summaryrefslogtreecommitdiffstats
path: root/doc/src/snippets/code/src_qdbus_qdbusabstractinterface.cpp
diff options
context:
space:
mode:
authorQt Continuous Integration System <qt-info@nokia.com>2010-11-15 08:19:54 (GMT)
committerQt Continuous Integration System <qt-info@nokia.com>2010-11-15 08:19:54 (GMT)
commitab743885e66a970a3425d97c6547ce995de3f64f (patch)
tree9baf720fbb9c1d2ce27ee8c12559ce51521e62fe /doc/src/snippets/code/src_qdbus_qdbusabstractinterface.cpp
parentcde72ad73cf2ee31e701e84763c152685493b7c7 (diff)
parent54ce087390724b5e03f95b93a5661d0a60765daa (diff)
downloadQt-ab743885e66a970a3425d97c6547ce995de3f64f.zip
Qt-ab743885e66a970a3425d97c6547ce995de3f64f.tar.gz
Qt-ab743885e66a970a3425d97c6547ce995de3f64f.tar.bz2
Merge branch '4.7' of scm.dev.nokia.troll.no:qt/qt-multimedia-staging into 4.7-integration
* '4.7' of scm.dev.nokia.troll.no:qt/qt-multimedia-staging: Crash fix, when the Object will be deleted during handling a QGestureEvent.
Diffstat (limited to 'doc/src/snippets/code/src_qdbus_qdbusabstractinterface.cpp')
0 files changed, 0 insertions, 0 deletions
bug_3613671'>bug_3613671 Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.fossil-settings/binary-glob3
-rw-r--r--.fossil-settings/crnl-glob0
-rw-r--r--.fossil-settings/ignore-glob24
-rw-r--r--.project11
-rw-r--r--.settings/org.eclipse.core.resources.prefs2
-rw-r--r--.settings/org.eclipse.core.runtime.prefs2
-rw-r--r--ChangeLog12949
-rw-r--r--ChangeLog.19991861
-rw-r--r--ChangeLog.20001872
-rw-r--r--ChangeLog.20013025
-rw-r--r--ChangeLog.20023403
-rw-r--r--ChangeLog.20032541
-rw-r--r--ChangeLog.20044619
-rw-r--r--ChangeLog.20053822
-rw-r--r--ChangeLog.20075921
-rw-r--r--ChangeLog.20083796
-rw-r--r--README113
-rw-r--r--changes1935
-rw-r--r--compat/README2
-rw-r--r--compat/dirent.h2
-rw-r--r--compat/dirent2.h12
-rw-r--r--compat/dlfcn.h21
-rw-r--r--compat/fake-rfc2553.c266
-rw-r--r--compat/fake-rfc2553.h170
-rw-r--r--compat/fixstrtod.c10
-rw-r--r--compat/float.h2
-rw-r--r--compat/gettod.c9
-rw-r--r--compat/limits.h2
-rw-r--r--compat/memcmp.c50
-rw-r--r--compat/mkstemp.c78
-rw-r--r--compat/opendir.c125
-rw-r--r--compat/stdlib.h53
-rw-r--r--compat/string.h76
-rw-r--r--compat/strncasecmp.c48
-rw-r--r--compat/strstr.c29
-rw-r--r--compat/strtod.c75
-rw-r--r--compat/strtol.c43
-rw-r--r--compat/strtoll.c110
-rw-r--r--compat/strtoul.c75
-rw-r--r--compat/strtoull.c260
-rw-r--r--compat/tclErrno.h99
-rw-r--r--compat/tmpnam.c42
-rw-r--r--compat/unistd.h114
-rw-r--r--compat/waitpid.c93
-rw-r--r--compat/zlib/CMakeLists.txt249
-rw-r--r--compat/zlib/ChangeLog1472
-rw-r--r--compat/zlib/FAQ368
-rw-r--r--compat/zlib/INDEX68
-rw-r--r--compat/zlib/Makefile5
-rw-r--r--compat/zlib/Makefile.in288
-rw-r--r--compat/zlib/README115
-rw-r--r--compat/zlib/adler32.c179
-rw-r--r--compat/zlib/amiga/Makefile.pup69
-rw-r--r--compat/zlib/amiga/Makefile.sas68
-rw-r--r--compat/zlib/as400/bndsrc215
-rw-r--r--compat/zlib/as400/compile.clp110
-rw-r--r--compat/zlib/as400/readme.txt115
-rw-r--r--compat/zlib/as400/zlib.inc451
-rw-r--r--compat/zlib/compress.c80
-rwxr-xr-xcompat/zlib/configure831
-rw-r--r--compat/zlib/contrib/README.contrib78
-rw-r--r--compat/zlib/contrib/ada/buffer_demo.adb106
-rw-r--r--compat/zlib/contrib/ada/mtest.adb156
-rw-r--r--compat/zlib/contrib/ada/read.adb156
-rw-r--r--compat/zlib/contrib/ada/readme.txt65
-rw-r--r--compat/zlib/contrib/ada/test.adb463
-rw-r--r--compat/zlib/contrib/ada/zlib-streams.adb225
-rw-r--r--compat/zlib/contrib/ada/zlib-streams.ads114
-rw-r--r--compat/zlib/contrib/ada/zlib-thin.adb141
-rw-r--r--compat/zlib/contrib/ada/zlib-thin.ads450
-rw-r--r--compat/zlib/contrib/ada/zlib.adb701
-rw-r--r--compat/zlib/contrib/ada/zlib.ads328
-rw-r--r--compat/zlib/contrib/ada/zlib.gpr20
-rw-r--r--compat/zlib/contrib/amd64/amd64-match.S452
-rw-r--r--compat/zlib/contrib/asm686/README.68651
-rw-r--r--compat/zlib/contrib/asm686/match.S357
-rw-r--r--compat/zlib/contrib/blast/Makefile8
-rw-r--r--compat/zlib/contrib/blast/README4
-rw-r--r--compat/zlib/contrib/blast/blast.c446
-rw-r--r--compat/zlib/contrib/blast/blast.h75
-rw-r--r--compat/zlib/contrib/blast/test.pkbin0 -> 8 bytes
-rw-r--r--compat/zlib/contrib/blast/test.txt1
-rw-r--r--compat/zlib/contrib/delphi/ZLib.pas557
-rw-r--r--compat/zlib/contrib/delphi/ZLibConst.pas11
-rw-r--r--compat/zlib/contrib/delphi/readme.txt76
-rw-r--r--compat/zlib/contrib/delphi/zlibd32.mak99
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib.build33
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib.chmbin0 -> 72726 bytes
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib.sln21
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs58
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs202
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs83
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs198
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs106
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs288
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj141
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs301
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs105
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs274
-rw-r--r--compat/zlib/contrib/dotzlib/LICENSE_1_0.txt23
-rw-r--r--compat/zlib/contrib/dotzlib/readme.txt58
-rw-r--r--compat/zlib/contrib/gcc_gvmat64/gvmat64.S574
-rw-r--r--compat/zlib/contrib/infback9/README1
-rw-r--r--compat/zlib/contrib/infback9/infback9.c615
-rw-r--r--compat/zlib/contrib/infback9/infback9.h37
-rw-r--r--compat/zlib/contrib/infback9/inffix9.h107
-rw-r--r--compat/zlib/contrib/infback9/inflate9.h47
-rw-r--r--compat/zlib/contrib/infback9/inftree9.c324
-rw-r--r--compat/zlib/contrib/infback9/inftree9.h61
-rw-r--r--compat/zlib/contrib/inflate86/inffas86.c1157
-rw-r--r--compat/zlib/contrib/inflate86/inffast.S1368
-rw-r--r--compat/zlib/contrib/iostream/test.cpp24
-rw-r--r--compat/zlib/contrib/iostream/zfstream.cpp329
-rw-r--r--compat/zlib/contrib/iostream/zfstream.h128
-rw-r--r--compat/zlib/contrib/iostream2/zstream.h307
-rw-r--r--compat/zlib/contrib/iostream2/zstream_test.cpp25
-rw-r--r--compat/zlib/contrib/iostream3/README35
-rw-r--r--compat/zlib/contrib/iostream3/TODO17
-rw-r--r--compat/zlib/contrib/iostream3/test.cc50
-rw-r--r--compat/zlib/contrib/iostream3/zfstream.cc479
-rw-r--r--compat/zlib/contrib/iostream3/zfstream.h466
-rw-r--r--compat/zlib/contrib/masmx64/bld_ml64.bat2
-rw-r--r--compat/zlib/contrib/masmx64/gvmat64.asm553
-rw-r--r--compat/zlib/contrib/masmx64/inffas8664.c186
-rw-r--r--compat/zlib/contrib/masmx64/inffasx64.asm396
-rw-r--r--compat/zlib/contrib/masmx64/readme.txt31
-rw-r--r--compat/zlib/contrib/masmx86/bld_ml32.bat2
-rw-r--r--compat/zlib/contrib/masmx86/inffas32.asm1080
-rw-r--r--compat/zlib/contrib/masmx86/match686.asm479
-rw-r--r--compat/zlib/contrib/masmx86/readme.txt27
-rw-r--r--compat/zlib/contrib/minizip/Makefile25
-rw-r--r--compat/zlib/contrib/minizip/Makefile.am45
-rw-r--r--compat/zlib/contrib/minizip/MiniZip64_Changes.txt6
-rw-r--r--compat/zlib/contrib/minizip/MiniZip64_info.txt74
-rw-r--r--compat/zlib/contrib/minizip/configure.ac32
-rw-r--r--compat/zlib/contrib/minizip/crypt.h131
-rw-r--r--compat/zlib/contrib/minizip/ioapi.c247
-rw-r--r--compat/zlib/contrib/minizip/ioapi.h208
-rw-r--r--compat/zlib/contrib/minizip/iowin32.c461
-rw-r--r--compat/zlib/contrib/minizip/iowin32.h28
-rw-r--r--compat/zlib/contrib/minizip/make_vms.com25
-rw-r--r--compat/zlib/contrib/minizip/miniunz.c660
-rw-r--r--compat/zlib/contrib/minizip/miniunzip.163
-rw-r--r--compat/zlib/contrib/minizip/minizip.146
-rw-r--r--compat/zlib/contrib/minizip/minizip.c520
-rw-r--r--compat/zlib/contrib/minizip/minizip.pc.in12
-rw-r--r--compat/zlib/contrib/minizip/mztools.c291
-rw-r--r--compat/zlib/contrib/minizip/mztools.h37
-rw-r--r--compat/zlib/contrib/minizip/unzip.c2125
-rw-r--r--compat/zlib/contrib/minizip/unzip.h437
-rw-r--r--compat/zlib/contrib/minizip/zip.c2007
-rw-r--r--compat/zlib/contrib/minizip/zip.h362
-rw-r--r--compat/zlib/contrib/pascal/example.pas599
-rw-r--r--compat/zlib/contrib/pascal/readme.txt76
-rw-r--r--compat/zlib/contrib/pascal/zlibd32.mak99
-rw-r--r--compat/zlib/contrib/pascal/zlibpas.pas276
-rw-r--r--compat/zlib/contrib/puff/Makefile42
-rw-r--r--compat/zlib/contrib/puff/README63
-rw-r--r--compat/zlib/contrib/puff/puff.c840
-rw-r--r--compat/zlib/contrib/puff/puff.h35
-rw-r--r--compat/zlib/contrib/puff/pufftest.c165
-rw-r--r--compat/zlib/contrib/puff/zeros.rawbin0 -> 2517 bytes
-rw-r--r--compat/zlib/contrib/testzlib/testzlib.c275
-rw-r--r--compat/zlib/contrib/testzlib/testzlib.txt10
-rw-r--r--compat/zlib/contrib/untgz/Makefile14
-rw-r--r--compat/zlib/contrib/untgz/Makefile.msc17
-rw-r--r--compat/zlib/contrib/untgz/untgz.c674
-rw-r--r--compat/zlib/contrib/vstudio/readme.txt65
-rw-r--r--compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj310
-rw-r--r--compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters22
-rw-r--r--compat/zlib/contrib/vstudio/vc10/minizip.vcxproj307
-rw-r--r--compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters22
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj420
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters58
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj310
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters22
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj473
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters77
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.def143
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.sln135
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj657
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters118
-rw-r--r--compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj314
-rw-r--r--compat/zlib/contrib/vstudio/vc11/minizip.vcxproj311
-rw-r--r--compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj426
-rw-r--r--compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj314
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj464
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.def143
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.sln117
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj688
-rw-r--r--compat/zlib/contrib/vstudio/vc9/miniunz.vcproj565
-rw-r--r--compat/zlib/contrib/vstudio/vc9/minizip.vcproj562
-rw-r--r--compat/zlib/contrib/vstudio/vc9/testzlib.vcproj852
-rw-r--r--compat/zlib/contrib/vstudio/vc9/testzlibdll.vcproj565
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj835
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.def143
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.sln144
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj1156
-rw-r--r--compat/zlib/crc32.c425
-rw-r--r--compat/zlib/crc32.h441
-rw-r--r--compat/zlib/deflate.c1967
-rw-r--r--compat/zlib/deflate.h346
-rw-r--r--compat/zlib/doc/algorithm.txt209
-rw-r--r--compat/zlib/doc/rfc1950.txt619
-rw-r--r--compat/zlib/doc/rfc1951.txt955
-rw-r--r--compat/zlib/doc/rfc1952.txt675
-rw-r--r--compat/zlib/doc/txtvsbin.txt107
-rw-r--r--compat/zlib/examples/README.examples49
-rw-r--r--compat/zlib/examples/enough.c572
-rw-r--r--compat/zlib/examples/fitblk.c233
-rw-r--r--compat/zlib/examples/gun.c702
-rw-r--r--compat/zlib/examples/gzappend.c504
-rw-r--r--compat/zlib/examples/gzjoin.c449
-rw-r--r--compat/zlib/examples/gzlog.c1059
-rw-r--r--compat/zlib/examples/gzlog.h91
-rw-r--r--compat/zlib/examples/zlib_how.html545
-rw-r--r--compat/zlib/examples/zpipe.c205
-rw-r--r--compat/zlib/examples/zran.c409
-rw-r--r--compat/zlib/gzclose.c25
-rw-r--r--compat/zlib/gzguts.h209
-rw-r--r--compat/zlib/gzlib.c634
-rw-r--r--compat/zlib/gzread.c594
-rw-r--r--compat/zlib/gzwrite.c577
-rw-r--r--compat/zlib/infback.c640
-rw-r--r--compat/zlib/inffast.c340
-rw-r--r--compat/zlib/inffast.h11
-rw-r--r--compat/zlib/inffixed.h94
-rw-r--r--compat/zlib/inflate.c1512
-rw-r--r--compat/zlib/inflate.h122
-rw-r--r--compat/zlib/inftrees.c306
-rw-r--r--compat/zlib/inftrees.h62
-rw-r--r--compat/zlib/make_vms.com867
-rw-r--r--compat/zlib/msdos/Makefile.bor115
-rw-r--r--compat/zlib/msdos/Makefile.dj2104
-rw-r--r--compat/zlib/msdos/Makefile.emx69
-rw-r--r--compat/zlib/msdos/Makefile.msc112
-rw-r--r--compat/zlib/msdos/Makefile.tc100
-rw-r--r--compat/zlib/nintendods/Makefile126
-rw-r--r--compat/zlib/nintendods/README5
-rw-r--r--compat/zlib/old/Makefile.emx69
-rw-r--r--compat/zlib/old/Makefile.riscos151
-rw-r--r--compat/zlib/old/README3
-rw-r--r--compat/zlib/old/descrip.mms48
-rw-r--r--compat/zlib/old/os2/Makefile.os2136
-rw-r--r--compat/zlib/old/os2/zlib.def51
-rw-r--r--compat/zlib/old/visual-basic.txt160
-rw-r--r--compat/zlib/qnx/package.qpg141
-rw-r--r--compat/zlib/test/example.c601
-rw-r--r--compat/zlib/test/infcover.c671
-rw-r--r--compat/zlib/test/minigzip.c651
-rw-r--r--compat/zlib/treebuild.xml116
-rw-r--r--compat/zlib/trees.c1226
-rw-r--r--compat/zlib/trees.h128
-rw-r--r--compat/zlib/uncompr.c59
-rw-r--r--compat/zlib/watcom/watcom_f.mak43
-rw-r--r--compat/zlib/watcom/watcom_l.mak43
-rw-r--r--compat/zlib/win32/DLL_FAQ.txt397
-rw-r--r--compat/zlib/win32/Makefile.bor110
-rw-r--r--compat/zlib/win32/Makefile.gcc182
-rw-r--r--compat/zlib/win32/Makefile.msc163
-rw-r--r--compat/zlib/win32/README-WIN32.txt103
-rw-r--r--compat/zlib/win32/README.txt60
-rw-r--r--compat/zlib/win32/USAGE.txt89
-rw-r--r--compat/zlib/win32/VisualC.txt3
-rw-r--r--compat/zlib/win32/zdll.libbin0 -> 15658 bytes
-rw-r--r--compat/zlib/win32/zlib.def86
-rwxr-xr-xcompat/zlib/win32/zlib1.dllbin0 -> 107520 bytes
-rw-r--r--compat/zlib/win32/zlib1.rc40
-rw-r--r--compat/zlib/win64/libz.dll.abin0 -> 46874 bytes
-rw-r--r--compat/zlib/win64/zdll.libbin0 -> 15288 bytes
-rwxr-xr-xcompat/zlib/win64/zlib1.dllbin0 -> 112640 bytes
-rw-r--r--compat/zlib/zconf.h511
-rw-r--r--compat/zlib/zconf.h.cmakein513
-rw-r--r--compat/zlib/zconf.h.in511
-rw-r--r--compat/zlib/zlib.3151
-rw-r--r--compat/zlib/zlib.3.pdfbin0 -> 8734 bytes
-rw-r--r--compat/zlib/zlib.h1768
-rw-r--r--compat/zlib/zlib.map83
-rw-r--r--compat/zlib/zlib.pc.cmakein13
-rw-r--r--compat/zlib/zlib.pc.in13
-rw-r--r--compat/zlib/zlib2ansi152
-rw-r--r--compat/zlib/zutil.c324
-rw-r--r--compat/zlib/zutil.h253
-rw-r--r--doc/Access.375
-rw-r--r--doc/AddErrInfo.3128
-rw-r--r--doc/Alloc.314
-rw-r--r--doc/AllowExc.34
-rw-r--r--doc/AppInit.322
-rw-r--r--doc/AssocData.38
-rw-r--r--doc/Async.315
-rw-r--r--doc/BackgdErr.356
-rw-r--r--doc/Backslash.36
-rw-r--r--doc/BoolObj.314
-rw-r--r--doc/ByteArrObj.358
-rw-r--r--doc/CallDel.320
-rw-r--r--doc/Cancel.366
-rw-r--r--doc/ChnlStack.322
-rw-r--r--doc/Class.3236
-rw-r--r--doc/CmdCmplt.34
-rw-r--r--doc/Concat.34
-rw-r--r--doc/CrtChannel.3186
-rw-r--r--doc/CrtChnlHdlr.311
-rw-r--r--doc/CrtCloseHdlr.38
-rw-r--r--doc/CrtCommand.339
-rw-r--r--doc/CrtFileHdlr.317
-rw-r--r--doc/CrtInterp.367
-rw-r--r--doc/CrtMathFnc.340
-rw-r--r--doc/CrtObjCmd.347
-rw-r--r--doc/CrtSlave.347
-rw-r--r--doc/CrtTimerHdlr.315
-rw-r--r--doc/CrtTrace.322
-rw-r--r--doc/DString.314
-rw-r--r--doc/DetachPids.312
-rw-r--r--doc/DictObj.382
-rw-r--r--doc/DoOneEvent.36
-rw-r--r--doc/DoWhenIdle.317
-rw-r--r--doc/DoubleObj.375
-rw-r--r--doc/DumpActiveMemory.34
-rw-r--r--doc/Encoding.3152
-rw-r--r--doc/Ensemble.385
-rw-r--r--doc/Environment.317
-rw-r--r--doc/Eval.354
-rw-r--r--doc/Exit.329
-rw-r--r--doc/ExprLong.318
-rw-r--r--doc/ExprLongObj.322
-rw-r--r--doc/FileSystem.3995
-rw-r--r--doc/FindExec.311
-rw-r--r--[-rwxr-xr-x]doc/GetCwd.36
-rw-r--r--doc/GetHostName.34
-rw-r--r--doc/GetIndex.339
-rw-r--r--doc/GetInt.323
-rw-r--r--doc/GetOpnFl.39
-rw-r--r--doc/GetStdChan.319
-rw-r--r--doc/GetTime.381
-rw-r--r--[-rwxr-xr-x]doc/GetVersion.34
-rw-r--r--doc/Hash.3165
-rw-r--r--doc/Init.36
-rw-r--r--doc/InitStubs.310
-rw-r--r--doc/IntObj.3177
-rw-r--r--doc/Interp.343
-rw-r--r--doc/Limit.312
-rw-r--r--doc/LinkVar.343
-rw-r--r--doc/ListObj.3141
-rw-r--r--doc/Load.370
-rw-r--r--doc/Method.3249
-rw-r--r--doc/NRE.3328
-rw-r--r--doc/Namespace.336
-rw-r--r--doc/Notifier.3137
-rw-r--r--doc/OOInitStubs.354
-rw-r--r--doc/Object.3253
-rw-r--r--doc/ObjectType.3214
-rw-r--r--doc/OpenFileChnl.389
-rw-r--r--doc/OpenTcp.337
-rw-r--r--doc/Panic.331
-rw-r--r--doc/ParseArgs.3198
-rw-r--r--doc/ParseCmd.373
-rw-r--r--doc/PkgRequire.330
-rw-r--r--doc/Preserve.316
-rw-r--r--doc/PrintDbl.319
-rw-r--r--doc/RecEvalObj.314
-rw-r--r--doc/RecordEval.314
-rw-r--r--doc/RegConfig.331
-rw-r--r--doc/RegExp.3147
-rw-r--r--doc/SaveResult.318
-rw-r--r--doc/SetChanErr.3159
-rw-r--r--doc/SetErrno.39
-rw-r--r--doc/SetRecLmt.34
-rw-r--r--doc/SetResult.3124
-rw-r--r--doc/SetVar.329
-rw-r--r--doc/Signal.310
-rw-r--r--doc/Sleep.38
-rw-r--r--doc/SourceRCFile.35
-rw-r--r--doc/SplitList.321
-rw-r--r--doc/SplitPath.39
-rw-r--r--doc/StaticPkg.321
-rw-r--r--doc/StdChannels.337
-rw-r--r--doc/StrMatch.322
-rw-r--r--doc/StringObj.3242
-rw-r--r--doc/SubstObj.323
-rw-r--r--doc/TCL_MEM_DEBUG.333
-rw-r--r--doc/Tcl.n153
-rw-r--r--doc/TclZlib.3276
-rw-r--r--doc/Tcl_Main.3112
-rw-r--r--doc/Thread.380
-rw-r--r--doc/ToUpper.34
-rw-r--r--doc/TraceCmd.328
-rw-r--r--doc/TraceVar.342
-rw-r--r--doc/Translate.320
-rw-r--r--doc/UniCharIsAlpha.36
-rw-r--r--doc/UpVar.311
-rw-r--r--doc/Utf.311
-rw-r--r--doc/WrongNumArgs.331
-rw-r--r--doc/after.n35
-rw-r--r--doc/append.n22
-rw-r--r--doc/apply.n102
-rw-r--r--doc/array.n47
-rw-r--r--doc/bgerror.n21
-rw-r--r--doc/binary.n396
-rw-r--r--doc/break.n22
-rw-r--r--doc/case.n4
-rw-r--r--doc/catch.n103
-rw-r--r--doc/cd.n10
-rw-r--r--doc/chan.n384
-rw-r--r--doc/class.n136
-rw-r--r--doc/clock.n342
-rw-r--r--doc/close.n53
-rw-r--r--doc/concat.n46
-rw-r--r--doc/continue.n24
-rw-r--r--doc/copy.n66
-rw-r--r--doc/coroutine.n205
-rw-r--r--doc/dde.n68
-rw-r--r--doc/define.n404
-rw-r--r--doc/dict.n244
-rw-r--r--doc/encoding.n68
-rw-r--r--doc/eof.n10
-rw-r--r--doc/error.n32
-rw-r--r--doc/eval.n38
-rw-r--r--doc/exec.n285
-rw-r--r--doc/exit.n14
-rw-r--r--doc/expr.n279
-rw-r--r--doc/fblocked.n4
-rw-r--r--doc/fconfigure.n85
-rw-r--r--doc/fcopy.n113
-rw-r--r--doc/file.n281
-rw-r--r--doc/fileevent.n66
-rw-r--r--doc/filename.n47
-rw-r--r--doc/flush.n9
-rw-r--r--doc/for.n31
-rw-r--r--doc/foreach.n21
-rw-r--r--doc/format.n122
-rw-r--r--doc/gets.n14
-rw-r--r--doc/glob.n233
-rw-r--r--doc/global.n19
-rw-r--r--doc/history.n26
-rw-r--r--doc/http.n422
-rw-r--r--doc/if.n33
-rw-r--r--doc/incr.n20
-rw-r--r--doc/info.n600
-rw-r--r--doc/interp.n545
-rw-r--r--doc/join.n14
-rw-r--r--doc/lappend.n21
-rw-r--r--doc/lassign.n29
-rw-r--r--doc/library.n92
-rw-r--r--doc/lindex.n89
-rw-r--r--doc/linsert.n35
-rw-r--r--doc/list.n22
-rw-r--r--doc/llength.n14
-rw-r--r--doc/lmap.n85
-rw-r--r--doc/load.n75
-rw-r--r--doc/lrange.n29
-rw-r--r--doc/lrepeat.n29
-rw-r--r--doc/lreplace.n52
-rw-r--r--doc/lreverse.n34
-rw-r--r--doc/lsearch.n100
-rw-r--r--[-rwxr-xr-x]doc/lset.n93
-rw-r--r--doc/lsort.n175
-rw-r--r--doc/man.macros211
-rw-r--r--doc/mathfunc.n219
-rw-r--r--doc/mathop.n310
-rw-r--r--doc/memory.n39
-rw-r--r--doc/msgcat.n191
-rw-r--r--doc/my.n56
-rw-r--r--doc/namespace.n389
-rw-r--r--doc/next.n206
-rw-r--r--doc/object.n128
-rw-r--r--doc/open.n165
-rw-r--r--doc/package.n237
-rw-r--r--doc/packagens.n18
-rw-r--r--doc/pid.n6
-rw-r--r--doc/pkgMkIndex.n64
-rw-r--r--doc/platform.n86
-rw-r--r--doc/platform_shell.n57
-rw-r--r--doc/prefix.n116
-rw-r--r--doc/proc.n53
-rw-r--r--doc/puts.n14
-rw-r--r--doc/pwd.n10
-rw-r--r--doc/re_syntax.n587
-rw-r--r--doc/read.n23
-rw-r--r--doc/refchan.n411
-rw-r--r--doc/regexp.n124
-rw-r--r--doc/registry.n76
-rw-r--r--doc/regsub.n133
-rw-r--r--doc/rename.n9
-rw-r--r--doc/return.n226
-rw-r--r--doc/safe.n84
-rw-r--r--doc/scan.n229
-rw-r--r--doc/seek.n23
-rw-r--r--doc/self.n152
-rw-r--r--doc/set.n16
-rw-r--r--doc/socket.n174
-rw-r--r--doc/source.n36
-rw-r--r--doc/split.n41
-rw-r--r--doc/string.n321
-rw-r--r--doc/subst.n93
-rw-r--r--doc/switch.n91
-rw-r--r--doc/tailcall.n69
-rw-r--r--doc/tclsh.161
-rw-r--r--doc/tcltest.n1084
-rw-r--r--doc/tclvars.n316
-rw-r--r--doc/tell.n9
-rw-r--r--doc/throw.n48
-rw-r--r--doc/time.n17
-rw-r--r--doc/tm.n135
-rw-r--r--doc/trace.n267
-rw-r--r--doc/transchan.n160
-rw-r--r--doc/try.n103
-rw-r--r--doc/unknown.n34
-rw-r--r--doc/unload.n40
-rw-r--r--doc/unset.n24
-rw-r--r--doc/update.n14
-rw-r--r--doc/uplevel.n27
-rw-r--r--doc/upvar.n37
-rw-r--r--doc/variable.n15
-rw-r--r--doc/vwait.n209
-rw-r--r--doc/while.n12
-rw-r--r--doc/zlib.n460
-rw-r--r--generic/README2
-rw-r--r--generic/regc_color.c1287
-rw-r--r--generic/regc_cvec.c182
-rw-r--r--generic/regc_lex.c1857
-rw-r--r--generic/regc_locale.c1194
-rw-r--r--generic/regc_nfa.c2825
-rw-r--r--generic/regcomp.c3616
-rw-r--r--generic/regcustom.h147
-rw-r--r--generic/rege_dfa.c1233
-rw-r--r--generic/regerror.c150
-rw-r--r--generic/regerrs.h2
-rw-r--r--generic/regex.h176
-rw-r--r--generic/regexec.c1904
-rw-r--r--generic/regfree.c47
-rw-r--r--generic/regfronts.c92
-rw-r--r--generic/regguts.h408
-rw-r--r--generic/tcl.decls2269
-rw-r--r--generic/tcl.h1564
-rw-r--r--generic/tclAlloc.c131
-rw-r--r--generic/tclAssembly.c4325
-rw-r--r--generic/tclAsync.c96
-rw-r--r--generic/tclBasic.c7241
-rw-r--r--generic/tclBinary.c2893
-rw-r--r--generic/tclCkalloc.c528
-rw-r--r--generic/tclClock.c2013
-rw-r--r--generic/tclCmdAH.c3262
-rw-r--r--generic/tclCmdIL.c3561
-rw-r--r--generic/tclCmdMZ.c4444
-rw-r--r--generic/tclCompCmds.c5315
-rw-r--r--generic/tclCompCmdsGR.c3171
-rw-r--r--generic/tclCompCmdsSZ.c4383
-rw-r--r--generic/tclCompExpr.c3203
-rw-r--r--generic/tclCompile.c3878
-rw-r--r--generic/tclCompile.h1253
-rw-r--r--generic/tclConfig.c228
-rw-r--r--generic/tclDTrace.d225
-rw-r--r--generic/tclDate.c2674
-rw-r--r--generic/tclDecls.h6839
-rw-r--r--generic/tclDictObj.c3074
-rw-r--r--generic/tclEncoding.c1653
-rw-r--r--generic/tclEnsemble.c3486
-rw-r--r--generic/tclEnv.c395
-rw-r--r--generic/tclEvent.c1012
-rw-r--r--generic/tclExecute.c11614
-rw-r--r--generic/tclFCmd.c780
-rw-r--r--generic/tclFileName.c991
-rw-r--r--generic/tclFileSystem.h152
-rw-r--r--generic/tclGet.c84
-rw-r--r--generic/tclGetDate.y1434
-rw-r--r--generic/tclHash.c551
-rw-r--r--generic/tclHistory.c161
-rw-r--r--generic/tclIO.c6266
-rw-r--r--generic/tclIO.h431
-rw-r--r--generic/tclIOCmd.c1253
-rw-r--r--generic/tclIOGT.c939
-rw-r--r--generic/tclIORChan.c3947
-rw-r--r--generic/tclIORTrans.c3420
-rw-r--r--generic/tclIOSock.c198
-rw-r--r--generic/tclIOUtil.c3983
-rw-r--r--generic/tclIndexObj.c1121
-rw-r--r--generic/tclInt.decls997
-rw-r--r--generic/tclInt.h3277
-rw-r--r--generic/tclIntDecls.h2256
-rw-r--r--generic/tclIntPlatDecls.h750
-rw-r--r--generic/tclInterp.c1949
-rw-r--r--generic/tclLink.c278
-rw-r--r--generic/tclListObj.c1507
-rw-r--r--generic/tclLiteral.c799
-rw-r--r--generic/tclLoad.c566
-rw-r--r--generic/tclLoadNone.c144
-rw-r--r--generic/tclMain.c892
-rw-r--r--generic/tclNamesp.c4832
-rw-r--r--generic/tclNotify.c201
-rw-r--r--generic/tclOO.c2977
-rw-r--r--generic/tclOO.decls218
-rw-r--r--generic/tclOO.h147
-rw-r--r--generic/tclOOBasic.c1249
-rw-r--r--generic/tclOOCall.c1495
-rw-r--r--generic/tclOODecls.h234
-rw-r--r--generic/tclOODefineCmds.c2697
-rw-r--r--generic/tclOOInfo.c1526
-rw-r--r--generic/tclOOInt.h604
-rw-r--r--generic/tclOOIntDecls.h166
-rw-r--r--generic/tclOOMethod.c1783
-rw-r--r--generic/tclOOStubInit.c78
-rw-r--r--generic/tclOOStubLib.c71
-rw-r--r--generic/tclObj.c3351
-rw-r--r--generic/tclOptimize.c444
-rw-r--r--generic/tclPanic.c77
-rw-r--r--generic/tclParse.c1123
-rw-r--r--generic/tclParse.h17
-rw-r--r--generic/tclParseExpr.c2148
-rw-r--r--generic/tclPathObj.c1327
-rw-r--r--generic/tclPipe.c410
-rw-r--r--generic/tclPkg.c1575
-rw-r--r--generic/tclPkgConfig.c12
-rw-r--r--generic/tclPlatDecls.h124
-rw-r--r--generic/tclPort.h9
-rw-r--r--generic/tclPosixStr.c96
-rw-r--r--generic/tclPreserve.c103
-rw-r--r--generic/tclProc.c2572
-rw-r--r--generic/tclRegexp.c341
-rw-r--r--generic/tclRegexp.h34
-rw-r--r--generic/tclResolve.c129
-rw-r--r--generic/tclResult.c576
-rw-r--r--generic/tclScan.c591
-rw-r--r--[-rwxr-xr-x]generic/tclStrToD.c5031
-rw-r--r--generic/tclStringObj.c2421
-rw-r--r--generic/tclStringTrim.h43
-rw-r--r--generic/tclStubInit.c802
-rw-r--r--generic/tclStubLib.c140
-rw-r--r--generic/tclStubLibTbl.c58
-rw-r--r--generic/tclTest.c6053
-rw-r--r--generic/tclTestObj.c981
-rw-r--r--generic/tclTestProcBodyObj.c190
-rw-r--r--generic/tclThread.c210
-rw-r--r--[-rwxr-xr-x]generic/tclThreadAlloc.c411
-rw-r--r--generic/tclThreadJoin.c32
-rw-r--r--generic/tclThreadStorage.c595
-rw-r--r--generic/tclThreadTest.c859
-rw-r--r--generic/tclTimer.c449
-rw-r--r--generic/tclTomMath.decls223
-rw-r--r--generic/tclTomMath.h901
-rw-r--r--generic/tclTomMathDecls.h501
-rw-r--r--generic/tclTomMathInt.h3
-rw-r--r--generic/tclTomMathInterface.c241
-rw-r--r--generic/tclTomMathStubLib.c79
-rw-r--r--generic/tclTrace.c1439
-rw-r--r--generic/tclUniData.c2138
-rw-r--r--generic/tclUtf.c472
-rw-r--r--generic/tclUtil.c3240
-rw-r--r--generic/tclVar.c5928
-rw-r--r--generic/tclZlib.c4017
-rw-r--r--generic/tommath.h609
-rw-r--r--library/auto.tcl385
-rw-r--r--library/clock.tcl3271
-rw-r--r--library/dde/pkgIndex.tcl10
-rw-r--r--[-rwxr-xr-x]library/encoding/tis-620.enc0
-rw-r--r--library/history.tcl304
-rw-r--r--library/http/http.tcl1213
-rw-r--r--library/http/pkgIndex.tcl14
-rw-r--r--library/http1.0/http.tcl8
-rw-r--r--library/init.tcl267
-rw-r--r--library/msgcat/msgcat.tcl455
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--[-rwxr-xr-x]library/msgs/af.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/af_za.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_jo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_lb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_sy.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bn_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/cs.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/da.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de_at.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/el.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_au.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_bw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_hk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ie.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_nz.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ph.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_sg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_za.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_zw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ar.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_bo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_cl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_co.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_cr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_do.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ec.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_gt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_hn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_mx.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ni.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pa.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pe.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_py.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_sv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_uy.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ve.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/et.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eu.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eu_es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa_ir.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fo_fo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_ch.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ga.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ga_ie.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gl_es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gv_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/he.msg4
-rw-r--r--[-rwxr-xr-x]library/msgs/hi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hi_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hu.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/id.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/id_id.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/is.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/it.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/it_ch.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ja.msg27
-rw-r--r--[-rwxr-xr-x]library/msgs/kl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kl_gl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ko.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ko_kr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kok.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kok_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kw_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/lt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/lv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mr_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ms.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ms_my.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nl_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pt_br.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ro.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ru.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ru_ua.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sh.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sq.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ta.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ta_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/te.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/te_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/th.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/tr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/uk.msg2
-rw-r--r--[-rwxr-xr-x]library/msgs/vi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_cn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_hk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_sg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_tw.msg0
-rw-r--r--library/opt/optparse.tcl476
-rw-r--r--library/opt/pkgIndex.tcl2
-rw-r--r--library/package.tcl346
-rw-r--r--library/parray.tcl4
-rw-r--r--library/platform/pkgIndex.tcl3
-rw-r--r--library/platform/platform.tcl387
-rw-r--r--library/platform/shell.tcl241
-rwxr-xr-xlibrary/reg/pkgIndex.tcl14
-rw-r--r--library/safe.tcl1690
-rw-r--r--library/tclIndex22
-rw-r--r--library/tcltest/pkgIndex.tcl4
-rw-r--r--library/tcltest/tcltest.tcl310
-rw-r--r--library/tm.tcl273
-rw-r--r--library/tzdata/Africa/Abidjan2
-rw-r--r--library/tzdata/Africa/Accra2
-rw-r--r--library/tzdata/Africa/Addis_Ababa2
-rw-r--r--library/tzdata/Africa/Algiers2
-rw-r--r--library/tzdata/Africa/Asmara8
-rw-r--r--library/tzdata/Africa/Asmera11
-rw-r--r--library/tzdata/Africa/Bamako2
-rw-r--r--library/tzdata/Africa/Bangui2
-rw-r--r--library/tzdata/Africa/Banjul2
-rw-r--r--library/tzdata/Africa/Bissau2
-rw-r--r--library/tzdata/Africa/Blantyre2
-rw-r--r--library/tzdata/Africa/Brazzaville2
-rw-r--r--library/tzdata/Africa/Bujumbura2
-rw-r--r--library/tzdata/Africa/Cairo250
-rw-r--r--library/tzdata/Africa/Casablanca146
-rw-r--r--library/tzdata/Africa/Ceuta2
-rw-r--r--library/tzdata/Africa/Conakry2
-rw-r--r--library/tzdata/Africa/Dakar2
-rw-r--r--library/tzdata/Africa/Dar_es_Salaam6
-rw-r--r--library/tzdata/Africa/Djibouti2
-rw-r--r--library/tzdata/Africa/Douala2
-rw-r--r--library/tzdata/Africa/El_Aaiun2
-rw-r--r--library/tzdata/Africa/Freetown2
-rw-r--r--library/tzdata/Africa/Gaborone5
-rw-r--r--library/tzdata/Africa/Harare2
-rw-r--r--library/tzdata/Africa/Johannesburg2
-rw-r--r--library/tzdata/Africa/Juba5
-rw-r--r--library/tzdata/Africa/Kampala6
-rw-r--r--library/tzdata/Africa/Khartoum2
-rw-r--r--library/tzdata/Africa/Kigali2
-rw-r--r--library/tzdata/Africa/Kinshasa2
-rw-r--r--library/tzdata/Africa/Lagos2
-rw-r--r--library/tzdata/Africa/Libreville2
-rw-r--r--library/tzdata/Africa/Lome2
-rw-r--r--library/tzdata/Africa/Luanda2
-rw-r--r--library/tzdata/Africa/Lubumbashi2
-rw-r--r--library/tzdata/Africa/Lusaka2
-rw-r--r--library/tzdata/Africa/Malabo2
-rw-r--r--library/tzdata/Africa/Maputo2
-rw-r--r--library/tzdata/Africa/Maseru2
-rw-r--r--library/tzdata/Africa/Mbabane2
-rw-r--r--library/tzdata/Africa/Mogadishu2
-rw-r--r--library/tzdata/Africa/Monrovia2
-rw-r--r--library/tzdata/Africa/Nairobi6
-rw-r--r--library/tzdata/Africa/Ndjamena2
-rw-r--r--library/tzdata/Africa/Niamey2
-rw-r--r--library/tzdata/Africa/Nouakchott2
-rw-r--r--library/tzdata/Africa/Ouagadougou2
-rw-r--r--library/tzdata/Africa/Porto-Novo2
-rw-r--r--library/tzdata/Africa/Sao_Tome2
-rw-r--r--library/tzdata/Africa/Timbuktu9
-rw-r--r--library/tzdata/Africa/Tripoli179
-rw-r--r--library/tzdata/Africa/Tunis36
-rw-r--r--library/tzdata/Africa/Windhoek2
-rw-r--r--library/tzdata/America/Adak374
-rw-r--r--library/tzdata/America/Anchorage378
-rw-r--r--library/tzdata/America/Anguilla9
-rw-r--r--library/tzdata/America/Antigua2
-rw-r--r--library/tzdata/America/Araguaina5
-rw-r--r--library/tzdata/America/Argentina/Buenos_Aires6
-rw-r--r--library/tzdata/America/Argentina/Catamarca5
-rw-r--r--library/tzdata/America/Argentina/ComodRivadavia68
-rw-r--r--library/tzdata/America/Argentina/Cordoba6
-rw-r--r--library/tzdata/America/Argentina/Jujuy5
-rw-r--r--library/tzdata/America/Argentina/La_Rioja5
-rw-r--r--library/tzdata/America/Argentina/Mendoza5
-rw-r--r--library/tzdata/America/Argentina/Rio_Gallegos5
-rw-r--r--library/tzdata/America/Argentina/Salta66
-rw-r--r--library/tzdata/America/Argentina/San_Juan5
-rw-r--r--library/tzdata/America/Argentina/San_Luis68
-rw-r--r--library/tzdata/America/Argentina/Tucuman6
-rw-r--r--library/tzdata/America/Argentina/Ushuaia5
-rw-r--r--library/tzdata/America/Aruba10
-rw-r--r--library/tzdata/America/Asuncion362
-rw-r--r--library/tzdata/America/Atikokan12
-rw-r--r--library/tzdata/America/Atka2
-rw-r--r--library/tzdata/America/Bahia5
-rw-r--r--library/tzdata/America/Bahia_Banderas222
-rw-r--r--library/tzdata/America/Barbados8
-rw-r--r--library/tzdata/America/Belem2
-rw-r--r--library/tzdata/America/Belize2
-rw-r--r--library/tzdata/America/Blanc-Sablon12
-rw-r--r--library/tzdata/America/Boa_Vista2
-rw-r--r--library/tzdata/America/Bogota12
-rw-r--r--library/tzdata/America/Boise374
-rw-r--r--library/tzdata/America/Buenos_Aires2
-rw-r--r--library/tzdata/America/Cambridge_Bay382
-rw-r--r--library/tzdata/America/Campo_Grande20
-rw-r--r--library/tzdata/America/Cancun2
-rw-r--r--library/tzdata/America/Caracas3
-rw-r--r--library/tzdata/America/Catamarca2
-rw-r--r--library/tzdata/America/Cayenne2
-rw-r--r--library/tzdata/America/Cayman6
-rw-r--r--library/tzdata/America/Chicago374
-rw-r--r--library/tzdata/America/Chihuahua2
-rw-r--r--library/tzdata/America/Coral_Harbour5
-rw-r--r--library/tzdata/America/Cordoba2
-rw-r--r--library/tzdata/America/Costa_Rica8
-rw-r--r--library/tzdata/America/Creston8
-rw-r--r--library/tzdata/America/Cuiaba20
-rw-r--r--library/tzdata/America/Curacao6
-rw-r--r--library/tzdata/America/Danmarkshavn2
-rw-r--r--library/tzdata/America/Dawson376
-rw-r--r--library/tzdata/America/Dawson_Creek4
-rw-r--r--library/tzdata/America/Denver374
-rw-r--r--library/tzdata/America/Detroit374
-rw-r--r--library/tzdata/America/Dominica9
-rw-r--r--library/tzdata/America/Edmonton377
-rw-r--r--library/tzdata/America/Eirunepe3
-rw-r--r--library/tzdata/America/El_Salvador2
-rw-r--r--library/tzdata/America/Ensenada2
-rw-r--r--library/tzdata/America/Fort_Wayne8
-rw-r--r--library/tzdata/America/Fortaleza2
-rw-r--r--library/tzdata/America/Glace_Bay376
-rw-r--r--library/tzdata/America/Godthab2
-rw-r--r--library/tzdata/America/Goose_Bay377
-rw-r--r--library/tzdata/America/Grand_Turk490
-rw-r--r--library/tzdata/America/Grenada9
-rw-r--r--library/tzdata/America/Guadeloupe9
-rw-r--r--library/tzdata/America/Guatemala4
-rw-r--r--library/tzdata/America/Guayaquil2
-rw-r--r--library/tzdata/America/Guyana2
-rw-r--r--library/tzdata/America/Halifax379
-rw-r--r--library/tzdata/America/Havana419
-rw-r--r--library/tzdata/America/Hermosillo2
-rw-r--r--library/tzdata/America/Indiana/Indianapolis237
-rw-r--r--library/tzdata/America/Indiana/Knox191
-rw-r--r--library/tzdata/America/Indiana/Marengo191
-rw-r--r--library/tzdata/America/Indiana/Petersburg247
-rw-r--r--library/tzdata/America/Indiana/Tell_City234
-rw-r--r--library/tzdata/America/Indiana/Vevay191
-rw-r--r--library/tzdata/America/Indiana/Vincennes234
-rw-r--r--library/tzdata/America/Indiana/Winamac240
-rw-r--r--library/tzdata/America/Indianapolis48
-rw-r--r--library/tzdata/America/Inuvik387
-rw-r--r--library/tzdata/America/Iqaluit383
-rw-r--r--library/tzdata/America/Jamaica8
-rw-r--r--library/tzdata/America/Jujuy2
-rw-r--r--library/tzdata/America/Juneau379
-rw-r--r--library/tzdata/America/Kentucky/Louisville317
-rw-r--r--library/tzdata/America/Kentucky/Monticello374
-rw-r--r--library/tzdata/America/Knox_IN2
-rw-r--r--library/tzdata/America/Kralendijk5
-rw-r--r--library/tzdata/America/La_Paz2
-rw-r--r--library/tzdata/America/Lima2
-rw-r--r--library/tzdata/America/Los_Angeles374
-rw-r--r--library/tzdata/America/Louisville317
-rw-r--r--library/tzdata/America/Lower_Princes5
-rw-r--r--library/tzdata/America/Maceio2
-rw-r--r--library/tzdata/America/Managua12
-rw-r--r--library/tzdata/America/Manaus2
-rw-r--r--library/tzdata/America/Marigot5
-rw-r--r--library/tzdata/America/Martinique2
-rw-r--r--library/tzdata/America/Matamoros219
-rw-r--r--library/tzdata/America/Mazatlan2
-rw-r--r--library/tzdata/America/Mendoza2
-rw-r--r--library/tzdata/America/Menominee374
-rw-r--r--library/tzdata/America/Merida2
-rw-r--r--library/tzdata/America/Metlakatla43
-rw-r--r--library/tzdata/America/Mexico_City2
-rw-r--r--library/tzdata/America/Miquelon374
-rw-r--r--library/tzdata/America/Moncton342
-rw-r--r--library/tzdata/America/Monterrey2
-rw-r--r--library/tzdata/America/Montevideo202
-rw-r--r--library/tzdata/America/Montreal379
-rw-r--r--library/tzdata/America/Montserrat9
-rw-r--r--library/tzdata/America/Nassau379
-rw-r--r--library/tzdata/America/New_York374
-rw-r--r--library/tzdata/America/Nipigon379
-rw-r--r--library/tzdata/America/Nome374
-rw-r--r--library/tzdata/America/Noronha2
-rw-r--r--library/tzdata/America/North_Dakota/Beulah279
-rw-r--r--library/tzdata/America/North_Dakota/Center374
-rw-r--r--library/tzdata/America/North_Dakota/New_Salem279
-rw-r--r--library/tzdata/America/Ojinaga222
-rw-r--r--library/tzdata/America/Panama2
-rw-r--r--library/tzdata/America/Pangnirtung382
-rw-r--r--library/tzdata/America/Paramaribo2
-rw-r--r--library/tzdata/America/Phoenix2
-rw-r--r--library/tzdata/America/Port-au-Prince220
-rw-r--r--library/tzdata/America/Port_of_Spain2
-rw-r--r--library/tzdata/America/Porto_Acre2
-rw-r--r--library/tzdata/America/Porto_Velho2
-rw-r--r--library/tzdata/America/Puerto_Rico6
-rw-r--r--library/tzdata/America/Rainy_River383
-rw-r--r--library/tzdata/America/Rankin_Inlet385
-rw-r--r--library/tzdata/America/Recife2
-rw-r--r--library/tzdata/America/Regina4
-rw-r--r--library/tzdata/America/Resolute248
-rw-r--r--library/tzdata/America/Rio_Branco3
-rw-r--r--library/tzdata/America/Rosario2
-rw-r--r--library/tzdata/America/Santa_Isabel284
-rw-r--r--library/tzdata/America/Santarem36
-rw-r--r--library/tzdata/America/Santiago406
-rw-r--r--library/tzdata/America/Santo_Domingo2
-rw-r--r--library/tzdata/America/Sao_Paulo20
-rw-r--r--library/tzdata/America/Scoresbysund8
-rw-r--r--library/tzdata/America/Shiprock2
-rw-r--r--library/tzdata/America/Sitka275
-rw-r--r--library/tzdata/America/St_Barthelemy5
-rw-r--r--library/tzdata/America/St_Johns377
-rw-r--r--library/tzdata/America/St_Kitts9
-rw-r--r--library/tzdata/America/St_Lucia10
-rw-r--r--library/tzdata/America/St_Thomas9
-rw-r--r--library/tzdata/America/St_Vincent10
-rw-r--r--library/tzdata/America/Swift_Current4
-rw-r--r--library/tzdata/America/Tegucigalpa4
-rw-r--r--library/tzdata/America/Thule374
-rw-r--r--library/tzdata/America/Thunder_Bay374
-rw-r--r--library/tzdata/America/Tijuana364
-rw-r--r--library/tzdata/America/Toronto379
-rw-r--r--library/tzdata/America/Tortola9
-rw-r--r--library/tzdata/America/Vancouver377
-rw-r--r--library/tzdata/America/Virgin8
-rw-r--r--library/tzdata/America/Whitehorse376
-rw-r--r--library/tzdata/America/Winnipeg459
-rw-r--r--library/tzdata/America/Yakutat374
-rw-r--r--library/tzdata/America/Yellowknife383
-rw-r--r--library/tzdata/Antarctica/Casey6
-rw-r--r--library/tzdata/Antarctica/Davis6
-rw-r--r--library/tzdata/Antarctica/DumontDUrville2
-rw-r--r--library/tzdata/Antarctica/Macquarie97
-rw-r--r--library/tzdata/Antarctica/Mawson3
-rw-r--r--library/tzdata/Antarctica/McMurdo260
-rw-r--r--library/tzdata/Antarctica/Palmer380
-rw-r--r--library/tzdata/Antarctica/Rothera2
-rw-r--r--library/tzdata/Antarctica/South_Pole8
-rw-r--r--library/tzdata/Antarctica/Syowa2
-rw-r--r--library/tzdata/Antarctica/Vostok2
-rw-r--r--library/tzdata/Arctic/Longyearbyen2
-rw-r--r--library/tzdata/Asia/Aden6
-rw-r--r--library/tzdata/Asia/Almaty76
-rw-r--r--library/tzdata/Asia/Amman240
-rw-r--r--library/tzdata/Asia/Anadyr291
-rw-r--r--library/tzdata/Asia/Aqtau78
-rw-r--r--library/tzdata/Asia/Aqtobe76
-rw-r--r--library/tzdata/Asia/Ashgabat32
-rw-r--r--library/tzdata/Asia/Ashkhabad2
-rw-r--r--library/tzdata/Asia/Baghdad276
-rw-r--r--library/tzdata/Asia/Bahrain2
-rw-r--r--library/tzdata/Asia/Baku444
-rw-r--r--library/tzdata/Asia/Bangkok2
-rw-r--r--library/tzdata/Asia/Beirut2
-rw-r--r--library/tzdata/Asia/Bishkek230
-rw-r--r--library/tzdata/Asia/Brunei2
-rw-r--r--library/tzdata/Asia/Calcutta13
-rw-r--r--library/tzdata/Asia/Choibalsan246
-rw-r--r--library/tzdata/Asia/Chongqing2
-rw-r--r--library/tzdata/Asia/Chungking2
-rw-r--r--library/tzdata/Asia/Colombo3
-rw-r--r--library/tzdata/Asia/Dacca2
-rw-r--r--library/tzdata/Asia/Damascus374
-rw-r--r--library/tzdata/Asia/Dhaka5
-rw-r--r--library/tzdata/Asia/Dili10
-rw-r--r--library/tzdata/Asia/Dubai2
-rw-r--r--library/tzdata/Asia/Dushanbe32
-rw-r--r--library/tzdata/Asia/Gaza391
-rw-r--r--library/tzdata/Asia/Harbin2
-rw-r--r--library/tzdata/Asia/Hebron277
-rw-r--r--library/tzdata/Asia/Ho_Chi_Minh9
-rw-r--r--library/tzdata/Asia/Hong_Kong19
-rw-r--r--library/tzdata/Asia/Hovd246
-rw-r--r--library/tzdata/Asia/Irkutsk286
-rw-r--r--library/tzdata/Asia/Istanbul2
-rw-r--r--library/tzdata/Asia/Jakarta14
-rw-r--r--library/tzdata/Asia/Jayapura8
-rw-r--r--library/tzdata/Asia/Jerusalem200
-rw-r--r--library/tzdata/Asia/Kabul2
-rw-r--r--library/tzdata/Asia/Kamchatka287
-rw-r--r--library/tzdata/Asia/Karachi6
-rw-r--r--library/tzdata/Asia/Kashgar2
-rw-r--r--library/tzdata/Asia/Kathmandu7
-rw-r--r--library/tzdata/Asia/Katmandu10
-rw-r--r--library/tzdata/Asia/Khandyga72
-rw-r--r--library/tzdata/Asia/Kolkata10
-rw-r--r--library/tzdata/Asia/Krasnoyarsk286
-rw-r--r--library/tzdata/Asia/Kuala_Lumpur2
-rw-r--r--library/tzdata/Asia/Kuching2
-rw-r--r--library/tzdata/Asia/Kuwait2
-rw-r--r--library/tzdata/Asia/Macao2
-rw-r--r--library/tzdata/Asia/Macau2
-rw-r--r--library/tzdata/Asia/Magadan286
-rw-r--r--library/tzdata/Asia/Makassar6
-rw-r--r--library/tzdata/Asia/Manila2
-rw-r--r--library/tzdata/Asia/Muscat6
-rw-r--r--library/tzdata/Asia/Nicosia2
-rw-r--r--library/tzdata/Asia/Novokuznetsk71
-rw-r--r--library/tzdata/Asia/Novosibirsk286
-rw-r--r--library/tzdata/Asia/Omsk286
-rw-r--r--library/tzdata/Asia/Oral78
-rw-r--r--library/tzdata/Asia/Phnom_Penh2
-rw-r--r--library/tzdata/Asia/Pontianak14
-rw-r--r--library/tzdata/Asia/Pyongyang2
-rw-r--r--library/tzdata/Asia/Qatar2
-rw-r--r--library/tzdata/Asia/Qyzylorda76
-rw-r--r--library/tzdata/Asia/Rangoon6
-rw-r--r--library/tzdata/Asia/Riyadh2
-rw-r--r--library/tzdata/Asia/Saigon12
-rw-r--r--library/tzdata/Asia/Sakhalin287
-rw-r--r--library/tzdata/Asia/Samarkand47
-rw-r--r--library/tzdata/Asia/Seoul2
-rw-r--r--library/tzdata/Asia/Shanghai6
-rw-r--r--library/tzdata/Asia/Singapore2
-rw-r--r--library/tzdata/Asia/Taipei6
-rw-r--r--library/tzdata/Asia/Tashkent35
-rw-r--r--library/tzdata/Asia/Tbilisi225
-rw-r--r--library/tzdata/Asia/Tehran6
-rw-r--r--library/tzdata/Asia/Tel_Aviv2
-rw-r--r--library/tzdata/Asia/Thimbu2
-rw-r--r--library/tzdata/Asia/Thimphu2
-rw-r--r--library/tzdata/Asia/Tokyo10
-rw-r--r--library/tzdata/Asia/Ujung_Pandang2
-rw-r--r--library/tzdata/Asia/Ulaanbaatar246
-rw-r--r--library/tzdata/Asia/Ulan_Bator2
-rw-r--r--library/tzdata/Asia/Urumqi2
-rw-r--r--library/tzdata/Asia/Ust-Nera70
-rw-r--r--library/tzdata/Asia/Vientiane2
-rw-r--r--library/tzdata/Asia/Vladivostok286
-rw-r--r--library/tzdata/Asia/Yakutsk286
-rw-r--r--library/tzdata/Asia/Yekaterinburg286
-rw-r--r--library/tzdata/Asia/Yerevan281
-rw-r--r--library/tzdata/Atlantic/Azores252
-rw-r--r--library/tzdata/Atlantic/Bermuda379
-rw-r--r--library/tzdata/Atlantic/Canary2
-rw-r--r--library/tzdata/Atlantic/Cape_Verde2
-rw-r--r--library/tzdata/Atlantic/Faeroe248
-rw-r--r--library/tzdata/Atlantic/Faroe245
-rw-r--r--library/tzdata/Atlantic/Jan_Mayen2
-rw-r--r--library/tzdata/Atlantic/Madeira190
-rw-r--r--library/tzdata/Atlantic/Reykjavik112
-rw-r--r--library/tzdata/Atlantic/South_Georgia2
-rw-r--r--library/tzdata/Atlantic/St_Helena2
-rw-r--r--library/tzdata/Atlantic/Stanley182
-rw-r--r--library/tzdata/Australia/ACT2
-rw-r--r--library/tzdata/Australia/Adelaide516
-rw-r--r--library/tzdata/Australia/Brisbane18
-rw-r--r--library/tzdata/Australia/Broken_Hill516
-rw-r--r--library/tzdata/Australia/Canberra2
-rw-r--r--library/tzdata/Australia/Currie273
-rw-r--r--library/tzdata/Australia/Darwin2
-rw-r--r--library/tzdata/Australia/Eucla25
-rw-r--r--library/tzdata/Australia/Hobart532
-rw-r--r--library/tzdata/Australia/LHI2
-rw-r--r--library/tzdata/Australia/Lindeman26
-rw-r--r--library/tzdata/Australia/Lord_Howe372
-rw-r--r--library/tzdata/Australia/Melbourne516
-rw-r--r--library/tzdata/Australia/NSW2
-rw-r--r--library/tzdata/Australia/North2
-rw-r--r--library/tzdata/Australia/Perth22
-rw-r--r--library/tzdata/Australia/Queensland2
-rw-r--r--library/tzdata/Australia/South2
-rw-r--r--library/tzdata/Australia/Sydney516
-rw-r--r--library/tzdata/Australia/Tasmania2
-rw-r--r--library/tzdata/Australia/Victoria2
-rw-r--r--library/tzdata/Australia/West2
-rw-r--r--library/tzdata/Australia/Yancowinna2
-rw-r--r--library/tzdata/Brazil/Acre2
-rw-r--r--library/tzdata/Brazil/DeNoronha2
-rw-r--r--library/tzdata/Brazil/East2
-rw-r--r--library/tzdata/Brazil/West2
-rw-r--r--library/tzdata/CET516
-rw-r--r--library/tzdata/CST6CDT281
-rw-r--r--library/tzdata/Canada/Atlantic2
-rw-r--r--library/tzdata/Canada/Central2
-rw-r--r--library/tzdata/Canada/East-Saskatchewan2
-rw-r--r--library/tzdata/Canada/Eastern2
-rw-r--r--library/tzdata/Canada/Mountain2
-rw-r--r--library/tzdata/Canada/Newfoundland2
-rw-r--r--library/tzdata/Canada/Pacific2
-rw-r--r--library/tzdata/Canada/Saskatchewan2
-rw-r--r--library/tzdata/Canada/Yukon2
-rw-r--r--library/tzdata/Chile/Continental2
-rw-r--r--library/tzdata/Chile/EasterIsland2
-rw-r--r--library/tzdata/Cuba2
-rw-r--r--library/tzdata/EET2
-rw-r--r--library/tzdata/EST8
-rw-r--r--library/tzdata/EST5EDT281
-rw-r--r--library/tzdata/Egypt2
-rw-r--r--library/tzdata/Eire2
-rw-r--r--library/tzdata/Etc/GMT2
-rw-r--r--library/tzdata/Etc/GMT+02
-rw-r--r--library/tzdata/Etc/GMT+12
-rw-r--r--library/tzdata/Etc/GMT+102
-rw-r--r--library/tzdata/Etc/GMT+112
-rw-r--r--library/tzdata/Etc/GMT+122
-rw-r--r--library/tzdata/Etc/GMT+22
-rw-r--r--library/tzdata/Etc/GMT+32
-rw-r--r--library/tzdata/Etc/GMT+42
-rw-r--r--library/tzdata/Etc/GMT+52
-rw-r--r--library/tzdata/Etc/GMT+62
-rw-r--r--library/tzdata/Etc/GMT+72
-rw-r--r--library/tzdata/Etc/GMT+82
-rw-r--r--library/tzdata/Etc/GMT+92
-rw-r--r--library/tzdata/Etc/GMT-02
-rw-r--r--library/tzdata/Etc/GMT-12
-rw-r--r--library/tzdata/Etc/GMT-102
-rw-r--r--library/tzdata/Etc/GMT-112
-rw-r--r--library/tzdata/Etc/GMT-122
-rw-r--r--library/tzdata/Etc/GMT-132
-rw-r--r--library/tzdata/Etc/GMT-142
-rw-r--r--library/tzdata/Etc/GMT-22
-rw-r--r--library/tzdata/Etc/GMT-32
-rw-r--r--library/tzdata/Etc/GMT-42
-rw-r--r--library/tzdata/Etc/GMT-52
-rw-r--r--library/tzdata/Etc/GMT-62
-rw-r--r--library/tzdata/Etc/GMT-72
-rw-r--r--library/tzdata/Etc/GMT-82
-rw-r--r--library/tzdata/Etc/GMT-92
-rw-r--r--library/tzdata/Etc/GMT02
-rw-r--r--library/tzdata/Etc/Greenwich2
-rw-r--r--library/tzdata/Etc/UCT2
-rw-r--r--library/tzdata/Etc/UTC2
-rw-r--r--library/tzdata/Etc/Universal2
-rw-r--r--library/tzdata/Etc/Zulu2
-rw-r--r--library/tzdata/Europe/Amsterdam109
-rw-r--r--library/tzdata/Europe/Andorra2
-rw-r--r--library/tzdata/Europe/Athens16
-rw-r--r--library/tzdata/Europe/Belfast375
-rw-r--r--library/tzdata/Europe/Belgrade17
-rw-r--r--library/tzdata/Europe/Berlin46
-rw-r--r--library/tzdata/Europe/Bratislava2
-rw-r--r--library/tzdata/Europe/Brussels28
-rw-r--r--library/tzdata/Europe/Bucharest86
-rw-r--r--library/tzdata/Europe/Budapest41
-rw-r--r--library/tzdata/Europe/Busingen5
-rw-r--r--library/tzdata/Europe/Chisinau68
-rw-r--r--library/tzdata/Europe/Copenhagen31
-rw-r--r--library/tzdata/Europe/Dublin4
-rw-r--r--library/tzdata/Europe/Gibraltar2
-rw-r--r--library/tzdata/Europe/Guernsey5
-rw-r--r--library/tzdata/Europe/Helsinki12
-rw-r--r--library/tzdata/Europe/Isle_of_Man5
-rw-r--r--library/tzdata/Europe/Istanbul92
-rw-r--r--library/tzdata/Europe/Jersey5
-rw-r--r--library/tzdata/Europe/Kaliningrad304
-rw-r--r--library/tzdata/Europe/Kiev30
-rw-r--r--library/tzdata/Europe/Lisbon2
-rw-r--r--library/tzdata/Europe/Ljubljana2
-rw-r--r--library/tzdata/Europe/London2
-rw-r--r--library/tzdata/Europe/Luxembourg22
-rw-r--r--library/tzdata/Europe/Madrid2
-rw-r--r--library/tzdata/Europe/Malta59
-rw-r--r--library/tzdata/Europe/Mariehamn2
-rw-r--r--library/tzdata/Europe/Minsk291
-rw-r--r--library/tzdata/Europe/Monaco2
-rw-r--r--library/tzdata/Europe/Moscow286
-rw-r--r--library/tzdata/Europe/Nicosia2
-rw-r--r--library/tzdata/Europe/Oslo45
-rw-r--r--library/tzdata/Europe/Paris10
-rw-r--r--library/tzdata/Europe/Podgorica5
-rw-r--r--library/tzdata/Europe/Prague42
-rw-r--r--library/tzdata/Europe/Riga62
-rw-r--r--library/tzdata/Europe/Rome68
-rw-r--r--library/tzdata/Europe/Samara290
-rw-r--r--library/tzdata/Europe/San_Marino2
-rw-r--r--library/tzdata/Europe/Sarajevo2
-rw-r--r--library/tzdata/Europe/Simferopol34
-rw-r--r--library/tzdata/Europe/Skopje2
-rw-r--r--library/tzdata/Europe/Sofia46
-rw-r--r--library/tzdata/Europe/Stockholm2
-rw-r--r--library/tzdata/Europe/Tallinn70
-rw-r--r--library/tzdata/Europe/Tirane2
-rw-r--r--library/tzdata/Europe/Tiraspol2
-rw-r--r--library/tzdata/Europe/Uzhgorod34
-rw-r--r--library/tzdata/Europe/Vaduz248
-rw-r--r--library/tzdata/Europe/Vatican2
-rw-r--r--library/tzdata/Europe/Vienna46
-rw-r--r--library/tzdata/Europe/Vilnius64
-rw-r--r--library/tzdata/Europe/Volgograd70
-rw-r--r--library/tzdata/Europe/Warsaw116
-rw-r--r--library/tzdata/Europe/Zagreb2
-rw-r--r--library/tzdata/Europe/Zaporozhye34
-rw-r--r--library/tzdata/Europe/Zurich16
-rw-r--r--library/tzdata/GB2
-rw-r--r--library/tzdata/GB-Eire2
-rw-r--r--library/tzdata/GMT2
-rw-r--r--library/tzdata/GMT+02
-rw-r--r--library/tzdata/GMT-02
-rw-r--r--library/tzdata/GMT02
-rw-r--r--library/tzdata/Greenwich2
-rw-r--r--library/tzdata/HST8
-rw-r--r--library/tzdata/Hongkong2
-rw-r--r--library/tzdata/Iceland2
-rw-r--r--library/tzdata/Indian/Antananarivo6
-rw-r--r--library/tzdata/Indian/Chagos2
-rw-r--r--library/tzdata/Indian/Christmas2
-rw-r--r--library/tzdata/Indian/Cocos2
-rw-r--r--library/tzdata/Indian/Comoro2
-rw-r--r--library/tzdata/Indian/Kerguelen2
-rw-r--r--library/tzdata/Indian/Mahe2
-rw-r--r--library/tzdata/Indian/Maldives2
-rw-r--r--library/tzdata/Indian/Mauritius6
-rw-r--r--library/tzdata/Indian/Mayotte2
-rw-r--r--library/tzdata/Indian/Reunion2
-rw-r--r--library/tzdata/Iran2
-rw-r--r--library/tzdata/Israel2
-rw-r--r--library/tzdata/Jamaica2
-rw-r--r--library/tzdata/Japan2
-rw-r--r--library/tzdata/Kwajalein2
-rw-r--r--library/tzdata/Libya2
-rw-r--r--library/tzdata/MET516
-rw-r--r--library/tzdata/MST8
-rw-r--r--library/tzdata/MST7MDT281
-rw-r--r--library/tzdata/Mexico/BajaNorte2
-rw-r--r--library/tzdata/Mexico/BajaSur2
-rw-r--r--library/tzdata/Mexico/General2
-rw-r--r--library/tzdata/NZ2
-rw-r--r--library/tzdata/NZ-CHAT2
-rw-r--r--library/tzdata/Navajo2
-rw-r--r--library/tzdata/PRC2
-rw-r--r--library/tzdata/PST8PDT281
-rw-r--r--library/tzdata/Pacific/Apia182
-rw-r--r--library/tzdata/Pacific/Auckland504
-rw-r--r--library/tzdata/Pacific/Chatham504
-rw-r--r--library/tzdata/Pacific/Chuuk6
-rw-r--r--library/tzdata/Pacific/Easter400
-rw-r--r--library/tzdata/Pacific/Efate2
-rw-r--r--library/tzdata/Pacific/Enderbury2
-rw-r--r--library/tzdata/Pacific/Fakaofo5
-rw-r--r--library/tzdata/Pacific/Fiji187
-rw-r--r--library/tzdata/Pacific/Funafuti2
-rw-r--r--library/tzdata/Pacific/Galapagos2
-rw-r--r--library/tzdata/Pacific/Gambier2
-rw-r--r--library/tzdata/Pacific/Guadalcanal2
-rw-r--r--library/tzdata/Pacific/Guam2
-rw-r--r--library/tzdata/Pacific/Honolulu9
-rw-r--r--library/tzdata/Pacific/Johnston8
-rw-r--r--library/tzdata/Pacific/Kiritimati2
-rw-r--r--library/tzdata/Pacific/Kosrae2
-rw-r--r--library/tzdata/Pacific/Kwajalein2
-rw-r--r--library/tzdata/Pacific/Majuro2
-rw-r--r--library/tzdata/Pacific/Marquesas2
-rw-r--r--library/tzdata/Pacific/Midway2
-rw-r--r--library/tzdata/Pacific/Nauru2
-rw-r--r--library/tzdata/Pacific/Niue2
-rw-r--r--library/tzdata/Pacific/Norfolk2
-rw-r--r--library/tzdata/Pacific/Noumea6
-rw-r--r--library/tzdata/Pacific/Pago_Pago2
-rw-r--r--library/tzdata/Pacific/Palau2
-rw-r--r--library/tzdata/Pacific/Pitcairn2
-rw-r--r--library/tzdata/Pacific/Pohnpei6
-rw-r--r--library/tzdata/Pacific/Ponape9
-rw-r--r--library/tzdata/Pacific/Port_Moresby2
-rw-r--r--library/tzdata/Pacific/Rarotonga2
-rw-r--r--library/tzdata/Pacific/Saipan2
-rw-r--r--library/tzdata/Pacific/Samoa2
-rw-r--r--library/tzdata/Pacific/Tahiti2
-rw-r--r--library/tzdata/Pacific/Tarawa2
-rw-r--r--library/tzdata/Pacific/Tongatapu6
-rw-r--r--library/tzdata/Pacific/Truk9
-rw-r--r--library/tzdata/Pacific/Wake2
-rw-r--r--library/tzdata/Pacific/Wallis2
-rw-r--r--library/tzdata/Pacific/Yap10
-rw-r--r--library/tzdata/Poland2
-rw-r--r--library/tzdata/Portugal2
-rw-r--r--library/tzdata/ROC2
-rw-r--r--library/tzdata/ROK2
-rw-r--r--library/tzdata/Singapore2
-rw-r--r--library/tzdata/Turkey2
-rw-r--r--library/tzdata/UCT2
-rw-r--r--library/tzdata/US/Alaska2
-rw-r--r--library/tzdata/US/Aleutian2
-rw-r--r--library/tzdata/US/Arizona2
-rw-r--r--library/tzdata/US/Central2
-rw-r--r--library/tzdata/US/East-Indiana8
-rw-r--r--library/tzdata/US/Eastern2
-rw-r--r--library/tzdata/US/Hawaii2
-rw-r--r--library/tzdata/US/Indiana-Starke2
-rw-r--r--library/tzdata/US/Michigan2
-rw-r--r--library/tzdata/US/Mountain2
-rw-r--r--library/tzdata/US/Pacific2
-rw-r--r--library/tzdata/US/Pacific-New2
-rw-r--r--library/tzdata/US/Samoa2
-rw-r--r--library/tzdata/UTC2
-rw-r--r--library/tzdata/Universal2
-rw-r--r--library/tzdata/W-SU2
-rw-r--r--library/tzdata/WET2
-rw-r--r--library/tzdata/Zulu2
-rw-r--r--library/word.tcl144
-rw-r--r--libtommath/bn.pdfbin340681 -> 340921 bytes
-rw-r--r--libtommath/bn.tex2
-rw-r--r--libtommath/bn_error.c6
-rw-r--r--libtommath/bn_fast_mp_invmod.c6
-rw-r--r--libtommath/bn_fast_mp_montgomery_reduce.c6
-rw-r--r--libtommath/bn_fast_s_mp_mul_digs.c11
-rw-r--r--libtommath/bn_fast_s_mp_mul_high_digs.c11
-rw-r--r--libtommath/bn_fast_s_mp_sqr.c6
-rw-r--r--libtommath/bn_mp_2expt.c6
-rw-r--r--libtommath/bn_mp_abs.c6
-rw-r--r--libtommath/bn_mp_add.c6
-rw-r--r--libtommath/bn_mp_add_d.c14
-rw-r--r--libtommath/bn_mp_addmod.c6
-rw-r--r--libtommath/bn_mp_and.c6
-rw-r--r--libtommath/bn_mp_clamp.c6
-rw-r--r--libtommath/bn_mp_clear.c6
-rw-r--r--libtommath/bn_mp_clear_multi.c6
-rw-r--r--libtommath/bn_mp_cmp.c8
-rw-r--r--libtommath/bn_mp_cmp_d.c8
-rw-r--r--libtommath/bn_mp_cmp_mag.c8
-rw-r--r--libtommath/bn_mp_cnt_lsb.c8
-rw-r--r--libtommath/bn_mp_copy.c8
-rw-r--r--libtommath/bn_mp_count_bits.c8
-rw-r--r--libtommath/bn_mp_div.c6
-rw-r--r--libtommath/bn_mp_div_2.c6
-rw-r--r--libtommath/bn_mp_div_2d.c8
-rw-r--r--libtommath/bn_mp_div_3.c6
-rw-r--r--libtommath/bn_mp_div_d.c10
-rw-r--r--libtommath/bn_mp_dr_is_modulus.c6
-rw-r--r--libtommath/bn_mp_dr_reduce.c6
-rw-r--r--libtommath/bn_mp_dr_setup.c6
-rw-r--r--libtommath/bn_mp_exch.c6
-rw-r--r--libtommath/bn_mp_expt_d.c6
-rw-r--r--libtommath/bn_mp_exptmod.c6
-rw-r--r--libtommath/bn_mp_exptmod_fast.c7
-rw-r--r--libtommath/bn_mp_exteuclid.c6
-rw-r--r--libtommath/bn_mp_fread.c6
-rw-r--r--libtommath/bn_mp_fwrite.c6
-rw-r--r--libtommath/bn_mp_gcd.c18
-rw-r--r--libtommath/bn_mp_get_int.c6
-rw-r--r--libtommath/bn_mp_grow.c6
-rw-r--r--libtommath/bn_mp_init.c6
-rw-r--r--libtommath/bn_mp_init_copy.c6
-rw-r--r--libtommath/bn_mp_init_multi.c6
-rw-r--r--libtommath/bn_mp_init_set.c6
-rw-r--r--libtommath/bn_mp_init_set_int.c6
-rw-r--r--libtommath/bn_mp_init_size.c6
-rw-r--r--libtommath/bn_mp_invmod.c6
-rw-r--r--libtommath/bn_mp_invmod_slow.c6
-rw-r--r--libtommath/bn_mp_is_square.c6
-rw-r--r--libtommath/bn_mp_jacobi.c6
-rw-r--r--libtommath/bn_mp_karatsuba_mul.c6
-rw-r--r--libtommath/bn_mp_karatsuba_sqr.c6
-rw-r--r--libtommath/bn_mp_lcm.c6
-rw-r--r--libtommath/bn_mp_lshd.c6
-rw-r--r--libtommath/bn_mp_mod.c6
-rw-r--r--libtommath/bn_mp_mod_2d.c8
-rw-r--r--libtommath/bn_mp_mod_d.c6
-rw-r--r--libtommath/bn_mp_montgomery_calc_normalization.c6
-rw-r--r--libtommath/bn_mp_montgomery_reduce.c6
-rw-r--r--libtommath/bn_mp_montgomery_setup.c8
-rw-r--r--libtommath/bn_mp_mul.c6
-rw-r--r--libtommath/bn_mp_mul_2.c6
-rw-r--r--libtommath/bn_mp_mul_2d.c8
-rw-r--r--libtommath/bn_mp_mul_d.c6
-rw-r--r--libtommath/bn_mp_mulmod.c6
-rw-r--r--libtommath/bn_mp_n_root.c6
-rw-r--r--libtommath/bn_mp_neg.c8
-rw-r--r--libtommath/bn_mp_or.c6
-rw-r--r--libtommath/bn_mp_prime_fermat.c6
-rw-r--r--libtommath/bn_mp_prime_is_divisible.c6
-rw-r--r--libtommath/bn_mp_prime_is_prime.c6
-rw-r--r--libtommath/bn_mp_prime_miller_rabin.c6
-rw-r--r--libtommath/bn_mp_prime_next_prime.c8
-rw-r--r--libtommath/bn_mp_prime_rabin_miller_trials.c6
-rw-r--r--libtommath/bn_mp_prime_random_ex.c6
-rw-r--r--libtommath/bn_mp_radix_size.c8
-rw-r--r--libtommath/bn_mp_radix_smap.c6
-rw-r--r--libtommath/bn_mp_rand.c6
-rw-r--r--libtommath/bn_mp_read_radix.c11
-rw-r--r--libtommath/bn_mp_read_signed_bin.c6
-rw-r--r--libtommath/bn_mp_read_unsigned_bin.c6
-rw-r--r--libtommath/bn_mp_reduce.c6
-rw-r--r--libtommath/bn_mp_reduce_2k.c6
-rw-r--r--libtommath/bn_mp_reduce_2k_l.c6
-rw-r--r--libtommath/bn_mp_reduce_2k_setup.c6
-rw-r--r--libtommath/bn_mp_reduce_2k_setup_l.c6
-rw-r--r--libtommath/bn_mp_reduce_is_2k.c6
-rw-r--r--libtommath/bn_mp_reduce_is_2k_l.c6
-rw-r--r--libtommath/bn_mp_reduce_setup.c6
-rw-r--r--libtommath/bn_mp_rshd.c6
-rw-r--r--libtommath/bn_mp_set.c6
-rw-r--r--libtommath/bn_mp_set_int.c6
-rw-r--r--libtommath/bn_mp_shrink.c17
-rw-r--r--libtommath/bn_mp_signed_bin_size.c6
-rw-r--r--libtommath/bn_mp_sqr.c6
-rw-r--r--libtommath/bn_mp_sqrmod.c6
-rw-r--r--libtommath/bn_mp_sqrt.c83
-rw-r--r--libtommath/bn_mp_sub.c6
-rw-r--r--libtommath/bn_mp_sub_d.c10
-rw-r--r--libtommath/bn_mp_submod.c6
-rw-r--r--libtommath/bn_mp_to_signed_bin.c6
-rw-r--r--libtommath/bn_mp_to_signed_bin_n.c6
-rw-r--r--libtommath/bn_mp_to_unsigned_bin.c6
-rw-r--r--libtommath/bn_mp_to_unsigned_bin_n.c6
-rw-r--r--libtommath/bn_mp_toom_mul.c6
-rw-r--r--libtommath/bn_mp_toom_sqr.c6
-rw-r--r--libtommath/bn_mp_toradix.c6
-rw-r--r--libtommath/bn_mp_toradix_n.c21
-rw-r--r--libtommath/bn_mp_unsigned_bin_size.c6
-rw-r--r--libtommath/bn_mp_xor.c6
-rw-r--r--libtommath/bn_mp_zero.c6
-rw-r--r--libtommath/bn_prime_tab.c6
-rw-r--r--libtommath/bn_reverse.c6
-rw-r--r--libtommath/bn_s_mp_add.c6
-rw-r--r--libtommath/bn_s_mp_exptmod.c6
-rw-r--r--libtommath/bn_s_mp_mul_digs.c6
-rw-r--r--libtommath/bn_s_mp_mul_high_digs.c6
-rw-r--r--libtommath/bn_s_mp_sqr.c6
-rw-r--r--libtommath/bn_s_mp_sub.c6
-rw-r--r--libtommath/bncore.c6
-rw-r--r--libtommath/booker.pl2
-rw-r--r--libtommath/changes.txt31
-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.c6
-rw-r--r--libtommath/etc/mont.c9
-rw-r--r--libtommath/etc/pprime.c8
-rw-r--r--libtommath/etc/tune.c6
-rw-r--r--libtommath/logs/index.html3
-rw-r--r--libtommath/makefile24
-rw-r--r--libtommath/makefile.bcc2
-rw-r--r--libtommath/makefile.cygwin_dll4
-rw-r--r--libtommath/makefile.shared13
-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.c8
-rw-r--r--libtommath/mtest/mpi.h6
-rw-r--r--libtommath/mtest/mtest.c4
-rw-r--r--libtommath/poster.pdfbin37805 -> 37822 bytes
-rw-r--r--libtommath/pre_gen/mpi.c787
-rw-r--r--libtommath/tommath.h81
-rw-r--r--libtommath/tommath.pdfbin1159821 -> 1194158 bytes
-rw-r--r--libtommath/tommath.src138
-rw-r--r--libtommath/tommath.tex4521
-rw-r--r--libtommath/tommath_class.h4
-rw-r--r--libtommath/tommath_superclass.h4
-rw-r--r--license.terms2
-rw-r--r--macosx/GNUmakefile (renamed from macosx/Makefile)78
-rw-r--r--macosx/README232
-rw-r--r--macosx/Tcl-Common.xcconfig37
-rw-r--r--macosx/Tcl-Debug.xcconfig20
-rw-r--r--macosx/Tcl-Info.plist.in15
-rw-r--r--macosx/Tcl-Release.xcconfig20
-rw-r--r--macosx/Tcl.pbproj/jingham.pbxuser79
-rw-r--r--macosx/Tcl.pbproj/project.pbxproj1285
-rw-r--r--macosx/Tcl.xcode/default.pbxuser200
-rw-r--r--macosx/Tcl.xcode/project.pbxproj2936
-rw-r--r--macosx/Tcl.xcodeproj/default.pbxuser211
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj3041
-rw-r--r--macosx/Tclsh-Info.plist.in36
-rw-r--r--macosx/configure.ac11
-rw-r--r--macosx/tclMacOSXBundle.c288
-rw-r--r--macosx/tclMacOSXFCmd.c523
-rw-r--r--macosx/tclMacOSXNotify.c1634
-rw-r--r--pkgs/README57
-rw-r--r--pkgs/package.list.txt35
-rw-r--r--tests/README2
-rw-r--r--tests/all.tcl6
-rw-r--r--tests/append.test252
-rw-r--r--tests/appendComp.test281
-rw-r--r--tests/apply.test321
-rw-r--r--tests/assemble.test3292
-rw-r--r--tests/assemble1.bench85
-rw-r--r--tests/assocd.test35
-rw-r--r--tests/async.test76
-rw-r--r--tests/autoMkindex.test301
-rw-r--r--tests/basic.test208
-rw-r--r--tests/binary.test2115
-rw-r--r--tests/case.test8
-rw-r--r--tests/chan.test189
-rw-r--r--tests/chanio.test7723
-rw-r--r--tests/clock.test7418
-rw-r--r--tests/cmdAH.test1263
-rw-r--r--tests/cmdIL.test476
-rw-r--r--tests/cmdInfo.test29
-rw-r--r--tests/cmdMZ.test293
-rw-r--r--tests/compExpr-old.test295
-rw-r--r--tests/compExpr.test336
-rw-r--r--tests/compile.test556
-rw-r--r--tests/concat.test23
-rw-r--r--tests/config.test6
-rw-r--r--tests/coroutine.test739
-rw-r--r--tests/dcall.test13
-rw-r--r--tests/dict.test2111
-rw-r--r--tests/dstring.test271
-rw-r--r--tests/encoding.test278
-rw-r--r--tests/env.test315
-rw-r--r--tests/error.test1085
-rw-r--r--tests/eval.test29
-rw-r--r--tests/event.test663
-rw-r--r--tests/exec.test562
-rw-r--r--tests/execute.test540
-rw-r--r--tests/expr-old.test359
-rw-r--r--tests/expr.test1567
-rw-r--r--tests/fCmd.test2602
-rw-r--r--tests/fileName.test1374
-rw-r--r--tests/fileSystem.test902
-rw-r--r--tests/for-old.test2
-rw-r--r--tests/for.test414
-rw-r--r--tests/foreach.test68
-rw-r--r--tests/format.test74
-rw-r--r--tests/get.test5
-rw-r--r--tests/history.test18
-rw-r--r--tests/http.test557
-rw-r--r--tests/http11.test656
-rw-r--r--tests/httpd41
-rw-r--r--tests/httpd11.tcl254
-rw-r--r--tests/httpold.test2
-rw-r--r--tests/if-old.test2
-rw-r--r--tests/if.test701
-rw-r--r--tests/incr-old.test15
-rw-r--r--tests/incr.test277
-rw-r--r--tests/indexObj.test73
-rw-r--r--tests/info.test2169
-rw-r--r--tests/init.test156
-rw-r--r--tests/interp.test1407
-rw-r--r--tests/io.test703
-rw-r--r--tests/ioCmd.test2643
-rw-r--r--tests/ioTrans.test1918
-rw-r--r--tests/ioUtil.test310
-rw-r--r--tests/iogt.test527
-rw-r--r--tests/join.test17
-rw-r--r--tests/lindex.test138
-rw-r--r--tests/link.test164
-rw-r--r--tests/linsert.test12
-rw-r--r--tests/list.test26
-rw-r--r--tests/listObj.test33
-rw-r--r--tests/llength.test2
-rw-r--r--tests/lmap.test471
-rw-r--r--tests/load.test81
-rw-r--r--tests/lrange.test15
-rw-r--r--tests/lrepeat.test25
-rw-r--r--tests/lreplace.test6
-rw-r--r--tests/lsearch.test171
-rw-r--r--tests/lset.test174
-rw-r--r--[-rwxr-xr-x]tests/lsetComp.test4
-rw-r--r--tests/macOSXFCmd.test66
-rw-r--r--tests/macOSXLoad.test33
-rw-r--r--tests/main.test107
-rw-r--r--tests/mathop.test1340
-rw-r--r--tests/misc.test14
-rw-r--r--tests/msgcat.test75
-rw-r--r--tests/namespace-old.test163
-rw-r--r--tests/namespace.test902
-rw-r--r--[-rwxr-xr-x]tests/notify.test5
-rw-r--r--tests/nre.test426
-rw-r--r--tests/obj.test28
-rw-r--r--tests/oo.test3512
-rw-r--r--tests/ooNext2.test788
-rw-r--r--tests/opt.test30
-rw-r--r--tests/package.test1258
-rw-r--r--tests/parse.test331
-rw-r--r--tests/parseExpr.test762
-rw-r--r--tests/parseOld.test32
-rw-r--r--tests/pid.test2
-rw-r--r--tests/pkg.test673
-rw-r--r--tests/pkgMkIndex.test151
-rw-r--r--tests/platform.test38
-rw-r--r--tests/proc-old.test43
-rw-r--r--tests/proc.test418
-rw-r--r--tests/pwd.test2
-rw-r--r--tests/reg.test207
-rw-r--r--tests/regexp.test569
-rw-r--r--tests/regexpComp.test211
-rw-r--r--tests/registry.test762
-rw-r--r--tests/remote.tcl45
-rw-r--r--tests/rename.test89
-rw-r--r--tests/resolver.test203
-rw-r--r--tests/result.test64
-rw-r--r--tests/safe.test1027
-rw-r--r--tests/scan.test737
-rw-r--r--tests/security.test16
-rw-r--r--tests/set-old.test40
-rw-r--r--tests/set.test37
-rw-r--r--tests/socket.test1471
-rw-r--r--tests/source.test65
-rw-r--r--tests/split.test24
-rw-r--r--tests/stack.test94
-rw-r--r--tests/string.test593
-rw-r--r--tests/stringComp.test392
-rw-r--r--tests/stringObj.test169
-rw-r--r--tests/subst.test139
-rw-r--r--tests/switch.test563
-rw-r--r--tests/tailcall.test666
-rw-r--r--[-rwxr-xr-x]tests/tcltest.test199
-rw-r--r--tests/thread.test1478
-rw-r--r--tests/timer.test290
-rw-r--r--tests/tm.test12
-rw-r--r--tests/trace.test749
-rw-r--r--tests/unixFCmd.test381
-rw-r--r--tests/unixFile.test5
-rw-r--r--tests/unixForkEvent.test45
-rw-r--r--tests/unixInit.test201
-rw-r--r--tests/unixNotfy.test26
-rw-r--r--tests/unknown.test22
-rw-r--r--tests/unload.test83
-rw-r--r--tests/uplevel.test118
-rw-r--r--tests/upvar.test271
-rw-r--r--tests/utf.test203
-rw-r--r--tests/util.test2945
-rw-r--r--tests/var.test553
-rw-r--r--tests/while-old.test4
-rw-r--r--tests/while.test385
-rw-r--r--tests/winConsole.test4
-rw-r--r--tests/winDde.test304
-rw-r--r--tests/winFCmd.test1490
-rw-r--r--tests/winFile.test162
-rw-r--r--tests/winNotify.test5
-rw-r--r--tests/winPipe.test112
-rw-r--r--tests/winTime.test5
-rw-r--r--tests/zlib.test878
-rw-r--r--tools/Makefile.in2
-rw-r--r--tools/README3
-rwxr-xr-xtools/checkLibraryDoc.tcl30
-rwxr-xr-xtools/configure268
-rw-r--r--tools/configure.in5
-rw-r--r--tools/encoding/big5.txt2
-rw-r--r--[-rwxr-xr-x]tools/encoding/ebcdic.txt0
-rw-r--r--tools/encoding/gb2312.txt2
-rw-r--r--[-rwxr-xr-x]tools/encoding/tis-620.txt0
-rw-r--r--tools/eolFix.tcl18
-rwxr-xr-xtools/findBadExternals.tcl53
-rwxr-xr-xtools/fix_tommath_h.tcl114
-rw-r--r--tools/genStubs.tcl717
-rw-r--r--tools/genWinImage.tcl157
-rw-r--r--tools/index.tcl13
-rw-r--r--tools/installData.tcl27
-rwxr-xr-xtools/loadICU.tcl23
-rwxr-xr-xtools/makeTestCases.tcl38
-rw-r--r--tools/man2help.tcl6
-rw-r--r--tools/man2help2.tcl102
-rw-r--r--tools/man2html.tcl3
-rw-r--r--tools/man2html1.tcl3
-rw-r--r--tools/man2html2.tcl333
-rw-r--r--tools/man2tcl.c252
-rw-r--r--tools/mkdepend.tcl420
-rw-r--r--tools/regexpTestLib.tcl33
-rw-r--r--tools/str2c8
-rw-r--r--tools/tcl.hpj.in4
-rw-r--r--tools/tcl.wse.in2376
-rw-r--r--tools/tclSplash.bmpbin162030 -> 0 bytes
-rwxr-xr-xtools/tclZIC.tcl53
-rw-r--r--tools/tclmin.wse247
-rw-r--r--tools/tclsh.svg67
-rw-r--r--tools/tcltk-man2html-utils.tcl1629
-rwxr-xr-xtools/tcltk-man2html.tcl2109
-rw-r--r--tools/tsdPerf.c59
-rw-r--r--tools/tsdPerf.tcl24
-rw-r--r--tools/uniClass.tcl53
-rw-r--r--tools/uniParse.tcl159
-rw-r--r--unix/Makefile.in1745
-rw-r--r--unix/README230
-rw-r--r--unix/aclocal.m42
-rwxr-xr-xunix/configure8642
-rw-r--r--unix/configure.in651
-rw-r--r--unix/dltest/Makefile.in88
-rw-r--r--unix/dltest/README2
-rw-r--r--unix/dltest/pkga.c81
-rw-r--r--unix/dltest/pkgb.c126
-rw-r--r--unix/dltest/pkgc.c96
-rw-r--r--unix/dltest/pkgd.c93
-rw-r--r--unix/dltest/pkge.c38
-rw-r--r--unix/dltest/pkgf.c53
-rw-r--r--unix/dltest/pkgooa.c141
-rw-r--r--unix/dltest/pkgua.c167
-rwxr-xr-xunix/install-sh580
-rwxr-xr-xunix/installManPage132
-rwxr-xr-xunix/ldAix40
-rw-r--r--unix/tcl.m42306
-rw-r--r--unix/tcl.pc.in15
-rw-r--r--unix/tcl.spec49
-rw-r--r--unix/tclAppInit.c116
-rw-r--r--unix/tclConfig.h.in278
-rw-r--r--unix/tclConfig.sh.in15
-rw-r--r--unix/tclLoadAix.c45
-rw-r--r--unix/tclLoadDl.c145
-rw-r--r--unix/tclLoadDld.c209
-rw-r--r--unix/tclLoadDyld.c626
-rw-r--r--unix/tclLoadNext.c91
-rw-r--r--unix/tclLoadOSF.c86
-rw-r--r--unix/tclLoadShl.c87
-rw-r--r--unix/tclUnixChan.c2461
-rw-r--r--unix/tclUnixCompat.c1022
-rw-r--r--unix/tclUnixEvent.c13
-rw-r--r--unix/tclUnixFCmd.c1315
-rw-r--r--unix/tclUnixFile.c580
-rw-r--r--unix/tclUnixInit.c570
-rw-r--r--unix/tclUnixNotfy.c1096
-rw-r--r--unix/tclUnixPipe.c568
-rw-r--r--unix/tclUnixPort.h596
-rw-r--r--unix/tclUnixSock.c1441
-rw-r--r--unix/tclUnixTest.c462
-rw-r--r--unix/tclUnixThrd.c263
-rw-r--r--unix/tclUnixThrd.h2
-rw-r--r--unix/tclUnixTime.c292
-rw-r--r--unix/tclXtNotify.c110
-rw-r--r--unix/tclXtTest.c79
-rw-r--r--unix/tclooConfig.sh19
-rw-r--r--win/.cvsignore17
-rw-r--r--win/Makefile.in557
-rw-r--r--win/README100
-rw-r--r--win/README.binary143
-rw-r--r--[-rwxr-xr-x]win/buildall.vc.bat81
-rw-r--r--win/cat.c16
-rw-r--r--win/coffbase.txt19
-rwxr-xr-xwin/configure3097
-rw-r--r--win/configure.in431
-rw-r--r--win/makefile.bc136
-rw-r--r--win/makefile.vc810
-rw-r--r--win/nmakehlp.c578
-rw-r--r--win/rules.vc479
-rw-r--r--win/stub16.c198
-rw-r--r--win/tcl.dsp48
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m4833
-rw-r--r--win/tcl.rc2
-rw-r--r--win/tclAppInit.c327
-rw-r--r--win/tclConfig.sh.in4
-rw-r--r--win/tclWin32Dll.c776
-rw-r--r--win/tclWinChan.c484
-rw-r--r--win/tclWinConsole.c602
-rw-r--r--win/tclWinDde.c735
-rw-r--r--win/tclWinError.c94
-rw-r--r--win/tclWinFCmd.c524
-rw-r--r--win/tclWinFile.c2204
-rw-r--r--win/tclWinInit.c254
-rw-r--r--win/tclWinInt.h128
-rw-r--r--win/tclWinLoad.c293
-rw-r--r--win/tclWinNotify.c471
-rw-r--r--win/tclWinPipe.c612
-rw-r--r--win/tclWinPort.h410
-rw-r--r--win/tclWinReg.c708
-rw-r--r--win/tclWinSerial.c501
-rw-r--r--win/tclWinSock.c1912
-rw-r--r--win/tclWinTest.c673
-rw-r--r--win/tclWinThrd.c293
-rw-r--r--win/tclWinThrd.h21
-rw-r--r--win/tclWinTime.c255
-rw-r--r--win/tclooConfig.sh19
-rw-r--r--win/tclsh.exe.manifest.in33
-rw-r--r--win/tclsh.icobin3630 -> 57022 bytes
-rw-r--r--win/tclsh.rc13
1840 files changed, 394288 insertions, 168304 deletions
diff --git a/.fossil-settings/binary-glob b/.fossil-settings/binary-glob
new file mode 100644
index 0000000..ca85874
--- /dev/null
+++ b/.fossil-settings/binary-glob
@@ -0,0 +1,3 @@
+*.bmp
+*.gif
+*.png
diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/.fossil-settings/crnl-glob
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
new file mode 100644
index 0000000..9ed86b1
--- /dev/null
+++ b/.fossil-settings/ignore-glob
@@ -0,0 +1,24 @@
+*.a
+*.dll
+*.dylib
+*.exe
+*.exp
+*.lib
+*.o
+*.obj
+*.res
+*.sl
+*.so
+*/Makefile
+*/config.cache
+*/config.log
+*/config.status
+*/tclConfig.sh
+*/tclsh*
+*/tcltest*
+*/versions.vc
+unix/dltest.marker
+unix/tcl.pc
+unix/pkgs/*
+win/pkgs/*
+win/tcl.hpj
diff --git a/.project b/.project
new file mode 100644
index 0000000..358cc74
--- /dev/null
+++ b/.project
@@ -0,0 +1,11 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+ <name>tcl8.6</name>
+ <comment></comment>
+ <projects>
+ </projects>
+ <buildSpec>
+ </buildSpec>
+ <natures>
+ </natures>
+</projectDescription>
diff --git a/.settings/org.eclipse.core.resources.prefs b/.settings/org.eclipse.core.resources.prefs
new file mode 100644
index 0000000..99f26c0
--- /dev/null
+++ b/.settings/org.eclipse.core.resources.prefs
@@ -0,0 +1,2 @@
+eclipse.preferences.version=1
+encoding/<project>=UTF-8
diff --git a/.settings/org.eclipse.core.runtime.prefs b/.settings/org.eclipse.core.runtime.prefs
new file mode 100644
index 0000000..5a0ad22
--- /dev/null
+++ b/.settings/org.eclipse.core.runtime.prefs
@@ -0,0 +1,2 @@
+eclipse.preferences.version=1
+line.separator=\n
diff --git a/ChangeLog b/ChangeLog
index 5948c55..bb441a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7073 +1,8848 @@
-2005-09-26 Kevin Kenny <kennykb@acm.org>
+A NOTE ON THE CHANGELOG:
+Starting in early 2011, Tcl source code has been under the management of
+fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline"
+view of changes made that is superior in every way to a hand edited log file.
+Because of this, many Tcl developers are now out of the habit of maintaining
+this log file. You may still find useful things in it, but the Timeline is
+a better first place to look now.
+============================================================================
- * libtommath/: Updated to release 0.36.
- * generic/tommath.h: Regenerated.
-
-2005-09-15 Miguel Sofer <msofer@users.sf.net>
+2013-09-19 Don Porter <dgp@users.sourceforge.net>
- * doc/ParseCmd.3: copy/paste fix [Bug 1292427]
+ *** 8.6.1 TAGGED FOR RELEASE ***
-2005-09-15 Don Porter <dgp@users.sourceforge.net>
+ * generic/tcl.h: Bump version number to 8.6.1.
+ * library/init.tcl:
+ * unix/configure.in:
+ * win/configure.in:
+ * unix/tcl.spec:
+ * README:
- * generic/tclStringObj.c (TclAppendFormattedObjs): Revision
- to eliminate one round of string copying.
+ * unix/configure: autoconf-2.59
+ * win/configure:
- * generic/tclBasic.c: More callers of TclObjPrintf and
- * generic/tclCkalloc.c: TclFormatToErrorInfo.
- * generic/tclCmdMZ.c:
- * generic/tclExecute.c:
- * generic/tclIORChan.c:
- * generic/tclMain.c:
- * generic/tclProc.c:
- * generic/tclTimer.c:
- * generic/tclUtil.c:
- * unix/tclUnixFCmd.c
+2013-09-19 Donal Fellows <dkf@users.sf.net>
- * unix/configure: autoconf-2.59
+ * doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected
+ description of method search order.
-2005-09-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2013-09-18 Donal Fellows <dkf@users.sf.net>
- * unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl
- to transparently open large files on RHEL 3. [Bug 1287638]
+ Bump TclOO version to 1.0.1 for release.
-2005-09-14 Don Porter <dgp@users.sourceforge.net>
+2013-09-17 Donal Fellows <dkf@users.sf.net>
- * generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to
- support "*" fields and needed to interpret precision limits on
- %s conversions as a maximum number of bytes, not Tcl_UniChars, to
- take from the (char *) argument.
+ * generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
+ Corrected implementation of the core of uuencode handling so that the
+ line length processing is correctly applied.
+ ***POTENTIAL INCOMPATIBILITY***
+ Existing code that was using the old versions and working around the
+ limitations will now need to do far less. The -maxlen option now has
+ strict limits on the range of supported lengths; this is a limitation
+ of the format itself.
- * generic/tclBasic.c: Updated several callers to use
- * generic/tclCkalloc.c: TclFormatToErrorInfo() and/or
- * generic/tclCmdAH.c: TclObjPrintf().
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclDictObj.c:
- * generic/tclExecute.c:
- * generic/tclIORChan.c:
- * generic/tclIOUtil.c:
- * generic/tclNamesp.c:
+2013-09-09 Donal Fellows <dkf@users.sf.net>
+
+ * generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
+ the internal representation of method bodies during cloning in order
+ to ensure that any bound references to instance variables are removed.
+
+2013-09-01 Donal Fellows <dkf@users.sf.net>
+
+ * generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that
+ whitespace at the end of a string don't cause the decoder to drop the
+ last decoded byte.
+
+2013-08-03 Donal Fellows <dkf@users.sf.net>
+
+ * library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
+ by the autoloading mechanism.
+
+2013-08-02 Donal Fellows <dkf@users.sf.net>
+
+ * generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
+ crashes when emptying the superclass slot, even when doing elaborate
+ things with metaclasses.
+
+2013-08-01 Harald Oehlmann <oehhar@users.sf.net>
+
+ * tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
+ thread again if we were forked, to solve Rivet bug 55153.
+
+2013-07-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/America/Asuncion:
+ * library/tzdata/Antarctica/Macquarie:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Hebron:
+ * library/tzdata/Asia/Jerusalem:
+ http://www.iana.org/time-zones/repository/releases/tzdata2013d.tar.gz
+
+2013-07-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclXtNotify.c: Bug [817249]: bring tclXtNotify.c up to date with
+ Tcl_SetNotifier() change.
+
+2013-07-02 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4
+ * unix/configure: (thanks to Brian Griffin)
+
+2013-06-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs
+ * generic/tclMain.c: initialized encodings.
+
+2013-06-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
+ issue.
+
+2013-06-17 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/regc_locale.c: Bug [a876646efe]: re_expr character class
+ [:cntrl:] should contain \u0000 - \u001f
+
+2013-06-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]:
+ Rewrote the [try] compiler to generate better code in some cases and
+ to behave correctly in others; when an error happens during the
+ processing of an exception-trap clause or a finally clause, the
+ *original* return options are now captured in a -during option, even
+ when fully compiled.
+
+2013-06-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]:
+ New opcode to allow resetting the stack to get rid of an expansion,
+ restoring the stack to a known state in the process.
+ * generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers
+ for [break] and [continue] to get stack cleanup right in the majority
+ of cases.
+ * tests/for.test (for-7.*): Set of tests for these evil cases.
+
+2013-06-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN
+ instead. One more last-moment fix for FreeBSD by Pietro Cerutti
+
+2013-06-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fix for perf bug detected by Kieran
+ (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ),
+ diagnosed by dgp to be a close relative of [Bug 781585], which was
+ fixed by commit [f46fb50cb3]. This bug was introduced by myself in
+ commit [cbfe055d8c].
+
+2013-06-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd):
+ Added code to allow [break] and [continue] to be issued as a jump (in
+ the most common cases) rather than using the more expensive exception
+ processing path in the bytecode engine. [Bug 3614226]: Partial fix for
+ the issues relating to cleaning up the stack when dealing with [break]
+ and [continue].
+
+2013-05-27 Harald Oehlmann <oehhar@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from
+ registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor
+ installed language packs on Vista+.
+ Bumped msgcat version to 1.5.2
+
+2013-05-22 Andreas Kupries <andreask@activestate.com>
+
+ * tclCompile.c: Removed duplicate const qualifier causing the HP
+ native cc to error out.
+
+2013-05-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic
+ uses of strcasecmp with a proper UTF-8-aware version. Affects both
+ [lsearch -nocase] and [lsort -nocase].
+
+2013-05-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/file.n: [Bug 3613671]: Added note to portability section on the
+ fact that [file owned] does not produce useful results on Windows.
+
+2013-05-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixFCmd.c (DefaultTempDir): [Bug 3613567]: Corrected logic
+ for checking return code of access() system call, which was inverted.
+
+2013-05-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Fix for FreeBSD, and remove support for older
+ * unix/configure: FreeBSD versions. Patch by Pietro Cerutti.
+
+2013-05-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsGR.c: Split tclCompCmds.c again to keep size of
+ code down.
+
+2013-05-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: Add panic in order to detect incompatible
+ mingw32 sys/stat.h and sys/time.h headers.
+
+2013-05-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/zlib/*: Upgrade to zlib 1.2.8
+
+2013-05-10 Donal K. Fellows <dkf@users.sf.net>
+
+ Optimizations and general bytecode generation improvements.
+ * generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd):
+ (TclCompileReturnCmd): Make these generate bytecode in more cases.
+ (TclCompileListCmd): Make this able to push a literal when it can.
+ * generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize):
+ Added checks to see if we can apply some simple cross-command-boundary
+ optimizations, and defined a small number of such optimizations.
+ (TclCompileScript): Added the special ability to compile the list
+ command with expansion ([list {*}blah]) into bytecode that does not
+ call an external command.
+
+2013-05-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
+ * generic/tclDecls.h: "long" type. Binary compatibility with win64
+ requires that all stub entries use 32-bit long's, therefore the need
+ for various wrapper functions/macros. For Tcl 9 a better solution is
+ needed, but that cannot be done without introducing binary
+ incompatibility.
+
+2013-04-30 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/platform.tcl (::platform::LibcVersion):
+ * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change.
+ The RE become too restrictive again. SuSe added a timestamp after the
+ version. Loosened up a bit. Bumped package to version 1.0.12.
+
+2013-04-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code
+ when the list of things to set is a literal.
+
+2013-04-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
+ and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
+ and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it
+ only eliminates code duplication.
+ * generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's
+ exactly the same as TCL_WIDE_INT_IS_LONG
+
+2013-04-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: Implement many Tcl_*Var* functions and
+ Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their
+ Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct.
+
+2013-04-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: Implement Tcl_Pkg* functions as
+ (faster/stack-saving) macros around Tcl_Pkg*Ex functions.
+
+2013-04-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/regc_color.c: [Bug 3610026]: Stop crash when the number of
+ * generic/regerrs.h: "colors" in a regular expression overflows a
+ * generic/regex.h: short int. Thanks to Heikki Linnakangas for
+ * generic/regguts.h: the report and the patch.
+ * tests/regexp.test:
+
+2013-04-04 Reinhard Max <max@suse.de>
+
+ * library/http/http.tcl (http::geturl): Allow URLs that don't have a
+ path, but a query query, e.g. http://example.com?foo=bar
+ * Bump the http package to 2.8.7.
+
+2013-03-22 Venkat Iyer <venkat@comit.com>
+ * library/tzdata/Africa/Cairo: Update to tzdata2013b.
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/Africa/Gaborone:
+ * library/tzdata/Africa/Tripoli:
+ * library/tzdata/America/Asuncion:
+ * library/tzdata/America/Barbados:
+ * library/tzdata/America/Bogota:
+ * library/tzdata/America/Costa_Rica:
+ * library/tzdata/America/Curacao:
+ * library/tzdata/America/Nassau:
+ * library/tzdata/America/Port-au-Prince:
+ * library/tzdata/America/Santiago:
+ * library/tzdata/Antarctica/Palmer:
+ * library/tzdata/Asia/Aden:
+ * library/tzdata/Asia/Hong_Kong:
+ * library/tzdata/Asia/Muscat:
+ * library/tzdata/Asia/Rangoon:
+ * library/tzdata/Asia/Shanghai:
+ * library/tzdata/Atlantic/Bermuda:
+ * library/tzdata/Europe/Vienna:
+ * library/tzdata/Pacific/Easter:
+ * library/tzdata/Pacific/Fiji:
+ * library/tzdata/Asia/Khandyga: (new)
+ * library/tzdata/Asia/Ust-Nera: (new)
+ * library/tzdata/Europe/Busingen: (new)
+
+2013-03-21 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to
+ * tests/autoMkindex.test: [auto_mkindex]. Thanks Brian Griffin.
+
+2013-03-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result.
+ * tests/fileSystem.test:
+
+2013-03-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file
+ exists".
+
+2013-03-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/cmdAH.test (cmdAH-19.12): [Bug 3608360]: Added test to ensure
+ that we never ever allow [file exists] to do globbing.
+
+2013-03-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Patch by Andrew Shadura, providing better support for
+ three architectures they have in Debian.
+
+2013-03-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: [Bugs 3607246,3607372]: Unbalanced refcounts
+ * generic/tclLiteral.c: of literals in the global literal table.
+
+2013-03-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/regc_nfa.c: [Bugs 3604074,3606683]: Rewrite of the
+ * generic/regcomp.c: fixempties() routine (and supporting routines)
+ to completely eliminate the infinite loop hazard. Thanks to Tom Lane
+ for the much improved solution.
+
+2013-02-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a NULL
+ interp argument.
+
+ * generic/tclCompile.c: Update callers and revise mistaken comments.
* generic/tclProc.c:
- * library/init.tcl: Keep [unknown] in sync with errorInfo
- formatting rules.
+2013-02-27 Jan Nijtmans <nijtmans@users.sf.net>
-2005-09-13 Don Porter <dgp@users.sourceforge.net>
+ * generic/regcomp.c: [Bug 3606139]: missing error check allows
+ * tests/regexp.test: regexp to crash Tcl. Thanks to Tom Lane for
+ providing the test-case and the patch.
- * generic/tclBasic.c: First caller of TclFormatToErrorInfo.
+2013-02-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h: Using stdarg.h conventions, add more
- * generic/tclStringObj.c: fixed arguments to TclFormatObj() and
- TclObjPrintf(). Added new routine TclFormatToErrorInfo().
+ * tests/chanio.test (chan-io-28.7): [Bug 3605120]: Stop test from
+ hanging when run standalone.
- * generic/tcl.h: Explicitly standardized on the use of stdarg.h
- * generic/tclBasic.c: conventions for functions with variable number
- * generic/tclInt.h: of arguments. Support for varargs.h has been
- * generic/tclPanic.c: implicitly gone for some time now. All
- * generic/tclResult.c: TCL_VARARGS* macros purged from Tcl sources,
- * generic/tclStringObj.c: leaving only some deprecated #define's
- * tools/genStubs.tcl: in tcl.h for the sake of older extensions.
+2013-02-26 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclDecls.h: make genstubs
+ * generic/tclObj.c: Don't panic if Tcl_ConvertToType is called for a
+ type that doesn't have a setFromAnyProc, create a proper error message.
- * doc/AddErrInfo.3: Replaced all documented requirement for use
- * doc/Eval.3: of TCL_VARARGS_START() with requirement for
- * doc/Panic.3: use of va_start().
- * doc/SetResult.3:
- * doc/StringObj.3:
+2013-02-25 Donal K. Fellows <dkf@users.sf.net>
-2005-09-12 Don Porter <dgp@users.sourceforge.net>
+ * tests/binary.test (binary-41.*): [Bug 3605721]: Test independence
+ fixes. Thanks to Rolf Ade for pointing out the problem.
- * generic/tclStringObj.c (TclAppendFormattedObjs): Bug fix:
- make sure %ld formats force the collection of a wide value, when
- the value could be a different long.
+2013-02-25 Don Porter <dgp@users.sourceforge.net>
-2005-09-09 Andreas Kupries <andreask@activestate.com>
+ * tests/assocd.test: [Bugs 3605719,3605720]: Test independence.
+ * tests/basic.test: Thanks Rolf Ade for patches.
- * generic/tclIORChan.c (RcDecodeEventMask): Added missing type
- declaration for the parameter 'mask'. This fixes the [SF Tcl Bug
- 1286256]. The other warning can be removed only by removing the
- panic/return code.
+2013-02-23 Jan Nijtmans <nijtmans@users.sf.net>
-2005-09-09 Kevin Kenny <kennykb@acm.org>
+ * compat/fake-rfc2553.c: [Bug 3599194]: compat/fake-rfc2553.c is
+ broken.
- * generic/tclStringObj.c: Added two missing casts to silence
- messages from MSVC6.
-
-2005-09-09 Don Porter <dgp@users.sourceforge.net>
+2013-02-22 Don Porter <dgp@users.sourceforge.net>
- * generic/tclInt.h: New internal routine TclObjPrintf()
- * generic/tclStringObj.c: is similar to TclFormatObj() but
- accepts arguments in non-Tcl_Obj format.
+ * generic/tclAssembly.c: Shift more burden of smart cleanup
+ * generic/tclCompile.c: onto the TclFreeCompileEnv() routine.
+ Stop crashes when the hookProc raises an error.
- * generic/tclInt.h: New internal routines TclFormatObj()
- * generic/tclStringObj.c: and TclAppendFormattedObjs() to offer
- sprintf()-like means to append to Tcl_Obj. Work in progress toward
- [RFE 572392].
+2013-02-20 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCmdAH.c: Compiler directive NEW_FORMAT when #define'd
- directs the [format] command to be implemented in terms of the new
- TclAppendFormattedObjs() routine.
+ * generic/tclNamesp.c: [Bug 3605447]: Make sure the -clear option
+ * tests/namespace.test: to [namespace export] always clears, whether
+ or not new export patterns are specified.
-2005-09-08 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+2013-02-20 Jan Nijtmans <nijtmans@users.sf.net>
- TIP#254 IMPLEMENTATION
+ * win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64
+ headers.
- * generic/tclLink.c (LinkTraceProc,ObjValue): Added many new of C var
- * generic/tcl.h: to link to, making it
- * doc/LinkVar.3: easier to seamlessly
- * generic/tclTest.c (TestlinkCmd): couple C code and Tcl
- * tests/link.test: scripts in an
- application. [Patch 1242844]
+2013-02-19 Jan Nijtmans <nijtmans@users.sf.net>
-2005-09-07 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclTrace.c: [Bug 2438181]: Incorrect error reporting in
+ * tests/trace.test: traces. Test-case and fix provided by Poor
+ Yorick.
- * generic/tclUtf.c (Tcl_UniCharToUtf): Corrected handling of negative
- * tests/utf.test (utf-1.5): Tcl_UniChar input value. Incorrect
- handling was producing byte sequences outside of Tcl's legal internal
- encoding. [Bug 1283976].
+2013-02-15 Don Porter <dgp@users.sourceforge.net>
-2005-09-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/regc_nfa.c: [Bug 3604074]: Fix regexp optimization to
+ * tests/regexp.test: stop hanging on the expression
+ ((((((((a)*)*)*)*)*)*)*)* . Thanks to Bjørn Grathwohl for discovery.
- * generic/tclInt.h (List): Added flag to keep track of whether a list
- * generic/tclListObj.c: with a string rep is provably canonical.
- * generic/tclUtil.c (Tcl_ConcatObj): Do efficient concatenation and
- * generic/tclBasic.c (Tcl_EvalObjEx): evaluation when the list is
- canonical, and not just when the list is pure. This should make the
- "pure list" hacking introduced in 8.3 much more robust.
+2013-02-14 Harald Oehlmann <oehhar@users.sf.net>
-2005-09-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * library/msgcat/msgcat.tcl: [Bug 3604576]: Catch missing registry
+ entry "HCU\Control Panel\International".
+ Bumped msgcat version to 1.5.1
- * generic/tclObj.c (pendingObjDataKey): Added missing 'static' to stop
- symbol from leaking outside the Tcl library. [Bug 1263012]
+2013-02-11 Donal K. Fellows <dkf@users.sf.net>
-2005-09-01 Andreas Kupries <andreask@activestate.com>
+ * generic/tclZlib.c (ZlibTransformOutput): [Bug 3603553]: Ensure that
+ data gets written to the underlying stream by compressing transforms
+ when the amount of data to be written is one buffer's-worth; problem
+ was particularly likely to occur when compressing large quantities of
+ not-very-compressible data. Many thanks to Piera Poggio (vampiera) for
+ reporting.
- * unix/tclUnixSock.c (InitializeHostName): Synchronized use of
- static modifier in declaration and definition of function.
+2013-02-09 Donal K. Fellows <dkf@users.sf.net>
- * unix/tclUnixChan.c (FileTruncateProc): Synchronized use of
- static modifier in declaration and definition of function.
+ * generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change
+ the way that the 'varname' method is implemented so that there are no
+ longer problems with interactions due to the resolver. Thanks to
+ Taylor Venable <tcvena@gmail.com> for identifying the problem.
- * generic/tclResult.c (ReleaseKeys): Synchronized use of static
- modifier in declaration and definition of function.
+2013-02-08 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclListObj.c (NewListIntRep): Synchronized use of static
- modifier in declaration and definition of function.
+ * generic/regc_nfa.c (duptraverse): [Bug 3603557]: Increase the
+ maximum depth of recursion used when duplicating an automaton in
+ response to encountering a "wild" RE that hit the previous limit.
+ Allow the limit (DUPTRAVERSE_MAX_DEPTH) to be set by defining its
+ value in the Makefile. Problem reported by Jonathan Mills.
- * generic/tclEncoding.c (InitializeEncodingSearchPath):
- Synchronized use of static modifier in declaration and
- definition of function.
+2013-02-05 Don Porter <dgp@users.sourceforge.net>
- * generic/tclEncoding.c (FillEncodingFileMap): Synchronized use of
- static modifier in declaration and definition of function.
+ * win/tclWinFile.c: [Bug 3603434]: Make sure TclpObjNormalizePath()
+ properly declares "a:/" to be normalized, even when no "A:" drive is
+ present on the system.
- * generic/tclIORChan.c (RcNewHandle): Synchronized use of static
- modifier in declaration and definition of function.
+2013-02-05 Donal K. Fellows <dkf@users.sf.net>
-2005-08-31 Vince Darley <vincentdarley@sourceforge.net>
+ * generic/tclLoadNone.c (TclpLoadMemory): [Bug 3433012]: Added dummy
+ version of this function to use in the event that a platform thinks it
+ can load from memory but cannot actually do so due to it being
+ disabled at configuration time.
- * doc/FileSystem.3:
- * unix/tclUnixFile.c:
- * windows/tclWinFile.c: clarify that Tcl_FSMatchInDirectory may
- be called with a NULL interpreter, and fix the code so this is
- allowed. Tcl's core itself (tclEncoding.c:FillEncodingFileMap())
- calls this with a NULL interpreter.
+2013-02-04 Donal K. Fellows <dkf@users.sf.net>
-2005-08-29 Andreas Kupries <andreask@activestate.com>
+ * generic/tclCompCmds.c (TclCompileArraySetCmd): [Bug 3603163]: Stop
+ crash in weird case where [eval] is used to make [array set] get
+ confused about whether there is a local variable table or not. Thanks
+ to Poor Yorick for identifying a reproducible crashing case.
- * library/tm.tcl (::tcl::tm::roots): Accepted Don Porter's patch
- for [Tcl SF Bug 1189657]. Syncs the implementation to the
- specification (TIP #189).
+2013-01-30 Andreas Kupries <andreask@activestate.com>
-2005-08-29 Kevin Kenny <kennykb@acm.org>
+ * library/platform/platform.tcl (::platform::LibcVersion): See
+ * library/platform/pkgIndex.tcl: [Bug 3599098]: Fixed the RE
+ * unix/Makefile.in: extracting the version to avoid issues with
+ * win/Makefile.in: recent changes to the glibc banner. Now targeting a
+ less variable part of the string. Bumped package to version 1.0.11.
- * generic/tclBasic.c (ExprMathFunc): Restored "round away from
- * tests/expr.test (expr-46.*): zero" behaviour to the
- "round" function. Added
- test cases for the behavior, including the awkward case of a
- number whose fractional part is 1/2-1/2ulp. [Bug 1275043]
-
-2005-08-26 Andreas Kupries <andreask@activestate.com>
+2013-01-28 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclIO.c: Moved Tcl_{Cut,Splice}Channel to
- {Cut,Splice}Channel for internal use, and created new public
- functions for Tcl_{Cut,Splice}Channel which walk the whole stack
- of transformations and invoke the necessary thread actions.
- Added code to Tcl_(Un)StackChannel to properly invoke the thread
- actions when pushing and popping transformations on/from a
- channel.
+ * generic/tclCompCmds.c (TclCompileArraySetCmd)
+ (TclCompileArrayUnsetCmd, TclCompileDictAppendCmd)
+ (TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd)
+ (TclCompileDictLappendCmd, TclCompileDictMergeCmd)
+ (TclCompileDictUnsetCmd, TclCompileDictUpdateCmd)
+ (TclCompileDictWithCmd, TclCompileInfoCommandsCmd):
+ * generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd)
+ (TclCompileStringMapCmd): Improve the code generation in cases where
+ full compilation is impossible but a full ensemble invoke is provably
+ not necessary.
-2005-08-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2013-01-26 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclNamesp.c (NamespaceEnsembleCmd): Reset the result after
- creating an ensemble to clear any result object sharing (potentially
- caused by delete traces) so that we can safely return the name of the
- ensemble. Previously, this caused crashes in Snit's test suite.
+ * unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation
+ fault on Darwin.
-2005-08-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2013-01-23 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclListObj.c (UpdateStringOfList): Stop uncontrolled and
- unsafe crashes from happening when working with very large string
- representations. [Bug 1267380]
+ * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
+ for connect to avoid reentrancy problems (except when operating
+ without a -command option). Internally, this means that all sockets
+ created by the http package will always be operated in asynchronous
+ mode.
- * generic/tclExecute.c (TEBC:INST_DICT_LAPPEND): Stop dropping a
- duplicated object on the floor, which was a memory leak (and a wrong
- result too). Thanks to Andreas Kupries for reporting this.
+2013-01-21 Jan Nijtmans <nijtmans@users.sf.net>
-2005-08-24 Andreas Kupries <andreask@activestate.com>
+ * generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName)
+ in private stub table, so extensions using this (like Tk 8.4) will
+ continue to work in all Tcl 8.x versions. Extensions using this
+ still cannot be compiled against Tcl 8.6 headers.
- TIP#219 IMPLEMENTATION
+2013-01-18 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/SetChanErr.3: ** New File **. Documentation of the new
- channel API functions.
- * generic/tcl.decls: Stub declarations of the new channel API.
- * generic/tclDecls.h: Regenerated
- * generic/tclStubInit.c:
+ * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include
+ sys/stat.h
- * tclIORChan.c: ** New File **. Implementation of the reflected
- channel.
- * generic/tclInt.h: Integration of reflected channel and new error
- * generic/tclIO.c: propagation into the generic I/O core.
- * generic/tclIOCmd.c:
- * generic/tclIO.h:
- * library/init.tcl:
+2013-01-17 Donal K. Fellows <dkf@users.sf.net>
- * tests/io.test: Extended testsuite.
- * tests/ioCmd.test:
- * tests/chan.test:
- * generic/tclTest.c:
- * generic/tclThreadTest.c:
+ * generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism
+ for suppressing compilation of variables when we couldn't cope with
+ the results. Useful for some [array] subcommands.
+ * generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the
+ compilation environment when a command compiler fails.
- * unix/Makefile.in: Integration into the build machinery.
- * win/Makefile.in:
- * win/Makefile.vc:
+2013-01-16 Donal K. Fellows <dkf@users.sf.net>
-2005-08-24 Kevin Kenny <kennykb@acm.org>
+ * generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config
+ info in the iso8859-1 encoding as that is guaranteed to be present.
- * generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of
- * tests/binary.test (binary-65.*) formatting floating
- point numbers with the largest and smallest possible significands,
- and added test cases for them.
+2013-01-16 Jan Nijtmans <nijtmans@users.sf.net>
-2005-08-23 Mo DeJong <mdejong@users.sourceforge.net>
+ * Makefile.in: Allow win32 build with -DTCL_NO_DEPRECATED, just as
+ * generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and
+ * generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when
+ * generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit
+ from it too.
- * unix/configure.in:
- * win/configure: Regen.
- * win/configure.in: Update minimum autoconf version
- to 2.59.
-
-2005-08-22 Daniel Steffen <das@users.sourceforge.net>
-
- * unix/tclConfig.h.in: autoheader-2.59.
-
-2005-08-17 George Peter Staplin <GeorgePS@XMission.com>
-
- * generic/tclBasic.c: eliminate a namespace clash caused by
- BuiltinFuncTable not being static.
-
- * generic/tclObj.c: fix a namespace clash caused by a missing
- static for pendingObjData.
-
-2005-08-17 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclEvent.c (Tcl_Finalize): Removed a copy-and-paste
- accident that caused a (mostly harmless) double finalize of the
- load and filesystem subsystems.
- * tests/clock.test: Eliminated the bad test clock-43.1, and split
- clock-50.1 into two tests, with a more permissive check on the
- error message for an out-of-range value.
-
-2005-08-12 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclClock.c (MktimeObjCmd):
- * library/clock.tcl (GetSystemTimeZone, LoadZoneinfoFile,
- ReadZoneinfoFile):
- * tests/clock.test (clock-50.1):
- Added functionality to read /etc/localtime if it exists, so that
- Tcl's time can track system time on Linux even if TZ is not set.
- Changed ::tcl::clock::Mktime to check for failure, and added a
- test case that mimics failure but is really success.
-
-2005-08-11 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclEvent.c: Eliminated the USE_THREAD_STORAGE
- * generic/tclInt.h: option (which is on in every build
- * generic/tclThread.c: generated by the standard configurator).
- * generic/tclThreadStorage.c: Eliminated the code for thread
- * unix/configure: specific data without USE_THREAD_STORAGE
- * unix/tcl.m4: and radically refactored the code
- * unix/tclConfig.h.in: for USE_THREAD_STORAGE so that it
- * unix/tclUnixThrd.c: has fewer dependencies on the order
- * win/configure: of finalization. (Also, made
- * win/Makefile.in: 'make distclean' on Windows clean
- * win/rules.vc: just a little bit cleaner.)
- * win/tcl.m4:
- * win/tclWinThrd.c:
+2013-01-14 Jan Nijtmans <nijtmans@users.sf.net>
-2005-08-10 Kevin Kenny <kennykb@acm.org>
+ * win/tcl.m4: More flexible search for win32 tclConfig.sh, backported
+ from TEA (not actually used in Tcl, only for Tk)
- * generic/tclEvent.c (Tcl_Finalize): Pushed Tcl_FinalizeLoad and
- Tcl_ResetFilesystem down after Tcl_FinalizeThreadAlloc because
- we can't unload DLL's until after their TSD keys are finalized.
- (Note that we'll still see aborts if an unloaded DLL has TSD -
- that still needs to be fixed.
+2013-01-14 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/compExpr-old.test (compExpr-3.8): Made tests conditional on
- * tests/expr.test (expr-3.8): 'unix' because they get
- stack overflows on Win32
- threaded builds,
+ * generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal
+ stub table, so extensions using this, compiled against 8.5 headers
+ still run in Tcl 8.6.
-2005-08-09 Vince Darley <vincentdarley@users.sourceforge.net>
+2013-01-13 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclPathObj.c: fix to [file rootname] bug in optimized
- code path reported on comp.lang.tcl.
+ * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false
+ positives" in the case of multibyte encodings/transforms.
-2005-08-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2013-01-13 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclThreadStorage.c: Stop exposing the guts of the thread
- storage system through the internal stubs table. Client code
- should always use the standard API.
+ * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure
+ that TIP #139 functions all are taken from the public stub table, even
+ if the inclusion is through tclInt.h.
-2005-08-05 Donal K. Fellows <dkf@users.sf.net>
+2013-01-12 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclUnixInit.c (localeTable): Solaris uses a non-standard
- name for the cp1251 charset. Thanks to Victor Wagner for reporting
- this. [Bug 1252475]
+ * generic/tclInt.decls: Put back TclBackgroundException in internal
+ stub table, so extensions using this, compiled against 8.5 headers
+ still run in Tcl 8.6.
-2005-08-05 Kevin Kenny <kennykb@users.sourceforge.net>
+2013-01-09 Jan Nijtmans <nijtmans@users.sf.net>
- * win/makefile.vc: Removed unused file ldAout.tcl.
- * win/makefile.bc: [Bug #1244361]
+ * library/http/http.tcl: [Bug 3599395]: http assumes status line is a
+ proper Tcl list.
- * tests/binary.test: Cleaned up testing for scanning of NaN.
- [Bug #1246264]
+2013-01-08 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclBasic.c (ExprAbsFunc): Added code to handle the
- * tests/expr.test (expr-38.1): corner case of applying
- 'abs' to the smallest 32-bit integer. [Bug #1241572]
+ * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
+ components. [Bug 3587096]: win vista/7: "can't find init.tcl" when
+ called via junction without folder list access.
-2005-08-04 Andreas Kupries <andreask@activestate.com>
+2013-01-07 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclIO.c (CloseChannel): Fixed comment nit, added
- apparently missing word to complete a sentence.
+ * generic/tclOOStubLib.c: Restrict the stub library to only use
+ * generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and
+ Tcl_AppendResult, not any other function. This puts least restrictions
+ on eventual Tcl 9 stubs re-organization, and it works on the widest
+ range of Tcl versions.
- * generic/tclObj.c (Tcl_DbDecrRefCount): Fixed whitespace nit in
- panic message.
+2013-01-06 Jan Nijtmans <nijtmans@users.sf.net>
-2005-08-04 Don Porter <dgp@users.sourceforge.net>
+ * library/http/http.tcl: Don't depend on Spencer-specific regexp
+ * tests/env.test: syntax (/u and /U) any more in unrelated places.
+ * tests/exec.test:
+ Bump http package to 2.8.6.
- * generic/tclObj.c: Simplified routines that manage the typeTable.
- Deleted the UpdateStringOfBoolean() routine, that can never be called.
+2013-01-04 Donal K. Fellows <dkf@users.sf.net>
-2005-08-03 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple
+ compiler (which just compiles to a normal invoke of the implementation
+ command) for many ensemble subcommands where we can prove that there
+ is no way for scripts to detect the difference even through error
+ handling or [info level]/[info frame]. This improves the code produced
+ from some ensembles (e.g., [info], [string]) to the point where the
+ ensemble is now not normally seen at the bytecode level at all.
- * generic/tclCompExpr.c: Untangled some dependencies in the
- * generic/tclEvent.c: order of finalization routines.
- * generic/tclInt.h: [Bug 1251399]
- * generic/tclObj.c:
+2013-01-04 Miguel Sofer <msofer@users.sf.net>
-2005-07-30 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tclInt.h: Insure that PURIFY builds cannot exploit the
+ * generic/tclExecute.c: Tcl stack to hide mem defects.
- * unix/tclLoadDyld.c (TclpDlopen, TclpLoadMemory): workarounds
- for bugs/changes in behaviour in Mac OS X 10.4 Tiger.
+2013-01-03 Donal K. Fellows <dkf@users.sf.net>
-2005-07-29 Donal K. Fellows <dkf@users.sf.net>
+ * doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that
+ the minimum buffer size is one byte, not ten. Identified by Schelte
+ Bron on the Tcler's Chat.
- * generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode,
- still have to take care with non-existant variables. [Bug 1247135]
+ * generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE):
+ * generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to
+ allow for more efficient dispatch of non-bytecode-compiled subcommands
+ of bytecode-compiled ensembles. This can provide substantial speed
+ benefits in some cases.
-2005-07-28 Mo DeJong <mdejong@users.sourceforge.net>
+2013-01-02 Miguel Sofer <msofer@users.sf.net>
- * win/README: Update link to msys_mingw8.zip.
+ * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and friends:
+ * generic/tclExecute.c: the core should only use ckalloc to allow
+ * generic/tclIORTrans.c: MEM_DEBUG to work properly.
+ * generic/tclTomMathInterface.c:
-2005-07-28 Don Porter <dgp@users.sourceforge.net>
+2012-12-31 Donal K. Fellows <dkf@users.sf.net>
- * tests/compExpr-old.test: Still more conversion of "nonPortable"
- * tests/error.test: tests into tests with constraints that
- * tests/expr-old.test: describe the limits of their
- * tests/expr.test: portability. Also more consolidation
- * tests/fileName.test: of constraint synonyms.
- * tests/format.test: wideis64bit, 64bitInts => wideIs64bit
- * tests/get.test: wideIntegerUnparsed => wideIs32bit
- * tests/load.test: wideIntExpressions => wideBiggerThanInt
- * tests/obj.test:
- * tests/parseExpr.test: Dropped "roundOffBug" constraint that
- * tests/string.test: protected from buggy sprintf.
+ * doc/string.n: Noted the obsolescence of the 'bytelength',
+ 'wordstart' and 'wordend' subcommands, and moved them to later in the
+ file.
-2005-07-28 Donal K. Fellows <dkf@users.sf.net>
+2012-12-27 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclPipe.c (TclCreatePipeline): Arrange for POSIX systems to
- * unix/tclUnixPipe.c (TclpOpenFile): use the O_APPEND flag for
- * tests/exec.test (exec-19.1): files opened in a pipeline
- like ">>this". Note that Windows cannot support such access; there is
- no equivalent flag on the handle that can be set at the kernel-call
- level. The test is unix-specific in every way. [Bug 1245953]
+ * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release
+ deleted elements too early.
-2005-07-27 Don Porter <dgp@users.sourceforge.net>
+2012-12-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclUtil.c: Converted the $::tcl_precision value to be
- kept per-thread to prevent different threads from stomping on each
- others' formatting prescriptions.
+ * generic/tclUtil.c: [Bug 3598150]: Stop leaking allocated space when
+ objifying a zero-length DString. Spotted by afredd.
- ***POTENTIAL INCOMPATIBILITY*** Multi-threaded programs that set
- the value of ::tcl_precision will now have to set it in each thread.
+2012-12-21 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/expr.test: Consolidated equivalent constraints into
- * tests/fileName.test: single definitions and (more precise) names:
- * tests/get.test: longis32bit, 32bit, !intsAre64bit => longIs32bit
- * tests/listObj.test: empty => emptyTest; winOnly => win
- * tests/obj.test: intsAre64bit => longIs64bit
- Also updated some "nonPortable" tests to use constraints that mark
- precisely what about them isn't portable, so the tests can run where
- they work.
+ * unix/dltest/pkgb.c: Inline compat Tcl_GetDefaultEncodingDir.
+ * generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport()
+ and isDigit() functions, just do the same inline.
- * library/init.tcl ([unknown]): Corrected return code handling
- in the portions of [unknown] that expand incomplete commands
- during interactive operations. [Bug 1214462].
+2012-12-18 Donal K. Fellows <dkf@users.sf.net>
-2005-07-26 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of
+ instructions issued for [subst] when dealing with simple variable
+ references.
- * unix/configure: Regen.
- * unix/configure.in: Check for a $prefix/share
- directory and add it the the package if found.
- This will check for Tcl packages in /usr/local/share
- when Tcl is configured with the default dist install.
- [patch 1231015]
+2012-12-14 Don Porter <dgp@users.sourceforge.net>
-2005-07-26 Don Porter <dgp@users.sourceforge.net>
+ *** 8.6.0 TAGGED FOR RELEASE ***
- * generic/tclBasic.c (Tcl_CallWhenDeleted): Converted to use
- per-thread counter, rather than a process global one that required
- mutex protection. [RFE 1077194]
+ * changes: updates for 8.6.0
- * generic/tclNamesp.c (TclTeardownNamespace): Re-ordering so that
- * tests/trace.test (trace-34.4): command delete traces fire
- while the command still exists. [Bug 1047286]
+2012-12-13 Don Porter <dgp@users.sourceforge.net>
-2005-07-24 Mo DeJong <mdejong@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.
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH):
- * win/configure: Regen.
- * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH):
- Split confused search for tclsh on PATH and
- build and install locations into two macros.
- SC_PROG_TCLSH searches just the PATH.
- SC_BUILD_TCLSH determines the name of the tclsh
- executable in the Tcl build directory.
- [Tcl bug 1160114]
- [Tcl patch 1244153]
+2012-12-13 Miguel Sofer <msofer@users.sf.net>
-2005-07-23 Don Porter <dgp@users.sourceforge.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.
- * library/auto.tcl: Updates to the Tcl script library to make
- * library/history.tcl: use of Tcl 8.4 features. Forward port of
- * library/init.tcl: appropriate portions of [Patch 1237755].
- * library/package.tcl:
- * library/safe.tcl:
- * library/word.tcl:
+2012-12-13 Jan Nijtmans <nijtmans@users.sf.net>
-2005-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't
+ access its objPtr parameter twice any more.
- * tests/string.test: Add string is tests for
- functionality that was not tested.
- * win/README: Update msys + mingw URL.
- Remove old Cygwin + mingw info.
+2012-12-11 Don Porter <dgp@users.sourceforge.net>
-2005-07-23 Miguel Sofer <msofer@users.sf.net>
+ * generic/tcl.h: Bump version number to 8.6.0.
+ * library/init.tcl:
+ * unix/configure.in:
+ * win/configure.in:
+ * unix/tcl.spec:
+ * README:
- * generic/tclExecute.c (INST_DICT_*): stop 2 compiler
- warnings for uninitialised variables.
+ * unix/configure: autoconf-2.59
+ * win/configure:
-2005-07-23 Donal K. Fellows <dkf@users.sf.net>
+2012-12-10 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclExecute.c (TEBC:INST_DICT_INCR_IMM): Fix the
- incrementor to work correctly with wide values.
+ * 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.
-2005-07-21 Donal K. Fellows <dkf@users.sf.net>
+2012-12-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclCompCmds.c (TclCompileDictCmd): First run at a compiler
- * generic/tclExecute.c (TclExecuteByteCode): for dictionaries.
- Also added an instruction to support 'finally'-like clauses, exposed
- more of the dict guts to the rest of the core, and defined a few
- tests to exercise more obscure parts of the compiler's operation that
- were bugs during development.
+ * 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]).
-2005-07-21 Kevin B. Kenny <kennykb@acm.org>
+ * doc/expr.n: [Bug 3594188]: Clarifications about commas.
- * library/ldAout.tcl (***REMOVED***): Removed support for ancient
- * unix/configure: BSD's, IRIX 4, RISCos and
- * unix/Makefile.in: Ultrix. Removed two files
- * unix/tcl.m4: whose code is used only on
- * unix/tclLoadAout.c (***REMOVED***): those antique platforms.
+2012-12-08 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- ***POTENTIAL INCOMPATIBILITY*** if anyone actually uses those
- platforms; it is to be noted though, that an error in the
- installer has actually not caused a necessary file to be installed
- on those platforms in several releases, and nobody's complained.
-
-2005-07-16 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT
+ when there are unflushed nonblocking channels. Thanks Miguel for
+ spotting.
- * generic/tclStrToD.c (RefineResult): Plugged a stupid memory
- leak in RefineResult (called from Tcl_StrToD). [Tk Bug 1227781]
-
-2005-07-15 Kevin B. Kenny <kennykb@acm.org>
+2012-12-07 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclClock.c (TclClockLocaltimeObjCmd,ThreadSafeLocalTime):
- * library/clock.tcl (GuessWindowsTimeZone, ClearCaches):
- * tests/clock.test (clock-49.1, clock-49.2):
- Handle correctly the case where localtime() returns NULL to
- report a conversion error. Also handle the case where the Windows
- registry contains timezone values that can be mapped to a tzdata
- file name but the corresponding file does not exist or is
- corrupted, by falling back on a Posix timezone string instead;
- this last case will avoid calls to localtime() in starpacks on
- Windows. [Bug 1237907]
-
-2005-07-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+ * 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.
- * generic/tclCompile.c: Update to follow style guidelines.
- (TclPrintInstruction): Reorganize to do better printing out of
- bytecode with far fewer "special hacks" for particular opcodes.
- * generic/tclCompile.h: Requires two new opcode types.
+2012-11-28 Donal K. Fellows <dkf@users.sf.net>
-2005-07-13 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
+ for complex option resolution that has fewer problems with more
+ finicky compilers.
- * unix/tclUnixSock.c: Use a ProcessGlobalValue to store the
- * win/tclWinSock.c: value returned by Tcl_GetHostName()
- ([info hostname]). Also re-order initialization of the value
- on Windows to favor GetComputerName() over gethostname() as
- a source of the information.
+2012-11-26 Reinhard Max <max@suse.de>
-2005-07-12 Donal K. Fellows <dkf@users.sf.net>
+ * 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.
- * doc/lsearch.n: Clarify documentation of -exact option; wording was
- open to misinterpretation by non-English speakers.
+2012-11-20 Donal K. Fellows <dkf@users.sf.net>
-2005-07-11 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.
- * generic/tclExecute.c: General style cleanup.
+2012-11-19 Donal K. Fellows <dkf@users.sf.net>
-2005-07-08 Mo DeJong <mdejong@users.sourceforge.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.
- * generic/tclExecute.c (TclExecuteByteCode): Reimplement long and wide
- type integer division and modulus operations so that the smallest and
- largest integer values are handled properly. The divide operation is
- more efficient since it no longer does a modulus or negation and only
- checks for a remainder when the quotient will be a negative number.
- The modulus operation is now a bit more complex because of a number of
- special cases dealing with the smallest and largest integers.
- * tests/expr.test: Add test cases for division and modulus operations
- on the smallest and largest integer values for 32 and 64 bit types.
- [Patch 1230205]
+2012-11-15 Jan Nijtmans <nijtmans@users.sf.net>
-2005-07-06 Don Porter <dgp@users.sourceforge.net>
+ IMPLEMENTATION OF TIP#416
- * generic/tclLink.c: Simplified LinkTraceProc [Bug 1208108].
+ New Options for 'load': -global and -lazy
-2005-07-05 Don Porter <dgp@users.sourceforge.net>
+ * generic/tcl.h:
+ * generic/tclLoad.c
+ * unix/tclLoadDl.c
+ * unix/tclLoadDyld.c
+ * tests/load.test
+ * doc/Load.3
+ * doc/load.n
- * unix/Makefile.in: Purged use of TCLTESTARGS [RFE 1161550].
+2012-11-14 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclUtil.c: Converted TclFormatInt() into a macro.
- * generic/tclInt.decls: [RFE 1194015]
- * generic/tclInt.h:
+ * 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).
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
+2012-11-13 Joe Mistachkin <joe@mistachkin.com>
- * generic/tclNamesp.c: Allow for [namespace import] of a command
- * tests/namespace.test: over a previous [namespace import] of itself
- without throwing an error. [RFE 1230597]
+ * win/tclWinInit.c: also search for the library directory (init.tcl,
+ encodings, etc) relative to the build directory associated with the
+ source checkout.
-2005-07-04 Donal K. Fellows <dkf@users.sf.net>
+2012-11-10 Miguel Sofer <msofer@users.sf.net>
- * generic/tclDictObj.c (DictForCmd, DictFilterCmd): Interlocking of
- dictionary internal representations is now done in the core of the
- dict iterator. Purge the last attempts at doing it at a higher level
- as they didn't work and were no longer needed.
+ * generic/tclBasic.c: re-enable bcc-tailcall, after fixing an
+ * generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode
-2005-07-01 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
- * unix/tclUnixNotfy.c: protect against spurious wake-ups while
- waiting on the condition variable when tearing down the notifier
- thread [Bug# 1222872].
+2012-11-07 Kevin B. Kenny <kennykb@acm.org>
-2005-06-28 Mo DeJong <mdejong@users.sourceforge.net>
+ * 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.
- * generic/tclExecute.c (TclExecuteByteCode): When parsing an integer
- operand for a unary minus expression operator, check for a wide
- integer that is actually LONG_MIN. If found, convert it back to a long
- int type.
- * tests/expr.test: Add constraint for 32bit long int type and 64bit
- wide int type. Add tests that parse the smallest/largest long int and
- wide int values.
+2012-10-31 Jan Nijtmans <nijtmans@users.sf.net>
-2004-06-24 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclEvent.c (Tcl_Finalize):
- * generic/tclInt.h:
- * generic/tclPreserve.c (TclFinalizePreserve): Changed the
- finalization logic so that Tcl_Preserve finalizes after exit handlers
- run; a lot of code called from Tk's exit handlers presumes that
- Tcl_Preserve will still work even from an exit handler.
-
-2005-06-24 Don Porter <dgp@users.sourceforge.net>
-
- * library/auto.tcl: Make file safe to re-[source] without
- destroying registered auto_mkindex_parser hooks.
-
-2005-06-23 Kevin Kenny <kennykb@acm.org>
-
- * win/tclWinChan.c: More rewriting of __asm__ blocks that implement
- * win/tclWinFCmd.c: SEH in GCC, because mingw's gcc 3.4.2 is not as
- forgiving of violations committed by the old code and caused panics.
- [Bug #1225957]
-
-2005-06-23 Daniel Steffen <das@users.sourceforge.net>
-
- * tools/tcltk-man2html.tcl: fixed useversion glob pattern to accept
- multi-digit patchlevels.
-
-2005-06-22 Don Porter <dgp@users.sourceforge.net>
-
- * win/tclWinFile.c: Potential buffer overflow. [Bug 1225571]
- Thanks to Pat Thoyts for discovery and fix.
-
-2005-06-22 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclInt.h: Changed the finalization
- * generic/tclEvent.c (Tcl_Finalize): logic to defer the
- * generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe
- * unix/tclUnixPipe.c (TclFinalizePipes): management until after
- * win/tclWinPipe.c (TclFinalizePipes): all channels have been
- closed, in order to avoid a situation where the Windows PipeCloseProc2
- would re-establish the exit handler after exit handlers had already
- run, corrupting the heap. [Bug #1225727]
- Also corrected a potential read of uninitialized memory in
- PipeClose2Proc [Bug #1225044]
-
-2005-06-21 Andreas Kupries <andreask@activestate.com>
+ * 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
- * generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel
- Steffen. There are compilers (*) who error out on the redefinition of
- WORDS_BIGENDIAN. We have to undef the previous definition (on the
- command line) first to make this acceptable. (*): AIX native.
+2012-10-24 Donal K. Fellows <dkf@users.sf.net>
-2005-06-21 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclCompCmds.c (TclCompileDictUnsetCmd): Added compilation of
+ the [dict unset] command (for scalar var in LVT only).
- * generic/tclFileName.c: Changed [file split] and [file join] to treat
- Windows drive letters similarly to ~ syntax and make sure that they
- appear with "./" in front when they are in intermediate components of
- the path. [Bug 1194458]
- * tests/fileName.test: Added test for the above bug.
-
-2005-06-21 Don Porter <dgp@users.sourceforge.net>
+2012-10-23 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclBasic.c: Added missing walk of the list of active traces
- * generic/tclTrace.c: to cleanup references to traces being deleted.
- * generic/tclInt.h: [Bug 1201035] Made the walk of the active trace
- * tests/trace.test (trace-34.*): list aware of the direction of trace
- scanning, so the proper correction can be made. [Bug 1224585]
+ * 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:
-2005-06-21 Donal K. Fellows <dkf@users.sf.net>
+2012-10-17 Miguel Sofer <msofer@users.sf.net>
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' special
- debugging feature when requested in configure.in; removes irrelevant
- junk from the configure files of extensions that use Tcl's tcl.m4.
+ * 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/
-2005-06-20 Donal K. Fellows <dkf@users.sf.net>
+2012-10-16 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCompile.h (INST_PUSH_RETURN_OPTIONS): New opcode to allow
- * generic/tclCompCmds.c (TclCompileCatchCmd): compilation of TIP90
- * generic/tclCompile.c: catch [Bug 1219112]
- * generic/tclExecute.c (TclExecuteByteCode):
+ IMPLEMENTATION OF TIP#405
- * generic/tclCompCmds.c (TclCompileSwitchCmd): Ensure we spill to the
- command form in all cases where it generates an error.
+ 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.
-2005-06-20 Mo DeJong <mdejong@users.sourceforge.net>
+ * 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].
- * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Generate an error if a mode
- argument like -exact is passed more than once to the switch command.
- The previous implementation silently accepted invalid switch
- invocations like [switch -exact -glob $str ...].
- * tests/for.test: Check some error cases when invoking continue and
- break inside a for loop next script.
- * tests/switch.test: Add checks for shortened version of a mode
- argument like -exact. Add test for more than one mode argument. Add
- test for odd case of passing a variable as a body script.
+ IMPLEMENTATION OF TIP#400
-2005-06-18 Daniel Steffen <das@users.sourceforge.net>
+ * 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.
- * generic/tclInt.h: ensure WORDS_BIGENDIAN is defined correctly with
- fat compiles on Darwin (i.e. ppc and i386 at the same time), the
- configure AC_C_BIGENDIAN check is not sufficient in this case because
- a single run of the compiler builds for two architectures with
- different endianness.
+2012-10-14 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to
- ensure we can always relocate binaries with install_name_tool.
+ * 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.
- * unix/configure: autoconf-2.59
+2012-10-13 Jan Nijtmans <nijtmans@users.sf.net>
-2005-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclEvent.c: [Bug 3576509]: tcl::Bgerror crashes with invalid
+ arguments
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): Fix for [Bug 1154163]; only
- * tests/format.test: insert 'l' modifier when it is needed.
+2012-10-06 Jan Nijtmans <nijtmans@users.sf.net>
-2005-06-17 Donal K. Fellows <dkf@users.sf.net>
+ * win/Makefile.in: [Bug 2459774]: tcl/win/Makefile.in not compatible
+ with msys 0.8.
- * generic/tclTimer.c (AfterDelay): Split out the code to manage
- synchronous-delay [after] commands.
- * tests/interp.test (interp-34.10): Time limits and synch-delay
- [after] did not mix well... [Bug 1221395]
+2012-10-03 Don Porter <dgp@users.sourceforge.net>
-2005-06-14 Donal K. Fellows <dkf@users.sf.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.
- * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a
- * tests/namespace.test (namespace-49.2): command from the hashtable on
- reentrant processing if it has not been already deleted; at least
- three deletes of the same command are possible. [Bug 1220058]
- * generic/tclTrace.c (TraceCommandProc): Remove bogus error message
- creation when traces trigger in situations where the command has
- already been deleted.
+2012-09-26 Reinhard Max <max@suse.de>
-2005-06-13 Vince Darley <vincentdarley@users.sourceforge.net>
+ * 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].
- * generic/tclFCmd.c: correct fix to file mkdir 2005-06-09, [Bug 1219176]
+2012-09-20 Jan Nijtmans <nijtmans@users.sf.net>
-2005-06-12 Donal K. Fellows <dkf@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:
- * generic/tclCompCmds.c: Factor out some common idioms into named
- forms for greater clarity.
+ * win/tclWinDde.c: [FRQ 3527238]: Full unicode support for dde. Dde
+ version is now 1.4.0b2.
+ ***POTENTIAL INCOMPATIBILITY***
-2005-06-10 Donal K. Fellows <dkf@users.sf.net>
+2012-09-19 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/chan.n: Fold in the descriptive parts of the documentation
- for all the commands that [chan] builds on top of.
+ * 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).
-2005-06-09 Vince Darley <vincentdarley@users.sourceforge.net>
+2012-09-07 Harald Oehlmann <oehhar@users.sf.net>
- * generic/tclFCmd.c: fix to race condition in file mkdir [Bug 1217375]
- * doc/glob.n: improve glob documentation [Bug 1190891]
+ *** 8.6b3 TAGGED FOR RELEASE ***
-2005-06-09 Donal K. Fellows <dkf@users.sf.net>
+ IMPLEMENTATION OF TIP#404.
- * doc/expr.n, doc/mathfunc.n: Fix minor typos [Bug 1211078] and
- add mention of distinctly-relevant [namespace path] subcommand.
+ * 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.
-2005-06-07 Don Porter <dgp@users.sourceforge.net>
+2012-08-25 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h: Reduced the Tcl_ObjTypes "index",
- * generic/tclIndexObj.c: "ensembleCmd", "localVarName", and
- * generic/tclNamesp.c: "levelReference" to file static scope.
- * generic/tclProc.c:
- * generic/tclVar.c:
+ * library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of
+ March in Ukrainian. Thanks to Mikhail Teterin for reporting.
- * generic/tclObj.c: Restored registration of the "procbody"
- Tcl_ObjType, as required by the tclcompiler application.
+2012-08-23 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclDecls.h: make genstubs
+ * 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:
-2005-06-07 Donal K. Fellows <dkf@users.sf.net>
+2012-08-17 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclIO.c (Tcl_ChannelTruncateProc): Stop proliferation of
- * generic/tcl.h: channel type versions
- * doc/CrtChannel.3: following advice from AKu
+ * win/nmakehlp.c: Add "-V<num>" option, in order to be able to detect
+ partial version numbers.
- Bump patchlevel to a4 to distinguish from a3 release.
+2012-08-15 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h (INTERP_TRACE_IN_PROGRESS): Add flag so the error
- * generic/tclIndexObj.c (Tcl_WrongNumArgs): messages from ensembles
- * generic/tclIOCmd.c (Tcl_ReadObjCmd): can be correct.
+ * win/buildall.vc.bat: Only build the threaded builds by default
+ * win/rules.vc: Some code cleanup
- TIP#208 IMPLEMENTATION
+2010-08-13 Stuart Cassoff <stwo@users.sourceforge.net>
- * library/init.tcl: Create the chan ensemble.
- * tests/chan.test: Rudimentary test suite.
- * doc/chan.n: General documentation.
+ * unix/tclUnixCompat.c: [Bug 3555454]: Rearrange a bit to quash
+ 'declared but never defined' compiler warnings.
- TRUNCATION API (part of TIP#208)
- * generic/tcl.h, generic/tcl.decls: Declaration of the API.
- * doc/CrtChannel.3, doc/OpenFileChnl.3: Documentation of the API.
- * generic/tclBasic.c (Tcl_CreateInterp): Create the mapping into Tcl.
- * generic/tclIOCmd.c (TclChanTruncateObjCmd): Implementation of
- Tcl-level truncation API.
- * generic/tclIO.c (Tcl_TruncateChannel): Generic C-level
- truncation API implementation.
- * unix/tclUnixChan.c (FileTruncateProc): Basic implementation of
- truncating driver.
+2012-08-13 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWinChan.c (FileTruncateProc): Added implementation of
- file truncation for Windows.
- * tests/chan.test (chan-15.2): Added real test of truncation.
+ * 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:
-2005-06-06 Kevin B. Kenny <kennykb@acm.org>
+2012-08-09 Reinhard Max <max@suse.de>
- * win/tclWin32Dll.c: Corrected another buglet in the assembly code for
- stack probing on Win32/gcc. [Bug #1213678]
- * generic/tclObj,c: Added missing 'static' on definition of
- UpdateStringOfBignum, and removed a 'switch' on a 'long long' operand
- (which HP-UX native 'cc' seems unable to handle). [Bug #1215775]
-
-2005-06-04 Jeff Hobbs <jeffh@ActiveState.com>
+ * tests/http.test: Fix http-3.29 for machines without IPv6 support.
- *** 8.5a3 TAGGED FOR RELEASE ***
+2010-08-08 Stuart Cassoff <stwo@users.sourceforge.net>
- * unix/Makefile.in (dist): add libtommath
+ * unix/tclUnixCompat.c: Change one '#ifdef' to '#if defined()' for
+ improved consistency within the file.
-2005-06-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2012-08-08 Jan Nijtmans <nijtmans@users.sf.net>
- * library/parray.tcl (parray): Only generate the sorted list of
- element names once. Thanks to Andreas Leitgeb for spotting this.
+ * generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname
+ * tests/fileName.test: support
-2005-06-03 Daniel Steffen <das@users.sourceforge.net>
+2012-08-07 Don Porter <dgp@users.sourceforge.net>
- * macosx/Makefile: fixed 'embedded' target.
+ * generic/tclIOUtil.c: [Bug 3554250]: Overlooked one field of cleanup
+ in the thread exit handler for the filesystem subsystem.
-2005-06-02 Jeff Hobbs <jeffh@ActiveState.com>
+2012-07-31 Donal K. Fellows <dkf@users.sf.net>
- * unix/Makefile.in (html): add BUILD_HTML_FLAGS optional var
- * tools/tcltk-man2html.tcl: add a --useversion to prevent
- confusion when multiple Tcl source dirs exist.
+ * 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.
-2005-06-01 Don Porter <dgp@users.sourceforge.net>
+2012-07-31 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclBasic.c: For compatibility with earlier Tcl releases,
- * generic/tclResult.c: when a command procedure simply does a
- * generic/tclTest.c: "return TCL_RETURN;" we must interpret that
- * tests/result.test: the same as
- "return Tcl_SetReturnOptions(interp, Tcl_NewObj());" [Bug 1209759].
+ * 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).
-2005-06-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2012-07-29 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclCompCmds.c (TclCompileSwitchCmd): Allow compilation
- of -nocase -glob [switch]es (only one we know how to compile).
+ * 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.
- TIP#241 IMPLEMENTATION from Joe Mistachkin
+2012-07-28 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
- * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Implementation of -nocase
- option for [lsearch], [lsort] and [switch] commands.
- * win/tclWinPort.h: Win uses nonstandard function names...
- * tests/cmdIL.test, tests/lsearch.test, tests/switch.test: Tests
- * doc/lsearch.n, doc/lsort.n, doc/switch.n: Docs
+ * tests/clock.test: [Bug 3549770]: Multiple test failures running
+ * tests/registry.test: tcltest outside build tree
+ * tests/winDde.test:
- * generic/tclCompCmds.c (TclCompileLindexCmd): Compile the most
- common case of [lindex] more efficiently.
+2012-07-27 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier): Pass the correct
- number of arguments to Tcl_JoinThread.
+ * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign)
+ * generic/regc_locale.c:
-2005-05-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2012-07-25 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * unix/configure.in, unix/tcl.m4: Standardize generation of help
- messages to always use AC_HELP_STRING and always (except for
- --with-tcl and --with-tk, where the default is complex) say what
- the default is.
+ * win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows
+ pipe driver to its fate when needed to honour TIP#398.
-2005-05-31 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+2012-07-24 Trevor Davel <twylite@crypt.co.za>
- * unix/tclUnixNotfy.c: the notifier thread is now created as
- joinable thread and it is properly joined in Tcl_FinalizeNotifier.
- This is an attempt to fix the Tcl Bug #1082283.
+ * 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.
-2005-05-30 Zoran Vasiljevic <vasiljevic@users.sf.net>
+2012-07-19 Reinhard Max <max@suse.de>
- * win/tclWinThrd.c: Fixed Tcl Bug #1204064.
+ * 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.
-2005-05-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2012-07-23 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- TIP #229 IMPLEMENTATION
+ * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead
+ channel, just like before 2011-08-17.
- * generic/tclNamesp.c (Tcl_FindCommand, TclResetShadowedCmdRefs)
- (NamespacePathCmd, SetNsPath, UnlinkNsPath, TclInvalidateNsPath):
- Implementation of the [namespace path] command and the command
- name resolution engine.
- * doc/info.n, doc/namespace.n: Doc updates.
- * tests/namespace.test (namespace-51.*): Test updates.
- * generic/tclResolve.c (BumpCmdRefEpochs, Tcl_SetNamespaceResolvers):
- * generic/tclBasic.c (Tcl_CreateCommand, Tcl_CreateObjCommand):
- Ensure that people don't see stale paths.
- * generic/tclInt.h (Namespace, NamespacePathEntry): Structure defs.
- * generic/tclCmdIL.c (InfoCommandsCmd): Updates to [info commands].
+2012-07-19 Joe Mistachkin <joe@mistachkin.com>
-2005-05-26 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tclTest.c: Fix several more missing mutex-locks in
+ TestasyncCmd.
- * macosx/Makefile: moved & corrected EMBEDDED_BUILD check.
-
- * unix/configure.in: corrected framework finalization to softlink
- stub library to Versions/8.x subdir instead of Versions/Current.
- * unix/configure: autoconf-2.59
+2012-07-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2005-05-25 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in
+ TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart
+ Cassoff for spotting it.
- * generic/tclCmdMZ.c (Tcl_TimeObjCmd): add necessary cast
+2012-07-17 Jan Nijtmans <nijtmans@users.sf.net>
-2005-05-25 Don Porter <dgp@users.sourceforge.net>
+ * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails
- TIP#182 IMPLEMENTATION [Patch 1165062]
+2012-07-16 Donal K. Fellows <dkf@users.sf.net>
- * doc/mathfunc.n: New built-in math function bool().
- * generic/tclBasic.c:
- * tests/expr.test:
- * tests/info.test:
+ * 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>
-2005-05-24 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/init.tcl: Updated [unknown] to be sure the [return]
- * tests/init.test: options from an auto-loaded command are
- seen correctly by the caller.
+ * 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>
-2005-05-24 Daniel Steffen <das@users.sourceforge.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.
- * tests/env.test: added DYLD_FRAMEWORK_PATH to the list of env vars
- that need to be handled specially.
+2012-06-26 Jan Nijtmans <nijtmans@users.sf.net>
- * macosx/Makefile:
- * macosx/README:
- * macosx/Tcl-Info.plist.in (new file):
+ * 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:
- * unix/configure.in:
- * unix/tcl.m4:
- * unix/tclUnixInit.c: moved all Darwin framework build support from
- macosx/Makefile into the standard unix configure/make buildsystem, the
- macosx/Makefile is no longer required to build Tcl.framework (but its
- functionality is still available for backwards compatibility).
- * unix/configure: autoconf-2.59
- * generic/tclIOUtil.c (TclLoadFile):
- * generic/tclInt.h:
- * unix/tcl.m4:
- * unix/tclLoadDyld.c: added support for [load]ing .bundle binaries in
- addition to .dylib's: .bundle's can be [unload]ed (unlike .dylib's),
- and can be [load]ed from memory, e.g. directly from VFS without
- needing to be written out to a temporary location first. [Bug 1202209]
- * unix/configure: autoconf-2.59
- * unix/tclConfig.h.in: autoheader-2.59
+2012-06-26 Reinhard Max <max@suse.de>
- * generic/tclCmdMZ.c (Tcl_TimeObjCmd): change [time] called with a
- count > 1 to return a string with a float value instead of a rounded
- off integer. [Bug 1202178]
+ * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
+ * unix/tclUnixSock.c:
- * doc/expr.n:
- * doc/string.n: fixed roff syntax complaints from 'make html'.
+2012-06-25 Don Porter <dgp@users.sourceforge.net>
-2005-05-20 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.
- * generic/tclParseExpr.c: Corrected parser to recognize all
- boolean literals accepted by Tcl_GetBoolean, including prefixes
- like "y" and "f", and to allow "eq" and "ne" as function names
- in the proper context. [Bug 1201589].
+2012-06-25 Donal K. Fellows <dkf@users.sf.net>
-2005-05-19 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.
- * generic/tclBasic.c (TclEvalObjvInternal): Rewrite for greater
- clarity; although 'goto' is Bad, the contortions you have to go
- through to avoid it can be worse...
+2012-06-25 Jan Nijtmans <nijtmans@users.sf.net>
-2005-05-19 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
+ * tests/fileName.test: support.
- * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): fixed crashing
- CFRelease of runLoopSource in Tcl_InitNotifier (reported by Zoran):
- CFRunLoopAddSource doesn't CFRetain, so can only CFRelease the
- runLoopSource in Tcl_FinalizeNotifier.
+2012-06-23 Jan Nijtmans <nijtmans@users.sf.net>
-2005-05-18 Don Porter <dgp@users.sourceforge.net>
+ * unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling
+ win32 events.
- * generic/tclBasic.c (Tcl_ExprBoolean): Rewrite as wrapper around
- Tcl_ExprBooleanObj.
+2012-06-22 Reinhard Max <max@suse.de>
- * generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite
- dropping string-based Tcl_GetBoolean call, so that internal reps
- are kept for subsequent quick boolean operations.
+ * 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.
- * generic/tclExecute.c: Dropped most special handling of the
- "boolean" Tcl_ObjType, since that type should now be rarely
- encountered.
+2012-06-21 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/BoolObj.3: Rewrite of documentation dropping many details
- about the internals of Tcl_Objs. Shorter documentation focuses on
- the function and use of the routines.
+ * win/tclWinReg.c: [Bug 3362446]: registry keys command fails
+ * tests/registry.test: with 8.5/8.6
- * generic/tclInt.h: Revision to the "boolean" Tcl_ObjType, so
- * generic/tclObj.c: that only string values like "yes" and "false"
- * tests/obj.test: are kept as the "boolean" Tcl_ObjType. The
- string values "0" and "1" are kept as "int" Tcl_ObjType, which also
- produce quick calls to Tcl_GetBooleanFromObj(). Since this internal
- change means a Tcl_ConvertToType to a "boolean" Tcl_ObjType might
- not produce a Tcl_Obj of type "boolean", the registration of the
- "boolean" type is also removed.
- ***POTENTIAL INCOMPATIBILITY***
- For callers of Tcl_GetObjType on the type name "boolean".
-
-2005-05-17 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclObj.c (TclInitObjSubsystem): Removed the
- * tests/listObj.test: registration of the Tcl_ObjType's "list",
- * tests/obj.test: "procbody", "index", "ensembleCommand",
- "localVarName", and "levelReference". The only reason to register
- a Tcl_ObjType is to have it returned by Tcl_GetObjType, and the
- only reason for that is to retrieve a (Tcl_ObjType *) to pass to
- Tcl_ConvertToType(). None of the types above can support a
- Tcl_ConvertToType() call; they panic. Better not to offer something
- than to lead users into a panic.
+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***
- For callers of Tcl_GetObjType on the type names listed above.
+ 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.
-2005-05-15 Kevin Kenny <kennykb@users.sourceforge.net>
+ * 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.
- * win/tclWin32Dll.c: conditioned definition of
- EXCEPTION_REGISTRATION structures on HAVE_NO_SEH, to fix a bug in
- buildability on MSVC.
-
-2005-05-14 Daniel Steffen <das@users.sourceforge.net>
+ * 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).
- * generic/tclInt.decls:
- * generic/tclTest.c:
- * generic/tclUtil.c:
- * win/tclWin32Dll.c: fixed link error due to direct access by
- tclTest.c to the MODULE_SCOPE tclPlatform global: renamed existing
- TclWinGetPlatform() accessor to TclGetPlatform() and moved it to
- generic code so that it can be used by on all platforms where
- MODULE_SCOPE is enforced.
-
- * macosx/tclMacOSXBundle.c:
- * unix/tclUnixInit.c:
- * unix/tcl.m4 (Darwin): made use of CoreFoundation API configurable
- and added test of CoreFoundation availablility to allow building on
- ppc64, replaced HAVE_CFBUNDLE by HAVE_COREFOUNDATION; test for
- availability of Tiger or later OSSpinLockLock API.
+2012-05-16 Donal K. Fellows <dkf@users.sf.net>
- * unix/tclUnixNotfy.c:
- * unix/Makefile.in:
- * macosx/tclMacOSXNotify.c (new file): when CoreFoundation is
- available, use new CFRunLoop based notifier: allows easy integration
- with other event loops on Mac OS X, in particular the TkAqua Carbon
- event loop is now integrated via a standard tcl event source (instead
- of TkAqua upon loading having to finalize the exsting notifier and
- replace it with its custom version). [Patch 1202052]
+ * 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.
- * tests/unixNotfy.test: don't run unthreaded tests on Darwin
- since notifier may be using threads even in unthreaded core.
+2012-05-13 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclUnixPort.h:
- * unix/tcl.m4 (Darwin): test for thread-unsafe realpath durning
- configure, as Darwin 7 and later realpath is threadsafe.
-
- * macosx/Makefile: enable configure caching.
+ * win/tclWinDde.c: Protect against receiving strings without ending
+ \0, as external applications (or Tcl with TIP #106) could generate
+ that.
- * unix/configure.in: wrap tclConfig.h header in #ifndef _TCLCONFIG so
- that it can be included more than once without warnings from gcc4.0
- (as happens e.g. when including both tclInt.h and tclPort.h)
+2012-05-10 Jan Nijtmans <nijtmans@users.sf.net>
- * macosx/tclMacOSXBundle.c:
- * unix/tclUnixChan.c:
- * unix/tclLoadDyld.c:
- * unix/tclUnixInit.c: fixed gcc 4.0 warnings.
+ * win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent
+ * library/dde/pkgIndex.tcl: Increase version to 1.3.3
- * unix/configure: autoconf-2.59
- * unix/tclConfig.h.in: autoheader-2.59
+2012-05-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclStubInit.c: make genstubs
-
-2005-05-13 Kevin Kenny <kennykb@acm.org>
-
- * win/tclWin32Dll.c: Further rework of the SEH logic. All
- EXCEPTION_REGISTRATION records are now
- in the activation record rather than pushed
- on the stack.
-
-2005-05-13 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c: Dropped the TCL_NO_MATH configuration.
- * generic/tclBinary.c: It's believed this has not been working
- * generic/tclExecute.c: in a long time. Tcl needs math.h.
- * unix/Makefile.in: [RFE 1200680].
-
-2005-05-12 Kevin Kenny <kennykb@acm.org>
-
- * doc/mathfunc.n: Changed NAME line to match the name of the page.
-
-2005-05-11 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclStrToD.c (TclStrToD, RefineResult, ParseNaN):
- Changed the code to cast 'char' to UCHAR explicitly when
- using ctype macros, to silence complaints from the Solaris
- compiler.
-
-2005-05-10 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly
- compliant compilers that don't like trailing ,s.
-
- * tests/string.test: string-10.[21-30]
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to
- prevent possible UMR in unichar cmp function for string map.
-
-2005-05-10 Kevin Kenny <kennykb@acm.org>
-
- * generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's
- resulted in reads of uninitialized memory when using 'd',
- 'q', or 'Q' format.
- * generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to
- handle the peculiarities of HP's PA_RISC, which uses a different
- 'quiet' bit in NaN from everyone else.
- * libtommath/tommath_superclass.h: Corrected C++-style comment.
-
-2005-05-10 Kevin Kenny <kennykb@acm.org>
-
- Merged all changes on kennykb-numerics-branch back into the
- HEAD. TIP's 132 and 232 are now Final.
-
-2005-05-10 Kevin Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch] Merged changes from HEAD.
-
-2005-05-10 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c (ExponLong, ExponWide):
- * tests/expr.test (expr-23.34/35): fixed special case 'i**0' for
- i>0 [Bug 1198892]
-
-2005-05-09 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
- * win/tclWin32Dll.c (TclpCheckStackSpace, TclWinCPUID):
- Reworked structured event handling to function even
- with -fomit-frame-pointers.
-
-2005-05-08 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
- * generic/tclStrToD.c: Made code more portable by finding a
- workaround for MSVC's 'volatile' issue that
- does not require conditional compilation.
- * win/tclWin32Dll.c (TclWinCPUID): Removed structured event
- handling from the GCC code
- since (a) bad code is generated
- by the instruction scheduling
- with -O2, and (b) it's not
- needed on any reasonably modern
- CPU.
-
-2005-05-07 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
- * generic/tclEvent.c: Moved initialization of tclStrToD.c's
- * generic/tclInt.h: static constants into a procedure called
- * generic/tclStrToD.c: from TclInitSubsystems to avoid double
- checked locking protocol. Cleaned up
- an issue where MSVC ignored the 'volatile'
- specifier, causing incorrect comparison
- of an underflowed number against zero.
-
-2005-05-06 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and
- add support for x86_64 Solaris cc builds.
-
-2005-05-05 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch] Merged with HEAD.
-
-2005-05-05 Kevin B. Kenny <kennykb@acm.org>
-
- * win/tclWinThrd.c: Corrected a compilation error on the
- --enable-threads configuration.
-
-2005-05-05 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInt.decls: Converted TclMatchIsTrivial to a macro.
- * generic/tclInt.h:
- * generic/tclUtil.c:
- * generic/tclIntDecls.h: `make genstubs`
- * generic/tclStubInit.c:
- * generic/tclBasic.c: Added callers of TclMatchIsTrivial where
- * generic/tclCmdIL.c: a search can be done more efficiently
- * generic/tclCompCmds.c:when it is recognized that a pattern match
- * generic/tclDictObj.c: is really an exact match. [Patch 1076088]
- * generic/tclIO.c:
- * generic/tclNamesp.c:
- * generic/tclVar.c:
+ * {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/tclCompCmds.c: Factored common efficiency trick into
- a macro named CompileWord.
+ * 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.
- * generic/tclCompCmds.c: Replaced all instance of
- * generic/tclCompile.c: TCL_OUT_LINE_COMPILE with TCL_ERROR.
- * generic/tclInt.h: Now that we've eradicated the mistaken
- * tests/appendComp.test: notion of a "compile-time error", we
- can use the TCL_ERROR return code to signal any failure to produce
- bytecode.
+ * 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.
-2005-05-03 Don Porter <dgp@users.sourceforge.net>
+2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * doc/DString.3: Eliminated use of identifier "string" in Tcl's
- * doc/Environment.3: public C API to avoid conflict/confusion with
- * doc/Eval.3: the std::string of C++.
- * doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3:
- * doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3:
- * doc/Utf.3, generic/tcl.decls, generic/tclBasic.c, generic/tclEnv.c:
- * generic/tclGet.c, generic/tclParse.c, generic/tclParseExpr.c:
- * generic/tclRegexp.c, generic/tclResult.c, generic/tclUtf.c:
- * generic/tclUtil.c, unix/tclUnixChan.c:
+ * generic/tclIO.c: Properly close nonblocking channels even when
+ not flushing them.
- * generic/tclDecls.h: `make genstubs`
+2012-05-03 Jan Nijtmans <nijtmans@users.sf.net>
-2005-05-02 Don Porter <dgp@users.sourceforge.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)
- * generic/tcl.decls:
- * generic/tclBasic.c: Simplified implementation of Tcl_ExprString.
- * tests/expr-old.test:
+2012-05-03 Don Porter <dgp@users.sourceforge.net>
- * generic/tclDecls.h: `make genstubs`
+ * tests/socket.test: [Bug 3428754]: Test socket-14.2 tolerate
+ [socket -async] connection that connects synchronously.
-2005-04-30 Daniel Steffen <das@users.sourceforge.net>
+ * unix/tclUnixSock.c: [Bug 3428753]: Fix [socket -async] connections
+ that manage to connect synchronously.
- * unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes.
+2012-05-02 Jan Nijtmans <nijtmans@users.sf.net>
-2005-04-29 Don Porter <dgp@users.sourceforge.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.
- TIP#176 IMPLEMENTATION [Patch 1165695]
+2012-04-30 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * generic/tclUtil.c: Extended TclGetIntForIndex to recognize
- index formats including end+integer and integer+/-integer.
+ * tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan
+ tests.
- * generic/tclCmdMZ.c: Extended the -start switch of [regexp]
- and [regsub] to accept all index formats known by TclGetIntForIndex.
+2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * doc/lindex.n: Updated docs to note new index formats.
- * doc/linsert.n, doc/lrange.n, doc/lreplace.n, doc/lsearch.n:
- * doc/lset.n, doc/lsort.n, doc/regexp.n, doc/regsub.n, doc/string.n:
+ IMPLEMENTATION OF TIP#398
- * tests/cmdIL.test: Updated tests.
- * tests/compile.test, tests/lindex.test, tests/linsert.test:
- * tests/lrange.test, tests/lreplace.test, tests/lsearch.test:
- * tests/lset.test, tests/regexp.test, tests/regexpComp.test:
- * tests/string.test, tests/stringComp.test, tests/util.test:
+ * generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
+ * tests/io.test : *** POTENTIAL INCOMPATIBILITY ***
+ * doc/close.n : (compat flag available)
-2005-04-28 Don Porter <dgp@users.sourceforge.net>
+2012-04-27 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/unixInit.test (7.1): Alternative fix for the 2004-11-11 commit.
+ * 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:
-2005-04-27 Don Porter <dgp@users.sourceforge.net>
+2012-04-27 Donal K. Fellows <dkf@users.sf.net>
- * library/init.tcl: Corrected flaw in interactive command
- * tests/main.test: auto-completion. [Bug 1191409].
+ * library/init.tcl (auto_execok): Allow shell builtins to be detected
+ even if they are upper-cased.
- TIP#183 IMPLEMENTATION [Patch 577093]
+2012-04-26 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclIOUtil.c (TclGetOpenModeEx): New routine.
- * generic/tclInt.h:
+ * 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);
- * generic/tclIO.c (Tcl_OpenObjCmd): Support for "b" and
- * doc/open.n: "BINARY" in "access" argument to [open].
- * tests/ioCmd.test:
-
-2005-04-26 Kevin B. Kenny <kennykb@users.sourceforge.net>
-
- * generic/tclBinary.c (FormatNumber):
- Dredge the NaN out of the internal representation if
- Tcl_GetDoubleFromObj returns TCL_ERROR on a NaN.
-
- * generic/tclObj.c (Tcl_GetDoubleFromObj):
- Restored silent overflow/underflow behaviour that the merge
- of 2004-04-25 messed up. Thanks to Don Porter for calling
- attention to this bug. Also removed an uninitialised memory
- reference in this function that valgrind caught. Also changed
- to return TCL_ERROR on a pure NaN.
-
- * generic/tclStrToD.c (RefineResult):
- Added a test for the initial approximation being HUGE_VAL;
- this test avoids EDOM being returned from ldexp on some platforms
- on input values exceeding the floating point range.
-
- * tests/expr.test (expr-29.*, expr-30.*):
- Added further tests of overflow/underflow on input conversions.
-
-2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net>
-
- [kennykb-numerics-branch] Merged with HEAD.
-
- * doc/CrtMathFunc.n: Revised documentation for TIP 232
-
-2005-04-25 Daniel Steffen <das@users.sourceforge.net>
-
- * compat/string.h: fixed memchr() protoype for __APPLE__ so that we
- build on Mac OS X 10.1 again.
-
- * generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being
- finalized in unthreaded core (was testing for notifier initialization in
- current thread by checking thread id != 0 but thread id is always 0 in
- untreaded core).
-
- * win/tclWinNotify.c (Tcl_WaitForEvent):
- * unix/tclUnixNotfy.c (Tcl_WaitForEvent): don't call ScaleTimeProc for
- zero wait times (as specified in TIP 233).
-
- * unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS
- from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS.
-
- * unix/tcl.m4 (Darwin): added configure checks for recently added linker
- flags -single_module and -search_paths_first to allow building with
- older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD and
- not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of symbols
- from libtclstub to avoid duplicate symbol warnings, added PLAT_SRCS
- definition for Mac OS X, defined MODULE_SCOPE to __private_extern__.
- (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check.
-
- * unix/configure: autoconf-2.59
-
-2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net>
-
- * library/tzdata/America/Boise:
- * library/tzdata/America/Chicago:
- * library/tzdata/America/Denver
- * library/tzdata/America/Indianapolis:
- * library/tzdata/America/Los_Angeles:
- * library/tzdata/America/Louisville:
- * library/tzdata/America/Managua:
- * library/tzdata/America/New_York:
- * library/tzdata/America/Phoenix:
+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/America/Indiana/Knox:
- * library/tzdata/America/Indiana/Marengo:
- * library/tzdata/America/Indiana/Vevay:
- * library/tzdata/America/Kentucky/Monticello:
- * library/tzdata/America/North_Dakota/Center:
- * library/tzdata/Asia/Tehran:
- Olson's tzdata2005i. Corrects exact time at which Standard Time
- was adopted in the US (generally, noon, Standard Time, rather than
- noon, Local Mean Time). Adopts new civil rules for Nicaragua
- and Iran.
-
-2005-04-25 Don Porter <dgp@users.sourceforge.net>
-
- * library/init.tcl: Use "ni" and "in" operators.
-
-2005-04-25 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: fix for [Bug 1189274].
-
-2005-04-24 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclLiteral.c: Silence compiler warnings.
- * generic/tclObj.c: [Bug 1188863].
-
-2005-04-22 Don Porter <dgp@users.sourceforge.net>
-
- The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring
- it into agreement with its docs. Further investigation reveals it
- was the docs that were incorrect.
-
- * doc/BoolObj.3: Corrections to the documentation of
- Tcl_GetBooleanFromObj to bring it into agreement with what this
- public interface has always done, including noting the difference
- in function between Tcl_GetBooleanFromObj and Tcl_GetBoolean.
-
- * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a
- wrapper around Tcl_GetBooleanFromObj (different function!).
-
- * generic/tclObj.c: Removed TclGetTruthValueFromObj routine
- that was added yesterday. Revisions so that only
- Tcl_GetBoolean-approved values get the "boolean" Tcl_ObjType.
- This retains the fix for [Bug 1187123].
- * tests/string.test: Test string-23.0 for Bug 1187123.
-
- * generic/tclInt.h: Revert most recent change.
- * generic/tclBasic.c:
- * generic/tclCompCmds.c:
- * generic/tclDictObj.c:
- * generic/tclExecute.c:
- * tests/obj.test:
-
-2005-04-21 Don Porter <dgp@users.sourceforge.net>
-
- * doc/GetInt.3: Convert argument "string" to "str" to agree with code.
- Also clarified a few details on int and double formats.
- * generic/tclGet.c: Radical code simplification. Converted
- Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj().
- Reduces code duplication, and the resulting potential for inconsistency.
-
- * generic/tclObj.c: Several changes:
-
- - Re-ordered error detection code so all values with trailing
- garbage receive a "not an integer" message instead of an
- "integer too large" message.
- - Removed inactive code meant to deal with strtoul* routines that
- fail to parse leading signs. All of them do, and if any are
- detected that do not, the correct fix is replacement with
- compat/strtoul*.c, not a lot of special care by the callers.
- - Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep.
- - Fixed Tcl_GetBooleanFromObj to agree with its documentation and
- with Tcl_GetBoolean, accepting only "0" and "1" and not other
- numeric strings. [Bug 1187123]
- - Added new private routine TclGetTruthValueFromObj to perform
- the more permissive conversion of numeric values to boolean
- that is needed by the [expr] machinery.
-
- * generic/tclInt.h (TclGetTruthValueFromObj): New routine.
- * generic/tclExecute.c: Updated callers to call new routine.
- * generic/tclBasic.c: Updated callers to call new routine.
- * generic/tclCompCmds.c: Updated callers to call new routine.
- * generic/tclDictObj.c: Updated callers to call new routine.
- * tests/obj.test: Corrected bad tests that actually expected
- values like "47" and "0xac" to be accepted as booleans.
-
- * generic/tclLiteral.c: Disabled the code that forces some literals
- into the "int" Tcl_ObjType during registration. We can re-enable it
- if this change causes trouble, but it seems more sensible to let
- Tcl's "on-demand" shimmering rule, and not try to pre-guess things.
-
-2005-04-20 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
- * doc/expr.n:
- * doc/mathfunc.n (new file): Revised documentation for TIP 232
-
-2005-04-20 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclGet.c (Tcl_GetInt): Corrected error that did not
- * generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be
- recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869].
-
-2005-04-20 Kevin B. Kenny <kennykb@acm.org>
-
- * generic/tclFileName.c: Silenced a compiler warning about
- '/*' within a comment.
-
-2005-04-19 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c: Added unsupported command
- * generic/tclCmdAH.c: [::tcl::unsupported::EncodingDirs] to permit
- * generic/tclInt.h: query/set of the encoding search path at
- * generic/tclInterp.c: the script level. Updated init.tcl to make
- * library/init.tcl: use of the new command. Also updated several
- coding practices in init.tcl ("eq" for [string equal], etc.)
-
-2005-04-19 Kevin B. Kenny <kennykb@acm.org>
-
- * library/clock.tcl (Initialize): Put initialization code into a
- proc to avoid inadvertently clobbering global variables.
- [Bug 1185933]
- * tests/clock.test (clock-48.1): Added regression test for the
- above bug.
- Thanks to Ulrich Ring for reporting this bug.
-
-2005-04-16 Miguel Sofer <msofer@users.sf.net>
-
- * generic/Var.c (Tcl_ArrayObjCmd - ARRAY_NAMES): fix Tcl_Obj leak
- [Bug 1084111]
-
-2005-04-16 Zoran Vasiljevic <vasiljevic@users.sf.net>
-
- * generic/tclIOUtil.c: force clenaup of the interp result
- in TclLoadFile(). Some implementations of TclpFindSymbol()
- will seed the interp result with error message when unable
- to find the requested symbol (this is not considered to
- be an error).
-
- Set of changes correcting huge memory waste (not a leak)
- when a thread exits. This has been introduced in 8.4.7
- within an attempt to correctly cleanup after ourselves when
- Tcl library is being unloaded with the Tcl_Finalize() call.
-
- This fixes the Tcl Bug #1178445.
-
- * generic/tclInt.h: added prototypes for TclpFreeAllocCache()
- and TclFreeAllocCache()
-
- * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc()
- to explicitly call TclpFreeAllocCache with the NULL-ptr as
- argument signalling cleanup of private tsd key used only by
- the threading allocator.
-
- * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize
- when being called with NULL argument. This is a signal for it
- to clean up the tsd key associated with the threading allocator.
-
- * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache
- and fixed to recognize when being called with NULL argument.
- This is a signal for it to clean up the tsd key associated with the
- threading allocator.
-
-2005-04-13 Don Porter <dgp@users.sourceforge.net>
-
- * tests/unixInit.test: Disabled obsolete tests and removed code
- * tests/encoding.test: that supported them.
- * generic/tclInterp.c:
+ * library/tzdata/Asia/Damascus:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Hebron: tzdata2012c
- * library/init.tcl: Use auto-loading to bring in Tcl Module
- * library/tclIndex: support as needed. This reduces startup
- * library/tm.tcl: time by delaying this initialization to
- a later time.
-
-2005-04-15 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: missing semicolons caused failure to
- compile with TCL_COMPILE_DEBUG.
-
-2005-04-13 David Gravereaux <davygrvy@pobox.com>
-
- * generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit
- * tests/io.test: changed from ten bytes to one byte. Need
- * tests/iogt.test: for this change was proven by
- Ross Cartlidge <rossc@cisco.com> where [read stdin 1] was grabbing
- 10 bytes followed by starting a child process that was intended to
- continue reading from stdin. Even with -buffersize set to one,
- nine chars were getting lost by the buffersize over reading for
- the native read() caused by [read].
-
-2005-04-13 Don Porter <dgp@users.sourceforge.net>
-
- * unix/tclUnixInit.c (TclpGetEncodingNameFromEnvironment): Reversed
- order of verifying candidate [encoding system] value, checking against
- a table in memory first before calling Tcl_GetEncoding and potentially
- scanning through the filesystem. Also ordered the table so that a
- binary search could be used within it. Improves startup time a bit
- more on some systems.
-
-2004-04-13 Kevin B. Kenny <kennykb@acm.org>
-
- * library/clock.n: Added a missing '--' on several [switch]
- commands to improve performance of [clock format] and related
- operations. [Feature Request 1182459]
-
-2005-04-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
-
- * doc/fcopy.n: Improved documentation on copying binary files,
- added an example and mentioned the use of [file copy].
- * doc/fconfigure.n: Improved documentation of -encoding binary
- option.
- This is all following comments from Steve Manning <steve@manning.net>
- on comp.lang.tcl that the current documentation was not clear.
-
-2005-04-13 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c:Commented out the functions
- TclPrintInstruction(), TclPrintObject() and TclPrintSource() when
- not debugging the compiler, as they are never called in that case.
-
-2005-04-12 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInterp.c: Corrected bad syntax of Tcl_Panic() call.
-
- * generic/tclUtil.c (TclGetProcessGlobalValue): More robust handling
- of bad TclInitProcessGlobalValueProc behavior; an immediate panic
- rather than a mysterious crash later.
-
- * generic/tclEncoding.c: Several changes to the way the
- encodingFileMap cache is maintained. Previously, it was attempted
- to keep the file map filled and up to date with changes in the
- encoding search path. This contributed to slow startup times since
- it required an expensive "glob" operation to fill the cache. Now the
- validity of items in the cache are checked at the time they are
- used, so the cache is permitted to fall out of sync with the
- encoding search path. Only [encoding names] and Tcl_GetEncodingNames()
- now pay the full expense. [Bug 1177363]
-
-2005-04-12 Kevin B. Kenny <kennykb@acm.org>
-
- * compat/strstr.c: Added default definition of NULL to
- accommodate building on systems with badly broken headers.
- [Bug #1175161]
-
-2005-04-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
-
- * tools/tclZIC.tcl: Rewrote to take advantage of more features of
- Tcl 8.5 (on which it was dependent anyway). Also added a [package
- require] line to formalize the relationship.
-
-2005-04-11 Kevin Kenny <kennykb@users.sf.net>
-
- [kennykb-numerics-branch] Merged with HEAD. Updated to libtommath 0.35.
-
- * generic/tclBasic.c: Attempted to repeat changes that applied
- to tclExecute.c in Miguel Sofer's commit of 2005-04-01, together
- with (possibly) a few more uses of his new object creation macros.
- Also plugged a memory leak in TclObjInvoke. [Bug 1180368]
-
-2005-04-10 Kevin Kenny <kennykb@acm.org>
-
- * library/tzdata/America/Montevideo:
- * library/tzdata/Asia/Almaty:
- * library/tzdata/Asia/Aqtau:
- * library/tzdata/Asia/Aqtobe:
- * library/tzdata/Asia/Baku:
- * library/tzdata/Asia/Jerusalem:
- * library/tzdata/Asia/Oral:
- * library/tzdata/Asia/Qyzylorda:
- * library/tzdata/Indian/Chagos:
- * library/tzdata/Indian/Cocos: Olson's tzdata2005h
-
-2005-04-10 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c (TclObjInvoke): Plug memory leak. [Bug 1180368]
-
-2005-04-09 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: fix possible leak of expansion Tcl_Objs
-
-2005-04-09 Daniel Steffen <das@users.sourceforge.net>
-
- * macosx/README: updated requirements for OS & developer tool
- versions + other small fixes/cleanup.
-
- * generic/tclListObj.c (Tcl_ListObjIndex): added missing NULL return
- when getting index from an empty list.
-
- * unix/tcl.m4 (Darwin): added -single_module linker flag to
- TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS.
- * unix/configure: autoconf-2.59
-
-2005-04-08 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInt.h (TclGetEncodingFromObj): New function to
- * generic/tclEncoding.c (TclGetEncodingFromObj): retrieve a
- Tcl_Encoding value, as well as cache it in the internal rep
- of a new "encoding" Tcl_ObjType.
- * generic/tclCmdAH.c (Tcl_EncodingObjCmd): Updated to call
- new function so that Tcl_Encoding's used by [encoding convert*]
- routines are not freed too quickly. [Bug 1077262]
-
-2005-04-08 Donal K. Fellows <dkf@users.sf.net>
-
- * generic/tclCompCmds.c (TclCompileSwitchCmd): Rewritten to be
- able to handle the other form of [switch] and generate slightly
- simpler (but longer) code.
-
-2005-04-06 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/upvar.n, doc/unset.n, doc/tell.n, doc/tclvars.n, doc/subst.n:
- * doc/seek.n, doc/scan.n, doc/regsub.n, doc/registry.n, doc/regexp.n:
- * doc/read.n, doc/puts.n, doc/pkgMkIndex.n, doc/open.n, doc/lreplace.n:
- * doc/lrange.n, doc/load.n, doc/llength.n, doc/linsert.n, doc/lindex.n:
- * doc/lappend.n, doc/info.n, doc/gets.n, doc/format.n, doc/flush.n:
- * doc/fileevent.n, doc/file.n, doc/fblocked.n, doc/close.n:
- * doc/array.n, doc/Utf.3, doc/TraceVar.3, doc/StrMatch.3, doc/RegExp.3:
- * doc/PrintDbl.3, doc/OpenTcp.3, doc/OpenFileChnl.3, doc/Object.3:
- * doc/Notifier.3, doc/LinkVar.3, doc/IntObj.3, doc/Interp.3:
- * doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3, doc/CrtMathFnc.3:
- * doc/CrtFileHdlr.3, doc/CrtCommand.3, doc/CrtChannel.3:
- * doc/Backslash.3: Purge old .VS/.VE macro instances.
-
- * tools/man2html2.tcl (IPmacro): Rewrote to understand what .IP
- really is (.IP and .TP are really just two ways of doing the same
- thing). Change below made this relevant.
- * doc/re_syntax.n: Change some uses of .TP to .IP to work around
- bugs in various *roff implementations. Also reworded the atom
- descriptions slightly.
-
-2005-04-05 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclExecute.c (ExprSrandFunc): Replaced incursions into the
- * generic/tclUtil.c (TclGetIntForIndex): intreps of numeric types
- with simpler calls of Tcl_GetIntFromObj and Tcl_GetLongFromObj,
- now that those routines are better behaved wrt shimmering.
- [Patch 1177219]
-
-2005-04-05 Miguel Sofer <msofer@users.sf.net>
+2012-04-16 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h:
- * generic/tclObj.c: Change in TclDecrRefCount and TclFreeObj, to
- speed up the freeing of simple Tcl_Obj [Patch 1174551]
+ * 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>
-2005-04-04 Miguel Sofer <msofer@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/tclExecute.c: small opts in obj handling
+ * generic/tclZlib.c (ZlibTransformSetOption): [Bug 3517696]: Make
+ flushing work correctly in a pushed compressing channel transform.
-2005-04-02 Miguel Sofer <msofer@users.sf.net>
+2012-04-12 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclVar.c: converted a few function calls to macros.
+ * generic/tclInt.decls: [Bug 3514475]: Remove TclpGetTimeZone and
+ * generic/tclIntDecls.h: TclpGetTZName
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * unix/tclUnixTime.c:
+ * unix/tclWinTilemc:
-2005-04-01 Miguel Sofer <msofer@users.sf.net>
+2012-04-11 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/ListObj.3:
+ * 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:
- * generic/tclCmdIL.c:
- * generic/tclConfig.c:
- * generic/tclExecute.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/tclInt.h:
* generic/tclIntDecls.h:
- * generic/tclListObj.c:
* generic/tclStubInit.c:
- * generic/tclVar.c: Changed the internal representation of lists
- to (a) reduce the malloc/free calls at list creation (from 2 to
- 1), (b) reduce the cost of handling empty lists (we now never
- create a list internal rep for them), (c) allow refcounting of the
- list internal rep. The latter permits insuring that the pointers
- returned by Tcl_ListObjGetElements remain valid even if the object
- shimmers away from its original list type. This is [Patch 1158008]
-
- * generic/tclExecute.c:
- * generic/tclInt.h:
- * generic/tclObj.c:
- * generic/tclStringObj.c:
- (1) defined new internal macros for creating and setting
- frequently used obj types (int,long, wideInt, double,
- string). Changed TEBC to use eg 'TclNewIntObj(objPtr, i)' to avoid
- the function call in 'objPtr = Tcl_NewIntObj(i)'
- (2) ExecEnv now stores two Tcl_Obj* pointing to the constants "0"
- and "1", for use by TEBC.
- (3) slight reduction in cost of INST_START_CMD
-2005-03-31 Miguel Sofer <msofer@users.sf.net>
+2012-04-03 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclExecute.c (INST_JUMP_TRUE/FALSE): replaced
- "test and branch" with "compute index into table"
+ * 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.
-2005-03-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+2012-03-30 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/FileSystem.3: Defined loadHandle argument. [Bug 1172401]
+ * 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].
-2005-03-29 Jeff Hobbs <jeffh@ActiveState.com>
+2012-03-27 Donal K. Fellows <dkf@users.sf.net>
- * win/tcl.m4, win/configure: do not require cygpath in macros to
- allow msys alone as an alternative.
+ IMPLEMENTATION OF TIP#395.
-2005-03-24 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
+ entier] check. Code by Jos Decoster.
- * generic/tclCompile.h: Move the TclInterpReady() declaration from
- * generic/tclInt.h: tclCompile.h to tclInt.h. Should have
- been done as part of the 1115904 bug fix on 2005-03-18.
+2012-03-27 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclThreadTest.c: Stop providing the phony package
- "Thread 1.0" when the [::testthread] command is defined. It's
- never used by anything, and conflicts with loading the real
- "Thread" package.
+ * 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.
-2005-03-18 Don Porter <dgp@users.sourceforge.net>
+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].
- * generic/tclCompCmds.c (TclCompileIncrCmd): Corrected checks
- for immediate operand usage to permit leading space and sign
- characters. Restores more efficient bytecode for [incr x -1]
- that got lost in the CONST string reforms of Tcl 8.4. [Bug 1165671]
+2012-03-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclBasic.c (Tcl_EvalEx): Restored recursion limit
- * generic/tclParse.c (TclSubstTokens): testing in nested command
- * tests/basic.test (basic-46.4): substitutions within direct
- * tests/parse.test (parse-19.*): script evaluation (Tcl_EvalEx)
- that got lost in the parser reforms of Tcl 8.1. Added tests for
- correct behavior. [Bug 1115904]
+ IMPLEMENTATION OF TIP#380.
-2005-03-15 Vince Darley <vincentdarley@users.sourceforge.net>
+ * 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.
- * generic/tclFileName.c:
+ ***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:
- * tests/winFCMd.test: fix to 'file pathtype' and 'file norm'
- failures on reserved filenames like 'COM1:', etc.
+ * win/tclWinPort.h:
-2005-03-15 Pat Thoyts <patthoyts@users.sourceforge.net>
+2012-03-12 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4: Updated the OpenBSD configuration and regenerated
- * unix/configure: the configure script.
-
-2005-03-15 Kevin B. Kenny <kennykb@acm.org>
+ * win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings
- [kennykb-numerics-branch] Merged with HEAD.
-
- * generic/tclBasic.c (many):
- * generic/tclCompExpr.c (CompileMathFuncCall):
- * generic/tclCompile.h:
- * generic/tclExecute.c (many):
- * generic/tclParseExpr.c (ParsePrimaryExpr):
- * tests/compExpr-old.test:
- * tests/compExpr.test:
- * tests/compile.test:
- * tests/expr-old.test:
- * tests/expr.test:
- * tests/for.test:
- * tests/parseExpr.test:
- Initial implementation of TIP #232.
-
- * generic/tclObj.c (Tcl_DbNewBignumObj): Fixed typo that broke
- --enable-symbols=mem build
- * tests/binary.test (binary-40.3, binary-40.6): Corrected tests
- to allow NaN(7ffffffffffff).
-
-2005-03-14 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: fixed INST_PUSH1's debugging code (wrong
- obj ref passed to TRACE_WITH_OBJ).
-
-2005-03-14 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c: fixed INST_RETURN's stack effect in
- tclInstructionTable (-1 instead of -2)
-
-2005-03-10 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompCmds.c: removed debugging line
-
-2005-03-10 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclTrace.c (TclCheckInterpTraces): Corrected mistaken
- cast of ClientData to (TraceCommandInfo *) when not warranted.
- Thanks to Yuri Victorovich for the report. [Bug 1153871]
- * generic/tcl.h: Moved flag values TCL_TRACE_ENTER_EXEC and
- * generic/tclInt.h: TCL_TRACE_LEAVE_EXEC from public interface
- into private. Should be used only by internal workings of
- execution traces.
-
-2005-03-09 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch] Merged from HEAD.
-
- * doc/PrintDbl.3:
- * doc/tclVars.n: Documented new semantics for tcl_precision.
- * generic/tclExecute.c (Tcl_ExecuteByteCode): Removed the check
- for division-by-zero on IEEE-754 machines.
- * generic/tclUtil.c (Tcl_PrintDouble): Corrected bug where numbers
- in the range [1e-4 .. 1.) were printed incorrectly.
- * tests/compExpr-old.test (compExpr-old-11.13): Revised test
- case for division by zero
- * tests/expr-old.test (expr-34.11, expr-34.12): Revised test
- cases for overflow in pow() to deal with infinities.
- * tests/expr.test (expr-11.13, expr-29.1, expr-29.2): Revised
- test case for division by zero and for underflow on input
- conversions.
- * tests/parseExpr.test (parseExpr-16.11): Revised test case for
- overflow on input conversion.
- * tests/string.test (string-6.38 deleted): Removed test case
- for underflow on input conversion, which is no longer an error.
- * tests/util.test (util-10.*): Added test case for the bug in
- tclUtil.c.
-
-2005-03-08 Jeff Hobbs <jeffh@ActiveState.com>
-
- * win/makefile.vc: clarify necessary defined vars that can come
- from MSVC or the Platform SDK.
-
-2005-03-07 Donal K. Fellows <dkf@users.sf.net>
-
- * doc/string.n: Minor typo. [Bug 1158247]
-
-2005-03-07 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c: new peephole optimisation for INST_PUSH1;
- fixed the peephole opt in INST_POP so that it is not used when
- TCL_COMPILE_DEBUG is defined.
-
-2005-03-04 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
-
- * generic/tclCmdMZ.c: Changed [scan] to treat out-of-range
- floating point values as infinities and zeroes.
- * generic/tclExecute.c: Changed [expr] to be permissive about
- infinities, allowing them to propagate.
- * generic/tclGet.c: Changed Tcl_GetDouble to be permissive about
- over/underflow.
- * generic/tclObj.c: Changed SetDoubleFromAny to be permissive
- about over/underflow.
- * generic/tclParseExpr.c: Made [expr] permissive about input
- numbers out of range.
-
-2005-03-03 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch]
+2012-03-11 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h:
- * generic/tclStrToD.c (Tcl_DoubleDigits, TclFormatNaN):
- * generic/tclUtil.c (Tcl_PrintDouble):
- Changed the signature of TclDoubleDigits so that it
- accepts a pointer to the signum of the argument, and
- returns the signum via that pointer. Added very
- hacky code to handle IEEE signed zeroes in Tcl_DoubleDigits.
- (It can't be done other than as a hack until C9x;
- C89 simply doesn't deal with the concept of -0.0).
- Added output conversion of tagged NaN values.
- * generic/tclBinary.c (FormatNumber):
- Changed to allow [binary format] to handle NaN.
- * tests/binary.test (binary-60.1):
- Added a quick-n-dirty test to make sure that NaN's
- can be scanned and formatted.
- * generic/tclParseExpr.c (GetLexeme, ParseMaxDoubleLength):
- Modified so that tagged NaN (e.g., NaN(DEADBEEF)) can
- be recognized.
-
-2005-03-02 Kevin B. Kenny <kennykb@acm.org>
-
- [kennykb-numerics-branch] Merged with HEAD as of 2005-02-23.
-
- * generic/tclExecute.c:
- Broadened test for NaN to work on Windows.
- * generic/tclInt.h:
- * generic/tclStrToD.c (Tcl_DoubleDigits):
- * generic/tclUtil.c (Tcl_PrintDouble, TclPrecTraceProc):
- Added Tcl_DoubleDigits to format 'double' numbers
- with the minimum number of significant digits to
- yield correct rounding. Modified tcl_precision to
- accept 0 as a precision (meaning "minimum digits"), and
- made 0 the default. [TIP #132]
- * generic/tclObj.c:
- Made NaN's throw an error in Tcl_GetDoubleFromObj.
+ * 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:
- * win/makefile.vc:
- Added libtommath/bn_mp_init_set.c to the build.
- * libtommath/tommath.h (mp_iseven):
- Fixed a bug that caused zero to test 'odd'.
- * generic/tommath.h:
- Regenerated.
- * tests/binary.test:
- * tests/expr-old.test:
- * tests/expr.test:
- * tests/scan.test:
- Corrected a number of tests that depended on
- tcl_precision, and removed the {eformat} condition
- from tests that no longer require it.
- * tests/util.test:
- Corrected a number of tests that depended on
- tcl_precision, and removed the {eformat} condition
- from tests that no longer require it. Added a series
- of tests for correct rounding in Tcl_PrintDouble. [TIP
- #132].
-
-2005-03-01 David N. Welton <davidw@dedasys.com>
-
- * doc/CrtSlave.3: Changed to Tcl_Object to Tcl_Obj in the man
- page.
-
-2005-02-24 Don Porter <dgp@users.sourceforge.net>
-
- * library/tcltest/tcltest.tcl: Better use of [glob -types] to avoid
- * tests/tcltest.test: failed attempts to [source] a directory, and
- similar matters. Thanks to "mpettigr". [Bug 1119798]
-
- * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8
+
+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:
-2005-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * changes: Updates toward 8.6b3 release.
- * doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605]
+2011-10-20 Donal K. Fellows <dkf@users.sf.net>
-2005-02-17 Jeff Hobbs <jeffh@ActiveState.com>
+ * 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.
- * win/tclWinFCmd.c (TraverseWinTree): use wcslen on wchar, not
- Tcl_UniCharLen.
+2011-10-18 Reinhard Max <max@suse.de>
-2005-02-16 Miguel Sofer <msofer@users.sf.net>
+ * 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.
- * doc/variable.n: fix for [Bug 1124160], variables are detected
- by [info vars] but not by [info locals].
-
-2005-02-11 Jeff Hobbs <jeffh@ActiveState.com>
+2011-10-15 Venkat Iyer <venkat@comit.com>
- * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined
- * unix/tcl.m4: into SHLIB_LD). Combine AIX-* and AIX-5
- * unix/configure: branches in SC_CONFIG_CFLAGS.
- Correct gcc builds for AIX-4+ and HP-UX-11. autoconf-2.59 gen'd.
+ * library/tzdata/America/Sitka: Update to Olson's tzdata2011l
+ * library/tzdata/Pacific/Fiji:
+ * library/tzdata/Asia/Hebron: (New)
-2005-02-11 Miguel Sofer <msofer@users.sf.net>
+2011-10-11 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/basic.test (basic-26.3): new test
+ * win/tclWinFile.c: [Bug 2935503]: Incorrect mode field returned by
+ [file stat] command.
-2005-02-10 Miguel Sofer <msofer@users.sf.net>
+2011-10-09 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclBasic.c (Tcl_EvalObjEx):
- * tests/basic.test (basic-26.2): preserve the arguments passed to
- TEOV in the pure-list branch, in case the list shimmers away. Fix
- for [Bug 1119369], reported by Peter MacDonald.
+ * 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).
-2005-02-10 Vince Darley <vincentdarley@users.sourceforge.net>
+2011-10-07 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclFileName.c: fix for test failures introduced
- on 2005-01-17 [Bug 1119092]
+ * 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.
-2005-02-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-10-06 Donal K. Fellows <dkf@users.sf.net>
- * doc/binary.n: Made the documentation of sign bit masking and
- [binary scan] consistent. [Bug 1117017]
+ * 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.
-2005-02-08 David N. Welton <davidw@dedasys.com>
+2011-10-05 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/CrtChannel.3: Typo: return->returns.
+ * win/tclWinInt.h: Remove tclWinProcs, as it is no longer
+ * win/tclWin32Dll.c: being used.
-2005-02-06 Kevin B. Kenny <kennykb@acm.org>
+2011-10-03 Venkat Iyer <venkat@comit.com>
- [kennykb-numerics-branch]
-
- * generic/tclStrToD.c (TclStrToD, SafeLdExp):
- Added code to manage the FPU precision on gcc+x86.
- Enabled fast conversion of floats with small exponents
- now that precision is correct.
- * tests/expr.test: Corrected test for the smallest representible
- value to the right IEEE values.
-
-2005-02-06 David N. Welton <davidw@dedasys.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:
- * doc/Thread.3: One-word grammar fix.
+2011-09-29 Donal K. Fellows <dkf@users.sf.net>
-2005-02-05 David N. Welton <davidw@dedasys.com>
+ * 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.
- * doc/Thread.3: Fixed sentence describing flags for
- Tcl_CreateThread.
+2011-09-28 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/FileSystem.3: Cleaned up typo in Tcl_FSNewNativePath
- documentation.
+ * generic/tclOO.h: [RFE 3010352]: make all TclOO API functions
+ * generic/tclOODecls.h: MODULE_SCOPE
+ * generic/tclOOIntDecls.h:
- * generic/tclPathObj.c: Cleaned up typo in comment.
+2011-09-27 Donal K. Fellows <dkf@users.sf.net>
-2005-02-03 Kevin B. Kenny <kennykb@acm.org>
+ * 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.
- [kennykb-numerics-branch]
-
- * generic/tclStrToD.c (TclStrToD, RefineResult, SafeLdExp):
- Added code to ensure that 'ldexp' is never called with
- a value that will underflow.
- * tests/expr.test: Added tests for the smallest representible
- value, and rounding between it and zero. (The tests reflect
- current behaviour; plan is to change the specification of
- Tcl so that input conversion of doubles underflows silently.)
-
-2005-02-02 Mo DeJong <mdejong@users.sourceforge.net>
+2011-09-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclProc.c (TclInitCompiledLocals):
- Add check for type of the framePtr->procPtr->bodyPtr
- passed to TclInitCompiledLocals and panic if
- it is not the correct type. If the body of the proc
- is not of the compiled byte code type then the
- code will crash. This was discovered while tracking
- down a crash in Itcl, that crash is fixed by
- Itcl patch 1115085.
+ * 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...
-2005-02-01 Kevin B. Kenny <kennykb@acm.org>
+2011-09-23 Don Porter <dgp@users.sourceforge.net>
- [kennykb-numerics-branch] Merged with HEAD as of today.
-
- * generic/tclInt.decls:
- Changed numbers of new stubs to resolve a conflict.
- * generic/tclInt.h:
- Added new TclStrToD routine that replaces the native
- 'strtod' thro
- ughout Tcl.
- * generic/tclCmdMZ (Tcl_StringObjCmd):
- * generic/tclGet.c (Tcl_GetDouble):
- * generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny):
- * generic/tclParseExpr.c (GetLexeme):
- * generic/tclScan.c (Tcl_ScanObjCmd):
- Replaced all uses of the native 'strtod' with a TclStrToD
- routine that performs correct rounding and handles denormals.
- * generic/tclStrToD.c: (new file)
- New scanning function for extracting 'double' from a string
- that rounds correctly, and handles denormals and infinities.
+ * 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:
- * win/Makefile.in:
- * win/makefile.vc:
- Added tclStrToD.c and the tommath routines that support it.
- These changes represent a partial implementation of TIP #132.
- Output conversion of floating point numbers, and proper handling
- of infinities within expressions, still need to be addressed.
-
-2005-02-01 Don Porter <dgp@users.sourceforge.net>
+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:
- * generic/tclExecute.c (TclCompEvalObj): Removed stray statement
- left behind in prior code reorganization.
+2011-09-16 Donal K. Fellows <dkf@users.sf.net>
-2005-01-31 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
+ Corrected the handling of procedure error messages (found by TclOO).
- * unix/configure: autoconf-2.57
+2011-09-16 Jan Nijtmans <nijtmans@users.sf.net>
-2005-01-30 Joe English <jenglish@users.sourceforge.net>
+ * generic/tcl.h: Don't change Tcl_UniChar type when
+ * generic/regcustom.h: TCL_UTF_MAX == 4 (not supported anyway)
- * unix/configure.in: Restored two double-evals that were
- removed in the DBGX purge; these are still needed on some
- platforms to account for TCL_TRIM_DOTS. [Bug 1112654]
+2011-09-16 Donal K. Fellows <dkf@users.sf.net>
- * unix/configure: NOT REGENERATED: only have autoconf 2.59 here,
- need to find someone with autoconf 2.57.
+ * 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.
-2005-01-28 Jeff Hobbs <jeffh@ActiveState.com>
+ * 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).
- * unix/configure, unix/tcl.m4: add solaris 64-bit gcc build
- support. [Bug 1021871]
+2011-09-15 Don Porter <dgp@users.sourceforge.net>
-2005-01-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * tests/expr-old.test (expr-old-37.2): Added test for [Bug 1109484]
+2011-09-13 Don Porter <dgp@users.sourceforge.net>
-2005-01-27 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclUtil.c: [Bug 3390638]: Workaround broken Solaris
+ Studio cc optimizer. Thanks to Wolfgang S. Kechel.
- * generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble)
- (Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484]
+ * generic/tclDTrace.d: [Bug 3405652]: Portability workaround for
+ broken system DTrace support. Thanks to Dagobert Michelson.
-2005-01-26 Andreas Kupries <andreask@activestate.com>
+2011-09-12 Jan Nijtmans <nijtmans@users.sf.net>
- TIP#218 IMPLEMENTATION
+ * win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with
+ EOVERFLOW==E2BIG
- * generic/tclDecls.h: Regenerated from tcl.decls.
- * generic/tclStubInit.c:
+2011-09-11 Don Porter <dgp@users.sourceforge.net>
- * doc/CrtChannel.3: Documentation of extended API,
- * generic/tcl.decls: extended testsuite, and
- * generic/tcl.h: implementation. Removal of old
- * generic/tclIO.c: driver-specific TclpCut/Splice
- * generic/tclInt.h: functions. Replaced with generic
- * tests/io.test: thread-action calls through the
- * unix/tclUnixChan.c: new hooks. Update of all builtin
- * unix/tclUnixPipe.c: channel drivers to version 4.
- * unix/tclUnixSock.c: Windows drivers extended to
- * win/tclWinChan.c: manage thread state in a thread
- * win/tclWinConsole.c: action handler.
- * win/tclWinPipe.c:
- * win/tclWinSerial.c:
- * win/tclWinSock.c:
+ * tests/thread.test: Convert [testthread] use to Thread package use
+ in thread-6.1. Eliminates a memory leak in `make valgrind`.
-2005-01-25 Don Porter <dgp@users.sourceforge.net>
+ * tests/socket.test: [Bug 3390699]: Convert [testthread] use to
+ Thread package use in socket_*-13.1. Eliminates a memory leak in
+ `make valgrind`.
- * library/auto.tcl: Updated [auto_reset] to clear auto-loaded
- commands in namespaces other than :: and to clear auto-loaded commands
- that do not happen to be procs. [Bug 1101670]
+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***
-2005-01-25 Daniel Steffen <das@users.sourceforge.net>
+2011-09-06 Venkat Iyer <venkat@comit.com>
- * unix/tcl.m4 (Darwin): fixed bug with static build linking to
- dynamic library in /usr/lib etc instead of linking to static library
- earlier in search path. [Tcl Bug 956908]
- Removed obsolete references to Rhapsody.
- * unix/configure: autoconf-2.57
+ * 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)
-2005-01-21 Andreas Kupries <andreask@activestate.com>
+2011-09-06 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclStubInit.c: Regenerated the stubs support code from
- * generic/tclDecls.h: the modified tcl.decls (TIP #233, see below).
+ * generic/tcl.h: [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
+ * generic/tclDecls.h:
+ * generic/tclMain.c:
- * doc/GetTime.3: Implemented TIP #233, i.e. the
- * generic/tcl.decls: 'Virtualization of Tcl's Sense of Time'.
- * generic/tcl.h: Declared, implemented, and documented the
- * generic/tclInt.h: specified new API functions. Moved the
- * unix/tclUnixEvent.c: native (OS) access to time information
- * unix/tclUnixNotfy.c: into standard handler functions. Inserted
- * unix/tclUnixTime.c: hooks calling on the handlers where native
- * win/tclWinNotify.c: access was done before, and where scaling
- * win/tclWinTime.c: between domains (real/virtual) is required.
+2011-09-02 Don Porter <dgp@users.sourceforge.net>
-2005-01-21 Andreas Kupries <andreask@activestate.com>
+ * tests/http.test: Convert [testthread] use to Thread package use.
+ Eliminates memory leak seen in `make valgrind`.
- * generic/tclThread.c: Typo police. Fixed some nits
- * generic/tclCmdAH.c: in header comments of functions.
- * generic/tclBasic.c: (Missing --).
- * generic/tclFileName.c:
+2011-09-01 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2005-01-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * doc/FileSystem.3: Add missing ARGUMENTS section definitions for
- arguments to Tcl_FSLink. [Bug 1106272]
+2011-09-01 Don Porter <dgp@users.sourceforge.net>
-2005-01-21 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclStrToD.c: [Bug 3402540]: Corrections to TclParseNumber()
+ * tests/binary.test: to make it reject invalid Nan(Hex) strings.
- [kennykb-numerics-branch]
+ * tests/scan.test: [scan Inf %g] is portable; remove constraint.
- * unix/Makefile.in: Updated Makefile to build libtommath on
- Unix as well as Windows. [Bug 1106865]
+2011-08-30 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclTestObj.c (TestbignumobjCmd):
- Silenced a compiler warning about a mismatched 'const'.
-
-2005-01-20 Kevin B. Kenny <kennykb@acm.org>
+ * 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).
- [kennykb-numerics-branch] Development checkpoint.
-
- * compat/strtoll.c: Reverted to HEAD.
- * compat/strtoull.c:
- * doc/Ensemble.3:
- * generic/tclBasic.c:
- * generic/tclCmdIL.c:
- * generic/tclNamesp.c:
- * generic/tclPathObj.c:
- * generic/tclPort.h:
- * unix/configure:
- * unix/configure.in:
- * unix/tcl.m4:
+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:
- * win/rules.vc:
- * win/tcl.m4:
+ * unix/tcl.spec:
+ * tools/tcl.wse.in:
+ * README:
- * generic/tcl.h: Added declarations for bignum types, and
- for a 'bignumValue' in the Tcl_Obj structure.
- * generic/tclInt.h: Added declarations of interface procedures
- for memory allocation in libtommath.
-
- * generic/tcl.decls: Added new interface to bignum objects.
- * generic/tclInt.decls: Added internal stubs for bignum routines
- used by the test code in tclTestObj.c.
-
- * generic/tclDecls/h: Regen.
- * generic/tclIntDecls.h:
- * generic/tclStubInit.h:
+ * unix/configure: autoconf-2.59
+ * win/configure:
- * tools/fix_tommath_h.tcl: (New file) Script to edit
- libtommath/tommath.h and produce
- generic/tommath.h so that storage
- classes, allocation routines, and
- data types conform to Tcl's
- conventions.
- * generic/tommath.h: (New file) Generated by the above.
+2011-07-15 Don Porter <dgp@users.sourceforge.net>
- * generic/tclTomMath.h: (New file) Additional declarations
- to be included in tommath.h when building
- Tcl.
+ * generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is
+ called in a deleted interp.
- * generic/tclTomMathInterface.c: (New file) Small 'glue' routines
- adapting tommath's API to Tcl.
+ * generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular
+ references in values with ByteCode intreps. They can lead to memory
+ leaks.
- * libtommath/bn_fast_s_mp_mul_digs.c:
- * libtommath/bn_mp_mul_d.c:
- * libtommath/bn_mp_read_radix.c:
- * libtommath/tommath.h: Applied suggested changes from Tom St
- Denis that correct an off-by-one error in single-digit
- multiplication (leading to a pointer smash if uncorrected) and
- change the string argument to 'mp_read_radix' from 'char*' to
- 'const char*'.
-
- * libtommath/bn_mp_radix_size.c:
- Local patch to ensure that sufficient memory is requested
- even if the number has a single digit.
-
- * libtommath/bn_mp_read_radix.c:
- Local patch to return MP_VAL if the input string contains
- an invalid character.
+2011-07-14 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclObj.c: Added accessor functions for bignums.
- * generic/tclTestObj.c: Added a 'testbignumobj' command to
- exercise the accessor functions for bignums.
+ * generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove
+ stray refcount bump that caused a memory leak.
- * win/Makefile.in: Added rules for making libtommath.
-
-2005-01-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-07-12 Don Porter <dgp@users.sourceforge.net>
- TIP#235 IMPLEMENTATION
+ * generic/tclUnixSock.c: [Bug 3364777]: Stop segfault caused by
+ reading from struct after it had been freed.
- * doc/Ensemble.3: Documentation for the new public API.
- * generic/tclNamesp.c (Tcl_CreateEnsemble,...): Rename of
- * generic/tcl.decls: existing API into TIPped form.
+2011-07-11 Joe Mistachkin <joe@mistachkin.com>
-2005-01-19 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tclExecute.c: [Bug 3339502]: Correct cast for CURR_DEPTH to
+ silence compiler warning.
- * win/tclWinChan.c (FileCloseProc): Invoke TclpCutFileChannel() to
- remove a FileInfo from the thread local list before deallocating
- it. This should have been done via an earlier call to
- Tcl_CutChannel, but I was running into a crash in the next call to
- Tcl_CutChannel during the IO finalization stage.
+2011-07-08 Donal K. Fellows <dkf@users.sf.net>
-2005-01-18 Kevin Kenny <kennykb@acm.org>
+ * doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1.
- * library/tzdata/GMT+0:
- * library/tzdata/GMT-0:
- * library/tzdata/GMT0:
- * library/tzdata/Greenwich:
- * library/tzdata/Navajo:
- * library/tzdata/Universal:
- * library/tzdata/Zulu:
- * library/tzdata/America/Asuncion:
- * library/tzdata/America/Rosario:
- * library/tzdata/Asia/Jerusalem:
- * library/tzdata/Brazil/Acre:
- Routine update per Olson's tzdata2005c. Removed links to links
- (Greenwich in several aliases; Navajo; Acre). Updated Paraguayan
- DST rules and "best guess" at this year's Israeli rules.
+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>
-2005-01-17 Vince Darley <vincentdarley@users.sourceforge.net>
+ * 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).
- * generic/tclFileName.c: fix for glob failure on Windows shares
- [Bug 1100542].
+2011-06-28 Reinhard Max <max@suse.de>
- * doc/pkgMkIndex.n: added documentation that 'pkg_mkIndex -lazy' is
- not a good idea. [Bug 1101678]
+ * 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].
-2005-01-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * tests/socket.test: Adjust tests to the async code changes. Add more
+ tests for corner cases of async sockets.
- * tests/compile.test (compile-17.1): Document known issue with
- binding time of compiled command interpretations in [expr].
+2011-06-22 Andreas Kupries <andreask@activestate.com>
- * generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so
- that we don't need to hard-code attribute indexes. [Bug 1100671]
+ * 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:
-2005-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclInt.h: Fixed the inadvertently committed disabling of
+ stack checks, see my 2010-11-15 commit.
- * doc/string.n: Removed the term 'set' from the documentation of
- the [string trim] commands, as it caused confusion.
+2011-06-22 Reinhard Max <max@suse.de>
-2005-01-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ 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
- * unix/tcl.m4 (SC_PATH_{TCL,TK}CONFIG): Added code to detect the
- case when the --with-tcl/--with-tk arguments point to the config
- scripts themselves and not their directory. If this is the case,
- they now complain but keep working. [FRQ 951247]
- * unix/configure: autoconf-2.57
+2011-06-21 Don Porter <dgp@users.sourceforge.net>
-2005-01-10 Joe English <jenglish@users.sourceforge.net>
+ * generic/tclLink.c: [Bug 3317466]: Prevent multiple links to a
+ single Tcl variable when calling Tcl_LinkVar().
- * unix/Makefile.in, unix/configure.in, unix/tcl.m4,
- * unix/tclConfig.sh.in, unix/dltest/Makefile.in:
- Remove ${DBGX}, ${TCL_DBGX} from Tcl build system [Patch 1081595].
- * unix/configure: regenerated
+2011-06-13 Don Porter <dgp@users.sourceforge.net>
-2005-01-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclStrToD.c: [Bug 3315098]: Mem leak fix from Gustaf
+ Neumann.
- * unix/tclUnixFCmd.c (TclUnixCopyFile): Convert u_int to unsigned
- to make clashes with types in standard C headers less of a
- problem. [Bug 1098829]
+2011-06-08 Andreas Kupries <andreask@activestate.com>
-2005-01-09 Joe English <jenglish@users.sourceforge.net>
+ * 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.
- * unix/tclUnixThrd.c, unix/tclUnixPort.h: Remove readdir_r()
- and related #ifdeffery (see #1095909).
- * unix/tcl.m4, unix/tclConfig.h.in: Don't check for HAVE_READDIR_R.
- * unix/configure: Regenerated.
+2011-06-08 Donal K. Fellows <dkf@users.sf.net>
-2005-01-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * library/http/http.tcl (http::mapReply): Significant performance
- enhancement by using [string map] instead of [regsub]/[subst], and
- update version requirement to Tcl8.4. [Bug 1020491]
+2011-06-06 Jan Nijtmans <nijtmans@users.sf.net>
-2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * doc/lsearch.n, doc/re_syntax.n: Convert to other form of emacs
- mode control comment to prevent problems with old versions of
- man. [Bug 1085127]
+2011-06-02 Don Porter <dgp@users.sourceforge.net>
-2005-01-05 Pat Thoyts <patthoyts@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.
- * tests/winDde.test: Fixed broken test result.
+2011-06-02 Donal K. Fellows <dkf@users.sf.net>
-2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * generic/tclInt.h, generic/tclPort.h: Move the #include of
- tclConfig.h *first* before any reference to tcl.h so that the
- build configuration is loaded before the first reference to any
- system headers. Issue reported by Art Haas on tcl-core.
+2011-06-01 Miguel Sofer <msofer@users.sf.net>
-2005-01-04 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c: Using the two free data elements in NRCommand to
+ store objc and objv - useful for debugging.
- * tests/fCmd.test (fCmd-18.10): Added notNetworkFilesystem constraint.
- [Bug 456665]
+2011-06-01 Jan Nijtmans <nijtmans@users.sf.net>
-2004-12-29 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclUtil.c: Fix for [Bug 3309871]: Valgrind finds: invalid
+ read in TclMaxListLength().
- * win/tcl.m4, win/configure: update MSVC CFLAGS_OPT to -O2, remove
- -Gs (included in -O2) and -GD (outdated). Use "link -lib" instead
- of "lib" binary and remove -YX for MSVC7 portability. Add
- -fomit-frame-pointer for gcc OPT compiles. [Bug 1092952, 1091967]
- Align LIBS_GUI with Tk head needs.
+2011-05-31 Don Porter <dgp@users.sourceforge.net>
-2004-12-29 Kevin B. Kenny <kennykb@acm.org>
+ * 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.
- * generic/tclDate.c: Regen
- * generic/tclGetDate.y (TclDatelex):
- Fixed a problem where a four-digit group with >=2
- leading zeroes appeared to be a two-digit group, leading to
- misinterpreting the time 0012 as 1200. [Bug # 1090413]
- * library/clock.tcl: Added code to interpret correctly months
- outside the range 01-12 as reduced modulo 12
- with a corresponding adjustment to the year.
- [Bug 1092789]
- * tests/clock.test: Added regression test cases for the above two
- bugs.
- * unix/Makefile.in: Added --no-lines to the 'bison' command line
- * win/Makefile.in: to help constrain the number of diffs in a cvs
- checkin.
-
-2004-12-24 Miguel Sofer <msofer@users.sf.net>
+2011-05-25 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCompile.c:
- * generic/tclCompile.h:
+ * 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/tclLiteral.c:
- * generic/tclProc.c:
- Avoid sharing cmdName literals accross namespaces, and generalise
- usage of the TclRegisterNewLiteral macro [Patch 1090905]
-
-2004-12-20 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c
- * generic/tclProc.c: new static InitCompiledLocals to allow for a
- single pass over the proc's arguments at proc load time (instead of
- two as previously). TclObjInterpProc() now allocates the
- compiledLocals on the tcl execution stack, using the new
- TclStackAlloc/Free functions.
-
-2004-12-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback):
- (TclLimitRemoveAllHandlers, TclInitLimitSupport): Set a timer
- event to trigger when the time limit runs out. All the time limit
- actually does is check to see if the time limit has been exceeded,
- but this is enough to fix [Bug 1085023].
- * generic/tclInt.h (struct Interp): Added a field to hold the token
- for the timer event handler associated with the current time limit.
- * generic/tclEvent.c (Tcl_UpdateObjCmd, Tcl_VwaitObjCmd): Add
- error message when limit exceeded.
- * tests/interp.test (interp-34.[89]): Check that time limits
- handle the two cases reported in [Bug 1085023]
-
- * generic/tclTimer.c (TclCreateAbsoluteTimerHandler): New internal
- function that allows setting a timer handler that will be
- triggered at (or after) a specific time instead of at some number
- of milliseconds in the future. This is a candidate for future
- exposure via a TIP.
-
-2004-12-15 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclListObj.c:
+ * generic/tclNamesp.c:
+ * generic/tclResult.c:
+ * generic/tclStringObj.c:
+ * generic/tclVar.c:
- * generic/tclBasic.c:
- * generic/tclExecute.c:
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
+ * 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:
- * generic/tclStubInit.c:
- * generic/tclTest.c: Added two new functions to allocate memory
- from the execution stack (TclStackAlloc, TclStackFree). Added
- functions TclPushStackFrame and TclPopStackFrame that do the work
- of Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames
- allocated in the execution stack - i.e., heap instead of
- C-stack. The core uses these two new functions exclusively; the
- old ones remain for backwards compat, as at least two popular
- extensions (itcl, xotcl) are known to use them.
-
-2004-12-14 Miguel Sofer <msofer@users.sf.net>
+ * macosx/tclMacOSXFCmd.c:
- * generic/tclCmdIL.c:
- * generic/tclInt.h:
+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:
- * generic/tclVar.c: changing the isProcCallFrame field of the
- CallFrame struct from a 0/1 field to flags. Should be perfectly
- backwards compatible.
-2004-12-14 Don Porter <dgp@users.sourceforge.net>
+2011-03-16 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure.in: Added special processing to remove "$U"
- from libraries in the LIBOBJS value. This is an auto-make-ism
- we need to avoid. [Bug 1081541]
+ * 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.
- * unix/configure: autoconf-2.57
+2011-03-14 Kevin B. Kenny <kennykb@acm.org>
-2004-12-13 Don Porter <dgp@users.sourceforge.net>
+ * 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/tcl.h: Restored extern "C" guards so that C++ code
- sees function pointer typedef linkage consistent with earlier Tcl
- releases. [Bug 1082349].
+ * 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*'.
- * generic/tclEncoding.c: Plugged some memory leaks. Thanks to
- * generic/tclUtil.c: Rolf Ade for reports and testing [Bug 1083082]
+2011-03-13 Miguel Sofer <msofer@users.sf.net>
-2004-12-13 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclExecute.c: remove TEBCreturn()
- * doc/clock.n: Clarify that the [clock scan] command does not
- accept the full range of ISO8601 point-in-time formats
- [Bug 1075433].
-
-2004-12-12 Miguel Sofer <msofer@users.sf.net>
+2011-03-12 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclVar.c (TclArrayObjCmd - ARRAY_NAMES): leaking an
- object [Bug 1084111] - thanks to Rolf Ade.
+ * 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).
-2004-12-12 Miguel Sofer <msofer@users.sf.net>
+2011-03-12 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclObj.c (TclSetCmdNameObj): special handling for fully
- qualified command names (as in fix [Patch 456668]).
+ * win/tclWinFile.c: [Bug 3185609]: File normalization corner case
+ of ... broken with -DUNICODE
-2004-12-11 Miguel Sofer <msofer@users.sf.net>
+2011-03-11 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h:
- * generic/tclNamesp.c: converting the static function
- GetNamespaceFromObj() to MODULE_SCOPE TclGetNamespaceFromObj().
+ * tests/unixInit.test: Make better use of tcltest2.
-2004-12-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-03-10 Donal K. Fellows <dkf@users.sf.net>
- * tools/tcl.wse.in, unix/tcl.spec, win/README.binary, README:
- * win/configure.in, unix/configure.in, generic/tcl.h:
- Bumped version number to 8.5a3 to distinguish HEAD of CVS
- development from the recent 8.5a2 release.
+ * 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***
-2004-12-10 Miguel Sofer <msofer@users.sf.net>
+ * 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/tclCompile.c (TclInitCompiledLocals):
- * generic/tclCompile.h:
- * generic/tclInt.h:
- * generic/tclProc.c (TclObjInterpProc, TclCreateProc): optimised
- loops that initialise a proc's arguments and compiled local
- variables, removing tests from inner loops.
+ * 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.
-2004-12-10 Donal K. Fellows <dkf@users.sf.net>
+2011-03-09 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h: Move ensemble API decls here from tclNamesp.c
+ * tests/incr.test: Update more of the test suite to use Tcltest 2.
-2004-12-09 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-03-09 Don Porter <dgp@users.sourceforge.net>
- * generic/tclNamesp.c (TclMakeEnsembleCmd, TclSetEnsemble*)
- (TclSetEnsemble*, TclFindEnsemble): Build an internal API for
- creating and manipulating ensembles; they can be deleted using the
- normal command-deletion API.
+ * 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/Async.3: Reword for better grammar, better nroff and get the
- flag name right. (Reported by David Welton.)
+ * doc/tclvars.n: Formatting fix. Thanks to Pat Thotys.
-2004-12-07 Don Porter <dgp@users.sourceforge.net>
+2011-03-09 Donal K. Fellows <dkf@users.sf.net>
- * tests/unixInit.test (2.1-4): Added constraints so that when a
- value of TCL_LIBRARY is required for process initialization, we skip
- the tests that mess with that value.
+ * tests/dstring.test, tests/init.test, tests/link.test: Update more of
+ the test suite to use Tcltest 2.
-2004-12-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-03-08 Jan Nijtmans <nijtmans@users.sf.net>
- *** 8.5a2 TAGGED FOR RELEASE ***
+ * 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
- * unix/Makefile.in: add library/{tzdata,msgs} to dist target (kbk)
+2011-03-08 Don Porter <dgp@users.sourceforge.net>
- * doc/foreach.n: Adjust tabs to be friendlier to some HTML
- converters. [Bug 1078760]
+ * generic/tclInt.h: Remove TclMarkList() routine, an experimental
+ * generic/tclUtil.c: dead-end from the 8.5 alpha days.
-2004-12-06 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclResult.c (ResetObjResult): [Bug 3202905]: Correct failure
+ to clear invalid intrep. Thanks to Colin McDonald.
- * unix/tclUnixNotfy.c (NotifierThreadProc): init numFdBits
- [Bug 1079286]
+2011-03-08 Donal K. Fellows <dkf@users.sf.net>
- * doc/error.n, doc/SaveResult.3, doc/Thread.3: minor nroff typos
+ * generic/tclAssembly.c, tests/assemble.test: Migrate to use a style
+ more consistent with the rest of Tcl.
-2004-12-06 Don Porter <dgp@users.sourceforge.net>
+2011-03-06 Don Porter <dgp@users.sourceforge.net>
- * tests/safe.test: Trim auto_path to improve performance [1080039]
+ * 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:
- * tests/msgcat.test: makeFile/removeFile cleanup [1079117]
+ * generic/tclUtil.c (TclFindElement): [Bug 3192636]: Guard escape
+ sequence scans to not overrun the string end.
-2004-12-04 Don Porter <dgp@users.sourceforge.net>
+2011-03-05 Don Porter <dgp@users.sourceforge.net>
- * generic/tclEncoding.c: Different fix for [Bug 1077005].
- * generic/tclEvent.c: Broke apart TclpSetInitialEncodings() on
- * generic/tclInt.h: Windows into TclpSetInterfaces(), that is
- * unix/tclUnixInit.c: fundamentally essential, and the initialization
- * win/tclWinInit.c: of the system encoding, which is not. Made
- the TclpSetInterfaces call part of TclInitSubsystems so it cannot be
- overlooked.
+ * generic/tclParse.c (TclParseBackslash): [Bug 3200987]: Correct
+ * tests/parse.test: trunction checks in \x and \u substitutions.
-2004-12-03 Jeff Hobbs <jeffh@ActiveState.com>
+2011-03-05 Miguel Sofer <msofer@users.sf.net>
- * changes: updated for 8.5a2 release
+ * 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.
-2004-12-02 Don Porter <dgp@users.sourceforge.net>
+2011-03-05 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclUtil.c (TclSetProcessGlobalValue): Handle the case
- where a ProcessGlobalValue might be assigned to itself.
+ * 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.
- * generic/tclEncoding.c (MakeFileMap): Correct refcounting errors
- managing values returned by TclPathPart (with refCount of 1!) that
- led to a memory leak. [Bug 1077474].
+2011-03-05 Miguel Sofer <msofer@users.sf.net>
-2004-12-02 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclExecute.c: Cleaner mem management for TEBCdata
- * generic/tclPathObj.c: fix and new tests for [Bug 1074671] to
- * tests/fileSystem.test: ensure tilde paths are not returned
- specially by 'glob'.
+ * 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.
-2004-12-02 Kevin B. Kenny <kennykb@acm.org>
+ * 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:
- * win/Makefile.in: Added a 'sed' in the setting of ROOT_DIR_NATIVE
- to compensate for a bug in cygpath (at least version 1.36) that
- leaves a trailing backslash on the end of the converted path.
+2011-03-04 Donal K. Fellows <dkf@users.sf.net>
-2004-12-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * generic/tclInterp.c (Alias,Target,Master): Rewrote these so that
- the aliases that refer to an interpreter are stored in a list and
- not a hashtable (which was only ever a convenience, and forced the
- use of a global mutex to generate keys!) [FRQ 1077210]
- * generic/tclNamesp.c (numNsCreated): Moved into thread-local
- storage to remove a global mutex. [FRQ 1077210]
+2011-03-01 Miguel Sofer <msofer@users.sf.net>
-2004-12-01 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c (TclNREvalObjv): Missing a variable declaration
+ in commented out non-optimised code, left for ref in checkin
+ [b97b771b6d]
- * generic/tclUtil.c (TclGetProcessGlobalValue): Narrowed the scope
- of mutex locks.
+2011-03-03 Don Porter <dgp@users.sourceforge.net>
- * generic/tclUtil.c: Updated Tcl_GetNameOfExecutable() to
- * generic/tclEncoding.c: make use of a ProcessGlobalValue for
- * generic/tclEvent.c: storing the executable name.
- Added internal routines Tcl(Get|Set)ObjNameOfExecutable() to access
- that storage in Tcl_Obj, rather than string format.
+ * 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.
- * unix/tclUnixFile.c: Rewrote TclpFindExecutable() to use
- * win/tclWinFile.c: TclSetObjNameOfExecutable to store the
- executable name it computes.
+2011-03-01 Miguel Sofer <msofer@users.sf.net>
- * generic/tclInt.h: Added internal stub entries for
- * generic/tclInt.decls: TclpFindExecutable and
- Tcl(Get|Set)ObjNameOfExecutable.
+ * generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd):
+ fix leaks
- * generic/tclIntDecls.h: make genstubs
+ * 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/tclCmdIL.c: Retrieve executable name in Tcl_Obj form
- * win/tclWinPipe.c: instead of string form.
-
- * unix/tclUnixTest.c: Update [testfindexecutable] command to use
- new internal interfaces.
-
- * generic/tclEncoding.c: Moved TclpSetInitialEncodings()
- call from Tcl_FindExecutable() into TclInitEncodingSubsystem().
- This is important on Windows where it establishes whether the
- "ascii" or "unicode" set of system routines will be used, and
- that needs to be done earlier to support filesystem operations.
- [Bug 1077005]
-
-2004-12-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * tests/winDde.test: Rewritten to use tcltest2 features more
- thoroughly (reducing the [catch] count!) and fix the problem with
- winDde-6.1 being out of synch with the implementation.
-
-2004-11-30 Don Porter <dgp@users.sourceforge.net>
-
- * library/init.tcl ([unknown]): Restored the save/restore of
- the variables ::errorCode and ::errorInfo. This is needed when
- the [::bgerror] command is auto-loaded (as it is by Tk).
-
- Patch 976520 reworks several of the details involved with
- startup/initialization of the Tcl library, focused on the
- activities of Tcl_FindExecutable().
-
- * generic/tclIO.c: Removed bogus claim in comment that
- encoding "iso8859-1" is "built-in" to Tcl.
-
- * generic/tclInt.h: Created a new struct ProcessGlobalValue,
- * generic/tclUtil.c: routines Tcl(Get|Set)ProcessGlobalValue,
- and function type TclInitProcessGlobalValueProc. Together, these
- take care of the housekeeping for "values" (things that can be
- held in a Tcl_Obj) that are global across a whole process. That is,
- they are shared among multiple threads, and epoch and mutex
- protection must govern the validity of cached copies maintained
- in each thread.
-
- * generic/tclNotify.c: Modified TclInitNotifier() to tolerate
- being called multiple times in the same thread.
-
- * generic/tclEvent.c: Dropped the unused argv0 argument to
- TclInitSubsystems(). Removed machinery to unsure only one
- TclInitNotifier() call per thread, now that that is safe.
- Converted Tcl(Get|Set)LibraryPath to use a ProcessGlobalValue,
- and moved them to tclEncoding.c.
- * generic/tclBasic.c: Updated caller.
-
- * generic/tclInt.h: TclpFindExecutable now returns void.
- * unix/tclUnixFile.c:
- * win/tclWinFile.c:
- * win/tclWinPipe.c:
+ * generic/tclExecute.c (ExprObjCallback): Fix object leak
- * generic/tclEncoding.c: Built new encoding search initialization
- on a foundation of ProcessGlobalValues, exposing new routines
- Tcl(Get|Set)EncodingSearchPath. A cache of a map from encoding name
- to directory pathname keeps track of where encodings are available
- for loading. Tcl_FindExecutable greatly simplified into just
- three function calls. The "library path" is now misnamed, as its
- only remaining purpose is as a foundation for the default encoding
- search path.
-
- * generic/tclInterp.c: Inlined the initScript that is evaluated
- by Tcl_Init(). Added verification after initScript evaluation
- that Tcl can find its installed *.enc files, and that it has
- initialized [encoding system] in agreement with what the environment
- expects. [tclInit] no longer driven by the value of $::tcl_libPath;
- it largely constructs its own search path now, rather than attempt
- to share one with the encoding system.
-
- * unix/tclUnixInit.c: TclpSetInitialEncodings factored so that a new
- * win/tclWinInit.c: routine TclpGetEncodingNameFromEnvironment
- can reveal that Tcl thinks the [encoding system] should be, even
- when an incomplete encoding search path, or a missing *.enc file
- won't allow that initialization to succeed. TclpInitLibraryPath
- reworked as an initializer of a ProcessGlobalValue.
-
- * unix/tclUnixTest.c: Update implementations of [testfindexecutable],
- [testgetdefenc], and [testsetdefenc].
-
- * tests/unixInit.test: Corrected tests to operate properly even
- when a value of TCL_LIBRARY is required to find encodings.
-
- * generic/tclInt.decls: New internal stubs: TclGetEncodingSearchPath,
- TclSetEncodingSearchPath, TclpGetEncodingNameFromEnvironment. These
- are candidates for public exposure by future TIPs.
+ * generic/tclExecute.c (TEBCresume): Store local var array and
+ constants in automatic vars to reduce indirection, slight perf
+ increase
- * generic/tclIntDecls.h: make genstubs
- * generic/tclStubInit.c:
-
- * generic/tclTest.c: Updated [testencoding] to use
- * tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests.
-
-2004-11-30 Kevin B. Kenny <kennykb@acm.org>
-
- * library/clock.tcl: Corrected the regular expressions that match
- a time zone to allow for time zones specified as +HH or -HH.
- * tests/clock.test: Added regression test case for the above issue.
- Thanks to Rolf Ade for reporting this issue
- [http://wiki.tcl.tk/13094]
- * win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a
- compilation failure on VC++.
-
-2004-11-29 Andreas Kupries <andreask@activestate.com>
-
- * win/Makefile.in (install-libraries): Brought entry '2004-10-26
- Don Porter (Tcl Modules)' into the windows world, actually the
- win/configure buildsystem. The other windows buildsystems (.vc,
- .bc) still have to be updated as well.
-
-2004-11-26 Andreas Kupries <andreask@activestate.com>
-
- * win/tclWinDde.c (ExecuteRemoteObject): Removed bogus semicolon
- found at the end of the header for the function definition,
- terminating it early and preventing a compile. This is likely a
- fix for '2004-11-25 Donal'. I have to conclude that it is also
- unknown if the other changes to this file actually pass the
- testsuite. Running testsuite ... They don't. winDde-6.1
- fails. This is only a message discrepance, i.e. not too
- bad. Leaving resolution of that to Pat and Donal.
-
-2004-11-26 Don Porter <dgp@users.sourceforge.net>
-
- * library/auto.tcl (tcl_findLibrary): Made sure the uniquifying
- operations on the search path does not also normalize. [Bug 1072136]
-
-2004-11-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * unix/configure.in: Simplify the code to check for correctness of
- strstr, strtoul and strtod.
- * unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza
- out of configure.in into its own function. Also force it to do the
- right thing with cacheing of results of AC_TRY_RUN to deal with
- issue raised in [Patch 1073524]
-
- * doc/foreach.n: Added simple example. [FRQ 1073334]
-
-2004-11-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclProc.c (TclObjInterpProc): Make it so that only
- * generic/tclIndexObj.c (Tcl_WrongNumArgs): [proc] instances do
- * tests/indexObj.test (indexObj-5.7): quoting of their first
- arguments, so keeping [Bug 942757] fixed and making [Bug 1066837]
- be fixed as well. Done with a load of #ifdef-ery because this hack
- is so ugly nobody should keep it around once Itcl's fixed.
-
-2004-11-25 Reinhard Max <max@suse.de>
-
- * tests/tcltest.test: The order in which [glob] returns the file
- names is undefined, so tests should not depend on it.
-
-2004-11-25 Zoran Vasiljevic <vasiljevic@users.sf.net>
+ * generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so that
+ trunk compiles.
- * doc/Thread.3:
- * doc/Notifier.3: Added changes from the core-8-4-branch
+ * generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do
+ the trampoline dance for commands that do not have an nreProc.
-2004-11-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2011-03-01 Donal K. Fellows <dkf@users.sf.net>
- * doc/dde.n: Synchronized the documentation of the commands with
- the header of the docs and what the package actually does. Thanks
- to Andreas Kupries for spotting this.
- * win/tclWinDde.c (Tcl_DdeObjCmd): Much cleanup of argument
- parsing code.
+ * 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.
-2004-11-24 David Gravereaux <davygrvy@pobox.com>
+2011-01-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclPort.h: Relative include of tclWinPort.h returned
- as it was requiring me set -I$(tcl_root)/win for my extensions
- that need to include tclInt.h and doesn't appear to serve any
- purpose for windows builds.
+ * doc/RegExp.3: [Bug 3165108]: Corrected documentation of description
+ of subexpression info in Tcl_RegExpInfo structure.
-2004-11-24 Kevin B. Kenny <kennykb@acm.org>
+2011-01-25 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected bad check for
- 3-argument readdir_r [Bug 1001325].
- * unix/configure: Regenerated.
- * unix/tclUnixNotfy.c: Corrected all uses of 'select' to
- manage their masks using the FD_CLR, FD_ISSET, FD_SET, and
- FD_ZERO macros rather than bit-whacking that failed under
- Solaris-Sparc-64. [Bug 1071807]
- * win/tclWinInit.c (TclpInitLibraryPath): Removed unused
- vars 'pathc' and 'pathv' that caused compilation problems
- on VC++ with --enable-symbols.
-
-2004-11-24 Don Porter <dgp@users.sourceforge.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:
- * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected failure to determine
- the number of arguments for readdir_r on SunOS systems. [Bug 1071701]
+2011-01-19 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure: autoconf-2.57
+ * tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with
+ * generic/tcl.decls bad format specifier.
+ * generic/tcl.h:
+ * generic/tclDecls.h:
- * generic/tclCmdIL.c (InfoVarsCmd): Corrected segfault in new
- * tests/info.test (info-19.6): trivial matching branch [Bug 1072654]
+2011-01-18 Donal K. Fellows <dkf@users.sf.net>
-2004-11-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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!)
- * tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4.
- * tools/man2html2.tcl: Fix broken .SS handling.
+2011-01-18 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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:
- * unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h
- into the dependency tree and 'make distclean'. [Bug 1068171]
+2011-01-17 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclResult.c (Tcl_AppendResultVA): Remove call to
- Tcl_GetStringResult to speed up repeated calls to Tcl_AppendResult
- with the side effect that code that wants to access interp->result
- should always call Tcl_GetStringResult first. See [Patch 1041072]
- discussion for more details.
+ * 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
-2004-11-22 Mo DeJong <mdejong@users.sourceforge.net>
+2011-01-15 Kevin B. Kenny <kennykb@acm.org>
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Define HAVE_TYPE_OFF64_T
- only when off64_t, open64(), and lseek64() are defined.
- IRIX 5.3 is known to not include an open64 function.
- [Bug 1030465]
+ * 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.
-2004-11-22 Mo DeJong <mdejong@users.sourceforge.net>
+2011-01-12 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_ENABLE_THREADS): Check for a 2
- argument version of readdir_r that is known to
- exists under IRIX 5.3.
- * unix/tclUnixThrd.c (TclpReaddir): Use either
- 2 arg or 3 arg version of readdir_r.
- [Bug 1001325]
+ * 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.
-2004-11-22 Don Porter <dgp@users.sourceforge.net>
+2011-01-07 Kevin B. Kenny <kennykb@acm.org>
- * unix/tclUnixInit.c (TclpInitLibraryPath): Purged dead code that
- * win/tclWinInit.c (TclpInitLibraryPath): used to extend the
- "library path". Search path construction for init.tcl is now done
- within the [tclInit] proc.
+ * 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.)
- * generic/tclInterp.c: Restored several directories to the search
- * tests/unixInit.test: path used to locate init.tcl within [tclInit].
- This change does not restore any directories to the encoding search
- path, so should still avoid the price of an unreasonably large number
- of filesystem accesses during encoding initialization at startup
- [Bug 976438]
+2011-01-05 Donal K. Fellows <dkf@users.sf.net>
-2004-11-22 Vince Darley <vincentdarley@users.sourceforge.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.
- * generic/tclPathObj.c: fix and new test for [Bug 1043129] in
- * tests/fileSystem.test: the treatment of backslashes in file
- join on Windows.
+2011-01-01 Donal K. Fellows <dkf@users.sf.net>
-2004-11-21 Don Porter <dgp@users.sourceforge.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.
- * doc/AddErrInfo.3: Typo corrections (Thanks Daniel South).
- * doc/interp.n:
+ * tests/execute.test (execute-11.1): [Bug 3142026]: Added test that
+ fails (with a crash) in an unfixed memdebug build on 64-bit systems.
-2004-11-19 Don Porter <dgp@users.sourceforge.net>
+2010-12-31 Donal K. Fellows <dkf@users.sf.net>
- * doc/AddErrInfo.3: Docs for Tcl_(Get|Set)ReturnOptions. [TIP 227]
-
- * doc/AddErrInfo.3:
- * doc/Async.3: Documentation updates to replace references
- * doc/BackgdErr.3: to global variable ::errorInfo and ::errorCode
- * doc/SaveResult.3: and to the ::bgerror command with references
- * doc/after.n: to their preferred replacements, the
- * doc/bgerror.n: -errorinfo and -errorcode return options,
- * doc/error.n: the Tcl_*InterpState routines, and the
- * doc/exec.n: [interp bgerror] command.
- * doc/exit.n:
- * doc/fileevent.n:
- * doc/interp.n:
- * doc/return.n:
- * doc/tclvars.n:
- * doc/update.n:
+ * 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.
- * tests/unixInit.test: Removed "knownBug" constraints to prompt
- bug fixing before 8.5a2 release.
+2010-12-31 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-19 Daniel Steffen <das@users.sourceforge.net>
+ * unix/dltest/*.c: [Bug 3148192]: Fix broken [load] tests by ensuring
+ that the affected files are never compiled with -DSTATIC_BUILD.
- * macosx/Makefile:
- * unix/configure.in:
- * unix/tclUnixInit.c (MacOSXGetLibraryPath): changed detection
- of tcl framework build when determining tclLibPath from overloaded
- TCL_LIBRARY to configuration define TCL_FRAMEWORK. [Bug 1068088]
+2010-12-30 Miguel Sofer <msofer@users.sf.net>
- * unix/configure: autoconf-2.57
- * unix/tclConfig.h.in: autoheader-2.57
+ * 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.
-2004-11-18 Don Porter <dgp@users.sourceforge.net>
+2010-12-26 Donal K. Fellows <dkf@users.sf.net>
- * doc/SaveResult.3: Documentation for Tcl_*InterpState (TIP 226).
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
+ options are used. Simplified memory handling logic.
- * generic/tclEvent.c (HandleBgErrors): Simplified program flow.
+2010-12-20 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/basic.test: Updated functional (not testing) uses of
- * tests/io.test: [bgerror] to make use of [interp bgerror].
- * tests/socket.test:
- * tests/timer.test:
+ * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1
+ tdm64-1: completed for all environments.
- * tests/interp.test (interp-36.*): [interp bgerror] tests.
+2010-12-20 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInterp.c: Corrected [interp bgerror] error messages.
+ * win/configure.in: Explicitely test for intrinsics support in
+ compiler, before assuming only MSVC has it.
+ * win/configure: (autoconf-2.59)
+ * generic/tclPanic.c:
-2004-11-18 Reinhard Max <max@suse.de>
+2010-12-19 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4 (SC_CONFIG_MANPAGES): Applied an improved version of
- * unix/configure.in: patch #996085, that introduces
- * unix/Makefile.in: --enable-man-suffix.
+ * win/tclWin32Dll.c: [Patch 3059922]: fixes for mingw64 - gcc4.5.1
+ tdm64-1: Fixed for gcc, not yet for MSVC 64-bit.
- * unix/installManPage: added
- * unix/mkLinks.tcl: removed
- * unix/mkLinks: removed
- * unix/configure: generated
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
- * unix/Makefile.in: Don't install tclConfig.h .
+ * unix/Makefile.in: Remove unwanted/obsolete 'ddd' target.
-2004-11-17 Don Porter <dgp@users.sourceforge.net>
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
- * unix/configure.in: The change below reveals that the public
- data type Tcl_StatBuf relies on config information. For now,
- disabled the use of the tclConfig.h file until its full impact
- on Tcl's interface can be assessed.
+ * 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.
- * unix/configure: autoconf-2.57
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
- * generic/tcl.h: Moved the #include "tclConfig.h" out of
- * generic/tclInt.h: tcl.h. The config settings are not part of
- * generic/tclPort.: the public interface, and having it there
- breaks compiled against uninstalled Tcl and extensions using
- autoconf-2.5*.
+ * unix/Makefile.in: [Bug 2446711]: Remove 'allpatch' target.
-2004-11-16 Jeff Hobbs <jeffh@ActiveState.com>
+2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net>
- * unix/tclUnixChan.c (TtySetOptionProc): fixed crash configuring
- -ttycontrol on a channel. [Bug 1067708]
+ * unix/Makefile.in: [Bug 2537626]: Use 'rpmbuild', not 'rpm'.
-2004-11-16 Don Porter <dgp@users.sourceforge.net>
+2010-12-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclIOUtil.c (TclFSEpochOk): There were two code paths
- via which the thread copy of filesystemEpoch could be synched with
- the master copy, but only one kept the filesystem list cache up
- to date. Fix routes everything through a single code path.
- [Bug 1035775].
+ * generic/tclPanic.c: [Patch 3124554]: Move WishPanic from Tk to Tcl
+ * win/tclWinFile.c: Better communication with debugger, if present.
-2004-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-12-15 Kevin B. Kenny <kennykb@acm.org>
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Stop architecture flags to 'ld'
- from getting lost when [load] is disabled. [Bug 1016796]
+ [dogeen-assembler-branch]
-2004-11-16 Daniel Steffen <das@users.sourceforge.net>
+ * 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.
- * generic/tcl.h:
- * unix/configure.in: changed HAVE_CONFIG_H to HAVE_TCL_CONFIG_H.
+2010-12-15 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure: autoconf-2.57
+ * generic/tclPanic.c: Restore abort() as it was before.
+ * win/tclWinFile.c: [Patch 3124554]: Use ExitProcess() here, like
+ in wish.
-2004-11-15 Don Porter <dgp@users.sourceforge.net>
+2010-12-14 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h: Added comment warning that the old
- ERR_IN_PROGRESS and ERROR_CODE_SET flag values should not be re-used
- for the sake of those extensions that have accessed them.
+ * generic/tcl.h: [Bug 3137454]: Tcl CVS HEAD does not build on GCC 3.
- * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Fixed Bug 1065378 which failed
- * tests/trace.test (trace-33.1): to permit a variable trace
- created with [trace variable] to be destroyed with [trace remove].
- Thanks to Keith Vetter for the report.
+2010-12-14 Reinhard Max <max@suse.de>
-2004-11-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * doc/tclvars.n: Added section to documentation on global
- variables that are specific to tclsh and wish. [Patch 1065732]
+2010-12-13 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-12 Jeff Hobbs <jeffh@ActiveState.com>
+ * 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
- * generic/tclEncoding.c (TableFromUtfProc): correct crash
- condition when TCL_UTF_MAX == 6. [Bug 1004065]
+2010-12-12 Stuart Cassoff <stwo@users.sourceforge.net>
-2004-11-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * unix/tcl.m4: Better building on OpenBSD.
+ * unix/configure: (autoconf-2.59)
- * doc/interp.n: Basic documentation of the TIP#221 API.
+2010-12-10 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-12 Don Porter <dgp@users.sourceforge.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:
- TIP #221 IMPLEMENTATION
- * generic/tclBasic.c: Define [::tcl::Bgerror] in new interps.
- * generic/tclEvent.c: Update Tcl_BackgroundError to make use
- of the registered [interp bgerror] command.
- * generic/tclInterp.c: New [interp bgerror] subcommand.
- * tests/interp.test: syntax tests updated.
+2010-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- TIP #226 IMPLEMENTATION
- * generic/tcl.decls: Stubs for Tcl_(Save|Restore|Discard)InterpState
- * generic/tcl.h: New public opaque type, Tcl_InterpState.
- * generic/tclInt.h: Drop old private declarations. Add
- Tcl(Get|Set)BgErrorHandler
- * generic/tclResult.c: Tcl_*InterpState implementations.
- * generic/tclDictObj.c: Update callers.
- * generic/tclIOGT.c:
+ * 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:
- TIP #227 IMPLEMENTATION
- * generic/tcl.decls: Stubs for Tcl_(Get|Set)ReturnOptions.
- * generic/tclInt.h: Drop old private declarations.
- * generic/tclResult.c: Tcl_*ReturnOptions implementations.
- * generic/tclCmdAH.c: Update callers.
- * generic/tclMain.c:
+2010-12-05 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclDecls.h: make genstubs
- * generic/tclStubInit.c:
+ * unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix
+ * unix/configure: (autoconf-2.59)
- * unix/tclAppInit.c: Removed tclConfig.h #include, now that tcl.h
- takes care of it for us.
+2010-12-03 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclInt.h: Moved verification of ptrdiff_t typedef from
- * generic/tclExecute.c: multiple .c files into one common header where
- * generic/tclVar.c: it is verifiably after tclConfig.h inclusion.
+ * 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.
-2004-11-12 Daniel Steffen <das@users.sourceforge.net>
+2010-12-03 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tcl.h:
+ * 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:
- * unix/Makefile.in: include tclConfig.h from tcl.h and install it
- as a public header. Normalized compiler include path order to
- -I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR}.
+ * 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.
- * unix/dltest/Makefile.in: add ${BUILD_DIR}/.. to include path
- to pick up tclConfig.h.
+ * 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>
- * unix/tclUnixInit.c: moved check for HAVE_CFBUNDLE define after
- #include "tclInt.h" to ensure tclConfig.h has been included.
+ * doc/file.n: [Bug 3111298]: Typofix.
-2004-11-12 Reinhard Max <max@suse.de>
+ * tests/oo.test: [Bug 3111059]: Added testing that neatly trapped this
+ issue.
- * unix/config.h.in:
- * unix/tclConfig.h.in: renamed
+2010-11-18 Miguel Sofer <msofer@users.sf.net>
- * unix/Makefile.in: Completed support for config header,
- * unix/configure.in: fixed building outside of the unix dir,
- * unix/tclAppinit.c: and reflected the name change of config.h.
+ * 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:
- * unix/configure: generated
+2010-11-10 Andreas Kupries <andreask@activestate.com>
-2004-11-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * changes: Updates for 8.6b2 release.
- * unix/config.h.in: Allow configure to put all the C #defs into
- * unix/configure.in: a file (called config.h) so that Unix builds
- * unix/tcl.m4: now take far fewer lines of scrollback to
- * unix/Makefile.in: proceed (making it less likely that any errors
- * generic/tclInt.h: or warnings will get missed).
- * unix/tclAppInit.c: Part of the TIP#34 upgrades.
+2010-11-09 Donal K. Fellows <dkf@users.sf.net>
- * unix/tcl.m4, unix/tclUnixPort.h: Check for pthread_attr_get_np
- in <pthread.h> before forcing the use of <pthread_np.h> to make
- things work on NetBSD 2.0. [Bug 1064882]
+ * generic/tclOOMethod.c (ProcedureMethodVarResolver): [Bug 3105999]:
+ * tests/oo.test: Make sure that resolver structures that are
+ only temporarily needed get squelched.
- * doc/binary.n, doc/upvar.n: More minor fixes.
+2010-11-05 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-12 Daniel Steffen <das@users.sourceforge.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).
- * doc/CrtChannel.3:
- * doc/Interp.3:
- * doc/Limit.3:
- * doc/binary.n:
- * doc/dict.n:
- * doc/tm.n:
- * doc/upvar.n: fixed *roff errors uncovered by running 'make html'.
+2010-11-05 Kevin B. Kenny <kennykb@acm.org>
- * tools/tcltk-man2html.tcl: added faked support for bullet point
- lists, i.e. *nroff ".IP \(bu" syntax.
+ * 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.
-2004-11-11 Daniel Steffen <das@users.sourceforge.net>
+2010-11-04 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/fCmd.test:
- * unix/tclUnixFCmd.c (TraverseUnixTree): added option to rewind()
- the readdir() loop whenever the source hierarchy has been modified
- by traverseProc (e.g. by deleting files); this is required to ensure
- complete traversal of the source hierarchy on certain filesystems
- like HFS+. Added test for failing recursive delete on Mac OS X that
- was due to this. [Bug 1034337]
+ * 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
- * generic/tclListObj.c (Tcl_ListObjReplace): use memmove() instead
- of manual copy loop to shift list elements. Decreases time spent in
- Tcl_ListObjReplace() from 5.2% to 1.7% of overall runtime of
- tclbench on a ppc 7455 (i.e. 200% speed increase). [Patch 1064243]
+2010-11-04 Reinhard Max <max@suse.de>
- * generic/tclHash.c: hoisted some constant pointer dereferences out
- of loops to eliminate redundant loads that the gcc optimizer didn't
- deal with. Decreases time spend in Tcl_FindHashEntry() by 10% over a
- full run of the tcl testuite on a ppc 7455. [Patch 1064243]
+ * 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.
- * tests/fileName.test:
- * tests/fileSystem.test:
- * tests/io.test:
- * tests/msgcat.test:
- * tests/tcltest.test:
- * tests/unixInit.test: fixed bugs causing failures when running
- tests with -tmpdir arg not set to working dir.
+ Rework some of the tests to speed them up by avoiding (supposedly)
+ unneeded [after]s.
- * macosx/Makefile: corrected path to html help inside framework.
- Prevent parallel make from building several targets at the same
- time.
+2010-11-04 Stuart Cassoff <stwo@users.sourceforge.net>
- * macosx/tclMacOSXFCmd.c (struct fileinfobuf): force struct to be
- packed to prevent failures when builing with -malign=natural.
+ * unix/Makefile.in: [Patch 3101127]: Installer Improvements.
+ * unix/install-sh:
-2004-11-10 Andreas Kupries <andreask@activestate.com>
+2010-11-04 Donal K. Fellows <dkf@users.sf.net>
- * unix/tclUnixChan.c: [Bug 727786]. Exterminated the code marked
- DEPRECATED. This code has not been used in over a year now, and
- we have no complaints.
+ * tests/error.test (error-19.13): Another variation on testing for
+ issues in [try] compilation.
-2004-11-08 David Gravereaux <davygrvy@pobox.com>
+ * 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.
- * win/tclWinPipe.c: The pipe channel driver now respects
- the -blocking option when closing is the same way the UNIX
- side works. This is to avoid a hung shell when exiting due
- to open pipes that refuse to close in a graceful manner.
- * doc/open.n: Added a note about -blocking 0 and lack of
- exit status as it had never been documented. [Bug 947693]
+2010-11-04 Don Porter <dgp@users.sourceforge.net>
- ***POTENTIAL INCOMPATIBILITY***
+ * changes: Updates for 8.6b2 release. (Thanks Andreas Kupries)
- Scripts that use async pipes on windows, must (like the
- UNIX side) set -blocking to 1 before calling [close] to
- receive the exit status.
+2010-11-03 Jan Nijtmans <nijtmans@users.sf.net>
-2004-11-07 David Gravereaux <davygrvy@pobox.com>
+ * win/tclWinFcmd.c: [FRQ 2965056]: Windows build with -DUNICODE
+ * win/tclWinFile.c: (more clean-ups for pre-win2000 stuff)
+ * win/tclWinReg.c:
- * tests/winFile.test: added contraint to winFile-4.0 to prevent
- it being run on NT4 [Bug 981829]
+2010-11-03 Donal K. Fellows <dkf@users.sf.net>
-2004-11-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * tests/reg.test: Major reorganization so that this file is much
- easier for a normal Tcl maintainer to comprehend. The test flags
- are still very cryptic, but they appear to have to be that way.
- The number of skipped tests has increased, but now the skipped
- tests have much more meaningful content.
+2010-11-03 Kevin B. Kenny <kennykb@acm.org>
- * tests/tm.test (genpaths): Add a [file normalize] so we pick up
- Windows drive letters, etc. [Bug 1053568]
+ * 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.
-2004-11-04 Don Porter <dgp@users.sourceforge.net>
+2010-11-01 Stuart Cassoff <stwo@users.sourceforge.net>
- * changes: Updates toward an 8.5a2 release.
+ * library/safe.tcl: Improved handling of non-standard module path
+ * tests/safe.test: lists, empty path lists in particular.
-2004-11-03 Kevin B. Kenny <kennykb@acm.org>
+2010-11-01 Kevin B. Kenny <kennykb@acm.org>
- * library/clock.tcl (FreeScan): Fixed a bug where scanning
- "Monday" with a base time other than midnight incorrectly carried
- the base time forward.
+ * library/tzdata/Asia/Hong_Kong:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Fiji: Olson's tzdata2010o.
- * test/clock.test (clock-33.{5,5a}): Made the test failure more
- informative.
+2010-10-29 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * tests/clock.test (clock-34.{28,44,45,46}): Removed 'knownBug'
- constraints from tests that no longer fail.
+ * generic/tclTimer.c: [Bug 2905784]: Stop small [after]s from
+ wasting CPU while keeping accuracy.
- Thanks to Don Porter for reporting these.
+2010-10-28 Kevin B. Kenny <kennykb@acm.org>
-2004-11-03 David Gravereaux <davygrvy@pobox.com>
+ [dogeen-assembler-branch]
+ * generic/tclAssembly.c:
+ * tests/assembly.test (assemble-31.*): Added jump tables.
- * generic/tcl.h: Moved the preprocessor logic
- * generic/tclDecls.h: from tclInt.h of setting the
- * generic/tclInt.h: TCL_STORAGE_CLASS macro to the
- * generic/tclIntDecls.h: tcl*Decls.h files now that no
- * generic/tclIntPlatDecls.h: use of EXTERN is left in tclInt.h.
- * generic/tclPlatDecls.h: Proto for Tcl_Main moved in tcl.h
- * win/tclWinPort.h: to prior the inclusion of the Stubs
- headers as they are now resetting TCL_STORAGE_CLASS. Removed
- extrainious reset from tclWinPort.h. [Patch 1055668]
+2010-10-28 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCompile.h: Removed extrainious reset of
- TCL_STORAGE_CLASS missed in my last edit.
+ * tests/http.test: [Bug 3097490]: Make http-4.15 pass in
+ isolation.
-2004-11-03 Don Porter <dgp@users.sourceforge.net>
+ * unix/tclUnixSock.c: [Bug 3093120]: Prevent calls of
+ freeaddrinfo(NULL) which can crash some
+ systems. Thanks Larry Virden.
- * library/init.tcl ([unknown]): Corrections to the 2004-10-25 mods
- to Aunt ??? in [unknown]. Flaws revealed by Itcl test suite, which
- still apparently relies on this brokenness. Also added comment
- suggesting the error message that any code using this hack *ought*
- to receive in reply.
+2010-10-26 Reinhard Max <max@suse.de>
- * generic/tclTrace.c (TclCallVarTraces): Improved ability to debug
- * tests/incr-old.test (incr-old-2.6): errors during variable
- * tests/incr.test (incr-{1,2}.28): traces by preserving the
- * tests/set.test (set-{2,4}.4): -errorinfo data.
- * tests/trace.test (trace-33.1): [Bug 527164]
+ * Changelog.2008: Split off from Changelog.
+ * generic/tclIOSock.c (TclCreateSocketAddress): The interp != NULL
+ check is needed for ::tcl::unsupported::socketAF as well.
-2004-11-02 David Gravereaux <davygrvy@pobox.com>
+2010-10-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h: added a check for #ifdef __cplusplus around
- the #define of MODULE_SCOPE. About the only time it would be
- problem is when someone is statically linking to Tcl and accessing
- internals from a C++ file and has name mangling issues from the
- lack of "C" after 'extern' [Patch 1055668].
- * generic/tclCompile.h: Exchanged use of the EXTERN macro to the
- new MODULE_SCOPE macro. Lowered exported internals count by 35.
- [Patch 1055668]
- * win/tclWinInt.h:
- * win/tclWinPort.h: exported internals dropped by a count of 14.
- * generic/tclFileSystem.h: Added use of MODULE_SCOPE on protos.
- * generic/tclRegexp.h: manipulating TCL_STORAGE_CLASS unnecessary.
+ * unix/tclUnixSock.c (TcpGetOptionProc): Prevent crash if interp is
+ * win/tclWinSock.c (TcpGetOptionProc): NULL (a legal situation).
-2004-11-02 Don Porter <dgp@users.sourceforge.net>
+2010-10-26 Reinhard Max <max@suse.de>
- * library/tcltest/tcltest.tcl: Corrected some misleading
- * tests/tcltest.test (tcltest-26.1,2): displays of ::errorInfo and
- ::errorCode information when the -setup, -body, and/or -cleanup scripts
- return an unexpected return code. Thanks to Robert Seeger for the
- fix. [RFE 1017151].
+ * 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.
-2004-11-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-10-24 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclExecute.c (TclExecuteByteCode): Improved version of
- the NaN fix from Miguel Sofer. [Bug 761471]
+ [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.
-2004-11-02 Kevin Kenny <kennykb@acm.org>
+2010-10-23 Kevin B. Kenny <kennykb@acm.org>
- * library/tzdata/America/Cuiaba: Change to DST rules for
- * library/tzdata/America/Havana: autumn of 2004.
- [ftp://elsie.nci.nih.gov/pub/tzdata2004g.tar.gz]
+ [dogeen-assembler-branch]
+ * generic/tclAssembly.h (removed):
+ Removed file that was included in only one
+ source file.
+ * generictclAssembly.c: Inlined tclAssembly.h.
- * tools/tclZIC.tcl: Updated to be compatible with recent
- changes in library/clock.tcl.
+2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-11-02 Vince Darley <vincentdarley@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:
- * win/tclWinFile.c: Simplify TclpUtime to use Tcl_FSGetNativePath,
- and add comments.
+2010-10-20 Donal K. Fellows <dkf@users.sf.net>
-2004-11-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * generic/tclInt.h: Change uses of EXTERN to MODULE_SCOPE (defined
- in this file too to be 'extern' if not overridden) as nothing
- declared in tclInt.h is supposed to be visible outside the Tcl
- core. If there *is* anything that extensions are actually using,
- we can open this up later on. [Patch 1055668]
+2010-10-19 Donal K. Fellows <dkf@users.sf.net>
- * doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446]
+ * 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.
-2004-11-01 Kevin B. Kenny <kennykb@acm.org>
+ * 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.
- * win/tclWinFile.c (FromCTime, TclpUtime): Replaced a call to the
- Posix 'utime' function with calls to Windows-API equivalents, to
- avoid a bug where the VC++ versions misconvert times across a
- Daylight Saving Time boundary. [Bug 926106]
- * win/tclWinInt.h (TclWinProcs):
- * win/tclWin32Dll.c (asciiProcs, unicodeProcs): Removed now-unused
- reference to 'utime'.
- * tests/cmdAH.test (cmdAH-24.12): Added test case for the
- above bug.
+ * tests/http11.test (check_crc): Use a simpler way to express the
+ functionality of this procedure.
-2004-11-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * generic/tclExecute.c (TclExecuteByteCode): Make INST_EQ and
- friends handle NaN correctly in all cases. [Bug 761471]
+2010-10-18 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclNamesp.c (NamespaceInscopeCmd): Make the error
- message generation the same as in NamespaceEvalCmd().
- (Tcl_Import): Rationalized to use Tcl_EvalObjv().
+ * 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
-2004-10-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * tests/io.test (io-40.3): Convert umask2 test constraint into a
- form that most people will be able to satisfy.
+ * doc/info.n: Document [info errorstack] faithfully.
- * tests/cmdAH.test (cmdAH-8.45): Removed broken test constraint.
- It didn't do what it was intended to do, and it implied the other
- correct constraint. [Bug 1053908]
+2010-10-16 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCmdIL.c (InfoGlobalsCmd):
- * tests/info.test (info-8.4): Strip leading global-namespace
- specifiers from the pattern argument. [Bug 1057461]
+ * 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.
-2004-10-30 Kevin Kenny <kennykb@acm.org>
+2010-10-15 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/clock.c: Replaced WIN32 macro with __WIN32__.
- [Bug 1054357]. Thanks to David Gravereaux for the patch.
- * win/tclWinFile.c: Removed a long-standing bug that causes
- incorrect conversion between file time and UTC time if
- the file time is recorded in a different Daylight Saving Time
- status than the current one. [Bug 926106]
+ * 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)
-2004-10-29 Don Porter <dgp@users.sourceforge.net>
+2010-10-13 Don Porter <dgp@users.sourceforge.net>
- * library/tcltest/tcltest.tcl: Correct reaction to errors in the
- obsolete processCmdLineArgsHook. [Bug 1055673]
- * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.7
- * unix/Makefile.in:
- * tests/all.tcl: Update to use [tcltest::configure].
-
-2004-10-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * library/tm.tcl (::tcl::tm::*): Use the core proc engine to
- generate the wrong-num-args error messages for the path ensemble.
-
- Ensembles can now (sometimes) rewrite the error messages of their
- subcommands so they appear more like the arguments that the user
- passed to the ensemble. Below is a description of changes involved
- in doing this.
-
- * tests/namespace.test (namespace-50.*): Tests of ensemble
- subcommand error message rewriting.
- * generic/tclProc.c (TclObjInterpProc): Make procedures implement
- their wrong-num-args message using Tcl_WrongNumArgs instead of
- something baked-at-home.
- * generic/tclNamesp.c (TclIsEnsemble, NsEnsembleImplementationCmd):
- Added test of ensemble-hood (available to rest of core) and made
- ensembles set up the rewriting for Tcl_WrongNumArgs to take
- advantage of.
- * generic/tclInt.h (Interp.ensembleRewrite): Extra fields.
- * generic/tclIndexObj.c (Tcl_WrongNumArgs): Add knowledge of what
- is going on in ensembles' command rewriting so this command can
- generate the right error message itself.
- * generic/tclBasic.c (Tcl_CreateInterp, TclEvalObjvInternal):
- Added code to initialize (as empty) the rewriting fields and reset
- them when we leak outside an ensemble implementation.
-
-2004-10-28 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c (INST_START_CMD):
- * tests/execute.test (execute-8.3): fix for execution stack
- corruption [Bug 1055676]. Credit dgp for detective work and fix.
-
-2004-10-27 Don Porter <dgp@users.sourceforge.net>
-
- * tests/socket.test (socket-13.1): Balanced [makeFile] and
- [removeFile] commands.
-
- * tests/clock.test: Correct duplicate test names.
- * tests/namespace.test:
- * tests/string.test:
- * tests/io.test (io-50.4): Use namespace variables.
+ * generic/tclCompile.c: Alternative fix for [Bugs 467523,983660] where
+ * generic/tclExecute.c: sharing of empty scripts is allowed again.
-2004-10-27 David Gravereaux <davygrvy@pobox.com>
+2010-10-13 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.decls: The following 9 functions were moved from
- * generic/tclInt.h: tclInt.h to the private/int Stubs table for
- * generic/tclIntDecls.h: use by the test suite. As tclTest.obj is
- * generic/tclStubInit.c: linked to the shell, these functions need
- "blessed" status so as to always be exported from the library. Being
- placed in the Stubs table guarantees this [Bug 1054748]:
- TclpObjRemoveDirectory, TclpObjCopyDirectory,
- TclpObjCreateDirectory, TclpObjDeleteFile,
- TclpObjCopyFile, TclpObjRenameFile,
- TclpObjStat, TclpObjAccess,
- TclpOpenFileChannel
+ * win/tclWinThrd.h: (removed) because it is just empty en used nowhere
+ * win/tcl.dsp
- * tests/registry.test: Fixed test files to load the correct
- * tests/winDde.test: registry and dde packages by using the info
- * win/Makefile.in: from makefiles to tell tcltest where to load
- * win/makefile.vc: them from. This avoids grabbing the wrong
- package from $auto_path which might be the install point rather than
- the dev location. Kudos to Jennifer Hom for adding -load and
- -loadfile to the tcltest package. [Bug 926088]
+2010-10-12 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWinThrd.c (TclFinalizeLock): release the critical section
- before deleting it. [Bug 731778]
+ * 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
- * generic/tcl.h: Removed the file level 'extern "C" {' and the
- coresponding closing block as it serves no purpose given that all
- the function prototypes have the proper extern usage already.
+2010-10-12 Reinhard Max <max@suse.de>
- * unix/tclAppInit.c: When built as tcltest, TclThread_Init was
- * win/tclAppInit.c: getting called twice. First by
- Tcltest_Init, then again in Tcl_AppInit. The call from Tcl_AppInit
- is now removed.
+ * unix/tclUnixSock.c (CreateClientSocket): [Bug 3084338]: Fix a
+ memleak and refactor the calls to freeaddrinfo().
-2004-10-27 Andreas Kupries <andreask@activestate.com>
+2010-10-11 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/tm.test: Expanded on the testsuite entered by Donal.
- * library/tm.tcl: Even found bugs, these have been corrected.
+ * 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
-2004-10-26 Kevin Kenny <kennykb@acm.org>
+2010-10-09 Miguel Sofer <msofer@users.sf.net>
- * tests/format.test (format-19.1): Additional regression test for
- Bug 868489.
+ * generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due
+ to mixing numwords and numbytes)
-2004-10-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-10-08 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/*.n: Many small general documentation fixes.
+ * generic/tclIOSock.c: On Windows, use gai_strerrorA
-2004-10-26 David Gravereaux <davygrvy@pobox.com>
+2010-10-06 Don Porter <dgp@users.sourceforge.net>
- * generic/tclPipe.c (TclCleanupChildren): bad cast of resolvedPid
- caused PIDs on win95 to go negative. winpipe-4.2 brought this to
- the surface. Fixed with sprintf in place of TclFormatInt. Thanks
- to hgiese [Patch 767676]
+ * tests/winPipe.test: Test hygiene with makeFile and removeFile.
-2004-10-26 Andreas Kupries <andreask@activestate.com>
+ * generic/tclCompile.c: [Bug 3081065]: Prevent writing to the intrep
+ * tests/subst.test: fields of a freed Tcl_Obj.
- * library/tm.tcl (::tcl::tm::Defaults): Added a second [file
- dirname] around the location of the executable. This fixes [Tcl
- SF Bug 1038705]. Instable of a bogus "foo/bin/lib" we now have
- the correct "foo/lib" as a base path for modules.
+2010-10-06 Kevin B. Kenny <kennykb@acm.org>
-2004-10-26 Don Porter <dgp@users.sourceforge.net>
+ [dogeen-assembler-branch]
- * generic/tclParse.c (Tcl_SubstObj): Fix for failed subst-12.3 test.
- * tests/subst.test (subst-12.3-5): More tests for Bug 1036649.
+ * generic/tclAssembly.c:
+ * generic/tclAssembly.h:
+ * tests/assemble.test: Added catches. Still needs a lot of testing.
- * unix/Makefile.in (install-libraries): Updated the installation
- of the http, msgcat, and tcltest packages to install as Tcl Modules
- on Unix systems. Other platform Makefiles still need updating.
- [Patch 1054370]
+2010-10-02 Kevin B. Kenny <kennykb@acm.org>
- * tests/basic.test: Added missing constraints.
- * tests/compile.test:
- * tests/fileSystem.test:
+ [dogeen-assembler-branch]
- * tests/init.test (init-2.8): Updated to not rely on http package.
+ * generic/tclAssembly.c:
+ * generic/tclAssembly.h:
+ * tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
+ dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable.
-2004-10-26 Miguel Sofer <msofer@users.sf.net>
+2010-10-02 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h:
- * generic/tclVar.c: removed more direct references to the VAR
- flags, replaced with access macros.
+ * 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>
-2004-10-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * 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.
- * doc/expr.n: Clarified that non-num/non-bool literals require
- quoting. [Bug 1027849]. Also listed booleans as acceptable values.
+2010-10-01 Kevin B. Kenny <kennykb@acm.org>
-2004-10-26 Kevin B. Kenny <kennykb@acm.org>
+ [dogeen-assembler-branch]
- * library/clock.tcl (FreeScan): Fixed a bug that caused relative
- days of the week in free-form [clock scan] to be evaluated in the
- wrong time zone.
- * tests/clock.test (clock-31.[456]): Made sure that there
- isn't an env(TZ) or env(TCL_TZ) lying around that will
- override the time zone that we're trying to establish with
- the simulated registry.
- Both problems reported as [Bug 1054101].
+ * tests/assemble.test:
+ * generic/tclAssemble.h:
+ * generic/tclAssemble.c: Added listIn, listNotIn, and dictGet.
-2004-10-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-09-30 Kevin B. Kenny <kennykb@acm.org>
- * doc/string.n (map): Rewrote to clarify that we don't just map
- single characters. [Bug 1048005]
- * doc/info.n (procs): Clarified that the pattern argument may have
- namespace separators in it. [Bug 1047928]
+ [dogeen-assembler-branch]
- * tests/cmdAH.test (cmdAH-8.45): Simplify in the hope that the
- reasons for [Bug 1053908] will become clearer.
+ * tests/assemble.test: Added tryCvtToNumeric and several more list
+ * generic/tclAssemble.c: operations.
+ * generic/tclAssemble.h:
-2004-10-25 Don Porter <dgp@users.sourceforge.net>
+2010-09-29 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclExecute.c (IllegalExprOperandType,TclExecuteByteCode):
- Removed several DECACHE_INFO/CACHE_INFO pairs that are no longer
- needed for protection because routines like Tcl_SetErrorCode() and
- Tcl_AddErrorInfo() can no longer re-enter bytecode execution.
+ [dogeen-assembler-branch]
- * generic/tclResult.c (TclProcessReturn): Bug fix. Be sure that
- a missing -errorinfo option when code == TCL_ERROR causes the
- errorInfo field to get reset.
+ * 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.
- * tests/thread.test (thread-4.4): Test depended on a ::errorInfo
- value initialized to "". Added code to test to setup that requirement.
+2010-09-29 Jan Nijtmans <nijtmans@users.sf.net>
- * library/auto.tcl Purged Tcl's script library of all
- * library/clock.tcl remaining references to global vars
- * library/init.tcl ::errorInfo and ::errorCode.
+ * 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 (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/tclMain.c (Tcl_Main): Updated to make use of
- TclGetReturnOptions instead of ::errorInfo variable.
+ * generic/tclVar.c: Use the macro HasLocalVars everywhere
- * generic/tclInterp.c (tclInit): Bug fix. Access dict variables
- with [dict get], not array syntax.
+2010-09-26 Miguel Sofer <msofer@users.sf.net>
-2004-10-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code
+ duplication, let the runtime var resolver call the compiled var
+ resolver.
- * tests/tm.test: Rewrote the tests to actually perform syntax
- checks on the public API. Added a new test (currently failing) to
- indicate that the test suite is not complete yet.
- * library/tm.tcl (path): Rewrote to turn this command into an
- ensemble to make it faster and simpler.
+2010-09-26 Kevin B. Kenny <kennykb@acm.org>
-2004-10-24 Miguel Sofer <msofer@users.sf.net>
+ [dogeen-assembler-branch]
- * generic/tclCmdIL.c:
- * generic/tclExecute.c:
+ * 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.
+
+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
+ documentation on how the module works to the top.
+
+2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: Make Tcl_SetPanicProc and Tcl_GetStringResult
+ * unix/tclAppInit.c: callable without stubs, just as Tcl_SetVar.
+ * win/tclAppInit.c:
+
+2010-09-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c: Fix cases where value returned by
+ * generic/tclEvent.c: Tcl_GetReturnOptions() was leaked.
+ * generic/tclMain.c: Thanks to Jeff Hobbs for discovery of the
+ anti-pattern to seek and destroy.
+
+2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * 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: [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.
+
+ * 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
+ * win/configure: mingw is exactly the same as for MSVC++.
+
+2010-09-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclExecute.c (TclExecuteByteCode):
+ * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect):
+ * 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
+ 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:
- * generic/tclTrace.c: defined new macros to get/set the flags of
- variables. The only files that still access the flag values
- directly are tclCompCmds.c, tclCompile.c, tclProc.c and tclVar.c
+ * 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.
-2004-10-24 Don Porter <dgp@users.sourceforge.net>
+2010-09-21 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo):
- Shift the initialization of errorCode to NONE to more central
- location.
+ * win/tclWinFile.c: Fix declaration after statement.
+ * 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
- * generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
- Rewrite to build on the new TclGet/SetReturnOptions routines.
+2010-09-20 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclResult.c (TclGetReturnOptions): Add call to
- Tcl_AddObjErrorInfo to be sure error fields are initialized.
+ * win/tclWinFCmd.c: Eliminate tclWinProcs->useWide everywhere, since
+ * win/tclWinFile.c: the value is always "1" on platforms >win95
+ * win/tclWinPipe.c:
- * generic/tclResult.c (TclTransferResult):
- Rewrite to build on the new TclGet/SetReturnOptions routines.
+2010-09-19 Donal K. Fellows <dkf@users.sf.net>
-2004-10-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * doc/file.n (file readlink): [Bug 3070580]: Typofix.
- * doc/tm.n: Tightened up the documentation.
- * tests/tm.test: Created (with partially dummy content) so TIP#189
- can be marked Final.
+2010-09-18 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make
- ensembles cut their implementations out of error traces. This is
- the right thing to do more often than not.
+ * win/tclWinFCmd.c [Bug 3069278]: Breakage on head Windows triggered
+ by install-tzdata. Temporary don't compile this with -DUNICODE, while
+ investigating this bug.
-2004-10-22 Kevin B. Kenny <kennykb@acm.org>
+2010-09-16 Jeff Hobbs <jeffh@ActiveState.com>
- * library/clock.tcl: Fixed a typo where the fallback time zone
- became ::localtime instead of :localtime. Fixed a bug where
- time zone names containing hyphens could not be loaded.
- * tests/clock.test: Added regression test cases that covers
- both bugs.
- Thanks to Todd M. Helfter <tmh@jumpgate.itsp.purdue.edu> for
- finding these bugs.
+ * win/tclWinFile.c: Remove define of FINDEX_INFO_LEVELS as all
+ supported versions of compilers should now have it.
-2004-10-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * unix/Makefile.in: Do not pass current build env vars when using
+ NATIVE_TCLSH in targets.
- * generic/tclExecute.c (TclCompEvalObj, Tcl_ExprObj):
- * generic/tclProc.c (TclProcCompileProc): Always call object
- freeIntRepProc's in the same way.
-
-2004-10-22 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclVar.c: fixed bug in commit of 2004-07-23, which was
- causing a leak of Proc structures and failure of compile-12.1. Two
- lines were 'zombies' from the previous way localVarNames
- worked. Credit dgp for finding this.
-
-2004-10-21 Don Porter <dgp@users.sourceforge.net>
+2010-09-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h (Interp):
- * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
- * generic/tclResult.c (GetKeys,ReleaseKeys,etc.):
- Moved the key values of the return options dictionary out of
- private fields of the Interp struct and into thread-static
- values managed in tclResult.c.
+ * 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/tclCmdAH.c (Tcl_CatchObjCmd, Tcl_ErrorObjCmd):
- Updated to call the new TclGet/SetReturnOptions routines to do
- much of their work.
-
- * generic/tclInt.h (TclGetReturnOptions,TclSetReturnOptions):
- * generic/tclResult.c (TclGetReturnOptions,TclSetReturnOptions):
- New utility routines to get/set the return options of an interp.
- Intent is that these routines will be converted to public routines
- after TIP approval.
-
- * generic/tclCmdMZ.c (TclProcessReturn,TclMergeReturnOptions):
- * generic/tclResult.c (TclProcessReturn,TclMergeReturnOptions):
- Move internal utility routines from tclCmdMZ.c to tclResult.c.
-
- * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp):
- * generic/tclResult.c (TclTransferResult): Rework so that
- iPtr->returnOpts can be NULL when there are no special options.
-
- * generic/tclResult.c (TclRestoreInterpState): Plug potential
- memory leak.
-
-2004-10-21 Kevin B. Kenny <kennykb@acm.org>
-
- * generic/tclBasic.c: Various changes to [clock format] that,
- * generic/tclClock.c: together, make it roughly twice as fast
- * generic/tclInt.h: while all tests in the test suite
- * library/clock.tcl: continue to pass.
-
-2004-10-20 Andreas Kupries <andreask@activestate.com>
-
- * win/Makefile.in (install-msgs): Fixed a problem with the
- * win/Makefile.in (install-tzdata): installation of timezone data
- and message catalogs. They used the installed tcl library
- directory, not the source library. Before it was installed.
- Switched to source lib dir. Thanks to Kevin for the help in
- figuring this out.
-
-2004-10-20 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclThreadTest.c (ThreadEventProc): Corrected subtle
- bug where the returned (char *) from Tcl_GetStringResult(interp)
- continued to be used without copying or refcounting, while
- activity on the interp continued. That's not safe, and recent
- changes demonstrated the lack of safety with failing tests
- thread-4.3 and thread-4.5.
-
-2004-10-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclDictObj.c (DictWithCmd): Make sure all paths (that
- are not themselves error paths) do not lose the result code.
-
-2004-10-19 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclInt.h (Tcl*InterpState): New internal routines
- * generic/tclResult.c (Tcl*InterpState): TclSaveInterpState,
- TclRestoreInterpState, and TclDiscardInterpState are superior
- replacements for Tcl_(Save|Restore|Discard)Result. Intent is that
- these routines will be converted to public routines after TIP approval.
- Interfaces for these routines were shamelessly stolen from Itcl.
-
- * generic/tclBasic.c (TclEvalObjvInternal):
- * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd):
- * generic/tclIOGT.c (ExecuteCallback):
- * generic/tclTrace.c (Trace*Proc,TclCheck*Traces,TclCallVarTraces):
- Callers of Tcl_*Result updated to call the new routines. The
- calls were relocated in several cases to perform save/restore
- operations only when needed.
-
- * generic/tclEvent.c (HandleBgErrors):
- * generic/tclFCmd.c (CopyRenameOneFile):
- Calls to Tcl_*Result that were eliminated because they appeared
- to serve no useful purpose, typically saving/restoring an error
- message, only to throw it away.
-
-2004-10-18 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
- * generic/tclCmdAH.c (Tcl_CatchObjCmd):
- * generic/tclCmdMZ.c (TclMergeReturnOptions,TclProcessReturn):
- * generic/tclCompCmds.c (TclCompileReturnCmd):
- * generic/tclExecute.c (TclCompEvalObj):
- * generic/tclInt.h (Interp):
- * generic/tclProc.c (TclUpdateReturnInfo):
- Place primary storage of the -level and -code information in private
- fields of the Interp struct, rather than in a DictObj. This should
- significantly improve performance of TclUpdateReturnInfo.
-
-2004-10-17 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclResult.c: removed unused variable [Bug 1048588].
- Thanks to Daniel South.
-
-2004-10-15 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclCmdMZ.c (TclProcessReturn): Now that primary
- * generic/tclProc.c (TclUpdateReturnInfo): storage for the
- errorInfo and errorCode values are internal fields, we can set
- them at the time of the [return] command, and not have to wait
- until the specified number of "-level"s have popped.
-
- * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,
- TclEvalObjvInternal,Tcl_LogCommandInfo,TclAddObjErrorInfo):
- * generic/tclCmdAH.c (Tcl_CatchObjCmd):
- * generic/tclEvent.c (BgError,ErrAssocData,Tcl_BackgroundError,
- HandleBgErrors,BgErrorDeleteProc):
- * generic/tclExecute.c (TclCreateExecEnv,TclDeleteExecEnv):
- * generic/tclIOUtil.c (comments only):
- * generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS):
- * generic/tclInterp.c ([tclInit]):
- * generic/tclMain.c (comments only):
- * generic/tclNamesp.c
- (Tcl_CreateNamespace,Tcl_DeleteNamespace,TclTeardownNamespace):
- * generic/tclProc.c (TclUpdateReturnInfo):
- * generic/tclResult.c
- (Tcl_ResetResult,TclTransferResult):
- * generic/tclTrace.c (CallVarTraces):
- Reworked management of the "errorInfo" data of an interp.
- That information is now primarily stored in a new private
- (Tcl_Obj *) field of the Interp struct, rather than using a
- global variable ::errorInfo as the primary storage. The
- ERR_IN_PROGRESS flag bit value is no longer required to manage
- the value in its new location, and is removed. Variable traces
- are established to support compatibility for any code expecting
- the ::errorInfo variable to hold the information.
+2010-09-15 Donal K. Fellows <dkf@users.sf.net>
- ***POTENTIAL INCOMPATIBILITY***
- Code that sets traces on the ::errorInfo variable may notice a
- difference in timing of the firing of those traces. Code that
- uses the value ERR_IN_PROGRESS.
+ * generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 3067036]: Make
+ sure we never try to double zero repeatedly to get a buffer size. Also
+ added a check for sanity on the size of buffer being appended.
-2004-10-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-09-15 Don Porter <dgp@users.sourceforge.net>
- TIP#217 IMPLEMENTATION
+ * unix/Makefile.in: Revise `make dist` target to tolerate the
+ case of zero bundled packages.
- * generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from
- James Salsman. [Patch 1017532]
+2010-09-15 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases
- of glob matching that let us avoid scanning through hash tables.
- * generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd):
- (InfoVarsCmd): Use this to speed up some [info] subcommands.
+ * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
+ * generic/tcl.decls: features to genStubs.tcl. Make the "generic"
+ * generic/tclInt.decls: argument in the *.decls files optional
+ * generic/tclOO.decls: (no change to any tcl*Decls.h files)
+ * generic/tclTomMath.decls:
+ This allows genStubs.tcl to generate the ttk stub files as well, while
+ keeping full compatibility with existing *.decls files.
-2004-10-12 Kevin B. Kenny <kennykb@acm.org>
+2010-09-14 Jan Nijtmans <nijtmans@users.sf.net>
- * library/tzdata/America/Campo_Grande:
- * library/tzdata/America/Cuiaba:
- * library/tzdata/America/Sao_Paulo
- * library/tzdata/America/Argentina/Mendoza:
- * library/tzdata/America/Argentina/San_Juan:
- Synchronized to Olson's 'tzdata2004e'.
+ * win/tclWinPort.h: Allow all Win2000+ API entries in Tcl
+ * win/tclWin32Dll.c: Eliminate dynamical loading of advapi23 and
+ kernel32 symbols.
-2004-10-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-09-13 Jan Nijtmans <nijtmans@users.sf.net>
- TIP#201 AND TIP#212 IMPLEMENTATIONS
+ * win/tclWinChan.c: Various clean-ups, converting from
+ * win/tclWinConsole.c: tclWinProc->xxxProc directly to Xxx
+ * win/tclWinInit.c: (no change in functionality)
+ * win/tclWinLoad.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+ * tools/genStubs.tcl: Add scspec feature from ttkGenStubs.tcl
+ (no change in output for *Decls.h files)
- * doc/dict.n, doc/expr.n: Documentation for new functionality.
- * tests/expr.test: Basic tests of 'in' and 'ni' behaviour.
- * tests/dict.test (dict-21.*,dict-22.*): Tests for [dict update]
- and [dict with].
- * generic/tclExecute.c (TclExecuteByteCode): Implementation of the
- INST_LIST_IN and INST_LIST_NOT_IN bytecodes.
- * generic/tclParseExpr.c (GetLexeme): Parse the 'in' and 'ni'
- operators for TIP#201.
- * generic/tclDictObj.c (DictUpdateCmd,DictWithCmd): Core of
- implementation of TIP#212; docs and tests still to do...
+2010-09-10 Jan Nijtmans <nijtmans@users.sf.net>
-2004-10-07 Don Porter <dgp@users.sourceforge.net>
+ * win/tclWin32Dll.c: Partly revert yesterday's change, to make it work
+ on VC++ 6.0 again.
- * generic/tclTest.c (TestsetobjerrorcodeCmd): Simplified.
+2010-09-10 Donal K. Fellows <dkf@users.sf.net>
-2004-10-07 Vince Darley <vincentdarley@users.sourceforge.net>
+ * doc/regsub.n: [Bug 3063568]: Fix for gotcha in example due to Tcl's
+ special handling of backslash-newline. Makes example slightly less
+ pure, but more useful.
- * generic/tclFileName.c:
- * generic/tclFileSystem.h:
- * generic/tclIOUtil.c:
- * generic/tclPathObj.c:
- * unix/tclUnixFile.c:
- * win/tclWinFile.c:
- * tests/fileName.test:
- * tests/winFCmd.test: code reorganization for better generic/
- platform code splitting [Bug 925620] removing the need for
- several #ifdef's, and tests and fix for an unreported Windows
- glob problem ('glob -dir C: -tails *').
+2010-09-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/makefile.vc: Mingw should always link with -ladvapi32.
+ * win/tcl.m4:
+ * win/configure: (regenerated)
+ * win/tclWinInt.h: Remove ascii variant of tkWinPocs table, it is
+ * win/tclWin32Dll.c: no longer necessary. Fix CreateProcess signature
+ * win/tclWinPipe.c: and remove unused GetModuleFileName and lstrcpy.
+ * win/tclWinPort.h: Mingw/cygwin fixes: <tchar.h> should always be
+ included, and fix conflict in various macro values: Always force the
+ same values as in VC++.
+
+2010-09-08 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinChan.c: [Bug 3059922]: #ifdef protections to permit
+ * win/tclWinFCmd.c: builds with mingw on amd64 systems. Thanks to
+ "mescalinum" for reporting and testing.
-2004-10-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-09-08 Andreas Kupries <andreask@activestate.com>
- * *.3: Convert CONST to const and VOID to void so we document how
- people should actually use the Tcl API and not the compatability
- hacks that it has to have.
+ * doc/tm.n: Added underscore to the set of characters accepted in
+ module names. This is true for quite some time in the code, this
+ change catches up the documentation.
- * doc/man.macros, *.3: Update .AS macro so it can know how wide to
- make the third column of the argument list. Update documentation
- for C API (only users) to take advantage of this.
+2010-09-03 Donal K. Fellows <dkf@users.sf.net>
- * doc/FileSystem.3: Formatting fixes for greater documentation
- clarity.
+ * tools/tcltk-man2html.tcl (plus-pkgs): Improve the package
+ documentation search pattern to support the doctoos-generated
+ directory structure.
+ * tools/tcltk-man2html-utils.tcl (output-name): Made this more
+ resilient against misformatted NAME sections, induced by import of
+ Thread package documentation into Tcl doc tree.
-2004-10-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-09-02 Andreas Kupries <andreask@activestate.com>
- * generic/tclFileName.c (DoGlob, TclGlob): Stop messy sharing of
- interpreter result and instead use a private object for collecting
- the result of the glob. This simplifies TclGlob quite a lot.
- * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): Simplify by
- removing some nesting. Also standardize variable names.
- (FsAddMountsToGlobResult): Force updates to the list to be done
- in-place, putting a side-condition of non-shared-ness on the
- resultPtr argument to Tcl_FSMatchInDirectory, but everything would
- have broken before if that was shared *anyway*.
+ * doc/glob.n: Fixed documentation ambiguity regarding the handling
+ of -join.
- * generic/tclEncoding.c (LoadTableEncoding): Removed reference to
- Tcl interpreter; it wasn't needed as direct object use is more
- efficient.
+ * library/safe.tcl (safe::AliasGlob): Fixed another problem, the
+ option -join does not stop option processing in the core builtin, so
+ the emulation must not do that either.
- * generic/tclPathObj.c: Made this file follow the style rules in
- the Engineering Manual more closely, and also take advantage of
- the internal object manipulation macros more.
+2010-09-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reorganized to have fewer
- magic flag variables and to separate the code that scans for a
- match from the code that processes a match body.
+ * library/safe.tcl (safe::AliasGlob): Moved the command extending the
+ actual glob command with a -directory flag to when we actually have a
+ proper untranslated path,
-2004-10-06 Don Porter <dgp@users.sourceforge.net>
+2010-09-01 Andreas Kupries <andreask@activestate.com>
+ * generic/tclExecute.c: [Bug 3057639]: Applied patch by Jeff to make
+ * generic/tclVar.c: the behaviour of lappend in bytecompiled mode
+ * tests/append.test: consistent with direct-eval and 'append'
+ * tests/appendComp.test: generally. Added tests (append*-9.*)
+ showing the difference.
+
+2010-08-31 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/rules.vc: Typo (thanks to Twylite discovering
+ this)
+ * generic/tclStubLib.c: Revert to previous version: MSVC++ 6.0
+ * generic/tclTomMathStubLib.c:cannot handle the new construct.
+ * generic/tcl.decls [Patch 2997642]: Many type casts needed
+ * generic/tclDecls.h: when using Tcl_Pkg* API. Remaining part.
+ * generic/tclPkg.c:
* generic/tclBasic.c:
- * generic/tclBinary.c:
- * generic/tclCmdAH.c:
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclCompExpr.c:
+ * generic/tclTomMathInterface.c:
+ * doc/PkgRequire.3
+
+2010-08-31 Andreas Kupries <andreask@activestate.com>
+
+ * win/tcl.m4: Applied patch by Jeff fixing issues with the manifest
+ handling on Win64.
+ * win/configure: Regenerated.
+
+2010-08-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: [Bugs 3046594,3047235,3048771]: New
+ * generic/tclCmdAH.c: implementation for [tailcall] command: it now
+ * generic/tclCmdMZ.c: schedules the command and returns TCL_RETURN.
+ * generic/tclExecute.c: This fixes all issues with [catch] and [try].
+ * generic/tclInt.h: Thanks dgp for exploring the dark corners.
+ * generic/tclNamesp.c: More thorough testing is required.
+ * tests/tailcall.test:
+
+2010-08-30 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: [FRQ 2965056]: Windows build with -DUNICODE
+ * win/rules.vc:
+ * win/tclWinFCmd.c: Make sure that allocated TCHAR arrays are
+ * win/tclWinFile.c: always properly aligned as wchar_t, and
+ * win/tclWinPipe.c: not bigger than necessary.
+ * win/tclWinSock.c:
+ * win/tclWinDde.c: Those 3 files are not converted yet to be
+ * win/tclWinReg.c: built with -DUNICODE, so add a TODO.
+ * win/tclWinTest.c:
+ * generic/tcl.decls: [Patch 2997642]: Many type casts needed when
+ * generic/tclDecls.h: using Tcl_Pkg* API. Partly.
+ * generic/tclPkg.c:
+ * generic/tclStubLib.c: Demonstration how this change can benefit
+ code.
+ * generic/tclTomMathStubLib.c:
+ * doc/PkgRequire.3:
+
+2010-08-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/dict.n: [Bug 3046999]: Corrected cross reference to array
+ manpage to refer to (correct) existing subcommand.
+
+2010-08-26 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure, unix/tcl.m4: SHLIB_LD_LIBS='${LIBS}' for OSF1-V*.
+ Add /usr/lib64 to set of auto-search dirs. [Bug 1230554]
+ (SC_PATH_X): Correct syntax error when xincludes not found.
+
+ * win/Makefile.in (VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE):
+ * win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST
+ macro and --enable-embedded-manifest configure arg added to support
+ manifest embedding where we know the magic. Help prevents DLL hell
+ with MSVC8+.
+
+2010-08-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls: [Bug 3007895]: Tcl_(Find|Create)HashEntry
+ * generic/tclHash.c: stub entries can never be called.
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c: [Patch 2994165]: Change signature of
+ Tcl_FSGetNativePath and TclpDeleteFile follow-up: move stub entry back
+ to original location.
+
+2010-08-23 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/Asia/Gaza: Olson's tzdata2010l.
+
+2010-08-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBasic.c: [Patch 3009403]: Signature of Tcl_GetHashKey,
+ * generic/tclBinary.c: Tcl_(Create|Find)HashEntry follow-up:
+ * generic/tclCmdIL.c: Remove many type casts which are no longer
+ * generic/tclCompile.c:necessary as a result of this signature change.
* generic/tclDictObj.c:
* generic/tclEncoding.c:
* generic/tclExecute.c:
- * generic/tclFCmd.c:
- * generic/tclHistory.c:
- * generic/tclIndexObj.c:
* generic/tclInterp.c:
- * generic/tclIO.c:
* generic/tclIOCmd.c:
- * generic/tclNamesp.c:
* generic/tclObj.c:
- * generic/tclPkg.c:
- * generic/tclResult.c:
- * generic/tclScan.c:
- * generic/tclTimer.c:
+ * generic/tclProc.c:
+ * generic/tclTest.c:
* generic/tclTrace.c:
* generic/tclUtil.c:
* generic/tclVar.c:
+
+2010-08-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/linsert.n: [Bug 3045123]: Make description of what is actually
+ happening more accurate.
+
+2010-08-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
+ features to genStubs.tcl, partly: Use void (*reserved$i)(void) = 0
+ instead of void *reserved$i = NULL for unused stub entries, in case
+ pointer-to-function and pointer-to-object are different sizes.
+ * generic/tcl*Decls.h: (regenerated)
+ * generic/tcl*StubInit.c:(regenerated)
+
+2010-08-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * doc/Method.3: Fix definition of Tcl_MethodType.
+
+2010-08-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclTrace.c (TraceExecutionObjCmd, TraceCommandObjCmd)
+ (TraceVariableObjCmd): [Patch 3048354]: Use memcpy() instead of
+ strcpy() to avoid buffer overflow; we have the correct length of data
+ to copy anyway since we've just allocated the target buffer.
+
+2010-08-18 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
+ features to genStubs.tcl, partly: remove unneeded ifdeffery and put
+ C++ guard around stubs pointer definition.
+ * generic/*Decls.h: (regenerated)
+
+2010-08-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: New redesign of [tailcall]: find
+ * generic/tclExecute.c: errors early on, so that errorInfo
+ * generic/tclInt.h: contains the proper info [Bug 3047235]
+ * generic/tclNamesp.c:
+
+ * generic/tclCmdAH.c (TclNRTryObjCmd): [Bug 3046594]: Block
+ tailcalling out of the body of a non-bc'ed [try].
+
+ * generic/tclBasic.c: Redesign of [tailcall] to
+ * generic/tclCmdAH.c: (a) fix [Bug 3047235]
+ * generic/tclCompile.h: (b) enable fix for [Bug 3046594]
+ * generic/tclExecute.c: (c) enable recursive tailcalls
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * tests/tailcall.test:
+
+2010-08-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (AliasGlob): [Bug 3004191]: Restore safe [glob] to
+ working condition.
+
+2010-08-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the
+ handling of passing the wrong number of arguments to [apply] somewhat
+ less verbose when a lambda term is present.
+
+2010-08-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/unicows: Remove completely, see [FRQ 2819611].
+ * doc/FileSystem.3: [Patch 2994165]: Change signature of
+ * generic/tcl.decls Tcl_FSGetNativePath and TclpDeleteFile
+ * generic/tclDecls.h:
+ * generic/tclIOUtil.c:
+ * generic/tclStubInit.c:
+ * generic/tclInt.h:
* unix/tclUnixFCmd.c:
- * unix/tclUnixPipe.c:
- * win/tclWinDde.c:
* win/tclWinFCmd.c:
- * win/tclWinPipe.c:
- * win/tclWinReg.c:
- It is a poor practice to directly set or append to the value
- of the objResult of an interp, because that value might be
- shared, and in that circumstance a Tcl_Panic() will be the
- result. Searched for example of this practice and replaced
- with safer alternatives, often using the Tcl_AppendResult()
- routine that dkf just rehabilitated.
- * library/dde/pkgIndex.tcl: Bump to dde 1.3.1
- * library/reg/pkgIndex.tcl: Bump to registry 1.1.5
-
-2004-10-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * doc/SetResult.3: Made Tcl_AppendResult non-deprecated; better
- that people use it than most of the common alternatives!
- * generic/tclResult.c (Tcl_AppendResultVA): Make this work better
- with Tcl_Objs. [Patch 1041072]
- (Tcl_SetResult, Tcl_AppendElement): Change string to stringPtr to
- avoid C++ keywords.
-
-2004-10-05 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c (TclObjInvoke): More simplification of the
- TclObjInvoke routine toward unification with the rest of the
- evaluation stack.
-
- * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,
- TclEvalObjvInternal,Tcl_LogCommandInfo):
- * generic/tclCmdAH.c (Tcl_CatchObjCmd):
- * generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
- * generic/tclInt.h (Interp, ERROR_CODE_SET):
- * generic/tclNamesp.c
- (Tcl_CreateNamespace,Tcl_DeleteNamespace,TclTeardownNamespace):
- * generic/tclResult.c
- (Tcl_ResetResult,Tcl_SetObjErrorCode,TclTransferResult):
- * generic/tclTrace.c (CallVarTraces):
- Reworked management of the "errorCode" data of an interp.
- That information is now primarily stored in a new private
- (Tcl_Obj *) field of the Interp struct, rather than using a
- global variable ::errorCode as the primary storage. The
- ERROR_CODE_SET flag bit value is no longer required to manage
- the value in its new location, and is removed. Variable traces
- are established to support compatibility for any code expecting
- the ::errorCode variable to hold the information.
+ * doc/Hash.3: [Patch 3009403]: Signature of Tcl_GetHashKey,
+ * generic/tcl.h: Tcl_(Create|Find)HashEntry
- ***POTENTIAL INCOMPATIBILITY***
- Code that sets traces on the ::errorCode variable may notice a
- difference in timing of the firing of those traces.
+2010-08-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/ldAix: Remove ancient (pre-4.2) AIX support
+ * unix/configure: Regen with ac-2.59
+ * unix/configure.in, unix/tclConfig.sh.in, unix/Makefile.in:
+ * unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with
+ -bexpall/-brtl. Remove TCL_EXP_FILE (export file) and other baggage
+ that went with it. Remove pre-4 AIX build support.
- * generic/tclNamesp.c (Tcl_PopCallFrame): Removed Bug 1038021
- workaround. That bug is now fixed.
-
-2004-10-04 Kevin B. Kenny <kennykb@acm.org>
-
- * tests/clock.test (clock-34.*): Removed an antibug that forced
- comparison of [clock scan] results with the :localtime time zone.
- Now that [clock scan] uses the current time zone instead, the
- antibug caused several tests to fail. [Bug 1038554]
+2010-08-11 Miguel Sofer <msofer@users.sf.net>
-2004-10-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclBasic.c (TclNRYieldToObjCmd):
+ * tests/coroutine.test: Fixed bad copypasta snafu. Thanks to Andy Goth
+ for finding the bug.
- * generic/tclParseExpr.c (GetLexeme): Ensure that the 'eq' and
- 'ne' operators are followed by non-alphabetic characters so
- lexemes can't run together. [Bug 884830]
+2010-08-10 Jeff Hobbs <jeffh@ActiveState.com>
- * doc/DictObj.3, doc/dict.n: Clarified that a dictionary is not
- order-preserving. [Bug 1032243] Also added another example to
- show off more ways of using a dictionary and a few other
- formatting improvements.
+ * generic/tclUtil.c (TclByteArrayMatch): Patterns may not be
+ null-terminated, so account for that.
-2004-10-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-08-09 Don Porter <dgp@users.sourceforge.net>
- * generic/tclDictObj.c (TraceDictPath, Tcl_DictObjPutKeyList): Add
- support for automatic creation of dictionary paths since that is
- what everyone seems to actually expect of the API! [Bug 1037235]
- (Tcl_DictObjNext): Make calling this after Tcl_DictObjDone non-fatal
- as that simplifies a number of internal APIs. This doesn't break any
- existing working code as it is a case which previously caused a panic.
+ * changes: Updates for 8.6b2 release.
-2004-10-02 Don Porter <dgp@users.sourceforge.net>
+2010-08-04 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/namespace.test (namespace-8.7): Another test for save/restore
- of ::errorInfo and ::errorCode during global namespace teardown.
+ * win/Makefile.in, win/makefile.bc, win/makefile.vc, win/tcl.dsp:
+ * win/tclWinPipe.c (TclpCreateProcess):
+ * win/stub16.c (removed): Removed Win9x tclpip8x.dll build and 16-bit
+ application loader stub support. Win9x is no longer supported.
-2004-10-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * win/tclWin32Dll.c (TclWinInit): Hard-enforce Windows 9x as an
+ unsupported platform with a panic. Code to support it still exists in
+ other files (to go away in time), but new APIs are being used that
+ don't exist on Win9x.
- * generic/tclProc.c (TclObjGetFrame, Tcl_UplevelObjCmd):
- * generic/tclVar.c (Tcl_UpvarObjCmd): Cache stackframe level
- references in the level object for speed.
+ * unix/tclUnixFCmd.c: Adjust license header as per
+ ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change
-2004-09-30 Don Porter <dgp@users.sourceforge.net>
+ * license.terms: Fix DFARs note for number-adjusted rights clause
- * generic/tclBasic.c (Tcl_CreateInterp): Removed the flag bit value
- * generic/tclInt.h (Interp): EXPR_INITIALIZED. It was set during
- interp creation and never tested. Whatever purpose it had is in
- the past.
+ * win/tclWin32Dll.c (asciiProcs, unicodeProcs):
+ * win/tclWinLoad.c (TclpDlopen): 'load' use LoadLibraryEx with
+ * win/tclWinInt.h (TclWinProcs): LOAD_WITH_ALTERED_SEARCH_PATH to
+ prefer dependent DLLs in same dir as loaded DLL.
- * generic/tclBasic.c (Tcl_EvalObjEx): Removed the flag bit value
- * generic/tclInt.h (Interp): USE_EVAL_DIRECT. It was used only
- * generic/tcLTest.c (TestevalexObjCmd): in the testing command
- * tests/parser.test (parse-9.2): [testevalex] and nothing in the
- test suite made use of the capability it enabled.
+ * win/Makefile.in (%.${OBJEXT}): better implicit rules support
- * generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization
- * generic/tclCmdAH.c (Tcl_ErrorObjCmd): of the management of
- * generic/tclCmdMZ.c (TclProcessReturn): the errorCode value.
- * tests/error.test (error-6.4-9):
+2010-08-04 Andreas Kupries <andreask@activestate.com>
- * generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified
- * tests/namespace.test (namespace-8.5,6): the save/restore
- of ::errorInfo and ::errorCode during global namespace teardown.
- Revised the comment to clarify why this is done, and added tests
- that will fail if this is not done.
+ * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting in
+ * generic/tclIORTrans.c: InvokeTclMethod and callers.
+ * tests/ioTrans.test:
- * generic/tclResult.c (TclTransferResult): Added safety
- checks so that unexpected undefined ::errorInfo or ::errorCode
- will not lead to a segfault.
+2010-08-03 Andreas Kupries <andreask@activestate.com>
- * generic/tclTrace.c (TclCallVarTraces): Save/restore the flag
- * tests/var.test (var-16.1): values that define part of the
- interpreter state during variable traces. [Bug 1038021].
+ * tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating
+ the local hashtable deletion crash and fix.
-2004-09-30 Miguel Sofer <msofer@users.sf.net>
+ * tests/info.test (info-39.1): Added forward copy of test in 8.5
+ branch about [Bug 2933089]. Should not fail, and doesn't, after
+ updating the line numbers to the changed position.
- * tests/subst.test (12.1-2): added tests for [Bug 1036649]
+2010-08-02 Kevin B. Kenny <kennykb@users.sf.net>
-2004-09-29 Don Porter <dgp@users.sourceforge.net>
+ * library/tzdata/America/Bahia_Banderas:
+ * library/tzdata/Pacific/Chuuk:
+ * library/tzdata/Pacific/Pohnpei:
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/Europe/Helsinki:
+ * library/tzdata/Pacific/Ponape:
+ * library/tzdata/Pacific/Truk:
+ * library/tzdata/Pacific/Yap: Olson's tzdata2010k.
- * tests/basic.test (49.*): New tests for TCL_EVAL_GLOBAL.
+2010-08-02 Miguel Sofer <msofer@users.sf.net>
-2004-09-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclVar.c: Correcting bad port of [Bug 3037525] fix
- * generic/tclVar.c (TclObjLookupVar, TclObjLookupVar):
- (TclObjUnsetVar2, SetArraySearchObj):
- * generic/tclUtil.c (SetEndOffsetFromAny):
- * generic/tclStringObj.c (Tcl_SetStringObj):
- (Tcl_SetUnicodeObj, SetStringFromAny):
- * generic/tclResult.c (ResetObjResult):
- * generic/tclRegexp.c (Tcl_GetRegExpFromObj):
- * generic/tclPathObj.c (TclFSMakePathRelative, SetFsPathFromAny):
- (TclFSMakePathFromNormalized, Tcl_FSNewNativePath):
- * generic/tclObj.c (TclFreeObj, Tcl_SetBooleanObj, SetBooleanFromAny):
- (Tcl_SetDoubleObj, SetDoubleFromAny, Tcl_SetIntObj):
- (SetIntOrWideFromAny, Tcl_SetLongObj, SetWideIntFromAny):
- (Tcl_SetWideIntObj, TclSetCmdNameObj, SetCmdNameFromAny):
- * generic/tclNamesp.c (SetNsNameFromAny, MakeCachedEnsembleCommand):
- * generic/tclListObj.c (Tcl_SetListObj, SetListFromAny):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
- * generic/tclDictObj.c (SetDictFromAny):
- * generic/tclCompile.c (TclInitByteCodeObj):
- * generic/tclBinary.c (Tcl_SetByteArrayObj, SetByteArrayFromAny):
- * generic/tclInt.h (TclFreeIntRep): Factorize out deletion of object
- internal representation to a shared macro, so simplifying much code.
+2010-07-28 Miguel Sofer <msofer@users.sf.net>
-2004-09-27 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclBasic.c (TclObjInvoke): fix for bogus gcc warning
- about uninitialised variable.
+ * generic/tclVar.c: [Bug 3037525]: Lose fickle optimisation in
+ TclDeleteVars (used for runtime-created locals) that caused crash.
-2004-09-27 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclBasic.c: Removed internal routines TclInvoke,
- * generic/tclInt.decls: TclGlobalInvoke, TclObjInvokeGlobal and
- * tests/basic.test: the portion of TclObjInvoke that handles
- calls without TCL_INVOKE_HIDDEN enabled. None of this code is
- called any longer within the core, and the superior public
- interface, Tcl_EvalObjv, is available for any external callers.
+2010-07-29 Jan Nijtmans <nijtmans@users.sf.net>
+ * compat/zlib/win32/README.txt: Official build of zlib1.dll 1.2.5 is
+ * compat/zlib/win32/USAGE.txt: finally available, so put it in.
+ * compat/zlib/win32/zlib1.dll:
+
+2010-07-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/http.n: Corrected description of location of one of the entries
+ in the state array.
+
+2010-07-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclDecls.h: [Bug 3029891]: Functions that don't belong in
+ * generic/tclTest.c: the stub table.
+ * generic/tclBasic.c: From [Bug 3030870] make itcl 3.x built with
+ pre-8.6 work in 8.6: Relax the relation between Tcl_CallFrame and
+ CallFrame.
+
+2010-07-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c: Added more errorCode setting.
+
+2010-07-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Ensure that [dict get]
+ * generic/tclDictObj.c (DictGetCmd): always generates an errorCode on
+ a failure to look up an entry.
+
+2010-07-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * unix/configure: (regenerated)
+ * unix/configure.in: For the NATIVE_TCLSH variable use the autoconf
+ * unix/Makefile.in: SC_PROG_TCLSH to try and find a locally installed
+ native binary. This avoids manually fixing up when cross compiling. If
+ there is not one, revert to using the build product.
+
+2010-07-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decs: Reverted to the original TIP 337
+ implementation on what to do with the obsolete internal stub for
+ TclBackgroundException() (eliminate it!)
* generic/tclIntDecls.h: make genstubs
* generic/tclStubInit.c:
- * generic/tclEvent.c (HandleBgErrors): Updated [bgerror]
- invocations to make use of Tcl_Obj based routines, dropping
- the calls to TclGlobalInvoke()
+2010-07-02 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-27 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclInt.decls: [Bug 803489]: Tcl_FindNamespace problem in
+ * generic/tclIntDecls.h: the Stubs table
+ * generic/tclStubInit.c:
- * generic/tclFileName.c:
- * generic/tclFileSystem.h:
- * generic/tclIOUtil.c:
- * generic/tclPathObj.c:
- * tests/cmdAH.test:
- * tests/fileSystem.test:
- * tests/winFCmd.test: fix to bad error message with 'cd' on
- windows, when permissions are inadequate [Bug 1035462] and
- to treatment of a volume-relative pwd on Windows [Bug 1018980].
+2010-07-02 Donal K. Fellows <dkf@users.sf.net>
- * doc/FileSystem.3: added missing Tcl_GlobTypeData documentation
- [Bug 935853]
+ * generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made
+ sure that errors caused by an argument to an operator being outside
+ the domain of the operator all result in ::errorCode being ARITH
+ DOMAIN and not NONE.
-2004-09-27 Kevin Kenny <kennykb@acm.org>
+2010-07-01 Jan Nijtmans <nijtmans@users.sf.net>
- * compat/strftime.c (Removed):
- * generic/tclClock.c (removed TclClockOldscanObjCmd):
- * generic/tclDate.c (Regenerated):
- * generic/tclGetDate.y:
- * generic/tclInt.decls (removed TclGetDate and TclpStrftime):
- * generic/tclInt.h (removed TclGetDateInfo):
- * generic/tclIntDecls.h (Regenerated):
- * generic/tclStubInit.c (Regenerated):
- * library/clock.tcl:
- * unix/tclUnixTime.c (removed TclpStrftime):
- * win/Makefile.in:
- * win/makefile.bc:
- * win/makefile.bc:
- * win/tcl.dsp:
- Continued refactoring of [clock] for TIP 173 changes.
- Broke the free-form parser apart so that the Bison parser
- is responsible for only parsing, while clock.tcl handles
- relative times like "next Thursday", "next January". This
- change is needed to make timezones other than :localtime
- and :Etc/UTC work with free-form scanning. This change closes
- out the issue identified as being "for another day" in
- my log message of 2004-09-08. The refactored code also
- eliminates the last known references to TclpStrftime and
- TclGetDate, so those routines (including compat/strftime.c)
- have been removed. The refactoring also has the benefit
- that all storage in the Bison parser is now on the C stack,
- eliminating any need for mutex protection around [clock scan].
- Also, changed the Makefiles so that 'make gendate' is
- available on Windows as well as Unix.
-
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): Removed some grubby
- * generic/tclObj.c (SetBooleanFromAny): work-around code
- that was needed only
- because of Bug 868489.
-
- * generic/tclBasic.c (TclObjInvoke): Removed three unused
- variables to silence a compiler warning in VC++.
-
-2004-09-27 Vince Darley <vincentdarley@users.sourceforge.net>
-
- * doc/FileSystem.3: fix to small typo.
-
-2004-09-26 Miguel Sofer <msofer@users.sf.net>
+ * win/rules.vc: [Bug 3020677]: wish can't link reg1.2
+ * tools/checkLibraryDoc.tcl: formatting, spacing, cleanup unused
+ * tools/eolFix.tcl: variables; no change in generated output
+ * tools/fix_tommath_h.tcl:
+ * tools/genStubs.tcl:
+ * tools/index.tcl:
+ * tools/man2help2.tcl:
+ * tools/regexpTestLib.tcl:
+ * tools/tsdPerf.tcl:
+ * tools/uniClass.tcl:
+ * tools/uniParse.tcl:
- * generic/tclCompCmds.c:
- * generic/tclCompExpr.c:
- * generic/tclCompile.c:
- * generic/tclCompile.h:
- * generic/tclInt.h:
- * generic/tclProc.c:
- * tests/compExpr-old.test:
- * tests/compExpr.test:
- * tests/expr.test:
- * tests/for.test:
- * tests/if.test:
- * tests/incr.test:
- * tests/while.test:
- Report compilation errors at runtime, [Patch 1033689] by dgp.
+2010-07-01 Donal K. Fellows <dkf@users.sf.net>
-2004-09-23 Mo DeJong <mdejong@users.sourceforge.net>
+ * doc/mathop.n: [Bug 3023165]: Fix typo that was preventing proper
+ rendering of the exclusive-or operator.
- * unix/dltest/Makefile.in (clean): Fixup make clean
- rule so that it does not delete all files when
- SHLIB_SUFFIX is set to the empty string in a static build.
- [Bug 1016726]
+2010-06-28 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-23 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclPosixStr.c: [Bug 3019634]: errno.h and tclWinPort.h have
+ conflicting definitions. Added messages for ENOTRECOVERABLE, EOTHER,
+ ECANCELED and EOWNERDEAD, and fixed various typing mistakes in other
+ messages.
- * generic/tclBasic.c: Corrections to the 2004-09-21 commit
- * generic/tclExecute.c: regarding ERR_ALREADY_LOGGED. That commit
- * generic/tclNamesp.c: caused Tk test send-10.7 to fail. Added
- * tests/namespace.test (25.7,8): tests in the Tcl test suite
- * tests/pkg.test (2.25,26): to catch this error without the
- aid of Tk in the future.
+2010-06-25 Reinhard Max <max@suse.de>
- * generic/tclCmdAH.c (Tcl_ExprObjCmd): Simplified the TclObjCmdProc
- of [expr] with a call to Tcl_ConcatObj.
+ * tests/socket.test: Prevent a race condition during shutdown of the
+ remote test server that can cause a hang when the server is being run
+ in verbose mode.
-2004-09-22 Don Porter <dgp@users.sourceforge.net>
+2010-06-24 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclCmdMZ.c (TclProcessReturn): Support the -errorline
- * generic/tclCompile.c (TclCompileScript): option to [return].
- * tests/compile.test (16.23.*): Use that capability to defer reporting
- * tests/misc.test (1.2): of parse errors until runtime.
- Updated tests to reflect change. [Bug 1032805]
+ * win/tclWinPort.h: [Bug 3019634]: errno.h and tclWinPort.h have
+ conflicting definitions.
-2004-09-22 Miguel Sofer <msofer@users.sf.net>
+ ***POTENTIAL INCOMPATIBILITY***
+ On win32, the correspondence between errno and the related error
+ message, as handled by Tcl_ErrnoMsg() changes. The error message is
+ kept the same, but the corresponding errno value might change.
- * generic/tclExecute.c (INST_START_CMD):
- * tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect
- whenever a loop exception was returned.
+2010-06-22 Donal K. Fellows <dkf@users.sf.net>
-2004-09-22 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclCmdIL.c (Tcl_LsetObjCmd): [Bug 3019351]: Corrected wrong
+ args message.
- * library/tzdata/America/Montevideo: Updated to reflect
- ftp://elsie.nci.nih.gov/pub/tzdata2004d.tar.gz. (Changes
- to Asia/Jerusalem were in the comments only.) [Routine
- maintenance - no bug] Spanish-language description of the
- change at http://www.presidencia.gub.uy/decretos/2004091502.htm
+2010-06-21 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-21 Don Porter <dgp@users.sourceforge.net>
+ * unix/tclLoadDl.c: Eliminate various unnecessary type casts, use
+ * unix/tclLoadNext.c: function typedefs whenever possible
+ * unix/tclUnixChan.c:
+ * unix/tclUnixFile.c:
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixSock.c:
+ * unix/tclUnixTest.c:
+ * unix/tclXtTest.c:
+ * generic/tclZlib.c: Remove hack needed for zlib 1.2.3 on win32
- * generic/tclCompCmds.c: Tolerate [append] syntax errors
- * tests/appendComp.test (8.1): at compile time, and allow runtime
- to raise the error (or succeed if a redefined [append] allows).
+2010-06-18 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclBasic.c: Reworked management of the interp
- * generic/tclCompile.c: flag ERR_ALREADY_LOGGED, to reduce
- * generic/tclExecute.c: its exposure. Still left several
- * generic/tclNamesp.c: references that are just too nice
- on performace to do away with. These changes also resolve
- an inconsistency in the ::errorInfo values produced by
- [namespace eval x error foo bar] and
- [namespace eval x {error foo bar}].
+ * library/init.tcl (auto_execok): [Bug 3017997]: Add .cmd to the
+ default list of extensions that we can execute interactively.
- * generic/tclExecute.c (TclCompEvalObj): Simplified
- the TclCompEvalObj routine. Much housekeeping now reliably
- happens elsewhere. [Patch 1031949]
+2010-06-16 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * tools/loadICU.tcl: [Bug 3016135]: Traceback using clock format
+ * library/msgs/he.msg: with locale of he_IL.
- * doc/interp.n: Tighten up wording on how [interp eval] and
- [interp invokehidden] operate w.r.t. stack frames. [Bug 926590]
+ * generic/tcl.h: Simplify Tcl_AppInit and *_Init definitions,
+ * generic/tclInt.h: spacing. Change TclpThreadCreate and
+ * generic/tcl.decls: Tcl_CreateThread signature, making clear that
+ * generic/tclDecls.h: "proc" is a function pointer, as in all other
+ * generic/tclEvent.c: "proc" function parameters.
+ * generic/tclTestProcBodyObj.c:
+ * win/tclWinThrd.c:
+ * unix/tclUnixThrd.c:
+ * doc/Thread.3:
+ * doc/Class.3: Fix Tcl_ObjectMetadataType definition.
-2004-09-20 Don Porter <dgp@users.sourceforge.net>
+2010-06-14 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/error.test (error-6.2,3): Added more tests to verify
- ::errorCode setting by/after a [catch].
+ * unix/Makefile.in: Fix compilation of xttest with 8.6 changes
+ * unix/tclXtNotify.c:
+ * unix/tclXtTest.c:
+ * generic/tclPipe.c: Fix gcc warning (with -fstrict-aliasing=2)
+ * library/auto.tcl: Spacing and style fixes.
+ * library/history.tcl:
+ * library/init.tcl:
+ * library/package.tcl:
+ * library/safe.tcl:
+ * library/tm.tcl:
-2004-09-19 Miguel Sofer <msofer@users.sf.net>
+2010-06-13 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCmdAH.c: removed outdated comment [Bug 1029518].
+ * tools/tcltk-man2html.tcl (make-man-pages): [Bug 3015327]: Make the
+ title of a manual page be stored relative to its resulting directory
+ name as well as its source filename. This was caused by both Tcl and a
+ contributed package ([incr Tcl]) defining an Object.3. Also corrected
+ the joining of strings in titles to avoid extra braces.
-2004-09-18 David Gravereaux <davygrvy@pobox.com>
+2010-06-09 Andreas Kupries <andreask@activestate.com>
- * win/tclAppInit.c: Dde package can load into a safe interp.
- Claim this fact for the Tcl_StaticPackage() call when the shell
- is built with the TCL_USE_STATIC_PACKAGES option.
+ * library/platform/platform.tcl: Added OSX Intel 64bit
+ * library/platform/pkgIndex.tcl: Package updated to version 1.0.9.
+ * unix/Makefile.in:
+ * win/Makefile.in:
-2004-09-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-06-09 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that
- large shifts end up shifting correctly. [Bug 868467]
+ * tools/tsdPerf.c: Fix export of symbol Tsdperf_Init, when using
+ -fvisibility=hidden. Make two functions static, eliminate some
+ unnecessary type casts.
+ * tools/configure.in: Update to Tcl 8.6
+ * tools/configure: (regenerated)
+ * tools/.cvsignore new file
- * doc/FileSystem.3, doc/OpenFileChnl.3: More documentation fixes
- from Mikhail Kolesnitchenko. [Patch 1022527]
- * doc/*: Standardize highlighting of symbols defined in tcl.h
+2010-06-07 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-09-17 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclExecute.c: Ensure proper reset of [info errorstack] even
+ * generic/tclNamesp.c: when compiling constant expr's with errors.
- * generic/tclBasic.c (Tcl_AddObjErrorInfo, Tcl_LogCommandInfo):
- * generic/tclCmdAH.c ([catch], [error]):
- * generic/tclCmdMZ.c ([return]):
- * generic/tclProc.c (TclUpdateReturnInfo):
- * generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode)
- (TclTransferResult): Refactored so that all errorCode setting
- flows through Tcl_SetObjErrorCode(). This greatly reduces the
- number of different places in the code that need to know details
- about an internal bitflag field of the Interp struct. Also
- places errorCode setting in one place for easier future mods.
+2010-06-05 Miguel Sofer <msofer@users.sf.net>
-2004-09-17 Kevin B.Kenny <kennykb@acm.org>
+ * generic/tclBasic.c: [Bug 3008307]: make callerPtr chains be
+ * generic/tclExecute.c: traversable accross coro boundaries. Add the
+ special coroutine CallFrame (partially reverting commit of
+ 2009-12-10), as it is needed for coroutines that do not push a CF, eg,
+ those with [eval] as command. Thanks to Colin McCormack (coldstore)
+ and Alexandre Ferrieux for the hard work on this.
- * generic/tclDate.c: Revised tclGetDate.y to use bison instead
- * generic/tclGetDate.y: of yacc to build the parser, eliminating
- * generic/tclInt.h: all the complicated hackery involving
- * unix/Makefile.in: 'sed' postprocessing. Rebuilt the parser.
+2010-06-03 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-09-14 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclNamesp.c: Safer (and faster) computation of [uplevel]
+ * tests/error.test: offsets in TIP 348. Toplevel offsets no longer
+ * tests/result.test: overestimated.
- * generic/tclClock.c (ClockOldscanObjCmd): Silenced a compiler
- warning (long passed as a param where unsigend long was
- expected). 'Unsigned long' is wrong, but the fix is really
- to change the signature of TclGetDate to return a structure of
- its 'yy' variables and then do the remaining work inside
- clock.tcl. But, as I said on 2004-09-08, that's a job for
- another day. [Bug 1027993]
+2010-06-02 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-10 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclOO.h: BUILD_tcloo is never defined (leftover)
+ * win/makefile.bc: Don't set BUILD_tcloo (leftover)
+ See also entry below: 2008-06-01 Joe Mistachkin
- * doc/interp.n:
- * generic/tclInterp.c (TclPreventAliasLoop, AliasCreate):
- * tests/interp.test (17.4-6, 19.3-4): fixing problems with
- renaming of aliases [Bugs 707104 1026493]. Fix designed by dgp.
+2010-06-01 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-09-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclNamesp.c: Fix computation of [uplevel] offsets in TIP 348
+ * tests/error.test: Only depend on callerPtr chaining now.
+ * tests/result.test: Needed for upcoming coro patch.
- * generic/tclNamesp.c (NsEnsembleImplementationCmd): Add token
- field to internal rep of EnsembleCmdRep structure so that we can
- check it to see if the subcommand object is really being used with
- the same ensemble. [Bug 1026903]
+2010-05-31 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-11 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclVar.c: Eliminate some casts to (Tcl_HashTable *)
+ * generic/tclExecute.c:
+ * tests/fileSystem.test: Fix filesystem-5.1 test failure on CYGWIN
- * generic/tclClock.c (TclMktimeObjCmd): Corrected a bad check
- for error return from 'mktime'.
- * generic/tclObj.c (Tcl_GetIntFromObj): Corrected a problem where
- demoting a wide to an int failed on a big-endian machine.
- [Bug 1026125].
- * tests/clock.test (clock-43.1): Added regression test for
- error return from 'mktime'.
+2010-05-28 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-11 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclInt.h: [Patch 3008541]: Order of TIP #348 fields in
+ Interp structure
- * generic/tclExecute.c (INST_CONCAT1): fix for [Bug 1025834];
- avoid unnecessary string copies.
+2010-05-28 Donal K. Fellows <dkf@users.sf.net>
-2004-09-10 David Gravereaux <davyrgvy@pobox.com>
+ * generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]:
+ Corrected error in handling of catch contexts to prevent crash with
+ chained handlers.
- * tests/tcltest.test: tcltest-12.3-4 needed to have
- ::tcltest::loadScript set to empty in their -setup
+ * generic/tclExecute.c (TclExecuteByteCode): Restore correct operation
+ of instruction-level execution tracing (had been broken by NRE).
-2004-09-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-05-27 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value
- parsing code so that values do not flip so easily between numeric
- representations. Thanks to KBK for this! [Bug 868489]
+ * library/opt/optParse.tcl: Don't generate spaces at the end of a
+ * library/opt/pkgIndex.tcl: line, eliminate ';' at line end, bump to
+ * tools/uniParse.tcl: v0.4.6
+ * generic/tclUniData.c:
+ * tests/opt.test:
+ * tests/safe.test:
- * generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to
- set ::errorCode on error. [Bug 1025359]
+2010-05-21 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-10 Andreas Kupries <andreask@activestate.com>
+ * tools/installData.tcl: Make sure that copyDir only receives
+ normalized paths, otherwise it might result in a crash on CYGWIN.
+ Restyle according to the Tcl style guide.
+ * generic/tclStrToD.c: [Bug 3005233]: Fix for build on OpenBSD vax
- * generic/tcl.h: Micro formatting fixes.
- * generic/tclIOGT.c: Channel version fixed, must be 3, to have
- wideseekProc. Thanks to David Graveraux <davygrvy@pobox.com>.
-
-2004-09-11 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclNamespace.c (TclGetNamespaceForQualName): Resolved
- longstanding inconsistency in the treatment of the TCL_NAMESPACE_ONLY
- flag revealed by testing the 2004-09-09 commits against Itcl.
- TCL_NAMESPACE_ONLY now acts as specified in the pre-function
- comment, forcing resolution in the passed in context namespace.
- It has been incorrectly forcing resolution in the interp's current
- namespace.
-
-2004-09-10 Kevin Kenny <kennykb@acm.org>
-
- * library/clock.tcl: Fixed a bug where %z always put a plus
- sign on the time zone in :localtime.
- * tests/clock.test: Added test case for the above bug.
-
-2004-09-10 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclExecute.c (INST_CONCAT1): added a peephole
- optimisation for concatting an empty string. This enables
- replacing the idiom 'K $x [set x {}]' by '$x[set x {}]' for
- fastest execution.
-
-2004-09-09 David Gravereaux <davygrvy@pobox.com>
-
- * win/tclWinConsole.c: Calls to WriteFile and WriteConsoleA
- changed to WriteConsole for simplicity.
-
-2004-09-09 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclNamesp.c (Tcl_ForgetImport): Corrected faulty
- * tests/namespace.test: logic that relied exclusively on string
- matching and failed in the presence of [rename]s. [Bug 560297]
- Also corrected faulty prevention of [namespace import] cycles.
- [Bug 1017299]
+2010-05-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-09-08 Don Porter <dgp@users.sourceforge.net>
+ * tests/dict.test: Add missing tests for [Bug 3004007], fixed under
+ the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions
- * generic/tclBasic.c (Tcl_CreateInterp): Removed obsolete
- field for storing the string-based command procedure of built-in
- commands. We no longer have any string-based built-in commands!
+2010-05-19 Jan Nijtmans <nijtmans@users.sf.net>
-2004-09-08 Kevin B. Kenny <kennykb@acm.org>
-
- * compat/strftime.c (_conv): Corrected a problem where hour 0
- would format as a blank format group with %k.
- * doc/clock.n: Corrected a buglet in the header information.
- [Bug 1024058]
- * generic/tclClock.c (TclClockMktimeObjCmd): Fixed a bug where
- the month was scanned incorrectly in -timezone :localtime.
- * tests/clock.test (clock-34.*,clock-40.1, clock-41.1): Adjusted the
- clock-34.* test cases so that the consistency check is performed
- in :localtime rather than the current time zone. This change
- allows dealing with issues where the C library has a different
- idea of DST conversion than Tcl. (Real fix would be to break
- TclGetDate into separate parser and time converter, and do
- the time conversion in clock.tcl. That's for another day.)
- Added regression test case for the bug where month was scanned
- incorrectly in -timezone :localtime. [Bug 1023779] Added
- regression test case for %k at the zero hour.
+ * generic/regcomp.c: Don't use arrays of length 1, just use a
+ * generic/tclFileName.c: single element then, it makes code more
+ * generic/tclLoad.c: readable. (Here it even prevents a type cast)
-2004-09-07 David Gravereaux <davygrvy@pobox.com>
+2010-05-17 Jan Nijtmans <nijtmans@users.sf.net>
- * win/makefile.vc: some quoting needed to be removed as it was
- breaking with VC7. [Bug 1023150]
+ * generic/tclStrToD.c: [Bug 2996549]: Failure in expr.test on Win32
-2004-09-07 Kevin B. Kenny <kennykb@acm.org>
+2010-05-17 Donal K. Fellows <dkf@users.sf.net>
- * doc/clock.n: Documented the default -format, and changed
- references to a (nonexistent) msgcat command to refer to
- the msgcat package. [Bug 1023870]
- * generic/tclTimer.c: Removed a premature optimisation that
- attempted to store the assoc data in the client data; the
- optimisation caused a bug that [after] would overwrite
- its imports. [Bug 1016167]
- * library/clock.tcl (InitTZData, ClearCaches): Changed so that the
- in-memory time zone :UTC (and its aliases) always gets
- reinitialised, in case tzdata is absent. [Bug 1019537, 1023779]
- * library/tzdata/*: Regenerated.
- * tests/clock.test (clock-31.*, clock-39.1): Corrected a problem
- where the 'system' locale tests fail on a non-English Windows
- machine. [Bug 1023761]. Added a test to make sure that alias
- time zones load correctly. [Bug 1023779].
- * tests/timer.test (timer-1.1, timer-2.1): Changed to (one hopes!)
- be more resilient on an overloaded system, if [after 200] sleeps
- for 300 ms or longer.
- * tools/tclZIC.tcl (writeLinks): Corrected a problem where
- alias time zone names were written incorrectly, causing them
- to fail to load at run time. [Bug 1023779].
- * win/tclWinTime.c (Tcl_GetTime): Eliminated CPUID tests on
- Win64 - assuming that HAL vendors now do a better job of
- keeping the performance counters synchronized among CPU's.
- [Bug 1020445]
+ * generic/tclCmdIL.c (TclInfoFrame): Change this code to use
+ Tcl_GetCommandFullName rather than rolling its own. Discovered during
+ the hunting of [Bug 3001438] but unlikely to be a fix.
-2004-09-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-05-11 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/tclvars.n, doc/tcltest.n, doc/tclsh.1, doc/safe.n, doc/expr.n:
- * doc/WrongNumArgs.3, doc/Utf.3, doc/TraceVar.3, doc/Thread.3:
- * doc/TCL_MEM_DEBUG.3, doc/SubstObj.3, doc/StdChannels.3:
- * doc/SetResult.3, doc/RegExp.3, doc/RegConfig.3, doc/RecEvalObj.3:
- * doc/PrintDbl.3, doc/ParseCmd.3, doc/Panic.3, doc/ObjectType.3:
- * doc/Object.3, doc/Namespace.3, doc/Interp.3, doc/IntObj.3:
- * doc/Hash.3, doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3:
- * doc/Encoding.3, doc/DoubleObj.3, doc/DictObj.3, doc/CrtTimerHdlr.3:
- * doc/CrtObjCmd.3, doc/CrtMathFnc.3, doc/CrtCommand.3, doc/CrtChannel.3:
- * doc/ChnlStack.3, doc/ByteArrObj.3, doc/AssocData.3, doc/Alloc.3:
- More documentation fixes from Mikhail Kolesnitchenko. [Patch 1022527]
+ * win/tclWinConsole.c: [Patch 2997087]: Unnecessary type casts.
+ * win/tclWinDde.c:
+ * win/tclWinLoad.c:
+ * win/tclWinNotify.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+ * win/tclWinTime.c:
+ * win/tclWinPort.h: Don't duplicate CYGWIN timezone #define from
+ tclPort.h
+
+2010-05-07 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit.
+ * library/platform/pkgIndex.tcl: Package updated to version 1.0.8.
+ * unix/Makefile.in:
+ * win/Makefile.in:
-2004-09-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-05-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPkg.c: Unnecessary type casts, see [Patch 2997087]
+
+2010-05-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinNotify.c: TCHAR-related fixes, making those two files
+ * win/tclWinSock.c: compile fine when TCHAR != char. Please see
+ comments in [FRQ 2965056] (2965056-1.patch).
+
+2010-05-03 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIORChan.c: Use "tclIO.h" and "tclTomMathDecls.h"
+ * generic/tclIORTrans.c: everywhere
+ * generic/tclTomMath.h:
+ * tools/fix_tommath_h.tcl:
+ * libtommath/tommath.h: Formatting (# should always be first char on
+ line)
+ * win/tclAppInit.c: For MINGW/CYGWIN, use GetCommandLineA
+ explicitly.
+ * unix/.cvsignore: Add pkg, *.dll
+
+ * libtommath/tommath.h: CONSTify various useful internal
+ * libtommath/bn_mp_cmp_d.c: functions (TclBignumToDouble, TclCeil,
+ * libtommath/bn_mp_cmp_mag.c: TclFloor), and related tommath functions
+ * libtommath/bn_mp_cmp.c:
+ * libtommath/bn_mp_copy.c:
+ * libtommath/bn_mp_count_bits.c:
+ * libtommath/bn_mp_div_2d.c:
+ * libtommath/bn_mp_mod_2d.c:
+ * libtommath/bn_mp_mul_2d.c:
+ * libtommath/bn_mp_neg.c:
+ * generic/tclBasic.c: Handle TODO: const correctness ?
+ * generic/tclInt.h:
+ * generic/tclStrToD.c:
+ * generic/tclTomMath.decls:
+ * generic/tclTomMath.h:
+ * generic/tclTomMathDecls.h:
+
+2010-04-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump patchlevel to 8.6b1.2 to distinguish
+ * library/init.tcl: CVS snapshots from earlier snapshots as well
+ * unix/configure.in: as the 8.6b1 and 8.6b2 releases.
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
- * unix/tclUnixFCmd.c: Stop NULL interp arguments from triggering a
- crash when an error happens. [Bug 1020538]
+ * generic/tclBinary.c (TclAppendBytesToByteArray): Add comments
+ * generic/tclInt.h (TclAppendBytesToByteArray): placing overflow
+ protection responsibility on caller. Convert "len" argument to signed
+ int which any value already vetted for overflow issues will fit into.
+ * generic/tclStringObj.c: Update caller; standardize panic msg.
-2004-09-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]: Add
+ panic when the generated string representation would grow beyond Tcl's
+ size limits.
- * doc/lsearch.n: Clarified meaning of -dictionary. [Bug 759545]
+2010-04-30 Donal K. Fellows <dkf@users.sf.net>
-2004-09-02 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclBinary.c (TclAppendBytesToByteArray): Add extra armour
+ against buffer overflows.
- * win/makefile.vc: clock.tcl needs to be installed.
+ * generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
+ * tests/coroutine.test (coroutine-6.4): arguments to deal with
+ trickier cases.
-2004-09-01 Jeff Hobbs <jeffh@ActiveState.com>
+2010-04-30 Miguel Sofer <msofer@users.sf.net>
- * win/tclWinReg.c (BroadcastValue): WIN64 cast corrections
+ * tests/coroutine.test: testing coroutine arguments after [yield]:
+ check that only 0/1 allowed
- * win/tclWinDde.c (DdeClientWindowProc):
- (DdeServicesOnAck, DdeEnumWindowsCallback): WIN64 corrections
+2010-04-30 Donal K. Fellows <dkf@users.sf.net>
- * win/tclWin32Dll.c (TclWinCPUID): need _asm for WIN64 (Itanium),
- until we have it, just return unknown. [Bug 1020445]
+ * generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
+ arguments to deal with trickier cases.
-2004-09-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclCompCmds.c (TclCompileVariableCmd): Slightly tighter
+ issuing of instructions.
- * doc/regsub.n, doc/RegConfig.3, doc/Environment.3:
- * doc/CrtChannel.3, doc/safe.n: Use correct abbreviations.
+ * generic/tclExecute.c (TclExecuteByteCode): Add peephole optimization
+ of the fact that INST_DICT_FIRST and INST_DICT_NEXT always have a
+ conditional jump afterwards.
-2004-08-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclBasic.c (TclNRYieldObjCmd, TclNRYieldmObjCmd)
+ (NRInterpCoroutine): Replace magic values for formal argument counts
+ for coroutine command implementations with #defines, for an increase
+ in readability.
- * doc/trace.n, doc/socket.n, doc/registry.n, doc/pid.n:
- * doc/namespace.n, doc/msgcat.n, doc/lsort.n, doc/lsearch.n:
- * doc/linsert.n, doc/info.n, doc/http.n, doc/history.n:
- * doc/format.n, doc/file.n, doc/exec.n, doc/dde.n, doc/clock.n:
- * doc/catch.n, doc/binary.n: More spelling and grammar fixes from
- Mikhail Kolesnitchenko. [Patch 1018486]
-
-2004-08-31 Vince Darley <vincentdarley@users.sourceforge.net>
+2010-04-30 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/FileSystem.3:
- * generic/tclIOUtil.c: Clarified documentation regarding ability
- of a filesystem to say that it doesn't support a given operation
- using the EXDEV posix error code (copyFileProc, renameFileProc,
- etc), and updated one piece of code to ensure correct behaviour
- when an operation is not supported [Bug 1017072]
+ * generic/tclMain.c: Unnecessary TCL_STORAGE_CLASS re-definition. It
+ was used for an ancient dummy reference to Tcl_LinkVar(), but that's
+ already gone since 2002-05-29.
- * tests/fCmd.test: fix to test suite problem [Bug 1002884]
+2010-04-29 Miguel Sofer <msofer@users.sf.net>
-2004-08-31 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tclCompExpr.c: Slight change in the literal sharing
+ * generic/tclCompile.c: mechanism to avoid shimmering of
+ * generic/tclCompile.h: command names.
+ * generic/tclLiteral.c:
- * unix/Makefile.in (install-libraries): portable sh fix.
+2010-04-29 Andreas Kupries <andreask@activestate.com>
-2004-08-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * library/platform/platform.tcl: Another stab at getting the /lib,
+ * library/platform/pkgIndex.tcl: /lib64 difference right for linux.
+ * unix/Makefile.in: Package updated to version 1.0.7.
+ * win/Makefile.in:
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from
- crashing when its map and input string are the same object.
+2010-04-29 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Antarctica/Macquarie:
+ * library/tzdata/Africa/Casablanca:
+ * library/tzdata/Africa/Tunis:
+ * library/tzdata/America/Santiago:
+ * library/tzdata/America/Argentina/San_Luis:
+ * library/tzdata/Antarctica/Casey:
+ * library/tzdata/Antarctica/Davis:
+ * library/tzdata/Asia/Anadyr:
+ * library/tzdata/Asia/Damascus:
+ * library/tzdata/Asia/Dhaka:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Kamchatka:
+ * library/tzdata/Asia/Karachi:
+ * library/tzdata/Asia/Taipei:
+ * library/tzdata/Europe/Samara:
+ * library/tzdata/Pacific/Apia:
+ * library/tzdata/Pacific/Easter:
+ * library/tzdata/Pacific/Fiji: Olson's tzdata2010i.
+
+2010-04-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make
+ * generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte
+ array to another into an efficent operation. The problem was the (lack
+ of) a proper growth management strategy for the byte array.
+
+2010-04-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/dirent2.h: Include "tcl.h", not <tcl.h>, like everywhere
+ * compat/dlfcn.h: else, to ensure that the version in the Tcl
+ * compat/stdlib.h: distribution is used, not some version from
+ * compat/string.h: somewhere else.
+ * compat/unistd.h:
+
+2010-04-28 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/Makefile.in: Remove unused @MAN2TCLFLAGS@
+ * win/tclWinPort.h: Move <limits.h> include from tclInt.h to
+ * generic/tclInt.h: tclWinPort.h, and eliminate unneeded
+ * generic/tclEnv.c: <stdlib.h>, <stdio.h> and <string.h>, which
+ are already in tclInt.h
+ * generic/regcustom.h: Move "tclInt.h" from regcustom.h up to
+ * generic/regex.h: regex.h.
+ * generic/tclAlloc.c: Unneeded <stdio.h> include.
+ * generic/tclExecute.c: Fix gcc warning: comparison between signed and
+ unsigned.
+
+2010-04-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (TclIsVarDirectUnsettable): Corrected flags so that
+ deletion of traces is not optimized out...
+
+ * generic/tclExecute.c (ExecuteExtendedBinaryMathOp)
+ (TclCompareTwoNumbers,ExecuteExtendedUnaryMathOp,TclExecuteByteCode):
+ [Patch 2981677]: Move the less common arithmetic operations (i.e.,
+ exponentiation and operations on non-longs) out of TEBC for a big drop
+ in the overall size of the stack frame for most code. Net effect on
+ speed is minimal (slightly faster overall in tclbench). Also extended
+ the number of places where TRESULT handling is replaced with a jump to
+ dedicated code.
+
+2010-04-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Rearrange location of an
+ assignment to shorten the object code.
+
+2010-04-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIOUtil.c (Tcl_FSGetNativePath): [Bug 2992292]:
+ tclIOUtil.c assignment type mismatch compiler warning
+ * generic/regguts.h: If tclInt.h or tclPort.h is already
+ * generic/tclBasic.c: included, don't include <limits.h>
+ * generic/tclExecute.c: again. Follow-up to [Bug 2991415]:
+ * generic/tclIORChan.c: tclport.h #included before limits.h
+ * generic/tclIORTrans.c: See comments in [Bug 2991415]
+ * generic/tclObj.c:
+ * generic/tclOOInt.h:
+ * generic/tclStrToD.c:
+ * generic/tclTomMath.h:
+ * generic/tclTomMathInterface.c:
+ * generic/tclUtil.c:
+ * compat/strtod.c:
+ * compat/strtol.c:
-2004-08-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-04-27 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclNamesp.c (FindEnsemble): Factor out the code to
- convert a command name into an ensemble configuration and add
- support for ignoring [namespace import] link chains. [Bug 1017022]
- (NamespaceWhichCmd): Rework to use newer option parsing API.
+ * unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Simplified the logic
+ so that the casts added in Donal Fellows's change for the same bug are
+ no longer necessary.
-2004-08-27 Daniel Steffen <das@users.sourceforge.net>
+2010-04-26 Donal K. Fellows <dkf@users.sf.net>
- * unix/Makefile.in: added customization of default module path roots
- via TCL_MODULE_PATH makefile variable.
- * macosx/Makefile: add platform standard locations to default
- module path roots. [Patch 942881]
+ * unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Added an explicit cast
+ because auto-casting between function and non-function types is never
+ naturally warning-free.
- * tests/env.test: macosx fixes.
+ * generic/tclStubInit.c: Add a small amount of gcc-isms (with #ifdef
+ * generic/tclOOStubInit.c: guards) to ensure that warnings are issued
+ when these files are older than the various *.decls files.
-2004-08-25 Don Porter <dgp@users.sourceforge.net>
+2010-04-25 Miguel Sofer <msofer@users.sf.net>
- * tests/timer.test (timer-10.1): Test for Bug 1016167.
- * generic/tclTimer.c: Workaround for situation when a
- [namespace import] causes the objv[0] value to be something
- other than what Tcl_AfterObjCmd expects. [Bug 1016167].
+ * generic/tclBasic.c: Add unsupported [yieldm] command. Credit
+ * generic/tclInt.h: Lars Hellstrom for the basic idea.
-2004-08-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-04-24 Miguel Sofer <msofer@users.sf.net>
- * generic/tclNamesp.c (NsEnsembleImplementationCmd): Use the
- ensemble command token to get the name of the ensemble for passing
- to the -unknown handler instead of relying on objv[0], which may
- contain useless info in the presence of [namespace import].
- Problem found by Don Porter when investigating [Bug 1016167].
+ * generic/tclBasic.c: Modify api of TclSpliceTailcall() to fix
+ * generic/tclExecute.c: [yieldTo], which had not survived the latest
+ * generic/tclInt.h: mods to tailcall. Thanks kbk for detecting
+ the problem.
-2004-08-24 Don Porter <dgp@users.sourceforge.net>
+2010-04-23 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclProc.c: The routine TclProcInterpProc was a
- * generic/tclTestProcBodyObj.c: specific instance of the general
- service already provided by TclObjInvokeProc. Removed
- TclProcInterpProc and TclGetInterpProc from the code...
+ * unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before
+ limits.h
- * generic/tclInt.decls ...and from the internal stubs table.
- * generic/tclIntDecls.h
- * generic/tclStubInit.c
+2010-04-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclPlatDecls.h: Move TCHAR fallback typedef from tcl.h to
+ * generic/tcl.h: tclPlatDecls.h (as suggested by dgp)
+ * generic/tclInt.h: fix typo
+ * generic/tclIOUtil.c: Eliminate various unnecessary
+ * unix/tclUnixFile.c: type casts.
+ * unix/tclUnixPipe.c:
+ * win/tclWinChan.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+ * win/tclWinLoad.c:
+ * win/tclWinPipe.c:
+
+2010-04-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclTest.c: Use function prototypes from the FS API.
+ * compat/zlib/*: Upgrade to zlib 1.2.5
+
+2010-04-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Improve commenting and
+ reduce indentation for the Invocation Block.
+
+2010-04-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/unset.n: [Bug 2988940]: Fix typo.
-2004-08-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-04-15 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/string.n: Added clarifying note.
+ * win/tclWinPort.h: Move inclusion of <tchar.h> from
+ * generic/tcl.h: tclPlatDecls.h to tclWinPort.h, where it
+ * generic/tclPlatDecls.h: belongs. Add fallback in tcl.h, so TCHAR is
+ available in win32 always.
-2004-08-23 Don Porter <dgp@users.sourceforge.net>
+2010-04-15 Donal K. Fellows <dkf@users.sf.net>
- * library/auto.tcl: Updated [tcl_findLibrary] search path
- to include any [<pkg>::pkgconfig get scriptdir,runtime] directory,
- as well as the $::auto_path. [RFE 695441]
+ * doc/try.n: [Bug 2987551]: Fix typo.
-2004-08-21 Kevin B. Kenny <kennykb@acm.org>
+2010-04-14 Andreas Kupries <andreask@activestate.com>
- * tests/clock.test (clock-38.1): Changed TZ setting to specify
- CET in excruciating detail to deal with systems that lack the
- Posix defaults for DST changes (and to be formally correct with
- the change dates for CET).
+ * library/platform/platform.tcl: Linux platform identification:
+ * library/platform/pkgIndex.tcl: Check /lib64 for existence of files
+ * unix/Makefile.in: matching libc* before accepting it as base
+ * win/Makefile.in: directory. This can happen on weirdly installed
+ 32bit systems which have an empty or partially filled /lib64 without
+ an actual libc. Bumped to version 1.0.6.
-2004-08-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-04-13 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclScan.c (Tcl_ScanObjCmd, ValidateFormat): Ensure that
- the %ld conversion works correctly on 64-bit platforms. [Bug 1011860]
+ * win/tclWinPort.h: Fix [Patch 2986105]: conditionally defining
+ * win/tclWinFile.c: strcasecmp/strncasecmp
+ * win/tclWinLoad.c: Fix gcc warning: comparison of unsigned expression
+ >= 0 is always true
-2004-08-19 Kevin Kenny <kennykb@acm.org>
+2010-04-08 Donal K. Fellows <dkf@users.sf.net>
- * library/clock.tcl (format): Changed default timezone format
- from alphabetic to numeric to produce scannable times in more
- locales.
- * tests/clock.test (clock-37.1): Removed now-unused 'needPST'
- constraint and the comments that refer to it.
+ * generic/tclCompCmdsSZ.c (TclSubstCompile): If the first token does
+ not result in a *guaranteed* push of a Tcl_Obj on the stack, we must
+ push an empty object. Otherwise it is possible to get to a 'concat1'
+ or 'done' without enough values on the stack, resulting in a crash.
+ Thanks to Joe Mistachkin for identifying a script that could trigger
+ this case.
-2004-08-18 Andreas Kupries <andreask@activestate.com>
+2010-04-07 Donal K. Fellows <dkf@users.sf.net>
- * library/init.tcl: Integrated TIP #189. We source a separate file
- (see below), instead of inlining the contents of that file. This
- should beeasier to maintain, and easier to backport/install in
- 8.4 installations.
+ * doc/catch.n, doc/info.n, doc/return.n: Formatting.
- Note: Usage of Tcl Modules is restricted to non-safe interps. It
- cannot be loaded into a safe interp.
+2010-04-06 Donal K. Fellows <dkf@users.sf.net>
- * library/tm.tcl: New file, the v2 reference implementation for
- TIP #189, Tcl Modules.
+ * doc/Load.3: Minor corrections of formatting and cross links.
- * doc/tm.n: New file, documentation for Tcl Modules, based on the
- TIP.
+2010-04-06 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/mkLinks: Regenerated.
- * win/makefile.vc: Added tm.tcl to list of files to install.
+ * win/configure: (regenerate with autoconf-2.59)
+ * unix/configure:
+ * unix/installManPage: [Bug 2982540]: configure and install* script
+ * unix/install-sh: files should always have LF line ending.
+ * doc/Load.3: Fix signature of Tcl_LoadFile in documentation.
-2004-08-18 Kevin Kenny <kennykb@acm.org>
+2010-04-05 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * tests/httpd (httpdRespond): Corrected an abuse of the [clock]
- command that caused test failures for some values of [clock clicks].
+ TIP #348 IMPLEMENTATION
- * doc/clock.n
- * generic/tclBasic.c (Tcl_CreateInterp, Tcl_HideUnsafeCommands):
- * generic/tclClock.c (all):
+ * generic/tclBasic.c: [Patch 2868499]: Substituted error stack
+ * generic/tclCmdIL.c:
* generic/tclInt.h:
- * generic/tclInterp.c (CreateSlave):
- * library/clock.tcl: (new file)
- * library/init.tcl (clock):
- * library/msgs/*.msg:(new files)
- * library/tzdata/*:
- * library/tzdata/*/*:
- * library/tzdata/*/*/*: (new files)
- * tools/installData.tcl: (new file)
- * tools/loadICU.tcl: (new file)
- * tools/makeTestCases.tcl: (new file)
- * tools/tclZIC.tcl: (new file)
- * unix/Makefile.in:
- * unix/configure: (regenerated)
- * unix/tcl.m4:
- * tests/clock.test (all):
+ * generic/tclNamesp.c:
+ * generic/tclResult.c:
+ * doc/catch.n:
+ * doc/info.n:
+ * doc/return.n:
+ * tests/cmdMZ.test:
+ * tests/error.test:
+ * tests/execute.test:
+ * tests/info.test:
+ * tests/init.test:
+ * tests/result.test:
+
+2010-04-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Flip the default for whether to
+ * win/tcl.m4 (SC_ENABLE_THREADS): build in threaded mode. Part of
+ * win/rules.vc: TIP #364.
+
+ * unix/tclLoadDyld.c (FindSymbol): Better human-readable error message
+ generation to match code in tclLoadDl.c.
+
+2010-04-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIOUtil.c, unix/tclLoadDl.c: Minor changes to enforce
+ Engineering Manual style rules.
+
+ * doc/FileSystem.3, doc/Load.3: Documentation for TIP#357.
+
+ * macosx/tclMacOSXBundle.c (OpenResourceMap): [Bug 2981528]: Only
+ define this function when HAVE_COREFOUNDATION is defined.
+
+2010-04-02 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls (Tcl_LoadFile): Add missing "const" in signature,
+ * generic/tclIOUtil.c (Tcl_LoadFile): and some formatting fixes
+ * generic/tclDecls.h: (regenerated)
+
+2010-04-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIOUtil.c (Tcl_LoadFile): Corrections to previous commit
+ * unix/tclLoadDyld.c (TclpDlopen): to make it build on OSX.
+
+2010-04-02 Kevin B. Kenny <kennykb@acm.org>
+
+ TIP #357 IMPLEMENTATION
+ TIP #362 IMPLEMENTATION
+
+ * generic/tclStrToD.c: [Bug 2952904]: Defer creation of the smallest
+ floating point number until it is actually used. (This change avoids a
+ bogus syslog message regarding a 'floating point software assist
+ fault' on SGI systems.)
+
+ * library/reg/pkgIndex.tcl: [TIP #362]: Fixed first round of bugs
+ * tests/registry.test: resulting from the recent commits of
+ * win/tclWinReg.c: changes in support of the referenced
+ TIP.
+
+ * generic/tcl.decls: [TIP #357]: First round of changes
+ * generic/tclDecls.h: to export Tcl_LoadFile,
+ * generic/tclIOUtil.c: Tcl_FindSymbol, and Tcl_FSUnloadFile
+ * generic/tclInt.h: to the public API.
+ * generic/tclLoad.c:
+ * generic/tclLoadNone.c:
+ * generic/tclStubInit.c:
+ * tests/fileSystem.test:
+ * tests/load.test:
+ * tests/unload.test:
+ * unix/tclLoadDl.c:
+ * unix/tclLoadDyld.c:
+ * unix/tclLoadNext.c:
+ * unix/tclLoadOSF.c:
+ * unix/tclLoadShl.c:
+ * unix/tclUnixPipe.c:
* win/Makefile.in:
- * win/Makefile.vc:
- Implementation of TIPs #173 and #209.
-
- The [clock] command is now a Tcl ensemble, with most of its
- functionality written in Tcl and callouts to C code only to
- access low-level functions such as localtime, mktime and
- tzset.
-
- In addition to the functionality changes called out in the two
- TIPs, it is worth noting that the [clock] command in a safe
- slave interpreter is now an alias to the [clock] command in the
- master, and that [clock] is otherwise not expected to function
- entirely correctly in safe interps. C code that simply does
- Tcl_MakeSafe needs to be aware that [clock] may need special
- handling. (It appears unlikely that such code actually exists.)
-
- One incompatibility of note is that if the time zone cannot
- be determined from the TZ, TCL_TZ environment variables, or
- from the Windows control panel, so that the C library must be
- used for date and time conversions, then times outside the
- range of time_t will fail; they used to return bad data silently.
-
- Many thanks to all the many people who assisted with testing,
- debugging, criticism of the specification, and localisation.
- Deserving of particular mention are Joe English, Clif Flynt, Donal
- K. Fellows, Jeff Hobbs, Cameron Laird, Arjen Markus, Reinhard Max,
- Christopher Nelson, Steve Offutt, Donald G. Porter, Pascal
- Scheffers, Peter da Silva and Richard Suchenwirth-Bauersachs.
-
- *** POTENTIAL INCOMPATIBILITY ***
-
-2004-08-16 Miguel Sofer <msofer@users.sf.net>
-
- * doc/SetVar.3:
- * generic/tclTest.c (TestseterrorcodeCmd):
- * generic/tclVar.c (TclPtrSetVar):
- * tests/result.test (result-4.*, result-5.*): [Bug 1008314]
- detected and fixed by dgp.
+ * win/tclWinLoad.c:
-2004-08-13 Don Porter <dgp@users.sourceforge.net>
+2010-03-31 Donal K. Fellows <dkf@users.sf.net>
- * library/msgcat/msgcat.tcl: Added checks to prevent [mclocale]
- * tests/msgcat.test: from registering filesystem paths to possibly
- malicious code to be evaluated by a later [mcload].
+ * doc/registry.n: Added missing documentation of TIP#362 flags.
-2004-08-10 Zoran Vasiljevic <vasiljevic@users.sf.net>
+ * doc/package.n: [Bug 2980210]: Document the arguments taken by
+ the [package present] command correctly.
- * unix/tclUnixThrd.c (TclpThreadCreate): changed handling of
- the returned thread ID since broken on 64-bit systems (Cray).
- Thanks to Rob Ratcliff for reporting the bug.
+ * doc/Thread.3: Added some better documentation of how to create and
+ use a thread using the C-level thread API, based on realization that
+ no such tutorial appeared to exist.
-2004-08-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-03-31 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclNamesp.c (MakeCachedEnsembleCommand): Initialize the
- epoch field cached in the subcommand. [Bug 989298]
- (NsEnsembleImplementationCmd): Plug a leak (thanks to Miguel Sofer
- for spotting it with valgrind) and reduce the number of goto
- labels to make the code clearer.
+ * test/cmdMZ.test: [FRQ 2974744]: share exception codes (ObjType?):
+ * test/error.test: Revised test cases, making sure that abbreviated
+ * test/proc-old.test: codes are checked resulting in an error, and
+ checking for the exact error message.
-2004-08-02 Don Porter <dgp@users.sourceforge.net>
+2010-03-30 Andreas Kupries <andreask@activestate.com>
- * library/package.tcl (pkg_mkIndex): Updated [pkg_mkIndex] to
- make use of [glob -directory $dir -tails] and return options.
+ * generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,
+ (ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
+ (ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
+ ReflectedChannel* structures across handler invokations, to avoid
+ crashes when the handler implementation induces nested callbacks and
+ destruction of the channel deep inside such a nesting.
- TIP#207 IMPLEMENTATION
+2010-03-30 Don Porter <dgp@users.sourceforge.net>
- * doc/interp.n: Added support for a -namespace option to the
- * generic/tclBasic.c: [interp invokehidden] command. Also added an
- * generic/tclInt.h: internal routine TclObjInvokeNamespace() and
- * generic/tclInterp.c: corrected the flag names TCL_FIND_ONLY_NS and
- * generic/tclNamesp.c: TCL_CREATE_NS_IF_UNKNOWN that are passed to the
- * generic/tclTrace.c: internal routine TclGetNamespaceForQualName().
- * tests/interp.test: [Patch 981841]
+ * generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2979402]: Reorder
+ the validity tests on internal rep of a "cmdName" value to avoid
+ invalid reads reported by valgrind.
- * generic/tclLiteral.c (TclCleanupLiteralTable): Corrected
- * tests/compile.test (compile-12.4): flawed deletion of literal
- internal reps that could lead to accessing of freed memory.
- Thanks to Kevin Kenny for test case and fix [Bug 1001997].
+2010-03-30 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-30 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclIndexObj: [FRQ 2974744]: share exception codes
+ * generic/tclResult.c: further optimization, making use of indexType.
+ * generic/tclZlib.c: [Bug 2979399]: uninitialized value troubles
- * tests/safe.test (safe-2.1): Disabled senseless test. [Bug 999612]
+2010-03-30 Donal K. Fellows <dkf@users.sf.net>
- * library/auto.tcl (auto_reset): Removed "protected" list of commands
- from [auto_reset]. All entries in the auto_index can be re-loaded.
- * library/package.tcl: Updated comment to reflect 2004-07-28 commit.
+ TIP #362 IMPLEMENTATION
- * generic/tclEvent.c (Tcl_Finalize): Re-organized Tcl_Finalize
- so that Tcl_ExitProc's that call Tcl_Finalize recursively do not
- cause deadlock. [Patch 999084 fixes Tk Bug 714956]
+ * win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to
+ * tests/registry.test: allow the registry command to be told to work
+ * win/Makefile.in: with both 32-bit and 64-bit registries. Bump
+ * win/configure.in: version of registry package to 1.3.
+ * win/makefile.bc:
+ * win/makefile.vc:
+ * win/configure: autoconf-2.59
-2004-07-30 Daniel Steffen <das@users.sourceforge.net>
+2010-03-29 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure:
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Darwin: instead of setting PLAT_OBJS
- to explict object files in tcl.m4, refer to MAC_OSX_OBJS makefile var.
- * unix/Makefile.in: added MAC_OSX_OBJS variable.
+ * unix/tcl.m4: Only test for -visibility=hidden with gcc
+ (Second remark in [Bug 2976508])
+ * unix/configure: regen
+
+2010-03-29 Don Porter <dgp@users.sourceforge.net>
-2004-07-29 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclStringObj.c: Fix array overrun in test format-1.12
+ caught by valgrind testing.
- * library/package.tcl: [::pkg::create] is now an alias. Test
- safe-2.1 will now fail until Bug 999612 is corrected.
+2010-03-27 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-28 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclInt.h: [FRQ 2974744]: share exception codes
+ * generic/tclResult.c: (ObjType?)
+ * generic/tclCmdMZ.c:
+ * generic/tclCompCmdsSZ.c:
- * library/package.tcl: Moved private command
- * library/tclIndex: [pkg_compareExtension] into ::tcl::Pkg.
- * tests/pkg_mkIndex.test: Also moved implementation of
- [::pkg::create] to [::tcl::Pkg::Create].
+2010-03-26 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+ * generic/tclExecute.c: [Bug 2976508]: Tcl HEAD fails on HP-UX
- * tests/io.test: Make io-61.1 create file as binary to pass on Win32
+2010-03-25 Donal K. Fellows <dkf@users.sf.net>
-2004-07-23 Miguel Sofer <msofer@users.sf.net>
+ * unix/tclUnixFCmd.c (TclUnixCopyFile): [Bug 2976504]: Corrected
+ number of arguments to fstatfs() call.
- * generic/tclVar.c: simplify tclLocalVarNameType, removing the
- reference to the corresponding proc. The reference is now seen as
- unnecessary, and it may cause leaking circular references under
- some circumstances (see for example [Bug 994838]).
+ * macosx/tclMacOSXBundle.c, macosx/tclMacOSXFCmd.c:
+ * macosx/tclMacOSXNotify.c: Reduce the level of ifdeffery in the
+ functions of these files to improve readability. They need to be
+ audited for whether complexity can be removed based on the minimum
+ supported version of OSX, but that requires a real expert.
-2004-07-22 Don Porter <dgp@users.sourceforge.net>
+2010-03-24 Don Porter <dgp@users.sourceforge.net>
- * tests/eofchar.data (removed): Test io-61.1 now generates its own
- * tests/io.test: file of test data as needed.
+ * generic/tclResult.c: [Bug 2383005]: Revise [return -errorcode] so
+ * tests/result.test: that it rejects illegal non-list values.
-2004-07-20 Jeff Hobbs <jeffh@ActiveState.com>
+2010-03-24 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclEvent.c: Correct threaded obj allocator to
- * generic/tclInt.h: fully cleanup on exit and allow for
- * generic/tclThreadAlloc.c: reinitialization. [Bug #736426]
- * unix/tclUnixThrd.c: (mistachkin, kenny)
- * win/tclWinThrd.c:
+ * generic/tclOOInfo.c (InfoObjectMethodTypeCmd)
+ (InfoClassMethodTypeCmd): Added introspection of method types so that
+ it is possible to find this info out without using errors.
+ * generic/tclOOMethod.c (procMethodType): Now that introspection can
+ reveal the name of method types, regularize the name of normal methods
+ to be the name of the definition type used to create them.
+
+ * tests/async.test (async-4.*): Reduce obscurity of these tests by
+ putting the bulk of the code for them inside the test body with the
+ help of [apply].
+
+ * generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the
+ [try] command does not trap unwinding due to limits.
+
+2010-03-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: [Bug 2973361]: Revised fix for computing
+ indices of script arguments to [try].
+
+2010-03-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCmdMZ.c: Make error message in "try" implementation
+ * generic/tclCompCmdsSZ.c: exactly the same as the one in "return"
+ * tests/error.test:
+ * libtommath/mtests/mpi.c: Single "const" addition
-2004-07-21 Kevin Kenny <kennykb@acm.org>
+2010-03-22 Don Porter <dgp@users.sourceforge.net>
- * generic/tclBasic.c (DeleteInterpProc):
- * generic/tclLiteral.c (TclCleanupLiteralTable):
- * generic/tclInt.h: added a TclCleanupLiteralTable function,
- called from DeleteInterpProc, that frees internal representations
- of shared literals early when an interpreter is being deleted.
- This change corrects a number of memory mismanagement issues in
- the cases where the internal representation of one literal
- contains a reference to another, and avoids conditions such as
- resolved variable names referring to procedure and namespace
- contexts that no longer exist. [Bug 994838]
+ * generic/tclCmdMZ.c: [Bug 2973361]: Compute the correct integer
+ values to identify the argument indices of the various script
+ arguments to [try]. Passing in -1 led to invalid memory reads.
-2004-07-20 Daniel Steffen <das@users.sourceforge.net>
+2010-03-20 Donal K. Fellows <dkf@users.sf.net>
+ * doc/exec.n: Make it a bit clearer that there is an option to run a
+ pipeline in the background.
+
+ * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Lift the restriction
+ * generic/tclIO.c (TclCopyChannel, CopyData): on the [fcopy] command
+ * generic/tclIO.h (CopyState): that forced it to only
+ copy up to 2GB per script-level callback. Now it is anything that can
+ fit in a (signed) 64-bit integer. Problem identified by Frederic
+ Bonnet on comp.lang.tcl. Note that individual low-level reads and
+ writes are still smaller as the optimal buffer size is smaller.
+
+2010-03-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/stub16.c: Don't hide that we use the ASCII API here.
+ (does someone still use that?)
+ * win/tclWinPipe.c: 2 unnecessary type casts.
+
+2010-03-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (TclCompileThrowCmd): Added compilation for
+ the [throw] command.
+
+2010-03-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c: [Bug 2971669]: Prevent in overflow trouble in
+ * generic/tclTestObj.c: ListObjReplace operations. Thanks to kbk for
+ * tests/listObj.test: fix and test.
+
+2010-03-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions):
+ [Bug 2971921]: Corrected jump so that it doesn't skip into the middle
+ of an instruction! Tightened the instruction issuing. Moved endCatch
+ calls closer to their point that they guard, ensuring correct ordering
+ of result values.
+
+2010-03-17 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORTrans.c (ReflectInput, ReflectOutput)
+ (ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
+ calls for preserved ReflectedTransform* structures. Reworked
+ ReflectInput to preserve the structure for its whole life, not only in
+ InvokeTclMethod.
+
+ * generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate topChan,
+ may have been changed by a self-modifying transformation.
+
+ * tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11)
+ (iortrans-7.4, iortrans-8.3): New test cases.
+
+2010-03-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * compat/zlib/*: Upgrade zlib to version 1.2.4.
+ * win/makefile.vc:
* unix/Makefile.in:
- * win/Makefile.in: added 'install-private-headers' makefile target
- to allow optionally installing private tcl headers. [FR 922727]
+ * win/tclWinChan.c: Don't cast away "const" without reason.
- * macosx/Makefile: use new 'install-private-headers' target
- to install private headers into framework. [FR 922727]
+2010-03-12 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclUnixFile.c (NativeMatchType): added support for
- readonly matching of user immutable files (where available).
+ * win/makefile.vc: [Bug 2967340]: Static build was failing.
+ * win/.cvsignore:
- * macosx/tclMacOSXBundle.c: dynamically acquire address for
- CFBundleOpenBundleResourceMap symbol, since it is only present in
- full CoreFoundation on Mac OS X and not in CFLite on pure Darwin.
+2010-03-10 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-19 Zoran Vasiljevic <vasiljevic@users.sf.net>
+ * generic/tclTest.c: Remove unnecessary '&' decoration for
+ * generic/tclIOUtil.c: function pointers
+ * win/tclWin32Dll.c: Double declaration of TclNativeDupInternalRep
+ * unix/tclIOUtil.c:
+ * unix/dltest/.cvsignore: Ignore *.so here
- * win/tclwinThrd.c: redefined MASTER_LOCK to call
- TclpMasterLock. Fixes Bug #987967
+2010-03-09 Andreas Kupries <andreask@activestate.com>
-2004-07-17 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux
+ * doc/refchan.n: <ferrieux@users.sourceforge.net> for debugging and
+ * tests/ioCmd.test: fixing the problem. It is the write-side
+ equivalent to the bug fixed 2009-08-06.
- * generic/tclIOUtil.c: fix to rare 'cd' infinite loop in
- normalization with vfs [Bug 991420].
- * tests/fileSystem.test: added test for above bug.
+2010-03-09 Don Porter <dgp@users.sourceforge.net>
- * doc/FileSystem.3: clarified documentation of posix error
- codes in 'remove directory' FS proc - 'EEXIST' is used to
- signify a non-empty directory error (bug reported against
- tclvfs).
+ * library/tzdata/America/Matamoros: New locale
+ * library/tzdata/America/Ojinaga: New locale
+ * library/tzdata/America/Santa_Isabel: New locale
+ * library/tzdata/America/Asuncion:
+ * library/tzdata/America/Tijuana:
+ * library/tzdata/Antarctica/Casey:
+ * library/tzdata/Antarctica/Davis:
+ * library/tzdata/Antarctica/Mawson:
+ * library/tzdata/Asia/Dhaka:
+ * library/tzdata/Pacific/Fiji:
+ Olson tzdata2010c.
+
+2010-03-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclTest.c: Test that tclOO stubs are present in stub
+ library
+ * generic/tclOOMethod.c: Applied missing part of [Patch 2961556]
+ * win/tclWinInt.h: Change all tclWinProcs signatures to use
+ * win/tclWin32Dll.c: TCHAR* in stead of WCHAR*. This is meant
+ * win/tclWinDde.c: as preparation to make [Enh 2965056]
+ * win/tclWinFCmd.c: possible at all.
+ * win/tclWinFile.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSock.c:
-2004-07-16 Jeff Hobbs <jeffh@ActiveState.com>
+2010-03-06 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/Makefile.in, unix/tcl.m4: move (C|LD)FLAGS after their
- * unix/configure.in, unix/configure: _DEFAULT to allow for env
- setting to override m4 switches. Move SC_MISSING_POSIX_HEADERS up
- and consolidate calls to limit redundancy in configure.
- (CFLAGS_WARNING): Remove -Wconversion
- (SC_ENABLE_THREADS): Set m4 to force threaded build when built
- against a threaded Tcl core.
+ * generic/tclStubLib.c: Remove presence of tclTomMathStubsPtr here.
+ * generic/tclTest.c: Test that tommath stubs are present in stub
+ library.
-2004-07-16 Andreas Kupries <andreask@activestate.com>
+2010-03-05 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Corrected a typo in the
- generation of error messages and simplified by reusing data in a
- variable instead of retrieving the string again.
- Fixes [Tcl SF Bug 835289].
+ * generic/tclIORTrans.c (ForwardProc): [Bug 2964425]: When cleaning
+ the stables, it is sometimes necessary to do more than the minimum. In
+ this case, rationalizing the variables for a forwarded limit? method
+ required removing an extra Tcl_DecrRefCount too.
- * doc/OpenFileChnl.3: Added description of the behaviour of
- Tcl_ReadChars when its 'charsToRead' argument is set to
- -1. Fixes [Tcl SF Bug 934511].
+ * generic/tclOO.h, generic/tclOOInt.h: [Patch 2961556]: Change TclOO
+ to use the same style of function typedefs as Tcl, as this is about
+ the last chance to get this right.
- * doc/CrtCommand.3: Added note that the arguments given to the
- command proc of a Tcl_CreateCommand are in utf8 since Tcl
- 8.1. Closing [Tcl SF Patch 414778].
+ ***POTENTIAL INCOMPATIBILITY***
+ Source code that uses function typedefs from TclOO will need to update
+ variables and argument definitions so that pointers to the function
+ values are used instead. Binary compatibility is not affected.
+
+ * generic/*.c, generic/tclInt.h, unix/*.c, macosx/*.c: Applied results
+ of doing a Code Audit. Principal changes:
+ * Use do { ... } while (0) in macros
+ * Avoid shadowing one local variable with another
+ * Use clearer 'foo.bar++;' instead of '++foo.bar;' where result not
+ required (i.e., semantically equivalent); clarity is increased
+ because it is bar that is incremented, not foo.
+ * Follow Engineering Manual rules on spacing and declarations
+
+2010-03-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special
+ handling so that when the class of classes is deleted, so is the class
+ of objects. Immediately.
+
+ * generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking
+ the root class. Simpler and more robust than the previous technique.
+
+2010-03-04 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclGetDate.y: 3 unnecessary MODULE_SCOPE
+ * generic/tclDate.c: symbols
+ * generic/tclStubLib.c: Split tommath stub lib
+ * generic/tclTomMathStubLib.c: in separate file.
+ * win/makefile.bc:
+ * win/Makefile.in:
+ * win/makefile.vc:
+ * win/tcl.dsp:
+ * unix/Makefile.in:
+ * unix/tcl.m4: Cygwin only gives warning
+ * unix/configure: using -fvisibility=hidden
+ * compat/strncasecmp.c: A few more const's
+ * compat/strtod.c:
+ * compat/strtoul.c:
- * doc/ChnlStack.3: Removed the declaration that the interp
- argument to Tcl_(un)StackChannel can be NULL. This fixes [Tcl SF
- Bug 881220], reported by Marco Maggi
- <marcomaggi@users.sourceforge.net>.
+2010-03-03 Andreas Kupries <andreask@activestate.com>
- * tests/socket.test: Accepted two new testcases by Stuart Casoff
- <stwo@users.sourceforge.net> checking that -server and -async
- don't go together [Tcl SF Bug 796534].
+ * doc/refchan.n: Followup to ChangeLog entry 2009-10-07
+ (generic/tclIORChan.c). Fixed the documentation to explain that errno
+ numbers are operating system dependent, and reworked the associated
+ example.
- * unix/tclUnixNotfy.c (NotifierThreadProc): Accepted Joe
- Mistachkin's patch for [Tcl SF Bug 990500], properly closing the
- notifier thread when its exits.
+2010-03-02 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-15 Andreas Kupries <andreask@activestate.com>
+ * unix/tcl.m4: [FRQ 2959069]: Support for -fvisibility=hidden
+ * unix/configure (regenerated with autoconf-2.59)
- * unix/tclUnixThrd.c (TclpFinalizeMutex): Accepted Joe
- Mistachkin's patch for [Tcl SF Bug 990453], closing leakage of
- mutexes. They were not destroyed properly upon finalization.
+2010-03-01 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-07-15 Andreas Kupries <andreask@activestate.com>
+ * unix/tclUnixSock.c: Refrain from a possibly lengthy reverse-DNS
+ lookup on 0.0.0.0 when calling [fconfigure -sockname] on an
+ universally-bound (default) server socket.
- * generic/tclIO.h (CHANNEL_INCLOSE): New flag. Set in
- * generic/tclIO.c (Tcl_UnregisterChannel): 'Tcl_Close' while the
- * generic/tclIO.c (Tcl_Close): close callbacks are
- run. Checked in 'Tcl_Close' and 'Tcl_Unregister' to prevent
- recursive call of 'close' in the close-callbacks. This is a
- possible error made by implementors of virtual filesystems based
- on 'tclvfs', thinking that they have to close the channel in the
- close handler for the filesystem.
+ * generic/tclIndexObj.c: fix [AT 86258]: special-casing of empty
+ tables when generating error messages for [::tcl::prefix match].
-2004-07-14 Andreas Kupries <andreask@activestate.com>
+2010-02-28 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclIO.c:
- * generic/tclIO.h:
- * Not reverting, but #ifdef'ing the changes from May 19, 2004 out
- of the core. This removes the ***POTENTIAL INCOMPATIBILITY***
- for channel drivers it introduced. This has become possible due
- to Expect gaining a BlockModeProc and now handling blockingg and
- non-blocking modes correctly. Thus [SF Tcl Bug 943274] is still
- fixed if a recent enough version of Expect is used.
+ * generic/tclCmdIL.c: More additions of {TCL LOOKUP} error-code
+ generation to various subcommands of [info] as part of long-term
+ project to classify all Tcl's generated errors.
- * doc/CrtChannel.3: Added warning about usage of a channel without
- a BlockModeProc.
+2010-02-28 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-15 Andreas Kupries <andreask@pliers.activestate.com>
+ * generic/tclStubInit.c: [Bug 2959713]: Link error with gcc 4.1
- * generic/tclIOCmd.c (Tcl_PutsObjCmd): Added length check to the
- old depreceated newline syntax, to ensure that only "nonewline"
- is accepted. [Tcl SF Bug 985869], reported by Joe Mistachkin
- <mistachkin@users.sourceforge.net>.
+2010-02-27 Donal K. Fellows <dkf@users.sf.net>
-2004-07-15 Zoran Vasiljevic <vasiljevic@users.sf.net>
+ * generic/tclCmdMZ.c (StringFirstCmd, StringLastCmd): [Bug 2960021]:
+ Only search for the needle in the haystack when the needle isn't
+ larger than the haystack. Prevents an odd crash from sometimes
+ happening when things get mixed up (a common programming error).
- * generic/tclEvent.c (Tcl_Finalize): stuffed memory leak
- incurred by re-initializing of TSD slots after the last call to
- TclFinalizeThreadData (done from within Tcl_FinalizeThread()).
- We basically just repeat the TclFinalizeThreadData() once more
- before tearing down TSD keys in TclFinalizeSynchronization().
- There should be more elaborate mechanism in place for handling
- such issues, based on thread cleanup handlers registered on the
- OS level. Such change requires much more work and would also
- require TIP because some visible parts of Tcl API would have to
- be modified. In the meantime, this will do.
+ * generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding
+ of the client-installed main loop function into thread-specific data.
- * generic/tclNotify.c (TclFinalizeNotifier): Added conditional
- notifier finalization based on the fact that an TclInitNotifier
- has been called for the current thread. This fixes the Tcl
- Bug #770053 again. Hopefully this time w/o unwanted side-effects.
+ ***POTENTIAL INCOMPATIBILITY***
+ Code that previously tried to set the main loop from another thread
+ will now fail. On the other hand, there is a fairly high probability
+ that such programs would have been failing before due to the lack of
+ any kind of inter-thread memory barriers guarding accesses to this
+ part of Tcl's state.
-2004-07-15 Kevin Kenny <kennykb@acm.org>
+2010-02-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclLiteral.c (TclReleaseLiteral): Removed unused
- variable 'codePtr' to silence a message from VC++.
+ * generic/tclCompCmds.c: Split this file into two pieces to make it
+ * generic/tclCompCmdsSZ.c: easier to work with. It's still two very
+ long files even after the split.
-2004-07-15 Miguel Sofer <msofer@users.sf.net>
+2010-02-26 Reinhard Max <max@suse.de>
- * generic/tclCompile.c (TclCompileScript):
- * generic/tclLiteral.c (TclReleaseLiteral): fix for [Bug 467523],
- which resurfaced with the latest changes. The previous strategy
- was to have special code in TclReleaseLiteral to handle the
- self-references generated by empty scripts. The new approach
- avoids the self-reference altogether, by having empty scripts
- return an unshared literal.
+ * doc/safe.n: Name the installed file after the command it documents.
+ Use "Safe Tcl" instead of the "Safe Base", "Safe Tcl" mixture.
-2004-07-15 Zoran Vasiljevic <vasiljevic@users.sf.net>
+2010-02-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclEvent.c (NewThreadProc): Backout of changes
- to fix the Tcl Bug #770053. See SF bugreport for more info.
+ * unix/Makefile.in (NATIVE_TCLSH): Added this variable to allow for
+ better control of what tclsh to use for various scripts when doing
+ cross compiling. An imperfect solution, but works.
-2004-07-11 Miguel Sofer <msofer@users.sf.net>
+ * unix/installManPage: Remap non-alphanumeric sequences in filenames
+ to single underscores (especially colons).
- * generic/tclBasic.c (Tcl_EvalEx): leak fix by dgp, release
- objv[objectsUsed] on error.
+2010-02-26 Pat Thoyts <patthoyts@users.sourceforge.net>
-2004-07-11 Miguel Sofer <msofer@users.sf.net>
+ * tests/zlib.test: Add tests for [Bug 2818131] which was crashing with
+ mismatched zlib algorithms used in combination with gets. This issue
+ has been fixed by Andreas's last commit.
- * generic/tclParse.c (Tcl_SubstObj): leak fix by dgp, release
- result on error.
+2010-02-25 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclHash.c: [FRQ 2958832]: Further speed-up of the
+ * generic/tclLiteral.c: ouster-hash function.
+ * generic/tclObj.c:
+ * generic/tclCkalloc.c: Eliminate various unnecessary (ClientData)
+ * generic/tclTest.c: type casts.
+ * generic/tclTestObj.c:
+ * generic/tclTestProcBodyObj.c:
+ * unix/tclUnixTest.c:
+ * unix/tclUnixTime.c:
+ * unix/tclXtTest.c:
- * generic/tclNamesp.c (BuildEnsembleConfig): Don't forget to clean
- out references when deleting the hash table.
- * generic/tclDictObj.c (Tcl_DictObjRemoveKeyList): Oops, forgot to
- delete value object when removing the hash entry. [Bug 989093 in part]
+2010-02-24 Donal K. Fellows <dkf@users.sf.net>
-2004-07-11 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclDictObj.c (SetDictFromAny): Prevent the list<->dict
+ * generic/tclListObj.c (SetListFromAny): conversion code from taking
+ too many liberties. Stops loss of duplicate keys in some scenarios.
+ Many thanks to Jean-Claude Wippler for finding this.
- * generic/tclExecute.c (TEBC): fixed leak of expandNestList objs
- when there is an error while an expansion is in progress (code
- added at checkForCatch).
+ * generic/tclExecute.c (TclExecuteByteCode): Reduce ifdef-fery and
+ size of activation record. More variables shared across instructions
+ than before.
-2004-07-11 Vince Darley <vincentdarley@users.sourceforge.net>
+ * doc/socket.n: [Bug 2957688]: Clarified that [socket -server] works
+ with a command prefix. Extended example to show this in action.
- * generic/tclIOUtil.c: fix to 'cd' bug when vfs is active
- [Bug 986944 in tclvfs project] - this bug recently introduced
- by some threading fixes. Need to work out how to add
- tests for this.
+2010-02-22 Andreas Kupries <andreask@activestate.com>
-2004-07-10 Kevin Kenny <kennykb@acm.org>
+ * generic/tclZlib.c (ZlibTransformInput): [Bug 2762041]: Added a hack
+ to work around the general problem, early EOF recognition based on the
+ base-channel, instead of the data we have ready for reading in the
+ transform. Long-term we need a proper general fix (likely tracking EOF
+ on each level of the channel stack), with attendant complexity.
+ Furthermore, Z_BUF_ERROR can be ignored, and must be when feeding the
+ zlib code with single characters.
- * tests/clock.test (clock-2.11): Changed the test so that
- it isn't an infinite loop when run under valgrind on a slow
- virtual machine. Thanks to Miguel Sofer for the bug report.
- Also put in code to restore env(LC_TIME) after tests complete,
- silencing a warning from 'make TESTFLAGS="-debug 1" test'.
+2010-02-22 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-08 Miguel Sofer <msofer@users.sf.net>
+ * unix/tclUnixPort.h: Remove unnecessary EXTERN's, which already are
+ in the global stub table.
+ * unix/configure.in: Use @EXEEXT@ in stead of @EXT_SUFFIX@
+ * unix/tcl.m4:
+ * unix/Makefile.in: Use -DBUILD_tcl for CYGWIN
+ * unix/configure: (regenerated)
+ * unix/dltest/pkg*.c: Use EXTERN to control CYGWIN exported symbols
+ * generic/tclCmdMZ.c: Remove some unnecessary type casts.
+ * generic/tclCompCmds.c:
+ * generic/tclTest.c:
+ * generic/tclUtil.c:
- * generic/tclBasic.c (DeleteInterpProc): reverted the modification
- of 3 days ago, as the leak of [Bug 983660] is now handled by the
- change in TclCleanupByteCode.
- * generic/tclCompile.c (TclCleanupByteCode): let each bytecode
- remove its references to literals at interp deletion, without
- updating the dying literal table.
- * generic/tclLiteral.c (TclDeleteLiteralTable): with the above
- change to TclCleanupByteCode, this function now removes a single
- reference to the literal object and cleans up its own structures.
+2010-02-21 Mo DeJong <mdejong@users.sourceforge.net>
-2004-07-08 Kevin Kenny <kennykb@acm.org>
+ * tests/regexp.test: Add test cases back ported from Jacl regexp work.
- * win/tclWinInit.c (AppendEnvironment): Silenced a compilation
- warning about a type mismatch.
+2010-02-21 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-07 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclDate.c: Some more const tables.
+ * generic/tclGetDate.y:
+ * generic/regc_lex.c:
+ * generic/regerror.c:
+ * generic/tclStubLib.c:
+ * generic/tclBasic.c: Fix [Bug 2954959] expr abs(0.0) is -0.0
+ * tests/expr.test:
+
+2010-02-20 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCompile.c (TclCompileScript): fix for [Bug 458361].
- Single-word scripts are compiled with an unshared cmdName to avoid
- shimmering between bytecode and cmdName reps.
+ * generic/tclCompCmds.c (TclCompileStringLenCmd): Make [string length]
+ of a constant string be handled better (i.e., handle backslashes too).
-2004-07-07 Don Porter <dgp@users.sourceforge.net>
+2010-02-19 Stuart Cassoff <stwo@users.sourceforge.net>
- * generic/tclCmdMZ.c (TclMergeReturnOptions): Simplified logic and
- removed potential memory leak. [Bug 986257].
+ * tcl.m4: Correct compiler/linker flags for threaded builds on
+ OpenBSD.
+ * configure: (regenerated).
-2004-07-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-02-19 Donal K. Fellows <dkf@users.sf.net>
- * tools/man2help2.tcl (setTabs, IPmacro): Added support for the
- more advanced *roff macros used in Tk's doc/bind.n
+ * unix/installManPage: [Bug 2954638]: Correct behaviour of manual page
+ installer. Also added armouring to check that assumptions about the
+ initial state are actually valid (e.g., look for existing input file).
- * generic/tclObj.c (TclInitObjSubsystem): Declare all current
- object types.
+2010-02-17 Donal K. Fellows <dkf@users.sf.net>
-2004-07-06 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclHash.c (HashStringKey): Restore these hash functions
+ * generic/tclLiteral.c (HashString): to use the classic algorithm.
+ * generic/tclObj.c (TclHashObjKey): Community felt normal case
+ speed to be more important than resistance to malicious cases. For
+ now, hashes that need to deal with the malicious case can use a custom
+ hash table and install their own hash function, though that is not
+ functionality exposed to the script level.
- * tests/cmdMZ.test (cmdMZ-return-2.17): Added a test that a word
- containing backslash-quoted value is treated correctly.
+ * generic/tclCompCmds.c (TclCompileDictUpdateCmd): Stack depth must be
+ correctly described when compiling a body to prevent crashes in some
+ debugging modes.
- * generic/tclCompile.c (TclWordKnownAtCompileTime): [Bug 986196]
- Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs
- to have their original word value copied ( "{a b}" ) rather than the
- actual value ( "a b" ). Thanks to Kevin Kenny for report and tests.
+2010-02-16 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-06 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclInt.h: Change order of various struct members,
+ fixing potential binary incompatibility with Tcl 8.5
- * tests/cmdMZ.test (cmdMZ-return-2.15,cmdMZ-return-2.16):
- Added a test that a return code containing spaces is correctly
- returned.
+2010-02-16 Donal K. Fellows <dkf@users.sf.net>
-2004-07-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * unix/configure.in, generic/tclIOUtil.c (Tcl_Stat): Updated so that
+ we do not assume that all unix systems have the POSIX blkcnt_t type,
+ since OpenBSD apparently does not.
- * tools/man2html2.tcl (IPmacro, setTabs): Added support for the
- more advanced *roff macros used in Tk's doc/bind.n
+ * generic/tclLiteral.c (HashString): Missed updating to FNV in one
+ place; the literal table (a copy of the hash table code...)
-2004-07-05 Miguel Sofer <msofer@users.sf.net>
+2010-02-15 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclBasic.c (DeleteInterpProc): fix for [Bug 983660],
- found by pspjuth. Tear down the global namespace before freeing
- the interp handle, to allow the bytecodes to free their non-shared
- literals.
- * generic/tclLiteral.c (TclReleaseLiteral): moved special code for
- self-ref so that it is also used for non-shared literals. Possible
- bug found by inspection.
+ * tools/genStubs.tcl: Reverted earlier rename from tcl*Stubs to
+ * generic/tclBasic.c: tcl*ConstStubs, it's not necessary at all.
+ * generic/tclOO.c:
+ * generic/tclTomMathInterface.c:
+ * generic/tclStubInit.c: (regenerated)
+ * generic/tclOOStubInit.c: (regenerated)
+ * generic/tclEnsemble.c:Fix signed-unsigned mismatch
+ * win/tclWinInt.h: make tclWinProcs "const"
+ * win/tclWin32Dll.c:
+ * win/tclWinFCmd.c: Eliminate all internal Tcl_WinUtfToTChar
+ * win/tclWinFile.c: and Tcl_WinTCharToUtf calls, needed
+ * win/tclWinInit.c: for mslu support.
+ * win/tclWinLoad.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+ * win/.cvsignore:
+ * compat/unicows/readme.txt: [FRQ 2819611]: Add first part of MSLU
+ * compat/unicows/license.txt: support.
+ * compat/unicows/unicows.lib:
-2004-07-03 Miguel Sofer <msofer@users.sf.net>
+2010-02-15 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclExecute.c (ExprRoundFunc):
- * tests/expr-old.test (39.1): added support for wide integers to
- round(); [Bug 908375], reported by Hemang Lavana.
+ * generic/tclOO.c (AllocObject, SquelchedNsFirst, ObjectRenamedTrace):
+ * generic/tclNamesp.c (Tcl_DeleteNamespace): [Bug 2950259]: Revised
+ the namespace deletion code to provide an additional internal callback
+ that gets triggered early enough in namespace deletion to allow TclOO
+ destructors to run sanely. Adjusted TclOO to take advantage of this,
+ so making tearing down an object by killing its namespace appear to
+ work seamlessly, which is needed for Itcl. (Note that this is not a
+ feature that will ever be backported to 8.5, and it remains not a
+ recommended way of deleting an object.)
-2004-07-03 Miguel Sofer <msofer@users.sf.net>
+2010-02-13 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCompile.h:
- * generic/tclInt.decls:
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Divided the [switch]
+ compiler into three pieces (after the model of [try]): a parser, an
+ instruction-issuer for chained tests, and an instruction-issuer for
+ jump tables.
+
+ * generic/tclEnsemble.c: Split the ensemble engine out into its own
+ file rather than keeping it mashed together with the namespace code.
+
+2010-02-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tcl.m4: Use -pipe for gcc on win32
+ * win/configure: (mingw/cygwin) (regenerated)
+ * win/.cvsignore: Add .lib, .exp and .res here
+
+2010-02-11 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/list.test: Add tests for explicit \0 in a string argument to
+ the list command.
+
+2010-02-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIOCmd.c (Tcl_OpenObjCmd): [Bug 2949740]: Make sure that
+ we do not try to put a NULL pipeline channel into binary mode.
+
+2010-02-11 Mo DeJong <mdejong@users.sourceforge.net>
+
+ [Bug 2826551, Patch 2948425]: Assorted regexp bugs related to -all,
+ -line and -start options and newlines.
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): If -offset is given, treat it
+ as the start of the line if the previous character was a newline. Fix
+ nasty edge case where a zero length match would not advance the index.
+ * tests/regexp.test: Add regression tests back ported from Jacl.
+ Checks for a number of issues related to -line and newline handling. A
+ few of tests were broken before the patch and continue to be broken,
+ marked as knownBug.
+
+2010-02-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (ObjectRenamedTrace): [Bug 2949397]: Prevent
+ destructors from running on the two core class objects when the whole
+ interpreter is being destroyed.
+
+2010-02-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileTryCmd, IssueTryInstructions)
+ (IssueTryFinallyInstructions): Added compiler for the [try] command.
+ It is split into three pieces that handle the parsing of the tokens,
+ the issuing of instructions for finally-free [try], and the issuing of
+ instructions for [try] with finally; there are enough differences
+ between the all cases that it was easier to split the code rather than
+ have a single function do the whole thing.
+
+2010-02-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * tools/genStubs.tcl: Remove dependency on 8.5+ idiom "in" in
+ expressions.
+
+2010-02-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclZlib.c (Tcl_ZlibDeflate, Tcl_ZlibInflate): [Bug 2947783]:
+ Make sure that the result is an unshared object before appending to it
+ so that nothing crashes if it is shared (use in Tcl code was not
+ affected by this, but use from C was an issue).
+
+2010-02-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclHash.c (HashStringKey): Replace Tcl's crusty old hash
+ * generic/tclObj.c (TclHashObjKey): function with the algorithm
+ due to Fowler, Noll and Vo. This is slightly faster (assuming the
+ presence of hardware multiply) and has somewhat better distribution
+ properties of the resulting hash values. Note that we only ever used
+ the 32-bit version of the FNV algorithm; Tcl's core hash engine
+ assumes that hash values are simple unsigned ints.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Code that depends on hash iteration order (especially tests) may well
+ be disrupted by this. Where a definite order is required, the fix is
+ usually to just sort the results after extracting them from the hash.
+ Where this is insufficient, the code that has ceased working was
+ always wrong and was only working by chance.
+
+2010-02-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileErrorCmd): Added compilation of the
+ [error] command. No new bytecodes.
+
+2010-02-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Follow-up to earlier commit today:
+ Eliminate the need for an extra Stubs Pointer for adressing
+ a static stub table: Just change the exported table from
+ static to MODULE_SCOPE.
+ * generic/tclBasic.c
+ * generic/tclOO.c
+ * generic/tclTomMathInterface.c
+ * generic/tcl*Decls.h (regenerated)
+ * generic/tclStubInit.c (regenerated)
+ * generic/tclOOStubInit.c (regenerated)
+ * generic/tclTest.c (minor formatting)
+
+2010-02-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c: More consistency in errorcode generation.
+
+ * generic/tclOOBasic.c (TclOO_Object_Destroy): Rewrote to be NRE-aware
+ when calling destructors. Note that there is no guarantee that
+ destructors will always be called in an NRE context; that's a feature
+ of the 'destroy' method only.
+
+ * generic/tclEncoding.c: Add 'const' to many function-internal vars
+ that are never pointing to things that are written to.
+
+2010-02-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Follow-up to [2010-01-29] commit:
+ prevent space within stub table function parameters if the
+ parameter type is a pointer.
+ * win/tclWinInt.h: Minor Formatting
+ * generic/tcl.h: VOID -> void and other formatting
+ * generic/tclInt.h: Minor formatting
+ * generic/tclInt.decls: Change signature of TclNRInterpProcCore,
+ * generic/tclOO.decls: and TclOONewProc(Instance|)MethodEx,
+ * generic/tclProc.c: indicating that errorProc is a function,
+ * generic/tclOOMethod.c:pointer, and other formatting
+ * generic/tcl*Decls.h: (regenerated)
+ * generic/tclVar.c: gcc warning(line 3703): 'pattern' may be used
+ uninitialized in this function
+ gcc warning(line 3788): 'matched' may be used
+ uninitialized in this function
+
+2010-02-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c: Added more use of error-codes and reduced the
+ stack overhead of older interfaces.
+ (ArrayGetCmd): Stop silly crash when using a trivial pattern due to
+ error in conversion to ensemble.
+ (ArrayNamesCmd): Use the object RE interface for faster matching.
+
+2010-02-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c (ArrayUnsetCmd): More corrections.
+
+2010-02-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c: Turned the [array] command into a true ensemble.
+
+ * generic/tclOO.c (AllocObject, MyDeleted): A slightly faster way to
+ handle the deletion of [my] is with a standard delete callback. This
+ is because it doesn't require an additional memory allocation during
+ object creation. Also reduced the amount of string manipulation
+ performed during object creation to further streamline memory
+ handling; this is not backported to the 8.5 package as it breaks a
+ number of abstractions.
+
+ * generic/tclOOBasic.c (TclOO_Object_Destroy): [Bug 2944404]: Do not
+ crash when a destructor deletes the object that is executing that
+ destructor.
+
+2010-02-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c (Tcl_ArrayObjCmd): [Bug 2939073]: Stop the [array
+ unset] command from having dangling pointer problems when an unset
+ trace deletes the element that is going to be processed next. Many
+ thanks to Alexandre Ferrieux for the bulk of this fix.
+
+ * generic/regexec.c (ccondissect, crevdissect): [Bug 2942697]: Rework
+ these functions so that certain pathological patterns are matched much
+ more rapidly. Many thanks to Tom Lane for dianosing this issue and
+ providing an initial patch.
+
+2010-01-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompile.c (tclInstructionTable): Bytecode instructions
+ * generic/tclCompCmds.c (TclCompileUnsetCmd): to allow the [unset]
+ * generic/tclExecute.c (TclExecuteByteCode): command to be compiled
+ with the compiler being a complete compilation for all compile-time
+ decidable uses.
+
+ * generic/tclVar.c (TclPtrUnsetVar): Var reference version of the code
+ to unset a variable. Required for INST_UNSET bytecodes.
+
+2010-01-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change
+ Changed some Tcl_CallFrame fields from "char *"
+ to "void *". This saves unnecessary space on
+ Cray's (and it's simply more correct).
+
+ * tools/genStubs.tcl: No longer generate a space after "*" and
+ immediately after a function name, so the
+ format of function definitions in tcl*Decls.h
+ match all other tcl*.h header files.
+ * doc/ParseArgs.3: Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
+ * generic/tcl.h: and GetFrameInfoValueProc to be function
+ * generic/tclInt.h: definitions, not pointers, for consistency
+ * generic/tclOOInt.h: with all other Tcl function definitions.
+ * generic/tclIndexObj.c:
+ * generic/regguts.h: CONST -> const
+ * generic/tcl.decls: Formatting
+ * generic/tclTomMath.decls: Formatting
+ * generic/tclDecls.h: (regenerated)
* generic/tclIntDecls.h:
- * generic/tclStubInit.c: Moved declaration of TclCompEvalObj()
- from tclCompile.h to the internal stubs table, for compiler
- experimentation.
+ * generic/tclIntPlatDecls.h:
+ * generic/tclOODecls.h:
+ * generic/tclOOIntDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclTomMathDecls.h:
+
+2010-01-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOBasic.c (TclOO_Object_Destroy): Move the execution of
+ destructors to a point where they can produce an error. This will not
+ work for all destructors, but it does mean that more failing calls of
+ them will be caught.
+ * generic/tclOO.c (AllocObject, MyDeletedTrace, ObjectRenamedTrace):
+ (ObjectNamespaceDeleted): Stop various ways of getting at commands
+ with dangling pointers to the object. Also increases the reliability
+ of calling of destructors (though most destructors won't benefit; when
+ an object is deleted namespace-first, its destructors are not run in a
+ nice state as the namespace is partially gone).
+
+2010-01-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclOOStubInit.c: Remove double includes (which causes a
+ * generic/tclOOStubLib.c: warning in CYGWIN compiles)
+ * unix/.cvsignore: add confdefs.h
-2004-07-02 Jeff Hobbs <jeffh@ActiveState.com>
+2010-01-22 Donal K. Fellows <dkf@users.sf.net>
- * generic/regcomp.c (stid): correct minor pointer size error
+ * doc/proc.n: [Bug 1970629]: Define a bit better what the current
+ namespace of a procedure is.
- * generic/tclPipe.c (TclCreatePipeline): applied TIP #202 patch
- * doc/exec.n, tests/exec.test: that adds 2>@1 as a
- special case redirection of stderr to the result output.
+2010-01-22 Jan Nijtmans <nijtmans@users.sf.net>
-2004-07-02 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclInt.decls: Don't use DWORD and HANDLE here.
+ * generic/tclIntPlatDecls.h:
+ * generic/tcl.h: Revert [2009-12-21] change, instead
+ * generic/tclPort.h: resolve the CYGWIN inclusion problems by
+ * win/tclWinPort.h: re-arranging the inclusions at other
+ places.
+ * win/tclWinError.c
+ * win/tclWinPipe.c
+ * win/tcl.m4: Make cygwin configuration error into
+ * win/configure.in: a warning: CYGWIN compilation works
+ * win/configure: although there still are test failures.
+
+2010-01-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Improve error code
+ generation from some of the tailcall-related bits of TEBC.
- * tests/io.test: Changed several tests to run the event
- loop rather than just calling [update] periodically, avoiding
- intermittent failures (usually in io-29.32) that stemmed from
- unreaped processes on Windows.
- * tests/winPipe.test (winpipe-1.11): Fixed a bug that caused
- test to fail if the path name of the working directory contained
- whitespace [Bug 678430]
+2010-01-21 Miguel Sofer <msofer@users.sf.net>
-2004-07-01 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
+ * generic/tclExecute.c: spoilage.
+ * tests/nre.test:
- * tests/fileSystem.test: Added test for [Bug 970529]
+2010-01-19 Donal K. Fellows <dkf@users.sf.net>
-2004-07-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict
+ update] are doing with variables.
- * win/README.binary, win/README: Updated references to Tcl and Tk
- 8.4 to point to 8.5 instead. Thanks to Theo Verelst for spotting
- this.
- * generic/tcl.h: Added note to help prevent those changes from
- getting missed in the future.
+2010-01-18 Andreas Kupries <andreask@activestate.com>
- * doc/Namespace.3, doc/load.n, doc/Limit.3: Typo fixes and remove
- duplicate documentation. [Bug 983146]
+ * generic/tclIO.c (CreateScriptRecord): [Bug 2918110]: Initialize
+ the EventScriptRecord (esPtr) fully before handing it to
+ Tcl_CreateChannelHandler for registration. Otherwise a reflected
+ channel calling 'chan postevent' (== Tcl_NotifyChannel) in its
+ 'watchProc' will cause the function 'TclChannelEventScriptInvoker'
+ to be run on an uninitialized structure.
-2004-06-30 Don Porter <dgp@users.sourceforge.net>
+2010-01-18 Donal K. Fellows <dkf@users.sf.net>
- * tests/fileSystem.test: Minor correction to new fileSystem-9.X
- tests so that they clean up temporary directories correctly.
+ * generic/tclStringObj.c (Tcl_AppendFormatToObj): [Bug 2932421]: Stop
+ the [format] command from causing argument objects to change their
+ internal representation when not needed. Thanks to Alexandre Ferrieux
+ for this fix.
-2004-06-30 Vince Darley <vincentdarley@users.sourceforge.net>
+2010-01-13 Donal K. Fellows <dkf@users.sf.net>
- * doc/filename.n: clarified behaviour concerning trailing
- slashes in filenames [Bug 971976]
+ * tools/tcltk-man2html.tcl: More factoring out of special cases
+ * tools/tcltk-man2html-utils.tcl: so that they are described outside
+ the engine file. Now there is only one real set of special cases in
+ there, to handle the .SO/.OP/.SE directives.
+2010-01-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: Fix TCL_LL_MODIFIER for Cygwin
+ * generic/tclEnv.c: Fix CYGWIN compilation problems,
+ * generic/tclInt.h: and remove some unnecessary
+ * generic/tclPort.h: double includes.
+ * generic/tclPlatDecls.h:
+ * win/cat.c:
+ * win/tclWinConsole.c:
+ * win/tclWinFCmd.c:
* win/tclWinFile.c:
- * tests/fileSystem.test: fix and tests for [Bug 979879]
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+ * win/tclWinThrd.c:
+ * win/tclWinPort.h: Put win32 includes first
+ * unix/tclUnixChan.c: Forgot one CONST change
-2004-06-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-01-12 Donal K. Fellows <dkf@users.sf.net>
- TIP#188 IMPLEMENTATION
+ * tools/tcltk-man2html.tcl: Make the generation of the list of things
+ to process the docs from simpler and more flexible. Also factored out
+ the lists of special cases.
- * doc/string.n, tests/string.test: Add 'wideinteger' to things
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): that can be tested for with
- the [string is] subcommand. [Patch 940915, by Kevin Kenny]
+2010-01-10 Jan Nijtmans <nijtmans@users.sf.net>
-2004-06-29 Don Porter <dgp@users.sourceforge.net>
+ * win/tclWinDde.c: VC++ 6.0 doesn't have
+ * win/tclWinReg.c: PDWORD_PTR
+ * win/tclWinThrd.c: Fix various minor gcc warnings.
+ * win/tclWinTime.c:
+ * win/tclWinConsole.c: Put channel type definitions
+ * win/tclWinChan.c: in static const memory
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+ * generic/tclIOGT.c:
+ * generic/tclIORChan.c:
+ * generic/tclIORTrans.c:
+ * unix/tclUnixChan.c:
+ * unix/tclUnixPipe.c:
+ * unix/tclUnixSock.c:
+ * unix/configure: (regenerated with autoconf 2.59)
+ * tests/info.test: Make test independant from
+ tcltest implementation.
- * win/tclWinInit.c: Corrected reference counting flaw in
- recent changes. Thanks to Pat Thoyts. [Bug 981893].
+2010-01-10 Donal K. Fellows <dkf@users.sf.net>
-2004-06-29 Vince Darley <vincentdarley@users.sourceforge.net>
+ * tests/namespace.test (namespace-51.17): [Bug 2898722]: Demonstrate
+ that there are still bugs in the handling of resolution epochs. This
+ bug is not yet fixed.
- * win/tclWin32Dll.c: fix to compilation with VC++ 5.2
+ * tools/tcltk-man2html.tcl: Split the man->html converter into
+ * tools/tcltk-man2html-utils.tcl: two pieces for easier maintenance.
+ Also made it much less verbose in its printed messages by default.
-2004-06-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-01-09 Donal K. Fellows <dkf@users.sf.net>
- * library/safe.tcl: Make sure that the temporary variable is
- local to the namespace and not inadvertently global. [Bug 981733]
+ * tools/tcltk-man2html.tcl: Added basic support for building the docs
+ for contributed packages into the HTML versions. Prompted by question
+ on Tcler's Chat by Tom Krehbiel. Note that there remain problems in
+ the documentation generated due to errors in the contributed docs.
-2004-06-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2010-01-05 Don Porter <dgp@users.sourceforge.net>
- * tests/unixNotfy.test: Modified constraints so that testing with
- a threaded tclsh (not tcltest) will not hang.
+ * generic/tclPathObj.c (TclPathPart): [Bug 2918610]: Correct
+ * tests/fileName.test (filename-14.31): inconsistency between the
+ string rep and the intrep of a path value created by [file rootname].
+ Thanks to Vitaly Magerya for reporting.
-2004-06-23 Don Porter <dgp@users.sourceforge.net>
+2010-01-03 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclThreadStorage.c: Corrected type casting errors that led
- to calculation of a negative index value, thus accesses outside the
- threadStorageCache array, thus memory corruption. Crash observed on
- Mac OS X platform.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 1636685]: Use the configuration
+ for modern FreeBSD suggested by the FreeBSD porter.
-2004-06-23 Joe Mistachkin <joe@mistachkin.com>
+2010-01-03 Miguel Sofer <msofer@users.sf.net>
- * generic/tclThread.c: Implements platform independent thread storage
- * generic/tclThreadStorage.c: mechanism and fixes associated bugs on
- platforms where there is limited thread local storage space
- (Win98/WinNT4). [Patch 976496]
+ * generic/tclBasic.c: [Bug 2724403]: Fix leak of coroutines on
+ * generic/tclCompile.h: namespace deletion. Added a test for this
+ * generic/tclNamesp.c: leak, and also a test for leaks on namespace
+ * tests/coroutine.test: deletion.
+ * tests/namespace.test:
- * generic/tclInt.decls:
- * generic/tclIntDecls.h: Added thread storage functions to the
- * generic/tclStubInit.c: internal stubs table.
+2009-12-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer
+ * tests/safe.test (safe-8.9): [source] handle a [return] at the
+ end of the file correctly.
+
+2009-12-30 Miguel Sofer <msofer@users.sf.net>
+
+ * library/init.tcl (unknown): [Bug 2824981]: Fix infinite recursion of
+ ::unknown when [set] is undefined.
+
+2009-12-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclHistory.c (Tcl_RecordAndEvalObj): Reduce the amount of
+ allocation and deallocation of memory by caching objects in the
+ interpreter assocData table.
+
+ * generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so that
+ it does not require making assignments part way through an 'if'
+ condition, which was deeply unclear.
+
+ * generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that
+ the min() and max() functions are supported in safe interpreters.
+
+2009-12-29 Pat Thoyts <patthoyts@users.sourceforge.net>
+ * generic/tclBinary.c: [Bug 2922555]: Handle completely invalid input
+ * tests/binary.test: to the decode methods.
+
+2009-12-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added
+ targets to allow easier tracing of shell and test invokations.
+
+ * unix/configure.in: [Bug 942170]: Detect the st_blocks field of
+ * generic/tclCmdAH.c (StoreStatData): 'struct stat' correctly.
+ * generic/tclFileName.c (Tcl_GetBlocksFromStat):
+ * generic/tclIOUtil.c (Tcl_Stat):
+
+ * generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that
+ * tests/interp.test (interp-34.13): the granularity ticker is
+ reset when we check limits because of the time limit event firing.
+
+2009-12-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/namespace.n (SCOPED SCRIPTS): [Bug 2921538]: Updated example to
+ not be quite so ancient.
+
+2009-12-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCmdMZ.c: CONST -> const
+ * generic/tclParse.c
+
+2009-12-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop
+ information about paths from leaking through [info script] and [info
+ nameofexecutable].
+
+2009-12-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Install libtcl8.6.dll in bin directory
* unix/Makefile.in:
- * unix/configure:
- * unix/tcl.m4:
- * win/makefile.vc:
- * win/rules.vc:
- * win/Makefile.in: Modified the unix, VC++, and Cygwin build systems
- * win/configure: to include the new "tclThreadStorage.c" and the new
- * win/tcl.m4: USE_THREAD_STORAGE define.
+ * unix/configure: (regenerated)
-2004-06-23 Pat Thoyts <patthoyts@users.sourceforge.net>
+2009-12-22 Donal K. Fellows <dkf@users.sf.net>
- * tests/io.test: Added -force to 18.1 and 18.2. This was failing
- on WinXP.
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when
+ -index and -stride are used together.
- * tests/winFCmd.test: Added a cleanup to winFCmd-16.11 to avoid a
- failure in 16.12.
+2009-12-21 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/eofchar.data: Added -kb option to ensure a binary checkout
- to win32 systems. This fixes a failure in io-61.1
+ * generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on
+ cygwin: missing initializer
+ * generic/tclOOInt.h: Prevent conflict with DUPLICATE
+ definition in WINAPI's nb30.h
+ * generic/rege_dfa.c: Fix macro conflict on CYGWIN: don't use
+ "small".
+ * generic/tcl.h: Include <winsock2.h> before <stdio.h> on
+ CYGWIN
+ * generic/tclPathObj.c
+ * generic/tclPort.h
+ * tests/env.test: Don't unset WINDIR and TERM, it has a
+ special meaning on CYGWIN (both in UNIX
+ and WIN32 mode!)
+ * generic/tclPlatDecls.h: Include <tchar.h> through tclPlatDecls.h
+ * win/tclWinPort.h: stricmp -> strcasecmp
+ * win/tclWinDde.c: _wcsicmp -> wcscasecmp
+ * win/tclWinFile.c
+ * win/tclWinPipe.c
+ * win/tclWinSock.c
+ * unix/tcl.m4: Add dynamic loading support to CYGWIN
+ * unix/configure (regenerated)
+ * unix/Makefile.in
- * win/makefile.vc: fix for bug #977369 about launching tclsh to
- generate a tclConfig.sh with the nmake build system
+2009-12-19 Miguel Sofer <msofer@users.sf.net>
-2004-06-23 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclBasic.c: [Bug 2917627]: Fix for bad cmd resolution by
+ * tests/coroutine.test: coroutines. Thanks to schelte for finding it.
- * tests/winDde.test (createChildProcess): Added a 200-ms delay
- (with the event loop live) when shutting down the test DDE server
- process, With the delay in place, nuisance failures of tests
- winDde-4.2, -6.5, and -6.6 appear to be much less frequent.
- [Bug #957449]
+2009-12-16 Donal K. Fellows <dkf@users.sf.net>
-2004-06-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * library/safe.tcl (::safe::AliasGlob): Upgrade to correctly support a
+ larger fraction of [glob] functionality, while being stricter about
+ directory management.
+
+2009-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclTest.c: Fix gcc warning: ignoring return value of
+ * unix/tclUnixNotify.c: "write", declared with attribute
+ * unix/tclUnixPipe.c: warn_unused_result.
+ * generic/tclInt.decls: CONSTify functions TclpGetUserHome and
+ * generic/tclIntDecls.h:TclSetPreInitScript (TIP #27)
+ * generic/tclInterp.c:
+ * win/tclWinFile.c:
+ * unix/tclUnixFile.c:
- * tests/*.test: Standardize use of platform constraints.
+2009-12-16 Donal K. Fellows <dkf@users.sf.net>
- * unix/tclUnixInit.c (GetStackSize, TclpCheckStackSpace):
- * unix/tclUnixThrd.c (TclpThreadGetStackSize): Added code to check
- whether the C stack is about to be exceeded, from [Patch 746378]
- by Joe Mistachkin but with substantial revisions.
+ * doc/tm.n: [Bug 1911342]: Formatting rewrite to avoid bogus crosslink
+ to the list manpage when generating HTML.
-2004-06-22 Kevin Kenny <kennykb@acm.org>
+ * library/msgcat/msgcat.tcl (Init): [Bug 2913616]: Do not use platform
+ tests that are not needed and which don't work in safe interpreters.
- * generic/tclEvent.c (NewThreadProc): Fixed broken build on
- Windows caused by missing TCL_THREAD_CREATE_RETURN.
+2009-12-14 Donal K. Fellows <dkf@users.sf.net>
- * tests/stack.test (stack-3.1): Corrected nuisance error in
- threaded builds.
+ * doc/file.n (file tempfile): [Bug 2388866]: Note that this only ever
+ creates files on the native filesystem. This is a design feature.
-2004-06-22 Zoran Vasiljevic <vasiljevic@users.sf.net>
+2009-12-13 Miguel Sofer <msofer@users.sf.net>
- * generic/tclEvent.c:
+ * generic/tclBasic.c: Release TclPopCallFrame() from its
+ * generic/tclExecute.c: tailcall-management duties
+ * generic/tclNamesp.c:
+
+ * generic/tclBasic.c: Moving TclBCArgumentRelease call from
+ * generic/tclExecute.c: TclNRTailcallObjCmd to TEBC, so that the
+ pairing of the Enter and Release calls is clearer.
+
+2009-12-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclTest.c (TestconcatobjCmd): [Bug 2895367]: Stop memory
+ leak when testing. We don't need extra noise of this sort when
+ tracking down real problems!
+
+2009-12-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclBinary.c: Fix gcc warning, using gcc-4.3.4 on cygwin
+ * generic/tclCompExpr.c:warning: array subscript has type 'char'
+ * generic/tclPkg.c:
+ * libtommath/bn_mp_read_radix.c:
+ * win/makefile.vc: [Bug 2912773]: Revert to version 1.203
+ * unix/tclUnixCompat.c: Fix gcc warning: signed and unsigned type
+ in conditional expression.
+
+2009-12-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl (long-toc, cross-reference): [FRQ 2897296]:
+ Added cross links to sections within manual pages.
+
+2009-12-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: [Bug 2806407]: Full nre-enabling of coroutines
+ * generic/tclExecute.c:
+
+ * generic/tclBasic.c: Small cleanup
+
+ * generic/tclExecute.c: Fix panic in http11.test caused by buggy
+ earlier commits in coroutine management.
+
+2009-12-10 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclObj.c (TclContinuationsEnter): [Bug 2895323]: Updated
+ comments to describe when the function can be entered for the same
+ Tcl_Obj* multiple times. This is a continuation of the 2009-11-10
+ entry where a memory leak was plugged, but where not sure if that was
+ just a band-aid to paper over some other error. It isn't, this is a
+ legal situation.
+
+2009-12-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Reducing the # of moving parts for coroutines
+ * generic/tclExecute.c: by delegating more to tebc; eliminate the
+ special coroutine CallFrame.
+
+2009-12-09 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c: [Bug 2901998]: Applied Alexandre Ferrieux's patch
+ fixing the inconsistent buffered I/O. Tcl's I/O now flushes buffered
+ output before reading, discards buffered input before writing, etc.
+
+2009-12-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Ensure right lifetime of varFrame's (objc,objv)
+ for coroutines.
+
+ * generic/tclExecute.c: Code regrouping
+
+2009-12-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c: Added some of the missing setting of errorcode
+ values.
+
+2009-12-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclStackFree): Improved panic msg.
+
+2009-12-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Partial nre-enabling of coroutines. The
+ * generic/tclExecute.c: initial call still requires its own
+ * generic/tclInt.h: instance of tebc, but on resume coros can
+ execute in the caller's tebc.
+
+ * generic/tclExecute.c (TEBC): Silence warning about pcAdjustment.
+
+2009-12-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Make the dict opcodes
+ more sparing in their use of C variables, to reduce size of TEBC
+ activiation record a little bit.
+
+2009-12-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TEBC): Grouping "slow" variables into structs,
+ to reduce register pressure and help the compiler with variable
+ allocation.
+
+2009-12-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Start cleaning the TEBC stables
* generic/tclInt.h:
- * unix/tclUnixNotfy.c:
- * unix/tclUnixThrd.c:
- * win/tclWinThrd.c: [Bug #770053]. See bug report for
- more information about what it does.
-
- * tests/unixNotfy.test: rewritten to use tcltest::threadReap
- to gracefully wait for the test thread to exit. Otherwise
- we got a race condition with main thread exiting before the
- test thread. This exposed the long-standing Tcl lib issue
- with resource garbage-collection on application exit.
-
-2004-06-21 Mo DeJong <mdejong@users.sourceforge.net>
-
- * win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler,
- TclpCheckStackSpace, _except_checkstackspace_handler,
- TclWinCPUID, _except_TclWinCPUID_detach_handler):
- * win/tclWinChan.c (Tcl_MakeFileChannel,
- _except_makefilechannel_handler):
- * win/tclWinFCmd.c (DoRenameFile,
- _except_dorenamefile_handler, DoCopyFile,
- _except_docopyfile_handler):
- Rework pushing of exception handler function pointer
- so that compiling with gcc -O3 works. Remove empty
- function call to avoid compiler warning. Mark the
- DllMain function as noinline to avoid compiler
- error from duplicated asm labels in generated code.
-
-2004-06-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclThreadAlloc.c (Ptr2Block): Rewrote so as to maximize
- the chance of detecting and reporting a memory inconsistency without
- relying on things being consistent. [Bug 975895]
-
-2004-06-18 Don Porter <dgp@users.sourceforge.net>
-
- * tests/load.test: Relaxed strictness of error message matching
- for test load-2.3 so that it will pass on Mac OSX.
-
- * generic/tclEncoding.c: Static TclFindEncodings -> FindEncodings.
- * generic/tclInt.h: Updated TclpFindExecutable() so that failed
- * generic/tclUtil.c: attempts to find the executable are saved
- * unix/tclUnixFile.c: just as successful finds are. [Patch 966053]
- * unix/tclUnixTest.c:
-2004-06-18 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclCmdIL.c: [Bug 2910094]: Fix by aku
+ * tests/coroutine.test:
- * tests/winFCmd.test (winFCmd-16.12): Changed test to
- compute the target directory, so as not to fail if the
- user's HOME isn't the root.
+ * generic/tclBasic.c: Arrange for [tailcall] to be created with the
+ other builtins: was being created in a separate call, leftover from
+ pre-tip days.
-2004-06-19 Daniel Steffen <das@users.sourceforge.net>
+2009-12-07 Don Porter <dgp@users.sourceforge.net>
- * unix/tcl.m4: autoconf 2.5 fixes in Darwin section.
- * unix/configure: autoconf-2.57
+ * generic/tclStrToD.c: [Bug 2902010]: Correct conditional compile
+ directives to better detect the toolchain that needs extra work for
+ proper underflow treatment instead of merely detecting the MIPS
+ platform.
-2004-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-12-07 Miguel Sofer <msofer@users.sf.net>
- * unix/tclUnixInit.c (localeTable): Added some more locale to
- encoding mapping info from Jim Huang <jserv@kaffe.org>
+ * generic/tclBasic.c: [Patch 2910056]: Add ::tcl::unsupported::yieldTo
+ * generic/tclInt.h:
- * generic/tclInt.h (PendingObjData,TclFreeObjMacro,etc):
- * generic/tclObj.c (TclFreeObj): Added scheme for making TclFreeObj()
- avoid blowing up the C stack when freeing up very large object
- trees. [Bug 886231]
+2009-12-07 Donal K. Fellows <dkf@users.sf.net>
- * win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and
- add comments.
+ * generic/tclCmdMZ.c (TryPostBody): [Bug 2910044]: Close off memory
+ leak in [try] when a variable-free handler clause is present.
-2004-06-17 Don Porter <dgp@users.sourceforge.net>
+2009-12-05 Miguel Sofer <msofer@users.sf.net>
- * generic/tclObj.c: Added missing space in panic message.
+ * generic/tclBasic.c: Small changes for clarity in tailcall
+ * generic/tclExecute.c: and coroutine code.
+ * tests/coroutine.test:
- * win/tclWinInit.c: Inform [tclInit] about the default library
- directory via the ::tclDefaultLibrary variable. This should correct
- a problem with my 2004-06-11 commit. Better solutions still in the
- works. Thanks to Joe Mistachkin for pointing out the breakage.
+ * tests/tailcall.test: Remove some old unused crud; improved the
+ stack depth tests.
-2004-06-16 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c: Fixed things so that you can tailcall
+ * generic/tclNamesp.c: properly out of a coroutine.
+ * tests/tailcall.test:
- * doc/library.n: Moved variables ::auto_oldpath and
- * library/auto.tcl: ::unknown_pending into ::tcl namespace.
- * library/init.tcl: [Bugs 808319, 948794]
+ * generic/tclInterp.c: Fixed tailcalls for same-interp aliases (no
+ test)
-2004-06-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-12-03 Donal K. Fellows <dkf@users.sf.net>
- * doc/binary.n: Added some notes to the documentation of the 'a'
- format to address the point raised in [RFE 768852].
+ * library/safe.tcl (::safe::AliasEncoding): Make the safe encoding
+ command behave more closely like the unsafe one (for safe ops).
+ (::safe::AliasGlob): [Bug 2906841]: Clamp down on evil use of [glob]
+ in safe interpreters.
+ * tests/safe.test: Rewrite to use tcltest2 better.
-2004-06-15 Jeff Hobbs <jeffh@ActiveState.com>
+2009-12-02 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclConfig.sh.in (TCL_EXTRA_CFLAGS): set to @CFLAGS@, which
- is the configure-time CFLAGS. Addendum to m4 change on 2004-05-26.
+ * tools/genStubs.tcl: Add support for win32 CALLBACK functions and
+ remove obsolete "emitStubs" and "genStubs" functions.
+ * win/Makefile.in: Use tcltest86.dll for all tests, and add
+ .PHONY rules to preemptively stop trouble that plagued Tk from hitting
+ Tcl too.
-2004-06-14 Kevin Kenny <kennykb@acm.org>
+2009-11-30 Jan Nijtmans <nijtmans@users.sf.net>
- * win/Makefile.in: Corrected compilation flags for tclPkgConfig.c
- so that it doesn't require Stubs.
- * generic/tclBasic.c (Tcl_CreateInterp): Removed comment stating
- that TclInitEmbeddedConfigurationInformation needs Stubs; with the
- change above, the comment is now erroneous.
+ * generic/tcl.h: Don't use EXPORT for Tcl_InitStubs
+ * win/Makefile.in: Better dependancies in case of static build.
-2004-06-11 Don Porter <dgp@users.sourceforge.net>
+2009-11-30 Donal K. Fellows <dkf@users.sf.net>
- * doc/Encoding.3: Removed bogus claims about tcl_libPath.
+ * doc/Tcl.n: [Bug 2901433]: Improved description of expansion to
+ mention that it is using list syntax.
- * generic/tclInterp.c (Tcl_Init): Stopped setting the
- tcl_libPath variable. [tclInit] can get all its directories
- without it.
+2009-11-27 Kevin B. Kenny <kennykb@acm.org>
- * tests/unixInit.test: Modified test code that made use of
- tcl_libPath variable.
+ * win/tclAppInit.c (Tcl_AppInit): [Bug 2902965]: Reverted Jan's change
+ that added a call to Tcl_InitStubs. The 'tclsh' and 'tcltest' programs
+ are providers, not consumers of the Stubs table, and should not link
+ with the Stubs library, but only with the main Tcl library. (In any
+ case, the presence of Tcl_InitStubs broke the build.)
- * unix/tclUnixInit.c: Stopped setting the tclDefaultLibrary variable,
- execept on the Mac OS X platform with HAVE_CFBUNDLE. In that
- configuration we should seek some way to make use of the TIP 59
- facilities and get rid of that usage of tclDefaultLibrary as well.
+2009-11-27 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInterp.c: Updated [tclInit] to make $env(TCL_LIBRARY) an
- absolute path, and to include the scriptdir,runtime configuration value
- on the search path for init.tcl.
+ * doc/BoolObj.3, doc/Class.3, doc/CrtChannel.3, doc/DictObj.3:
+ * doc/DoubleObj.3, doc/Ensemble.3, doc/Environment.3:
+ * doc/FileSystem.3, doc/Hash.3, doc/IntObj.3, doc/Limit.3:
+ * doc/Method.3, doc/NRE.3, doc/ObjectType.3, doc/PkgRequire.3:
+ * doc/SetChanErr.3, doc/SetResult.3: [Patch 2903921]: Many small
+ spelling fixes from Larry Virden.
- * unix/tclUnixInit.c: The routines Tcl_Init() and TclSourceRCFile()
- * win/tclWinInit.c: had identical implementations for both win and
- * generic/tclInterp.c: unix. Moved to a single generic implementation.
- * generic/tclMain.c:
- * library/init.tcl:
- * generic/tclInitScript.h (removed):
- * unix/Makefile.in:
- * win/tcl.dsp:
+ BUMP VERSION OF TCLOO TO 0.6.2. Too many people need accumulated small
+ versions and bugfixes, so the version-bump removes confusion.
- * unix/configure.in: Updated TCL_PACKAGE_PATH value to
- * win/configure.in: handle --libdir configuration.
+ * generic/tclOOBasic.c (TclOO_Object_LinkVar): [Bug 2903811]: Remove
+ unneeded restrictions on who can usefully call this method.
- * unix/configure.in: autoconf-2.57
- * win/configure.in:
+2009-11-26 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclBasic.c (Tcl_CreateInterp): Moved call to
- TclInitEmbeddedConfigurationInformation() earlier in
- Tcl_CreateInterp() so that other parts of interp creation
- and initialization may access and use the config values.
+ * unix/Makefile.in: Add .PHONY rules and documentation to preemptively
+ stop trouble that plagued Tk from hitting Tcl too, and to make the
+ overall makefile easier to understand. Some reorganization too to move
+ related rules closer together.
-2004-06-11 Kevin Kenny <kennykb@acm.org>
+2009-11-26 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclAppInit.c: Restored the 'setargv' procedure when
- compiling with mingw. Apparently, the command line parsing in
- mingw doesn't work as well as that in vc++, and the result was
- (1) that winPipe-8.19 failed, and (2) that 'make test' would
- work at all only with TESTFLAGS='-singleproc 1'. [Bug 967195]
+ * win/Makefile.in: [Bug 2902965]: Fix stub related changes that
+ * win/makefile.vc: caused tclkit build to break.
+ * win/tclAppInit.c
+ * unix/tcl.m4
+ * unix/Makefile.in
+ * unix/tclAppInit.c
+ * unix/configure: (regenerated)
-2004-06-10 Zoran Vasiljevic <vasiljevic@users.sf.net>
+2009-11-25 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclIOUtil.c: removed forceful setting of the
- private cached current working directory rep from
- within the Tcl_FSChdir(). We delegate this task to
- the Tcl_FSGetCwd() which does this task anyway.
- The relevant code is still present but disabled
- temporarily until the change proves correct. The Tcl
- test suite passes all test with the given change so
- I suppose it is good enough.
+ * win/Makefile.in: Added a 'test-tcl' rule that is identical to
+ 'test' except that it does not go spelunking in 'pkgs/'. (This rule
+ has existed in unix/Makefile.in for some time.)
-2004-06-10 Don Porter <dgp@users.sourceforge.net>
+2009-11-25 Stuart Cassoff <stwo@users.sf.net>
- * unix/tclUnixInit.c (TclpInitLibraryPath): Disabled addition of
- * win/tclWinInit.c (TclpInitLibraryPath): relative-to-executable
- directories to the library search path. A first step in reform of
- Tcl's startup process.
+ * unix/configure.in: [Patch 2892871]: Remove unneeded
+ * unix/tcl.m4: AC_STRUCT_TIMEZONE and use
+ * unix/tclConfig.h.in: AC_CHECK_MEMBERS([struct stat.st_blksize])
+ * unix/tclUnixFCmd.c: instead of AC_STRUCT_ST_BLKSIZE.
+ * unix/configure: Regenerated with autoconf-2.59.
- ***POTENTIAL INCOMPATIBILITY***
- Attempts to directly run ./tclsh or ./tcltest out of a build
- directory will either fail, or will make use of an installed
- script library in preference to the one in the source tree.
- Use `make shell` or `make runtest` instead.
+2009-11-24 Andreas Kupries <andreask@activestate.com>
- * tests/unixInit.test: Modified tests to suit above changes.
+ * library/tclIndex: Manually redone the part of tclIndex dealing with
+ safe.tcl and tm.tcl. This part passes the testsuite. Note that
+ automatic regeneration of this part is not possible because it wrongly
+ puts 'safe::Setup' on the list, and wrongly leaves out 'safe::Log'
+ which is more dynamically created than the generator expects.
- * generic/tclPathObj.c: Corrected [file tail] results when operating
- on a path produced by TclNewFSPathObj(). [Bug 970529]
+ Further note that the file "clock.tcl" is explicitly loaded by
+ "init.tcl", the first time the clock command is invoked. The relevant
+ code can be found at line 172ff, roughly, the definition of the
+ procedure 'clock'. This means none of the procedures of this file
+ belong in the tclIndex. Another indicator that automatic regeneration
+ of tclIndex is ill-advised.
-2004-06-09 Zoran Vasiljevic <vasiljevic@users.sf.net>
+2009-11-24 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclIOUtil.c: partially corrected [Bug 932314].
- Also, corrected return values of Tcl_FSChdir() to
- reflect those of the underlying platform-specific call.
- Originally, return codes were mixed with those of Tcl.
+ * generic/tclOO.c (FinalizeAlloc, Tcl_NewObjectInstance):
+ [Bug 2903011]: Make it an error to destroy an object in a constructor,
+ and also make sure that an object is not deleted twice in the error
+ case.
-2004-06-08 Miguel Sofer <msofer@users.sf.net>
+2009-11-24 Pat Thoyts <patthoyts@users.sourceforge.net>
- * generic/tclCompile.c:
- * generic/tclExecute.c: handle warning [Bug 969066]
+ * tests/fCmd.test: [Bug 2893771]: Teach [file stat] to handle locked
+ * win/tclWinFile.c: files so that [file exists] no longer lies.
-2004-06-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-11-23 Kevin Kenny <kennykb@acm.org>
- * generic/tclHash.c (RebuildTable): Move declaration of variable
- so it is only declared when it is used. [Bug 969068]
+ * tests/fCmd.test (fCmd-30.1): Changed registry location of the 'My
+ Documents' folder to the one that's correct for Windows 2000, XP,
+ Server 2003, Vista, Server 2008, and Windows 7. (See
+ http://support.microsoft.com/kb/310746)
-2004-06-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-11-23 Jan Nijtmans <nijtmans@users.sf.net>
- * doc/lsearch.n: Added correct option to example. [Bug 968219]
+ * win/tclWinDde.c: #undef STATIC_BUILD, in order to make sure
+ * win/tclWinReg.c: that Xxxxx_Init is always exported even when
+ * generic/tclTest.c: Tcl is built static (otherwise we cannot
+ create a DLL).
+ * generic/tclThreadTest.c: Make all functions static, except
+ TclThread_Init.
+ * tests/fCmd.test: Enable fCmd-30.1 when registry is available.
+ * win/tcl.m4: Fix ${SHLIB_LD_LIBS} definition, fix conflicts
+ * win/Makefile.in: Simplifications related to tcl.m4 changes.
+ * win/configure.in: Between static libraries and import library on
+ windows.
+ * win/configure: (regenerated)
+ * win/makefile.vc: Add stub library to necessary link lines.
-2004-06-05 Kevin B. Kenny <kennykb@acm.org>
+2009-11-23 Kevin B. Kenny <kennykb@acm.org>
- * generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw
- build works again.
- * generic/tclDecls.h: Changes to the tests for
- * generic/tclInt.decls: clock frequency in
- * generic/tclIntDecls.h: Tcl_WinTime
- * generic/tclIntPlatDecls.h: so that any clock frequency
- * generic/tclPlatDecls.h: is accepted provided that
- * generic/tclStubInit.c: all CPU's in the system share
- * tests/platform.test (platform-1.3): a common chip, and hence,
- * win/tclWin32Dll.c (TclWinCPUID): presumably, a common clock.
- * win/tclWinTest.c (TestwincpuidCmd) This change necessitated a
- * win/tclWinTime.c (Tcl_GetTime): small burst of assembly code
- to read CPU ID information, which was added as TclWinCPUID in the
- internal Stubs. To test this code in the common case of a
- single-processor machine, a 'testwincpuid' command was added to
- tclWinTest.c, and a test case in platform.test. Thanks to Jeff
- Godfrey and Richard Suchenwirth for reporting this bug. [Bug
- #976722]
+ * generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Further
+ machinations to get NewTestThread actually to launch the thread, not
+ just compile.
-2004-06-04 Don Porter <dgp@users.sourceforge.net>
+2009-11-22 Donal K. Fellows <dkf@users.sf.net>
- * generic/tcl.h: Restored #include <stdio.h> to tcl.h,
- rejecting the "fix" for "Bug" 945570. Tcl_FSSeek() needs the
- values of SEEK_SET, etc. and too many extensions rely on tcl.h
- providing stdio.h for them.
+ * generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Fix small
+ error in function naming which blocked a threaded test build.
-2004-06-02 Jeff Hobbs <jeffh@ActiveState.com>
+2009-11-19 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWinFile.c (TclpFindExecutable): when using
- GetModuleFileNameA (Win9x), convert from CP_ACP to WCHAR then
- convert back to utf8. Adjunct to 2004-04-07 fix.
+ * win/Makefile.in: Create tcltest86.dll as dynamic Tcltest
+ package.
+ * generic/tclTest.c: Remove extraneous prototypes, follow-up to
+ * generic/tclTestObj.c: [Bug 2883850]
+ * tests/chanio.test: Test-cases for fixed [Bug 2849797]
+ * tests/io.test:
+ * tests/safe.test: Fix safe-10.1 and safe-10.4 test cases, making
+ the wrong assumption that Tcltest is a static
+ package.
+ * generic/tclEncoding.c:[Bug 2857044]: Updated freeIntRepProc routines
+ * generic/tclVar.c: so that they set the typePtr field to NULL so
+ that the Tcl_Obj is not left in an
+ inconsistent state.
+ * unix/tcl.m4: [Patch 2883533]: tcl.m4 support for Haiku OS
+ * unix/configure: autoconf-2.59
-2004-06-02 David Gravereaux <davygrvy@pobox.com>
+2009-11-19 Don Porter <dgp@users.sourceforge.net>
- * tests/winPipe.test (winpipe-6.1): blocking set to 1 before
- closing to ensure we get an exitcode. The windows pipe channel
- driver doesn't differentiate between a blocking and non-blocking
- close just yet, but will soon. Part of [Bug 947693]
+ * unix/tclAppInit.c: [Bug 2883850, 2900542]: Repair broken build of
+ * win/tclAppInit.c: the tcltest executable.
-2004-06-02 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-11-19 Donal K. Fellows <dkf@users.sf.net>
- * doc/file.n: fix to documentation of 'file volumes' (Bug 962435)
+ * library/auto.tcl (tcl_findLibrary):
+ * library/clock.tcl (MakeUniquePrefixRegexp, MakeParseCodeFromFields)
+ (SetupTimeZone, ProcessPosixTimeZone): Restored the use of a literal
+ * library/history.tcl (HistAdd): 'then' when following a multi-
+ * library/safe.tcl (interpConfigure): line test expresssion. It's an
+ * library/tm.tcl (UnknownHandler): aid to readability then.
-2004-06-01 David Gravereaux <davygrvy@pobox.com>
+2009-11-19 Jan Nijtmans <nijtmans@users.sf.net>
- * win/makefile.vc: check for either MSDEVDIR or MSVCDIR being in
- the environment, for VC7. [Bug 942214]
+ * 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/tclIO.c (Tcl_SetChannelOption): -buffersize wasn't
- understanding hexidecimal notation nor was reporting number
- conversion errors. The behavior to silently ignore settings
- outside the acceptable range of Tcl_SetChannelBufferSize
- (<10 or >1M) is unchanged. This silent ignoring behavior
- might be up for review soon..
+2009-11-18 Jan Nijtmans <nijtmans@users.sf.net>
-2004-05-30 David Gravereaux <davygrvy@pobox.com>
+ * doc/CrtChannel.3: [Bug 2849797]: Fix channel name inconsistences
+ * generic/tclIORChan.c: as suggested by DKF.
+ * generic/tclIO.c: Minor *** POTENTIAL INCOMPATIBILITY ***
+ because Tcl_CreateChannel() and derivatives
+ now sometimes ignore their "chanName"
+ argument.
- * win/tclWinPipe.c:
- * win/tclWinPort.h: Reworked the win implementation of
- Tcl_WaitPid to support exitcodes in the 'signed short' range.
- Even though this range is non-portable, it is valid on windows.
- Detection of exception codes are now more accurate. Previously,
- an application that exited with ExitProcess((DWORD)-1); was
- improperly reported as exiting with SIGABRT.
+ * generic/tclAsync.c: Eliminate various gcc warnings (with -Wextra)
+ * generic/tclBasic.c
+ * generic/tclBinary.c
+ * generic/tclCmdAH.c
+ * generic/tclCmdIL.c
+ * generic/tclCmdMZ.c
+ * generic/tclCompile.c
+ * generic/tclDate.c
+ * generic/tclExecute.c
+ * generic/tclDictObj.c
+ * generic/tclIndexObj.c
+ * generic/tclIOCmd.c
+ * generic/tclIOUtil.c
+ * generic/tclIORTrans.c
+ * generic/tclOO.c
+ * generic/tclZlib.c
+ * generic/tclGetDate.y
+ * win/tclWinInit.c
+ * win/tclWinChan.c
+ * win/tclWinConsole.c
+ * win/tclWinNotify.c
+ * win/tclWinReg.c
+ * library/auto.tcl: Eliminate "then" keyword
+ * library/clock.tcl
+ * library/history.tcl
+ * library/safe.tcl
+ * library/tm.tcl
+ * library/http/http.tcl: Eliminate unnecessary spaces
+ * library/http1.0/http.tcl
+ * library/msgcat/msgcat.tcl
+ * library/opt/optparse.tcl
+ * library/platform/platform.tcl
+ * tools/tcltk-man2html.tcl
+ * tools/tclZIC.tcl
+ * tools/tsdPerf.c
+
+2009-11-17 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up
+ from a few days ago (2009-11-9, not in ChangeLog). It seems that
+ strchr is apparently a macro on AIX and reacts badly to pre-processor
+ directives in its arguments.
+
+2009-11-16 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclEncoding.c: [Bug 2891556]: Fix and improve test to
+ * generic/tclTest.c: detect similar manifestations in the future.
+ * tests/encoding.test: Add tcltest support for finalization.
+
+2009-11-15 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/tclWinDde.c: Avoid gcc compiler warning by explicitly casting
+ DdeCreateStringHandle argument.
+
+2009-11-12 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (CopyData): [Bug 2895565]: Dropped bogosity which
+ * tests/io.test: used the number of _written_ bytes or character to
+ update the counters for the read bytes/characters. New test io-53.11.
+ This is a forward port from the 8.5 branch.
+
+2009-11-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclClock.c (TclClockInit): Do not create [clock] support
+ commands in safe interps.
+
+2009-11-11 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/http/http.tcl (http::geturl): [Bug 2891171]: URL checking
+ too strict when using multiple question marks.
+ * tests/http.test
+ * library/http/pkgIndex.tcl: Bump to http 2.8.2
+ * unix/Makefile.in:
+ * win/Makefile.in:
-2004-05-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-11-11 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by
+ saving the errno from the first of two FlushChannel()s. Uneasy to
+ test; might need specific channel drivers. Four-hands with aku.
+
+2009-11-10 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/winFCmd.test: Cleanup directories that have been set chmod
+ 000. On Windows7 and Vista we really have no access and these were
+ getting left behind.
+ A few tests were changed to reflect the intent of the test where
+ setting a directory chmod 000 should prevent any modification. This
+ restriction was ignored on XP but is honoured on Vista
+
+2009-11-10 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: Plug another leak in TCL_EVAL_DIRECT evaluation.
+ Forward port from Tcl 8.5 branch, change by Don Porter.
+
+ * generic/tclObj.c: [Bug 2895323]: Plug memory leak in
+ TclContinuationsEnter(). Forward port from Tcl 8.5 branch, change by
+ Don Porter.
+
+2009-11-09 Stuart Cassoff <stwo@users.sf.net>
+
+ * win/README: [bug 2459744]: Removed outdated Msys + Mingw info.
+
+2009-11-09 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c (TclEvalObjEx): Moved the #280 decrement of
+ refCount for the file path out of the branch after the whole
+ conditional, closing a memory leak. Added clause on structure type to
+ prevent seg.faulting. Forward port from valgrinding the Tcl 8.5
+ branch.
+
+ * tests/info.test: Resolve ambiguous resolution of variable "res".
+ Forward port from 8.5
+
+2009-11-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/string.n (bytelength): Noted that this command is not a good
+ thing to use, and suggested a better alternatve. Also factored out the
+ description of the indices into its own section.
+
+2009-11-07 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/fCmd.test: [Bug 2891026]: Exclude tests using chmod 555
+ directories on vista and win7. The current user has access denied and
+ so cannot rename the directory without admin privileges.
+
+2009-11-06 Andreas Kupries <andreask@activestate.com>
+
+ * library/safe.tcl (::safe::Setup): Added documentation of the
+ contents of the state array. Also killed the 'InterpState' procedure
+ with its upleveled variable/upvar combination, and replaced all uses
+ with 'namespace upvar'.
+
+2009-11-05 Andreas Kupries <andreask@activestate.com>
+
+ * library/safe.tcl: A series of patches which bring the SafeBase up to
+ date with code guidelines, Tcl's features, also eliminating a number
+ of inefficiencies along the way.
+ (1) Changed all procedure names to be fully qualified.
+ (2) Moved the procedures out of the namespace eval. Kept their
+ locations. IOW, broke the namespace eval apart into small sections not
+ covering the procedure definitions.
+ (3) Reindented the code. Just lots of whitespace changes.
+ Functionality unchanged.
+ (4) Moved the multiple namespace eval's around. Command export at the
+ top, everything else (var decls, argument parsing setup) at the
+ bottom.
+ (5) Moved the argument parsing setup into a procedure called when the
+ code is loaded. Easier management of temporary data.
+ (6) Replaced several uses of 'Set' with calls to the new procedure
+ 'InterpState' and direct access to the per-slave state array.
+ (7) Replaced the remaining uses of 'Set' and others outside of the
+ path/token handling, and deleted a number of procedures related to
+ state array access which are not used any longer.
+ (8) Converted the path token system to cache normalized paths and path
+ <-> token conversions. Removed more procedures not used any longer.
+ Removed the test cases 4.3 and 4.4 from safe.test. They were testing
+ the now deleted command "InterpStateName".
+ (9) Changed the log command setup so that logging is compiled out
+ completely when disabled (default).
+ (10) Misc. cleanup. Inlined IsInterp into CheckInterp, its only user.
+ Consistent 'return -code error' for error reporting. Updated to use
+ modern features (lassign, in/ni, dicts). The latter are used to keep a
+ reverse path -> token map and quicker check of existence.
+ (11) Fixed [Bug 2854929]: Recurse into all subdirs under all TM root
+ dirs and put them on the access path.
+
+2009-11-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/Asia/Novokuznetsk: New tzdata locale for Kemerovo
+ oblast', which now keeps Novosibirsk time and not Kranoyarsk time.
+ * library/tzdata/Asia/Damascus: Syrian DST changes.
+ * library/tzdata/Asia/Hong_Kong: Hong Kong historic DST corrections.
+ Olson tzdata2009q.
+
+2009-11-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/object.n (DESCRIPTION): Substantive revision to make it clearer
+ what the fundamental semantics of an object actually are.
+
+2009-11-01 Joe Mistachkin <joe@mistachkin.com>
+
+ * doc/Cancel.3: Minor cosmetic fixes.
+ * win/makefile.vc: Make htmlhelp target work again. An extra set of
+ double quotes around the definition of the HTML help compiler tool
+ appears to be required. Previously, there was one set of double
+ quotes around the definition of the tool and one around the actual
+ invocation. This led to confusion because it was the only such tool
+ path to include double quotes around its invocation. Also, it was
+ somewhat inflexible in the event that somebody needed to override the
+ tool command to include arguments. Therefore, even though it may look
+ "wrong", there are now two double quotes on either side of the tool
+ path definition. This fixes the problem that currently prevents the
+ htmlhelp target from building and maintains flexibility in case
+ somebody needs to override it via the command line or an environment
+ variable.
+
+2009-11-01 Joe English <jenglish@users.sourceforge.net>
+
+ * doc/Eval.3, doc/Cancel.3: Move TIP#285 routines out of Eval.3 into
+ their own manpage.
+
+2009-10-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (ExprRoundFunc): [Bug 2889593]: Correctly report
+ the expected number of arguments when generating an error for round().
+
+2009-10-30 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/tcltest.test: When creating the notwritabledir we deny the
+ current user access to delete the file. We must grant this right when
+ we cleanup. Required on Windows 7 when the user does not automatically
+ have administrator rights.
+
+2009-10-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Changed the typedef for the mp_digit type
+ from:
+ typedef unsigned long mp_digit;
+ to:
+ typedef unsigned int mp_digit;
+ 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].
- * generic/tclInterp.c: Added comments describing the purposes of
- each function in the limit implementation and rewrote the names of
- some non-public functions for greater clarity of purpose.
- * doc/interp.n: Added note about what happens when a limited
- interpreter creates a slave interpreter.
- * doc/Limit.3: Added manual page for the resource limit
- subsystem's C API. [Bug 953903]
+ ***POTENTIAL INCOMPATIBILITY***
+ For 64-bit builds, callers of routines with (mp_digit) or (mp_digit *)
+ arguments *will*, and callers of routines with (mp_int *) arguments
+ *may* suffer both binary and stubs incompatibilities with Tcl releases
+ 8.5.0 - 8.5.7. Such possibilities should be checked, and if such
+ incompatibilities are present, suitable [package require] requirements
+ on the Tcl release should be put in place to keep such built code
+ [load]-ing only in Tcl interps that are compatible.
-2004-05-29 Joe English <jenglish@users.sourceforge.net>
+2009-10-29 Donal K. Fellows <dkf@users.sf.net>
- * doc/global.n, doc/interp.n, doc/lrange.n:
- Fix minor markup errors.
+ * tests/dict.test: Make variable-clean and simplify tests by utilizing
+ the fact that dictionaries have defined orders.
-2004-05-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclZlib.c (TclZlibCmd): Remove accidental C99-ism which
+ reportedly makes the AIX native compiler choke.
- * doc/*.n: Added examples to many (too many to list) more man pages.
+2009-10-29 Kevin B. Kenny <kennykb@acm.org>
-2004-05-25 Miguel Sofer <msofer@users.sf.net>
+ * library/clock.tcl (LocalizeFormat):
+ * tests/clock.test (clock-67.1):
+ [Bug 2819334]: Corrected a problem where '%%' followed by a letter in
+ a format group could expand recursively: %%R would turn into %%H:%M:%S
- * generic/tclExecute.c:
- * generic/tclVar.c: using (ptrdiff_t) instead of (int) casting to
- correct compiler warnings [Bug 961657], reported by Bob Techentin.
-
-2004-05-27 Kevin B. Kenny <kennykb@acm.org>
-
- * tests/clock.test: Added a single test for the presence of %G
- in [clock format], and conditioned out the clock-10.x series if
- they're all going to fail because of a broken strftime() call.
- [Bug 961714]
-
-2004-05-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclHash.c (CompareStringKeys): Added #ifdef to allow
- people to instruct this function to use strcmp(). [FRQ 951168]
-
- * generic/tclVar.c: Moved declarations into #if guards so they
- only happen when required.
- * unix/tclUnixPort.h: Guard declaration of strtod() so it is only
- enabled when we don't have a declaration in stdlib.h
- * unix/tclUnixThrd.c (Tcl_CreateThread): Added declarations
- * unix/tclUnixTest.c (AlarmHandler): and casts so that
- * unix/tclUnixChan.c (TtyModemStatusStr): all functions are
- * generic/tclScan.c (Tcl_ScanObjCmd): defined before use
- * generic/tclDictObj.c (InvalidateDictChain): and no cross-type
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): uses are performed.
-
- The overall effect is to make building with gcc with the
- additional flags -Wstrict-prototypes -Wmissing-prototypes produce
- no increase in the total number of warnings (except for main(),
- which is undeclared for traditional reasons.)
-
-2004-05-26 Jeff Hobbs <jeffh@ActiveState.com>
-
- * unix/Makefile.in: Rework configure ordering to TCL_LINK_LIBS,
- * unix/tcl.m4: ENABLE_SHARED, CONFIG_CFLAGS, & ENABLE_SYMBOLS
- * unix/configure: before TCL_EARLY_FLAGS and TCL_64BIT_FLAGS
- * unix/configure.in: (about 400 lines earlier) in configure.in.
- This forces CFLAGS configuration to be done before many tests,
- which is needed for 64-bit builds and may affect other builds.
- Also make CONFIG_CFLAGS append to CFLAGS directly instead of using
- EXTRA_CFLAGS, and have LDFLAGS append to any existing value.
- [Bug #874058]
- * unix/dltest/Makefile.in: change EXTRA_CFLAGS to DEFS
-
-2004-05-26 Don Porter <dgp@users.sourceforge.net>
-
- * library/tcltest/tcltest.tcl: Correction to debug prints and testing
- * library/tcltest/pkgIndex.tcl: if TCLTEST_OPTIONS value. Corrected
- * tests/tcltest.test: double increment of numTestFiles in
- -singleproc 1 configurations. Updated tcltest-19.1 to tcltest 2.1
- behavior. Corrected tcltest-25.3 to not falsely report a failure
- in tcltest.test. Bumped to tcltest 2.2.6. [Bugs 960560, 960926]
-
-2004-05-25 Jeff Hobbs <jeffh@ActiveState.com>
-
- * doc/http.n (http::config): add -urlencoding option (default utf-8)
- * library/http/http.tcl: that specifies encoding conversion of
- * library/http/pkgIndex.tcl: args for http::formatQuery. Previously
- * tests/http.test: undefined, RFC 2718 says it should be
- utf-8. 'http::config -urlencoding {}' returns previous behavior,
- which will throw errors processing non-latin-1 chars.
- Bumped http package to 2.5.0.
-
-2004-05-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclInterp.c (DeleteScriptLimitCallback): Move all
- deletion of script callback hash table entries to happen here so
- the entries are correctly removed at the right time. [Bug 960410]
-
-2004-05-25 Miguel Sofer <msofer@users.sf.net>
-
- * docs/global.n: added details for qualified variable names
- [Bug 959831]
-
-2004-05-25 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclNamesp.c (Tcl_FindNamespaceVar):
- * tests/namespace.test (namespace-17.10-12): reverted commit of
- 2004-05-23 and removed the tests, as it interferes with the
- varname resolver and there are apps that break (AlphaTk). A fix
- will have to wait for Tcl9.
-
- * generic/tclVar.c: Caching of namespace variables disabled: no
- simple way was found to avoid interfering with the resolver's idea
- of variable existence. A cached varName may keep a variable's name
- in the namespace's hash table, which is the resolver's criterion
- for existence.
-
- * tests/namespace.c (namespace-17.10): testing for interference
- between varname caching and name resolver.
-
-2004-05-25 Kevin Kenny <kennykb@acm.org>
-
- * tests/winFCmd.test: Correct test for the presence of a CD-ROM so
- that it doesn't misdetect some other sort
- of filesystem with a write-protected root as
- being a CD-ROM drive. [Bug 918267]
-
-2004-05-25 Don Porter <dgp@users.sourceforge.net>
-
- * tests/winPipe.test: Protect against path being set
- * tests/unixInit.test: Unset path when done.
- * tests/unload.test (unload-3.1): Verify [pkgb_sub] does not exist.
- Delete interps when done.
- * tests/stringComp.test: stop re-use of string.test test names
- * tests/regexpComp.test: stop re-use of regexp.test test names
- * tests/namespace.test (namespace-46.3): Verify [p] does not exist.
- * tests/http.test: Clear away the custom [bgerror] when done.
- * tests/io.test: Take care to use namespace variables.
- * tests/autoMkindex.test (autoMkindex-5.2): Use variable "result"
- that gets cleaned up.
- * tests/exec.test: Clean up the "path" array.
- * tests/interp.test (interp-9.3): Initialize res, so prior values
- cannot make the test fail.
- * tests/execute.test (execute-8.1): Updated to remove the trace
- set on ::errorInfo . When left in place, that trace can cause
- later tests to fail.
-
-2004-05-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclBasic.c: Removed references to Tcl_RenameCommand from
- * generic/tcl.h: comments. [Bug 848440, second part]
-
- * tests/fCmd.test: Rewrote tests that failed consistently on NFS
- so they either succeed (through slightly more liberal matching of
- the results) or are constrained to not run. [Bug 931312]
-
- * doc/bgerror.n: Use idiomatic open flags for working with log
- files. [Bug 959602]
-
-2004-05-24 Jeff Hobbs <jeffh@ActiveState.com>
-
- * generic/tclExecute.c (VerifyExprObjType): use GET_WIDE_OR_INT to
- properly have tclIntType used for smaller values. This corrects
- TclX bug 896727 and any other 3rd party extension that created
- math functions but was not yet WIDE_INT aware in them.
-
-2004-05-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclInterp.c (TclInitLimitSupport): Made limits work on
- platforms where sizeof(void*)!=sizeof(int). [Bug 959193]
-
-2004-05-24 Miguel Sofer <msofer@users.sf.net>
-
- * doc/set.n: accurate description of name resolution process,
- referring to namespace.n for details [Bug 959180]
-
-2004-05-23 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclNamesp.c (Tcl_FindNamespaceVar): [Bug 959052] fixed,
- insuring that no "zombie" variables are found.
- * generic/tclVar.c (TclLookupSimpleVar): comments re [Bug 736729]
- (predecessor of [Bug 959052]) removed.
- * tests/namespace.test: added tests 17.10-12
-
- The patch modifies non-documented behaviour, and passes every test
- in the testsuite. However, scripts relying on the old behaviour
- may break.
- Note that the only behaviour change concerns the creative writing
- of unset variables. More precisely, which variable will be created
- when neither a namespace variable nor a global variable by that
- name exists, as defined by [info vars]. The new behaviour is that
- the namespace resolution process deems a variable to exist exactly
- when [info vars] finds it - ie, either it has value, or else it
- was "fixed" by a call to [variable].
- Note: this patch was removed on 2002-05-25.
-
-2004-05-22 Miguel Sofer <msofer@users.sf.net>
+2009-10-28 Don Porter <dgp@users.sourceforge.net>
- * generic/tclVar.c (TclObjLookupVar, TclObjUnsetVar2): fix for new
- (in tcl8.4) exteriorisations of [Bug 736729] due to the use of
- tclNsVarNameType obj types. Reenabling the use of this objType
- ("VAR ref absolute" benchmark down to 66 ms, from 230).
- Added comments in TclLookupSimpleVar explaining my current
- understanding of [Bug 736729].
-
-2004-05-22 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclVar.c: fix for [Bug 735335]. The use of
- tclNsVarNameType objs is still disabled, pending resolution of
- [Bug 736729].
+ * generic/tclLiteral.c: [Bug 2888044]: Fixed 2 bugs.
+ * tests/info.test: First, as noted in the comments of the
+ TclCleanupLiteralTable routine, since the teardown of the intrep of
+ one Tcl_Obj can cause the teardown of others in the same table, the
+ full table cleanup must be done with care, but the code did not
+ contain the same care demanded in the comment. Second, recent
+ additions to the info.test file had poor hygiene, leaving an array
+ variable ::a lying around, which breaks later interp.test tests during
+ a -singleproc 1 run of the test suite.
-2004-05-21 Miguel Sofer <msofer@users.sf.net>
+2009-10-28 Kevin B. Kenny <kennykb@acm.org>
- * tests/namespace.test (namespace-41.3): removed the {knownBug}
- constraint: [Bug 231259] is closed since nov 2001, and the fix of
- [Bug 729692] (INST_START_CMD) makes the test succeed.
+ * tests/fileName.test (fileName-20.[78]): Corrected poor test
+ hygiene (failure to save and restore the working directory) that
+ caused these two tests to fail on Windows (and [Bug 2806250] to be
+ reopened).
-2004-05-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-27 Don Porter <dgp@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): Move a few
- declarations a short distance so pre-C99 compilers can cope. Also
- fix so TCL_COMPILE_DEBUG path compiles...
+ * generic/tclPathObj.c: [Bug 2884203]: Missing refcount on cached
+ normalized path caused crashes.
-2004-05-21 Miguel Sofer <msofer@users.sf.net>
+2009-10-27 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC
- automatic variables, defining them in tight blocks instead of at
- the function level. This has three purposes:
- - it simplifies the analysis of individual instructions
- - it is preliminary work to the non-recursive engine
- - it allows a better register allocation by the optimiser; under
- gcc3.3, this results in up to 10% runtime in some tests
+ * library/clock.tcl (ParseClockScanFormat): [Bug 2886852]: Corrected a
+ problem where [clock scan] didn't load the timezone soon enough when
+ processing a time format that lacked a complete date.
+ * tests/clock.test (clock-66.1):
+ Added a test case for the above bug.
+ * library/tzdata/America/Argentina/Buenos_Aires:
+ * library/tzdata/America/Argentina/Cordoba:
+ * library/tzdata/America/Argentina/San_Luis:
+ * library/tzdata/America/Argentina/Tucuman:
+ New DST rules for Argentina. (Olson's tzdata2009p.)
-2004-05-20 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-26 Don Porter <dgp@users.sourceforge.net>
- * generic/tclInterp.c (TclLimitRemoveAllHandlers):
- * generic/tclBasic.c (DeleteInterpProc):
- * tests/interp.test (interp-34.7):
- Ensure that all limit callbacks are deleted when their interpreters
- are deleted. [Bug 956083]
+ * unix/Makefile.in: Remove $(PACKAGE).* and prototype from the
+ `make distclean` target. Completes 2009-10-20 commit.
-2004-05-19 Kevin B. Kenny <kennykb@acm.org>
+2009-10-24 Kevin B. Kenny <kennykb@acm.org>
- * win/tclWinFile.c (TclpMatchInDirectory): fix for an issue
- where there was a sneak path from Tcl_DStringFree to
- SetErrorCode(0). The result was that the error code could
- be reset between a call to FindFirstFileEx and the check
- of its status return, leading to a bizarre error return of
- {POSIX unknown {No error}}. (Found in unplanned test -
- no incident logged at SourceForge.)
+ * library/clock.tcl (ProcessPosixTimeZone):
+ Corrected a regression in the fix to [Bug 2207436] that caused
+ [clock] to apply EU daylight saving time rules in the US.
+ Thanks to Karl Lehenbauer for reporting this regression.
+ * tests/clock.test (clock-52.4):
+ Added a regression test for the above bug.
+ * library/tzdata/Asia/Dhaka:
+ * library/tzdata/Asia/Karachi:
+ New DST rules for Bangladesh and Pakistan. (Olson's tzdata2009o.)
-2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-23 Andreas Kupries <andreask@activestate.com>
- * tests/interp.test (interp-34.3): Rewrite this test to see if a
- time limit can catch a tight bytecode loop, a maximally aggressive
- denial-of-service attack.
- * generic/tclInterp.c (Tcl_LimitCheck): Fix the sense of checks to
- see whether a time limit has been extended.
+ * generic/tclIO.c (FlushChannel): Skip OutputProc for low-level
+ 0-length writes. When closing pipes which have already been closed
+ not skipping leads to spurious SIG_PIPE signals. Reported by
+ Mikhail Teterin <mi+thun@aldan.algebra.com>.
- * tests/*.test: Many minor fixes, including ensuring that every
- test is run (so constraints control whether the test is doing
- anything) and making sure that constraints are always set using
- the API instead of poking around inside tcltest's internal
- datastructures. Also got rid of all trailing whitespace lines
- from the test suite!
+2009-10-22 Donal K. Fellows <dkf@users.sf.net>
-2004-05-19 Andreas Kupries <andreask@activestate.com>
+ * generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 2883857]: Allow
+ the passing of array element names through this method.
- * generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem
- * generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry
- 2001-09-26. The fix done at that time is incomplete. It
- is possible to get around it if the actual read
- operation is defered and not executed in the event
- handler itself. Instead of tracking if we are in an
- read caused by a synthesized fileevent we now track if
- the OS has delivered a true event = actual data and
- bypass the driver if a read finds that there is no
- actual data waiting. The flag is cleared by a short or
- full read.
+2009-10-21 Donal K. Fellows <dkf@users.sf.net>
- ***POTENTIAL INCOMPATIBILITY*** for channel drivers.
+ * generic/tclPosixStr.c: [Bug 2882561]: Work around oddity on Haiku OS
+ where SIGSEGV and SIGBUS are the same value.
-2004-05-17 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclTrace.c (StringTraceProc): [Bug 2881259]: Added back cast
+ to work around silly bug in MSVC's handling of auto-casting.
- * generic/tclPathObj.c: fix to (Bug 956063) in 'file dirname'.
- * tests/cmdAH.test: added test for this bug.
+2009-10-20 Don Porter <dgp@users.sourceforge.net>
- * doc/FileSystem.3: better documentation of refCount requirements
- of some FS functions (Bug 956126)
+ * unix/Makefile.in: Removed the long outdated and broken targets
+ package-* that were for building Solaris packages. Appears that the
+ pieces needed for these targets to function have never been present in
+ the current era of Tcl development and belong completely to Tcl
+ pre-history.
-2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-19 Don Porter <dgp@users.sourceforge.net>
- * generic/tclTest.c (TestgetintCmd): Made the tests in get.test check
- * tests/get.test: Tcl_GetInt() since the core now
- avoids that function.
+ * generic/tclIO.c: [Patch 2107634]: Revised ReadChars and
+ FilterInputBytes routines to permit reads to continue up to the string
+ limits of Tcl values. Before revisions, large read attempts could
+ panic when as little as half the limiting value length was reached.
+ Thanks to Sean Morrison and Bob Parker for their roles in the fix.
-2004-05-18 Kevin B. Kenny <kennykb@acm.org>
+2009-10-18 Joe Mistachkin <joe@mistachkin.com>
- * compat/strftime.c (_fmt, ISO8601Week):
- * doc/clock.n:
- * tests/clock.test: Major rework to the handling of ISO8601
- week numbers. Now passes all the %G and %V test cases on
- Windows, Linux and Solaris [Bugs #500285, #500389, and #852944]
+ * generic/tclObj.c (TclDbDumpActiveObjects, TclDbInitNewObj)
+ (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared):
+ [Bug 2871908]: Enforce separation of concerns between the lineCLPtr
+ and objThreadMap thread specific data members.
-2004-05-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-18 Joe Mistachkin <joe@mistachkin.com>
- * doc/append.n, doc/upvar.n: Added example.
+ * 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.
-2004-05-18 David Gravereaux <davygrvy@pobox.com>
+2009-10-17 Donal K. Fellows <dkf@users.sf.net>
- * win/makefile.vc: now generates a tclConfig.sh from Pat Thoyts
- [Patch 909911]
+ * generic/tclVar.c (UnsetVarStruct, TclDeleteNamespaceVars)
+ (TclDeleteCompiledLocalVars, DeleteArray):
+ * generic/tclTrace.c (Tcl_UntraceVar2): [Bug 2629338]: Stop traces
+ that are deleted part way through (a feature used by tdom) from
+ causing freed memory to be accessed.
-2004-05-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-10-08 Donal K. Fellows <dkf@users.sf.net>
- * doc/lsearch.n: Improve clarity (based on [Patch 955361] by Peter
- Spjuth)
+ * generic/tclDictObj.c (DictIncrCmd): [Bug 2874678]: Don't leak any
+ bignums when doing [dict incr] with a value.
+ * tests/dict.test (dict-19.3): Memory leak detection code.
- * tools/man2help2.tcl (macro,SHmacro): Added support for
- subsection (.SS) header macros.
+2009-10-07 Andreas Kupries <andreask@activestate.com>
- * doc/interp.n: Added user documentation for the TIP#143 resource
- limits and some examples.
+ * generic/tclObj.c: [Bug 2871908]: Plug memory leaks of objThreadMap
+ and lineCLPtr hashtables. Also make the names of the continuation
+ line information initialization and finalization functions more
+ consistent. Patch supplied by Joe Mistachkin <joe@mistachkin.com>.
- * generic/tclInterp.c (Tcl_LimitCheck, Tcl_LimitTypeReset): Reset
- the limit-exceeded flag when removing a limit.
+ * generic/tclIORChan.c (ErrnoReturn): Replace hardwired constant 11
+ with proper errno #define, EAGAIN. What was I thinking? The BSD's have
+ a different errno assignment and break with the hardwired number.
+ Reported by emiliano on the chat.
-2004-05-18 Miguel Sofer <msofer@users.sf.net>
+2009-10-06 Don Porter <dgp@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): added comments to
- classify the variables according to their use in TEBC.
+ * generic/tclInterp.c (SlaveEval): Agressive stomping of internal reps
+ was added as part of the NRE patch of 2008-07-13. This doesn't appear
+ to actually be needed, and it hurts quite a bit when large lists lose
+ their intreps and require reparsing. Thanks to Ashok Nadkarni for
+ reporting the problem.
-2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclTomMathInt.h (new): Public header tclTomMath.h had
+ * generic/tclTomMath.h: dependence on private headers, breaking use
+ * generic/tommath.h: by extensions [Bug 1941434].
- * doc/global.n, doc/uplevel.n: Added an example.
+2009-10-05 Andreas Kupries <andreask@activestate.com>
- * tests/info.test (info-3.1): Corrected test result back to what
- it used to be in Tcl 7.* now that command counts are being
- correctly kept.
+ * 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.
- * generic/tclExecute.c (TEBC:INST_START_CMD): Make sure that the
- command-count is always advanced. Allows TIP#143 limits to tell
- that work is being done.
+2009-10-04 Daniel Steffen <das@users.sourceforge.net>
- * doc/list.n: Updated example to fit with the unified format.
- * doc/seek.n: Added some examples.
+ * macosx/tclMacOSXBundle.c: [Bug 2569449]: Workaround CF memory
+ * unix/tclUnixInit.c: managment bug in Mac OS X 10.4 &
+ earlier.
-2004-05-17 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-10-02 Kevin B. Kenny <kennykb@acm.org>
- * win/tclWinFile.c:
- * tests/cmdAH.test: fix to (Bug 954263) where 'file executable'
- was case-sensitive.
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Karachi:
+ * library/tzdata/Pacific/Apia: Olson's tzdata2009n.
-2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-09-29 Don Porter <dgp@users.sourceforge.net>
- * doc/OpenFileChnl.3: Documented type of 'offset' argument to
- Tcl_Seek was wrong. [Bug 953374]
+ * generic/tclDictObj.c: [Bug 2857044]: Updated freeIntRepProc
+ * generic/tclExecute.c: routines so that they set the typePtr
+ * generic/tclIO.c: field to NULL so that the Tcl_Obj is
+ * generic/tclIndexObj.c: not left in an inconsistent state.
+ * generic/tclInt.h:
+ * generic/tclListObj.c:
+ * generic/tclNamesp.c:
+ * generic/tclOOCall.c:
+ * generic/tclObj.c:
+ * generic/tclPathObj.c:
+ * generic/tclProc.c:
+ * generic/tclRegexp.c:
+ * generic/tclStringObj.c:
-2004-05-16 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclAlloc.c: Cleaned up various routines in the
+ * generic/tclCkalloc.c: call stacks for memory allocation to
+ * generic/tclInt.h: guarantee that any size values computed
+ * generic/tclThreadAlloc.c: are within the domains of the routines
+ they get passed to. [Bugs 2557696 and 2557796].
- * generic/tclExecute.c (TclExecuteByteCode): remove one level of
- indirection for compiledLocals addressing.
+2009-09-28 Don Porter <dgp@users.sourceforge.net>
-2004-05-16 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclCmdMZ.c: Replaced TclProcessReturn() calls with
+ * tests/error.test: Tcl_SetReturnOptions() calls as a simple fix
+ for [Bug 2855247]. Thanks to Anton Kovalenko for the report and fix.
+ Additional fixes for other failures demonstrated by new tests.
- * generic/tclExecute.c (INST_CALL_FUNC1): bugfix; restored
- (DE)CACHE_STACK_INFO pair around the call - the user defined math
- function could cause a recursive call to TEBC.
+2009-09-27 Don Porter <dgp@users.sourceforge.net>
-2004-05-16 Miguel Sofer <msofer@users.sf.net>
+ * tests/error.test (error-15.8.*): Coverage tests illustrating
+ flaws in the propagation of return options by [try].
- * generic/tclBasic.c (Tcl_DeleteInterp):
- * generic/tclExecute.c (INST_START_CMD): interp deletion now
- modifies the compileEpoch, eliminating the need for the check for
- interp deletion in INST_START_CMD.
+2009-09-26 Donal K. Fellows <dkf@users.sf.net>
-2004-05-16 Miguel Sofer <msofer@users.sf.net>
+ * unix/tclooConfig.sh, win/tclooConfig.sh: [Bug 2026844]: Added dummy
+ versions of tclooConfig.sh that make it easier to build extensions
+ against both Tcl8.5+TclOO-standalone and Tcl8.6.
- * generic/tclCompile.h:
- * generic/tclCompile.c:
- * generic/tclExecute.c: changed implementation of {expand}, last
- chance while in alpha as ...
+2009-09-24 Don Porter <dgp@users.sourceforge.net>
- ***POTENTIAL INCOMPATIBILITY***
- Scripts precompiled with ProComp under previous tcl8.5a versions
- may malfunction due to changed instruction numbers for
- INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD.
+ TIP #356 IMPLEMENTATION
-2004-05-14 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tcl.decls: Promote internal routine TclNRSubstObj()
+ * generic/tclCmdMZ.c: to public Tcl_NRSubstObj(). Still needs docs.
+ * generic/tclCompile.c:
+ * generic/tclInt.h:
- * generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime
- * generic/tclIntDecls.h: from Unix-specific stubs to the generic
- * generic/tclIntPlatDecls.h: internal Stubs table. Reran 'genstubs'
+ * generic/tclDecls.h: make genstubs
* generic/tclStubInit.c:
- * unix/tclUnixPort.h:
- * generic/tclClock.c: Changed a buggy 'GMT' timezone specification
- to the correct 'GMT0'. [Bug #922848]
+2009-09-23 Miguel Sofer <msofer@users.sf.net>
- * unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to
- unix/tclUnixTime.c where they belong.
+ * doc/namespace.n: the description of [namespace unknown] failed
+ to mention [namespace path]: fixed. Thx emiliano.
- * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone,
- ThreadSafeGMTime [removed],
- ThreadSafeLocalTime [removed],
- SetTZIfNecessary, CleanupMemory):
- Restructured to make sure that the same mutex protects
- all calls to localtime, gmtime, and tzset. Added a check
- in front of those calls to make sure that the TZ env var
- hasn't changed since the last call to tzset, and repeat
- tzset if necessary. [Bug #942078] Removed a buggy test
- of the Daylight Saving Time information in 'gettimeofday'
- in favor of applying 'localtime' to a known value.
- [Bug #922848]
+2009-09-21 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/clock.test (clock-3.14): Added test to make sure that
- changes to $env(TZ) take effect immediately.
+ * tests/regexp.test: Added check for error message from
+ unbalanced [] in regexp. Added additional simple test cases
+ of basic regsub command.
- * win/tclWinTime.c (TclpLocaltime, TclpGmtime):
- Added porting layer for 'localtime' and 'gmtime' calls.
+2009-09-21 Don Porter <dgp@users.sourceforge.net>
-2004-05-14 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclCompile.c: Correct botch in the conversion of
+ Tcl_SubstObj(). Thanks to Kevin Kenny for detection and report.
- * generic/tclExecute.c:
- * generic/tclCompile.h: the math functions receive a pointer to
- top of the stack (tosPtr) instead of the execution environment
- (eePtr). First step towards a change in the execution stack
- management - it is now only used within TEBC.
+2009-09-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Re-implement Tcl_SubstObj() as a simple
+ * generic/tclParse.c: wrapper around TclNRSubstObj(). This has
+ * tests/basic.test: the effect of caching compiled bytecode in
+ * tests/parse.test: the value to be substituted. Note that
+ Tcl_SubstObj() now exists only for extensions. Tcl itself no longer
+ makes any use of it. Note also that TclSubstTokens() is now reachable
+ only by Tcl_EvalEx() and Tcl_ParseVar() so tests aiming to test its
+ functioning needed adjustment to still have the intended effect.
+
+2009-09-16 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclObj.c: Extended ::tcl::unsupported::representation.
+
+2009-09-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Completed the NR-enabling of [subst].
+ * generic/tclCmdMZ.c: [Bug 2314561].
+ * generic/tclCompCmds.c:
+ * generic/tclCompile.c:
+ * generic/tclInt.h:
+ * tests/coroutine.test:
+ * tests/parse.test:
+
+2009-09-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/http.test: Added in cleaning up of http tokens for each test
+ to reduce amount of global-variable pollution.
+
+2009-09-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/http/http.tcl (http::Event): [Bug 2849860]: Handle charset
+ names in double quotes; some servers like generating them like that.
+
+2009-09-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c: [Bug 2850901]: Corrected line counting error
+ * tests/into.test: in multi-command script substitutions.
+
+2009-09-07 Daniel Steffen <das@users.sourceforge.net>
-2004-05-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclExecute.c: Fix potential uninitialized variable use and
+ * generic/tclFCmd.c: null dereference flagged by clang static
+ * generic/tclProc.c: analyzer.
+ * generic/tclTimer.c:
+ * generic/tclUtf.c:
- TIP#143 IMPLEMENTATION
+ * generic/tclExecute.c: Silence false positives from clang static
+ * generic/tclIO.c: analyzer about potential null dereference.
+ * generic/tclScan.c:
+ * generic/tclCompExpr.c:
- * generic/tclExecute.c (TclCompEvalObj, TclExecuteByteCode):
- * generic/tclBasic.c (TclEvalObjvInternal): Enable limit checking.
- * generic/tclInterp.c (Tcl_Limit*): Public limit API.
- * generic/tcl.decls:
- * tests/interp.test: Basic tests of command limits.
+2009-09-04 Don Porter <dgp@users.sourceforge.net>
- * doc/binary.n: TIP#129 IMPLEMENTATION [Patch 858211]
- * generic/tclBinary.c: Note that the test suite probably has many more
- * tests/binary.test: failures now due to alterations in constraints.
+ * generic/tclCompCmds.c (TclCompileSubstCmd): [Bug 2314561]:
+ * generic/tclBasic.c: Added a bytecode compiler routine for the
+ * generic/tclCmdMZ.c: [subst] command. This is a partial solution to
+ * generic/tclCompile.c: the need to NR-enable [subst] since bytecode
+ * generic/tclCompile.h: execution is already NR-enabled. Two new
+ * generic/tclExecute.c: bytecode instructions, INST_NOP and
+ * generic/tclInt.h: INST_RETURN_CODE_BRANCH were added to support
+ * generic/tclParse.c: the new routine. INST_RETURN_CODE_BRANCH is
+ * tests/basic.test: likely to be useful in any future effort to
+ * tests/info.test: add a bytecode compiler routine for [try].
+ * tests/parse.test:
-2004-05-12 Miguel Sofer <msofer@users.sf.net>
+2009-09-03 Donal K. Fellows <dkf@users.sf.net>
- Optimisations for INST_START_CMD [Bug 926164].
- * generic/tclCompile.c (TclCompileScript): avoid emitting
- INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It
- is not needed, as the checks are done before calling TEBC.
- * generic/tclExecute.c (TclExecuteByteCode): runtime peephole
- optimisation: check at INST_POP if the next instruction is
- INST_START_CMD, in which case we fall through.
+ * doc/LinkVar.3: [Bug 2844962]: Added documentation of issues relating
+ to use of this API in a multi-threaded environment.
-2004-05-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-09-01 Andreas Kupries <andreask@activestate.com>
- * doc/split.n, doc/join.n: Updated examples and added more.
+ * generic/tclIORTrans.c (ReflectInput): Remove error response to
+ 0-result from method 'limit?' of transformations. Return the number of
+ copied bytes instead, which is possibly nothing. The latter then
+ triggers EOF handling in the higher layers, making the 0-result of
+ limit? the way to inject artificial EOF's into the data stream.
-2004-05-11 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-09-01 Don Porter <dgp@users.sourceforge.net>
- * doc/glob.n: documented behaviour of symbolic links with
- 'glob -types d' (Bug 951489)
+ * library/tcltest/tcltest.tcl: Bump to tcltest 2.3.2 after revision
+ * library/tcltest/pkgIndex.tcl: to verbose error message.
+ * unix/Makefile.in:
+ * win/Makefile.in:
-2004-05-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-08-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: [Bug 2845535]: A few more string
+ overflow cases in [format].
+
+2009-08-25 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard)
+ (Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx):
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
+ * generic/tclCompCmds.c (*):
+ * generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv)
+ (TclFreeCompileEnv, TclCompileScript, TclCompileTokens):
+ * generic/tclCompile.h (CompileEnv):
+ * generic/tclInt.h (ContLineLoc, Interp):
+ * generic/tclObj.c (ThreadSpecificData, ContLineLocFree)
+ (TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter,
+ (TclContinuationsEnterDerived, TclContinuationsCopy, TclFreeObj)
+ (TclContinuationsGet):
+ * generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
+ * generic/tclProc.c (TclCreateProc):
+ * generic/tclVar.c (TclPtrSetVar):
+ * tests/info.test (info-30.0-24):
- * doc/scan.n: Updated the examples to be clearer about their
- relevance to the scan command.
+ Extended the parser, compiler, and execution engine with code and
+ attendant data structures tracking the position of continuation lines
+ which are not visible in the resulting script Tcl_Obj*'s, to properly
+ account for them while counting lines for #280.
-2004-05-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-08-24 Daniel Steffen <das@users.sourceforge.net>
- * doc/scan.n: Added examples.
+ * generic/tclInt.h: Annotate Tcl_Panic as noreturn for clang static
+ analyzer in PURIFY builds, replacing preprocessor/assert technique.
-2004-05-10 David Gravereaux <davygrvy@pobox.com>
+ * macosx/tclMacOSXNotify.c: Fix multiple issues with nested event loops
+ when CoreFoundation notifier is running in embedded mode. (Fixes
+ problems in TkAqua Cocoa reported by Youness Alaoui on tcl-mac)
- * win/tclWinPipe.c (BuildCommandLine): Moved non-obvious appending
- logic to outside the loop and added commentary for its purpose. Also
- use the existence of contents in the linePtr rather than the scratch
- DString post the append, as this more clear.
+2009-08-21 Don Porter <dgp@users.sourceforge.net>
- (TclpCreateProcess): When under NT, with no console, and executing a
- DOS application, the path priming does not need an ending space as
- BuildCommandLine() will do this for us.
+ * generic/tclFileName.c: Correct regression in [Bug 2837800] fix.
+ * tests/fileName.test:
-2004-05-08 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-08-20 Don Porter <dgp@users.sourceforge.net>
- * generic/tclFileName.c:
- * generic/tclIOUtil.c: remove some compiler warnings on MacOS X.
+ * generic/tclFileName.c: [Bug 2837800]: Correct the result produced by
+ [glob */test] when * matches something like ~foo.
-2004-05-07 Chengye Mao <chengye.geo@yahoo.com>
+ * generic/tclPathObj.c: [Bug 2806250]: Prevent the storage of strings
+ starting with ~ in the "tail" part (normPathPtr field) of the path
+ intrep when PATHFLAGS != 0. This establishes the assumptions relied
+ on elsewhere that the name stored there is a relative path. Also
+ refactored to make an AppendPath() routine instead of the cut/paste
+ stanzas that were littered throughout.
- * win/tclWinPipe.c: refixed bug 789040 re-entered in rev 1.41.
- Let's be careful and don't re-enter previously fixed bugs.
+2009-08-20 Donal K. Fellows <dkf@users.sf.net>
-2004-05-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclCmdIL.c (TclNRIfObjCmd): [Bug 2823276]: Make [if]
+ NRE-safe on all arguments when interpreted.
+ (Tcl_LsortObjCmd): Close off memory leak.
- * doc/format.n: Added examples.
+2009-08-19 Donal K. Fellows <dkf@users.sf.net>
-2004-05-07 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclCmdAH.c (TclNRForObjCmd, etc.): [Bug 2823276]: Make [for]
+ and [while] into NRE-safe commands, even when interpreted.
- * doc/unset.n: added upvar.n to the "see also" list
+2009-08-18 Don Porter <dgp@users.sourceforge.net>
-2004-05-07 Reinhard Max <max@suse.de>
+ * generic/tclPathObj.c: [Bug 2837800]: Added NULL check to prevent
+ * tests/fileName.test: crashes during [glob].
- * generic/tclEncoding.c:
- * tests/encoding.test: added support and tests for translating
- embedded null characters between real nullbytes and the internal
- representation on input/output (Bug #949905).
+2009-08-16 Jan Nijtmans <nijtmans@users.sf.net>
-2004-05-07 Vince Darley <vincentdarley@users.sourceforge.net>
+ * 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:
- * generic/tclFileName.c:
- * generic/tclIOUtil.c:
- * generic/tclFileSystem.h:
- * tests/fileSystem.test: fix for [Bug 943995], in which vfs-
- registered root volumes were not handled correctly as glob
- patterns in all circumstances.
+2009-08-12 Don Porter <dgp@users.sourceforge.net>
-2004-05-06 Miguel Sofer <msofer@users.sf.net>
+ TIP #353 IMPLEMENTATION
+ * doc/NRE.3: New public routine Tcl_NRExprObj() permits
+ * generic/tcl.decls: extension commands to evaluate Tcl expressions
+ * generic/tclBasic.c: in NR-enabled command procedures.
+ * generic/tclCmdAH.c:
+ * generic/tclExecute.c:
* generic/tclInt.h:
- * generic/tclObj.c (TclFreeObj): made TclFreeObj use the new macro
- TclFreeObjMacro(), so that the allocation and freeing of Tcl_Obj
- is defined in a single spot (the macros in tclInt.h), with the
- exception of the TCL_MEM_DEBUG case.
- The #ifdef logic for the corresponding macros has been reformulated
- to make it clearer.
+ * generic/tclObj.c:
+ * tests/expr.test:
-2004-05-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
- * doc/break.n, doc/continue.n, doc/for.n, doc/while.n: More examples.
+2009-08-06 Andreas Kupries <andreask@activestate.com>
-2004-05-05 Don Porter <dgp@users.sourceforge.net>
+ * doc/refchan.n [Bug 2827000]: Extended the implementation of
+ * generic/tclIORChan.c: reflective channels (TIP 219, method
+ * tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to
+ indicate 'no data, but not at EOF either', and other system
+ errors. Updated documentation, extended testsuite (New test cases
+ iocmd*-23.{9,10}).
- * tests/unixInit.test (unixInit-2.10): Test correction for Mac OSX.
- Be sure to consistently compare normalized path names. Thanks to
- Steven Abner (tauvan). [Bug 948177]
+2009-08-02 Miguel Sofer <msofer@users.sf.net>
-2004-05-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * tests/coroutine.test: fix testfile cleanup
- * doc/CrtObjCmd.3: Remove reference to Tcl_RenameCommand; there is
- no such API. [Bug 848440]
+2009-08-02 Donal K. Fellows <dkf@users.sf.net>
-2004-05-05 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclObj.c (Tcl_RepresentationCmd): Added an unsupported
+ command for reporting the representation of an object. Result string
+ is deliberately a bit obstructive so that people are not encouraged to
+ make code that depends on it; it's a debugging tool only!
- * win/tclWinSock.c (SocketEventProc) : connect errors should
- fire both the readable and writable handlers because this is
- how it works on UNIX [Bug 794839]
+ * unix/tclUnixFCmd.c (GetOwnerAttribute, SetOwnerAttribute)
+ (GetGroupAttribute, SetGroupAttribute): [Bug 1942222]: Stop calling
+ * unix/tclUnixFile.c (TclpGetUserHome): endpwent() and endgrent();
+ they've been unnecessary for ages.
- * generic/tclEncoding.c (TclFinalizeEncodingSubsystem):
- FreeEncoding(systemEncoding); moved to before the hash table
- itereation as it was causing a double free attempt under some
- conditions.
+2009-08-02 Jan Nijtmans <nijtmans@users.sf.net>
- * win/coffbase.txt: Added the tls extension to the list of
- preferred load addresses.
+ * win/tclWin32Dll.c: Eliminate TclWinResetInterfaceEncodings, since it
+ * win/tclWinInit.c: does exactly the same as TclWinEncodingsCleanup,
+ * win/tclWinInt.h: make sure that tclWinProcs and
+ tclWinTCharEncoding are always set and reset
+ concurrently.
+ * win/tclWinFCmd.c: Correct check for win95
-2004-05-04 Jeff Hobbs <jeffh@ActiveState.com>
+2009-07-31 Don Porter <dgp@users.sourceforge.net>
- * tests/fileSystem.test (filesystem-1.39): replace 'file volumes'
- * tests/fileName.test (filename-12.9,10): lindex with direct C:/
- hard-coded because A:/ was being used and that is empty for most.
+ * generic/tclStringObj.c: [Bug 2830354]: Corrected failure to
+ * tests/format.test: grow buffer when format spec request
+ large width floating point values. Thanks to Clemens Misch.
- * tests/winFCmd.test (winFCmd-16.12): test volumerelative $HOME
+2009-07-26 Donal K. Fellows <dkf@users.sf.net>
-2004-05-04 Don Porter <dgp@users.sourceforge.net>
+ * library/auto.tcl (tcl_findLibrary, auto_mkindex):
+ * library/package.tcl (pkg_mkIndex, tclPkgUnknown, MacOSXPkgUnknown):
+ * library/safe.tcl (interpAddToAccessPath, interpDelete, AliasGlob):
+ (AliasSource, AliasLoad, AliasEncoding):
+ * library/tm.tcl (UnknownHandler): Simplify by swapping some [catch]
+ gymnastics for use of [try].
- * generic/tclAlloc.c: Make sure Tclp*Alloc* routines get
- * generic/tclInt.h: declared in the TCL_MEM_DEBUG and
- * generic/tclThreadAlloc.c: TCL_THREADS configuration. [Bug 947564]
+2009-07-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * tests/tcltest.test: Test corrections for Mac OSX. Thanks
- to Steven Abner (tauvan). [Bug 947440]
+ * tools/genStubs.tcl: Forced LF translation when generating .h's to
+ avoid spurious diffs when regenerating on a Windows box.
-2004-05-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-07-26 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclEvent.c (TclSetLibraryPath): Suppress a warning.
+ * win/Makefile.in: [Bug 2827066]: msys build --enable-symbols broken
+ * win/tcl.m4: And modified the same for unicows.dll, as a
+ * win/configure: preparation for [Enh 2819611].
-2004-05-03 Andreas Kupries <andreask@activestate.com>
+2009-07-25 Donal K. Fellows <dkf@users.sf.net>
- * Applied [SF Tcl Patch 868853], fixing a mem leak in
- TtySetOptionProc. Report and Patch provided by Stuart
- Cassoff <stwo@users.sf.net>.
+ * library/history.tcl (history): Reworked the history mechanism in
+ terms of ensembles, rather than the ad hoc ensemble-lite mechanism
+ used previously.
-2004-05-03 Miguel Sofer <msofer@users.sf.net>
+2009-07-24 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclProc.c (TclCreateProc): comments corrected.
+ * doc/self.n (self class): [Bug 2704302]: Add some text to make it
+ clearer how to get the name of the current object's class.
-2004-05-03 Miguel Sofer <msofer@users.sf.net>
+2009-07-23 Andreas Kupries <andreask@activestate.com>
- * generic/tclCompile.c (TclCompileScript): setting the compilation
- namespace outside of the loop.
+ * generic/tclIO.c (Tcl_GetChannelHandle): [Bug 2826248]: Do not crash
+ * generic/tclPipe.c (FileForRedirect): for getHandleProc == NULL, this
+ is allowed. Provide a nice error message in the bypass area. Updated
+ caller to check the bypass for a mesage. Bug reported by Andy
+ Sonnenburg <andy22286@users.sourceforge.net>
-2004-05-03 Miguel Sofer <msofer@users.sf.net>
+2009-07-23 Joe Mistachkin <joe@mistachkin.com>
- * generic/tclCompile.c:
- * generic/tclInt.h: reverted fix for [Bug 926445] of 2004-04-02,
- restoring TCL_ALIGN to the header file. Todd Helfter reported that
- the macro is required by tbcload.
+ * generic/tclNotify.c: [Bug 2820349]: Ensure that queued events are
+ freed once processed.
-2004-05-03 Kevin Kenny <kennykb@acm.org>
+2009-07-22 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWin32Dll.c (TclpCheckStackSpace):
- * tests/stack.test (stack-3.1): Fix for undetected stack
- overflow in TclReExec on Windows. [Bug 947070]
+ * macosx/tclMacOSXFCmd.c: CONST -> const
+ * generic/tclGetDate.y:
+ * generic/tclDate.c:
+ * generic/tclLiteral.c: (char *) cast in ckfree call
+ * generic/tclPanic.c: [Feature Request 2814786]: remove TclpPanic
+ * generic/tclInt.h
+ * unix/tclUnixPort.h
+ * win/tclWinPort.h
-2004-05-03 Don Porter <dgp@users.sourceforge.net>
+2009-07-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
- * library/init.tcl: Corrected unique prefix matching of
- interactive command completion in [unknown]. [Bug 946952]
+ * generic/tclEvent.c: [Bug 2001201 again]: Refined the 20090617 patch
+ on [exit] streamlining, so that it now correctly calls thread exit
+ handlers for the calling thread, including <Destroy> bindings in Tk.
-2004-05-02 Miguel Sofer <msofer@users.sf.net>
+2009-07-21 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclProc.c (TclObjInvokeProc):
- * tests/proc.test (proc-3.6): fix for bad quoting of multi-word
- proc names in error messages [Bug 942757]
+ * library/tzdata/Asia/Dhaka:
+ * library/tzdata/Indian/Mauritius: Olson's tzdata2009k.
-2004-04-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-07-20 Donal K. Fellows <dkf@users.sf.net>
- * doc/glob.n, doc/incr.n, doc/set.n: More examples.
- * doc/if.n, doc/rename.n, doc/time.n:
+ * generic/tclCmdMZ.c (StringIsCmd): Reorganize so that [string is] is
+ more efficient when parsing things that are correct, at a cost of
+ making the empty string test slightly more costly. With this, the cost
+ of doing [string is integer -strict $x] matches [catch {expr {$x+0}}]
+ in the successful case, and greatly outstrips it in the failing case.
-2004-04-30 Don Porter <dgp@users.sourceforge.net>
+2009-07-19 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclInt.h: Replaced Kevin Kenny's temporary
- * generic/tclThreadAlloc.c: fix for Bug 945447 with a cleaner,
- more permanent replacement.
+ * generic/tclOO.decls, generic/tclOO.c (Tcl_GetObjectName): Expose a
+ function for efficiently returning the current name of an object.
-2004-04-30 Kevin B. Kenny <kennykb@acm.org>
+2009-07-18 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclThreadAlloc.c: Added a temporary (or so I hope!)
- inclusion of "tclWinInt.h" to avoid problems when compiling
- on Win32-VC++ with --enable-threads. [Bug 945447]
+ * unix/Makefile.in: Define NDEBUG in optimized (non-symbols) build to
+ disable NRE assert()s and threaded allocator range checks.
-2004-04-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-07-16 Don Porter <dgp@users.sourceforge.net>
- * doc/puts.n: Added a few examples.
+ * generic/tclBinary.c: Removed unused variables.
+ * generic/tclCmdIL.c:
+ * generic/tclCompile.c:
+ * generic/tclExecute.c:
+ * generic/tclHash.c:
+ * generic/tclIOUtil.c:
+ * generic/tclVar.c:
-2004-04-29 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c: Silence compiler warnings about ClientData.
+ * generic/tclProc.c:
- * tests/execute.test (execute-8.2): Avoid crashes when there
- is limited system stack space (threads-enabled).
+ * generic/tclScan.c: Typo in ACCEPT_NAN configuration.
+
+ * generic/tclStrToD.c: [Bug 2819200]: Set floating point control
+ register on MIPS systems so that the gradual underflow expected by Tcl
+ is in effect.
+
+2009-07-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (Namespace): Added machinery to allow
+ * generic/tclNamesp.c (many functions): reduction of memory used
+ * generic/tclResolve.c (BumpCmdRefEpochs): by namespaces. Currently
+ #ifdef'ed out because of compatibility concerns.
-2004-04-28 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclInt.decls: Added four functions for better integration
+ with itcl-ng.
- * doc/global.n:
- * doc/upvar.n:
- * generic/tclVar.c (ObjMakeUpvar):
- * tests/upvar.test (upvar-8.11):
- * tests/var.test (var-3.11): Avoid creation of unusable variables:
- [Bug 600812] [TIP 184].
+2009-07-14 Kevin B. Kenny <kennykb@acm.org>
-2004-04-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclInt.h (TclNRSwitchObjCmd):
+ * generic/tclBasic.c (builtInCmds):
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
+ * tests/switch.test (switch-15.1):
+ [Bug 2821401]: Make non-bytecoded [switch] command aware of NRE.
- * doc/lsearch.n: Fixed fault in documentation of -index option [943448]
+2009-07-13 Andreas Kupries <andreask@activestate.com>
-2004-04-26 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex)
+ (TclCleanupByteCode, TclCompileScript):
+ * generic/tclExecute.c (TclCompileObj, TclExecuteByteCode):
+ * tclCompile.h (ExtCmdLoc):
+ * tclInt.h (ExtIndex, CFWordBC, CmdFrame):
+ * tclBasic.c (DeleteInterpProc, TclArgumentBCEnter)
+ (TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT)
+ (RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd):
+ * generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback,
+ (ForNextCallback):
+ * generic/tclCmdMZ.c (TclNRWhileObjCmd):
- * unix/tclUnixFCmd.c (TclpObjNormalizePath): Corrected improper
- positioning of returned checkpoint. [Bug 941108]
+ Extended the bytecode compiler initialization to recognize the
+ compilation of whole files (NRE enabled 'source' command) and switch
+ to the counting of absolute lines in that case.
-2004-04-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ Further extended the bytecode compiler to track the start line in the
+ generated information, and modified the bytecode execution to
+ recompile an object if the location as per the calling context doesn't
+ match the location saved in the bytecode. This part could be optimized
+ more by using more memory to keep all possibilities which occur
+ around, or by just adjusting the location information instead of a
+ total recompile.
- * doc/open.n, doc/close.n: Updated (thanks to David Welton) to be
- clearer about pipeline errors and added example to open(n) that shows
- simple pipeline use. [Patches 941377,941380]
+ Reworked the handling of literal command arguments in bytecode to be
+ saved (compiler) and used (execution) per command (See the
+ TCL_INVOKE_STK* instructions), and not per the whole bytecode. This,
+ and the previous change remove the problems with location data caused
+ by literal sharing (across whole files, but also proc bodies).
+ Simplified the associated datastructures (ExtIndex is gone, as is the
+ function EnterCmdWordIndex).
- * doc/DictObj.3: Added warning about the use of Tcl_DictObjDone and an
- example of use of iteration. [Bug 940843]
+ The last change causes the hashtable 'lineLABCPtr' to be state which
+ has to be kept per coroutine, like the CmdFrame stack. Reworked the
+ coroutine support code to create, delete and switch the information as
+ needed. Further reworked the tailcall command as well, it has to pop
+ its own arguments when run in a bytecode context to keep a proper
+ stack in 'lineLABCPtr'.
- * doc/Thread.3: Reworked to remove references to testing interfaces
- and instead promote the use of the Thread package. [Patch 932527]
- Also reworked and reordered the page for better readability.
+ Fixed the mishandling of line information in the NRE-enabled 'for' and
+ 'while' commands introduced when both were made to share their
+ iteration callbacks without taking into account that the loop body is
+ found in different words of the command. Introduced a separate data
+ structure to hold all the callback information, as we went over the
+ limit of 4 direct client-data values for NRE callbacks.
-2004-04-25 Don Porter <dgp@users.sourceforge.net>
+ The above fixes [Bug 1605269].
- * generic/tcl.h: Removed obsolete declarations and #include's.
- * generic/tclInt.h: [Bugs 926459, 926486]
+2009-07-12 Donal K. Fellows <dkf@users.sf.net>
-2004-04-24 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd):
+ * generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out
+ * generic/tclInt.h (TclIsPureByteArray): the code to determine if
+ * generic/tclUtil.c (TclStringMatchObj): it is safe to work with
+ byte arrays directly, so that we get the check correct _once_.
- * win/tclWin32Dll.c (DllMain): Added DisableThreadLibraryCalls()
- for the DLL_PROCESS_ATTACH case. We're not interested in knowing
- about DLL_THREAD_ATTACH, so disable the notices.
+ * generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed
+ * generic/tclOO.c (TclOOObjectCmdCore): the way that the cache is
+ managed so that when itcl does cunning things, those cunning things
+ can be cached properly.
-2004-04-24 Daniel Steffen <das@users.sourceforge.net>
+2009-07-11 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclPort.h:
- * macosx/Makefile:
- * unix/Makefile.in: followup on tcl header reform [FR 922727]:
- removed use of relative #include paths in tclPort.h to allow
- installation of private headers outside of tcl source tree; added
- 'unix' dir to compiler header search path; add newly required
- tcl private headers to Tcl.framework on Mac OSX.
+ * doc/vwait.n: Substantially increased the discussion of issues and
+ work-arounds relating to nested vwaits, following discussion on the
+ tcl-core mailing list on the topic.
-2004-04-23 Andreas Kupries <andreask@activestate.com>
+2009-07-10 Pat Thoyts <patthoyts@users.sourceforge.net>
- * generic/tclIO.c (Tcl_SetChannelOption): Fixed [SF Tcl Bug
- 930851]. When changing the eofchar we have to zap the related
- flags to prevent them from prematurely aborting the next read.
+ * tests/zlib.test: ZlibTransformClose may be called with a NULL
+ * generic/tclZlib.c: interpreter during finalization and
+ Tcl_SetChannelError requires a list. Added some tests to ensure error
+ propagation from the zlib library to the interp.
-2004-04-25 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-07-09 Pat Thoyts <patthoyts@users.sourceforge.net>
- * generic/tclPathObj.c: fix to [Bug 940281]. Tcl_FSJoinPath
- will now always return a valid Tcl_Obj when the input is valid.
- * generic/tclIOUtil.c: fix to [Bug 931823] for a more consistent
- Tcl_FSPathSeparator() implementation which allows filesystems
- not to implement their Tcl_FSFilesystemSeparatorProc if they
- wish to use the default '/'. Also fixed associated memory leak
- seen with, e.g., tclvfs package.
- * doc/FileSystem.3: documented Tcl_FSJoinPath return values
- more clearly, and Tcl_FSFilesystemSeparatorProc requirements.
+ * tests/zlib.test: [Bug 2818131]: Added tests and fixed a typo that
+ broke [zlib push] for deflate format.
-2004-04-23 David Gravereaux <davygrvy@pobox.com>
+2009-07-09 Donal K. Fellows <dkf@users.sf.net>
- * win/tclWin32Dll.c: Removed my mistake from 4/19 of adding an
- exit handler to TclWinInit. TclWinEncodingsCleanup called from
- TclFinalizeFilesystem does the Tcl_FreeEncoding for us.
+ * compat/mkstemp.c (mkstemp): [Bug 2819227]: Use rand() for random
+ numbers as it is more portable.
- * win/tclWinChan.c (Tcl_MakeFileChannel) : Case for CloseHandle
- returning zero and not throwing a
- RaiseException(EXCEPTION_INVALID_HANDLE) now being done.
+2009-07-05 Donal K. Fellows <dkf@users.sf.net>
-2004-04-22 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclZlib.c (ZlibTransformWatch): Correct the handling of
+ events so that channel transforms work with things like an asynch
+ [chan copy]. Problem reported by Pat Thoyts.
- * generic/tclEvent.c: TclSetLibraryPath's use of caching the
- stringrep of the pathPtr object to TclGetLibraryPath called from
- another thread was ineffective if the original's stringrep had
- been invalidated as what happens when it gets muted to a list.
+2009-07-01 Pat Thoyts <patthoyts@users.sourceforge.net>
- * win/tclWinTime.c: If the Tcl_ExitProc (StopCalibration) is
- called from the stack frame of DllMain's PROCESS_DETACH, the
- wait operation should timeout and continue.
+ * win/tclWinInt.h: [Bug 2806622]: Handle the GetUserName API call
+ * win/tclWin32Dll.c: via the tclWinProcs indirection structure. This
+ * win/tclWinInit.c: fixes a problem obtaining the username when the
+ USERNAME environment variable is unset.
- * generic/tclInt.h:
- * generic/tclThread.c:
- * generic/tclEvent.c:
- * unix/tclUnixThrd.c:
- * win/tclWinThrd.c: Provisions made so masterLock, initLock,
- allocLock and joinLock mutexes can be recovered during
- Tcl_Finalize.
+2009-06-30 Daniel Steffen <das@users.sourceforge.net>
-2004-04-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclInt.h: Add assert macros for clang static
+ * generic/tclPanic.c: analyzer and redefine Tcl_Panic to
+ * generic/tclStubInit.c: assert after panic in clang PURIFY
+ builds.
- * doc/switch.n: Reworked the examples to be more systematically
- named and to cover some TIP#75 capabilities.
+ * generic/tclCmdIL.c: Add clang assert for false positive
+ from static analyzer.
- * doc/cd.n: Documentation clarification from David Welton.
+2009-06-26 Daniel Steffen <das@users.sourceforge.net>
- * doc/exec.n: Added some examples, Windows ones from Arjen Markus
- and Unix ones by myself.
+ * macosx/Tcl-Common.xcconfig: Update projects for Xcode 3.1 and
+ * macosx/Tcl.xcode/*: 3.2, standardize on gcc 4.2, remove
+ * macosx/Tcl.xcodeproj/*: obsolete configurations and pre-Xcode
+ * macosx/Tcl.pbproj/* (removed): project.
-2004-04-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * macosx/README: Update project docs, cleanup.
- * doc/Hash.3: Added note to Tcl_{First,Next}HashEntry docs that
- deleting the element they return is supported (and is in fact the
- only safe update you can do to the structure of a hashtable while
- an iteration is going over it.)
+ * unix/Makefile.in: Update dist target for project
+ changes.
- * doc/bgerror.n: Added example from David Welton. [Patch 939473]
+2009-06-24 Donal K. Fellows <dkf@users.sf.net>
- * doc/after.n: Added examples from David Welton. [Patch 938820]
+ * tests/oo.test (oo-19.1): [Bug 2811598]: Make more resilient.
-2004-04-19 David Gravereaux <davygrvy@pobox.com>
+2009-06-24 Pat Thoyts <patthoyts@users.sourceforge.net>
- * win/tclWin32Dll.c: Added an exit handler in TclWinInit() so
- tclWinTCharEncoding could be freed during Tcl_Finalize().
+ * tests/http11.test: [Bug 2811492]: Clean up procs after testing.
- * generic/tclEncoding.c: Added FreeEncoding(systemEncoding) in
- TclFinalizeEncodingSubsystem because its ref count was incremented
- in TclInitEncodingSubsystem.
+2009-06-18 Donal K. Fellows <dkf@users.sf.net>
-2004-04-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclCkalloc.c (MemoryCmd): [Bug 988703]:
+ * generic/tclObj.c (ObjData, TclFinalizeThreadObjects): Add mechanism
+ for discovering what Tcl_Objs are allocated when built for memory
+ debugging. Developed by Joe Mistachkin.
- * doc/read.n: Added example from David Welton. [Patch 938056]
+2009-06-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-04-19 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclEvent.c: Applied a patch by George Peter Staplin
+ drastically reducing the ambition of [exit] wrt finalization, and
+ thus solving many multi-thread teardown issues. [Bugs 2001201,
+ 486399, and possibly 597575, 990457, 1437595, 2750491]
- * generic/tclObj.c (Tcl_GetDoubleFromObj) Corrected
- "short circuit" conversion of int to double. Reported by
- Jeff Hobbs on the Tcl'ers Chat.
+2009-06-15 Don Porter <dgp@users.sourceforge.net>
-2004-04-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclStringObj.c: sprintf() -> Tcl_ObjPrintf() conversion.
- * doc/lreplace.n, doc/lrange.n, doc/llength.n: More examples for
- * doc/linsert.n, doc/lappend.n: the documentation.
+2009-06-15 Reinhard Max <max@suse.de>
-2004-04-16 Vince Darley <vincentdarley@users.sourceforge.net>
+ * unix/tclUnixPort.h: Move all socket-related code from tclUnixChan.c
+ * unix/tclUnixChan.c: to tclUnixSock.c.
+ * unix/tclUnixSock.c:
- * doc/FileSystem.3: Corrected documentation of Tcl_FSUtime, and
- the corresponding filesystem driver Tcl_FSUtimeProc. [Bug 935838]
+2009-06-15 Donal K. Fellows <dkf@users.sf.net>
-2004-04-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * tools/tcltk-man2html.tcl (make-man-pages): [Patch 557486]: Apply
+ last remaining meaningful part of this patch, a clean up of some
+ closing tags.
- * doc/socket.n: Added example from [Patch 936245].
- * doc/gets.n: Added example based on [Patch 935911].
+2009-06-13 Don Porter <dgp@users.sourceforge.net>
-2004-04-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclCompile.c: [Bug 2802881]: The value stashed in
+ * generic/tclProc.c: iPtr->compiledProcPtr when compiling a proc
+ * tests/execute.test: survives too long. We only need it there long
+ enough for the right TclInitCompileEnv() call to re-stash it into
+ envPtr->procPtr. Once that is done, the CompileEnv controls. If we
+ let the value of iPtr->compiledProcPtr linger, though, then any other
+ bytecode compile operation that takes place will also have its
+ CompileEnv initialized with it, and that's not correct. The value is
+ meant to control the compile of the proc body only, not other compile
+ tasks that happen along. Thanks to Carlos Tasada for discovering and
+ reporting the problem.
- * generic/tclClock.c (Tcl_ClockObjCmd): Minor fault in a [clock
- clicks] error message.
+2009-06-10 Don Porter <dgp@users.sourceforge.net>
-2004-04-07 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclStringObj.c: [Bug 2801413]: Revised [format] to not
+ overflow the integer calculations computing the length of the %ll
+ formats of really big integers. Also added protections so that
+ [format]s that would produce results overflowing the maximum string
+ length of Tcl values throw a normal Tcl error instead of a panic.
- * win/tclWinInit.c (TclpSetInitialEncodings): note that WIN32_CE
- is also a unicode platform.
- * generic/tclEncoding.c (TclFindEncodings, Tcl_FindExecutable):
- * generic/tclInt.h: Correct handling of UTF
- * unix/tclUnixInit.c (TclpInitLibraryPath): data that is actually
- * win/tclWinFile.c (TclpFindExecutable): "clean", allowing the
- * win/tclWinInit.c (TclpInitLibraryPath): loading of Tcl from
- paths that contain multi-byte chars on Windows [Bug 920667]
+ * generic/tclStringObj.c: [Bug 2803109]: Corrected failures to
+ deal with the "pure unicode" representation of an empty string.
+ Thanks to Julian Noble for reporting the problem.
- * win/configure: define TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC,
- * win/configure.in: TCL_LIB_SPEC, TCL_PACKAGE_PATH in tclConfig.sh.
+2006-06-09 Kevin B. Kenny <kennykb@acm.org>
-2004-04-06 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclGetDate.y: Fixed a thread safety bug in the generated
+ * library/clock.tcl: Bison parser (needed a %pure-parser
+ * tests/clock.test: declaration to avoid static variables).
+ Discovered that the %pure-parser declaration
+ allowed for returning the Bison error message
+ to the Tcl caller in the event of a syntax
+ error, so did so.
+ * generic/tclDate.c: bison 2.3
- Patch 922727 committed. Implements three changes:
+2006-06-08 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclInt.h: Reworked the Tcl header files into a clean
- * unix/tclUnixPort.h: hierarchy where tcl.h < tclPort.h < tclInt.h
- * win/tclWinInt.h: and every C source file should #include
- * win/tclWinPort.h: at most one of those files to satisfy its
- declaration needs. tclWinInt.h and tclWinPort.h also better organized
- so that tclWinPort.h includes the Windows implementation of
- cross-platform declarations, while tclWinInt.h makes declarations that
- are available on Windows only.
+ * library/tzdata/Asia/Dhaka: New DST rule for Bangladesh. (Olson's
+ tzdata2009i.)
- * generic/tclBinary.c (TCL_NO_MATH): Deleted the generic/tclMath.h
- * generic/tclMath.h (removed): header file. The internal Tcl
- * macosx/Makefile (PRIVATE_HEADERS): header, tclInt.h, has a
- * win/tcl.dsp: #include <math.h> directly,
- and file external to Tcl needing libm should do the same.
+2009-06-08 Donal K. Fellows <dkf@users.sf.net>
- * win/Makefile.in (WIN_OBJS): Deleted the win/tclWinMtherr.c file.
- * win/makefile.bc (TCLOBJS): It's a vestige from matherr() days
- * win/makefile.vc (TCLOBJS): gone by.
- * win/tcl.dsp:
- * win/tclWinMtherr.c (removed):
+ * doc/copy.n: Fix error in example spotted by Venkat Iyer.
- End Patch 922727.
+2009-06-02 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test (unixInit-3.1): Default encoding on Darwin
- systems is utf-8. Thanks to Steven Abner (tauvan). [Bug 928808]
+ * generic/tclExecute.c: Replace dynamically-initialized table with a
+ table of static constants in the lookup table for exponent operator
+ computations that fit in a 64 bit integer result.
-2004-04-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclExecute.c: [Bug 2798543]: Corrected implementations and
+ selection logic of the INST_EXPON instruction.
- * tests/cmdAH.test (cmdAH-18.2): Added constraint because
- access(...,X_OK) is defined to be permitted to be meaningless when
- running as root, and OSX exhibits this. [Bug 929892]
+2009-06-01 Don Porter <dgp@users.sourceforge.net>
-2004-04-02 Miguel Sofer <msofer@users.sf.net>
+ * tests/expr.test: [Bug 2798543]: Added many tests demonstrating
+ the broken cases.
- * generic/tclCompile.c:
- * generic/tclInt.h: removed the macro TCL_ALIGN() from tclInt.h,
- replaced by the static macro ALIGN() in tclCompile.c [Bug 926445]
+009-05-30 Kevin B. Kenny <kennykb@acm.org>
-2004-04-02 Miguel Sofer <msofer@users.sf.net>
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/Asia/Amman: Olson's tzdata2009h.
- * generic/tclCompile.h: removed redundant #ifdef _TCLINT
- [Bug 928415], reported by tauvan.
+2009-05-29 Andreas Kupries <andreask@activestate.com>
-2004-04-02 Don Porter <dgp@users.sourceforge.net>
+ * library/platform/platform.tcl: Fixed handling of cpu ia64,
+ * library/platform/pkgIndex.tcl: taking ia64_32 into account
+ * unix/Makefile.in: now. Bumped version to 1.0.5. Updated the
+ * win/Makefile.in: installation commands.
- * tests/tcltest.test: Corrected constraint typos: "nonRoot" ->
- "notRoot". Thanks to Steven Abner (tauvan). [Bug 928353]
+2009-05-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-04-01 Don Porter <dgp@users.sourceforge.net>
+ * doc/expr.n: Fixed documentation of the right-associativity of
+ the ** operator. (spotted by kbk)
- * generic/tclInt.h: Removed obsolete tclBlockTime* declarations.
- [Bug 926454]
+2009-05-14 Donal K. Fellows <dkf@users.sf.net>
-2004-04-01 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclOOInfo.c (InfoObjectNsCmd): Added introspection mechanism
+ for finding out what an object's namespace is. Experience suggests
+ that it is just too useful to be able to do without it.
- * generic/tclIOUtil.c: Fix to privately reported vfs bug with
- 'glob -type d -dir . *' across a vfs boundary. No tests for
- this are currently possible without effectively moving tclvfs
- into Tcl's test suite.
+2009-05-12 Donal K. Fellows <dkf@users.sf.net>
-2004-03-31 Don Porter <dgp@users.sourceforge.net>
+ * doc/vwait.n: Added more words to make it clear just how bad it is to
+ nest [vwait]s.
- * doc/msgcat.n: Clarified message catalog file encodings. [Bug 811457]
- * library/msgcat/msgcat.tcl:
- Updated internals to make use of [dict]s to store message catalog
- data and to use [source -encoding utf-8] to access catalog files.
- Thanks to Michael Sclenker. [Patch 875055, RFE 811459]
- Corrected [mcset] to be able to successfully set a translation to
- the empty string. [mcset $loc $src {}] was incorrectly set the
- $loc translation of $src back to $src. Also changed [ConvertLocale]
- to minimally require a non-empty "language" part in the locale value.
- If not, an error raised prompts [Init] to keep looking for a valid
- locale value, or ultimately fall back on the "C" locale. [Bug 811461].
- * library/msgcat/pkgIndex.tcl: Bump to msgcat 1.4.1.
+ * compat/mkstemp.c: Add more headers to make this file build on IRIX
+ 6.5. Thanks to Larry McVoy for this.
-2004-03-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-05-08 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclHash.c (HashStringKey): Cleaned up. This function is
- not faster, but it is a little bit clearer.
- * generic/tclLiteral.c (HashString): Applied logic from HashObjKey.
- * generic/tclObj.c (HashObjKey): Rewrote to fix fault which hashed
- every single-character object to the same hash bucket. The new
- code is shorter, simpler, clearer, and (happily) faster.
+ * generic/tclOO.c (TclNRNewObjectInstance): [Bug 2414858]: Add a
+ * generic/tclBasic.c (TclPushTailcallPoint): marker to the stack of
+ NRE callbacks at the right point so that tailcall works correctly in a
+ constructor.
-2004-03-30 Miguel Sofer <msofer@users.sf.net>
+ * tests/exec.test (cat): [Bug 2788468]: Adjust the scripted version of
+ cat so that it does not perform transformations on the data it is
+ working with, making it more like the standard Unix 'cat' program.
- * generic/tclExecute.c (TEBC): reverting to the previous method
- for async tests in TEBC, as the new method turned out to be too
- costly. Async tests now run every 64 instructions.
+2009-05-07 Miguel Sofer <msofer@users.sf.net>
-2004-03-30 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2785893]: Ensure that
+ a command in a deleted namespace can't be found through a cached name.
- * generic/tclCompile.c: New instruction code INST_START_CMD
- * generic/tclCompile.h: that allows checking the bytecode's
- * generic/tclExecute.c: validity [Bug 729692] and the interp's
- * tests/interp.test (18.9): readyness [Bug 495830] before running
- * tests/proc.test (7.1): the command. It also changes the
- * tests/rename.test (6.1): mechanics of the async tests in TEBC,
- doing it now at command start instead of every 16 instructions.
+ * generic/tclBasic.c: Let coroutines start with a much smaller
+ * generic/tclCompile.h: stack: 200 words (previously was 2000, the
+ * generic/tclExecute.c: same as interps).
-2004-03-30 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-05-07 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclFileName.c: Fix to Windows glob where the pattern is
- * generic/tclIOUtil.c: a volume relative path or a network
- * tests/fileName.test: share [Bug 898238]. On windows 'glob'
- * tests/fileSystem.test: will now return the results of
- 'glob /foo/bar' and 'glob \\foo\\bar' as 'C:/foo/bar', i.e. a
- correct absolute path (rather than a volume relative path).
+ * tests/env.test (printenvScript, env-4.3, env-4.5): [Bug 1513659]:
+ * tests/exec.test (exec-2.6): These tests had subtle dependencies on
+ being on platforms that were either ISO 8859-1 or UTF-8. Stabilized
+ the results by forcing the encoding.
- Note that the test suite does not test commands like
- 'glob //Machine/Shared/*' (on a network share).
+2009-05-06 Don Porter <dgp@users.sourceforge.net>
-2004-03-30 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclCmdMZ.c: [Bug 2582327]: Improve overflow error message
+ from [string repeat].
- * generic/tclPathObj.c: Fix to filename bugs recently
- * tests/fileName.test: introduced [Bug 918320].
+ * tests/interp.test: interp-20.50 test for Bug 2486550.
-2004-03-29 Don Porter <dgp@users.sourceforge.net>
+2009-05-04 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclMain.c (Tcl_Main, StdinProc): Append newline only
- * tests/basic.test (basic-46.1): to incomplete scripts
- as part of multi-line script construction. Do not add an extra
- trailing newline to the complete script. [Bug 833150]
+ * generic/tclOO.c (InitFoundation, AllocObject, AllocClass):
+ * generic/tclOODefineCmds.c (InitDefineContext): Make sure that when
+ support namespaces are deleted, nothing bad can subsequently happen.
+ Issue spotted by Don Porter.
-2004-03-28 Miguel Sofer <msofer@users.sf.net>
+2009-05-03 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclCompile.c (TclCompileScript): corrected possible
- segfault when a compilation returns TCL_OUTLINE_COMPILE after
- having grown the compile environment [Bug 925121].
+ * doc/Tcl.n: [Bug 2538432]: Clarified exact treatment of ${arr(idx)}
+ form of variable substitution. This is not a change of behavior, just
+ an improved description of the current situation.
-2004-03-27 Miguel Sofer <msofer@users.sf.net>
+2009-04-30 Miguel Sofer <msofer@users.sf.net>
- * doc/array.n: added documentation for trace-realted behaviour of
- 'array get' [Bug 449893]
+ * generic/tclBasic.c (TclObjInvoke): [Bug 2486550]: Make sure that a
+ null objProc is not used, use Tcl_NRCallObjProc instead.
-2004-03-26 Don Porter <dgp@users.sourceforge.net>
+2009-05-01 Jan Nijtmans <nijtmans@users.sf.net>
- * README: Bumped version number to 8.5a2 to
- * tools/tcl.wse.in: distinguish HEAD of CVS development
- * unix/configure.in: from the recent 8.5a1 release.
- * unix/tcl.spec:
- * win/README.binary:
- * win/configure.in:
+ * win/configure.in Fix 64-bit detection for zlib on Win64
+ * win/configure (regenerated)
- * unix/configure: autoconf-2.57
- * win/configure:
+2009-04-28 Jeff Hobbs <jeffh@ActiveState.com>
-2004-03-26 Vince Darley <vincentdarley@users.sourceforge.net>
+ * unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check to
+ add _r to CC on AIX with threads.
- * generic/tclPathObj.c: Fix to Windows-only volume relative
- * tests/fileSystem.test: path normalization. [Bug 923568].
- Also fixed another volume relative bug found while testing.
+2009-04-27 Donal K. Fellows <dkf@users.sf.net>
-2004-03-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * doc/concat.n (EXAMPLES): [Bug 2780680]: Rewrote so that the spacing
+ of result messages is correct. (The exact way they were wrong was
+ different when rendered through groff or as HTML, but it was still
+ wrong both ways.)
- * generic/tclNamesp.c (NsEnsembleImplementationCmd): Fix messed up
- handling of strncmp result which just happened to work in some
- libc implementations. [Bug 922752]
+2009-04-27 Jan Nijtmans <nijtmans@users.sf.net>
-2004-03-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclIndexObj.c: Reset internal INTERP_ALTERNATE_WRONG_ARGS
+ * generic/tclIOCmd.c: flag inside the Tcl_WrongNumArgs function,
+ so the caller no longer has to do the reset.
- * doc/StringObj.3: Inverted the sense of the documentation of how
- the bytes parameter is documented to match behaviour. [Bug 921464]
+2009-04-24 Stuart Cassoff <stwo@users.sf.net>
-2004-03-19 Kevin B. Kenny <kennykb@acm.org>
+ * unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage.
- * compat/strtoll.c:
- * compat/strtoull.c:
- * generic/tclIntDecls.h:
- * generic/tclMain.c:
- * generic/tclObj.c:
- * win/tclWinDde.c:
- * win/tclWinReg.c:
- * win/tclWinTime.c: Made HEAD build on Windows VC++ again.
+2009-04-19 Pat Thoyts <patthoyts@users.sourceforge.net>
-2004-03-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * library/http/http.tcl: [Bug 2715421]: Removed spurious newline added
+ * tests/http11.test: after POST and added tests to detect excess
+ * tests/httpd11.tcl: bytes being POSTed.
+ * library/http/pkgIndex.tcl:
+ * makefiles: package version now 2.8.1
- * generic/tclIntDecls.h: Made HEAD build on Solaris again by
- applying fix recommended by Don Porter.
+2009-04-15 Donal K. Fellows <dkf@users.sf.net>
-2004-03-18 Reinhard Max <max@suse.de>
+ * doc/chan.n, doc/close.n: Tidy up documentation of TIP #332.
- * generic/tclIntDecls.h: Removed TclpTime_t. It wasn't really needed,
- * generic/tclInt.h: but caused warnings related to
- * generic/tclInt.decls: strict aliasing with GCC 3.3.
- * generic/tclClock.c:
- * generic/tclDate.c:
- * generic/tclGetDate.y:
- * win/tclWinTime.c:
- * unix/tclUnixTime.c:
+2009-04-14 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclNamesp.c: Added temporary pointer variables to work
- * generic/tclStubLib.c: around warnings related to
- * unix/tclUnixChan.c: strict aliasing with GCC 3.3.
+ * library/tzdata/Asia/Karachi: Updated rules for Pakistan Summer
+ Time (Olson's tzdata2009f)
- * unix/tcl.m4: Removed -Wno-strict-aliasing.
+2009-04-11 Donal K. Fellows <dkf@users.sf.net>
-2004-03-18 Daniel Steffen <das@users.sourceforge.net>
+ * generic/tclOOMethod.c (InvokeForwardMethod): Clarify the resolution
+ behaviour of the name of the command that is forwarded to: it's now
+ resolved using the object's namespace as context, which is much more
+ useful than the previous (somewhat random) behaviour of using the
+ caller's current namespace.
- Removed support for Mac OS Classic platform [Patch 918142]
+2009-04-10 Pat Thoyts <patthoyts@users.sourceforge.net>
- * README:
- * compat/string.h:
- * doc/Encoding.3:
- * doc/FileSystem.3:
- * doc/Init.3:
- * doc/Macintosh.3 (removed):
- * doc/OpenFileChnl.3:
- * doc/OpenTcp.3:
- * doc/SourceRCFile.3:
- * doc/Thread.3:
- * doc/clock.n:
- * doc/exec.n:
- * doc/fconfigure.n:
- * doc/file.n:
- * doc/filename.n:
- * doc/glob.n:
- * doc/open.n:
- * doc/puts.n:
- * doc/resource.n (removed):
- * doc/safe.n:
- * doc/source.n:
- * doc/tclvars.n:
- * doc/unload.n:
- * generic/README:
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclAlloc.c:
- * generic/tclBasic.c:
- * generic/tclCmdAH.c:
- * generic/tclDate.c:
- * generic/tclDecls.h:
- * generic/tclFCmd.c:
- * generic/tclFileName.c:
- * generic/tclGetDate.y:
- * generic/tclIOCmd.c:
- * generic/tclIOUtil.c:
- * generic/tclInitScript.h:
- * generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclMain.c:
- * generic/tclMath.h:
- * generic/tclNotify.c:
- * generic/tclPathObj.c:
- * generic/tclPlatDecls.h:
- * generic/tclPort.h:
- * generic/tclStubInit.c:
- * generic/tclTest.c:
- * generic/tclThreadJoin.c:
- * library/auto.tcl:
- * library/init.tcl:
- * library/package.tcl:
- * library/safe.tcl:
- * library/tclIndex:
- * mac/AppleScript.html (removed):
- * mac/Background.doc (removed):
- * mac/MW_TclAppleScriptHeader.h (removed):
- * mac/MW_TclAppleScriptHeader.pch (removed):
- * mac/MW_TclBuildLibHeader.h (removed):
- * mac/MW_TclBuildLibHeader.pch (removed):
- * mac/MW_TclHeader.h (removed):
- * mac/MW_TclHeader.pch (removed):
- * mac/MW_TclHeaderCommon.h (removed):
- * mac/MW_TclStaticHeader.h (removed):
- * mac/MW_TclStaticHeader.pch (removed):
- * mac/MW_TclTestHeader.h (removed):
- * mac/MW_TclTestHeader.pch (removed):
- * mac/README (removed):
- * mac/bugs.doc (removed):
- * mac/libmoto.doc (removed):
- * mac/morefiles.doc (removed):
- * mac/porting.notes (removed):
- * mac/tclMac.h (removed):
- * mac/tclMacAETE.r (removed):
- * mac/tclMacAlloc.c (removed):
- * mac/tclMacAppInit.c (removed):
- * mac/tclMacApplication.r (removed):
- * mac/tclMacBOAAppInit.c (removed):
- * mac/tclMacBOAMain.c (removed):
- * mac/tclMacChan.c (removed):
- * mac/tclMacCommonPch.h (removed):
- * mac/tclMacDNR.c (removed):
- * mac/tclMacEnv.c (removed):
- * mac/tclMacExit.c (removed):
- * mac/tclMacFCmd.c (removed):
- * mac/tclMacFile.c (removed):
- * mac/tclMacInit.c (removed):
- * mac/tclMacInt.h (removed):
- * mac/tclMacInterupt.c (removed):
- * mac/tclMacLibrary.c (removed):
- * mac/tclMacLibrary.r (removed):
- * mac/tclMacLoad.c (removed):
- * mac/tclMacMath.h (removed):
- * mac/tclMacNotify.c (removed):
- * mac/tclMacOSA.c (removed):
- * mac/tclMacOSA.r (removed):
- * mac/tclMacPanic.c (removed):
- * mac/tclMacPkgConfig.c (removed):
- * mac/tclMacPort.h (removed):
- * mac/tclMacProjects.sea.hqx (removed):
- * mac/tclMacResource.c (removed):
- * mac/tclMacResource.r (removed):
- * mac/tclMacSock.c (removed):
- * mac/tclMacTclCode.r (removed):
- * mac/tclMacTest.c (removed):
- * mac/tclMacThrd.c (removed):
- * mac/tclMacThrd.h (removed):
- * mac/tclMacTime.c (removed):
- * mac/tclMacUnix.c (removed):
- * mac/tclMacUtil.c (removed):
- * mac/tcltkMacBuildSupport.sea.hqx (removed):
- * tests/all.tcl:
- * tests/binary.test:
- * tests/cmdAH.test:
- * tests/cmdMZ.test:
- * tests/fCmd.test:
- * tests/fileName.test:
- * tests/fileSystem.test:
- * tests/interp.test:
- * tests/io.test:
- * tests/ioCmd.test:
- * tests/load.test:
- * tests/macFCmd.test (removed):
- * tests/osa.test (removed):
- * tests/resource.test (removed):
- * tests/socket.test:
- * tests/source.test:
- * tests/unload.test:
- * tools/cvtEOL.tcl (removed):
- * tools/genStubs.tcl:
- * unix/Makefile.in:
- * unix/README:
- * unix/mkLinks:
- * unix/tcl.spec:
- * win/README.binary:
- * win/tcl.dsp:
+ * library/http/http.tcl: Improved HTTP/1.1 support and added
+ * library/http/pkgIndex.tcl: specific HTTP/1.1 testing to ensure
+ * tests/http11.test: we handle chunked+gzip for the various
+ * tests/httpd11.test: modes (normal, -channel and -handler)
+ * makefiles: package version set to 2.8.0
-2004-03-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-04-10 Daniel Steffen <das@users.sourceforge.net>
- * doc/lsearch.n: Improved examples on the advanced capabilities of
- lsearch (with the right options, set element removal can be done)
- following discussion on tkchat.
+ * unix/tclUnixChan.c: TclUnixWaitForFile(): use FD_* macros
+ * macosx/tclMacOSXNotify.c: to manipulate select masks (Cassoff).
+ [FRQ 1960647] [Bug 3486554]
-2004-03-16 Don Porter <dgp@users.sourceforge.net>
+ * unix/tclLoadDyld.c: Use RTLD_GLOBAL instead of RTLD_LOCAL.
+ [Bug 1961211]
- * doc/catch.n: Compiled [catch] no longer fails to catch syntax
- errors. Removed the claims in the documentation that it does.
- * doc/return.n: Updated example to use [dict merge].
+ * macosx/tclMacOSXNotify.c: revise CoreFoundation notifier to allow
+ embedding into applications that
+ already have a CFRunLoop running and
+ want to run the tcl event loop via
+ Tcl_ServiceModeHook(TCL_SERVICE_ALL).
-2004-03-16 Jeff Hobbs <jeffh@ActiveState.com>
+ * macosx/tclMacOSXNotify.c: add CFRunLoop based Tcl_Sleep() and
+ * unix/tclUnixChan.c: TclUnixWaitForFile() implementations
+ * unix/tclUnixEvent.c: and disable select() based ones in
+ CoreFoundation builds.
- * unix/configure, unix/tcl.m4: add -Wno-strict-aliasing for GCC to
- suppress useless type puning warnings.
+ * unix/tclUnixNotify.c: simplify, sync with tclMacOSXNotify.c.
-2004-03-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclInt.decls: add TclMacOSXNotifierAddRunLoopMode()
+ * generic/tclIntPlatDecls.h: internal API, regen.
+ * generic/tclStubInit.c:
- * doc/file.n: *roff formatting fix. [Bug 917171]
+ * unix/configure.in (Darwin): use Darwin SUSv3 extensions if
+ available; remove /Network locations
+ from default tcl package search path
+ (NFS mounted locations and thus slow).
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
-2004-03-15 David Gravereaux <davygrvy@pobox.com>
+ * macosx/tclMacOSXBundle.c: on Mac OS X 10.4 and later, replace
+ deprecated NSModule API by dlfcn API.
- * win/tclWinNotify.c: Fixed a mistake where the return value of
- MsgWaitForMultipleObjectsEx for "a message is in the queue" wasn't
- accurate. I removed the check on the case result==(WAIT_OBJECT_0 + 1)
- This was having the error of falling into GetMessage and waiting
- there by accident, which wasn't alertable through Tcl_AlertNotifier.
- I'll do some more study on this and try to find-out why.
+2009-04-10 Donal K. Fellows <dkf@users.sf.net>
-2004-03-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * doc/StringObj.3: [Bug 2089279]: Corrected example so that it works
+ on 64-bit machines as well.
- IMPLEMENTATION OF TIP#163
- * generic/tclDictObj.c (DictMergeCmd): This is based on work by Joe
- * tests/dict.test (dict-20.*): English in Tcl [FRQ 745851]
- * doc/dict.n: but not exactly.
+2009-04-10 Pat Thoyts <patthoyts@users.sourceforge.net>
-2004-03-10 Kevin B. Kenny <kennykb@acm.org>
+ * tests/http.test: [Bug 26245326]: Added specific check for problem
+ * tests/httpd: (return incomplete HTTP response header).
- * generic/tclGetDate.y (TclGetDate): Fix so that
- [clock scan <timeOfDay> -gmt true] uses the GMT base date
- instead of the local one. [Bug 913513]
- * tests/clock.test: Added test cases for wrong ISO8601 week number
- [Bug 500285] and wrong GMT base date [Bug 913513]. Several tests
- still fail on Windows, and these are actual faults in [clock scan].
- Fix is still pending.
- * generic/tclDate.c: Regenerated.
+2009-04-08 Kevin B. Kenny <kennykb@acm.org>
-2004-03-08 Vince Darley <vincentdarley@users.sourceforge.net>
+ * tools/tclZIC.tcl: Always emit files with Unix line termination.
+ * library/tzdata: Olson's tzdata2009e
- * generic/tclFileName.c: Fix to 'glob -path' near the root
- * tests/fileName.test: of the filesystem. [Bug 910525]
+2009-04-09 Don Porter <dgp@users.sourceforge.net>
-2004-03-08 Don Porter <dgp@users.sourceforge.net>
+ * library/http/http.tcl: [Bug 26245326]: Handle incomplete
+ lines in the "connecting" state. Thanks to Sergei Golovan.
- * generic/tclParse.c (TclParseInit): Modified TclParseInit so
- * generic/tclTest.c ([testexprparser]): that Tcl_Parse initialization
- conforms to documented promised about what fields will not be
- modified by what Tcl_Parse* routines. [Bug 910595]
+2009-04-08 Andreas Kupries <andreask@activestate.com>
-2004-03-05 Mo DeJong <mdejong@users.sourceforge.net>
+ * library/platform/platform.tcl: Extended the darwin sections to add
+ * library/platform/pkgIndex.tcl: a kernel version number to the
+ * unix/Makefile.in: identifier for anything from Leopard (10.5) on up.
+ * win/Makefile.in: Extended patterns for same. Extended cpu
+ * doc/platform.n: recognition for 64bit Tcl running on a 32bit kernel
+ on a 64bit processor (By Daniel Steffen). Bumped version to 1.0.4.
+ Updated Makefiles.
- * win/configure: Regen.
- * win/configure.in: Check for define of
- MWMO_ALERTABLE in winuser.h.
- * win/tclWinPort.h: If MWMO_ALERTABLE
- is not defined in winuser.h then define it.
- This is needed for Mingw.
+2009-04-08 Don Porter <dgp@users.sourceforge.net>
-2004-03-05 Kevin B. Kenny <kennykb@acm.org>
+ * library/tcltest/tcltest.tcl: [Bug 2570363]: Converted [eval]s (some
+ * library/tcltest/pkgIndex.tcl: unsafe!) to {*} in tcltest package.
+ * unix/Makefile.in: => tcltest 2.3.1
+ * win/Makefile.in:
- * generic/tclTest.c: Modified TesteventObjCmd to use
- a Tcl_QueuePosition in place of an 'int' for the enumerated
- queue position, to avoid a compiler warning on SGI.
- (Bug #771960).
+2009-04-07 Don Porter <dgp@users.sourceforge.net>
-2004-03-05 Kevin B. Kenny <kennykb@acm.org>
+ * generic/tclStringObj.c: Correction so that value of
+ TCL_GROWTH_MIN_ALLOC is everywhere expressed in bytes as comment
+ claims.
- * tests/registry.test: Applied fix from Patch #910174 to
- make the test for an English-language system include any
- country code, rather than just English-United States.1252.
- Thanks to Pat Thoyts for the changes.
+2009-04-04 Donal K. Fellows <dkf@users.sf.net>
-2004-03-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+ * doc/vwait.n: [Bug 1910136]: Extend description and examples to make
+ it clearer just how this command interprets variable names.
- * tests/registry.test: Applied fixed from #766159 to skip two
- tests on Win98 that depend on a Unicode registry (NT specific).
+2009-03-30 Don Porter <dgp@users.sourceforge.net>
-2004-03-04 Don Porter <dgp@users.sourceforge.net>
+ * doc/Alloc.3: [Bug 2556263]: Size argument is "unsigned int".
- * generic/tclInt.h (TclParseInit): Factored the common code
- * generic/tclParse.c (TclParseInit): for initializing a Tcl_Parse
- * generic/tclParseExpr.c: struct into one routine.
+2009-03-27 Don Porter <dgp@users.sourceforge.net>
-2004-03-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+ * generic/tclPathObj.c (TclPathPart): [Bug 2710920]: TclPathPart()
+ * tests/fileName.test: was computing the wrong results for both [file
+ dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0
+ intrep and with an empty string for the "joined-on" part.
- * library/reg/pkgIndex.tcl: Added TIP #100 support to the
- * win/tclWinReg.c: registry package (patch #903831)
- This provides a Windows test of the TIP #100 mechanism and
- a sample to show how unloading an extension can be done.
+2009-03-25 Jan Nijtmans <nijtmans@users.sf.net>
-2004-03-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * doc/tclsh.1: Bring doc and tools in line with
+ * tools/installData.tcl: http://wiki.tcl.tk/812
+ * tools/str2c
+ * tools/tcltk-man2html.tcl
- * unix/dltest/pkgua.c: Fix minor syntax problems. [Bug 909288]
+2009-03-25 Donal K. Fellows <dkf@users.sf.net>
-2004-03-03 Jeff Hobbs <jeffh@ActiveState.com>
+ * doc/coroutine.n: [Bug 2152285]: Added basic documentation for the
+ coroutine and yield commands.
- *** 8.5a1 TAGGED FOR RELEASE ***
+2009-03-24 Donal K. Fellows <dkf@users.sf.net>
- * changes: updated for 8.5a1
+ * generic/tclOOBasic.c (TclOOSelfObjCmd): [Bug 2704302]: Make 'self
+ class' better defined in the context of objects that change class.
-2004-03-03 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclVar.c (Tcl_UpvarObjCmd): [Bug 2673163] (ferrieux)
+ * generic/tclProc.c (TclObjGetFrame): Make the upvar command more able
+ to handle its officially documented syntax.
- * win/makefile.vc: default environment variable for VC++ is
- %MSDevDir% not %MSVCDir%, although vcvars32.bat sets both.
+2009-03-22 Miguel Sofer <msofer@users.sf.net>
- * win/tclWinNotify.c (Tcl_WaitForEvent) : Allows an idling
- notifier to service "Asynchronous Procedure Calls" from its wait
- state. Only useful for extension authors who decide they might
- want to try "completion routines" with WriteFileEx(), as an
- example. From experience, I recommend that "completion ports"
- should be used instead as the execution of the callbacks are more
- managable.
+ * generic/tclBasic.c: [Bug 2502037]: NR-enable the handling of unknown
+ commands.
-2004-03-01 Jeff Hobbs <jeffh@ActiveState.com>
+2009-03-21 Miguel Sofer <msofer@users.sf.net>
- * README: update patchlevel to 8.5a1
- * generic/tcl.h:
- * tools/tcl.wse.in, tools/tclSplash.bmp:
- * unix/configure, unix/configure.in, unix/tcl.spec:
- * win/README.binary, win/configure, win/configure.in:
+ * generic/tclBasic.c: Fixed "leaks" in aliases, imports and
+ * generic/tclInt.h: ensembles. Only remaining known leak is in
+ * generic/tclInterp.c: ensemble unknown dispatch (as it not
+ * generic/tclNamesp.c: NR-enabled)
+ * tests/tailcall.test:
- * unix/tcl.m4: update HP-11 build libs setup
+ * tclInt.h: comments
-2004-03-01 Don Porter <dgp@users.sourceforge.net>
+ * tests/tailcall.test: Added tests to show that [tailcall] does not
+ currently always execute in constant space: interp-alias, ns-imports
+ and ensembles "leak" as of this commit.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow 64-bit enabling on
- IRIX64-6.5* systems. [Bug 218561]
- * unix/configure: autoconf-2.57
+ * tests/nre.test: [foreach] has been NR-enabled for a while, the test
+ was marked 'knownBug': unmark it.
- * generic/tclTrace.c (TclCheckInterpTraces): The TIP 62
- * generic/tclTest.c (TestcmdtraceCmd): implementation introduced a
- * tests/trace.test (trace-29.10): bug by testing the CallFrame
- level instead of the iPtr->numLevels level when deciding what traces
- created by Tcl_Create(Obj)Trace to call. Added test to expose the
- error, and made fix. [Request 462580]
+ * generic/tclBasic.c: Fix for (among others) [Bug 2699087]
+ * generic/tclCmdAH.c: Tailcalls now perform properly even from
+ * generic/tclExecute.c: within [eval]ed scripts.
+ * generic/tclInt.h: More tests missing, as well as proper
+ exploration and testing of the interaction with "redirectors" like
+ interp-alias (suspect that it does not happen in constant space)
+ and pure-eval commands.
-2004-02-28 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclExecute.c: Proper fix for [Bug 2415422]. Reenabled
+ * tests/nre.test: the failing assertion that was disabled on
+ 2008-12-18: the assertion is correct, the fault was in the
+ management of expansions.
- * tests/fileSystem.test: fix to Tcl Bug 905163.
- * tests/fileName.test: fix to Tcl Bug 904705.
+ * generic/tclExecute.c: Fix both test and code for tailcall
+ * tests/tailcall.test: from within a compiled [eval] body.
- * doc/{various}.n: removed 'the the' typos.
+ * tests/tailcall.test: Slightly improved tests
-2004-02-26 Daniel Steffen <das@users.sourceforge.net>
+2009-03-20 Don Porter <dgp@users.sourceforge.net>
- * macosx/Makefile: fixed copyright year in Tcl.framework Info.plist
+ * tests/stringObj.test: [Bug 2597185]: Test stringObj-6.9
+ checks that Tcl_AppendStringsToObj() no longer crashes when operating
+ on a pure unicode value.
-2004-02-25 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclExecute.c (INST_CONCAT1): [Bug 2669109]: Panic when
+ appends overflow the max length of a Tcl value.
- * tests/basic.test: Made several tests more robust to the
- * tests/cmdMZ.test: list-quoting of path names that might
- * tests/exec.test: contain Tcl-special chars like { or [.
- * tests/io.test: Should help us sort out Tcl Bug 554068.
- * tests/pid.test:
- * tests/socket.test:
- * tests/source.test:
- * tests/unixInit.test:
+2009-03-19 Miguel Sofer <msofer@users.sf.net>
-2004-02-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tcl.h:
+ * generic/tclInt.h:
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall
+ implementation, ::unsupported::atProcExit is (temporarily?) gone. The
+ new approach is much simpler, and also closer to being correct. This
+ commit fixes [Bug 2649975] and [Bug 2695587].
- * generic/tclLoad.c (Tcl_LoadObjCmd): Missing dereference caused
- segfault with non-loadable extension. [Bug 904307]
+ * tests/coroutine.test: Moved the tests to their own files,
+ * tests/tailcall.test: removed the unsupported.test. Added
+ * tests/unsupported.test: tests for the fixed bugs.
- * unix/tclUnixChan.c (TcpGetOptionProc): Stop memory leak with
- very long hostnames. [Bug 888777]
+2009-03-19 Donal K. Fellows <dkf@users.sf.net>
-2004-02-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+ * doc/tailcall.n: Added documentation for tailcall command.
- * win/tclWinDde.c: Removed some gcc warnings - except for the
- -Wconversion warning for GetGlobalAtomName. gcc is just wrong
- about this.
+2009-03-18 Don Porter <dgp@users.sourceforge.net>
-2004-02-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * win/tclWinFile.c (TclpObjNormalizePath): [Bug 2688184]:
+ Corrected Tcl_Obj leak. Thanks to Joe Mistachkin for detection and
+ patch.
- IMPLEMENTATION OF TIP#100 FROM GEORGIOS PETASIS
- * generic/tclLoad.c (Tcl_UnloadObjCmd): Implementation.
- * tests/unload.test: Test suite.
- * unix/dltest/pkgua.c: Helper for test suite.
- * doc/unload.n: Documentation.
- Also assorted changes (mostly small) to several other files.
+ * generic/tclVar.c (TclLookupSimpleVar): [Bug 2689307]: Shift
+ all calls to Tcl_SetErrorCode() out of TclLookupSimpleVar and onto its
+ callers, where control with TCL_LEAVE_ERR_MSG flag is more easily
+ handled.
-2004-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-03-16 Donal K. Fellows <dkf@users.sf.net>
- * generic/regc_locale.c (cclass): Buffer was having its size reset
- instead of being released => memleak. [Bug 902562]
+ * generic/tclCmdMZ.c (TryPostBody): [Bug 2688063]: Extract information
+ from list before getting rid of last reference to it.
-2004-02-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-03-15 Joe Mistachkin <joe@mistachkin.com>
- * generic/tclLoad.c (Tcl_LoadObjCmd): Fixed memory leak due to
- an improper error exit route.
+ * generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match
+ * generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics
-2004-02-20 David Gravereaux <davygrvy@pobox.com>
+2009-03-15 Donal K. Fellows <dkf@users.sf.net>
- * win/tclWinSock.c (SocketThreadExitHandler): Don't call
- TerminateThread when WaitForSingleObject returns a timeout.
- Tcl_Finalize called from DllMain will pause all threads. Trust
- that the thread will get the close notice at a later time if it
- does ever wake up before being cleaned up by the system anyway.
+ * generic/tclThreadStorage.c (TSDTableDelete): [Bug 2687952]: Ensure
+ * generic/tclThread.c (Tcl_GetThreadData): that structures in
+ Tcl's TSD system are all freed. Use the correct matching allocator.
-2004-02-17 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclPosixStr.c (Tcl_SignalId,Tcl_SignalMsg): [Patch 1513655]:
+ Added support for SIGINFO, which is present on BSD platforms.
- * doc/tcltest.n:
- * library/tcltest/tcltest.tcl: Changed -verbose default value to
- {body error} so that detailed information on unexpected errors in
- tests is provided by default, even after the fix for [Bug 725253]
+2009-03-14 Donal K. Fellows <dkf@users.sf.net>
-2004-02-17 Jeff Hobbs <jeffh@ActiveState.com>
+ * unix/tcl.pc.in (new file): [Patch 2243948] (hat0)
+ * unix/configure.in, unix/Makefile.in: Added support for reporting
+ Tcl's public build configuration via the pkg-config system. TEA is
+ still the official mechanism though, in part because pkg-config is not
+ universally supported across all Tcl's supported platforms.
- * tests/unixInit.test (unixInit-7.1):
- * unix/tclUnixInit.c (TclpInitPlatform): ensure the std fds exist
- to prevent crash condition [Bug #772288]
+2009-03-11 Miguel Sofer <msofer@users.sf.net>
-2004-02-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclBasic.c (TclNRCoroutineObjCmd): fix Tcl_Obj leak.
+ Diagnosis and fix thanks to GPS.
- * generic/tclCompCmds.c (TclCompileSwitchCmd): Bozo mistake in
- memory releasing order when in an error case. [Bug 898910]
+2009-03-09 Donal K. Fellows <dkf@users.sf.net>
-2004-02-16 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclCmdMZ.c (Tcl_TryObjCmd, TclNRTryObjCmd): Moved the
+ implementation of [try] from Tcl code into C. Still lacks a bytecode
+ version, but should be better than what was before.
- * generic/tclTrace.c (TclTraceExecutionObjCmd)
- (TclTraceCommandObjCmd): fix possible mem leak in trace info.
+2009-03-04 Donal K. Fellows <dkf@users.sf.net>
-2004-02-12 Mo DeJong <mdejong@users.sourceforge.net>
+ * generic/tclZlib.c (TclZlibCmd): Checksums are defined to be unsigned
+ 32-bit integers, use Tcl_WideInt to pass to scripts. [Bug 2662434]
+ (ZlibStreamCmd, ChanGetOption): A few other related corrections.
- * win/tclWinInit.c (AppendEnvironment):
- Use the tail component of the passed in
- lib path instead of just blindly using
- lib+4. That worked when lib was "lib/..."
- but fails for other values. Thanks go to
- Patrick Samson for pointing this out.
+2009-02-27 Jan Nijtmans <nijtmans@users.sf.net>
-2004-02-10 David Gravereaux <davygrvy@pobox.com>
+ * generic/tcl.decls: [Bug 218977]: Tcl_DbCkfree needs return value
+ * generic/tclCkalloc.c
+ * 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.
+ * generic/tclIntDecls.h (regenerated)
- * win/nmakehlp.c: better macro grepping logic.
+2009-02-25 Don Porter <dgp@users.sourceforge.net>
-2004-02-07 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclUtil.c (TclStringMatchObj): [Bug 2637173]: Revised
+ the branching on the strObj->typePtr so that untyped values get
+ converted to the "string" type and pass through the Unicode matcher.
+ [Bug 2613766]: Also added checks to only perform "bytearray"
+ optimization on pure bytearray values.
- * win/makefile.vc:
- * win/rules.vc:
- * win/tcl.rc:
- * win/tclsh.rc: Added an 'unchecked' option to the OPTS macro so a
- core built with symbols can be linked to the non-debug enabled C
- run-time. As per discussion with Kevin Kenny. Called like this:
+ * generic/tclCmdMZ.c: Since Tcl_GetCharLength() has its own
+ * generic/tclExecute.c: optimizations for the tclByteArrayType, stop
+ having the callers do them.
- nmake -af makefile.vc OPTS=unchecked,symbols
+2009-02-24 Donal K. Fellows <dkf@users.sf.net>
- This clarifies the meaning of the 'g' naming suffix to mean only that
- the binary requires the debug enabled C run-time. Whether the binary
- contains symbols or not is a different condition.
+ * doc/clock.n, doc/fblocked.n, doc/format.n, doc/lsort.n,
+ * doc/pkgMkIndex.n, doc/regsub.n, doc/scan.n, doc/tclvars.n:
+ General minor documentation improvements.
-2004-02-06 Don Porter <dgp@users.sourceforge.net>
+ * library/http/http.tcl (geturl, Eof): Added support for 8.6's built
+ in zlib routines.
- * doc/clock.n: Removed reference to non-existent [file ctime].
+2009-02-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
-2004-02-05 David Gravereaux <davygrvy@pobox.com>
+ * tests/lrange.test: Revert commits of 2008-07-23. Those were speed
+ * tests/binary.test: tests, that are inherently brittle.
- * docs/tclvars.n: Added clarification of the tcl_platform(debug)
- var that it only refers to the flavor of the C run-time, and not
- whether the core contains symbols.
+2009-02-21 Don Porter <dgp@users.sourceforge.net>
-2004-02-05 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclStringObj.c: Several revisions to the shimmering
+ patterns between Unicode and UTF string reps. Most notably the
+ call: objPtr = Tcl_NewUnicodeObj(...,0); followed by a loop of calls:
+ Tcl_AppendUnicodeToObj(objPtr, u, n); will now grow and append to
+ the Unicode representation. Before this commit, the sequence would
+ convert each append to UTF and perform the append to the UTF rep.
+ This is puzzling and likely a bug. The performance of [string map]
+ is significantly improved by this change (according to the MAP
+ collection of benchmarks in tclbench). Just in case there was some
+ wisdom in the old ways that I missed, I left in the ability to restore
+ the old patterns with a #define COMPAT 1 at the top of the file.
- * generic/tclFileName.c (SkipToChar): Corrected CONST and
- type-casting issues that caused compiler warnings.
+2009-02-20 Don Porter <dgp@users.sourceforge.net>
-2004-02-04 Don Porter <dgp@users.sourceforge.net>
+ * 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.
- * generic/tclCmdAH.c (StoreStatData): Removed improper refcount
- decrement of the varName parameter. This error was causing
- segfaults following test cmdAH-28.7.
+2009-02-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Simplify the logic of the
+ Tcl_*SetObjLength() routines.
+
+ * generic/tclStringObj.c: Rewrite GrowStringBuffer() so that it
+ has parallel structure with GrowUnicodeBuffer(). The revision permits
+ allocation attempts to continue all the way up to failure, with no
+ gap. It also directly manipulates the String and Tcl_Obj internals
+ instead of inefficiently operating via Tcl_*SetObjLength() with all of
+ its extra protections and underdocumented special cases.
+
+ * generic/tclStringObj.c: Another round of simplification on
+ the allocation macros.
+
+2009-02-17 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tcl.m4, win/configure: Check if cl groks _WIN64 already to
+ avoid CC manipulation that can screw up later configure checks.
+ Use 'd'ebug runtime in 64-bit builds.
+
+2009-02-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Pare back the length of the unicode
+ array in a non-extended String struct to one Tcl_UniChar, meant to
+ hold the terminating NUL character. Non-empty unicode strings are
+ then stored by extending the String struct by stringPtr->maxChars
+ additional slots in that array with sizeof(Tcl_UniChar) bytes per
+ slot. This revision makes the allocation macros much simpler.
+
+ * generic/tclStringObj.c: Factor out common GrowUnicodeBuffer()
+ and solve overflow and growth algorithm fallbacks in it.
+
+ * generic/tclStringObj.c: Factor out common GrowStringBuffer().
+
+ * generic/tclStringObj.c: Convert Tcl_AppendStringsToObj into
+ * tests/stringObj.test: a radically simpler implementation
+ where we just loop over calls to Tcl_AppendToObj. This fixes [Bug
+ 2597185]. It also creates a *** POTENTIAL INCOMPATIBILITY *** in
+ that T_ASTO can now allocate more space than is strictly required,
+ like all the other Tcl_Append* routines. The incompatibility was
+ detected by test stringObj-6.5, which I've updated to reflect the
+ new behavior.
+
+ * generic/tclStringObj.c: Revise buffer growth implementation
+ in ExtendStringRepWithUnicode. Use cheap checks to determine that
+ no reallocation is necessary without cost of computing the precise
+ number of bytes needed. Also make use of the string growth algortihm
+ in the case of repeated appends.
+
+2009-02-16 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * 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: [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: [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.
+
+ * generic/tclStringObj.c: Replace the 'size_t uallocated' field
+ of the String struct, storing the number of bytes allocated to store
+ the Tcl_UniChar array, with an 'int maxChars' field, storing the
+ number of Tcl_UniChars that may be stored in the allocated space.
+ This reduces memory requirement a small bit, and makes some range
+ checks simpler to code.
+ * generic/tclTestObj.c: Replace the [teststringobj ualloc] testing
+ * tests/stringObj.test: command with [teststringobj maxchars] and
+ update the tests.
+
+ * generic/tclStringObj.c: Removed limitation in
+ Tcl_AppendObjToObj where the char length of the result was only
+ computed if the appended string was all single byte characters.
+ This limitation was in place to dodge a bug in Tcl_GetUniChar.
+ With that bug gone, we can take advantage of always recording the
+ length of append results when we know it.
+
+2009-02-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Revisions so that we avoid creating
+ the strange representation of an empty string with
+ objPtr->bytes == NULL and stringPtr->hasUnicode == 0. Instead in
+ the situations where that was being created, create a traditional
+ two-legged stork representation (objPtr->bytes = tclEmptyStringRep
+ and stringPtr->hasUnicode = 1). In the situations where the strange
+ rep was treated differently, continue to do so by testing
+ stringPtr->numChars == 0 to detect it. These changes make the code
+ more conventional so easier for new maintainers to pick up. Also
+ sets up further simplifications.
+
+ * generic/tclTestObj.c: Revise updates to [teststringobj] so we don't
+ get blocked by MODULE_SCOPE limits.
+
+2009-02-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Rewrites of the routines
+ Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetUnicodeFromObj,
+ Tcl_GetRange, and TclStringObjReverse to use the new macro, and
+ to more simply and clearly split the cases depending on whether
+ a valid unicode rep is present or needs to be created.
+ New utility routine UnicodeLength(), to compute the length of unicode
+ buffer arguments when no length is passed in, with built-in
+ overflow protection included. Update three callers to use it.
+
+ * generic/tclInt.h: New macro TclNumUtfChars meant to be a faster
+ replacement for a full Tcl_NumUtfChars() call when the string has all
+ single-byte characters.
+
+ * generic/tclStringObj.c: Simplified Tcl_GetCharLength by
+ * generic/tclTestObj.c: removing code that did nothing.
+ Added early returns from Tcl_*SetObjLength when the desired length
+ is already present; adapted test command to the change.
+
+ * generic/tclStringObj.c: Re-implemented AppendUtfToUnicodeRep
+ so that we no longer pass through Tcl_DStrings which have their own
+ sets of problems when lengths overflow the int range. Now AUTUR and
+ FillUnicodeRep share a common core routine.
+
+2009-02-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOODefineCmds.c (TclOOGetDefineCmdContext): Use the
+ correct field in the Interp structure for retrieving the frame to get
+ the context object so that people can extend [oo::define] without deep
+ shenanigans. Bug found by Federico Ferri.
+
+2009-02-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Re-implemented AppendUnicodeToUtfRep
+ so that we no longer pass through Tcl_DStrings which have their own
+ sets of problems when lengths overflow the int range. Now AUTUR and
+ UpdateStringOfString share a common core routine.
+
+ * generic/tclStringObj.c: Changed type of the 'allocated' field
+ * generic/tclTestObj.c: of the String struct (and the
+ TestString counterpart) from size_t to int since only int values are
+ ever stored in it.
+
+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)
- * library/tcltest/tcltest.tcl: Corrected references to
- non-existent $name variable in [cleanupTests]. [Bug 833637]
+2009-02-10 Jan Nijtmans <nijtmans@users.sf.net>
-2004-02-03 Don Porter <dgp@users.sourceforge.net>
+ * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
+ using the native CC.
+ * unix/configure: (autoconf-2.59)
- * library/tcltest/tcltest.tcl: Corrected parsing of single
- command line argument (option with missing value) [Bug 833910]
- * library/tcltest/pkgIndex.tcl: Bump to version 2.2.5.
+2009-02-10 Don Porter <dgp@users.sourceforge.net>
-2004-02-02 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclObj.c (Tcl_GetString): Added comments and validity
+ checks following the call to an UpdateStringProc.
- * generic/tclIO.c (Tcl_Ungets): Fixes improper filling of the
- channel buffer. This is the buffer before the splice. [Bug 405995]
+ * generic/tclStringObj.c: Reduce code duplication in Tcl_GetUnicode*.
+ Restrict AppendUtfToUtfRep to non-negative length appends.
+ Convert all Tcl_InvalidateStringRep() calls into macros.
+ Simplify Tcl_AttemptSetObjLength by removing unreachable code.
+ Simplify SetStringFromAny() by removing unreachable and duplicate code.
+ Simplify Tcl_SetObjLength by removing unreachable code.
+ Removed handling of (objPtr->bytes != NULL) from UpdateStringOfString,
+ which is only called when objPtr->bytes is NULL.
-2004-02-01 David Gravereaux <davygrvy@pobox.com>
+2009-02-09 Jan Nijtmans <nijtmans@users.sf.net>
- * tests/winPipe.test: more pass-thru commandline verifications.
- * win/tclWinPipe.c (BuildCommandLine): Special case quoting for
- '{' not required by the c-runtimes's parse_cmdline().
- * win/tclAppInit.c: Removed our custom setargv() in favor of
- the work provided by the c-runtime. [Bug 672938]
+ * generic/tclCompile.c: [Bug 2555129]: const compiler warning (as
+ error) in tclCompile.c
- * win/nmakehlp.c: defensive techniques to avoid static buffer
- overflows and a couple envars upsetting invokations of cl.exe
- and link.exe. [Bug 885537]
+2009-02-07 Donal K. Fellows <dkf@users.sf.net>
- --------
- * tests/winPipe.test: Added proof that BuildCommandLine() is not
- doing the "N backslashes followed a quote -> insert N * 2 + 1
- backslashes then a quote" rule needed for the crt's
- parse_cmdline().
- * win/tclWinPipe.c: Fixed BuildCommandLine() to pass the new
- cases.
+ * generic/tclZlib.c (TclZlibCmd): [Bug 2573172]: Ensure that when
+ invalid subcommand name is given, the list of valid subcommands is
+ produced. This gives a better experience when using the command
+ interactively.
-2004-01-30 David Gravereaux <davygrvy@pobox.com>
+2009-02-05 Joe Mistachkin <joe@mistachkin.com>
- * win/makefile.vc: Use the -GZ compiler switch when building for
- symbols. This is supposed to emulate the release build better to
- avoid hiding problems that only show themselves in a release
- build.
+ * 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).
-2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-02-05 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclPathObj.c: fix to [Bug 883143] in file normalization
+ * generic/tclCmdMZ.c (StringIndexCmd, StringRangeCmd, StringLenCmd):
+ Simplify the implementation of some commands now that the underlying
+ string API knows more about bytearrays.
-2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclExecute.c (TclExecuteByteCode): [Bug 2568434]: Make sure
+ that INST_CONCAT1 will not lose string reps wrongly.
- * doc/file.n:
- * generic/tclFCmd.c
- * generic/tclTest.c
- * library/init.tcl
- * mac/tclMacFile.c
- * tests/fileSystem.test: fix to [Bug 886352] where 'file copy
- -force' had inconsistent behaviour wrt target files with
- insufficient permissions, particular from vfs->native fs.
- Behaviour of '-force' is now always consistent (and now
- consistent with behaviour of 'file delete -force'). Added new
- tests and documentation and cleaned up the 'simplefs' test
- filesystem.
+ * generic/tclStringObj.c (Tcl_AppendObjToObj): Special-case the
+ appending of one bytearray to another, which can be extremely rapid.
+ Part of scheme to address [Bug 1665628] by making the basic string
+ operations more efficient on byte arrays.
+ (Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetRange): More special casing
+ work for bytearrays.
- * generic/tclIOUtil.c
+2009-02-04 Don Porter <dgp@users.sourceforge.net>
+
+ * 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: [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>
+
+ * macosx/tclMacOSXFCmd.c: Eliminate some unnessary type casts
+ * unix/tclLoadDyld.c: some internal const decorations
+ * unix/tclUnixCompat.c: spacing
* unix/tclUnixFCmd.c
* unix/tclUnixFile.c
- * win/tclWinFile.c: made native filesystems more robust to C code
- which asks for mount lists.
+ * win/tclWinDde.c
+ * win/tclWinFCmd.c
+ * win/tclWinInit.c
+ * win/tclWinLoad.c
+ * win/tclWinPipe.c
+ * win/tclWinReg.c
+ * win/tclWinTest.c
+ * generic/tclBasic.c
+ * generic/tclBinary.c
+ * generic/tclCmdAH.c
+ * generic/tclCmdIL.c
+ * generic/tclCmdMZ.c
+ * generic/tclCompCmds.c
+ * generic/tclDictObj.c
- * generic/tclPathObj.c: fix to [Bug 886607] removing warning/error
- with some compilers.
+2009-02-03 Donal K. Fellows <dkf@users.sf.net>
-2004-01-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tclObj.c (tclCmdNameType): [Bug 2558422]: Corrected the type
+ of this structure so that extensions that write it (yuk!) will still
+ be able to function correctly.
- * generic/tclObj.c (SetBooleanFromAny): Rewrite to do more
- efficient string->bool conversion.
- Many other minor whitespace/style fixes to this file too.
+2009-02-03 Don Porter <dgp@users.sourceforge.net>
-2004-01-27 David Gravereaux <davygrvy@pobox.com>
+ * 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.
- * win/nmakehlp.c: Use '.\nul' as the sourcefile name instead of
- 'nul' so VC 5.2 doesn't try searching the path for it and failing
- with a possible dialogbox popping up about having to add a CD to
- an empty drive. Also added a SetErrorMode() call to disable any
- dialogs that cl.exe or link.exe might create. [Bug 885537]
+ * generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication.
-2004-01-22 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-02-02 Don Porter <dgp@users.sourceforge.net>
- * doc/file.n: clarified documentation of 'file system' [Bug 883825]
- * tests/fCmd.test: improved test result in failure case.
+ * generic/tclInterp.c: Reverted the conversion of [interp] into an
+ * tests/interp.test: ensemble. Such conversion is not necessary
+ * tests/nre.test: (or even all that helpful) in the NRE-enabling
+ of [interp invokehidden], and it has other implications -- including
+ significant forkage of the 8.5 and 8.6 implementations -- that are
+ better off avoided if there's no gain.
-2004-01-22 Vince Darley <vincentdarley@users.sourceforge.net>
+ * generic/tclStringObj.c (STRING_NOMEM): [Bug 2494093]: Add missing
+ cast of NULL to (char *) that upsets some compilers.
- * tests/fileSystem.test: 3 new tests
- * generic/tclPathObj.c: fix to [Bug 879555] in file normalization.
- * doc/filename.n: small clarification to Windows behaviour with
- filenames like '.....', 'a.....', '.....a'.
+ * generic/tclStringObj.c (Tcl_(Attempt)SetObjLength): [Bug 2553906]:
+ Added protections against callers asking for negative lengths. It is
+ likely when this happens that an integer overflow is to blame.
- * generic/tclIOUtil.c: slight improvement to native cwd caching
- on Windows.
+2009-02-01 David Gravereaux <davygrvy@pobox.com>
-2004-01-21 David Gravereaux <davygrvy@pobox.com>
+ * win/makefile.vc: Allow nmake flags such as -a (rebuild all) to pass
+ down to the pkgs targets, too.
- * doc/Panic.3: Mentions of 'panic' and 'panicVA' removed from
- the documentation.
+2009-01-30 Donal K. Fellows <dkf@users.sf.net>
-2004-01-21 Vince Darley <vincentdarley@users.sourceforge.net>
+ * doc/chan.n: [Bug 1216074]: Added another extended example.
- * doc/FileSystem.3:
- * generic/tcl.decls:
- * generic/tclCmdAH.c
- * generic/tclDecls.h
- * generic/tclFCmd.c
+ * doc/refchan.n: Added an example of how to build a scripted channel.
+
+2009-01-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/stringObj.test: [Bug 2006888]: Remove non-ASCII chars from
+ non-comment locations in the file, making it work more reliably in
+ locales with a non-Latin-1 default encoding.
+
+ * generic/tclNamesp.c (Tcl_FindCommand): [Bug 2519474]: Ensure that
+ the path is not searched when the TCL_NAMESPACE_ONLY flag is given.
+
+ * generic/tclOODecls.h (Tcl_OOInitStubs): [Bug 2537839]: Make the
+ declaration of this macro work correctly in the non-stub case.
+
+2009-01-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInterp.c: Convert the [interp] command into a
+ * tests/interp.test: [namespace ensemble]. Work in progress
+ * tests/nre.test: to NRE-enable the [interp invokehidden]
+ subcommand.
+
+2009-01-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529117]: Make this
+ function behave more sensibly when presented with a fully-qualified
+ name, rather than doing strange stuff.
+
+2009-01-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (TclInvokeObjectCommand): Made this understand
+ what to do if it ends up being used on a command with no objProc; that
+ shouldn't happen, but...
+
+ * generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529157]: Made this
+ understand NRE command implementations better.
+ * generic/tclDictObj.c (DictForCmd): Eliminate unnecessary command
+ implementation.
+
+2009-01-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOODefineCmds.c (Tcl_ClassSetConstructor):
+ [Bug 2531577]: Ensure that caches of constructor chains are cleared
+ when the constructor is changed.
+
+2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * 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: [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): [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>
+
+ * doc/zlib.n: Added a note that 'zlib push' is reversed by 'chan pop'.
+
+2009-01-22 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclCompile.h: CONSTify TclPrintInstruction (TIP #27)
+ * generic/tclCompile.c
+ * generic/tclInt.h: CONSTify TclpNativeJoinPath (TIP #27)
* generic/tclFileName.c
- * generic/tclFileSystem.h
- * generic/tclIOUtil.c
+ * generic/tcl.decls: {unix win} is equivalent to {generic}
* generic/tclInt.decls
- * generic/tclInt.h
+ * generic/tclDecls.h: (regenerated)
* generic/tclIntDecls.h
- * generic/tclPathObj.c
- * generic/tclStubInit.c
- * generic/tclTest.c
- * mac/tclMacFile.c
- * tests/fileName.test
- * tests/fileSystem.test
- * tests/winFCmd.test
- * unix/tclUnixFile.c
- * win/tclWin32Dll.c
- * win/tclWinFCmd.c
- * win/tclWinFile.c
- * win/tclWinInt.h
-
- Three main issues accomplished: (1) cleaned up variable names in
- the filesystem code so that 'pathPtr' is used throughout. (2)
- applied a round of filesystem optimisation with better handling
- and caching of relative and absolute paths, requiring fewer
- conversions. (3) clarifications to the documentation,
- particularly regarding the acceptable refCounts of objects.
- Some new tests added. Tcl benchmarks show a significant
- improvement over 8.4.5, and on Windows typically a small
- improvement over 8.3.5 (Unix still appears to require
- optimisation). TCL_FILESYSTEM_VERSION_2 introduced, but for
- internal use only. There should be no public incompatibilities
- from these changes. Thanks to dgp for extensive testing.
-
-2004-01-19 David Gravereaux <davygrvy@pobox.com>
-
- * win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem
- with the process list. The delayed cut operation after the wait
- was going stale by being outside the list lock. It now cuts
- within the lock and does a locked splice for when it needs to
- instead. [Bug 859820]
-
-2004-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclCompile.c, generic/tclCompile.h: Two new opcodes,
- INST_LIST_INDEX_IMM and INST_LIST_RANGE_IMM, that have operand(s)
- of new type OPERAND_IDX4 which represents indexes into things like
- lists (and perhaps other things eventually.)
- * generic/tclExecute.c (TclExecuteByteCode): Implementation of the
- new opcodes. INST_LIST_INDEX_IMM does a simple [lindex] with
- either front- or end-based simple indexing. INST_LIST_RANGE_IMM
- does an [lrange] with front- or end-based simple indexing for both
- the reference to the first and last items in the range.
- * generic/tclCompCmds.c (TclCompileLassignCmd): Generate bytecode
- for the [lassign] command.
-
-2004-01-17 David Gravereaux <davygrvy@pobox.com>
-
- * win/tclWinInit.c: added #pragma comment(lib, "advapi32.lib")
- when compiling under VC++ so we don't need to specify it
- when linking.
-
-2004-01-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclCmdIL.c (Tcl_LassignObjCmd): Add more shimmering
- protection for when the list is also one of the variables.
-
- BASIC IMPLEMENTATION OF TIP#57
- * generic/tclCmdIL.c (Tcl_LassignObjCmd): Implementation of the
- [lassign] command that takes full advantage of Tcl's object API.
- * doc/lassign.n: New file documenting the command.
- * tests/cmdIL.test (cmdIL-6.*): Test suite for the command.
-
-2004-01-15 David Gravereaux <davygrvy@pobox.com>
-
- * win/tclWinReg.c: Placed the requirement for advapi.lib into
- the object file itself with #paragma comment (lib, ...) when
- built with VC++. This will simplify linking for users of the
- static library.
-
- * win/rules.vc: Added new 'fullwarn' to the CHECKS commandline
- macro; sets $(FULLWARNINGS).
-
- * win/makefile.vc: Removed 'advapi.lib' from $(baselibs).
- Added new logic to crank-up the warning levels for both compile
- and link when $(FULLWARNINGS) is set. Some clean-up with how
- the resource files are built and how -DTCL_USE_STATIC_PACKAGES
- is sent when compiling the shells.
-
- * win/tclAppInit.c: Small change in how TCL_USE_STATIC_PACKAGES
- is used.
-
- * win/tcl.rc:
- * win/tclsh.rc: Some clean-up with how the resource files are
- built. Fixed 'OriginalFilename' problem that still thought
- a debug suffix was still 'd', now is 'g'.
-
-2004-01-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
-
- * generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted
- behaviour of [dict exists] so a failure to look up a dictionary
- along the path of dicts doesn't trigger an error. This is how it
- was documented to behave previously... [Bug 871387]
-
- * generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth
- relating to [Bug 876170].
- (SetDictFromAny): Make sure that lists retain their ordering even
- when converted to dictionaries and back.
- (TraceDictPath): Correct object reference count handling!
- (DictReplaceCmd, DictRemoveCmd): Stop object leak.
- (DictIncrCmd,DictLappendCmd,DictAppendCmd,DictSetCmd,DictUnsetCmd):
- Simpler handling of reference counts when assigning to variables.
- * tests/dict.test (dict-19.2): Memory leak stress test
-
-2004-01-13 Don Porter <dgp@users.sourceforge.net>
-
- * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Silence compiler warnings.
-
- Patch 876451: restores performance of [return]. Also allows forms
- such as [return -code error $msg] to be bytecompiled.
-
- * generic/tclInt.h: Factored Tcl_ReturnObjCmd() into two pieces:
- * generic/tclCmdMZ.c: TclMergeReturnOptions(), which can parse the
- options to [return], check their validity, and create the
- corresponding return options dictionary, and TclProcessReturn(),
- which takes that return options dictionary and performs the
- [return] operation.
-
- * generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to
- call TclMergeReturnOptions() at compile time so the return options
- dictionary is computed at compile time (when it is fully known).
- The dictionary is pushed on the stack along with the result, and
- the code and level values are included in the bytecode as operands.
- Also supports optimized compilation of un-[catch]ed [return]s from
- procs with default options into the INST_DONE instruction.
-
- * generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve
- the code and level operands, pop the return options from the stack,
- and call TclProcessReturn() to perform the [return] operation.
-
- * generic/tclCompile.h: New utilities include TclEmitInt4 macro
- * generic/tclCompile.c: and TclWordKnownAtCompileTime().
-
- End Patch 876451.
-
- * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to
- management of the interp result by Tcl_GetIndexFromObj() exposed
- improper interp result management in the [glob] command procedure.
- Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern.
- This stopped a segfault in test filename-11.36. [Bug 877677]
+ * generic/tclGetDate.y: Single internal const decoration.
+ * generic/tclDate.c:
-2004-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+2009-01-22 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs):
- Create fresh objects instead of using the one currently in the
- interpreter, which isn't guaranteed to be fresh and unshared. The
- cost for the core will be minimal because of the object cache, and
- this fixes [Bug 875395].
+ * unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be
+ ${SHLIB_VERSION}).
+ * unix/configure: Autoconf 2.59
-2004-01-12 Miguel Sofer <msofer@users.sf.net>
+2009-01-21 Andreas Kupries <andreask@activestate.com>
- * generic/tclCompExpr.c (CompileLandOrLorExpr): cosmetic changes.
+ * 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.
-2004-01-12 Miguel Sofer <msofer@users.sf.net>
-
- * generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer
- instructions. As a side effect, the instructions INST_LOR and
- INST_LAND are now never used.
- * generic/tclExecute.c (INST_JUMP*): small optimisation; fix a
- bug in debug code.
+2009-01-21 Don Porter <dgp@users.sourceforge.net>
-2004-01-11 David Gravereaux <davygrvy@pobox.com>
+ * generic/tclStringObj.c: New fix for [Bug 2494093] replaces the
+ flawed attempt committed 2009-01-09.
- * win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be
- dereferenced to see if there are waiters else uninitialized
- datum is manipulated. [Bug 849007 789338 745068]
-
-2004-01-09 David Gravereaux <davygrvy@pobox.com>
+2009-01-19 Kevin B. Kenny <kennykb@acm.org>
- * generic/tcl.h: Renamed and deprecated #defines moved to within
- the #ifndef TCL_NO_DEPRECATED block. This allows us to build Tcl
- to check for deprecated functions in use, such as panic() and
- Tcl_Ckalloc(). By request from DKF. Extensions that build
- with -DTCL_NO_DEPRECATED now have these macros as restricted.
- ***POTENTIAL INCOMPATIBILITY***
+ * 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
- * win/makefile.vc:
- * win/rules.vc: Added -DTCL_NO_DEPRECATED usage to makefile.vc.
- Called like this: nmake -af makefile.vc CHECKS=nodep
+2009-01-19 David Gravereaux <davygrvy@pobox.com>
+
+ * win/build.vc.bat: Improved tools detection and error message
+ * win/makefile.vc: Reorganized the $(TCLOBJ) file list into seperate
+ parts for easier maintenance. Matched all sources built using -GL to
+ both $(lib) and $(link) to use -LTCG and avoid a warning message.
+ Addressed the over-building nature of the htmlhelp target by moving
+ from a pseudo target to a real target dependent on the entire docs/
+ directory contents.
+ * win/nmakehlp.c: Removed -g option and GrepForDefine() func as it
+ isn't being used anymore. The -V option method is much better.
+
+2009-01-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump patchlevel to 8.6b1.1 to distinguish
+ * library/init.tcl: CVS snapshots from the 8.6b1 and 8.6b2 releases
+ * unix/configure.in: and to deal with the fact that the 8.6b1
+ * win/configure.in: version of init.tcl will not [source] in the
+ HEAD version of Tcl.
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2009-01-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Reverted most
+ of the substance of my 2009-01-12 commit. NULLing the objProc field of
+ a Command when deleting it is important so that tests for certain
+ classes of commands don't return false positives when applied to
+ deleted command tokens. Overall change is now just replacement of a
+ false comment with a true one.
+
+2009-01-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * 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>
+
+ * generic/tclCmdMZ.c (Tcl_ThrowObjCmd): Move implementation of [throw]
+ * library/init.tcl (throw): to C from Tcl.
+
+2009-01-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken): One consequence of
+ the NRE rewrite is that there are now situations where a NULL objProc
+ field in a Command struct is perfectly normal. Removed an outdated
+ comment in Tcl_DeleteCommandFromToken that claimed we use
+ cmdPtr->objPtr==NULL as a test of command validity. In fact we use
+ cmdPtr->flags&CMD_IS_DELETED to perform that test. Also removed the
+ setting to NULL, since any extension following the advice of the old
+ comment is going to be broken by NRE anyway, and needs to shift to
+ flag-based testing (or stop intruding into such internal matters).
+ Part of [Bug 2486550].
+
+2009-01-09 Don Porter <dgp@users.sourceforge.net>
+
+ * 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): [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): [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>
+
+ * generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c,
+ * generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c,
+ * generic/tclVar.c: Generate errorcodes for the error cases which
+ approximate to "I can't interpret that string as one of those" and
+ "You gave me the wrong number of arguments".
+
+2009-01-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * 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
+ instead to focus on what methods add to it; that's really what the
+ test is about anyway.
+
+2009-01-06 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/stringObj.test: Revise tests that demand a NULL Tcl_ObjType
+ in certain values to construct those values with [testdstring] so
+ there's no lack of robustness depending on the shimmer history of
+ shared literals.
+
+2009-01-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals
+ of dictionaries so that literals can't get destroyed.
+
+ * tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char.
+
+ * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd):
+ [Bug 2489836]: Only delete pointers that were actually allocated!
+
+ * generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
+ [Bug 2481109]: Perform search for existing commands in right context.
+
+2009-01-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * 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>
+
+ * generic/tclCmdAH.c: Tidy up spacing and code style.
+
+2009-01-03 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (tcl::clock::add): Fixed error message formatting
+ in the case where [clock add] is presented with a bad switch.
+ * tests/clock.test (clock-65.1) Added a test case for the above
+ problem [Bug 2481670].
-2004-01-09 Vince Darley <vincentdarley@users.sourceforge.net>
+2009-01-02 Donal K. Fellows <dkf@users.sf.net>
- * generic/tclIOUtil.c: fix to infinite loop in
- TclFinalizeFilesystem [Bug 873311]
+ * 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): [Bug 741967]: Added a compatibility
+ implementation of the mkstemp() function, which is apparently needed
+ on some platforms.
******************************************************************
- *** 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 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" ***
******************************************************************
diff --git a/ChangeLog.1999 b/ChangeLog.1999
index 8be8ac0..3bf4e9a 100644
--- a/ChangeLog.1999
+++ b/ChangeLog.1999
@@ -15,7 +15,7 @@
* unix/Makefile.in: added -srcdir=... for 'make html'
- * doc/Hash.3: fixed reference to ckfree [Bug: 3912]
+ * doc/Hash.3: fixed reference to ckfree [Bug 3912]
* doc/RegExp.3: fixed calling params for Tcl_RegExecFromObj
* doc/open.n: fixed minor formatting errors
* doc/string.n: fixed minor formatting errors
@@ -24,12 +24,12 @@
* tests/cmdIL.test:
* generic/tclCmdIL.c: added -unique option to lsort
- * generic/tclThreadTest.c: changed thread ids to longs [Bug: 3902]
+ * generic/tclThreadTest.c: changed thread ids to longs [Bug 3902]
- * mac/tclMacOSA.c: fixed applescript for I18N [Bug: 3644]
+ * mac/tclMacOSA.c: fixed applescript for I18N [Bug 3644]
* win/mkd.bat:
- * win/rmd.bat: removed necessity of tag.txt [Bug: 3874]
+ * win/rmd.bat: removed necessity of tag.txt [Bug 3874]
* win/tclWinThrd.c: changed CreateThread to _beginthreadex and
ExitThread to _endthreadex
@@ -47,43 +47,43 @@
* mac/tclMacFile.c:
* unix/tclUnixFile.c:
* win/tclWinFile.c: enhanced the glob command with the new options
- -types -path -directory and -join. Deprecated TclpMatchFiles with
+ -types -path -directory and -join. Deprecated TclpMatchFiles with
TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added
- GlobTypeData structure. [Bug: 2363]
+ GlobTypeData structure. [Bug 2363]
1999-12-10 Jeff Hobbs <hobbs@scriptics.com>
* tests/var.test:
- * generic/tclCompile.c: fixed problem where setting to {} array
- would intermittently not work. (Fontaine) [Bug: 3339]
+ * generic/tclCompile.c: fixed problem where setting to {} array would
+ intermittently not work. [Bug 3339] (Fontaine)
* generic/tclCmdMZ.c:
- * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to
- recognize boolean objects. (Spjuth) [Bug: 2815]
+ * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to recognize
+ boolean objects. [Bug 2815] (Spjuth)
* tests/info.test:
* tests/parseOld.test:
* generic/tclCmdAH.c:
* generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and
- Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg
- case as well, to take advantage of potential pure list input
- optimization. This means that it won't get byte compiled though,
- which should be acceptable.
- * generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in
- the TCL_EVAL_DIRECT case for efficiency.
- * generic/tclUtil.c: made Tcl_ConcatObj pure list object aware,
- and return a list object in that case [Bug: 2098 2257]
+ Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg case as
+ well, to take advantage of potential pure list input optimization.
+ This means that it won't get byte compiled though, which should be
+ acceptable.
+ * generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in the
+ TCL_EVAL_DIRECT case for efficiency.
+ * generic/tclUtil.c: made Tcl_ConcatObj pure list object aware, and
+ return a list object in that case [Bug 2098 2257]
* generic/tclMain.c: changed Tcl_Main to not constantly reuse the
commandPtr object (interactive case) as it could be shared. (Fellows)
* unix/configure.in:
* unix/tcl.m4:
- * unix/tclUnixPipe.c: removed checking for compatible vfork
- function and use of the vfork function. Modern VM systems rarely
- suffer any performance degradation when fork is used, and it
- solves multiple problems with vfork. Users that still want vfork
- can add -Dfork=vfork to the compile flags. [Bug: 942 2228 1312]
+ * unix/tclUnixPipe.c: removed checking for compatible vfork function
+ and use of the vfork function. Modern VM systems rarely suffer any
+ performance degradation when fork is used, and it solves multiple
+ problems with vfork. Users that still want vfork can add -Dfork=vfork
+ to the compile flags. [Bug 942 2228 1312]
1999-12-09 Jeff Hobbs <hobbs@scriptics.com>
@@ -96,44 +96,44 @@
* win/tclWinFCmd.c:
* win/tclWinInit.c:
* win/tclWinPipe.c:
- * win/tclWinSock.c: removed all code that supported Win32s. It
- was no longer officially supported, and likely didn't work anyway.
+ * win/tclWinSock.c: removed all code that supported Win32s. It was no
+ longer officially supported, and likely didn't work anyway.
* win/makefile.vc: removed 16 bit stuff, cleaned up.
* win/tcl16.rc:
* win/tclWin16.c:
- * win/winDumpExts.c: these files have been removed from the
- source tree (no longer necessary to build)
+ * win/winDumpExts.c: these files have been removed from the source
+ tree (no longer necessary to build)
1999-12-07 Jeff Hobbs <hobbs@scriptics.com>
- * tests/io.test: removed 'knownBug' tests that were for
- unsupported0, which is now fcopy (that already has tests)
+ * tests/io.test: removed 'knownBug' tests that were for unsupported0,
+ which is now fcopy (that already has tests)
* mac/tclMacPort.h: added utime.h include
* generic/tclDate.c:
- * unix/Makefile.in: fixed make gendate to swap const with CONST
- so it uses the Tcl defined CONST type [Bug: 3521]
+ * unix/Makefile.in: fixed make gendate to swap const with CONST so it
+ uses the Tcl defined CONST type [Bug 3521]
- * generic/tclIO.c: removed panic that could occur in FlushChannel
- when a "blocking" channel would receive EAGAIN, instead treating
- it the same as non-blocking. [Bug: 3773]
+ * generic/tclIO.c: removed panic that could occur in FlushChannel when
+ a "blocking" channel would receive EAGAIN, instead treating it the
+ same as non-blocking. [Bug 3773]
- * generic/tclUtil.c: fixed Tcl_ScanCountedElement to not step
- beyond the end of the counted string [Bug: 3336]
+ * generic/tclUtil.c: fixed Tcl_ScanCountedElement to not step beyond
+ the end of the counted string. [Bug 3336]
1999-12-03 Jeff Hobbs <hobbs@scriptics.com>
* doc/load.n: added note about NT's buggy handling of './' with
LoadLibrary
- * library/http2.1/http.tcl: fixed error handling in http::Event
- [Bug: 3752]
+ * library/http2.1/http.tcl: fixed error handling in http::Event. [Bug
+ 3752]
* tests/env.test: removed knownBug limitation from working test
- * tests/all.tcl: ensured that ::tcltest::testsDirectory would be
- set to an absolute path
+ * tests/all.tcl: ensured that ::tcltest::testsDirectory would be set
+ to an absolute path
* tests/expr-old.test:
* tests/parseExpr.test:
@@ -144,25 +144,24 @@
* generic/tclParseExpr.c:
* generic/tclUtil.c:
* generic/tclExecute.c: added TclCheckBadOctal routine to enhance
- error message checking for when users use invalid octal numbers
- (like 08), as well as replumbed the Expr*Funcs with a new
- VerifyExprObjType to simplify type handling. [Bug: 2467]
+ error message checking for when users use invalid octal numbers (like
+ 08), as well as replumbed the Expr*Funcs with a new VerifyExprObjType
+ to simplify type handling. [Bug 2467]
* tests/expr.test:
- * generic/tclCompile.c: fixed 'bad code length' error for
- 'expr + {[incr]}' case, with new test case [Bug: 3736]
- and seg fault on 'expr + {[error]}' (different cause) that
- was caused by a correct optimization that didn't correctly
- track how it was modifying the source string in the opt.
- The optimization was removed, which means that:
+ * generic/tclCompile.c: fixed 'bad code length' error for 'expr +
+ {[incr]}' case, with new test case [Bug 3736] and seg fault on 'expr
+ + {[error]}' (different cause) that was caused by a correct
+ optimization that didn't correctly track how it was modifying the
+ source string in the opt. The optimization was removed, which means
+ that:
expr 1 + {[string length abc]}
- will be not be compiled inline as before, but this should be
- written:
+ will be not be compiled inline as before, but this should be written:
expr {1 + [string length abc]}
- which will be compiled inline for speed. This prevents
+ which will be compiled inline for speed. This prevents:
expr 1 + {[mindless error]}
- from seg faulting, and only affects optimizations for
- degenerate cases [Bug: 3737]
+ from seg faulting, and only affects optimizations for degenerate cases
+ [Bug 3737]
1999-12-01 Scott Redman <redman@scriptics.com>
@@ -170,13 +169,12 @@
* generic/tclMain.c:
* unix/tclAppInit.c:
* win/tclAppInit.c: Added two new internal functions,
- TclSetStartupScriptFileName() and TclGetStartupScriptFileName()
- and added hooks into the main() code for supporting TclPro and
- other "big" shells more easily without requiring a copy of the
- main() code.
+ TclSetStartupScriptFileName() and TclGetStartupScriptFileName() and
+ added hooks into the main() code for supporting TclPro and other "big"
+ shells more easily without requiring a copy of the main() code.
* generic/tclEncoding.c:
- * generic/tclEvent.c: Moved encoding-related startup code from
+ * generic/tclEvent.c: Moved encoding-related startup code from
tclEvent.c into the more appropriate tclEncoding.c.
1999-11-30 Jeff Hobbs <hobbs@scriptics.com>
@@ -184,46 +182,44 @@
* generic/tclIO.c: fix from Kupries for Tcl_UnstackChannel that
correctly handles resetting translation and encoding.
- * generic/tclLoad.c: #def'd out the unloading of DLLs at finalize
- time for Unix in TclFinalizeLoad. [Bug: 2560 3373] Should be
- parametrized to allow for user to specify unload or not.
+ * generic/tclLoad.c: #def'd out the unloading of DLLs at finalize time
+ for Unix in TclFinalizeLoad. [Bug 2560 3373] Should be parametrized
+ to allow for user to specify unload or not.
- * win/tclWinTime.c: fixed handling of %Z on NT for time zones
- that don't have DST.
+ * win/tclWinTime.c: fixed handling of %Z on NT for time zones that
+ don't have DST.
1999-11-29 Jeff Hobbs <hobbs@scriptics.com>
* library/dde1.1/pkgIndex.tcl:
- * library/reg1.0/pkgIndex.tcl: added supported for debugged
- versions of the libraries
+ * library/reg1.0/pkgIndex.tcl: added supported for debugged versions
+ of the libraries
* unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set
- isNonBlocking flag on pipe. [Bug: 1356 710]
+ isNonBlocking flag on pipe. [Bug 1356 710]
removed spurious fcntl call from PipeBlockModeProc
* tests/scan.test:
- * generic/tclScan.c: fixed scan where %[..] didn't match anything
- and added test case [Bug: 3700]
+ * generic/tclScan.c: fixed scan where %[..] didn't match anything and
+ added test case. [Bug 3700]
1999-11-24 Jeff Hobbs <hobbs@scriptics.com>
* doc/open.n:
* win/tclWinSerial.c: adopted patch from Schroedter to handle
- fconfigure $sock -lasterror on Windows. [RFE: 3368]
+ fconfigure $sock -lasterror on Windows. [RFE 3368]
- * generic/tclCmdIL.c: made SORTMODE_INTEGER work with Longs
- [Bug: 3652]
+ * generic/tclCmdIL.c: made SORTMODE_INTEGER work with Longs [Bug 3652]
1999-11-23 Scott Stanton <stanton@scriptics.com>
- * library/tcltest1.0/tcltest.tcl: Fixed bug where tcltest output
- went to stdout instead of the specified output file in some
- cases.
+ * library/tcltest1.0/tcltest.tcl: Fixed bug where tcltest output went
+ to stdout instead of the specified output file in some cases.
1999-11-19 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclProc.c: backed out change from 1999-11-18 as it
- could affect return string from upvar as well.
+ * generic/tclProc.c: backed out change from 1999-11-18 as it could
+ affect return string from upvar as well.
* tools/tcl.wse.in: added tcltest1.0 library to distribution list
@@ -234,49 +230,49 @@
1999-11-18 Jeff Hobbs <hobbs@scriptics.com>
* unix/tcl.m4: added defined for _THREAD_SAFE in --enable-threads
- case; added check for pthread_mutex_init in libc; in AIX case,
- with --enable-threads ${CC}_r is used; fixed flags when using gcc
- on SCO
+ case; added check for pthread_mutex_init in libc; in AIX case, with
+ --enable-threads ${CC}_r is used; fixed flags when using gcc on SCO
- * generic/tclProc.c: corrected error reporting for default case
- at the global level for uplevel command.
+ * generic/tclProc.c: corrected error reporting for default case at the
+ global level for uplevel command.
- * generic/tclIOSock.c: changed int to size_t type for len
- in TclSockMinimumBuffers.
+ * generic/tclIOSock.c: changed int to size_t type for len in
+ TclSockMinimumBuffers.
- * generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value
- on NULL input. [Bug: 3400]
+ * generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value on NULL
+ input. [Bug 3400]
- * generic/tclStringObj.c: fixed support for passing in negative
- length to Tcl_SetUnicodeObj, et al handling routines. [Bug: 3380]
+ * generic/tclStringObj.c: fixed support for passing in negative length
+ to Tcl_SetUnicodeObj, et al handling routines. [Bug 3380]
* doc/scan.n:
* tests/scan.test:
- * generic/tclScan.c: finished support for inline scan by
- supporting XPG identifiers.
+ * generic/tclScan.c: finished support for inline scan by supporting
+ XPG identifiers.
* doc/http.n:
- * library/http2.1/http.tcl: added register and unregister
- commands to http:: package (better support for tls/SSL),
- as well as -type argument to http::geturl. [RFE: 2617]
+ * library/http2.1/http.tcl: added register and unregister commands to
+ http:: package (better support for tls/SSL), as well as -type argument
+ to http::geturl. [RFE 2617]
- * generic/tclBasic.c: removed extra decr of numLevels in
- Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de)
+ * generic/tclBasic.c: removed extra decr of numLevels in Tcl_EvalObjEx
+ that could cause seg fault. (mjansen@wendt.de)
* generic/tclEvent.c: fixed possible lack of MutexUnlock in
- Tcl_DeleteExitHandler [Bug: 3545]
+ Tcl_DeleteExitHandler. [Bug 3545]
- * unix/tcl.m4: Added better pthreads library check and inclusion
- of _THREAD_SAFE in --enable-threads case
+ * unix/tcl.m4: Added better pthreads library check and inclusion of
+ _THREAD_SAFE in --enable-threads case
Added support for gcc config on SCO
* doc/glob.n: added note about ..../ glob behavior on Win9*
- * doc/tcltest.n: fixed minor example errors [Bug: 3551]
+ * doc/tcltest.n: fixed minor example errors. [Bug 3551]
1999-11-17 Brent Welch <welch@scriptics.com>
- * library/http2.1/http.tcl: Correctly fixed the -timeout
- problem mentioned in the 10-29 change. Also added error
- handling for failed writes on the socket during the protocol.
+
+ * library/http2.1/http.tcl: Correctly fixed the -timeout problem
+ mentioned in the 10-29 change. Also added error handling for failed
+ writes on the socket during the protocol.
1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
@@ -291,54 +287,53 @@
* generic/tclParse.c: added code in Tcl_ParseBraces to test for
possible unbalanced open brace in a comment
- * library/init.tcl: removed the installed binary directory from
- the auto_path variable
+ * library/init.tcl: removed the installed binary directory from the
+ auto_path variable
- * tools/tcl.wse.in: updated to 8.3a1, fixed install of twind.tcl
- and koi8-r.enc files
+ * tools/tcl.wse.in: updated to 8.3a1, fixed install of twind.tcl and
+ koi8-r.enc files
* unix/tcl.m4: added recognition of pthreads library for AIX
1999-10-29 Brent Welch <welch@scriptics.com>
- * generic/tclInt.h: Modified the TclNewObj and TclDecrRefCount
- in two ways. First, in the case of TCL_THREADS, we do not use
- the special Tcl_Obj allocator because that is a source of
- lock contention. Second, general code cleanup to eliminate
- duplicated code. In particular, TclDecrRefCount now uses
- TclFreeObj instead of duplicating that code, so it is now
- identical to Tcl_DecrRefCount.
-
- * generic/tclObj.c: Changed Tcl_NewObj so it uses the
- TclNewObj macro instead of duplicating the code. Adjusted
- TclFreeObj so it understands the TCL_THREADS case described
- above.
-
- * library/http2.1/http.tcl: Fixed a bug in the handling of
- the state(status) variable when the -timeout flag is specified.
- Previously it was possible to leave the status undefined
- instead of empty, which caused errors in http::status
+
+ * generic/tclInt.h: Modified the TclNewObj and TclDecrRefCount in two
+ ways. First, in the case of TCL_THREADS, we do not use the special
+ Tcl_Obj allocator because that is a source of lock contention. Second,
+ general code cleanup to eliminate duplicated code. In particular,
+ TclDecrRefCount now uses TclFreeObj instead of duplicating that code,
+ so it is now identical to Tcl_DecrRefCount.
+
+ * generic/tclObj.c: Changed Tcl_NewObj so it uses the TclNewObj macro
+ instead of duplicating the code. Adjusted TclFreeObj so it understands
+ the TCL_THREADS case described above.
+
+ * library/http2.1/http.tcl: Fixed a bug in the handling of the
+ state(status) variable when the -timeout flag is specified. Previously
+ it was possible to leave the status undefined instead of empty, which
+ caused errors in http::status
1999-10-28 Jeff Hobbs <hobbs@scriptics.com>
* unix/aclocal.m4: made it just include tcl.m4
- * library/tcltest1.0/tcltest.tcl: updated makeFile to return
- full pathname of file created
+ * library/tcltest1.0/tcltest.tcl: updated makeFile to return full
+ pathname of file created
* generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only
- iterates once over the va_list (avoiding a memcpy of it,
- which is not portable).
+ iterates once over the va_list (avoiding a memcpy of it, which is not
+ portable).
* generic/tclEnv.c: fixed possible ABR error in environ array
* tests/scan.test:
- * generic/tclScan.c: added support for use of inline scan,
- XPG3 currently not included
+ * generic/tclScan.c: added support for use of inline scan, XPG3
+ currently not included
* tests/incr.test:
* tests/set.test:
- * generic/tclCompCmds.c: fixed improper bytecode handling of
- 'eval {set array($unknownvar) 5}' (also for incr) [Bug: 3184]
+ * generic/tclCompCmds.c: fixed improper bytecode handling of 'eval
+ {set array($unknownvar) 5}' (also for incr). [Bug 3184]
* win/tclWinTest.c: added testvolumetype command, as atime is
completely ignored for Windows FAT file systems
@@ -346,67 +341,67 @@
* unix/tclUnixPort.h: added utime.h to includes
* doc/file.n:
* tests/cmdAH.test:
- * generic/tclCmdAH.c: added time arguments to atime and mtime
- file command methods (support 'touch' functionality)
+ * generic/tclCmdAH.c: added time arguments to atime and mtime file
+ command methods (support 'touch' functionality)
1999-10-20 Jeff Hobbs <hobbs@scriptics.com>
- * unix/tclUnixNotfy.c: fixed event/io threading problems by
- making triggerPipe non-blocking [Bug: 2792]
+ * unix/tclUnixNotfy.c: fixed event/io threading problems by making
+ triggerPipe non-blocking. [Bug 2792]
* library/tcltest1.0/tcltest.tcl:
* generic/tclThreadTest.c: fixed mem leaks in threads
- * generic/tclResult.c: fixed Tcl_AppendResultVA so it only
- iterates once over the va_list (avoiding a memcpy of it,
- which is not portable).
+ * generic/tclResult.c: fixed Tcl_AppendResultVA so it only iterates
+ once over the va_list (avoiding a memcpy of it, which is not
+ portable).
* generic/regc_color.c: fixed mem leak and assertion, from HS
- * generic/tclCompile.c: removed savedChar trick that appeared to
- be causing a segv when the literal table was released
+ * generic/tclCompile.c: removed savedChar trick that appeared to be
+ causing a segv when the literal table was released
* tests/string.test:
- * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj
- when indexing into one (test case string-5.16) [Bug: 2871]
+ * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when
+ indexing into one (test case string-5.16). [Bug 2871]
- * library/http2.1/http.tcl: protected gets with catch [Bug: 2665]
+ * library/http2.1/http.tcl: protected gets with catch. [Bug 2665]
1999-10-19 Jennifer Hom <jenn@scriptics.com>
* tests/tcltest.test:
* doc/tcltest.n:
- * library/tcltest1.0/tcltest.tcl: Removed the extra return at the
- end of the tcltest.tcl file, added version information about tcl.
+ * library/tcltest1.0/tcltest.tcl: Removed the extra return at the end
+ of the tcltest.tcl file, added version information about tcl.
Applied patches sent in by Andreas Kupries to add helper procs for
debug output, add 3 new flags (-testsdir, -load, -loadfile), and
- internally refactors common code for dealing with paths into
- separate procedures. [Bug: 2838, 2842]
+ internally refactors common code for dealing with paths into separate
+ procedures. [Bug 2838, 2842]
Merged code from core-8-2-1 branch that changes the checks for the
- value of tcl_interactive to also incorporate a check for the
- existence of the variable.
+ value of tcl_interactive to also incorporate a check for the existence
+ of the variable.
* tests/autoMkindex.test:
- * tests/pkgMkIndex.test: Explicitly cd to
- ::tcltest::testsDirectory at the beginning of the test run
+ * tests/pkgMkIndex.test: Explicitly cd to ::tcltest::testsDirectory at
+ the beginning of the test run
- * tests/basic.test: Use version information defined in tcltest
- instead of hardcoded version number
+ * tests/basic.test: Use version information defined in tcltest instead
+ of hardcoded version number
- * tests/socket.test: package require tcltest before attempting to
- use variable defined in tcltest namespace
+ * tests/socket.test: package require tcltest before attempting to use
+ variable defined in tcltest namespace
* tests/unixInit.test:
- * tests/unixNotfy.test: Added explicit exits needed to avoid
- problems when the tests area run in wish.
+ * tests/unixNotfy.test: Added explicit exits needed to avoid problems
+ when the tests area run in wish.
1999-10-12 Jim Ingham <jingham@scriptics.com>
* mac/tclMacLoad.c: Stupid bug - we converted the filename to
external, but used the unconverted version.
- * mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug: 2869]
+ * mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug 2869]
1999-10-12 Jeff Hobbs <hobbs@scriptics.com>
@@ -423,21 +418,20 @@
* generic/tclRegexp.c:
* generic/tclTest.c:
* tests/reg.test: updated to Henry Spencer's new regexp engine
- (mid-Sept 99). Should greatly reduce stack space reqs.
+ (mid-Sept 99). Should greatly reduce stack space reqs.
* library/tcltest1.0/pkgIndex.tcl: fixed procs in pkgIndex.tcl file
* generic/tclEnv.c: fixed mem leak with putenv and DStrings
* doc/Encoding.3: corrected docs
* tests/basic.test: updated test cases for 8.3
- * tests/encoding.test: fixed test case that change system
- encoding to a double-byte one (this causes a bogus mem read
- error for purify)
+ * tests/encoding.test: fixed test case that change system encoding to
+ a double-byte one (this causes a bogus mem read error for purify)
* unix/Makefile.in: purify has to use -best-effort to instrument
* unix/tclAppInit.c: identified potential mem leak when compiling
tcltest (not critical)
- * unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when
- doing alloc between vfork and execvp.
+ * unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when doing
+ alloc between vfork and execvp.
* unix/tclUnixTest.c: fixed mem leak in findexecutable test command
1999-10-05 Jeff Hobbs <hobbs@scriptics.com>
@@ -452,127 +446,126 @@
* library/http2.1/http.tcl: fixed possible use of global c var.
* win/tclWinReg.c: fixed registry command to properly 'get'
- HKEY_PERFORMANCE_DATA root key data. Needs more work.
+ HKEY_PERFORMANCE_DATA root key data. Needs more work.
* generic/tclNamesp.c:
* generic/tclVar.c:
* generic/tclCmdIL.c: fixed comment typos
- * mac/tclMacFCmd.c: fixed filename stuff to support UTF-8 [Bug: 2869]
+ * mac/tclMacFCmd.c: fixed filename stuff to support UTF-8. [Bug 2869]
- * win/tclWinSerial.c: changed SerialSetOptionProc to return
- TCL_OK by default. (patch from Rolf Schroedter)
+ * win/tclWinSerial.c: changed SerialSetOptionProc to return TCL_OK by
+ default. (patch from Rolf Schroedter)
1999-09-21 Jennifer Hom <jenn@scriptics.com>
- * library/tcltest1.0/tcltest.tcl: Applied patches sent in by
- Andreas Kupries to fix typos in comments and ::tcltest::grep,
- fix hook redefinition problems, and change "string compare" to
- "string equal." [Bug: 2836, 2837, 2839, 2840]
+ * library/tcltest1.0/tcltest.tcl: Applied patches sent in by Andreas
+ Kupries to fix typos in comments and ::tcltest::grep, fix hook
+ redefinition problems, and change "string compare" to "string equal".
+ [Bug 2836, 2837, 2839, 2840]
1999-09-20 Jeff Hobbs <hobbs@scriptics.com>
* tests/env.test:
- * unix/Makefile.in: added support for AIX LIBPATH env var [Bug: 2793]
+ * unix/Makefile.in: added support for AIX LIBPATH env var. [Bug 2793]
removed second definition of INCLUDE_INSTALL_DIR (the one that
- referenced @includedir@) [Bug: 2805]
- * unix/dltest/Makefile.in: added -lc to LIBS [Bug: 2794]
+ referenced @includedir@) [Bug 2805]
+ * unix/dltest/Makefile.in: added -lc to LIBS. [Bug 2794]
1999-09-16 Jeff Hobbs <hobbs@scriptics.com>
- * tests/timer.test: changed after delay in timer test 6.29 from
- 1 to 10. [Bug: 2796]
+ * tests/timer.test: changed after delay in timer test 6.29 from 1 to
+ 10. [Bug 2796]
* tests/pkg.test:
* generic/tclPkg.c: fixed package version check to disallow 1.2..3
- [Bug: 2539]
-
- * unix/Makefile.in: fixed gendate target - this never worked
- since RCS was intro'd.
- * generic/tclGetDate.y: updated to reflect previous changes
- to tclDate.c (leap year calc) and added CEST and UCT time zone
- recognition. Fixed 4 missing UCHAR() casts. [Bug: 2717, 954,
- 1245, 1249]
-
- * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really
- dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc
- and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719]
- and changed Tcl_Alloc, et al to not panic when a alloc request
- for zero came through and NULL was returned (valid on AIX, Tru64)
- [Bug: 2795, etc]
+ [Bug 2539]
+
+ * unix/Makefile.in: fixed gendate target - this never worked since RCS
+ was intro'd.
+ * generic/tclGetDate.y: updated to reflect previous changes to
+ tclDate.c (leap year calc) and added CEST and UCT time zone
+ recognition. Fixed 4 missing UCHAR() casts. [Bug 2717, 954, 1245,
+ 1249]
+
+ * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really dump to
+ stderr and close it [Bug 725] and changed Tcl_Ckrealloc and
+ Tcl_Ckfree to not bomb when NULL was passed in [Bug 1719] and changed
+ Tcl_Alloc, et al to not panic when a alloc request for zero came
+ through and NULL was returned (valid on AIX, Tru64) [Bug 2795, etc]
* tests/clock.test:
* doc/clock.n:
- * generic/tclClock.c: added -milliseconds switch to clock clicks
- to guarantee that the return value of clicks is in the millisecs
- granularity [Bug: 2682, 1332]
+ * generic/tclClock.c: added -milliseconds switch to clock clicks to
+ guarantee that the return value of clicks is in the millisecs
+ granularity. [Bug 2682, 1332]
1999-09-15 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclIOCmd.c: fixed potential core dump in conjunction
- with stacked channels with result obj manipulation in
- Tcl_ReadChars [Bug: 2623]
+ * generic/tclIOCmd.c: fixed potential core dump in conjunction with
+ stacked channels with result obj manipulation in Tcl_ReadChars. [Bug
+ 2623]
* tests/format.test:
- * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
+ * generic/tclCmdAH.c: fixed translation of %0#s in format. [Bug 2605]
- * doc/msgcat.n: fixed \\ bug in example [Bug: 2548]
+ * doc/msgcat.n: fixed \\ bug in example. [Bug 2548]
* unix/tcl.m4:
- * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition
- [Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610]
+ * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition [Bug 2070]
+ and fix for IRIX SHLIB_LB_LIBS. [Bug 2610]
* doc/array.n:
* tests/var.test:
* tests/set.test:
- * generic/tclVar.c: added an array unset operation, with docs
- and tests. Variation of [Bug: 1775]. Added fix in TclArraySet
- to check when trying to set in a non-existent namespace. [Bug: 2613]
+ * generic/tclVar.c: added an array unset operation, with docs and
+ tests. Variation of [Bug 1775]. Added fix in TclArraySet to check
+ when trying to set in a non-existent namespace. [Bug 2613]
1999-09-14 Jeff Hobbs <hobbs@scriptics.com>
* tests/linsert.test:
* doc/linsert.n:
- * generic/tclCmdIL.c: fixed end-int interpretation of linsert
- to correctly calculate value for end, added test and docs [Bug: 2693]
+ * generic/tclCmdIL.c: fixed end-int interpretation of linsert to
+ correctly calculate value for end, added test and docs. [Bug 2693]
* doc/regexp.n:
* doc/regsub.n:
* tests/regexp.test:
- * generic/tclCmdMZ.c: add -start switch to regexp and regsub
- with docs and tests
+ * generic/tclCmdMZ.c: add -start switch to regexp and regsub with docs
+ and tests
* doc/switch.n: added proper use of comments to example.
- * generic/tclCmdMZ.c: changed switch to complain when an error
- occurs that seems to be due to a misplaced comment.
+ * generic/tclCmdMZ.c: changed switch to complain when an error occurs
+ that seems to be due to a misplaced comment.
- * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions
- in regsub [Bug: 2723]
+ * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions in
+ regsub. [Bug 2723]
- * generic/tclCmdMZ.c: changed [string equal] to return an Int
- type object (was a Boolean)
+ * generic/tclCmdMZ.c: changed [string equal] to return an Int type
+ object (was a Boolean)
1999-09-01 Jennifer Hom <jenn@scriptics.com>
- * library/tcltest1.0/tcltest.tcl: Process command-line arguments
- only ::tcltest doesn't have a child namespace (requires that
- command-line args are processed in that namespace)
+ * library/tcltest1.0/tcltest.tcl: Process command-line arguments only
+ ::tcltest doesn't have a child namespace (requires that command-line
+ args are processed in that namespace)
1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD
- happy [Bug: 2625]
- * generic/tclProc.c: moved static buf to better location and
- changed static msg that would overflow in ProcessProcResultCode
- [Bug: 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd.
- Also reworked size of static buffers.
+ * generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD happy.
+ [Bug 2625]
+ * generic/tclProc.c: moved static buf to better location and changed
+ static msg that would overflow in ProcessProcResultCode [Bug 2483]
+ and added Tcl_DStringFree to Tcl_ProcObjCmd. Also reworked size of
+ static buffers.
* tests/stringObj.test: added test 9.11
- * generic/tclStringObj.c: changed Tcl_AppendObjToObj to
- properly handle the 1-byte dest and mixed src case where
- both had had Unicode string len checks made on them. [Bug: 2678]
+ * generic/tclStringObj.c: changed Tcl_AppendObjToObj to properly
+ handle the 1-byte dest and mixed src case where both had had Unicode
+ string len checks made on them. [Bug 2678]
* unix/aclocal.m4:
- * unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the
- AIX-* case and readjusted the range
+ * unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the AIX-*
+ case and readjusted the range
1999-08-31 Jennifer Hom <jenn@scriptics.com>
@@ -592,74 +585,71 @@
themselves write, and removed accidental checkin of knownBugThreaded
constraints for Solaris and Linux.
- * library/tcltest1.0/tcltest.tcl: Modified tcltest so that
- variables are only initialized to their default values if they did
- not previously exist.
+ * library/tcltest1.0/tcltest.tcl: Modified tcltest so that variables
+ are only initialized to their default values if they did not
+ previously exist.
1999-08-26 Jennifer Hom <jenn@scriptics.com>
* tests/tcltest.test:
- * library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
- variable named ::tcltest::parameters based on whatever's being
- sent in as the argument to the -args flag.
+ * library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
+ variable named ::tcltest::parameters based on whatever's being sent in
+ as the argument to the -args flag.
1999-08-23 Jennifer Hom <jenn@scriptics.com>
- * tests/tcltest.test: Added additional tests for -tmpdir, marked
- all tests that use exec as unixOrPc.
+ * tests/tcltest.test: Added additional tests for -tmpdir, marked all
+ tests that use exec as unixOrPc.
* tests/encoding.test:
* tests/interp.test:
* tests/macFCmd.test:
* tests/parseOld.test:
- * tests/regexp.test: Applied patches from Jim Ingham to add
- encoding to a Mac only interp test, change an error message in
- macFCmd.tet, put a comment in parseOld.test, fix tests using the
- testencoding path command, and put unixOrPc constraints on tests
- that use exec.
+ * tests/regexp.test: Applied patches from Jim Ingham to add encoding
+ to a Mac only interp test, change an error message in macFCmd.tet, put
+ a comment in parseOld.test, fix tests using the testencoding path
+ command, and put unixOrPc constraints on tests that use exec.
1999-08-21 Jeff Hobbs <hobbs@scriptics.com>
- * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9]
- [Bug: 1909]
+ * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9] [Bug 1909]
1999-08-20 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclPosixStr.c: fixed typo [Bug: 2592]
+ * generic/tclPosixStr.c: fixed typo. [Bug 2592]
- * doc/*: fixed various nroff bugs in man pages [Bug: 2503 2588]
+ * doc/*: fixed various nroff bugs in man pages. [Bug 2503 2588]
1999-08-19 Jeff Hobbs <hobbs@scriptics.com>
- * win/README.binary: fixed version info and some typos [Bug: 2561]
+ * win/README.binary: fixed version info and some typos. [Bug 2561]
* doc/interp.n: updated list of commands available in a safe
- interpreter [Bug: 2526]
+ interpreter. [Bug 2526]
* generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide
headers (pleases HP cc)
1999-08-18 Jeff Hobbs <hobbs@scriptics.com>
- * doc/Eval.3: fixed doc on input args [Bug: 2114]
+ * doc/Eval.3: fixed doc on input args. [Bug 2114]
* doc/OpenFileChnl.3:
* doc/file.n:
* tests/cmdAH.test:
* tclIO.c:
* tclCmdAH.c: added "file channels ?pattern?" tcl command, with
- associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public
- C APIs (added to tcl.decls as well), with docs and tests.
+ associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public C APIs
+ (added to tcl.decls as well), with docs and tests.
* tests/expr.test:
- * generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types
- that cause differed compilation for exprs, to correct the expr
- double-evaluation problem for vars. Added test cases.
- Related to [Bug: 732]
+ * generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types that
+ cause differed compilation for exprs, to correct the expr
+ double-evaluation problem for vars. Added test cases. Related to [Bug
+ 732]
- * unix/Makefile.in: changed the dependency structure so that
- install-* is dependent on * (ie - install-binaries is dependent
- on binaries).
+ * unix/Makefile.in: changed the dependency structure so that install-*
+ is dependent on * (ie - install-binaries is dependent on binaries).
* library/auto.tcl:
* library/init.tcl:
@@ -668,14 +658,13 @@
* library/safe.tcl:
* library/word.tcl:
* library/http2.1/http.tcl:
- * library/msgcat1.0/msgcat.tcl: updated libraries to better
- Tcl style guide (no more string comparisons with == or !=, spacing
- changes).
+ * library/msgcat1.0/msgcat.tcl: updated libraries to better Tcl style
+ guide (no more string comparisons with == or !=, spacing changes).
1999-08-05 Jim Ingham <jingham@cygnus.com>
* mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build
- directory is separate from the sources. Much more convenient!
+ directory is separate from the sources. Much more convenient!
1999-08-13 Scott Redman <redman@scriptics.com>
@@ -683,18 +672,18 @@
1999-08-12 Scott Stanton <stanton@scriptics.com>
- * win/Makefile.in: Added COMPILE_DEBUG_FLAGS macro to make it
- easier to turn on compiler tracing.
+ * win/Makefile.in: Added COMPILE_DEBUG_FLAGS macro to make it easier
+ to turn on compiler tracing.
* tests/parse.test:
- * generic/tclParse.c: Fixed bug in Tcl_EvalEx where the termOffset
- was not being updated in cases where the evaluation returned a non
- TCL_OK error code. [Bug: 2535]
+ * generic/tclParse.c: Fixed bug in Tcl_EvalEx where the termOffset was
+ not being updated in cases where the evaluation returned a non TCL_OK
+ error code. [Bug 2535]
1999-08-12 Scott Redman <redman@scriptics.com>
- * win/tclWinSerial.c: Applied patch from Petteri Kettunen to
- remove compiler warning.
+ * win/tclWinSerial.c: Applied patch from Petteri Kettunen to remove
+ compiler warning.
1999-08-10 Scott Redman <redman@scriptics.com>
@@ -720,12 +709,11 @@
* generic/tclVar.c:
* mac/tclMacThrd.c:
* unix/tclUnixThrd.c:
- * win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c
- and tclCkalloc.c so they can be linked against alternate thread
- packages. Added Tcl_GetChannelNames to tclIO.c. Added
- TclVarTraceExists hook so "info exists" triggers read traces
- exactly like it did in Tcl 7.6. Stubs table changes to reflect new
- internal and external APIs.
+ * win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c and
+ tclCkalloc.c so they can be linked against alternate thread packages.
+ Added Tcl_GetChannelNames to tclIO.c. Added TclVarTraceExists hook so
+ "info exists" triggers read traces exactly like it did in Tcl 7.6.
+ Stubs table changes to reflect new internal and external APIs.
1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
@@ -733,23 +721,23 @@
machines and int overflow testing.
* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)
- * doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952]
- * doc/array.n: clarified array pattern docs [Bug: 1330]
- * doc/clock.n: fixed clock docs [Bug: 693]
+ * doc/Object.3: clarified Tcl_DecrRefCount docs. [Bug 1952]
+ * doc/array.n: clarified array pattern docs. [Bug 1330]
+ * doc/clock.n: fixed clock docs. [Bug 693]
* doc/lindex.n: clarified to account for new end-int behavior.
- * doc/string.n: fixed formatting errors [Bug: 2188 2189]
- * doc/tclvars.n: fixed doc error [Bug: 2042]
- * library/init.tcl: fixed path handling in auto_execok (it could
- miss including the normal path on some Windows machines) [Bug: 1276]
+ * doc/string.n: fixed formatting errors. [Bug 2188 2189]
+ * doc/tclvars.n: fixed doc error. [Bug 2042]
+ * library/init.tcl: fixed path handling in auto_execok (it could miss
+ including the normal path on some Windows machines). [Bug 1276]
1999-08-05 Jeff Hobbs <hobbs@scriptics.com>
- * doc/tclvars.n: Made it clear that tcl_pkgPath was not set
- for Windows (already mentioned in init.tcl) [Bug: 2455]
- * generic/tclLiteral.c: fixed reference to bytes that might
- not be null terminated (using objPtr->bytes, which is) [Bug: 2496]
- * library/http2.1/http.tcl: Made use of "i" in init section use
- local var and start at 0 (was 1). [Bug: 2502]
+ * doc/tclvars.n: Made it clear that tcl_pkgPath was not set for
+ Windows (already mentioned in init.tcl). [Bug 2455]
+ * generic/tclLiteral.c: fixed reference to bytes that might not be
+ null terminated (using objPtr->bytes, which is). [Bug 2496]
+ * library/http2.1/http.tcl: Made use of "i" in init section use local
+ var and start at 0 (was 1). [Bug 2502]
1999-08-04 Scott Stanton <stanton@scriptics.com>
@@ -762,7 +750,7 @@
* generic/regexec.c:
* generic/regguts.h: Applied patches supplied by Henry Spencer to
greatly enhance the performance of certain classes of regular
- expressions. [Bug: 2440, 2447]
+ expressions. [Bug 2440, 2447]
1999-08-03 Scott Redman <redman@scriptics.com>
@@ -782,104 +770,101 @@
* generic/tclIntDecls.h:
* generic/tclRegexp.h:
* generic/tclStubInit.c: Move some exported public and internal
- functions to the stub tables. Removed functions that are in the
- stub tables (from this and previous changes) from the original
- header files.
+ functions to the stub tables. Removed functions that are in the stub
+ tables (from this and previous changes) from the original header
+ files.
1999-08-01 Scott Redman <redman@scriptics.com>
- * win/tclWinSock.c: Added comment block to SocketThread()
- function. Added code to avoid calling TerminateThread(), but
- instead to send a message to the socket event window to tell it to
- terminate its thread.
+ * win/tclWinSock.c: Added comment block to SocketThread() function.
+ Added code to avoid calling TerminateThread(), but instead to send a
+ message to the socket event window to tell it to terminate its thread.
1999-07-30 Jennifer Hom <jenn@scriptics.com>
* tests/tcltest.test:
- * library/tcltest1.0/tcltest.tcl: Exit with non-zero status if
- there were problems with the way the test suite was started
- (e.g. wrong # arguments).
+ * library/tcltest1.0/tcltest.tcl: Exit with non-zero status if there
+ were problems with the way the test suite was started (e.g. wrong #
+ arguments).
1999-07-30 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclInt.decls: added declaractions necessary for the
- Tcl test code to work wth stubs [Bug: 2445]
+ * generic/tclInt.decls: added declaractions necessary for the Tcl test
+ code to work wth stubs. [Bug 2445]
1999-07-30 Scott Redman <redman@scriptics.com>
* win/tclWinPipe.c:
- * win/Makefile.in: Fixing launching of 16-bit apps on Win9x from
- wish. The command line was primed with tclpip82.dll, but it was
- ignored. Fixed that, then fixed the gmake makefile to build
- tclpip82.dll as an executable.
+ * win/Makefile.in: Fixing launching of 16-bit apps on Win9x from wish.
+ The command line was primed with tclpip82.dll, but it was ignored.
+ Fixed that, then fixed the gmake makefile to build tclpip82.dll as an
+ executable.
- * win/tclWinSock.c: Applied small patch to get thread-specific
- data after initializing the socket driver.
+ * win/tclWinSock.c: Applied small patch to get thread-specific data
+ after initializing the socket driver.
- * unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5.
- Patch from James Dennett. [Bug: 2450]
+ * unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5. Patch
+ from James Dennett. [Bug 2450]
- * tests/info.test: Enable test for tclParse.c change (info
- complete).
+ * tests/info.test: Enable test for tclParse.c change (info complete).
1999-07-30 Jeff Hobbs <hobbs@scriptics.com>
- * tclIO.c: added fix for Kupries' trf patch [Bug: 2386]
+ * tclIO.c: added fix for Kupries' trf patch. [Bug 2386]
* tclParse.c: fixed bug in info complete regarding nested square
- brackets [Bug: 2382, 2466]
+ brackets. [Bug 2382, 2466]
1999-07-29 Scott Redman <redman@scriptics.com>
* win/tclWinChan.c: Allow tcl to open CON and NUL, even for std
- channels. Checking for bad/unusable std channels was moved to Tk
- since its only purpose was to check whether to use the Tk Console
- Window for the std channels. [Bug: 2393 2392 2209 2458]
+ channels. Checking for bad/unusable std channels was moved to Tk since
+ its only purpose was to check whether to use the Tk Console Window for
+ the std channels. [Bug 2393 2392 2209 2458]
* unix/mkLinks.tcl: Applied patch to avoid linking pack.n to
- pack-old.n. Patch from Don Porter. [Bug: 2469]
+ pack-old.n. Patch from Don Porter. [Bug 2469]
- * doc/Encoding.n: Applied patch to fix typo in .SH NAME line.
- Patch from Don Porter. [Bug: 2451]
+ * doc/Encoding.n: Applied patch to fix typo in .SH NAME line. Patch
+ from Don Porter. [Bug 2451]
- * win/tclWinSock.c: Free Win32 Event handles when destroying
- the socket helper thread.
+ * win/tclWinSock.c: Free Win32 Event handles when destroying the
+ socket helper thread.
1999-07-28 Jennifer Hom <jenn@scriptics.com>
* tests/tcltest.test:
* library/tcltest1.0/tcltest.tcl: Fixed the condition under which
- ::tcltest::PrintError had an infinite loop problem and added a
- test case for it. Added an optional argument to
- ::tcltest::getMatchingFiles telling it where to search for test
- files.
+ ::tcltest::PrintError had an infinite loop problem and added a test
+ case for it. Added an optional argument to ::tcltest::getMatchingFiles
+ telling it where to search for test files.
1999-07-27 Scott Redman <redman@scriptics.com>
- * tools/tclSplash.bmp: Updated Windows installer bitmap
- to ready Tcl/Tk Version 8.2.
+ * tools/tclSplash.bmp: Updated Windows installer bitmap to ready
+ Tcl/Tk Version 8.2.
1999-07-26 Scott Redman <redman@scriptics.com>
- * tests/tcltest.test: Need to close the new core file, there
- seems to be a hang in threaded WinNT if the file isn't closed.
- Open issue, need to fix that hang.
+ * tests/tcltest.test: Need to close the new core file, there seems to
+ be a hang in threaded WinNT if the file isn't closed. Open issue, need
+ to fix that hang.
- * tests/httpold.test: Add time delay in response from Http server
- so that test cases can properly detect timeout conditions with
- threads enabled on multi-CPU WinNT.
+ * tests/httpold.test: Add time delay in response from Http server so
+ that test cases can properly detect timeout conditions with threads
+ enabled on multi-CPU WinNT.
- * tests/winFCmd.test: Test case winFcmd-1.33 was looking for
- c:\windows, which may not exist. Instead, create a new directory
- on c:\ and use it for the test.
+ * tests/winFCmd.test: Test case winFcmd-1.33 was looking for
+ c:\windows, which may not exist. Instead, create a new directory on
+ c:\ and use it for the test.
* win/tclWinConsole.c:
* win/tclWinPipe.c:
- * win/tclWinSock.c: Fix terminating helper threads by holding any
- mutexes from the primary thread while waiting for the helper
- thread to terminate. Without these changes, the test suite hangs
- on WinNT with 2 CPUs and threads enabled. Open issue, seems to be
- a sporadic hang on dual CPU systems still (very rare).
+ * win/tclWinSock.c: Fix terminating helper threads by holding any
+ mutexes from the primary thread while waiting for the helper thread to
+ terminate. Without these changes, the test suite hangs on WinNT with 2
+ CPUs and threads enabled. Open issue, seems to be a sporadic hang on
+ dual CPU systems still (very rare).
1999-07-26 Jennifer Hom <jenn@scriptics.com>
@@ -891,51 +876,51 @@
1999-07-23 Scott Redman <redman@scriptics.com>
* tests/info.test:
- * generic/tclParse.c: Removed patch for info command, breaks test
- cases on Unix. Patch was bad and needs to be redone
- properly. [Bug: 2382]
+ * generic/tclParse.c: Removed patch for info command, breaks test
+ cases on Unix. Patch was bad and needs to be redone properly. [Bug
+ 2382]
1999-07-22 Scott Redman <redman@scriptics.com>
* Changed version to 8.2b2.
- * win/tclWinSock.c: Fixed hang with threads enabled, fixed
- semaphores with threads disabled.
+ * win/tclWinSock.c: Fixed hang with threads enabled, fixed semaphores
+ with threads disabled.
* win/safe.test: Fixed safe-6.3 with threads enabled.
- * win/Makefile.in: Fixed calling of tcltest to fix safe.test
- failures due to path TCL_LIBRARY path.
+ * win/Makefile.in: Fixed calling of tcltest to fix safe.test failures
+ due to path TCL_LIBRARY path.
- * win/tclWinPort.h: Block out include of sys/*.h in order to
- build extensions with MetroWerks compiler for Win32. [Bug: 2385]
+ * win/tclWinPort.h: Block out include of sys/*.h in order to build
+ extensions with MetroWerks compiler for Win32. [Bug 2385]
* generic/tclCmdMZ.c:
* generic/tclIO.c: Fix ANSI-style prototypes based on patch from
- Ulrich Ring. [Bug: 2391]
+ Ulrich Ring. [Bug 2391]
- * unix/Makefile.in: Need to make install-sh executable before
- calling (with chmod +x). [Bug: 2413]
+ * unix/Makefile.in: Need to make install-sh executable before calling
+ (with chmod +x). [Bug 2413]
* tests/var.test:
- * generic/tclVar.c: Fixed bug that caused a seg. fault when using
- "array set a(b) {}", which is a bad array name anyway. Now the
- "array set" command will return an error in this case. Added test
- case and fixed existing test. [Bug: 2427]
+ * generic/tclVar.c: Fixed bug that caused a seg. fault when using
+ "array set a(b) {}", which is a bad array name anyway. Now the "array
+ set" command will return an error in this case. Added test case and
+ fixed existing test. [Bug 2427]
1999-07-21 Scott Redman <redman@scriptics.com>
* tests/info.test:
- * generic/tclParse.c: Applied patch to fix "info complete"
- for the string {[a [b]}. Patch from Peter Spjuth. [Bug: 2382]
+ * generic/tclParse.c: Applied patch to fix "info complete" for the
+ string {[a [b]}. Patch from Peter Spjuth. [Bug 2382]
* doc/Utf.3:
* generic/tcl.decls:
* generic/tclDecls.h:
* generic/tclUtf.c: Changed function declarations in
non-platform-specific public APIs to use "unsigned long" instead of
- "size_t", which may not be defined on certain compilers (rather
- than include sys/types.h, which may not exist).
+ "size_t", which may not be defined on certain compilers (rather than
+ include sys/types.h, which may not exist).
* unix/Makefile.in: Added the Windows configure script to the
distribution file list, already shipping configure.in and the .m4
@@ -950,17 +935,16 @@
* tests/ioCmd.test:
* doc/open.n:
* win/tclWinSerial.c: Applied patch from Rolf Schroedter to add
- -pollinterval option to fconfigure to modify the maxblocktime used
- in the fileevent polling. Added documentation and fixed the test
- case as well.
-
- * win/tclWinSock.c: Modified 8.1.0 version of the Win32 socket
- driver to move the handling of the socket event window in a
- separate thread. It also turned out that Win95 & Win98 were, in
- some cases, getting multiple FD_ACCEPTs but only handling one.
- Added a count for the FD_ACCEPT to take care of this. Tested on
- NT4 SP3, NT4 SP4, Win95, and Win98.
- [Bug: 2178 2256 2259 2329 2323 2355]
+ -pollinterval option to fconfigure to modify the maxblocktime used in
+ the fileevent polling. Added documentation and fixed the test case as
+ well.
+
+ * win/tclWinSock.c: Modified 8.1.0 version of the Win32 socket driver
+ to move the handling of the socket event window in a separate thread.
+ It also turned out that Win95 & Win98 were, in some cases, getting
+ multiple FD_ACCEPTs but only handling one. Added a count for the
+ FD_ACCEPT to take care of this. Tested on NT4 SP3, NT4 SP4, Win95, and
+ Win98. [Bug 2178 2256 2259 2329 2323 2355]
1999-07-21 Jerry Peek <jpeek@scriptics.com>
@@ -969,11 +953,11 @@
1999-07-20 Melissa Hirschl <hershey@matisse.scriptics.com>
* generic/tclInitScript.h:
- * unix/tclUnixInit.c: merged code with 8.0.5. We now use an
+ * unix/tclUnixInit.c: merged code with 8.0.5. We now use an
intermediate global tcl var "tclDefaultLibrary" to keep the
- "tcl_library" var from being set by the default value in the
- Makefile. Also fixed a bug in which caused the value of
- TCL_LIBRARY env var to be ignored.
+ "tcl_library" var from being set by the default value in the Makefile.
+ Also fixed a bug in which caused the value of TCL_LIBRARY env var to
+ be ignored.
* unix/tclWinInit.c: just updated some comments.
1999-07-19 Melissa Hirschl <hershey@matisse.scriptics.com>
@@ -985,16 +969,14 @@
* generic/tcl.decls:
* generic/tclDecls.h:
- * generic/tclStubInit.c: Add Tcl_SetNotifier to stub table.
- [Bug: 2364]
+ * generic/tclStubInit.c: Add Tcl_SetNotifier to stub table. [Bug 2364]
* unix/aclocal.m4:
- * unix/tcl.m4: Add check for Alpha/Linux to correct the IEEE
- floating flag to the compiler, should be -mieee. Patch from Don
- Porter.
+ * unix/tcl.m4: Add check for Alpha/Linux to correct the IEEE floating
+ flag to the compiler, should be -mieee. Patch from Don Porter.
- * tools/tcl.hpj.in: Change version number of .cnt file referenced
- in .HPJ file.
+ * tools/tcl.hpj.in: Change version number of .cnt file referenced in
+ .HPJ file.
1999-07-15 Scott Redman <redman@scriptics.com>
@@ -1006,73 +988,72 @@
1999-07-12 Jerry Peek <jpeek@scriptics.com>
- * doc/re_syntax.n: Removed two notes to myself (oops), cleaned
- up wording, fixed changebars, made two examples easier to read.
+ * doc/re_syntax.n: Removed two notes to myself (oops), cleaned up
+ wording, fixed changebars, made two examples easier to read.
1999-07-11 Scott Redman <redman@scriptics.com>
- * win/makefile.vc: Since the makefile.vc should continue to work
- while we're working out bugs/issues in the new TEA-style
+ * win/makefile.vc: Since the makefile.vc should continue to work while
+ we're working out bugs/issues in the new TEA-style
autoconf/configure/gmake build mechanism for Windows, the version
- numbers of the Tcl libraries need to remain in sync. Modified the
+ numbers of the Tcl libraries need to remain in sync. Modified the
version numbers in the makefile to reflect the change to 8.2b1.
1999-07-09 Scott Redman <redman@scriptics.com>
- * win/configure.in: Eval DLLSUFFIX, LIBSUFFIX, and EXESUFFIX in
- the configure script so that substitutions get expanded before
- being placed in the Makefile. The "d" portion for debug libraries
- and DLLs was not being set properly.
+ * win/configure.in: Eval DLLSUFFIX, LIBSUFFIX, and EXESUFFIX in the
+ configure script so that substitutions get expanded before being
+ placed in the Makefile. The "d" portion for debug libraries and DLLs
+ was not being set properly.
1999-07-08 Scott Stanton <stanton@scriptics.com>
* tests/string.test:
- * generic/tclCmdMZ.c: Fixed bug in string range bounds checking
- code.
+ * generic/tclCmdMZ.c: Fixed bug in string range bounds checking code.
1999-07-08 Jennifer Hom <jenn@scriptics.com>
* doc/tcltest.n:
* library/tcltest1.0/tcltest.tcl: Removed -asidefromdir and
- -relateddir flags, removed unused ::tcltest::dotests proc, cleaned
- up implementation of core file checking, and fixed the code that
- checks for 1-letter flag abbreviations.
+ -relateddir flags, removed unused ::tcltest::dotests proc, cleaned up
+ implementation of core file checking, and fixed the code that checks
+ for 1-letter flag abbreviations.
1999-07-08 Scott Stanton <stanton@scriptics.com>
- * win/Makefile.in: Added tcltest target so runtest works
- properly. Added missing names to the clean/distclean targets.
+ * win/Makefile.in: Added tcltest target so runtest works properly.
+ Added missing names to the clean/distclean targets.
* tests/reg.test:
- * generic/rege_dfa.c: Applied fix supplied by Henry Spencer for
- bug in DFA state caching under lookahead conditions. [Bug: 2318]
+ * generic/rege_dfa.c: Applied fix supplied by Henry Spencer for bug in
+ DFA state caching under lookahead conditions. [Bug 2318]
1999-07-07 Scott Stanton <stanton@scriptics.com>
* doc/fconfigure.n: Clarified default buffering behavior for the
- standard channels. [Bug: 2335]
+ standard channels. [Bug 2335]
1999-07-06 Scott Redman <redman@scriptics.com>
- * win/tclWinSerial.c: New implementation of serial port driver
- from Rolf Shroedter (Rolf.Schroedter@dlr.de) that allows more than
- one byte to be read from the port. Implemented using polling
- instead of threads, there is a max. 10ms latency between checking the
- port for file events. [Bug: 1980 2217]
+ * win/tclWinSerial.c: New implementation of serial port driver from
+ Rolf Shroedter (Rolf.Schroedter@dlr.de) that allows more than one byte
+ to be read from the port. Implemented using polling instead of
+ threads, there is a max. 10ms latency between checking the port for
+ file events. [Bug 1980 2217]
1999-07-06 Brent Welch <welch@scriptics.com>
- * library/http2.0/http.tcl: Fixed the -timeout option so it
- handles timeouts that occur during connection attempts to
- hosts that are down (the only case that really matters!)
+ * library/http2.0/http.tcl: Fixed the -timeout option so it handles
+ timeouts that occur during connection attempts to hosts that are down
+ (the only case that really matters!)
1999-07-03 Brent Welch <welch@scriptics.com>
* doc/ChnlStack.3:
* generic/tcl.decls:
- * generic/tclIO.c: Added a new variant of the "Trf patch"
- from Andreas Kupres that adds new C APIs Tcl_StackChannel,
- Tcl_UnstackChannel, and Tcl_GetStackedChannel.
+ * generic/tclIO.c: Added a new variant of the "Trf patch" from Andreas
+ Kupres that adds new C APIs Tcl_StackChannel, Tcl_UnstackChannel, and
+ Tcl_GetStackedChannel.
1999-07-03 Brent Welch <welch@scriptics.com>
@@ -1081,17 +1062,16 @@
* unix/tclXtTest.c:
* unix/tclXtNotify.c:
* win/tclWinNotify.c:
- * mac/tclMacNotify.c: Added Tcl_SetNotifier and the associated
- hook points in the notifiers to be able to replace the notifier
- calls at runtime The Xt notifier and test program use this hook.
+ * mac/tclMacNotify.c: Added Tcl_SetNotifier and the associated hook
+ points in the notifiers to be able to replace the notifier calls at
+ runtime. The Xt notifier and test program use this hook.
1999-07-03 Brent Welch <welch@scriptics.com>
- * generic/tclParse.c: Changed parsing of variable names to
- allow empty array names. Now "$(foo)" is a variable reference!
- Previous you had to use something like $::(foo), which is slower.
- This change is requested by Jean-Luc Fontaine for his STOOOP
- package.
+ * generic/tclParse.c: Changed parsing of variable names to allow empty
+ array names. Now "$(foo)" is a variable reference! Previous you had to
+ use something like $::(foo), which is slower. This change is requested
+ by Jean-Luc Fontaine for his STOOOP package.
1999-07-01 Scott Redman <redman@scriptics.com>
@@ -1104,30 +1084,27 @@
* library/tcltest1.0/pkgIndex.tcl:
* library/tcltest1.0/tcltest.tcl:
* doc/tcltest.n:
- * tests/all.tcl: Added -preservecore, -limitconstraints, -help,
- -file, -notfile, -relateddir and -asidefromdir flags to the
- tcltest package along with exported proc
- ::tcltest::getMatchingFiles. The documentation was modified to
- match and all.tcl was modified to use the new functionality
- instead of implementing -file itself.
+ * tests/all.tcl: Added -preservecore, -limitconstraints, -help, -file,
+ -notfile, -relateddir and -asidefromdir flags to the tcltest package
+ along with exported proc ::tcltest::getMatchingFiles. The
+ documentation was modified to match and all.tcl was modified to use
+ the new functionality instead of implementing -file itself.
1999-06-28 Scott Redman <redman@scriptics.com>
* generic/tclIndexObj.c:
* doc/GetIndex.3:
* tests/binary.test:
- * tests/winDde.test: Applied patch from Peter Hardie (with
- changes) to fix problem with Tcl_GetIndexFromObj() when the key
- being passed is the empty string. It used to match "" and return
- TCL_OK, but it should have returned TCL_ERROR instead. Added test
- case to "binary" and "dde" commands to check the behavior. Added
- documentation note as well.
+ * tests/winDde.test: Applied patch from Peter Hardie (with changes) to
+ fix problem with Tcl_GetIndexFromObj() when the key being passed is
+ the empty string. It used to match "" and return TCL_OK, but it should
+ have returned TCL_ERROR instead. Added test case to "binary" and "dde"
+ commands to check the behavior. Added documentation note as well.
1999-06-26 Scott Redman <redman@scriptics.com>
- * win/tclWinDde.c: Applied patch from Peter Hardie to add poke
- command to dde. Also rev'd version of dde package to 1.1.
- [Bug: 1738]
+ * win/tclWinDde.c: Applied patch from Peter Hardie to add poke command
+ to dde. Also rev'd version of dde package to 1.1. [Bug 1738]
1999-06-25 Jennifer Hom <jenn@scriptics.com>
@@ -1136,18 +1113,17 @@
* library/tcltest1.0/pkgIndex.tcl:
* library/tcltest1.0/tcltest.tcl:
* library/tcltest1.0: Added initial implementation of the Tcl test
- harness package. This package was based on the defs.tcl file that
- was part of the tests directory. Reversed the way that tests were
+ harness package. This package was based on the defs.tcl file that was
+ part of the tests directory. Reversed the way that tests were
evaluated to fix a problem with false passes.
* doc/tcltest.n: Added documentation for the tcltest package.
* tests/README:
* tests/defs.tcl:
- * tests/all.tcl: Modified all test files (tests/*.test) and
- all.tcl to use the new tcltest package and removed references to
- the defs.tcl file. Modified the README file to point to the man
- page for tcltest.
+ * tests/all.tcl: Modified all test files (tests/*.test) and all.tcl to
+ use the new tcltest package and removed references to the defs.tcl
+ file. Modified the README file to point to the man page for tcltest.
1999-06-25 Scott Stanton <stanton@scriptics.com>
@@ -1162,8 +1138,8 @@
* doc/RegExp.3:
* doc/regexp.n:
* doc/regsub.n: Moved information about syntax of 8.1 regular
- expressions from regexp(n) manpage into new re_syntax(n) page.
- Added pointers from other manpages to new re_syntax(n) page.
+ expressions from regexp(n) manpage into new re_syntax(n) page. Added
+ pointers from other manpages to new re_syntax(n) page.
1999-06-23 Scott Stanton <stanton@scriptics.com>
@@ -1177,34 +1153,34 @@
* generic/tclUniData.c:
* generic/tclUtf.c:
* doc/string.n: Updated Unicode character tables to reflect latest
- Unicode 2.1 data. Also rationalized "regexp" and "string is"
+ Unicode 2.1 data. Also rationalized "regexp" and "string is"
definitions of character classes.
1999-06-21 Scott Stanton <stanton@scriptics.com>
* unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where
- thread attributes were not being released. [Bug: 2254]
+ thread attributes were not being released. [Bug 2254]
1999-06-17 Scott Stanton <stanton@scriptics.com>
* tests/regexp.test:
* generic/tclCmdMZ.c:
- * generic/tclCmdIL.c: Changed to use new regexp interfaces. Added
+ * generic/tclCmdIL.c: Changed to use new regexp interfaces. Added
-expanded, -line, -linestop, and -lineanchor switches to regsub.
- * doc/RegExp.3: Documented the new regexp interfaces and
- the compile/execute flags.
+ * doc/RegExp.3: Documented the new regexp interfaces and the
+ compile/execute flags.
* generic/tclTest.c:
* generic/tclRegexp.h:
* generic/tclRegexp.c:
* generic/tcl.h:
- * generic/tcl.decls: Renamed Tcl_RegExpMatchObj to
- Tcl_RegExpExecObj and added a new Tcl_RegExpMatchObj that is
- equivalent to Tcl_RegExpMatch. Added public macros for the regexp
- compile/execute flags. Changed to store either an object pointer
- or a string pointer in the TclRegexp structure. Changed to avoid
- adding a reference to the object or copying the string.
+ * generic/tcl.decls: Renamed Tcl_RegExpMatchObj to Tcl_RegExpExecObj
+ and added a new Tcl_RegExpMatchObj that is equivalent to
+ Tcl_RegExpMatch. Added public macros for the regexp compile/execute
+ flags. Changed to store either an object pointer or a string pointer
+ in the TclRegexp structure. Changed to avoid adding a reference to the
+ object or copying the string.
* generic/regcomp.c: lint
@@ -1214,7 +1190,7 @@
iterate through a string an only find matches that start at the
current position within the string.
-1999-06-16 <wart@scriptics.com>
+1999-06-16 Michael Thomas <wart@scriptics.com>
* unix/configure.in:
* unix/Makefile.in:
@@ -1224,15 +1200,15 @@
1999-06-16 Melissa Hirschl <hershey@matisse.scriptics.com>
- * generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment
- in loop that was causing out-of-bounds reads on array "varName".
+ * generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment in
+ loop that was causing out-of-bounds reads on array "varName".
1999-06-16 Scott Stanton <stanton@scriptics.com>
* tests/execute.test:
- * generic/tclExecute.c (TclExecuteByteCode): Fixed crash caused by
- a bug in INST_LOAD_SCALAR1 where the scalar index was read as
- a signed 1 byte value instead of unsigned. [Bug: 2243]
+ * generic/tclExecute.c (TclExecuteByteCode): Fixed crash caused by a
+ bug in INST_LOAD_SCALAR1 where the scalar index was read as a signed 1
+ byte value instead of unsigned. [Bug 2243]
1999-06-14 Melissa Hirschl <hershey@matisse.scriptics.com>
@@ -1242,34 +1218,33 @@
* win/Makefile.in
* win/makefile.vc
* generic/tclStringObj.c:
- Merged String and Unicode object types. Added new functions to
- the puplic API: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj,
- Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
+ Merged String and Unicode object types. Added new functions to the
+ puplic API: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj, Tcl_GetUnicode,
+ Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
Tcl_AppendUnicodeToObj.
1999-06-09 Scott Stanton <stanton@scriptics.com>
- * generic/tclUnicodeObj.c: Lots of cleanup and simplification.
- Fixed several memory bugs. Added TclAppendUnicodeToObj.
+ * generic/tclUnicodeObj.c: Lots of cleanup and simplification. Fixed
+ several memory bugs. Added TclAppendUnicodeToObj.
* generic/tclInt.h: Added declarations for various Unicode string
functions.
* generic/tclRegexp.c:
- * generic/tclCmdMZ.c: Changed to use new Unicode string interfaces
- for better performance.
+ * generic/tclCmdMZ.c: Changed to use new Unicode string interfaces for
+ better performance.
* generic/tclRegexp.h:
* generic/tclRegexp.c:
* generic/tcl.h:
- * generic/tcl.decls: Added Tcl_RegExpMatchObj and
- Tcl_RegExpGetInfo calls to access lower level regexp API. These
- features are needed by Expect. This is a preliminary
- implementation pending final review and cleanup.
+ * generic/tcl.decls: Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo
+ calls to access lower level regexp API. These features are needed by
+ Expect. This is a preliminary implementation pending final review and
+ cleanup.
* generic/tclCmdMZ.c:
- * tests/string.test: Fixed bug where string map failed on null
- strings.
+ * tests/string.test: Fixed bug where string map failed on null strings
* generic/regexec.c:
* unix/tclUnixNotfy.c: lint
@@ -1278,21 +1253,20 @@
1999-06-08 Scott Stanton <stanton@scriptics.com>
- * win/tclWinSock.c: Rolled back to the 8.1.0 implementation
- because of serious problems with the new driver. Basically no
- incoming socket connections would be reported to a server port.
- The 8.1.1 code needs to be redesigned and fixed correctly.
+ * win/tclWinSock.c: Rolled back to the 8.1.0 implementation because of
+ serious problems with the new driver. Basically no incoming socket
+ connections would be reported to a server port. The 8.1.1 code needs
+ to be redesigned and fixed correctly.
1999-06-07 Melissa Hirschl <hershey@matisse.scriptics.com>
* tests/string.test:
* generic/tclVar.c (Tcl_SetVar2Ex):
* generic/tclStringObj.c (Tcl_AppendObjToObj):
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): optimized the string
- index, string length, string range, and append command in cases
- where the object's internal rep is a bytearray. Objects with
- other internal reps are converted to have the new unicode internal
- rep.
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): optimized the string index,
+ string length, string range, and append command in cases where the
+ object's internal rep is a bytearray. Objects with other internal reps
+ are converted to have the new unicode internal rep.
* unix/Makefile.in:
* win/Makefile.in:
@@ -1304,31 +1278,31 @@
unicode representation of a string.
* generic/tclTestObj.c: added the objtype option to the testobj
- command. This option returns the name of the type of internal rep
- an object has.
+ command. This option returns the name of the type of internal rep an
+ object has.
1999-06-04 Scott Stanton <stanton@scriptics.com>
* win/configure.in:
* win/Makefile.in: Windows build now handles static/dynamic
- debug/nodebug builds and supports the standard targets using
- Cygwin user tools plus GNU make and autoconf.
+ debug/nodebug builds and supports the standard targets using Cygwin
+ user tools plus GNU make and autoconf.
1999-06-03 Scott Stanton <stanton@scriptics.com>
* generic/tclCmdMZ.c (Tcl_StringObjCmd):
* tests/string.test: Fixed bug where string equal/compare -nocase
- reported wrong result on null strings. [Bug: 2138]
+ reported wrong result on null strings. [Bug 2138]
1999-06-02 Scott Stanton <stanton@scriptics.com>
- * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation
- of relative ordering. [Bug: 2135]
+ * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation of
+ relative ordering. [Bug 2135]
1999-06-01 Scott Stanton <stanton@scriptics.com>
* unix/configure.in: Fixed various small configure.in patches
- submitted by Jan Nijtmans. [Bug: 2121]
+ submitted by Jan Nijtmans. [Bug 2121]
* tests/reg.test:
* generic/regc_color.c:
@@ -1350,8 +1324,8 @@
* generic/tclRegexp.c:
* generic/tclRegexp.h:
* generic/tclTest.c: Applied Henry Spencer's latest regexp patches
- that fix an infinite loop bug and add support for testing whether
- a string could match with additional input. [Bug: 2117]
+ that fix an infinite loop bug and add support for testing whether a
+ string could match with additional input. [Bug 2117]
1999-05-28 Scott Stanton <stanton@scriptics.com>
@@ -1362,22 +1336,21 @@
* win/configure.in: Added preliminary TEA implementation.
* win/tclWinDde.c: Fixed bug where dde calls were being passed an
- invalid dde handle because Initialize had not been called.
- [Bug: 2124]
+ invalid dde handle because Initialize had not been called. [Bug 2124]
1999-05-26 Scott Redman <redman@scriptic.com>
- * generic/tclThreadTest.c: Fixed race condition in testthread
- code that showed up in the WinNT test suite intermittently.
+ * generic/tclThreadTest.c: Fixed race condition in testthread code
+ that showed up in the WinNT test suite intermittently.
- * win/tclWinSock.c: Fixed a hang in the WinNT socket driver, wake
- up the socket thread every 100ms to check for events on the
- sockets that did not wake up the thread (race condition).
+ * win/tclWinSock.c: Fixed a hang in the WinNT socket driver, wake up
+ the socket thread every 100ms to check for events on the sockets that
+ did not wake up the thread (race condition).
1999-05-24 Scott Stanton <stanton@scriptics.com>
- * tools/genStubs.tcl: Changed to allow a list of platforms instead
- of just one at a time.
+ * tools/genStubs.tcl: Changed to allow a list of platforms instead of
+ just one at a time.
* generic/tcl.decls:
* generic/tclCmdMZ.c:
@@ -1391,22 +1364,22 @@
1999-05-21 Scott Redman <redman@scriptics.com>
- * win/tclWinPipe.c: Fix bug when launching command.com on
- Win95/98. Need to wait for the procInfo.hProcess of the process that
- was created, not the hProcess of the current process. [Bug: 2105]
+ * win/tclWinPipe.c: Fix bug when launching command.com on Win95/98.
+ Need to wait for the procInfo.hProcess of the process that was
+ created, not the hProcess of the current process. [Bug 2105]
1999-05-20 Scott Redman <redman@scriptics.com>
- * library/init.tcl: Add the directory where the executable is, and
- the ../lib directory relative to that, to the auto_path variable.
+ * library/init.tcl: Add the directory where the executable is, and the
+ ../lib directory relative to that, to the auto_path variable.
1999-05-19 Scott Stanton <stanton@scriptics.com>
Merged in various changes submitted by Jeff Hobbs:
* generic/tcl.decls:
- * generic/tclUtf.c: Added Tcl_UniCharIs* functions for control,
- graph, print, and punct classes.
+ * generic/tclUtf.c: Added Tcl_UniCharIs* functions for control, graph,
+ print, and punct classes.
* generic/tclUtil.c:
* doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
@@ -1415,59 +1388,57 @@
* doc/string.n:
* unix/mkLinks:
* tests/string.test:
- * generic/tclCmdMZ.c: Added additional character class tests,
- added -nocase switch to "string match", changed string first/last
- to use offsets.
+ * generic/tclCmdMZ.c: Added additional character class tests, added
+ -nocase switch to "string match", changed string first/last to use
+ offsets.
1999-05-19 Scott Redman <redman@scriptics.com>
* generic/tcl.h: Add extern "C" block around entire header file for
- C++ compilers to fix linkage issues. Submitted by Don Porter and
- Paul Duffin.
+ C++ compilers to fix linkage issues. Submitted by Don Porter and Paul
+ Duffin.
- * generic/tclRegexp.c: Fix bug when the regexp cache is empty
- and an empty pattern is used in regexp ( such as {} or "" ).
+ * generic/tclRegexp.c: Fix bug when the regexp cache is empty and an
+ empty pattern is used in regexp ( such as {} or "" ).
1999-05-18 Scott Stanton <stanton@scriptics.com>
- * win/tclWinChan.c: Modified initialization code to avoid
- inherenting closed or invalid channels. If the standard input is
- anything other than a console, file, serial port, or pipe, then we
- fall back to the standard Tk window console.
+ * win/tclWinChan.c: Modified initialization code to avoid inherenting
+ closed or invalid channels. If the standard input is anything other
+ than a console, file, serial port, or pipe, then we fall back to the
+ standard Tk window console.
1999-05-14 Scott Stanton <stanton@scriptics.com>
- * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by
- failure to reset the result before evaluating the test
- expression.
+ * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by failure to
+ reset the result before evaluating the test expression.
1999-05-14 Bryan Surles <surles@scriptics.com>
- * generic/tclBasic.c (Tcl_CreateInterp): Added introspection
- variable for threaded interps. If the interp was compiled with
- threads enabled, the tcl_platform(threaded) variable will exist.
+ * generic/tclBasic.c (Tcl_CreateInterp): Added introspection variable
+ for threaded interps. If the interp was compiled with threads enabled,
+ the tcl_platform(threaded) variable will exist.
1999-05-14 Scott Redman <redman@scriptics.com>
* generic/tclDate.c: Applied patch to fix 100-year and 400-year
- boundaries in leap year code, from Isaac Hollander. [Bug: 2066]
+ boundaries in leap year code, from Isaac Hollander. [Bug 2066]
1999-05-13 Scott Stanton <stanton@scriptics.com>
* unix/Makefile.in:
* unix/tclAppInit.c: Minor cleanup related to Xt notifier.
- * unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for
- an encoding subfield in the LANG/LC_ALL variables in cases where
- the locale is not found in the locale table. Ensure that
- setlocale() is called at least once so X11 will initialize
- properly. Also, forces the LC_NUMERIC locale to be "C" so numeric
- processing in scripts is not affected by the current locale
- setting. [Bug: 1989]
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for an
+ encoding subfield in the LANG/LC_ALL variables in cases where the
+ locale is not found in the locale table. Ensure that setlocale() is
+ called at least once so X11 will initialize properly. Also, forces the
+ LC_NUMERIC locale to be "C" so numeric processing in scripts is not
+ affected by the current locale setting. [Bug 1989]
- * generic/tclRegexp.c: Increased per-thread regexp cache to 30
- slots. This seems to be about the right number for larger
- applications like exmh. [Bug: 1063]
+ * generic/tclRegexp.c: Increased per-thread regexp cache to 30 slots.
+ This seems to be about the right number for larger applications like
+ exmh. [Bug 1063]
1999-05-12 Scott Stanton <stanton@scriptics.com>
@@ -1478,47 +1449,47 @@
* generic/tclInt.h:
* generic/tclBasic.c:
* generic/tclRegexp.h:
- * generic/tclRegexp.c: Replaced the per-interpreter regexp cache
- with a per-thread cache. Changed the Regexp object to take
- advantage of this extra cache. Added a reference count to the
- TclRegexp type so regexps can be shared by multiple objects.
- Removed the per-interp regexp cache from the interpreter. Now
- regexps can be used with no need for an interpreter. [Bug: 1063]
+ * generic/tclRegexp.c: Replaced the per-interpreter regexp cache with
+ a per-thread cache. Changed the Regexp object to take advantage of
+ this extra cache. Added a reference count to the TclRegexp type so
+ regexps can be shared by multiple objects. Removed the per-interp
+ regexp cache from the interpreter. Now regexps can be used with no
+ need for an interpreter. [Bug 1063]
- * win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName
- if the value can be determined from the USERNAME environment
- variable. GetUserName is very slow.
+ * win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName if
+ the value can be determined from the USERNAME environment variable.
+ GetUserName is very slow.
1999-05-07 Scott Stanton <stanton@scriptics.com>
* win/winDumpExts.c:
- * win/makefile.vc: Removed incorrect patch. [Bug: 1998]
+ * win/makefile.vc: Removed incorrect patch. [Bug 1998]
* generic/tcl.decls: Replaced const with CONST.
* generic/tclResult.c (Tcl_AppendResultVA):
* generic/tclStringObj.c (Tcl_AppendStringsToObjVA): Fixed to copy
arglist using memcpy instead of assignment so it works properly on
- OS/390. [Bug: 1997]
+ OS/390. [Bug 1997]
* generic/tclLoadNone.c: Updated to use current interfaces, added
- TclpUnloadFile. [Bug: 2003]
+ TclpUnloadFile. [Bug 2003]
* win/winDumpExts.c:
- * win/makefile.vc: Changed to emit library name in defs
- file. [Bug: 1998]
+ * win/makefile.vc: Changed to emit library name in defs file. [Bug
+ 1998]
- * unix/configure.in: Added fix for OS/390. [Bug: 1976]
+ * unix/configure.in: Added fix for OS/390. [Bug 1976]
1999-05-06 Scott Stanton <stanton@scriptics.com>
* tests/string.test:
* generic/tclCmdMZ.c:
* doc/string.n: Fixed bug in string equal/compare code when using
- -length option. Cleaned up docs a bit more.
+ -length option. Cleaned up docs a bit more.
- * tests/http.test: Unset "data" array before running tests to
- avoid failures due to previous tests.
+ * tests/http.test: Unset "data" array before running tests to avoid
+ failures due to previous tests.
* doc/string.n:
* tests/cmdIL.test:
@@ -1532,12 +1503,11 @@
* tests/string.test:
* tests/cmdIL.test:
* generic/tclUtil.c:
- * generic/tclCmdMZ.c: Replaced "string icompare/iequal" with
- -nocase and -length switches to "string compare/equal". Added a
- -nocase option to "string map". Changed index syntax to allow
- integer or end?-integer? instead of a full expression. This is
- much simpler with safeTcl scripts since it avoids double
- substitution issues.
+ * generic/tclCmdMZ.c: Replaced "string icompare/iequal" with -nocase
+ and -length switches to "string compare/equal". Added a -nocase option
+ to "string map". Changed index syntax to allow integer or
+ end?-integer? instead of a full expression. This is much simpler with
+ safeTcl scripts since it avoids double substitution issues.
* doc/Utf.3:
* generic/tclStubInit.c:
@@ -1555,8 +1525,8 @@
* doc/string.n:
* tests/cmdMZ.test:
* tests/string.test:
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed "string length"
- to avoid regenerating the string rep of a ByteArray object.
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed "string length" to
+ avoid regenerating the string rep of a ByteArray object.
* tests/cmdIL.test:
* tests/cmdMZ.test:
@@ -1567,53 +1537,40 @@
* tests/lreplace.test:
* tests/string.test:
* generic/tclCmdMZ.c (Tcl_StringObjCmd):
- * generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's
- string patch which includes the following changes [Bug: 1845]:
-
- - string compare now takes optional length arg (for strncmp
- behavior)
-
- - added string equal (just a few lines of code blended
- in with string compare)
-
- - added string icompare/iequal for case-insensitive comparisons
-
- - string index's index can now be ?end[+-]?expression
- I made this change in the private TclGetIntForIndex,
- which means that the list commands also benefit, as
- well as string range, et al.
-
- - added [string repeat string count]
- Repeats given string number of times
-
- - added string replace, string equiv to lreplace
- (quasi opposite of string range):
- string replace first last ?string?
- Example of use, replacing end of string with ...
- should the string be more than 16 chars long:
- string replace $string 16 end "..."
- This just returns the string len < 16, so it
- will only affect the long strings.
-
- - added optional first and last args to string to*
- This allows you to just affect certain regions of
- a string with the command (like just capping the
- first letter). I found the original totitle to
- be too draconian to be useful.
-
- - added [string map charMap string]
- where charMap is a {from to from to} list that equates to
- what one might get from [array get]. Each and
- can be multiple chars (or none at all). For Tcl/CGI users,
- this is a MAJOR speed booster.
-
- * generic/tclParse.c (Tcl_ParseCommand): Changed to avoid
- modifying eval'ed strings that are already null terminated.
- [Bug: 1793]
+ * generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's string
+ patch which includes the following changes [Bug 1845]:
+ - string compare now takes optional length arg (for strncmp behavior)
+ - added string equal (just a few lines of code blended in with string
+ compare)
+ - added string icompare/iequal for case-insensitive comparisons
+ - string index's index can now be ?end[+-]?expression
+ I made this change in the private TclGetIntForIndex, which means
+ that the list commands also benefit, as well as string range, et al.
+ - added [string repeat string count]
+ Repeats given string number of times
+ - added string replace, string equiv to lreplace
+ (quasi opposite of string range):
+ string replace first last ?string?
+ Example of use, replacing end of string with ... should the string
+ be more than 16 chars long:
+ string replace $string 16 end "..."
+ This just returns the string len < 16, so it will only affect the
+ long strings.
+ - added optional first and last args to string to*
+ This allows you to just affect certain regions of a string with the
+ command (like just capping the first letter). I found the original
+ totitle to be too draconian to be useful.
+ - added [string map charMap string]
+ where charMap is a {from to from to} list that equates to what one
+ might get from [array get]. Each and can be multiple chars (or none
+ at all). For Tcl/CGI users, this is a MAJOR speed booster.
+
+ * generic/tclParse.c (Tcl_ParseCommand): Changed to avoid modifying
+ eval'ed strings that are already null terminated. [Bug 1793]
* tests/binary.test:
- * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where
- type was not being set in duplicated object. [Bug: 1975, 2047]
+ * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where type
+ was not being set in duplicated object. [Bug 1975, 2047]
1999-04-30 Scott Stanton <stanton@scriptics.com>
@@ -1630,8 +1587,8 @@
* generic/tclIntDecls.h:
* generic/tclDecls.h:
* tools/genStubs.tcl: Added 'extern "C" {}' block around the stub
- table pointer declaration so the stub library can be used from
- C++. [Bug: 1934]
+ table pointer declaration so the stub library can be used from C++.
+ [Bug 1934]
* Lots of documentation and other release engineering fixes.
@@ -1641,15 +1598,14 @@
* generic/tclListObj.c:
* generic/tclObj.c:
* generic/tclStringObj.c: Changed to avoid freeing the string
- representation before freeing the internal rep. This helps with
- debugging since the string rep will still be valid when the free
- proc is invoked.
+ representation before freeing the internal rep. This helps with
+ debugging since the string rep will still be valid when the free proc
+ is invoked.
1999-04-27 Scott Stanton <stanton@scriptics.com>
- * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals
- get duplicated to avoid accidental sharing in the global object
- table.
+ * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals get
+ duplicated to avoid accidental sharing in the global object table.
1999-04-23 Scott Stanton <stanton@scriptics.com>
@@ -1661,37 +1617,37 @@
* library/encoding/koi8-r.enc:
* tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic
- encoding. [Bug: 1771]
+ encoding. [Bug 1771]
1999-04-22 Scott Stanton <stanton@scriptics.com>
* win/tclWinFCmd.c:
- * win/tclWin32Dll.c: Changed uses of "try" to "__try", since that
- is the actual keyword. This eliminates the need for some -D flags
- from the makefile.
+ * win/tclWin32Dll.c: Changed uses of "try" to "__try", since that is
+ the actual keyword. This eliminates the need for some -D flags from
+ the makefile.
- * generic/tclPort.h: Added include of tcl.h since it defines
- various Windows macros that are needed before deciding which
- platform porting file to use.
+ * generic/tclPort.h: Added include of tcl.h since it defines various
+ Windows macros that are needed before deciding which platform porting
+ file to use.
* generic/tclEvent.c: lint
- * win/tclWinInit.c (TclpInitPlatform): Added call to TclWinInit
- when building a static library since DllMain will not be invoked.
- This could break old code that explicitly called TclWinInit, but
- should be simpler in the long run.
+ * win/tclWinInit.c (TclpInitPlatform): Added call to TclWinInit when
+ building a static library since DllMain will not be invoked. This
+ could break old code that explicitly called TclWinInit, but should be
+ simpler in the long run.
1999-04-22 Scott Stanton <stanton@scriptics.com>
* generic/tclInt.h:
* generic/tclInt.decls:
- * generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a
- hook procedure to invoke after compilation but before the byte
- codes are emitted. This makes it possible to do postprocessing on
- the compiled byte codes before the ByteCode is generated.
+ * generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a hook
+ procedure to invoke after compilation but before the byte codes are
+ emitted. This makes it possible to do postprocessing on the compiled
+ byte codes before the ByteCode is generated.
- * generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj
- to make it possible to create local unshared literal objects.
+ * generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj to
+ make it possible to create local unshared literal objects.
* win/tclWinInit.c:
* unix/tclUnixInit.c: Changed initial search path to match that
@@ -1700,10 +1656,10 @@
1999-04-22 Scott Redman <redman@scriptics.com>
* win/tclWinPort.h:
- * win/tclWinSock.c: Added code to use WinSock 2.0 API on NT to
- avoid creating a window to handle sockets. API not available on
- Win95 and needs to be fixed on Win98, until then continue to use
- the older (window-based) scheme on those two OSes.
+ * win/tclWinSock.c: Added code to use WinSock 2.0 API on NT to avoid
+ creating a window to handle sockets. API not available on Win95 and
+ needs to be fixed on Win98, until then continue to use the older
+ (window-based) scheme on those two OSes.
1999-04-15 Scott Stanton <stanton@scriptics.com>
@@ -1716,31 +1672,31 @@
* tools/encoding/gb2312.txt:
* tools/encoding/cp950.txt:
* tools/encoding/Makefile: Restored the double byte definition of
- GB2312 and added the EUC-CN encoding. EUC-CN is a variant of
- GB2312 that shifts the characters into bytes with the high bit set
- and includes ASCII as a subset. [Bug: 632]
+ GB2312 and added the EUC-CN encoding. EUC-CN is a variant of GB2312
+ that shifts the characters into bytes with the high bit set and
+ includes ASCII as a subset. [Bug 632]
1999-04-13 Scott Redman <redman@scriptics.com>
- * win/tclWinSock.c: Apply patch to allow write access to a socket
- if FD_WRITE is sent but FD_CONNECT is not. Some strange problem
- with either Win32 or a socket driver. [Bug: 1664 1776]
+ * win/tclWinSock.c: Apply patch to allow write access to a socket if
+ FD_WRITE is sent but FD_CONNECT is not. Some strange problem with
+ either Win32 or a socket driver. [Bug 1664 1776]
1999-04-09 Scott Redman <redman@scriptics.com>
- * unix/tclUnixNotfy.c: Fixed notifier deadlock situation when the
- pipe used to talk back notifier thread is filled with data. When
- calling the write() function to feed data down that pipe, unlock
- the notifierMutex to allow the notifier to wake up again. Found
- as a result of the focus.test for Tk hanging. [Bug: 1700]
+ * unix/tclUnixNotfy.c: Fixed notifier deadlock situation when the pipe
+ used to talk back notifier thread is filled with data. When calling
+ the write() function to feed data down that pipe, unlock the
+ notifierMutex to allow the notifier to wake up again. Found as a
+ result of the focus.test for Tk hanging. [Bug 1700]
1999-04-06 Scott Stanton <stanton@scriptics.com>
* tests/unixNotfy.test: Fixed hang in tests when built with thread
support.
- * tests/httpold.test: Fixed broken test that didn't wait long
- enough for events to arrive.
+ * tests/httpold.test: Fixed broken test that didn't wait long enough
+ for events to arrive.
* tests/unixInit.test: Fixed race condition in test.
@@ -1753,36 +1709,36 @@
1999-04-06 Bryan Surles <surles@scriptics.com>
* generic/tclVar.c:
- * generic/tclEnv.c: Moved the "array set" C level code into a
- common routine (TclArraySet). The TclSetupEnv routine now uses
- this API to create an env array w/ no elements.
+ * generic/tclEnv.c: Moved the "array set" C level code into a common
+ routine (TclArraySet). The TclSetupEnv routine now uses this API to
+ create an env array w/ no elements.
* generic/tclEnv.c:
* generic/tclWinInit.h:
* generic/tclUnixInit.h:
- * generic/tclInt.h: Made the Env module I18N compliant. Changed the
+ * generic/tclInt.h: Made the Env module I18N compliant. Changed the
FindVariable routine to TclpFindVariable, that now does a case
- insensitive string comparison on Windows, and not on UNIX. [Bug:
- 1299, 1500]
+ insensitive string comparison on Windows, and not on UNIX. [Bug 1299,
+ 1500]
1999-04-05 Scott Stanton <stanton@scriptics.com>
* tests/io.test: Minor test cleanup.
- * generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make
- it easier to compile on Digital-unix. [Bug: 1659]
+ * generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make it
+ easier to compile on Digital-unix. [Bug 1659]
* unix/configure.in:
* unix/tclUnixPort.h: Applied patch for OS/390 to handle lack of
- sys/param.h. [Bug: 1725]
+ sys/param.h. [Bug 1725]
- * unix/configure.in: Fixed BSD/OS 4.* configuration to support
- shared libraries properly. [Bug: 1730]
+ * unix/configure.in: Fixed BSD/OS 4.* configuration to support shared
+ libraries properly. [Bug 1730]
1999-04-05 Scott Redman <redman@scriptics.com>
- * win/tclWinDde.c: decrease timeout value for DDE calls to 30k
- [Bug: 1639]
+ * win/tclWinDde.c: decrease timeout value for DDE calls to 30k. [Bug
+ 1639]
* generic/tcl.decls:
* generic/tcl.h:
@@ -1792,23 +1748,23 @@
* generic/tclIntDecls.h:
* generic/tclStubInit.c:
* generic/tclUtil.c: Added more functions to the Tcl stubs table,
- including all Tcl_ functions not already in it (except Cmd
- functions) and Tcl_GetCwd() and Tcl_Chdir() (new functions).
+ including all Tcl_ functions not already in it (except Cmd functions)
+ and Tcl_GetCwd() and Tcl_Chdir() (new functions).
* tests/safe.test:
* doc/safe.n:
* generic/tclBasic.c:
- * library/safe.tcl: The encoding command is not safe as-is, so
- create a safe alias to mask out the "encoding system <name>" but
- allow all other uses including "encoding system". Added test cases
- and updated the man page for Safe Tcl.
+ * library/safe.tcl: The encoding command is not safe as-is, so create
+ a safe alias to mask out the "encoding system <name>" but allow all
+ other uses including "encoding system". Added test cases and updated
+ the man page for Safe Tcl.
1999-04-05 Scott Stanton <stanton@scriptics.com>
* tests/winTime.test:
- * win/tclWinTime.c: Fixed crash in clock command that occurred
- when manipulating negative time values in timezones east of
- GMT. [Bug: 1142, 1458]
+ * win/tclWinTime.c: Fixed crash in clock command that occurred when
+ manipulating negative time values in timezones east of GMT. [Bug
+ 1142, 1458]
* tests/platform.test:
* tests/fileName.test: Fixed broken tests.
@@ -1816,22 +1772,21 @@
* generic/tclFileName.c: Moved global regexps into thread local
storage.
- * tests/socket.test: Changed so tests don't reuse sockets,
- since Windows is slow to release sockets.
+ * tests/socket.test: Changed so tests don't reuse sockets, since
+ Windows is slow to release sockets.
* win/tclWinConsole.c:
* win/tclWinPipe.c:
- * win/tclWinSerial.c: Fixed race condition where background
- threads were terminated while they still held a lock in the
- notifier.
+ * win/tclWinSerial.c: Fixed race condition where background threads
+ were terminated while they still held a lock in the notifier.
1999-04-02 Scott Stanton <stanton@scriptics.com>
* tests/http.test: Fixed bad test initialization code.
* generic/tclThreadTest.c (ThreadExitProc): Fixed bug where static
- memory was being returned instead of a dynamically allocated
- result in error cases.
+ memory was being returned instead of a dynamically allocated result in
+ error cases.
1999-04-02 Scott Redman <redman@scriptics.com>
@@ -1839,10 +1794,9 @@
* tools/tcl.wse.in:
* win/makefile.vc:
* win/pkgIndex.tcl:
- * win/tclWinDde.c: Add new DDE package, code removed from Tk now
- separated into its own package. Changed DDE-based send code into
- "dde eval" command. Can be loaded into tclsh (not just wish).
- Windows only.
+ * win/tclWinDde.c: Add new DDE package, code removed from Tk now
+ separated into its own package. Changed DDE-based send code into "dde
+ eval" command. Can be loaded into tclsh (not just wish). Windows only.
1999-04-02 Scott Stanton <stanton@scriptics.com>
@@ -1855,7 +1809,7 @@
* tests/if.test:
* tests/init.test:
* tests/interp.test:
- * tests/while.test: Added some tests for known bugs (marked with
+ * tests/while.test: Added some tests for known bugs (marked with
knownBug constraint), and cleaned up a few bad tests.
* generic/regc_locale.c:
@@ -1869,9 +1823,8 @@
* generic/tclTest.c:
* generic/tclUtf.c:
* win/tclWinFCmd.c:
- * win/tclWinFile.c: Made various Unicode utility functions
- public. The following functions were made public and added to the
- stubs table:
+ * win/tclWinFile.c: Made various Unicode utility functions public. The
+ following functions were made public and added to the stubs table:
Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString,
Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum,
Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower,
@@ -1880,19 +1833,19 @@
1999-04-01 Scott Stanton <stanton@scriptics.com>
* tests/registry.test:
- * win/tclWinReg.c: Internationalized the registry code. It now
- uses Unicode interfaces on NT. [Bug: 1197]
+ * win/tclWinReg.c: Internationalized the registry code. It now uses
+ Unicode interfaces on NT. [Bug 1197]
* tests/parse.test:
* generic/tclParse.c: Fixed crash due to multiple frees in parser
- during error cleanup when parsing commands with more tokens than
- will fit in the static area of the parse structure. [Bug: 1681]
+ during error cleanup when parsing commands with more tokens than will
+ fit in the static area of the parse structure. [Bug 1681]
* generic/tclInt.h: Removed duplicate declarations.
* generic/tclInt.decls:
- * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf
- to the tclPlat table.
+ * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf to
+ the tclPlat table.
1999-04-01 Scott Redman <redman@scriptics.com>
@@ -1904,35 +1857,35 @@
* tools/genStubs.tcl:
* unix/Makefile.in:
* win/makefile.vc: Applied patch from Jan Nijtmans to fix Ultrix
- multiple symbol definition problem. Now, even Tcl includes a copy
- of the Tcl stub library. Also fixed TCL_MEM_DEBUG mode (for Tk).
+ multiple symbol definition problem. Now, even Tcl includes a copy of
+ the Tcl stub library. Also fixed TCL_MEM_DEBUG mode (for Tk).
1999-03-31 Scott Redman <redman@scriptics.com>
- * win/tclWinConsole.c: WinNT has a bug when reading a single
- character from the console. Rewrote the code for the console to
- read an entire line at a time using the reader thread.
+ * win/tclWinConsole.c: WinNT has a bug when reading a single character
+ from the console. Rewrote the code for the console to read an entire
+ line at a time using the reader thread.
1999-03-30 Scott Stanton <stanton@scriptics.com>
- * unix/Makefile.in: Removed trailing backslash that broke the
- "depend" target.
+ * unix/Makefile.in: Removed trailing backslash that broke the "depend"
+ target.
* unix/tclUnixInit.c (TclpSetInitialEncodings): Changed to avoid
- calling setlocale(). We now look directly at env(LANG) and
- env(LC_CTYPE) instead. [Bug: 1636]
+ calling setlocale(). We now look directly at env(LANG) and
+ env(LC_CTYPE) instead. [Bug 1636]
* generic/tclFileName.c:
* generic/tclDecls.h:
* generic/tcl.decls: Removed CONST from Tcl_JoinPath and
- Tcl_TranslateFileName because it changes the signature of
- Tcl_JoinPath in an incompatible manner.
+ Tcl_TranslateFileName because it changes the signature of Tcl_JoinPath
+ in an incompatible manner.
* generic/tclInt.h:
* generic/tclLoad.c (TclFinalizeLoad):
* generic/tclEvent.c (Tcl_Finalize): Defer unloading of loadable
- modules until all exit handlers have been invoked.
- [Bug: 998, 1273, 1573, 1593]
+ modules until all exit handlers have been invoked. [Bug 998, 1273,
+ 1573, 1593]
1999-03-29 Scott Stanton <stanton@scriptics.com>
@@ -1952,63 +1905,62 @@
* generic/tclDecls.h:
* generic/tclIntDecls.h:
* generic/tclPlatDecls.h:
- * generic/tclIntPlatDecls.h: Removed the stub functions and
- changed the stub macros to just use the name without params. Pass
- &tclStubs into the interp (don't use tclStubsPtr because of
- collisions with the stubs on Solaris).
+ * generic/tclIntPlatDecls.h: Removed the stub functions and changed
+ the stub macros to just use the name without params. Pass &tclStubs
+ into the interp (don't use tclStubsPtr because of collisions with the
+ stubs on Solaris).
1999-03-27 Scott Redman <redman@scriptics.com>
- * win/makefile.bc: Removed makefile for Borland compiler, no
- longer supported.
+ * win/makefile.bc: Removed makefile for Borland compiler, no longer
+ supported.
1999-03-26 Scott Redman <redman@scriptics.com>
* win/tclWinSerial.c:
* win/tclWinConsole.c:
- * win/tclWinPipe.c: Don't close the Win32 handle for a channel if
- it's a stdio handle (GetStdHandle()) during shutdown of a thread
- to prevent it from destroying the stdio of other threads.
+ * win/tclWinPipe.c: Don't close the Win32 handle for a channel if it's
+ a stdio handle (GetStdHandle()) during shutdown of a thread to prevent
+ it from destroying the stdio of other threads.
1999-03-26 Suresh Ankolekar <suresh@scriptics.com>
- * unix/configure.in
- --nameble-shared is now the default and build Tcl as a shared
- library; specify --disable-shared to build a static Tcl library
- and shell.
+ * unix/configure.in: --nameble-shared is now the default and build Tcl
+ as a shared library; specify --disable-shared to build a static Tcl
+ library and shell.
1999-03-25 Scott Stanton <stanton@scriptics.com>
* tests/interp.test:
- * generic/tclInterp.c (AliasObjCmd): Changed so aliases are
- invoked at current scope in the target interpreter instead of at
- the global scope. This was an incompatibility introduced in 8.1
- that is being removed. [Bug: 1153, 1556]
+ * generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at
+ current scope in the target interpreter instead of at the global
+ scope. This was an incompatibility introduced in 8.1 that is being
+ removed. [Bug 1153, 1556]
* library/encoding/big5.enc:
* library/encoding/gb2312.enc:
* tools/encoding/big5.enc:
- * tools/encoding/gb2312.enc: Added ASCII to big5 and gb2312
- encodings. [Bug: 632]
+ * tools/encoding/gb2312.enc: Added ASCII to big5 and gb2312 encodings.
+ [Bug 632]
* generic/tclPkg.c (Tcl_PkgRequireEx): Fixed broken clientData
initialization in package code.
- * unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to
- source distribution. [Bug: 1571]
+ * unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to source
+ distribution. [Bug 1571]
* doc/Thread.3: Updated documentation of Tcl_MutexLock to indicate
- that the recursive locking behavior is undefined. On Windows, it
- does not block, on Unix it deadlocks. [Bug: 1275]
+ that the recursive locking behavior is undefined. On Windows, it does
+ not block, on Unix it deadlocks. [Bug 1275]
1999-03-24 Scott Stanton <stanton@scriptics.com>
* tests/execute.test:
* generic/tclExecute.c (TclExecuteByteCode): Fixed expression code
- that incorrectly returned floating point values for integers if
- the internal rep happened to be a double. Now we check to see if
- the object has a string rep that looks like an integer before
- using the double internal rep. [Bug: 1516]
+ that incorrectly returned floating point values for integers if the
+ internal rep happened to be a double. Now we check to see if the
+ object has a string rep that looks like an integer before using the
+ double internal rep. [Bug 1516]
1999-03-24 Scott Redman <redman@scriptics.com>
@@ -2016,20 +1968,19 @@
* generic/tclEncoding.c:
* generic/tclProc.c:
* unix/tclUnixTime.c:
- * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++
- 5.0 and 6.0 and HP-UX native compiler without -Aa or -Ae.
- [Bug: 1323 1518 1324 1583 1585 1586]
+ * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++ 5.0
+ and 6.0 and HP-UX native compiler without -Aa or -Ae. [Bug 1323 1518
+ 1324 1583 1585 1586]
- * win/tclWinSock.c: Make sockets thread-safe on Windows. The
- current implementation uses windows to handle events on the
- socket, one for each thread (thread local storage). Previously,
- there was only one window shared between threads, which didn't
- work. [Bug: 1326]
+ * win/tclWinSock.c: Make sockets thread-safe on Windows. The current
+ implementation uses windows to handle events on the socket, one for
+ each thread (thread local storage). Previously, there was only one
+ window shared between threads, which didn't work. [Bug 1326]
1999-03-23 Scott Stanton <stanton@scriptics.com>
- * tools/tcl.wse: Fixed file association to look in the right place
- for the wish icon. [Bug: 1544]
+ * tools/tcl.wse: Fixed file association to look in the right place for
+ the wish icon. [Bug 1544]
* tests/winNotify.test:
* tests/ioCmd.test:
@@ -2038,39 +1989,38 @@
* tests/encoding.test: Fixed nonportable test.
* unix/dltest/configure.in:
- * unix/dltest/Makefile.in: Added missing DBGX macros. [Bug: 1564]
+ * unix/dltest/Makefile.in: Added missing DBGX macros. [Bug 1564]
* tests/winNotify.test:
* mac/tclMacNotify.c:
* win/tclWinNotify.c:
* unix/tclUnixNotfy.c:
- * generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface
- that is invoked whenever the service mode changes. This is needed
- to allow the Windows notifier to create a communication window the
- first time Tcl is about to enter an external modal event loop
- instead of at startup time. This will avoid the various problems
- that people have been seeing where the system hangs when tclsh
- is running outside of the event loop. [Bug: 783]
+ * generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface that
+ is invoked whenever the service mode changes. This is needed to allow
+ the Windows notifier to create a communication window the first time
+ Tcl is about to enter an external modal event loop instead of at
+ startup time. This will avoid the various problems that people have
+ been seeing where the system hangs when tclsh is running outside of
+ the event loop. [Bug 783]
* generic/tclInt.h:
* generic/tcl.decls: Renamed TclpAlertNotifier back to
- Tcl_AlertNotifier since it is part of the public notifier driver
- API.
+ Tcl_AlertNotifier since it is part of the public notifier driver API.
1999-03-23 Scott Redman <redman@scriptics.com>
- * win/tclWinSerial.c: Fixed problem with fileevent on the serial
- port and nonblocking mode. Gets no longer hangs, fileevents fire
- whenever there is any character data on the port.
+ * win/tclWinSerial.c: Fixed problem with fileevent on the serial port
+ and nonblocking mode. Gets no longer hangs, fileevents fire whenever
+ there is any character data on the port.
* tests/winConsole.test:
- * win/tclWinConsole.c: Fixed problem with fileevents and gets from
- a console stdin. Previously, fileevents were firing before an
- entire line was available for reading, which meant that when you
- did a gets or read, it blocked (even in nonblocking mode). Now, it
- should work the same as Unix: fileevents fire when an entire line
- is ready, and gets and read do not block in non-blocking mode.
- Added an interactive test case to check for this.
+ * win/tclWinConsole.c: Fixed problem with fileevents and gets from a
+ console stdin. Previously, fileevents were firing before an entire
+ line was available for reading, which meant that when you did a gets
+ or read, it blocked (even in nonblocking mode). Now, it should work
+ the same as Unix: fileevents fire when an entire line is ready, and
+ gets and read do not block in non-blocking mode. Added an interactive
+ test case to check for this.
1999-03-22 Scott Stanton <stanton@scriptics.com>
@@ -2079,34 +2029,33 @@
1999-03-19 Scott Redman <redman@scriptics.com>
- * generic/tclCmdIL.c: Fixed the initialization of an array so that
- the Sun 5.0 C compiler wouldn't complain.
+ * generic/tclCmdIL.c: Fixed the initialization of an array so that the
+ Sun 5.0 C compiler wouldn't complain.
- * unix/configure.in: Added support for --enable-64bit. For now,
- this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
+ * unix/configure.in: Added support for --enable-64bit. For now, this
+ is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
compiler (not gcc).
1999-03-18 Scott Stanton <stanton@scriptics.com>
- * win/tclWinChan.c (TclpOpenFileChannel, Tcl_MakeFileChannel):
- Changed to only test for console or comm handles when the type is
- FILE_TYPE_CHAR to avoid useless tests on simple files. Also
- reordered tests so consoles are tested first as this is more
- common.
+ * win/tclWinChan.c (TclpOpenFileChannel, Tcl_MakeFileChannel): Changed
+ to only test for console or comm handles when the type is
+ FILE_TYPE_CHAR to avoid useless tests on simple files. Also reordered
+ tests so consoles are tested first as this is more common.
* win/makefile.vc: Regularized usage of mkd and rmd and rm.
* library/encoding/shiftjis.enc:
* tools/encoding/shiftjis.txt: Missing/incorrect characters in
- shift-jis table. [Bug: 1008, 1526]
+ shift-jis table. [Bug 1008, 1526]
* generic/tclInt.decls:
* generic/tcl.decls: Eliminated use of "string" and "list" from
- argument lists to avoid conflicts with C++ STL. [Bug: 1181]
+ argument lists to avoid conflicts with C++ STL. [Bug 1181]
* win/tclWinFile.c (TclpMatchFiles): Changed to ignore the
- FS_CASE_IS_PRESERVED bit and always return exactly what we get
- from the system.
+ FS_CASE_IS_PRESERVED bit and always return exactly what we get from
+ the system.
1999-03-17 Scott Stanton <stanton@GASPODE>
@@ -2122,8 +2071,8 @@
* win/tclWinPipe.c:
* win/tclWinSerial.c: Changed so channel drivers wait for the
reader/writer threads to exit before returning during a close
- operation. This ensures that the main thread is the last thread
- to exit, so the process return value is set properly.
+ operation. This ensures that the main thread is the last thread to
+ exit, so the process return value is set properly.
* generic/tclIntDecls.h:
* generic/tclIntPlatDecls.h:
@@ -2134,21 +2083,21 @@
* generic/tclStubInit.c:
* generic/tclStubs.c: Fixed bad eol characters.
- * generic/tclInt.decls: Changed "const" to "CONST" in
- declarations for better portability.
+ * generic/tclInt.decls: Changed "const" to "CONST" in declarations for
+ better portability.
* generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and
Tcl_PanicVA in the stub files.
- * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user)
- from safe interps.
+ * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user) from
+ safe interps.
1999-03-11 Scott Stanton <stanton@GASPODE>
* unix/Makefile.in:
* unix/configure.in: Include compat files in the stub library in
- addition to the main library. Compat files are now built for
- dynamic use in all cases.
+ addition to the main library. Compat files are now built for dynamic
+ use in all cases.
* generic/tcl.h: Changed magic number so it doesn't match the plus
patch, at Jan's request.
@@ -2161,15 +2110,14 @@
* unix/dltest/pkgc.c:
* unix/dltest/pkgd.c:
* unix/dltest/pkge.c:
- * unix/dltest/pkgf.c: Changed package tests to build against the
- stubs library.
+ * unix/dltest/pkgf.c: Changed package tests to build against the stubs
+ library.
1999-03-10 Scott Stanton <stanton@GASPODE>
* generic/tcl.h:
- * generic/tcl.decls: Changed Tcl_ReleaseType from an enum to
- macros so it can be used in .rc files.
- Added Tcl_GetString.
+ * generic/tcl.decls: Changed Tcl_ReleaseType from an enum to macros so
+ it can be used in .rc files. Added Tcl_GetString.
* mac/tclMacNotify.c:
* generic/tclNotify.c:
@@ -2177,16 +2125,15 @@
* win/tclWinNotify.c:
* generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier.
- * generic/tclInt.decls: Added TclWinAddProcess to make it possible
- for expect to use Tcl_WaitForPid(). This patch is from Gordon
- Chaffee.
+ * generic/tclInt.decls: Added TclWinAddProcess to make it possible for
+ expect to use Tcl_WaitForPid(). This patch is from Gordon Chaffee.
* mac/tclMacPort.h:
* win/tclWinInit.c:
* unix/tclUnixPort.h:
- * generic/tclAsync.c: Added TclpAsyncMark to fix bug in async
- handling on Windows where async events don't wake up the event
- loop. This patch comes from Gordon Chaffee.
+ * generic/tclAsync.c: Added TclpAsyncMark to fix bug in async handling
+ on Windows where async events don't wake up the event loop. This patch
+ comes from Gordon Chaffee.
* generic/tcl.decls: Fixed declarations of reserved slots.
@@ -2196,10 +2143,10 @@
compatible with the version in 8.0.6.
* generic/tcl.h:
- * generic/tclBasic.c: Add Tcl_GetVersion() function to the public
- C API to allow programs to check the version number of the Tcl
- library at runtime. Also added an enum to clarify the release
- level (alpha, beta, final).
+ * generic/tclBasic.c: Add Tcl_GetVersion() function to the public C
+ API to allow programs to check the version number of the Tcl library
+ at runtime. Also added an enum to clarify the release level (alpha,
+ beta, final).
1999-03-09 Scott Stanton <stanton@GASPODE>
@@ -2210,13 +2157,12 @@
1999-03-08 Lee Bernhard <lfb@scriptics.com>
- * win/tclWin32Dll.c: Removed Dll instance from thread-local
- storage.
+ * win/tclWin32Dll.c: Removed Dll instance from thread-local storage.
1999-03-08 Scott Stanton <stanton@GASPODE>
- * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion
- of tclDecls.h to avoid macro conflicts.
+ * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion of
+ tclDecls.h to avoid macro conflicts.
* generic/tclInt.h:
* generic/regc_color.c:
@@ -2256,12 +2202,12 @@
* unix/Makefile.in:
* unix/tclConfig.sh.in:
* win/makefile.vc:
- * win/tclWinPort.h: Added Tcl stubs implementation. There are
- now two new macros USE_TCL_STUBS and USE_TCL_STUB_PROCS that
- enable use of stubs and disable stub macros respectively. All of
- the public and private function declarations from tcl.h and
- tclInt.h have moved into the *.decls files and the *Stubs.c and
- *Decls.h files are generated using the genStubs.tcl script.
+ * win/tclWinPort.h: Added Tcl stubs implementation. There are now two
+ new macros USE_TCL_STUBS and USE_TCL_STUB_PROCS that enable use of
+ stubs and disable stub macros respectively. All of the public and
+ private function declarations from tcl.h and tclInt.h have moved into
+ the *.decls files and the *Stubs.c and *Decls.h files are generated
+ using the genStubs.tcl script.
* unix/Makefile.in:
* unix/configure.in:
@@ -2270,8 +2216,8 @@
* win/tclWinSock.c: Removed a bunch of extraneous PASCAL FAR
attributes from internal functions.
- * win/tclWinReg.c: Changed registry package to use stubs mechanism
- so it no longer depends on the specific version of Tcl.
+ * win/tclWinReg.c: Changed registry package to use stubs mechanism so
+ it no longer depends on the specific version of Tcl.
* doc/AddErrInfo.3:
* doc/Eval.3:
@@ -2283,22 +2229,21 @@
* generic/tclPanic.c:
* generic/tclStringObj.c:
* generic/tclUtil.c:
- * unix/mkLinks: Added va_list versions of all VARARGS
- functions so they can be invoked from the stub functions.
+ * unix/mkLinks: Added va_list versions of all VARARGS functions so
+ they can be invoked from the stub functions.
* doc/package.n:
* doc/PkgRequire.3:
* generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx,
- Tcl_PresentEx, and Tcl_PkgPresent. Added "package present"
- command.
+ Tcl_PresentEx, and Tcl_PkgPresent. Added "package present" command.
* generic/tclFileName.c:
* mac/tclMacFile.c:
* mac/tclMacShLib.exp:
* unix/tclUnixFile.c:
- * win/tclWinFile.c: Changed so TclGetUserHome is defined on
- all platforms, even though it is currently a noop on mac and
- windows, and renamed it to TclpGetUserHome.
+ * win/tclWinFile.c: Changed so TclGetUserHome is defined on all
+ platforms, even though it is currently a noop on mac and windows, and
+ renamed it to TclpGetUserHome.
* generic/tclPanic.c:
* generic/panic.c: Renamed panic to Tcl_Panic.
@@ -2307,19 +2252,19 @@
* win/makefile.vc: Added tclWinConsole.c and tclWinSerial.c
- * win/tclWinConsole.c: New code to properly deal with fileevents
- and nonblocking mode on consoles.
+ * win/tclWinConsole.c: New code to properly deal with fileevents and
+ nonblocking mode on consoles.
- * win/tclWinSerial.c: New code to properly deal with fileevents
- and nonblocking mode on serial ports.
+ * win/tclWinSerial.c: New code to properly deal with fileevents and
+ nonblocking mode on serial ports.
* win/tclWinPipe.c:
* win/tclWinPort.h: Exported functions to allow creation of pipe
channels from tclWinChan.c
* win/tclWinChan.c: Check the type of a channel, including for the
- standard (stdin/stdout/stderr), and use the correct channel type
- to create the channel (file, serial, console, or pipe).
+ standard (stdin/stdout/stderr), and use the correct channel type to
+ create the channel (file, serial, console, or pipe).
1999-02-11 Scott Stanton <stanton@GASPODE>
@@ -2332,16 +2277,15 @@
1999-02-10 Scott Stanton <stanton@GASPODE>
- * library/auto.tcl: Fixed auto_mkindex so it handles .tbc files.
- Did some general cleanup to handle bad eval statements that didn't
- use "list".
+ * library/auto.tcl: Fixed auto_mkindex so it handles .tbc files. Did
+ some general cleanup to handle bad eval statements that didn't use
+ "list".
* unix/mkLinks:
* doc/SetVar.3:
* generic/tcl.h:
- * generic/tclVar.c: Restored Tcl_ObjGetVar2 and Tcl_ObjSetVar2
- from 8.0. Renamed Tcl_Get/SetObjVar2 to Tcl_GetVar2Ex and
- Tcl_SetVar2Ex.
+ * generic/tclVar.c: Restored Tcl_ObjGetVar2 and Tcl_ObjSetVar2 from
+ 8.0. Renamed Tcl_Get/SetObjVar2 to Tcl_GetVar2Ex and Tcl_SetVar2Ex.
1999-02-10 Scott Stanton <stanton@GASPODE>
@@ -2353,99 +2297,96 @@
* tests/cmdAH.test:
* generic/tclFileName.c (TclGetExtension): Changed behavior so the
split happens at the last period in the name instead of the first
- period of the last run of periods. So, "foo..o" is split into
- "foo." and ".o" now. [Bug: 1126]
+ period of the last run of periods. So, "foo..o" is split into "foo."
+ and ".o" now. [Bug 1126]
- * win/makefile.vc: Added better support for paths with spaces in
- the name. Added .lib and support .dlls to the install-binaries
- target. Added generate of a pkgIndex.tcl script to the
- install-libraries target.
+ * win/makefile.vc: Added better support for paths with spaces in the
+ name. Added .lib and support .dlls to the install-binaries target.
+ Added generate of a pkgIndex.tcl script to the install-libraries
+ target.
* win/tclAppInit.c:
* unix/tclAppInit.c:
* mac/tclMacAppInit.c:
- * generic/tclTest.c: Changed some EXTERN declarations to extern
- since they are not defining exported interfaces. This avoids
- generating useless declspec() attributes and makes the windows
- makefile simpler.
+ * generic/tclTest.c: Changed some EXTERN declarations to extern since
+ they are not defining exported interfaces. This avoids generating
+ useless declspec() attributes and makes the windows makefile simpler.
- * generic/tcl.h: Moved Tcl_AppInit declaration to end and cleared
- out TCL_STORAGE_CLASS so it is not declared with a declspec().
+ * generic/tcl.h: Moved Tcl_AppInit declaration to end and cleared out
+ TCL_STORAGE_CLASS so it is not declared with a declspec().
* tests/interp.test:
* generic/tclInterp.c (DeleteAlias): Changed to use
- Tcl_DeleteCommandFromToken so we handle renames properly. This
- avoids senseless panic. [Bug: 736]
+ Tcl_DeleteCommandFromToken so we handle renames properly. This avoids
+ senseless panic. [Bug 736]
* unix/tclUnixChan.c:
* win/tclWinSock.c:
* doc/socket.n: Applied Gordon Chaffee's patch to handle failures
- during asynchronous socket connection operations. This adds a new
- "-error" fconfgure option to socket channels. [Bug: 893]
+ during asynchronous socket connection operations. This adds a new
+ "-error" fconfgure option to socket channels. [Bug 893]
* generic/tclProc.c:
* generic/tclNamesp.c:
* generic/tclInt.h:
* generic/tclCmdIL.c:
* generic/tclBasic.c:
- * generic/tclVar.c: Applied patch from Viktor Dukhovni to
- rationalize TCL_LEAVE_ERR_MSG behavior when creating variables.
+ * generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize
+ TCL_LEAVE_ERR_MSG behavior when creating variables.
- * generic/tclVar.c: Fixed bug in namespace tail computation.
- Fixed bug where upvar could resurrect a namespace variable whose
- namespace had been deleted.
+ * generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug
+ where upvar could resurrect a namespace variable whose namespace had
+ been deleted.
* generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
bogus optimization in expression compilation.
- * unix/configure.in: Added branch for BSD/OS-4* to shared library
- case statement. [Bug: 975]
- Fixed to correctly handle IRIX 6.5 n32 library support. [Bug: 1117]
+ * unix/configure.in: Added branch for BSD/OS-4* to shared library case
+ statement. [Bug 975]
+ Fixed to correctly handle IRIX 6.5 n32 library support. [Bug 1117]
- * win/winDumpExts.c: Patched to be pickier about stripping
- @'s. [Bug: 920]
+ * win/winDumpExts.c: Patched to be pickier about stripping @'s. [Bug
+ 920]
- * library/http2.0/http.tcl: Added catch around eof test in
- CopyDone since the user may have already called http::reset.
- [Bug: 1108]
+ * library/http2.0/http.tcl: Added catch around eof test in CopyDone
+ since the user may have already called http::reset. [Bug 1108]
- * unix/configure.in: Changed Linux and IRIX to set SHLIB_LIBS to
- LIBS so shared libraries are linked with the system
- libraries. [Bug: 1018]
+ * unix/configure.in: Changed Linux and IRIX to set SHLIB_LIBS to LIBS
+ so shared libraries are linked with the system libraries. [Bug 1018]
* generic/tclCompile.c (CompileExprWord): Fixed exception stack
- overflow bug caused by missing statement. [Bug: 928]
+ overflow bug caused by missing statement. [Bug 928]
* generic/tclIOCmd.c:
- * generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]
+ * generic/tclBasic.c: Objectified the "open" command. [Bug 1113]
- * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): When using
- egcs, ENOTSUP and EOPNOTSUPP are the same, so now we handle that
- case. [Bug: 1137]
+ * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): When using egcs,
+ ENOTSUP and EOPNOTSUPP are the same, so now we handle that case. [Bug
+ 1137]
* library/init.tcl: Various small changes requested by Jan Nijtmans.
- - If the variable $tcl_library contains the empty string, this
- empty string will be put in $auto_path. This is not useful at all,
- it only slows down later package processing.
- - If the variable tcl_pkgPath is not set, the "unset __dir"
- fails. Thich makes init.tcl totally unusable. Better put a "catch"
- around it.
- - In the function tcl_findLibraries, the "string match" function
- only works correctly if $tcl_patchLevel is in one of the forms
- "?.?a?", "?.?b?" or "?.?.?". Could a "regexp" be used instead,
- then it allows anything to be appended to the patchLevel
- string. And it is more efficient.
- - The tclPkgSetup function assumes that if $type != "load" then
- the type must be "source". This needn't be true. Some users want
- to add their own setup types.
- [RFE: 1138] [Bug: 978]
+ - If the variable $tcl_library contains the empty string, this empty
+ string will be put in $auto_path. This is not useful at all, it only
+ slows down later package processing.
+ - If the variable tcl_pkgPath is not set, the "unset __dir" fails.
+ Thich makes init.tcl totally unusable. Better put a "catch" around
+ it.
+ - In the function tcl_findLibraries, the "string match" function only
+ works correctly if $tcl_patchLevel is in one of the forms "?.?a?",
+ "?.?b?" or "?.?.?". Could a "regexp" be used instead, then it allows
+ anything to be appended to the patchLevel string. And it is more
+ efficient.
+ - The tclPkgSetup function assumes that if $type != "load" then the
+ type must be "source". This needn't be true. Some users want to add
+ their own setup types.
+ [RFE 1138] [Bug 978]
* win/tclWinReg.c:
* doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and
- HKEY_DYN_DATA keys. [Bug: 1109]
+ HKEY_DYN_DATA keys. [Bug 1109]
- * win/tclWinInit.c (TclPlatformInit): Added code to ensure
- tcl_pkgPath is set to "" when no registry entry is found. [Bug: 978]
+ * win/tclWinInit.c (TclPlatformInit): Added code to ensure tcl_pkgPath
+ is set to "" when no registry entry is found. [Bug 978]
1999-02-01 Scott Stanton <stanton@GASPODE>
@@ -2464,18 +2405,18 @@
* generic/tclProc.c:
* generic/tclTest.c:
* generic/tclTimer.c:
- * generic/tcl.h: Made eval interfaces compatible with 8.0 by
- renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to
- Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj
- interfaces so they match Tcl 8.0.
+ * generic/tcl.h: Made eval interfaces compatible with 8.0 by renaming
+ Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to Tcl_EvalEx and
+ restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces so they match
+ Tcl 8.0.
1999-01-28 Scott Stanton <stanton@GASPODE>
* Merged Tcl 8.0.5b1 changes.
* generic/tclUtil.c (Tcl_DStringSetLength): Changed so the buffer
- overallocates in a manner similar to Tcl_DStringAppend. This
- should improve performance for TclUniCharToUtfDString.
+ overallocates in a manner similar to Tcl_DStringAppend. This should
+ improve performance for TclUniCharToUtfDString.
1998-12-11 === Tcl 8.1b1 Release ===
@@ -2485,28 +2426,27 @@
* generic/tclEncoding.c (Tcl_FreeEncoding): Moved most of the code
into a static FreeEncoding routine that does not grab the
- encodingMutex to avoid deadlocks/races when called from other
- routines that already have the mutex.
+ encodingMutex to avoid deadlocks/races when called from other routines
+ that already have the mutex.
1998-12-09 Scott Stanton <stanton@GASPODE>
- * library/msgcat1.0/msgcat.tcl: Fixed bad export list, fixed so
- all locale strings are converted to lower case, including file
- names.
+ * library/msgcat1.0/msgcat.tcl: Fixed bad export list, fixed so all
+ locale strings are converted to lower case, including file names.
- * generic/regcomp.c (makescan): Fixed bug in longest match case
- that caused anchored patterns to fail. [Bug: 897]
+ * generic/regcomp.c (makescan): Fixed bug in longest match case that
+ caused anchored patterns to fail. [Bug 897]
1998-12-08 Scott Stanton <stanton@GASPODE>
- * library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in
- the calling context, changed locale lookups to be case insensitive
+ * library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in the
+ calling context, changed locale lookups to be case insensitive
1998-12-07 Scott Stanton <stanton@GASPODE>
* generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug
- where big blocks that were reallocated into a different heap
- location were not being placed into the bigBlocks list. [Bug: 933]
+ where big blocks that were reallocated into a different heap location
+ were not being placed into the bigBlocks list. [Bug 933]
* tests/msgcat.test: Added message catalog test suite.
@@ -2515,34 +2455,34 @@
1998-12-04 Scott Stanton <stanton@GASPODE>
- * library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl
- coding standards. Changed to use file join for portability.
+ * library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl coding
+ standards. Changed to use file join for portability.
* library/msgcat1.0: Added initial implementaion of Tcl message
catalog package contributed by Mark Harrison.
1998-12-03 Scott Stanton <stanton@GASPODE>
- * win/tclWinPipe.c (BuildCommandLine): Fixed bug that kept
- arguments containing spaces from being properly quoted.
+ * win/tclWinPipe.c (BuildCommandLine): Fixed bug that kept arguments
+ containing spaces from being properly quoted.
* tests/defs: Changed so auto_path is set to only contain the Tcl
- library directory. This keeps the tests from accidentally picking
- up stuff in installed packages.
+ library directory. This keeps the tests from accidentally picking up
+ stuff in installed packages.
- * generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0
- behavior in corner case where there is no closing bracket.
+ * generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0 behavior
+ in corner case where there is no closing bracket.
1998-12-02 Scott Stanton <stanton@GASPODE>
- * win/tclWinPipe.c (TclpCreateCommandChannel): Changed
- reader/writer threads to have THREAD_PRIORITY_HIGHEST so they will
- have a chance to run whenever there is something to do.
+ * win/tclWinPipe.c (TclpCreateCommandChannel): Changed reader/writer
+ threads to have THREAD_PRIORITY_HIGHEST so they will have a chance to
+ run whenever there is something to do.
* generic/tclIO.c (WriteBytes, WriteChars): Fixed so extraneous
flushes do not happen in line mode.
- (TranslateOutputEOL): Made translation more efficient in line mode
- and fixed a buffer overflow bug in CRLF translation. [Bug: 887]
+ (TranslateOutputEOL): Made translation more efficient in line mode and
+ fixed a buffer overflow bug in CRLF translation. [Bug 887]
1998-12-02 Brent Welch <welch@SAGE>
@@ -2550,15 +2490,14 @@
1998-12-02 Scott Stanton <stanton@GASPODE>
- * generic/regc_color.c (subcolor): Added check for error case to
- avoid an out of bounds array reference.
+ * generic/regc_color.c (subcolor): Added check for error case to avoid
+ an out of bounds array reference.
* generic/tclCmdAH.c (Tcl_EncodingObjCmd): Changed to avoid using
Tcl_DStringResult because it is not binary clean.
- * generic/tclParse.c (Tcl_ParseCommand): Fixed bug in comment
- parsing where a trailing comment looked like an incomplete
- command.
+ * generic/tclParse.c (Tcl_ParseCommand): Fixed bug in comment parsing
+ where a trailing comment looked like an incomplete command.
1998-12-02 Brent Welch <welch@SAGE>
@@ -2566,27 +2505,26 @@
1998-12-01 Scott Stanton <stanton@GASPODE>
- * generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest
- so we don't block when there is data sitting in the buffers.
+ * generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest so
+ we don't block when there is data sitting in the buffers.
- * generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv
- change.
+ * generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv change.
* tests/parse.test: Updated tests for EvalObjv change.
- * generic/tclParse.c (EvalObjv, Tcl_EvalObjv): Changed
- Tcl_EvalObjv interface to remove string and length arguments,
- preserved original interface as EvalObjv for internal use.
+ * generic/tclParse.c (EvalObjv, Tcl_EvalObjv): Changed Tcl_EvalObjv
+ interface to remove string and length arguments, preserved original
+ interface as EvalObjv for internal use.
- * generic/tcl.h: Changed Tcl_EvalObjv interface to remove string
- and length arguments.
+ * generic/tcl.h: Changed Tcl_EvalObjv interface to remove string and
+ length arguments.
- * doc/Eval.3: Updated documentation for Tcl_EvalObjv to remove
- string and length arguments.
+ * doc/Eval.3: Updated documentation for Tcl_EvalObjv to remove string
+ and length arguments.
* generic/tclCompCmds.c (TclCompileForeachCmd): Fixed code that
corrupted the exceptDepth value in the compile environment when
- foreach failed to compile inline. [Bug: 884]
+ foreach failed to compile inline. [Bug 884]
* library/encoding/euc-kr.enc:
* library/encoding/ksc5601.enc:
@@ -2598,30 +2536,30 @@
1998-11-30 Scott Stanton <stanton@GASPODE>
- * unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed hang that occurs
- when trying to close a pipe that is currently being waited on by
- the notifier thread. [Bug: 607]
+ * unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed hang that occurs when
+ trying to close a pipe that is currently being waited on by the
+ notifier thread. [Bug 607]
* unix/tclUnixFCmd.c (GetPermissionsAttribute): Increase size of
- returnString buffer to avoid overflow. [Bug: 584]
+ returnString buffer to avoid overflow. [Bug 584]
- * generic/tclThreadTest.c (TclThreadSend): Fixed memory leak due
- to use of TCL_VOLATILE instead of TCL_DYNAMIC.
+ * generic/tclThreadTest.c (TclThreadSend): Fixed memory leak due to
+ use of TCL_VOLATILE instead of TCL_DYNAMIC.
* generic/tclThread.c (TclRememberSyncObject): Fixed memory leak
caused by failure to reuse condition variables.
- * unix/tclUnixNotfy.c: (Tcl_AlertNotifier, Tcl_WaitForEvent,
- NotifierThreadProc, Tcl_InitNotifier): Fixed race condition caused
- by incorrect use of condition variables when sending messages
- between threads.. [Bug: 607]
+ * unix/tclUnixNotfy.c (Tcl_AlertNotifier, Tcl_WaitForEvent,
+ (NotifierThreadProc, Tcl_InitNotifier): Fixed race condition caused by
+ incorrect use of condition variables when sending messages between
+ threads. [Bug 607]
* generic/tclTestObj.c (TeststringobjCmd): MAX_STRINGS was off by one
so the strings array was too small.
* generic/tclCkalloc.c (Tcl_DbCkfree): Moved mutex lock so
- ValidateMemory is done inside the mutex to avoid a race condition
- when validate_memory is enabled. [Bug: 880]
+ ValidateMemory is done inside the mutex to avoid a race condition when
+ validate_memory is enabled. [Bug 880]
1998-11-23 Scott Stanton <stanton@GASPODE>
@@ -2629,23 +2567,22 @@
1998-11-17 Scott Stanton <stanton@GASPODE>
- * tclScan.c: moved "scan" implementation out of tclCmdMZ.c and
- added Unicode support. This required a complete reimplementation
- of the command to avoid using scanf(), which isn't Unicode aware.
- Two new features were added in the process: %n to return the
- current number of characters consumed, and XPG3-style %n$ argument
- order specifiers similar to those provided by the "format"
- command. [Bug: 833]
+ * tclScan.c: moved "scan" implementation out of tclCmdMZ.c and added
+ Unicode support. This required a complete reimplementation of the
+ command to avoid using scanf(), which isn't Unicode aware. Two new
+ features were added in the process: %n to return the current number of
+ characters consumed, and XPG3-style %n$ argument order specifiers
+ similar to those provided by the "format" command. [Bug 833]
- * tclAlloc.c: changed so allocated memory is always 8-byte aligned
- to improve memory performance and to ensure that it will work on
- systems that don't like accessing 4-byte aligned values
- (e.g. Solaris and HP-UX). [Bug: 834]
+ * tclAlloc.c: changed so allocated memory is always 8-byte aligned to
+ improve memory performance and to ensure that it will work on systems
+ that don't like accessing 4-byte aligned values (e.g. Solaris and
+ HP-UX). [Bug 834]
1998-11-06 Scott Stanton <stanton@GASPODE>
- * tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was
- getting lost before being passed to CallTraces.
+ * tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was getting
+ lost before being passed to CallTraces.
1998-10-21 Scott Stanton <stanton@GASPODE>
@@ -2661,9 +2598,9 @@
* tclInt.h: added TclUniCharIsWordChar
- * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand,
- changed "wordend" and "wordstart" to properly handle Unicode word
- characters and connector punctuation
+ * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand, changed
+ "wordend" and "wordstart" to properly handle Unicode word characters
+ and connector punctuation
1998-10-05 Scott Stanton <stanton@GASPODE>
@@ -2682,8 +2619,8 @@
* tclExecute.c: fixed off-by-one copying error, fixed merge bugs
- * tclEvent.c: changed so USE_TCLALLOC is tested for value instead
- of definition
+ * tclEvent.c: changed so USE_TCLALLOC is tested for value instead of
+ definition
* tclCompCmds.c: replaced SCCS strings, added warnings around code
that modifies strings in place
diff --git a/ChangeLog.2000 b/ChangeLog.2000
index 70d491f..0d20eaf 100644
--- a/ChangeLog.2000
+++ b/ChangeLog.2000
@@ -1,12 +1,11 @@
2000-12-14 Don Porter <dgp@users.sourceforge.net>
* generic/tclExecute.c:
- * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and
- [expr srand($seed)] implementations, fixing a range error
- on some 64-bit platforms. Added tests that detect the bug.
- The rewrite changes the seed -> sequence map on 64-bit
- platforms, only for seed >= 2^31, a slight incompatibility.
- [Bug 121072, Patch 102781]
+ * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and [expr
+ srand($seed)] implementations, fixing a range error on some 64-bit
+ platforms. Added tests that detect the bug. The rewrite changes the
+ seed -> sequence map on 64-bit platforms, only for seed >= 2^31, a
+ slight incompatibility. [Bug 121072, Patch 102781]
2000-12-10 Don Porter <dgp@users.sourceforge.net>
@@ -14,217 +13,209 @@
* library/msgcat/msgcat.tcl:
* library/msgcat/pkgIndex.tcl:
* library/opt/optparse.tcl:
- * library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc
- to evaluate a Tcl built-in command in the caller's context,
- the built-in commands are now fully namespace-qualified. This
- prevents problems when the caller context is in a namespace where
- the built-in command name has been used by a command in the
- namespace. (For example, [::ns::set] might be called instead
- of the intended [::set]). [Bug #119422, Patch #102545]
+ * library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc to
+ evaluate a Tcl built-in command in the caller's context, the built-in
+ commands are now fully namespace-qualified. This prevents problems
+ when the caller context is in a namespace where the built-in command
+ name has been used by a command in the namespace. (For example,
+ [::ns::set] might be called instead of the intended [::set]). [Bug
+ 119422, Patch 102545]
-2000-12-09 jeff hobbs <jhobbs@interwoven.com>
+2000-12-09 Jeff Hobbs <jhobbs@interwoven.com>
* win/tclWinTime.c (CalibrationThread): added lint return value to
- prevent compiler warning. [Bug #125005]
+ prevent compiler warning. [Bug 125005]
* docs/scan.n:
* tests/scan.test:
- * generic/tclScan.c (Tcl_ScanObjCmd): changed %o and %x to use
- strtoul instead of strtol to correctly preserve scan<>format
- conversion of large integers. [Patch #102663, Bug #124600]
+ * generic/tclScan.c (Tcl_ScanObjCmd): changed %o and %x to use strtoul
+ instead of strtol to correctly preserve scan<>format conversion of
+ large integers. [Patch 102663, Bug 124600]
* generic/tclExecute.c (TclExecuteByteCode): Commited patch fixing
- handling of {!<boolean>} in expressions. [Patch #102702]
+ handling of {!<boolean>} in expressions. [Patch 102702]
-2000-12-08 jeff hobbs <jhobbs@interwoven.com>
+2000-12-08 Jeff Hobbs <jhobbs@interwoven.com>
- * library/init.tcl: Added support for PATHEXT variable in
- auto_execok, recognizing the proper set of executable extensions
- on Windows. [Patch #102719]
+ * library/init.tcl: Added support for PATHEXT variable in auto_execok,
+ recognizing the proper set of executable extensions on Windows. [Patch
+ 102719]
2000-12-08 Andreas Kupries <a.kupries@westend.com>
- * generic/tclEncoding.c (LoadTableEncoding): Changed dangerous
- code to something less critical. This fixes bug 119417, part A
- without affecting the speed when loading encodings.
+ * generic/tclEncoding.c (LoadTableEncoding): Changed dangerous code to
+ something less critical. This fixes [Bug 119417], part A without
+ affecting the speed when loading encodings.
2000-12-08 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/open.n: Added xref to fconfigure and advice on the opening
- of binary files. Should help prevent a recurrence of bugs like
- #124558
+ * doc/open.n: Added xref to fconfigure and advice on the opening of
+ binary files. Should help prevent a recurrence of bugs like [Bug
+ 124558]
-2000-12-07 jeff hobbs <jhobbs@interwoven.com>
+2000-12-07 Jeff Hobbs <jhobbs@interwoven.com>
* generic/tcl.h: added note about need to updated
library/dde/pkgIndex.tcl with minor version increment.
- * library/dde/pkgIndex.tcl: updated to use 84 version to reflect
- the makefile. Should probably be updated to use its real version
- at some point. [Patch #102560, Bug #119421]
+ * library/dde/pkgIndex.tcl: updated to use 84 version to reflect the
+ makefile. Should probably be updated to use its real version at some
+ point. [Patch 102560, Bug 119421]
-2000-12-06 eric melski <ericm@ajubasolutions.com>
+2000-12-06 Eric Melski <ericm@ajubasolutions.com>
* generic/tcl.h (attemptckalloc): Fixed typo for #define of
- attemptckalloc (was defined to Tcl_AttempDbCkalloc, should have
- been Tcl_AttemptDbCkalloc). [Bug: 124384]
+ attemptckalloc (was defined to Tcl_AttempDbCkalloc, should have been
+ Tcl_AttemptDbCkalloc). [Bug 124384]
- * generic/tclCkalloc.c: Added
- TCL_MEM_DEBUG versions of Tcl_AttemptDbCkrealloc and
- Tcl_AttemptDbCkalloc. [Bug: 124384].
+ * generic/tclCkalloc.c: Added TCL_MEM_DEBUG versions of
+ Tcl_AttemptDbCkrealloc and Tcl_AttemptDbCkalloc. [Bug 124384].
2000-11-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclExecute.c (TclExecuteByteCode): Logical negation "!"
- can now handle string booleans, provided those values are placed
- in variables.
+ * generic/tclExecute.c (TclExecuteByteCode): Logical negation "!" can
+ now handle string booleans, provided those values are placed in
+ variables.
- * tests/expr.test (expr-13.17): Check that [expr {!$var}] can
- negate the string-versions of booleans "yes", "false", etc.
+ * tests/expr.test (expr-13.17): Check that [expr {!$var}] can negate
+ the string-versions of booleans "yes", "false", etc.
* library/tcltest/tcltest.tcl (getMatchingFiles,
- getMatchingDirectories):
- * tools/man2html.tcl (doDir):
- * tools/man2help.tcl (doDir):
- * library/package.tcl (tclPkgUnknown,tclMacPkgSearch):
+ (getMatchingDirectories):
+ * tools/man2html.tcl (doDir):
+ * tools/man2help.tcl (doDir):
+ * library/package.tcl (tclPkgUnknown,tclMacPkgSearch):
* library/safe.tcl (AddSubDirs): [glob] uses -directory instead of
- unsafe [file join] to fix Bug #123313
+ unsafe [file join]. [Bug 123313]
* generic/tclIndexObj.c:
* generic/tclTestObj.c (TestindexobjCmd): Changed internal
- representation of index objects to fix Bug #119082; fix
- shouldn't be visible to outside world...
+ representation of index objects to fix [Bug 119082]; fix shouldn't be
+ visible to outside world...
- * generic/tclTest.c (TestGetIndexFromObjStructObjCmd):
- * tests/indexObj.test: (indexObj-6.*) Added to test for presence
- of Bug #119082.
+ * generic/tclTest.c (TestGetIndexFromObjStructObjCmd):
+ * tests/indexObj.test: (indexObj-6.*) Added to test for presence of
+ [Bug 119082].
2000-11-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fixed memory leak from Bug
- #119398
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fixed memory leak from [Bug
+ 119398]
* library/init.tcl (unknown): Added specific level parameters to
- all uplevel invokations to boost performance; didn't dare touch
- the "namespace inscope" stuff though, since it looks sensitive
- to me! Should fix Bug #123217, though testing is tricky...
+ all uplevel invokations to boost performance; didn't dare touch
+ the "namespace inscope" stuff though, since it looks sensitive
+ to me! Should fix [Bug 123217], though testing is tricky...
2000-11-21 Andreas Kupries <a.kupries@westend.com>
- * All of the changes below are described in TIP #7 ~ Specification
- and result from the application of the patch contained
- therein. Creator of the patch is Kevin Kenny
- <kennykb@crd.ge.com>. The patch used here is actually a bit
- different. Two MS specific constant values (format FOOui64) were
- replaced with a more portable formatting of the values and an
- additional cast to LONGLONG. My cross-compiling gcc was unable to
- process the original form. The SF Id of the patch is 102459.
-
- * tclWinTime.c: Add to the static data a set of variables that
- manage the phase-locked techniques, including a
- ''CRITICAL_SECTION'' to guard them so that multi-threaded code
- is stable.
-
- * tclWinTime.c: Modify ''TclpGetSeconds'' to call ''TclpGetTime''
- and return the 'seconds' portion of the result. This change is
- necessary to make sure that the two times are consistent near
- the rollover from one second to another.
+ All of the changes below are described in TIP #7 ~ Specification and
+ result from the application of the patch contained therein. Creator of
+ the patch is Kevin Kenny <kennykb@crd.ge.com>. The patch used here is
+ actually a bit different. Two MS specific constant values (format
+ FOOui64) were replaced with a more portable formatting of the values
+ and an additional cast to LONGLONG. My cross-compiling gcc was unable
+ to process the original form. [Patch 102459]
+
+ * tclWinTime.c: Add to the static data a set of variables that manage
+ the phase-locked techniques, including a ''CRITICAL_SECTION'' to guard
+ them so that multi-threaded code is stable.
+
+ * tclWinTime.c: Modify ''TclpGetSeconds'' to call ''TclpGetTime'' and
+ return the 'seconds' portion of the result. This change is necessary
+ to make sure that the two times are consistent near the rollover from
+ one second to another.
* tclWinTime.c: Modify ''TclpGetClicks'' to use TclpGetTime to
- determine the click count as a number of microseconds.
-
- * tclWinTime.c: Modify ''TclpGetTime'' to return the time as
- M*Q+B, where Q is the result of ''QueryPerformanceCounter'', and
- M and B are variables maintained by the phase-locked loop to
- keep the result as close as possible to the system clock. The
- ''TclpGetTime'' call will also launch the phase-lock management
- in a separate thread the first time that it is invoked. If the
- performance counter is unavailable, or if its frequency is not
- one of the two common 8254-compatible rates, then
- ''TclpGetTime'' will return the result of ''ftime'' as it does
- in Tcl 8.3.2.
-
- * tclWinTime.c: Add the clock calibration procedure. The
- calibration is somewhat complex; to save space, the reader is
- referred to the reference implementation for the details of how
- the time base and frequency are maintained.
-
- * tclWinNotify.c: Modify ''Tcl_Sleep'' to test that the process
- has, in fact, slept for the requisite time by calling
- ''TclpGetTime'' and comparing with the desired time. Otherwise,
- roundoff errors may cause the process to awaken early.
-
- * tclWinTest.c: Add a ''testwinclock'' command. This command
- returns a four element list comprising the seconds and
- microseconds portions of the system clock and the seconds and
- microseconds portions of the Tcl clock.
-
- * winTime.test: Add to the test suite a test that makes sure that
- the Tcl clock stays within 1.1 ms of the system clock over the
- duration of the test.
+ determine the click count as a number of microseconds.
+
+ * tclWinTime.c: Modify ''TclpGetTime'' to return the time as M*Q+B,
+ where Q is the result of ''QueryPerformanceCounter'', and M and B are
+ variables maintained by the phase-locked loop to keep the result as
+ close as possible to the system clock. The ''TclpGetTime'' call will
+ also launch the phase-lock management in a separate thread the first
+ time that it is invoked. If the performance counter is unavailable, or
+ if its frequency is not one of the two common 8254-compatible rates,
+ then ''TclpGetTime'' will return the result of ''ftime'' as it does in
+ Tcl 8.3.2.
+
+ * tclWinTime.c: Add the clock calibration procedure. The calibration
+ is somewhat complex; to save space, the reader is referred to the
+ reference implementation for the details of how the time base and
+ frequency are maintained.
+
+ * tclWinNotify.c: Modify ''Tcl_Sleep'' to test that the process has,
+ in fact, slept for the requisite time by calling ''TclpGetTime'' and
+ comparing with the desired time. Otherwise, roundoff errors may cause
+ the process to awaken early.
+
+ * tclWinTest.c: Add a ''testwinclock'' command. This command returns a
+ four element list comprising the seconds and microseconds portions of
+ the system clock and the seconds and microseconds portions of the Tcl
+ clock.
+
+ * winTime.test: Add to the test suite a test that makes sure that the
+ Tcl clock stays within 1.1 ms of the system clock over the duration of
+ the test.
2000-11-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/global.n:
- * doc/upvar.n:
- * doc/variable.n: Improved documentation to mention that variables
- so created are listed in [info locals] and added a few more
- cross-links between these commands. Fixes bug #119387
+ * doc/global.n:
+ * doc/upvar.n:
+ * doc/variable.n: Improved documentation to mention that variables so
+ created are listed in [info locals] and added a few more cross-links
+ between these commands. [Bug 119387]
2000-11-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/safe.test: (safe-4.3):
- * generic/tclVar.c (TclLookupVar): Changed again. Now passes all
- the tests, though one needed modifying since it required the
- wrong answer. (Why on earth do we have inline modification of
- argument strings? This sort of thing is horrendous to debug and
- doesn't work well in a multithreaded environment!) Fixes bug
- 119192.
+ * generic/tclVar.c (TclLookupVar): Changed again. Now passes all the
+ tests, though one needed modifying since it required the wrong answer.
+ (Why on earth do we have inline modification of argument strings? This
+ sort of thing is horrendous to debug and doesn't work well in a
+ multithreaded environment!) [Bug 119192]
- * tests/var.test: (var-1.19) If my attempts to fix the problem
- aren't right yet, my attempts to describe it look pretty good to
- me...
+ * tests/var.test: (var-1.19) If my attempts to fix the problem aren't
+ right yet, my attempts to describe it look pretty good to me...
2000-11-16 Andreas Kupries <a.kupries@westend.com>
* win/tclWinPort.h (line 69): Changed reference to winsock2.h into
- winsock.h. This was a leftover from a foray into using winsock
- version 2 (History lesson from Scott Redman and Jeff
- Hobbs). This code was no problem when compiling Tcl itself, but
- could trip extensions. Fixes bug 122568.
+ winsock.h. This was a leftover from a foray into using winsock version
+ 2 (History lesson from Scott Redman and Jeff Hobbs). This code was no
+ problem when compiling Tcl itself, but could trip extensions. [Bug
+ 122568]
-2000-11-15 jeff hobbs <jeff.hobbs@acm.org>
+2000-11-15 Jeff Hobbs <jeff.hobbs@acm.org>
- * unix/Makefile.in: removed bp.c references (hasn't existed in a
- long time). Corrected 'make dist' to make dist with unversioned
- library directories (same as out of cvs), so make install works
- correctly with either source tree.
+ * unix/Makefile.in: removed bp.c references (hasn't existed in a long
+ time). Corrected 'make dist' to make dist with unversioned library
+ directories (same as out of cvs), so make install works correctly with
+ either source tree.
-2000-11-15 jeff hobbs <jeff.hobbs@acm.org>
+2000-11-15 Jeff Hobbs <jeff.hobbs@acm.org>
- * generic/tclVar.c (TclLookupVar): reverted fix below as it broke
- all other array unset error reporting. Bug-119192 is still
- open.
+ * generic/tclVar.c (TclLookupVar): reverted fix below as it broke all
+ other array unset error reporting. Bug 119192 is still open.
2000-11-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclVar.c (TclLookupVar): Changed references to part2 to
- use elName instead in various error message generating spots, so
- as to fix Bug-119192.
+ * generic/tclVar.c (TclLookupVar): Changed references to part2 to use
+ elName instead in various error message generating spots. [Bug 119192]
2000-11-03 David Gravereaux <davygrvy@ajubasolutions.com>
- * win/.cvsignore: Removed 'configure' from the glob list now
- that it's included.
+ * win/.cvsignore: Removed 'configure' from the glob list now that it's
+ included.
2000-11-03 Jeff Hobbs <hobbs@ajubasolutions.com>
8.4a2 RELEASE
- * unix/Makefile.in (install-libraries, dist):
+ * unix/Makefile.in (install-libraries, dist):
* win/makefile.vc (install-libraries):
- * win/Makefile.in (install-libraries): updated to install
- unversioned library directories into versioned directories.
+ * win/Makefile.in (install-libraries): updated to install unversioned
+ library directories into versioned directories.
* tools/tcl.wse.in: updated for unversioning of library dirs
@@ -234,31 +225,31 @@
* generic/tclStubInit.c:
* generic/tclDecls.h:
- * generic/tcl.decls: added Tcl_SetMainLoop proc that allows people
- to set a main loop that will run for tclsh.
+ * generic/tcl.decls: added Tcl_SetMainLoop proc that allows people to
+ set a main loop that will run for tclsh.
* generic/tcl.h: added Tcl_MainLoopProc typedef
* generic/tclMain.c (Tcl_SetMainLoop, StdinProc, Prompt): new
- StdinProc and Prompt static procs and Tcl_SetMainLoop stubs proc.
- The first two handle a fileevent based prompt (taken from
- tkMain.c). Tcl_SetMainLoop enables the interactive setting of a
- main loop procedure. This enables Tk to be a loadable package.
+ StdinProc and Prompt static procs and Tcl_SetMainLoop stubs proc. The
+ first two handle a fileevent based prompt (taken from tkMain.c).
+ Tcl_SetMainLoop enables the interactive setting of a main loop
+ procedure. This enables Tk to be a loadable package.
2000-11-02 David Gravereaux <davygrvy@ajubasolutions.com>
- * generic/tclEvent.c: tclLibraryPath Tcl_Obj didn't have a way
- to share its data among threads. This caused Tcl_Init() to
- always fail in threads. Added a way to pass the data around
- with a global char*. [BUG: 5301]
+ * generic/tclEvent.c: tclLibraryPath Tcl_Obj didn't have a way to
+ share its data among threads. This caused Tcl_Init() to always fail in
+ threads. Added a way to pass the data around with a global char*.
+ [BUG: 5301]
2000-11-02 Jeff Hobbs <hobbs@ajubasolutions.com>
* unix/configure:
* unix/dltest/configure:
* win/configure:
- * tools/configure: checked in configure scripts so people doing
- CVS checkouts aren't required to have autoconf. Changes to
- configure.in in the future will require the corresponding
- configure script to also be re-autoconf'ed and checked in.
+ * tools/configure: checked in configure scripts so people doing CVS
+ checkouts aren't required to have autoconf. Changes to configure.in in
+ the future will require the corresponding configure script to also be
+ re-autoconf'ed and checked in.
* win/makefile.vc:
* win/tcl.m4: makefile fixes for Win64 support
@@ -270,14 +261,14 @@
* unix/tcl.m4: removed use of -lbsd and -ldl for AIX-5.
- * tests/subst.test: added tests for non-zero return code handling
- by subst.
+ * tests/subst.test: added tests for non-zero return code handling by
+ subst.
* generic/tclParse.c (Tcl_EvalEx): corrected handling of non-zero,
- non-error return code cases for subst. [BUG: 119829]
+ non-error return code cases for subst. [Bug 119829]
- * generic/tclVar.c (TclVarTraceExists): Corrected excessive mem
- use when info exists was called on a non-existent array element.
- [BUG: 119213, 119336]
+ * generic/tclVar.c (TclVarTraceExists): Corrected excessive mem use
+ when info exists was called on a non-existent array element. [Bug
+ 119213, 119336]
2000-10-30 David Gravereaux <davygrvy@ajubasolutions.com>
@@ -290,8 +281,8 @@
2000-10-30 Jeff Hobbs <hobbs@ajubasolutions.com>
- * unix/tclUnixInit.c: added default encoding map from
- "ja_JP.eucJP" to "euc-jp". (takahashi)
+ * unix/tclUnixInit.c: added default encoding map from "ja_JP.eucJP" to
+ "euc-jp". (takahashi)
* tests/clock.test: corrected clock-2.* test numbering
@@ -306,68 +297,67 @@
* unix/configure.in:
* unix/tcl.m4: added support for AIX-5.
- * generic/tclIO.c (Tcl_NotifyChannel): removed #ifdef around code
- for old channel structures, placed preserve/release around statePtr
- * generic/tclIO.c (CloseChannel): the statePtr for a channel was
- not being freed when the last channel in a stack was freed,
- causing a mem leak.
+ * generic/tclIO.c (Tcl_NotifyChannel): removed #ifdef around code for
+ old channel structures, placed preserve/release around statePtr
+ * generic/tclIO.c (CloseChannel): the statePtr for a channel was not
+ being freed when the last channel in a stack was freed, causing a mem
+ leak.
* unix/tclUnixChan.c: updated channel types to strict
- TCL_CHANNEL_VERSION_2 style to avoid compiler warnings. They work
+ TCL_CHANNEL_VERSION_2 style to avoid compiler warnings. They work
either way, but this avoids compiler warnings (that worries people).
2000-10-27 Jennifer Hom <jenn@ajubasolutions.com>
- * library/tcltest1.0/tcltest.tcl: Removed a cd into the test
- directory in runAllTests that screwed up the temporary directory
- setting, effectively preventing users from running tests on
- multiple platforms at the same time.
+ * library/tcltest1.0/tcltest.tcl: Removed a cd into the test directory
+ in runAllTests that screwed up the temporary directory setting,
+ effectively preventing users from running tests on multiple platforms
+ at the same time.
2000-10-26 David Gravereaux <davygrvy@ajubasolutions.com>
- * win/tclWinFile.c (TclpMatchFilesTypes): NULL was being set to
- "attr" which was a DWORD. Changed NULL to zero because a 'void *'
- can't be set to a DWORD to avoid the compiler warning.
+ * win/tclWinFile.c (TclpMatchFilesTypes): NULL was being set to "attr"
+ which was a DWORD. Changed NULL to zero because a 'void *' can't be
+ set to a DWORD to avoid the compiler warning.
2000-10-24 Jennifer Hom <jenn@ajubasolutions.com>
* tests/all.tcl: Removed support for tcltest 1.0.
-
+
* tests/tcltest.test:
* library/tcltest1.0/tcltest.tcl:
* library/tcltest1.0/pkgIndex.tcl:
* docs/tcltest.n: Moved tcltest2 code so that it's the standard
- version of tcltest. Removed all tcltest2 files
- (tests/tcltest2.test, library/tcltest1.0/tcltest2.tcl,
- docs/tcltest2.n).
+ version of tcltest. Removed all tcltest2 files (tests/tcltest2.test,
+ library/tcltest1.0/tcltest2.tcl, docs/tcltest2.n).
2000-10-20 Jeff Hobbs <hobbs@ajubasolutions.com>
* win/tclWinFile.c (TclpMatchFilesTypes): made the stat call only
- occur when necessary (for 'glob' command). Significantly speeds
- up glob command from 8.3. [BUG: 6216]
+ occur when necessary (for 'glob' command). Significantly speeds up
+ glob command from 8.3. [BUG: 6216]
2000-10-19 Jennifer Hom <jenn@ajubasolutions.com>
* library/tcltest1.0/tcltest2.tcl:
* tests/tcltest2
- * doc/tcltest2.n: Code and documentation cleanup. Modified
- -verbose to take list of keywords as well as string of letters.
- Removed Tcl version information from tcltest. Removed
- tcltest::grep from tcltest package. Added optional 3rd directory
- argument to makeFile/makeDirectory and removeFile/removeDirectory.
+ * doc/tcltest2.n: Code and documentation cleanup. Modified -verbose to
+ take list of keywords as well as string of letters. Removed Tcl
+ version information from tcltest. Removed tcltest::grep from tcltest
+ package. Added optional 3rd directory argument to
+ makeFile/makeDirectory and removeFile/removeDirectory.
* tests/basic.test: Changed references to tcltest::tclVersion to
hardcoded numbers.
- * generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl
- in comments to tests/basic.test.
+ * generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl in
+ comments to tests/basic.test.
2000-10-06 David Gravereaux <davygrvy@ajubasolutions.com>
- * win/tclWinChan.c: moved Win2K bug case test with GetStdHandle()
- from TclpGetDefaultStdChannel into Tcl_MakeFileChannel to enable
- a more general method in detecting invalid OS handles rather than
- just a specific known case. [BUG: 5971]
+ * win/tclWinChan.c: moved Win2K bug case test with GetStdHandle() from
+ TclpGetDefaultStdChannel into Tcl_MakeFileChannel to enable a more
+ general method in detecting invalid OS handles rather than just a
+ specific known case. [BUG: 5971]
2000-10-06 Jeff Hobbs <hobbs@ajubasolutions.com>
@@ -383,10 +373,10 @@
* library/tcltest1.0/tcltest2.tcl:
* tests/tcltest2.test:
- * doc/tcltest2.n: Modified the new form of the test command to
- accept both attribute-value pairs and command line options.
- Updated the tests and the documentation for this new format.
- Also changed the option names for the test command.
+ * doc/tcltest2.n: Modified the new form of the test command to accept
+ both attribute-value pairs and command line options. Updated the tests
+ and the documentation for this new format. Also changed the option
+ names for the test command.
2000-09-29 Jeff Hobbs <hobbs@scriptics.com>
@@ -394,24 +384,24 @@
space parity on Windows (Eason) [Bug 6057].
* win/Makefile.in: commented use of TESTFLAGS
- * unix/Makefile.in: added TESTFLAGS to test target to
- conform with Windows makefile and TEA style.
+ * unix/Makefile.in: added TESTFLAGS to test target to conform with
+ Windows makefile and TEA style.
* tests/stack.test: prevented possible crash on systems with low
- default stacksize (Tru64, AIX) in infinite recursion test. A
- solution to check remaining stack space in the core is best, but
- hard to do in a cross-platform manner.
+ default stacksize (Tru64, AIX) in infinite recursion test. A solution
+ to check remaining stack space in the core is best, but hard to do in
+ a cross-platform manner.
- * generic/tclIOGT.c (FLUSH_DELAY): renamed DELAY define to
- FLUSH_DELAY to avoid defn conflict using Tru64's cc.
+ * generic/tclIOGT.c (FLUSH_DELAY): renamed DELAY define to FLUSH_DELAY
+ to avoid defn conflict using Tru64's cc.
2000-09-28 Jeff Hobbs <hobbs@ajubasolutions.com>
* tools/tcl.wse.in: added tclPlatDecls.h and tkPlatDecls.h to the
Windows .exe install.
- * tests/fCmd.test (fCmd-6.20): corrected test to remove
- c:/tcl8975@ after creating it.
+ * tests/fCmd.test (fCmd-6.20): corrected test to remove c:/tcl8975@
+ after creating it.
* tests/fileName.test: cleaned up the testing of glob patterns for
c:/globTest (Windows) to directly create/remove directory.
@@ -421,13 +411,13 @@
* generic/tcl.decls:
* generic/tclIO.c: updated Tcl_IsChannelShared,
Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel,
- Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to
- the new stacked channel implementation. Their stub slots were
- also moved to give preference to the new 8.3.2 stub functions.
- This will cause an incompatability with 8.4a1 only.
+ Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
+ new stacked channel implementation. Their stub slots were also moved
+ to give preference to the new 8.3.2 stub functions. This will cause an
+ incompatability with 8.4a1 only.
(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
didn't set nonBlocking correctly when resetting the flags for the
- write side. [Bug: 6261]
+ write side. [Bug: 6261]
* doc/ChnlStack.3:
* doc/CrtChannel.3:
@@ -451,7 +441,7 @@
* win/tclWinPipe.c:
* win/tclWinSerial.c:
* win/tclWinSock.c: Up-port of changes made in 8.3.2 to 8.4a2 code
- base. Most of these changes relate to the rewrite of the stacked
+ base. Most of these changes relate to the rewrite of the stacked
channel implementation, with a few config related fixes.
Following is an asynchronous include of the applicable ChangeLog
@@ -467,67 +457,66 @@
* doc/CrtChannel.3: updated the docs to be aware of the
TCL_CHANNEL_VERSION_2 style of Tcl channels.
- * generic/tclIO.c (Tcl_CreateChannel): added assertion to verify
- that the new channel versioning will be binary compatible with
- older channel drivers.
+ * generic/tclIO.c (Tcl_CreateChannel): added assertion to verify that
+ the new channel versioning will be binary compatible with older
+ channel drivers.
2000-08-05 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclIOGT.c (TclChannelTransform): fixed segfault that
- would occur when transforming a channel with a proc that did not
- yet exist. (Kupries)
+ * generic/tclIOGT.c (TclChannelTransform): fixed segfault that would
+ occur when transforming a channel with a proc that did not yet exist.
+ (Kupries)
* generic/tclTest.c (TestChannelCmd): added some lint init'ing of
statePtr and chan vars.
2000-07-26 Jeff Hobbs <hobbs@scriptics.com>
- * merged core-8-3-1-io-rewrite back into core-8-3-1-branch.
- The core-8-3-1-io-rewrite branch should now be considered defunct.
+ Merged core-8-3-1-io-rewrite back into core-8-3-1-branch. The
+ core-8-3-1-io-rewrite branch should now be considered defunct.
* generic/tclStubInit.c:
* generic/tclDecls.h:
* generic/tcl.decls:
* generic/tcl.h:
- * generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to
- tclIO.c and made them proper stubbed functions. These are:
- Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc,
- Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc,
- Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc,
+ * generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to tclIO.c
+ and made them proper stubbed functions. These are: Tcl_ChannelName,
+ Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc,
+ Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc,
+ Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc,
Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc,
- Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc,
- and Tcl_ChannelHandlerProc. These should be used to access the
+ Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, and
+ Tcl_ChannelHandlerProc. These should be used to access the
Tcl_ChannelType structure instead of direct pointer dereferencing.
- * tests/iogt.test: added RCS string, marked tests 2.* to be
- unixOnly due to underlying system differences.
+ * tests/iogt.test: added RCS string, marked tests 2.* to be unixOnly
+ due to underlying system differences.
2000-07-25 Andreas Kupries <a.kupries@westend.com>
* tests/iogt.test: (line 866f) New tests iogt-6.[01], highlighting
- buffering trouble when stacking and unstacking transformations.
- iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for
- now, due to the perceived complexity of solutions.
+ buffering trouble when stacking and unstacking transformations.
+ iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for now,
+ due to the perceived complexity of solutions.
- * generic/tclIO.h: (line 139f) struct Channel, added a buffer
- queue, to hold data pushed back when stacking a transformation.
+ * generic/tclIO.h: (line 139f) struct Channel, added a buffer queue,
+ to hold data pushed back when stacking a transformation.
* generic/tclIO.c:
- (line 91f, line 7434f) New internal function 'CopyBuffer'.
- Derived from 'CopyAndTranslateBuffer', with translation
- removed.
- (line 1025f, line 1212f): Initialization of new queue.
- (line 1164f, Tcl_StackChannel): Pushback of input queue.
- (line 1293f, Tcl_UnstackChannel): Discard input and pushback.
- (line 3748f, Tcl_ReadRaw): Modified to use data in the push back
- area before going to the driver. Uses 'CopyBuffer', s.a.
- (line 4702f, GetInput): Modified to use data in the push back
- area before going to the driver.
- (line 4867f, Tcl_Seek): Modified to take pushback of the topmost
- channel in a stack into account.
- (line 5620f, Tcl_InputBuffered): See above. Added
- 'Tcl_ChannelBuffered'. Analogue to 'Tcl_InputBuffered' but for
- the buffer area in the channel.
+ (line 91f, line 7434f) New internal function 'CopyBuffer'. Derived
+ from 'CopyAndTranslateBuffer', with translation removed.
+ (line 1025f, line 1212f): Initialization of new queue.
+ (line 1164f, Tcl_StackChannel): Pushback of input queue.
+ (line 1293f, Tcl_UnstackChannel): Discard input and pushback.
+ (line 3748f, Tcl_ReadRaw): Modified to use data in the push back area
+ before going to the driver. Uses 'CopyBuffer', s.a.
+ (line 4702f, GetInput): Modified to use data in the push back area
+ before going to the driver.
+ (line 4867f, Tcl_Seek): Modified to take pushback of the topmost
+ channel in a stack into account.
+ (line 5620f, Tcl_InputBuffered): See above. Added
+ 'Tcl_ChannelBuffered'. Analog to 'Tcl_InputBuffered' but for the
+ buffer area in the channel.
* generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.
@@ -541,21 +530,21 @@
* generic/tclIntDecls.h:
* generic/tclInt.decls: commented out internal decls for
TclTestChannelCmd and TclTestChannelEventCmd as they were moved to
- tclTest.c. Added new decls for TclChannelEventScriptInvoker and
+ tclTest.c. Added new decls for TclChannelEventScriptInvoker and
TclChannelTransform.
* generic/tclIO.c (CloseChannel): stopped masking out of the
- TCL_READABLE|TCL_WRITABLE bits from the state flags in
- CloseChannel, instead adding extra intelligence to
- CheckChannelErrors with a new CHANNEL_RAW_MODE bit for special
- behavior when called from Raw channel APIs.
+ TCL_READABLE|TCL_WRITABLE bits from the state flags in CloseChannel,
+ instead adding extra intelligence to CheckChannelErrors with a new
+ CHANNEL_RAW_MODE bit for special behavior when called from Raw channel
+ APIs.
2000-07-13 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclIO.c (StackSetBlockMode): moved set of chanPtr
- outside of blockModeProc check to avoid infinite loop when
- blockModeProc was NULL (Kupries). updated TransformSeekProc to
- not call Tcl_Seek directly (Kupries).
+ * generic/tclIO.c (StackSetBlockMode): moved set of chanPtr outside of
+ blockModeProc check to avoid infinite loop when blockModeProc was
+ NULL. Updated TransformSeekProc to not call Tcl_Seek directly
+ (Kupries).
* win/tclWinChan.c: updated fileChannelType to v2 channel struct
* win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
@@ -565,85 +554,82 @@
2000-07-11 Brent Welch <welch@ajubasolutions.com>
- * win/tclConfig.sh.in (TCL_LIBS): Cleaned up unix-specific
- autoconf variables.
+ * win/tclConfig.sh.in (TCL_LIBS): Cleaned up unix-specific autoconf
+ variables.
2000-07-11 Jeff Hobbs <hobbs@scriptics.com>
- * tests/iogt.test: made tests [345].0 not run by default as they
- were failing in the new design, but I'm not convinced that the
- returned result isn't correct.
+ * tests/iogt.test: made tests [345].0 not run by default as they were
+ failing in the new design, but I'm not convinced that the returned
+ result isn't correct.
* generic/tclDecls.h:
* generic/tclStubInit.c:
- * generic/tcl.decls: added Tcl_GetTopChannel C API that returns
- the current top channel of a channel stack. Tcl_GetChannel was
- changed earlier to return the bottommost channel of a stack
- because that is the one that is guaranteed to stay around the
- longest, and this was needed to compensate for certain
- operations that want to look at the state of the main channel.
- Most channel APIs already compensate for grabbing the top, so it
- shouldn't be needed often.
+ * generic/tcl.decls: added Tcl_GetTopChannel C API that returns the
+ current top channel of a channel stack. Tcl_GetChannel was changed
+ earlier to return the bottommost channel of a stack because that is
+ the one that is guaranteed to stay around the longest, and this was
+ needed to compensate for certain operations that want to look at the
+ state of the main channel. Most channel APIs already compensate for
+ grabbing the top, so it shouldn't be needed often.
* generic/tclIO.c (Tcl_StackChannel, Tcl_UnstackChannel): Added
- flushing of buffers (Kupries), removed use of DownChannel macro,
- added Tcl_GetTopChannel public API to get to the top channel of
- the channel stack (necessary for TLS). Rewrote Tcl_NotifyChannel
- for new channel design (Kupries). Did some code cleanup in the
- transform code. tclIO.c must still be broken into bits (separate
- out test code and giot code, create tclIO.h).
+ flushing of buffers (Kupries), removed use of DownChannel macro, added
+ Tcl_GetTopChannel public API to get to the top channel of the channel
+ stack (necessary for TLS). Rewrote Tcl_NotifyChannel for new channel
+ design (Kupries). Did some code cleanup in the transform code.
+ tclIO.c must still be broken into bits (separate out test code and
+ giot code, create tclIO.h).
2000-07-10 Andreas Kupries <a.kupries@westend.com>
* tests/iogt.test: Reverted some earlier changes as a fix by Jeff
- revived the original and correct behaviour. IOW, the tests showed
- a genuine error and I didn't see it :(.
+ revived the original and correct behaviour. IOW, the tests showed a
+ genuine error and I didn't see it :(.
- * generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use
- the drivers and not DoRead|DoWrite. The latter use the buffering
- system, encoding and eol-translation and this wreaks havoc with
- the data going through the transformations. Both procedures use
- CheckForchannelErrors and let it believe that there is no
- background copy in progress or else stacked channels could not
- be used for that.
+ * generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use the
+ drivers and not DoRead|DoWrite. The latter use the buffering system,
+ encoding and eol-translation and this wreaks havoc with the data going
+ through the transformations. Both procedures use CheckForchannelErrors
+ and let it believe that there is no background copy in progress or
+ else stacked channels could not be used for that.
* generic/tclIO.c (TclCopyChannel, CopyData): Moved access to the
- topmost channel from the first to the second procedure to make
- the decision about that at the last possible time (Callbacks can
- change the stacking).
+ topmost channel from the first to the second procedure to make the
+ decision about that at the last possible time (Callbacks can change
+ the stacking).
test suite: failures of iogt-[345].0
-
+
2000-07-06 Jeff Hobbs <hobbs@scriptics.com>
- * tests/iogt.test: new tests for stacked channel stuff based off
- new 'testchannel transform|unstack' code (Kupries IOGT extension).
+ * tests/iogt.test: new tests for stacked channel stuff based off new
+ 'testchannel transform|unstack' code (Kupries IOGT extension).
* generic/tcl.decls:
* generic/tcl.h:
* generic/tclDecls.h:
* generic/tclStubsInit.c:
- * generic/tclIO.c: complete rewrite of Tcl Channel code for
- stacked channels. Channels are now designed to work in a more
- stacked fashion with a shared ChannelState data structure.
+ * generic/tclIO.c: complete rewrite of Tcl Channel code for stacked
+ channels. Channels are now designed to work in a more stacked fashion
+ with a shared ChannelState data structure.
2000-06-02 Jeff Hobbs <hobbs@scriptics.com>
* generic/tclIO.c (CloseChannel): removed the &ing out of
- (TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does
- this on the next pass through for the top channel, and it appeared
- to be causing hangs by not allowing the final flush.
+ (TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does this
+ on the next pass through for the top channel, and it appeared to be
+ causing hangs by not allowing the final flush.
2000-06-01 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclIO.c (CloseChannel): Rewrote CloseChannel code to
- unstack a channel during the close process. Fixed a refcount bug
- in Tcl_UnstackChannel. [Bug: 5623]
- (CloseChannel): further extended CloseChannel in the stacked case
- to effect certain operations on the next channel that would have
- been done in Tcl_Close. Also added CHANNEL_CLOSED and removed
- (TCL_READABLE|TCL_WRITABLE) bits from chanPtr->flags. Changed
- final reset of the WatchProc to check the chanDownPtr's (next)
- interestMask.
+ * generic/tclIO.c (CloseChannel): Rewrote CloseChannel code to unstack
+ a channel during the close process. Fixed a refcount bug in
+ Tcl_UnstackChannel. [Bug: 5623]
+ (CloseChannel): further extended CloseChannel in the stacked case to
+ effect certain operations on the next channel that would have been
+ done in Tcl_Close. Also added CHANNEL_CLOSED and removed
+ (TCL_READABLE|TCL_WRITABLE) bits from chanPtr->flags. Changed final
+ reset of the WatchProc to check the chanDownPtr's (next) interestMask.
******************************************************
** END OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) **
@@ -651,49 +637,46 @@
2000-09-20 Jeff Hobbs <hobbs@scriptics.com>
- * tests/socket.test: removed doTestsWithRemoteServer constraint
- from socket-12.*. It requires 'exec', not a remote server.
- Cleaned up some coding errors.
+ * tests/socket.test: removed doTestsWithRemoteServer constraint from
+ socket-12.*. It requires 'exec', not a remote server. Cleaned up some
+ coding errors.
2000-09-20 Jennifer Hom <jenn@ajubasolutions.com>
* library/tcltest1.0/pkgIndex.tcl: Updated to load tcltest 2.0.
- * library/tcltest1.0/tcltest2.tcl: New version of tcltest.
- Cleanup of command line parsing: allows users to specify command
- line arguments through an environment variable named
- TCLTEST_OPTIONS [RFE: 3748], does not respond to incorrect
- arguments, and forces usage of entire flag name when using command
- line arguments. Defines accessor procs for all tcltest
- variables. Allows users to use 'return' in test scripts. Allow
- users to specify whether test files should be sourced or run in a
- separate process. 'all.tcl' code moved to tcltest package.
- 'test' proc modified to use attribute-value pairs. Allow users to
+ * library/tcltest1.0/tcltest2.tcl: New version of tcltest.
+ Cleanup of command line parsing: allows users to specify command line
+ arguments through an environment variable named TCLTEST_OPTIONS [RFE:
+ 3748], does not respond to incorrect arguments, and forces usage of
+ entire flag name when using command line arguments. Defines accessor
+ procs for all tcltest variables. Allows users to use 'return' in test
+ scripts. Allow users to specify whether test files should be sourced
+ or run in a separate process. 'all.tcl' code moved to tcltest package.
+ 'test' proc modified to use attribute-value pairs. Allow users to
specify what return codes, output, and errors can be compared and
- whether these values should be compared using regexp, glob, or
- exact matching. makeDirectory & removeDirectory now operate with
- respect to temporaryDirectory [Bug: 6001]. Test results from
- tests run in slave interpreters are now included in test totals
- [Bug: 1493]. Test files that return error values are now reported.
-
- * tests/all.tcl: Added code to check for the tcltest version
- loaded; modified to figure out which tests to run based on the
- tcltest version loaded.
+ whether these values should be compared using regexp, glob, or exact
+ matching. makeDirectory & removeDirectory now operate with respect to
+ temporaryDirectory [Bug: 6001]. Test results from tests run in slave
+ interpreters are now included in test totals [Bug: 1493]. Test files
+ that return error values are now reported.
+ * tests/all.tcl: Added code to check for the tcltest version loaded;
+ modified to figure out which tests to run based on the tcltest version
+ loaded.
* tests/tcltest.test: Modified to explicitly load version 1.0 of
tcltest.
- * tests/tcltest2.test: New test suite for tcltest; includes all of
- the old tests plus new ones reflecting changes made for version
- 2.0.
- * tests/cmdAH.test: Added singleTestInterp constraint to
- cmdAH-31.2; this test does not run if tests aren't sourced into a
- single interpreter.
- * tests/socket.test: Fixed two tests that were referencing
- variables outside of scope.
-
+ * tests/tcltest2.test: New test suite for tcltest; includes all of the
+ old tests plus new ones reflecting changes made for version 2.0.
+ * tests/cmdAH.test: Added singleTestInterp constraint to cmdAH-31.2;
+ this test does not run if tests aren't sourced into a single
+ interpreter.
+ * tests/socket.test: Fixed two tests that were referencing variables
+ outside of scope.
+
* tools/tcl.wse.in: Added code to install tcltest2.tcl.
- * doc/tcltest2.n: New documentation for tcltest version 2.0.
- Removes documentation for tcltest namespace variables. Adds
- documentation for new tcltest procs.
+ * doc/tcltest2.n: New documentation for tcltest version 2.0. Removes
+ documentation for tcltest namespace variables. Adds documentation for
+ new tcltest procs.
* unix/mkLinks: Added code to link to tcltest2.n.
@@ -702,15 +685,15 @@
2000-09-19 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): When using -all, all
- attempts after the first to match the regexp against the string
- should include the TCL_REG_NOTBOL flag, to avoid erroneously
- matching ^ in the middle of the string. Added code to set this
- flag after the first pass through the matching loop. [Bug: 6284].
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): When using -all, all attempts
+ after the first to match the regexp against the string should include
+ the TCL_REG_NOTBOL flag, to avoid erroneously matching ^ in the middle
+ of the string. Added code to set this flag after the first pass
+ through the matching loop. [Bug: 6284].
2000-09-19 David Gravereaux <davygrvy@ajubasolutions.com>
- * doc/Eval.3: Added a note about the script argument to Tcl_Eval()
+ * doc/Eval.3: Added a note about the script argument to Tcl_Eval()
should be in UTF-8 or risk implied conversion errors when possible
combinations of upper ascii can be valid UTF-8 special codes.
@@ -726,24 +709,24 @@
* doc/Alloc.3: Added entries for Tcl_AttemptAlloc, Tcl_AttempRealloc.
* doc/StringObj.3: Added entry for Tcl_AttemptSetObjLength.
-
+
* generic/tclDecls.h:
* generic/tclStubInit.c: Regen'ed stubs files from new tcl.decls.
* generic/tcl.decls: Added stubs for the Tcl_Attempt* memory
allocators and for Tcl_AttemptSetObjLength.
- * generic/tcl.h: Added #define's for attemptckalloc,
- attemptckrealloc, which map to the Tcl_Attempt* memory allocators.
+ * generic/tcl.h: Added #define's for attemptckalloc, attemptckrealloc,
+ which map to the Tcl_Attempt* memory allocators.
* generic/tclCkalloc.c: Added non-panic'ing versions of Tcl_Alloc,
Tcl_Realloc, etc.; these are called Tcl_AttemptAlloc,
- Tcl_AttemptRealloc, etc. These are used by
- Tcl_AttemptSetObjLength and the string obj append functions.
+ Tcl_AttemptRealloc, etc. These are used by Tcl_AttemptSetObjLength and
+ the string obj append functions.
* generic/tclStringObj.c: Modified string growth algorithm to use
- doubling algorithm as long as possible, and only fall back when
- that fails. Added Tcl_AttemptSetObjLength, and modified
+ doubling algorithm as long as possible, and only fall back when that
+ fails. Added Tcl_AttemptSetObjLength, and modified
AppendUnicodeToUnicodeRep, AppendUtfToUtfRep, and
Tcl_AppendStringsToObjVA to support this.
@@ -753,17 +736,17 @@
project conversion backups.
* win/tclWinPipe.c: Stage-1 bug fix for TR#2460 "exec leaks memory".
- Added more logic around the close-down of the pipe reader thread so
- as to avoid, at all cost, a TerminateThread. Most cases with exec
- are fixed, but I don't consider 2460 done yet. Closing down the
- read side of a pipe before the child process, doesn't really fit
- the windows model. [BUG: 2460]
+ Added more logic around the close-down of the pipe reader thread so as
+ to avoid, at all cost, a TerminateThread. Most cases with exec are
+ fixed, but I don't consider 2460 done yet. Closing down the read side
+ of a pipe before the child process, doesn't really fit the windows
+ model. [BUG: 2460]
2000-09-07 Jeff Hobbs <hobbs@scriptics.com>
* 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
@@ -771,14 +754,14 @@
* win/tclWinLoad.c (TclpLoadFile): added special message for
ERROR_PROC_NOT_FOUND exception in loading a dll.
- * win/tclWinError.c: changed ERROR_PROC_NOT_FOUND to map from
- ESRCH (POSIX: no such process) to EINVAL because there is no good
- mapping for "procedure not found".
+ * win/tclWinError.c: changed ERROR_PROC_NOT_FOUND to map from ESRCH
+ (POSIX: no such process) to EINVAL because there is no good mapping
+ for "procedure not found".
* README:
* generic/tcl.h:
* library/tcltest1.0/tcltest.tcl:
- * tools/tcl.wse.in:
+ * tools/tcl.wse.in:
* tools/tcltk-man2html.tcl:
* unix/configure.in:
* unix/tcl.spec:
@@ -795,8 +778,8 @@
appends.
* doc/source.n:
- * doc/Eval.3: added extra note about how to safe use ^Z in code,
- as it is now a cross-platform (was just Windows) EOF char.
+ * doc/Eval.3: added extra note about how to safe use ^Z in code, as it
+ is now a cross-platform (was just Windows) EOF char.
2000-09-05 Jeff Hobbs <hobbs@scriptics.com>
@@ -810,26 +793,26 @@
2000-08-29 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclStringObj.c: Applied patch from Gerhard Hintermayer
- to provide a more conservative string growth algorithm for strings
- larger than one megabyte; this allows more efficient use of memory
- for very large strings.
+ * generic/tclStringObj.c: Applied patch from Gerhard Hintermayer to
+ provide a more conservative string growth algorithm for strings larger
+ than one megabyte; this allows more efficient use of memory for very
+ large strings.
2000-08-25 Eric Melski <ericm@ajubasolutions.com>
* tests/trace.test: Extended array tracing tests.
- * doc/trace.n: Clarified information about when array traces will
- be fired.
+ * doc/trace.n: Clarified information about when array traces will be
+ fired.
* generic/tclVar.c (Tcl_ArrayObjCmd): Corrected call to CallTraces
- (for TCL_TRACE_ARRAY) to only be called when the variable is
- either an array or is undefined, to ensure that array traces do
- not fire for scalar variables.
+ (for TCL_TRACE_ARRAY) to only be called when the variable is either an
+ array or is undefined, to ensure that array traces do not fire for
+ scalar variables.
2000-08-24 Eric Melski <ericm@ajubasolutions.com>
-
- * doc/man.macros: Tweaked tab settings for .SO (Standard Options)
+
+ * doc/man.macros: Tweaked tab settings for .SO (Standard Options)
sections, based on suggestion from Peter Spjuth.
2000-08-24 Mo DeJong <mdejong@redhat.com>
@@ -838,23 +821,22 @@
* unix/configure.in:
* unix/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option.
* win/README: Add note about building with Cygwin.
- * win/configure.in:
- * win/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option.
- Remove quick hack that provided cross compile support for
- windows builds.
+ * win/configure.in:
+ * win/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option. Remove quick
+ hack that provided cross compile support for windows builds.
2000-08-24 Eric Melski <ericm@ajubasolutions.com>
- Overall change: Added support for command rename/delete traces
- and new trace syntax, from patch from Vince Darley. Added support
- for array traces for variables. [RFE: 5048, 5967].
+ Overall change: Added support for command rename/delete traces and new
+ trace syntax, from patch from Vince Darley. Added support for array
+ traces for variables. [RFE: 5048, 5967].
* doc/trace.n: Updated documentation for new syntax; flagged old
- syntax as deprecated; added documentation for command
- rename/delete traces and variable array traces.
+ syntax as deprecated; added documentation for command rename/delete
+ traces and variable array traces.
- * tests/trace.test: Updated tests for new trace syntax; new tests
- for command rename/delete traces; new tests for array traces.
+ * tests/trace.test: Updated tests for new trace syntax; new tests for
+ command rename/delete traces; new tests for array traces.
* generic/tclVar.c: Support for new trace syntax; support for
TCL_TRACE_ARRAY.
@@ -863,17 +845,17 @@
* generic/tclDecls.h:
* generic/tcl.decls: Stub functions for command rename/delete traces.
- * generic/tcl.h:
+ * generic/tcl.h:
* generic/tclInt.h:
* generic/tclBasic.c: Support for command traces.
- * generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support
- new [trace] syntax:
+ * generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support new
+ [trace] syntax:
trace {add|remove|list} {variable|command} name ops command
Added support for command traces (rename, delete operations).
- Added support for TCL_TRACE_ARRAY at Tcl level (array operation
- for variable traces).
-
+ Added support for TCL_TRACE_ARRAY at Tcl level (array operation for
+ variable traces).
+
2000-08-20 Eric Melski <ericm@ajubasolutions.com>
* generic/tclVar.c: Added check for non-arrays for [array statistics]
@@ -885,11 +867,11 @@
tclPlatDecls.h can't be parsed due to a missing definition of TCHAR.
Added a check to include it when not defined.
- ***POSSIBLE OBSCURE BUG*** could be caused when the compile flags
- for the core happen to be different than a project who uses these
- publics regarding -D_MBCS and -D_UNICODE. This added check might
- have to be revisited later with a better understanding of the
- reprocusions. I think TCHAR should be replaced with it's expansion.
+ ***POSSIBLE OBSCURE BUG*** could be caused when the compile flags for
+ the core happen to be different than a project who uses these publics
+ regarding -D_MBCS and -D_UNICODE. This added check might have to be
+ revisited later with a better understanding of the reprocusions. I
+ think TCHAR should be replaced with it's expansion.
2000-08-18 David Gravereaux <davygrvy@ajubasolutions.com>
@@ -899,13 +881,13 @@
2000-08-15 Eric Melski <ericm@ajubasolutions.com>
* library/tcltest1.0/tcltest.tcl: Set debug level in
- tcltest::restoreState to 2, for consistancy with the debug level
- in tcltest::saveState [Bug: 4505].
+ tcltest::restoreState to 2, for consistancy with the debug level in
+ tcltest::saveState [Bug: 4505].
2000-08-14 Eric Melski <ericm@ajubasolutions.com>
- * win/makefile.vc:
- * win/Makefile.in:
+ * win/makefile.vc:
+ * win/Makefile.in:
* unix/Makefile.in: Added tclPlatDecls.h to the list of installed
headers, for more complete stubs support. [Bug: 5241].
@@ -913,47 +895,44 @@
platform-specific stubs declarations (Tcl_WinTCharToUtf, etc)
[Bug: 5241].
- * README: Updated link for instructions on compiling Tcl from
- sources to point to correct location
- (http://dev.scriptics.com/doc/... instead of
- http://dev.scriptics.com/support/...).
+ * README: Updated link for instructions on compiling Tcl from sources
+ to point to correct location (http://dev.scriptics.com/doc/... instead
+ of http://dev.scriptics.com/support/...).
2000-08-11 Eric Melski <ericm@ajubasolutions.com>
* generic/tclEnv.c (TclUnsetEnv): Changed declaration of length
- variable from "unsigned int" to "int", to match usage when passed
- to TclpFindVariable [Bug: 6126].
+ variable from "unsigned int" to "int", to match usage when passed to
+ TclpFindVariable [Bug: 6126].
2000-08-10 Eric Melski <ericm@ajubasolutions.com>
- * library/msgcat1.0/pkgIndex.tcl: Bumped version number to 1.2
- [Bug: 6100].
+ * library/msgcat1.0/pkgIndex.tcl: Bumped version number to 1.2 [Bug:
+ 6100].
- * library/msgcat1.0/msgcat.tcl: Removed erroneous [package forget]
- in msgcat namespace initializer. Bumped version number to 1.2
- [Bug: 6100].
+ * library/msgcat1.0/msgcat.tcl: Removed erroneous [package forget] in
+ msgcat namespace initializer. Bumped version number to 1.2 [Bug: 6100]
2000-08-10 David Gravereaux <davygrvy@ajubasolutions.com>
- * generic/tclObj.c: r1.15 accidentally changed a global mutex
- name tclObjMutex to ObjMutex. Put the correct name back.
+ * generic/tclObj.c: r1.15 accidentally changed a global mutex name
+ tclObjMutex to ObjMutex. Put the correct name back.
2000-08-07 Eric Melski <ericm@ajubasolutions.com>
* tests/indexObj.test: Added tests using the [testwrongnumargs]
command to test Tcl_WrongNumArgs.
- * generic/tclTest.c (TestWrongNumArgsObjCmd): Added test function
- for the Tcl_WrongNumArgs function.
+ * generic/tclTest.c (TestWrongNumArgsObjCmd): Added test function for
+ the Tcl_WrongNumArgs function.
- * generic/tclIndexObj.c (Tcl_WrongNumArgs): Corrected algorithm to
- not insert a space before the message component when objc == 0
- [Bug: 6078].
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): Corrected algorithm to not
+ insert a space before the message component when objc == 0 [Bug: 6078]
2000-07-27 Mo DeJong <mdejong@redhat.com>
- * win/configure.in: TCL_STUB_LIB_FLAG should not
- include ${TCL_DBGX} in win/tclConfig.sh, fix that.
+ * win/configure.in: TCL_STUB_LIB_FLAG should not include ${TCL_DBGX}
+ in win/tclConfig.sh, fix that.
2000-07-25 David Gravereaux <davygrvy@ajubasolutions.com>
@@ -965,30 +944,30 @@
* generic/tclTest.c:
* mac/tclMacPort.h:
* unix/tclUnixPort.h:
- * win/tclWinInit.c: Thread-safe rewrite for tclAsync.c. Added
- notifier alerting on all platforms as it was only working on Win
- before. Removed older Win hacks that would end-up waking the
- wrong notifier in the presence of a threaded build. All tests
- pass as before. New test cases will be added soon for the new
- behavior. [BUG: 5791]
+ * win/tclWinInit.c: Thread-safe rewrite for tclAsync.c. Added notifier
+ alerting on all platforms as it was only working on Win before.
+ Removed older Win hacks that would end-up waking the wrong notifier in
+ the presence of a threaded build. All tests pass as before. New test
+ cases will be added soon for the new behavior. [BUG: 5791]
2000-07-25 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclVar.c (CallTraces): Added check for VAR_TRACE_ACTIVE
- on the array containing the variable before executing traces on
- that array, to conform with normal variable traces and the
- documentation, which states that while executing a trace, other
- traces on that variable are disabled. [Bug: 6049].
+ * generic/tclVar.c (CallTraces): Added check for VAR_TRACE_ACTIVE on
+ the array containing the variable before executing traces on that
+ array, to conform with normal variable traces and the documentation,
+ which states that while executing a trace, other traces on that
+ variable are disabled. [Bug: 6049].
- * win/tclWinPipe.c (BuildCommandLine): Added Tcl_DStringFree call
- to prevent potential memory leaks [Bug: 6041].
+ * win/tclWinPipe.c (BuildCommandLine): Added Tcl_DStringFree call to
+ prevent potential memory leaks [Bug: 6041].
2000-07-24 Eric Melski <ericm@ajubasolutions.com>
- * doc/msgcat.n: Added documentation about the selection of the
- default locale on Windows.
+ * doc/msgcat.n: Added documentation about the selection of the default
+ locale on Windows.
2000-07-23 Joe English <jenglish@flightlab.com>
+
* doc/AddErrInfo.3:
* doc/ChnlStack.3:
* doc/Exit.3:
@@ -1006,13 +985,13 @@
2000-07-21 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclStubInit.c:
- * generic/tclObj.c:
- * generic/tclInt.h:
- * generic/tclHash.c:
- * generic/tclDecls.h:
- * generic/tcl.h:
- * generic/tcl.decls:
+ * generic/tclStubInit.c:
+ * generic/tclObj.c:
+ * generic/tclInt.h:
+ * generic/tclHash.c:
+ * generic/tclDecls.h:
+ * generic/tcl.h:
+ * generic/tcl.decls:
* doc/Hash.3: Reapplied patch from Paul Duffin to extend hash tables
to allow custom key types, such as Tcl_Obj *'s, and others.
@@ -1022,41 +1001,41 @@
2000-07-21 Mo DeJong <mdejong@redhat.com>
* win/configure.in: Define ${prefix} and ${exec_prefix} like
- unix/configure.in. Fix or add TCL_SRC_DIR, TCL_STUB_LIB_FILE,
+ unix/configure.in. Fix or add TCL_SRC_DIR, TCL_STUB_LIB_FILE,
TCL_STUB_LIB_FLAG, TCL_BUILD_STUB_LIB_SPEC, TCL_STUB_LIB_SPEC,
TCL_BUILD_STUB_LIB_PATH, TCL_STUB_LIB_PATH.
2000-07-20 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclStubInit.c:
- * generic/tclObj.c:
- * generic/tclInt.h:
- * generic/tclHash.c:
- * generic/tclDecls.h:
- * generic/tcl.h:
- * generic/tcl.decls:
- * doc/Hash.3: Reverted patch from Paul Duffin to extend hash tables
- to allow custom key types, such as Tcl_Obj *'s, and others; it
- seems to break Tk.
+ * generic/tclStubInit.c:
+ * generic/tclObj.c:
+ * generic/tclInt.h:
+ * generic/tclHash.c:
+ * generic/tclDecls.h:
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * doc/Hash.3: Reverted patch from Paul Duffin to extend hash tables to
+ allow custom key types, such as Tcl_Obj *'s, and others; it seems to
+ break Tk.
2000-07-19 Eric Melski <ericm@ajubasolutions.com>
- * generic/tclStubInit.c:
- * generic/tclObj.c:
- * generic/tclInt.h:
- * generic/tclHash.c:
- * generic/tclDecls.h:
- * generic/tcl.h:
- * generic/tcl.decls:
- * doc/Hash.3: Applied patch from Paul Duffin to extend hash tables
- to allow custom key types, such as Tcl_Obj *'s, and others.
+ * generic/tclStubInit.c:
+ * generic/tclObj.c:
+ * generic/tclInt.h:
+ * generic/tclHash.c:
+ * generic/tclDecls.h:
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * doc/Hash.3: Applied patch from Paul Duffin to extend hash tables to
+ allow custom key types, such as Tcl_Obj *'s, and others.
* tests/pkgMkIndex.test: Added tests for pkg_compareExtension.
- * library/package.tcl: Enhanced pkg_compareExtension to handle
- Unixes which tack the version number on to the end of library
- names (eg, foo.so.1.2); such filenames will be correctly matched.
- (Patch from Vince Darley).
+ * library/package.tcl: Enhanced pkg_compareExtension to handle Unixes
+ which tack the version number on to the end of library names (eg,
+ foo.so.1.2); such filenames will be correctly matched. (Patch from
+ Vince Darley).
* win/makefile.vc: Applied patch from Don Porter to provide better
nmake support for NT/Alpha [RFE: 5938].
@@ -1065,52 +1044,49 @@
* unix/configure.in:
* unix/tcl.m4:
- * win/tcl.m4: Properly quote arguments to m4 macros. This allows
- Tcl to work with the new version of autoconf.
+ * win/tcl.m4: Properly quote arguments to m4 macros. This allows Tcl
+ to work with the new version of autoconf.
2000-07-18 Eric Melski <ericm@ajubasolutions.com>
* tests/opt.test: Removed references to Lfirst, Lrest functions.
- * library/opt0.4/optparse.tcl: Applied patch from Chris Nelson,
- which replaces the [Lfirst] function with an inline [lindex ... 0]
- and [Lrest] with [lrange ... 1 end], for better performance.
- [RFE: 6019]
-
+ * library/opt0.4/optparse.tcl: Applied patch from Chris Nelson, which
+ replaces the [Lfirst] function with an inline [lindex ... 0] and
+ [Lrest] with [lrange ... 1 end], for better performance. [RFE: 6019]
2000-07-18 Eric Melski <ericm@scriptics.com>
- * compat/string.h: Fixed function prototypes for strpbrk and
- strtok [Bug: 6020].
+ * compat/string.h: Fixed function prototypes for strpbrk and strtok
+ [Bug: 6020].
2000-07-17 David Gravereaux <davygrvy@ajubasolutions.com>
- * win/tclWinChan.c: Win2K OS bug with
- GetStdHandle(STD_OUTPUT_HANDLE) giving the wrong answer. This
- made TclpGetDefaultStdChannel grab what it thought was a valid
- native stdout handle. Added a new WriteFile() test to make sure
- it's really valid. This OS bug doesn't affect the shells. Only
- -subsystem:windows (aka WinMain) application that dynamically
- load tclXX.dll [BUG: 5971]
+ * win/tclWinChan.c: Win2K OS bug with GetStdHandle(STD_OUTPUT_HANDLE)
+ giving the wrong answer. This made TclpGetDefaultStdChannel grab what
+ it thought was a valid native stdout handle. Added a new WriteFile()
+ test to make sure it's really valid. This OS bug doesn't affect the
+ shells. Only -subsystem:windows (aka WinMain) application that
+ dynamically load tclXX.dll [BUG: 5971]
2000-07-17 Eric Melski <ericm@scriptics.com>
- * library/msgcat1.0/msgcat.tcl:
- * doc/msgcat.n:
- * tests/msgcat.test: Applied patches from Chris Nelson, to provide
- the mcmset function, which allows the translator to set multiple
- string translations in a single function call, rather than
- requiring many calls to mcset. [RFE: 6000, 5993]. In addition,
- these patches correct mcload to use utf-8 encoding on when reading
- message catalog files, and provides for better default behavior
- for determining the locale on a Windows system.
+ * library/msgcat1.0/msgcat.tcl:
+ * doc/msgcat.n:
+ * tests/msgcat.test: Applied patches from Chris Nelson, to provide the
+ mcmset function, which allows the translator to set multiple string
+ translations in a single function call, rather than requiring many
+ calls to mcset. [RFE: 6000, 5993]. In addition, these patches correct
+ mcload to use utf-8 encoding on when reading message catalog files,
+ and provides for better default behavior for determining the locale on
+ a Windows system.
2000-07-17 Mo DeJong <mdejong@redhat.com>
- * unix/tcl.m4 (SC_ENABLE_GCC): Don't set CC=gcc
- before running AC_PROG_CC if CC is already set.
+ * 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:
@@ -1124,31 +1100,30 @@
2000-07-07 Mo DeJong <mdejong@redhat.com>
- * win/configure.in: Fix definition of
- TCL_SRC_DIR so that it matches the Unix version.
+ * win/configure.in: Fix definition of TCL_SRC_DIR so that it matches
+ the Unix version.
* win/tclConfig.sh.in: Removed duplicate variables.
2000-07-06 Eric Melski <ericm@scriptics.com>
- * tests/msgcat.test:
- * library/msgcat1.0/msgcat.tcl: Applied patch from Christian
- Krone, to provide extended args support for msgcat::unknown, which
- is used for strings without a known translation in the current
- locale [Bug: 5984].
+ * tests/msgcat.test:
+ * library/msgcat1.0/msgcat.tcl: Applied patch from Christian Krone, to
+ provide extended args support for msgcat::unknown, which is used for
+ strings without a known translation in the current locale [Bug: 5984].
2000-06-29 Eric Melski <ericm@scriptics.com>
* doc/msgcat.n: Doc's for mcmax function.
- * library/msgcat1.0/msgcat.tcl: Applied patches from Laurent
- Duperval, to add mcmax function, which computes the length of the
- longest of several translated strings. Bumped version number to 1.1.
+ * library/msgcat1.0/msgcat.tcl: Applied patches from Laurent Duperval,
+ to add mcmax function, which computes the length of the longest of
+ several translated strings. Bumped version number to 1.1.
2000-06-27 Eric Melski <ericm@scriptics.com>
- * tests/stringObj.test: Tweaked tests to avoid hardcoded
- high-ASCII characters (which will fail in multibyte locales);
- instead used \uXXXX syntax. [Bug: 3842].
+ * tests/stringObj.test: Tweaked tests to avoid hardcoded high-ASCII
+ characters (which will fail in multibyte locales); instead used \uXXXX
+ syntax. [Bug: 3842].
2000-06-26 Eric Melski <ericm@scriptics.com>
@@ -1157,17 +1132,17 @@
2000-06-23 Eric Melski <ericm@scriptics.com>
- * doc/Hash.3: Added documentation patch for Tcl_Obj *'s as keys in
- Tcl hash tables [RFE: 5934].
+ * doc/Hash.3: Added documentation patch for Tcl_Obj *'s as keys in Tcl
+ hash tables [RFE: 5934].
- * generic/tcl.h:
- * generic/tclHash.c: Applied patch from [RFE: 5934], which extends
- Tcl hash tables to allow Tcl_Obj *'s as the key.
+ * generic/tcl.h:
+ * generic/tclHash.c: Applied patch from [RFE: 5934], which extends Tcl
+ hash tables to allow Tcl_Obj *'s as the key.
2000-06-20 Eric Melski <ericm@ajubasolutions.com>
* tests/opt.test:
- * library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which
+ * library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which
corrected an incorrect use of [string match].
* unix/tclConfig.sh.in:
@@ -1183,23 +1158,23 @@
* win/tcl.m4:
* win/configure.in:
- * win/Makefile.in: Applied patch from [RFE: 5844], to extend
- support for mingw compile environment on Windows.
+ * win/Makefile.in: Applied patch from [RFE: 5844], to extend support
+ for mingw compile environment on Windows.
* win/tclWinDde.c:
* win/tclWinInit.c:
* win/tclWinNotify.c:
* win/tclWinPipe.c:
* win/tclWinReg.c:
- * win/tclWinThrd.c: Applied patch from [Bug: 5794], to fix
- compiler warnings when using mingw on Windows.
+ * win/tclWinThrd.c: Applied patch from [Bug: 5794], to fix compiler
+ warnings when using mingw on Windows.
2000-05-31 Jeff Hobbs <hobbs@scriptics.com>
* tests/set-old.test:
* doc/unset.n:
- * generic/tclVar.c (Tcl_UnsetObjCmd): added -nocomplain and --
- options to unset, to allow for a silent unset operation.
+ * generic/tclVar.c (Tcl_UnsetObjCmd): added -nocomplain and -- options
+ to unset, to allow for a silent unset operation.
2000-05-31 Eric Melski <ericm@scriptics.com>
@@ -1216,68 +1191,66 @@
8.4a1 RELEASE
- * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): added
- test of iResult return from memcmp, as memcmp isn't required to
- return only -1,0,1.
+ * generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): added test
+ of iResult return from memcmp, as memcmp isn't required to return only
+ -1,0,1.
2000-06-03 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected
- caching of the index ptr to account for offsets != sizeof(char *).
- [Bug: 5153]
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected caching
+ of the index ptr to account for offsets != sizeof(char *). [Bug: 5153]
2000-05-29 Sandeep Tamhankar <sandeep@scriptics.com>
* tests/http.test
* doc/http.n
- * library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful
- geturl calls sometimes leaked memory and resources (sockets).
- Also, switched around some of the logic so that http::wait never
- throws an exception. This is because in an asynchronous geturl,
- the command callback will probably end up doing all the error
- handling anyway, and in an asynchronous situation, the user
- expects to check the state when the transaction completes, as
- opposed to being thrown an exception. For the http package, this
- menas the user can check http::status for "error" and http::error
- for the error message after doing the http::wait.
+ * library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful geturl
+ calls sometimes leaked memory and resources (sockets). Also, switched
+ around some of the logic so that http::wait never throws an exception.
+ This is because in an asynchronous geturl, the command callback will
+ probably end up doing all the error handling anyway, and in an
+ asynchronous situation, the user expects to check the state when the
+ transaction completes, as opposed to being thrown an exception. For
+ the http package, this menas the user can check http::status for
+ "error" and http::error for the error message after doing the
+ http::wait.
2000-05-27 Jeff Hobbs <hobbs@scriptics.com>
* tests/info.test:
* doc/info.n:
* generic/tclIOUtil.c (Tcl_EvalFile):
- * generic/tclCmdIL.c (InfoScriptCmd): added ability to set the
- info script return value [info script ?newFileName?]. This will
- be beneficial for virtual file system programs. [Bug: 4225]
+ * generic/tclCmdIL.c (InfoScriptCmd): added ability to set the info
+ script return value [info script ?newFileName?]. This will be
+ beneficial for virtual file system programs. [Bug: 4225]
2000-05-26 Jeff Hobbs <hobbs@scriptics.com>
* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): reworked to operate in
Unicode, tweaked for performance.
(Tcl_StringObjCmd) changed STR_FIRST/STR_LAST error message to
- something more understandable, reworked STR_FIRST, STR_LAST,
- STR_MAP, STR_MATCH, STR_RANGE, STR_REPLACE to operate in Unicode.
- Removed inneffectual STR_RANGE "special" ByteArray support.
- Optimized STR_MAP algorithm, especially optimized for one-pair case.
- Fixed possible mem overrun in STR_INDEX bytearray case.
-
+ something more understandable, reworked STR_FIRST, STR_LAST, STR_MAP,
+ STR_MATCH, STR_RANGE, STR_REPLACE to operate in Unicode. Removed
+ inneffectual STR_RANGE "special" ByteArray support. Optimized STR_MAP
+ algorithm, especially optimized for one-pair case. Fixed possible mem
+ overrun in STR_INDEX bytearray case.
+
* generic/tclCompExpr.c: changed INST_STREQ -> INST_STR_EQ,
INST_STRNEQ -> INST_STR_NEQ
* generic/tclCompile.c: added streq, strneq, strcmp, strlen &
strmatch to the compiled stats instructionTable
* generic/tclCompile.h: added instructions INST_STR_CMP,
INST_STR_INDEX, INST_STR_MATCH
- * generic/tclCompCmds.c: added byte compiler support for
- [string compare|match|index].
- * generic/tclExecute.c:
- Changed INST_STR_(N)EQ to return an Int object and not bother
- trying to reuse the top stack object.
- Added INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH bytecode ops.
- Extended evalstats output info with Tcl_IsShared stat info.
+ * generic/tclCompCmds.c: added byte compiler support for [string
+ compare|match|index].
+ * generic/tclExecute.c: Changed INST_STR_(N)EQ to return an Int object
+ and not bother trying to reuse the top stack object. Added
+ INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH bytecode ops. Extended
+ evalstats output info with Tcl_IsShared stat info.
* generic/tclInt.h:
- * generic/tclObj.c (Tcl_DbIsShared): added support for checking
- result of Tcl_IsShared in evalstats (TCL_COMPILE_STATS).
+ * generic/tclObj.c (Tcl_DbIsShared): added support for checking result
+ of Tcl_IsShared in evalstats (TCL_COMPILE_STATS).
* generic/tclStringObj.c (Tcl_AppendUnicodeToObj): removed dead code.
(AppendUnicodeToUnicodeRep) removed overallocation by extra
@@ -1289,31 +1262,30 @@
2000-05-23 Eric Melski <ericm@scriptics.com>
- * generic/tclInt.h: Added function prototypes for
- TclCompileStringCmd and TclCompileReturnCmd.
+ * generic/tclInt.h: Added function prototypes for TclCompileStringCmd
+ and TclCompileReturnCmd.
* generic/tclCompile.h: Added definition of INST_STRLEN opcode and
updated LAST_INST_OPCODE value.
- * generic/tclBasic.c: Added information about TclCompileStringCmd
- and TclCompileReturnCmd to BuiltInCmds table.
+ * generic/tclBasic.c: Added information about TclCompileStringCmd and
+ TclCompileReturnCmd to BuiltInCmds table.
* generic/tclExecute.c (TclExecuteByteCode): Added support for the
INST_STRLEN opcode.
- * generic/tclCompCmds.c
- (TclCompileStringCmd): Basic implementation of byte-compiled
- [string] command. Not all subcommands are implemented; those
- that are not an out-line compiled.
+ * generic/tclCompCmds.c (TclCompileStringCmd): Basic implementation of
+ byte-compiled [string] command. Not all subcommands are implemented;
+ those that are not an out-line compiled.
(TclCompileReturnCmd): Byte-compiled implementation of [return]
- command. Only "simple" returns are byte-compiled; in particular,
- if the -code, -errorinfo or -errorcode flags are used, the command
- is not byte-compiled.
+ command. Only "simple" returns are byte-compiled; in particular, if
+ the -code, -errorinfo or -errorcode flags are used, the command is not
+ byte-compiled.
2000-05-22 Jeff Hobbs <hobbs@scriptics.com>
- * doc/scan.n:
+ * doc/scan.n:
* doc/array.n: minor doc fixes [Bug: 5396]
* generic/tclEnv.c: cast cleanup [Bug: 5624]
@@ -1331,9 +1303,9 @@
* generic/tclStubInit.c:
* generic/tclIntDecls.h:
- * generic/tclInt.decls: removed TclTestChannel*Cmd from internal
- stubs table and added TclChannelEventScriptInvoker to the internal
- stubs table so it can be used from the test code.
+ * generic/tclInt.decls: removed TclTestChannel*Cmd from internal stubs
+ table and added TclChannelEventScriptInvoker to the internal stubs
+ table so it can be used from the test code.
2000-05-18 Eric Melski <ericm@scriptics.com>
@@ -1342,9 +1314,9 @@
* generic/tclDate.c: Regenerated from tclGetDate.y.
- * generic/tclGetDate.y: Tweaked grammar to properly handle the
- "ago" keyword when it follows multiple relative unit specifiers,
- as in "2 days 2 hours ago". [Bug: 5497].
+ * generic/tclGetDate.y: Tweaked grammar to properly handle the "ago"
+ keyword when it follows multiple relative unit specifiers, as in "2
+ days 2 hours ago". [Bug: 5497]
2000-05-18 Jeff Hobbs <hobbs@scriptics.com>
@@ -1354,9 +1326,9 @@
* generic/tclClock.c (FormatClock): correct code to handle locale
specific return values from strftime, if any. [Bug: 3345]
- * unix/tclUnixInit.c (TclpSetInitialEncodings): attempt to
- correct setlocale calls for XIM support and locale issues.
- [BUG: 5422 3345 4236 2522 2521]
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): attempt to correct
+ setlocale calls for XIM support and locale issues. [BUG: 5422 3345
+ 4236 2522 2521]
2000-05-17 Jeff Hobbs <hobbs@scriptics.com>
@@ -1373,32 +1345,32 @@
2000-05-10 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for
- Linux on Sparc to compile correctly. [Bug: 5364]
+ * generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for Linux
+ on Sparc to compile correctly. [Bug: 5364]
* doc/namespace.n:
* tests/namespace.test:
- * generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace
- exists' command. [Bug: 4665]
+ * generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace exists'
+ command. [Bug: 4665]
* doc/source.n:
* doc/Eval.3:
* tests/source.test:
- * generic/tclIOUtil.c (Tcl_EvalFile): added explicit \32 (^Z)
- eofchar (affects Tcl_EvalFile in C, "source" in Tcl). This was
- implicit on Windows already, and is now cross-platform to allow
- for scripted documents.
+ * generic/tclIOUtil.c (Tcl_EvalFile): added explicit \32 (^Z) eofchar
+ (affects Tcl_EvalFile in C, "source" in Tcl). This was implicit on
+ Windows already, and is now cross-platform to allow for scripted
+ documents.
2000-05-09 Andreas Kupries <a.kupries@westend.com>
operating as proxy for David Gravereaux <davygrvy@pobox.com>
-
+
* win/tclWinThrd.c (TclpInitLock, TclpMasterLock): Added missing
- initialization of joinLock.
+ initialization of joinLock.
2000-05-09 Eric Melski <ericm@scriptics.com>
- * tests/lsearch.test:
- * doc/lsearch.n:
+ * tests/lsearch.test:
+ * doc/lsearch.n:
* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Extended [lsearch] to
support sorted list searching and typed list searching. [RFE: 4098].
@@ -1408,19 +1380,19 @@
* tests/expr.test:
* tests/expr-old.test: added tests for 'eq' and 'ne'
* generic/tclExecute.c:
- * generic/tclCompile.h: added INST_STREQ and INST_STRNEQ opcodes
- that do strict string comparisons.
+ * generic/tclCompile.h: added INST_STREQ and INST_STRNEQ opcodes that
+ do strict string comparisons.
* generic/tclCompExpr.c: added 'eq' and 'ne' string comparison
operators.
- * generic/tclParseExpr.c (GetLexeme): added 'eq' and 'ne' expr
- parse terms (string (in)equality check).
+ * generic/tclParseExpr.c (GetLexeme): added 'eq' and 'ne' expr parse
+ terms (string (in)equality check).
* generic/tclCmdIL.c (Tcl_LinsertObjCmd): made use of
- Tcl_DuplicateObj where code was otherwise duplicated. Made
- special case of inserting one element at the end work again (where
- index == len).
- (Tcl_LreplaceObjCmd): moved Tcl_DuplicateObj call lower and
- cleaned up use of other arguments.
+ Tcl_DuplicateObj where code was otherwise duplicated. Made special
+ case of inserting one element at the end work again (where index ==
+ len).
+ (Tcl_LreplaceObjCmd): moved Tcl_DuplicateObj call lower and cleaned
+ up use of other arguments.
* generic/tclObj.c (Tcl_DuplicateObj): simplified code to call
TclInitStringRep, which the code was just duplicating in part.
@@ -1437,16 +1409,15 @@
2000-05-08 Eric Melski <ericm@scriptics.com>
- * tests/set-old.test:
- * doc/array.n:
+ * tests/set-old.test:
+ * doc/array.n:
* generic/tclVar.c: Added [array statistics] command [RFE: 4557]
2000-05-06 Andreas Kupries <a.kupries@westend.com>
operating as proxy for David Gravereaux <davygrvy@pobox.com>
- * tclThreadJoin.c: Fixed several places with missing a & in
- arguments to calls of Tcl_Mutex(Un)lock and
- Tcl_ConditionNotify functions.
+ * tclThreadJoin.c: Fixed several places with missing a & in arguments
+ to calls of Tcl_Mutex(Un)lock and Tcl_ConditionNotify functions.
2000-05-02 Jeff Hobbs <hobbs@scriptics.com>
@@ -1480,72 +1451,70 @@
2000-05-02 Andreas Kupries <a.kupries@westend.com>
- * Overall changes:
+ Overall changes:
(1) Implementation of joinable threads for all platforms.
- (2) Additional API's for channels. Required to allow the
- thread extension to move channels between threads.
+ (2) Additional API's for channels. Required to allow the thread
+ extension to move channels between threads.
* generic/tcl.decls (lines 1360f): Added Tcl_JoinThread,
- Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel,
- Tcl_SpliceChannel, Tcl_IsChannelExisting and
- Tcl_ClearChannelHandlers (slots 394 to 400).
+ Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel,
+ Tcl_SpliceChannel, Tcl_IsChannelExisting and Tcl_ClearChannelHandlers
+ (slots 394 to 400).
* generic/tclIO.c: Implemented Tcl_IsChannelRegistered,
- Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
- Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.
- Tcl_CutChannel uses code from CloseChannel. Replaced this code
- by a call to Tcl_CutChannel. Replaced several code fragments
- adding channels to the channel list with calls to
- Tcl_SpliceChannel. Removed now unused variables from
- CloseChannel and Tcl_UnstackChannel. Tcl_ClearChannelHandlers
- uses code from Tcl_Close. Replaced this code by a call to
- Tcl_ClearChannelHandlers. Removed now unused variables from
- Tcl_Close. Added the subcommands 'cut', 'forgetch', 'splice' and
- 'isshared' to the test code
- (TclTestChannelCmd).
+ Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
+ Tcl_IsChannelExisting and Tcl_ClearChannelHandlers. Tcl_CutChannel
+ uses code from CloseChannel. Replaced this code by a call to
+ Tcl_CutChannel. Replaced several code fragments adding channels to
+ the channel list with calls to Tcl_SpliceChannel. Removed now unused
+ variables from CloseChannel and Tcl_UnstackChannel.
+ Tcl_ClearChannelHandlers uses code from Tcl_Close. Replaced this code
+ by a call to Tcl_ClearChannelHandlers. Removed now unused variables
+ from Tcl_Close. Added the subcommands 'cut', 'forgetch', 'splice' and
+ 'isshared' to the test code (TclTestChannelCmd).
* unix/tclUnixThread.c: Implemented Tcl_JoinThread using the
- pthread-functionality.
+ pthread-functionality.
* win/tclWinThrd.c: Fixed several small typos in comments.
- Implemented Tcl_JoinThread using a platform independent
- emulation layer (see generic/tclThreadJoin.c below). Added
- 'joinLock' to serialize Tcl_CreateThread and TclpExitThread to
- prevent a race for joinable threads.
+ Implemented Tcl_JoinThread using a platform independent emulation
+ layer (see generic/tclThreadJoin.c below). Added 'joinLock' to
+ serialize Tcl_CreateThread and TclpExitThread to prevent a race for
+ joinable threads.
* mac/tclMacThrd.c: Implemented Tcl_JoinThread using a platform
- independent emulation layer (see generic/tclThreadJoin.c
- below). Due to the cooperative nature of threading on this
- platform the race mentioned above is not present.
+ independent emulation layer (see generic/tclThreadJoin.c below). Due
+ to the cooperative nature of threading on this platform the race
+ mentioned above is not present.
- * generic/tclThreadJoin.c: New file. Contains a platform
- independent emulation layer helping in the implementation of
- joinable threads for the win and mac platforms.
+ * generic/tclThreadJoin.c: New file. Contains a platform independent
+ emulation layer helping in the implementation of joinable threads for
+ the win and mac platforms.
* generic/tclInt.h: Added declarations for TclJoinThread,
- TclRememberJoinableThread and TclSignalExitThread. These
- procedures define the API of the emulation layer for joinable
- threads (see generic/tclThreadJoin.c above).
+ TclRememberJoinableThread and TclSignalExitThread. These procedures
+ define the API of the emulation layer for joinable threads (see
+ generic/tclThreadJoin.c above).
* win/Makefile.in:
* win/makefile.vc: Added generic/tclTheadJoin.o to the rules.
- * mac/: I don't know to which file generic/tclTheadJoin.o has to
- be added to so that it compiles. Sorry.
+ * mac/: I don't know to which file generic/tclTheadJoin.o has to be
+ added to so that it compiles. Sorry.
- * unix/tclUnixChan.c: #ifdef'd the thread-local list of file
- channels as it prevents us from transfering channels. To restore
- this we may need an extended interface to drivers in the
- future. Target: 9.0. Found while testing the new transfer of
- channels. The information in this list for a channel was left
- behind and then crashed the system during finalization.
+ * unix/tclUnixChan.c: #ifdef'd the thread-local list of file channels
+ as it prevents us from transfering channels. To restore this we may
+ need an extended interface to drivers in the future. Target:
+ 9.0. Found while testing the new transfer of channels. The information
+ in this list for a channel was left behind and then crashed the system
+ during finalization.
* generic/tclThreadTest.c: Added -joinable flag to 'testthread
- create'. Added subcommand 'testthread join'.
+ create'. Added subcommand 'testthread join'.
* doc/CrtChannel.3: Added documentation for Tcl_IsChannelRegistered,
- Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
- Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.
+ Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
+ Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.
* doc/Thread.3: Added documentation for Tcl_JoinThread.
@@ -1563,8 +1532,8 @@
2000-04-26 Eric Melski <ericm@scriptics.com>
- * doc/memory.n: Man page for Tcl "memory" command, which is
- created when TCL_MEM_DEBUG is defined at compile time.
+ * doc/memory.n: Man page for Tcl "memory" command, which is created
+ when TCL_MEM_DEBUG is defined at compile time.
* doc/TCL_MEM_DEBUG.3: Man page with overall information about
TCL_MEM_DEBUG usage.
@@ -1577,13 +1546,13 @@
* unix/mkLinks: Regen'd with new mkLinks.tcl.
* unix/mkLinks.tcl: Fixed indentation, made link setup more
- intelligent (only do one existance test per man page, instead of
- one per function).
+ intelligent (only do one existance test per man page, instead of one
+ per function).
* doc/library.n: Fixed .SH NAME macro to include each function
- documented on the page, so that mkLinks will know about the
- functions listed there, and so that the Windows help file index
- will get set up correctly [Bug: 1898, 5273].
+ documented on the page, so that mkLinks will know about the functions
+ listed there, and so that the Windows help file index will get set up
+ correctly [Bug: 1898, 5273].
2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
@@ -1613,42 +1582,41 @@
2000-04-25 Eric Melski <ericm@scriptics.com>
- * unix/mkLinks:
+ * unix/mkLinks:
* doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo
[Bug: 1818].
2000-04-24 Eric Melski <ericm@scriptics.com>
- * unix/mkLinks:
+ * unix/mkLinks:
* doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834].
- * unix/mkLinks:
+ * unix/mkLinks:
* doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833].
- * unix/mkLinks:
+ * unix/mkLinks:
* doc/ParseCmd.3: Added documentation for Tcl_ParseVar [Bug: 1828].
2000-04-24 Jeff Hobbs <hobbs@scriptics.com>
* unix/tclUnixNotfy.c (Tcl_FinalizeNotifier, NotifierThreadProc):
- added write of 'q' into triggerPipe for notifier in threaded case,
- so that Tcl doesn't hang when children are still running [Bug: 4139]
+ added write of 'q' into triggerPipe for notifier in threaded case, so
+ that Tcl doesn't hang when children are still running [Bug: 4139]
* unix/tclUnixThrd.c (Tcl_MutexLock): minor comment fixes.
2000-04-23 Jim Ingham <jingham@cygnus.com>
These changes make some error handling marginally better for Mac
- sockets. It is still somewhat flakey, however.
-
- * mac/tclMacSock.c (TcpClose): Add timeouts to the close - these
- don't seem to be honored, however.
- Use a separate PB for the release, since an async connect socket
- will still be using the original buffer.
- Make sure TCPRelease returns noErr before freeing the recvBuff.
- If the call returns an error, then the buffer is not right.
- * mac/tclMacSock.c (CreateSocket): Add timeouts to the async
- create. These don't seem to trigger, however. Sigh...
+ sockets. It is still somewhat flakey, however.
+
+ * mac/tclMacSock.c (TcpClose): Add timeouts to the close - these don't
+ seem to be honored, however. Use a separate PB for the release, since
+ an async connect socket will still be using the original buffer. Make
+ sure TCPRelease returns noErr before freeing the recvBuff. If the call
+ returns an error, then the buffer is not right.
+ * mac/tclMacSock.c (CreateSocket): Add timeouts to the async create.
+ These don't seem to trigger, however. Sigh...
* mac/tclMacSock.c (WaitForSocketEvent): If an TCP_ASYNC_CONNECT
socket errors out, then return EWOULDBLOCK & error out.
* mac/tclMacSock.c (NotifyRoutine): Added a NotifyRoutine for
@@ -1662,20 +1630,20 @@
2000-04-21 Sandeep Tamhankar <sandeep@scriptics.com>
* library/http2.1/http.tcl: Fixed a newly introduced bug where if
- there's a -command callback and something goes wrong, geturl threw
- an exception, called the callback, and unset the token. I changed
- it so that it will not call the callback when throwing an
- exception (so the caller only finds out about a given error from
- one place). Also, fixed http::ncode so that it actually gives you
- back the http return code (i.e. 200, 404, etc.) instead of the
- first digit of the version of HTTP being used (i.e. 1).
+ there's a -command callback and something goes wrong, geturl threw an
+ exception, called the callback, and unset the token. I changed it so
+ that it will not call the callback when throwing an exception (so the
+ caller only finds out about a given error from one place). Also,
+ fixed http::ncode so that it actually gives you back the http return
+ code (i.e. 200, 404, etc.) instead of the first digit of the version
+ of HTTP being used (i.e. 1).
2000-04-21 Brent Welch <welch@scriptics.com>
* library/http2.1/http.tcl: More thrashing with the "server closes
- without reading post data" scenario. Reverted to the previous
- filevent configuratiuon, which seems to work better with small
- amounts of post data.
+ without reading post data" scenario. Reverted to the previous filevent
+ configuratiuon, which seems to work better with small amounts of post
+ data.
2000-04-20 Jeff Hobbs <hobbs@scriptics.com>
@@ -1688,15 +1656,15 @@
* library/dde1.1/pkgIndex.tcl:
* library/reg1.0/pkgIndex.tcl:
* win/tclWinChan.c:
- * win/tclWinThrd.c: converted CRLF to LF the */tcl.hpj.in files
- were not converted, as it confuses hcw locally. [Bug: 5096]
+ * win/tclWinThrd.c: converted CRLF to LF the */tcl.hpj.in files were
+ not converted, as it confuses hcw locally. [Bug: 5096]
* win/Makefile.in: expanded cleanup target for help files
* doc/Thread.3: minor macro cleanup
- * generic/tclFileName.c (SplitUnixPath): added support for QNX
- node ids.
+ * generic/tclFileName.c (SplitUnixPath): added support for QNX node
+ ids.
2000-04-18 Jeff Hobbs <hobbs@scriptics.com>
@@ -1716,9 +1684,8 @@
* unix/Makefile.in: added install-strip target; bindir, libdir,
mandir, includedir vars; tclLoadDyld.c target [Bug: 2527]
- * unix/tclUnixChan.c (CreateSocket): force a socket back into
- blocking mode (default state) after a -async connect succeeds.
- [Bug: 4388]
+ * unix/tclUnixChan.c (CreateSocket): force a socket back into blocking
+ mode (default state) after a -async connect succeeds. [Bug: 4388]
* generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to
thread-local storage to prevent thread-related race condition.
@@ -1732,23 +1699,23 @@
* win/Makefile.in:
* win/tcl.rc:
* win/tclsh.rc:
- * win/tclsh.ico: Modified copyright dates in Windows resource
- files. Added an icon for tclsh.exe.
+ * win/tclsh.ico: Modified copyright dates in Windows resource files.
+ Added an icon for tclsh.exe.
2000-04-17 Brent Welch <welch@scriptics.com>
* generic/tcl.h, generic/tclThreadTest.c, unix/tclUnixThrd.c,
- win/tclWinThread.c, mac/tclMacThread.c:
- Added Tcl_CreateThreadType and TCL_RETURN_THREAD_TYPE
- macros for declaring the NewThread callback proc.
+ * win/tclWinThread.c, mac/tclMacThread.c: Added Tcl_CreateThreadType
+ and TCL_RETURN_THREAD_TYPE macros for declaring the NewThread callback
+ proc.
2000-04-14 Jeff Hobbs <hobbs@scriptics.com>
* unix/tclUnixChan.c (TtyParseMode): Only allow setting mark/space
parity on platforms that support it [Bug: 5089]
- * generic/tclBasic.c (Tcl_GetVersion): adjusted use of major/minor
- to not conflict with global decl on some systems [Bug: 2882]
+ * generic/tclBasic.c (Tcl_GetVersion): adjusted use of major/minor to
+ not conflict with global decl on some systems [Bug: 2882]
* doc/AppInit.3:
* doc/Async.3:
@@ -1798,17 +1765,17 @@
* generic/tcl.h: Fixed Tcl_CreateThread declaration.
* library/tcltest1.0/tcltest.tcl: Fixed the "mainThread"
initialization to work with either testthread or the thread extension
- * unix/tclUnixThrd.c: Fixed compiler warning when compiling
- with -DTCL_THREADS
+ * unix/tclUnixThrd.c: Fixed compiler warning when compiling with
+ -DTCL_THREADS
2000-04-10 Eric Melski <ericm@scriptics.com>
- * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of
- contents string from UTF to native encoding [Bug: 4030].
+ * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of contents
+ string from UTF to native encoding [Bug: 4030].
* tests/regexp.test: Added tests for infinite looping in [regexp
-all].
-
+
* generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
[Bug: 4981].
@@ -1817,14 +1784,13 @@
2000-04-09 Brent Welch <welch@scriptics.com>
- * lib/httpd2.1/http.tcl: Worked on the "server closes before
- reading post data" case, which unfortunately causes different
- error cases on Solaris, which can read the reply, and Linux
- and Windows, which cannot read anything. This is all in the
- loop-back case - client and server on the same host. Also
- unified the error handling so the "ioerror" status goes away
- and errors are reflected in a more uniform way. Updated the
- man page to document the behavior.
+ * lib/httpd2.1/http.tcl: Worked on the "server closes before reading
+ post data" case, which unfortunately causes different error cases on
+ Solaris, which can read the reply, and Linux and Windows, which cannot
+ read anything. This is all in the loop-back case - client and server
+ on the same host. Also unified the error handling so the "ioerror"
+ status goes away and errors are reflected in a more uniform way.
+ Updated the man page to document the behavior.
2000-04-09 Jeff Hobbs <hobbs@scriptics.com>
@@ -1834,70 +1800,68 @@
* generic/tclBasic.c (Tcl_SetCommandInfo): comment fix
* unix/tclUnixThrd.c (Tcl_CreateThread): moved TCL_THREADS ifdef
- inside of func as it is declared for non-threads builds as well.
- In the non-threads case, it always returns TCL_ERROR (couldn't
- create thread).
+ inside of func as it is declared for non-threads builds as well. In
+ the non-threads case, it always returns TCL_ERROR (couldn't create
+ thread).
2000-04-08 Andreas Kupries <a.kupries@westend.com>
* Overall change: Definition of a public API for the creation of
- new threads.
+ new threads.
* generic/tclInt.h (line 1802f): Removed the definition of
'TclpThreadCreate'. (line 793f) Removed the definition of
'Tcl_ThreadCreateProc'.
* generic/tcl.h (line 388f): Readded the definition of
- 'Tcl_ThreadCreateProc'. Added Win32 stuff send in by David
- Graveraux <davygrvy@bigfoot.com> to that too (__stdcall,
- ...). Added macros for the default stacksize and allowed flags.
+ 'Tcl_ThreadCreateProc'. Added Win32 stuff send in by David Graveraux
+ <davygrvy@bigfoot.com> to that too (__stdcall, ...). Added macros for
+ the default stacksize and allowed flags.
* generic/tcl.decls (line 1356f): Added definition of
- 'Tcl_CreateThread', slot 393 of the stub table. Two new
- arguments in the public API, for stacksize and flags.
+ 'Tcl_CreateThread', slot 393 of the stub table. Two new arguments in
+ the public API, for stacksize and flags.
* win/tclWinThrd.c:
* mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread,
- added handling of the stacksize. Flags are currently ignored.
+ added handling of the stacksize. Flags are currently ignored.
- * unix/tclUnixThrd.c: See above, but handles joinable
- flag. Ignores the specified stacksize if the macro
- HAVE_PTHREAD_ATTR_SETSTACKSIZE is not defined.
+ * unix/tclUnixThrd.c: See above, but handles joinable flag. Ignores
+ the specified stacksize if the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE is
+ not defined.
* generic/tclThreadTest.c (line 363): See below.
- * unix/tclUnixNotfy.c (line 210): Adapted to the changes
- above. Uses default stacksize and no flags now.
+ * unix/tclUnixNotfy.c (line 210): Adapted to the changes above. Uses
+ default stacksize and no flags now.
* unic/tcl.m4 (line 382f): Added a check for
- 'pthread_attr_setstacksize' to detect platforms not implementing
- this feature of pthreads. If it is implemented, configure will
- define the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE (See
- unix/tclUnixThrd.c too).
+ 'pthread_attr_setstacksize' to detect platforms not implementing this
+ feature of pthreads. If it is implemented, configure will define the
+ macro HAVE_PTHREAD_ATTR_SETSTACKSIZE (See unix/tclUnixThrd.c too).
- * doc/Thread.3: Added Tcl_CreateThread and its arguments to the
- list of described functions. Removed stuff about not providing a
- public C-API for thread-creation.
+ * doc/Thread.3: Added Tcl_CreateThread and its arguments to the list
+ of described functions. Removed stuff about not providing a public
+ C-API for thread-creation.
2000-04-07 Jeff Hobbs <hobbs@scriptics.com>
- * doc/binary.n: clarified docs on sign extension in binary scan
- [Bug: 3466]
+ * doc/binary.n: clarified docs on sign extension in binary scan [Bug:
+ 3466]
* library/tcltest1.0/tcltest.tcl (initConstraints): removed win32s
references (no longer supported)
- * tests/fCmd.test: marked test 8.1 knownBug because it is
- dangerous on poorly configured systems [Bug: 3881]
- and added 8.2 to keep essence of 8.1 tested.
+ * tests/fCmd.test: marked test 8.1 knownBug because it is dangerous on
+ poorly configured systems [Bug: 3881] and added 8.2 to keep essence of
+ 8.1 tested.
2000-04-05 Andreas Kupries <a.kupries@westend.com>
- * generic/tclIO.c (Tcl_UnstackChannel, line 1831): Forcing
- interest mask to the correct value after an unstack and
- re-initialization of the notifier via the watchProc. Without this
- the first fileevent after an unstack will come through and be
- processed, but no more. [Bug: ??].
+ * generic/tclIO.c (Tcl_UnstackChannel, line 1831): Forcing interest
+ mask to the correct value after an unstack and re-initialization of
+ the notifier via the watchProc. Without this the first fileevent after
+ an unstack will come through and be processed, but no more. [Bug: ??].
2000-03-04 Brent Welch <welch@scriptics.com>
@@ -1909,18 +1873,18 @@
2000-03-29 Sandeep Tamhankar <sandeep@scriptics.com>
- * library/http2.1/http.tcl: For the -querychannel option,
- fconfigure the socket to be binary so that we don't translate
- anything while reading the data. This is because we determine the
- content length of the data on the channel by using seek (to the end
- of the file) and tell on the file handle, and we need the
- content-length to match the amount of data actually sent, and
- translation can affect the number of bytes posted.
+ * library/http2.1/http.tcl: For the -querychannel option, fconfigure
+ the socket to be binary so that we don't translate anything while
+ reading the data. This is because we determine the content length of
+ the data on the channel by using seek (to the end of the file) and
+ tell on the file handle, and we need the content-length to match the
+ amount of data actually sent, and translation can affect the number of
+ bytes posted.
2000-04-03 Andreas Kupries <a.kupries@westend.com>
- * Overall change: Definition of public API's for the finalization
- of conditions and mutexes. [Bug: 4199].
+ * Overall change: Definition of public API's for the finalization of
+ conditions and mutexes. [Bug: 4199].
* generic/tclInt.h: Removed definitions of TclFinalizeMutex and
TclFinalizeCondition.
@@ -1928,27 +1892,26 @@
* generic/tcl.decls: Added declarations of Tcl_MutexFinalize and
Tcl_ConditionFinalize.
- * generic/tclThread.c: Renamed TclFinalizeMutex to
- Tcl_MutexFinalize. Renamed TclFinalizeCondition to
- Tcl_ConditionFinalize.
+ * generic/tclThread.c: Renamed TclFinalizeMutex to Tcl_MutexFinalize.
+ Renamed TclFinalizeCondition to Tcl_ConditionFinalize.
* generic/tclNotify.c: Changed usage of TclFinalizeMutex to
Tcl_MutexFinalize.
- * unix/tclUnixNotfy.c:
+ * unix/tclUnixNotfy.c:
* generic/tclThreadTest.c: Changed usages of TclFinalizeCondition to
Tcl_ConditionFinalize.
* generic/tcl.h: Added empty macros for Tcl_MutexFinalize and
- Tcl_ConditionFinalize, to be used when the core is compiled
- without threads.
+ Tcl_ConditionFinalize, to be used when the core is compiled without
+ threads.
* doc/Thread.3: Added description the new API's.
2000-04-03 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr
- to prevent itcl info override crash [Bug: 4064]
+ * generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr to
+ prevent itcl info override crash [Bug: 4064]
* tests/foreach.test:
* tests/namespace.test:
@@ -1967,27 +1930,27 @@
2000-04-03 Eric Melski <ericm@scriptics.com>
- * unix/tclUnixFCmd.c (SetGroupAttribute):
- * unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t)
+ * unix/tclUnixFCmd.c (SetGroupAttribute):
+ * unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t)
casts to avoid compiler warnings.
2000-03-31 Eric Melski <ericm@scriptics.com>
* generic/tclGet.c (Tcl_GetDouble): Added additional conditions to
- error test (previously only errno was checked, but the return
- value of strtod() should be checked as well). [Bug: 4118].
+ error test (previously only errno was checked, but the return value of
+ strtod() should be checked as well). [Bug: 4118]
- * tests/exec.test: Added test for proper conversion of UTF data
- when used with "<< $dataWithUTF" on exec's.
+ * tests/exec.test: Added test for proper conversion of UTF data when
+ used with "<< $dataWithUTF" on exec's.
* unix/tclUnixPipe.c (TclpCreateTempFile): Added
- Tcl_UtfToExternalDString call, so that if there is UTF content in
- the string it will be properly converted to the system encoding
- before being written [Bug: 4030].
+ Tcl_UtfToExternalDString call, so that if there is UTF content in the
+ string it will be properly converted to the system encoding before
+ being written [Bug: 4030].
(TclpCreateTempFile): Added a check on the return value of tmpnam;
some systems (Linux, for example) will start to return NULL after
- tmpnam has been called TMP_MAX times; not checking for this can
- have bad results (overwriting temp files, core dumps, etc.)
+ tmpnam has been called TMP_MAX times; not checking for this can have
+ bad results (overwriting temp files, core dumps, etc.)
2000-03-30 Jeff Hobbs <hobbs@scriptics.com>
@@ -2000,8 +1963,8 @@
* win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s
support).
- * win/tclWinReg.c: made use of TclWinGetPlatformId instead of
- getting info again
+ * win/tclWinReg.c: made use of TclWinGetPlatformId instead of getting
+ info again
* win/tclWinPort.h:
* win/Makefile.in:
@@ -2019,16 +1982,15 @@
2000-03-29 Sandeep Tamhankar <sandeep@scriptics.com>
- * library/http2.1/http.tcl: Removed an unnecessary fileevent
- statement from the error processing part of the Write method.
- Also, fixed two potential memory leaks in wait and reset, in which
- the state array wasn't being unset before throwing an exception.
- Prior to this version, Brent checked in a fix to catch a
- fileevent statement that was sometimes causing a stack trace when
- geturl was called with -timeout. I believe Brent's fix is
- necessary because TLS closes bad sockets for secure connections,
- and the fileevent was trying to act on a socket that no longer
- existed.
+ * library/http2.1/http.tcl: Removed an unnecessary fileevent statement
+ from the error processing part of the Write method. Also, fixed two
+ potential memory leaks in wait and reset, in which the state array
+ wasn't being unset before throwing an exception. Prior to this
+ version, Brent checked in a fix to catch a fileevent statement that
+ was sometimes causing a stack trace when geturl was called with
+ -timeout. I believe Brent's fix is necessary because TLS closes bad
+ sockets for secure connections, and the fileevent was trying to act on
+ a socket that no longer existed.
2000-03-27 Jeff Hobbs <hobbs@scriptics.com>
@@ -2036,118 +1998,115 @@
* tests/namespace.test:
* generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the
- export list so only one instance of each export pattern would
- exist in the list.
+ export list so only one instance of each export pattern would exist in
+ the list.
- * generic/tclExecute.c (TclExecuteByteCode): optimized case for
- the empty string in ==/!= comparisons
+ * generic/tclExecute.c (TclExecuteByteCode): optimized case for the
+ empty string in ==/!= comparisons
2000-03-27 Eric Melski <ericm@scriptics.com>
- * unix/tclUnixChan.c: Added (off_t) type casts in lseek() call
- [Bug: 4409].
+ * unix/tclUnixChan.c: Added (off_t) type casts in lseek() call [Bug:
+ 4409].
- * unix/tclLoadAout.c:
- * unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls
- [Bug: 4410].
+ * unix/tclLoadAout.c:
+ * unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls [Bug:
+ 4410].
2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com>
- * library/http2.1/http.tcl: Fixed a bug where string query data
- that was bigger than queryblocksize would get duplicate characters
- at block boundaries.
+ * library/http2.1/http.tcl: Fixed a bug where string query data that
+ was bigger than queryblocksize would get duplicate characters at block
+ boundaries.
2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com>
- * library/http2.1/http.tcl: Fixed bug 4463, where we were getting
- a stack trace if we tried to publish a project to a good host but
- a port where there was no server listening. It turned out the
- problem was a stray fileevent that needed to be cleared. Also,
- fixed a bug where http::code could stack trace if called on a bad
- token (one which didn't represent a successful geturl) by adding
- an http element to the state array in geturl.
+ * library/http2.1/http.tcl: Fixed bug 4463, where we were getting a
+ stack trace if we tried to publish a project to a good host but a port
+ where there was no server listening. It turned out the problem was a
+ stray fileevent that needed to be cleared. Also, fixed a bug where
+ http::code could stack trace if called on a bad token (one which
+ didn't represent a successful geturl) by adding an http element to the
+ state array in geturl.
2000-03-21 Eric Melski <ericm@scriptics.com>
* tests/clock.test: Modified some tests that were not robust with
- respect to the time zone in which they were run and were thus
- failing.
+ respect to the time zone in which they were run and were thus failing.
- * doc/clock.n: Clarified meaning of -gmt with respect to -base
- when used with [clock scan] (-gmt does not affect the
- interpretation of -base).
+ * doc/clock.n: Clarified meaning of -gmt with respect to -base when
+ used with [clock scan] (-gmt does not affect the interpretation of
+ -base).
2000-03-19 Sandeep Tamhankar <sandeep@scriptics.com>
- * library/http2.1/http.tcl: geturl used to throw an exception when
- the connection failed; I accidentally returned a token with the
- error info, breaking backwards compatibility. I changed it back
- to throwing an exception, but unsetting the state array first
- (thus still eliminating the original memory leak problem).
+ * library/http2.1/http.tcl: geturl used to throw an exception when the
+ connection failed; I accidentally returned a token with the error
+ info, breaking backwards compatibility. I changed it back to throwing
+ an exception, but unsetting the state array first (thus still
+ eliminating the original memory leak problem).
2000-03-19 Sandeep Tamhankar <sandeep@scriptics.com>
* library/http2.1/http.tcl: Added -querychannel option and altered
some of Brent's modifications to allow asynchronous posts (via
- -command). Also modified -queryprogress so that it calls the
- query callback as <callback> <token> <total size> <current size>
- to be consistent with -progress. Added -queryblocksize option
- with default 8192 bytes for post blocksize. Fixed a bunch of
- potential memory leaks for the case when geturl receives bad args
- or can't open a socket, etc. Overall, the package really rocks
- now.
+ -command). Also modified -queryprogress so that it calls the query
+ callback as <callback> <token> <total size> <current size> to be
+ consistent with -progress. Added -queryblocksize option with default
+ 8192 bytes for post blocksize. Fixed a bunch of potential memory leaks
+ for the case when geturl receives bad args or can't open a socket,
+ etc. Overall, the package really rocks now.
* doc/http.n: Added -queryblocksize, -querychannel, and
- -queryprogress. Also, changed the description of -blocksize,
- which states that the -progress callback will be called for each
- block, to now qualify that with an "if -progress is specified".
+ -queryprogress. Also, changed the description of -blocksize, which
+ states that the -progress callback will be called for each block, to
+ now qualify that with an "if -progress is specified".
* tests/http.test: Added a querychannel test for synchronous and
asynchronous posts, altered the queryprogress test such that the
- callback conforms to the -progress format. Also, had to use the
- -queryblocksize option to do the post 16K at a time to match
- Brent's expected results (and to test that -queryblocksize works).
+ callback conforms to the -progress format. Also, had to use the
+ -queryblocksize option to do the post 16K at a time to match Brent's
+ expected results (and to test that -queryblocksize works).
2000-03-15 Brent Welch <welch@scriptics.com>
* library/http2.1/http.tcl: Added -queryprogress callback to
- http::geturl and also changed it so that writing the post data
- is event driven if the queryprogress callback or a timeout is given.
- This allows a timeout to occur when writing lots of post data.
- The queryprogress callback is called after each block of query
- data is posted. It has the same signature as the -progress callback.
+ http::geturl and also changed it so that writing the post data is
+ event driven if the queryprogress callback or a timeout is given.
+ This allows a timeout to occur when writing lots of post data. The
+ queryprogress callback is called after each block of query data is
+ posted. It has the same signature as the -progress callback.
2000-03-06 Eric Melski <ericm@scriptics.com>
* library/package.tcl: Applied patch from Bug: 2570; rather than
setting geometry of slave interp to 0x0 when Tk was loaded, it now
- does "wm withdraw .". Both remove the main window from the
- display, but the former caused some internal structures to get
- initialized to zero, which caused crashes with some extensions.
+ does "wm withdraw .". Both remove the main window from the display,
+ but the former caused some internal structures to get initialized to
+ zero, which caused crashes with some extensions.
2000-03-02 Jeff Hobbs <hobbs@scriptics.com>
- * library/package.tcl (tclPkgUnknown): extended to allow
- recognizes changes in the auto_path while sourcing in other
- pkgIndex.tcl files
+ * library/package.tcl (tclPkgUnknown): extended to allow recognizes
+ changes in the auto_path while sourcing in other pkgIndex.tcl files
* doc/FindExec.3: fixed doc for declaration of Tcl_FindExecutable
[Bug: 4275]
- * generic/tclFileName.c (Tcl_TranslateFileName): Applied patch
- from Newman to significantly speedup file split/join on Windows
- (replaces regexp with custom parser). [Bug: 2867]
+ * generic/tclFileName.c (Tcl_TranslateFileName): Applied patch from
+ Newman to significantly speedup file split/join on Windows (replaces
+ regexp with custom parser). [Bug: 2867]
- * win/README.binary: change mailing lists from @consortium.org
- to @scriptics.com [Bug: 4173]
+ * win/README.binary: change mailing lists from @consortium.org to
+ @scriptics.com [Bug: 4173]
2000-02-28 Eric Melski <ericm@scriptics.com>
* tests/clock.test: Added test for ISO bases < 100000
* generic/tclDate.c: (generated on Solaris)
- * generic/tclGetDate.y: Changed condition for deciding if a number
- is an ISO 8601 base from number >= 100000 to numberOfDigits >= 6.
+ * generic/tclGetDate.y: Changed condition for deciding if a number is
+ an ISO 8601 base from number >= 100000 to numberOfDigits >= 6.
Previously it would fail to recognize 000000 as an ISO base.
2000-02-14 Eric Melski <ericm@scriptics.com>
@@ -2166,42 +2125,41 @@
* doc/load.n: added notes about dll load errors on Windows
* unix/README:
- * unix/Makefile.in (dist): removed porting.notes and porting.old
- from distribution and CVS. The information was very outdated. Now
- refer to http://dev.scriptics.com/services/support/platforms.html
+ * unix/Makefile.in (dist): removed porting.notes and porting.old from
+ distribution and CVS. The information was very outdated. Now refer to
+ http://dev.scriptics.com/services/support/platforms.html
* tests/unixInit.test: fixed japanese LANG encoding test [Bug: 3549]
* unix/configure.in:
- * unix/tcl.m4: correct CFLAG_WARNING setting,
- fixed gcc config for AIX,
- added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998]
+ * unix/tcl.m4: correct CFLAG_WARNING setting, fixed gcc config for
+ AIX, added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998]
* win/tclWinLoad.c (TclpLoadFile): improved error message for load
failures, could perhaps be even more intelligent.
2000-02-09 Jim Ingham <jingham@cygnus.com>
- * mac/tclMacSock.c: Don't panic when you get an error closing an async
- socket. This doesn't seem to hurt anything, and we return the error so
+ * mac/tclMacSock.c: Don't panic when you get an error closing an async
+ socket. This doesn't seem to hurt anything, and we return the error so
the caller can do the right thing.
New Files:
* mac/MW_TclHeader.h:
* mac/MW_TclTestHeader.h:
* mac/MW_TclTestHeader.pch:
- * mac/MW_TclAppleScriptHeader.h: More convenient to use .h prefix files
- in the preference panels...
+ * mac/MW_TclAppleScriptHeader.h: More convenient to use .h prefix
+ files in the preference panels...
The above are curtesy of Daniel Steffen (steffen@math.mq.edu.au)
2000-02-08 Eric Melski <ericm@scriptics.com>
* tests/clock.test: Added tests for "next monthname" constructs.
- * generic/tclDate.c:
+ * generic/tclDate.c:
* generic/tclGetDate.y (Message): Added a grammar rule for "next
- monthname" so that we can handle "next january" and similar
- constructs (bug #4146).
+ monthname" so that we can handle "next january" and similar constructs
+ (bug #4146).
2000-02-08 Jeff Hobbs <hobbs@scriptics.com>
@@ -2228,35 +2186,35 @@
* tests/httpold.test: changed test script to source in the httpd
server procs from httpd instead of having its own set.
- * tests/httpd: improved query support in test httpd to handle fix
- in http.tcl. [Bug: 4089 change 2000-02-01]
+ * tests/httpd: improved query support in test httpd to handle fix in
+ http.tcl. [Bug: 4089 change 2000-02-01]
- * unix/README: fixed notes about --enable-shared and add note
- about --disable-shared.
+ * unix/README: fixed notes about --enable-shared and add note about
+ --disable-shared.
2000-02-07 Eric Melski <ericm@scriptics.com>
- * tests/package.test:
- * library/tclIndex:
+ * tests/package.test:
+ * library/tclIndex:
* library/package.tcl: Renamed ::package namespace to ::pkg.
2000-02-03 Eric Melski <ericm@scriptics.com>
* doc/Package.n:
- * doc/packagens.n: Renamed Package.n -> packagens.n because Windows
+ * doc/packagens.n: Renamed Package.n -> packagens.n because Windows
can't deal with case-sensitive names.
2000-02-02 Jeff Hobbs <hobbs@scriptics.com>
* tests/regexp.test: added tests for -all and -inline switches
* doc/regexp.n: added docs for -all and -inline switches
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): added extra comments for
- new -all and -inline switches to regexp command
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): added extra comments for new
+ -all and -inline switches to regexp command
2000-02-01 Eric Melski <ericm@scriptics.com>
- * library/init.tcl: Applied patch from rfe 1734 regarding
- auto_load errors not setting error message and errorInfo properly.
+ * library/init.tcl: Applied patch from rfe 1734 regarding auto_load
+ errors not setting error message and errorInfo properly.
2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
@@ -2271,13 +2229,13 @@
2000-01-31 Eric Melski <ericm@scriptics.com>
- * tests/package.test:
- * library/tclIndex:
- * library/package.tcl: Added ::package namespace and
- ::package::create function.
+ * tests/package.test:
+ * library/tclIndex:
+ * library/package.tcl: Added ::package namespace and ::package::create
+ function.
- * library/init.tcl: Fixed problem with auto_load and determining
- if commands were loaded.
+ * library/init.tcl: Fixed problem with auto_load and determining if
+ commands were loaded.
* library/auto.tcl: "Fixed" issues with $ in files to be auto indexed.
@@ -2289,66 +2247,66 @@
2000-01-28 Eric Melski <ericm@scriptics.com>
- * tests/pkg/magicchar2.tcl:
+ * tests/pkg/magicchar2.tcl:
* tests/autoMkindex.test: Test for auto loader fix (bug #2480).
* library/init.tcl: auto_load was using [info commands $name] to
- determine if a given command was available; if the command name
- had * or [] it, this would fail because info commands uses
- glob-style matching. This is fixed. (Bug #2480).
+ determine if a given command was available; if the command name had *
+ or [] it, this would fail because info commands uses glob-style
+ matching. This is fixed. (Bug #2480).
- * tests/pkg/spacename.tcl:
+ * tests/pkg/spacename.tcl:
* tests/pkgMkIndex.test: Tests for fix for bug #2360.
- * library/package.tcl: Fixed to extract only the first element of
- the list returned by auto_qualify (bug #2360).
+ * library/package.tcl: Fixed to extract only the first element of the
+ list returned by auto_qualify (bug #2360).
- * tests/pkg/magicchar.tcl:
+ * tests/pkg/magicchar.tcl:
* tests/autoMkindex.test: Test for fix for bug #2611.
* library/auto.tcl: Fixed the regular expression that performs $
- escaping before sourcing a file to index. It was erroneously
- adding \ escapes even to $'s that were already escaped,
- effectively "un-escaping" those $'s. (bug #2611).
+ escaping before sourcing a file to index. It was erroneously adding \
+ escapes even to $'s that were already escaped, effectively
+ "un-escaping" those $'s. (bug #2611).
2000-01-27 Eric Melski <ericm@scriptics.com>
- * tests/autoMkindex.test:
- * library/auto.tcl: Applied patch (with slight modification) from
- bug #2701: auto_mkIndex uses platform dependent file paths.
- Added test for fix.
+ * tests/autoMkindex.test:
+ * library/auto.tcl: Applied patch (with slight modification) from bug
+ #2701: auto_mkIndex uses platform dependent file paths. Added test for
+ fix.
2000-01-27 Jennifer Hom <jenn@scriptics.com>
* library/tcltest1.0/tcltest.tcl: Changed NormalizePath to
- normalizePath and exported it as a public proc. This proc
- creates an absolute path given the name of the variable containing
- the path to modify. The path is modified in place.
+ normalizePath and exported it as a public proc. This proc creates an
+ absolute path given the name of the variable containing the path to
+ modify. The path is modified in place.
* library/tcltest1.0/pkgIndex.tcl: Added normalizePath.
* tests/all.tcl: Changed code to use normalizePath.
2000-01-27 Eric Melski <ericm@scriptics.com>
* tests/pkg/samename.tcl: test file for bug #1983
-
- * tests/pkgMkIndex.test:
- * doc/pkgMkIndex.n:
+
+ * tests/pkgMkIndex.test:
+ * doc/pkgMkIndex.n:
* library/package.tcl: Per rfe #4097, optimized creation of direct
- load packages to bypass computing the list of commands added by
- the new package. Also made direct loading the default, and added
- a -lazy option.
+ load packages to bypass computing the list of commands added by the
+ new package. Also made direct loading the default, and added a -lazy
+ option.
Fixed bug #1983, dealing with pkg_mkIndex incorrectly handling
- situations with two procs by the same name but in different
- namespaces (ie, foo::baz and bar::baz).
+ situations with two procs by the same name but in different namespaces
+ (ie, foo::baz and bar::baz).
2000-01-26 Eric Melski <ericm@scriptics.com>
* generic/tclNamesp.c: Undid fix for #956, which broke backwards
compatibility.
- * doc/variable.n:
- * doc/trace.n:
- * doc/namespace.n:
+ * doc/variable.n:
+ * doc/trace.n:
+ * doc/namespace.n:
* doc/info.n: Added further information about differences between
"namespace which" and "info exists".
@@ -2357,18 +2315,18 @@
2000-01-25 Jeff Hobbs <hobbs@scriptics.com>
- * unix/tcl.m4: modified EXTRA_CFLAGS to add -DHAVE_TZSET for
- OSF1-V* and ULTRIX-4.* when not using gcc. Also added higher min
- stack size for OSF1-V* when building with threads. [Bug: 4063]
+ * unix/tcl.m4: modified EXTRA_CFLAGS to add -DHAVE_TZSET for OSF1-V*
+ and ULTRIX-4.* when not using gcc. Also added higher min stack size
+ for OSF1-V* when building with threads. [Bug: 4063]
* generic/tclClock.c (FormatClock): inlined resultPtr, as it
conflicted with var creation for HAVE_TZSET #def [Bug: 4063]
- * generic/tclCmdIL.c (Tcl_LsortObjCmd): fixed potential leak
- when calling lsort -command with bad command [Bug: 4067]
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): fixed potential leak when
+ calling lsort -command with bad command [Bug: 4067]
- * generic/tclFileName.c (Tcl_JoinPath): added support for special
- QNX node id prefixes in pathnames [Bug: 4053]
+ * generic/tclFileName.c (Tcl_JoinPath): added support for special QNX
+ node id prefixes in pathnames [Bug: 4053]
* doc/ListObj.3: clarified Tcl_ListObjGetElements docs [Bug: 4080]
@@ -2378,18 +2336,18 @@
2000-01-23 Jeff Hobbs <hobbs@scriptics.com>
- * library/init.tcl (auto_execok): added 'start' to list of
- recognized built-in commands for COMSPEC on NT. [Bug: 2858]
+ * library/init.tcl (auto_execok): added 'start' to list of recognized
+ built-in commands for COMSPEC on NT. [Bug: 2858]
* unix/tclUnixPort.h: moved include of <utime.h> lower since some
systems (UTS) require sys/types.h to be included first [Bug: 4031]
- * unix/tclUnixChan.c (CreateSocketAddress): changed comparison
- with -1 to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit
- systems. [Bug: 3878]
+ * unix/tclUnixChan.c (CreateSocketAddress): changed comparison with -1
+ to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit systems.
+ [Bug: 3878]
- * generic/tclFileName.c: improved guessing of path separator
- for the Mac. (Darley)
+ * generic/tclFileName.c: improved guessing of path separator for the
+ Mac. (Darley)
* generic/tclInt.h:
* generic/tcl.decls: moved Tcl_ProcObjCmd to stubs table [Bug: 3827]
@@ -2398,7 +2356,7 @@
2000-01-21 Eric Melski <ericm@scriptics.com>
- * unix/mkLinks:
+ * unix/mkLinks:
* doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817).
* doc/lreplace.n: Corrected man page with respect to treatment of
@@ -2412,24 +2370,24 @@
* generic/tclNamesp.c: Added check for undefined variables in
NamespaceWhichCmd (bug #956).
- * tests/var.test: Added tests for corrected variable behavior
- (bug #981).
+ * tests/var.test: Added tests for corrected variable behavior (bug
+ #981).
* doc/upvar.n: Expanded explanation of upvar behavior with respect to
- variable traces. (bugs 3917 1433 2110).
+ variable traces. (bugs 3917 1433 2110).
* generic/tclVar.c: Changed behavior of variable command when name
refers to an element in an array (ie, "variable foo(x)") to always
- return an error, regardless of existance of that element in the
- array (now behavior is consistant with docs too) (bug #981).
+ return an error, regardless of existance of that element in the array
+ (now behavior is consistant with docs too) (bug #981).
2000-01-20 Jeff Hobbs <hobbs@scriptics.com>
- * generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a
- string if the body has been bytecompiled.
+ * generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a string
+ if the body has been bytecompiled.
* generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for
- originating proc body of bytecompiled code, #def'd out as the
- change for [info body] should make it unnecessary
+ originating proc body of bytecompiled code, #def'd out as the change
+ for [info body] should make it unnecessary
* unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr
@@ -2442,20 +2400,19 @@
* doc/vwait.n: added notes about requirement for vwait var being
globally scoped [Bug: 3329]
- * library/word.tcl: changed tcl_(non)wordchars settings to use
- new unicode regexp char class escapes instead of char sequences
+ * library/word.tcl: changed tcl_(non)wordchars settings to use new
+ unicode regexp char class escapes instead of char sequences
2000-01-14 Eric Melski <ericm@scriptics.com>
* tests/var.test: Added a test for the array multiple delete
protection in Tcl_UnsetVar2.
- * generic/tclVar.c: Added protection in Tcl_UnsetVar2 against
- attempts to multiply delete arrays when unsetting them (bug
- #3453). This could happen if there was an unset trace on an array
- element and the trace proc made a global or upvar link to the
- array, and then the array was unset at the global level. See the
- bug reference for more information.
+ * generic/tclVar.c: Added protection in Tcl_UnsetVar2 against attempts
+ to multiply delete arrays when unsetting them (bug #3453). This could
+ happen if there was an unset trace on an array element and the trace
+ proc made a global or upvar link to the array, and then the array was
+ unset at the global level. See the bug reference for more information.
* unix/tclUnixTime.c: New clock format format.
@@ -2480,14 +2437,14 @@
2000-01-13 Eric Melski <ericm@scriptics.com>
- * tests/cmdIL.test: Added tests for lsort -dictionary with
- characters that occur between Z and a in ASCII.
+ * tests/cmdIL.test: Added tests for lsort -dictionary with characters
+ that occur between Z and a in ASCII.
* generic/tclCmdIL.c: Modified DictionaryCompare function (used by
lsort -dictionary) to do upper/lower case equivalency before doing
- character comparisons, instead of after. This fixes bug #1357, in
- which lsort -dictionary [list ` AA c CC] and lsort -dictionary
- [list AA c ` CC] gave different (and both wrong) results.
+ character comparisons, instead of after. This fixes bug #1357, in
+ which lsort -dictionary [list ` AA c CC] and lsort -dictionary [list
+ AA c ` CC] gave different (and both wrong) results.
2000-01-12 Eric Melski <ericm@scriptics.com>
@@ -2497,23 +2454,22 @@
* doc/tests/clock.test: Added numerous tests for clock scan.
- * doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in
- clock grammar.
+ * doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in clock
+ grammar.
- * doc/doc/clock.n: Added documentation for new supported clock
- scan formats and additional explanation of daylight savings time
- correction algorithm.
+ * doc/doc/clock.n: Added documentation for new supported clock scan
+ formats and additional explanation of daylight savings time correction
+ algorithm.
2000-01-12 Jeff Hobbs <hobbs@scriptics.com>
* doc/file.n:
* tests/unixFCmd.test:
- * unix/tclUnixFCmd.c: added support for symbolic permissions
- setting in SetPermissionsAttribute (file attr $file -perm ...)
- [Bug: 3970]
+ * unix/tclUnixFCmd.c: added support for symbolic permissions setting
+ in SetPermissionsAttribute (file attr $file -perm ...) [Bug: 3970]
- * generic/tclClock.c: fixed support for 64bit handling of clock
- values [Bug: 1806]
+ * generic/tclClock.c: fixed support for 64bit handling of clock values
+ [Bug: 1806]
* generic/tclThreadTest.c: upped a buffer size to hold double
@@ -2526,20 +2482,20 @@
* tests/expr.test:
* unix/Makefile.in:
* unix/configure.in:
- * unix/tcl.m4: recognize strtod bug on Tru64 v5.0 [Bug: 3378]
- and added tests to prevent unnecessary chmod +x in sources while
+ * unix/tcl.m4: recognize strtod bug on Tru64 v5.0 [Bug: 3378] and
+ added tests to prevent unnecessary chmod +x in sources while
installing, as well as more intelligent setsockopt/gethostbyname
checks [Bug: 3366, 3389]
- * unix/tclUnixThrd.c: added compile time support (through use of
- the TCL_THREAD_STACK_MIN define) for increasing the default stack
- size for a thread. [Bug: 3797, 1966]
+ * unix/tclUnixThrd.c: added compile time support (through use of the
+ TCL_THREAD_STACK_MIN define) for increasing the default stack size for
+ a thread. [Bug: 3797, 1966]
2000-01-11 Eric Melski <ericm@scriptics.com>
- * generic/tclGetDate.y: Added comments for the Convert function.
- Added a fix for daylight savings time handling for relative time
- spans of days, weeks or fortnights. (bug 3441, 3868).
+ * generic/tclGetDate.y: Added comments for the Convert function. Added
+ a fix for daylight savings time handling for relative time spans of
+ days, weeks or fortnights. (bug 3441, 3868).
* generic/tclDate.c: Fixed compiler warning issues.
@@ -2548,8 +2504,8 @@
* compat/waitpid.c: use pid_t type instead of int [Bug: 3999]
* tests/utf.test: fixed test that allowed \8 as octal value
- * generic/tclUtf.c: changed Tcl_UtfBackslash to not allow
- non-octal digits (8,9) in \ooo substs. [Bug: 3975]
+ * generic/tclUtf.c: changed Tcl_UtfBackslash to not allow non-octal
+ digits (8,9) in \ooo substs. [Bug: 3975]
* generic/tcl.h: noted need to change win/tcl.m4 and
tools/tclSplash.bmp for minor version changes
@@ -2579,5 +2535,5 @@
2000-01-07 Eric Melski <ericm@scriptics.com>
* generic/tclClock.c: Changed switch in Tcl_ClockObjCmd to use
- enumerated values instead of constants. (ie, COMMAND_SCAN instead
- of 3).
+ enumerated values instead of constants. (ie, COMMAND_SCAN instead of
+ 3).
diff --git a/ChangeLog.2001 b/ChangeLog.2001
index 2c8b4d7..06e7c36 100644
--- a/ChangeLog.2001
+++ b/ChangeLog.2001
@@ -1,20 +1,20 @@
2001-12-28 Jeff Hobbs <jeffh@ActiveState.com>
- * library/init.tcl: make sure env(COMSPEC) on Windows is executed
- with the right case, as it may otherwise fail inexplicably.
+ * library/init.tcl: make sure env(COMSPEC) on Windows is executed with
+ the right case, as it may otherwise fail inexplicably.
2001-12-28 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem):
- Added the [memory onexit] command, intended to replace [checkmem].
+ * generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem): Added
+ the [memory onexit] command, intended to replace [checkmem].
- * doc/DumpActiveMemory.3:
+ * doc/DumpActiveMemory.3:
* doc/memory.n: Updated documentation for [memory] and related
- matters. [Bug 487677]
+ matters. [Bug 487677]
* mac/tclMacBOAMain.c (Tcl_Main, CheckmemCmd): Removed all the
- machinery for the [checkmem] command that is completely duplicated
- by code in generic/tclCkalloc.c.
+ machinery for the [checkmem] command that is completely duplicated by
+ code in generic/tclCkalloc.c.
* generic/tclBinary.c:
* generic/tclListObj.c:
@@ -27,12 +27,11 @@
* mac/tclMacInit.c:
* mac/tclMacTclCode.r: synced up tclInit features to unix/win:
- implemented TclSetPreInitScript support, use of existing tclInit
- proc if defined, check of default encoding dir if set. Changed
- script library resource names to lowercase (i.e. same as
- corresponding files). Used Tcl_JoinPath instead of string append.
- Check that system encoding could be loaded before utf translating
- the LibraryPath.
+ implemented TclSetPreInitScript support, use of existing tclInit proc
+ if defined, check of default encoding dir if set. Changed script
+ library resource names to lowercase (i.e. same as corresponding
+ files). Used Tcl_JoinPath instead of string append. Check that system
+ encoding could be loaded before utf translating the LibraryPath.
* mac/tclMacApplication.r:
* mac/tclMacLibrary.r:
* mac/tclMacOSA.r:
@@ -41,147 +40,138 @@
2001-12-21 Mo DeJong <mdejong@users.sourceforge.net>
* unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
- Search for config file using exec_prefix instead of
- prefix when no --with-tcl or --with-tk argument is used. [Bug 492418]
+ Search for config file using exec_prefix instead of prefix when no
+ --with-tcl or --with-tk argument is used. [Bug 492418]
2001-12-21 Daniel Steffen <das@users.sourceforge.net>
- * unix/tcl.m4: fixed incorrect SHLIB_LD_LIBS
- setting for MacOSX / Darwin.
+ * unix/tcl.m4: fixed incorrect SHLIB_LD_LIBS setting for MacOSX /
+ Darwin.
* unix/configure: Regen.
- * unix/mkLinks.tcl: improved case-insensitive
- filesystem support.
+ * unix/mkLinks.tcl: improved case-insensitive filesystem support.
* unix/mkLinks: Regen.
2001-12-19 Don Porter <dgp@users.sourceforge.net>
- * unix/Makefile.in (dist): corrected use of eolFix.tcl on
- working files. It should operate on distributed files. [Bug 495120]
+ * unix/Makefile.in (dist): corrected use of eolFix.tcl on working
+ files. It should operate on distributed files. [Bug 495120]
2001-12-19 David Gravereaux <davygrvy@pobox.com>
- * tools/tcl.wse.in: Fix for #495120. tcl.wse.in was
- stored in cvs with improper <eol>. This resulted in
- corrupted <eol> when checked-out on translating CVS
- clients such as windows (CRCRLF) and mac (CRCR).
+ * tools/tcl.wse.in: Fix for [Bug 495120]. tcl.wse.in was stored in cvs
+ with improper <eol>. This resulted in corrupted <eol> when checked-out
+ on translating CVS clients such as windows (CRCRLF) and mac (CRCR).
2001-12-19 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure:
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Update
- SunOS 5.[0-6] target so that correct linker
- options are passed to gcc or ld. [Tk Bug 220863]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Update SunOS 5.[0-6] target so that
+ correct linker options are passed to gcc or ld. [Tk Bug 220863]
2001-12-19 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/README: Update to account for changes
- in the unix/dltest directory, the way autoconf
- is run, and the new "make shell" target.
+ * unix/README: Update to account for changes in the unix/dltest
+ directory, the way autoconf is run, and the new "make shell" target.
2001-12-19 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Rename dltest to dlpkgs to
- fix problem where lib files were not getting
- built because dltest/ directory already existed.
+ * unix/Makefile.in: Rename dltest to dlpkgs to fix problem where lib
+ files were not getting built because dltest/ directory already
+ existed.
2001-12-19 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinSerial.c (SerialCheckProc): corrected time
- calculations to be unsigned. (schroedter)
+ * win/tclWinSerial.c (SerialCheckProc): corrected time calculations to
+ be unsigned. (schroedter)
2001-12-18 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Define new dltest target that
- simply does a cd to dltest/ before running make.
- There is no need for the separate configure
- script that was previously being used.
+ * unix/Makefile.in: Define new dltest target that simply does a cd to
+ dltest/ before running make. There is no need for the separate
+ configure script that was previously being used.
* unix/configure: Regen.
* unix/configure.in: Subst into dltest/Makefile.
- * unix/dltest/Makefile.in: Define LIBS using
- DL_LIBS, LIBS, and MATH_LIBS variables instead
- of TCL_LIBS variable from tclConfig.sh.
- * unix/dltest/README: Update readme to account for new
- configure free implementation.
+ * unix/dltest/Makefile.in: Define LIBS using DL_LIBS, LIBS, and
+ MATH_LIBS variables instead of TCL_LIBS variable from tclConfig.sh.
+ * unix/dltest/README: Update readme to account for new configure free
+ implementation.
* unix/dltest/configure: Removed.
* unix/dltest/configure.in: Removed.
2001-12-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tcl.h (TCL_STUB_MAGIC): Added cast to force type to be
- an int and get rid of a persistent and pointless warning with
- SunPro compiler.
+ * generic/tcl.h (TCL_STUB_MAGIC): Added cast to force type to be an
+ int and get rid of a persistent and pointless warning with SunPro
+ compiler.
- * generic/tclCkalloc.c (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc):
+ * generic/tclCkalloc.c (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc):
* generic/tcl.decls (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc):
- Made the file parameters to these functions into CONST char *,
- like they always should have been to match the other Tcl*Db* API
- functions.
+ Made the file parameters to these functions into CONST char *, like
+ they always should have been to match the other Tcl*Db* API functions.
-2001-12-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-12-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * Applied #219311 on behalf of Rolf Schroedter
- <schroedter@users.sourceforge.net> to prevent fcopy on serial
- ports from flooding the event queue.
+ * Applied [Bug 219311] on behalf of Rolf Schroedter
+ <schroedter@users.sourceforge.net> to prevent fcopy on serial ports
+ from flooding the event queue.
2001-12-11 Miguel Sofer <msofer@users.sourceforge.net>
* doc/CrtInterp.3:
- * generic/tclBasic.c: docs and comments corrections [Bug 493412]
- Bug & patch by Don Porter.
+ * generic/tclBasic.c: docs and comments corrections. [Bug 493412]
+ Bug & patch by Don Porter.
2001-12-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinNotify.c (Tcl_FinalizeNotifier): Stop Tcl on Windows
- from crashing when shutdown from a non-Tcl thread. Fixes Bug
- #217982 [orig. 5804] reported by Hugh Vu and Gene Leache. I'm
- not convinced that the shutdown process is right even with this,
- but it was definitely wrong without...
+ * win/tclWinNotify.c (Tcl_FinalizeNotifier): Stop Tcl on Windows from
+ crashing when shutdown from a non-Tcl thread. Fixes [Bug 217982]
+ [orig. 5804] reported by Hugh Vu and Gene Leache. I'm not convinced
+ that the shutdown process is right even with this, but it was
+ definitely wrong without...
-2001-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/tclWinSock.c (TcpGetOptionProc): Fix for tcl bug item
- #478565 reported by an unknown person. Bypasses all calls to
- "gethostbyaddr" for address "0.0.0.0" to prevent delays on
- Win/NT.
+ * win/tclWinSock.c (TcpGetOptionProc): Fix for [Bug 478565] reported
+ by an unknown person. Bypasses all calls to "gethostbyaddr" for
+ address "0.0.0.0" to prevent delays on Win/NT.
2001-12-12 Jeff Hobbs <jeffh@ActiveState.com>
- * doc/Preserve.3: doc'd TCL_DYNAMIC use. [Patch #483989] (porter)
+ * doc/Preserve.3: doc'd TCL_DYNAMIC use. [Patch 483989] (porter)
-2001-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIO.c (Tcl_GetsObj): Applied patch for bug #491341 as
- provided by Don Porter <dgp@users.sourceforge.net>. Fixes the
- assumption of having an empty Tcl_Obj to work with.
+ * generic/tclIO.c (Tcl_GetsObj): Applied patch for [Bug 491341] as
+ provided by Don Porter <dgp@users.sourceforge.net>. Fixes the
+ assumption of having an empty Tcl_Obj to work with.
2001-12-11 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCompCmds.c:
* generic/tclCompile.c:
- * generic/tclExecute.c: consistency patch, to make all
- instructions that pop a variable number of Tcl_Obj's off the
- execution stack take the number of popped objects as first
- operand. Modified *only* the new instructions
- INST_LIST_INDEX_MULTI and INST_LSET_FLAT, so this has no effect
- on bytecodes generated up to tcl8.4a3 inclusive.
+ * generic/tclExecute.c: consistency patch, to make all instructions
+ that pop a variable number of Tcl_Obj's off the execution stack take
+ the number of popped objects as first operand. Modified *only* the new
+ instructions INST_LIST_INDEX_MULTI and INST_LSET_FLAT, so this has no
+ effect on bytecodes generated up to tcl8.4a3 inclusive.
- * generic/tclExecute.c: fix debug messages in INST_LSET_LIST.
+ * generic/tclExecute.c: fix debug messages in INST_LSET_LIST.
* generic/tclCompCmds.c (TclCompileLindexCmd):
- * generic/tclCompExpr.c (CompileMathFuncCall): removed the last
- two overestimates of the necessary stack depth for bytecodes in
- the fix of [Bug 483611].
+ * generic/tclCompExpr.c (CompileMathFuncCall): removed the last two
+ overestimates of the necessary stack depth for bytecodes in the fix of
+ [Bug 483611]
-2001-12-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-12-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * unix/tclUnixPipe.c (TclpCreateProcess): Applied Don Porter's
- patch fixing bug #437489.
+ * unix/tclUnixPipe.c (TclpCreateProcess): Applied Don Porter's patch
+ fixing [Bug 437489].
2001-12-10 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclEvent.c:
- * tests/event.test: fix background error reporting in the absence
- of a bgerror proc [Bug 219142].
+ * tests/event.test: fix background error reporting in the absence of a
+ bgerror proc [Bug 219142].
2001-12-10 Don Porter <dgp@users.sourceforge.net>
@@ -198,7 +188,7 @@
* doc/Utf.3:
* doc/file.n:
* doc/tclsh.1: Several typo and formatting corrections discovered
- during conversion to TMML. Thanks to Joe English. [Patch 490514]
+ during conversion to TMML. Thanks to Joe English. [Patch 490514]
* unix/mkLinks: 'make mklinks'
2001-12-10 Miguel Sofer <msofer@users.sourceforge.net>
@@ -208,14 +198,14 @@
* generic/tclCompile.c:
* generic/tclCompile.h:
* generic/tclExecute.c:
- * generic/tclProc.c: fixed the calculation of the maximal stack
- depth required by bytecodes [Bug 483611].
+ * generic/tclProc.c: fixed the calculation of the maximal stack depth
+ required by bytecodes. [Bug 483611]
2001-12-07 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c:
+ * generic/tclVar.c:
* tests/trace.test: restored consistency in refCount accounting by
- array traces [Bug #4484339], submitted by Don Porter.
+ array traces [Bug 4484339], submitted by Don Porter.
2001-12-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -225,19 +215,19 @@
* generic/tclParseExpr.c (ParsePrimaryExpr): Rewrote to give even
better syntax errors in the fairly common case of an identifier
without decorations by guessing based on the currently available
- functions. Also made messages consistent between memdebug and
- ordinary builds.
+ functions. Also made messages consistent between memdebug and ordinary
+ builds.
2001-12-05 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c:
- * tests/trace.test: new algorithm for [array get], safe when there
- are traces that modify the array [Bug #449893].
+ * generic/tclVar.c:
+ * tests/trace.test: new algorithm for [array get], safe when there are
+ traces that modify the array. [Bug 449893]
2001-12-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/compExpr-old.test, tests/compExpr.test, tests/compile.test:
- * tests/expr-old.test, tests/expr.test, tests/for.test:
+ * tests/compExpr-old.test, tests/compExpr.test, tests/compile.test:
+ * tests/expr-old.test, tests/expr.test, tests/for.test:
* tests/while.test, tests/if.test: Rewrite to handle more specific
syntax errors.
* tests/parseExpr.test: Rewrite to get rid of dup test numbers and
@@ -246,26 +236,25 @@
argument to help explain what the syntax error is.
(Tcl_ParseExpr, ParseCondExpr, ParsePrimaryExpr): Added detail
messages.
- (UNKNOWN_CHAR): New lexeme for characters that are always illegal
- in expressions outside strings.
+ (UNKNOWN_CHAR): New lexeme for characters that are always illegal in
+ expressions outside strings.
2001-12-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/expr.n: Various documentation improvements in relation to
- the function calls. Includes fix for Bug #487704 submitted by
- Devin Eyre.
+ * doc/expr.n: Various documentation improvements in relation to the
+ function calls. Includes fix for [Bug 487704] submitted by Devin Eyre.
2001-12-03 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc: Some install target bugs repaired along with
$(TCLSTUBLIB) added to the dependencies rather than implicit through
- the dde and reg extensions which don't happen to always require it
- for some build types.
+ the dde and reg extensions which don't happen to always require it for
+ some build types.
2001-11-30 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c: Tcl_Preserve'ing VarTrace structures to avoid
- memory corruption. Patch for [Bug: 484334] provided by Don Porter
+ * generic/tclVar.c: Tcl_Preserve'ing VarTrace structures to avoid
+ memory corruption. Patch for [Bug 484334] provided by Don Porter
2001-11-29 Miguel Sofer <msofer@users.sourceforge.net>
@@ -275,16 +264,15 @@
2001-11-29 Miguel Sofer <msofer@users.sourceforge.net>
* tests/namespace.test: added namespace-41.2, a simpler test for
- [Bug: 231259]
+ [Bug 231259]
2001-11-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclBinary.c (BINARY_SCAN_MAX_CACHE, Tcl_BinaryObjCmd,
- ScanNumber): Added caching scheme to reduce number of object
- allocations when doing scans of large repetitive binary strings.
- See comments in file for reasoning behind implementation.
- Suggested by Miguel Sofer in Patch #429916, but independently
- implemented.
+ (ScanNumber): Added caching scheme to reduce number of object
+ allocations when doing scans of large repetitive binary strings. See
+ comments in file for reasoning behind implementation. Suggested by
+ Miguel Sofer in [Patch 429916], but independently implemented.
2001-11-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -293,8 +281,8 @@
2001-11-27 D. Richard Hipp <drh@hwaci.com>
- * win/tclWinFCmd.c: Fix a coredump in the filename normalizer
- code for Win95/98.
+ * win/tclWinFCmd.c: Fix a coredump in the filename normalizer code for
+ Win95/98.
2001-11-27 David Gravereaux <davygrvy@pobox.com>
@@ -305,37 +293,36 @@
2001-11-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/cmdAH.test (cmdAH-24.2): Made test less sensitive to OS
- preemption, but perfection isn't practical [Bug 463189, reported
- by Don Porter.]
+ preemption, but perfection isn't practical. [Bug 463189, reported by
+ Don Porter]
- * tests/switch.test (switch-9.*): Added tests to exercise more of
- the argument checking. (switch-7.2,switch-7.3): Test changed
- behaviour slightly.
- * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reworked argument parsing
- to be stricter about what it accepts. This should make uses of
- the [switch] command be more maintainable. [Bug 475397, reported
- by Don Porter.]
+ * tests/switch.test (switch-9.*): Added tests to exercise more of the
+ argument checking. (switch-7.2,switch-7.3): Test changed behaviour
+ slightly.
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reworked argument parsing to
+ be stricter about what it accepts. This should make uses of the
+ [switch] command be more maintainable. [Bug 475397, reported by Don
+ Porter]
2001-11-26 Don Porter <dgp@users.sourceforge.net>
- * generic/tclIntPlatDecls.h: 'make genstubs' after changes
- in 2001-11-23 commit from Daniel Steffen.
+ * generic/tclIntPlatDecls.h: 'make genstubs' after changes in
+ 2001-11-23 commit from Daniel Steffen.
2001-11-24 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Add comments to better describe
- TCL_EXE and when it should be available.
- * win/Makefile.in: Add TCL_EXE variable to be used
- by rules like `make genstubs`. Don't set TCL_LIBRARY
- before running `make genstubs` since we will be running
- with a tclsh from the PATH not the one we build.
+ * unix/Makefile.in: Add comments to better describe TCL_EXE and when
+ it should be available.
+ * win/Makefile.in: Add TCL_EXE variable to be used by rules like `make
+ genstubs`. Don't set TCL_LIBRARY before running `make genstubs` since
+ we will be running with a tclsh from the PATH not the one we build.
2001-11-24 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Add comctl32.lib
- to wish link libs. This change was originally added
- to Tk on 2001-11-09 but was not committed to Tcl.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Add comctl32.lib to wish link libs.
+ This change was originally added to Tk on 2001-11-09 but was not
+ committed to Tcl.
2001-11-23 Daniel Steffen <das@users.sourceforge.net>
@@ -346,17 +333,17 @@
* unix/mkLinks.tcl:
* unix/tclLoadDyld.c:
* unix/tclMtherr.c: Mac OSX support: build system, dynamic code loading
- and support for case-insensitive filesystems in mkLinks (patch #435258)
+ and support for case-insensitive filesystems in mkLinks. [Patch 435258]
2001-11-23 Daniel Steffen <das@users.sourceforge.net>
- Up-port to 8.4 of mac code changes for 8.3.3 & various new
- changes for 8.4, some already backported to 8.3.4 (patch #435658)
+ Up-port to 8.4 of mac code changes for 8.3.3 & various new changes for
+ 8.4, some already backported to 8.3.4. [Patch 435658]
* generic/tclObj.c: added #include to fix missing prototype errors
* generic/tcl.h: MAC_TCL: addition of ConditionalMacros.h and use of
- DLLIMPORT and DLLEXPORT like on other platforms. ( => no longer need
+ DLLIMPORT and DLLEXPORT like on other platforms. ( => no longer need
the .exp files and can remove use of #pragma export that never worked
well)
removed line continuation in #if clause as this breaks the mac
@@ -364,10 +351,10 @@
* mac/tclMacFile.c: fixed bug in permission checking code
- * mac/tclMacLoad.c: corrected utf8 handling, comparison of
- package names to code fragment names changed to only match on the
- length of package name, this allows for fragment names with version
- numbers appended
+ * mac/tclMacLoad.c: corrected utf8 handling, comparison of package
+ names to code fragment names changed to only match on the length of
+ package name, this allows for fragment names with version numbers
+ appended.
* mac/tclMacInt.h:
* generic/tclInt.h:
@@ -402,7 +389,7 @@
platforms, removed use of #pragma export.
* mac/tcltkMacBuildSupport.sea.hqx: new archive of mac build support
- files & suggested build environment directory hierarchy:
+ files & suggested build environment directory hierarchy:
'Building MacTclTk' & 'CW Pro6 changes' readme's.
projects for MoreFiles 1.5.2 static & shared libraries.
project & sources for 'pseudoCarbonSupport', see below.
@@ -430,13 +417,13 @@
Highly experimental "pseudoCarbon" support for Tcl only on OS 8/9:
binaries in "Build:(Carbon):" link against CarbonLib instead of
InterfaceLib, however the actual code has not been carbonized! i.e. it
- will not run on OSX and may not even run properly with CarbonLib.
+ will not run on OSX and may not even run properly with CarbonLib.
This should in principle allow you to build & test OS9 CFM Carbon
- binaries that need to link with Tcl.shlb. On OSX you can use the
+ binaries that need to link with Tcl.shlb. On OSX you can use the
native Tcl.framework, but you have to build a MachO binary as there
is no CFM glue lib for Tcl.framework.
- the library pseudoCarbonSupport.shlb manually loads the symbols
- from InterfaceLib that are not in CarbonLib but are needed by the
+ the library pseudoCarbonSupport.shlb manually loads the symbols from
+ InterfaceLib that are not in CarbonLib but are needed by the
uncarbonized code in Tcl.shlb and TclShell.
* generic/tclMain.c: MAC_TCL: workaround for broken/non-standard isatty
@@ -461,10 +448,10 @@
strings; updated version strings to standard usage; added support for
'(Support Libraries)' subfolder for shared runtime libraries in
unmerged binaries; commented out demo setting of "Tcl Environment
- Variables"; reorganized resources among these files to avoid
- multiple copies in applications and shared libraries, the script
- libraries are now no longer duplicated in Tclsh but are only included
- in the resources of Tcl.shlb.
+ Variables"; reorganized resources among these files to avoid multiple
+ copies in applications and shared libraries, the script libraries are
+ now no longer duplicated in Tclsh but are only included in the
+ resources of Tcl.shlb.
* mac/tclMacChan.c:
* mac/tclMacSock.c: cast for *BlockMode
@@ -497,52 +484,51 @@
* mac/tclMacUnix.c: added missing (Tcl_Obj ***) cast to
Tcl_ListObjGetElements call
- * mac/tclMacAlloc.c: modernized TclpSysAlloc() to use temporary
- memory instead of system heap memory when available (MacOS
- >= 7.5 and possibly earlier, use of system heap has been
- discouraged for a long time and has many disadvantages, e.g. memory
- isn't paged out, and errors can very easily bring the system down);
- fixed crashing bug in TclpSysRealloc() and CleanUpExitProc() where
- memory was being accessed after having been deallocated; fixed
- memory leak in (de)allocation code (for every block ever allocated
- with TclpSysAlloc, a Ptr was leaked), if temporary memory is
- available, don't track allocated memory, instead use
- RecoverHandle() to get Handle from Ptr, otherwise use doubly linked
- list to correctly track memory and free all allocated memory; added
- new option for ConfigureMemory: MEMORY_DONT_USE_TEMPMEM, disables
- use of temporary memory even when it would be available, only
- necessary when writing e.g. a driver (using tcl??); increased
- fraction of application heap reserved for OS routines to 512K
-
- * compat/strftime.c:
+ * mac/tclMacAlloc.c: modernized TclpSysAlloc() to use temporary memory
+ instead of system heap memory when available (MacOS >= 7.5 and
+ possibly earlier, use of system heap has been discouraged for a long
+ time and has many disadvantages, e.g. memory isn't paged out, and
+ errors can very easily bring the system down); fixed crashing bug in
+ TclpSysRealloc() and CleanUpExitProc() where memory was being accessed
+ after having been deallocated; fixed memory leak in (de)allocation
+ code (for every block ever allocated with TclpSysAlloc, a Ptr was
+ leaked), if temporary memory is available, don't track allocated
+ memory, instead use RecoverHandle() to get Handle from Ptr, otherwise
+ use doubly linked list to correctly track memory and free all
+ allocated memory; added new option for ConfigureMemory:
+ MEMORY_DONT_USE_TEMPMEM, disables use of temporary memory even when it
+ would be available, only necessary when writing e.g. a driver (using
+ tcl??); increased fraction of application heap reserved for OS
+ routines to 512K
+
+ * compat/strftime.c:
* mac/tclMacTime.c:
* mac/tclMacPort.h:
- * generic/tclInt.decls:
+ * generic/tclInt.decls:
* generic/tclIntPlatDecls.h:
- * generic/tclStubInit.c: timezone support for mac via
- TclpGetTZName() like on windows, using an inverse timezone table
- adapted from tclDate.c to map gmtoffset in seconds gotten from
- the MacOS APIs to a timezone string, as there is no good way to get
- this info from MacOS. I had to make up some unusual timezones and
- arbitrarily decide on the most standard of the multiple choices
- available for every timezone.
-
- * generic/tclExecute.c: workaround for a MSL bug/misfeature: for
- very small floats, MSL can return errno ERANGE but a
- non-zero value ( < LDBL_MIN however)
-
- * mac/tclMacAppInit.c: support for WASTE text library using
- temporary memory, setting has no effect if WASTE is not used.
-
+ * generic/tclStubInit.c: timezone support for mac via TclpGetTZName()
+ like on windows, using an inverse timezone table adapted from
+ tclDate.c to map gmtoffset in seconds gotten from the MacOS APIs to a
+ timezone string, as there is no good way to get this info from MacOS.
+ I had to make up some unusual timezones and arbitrarily decide on the
+ most standard of the multiple choices available for every timezone.
+
+ * generic/tclExecute.c: workaround for a MSL bug/misfeature: for very
+ small floats, MSL can return errno ERANGE but a non-zero value (<
+ LDBL_MIN however)
+
+ * mac/tclMacAppInit.c: support for WASTE text library using temporary
+ memory, setting has no effect if WASTE is not used.
+
* mac/tclMacPanic.c: removed duplicate code from generic/tclPanic.c
and added that file to projects instead.
* tests/all.tcl: set tcltest::singleProcess 1 as multiple processes
are not available on the mac.
-
- * tests/cmdAH.test: access time not available on the mac, skip the
+
+ * tests/cmdAH.test: access time not available on the mac, skip the
atime touch test
-
+
* tests/appendComp.test:
* tests/cmdMZ.test:
* tests/compile.test:
@@ -550,20 +536,20 @@
* tests/fileName.test:
* tests/lset.test:
* tests/namespace.test:
- * tests/tcltest.test: added missing cleanups/tests/catches that
- caused tests to fail on the mac.
+ * tests/tcltest.test: added missing cleanups/tests/catches that caused
+ tests to fail on the mac.
* doc/tclvars.n: doc bug, env(PWD) should be env(HOME) [Bug 463834]
-
+
2001-11-21 Don Porter <dgp@users.sourceforge.net>
* tests/trace.test (trace-8.8): Corrected test for Bug 219393.
* generic/tclBasic.c (Tcl_DeleteCommandFromToken,CallCommandTraces):
* generic/tclCmdMZ>c (Tcl_UntraceCommand): Added Tcl_Preserve and
- Tcl_Release calls to prevent deletion of CommandTrace structures
- until all callers are done using them, preventing memory corruption.
- [Bug 453805]
+ Tcl_Release calls to prevent deletion of CommandTrace structures until
+ all callers are done using them, preventing memory corruption. [Bug
+ 453805]
2001-11-20 Kevin B. Kenny <kennykb@users.sourceforge.net>
@@ -575,7 +561,7 @@
* generic/tclUtil.c (TclpGetTime):
* generic/tclTest.c (GetTimesCmd):
* generic/tclTimer.c (Tcl_CreateTimerHandler, TimerSetupProc,
- TimerCheckProc, TimerHandlerEventProc):
+ (TimerCheckProc, TimerHandlerEventProc):
* mac/tclMacNotify.c (Tcl_SetTimer):
* mac/tclMacShLib.exp (Tcl_GetTime):
* mac/tclMacTime.c (Tcl_GetTime):
@@ -586,72 +572,72 @@
* win/tclWinNotify.c (Tcl_Sleep):
* win/tclWinTest.c (TestwinclockCmd):
* win/tclWinTime.c (TclpGetSeconds, TclpGetClicks, Tcl_GetTime):
- Changed all uses of TclpGetTime to Tcl_GetTime. Added Tcl_GetTime
- to the Stubs table and the library documentation. Added a
- TclpGetTime in tclUtil.c for backward compatibility of
- extensions. [Patch #483500, TIP#73]
+ Changed all uses of TclpGetTime to Tcl_GetTime. Added Tcl_GetTime to
+ the Stubs table and the library documentation. Added a TclpGetTime in
+ tclUtil.c for backward compatibility of extensions. [Patch 483500,
+ TIP#73]
* generic/tclCmdMZ.c (Tcl_TimeObjCmd): Corrected an error in the
[time] command that caused incorrect results to be returned if the
- total duration of all iterations exceeded 2**31 microseconds.
- [Bug #478847]
+ total duration of all iterations exceeded 2**31 microseconds. [Bug
+ 478847]
* generic/tclInt.decls:
* generic/tclInt.h:
* generic/tclStubInit.h: Reran 'make genstubs'
-
+
2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c
- * generic/tclCompile.h:
+ * generic/tclCompile.h:
* generic/tclExecute.c: moving all code relative to bytecodes from
tclBasic.c to tclExecute.c - the functions RecordTracebackInfo and
Tcl_ExprObj went to tclExecute.c, and new interface function was
defined (TclCompEvalObj).
- The final objective of this sequence of moves is to provide a
- clean, clear-cut interface between Tcl's core and the
- compiler/engine subsystem.
+ The final objective of this sequence of moves is to provide a clean,
+ clear-cut interface between Tcl's core and the compiler/engine
+ subsystem.
2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c
- * generic/tclCompile.h:
+ * generic/tclCompile.h:
* generic/tclExecute.c: factoring out of common code in tclBasic.c
- (new function TclInterpReady defined: it resets the interp's
- result, then checks that it hasn't been deleted and that the
- nesting level is acceptable). Passed the responsibility of calling
- it to the *callers* of TclEvalObjvInternal.
+ (new function TclInterpReady defined: it resets the interp's result,
+ then checks that it hasn't been deleted and that the nesting level is
+ acceptable). Passed the responsibility of calling it to the *callers*
+ of TclEvalObjvInternal.
2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c
* generic/tclExecute.c: a better variant of the previous-to-last
- commit (restoring numLevels computations). The managing of the
- levels now has to be done by the *callers* of TclEvalObjvInternal
+ commit (restoring numLevels computations). The managing of the levels
+ now has to be done by the *callers* of TclEvalObjvInternal
2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c: missing variable declaration under
- TCL_COMPILE_DEBUG.
+ TCL_COMPILE_DEBUG.
2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c:
- * generic/tclProc.c: restoring the computations of iPtr->numLevels
- to the original logic (previous to buggy modifs on 2001-11-16).
+ * generic/tclProc.c: restoring the computations of iPtr->numLevels to
+ the original logic (previous to buggy modifs on 2001-11-16).
2001-11-20 Jeff Hobbs <jeffh@ActiveState.com>
* tools/eolFix.tcl (new-file):
* unix/Makefile.in: added EOL correction for Windows bat files to
- dist target. [Bug #219409] (davygrvy)
+ dist target. [Bug 219409] (davygrvy)
- * unix/tclUnixInit.c (TclpSetInitialEncodings): update of patch
- from 2001-11-16 that uses the old Tcl encoding check mechanism as
- a fallback to the original. Also added a TCL_DEFAULT_ENCODING
- #define (defaults to iso8859-1). Tcl will first try setlocale and
- nl_langinfo, and if that fails, guess based on certain LANG|LC_*
- env vars. [Patch #418645]
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): update of patch from
+ 2001-11-16 that uses the old Tcl encoding check mechanism as a
+ fallback to the original. Also added a TCL_DEFAULT_ENCODING #define
+ (defaults to iso8859-1). Tcl will first try setlocale and nl_langinfo,
+ and if that fails, guess based on certain LANG|LC_* env vars. [Patch
+ 418645]
2001-11-19 David Gravereaux <davygrvy@pobox.com>
@@ -667,42 +653,42 @@
* win/tclWinFCmd.c:
* win/tclWin32Dll.c:
* doc/file.n:
- * tests/winFCmd.test: improved speed of file normalization
- for Win95/98, and clarified docs on differences in file
- normalization between NT/2000 and the older operating systems.
- Added test to ensure normalization is correct.
-
+ * tests/winFCmd.test: improved speed of file normalization for
+ Win95/98, and clarified docs on differences in file normalization
+ between NT/2000 and the older operating systems. Added test to ensure
+ normalization is correct.
+
2001-11-19 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c:
* generic/tclParse.c: Code reorganisation. Moved all evaluation
- functions from tclParse.c to tclBasic.c, so that now tclParse.c
- deals exclusively with parsing and all evaluations are done by
- code in tclBasic.c. The functions moved are: TclEvalObjvInternal,
+ functions from tclParse.c to tclBasic.c, so that now tclParse.c deals
+ exclusively with parsing and all evaluations are done by code in
+ tclBasic.c. The functions moved are: TclEvalObjvInternal,
Tcl_EvalObjv, Tcl_LogCommandInfo, Tcl_EvalTokensStandard,
Tcl_EvalTokens, Tcl_EvalEx, Tcl_Eval, Tcl_EvalObj and
- Tcl_GlobalEvalObj.
+ Tcl_GlobalEvalObj.
2001-11-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/trace.test (trace-8.8): Added adapted version of Bug
- #219393 as new test; the test won't reliably show up the old
- problem unless it is being run under something like Purify, but
- something is better than nothing...
+ * tests/trace.test (trace-8.8): Added adapted version of [Bug 219393]
+ as new test; the test won't reliably show up the old problem unless it
+ is being run under something like Purify, but something is better than
+ nothing...
* generic/tclVar.c (Tcl_TraceVar2, Tcl_UntraceVar2): Added missing
mask bits for trace result type and a check for a nonsense flag
combination.
- * generic/tclCmdMZ.c (TraceVarProc): Added missing test for NULL
- when deleting a trace that doesn't cause an error.
+ * generic/tclCmdMZ.c (TraceVarProc): Added missing test for NULL when
+ deleting a trace that doesn't cause an error.
* doc/TraceVar.3: Added documentation for change due to TIP#68.
- * generic/tclCmdMZ.c (TraceVarInfo): Removed problematic errMsg
- field from structure.
+ * generic/tclCmdMZ.c (TraceVarInfo): Removed problematic errMsg field
+ from structure.
(TraceVarProc): Removed references to errMsg field and changed
handling of errors so that they returned a Tcl_Obj* containing the
- error string. This minimizes the number of calls to the memory
+ error string. This minimizes the number of calls to the memory
management subsystem.
(TclTraceCommandObjCmd, TraceCommandProc): Removed references to
errMsg field which was never used in command traces in any case.
@@ -710,14 +696,14 @@
errMsg field and made variable traces register with
TCL_TRACE_RESULT_OBJECT bit set.
- * generic/tcl.h (TCL_TRACE_RESULT_DYNAMIC,TCL_TRACE_RESULT_OBJECT):
- New constants to define how to handle the strings returned from
- trace callbacks [TIP#68]
+ * generic/tcl.h (TCL_TRACE_RESULT_DYNAMIC,TCL_TRACE_RESULT_OBJECT):
+ New constants to define how to handle the strings returned from trace
+ callbacks [TIP#68]
* generic/tclVar.c (CallTraces, Tcl_GetVar2Ex, TclGetIndexedScalar,
- TclGetElementOfIndexedArray, Tcl_SetVar2Ex, TclSetIndexedScalar,
- TclSetElementOfIndexedArray, Tcl_UnsetVar2, Tcl_ArrayObjCmd,
- TclDeleteVars, TclDeleteCompiledLocalVars, DeleteArray,
- TclVarTraceExists): Support for those new trace flags.
+ (TclGetElementOfIndexedArray, Tcl_SetVar2Ex, TclSetIndexedScalar,
+ (TclSetElementOfIndexedArray, Tcl_UnsetVar2, Tcl_ArrayObjCmd,
+ (TclDeleteVars, TclDeleteCompiledLocalVars, DeleteArray,
+ (TclVarTraceExists): Support for those new trace flags.
2001-11-19 Miguel Sofer <msofer@users.sourceforge.net>
@@ -725,14 +711,14 @@
2001-11-16 Kevin B. Kenny <kennykb@users.sourceforge.net>
- * generic/tclListObj.c: removed a C++-style comment that
- was inadvertently left in the source code.
+ * generic/tclListObj.c: removed a C++-style comment that was
+ inadvertently left in the source code.
2001-11-16 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/interp.test:
- * generic/tclInterp.c (SlaveObjCmd): Corrected argument checking
- for '$interp alias|aliases|issafe'. [Patch #479560] (thoyts, hobbs)
+ * tests/interp.test:
+ * generic/tclInterp.c (SlaveObjCmd): Corrected argument checking for
+ '$interp alias|aliases|issafe'. [Patch 479560] (thoyts, hobbs)
* unix/tclUnixInit.c: added HAVE_LANGINFO code block.
* unix/configure: regened
@@ -740,17 +726,17 @@
* unix/tcl.m4: made SHLIB_LD_LIBS='${LIBS}' for FreeBSD* (meyer)
Added modified version of Wagner patch to make use of nl_langinfo
where possible to determine Unix platform encoding, instead of the
- inflexible built-in system. This is used by default when
- possible, and can be disabled with --enable-langinfo=no.
- [Patch #418645] (hobbs, wagner)
+ inflexible built-in system. This is used by default when possible, and
+ can be disabled with --enable-langinfo=no. [Patch 418645] (hobbs,
+ wagner)
2001-11-16 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCompile.h:
* generic/tclExecute.c:
- * generic/tclObj.c: moved Tcl_GetCommandFromObj and all defining
- code for tclCmdNameType objects to tclObj.c (from tclExecute.c).
- This code has nothing to do with bytecodes.
+ * generic/tclObj.c: moved Tcl_GetCommandFromObj and all defining code
+ for tclCmdNameType objects to tclObj.c (from tclExecute.c). This code
+ has nothing to do with bytecodes.
2001-11-16 Miguel Sofer <msofer@users.sourceforge.net>
@@ -760,18 +746,17 @@
* generic/tclParse.c:
* generic/tclProc.c:
* tests/stack.test: consolidation of duplicated code (in
- TclExecuteByteCode and EvalObjv); renaming of EvalObjv to
- TclEvalObjv as it is not static anymore; restored consistency of
- level counts between compiled and directly evaled code.
- [Bug 480896]
+ TclExecuteByteCode and EvalObjv); renaming of EvalObjv to TclEvalObjv
+ as it is not static anymore; restored consistency of level counts
+ between compiled and directly evaled code. [Bug 480896]
2001-11-12 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc:
* win/rules.vc: Small bug fixes.
- * win/README: added some docs pointing to the docs in makefile.vc
- for it's use.
+ * win/README: added some docs pointing to the docs in makefile.vc for
+ it's use.
2001-10-17 Kevin B. Kenny <kennykb@users.sourceforge.net>
@@ -806,17 +791,17 @@
* tests/obj.test:
* tests/string.test:
* tests/stringComp.test:
- Reference implementation of TIP's #22, #33 and #45. Adds the
- ability of the [lindex] command to have multiple index arguments,
- and adds the [lset] command. Both commands are byte-code compiled.
- [Patch #471874] (work by Kenny, commited by Hobbs)
+ Reference implementation of TIP's #22, #33 and #45. Adds the ability
+ of the [lindex] command to have multiple index arguments, and adds the
+ [lset] command. Both commands are byte-code compiled. [Patch 471874]
+ (work by Kenny, commited by Hobbs)
2001-11-12 David Gravereaux <davygrvy@pobox.com>
* win/buildall.vc.bat(new):
* win/makefile.vc: Small fix with deriving the "OriginalFilename"
- string in the .rc scripts. Added a quick batchfile for building
- the entire thing.
+ string in the .rc scripts. Added a quick batchfile for building the
+ entire thing.
2001-11-12 Jeff Hobbs <jeffh@ActiveState.com>
@@ -827,8 +812,8 @@
2001-11-10 Mo DeJong <mdejong@users.sourceforge.net>
* unix/Makefile.in:
- * win/Makefile.in: Add "make gdb" target. This target
- can run tclsh inside either gdb or insight.
+ * win/Makefile.in: Add "make gdb" target. This target can run tclsh
+ inside either gdb or insight.
2001-11-10 David Gravereaux <davygrvy@pobox.com>
@@ -837,20 +822,19 @@
* win/mkd.bat:
* win/rmd.bat: Changes from Llyod Lim for better stability.
- [Patch #456759]
+ [Patch 456759]
2001-11-09 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc:
- * win/tcl.dsp: winhelp target fixes for non-NT systems. It
- seems NMAKE under these remembers changed directories during
- commands. A new tcltest feature from Peter Spjuth
- <peter.spjuth@space.se> to specify a pattern file from the
- commandline and redirecting output to a file when not under
- NT with it's scrollback console. Then it replays it, piped
- through more. Added 2 new static "configurations" to tcl.dsp.
- I could keep adding more, but I think we should leave it up to
- the user for customizing it.
+ * win/tcl.dsp: winhelp target fixes for non-NT systems. It seems
+ NMAKE under these remembers changed directories during commands. A new
+ tcltest feature from Peter Spjuth <peter.spjuth@space.se> to specify a
+ pattern file from the commandline and redirecting output to a file
+ when not under NT with it's scrollback console. Then it replays it,
+ piped through more. Added 2 new static "configurations" to tcl.dsp.
+ I could keep adding more, but I think we should leave it up to the
+ user for customizing it.
Sticky-points left: 'profile' option.
@@ -860,9 +844,9 @@
* doc/StdChannels.3:
* doc/file.n:
* doc/tcltest.n:
- * tools/man2help.tcl:
+ * tools/man2help.tcl:
* tools/man2help2.tcl: fixed winhelp generation problems
- [Patch #480268]
+ [Patch 480268]
* unix/configure:
* unix/tcl.m4: added -lc to AIX libs, fixed path to ldAix
@@ -870,68 +854,64 @@
2001-11-09 Don Porter <dgp@users.sourceforge.net>
* tests/var.test:
- * generic/tclVar.c: Corrected bug in [global] when dealing
- with variable names matching :*. [Bug 480176]
+ * generic/tclVar.c: Corrected bug in [global] when dealing with
+ variable names matching :*. [Bug 480176]
2001-11-08 Mo DeJong <mdejong@users.sourceforge.net>
- Fixup stack size under OSF1. [Tcl patch 474790]
+ Fixup stack size under OSF1. [Patch 474790]
* unix/configure: Regen.
- * unix/tcl.m4: Add HAVE_PTHREAD_ATTR_SETSTACKSIZE define
- to EXTRA_CFLAGS to adjust initial stack size.
+ * unix/tcl.m4: Add HAVE_PTHREAD_ATTR_SETSTACKSIZE define to
+ EXTRA_CFLAGS to adjust initial stack size.
2001-11-08 Mo DeJong <mdejong@users.sourceforge.net>
- Enable thread support under FreeBSD. [Tcl bug 473708]
+ Enable thread support under FreeBSD. [Bug 473708]
* unix/configure: Regen.
- * unix/tcl.m4 (SC_ENABLE_THREADS): Check for pthread functions
- in libc_r and enable thread support if found.
- * unix/dltest/Makefile.in: Set SHLIB_LD_LIBS and use it in
- the Makefile to properly link a shared library.
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Check for pthread functions in
+ libc_r and enable thread support if found.
+ * unix/dltest/Makefile.in: Set SHLIB_LD_LIBS and use it in the
+ Makefile to properly link a shared library.
2001-11-08 Mo DeJong <mdejong@users.sourceforge.net>
* unix/Makefile.in:
- * unix/dltest/Makefile.in:
- Avoid adding libc to the LIBS variable since it
- is not needed when linking with CC. If required
- when linking with LD it should be done on a case
- by case basis in tcl.m4.
+ * unix/dltest/Makefile.in: Avoid adding libc to the LIBS variable
+ since it is not needed when linking with CC. If required when linking
+ with LD it should be done on a case by case basis in tcl.m4.
2001-11-08 David Gravereaux <davygrvy@pobox.com>
* win/rules.vc:
- * win/makefile.vc: Fixed install target to adjust for the
- different build types. Added a 'linkexten' option to link the
- win extensions inside the shell when built static. Placed
- win/tclAppInit.c patch in SF patch DB for approval. 'profile'
- option not hooked in yet. Everything else know is done.
+ * win/makefile.vc: Fixed install target to adjust for the different
+ build types. Added a 'linkexten' option to link the win extensions
+ inside the shell when built static. Placed win/tclAppInit.c patch in
+ SF patch DB for approval. 'profile' option not hooked in yet.
+ Everything else know is done.
* win/tcl.dsp(new):
* win/tcl.dsw(new): Simple MsDev stub project files that calls
- makefile.vc. Will help run Tcl in the debugger easier without
+ makefile.vc. Will help run Tcl in the debugger easier without
confusing MsDev for where the .pdb files are.
2001-11-07 Mo DeJong <mdejong@users.sourceforge.net>
* unix/Makefile.in:
- * win/Makefile.in:
- Print a message indicating that the user should
- run "make genstubs" when the generated tclStubInit.c
- file is out of date. We can't regenerate automatically
- since there may be no tclsh on the system and that
- would cause bootstrap problems. [Tcl bug 465874]
+ * win/Makefile.in: Print a message indicating that the user should run
+ "make genstubs" when the generated tclStubInit.c file is out of date.
+ We can't regenerate automatically since there may be no tclsh on the
+ system and that would cause bootstrap problems. [Bug 465874]
2001-11-07 Mo DeJong <mdejong@users.sourceforge.net>
- Define TCL_INCLUDE_SPEC in tclConfig.sh. It should be
- included by extensions that need to find Tcl include
- headers in the install location. The user can override
- the include install dir with --includedir so we need
- to record this information for extensions. [Tcl bug 421835]
-
+ Define TCL_INCLUDE_SPEC in tclConfig.sh. It should be included by
+ extensions that need to find Tcl include headers in the install
+ location. The user can override the include install dir with
+ --includedir so we need to record this information for extensions.
+ [Bug 421835]
+
* unix/configure: Regen.
* unix/configure.in: Define TCL_INCLUDE_SPEC.
* unix/tclConfig.sh.in: Define TCL_INCLUDE_SPEC.
@@ -942,45 +922,41 @@
2001-11-07 David Gravereaux <davygrvy@pobox.com>
* win/rules.vc:
- * win/makefile.vc: Dropped the NOMSVCRT macro and put it on the
- option list instead. It makes more sense to me this way as
- NOMSVCRT=0 would only be the valid setting. Fixed the dde and reg
- extension for building static. Improved, but not perfected, the
- winhelp target.
+ * win/makefile.vc: Dropped the NOMSVCRT macro and put it on the option
+ list instead. It makes more sense to me this way as NOMSVCRT=0 would
+ only be the valid setting. Fixed the dde and reg extension for
+ building static. Improved, but not perfected, the winhelp target.
2001-11-07 Mo DeJong <mdejong@users.sourceforge.net>
- * win/README: Change minimum VC++ version to 5.X since
- 4.X is known not to work.
- Indicate that Mingw is required and building with Cygwin
- gcc is not supported. Include instructions that indicate
- how to install Mingw and what URLs folks should use to
- download the supported version of Mingw.
+ * win/README: Change minimum VC++ version to 5.X since 4.X is known
+ not to work.
+ Indicate that Mingw is required and building with Cygwin gcc is not
+ supported. Include instructions that indicate how to install Mingw and
+ what URLs folks should use to download the supported version of Mingw.
* win/configure: Regen.
- * win/configure.in: Error out if user tries to compile the
- Windows version of Tcl with Cygwin gcc. Users should compile
- with Mingw gcc instead.
+ * win/configure.in: Error out if user tries to compile the Windows
+ 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 fileevents when [read]ing less data from the channel than
- buffered. Due to an empty input buffer the flag
- CHANNEL_NEED_MORE_DATA was set but never reset, causing the I/O
- system to wait for more data instead of using a timer to
- synthesize fileevents and to flush the pending data out of the
- buffers.
+ * generic/tclIO.c (ReadChars): Fixed [Bug 478856] reported by Stuart
+ Cassoff <stwo@users.sourceforge.net>. The bug caused loss of
+ fileevents when [read]ing less data from the channel than buffered.
+ Due to an empty input buffer the flag CHANNEL_NEED_MORE_DATA was set
+ but never reset, causing the I/O system to wait for more data instead
+ of using a timer to synthesize fileevents and to flush the pending
+ data out of the buffers.
2001-11-06 David Gravereaux <davygrvy@pobox.com>
* win/rules.vc (new):
* win/makefile.vc: Complete over/under rewrite to support numerous
- build options all from the commandline itself without needing to
- edit the makefile. Now requires vcvars32.bat to be run prior to
- running nmake for bootstraping the environment. Fully doc'd usage
- for it is in makefile.vc. Commentary welcome. Sticky points left
- are:
+ build options all from the commandline itself without needing to edit
+ the makefile. Now requires vcvars32.bat to be run prior to running
+ nmake for bootstraping the environment. Fully doc'd usage for it is in
+ makefile.vc. Commentary welcome. Sticky points left are:
1) winhelp target shows errors in the converting script.
2) .rc scripts aren't getting the right #defines to build the correct
@@ -992,158 +968,153 @@
2001-11-04 Vince Darley <vincentdarley@users.sourceforge.net>
- * library/init.tcl: made filesystem fallback proc
- ::tcl::CopyDirectory more robust to vagaries of non-native
- filesystems.
-
+ * library/init.tcl: made filesystem fallback proc ::tcl::CopyDirectory
+ more robust to vagaries of non-native filesystems.
+
2001-11-02 Vince Darley <vincentdarley@users.sourceforge.net>
* doc/file.n:
- * generic/tclIOUtil.c: updated documentation and comments
- to clarify behaviour of 'file copy' wrt soft links.
-
+ * generic/tclIOUtil.c: updated documentation and comments to clarify
+ behaviour of 'file copy' wrt soft links.
+
2001-10-29 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/tclWinFile.c: fix to '-types {f r}' bug in
- TclpMatchInDirectory (which could cause a UMR, as well as
- returning wrong results). Also improved API for 'stat'
- to resolve [Bug#219258].
+ * win/tclWinFile.c: fix to '-types {f r}' bug in TclpMatchInDirectory
+ (which could cause a UMR, as well as returning wrong results). Also
+ improved API for 'stat' to resolve [Bug 219258].
* win/tclWin32Dll.c
- * win/tclWinInt.h: addition of improved stat API to internal
- lookup table.
+ * win/tclWinInt.h: addition of improved stat API to internal lookup
+ table.
* tests/fileName.test: two new tests for the above bug.
* generic/tclIOUtil.c: some cleanup of comments and #ifdefs
-
+
2001-10-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/tclUnixFile.c (TclpMatchInDirectory): Argument to access()
- was entryPtr->d_name instead of nativeEntry which failed when
- trying to check access for files in other than the current
- directory. [Bug 475941, reported by Georgios Petasis]
+ * unix/tclUnixFile.c (TclpMatchInDirectory): Argument to access() was
+ entryPtr->d_name instead of nativeEntry which failed when trying to
+ check access for files in other than the current directory. [Bug
+ 475941, reported by Georgios Petasis]
2001-10-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* unix/tclUnixChan.c: Added stateUpdated member to struct TtyState.
- (TtyCloseProc,TtySetOptionProc,TtyInit): Use stateUpdated member
- of TtyState to decide whether it is necessary to reset a serial
- port when Tcl closes it. Blindly resetting can cause Tcl to be
- sent an unexpected SIGTSTP when it is executing in the background
- [Bug 471374, reported by Chris Nelson]
+ (TtyCloseProc,TtySetOptionProc,TtyInit): Use stateUpdated member of
+ TtyState to decide whether it is necessary to reset a serial port when
+ Tcl closes it. Blindly resetting can cause Tcl to be sent an
+ unexpected SIGTSTP when it is executing in the background [Bug 471374,
+ reported by Chris Nelson]
-2001-10-22 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-10-22 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * doc/ObjectType.3: Minor documentation fix, reported by David
- N. Welton <davidw@users.sourceforge.net> directly to me.
+ * doc/ObjectType.3: Minor documentation fix, reported by David N.
+ Welton <davidw@users.sourceforge.net> directly to me.
2001-10-22 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/tclWinFCmd.c: fix to stop test suite from hanging process
- under some versions of WinNT. [Bug #466102] (Kevin Kenny)
-
+ * win/tclWinFCmd.c: fix to stop test suite from hanging process under
+ some versions of WinNT. [Bug 466102] (Kevin Kenny)
+
2001-10-18 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/clock.test (clock-8.1):
- * generic/tclDate.c (RelativeMonth):
- * generic/tclGetDate.y (RelativeMonth): corrected off-by-one-day
- error in clock scan with relative months and years during swing
- hours. [Bug #413397, Patch #414024] (lavana)
+ * tests/clock.test (clock-8.1):
+ * generic/tclDate.c (RelativeMonth):
+ * generic/tclGetDate.y (RelativeMonth): corrected off-by-one-day error
+ in clock scan with relative months and years during swing hours. [Bug
+ 413397, Patch 414024] (lavana)
2001-10-18 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: fix to bug in Tcl_FSChdir shown up
- by recent tclkit builds.
+ * generic/tclIOUtil.c: fix to bug in Tcl_FSChdir shown up by recent
+ tclkit builds.
2001-10-17 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tclUnixPipe.c (PipeInputProc, PipeOutputProc): do immediate
- retry when error is returned with errno == EINTR.
- [Bug #415131] (leger)
+ retry when error is returned with errno == EINTR. [Bug 415131] (leger)
2001-10-16 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/tclLoadAout.c (TclGuessPackageName): removed unused vars
- and fixed warnings. [Bug #446622] (lim)
+ * unix/tclLoadAout.c (TclGuessPackageName): removed unused vars and
+ fixed warnings. [Bug 446622] (lim)
2001-10-15 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclProc.c: changing a memcmp to strncmp to avoid a memory
- error detected by purify (thanks Jeff); modify style to agrre with
- the style guide.
-
-2001-10-15 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ error detected by purify (thanks Jeff); modify style to agrre with the
+ style guide.
+
+2001-10-15 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* generic/tclInt.decls (TclExpandCodeArray,TclGetInstructionTable):
- Added to internal stubs table. Tclcompiler (Tclpro project)
- needs them if used as loadable package under Windows. Changed
- signatures. We don't want to describe compiler internal
- structures in "tclInt.h".
+ Added to internal stubs table. Tclcompiler (Tclpro project) needs them
+ if used as loadable package under Windows. Changed signatures. We
+ don't want to describe compiler internal structures in "tclInt.h".
* generic/tclCompile.h: S.a. Removed function declarations.
* generic/tclCompile.c: S.a. Adapted to changed signatures.
2001-10-15 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/configure:
- * unix/configure.in:
- * win/configure:
- * win/configure.in:
- * win/tcl.m4: reworked to be a little cleaner in comparison to
- each other, and to AC_SUBST even empty vars for win/tclConfig.sh
+ * unix/configure:
+ * unix/configure.in:
+ * win/configure:
+ * win/configure.in:
+ * win/tcl.m4: reworked to be a little cleaner in comparison to each
+ other, and to AC_SUBST even empty vars for win/tclConfig.sh
* generic/tclFileName.c: minor code cleanup
- * generic/tcl.h: moved #define of WIN32 to tcl.h where __WIN32__
- is defined and added #ifndef check.
+ * generic/tcl.h: moved #define of WIN32 to tcl.h where __WIN32__ is
+ defined and added #ifndef check.
* doc/open.n: moved all fconfigure option docs to fconfigure.n
* doc/fconfigure.n: added serial config options
* win/tclWinChan.c:
* win/tclWinPort.h:
- * win/tclWinSerial.c: added TIP #35 Windows enhancements for
- serial configuration. [Patch #438509] (schroedter)
+ * win/tclWinSerial.c: added TIP #35 Windows enhancements for serial
+ configuration. [Patch 438509] (schroedter)
2001-10-15 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclFCmd.c: fix to memory leak in TclFileDeleteCmd on
certain error conditions.
* doc/FileSystem.3: fix to typo.
-
+
2001-10-12 Jeff Hobbs <jeffh@ActiveState.com>
* library/encoding/ebcdic.enc:
* tools/encoding/ebcdic.txt: EBCDIC charset mapping.
- [Patch #219323] (nijtmans)
+ [Patch 219323] (nijtmans)
* library/encoding/tis-620.enc:
* tools/encoding/tis-620.txt: TIS-620 charset mapping.
- [Patch #467423] (poonlap)
+ [Patch 467423] (poonlap)
* tests/http.test: added removeFile for outdata
- * tests/ioCmd.test: added catch around file removal, as Windows
- file locking throws errors.
+ * tests/ioCmd.test: added catch around file removal, as Windows file
+ locking throws errors.
* tests/socket.test (socket-7.2): corrected to work on Win2K.
2001-10-12 Miguel Sofer <msofer@users.sourceforge.net>
-
+
* tests/compile.test: new tests for [Bug 467523]; they are only
effective if TCL_MEM_DEBUG was set during compilation.
2001-10-11 Miguel Sofer <msofer@users.sourceforge.net>
-
+
* generic/tclLiteral.c (TclReleaseLiteral): insured that
self-referential bytecodes are properly cleaned up on interpreter
deletion [Bug 467523] (Ronnie Brunner)
2001-10-10 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinPort.h: #include <winsock2.h> needed to get moved
- to after #include <windows.h> or wierd misunderstandings took
- place when -D_WIN32_WINNT=0x0400 is set for outside code that
- requires knowledge of Tcl innards. General header macro magic
- applied liberally...
+ * win/tclWinPort.h: #include <winsock2.h> needed to get moved to
+ after #include <windows.h> or wierd misunderstandings took place when
+ -D_WIN32_WINNT=0x0400 is set for outside code that requires knowledge
+ of Tcl innards. General header macro magic applied liberally...
2001-10-10 Don Porter <dgp@users.sourceforge.net>
@@ -1151,20 +1122,20 @@
2001-10-09 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclFileName.c (Tcl_SplitPath): corrected mem leak
- intro'd with VFS code where the result obj from Tcl_FSSplitPath
- was not getting freed.
+ * generic/tclFileName.c (Tcl_SplitPath): corrected mem leak intro'd
+ with VFS code where the result obj from Tcl_FSSplitPath was not
+ getting freed.
2001-10-09 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclLiteral.c: (TclReleaseLiteral) reverted previous
- patch for [Bug 467523] - cure is worse than the illness.
+
+ * generic/tclLiteral.c: (TclReleaseLiteral) reverted previous patch
+ for [Bug 467523] - cure is worse than the illness.
2001-10-05 Miguel Sofer <msofer@users.sourceforge.net>
-
+
* generic/tclLiteral.c: (TclReleaseLiteral) insured that
self-referential bytecodes are properly cleaned up on interpreter
- deletion [Bug 467523] (Ronnie Brunner)
+ deletion. [Bug 467523] (Ronnie Brunner)
2001-10-04 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1217,18 +1188,18 @@
* tools/encoding/macIceland.txt:
* tools/encoding/macRoman.txt:
* tools/encoding/macTurkish.txt:
- Updated encodings with latest mappings from www.unicode.org. This
- did not include some Mac encodings that have special multi-unichar
- translations now (like symbols, dingbats and japanese). Also does
- not include big5, gb or euc* as those have different formats in
- the latest Unicode version that need new conversion tools. Not
- all related .enc files changed as some had been updates separately.
+ Updated encodings with latest mappings from www.unicode.org. This did
+ not include some Mac encodings that have special multi-unichar
+ translations now (like symbols, dingbats and japanese). Also does not
+ include big5, gb or euc* as those have different formats in the latest
+ Unicode version that need new conversion tools. Not all related .enc
+ files changed as some had been updates separately.
2001-10-03 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclEvent.c (Tcl_FinalizeThread): moved freeing of
- tclLibraryPath to before the thread exit handlers are called.
- Slight modification to change on 2001-09-24.
+ tclLibraryPath to before the thread exit handlers are called. Slight
+ modification to change on 2001-09-24.
2001-10-01 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1245,45 +1216,44 @@
* generic/tclCmdIL.c:
* generic/tclCmdMZ.c:
* generic/tclParseExpr.c: removed unnecessary inclusion of
- tclCompile.h and made a small modification in (InfoBodyCmd) to
- improve the isolation of the compiler/engine subsystem.
+ tclCompile.h and made a small modification in (InfoBodyCmd) to improve
+ the isolation of the compiler/engine subsystem.
2001-09-29 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclIOUtil.c:
- * doc/FileSystem.3: corrected and clarified documentation
- for 'Tcl_FSListVolumes(Proc)'. No code changes.
-
+ * doc/FileSystem.3: corrected and clarified documentation for
+ 'Tcl_FSListVolumes(Proc)'. No code changes.
+
2001-09-28 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/FindExec.3: added a comment not to change the working
- directory before calling Tcl_GetNameOfExecutable [Bug 219215]
+ * doc/FindExec.3: added a comment not to change the working directory
+ before calling Tcl_GetNameOfExecutable. [Bug 219215]
2001-09-28 Kevin Kenny <kennykb@users.sourceforge.net>
- * generic/tclIO.c: added two more '(ClientData)' casts
- on calls to Tcl_Preserve and Tcl_Release -- ones that
- Vince apparently missed.
-
+ * generic/tclIO.c: added two more '(ClientData)' casts on calls to
+ Tcl_Preserve and Tcl_Release -- ones that Vince apparently missed.
+
2001-09-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/lsort.n: Improved doc...
* generic/tclCmdIL.c (Tcl_LsortObjCmd, SortCompare): Made
- offset-from-end indexing work, and factored out some "magic
- numbers" for easier understanding. [Bug #465674]
+ offset-from-end indexing work, and factored out some "magic numbers"
+ for easier understanding. [Bug 465674]
* tests/cmdIL.test (cmdIL-1.26): Added test for offset-from-end
indexing for lsort.
2001-09-28 Vince Darley <vincentdarley@users.sourceforge.net>
* win/tclWinFCmd.c:
- * unix/tclUnixFCmd.c: fix to performance issue reported
- by jcw in which 'access("")' is called unnecessarily when
- normalizing any absolute path.
+ * unix/tclUnixFCmd.c: fix to performance issue reported by jcw in
+ which 'access("")' is called unnecessarily when normalizing any
+ absolute path.
* generic/tclIO.c: added '(ClientData)' cast to calls to
- Tcl_(Preserve|Release) newly introduced, fixing compile
- error on Windows.
-
+ Tcl_(Preserve|Release) newly introduced, fixing compile error on
+ Windows.
+
2001-09-27 Don Porter <dgp@users.sourceforge.net>
* doc/FileSystem.3 (Tcl_FSLoadFile):
@@ -1305,70 +1275,67 @@
* unix/tclLoadShl.c (TclpLoadFile):
* win/tclWinLoad.c (TclpLoadFile):
* win/tclWinFCmd.c (DoRemoveJustDirectory): More CONST poisoning
- fixes from the 2001-09-24 TIP 27 changes. CONST-ified
- Tcl_FSLoadFile and TclpLoadFile. Report and patch from Kevin
- Kenny. [Bug 465833]
+ fixes from the 2001-09-24 TIP 27 changes. CONST-ified Tcl_FSLoadFile
+ and TclpLoadFile. Report and patch from Kevin Kenny. [Bug 465833]
- * generic/tclIO.c (ChannelTimerProc): Added Tcl_Preserve()
- and Tcl_Release() to fix segfault introduced by the 2001-09-26
- changes. [Bug 465494]
+ * generic/tclIO.c (ChannelTimerProc): Added Tcl_Preserve() and
+ Tcl_Release() to fix segfault introduced by the 2001-09-26 changes.
+ [Bug 465494]
- * doc/TCL_MEM_DEBUG.3: Updated out-of-date reference to
- #define GUARD_SIZE.
+ * doc/TCL_MEM_DEBUG.3: Updated out-of-date reference to #define
+ GUARD_SIZE.
* doc/UpVar.3 (Tcl_UpVar,Tcl_UpVar2):
* generic/tcl.decls (Tcl_UpVar,Tcl_UpVar2):
* generic/tclInt.decls (TclFindProc,TclGetFrame):
* generic/tclInt.h (TclFindProc,TclGetFrame,TclLookupVar,
- TclPrecTraceProc,TclProcInterpProc}):
+ (TclPrecTraceProc,TclProcInterpProc}):
* generic/tclProc.c (TclGetFrame,TclFindProc):
* generic/tclVar.c (Tcl_UpVar,Tcl_UpVar2,MakeUpvar): Updated APIs in
- generic/tclProc.c and generic/tclVar.c according to the guidelines
- of TIP 27. [Patch 465442]
+ generic/tclProc.c and generic/tclVar.c according to the guidelines of
+ TIP 27. [Patch 465442]
* generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
-2001-09-26 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * doc/fileevent.n: Accepted [Patch #465279] adding an example to
- the fileevent manpage. Minor modifications to get a better
- formatting. Report and patch by David N. Welton
- <davidw@users.sourceforge.net>.
-
- * The changes below fix [Bug #462317] where Expect tried to read
- more than was in the buffers and then blocked in the OS call as
- its pty channel driver provides no blockmodeproc through which
- the OS could be notified of blocking-behaviour. Because of this
- the general I/O core has to take more care than usual to
- preserve the semantics of non-blocking channels.
-
- The problem was reported by "Kevin O'Gorman"
- <kevin@kosmanor.com>.
-
- * generic/tclIO.c (Tcl_ReadRaw): Do not read from the driver if
- the channel is non-blocking and the fileevent causing the read
- was generated by a timer. We do not know if there is data
- available from the OS. Instead of going to the OS for more and
- potentially blocking we simply signal EWOULDBLOCK to the higher
- levels to cause the system to wait for true fileevents.
- (GetInput): Same as before.
- (ChannelTimerProc): Added set and clear of CHANNEL_TIMER_FEV.
-
- * generic/tclIO.h (CHANNEL_TIMER_FEV): New flag for channels. Is
- set if a fileevent was generated by a timer, the channel is not
- blocking and the driver did not provide a blockmodeproc. In that
- case the I/O core has to be especially careful about going to
- the driver for more data.
+2001-09-26 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * doc/fileevent.n: Accepted [Patch 465279] adding an example to the
+ fileevent manpage. Minor modifications to get a better formatting.
+ Report and patch by David N. Welton <davidw@users.sourceforge.net>.
+
+ * The changes below fix [Bug 462317] where Expect tried to read more
+ than was in the buffers and then blocked in the OS call as its pty
+ channel driver provides no blockmodeproc through which the OS could be
+ notified of blocking-behaviour. Because of this the general I/O core
+ has to take more care than usual to preserve the semantics of
+ non-blocking channels.
+
+ The problem was reported by "Kevin O'Gorman" <kevin@kosmanor.com>.
+
+ * generic/tclIO.c (Tcl_ReadRaw): Do not read from the driver if the
+ channel is non-blocking and the fileevent causing the read was
+ generated by a timer. We do not know if there is data available from
+ the OS. Instead of going to the OS for more and potentially blocking
+ we simply signal EWOULDBLOCK to the higher levels to cause the system
+ to wait for true fileevents.
+ (GetInput): Same as before.
+ (ChannelTimerProc): Added set and clear of CHANNEL_TIMER_FEV.
+
+ * generic/tclIO.h (CHANNEL_TIMER_FEV): New flag for channels. Is set
+ if a fileevent was generated by a timer, the channel is not blocking
+ and the driver did not provide a blockmodeproc. In that case the I/O
+ core has to be especially careful about going to the driver for more
+ data.
2001-09-26 Don Porter <dgp@users.sourceforge.net>
* doc/SplitPath.3 (Tcl_GetPathType):
* generic/tcl.decls (Tcl_GetPathType):
* generic/tclFileName.c (Tcl_GetPathType):
- * win/tclWinFile.c (TclpMatchInDirectory, NativeStat): Vince
- Darley reports the 2001-09-24 TIP 27 changes left the win
- directory CONST poisoned. These changes should fix that.
+ * win/tclWinFile.c (TclpMatchInDirectory, NativeStat): Vince Darley
+ reports the 2001-09-24 TIP 27 changes left the win directory CONST
+ poisoned. These changes should fix that.
* generic/tclDecls.h: make genstubs
@@ -1378,17 +1345,17 @@
* generic/tclInt.h (TclGetLong deleted):
* generic/tcl.decls:
* generic/tclInt.decls:
- * generic/tclGet.c: Updated APIs in generic/tclGet.c
- according to the guidelines of TIP 27. [Patch 464674]
+ * generic/tclGet.c: Updated APIs in generic/tclGet.c according to the
+ guidelines of TIP 27. [Patch 464674]
- * generic/tclDecls.h:
+ * generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
2001-09-25 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclVar.c: removed comments referring to unused flag
- TCL_PARSE_PART1.
-
+ TCL_PARSE_PART1.
+
2001-09-24 Don Porter <dgp@users.sourceforge.net>
* doc/Concat.3:
@@ -1400,37 +1367,34 @@
* generic/tclEncoding.c (OpenEncodingFile):
* generic/tclMain.c (Tcl_Main):
* generic/tclUtil.c:
- * unix/tclLoadDl.c (TclpLoadFile): Updated APIs in
- generic/tclUtil.c according to the guidelines of TIP 27.
- [Patch 464553]
+ * unix/tclLoadDl.c (TclpLoadFile): Updated APIs in generic/tclUtil.c
+ according to the guidelines of TIP 27. [Patch 464553]
- * generic/tclDecls.h:
+ * generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
2001-09-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * The change below fixes [Bug #464380]. The bug was reported by
- Ronnie Brunner <rbrunner@users.sourceforge.net>. He also
- provided the patch.
-
- * generic/tclEvent.c (Tcl_Finalize): Moved release of
- 'tclLibraryPath' to Tcl_FinalizeThread.
- (Tcl_FinalizeThread): See above, new place for release of
- 'tclLibraryPath'.
+ The change below fixes [Bug 464380]. The bug was reported by Ronnie
+ Brunner <rbrunner@users.sourceforge.net>. He also provided the patch.
+
+ * generic/tclEvent.c (Tcl_Finalize): Moved release of 'tclLibraryPath'
+ to Tcl_FinalizeThread.
+ (Tcl_FinalizeThread): See above, new place for release of
+ 'tclLibraryPath'.
2001-09-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tools/encoding/cp1252.txt: File was missing part of the encoding
- [euro, ZCaron and zcaron].
+ [euro, ZCaron and zcaron].
- * doc/OpenFileChnl.3: Add docs for Tcl_OutputBuffered; remove some
- old changebars.
+ * doc/OpenFileChnl.3: Add docs for Tcl_OutputBuffered; remove some old
+ changebars.
2001-09-21 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c (TclExecuteByteCode): corrected
- INST_STR_CMP else case for strings to pass true utf char length
- to Tcl_UtfNCmp.
+ * generic/tclExecute.c (TclExecuteByteCode): corrected INST_STR_CMP
+ else case for strings to pass true utf char length to Tcl_UtfNCmp.
2001-09-20 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1439,30 +1403,30 @@
* win/tclWinSock.c (SocketThread): corrected pointer cast for _WIN64.
* win/tclWinNotify.c: removed unnecessary winsock include (it is
- already in from tclWinPort.h).
+ already in from tclWinPort.h).
- * win/tclWinPort.h: changed winsock.h include to winsock2.h.
- Reverses change from 2000-11-16, but is necessary for WIN64.
- Extensions should comply with defined OS words, or use #ifndef.
+ * win/tclWinPort.h: changed winsock.h include to winsock2.h. Reverses
+ change from 2000-11-16, but is necessary for WIN64. Extensions should
+ comply with defined OS words, or use #ifndef.
2001-09-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/socket.test: removed dependence on being run from same dir
- as remote.tcl, which only now needs to be in the same dir as
- this file. [Bug #219326]
+ * tests/socket.test: removed dependence on being run from same dir as
+ remote.tcl, which only now needs to be in the same dir as this file.
+ [Bug 219326]
2001-09-19 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclTest.c (TestcmdtokenCmd): corrected pointer
- storage/retrieval for 64bit machines.
+ storage/retrieval for 64bit machines.
* generic/tclCmdAH.c (Tcl_FormatObjCmd):
- * generic/tclScan.c (Tcl_ScanObjCmd): corrected handling of format
- and scan on 64-bit machines. [Bug #412696] (rmax)
+ * generic/tclScan.c (Tcl_ScanObjCmd): corrected handling of format and
+ scan on 64-bit machines. [Bug 412696] (rmax)
* unix/configure: regen'ed
- * unix/tcl.m4: added --enable-64bit support for HP-11 with the
- 64-bit kernel.
+ * unix/tcl.m4: added --enable-64bit support for HP-11 with the 64-bit
+ kernel.
* tests/basic.test:
* tests/cmdInfo.test: improved skip reporting of missing commands
@@ -1471,10 +1435,10 @@
* tests/winPipe.test: removed obsolete cat16 tests
- * generic/tclExecute.c (TclExecuteByteCode): fixed invalid usage
- of valuePtr in TRACE_WITH_OBJ in INST_EVAL_STK case. [Bug #462594]
- Changed INST_STR_CMP instruction to promote to Unicode strings
- only when one of the strings is already of Unicode type.
+ * generic/tclExecute.c (TclExecuteByteCode): fixed invalid usage of
+ valuePtr in TRACE_WITH_OBJ in INST_EVAL_STK case. [Bug 462594] Changed
+ INST_STR_CMP instruction to promote to Unicode strings only when one
+ of the strings is already of Unicode type.
* generic/tclExecute.c (TclExecuteByteCode):
* generic/tclCompile.c (instructionTable):
@@ -1486,77 +1450,75 @@
* tests/{for.test,foreach.test,if.test,while.test}:
* generic/tclCompCmds.c (TclCompileForCmd, TclCompileForeachCmd,
TclCompileIfCmd, TclCompileWhileCmd): Corrected the overaggressive
- compiling of loop bodies enclosed in ""s. [Bug #219166] (msofer)
+ compiling of loop bodies enclosed in ""s. [Bug 219166] (msofer)
2001-09-19 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: insured that execution stack errors are
- also detected at abnormal returns.
+
+ * generic/tclExecute.c: insured that execution stack errors are also
+ detected at abnormal returns.
2001-09-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/socket.n: Added documentation to mention what happens when a
- server socket is created with port=0. Removed an old change bar,
- and no new change bar because Tcl has always behaved this way as
- it is really a poorly-documented standards-defined OS feature.
+ server socket is created with port=0. Removed an old change bar, and
+ no new change bar because Tcl has always behaved this way as it is
+ really a poorly-documented standards-defined OS feature.
* tests/util.test (util-8.1): Test derived from code to detect the
- problem, but the test always works in the C locale, so beware if
- you are maintaining the code.
- * generic/tclUtil.c (TclNeedSpace): Rewrote to be UTF-8 aware.
- [Bug 411825, but not that patch which would have added extra
- spaces if there was a real non-ASCII space involved. ]
+ problem, but the test always works in the C locale, so beware if you
+ are maintaining the code.
+ * generic/tclUtil.c (TclNeedSpace): Rewrote to be UTF-8 aware. [Bug
+ 411825, but not that patch which would have added extra spaces if
+ there was a real non-ASCII space involved.]
-2001-09-18 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2001-09-18 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* generic/tclIOCmd.c (Tcl_PutsObjCmd): Rewritten to have saner and
- faster argument handling. Fixes bug #123552. Patch provided by
- Donal K. Fellows <fellowsd@cs.man.ac.uk>: #402564.
+ faster argument handling. [Bug 123552], [Patch 402564] (fellows)
2001-09-18 Don Porter <dgp@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): On Linux, disable inlining when
- one of the compat/*.c routines is to be linked in. [Patch 440891]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): On Linux, disable inlining when one
+ of the compat/*.c routines is to be linked in. [Patch 440891]
2001-09-17 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tcl.h: removed forced #define USE_TCLALLOC 1 for
- Windows. This means the native system allocator will be used by
- default. This should be binary and source compatible with
- extensions, as Tcl_Alloc is a properly stubbed function.
+ * generic/tcl.h: removed forced #define USE_TCLALLOC 1 for Windows.
+ This means the native system allocator will be used by default. This
+ should be binary and source compatible with extensions, as Tcl_Alloc
+ is a properly stubbed function.
2001-09-17 Miguel Sofer <msofer@users.sourceforge.net>
-
- * generic/tclExecute.c: corrected small bug in [Patch 456668] -
- the varFramePtr was not restored in one possible exit.
+
+ * generic/tclExecute.c: corrected small bug in [Patch 456668] - the
+ varFramePtr was not restored in one possible exit.
2001-09-17 Miguel Sofer <msofer@users.sourceforge.net>
-
+
* doc/tclvars.n:
* generic/tclCompile.c:
* generic/tclCompile.h:
* generic/tclExecute.c:
* generic/tclProc.c: disabled all compile and execution tracing
- functionality in standard builds; TCL_COMPILE_DEBUG is now
- necessary to enable it. [Bug 451858]
+ functionality in standard builds; TCL_COMPILE_DEBUG is now necessary
+ to enable it. [Bug 451858]
2001-09-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * doc/gets.n:
- * doc/read.n:
- * doc/puts.n:
- * doc/flush.n:
- * doc/fconfigure.n:
- * doc/flush.n:
- * doc/eof.n:
- * doc/seek.n:
- * doc/tell.n:
- * doc/close.n:
- * doc/fileevent.n: Added references to the Tcl standard
- channels. Item [219250], reported by David LeBlanc
- <whisper@oz.net>. Thanks to Christopher Nelson
- <chris@pinebush.com> for doing editorial work.
+ * doc/gets.n:
+ * doc/read.n:
+ * doc/puts.n:
+ * doc/flush.n:
+ * doc/fconfigure.n:
+ * doc/flush.n:
+ * doc/eof.n:
+ * doc/seek.n:
+ * doc/tell.n:
+ * doc/close.n:
+ * doc/fileevent.n: Added references to the Tcl standard channels. Item
+ [219250], reported by David LeBlanc <whisper@oz.net>. Thanks to
+ Christopher Nelson <chris@pinebush.com> for doing editorial work.
2001-09-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
@@ -1565,56 +1527,52 @@
* win/makefile.bc:
* win/makefile.vc:
* library/dde/pkgIndex.tcl: Fixed version numbers from bogus tcl
- versions to independent versions for dde and registry packages.
+ versions to independent versions for dde and registry packages.
2001-09-13 Jeff Hobbs <jeffh@ActiveState.com>
* tests/regexp.test (regexp-20.1):
* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): had to adjust fix from
- 2001-08-06 to actually duplicate the objects in certain cases.
- This is really a place where feather would have been essential.
- [Bug #461322]
+ 2001-08-06 to actually duplicate the objects in certain cases. This is
+ really a place where feather would have been essential. [Bug 461322]
* generic/tclUtf.c (Tcl_UtfPrev): corrected to return the proper
- location when the middle of a UTF-8 byte was passed in.
- [Tk Bug #450504]
+ location when the middle of a UTF-8 byte was passed in [Tk Bug 450504]
* ChangeLog.1999:
* ChangeLog: broke changes from 199x into ChangeLog.1999 to reduce
- size of the main ChangeLog.
+ size of the main ChangeLog.
2001-09-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* tests/ioCmd.test: Changed the computation of the result for
- iocmd-8.1[123] so that the tests work for single- and
- multi-process execution of the testsuite. Depending on the
- choice of the user stdout is a tty or not and thus reports
- different channel options. Fixes [460993] reported by Don
- Porter.
+ iocmd-8.1[123] so that the tests work for single- and multi-process
+ execution of the testsuite. Depending on the choice of the user stdout
+ is a tty or not and thus reports different channel options. Fixes
+ [460993] reported by Don Porter.
2001-09-13 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/ParseCmd.3:
+ * doc/ParseCmd.3:
* generic/tcl.decls:
* generic/tclCmdMZ.c (Tcl_SubstObjCmd):
* generic/tclDecls.h:
* generic/tclParse.c:
* generic/tclStubInit.c:
- * tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced
- by the new Tcl_EvalTokensStandard. The new function performs the
- same duties but adheres to the standard return convention for Tcl
+ * tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced by
+ the new Tcl_EvalTokensStandard. The new function performs the same
+ duties but adheres to the standard return convention for Tcl
evaluations; the deprecated function could only return TCL_OK or
- TCL_ERROR, which caused [Bug 219384] and [Bug 455151].
- This patch implements [TIP 56].
-
+ TCL_ERROR, which caused [Bug 219384] and [Bug 455151]. This patch
+ implements [TIP 56].
+
2001-09-12 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4: Invert the logic that checks for $GCC.
- Instead of checking for "$GCC" = "no" we check for
- "$GCC" != "yes" or simply swap the true and false
- blocks of code in an if statement. That way if
- GCC is set to "" everything will still work. [Bug 460991]
+ * unix/tcl.m4: Invert the logic that checks for $GCC. Instead of
+ checking for "$GCC" = "no" we check for "$GCC" != "yes" or simply swap
+ the true and false blocks of code in an if statement. That way if GCC
+ is set to "" everything will still work. [Bug 460991]
2001-09-12 Don Porter <msofer@users.sourceforge.net>
@@ -1622,8 +1580,8 @@
* tests/lsearch.test:
* tests/namespace.test:
* tests/rename.test:
- * tests/split.test: Corrected tests to better isolate tests in
- one file from influencing tests in other files. [Bug 460591]
+ * tests/split.test: Corrected tests to better isolate tests in one
+ file from influencing tests in other files. [Bug 460591]
2001-09-12 Miguel Sofer <msofer@users.sourceforge.net>
@@ -1633,181 +1591,170 @@
2001-09-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* doc/OpenFileChnl.3: Added documentation for Tcl_WriteRaw and
- Tcl_ReadRaw [#414929].
-
- * doc/CrtChannel.3: Added documentation for Tcl_ChannelBuffered
- and Tcl_GetTopChannel [#414929].
+ Tcl_ReadRaw [Bug 414929].
+
+ * doc/CrtChannel.3: Added documentation for Tcl_ChannelBuffered and
+ Tcl_GetTopChannel [Bug 414929].
- * The changes below are a fix for [219253].
+ * The changes below are a fix for [Bug 219253].
* tests/socket.test: Removed _most_ instances of hardwired port
- numbers for listening sockets. Remaining are the ports in all
- tests with constraint 'doTestsWithRemoteServer'. These seem to
- be designed for a more controlled environment and are usually
- skipped when running the testsuite.
+ numbers for listening sockets. Remaining are the ports in all tests
+ with constraint 'doTestsWithRemoteServer'. These seem to be designed
+ for a more controlled environment and are usually skipped when running
+ the testsuite.
- * tests/io.test: Removed all instances of hardwired port numbers
- for listening sockets.
+ * tests/io.test: Removed all instances of hardwired port numbers for
+ listening sockets.
2001-09-10 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclEvent.c (TclInExit): Corrected handling of tsd in
- late stages of finalization. [Bug #419449] (darley)
+ * generic/tclEvent.c (TclInExit): Corrected handling of tsd in late
+ stages of finalization. [Bug 419449] (darley)
* tests/stack.test:
* generic/tclInterp.c (AliasObjCmd): Check the numLevels to ensure
- that we aren't hitting some alias loop condition. [Bug #443184]
+ that we aren't hitting some alias loop condition. [Bug 443184]
2001-09-10 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't include . characters
- in the Tcl library name when building on FreeBSD 3.X and later
- systems. [Patch 450725]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't include . characters in the
+ Tcl library name when building on FreeBSD 3.X and later systems.
+ [Patch 450725]
2001-09-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* doc/tclsh.1:
- * doc/Tcl_Main.3:
- * doc/CrtChannel.3:
- * doc/OpenFileChnl.3:
+ * doc/Tcl_Main.3:
+ * doc/CrtChannel.3:
+ * doc/OpenFileChnl.3:
* doc/GetStdChan.3: Enhanced the manpages with cross-references to
- the new manpage and more explanations how these functions deal
- with the standard channels in various situations.
+ the new manpage and more explanations how these functions deal with
+ the standard channels in various situations.
- * doc/StdChannels.3: New manpage describing handling of the
- standard channels by the Tcl library [402725].
+ * doc/StdChannels.3: New manpage describing handling of the standard
+ channels by the Tcl library. [Bug 402725]
2001-09-10 Don Porter <dgp@users.sourceforge.net>
- * unix/mkLinks (Tcl_FSLink): Updated to reflect 2001-08-23
- file system changes.
+ * unix/mkLinks (Tcl_FSLink): Updated to reflect 2001-08-23 file system
+ changes.
* unix/tclLoadShl.c: Added #include of tclInt.h; access to Tcl
- internals, notably TclpUnloadFile(), is required. Thanks to
- Bob Techentin for report and patch. [Bug 459305]
+ internals, notably TclpUnloadFile(), is required. Thanks to Bob
+ Techentin for report and patch. [Bug 459305]
* generic/tclInitScript.h (initScript):
* win/tclWinInit.c (TCL_REGISTRY_KEY, TclpSetVariables): Removed
- vestiges of Tcl's old initialization from registry variables.
- [Bug 455645]
+ vestiges of Tcl's old initialization from registry variables. [Bug
+ 455645]
2001-09-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclInt.decls: Also added 'TclWinFlushDirtyChannels' to
- the internal platform specific stub table.
+ * generic/tclInt.decls: Also added 'TclWinFlushDirtyChannels' to the
+ internal platform specific stub table.
* win/tclWinFile.c (TclpObjStat): Now added the call to
- 'TclWinFlushDirtyChannels' to this function. I don't know where
- my head was last thursday (2001-09-06), but the call was
- actually added to 'TclpObjChdir', i.e. the implementation of
- [cd]. Corrected this now. Thanks to Vince Darley for spotting
- this.
+ 'TclWinFlushDirtyChannels' to this function. I don't know where my
+ head was last thursday (2001-09-06), but the call was actually added
+ to 'TclpObjChdir', i.e. the implementation of [cd]. Corrected this
+ now. Thanks to Vince Darley for spotting this.
2001-09-10 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclProc.c:
- * tests/proc.test: made [proc] bytecompile a no-op for procs
- defined with _args_ as single argument and an empty body.
- [FQ 451441]
-
+ * tests/proc.test: made [proc] bytecompile a no-op for procs defined
+ with _args_ as single argument and an empty body. [FRQ 451441]
+
2001-09-09 Mo DeJong <mdejong@users.sourceforge.net>
* unix/Makefile.in:
- * win/Makefile.in: Use () around variable name
- instead of {}. Use TCLTEST variable directly
- instead of depending on the tcltest alias.
+ * win/Makefile.in: Use () around variable name instead of {}. Use
+ TCLTEST variable directly instead of depending on the tcltest alias.
2001-09-09 David Gravereaux <davygrvy@pobox.com>
* generic/tcl.h:
- * generic/tclPlatDecls.h: Reminder from David Cuthbert <dacut@kanga.org>
- that I hadn't finished the Borland compatibility stuff.
- [Patch: 436116]
+ * generic/tclPlatDecls.h: Reminder from David Cuthbert
+ <dacut@kanga.org> that I hadn't finished the Borland compatibility
+ stuff. [Patch 436116]
2001-09-09 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/cmdAH.test: Modify cmdAH-20.5 and cmdAH-24.8
- to display the file atime or mtime results if
- the test fails.
+ * tests/cmdAH.test: Modify cmdAH-20.5 and cmdAH-24.8 to display the
+ file atime or mtime results if the test fails.
2001-09-08 David Gravereaux <davygrvy@pobox.com>
* win/mkd.bat:
- * win/rmd.bat: made these text files, text files again.
- [Patch: 451333]
+ * win/rmd.bat: made these text files, text files again. [Patch 451333]
2001-09-08 Mo DeJong <mdejong@users.sourceforge.net>
* win/mkd.bat:
- * win/rmd.bat:
- Apply binary property (cvs admin -kb) to files and convert
- to CRLF linefeed format to fix the VC++ build. [Bug #219409]
+ * win/rmd.bat: Apply binary property (cvs admin -kb) to files and
+ convert to CRLF linefeed format to fix the VC++ build. [Bug 219409]
2001-09-08 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclInt.h:
+ * generic/tclInt.h:
* generic/tclFCmd.c:
* doc/FileSystem.3:
- * generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback
- to channel copying, since the channels will not have
- access to interpreters and the channel copying currently
- requires an interp. Code which required cross-platform
- copies always has interpreters, so that solves the problem.
- Fixes bug in TclKit.
-
+ * generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback to channel
+ copying, since the channels will not have access to interpreters and
+ the channel copying currently requires an interp. Code which required
+ cross-platform copies always has interpreters, so that solves the
+ problem. Fixes bug in TclKit.
+
2001-09-07 David Gravereaux <davygrvy@pobox.com>
- * win/tcl.m4: Added -link50compat option so a VC6 linker makes
- a VC5 (pre sp3) compatible import library.
- [Bug: 219257]
+ * win/tcl.m4: Added -link50compat option so a VC6 linker makes a VC5
+ (pre sp3) compatible import library. [Bug 219257]
2001-09-07 Mo DeJong <mdejong@users.sourceforge.net>
* win/tclWinThrd.c (TclpThreadExit): Cast status argument to
- _endthreadex to unsigned instead of DWORD to match the Win32
- function prototype.
+ _endthreadex to unsigned instead of DWORD to match the Win32 function
+ prototype.
2001-09-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * All the changes below serve to fix bug [219148] which reports a
- 80x performance hit for file I/O on Win* systems. On my system
- it was closer to a 120x hit. Problem report by Uwe Traum <no
- email address available>.
+ * All the changes below serve to fix bug [219148] which reports a 80x
+ performance hit for file I/O on Win* systems. On my system it was
+ closer to a 120x hit. Problem report by Uwe Traum <no email address
+ available>.
- The fix goes like this: The obstacle is 'FlushFileBuffers',
- executed whenever Tcl writes data to the OS, as Tcl has to wait
- for the disk to complete I/O, and disks are slow. We remove that
- obstacle. This opens another problem, [file size] reports back
- wrong numbers. So for [file size] we add the call back in. As
- optimization we keep track of the channels which were written to
- and flush only these.
+ The fix goes like this: The obstacle is 'FlushFileBuffers', executed
+ whenever Tcl writes data to the OS, as Tcl has to wait for the disk to
+ complete I/O, and disks are slow. We remove that obstacle. This opens
+ another problem, [file size] reports back wrong numbers. So for [file
+ size] we add the call back in. As optimization we keep track of the
+ channels which were written to and flush only these.
* win/tclWinFile.c (TclpObjStat): Added a call to
- 'TclWinFlushDirtyChannels'. This ensures that [file size] and
- related commands report the correct size of a file even if Tcl
- has recently written to it. Unixoid OS's always report the
- correct size even for files with pending data, but Win*
- syssystem don't. They only report what is actually on disk.
+ 'TclWinFlushDirtyChannels'. This ensures that [file size] and related
+ commands report the correct size of a file even if Tcl has recently
+ written to it. Unixoid OS's always report the correct size even for
+ files with pending data, but Win* syssystem don't. They only report
+ what is actually on disk.
- * win/tclWinInt.h: Added declaration of
- 'TclWinFlushDirtyChannels', making it available to other parts
- of the tcl core.
+ * win/tclWinInt.h: Added declaration of 'TclWinFlushDirtyChannels',
+ making it available to other parts of the tcl core.
* win/tclWinChan.c (TclWinFlushDirtyChannels): New, internal,
- procedure. Goes through the list of open file channels and
- forces the OS to flush its file buffers for all which were
- written to since the last call of this function. This is an
- expensive operation as Tcl has to wait for the OS to complete
- actual writes to the disk.
+ procedure. Goes through the list of open file channels and forces the
+ OS to flush its file buffers for all which were written to since the
+ last call of this function. This is an expensive operation as Tcl has
+ to wait for the OS to complete actual writes to the disk.
- (FileInfo): Added dirty flag required by the procedure above.
+ (FileInfo): Added dirty flag required by the procedure above.
- (FileOutputProc): Removed flushing of file buffers, setting the
- dirty flag instead. This means that the previously incurred
- delays do not happen anymore.
+ (FileOutputProc): Removed flushing of file buffers, setting the dirty
+ flag instead. This means that the previously incurred delays do not
+ happen anymore.
- (TclWinOpenFileChannel): Added initialization of 'dirty' flag.
+ (TclWinOpenFileChannel): Added initialization of 'dirty' flag.
2001-09-06 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1815,48 +1762,48 @@
* tests/http.test:
* library/http/pkgIndex.tcl:
* library/http/http.tcl (geturl): correctly get charset parameter
- and convert text according to specified encoding (if known). RFC
- iso8859-1 is used by default. Also recognize Content-encoding to
- see if we should do binary translation. Added a CYA -binary
- switch for the cases that were missed. [Bug #219211 #219399]
+ and convert text according to specified encoding (if known). RFC
+ iso8859-1 is used by default. Also recognize Content-encoding to see
+ if we should do binary translation. Added a CYA -binary switch for the
+ cases that were missed. [Bugs 219211, 219399]
* tests/ioUtil.test: changed to make better use of constraints and
remove knownBug constraints that weren't valid.
2001-09-06 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test (unixInit-3.2): Updated test to support
- newer HP-UX releases that properly report euc-jp as the system
- encoding for Japanese. Bug report and patch verification by Bob
- Techentin. [Bug 453883]
+ * tests/unixInit.test (unixInit-3.2): Updated test to support newer
+ HP-UX releases that properly report euc-jp as the system encoding for
+ Japanese. Bug report and patch verification by Bob Techentin. [Bug
+ 453883]
* doc/http.n:
* library/http/*.tcl:
* tools/tcl.wse.in:
* tools/tclmin.wse:
* unix/Makefile.in:
- * win/{Mm}akefile.*: Updated http package to version 2.4,
- reflecting the new features just added.
+ * win/{Mm}akefile.*: Updated http package to version 2.4, reflecting
+ the new features just added.
2001-09-06 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclTest.c: tests of old-fs hooks no longer cause problems
- in threaded builds. Also removed unused unload proc.
+ * generic/tclTest.c: tests of old-fs hooks no longer cause problems in
+ threaded builds. Also removed unused unload proc.
* generic/tcl.decls:
- * generic/tclIOUtilc: added Tcl_FSMountsChanged so that a vfs
- can inform the filesystem that the filesystem epoch must be
- changed (since cached filesystems may now be incorrect). Fixes
- problem running tclvfs extension.
- * library/tcltest/tcltest.tcl: if tests aren't in a native
- filesystem, then don't use pipes to run them. [Bug 458741]
-
+ * generic/tclIOUtilc: added Tcl_FSMountsChanged so that a vfs can
+ inform the filesystem that the filesystem epoch must be changed (since
+ cached filesystems may now be incorrect). Fixes problem running tclvfs
+ extension.
+ * library/tcltest/tcltest.tcl: if tests aren't in a native filesystem,
+ then don't use pipes to run them. [Bug 458741]
+
2001-09-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tcl.decls (479 generic):
- * generic/tclIO.c (Tcl_Seek,Tcl_Tell,Tcl_OutputBuffered): Added
- public function to return the size of the output buffer and
- reworked other channel functions to use this shared functionality
- and that of Tcl_InputBuffered() too. [TIP#49, Rolf Schroedter]
+ * generic/tcl.decls (479 generic):
+ * generic/tclIO.c (Tcl_Seek,Tcl_Tell,Tcl_OutputBuffered): Added public
+ function to return the size of the output buffer and reworked other
+ channel functions to use this shared functionality and that of
+ Tcl_InputBuffered() too. [TIP#49, Rolf Schroedter]
2001-09-05 David Gravereaux <davygrvy@pobox.com>
@@ -1864,39 +1811,36 @@
support.
* win/tclWinPipe.c:
- * win/tclWinPort.h: More Borland compatibility fixes. Changed
- EDQUOT #define from 49 to 69. Borland had a clash as it was already
- using this number. Upon advice from Helmut Giese, EDQUOT has been
- found in other header files #defined as 69.
- [Patch: 436116]
+ * win/tclWinPort.h: More Borland compatibility fixes. Changed EDQUOT
+ #define from 49 to 69. Borland had a clash as it was already using
+ this number. Upon advice from Helmut Giese, EDQUOT has been found in
+ other header files #defined as 69. [Patch 436116]
* win/.cvsignore: A few more glob patterns added.
* win/makefile.bc (new): Borland lives once more! rejoice..
* generic/tclAlloc.c: Small Borland compatibility fix.
- * win/tclWinTime.c: More Borland compatibility fixes.
- [Patch: 436116]
+ * win/tclWinTime.c: More Borland compatibility fixes. [Patch 436116]
2001-09-05 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/winFCmd.test: made notWin2000 constraint false if not
- running on Windows at all.
-
+ * tests/winFCmd.test: made notWin2000 constraint false if not running
+ on Windows at all.
+
2001-09-04 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinThrd.c: Revisited _beginthreadex() stuff. Instead
- of assuming a c-runtime implimentation of _beginthreadex normal,
- I reversed the logic to not assume, and use when is by explicitly
+ * win/tclWinThrd.c: Revisited _beginthreadex() stuff. Instead of
+ assuming a c-runtime implimentation of _beginthreadex normal, I
+ reversed the logic to not assume, and use when is by explicitly
needing to add runtimes that support it such as Borland.
* generic/tcl.h:
- * generic/tclPlatDecls.h: Borland compatibility change so
- ClientData was properly typed as a void* and TCHAR would not be
- defined twice.
+ * generic/tclPlatDecls.h: Borland compatibility change so ClientData
+ was properly typed as a void* and TCHAR would not be defined twice.
- * generic/tcl.h: Removed a small mistake from before. Changes to
- the EXTERN macro for proper Borland compatibility will have to see
- a TIP. What's this with the MS compiler:
+ * generic/tcl.h: Removed a small mistake from before. Changes to the
+ EXTERN macro for proper Borland compatibility will have to see a TIP.
+ What's this with the MS compiler:
__declspec(dllexport) int func (int a, int b);
@@ -1908,115 +1852,110 @@
2001-09-04 Don Porter <dgp@users.sourceforge.net>
- * compat/strtod.c (strtod): Fixed failure to handle expressions
- like 3eq2 and failure to set errno on overflow. [Bug 440894]
+ * compat/strtod.c (strtod): Fixed failure to handle expressions like
+ 3eq2 and failure to set errno on overflow. [Bug 440894]
2001-09-04 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclProc.c:
- * tests/proc.test: made [proc] check that formal args have
- simple names [Bug 458548]
+ * tests/proc.test: made [proc] check that formal args have simple
+ names. [Bug 458548]
2001-09-04 Vince Darley <vincentdarley@users.sourceforge.net>
- Minor bug fixes in filesystem, plus small vfs changes as a
- result of enabling the test filesystem to work properly.
+ Minor bug fixes in filesystem, plus small vfs changes as a result of
+ enabling the test filesystem to work properly.
* tests/fileName.test: ensure new test cleans up after itself
- * doc/filename.n:
- * generic/tclFileName.c: improved Mac path handling and document
- why [Bug: 421842] on Windows handling of UNC paths is not valid.
- Documentation and code now much clearer on what is and is not a
- UNC path.
+ * doc/filename.n:
+ * generic/tclFileName.c: improved Mac path handling and document why
+ [Bug 421842] on Windows handling of UNC paths is not valid.
+ Documentation and code now much clearer on what is and is not a UNC
+ path.
* doc/FileSystem.3:
* unix/tclUnixPipe.c:
* generic/tclFCmd.c:
- * generic/tclIOUtil.c: fixed error message, fixed [Bug: 453512]
- about dangerous use of tmpnam, replaced with mkstemp.
- Documented all the changes.
- * generic/tclTest.c: made test vfs fully functional as a
- 'reporting filesystem'.
+ * generic/tclIOUtil.c: fixed error message, fixed [Bug 453512] about
+ dangerous use of tmpnam, replaced with mkstemp. Documented all the
+ changes.
+ * generic/tclTest.c: made test vfs fully functional as a 'reporting
+ filesystem'.
* generic/tcl.stubs:
* generic/tcl.h:
- * generic/tclInt.h:
+ * generic/tclInt.h:
* generic/tclIOUtil.c:
* doc/file.n:
- * various platform-specific 'TclpLoadFile': fixed comments about
- unload behaviour, and completed objectification of loading.
- Required change to Tcl_Filesystem lookup table, so incompatible
- with 8.4a3, but not older versions of Tcl. The change also
- allows 'link' and 'reporting' filesystems to function correctly
- when loading files. Implementation of 'file delete -force'
- copes with case where cwd is inside the directory. Moved
- overlooked Tcl_FSGetPathType from internal to external API.
- Made sure filesystems which are registered and then unregistered
- are only freed when all references to them are gone.
+ * various platform-specific 'TclpLoadFile': fixed comments about
+ unload behaviour, and completed objectification of loading. Required
+ change to Tcl_Filesystem lookup table, so incompatible with 8.4a3, but
+ not older versions of Tcl. The change also allows 'link' and
+ 'reporting' filesystems to function correctly when loading files.
+ Implementation of 'file delete -force' copes with case where cwd is
+ inside the directory. Moved overlooked Tcl_FSGetPathType from internal
+ to external API. Made sure filesystems which are registered and then
+ unregistered are only freed when all references to them are gone.
Documented changes.
- * unix/tclUnixFCmd.c: when deleting directories recursively,
- make sure permissions are ok. Together with the above, this
- fixes [Bug: 219139]
- * tests/winFCmd.test: differentiated test results for win2k
- versus not. This fixes [Bug: 219239]
- * tests/fCmd.test: added tests for 'file delete -force' where
- the cwd is inside, and when permissions are inadequate.
-
+ * unix/tclUnixFCmd.c: when deleting directories recursively, make sure
+ permissions are ok. Together with the above, this fixes [Bug 219139]
+ * tests/winFCmd.test: differentiated test results for win2k versus
+ not. This fixes [Bug: 219239]
+ * tests/fCmd.test: added tests for 'file delete -force' where the cwd
+ is inside, and when permissions are inadequate.
+
2001-09-04 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompile.c: fixed incorrect operands for INST_LIST
- [Bug: 458241] (David Cuthbert, dacut@users.sourceforge.net)
+ * generic/tclCompile.c: fixed incorrect operands for INST_LIST [Bug
+ 458241] (David Cuthbert, dacut@users.sourceforge.net)
2001-09-03 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c (TclExecuteByteCode): fixed missing comma
- in debug macro.
+ * generic/tclExecute.c (TclExecuteByteCode): fixed missing comma in
+ debug macro.
2001-09-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/ExprLongObj.3: Fixed error in documentation of argument type
- to Tcl_ExprObj [Bug: 457435]
+ * doc/ExprLongObj.3: Fixed error in documentation of argument type to
+ Tcl_ExprObj [Bug 457435]
2001-09-02 David Gravereaux <davygrvy@pobox.com>
* win/tclWinThrd.c: Portability fix for Cygwin who's c-runtime,
not surprisingly, doesn't have the MSVCRT specific _beginthreadex /
- _endthreadex pair. This might have to be revisited for proper
- Borland, lcc32, Watcom and other support as well.
- [Patch: 444255]
+ _endthreadex pair. This might have to be revisited for proper Borland,
+ lcc32, Watcom and other support as well. [Patch 444255]
* win/tclWinThrd.c: Moved FinalizeConditionEvent() proto to within
the main #ifdef TCL_THREADS block to avoid mingw warning about it
being there but unused.
- * win/makefile.vc: Added -Zl (zee el) to tclStubLib.c compile line
- to make sure the tclstub84.lib static library is built without
- requiring a specific C-runtime library at link-time for the end-use
- developer. It has been noted on c.l.t that this trips many first
- time users trying to make extensions.
- [Patch: 403533]
+ * win/makefile.vc: Added -Zl (zee el) to tclStubLib.c compile line to
+ make sure the tclstub84.lib static library is built without requiring
+ a specific C-runtime library at link-time for the end-use developer.
+ It has been noted on c.l.t that this trips many first time users
+ trying to make extensions. [Patch 403533]
2001-08-31 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclInt.h: added TclCompileListCmd header
* generic/tclBasic.c: added TclCompileListCmd compile proc
- * generic/tclCompCmds.c (TclCompileListCmd): function to compile
- the 'list' command at parse time.
- * generic/tclExecute.c (TclExecuteByteCode): definition of
- INST_LIST bytecode.
+ * generic/tclCompCmds.c (TclCompileListCmd): function to compile the
+ 'list' command at parse time.
+ * generic/tclExecute.c (TclExecuteByteCode): definition of INST_LIST
+ bytecode.
- * doc/StringObj.3: added words of warning to use Tcl_ResetResult
- with the Tcl_Append* functions.
+ * doc/StringObj.3: added words of warning to use Tcl_ResetResult with
+ the Tcl_Append* functions.
* tests/compile.test: added compile-11.* interp result checks
- * generic/tclUtil.c (TclGetIntForIndex): added Tcl_ResetResult
- before Tcl_AppendStringsToObj to prevent shared object crash when
- called from bcc instruction. The Tcl_Append* calls that append to
- the result object that are invoked by bcc insts must remember to
- call Tcl_ResetResult because the bcc doesn't do this for us.
- [Bug #456892]
+ * generic/tclUtil.c (TclGetIntForIndex): added Tcl_ResetResult before
+ Tcl_AppendStringsToObj to prevent shared object crash when called from
+ bcc instruction. The Tcl_Append* calls that append to the result
+ object that are invoked by bcc insts must remember to call
+ Tcl_ResetResult because the bcc doesn't do this for us. [Bug 456892]
2001-08-30 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclIndexObj.c: fixed some casting problems that upset
- Crays. [Bug #419528] (andreasen)
+ * generic/tclIndexObj.c: fixed some casting problems that upset Crays.
+ [Bug 419528] (andreasen)
2001-08-30 Don Porter <dgp@users.sourceforge.net>
@@ -2024,120 +1963,116 @@
2001-08-30 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: allow cached fully-qualified command names
- to be usable from different namespaces within the same interpreter
- without forcing a new lookup. This speeds up scripts that pass
- command names in variables ("this" in some OO packages).
- [Patch 456668].
+ * generic/tclExecute.c: allow cached fully-qualified command names to
+ be usable from different namespaces within the same interpreter
+ without forcing a new lookup. This speeds up scripts that pass command
+ names in variables ("this" in some OO packages). [Patch 456668]
2001-08-30 Vince Darley <vincentdarley@users.sourceforge.net>
- Further fs updates. After examining the most common Tcl
- extensions (TclX, BLT, Tk, TclPro, Mktclapp), it has been
- determined that only TclpGetCwd and the Access/Stat/Open
- insert/delete hooks of the internal fs functions are ever used.
- The remaining functions from Tcl's internal interfaces have
- therefore been removed, since Tcl now exports a more suitable
- public API (Tcl_FS...)
-
+ Further fs updates. After examining the most common Tcl extensions
+ (TclX, BLT, Tk, TclPro, Mktclapp), it has been determined that only
+ TclpGetCwd and the Access/Stat/Open insert/delete hooks of the
+ internal fs functions are ever used. The remaining functions from
+ Tcl's internal interfaces have therefore been removed, since Tcl now
+ exports a more suitable public API (Tcl_FS...)
+
* generic/tclInt.stubs:
- * generic/tclInt.h: updated for removed internal functions.
- Some new internal functions have been put in tclInt.h (and
- not exported in the stub table because good public equivalents
- exist).
- * generic/tclTest.c: some test functions used the internal private
- APIs. These tests have been retained, but modified to use
- public APIs. Also objectified the internal filesystem tests.
- * win/tclWinFile.c: removed TclpStat, TclpAccess and refactored
- code to use NativeAccess, NativeStat. This should speed up
- stat, access and glob commands.
- * win/tclWinFCmd.c: removed all TclpCopy/Rename/Delete
- File/Directory string-based procedures which aren't used any more.
- Improved efficiency of some other procedures. Ensure that filename
- conversions with a NULL interp do not crash Tcl.
+ * generic/tclInt.h: updated for removed internal functions. Some new
+ internal functions have been put in tclInt.h (and not exported in the
+ stub table because good public equivalents exist).
+ * generic/tclTest.c: some test functions used the internal private
+ APIs. These tests have been retained, but modified to use public APIs.
+ Also objectified the internal filesystem tests.
+ * win/tclWinFile.c: removed TclpStat, TclpAccess and refactored code
+ to use NativeAccess, NativeStat. This should speed up stat, access and
+ glob commands.
+ * win/tclWinFCmd.c: removed all TclpCopy/Rename/Delete File/Directory
+ string-based procedures which aren't used any more. Improved
+ efficiency of some other procedures. Ensure that filename conversions
+ with a NULL interp do not crash Tcl.
* mac/tclMacFCmd.c: wrapped long lines and cleaned up
- TclpObjNormalizePath, removed all TclpCopy/Rename/Delete
+ TclpObjNormalizePath, removed all TclpCopy/Rename/Delete
File/Directory string-based procedures which aren't used any more.
* mac/tclMacFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir,
etc.
* unix/tclUnixFCmd.c: removed use of TclpAccess, removed all
TclpCopy/Rename/Delete File/Directory string-based procedures which
aren't used any more.
- * unix/tclUnixFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir,
- etc.
+ * unix/tclUnixFile.c: removed obsolete TclpStat, TclpAccess,
+ TclpChdir, etc.
* tcl(Unix|Mac|Win)Chan.c: objectified TclpOpenFileChannel.
* various 'load' implementations all objectified.
* generic/tclFileName.c: removed redundant code.
* generic/tclIOUtil.c: removed TclStat, TclAccess, TclpListVolumes.
- Fix to MatchInDirectory at the root of a volume. Also improved
- some documentation, and improved default path joining behaviour
- for virtual filesystems, especially regarding '~'.
+ Fix to MatchInDirectory at the root of a volume. Also improved some
+ documentation, and improved default path joining behaviour for virtual
+ filesystems, especially regarding '~'.
* tests/fileName.test: added tests to check for bugs fixed above.
* doc/FileName.3: improved documentation
-
+
2001-08-30 David Gravereaux <davygrvy@pobox.com>
* generic/tclAsync.c:
* generic/tclEvent.c:
* generic/tclInt.h: Improper cleanup of asyncMutex in tclAsync.c
- repaired. TclFinalizeSynchronization() was trying to remove a
- registered mutex that was dumped earlier when the TSD it was stored
- in was cleared. This was only surfacing on *nix. Windows was being
- masked by mutexes not actually being returned to the system! That
- was repaired in a previous patch. Needed to add a private
+ repaired. TclFinalizeSynchronization() was trying to remove a
+ registered mutex that was dumped earlier when the TSD it was stored in
+ was cleared. This was only surfacing on *nix. Windows was being masked
+ by mutexes not actually being returned to the system! That was
+ repaired in a previous patch. Needed to add a private
TclFinalizeAsync() to tclAsync.c and called from Tcl_FinalizeThread().
- Pheww.. Is this done yet?
- [Bug: 414419] requested by Rob Ratcliff <rrr6399@futuretek.com>
+ Pheww.. Is this done yet? [Bug 414419] requested by Rob Ratcliff
+ <rrr6399@futuretek.com>
2001-08-28 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclCompCmds.c (TclPushVarName): noted 'static' defn.
- [Bug #453872]
+ [Bug 453872]
2001-08-26 Don Porter <dgp@users.sourceforge.net>
* library/auto.tcl (tcl_findLibrary):
* tests/unixInit.test (unixInit-2.{1,9}):
* unix/tclUnixInit.c (TclpInitLibraryPath):
- * win/tclWinInit.c (TclpInitLibraryPath): Corrected
- inconsistency between the search path for script libraries and
- the directory name $DISTNAME into which distributions built
- by 'make test' unpack. [Bug 455642]
+ * win/tclWinInit.c (TclpInitLibraryPath): Corrected inconsistency
+ between the search path for script libraries and the directory name
+ $DISTNAME into which distributions built by 'make test' unpack. [Bug
+ 455642]
2001-08-24 Jeff Hobbs <jeffh@ActiveState.com>
* tests/stringComp.test: added string-1.3
* generic/tclCompCmds.c (TclCompileStringCmd): changed to return
TCL_OUT_LINE_COMPILE instead of TCL_ERROR when compiling and an
- unknown string method is called. This is necessary as the string
+ unknown string method is called. This is necessary as the string
command may be never called, or not until 'string' is redefined.
2001-08-24 Vince Darley <vincentdarley@users.sourceforge.net>
* doc/glob.n: documented windows-style path issue with glob.
- [Bug: 219392]
+ [Bug 219392]
* doc/filename.n: documented windows path/file length limitation.
- [Bug: 454597]
+ [Bug 454597]
2001-08-24 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test (unixInit-2.9): Corrected expected result
- to match Tcl's quirky construction of its init library path.
+ * tests/unixInit.test (unixInit-2.9): Corrected expected result to
+ match Tcl's quirky construction of its init library path.
2001-08-23 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/tclWinPipe.c (BuildCommandLine): Fixed tcl Bug
- [432499]. Part of the code used the non-absolute path to the
- executable to determine quoting. This failed if the absolute
- path contained spaces, but the application name itself not. This
- bug caused no trouble on Win NT 5, but does for other variants
- in the Win* family. Report and fix due to Ken Poole
- <kenpoole@users.sourceforge.net>.
+ * win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 432499]. Part of the
+ code used the non-absolute path to the executable to determine
+ quoting. This failed if the absolute path contained spaces, but the
+ application name itself not. This bug caused no trouble on Win NT 5,
+ but does for other variants in the Win* family. Report and fix due to
+ Ken Poole <kenpoole@users.sourceforge.net>.
2001-08-23 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure:
- * unix/tcl.m4: added QNX-6 build support. [Bug #219410] (loverso)
+ * unix/tcl.m4: added QNX-6 build support. [Bug 219410] (loverso)
* unix/tclUnixFCmd.c:
* generic/tclIOUtil.c:
@@ -2145,97 +2080,93 @@
2001-08-23 Vince Darley <vincentdarley@users.sourceforge.net>
- Variety of small filesystem and vfs issues fixed or improved.
- The new fs code allows many new opportunities for efficiency
- improvements through the objectified API. The main changes
- integrated here are such efficiency improvements. Some
- limitations of the original implementation have also now been
- lifted. Meanwhile a variety of fs bugs (some old, some new)
- have also been fixed.
-
- * generic/tclFileName.c: Made Tcl_FSSplitPath more efficient,
- and removed some static string-based procedures which are no
- longer used. Much more objectification. Tcl_FSJoinPath
- is now very efficient and more aware of virtual filesystems.
- Clarified where the Mac-specific code attempts to interpret
- Unix-style paths. Modified TclDoGlob to use lstat not
- access to fix [Bug: 434876, L. Virden]
+ Variety of small filesystem and vfs issues fixed or improved. The new
+ fs code allows many new opportunities for efficiency improvements
+ through the objectified API. The main changes integrated here are such
+ efficiency improvements. Some limitations of the original
+ implementation have also now been lifted. Meanwhile a variety of fs
+ bugs (some old, some new) have also been fixed.
+
+ * generic/tclFileName.c: Made Tcl_FSSplitPath more efficient, and
+ removed some static string-based procedures which are no longer used.
+ Much more objectification. Tcl_FSJoinPath is now very efficient and
+ more aware of virtual filesystems. Clarified where the Mac-specific
+ code attempts to interpret Unix-style paths. Modified TclDoGlob to use
+ lstat not access to fix [Bug 434876] (L. Virden)
+
* tcl(Win|Unix|Mac)FCmd.c:
* tcl(Win|Unix|Mac)File.c: replaced TclpListVolumes with
- TclpObjListVolumes with different signature, updated code due
- to more efficient signature of Tcl_FSGetTranslatedPath. Used
- cached native paths where possible to improve efficiency --
- this was completed on MacOS, but on Unix and Win the traversal
- functions make the task much more complex, so there are still
- some improvements possible there. Removed unused
- TclpNormalizePath which had been left in tclWinFCmd.c.
- Objectified all 'file attributes' functions. Fixed the new
- [Bug:451571, Bruce Stephens] which is most obvious on Unix,
- but could occur on MacOS or Windows. This bug actually existed
- in Tcl 8.3.x but was only made obvious by the recent filesystem
- overhaul when the code was exercised more heavily.
- * tests/fileName.test: Three new tests to exercise the above bug,
- and make sure it is fixed correctly.
- * unix/tclUnixFile.c: avoid panic in glob when a link
- doesn't point anywhere. It would probably be good to define
- exactly what Tcl should do in circumstances like these, and
- make sure mac/win/unix all behave accordingly. [Bug: 417111,
- Hemang Lavana]. Also fixed misleading/obsolete comment in the code.
- * generic/tcl.stubs: changed signature of Tcl_FSGetTranslatedPath
- and added Tcl_FSGetTranslatedStringPath.
+ TclpObjListVolumes with different signature, updated code due to more
+ efficient signature of Tcl_FSGetTranslatedPath. Used cached native
+ paths where possible to improve efficiency -- this was completed on
+ MacOS, but on Unix and Win the traversal functions make the task much
+ more complex, so there are still some improvements possible there.
+ Removed unused TclpNormalizePath which had been left in tclWinFCmd.c.
+ Objectified all 'file attributes' functions. Fixed the new [Bug
+ 451571, Bruce Stephens] which is most obvious on Unix, but could occur
+ on MacOS or Windows. This bug actually existed in Tcl 8.3.x but was
+ only made obvious by the recent filesystem overhaul when the code was
+ exercised more heavily.
+ * tests/fileName.test: Three new tests to exercise the above bug, and
+ make sure it is fixed correctly.
+ * unix/tclUnixFile.c: avoid panic in glob when a link doesn't point
+ anywhere. It would probably be good to define exactly what Tcl should
+ do in circumstances like these, and make sure mac/win/unix all behave
+ accordingly. [Bug 417111] (Hemang Lavana). Also fixed
+ misleading/obsolete comment in the code.
+ * generic/tcl.stubs: changed signature of Tcl_FSGetTranslatedPath and
+ added Tcl_FSGetTranslatedStringPath.
These changes allow further optimisations in the FS code.
- * generic/tcl.h: changed signature of Tcl_FSListVolumes so that
- it doesn't require a Tcl interpreter plus result. Renamed
- Tcl_FSReadLink to Tcl_FSLink with additional argument so
- we can support making links in the future. [Patch: 450340]
- * generic/tclInt.h:
- added declaration for TclpObjListVolumes. Objectified
- internal call signatures for 'file attributes' functions, and
- added an internal objectified get path type function.
- * generic/tclIOUtil.c: added the moved function TclpListVolumes
- which calls platform specific code (needed for backwards
- compatibility), and improved efficiency of parts of the FS
- (particularly file normalization). Much less copying and
- memory allocation is required now. added new GetPathType
- so that changes in 'file volumes' can actually affect files'
- types, and objectified more code. Made current code work
- with test suite artificially changing current platform.
+ * generic/tcl.h: changed signature of Tcl_FSListVolumes so that it
+ doesn't require a Tcl interpreter plus result. Renamed Tcl_FSReadLink
+ to Tcl_FSLink with additional argument so we can support making links
+ in the future. [Patch: 450340]
+ * generic/tclInt.h: added declaration for TclpObjListVolumes.
+ Objectified internal call signatures for 'file attributes' functions,
+ and added an internal objectified get path type function.
+ * generic/tclIOUtil.c: added the moved function TclpListVolumes which
+ calls platform specific code (needed for backwards compatibility), and
+ improved efficiency of parts of the FS (particularly file
+ normalization). Much less copying and memory allocation is required
+ now. added new GetPathType so that changes in 'file volumes' can
+ actually affect files' types, and objectified more code. Made current
+ code work with test suite artificially changing current platform.
Added 'static' keywords where required.
* generic/tclIO.c:
- * generic/tclTest.c: Added 'static' keywords, fixing
- [Bug: 453872, Bob Techentin]
- * generic/tclCmdAH.c: file command implementation updated for
- API changes, removed unnecessary special-case SplitPath static
- function, since it no longer helps prevent code duplication.
- Moved setting of interpreter result to each individual location
- that actually required it, to avoid very large code separation
- between reading and setting the result.
- * doc/FileSystem.3: updated documentation for the new or
- changed APIs, and clarified some issues.
+ * generic/tclTest.c: Added 'static' keywords, fixing [Bug 453872] (Bob
+ Techentin)
+ * generic/tclCmdAH.c: file command implementation updated for API
+ changes, removed unnecessary special-case SplitPath static function,
+ since it no longer helps prevent code duplication. Moved setting of
+ interpreter result to each individual location that actually required
+ it, to avoid very large code separation between reading and setting
+ the result.
+ * doc/FileSystem.3: updated documentation for the new or changed APIs,
+ and clarified some issues.
* doc/SplitPath.3: added pointer to newer APIs in FileSystem.3
- * doc/filename.n: clarified current implementation of tilde
- support on Mac/Win. [Bug:453514, Sergey Kuzmin]
- * doc/glob.n: improved documentation for '-directory' and '-path'
+ * doc/filename.n: clarified current implementation of tilde support on
+ Mac/Win. [Bug 453514] (Sergey Kuzmin)
+ * doc/glob.n: improved documentation for '-directory' and '-path'
options.
-
- There are now many private, obsolete, platform-specific 'Tclp'
- string-based filesystem APIs which could be removed. We should
- check whether any of these are used by extensions and, at least
- in Tcl 9, remove them.
-
- The above changes signify a ***POTENTIAL INCOMPATIBILITY***
- with 8.4a3, since signatures of two functions in the new API
- have changed, but not with older versions of Tcl.
+
+ There are now many private, obsolete, platform-specific 'Tclp'
+ string-based filesystem APIs which could be removed. We should check
+ whether any of these are used by extensions and, at least in Tcl 9,
+ remove them.
+
+ The above changes signify a ***POTENTIAL INCOMPATIBILITY*** with
+ 8.4a3, since signatures of two functions in the new API have changed,
+ but not with older versions of Tcl.
2001-08-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclBinary.c (FormatNumber): Extract a long from the
- object and not an int, to stop [binary format] from being unable
- to format some input numbers on architectures where sizeof(int) is
- less than sizeof(long) (particularly Alpha.) [tiprender Bug #441861]
+ * generic/tclBinary.c (FormatNumber): Extract a long from the object
+ and not an int, to stop [binary format] from being unable to format
+ some input numbers on architectures where sizeof(int) is less than
+ sizeof(long) (particularly Alpha). [tiprender Bug 441861]
- * tests/format.test: Converted conditional execution of tests into
- a test constraint.
+ * tests/format.test: Converted conditional execution of tests into a
+ test constraint.
2001-08-22 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2243,90 +2174,88 @@
* win/makefile.vc: updated install target for dde1.2
* doc/dde.n: fixed dde man page (which was totally incorrect).
* tests/winDde.test:
- * win/tclWinDde.c (Tcl_DdeObjCmd): added -binary option to dde
- request command to allow for returning binary data. [Bug #227482]
+ * win/tclWinDde.c (Tcl_DdeObjCmd): added -binary option to dde request
+ command to allow for returning binary data. [Bug 227482]
Updated dde to 1.2
- * tests/tcltest.test: added unixExecs constraint to files that
- used 'grep' in the test. [Bug #453143]
+ * tests/tcltest.test: added unixExecs constraint to files that used
+ 'grep' in the test. [Bug 453143]
+
+ * library/tcltest/tcltest.tcl: fixed stdio constraint test. [Patch
+ 454050] (stanton)
+ Simplified unixExecs constraint test.
- * library/tcltest/tcltest.tcl: fixed stdio constraint test.
- [Patch #454050] (stanton)
- Simplified unixExecs constraint test.
-
2001-08-22 Don Porter <dgp@users.sourceforge.net>
- * tests/ioUtil.test (ioUtil-3.*): Corrected errors in tests
- revealed by fix of overagressive compiler. [Bug 451200]
+ * tests/ioUtil.test (ioUtil-3.*): Corrected errors in tests revealed
+ by fix of overagressive compiler. [Bug 451200]
2001-08-21 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCompCmds.c:
- * tests/compile.test: Fixed overagressive compilation of [catch]:
- it was catching errors at substitution time. [Bug #219184]
-
+ * tests/compile.test: Fixed overagressive compilation of [catch]: it
+ was catching errors at substitution time. [Bug 219184]
+
2001-08-21 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/tcltest.test (tcltest-12.2): fixed test that would break
- when env vars weren't Tcl list friendly [Patch #454046] (stanton)
+ * tests/tcltest.test (tcltest-12.2): fixed test that would break when
+ env vars weren't Tcl list friendly [Patch 454046] (stanton)
2001-08-20 Jeff Hobbs <jeffh@ActiveState.com>
- * library/http/http.tcl (geturl): added port number to Host:
- header to comply with HTTP/1.1 spec (RFC 2068). [Bug #452217]
+ * library/http/http.tcl (geturl): added port number to Host: header to
+ comply with HTTP/1.1 spec (RFC 2068). [Bug 452217]
2001-08-16 David Gravereaux <davygrvy@pobox.com>
* tools/tcl.wse.in:
* tools/tcl.hpj.in:
* win/tcl.hpj.in: Removed -kb storage in CVS to ensure these text
- files are checked-out in the translation mode CVS is in. Setting
- these as binary as part of an effort to make sure they are always
- in CRLF, no matter what the CVS translation, is bypassing how CVS
- works and is confusing.
+ files are checked-out in the translation mode CVS is in. Setting these
+ as binary as part of an effort to make sure they are always in CRLF,
+ no matter what the CVS translation, is bypassing how CVS works and is
+ confusing.
- * tools/genStubs.tcl: Removed LF-only output. Having to reconvert
- back to CRLF before committing to CVS was giving me a headache.
- [Bug: 451333]
+ * tools/genStubs.tcl: Removed LF-only output. Having to reconvert
+ back to CRLF before committing to CVS was giving me a headache. [Bug
+ 451333]
* win/makefile.vc: replaced $(WINDIR) with $(include32) for the
- .rc.res inference rule. winver.h wasn't getting included.
- [Bug: 445630]
+ .rc.res inference rule. winver.h wasn't getting included. [Bug 445630]
2001-08-14 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c: make the intial maxNestingDepth of an
- interpreter be MAX_NESTING_DEPTH instead of a hardwired value
- [Bug: 232564]
+ interpreter be MAX_NESTING_DEPTH instead of a hardwired value. [Bug
+ 232564]
2001-08-13 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/trace.test: Corrected test numbers [Bug: 449794]
+ * tests/trace.test: Corrected test numbers. [Bug 449794]
2001-08-12 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
* unix/configure.in:
- * unix/tcl.m4: Use GCC variable set by AC_PROG_CC instead
- of defining our own using_gcc variable.
+ * unix/tcl.m4: Use GCC variable set by AC_PROG_CC instead of defining
+ our own using_gcc variable.
2001-08-11 Vince Darley <vincentdarley@users.sourceforge.net>
Variety of small issues introduced by the vfs code fixed:
* generic/tclIOUtil.c: uninitialised read.
- * generic/tclFCmd.c: possible memory leak in file delete
- with error condition.
+ * generic/tclFCmd.c: possible memory leak in file delete with error
+ condition.
2001-08-10 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c:
+ * generic/tclVar.c:
* tests/trace.test: Insure that [array] traces work correctly for
- undefined variables [Bug: 449094]
+ undefined variables. [Bug 449094]
2001-08-09 Mo DeJong <mdejong@redhat.com>
- * unix/Makefile.in: Delete the unused getcwd.o
- target. This fixes bug #440942.
+ * unix/Makefile.in: Delete the unused getcwd.o target. [Bug 440942]
2001-08-08 Don Porter <dgp@users.sourceforge.net>
@@ -2340,8 +2269,8 @@
* library/reg/pkgIndex.tcl:
* library/tcltest/tcltest.tcl:
* library/tcltest/pkgIndex.tcl: Added checks for package dependencies.
- Bumped patchlevels of changed packages: http 2.3.2, msgcat 1.2.2,
- opt 0.4.3, tcltest 2.0.1. [Patch 448931]
+ Bumped patchlevels of changed packages: http 2.3.2, msgcat 1.2.2,
+ opt 0.4.3, tcltest 2.0.1. [Patch 448931]
* README:
* generic/tcl.h:
@@ -2351,9 +2280,9 @@
* unix/tcl.spec:
* win/README.binary:
* win/configure:
- * win/configure.in: Bumped up patchlevel to 8.4a4 to distinguish
- CVS snapshots from the 8.4a3 release. This does not necessarily
- mean there will be an 8.4a4 release. [Bug 448938].
+ * win/configure.in: Bumped up patchlevel to 8.4a4 to distinguish CVS
+ snapshots from the 8.4a3 release. This does not necessarily mean there
+ will be an 8.4a4 release. [Bug 448938]
2001-08-06 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2361,64 +2290,63 @@
* changes:
* README:
- * mac/README:
+ * mac/README:
* unix/README:
* win/README.binary: updated for 8.4a3 release
- * generic/tclFileName.c (Tcl_FSSplitPath): update to Tcl style
- guide.
+ * generic/tclFileName.c (Tcl_FSSplitPath): update to Tcl style guide.
- * generic/tclFCmd.c (FileCopyRename): fixed mem leak in
- introduction of vfs code where a new Tcl_Obj wasn't freed.
+ * generic/tclFCmd.c (FileCopyRename): fixed mem leak in introduction
+ of vfs code where a new Tcl_Obj wasn't freed.
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd):
- reordered the retrieval of arguments to avoid shimmering bug when
- the pattern and string referenced the same object.
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): reordered
+ the retrieval of arguments to avoid shimmering bug when the pattern
+ and string referenced the same object.
* unix/configure: regenerated
- * unix/tcl.m4: added GNU (HURD) configuration target. (brinkmann)
- [Patch: #442974]
+ * unixE/tcl.m4: added GNU (HURD) configuration target.
+ [Patch 442974] (brinkmann)
* win/README: made note of URL for Windows compilation notes
- * win/tclWinThrd.c (TclpFinalizeMutex, TclpFinalizeCondition):
- added DeleteCriticalSection calls for cleanup [Patch: #419683]
+ * win/tclWinThrd.c (TclpFinalizeMutex, TclpFinalizeCondition): added
+ DeleteCriticalSection calls for cleanup [Patch 419683]
* unix/tclUnixPipe.c (TclpCreateTempFile): fixed use of tmpnam,
- which is dangerous. [Patch: #442636] (lim)
+ which is dangerous. [Patch 442636] (lim)
The use of tmpnam in TclpTempFileName must still be changed.
* tests/http.test (http-4.14): fixed variable error return.
- [Bug: 424252]
+ [Bug 424252]
2001-08-03 Jeff Hobbs <jeffh@ActiveState.com>
* win/configure: regenerated
* win/tcl.m4: fixed DLLSUFFIX definition to always be ${DBGX}.dll.
- This is necessary for TEA compliant builds that build shared
- against a static-built Tcl.
+ This is necessary for TEA compliant builds that build shared against a
+ static-built Tcl.
* win/Makefile.in ($(TCLSH)): added $(TCL_STUB_LIB_FILE) to build
target, otherwise it wouldn't get generated in a static build.
2001-08-06 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIOCmd.c (Tcl_GetsObjCmd): Applied patch from SF item
- [442665] to fix the bug reported by it. The function can corrupt
- a freed object if it is called with objc == 3. This is because
- it retrieves resultPtr and does not increment its reference
- count, but then calls Tcl_ObjSetVar2, which causes the retrieved
- resultPtr object to be released.
-
+ * generic/tclIOCmd.c (Tcl_GetsObjCmd): Applied patch from [Bug 442665]
+ to fix the bug reported by it. The function can corrupt a freed object
+ if it is called with objc == 3. This is because it retrieves resultPtr
+ and does not increment its reference count, but then calls
+ Tcl_ObjSetVar2, which causes the retrieved resultPtr object to be
+ released.
+
2001-08-06 Don Porter <dgp@users.sourceforge.net>
- * doc/tclsh.1: Added note that the tclsh program is frequently
- installed with the Tcl version numer as part of the name.
- [Patch 402725]
+ * doc/tclsh.1: Added note that the tclsh program is frequently
+ installed with the Tcl version numer as part of the name. [Patch
+ 402725]
* generic/tclPkg.c:
- * tests/pkg.test: [package forget] now forgets all of the
- package arguments it receives, not stopping when a package is
- not found. [Bug 415273]
+ * tests/pkg.test: [package forget] now forgets all of the package
+ arguments it receives, not stopping when a package is not found. [Bug
+ 415273]
2001-08-02 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2428,141 +2356,133 @@
2001-08-02 Mo DeJong <mdejong@redhat.com>
* generic/tclPlatDecls.h:
- * win/tclWinPort.h:
- Revert <tchar.h> related changes made to improve
- Cygwin support on 2001-07-18. This change ended
- up breaking the VC++ build because of conflicts
- between Windows APIs and internal Tk APIs.
+ * win/tclWinPort.h: Revert <tchar.h> related changes made to improve
+ Cygwin support on 2001-07-18. This change ended up breaking the VC++
+ build because of conflicts between Windows APIs and internal Tk APIs.
2001-08-01 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tclUnixFCmd.c: minor casts to eliminate warnings. (lim)
- [Patch: #440218]
+ [Patch 440218]
- * tests/parseOld.test: changed some tests that required
- testwordend to exist to skip in a proper tcltest manner.
- [Bug: #442663]
+ * tests/parseOld.test: changed some tests that required testwordend to
+ exist to skip in a proper tcltest manner. [Bug 442663]
- * library/http/http.tcl (http::mapReply): the regsub'ing of \n and
- \t to escape them was unnecessary.
+ * library/http/http.tcl (http::mapReply): the regsub'ing of \n and \t
+ to escape them was unnecessary.
2001-07-31 Vince Darley <vincentdarley@users.sourceforge.net>
Changes from TIP#17 "Redo Tcl's filesystem"
The following files were impacted:
- * doc/Access.3:
- * doc/FileSystem.3:
- * doc/OpenFileChnl.3:
- * doc/file.n:
- * doc/glob.n:
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclCmdAH.c:
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclDate.c:
- * generic/tclDecls.h:
- * generic/tclEncoding.c:
- * generic/tclFCmd.c:
- * generic/tclFileName.c:
- * generic/tclGetDate.y:
- * generic/tclIO.c:
- * generic/tclIOCmd.c:
- * generic/tclIOUtil.c:
- * generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclLoad.c:
- * generic/tclStubInit.c:
- * generic/tclTest.c:
- * generic/tclUtil.c:
- * library/init.tcl:
- * mac/tclMacFCmd.c:
- * mac/tclMacFile.c:
- * mac/tclMacInit.c:
- * mac/tclMacPort.h:
- * mac/tclMacResource.c:
- * mac/tclMacTime.c:
- * tests/cmdAH.test:
- * tests/event.test:
- * tests/fCmd.test:
- * tests/fileName.test:
- * tests/io.test:
- * tests/ioCmd.test:
- * tests/proc-old.test:
- * tests/registry.test:
- * tests/unixFCmd.test:
- * tests/winDde.test:
- * tests/winFCmd.test:
- * unix/mkLinks:
- * unix/tclUnixFCmd.c:
- * unix/tclUnixFile.c:
- * unix/tclUnixInit.c:
- * unix/tclUnixPipe.c:
- * win/tclWinFCmd.c:
- * win/tclWinFile.c:
- * win/tclWinInit.c:
- * win/tclWinPipe.c
+ * doc/Access.3:
+ * doc/FileSystem.3:
+ * doc/OpenFileChnl.3:
+ * doc/file.n:
+ * doc/glob.n:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclDate.c:
+ * generic/tclDecls.h:
+ * generic/tclEncoding.c:
+ * generic/tclFCmd.c:
+ * generic/tclFileName.c:
+ * generic/tclGetDate.y:
+ * generic/tclIO.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclLoad.c:
+ * generic/tclStubInit.c:
+ * generic/tclTest.c:
+ * generic/tclUtil.c:
+ * library/init.tcl:
+ * mac/tclMacFCmd.c:
+ * mac/tclMacFile.c:
+ * mac/tclMacInit.c:
+ * mac/tclMacPort.h:
+ * mac/tclMacResource.c:
+ * mac/tclMacTime.c:
+ * tests/cmdAH.test:
+ * tests/event.test:
+ * tests/fCmd.test:
+ * tests/fileName.test:
+ * tests/io.test:
+ * tests/ioCmd.test:
+ * tests/proc-old.test:
+ * tests/registry.test:
+ * tests/unixFCmd.test:
+ * tests/winDde.test:
+ * tests/winFCmd.test:
+ * unix/mkLinks:
+ * unix/tclUnixFCmd.c:
+ * unix/tclUnixFile.c:
+ * unix/tclUnixInit.c:
+ * unix/tclUnixPipe.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+ * win/tclWinInit.c:
+ * win/tclWinPipe.c:
2001-07-24 Mo DeJong <mdejong@redhat.com>
- * win/tclWinThrd.c (Tcl_CreateThread): Close Windows
- HANDLE returned by _beginthreadex. The MS documentation
- states that this handle is not closed by a later call to
- _endthreadex.
+ * win/tclWinThrd.c (Tcl_CreateThread): Close Windows HANDLE returned
+ by _beginthreadex. The MS documentation states that this handle is not
+ closed by a later call to _endthreadex.
2001-07-21 Don Porter <dgp@users.sourceforge.net>
* doc/pkgMkindex.n:
- * library/package.tcl: Corrected documentation and usage
- message of [pkg_mkIndex].
+ * library/package.tcl: Corrected documentation and usage message of
+ [pkg_mkIndex].
2001-07-18 Mo DeJong <mdejong@redhat.com>
- * generic/tclPlatDecls.h: Define TCHAR by including
- windows.h instead of tchar.h since Cygwin does not
- support the tchar.h header. Include CHECK_UNICODE_CALLS
- logic from tclWinPort.h.
- * win/tclWinPort.h: Remove CHECK_UNICODE_CALLS logic.
- Remove include of windows.h since this now done it
- tclPlatDecls.h.
+ * generic/tclPlatDecls.h: Define TCHAR by including windows.h instead
+ of tchar.h since Cygwin does not support the tchar.h header. Include
+ CHECK_UNICODE_CALLS logic from tclWinPort.h.
+ * win/tclWinPort.h: Remove CHECK_UNICODE_CALLS logic. Remove include
+ of windows.h since this now done it tclPlatDecls.h.
* win/tclWinReg.c: Remove duplicate include of windows.h.
2001-07-18 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIO.c: Aftermath to [SF #427196]. Squash empty buffers
- if they are smaller than the requested buffersize, to prevent
- reusage of old buffers and to honor changes in the requested
- buffersize made by the user.
+ * generic/tclIO.c: Aftermath to [Bug 427196]. Squash empty buffers if
+ they are smaller than the requested buffersize, to prevent reusage of
+ old buffers and to honor changes in the requested buffersize made by
+ the user.
2001-07-17 Mo DeJong <mdejong@redhat.com>
- * win/tclWinFile.c (TclpReadlink): Add Cygwin specific definition
- for the TclpReadlink function. This method implements reading of
- symbolic links when build with Cygwin.
+ * win/tclWinFile.c (TclpReadlink): Add Cygwin specific definition for
+ the TclpReadlink function. This method implements reading of symbolic
+ links when build with Cygwin.
2001-07-17 Mo DeJong <mdejong@redhat.com>
- * win/tclWinPort.h: Add Cygwin specific defines for environ
- and timezone variables.
+ * win/tclWinPort.h: Add Cygwin specific defines for environ and
+ timezone variables.
2001-07-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIO.c (GetInput): Fixed [SF #427196]. Memory was
- overwritten because a buffer was used after a change of the
- requested buffersize together with that requested buffersize and
- not its actual size, which was smaller. Note that the continous
- reuse of the smaller buffer negatively impacts performance. The
- system never allocates a buffer with the newly requested bigger
- buffersize.
+ * generic/tclIO.c (GetInput): Fixed [Bug 427196]. Memory was
+ overwritten because a buffer was used after a change of the requested
+ buffersize together with that requested buffersize and not its actual
+ size, which was smaller. Note that the continous reuse of the smaller
+ buffer negatively impacts performance. The system never allocates a
+ buffer with the newly requested bigger buffersize.
2001-07-16 Mo DeJong <mdejong@redhat.com>
- * generic/tcl.h: Define __WIN32__ when
- __CYGWIN__ or __MINGW32__ is defined.
- * generic/tclAlloc.c: Define caddr_t when
- compiling with VC++ or mingw. This type is
- already defined when compiling with Cygwin.
+ * generic/tcl.h: Define __WIN32__ when __CYGWIN__ or __MINGW32__ is
+ defined.
+ * generic/tclAlloc.c: Define caddr_t when compiling with VC++ or
+ mingw. This type is already defined when compiling with Cygwin.
2001-07-16 Mo DeJong <mdejong@redhat.com>
@@ -2571,9 +2491,9 @@
* win/tclWinPort.h:
* win/tclWinSerial.c:
* win/tclWinThrd.c:
- Remove unnecessary #includes of dos.h, direct.h,
- and tchar.h. This will help the Cygwin porting
- effort since these headers do not exist under Cygwin.
+ Remove unnecessary #includes of dos.h, direct.h, and tchar.h. This
+ will help the Cygwin porting effort since these headers do not exist
+ under Cygwin.
2001-07-16 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2581,74 +2501,70 @@
just the TerminateThread call and waiting for termination. (jsmith)
* generic/tclCmdMZ.c: Removed extra copy of the SCAN_* macros
- #defined in generic/tclScan.c. (porter) [Bug 441230]
+ #defined in generic/tclScan.c. [Bug 441230] (porter)
2001-07-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/unixInit.test (unixInit-2.8): Added extra constraint,
- notInstalledInTmp, to stop this test from damaging installations
- in /tmp; not much fun to have to reinstall the Tcl library every
- time you run the test suite!
+ notInstalledInTmp, to stop this test from damaging installations in
+ /tmp; not much fun to have to reinstall the Tcl library every time you
+ run the test suite!
- * tests/subst.test (subst-10.*): Updated tests to check new
- behaviour for 'break' in command substitutions.
+ * tests/subst.test (subst-10.*): Updated tests to check new behaviour
+ for 'break' in command substitutions.
(subst-1.2,subst-7.1): Error messages changed.
* doc/SubstObj.3: New file, to document Tcl_SubstObj.
- * doc/subst.n: Improved and updated documentation for 'subst' to
- help support the changed behaviour.
+ * doc/subst.n: Improved and updated documentation for 'subst' to help
+ support the changed behaviour.
* generic/tcl.decls (generic-437): Declaration for Tcl_SubstObj
* generic/tcl.h (TCL_SUBST_*): Added flags for Tcl_SubstObj.
- * generic/tclCmdMZ.c (Tcl_SubstObj,Tcl_SubstObjCmd): Divided into
- two parts to allow people to access the innards of 'subst' and
- changed the behaviour when command substitutions do a 'break' to
- be different from 'continue'. Also now works with objects, which
- allows for some nifty optimisations with variable substitutions
- and a slight improvement with command substitutions. [TIP#36]
+ * generic/tclCmdMZ.c (Tcl_SubstObj,Tcl_SubstObjCmd): Divided into two
+ parts to allow people to access the innards of 'subst' and changed the
+ behaviour when command substitutions do a 'break' to be different from
+ 'continue'. Also now works with objects, which allows for some nifty
+ optimisations with variable substitutions and a slight improvement
+ with command substitutions. [TIP#36]
2001-07-10 Mo DeJong <mdejong@redhat.com>
* unix/Makefile.in: Add AR variable for use in STLIB_LD.
* unix/configure: Regen.
- * unix/configure.in: Use STLIB_LD when defining MAKE_LIB
- and MAKE_STUB_LIB. Subst RANLIB and AR.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add doc comment about
- STLIB_LD command. Check ${AR} env var when setting
- STLIB_LD and delay evaluation until make time.
+ * unix/configure.in: Use STLIB_LD when defining MAKE_LIB and
+ MAKE_STUB_LIB. Subst RANLIB and AR.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add doc comment about STLIB_LD
+ command. Check ${AR} env var when setting STLIB_LD and delay
+ evaluation until make time.
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Delay evaluation of
- ${AR} in STLIB_LD and add flags to better match the
- Unix implementation. Don't bother defining AR when
- using VC++ since it is not used.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Delay evaluation of ${AR} in STLIB_LD
+ and add flags to better match the Unix implementation. Don't bother
+ defining AR when using VC++ since it is not used.
2001-07-06 Mo DeJong <mdejong@redhat.com>
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass -e _WinMain@16 in
- addition to the -mwindows flag to work around a problem
- with ld when it incorrectly use main() as the executable
- entry point when both WinMain() and main() are available.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass -e _WinMain@16 in addition to
+ the -mwindows flag to work around a problem with ld when it
+ incorrectly use main() as the executable entry point when both
+ WinMain() and main() are available.
2001-07-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/cmdAH.test: Added leading zero to file modes to work
- around fault in HPUX strtol() which ignores the base parameter
- [Bug #438808]
+ * tests/cmdAH.test: Added leading zero to file modes to work around
+ fault in HPUX strtol() which ignores the base parameter. [Bug 438808]
2001-07-05 Mo DeJong <mdejong@redhat.com>
- * win/Makefile.in: Subst DEPARG directly instead
- of relying on a variable. This will make Cygwin
- builds faster since an extra exec will be avoided.
+ * win/Makefile.in: Subst DEPARG directly instead of relying on a
+ variable. This will make Cygwin builds faster since an extra exec will
+ be avoided.
* win/configure: Regen.
* win/configure.in: Subst DEPARG.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Move AC_MSG_CHECKING
- after the AC_CHECK_PROG so that status messages do
- not get mixed together. Set DEPARG based on the
- results of the cygpath check so that we avoid using
- an extra exec when it is not needed. Use ac_cv_cygwin
- status flag instead of looking at the output of
- gcc -v, which works in the case where -mno-cygwin is
- set in the CFLAGS.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Move AC_MSG_CHECKING after the
+ AC_CHECK_PROG so that status messages do not get mixed together. Set
+ DEPARG based on the results of the cygpath check so that we avoid
+ using an extra exec when it is not needed. Use ac_cv_cygwin status
+ flag instead of looking at the output of gcc -v, which works in the
+ case where -mno-cygwin is set in the CFLAGS.
2001-07-04 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2663,32 +2579,30 @@
* win/Makefile.in: Remove PATHTYPE variable.
* win/configure: Regen.
* win/configure.in: Don't subst PATHTYPE.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE
- variable. Set CYGPATH to "cygpath -w" if the
- cygpath executable is found on the path. This
- approach works for native Cygwin builds and
- cross compiles.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE variable. Set CYGPATH
+ to "cygpath -w" if the cygpath executable is found on the path. This
+ approach works for native Cygwin builds and cross compiles.
2001-07-03 Jeff Hobbs <jeffh@ActiveState.com>
* tests/var.test:
* generic/tclVar.c (Tcl_VariableObjCmd): added patch to check for
- number of args. [Patch #426038]
+ number of args. [Patch 426038]
* generic/tclVar.c (Tcl_GetVar2Ex): added ability to recognize
- TCL_TRACE_READS flags to cause creation of part1 in TclLookupVar
- to make sure newly created array will get read traces triggered
- appropriately. This is called by Tcl_ObjGetVar2, Tcl_GetVar, and
+ TCL_TRACE_READS flags to cause creation of part1 in TclLookupVar to
+ make sure newly created array will get read traces triggered
+ appropriately. This is called by Tcl_ObjGetVar2, Tcl_GetVar, and
Tcl_GetVar2.
- (TclSetIndexedScalar, TclSetElementOfIndexedArray): added read
- trace triggering for lappend case.
- (Tcl_LappendObjCmd): pass TCL_TRACE_READS to Tcl_ObjGetVar2 to
- trigger possible read traces for new arrays.
+ (TclSetIndexedScalar, TclSetElementOfIndexedArray): added read trace
+ triggering for lappend case.
+ (Tcl_LappendObjCmd): pass TCL_TRACE_READS to Tcl_ObjGetVar2 to trigger
+ possible read traces for new arrays.
* generic/tclExecute.c (TclExecuteByteCode): added TCL_TRACE_READS
- flag to INST_LAPPEND(_ARRAY)_STK case to trigger read traces for
- newly created arrays. Removed unnecessary #ifdef for
- TCL_COMPILE_DEBUG in INST_LOAD_SCALAR1 case.
+ flag to INST_LAPPEND(_ARRAY)_STK case to trigger read traces for newly
+ created arrays. Removed unnecessary #ifdef for TCL_COMPILE_DEBUG in
+ INST_LOAD_SCALAR1 case.
* tests/append.test:
* tests/appendComp.test: added tests for read trace triggering for
@@ -2696,98 +2610,96 @@
2001-07-03 Mo DeJong <mdejong@redhat.com>
- * tests/clock.test (clock-2.5): Adjust test so that it passes
- when the time slice is 60 msecs, now passes under Windows 98.
+ * tests/clock.test (clock-2.5): Adjust test so that it passes when the
+ time slice is 60 msecs, now passes under Windows 98.
2001-07-03 Mo DeJong <mdejong@redhat.com>
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass the v flag
- to ${AR} when using gcc, verbose output is not needed.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass the v flag to ${AR} when
+ using gcc, verbose output is not needed.
2001-07-03 Don Porter <dgp@users.sourceforge.net>
* tests/unixInit.test (unixInit-2.8): Changed test back to using
- installation layout, adding comments explaining why the test writes
- to the directories it does, and checks to avoid destroying other
- files in /tmp.
+ installation layout, adding comments explaining why the test writes to
+ the directories it does, and checks to avoid destroying other files in
+ /tmp.
2001-07-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/unixInit.test (unixInit-1.2): Fixed faults reported in
- Bug#438070 - well, at least enough to work on Solaris - and added
+ [Bug 438070] - well, at least enough to work on Solaris - and added
comments that should make what is going on in the test clearer.
2001-07-02 Jeff Hobbs <jeffh@ActiveState.com>
* tests/util.test: added util-4.6
- * generic/tclUtil.c (Tcl_ConcatObj): Corrected walking backwards
- over utf-8 chars. [Bug #227512]
+ * generic/tclUtil.c (Tcl_ConcatObj): Corrected walking backwards over
+ utf-8 chars. [Bug 227512]
2001-07-02 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test (unixInit-2.8): Corrected test for all
- absolute pathnames in library path when executable is installed
- near root directory to use correct development directory layout.
- [Bug 438014]
+ * tests/unixInit.test (unixInit-2.8): Corrected test for all absolute
+ pathnames in library path when executable is installed near root
+ directory to use correct development directory layout. [Bug 438014]
- * tests/unixInit.test (unixInit-2.9):
+ * tests/unixInit.test (unixInit-2.9):
* unix/tclUnixInit.c (TclpInitLibraryPath):
* win/tclWinInit.c (TclpInitLibraryPath): Corrected buggy
- construction of search path entries relative to executable.
- Added test for bad construction. [Bug 438014]
+ construction of search path entries relative to executable. Added test
+ for bad construction. [Bug 438014]
2001-06-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclNamesp.c: Correction to faulty patch from [Bug: 231259]
+ * generic/tclNamesp.c: Correction to faulty patch from [Bug 231259]
2001-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/unixInit.test (unixInit-1.2): Modified so as not to
- require a local echo service, which fails on many systems which
- have that turned off for security reasons...
+ * tests/unixInit.test (unixInit-1.2): Modified so as not to require a
+ local echo service, which fails on many systems which have that turned
+ off for security reasons...
2001-06-27 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclInt.h:
* generic/tclObj.c:
* unix/Makefile.in: added a -DPURIFY mode that makes Tcl_Obj's
- allocated and free singularly (instead of in alloc in blocks and
- never free) to allow checkers like Purify to operate better.
+ allocated and free singularly (instead of in alloc in blocks and never
+ free) to allow checkers like Purify to operate better.
* library/encoding/koi8-u.enc: added koi8-u (Ukranian variant)
encoding.
* tests/subst.test:
- * generic/tclUtf.c (Tcl_UtfBackslash): Corrected backslash
- handling of multibyte utf-8 chars. [Bug #217987]
+ * generic/tclUtf.c (Tcl_UtfBackslash): Corrected backslash handling of
+ multibyte utf-8 chars. [Bug 217987]
- * generic/tclCmdIL.c (InfoProcsCmd): fixed potential mem leak in
- info procs that created objects without using them.
+ * generic/tclCmdIL.c (InfoProcsCmd): fixed potential mem leak in info
+ procs that created objects without using them.
* generic/tclCompCmds.c (TclCompileStringCmd): fixed mem leak when
string command failed to parse the subcommand.
* doc/interp.n:
- * doc/unknown.n: updated notes about what is in a safe interp.
- [Bug #218605]
+ * doc/unknown.n: updated notes about what is in a safe interp. [Bug
+ 218605]
2001-06-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/event.test (event-11.5): Removed hard-coded port number
- which could fail on some systems. [Bug #436727]
+ * tests/event.test (event-11.5): Removed hard-coded port number which
+ could fail on some systems. [Bug 436727]
2001-06-26 Mo DeJong <mdejong@redhat.com>
* unix/Makefile.in:
- * win/Makefile.in: Add `make shell` target. This target
- will set the proper env vars before invoking tclsh
- from the build directory.
+ * win/Makefile.in: Add `make shell` target. This target will set the
+ proper env vars before invoking tclsh from the build directory.
2001-06-26 Mo DeJong <mdejong@redhat.com>
- * win/Makefile.in: Use : to separate VPATH entries. This
- works for both Cygwin builds and cross builds, the VPSEP
- variable is simply unneeded complexity.
+ * win/Makefile.in: Use : to separate VPATH entries. This works for
+ both Cygwin builds and cross builds, the VPSEP variable is simply
+ unneeded complexity.
* win/configure: Regen.
* win/configure.in: Don't subst VPSEP.
* win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP variable.
@@ -2795,17 +2707,17 @@
2001-06-26 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
- * unix/configure.in: Fix last checkin by removing
- export since that only works in bash.
+ * unix/configure.in: Fix last checkin by removing export since that
+ only works in bash.
* win/configure: Regen.
* win/configure.in: Ditto.
2001-06-26 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
- * unix/configure.in: Set CFLAGS to "" if the user
- did not set CFLAGS in the env. This keeps AC_PROG_CC
- from adding "-g -O2" to the CFLAGS by default.
+ * unix/configure.in: Set CFLAGS to "" if the user did not set CFLAGS
+ in the env. This keeps AC_PROG_CC from adding "-g -O2" to the CFLAGS
+ by default.
* win/configure: Regen.
* win/configure.in: Ditto.
@@ -2813,28 +2725,27 @@
* win/configure: Regen.
* win/configure.in: Use RC_DEFINE flag from tcl.m4.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set RC_DEFINE
- flag based on the compiler in use.
-
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set RC_DEFINE flag based on the
+ compiler in use.
+
2001-06-25 Mo DeJong <mdejong@redhat.com>
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the
- imm32 library when building with mingw gcc.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the imm32 library when
+ building with mingw gcc.
2001-06-25 Mo DeJong <mdejong@redhat.com>
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): When building with
- gcc, don't attempt to link with LD or support dllwrap.
- Simply require a recent version of Cygwin gcc or Mingw
- gcc that supports -shared. When linking, use gcc instead
- of ld since gcc automatically includes libs like -lmsvcrt.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): When building with gcc, don't attempt
+ to link with LD or support dllwrap. Simply require a recent version of
+ Cygwin gcc or Mingw gcc that supports -shared. When linking, use gcc
+ instead of ld since gcc automatically includes libs like -lmsvcrt.
2001-06-22 Mo DeJong <mdejong@redhat.com>
* win/configure: Regen.
- * win/configure.in: Add resource compiler fix from
- 8.3.3 to fix compiling with mingw.
+ * win/configure.in: Add resource compiler fix from 8.3.3 to fix
+ compiling with mingw.
2001-06-22 Mo DeJong <mdejong@redhat.com>
@@ -2843,63 +2754,61 @@
2001-06-22 Mo DeJong <mdejong@redhat.com>
- * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
- Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG
- and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works.
- This will support user set CFLAGS or LDFLAGS at configure time.
+ * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set
+ LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG and
+ LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works. This will
+ support user set CFLAGS or LDFLAGS at configure time.
* unix/configure: Regen.
* unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead
- subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEFAULT,
- LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE.
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that
- it uses a Makefile variable just like CFLAGS_DEFAULT.
- * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
- Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@.
- This will support user set CFLAGS or LDFLAGS at configure time.
+ subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for
+ CFLAGS_DEFAULT, LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE.
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it
+ uses a Makefile variable just like CFLAGS_DEFAULT.
+ * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set
+ LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. This will support user set
+ CFLAGS or LDFLAGS at configure time.
* win/configure: Regen.
* win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst
CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile.
- * win/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that
- it uses a Makefile variable just like CFLAGS_DEFAULT.
+ * win/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it
+ uses a Makefile variable just like CFLAGS_DEFAULT.
2001-06-22 Mo DeJong <mdejong@redhat.com>
* win/configure:
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't set LDFLAGS_DEBUG
- to -g or LDFLAGS_OPTIMIZE to -O when compiling with gcc.
- These flags are not needed and can cause problems with
- the Cygwin version of ld.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't set LDFLAGS_DEBUG to -g or
+ LDFLAGS_OPTIMIZE to -O when compiling with gcc. These flags are not
+ needed and can cause problems with the Cygwin version of ld.
2001-06-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/unixInit.test (unixInit-1.2,unixInit-2.8): Added test for
- code described below, and fixed a couple of errors that caused
- problems during testing; the code to determine the installedTcl
- constraint was wrong, and test unixInit-2.8 assumed that /tmp/lib
- was free for use and could be deleted, which clashed nastily with
- my installation and made other tests fail unnecessarily!
+ * tests/unixInit.test (unixInit-1.2,unixInit-2.8): Added test for code
+ described below, and fixed a couple of errors that caused problems
+ during testing; the code to determine the installedTcl constraint was
+ wrong, and test unixInit-2.8 assumed that /tmp/lib was free for use
+ and could be deleted, which clashed nastily with my installation and
+ made other tests fail unnecessarily!
* unix/tclUnixChan.c (TtyInit,TclpOpenFileChannel,
- Tcl_MakeFileChannel,TclpGetDefaultStdChannel): Alterations so that
- the standard channels - stdin, stdout and stderr - have the
- correct type and fconfigure options. This required making the
- initialisation of serial lines a little more sophisticated to
- make the console behave correctly in interactive mode... [Bug
- #219137 and duplicates]
+ (Tcl_MakeFileChannel,TclpGetDefaultStdChannel): Alterations so that
+ the standard channels - stdin, stdout and stderr - have the correct
+ type and fconfigure options. This required making the initialisation
+ of serial lines a little more sophisticated to make the console behave
+ correctly in interactive mode... [Bug 219137 and duplicates]
2001-06-16 Don Porter <dgp@users.sourceforge.net>
* generic/tclInt.decls:
- * generic/tclInt.h:
+ * generic/tclInt.h:
* generic/tclPanic.c (Tcl_PanicVA):
* mac/tclMacAppInit.c (main):
* mac/tclMacPanic.c (TclpPanic):
* unix/tclUnixPort.h:
- * win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic
- for setting a platform-specific panic handler. TclpPanic
- is NULL on Unix and Windows. Fixes broken wish on Mac due
- to earlier patches. [Patch 415648]
-
+ * win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic for setting
+ a platform-specific panic handler. TclpPanic is NULL on Unix and
+ Windows. Fixes broken wish on Mac due to earlier patches. [Patch
+ 415648]
+
* generic/tclIntPlatDecls.h:
* generic/tclStubInit.c: `make gentubs` after above changes.
@@ -2912,9 +2821,9 @@
2001-06-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/regexp.test (regexp-18.12):
+ * tests/regexp.test (regexp-18.12):
* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): Fixed so that submatches
- that do not match always have index pair {-1 -1} [Bug #219232]
+ that do not match always have index pair {-1 -1} [Bug 219232]
2001-06-08 Don Porter <dgp@users.sourceforge.net>
@@ -2927,11 +2836,10 @@
* mac/tclMacAppInit.c (main):
* mac/tclMacBOAAppInit.c (main):
* mac/tclMacPanic.c: Modified special Mac implementations of
- Tcl_*Panic* to be exact copies of the generic implementations.
- Added TclMacSetPanic. The generic implementations should be
- used directly, rather than copies, but that requires further
- changes by someone familiar with the Mac build systems.
- [Patch 415648]
+ Tcl_*Panic* to be exact copies of the generic implementations. Added
+ TclMacSetPanic. The generic implementations should be used directly,
+ rather than copies, but that requires further changes by someone
+ familiar with the Mac build systems. [Patch 415648]
* generic/tclDecls.h:
* generic/tclIntPlatDecls.h:
@@ -2939,24 +2847,24 @@
* doc/Panic.3:
* unix/mkLinks: New file documenting Tcl_*Panic* public interfaces,
- followed by `make mklinks`. [Patch 415648, Bug 219170, Bug 414936]
+ followed by `make mklinks`. [Patch 415648, Bug 219170, Bug 414936]
2001-06-03 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclUtil.c (Tcl_DStringAppendElement): patch to save an
- extra strlen call. [Bug #428572]
+ extra strlen call. [Bug 428572]
2001-05-30 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclExecute.c (TclExecuteByteCode): Added two casts to
- INST_STR_CMP implementation to get rid of a couple warnings from
- the SUNWspro C compiler.
-
- * generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs):
- * generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd):
- * generic/tcl.decls (generic table, positions 435+436):
- * tests/info.test:
- * doc/CrtMathFnc.3:
+ INST_STR_CMP implementation to get rid of a couple warnings from the
+ SUNWspro C compiler.
+
+ * generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs):
+ * generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd):
+ * generic/tcl.decls (generic table, positions 435+436):
+ * tests/info.test:
+ * doc/CrtMathFnc.3:
* doc/info.n: Changes due to TIP #15 "Functions to List and Detail
Math Functions"
@@ -2968,32 +2876,31 @@
* generic/regc_locale.c: updated character class range data for
Unicode v3.1.0 compliance.
- * generic/tclUniData.c: regenerated from Unicode v3.1.0 data file
- (new as of 2001-05-16). This brings Tcl to current unicode
- compliance.
+ * generic/tclUniData.c: regenerated from Unicode v3.1.0 data file (new
+ as of 2001-05-16). This brings Tcl to current unicode compliance.
* tests/utf.test: added tests to check unicode 3 compliance
* unix/Makefile.in (tclUtf.o): added tclUniData.c dependency.
- * tools/uniClass.tcl: added comments to output format and the
- script for clarification.
+ * tools/uniClass.tcl: added comments to output format and the script
+ for clarification.
- * tools/uniParse.tcl: corrected filename output and GetDelta macro
- to use 'info' as param (was 'infO')
+ * tools/uniParse.tcl: corrected filename output and GetDelta macro to
+ use 'info' as param (was 'infO')
2001-05-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclVar.c (tclArraySearchType,SetArraySearchObj,
- ParseSearchId): Added code to speed up array searching by reducing
+ (ParseSearchId): Added code to speed up array searching by reducing
the amount of parsing needed for searchIds.
- * generic/tclObj.c (TclInitObjSubsystem):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
- * generic/tclNamesp.c (TclInitNamespaceSubsystem):
+ * generic/tclObj.c (TclInitObjSubsystem):
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
+ * generic/tclNamesp.c (TclInitNamespaceSubsystem):
* generic/tclInt.h: Moved some Tcl_ObjType initialisation to
- TclInitObjSubsystem to be with the bulk of the rest.
- [Patch 424851] Committed by Miguel Sofer <mig@utdt.edu>
+ TclInitObjSubsystem to be with the bulk of the rest. [Patch 424851]
+ Committed by Miguel Sofer <mig@utdt.edu>
2001-05-23 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3015,31 +2922,29 @@
* library/encoding/iso8859-8.enc:
* library/encoding/iso8859-10.enc (new):
* library/encoding/iso8859-13.enc (new):
- * library/encoding/iso8859-14.enc (new): updated encoding tables
- based on http://www.unicode.org/Public/MAPPINGS/. (kuhn)
+ * library/encoding/iso8859-14.enc (new): updated encoding tables based
+ on http://www.unicode.org/Public/MAPPINGS/. (kuhn)
2001-05-23 Mo DeJong <mdejong@redhat.com>
- * unix/tcl.m4 (SC_PATH_TCLCONFIG): Fix comments,
- and typo in cached variable name.
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG): Fix comments, and typo in cached
+ variable name.
2001-05-23 Mo DeJong <mdejong@redhat.com>
- * unix/tcl.m4 (SC_LOAD_TKCONFIG):
- Remove use of undefined TCLCONFIG variable and
- call AC_MSG_RESULT to print the checking result.
+ * unix/tcl.m4 (SC_LOAD_TKCONFIG): Remove use of undefined TCLCONFIG
+ variable and call AC_MSG_RESULT to print the checking result.
* win/tcl.m4: Ditto.
2001-05-22 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclObj.c (TclAllocateFreeObjects): simplified
- objSizePlusPadding to use sizeof(Tcl_Obj) (max)
- Corrected use of tclObjsAlloced/Freed/Shared in TCL_MEM_DEBUG
- compile.
+ objSizePlusPadding to use sizeof(Tcl_Obj) (max) Corrected use of
+ tclObjsAlloced/Freed/Shared in TCL_MEM_DEBUG compile.
2001-05-22 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: removed Tcl_DuplicateObj in INST_DUP
+ * generic/tclExecute.c: removed Tcl_DuplicateObj in INST_DUP
2001-05-21 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3047,13 +2952,13 @@
getting affected by Windows env handling of empty valued elements.
* unix/tcl.m4: added more common install directories in which to
- search for *Config.sh [Bug #419812]
+ search for *Config.sh. [Bug 419812]
- * tests/cmdMZ.test (cmdMZ-1.4): added notLinux constraint to test
- to prevent failure message on Linux due to OS caching bug.
+ * tests/cmdMZ.test (cmdMZ-1.4): added notLinux constraint to test to
+ prevent failure message on Linux due to OS caching bug.
- * tests/httpd (httpdRespond): added response to timeout value in
- query string.
+ * tests/httpd (httpdRespond): added response to timeout value in query
+ string.
* tests/http.test: removed unused notLinux constraint setting
@@ -3063,61 +2968,58 @@
2001-05-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* Note that "tclbench" (see project "tcllib") was extended with
- performance benchmarks for [fcopy] too.
+ performance benchmarks for [fcopy] too.
* doc/fcopy.n: Updated to reflect the extended behaviour of 'fcopy'.
- * tests/io.test: Added tests 'io-52.9', 'io-52.10' and 'io-52.11'
- to test the handling of encodings by 'fcopy' / 'TclCopychannel'
- [Bug #209210].
+ * tests/io.test: Added tests 'io-52.9', 'io-52.10' and 'io-52.11' to
+ test the handling of encodings by 'fcopy' / 'TclCopychannel'. [Bug
+ 209210]
- * generic/tclIO.c: Split of both 'Tcl_ReadChars' and
- 'Tcl_WriteChars' into a public error checking and an internal
- working part. The public functions now use the new internal
- ones. The new functions are 'DoReadChars' and 'DoWriteChars'.
- Extended 'CopyData' to use the new functions 'DoXChars' when
- required by the encodings on the input and output channels
- [Bug #209210].
+ * generic/tclIO.c: Split of both 'Tcl_ReadChars' and 'Tcl_WriteChars'
+ into a public error checking and an internal working part. The public
+ functions now use the new internal ones. The new functions are
+ 'DoReadChars' and 'DoWriteChars'. Extended 'CopyData' to use the new
+ functions 'DoXChars' when required by the encodings on the input and
+ output channels. [Bug 209210]
2001-05-16 Jeff Hobbs <jeffh@ActiveState.com>
- * library/history.tcl (tcl::HistAdd): prevent empty calls from
- being added to the history (arndt)
+ * library/history.tcl (tcl::HistAdd): prevent empty calls from being
+ added to the history (arndt)
- * tests/error.test: updated error-1.3 message to account for
- string index being compiled at toplevel.
+ * tests/error.test: updated error-1.3 message to account for string
+ index being compiled at toplevel.
* tests/appendComp.test:
* tests/stringComp.test: new files for extended bytecode testing
* generic/tclBasic.c: added new CompileProc invocations to basic
command initialization.
* generic/tclCompCmds.c: added new compile commands for append,
- lappend, lindex and llength. Refactored set and incr compile
- commands to use new TclPushVarName function for handling the
- varname component during compilation (also used by append and
- lappend). Changed string compile command to compile toplevel code
- as well (when possible).
+ lappend, lindex and llength. Refactored set and incr compile commands
+ to use new TclPushVarName function for handling the varname component
+ during compilation (also used by append and lappend). Changed string
+ compile command to compile toplevel code as well (when possible).
* generic/tclCompile.c: added new instruction enums
* generic/tclCompile.h: added debug info for new instructions
- * generic/tclExecute.c (TclExecuteByteCode): moved elemPtr to
- toplevel var (oft-used). Added definitions for new bytecode
- instructions INST_LIST_INDEX, INST_LIST_LENGTH, INST_APPEND_SCALAR1,
+ * generic/tclExecute.c (TclExecuteByteCode): moved elemPtr to toplevel
+ var (oft-used). Added definitions for new bytecode instructions
+ INST_LIST_INDEX, INST_LIST_LENGTH, INST_APPEND_SCALAR1,
INST_APPEND_SCALAR4, INST_APPEND_ARRAY1, INST_APPEND_ARRAY4,
INST_APPEND_ARRAY_STK, INST_APPEND_STK, INST_LAPPEND_SCALAR1,
INST_LAPPEND_SCALAR4, INST_LAPPEND_ARRAY1, INST_LAPPEND_ARRAY4,
INST_LAPPEND_ARRAY_STK, INST_LAPPEND_STK.
Refactored repititious code for reuse with INST_LOAD_STK (same as
- INST_LOAD_SCALAR_STK), INST_STORE_STK (same as
- INST_STORE_SCALAR_STK).
+ INST_LOAD_SCALAR_STK), INST_STORE_STK (same as INST_STORE_SCALAR_STK).
Updated INST_STR_CMP with style of fix of 2001-04-06 Fellows
- [Bug #219201] as that fix only affected the runtime eval'ed
- "string" (string compare is normally byte-compiled now). We
- may want to back these out for speed in the future, noting the
- problems with \x00 comparisons in the docs.
+ [Bug 219201] as that fix only affected the runtime eval'ed "string"
+ (string compare is normally byte-compiled now). We may want to back
+ these out for speed in the future, noting the problems with \x00
+ comparisons in the docs.
* generic/tclInt.h: declarations for new compile commands.
* generic/tclVar.c: change TclGetIndexedScalar,
TclGetElementOfIndexedArray, TclSetElementOfIndexedArray and
- TclSetIndexedScalar to use flags. The Set functions now support
+ TclSetIndexedScalar to use flags. The Set functions now support
TCL_APPEND_ELEMENT and TCL_LIST_ELEMENT as well.
* generic/tclInt.decls:
* generic/tclIntDecls.h: minor signature changes for above.
@@ -3126,7 +3028,7 @@
2001-05-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/console.n: Deleted. Put it in the wrong source tree! D'oh!
+ * doc/console.n: Deleted. Put it in the wrong source tree! D'oh!
2001-05-15 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3136,8 +3038,8 @@
* generic/tclStringObj.c (Tcl_GetUnicodeFromObj): new function to
parallel Tcl_GetStringFromObj (fix of an API oversight).
- * unix/tclUnixPipe.c: updated pipeChannelType to
- TCL_CHANNEL_VERSION_2 type specification.
+ * unix/tclUnixPipe.c: updated pipeChannelType to TCL_CHANNEL_VERSION_2
+ type specification.
* tests/fileName.test: corrected tests not to fail on win when a
C:/test dir exists.
@@ -3146,82 +3048,80 @@
2001-05-15 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/lindex.test: added test for nested braces [Patch: 423617]
+ * tests/lindex.test: added test for nested braces [Patch 423617]
2001-05-15 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclInt.h
- * generic/tclNamesp.c: invalidate all bytecodes in a namespace if
- a new command shadows a bytecoded command.
- * tests/namespace.test
- Patched from [Bug: 231259]
+ * generic/tclInt.h:
+ * generic/tclNamesp.c: invalidate all bytecodes in a namespace if a
+ new command shadows a bytecoded command.
+ * tests/namespace.test:
+ Patched from [Bug 231259]
2001-05-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/console.n: Created. It seems very odd to me that the
- console implementation is part of the Tcl distribution and not
- part of Tk, but given the location of the source, the
- documentation must obviously match up...
+ * doc/console.n: Created. It seems very odd to me that the console
+ implementation is part of the Tcl distribution and not part of Tk, but
+ given the location of the source, the documentation must obviously
+ match up...
2001-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdMZ.c (Tcl_StringObjCmd):
- * tests/string.test (string-4.14): Negative string indices should
- not be added as offsets to the result of [string first] but
- instead be treated as referring to the start of the string.
- [Bug: 423581]
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * tests/string.test (string-4.14): Negative string indices should not
+ be added as offsets to the result of [string first] but instead be
+ treated as referring to the start of the string. [Bug 423581]
2001-05-11 Mo DeJong <mdejong@redhat.com>
- * unix/Makefile.in: Add a LDFLAGS variable to the
- Makefile instead of directly substing @LDFLAGS@.
+ * unix/Makefile.in: Add a LDFLAGS variable to the Makefile instead of
+ directly substing @LDFLAGS@.
* unix/configure: Regen.
- * unix/tcl.m4: Fix CFLAGS_DEFAULT so that the name
- of a Makefile variable is passed as @CFLAGS@.
- * win/Makefile.in: Move the setting of CFLAGS
- higher up in the Makefile.
+ * unix/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile
+ variable is passed as @CFLAGS@.
+ * win/Makefile.in: Move the setting of CFLAGS higher up in the
+ Makefile.
* win/configure: Regen.
- * win/configure.in: Use dnl to comment out macros
- so that they are not accidently expanded.
- * win/tcl.m4: Fix CFLAGS_DEFAULT so that the name
- of a Makefile variable is passed as @CFLAGS@.
+ * win/configure.in: Use dnl to comment out macros so that they are not
+ accidently expanded.
+ * win/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile
+ variable is passed as @CFLAGS@.
2001-05-07 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c: insure different rand() seeds in different
- threads [Bug 416643]
+ threads. [Bug 416643]
2001-05-03 Jeff Hobbs <jeffh@ActiveState.com>
* tests/tcltest.test: removed extraneous 'c' (doh!) [Bug: 414031]
- * tools/tcltk-man2html.tcl: removed use of 'exec' for portability
- and fixed up code.
+ * tools/tcltk-man2html.tcl: removed use of 'exec' for portability and
+ fixed up code.
2001-05-03 Don Porter <dgp@users.sourceforge.net>
* doc/library.n:
* library/init.tcl:
- * tests/autoMkindex.t*: Modified [auto_import] to apply
- pattern matching in the [namespace import] style. [Bug 420186]
- ***POTENTIAL INCOMPATIBILITY*** for any callers of [auto_import]
- from outside Tcl that expect the pattern matching to be like that
- of [string match].
+ * tests/autoMkindex.t*: Modified [auto_import] to apply pattern
+ matching in the [namespace import] style. [Bug 420186]
+ ***POTENTIAL INCOMPATIBILITY*** for any callers of [auto_import] from
+ outside Tcl that expect the pattern matching to be like that of
+ [string match].
2001-05-03 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclParse.c:
- * tests/namespace.test: Insure consistent behaviour of the
- [unknown] command: when a command is unknown, it is always
- processed by [::unknown], ignoring any namespace proc which
- happens to be called "unknown" [Patch #421166, Bug #420507]
+ * generic/tclParse.c:
+ * tests/namespace.test: Insure consistent behaviour of the [unknown]
+ command: when a command is unknown, it is always processed by
+ [::unknown], ignoring any namespace proc which happens to be called
+ "unknown" [Patch 421166, Bug 420507]
2001-05-02 Don Porter <dgp@users.sourceforge.net>
- * tools/genStubs.tcl: Add a package require of Tcl 8
- at the beginning of the script so that the script
- will print a descriptive error message when run
- in an old Tcl 7 shell.
+ * tools/genStubs.tcl: Add a package require of Tcl 8 at the beginning
+ of the script so that the script will print a descriptive error
+ message when run in an old Tcl 7 shell.
2001-04-27 Kevin Kenny <kennykb@crd.ge.com>
@@ -3229,10 +3129,10 @@
* generic/tclInt.h:
* generic/tclCmdIL.c:
* generic/tclProc.c:
- * generic/tclVar.c: Added another collection of missing CONSTs
- related to TclGetNamespaceForQualName.
+ * generic/tclVar.c: Added another collection of missing CONSTs related
+ to TclGetNamespaceForQualName.
* generic/tclIntDecls.h: Regenerated.
-
+
2001-04-25 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
@@ -3245,9 +3145,9 @@
2001-04-25 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
- * unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB
- commands instead of using a delayed subst variable. Replace
- instances of STUB_LIB_FILE with TCL_STUB_LIB_FILE.
+ * unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB commands
+ instead of using a delayed subst variable. Replace instances of
+ STUB_LIB_FILE with TCL_STUB_LIB_FILE.
2001-04-25 Mo DeJong <mdejong@redhat.com>
@@ -3259,19 +3159,20 @@
2001-04-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tools/encoding/iso8859-15.txt:
- * library/encoding/iso8859-15.enc: Oops! Got the full encoding
- wrong. Should be fixed now...
+ * library/encoding/iso8859-15.enc: Oops! Got the full encoding wrong.
+ Should be fixed now...
* tools/encoding/iso8859-15.txt:
* library/encoding/iso8859-15.enc:
- * tools/tcl.wse.in: Added ISO 8859-15 (a.k.a. Latin-1 + Euro
- currency symbol) support.
+ * tools/tcl.wse.in: Added ISO 8859-15 (a.k.a. Latin-1 + Euro currency
+ symbol) support.
* generic/tclNamesp.c:
- * generic/tclBasic.c (TclRenameCommand): Missing CONST from
- several declarations relating to use of TclGetNamespaceForQualName
+ * generic/tclBasic.c (TclRenameCommand): Missing CONST from several
+ declarations relating to use of TclGetNamespaceForQualName
2001-04-24 Kevin B. Kenny <kennykb@acm.org>
+
* doc/AssocData.3:
* doc/CrtCommand.3:
* doc/CrtMathFnc.3:
@@ -3285,18 +3186,18 @@
* generic/tcl.h:
* generic/tclInt.decls:
* generic/tclInt.h: (TIP #27) Another round of CONST changes, this
- time adding CONST to the API's exported from tclBasic.c.
- [Patch #415179]
- ***POTENTIAL INCOMPATIBILITY*** from 8.4a2, in which Vince
- Darley's changes to command tracing were added. A const has been
- added to the type signature of one of the parameters to
- Tcl_CommandTraceProc.
+ time adding CONST to the API's exported from tclBasic.c. [Patch
+ 415179]
+ ***POTENTIAL INCOMPATIBILITY*** from 8.4a2, in which Vince Darley's
+ changes to command tracing were added. A const has been added to the
+ type signature of one of the parameters to Tcl_CommandTraceProc.
2001-04-10 Kevin B. Kenny <kennykb@acm.org>
+
* unix/tclUnixTime.c: Altered code to use memcpy instead of
structure assigments in an effort to achieve better K&R
compatibility.
-
+
2001-04-10 Kevin B. Kenny <kennykb@acm.org>
* unix/tclUnixTime.c: Fixed silly typo in calls to 'gmtime' and
@@ -3304,125 +3205,122 @@
2001-04-09 Kevin B. Kenny <kennykb@acm.org>
- * unix/tclLoadShl.c: Added DYNAMIC_PATH to the load flags so that
- the SHLIB_PATH will be searched for other libraries. [Bug #219140]
-
+ * unix/tclLoadShl.c: Added DYNAMIC_PATH to the load flags so that the
+ SHLIB_PATH will be searched for other libraries. [Bug 219140]
+
2001-04-09 Kevin B. Kenny <kennykb@acm.org>
- * unix/tcl.m4: Added _REENTRANT to Solaris build so that thread
- safe library routines are included.
+ * unix/tcl.m4: Added _REENTRANT to Solaris build so that thread safe
+ library routines are included.
* unix/configure: Re-ran 'autoconf' with changed tcl.m4
* tclUnixTime.c: Modified for thread safety of 'gmtime' and
- 'localtime' system calls [Bugs #219136 and #232558]
-
+ 'localtime' system calls. [Bugs 219136 and 232558]
+
2001-04-09 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/expr.test (expr-21.*): Tests to check below fix.
* generic/tclParseExpr.c (GetLexeme): Now recognises the
non-numeric boolean literals for what they are. It no longer makes
sense for anyone to create functions with the same name as one of
- them, but this was true in 7.* as well [Bug #217777; finally!]
+ them, but this was true in 7.* as well [Bug 217777; finally!]
2001-04-07 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: Avoid panic when there are extra items in
- the tcl stack [Bug #406709, Patch #414470]
+ * generic/tclExecute.c: Avoid panic when there are extra items in the
+ tcl stack. [Bug 406709, Patch 414470]
* tests/foreach.test: test to exercise the patch
2001-04-07 Miguel Sofer <msofer@users.sourceforge.net>
* doc/namespace.n: document correct functionality
* generic/tclNamesp.c: corrected behaviour of [namespace code]
- (Bug #219385, Patch #403530)
+ [Bug 219385, Patch 403530]
* library/init.tcl:
* tests/namespace-old.test: test correct functionality
* tests/namespace.test: test correct functionality
2001-04-07 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * unix/Makefile.in (checkdoc): New target, checking the
- definitions as found in the compiled library against the
- manpages to find undocumented public functionality.
+ * unix/Makefile.in (checkdoc): New target, checking the definitions as
+ found in the compiled library against the manpages to find
+ undocumented public functionality.
* unix/mkLinks: Updated to include the new manpage.
* doc/UniCharIsAlpha.3: New manpage documenting the Unicode
- character classification APIs [Bug #218720].
+ character classification APIs. [Bug 218720]
2001-04-07 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* unix/mkLinks: Updated to incorporate the changes below.
* doc/StringObj.3: Added 'Tcl_AttemptSetObjLength' to the NAME
- section. [Bug #414435].
+ section. [Bug 414435]
- * doc/Alloc.3: Added both 'Tcl_AttemptAlloc' and
- 'Tcl_AttemptRealloc' to the NAME section. [Bug #414435].
+ * doc/Alloc.3: Added both 'Tcl_AttemptAlloc' and 'Tcl_AttemptRealloc'
+ to the NAME section. [Bug 414435]
* doc/Utf.3: Added both 'Tcl_UniCharCaseMatch' and
- 'Tcl_UniCharNcasecmp' to the NAME section. [Bug #414435].
+ 'Tcl_UniCharNcasecmp' to the NAME section. [Bug 414435]
2001-04-06 Don Porter <dgp@users.sourceforge.net>
* library/init.tcl:
- * tests/init.test: Modified processing of $::errorInfo by
- [unknown] when the auto-loaded command throws an error to better
- cover the tracks of auto-loading. [Bug 219280, Patch 403551]
+ * tests/init.test: Modified processing of $::errorInfo by [unknown]
+ when the auto-loaded command throws an error to better cover the
+ tracks of auto-loading. [Bug 219280, Patch 403551]
2001-04-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/read.n: Added section on "USE WITH SERIAL PORTS" to resolve
- [Bug #219402]
+ [Bug 219402]
* tests/string.test (string-2.30): Test for this case
* generic/tclCmdMZ.c (Tcl_StringObjCmd, STR_COMPARE branch): Fixed
problem caused by Utf-rep of \x00 being more than Utf-rep of \x01
- fooling memcmp by forcing everything through Utf-based
- comparisons. Added optimizations for case where objects have a
- string/unicode-rep or a bytearray-rep (i.e. where we can perform
- comparisons on fixed-size units.) [Bug #219201]
+ fooling memcmp by forcing everything through Utf-based comparisons.
+ Added optimizations for case where objects have a string/unicode-rep
+ or a bytearray-rep (i.e. where we can perform comparisons on
+ fixed-size units). [Bug 219201]
* generic/tclUtf.c (Tcl_UtfNcmp): Corrected seriously erroneous
comment.
2001-04-05 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * doc/Macintosh.3: Removed duplicates from .SH line
- [Bug #413983].
+ * doc/Macintosh.3: Removed duplicates from .SH line. [Bug 413983]
2001-04-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCmdMZ.c (Tcl_StringObjCmd): Fixed so will compile
- with K&R compilers [Patch #413844, Bug #413847]
+ with K&R compilers. [Patch 413844, Bug 413847]
2001-04-04 Don Porter <dgp@users.sourceforge.net>
* generic/tclMain.c: Patch from Kevin Kenny to restore support of
- pre-ANSI compilers. [Bug 413846, Patch 413842]
+ pre-ANSI compilers. [Bug 413846, Patch 413842]
2001-04-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* unix/mkLinks: Updated to contain the new manpage.
- * doc/Environment.3: New manpage, describes Tcl_PutEnv
- [Bug #219171].
+ * doc/Environment.3: New manpage, describes Tcl_PutEnv. [Bug 219171]
- * doc/Macintosh.3: New manpage describing the macintosh specific
- parts of the public API [Bug #219169].
+ * doc/Macintosh.3: New manpage describing the macintosh specific parts
+ of the public API. [Bug 219169]
2001-04-04 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure:
* unix/tcl.m4: extended test of termios vs. termio vs. sgtty to
better detect result on Linux and when certain configure
- redirections are being used. (max) [Patch #402923; Bug #227412,
- #219194]
+ redirections are being used. [Patch 402923; Bug 227412, 219194] (max)
2001-04-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* generic/tclTest.c:
* tests/io.tests: TIP #10 followup correcting a problem with the
- original patch because of the lack of 'testthread id' for a
- non-threaded compilation.
+ original patch because of the lack of 'testthread id' for a
+ non-threaded compilation.
2001-04-04 Kevin Kenny <kennykb@acm.org>
@@ -3440,24 +3338,24 @@
* generic/tclObj.c:
* generic/tclPkg.c:
* generic/tclStringObj.c:
- * generic/tclStubLib.c:
- (TIP#27) Changed a number of Tcl API's to accept "CONST char*"
- in place of simple "char*". (kennykb) [Patch #404026]
+ * generic/tclStubLib.c: (TIP#27) Changed a number of Tcl API's to
+ accept "CONST char*" in place of simple "char*". (kennykb) [Patch
+ 404026]
2001-04-04 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclListObj.c (Tcl_SetListObj): set objPtr->length = 0 in
empty object case to maintain sanctity of Tcl_Obj bytes/length
- pairing. (porter) [Patch #405998]
+ pairing. [Patch 405998] (porter)
2001-04-03 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* unix/mkLinks: Added 'Signal.3', 'Tcl_WaitPid'.
- * doc/DetachPids.3: Added description of 'Tcl_WaitPid' [Bug #219173].
+ * doc/DetachPids.3: Added description of 'Tcl_WaitPid' [Bug 219173].
* doc/Signal.3: New man page describing the public API procedures
- 'Tcl_SignalId' and 'Tcl_SignalMsg' [Bug #219172].
+ 'Tcl_SignalId' and 'Tcl_SignalMsg'. [Bug 219172]
2001-04-02 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3466,7 +3364,7 @@
* win/README.binary: further notes corrections.
* win/configure:
- * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug #219381]
+ * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug 219381]
2001-04-01 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3474,8 +3372,8 @@
* mac/README:
* win/README:
* win/README.binary:
- * unix/README: updated patchlevel information to 8.4a3 and
- updated links and notes.
+ * unix/README: updated patchlevel information to 8.4a3 and updated
+ links and notes.
* generic/tcl.h:
* tools/tcl.wse.in:
@@ -3489,18 +3387,17 @@
* generic/tclCkalloc.c (TclFinalizeMemorySubsystem): set curTagPtr
to NULL to allow for reuse.
- * generic/tclEvent.c (Tcl_Finalize): moved the tsdPtr
- initialization inside the subsystemsInitialized check to prevent
- it potentially getting called twice during finalization. (wu)
- [Patch #403532, Bug #219391]
+ * generic/tclEvent.c (Tcl_Finalize): moved the tsdPtr initialization
+ inside the subsystemsInitialized check to prevent it potentially
+ getting called twice during finalization.
+ [Patch 403532, Bug 219391] (wu)
* generic/tclThreadTest.c (Tcl_ThreadObjCmd): cast fixes
- * generic/tclTest.c (TestChannelCmd): added cast to mollify
- Windows debug build.
+ * generic/tclTest.c (TestChannelCmd): added cast to mollify Windows
+ debug build.
* win/tclWinSock.c (SocketEventProc): Fixed race condition in
- readability of socket on Windows.
- [Patch #410674, Bug #219205 #219333]
+ readability of socket on Windows. [Patch 410674, Bug 219205, 219333]
* win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support.
@@ -3512,38 +3409,36 @@
2001-03-30 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* All of the changes below belong to TIP #10 [Tcl I/O Enhancement:
- Thread-Aware Channels]. See also [Patch #403358] at SF.
+ Thread-Aware Channels]. See also [Patch 403358] at SF.
* generic/tclIO.h (struct ChannelState, line 236f): Extended the
- structure with a new field of type 'Tcl_ThreadId' to hold the id
- of the thread currently managing all channels with this state.
+ structure with a new field of type 'Tcl_ThreadId' to hold the id of
+ the thread currently managing all channels with this state.
- Note: This structure is shared by all channels in a stack of
- transformations.
+ Note: This structure is shared by all channels in a stack of
+ transformations.
- * generic/tclIO.c (Tcl_CreateChannel, lines 1058-1065): Modified
- to store the Id of the current thread in the 'ChannelState' of
- the new channel.
+ * generic/tclIO.c (Tcl_CreateChannel, lines 1058-1065): Modified to
+ store the Id of the current thread in the 'ChannelState' of the new
+ channel.
- * generic/tclIO.c (Tcl_SpliceChannel, lines 2265-2270): Modified
- in the same manner as 'Tcl_CreateChannel' as the channel will be
- managed by the current thread afterward.
+ * generic/tclIO.c (Tcl_SpliceChannel, lines 2265-2270): Modified in
+ the same manner as 'Tcl_CreateChannel' as the channel will be managed
+ by the current thread afterward.
* generic/tclIO.c (Tcl_GetChannelThread, lines 1478-1503):
- * generic/tcl.decls (Tcl_GetChannelThread, lines 1504-1506): New
- API function to retrieve the Id of the managing thread from a
- channel. Implementation and declaration.
+ * generic/tcl.decls (Tcl_GetChannelThread, lines 1504-1506): New API
+ function to retrieve the Id of the managing thread from a channel.
+ Implementation and declaration.
* generic/tclTest.c (TestChannelCmd, lines 4520-4532): Added
- subcommand 'mthread' to query a channel about its managing
- thread.
+ subcommand 'mthread' to query a channel about its managing thread.
2001-03-29 Mo DeJong <mdejong@redhat.com>
- * tests/interp.test: Print out warning when
- testinterpdelete command is not defined.
- Add tests that checks to make sure a
- child interp inherits the parent's cwd.
+ * tests/interp.test: Print out warning when testinterpdelete command
+ is not defined. Add tests that checks to make sure a child interp
+ inherits the parent's cwd.
2001-03-29 Jeff Hobbs <jeffh@gimlet.activestate.com>
@@ -3553,35 +3448,34 @@
* unix/tclUnixPipe.c (TclpCreateTempFile): prevent potential race
condition and security leak in tmp filename creation.
- (max) [Patch #402924]
+ [Patch 402924] (max)
* unix/configure:
* unix/tcl.m4: corrected IRIX-5.x config to not use -n32.
- (english) [Patch #403626]
+ [Patch 403626] (english)
- * unix/tclUnixThrd.c (Tcl_ConditionWait): fixed handling of
- timeout for threads (corrects excessive CPU usage issue for Tk on
- Unix in threaded Tcl environment). (ruppert) [Bug #411603]
+ * unix/tclUnixThrd.c (Tcl_ConditionWait): fixed handling of timeout
+ for threads (corrects excessive CPU usage issue for Tk on Unix in
+ threaded Tcl environment). [Bug 411603] (ruppert)
2001-03-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/lsort.n: Added some notes that clarify the behaviour of
- [lsort] as well as a whole bunch of examples. [Bug #219202]
+ [lsort] as well as a whole bunch of examples. [Bug 219202]
2001-03-27 Jeff Hobbs <jeffh@gimlet.activestate.com>
- * doc/Alloc.3: corrected docs to note that Tcl_Attempt* return
- char *'s, not ints. [Bug #411388]
+ * doc/Alloc.3: corrected docs to note that Tcl_Attempt* return char
+ *'s, not ints. [Bug 411388]
* tests/regexp.test (regexp-19.1):
- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): fixed handling of nulls
- in subspec value.
+ * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): fixed handling of nulls in
+ subspec value.
2001-03-26 Don Porter <dgp@users.sourceforge.net>
- * generic/tclDecls.h (Tcl_InitCustomHashTable): Correction to
- patch from 2001-01-18; tclDecls.h was not generated using
- 'make genstubs'.
+ * generic/tclDecls.h (Tcl_InitCustomHashTable): Correction to patch
+ from 2001-01-18; tclDecls.h was not generated using 'make genstubs'.
2001-03-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3590,11 +3484,11 @@
2001-03-23 Jeff Hobbs <jeffh@activestate.com>
- * generic/tclVar.c (Tcl_ArrayObjCmd): Corrected retrieval of
- resultPtr to prevent possible corruption.
+ * generic/tclVar.c (Tcl_ArrayObjCmd): Corrected retrieval of resultPtr
+ to prevent possible corruption.
* generic/tclNamesp.c (Tcl_Import): Correctly freed a DString.
- (lavana) [Patch #403755]
+ [Patch 403755] (lavana)
2001-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3603,134 +3497,131 @@
2001-03-14 Don Porter <dgp@users.sourceforge.net>
- * library/package.tcl (pkg_mkIndex): Added patch from Vince
- Darley to make [pkg_mkIndex -verbose] even more verbose.
- [Bug 219349, Patch 403529]
+ * library/package.tcl (pkg_mkIndex): Added patch from Vince Darley to
+ make [pkg_mkIndex -verbose] even more verbose. [Bug 219349, Patch
+ 403529]
2001-03-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/info.n: Improved documentation for [info hostname].
- [Bug #403840]
+ * doc/info.n: Improved documentation for [info hostname]. [Bug 403840]
* generic/tclVar.c (Tcl_UnsetObjCmd): Made command behave as
- documented [issue remaining from bug #405769]
+ documented [issue remaining from Bug 405769]
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): A missing
- {return TCL_OK;} was causing memory corruption. [Bug #408002]
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): A missing {return TCL_OK;}
+ was causing memory corruption. [Bug 408002]
* generic/tclExecute.c (TclDeleteExecEnv, GrowEvaluationStack,
- TclExecuteByteCode): Added some casts to ClientData that are
+ (TclExecuteByteCode): Added some casts to ClientData that are
apparently needed on some architectures.
2001-03-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/string.test: Fixed some test numberings and added a test.
- [Patch #403229]
+ [Patch 403229]
2001-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to
- avoid a read off the end of the argument array that could occur
- when executing something like [unset -nocomplain] was executed.
- Improved the error message given when too few arguments are given
- (-nocomplain should obviously be *before* --, not after it) and
- also modified the test suite to take account of that and the
- documentation to use the same improvement. [Bug 405769]
+ * generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid
+ a read off the end of the argument array that could occur when
+ executing something like [unset -nocomplain] was executed. Improved
+ the error message given when too few arguments are given (-nocomplain
+ should obviously be *before* --, not after it) and also modified the
+ test suite to take account of that and the documentation to use the
+ same improvement. [Bug 405769]
2001-03-02 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could
- pass pointers to freed memory to command implementations, which
- most obviously caused some weird behaviour with [info level], but
- could have caused problems with user code and command traces too.
- [Bug 404865, Patch 405436]
+ * generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could pass
+ pointers to freed memory to command implementations, which most
+ obviously caused some weird behaviour with [info level], but could
+ have caused problems with user code and command traces too. [Bug
+ 404865, Patch 405436]
2001-02-23 msofer <msofer@users.sourceforge.net>
+
* no changes; fixing up the missing comment in the previous one.
Sorry.
2001-02-23 msofer <msofer@ant.utdt>
- * /cvsroot/tcl/tcl/tests/execute.test:
- added test for evaluation of an expression in a variable; evals once
- by compiling, second time using the previous compilation
+ * /cvsroot/tcl/tcl/tests/execute.test: added test for evaluation of an
+ expression in a variable; evals once by compiling, second time using
+ the previous compilation
2001-02-18 Kevin B. Kenny <kennykb@acm.org>
* doc/clock.n: Updated documentation to reflect the addition of
- compat/strftime.c, including the correct formatting of
- ISO-8601:1988 fiscal week number (%V).
-
+ compat/strftime.c, including the correct formatting of ISO-8601:1988
+ fiscal week number (%V).
+
2001-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCmdMZ.c (Tcl_SplitObjCmd): Improved efficiency of
- splitting strings into individual characters by adding hash so
- that only one Tcl_Obj per character is created. Improves
- performance of splitting of short strings and makes a huge
- difference to splitting of long strings, such as is done in the
- mime package in tcllib. [Bug #131523]
+ splitting strings into individual characters by adding hash so that
+ only one Tcl_Obj per character is created. Improves performance of
+ splitting of short strings and makes a huge difference to splitting of
+ long strings, such as is done in the mime package in tcllib. [Bug
+ 131523]
2001-01-31 Don Porter <dgp@users.sourceforge.net>
- * win/makefile.vc (install-libraries): Corrected misdirected
- install directory for the msgcat 1.2 package.
+ * win/makefile.vc (install-libraries): Corrected misdirected install
+ directory for the msgcat 1.2 package.
2001-01-30 Don Porter <dgp@users.sourceforge.net>
- * generic/tclIO.c (CopyData): Moved code that updates the count
- of how many bytes are left to copy. Corrects bug that when
- writing occurs in the background, the copy loop could be
- escaped without updating the count, causing CopyData() to try
- to copy more bytes than the toRead value originally passed to
- TclCopyChannel(), leading to hangs and misreporting of number
- of bytes copied. [Bug 118203, Patch 103432]
+ * generic/tclIO.c (CopyData): Moved code that updates the count of how
+ many bytes are left to copy. Corrects bug that when writing occurs in
+ the background, the copy loop could be escaped without updating the
+ count, causing CopyData() to try to copy more bytes than the toRead
+ value originally passed to TclCopyChannel(), leading to hangs and
+ misreporting of number of bytes copied. [Bug 118203, Patch 103432]
2001-01-18 Andreas Kupries <a.kupries@westend.com>
- * Everything below belongs together, it fixes bug #123153.
+ Everything below belongs together, it fixes [Bug 123153]
- * generic/tcl.h (line 342): A bit more explanation about the
- default value for TCL_PRESERVE_BINARY_COMPATABILITY.
+ * generic/tcl.h (line 342): A bit more explanation about the default
+ value for TCL_PRESERVE_BINARY_COMPATABILITY.
- * generic/tcl.h (line 1208): Define the macro 'Tcl_InitHashTable'
- only when TCL_PRESERVE_BINARY_COMPATIBILITY is not set
- as it kills binary compatibility to 8.3 and earlier
- versions. This is the main part of the patch/change.
+ * generic/tcl.h (line 1208): Define the macro 'Tcl_InitHashTable' only
+ when TCL_PRESERVE_BINARY_COMPATIBILITY is not set as it kills binary
+ compatibility to 8.3 and earlier versions. This is the main part of
+ the patch/change.
* generic/tcl.decls (line 1469):
* generic/tclHash.c (Tcl_InitHashTable):
* generic/tclHash.c (Tcl_InitHashTableEx):
* generic/tclObj.c (Tcl_InitObjHashTable): Changed
- 'Tcl_InitHashTableEx' to 'Tcl_InitCustomHashTable'. This change
- is more of an estethical nature, replacing the ubiquitous 'Ex'
- suffix with a more meaningful name. The introduced binary
- incompatibility is deemed acceptable as it is between alpha
- versions. Updated callers.
+ 'Tcl_InitHashTableEx' to 'Tcl_InitCustomHashTable'. This change is
+ more of an estethical nature, replacing the ubiquitous 'Ex' suffix
+ with a more meaningful name. The introduced binary incompatibility is
+ deemed acceptable as it is between alpha versions. Updated callers.
* doc/Hash.3:
* unix/mkLinks: Changed 'Tcl_InitHashTableEx' to
- 'Tcl_InitCustomHashTable'.
+ 'Tcl_InitCustomHashTable'.
2001-01-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/winPipe.test (winpipe-1.20):
- * tests/winDde.test (createChildProcess):
- * tests/pkgMkIndex.test (pkgtest::createIndex): Removed
- assumption that paths contain no spaces which causes problems with
- both [eval] and [open |...] due to the well-known differences
- between lists and strings. Fixes bug #119406
+ * tests/winPipe.test (winpipe-1.20):
+ * tests/winDde.test (createChildProcess):
+ * tests/pkgMkIndex.test (pkgtest::createIndex): Removed assumption
+ that paths contain no spaces which causes problems with both [eval]
+ and [open |...] due to the well-known differences between lists and
+ strings. Fixes [Bug 119406]
2001-01-04 Don Porter <dgp@users.sourceforge.net>
* tests/unixInit.test:
* unix/tclUnixInit.c (TclpInitLibraryPath):
- * win/tclWinInit.c (TclpInitLibraryPath): Several entries in
- the library path ($tcl_libPath) are determined relative to the
- absolute path of the executable. When the executable is
- installed in or near the root directory of the file system,
- relative pathnames were being incorrectly generated, and in
- the worst case, memory access violations were crashing the program.
- [Bug 119416, Patch 102972]
+ * win/tclWinInit.c (TclpInitLibraryPath): Several entries in the
+ library path ($tcl_libPath) are determined relative to the absolute
+ path of the executable. When the executable is installed in or near
+ the root directory of the file system, relative pathnames were being
+ incorrectly generated, and in the worst case, memory access violations
+ were crashing the program. [Bug 119416, Patch 102972]
******************************************************************
*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
diff --git a/ChangeLog.2002 b/ChangeLog.2002
index 53550bd..30b8b17 100644
--- a/ChangeLog.2002
+++ b/ChangeLog.2002
@@ -5,24 +5,23 @@
2002-12-17 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode):
- (Tcl_ThreadAlert): Check that the stub functions are non-NULL
- before calling them. They could be set to NULL by Tcl_SetNotifier.
+ * generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode):
+ (Tcl_ThreadAlert): Check that the stub functions are non-NULL before
+ calling them. They could be set to NULL by Tcl_SetNotifier.
2002-12-16 David Gravereaux <davygrvy@pobox.com>
* generic/tclPipe.c (TclCleanupChildren):
* tests/winPipe.test:
* win/tclWinPipe.c (Tcl_WaitPid):
- * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a
- Win32 exception code translated into a posix style SIG*. This
- allows [close] to report "CHILDKILLED" without the meaning
- getting lost in a truncated exit code. In TclCleanupChildren(),
- TclpGetPid() had to get moved to before Tcl_WaitPid() as the
- the handle is removed from the list taking away the ability
- to get the process id after the wait is done. This shouldn't
- effect the unix implimentaion unless waitpid is called with
- a pid of zero, meaning "any". I don't think it is..
+ * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a Win32
+ exception code translated into a posix style SIG*. This allows [close]
+ to report "CHILDKILLED" without the meaning getting lost in a
+ truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get
+ moved to before Tcl_WaitPid() as the the handle is removed from the
+ list taking away the ability to get the process id after the wait is
+ done. This shouldn't effect the unix implimentaion unless waitpid is
+ called with a pid of zero, meaning "any". I don't think it is..
2002-12-13 Don Porter <dgp@users.sourceforge.net>
@@ -34,28 +33,27 @@
2002-12-11 Don Porter <dgp@users.sourceforge.net>
- * generic/tclProc.c (ProcessProcResultCode): Fix failure to
- propagate negative return codes up the call stack. [Bug 647307]
+ * generic/tclProc.c (ProcessProcResultCode): Fix failure to propagate
+ negative return codes up the call stack. [Bug 647307]
* tests/proc.test (proc-6.1): Test for Bug 647307
- * generic/tclParseExpr.c (TclParseInteger): Return 1 for the
- string "0x" (recognize leading "0" as an integer). [Bug 648441].
+ * generic/tclParseExpr.c (TclParseInteger): Return 1 for the string
+ "0x" (recognize leading "0" as an integer). [Bug 648441]
* tests/parseExpr.test (parseExpr-19.1): Test for Bug 648441.
2002-12-09 Jeff Hobbs <jeffh@ActiveState.com>
* win/tclWinThrd.c (TclpMasterUnlock):
- * generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock
- must exist and be called unconditional of TCL_THREADS. [Bug #651139]
+ * generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock must
+ exist and be called unconditional of TCL_THREADS. [Bug 651139]
2002-12-08 David Gravereaux <davygrvy@pobox.com>
* win/tclWinSock.c (SocketThreadExitHandler, InitSockets): Check
- that the tsdPtr is valid before dereferencing as we call it from
- the exit handler, too [Bug 650353]. Another WSAStartup() loaded
- version comparison byte swap issue fixed. Although 0x0101 byte
- swapped is still 0x0101, properly claiming which is major/minor
- is more correct.
+ that the tsdPtr is valid before dereferencing as we call it from the
+ exit handler, too [Bug 650353]. Another WSAStartup() loaded version
+ comparison byte swap issue fixed. Although 0x0101 byte swapped is
+ still 0x0101, properly claiming which is major/minor is more correct.
2002-12-06 Jeff Hobbs <jeffh@ActiveState.com>
@@ -65,46 +63,45 @@
* win/tclWin32Dll.c (TclWinResetInterfaces):
* win/tclWinInit.c (TclpSetInitialEncodings, WinEncodingsCleanup):
- add exit handler that resets the encoding information to a state
- where we can reuse Tcl. Following these changes, it is possible
- to reuse Tcl (following Tcl_FindExecutable or Tcl_CreateInterp)
- following a Tcl_Finalize.
+ add exit handler that resets the encoding information to a state where
+ we can reuse Tcl. Following these changes, it is possible to reuse Tcl
+ (following Tcl_FindExecutable or Tcl_CreateInterp) following a
+ Tcl_Finalize.
- * generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to
- their original values on finalize to allow reuse of the library.
+ * generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to their
+ original values on finalize to allow reuse of the library.
2002-12-04 David Gravereaux <davygrvy@pobox.com>
* win/tclWinPipe.c: reverted back to -r1.27 due to numerous test
- failures that need to be resolved first. The idea was good,
- but the details aren't.
-
+ failures that need to be resolved first. The idea was good, but the
+ details aren't.
+
2002-12-04 David Gravereaux <davygrvy@pobox.com>
* win/tclWinPipe.c (Tcl_WaitPid): When a process exits with an
- exception, pass this notice on to the caller with a SIG* code
- rather than truncating the exit code and missing the meaning.
- This allows TclCleanupChildren() to report "CHILDKILLED".
+ exception, pass this notice on to the caller with a SIG* code rather
+ than truncating the exit code and missing the meaning. This allows
+ TclCleanupChildren() to report "CHILDKILLED".
- This has a different behavior than unix in that closing the
- read pipe to a process sends the SIGPIPE signal which is
- returned as a SIGPIPE exit status. On windows, we send the
- process a CTRL_BREAK_EVENT and get back a CONTROL_C_EXIT which
- is documented to mean a SIGINT which seems wrong as a system,
- but is the correct exit status.
+ This has a different behavior than unix in that closing the read pipe
+ to a process sends the SIGPIPE signal which is returned as a SIGPIPE
+ exit status. On windows, we send the process a CTRL_BREAK_EVENT and
+ get back a CONTROL_C_EXIT which is documented to mean a SIGINT which
+ seems wrong as a system, but is the correct exit status.
2002-12-04 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: fix to redirected 'load' in virtual
- filesystem for some Unix systems.
+ * generic/tclIOUtil.c: fix to redirected 'load' in virtual filesystem
+ for some Unix systems.
+
+ * generic/tclEvent.c: the filesystem must be cleaned up before the
+ encoding subsystem because it needs access to encodings. Fixes crash
+ on exit observed in embedded applications.
- * generic/tclEvent.c: the filesystem must be cleaned up before
- the encoding subsystem because it needs access to encodings.
- Fixes crash on exit observed in embedded applications.
+ * generic/tclTestObj.c: patch omitted from previous change of
+ 2002-11-13
- * generic/tclTestObj.c: patch omitted from previous change
- of 2002-11-13
-
2002-12-03 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclStubLib.c (Tcl_InitStubs): prevent the cached check of
@@ -113,15 +110,15 @@
2002-12-03 David Gravereaux <davygrvy@pobox.com>
- * win/tclAppInit.c (sigHandler): Protect from trying to close a
- NULL handle.
+ * win/tclAppInit.c (sigHandler): Protect from trying to close a NULL
+ handle.
- * win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a
- real Win32 signal (CTRL_C_EVENT) when the read channel is brought
- down to alert the child to close on its side. Start the process
- with CREATE_NEW_PROCESS_GROUP to allow the ability to send these
- signals. The following test case now brings down the child
- without the use of an external [kill] command.
+ * win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a real
+ Win32 signal (CTRL_C_EVENT) when the read channel is brought down to
+ alert the child to close on its side. Start the process with
+ CREATE_NEW_PROCESS_GROUP to allow the ability to send these signals.
+ The following test case now brings down the child without the use of
+ an external [kill] command.
% set p [open "|[info name]" w+]
file8d5380
@@ -130,26 +127,25 @@
% close $p <- now doesn't block in Tcl_WaitPid()
%
- * win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT
- to CTRL_BREAK_EVENT as it can't be ignored by the child and
- proved to work on [open "|netstat 1" w+] where CTRL_C_EVENT
- didn't.
+ * win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT to
+ CTRL_BREAK_EVENT as it can't be ignored by the child and proved to
+ work on [open "|netstat 1" w+] where CTRL_C_EVENT didn't.
2002-11-27 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinPort.h: Don't turn off winsock prototypes!
- TclX didn't like it. Even though the core doesn't use the
- prototypes, do offer them.
+ * win/tclWinPort.h: Don't turn off winsock prototypes! TclX didn't
+ like it. Even though the core doesn't use the prototypes, do offer
+ them.
- * win/tclWinSock.c: Removed shutdown() from the function
- table as it wasn't referenced anywhere and cleaned-up some
- casting that that wasn't needed.
+ * win/tclWinSock.c: Removed shutdown() from the function table as it
+ wasn't referenced anywhere and cleaned-up some casting that that
+ wasn't needed.
- * win/tclWinSock.c: WSAStartup() loaded version comparison
- error which resulted in 2.0 looking less than 1.1.
+ * win/tclWinSock.c: WSAStartup() loaded version comparison error which
+ resulted in 2.0 looking less than 1.1.
- * win/tclWinChan.c (Tcl_MakeFileChannel): return of
- DuplicateHandle() incorrectly used [Bug 618852].
+ * win/tclWinChan.c (Tcl_MakeFileChannel): return of DuplicateHandle()
+ incorrectly used. [Bug 618852]
2002-11-26 Jeff Hobbs <jeffh@ActiveState.com>
@@ -168,18 +164,16 @@
* win/tclWinPort.h:
* win/tclWinSock.c: This patch does two things:
- 1) Cleans-up the winsock typedefs by using the typedefs
- provided by winsock2.h. This has no effect on how winsock
- is initialized; just makes the source code easier to read.
- [Patch 561305 561301]
-
- 2) Revamps how the socket message handler thread is brought
- up and down to allow for cleaner exits without the use of
- TerminateThread(). TerminateThread is evil. No attempt has
- been made to resolve [Bug 593810] which may need a new
- channel driver version for adding a registering function
- within the transfered thread to init the handler thread.
- IOW, initialization of the TSD structure is getting bypassed
+ 1) Cleans-up the winsock typedefs by using the typedefs provided by
+ winsock2.h. This has no effect on how winsock is initialized; just
+ makes the source code easier to read. [Patch 561305 561301]
+
+ 2) Revamps how the socket message handler thread is brought up and
+ down to allow for cleaner exits without the use of TerminateThread().
+ TerminateThread is evil. No attempt has been made to resolve [Bug
+ 593810] which may need a new channel driver version for adding a
+ registering function within the transfered thread to init the handler
+ thread. IOW, initialization of the TSD structure is getting bypassed
through the thread extension's [thread::transfer] command.
2002-11-26 David Gravereaux <davygrvy@pobox.com>
@@ -189,20 +183,19 @@
* win/tclWinSerial.c:
* win/tclWinSock.c:
* win/tclWinThrd.c:
- * win/tclWinTime.c: General cleanup of all worker threads used
- by the channel drivers. Eliminates the normal case where the
- worker thread is terminated ('cept the winsock one). Instead,
- use kernel events to signal a clean exit. Only when the worker
- thread is blocked on an I/O call is the thread terminated.
- Essentially, this makes all other channel worker threads behave
- like the PipeReaderThread() function for it's cleaner exit
- behavior. This appears to fix [Bug 597924] but needs 3rd party
- confirmation to close the issue.
+ * win/tclWinTime.c: General cleanup of all worker threads used by the
+ channel drivers. Eliminates the normal case where the worker thread is
+ terminated ('cept the winsock one). Instead, use kernel events to
+ signal a clean exit. Only when the worker thread is blocked on an I/O
+ call is the thread terminated. Essentially, this makes all other
+ channel worker threads behave like the PipeReaderThread() function for
+ it's cleaner exit behavior. This appears to fix [Bug 597924] but needs
+ 3rd party confirmation to close the issue.
2002-11-26 Mo DeJong <mdejong@users.sourceforge.net>
- * win/README: Update msys build env URL. This
- release #4 build both tcl and tk without problems.
+ * win/README: Update msys build env URL. This release #4 build both
+ tcl and tk without problems.
2002-11-22 Jeff Hobbs <jeffh@ActiveState.com>
@@ -210,8 +203,8 @@
* library/opt/optparse.tcl: string compare
* tests/interp.test: interp-14.4
- * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault
- when creating an alias command over the interp name. [Bug #641195]
+ * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when
+ creating an alias command over the interp name. [Bug 641195]
2002-11-18 Jeff Hobbs <jeffh@ActiveState.com>
@@ -220,17 +213,17 @@
* generic/get.test:
* generic/string.test:
- * generic/tclObj.c (SetIntFromAny, SetWideIntFromAny):
- * generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign
- handling before calling strtoul(l). [Bug #634856]
+ * generic/tclObj.c (SetIntFromAny, SetWideIntFromAny):
+ * generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign handling
+ before calling strtoul(l). [Bug 634856]
2002-11-18 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed
- improper compiler macros that missed the VC++ compiler. This
- resulted in VC++ builds using CreateThread()/ExitThread() in place
- of the proper _beginthreadex()/_endthreadex(). This was a large
- error and am surprised I missed seeing it earlier.
+ * win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed improper
+ compiler macros that missed the VC++ compiler. This resulted in VC++
+ builds using CreateThread()/ExitThread() in place of the proper
+ _beginthreadex()/_endthreadex(). This was a large error and am
+ surprised I missed seeing it earlier.
2002-11-13 Jeff Hobbs <jeffh@ActiveState.com>
@@ -243,20 +236,19 @@
2002-11-13 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclCmdMZ.c:
- * tests/trace.test: applied patch from Hemang Levana to fix
- [Bug #615043] in execution traces with 'return -code error'.
-
+ * tests/trace.test: applied patch from Hemang Levana to fix [Bug
+ 615043] in execution traces with 'return -code error'.
+
* generic/tclTestObj.c:
* tests/stringObj.test: added 'knownBug' test for [Bug 635200]
* generic/tclStringObj.c: corrected typos in comments
* generic/tclFileName.c:
- * tests/fileName.test: applied patch for bug reported against
- tclvfs concerning handling of Windows serial ports like 'com1',
- 'lpt3' by the virtual filesystem code.
+ * tests/fileName.test: applied patch for bug reported against tclvfs
+ concerning handling of Windows serial ports like 'com1', 'lpt3' by the
+ virtual filesystem code.
- * doc/RegExp.3: clarification of the 'extendMatch' return
- values.
+ * doc/RegExp.3: clarification of the 'extendMatch' return values.
2002-11-11 Jeff Hobbs <jeffh@ActiveState.com>
@@ -264,63 +256,61 @@
(Tcl_StringCaseMatch): use TclUtfToUniChar and add further
optimizations for the one-byte/char case.
- * generic/tclUtf.c: make use of TclUtfToUniChar macro throughout
- the functions, and add extra optimization to Tcl_NumUtfChars for
+ * generic/tclUtf.c: make use of TclUtfToUniChar macro throughout the
+ functions, and add extra optimization to Tcl_NumUtfChars for
one-byte/char case.
* generic/tclVar.c (DisposeTraceResult, CallVarTraces): add proper
static declarations.
- * generic/tclStringObj.c (Tcl_GetCharLength): optimize for the
- ascii char case.
+ * generic/tclStringObj.c (Tcl_GetCharLength): optimize for the ascii
+ char case.
(Tcl_GetUniChar): remove unnecessary use of Tcl_UtfToUniChar.
(FillUnicodeRep): Use TclUtfToUniChar.
- * generic/tclHash.c (HashStringKey): move string++ lower to save
- an instruction.
+ * generic/tclHash.c (HashStringKey): move string++ lower to save an
+ instruction.
- * generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP
- to use memcmp in the one-byte/char case, also use direct index for
+ * generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP to
+ use memcmp in the one-byte/char case, also use direct index for
INST_STR_INDEX in that case.
- * generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc):
+ * generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc):
(TableFromUtfProc, EscapeFromUtfProc): Use TclUtfToUniChar.
- (UnicodeToUtfProc, TableToUtfProc): add 1-byte char optimizations
- for Tcl_UniCharToUtf call. These improve encoded channel
- conversion speeds by up to 20%.
+ (UnicodeToUtfProc, TableToUtfProc): add 1-byte char optimizations for
+ Tcl_UniCharToUtf call. These improve encoded channel conversion speeds
+ by up to 20%.
* tests/split.test: added 1-char string split tests
- * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar.
- Also added a special case for single-ascii-char splits.
- (Tcl_StringObjCmd): Use TclUtfToUniChar.
- For STR_RANGE, support getting ranges of ByteArrays (reverts
- change from 2000-05-26).
+ * generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar. Also
+ added a special case for single-ascii-char splits.
+ (Tcl_StringObjCmd): Use TclUtfToUniChar. For STR_RANGE, support
+ getting ranges of ByteArrays (reverts change from 2000-05-26).
(TraceExecutionProc) add proper static declaration.
* generic/tclInt.h: add macro version of Tcl_UtfToUniChar
(TclUtfToUniChar) that does the one-byte utf-char check without
- calling Tcl_UtfToUniChar, for use by the core. This brings
- notable speedups for primarily ascii string handling.
+ calling Tcl_UtfToUniChar, for use by the core. This brings notable
+ speedups for primarily ascii string handling.
* generic/tcl.h (TCL_PATCH_LEVEL): bump to 8.4.1.1 for patchlevel
- only. This interim number will only be reflected by
- [info patchlevel].
+ only. This interim number will only be reflected by [info patchlevel].
2002-11-11 Kevin Kenny <kennykb@acm.org>
- * doc/Tcl.n: Corrected indentation of the new language. Oops.
-
+
+ * doc/Tcl.n: Corrected indentation of the new language. Oops.
+
2002-11-10 Kevin Kenny <kennykb@acm.org>
- * doc/Tcl.n: Added language to the Endekalogue to make it clear
- that substitutions always take place from left to right. [Bug
- #635644]
+ * doc/Tcl.n: Added language to the Endekalogue to make it clear that
+ substitutions always take place from left to right. [Bug 635644]
2002-11-06 Mo DeJong <mdejong@users.sourceforge.net>
* changes: Note TclInExit TclInThreadExit changes.
- * generic/tclEvent.c (TclInExit, TclInThreadExit):
- Split out functionality of TclInExit to make it
- clear which one should be called in each situation.
+ * generic/tclEvent.c (TclInExit, TclInThreadExit): Split out
+ functionality of TclInExit to make it clear which one should be called
+ in each situation.
* generic/tclInt.decls: Declare TclInThreadExit.
* generic/tclIntDecls.h: Regen.
* generic/tclStubInit.c: Regen.
@@ -329,18 +319,17 @@
* win/tclWinChan.c (FileCloseProc):
* win/tclWinConsole.c (ConsoleCloseProc):
* win/tclWinPipe.c (TclpCloseFile):
- * win/tclWinSerial.c (SerialCloseProc): Invoke the
- new TclInThreadExit method instead of TclInExit.
+ * win/tclWinSerial.c (SerialCloseProc): Invoke the new TclInThreadExit
+ method instead of TclInExit.
2002-11-06 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal
- configure error if no ar program can be found on the
- path. [Bug #582039]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal configure error if
+ no ar program can be found on the path. [Bug 582039]
* win/configure: Regen.
- * win/configure.in: Check that AR, RANLIB, and RC
- are found on the path when building with gcc.
+ * win/configure.in: Check that AR, RANLIB, and RC are found on the
+ path when building with gcc.
2002-11-03 David Gravereaux <davygrvy@pobox.com>
@@ -350,58 +339,58 @@
* win/makefile.vc:
* win/rules.vc: linkexten option now sets the TCL_USE_STATIC_PACKAGES
macro which also adds the registry and dde object files to the link
- of the shell. [Patch 479697] Also factored some additional macros
- that will be helpful for extension authors. Version grepping of tcl.h
- will need to be added to complete this.
+ of the shell. [Patch 479697] Also factored some additional macros that
+ will be helpful for extension authors. Version grepping of tcl.h will
+ need to be added to complete this.
* win/buildall.vc.bat: Added more descriptive commentary.
2002-11-01 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinReg.c: Changed the Tcl_PkgProvide() line to declare
- the registry extension at version 1.1 from 1.0.
+ * win/tclWinReg.c: Changed the Tcl_PkgProvide() line to declare the
+ registry extension at version 1.1 from 1.0.
2002-10-31 Andreas Kupries <andreask@activestate.com>
- * library/word.tcl: Changed $tcl_platform to $::tcl_platform to
- avoid possible scope trouble.
+ * library/word.tcl: Changed $tcl_platform to $::tcl_platform to avoid
+ possible scope trouble.
2002-10-29 Vince Darley <vincentdarley@users.sourceforge.net>
* win/tclWinInt.h:
* win/tclWin32Dll.c: added comments about certain NULL function
- pointers which will be filled in when Tcl_FindExecutable is
- called, so that users don't report invalid bugs on this topic.
- (No code changes at all).
-
+ pointers which will be filled in when Tcl_FindExecutable is called, so
+ that users don't report invalid bugs on this topic. (No code changes
+ at all).
+
2002-10-29 Daniel Steffen <das@users.sourceforge.net>
- * unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error
- messages upstream [Bug #627546].
+ * unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error messages
+ upstream [Bug 627546].
2002-10-28 Andreas Kupries <andreask@activestate.com>
* library/dde/pkgIndex.tcl:
- * library/reg/pkgIndex.tcl: Changed the hardwired debug suffix
- (d) to the correct suffix (g).
+ * library/reg/pkgIndex.tcl: Changed the hardwired debug suffix (d) to
+ the correct suffix (g).
2002-10-28 Don Porter <dgp@users.sourceforge.net>
* library/auto.tcl: Converted the Mac-specific [package unknown]
* library/init.tcl: behavior to use a chaining mechanism to extend
- * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660]
+ * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660]
* library/tclIndex: [Patch 624509] (steffen)
2002-10-26 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc: xcopy on NT 4.0 doesn't support the /Y switch
- (overwrite). Added logic to handle this. [Bug 618019]
+ (overwrite). Added logic to handle this. [Bug 618019]
2002-10-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclInt.h: Removed definitions of obsolete HistoryEvent
- and HistoryRev structures (the history mechanism has been written
- in Tcl for some time now.)
+ * generic/tclInt.h: Removed definitions of obsolete HistoryEvent and
+ HistoryRev structures (the history mechanism has been written in Tcl
+ for some time now.)
2002-10-22 Jeff Hobbs <jeffh@ActiveState.com>
@@ -419,20 +408,20 @@
* library/auto.tcl (tcl_findLibrary):
* library/package.tcl (tclPkgUnknown): on macosx, search inside the
- Resources/Scripts subdirectory of any potential package directory
- * macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs
- to TCL_PACKAGE_PATH make argument.
+ Resources/Scripts subdirectory of any potential package directory.
+ * macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs to
+ TCL_PACKAGE_PATH make argument.
* unix/tclUnixInit.c (TclpSetVariables): on macosx, add embedded
framework dirs to tcl_pkgPath: @executable_path/../Frameworks and
- @executable_path/../PrivateFrameworks (if they exist), as well as
- the dirs in DYLD_FRAMEWORK_PATH (if set). [Patch #624509]
+ @executable_path/../PrivateFrameworks (if they exist), as well as the
+ dirs in DYLD_FRAMEWORK_PATH (if set). [Patch 624509]
use standard MAXPATHLEN instead of literal 1024
2002-10-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/StringObj.3, doc/Object.3: Documented that Tcl_Obj's
- standard string form is a modified UTF-8; apparently, this was not
- mentioned anywhere in the main docs, and lead to [Bug 624919].
+ * doc/StringObj.3, doc/Object.3: Documented that Tcl_Obj's standard
+ string form is a modified UTF-8; apparently, this was not mentioned
+ anywhere in the main docs, and lead to [Bug 624919].
2002-10-21 Daniel Steffen <das@users.sourceforge.net>
@@ -449,50 +438,50 @@
* win/makefile.vc:
* win/makefile.bc: Updated to reg1.1
- * doc/registry.n: Added support for broadcasting changes to
- * tests/registry.test: the registry Environment. Noted proper code
- * win/tclWinReg.c: in the docs. [Patch #625453]
+ * doc/registry.n: Added support for broadcasting changes to the
+ * tests/registry.test: registry Environment. Noted proper code in the
+ * win/tclWinReg.c: docs. [Patch 625453]
* unix/Makefile.in (dist): add any mac/tcl*.sea.hqx files
2002-10-17 Don Porter <dgp@users.sourceforge.net>
* generic/tclVar.c: Fixed code that check for proper # of args to
- * tests/var.test: [array names]. Added test. [Bug 624755]
+ * tests/var.test: [array names]. Added test. [Bug 624755]
2002-10-16 Jeff Hobbs <jeffh@ActiveState.com>
* win/configure: add workaround for cygwin windres
- * win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch #624010] (howell)
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch 624010] (howell)
2002-10-15 Jeff Hobbs <jeffh@ActiveState.com>
* README: added archives.tcl.tk note
* unix/configure:
- * unix/tcl.m4: Correct AIX-5 ppc build flags.
- Correct HP 11 64-bit gcc building. [Patch #601051] (martin)
+ * unix/tcl.m4: Correct AIX-5 ppc build flags. Correct HP 11 64-bit gcc
+ building. [Patch 601051] (martin)
2002-10-15 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclCmdMZ.c:
- * tests/trace.test: applied patch from Hemang Levana to fix
- [Bug #615043] in execution traces with idle tasks firing.
+ * tests/trace.test: applied patch from Hemang Levana to fix [Bug
+ 615043] in execution traces with idle tasks firing.
2002-10-14 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak.
- [Patch #623269] (brouwers)
+ * generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak. [Patch
+ 623269] (brouwers)
2002-10-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tcl.h: Need a different strategy through the maze of
- #defines to let people building with Cygwin build correctly. Also
- made some comments less misleading...
+ #defines to let people building with Cygwin build correctly. Also made
+ some comments less misleading...
2002-10-10 Jeff Hobbs <jeffh@ActiveState.com>
- * README: fixed minor nits [Bug #607776] (virden)
+ * README: fixed minor nits [Bug 607776] (virden)
* win/configure:
* win/tcl.m4: enable USE_THREAD_ALLOC (new threaded allocator) by
@@ -500,10 +489,10 @@
2002-10-10 Don Porter <dgp@users.sourceforge.net>
- * doc/Tcl.n: Clarified that namespace separators are legal in
- the variable names during $-subtitution. [Bug 615139]
-
- * doc/regexp.n: Typo correction. Thanks Ronnie Brunner. [Bug 606826]
+ * doc/Tcl.n: Clarified that namespace separators are legal in the
+ variable names during $-subtitution. [Bug 615139]
+
+ * doc/regexp.n: Typo correction. Thanks Ronnie Brunner. [Bug 606826]
2002-10-10 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -514,10 +503,9 @@
* unix/tclLoadNext.c
* unix/tclLoadOSF.c
* unix/tclLoadShl.c
- * win/tclWinLoad.c: allow either full paths or simply dll names
- to be specified when loading files (the latter will be looked
- up by the OS on your PATH/LD_LIBRARY_PATH as appropriate).
- Fixes [Bug 611108]
+ * win/tclWinLoad.c: allow either full paths or simply dll names to be
+ specified when loading files (the latter will be looked up by the OS
+ on your PATH/LD_LIBRARY_PATH as appropriate). Fixes [Bug 611108]
2002-10-09 Jeff Hobbs <jeffh@ActiveState.com>
@@ -530,10 +518,9 @@
2002-10-09 Kevin B. Kenny <kennykb@acm.org>
- * win/tclWinTime.c: Added code to set an exit handler that
- terminates the thread that calibrates the performance counter, so
- that the thread won't outlive unloading the Tcl DLL. [Tcl bug
- 620735].
+ * win/tclWinTime.c: Added code to set an exit handler that terminates
+ the thread that calibrates the performance counter, so that the thread
+ won't outlive unloading the Tcl DLL. [Bug 620735]
2002-10-09 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -551,19 +538,19 @@
* generic/tclStubInit.c: regen.
* generic/tclCompile.h: added prototype for TclCompileVariableCmd.
- * mac/tclMacPort.h: removed incorrect <fcntl.h> definitions
- and obsolete <stat.h> definitions.
- * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced
- associated constants with the <fcntl.h> analogues (they existing
- defs were inconsistent with <fcntl.h> which was causing havoc when
+ * mac/tclMacPort.h: removed incorrect <fcntl.h> definitions and
+ obsolete <stat.h> definitions.
+ * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced
+ associated constants with the <fcntl.h> analogues (they existing defs
+ were inconsistent with <fcntl.h> which was causing havoc when
Tcl_GetOpenMode was used instead of private GetOpenMode).
- * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent
- (and identically named) routine from MoreFiles instead.
+ * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and
+ identically named) routine from MoreFiles instead.
* mac/tclMacLoad.c: CONSTification, fixes to Vince's last changes.
- * mac/tclMacFile.c:
+ * mac/tclMacFile.c:
* mac/tclMacTest.c:
* mac/tclMacUnix.c: CONSTification.
@@ -571,14 +558,14 @@
fix for missing autoname token from TclOSACompileCmd. (bdesgraupes)
* mac/AppleScript.html(AppleScript delete): doc fix. (bdesgraupes)
- * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3,
+ * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3,
updated build instructions for 8.4.
* mac/tclMacProjects.sea.hqx: rebuilt archive.
2002-10-09 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/Alloc.3: Added a note to mention that attempting to allocate
- a zero-length block can return NULL. [Tk bug 619544]
+ * doc/Alloc.3: Added a note to mention that attempting to allocate a
+ zero-length block can return NULL. [Tk Bug 619544]
2002-10-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -590,18 +577,18 @@
2002-10-03 Don Porter <dgp@users.sourceforge.net>
- * doc/tcltest.n: fixed typo [Bug 618018]. Thanks to "JJM".
+ * doc/tcltest.n: fixed typo [Bug 618018]. Thanks to "JJM".
2002-10-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tools/man2help2.tcl:
- * tests/http.test, tests/httpd, tests/httpold.test:
- * tests/env.test, tests/binary.test, tests/autoMkindex.test:
- * library/init.tcl, library/http/http.tcl: [info exist] should
- really be [info exists]. [Bug 602566]
+ * tools/man2help2.tcl:
+ * tests/http.test, tests/httpd, tests/httpold.test:
+ * tests/env.test, tests/binary.test, tests/autoMkindex.test:
+ * library/init.tcl, library/http/http.tcl: [info exist] should really
+ be [info exists]. [Bug 602566]
- * doc/lsearch.n: Better specification of what happens when -sorted
- is mixed with other options. [Bug 617816]
+ * doc/lsearch.n: Better specification of what happens when -sorted is
+ mixed with other options. [Bug 617816]
2002-10-01 Jeff Hobbs <jeffh@ActiveState.com>
@@ -611,33 +598,33 @@
2002-10-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/socket.n: Mentioned that ports may be specified as serivce
- names as well as integers. [Bug 616843]
+ * doc/socket.n: Mentioned that ports may be specified as serivce names
+ as well as integers. [Bug 616843]
2002-09-30 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclCompCmds.c (TclCompileRegexpCmd): correct the
- checking for bad re's that didn't terminate the re string.
- Resultant compiles were correct, but much slower than necessary.
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): correct the checking
+ for bad re's that didn't terminate the re string. Resultant compiles
+ were correct, but much slower than necessary.
2002-09-29 David Gravereaux <davygrvy@pobox.com>
* win/tclAppInit.c: Added proper exiting conditions using Win32
- console signals. This handles the existing lack of a Ctrl+C exit
- to call exit handlers when built for thread support. Also, properly
+ console signals. This handles the existing lack of a Ctrl+C exit to
+ call exit handlers when built for thread support. Also, properly
handles exits from other conditions such as CTRL_CLOSE_EVENT,
- CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases,
- exit handlers will be called. [Bug 219355]
+ CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases,
+ exit handlers will be called. [Bug 219355]
- * win/makefile.vc: Added missing tclThreadAlloc.c to the build
- rules and defines USE_THREAD_ALLOC when TCL_THREADS is defined
- to get the new behavior by default.
+ * win/makefile.vc: Added missing tclThreadAlloc.c to the build rules
+ and defines USE_THREAD_ALLOC when TCL_THREADS is defined to get the
+ new behavior by default.
2002-09-27 Don Porter <dgp@users.sourceforge.net>
- * README: Bumped to version 8.4.1 to avoid confusion
- * generic/tcl.h: of CVS snapshots with the actual 8.4.0
- * tools/tcl.wse.in: release.
+ * README: Bumped to version 8.4.1 to avoid confusion of
+ * generic/tcl.h: CVS snapshots with the actual 8.4.0 release.
+ * tools/tcl.wse.in:
* unix/configure.in:
* unix/tcl.spec:
* win/configure.in:
@@ -650,17 +637,17 @@
* unix/configure: regen.
* unix/tcl.m4: improve AIX-4/5 64bit compilation support.
- * generic/tclProc.c (Tcl_ProcObjCmd): correct overeager
- optimization of noop proc to handle the precompiled case. (sofer)
+ * generic/tclProc.c (Tcl_ProcObjCmd): correct overeager optimization
+ of noop proc to handle the precompiled case. (sofer)
* unix/ldAix (nmopts): add -X32_64 to make it work for 32 or 64bit
mode compilation.
- * library/encoding/koi8-u.enc: removed extraneous spaces that
- confused encoding reader. [Bug #615115]
+ * library/encoding/koi8-u.enc: removed extraneous spaces that confused
+ encoding reader. [Bug 615115]
- * unix/Makefile.in: generate source dists with -src designator and
- do not generate .Z anymore (just .gz and .zip).
+ * unix/Makefile.in: generate source dists with -src designator and do
+ not generate .Z anymore (just .gz and .zip).
2002-09-18 Mumit Khan <khan@nanotech.wisc.edu>
@@ -669,39 +656,38 @@
* win/tcl.m4 (SC_PATH_TCLCONFIG): Support one-tree build.
(SC_PATH_TKCONFIG): Likewise.
(SC_PROG_TCLSH): Likewise.
- (SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin
- flags. Add -mwin32 to extra_cflags and extra_ldflags.
- Remove ``-e _WinMain@16'' from LDFLAGS_WINDOW.
+ (SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin
+ flags. Add -mwin32 to extra_cflags and extra_ldflags. Remove ``-e
+ _WinMain@16'' from LDFLAGS_WINDOW.
* win/configure.in: Allow Cygwin build.
(SEH test): Define to be 1 instead of empty value.
(EXCEPTION_DISPOSITION): Add test.
* win/configure: Regenerate.
- * generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let
- the user decide whether to use Windows or POSIX personality.
- (TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define
- for Cygwin.
- * generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for
+ * generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let the
+ user decide whether to use Windows or POSIX personality.
+ (TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define for
Cygwin.
- * generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX
- to native format.
+ * generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for Cygwin.
+ * generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX to
+ native format.
(TclDoGlob): Likewise.
* generic/tclPlatDecls.h (TCHAR): Define for Cygwin.
- * win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree,
- TclpSysRealloc): Define for Cygwin.
+ * win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree,
+ (TclpSysRealloc): Define for Cygwin.
2002-09-26 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Makefile: preserve environment value of INSTALL_ROOT.
- When embedding only use deployment build. Force relink before
- embedded build to ensure new linker flags are picked up.
+ * macosx/Makefile: preserve environment value of INSTALL_ROOT. When
+ embedding only use deployment build. Force relink before embedded
+ build to ensure new linker flags are picked up.
- * macosx/Tcl.pbproj/project.pbxproj: add symbolic links to
- debug lib, stub libs and tclConfig.sh in framework toplevel.
- Configure target dependency fix. Fix to 'clean' action. Added
- private tcl headers to framework. Install tclsh symbolic link.
- Html doc build works when no installed tclsh available. Made
- html doc structure in framework more like in Apple frameworks.
+ * macosx/Tcl.pbproj/project.pbxproj: add symbolic links to debug lib,
+ stub libs and tclConfig.sh in framework toplevel. Configure target
+ dependency fix. Fix to 'clean' action. Added private tcl headers to
+ framework. Install tclsh symbolic link. Html doc build works when no
+ installed tclsh available. Made html doc structure in framework more
+ like in Apple frameworks.
2002-09-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -709,52 +695,49 @@
detection to close [Bug 613117] on more systems.
* generic/tclCompile.c (TclPrintSource): More CONSTifying.
- * generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce
- warnings. Thanks to 'CoderX2' on the chat for bringing this to my
- attention...
+ * generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce warnings.
+ Thanks to 'CoderX2' on the chat for bringing this to my attention...
* unix/tcl.m4: Forgot to define TCL_WIDE_INT_IS_LONG at the
- appropriate moment. I believe this is the cause of [Bug 613117]
+ appropriate moment. I believe this is the cause of [Bug 613117]
- * doc/lset.n: Changed 'list' to 'varName' for consistency with
- lappend documentation. Thanks to Glenn Jackman [Bug 611719]
+ * doc/lset.n: Changed 'list' to 'varName' for consistency with lappend
+ documentation. Thanks to Glenn Jackman [Bug 611719]
2002-09-22 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within
- test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788]
- Also corrected reporting of body return code. Thanks to David
- Taback [Bug 611922]
+ test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also
+ corrected reporting of body return code. Thanks to David Taback [Bug
+ 611922]
* library/tcltest/pkgIndex.tcl: Bump to version 2.2.1.
* tests/tcltest.test: added tests for these bugs.
2002-09-15 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM
- define under Linux. This is used by Tk to double
- check that an X input context is cleaned up
- before it is closed.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM define under
+ Linux. This is used by Tk to double check that an X input context is
+ cleaned up before it is closed.
2002-09-12 David Gravereaux <davygrvy@pobox.com>
- * win/coffbase.txt: Added BLT to the virtual base address
- listings table should BLT's build tools decide to use it.
+ * win/coffbase.txt: Added BLT to the virtual base address listings
+ table should BLT's build tools decide to use it.
2002-09-12 Daniel Steffen <das@users.sourceforge.net>
* generic/tcl.h:
* mac/tclMacApplication.r:
* mac/tclMacLibrary.r:
- * mac/tclMacResource.r: unified use of the two equivalent
- resource compiler header inclusion defines RC_INVOKED and
- RESOURCE_INCLUDED, now use RC_INVOKED throughout.
+ * mac/tclMacResource.r: unified use of the two equivalent resource
+ compiler header inclusion defines RC_INVOKED and RESOURCE_INCLUDED,
+ now use RC_INVOKED throughout.
2002-09-10 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/README: Add note about building extensions
- with the same compiler Tcl was built with.
- [Tk Bug 592096]
+ * unix/README: Add note about building extensions with the same
+ compiler Tcl was built with. [Tk Bug 592096]
2002-09-10 Daniel Steffen <das@users.sourceforge.net>
@@ -763,8 +746,8 @@
2002-09-10 Daniel Steffen <das@users.sourceforge.net>
- * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx
- and set it to default value ${LIB_RUNTIME_DIR}
+ * unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx and
+ set it to default value ${LIB_RUNTIME_DIR}
* unix/tcl.m4 (Darwin): use DYLIB_INSTALL_DIR instead of
LIB_RUNTIME_DIR in the -install_name argument to ld.
* unix/configure: regen.
@@ -774,7 +757,7 @@
framework, i.e. using an dyld install_name containing
@executable_path/../Frameworks via the new DYLIB_INSTALL_DIR
unix/Makefile variable.
-
+
2002-09-10 Jeff Hobbs <jeffh@ActiveState.com>
*** 8.4.0 TAGGED FOR RELEASE ***
@@ -796,38 +779,38 @@
* generic/tclBasic.c (TclRenameCommand,CallCommandTraces):
* tests/trace.test (trace-27.1): Corrected memory leak when a rename
- trace deleted the command being traced. Test added. Thanks to
- Hemang Lavana for the fix. [Bug 604609]
+ trace deleted the command being traced. Test added. Thanks to Hemang
+ Lavana for the fix. [Bug 604609]
* generic/tclVar.c (TclDeleteVars): Corrected logic for setting the
TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121]
2002-09-04 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks
- to dkf and dgp for the long and difficult discussion in the chat.
+ * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks to
+ dkf and dgp for the long and difficult discussion in the chat.
2002-09-03 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto
* unix/configure: remove -pthread from LIBS on FreeBSD in thread
- * unix/tcl.m4: enabled build. [Bug #602849]
+ * unix/tcl.m4: enabled build. [Bug 602849]
2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error
return from TclPreventAliasLoop.
-
+
2002-09-03 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to
- 8.4.0 and updated copyright info.
+ * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to 8.4.0
+ and updated copyright info.
2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on
- error return from TclGetFrame.
+ * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on error
+ return from TclGetFrame.
2002-09-03 Don Porter <dgp@users.sourceforge.net>
@@ -835,15 +818,15 @@
2002-09-02 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed
- extra native char*.
+ * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed extra
+ native char*.
* unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init
flags field of TcpState ptr to 0.
* unix/configure:
* unix/tcl.m4: added 64-bit gcc compilation support on HP-11.
- [Patch #601051] (martin)
+ [Patch 601051] (martin)
* README: Bumped version number to 8.4.0
* generic/tcl.h:
@@ -856,12 +839,12 @@
* win/configure.in:
* generic/tclInterp.c (SlaveCreate): make sure that the memory and
- checkmem commands are initialized in non-safe slave interpreters
- when TCL_MEM_DEBUG is used. [Bug #583445]
+ checkmem commands are initialized in non-safe slave interpreters when
+ TCL_MEM_DEBUG is used. [Bug 583445]
- * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable
- pipe if there was something to write. This may prevent infinite
- wait on exit.
+ * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe
+ if there was something to write. This may prevent infinite wait on
+ exit.
* tests/exec.test: marked exec-18.1 unixOnly until the Windows
incompatability (in the test, not the core) can be resolved.
@@ -881,60 +864,60 @@
2002-08-31 Daniel Steffen <das@users.sourceforge.net>
- *** macosx-8-4-branch merged into the mainline [tcl patch #602770] ***
+ *** macosx-8-4-branch merged into the mainline [Patch 602770] ***
* generic/tcl.decls: added new macosx specific entry to stubs table.
* tools/genStubs.tcl: added generation of platform guards for
- macosx. This is a little more complex than it seems, because MacOS
- X IS "unix" plus a little bit, for the purposes of Tcl. BUT
- unfortunately, Tk uses "unix" to mean X11. So added platform keys
- for macosx (the little added to "unix"), "aqua" and "x11" to
- distinguish these for Tk.
-
- * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h
- can be passed to the resource compiler.
-
+ macosx. This is a little more complex than it seems, because MacOS X
+ IS "unix" plus a little bit, for the purposes of Tcl. BUT
+ unfortunately, Tk uses "unix" to mean X11. So added platform keys for
+ macosx (the little added to "unix"), "aqua" and "x11" to distinguish
+ these for Tk.
+
+ * generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h can
+ be passed to the resource compiler.
+
* generic/tcl.h:
* generic/tclNotify.c: added a few Notifier procs, to be able to
- modify more bits of the Tcl notifier dynamically. Required to get
- Mac OS X Tk to live on top of the Tcl Unix threaded notifier.
- Changes the size of the Tcl_NotifierProcs structure, but doesn't
- move any elements around.
+ modify more bits of the Tcl notifier dynamically. Required to get Mac
+ OS X Tk to live on top of the Tcl Unix threaded notifier. Changes the
+ size of the Tcl_NotifierProcs structure, but doesn't move any elements
+ around.
* unix/tclUnixNotfy.c: moved the call to Tcl_ConditionNotify till
- AFTER we are done mucking with the pointer swap. Fixes cases where
- the thread waiting on the condition wakes & accesses the
- waitingListPtr before it gets reset, causing a hang.
+ AFTER we are done mucking with the pointer swap. Fixes cases where the
+ thread waiting on the condition wakes & accesses the waitingListPtr
+ before it gets reset, causing a hang.
- * library/auto.tcl (tcl_findLibrary): added checking the
- directories in the tcl_pkgPath for library files on macosx to
- enable support of the standard Mac OSX library locations
+ * library/auto.tcl (tcl_findLibrary): added checking the directories
+ in the tcl_pkgPath for library files on macosx to enable support of
+ the standard Mac OSX library locations.
* unix/Makefile.in:
* unix/configure.in:
- * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS:
- there are some MacOS X specific files now for Tcl, and when I get
- he resource & applescript stuff ported over, and restore support
- for FindFiles, etc, there will be a few more.
- Added LD_LIBRARY_PATH_VAR configure variable to avoid having to set
- all possible LD_LIBRARY_PATH analogues on all platforms.
- LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH" by default, "LIBPATH" on
- AIX, "SHLIB_PATH" on HPUX and "DYLD_LIBRARY_PATH" on Mac OSX.
- Added configure option to package Tcl as a framework on Mac OSX.
+ * unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS: there
+ are some MacOS X specific files now for Tcl, and when I get the
+ resource & applescript stuff ported over, and restore support for
+ FindFiles, etc, there will be a few more. Added LD_LIBRARY_PATH_VAR
+ configure variable to avoid having to set all possible LD_LIBRARY_PATH
+ analogues on all platforms. LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH"
+ by default, "LIBPATH" on AIX, "SHLIB_PATH" on HPUX and
+ "DYLD_LIBRARY_PATH" on Mac OSX. Added configure option to package Tcl
+ as a framework on Mac OSX.
* macosx/tclMacOSXBundle.c (new): support for finding Tcl extension
packaged as 'bundles' in the standard Mac OSX library locations.
- * unix/tclUnixInit.c: added support for findig the tcl script
- library inside Tcl packaged as a framework on Mac OSX.
+ * unix/tclUnixInit.c: added support for findig the tcl script library
+ inside Tcl packaged as a framework on Mac OSX.
* macosx/Tcl.pbproj/jingham.pbxuser (new):
* macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's
ProjectBuilder IDE.
- * macosx/Makefile (new): simple makefile for building the project
- from the command line via the ProjectBuilder tool 'pbxbuild'.
+ * macosx/Makefile (new): simple makefile for building the project from
+ the command line via the ProjectBuilder tool 'pbxbuild'.
* unix/configure:
* generic/tclStubInit.c:
@@ -943,19 +926,18 @@
2002-08-29 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache):
- Applied patch for bug #599428, provided by Miguel Sofer
- <msofer@users.sourceforge.net>.
+ Applied patch for [Bug 599428], provided by Miguel Sofer
+ <msofer@users.sourceforge.net>.
2002-08-28 David Gravereaux <davygrvy@pobox.com>
* generic/tclEnv.c:
* unix/configure.in:
- * win/tclWinPort.h: putenv() on some systems copies the buffer
- rather than taking reference to it. This causes memory leaks
- and is know to effect mswindows (msvcrt) and NetBSD 1.5.2 . This
- patch tests for this behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1
- when approriate. Thanks to David Welton for assistance.
- [Bug 414910]
+ * win/tclWinPort.h: putenv() on some systems copies the buffer rather
+ than taking reference to it. This causes memory leaks and is know to
+ effect mswindows (msvcrt) and NetBSD 1.5.2 . This patch tests for this
+ behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1 when approriate.
+ Thanks to David Welton for assistance. [Bug 414910]
* unix/configure: regen'd
@@ -963,47 +945,47 @@
* doc/eval.n: Added mention of list command and corrected "SEE ALSO".
- * unix/configure.in: Cache handling of ac_cv_type_socklen_t was
- wrong. [Bug 600931] reported by John Ellson. Fixed by putting the
- brackets where they belong.
+ * unix/configure.in: Cache handling of ac_cv_type_socklen_t was wrong.
+ [Bug 600931] reported by John Ellson. Fixed by putting the brackets
+ where they belong.
2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompCmds.c: fix for [Bug 599788] (error in element
- name causing segfault), reported by Tom Wilkason. Fixed by copying
- the tokens instead of the source string.
+ * generic/tclCompCmds.c: fix for [Bug 599788] (error in element name
+ causing segfault), reported by Tom Wilkason. Fixed by copying the
+ tokens instead of the source string.
2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclThreadAlloc.c: small optimisation, reducing the
- new allocator's overhead.
-
+ * generic/tclThreadAlloc.c: small optimisation, reducing the new
+ allocator's overhead.
+
2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936].
- Thanks to Zoran Vasiljevic.
+ * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936]. Thanks
+ to Zoran Vasiljevic.
2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects
- between caches as a block, instead of one-by-one.
+ * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects between
+ caches as a block, instead of one-by-one.
2002-08-22 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c:
- * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces
- [Bug 589863], patch by Hemang Lavana.
+ * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces [Bug
+ 589863], patch by Hemang Lavana.
2002-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/Makefile.in (CFLAGS):
+ * win/Makefile.in (CFLAGS):
* unix/Makefile.in (MEM_DEBUG_FLAGS): Added usage of @MEM_DEBUG_FLAGS@.
* win/configure.in:
* unix/configure.in: Added usage of SC_ENABLE_MEMDEBUG.
* win/tcl.m4:
* unix/tcl.m4: Added macro SC_ENABLE_MEMDEBUG. Allows a user of
- configure to (de)activate memory validation and debugging
- (TCL_MEM_DEBUG). No need to modify the makefile anymore.
+ configure to (de)activate memory validation and debugging
+ (TCL_MEM_DEBUG). No need to modify the makefile anymore.
2002-08-20 Don Porter <dgp@users.sourceforge.net>
@@ -1021,9 +1003,9 @@
* win/configure:
* library/http/http.tcl: Corrected installation directory of
- * library/msgcat/msgcat.tcl: the package tcltest 2.2. Added
+ * library/msgcat/msgcat.tcl: the package tcltest 2.2. Added
* library/opt/optparse.tcl: comments in other packages to remind
- * library/tcltest/tcltest.tcl: that installation directories need
+ * library/tcltest/tcltest.tcl: that installation directories need
* unix/Makefile.in: updates to match increasing version
* win/Makefile.in: numbers. [Bug 597450]
* win/makefile.bc:
@@ -1031,50 +1013,48 @@
2002-08-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * unix/tclUnixTest.c (TestfilehandlerCmd): Changed
- readable/writable to the more common readable|writable.
-
- Fixes SF #596034 reported by Larry Virden
- <lvirden@users.sourceforge.net>.
+ * unix/tclUnixTest.c (TestfilehandlerCmd): Changed readable/writable
+ to the more common readable|writable. Fixes [Bug 596034] reported by
+ Larry Virden <lvirden@users.sourceforge.net>.
2002-08-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/fCmd.test: Added test to make sure that the cause of the
problem is detectable with an unpatched Tcl.
- * doc/ObjectType.3: Added note on the root cause of this problem
- to the documentation, since it is possible for user code to
- trigger this sort of behaviour too.
+ * doc/ObjectType.3: Added note on the root cause of this problem to
+ the documentation, since it is possible for user code to trigger this
+ sort of behaviour too.
* generic/tclIOUtil.c (SetFsPathFromAny): Objects should only have
their old representation deleted when we know that we are about to
- install a new one. This stops a weird TclX bug under Linux with
- certain kinds of memory debugging enabled which essentally came
- down to a double-free of a string.
+ install a new one. This stops a weird TclX bug under Linux with
+ certain kinds of memory debugging enabled which essentally came down
+ to a double-free of a string.
2002-08-14 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclInt.h:
- * generic/tclObj.c: (code cleanup) factored the parts in the macros
+ * generic/tclObj.c: (code cleanup) factored the parts in the macros
TclNewObj() / TclDecrRefCount() into a common part for all
memory allocators and two new macros TclAllocObjStorage() /
TclFreeObjStorage() that are specific to each allocator and fully
describe the differences. Removed allocator-specific code from
tclObj.c by using the macros.
-
+
2002-08-12 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863].
-
+
2002-08-08 David Gravereaux <davygrvy@pobox.com>
- * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap
- wasn't specified $argc was off by one.
+ * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap wasn't
+ specified $argc was off by one.
2002-08-08 Miguel Sofer <msofer@users.sourceforge.net>
* tests/uplevel.test: added 6.1 to test [uplevel] with shadowed
commands [Bug 524383]
- * tests/subst.test: added 5.8-10 as further tests for [Bug 495207]
+ * tests/subst.test: added 5.8-10 as further tests for [Bug 495207]
2002-08-08 Don Porter <dgp@users.sourceforge.net>
@@ -1089,10 +1069,9 @@
* tests/fCmd.test:
* tests/unixFCmd.test: updated tests for new link copy behavior.
* generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to
- follow links to endpoints and copy that file/directory instead of
- just copying the surface link. This means that trying to copy a
- link that has no endpoint (danling link) is an error.
- [Patch #591647] (darley)
+ follow links to endpoints and copy that file/directory instead of just
+ copying the surface link. This means that trying to copy a link that
+ has no endpoint (danling link) is an error. [Patch 591647] (darley)
(CopyRenameOneFile): this is currently disabled by default until
further issues with such behavior (like relative links) can be
handled correctly.
@@ -1102,32 +1081,32 @@
2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
* docs/BoolObj.3: added description of valid string reps for a
- boolean object [Bug 584794]
+ boolean object. [Bug 584794]
* generic/tclObj.c: optimised Tcl_GetBooleanFromObj and
SetBooleanFromAny to avoid parsing the string rep when it can be
- avoided [Bugs 584650, 472576]
-
+ avoided. [Bugs 584650, 472576]
+
2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCompile.h:
- * generic/tclObj.c: making tclCmdNameType static ([Bug 584567],
- Don Porter).
-
+ * generic/tclObj.c: making tclCmdNameType static ([Bug 584567], Don
+ Porter).
+
2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclObj.c (Tcl_NewObj): added conditional code for
USE_THREAD_ALLOC; objects allocated through Tcl_NewObj() were
otherwise being leaked. [Bug 587488] reported by Sven Sass.
-
+
2002-08-06 Daniel Steffen <das@users.sourceforge.net>
* generic/tclInt.decls:
* unix/tclUnixThrd.c: Added stubs and implementations for
non-threaded build for the tclUnixThrd.c procs TclpReaddir,
- TclpLocaltime, TclpGmtime and TclpInetNtoa.
- Fixes link errors in stubbed & threaded extensions that include
- tclUnixPort.h and use any of the procs readdir, localtime,
- gmtime or inet_ntoa (e.g. TclX 8.4) [Bug 589526]
+ TclpLocaltime, TclpGmtime and TclpInetNtoa. Fixes link errors in
+ stubbed & threaded extensions that include tclUnixPort.h and use any
+ of the procs readdir, localtime, gmtime or inet_ntoa (e.g. TclX 8.4)
+ [Bug 589526]
* generic/tclIntPlatDecls.h:
* generic/tclStubInit.c: Regen.
@@ -1135,57 +1114,57 @@
* library/tcltest/tcltest.tcl: The setup and cleanup scripts are now
* library/tcltest/pkgIndex.tcl: skipped when a test is skipped, fixing
- * tests/tcltest.test: [Bug 589859]. Test for bug added, and
+ * tests/tcltest.test: [Bug 589859]. Test for bug added, and
corrected tcltest package bumped to version 2.2.
- * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like
+ * generic/tcl.decls: Restored Tcl_Concat to return (char *). Like
* generic/tclDecls.h: Tcl_Merge, it transfers ownership of a dynamic
* generic/tclUtil.c: allocated string to the caller.
2002-08-04 Don Porter <dgp@users.sourceforge.net>
- * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify
- * doc/Concat.3: all remaining public interfaces of Tcl.
- * doc/CrtCommand.3: Notably, the parser no longer writes on
- * doc/CrtSlave.3: the string it is parsing, so it is no
- * doc/CrtTrace.3: longer necessary for Tcl_Eval() to be
- * doc/Eval.3: given a writable string. Also, the
- * doc/ExprLong.3: refactoring of the Tcl_*Var* routines
- * doc/LinkVar.3: by Miguel Sofer is included, so that the
- * doc/ParseCmd.3: "part1" argument for them no longer needs
- * doc/SetVar.3: to be writable either.
+ * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify all
+ * doc/Concat.3: remaining public interfaces of Tcl. Notably,
+ * doc/CrtCommand.3: the parser no longer writes on the string it
+ * doc/CrtSlave.3: is parsing, so it is no longer necessary for
+ * doc/CrtTrace.3: Tcl_Eval() to be given a writable string. Also
+ * doc/Eval.3: the refactoring of the Tcl_*Var* routines by
+ * doc/ExprLong.3: by Miguel Sofer is included, so that the
+ * doc/LinkVar.3: "part1" argument for them no longer needs to
+ * doc/ParseCmd.3: be writable either.
+ * doc/SetVar.3:
* doc/TraceVar.3:
* doc/UpVar.3: Compatibility support has been enhanced so
- * generic/tcl.decls that a #define of USE_NON_CONST will remove
- * generic/tcl.h all possible source incompatibilities with
- * generic/tclBasic.c the 8.3 version of the header file(s).
- * generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does
- * generic/tclCompCmds.c what USE_NON_CONST used to do -- disable
- * generic/tclCompExpr.c only those new CONST's that introduce
- * generic/tclCompile.c irreconcilable incompatibilities.
- * generic/tclCompile.h
- * generic/tclDecls.h Several bugs are also fixed by this patch.
- * generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429]
- * generic/tclEvent.c
- * generic/tclInt.decls
- * generic/tclInt.h
- * generic/tclIntDecls.h
- * generic/tclInterp.c
- * generic/tclLink.c
- * generic/tclObj.c
- * generic/tclParse.c
- * generic/tclParseExpr.c
- * generic/tclProc.c
- * generic/tclTest.c
- * generic/tclUtf.c
- * generic/tclUtil.c
- * generic/tclVar.c
- * mac/tclMacTest.c
- * tests/expr-old.test
- * tests/parseExpr.test
- * unix/tclUnixTest.c
- * unix/tclXtTest.c
- * win/tclWinTest.c
+ * generic/tcl.decls: that a #define of USE_NON_CONST will remove
+ * generic/tcl.h: all possible source incompatibilities with the
+ * generic/tclBasic.c: 8.3 version of the header file(s). The new
+ * generic/tclCmdMZ.c: #define of USE_COMPAT_CONST now does what
+ * generic/tclCompCmds.c:USE_NON_CONST used to do -- disable only those
+ * generic/tclCompExpr.c:new CONST's that introduce irreconcilable
+ * generic/tclCompile.c: incompatibilities.
+ * generic/tclCompile.h:
+ * generic/tclDecls.h: Several bugs are also fixed by this patch.
+ * generic/tclEnv.c: [Bugs 584051,580433] [Patches 585105,582429]
+ * generic/tclEvent.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclInterp.c:
+ * generic/tclLink.c:
+ * generic/tclObj.c:
+ * generic/tclParse.c:
+ * generic/tclParseExpr.c:
+ * generic/tclProc.c:
+ * generic/tclTest.c:
+ * generic/tclUtf.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+ * mac/tclMacTest.c:
+ * tests/expr-old.test:
+ * tests/parseExpr.test:
+ * unix/tclUnixTest.c:
+ * unix/tclXtTest.c:
+ * win/tclWinTest.c:
2002-08-01 Miguel Sofer <msofer@users.sourceforge.net>
@@ -1195,28 +1174,27 @@
2002-08-01 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c: added a reference count for the complete
- execution stack, instead of Tcl_Preserve/Tcl_Release.
+ execution stack, instead of Tcl_Preserve/Tcl_Release.
2002-08-01 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclCkalloc.c (TclFinalizeMemorySubsystem):
- Don't lock the ckalloc mutex before invoking the
- Tcl_DumpActiveMemory function since it also
- locks the same mutex. This code is only executed
- when "memory onexit filename" has been executed
- and Tcl is compiled with -DTCL_MEM_DEBUG.
+ * generic/tclCkalloc.c (TclFinalizeMemorySubsystem): Don't lock the
+ ckalloc mutex before invoking the Tcl_DumpActiveMemory function since
+ it also locks the same mutex. This code is only executed when "memory
+ onexit filename" has been executed and Tcl is compiled with
+ -DTCL_MEM_DEBUG.
2002-08-01 Reinhard Max <max@suse.de>
- * win/tclWinPort.h: The windows headers don't provide socklen_t,
- so we have to do it.
+ * win/tclWinPort.h: The windows headers don't provide socklen_t, so we
+ have to do it.
2002-07-31 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclInt.h (USE_THREAD_ALLOC): for unshared objects,
TclDecrRefCount now frees the internal rep before the string rep -
- just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802].
- For the other allocators the fix was done on 2002-03-06.
+ just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. For
+ the other allocators the fix was done on 2002-03-06.
2002-07-31 Miguel Sofer <msofer@users.sourceforge.net>
@@ -1230,134 +1208,125 @@
* unix/tcl.m4 (SC_BUGGY_STRTOD): Solaris 2.8 still has a buggy
strtod() implementation; make sure we detect it.
- * tests/expr.test (expr-22.*): Marked as non-portable because it
- seems that these tests have an annoying tendency to fail in
- unexpected ways. [Bugs 584825, 584950, 585986]
+ * tests/expr.test (expr-22.*): Marked as non-portable because it seems
+ that these tests have an annoying tendency to fail in unexpected ways.
+ [Bugs 584825, 584950, 585986]
2002-07-30 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tests/io.test:
+ * tests/io.test:
* generic/tclIO.c (WriteChars): Added flag to break out of loop if
- nothing of the input is consumed at all, to prevent infinite
- looping of called with a non-UTF-8 string. Fixes Bug 584603
- (partially). Added new test "io-60.1". Might need additional
- changes to Tcl_Main so that unprintable results are printed as
- binary data.
+ nothing of the input is consumed at all, to prevent infinite looping
+ of called with a non-UTF-8 string. Fixes Bug 584603 (partially). Added
+ new test "io-60.1". Might need additional changes to Tcl_Main so that
+ unprintable results are printed as binary data.
2002-07-29 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of
- LD_SEARCH_FLAGS when linking with ${CC}.
+ * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of LD_SEARCH_FLAGS
+ when linking with ${CC}.
* unix/configure: Regen.
- * unix/configure.in: Don't subst CC_SEARCH_FLAGS or
- LD_SEARCH_FLAGS since this is now done in tcl.m4.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and
- set CC_SEARCH_FLAGS whenever LD_SEARCH_FLAGS is set.
- [Tcl patch 588290]
+ * unix/configure.in: Don't subst CC_SEARCH_FLAGS or LD_SEARCH_FLAGS
+ since this is now done in tcl.m4.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and set CC_SEARCH_FLAGS
+ whenever LD_SEARCH_FLAGS is set. [Patch 588290]
2002-07-29 Reinhard Max <max@suse.de>
* unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when
configure's stdin is not a tty.
-
- * unix/tclUnixPort.h:
+
+ * unix/tclUnixPort.h:
* generic/tclIOSock.c: Changed size_t to socklen_t in
socket-related function calls.
* unix/configure.in: Added test and fallback definition
for socklen_t.
-
+
* unix/configure: generated.
2002-07-29 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclObj.c: fixed a comment
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to
- the interface of the Tcl_Eval* functions, removing the
- TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only
- require no tracebacks, but also look up the command name in the
- global scope - see new test interp-9.4
- * tests/interp.test: added 9.3 to test for safety of aliases to
- hidden commands, 9.4 to test for correct command lookup scope.
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to the
+ interface of the Tcl_Eval* functions, removing the
+ TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only
+ require no tracebacks, but also look up the command name in the global
+ scope - see new test interp-9.4
+ * tests/interp.test: added 9.3 to test for safety of aliases to hidden
+ commands, 9.4 to test for correct command lookup scope.
2002-07-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/regc_locale.c (cclass): [[:xdigit:]] is only a defined
- concept on western characters, so should not allow any unicode
- digit, and hence number of ranges in [[:xdigit:]] is fixed.
+ concept on western characters, so should not allow any unicode digit,
+ and hence number of ranges in [[:xdigit:]] is fixed.
* tests/reg.test: Added test to detect the bug.
* generic/regc_cvec.c (newcvec): Corrected initial size value in
- character vector structure. [Bug 578363] Many thanks to
+ character vector structure. [Bug 578363] Many thanks to
pvgoran@users.sf.net for tracking this down.
2002-07-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tcl.h:
- * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to
- the interface of the Tcl_Eval* functions. Modified the error
- message for too many nested evaluations.
+ * generic/tcl.h:
+ * generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to the
+ interface of the Tcl_Eval* functions. Modified the error message for
+ too many nested evaluations.
* generic/tclInterp.h: changed the Alias struct to be of variable
- length and store the prefix arguments directly (instead of a
- pointer to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv
- instead of TclObjInvoke - thus making aliases trigger execution
- traces [Bug 582522].
+ length and store the prefix arguments directly (instead of a pointer
+ to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv instead of
+ TclObjInvoke - thus making aliases trigger execution traces [Bug
+ 582522].
* tests/interp.test:
* tests/stack.test: adapted to the new error message.
- * tests/trace.test: added tests for aliases firing the exec
- traces.
+ * tests/trace.test: added tests for aliases firing the exec traces.
2002-07-27 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Revert fix for Tcl bug 529801
- since it was incorrect and broke the build on
- other systems. Fix Tcl bug 587299.
- Add MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL,
- SHLIB_LD_FLAGS, SHLIB_LD_LIBS, CC_SEARCH_FLAGS,
- LD_SEARCH_FLAGS, and LIB_FILE variables to support
- more generic library build/install rules.
+ * unix/Makefile.in: Revert fix for Tcl bug 529801 since it was
+ incorrect and broke the build on other systems. Fix [Bug 587299]. Add
+ MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL, SHLIB_LD_FLAGS,
+ SHLIB_LD_LIBS, CC_SEARCH_FLAGS, LD_SEARCH_FLAGS, and LIB_FILE
+ variables to support more generic library build/install rules.
* unix/configure: Regen.
- * unix/configure.in: Move AC_PROG_RANLIB into
- tcl.m4. Move shared build test and setting
- of MAKE_LIB and MAKE_STUB_LIB into tcl.m4.
- Move subst of a number of variables into
- tcl.m4 where they are defined.
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS):
- Subst vars where they are defined. Add MAKE_LIB,
- MAKE_STUB_LIB, INSTALL_LIB, and INSTALL_STUB_LIB
- rules to deal with the ugly details of running
- ranlib on static libs at build and install time.
- Replace TCL_SHLIB_LD_EXTRAS with SHLIB_LD_FLAGS
- and use it when building a shared library.
+ * unix/configure.in: Move AC_PROG_RANLIB into tcl.m4. Move shared
+ build test and setting of MAKE_LIB and MAKE_STUB_LIB into tcl.m4. Move
+ subst of a number of variables into tcl.m4 where they are defined.
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Subst vars where
+ they are defined. Add MAKE_LIB, MAKE_STUB_LIB, INSTALL_LIB, and
+ INSTALL_STUB_LIB rules to deal with the ugly details of running ranlib
+ on static libs at build and install time. Replace TCL_SHLIB_LD_EXTRAS
+ with SHLIB_LD_FLAGS and use it when building a shared library.
* unix/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS.
2002-07-26 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding
- to the macro NEXT_INST_V(x, 0, 1) [Bug 587495].
-
+ * generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding to
+ the macro NEXT_INST_V(x, 0, 1) [Bug 587495].
+
2002-07-26 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c (TclObjLookupVar): leak fix and improved
- comments.
+ * generic/tclVar.c (TclObjLookupVar): leak fix and improved comments.
2002-07-26 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclVar.c (TclLookupVar): removed early returns that
- prevented the parens from being restored. also removed goto label
- as it was not necessary.
+ prevented the parens from being restored. Also removed goto label as
+ it was not necessary.
2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c:
+ * generic/tclExecute.c:
* tests/expr-old.test: fix for erroneous error messages in [expr],
- [Bug 587140] reported by Martin Lemburg.
+ [Bug 587140] reported by Martin Lemburg.
2002-07-25 Joe English <jenglish@users.sourceforge.net>
- * generic/tclProc.c: fix for Tk Bug #219218 "error handling
- with bgerror in Tk"
+
+ * generic/tclProc.c: fix for [Tk Bug 219218] "error handling with
+ bgerror in Tk"
2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
@@ -1366,21 +1335,21 @@
2002-07-24 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15
- as a valid C encoding. [Bug 575336]
+ * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15 as a
+ valid C encoding. [Bug 575336]
2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: restoring the tcl_traceCompile
- functionality while I repair tcl_traceExec. The core now compiles
- and runs also under TCL_COMPILE_DEBUG, but execution in the
- bytecode engine can still not be traced.
+ * generic/tclExecute.c: restoring the tcl_traceCompile functionality
+ while I repair tcl_traceExec. The core now compiles and runs also
+ under TCL_COMPILE_DEBUG, but execution in the bytecode engine can
+ still not be traced.
2002-07-24 Daniel Steffen <das@users.sourceforge.net>
* unix/Makefile.in:
- * unix/configure.in: corrected fix for [Bug 529801]: ranlib
- only needed for static builds on Mac OS X.
+ * unix/configure.in: corrected fix for [Bug 529801]: ranlib only
+ needed for static builds on Mac OS X.
* unix/configure: Regen.
* unix/tclLoadDyld.c: fixed small bugs introduced by Vince,
implemented library unloading correctly (needs OS X 10.2).
@@ -1390,43 +1359,42 @@
* doc/OpenFileChnl.3: (Updates from Larry Virden)
* doc/open.n:
* doc/tclsh.1: Fix section numbers in Unix man page references.
- * doc/lset.n: In EXAMPLES section, include command to set the
- initial value used in subsequent examples.
+ * doc/lset.n: In EXAMPLES section, include command to set the initial
+ value used in subsequent examples.
* doc/http.n: Package version updated to 2.4.
2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation
- when using the native compiler on a 64 bit version of IRIX.
- [Tcl bug 219220]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation when using
+ the native compiler on a 64 bit version of IRIX. [Bug 219220]
2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Combine ranlib tests and
- avoid printing unless ranlib is actually run.
+ * unix/Makefile.in: Combine ranlib tests and avoid printing unless
+ ranlib is actually run.
2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead
- of "# no special path needed" or "# no include files found"
- when x headers cannot be located.
+ * unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead of "# no
+ special path needed" or "# no include files found" when x headers
+ cannot be located.
2002-07-22 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: made tclNativeFilesystem static
- (since 07-19 changes removed its usage elsewhere), and
- added comments about its usage.
+ * generic/tclIOUtil.c: made tclNativeFilesystem static (since 07-19
+ changes removed its usage elsewhere), and added comments about its
+ usage.
* generic/tclLoad.c:
* generic/tcl.h:
- * generic/tcl.decls:
- * doc/FileSystem.3: converted last load-related ClientData
- parameter to Tcl_LoadHandle opaque structure, removing a
- couple of casts in the process.
-
- * generic/tclInt.h: removed tclNativeFilesystem declaration
- since it is now static again.
-
+ * generic/tcl.decls:
+ * doc/FileSystem.3: converted last load-related ClientData parameter
+ to Tcl_LoadHandle opaque structure, removing a couple of casts in the
+ process.
+
+ * generic/tclInt.h: removed tclNativeFilesystem declaration since it
+ is now static again.
+
2002-07-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/expr.test (expr-22.*): Added tests to help detect the
@@ -1444,34 +1412,33 @@
* generic/tclIOUtil.c: fix to GetFilesystemRecord
* win/tclWinFile.c:
- * unix/tclUnixFile.c: fix to subtle problem with links shown
- up by latest tclkit builds.
+ * unix/tclUnixFile.c: fix to subtle problem with links shown up by
+ latest tclkit builds.
2002-07-19 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure:
* unix/configure.in:
* win/configure:
- * win/configure.in: Add AC_PREREQ(2.13) in an attempt
- to make it more clear that the configure scripts
- must be generated with autoconf version 2.13.
- [Bug 583573]
+ * win/configure.in: Add AC_PREREQ(2.13) in an attempt to make it more
+ clear that the configure scripts must be generated with autoconf
+ version 2.13. [Bug 583573]
2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net>
- * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug
- report and fix from jcw.
+ * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug report
+ and fix from jcw.
2002-07-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* win/tclWinSerial.c (no_timeout): Made this variable static.
- * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c:
+ * generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c:
* generic/tclCompile.h (builtinFuncTable, instructionTable): Added
prefix to these symbols because they are visible outside the Tcl
library.
- * generic/tclCompExpr.c (operatorTable):
+ * generic/tclCompExpr.c (operatorTable):
* unix/tclUnixTime.c (tmKey):
* generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify,
filesystemIteratorsInProgress, filesystemOkToModify): Made these
@@ -1480,18 +1447,18 @@
* unix/tclUnixFile.c: Renamed nativeFilesystem to
* win/tclWinFile.c: tclNativeFilesystem and declared
* generic/tclIOUtil.c: it properly in tclInt.h
- * generic/tclInt.h:
+ * generic/tclInt.h:
* generic/tclUtf.c (totalBytes): Made this array static and const.
* generic/tclParse.c (typeTable): Made this array static and const.
- (Tcl_ParseBraces): Simplified error handling case so that scans
- are only performed when needed, and flags are simpler too.
+ (Tcl_ParseBraces): Simplified error handling case so that scans are
+ only performed when needed, and flags are simpler too.
* license.terms: Added AS to list of copyright holders; it's only
fair for the current gatekeepers to be listed here!
- * tests/cmdMZ.test: Renamed constraint for clarity. [Bug#583427]
+ * tests/cmdMZ.test: Renamed constraint for clarity. [Bug 583427]
Added tests for the [time] command, which was previously only
indirectly tested!
@@ -1499,41 +1466,39 @@
* generic/tclInt.h:
* generic/tcl.h:
- * */*Load*.c: added comments on changes of 07/17 and
- replaced clientData with Tcl_LoadHandle in all locations.
+ * */*Load*.c: added comments on changes of 07/17 and replaced
+ clientData with Tcl_LoadHandle in all locations.
* generic/tclFCmd.c:
- * tests/fileSystem.test: fixed a 'knownBug' with 'file
- attributes ""'
- * tests/winFCmd.test:
+ * tests/fileSystem.test: fixed a 'knownBug' with 'file attributes ""'
+ * tests/winFCmd.test:
* tests/winPipe.test:
* tests/fCmd.test:
- * tessts/winFile.test: added 'pcOnly' constraint to some
- tests to make for more useful 'tests skipped' log from
- running all tests on non-Windows platforms.
-
+ * tessts/winFile.test: added 'pcOnly' constraint to some tests to make
+ for more useful 'tests skipped' log from running all tests on
+ non-Windows platforms.
+
2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c (CallCommandTraces): delete traces now
- receive the FQ old name of the command.
- [Bug 582532] (Don Porter)
+ * generic/tclBasic.c (CallCommandTraces): delete traces now receive
+ the FQ old name of the command. [Bug 582532] (Don Porter)
2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/ioUtil.test: added constraints to 1.4,2.4 so they
- don't run outside of tcltest. [Bugs 583276,583277]
-
+ * tests/ioUtil.test: added constraints to 1.4,2.4 so they don't run
+ outside of tcltest. [Bugs 583276, 583277]
+
2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported
- by Vince Darley.
+ * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported by
+ Vince Darley.
2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations,
- inconsistent with tclInt.h. Thanks to Vince Darley for reporting,
- boo to gcc for not complaining.
-
+ inconsistent with tclInt.h. Thanks to Vince Darley for reporting, boo
+ to gcc for not complaining.
+
2002-07-17 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclInt.h:
@@ -1547,16 +1512,16 @@
* unix/tclLoadOSF.c:
* unix/tclLoadShl.c:
* mac/tclMacLoad.c:
- * win/tclWinLoad.c: modified to move more functionality
- to the generic code and avoid duplication. Partial replacement
- of internal uses of clientData with opaque Tcl_LoadHandle. A
- little further work still needed, but significant changes are done.
+ * win/tclWinLoad.c: modified to move more functionality to the generic
+ code and avoid duplication. Partial replacement of internal uses of
+ clientData with opaque Tcl_LoadHandle. A little further work still
+ needed, but significant changes are done.
2002-07-17 D. Richard Hipp <drh@hwaci.com>
- * library/msgcat/msgcat.tcl: fix a comment that was causing
- problems for programs (ex: mktclapp) that embed the initialization
- scripts in strings.
+ * library/msgcat/msgcat.tcl: fix a comment that was causing problems
+ for programs (ex: mktclapp) that embed the initialization scripts in
+ strings.
2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
@@ -1565,17 +1530,17 @@
* generic/tclStubInit.c:
* generic/tclVar.c: removing the now redundant functions to access
indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and
- Tcl(Get|Set|Incr)ElementOfIndexedArray().
+ Tcl(Get|Set|Incr)ElementOfIndexedArray().
2002-07-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make
- this file compile with SunPro CC...
+ * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make this
+ file compile with SunPro CC...
2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: modified to do variable lookup explicitly,
- and then either inlining the variable access or else calling the new
+ * generic/tclExecute.c: modified to do variable lookup explicitly, and
+ then either inlining the variable access or else calling the new
TclPtr(Set|Get|Incr)Var functions in tclVar.c
* generic/tclInt.h: declare some functions previously local to
tclVar.c for usage by TEBC.
@@ -1586,21 +1551,20 @@
** WARNING FOR BYTECODE MAINTAINERS **
TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP.
-
+
2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
* unix/Makefile.in:
- * win/Makefile.in: Add a more descriptive warning
- in the event `make genstubs` needs to be rerun.
+ * win/Makefile.in: Add a more descriptive warning in the event `make
+ genstubs` needs to be rerun.
2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Use dltest.marker file
- to keep track of when the dltest package
- is up to date. This fixes [Tcl bug 575768]
- since tcltest is no longer linked every time.
- * unix/dltest/Makefile.in: Create ../dltest.marker
- after a successful `make all` run in dltest.
+ * unix/Makefile.in: Use dltest.marker file to keep track of when the
+ dltest package is up to date. This fixes [Bug 575768] since tcltest is
+ no longer linked every time.
+ * unix/dltest/Makefile.in: Create ../dltest.marker after a successful
+ `make all` run in dltest.
2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
@@ -1610,33 +1574,32 @@
2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclVar.c: inaccurate comment fixed
-
+
2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c (Tcl_AddObjErrorInfo):
* generic/tclExecute.c (TclUpdateReturnInfo):
- * generic/tclInt.h:
- * generic/tclProc.c:
- Added two Tcl_Obj to the ExecEnv structure to hold the fully
- qualified names "::errorInfo" and "::errorCode" to cache the
- addresses of the corresponding variables. The two most frequent
- setters of these variables now profit from the new variable name
- caching.
+ * generic/tclInt.h:
+ * generic/tclProc.c:
+ Added two Tcl_Obj to the ExecEnv structure to hold the fully qualified
+ names "::errorInfo" and "::errorCode" to cache the addresses of the
+ corresponding variables. The two most frequent setters of these
+ variables now profit from the new variable name caching.
2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclVar.c: refactorisation to reuse already looked-up Var
- pointers; definition of three new Tcl_Obj types to cache variable
- name parsing and lookup for later reuse; modification of internal
- functions to profit from the caching.
-
+ pointers; definition of three new Tcl_Obj types to cache variable name
+ parsing and lookup for later reuse; modification of internal functions
+ to profit from the caching.
+
* generic/tclInt.decls:
* generic/tclInt.h:
* generic/tclIntDecls.h:
* generic/tclNamesp.c: adding CONST qualifiers to variable names
- passed to Tcl_FindNamespaceVar and to variable resolvers; adding
- CONST qualifier to the 'msg' argument to TclLookupVar. Needed to
- avoid code duplication in the new tclVar.c code.
+ passed to Tcl_FindNamespaceVar and to variable resolvers; adding CONST
+ qualifier to the 'msg' argument to TclLookupVar. Needed to avoid code
+ duplication in the new tclVar.c code.
* tests/set-old.test:
* tests/var.test: slight modification of error messages due to the
@@ -1644,27 +1607,27 @@
2002-07-15 Don Porter <dgp@users.sourceforge.net>
- * tests/unixInit.test: Improved constraints to protect /tmp.
- [Bug 581403]
+ * tests/unixInit.test: Improved constraints to protect /tmp. [Bug
+ 581403]
2002-07-15 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to
- more appropriate constraint names.
+ * tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to more
+ appropriate constraint names.
* win/tclWinFile.c: updated comments to reflect 07-11 changes.
- * win/tclWinFCmd.c: made ConvertFileNameFormat static again,
- since no longer used in tclWinFile.c
- * mac/tclMacFile.c: completed TclpObjLink implementation which
- was previously lacking.
+ * win/tclWinFCmd.c: made ConvertFileNameFormat static again, since no
+ longer used in tclWinFile.c
+ * mac/tclMacFile.c: completed TclpObjLink implementation which was
+ previously lacking.
* generic/tclIOUtil.c: comment cleanup and code speedup.
-
+
2002-07-14 Don Porter <dgp@users.sourceforge.net>
* generic/tclInt.h: Removed declarations that duplicated entries
- in the (internal) stub table.
-
+ in the (internal) stub table.
+
* library/tcltest/tcltest.tcl: Corrected errors in handling of
- configuration options -constraints and -limitconstraints.
+ configuration options -constraints and -limitconstraints.
* README: Bumped HEAD to version 8.4b2 so we can
* generic/tcl.h: distinguish it from the 8.4b1 release.
@@ -1677,11 +1640,11 @@
2002-07-11 Vince Darley <vincentdarley@users.sourceforge.net>
* doc/file.n:
- * win/tclWinFile.c: on Win 95/98/ME the long form of the path
- is used as a normalized form. This is required because short
- forms are not a robust representation. The file normalization
- function has been sped up, but more performance gains might be
- possible, if speed is still an issue on these platforms.
+ * win/tclWinFile.c: on Win 95/98/ME the long form of the path is used
+ as a normalized form. This is required because short forms are not a
+ robust representation. The file normalization function has been sped
+ up, but more performance gains might be possible, if speed is still an
+ issue on these platforms.
2002-07-11 Don Porter <dgp@users.sourceforge.net>
@@ -1692,16 +1655,16 @@
2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCkalloc.c: ckalloc() and friends take the block size
- as an unsigned, so we should use %ud when reporting it in fprintf()
- and panic().
+ * generic/tclCkalloc.c: ckalloc() and friends take the block size as
+ an unsigned, so we should use %ud when reporting it in fprintf() and
+ panic().
2002-07-11 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompile.c: now setting local vars undefined at
- compile time, instead of waiting until the proc is initialized.
- * generic/tclProc.c: use macro TclSetVarUndefined instead of
- directly etting the flag.
+ * generic/tclCompile.c: now setting local vars undefined at compile
+ time, instead of waiting until the proc is initialized.
+ * generic/tclProc.c: use macro TclSetVarUndefined instead of directly
+ setting the flag.
2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1710,10 +1673,10 @@
2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/unixFCmd.test, tests/fileName.test:
+ * tests/unixFCmd.test, tests/fileName.test:
* tests/fCmd.test: Removed [exec] of Unix utilities that have
- equivalents in standard Tcl. [Bug 579268] Also simplified some
- of unixFCmd.test while I was at it.
+ equivalents in standard Tcl. [Bug 579268] Also simplified some of
+ unixFCmd.test while I was at it.
2002-07-10 Don Porter <dgp@users.sourceforge.net>
@@ -1743,20 +1706,19 @@
* tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211]
* tests/expr.test: Added tests to make sure that this works.
- * generic/tclExecute.c (ExprCallMathFunc): Functions should also
- be able to return wide-ints. [Bug 579284]
+ * generic/tclExecute.c (ExprCallMathFunc): Functions should also be
+ able to return wide-ints. [Bug 579284]
2002-07-08 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tests/socket.test: Fixed bug #578164. The original reason for
- the was a DNS outage while running the testsuite. Changed [info
- hostname] to 127.0.0.1 to bypass DNS, knowing that we operate on
- the local host.
+ * tests/socket.test: Fixed [Bug 578164]. The original reason for the
+ was a DNS outage while running the testsuite. Changed [info hostname]
+ to 127.0.0.1 to bypass DNS, knowing that we operate on the local host.
2002-07-08 Don Porter <dgp@users.sourceforge.net>
* doc/tcltest.n: Fixed incompatibility in [viewFile].
- * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1.
+ * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1.
* library/tcltest/pkgIndex.tcl: [Bug 578163]
2002-07-08 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -1773,26 +1735,27 @@
* unix/tclUnixChan.c:
* win/tclWinChan.c:
* doc/FileSystem.3: cleaned up internal handling of
- Tcl_FSOpenFileChannel to remove duplicate code, and make
- writing external vfs's clearer and easier. No
- functionality change. Also clarify that objects with refCount
- zero should not be passed in to the Tcl_FS API, and prevent
- segfaults from occuring on such user errors. [Bug 578617]
-
+ Tcl_FSOpenFileChannel to remove duplicate code, and make writing
+ external vfs's clearer and easier. No functionality change. Also
+ clarify that objects with refCount zero should not be passed in to the
+ Tcl_FS API, and prevent segfaults from occuring on such user errors.
+ [Bug 578617]
+
2002-07-06 Don Porter <dgp@users.sourceforge.net>
* tests/pkgMkIndex.test: Constrained tests of [load] package indexing
to those platforms where the testing shared libraries have been built.
- [Bug 578166].
+ [Bug 578166]
2002-07-05 Don Porter <dgp@users.sourceforge.net>
+
* changes: added recent changes
2002-07-05 Reinhard Max <max@suse.de>
- * generic/tclClock.c (FormatClock): Convert the format string to
- UTF8 before calling TclpStrftime, so that non-ASCII characters
- don't get mangled when the result string is being converted back.
+ * generic/tclClock.c (FormatClock): Convert the format string to UTF8
+ before calling TclpStrftime, so that non-ASCII characters don't get
+ mangled when the result string is being converted back.
* tests/clock.test: Added a test for that.
2002-07-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1803,22 +1766,22 @@
names for broken sites (like mine) where gdb and ddd are installed
with non-standard names...
- * tests/httpold.test: Altered test names to httpold-* to avoid
- clashes with http.test, and stopped tests from failing when the
- current directory is not writable...
-
- * tests/event.test: Stop these tests from failing
- * tests/ioUtil.test: when the current directory is
- * tests/regexp.test: not writable...
- * tests/regexpComp.test:
- * tests/source.test:
- * tests/unixFile.test:
- * tests/unixNotfy.test:
-
- * tests/unixFCmd.test: Trying to make these test-files
- * tests/macFCmd.test: not bomb out with an error when
- * tests/http.test: the current directory is not
- * tests/fileName.test: writable...
+ * tests/httpold.test: Altered test names to httpold-* to avoid clashes
+ with http.test, and stopped tests from failing when the current
+ directory is not writable...
+
+ * tests/event.test: Stop these tests from failing when the
+ * tests/ioUtil.test: current directory is not writable...
+ * tests/regexp.test:
+ * tests/regexpComp.test:
+ * tests/source.test:
+ * tests/unixFile.test:
+ * tests/unixNotfy.test:
+
+ * tests/unixFCmd.test: Trying to make these test-files not
+ * tests/macFCmd.test: bomb out with an error when the
+ * tests/http.test: current directory is not writable...
+ * tests/fileName.test:
* tests/env.test:
2002-07-05 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1827,35 +1790,35 @@
2002-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/cmdMZ.test (cmdMZ-1.4):
- * tests/cmdAH.test: More fixing of writable-current-dir
- assumption. [Bug 575824]
+ * tests/cmdMZ.test (cmdMZ-1.4):
+ * tests/cmdAH.test: More fixing of writable-current-dir assumption.
+ [Bug 575824]
2002-07-04 Miguel Sofer <msofer@users.sourceforge.net>
* tests/basic.test: Same issue as below; fixed [Bug 575817]
-
+
2002-07-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tests/socket.test:
- * tests/winPipe.test:
- * tests/pid.test: Fixed SF Bug #575848. See below for a
- description the general problem.
+ * tests/socket.test:
+ * tests/winPipe.test:
+ * tests/pid.test: Fixed [Bug 575848]. See below for a description the
+ general problem.
- * All the bugs below are instances of the same problem: The
- testsuite assumes [pwd] = [temporaryDirectory] and writable.
+ * All the bugs below are instances of the same problem: The testsuite
+ assumes [pwd] = [temporaryDirectory] and writable.
- * tests/iogt.test: Fixed bug #575860.
- * tests/io.test: Fixed bug #575862.
- * tests/exec.test:
- * tests/ioCmd.test: Fixed bug #575836.
+ * tests/iogt.test: Fixed [Bug 575860].
+ * tests/io.test: Fixed [Bug 575862].
+ * tests/exec.test:
+ * tests/ioCmd.test: Fixed [Bug 575836].
2002-07-03 Don Porter <dgp@users.sourceforge.net>
* tests/pkg1/direct1.tcl: removed
* tests/pkg1/pkgIndex.tcl: removed
* tests/pkgMkIndex.test: Imported auxilliary files from tests/pkg1
- into the test file pkgMkIndex.test itself. Formatting fixes.
+ into the test file pkgMkIndex.test itself. Formatting fixes.
* unix/Makefile.in: removed tests/pkg/* from `make dist`
@@ -1876,22 +1839,21 @@
* tests/pkg/spacename.tcl: removed
* tests/pkg/std.tcl: removed
* tests/pkgMkIndex.test: Fixed [Bug 575857] where this test file
- expected to be able to write to [file join [testsDirectory]
- pkg]. Part of the fix was to import several auxilliary files
- into the test file itself.
+ expected to be able to write to [file join [testsDirectory] pkg]. Part
+ of the fix was to import several auxilliary files into the test file
+ itself.
- * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid
+ * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid
* tests/tcltest.test: non-writable . by [cd [temporaryDirectory]].
- * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets
- $varName only if a successful library script is found.
- [Bug 577033]
+ * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets $varName
+ only if a successful library script is found. [Bug 577033]
2002-07-03 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCompCmds.c (TclCompileCatchCmd): return
- TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure
- happen at runtime so that it can be caught [Bug 577015].
+ TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure happen at
+ runtime so that it can be caught [Bug 577015].
2002-07-02 Joe English <jenglish@users.sourceforge.net>
@@ -1902,27 +1864,26 @@
* doc/tcltest.n: more refinements of the documentation.
* library/tcltest/tcltest.tcl: Added trace to be sure the stdio
- constraint is updated whenever the [interpreter] changes.
+ constraint is updated whenever the [interpreter] changes.
* doc/tcltest.n: Reverted [makeFile] and [viewFile] to
* library/tcltest/tcltest.tcl: their former behavior, and documented
- * tests/cmdAH.test: it. Corrected misspelling of hook
- * tests/event.test: procedure. Restored tests.
+ * tests/cmdAH.test: it. Corrected misspelling of hook
+ * tests/event.test: procedure. Restored tests.
* tests/http.test:
* tests/io.test:
- * library/tcltest/tcltest.tcl: Simplified logic of
- [GetMatchingFiles] and [GetMatchingDirectories], removing
- special case processing.
+ * library/tcltest/tcltest.tcl: Simplified logic of [GetMatchingFiles]
+ and [GetMatchingDirectories], removing special case processing.
- * doc/tcltest.n: More documentation updates. Reference sections
- are complete. Only examples need adding.
+ * doc/tcltest.n: More documentation updates. Reference sections are
+ complete. Only examples need adding.
2002-07-02 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/fCmd.test:
- * generic/tclCmdAH.c: clearer error msgs for 'file link',
- as per the man page.
+ * tests/fCmd.test:
+ * generic/tclCmdAH.c: clearer error msgs for 'file link', as per the
+ man page.
2002-07-01 Joe English <jenglish@users.sourceforge.net>
@@ -1968,18 +1929,17 @@
when building with gcc to resolve problems with undefined symbols
being present when tcl library used with non-gcc linker at later
stage. Symbols were compiler-generated, so it is the compiler's
- business to define them. [Bug #541181]
+ business to define them. [Bug 541181]
2002-07-01 Don Porter <dgp@users.sourceforge.net>
* doc/tcltest.n: more work in progress updating tcltest docs.
- * library/tcltest/tcltest.tcl: Change [configure -match] to
- stop treating an empty list as a list of the single pattern "*".
- Changed the default value to [list *] so default operation
- remains the same.
+ * library/tcltest/tcltest.tcl: Change [configure -match] to stop
+ treating an empty list as a list of the single pattern "*". Changed
+ the default value to [list *] so default operation remains the same.
- * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.
+ * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.
* library/tcltest/tcltest.tcl: restored writeability testing of
-tmpdir, augmented by a special exception for the deafault value.
@@ -1993,58 +1953,58 @@
* doc/tcltest.n: more work in progress updating tcltest docs.
* tests/README: Updated the instructions on running and
- * tests/cmdMZ.test: adding to the test suite. Also updated
+ * tests/cmdMZ.test: adding to the test suite. Also updated
* tests/encoding.test: several tests, mostly to correctly create
* tests/fCmd.test: and destroy any temporary files in the
* tests/info.test: [temporaryDirectory] of tcltest.
* tests/interp.test:
- * library/tcltest/tcltest.tcl: Stopped checking for writeability
- of -tmpdir value because no default directory can be guaranteed to
- be writeable.
+ * library/tcltest/tcltest.tcl: Stopped checking for writeability of
+ -tmpdir value because no default directory can be guaranteed to be
+ writeable.
* tests/autoMkindex.tcl: removed.
* tests/pkg/samename.tcl: removed.
* tests/pkg/magicchar.tcl: removed.
* tests/pkg/magicchar2.tcl: removed.
- * tests/autoMkindex.test: Updated auto_mkIndex tests to use
- [makeFile] and [removeFile] so tests are done in [temporaryDirecotry]
- where write access is guaranteed.
+ * tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile]
+ and [removeFile] so tests are done in [temporaryDirecotry] where write
+ access is guaranteed.
* library/tcltest/tcltest.tcl: Fixed [makeFile] and [viewFile] to
* tests/cmdAH.test: accurately reflect a file's contents.
* tests/event.test: Updated tests that depended on buggy
- * tests/http.test: behavior. Also added warning messages
+ * tests/http.test: behavior. Also added warning messages
* tests/io.test: to "-debug 1" operations to debug test
- * tests/iogt.test: calls to (make|remove)(File|Directory).
+ * tests/iogt.test: calls to (make|remove)(File|Directory)
* unix/mkLinks: `make mklinks` on 6-27 commits.
2002-06-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompile.h: modified the macro TclEmitPush to not
- call its first argument repeatedly or pass it to other macros,
- [Bug 575194] reported by Peter Spjuth.
+ * generic/tclCompile.h: modified the macro TclEmitPush to not call its
+ first argument repeatedly or pass it to other macros, [Bug 575194]
+ reported by Peter Spjuth.
2002-06-28 Don Porter <dgp@users.sourceforge.net>
* docs/tcltest.n: Doc revisions in progress.
- * library/tcltest/tcltest.tcl: Corrected -testdir default value.
- Was not reliable, and disagreed with docs! Thanks to Hemang Lavana.
- [Bug 575150]
+ * library/tcltest/tcltest.tcl: Corrected -testdir default value. Was
+ not reliable, and disagreed with docs! Thanks to Hemang Lavana. [Bug
+ 575150]
2002-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/tclUnixThrd.c: Renamed the Tcl_Platform* #defines to
- * unix/tclUnixPipe.c: TclOS* because they are only used
- * unix/tclUnixFile.c: internally. Also stopped double-#def
- * unix/tclUnixFCmd.c: of TclOSlstat [Bug #566099, post-rename]
+ * unix/tclUnixThrd.c: Renamed the Tcl_Platform* #defines to TclOS*
+ * unix/tclUnixPipe.c: because they are only used internally. Also
+ * unix/tclUnixFile.c: stopped double-#def of TclOSlstat [Bug 566099,
+ * unix/tclUnixFCmd.c: post-rename]
* unix/tclUnixChan.c:
* unix/tclUnixPort.h:
- * doc/string.n: Improved documentation for [string last] along
- lines described in Bug #574799 so it indicates that the supplied
- index marks the end of the search space.
+ * doc/string.n: Improved documentation for [string last] along lines
+ described in [Bug 574799] so it indicates that the supplied index
+ marks the end of the search space.
2002-06-27 Don Porter <dgp@users.sourceforge.net>
@@ -2059,36 +2019,36 @@
2002-06-26 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/fileSystem.test:
- * generic/tclIOUtil.c: fix to handling of empty paths ""
- which are not claimed by any filesystem (Bug #573758).
- Ensure good error messages are given in all cases.
+ * tests/fileSystem.test:
+ * generic/tclIOUtil.c: fix to handling of empty paths "" which are not
+ claimed by any filesystem [Bug 573758]. Ensure good error messages
+ are given in all cases.
* tests/cmdAH.test:
- * unix/tclUnixFCmd.c: fix to bug reported as part of
- (Patch #566669). Thanks to Taguchi, Takeshi for the report.
-
+ * unix/tclUnixFCmd.c: fix to bug reported as part of [Patch 566669].
+ Thanks to Taguchi, Takeshi for the report.
+
2002-06-26 Reinhard Max <max@suse.de>
* unix/tclUnixTime.c: Make [clock format] respect locale settings.
- * tests/clock.test: Bug #565880. ***POTENTIAL INCOMPATIBILITY***
+ * tests/clock.test: [Bug 565880]. ***POTENTIAL INCOMPATIBILITY***
2002-06-26 Miguel Sofer <msofer@users.sourceforge.net>
* doc/CrtInterp.3:
- * doc/StringObj.3: clarifications by Don Porter, bugs #493995 and
- #500930.
-
+ * doc/StringObj.3: clarifications by Don Porter, [Bug 493995] and [Bug
+ 500930].
+
2002-06-24 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: Corrected suppression of -verbose skip
- * tests/tcltest.test: and start by [test -output]. Also
- corrected test suite errors exposed by corrected code. [Bug 564656]
+ * tests/tcltest.test: and start by [test -output]. Also
+ corrected test suite errors exposed by corrected code. [Bug 564656]
2002-06-25 Reinhard Max <max@suse.de>
* unix/tcl.m4: New macro SC_CONFIG_MANPAGES.
- * unix/configure.in: Added support for symlinks and compression
- * unix/Makefile.in: when installing the manpages. [Patch 518052]
+ * unix/configure.in: Added support for symlinks and compression when
+ * unix/Makefile.in: installing the manpages. [Patch 518052]
* unix/mkLinks.tcl: Default is still hardlinks and no compression.
* unix/mkLinks: generated
@@ -2101,33 +2061,32 @@
2002-06-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclUtil.c (TclGetIntForIndex): Fix of critical bug
- #533364 generated when the index is bad and the result is a shared
- object. The T_ASTO(T_GOR, ...) idiom likely exists elsewhere
- though. Also removed some cruft that just complicated things to
- no advantage.
+ * generic/tclUtil.c (TclGetIntForIndex): Fix of critical [Bug 533364]
+ generated when the index is bad and the result is a shared object. The
+ T_ASTO(T_GOR, ...) idiom likely exists elsewhere though. Also removed
+ some cruft that just complicated things to no advantage.
(SetEndOffsetFromAny): Same fix, though this wasn't on the path
excited by the bug.
2002-06-24 Don Porter <dgp@users.sourceforge.net>
- * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds
- * tests/parseOld.test: and exports a [configure] command
- * tests/tcltest.test: from tcltest.
+ * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds abd
+ * tests/parseOld.test: exports a [configure] command from
+ * tests/tcltest.test: tcltest.
2002-06-22 Don Porter <dgp@users.sourceforge.net>
* changes: updated changes file for 8.4b1 release.
- * library/tcltest/tcltest.tcl: Corrections to tcltest and the
- * tests/basic.test: Tcl test suite so that a test
- * tests/cmdInfo.test: with options -constraints knownBug
+ * library/tcltest/tcltest.tcl: Corrections to tcltest and the Tcl
+ * tests/basic.test: test suite so that a test with options
+ * tests/cmdInfo.test: -constraints knownBug
* tests/compile.test: -limitConstraints 1 only tests the
- * tests/encoding.test: knownBug tests. Mostly involves
+ * tests/encoding.test: knownBug tests. Mostly involves
* tests/env.test: replacing direct access to the
- * tests/event.test: testConstraints array with calls
- * tests/exec.test: to the testConstraint command
- * tests/execute.test: (which requires tcltest version 2)
+ * tests/event.test: testConstraints array with calls to
+ * tests/exec.test: the testConstraint command (which
+ * tests/execute.test: requires tcltest version 2)
* tests/fCmd.test:
* tests/format.test:
* tests/http.test:
@@ -2144,35 +2103,35 @@
2002-06-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version):
- * win/README.binary, README, win/configure.in, unix/configure.in:
+ * tools/tcl.wse.in (Disk Label), unix/tcl.spec (version):
+ * win/README.binary, README, win/configure.in, unix/configure.in:
* generic/tcl.h (TCL_RELEASE_*, TCL_PATCH_LEVEL): Bump to beta1.
2002-06-21 Joe English <jenglish@users.sourceforge.net>
* generic/tclCompExpr.c:
- * generic/tclParseExpr.c: LogSyntaxError() should reset
- the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"]
+ * generic/tclParseExpr.c: LogSyntaxError() should reset the
+ interpreter result [Bug 550142 "Tcl_ExprObj -> abort"]
2002-06-21 Don Porter <dgp@users.sourceforge.net>
-
+
* unix/Makefile.in: Updated all package install directories
* win/Makefile.in: to match current Major.minor versions
- * win/makefile.bc: of the packages. Added tcltest package
+ * win/makefile.bc: of the packages. Added tcltest package
* win/makefile.vc: to installation on Windows.
- * library/init.tcl: Corrected comments and namespace style
- issues. Thanks to Bruce Stephens. [Bug 572025]
+ * library/init.tcl: Corrected comments and namespace style issues.
+ Thanks to Bruce Stephens. [Bug 572025]
2002-06-21 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/cmdAH.test: Added TIP#99 implementation
- * tests/fCmd.test: of 'file link'. Supports creation
- * tests/fileName.test: of symbolic and hard links in the
- * tests/fileSystem.test: native filesystems and in vfs's,
- * generic/tclTest.c: when the individual filesystem
- * generic/tclCmdAH.c: supports the concept.
- * generic/tclIOUtil.c:
+ * tests/cmdAH.test: Added TIP#99 implementation of 'file
+ * tests/fCmd.test: link'. Supports creation of symbolic and
+ * tests/fileName.test: hard links in the native filesystems and
+ * tests/fileSystem.test: in vfs's, when the individual filesystem
+ * generic/tclTest.c: supports the concept.
+ * generic/tclCmdAH.c:
+ * generic/tclIOUtil.c:
* generic/tcl.h:
* generic/tcl.decls:
* doc/FileSystem.3:
@@ -2184,23 +2143,24 @@
2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385]
- in the implementation of TIP#62 (command tracing). Vince Darley,
- Hemang Lavana & Don Porter: thanks.
+ * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385] in
+ the implementation of TIP#62 (command tracing). Vince Darley, Hemang
+ Lavana & Don Porter: thanks.
2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TclCompEvalObj): clarified and simplified
- the logic for compilation/recompilation.
+ * generic/tclExecute.c (TclCompEvalObj): clarified and simplified the
+ logic for compilation/recompilation.
2002-06-19 Joe English <jenglish@users.sourceforge.net>
- * doc/file.n: Fixed indentation. No substantive changes.
+
+ * doc/file.n: Fixed indentation. No substantive changes.
2002-06-19 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again
- as the Tcl_ObjSetVar2 may cause the result to change.
- [Patch #558324] (watson)
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again as
+ the Tcl_ObjSetVar2 may cause the result to change. [Patch 558324]
+ (watson)
2002-06-19 Miguel Sofer <msofer@users.sourceforge.net>
@@ -2209,35 +2169,34 @@
2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TEBC):
+ * generic/tclExecute.c (TEBC):
- elimination of duplicated code in the non-immediate INST_INCR
- instructions.
+ instructions.
- elimination of 103 (!) TclDecrRefCount macros. The different
- instructions now jump back to a common "DecrRefCount zone" at
- the top of the loop. The macro "ADJUST_PC" was replaced by two
- macros "NEXT_INST_F" and "NEXT_INST_V" that take three params
- (pcAdjustment, # of stack objects to discard, resultObjPtr
- handling flag). The only instructions that retain a
- TclDecrRefCount are INST_POP (for speed), the common code for
- the non-immediate INST_INCR, INST_FOREACH_STEP and the two
- INST_LSET.
-
- The object size of tclExecute.o was reduced by approx 20% since
- the start of the consolidation drive, while making room for some
- peep-hole optimisation at runtime.
+ instructions now jump back to a common "DecrRefCount zone" at the
+ top of the loop. The macro "ADJUST_PC" was replaced by two macros
+ "NEXT_INST_F" and "NEXT_INST_V" that take three params
+ (pcAdjustment, # of stack objects to discard, resultObjPtr handling
+ flag). The only instructions that retain a TclDecrRefCount are
+ INST_POP (for speed), the common code for the non-immediate
+ INST_INCR, INST_FOREACH_STEP and the two INST_LSET.
+
+ The object size of tclExecute.o was reduced by approx 20% since the
+ start of the consolidation drive, while making room for some peep-hole
+ optimisation at runtime.
2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic
- code for tcl-stack corruption.
+ * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic code
+ for tcl-stack corruption.
2002-06-17 David Gravereaux <davygrvy@pobox.com>
- Trims to support the removal of RESOURCE_INCLUDED from rc
- scripts from FR #565088.
+ Trims to support the removal of RESOURCE_INCLUDED from rc scripts from
+ [FRQ 565088].
- * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in
- the file. rc scripts don't need to know thread mutexes.
+ * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in the
+ file. rc scripts don't need to know thread mutexes.
* win/tcl.rc:
* win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the
@@ -2246,7 +2205,7 @@
2002-06-17 Jeff Hobbs <jeffh@ActiveState.com>
* doc/CrtTrace.3: Added TIP#62 implementation of command
- * doc/trace.n: execution tracing [FR #462580] (lavana).
+ * doc/trace.n: execution tracing [FRQ 462580] (lavana).
* generic/tcl.h: This includes enter/leave tracing as well
* generic/tclBasic.c: as inter-procedure stepping.
* generic/tclCmdMZ.c:
@@ -2261,110 +2220,107 @@
2002-06-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/tclWinPipe.c (BuildCommandLine): Fixed bug #554068 ([exec]
- on windows did not treat { in filenames well.). Bug reported by
- Vince Darley <vincentdarley@users.sourceforge.net>, patch
- provided by Vince too.
+ * win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 554068] ([exec] on
+ windows did not treat { in filenames well.). Bug reported by Vince
+ Darley <vincentdarley@users.sourceforge.net>, patch provided by Vince
+ too.
2002-06-17 Joe English <jenglish@users.sourceforge.net>
* generic/tcl.h: #ifdef logic for K&R C backwards compatibility
- changed to assume modern C by default. See SF FR #565088 for
- full details.
+ changed to assume modern C by default. See [FRQ 565088] for full
+ details.
2002-06-17 Don Porter <dgp@users.sourceforge.net>
- * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not
- a country designation recognized in ISO 3166.
+ * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not a
+ country designation recognized in ISO 3166.
- * library/msgcat/msgcat.tcl: More Windows Registry locale codes
- from Bruno Haible.
+ * library/msgcat/msgcat.tcl: More Windows Registry locale codes from
+ Bruno Haible.
* doc/msgcat.n:
* library/msgcat/msgcat.tcl:
* library/msgcat/pkgIndex.tcl:
* tests/msgcat.test: Revised locale initialization to interpret
- environment variable locale values according to XPG4, and to
- recognize the LC_ALL and LC_MESSAGES values over that of LANG.
- Also added many Windows Registry locale values to those
- recognized by msgcat. Revised tests and docs. Bumped to
- version 1.3. Thanks to Bruno Haible for the report and
- assistance crafting the solution. [Bug 525522, 525525]
+ environment variable locale values according to XPG4, and to recognize
+ the LC_ALL and LC_MESSAGES values over that of LANG. Also added many
+ Windows Registry locale values to those recognized by msgcat. Revised
+ tests and docs. Bumped to version 1.3. Thanks to Bruno Haible for the
+ report and assistance crafting the solution. [Bug 525522, 525525]
2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompile.c (TclCompileTokens): a better algorithm for
- the previous bug fix.
+ * generic/tclCompile.c (TclCompileTokens): a better algorithm for the
+ previous bug fix.
2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompile.c (TclCompileTokens):
+ * generic/tclCompile.c (TclCompileTokens):
* tests/compile.test: [Bug 569438] in the processing of dollar
- variables; report by Georgios Petasis.
-
+ variables; report by Georgios Petasis.
+
2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: bug in the consolidation of the
- INCR_..._STK instructions; the bug could not be exercised as the
- (faulty) instruction INST_INCR_ARRAY_STK was never compiled-in
- (related to [Bug 569438]).
+ * generic/tclExecute.c: bug in the consolidation of the INCR_..._STK
+ instructions; the bug could not be exercised as the (faulty)
+ instruction INST_INCR_ARRAY_STK was never compiled-in (related to [Bug
+ 569438]).
2002-06-14 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c (TclExecuteByteCode): runtime peep-hole
optimisation of variables (INST_STORE, INST_INCR) and commands
(INST_INVOKE); faster check for the existence of a catch.
- (TclExecuteByteCode): runtime peep-hole optimisation of
- comparisons.
- (TclExecuteByteCode): runtime peep-hole optimisation of
- INST_FOREACH - relies on peculiarities of the code produced by the
- bytecode compiler.
+ (TclExecuteByteCode): runtime peep-hole optimisation of comparisons.
+ (TclExecuteByteCode): runtime peep-hole optimisation of INST_FOREACH -
+ relies on peculiarities of the code produced by the bytecode compiler.
2002-06-14 David Gravereaux <davygrvy@pobox.com>
* win/rules.vc: The test for compiler optimizations was in error.
- Thanks goes to Roy Terry <royterry@earthlink.net> for his
- assistance with this.
+ Thanks goes to Roy Terry <royterry@earthlink.net> for his assistance
+ with this.
2002-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/trace.n, tests/trace.test:
+ * doc/trace.n, tests/trace.test:
* generic/tclCmdMZ.c (Tcl_TraceObjCmd,TclTraceCommandObjCmd)
(TclTraceVariableObjCmd): Changed references to "trace list" to
"trace info" as mandated by TIP#102.
2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): consolidated code for
- the conditional branch instructions.
+ * generic/tclExecute.c (TclExecuteByteCode): consolidated code for the
+ conditional branch instructions.
2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): fixed the previous
- patch - wouldn't compile with TCL_COMPILE_DEBUG set.
+ * generic/tclExecute.c (TclExecuteByteCode): fixed the previous patch;
+ wouldn't compile with TCL_COMPILE_DEBUG set.
2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): consolidated the
- handling of exception returns to INST_INVOKE and INST_EVAL, as
- well as most of the code for INST_CONTINUE and INST_BREAK, in the
- new jump target "processExceptionReturn".
+ * generic/tclExecute.c (TclExecuteByteCode): consolidated the handling
+ of exception returns to INST_INVOKE and INST_EVAL, as well as most of
+ the code for INST_CONTINUE and INST_BREAK, in the new jump target
+ "processExceptionReturn".
2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c (TclExecuteByteCode): consolidated variable
handling opcodes, replaced redundant code with some 'goto'. All
- store/append/lappend opcodes on the same data type now share the
- main code; same with incr opcodes.
+ store/append/lappend opcodes on the same data type now share the main
+ code; same with incr opcodes.
* generic/tclVar.c: added the bit TCL_TRACE_READS to the possible
- flags to Tcl_SetVar2Ex - it causes read traces to be fired prior
- to setting the variable. This is used in the core for [lappend].
+ flags to Tcl_SetVar2Ex - it causes read traces to be fired prior to
+ setting the variable. This is used in the core for [lappend].
- ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is
- not documented; there, it causes the call to create the variable
- if it does not exist. The new usage in Tcl_(Obj)?SetVar.* remains
+ ***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is not
+ documented; there, it causes the call to create the variable if it
+ does not exist. The new usage in Tcl_(Obj)?SetVar.* remains
undocumented too ...
-
+
2002-06-13 Vince Darley <vincentdarley@users.sourceforge.net>
* tests/fCmd.test:
@@ -2376,65 +2332,63 @@
* doc/FileSystem.3:
* mac/tclMacFile.c:
* unix/tclUnixFile.c:
- * win/tclWinFile.c: fixed up further so both compiles and
- actually works with VC++ 5 or 6.
- * win/tclWinInt.h:
- * win/tclWin32Dll.c: cleaned up code and vfs tests and
- added tests for the internal changes of 2002-06-12, to see
- whether WinTcl on NTFS can coexist peacefully with links
- in the filesystem. Added new test command 'testfilelink'
- to enable the newer code to be tested.
- * tests/fCmd.test: (made certain tests of 'testfilelink' not
- run on unix).
+ * win/tclWinFile.c: fixed up further so both compiles and actually
+ works with VC++ 5 or 6.
+ * win/tclWinInt.h:
+ * win/tclWin32Dll.c: cleaned up code and vfs tests and added tests for
+ the internal changes of 2002-06-12, to see whether WinTcl on NTFS can
+ coexist peacefully with links in the filesystem. Added new test
+ command 'testfilelink' to enable the newer code to be tested.
+ * tests/fCmd.test: (made certain tests of 'testfilelink' not run on
+ unix).
2002-06-12 Miguel Sofer <msofer@users.sourceforge.net>
- * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to
- Hemang Lavana)
-
+ * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to Hemang
+ Lavana)
+
2002-06-12 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinFile.c: corrected the symbolic link handling code to
- allow it to compile. Added real definition of REPARSE_DATA_BUFFER
- (found in winnt.h). Most of the added definitions appear to have
- correct, cross-Win-version equivalents in winnt.h and should be
- removed, but just making things "work" for now.
+ * win/tclWinFile.c: corrected the symbolic link handling code to allow
+ it to compile. Added real definition of REPARSE_DATA_BUFFER (found in
+ winnt.h). Most of the added definitions appear to have correct,
+ cross-Win-version equivalents in winnt.h and should be removed, but
+ just making things "work" for now.
2002-06-12 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclIOUtil.c:
* generic/tcl.decls:
- * generic/tclDecls.h: made code for Tcl_FSNewNativePath
- agree with man pages.
-
- * doc/FileSystem.3: clarified the circumstances under which
- certain functions are called in the presence of symlinks.
-
+ * generic/tclDecls.h: made code for Tcl_FSNewNativePath agree with man
+ pages.
+
+ * doc/FileSystem.3: clarified the circumstances under which certain
+ functions are called in the presence of symlinks.
+
* win/tclWinFile.c:
- * win/tclWinPort.h:
- * win/tclWinInt.h:
- * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat',
- 'file type', 'glob -type l', 'file copy', 'file delete',
- 'file normalize', and all VFS code to work correctly in the
- presence of symlinks (previously Tcl's behaviour was not very
- well defined). This also fixes possible serious problems in
- all versions of WinTcl where 'file delete' on a NTFS symlink
- could delete the original, not the symlink.
+ * win/tclWinPort.h:
+ * win/tclWinInt.h:
+ * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat', 'file
+ type', 'glob -type l', 'file copy', 'file delete', 'file normalize',
+ and all VFS code to work correctly in the presence of symlinks
+ (previously Tcl's behaviour was not very well defined). This also
+ fixes possible serious problems in all versions of WinTcl where 'file
+ delete' on a NTFS symlink could delete the original, not the symlink.
Note: symlinks cannot yet be created in pure Tcl.
2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c:
+ * generic/tclBasic.c:
* generic/tclCompCmds.c:
- * generic/tclInt.h: reverted the new compilation functions;
- replaced by a more general approach described below.
+ * generic/tclInt.h: reverted the new compilation functions; replaced
+ by a more general approach described below.
* generic/tclCompCmds.c:
- * generic/tclCompile.c: made *all* compiled variable access
- attempts create an indexed variable - even get or incr without
- previous set. This allows indexed access to local variables that
- are created and set at runtime, for example by [global], [upvar],
- [variable], [regexp], [regsub].
+ * generic/tclCompile.c: made *all* compiled variable access attempts
+ create an indexed variable - even get or incr without previous set.
+ This allows indexed access to local variables that are created and set
+ at runtime, for example by [global], [upvar], [variable], [regexp],
+ [regsub].
2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
@@ -2443,13 +2397,13 @@
* test/info.test:
* generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was
reporting some linked variables.
-
- * generic/tclBasic.c:
+
+ * generic/tclBasic.c:
* generic/tclCompCmds.c:
- * generic/tclInt.h: added compile functions for [global],
- [variable] and [upvar]. They just declare the new local variables,
- the commands themselves are not compiled-in. This gives a notably
- faster read access to these linked variables.
+ * generic/tclInt.h: added compile functions for [global], [variable]
+ and [upvar]. They just declare the new local variables, the commands
+ themselves are not compiled-in. This gives a notably faster read
+ access to these linked variables.
2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
@@ -2458,43 +2412,43 @@
2002-06-10 Vince Darley <vincentdarley@users.sourceforge.net>
- * unix/tclUnixFCmd.c: fixed [Bug #566669]
- * generic/tclIOUtil.c: improved and sped up handling of
- native paths (duplication and conversion to normalized paths),
- particularly on Windows.
- * modified part of above commit, due to problems on Linux.
- Will re-examine bug report and evaluate more closely.
+ * unix/tclUnixFCmd.c: fixed [Bug 566669]
+ * generic/tclIOUtil.c: improved and sped up handling of native paths
+ (duplication and conversion to normalized paths), particularly on
+ Windows.
+ * modified part of above commit, due to problems on Linux. Will
+ re-examine bug report and evaluate more closely.
2002-06-07 Don Porter <dgp@users.sourceforge.net>
- * tests/tcltest.test: More corrections to test suite so that tests
- of failing [test]s don't show up themselves as failing tests.
+ * tests/tcltest.test: More corrections to test suite so that tests of
+ failing [test]s don't show up themselves as failing tests.
2002-06-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclExecute.c: Tidied up headers in relation to float.h
- to cut the cruft and ensure DBL_MAX is defined since doubles seem
- to be the same size everywhere; if the assumption isn't true, the
- variant platforms had better have run configure...
+ * generic/tclExecute.c: Tidied up headers in relation to float.h to
+ cut the cruft and ensure DBL_MAX is defined since doubles seem to be
+ the same size everywhere; if the assumption isn't true, the variant
+ platforms had better have run configure...
* unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it
- wasn't previously defined. Also some other general tidying and
- adding of comments. [Tcl bugs 563122, 564595]
+ wasn't previously defined. Also some other general tidying and adding
+ of comments. [Bugs 563122, 564595]
* compat/tclErrno.h: Added definition for EOVERFLOW copied from
- Solaris headers; I've been unable to find any uses of EFTYPE,
- which was the error code previously occupying the slot, in Tcl, or
- any definition of it in the Solaris headers.
+ Solaris headers; I've been unable to find any uses of EFTYPE, which
+ was the error code previously occupying the slot, in Tcl, or any
+ definition of it in the Solaris headers.
2002-06-06 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g
- and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and
- CFLAGS_DEFAULT varaibles. [Tcl bug 565488]
+ * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g and add
+ CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and CFLAGS_DEFAULT varaibles. [Bug
+ 565488]
2002-06-06 Don Porter <dgp@users.sourceforge.net>
- * tests/tcltest.test: Corrections to test suite so that tests
- of failing [test]s don't show up themselves as failing tests.
+ * tests/tcltest.test: Corrections to test suite so that tests of
+ failing [test]s don't show up themselves as failing tests.
* tests/io.test: Fixed up namespace variable resolution issues
revealed by running test suite with "-singleproc 1".
@@ -2510,17 +2464,17 @@
2002-06-06 Daniel Steffen <das@users.sourceforge.net>
- * unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime):
- added mutex wrapped calls to readdir, localtime & gmtime in
- case their thread-safe *_r counterparts are not available.
+ * unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime): added
+ mutex wrapped calls to readdir, localtime & gmtime in case their
+ thread-safe *_r counterparts are not available.
* unix/tcl.m4: added configure check for readdir_r
- * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on
- MacOSX (where posix file apis expect utf-8, not iso8859-1).
+ * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX
+ (where posix file apis expect utf-8, not iso8859-1).
* unix/configure: regen
- * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel
- to LD_LIBRARY_PATH for MacOSX dynamic linker.
- * generic/tclEnv.c (TclSetEnv): fix env var setting on
- MacOSX (adapted from patch #524352 by jkbonfield).
+ * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to
+ LD_LIBRARY_PATH for MacOSX dynamic linker.
+ * generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX (adapted
+ from [Patch 524352] by jkbonfield).
2002-06-05 Don Porter <dgp@users.sourceforge.net>
@@ -2529,8 +2483,8 @@
2002-06-05 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclFileName.c (TclGlob): mac specific fix to
- recent changes in 'glob -tails' handling.
+ * generic/tclFileName.c (TclGlob): mac specific fix to recent changes
+ in 'glob -tails' handling.
* mac/tclMacPort.h:
* mac/tclMacChan.c: fixed TIP#91 bustage.
* mac/tclMacResource.c (Tcl_MacConvertTextResource): added utf
@@ -2542,7 +2496,7 @@
* library/tcltest/tcltest.tcl:
* tests/init.test:
* tests/tcltest.test: Added more TIP 85 tests from Arjen Markus.
- Converted tcltest.test to use a private namespace. Fixed bugs in
+ Converted tcltest.test to use a private namespace. Fixed bugs in
[tcltest::Eval] revealed by calling [tcltest::test] from a non-global
namespace, and namespace errors in init.test.
@@ -2555,22 +2509,22 @@
* doc/tcltest.n:
* library/tcltest/tcltest.tcl:
* library/tcltest/pkgIndex.tcl:
- * tests/tcltest.test: Implementation of TIP 85. Allows tcltest
- users to add new legal values of the -match option to [test],
- associating each with a Tcl command that does the matching of
- expected results with actual results of tests. Thanks to
- Arjen Markus. => tcltest 2.1 [Patch 521362]
+ * tests/tcltest.test: Implementation of TIP 85. Allows tcltest users
+ to add new legal values of the -match option to [test], associating
+ each with a Tcl command that does the matching of expected results
+ with actual results of tests. Thanks to Arjen Markus. => tcltest 2.1
+ [Patch 521362]
2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/namespace.n: added description of [namepace forget]
- behaviour for unqualified patterns [Bug 559268]
+ * doc/namespace.n: added description of [namepace forget] behaviour
+ for unqualified patterns. [Bug 559268]
2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: reverting an accidental modification in
- the last commit.
-
+ * generic/tclExecute.c: reverting an accidental modification in the
+ last commit.
+
2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
* doc/Tcl.n: clarify the empty variable name issue ([Bug 549285]
@@ -2579,25 +2533,25 @@
2002-05-31 Don Porter <dgp@users.sourceforge.net>
* library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex].
- Thanks to Helmut for report. [Bug 550534]
+ Thanks to Helmut for report. [Bug 550534]
* tests/io.test:
- * tests/main.test: Use the "stdio" constraint to control whether
- an [open "|[interpreter]"] is attempted.
+ * tests/main.test: Use the "stdio" constraint to control whether an
+ [open "|[interpreter]"] is attempted.
* generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode
- ExprCallMathFunc):
+ (ExprCallMathFunc):
* generic/tclInt.h (TclMathInProgress):
* unix/Makefile.in (tclMtherr.*):
* unix/configure.in (NEED_MATHERR):
* unix/tclAppInit.c (matherr):
* unix/tclMtherr.c (removed file):
* win/tclWinMtherr.c (_matherr): Removed internal routine
- TclMathInProgress and Unix implementation of matherr(). These
- are now obsolete, dealing with very old versions of the C math
- library. Windows version is retained in case Borland compilers
- require it, but it is inactive. Thanks to Joe English.
- [Bug 474335, Patch 555635].
+ TclMathInProgress and Unix implementation of matherr(). These are now
+ obsolete, dealing with very old versions of the C math library.
+ Windows version is retained in case Borland compilers require it, but
+ it is inactive. Thanks to Joe English. [Bug 474335, Patch 555635]
+
* unix/configure: regen
2002-05-30 Miguel Sofer <msofer@users.sourceforge.net>
@@ -2610,48 +2564,46 @@
2002-05-30 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclFileName.c (TclGlob): fix to longstanding
- 'knownBug' in fileName tests 15.2-15.4, and fix to a new
- Tcl 8.4 bug in certain uses of 'glob -tails'.
- * tests/fileName.test: removed 'knownBug' flag from some tests,
- added some new tests for above bugs.
-
+ * generic/tclFileName.c (TclGlob): fix to longstanding 'knownBug' in
+ fileName tests 15.2-15.4, and fix to a new Tcl 8.4 bug in certain uses
+ of 'glob -tails'.
+ * tests/fileName.test: removed 'knownBug' flag from some tests, added
+ some new tests for above bugs.
+
2002-05-29 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure: regen'ed
- * unix/configure.in: replaced bigendian check with autoconf
- standard AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on
- bigendian systems.
- * generic/tclUtf.c (Tcl_UniCharNcmp):
+ * unix/configure.in: replaced bigendian check with autoconf standard
+ AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on bigendian systems.
+ * generic/tclUtf.c (Tcl_UniCharNcmp):
* generic/tclInt.h (TclUniCharNcmp): use WORDS_BIGENDIAN instead of
TCL_OPTIMIZE_UNICODE_COMPARE to enable memcmp alternative.
* generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP):
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for
- choosing the Tcl_UniCharNcmp compare to when both objs are of
- StringType, as benchmarks show that is the optimal check (both
- bigendian and littleendian systems).
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for choosing
+ the Tcl_UniCharNcmp compare to when both objs are of StringType, as
+ benchmarks show that is the optimal check (both bigendian and
+ littleendian systems).
2002-05-29 Don Porter <dgp@users.sourceforge.net>
- * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar.
- It is no longer needed since Tcl_Main() now actually calls
- Tcl_LinkVar(). Thanks to Joe English for pointing that out.
+ * generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar. It is
+ no longer needed since Tcl_Main() now actually calls Tcl_LinkVar().
+ Thanks to Joe English for pointing that out.
2002-05-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclExecute.c (TclExecuteByteCode):
+ * generic/tclExecute.c (TclExecuteByteCode):
* generic/tclCmdMZ.c (Tcl_StringObjCmd): Use the macro version.
- * generic/tclInt.h (TclUniCharNcmp): Optimised still further with
- a macro for use in sensitive places like tclExecute.c
+ * generic/tclInt.h (TclUniCharNcmp): Optimised still further with a
+ macro for use in sensitive places like tclExecute.c
- * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out
- when we can use an optimal comparison scheme, and default to the
- old scheme in other cases which is at least safe.
- * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional
- flag that indicates when we can use memcmp() to compare Unicode
- strings (i.e. when the high-byte of a Tcl_UniChar precedes the
- low-byte.)
+ * generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out when
+ we can use an optimal comparison scheme, and default to the old scheme
+ in other cases which is at least safe.
+ * unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional flag
+ that indicates when we can use memcmp() to compare Unicode strings
+ (i.e. when the high-byte of a Tcl_UniChar precedes the low-byte.)
2002-05-29 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2659,26 +2611,25 @@
* generic/tclIntDecls.h:
* generic/tclStubInit.c:
* generic/tclUtf.c: added TclpUtfNcmp2 private command that
- mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This
+ mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This
provides a faster alternative for comparing utf strings internally.
- (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end
- of string check as it wasn't correct for the function (by doc and
- logic).
+ (Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end of
+ string check as it wasn't correct for the function (by doc and logic).
* generic/tclCmdMZ.c (Tcl_StringObjCmd): reworked the string equal
comparison code to use TclpUtfNcmp2 as well as short-circuit for
equal objects or unequal length strings in the equal case.
Removed the use of goto and streamlined the other parts.
- * generic/tclExecute.c (TclExecuteByteCode): added check for
- object equality in the comparison instructions. Added
- short-circuit for != length strings in INST_EQ, INST_NEQ and
- INST_STR_CMP. Reworked INST_STR_CMP to use TclpUtfNcmp2 where
- appropriate, and only use Tcl_UniCharNcmp when at least one of the
- objects is a Unicode obj with no utf bytes.
+ * generic/tclExecute.c (TclExecuteByteCode): added check for object
+ equality in the comparison instructions. Added short-circuit for !=
+ length strings in INST_EQ, INST_NEQ and INST_STR_CMP. Reworked
+ INST_STR_CMP to use TclpUtfNcmp2 where appropriate, and only use
+ Tcl_UniCharNcmp when at least one of the objects is a Unicode obj with
+ no utf bytes.
- * generic/tclCompCmds.c (TclCompileStringCmd): removed error
- creation in code that no longer throws an error.
+ * generic/tclCompCmds.c (TclCompileStringCmd): removed error creation
+ in code that no longer throws an error.
* tests/string.test:
* tests/stringComp.test: added more string comparison checks.
@@ -2695,18 +2646,18 @@
* generic/tclClock.c:
* generic/tclInt.decls:
* generic/tclIntDecls.h:
- * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by
- using an env(TZ) setting trick for in clock format -gmt 1. This
- also makes %s seem to work correctly with -gmt 1 as well as
- making it a lot faster by avoid the env(TZ) hack. TclpStrftime
- now takes useGMT as an arg. [Bug #559376]
+ * unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by using
+ an env(TZ) setting trick for in clock format -gmt 1. This also makes
+ %s seem to work correctly with -gmt 1 as well as making it a lot
+ faster by avoid the env(TZ) hack. TclpStrftime now takes useGMT as an
+ arg. [Bug 559376]
2002-05-28 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on
- a file inside a vfs. This should avoid leaving temporary
- files sitting around on exit. [Bug #545579]
-
+ * generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on a file
+ inside a vfs. This should avoid leaving temporary files sitting
+ around on exit. [Bug 545579]
+
2002-05-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* win/tclWinError.c: Added comment on conversion of
@@ -2725,17 +2676,17 @@
* generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc):
Adapted to use the new channel mechanism.
* unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed
- FileSeekProc to FileWideSeekProc and created new FileSeekProc
- which has the old-style interface and which errors out with
- EOVERFLOW when the returned file position can't fit into the
- return type (int for historical reasons.)
+ FileSeekProc to FileWideSeekProc and created new FileSeekProc which
+ has the old-style interface and which errors out with EOVERFLOW when
+ the returned file position can't fit into the return type (int for
+ historical reasons).
* win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed
- FileSeekProc to FileWideSeekProc and created new FileSeekProc
- which has the old-style interface and which errors out with
- EOVERFLOW when the returned file position can't fit into the
- return type (int for historical reasons.)
- * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs
- lack large-file support because I can't see how to add it.
+ FileSeekProc to FileWideSeekProc and created new FileSeekProc which
+ has the old-style interface and which errors out with EOVERFLOW when
+ the returned file position can't fit into the return type (int for
+ historical reasons).
+ * mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs lack
+ large-file support because I can't see how to add it.
* generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions
knowledge of the new arrangement of channel types.
(Tcl_ChannelVersion): Added recognition of new version code.
@@ -2749,89 +2700,83 @@
(TCL_CHANNEL_VERSION_3): New channel version.
2002-05-24 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-
- * tests/winPipe.test: Applied patch for SF Tcl Bug #549617. Patch
- and bug report by Kevin Kenny <kennykb@users.sourceforge.net>.
- * win/tclWinSock.c (TcpWatchProc): Fixed SF Tcl Bug #557878. We
- are not allowed to mess with the watch mask if the socket is a
- server socket. I believe that the original reporter is George
- Peter Staplin.
+ * tests/winPipe.test: Applied patch for [Bug 549617]. Patch and bug
+ report by Kevin Kenny <kennykb@users.sourceforge.net>.
+
+ * win/tclWinSock.c (TcpWatchProc): Fixed [Bug 557878]. We are not
+ allowed to mess with the watch mask if the socket is a server socket.
+ I believe that the original reporter is George Peter Staplin.
2002-05-21 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/configure.in: Invoke SC_ENABLE_SHARED before
- calling SC_CONFIG_CFLAGS so that the SHARED_BUILD
- variable can be checked inside SC_CONFIG_CFLAGS.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared
- instead of -shared to ld when configured with
- --disable-shared under OSF. [Tcl bug 540390]
+ * unix/configure.in: Invoke SC_ENABLE_SHARED before calling
+ SC_CONFIG_CFLAGS so that the SHARED_BUILD variable can be checked
+ inside SC_CONFIG_CFLAGS.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared instead of -shared
+ to ld when configured with --disable-shared under OSF. [Bug 540390]
2002-05-20 Daniel Steffen <das@users.sourceforge.net>
* generic/tclInt.h: added prototype for TclpFilesystemPathType().
- * mac/tclMacChan.c: use MSL provided creator type if available
- instead of the default 'MPW '.
+ * mac/tclMacChan.c: use MSL provided creator type if available instead
+ of the default 'MPW '.
2002-05-16 Joe English <jenglish@users.sf.net>
- * doc/CrtObjCmd.3:
- Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName
- (Tcl Bug #547987, #414921)
+ * doc/CrtObjCmd.3: Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName
+ [Bugs 547987, 414921]
2002-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function
- out to stop compiler warnings. Also much general tidying of
- comments in this file and removal of whitespace from blank lines.
+ * unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function out
+ to stop compiler warnings. Also much general tidying of comments in
+ this file and removal of whitespace from blank lines.
2002-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a
- signed second argument, and Linux thinks ioctl() takes an unsigned
- second argument. So need a longer definition of this macro to get
- neither to spew warnings...
+ * unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a signed
+ second argument, and Linux thinks ioctl() takes an unsigned second
+ argument. So need a longer definition of this macro to get neither to
+ spew warnings...
2002-05-13 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclEvent.c:
+ * generic/tclEvent.c:
* generic/tclIOUtil.c:
- * generic/tclInt.h: clean up all memory allocated by the
- filesystem, via introduction of 'TclFinalizeFilesystem'.
- Move TclFinalizeLoad into TclFinalizeFilesystem so we can
- be sure it is called at just the right time.
- Fix bad comment also. [Bug #555078 and 'fs' part of #543549]
+ * generic/tclInt.h: clean up all memory allocated by the filesystem,
+ via introduction of 'TclFinalizeFilesystem'.
+ Move TclFinalizeLoad into TclFinalizeFilesystem so we can be sure it
+ is called at just the right time.
+ Fix bad comment also. [Bug 555078 and 'fs' part of 543549]
* win/tclWinChan.c: fix comment referring to wrong function.
-
+
2002-05-10 Don Porter <dgp@users.sourceforge.net>
* tests/load.test:
* tests/safe.test:
- * tests/tcltest.test: Corrected some list-quoting issues and
- other matters that cause tests to fail when the patch includes
- special characters. Report from Vince Darley. [Bug 554068].
+ * tests/tcltest.test: Corrected some list-quoting issues and other
+ matters that cause tests to fail when the patch includes special
+ characters. Report from Vince Darley. [Bug 554068]
2002-05-08 David Gravereaux <davygrvy@pobox.com>
* doc/file.n:
* tools/man2tcl.c:
* tools/man2help2.tcl: Thanks to Peter Spjuth
- <peter.spjuth@space.se>, again. My prior fix for
- single-quote macro mis-understanding was wrong. Reverted to
- reimpliment the 'macro2' proc which handles single-quote macros
- and restored file.n text arrangement to avoid single-quotes on
- the first line. Sorry for all the confusion.
+ <peter.spjuth@space.se>, again. My prior fix for single-quote macro
+ mis-understanding was wrong. Reverted to reimpliment the 'macro2' proc
+ which handles single-quote macros and restored file.n text arrangement
+ to avoid single-quotes on the first line. Sorry for all the confusion.
2002-05-08 David Gravereaux <davygrvy@pobox.com>
* tools/man2tcl.c:
- * tools/man2help2.tcl: Proper source of macro error mis-
- understanding single-quote as the leading macro command found
- and repaired.
+ * tools/man2help2.tcl: Proper source of macro error misunderstanding
+ single-quote as the leading macro command found and repaired.
- * doc/file.n: Reverted to prior state before I messed with
- it.
+ * doc/file.n: Reverted to prior state before I messed with it.
2002-05-08 Don Porter <dgp@users.sourceforge.net>
@@ -2840,18 +2785,18 @@
* tests/fileName.test:
* tests/load.test:
* tests/main.test:
- * tests/tcltest.test:
- * tests/unixInit.test: Fixes to test suite when there's a space
- in the working path. Thanks to Kevin Kenny.
+ * tests/tcltest.test:
+ * tests/unixInit.test: Fixes to test suite when there's a space in the
+ working path. Thanks to Kevin Kenny.
2002-05-07 David Gravereaux <davygrvy@pobox.com>
-- Changes from Peter Spjuth <peter.spjuth@space.se>
- * tools/man2tcl.c: Increased line buffer size and a bail-out if
- that should ever be over-run.
+ * tools/man2tcl.c: Increased line buffer size and a bail-out if that
+ should ever be over-run.
* tools/man2help.tcl: Include Courier New font in rtf header.
- * tools/man2help2.tcl: Improved handling of CS/CE fields. Use
- Courier New for code samples and indent better.
+ * tools/man2help2.tcl: Improved handling of CS/CE fields. Use Courier
+ New for code samples and indent better.
* doc/file.n:
* doc/TraceCmd.3: winhelp conversion tools where understanding
@@ -2861,14 +2806,14 @@
2002-05-07 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclFileName.c: fix to similar segfault when using
- 'glob -types nonsense -dir dirname -join * *'. [Bug 553320]
-
+ * generic/tclFileName.c: fix to similar segfault when using 'glob
+ -types nonsense -dir dirname -join * *'. [Bug 553320]
+
* doc/FileSystem.3: further documentation on vfs.
* tests/cmdAH.test:
* tests/fileSystem.test:
- * tests/pkgMkindex.test: Fix to testsuite bugs when running out
- of directory whose name contains '{' or '['.
+ * tests/pkgMkindex.test: Fix to testsuite bugs when running out of
+ directory whose name contains '{' or '['.
2002-05-07 Miguel Sofer <msofer@users.sourceforge.net>
@@ -2879,57 +2824,55 @@
2002-05-02 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclFileName.c: fix to freeing a bad object
- (i.e. segfault) when using 'glob -types nonsense -dir dirname'.
- * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some
- long lines.
+ * generic/tclFileName.c: fix to freeing a bad object (i.e. segfault)
+ when using 'glob -types nonsense -dir dirname'.
+ * generic/tclWinFile.c: fix to [Bug 551306], also wrapped some long
+ lines.
* tests/fileName.test: added several tests for the above bugs.
- * doc/FileSystem.3: clarified documentation on refCount
- requirements of the object returned by the path type function.
+ * doc/FileSystem.3: clarified documentation on refCount requirements
+ of the object returned by the path type function.
* generic/tclIOUtil.c:
* win/tclWinFile.c:
* unix/tclUnixFile.c:
- * mac/tclMacFile.c: moved TclpFilesystemPathType to the
- platform specific directories, so we can add missing platform-
- specific implementations. On Windows, 'file system' now returns
- useful results like "native NTFS", "native FAT" for that system.
- Unix and MacOS still only return "native".
+ * mac/tclMacFile.c: moved TclpFilesystemPathType to the platform-
+ specific directories, so we can add missing platform-specific
+ implementations. On Windows, 'file system' now returns useful results
+ like "native NTFS", "native FAT" for that system. Unix and MacOS still
+ only return "native".
* doc/file.n: clarified documentation.
- * tests/winFile.test: test for 'file system' returning correct
- values.
+ * tests/winFile.test: test for 'file system' returning correct values.
* tests/fileSystem.test: test for 'file system' returning correct
- values. Clean up after failed previous test run.
-
+ values. Clean up after failed previous test run.
+
2002-04-26 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure:
- * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so
- that the .sl knows its dependent libs.
+ * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so that
+ the .sl knows its dependent libs.
2002-04-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tests/obj.test (obj-11.[56]): Test conversion to boolean more
thoroughly.
* generic/tclObj.c (SetBooleanFromAny): Was not calling an integer
- parsing function on native 64-bit platforms! [Bug 548686]
+ parsing function on native 64-bit platforms! [Bug 548686]
2002-04-24 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclInt.h: corrected TclRememberJoinableThread decl to
- use VOID instead of void.
+ * generic/tclInt.h: corrected TclRememberJoinableThread decl to use
+ VOID instead of void.
* generic/tclThreadJoin.c: noted that this code isn't needed on Unix.
2002-04-23 Jeff Hobbs <jeffh@ActiveState.com>
- * doc/exec.n:
- * doc/tclvars.n: doc updates [Patch #509426] (gravereaux)
+ * doc/exec.n:
+ * doc/tclvars.n: doc updates [Patch 509426] (gravereaux)
2002-04-24 Daniel Steffen <das@users.sourceforge.net>
- * mac/tclMacResource.r: added check of
- TCLTK_NO_LIBRARY_TEXT_RESOURCES #define to allow disabling the
- inclusion of the tcl library code in the resource fork of Tcl
- executables and shared libraries.
+ * mac/tclMacResource.r: added check of TCLTK_NO_LIBRARY_TEXT_RESOURCES
+ #define to allow disabling the inclusion of the tcl library code in
+ the resource fork of Tcl executables and shared libraries.
2002-04-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -2945,44 +2888,44 @@
* unix/tclUnixThrd.c:
* win/Makefile.in:
* win/tclWinInt.h:
- * win/tclWinThrd.c: added new threaded allocator contributed by
- AOL that significantly reduces lock contention when multiple
- threads are in use. Only Windows and Unix implementations are
- ready, and the Windows one may need work. It is only used by
- default on Unix for now, and requires that USE_THREAD_ALLOC be
- defined (--enable-threads on Unix will define this).
+ * win/tclWinThrd.c: added new threaded allocator contributed by AOL
+ that significantly reduces lock contention when multiple threads are
+ in use. Only Windows and Unix implementations are ready, and the
+ Windows one may need work. It is only used by default on Unix for now,
+ and requires that USE_THREAD_ALLOC be defined (--enable-threads on
+ Unix will define this).
- * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister):
- corrected calling of Tcl_ConditionWait to ensure that there would
- be a condition to wait upon.
+ * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister): corrected
+ calling of Tcl_ConditionWait to ensure that there would be a condition
+ to wait upon.
* generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE.
- * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API
- calls in file deletion for correct Win32 API handling.
+ * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API calls
+ in file deletion for correct Win32 API handling.
* win/Makefile.in: correct dependencies for shell, gdb, runtest
targets.
* doc/clock.n:
* compat/strftime.c (_fmt): change strftime to correctly handle
- localized %c, %x and %X on Windows. Added some notes about how
- the other values could be further localized.
+ localized %c, %x and %X on Windows. Added some notes about how the
+ other values could be further localized.
2002-04-19 Don Porter <dgp@users.sourceforge.net>
* generic/tclMain.c (Tcl_Main): Free the memory allocated for the
- startup script path. [Bug 543549]
+ startup script path. [Bug 543549]
* library/msgcat/msgcat.tcl: [mcmax] wasn't using the caller's
- namespace when determining the max translated length. Also
- made revisions for better use of namespace variables and more
- efficient [uplevel]s.
+ namespace when determining the max translated length. Also made
+ revisions for better use of namespace variables and more efficient
+ [uplevel]s.
* doc/msgcat.n:
* library/msgcat/msgcat.tcl:
- * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list
- of msgcat; bumped to 1.2.3. [Bug 544727]
+ * library/msgcat/pkgIndex.tcl: Added [mcload] to the export list of
+ msgcat; bumped to 1.2.3. [Bug 544727]
2002-04-20 Daniel Steffen <das@users.sourceforge.net>
@@ -2991,97 +2934,95 @@
* generic/tclStubInit.c:
* mac/tclMacFCmd.c:
* mac/tclMacFile.c:
- * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias
- file aware, and replaced various calls to FSpLocationFrom*Path
- by calls to new alias file aware versions FSpLLocationFrom*Path.
- The alias file aware routines don't resolve the last component of
- a path if it is an alias. This allows [file copy/delete] etc. to
- act correctly on alias files. (c.f. discussion in Bug #511666)
+ * mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias file
+ aware, and replaced various calls to FSpLocationFrom*Path by calls to
+ new alias file aware versions FSpLLocationFrom*Path. The alias file
+ aware routines don't resolve the last component of a path if it is an
+ alias. This allows [file copy/delete] etc. to act correctly on alias
+ files. (c.f. discussion in [Bug 511666])
2002-04-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/lindex.test (lindex-3.7):
- * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from
- hitting wide ints. [Bug #526717]
+ * tests/lindex.test (lindex-3.7):
+ * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from hitting
+ wide ints. [Bug 526717]
2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclNamesp.c:
- * tests/info.test: [Bug 545325] info level didn't report
- namespace eval, bug report by Richard Suchenwirth.
+ * tests/info.test: [Bug 545325] info level didn't report namespace
+ eval, bug report by Richard Suchenwirth.
2002-04-18 Don Porter <dgp@users.sourceforge.net>
* doc/subst.n: Clarified documentation on handling unusual return
- codes during substitution, and on variable substitutions implied
- by command substitution, and vice versa. [Bug 536838]
+ codes during substitution, and on variable substitutions implied by
+ command substitution, and vice versa. [Bug 536838]
2002-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdIL.c (InfoBodyCmd):
- * tests/info.test (info-2.6): Proc bodies without string reps
- would report as empty [Bug #545644]
+ * generic/tclCmdIL.c (InfoBodyCmd):
+ * tests/info.test (info-2.6): Proc bodies without string reps would
+ report as empty. [Bug 545644]
- * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for
- comment on behaviour when substitutions are not well-formed,
- prompted by [Bug #536831]; alas, removing the ill-defined
- behaviour is a lot of work.
+ * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on
+ behaviour when substitutions are not well-formed, prompted by [Bug
+ 536831]; alas, removing the ill-defined behaviour is a lot of work.
2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c:
- * tests/expr-old.test: fix for [Bug #542588] (Phil Ehrens), where
- "too large integers" were reported as "floating-point value" in
- [expr] error messages.
+ * tests/expr-old.test: fix for [Bug 542588] (Phil Ehrens), where "too
+ large integers" were reported as "floating-point value" in [expr]
+ error messages.
2002-04-17 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclEncoding.c (EscapeFromUtfProc):
- * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling
- of outputting end escapes for escape-based encodings.
- [Bug #526524] (yamamoto)
+ * generic/tclEncoding.c (EscapeFromUtfProc):
+ * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling of
+ outputting end escapes for escape-based encodings.
+ [Bug 526524] (yamamoto)
2002-04-17 Don Porter <dgp@users.sourceforge.net>
- * doc/tcltest.n: Removed [saveState] and [restoreState] from
- tcltest 2 documentation, effectively deprecating them. [Bug 495660]
- * library/tcltest/tcltest.tcl: Made separate export for commands
- kept only for tcltest 1 compatibility.
+ * doc/tcltest.n: Removed [saveState] and [restoreState] from tcltest
+ 2 documentation, effectively deprecating them. [Bug 495660]
+ * library/tcltest/tcltest.tcl: Made separate export for commands kept
+ only for tcltest 1 compatibility.
* tests/iogt.test: Revised to run tests in a namespace, rather than
- use the useless and buggy [saveState] and [restoreState] commands
- of tcltest. Updated to use tcltest 2 as well. [Patch 544911]
+ use the useless and buggy [saveState] and [restoreState] commands of
+ tcltest. Updated to use tcltest 2 as well. [Patch 544911]
2002-04-16 Don Porter <dgp@users.sourceforge.net>
- * tests/io.test: Revised to run tests in a namespace, rather than
- use the useless and buggy [saveState] and [restoreState] commands
- of tcltest. Updated to use tcltest 2 as well. [Patch 544546]
+ * tests/io.test: Revised to run tests in a namespace, rather than use
+ the useless and buggy [saveState] and [restoreState] commands of
+ tcltest. Updated to use tcltest 2 as well. [Patch 544546]
2002-04-15 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclProc.c:
* tests/proc-old.test: Improved stack trace for TCL_BREAK and
- TCL_CONTINUE returns from procs. Patch by Don Porter
- [Bug 536955].
-
+ TCL_CONTINUE returns from procs. Patch by Don Porter [Bug 536955].
+
* generic/tclExecute.c:
* tests/compile.test: made bytecodes check for a catch before
- returning; the compiled [return] is otherwise non-catchable.
- [Bug 542142] reported by Andreas Kupries.
+ returning; the compiled [return] is otherwise non-catchable. [Bug
+ 542142] reported by Andreas Kupries.
2002-04-15 Don Porter <dgp@users.sourceforge.net>
* tests/socket.test: Increased timeout values so that tests have
- time to successfully complete even on slow/busy machines. [Bug 523470]
+ time to successfully complete even on slow/busy machines. [Bug 523470]
* doc/tcltest.n:
* library/tcltest/tcltest.tcl:
- * tests/tcltest.test: Revised [tcltest::test] to return errors
- when called with invalid syntax and to accept exactly two arguments
- as documented. Improved error messages. [Bug 497446, Patch 513983]
- ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous
- tcltest 2.* releases, found only in alpha releases of Tcl 8.4.
+ * tests/tcltest.test: Revised [tcltest::test] to return errors when
+ called with invalid syntax and to accept exactly two arguments as
+ documented. Improved error messages. [Bug 497446, Patch 513983]
+ ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous tcltest
+ 2.* releases, found only in alpha releases of Tcl 8.4.
2002-04-11 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3089,14 +3030,14 @@
unserviced events on finalization.
* win/tcl.m4: Enabled COFF as well as CV style debug info with
- --enable-symbols to allow Dr. Watson users to see function info.
- More info on debugging levels can be obtained at:
+ --enable-symbols to allow Dr. Watson users to see function info. More
+ info on debugging levels can be obtained at:
http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp
* tests/ioCmd.test: fixed iocmd-8.15 to have mac and unixPc variants.
- * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj
- refcount to prevent possible mem leak.
+ * generic/tclParse.c (Tcl_ParseVar): conditionally incr obj refcount
+ to prevent possible mem leak.
2002-04-08 Daniel Steffen <das@users.sourceforge.net>
@@ -3105,63 +3046,62 @@
* mac/tclMacOSA.c:
* mac/tclMacResource.c: added missing Tcl_UtfToExternalDString
conversions of resource file names.
- * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced
- by Andreas on 02-25; changed strcmp's to strncmp's so that
- option comparison behaves like on other platforms.
- * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added
- support to allow Tk to hookup C library stderr/stdout to TkConsole.
+ * mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced by Andreas
+ on 02-25; changed strcmp's to strncmp's so that option comparison
+ behaves like on other platforms.
+ * mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added support to
+ allow Tk to hookup C library stderr/stdout to TkConsole.
* tests/basic.test:
* tests/cmdAH.test:
* tests/encoding.test:
* tests/fileSystem.test:
- * tests/ioCmd.test: fixed tests failing on mac: check for
- existence of [exec], changed some result strings.
+ * tests/ioCmd.test: fixed tests failing on mac: check for existence of
+ [exec], changed some result strings.
2002-04-06 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tclUnixFCmd.c (Realpath): added a little extra code to
- initialize a realpath arg when compiling in PURIFY mode in order
- to prevent spurious purify warnings. We should really create our
- own realpath implementation, but this will at least quiet purify
- for now.
+ initialize a realpath arg when compiling in PURIFY mode in order to
+ prevent spurious purify warnings. We should really create our own
+ realpath implementation, but this will at least quiet purify for now.
2002-04-05 Don Porter <dgp@users.sourceforge.net>
* generic/tclCmdMZ.c (Tcl_SubstObj):
- * tests/subst.test: Corrected [subst] so that return codes
- TCL_BREAK and TCL_CONTINUE returned by variable substitution
- have the same effect as when those codes are returned by command
- substitution. [Bug 536879]
+ * tests/subst.test: Corrected [subst] so that return codes TCL_BREAK
+ and TCL_CONTINUE returned by variable substitution have the same
+ effect as when those codes are returned by command substitution. [Bug
+ 536879]
2002-04-03 Jeff Hobbs <jeffh@ActiveState.com>
- * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias
- to GetMatchingFiles), which was a public function in tcltest 1.0.
+ * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias to
+ GetMatchingFiles), which was a public function in tcltest 1.0.
2002-04-01 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclEnv.c:
- * generic/tclIOUtil.c: invalidate filesystem cache when the
- user changes env(HOME). Fixes [Bug #535621]. Also cleaned up
- some of the documentation.
+ * generic/tclIOUtil.c: invalidate filesystem cache when the user
+ changes env(HOME). Fixes [Bug 535621]. Also cleaned up some of the
+ documentation.
* tests/fileSystem.test: added test for bug just fixed.
-
+
2002-04-01 Kevin Kenny <kennykb@acm.org>
- * win/tclWinTime.c (Tcl_GetTime): made the checks of clock
- frequency more permissive to cope with the fact that Win98SE
- is observed to return 1.19318 in place of 1.193182 for the
- performance counter frequency.
-
+ * win/tclWinTime.c (Tcl_GetTime): made the checks of clock frequency
+ more permissive to cope with the fact that Win98SE is observed to
+ return 1.19318 in place of 1.193182 for the performance counter
+ frequency.
+
2002-03-29 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc)
- (TraceCommandProc, TclTraceCommandObjCmd): corrected
- potential double-free of traces on variables by flagging in
- Trace*Proc that it will free the var in case the eval wants to
- delete the var trace as well. [Bug #536937]
- Also converted Tcl_UntraceVar -> Tcl_UntraceVar2 and Tcl_Eval to
- Tcl_EvalEx in Trace*Proc for slight efficiency improvement.
+ (TraceCommandProc, TclTraceCommandObjCmd): corrected potential
+ double-free of traces on variables by flagging in Trace*Proc that it
+ will free the var in case the eval wants to delete the var trace as
+ well. [Bug 536937] Also converted Tcl_UntraceVar -> Tcl_UntraceVar2
+ and Tcl_Eval to Tcl_EvalEx in Trace*Proc for slight efficiency
+ improvement.
2002-03-29 Don Porter <dgp@users.sourceforge.net>
@@ -3169,25 +3109,24 @@
* generic/tclBasic.c (Tcl_EvalObjv,Tcl_EvalEx,Tcl_EvalObjEx):
* generic/tclCompile.h (TclCompEvalObj):
* generic/tclExecute.c (TclCompEvalObj,TclExecuteByteCode):
- * tests/basic.test: Corrected problems with Tcl_AllowExceptions
- having influence over the wrong scope of Tcl_*Eval* calls. Patch
- from Miguel Sofer. Report from Jean-Claude Wippler. [Bug 219181]
+ * tests/basic.test: Corrected problems with Tcl_AllowExceptions having
+ influence over the wrong scope of Tcl_*Eval* calls. Patch from Miguel
+ Sofer. Report from Jean-Claude Wippler. [Bug 219181]
2002-03-28 Don Porter <dgp@users.sourceforge.net>
- * generic/tclVar.c: Refactored CallTraces to collect repeated
- handling of its returned value into CallTraces itself.
+ * generic/tclVar.c: Refactored CallTraces to collect repeated handling
+ of its returned value into CallTraces itself.
2002-03-28 David Gravereaux <davygrvy@pobox.com>
* tools/feather.bmp:
* tools/man2help.tcl:
* tools/man2help2.tcl:
- * win/makefile.vc: More winhelp target fixups. Added a feather
- bitmap to the non-scrollable area and changed the color to be
- yellow from a plain white. The colors can be whatever we want
- them to be, but thought I would start with something bold.
- [Bug 527941]
+ * win/makefile.vc: More winhelp target fixups. Added a feather bitmap
+ to the non-scrollable area and changed the color to be yellow from a
+ plain white. The colors can be whatever we want them to be, but
+ thought I would start with something bold. [Bug 527941]
* doc/SetVar.3:
* doc/TraceVar.3:
@@ -3196,11 +3135,10 @@
2002-03-27 David Gravereaux <davygrvy@pobox.com>
* tools/man2help.tcl:
- * win/makefile.vc: winhelp target now copies all needed files
- from tools/ to a workarea under $(OUT_DIR) and builds it from
- there. No build cruft is left in tools/ anymore. All paths
- used in man2help.tcl are now relative to where the script is.
- [Bug 527941]
+ * win/makefile.vc: winhelp target now copies all needed files from
+ tools/ to a workarea under $(OUT_DIR) and builds it from there. No
+ build cruft is left in tools/ anymore. All paths used in man2help.tcl
+ are now relative to where the script is. [Bug 527941]
2002-03-27 David Gravereaux <davygrvy@pobox.com>
@@ -3209,28 +3147,26 @@
* win/coffbase.txt:
* win/makefile.vc:
* win/nmakehlp.c (new):
- * win/rules.vc: First draft fix for [Bug 527941]. More changes
- need to done to the makehelp target to get to stop leaving build
- files in the tools/ directory. This does not address the syntax
- errors in the man files. Having the contents of tcl.hpj(.in)
- inside makefile.vc allows for version numbers to be replaced with
- macros.
-
+ * win/rules.vc: First draft fix for [Bug 527941]. More changes need
+ to done to the makehelp target to get to stop leaving build files in
+ the tools/ directory. This does not address the syntax errors in the
+ man files. Having the contents of tcl.hpj(.in) inside makefile.vc
+ allows for version numbers to be replaced with macros.
+
The new nmakehlp.c is built by rules.vc in preprocessing and removes
the need to use tricky shell syntax that wasn't compatible on Win9x
- systems. Clean targets made Win9x complient. This is a first draft
+ systems. Clean targets made Win9x complient. This is a first draft
repair for [Bug 533862].
2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize
- to TclEvalObjvInternal. [Bug 219362], fix by David Knoll.
+ * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize to
+ TclEvalObjvInternal. [Bug 219362], fix by David Knoll.
2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c (Tcl_EvalEx):
- * tests/basic.test: avoid exceptional returns at level 0
- [Bug 219181]
+ * tests/basic.test: avoid exceptional returns at level 0. [Bug 219181]
2002-03-27 Don Porter <dgp@users.sourceforge.net>
@@ -3247,32 +3183,32 @@
* tests/main.test: Removed workarounds for Bug 495977.
* library/tcltest/tcltest.tcl: Keep the value of $::auto_path
- unchanged, so that the tcltest package can test code that depends
- on auto-loading. If a testing application needs $::auto_path pruned,
- it should do that itself. [Bug 495726]
+ unchanged, so that the tcltest package can test code that depends on
+ auto-loading. If a testing application needs $::auto_path pruned, it
+ should do that itself. [Bug 495726]
Improve the processing of the -constraints option to [test] so that
constraint lists can have arbitrary whitespace, and non-lists don't
- blow things up. [Bug 495977]
+ blow things up. [Bug 495977]
Corrected faulty variable initialization. [Bug 534845]
2002-03-25 Miguel Sofer <msofer@users.sourceforge.net>
* doc/CrtTrace.3: small doc correction
- * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on
- trace deletions [Bug 534728] (Hemang Lavana).
+ * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on trace
+ deletions. [Bug 534728] (Hemang Lavana)
2002-03-24 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect
- code as described in [Bug 533907] (Don Porter).
+ * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect code
+ as described in [Bug 533907] (Don Porter).
2002-03-24 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: Use [interpreter] to set/query the
- executable currently running the tcltest package. [Bug 454050]
+ executable currently running the tcltest package. [Bug 454050]
- * library/tcltest/tcltest.tcl: Allow non-proc commands to be used
- as the customization hooks. [Bug 495662]
+ * library/tcltest/tcltest.tcl: Allow non-proc commands to be used as
+ the customization hooks. [Bug 495662]
2002-03-24 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -3291,48 +3227,45 @@
* doc/file.n:
* tests/cmdAH.test:
* tests/fileName.test:
- * tests/fileSystem.test: (new file)
- * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658],
- and improved documentation of some aspects of the filesystem,
- particularly 'Tcl_FSMatchInDirectory' which now might match
- a single file/directory only, and 'file normalize' which
- wasn't very clear before. Removed inconsistency betweens
- docs and the Tcl_Filesystem structure. Also fixed
- [Bug 523217] and corrected file normalization on Unix so that
- it expands symbolic links. Added some new tests of the
- filesystem code (in the new file 'fileSystem.test'), and
- some extra tests for correct handling of symbolic links.
- Fix to [Bug 530960] which shows up on Win98. Made comparison
- with ".com" case insensitive in tclWinPipe.c
-
- ***POTENTIAL INCOMPATIBILITY***: But only between alpha
- releases (users of the new Tcl_Filesystem lookup table in Tcl
- 8.4a4 need to handle the new way in which Tcl may call
- Tcl_FSMatchInDirectory, and 'file normalize' on unix now
- behaves correctly). Only known impact is with the 'tclvfs'
- extension.
+ * tests/fileSystem.test: (new file)
+ * tests/winFCmd.test: fix [Bug 511666] and [Bug 511658], and improved
+ documentation of some aspects of the filesystem, particularly
+ 'Tcl_FSMatchInDirectory' which now might match a single file/directory
+ only, and 'file normalize' which wasn't very clear before. Removed
+ inconsistency betweens docs and the Tcl_Filesystem structure. Also
+ fixed [Bug 523217] and corrected file normalization on Unix so that
+ it expands symbolic links. Added some new tests of the filesystem
+ code (in the new file 'fileSystem.test'), and some extra tests for
+ correct handling of symbolic links. Fix to [Bug 530960] which shows up
+ on Win98. Made comparison with ".com" case insensitive in tclWinPipe.c
+
+ ***POTENTIAL INCOMPATIBILITY***: But only between alpha releases
+ (users of the new Tcl_Filesystem lookup table in Tcl 8.4a4 need to
+ handle the new way in which Tcl may call Tcl_FSMatchInDirectory, and
+ 'file normalize' on unix now behaves correctly). Only known impact is
+ with the 'tclvfs' extension.
2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/basic.test (basic-46.1): adding test for [Bug 533758],
- fixed earlier today.
-
+ * tests/basic.test (basic-46.1): adding test for [Bug 533758], fixed
+ earlier today.
+
2002-03-22 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug #478579]
+ * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug 478579]
2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c (Tcl_EvalObjEx):
* generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for
- return codes other than (TCL_OK, TCL_ERROR) to runLevel 0
- [Bug 533758]. Removed the static RecordTracebackInfo(), as its
- functionality is easily replicated by Tcl_LogCommandInfo. Bug
- and redundancy noted by Don Porter.
+ return codes other than (TCL_OK, TCL_ERROR) to runLevel 0.[Bug 533758]
+ Removed the static RecordTracebackInfo(), as its functionality is
+ easily replicated by Tcl_LogCommandInfo. Bug and redundancy noted by
+ Don Porter.
2002-03-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/expr.n: Improved documentation for ceil and floor [Bug 530535]
+ * doc/expr.n: Improved documentation for ceil and floor. [Bug 530535]
2002-03-20 Don Porter <dgp@users.sourceforge.net>
@@ -3341,8 +3274,8 @@
* doc/UpVar.3:
* generic/tcl.h (Tcl_VarTraceProc):
* generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2,
- Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2,
- Tcl_GetVar2Ex, TclSetVar2Ex):
+ (Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2,
+ (Tcl_GetVar2Ex, TclSetVar2Ex):
* generic/tclCmdMZ.c (TraceVarProc):
* generic/tclEnv.c (EnvTraceProc):
* generic/tclEvent.c (VwaitVarProc):
@@ -3350,12 +3283,12 @@
* generic/tclLink.c (LinkTraceProc):
* generic/tclUtil.c (TclPrecTraceProc):
* generic/tclVar.c (CallTraces, MakeUpvar, VarErrMsg, TclLookupVar,
- Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2,
- Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex,
- TclSetVar2Ex): Updated interfaces of generic/tclVar.c according
- to TIP 27. In particular, the "part2" arguments were CONSTified.
- [Patch 532642]
- * generic/tclDecls.h:
+ (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2,
+ (Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex,
+ (TclSetVar2Ex): Updated interfaces of generic/tclVar.c according to
+ TIP 27. In particular, the "part2" arguments were CONSTified. [Patch
+ 532642]
+ * generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
2002-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3367,33 +3300,30 @@
2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Add configure time test for SEH
- support in the compiler.
+ * win/configure.in: Add configure time test for SEH support in the
+ compiler.
* win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace,
- _except_checkstackspace_handler):
+ (_except_checkstackspace_handler):
* win/tclWinChan.c (ESP, EBP, Tcl_MakeFileChannel,
- _except_makefilechannel_handler):
- * win/tclWinFCmd.c (ESP, EBP, DoRenameFile,
- _except_dorenamefile_handler,
- DoCopyFile, _except_docopyfile_handler):
- Implement SEH support under gcc using inline asm.
- Tcl and Tk should now compile with Mingw 1.1. [Patch 525746]
+ (_except_makefilechannel_handler):
+ * win/tclWinFCmd.c (ESP, EBP, DoRenameFile, DoCopyFile,
+ (_except_dorenamefile_handler, _except_docopyfile_handler):
+ Implement SEH support under gcc using inline asm. Tcl and Tk should
+ now compile with Mingw 1.1. [Patch 525746]
2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle
- an SEH exception with EXCEPTION_EXECUTE_HANDLER instead
- of restarting the faulting instruction with
- EXCEPTION_CONTINUE_EXECUTION. Bug 466102 provides an
- example of how restarting could send Tcl into an
- infinite loop. [Patch 525746]
+ * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle an SEH exception
+ with EXCEPTION_EXECUTE_HANDLER instead of restarting the faulting
+ instruction with EXCEPTION_CONTINUE_EXECUTION. [Bug 466102] provides
+ an example of how restarting could send Tcl into an infinite loop.
+ [Patch 525746]
2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
* win/tclWinFCmd.c (DoRenameFile, DoCopyFile, DoDeleteFile,
- DoRemoveJustDirectory): Make sure we don't pass NULL or ""
- as a path name to Win32 API functions since this was
- crashing under Windows 98.
+ (DoRemoveJustDirectory): Make sure we don't pass NULL or "" as a path
+ name to Win32 API functions since this was crashing under Windows 98.
2002-03-11 Don Porter <dgp@users.sourceforge.net>
@@ -3402,25 +3332,23 @@
2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
- * library/tcltest/tcltest.tcl (getMatchingFiles): Pass
- a proper list to foreach to avoid munging a Windows
- patch like D:\Foo\Bar into D:FooBar before the glob.
+ * library/tcltest/tcltest.tcl (getMatchingFiles): Pass a proper list
+ to foreach to avoid munging a Windows patch like D:\Foo\Bar into
+ D:FooBar before the glob.
2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
* generic/tclEncoding.c: Fix typo in comment.
- * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars):
- Use NULL value instead of pointer set to NULL to make
- things more clear. Reorder arguments so that they
- match the function signatures. Cleanup little typos
- and add more descriptive comment.
+ * generic/tclIO.c (DoReadChars, ReadBytes, ReadChars): Use NULL value
+ instead of pointer set to NULL to make things more clear. Reorder
+ arguments so that they match the function signatures. Cleanup little
+ typos and add more descriptive comment.
2002-03-08 Mo DeJong <mdejong@users.sourceforge.net>
- * win/README: Update to indicate that Mingw 1.1 is
- required to build Tcl. Add section describing new
- msys based build process. Update Cygwin build
- instructions so users know where to find Mingw 1.1.
+ * win/README: Update to indicate that Mingw 1.1 is required to build
+ Tcl. Add section describing new msys based build process. Update
+ Cygwin build instructions so users know where to find Mingw 1.1.
2002-03-08 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3429,18 +3357,18 @@
2002-03-07 Mo DeJong <mdejong@users.sourceforge.net>
* win/tclWin32Dll.c (TclpCheckStackSpace):
- * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace
- hard coded constants with Win32 symbolic names.
- Move control flow statements out of __try blocks
- since the documentation indicates it is frowned upon.
+ * win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace hard coded
+ constants with Win32 symbolic names. Move control flow statements out
+ of __try blocks since the documentation indicates it is frowned upon.
2002-03-07 Don Porter <dgp@users.sourceforge.net>
* doc/interp.n:
- * generic/tclInterp.c(Tcl_InterpObjCmd,SlaveObjCmd,SlaveRecursionLimit):
+ * generic/tclInterp.c (Tcl_InterpObjCmd, SlaveObjCmd,
+ (SlaveRecursionLimit):
* generic/tclTest.c:
* tests/interp.test: Added the [interp recursionlimit] command to
- set/query the recursion limit of an interpreter. Proposal and
+ set/query the recursion limit of an interpreter. Proposal and
implementation from Stephen Trier. [TIP 87, Patch 522849]
2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3448,30 +3376,29 @@
* generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
* unix/tcl.spec, win/README.binary, win/configure.in, README:
Bumped patchlevel; this might need to change in the future, but it
- will help us distinguish between the CVS version and the most
- recent released version.
+ will help us distinguish between the CVS version and the most recent
+ released version.
2002-03-06 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclInt.h: for unshared objects, TclDecrRefCount now
- frees the internal rep before the string rep - just like the
- non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802].
+ * generic/tclInt.h: for unshared objects, TclDecrRefCount now frees
+ the internal rep before the string rep - just like the non-macro
+ Tcl_DecrRefCount/TclFreeObj. [Bug 524802]
2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/lsearch.n: Documentation of new features, plus examples.
* tests/lsearch.test: Tests of new features.
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See
http://purl.org/tcl/tip/80 for details.
2002-03-05 Jeff Hobbs <jeffh@ActiveState.com>
*** 8.4a4 TAGGED FOR RELEASE ***
- * unix/tclUnixChan.c: initial remedy for [Bug #525783] flush
- problem introduced by TIP #35. This may not satisfy true serial
- channels, but it restores the correct flushing of std* channels on
- exit.
+ * unix/tclUnixChan.c: initial remedy for [Bug 525783] flush problem
+ introduced by TIP #35. This may not satisfy true serial channels, but
+ it restores the correct flushing of std* channels on exit.
* unix/README: added --enable-langinfo doc.
@@ -3493,21 +3420,21 @@
* tests/encoding.test: corrected iso2022 encoding results.
added encoding-24.*
* generic/tclEncoding.c (EscapeFromUtfProc): corrected output of
- escape codes as per RFC 1468. [Patch #474358] (taguchi)
+ escape codes as per RFC 1468. [Patch 474358] (taguchi)
(TclFinalizeEncodingSubsystem): corrected potential double-free
- when encodings were finalized on exit. [Bug #219314, #524674]
+ when encodings were finalized on exit. [Bugs 219314, 524674]
2002-03-01 Jeff Hobbs <jeffh@ActiveState.com>
- * library/encoding/iso2022-jp.enc:
- * library/encoding/iso2022.enc:
+ * library/encoding/iso2022-jp.enc:
+ * library/encoding/iso2022.enc:
* tools/encoding/iso2022-jp.esc:
* tools/encoding/iso2022.esc: gave <ESC>$B precedence over <ESC>$@,
- based on comments (point 1) in [Bug #219283] (rfc 1468)
+ based on comments (point 1) in [Bug 219283] (rfc 1468)
* tests/encoding.test: added encoding-23.* tests
* generic/tclIO.c (FilterInputBytes): reset the TCL_ENCODING_START
- flags in the ChannelState when using 'gets'. [Bug #523988]
+ flags in the ChannelState when using 'gets'. [Bug 523988]
Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this
seems to improve the performance of 'gets' according to tclbench.
@@ -3525,36 +3452,35 @@
2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclNamesp.c: allow cached fully-qualified namespace
- names to be usable from different namespaces within the same
- interpreter without forcing a new lookup [Patch 458872].
+ * generic/tclNamesp.c: allow cached fully-qualified namespace names to
+ be usable from different namespaces within the same interpreter
+ without forcing a new lookup [Patch 458872].
2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: Replaced a few direct stack accesses
- with the POP_OBJECT() macro [Bug 507181] (Don Porter).
+ * generic/tclExecute.c: Replaced a few direct stack accesses with the
+ POP_OBJECT() macro [Bug 507181] (Don Porter).
2002-02-27 Don Porter <dgp@users.sourceforge.net>
* doc/GetIndex.3:
* generic/tcl.decls (Tcl_GetIndexFromObjStruct):
* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Revised the
- prototype of the Tcl_GetIndexFromObjStruct to take its struct
- table as a (CONST VOID *) argument, better describing what it is,
- maintaining source compatibility, and adding CONST correctness
- according to TIP 27. Thanks to Joe English for an elegant
- solution. [Bug 520304]
+ prototype of the Tcl_GetIndexFromObjStruct to take its struct table as
+ a (CONST VOID *) argument, better describing what it is, maintaining
+ source compatibility, and adding CONST correctness according to TIP
+ 27. Thanks to Joe English for an elegant solution. [Bug 520304]
* generic/tclDecls.h: make genstubs
* generic/tclMain.c (Tcl_Main,StdinProc): Corrected some reference
count management errors on the interactive command Tcl_Obj found by
- Purify. Thanks to Jeff Hobbs for the report and assistance.
+ Purify. Thanks to Jeff Hobbs for the report and assistance.
2002-02-27 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak
- in error case.
+ * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak in
+ error case.
* generic/tclTest.c (TestStatProc[123]): correct harmless UMRs.
@@ -3562,54 +3488,53 @@
2002-02-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tests/socket.test (2.7): Accepted and applied patch for Tcl SF
- bug #523470 provided by Don Porter <dgp@users.sourceforge.net>
- to avoid timing problems in that test.
+ * tests/socket.test (2.7): Accepted and applied patch for [Bug 523470]
+ provided by Don Porter <dgp@users.sourceforge.net> to avoid timing
+ problems in that test.
* unix/tclUnixChan.c (TclpOpenFileChannel): Added code to regonize
- "/dev/tty" (by name) and to not handle it as tty / serial
- line. This is the controlling terminal and is special. Setting
- it into raw mode as is done for other tty's is a bad idea. This
- is a hackish fix for expect SGF Bug #520624. The fix has
- limitation: Tcl_MakeFileChannel handles tty's specially too, but
- is unable to recognize /dev/tty as it only gets a file
- descriptor, and no name for it.
+ "/dev/tty" (by name) and to not handle it as tty / serial line. This
+ is the controlling terminal and is special. Setting it into raw mode
+ as is done for other tty's is a bad idea. This is a hackish fix for
+ expect [Bug 520624]. The fix has limitation: Tcl_MakeFileChannel
+ handles tty's specially too, but is unable to recognize /dev/tty as it
+ only gets a file descriptor, and no name for it.
2002-02-26 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclCmdAH.c (StoreStatData): corrected mem leak.
* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in
- remedial regsub case.
+ remedial regsub case.
* generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for
- error case to prevent mem leak.
+ error case to prevent mem leak.
* generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation.
* unix/tclUnixSock.c (Tcl_GetHostName): added an extra
- gethostbyname check to guard against failure with truncated
- names returned by uname.
+ gethostbyname check to guard against failure with truncated
+ names returned by uname.
* unix/configure:
* unix/tcl.m4 (SC_SERIAL_PORT): added sys/modem.h check and defined
- _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls.
+ _XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls.
* unix/tclUnixChan.c: added Unix implementation of TIP #35, serial
- port support. [Patch #438509] (schroedter)
+ port support. [Patch 438509] (schroedter)
2002-02-26 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclCmpCmds.c: (bugfix to the bugfix, hopefully the last)
- Bugfix to the new [for] compiling code: was setting a
- exceptArray parameter using another param which wasn't yet
- initialised, thus filling it with noise.
+ Bugfix to the new [for] compiling code: was setting a exceptArray
+ parameter using another param which wasn't yet initialised, thus
+ filling it with noise.
2002-02-25 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the
- option "-error". Essentially ignores the option, always
- returning an empty string.
+ * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the option
+ "-error". Essentially ignores the option, always returning an empty
+ string.
2002-02-25 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3620,21 +3545,21 @@
* doc/Preserve.3:
* doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
- to accurately describe when and how they are used. [Bug #497459] (dgp)
+ to accurately describe when and how they are used. [Bug 497459] (dgp)
* generic/tclHash.c (AllocArrayEntry, AllocStringEntry):
Before invoking ckalloc when creating a Tcl_HashEntry,
check that the amount of memory being allocated is
at least as large as sizeof(Tcl_HashEntry). The previous
code was allocating memory regions that were one
- or two bytes short. [Bug #521950] (dejong)
+ or two bytes short. [Bug 521950] (dejong)
2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun
reported by Joe English, and restoring tcl7.6 behaviour for
[subst]: badly terminated nested scripts will raise an error
- and not be evaluated. [Bug #495207]
+ and not be evaluated. [Bug 495207]
2002-02-25 Don Porter <dgp@users.sourceforge.net>
@@ -3646,18 +3571,17 @@
2002-02-25 Daniel Steffen <das@users.sourceforge.net>
* unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that
- have more libdl-like semantics. (bug #514392)
+ have more libdl-like semantics. [Bug 514392]
2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in
- the code for [for] and [while]. Under certain conditions, for long
- bodies, the exception range parameters were badly computed. Tests
- forthcoming: I still can't reproduce the conditions in the
- testsuite (!), although the bug (with assorted segfault or panic!)
- can be triggered from the console or with the new parse.bench in
- tclbench.
-
+ * generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in the
+ code for [for] and [while]. Under certain conditions, for long bodies,
+ the exception range parameters were badly computed. Tests forthcoming:
+ I still can't reproduce the conditions in the testsuite (!), although
+ the bug (with assorted segfault or panic!) can be triggered from the
+ console or with the new parse.bench in tclbench.
+
2002-02-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR,
@@ -3674,9 +3598,8 @@
2002-02-23 Mo DeJong <mdejong@users.sourceforge.net>
* configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32
- instead of -32 when building on IRIX64-6.* system.
- [Tcl bug 521707]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32 instead of -32 when
+ building on IRIX64-6.* system. [Bug 521707]
2002-02-22 Don Porter <dgp@users.sourceforge.net>
@@ -3688,8 +3611,8 @@
2002-02-22 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/regexpComp.test: updated regexp-11.[1-4] to match changes
- in regexp.test for new regsub syntax
+ * tests/regexpComp.test: updated regexp-11.[1-4] to match changes in
+ regexp.test for new regsub syntax
* unix/configure:
* unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64
@@ -3697,16 +3620,16 @@
* tests/safe.test: updated safe-8.5 and safe-8.7
* library/safe.tcl (CheckFileName): removed the limit on
- sourceable file names (was only *.tcl or tclIndex files with no
- more than one dot and 14 chars). There is enough internal
- protection in a safe interpreter already. Fixes [Tk Bug #521560].
+ sourceable file names (was only *.tcl or tclIndex files with no more
+ than one dot and 14 chars). There is enough internal protection in a
+ safe interpreter already. [Tk Bug 521560]
2002-02-22 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and
- [while] for constant conditions; in addition, [for] and [while]
- are now compiled with the "loop rotation" optimisation (thanks to
- Kevin Kenny).
+ * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and [while]
+ for constant conditions; in addition, [for] and [while] are now
+ compiled with the "loop rotation" optimisation (thanks to Kevin
+ Kenny).
2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3716,66 +3639,63 @@
* doc/regsub.n: Updated docs.
* tests/regexp.test: Updated and added tests.
- * compat/strtoll.c (strtoll):
- * compat/strtoull.c (strtoull):
+ * compat/strtoll.c (strtoll):
+ * compat/strtoull.c (strtoull):
* unix/tclUnixPort.h:
- * win/tclWinPort.h: Const-ing 64-bit compatability declarations.
- Note that the return pointer is non-const because it is entirely
- legal for the functions to be called from somewhere that owns the
- string being passed. Fixes problem reported by Larry Virden.
+ * win/tclWinPort.h: Const-ing 64-bit compatability declarations. Note
+ that the return pointer is non-const because it is entirely legal for
+ the functions to be called from somewhere that owns the string being
+ passed. Fixes problem reported by Larry Virden.
2002-02-21 David Gravereaux <davygrvy@pobox.com>
* win/mkd.bat (removed):
* win/coffbase.txt (new):
* win/makefile.bc:
- * win/makefile.vc: Changed the 'setup' target to stop using
- the mkd.bat file and just make the directory right in the rule.
- Same change to makefile.bc. configure.in nor Makefile.in use
- it.
+ * win/makefile.vc: Changed the 'setup' target to stop using the
+ mkd.bat file and just make the directory right in the rule. Same
+ change to makefile.bc. Neither configure.in nor Makefile.in use it.
- coffbase.txt will be the master list for our "prefered base
- addresses" set by the linker. This should improve load-time
- (NT only) by avoiding relocations. Submissions to the list
- by extension authors are encouraged.
+ coffbase.txt will be the master list for our "prefered base addresses"
+ set by the linker. This should improve load-time (NT only) by avoiding
+ relocations. Submissions to the list by extension authors are
+ encouraged.
- Added a 'tidy' target to compliment 'clean' and 'hose' to remove
- just the outputs. Also removed the $(winlibs) macro as it wasn't
- being used.
+ Added a 'tidy' target to compliment 'clean' and 'hose' to remove just
+ the outputs. Also removed the $(winlibs) macro as it wasn't being
+ used.
Stuff left to do:
- 1) get the winhelp target to stop building in the tools/
- directory.
+ 1) get the winhelp target to stop building in the tools/ directory.
2) stop using rmd.bat
3) add more dependacy rules.
- * win/tclAppInit.c: Reverted back to -r1.6, as the header file
- change to tclPort.h won't allow for easy embedded support
- outside of the source dist. Thanks to Don Porter for pointing
- this out to me.
+ * win/tclAppInit.c: Reverted back to -r1.6, as the header file change
+ to tclPort.h won't allow for easy embedded support outside of the
+ source dist. Thanks to Don Porter for pointing this out to me.
2002-02-21 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc:
* win/rules.vc: Added a new "loimpact" option that sets the
- -ws:aggressive linker option. Off by default. It's said to
- keep the heap use low at the expense of alloc speed.
+ -ws:aggressive linker option. Off by default. It's said to keep the
+ heap use low at the expense of alloc speed.
- * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to
- remove the raw windows.h include. tclPort.h brings in windows.h
- already and lessens the pre-compiled-header mush and the randomly
- useless #pragma comment (lib,...) references throughout the big
- windows.h tree (as observed at high linker warning levels).
+ * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove
+ the raw windows.h include. tclPort.h brings in windows.h already and
+ lessens the pre-compiled-header mush and the randomly useless #pragma
+ comment (lib,...) references throughout the big windows.h tree (as
+ observed at high linker warning levels).
2002-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but
- now sensitive to presence of (suitable) <limits.h>
+ * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but now
+ sensitive to presence of (suitable) <limits.h>
2002-02-20 Don Porter <dgp@users.sourceforge.net>
* generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct):
- Overlooked a few source incompatibilities. Now using CONST84.
+ Overlooked a few source incompatibilities. Now using CONST84.
* generic/tclDecls.h: make genstubs
* generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun
Workshop compiler.
@@ -3784,31 +3704,31 @@
* win/buildall.vc.bat:
* win/makefile.vc:
- * win/rules.vc: General clean-ups. Added compiler and linker tests
- for a) the pentium 0x0F errata, b) optimizing (not all have this),
- and c) linker v6 section alignment confusion. All these are tested
- first to make sure any D4002 or LNK1117 warnings aren't displayed.
- The pentium 0x0F errata is a recommended switch. The v5 linker's
- section alignment default is 512, but the v6 linker was changed
- to 4096 in an attempt to speed loading on Win98. I changed the
- default to always be 512 across both linkers, unless linking
- statically, then 4096 is used for the claimed speed effect. Using
- a 512 alignment saves 12k bytes of dead space in the DLL.
+ * win/rules.vc: General clean-ups. Added compiler and linker tests for
+ a) the pentium 0x0F errata, b) optimizing (not all have this), and c)
+ linker v6 section alignment confusion. All these are tested first to
+ make sure any D4002 or LNK1117 warnings aren't displayed. The pentium
+ 0x0F errata is a recommended switch. The v5 linker's section alignment
+ default is 512, but the v6 linker was changed to 4096 in an attempt to
+ speed loading on Win98. I changed the default to always be 512 across
+ both linkers, unless linking statically, then 4096 is used for the
+ claimed speed effect. Using a 512 alignment saves 12k bytes of dead
+ space in the DLL.
Added IA64 B-stepping errata switch when the compiler supports it.
Added profiling to $(lflags) when requested and also removed the
explict -entry option as the default works fine as is.
- Removed win/tclWinInit.c from the special case section to let it
- use the common implicit rule as the $(EXTFLAGS) macro it had was
- never referenced anywhere.
+ Removed win/tclWinInit.c from the special case section to let it use
+ the common implicit rule as the $(EXTFLAGS) macro it had was never
+ referenced anywhere.
2002-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tcl.h: Added code to guess the correct settings for
- TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't
- tell us them, as can happen with extensions.
+ TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't tell
+ us them, as can happen with extensions.
2002-02-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3842,14 +3762,14 @@
* tests/get.test:
* win/Makefile.vc: Further tweaks to the TIP 72 patch to make it
compile under VC++.
-
+
2002-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* tclExecute.c:
* tclIOGT.c:
- * tclIndexObj.c: Touchups to the TIP 72 patch to make it
- compileable under Windows again. The changes are not complete,
- there is one nasty regarding _stati64
+ * tclIndexObj.c: Touchups to the TIP 72 patch to make it compileable
+ under Windows again. The changes are not complete, there is one nasty
+ regarding _stati64
2002-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -3859,8 +3779,7 @@
There are a lot of changes from this TIP, so please see
http://purl.org/tcl/tip/72.html for discussion of
- backward-compatability issues, but the main ones modifications are
- in:
+ backward-compatability issues, but the main ones modifications are in:
* generic/tcl.h: New types.
* generic/tcl.decls: New public functions.
@@ -3876,55 +3795,53 @@
* unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced
cacheing.
- Most other changes, including all those in doc/* and test/* as
- well as the majority in the platform directories, follow on from
- these.
+ Most other changes, including all those in doc/* and test/* as well as
+ the majority in the platform directories, follow on from these.
Also coming out of the woodwork:
* generic/tclIndex.c: Better support for Cray PVP.
* win/tclWinMtherr.c: Better Borland support.
- Note that, in a number of places through the Unix part of the
- platform support, there are Tcl_Platform* references. These are
- expanded into the correct way to call that particular underlying
- function, i.e. with or without a '64' suffix, and should be used
- by people working on the core in preference to the API functions
- they overlay so that the code remains portable depending on the
- presence or absence of 64-bit support on the underlying platform.
+ Note that, in a number of places through the Unix part of the platform
+ support, there are Tcl_Platform* references. These are expanded into
+ the correct way to call that particular underlying function, i.e. with
+ or without a '64' suffix, and should be used by people working on the
+ core in preference to the API functions they overlay so that the code
+ remains portable depending on the presence or absence of 64-bit
+ support on the underlying platform.
***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP
- SUMMARY OF INCOMPATIBILITIES AND FIXES
+ SUMMARY OF INCOMPATIBILITIES AND FIXES
======================================
- The behaviour of expressions containing constants that appear
- positive but which have a negative internal representation will
- change, as these will now usually be interpreted as wide
- integers. This is always fixable by replacing the constant with
- int(constant).
+ The behaviour of expressions containing constants that appear positive
+ but which have a negative internal representation will change, as
+ these will now usually be interpreted as wide integers. This is always
+ fixable by replacing the constant with int(constant).
Extensions creating new channel types will need to be altered as
different types are now in use in those areas. The change to the
- declaration of Tcl_FSStat and Tcl_FSLstat (which are the new
- preferred API in any case) are less serious as no non-alpha
- releases have been made yet with those API functions.
+ declaration of Tcl_FSStat and Tcl_FSLstat (which are the new preferred
+ API in any case) are less serious as no non-alpha releases have been
+ made yet with those API functions.
Scripts that are lax about the use of the l modifier in format and
- scan will probably need to be rewritten. This should be very
- uncommon though as previously it had absolutely no effect.
+ scan will probably need to be rewritten. This should be very uncommon
+ though as previously it had absolutely no effect.
Extensions that create new math functions that take more than one
- argument will need to be recompiled (the size of Tcl_Value
- changes), and functions that accept arguments of any type
- (TCL_EITHER) will need to be rewritten to handle wide integer
- values. (I do not expect this to affect many extensions at all.)
+ argument will need to be recompiled (the size of Tcl_Value changes),
+ and functions that accept arguments of any type (TCL_EITHER) will need
+ to be rewritten to handle wide integer values. (I do not expect this
+ to affect many extensions at all.)
2002-02-14 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for bug
- #517503, a memory leak reported by Miguel Sofer
- <msofer@users.sourceforge.net>. The leak happens if an error
- occurs for "set var [gets $chan]" and leak one empty object.
+ * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for [Bug 517503], a
+ memory leak reported by Miguel Sofer <msofer@users.sf.net>. The leak
+ happens if an error occurs for "set var [gets $chan]" and leak one
+ empty object.
2002-02-12 David Gravereaux <davygrvy@pobox.com>
@@ -3935,12 +3852,11 @@
* unix/tclUnixFCmd.c:
* unix/tclUnixFile.c:
* unix/tclUnixInit.c:
- * unix/tclUnixPort.h: Early stage of DJGPP support for building
- Tcl on DOS. Dynamic loading isn't working, yet. Requires watt32
- for the TCP/IP stack. No autoconf, yet. Barely tested, but
- makes a working exe that runs Tcl in protected-mode, flat memory.
- [exec] and pipes will need the most work as multi-tasking on DOS
- has to be carefully.
+ * unix/tclUnixPort.h: Early stage of DJGPP support for building Tcl
+ on DOS. Dynamic loading isn't working, yet. Requires watt32 for the
+ TCP/IP stack. No autoconf, yet. Barely tested, but makes a working exe
+ that runs Tcl in protected-mode, flat memory. [exec] and pipes will
+ need the most work as multi-tasking on DOS has to be carefully.
2002-02-10 Kevin Kenny <kennykb@acm.org>
@@ -3957,20 +3873,20 @@
* generic/tclDecls.h:
* generic/tclStubInit.c: Regenerated Stubs tables.
-
+
2002-02-08 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure:
* unix/tcl.m4: added -pthread for FreeBSD to EXTRA_CFLAGS and
- LDFLAGS. Also triggered nodots only for FreeBSD-3.
- Added AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris.
+ LDFLAGS. Also triggered nodots only for FreeBSD-3. Added
+ AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris.
* unix/tclUnixPort.h:
* unix/tclUnixThrd.c: added thread-safe versions of readdir,
localtime, gmtime and inet_ntoa for threaded build. (jgdavidson)
- * generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being
- called on a pointer to NULL.
+ * generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being called on
+ a pointer to NULL.
2002-02-07 Don Porter <dgp@users.sourceforge.net>
@@ -3995,15 +3911,14 @@
* win/tclWin32Dll.c:
* win/tclWinFCmd.c:
* win/tclWinFile.c:
- * win/tclWinInit.c: Partial TIP 27 rollback. Following routines
+ * win/tclWinInit.c: Partial TIP 27 rollback. Following routines
restored to return (char *): Tcl_DStringAppend,
Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName,
Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString,
- Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also
- restored Tcl_WinUtfToTChar to return (TCHAR *) and
- Tcl_UtfToUniCharDString to return (Tcl_UniChar *). Modified
- some callers. This change recognizes that Tcl_DStrings are
- de-facto white-box objects.
+ Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also restored
+ Tcl_WinUtfToTChar to return (TCHAR *) and Tcl_UtfToUniCharDString to
+ return (Tcl_UniChar *). Modified some callers. This change recognizes
+ that Tcl_DStrings are de-facto white-box objects.
* generic/tclDecls.h:
* generic/tclPlatDecls.h: make genstubs
@@ -4013,17 +3928,17 @@
2002-02-06 Jeff Hobbs <jeffh@ActiveState.com>
* tests/scan.test:
- * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x
- handling that didn't accept the 0x as a prelude to a base 16
- number. [Bug #495213]
+ * generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x handling
+ that didn't accept the 0x as a prelude to a base 16 number. [Bug
+ 495213]
- * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check
- for bad RE to stop checking further.
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check for
+ bad RE to stop checking further.
- * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to
- search for simple 'string map' style regsub calls.
- Delayed creation of resultPtr object until an initial match is
- made, as the input string object can then be reused for no matches.
+ * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to search
+ for simple 'string map' style regsub calls. Delayed creation of
+ resultPtr object until an initial match is made, as the input string
+ object can then be reused for no matches.
(Tcl_StringObjCmd): optimization improvements to the STR_MAP
algorithm for zero-length and nocase cases.
@@ -4038,20 +3953,19 @@
* library/http/http.tcl:
* library/http/pkgIndex.tcl: Corrected use of http::error when
- ::error was intended. Bump to http 2.4.2.
+ ::error was intended. Bump to http 2.4.2.
2002-02-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported
- by Dale Talcott <daletalcott@users.sourceforge.net>. Avoid
- writing nothing into a file as STREAM based implementations will
- consider this a EOF (if the file is a pipe). Not done in the
- generic layer as this type of writing is actually useful to
- check the state of a socket.
+ * unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported by
+ Dale Talcott <daletalcott@users.sourceforge.net>. Avoid writing
+ nothing into a file as STREAM based implementations will consider this
+ a EOF (if the file is a pipe). Not done in the generic layer as this
+ type of writing is actually useful to check the state of a socket.
- * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid'
- as the command to use to retrieve the pid of a command pipeline
- created via 'open'.
+ * doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid' as
+ the command to use to retrieve the pid of a command pipeline created
+ via 'open'.
2002-02-01 Jeff Hobbs <jeffh@ActiveState.com>
@@ -4061,37 +3975,36 @@
2002-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* tests/io.test: io-39.22 split into two tests, one platform
- dependent, the other not. -eofchar is not empty on the windows
- platform.
+ dependent, the other not. -eofchar is not empty on the windows
+ platform.
2002-02-01 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclTest.c: fix to picky windows compiler problem
- with the 'MainLoop' function declaration.
+ * generic/tclTest.c: fix to picky windows compiler problem with the
+ 'MainLoop' function declaration.
2002-01-31 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on
- behalf of Don Porter <dgp@users.sourceforge.net>.
+ behalf of Don Porter <dgp@users.sourceforge.net>.
2002-01-30 Don Porter <dgp@users.sourceforge.net>
* generic/tcl.decls:
* generic/tcl.h:
* generic/tclInt.h: For each interface identified in the TIP 27
- changes below as a POTENTIAL INCOMPATIBILITY, the source of the
- incompatibility has been parameterized so that it can be
- removed. When compiling extension code against the Tcl header
- files, use the compiler flag -DUSE_NON_CONST to remove the
- irresolvable source incompatibilities introduced by the TIP 27
- changes. Resolvable changes are left for extension authors to
- resolve.
+ changes below as a POTENTIAL INCOMPATIBILITY, the source of the
+ incompatibility has been parameterized so that it can be removed. When
+ compiling extension code against the Tcl header files, use the
+ compiler flag -DUSE_NON_CONST to remove the irresolvable source
+ incompatibilities introduced by the TIP 27 changes. Resolvable changes
+ are left for extension authors to resolve.
* generic/tclDecls.h: make genstubs
2002-01-30 Vince Darley <vincentdarley@users.sourceforge.net>
- * doc/FileSystem.3: added documentation for 3 public
- functions which had been overlooked. Fixes [Bug 507701].
+ * doc/FileSystem.3: added documentation for 3 public functions which
+ had been overlooked. [Bug 507701]
* unix/mkLinks: make mklinks
2002-01-29 Jeff Hobbs <jeffh@ActiveState.com>
@@ -4103,14 +4016,12 @@
2002-01-28 Mo DeJong <mdejong@users.sourceforge.net>
* unix/tcl.m4 (SC_LOAD_TCLCONFIG):
- * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC,
- TCL_STUB_LIB_SPEC, and TCL_STUB_LIB_PATH to the
- values of TCL_BUILD_LIB_SPEC, TCL_BUILD_STUB_LIB_SPEC,
- and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh is loaded
- from the build directory. A Tcl extension should
- make use of the non-build versions of these variables
- since they will work in both cases. This modification
- was described in TIP 34.
+ * win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC, TCL_STUB_LIB_SPEC,
+ and TCL_STUB_LIB_PATH to the values of TCL_BUILD_LIB_SPEC,
+ TCL_BUILD_STUB_LIB_SPEC, and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh
+ is loaded from the build directory. A Tcl extension should make use of
+ the non-build versions of these variables since they will work in both
+ cases. This modification was described in TIP 34.
2002-01-28 Jeff Hobbs <jeffh@ActiveState.com>
@@ -4125,8 +4036,8 @@
TCL_OUT_LINE_COMPILE instead of TCL_ERROR for parsing errors, so
it only throws the error for runtime compile, in case the user
modifies 'string'.
- (TclCompileRegexpCmd): first try at a byte-compiled regexp
- command. It handles static strings and ^$ bounded static strings.
+ (TclCompileRegexpCmd): first try at a byte-compiled regexp command. It
+ handles static strings and ^$ bounded static strings.
(TclCompileAppendCmd): made TclPushVarName call always use
TCL_CREATE_VAR as numWords is always > 2 at that point.
@@ -4140,7 +4051,7 @@
* ChangeLog.2000 (new file):
* ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce
- size of the main ChangeLog.
+ size of the main ChangeLog.
2002-01-28 David Gravereaux <davygrvy@pobox.com>
@@ -4171,19 +4082,18 @@
2002-01-25 Mo DeJong <mdejong@users.sourceforge.net>
- Make -eofchar and -translation options read only for
- server sockets. [Bug 496733]
-
+ Make -eofchar and -translation options read only for server sockets.
+ [Bug 496733]
+
* generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption):
- Instead of returning nothing for the -translation option
- on a server socket, always return "auto". Return the empty
- string enclosed in quotes for the -eofchar option on
- a server socket. Fixup -eofchar usage message so that
- it matches the implementation.
- * tests/io.test: Add -eofchar tests and -translation tests
- to ensure options are read only on server sockets.
- * tests/socket.test: Update tests to account for -eofchar
- and -translation option changes.
+ Instead of returning nothing for the -translation option on a server
+ socket, always return "auto". Return the empty string enclosed in
+ quotes for the -eofchar option on a server socket. Fixup -eofchar
+ usage message so that it matches the implementation.
+ * tests/io.test: Add -eofchar tests and -translation tests to ensure
+ options are read only on server sockets.
+ * tests/socket.test: Update tests to account for -eofchar and
+ -translation option changes.
2002-01-25 Don Porter <dgp@users.sourceforge.net>
@@ -4198,20 +4108,20 @@
* generic/tclUtf.c (Tcl_UtfPrev):
* mac/tclMacFCmd.c (TclpObjListVolumes):
* mac/tclMacResource.c (TclMacRegisterResourceFork,
- BuildResourceForkList):
+ (BuildResourceForkList):
* win/tclWinInit.c (AppendEnvironment): Sought out and eliminated
instances of CONST-casting that are no longer needed after the
TIP 27 effort.
* Following is [Patch 501006]
* generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export,
- Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport,
- Tcl_Import, Tcl_RemoveInterpResolvers):
+ (Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport,
+ (Tcl_Import, Tcl_RemoveInterpResolvers):
* generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport,
- Tcl_FindNamespace):
+ (Tcl_FindNamespace):
* generic/tclResolve.c (Tcl_AddInterpResolvers,Tcl_GetInterpResolvers,
- Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c
- and generic/tclNamesp.c according to the guidelines of TIP 27.
+ (Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c and
+ generic/tclNamesp.c according to the guidelines of TIP 27.
* generic/tclIntDecls.h: make genstubs
* Following is [Patch 505630]
@@ -4245,11 +4155,11 @@
* generic/tclIOUtil.c (TclpNativeToNormalized):
* win/tclWinFCmd.c (TclpObjNormalizePath):
* win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory,
- NativeIsExec,NativeStat):
+ (NativeIsExec,NativeStat):
* win/tclWinLoad.c (TclpLoadFile):
* win/tclWinPipe.c (TclpOpenFile,ApplicationType):
* win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey,
- GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
+ (GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
* win/tclWinSerial.c (SerialSetOptionProc): Update callers.
* Following is [Patch 505072]
@@ -4266,23 +4176,23 @@
* generic/tcl.h (Tcl_FSMatchInDirectoryProc):
* generic/tclInt.h (TclpMatchInDirectory):
* generic/tcl.decls (Tcl_Concat,Tcl_GetStringResult,Tcl_GetVar,
- Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar,
- Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName,
- Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString,
- Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir,
- Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource):
+ (Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar,
+ (Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName,
+ (Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString,
+ (Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir,
+ (Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource):
* generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd,
- TclpCreateProcess):
+ (TclpCreateProcess):
* mac/tclMacFile.c (TclpGetCwd):
* generic/tclEncoding.c (Tcl_GetDefaultEncodingDir,
- Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName,
- Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile,
- LoadEscapeEncoding):
+ (Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName,
+ (Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile,
+ (LoadEscapeEncoding):
* generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath,
- Tcl_TranslateFileName):
+ (Tcl_TranslateFileName):
* generic/tclIOUtil.c (Tcl_FSMatchInDirectory):
* generic/tclPipe.c (FileForRedirect,TclCreatePipeline,
- Tcl_OpenCommandChannel):
+ (Tcl_OpenCommandChannel):
* generic/tclResult.c (Tcl_GetStringResult):
* generic/tclUtil.c (Tcl_Concat,Tcl_SplitList,Tcl_Merge):
* generic/tclVar.c (Tcl_GetVar,Tcl_GetVar2,Tcl_SetVar,Tcl_SetVar2):
@@ -4290,25 +4200,25 @@
Updated interfaces of generic/tclEncoding, generic/tclFilename.c,
generic/tclIOUtil.c, generic/tclPipe.c, generic/tclResult.c,
generic/tclUtil.c, generic/tclVar.c and mac/tclMacResource.c according
- to TIP 27. Tcl_TranslateFileName rewritten as wrapper around
- VFS-aware version.
- ***POTENTIAL INCOMPATIBILITY***
+ to TIP 27. Tcl_TranslateFileName rewritten as wrapper around VFS-aware
+ version.
+ ***POTENTIAL INCOMPATIBILITY***
Includes source incompatibilities: argv arguments of Tcl_Concat,
Tcl_JoinPath, Tcl_OpenCommandChannel, Tcl_Merge; argvPtr arguments of
Tcl_SplitList and Tcl_SplitPath.
- * generic/tclDecls.h:
+ * generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
* generic/tclCkalloc.c (MemoryCmd):
* generic/tclClock.c (FormatClock):
* generic/tclCmdAH.c (Tcl_CaseObjCmd,Tcl_EncodingObjCmd,Tcl_FileObjCmd):
* generic/tclCmdIL.c (InfoLibraryCmd,InfoPatchLevelCmd,
- InfoTclVersionCmd):
+ (InfoTclVersionCmd):
* generic/tclCompCmds.c (TclCompileForeachCmd):
* generic/tclCompCmds.h (TclCompileForeachCmd):
* generic/tclCompile.c (TclFindCompiledLocal):
* generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv,
- EnvTraceProc):
+ (EnvTraceProc):
* generic/tclEvent.c (Tcl_BackgroundError):
* generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption):
* generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd):
@@ -4319,9 +4229,9 @@
* generic/tclNamesp.c (TclTeardownNamespace):
* generic/tclProc.c (TclCreateProc):
* generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd,
- TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1,
- TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc,
- TestpanicCmd):
+ (TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1,
+ (TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc,
+ (TestpanicCmd):
* generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc):
* generic/tclUtil.c (TclPrecTraceProc):
* mac/tclMacFCmd.c (GetFileSpecs):
@@ -4331,93 +4241,91 @@
* mac/tclMacResource.c (Tcl_MacEvalResource):
* unix/tclUnixFCmd.c (TclpObjNormalizePath):
* unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd,
- TclpReadLink):
+ (TclpReadLink):
* unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables,
- Tcl_SourceRCFile):
+ (Tcl_SourceRCFile):
* unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile,
- TclpCreateProcess):
+ (TclpCreateProcess):
* win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory):
* win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile,
- TclpSetVariables):
+ (TclpSetVariables):
* win/tclWinPipe.c (TclpCreateProcess): Updated callers.
2002-01-24 Don Porter <dgp@users.sourceforge.net>
* generic/tclIOUtil.c (SetFsPathFromAny): Corrected tilde-substitution
- of pathnames where > 1 separator follows the ~. [Bug 504950]
+ of pathnames where > 1 separator follows the ~. [Bug 504950]
2002-01-24 Jeff Hobbs <jeffh@ActiveState.com>
* library/http/pkgIndex.tcl:
* library/http/http.tcl: don't add port in default case to handle
- broken servers. http bumped to 2.4.1 [Bug #504508]
+ broken servers. http bumped to 2.4.1 [Bug 504508]
2002-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net>
* unix/mkLinks: Regenerated.
* doc/CrtChannel.3:
- * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel'
- from 'CrtChannel' to 'ChnlStack'. Added documentation of
- 'Tcl_GetStackedChannel'. Bug #506147 reported by Mark Patton
- <msp@users.sourceforge.net>.
+ * doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel' from
+ 'CrtChannel' to 'ChnlStack'. Added documentation of
+ 'Tcl_GetStackedChannel'. [Bug 506147] reported by Mark Patton
+ <msp@users.sourceforge.net>.
2002-01-23 Don Porter <dgp@users.sourceforge.net>
* win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec,
- TclpGetUserHome):
+ (TclpGetUserHome):
* win/tclWinPort.h (TclWinSerialReopen):
* win/tclWinSerial.c (TclWinSerialReopen):
- * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier
- TIP 27 changes. Thanks to Andreas Kupries for the feedback.
+ * win/tclWinSock.c (Tcl_OpenTcpServer): Corrections to earlier TIP 27
+ changes. Thanks to Andreas Kupries for the feedback.
* generic/tclPlatDecls.h: make genstubs
* doc/GetHostName.3:
* doc/GetOpnFl.3:
* doc/OpenTcp.3:
* tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient,
- Tcl_OpenTclServer):
+ (Tcl_OpenTclServer):
* mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer,
- Tcl_GetHostName,GetHostFromString):
+ (Tcl_GetHostName,GetHostFromString):
* unix/tclUnixChan.c (CreateSocket,CreateSocketAddress,
- Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile):
+ (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile):
* unix/tclUnixSock.c (Tcl_GetHostName):
* win/tclWinSock.c (CreateSocket,CreateSocketAddress,
- Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName):
+ (Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName):
Updated socket interfaces according to TIP 27.
* generic/tclCmdIL.c (InfoHostnameCmd): Updated callers.
* generic/tclDecls.h: make genstubs
2002-01-21 David Gravereaux <davygrvy@pobox.com>
- * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of
- typedef Tcl_FSLoadFileProc. OK'd by vincentdarley.
- [Patch #502488]
+ * generic/tclLoadNone.c: TclpLoadFile() didn't match proto of typedef
+ Tcl_FSLoadFileProc. OK'd by vincentdarley. [Patch 502488]
2002-01-21 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIO.c (WriteChars): Fix for SF #506297, reported by
- Martin Forssen <ruric@users.sourceforge.net>. The encoding
- chosen in the script exposing the bug writes out three intro
- characters when TCL_ENCODING_START is set, but does not consume
- any input as TCL_ENCODING_END is cleared. As some output was
- generated the enclosing loop calls UtfToExternal again, again
- with START set. Three more characters in the out and still no
- use of input ... To break this infinite loop we remove
- TCL_ENCODING_START from the set of flags after the first call
- (no condition is required, the later calls remove an unset flag,
- which is a no-op). This causes the subsequent calls to
- UtfToExternal to consume and convert the actual input.
+ * generic/tclIO.c (WriteChars): Fix for [Bug 506297], reported by
+ Martin Forssen <ruric@users.sourceforge.net>. The encoding chosen in
+ the script exposing the bug writes out three intro characters when
+ TCL_ENCODING_START is set, but does not consume any input as
+ TCL_ENCODING_END is cleared. As some output was generated the
+ enclosing loop calls UtfToExternal again, again with START set. Three
+ more characters in the out and still no use of input ... To break this
+ infinite loop we remove TCL_ENCODING_START from the set of flags after
+ the first call (no condition is required, the later calls remove an
+ unset flag, which is a no-op). This causes the subsequent calls to
+ UtfToExternal to consume and convert the actual input.
2002-01-21 Don Porter <dgp@users.sourceforge.net>
* generic/tclTest.c: Converted declarations of TestReport file system
- to more portable form. [Bug 501417].
+ to more portable form. [Bug 501417]
* generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand,
- Tcl_CommandTraceInfo):
+ (Tcl_CommandTraceInfo):
* generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand,
- Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c
- according to the guidelines of TIP 27.
+ (Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c according
+ to the guidelines of TIP 27.
* generic/tclDecls.h: make genstubs
2002-01-18 Don Porter <dgp@users.sourceforge.net>
@@ -4436,32 +4344,30 @@
* mac/tclMacFCmd.c:
* mac/tclMacFile.c:
* mac/tclMacLoad.c:
- * mac/tclMacResource.c: TIP 27 CONSTification broke the mac
- build in a number of places.
+ * mac/tclMacResource.c: TIP 27 CONSTification broke the mac build in a
+ number of places.
2002-01-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed bug #504642 as
- reported by Brian Griffin <bgriffin@users.sourceforge.net>,
- using his patch. Before the patch the generic I/O layer held an
- unannounced reference to the interp result to store the read
- line into. This unfortunately has disastrous results if the
- channel driver executes a tcl script to perform its operation,
- this freeing the interp result. In that case we are
- dereferencing essentially a dangling reference. It is not truly
- dangling because the object is in the free list, but this only
- causes us to smash the free list and have the error occur later
- somewhere else. The patch simply creates a new object for the
- line and later sets it into the interp result when we are done
- with reading.
+ * generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed [Bug 504642] as reported
+ by Brian Griffin <bgriffin@users.sourceforge.net>, using his
+ patch. Before the patch the generic I/O layer held an unannounced
+ reference to the interp result to store the read line into. This
+ unfortunately has disastrous results if the channel driver executes a
+ tcl script to perform its operation, this freeing the interp
+ result. In that case we are dereferencing essentially a dangling
+ reference. It is not truly dangling because the object is in the free
+ list, but this only causes us to smash the free list and have the
+ error occur later somewhere else. The patch simply creates a new
+ object for the line and later sets it into the interp result when we
+ are done with reading.
2002-01-16 Mo DeJong <mdejong@users.sourceforge.net>
* unix/tcl.m4 (SC_LOAD_TCLCONFIG):
- * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX
- into TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG
- variables so that an extension does not need
- to subst TCL_DBGX into its makefile. [Tk Bug 504356]
+ * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX into
+ TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG variables so that an extension
+ does not need to subst TCL_DBGX into its makefile. [Tk Bug 504356]
2002-01-16 Don Porter <dgp@users.sourceforge.net>
@@ -4469,19 +4375,20 @@
* doc/GetCwd.3:
* doc/GetIndex.3:
* generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath,
- Tcl_FSGetTranslatedStringPath):
+ (Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath,
+ (Tcl_FSGetTranslatedStringPath):
* generic/tcl.h (Tcl_FSFileAttrStringsProc):
* generic/tclFCmd.c (TclFileAttrsCmd):
* generic/tclIOUtil.c (Tcl_GetCwd,NativeFileAttrStrings,
- Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath,
- Tcl_FSGetNativePath):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct):
+ (Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath,
+ (Tcl_FSGetNativePath):
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObj,
+ (Tcl_GetIndexFromObjStruct):
More TIP 27 updates in tclIOUtil.c and tclIndexObj.c that were
- overlooked before. [Patch 504671]
- ***POTENTIAL INCOMPATIBILITY***
- Includes a source incompatibility in the tablePtr arguments of
- the Tcl_GetIndexFromObj* routines.
+ overlooked before. [Patch 504671]
+ ***POTENTIAL INCOMPATIBILITY***
+ Includes a source incompatibility in the tablePtr arguments of the
+ Tcl_GetIndexFromObj* routines.
* generic/tclDecls.h: make genstubs
* generic/tclBinary.c (Tcl_BinaryObjCmd):
@@ -4489,20 +4396,20 @@
* generic/tclCmdAH.c (Tcl_EncodingObjCmd, Tcl_FileObjCmd):
* generic/tclCmdIL.c (Tcl_InfoObjCmd,Tcl_LsearchObjCmd,Tcl_LsortObjCmd):
* generic/tclCmdMZ.c (Tcl_TraceObjCmd,Tcl_RegexpObjCmd,Tcl_RegsubObjCmd,
- Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd,
- TclTraceCommandObjCmd,TclTraceVariableObjCmd):
+ (Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd,
+ (TclTraceCommandObjCmd,TclTraceVariableObjCmd):
* generic/tclCompCmds.c (TclCompileStringCmd):
* generic/tclEvent.c (Tcl_UpdateObjCmd):
* generic/tclFileName.c (Tcl_GlobObjCmd):
* generic/tclIO.c (Tcl_FileEventObjCmd):
* generic/tclIOCmd.c (Tcl_SeekObjCmd,Tcl_ExecObjCmd,Tcl_SocketObjCmd,
- Tcl_FcopyObjCmd):
+ (Tcl_FcopyObjCmd):
* generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd):
* generic/tclNamesp.c (Tcl_NamespaceObjCmd):
* generic/tclPkg.c (Tcl_PackageObjCmd):
* generic/tclTest.c (Tcltest_Init,TestencodingObjCmd,TestgetplatformCmd,
- TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd,
- TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings):
+ (TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd,
+ (TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings):
* generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd):
* generic/tclTimer.c (Tcl_AfterObjCmd):
* generic/tclVar.c (Tcl_ArrayObjCmd):
@@ -4510,7 +4417,7 @@
* unix/tclUnixChan.c (TclpOpenFileChannel):
* unix/tclUnixFCmd.c (tclpFileAttrStrings):
* unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat,
- TclpObjLstat):
+ (TclpObjLstat):
* win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers.
* doc/RegExp.3:
@@ -4529,15 +4436,15 @@
* mac/tclMacLoad.c (TclpLoadFile):
* win/tclWinFile.c (TclpGetUserHome): Updated callers.
- * generic/tclDecls.h:
+ * generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
* doc/ParseCmd.3 (Tcl_ParseVar):
* generic/tcl.decls (Tcl_ParseVar):
* generic/tclParse.c (Tcl_ParseVar):
* generic/tclTest.c (TestparsevarObjCmd): Updated APIs in
- generic/tclParse.c according to the guidelines of TIP 27. Updated
- callers. [Patch 501046]
+ generic/tclParse.c according to the guidelines of TIP 27. Updated
+ callers. [Patch 501046]
* generic/tclDecls.h: make genstubs
* generic/tcl.decls (Tcl_RecordAndEval):
@@ -4548,22 +4455,22 @@
* doc/CrtSlave.3:
* generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj,
- Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
+ (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
* generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj,
- Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
+ (Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
Updated APIs in the file generic/tclInterp.c according to the
- guidelines of TIP 27. [Patch 501371]
- ***POTENTIAL INCOMPATIBILITY***
- Includes a source incompatibility in the targetCmdPtr arguments of
- the Tcl_GetAlias* routines.
+ guidelines of TIP 27. [Patch 501371]
+ ***POTENTIAL INCOMPATIBILITY***
+ Includes a source incompatibility in the targetCmdPtr arguments of the
+ Tcl_GetAlias* routines.
* generic/tclDecls.h: make genstubs
2002-01-15 Don Porter <dgp@users.sourceforge.net>
* doc/SetErrno.3 (Tcl_ErrnoMsg): Corrected documentation for
- Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios
- Petasis. [Bug 468183]
+ Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios
+ Petasis. [Bug 468183]
* doc/AddErrInfo.3 (Tcl_PosixError):
* doc/Eval.3 (Tcl_EvalFile):
@@ -4572,26 +4479,26 @@
* doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg):
* doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg):
* generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile,
- Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg,
- Tcl_FSOpenFileChannel):
+ (Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg,
+ (Tcl_FSOpenFileChannel):
* generic/tcl.h (Tcl_FSOpenFileChannelProc):
* generic/tclIO.c (FlushChannel):
* generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode,
- Tcl_PosixError,Tcl_FSOpenFileChannel):
+ (Tcl_PosixError,Tcl_FSOpenFileChannel):
* generic/tclInt.decls (TclGetOpenMode):
* generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode,
- TclpOpenFileChannel):
+ (TclpOpenFileChannel):
* generic/tclPipe.c (TclCleanupChildren):
* generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId,
- Tcl_SignalMsg):
+ (Tcl_SignalMsg):
* generic.tclTest.c (PretendTclpOpenFileChannel,
- TestOpenFileChannelProc1,TestOpenFileChannelProc2,
- TestOpenFileChannelProc3,TestReportOpenFileChannel):
+ (TestOpenFileChannelProc1,TestOpenFileChannelProc2,
+ (TestOpenFileChannelProc3,TestReportOpenFileChannel):
* mac/tclMacChan.c (TclpOpenFileChannel):
* unix/tclUnixChan.c (TclpOpenFileChannel):
* win/tclWinChan.c (TclpOpenFileChannel): Updated APIs in
- generic/tclIOUtil.c and generic/tclPosixStr.c according to the
- guidelines of TIP 27. Updated callers. [Patch 499196]
+ generic/tclIOUtil.c and generic/tclPosixStr.c according to the
+ guidelines of TIP 27. Updated callers. [Patch 499196]
* generic/tclDecls.h:
* generic/tclIntDecls.h: make genstubs
@@ -4601,30 +4508,30 @@
* generic/tcl.decls:
* generic/tclIO.h:
* generic/tclIO.c (DoWrite, Tcl_RegisterChannel, Tcl_GetChannel,
- Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write,
- Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption,
- Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName):
+ (Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write,
+ (Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption,
+ (Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName):
Updated APIs in the file generic/tclIO.c according to the guidelines
- of TIP 27. Several minor documentation corrections as well.
+ of TIP 27. Several minor documentation corrections as well.
[Patch 503565]
* generic/tclDecls.h: make genstubs
* generic/tcl.h (Tcl_DriverOutputProc, Tcl_DriverGetOptionProc,
- Tcl_DriverSetOptionProc):
+ (Tcl_DriverSetOptionProc):
* generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc,
- TransformSetOptionProc):
+ (TransformSetOptionProc):
* mac/tclMacChan.c (FileOutput, StdIOOutput):
* man/tclMacSock.c (TcpGetOptionProc, TcpOutput):
* unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc,
- TtyGetOptionProc, TtySetOptionProc):
+ (TtyGetOptionProc, TtySetOptionProc):
* unix/tclUnixPipe.c (PipeOuputProc):
* win/tclWinChan.c (FileOutputProc):
* win/tclWinConsole.c (ConsleOutputProc):
* win/tclWinPipe.c (PipeOuputProc):
* win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc,
- SerialSetOptionProc):
+ (SerialSetOptionProc):
* win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel
- driver interface according to the guidelines of TIP 27. See also
+ driver interface according to the guidelines of TIP 27. See also
[Bug 500348].
* doc/CrtChannel.3:
@@ -4634,7 +4541,7 @@
* generic/tclInt.h:
* tools/checkLibraryDoc.tcl:
Moved Tcl_EolTranslation enum declaration from generic/tcl.h to
- generic/tclInt.h (renamed to TclEolTranslation). It is not used
+ generic/tclInt.h (renamed to TclEolTranslation). It is not used
anywhere in Tcl's public interface.
2002-01-14 Don Porter <dgp@users.sourceforge.net>
@@ -4642,10 +4549,10 @@
* doc/GetIndex.3:
* doc/WrongNumArgs.3:
* generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_WrongNumArgs):
- * generic/tclIndexObj.c (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
- Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c
- according to the guidelines of TIP 27. [Patch 501491]
+ (Tcl_WrongNumArgs):
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct,
+ (Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c
+ according to the guidelines of TIP 27. [Patch 501491]
* generic/tclDecls.h: make genstubs
2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
@@ -4656,36 +4563,35 @@
* win/configure.in: Use ${libdir} instead of ${exec_prefix}/lib
to properly support the --libdir option to configure. [Bug 489370]
-2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for SF
- bug #500348 supplied by Rolf Schroedter
- <schroedter@users.sourceforge.net>. The function modified the
- contents of the the 'value' string and now does not do this
- anymore. This is a followup to the change made on 2001-12-17.
+ * win/tclWinSerial.c (SerialSetOptionProc): Applied patch for [Bug
+ 500348] supplied by Rolf Schroedter <schroedter@users.sf.net>. The
+ function modified the contents of the the 'value' string and now does
+ not do this anymore. This is a followup to the change made on
+ 2001-12-17.
2002-01-11 David Gravereaux <davygrvy@pobox.com>
- * win/makefile.vc: Removed -GD compiler option. It was intended
- for future use, but MS is again changing the future at their whim.
- The D4002 warning was harmless though, but someone using VC .NET
- logged it as a concern. [Bug #501565]
+ * win/makefile.vc: Removed -GD compiler option. It was intended for
+ future use, but MS is again changing the future at their whim. The
+ D4002 warning was harmless though, but someone using VC .NET logged it
+ as a concern. [Bug 501565]
2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Burn Tcl build directory
- into tcltest executable to avoid crashes caused
- by ld loading a previously installed version
+ * unix/Makefile.in: Burn Tcl build directory into tcltest executable
+ to avoid crashes caused by ld loading a previously installed version
of the tcl shared library. [Bug 218110]
2002-01-10 Don Porter <dgp@users.sourceforge.net>,
Kevin Kenny <kennykb@users.sourceforge.net>
-
- * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced
- parens. Kevin notes that it's far from clear that this file is
- ever included in an actual build; Linux without dlopen appears to
- be a nonexistent configuration.
-
+
+ * unix/tclLoadDld.c (TclpLoadFile): syntax error: unbalanced parens.
+ Kevin notes that it's far from clear that this file is ever included
+ in an actual build; Linux without dlopen appears to be a nonexistent
+ configuration.
+
2002-01-08 Don Porter <dgp@users.sourceforge.net>,
Kevin Kenny <kennykb@users.sourceforge.net>
@@ -4704,26 +4610,25 @@
* unix/tclLoadNext.c (TclGuessPackageName):
* unix/tclLoadOSF.c (TclGuessPackageName):
* unix/tclLoadShl.c (TclGuessPackageName):
- * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in
- the files */tcl*Load*.c according to the guidelines of TIP 27.
- [Patch 501096]
+ * win/tclWinLoad.c (TclGuessPackageName): Updated APIs in the files
+ */tcl*Load*.c according to the guidelines of TIP 27. [Patch 501096]
2002-01-09 Don Porter <dgp@users.sourceforge.net>
* generic/tclTest.c (MainLoop):
* tests/main.test (Tcl_Main-1.{3,4,5,6}): Corrected some non-portable
- tests from the new Tcl_Main changes. Thanks to Kevin Kenny.
+ tests from the new Tcl_Main changes. Thanks to Kevin Kenny.
2002-01-07 Don Porter <dgp@users.sourceforge.net>
* generic/tclEvent.c (TclInExit):
* generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized,
- SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep):
+ (SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep):
* generic/tclListObj.c (TclLsetList,TclLsetFlat): Added some type
casts to satisfy picky compilers.
* generic/tclMain.c: Bug fix: neglected the NULL case in
- TclGetStartupScriptFileName(). Broke Tk/wish.
+ TclGetStartupScriptFileName(). Broke Tk/wish.
2002-01-05 Don Porter <dgp@users.sourceforge.net>
@@ -4731,44 +4636,44 @@
* generic/tclMain.c: Substantial rewrite and expanded documentation
of Tcl_Main to correct a number of bugs and flaws:
- * Interactive Tcl_Main can now enter a main loop, exit
- that loop and continue interactive operations. The loop
- may even exit in the midst of interactive command typing
- without loss of the partial command. [Bugs 486453, 474131]
- * Tcl_Main now gracefully handles deletion of its master
- interpreter.
- * Interactive Tcl_Main can now operate with non-blocking stdin
- * Interactive Tcl_Main can now detect EOF on stdin even in
- mid-command. [Bug 491341]
- * Added VFS-aware internal routines for managing the
- startup script selection.
- * Tcl variable 'tcl_interactive' is now linked to C variable
- 'tty' so that one can disable/enable interactive prompts
- at the script level when there is no startup script. This
- is meant for use by the test suite.
- * Consistent use of the Tcl libraries standard channels as
- returned by Tcl_GetStdChannel(); as opposed to the channels
- named 'stdin', 'stdout', and 'stderr' in the master interp,
- which can be different or unavailable.
- * Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
- master interpreter returns, assuring Tcl_Main does not return.
- * Documented Tcl_Main's absence from public stub table
- * Documented that Tcl_Main does not return.
- * Documented Tcl variables set by Tcl_Main.
- * All prompts are done from a single procedure, Prompt.
- * Use of Tcl_Obj-enabled interfaces everywhere.
+ - Interactive Tcl_Main can now enter a main loop, exit that loop and
+ continue interactive operations. The loop may even exit in the
+ midst of interactive command typing without loss of the partial
+ command. [Bugs 486453, 474131]
+ - Tcl_Main now gracefully handles deletion of its master
+ interpreter.
+ - Interactive Tcl_Main can now operate with non-blocking stdin
+ - Interactive Tcl_Main can now detect EOF on stdin even in
+ mid-command. [Bug 491341]
+ - Added VFS-aware internal routines for managing the startup script
+ selection.
+ - Tcl variable 'tcl_interactive' is now linked to C variable 'tty'
+ so that one can disable/enable interactive prompts at the script
+ level when there is no startup script. This is meant for use by
+ the test suite.
+ - Consistent use of the Tcl libraries standard channels as returned
+ by Tcl_GetStdChannel(); as opposed to the channels named 'stdin',
+ 'stdout', and 'stderr' in the master interp, which can be
+ different or unavailable.
+ - Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
+ master interpreter returns, assuring Tcl_Main does not return.
+ - Documented Tcl_Main's absence from public stub table
+ - Documented that Tcl_Main does not return.
+ - Documented Tcl variables set by Tcl_Main.
+ - All prompts are done from a single procedure, Prompt.
+ - Use of Tcl_Obj-enabled interfaces everywhere.
* generic/tclInt.decls (TclGetStartupScriptPath,
- TclSetStartupScriptPath): New internal VFS-aware routines for
+ (TclSetStartupScriptPath): New internal VFS-aware routines for
managing the startup script of Tcl_Main.
* generic/tclIntDecls.h:
* generic/tclStubInit.c: make genstubs
* generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
- Tcltest_Init,TestinterpdeleteCmd):
- * tests/main.test (new): Added new file to test suite that
- thoroughly tests generic/tclMain.c; added some new test commands
- for testing Tcl_SetMainLoop().
+ (Tcltest_Init,TestinterpdeleteCmd):
+ * tests/main.test (new): Added new file to test suite that thoroughly
+ tests generic/tclMain.c; added some new test commands for testing
+ Tcl_SetMainLoop().
2002-01-04 Don Porter <dgp@users.sourceforge.net>
@@ -4786,7 +4691,7 @@
* doc/SplitPath.3:
* doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
- to accurately describe when and how they are used. [Bug 497459]
+ to accurately describe when and how they are used. [Bug 497459]
* generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread):
Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that
@@ -4807,7 +4712,7 @@
* tests/basic.test (basic-39.4): Greatly simplified test while
still leaving it so that it crashes when run without the fix to
the [foreach] implementation.
- * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped Bug #494348 from
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped [Bug 494348] from
happening by not trying to be so clever with cacheing; if nothing
untoward is happening anyway, the less efficient technique will
only add a few instruction cycles (one function call and a few
@@ -4815,19 +4720,19 @@
number of tests) and if something odd *is* going on, the code is
now far more robust.
- * tests/basic.test (basic-39.4): Reproducable script from Bug #494348
+ * tests/basic.test (basic-39.4): Reproducable script from [Bug 494348]
2002-01-02 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so
- the test is performed with the right internal function since
- [string match] no longer uses Tcl_StringCaseMatch internally.
+ * tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so the
+ test is performed with the right internal function since [string
+ match] no longer uses Tcl_StringCaseMatch internally.
* tests/string.test (string-11.51):
* generic/tclUtf.c (Tcl_UniCharCaseMatch):
* generic/tclUtil.c (Tcl_StringCaseMatch): Fault with matching
- case-insensitive non-ASCII patterns containing upper case
- characters. [Bug #233257]
+ case-insensitive non-ASCII patterns containing upper case characters.
+ [Bug 233257]
******************************************************************
*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" ***
diff --git a/ChangeLog.2003 b/ChangeLog.2003
index 5c32878..c586ba9 100644
--- a/ChangeLog.2003
+++ b/ChangeLog.2003
@@ -1,17 +1,16 @@
2003-12-25 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWin32Dll.c (DllMain): Add HAVE_NO_SEH
- blocks in place of __try and __except statements
- to support gcc builds. This is needed after
- David's changes on 2003-12-21. [Tcl patch 858493]
+ * win/tclWin32Dll.c (DllMain): Add HAVE_NO_SEH blocks in place of
+ __try and __except statements to support gcc builds. This is needed
+ after David's changes on 2003-12-21. [Patch 858493]
2003-12-23 David Gravereaux <davygrvy@pobox.com>
- * generic/tclAlloc.c: All uses of 'panic' (the macro) changed
- * generic/tclBasic.c: to 'Tcl_Panic' (the function). The
- * generic/tclBinary.c: #define of panic in tcl.h clearly states
- * generic/tclCkalloc.c: it is deprecated in the comments.
- * generic/tclCmdAH.c: [Patch 865264]
+ * generic/tclAlloc.c: All uses of 'panic' (the macro) changed to
+ * generic/tclBasic.c: 'Tcl_Panic' (the function). The #define of
+ * generic/tclBinary.c: panic in tcl.h clearly states it is deprecated
+ * generic/tclCkalloc.c: in the comments. [Patch 865264]
+ * generic/tclCmdAH.c:
* generic/tclCmdIL.c:
* generic/tclCmdMZ.c:
* generic/tclCompCmds.c:
@@ -65,64 +64,61 @@
2003-12-22 David Gravereaux <davygrvy@pobox.com>
* win/nmakehlp.c:
- * win/rules.vc: New feature for extensions that use rules.vc.
- Now reads header files for version strings. No more hard coding
+ * win/rules.vc: New feature for extensions that use rules.vc. Now
+ reads header files for version strings. No more hard coding
TCL_VERSION = 8.5 and having to edit it when you swap cores.
* win/makefile.vc: VERSION macro now set by reading tcl.h for it.
- * generic/tcl.h: Removed note that makefile.vc needs to have a
- version number changed.
+ * generic/tcl.h: Removed note that makefile.vc needs to have a version
+ number changed.
2003-12-21 David Gravereaux <davygrvy@pobox.com>
* win/tclWin32Dll.c: Structured Exception Handling added around
- Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH. We can't
- be 100% assured that Tcl is being unloaded by the OS in a stable
- condition and we need to protect the exit handlers should the
- stack be in a hosed state. AT&T style assembly for SEH under
- MinGW has not been added yet. This is a first part change for
- [Patch 858493]
+ Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH. We can't be
+ 100% assured that Tcl is being unloaded by the OS in a stable
+ condition and we need to protect the exit handlers should the stack be
+ in a hosed state. AT&T style assembly for SEH under MinGW has not been
+ added yet. This is a first part change for [Patch 858493]
2003-12-17 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug
- when numeric scan-value cache contains NULL value.
+ * generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug when
+ numeric scan-value cache contains NULL value.
2003-12-17 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclCmdAH.c:
- * unix/tclUnixFile.c:
- * win/tclWinFCmd.c:
- * tests/fCmd.test:
- * tests/fileSystem.test:
- * doc/file.n: final fix to support for relative links and
- its implications on normalization and other parts of the
- filesystem code. Fixes [Bug 859251] and some Windows
- problems with recursive file delete/copy and symbolic links.
+ * generic/tclCmdAH.c:
+ * unix/tclUnixFile.c:
+ * win/tclWinFCmd.c:
+ * tests/fCmd.test:
+ * tests/fileSystem.test:
+ * doc/file.n: final fix to support for relative links and its
+ implications on normalization and other parts of the filesystem code.
+ Fixes [Bug 859251] and some Windows problems with recursive file
+ delete/copy and symbolic links.
2003-12-17 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclPathObj.c:
- * tests/fileSystem.test: fix and tests for [Bug 860402] in new
- file normalization code.
+ * generic/tclPathObj.c:
+ * tests/fileSystem.test: fix and tests for [Bug 860402] in new file
+ normalization code.
2003-12-17 Zoran Vasiljevic <zv@archiware.com>
- * generic/tclIOUtil.c: fixed 2 memory (object) leaks.
- This fixes Tcl Bug #839519.
+ * generic/tclIOUtil.c: fixed 2 memory (object) leaks. [Bug 839519]
- * generic/tclPathObj.c: fixed Tcl_FSGetTranslatedPath
- to always return properly refcounted path object.
- This fixes Tcl Bug #861515.
+ * generic/tclPathObj.c: fixed Tcl_FSGetTranslatedPath to always return
+ properly refcounted path object. [Bug 861515]
2003-12-16 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/fCmd.test: marking fCmd-9.14.2, as nonPortable, since
- on Solaris one can change the name of the current directory
- with 'file rename'.
- * doc/FileSystem.3: clarified documentation on ownership
- of return objects/strings of some Tcl_FS* calls.
+ * tests/fCmd.test: marking fCmd-9.14.2, as nonPortable, since on
+ Solaris one can change the name of the current directory with 'file
+ rename'.
+ * doc/FileSystem.3: clarified documentation on ownership of return
+ objects/strings of some Tcl_FS* calls.
2003-12-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
@@ -131,70 +127,67 @@
2003-12-15 David Gravereaux <davygrvy@pobox.com>
* win/tcl.rc:
- * win/tclsh.rc: Slight modification to the STRINGIFY macro to
- support Borland's rc tool.
+ * win/tclsh.rc: Slight modification to the STRINGIFY macro to support
+ Borland's rc tool.
- * win/tclWinFile.c (TclpUtime) : utimbuf struct not a problem
- with Borland.
+ * win/tclWinFile.c (TclpUtime) : utimbuf struct not a problem with
+ Borland.
- * win/tclWinTime.c (TclpGetDate) : Borland's localtime() has
- a slight behavioral difference.
+ * win/tclWinTime.c (TclpGetDate) : Borland's localtime() has a slight
+ behavioral difference.
From Helmut Giese <hgiese@ratiosoft.com> [Patch 758097].
2003-12-14 David Gravereaux <davygrvy@pobox.com>
- * generic/tclInt.decls: commented-out entry for
- TclpCheckStackSpace, removing it from the Stubs table. It's
- already declared in tclInt.h and labeled as a function that is
- not to be exported. Regened tables.
+ * generic/tclInt.decls: commented-out entry for TclpCheckStackSpace,
+ removing it from the Stubs table. It's already declared in tclInt.h
+ and labeled as a function that is not to be exported. Regened tables.
2003-12-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): TIP#75 Implementation
- * tests/switch.test: Can now get submatch information when
- * doc/switch.n: using -regexp matching in [switch].
+ * tests/switch.test: Can now get submatch information when using
+ * doc/switch.n: -regexp matching in [switch].
2003-12-14 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclPathObj.c: complete rewrite of generic file
- normalization code to cope with links followed by '..'.
- [Bug 849514], and parts of [859251]
+ * generic/tclPathObj.c: complete rewrite of generic file normalization
+ code to cope with links followed by '..'. [Bug 849514], and parts of
+ [Bug 859251]
2003-12-12 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinChan.c: Win32's SetFilePointer() takes LONGs not
- DWORDs (a signed/unsigned mismatch). Redid local vars to
- avoid all casting except where truly required.
+ * win/tclWinChan.c: Win32's SetFilePointer() takes LONGs not DWORDs (a
+ signed/unsigned mismatch). Redid local vars to avoid all casting
+ except where truly required.
2003-12-12 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclCmdAH.c: fix to normalization of non-existent user
- name ('file normalize ~nobody') [Bug 858937]
- * doc/file.n: clarify behaviour of 'file link' when the target
- is not an absolute path.
- * doc/filename.n: correct documentation to say that Windows Tcl
- does handle '~user', for recent Windows releases, and clarified
- distinction between MacOS 'classic' and MacOS X.
+ * generic/tclCmdAH.c: fix to normalization of non-existent user name
+ ('file normalize ~nobody') [Bug 858937]
+ * doc/file.n: clarify behaviour of 'file link' when the target is not
+ an absolute path.
+ * doc/filename.n: correct documentation to say that Windows Tcl does
+ handle '~user', for recent Windows releases, and clarified distinction
+ between MacOS 'classic' and MacOS X.
* doc/glob.n: clarification of glob's behaviour when returning
filenames starting with a '~'.
* tests/fileSystem.test:
- * tests/fileName.test: new tests added for the normalization
- problem above and other recentlt reported issues.
+ * tests/fileName.test: new tests added for the normalization problem
+ above and other recentlt reported issues.
* win/tclWinFile.c: corrected unclear comments
- * unix/tclUnixFile.c: allow creation of relative links
- [Bug 833713]
+ * unix/tclUnixFile.c: allow creation of relative links. [Bug 833713]
2003-12-11 David Gravereaux <davygrvy@pobox.com>
- * win/tclWinSock.c (SocketThreadExitHandler) : added a
- TerminateThread fallback just in case the socket handler thread
- is really in a paused state. This can happen when Tcl is being
- unloaded by the OS from an exception handler. See MSDN docs on
- DllMain, it states this behavior.
+ * win/tclWinSock.c (SocketThreadExitHandler) : added a TerminateThread
+ fallback just in case the socket handler thread is really in a paused
+ state. This can happen when Tcl is being unloaded by the OS from an
+ exception handler. See MSDN docs on DllMain, it states this behavior.
2003-12-09 Jeff Hobbs <jeffh@ActiveState.com>
@@ -204,24 +197,24 @@
2003-12-09 Donal K. Fellows <donal.k.fellows@man.ac.uk>
- * unix/tclUnixPort.h: #ifdef'd out declarations of errno which
- * tools/man2tcl.c: are known to cause problems with recent
- glibc. [Bug 852369]
+ * unix/tclUnixPort.h: #ifdef'd out declarations of errno which are
+ * tools/man2tcl.c: known to cause problems with recent glibc.
+ [Bug 852369]
2003-12-09 Vince Darley <vincentdarley@users.sourceforge.net>
* win/tclWinFile.c: fix to NT file permissions code [Bug 855923]
- * tests/winFile.test: added tests for NT file permissions - patch
- and test scripts supplied by Benny.
+ * tests/winFile.test: added tests for NT file permissions - patch and
+ test scripts supplied by Benny.
* tests/winFCmd.test: fixed one test for when not running in C:/
2003-12-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
- * generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made
- the numeric scan-value cache have proper references to the objects
- within it so strange patterns of writes won't cause references to
- freed objects. Thanks to Paul Obermeir for the report. [Bug 851747]
+ * generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made the
+ numeric scan-value cache have proper references to the objects within
+ it so strange patterns of writes won't cause references to freed
+ objects. Thanks to Paul Obermeir for the report. [Bug 851747]
2003-12-01 Miguel Sofer <msofer@users.sf.net>
@@ -230,14 +223,13 @@
2003-11-24 Don Porter <dgp@users.sourceforge.net>
* generic/tclParse.c: Corrected faulty check for trailing white
- space in {expand} parsing. Thanks Andreas Leitgeb. [Bug 848262].
+ space in {expand} parsing. Thanks Andreas Leitgeb. [Bug 848262]
* tests/parse.test: New tests for the bug.
2003-11-24 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclPathObj.c: fix to [Bug 845778] - Infinite recursion
- on [cd] (Windows only bug), for which new tests have just been
- added.
+ * generic/tclPathObj.c: fix to [Bug 845778] - Infinite recursion on
+ [cd] (Windows only bug), for which new tests have just been added.
2003-11-21 Don Porter <dgp@users.sourceforge.net>
@@ -246,20 +238,20 @@
2003-11-20 Miguel Sofer <msofer@users.sf.net>
- * generic/tclVar.c: fix flag bit collision between
- LOOKUP_FOR_UPVAR and TCL_PARSE_PART1 (deprecated) [Bug 835020]
+ * generic/tclVar.c: fix flag bit collision between LOOKUP_FOR_UPVAR
+ and TCL_PARSE_PART1 (deprecated) [Bug 835020]
2003-11-19 Don Porter <dgp@users.sourceforge.net>
- * tests/compile.test (compile-16.22.0): Improved test for the
- recent fix for Bug 845412.
+ * tests/compile.test (compile-16.22.0): Improved test for the recent
+ fix for Bug 845412.
2003-11-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclCompile.c (TclCompileScript): Added a guard for the
- expansion code so that long non-expanding commands don't get
- expansion infrastructure inserted in them, especially when that
- infrastructure isn't initialised. [Bug 845412]
+ expansion code so that long non-expanding commands don't get expansion
+ infrastructure inserted in them, especially when that infrastructure
+ isn't initialised. [Bug 845412]
2003-11-18 David Gravereaux <davygrvy@pobox.com>
@@ -273,44 +265,43 @@
2003-11-17 Don Porter <dgp@users.sourceforge.net>
* tests/reg.test: Added tests for [Bugs 230589, 504785, 505048, 840258]
- recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran.
- His notes on the fix: This bug results from an error in code that
- splits states into "progress" and "no-progress" ones. This error
- causes an interesting situation with the pre-collected single-linked
- list of states to be splitted: many items were added to the list, but
- only several of them are accessible from the list beginning,
- since the "tmp" member of struct state (which is used here to
- hold a pointer to the next list item) gets overwritten, which
- results in a "looped" chain. As a result, not all of states are
- splitted, and one state is splitted two times, causing incorrect
- "no-progress" flag values.
+ recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran. His
+ notes on the fix: This bug results from an error in code that splits
+ states into "progress" and "no-progress" ones. This error causes an
+ interesting situation with the pre-collected single-linked list of
+ states to be splitted: many items were added to the list, but only
+ several of them are accessible from the list beginning, since the
+ "tmp" member of struct state (which is used here to hold a pointer to
+ the next list item) gets overwritten, which results in a "looped"
+ chain. As a result, not all of states are splitted, and one state is
+ splitted two times, causing incorrect "no-progress" flag values.
2003-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclExecute.c (TclExecuteByteCode): Make sure that
Tcl_AsyncInvoke is called regularly when processing bytecodes.
- * generic/tclTest.c (AsyncThreadProc, TestasyncCmd): Extended
- testing harness to send an asynchronous marking without relying on
- UNIX signals.
- * tests/async.test (async-4.*): Tests to check that async events
- are handled by the bytecode core. [Bug 746722]
+ * generic/tclTest.c (AsyncThreadProc, TestasyncCmd): Extended testing
+ harness to send an asynchronous marking without relying on UNIX
+ signals.
+ * tests/async.test (async-4.*): Tests to check that async events are
+ handled by the bytecode core. [Bug 746722]
2003-11-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
- * generic/tclTest.c (TestHashSystemHashCmd): Removed 'const'
- modifier from hash type structure; it should be const and the hash
- code assumes it behaves like const, but that's not how the API is
- defined. Like this, we are following in the same footsteps as
- Tcl_RegisterObjType() which has the same conditions on its
- argument. Stops VC++5.2 warning. [Bug 842511]
+ * generic/tclTest.c (TestHashSystemHashCmd): Removed 'const' modifier
+ from hash type structure; it should be const and the hash code assumes
+ it behaves like const, but that's not how the API is defined. Like
+ this, we are following in the same footsteps as Tcl_RegisterObjType()
+ which has the same conditions on its argument. Stops VC++5.2 warning.
+ [Bug 842511]
2003-11-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
- * generic/tclHash.c (Tcl_DeleteHashTable,Tcl_HashStats,RebuildTable):
- * generic/tclTest.c (TestHashSystemHashCmd): TIP#138 implementation,
+ * generic/tclHash.c (Tcl_DeleteHashTable,Tcl_HashStats,RebuildTable):
+ * generic/tclTest.c (TestHashSystemHashCmd): TIP#138 implementation,
* tests/misc.test: plus a new chunk of stuff to test the hash
- functions more thoroughly in the test
- suite. [Patch 731356, modified]
+ functions more thoroughly in the test suite.
+ [Patch 731356, modified]
* doc/Tcl.n: Updated Tcl version number and changebars.
@@ -319,23 +310,23 @@
* doc/ParseCmd.3: Implementation of TIP 157. Adds recognition
* doc/Tcl.n: of the new leading {expand} syntax on words.
* generic/tcl.h: Parses such words as the new Tcl_Token type
- * generic/tclBasic.c: TCL_TOKEN_EXPAND_WORD. Updated Tcl_EvalEx
- * generic/tclCompile.c: and the bytecode compiler/execution engine
- * generic/tclCompile.h: to recognize the new token type. New opcodes
+ * generic/tclBasic.c: TCL_TOKEN_EXPAND_WORD. Updated Tcl_EvalEx and
+ * generic/tclCompile.c: the bytecode compiler/execution engine to
+ * generic/tclCompile.h: recognize the new token type. New opcodes
* generic/tclExecute.c: INST_LIST_VERIFY and INST_INVOKE_EXP and a new
- * generic/tclParse.c: operand type OPERAND_ULIST1 are defined. Docs
+ * generic/tclParse.c: operand type OPERAND_ULIST1 are defined. Docs
* generic/tclTest.c: and tests are included.
* tests/basic.test:
* tests/compile.test:
* tests/parse.test:
* library/auto.tcl: Replaced several [eval]s used to perform
- * library/package.tcl: argument expansion with the new syntax.
- * library/safe.tcl: In the test files lindex.test and lset.test,
- * tests/cmdInfo.test: replaced use of [eval] to force direct
- * tests/encoding.test: string evaluation with use of [testevalex]
- * tests/execute.test: which more directly and robustly serves the
- * tests/fCmd.test: same purpose.
+ * library/package.tcl: argument expansion with the new syntax. In the
+ * library/safe.tcl: test files lindex.test and lset.test, replaced
+ * tests/cmdInfo.test: use of [eval] to force direct string
+ * tests/encoding.test: evaluation with use of [testevalex] which more
+ * tests/execute.test: directly and robustly serves the same purpose.
+ * tests/fCmd.test:
* tests/http.test:
* tests/init.test:
* tests/interp.test:
@@ -357,16 +348,16 @@
2003-11-12 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more
- systems are using permissions caching, and this isn't really a Tcl
- controlled issue.
+ * tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more systems
+ are using permissions caching, and this isn't really a Tcl controlled
+ issue.
2003-11-11 Jeff Hobbs <jeffh@ActiveState.com>
* unix/configure:
* unix/tcl.m4: improve AIX --enable-64bit handling
- remove -D__NO_STRING_INLINES -D__NO_MATH_INLINES from
- CFLAGS_OPTIMIZE on Linux. Make default opt -O2 (was -O).
+ remove -D__NO_STRING_INLINES -D__NO_MATH_INLINES from CFLAGS_OPTIMIZE
+ on Linux. Make default opt -O2 (was -O).
2003-11-11 David Gravereaux <davygrvy@pobox.com>
@@ -381,10 +372,10 @@
* win/tclWinInit.c (TclpInitLibraryPath): Fix for [Bug 832657]
that should not run afoul of startup constraints.
- * library/dde/pkgIndex.tcl: Added safeguards so that registry
- * library/reg/pkgIndex.tcl: and dde packages are not offered
- * win/tclWinDde.c: on non-Windows platforms. Bumped to
- * win/tclWinReg.c: registry 1.1.3 and dde 1.3.
+ * library/dde/pkgIndex.tcl: Added safeguards so that registry and
+ * library/reg/pkgIndex.tcl: dde packages are not offered on
+ * win/tclWinDde.c: non-Windows platforms. Bumped to
+ * win/tclWinReg.c: registry 1.1.3 and dde 1.3.
* win/Makefile.in:
* win/configure.in:
* win/makefile.bc:
@@ -401,13 +392,13 @@
2003-11-10 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclCmdAH.c:
- * tests/fCmd.test: fix to misleading error message in 'file link'
+ * tests/fCmd.test: fix to misleading error message in 'file link'.
[Bug 836208]
2003-11-07 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: fix to compiler warning/error with
- some compilers [Bug 835918]
+ * generic/tclIOUtil.c: fix to compiler warning/error with some
+ compilers. [Bug 835918]
2003-11-07 Daniel Steffen <das@users.sourceforge.net>
@@ -427,10 +418,9 @@
2003-11-03 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclIOUtil.c
- * generic/tclInt.h: added comments and re-arranged code to
- clarify distinction between Tcl_LoadHandle, ClientData for
- 'load'ed code, and point out limitations of the design
- introduced with Tcl 8.4.
+ * generic/tclInt.h: added comments and re-arranged code to clarify
+ distinction between Tcl_LoadHandle, ClientData for 'load'ed code, and
+ point out limitations of the design introduced with Tcl 8.4.
* unix/tclUnixFile.c: fix to memory leak
@@ -440,14 +430,13 @@
* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Check for sensible list
lengths and allow for soft failure of the memory subsystem in the
- [lconcat] command [Bug 829027]. Uses direct list creation to
- avoid extra copies when working near the limit of available
- memory. Also reorganized to encourage optimizing compilers to
- optimize heavily.
+ [lconcat] command [Bug 829027]. Uses direct list creation to avoid
+ extra copies when working near the limit of available memory. Also
+ reorganized to encourage optimizing compilers to optimize heavily.
* generic/tclListObj.c (TclNewListObjDirect): New list constructor
that does not copy the array of objects. Useful for creating
- potentially very large lists or where you are about to throw away
- the array argument which is being used in its entirety.
+ potentially very large lists or where you are about to throw away the
+ array argument which is being used in its entirety.
2003-10-28 Miguel Sofer <msofer@users.sf.net>
@@ -457,14 +446,14 @@
2003-10-23 Andreas Kupries <andreask@activestate.com>
* unix/tclUnixChan.c (Tcl_MakeFileChannel): Applied [Patch 813606]
- fixing [Bug 813087]. Detection of sockets was off for Mac OS X
- which implements pipes as local sockets. The new code ensures
- that only IP sockets are detected as such.
+ fixing [Bug 813087]. Detection of sockets was off for Mac OS X which
+ implements pipes as local sockets. The new code ensures that only IP
+ sockets are detected as such.
- * win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when
- asked for writable events by the generic layer.
- (SocketEventProc): Generate a writable event too when a close is
- detected.
+ * win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when asked
+ for writable events by the generic layer.
+ (SocketEventProc): Generate a writable event too when a close is
+ detected.
Together the changes fix [Bug 599468].
@@ -487,42 +476,42 @@
* tools/tcltk-man2html.tcl: fixed incorrect html generated for
.IP/.TP lists, now use <DL><DT>...<DD>...<P><DT>...<DD>...</DL>
instead of illegal <DL><P><DT>...<DD>...<P><DT>...<DD>...</DL>.
- Added skipping of directives directly after .TP to avoid them
- being used as item descriptions, e.g. .TP\n.VS in clock.n.
+ Added skipping of directives directly after .TP to avoid them being
+ used as item descriptions, e.g. .TP\n.VS in clock.n.
2003-10-21 Andreas Kupries <andreask@pliers.activestate.com>
- * win/tclWinPipe.c (BuildCommandLine): Applied the patch coming
- with [Bug 805605] to the code, fixing the incorrect use of
- ispace noted by Ronald Dauster <ronaldd@users.sourceforge.net>.
+ * win/tclWinPipe.c (BuildCommandLine): Applied the patch coming with
+ [Bug 805605] to the code, fixing the incorrect use of ispace noted by
+ Ronald Dauster <ronaldd@users.sourceforge.net>.
2003-10-20 Kevin B. Kenny <kennykb@users.sourceforge.net>
* doc/msgcat.n:
* library/msgcat/msgcat.tcl (mclocale,mcload):
* tools/tcl.wse.in:
- * unix/Makefile.in: Implementation of TIP#156
- * win/makefile.bc: adding a "root locale" to
- * win/Makefile.in: the 'msgcat' package. Advanced
- * win/Makefile.vc: msgcat version number to 1.4.
+ * unix/Makefile.in: Implementation of TIP#156, add a "root locale"
+ * win/makefile.bc: to the 'msgcat' package. Advanced msgcat
+ * win/Makefile.in: version number to 1.4
+ * win/Makefile.vc:
2003-10-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCmdIL.c (SortInfo,etc): Reorganized so that SortInfo
- carries an array of integer indices instead of a Tcl list. This
- nips shimmering problems in the bud and simplifies SelectObjFromSublist
- at the cost of making setup slightly more complex. [Bug 823768]
+ carries an array of integer indices instead of a Tcl list. This nips
+ shimmering problems in the bud and simplifies SelectObjFromSublist at
+ the cost of making setup slightly more complex. [Bug 823768]
2003-10-14 David Gravereaux <davygrvy@pobox.com>
- * win/tclAppInit.c (sigHandler): Punt gracefully if exitToken
- has already been destroyed.
+ * win/tclAppInit.c (sigHandler): Punt gracefully if exitToken has
+ already been destroyed.
2003-10-14 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclCmdMZ.c:
- * tests/regexp.test: fix to [Bug 823524] in regsub; added three
- new tests.
+ * tests/regexp.test: fix to [Bug 823524] in regsub; added three new
+ tests.
2003-10-14 Don Porter <dgp@users.sourceforge.net>
@@ -534,7 +523,7 @@
routine that supports truncated appends with optional ellipsis marking.
This single routine supports UTF-8-safe truncated appends needed in
several places throughout the Tcl source code, mostly for error and
- stack messages. Clean fix for [Bug 760872].
+ stack messages. Clean fix for [Bug 760872].
* generic/tclInt.h: Declarations for new internal routines.
@@ -551,23 +540,23 @@
* mac/tclMacResource.c:
* library/init.tcl: Updated ::errorInfo cleanup in [unknown] to
- reflect slight modifications to Tcl_LogCommandInfo(). Corrects
- failing init-4.* tests.
+ reflect slight modifications to Tcl_LogCommandInfo(). Corrects failing
+ init-4.* tests.
2003-10-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
TIP#127 IMPLEMENTATION FROM JOE MICHAEL SCHLENKER
* generic/tclCmdIL.c (SelectObjFromSublist): Element selection engine.
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
* tests/lsearch.test: Set up and use of element selection engine,
* tests/cmdIL.test: plus tests and documentation.
* doc/lsearch.n: Based on [Patch 693836]
- * doc/lsort.n:
+ * doc/lsort.n:
2003-10-13 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tcl.h:
+ * generic/tcl.h:
* generic/tclFileName.c:
* generic/tclIOUtil.c:
* generic/tclPathObj.c:
@@ -579,28 +568,27 @@
* win/tclWin32Dll.c:
* win/tclWinFCmd.c:
* win/tclWinFile.c:
- * win/tclFileInt.h:
+ * win/tclFileInt.h:
Fixed [Bug 800106] in which 'glob' was incapable of merging the
results of a directory listing (real or virtual) and any virtual
- filesystem mountpoints in that directory (the latter were
- ignored). This meant boundaries between different filesystems
- were not seamless (e.g. 'glob */*' across a filesystem boundary
- was wrong). Added new entry to Tcl_GlobTypeData in a totally
- backwards compatible way. To allow listing of mounts, registered
- filesystems must support the 'TCL_GLOB_TYPE_MOUNT' flag. If this
- is not supported (e.g. in tclvfs 1.2) then mounts will simply not
- be listed for that filesystem.
-
- Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess)
- using correct permission checking code for Windows NT/2000/XP
- where more complex user-based security/access priveleges are
- available, particularly on shared volumes. The performance
- impact of this extra checking will need further investigation.
- Note: Win 95,98,ME have no support for this.
-
- Also made better use of normalized rather than translated paths
- in the platform specific code.
+ filesystem mountpoints in that directory (the latter were ignored).
+ This meant boundaries between different filesystems were not seamless
+ (e.g. 'glob */*' across a filesystem boundary was wrong). Added new
+ entry to Tcl_GlobTypeData in a totally backwards compatible way. To
+ allow listing of mounts, registered filesystems must support the
+ 'TCL_GLOB_TYPE_MOUNT' flag. If this is not supported (e.g. in tclvfs
+ 1.2) then mounts will simply not be listed for that filesystem.
+
+ Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess) using
+ correct permission checking code for Windows NT/2000/XP where more
+ complex user-based security/access priveleges are available,
+ particularly on shared volumes. The performance impact of this extra
+ checking will need further investigation. Note: Win 95,98,ME have no
+ support for this.
+
+ Also made better use of normalized rather than translated paths in the
+ platform specific code.
2003-10-12 Jeff Hobbs <jeffh@ActiveState.com>
@@ -618,7 +606,7 @@
* generic/tclBasic.c: Save and restore the iPtr->flag bits that
control the state of errorCode and errorInfo management when calling
"leave" execution traces, so that all error information of the traced
- command is still available whether traced or not. [Bug 760947]
+ command is still available whether traced or not. [Bug 760947]
Thanks to Yahalom Emet.
2003-10-08 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -626,27 +614,27 @@
* generic/tclTest.c (TestNumUtfCharsCmd): Command to allow finer
access to Tcl_NumUtfChars for testing.
* generic/tclUtf.c (Tcl_NumUtfChars): Corrected string length
- determining when the length parameter is negative; the terminator
- is a zero byte, not (necessarily) a \u0000 character. [Bug 769812]
+ determining when the length parameter is negative; the terminator is a
+ zero byte, not (necessarily) a \u0000 character. [Bug 769812]
2003-10-07 Don Porter <dgp@users.sourceforge.net>
* tests/cmdAH.test:
* tests/exec.test: Corrected temporary file management
* tests/fileSystem.test: issues uncovered by -debug 1 test
- * tests/io.test: operations. Also backported some
+ * tests/io.test: operations. Also backported some
* tests/ioCmd.test: other fixes from the HEAD.
* tests/main.test:
* tests/pid.test: [Bugs 675605, 675655, 675659]
* tests/socket.test:
* tests/source.test:
- * tests/fCmd.test: Run tests with the [temporaryDirectory] as
- the current directory, so that tests can depend on ability to write
- files. [Bug 575837]
+ * tests/fCmd.test: Run tests with the [temporaryDirectory] as the
+ current directory, so that tests can depend on ability to write files.
+ [Bug 575837]
- * doc/OpenFileChnl.3: Updated Tcl_Tell and Tcl_Seek documentation
- to reflect that they now return Tcl_WideInt (TIP 72) [Bug 787537]
+ * doc/OpenFileChnl.3: Updated Tcl_Tell and Tcl_Seek documentation to
+ reflect that they now return Tcl_WideInt (TIP 72). [Bug 787537]
* tests/io.test: Corrected several tests that failed when paths
* tests/ioCmd.test: included regexp-special chars. [Bug 775394]
@@ -654,9 +642,9 @@
2003-10-06 Jeff Hobbs <jeffh@ActiveState.com>
* win/configure:
- * win/tcl.m4: removed incorrect checks for existence of
- optimization. TCL_CFG_OPTIMIZED is now defined whenever the user
- does not build with --enable-symbols.
+ * win/tcl.m4: removed incorrect checks for existence of optimization.
+ TCL_CFG_OPTIMIZED is now defined whenever the user does not build with
+ --enable-symbols.
2003-10-06 Don Porter <dgp@users.sourceforge.net>
@@ -666,8 +654,8 @@
* tests/fCmd.test (fCmd-8.2): Test only that tilde-substitution
happens, not for any particular result. [Bug 685991]
- * unix/tcl.m4 (SC_PATH_TCLCONFIG): Corrected search path so
- that alpha and beta releases of Tcl are not favored. [Bug 608698]
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG): Corrected search path so that
+ alpha and beta releases of Tcl are not favored. [Bug 608698]
* tests/reg.test: Corrected duplicate test names.
* tests/resource.test: [Bugs 710370, 710358]
@@ -691,12 +679,12 @@
* generic/tclBasic.c: Fixed error in ref count management of command
* generic/tclCmdMZ.c: and execution traces that caused access to
- freed memory in trace-32.1. [Bug 811483].
+ freed memory in trace-32.1. [Bug 811483]
2003-10-02 Don Porter <dgp@users.sourceforge.net>
* generic/tclTrace.c: Corrected comingling of introspection results of
- [trace info command] and [trace info execution]. [Bug 807243]
+ [trace info command] and [trace info execution]. [Bug 807243]
Thanks to Mark Saye.
2003-10-01 Daniel Steffen <das@users.sourceforge.net>
@@ -712,10 +700,10 @@
2003-09-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclPathObj.c (TclNativePathInFilesystem,TclFSGetPathType):
+ * generic/tclPathObj.c (TclNativePathInFilesystem,TclFSGetPathType):
* generic/tclIOUtil.c (TclNativeDupInternalRep,TclGetPathType): Rename
- to make sure function names won't interfere with other non-Tcl
- code (reported by George Staplin)
+ to make sure function names won't interfere with other non-Tcl code
+ (reported by George Staplin)
TIP#121 IMPLEMENTATION FROM JOE MISTACHKIN
@@ -727,14 +715,13 @@
TIP#112 IMPLEMENTATION
* generic/tclNamesp.c: Core of implementation.
- * generic/tclInt.h (Namespace,TclInvalidateNsCmdLookup): Add
- command list epoch counter and list of ensembles to namespace
- structure, and define a macro to ease update of the epoch
- counter.
- * generic/tclBasic.c (Tcl_CreateObjCommand,etc.): Update epoch
- counter when list of commands in a namespace changes.
- * generic/tclObj.c (TclInitObjSubsystem): Register ensemble
- subcommand type.
+ * generic/tclInt.h (Namespace,TclInvalidateNsCmdLookup): Add command
+ list epoch counter and list of ensembles to namespace structure, and
+ define a macro to ease update of the epoch counter.
+ * generic/tclBasic.c (Tcl_CreateObjCommand,etc.): Update epoch counter
+ when list of commands in a namespace changes.
+ * generic/tclObj.c (TclInitObjSubsystem): Register ensemble subcommand
+ type.
* tests/namespace.test (42.1-47.6): Tests.
* doc/namespace.n: Documentation.
@@ -747,38 +734,37 @@
2003-09-28 David Gravereaux <davygrvy@pobox.com>
* win/tclWinPipe.c: The windows port of expect can call
- TclWinAddProcess before any of the other pipe functions.
- Added a missing PipeInit() call to make sure the
- initialization happens.
+ TclWinAddProcess before any of the other pipe functions. Added a
+ missing PipeInit() call to make sure the initialization happens.
2003-09-25 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Makefile: ensure SYMROOT exists if OBJROOT is overridden
- on command line. Replaced explict use of /usr/bin by ${BINDIR}.
+ * macosx/Makefile: ensure SYMROOT exists if OBJROOT is overridden on
+ command line. Replaced explict use of /usr/bin by ${BINDIR}.
2003-09-24 Vince Darley <vincentdarley@users.sourceforge.net>
- * library/package.tcl (tcl::MacPkgUnknown, tcl::MacOSXPkgUnknown):
- Minor performance tweaks to reduce the number of [file] invocations.
- Meant to improve startup times, at least a little bit.
- (The generic equivalent patch was applied on 2003-02-21).
+ * library/package.tcl (tcl::MacPkgUnknown, tcl::MacOSXPkgUnknown):
+ Minor performance tweaks to reduce the number of [file] invocations.
+ Meant to improve startup times, at least a little bit. (The generic
+ equivalent patch was applied on 2003-02-21).
2003-09-24 Vince Darley <vincentdarley@users.sourceforge.net>
- * trace.test: removed 'knownBug' from a test which doesn't
- illustrate a bug, just a bad test.
+ * trace.test: removed 'knownBug' from a test which doesn't illustrate
+ a bug, just a bad test.
2003-09-23 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c:
- * generic/tclInt.h: changed the evaluation-stack addressing mode,
- from array-style to pointer-style; the catch stack and evaluation
- stack are now contiguous in memory. [Patch 457449]
+ * generic/tclInt.h: changed the evaluation-stack addressing mode, from
+ array-style to pointer-style; the catch stack and evaluation stack are
+ now contiguous in memory. [Patch 457449]
2003-09-23 Don Porter <dgp@users.sourceforge.net>
- * tests/trace.test (trace-31,32-*): Added tests for [Bug 807243]
- and [Bug 811483].
+ * tests/trace.test (trace-31,32-*): Added tests for [Bug 807243] and
+ [Bug 811483].
* library/init.tcl (auto_load, auto_import): Expanded Eric Melski's
2000-01-28 fix for [Bug 218871] to all potentially troubled uses of
@@ -787,29 +773,29 @@
2003-09-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/expr.test (expr-23.4): Prevented accidental wrapping round
- of exponential operation; it isn't portable, and not what I
- intended to test either. [Bug 808244]
+ * tests/expr.test (expr-23.4): Prevented accidental wrapping round of
+ exponential operation; it isn't portable, and not what I intended to
+ test either. [Bug 808244]
2003-09-19 Miguel Sofer <msofer@users.sf.net>
- * generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to
- protect all calls that may cause traces on ::errorInfo or
- ::errorCode to corrupt the stack [Bug 804681]
+ * generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to protect
+ all calls that may cause traces on ::errorInfo or ::errorCode to
+ corrupt the stack. [Bug 804681]
2003-09-17 Vince Darley <vincentdarley@users.sourceforge.net>
- * tclPathObj.c: fix to test-suite problem introduced by the bug
- fix below. No problem in ordinary code, just test suite code
- which manually adjusts tclPlatform. [Bug 808247]
+ * tclPathObj.c: fix to test-suite problem introduced by the bug fix
+ below. No problem in ordinary code, just test suite code which
+ manually adjusts tclPlatform. [Bug 808247]
2003-09-16 Vince Darley <vincentdarley@users.sourceforge.net>
* doc/filename.n: documentation of Windows-specific feature as
discussed in [Bug 541989]
- * generic/tclPathObj.c: fix for normalization of volume-relative
- paths [Bug 767834]
- * tests/winFCmd.test: new tests for both of the above.
+ * generic/tclPathObj.c: fix for normalization of volume-relative paths
+ [Bug 767834]
+ * tests/winFCmd.test: new tests for both of the above.
* tests/cmdAH.test: fix for AFS problem in test suite [Bug 748960]
2003-09-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -818,35 +804,35 @@
* generic/tclCompile.h (INST_EXPON): Implementation of
* generic/tclCompile.c (tclInstructionTable): exponential operator.
- * generic/tclCompExpr.c (operatorTable):
- * generic/tclParseExpr.c (ParseExponentialExpr, GetLexeme):
- * generic/tclExecute.c (TclExecuteByteCode, ExponWide, ExponLong):
- (IllegalExprOperandType):
- * tests/expr.test:
- * tests/compExpr-old.test:
- * doc/expr.n:
+ * generic/tclCompExpr.c (operatorTable):
+ * generic/tclParseExpr.c (ParseExponentialExpr, GetLexeme):
+ * generic/tclExecute.c (TclExecuteByteCode, ExponWide, ExponLong):
+ (IllegalExprOperandType):
+ * tests/expr.test:
+ * tests/compExpr-old.test:
+ * doc/expr.n:
2003-09-10 Don Porter <dgp@users.sourceforge.net>
* library/opt/optparse.tcl: Latest revisions caused [OptGuessType]
- to guess "int" instead of "string" for empty strings. Missed the
- required "-strict" option to [string is]. Thanks to Revar Desmera.
+ to guess "int" instead of "string" for empty strings. Missed the
+ required "-strict" option to [string is]. Thanks to Revar Desmera.
[Bug 803968]
2003-09-08 David Gravereaux <davygrvy@pobox.com>
* win/tclWinLoad.c (TclpDlopen): Changed the error message for
ERROR_PROC_NOT_FOUND to be a bit more helpful in giving us clues.
- "can't find specified procedure" means a function in the import
- table, for implicit loading, couldn't be resolved and that's why
- the load failed.
+ "can't find specified procedure" means a function in the import table,
+ for implicit loading, couldn't be resolved and that's why the load
+ failed.
2003-09-04 Don Porter <dgp@users.sourceforge.net>
* doc/Tcl_Main.3:
* doc/FileSystem.3: Implementation of
- * doc/source.n: TIPs 137/151. Adds
- * doc/tclsh.1: a -encoding option to
+ * doc/source.n: TIPs 137/151. Adds a
+ * doc/tclsh.1: -encoding option to
* generic/tcl.decls: the [source] command
* generic/tclCmdMZ.c (Tcl_SourceObjCmd): and a new C routine,
* generic/tclIOUtil.c (Tcl_FSEvalFileEx): Tcl_FSEvalFileEx(),
@@ -854,20 +840,20 @@
* mac/tclMacResource.c (Tcl_MacSourceObjCmd): to the same function.
* tests/cmdMZ.test: Also adds command line
* tests/main.test: option handling in Tcl_Main() so that tclsh
- * tests/source.test: and other apps built on Tcl_Main() respect
- a -encoding command line option before a script filename. Docs and
- tests updated as well. [Patch 742683]
+ * tests/source.test: and other apps built on Tcl_Main() respect a
+ -encoding command line option before a script filename. Docs and tests
+ updated as well. [Patch 742683]
This is a ***POTENTIAL INCOMPATIBILITY*** only for those C programs
that embed Tcl, build on Tcl_Main(), and make use of Tcl_Main's former
ability to pass a leading "-encoding" option to interactive shell
operations.
* generic/tclInt.decls: Added internal stub
- * generic/tclMain.c (Tcl*StartupScript*): table entries for
- two new functions Tcl_SetStartupScript() and Tcl_GetStartupScript()
- that set/get the path and encoding for the startup script to be
- evaluated by either Tcl_Main() or Tk_Main(). Given public names in
- anticipation of their exposure by a followup TIP.
+ * generic/tclMain.c (Tcl*StartupScript*): table entries for two
+ new functions Tcl_SetStartupScript() and Tcl_GetStartupScript() that
+ set/get the path and encoding for the startup script to be evaluated
+ by either Tcl_Main() or Tk_Main(). Given public names in anticipation
+ of their exposure by a followup TIP.
* generic/tclDecls.h: make genstubs
* generic/tclIntDecls.h:
@@ -893,8 +879,8 @@
2003-09-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/Namespace.3: Basic documentation for the TIP#139 functions.
- This will need improving, but the basic bits are there at least.
+ * doc/Namespace.3: Basic documentation for the TIP#139 functions. This
+ will need improving, but the basic bits are there at least.
2003-08-31 Don Porter <dgp@users.sourceforge.net>
@@ -902,102 +888,100 @@
2003-08-29 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCmdAH.c: Corrected bug in TIP 90 implementation
- * tests/cmdMZ.test: where the default -errorcode NONE value
- was not copied into the return options dictionary. This correction
- modified one test result.
+ * generic/tclCmdAH.c: Corrected bug in TIP 90 implementation where
+ * tests/cmdMZ.test: the default -errorcode NONE value was not
+ copied into the return options dictionary. This correction modified
+ one test result.
2003-08-27 David Gravereaux <davygrvy@pobox.com>
* compat/strftime.c (_fmt): Removed syst array intializer that
couldn't take variables within it under the watcom compiler:
- 'Initializers must be constant'. I believe Borland has this
- strictness as well. VC++ must be non-standard about this.
+ 'Initializers must be constant'. I believe Borland has this strictness
+ as well. VC++ must be non-standard about this.
- Changed Win32 platform #ifdef from 'WIN32' to '__WIN32__' as
- this is the correct one to use across the Tcl sources. Even
- though we do force it in tcl.h, the true parent one is __WIN32__.
+ Changed Win32 platform #ifdef from 'WIN32' to '__WIN32__' as this is
+ the correct one to use across the Tcl sources. Even though we do force
+ it in tcl.h, the true parent one is __WIN32__.
- Added missing CONST'ification usage to match prototype listed
- in tclInt.decls.
+ Added missing CONST'ification usage to match prototype listed in
+ tclInt.decls.
- * win/tclWinPort.h: Added a block for OpenWatcom adjustments
- that fixes 1) the same issue Mo did for MinGW lack of missing LPFN_*
+ * win/tclWinPort.h: Added a block for OpenWatcom adjustments that
+ fixes 1) the same issue Mo did for MinGW lack of missing LPFN_*
typedefs in their WINE derived <winsock2.h> and 2) The need to be
strict about how the char type needs to be signed by default.
* win/tclWinSock.c: Added OpenWatcom to the commentary about the
#ifdef HAVE_NO_LPFN_DECLS block.
- * win/tclWinTime.c: Changed use of '_timezone' to 'timezone' as
- this difference is already adjusted for in tclWinPort.h. Removed
+ * win/tclWinTime.c: Changed use of '_timezone' to 'timezone' as this
+ difference is already adjusted for in tclWinPort.h. Removed
unreferenced posixEpoch file-scope global.
- * win/tclWinFile.c (WinReadLinkDirectory): Fix for 'Initializers
- must be constant' with the driveSpec array using OpenWatcom.
+ * win/tclWinFile.c (WinReadLinkDirectory): Fix for 'Initializers must
+ be constant' with the driveSpec array using OpenWatcom.
2003-08-27 Don Porter <dgp@users.sourceforge.net>
* generic/tclUtil.c: Corrected [Bug 411825] and other bugs in
TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped
- spaces were handled incorrectly.
+ spaces were handled incorrectly.
* tests/util.test: Added new tests util-8.[2-6].
2003-08-26 David Gravereaux <davygrvy@pobox.com>
* generic/tcl.h: Added some support for the LCC-Win32 compiler.
- Unfortunetly, this compiler has a bug in its preprocessor and
- can't build Tcl even with this minor patch. Also added some
- support for the OpenWatcom compiler. A new win/makefile.wc to
- follow soon.
+ Unfortunetly, this compiler has a bug in its preprocessor and can't
+ build Tcl even with this minor patch. Also added some support for the
+ OpenWatcom compiler. A new win/makefile.wc to follow soon.
2003-08-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* tools/genStubs.tcl (genStubs::makeDecl): A more subtle way of
- generating stubbed declarations allows us to have declarations of
- a function in multiple interfaces simultaneously.
+ generating stubbed declarations allows us to have declarations of a
+ function in multiple interfaces simultaneously.
* generic/tcl.decls: Duplicated some namespace declarations from
- tclInt.decls here, as mandated by TIP #139. This is OK since the
+ tclInt.decls here, as mandated by TIP #139. This is OK since the
declarations match and will end up using the declarations in the
- public code from now on because of #include ordering. Keeping the
- old declarations in tclInt.decls; there's no need to gratuitously
- break compatability for those extensions which are already clients
- of the namespace code.
+ public code from now on because of #include ordering. Keeping the old
+ declarations in tclInt.decls; there's no need to gratuitously break
+ compatability for those extensions which are already clients of the
+ namespace code.
2003-08-23 Zoran Vasiljevic <zoran@archiwrae.com>
- * generic/tclIOUtil.c: merged fixes for thread-unsafe
- handling of filesystem records [Bug #753315].
- This also fixed the Bug #788780
- * generic/tclPathObj.c: merged fixes for thread-unsafe
- handling of filesystem records [Bug #753315].
+ * generic/tclIOUtil.c: merged fixes for thread-unsafe handling of
+ filesystem records [Bug 753315]. This also fixed the [Bug 788780]
+ * generic/tclPathObj.c: merged fixes for thread-unsafe handling of
+ filesystem records. [Bug 753315]
- * generic/tclFileSystem.h: merged fixes for thread-unsafe
- handling of filesystem records [Bug #753315].
+ * generic/tclFileSystem.h: merged fixes for thread-unsafe handling of
+ filesystem records. [Bug 753315]
2003-08-19 Pat Thoyts <patthoyts@users.sourceforge.net>
- * win/tclWinSerial.c (SerialErrorStr): Fixed a syntax error
- created in the previous code cleanup.
+ * win/tclWinSerial.c (SerialErrorStr): Fixed a syntax error created in
+ the previous code cleanup.
2003-08-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinSerial.c: Adjusted commenting and spacing usage to
- follow the principles of the Style Guide better.
+ * win/tclWinSerial.c: Adjusted commenting and spacing usage to follow
+ the principles of the Style Guide better.
2003-08-18 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/tcl.m4 (SC_ENABLE_SYMBOLS): Use test instead
- of -eq, which does not work. [Bug 781109]
+ * win/tcl.m4 (SC_ENABLE_SYMBOLS): Use test instead of -eq, which does
+ not work. [Bug 781109]
2003-08-13 Chengye Mao <chengye.geo@yahoo.com>
- * win/tclWinPipe.c: fixed a bug in BuildCommandLine.
- This bug built a command line with a missing space between
- tclpipe.dll and the following arguments. It caused error
- in Windows 98 when exec command.com (e.g. dir) [Bug 789040]
+ * win/tclWinPipe.c: fixed a bug in BuildCommandLine. This bug built a
+ command line with a missing space between tclpipe.dll and the
+ following arguments. It caused error in Windows 98 when exec
+ command.com (e.g. dir). [Bug 789040]
2003-08-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1006,7 +990,7 @@
* doc/lrepeat.n: patch, updated to the HEAD
* tests/lrepeat.test: and matching the core style.
* generic/tclBasic.c (buildIntCmds): Splice into core.
- * generic/tclInt.h:
+ * generic/tclInt.h:
* doc/list.n: Cross-reference.
2003-08-06 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1017,50 +1001,45 @@
* library/msgcat/msgcat.tcl: Added escape so that non-Windows
* library/msgcat/pkgIndex.tcl: platforms do not try to use the
- registry package. This can save a costly and pointless package
- search. Bumped to 1.3.1. Thanks to Dave Bodenstab. [Bug 781609].
+ registry package. This can save a costly and pointless package search.
+ Bumped to 1.3.1. Thanks to Dave Bodenstab. [Bug 781609]
2003-08-05 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT):
added a Tcl_ResetResult(interp) at each point where the interp's
- result is pushed onto the stack, to avoid keeping an extra
- reference that may cause costly Tcl_Obj duplication [Bug 781585]
- Detected by Franco Violi, analyzed by Peter Spjuth and Donal
- Fellows.
+ result is pushed onto the stack, to avoid keeping an extra reference
+ that may cause costly Tcl_Obj duplication. Detected by Franco Violi,
+ analyzed by Peter Spjuth and Donal Fellows. [Bug 781585]
2003-07-28 Vince Darley <vincentdarley@users.sourceforge.net>
* doc/FileSystem.3:
- * doc/Translate.3: better documentation of Tcl_TranslateFileName
- and related functions [Bug 775220]
+ * doc/Translate.3: better documentation of Tcl_TranslateFileName and
+ related functions. [Bug 775220]
2003-07-24 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tcl.h: Revert change made on 2003-07-21
- since it made the sizeof(Tcl_Obj) different for
- regular vs mem debug builds.
- * generic/tclInt.h: Define TclDecrRefCount in terms
- of Tcl_DbDecrRefCount which removes one layer of
- inderection.
+ * generic/tcl.h: Revert change made on 2003-07-21 since it made the
+ sizeof(Tcl_Obj) different for regular vs mem debug builds.
+ * generic/tclInt.h: Define TclDecrRefCount in terms of
+ Tcl_DbDecrRefCount which removes one layer of inderection.
* generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount,
- Tcl_DbDecrRefCount, Tcl_DbIsShared):
- Define ThreadSpecificData that contains a hashtable.
- The table is used to ensure that a Tcl_Obj is only
- acted upon in the thread that allocated it. This
- checking code is enabled only when mem debug and
- threads are enabled.
+ (Tcl_DbDecrRefCount, Tcl_DbIsShared): Define ThreadSpecificData that
+ contains a hashtable. The table is used to ensure that a Tcl_Obj is
+ only acted upon in the thread that allocated it. This checking code is
+ enabled only when mem debug and threads are enabled.
2003-07-24 Don Porter <dgp@users.sourceforge.net>
- * tests/async.test: Added several tests that demonstrate Tcl
- * tests/basic.test: Bug 489537, Tcl's longstanding failure to
- * tests/dict.test: properly quote any leading '#' character
- * tests/dstring.test: when generating the string rep of a list
- * tests/list.test: so that the comment-power of that character
- * tests/parse.test: is hidden from any [eval], in order to
- * tests/util.test: satisfy the documentation that [list] does
- [eval]-safe quoting.
+ * tests/async.test: Added several tests that demonstrate [Bug
+ * tests/basic.test: 489537], Tcl's longstanding failure to
+ * tests/dict.test: properly quote any leading '#' character when
+ * tests/dstring.test: generating the string rep of a list so that
+ * tests/list.test: the comment-power of that character is hidden
+ * tests/parse.test: from any [eval], in order to satisfy the
+ * tests/util.test: documentation that [list] does [eval]-safe
+ quoting.
2003-07-24 Reinhard Max <max@suse.de>
@@ -1069,12 +1048,12 @@
* ChangeLog.2002 (new file):
* ChangeLog: broke changes from 2002 into ChangeLog.2002 to reduce
- size of the main ChangeLog.
+ size of the main ChangeLog.
2003-07-23 Daniel Steffen <das@users.sourceforge.net>
- * unix/Makefile.in: changes to html-tcl & html-tk
- targets for compatibility with non-gnu makes.
+ * unix/Makefile.in: changes to html-tcl & html-tk targets for
+ compatibility with non-gnu makes.
* unix/Makefile.in: added macosx/README to dist target.
@@ -1086,48 +1065,41 @@
2003-07-21 Mo DeJong <mdejong@users.sourceforge.net>
- Check that the thread incrementing or decrementing
- the ref count of a Tcl_Obj is the thread that
- originally allocated the thread. This fail fast
- behavior will catch programming errors that
- allow a single Tcl_Obj to be accessed from multiple
- threads.
-
- * generic/tcl.h (Tcl_Obj): Add allocThread member
- to Tcl_Obj. This member records the thread id the
- Tcl_Obj was allocated. It is used to check that
- any future ref count incr or decr is done from
- the same thread that allocated the Tcl_Obj.
- This member is defined only when threads and
- mem debug are enabled.
- * generic/tclInt.h (TclNewObj, TclDbNewObj,
- TclDecrRefCount):
- Define TclNewObj and TclDbNewObj using TclDbInitNewObj
- when mem debug is enabled. This fixes a problem where
- TclNewObj calls did not work the same as TclDbNewObj
- when mem debug was enabled.
+ Check that the thread incrementing or decrementing the ref count of a
+ Tcl_Obj is the thread that originally allocated the thread. This fail
+ fast behavior will catch programming errors that allow a single
+ Tcl_Obj to be accessed from multiple threads.
+
+ * generic/tcl.h (Tcl_Obj): Add allocThread member to Tcl_Obj. This
+ member records the thread id the Tcl_Obj was allocated. It is used to
+ check that any future ref count incr or decr is done from the same
+ thread that allocated the Tcl_Obj. This member is defined only when
+ threads and mem debug are enabled.
+ * generic/tclInt.h (TclNewObj, TclDbNewObj, TclDecrRefCount):
+ Define TclNewObj and TclDbNewObj using TclDbInitNewObj when mem debug
+ is enabled. This fixes a problem where TclNewObj calls did not work
+ the same as TclDbNewObj when mem debug was enabled.
* generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount,
- Tcl_DbDecrRefCount): Add new helper to init Tcl_Obj
- members when mem debug is enabled. Init the allocThread
- member in TclDbInitNewObj and check it in
- Tcl_DbIncrRefCount and Tcl_DbDecrRefCount to make sure
- a Tcl_Obj allocated in one thread is not being acted
- upon in another thread.
+ (Tcl_DbDecrRefCount): Add new helper to init Tcl_Obj members when mem
+ debug is enabled. Init the allocThread member in TclDbInitNewObj and
+ check it in Tcl_DbIncrRefCount and Tcl_DbDecrRefCount to make sure a
+ Tcl_Obj allocated in one thread is not being acted upon in another
+ thread.
2003-07-21 Vince Darley <vincentdarley@users.sourceforge.net>
- * test/cmdAH.test: ensure certain tests run in local filesystem
- [Bug 748960]
+ * test/cmdAH.test: ensure certain tests run in local filesystem. [Bug
+ 748960]
2003-07-18 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Makefile: added option to allow installing manpages
- in addition to default html help.
+ * macosx/Makefile: added option to allow installing manpages in
+ addition to default html help.
2003-07-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/Utf.3: Tightened up documentation of Tcl_UtfNext and
- Tcl_UtfPrev to better match the behaviour. [Bug 769895]
+ * doc/Utf.3: Tightened up documentation of Tcl_UtfNext and Tcl_UtfPrev
+ to better match the behaviour. [Bug 769895]
2003-07-18 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1146,18 +1118,18 @@
only in the caller's namespace. Documentation made more precise on
the subject. [Bug 706359]
- * doc/AddErrInfo.3: Improved consistency of documentation
- * doc/CrtTrace.3: by using "null" everywhere to refer to
- * doc/Encoding.3: the character '\0', and using "NULL"
- * doc/Eval.3: everywhere to refer to the value of a
- * doc/GetIndex.3: pointer that points to nowhere.
- * doc/Hash.3: Also dropped references to ASCII that
- * doc/LinkVar.3: are no longer true, and standardized on
- * doc/Macintosh.3: the hyphenated spelling of "null-terminated".
- * doc/OpenFileChnl.3:
- * doc/SetVar.3:
- * doc/StringObj.3:
- * doc/Utf.3:
+ * doc/AddErrInfo.3: Improved consistency of documentation by
+ * doc/CrtTrace.3: using "null" everywhere to refer to the
+ * doc/Encoding.3: character '\0', and using "NULL" everywhere
+ * doc/Eval.3: to refer to the value of a pointer that points
+ * doc/GetIndex.3: to nowhere. Also dropped references to ASCII
+ * doc/Hash.3: that are no longer true, and standardized on
+ * doc/LinkVar.3: the hyphenated spelling of "null-terminated".
+ * doc/Macintosh.3:
+ * doc/OpenFileChnl.3:
+ * doc/SetVar.3:
+ * doc/StringObj.3:
+ * doc/Utf.3:
* doc/CrtSlave.3 (Tcl_MakeSafe): Removed warning about possible
deprecation (no TIP on that).
@@ -1170,17 +1142,16 @@
* macosx/Makefile: Rewrote buildsystem for Mac OS X framework build
to be purely make driven; in order to become independent of Apple's
closed-source IDE and build tool. The changes are intended to be
- transparent to the Makefile user, all existing make targets and
- cmd line variable overrides should continue to work.
- Changed build to only include tcl specific html help in Tcl.framework,
- the tk specific html help is now included in Tk.framework.
- Added var to allow overriding of tclsh used during html help
- building (Landon Fuller).
+ transparent to the Makefile user, all existing make targets and cmd
+ line variable overrides should continue to work. Changed build to only
+ include tcl specific html help in Tcl.framework, the tk specific html
+ help is now included in Tk.framework. Added var to allow overriding of
+ tclsh used during html help building (Landon Fuller).
* macosx/Tcl.pbproj/project.pbxproj:
- * macosx/Tcl.pbproj/jingham.pbxuser: Changed to purely call through
- to the make driven buildsystem; Tcl.framework is no longer assembled
- by ProjectBuilder.
+ * macosx/Tcl.pbproj/jingham.pbxuser: Changed to purely call through to
+ the make driven buildsystem; Tcl.framework is no longer assembled by
+ ProjectBuilder.
Set default SYMROOT in target options to simplify setting up PB
(manually setting common build folder for tcl & tk no longer needed).
@@ -1188,17 +1159,17 @@
tcl or tk html help files; the default behaviour with none of the new
options is to build both, as before.
- * unix/Makefile.in: Added targets for building only the tcl or tk help.
+ * unix/Makefile.in: Added targets for building only the tcl or tk help
- * macosx/README (new): Tcl specific excerpts of tk/macosx/README.
+ * macosx/README (new): Tcl specific excerpts of tk/macosx/README.
* generic/tcl.h: Updated reminder comment about editing
macosx/Tcl.pbproj/project.pbxproj when version number changes.
2003-07-16 Mumit Khan <khan@nanotech.wisc.edu>
- * generic/tclPathObj.c (SetFsPathFromAny): Add Cygwin specific
- code to convert POSIX filename to native format.
+ * generic/tclPathObj.c (SetFsPathFromAny): Add Cygwin specific code to
+ convert POSIX filename to native format.
* generic/tclFileName.c (Tcl_TranslateFileName): And remove from here.
(TclDoGlob): Adjust for cygwin and append / for dirs instead of \
* win/tclWinFile.c (TclpObjChdir): Use chdir on Cygwin.
@@ -1209,12 +1180,12 @@
* library/safe.tcl (FileInAccessPath): normalize paths before
comparison. [Bug 759607] (myers)
- * unix/tclUnixNotfy.c (NotifierThreadProc): correct size of found
- and word vars from int to long. [Bug 767578] (hgo)
+ * unix/tclUnixNotfy.c (NotifierThreadProc): correct size of found and
+ word vars from int to long. [Bug 767578] (hgo)
- * generic/tcl.h: add recognition of -DTCL_UTF_MAX=6 on the
- * generic/regcustom.h: make line to support UCS-4 mode. No config
- arg at this time, as it is not the recommended build mode.
+ * generic/tcl.h: Add recognition of -DTCL_UTF_MAX=6 on the make
+ * generic/regcustom.h: line to support UCS-4 mode. No config arg at
+ this time, as it is not the recommended build mode.
* generic/tclPreserve.c: In Result and Preserve'd routines, do not
* generic/tclUtil.c: assume that ckfree == free, as that is not
@@ -1223,8 +1194,8 @@
2003-07-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/CrtSlave.3 (Tcl_MakeSafe): Updated documentation to strongly
- discourage use. IMHO code outside the core that uses this
- function is a bug... [Bug 655300]
+ discourage use. IMHO code outside the core that uses this function is
+ a bug... [Bug 655300]
2003-07-16 Don Porter <dgp@users.sourceforge.net>
@@ -1234,13 +1205,13 @@
Silence compiler warnings about unreached lines.
* library/tcltest/tcltest.tcl (ProcessFlags): Corrected broken call
- * library/tcltest/pkgIndex.tcl: to [lrange]. Bumped
- to version 2.2.4. [Bug 772333]
+ * library/tcltest/pkgIndex.tcl: to [lrange]. Bumped to
+ version 2.2.4. [Bug 772333]
2003-07-15 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/dltest/pkga.c (Pkga_EqObjCmd): Fix typo
- that was causing a crash in load.test.
+ * unix/dltest/pkga.c (Pkga_EqObjCmd): Fix typo that was causing a
+ crash in load.test.
2003-07-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1248,20 +1219,20 @@
2003-07-15 Don Porter <dgp@users.sourceforge.net>
- * doc/http.n: Updated SYNOPSIS to match actual syntax of
- commands. [Bug 756112]
+ * doc/http.n: Updated SYNOPSIS to match actual syntax of commands.
+ [Bug 756112]
* unix/dltest/pkga.c: Updated to not use Tcl_UtfNcmp and counted
- strings instead of strcmp (not defined in any #include'd header)
- and presumed NULL-terminated strings.
+ strings instead of strcmp (not defined in any #include'd header) and
+ presumed NULL-terminated strings.
- * generic/tclCompCmds.c (TclCompileIfCmd): Prior fix of Bug 711371
- on 2003-04-07 introduced a buffer overflow. Corrected. [Bug 771613]
+ * generic/tclCompCmds.c (TclCompileIfCmd): Prior fix of Bug 711371 on
+ 2003-04-07 introduced a buffer overflow. Corrected. [Bug 771613]
2003-07-15 Kevin B. Kenny <kennykb@acm.org>
- * win/rules.vc: Added a missing $(OPTDEFINES) which broke the
- build if STATS=memdbg was specified.
+ * win/rules.vc: Added a missing $(OPTDEFINES) which broke the build if
+ STATS=memdbg was specified.
2003-07-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1270,16 +1241,16 @@
2003-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/binary.test (binary-46.*): Tests to help enforce the
- current behaviour.
+ * tests/binary.test (binary-46.*): Tests to help enforce the current
+ behaviour.
* doc/binary.n: Documented that [binary format a] and [binary scan a]
- do encoding conversion by dropping high bytes, unlike the rest of
- the core. [Bug 735364]
+ do encoding conversion by dropping high bytes, unlike the rest of the
+ core. [Bug 735364]
2003-07-11 Don Porter <dgp@users.sourceforge.net>
* library/package.tcl: Corrected [pkg_mkIndex] bug reported on
- comp.lang.tcl. The indexer was searching for newly indexed packages
+ comp.lang.tcl. The indexer was searching for newly indexed packages
instead of newly provided packages.
2003-07-08 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -1302,15 +1273,14 @@
filesystems. [Patch 760768] Also a little general cleanup.
* generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept
- dictionaries for maps. This is much trickier than it looks, since
- map entry ordering is significant. [Bug 759936]
+ dictionaries for maps. This is much trickier than it looks, since map
+ entry ordering is significant. [Bug 759936]
- * generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array
- get] and [array set] work with dictionaries, producing them and
- consuming them. Note that for compatability reasons, you will
- never get a dict from feeding a string literal to [array set]
- since that alters the trace behaviour of "multi-key" sets.
- [Bug 759935]
+ * generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
+ and [array set] work with dictionaries, producing them and consuming
+ them. Note that for compatability reasons, you will never get a dict
+ from feeding a string literal to [array set] since that alters the
+ trace behaviour of "multi-key" sets. [Bug 759935]
2003-06-23 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -1330,16 +1300,15 @@
2003-06-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclTrace.c: New file, factoring out of virtually all the
- various trace-related things from tclBasic.c and tclCmdMZ.c with
- the goal of making this a separate maintenance area.
+ various trace-related things from tclBasic.c and tclCmdMZ.c with the
+ goal of making this a separate maintenance area.
2003-06-25 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add -ieee when
- compiling with cc and add -mieee when compiling
- with gcc under OSF1-V5 "Tru64" systems.
- [Bug 748957]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add -ieee when compiling with cc and
+ add -mieee when compiling with gcc under OSF1-V5 "Tru64" systems. [Bug
+ 748957]
2003-06-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -1353,15 +1322,14 @@
2003-06-24 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/tclUnixPort.h: #undef inet_ntoa before
- #define to avoid compiler warning under freebsd.
- [Bug 745844]
+ * unix/tclUnixPort.h: #undef inet_ntoa before #define to avoid
+ compiler warning under freebsd. [Bug 745844]
2003-06-23 Pat Thoyts <patthoyts@users.sourceforge.net>
* doc/dde.n: Committed TIP #135 which changes the
- * win/tclWinDde.c: -exact option to -force. Also cleaned
- * tests/winDde.test: a bug in the tests.
+ * win/tclWinDde.c: -exact option to -force. Also cleaned a
+ * tests/winDde.test: bug in the tests.
* library/dde/pkgIndex.tcl: Incremented version to 1.2.5
* doc/dde.n: Committed TIP #120 which provides the
@@ -1371,70 +1339,70 @@
2003-06-23 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclFCmd.c: fix to bad error message when trying to
- do 'file copy foo ""'. [Bug 756951]
+ * generic/tclFCmd.c: fix to bad error message when trying to do 'file
+ copy foo ""'. [Bug 756951]
* tests/fCmd.test: added two new tests for the bug.
* win/tclWinFile.c:
- * win/tclWin32Dll.c: recommitted some filesystem globbing
- speed-ups, but disabled some on the older Win 95/98/ME where
- they don't seem to work.
+ * win/tclWin32Dll.c: recommitted some filesystem globbing speed-ups,
+ but disabled some on the older Win 95/98/ME where they don't seem to
+ work.
* doc/FileSystem.3: documentation fix [Bug 720634]
2003-06-18 Miguel Sofer <msofer@users.sf.net>
- * generic/tclNamesp.c (Tcl_Export): removed erroneous comments
- [Bug 756744]
+ * generic/tclNamesp.c (Tcl_Export): removed erroneous comments. [Bug
+ 756744]
2003-06-17 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/makefile.vc: fixes to check-in below so compilation now
- works again on Windows.
+ * win/makefile.vc: fixes to check-in below so compilation now works
+ again on Windows.
* generic/tclCmdMZ.c:
* tests/regexp.test: fixing of bugs related to regexp and regsub
- matching of empty strings. Addition of a number of new tests.
- [Bug 755335]
+ matching of empty strings. Addition of a number of new tests. [Bug
+ 755335]
2003-06-16 Andreas Kupries <andreask@activestate.com>
- * win/Makefile.in: Haven't heard back from David for a week.
- * win/configure: Now committing the remaining changes.
- * win/configure.in: Note: In active contact with Helmut Giese
- * win/makefile.vc: about the borland relatedchanges. This part
- * win/rules.vc: will see future updates.
- * win/tcl.m4:
+ * win/Makefile.in: Haven't heard back from David for a week. Now
+ * win/configure: committing the remaining changes.
+ * win/configure.in: Note: In active contact with Helmut Giese about
+ * win/makefile.vc: the borland relatedchanges. This part will see
+ * win/rules.vc: future updates.
+ * win/tcl.m4:
* win/makefile.bc:
2003-06-10 Andreas Kupries <andreask@activestate.com>
* generic/tclConfig.c (ASSOC_KEY): Changed the key to
- "tclPackageAboutDict" (tcl prefix) to make collisions with the
- keys of other packages more unlikely.
+ "tclPackageAboutDict" (tcl prefix) to make collisions with the keys of
+ other packages more unlikely.
2003-06-10 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c:
* generic/tclExecute.c: let TclExecuteObjvInternal call
- TclInterpReady instead of relying on its callers to do so; fix for
- the part of [Bug 495830] that is new in 8.4.
+ TclInterpReady instead of relying on its callers to do so; fix for the
+ part of [Bug 495830] that is new in 8.4.
* tests/interp.test: Added tests 18.9 (knownbug) and 18.10
2003-06-09 Andreas Kupries <andreask@activestate.com>
* generic/tcl.decls: Ported the changes from the
* generic/tcl.h: 'tip-59-implementation' branch into the CVS
- * generic/tclBasic.c: head. Regenerated stub table. Regenerated
- * generic/tclInt.h: the configure's scripts, with help from Joe
- * generic/tclDecls.h English.
+ * generic/tclBasic.c: head. Regenerated stub table. Regenerated the
+ * generic/tclInt.h: configure's scripts, with help from Joe English.
+ * generic/tclDecls.h:
* generic/tclStubInit.c:
* generic/tclConfig.c:
* generic/tclPkgConfig.c:
- * unix/Makefile.in:
- * unix/configure.in: The changes in the windows section are not
- * unix/tcl.m4: yet committed, they await feedback from
- * unix/mkLinks: David Gravereaux.
+ * unix/Makefile.in:
+ * unix/configure.in: The changes in the windows section are not yet
+ * unix/tcl.m4: committed, they await feedback from David
+ * unix/mkLinks: Gravereaux.
* doc/RegConfig.3:
* mac/tclMacPkgConfig.c:
* tests/config.test:
@@ -1447,17 +1415,16 @@
2003-06-04 Joe Mistachkin <joe@mistachkin.com>
- * tools/man2help.tcl: Added duplicate help section checking
- * tools/index.tcl: and corrected a comment typo for the
- getTopics proc in index.tcl [Bug #748700].
+ * tools/man2help.tcl: Added duplicate help section checking and
+ * tools/index.tcl: corrected a comment typo for the getTopics proc
+ in index.tcl. [Bug 748700]
2003-06-02 Vince Darley <vincentdarley@users.sourceforge.net>
* win/tclWinFCmd.c:
- * tests/fCmd.test: fix to [Bug #747575] in which a bad error
- message is given when trying to rename a busy directory to
- one with the same prefix, but not the same name. Added three
- new tests.
+ * tests/fCmd.test: fix to [Bug #747575] in which a bad error message
+ is given when trying to rename a busy directory to one with the same
+ prefix, but not the same name. Added three new tests.
2003-05-23 D. Richard Hipp <drh@hwaci.com>
@@ -1467,30 +1434,28 @@
2003-05-23 Don Porter <dgp@users.sourceforge.net>
* generic/tclObj.c (tclCmdNameType): Converted internal rep
- management of the cmdName Tcl_ObjType the opposite way, to always
- use the twoPtrValue instead of always using the otherValuePtr.
- Previous fix on 2003-05-12 broke several extensions that wanted
- to poke around with the twoPtrValue.ptr2 value of a cmdName
- Tcl_Obj, like TclBlend and e4graph. [Bug 726018]
- Thanks to George Petasis for the bug report and Jacob Levy for
- testing assistance.
+ management of the cmdName Tcl_ObjType the opposite way, to always use
+ the twoPtrValue instead of always using the otherValuePtr. Previous
+ fix on 2003-05-12 broke several extensions that wanted to poke around
+ with the twoPtrValue.ptr2 value of a cmdName Tcl_Obj, like TclBlend
+ and e4graph. [Bug 726018]
+ Thanks to George Petasis for the bug report and Jacob Levy for testing
+ assistance.
2003-05-23 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/mkLinks: Set the var S to "" at the top
- of the file to avoid error when user has set S
- to something.
- [Tk Bug #739833]
+ * unix/mkLinks: Set the var S to "" at the top of the file to avoid
+ error when user has set S to something. [Tk Bug 739833]
2003-05-22 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Tcl.pbproj/project.pbxproj: added missing references to
- new source files tclPathObj.c and tclMacOSXFCmd.c.
+ * macosx/Tcl.pbproj/project.pbxproj: added missing references to new
+ source files tclPathObj.c and tclMacOSXFCmd.c.
- * macosx/tclMacOSXBundle.c: fixed a problem that caused only the
- first call to Tcl_MacOSXOpenVersionedBundleResources() for a given
- bundle identifier to succeed. This caused the tcl runtime library
- not to be found in all interps created after the inital one.
+ * macosx/tclMacOSXBundle.c: fixed a problem that caused only the first
+ call to Tcl_MacOSXOpenVersionedBundleResources() for a given bundle
+ identifier to succeed. This caused the tcl runtime library not to be
+ found in all interps created after the inital one.
2003-05-19 Kevin B. Kenny <kennykb@hippolyta>
@@ -1499,31 +1464,30 @@
2003-05-19 Daniel Steffen <das@users.sourceforge.net>
- * macosx/Tcl.pbproj/project.pbxproj: changed tclConfig.sh location
- in versioned framework subdirectories to be identical to location
- in framework toplevel; fixed stub library symbolic links to be
- tcl version specific.
+ * macosx/Tcl.pbproj/project.pbxproj: changed tclConfig.sh location in
+ versioned framework subdirectories to be identical to location in
+ framework toplevel; fixed stub library symbolic links to be tcl
+ version specific.
* unix/tclUnixTime.c: fixed typo.
2003-05-18 Kevin Kenny <kennykb@acm.org>
- * compat/strftime.c: Modified TclpStrftime to return its
- * generic/tclClock.c: result in UTF-8 encoding, and removed
- * mac/tclMacTime.c: the conversion from system encoding to
- * unix/tclUnixTime.c: UTF-8 from [clock format]. Needed to
- * win/tclWinTime.c: avoid double conversion of the timezone
- name on Windows systems. [Bug 624408]
+ * compat/strftime.c: Modified TclpStrftime to return its result in
+ * generic/tclClock.c: UTF-8 encoding, and removed the conversion from
+ * mac/tclMacTime.c: system encoding to UTF-8 from [clock format].
+ * unix/tclUnixTime.c: Needed to avoid double conversion of the
+ * win/tclWinTime.c: timezone name on Windows systems. [Bug 624408]
2003-05-16 Pat Thoyts <patthoyts@users.sourceforge.net>
- * library/dde/pkgIndex.tcl: Applied TIP #130 which provides
- * tests/winDde.test: for unique dde server names. Added
- * win/tclWinDde.c: some more tests. Fixes [Bug 219293]
+ * library/dde/pkgIndex.tcl: Applied TIP #130 which provides for
+ * tests/winDde.test: unique dde server names. Added some more
+ * win/tclWinDde.c: tests. Fixes [Bug 219293]
* doc/dde.n: Updated documentation re TIP #130.
- * tests/winDde.test: Applied patch for [Bug 738929] by KKB and
- changed to new-style tests.
+ * tests/winDde.test: Applied patch for [Bug 738929] by KKB and changed
+ to new-style tests.
2003-05-16 Kevin B. Kenny <kennykb@acm.org>
@@ -1536,33 +1500,33 @@
2003-05-15 Kevin B. Kenny <kennykb@acm.org>
* generic/tclGetDate.y: added further hackery to the yacc
- * generic/tclDate.c: post-processing to arrange for the
- * unix/Makefile.in: code to set up exit handlers to free
- the stacks [Bug 736425].
+ * generic/tclDate.c: post-processing to arrange for the code to set
+ * unix/Makefile.in: up exit handlers to free the stacks. [Bug
+ 736425]
2003-05-15 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinFile.c (TclpMatchInDirectory): revert glob code to
- r1.44 as 2003-04-11 optimizations broke Windows98 glob'ing.
+ * win/tclWinFile.c (TclpMatchInDirectory): revert glob code to r1.44
+ as 2003-04-11 optimizations broke Windows98 glob'ing.
* doc/socket.n: nroff font handling correction
* library/encoding/gb2312-raw.enc (new): This is the original
- gb2312.enc renamed to allow for it to still be used. This is
- needed by Tk (unix) because X fonts with gb2312* charsets really
- do want the original gb2312 encoding. [Bug 557030]
+ gb2312.enc renamed to allow for it to still be used. This is needed by
+ Tk (unix) because X fonts with gb2312* charsets really do want the
+ original gb2312 encoding. [Bug 557030]
2003-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop unwarranted demotion
- of wide values to longs by formatting of int values. [Bug 699060]
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop unwarranted demotion of
+ wide values to longs by formatting of int values. [Bug 699060]
2003-05-14 Jeff Hobbs <jeffh@ActiveState.com>
* library/encoding/gb2312.enc: copy euc-cn.enc over original
- gb2312.enc. gb2312.enc appeared to not work as expected, and most
- uses of gb2312 really mean euc-cn (which may be the cause of the
- problem). [Bug 557030]
+ gb2312.enc. gb2312.enc appeared to not work as expected, and most uses
+ of gb2312 really mean euc-cn (which may be the cause of the problem).
+ [Bug 557030]
2003-05-14 Daniel Steffen <das@users.sourceforge.net>
@@ -1602,50 +1566,48 @@
* tests/unixFCmd.test: added tests of -readonly attribute.
- * tests/macOSXFCmd.test (new): tests of macosx file attributes and
- of preservation of attributes & resource fork during [file copy].
+ * tests/macOSXFCmd.test (new): tests of macosx file attributes and of
+ preservation of attributes & resource fork during [file copy].
* tests/macFCmd.test: restore -readonly attribute of test dir, as
otherwise its removal can fail on unices supporting -readonly.
2003-05-13 David Gravereaux <davygrvy@pobox.com>
- * generic/tclEnv.c: Another putenv() copy behavior problem
- repaired when compiling on windows and using microsoft's runtime.
- [Bug 736421]
+ * generic/tclEnv.c: Another putenv() copy behavior problem repaired
+ when compiling on windows and using microsoft's runtime. [Bug 736421]
2003-05-13 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclIOUtil.c: ensure cd is thread-safe.
- [Bug #710642] (vasiljevic)
+ [Bug 710642] (vasiljevic)
2003-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclEvent.c (Tcl_Finalize): Removed unused variable to
- reduce compiler warnings. [Bug 664745]
+ * generic/tclEvent.c (Tcl_Finalize): Removed unused variable to reduce
+ compiler warnings. [Bug 664745]
2003-05-13 Joe Mistachkin <joe@mistachkin.com>
* generic/tcl.decls: Changed Tcl_JoinThread parameter name from
* generic/tclDecls.h: "id" to "threadId". [Bug 732477]
* unix/tclUnixThrd.c:
- * win/tclWinThrd.c:
+ * win/tclWinThrd.c:
* mac/tclMacThrd.c:
2003-05-13 Daniel Steffen <das@users.sourceforge.net>
* generic/tcl.decls:
- * macosx/tclMacOSXBundle.c: added extended version of the
+ * macosx/tclMacOSXBundle.c: added extended version of the
Tcl_MacOSXOpenBundleResources() API taking an extra version number
- argument: Tcl_MacOSXOpenVersionedBundleResources().
- This is needed to be able to access bundle resources in versioned
- frameworks such as Tcl and Tk, otherwise if multiple versions were
- installed, only the latest version's resources could be accessed.
- [Bug 736774]
+ argument: Tcl_MacOSXOpenVersionedBundleResources(). This is needed to
+ be able to access bundle resources in versioned frameworks such as Tcl
+ and Tk, otherwise if multiple versions were installed, only the latest
+ version's resources could be accessed. [Bug 736774]
* unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): use new versioned
- bundle resource API to get tcl runtime library for TCL_VERSION.
- [Bug 736774]
+ bundle resource API to get tcl runtime library for TCL_VERSION. [Bug
+ 736774]
* generic/tclPlatDecls.h:
* generic/tclStubInit.c: regen.
@@ -1658,13 +1620,13 @@
* tests/cmdAH.test: General clean-up of tests so that all
tcltest-specific commands are protected by constraints and all
- platforms see the same number of tests. [Bug 736431]
+ platforms see the same number of tests. [Bug 736431]
2003-05-12 Don Porter <dgp@users.sourceforge.net>
* generic/tclInterp.c: (AliasObjCmd): Added refCounting of the words
* tests/interp.test (interp-33.1): of the target of an interp
- alias during its execution. Also added test. [Bug 730244].
+ alias during its execution. Also added test. [Bug 730244]
* generic/tclBasic.c (TclInvokeObjectCommand): objv[argc] is no
longer set to NULL (Tcl_CreateObjCommand docs already say that it
@@ -1674,7 +1636,7 @@
* generic/tclObj.c (tclCmdNameType): Corrected variable use of the
otherValuePtr or the twoPtrValue.ptr1 fields to store a
- (ResolvedCmdName *) as the internal rep. [Bug 726018].
+ (ResolvedCmdName *) as the internal rep. [Bug 726018]
* doc/Eval.3: Corrected prototype for Tcl_GlobalEvalObj [Bug 727622].
@@ -1686,26 +1648,26 @@
2003-05-10 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinSerial.c (SerialCloseProc): correct mem leak on
- closing a Windows serial port [Bug #718002] (schroedter)
+ * win/tclWinSerial.c (SerialCloseProc): correct mem leak on closing a
+ Windows serial port [Bug 718002] (schroedter)
- * generic/tclCmdMZ.c (Tcl_StringObjCmd): prevent string repeat
- crash when overflow sizes were given (throws error). [Bug #714106]
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): prevent string repeat crash
+ when overflow sizes were given (throws error). [Bug 714106]
2003-05-09 Joe Mistachkin <joe@mistachkin.com>
* generic/tclThreadAlloc.c (TclFreeAllocCache): Fixed memory leak
- caused by treating cachePtr as a TLS index [Bug 731754].
+ caused by treating cachePtr as a TLS index. [Bug 731754]
* win/tclAppInit.c (Tcl_AppInit): Fixed memory leaks caused by not
freeing the memory allocated by setargv and the async handler created
by Tcl_AppInit. An exit handler has been created that takes care of
both leaks. In addition, Tcl_AppInit now uses ckalloc instead of
Tcl_Alloc to allow for easier leak tracking and to be more consistent
- with the rest of the Tcl core [Bugs 733156, 733221].
+ with the rest of the Tcl core. [Bugs 733156, 733221]
* tools/encoding/txt2enc.c (main): Fixed memory leak caused by failing
- to free the memory used by the toUnicode array of strings [Bug 733221].
+ to free the memory used by the toUnicode array of strings [Bug 733221]
2003-05-09 Miguel Sofer <msofer@users.sf.net>
@@ -1716,17 +1678,17 @@
2003-05-09 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdMZ.c (Tcl_ReturnObjCmd): The array of strings
- passed to Tcl_GetIndexFromObj must be NULL terminated. [Bug 735186]
+ * generic/tclCmdMZ.c (Tcl_ReturnObjCmd): The array of strings passed
+ to Tcl_GetIndexFromObj must be NULL terminated. [Bug 735186]
Thanks to Joe Mistachkin for spotting this.
2003-05-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/trace.n: Fixed very strange language in the documentation
- for 'trace add execution'. [Bug 729821]
+ * doc/trace.n: Fixed very strange language in the documentation for
+ 'trace add execution'. [Bug 729821]
- * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Made error message for
- 'trace info' more consistent with documentation. [Bug 706961]
+ * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Made error message for 'trace
+ info' more consistent with documentation. [Bug 706961]
* generic/tclDictObj.c (DictInfoCmd): Fixed memory leak caused by
confusion about string ownership. [Bug 731706]
@@ -1755,89 +1717,85 @@
2003-04-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclDictObj.c (DictIncrCmd): Updated to reflect the
- behaviour with wide increments of the normal [incr] command.
- * generic/tclInt.decls: Added TclIncrWideVar2 to internal stub
- table and cleaned up.
+ * generic/tclDictObj.c (DictIncrCmd): Updated to reflect the behaviour
+ with wide increments of the normal [incr] command.
+ * generic/tclInt.decls: Added TclIncrWideVar2 to internal stub table
+ and cleaned up.
* tests/incr.test (incr-3.*):
- * generic/tclVar.c (TclIncrWideVar2, TclPtrIncrWideVar):
- * generic/tclExecute.c (TclExecuteByteCode):
- * generic/tclCmdIL.c (Tcl_IncrObjCmd): Make [incr] work when
- trying to increment by wide values. [Bug 728838]
+ * generic/tclVar.c (TclIncrWideVar2, TclPtrIncrWideVar):
+ * generic/tclExecute.c (TclExecuteByteCode):
+ * generic/tclCmdIL.c (Tcl_IncrObjCmd): Make [incr] work when trying to
+ increment by wide values. [Bug 728838]
* generic/tclCompCmds.c (TclCompileSwitchCmd): Default mode of
- operation of [switch] is exact matching. [Bug 727563]
+ operation of [switch] is exact matching. [Bug 727563]
2003-04-25 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: Tcl_EvalObjv() failed to honor the
- TCL_EVAL_GLOBAL flag when resolving command names. Tcl_EvalEx
- passed a string rep including leading whitespace and comments
- to TclEvalObjvInternal().
+ TCL_EVAL_GLOBAL flag when resolving command names. Tcl_EvalEx passed a
+ string rep including leading whitespace and comments to
+ TclEvalObjvInternal().
2003-04-25 Andreas Kupries <andreask@activestate.com>
- * win/tclWinThrd.c: Applied SF patch #727271. This patch changes
- the code to catch any errors returned by the windows functions
- handling TLS ASAP instead of waiting to get some mysterious
- crash later on due to bogus pointers. Patch provided by Joe
- Mistachkin.
+ * win/tclWinThrd.c: Applied SF patch #727271. This patch changes the
+ code to catch any errors returned by the windows functions handling
+ TLS ASAP instead of waiting to get some mysterious crash later on due
+ to bogus pointers. Patch provided by Joe Mistachkin.
- This is a stop-gap measure to deal with the low number of ?TLS
- slots provided by some of the variants of Windows (60-80).
+ This is a stop-gap measure to deal with the low number of ?TLS slots
+ provided by some of the variants of Windows (60-80).
2003-04-24 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclFileName.c: fix to bug reported privately by
- Jeff where, for example, 'glob -path {[tcl]} *' gets confused
- by the leading special character (which is escaped internally),
- and instead lists files in '/'. Bug only occurs on Windows
- where '\' is also a directory separator.
+ * generic/tclFileName.c: fix to bug reported privately by Jeff where,
+ for example, 'glob -path {[tcl]} *' gets confused by the leading
+ special character (which is escaped internally), and instead lists
+ files in '/'. Bug only occurs on Windows where '\' is also a directory
+ separator.
* tests/fileName.test: added test for the above bug.
2003-04-22 Andreas Kupries <andreask@activestate.com>
* The changes below fix SF bugs [593810], and [718045].
- * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel):
- Invoke TclpCutSockChannel and TclpSpliceSockChannel.
+ * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke
+ TclpCutSockChannel and TclpSpliceSockChannel.
* generic/tclInt.h: Declare TclpCutSockChannel and
- TclpSpliceSockChannel.
+ TclpSpliceSockChannel.
* unix/tclUnixSock.c (TclpCutSockChannel, TclpSpliceSockChannel):
- Dummy functions, on unix the sockets are _not_ handled
- specially.
+ Dummy functions, on unix the sockets are _not_ handled specially.
* mac/tclMacSock.c (TclpCutSockChannel, TclpSpliceSockChannel):
- * win/tclWinSock.c (TclpCutSockChannel, TclpSpliceSockChannel):
- New functions to handle socket specific cut/splice operations:
- auto-initi of socket system for thread on splice, management of
- the module internal per-thread list of sockets, management of
- association of sockets with HWNDs for event notification.
+ * win/tclWinSock.c (TclpCutSockChannel, TclpSpliceSockChannel): New
+ functions to handle socket specific cut/splice operations: auto-init
+ of socket system for thread on splice, management of the module
+ internal per-thread list of sockets, management of association of
+ sockets with HWNDs for event notification.
* win/tclWinSock.c (NewSocketInfo): Extended initialization
- assignments to cover all items of the structure. During
- debugging of the new code mentioned above I found that two
- fileds could contain bogus data.
+ assignments to cover all items of the structure. During debugging of
+ the new code mentioned above I found that two fileds could contain
+ bogus data.
* win/tclWinFile.c: Added #undef HAVE_NO_FINDEX_ENUMS before
- definition because when compiling in debug mode the compiler
- complains about a redefinition, and this warning is also treated
- as an error.
+ definition because when compiling in debug mode the compiler complains
+ about a redefinition, and this warning is also treated as an error.
2003-04-21 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: When the return code of a test does
- not meet expectations, report that as the reason for test failure,
- and do not attempt to check the test result for correctness.
- [Bug 725253]
+ not meet expectations, report that as the reason for test failure, and
+ do not attempt to check the test result for correctness. [Bug 725253]
2003-04-18 Jeff Hobbs <jeffh@ActiveState.com>
* win/tclWinInt.h (VER_PLATFORM_WIN32_CE): conditionally define.
- * win/tclWinInit.c: recognize Windows CE as a Win platform.
- This just recognizes CE - full support will come later.
+ * win/tclWinInit.c: recognize Windows CE as a Win platform. This just
+ recognizes CE - full support will come later.
* win/configure: regen
* win/configure.in (SHELL): force it to /bin/sh as autoconf 2.5x
@@ -1848,26 +1806,26 @@
2003-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/open.n: Moved serial port options from [fconfigure]
- * doc/fconfigure.n: to [open] as it is up to the creator of a
- channel to describe the channel's special
- config options. [Bug 679010]
+ * doc/open.n: Moved serial port options from [fconfigure] to
+ * doc/fconfigure.n: [open] as it is up to the creator of a channel
+ to describe the channel's special config
+ options. [Bug 679010]
2003-04-16 Don Porter <dgp@users.sourceforge.net>
* generic/tcl.h: Made changes so that the "wideInt" Tcl_ObjType
* generic/tclObj.c: is defined on all platforms, even those where
- * generic/tclPort.h: TCL_WIDE_INT_IS_LONG is defined. Also made
- the Tcl_Value struct have a wideValue field on all platforms. This is
- a ***POTENTIAL INCOMPATIBILITY*** for TCL_WIDE_INT_IS_LONG platforms
- because that struct changes size. This is the same TIP 72
+ * generic/tclPort.h: TCL_WIDE_INT_IS_LONG is defined. Also made the
+ Tcl_Value struct have a wideValue field on all platforms. This is a
+ ***POTENTIAL INCOMPATIBILITY*** for TCL_WIDE_INT_IS_LONG platforms
+ because that struct changes size. This is the same TIP 72
incompatibility that was seen on other platforms at the 8.4.0 release,
- when this change should have happened as well. [Bug 713562]
+ when this change should have happened as well. [Bug 713562]
* generic/tclInt.h: New internal macros TclGetWide() and
TclGetLongFromWide() to deal with both forms of the "wideInt"
- Tcl_ObjType, so that conditional TCL_WIDE_INT_IS_LONG code
- is confined to the header file.
+ Tcl_ObjType, so that conditional TCL_WIDE_INT_IS_LONG code is confined
+ to the header file.
* generic/tclCmdAH.c: Replaced most coding that was conditional
* generic/tclCmdIL.c: on TCL_WIDE_INT_IS_LONG with code that
@@ -1878,35 +1836,36 @@
2003-04-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/socket.n: Added a paragraph to remind people to specify
- their encodings when using sockets. [Bug 630621]
+ * doc/socket.n: Added a paragraph to remind people to specify their
+ encodings when using sockets. [Bug 630621]
2003-04-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/CrtMathFnc.3: Functions also have to deal with wide ints,
- but this was not documented. [Bug 709720]
+ * doc/CrtMathFnc.3: Functions also have to deal with wide ints, but
+ this was not documented. [Bug 709720]
2003-04-16 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclPathObj.c: removed undesired 'static' for function
- which is now shared (previously it was duplicated).
+ * generic/tclPathObj.c: removed undesired 'static' for function which
+ is now shared (previously it was duplicated).
2003-04-15 Joe English <jenglish@users.sourceforge.net>
- * doc/namespace.n: added example section "SCOPED SCRIPTS",
- supplied by Kevin Kenny. (Fixes [Bug 219183])
+
+ * doc/namespace.n: added example section "SCOPED SCRIPTS", supplied by
+ Kevin Kenny. [Bug 219183]
2003-04-15 Kevin Kenny <kennykb@acm.org>
- * makefile.vc: Updated makefile.vc to conform with Mo DeJong's
- changes to Makefile.in and tclWinPipe.c on 2003-04-14. Now passes
- TCL_PIPE_DLL in place of TCL_DBGX.
+ * makefile.vc: Updated makefile.vc to conform with Mo DeJong's changes
+ to Makefile.in and tclWinPipe.c on 2003-04-14. Now passes TCL_PIPE_DLL
+ in place of TCL_DBGX.
* win/tclWinTime.c: Corrected use of types to make compilation
compatible with VC++5.
2003-04-15 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: finished check-in from yesterday,
- removing duplicate function definition.
+ * generic/tclIOUtil.c: finished check-in from yesterday, removing
+ duplicate function definition.
2003-04-14 Don Porter <dgp@users.sourceforge.net>
@@ -1915,19 +1874,14 @@
2003-04-14 Mo DeJong <mdejong@users.sourceforge.net>
- * win/Makefile.in: Don't define TCL_DBGX
- symbol for every compile. Instead, define
- TCL_PIPE_DLL only when compiling tclWinPipe.c.
- This will break other build systems, so
- they will need to remove the TCL_DBGX define
- and replace it with a define for TCL_PIPE_DLL.
- * win/tclWinPipe.c (TclpCreateProcess):
- Remove PREFIX_IDENT and DEBUG_IDENT from
- top of file. Use TCL_PIPE_DLL passed in
- from build env instead of trying to construct
- the dll name from already defined symbols.
- This approach is more flexible and better
- in the long run.
+ * win/Makefile.in: Don't define TCL_DBGX symbol for every compile.
+ Instead, define TCL_PIPE_DLL only when compiling tclWinPipe.c. This
+ will break other build systems, so they will need to remove the
+ TCL_DBGX define and replace it with a define for TCL_PIPE_DLL.
+ * win/tclWinPipe.c (TclpCreateProcess): Remove PREFIX_IDENT and
+ DEBUG_IDENT from top of file. Use TCL_PIPE_DLL passed in from build
+ env instead of trying to construct the dll name from already defined
+ symbols. This approach is more flexible and better in the long run.
2003-04-14 Kevin Kenny <kennykb@acm.org>
@@ -1936,29 +1890,26 @@
2003-04-14 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c:
- * generic/tclPathObj.c:
- * generic/tclFileSystem.h: overlooked one function which
- was duplicated, so this is now shared between modules.
+ * generic/tclIOUtil.c:
+ * generic/tclPathObj.c:
+ * generic/tclFileSystem.h: overlooked one function which was
+ duplicated, so this is now shared between modules.
* win/tclWinFile.c: allow this file to compile with VC++ 5.2 again
since Mingw build fixes broke that.
2003-04-13 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Add check for FINDEX_INFO_LEVELS
- from winbase.h, known to be a problem in VC++ 5.2.
- Define HAVE_NO_FINDEX_ENUMS if the define does not
- exist.
- * win/tclWinFile.c: Put declarations for
- FINDEX_INFO_LEVELS and FINDEX_SEARCH_OPS inside
- a check for HAVE_NO_FINDEX_ENUMS so that these are
- not declared twice. This fixes the Mingw build.
- * win/tclWinTime.c: Rework the init of timeInfo
- so that the number or initializers matches the
- declaration. This was broken under Mingw. Add
- cast to avoid compile warning when calling the
- AccumulateSample function.
+ * win/configure.in: Add check for FINDEX_INFO_LEVELS from winbase.h,
+ known to be a problem in VC++ 5.2. Define HAVE_NO_FINDEX_ENUMS if the
+ define does not exist.
+ * win/tclWinFile.c: Put declarations for FINDEX_INFO_LEVELS and
+ FINDEX_SEARCH_OPS inside a check for HAVE_NO_FINDEX_ENUMS so that
+ these are not declared twice. This fixes the Mingw build.
+ * win/tclWinTime.c: Rework the init of timeInfo so that the number or
+ initializers matches the declaration. This was broken under Mingw. Add
+ cast to avoid compile warning when calling the AccumulateSample
+ function.
2003-04-12 Jeff Hobbs <jeffh@ActiveState.com>
@@ -1967,76 +1918,73 @@
2003-04-12 Kevin Kenny <kennykb@acm.org>
* doc/clock.n:
- * generic/tclClock.c (Tcl_ClockObjCmd):
- * tests/clock.test: Implementation of TIP #124. Also renumbered
- test cases to avoid duplicates [Bug 710310].
+ * generic/tclClock.c (Tcl_ClockObjCmd):
+ * tests/clock.test: Implementation of TIP #124. Also renumbered test
+ cases to avoid duplicates. [Bug 710310]
* tests/winTime.test:
* win/tclWinTest.c (TestwinclockCmd, TestwinsleepCmd):
* win/tclWinTime.c (Tcl_WinTime, UpdateTimeEachSecond,
- ResetCounterSamples, AccumulateSample,
- SAMPLES, TimeInfo): Made substantial changes
- to the phase-locked loop (replaced an IIR filter with an FIR one)
- in a quest for improved loop stability (Bug not logged at SF, but
- cited in private communication from Jeff Hobbs).
+ (ResetCounterSamples, AccumulateSample, SAMPLES, TimeInfo): Made
+ substantial changes to the phase-locked loop (replaced an IIR filter
+ with an FIR one) in a quest for improved loop stability (Bug not
+ logged at SF, but cited in private communication from Jeff Hobbs).
2003-04-11 Don Porter <dgp@users.sourceforge.net>
* generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT): Corrected
- inconsistent results of [string is integer] observed on systems
- where sizeof(long) != sizeof(int). [Bug 718878]
+ inconsistent results of [string is integer] observed on systems where
+ sizeof(long) != sizeof(int). [Bug 718878]
* tests/string.test: Added tests for Bug 718878.
- * doc/string.n: Clarified that [string is integer] accepts
- 32-bit integers.
+ * doc/string.n: Clarified that [string is integer] accepts 32-bit
+ integers.
2003-04-11 Andreas Kupries <andreask@activestate.com>
* generic/tclIO.c (UpdateInterest): When dropping interest in
- TCL_READABLE now dropping interest in TCL_EXCEPTION too. This
- fixes a bug where Expect detects eof on a file prematurely on
- solaris 2.6 and higher. A much more complete explanation is in
- the code itself (40 lines of comments for a one-line change :)
+ TCL_READABLE now dropping interest in TCL_EXCEPTION too. This fixes a
+ bug where Expect detects eof on a file prematurely on solaris 2.6 and
+ higher. A much more complete explanation is in the code itself (40
+ lines of comments for a one-line change :)
2003-04-11 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/cmdAH.test: fix test suite problem if /home is a symlink
- [Bug #703264]
- * generic/tclIOUtil.c: fix bad error message with 'cd ""'
- [Bug #704917]
- * win/tclWinFile.c:
- * win/tclWin32Dll.c:
- * win/tclWinInt.h: allow Tcl to differentiate between reparse
- points which are symlinks and mounted volumes, and correctly
- handle the latter. This involves some elaborate code to find
- the actual drive letter (if possible) corresponding to a mounted
- volume. [Bug #697862]
- * tests/fileSystem.test: add constraints to stop tests running
- in ordinary tcl interpreter. [Bug #705675]
+ * tests/cmdAH.test: fix test suite problem if /home is a symlink. [Bug
+ 703264]
+ * generic/tclIOUtil.c: fix bad error message with 'cd ""'. [Bug
+ 704917]
+ * win/tclWinFile.c, win/tclWin32Dll.c:
+ * win/tclWinInt.h: allow Tcl to differentiate between reparse points
+ which are symlinks and mounted volumes, and correctly handle the
+ latter. This involves some elaborate code to find the actual drive
+ letter (if possible) corresponding to a mounted volume. [Bug 697862]
+ * tests/fileSystem.test: add constraints to stop tests running in
+ ordinary tcl interpreter. [Bug 705675]
* generic/tclIOUtil.c:
* generic/tclPathObj.c: (new file)
* generic/tclFileSystem.h: (new file)
* win/makefile.vc:
- Split path object handling out of the virtual filesystem layer,
- into tclPathObj.c. This refactoring cleans up the internal
- filesystem code, and will make any future optimisations and
- forthcoming better thread-safety much easier.
+ Split path object handling out of the virtual filesystem layer, into
+ tclPathObj.c. This refactoring cleans up the internal filesystem code,
+ and will make any future optimisations and forthcoming better
+ thread-safety much easier.
* generic/tclTest.c:
- * tests/reg.test: added some 'knownBug' tests for problems in
- Tcl's regexp code with the TCL_REG_CAN_MATCH flag (see Bug #703709).
- Code too impenetrable to fix right now, but a fix is needed
- for tip113 to work correctly.
+ * tests/reg.test: added some 'knownBug' tests for problems in Tcl's
+ regexp code with the TCL_REG_CAN_MATCH flag (see Bug 703709). Code too
+ impenetrable to fix right now, but a fix is needed for tip113 to work
+ correctly.
* tests/fCmd.test
- * win/tclWinFile.c: added some filesystem optimisation to the
- 'glob' implementation, and some new tests.
+ * win/tclWinFile.c: added some filesystem optimisation to the 'glob'
+ implementation, and some new tests.
* generic/tclCmdMZ.c: fix typo in comment
* tests/winFile.test:
* tests/ioUtil.test:
- * tests/unixFCmd.test: renumbered tests with duplicate numbers.
- (Bug #710361)
+ * tests/unixFCmd.test: renumbered tests with duplicate numbers. [Bug
+ 710361]
2003-04-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -2045,8 +1993,8 @@
2003-04-08 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCmdAH.c (Tcl_ErrorObjCmd): Strings are only empty if
- they have zero length, not if their first byte is zero, so fix
- test guarding Tcl_AddObjErrorInfo to take this into account. [Bug
+ they have zero length, not if their first byte is zero, so fix test
+ guarding Tcl_AddObjErrorInfo to take this into account. [Bug
reported by Don Porter; no bug-id.]
2003-04-07 Don Porter <dgp@users.sourceforge.net>
@@ -2066,58 +2014,56 @@
2003-04-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/dict.test (dict-2.6):
+ * tests/dict.test (dict-2.6):
* generic/tclDictObj.c (Tcl_NewDictObj, Tcl_DbNewDictObj): Oops!
Failed to fully initialise the Dict structure.
- (DictIncrCmd): Moved valueAlreadyInDictionary label to stop
- compiler complaints. [Bug 715751]
+ (DictIncrCmd): Moved valueAlreadyInDictionary label to stop compiler
+ complaints. [Bug 715751]
* generic/tclDictObj.c (DictIncrCmd): Followed style in the rest of
- the core by commenting out wide-specific operations on platforms
- where wides are longs, and used longs more thoroughly than ints
- through [dict incr] anyway to forestall further bugs.
+ the core by commenting out wide-specific operations on platforms where
+ wides are longs, and used longs more thoroughly than ints through
+ [dict incr] anyway to forestall further bugs.
* generic/tclObj.c: Made sure there's always a tclWideIntType
- implementation available, not that it is always useful. [Bug 713562]
+ implementation available, not that it is always useful. [Bug 713562]
2003-04-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclDictObj.c: Removed commented out notes on
- declarations to be moved to elsewhere in the Tcl core.
+ * generic/tclDictObj.c: Removed commented out notes on declarations to
+ be moved to elsewhere in the Tcl core.
* generic/tclInt.h: Final stages of plumbing in.
- * generic/tclBasic.c:
- * generic/tclObj.c (TclInitObjSubsystem):
+ * generic/tclBasic.c:
+ * generic/tclObj.c (TclInitObjSubsystem):
* unix/Makefile.in, win/Makefile.in, win/makefile.[bv]c: Build support.
* generic/tcl.decls: Added dict public API to stubs table.
- * generic/tcl.h (Tcl_DictSearch): Added declaration of structure
- to allow user code to iterate over dictionaries.
+ * generic/tcl.h (Tcl_DictSearch): Added declaration of structure to
+ allow user code to iterate over dictionaries.
- * doc/DictObj.3: New files containing dictionary
- * doc/dict.n: implementation, documentation and tests
- * generic/tclDictObj.c: as mandated by TIP #111.
+ * doc/DictObj.3: New files containing dictionary implementation
+ * doc/dict.n: documentation and tests as as mandated by TIP
+ * generic/tclDictObj.c: #111.
* tests/dict.test:
2003-04-03 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure:
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't set
- TCL_LIBS if it is already set to support
- use of TCL_LIBS var from tclConfig.sh in
- the Tk configure script.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't set TCL_LIBS if it is already
+ set to support use of TCL_LIBS var from tclConfig.sh in the Tk
+ configure script.
2003-04-03 Mo DeJong <mdejong@users.sourceforge.net>
- * unix/Makefile.in: Don't subst MATH_LIBS,
- LIBS, and DL_LIBS separately. Instead, just
- subst TCL_LIBS since it includes the others.
+ * unix/Makefile.in: Don't subst MATH_LIBS, LIBS, and DL_LIBS
+ separately. Instead, just subst TCL_LIBS since it includes the
+ others.
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS):
- Set and subst TCL_LIBS in SC_CONFIG_CFLAGS instead
- of SC_TCL_LINK_LIBS. Don't subst MATH_LIBS
- since it is now covered by TCL_LIBS.
- * unix/tclConfig.sh.in: Use TCL_LIBS instead
- of DL_LIBS, LIBS, and MATH_LIBS.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Set and subst
+ TCL_LIBS in SC_CONFIG_CFLAGS instead of SC_TCL_LINK_LIBS. Don't subst
+ MATH_LIBS since it is now covered by TCL_LIBS.
+ * unix/tclConfig.sh.in: Use TCL_LIBS instead of DL_LIBS, LIBS, and
+ MATH_LIBS.
* unix/dltest/Makefile.in: Ditto.
2003-04-03 Don Porter <dgp@users.sourceforge.net>
@@ -2128,56 +2074,51 @@
2003-04-02 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Set stub lib flag based
- on new LIBFLAGSUFFIX variable.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set new
- LIBFLAGSUFFIX that works like LIBSUFFIX,
- it is used when creating library names.
- The previous implementation would generate
- -ltclstub85 instead of -ltclstub85s when
+ * win/configure.in: Set stub lib flag based on new LIBFLAGSUFFIX
+ variable.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set new LIBFLAGSUFFIX that works like
+ LIBSUFFIX, it is used when creating library names. The previous
+ implementation would generate -ltclstub85 instead of -ltclstub85s when
configured with --disable-shared.
2003-04-02 Don Porter <dgp@users.sourceforge.net>
* generic/tclParse.c (TclSubstTokens): Moved declaration of
- utfCharBytes to beginning of procedure so that it does not go
- out of scope (get free()d) while append is still pointing to it.
- [Bugs 703167, 713754]
+ utfCharBytes to beginning of procedure so that it does not go out of
+ scope (get free()d) while append is still pointing to it. [Bugs
+ 703167, 713754]
2003-04-01 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Check for
- inet_ntoa in -lbind inside the BeOS block since
- doing it later broke the build under SuSE 7.3.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Check for inet_ntoa in -lbind inside
+ the BeOS block since doing it later broke the build under SuSE 7.3.
[Bug 713128]
2003-04-01 Don Porter <dgp@users.sourceforge.net>
* tests/README: Direct [source] of *.test files is no longer
- recommended. The tests/*.test files should only be evaluated under
- the control of the [runAllTests] command in tests/all.tcl.
+ recommended. The tests/*.test files should only be evaluated under the
+ control of the [runAllTests] command in tests/all.tcl.
- * generic/tclExecute.c (INST_RETURN): Bytecompiled [return] failed
- to reset iPtr->returnCode, causing tests parse-18.17 and parse-18.21
- to fail strangely.
+ * generic/tclExecute.c (INST_RETURN): Bytecompiled [return] failed to
+ reset iPtr->returnCode, causing tests parse-18.17 and parse-18.21 to
+ fail strangely.
* tests/parse.test (parse-18.21): Corrected now functioning test.
Added further coverage tests.
2003-03-31 Don Porter <dgp@users.sourceforge.net>
* tests/parse.test (parse-18.*): Coverage tests for the new
- implementation of Tcl_SubstObj(). Note that tests parse-18.17 and
+ implementation of Tcl_SubstObj(). Note that tests parse-18.17 and
parse-18.21 demonstrate some bugs left to fix in the current code.
2003-03-27 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Use -Wl,--export-dynamic
- instead of -rdynamic for LDFLAGS. The -rdynamic is
- not documented so it seems better to pass the
- --export-dynamic flag to the linker.
- [Patch 573395]
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Use -Wl,--export-dynamic instead of
+ -rdynamic for LDFLAGS. The -rdynamic is not documented so it seems
+ better to pass the --export-dynamic flag to the linker. [Patch 573395]
2003-03-27 Miguel Sofer <msofer@users.sf.net>
@@ -2206,19 +2147,18 @@
2003-03-26 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS):
- Add BeOS system to SC_CONFIG_CFLAGS. Check for
- inet_ntoa in -lbind, needed for BeOS.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Add BeOS system to
+ SC_CONFIG_CFLAGS. Check for inet_ntoa in -lbind, needed for BeOS.
2003-03-26 Don Porter <dgp@users.sourceforge.net>
* doc/tcltest.n:
- * library/tcltest/tcltest.tcl: Added reporting during
- [configure -debug 1] operations to warn about multiple uses of
- the same test name. [FR 576693]
+ * library/tcltest/tcltest.tcl: Added reporting during [configure
+ -debug 1] operations to warn about multiple uses of the same test
+ name. [FRQ 576693]
* tests/msgcat.test (msgcat-2.2.1): changed test name to avoid
- duplication. [Bug 710356]
+ duplication. [Bug 710356]
* unix/dltest/pkg?.c: Changed all Tcl_InitStubs calls to pass
argument exact = 0, so that rebuilds are not required when Tcl
@@ -2228,13 +2168,13 @@
* generic/tclVar.c:
* tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the
- created local variable, bugs #631741 (Chris Darroch) and #696893
- (David Hilker).
+ created local variable. [Bug 631741] (Chris Darroch) and [Bug 696893]
+ (David Hilker)
2003-03-24 Pat Thoyts <patthoyts@users.sourceforge.net>
* library/dde/pkgIndex.tcl: bumped version to 1.2.2 in tclWinDde.c,
- now adding here too.
+ now adding here too.
2003-03-22 Kevin Kenny <kennykb@acm.org>
@@ -2243,20 +2183,19 @@
or [package require registry] attempted to load the release version
of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin
for the patch.
- * win/makefile.vc: Added quoting around the script name in the
- 'test' target; Joe Mistachkin insists that he has a configuration
- that fails to launch tcltest without it, and it appears harmless
- otherwise.
+ * win/makefile.vc: Added quoting around the script name in the 'test'
+ target; Joe Mistachkin insists that he has a configuration that fails
+ to launch tcltest without it, and it appears harmless otherwise.
2003-03-22 Pat Thoyts <patthoyts@users.sourceforge.net>
* win/tclWinDde.c: Make dde services conform the the documentation
- such that giving only a topic name really returns all services
- with that topic. [Bug 219155]
+ such that giving only a topic name really returns all services with
+ that topic. [Bug 219155]
Prevent hangup caused by dde server applications failing to process
- messages [Bug 707822]
- * tests/winDde.test: Corrected labels and added a test for search
- by topic name.
+ messages. [Bug 707822]
+ * tests/winDde.test: Corrected labels and added a test for search by
+ topic name.
2003-03-20 Don Porter <dgp@users.sourceforge.net>
@@ -2264,30 +2203,30 @@
* generic/tclStubInit.c (tclOriginalNotifier):
* mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent):
* unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent,
- Tcl_CreateFileHandler,Tcl_DeleteFileHandler):
+ (Tcl_CreateFileHandler,Tcl_DeleteFileHandler):
* win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): Some linkers
apparently use a different representation for a pointer to a function
within the same compilation unit and a pointer to a function in a
- different compilation unit. This causes checks like those in the
- original notifier procedures to fall into infinite loops. The fix
- is to store pointers to the original notifier procedures in a struct
+ different compilation unit. This causes checks like those in the
+ original notifier procedures to fall into infinite loops. The fix is
+ to store pointers to the original notifier procedures in a struct
defined in the same compilation unit as the stubs tables, and compare
- against those values. [Bug 707174]
+ against those values. [Bug 707174]
- * generic/tclInt.h: Removed definition of ParseValue struct that
- is no longer used.
+ * generic/tclInt.h: Removed definition of ParseValue struct that is
+ no longer used.
2003-03-19 Miguel Sofer <msofer@users.sf.net>
* generic/tclCompile.c:
- * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE
- [Bug 705406] (Don Porter).
+ * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE.
+ [Bug 705406] (Don Porter)
2003-03-19 Don Porter <dgp@users.sourceforge.net>
* library/auto.tcl: Replaced [regexp] and [regsub] with
* library/history.tcl: [string map] where possible. Thanks
- * library/ldAout.tcl: to David Welton. [Bugs 667456,667558]
+ * library/ldAout.tcl: to David Welton. [Bugs 667456,667558]
* library/safe.tcl: Bumped to http 2.4.3, opt 0.4.5, and
* library/http/http.tcl: tcltest 2.2.3.
* library/http/pkgIndex.tcl:
@@ -2300,67 +2239,64 @@
* unix/mkLinks.tcl:
* doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and
- * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors
- in documentation. [Bug 683994]
+ * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors in
+ documentation. [Bug 683994]
* generic/tclCompCmds.c (TclCompileReturnCmd): Alternative fix for
* generic/tclCompile.c (INST_RETURN): [Bug 633204] that uses a new
* generic/tclCompile.h (INST_RETURN): bytecode INST_RETURN to
- * generic/tclExecute.c (INST_RETURN): properly bytecode the
- [return] command to something that returns TCL_RETURN.
+ * generic/tclExecute.c (INST_RETURN): properly bytecode the [return]
+ command to something that returns TCL_RETURN.
2003-03-18 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Don't run the AC_CYGWIN
- macro since it uses AC_CANONICAL_HOST under
- autoconf 2.5X. Just check to see if __CYGWIN__
- is defined by the compiler and set the
- ac_cv_cygwin variable based on that.
- [Bug 705912]
+ * win/configure.in: Don't run the AC_CYGWIN macro since it uses
+ AC_CANONICAL_HOST under autoconf 2.5X. Just check to see if __CYGWIN__
+ is defined by the compiler and set the ac_cv_cygwin variable based on
+ that. [Bug 705912]
2003-03-18 Kevin Kenny <kennykb@users.sourceforge.net>
- * tests/registry.test: Changed the conditionals to avoid an
- abort if [testlocale] is missing, as when running the test in
- tclsh rather than tcltest. [Bug #705677]
+ * tests/registry.test: Changed the conditionals to avoid an abort if
+ [testlocale] is missing, as when running the test in tclsh rather than
+ tcltest. [Bug 705677]
2003-03-18 Daniel Steffen <das@users.sourceforge.net>
* tools/tcltk-man2html.tcl: added support for building 'make html'
- from inside distribution directories named with 8.x.x version
- numbers. tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x
- directories found inside its --srcdir argument.
+ from inside distribution directories named with 8.x.x version numbers.
+ tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x directories
+ found inside its --srcdir argument.
2003-03-17 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/format.test: Renumber tests, a bunch of
- tests all had the same id.
+ * tests/format.test: Renumber tests, a bunch of tests all had the same
+ id.
2003-03-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* doc/lsearch.n: Altered documentation of -ascii options so
- * doc/lsort.n: they don't specify that they operate on
- ASCII strings, which they never did
- anyway. [Bug #703807]
+ * doc/lsort.n: they don't specify that they operate on ASCII
+ strings, which they never did anyway. [Bug
+ 703807]
2003-03-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier
- that indicates we've got a wide int when we're formatting in an
- integer style. Stops some libc's from going mad. [Bug #702622]
- Also tidied whitespace.
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that
+ indicates we've got a wide int when we're formatting in an integer
+ style. Stops some libc's from going mad. [Bug 702622] Also tidied
+ whitespace.
2003-03-13 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tcl.m4 (SC_WITH_TCL): Port version number
- fix that was made in tk instead of tcl sources.
+ * win/tcl.m4 (SC_WITH_TCL): Port version number fix that was made in
+ tk instead of tcl sources.
2003-03-13 Mo DeJong <mdejong@users.sourceforge.net>
- Require autoconf 2.57 or newer, see TIP 34
- for a detailed explanation of why this is good.
- This will no doubt break the build on some
+ Require autoconf 2.57 or newer, see TIP 34 for a detailed explanation
+ of why this is good. This will no doubt break the build on some
platforms, let the flaming begin.
* tools/configure: Regen with autoconf 2.57.
@@ -2371,8 +2307,8 @@
* unix/tcl.m4: Ditto.
* win/configure: Regen with autoconf 2.57.
* win/configure.in: Require autoconf 2.57.
- Don't subst LIBOBJS since this happens by
- default, this avoids an autoconf error.
+ Don't subst LIBOBJS since this happens by default, this avoids an
+ autoconf error.
2003-03-12 Don Porter <dgp@users.sourceforge.net>
@@ -2381,7 +2317,7 @@
* generic/tclCompCmds.c (TclCompileSwitchCmd):
* generic/tclCompExpr.c (CompileSubExpr):
* generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript,
- TclCompileTokens,TclCompileCmdWord):
+ (TclCompileTokens,TclCompileCmdWord):
* generic/tclCompile.h (TclCompileScript):
* generic/tclExecute.c (TclCompEvalObj):
* generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens):
@@ -2389,16 +2325,16 @@
* tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5):
Substantial refactoring of Tcl_SubstObj to make use of the same
parsing and substitution procedures as normal script evaluation.
- Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens()
- created in tclParse.c which implements all substantial functioning
- of Tcl_EvalTokensStandard(). TclCompileScript() loses its
- "nested" argument, the Tcl_Interp struct loses its termOffset
- field and the TCL_BRACKET_TERM flag in the evalFlags field, all
- of which were only used (indirectly) by Tcl_SubstObj(). Tests
- subst-8.7,8.8,11.4,11.5 modified to accomodate the only behavior
- change: reporting of parse errors now takes precedence over
- [return] and [continue] exceptions. All other behavior should
- remain compatible. [RFE 536831,684982] [Bug 685106]
+ Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens()
+ created in tclParse.c which implements all substantial functioning of
+ Tcl_EvalTokensStandard(). TclCompileScript() loses its "nested"
+ argument, the Tcl_Interp struct loses its termOffset field and the
+ TCL_BRACKET_TERM flag in the evalFlags field, all of which were only
+ used (indirectly) by Tcl_SubstObj(). Tests subst-8.7,8.8,11.4,11.5
+ modified to accomodate the only behavior change: reporting of parse
+ errors now takes precedence over [return] and [continue] exceptions.
+ All other behavior should remain compatible. [RFE 536831,684982] [Bug
+ 685106]
* generic/tcl.h: Removed TCL_PREFIX_IDENT and TCL_DEBUG_IDENT
* win/tclWinPipe.c: from tcl.h -- they are not part of Tcl's
@@ -2406,7 +2342,7 @@
* generic/tclInterp.c (Tcl_InterpObjCmd): Corrected and added
* tests/interp.test (interp-2.13): test for option
- parsing beyond objc for [interp create --]. Thanks to Marco Maggi.
+ parsing beyond objc for [interp create --]. Thanks to Marco Maggi.
[Bug 702383]
2003-03-11 Kevin Kenny <kennykb@users.sourceforge.net>
@@ -2416,52 +2352,48 @@
2003-03-09 Kevin Kenny <kennykb@users.sourceforge.net>
- * generic/tclTest.c (TestChannelCmd): Removed an unused local
- variable that caused compilation problems on some platforms.
+ * generic/tclTest.c (TestChannelCmd): Removed an unused local variable
+ that caused compilation problems on some platforms.
2003-03-08 Don Porter <dgp@users.sourceforge.net>
- * doc/tcltest.n: Added missing "-body" to example. Thanks to
- Helmut Giese. [Bug 700011]
+ * doc/tcltest.n: Added missing "-body" to example. Thanks to Helmut
+ Giese. [Bug 700011]
2003-03-07 Mo DeJong <mdejong@users.sourceforge.net>
* tests/io.test:
- * tests/ioCmd.test: Define a fcopy constraint and add
- it to the constraint list of any test that depends
- on the fcopy command. This is only useful to
- Jacl which does not support fcopy.
+ * tests/ioCmd.test: Define a fcopy constraint and add it to the
+ constraint list of any test that depends on the fcopy command. This is
+ only useful to Jacl which does not support fcopy.
2003-03-07 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/encoding.test: Name temp files *.tcltestout
- instead of *.out so that when they are removed later,
- we don't accidently toast any files named *.out that
- the user has created in the build directory.
+ * tests/encoding.test: Name temp files *.tcltestout instead of *.out
+ so that when they are removed later, we don't accidently toast any
+ files named *.out that the user has created in the build directory.
2003-03-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCmdAH.c (Tcl_FileObjCmd): Fix the setting of a file's
- mtime and atime on 64-bit platforms. [Bug #698146]
+ mtime and atime on 64-bit platforms. [Bug 698146]
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/io.test: Doh! Undo accidental commenting
- out of a couple of tests.
+ * tests/io.test: Doh! Undo accidental commenting out of a couple of
+ tests.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/io.test: Define a fileevent constraint and add
- it to the constraint list of any test that depends
- on the fileevent command. This is only useful to
- Jacl which does not support fileevent.
+ * tests/io.test: Define a fileevent constraint and add it to the
+ constraint list of any test that depends on the fileevent command.
+ This is only useful to Jacl which does not support fileevent.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * tests/io.test: Define an openpipe constraint and add
- it to the constraint list of any test that creates
- a pipe using the open command. This is only useful to
- Jacl which does not support pipes.
+ * tests/io.test: Define an openpipe constraint and add it to the
+ constraint list of any test that creates a pipe using the open
+ command. This is only useful to Jacl which does not support pipes.
2003-03-06 Don Porter <dgp@users.sourceforge.net>
@@ -2472,72 +2404,57 @@
2003-03-06 Kevin Kenny <kennykb@users.sourceforge.net>
* generic/tclCompCmds.c (TclCompileSwitchCmd):
- Replaced a non-portable 'bzero' with a portable 'memset'.
- [Bug 698442].
+ Replaced a non-portable 'bzero' with a portable 'memset'. [Bug 698442]
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_Seek, Tcl_OutputBuffered):
- If there is data buffered in the statePtr->curOutPtr
- member then set the BUFFER_READY flag in Tcl_Seek.
- This is needed so that the next call to FlushChannel
- will write any buffered bytes before doing the seek.
- The existing code would set the BUFFER_READY flag
- inside the Tcl_OutputBuffered function. This was a
- programming error made when Tcl_OutputBuffered
- was originally created in CVS revision 1.35. The
- setting of the BUFFER_READY flag should not have
- been included in the Tcl_OutputBuffered function.
- * generic/tclTest.c (TestChannelCmd): Use the
- Tcl_InputBuffered and Tcl_OutputBuffered
- util methods to query the amount of buffered
- input and output.
+ * generic/tclIO.c (Tcl_Seek, Tcl_OutputBuffered): If there is data
+ buffered in the statePtr->curOutPtr member then set the BUFFER_READY
+ flag in Tcl_Seek. This is needed so that the next call to FlushChannel
+ will write any buffered bytes before doing the seek. The existing code
+ would set the BUFFER_READY flag inside the Tcl_OutputBuffered
+ function. This was a programming error made when Tcl_OutputBuffered
+ was originally created in CVS revision 1.35. The setting of the
+ BUFFER_READY flag should not have been included in the
+ Tcl_OutputBuffered function.
+ * generic/tclTest.c (TestChannelCmd): Use the Tcl_InputBuffered and
+ Tcl_OutputBuffered util methods to query the amount of buffered input
+ and output.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_Flush): Compare the
- nextAdded member of the ChannelBuffer to the
- nextRemoved member to determine if any output
- has been buffered. The previous check against
- the value 0 seems to have just been a coding
- error. See other methods like Tcl_OutputBuffered
- for examples where nextAdded is compared to
- nextRemoved to find the number of bytes buffered.
+ * generic/tclIO.c (Tcl_Flush): Compare the nextAdded member of the
+ ChannelBuffer to the nextRemoved member to determine if any output has
+ been buffered. The previous check against the value 0 seems to have
+ just been a coding error. See other methods like Tcl_OutputBuffered
+ for examples where nextAdded is compared to nextRemoved to find the
+ number of bytes buffered.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_GetsObj): Check that
- the eol pointer has not gone past the end
- of the string when in auto translation
- mode and the INPUT_SAW_CR flag is set.
- The previous code worked because the
- end of string value \0 was being compared
- to \n, this patch just skips that pointless
- check.
+ * generic/tclIO.c (Tcl_GetsObj): Check that the eol pointer has not
+ gone past the end of the string when in auto translation mode and the
+ INPUT_SAW_CR flag is set. The previous code worked because the end of
+ string value \0 was being compared to \n, this patch just skips that
+ pointless check.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (WriteBytes, WriteChars,
- Tcl_GetsObj, ReadBytes): Rework calls to
- TranslateOutputEOL to make it clear that
- a boolean value is being returned.
- Add some comments in an effort to make
- the code more clear. This patch makes
- no functional changes.
+ * generic/tclIO.c (WriteBytes, WriteChars, Tcl_GetsObj, ReadBytes):
+ Rework calls to TranslateOutputEOL to make it clear that a boolean
+ value is being returned. Add some comments in an effort to make the
+ code more clear. This patch makes no functional changes.
2003-03-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_SetChannelOption):
- Invoke the Tcl_SetChannelBufferSize method
- as a result of changing the -buffersize
- option to fconfigure. The previous
- implementation used some inlined code that
- reset the buffer size to the default size
- instead of ignoring the request as
- implemented in Tcl_SetChannelBufferSize.
- * tests/io.test: Update test case so that
- it actually checks the implementation of
+ * generic/tclIO.c (Tcl_SetChannelOption): Invoke the
+ Tcl_SetChannelBufferSize method as a result of changing the
+ -buffersize option to fconfigure. The previous implementation used
+ some inlined code that reset the buffer size to the default size
+ instead of ignoring the request as implemented in
Tcl_SetChannelBufferSize.
+ * tests/io.test: Update test case so that it actually checks the
+ implementation of Tcl_SetChannelBufferSize.
2003-03-05 David Gravereaux <davygrvy@pobox.com>
@@ -2546,17 +2463,17 @@
2003-03-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tclCompCmds.c (TclCompileSwitchCmd): First attempt at a
- bytecode-compiled switch command. It only handles the most common
- case of switching, but that should be enough for this to speed up
- a lot of people's code. It is expected that the speed gains come
- from two things: better handling of the switch itself, and
- integrated compilation of the arms instead of embedding separate
- bytecode sequences (i.e. better local variable handling.)
+ bytecode-compiled switch command. It only handles the most common case
+ of switching, but that should be enough for this to speed up a lot of
+ people's code. It is expected that the speed gains come from two
+ things: better handling of the switch itself, and integrated
+ compilation of the arms instead of embedding separate bytecode
+ sequences (i.e. better local variable handling.)
* tests/switch.test (switch-10.*): Tests of both uncompiled and
compiled switch behaviour. [Patch #644819]
- * generic/tclCompile.h (TclFixupForwardJumpToHere): Additional
- macro to make the most common kind of jump fixup a bit easier.
+ * generic/tclCompile.h (TclFixupForwardJumpToHere): Additional macro
+ to make the most common kind of jump fixup a bit easier.
2003-03-04 Don Porter <dgp@users.sourceforge.net>
@@ -2589,16 +2506,16 @@
2003-03-03 Daniel Steffen <das@users.sourceforge.net>
Mac OS Classic specific fixes:
- * generic/tclIOUtil.c (TclNewFSPathObj): on TCL_PLATFORM_MAC,
- skip potential directory separator at the beginning of addStrRep.
- * mac/tclMacChan.c (OpenFileChannel, CommonWatch): followup
- fixes to cut and splice implementation for file channels.
+ * generic/tclIOUtil.c (TclNewFSPathObj): on TCL_PLATFORM_MAC, skip
+ potential directory separator at the beginning of addStrRep.
+ * mac/tclMacChan.c (OpenFileChannel, CommonWatch): followup fixes to
+ cut and splice implementation for file channels.
* mac/tclMacFile.c (TclpUtime): pass native path to utime().
- * mac/tclMacFile.c (TclpObjLink): correctly implemented creation
- of alias files via new static proc CreateAliasFile().
+ * mac/tclMacFile.c (TclpObjLink): correctly implemented creation of
+ alias files via new static proc CreateAliasFile().
* mac/tclMacPort.h: define S_ISLNK macro to fix stat'ing of links.
- * mac/tclMacUtil.c (FSpLocationFromPathAlias): fix to enable
- stat'ing of broken links.
+ * mac/tclMacUtil.c (FSpLocationFromPathAlias): fix to enable stat'ing
+ of broken links.
2003-03-03 Kevin Kenny <kennykb@users.sourceforge.net>
@@ -2618,8 +2535,8 @@
* win/configure:
* win/configure.in: check for 'g' for debug build type, not 'd'.
- * win/rules.vc (DBGX): correct to use 'g' for nmake win makefile
- to match the cygwin makefile for debug builds. [Bug #635107]
+ * win/rules.vc (DBGX): correct to use 'g' for nmake win makefile to
+ match the cygwin makefile for debug builds. [Bug 635107]
2003-02-28 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -2630,14 +2547,14 @@
* generic/tclIOUtil.c (MakeFsPathFromRelative): removed dead code
check of typePtr (darley).
- * tests/winTime.test: added note about PCI hardware dependency
- issues with high performance clock.
+ * tests/winTime.test: added note about PCI hardware dependency issues
+ with high performance clock.
2003-02-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/lsearch.test (lsearch-10.7):
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option
- from causing an option when used with an empty list. [Bug #694232]
+ * tests/lsearch.test (lsearch-10.7):
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option from
+ causing an option when used with an empty list. [Bug 694232]
2003-02-26 Chengye Mao <chengye.geo@yahoo.com>
@@ -2648,21 +2565,20 @@
2003-02-26 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclCmdMZ.c (TraceCommandProc): Fix mem leak when
- deleting a command that had trace on it. [Bug #693564] (sofer)
+ * generic/tclCmdMZ.c (TraceCommandProc): Fix mem leak when deleting a
+ command that had trace on it. [Bug 693564] (sofer)
2003-02-25 Don Porter <dgp@users.sourceforge.net>
* doc/pkgMkIndex.n: Modified [pkg_mkIndex] to use -nocase matching
- * library/package.tcl: of -load patterns, to better accomodate
- common user errors due to confusion between [package names] names
- and [info loaded] names.
+ * library/package.tcl: of -load patterns, to better accomodate common
+ user errors due to confusion between [package names] names and [info
+ loaded] names.
2003-02-25 Andreas Kupries <andreask@pliers.activestate.com>
- * tests/pid.test: See below [Bug #678412].
- * tests/io.test: Made more robust against spaces in paths
- [Bug #678400].
+ * tests/pid.test: See below [Bug 678412].
+ * tests/io.test: Made more robust against spaces in paths [Bug 678400]
2003-02-25 Miguel Sofer <msofer@users.sf.net>
@@ -2671,13 +2587,13 @@
2003-02-22 Zoran Vasiljevic <zoran@archiwrae.com>
- * generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug #571002]
+ * generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug 571002]
2003-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/binary.test (binary-44.[34]):
+ * tests/binary.test (binary-44.[34]):
* generic/tclBinary.c (ScanNumber): Fixed problem with unwanted
- sign-bit propagation when scanning wide ints. [Bug #690774]
+ sign-bit propagation when scanning wide ints. [Bug 690774]
2003-02-21 Daniel Steffen <das@users.sourceforge.net>
@@ -2686,16 +2602,16 @@
2003-02-21 Don Porter <dgp@users.sourceforge.net>
- * library/package.tcl (tclPkgUnknown): Minor performance tweaks
- to reduce the number of [file] invocations. Meant to improve
- startup times, at least a little bit. [Patch 687906]
+ * library/package.tcl (tclPkgUnknown): Minor performance tweaks to
+ reduce the number of [file] invocations. Meant to improve startup
+ times, at least a little bit. [Patch 687906]
2003-02-20 Daniel Steffen <das@users.sourceforge.net>
* unix/tcl.m4:
- * unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to
- create new processes, as recommended by Apple (vfork can be up to
- 100 times faster thank fork on macosx).
+ * unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to create
+ new processes, as recommended by Apple (vfork can be up to 100 times
+ faster thank fork on macosx).
* unix/configure: regen.
2003-02-20 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2703,53 +2619,52 @@
* generic/tclEncoding.c (LoadTableEncoding):
* library/encoding/cp932.enc: Correct jis round-trip encoding
* library/encoding/euc-jp.enc: by adding 'R' type to .enc files.
- * library/encoding/iso2022-jp.enc: [Patch #689341] (koboyasi, taguchi)
+ * library/encoding/iso2022-jp.enc: [Patch 689341] (koboyasi, taguchi)
* library/encoding/jis0208.enc:
* library/encoding/shiftjis.enc:
* tests/encoding.test:
* unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): add
- MakeTcpClientChannelMode that takes actual mode flags to avoid
- hang on OS X (may be OS X bug, but patch works x-plat).
- [Bug #689835] (steffen)
+ MakeTcpClientChannelMode that takes actual mode flags to avoid hang on
+ OS X (may be OS X bug, but patch works x-plat). [Bug 689835] (steffen)
2003-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/regsub.n: Typo fix [Bug #688943]
+ * doc/regsub.n: Typo fix [Bug 688943]
2003-02-19 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tclUnixThrd.c (TclpReaddir):
- * unix/tclUnixPort.h: update to Bug 689100 patch to ensure that
- there is a defined value of MAXNAMLEN (aka NAME_MAX in POSIX) and
- that we have some buffer allocated.
+ * unix/tclUnixPort.h: update to Bug 689100 patch to ensure that there
+ is a defined value of MAXNAMLEN (aka NAME_MAX in POSIX) and that we
+ have some buffer allocated.
2003-02-19 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect
- of always invalidating unicode rep (if the obj has a string rep).
- Added hasUnicode flag to String struct, allows decoupling of
- validity of unicode rep from buffer size allocated to it (improves
- memory allocation efficiency). [Bugs #686782, #671138, #635200]
+ * generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect of
+ always invalidating unicode rep (if the obj has a string rep). Added
+ hasUnicode flag to String struct, allows decoupling of validity of
+ unicode rep from buffer size allocated to it (improves memory
+ allocation efficiency). [Bugs 686782, 671138, 635200]
* macosx/Tcl.pbproj/project.pbxproj:
* macosx/Makefile: reworked embedded build to no longer require
relinking but to use install_name_tool instead to change the
- install_names for embedded frameworks. [Bug #644510]
+ install_names for embedded frameworks. [Bug 644510]
- * macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when
- running 'make install' to build framework (avoids bogus rebuilds
- of dependent frameworks because tcl headers appear changed).
+ * macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when running
+ 'make install' to build framework (avoids bogus rebuilds of dependent
+ frameworks because tcl headers appear changed).
- * tests/ioCmd.test (iocmd-1.8): fix failure when system encoding
- is utf-8: use iso8859-1 encoding explicitly.
+ * tests/ioCmd.test (iocmd-1.8): fix failure when system encoding is
+ utf-8: use iso8859-1 encoding explicitly.
2003-02-18 Miguel Sofer <msofer@users.sf.net>
- * generic/tclCompile.c (TclCompileExprWords): remove unused
- variable "range" [Bug 664743]
- * generic/tclExecute.c (ExprSrandFunc): remove unused
- variable "result" [Bug 664743]
+ * generic/tclCompile.c (TclCompileExprWords): remove unused variable
+ "range" [Bug 664743]
+ * generic/tclExecute.c (ExprSrandFunc): remove unused variable
+ "result" [Bug 664743]
* generic/tclStringObj.c (UpdateStringOfString): remove unused
variable "length" [Bug 664751]
* tests/execute.test (execute-7.30): fix for [Bug 664775]
@@ -2757,9 +2672,9 @@
2003-02-18 Andreas Kupries <andreask@activestate.com>
* unix/tcl.m4: [Bug #651811] Added definition of _XOPEN_SOURCE and
- linkage of 'xnet' library to HP 11 branch. This kills a lot of
- socket-related failures in the testsuite when Tcl was compiled
- in 64 bit mode (both PA-RISC 2.0W, and IA 64).
+ linkage of 'xnet' library to HP 11 branch. This kills a lot of
+ socket-related failures in the testsuite when Tcl was compiled in 64
+ bit mode (both PA-RISC 2.0W, and IA 64).
* unix/configure: Regenerated.
@@ -2767,25 +2682,24 @@
* generic/tclIO.c (HaveVersion): correctly decl static
- * unix/tclUnixThrd.c (TclpReaddir): reduce size of name string in
- tsd to NAME_MAX instead of PATH_MAX. [Bug #689100] (waters)
+ * unix/tclUnixThrd.c (TclpReaddir): reduce size of name string in tsd
+ to NAME_MAX instead of PATH_MAX. [Bug 689100] (waters)
2003-02-18 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
- * unix/tcl.m4 (SC_ENABLE_THREADS): Make sure
- -lpthread gets passed on the link line when
- checking for the pthread_attr_setstacksize symbol.
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Make sure -lpthread gets passed on
+ the link line when checking for the pthread_attr_setstacksize symbol.
2003-02-18 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclTest.c: cleanup of new 'simplefs' test code, and
- better documentation.
+ * generic/tclTest.c: cleanup of new 'simplefs' test code, and better
+ documentation.
2003-02-17 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c (TclRenameCommand): fixing error in previous
- commit.
+ commit.
2003-02-17 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2794,24 +2708,22 @@
* generic/tclUtf.c (TclUniCharMatch):
* generic/tclInt.decls: add private TclUniCharMatch function that
* generic/tclIntDecls.h: does string match on counted unicode
- * generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the
- * tests/string.test: failing that it can't handle strings or
- * tests/stringComp.test: patterns with embedded NULLs. Added
- tests that actually try strings/pats with NULLs. TclUniCharMatch
- should be TIPed and made public in the next minor version rev.
+ * generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the failing
+ * tests/string.test: that it can't handle strings or patterns with
+ * tests/stringComp.test: embedded NULLs. Added tests that actually try
+ strings/pats with NULLs. TclUniCharMatch should be TIPed and made
+ public in the next minor version rev.
2003-02-17 Miguel Sofer <msofer@users.sf.net>
- * generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was
- not being freed on all function exits, causing a memory leak
- [Bug 684756]
+ * generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was not
+ being freed on all function exits, causing a memory leak. [Bug 684756]
2003-02-17 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_GetsObj): Minor change
- so that eol is only assigned at the top of the
- TCL_TRANSLATE_AUTO case block. The other cases
- assign eol so this does not change any functionality.
+ * generic/tclIO.c (Tcl_GetsObj): Minor change so that eol is only
+ assigned at the top of the TCL_TRANSLATE_AUTO case block. The other
+ cases assign eol so this does not change any functionality.
2003-02-17 Kevin Kenny <kennykb@users.sourceforge.net>
@@ -2829,23 +2741,23 @@
* tests/misc.test (1.2):
* tests/parse.test (6.18):
* tests/parseExpr.test (15.35):
- * tests/subst.test (8.6): Don Porter's fix for bad parsing of
- nested scripts [Bug 681841].
+ * tests/subst.test (8.6): Don Porter's fix for bad parsing of nested
+ scripts. [Bug 681841]
2003-02-15 Kevin Kenny <kennykb@users.sourceforge.net>
- * tests/notify.test (new-file):
+ * tests/notify.test (new-file):
* generic/tclTest.c (TclTest_Init, EventtestObjCmd, EventtestProc,
- EventTestDeleteProc):
- * generic/tclNotify.c (Tcl_DeleteEvents): Fixed Tcl_DeleteEvents
- not to get a pointer smash when deleting the last event in the
- queue. Added test code in 'tcltest' and a new file of test cases
- 'notify.test' to exercise this functionality; several of the new
- test cases fail for the original code and pass for the corrected
- code. [Bug 673714]
+ (EventTestDeleteProc):
+ * generic/tclNotify.c (Tcl_DeleteEvents): Fixed Tcl_DeleteEvents not
+ to get a pointer smash when deleting the last event in the queue.
+ Added test code in 'tcltest' and a new file of test cases
+ 'notify.test' to exercise this functionality; several of the new test
+ cases fail for the original code and pass for the corrected code. [Bug
+ 673714]
- * unix/tclUnixTest.c (TestfilehandlerCmd): Corrected a couple
- of typos in error messages. [Bug 596027]
+ * unix/tclUnixTest.c (TestfilehandlerCmd): Corrected a couple of typos
+ in error messages. [Bug 596027]
2003-02-14 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2867,40 +2779,38 @@
2003-02-14 Kevin Kenny <kennykb@users.sourceforge.net>
- * win/tclWinTime.c: Added code to test and compensate for
- forward leaps of the performance counter. See the MSDN Knowledge
- Base article Q274323 for the hardware problem that makes this
- necessary on certain machines.
- * tests/winTime.test: Revised winTime-2.1 - it had a tolerance
- of thousands of seconds, rather than milliseconds. (What's six
- orders of magnitude among friends?
- Both the above changes are triggered by a problem reported at
+ * win/tclWinTime.c: Added code to test and compensate for forward
+ leaps of the performance counter. See the MSDN Knowledge Base article
+ Q274323 for the hardware problem that makes this necessary on certain
+ machines.
+ * tests/winTime.test: Revised winTime-2.1 - it had a tolerance of
+ thousands of seconds, rather than milliseconds. (What's six orders of
+ magnitude among friends?) Both the above changes are triggered by a
+ problem reported at:
http://aspn.activestate.com/ASPN/Mail/Message/ActiveTcl/1536811
- although the developers find it difficult to believe that it
- accounts for the observed behavior and suspect a fault in the
- RTC chip.
+ although the developers find it difficult to believe that it accounts
+ for the observed behavior and suspect a fault in the RTC chip.
2003-02-13 Kevin Kenny <kennykb@users.sourceforge.net>
- * win/tclWinInit.c: Added conversion from the system encoding
- to tcl_platform(user), so that it works with non-ASCII7 user names.
- [Bug 685926]
+ * win/tclWinInit.c: Added conversion from the system encoding to
+ tcl_platform(user), so that it works with non-ASCII7 user names. [Bug
+ 685926]
* doc/tclsh.1: Added language to describe the handling of the
- end-of-file character \u001a embedded in a script file.
- [Bug 685485]
+ end-of-file character \u001a embedded in a script file. [Bug 685485]
2003-02-11 Vince Darley <vincentdarley@users.sourceforge.net>
* tests/fileName.test:
- * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l'
- on broken symbolic links. Added two new tests for this bug.
+ * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' on
+ broken symbolic links. Added two new tests for this bug.
2003-02-11 Kevin Kenny <kennykb@users.sourceforge.net>
- * tests/http.test: Corrected a problem where http-4.14 would fail
- when run in an environment with a proxy server. Replaced references
- to scriptics.com by tcl.tk.
+ * tests/http.test: Corrected a problem where http-4.14 would fail when
+ run in an environment with a proxy server. Replaced references to
+ scriptics.com by tcl.tk.
2003-02-11 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2909,47 +2819,44 @@
that lsearch -regepx list and pattern objects are equal.
* tests/stringObj.test:
- * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char
- opt of 2002-11-11 to not stop early on \x00. [Bug #684699]
+ * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char opt
+ of 2002-11-11 to not stop early on \x00. [Bug 684699]
* tests.parse.test: remove excess EOF whitespace
- * generic/tclParse.c (CommandComplete): more paranoid check to
- break on (p >= end) instead of just (p == end).
+ * generic/tclParse.c (CommandComplete): more paranoid check to break
+ on (p >= end) instead of just (p == end).
2003-02-11 Miguel Sofer <msofer@users.sf.net>
- * generic/tclParse.c (CommandComplete):
+ * generic/tclParse.c (CommandComplete):
* tests/parse.test: fix for [Bug 684744], by Don Porter.
2003-02-11 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath):
+ * generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath):
(UpdateStringOfFsPath): revert the cwdLen == 0 check and instead
follow a different code path in Tcl_FSJoinPath.
(Tcl_FSConvertToPathType, Tcl_FSGetNormalizedPath):
- (Tcl_FSGetFileSystemForPath): Update string rep of path objects
- before freeing the internal object. (darley)
+ (Tcl_FSGetFileSystemForPath): Update string rep of path objects before
+ freeing the internal object. (darley)
* tests/fileSystem.test: added test 8.3
- * generic/tclIOUtil.c (Tcl_FSGetNormalizedPath):
- (UpdateStringOfFsPath): handle the cwdLen == 0 case
+ * generic/tclIOUtil.c (Tcl_FSGetNormalizedPath):
+ (UpdateStringOfFsPath): handle the cwdLen == 0 case
- * unix/tclUnixFile.c (TclpMatchInDirectory): simplify the hidden
- file match check.
+ * unix/tclUnixFile.c (TclpMatchInDirectory): simplify the hidden file
+ match check.
2003-02-10 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure:
- * win/configure.in: Generate error when attempting
- to build under Cygwin. The Cygwin port of Tcl/Tk
- does not build and people are filing bug reports
- under the mistaken impression that someone is
- actually maintaining the Cygwin port. A post to
- comp.lang.tcl asking someone to volunteer as an
- area maintainer has generated no results.
- Closing bugs 680840, 630199, and 634772 and
- marking as "Won't fix".
+ * win/configure.in: Generate error when attempting to build under
+ Cygwin. The Cygwin port of Tcl/Tk does not build and people are filing
+ bug reports under the mistaken impression that someone is actually
+ maintaining the Cygwin port. A post to comp.lang.tcl asking someone to
+ volunteer as an area maintainer has generated no results. Closing bugs
+ 680840, 630199, and 634772 and marking as "Won't fix".
2003-02-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
@@ -2963,17 +2870,16 @@
* tests/fileSystem.test:
* unix/tclUnixFCmd.c:
* unix/tclUnixFile.c:
- * win/tclWinFile.c: further filesystem optimization, applying
- [Patch 682500]. In particular, these code examples are
- faster now:
- foreach f $flist { if {[file exists $f]} {file stat $f arr;...}}
- foreach f [glob -dir $dir *] { # action and/or recursion on $f }
- cd $dir
- foreach f [glob *] { # action and/or recursion on $f }
- cd ..
-
- * generic/tclTest.c: Fix for [Bug 683181] where test suite
- left files in 'tmp'.
+ * win/tclWinFile.c: further filesystem optimization, applying [Patch
+ 682500]. In particular, these code examples are faster now:
+ foreach f $flist { if {[file exists $f]} {file stat $f arr;...}}
+ foreach f [glob -dir $dir *] { # action and/or recursion on $f }
+ cd $dir
+ foreach f [glob *] { # action and/or recursion on $f }
+ cd ..
+
+ * generic/tclTest.c: Fix for [Bug 683181] where test suite left files
+ in 'tmp'.
2003-02-08 Jeff Hobbs <jeffh@ActiveState.com>
@@ -2985,58 +2891,52 @@
* win/tclWinFile.c: sped up pure 'glob' by a factor of 2.5
('foreach f [glob *] { file exists $f }' is still slow)
* tests/fileSystem.text:
- * tests/fileName.test: added new tests to ensure correct
- behaviour in optimized filesystem code.
+ * tests/fileName.test: added new tests to ensure correct behaviour in
+ optimized filesystem code.
2003-02-07 Vince Darley <vincentdarley@users.sourceforge.net>
* generic/tclTest.c:
- * tests/fileSystem.text: fixed test 7.2 to avoid a possible
- crash, and not change the pwd.
+ * tests/fileSystem.text: fixed test 7.2 to avoid a possible crash, and
+ not change the pwd.
- * tests/http.text: added comment to test 4.15, that it may
- fail if you use a proxy server.
+ * tests/http.text: added comment to test 4.15, that it may fail if you
+ use a proxy server.
2003-02-06 Mo DeJong <mdejong@users.sourceforge.net>
* generic/tclCompCmds.c (TclCompileIncrCmd):
- * tests/incr.test: Don't include the text
- "(increment expression)" in the errorInfo
- generated by the compiled version of the
- incr command since it does not match the
- message generated by the non-compiled version
- of incr. It is also not possible to match
- this error output under Jacl, which does
- not support a compiler.
+ * tests/incr.test: Don't include the text "(increment expression)" in
+ the errorInfo generated by the compiled version of the incr command
+ since it does not match the message generated by the non-compiled
+ version of incr. It is also not possible to match this error output
+ under Jacl, which does not support a compiler.
2003-02-06 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): When an
- error is encountered reading the increment value during
- a compiled call to incr, add a "(reading increment)"
- error string to the errorInfo variable. This makes
- the errorInfo variable set by the compiled incr command
- match the value set by the non-compiled version.
- * tests/incr-old.test: Change errorInfo result for
- the compiled incr command case to match the modified
- implementation.
- * tests/incr.test: Add tests to make sure the compiled
- and non-compiled errorInfo messages are the same.
+ * generic/tclExecute.c (TclExecuteByteCode): When an error is
+ encountered reading the increment value during a compiled call to
+ incr, add a "(reading increment)" error string to the errorInfo
+ variable. This makes the errorInfo variable set by the compiled incr
+ command match the value set by the non-compiled version.
+ * tests/incr-old.test: Change errorInfo result for the compiled incr
+ command case to match the modified implementation.
+ * tests/incr.test: Add tests to make sure the compiled and
+ non-compiled errorInfo messages are the same.
2003-02-06 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: Filename arguments to [outputChannel]
and [errorChannel] (also -outfile and -errfile) were [open]ed but
- never [closed]. Also, [cleanupTests] could remove output or error
- files. [Bug 676978].
+ never [closed]. Also, [cleanupTests] could remove output or error
+ files. [Bug 676978].
* library/tcltest/pkgIndex.tcl: Bumped to version 2.2.2.
2003-02-05 Mo DeJong <mdejong@users.sourceforge.net>
* tests/interp.test:
- * tests/set-old.test: Run test cases that depend
- on hash order through lsort so that the tests
- also pass under Jacl. Does not change test
+ * tests/set-old.test: Run test cases that depend on hash order through
+ lsort so that the tests also pass under Jacl. Does not change test
results under Tcl.
2003-02-04 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -3050,172 +2950,158 @@
* win/tclWinFCmd.c:
* win/tclWinInit.c:
* win/tclWinInt.h:
- * tests/fileSystem.test: fix to finalization/unloading/encoding
- issues to make filesystem much less dependent on encodings for
- its cleanup, and therefore allow it to be finalized later in the
- exit process. This fixes fileSystem.test-7.1. Also fixed one
- more bug in setting of modification dates of files which have
- undergone cross-platform copies. [Patch 676271]
+ * tests/fileSystem.test: fix to finalization/unloading/encoding issues
+ to make filesystem much less dependent on encodings for its cleanup,
+ and therefore allow it to be finalized later in the exit process. This
+ fixes fileSystem.test-7.1. Also fixed one more bug in setting of
+ modification dates of files which have undergone cross-platform
+ copies. [Patch 676271]
* tests/basic.test:
* tests/exec.test:
* tests/fileName.test:
- * tests/io.test: fixed some test failures when tests are run
- from a directory containing spaces.
+ * tests/io.test: fixed some test failures when tests are run from a
+ directory containing spaces.
* tests/fileSystem.test:
- * generic/tclTest.c: added regression test for the modification
- date setting of cross-platform file copies.
+ * generic/tclTest.c: added regression test for the modification date
+ setting of cross-platform file copies.
2003-02-03 Kevin Kenny <kennykb@users.sourceforge.net>
* generic/tclBasic.c: Changed [trace add command] so that 'rename'
- callbacks get fully qualified names of the command. [Bug
- 651271]. ***POTENTIAL INCOMPATIBILITY***
- * tests/trace.test: Modified the test cases for [trace add
- command] to expect fully qualified names on the 'rename'
- callbacks. Added a case for renaming a proc within a namespace.
- * doc/trace.n: Added language about use of fully qualified names
- in trace callbacks.
+ callbacks get fully qualified names of the command. [Bug 651271].
+ ***POTENTIAL INCOMPATIBILITY***
+ * tests/trace.test: Modified the test cases for [trace add command] to
+ expect fully qualified names on the 'rename' callbacks. Added a case
+ for renaming a proc within a namespace.
+ * doc/trace.n: Added language about use of fully qualified names in
+ trace callbacks.
2003-02-01 Kevin Kenny <kennykb@users.sourceforge.net>
* generic/tclCompCmds.c: Removed an unused variable that caused
compiler warnings on SGI. [Bug 664379]
- * generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage
- is called to report the same package as being loaded in two interps,
- it shows up in [info loaded {}] in both of them (previously,
- it didn't appear in the static package list in the second.
+ * generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage is
+ called to report the same package as being loaded in two interps, it
+ shows up in [info loaded {}] in both of them (previously, it didn't
+ appear in the static package list in the second).
- * tests/load.test Added regression test for the above bug.
- [Bug 670042]
+ * tests/load.test Added regression test for the above bug. [Bug
+ 670042]
- * generic/tclClock.c: Fixed a bug that incorrectly allowed
- [clock clicks {}] and [clock clicks -] to be accepted as if
- they were [clock clicks -milliseconds].
+ * generic/tclClock.c: Fixed a bug that incorrectly allowed [clock
+ clicks {}] and [clock clicks -] to be accepted as if they were [clock
+ clicks -milliseconds].
- * tests/clock.test: Added regression tests for the above bug.
- [Bug 675356]
+ * tests/clock.test: Added regression tests for the above bug. [Bug
+ 675356]
- * tests/unixNotfy.test: Added cleanup of working files
- [Bug 675609]
+ * tests/unixNotfy.test: Added cleanup of working files. [Bug 675609]
* doc/Tcl.n: Added headings to the eleven paragraphs, to improve
formatting in the tools that attempt to extract tables of contents
from the manual pages. [Bug 627455]
- * generic/tclClock.c: Expanded mutex protection around the setting
- of env(TZ) and the thread-unsafe call to tzset(). [Bug 656660]
+ * generic/tclClock.c: Expanded mutex protection around the setting of
+ env(TZ) and the thread-unsafe call to tzset(). [Bug 656660]
2003-01-31 Don Porter <dgp@users.sourceforge.net>
* tests/tcltest.test: Cleaned up management of file/directory
- creation/deletion to improve "-debug 1" output. [Bug 675614]
+ creation/deletion to improve "-debug 1" output. [Bug 675614]
The utility [slave] command failed to properly [list]-quote a
constructed [open] command, causing failure when the pathname
- contained whitespace. [Bug 678415]
+ contained whitespace. [Bug 678415]
- * tests/main.test: Stopped main.test from deleting existing file.
- Test suite should not delete files that already exist. [Bug 675660]
+ * tests/main.test: Stopped main.test from deleting existing file. Test
+ suite should not delete files that already exist. [Bug 675660]
2003-01-28 Don Porter <dgp@users.sourceforge.net>
- * tests/main.test: Constrain tests that do not work on Windows.
- [Bug 674387]
+ * tests/main.test: Constrain tests that do not work on Windows. [Bug
+ 674387]
2003-01-28 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclIOUtil.c: fix to setting modification date
- in TclCrossFilesystemCopy. Also added 'panic' in
- Tcl_FSGetFileSystemForPath under illegal calling circumstances
- which lead to hard-to-track-down bugs.
+ * generic/tclIOUtil.c: fix to setting modification date in
+ TclCrossFilesystemCopy. Also added 'panic' in
+ Tcl_FSGetFileSystemForPath under illegal calling circumstances which
+ lead to hard-to-track-down bugs.
- * generic/tclTest.c: added test suite code to allow
- exercising a vfs-crash-on-exit bug in Tcl's finalization caused
- by the encodings being cleaned up before unloading occurs.
- * tests/fileSystem.test: added new 'knownBug' test 7.1
- to demonstrate the crash on exit.
+ * generic/tclTest.c: added test suite code to allow exercising a
+ vfs-crash-on-exit bug in Tcl's finalization caused by the encodings
+ being cleaned up before unloading occurs.
+ * tests/fileSystem.test: added new 'knownBug' test 7.1 to demonstrate
+ the crash on exit.
2003-01-28 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tcl.h: Add TCL_PREFIX_IDENT and
- TCL_DEBUG_IDENT, used only by TclpCreateProcess.
+ * generic/tcl.h: Add TCL_PREFIX_IDENT and TCL_DEBUG_IDENT, used only
+ by TclpCreateProcess.
* unix/Makefile.in: Define TCL_DBGX.
* win/Makefile.in: Define TCL_DBGX.
- * win/tclWinPipe.c (TclpCreateProcess):
- Check that the Tcl pipe dll actually exists
- in the Tcl bin directory and panic if it
- is not found. Incorporate TCL_DBGX into
- the Tcl pipe dll name. This fixes a really
- mysterious error that would show up when
- exec'ing a 16 bit application under Win95
- or Win98 when Tcl was compiled with symbols.
- The error seemed to indicate that the executable
- could not be found, but it was actually the
- Tcl pipe dll that could not be found.
+ * win/tclWinPipe.c (TclpCreateProcess): Check that the Tcl pipe dll
+ actually exists in the Tcl bin directory and panic if it is not found.
+ Incorporate TCL_DBGX into the Tcl pipe dll name. This fixes a really
+ mysterious error that would show up when exec'ing a 16 bit application
+ under Win95 or Win98 when Tcl was compiled with symbols. The error
+ seemed to indicate that the executable could not be found, but it was
+ actually the Tcl pipe dll that could not be found.
2003-01-26 Mo DeJong <mdejong@users.sourceforge.net>
- * win/README: Update msys+mingw URL to release 6.
- This version bundles gcc 3.
+ * win/README: Update msys+mingw URL to release 6. This version bundles
+ gcc 3.
2003-01-26 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Add test that checks to
- see if the compiler can cast to a union type.
- * win/tclWinTime.c: Squelch compiler warning
- about union initializer by casting to union
- type when compiling with gcc.
+ * win/configure.in: Add test that checks to see if the compiler can
+ cast to a union type.
+ * win/tclWinTime.c: Squelch compiler warning about union initializer
+ by casting to union type when compiling with gcc.
2003-01-25 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel):
- Invoke TclpCutFileChannel and TclpSpliceFileChannel.
- * generic/tclInt.h: Declare TclpCutFileChannel
- and TclpSpliceFileChannel.
+ * generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke
+ TclpCutFileChannel and TclpSpliceFileChannel.
+ * generic/tclInt.h: Declare TclpCutFileChannel and
+ TclpSpliceFileChannel.
* unix/tclUnixChan.c (FileCloseProc, TclpOpenFileChannel,
- Tcl_MakeFileChannel, TclpCutFileChannel,
- TclpSpliceFileChannel): Implement thread load data
- cut and splice for file channels. This avoids
- an invalid memory ref when compiled with -DDEPRECATED.
+ (Tcl_MakeFileChannel, TclpCutFileChannel, TclpSpliceFileChannel):
+ Implement thread load data cut and splice for file channels. This
+ avoids an invalid memory ref when compiled with -DDEPRECATED.
* win/tclWinChan.c (FileCloseProc, TclpCutFileChannel,
- TclpSpliceFileChannel): Implement thread load data
- cut and splice for file channels. This avoids
- an invalid memory ref that was showing up in the
- thread extension.
+ (TclpSpliceFileChannel): Implement thread load data cut and splice for
+ file channels. This avoids an invalid memory ref that was showing up
+ in the thread extension.
2003-01-25 Mo DeJong <mdejong@users.sourceforge.net>
* win/tclWin32Dll.c (TclpCheckStackSpace, squelch_warnings):
* win/tclWinChan.c (Tcl_MakeFileChannel, squelch_warnings):
* win/tclWinFCmd.c (DoRenameFile, DoCopyFile, squelch_warnings):
- Re-implement inline ASM SEH handlers for gcc.
- The esp and ebp registers are now saved on the
- stack instead of in global variables so that
- the code is thread safe. Add additional checks
- when TCL_MEM_DEBUG is defined to be sure the
- values were recovered from the stack properly.
- Remove squelch_warnings functions and add
- a dummy call in the handler methods to squelch
- compiler warnings.
+ Re-implement inline ASM SEH handlers for gcc. The esp and ebp
+ registers are now saved on the stack instead of in global variables so
+ that the code is thread safe. Add additional checks when TCL_MEM_DEBUG
+ is defined to be sure the values were recovered from the stack
+ properly. Remove squelch_warnings functions and add a dummy call in
+ the handler methods to squelch compiler warnings.
2003-01-25 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure:
- * win/configure.in: Define HAVE_ALLOCA_GCC_INLINE
- when we detect that no alloca function is found
- in malloc.h and we are compiling with GCC.
+ * win/configure.in: Define HAVE_ALLOCA_GCC_INLINE when we detect that
+ no alloca function is found in malloc.h and we are compiling with GCC.
Remove HAVE_NO_ALLOC_DECL define.
- * win/tclWin32Dll.c (TclpCheckStackSpace):
- Don't define alloca as a cdecl function.
- Doing this caused a tricky runtime bug because
- the _alloca function expects the size argument
- to be passed in a register and not on the stack.
- To fix this problem, we use inline ASM when
- compiling with gcc to invoke _alloca with the
- size argument loaded into a register.
+ * win/tclWin32Dll.c (TclpCheckStackSpace): Don't define alloca as a
+ cdecl function. Doing this caused a tricky runtime bug because the
+ _alloca function expects the size argument to be passed in a register
+ and not on the stack. To fix this problem, we use inline ASM when
+ compiling with gcc to invoke _alloca with the size argument loaded
+ into a register.
2003-01-24 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3223,57 +3109,53 @@
(DdeServerProc): better refcount handling of returnPackagePtr.
* generic/tclEvent.c (Tcl_Finalize): revert finalize change on
- 2002-12-04 to correct the issue with extensions that have TSD
- needing to finalize that before they are unloaded. This issue
- needs further clarification.
+ 2002-12-04 to correct the issue with extensions that have TSD needing
+ to finalize that before they are unloaded. This issue needs further
+ clarification.
* tests/unixFCmd.test: only do groups check on unix
2003-01-24 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and
- Tcl_AttemptSetObjectLength dealing with string objects with
- both pure-unicode and normal internal representations.
- Previous fix didn't handle all cases correctly.
- * generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has
- a valid 'objPtr->bytes' field before manipulating it directly.
+ * generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and
+ Tcl_AttemptSetObjectLength dealing with string objects with both
+ pure-unicode and normal internal representations. Previous fix didn't
+ handle all cases correctly.
+ * generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has a
+ valid 'objPtr->bytes' field before manipulating it directly.
This fixes [Bug 635200] and [Bug 671138], but may reduce performance
- of Unicode string handling in some cases. A further patch will
- be applied to address this, once the code is known to be correct.
+ of Unicode string handling in some cases. A further patch will be
+ applied to address this, once the code is known to be correct.
2003-01-24 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Add test to see if alloca
- is undefined in malloc.h.
- * win/tclWin32Dll.c (TclpCheckStackSpace): Rework
- the SEH exception handler logic to avoid using
- the stack since alloca will modify the stack.
- This was causing a nasty bug that would set the
- exception handler to 0 because it tried to pop
- the previous exception handler off the top of
- the stack.
+ * win/configure.in: Add test to see if alloca is undefined in
+ malloc.h.
+ * win/tclWin32Dll.c (TclpCheckStackSpace): Rework the SEH exception
+ handler logic to avoid using the stack since alloca will modify the
+ stack. This was causing a nasty bug that would set the exception
+ handler to 0 because it tried to pop the previous exception handler
+ off the top of the stack.
2003-01-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * doc/lset.n: Fixed fault in return values from lset in
- documentation examples [SF Bug #658463] and tidied up a bit at the
- same time.
+ * doc/lset.n: Fixed fault in return values from lset in documentation
+ examples [SF Bug #658463] and tidied up a bit at the same time.
2003-01-21 Joe English <jenglish@users.sourceforge.net>
+
* doc/namespace.n (namespace inscope): Clarified documentation
- [SF Patch #670110]
+ [Patch 670110]
2003-01-21 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX
- so that TCL_SHLIB_SUFFIX will be set to a useful
- value in the generated tclConfig.sh.
- Set SHLIB_LD_LIBS to "" or '${LIBS}' based on
- the --enable-shared flag. This matches the
- UNIX implementation.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX so that
+ TCL_SHLIB_SUFFIX will be set to a useful value in the generated
+ tclConfig.sh. Set SHLIB_LD_LIBS to "" or '${LIBS}' based on the
+ --enable-shared flag. This matches the UNIX implementation.
2003-01-18 Jeff Hobbs <jeffh@ActiveState.com>
@@ -3281,158 +3163,139 @@
2003-01-17 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWinDde.c (DdeServerProc): Deallocate
- the Tcl_Obj returned by ExecuteRemoteObject
- if it was not saved in a connection object.
+ * win/tclWinDde.c (DdeServerProc): Deallocate the Tcl_Obj returned by
+ ExecuteRemoteObject if it was not saved in a connection object.
2003-01-17 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tcl.h: Revert earlier change that
- defined TCL_WIDE_INT_TYPE as long long and
- TCL_LL_MODIFIER as L when compiling with
- mingw. This change ended up causing some
- test case failures when compiling with mingw.
- * generic/tclObj.c (UpdateStringOfWideInt):
- Describe the warning generated by mingw and
- why it needs to be ignored so that someone
- is not tempted to "fix" this problem again
- in the future.
+ * generic/tcl.h: Revert earlier change that defined TCL_WIDE_INT_TYPE
+ as long long and TCL_LL_MODIFIER as L when compiling with mingw. This
+ change ended up causing some test case failures when compiling with
+ mingw.
+ * generic/tclObj.c (UpdateStringOfWideInt): Describe the warning
+ generated by mingw and why it needs to be ignored so that someone is
+ not tempted to "fix" this problem again in the future.
2003-01-16 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclStringObj.c: Tcl_SetObjLength fix for when
- the object has a unicode string rep. Fixes [Bug 635200]
- * tests/stringObj.test: removed 'knownBug' constraint from
- test 14.1 now that this bug is fixed.
+ * generic/tclStringObj.c: Tcl_SetObjLength fix for when the object has
+ a unicode string rep. [Bug 635200]
+ * tests/stringObj.test: removed 'knownBug' constraint from test 14.1
+ now that this bug is fixed.
* generic/tclInt.h:
* generic/tclBasic.c:
* generic/tclCmdMZ.z:
* tests/trace.test: execution and command tracing bug fixes and
- cleanup. In particular fixed [Bug 655645], [Bug 615043],
- [Bug 571385]
- - fixed some subtle cleanup problems with tracing. This
- required replacing Tcl_Preserve/Tcl_Release with a more
- robust refCount approach. Solves at least one known crash
- caused by memory corruption.
- - fixed some confusion in the code between new style traces
- (Tcl 8.4) and the very limited 'Tcl_CreateTrace' which existed
- before.
- - made behaviour consistent with documentation (several
- tests even contradicted the documentation before).
+ cleanup. In particular fixed [Bug 655645], [Bug 615043], [Bug 571385]
+ - fixed some subtle cleanup problems with tracing. This required
+ replacing Tcl_Preserve/Tcl_Release with a more robust refCount
+ approach. Solves at least one known crash caused by memory
+ corruption.
+ - fixed some confusion in the code between new style traces (Tcl
+ 8.4) and the very limited 'Tcl_CreateTrace' which existed before.
+ - made behaviour consistent with documentation (several tests even
+ contradicted the documentation before).
- fixed some minor error message details
- added a number of new tests
2003-01-16 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinSerial.c (SerialOutputProc): add casts for
- bytesWritten to allow strict compilation (no warnings).
+ * win/tclWinSerial.c (SerialOutputProc): add casts for bytesWritten to
+ allow strict compilation (no warnings).
* tests/winDde.test:
- * win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty
- service name is passed to 'dde eval' and goto errorNoResult in
- request and poke error cases to free up any allocated data.
+ * win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty service
+ name is passed to 'dde eval' and goto errorNoResult in request and
+ poke error cases to free up any allocated data.
2003-01-16 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWin32Dll.c (squelch_warnings): Squelch
- compiler warnings from SEH ASM code.
- * win/tclWinChan.c (squelch_warnings): Squelch
- compiler warnings from SEH ASM code.
- * win/tclWinDde.c: Add casts to avoid compiler
- warnings. Pass pointer to DWORD instead of int
- to avoid compiler warnings.
- * win/tclWinFCmd.c (squelch_warnings): Add casts
- and fixup decls to avoid compiler warnings.
- Squelch compiler warnings from SEH ASM code.
- * win/tclWinFile.c: Add casts and fixup decls
- to avoid compiler warnings. Remove unused variable.
- * win/tclWinNotify.c: Declare as DWORD instead
- of int to avoid compiler warning.
- * win/tclWinReg.c: Add casts to avoid compiler
- warning. Fix assignment in if expression bug.
- * win/tclWinSerial.c: Add casts to avoid compiler
+ * win/tclWin32Dll.c (squelch_warnings): Squelch compiler warnings from
+ SEH ASM code.
+ * win/tclWinChan.c (squelch_warnings): Squelch compiler warnings from
+ SEH ASM code.
+ * win/tclWinDde.c: Add casts to avoid compiler warnings. Pass pointer
+ to DWORD instead of int to avoid compiler warnings.
+ * win/tclWinFCmd.c (squelch_warnings): Add casts and fixup decls to
+ avoid compiler warnings. Squelch compiler warnings from SEH ASM code.
+ * win/tclWinFile.c: Add casts and fixup decls to avoid compiler
warnings. Remove unused variable.
- * win/tclWinSock.c: Add casts and fixup decls
- to avoid compiler warnings.
+ * win/tclWinNotify.c: Declare as DWORD instead of int to avoid
+ compiler warning.
+ * win/tclWinReg.c: Add casts to avoid compiler warning. Fix assignment
+ in if expression bug.
+ * win/tclWinSerial.c: Add casts to avoid compiler warnings. Remove
+ unused variable.
+ * win/tclWinSock.c: Add casts and fixup decls to avoid compiler
+ warnings.
2003-01-14 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclClock.c (FormatClock): corrected typo that
- incorrectly conditionally defined savedTZEnv and savedTimeZone.
+ * generic/tclClock.c (FormatClock): corrected typo that incorrectly
+ conditionally defined savedTZEnv and savedTimeZone.
2003-01-13 Mo DeJong <mdejong@users.sourceforge.net>
Fix mingw build problems and compiler warnings.
- * generic/tcl.h: Add if defined(__MINGW32__)
- check to code that sets the TCL_WIDE_INT_TYPE
- and TCL_LL_MODIFIER.
- * generic/tclClock.c (FormatClock): Don't
- define savedTimeZone and savedTZEnv if
- we are not going to use them.
+ * generic/tcl.h: Add if defined(__MINGW32__) check to code that sets
+ the TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER.
+ * generic/tclClock.c (FormatClock): Don't define savedTimeZone and
+ savedTZEnv if we are not going to use them.
* generic/tclEnv.c: Add cast to avoid warning.
- * win/tclWinChan.c: Use DWORD instead of int
- to avoid compiler warning.
- * win/tclWinThrd.c: Only define allocLock,
- allocLockPtr, and dataKey when TCL_THREADS
- is defined. This avoid a compiler warning
- about unused variables.
+ * win/tclWinChan.c: Use DWORD instead of int to avoid compiler warning
+ * win/tclWinThrd.c: Only define allocLock, allocLockPtr, and dataKey
+ when TCL_THREADS is defined. This avoid a compiler warning about
+ unused variables.
2003-01-12 Mo DeJong <mdejong@users.sourceforge.net>
- * win/README: Update msys + mingw URL, the
- new release includes the released 1.0.8
- version of msys which includes a number
- of bug fixes.
+ * win/README: Update msys + mingw URL, the new release includes the
+ released 1.0.8 version of msys which includes a number of bug fixes.
2003-01-12 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in
- addition of shell32.lib to LIBS_GUI that
- was added to the Tk tcl.m4 but never made
- it back into the Tcl version.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in addition of shell32.lib to
+ LIBS_GUI that was added to the Tk tcl.m4 but never made it back into
+ the Tcl version.
2003-01-12 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tcl.h: Skip Tcl's define of CHAR,
- SHORT, and LONG when HAVE_WINNT_IGNORE_VOID
- is defined. This avoids a bunch of compiler
+ * generic/tcl.h: Skip Tcl's define of CHAR, SHORT, and LONG when
+ HAVE_WINNT_IGNORE_VOID is defined. This avoids a bunch of compiler
warnings when building with Cygwin or Mingw.
* win/configure: Regen.
- * win/configure.in: Define HAVE_WINNT_IGNORE_VOID
- when we detect a winnt.h that still defines
- CHAR, SHORT, and LONG when VOID has already
+ * win/configure.in: Define HAVE_WINNT_IGNORE_VOID when we detect a
+ winnt.h that still defines CHAR, SHORT, and LONG when VOID has already
been defined.
- * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the
- TCL_DEFS loaded from tclConfig.sh so that
- Tcl defines can make it into the Tk Makefile.
+ * win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the TCL_DEFS loaded from
+ tclConfig.sh so that Tcl defines can make it into the Tk Makefile.
2003-01-12 Mo DeJong <mdejong@users.sourceforge.net>
* win/configure: Regen.
- * win/configure.in: Check for typedefs like LPFN_ACCEPT
- in winsock2.h and define HAVE_NO_LPFN_DECLS if not found.
- * win/tclWinSock.c: Define LPFN_* typedefs if
- HAVE_NO_LPFN_DECLS is defined. This fixes the build
- under Mingw and Cygwin, it was broken by the changes
- made on 2002-11-26.
+ * win/configure.in: Check for typedefs like LPFN_ACCEPT in winsock2.h
+ and define HAVE_NO_LPFN_DECLS if not found.
+ * win/tclWinSock.c: Define LPFN_* typedefs if HAVE_NO_LPFN_DECLS is
+ defined. This fixes the build under Mingw and Cygwin, it was broken by
+ the changes made on 2002-11-26.
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 filesystem.
+ introduced on 2002-12-06. Encodings must be cleaned up after the
+ filesystem.
* win/makefile.vc: fix to minor VC++ 5.2 syntax problem
2003-01-09 Don Porter <dgp@users.sourceforge.net>
* generic/tclCompCmds.c (TclCompileReturnCmd): Corrected off-by-one
- problem with recent commit. [Bug 633204]
+ problem with recent commit. [Bug 633204]
2003-01-09 Vince Darley <vincentdarley@users.sourceforge.net>
@@ -3445,40 +3308,38 @@
* mac/tclMacFile.c:
* win/tclWinFile.c:
* win/tclWinInt.h:
- * win/tclWin32Dll.c:
- * tests/cmdAH.test: fix to non-ascii chars in paths when
- setting mtime and atime through 'file (a|m)time $path $time'
- [Bug 634151]
+ * win/tclWin32Dll.c:
+ * tests/cmdAH.test: fix to non-ascii chars in paths when setting mtime
+ and atime through 'file (a|m)time $path $time'. [Bug 634151]
2003-01-08 Don Porter <dgp@users.sourceforge.net>
- * generic/tclExecute.c (TclExprFloatError): Use the IS_NAN macro
- for greater clarity of code.
+ * generic/tclExecute.c (TclExprFloatError): Use the IS_NAN macro for
+ greater clarity of code.
2003-01-07 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCompCmds.c (TclCompileReturnCmd):
- * tests/compile.test: Corrects failure of bytecompiled
- [catch {return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204].
- This patch is a workaround for 8.4.X. A new opcode INST_RETURN is a
- better long term solution for 8.5 and later.
+ * generic/tclCompCmds.c (TclCompileReturnCmd):
+ * tests/compile.test: Corrects failure of bytecompiled [catch
+ {return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204]. This
+ patch is a workaround for 8.4.X. A new opcode INST_RETURN is a better
+ long term solution for 8.5 and later.
2003-01-04 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc:
- * win/rules.vc: Fixed INSTALLDIR macro problem that blanked itself
- by accident causing the install target to put the tree at the root
- of the drive built on. Whoops..
-
- Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc'
- to allow the switching _on_ of the thread allocator. Under testing,
- I found it not to be benificial under windows for the purpose of the
- application I was using it for. It was more important for this app
+ * win/rules.vc: Fixed INSTALLDIR macro problem that blanked itself by
+ accident causing the install target to put the tree at the root of the
+ drive built on. Whoops..
+
+ Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc' to
+ allow the switching _on_ of the thread allocator. Under testing, I
+ found it not to be benificial under windows for the purpose of the
+ application I was using it for. It was more important for this app
that resources for tcl threads be returned to the system rather than
- saved/moved to the global recycler. Be extra clean or extra fast
- for the default threaded build? Let's move to clean and allow it to
- be switched on for users who find it benificial for their use of
- threads.
+ saved/moved to the global recycler. Be extra clean or extra fast for
+ the default threaded build? Let's move to clean and allow it to be
+ switched on for users who find it benificial for their use of threads.
******************************************************************
*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" ***
diff --git a/ChangeLog.2004 b/ChangeLog.2004
new file mode 100644
index 0000000..82acd5c
--- /dev/null
+++ b/ChangeLog.2004
@@ -0,0 +1,4619 @@
+2004-12-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tcl.m4, win/configure: update MSVC CFLAGS_OPT to -O2, remove -Gs
+ (included in -O2) and -GD (outdated). Use "link -lib" instead of "lib"
+ binary and remove -YX for MSVC7 portability. Add -fomit-frame-pointer
+ for gcc OPT compiles. [Bug 1092952, 1091967] Align LIBS_GUI with Tk
+ head needs.
+
+2004-12-29 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclDate.c: Regen
+ * generic/tclGetDate.y (TclDatelex): Fixed a problem where a
+ four-digit group with >=2 leading zeroes appeared to be a two-digit
+ group, leading to misinterpreting the time 0012 as 1200. [Bug 1090413]
+ * library/clock.tcl: Added code to interpret correctly months outside
+ the range 01-12 as reduced modulo 12 with a corresponding adjustment
+ to the year. [Bug 1092789]
+ * tests/clock.test: Added regression test cases for the above two bugs
+ * unix/Makefile.in: Added --no-lines to the 'bison' command line to
+ * win/Makefile.in: help constrain the number of diffs in a cvs checkin
+
+2004-12-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclLiteral.c:
+ * generic/tclProc.c:
+ Avoid sharing cmdName literals accross namespaces, and generalise
+ usage of the TclRegisterNewLiteral macro. [Patch 1090905]
+
+2004-12-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c
+ * generic/tclProc.c: new static InitCompiledLocals to allow for a
+ single pass over the proc's arguments at proc load time (instead of
+ two as previously). TclObjInterpProc() now allocates the
+ compiledLocals on the tcl execution stack, using the new
+ TclStackAlloc/Free functions.
+
+2004-12-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback):
+ (TclLimitRemoveAllHandlers, TclInitLimitSupport): Set a timer event to
+ trigger when the time limit runs out. All the time limit actually does
+ is check to see if the time limit has been exceeded, but this is
+ enough to fix [Bug 1085023].
+ * generic/tclInt.h (struct Interp): Added a field to hold the token
+ for the timer event handler associated with the current time limit.
+ * generic/tclEvent.c (Tcl_UpdateObjCmd, Tcl_VwaitObjCmd): Add error
+ message when limit exceeded.
+ * tests/interp.test (interp-34.[89]): Check that time limits handle
+ the two cases reported in [Bug 1085023]
+
+ * generic/tclTimer.c (TclCreateAbsoluteTimerHandler): New internal
+ function that allows setting a timer handler that will be triggered at
+ (or after) a specific time instead of at some number of milliseconds
+ in the future. This is a candidate for future exposure via a TIP.
+
+2004-12-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclNamesp.c:
+ * generic/tclProc.c:
+ * generic/tclStubInit.c:
+ * generic/tclTest.c: Added two new functions to allocate memory from
+ the execution stack (TclStackAlloc, TclStackFree). Added functions
+ TclPushStackFrame and TclPopStackFrame that do the work of
+ Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames allocated in
+ the execution stack - i.e., heap instead of C-stack. The core uses
+ these two new functions exclusively; the old ones remain for backwards
+ compat, as at least two popular extensions (itcl, xotcl) are known to
+ use them.
+
+2004-12-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c:
+ * generic/tclInt.h:
+ * generic/tclProc.c:
+ * generic/tclVar.c: changing the isProcCallFrame field of the
+ CallFrame struct from a 0/1 field to flags. Should be perfectly
+ backwards compatible.
+
+2004-12-14 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/configure.in: Added special processing to remove "$U" from
+ libraries in the LIBOBJS value. This is an auto-make-ism we need to
+ avoid. [Bug 1081541]
+
+ * unix/configure: autoconf-2.57
+
+2004-12-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Restored extern "C" guards so that C++ code sees
+ function pointer typedef linkage consistent with earlier Tcl releases.
+ [Bug 1082349]
+
+ * generic/tclEncoding.c: Plugged some memory leaks. Thanks to Rolf Ade
+ * generic/tclUtil.c: for reports and testing [Bug 1083082]
+
+2004-12-13 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n: Clarify that the [clock scan] command does not accept
+ the full range of ISO8601 point-in-time formats. [Bug 1075433]
+
+2004-12-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclArrayObjCmd - ARRAY_NAMES): leaking an object
+ [Bug 1084111] - thanks to Rolf Ade.
+
+2004-12-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclObj.c (TclSetCmdNameObj): special handling for fully
+ qualified command names (as in fix [Patch 456668]).
+
+2004-12-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclNamesp.c: converting the static function
+ GetNamespaceFromObj() to MODULE_SCOPE TclGetNamespaceFromObj().
+
+2004-12-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/tcl.wse.in, unix/tcl.spec, win/README.binary, README:
+ * win/configure.in, unix/configure.in, generic/tcl.h:
+ Bumped version number to 8.5a3 to distinguish HEAD of CVS development
+ from the recent 8.5a2 release.
+
+2004-12-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclInitCompiledLocals):
+ * generic/tclCompile.h:
+ * generic/tclInt.h:
+ * generic/tclProc.c (TclObjInterpProc, TclCreateProc): optimised
+ loops that initialise a proc's arguments and compiled local
+ variables, removing tests from inner loops.
+
+2004-12-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h: Move ensemble API decls here from tclNamesp.c
+
+2004-12-09 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (TclMakeEnsembleCmd, TclSetEnsemble*)
+ (TclSetEnsemble*, TclFindEnsemble): Build an internal API for creating
+ and manipulating ensembles; they can be deleted using the normal
+ command-deletion API.
+
+ * doc/Async.3: Reword for better grammar, better nroff and get the
+ flag name right. (Reported by David Welton.)
+
+2004-12-07 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/unixInit.test (2.1-4): Added constraints so that when a value
+ of TCL_LIBRARY is required for process initialization, we skip the
+ tests that mess with that value.
+
+2004-12-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ *** 8.5a2 TAGGED FOR RELEASE ***
+
+ * unix/Makefile.in: add library/{tzdata,msgs} to dist target (kbk)
+
+ * doc/foreach.n: Adjust tabs to be friendlier to some HTML
+ converters. [Bug 1078760]
+
+2004-12-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixNotfy.c (NotifierThreadProc): init numFdBits
+ [Bug 1079286]
+
+ * doc/error.n, doc/SaveResult.3, doc/Thread.3: minor nroff typos
+
+2004-12-06 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/safe.test: Trim auto_path to improve performance [1080039]
+
+ * tests/msgcat.test: makeFile/removeFile cleanup [1079117]
+
+2004-12-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEncoding.c: Different fix for [Bug 1077005].
+ * generic/tclEvent.c: Broke apart TclpSetInitialEncodings() on
+ * generic/tclInt.h: Windows into TclpSetInterfaces(), that is
+ * unix/tclUnixInit.c: fundamentally essential, and the initialization
+ * win/tclWinInit.c: of the system encoding, which is not. Made
+ the TclpSetInterfaces call part of TclInitSubsystems so it cannot be
+ overlooked.
+
+2004-12-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * changes: updated for 8.5a2 release
+
+2004-12-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c (TclSetProcessGlobalValue): Handle the case where
+ a ProcessGlobalValue might be assigned to itself.
+
+ * generic/tclEncoding.c (MakeFileMap): Correct refcounting errors
+ managing values returned by TclPathPart (with refCount of 1!) that led
+ to a memory leak. [Bug 1077474].
+
+2004-12-02 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix and new tests for [Bug 1074671] to ensure
+ * tests/fileSystem.test: tilde paths are not returned specially by
+ 'glob'.
+
+2004-12-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/Makefile.in: Added a 'sed' in the setting of ROOT_DIR_NATIVE to
+ compensate for a bug in cygpath (at least version 1.36) that leaves a
+ trailing backslash on the end of the converted path.
+
+2004-12-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (Alias,Target,Master): Rewrote these so that the
+ aliases that refer to an interpreter are stored in a list and not a
+ hashtable (which was only ever a convenience, and forced the use of a
+ global mutex to generate keys!) [FRQ 1077210]
+ * generic/tclNamesp.c (numNsCreated): Moved into thread-local storage
+ to remove a global mutex. [FRQ 1077210]
+
+2004-12-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c (TclGetProcessGlobalValue): Narrowed the scope of
+ mutex locks.
+
+ * generic/tclUtil.c: Updated Tcl_GetNameOfExecutable() to
+ * generic/tclEncoding.c: make use of a ProcessGlobalValue for
+ * generic/tclEvent.c: storing the executable name. Added
+ internal routines Tcl(Get|Set)ObjNameOfExecutable() to access that
+ storage in Tcl_Obj, rather than string format.
+
+ * unix/tclUnixFile.c: Rewrote TclpFindExecutable() to use
+ * win/tclWinFile.c: TclSetObjNameOfExecutable to store the
+ executable name it computes.
+
+ * generic/tclInt.h: Added internal stub entries for
+ * generic/tclInt.decls: TclpFindExecutable and
+ Tcl(Get|Set)ObjNameOfExecutable.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclCmdIL.c: Retrieve executable name in Tcl_Obj form
+ * win/tclWinPipe.c: instead of string form.
+
+ * unix/tclUnixTest.c: Update [testfindexecutable] command to use new
+ internal interfaces.
+
+ * generic/tclEncoding.c: Moved TclpSetInitialEncodings() call
+ from Tcl_FindExecutable() into TclInitEncodingSubsystem(). This is
+ important on Windows where it establishes whether the "ascii" or
+ "unicode" set of system routines will be used, and that needs to be
+ done earlier to support filesystem operations. [Bug 1077005]
+
+2004-12-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/winDde.test: Rewritten to use tcltest2 features more
+ thoroughly (reducing the [catch] count!) and fix the problem with
+ winDde-6.1 being out of synch with the implementation.
+
+2004-11-30 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl ([unknown]): Restored the save/restore of the
+ variables ::errorCode and ::errorInfo. This is needed when the
+ [::bgerror] command is auto-loaded (as it is by Tk).
+
+ Patch 976520 reworks several of the details involved with
+ startup/initialization of the Tcl library, focused on the activities
+ of Tcl_FindExecutable().
+
+ * generic/tclIO.c: Removed bogus claim in comment that encoding
+ "iso8859-1" is "built-in" to Tcl.
+
+ * generic/tclInt.h: Created a new struct ProcessGlobalValue,
+ * generic/tclUtil.c: routines Tcl(Get|Set)ProcessGlobalValue, and
+ function type TclInitProcessGlobalValueProc. Together, these take care
+ of the housekeeping for "values" (things that can be held in a
+ Tcl_Obj) that are global across a whole process. That is, they are
+ shared among multiple threads, and epoch and mutex protection must
+ govern the validity of cached copies maintained in each thread.
+
+ * generic/tclNotify.c: Modified TclInitNotifier() to tolerate being
+ called multiple times in the same thread.
+ * generic/tclEvent.c: Dropped the unused argv0 argument to
+ TclInitSubsystems(). Removed machinery to unsure only one
+ TclInitNotifier() call per thread, now that that is safe. Converted
+ Tcl(Get|Set)LibraryPath to use a ProcessGlobalValue, and moved them to
+ tclEncoding.c.
+ * generic/tclBasic.c: Updated caller.
+
+ * generic/tclInt.h: TclpFindExecutable now returns void.
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c:
+ * win/tclWinPipe.c:
+
+ * generic/tclEncoding.c: Built new encoding search initialization on a
+ foundation of ProcessGlobalValues, exposing new routines
+ Tcl(Get|Set)EncodingSearchPath. A cache of a map from encoding name to
+ directory pathname keeps track of where encodings are available for
+ loading. Tcl_FindExecutable greatly simplified into just three
+ function calls. The "library path" is now misnamed, as its only
+ remaining purpose is as a foundation for the default encoding search
+ path.
+
+ * generic/tclInterp.c: Inlined the initScript that is evaluated by
+ Tcl_Init(). Added verification after initScript evaluation that Tcl
+ can find its installed *.enc files, and that it has initialized
+ [encoding system] in agreement with what the environment expects.
+ [tclInit] no longer driven by the value of $::tcl_libPath; it largely
+ constructs its own search path now, rather than attempt to share one
+ with the encoding system.
+
+ * unix/tclUnixInit.c: TclpSetInitialEncodings factored so that a new
+ * win/tclWinInit.c: routine TclpGetEncodingNameFromEnvironment can
+ reveal that Tcl thinks the [encoding system] should be, even when an
+ incomplete encoding search path, or a missing *.enc file won't allow
+ that initialization to succeed. TclpInitLibraryPath reworked as an
+ initializer of a ProcessGlobalValue.
+
+ * unix/tclUnixTest.c: Update implementations of [testfindexecutable],
+ [testgetdefenc], and [testsetdefenc].
+
+ * tests/unixInit.test: Corrected tests to operate properly even when
+ a value of TCL_LIBRARY is required to find encodings.
+
+ * generic/tclInt.decls: New internal stubs: TclGetEncodingSearchPath,
+ TclSetEncodingSearchPath, TclpGetEncodingNameFromEnvironment. These
+ are candidates for public exposure by future TIPs.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclTest.c: Updated [testencoding] to use
+ * tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests.
+
+2004-11-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Corrected the regular expressions that match a
+ time zone to allow for time zones specified as +HH or -HH.
+ * tests/clock.test: Added regression test case for the above issue.
+ Thanks to Rolf Ade for reporting this issue [http://wiki.tcl.tk/13094]
+ * win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a
+ compilation failure on VC++.
+
+2004-11-29 Andreas Kupries <andreask@activestate.com>
+
+ * win/Makefile.in (install-libraries): Brought entry '2004-10-26 Don
+ Porter (Tcl Modules)' into the windows world, actually the
+ win/configure buildsystem. The other windows buildsystems (.vc, .bc)
+ still have to be updated as well.
+
+2004-11-26 Andreas Kupries <andreask@activestate.com>
+
+ * win/tclWinDde.c (ExecuteRemoteObject): Removed bogus semicolon found
+ at the end of the header for the function definition, terminating it
+ early and preventing a compile. This is likely a fix for '2004-11-25
+ Donal'. I have to conclude that it is also unknown if the other
+ changes to this file actually pass the testsuite. Running testsuite
+ ... They don't. winDde-6.1 fails. This is only a message discrepance,
+ i.e. not too bad. Leaving resolution of that to Pat and Donal.
+
+2004-11-26 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl (tcl_findLibrary): Made sure the uniquifying
+ operations on the search path does not also normalize. [Bug 1072136]
+
+2004-11-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/configure.in: Simplify the code to check for correctness of
+ strstr, strtoul and strtod.
+ * unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza out
+ of configure.in into its own function. Also force it to do the right
+ thing with cacheing of results of AC_TRY_RUN to deal with issue raised
+ in [Patch 1073524]
+
+ * doc/foreach.n: Added simple example. [FRQ 1073334]
+
+2004-11-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclProc.c (TclObjInterpProc): Make it so that only
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): [proc] instances do
+ * tests/indexObj.test (indexObj-5.7): quoting of their first
+ arguments, so keeping [Bug 942757] fixed and making [Bug 1066837] be
+ fixed as well. Done with a load of #ifdef-ery because this hack is so
+ ugly nobody should keep it around once Itcl's fixed.
+
+2004-11-25 Reinhard Max <max@suse.de>
+
+ * tests/tcltest.test: The order in which [glob] returns the file names
+ is undefined, so tests should not depend on it.
+
+2004-11-25 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * doc/Thread.3:
+ * doc/Notifier.3: Added changes from the core-8-4-branch
+
+2004-11-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/dde.n: Synchronized the documentation of the commands with the
+ header of the docs and what the package actually does. Thanks to
+ Andreas Kupries for spotting this.
+ * win/tclWinDde.c (Tcl_DdeObjCmd): Much cleanup of argument parsing
+ code.
+
+2004-11-24 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclPort.h: Relative include of tclWinPort.h returned as it
+ was requiring me set -I$(tcl_root)/win for my extensions that need to
+ include tclInt.h and doesn't appear to serve any purpose for windows
+ builds.
+
+2004-11-24 Kevin B. Kenny <kennykb@acm.org>
+
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected bad check for 3-argument
+ readdir_r [Bug 1001325].
+ * unix/configure: Regenerated.
+ * unix/tclUnixNotfy.c: Corrected all uses of 'select' to manage their
+ masks using the FD_CLR, FD_ISSET, FD_SET, and FD_ZERO macros rather
+ than bit-whacking that failed under Solaris-Sparc-64. [Bug 1071807]
+ * win/tclWinInit.c (TclpInitLibraryPath): Removed unused vars 'pathc'
+ and 'pathv' that caused compilation problems on VC++ with
+ --enable-symbols.
+
+2004-11-24 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Corrected failure to determine the
+ number of arguments for readdir_r on SunOS systems. [Bug 1071701]
+
+ * unix/configure: autoconf-2.57
+
+ * generic/tclCmdIL.c (InfoVarsCmd): Corrected segfault in new
+ * tests/info.test (info-19.6): trivial matching branch [Bug 1072654]
+
+2004-11-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4.
+ * tools/man2html2.tcl: Fix broken .SS handling.
+
+2004-11-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h
+ into the dependency tree and 'make distclean'. [Bug 1068171]
+
+ * generic/tclResult.c (Tcl_AppendResultVA): Remove call to
+ Tcl_GetStringResult to speed up repeated calls to Tcl_AppendResult
+ with the side effect that code that wants to access interp->result
+ should always call Tcl_GetStringResult first. See [Patch 1041072]
+ discussion for more details.
+
+2004-11-22 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Define HAVE_TYPE_OFF64_T only when
+ off64_t, open64(), and lseek64() are defined. IRIX 5.3 is known to not
+ include an open64 function. [Bug 1030465]
+
+2004-11-22 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_ENABLE_THREADS): Check for a 2 argument version of
+ readdir_r that is known to exists under IRIX 5.3.
+ * unix/tclUnixThrd.c (TclpReaddir): Use either 2 arg or 3 arg version
+ of readdir_r. [Bug 1001325]
+
+2004-11-22 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixInit.c (TclpInitLibraryPath): Purged dead code that used
+ * win/tclWinInit.c (TclpInitLibraryPath): to extend the "library
+ path". Search path construction for init.tcl is now done within the
+ [tclInit] proc.
+ * generic/tclInterp.c: Restored several directories to the search
+ * tests/unixInit.test: path used to locate init.tcl within [tclInit].
+ This change does not restore any directories to the encoding search
+ path, so should still avoid the price of an unreasonably large number
+ of filesystem accesses during encoding initialization at startup
+ [Bug 976438]
+
+2004-11-22 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix and new test for [Bug 1043129] in the
+ * tests/fileSystem.test: treatment of backslashes in file join on
+ Windows.
+
+2004-11-21 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/AddErrInfo.3: Typo corrections (Thanks Daniel South).
+ * doc/interp.n:
+
+2004-11-19 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/AddErrInfo.3: Docs for Tcl_(Get|Set)ReturnOptions. [TIP 227]
+
+ * doc/AddErrInfo.3:
+ * doc/Async.3: Documentation updates to replace references
+ * doc/BackgdErr.3: to global variable ::errorInfo and ::errorCode
+ * doc/SaveResult.3: and to the ::bgerror command with references
+ * doc/after.n: to their preferred replacements, the
+ * doc/bgerror.n: -errorinfo and -errorcode return options,
+ * doc/error.n: the Tcl_*InterpState routines, and the
+ * doc/exec.n: [interp bgerror] command.
+ * doc/exit.n:
+ * doc/fileevent.n:
+ * doc/interp.n:
+ * doc/return.n:
+ * doc/tclvars.n:
+ * doc/update.n:
+
+ * tests/unixInit.test: Removed "knownBug" constraints to prompt bug
+ fixing before 8.5a2 release.
+
+2004-11-19 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Makefile:
+ * unix/configure.in:
+ * unix/tclUnixInit.c (MacOSXGetLibraryPath): changed detection of tcl
+ framework build when determining tclLibPath from overloaded
+ TCL_LIBRARY to configuration define TCL_FRAMEWORK. [Bug 1068088]
+
+ * unix/configure: autoconf-2.57
+ * unix/tclConfig.h.in: autoheader-2.57
+
+2004-11-18 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/SaveResult.3: Documentation for Tcl_*InterpState (TIP 226).
+
+ * generic/tclEvent.c (HandleBgErrors): Simplified program flow.
+
+ * tests/basic.test: Updated functional (not testing) uses of
+ * tests/io.test: [bgerror] to make use of [interp bgerror].
+ * tests/socket.test:
+ * tests/timer.test:
+
+ * tests/interp.test (interp-36.*): [interp bgerror] tests.
+
+ * generic/tclInterp.c: Corrected [interp bgerror] error messages.
+
+2004-11-18 Reinhard Max <max@suse.de>
+
+ * unix/tcl.m4 (SC_CONFIG_MANPAGES): Applied an improved version of
+ * unix/configure.in: [Patch 996085], that introduces
+ * unix/Makefile.in: --enable-man-suffix.
+
+ * unix/installManPage: added
+ * unix/mkLinks.tcl: removed
+ * unix/mkLinks: removed
+ * unix/configure: generated
+
+ * unix/Makefile.in: Don't install tclConfig.h .
+
+2004-11-17 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/configure.in: The change below reveals that the public data
+ type Tcl_StatBuf relies on config information. For now, disabled the
+ use of the tclConfig.h file until its full impact on Tcl's interface
+ can be assessed.
+
+ * unix/configure: autoconf-2.57
+
+ * generic/tcl.h: Moved the #include "tclConfig.h" out of
+ * generic/tclInt.h: tcl.h. The config settings are not part of
+ * generic/tclPort.: the public interface, and having it there
+ breaks compiled against uninstalled Tcl and extensions using
+ autoconf-2.5*.
+
+2004-11-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixChan.c (TtySetOptionProc): fixed crash configuring
+ -ttycontrol on a channel. [Bug 1067708]
+
+2004-11-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOUtil.c (TclFSEpochOk): There were two code paths via
+ which the thread copy of filesystemEpoch could be synched with the
+ master copy, but only one kept the filesystem list cache up to date.
+ Fix routes everything through a single code path. [Bug 1035775].
+
+2004-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Stop architecture flags to 'ld' from
+ getting lost when [load] is disabled. [Bug 1016796]
+
+2004-11-16 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tcl.h:
+ * unix/configure.in: changed HAVE_CONFIG_H to HAVE_TCL_CONFIG_H.
+
+ * unix/configure: autoconf-2.57
+
+2004-11-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Added comment warning that the old ERR_IN_PROGRESS
+ and ERROR_CODE_SET flag values should not be re-used for the sake of
+ those extensions that have accessed them.
+
+ * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Fixed Bug 1065378 which failed
+ * tests/trace.test (trace-33.1): to permit a variable trace
+ created with [trace variable] to be destroyed with [trace remove].
+ Thanks to Keith Vetter for the report.
+
+2004-11-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/tclvars.n: Added section to documentation on global variables
+ that are specific to tclsh and wish. [Patch 1065732]
+
+2004-11-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclEncoding.c (TableFromUtfProc): correct crash condition
+ when TCL_UTF_MAX == 6. [Bug 1004065]
+
+2004-11-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/interp.n: Basic documentation of the TIP#221 API.
+
+2004-11-12 Don Porter <dgp@users.sourceforge.net>
+
+ TIP #221 IMPLEMENTATION
+ * generic/tclBasic.c: Define [::tcl::Bgerror] in new interps.
+ * generic/tclEvent.c: Update Tcl_BackgroundError to make use of the
+ registered [interp bgerror] command.
+ * generic/tclInterp.c: New [interp bgerror] subcommand.
+ * tests/interp.test: syntax tests updated.
+
+ TIP #226 IMPLEMENTATION
+ * generic/tcl.decls: Stubs for Tcl_(Save|Restore|Discard)InterpState
+ * generic/tcl.h: New public opaque type, Tcl_InterpState.
+ * generic/tclInt.h: Drop old private declarations. Add
+ Tcl(Get|Set)BgErrorHandler
+ * generic/tclResult.c: Tcl_*InterpState implementations.
+ * generic/tclDictObj.c: Update callers.
+ * generic/tclIOGT.c:
+ * generic/tclTrace.c:
+
+ TIP #227 IMPLEMENTATION
+ * generic/tcl.decls: Stubs for Tcl_(Get|Set)ReturnOptions.
+ * generic/tclInt.h: Drop old private declarations.
+ * generic/tclResult.c: Tcl_*ReturnOptions implementations.
+ * generic/tclCmdAH.c: Update callers.
+ * generic/tclMain.c:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * unix/tclAppInit.c: Removed tclConfig.h #include, now that tcl.h
+ takes care of it for us.
+
+ * generic/tclInt.h: Moved verification of ptrdiff_t typedef from
+ * generic/tclExecute.c: multiple .c files into one common header where
+ * generic/tclVar.c: it is verifiably after tclConfig.h inclusion.
+
+2004-11-12 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tcl.h:
+ * generic/tclInt.h:
+ * unix/Makefile.in: include tclConfig.h from tcl.h and install it as a
+ public header. Normalized compiler include path order to
+ -I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR}.
+
+ * unix/dltest/Makefile.in: add ${BUILD_DIR}/.. to include path to pick
+ up tclConfig.h.
+
+ * unix/tclUnixInit.c: moved check for HAVE_CFBUNDLE define after
+ #include "tclInt.h" to ensure tclConfig.h has been included.
+
+2004-11-12 Reinhard Max <max@suse.de>
+
+ * unix/config.h.in:
+ * unix/tclConfig.h.in: renamed
+
+ * unix/Makefile.in: Completed support for config header,
+ * unix/configure.in: fixed building outside of the unix dir,
+ * unix/tclAppinit.c: and reflected the name change of config.h.
+ * generic/tclInt.h:
+
+ * unix/configure: generated
+
+2004-11-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/config.h.in: Allow configure to put all the C #defs into
+ * unix/configure.in: a file (called config.h) so that Unix builds
+ * unix/tcl.m4: now take far fewer lines of scrollback to
+ * unix/Makefile.in: proceed (making it less likely that any errors
+ * generic/tclInt.h: or warnings will get missed).
+ * unix/tclAppInit.c: Part of the TIP#34 upgrades.
+
+ * unix/tcl.m4, unix/tclUnixPort.h: Check for pthread_attr_get_np in
+ <pthread.h> before forcing the use of <pthread_np.h> to make things
+ work on NetBSD 2.0. [Bug 1064882]
+
+ * doc/binary.n, doc/upvar.n: More minor fixes.
+
+2004-11-12 Daniel Steffen <das@users.sourceforge.net>
+
+ * doc/CrtChannel.3:
+ * doc/Interp.3:
+ * doc/Limit.3:
+ * doc/binary.n:
+ * doc/dict.n:
+ * doc/tm.n:
+ * doc/upvar.n: fixed *roff errors uncovered by running 'make html'.
+
+ * tools/tcltk-man2html.tcl: added faked support for bullet point
+ lists, i.e. *nroff ".IP \(bu" syntax.
+
+2004-11-11 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/fCmd.test:
+ * unix/tclUnixFCmd.c (TraverseUnixTree): added option to rewind() the
+ readdir() loop whenever the source hierarchy has been modified by
+ traverseProc (e.g. by deleting files); this is required to ensure
+ complete traversal of the source hierarchy on certain filesystems like
+ HFS+. Added test for failing recursive delete on Mac OS X that was due
+ to this. [Bug 1034337]
+
+ * generic/tclListObj.c (Tcl_ListObjReplace): use memmove() instead of
+ manual copy loop to shift list elements. Decreases time spent in
+ Tcl_ListObjReplace() from 5.2% to 1.7% of overall runtime of tclbench
+ on a ppc 7455 (i.e. 200% speed increase). [Patch 1064243]
+
+ * generic/tclHash.c: hoisted some constant pointer dereferences out of
+ loops to eliminate redundant loads that the gcc optimizer didn't deal
+ with. Decreases time spend in Tcl_FindHashEntry() by 10% over a full
+ run of the tcl testuite on a ppc 7455. [Patch 1064243]
+
+ * tests/fileName.test:
+ * tests/fileSystem.test:
+ * tests/io.test:
+ * tests/msgcat.test:
+ * tests/tcltest.test:
+ * tests/unixInit.test: fixed bugs causing failures when running tests
+ with -tmpdir arg not set to working dir.
+
+ * macosx/Makefile: corrected path to html help inside framework.
+ Prevent parallel make from building several targets at the same time.
+
+ * macosx/tclMacOSXFCmd.c (struct fileinfobuf): force struct to be
+ packed to prevent failures when builing with -malign=natural.
+
+2004-11-10 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixChan.c: [Bug 727786]. Exterminated the code marked
+ DEPRECATED. This code has not been used in over a year now, and we
+ have no complaints.
+
+2004-11-08 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinPipe.c: The pipe channel driver now respects the -blocking
+ option when closing is the same way the UNIX side works. This is to
+ avoid a hung shell when exiting due to open pipes that refuse to close
+ in a graceful manner.
+ * doc/open.n: Added a note about -blocking 0 and lack of exit status
+ as it had never been documented. [Bug 947693]
+
+ ***POTENTIAL INCOMPATIBILITY***
+
+ Scripts that use async pipes on windows, must (like the UNIX side) set
+ -blocking to 1 before calling [close] to receive the exit status.
+
+2004-11-07 David Gravereaux <davygrvy@pobox.com>
+
+ * tests/winFile.test: added contraint to winFile-4.0 to prevent it
+ being run on NT4 [Bug 981829]
+
+2004-11-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/reg.test: Major reorganization so that this file is much
+ easier for a normal Tcl maintainer to comprehend. The test flags are
+ still very cryptic, but they appear to have to be that way. The number
+ of skipped tests has increased, but now the skipped tests have much
+ more meaningful content.
+
+ * tests/tm.test (genpaths): Add a [file normalize] so we pick up
+ Windows drive letters, etc. [Bug 1053568]
+
+2004-11-04 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates toward an 8.5a2 release.
+
+2004-11-03 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (FreeScan): Fixed a bug where scanning "Monday"
+ with a base time other than midnight incorrectly carried the base time
+ forward.
+
+ * test/clock.test (clock-33.{5,5a}): Made the test failure more
+ informative.
+
+ * tests/clock.test (clock-34.{28,44,45,46}): Removed 'knownBug'
+ constraints from tests that no longer fail.
+
+ Thanks to Don Porter for reporting these.
+
+2004-11-03 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tcl.h: Moved the preprocessor logic
+ * generic/tclDecls.h: from tclInt.h of setting the
+ * generic/tclInt.h: TCL_STORAGE_CLASS macro to the
+ * generic/tclIntDecls.h: tcl*Decls.h files now that no
+ * generic/tclIntPlatDecls.h: use of EXTERN is left in tclInt.h.
+ * generic/tclPlatDecls.h: Proto for Tcl_Main moved in tcl.h
+ * win/tclWinPort.h: to prior the inclusion of the Stubs
+ headers as they are now resetting TCL_STORAGE_CLASS. Removed
+ extraineous reset from tclWinPort.h. [Patch 1055668]
+
+ * generic/tclCompile.h: Removed extrainious reset of TCL_STORAGE_CLASS
+ missed in my last edit.
+
+2004-11-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl ([unknown]): Corrections to the 2004-10-25 mods to
+ Aunt ??? in [unknown]. Flaws revealed by Itcl test suite, which still
+ apparently relies on this brokenness. Also added comment suggesting
+ the error message that any code using this hack *ought* to receive in
+ reply.
+
+ * generic/tclTrace.c (TclCallVarTraces): Improved ability to debug
+ * tests/incr-old.test (incr-old-2.6): errors during variable
+ * tests/incr.test (incr-{1,2}.28): traces by preserving the
+ * tests/set.test (set-{2,4}.4): -errorinfo data.
+ * tests/trace.test (trace-33.1): [Bug 527164]
+
+2004-11-02 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclInt.h: added a check for #ifdef __cplusplus around the
+ #define of MODULE_SCOPE. About the only time it would be problem is
+ when someone is statically linking to Tcl and accessing internals from
+ a C++ file and has name mangling issues from the lack of "C" after
+ 'extern' [Patch 1055668].
+ * generic/tclCompile.h: Exchanged use of the EXTERN macro to the new
+ MODULE_SCOPE macro. Lowered exported internals count by 35. [Patch
+ 1055668]
+ * win/tclWinInt.h:
+ * win/tclWinPort.h: exported internals dropped by a count of 14.
+ * generic/tclFileSystem.h: Added use of MODULE_SCOPE on protos.
+ * generic/tclRegexp.h: manipulating TCL_STORAGE_CLASS unnecessary.
+
+2004-11-02 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Corrected some misleading
+ * tests/tcltest.test (tcltest-26.1,2): displays of ::errorInfo and
+ ::errorCode information when the -setup, -body, and/or -cleanup scripts
+ return an unexpected return code. Thanks to Robert Seeger for the fix.
+ [RFE 1017151].
+
+2004-11-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Improved version of the
+ NaN fix from Miguel Sofer. [Bug 761471]
+
+2004-11-02 Kevin Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Cuiaba: Change to DST rules for
+ * library/tzdata/America/Havana: autumn of 2004.
+ [ftp://elsie.nci.nih.gov/pub/tzdata2004g.tar.gz]
+
+ * tools/tclZIC.tcl: Updated to be compatible with recent changes in
+ library/clock.tcl.
+
+2004-11-02 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/tclWinFile.c: Simplify TclpUtime to use Tcl_FSGetNativePath, and
+ add comments.
+
+2004-11-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInt.h: Change uses of EXTERN to MODULE_SCOPE (defined in
+ this file too to be 'extern' if not overridden) as nothing declared in
+ tclInt.h is supposed to be visible outside the Tcl core. If there *is*
+ anything that extensions are actually using, we can open this up later
+ on. [Patch 1055668]
+
+ * doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446]
+
+2004-11-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWinFile.c (FromCTime, TclpUtime): Replaced a call to the
+ Posix 'utime' function with calls to Windows-API equivalents, to avoid
+ a bug where the VC++ versions misconvert times across a Daylight
+ Saving Time boundary. [Bug 926106]
+ * win/tclWinInt.h (TclWinProcs):
+ * win/tclWin32Dll.c (asciiProcs, unicodeProcs): Removed now-unused
+ reference to 'utime'.
+ * tests/cmdAH.test (cmdAH-24.12): Added test case for the above bug.
+
+2004-11-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Make INST_EQ and friends
+ handle NaN correctly in all cases. [Bug 761471]
+
+ * generic/tclNamesp.c (NamespaceInscopeCmd): Make the error message
+ generation the same as in NamespaceEvalCmd().
+ (Tcl_Import): Rationalized to use Tcl_EvalObjv().
+
+2004-10-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/io.test (io-40.3): Convert umask2 test constraint into a form
+ that most people will be able to satisfy.
+
+ * tests/cmdAH.test (cmdAH-8.45): Removed broken test constraint. It
+ didn't do what it was intended to do, and it implied the other correct
+ constraint. [Bug 1053908]
+
+ * generic/tclCmdIL.c (InfoGlobalsCmd):
+ * tests/info.test (info-8.4): Strip leading global-namespace
+ specifiers from the pattern argument. [Bug 1057461]
+
+2004-10-30 Kevin Kenny <kennykb@acm.org>
+
+ * generic/clock.c: Replaced WIN32 macro with __WIN32__. [Bug 1054357].
+ Thanks to David Gravereaux for the patch.
+ * win/tclWinFile.c: Removed a long-standing bug that causes incorrect
+ conversion between file time and UTC time if the file time is recorded
+ in a different Daylight Saving Time status than the current one. [Bug
+ 926106]
+
+2004-10-29 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Correct reaction to errors in the
+ obsolete processCmdLineArgsHook. [Bug 1055673]
+ * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.7
+ * unix/Makefile.in:
+ * tests/all.tcl: Update to use [tcltest::configure].
+
+2004-10-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * library/tm.tcl (::tcl::tm::*): Use the core proc engine to generate
+ the wrong-num-args error messages for the path ensemble.
+
+ Ensembles can now (sometimes) rewrite the error messages of their
+ subcommands so they appear more like the arguments that the user
+ passed to the ensemble. Below is a description of changes involved in
+ doing this.
+
+ * tests/namespace.test (namespace-50.*): Tests of ensemble subcommand
+ error message rewriting.
+ * generic/tclProc.c (TclObjInterpProc): Make procedures implement
+ their wrong-num-args message using Tcl_WrongNumArgs instead of
+ something baked-at-home.
+ * generic/tclNamesp.c (TclIsEnsemble, NsEnsembleImplementationCmd):
+ Added test of ensemble-hood (available to rest of core) and made
+ ensembles set up the rewriting for Tcl_WrongNumArgs to take advantage
+ of.
+ * generic/tclInt.h (Interp.ensembleRewrite): Extra fields.
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): Add knowledge of what is
+ going on in ensembles' command rewriting so this command can generate
+ the right error message itself.
+ * generic/tclBasic.c (Tcl_CreateInterp, TclEvalObjvInternal): Added
+ code to initialize (as empty) the rewriting fields and reset them when
+ we leak outside an ensemble implementation.
+
+2004-10-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_START_CMD):
+ * tests/execute.test (execute-8.3): fix for execution stack corruption
+ [Bug 1055676]. Credit dgp for detective work and fix.
+
+2004-10-27 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/socket.test (socket-13.1): Balanced [makeFile] and
+ [removeFile] commands.
+
+ * tests/clock.test: Correct duplicate test names.
+ * tests/namespace.test:
+ * tests/string.test:
+ * tests/io.test (io-50.4): Use namespace variables.
+
+2004-10-27 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclInt.decls: The following 9 functions were moved from
+ * generic/tclInt.h: tclInt.h to the private/int Stubs table for
+ * generic/tclIntDecls.h: use by the test suite. As tclTest.obj is
+ * generic/tclStubInit.c: linked to the shell, these functions need
+ "blessed" status so as to always be exported from the library. Being
+ placed in the Stubs table guarantees this [Bug 1054748]:
+ TclpObjRemoveDirectory, TclpObjCopyDirectory,
+ TclpObjCreateDirectory, TclpObjDeleteFile,
+ TclpObjCopyFile, TclpObjRenameFile,
+ TclpObjStat, TclpObjAccess,
+ TclpOpenFileChannel
+
+ * tests/registry.test: Fixed test files to load the correct
+ * tests/winDde.test: registry and dde packages by using the info
+ * win/Makefile.in: from makefiles to tell tcltest where to load
+ * win/makefile.vc: them from. This avoids grabbing the wrong
+ package from $auto_path which might be the install point rather than
+ the dev location. Kudos to Jennifer Hom for adding -load and
+ -loadfile to the tcltest package. [Bug 926088]
+
+ * win/tclWinThrd.c (TclFinalizeLock): release the critical section
+ before deleting it. [Bug 731778]
+
+ * generic/tcl.h: Removed the file level 'extern "C" {' and the
+ coresponding closing block as it serves no purpose given that all the
+ function prototypes have the proper extern usage already.
+
+ * unix/tclAppInit.c: When built as tcltest, TclThread_Init was
+ * win/tclAppInit.c: getting called twice. First by Tcltest_Init,
+ then again in Tcl_AppInit. The call from Tcl_AppInit is now removed.
+
+2004-10-27 Andreas Kupries <andreask@activestate.com>
+
+ * tests/tm.test: Expanded on the testsuite entered by Donal.
+ * library/tm.tcl: Even found bugs, these have been corrected.
+
+2004-10-26 Kevin Kenny <kennykb@acm.org>
+
+ * tests/format.test (format-19.1): Additional regression test for [Bug
+ 868489].
+
+2004-10-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/*.n: Many small general documentation fixes.
+
+2004-10-26 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclPipe.c (TclCleanupChildren): bad cast of resolvedPid
+ caused PIDs on win95 to go negative. winpipe-4.2 brought this to the
+ surface. Fixed with sprintf in place of TclFormatInt. Thanks to hgiese
+ [Patch 767676]
+
+2004-10-26 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl (::tcl::tm::Defaults): Added a second [file dirname]
+ around the location of the executable. This fixes [Bug 1038705].
+ Instable of a bogus "foo/bin/lib" we now have the correct "foo/lib" as
+ a base path for modules.
+
+2004-10-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c (Tcl_SubstObj): Fix for failed subst-12.3 test
+ * tests/subst.test (subst-12.3-5): More tests for Bug 1036649.
+
+ * unix/Makefile.in (install-libraries): Updated the installation of
+ the http, msgcat, and tcltest packages to install as Tcl Modules on
+ Unix systems. Other platform Makefiles still need updating. [Patch
+ 1054370]
+
+ * tests/basic.test: Added missing constraints.
+ * tests/compile.test:
+ * tests/fileSystem.test:
+
+ * tests/init.test (init-2.8): Updated to not rely on http package.
+
+2004-10-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclVar.c: removed more direct references to the VAR flags,
+ replaced with access macros.
+
+2004-10-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/expr.n: Clarified that non-num/non-bool literals require
+ quoting. [Bug 1027849]. Also listed booleans as acceptable values.
+
+2004-10-26 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (FreeScan): Fixed a bug that caused relative days
+ of the week in free-form [clock scan] to be evaluated in the wrong
+ time zone.
+ * tests/clock.test (clock-31.[456]): Made sure that there isn't an
+ env(TZ) or env(TCL_TZ) lying around that will override the time zone
+ that we're trying to establish with the simulated registry.
+ Both problems reported as [Bug 1054101].
+
+2004-10-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/string.n (map): Rewrote to clarify that we don't just map single
+ characters. [Bug 1048005]
+ * doc/info.n (procs): Clarified that the pattern argument may have
+ namespace separators in it. [Bug 1047928]
+
+ * tests/cmdAH.test (cmdAH-8.45): Simplify in the hope that the reasons
+ for [Bug 1053908] will become clearer.
+
+2004-10-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (IllegalExprOperandType,TclExecuteByteCode):
+ Removed several DECACHE_INFO/CACHE_INFO pairs that are no longer
+ needed for protection because routines like Tcl_SetErrorCode() and
+ Tcl_AddErrorInfo() can no longer re-enter bytecode execution.
+
+ * generic/tclResult.c (TclProcessReturn): Bug fix. Be sure that a
+ missing -errorinfo option when code == TCL_ERROR causes the errorInfo
+ field to get reset.
+
+ * tests/thread.test (thread-4.4): Test depended on a ::errorInfo value
+ initialized to "". Added code to test to setup that requirement.
+
+ * library/auto.tcl: Purged Tcl's script library of all
+ * library/clock.tcl: remaining references to global vars
+ * library/init.tcl: ::errorInfo and ::errorCode.
+
+ * generic/tclMain.c (Tcl_Main): Updated to make use of
+ TclGetReturnOptions instead of ::errorInfo variable.
+
+ * generic/tclInterp.c (tclInit): Bug fix. Access dict variables with
+ [dict get], not array syntax.
+
+2004-10-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/tm.test: Rewrote the tests to actually perform syntax checks
+ on the public API. Added a new test (currently failing) to indicate
+ that the test suite is not complete yet.
+ * library/tm.tcl (path): Rewrote to turn this command into an ensemble
+ to make it faster and simpler.
+
+2004-10-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclTrace.c: defined new macros to get/set the flags of
+ variables. The only files that still access the flag values directly
+ are tclCompCmds.c, tclCompile.c, tclProc.c and tclVar.c
+
+2004-10-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo): Shift
+ the initialization of errorCode to NONE to more central location.
+
+ * generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
+ Rewrite to build on the new TclGet/SetReturnOptions routines.
+
+ * generic/tclResult.c (TclGetReturnOptions): Add call to
+ Tcl_AddObjErrorInfo to be sure error fields are initialized.
+
+ * generic/tclResult.c (TclTransferResult): Rewrite to build on the new
+ TclGet/SetReturnOptions routines.
+
+2004-10-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/tm.n: Tightened up the documentation.
+ * tests/tm.test: Created (with partially dummy content) so TIP#189 can
+ be marked Final.
+
+ * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make ensembles
+ cut their implementations out of error traces. This is the right thing
+ to do more often than not.
+
+2004-10-22 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Fixed a typo where the fallback time zone became
+ ::localtime instead of :localtime. Fixed a bug where time zone names
+ containing hyphens could not be loaded.
+ * tests/clock.test: Added regression test cases that covers both bugs.
+ Thanks to Todd M. Helfter <tmh@jumpgate.itsp.purdue.edu> for finding
+ these bugs.
+
+2004-10-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclExecute.c (TclCompEvalObj, Tcl_ExprObj):
+ * generic/tclProc.c (TclProcCompileProc): Always call object
+ freeIntRepProc's in the same way.
+
+2004-10-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: fixed bug in commit of 2004-07-23, which was
+ causing a leak of Proc structures and failure of compile-12.1. Two
+ lines were 'zombies' from the previous way localVarNames worked.
+ Credit dgp for finding this.
+
+2004-10-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h (Interp):
+ * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
+ * generic/tclResult.c (GetKeys,ReleaseKeys,etc.): Moved the key values
+ of the return options dictionary out of private fields of the Interp
+ struct and into thread-static values managed in tclResult.c.
+
+ * generic/tclCmdAH.c (Tcl_CatchObjCmd, Tcl_ErrorObjCmd): Updated to
+ call the new TclGet/SetReturnOptions routines to do much of their
+ work.
+
+ * generic/tclInt.h (TclGetReturnOptions,TclSetReturnOptions):
+ * generic/tclResult.c (TclGetReturnOptions,TclSetReturnOptions): New
+ utility routines to get/set the return options of an interp. Intent is
+ that these routines will be converted to public routines after TIP
+ approval.
+
+ * generic/tclCmdMZ.c (TclProcessReturn,TclMergeReturnOptions):
+ * generic/tclResult.c (TclProcessReturn,TclMergeReturnOptions): Move
+ internal utility routines from tclCmdMZ.c to tclResult.c.
+
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp):
+ * generic/tclResult.c (TclTransferResult): Rework so that
+ iPtr->returnOpts can be NULL when there are no special options.
+
+ * generic/tclResult.c (TclRestoreInterpState): Plug potential memory
+ leak.
+
+2004-10-21 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclBasic.c: Various changes to [clock format] that,
+ * generic/tclClock.c: together, make it roughly twice as fast
+ * generic/tclInt.h: while all tests in the test suite
+ * library/clock.tcl: continue to pass.
+
+2004-10-20 Andreas Kupries <andreask@activestate.com>
+
+ * win/Makefile.in (install-msgs): Fixed a problem with the
+ * win/Makefile.in (install-tzdata): installation of timezone data and
+ message catalogs. They used the installed tcl library directory, not
+ the source library. Before it was installed. Switched to source lib
+ dir. Thanks to Kevin for the help in figuring this out.
+
+2004-10-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclThreadTest.c (ThreadEventProc): Corrected subtle bug
+ where the returned (char *) from Tcl_GetStringResult(interp) continued
+ to be used without copying or refcounting, while activity on the
+ interp continued. That's not safe, and recent changes demonstrated the
+ lack of safety with failing tests thread-4.3 and thread-4.5.
+
+2004-10-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclDictObj.c (DictWithCmd): Make sure all paths (that are
+ not themselves error paths) do not lose the result code.
+
+2004-10-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h (Tcl*InterpState): New internal routines
+ * generic/tclResult.c (Tcl*InterpState): TclSaveInterpState,
+ TclRestoreInterpState, and TclDiscardInterpState are superior
+ replacements for Tcl_(Save|Restore|Discard)Result. Intent is that
+ these routines will be converted to public routines after TIP
+ approval. Interfaces for these routines were shamelessly stolen from
+ Itcl.
+
+ * generic/tclBasic.c (TclEvalObjvInternal):
+ * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd):
+ * generic/tclIOGT.c (ExecuteCallback):
+ * generic/tclTrace.c (Trace*Proc,TclCheck*Traces,TclCallVarTraces):
+ Callers of Tcl_*Result updated to call the new routines. The calls
+ were relocated in several cases to perform save/restore operations
+ only when needed.
+
+ * generic/tclEvent.c (HandleBgErrors):
+ * generic/tclFCmd.c (CopyRenameOneFile): Calls to Tcl_*Result that
+ were eliminated because they appeared to serve no useful purpose,
+ typically saving/restoring an error message, only to throw it away.
+
+2004-10-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
+ * generic/tclCmdAH.c (Tcl_CatchObjCmd):
+ * generic/tclCmdMZ.c (TclMergeReturnOptions,TclProcessReturn):
+ * generic/tclCompCmds.c (TclCompileReturnCmd):
+ * generic/tclExecute.c (TclCompEvalObj):
+ * generic/tclInt.h (Interp):
+ * generic/tclProc.c (TclUpdateReturnInfo): Place primary storage of
+ the -level and -code information in private fields of the Interp
+ struct, rather than in a DictObj. This should significantly improve
+ performance of TclUpdateReturnInfo.
+
+2004-10-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclResult.c: removed unused variable [Bug 1048588]. Thanks
+ to Daniel South.
+
+2004-10-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (TclProcessReturn): Now that primary
+ * generic/tclProc.c (TclUpdateReturnInfo): storage for the
+ errorInfo and errorCode values are internal fields, we can set them at
+ the time of the [return] command, and not have to wait until the
+ specified number of "-level"s have popped.
+
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp)
+ (TclEvalObjvInternal, Tcl_LogCommandInfo, TclAddObjErrorInfo):
+ * generic/tclCmdAH.c (Tcl_CatchObjCmd):
+ * generic/tclEvent.c (BgError, ErrAssocData, Tcl_BackgroundError)
+ (HandleBgErrors, BgErrorDeleteProc):
+ * generic/tclExecute.c (TclCreateExecEnv, TclDeleteExecEnv):
+ * generic/tclIOUtil.c (comments only):
+ * generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS):
+ * generic/tclInterp.c ([tclInit]):
+ * generic/tclMain.c (comments only):
+ * generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace)
+ (TclTeardownNamespace):
+ * generic/tclProc.c (TclUpdateReturnInfo):
+ * generic/tclResult.c (Tcl_ResetResult, TclTransferResult):
+ * generic/tclTrace.c (CallVarTraces):
+ Reworked management of the "errorInfo" data of an interp. That
+ information is now primarily stored in a new private (Tcl_Obj *) field
+ of the Interp struct, rather than using a global variable ::errorInfo
+ as the primary storage. The ERR_IN_PROGRESS flag bit value is no
+ longer required to manage the value in its new location, and is
+ removed. Variable traces are established to support compatibility for
+ any code expecting the ::errorInfo variable to hold the information.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Code that sets traces on the ::errorInfo variable may notice a
+ difference in timing of the firing of those traces. Code that uses the
+ value ERR_IN_PROGRESS.
+
+2004-10-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP#217 IMPLEMENTATION
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from James
+ Salsman. [Patch 1017532]
+
+ * generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases of
+ glob matching that let us avoid scanning through hash tables.
+ * generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd):
+ (InfoVarsCmd): Use this to speed up some [info] subcommands.
+
+2004-10-12 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Campo_Grande:
+ * library/tzdata/America/Cuiaba:
+ * library/tzdata/America/Sao_Paulo
+ * library/tzdata/America/Argentina/Mendoza:
+ * library/tzdata/America/Argentina/San_Juan:
+ Synchronized to Olson's 'tzdata2004e'.
+
+2004-10-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP#201 AND TIP#212 IMPLEMENTATIONS
+
+ * doc/dict.n, doc/expr.n: Documentation for new functionality.
+ * tests/expr.test: Basic tests of 'in' and 'ni' behaviour.
+ * tests/dict.test (dict-21.*,dict-22.*): Tests for [dict update] and
+ [dict with].
+ * generic/tclExecute.c (TclExecuteByteCode): Implementation of the
+ INST_LIST_IN and INST_LIST_NOT_IN bytecodes.
+ * generic/tclParseExpr.c (GetLexeme): Parse the 'in' and 'ni'
+ operators for TIP#201.
+ * generic/tclDictObj.c (DictUpdateCmd,DictWithCmd): Core of
+ implementation of TIP#212; docs and tests still to do...
+
+2004-10-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTest.c (TestsetobjerrorcodeCmd): Simplified.
+
+2004-10-07 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c:
+ * generic/tclFileSystem.h:
+ * generic/tclIOUtil.c:
+ * generic/tclPathObj.c:
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c:
+ * tests/fileName.test:
+ * tests/winFCmd.test: code reorganization for better generic/platform
+ code splitting [Bug 925620] removing the need for several #ifdef's,
+ and tests and fix for an unreported Windows glob problem ('glob -dir
+ C: -tails *').
+
+2004-10-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * *.3: Convert CONST to const and VOID to void so we document how
+ people should actually use the Tcl API and not the compatability hacks
+ that it has to have.
+
+ * doc/man.macros, *.3: Update .AS macro so it can know how wide to
+ make the third column of the argument list. Update documentation for C
+ API (only users) to take advantage of this.
+
+ * doc/FileSystem.3: Formatting fixes for greater documentation
+ clarity.
+
+2004-10-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclFileName.c (DoGlob, TclGlob): Stop messy sharing of
+ interpreter result and instead use a private object for collecting the
+ result of the glob. This simplifies TclGlob quite a lot.
+ * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): Simplify by removing
+ some nesting. Also standardize variable names.
+ (FsAddMountsToGlobResult): Force updates to the list to be done
+ in-place, putting a side-condition of non-shared-ness on the resultPtr
+ argument to Tcl_FSMatchInDirectory, but everything would have broken
+ before if that was shared *anyway*.
+
+ * generic/tclEncoding.c (LoadTableEncoding): Removed reference to Tcl
+ interpreter; it wasn't needed as direct object use is more efficient.
+
+ * generic/tclPathObj.c: Made this file follow the style rules in the
+ Engineering Manual more closely, and also take advantage of the
+ internal object manipulation macros more.
+
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reorganized to have fewer
+ magic flag variables and to separate the code that scans for a match
+ from the code that processes a match body.
+
+2004-10-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c:
+ * generic/tclBinary.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclCompExpr.c:
+ * generic/tclDictObj.c:
+ * generic/tclEncoding.c:
+ * generic/tclExecute.c:
+ * generic/tclFCmd.c:
+ * generic/tclHistory.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclIO.c:
+ * generic/tclIOCmd.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclPkg.c:
+ * generic/tclResult.c:
+ * generic/tclScan.c:
+ * generic/tclTimer.c:
+ * generic/tclTrace.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+ * unix/tclUnixFCmd.c:
+ * unix/tclUnixPipe.c:
+ * win/tclWinDde.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinPipe.c:
+ * win/tclWinReg.c:
+ It is a poor practice to directly set or append to the value of the
+ objResult of an interp, because that value might be shared, and in
+ that circumstance a Tcl_Panic() will be the result. Searched for
+ example of this practice and replaced with safer alternatives, often
+ using the Tcl_AppendResult() routine that dkf just rehabilitated.
+ * library/dde/pkgIndex.tcl: Bump to dde 1.3.1
+ * library/reg/pkgIndex.tcl: Bump to registry 1.1.5
+
+2004-10-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/SetResult.3: Made Tcl_AppendResult non-deprecated; better that
+ people use it than most of the common alternatives!
+ * generic/tclResult.c (Tcl_AppendResultVA): Make this work better with
+ Tcl_Objs. [Patch 1041072]
+ (Tcl_SetResult, Tcl_AppendElement): Change string to stringPtr to
+ avoid C++ keywords.
+
+2004-10-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclObjInvoke): More simplification of the
+ TclObjInvoke routine toward unification with the rest of the
+ evaluation stack.
+
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp)
+ (TclEvalObjvInternal, Tcl_LogCommandInfo):
+ * generic/tclCmdAH.c (Tcl_CatchObjCmd):
+ * generic/tclEvent.c (BgError, Tcl_BackgroundError, HandleBgErrors):
+ * generic/tclInt.h (Interp, ERROR_CODE_SET):
+ * generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace)
+ (TclTeardownNamespace):
+ * generic/tclResult.c (Tcl_ResetResult, Tcl_SetObjErrorCode)
+ (TclTransferResult):
+ * generic/tclTrace.c (CallVarTraces):
+ Reworked management of the "errorCode" data of an interp. That
+ information is now primarily stored in a new private (Tcl_Obj *) field
+ of the Interp struct, rather than using a global variable ::errorCode
+ as the primary storage. The ERROR_CODE_SET flag bit value is no longer
+ required to manage the value in its new location, and is removed.
+ Variable traces are established to support compatibility for any code
+ expecting the ::errorCode variable to hold the information.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Code that sets traces on the ::errorCode variable may notice a
+ difference in timing of the firing of those traces.
+
+ * generic/tclNamesp.c (Tcl_PopCallFrame): Removed Bug 1038021
+ workaround. That bug is now fixed.
+
+2004-10-04 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/clock.test (clock-34.*): Removed an antibug that forced
+ comparison of [clock scan] results with the :localtime time zone. Now
+ that [clock scan] uses the current time zone instead, the antibug
+ caused several tests to fail. [Bug 1038554]
+
+2004-10-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclParseExpr.c (GetLexeme): Ensure that the 'eq' and 'ne'
+ operators are followed by non-alphabetic characters so lexemes can't
+ run together. [Bug 884830]
+
+ * doc/DictObj.3, doc/dict.n: Clarified that a dictionary is not
+ order-preserving. [Bug 1032243] Also added another example to show off
+ more ways of using a dictionary and a few other formatting
+ improvements.
+
+2004-10-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclDictObj.c (TraceDictPath, Tcl_DictObjPutKeyList): Add
+ support for automatic creation of dictionary paths since that is what
+ everyone seems to actually expect of the API! [Bug 1037235]
+ (Tcl_DictObjNext): Make calling this after Tcl_DictObjDone non-fatal
+ as that simplifies a number of internal APIs. This doesn't break any
+ existing working code as it is a case which previously caused a panic.
+
+2004-10-02 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/namespace.test (namespace-8.7): Another test for save/restore
+ of ::errorInfo and ::errorCode during global namespace teardown.
+
+2004-10-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclProc.c (TclObjGetFrame, Tcl_UplevelObjCmd):
+ * generic/tclVar.c (Tcl_UpvarObjCmd): Cache stackframe level
+ references in the level object for speed.
+
+2004-09-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_CreateInterp):
+ * generic/tclInt.h (Interp): Removed the flag bit value
+ EXPR_INITIALIZED. It was set during interp creation and never tested.
+ Whatever purpose it had is in the past.
+
+ * generic/tclBasic.c (Tcl_EvalObjEx): Removed the flag bit value
+ * generic/tclInt.h (Interp): USE_EVAL_DIRECT. It was used
+ * generic/tcLTest.c (TestevalexObjCmd): only in the testing command
+ * tests/parser.test (parse-9.2): [testevalex] and nothing in
+ the test suite made use of the capability it enabled.
+
+ * generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization
+ * generic/tclCmdAH.c (Tcl_ErrorObjCmd): of the management of
+ * generic/tclCmdMZ.c (TclProcessReturn): the errorCode value.
+ * tests/error.test (error-6.4-9):
+
+ * generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified
+ * tests/namespace.test (namespace-8.5,6): the save/restore of
+ ::errorInfo and ::errorCode during global namespace teardown. Revised
+ the comment to clarify why this is done, and added tests that will
+ fail if this is not done.
+
+ * generic/tclResult.c (TclTransferResult): Added safety checks so that
+ unexpected undefined ::errorInfo or ::errorCode will not lead to a
+ segfault.
+
+ * generic/tclTrace.c (TclCallVarTraces): Save/restore the flag values
+ * tests/var.test (var-16.1): that define part of the
+ interpreter state during variable traces. [Bug 1038021].
+
+2004-09-30 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/subst.test (12.1-2): added tests for [Bug 1036649]
+
+2004-09-29 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/basic.test (49.*): New tests for TCL_EVAL_GLOBAL.
+
+2004-09-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclVar.c (TclObjLookupVar, TclObjLookupVar):
+ (TclObjUnsetVar2, SetArraySearchObj):
+ * generic/tclUtil.c (SetEndOffsetFromAny):
+ * generic/tclStringObj.c (Tcl_SetStringObj):
+ (Tcl_SetUnicodeObj, SetStringFromAny):
+ * generic/tclResult.c (ResetObjResult):
+ * generic/tclRegexp.c (Tcl_GetRegExpFromObj):
+ * generic/tclPathObj.c (TclFSMakePathRelative, SetFsPathFromAny):
+ (TclFSMakePathFromNormalized, Tcl_FSNewNativePath):
+ * generic/tclObj.c (TclFreeObj, Tcl_SetBooleanObj, SetBooleanFromAny):
+ (Tcl_SetDoubleObj, SetDoubleFromAny, Tcl_SetIntObj):
+ (SetIntOrWideFromAny, Tcl_SetLongObj, SetWideIntFromAny):
+ (Tcl_SetWideIntObj, TclSetCmdNameObj, SetCmdNameFromAny):
+ * generic/tclNamesp.c (SetNsNameFromAny, MakeCachedEnsembleCommand):
+ * generic/tclListObj.c (Tcl_SetListObj, SetListFromAny):
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
+ * generic/tclDictObj.c (SetDictFromAny):
+ * generic/tclCompile.c (TclInitByteCodeObj):
+ * generic/tclBinary.c (Tcl_SetByteArrayObj, SetByteArrayFromAny):
+ * generic/tclInt.h (TclFreeIntRep): Factorize out deletion of object
+ internal representation to a shared macro, so simplifying much code.
+
+2004-09-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TclObjInvoke): fix for bogus gcc warning about
+ uninitialised variable.
+
+2004-09-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Removed internal routines TclInvoke,
+ * generic/tclInt.decls: TclGlobalInvoke, TclObjInvokeGlobal and the
+ * tests/basic.test: portion of TclObjInvoke that handles calls
+ without TCL_INVOKE_HIDDEN enabled. None of this code is called any
+ longer within the core, and the superior public interface,
+ Tcl_EvalObjv, is available for any external callers.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclEvent.c (HandleBgErrors): Updated [bgerror] invocations
+ to make use of Tcl_Obj based routines, dropping the calls to
+ TclGlobalInvoke()
+
+2004-09-27 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c:
+ * generic/tclFileSystem.h:
+ * generic/tclIOUtil.c:
+ * generic/tclPathObj.c:
+ * tests/cmdAH.test:
+ * tests/fileSystem.test:
+ * tests/winFCmd.test: fix to bad error message with 'cd' on windows,
+ when permissions are inadequate [Bug 1035462] and to treatment of a
+ volume-relative pwd on Windows [Bug 1018980].
+
+ * doc/FileSystem.3: added missing Tcl_GlobTypeData documentation [Bug
+ 935853]
+
+2004-09-27 Kevin Kenny <kennykb@acm.org>
+
+ * compat/strftime.c (Removed):
+ * generic/tclClock.c (removed TclClockOldscanObjCmd):
+ * generic/tclDate.c (Regenerated):
+ * generic/tclGetDate.y:
+ * generic/tclInt.decls (removed TclGetDate and TclpStrftime):
+ * generic/tclInt.h (removed TclGetDateInfo):
+ * generic/tclIntDecls.h (Regenerated):
+ * generic/tclStubInit.c (Regenerated):
+ * library/clock.tcl:
+ * unix/tclUnixTime.c (removed TclpStrftime):
+ * win/Makefile.in:
+ * win/makefile.bc:
+ * win/makefile.bc:
+ * win/tcl.dsp:
+ Continued refactoring of [clock] for TIP 173 changes. Broke the
+ free-form parser apart so that the Bison parser is responsible for
+ only parsing, while clock.tcl handles relative times like "next
+ Thursday", "next January". This change is needed to make timezones
+ other than :localtime and :Etc/UTC work with free-form scanning. This
+ change closes out the issue identified as being "for another day" in
+ my log message of 2004-09-08. The refactored code also eliminates the
+ last known references to TclpStrftime and TclGetDate, so those
+ routines (including compat/strftime.c) have been removed. The
+ refactoring also has the benefit that all storage in the Bison parser
+ is now on the C stack, eliminating any need for mutex protection
+ around [clock scan]. Also, changed the Makefiles so that 'make
+ gendate' is available on Windows as well as Unix.
+
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Removed some grubby
+ * generic/tclObj.c (SetBooleanFromAny): work-around code that was
+ needed only because of Bug 868489.
+
+ * generic/tclBasic.c (TclObjInvoke): Removed three unused variables to
+ silence a compiler warning in VC++.
+
+2004-09-27 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/FileSystem.3: fix to small typo.
+
+2004-09-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclInt.h:
+ * generic/tclProc.c:
+ * tests/compExpr-old.test:
+ * tests/compExpr.test:
+ * tests/expr.test:
+ * tests/for.test:
+ * tests/if.test:
+ * tests/incr.test:
+ * tests/while.test:
+ Report compilation errors at runtime, [Patch 1033689] by dgp.
+
+2004-09-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/dltest/Makefile.in (clean): Fixup make clean rule so that it
+ does not delete all files when SHLIB_SUFFIX is set to the empty string
+ in a static build. [Bug 1016726]
+
+2004-09-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Corrections to the 2004-09-21 commit
+ * generic/tclExecute.c: regarding ERR_ALREADY_LOGGED. That commit
+ * generic/tclNamesp.c: caused Tk test send-10.7 to fail. Added
+ * tests/namespace.test (25.7,8): tests in the Tcl test suite
+ * tests/pkg.test (2.25,26): to catch this error without the aid
+ of Tk in the future.
+
+ * generic/tclCmdAH.c (Tcl_ExprObjCmd): Simplified the TclObjCmdProc
+ of [expr] with a call to Tcl_ConcatObj.
+
+2004-09-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (TclProcessReturn): Support the -errorline
+ * generic/tclCompile.c (TclCompileScript): option to [return].
+ * tests/compile.test (16.23.*): Use that capability to defer reporting
+ * tests/misc.test (1.2): of parse errors until runtime. Updated
+ tests to reflect change. [Bug 1032805]
+
+2004-09-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_START_CMD):
+ * tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect whenever
+ a loop exception was returned.
+
+2004-09-22 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Montevideo: Updated to reflect
+ ftp://elsie.nci.nih.gov/pub/tzdata2004d.tar.gz. (Changes to
+ Asia/Jerusalem were in the comments only.) [Routine maintenance - no
+ bug] Spanish-language description of the change at
+ http://www.presidencia.gub.uy/decretos/2004091502.htm
+
+2004-09-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompCmds.c: Tolerate [append] syntax errors
+ * tests/appendComp.test (8.1): at compile time, and allow runtime to
+ raise the error (or succeed if a redefined [append] allows).
+
+ * generic/tclBasic.c: Reworked management of the interp flag
+ * generic/tclCompile.c: ERR_ALREADY_LOGGED, to reduce its exposure.
+ * generic/tclExecute.c: Still left several referebces that are just
+ * generic/tclNamesp.c: too nice on performace to do away with. These
+ changes also resolve an inconsistency in the ::errorInfo values
+ produced by [namespace eval x error foo bar] and [namespace eval x
+ {error foo bar}].
+
+ * generic/tclExecute.c (TclCompEvalObj): Simplified the
+ TclCompEvalObj routine. Much housekeeping now reliably happens
+ elsewhere. [Patch 1031949]
+
+2004-09-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/interp.n: Tighten up wording on how [interp eval] and [interp
+ invokehidden] operate w.r.t. stack frames. [Bug 926590]
+
+2004-09-20 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/error.test (error-6.2,3): Added more tests to verify
+ ::errorCode setting by/after a [catch].
+
+2004-09-19 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdAH.c: removed outdated comment [Bug 1029518].
+
+2004-09-18 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclAppInit.c: Dde package can load into a safe interp. Claim
+ this fact for the Tcl_StaticPackage() call when the shell is built
+ with the TCL_USE_STATIC_PACKAGES option.
+
+2004-09-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that
+ large shifts end up shifting correctly. [Bug 868467]
+
+ * doc/FileSystem.3, doc/OpenFileChnl.3: More documentation fixes from
+ Mikhail Kolesnitchenko. [Patch 1022527]
+ * doc/*: Standardize highlighting of symbols defined in tcl.h
+
+2004-09-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_AddObjErrorInfo, Tcl_LogCommandInfo):
+ * generic/tclCmdAH.c ([catch], [error]):
+ * generic/tclCmdMZ.c ([return]):
+ * generic/tclProc.c (TclUpdateReturnInfo):
+ * generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode)
+ (TclTransferResult): Refactored so that all errorCode setting flows
+ through Tcl_SetObjErrorCode(). This greatly reduces the number of
+ different places in the code that need to know details about an
+ internal bitflag field of the Interp struct. Also places errorCode
+ setting in one place for easier future mods.
+
+2004-09-17 Kevin B.Kenny <kennykb@acm.org>
+
+ * generic/tclDate.c: Revised tclGetDate.y to use bison instead of
+ * generic/tclGetDate.y: yacc to build the parser, eliminating all the
+ * generic/tclInt.h: complicated hackery involving 'sed'
+ * unix/Makefile.in: postprocessing. Rebuilt the parser.
+
+2004-09-14 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (ClockOldscanObjCmd): Silenced a compiler warning
+ (long passed as a param where unsigend long was expected). 'Unsigned
+ long' is wrong, but the fix is really to change the signature of
+ TclGetDate to return a structure of its 'yy' variables and then do the
+ remaining work inside clock.tcl. But, as I said on 2004-09-08, that's
+ a job for another day. [Bug 1027993]
+
+2004-09-10 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/interp.n:
+ * generic/tclInterp.c (TclPreventAliasLoop, AliasCreate):
+ * tests/interp.test (17.4-6, 19.3-4): fixing problems with renaming of
+ aliases [Bugs 707104 1026493]. Fix designed by dgp.
+
+2004-09-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (NsEnsembleImplementationCmd): Add token field
+ to internal rep of EnsembleCmdRep structure so that we can check it to
+ see if the subcommand object is really being used with the same
+ ensemble. [Bug 1026903]
+
+2004-09-11 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (TclMktimeObjCmd): Corrected a bad check for
+ error return from 'mktime'.
+ * generic/tclObj.c (Tcl_GetIntFromObj): Corrected a problem where
+ demoting a wide to an int failed on a big-endian machine. [Bug
+ 1026125].
+ * tests/clock.test (clock-43.1): Added regression test for error
+ return from 'mktime'.
+
+2004-09-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_CONCAT1): fix for [Bug 1025834]; avoid
+ unnecessary string copies.
+
+2004-09-10 David Gravereaux <davyrgvy@pobox.com>
+
+ * tests/tcltest.test: tcltest-12.3-4 needed to have
+ ::tcltest::loadScript set to empty in their -setup
+
+2004-09-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value
+ parsing code so that values do not flip so easily between numeric
+ representations. Thanks to KBK for this! [Bug 868489]
+
+ * generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to set
+ ::errorCode on error. [Bug 1025359]
+
+2004-09-10 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tcl.h: Micro formatting fixes.
+ * generic/tclIOGT.c: Channel version fixed, must be 3, to have
+ wideseekProc. Thanks to David Graveraux <davygrvy@pobox.com>.
+
+2004-09-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamespace.c (TclGetNamespaceForQualName): Resolved
+ longstanding inconsistency in the treatment of the TCL_NAMESPACE_ONLY
+ flag revealed by testing the 2004-09-09 commits against Itcl.
+ TCL_NAMESPACE_ONLY now acts as specified in the pre-function comment,
+ forcing resolution in the passed in context namespace. It has been
+ incorrectly forcing resolution in the interp's current namespace.
+
+2004-09-10 Kevin Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Fixed a bug where %z always put a plus sign on
+ the time zone in :localtime.
+ * tests/clock.test: Added test case for the above bug.
+
+2004-09-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_CONCAT1): added a peephole optimisation
+ for concatting an empty string. This enables replacing the idiom 'K $x
+ [set x {}]' by '$x[set x {}]' for fastest execution.
+
+2004-09-09 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinConsole.c: Calls to WriteFile and WriteConsoleA changed to
+ WriteConsole for simplicity.
+
+2004-09-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c (Tcl_ForgetImport): Corrected faulty
+
+ * tests/namespace.test: logic that relied exclusively on string
+ matching and failed in the presence of [rename]s. [Bug 560297] Also
+ corrected faulty prevention of [namespace import] cycles. [Bug 1017299]
+
+2004-09-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Removed obsolete field
+ for storing the string-based command procedure of built-in commands.
+ We no longer have any string-based built-in commands!
+
+2004-09-08 Kevin B. Kenny <kennykb@acm.org>
+
+ * compat/strftime.c (_conv): Corrected a problem where hour 0 would
+ format as a blank format group with %k.
+ * doc/clock.n: Corrected a buglet in the header information. [Bug
+ 1024058]
+ * generic/tclClock.c (TclClockMktimeObjCmd): Fixed a bug where the
+ month was scanned incorrectly in -timezone :localtime.
+ * tests/clock.test (clock-34.*,clock-40.1, clock-41.1): Adjusted the
+ clock-34.* test cases so that the consistency check is performed in
+ :localtime rather than the current time zone. This change allows
+ dealing with issues where the C library has a different idea of DST
+ conversion than Tcl. (Real fix would be to break TclGetDate into
+ separate parser and time converter, and do the time conversion in
+ clock.tcl. That's for another day.) Added regression test case for the
+ bug where month was scanned incorrectly in -timezone :localtime. [Bug
+ 1023779] Added regression test case for %k at the zero hour.
+
+2004-09-07 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: some quoting needed to be removed as it was
+ breaking with VC7. [Bug 1023150]
+
+2004-09-07 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n: Documented the default -format, and changed references
+ to a (nonexistent) msgcat command to refer to the msgcat package. [Bug
+ 1023870]
+ * generic/tclTimer.c: Removed a premature optimisation that attempted
+ to store the assoc data in the client data; the optimisation caused a
+ bug that [after] would overwrite its imports. [Bug 1016167]
+ * library/clock.tcl (InitTZData, ClearCaches): Changed so that the
+ in-memory time zone :UTC (and its aliases) always gets reinitialised,
+ in case tzdata is absent. [Bug 1019537, 1023779]
+ * library/tzdata/*: Regenerated.
+ * tests/clock.test (clock-31.*, clock-39.1): Corrected a problem where
+ the 'system' locale tests fail on a non-English Windows machine. [Bug
+ 1023761]. Added a test to make sure that alias time zones load
+ correctly. [Bug 1023779].
+ * tests/timer.test (timer-1.1, timer-2.1): Changed to (one hopes!) be
+ more resilient on an overloaded system, if [after 200] sleeps for 300
+ ms or longer.
+ * tools/tclZIC.tcl (writeLinks): Corrected a problem where alias time
+ zone names were written incorrectly, causing them to fail to load at
+ run time. [Bug 1023779].
+ * win/tclWinTime.c (Tcl_GetTime): Eliminated CPUID tests on Win64 -
+ assuming that HAL vendors now do a better job of keeping the
+ performance counters synchronized among CPU's. [Bug 1020445]
+
+2004-09-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/tclvars.n, doc/tcltest.n, doc/tclsh.1, doc/safe.n, doc/expr.n
+ * doc/WrongNumArgs.3, doc/Utf.3, doc/TraceVar.3, doc/Thread.3
+ * doc/TCL_MEM_DEBUG.3, doc/SubstObj.3, doc/StdChannels.3
+ * doc/SetResult.3, doc/RegExp.3, doc/RegConfig.3, doc/RecEvalObj.3
+ * doc/PrintDbl.3, doc/ParseCmd.3, doc/Panic.3, doc/ObjectType.3
+ * doc/Object.3, doc/Namespace.3, doc/Interp.3, doc/IntObj.3
+ * doc/Hash.3, doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3
+ * doc/Encoding.3, doc/DoubleObj.3, doc/DictObj.3, doc/CrtTimerHdlr.3
+ * doc/CrtObjCmd.3, doc/CrtMathFnc.3, doc/CrtCommand.3, doc/CrtChannel.3
+ * doc/ChnlStack.3, doc/ByteArrObj.3, doc/AssocData.3, doc/Alloc.3:
+ More documentation fixes from Mikhail Kolesnitchenko. [Patch 1022527]
+
+2004-09-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixFCmd.c: Stop NULL interp arguments from triggering a
+ crash when an error happens. [Bug 1020538]
+
+2004-09-02 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n: Clarified meaning of -dictionary. [Bug 759545]
+
+2004-09-02 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/makefile.vc: clock.tcl needs to be installed.
+
+2004-09-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinReg.c (BroadcastValue): WIN64 cast corrections
+
+ * win/tclWinDde.c (DdeClientWindowProc):
+ (DdeServicesOnAck, DdeEnumWindowsCallback): WIN64 corrections
+
+ * win/tclWin32Dll.c (TclWinCPUID): need _asm for WIN64 (Itanium),
+ until we have it, just return unknown. [Bug 1020445]
+
+2004-09-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/regsub.n, doc/RegConfig.3, doc/Environment.3:
+ * doc/CrtChannel.3, doc/safe.n: Use correct abbreviations.
+
+2004-08-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/trace.n, doc/socket.n, doc/registry.n, doc/pid.n:
+ * doc/namespace.n, doc/msgcat.n, doc/lsort.n, doc/lsearch.n:
+ * doc/linsert.n, doc/info.n, doc/http.n, doc/history.n:
+ * doc/format.n, doc/file.n, doc/exec.n, doc/dde.n, doc/clock.n:
+ * doc/catch.n, doc/binary.n: More spelling and grammar fixes from
+ Mikhail Kolesnitchenko. [Patch 1018486]
+
+2004-08-31 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/FileSystem.3:
+ * generic/tclIOUtil.c: Clarified documentation regarding ability of a
+ filesystem to say that it doesn't support a given operation using the
+ EXDEV posix error code (copyFileProc, renameFileProc, etc), and
+ updated one piece of code to ensure correct behaviour when an
+ operation is not supported [Bug 1017072]
+
+ * tests/fCmd.test: fix to test suite problem [Bug 1002884]
+
+2004-08-31 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in (install-libraries): portable sh fix.
+
+2004-08-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from
+ crashing when its map and input string are the same object.
+
+2004-08-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (FindEnsemble): Factor out the code to convert a
+ command name into an ensemble configuration and add support for
+ ignoring [namespace import] link chains. [Bug 1017022]
+ (NamespaceWhichCmd): Rework to use newer option parsing API.
+
+2004-08-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: added customization of default module path roots
+ via TCL_MODULE_PATH makefile variable.
+ * macosx/Makefile: add platform standard locations to default module
+ path roots. [Patch 942881]
+
+ * tests/env.test: macosx fixes.
+
+2004-08-25 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/timer.test (timer-10.1): Test for Bug 1016167.
+ * generic/tclTimer.c: Workaround for situation when a [namespace
+ import] causes the objv[0] value to be something other than what
+ Tcl_AfterObjCmd expects. [Bug 1016167].
+
+2004-08-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (NsEnsembleImplementationCmd): Use the ensemble
+ command token to get the name of the ensemble for passing to the
+ -unknown handler instead of relying on objv[0], which may contain
+ useless info in the presence of [namespace import]. Problem found by
+ Don Porter when investigating [Bug 1016167].
+
+2004-08-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclProc.c: The routine TclProcInterpProc was a
+ * generic/tclTestProcBodyObj.c: specific instance of the general
+ service already provided by TclObjInvokeProc. Removed
+ TclProcInterpProc and TclGetInterpProc from the code...
+
+ * generic/tclInt.decls: ...and from the internal stubs table.
+ * generic/tclIntDecls.h
+ * generic/tclStubInit.c
+
+2004-08-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/string.n: Added clarifying note.
+
+2004-08-23 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: Updated [tcl_findLibrary] search path to
+ include any [<pkg>::pkgconfig get scriptdir,runtime] directory, as
+ well as the $::auto_path. [RFE 695441]
+
+2004-08-21 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/clock.test (clock-38.1): Changed TZ setting to specify CET in
+ excruciating detail to deal with systems that lack the Posix defaults
+ for DST changes (and to be formally correct with the change dates for
+ CET).
+
+2004-08-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclScan.c (Tcl_ScanObjCmd, ValidateFormat): Ensure that the
+ %ld conversion works correctly on 64-bit platforms. [Bug 1011860]
+
+2004-08-19 Kevin Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (format): Changed default timezone format from
+ alphabetic to numeric to produce scannable times in more locales.
+ * tests/clock.test (clock-37.1): Removed now-unused 'needPST'
+ constraint and the comments that refer to it.
+
+2004-08-18 Andreas Kupries <andreask@activestate.com>
+
+ * library/init.tcl: Integrated TIP #189. We source a separate file
+ (see below), instead of inlining the contents of that file. This
+ should beeasier to maintain, and easier to backport/install in 8.4
+ installations.
+
+ Note: Usage of Tcl Modules is restricted to non-safe interps. It
+ cannot be loaded into a safe interp.
+
+ * library/tm.tcl: New file, the v2 reference implementation for TIP
+ #189, Tcl Modules.
+
+ * doc/tm.n: New file, documentation for Tcl Modules, based on the TIP.
+
+ * unix/mkLinks: Regenerated.
+ * win/makefile.vc: Added tm.tcl to list of files to install.
+
+2004-08-18 Kevin Kenny <kennykb@acm.org>
+
+ * tests/httpd (httpdRespond): Corrected an abuse of the [clock]
+ command that caused test failures for some values of [clock clicks].
+
+ * doc/clock.n
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_HideUnsafeCommands):
+ * generic/tclClock.c (all):
+ * generic/tclInt.h:
+ * generic/tclInterp.c (CreateSlave):
+ * library/clock.tcl: (new file)
+ * library/init.tcl (clock):
+ * library/msgs/*.msg:(new files)
+ * library/tzdata/*:
+ * library/tzdata/*/*:
+ * library/tzdata/*/*/*: (new files)
+ * tools/installData.tcl: (new file)
+ * tools/loadICU.tcl: (new file)
+ * tools/makeTestCases.tcl: (new file)
+ * tools/tclZIC.tcl: (new file)
+ * unix/Makefile.in:
+ * unix/configure: (regenerated)
+ * unix/tcl.m4:
+ * tests/clock.test (all):
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ Implementation of TIPs #173 and #209.
+
+ The [clock] command is now a Tcl ensemble, with most of its
+ functionality written in Tcl and callouts to C code only to access
+ low-level functions such as localtime, mktime and tzset.
+
+ In addition to the functionality changes called out in the two TIPs,
+ it is worth noting that the [clock] command in a safe slave
+ interpreter is now an alias to the [clock] command in the master, and
+ that [clock] is otherwise not expected to function entirely correctly
+ in safe interps. C code that simply does Tcl_MakeSafe needs to be
+ aware that [clock] may need special handling. (It appears unlikely
+ that such code actually exists.)
+
+ One incompatibility of note is that if the time zone cannot be
+ determined from the TZ, TCL_TZ environment variables, or from the
+ Windows control panel, so that the C library must be used for date and
+ time conversions, then times outside the range of time_t will fail;
+ they used to return bad data silently.
+
+ Many thanks to all the many people who assisted with testing,
+ debugging, criticism of the specification, and localisation. Deserving
+ of particular mention are Joe English, Clif Flynt, Donal K. Fellows,
+ Jeff Hobbs, Cameron Laird, Arjen Markus, Reinhard Max, Christopher
+ Nelson, Steve Offutt, Donald G. Porter, Pascal Scheffers, Peter da
+ Silva and Richard Suchenwirth-Bauersachs.
+
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2004-08-16 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/SetVar.3:
+ * generic/tclTest.c (TestseterrorcodeCmd):
+ * generic/tclVar.c (TclPtrSetVar):
+ * tests/result.test (result-4.*, result-5.*): [Bug 1008314] detected
+ and fixed by dgp.
+
+2004-08-13 Don Porter <dgp@users.sourceforge.net>
+
+ * library/msgcat/msgcat.tcl: Added checks to prevent [mclocale]
+ * tests/msgcat.test: from registering filesystem paths to possibly
+ malicious code to be evaluated by a later [mcload].
+
+2004-08-10 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * unix/tclUnixThrd.c (TclpThreadCreate): changed handling of the
+ returned thread ID since broken on 64-bit systems (Cray). Thanks to
+ Rob Ratcliff for reporting the bug.
+
+2004-08-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (MakeCachedEnsembleCommand): Initialize the
+ epoch field cached in the subcommand. [Bug 989298]
+ (NsEnsembleImplementationCmd): Plug a leak (thanks to Miguel Sofer for
+ spotting it with valgrind) and reduce the number of goto labels to
+ make the code clearer.
+
+2004-08-02 Don Porter <dgp@users.sourceforge.net>
+
+ * library/package.tcl (pkg_mkIndex): Updated [pkg_mkIndex] to make
+ use of [glob -directory $dir -tails] and return options.
+
+ TIP#207 IMPLEMENTATION
+
+ * doc/interp.n: Added support for a -namespace option to the
+ * generic/tclBasic.c: [interp invokehidden] command. Also added an
+ * generic/tclInt.h: internal routine TclObjInvokeNamespace() and
+ * generic/tclInterp.c: corrected the flag names TCL_FIND_ONLY_NS and
+ * generic/tclNamesp.c: TCL_CREATE_NS_IF_UNKNOWN that are passed to the
+ * generic/tclTrace.c: internal routine TclGetNamespaceForQualName().
+ * tests/interp.test: [Patch 981841]
+
+ * generic/tclLiteral.c (TclCleanupLiteralTable): Corrected
+ * tests/compile.test (compile-12.4): flawed deletion of literal
+ internal reps that could lead to accessing of freed memory. Thanks to
+ Kevin Kenny for test case and fix [Bug 1001997].
+
+2004-07-30 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/safe.test (safe-2.1): Disabled senseless test. [Bug 999612]
+
+ * library/auto.tcl (auto_reset): Removed "protected" list of commands
+ from [auto_reset]. All entries in the auto_index can be re-loaded.
+ * library/package.tcl: Updated comment to reflect 2004-07-28 commit.
+
+ * generic/tclEvent.c (Tcl_Finalize): Re-organized Tcl_Finalize so
+ that Tcl_ExitProc's that call Tcl_Finalize recursively do not cause
+ deadlock. [Patch 999084 fixes Tk Bug 714956]
+
+2004-07-30 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/configure:
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Darwin: instead of setting PLAT_OBJS
+ to explict object files in tcl.m4, refer to MAC_OSX_OBJS makefile var.
+ * unix/Makefile.in: added MAC_OSX_OBJS variable.
+
+2004-07-29 Don Porter <dgp@users.sourceforge.net>
+
+ * library/package.tcl: [::pkg::create] is now an alias. Test safe-2.1
+ will now fail until Bug 999612 is corrected.
+
+2004-07-28 Don Porter <dgp@users.sourceforge.net>
+
+ * library/package.tcl: Moved private command
+ * library/tclIndex: [pkg_compareExtension] into ::tcl::Pkg.
+ * tests/pkg_mkIndex.test: Also moved implementation of
+ [::pkg::create] to [::tcl::Pkg::Create].
+
+2004-07-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/io.test: Make io-61.1 create file as binary to pass on Win32
+
+2004-07-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: simplify tclLocalVarNameType, removing the
+ reference to the corresponding proc. The reference is now seen as
+ unnecessary, and it may cause leaking circular references under some
+ circumstances (see for example [Bug 994838]).
+
+2004-07-22 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/eofchar.data (removed): Test io-61.1 now generates its own
+ * tests/io.test: file of test data as needed.
+
+2004-07-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclEvent.c: Correct threaded obj allocator to
+ * generic/tclInt.h: fully cleanup on exit and allow for
+ * generic/tclThreadAlloc.c: reinitialization. [Bug 736426]
+ * unix/tclUnixThrd.c: (mistachkin, kenny)
+ * win/tclWinThrd.c:
+
+2004-07-21 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclBasic.c (DeleteInterpProc):
+ * generic/tclLiteral.c (TclCleanupLiteralTable):
+ * generic/tclInt.h: added a TclCleanupLiteralTable function, called
+ from DeleteInterpProc, that frees internal representations of shared
+ literals early when an interpreter is being deleted. This change
+ corrects a number of memory mismanagement issues in the cases where
+ the internal representation of one literal contains a reference to
+ another, and avoids conditions such as resolved variable names
+ referring to procedure and namespace contexts that no longer exist.
+ [Bug 994838]
+
+2004-07-20 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in:
+ * win/Makefile.in: added 'install-private-headers' makefile target to
+ allow optionally installing private tcl headers. [FR 922727]
+
+ * macosx/Makefile: use new 'install-private-headers' target to install
+ private headers into framework. [FR 922727]
+
+ * unix/tclUnixFile.c (NativeMatchType): added support for readonly
+ matching of user immutable files (where available).
+
+ * macosx/tclMacOSXBundle.c: dynamically acquire address for
+ CFBundleOpenBundleResourceMap symbol, since it is only present in full
+ CoreFoundation on Mac OS X and not in CFLite on pure Darwin.
+
+2004-07-19 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * win/tclwinThrd.c: redefined MASTER_LOCK to call TclpMasterLock.
+ Fixes [Bug 987967]
+
+2004-07-17 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: fix to rare 'cd' infinite loop in normalization
+ with vfs [Bug 991420].
+ * tests/fileSystem.test: added test for above bug.
+
+ * doc/FileSystem.3: clarified documentation of posix error codes in
+ 'remove directory' FS proc - 'EEXIST' is used to signify a non-empty
+ directory error (bug reported against tclvfs).
+
+2004-07-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in, unix/tcl.m4: move (C|LD)FLAGS after their
+ * unix/configure.in, unix/configure: _DEFAULT to allow for env setting
+ to override m4 switches. Move SC_MISSING_POSIX_HEADERS up and
+ consolidate calls to limit redundancy in configure.
+ (CFLAGS_WARNING): Remove -Wconversion
+ (SC_ENABLE_THREADS): Set m4 to force threaded build when built against
+ a threaded Tcl core.
+
+2004-07-16 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Corrected a typo in the
+ generation of error messages and simplified by reusing data in a
+ variable instead of retrieving the string again. Fixes [Bug 835289].
+
+ * doc/OpenFileChnl.3: Added description of the behaviour of
+ Tcl_ReadChars when its 'charsToRead' argument is set to -1. Fixes [Bug
+ 934511].
+
+ * doc/CrtCommand.3: Added note that the arguments given to the command
+ proc of a Tcl_CreateCommand are in utf8 since Tcl 8.1. Closing [Patch
+ 414778].
+
+ * doc/ChnlStack.3: Removed the declaration that the interp argument to
+ Tcl_(un)StackChannel can be NULL. This fixes [Bug 881220], reported by
+ Marco Maggi <marcomaggi@users.sourceforge.net>.
+
+ * tests/socket.test: Accepted two new testcases by Stuart Casoff
+ <stwo@users.sourceforge.net> checking that -server and -async don't go
+ together [Bug 796534].
+
+ * unix/tclUnixNotfy.c (NotifierThreadProc): Accepted Joe Mistachkin's
+ patch for [Bug 990500], properly closing the notifier thread when its
+ exits.
+
+2004-07-15 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixThrd.c (TclpFinalizeMutex): Accepted Joe Mistachkin's
+ patch for [Bug 990453], closing leakage of mutexes. They were not
+ destroyed properly upon finalization.
+
+2004-07-15 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.h (CHANNEL_INCLOSE): New flag. Set in
+ * generic/tclIO.c (Tcl_UnregisterChannel): 'Tcl_Close' while the
+ * generic/tclIO.c (Tcl_Close): close callbacks are
+ run. Checked in 'Tcl_Close' and 'Tcl_Unregister' to prevent recursive
+ call of 'close' in the close-callbacks. This is a possible error made
+ by implementors of virtual filesystems based on 'tclvfs', thinking
+ that they have to close the channel in the close handler for the
+ filesystem.
+
+2004-07-14 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c:
+ * generic/tclIO.h:
+ * Not reverting, but #ifdef'ing the changes from May 19, 2004 out of
+ the core. This removes the ***POTENTIAL INCOMPATIBILITY*** for channel
+ drivers it introduced. This has become possible due to Expect gaining
+ a BlockModeProc and now handling blockingg and non-blocking modes
+ correctly. Thus [SF Tcl Bug 943274] is still fixed if a recent enough
+ version of Expect is used.
+
+ * doc/CrtChannel.3: Added warning about usage of a channel without a
+ BlockModeProc.
+
+2004-07-15 Andreas Kupries <andreask@pliers.activestate.com>
+
+ * generic/tclIOCmd.c (Tcl_PutsObjCmd): Added length check to the old
+ depreceated newline syntax, to ensure that only "nonewline" is
+ accepted. [Tcl SF Bug 985869], reported by Joe Mistachkin
+ <mistachkin@users.sourceforge.net>.
+
+2004-07-15 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclEvent.c (Tcl_Finalize): stuffed memory leak incurred by
+ re-initializing of TSD slots after the last call to
+ TclFinalizeThreadData (done from within Tcl_FinalizeThread()). We
+ basically just repeat the TclFinalizeThreadData() once more before
+ tearing down TSD keys in TclFinalizeSynchronization(). There should be
+ more elaborate mechanism in place for handling such issues, based on
+ thread cleanup handlers registered on the OS level. Such change
+ requires much more work and would also require TIP because some
+ visible parts of Tcl API would have to be modified. In the meantime,
+ this will do.
+
+ * generic/tclNotify.c (TclFinalizeNotifier): Added conditional
+ notifier finalization based on the fact that an TclInitNotifier has
+ been called for the current thread. This fixes the [Bug 770053] again.
+ Hopefully this time w/o unwanted side-effects.
+
+2004-07-15 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclLiteral.c (TclReleaseLiteral): Removed unused variable
+ 'codePtr' to silence a message from VC++.
+
+2004-07-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript):
+ * generic/tclLiteral.c (TclReleaseLiteral): fix for [Bug 467523],
+ which resurfaced with the latest changes. The previous strategy was to
+ have special code in TclReleaseLiteral to handle the self-references
+ generated by empty scripts. The new approach avoids the self-reference
+ altogether, by having empty scripts return an unshared literal.
+
+2004-07-15 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclEvent.c (NewThreadProc): Backout of changes to fix the
+ [Bug 770053]. See SF bugreport for more info.
+
+2004-07-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_EvalEx): leak fix by dgp, release
+ objv[objectsUsed] on error.
+
+2004-07-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclParse.c (Tcl_SubstObj): leak fix by dgp, release result
+ on error.
+
+2004-07-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (BuildEnsembleConfig): Don't forget to clean out
+ references when deleting the hash table.
+ * generic/tclDictObj.c (Tcl_DictObjRemoveKeyList): Oops, forgot to
+ delete value object when removing the hash entry. [Bug 989093 in part]
+
+2004-07-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TEBC): fixed leak of expandNestList objs when
+ there is an error while an expansion is in progress (code added at
+ checkForCatch).
+
+2004-07-11 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: fix to 'cd' bug when vfs is active [tclvfs Bug
+ 986944] - this bug recently introduced by some threading fixes. Need
+ to work out how to add tests for this.
+
+2004-07-10 Kevin Kenny <kennykb@acm.org>
+
+ * tests/clock.test (clock-2.11): Changed the test so that it isn't an
+ infinite loop when run under valgrind on a slow virtual machine.
+ Thanks to Miguel Sofer for the bug report. Also put in code to restore
+ env(LC_TIME) after tests complete, silencing a warning from 'make
+ TESTFLAGS="-debug 1" test'.
+
+2004-07-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (DeleteInterpProc): reverted the modification of
+ 3 days ago, as the leak of [Bug 983660] is now handled by the change
+ in TclCleanupByteCode.
+ * generic/tclCompile.c (TclCleanupByteCode): let each bytecode remove
+ its references to literals at interp deletion, without updating the
+ dying literal table.
+ * generic/tclLiteral.c (TclDeleteLiteralTable): with the above change
+ to TclCleanupByteCode, this function now removes a single reference to
+ the literal object and cleans up its own structures.
+
+2004-07-08 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclWinInit.c (AppendEnvironment): Silenced a compilation warning
+ about a type mismatch.
+
+2004-07-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript): fix for [Bug 458361].
+ Single-word scripts are compiled with an unshared cmdName to avoid
+ shimmering between bytecode and cmdName reps.
+
+2004-07-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (TclMergeReturnOptions): Simplified logic and
+ removed potential memory leak. [Bug 986257].
+
+2004-07-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2help2.tcl (setTabs, IPmacro): Added support for the more
+ advanced *roff macros used in Tk's doc/bind.n
+
+ * generic/tclObj.c (TclInitObjSubsystem): Declare all current object
+ types.
+
+2004-07-06 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/cmdMZ.test (cmdMZ-return-2.17): Added a test that a word
+ containing backslash-quoted value is treated correctly.
+
+ * generic/tclCompile.c (TclWordKnownAtCompileTime): [Bug 986196]
+ Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs
+ to have their original word value copied ( "{a b}" ) rather than the
+ actual value ( "a b" ). Thanks to Kevin Kenny for report and tests.
+
+2004-07-06 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/cmdMZ.test (cmdMZ-return-2.15,cmdMZ-return-2.16): Added a test
+ that a return code containing spaces is correctly returned.
+
+2004-07-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2html2.tcl (IPmacro, setTabs): Added support for the more
+ advanced *roff macros used in Tk's doc/bind.n
+
+2004-07-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (DeleteInterpProc): fix for [Bug 983660], found
+ by pspjuth. Tear down the global namespace before freeing the interp
+ handle, to allow the bytecodes to free their non-shared literals.
+ * generic/tclLiteral.c (TclReleaseLiteral): moved special code for
+ self-ref so that it is also used for non-shared literals. Possible bug
+ found by inspection.
+
+2004-07-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (ExprRoundFunc):
+ * tests/expr-old.test (39.1): added support for wide integers to
+ round(); [Bug 908375], reported by Hemang Lavana.
+
+2004-07-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.h:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c: Moved declaration of TclCompEvalObj() from
+ tclCompile.h to the internal stubs table, for compiler
+ experimentation.
+
+2004-07-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/regcomp.c (stid): correct minor pointer size error
+
+ * generic/tclPipe.c (TclCreatePipeline): applied TIP #202 patch that
+ * doc/exec.n, tests/exec.test: adds 2>@1 as a special case
+ redirection of stderr to the result output.
+
+2004-07-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/io.test: Changed several tests to run the event loop rather
+ than just calling [update] periodically, avoiding intermittent
+ failures (usually in io-29.32) that stemmed from unreaped processes on
+ Windows.
+ * tests/winPipe.test (winpipe-1.11): Fixed a bug that caused test to
+ fail if the path name of the working directory contained whitespace
+ [Bug 678430]
+
+2004-07-01 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * tests/fileSystem.test: Added test for [Bug 970529]
+
+2004-07-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * win/README.binary, win/README: Updated references to Tcl and Tk 8.4
+ to point to 8.5 instead. Thanks to Theo Verelst for spotting this.
+ * generic/tcl.h: Added note to help prevent those changes from getting
+ missed in the future.
+
+ * doc/Namespace.3, doc/load.n, doc/Limit.3: Typo fixes and remove
+ duplicate documentation. [Bug 983146]
+
+2004-06-30 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/fileSystem.test: Minor correction to new fileSystem-9.X tests
+ so that they clean up temporary directories correctly.
+
+2004-06-30 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/filename.n: clarified behaviour concerning trailing slashes in
+ filenames [Bug 971976]
+
+ * win/tclWinFile.c:
+ * tests/fileSystem.test: fix and tests for [Bug 979879]
+
+2004-06-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP#188 IMPLEMENTATION
+
+ * doc/string.n, tests/string.test: Add 'wideinteger' to things
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): that can be tested for with
+ the [string is] subcommand. [Patch 940915, by Kevin Kenny]
+
+2004-06-29 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinInit.c: Corrected reference counting flaw in recent
+ changes. Thanks to Pat Thoyts. [Bug 981893].
+
+2004-06-29 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/tclWin32Dll.c: fix to compilation with VC++ 5.2
+
+2004-06-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * library/safe.tcl: Make sure that the temporary variable is local to
+ the namespace and not inadvertently global. [Bug 981733]
+
+2004-06-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/unixNotfy.test: Modified constraints so that testing with a
+ threaded tclsh (not tcltest) will not hang.
+
+2004-06-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclThreadStorage.c: Corrected type casting errors that led
+ to calculation of a negative index value, thus accesses outside the
+ threadStorageCache array, thus memory corruption. Crash observed on
+ Mac OS X platform.
+
+2004-06-23 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclThread.c: Implements platform independent thread storage
+ * generic/tclThreadStorage.c: mechanism and fixes associated bugs on
+ platforms where there is limited thread local storage space
+ (Win98/WinNT4). [Patch 976496]
+
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h: Added thread storage functions to the
+ * generic/tclStubInit.c: internal stubs table.
+
+ * unix/Makefile.in:
+ * unix/configure:
+ * unix/tcl.m4:
+ * win/makefile.vc:
+ * win/rules.vc:
+ * win/Makefile.in: Modified the unix, VC++, and Cygwin build systems
+ * win/configure: to include the new "tclThreadStorage.c" and the new
+ * win/tcl.m4: USE_THREAD_STORAGE define.
+
+2004-06-23 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/io.test: Added -force to 18.1 and 18.2. This was failing on
+ WinXP.
+
+ * tests/winFCmd.test: Added a cleanup to winFCmd-16.11 to avoid a
+ failure in 16.12.
+
+ * tests/eofchar.data: Added -kb option to ensure a binary checkout to
+ win32 systems. This fixes a failure in io-61.1
+
+ * win/makefile.vc: fix for [Bug 977369] about launching tclsh to
+ generate a tclConfig.sh with the nmake build system
+
+2004-06-23 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/winDde.test (createChildProcess): Added a 200-ms delay (with
+ the event loop live) when shutting down the test DDE server process.
+ With the delay in place, nuisance failures of tests winDde-4.2, -6.5,
+ and -6.6 appear to be much less frequent. [Bug 957449]
+
+2004-06-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/*.test: Standardize use of platform constraints.
+
+ * unix/tclUnixInit.c (GetStackSize, TclpCheckStackSpace):
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): Added code to check
+ whether the C stack is about to be exceeded, from [Patch 746378] by
+ Joe Mistachkin but with substantial revisions.
+
+2004-06-22 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclEvent.c (NewThreadProc): Fixed broken build on Windows
+ caused by missing TCL_THREAD_CREATE_RETURN.
+
+ * tests/stack.test (stack-3.1): Corrected nuisance error in threaded
+ builds.
+
+2004-06-22 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclEvent.c:
+ * generic/tclInt.h:
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixThrd.c:
+ * win/tclWinThrd.c: [Bug 770053]. See bug report for more information
+ about what it does.
+
+ * tests/unixNotfy.test: rewritten to use tcltest::threadReap to
+ gracefully wait for the test thread to exit. Otherwise we got a race
+ condition with main thread exiting before the test thread. This
+ exposed the long-standing Tcl lib issue with resource
+ garbage-collection on application exit.
+
+2004-06-21 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler)
+ (TclpCheckStackSpace, _except_checkstackspace_handler)
+ (TclWinCPUID, _except_TclWinCPUID_detach_handler):
+ * win/tclWinChan.c (Tcl_MakeFileChannel)
+ (_except_makefilechannel_handler):
+ * win/tclWinFCmd.c (DoRenameFile, _except_dorenamefile_handler)
+ (DoCopyFile, _except_docopyfile_handler):
+ Rework pushing of exception handler function pointer so that compiling
+ with gcc -O3 works. Remove empty function call to avoid compiler
+ warning. Mark the DllMain function as noinline to avoid compiler error
+ from duplicated asm labels in generated code.
+
+2004-06-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclThreadAlloc.c (Ptr2Block): Rewrote so as to maximize the
+ chance of detecting and reporting a memory inconsistency without
+ relying on things being consistent. [Bug 975895]
+
+2004-06-18 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/load.test: Relaxed strictness of error message matching
+ for test load-2.3 so that it will pass on Mac OSX.
+
+ * generic/tclEncoding.c: Static TclFindEncodings -> FindEncodings.
+ * generic/tclInt.h: Updated TclpFindExecutable() so that failed
+ * generic/tclUtil.c: attempts to find the executable are saved
+ * unix/tclUnixFile.c: just as successful finds are. [Patch 966053]
+ * unix/tclUnixTest.c:
+
+2004-06-18 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/winFCmd.test (winFCmd-16.12): Changed test to compute the
+ target directory, so as not to fail if the user's HOME isn't the root.
+
+2004-06-19 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4: autoconf 2.5 fixes in Darwin section.
+ * unix/configure: autoconf-2.57
+
+2004-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixInit.c (localeTable): Added some more locale to encoding
+ mapping info from Jim Huang <jserv@kaffe.org>
+
+ * generic/tclInt.h (PendingObjData,TclFreeObjMacro,etc):
+ * generic/tclObj.c (TclFreeObj): Added scheme for making TclFreeObj()
+ avoid blowing up the C stack when freeing up very large object trees.
+ [Bug 886231]
+
+ * win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and add
+ comments.
+
+2004-06-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclObj.c: Added missing space in panic message.
+
+ * win/tclWinInit.c: Inform [tclInit] about the default library
+ directory via the ::tclDefaultLibrary variable. This should correct a
+ problem with my 2004-06-11 commit. Better solutions still in the
+ works. Thanks to Joe Mistachkin for pointing out the breakage.
+
+2004-06-16 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/library.n: Moved variables ::auto_oldpath and
+ * library/auto.tcl: ::unknown_pending into ::tcl namespace.
+ * library/init.tcl: [Bugs 808319, 948794]
+
+2004-06-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/binary.n: Added some notes to the documentation of the 'a'
+ format to address the point raised in [RFE 768852].
+
+2004-06-15 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclConfig.sh.in (TCL_EXTRA_CFLAGS): set to @CFLAGS@, which is
+ the configure-time CFLAGS. Addendum to m4 change on 2004-05-26.
+
+2004-06-14 Kevin Kenny <kennykb@acm.org>
+
+ * win/Makefile.in: Corrected compilation flags for tclPkgConfig.c so
+ that it doesn't require Stubs.
+ * generic/tclBasic.c (Tcl_CreateInterp): Removed comment stating that
+ TclInitEmbeddedConfigurationInformation needs Stubs; with the change
+ above, the comment is now erroneous.
+
+2004-06-11 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/Encoding.3: Removed bogus claims about tcl_libPath.
+
+ * generic/tclInterp.c (Tcl_Init): Stopped setting the
+ tcl_libPath variable. [tclInit] can get all its directories without it.
+
+ * tests/unixInit.test: Modified test code that made use of
+ tcl_libPath variable.
+
+ * unix/tclUnixInit.c: Stopped setting the tclDefaultLibrary variable,
+ execept on the Mac OS X platform with HAVE_CFBUNDLE. In that
+ configuration we should seek some way to make use of the TIP 59
+ facilities and get rid of that usage of tclDefaultLibrary as well.
+
+ * generic/tclInterp.c: Updated [tclInit] to make $env(TCL_LIBRARY) an
+ absolute path, and to include the scriptdir,runtime configuration value
+ on the search path for init.tcl.
+
+ * unix/tclUnixInit.c: The routines Tcl_Init() and TclSourceRCFile()
+ * win/tclWinInit.c: had identical implementations for both win and
+ * generic/tclInterp.c: unix. Moved to a single generic implementation.
+ * generic/tclMain.c:
+ * library/init.tcl:
+ * generic/tclInitScript.h (removed):
+ * unix/Makefile.in:
+ * win/tcl.dsp:
+
+ * unix/configure.in: Updated TCL_PACKAGE_PATH value to handle
+ * win/configure.in: --libdir configuration.
+
+ * unix/configure.in: autoconf-2.57
+ * win/configure.in:
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Moved call to
+ TclInitEmbeddedConfigurationInformation() earlier in
+ Tcl_CreateInterp() so that other parts of interp creation and
+ initialization may access and use the config values.
+
+2004-06-11 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclAppInit.c: Restored the 'setargv' procedure when compiling
+ with mingw. Apparently, the command line parsing in mingw doesn't work
+ as well as that in vc++, and the result was (1) that winPipe-8.19
+ failed, and (2) that 'make test' would work at all only with
+ TESTFLAGS='-singleproc 1'. [Bug 967195]
+
+2004-06-10 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclIOUtil.c: removed forceful setting of the private cached
+ current working directory rep from within the Tcl_FSChdir(). We
+ delegate this task to the Tcl_FSGetCwd() which does this task anyway.
+ The relevant code is still present but disabled temporarily until the
+ change proves correct. The Tcl test suite passes all test with the
+ given change so I suppose it is good enough.
+
+2004-06-10 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixInit.c (TclpInitLibraryPath): Disabled addition of
+ * win/tclWinInit.c (TclpInitLibraryPath): relative-to-executable
+ directories to the library search path. A first step in reform of
+ Tcl's startup process.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Attempts to directly run ./tclsh or ./tcltest out of a build directory
+ will either fail, or will make use of an installed script library in
+ preference to the one in the source tree. Use `make shell` or `make
+ runtest` instead.
+
+ * tests/unixInit.test: Modified tests to suit above changes.
+
+ * generic/tclPathObj.c: Corrected [file tail] results when operating
+ on a path produced by TclNewFSPathObj(). [Bug 970529]
+
+2004-06-09 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclIOUtil.c: partially corrected [Bug 932314]. Also
+ corrected return values of Tcl_FSChdir() to reflect those of the
+ underlying platform-specific call. Originally, return codes were mixed
+ with those of Tcl.
+
+2004-06-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:
+ * generic/tclExecute.c: handle warning [Bug 969066]
+
+2004-06-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclHash.c (RebuildTable): Move declaration of variable so it
+ is only declared when it is used. [Bug 969068]
+
+2004-06-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n: Added correct option to example. [Bug 968219]
+
+2004-06-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw
+ build works again.
+ * generic/tclDecls.h: Changes to the tests for clock
+ * generic/tclInt.decls: frequency in Tcl_WinTime so
+ * generic/tclIntDecls.h: that any clock frequency is
+ * generic/tclIntPlatDecls.h: accepted provided that all
+ * generic/tclPlatDecls.h: CPU's in the system share a
+ * generic/tclStubInit.c: common chip, and hence,
+ * tests/platform.test (platform-1.3): presumably, a common clock.
+ * win/tclWin32Dll.c (TclWinCPUID): This change necessitated a
+ * win/tclWinTest.c (TestwincpuidCmd) small burst of assembly code
+ * win/tclWinTime.c (Tcl_GetTime): to read CPU ID information,
+ which was added as TclWinCPUID in the internal Stubs. To test this
+ code in the common case of a single-processor machine, a
+ 'testwincpuid' command was added to tclWinTest.c, and a test case in
+ platform.test. Thanks to Jeff Godfrey and Richard Suchenwirth for
+ reporting this bug. [Bug 976722]
+
+2004-06-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Restored #include <stdio.h> to tcl.h,
+ rejecting the "fix" for "Bug" 945570. Tcl_FSSeek() needs the values of
+ SEEK_SET, etc. and too many extensions rely on tcl.h providing stdio.h
+ for them.
+
+2004-06-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA
+ (Win9x), convert from CP_ACP to WCHAR then convert back to utf8.
+ Adjunct to 2004-04-07 fix.
+
+2004-06-02 David Gravereaux <davygrvy@pobox.com>
+
+ * tests/winPipe.test (winpipe-6.1): blocking set to 1 before closing
+ to ensure we get an exitcode. The windows pipe channel driver doesn't
+ differentiate between a blocking and non-blocking close just yet, but
+ will soon. Part of [Bug 947693]
+
+2004-06-02 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/file.n: fix to documentation of 'file volumes' (Bug 962435)
+
+2004-06-01 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: check for either MSDEVDIR or MSVCDIR being in the
+ environment, for VC7. [Bug 942214]
+
+ * generic/tclIO.c (Tcl_SetChannelOption): -buffersize wasn't
+ understanding hexidecimal notation nor was reporting number conversion
+ errors. The behavior to silently ignore settings outside the
+ acceptable range of Tcl_SetChannelBufferSize (<10 or >1M) is
+ unchanged. This silent ignoring behavior might be up for review soon.
+
+2004-05-30 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinPipe.c:
+ * win/tclWinPort.h: Reworked the win implementation of Tcl_WaitPid to
+ support exitcodes in the 'signed short' range. Even though this range
+ is non-portable, it is valid on windows. Detection of exception codes
+ are now more accurate. Previously, an application that exited with
+ ExitProcess((DWORD)-1); was improperly reported as exiting with
+ SIGABRT.
+
+2004-05-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c: Added comments describing the purposes of each
+ function in the limit implementation and rewrote the names of some
+ non-public functions for greater clarity of purpose.
+ * doc/interp.n: Added note about what happens when a limited
+ interpreter creates a slave interpreter.
+ * doc/Limit.3: Added manual page for the resource limit subsystem's C
+ API. [Bug 953903]
+
+2004-05-29 Joe English <jenglish@users.sourceforge.net>
+
+ * doc/global.n, doc/interp.n, doc/lrange.n: Fix minor markup errors.
+
+2004-05-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/*.n: Added examples to many (too many to list) more man pages.
+
+2004-05-25 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c:
+ * generic/tclVar.c: using (ptrdiff_t) instead of (int) casting to
+ correct compiler warnings [Bug 961657], reported by Bob Techentin.
+
+2004-05-27 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/clock.test: Added a single test for the presence of %G in
+ [clock format], and conditioned out the clock-10.x series if they're
+ all going to fail because of a broken strftime() call. [Bug 961714]
+
+2004-05-27 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclHash.c (CompareStringKeys): Added #ifdef to allow people
+ to instruct this function to use strcmp(). [FRQ 951168]
+
+ * generic/tclVar.c: Moved declarations into #if guards so they only
+ happen when required.
+ * unix/tclUnixPort.h: Guard declaration of strtod() so it is only
+ enabled when we don't have a declaration in stdlib.h
+ * unix/tclUnixThrd.c (Tcl_CreateThread): Added declarations
+ * unix/tclUnixTest.c (AlarmHandler): and casts so that
+ * unix/tclUnixChan.c (TtyModemStatusStr): all functions are
+ * generic/tclScan.c (Tcl_ScanObjCmd): defined before use
+ * generic/tclDictObj.c (InvalidateDictChain): and no cross-type
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): uses are performed.
+
+ The overall effect is to make building with gcc with the additional
+ flags -Wstrict-prototypes -Wmissing-prototypes produce no increase in
+ the total number of warnings (except for main(), which is undeclared
+ for traditional reasons.)
+
+2004-05-26 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in: Rework configure ordering to TCL_LINK_LIBS,
+ * unix/tcl.m4: ENABLE_SHARED, CONFIG_CFLAGS, & ENABLE_SYMBOLS
+ * unix/configure: before TCL_EARLY_FLAGS and TCL_64BIT_FLAGS
+ * unix/configure.in: (about 400 lines earlier) in configure.in. This
+ forces CFLAGS configuration to be done before many tests, which is
+ needed for 64-bit builds and may affect other builds. Also make
+ CONFIG_CFLAGS append to CFLAGS directly instead of using EXTRA_CFLAGS,
+ and have LDFLAGS append to any existing value. [Bug 874058]
+ * unix/dltest/Makefile.in: change EXTRA_CFLAGS to DEFS
+
+2004-05-26 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Correction to debug prints and testing
+ * library/tcltest/pkgIndex.tcl: if TCLTEST_OPTIONS value. Corrected
+ * tests/tcltest.test: double increment of numTestFiles in
+ -singleproc 1 configurations. Updated tcltest-19.1 to tcltest 2.1
+ behavior. Corrected tcltest-25.3 to not falsely report a failure in
+ tcltest.test. Bumped to tcltest 2.2.6. [Bugs 960560, 960926]
+
+2004-05-25 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/http.n (http::config): add -urlencoding option (default utf-8)
+ * library/http/http.tcl: that specifies encoding conversion of
+ * library/http/pkgIndex.tcl: args for http::formatQuery. Previously
+ * tests/http.test: undefined, RFC 2718 says it should be
+ utf-8. 'http::config -urlencoding {}' returns previous behavior, which
+ will throw errors processing non-latin-1 chars. Bumped http package to
+ 2.5.0.
+
+2004-05-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (DeleteScriptLimitCallback): Move all deletion
+ of script callback hash table entries to happen here so the entries
+ are correctly removed at the right time. [Bug 960410]
+
+2004-05-25 Miguel Sofer <msofer@users.sf.net>
+
+ * docs/global.n: added details for qualified variable names [Bug
+ 959831]
+
+2004-05-25 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_FindNamespaceVar):
+ * tests/namespace.test (namespace-17.10-12): reverted commit of
+ 2004-05-23 and removed the tests, as it interferes with the varname
+ resolver and there are apps that break (AlphaTk). A fix will have to
+ wait for Tcl9.
+
+ * generic/tclVar.c: Caching of namespace variables disabled: no simple
+ way was found to avoid interfering with the resolver's idea of
+ variable existence. A cached varName may keep a variable's name in the
+ namespace's hash table, which is the resolver's criterion for
+ existence.
+
+ * tests/namespace.c (namespace-17.10): testing for interference
+ between varname caching and name resolver.
+
+2004-05-25 Kevin Kenny <kennykb@acm.org>
+
+ * tests/winFCmd.test: Correct test for the presence of a CD-ROM so
+ that it doesn't misdetect some other sort of filesystem with a
+ write-protected root as being a CD-ROM drive. [Bug 918267]
+
+2004-05-25 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/winPipe.test: Protect against path being set
+ * tests/unixInit.test: Unset path when done.
+ * tests/unload.test (unload-3.1): Verify [pkgb_sub] does not exist.
+ Delete interps when done.
+ * tests/stringComp.test: stop re-use of string.test test names
+ * tests/regexpComp.test: stop re-use of regexp.test test names
+ * tests/namespace.test (namespace-46.3): Verify [p] does not exist.
+ * tests/http.test: Clear away the custom [bgerror] when done.
+ * tests/io.test: Take care to use namespace variables.
+ * tests/autoMkindex.test (autoMkindex-5.2): Use variable "result"
+ that gets cleaned up.
+ * tests/exec.test: Clean up the "path" array.
+ * tests/interp.test (interp-9.3): Initialize res, so prior values
+ cannot make the test fail.
+ * tests/execute.test (execute-8.1): Updated to remove the trace set
+ on ::errorInfo. When left in place, that trace can cause later tests
+ to fail.
+
+2004-05-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclBasic.c: Removed references to Tcl_RenameCommand from
+ * generic/tcl.h: comments. [Bug 848440, second part]
+
+ * tests/fCmd.test: Rewrote tests that failed consistently on NFS so
+ they either succeed (through slightly more liberal matching of the
+ results) or are constrained to not run. [Bug 931312]
+
+ * doc/bgerror.n: Use idiomatic open flags for working with log
+ files. [Bug 959602]
+
+2004-05-24 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclExecute.c (VerifyExprObjType): use GET_WIDE_OR_INT to
+ properly have tclIntType used for smaller values. This corrects [TclX
+ Bug 896727] and any other 3rd party extension that created math
+ functions but was not yet WIDE_INT aware in them.
+
+2004-05-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (TclInitLimitSupport): Made limits work on
+ platforms where sizeof(void*)!=sizeof(int). [Bug 959193]
+
+2004-05-24 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/set.n: accurate description of name resolution process,
+ referring to namespace.n for details [Bug 959180]
+
+2004-05-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_FindNamespaceVar): [Bug 959052] fixed,
+ insuring that no "zombie" variables are found.
+ * generic/tclVar.c (TclLookupSimpleVar): comments re [Bug 736729]
+ (predecessor of [Bug 959052]) removed.
+ * tests/namespace.test: added tests 17.10-12
+
+ The patch modifies non-documented behaviour, and passes every test in
+ the testsuite. However, scripts relying on the old behaviour may
+ break.
+ Note that the only behaviour change concerns the creative writing of
+ unset variables. More precisely, which variable will be created when
+ neither a namespace variable nor a global variable by that name
+ exists, as defined by [info vars]. The new behaviour is that the
+ namespace resolution process deems a variable to exist exactly when
+ [info vars] finds it - ie, either it has value, or else it was "fixed"
+ by a call to [variable].
+ Note: this patch was removed on 2002-05-25.
+
+2004-05-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclObjLookupVar, TclObjUnsetVar2): fix for new (in
+ tcl8.4) exteriorisations of [Bug 736729] due to the use of
+ tclNsVarNameType obj types. Reenabling the use of this objType ("VAR
+ ref absolute" benchmark down to 66 ms, from 230). Added comments in
+ TclLookupSimpleVar explaining my current understanding of [Bug
+ 736729].
+
+2004-05-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: fix for [Bug 735335]. The use of tclNsVarNameType
+ objs is still disabled, pending resolution of [Bug 736729].
+
+2004-05-21 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/namespace.test (namespace-41.3): removed the {knownBug}
+ constraint: [Bug 231259] is closed since nov 2001, and the fix of [Bug
+ 729692] (INST_START_CMD) makes the test succeed.
+
+2004-05-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Move a few declarations a
+ short distance so pre-C99 compilers can cope. Also fix so
+ TCL_COMPILE_DEBUG path compiles...
+
+2004-05-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC
+ automatic variables, defining them in tight blocks instead of at the
+ function level. This has three purposes:
+ - it simplifies the analysis of individual instructions
+ - it is preliminary work to the non-recursive engine
+ - it allows a better register allocation by the optimiser; under
+ gcc3.3, this results in up to 10% runtime in some tests
+
+2004-05-20 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (TclLimitRemoveAllHandlers):
+ * generic/tclBasic.c (DeleteInterpProc):
+ * tests/interp.test (interp-34.7): Ensure that all limit callbacks are
+ deleted when their interpreters are deleted. [Bug 956083]
+
+2004-05-19 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWinFile.c (TclpMatchInDirectory): fix for an issue where
+ there was a sneak path from Tcl_DStringFree to SetErrorCode(0). The
+ result was that the error code could be reset between a call to
+ FindFirstFileEx and the check of its status return, leading to a
+ bizarre error return of {POSIX unknown {No error}}. (Found in
+ unplanned test - no incident logged at SourceForge.)
+
+2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/interp.test (interp-34.3): Rewrite this test to see if a time
+ limit can catch a tight bytecode loop, a maximally aggressive
+ denial-of-service attack.
+ * generic/tclInterp.c (Tcl_LimitCheck): Fix the sense of checks to see
+ whether a time limit has been extended.
+
+ * tests/*.test: Many minor fixes, including ensuring that every test
+ is run (so constraints control whether the test is doing anything) and
+ making sure that constraints are always set using the API instead of
+ poking around inside tcltest's internal datastructures. Also got rid
+ of all trailing whitespace lines from the test suite!
+
+2004-05-19 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem
+ * generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry
+ 2001-09-26. The fix done at that time is incomplete. It is possible to
+ get around it if the actual read operation is defered and not executed
+ in the event handler itself. Instead of tracking if we are in an read
+ caused by a synthesized fileevent we now track if the OS has delivered
+ a true event = actual data and bypass the driver if a read finds that
+ there is no actual data waiting. The flag is cleared by a short or
+ full read.
+
+ ***POTENTIAL INCOMPATIBILITY*** for channel drivers.
+
+2004-05-17 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix to (Bug 956063) in 'file dirname'.
+ * tests/cmdAH.test: added test for this bug.
+
+ * doc/FileSystem.3: better documentation of refCount requirements of
+ some FS functions (Bug 956126)
+
+2004-05-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclTest.c (TestgetintCmd): Made the tests in get.test check
+ * tests/get.test: Tcl_GetInt() since the core now
+ avoids that function.
+
+2004-05-18 Kevin B. Kenny <kennykb@acm.org>
+
+ * compat/strftime.c (_fmt, ISO8601Week):
+ * doc/clock.n:
+ * tests/clock.test: Major rework to the handling of ISO8601 week
+ numbers. Now passes all the %G and %V test cases on Windows, Linux and
+ Solaris [Bugs 500285, 500389, and 852944]
+
+2004-05-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/append.n, doc/upvar.n: Added example.
+
+2004-05-18 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: now generates a tclConfig.sh from Pat Thoyts [Patch
+ 909911]
+
+2004-05-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n: Improve clarity (based on [Patch 955361] by Peter
+ Spjuth)
+
+ * tools/man2help2.tcl (macro,SHmacro): Added support for subsection
+ (.SS) header macros.
+
+ * doc/interp.n: Added user documentation for the TIP#143 resource
+ limits and some examples.
+
+ * generic/tclInterp.c (Tcl_LimitCheck, Tcl_LimitTypeReset): Reset the
+ limit-exceeded flag when removing a limit.
+
+2004-05-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): added comments to
+ classify the variables according to their use in TEBC.
+
+2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/global.n, doc/uplevel.n: Added an example.
+
+ * tests/info.test (info-3.1): Corrected test result back to what it
+ used to be in Tcl 7.* now that command counts are being correctly kept
+
+ * generic/tclExecute.c (TEBC:INST_START_CMD): Make sure that the
+ command-count is always advanced. Allows TIP#143 limits to tell that
+ work is being done.
+
+ * doc/list.n: Updated example to fit with the unified format.
+ * doc/seek.n: Added some examples.
+
+2004-05-17 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/tclWinFile.c:
+ * tests/cmdAH.test: fix to (Bug 954263) where 'file executable' was
+ case-sensitive.
+
+2004-05-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/OpenFileChnl.3: Documented type of 'offset' argument to Tcl_Seek
+ was wrong. [Bug 953374]
+
+2004-05-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): remove one level of
+ indirection for compiledLocals addressing.
+
+2004-05-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_CALL_FUNC1): bugfix; restored
+ (DE)CACHE_STACK_INFO pair around the call - the user defined math
+ function could cause a recursive call to TEBC.
+
+2004-05-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_DeleteInterp):
+ * generic/tclExecute.c (INST_START_CMD): interp deletion now modifies
+ the compileEpoch, eliminating the need for the check for interp
+ deletion in INST_START_CMD.
+
+2004-05-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.h:
+ * generic/tclCompile.c:
+ * generic/tclExecute.c: changed implementation of {expand}, last
+ chance while in alpha as ...
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Scripts precompiled with ProComp under previous tcl8.5a versions may
+ malfunction due to changed instruction numbers for
+ INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD.
+
+2004-05-14 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclInt.decls: Promoted TclpLocaltime and TclpGmtime
+ * generic/tclIntDecls.h: from Unix-specific stubs to the generic
+ * generic/tclIntPlatDecls.h: internal Stubs table. Reran 'genstubs'
+ * generic/tclStubInit.c:
+ * unix/tclUnixPort.h:
+
+ * generic/tclClock.c: Changed a buggy 'GMT' timezone specification
+ to the correct 'GMT0'. [Bug 922848]
+
+ * unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to
+ unix/tclUnixTime.c where they belong.
+
+ * unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone,
+ ThreadSafeGMTime [removed],
+ ThreadSafeLocalTime [removed],
+ SetTZIfNecessary, CleanupMemory):
+ Restructured to make sure that the same mutex protects all calls to
+ localtime, gmtime, and tzset. Added a check in front of those calls to
+ make sure that the TZ env var hasn't changed since the last call to
+ tzset, and repeat tzset if necessary. [Bug 942078] Removed a buggy
+ test of the Daylight Saving Time information in 'gettimeofday' in
+ favor of applying 'localtime' to a known value. [Bug 922848]
+
+ * tests/clock.test (clock-3.14): Added test to make sure that changes
+ to $env(TZ) take effect immediately.
+
+ * win/tclWinTime.c (TclpLocaltime, TclpGmtime): Added porting layer
+ for 'localtime' and 'gmtime' calls.
+
+2004-05-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c:
+ * generic/tclCompile.h: the math functions receive a pointer to top of
+ the stack (tosPtr) instead of the execution environment (eePtr). First
+ step towards a change in the execution stack management - it is now
+ only used within TEBC.
+
+2004-05-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP#143 IMPLEMENTATION
+
+ * generic/tclExecute.c (TclCompEvalObj, TclExecuteByteCode):
+ * generic/tclBasic.c (TclEvalObjvInternal): Enable limit checking.
+ * generic/tclInterp.c (Tcl_Limit*): Public limit API.
+ * generic/tcl.decls:
+ * tests/interp.test: Basic tests of command limits.
+
+ * doc/binary.n: TIP#129 IMPLEMENTATION [Patch 858211]
+ * generic/tclBinary.c: Note that the test suite probably has many more
+ * tests/binary.test: failures now due to alterations in constraints.
+
+2004-05-12 Miguel Sofer <msofer@users.sf.net>
+
+ Optimisations for INST_START_CMD [Bug 926164].
+ * generic/tclCompile.c (TclCompileScript): avoid emitting
+ INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It is
+ not needed, as the checks are done before calling TEBC.
+ * generic/tclExecute.c (TclExecuteByteCode): runtime peephole
+ optimisation: check at INST_POP if the next instruction is
+ INST_START_CMD, in which case we fall through.
+
+2004-05-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/split.n, doc/join.n: Updated examples and added more.
+
+2004-05-11 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/glob.n: documented behaviour of symbolic links with 'glob -types
+ d' (Bug 951489)
+
+2004-05-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/scan.n: Updated the examples to be clearer about their relevance
+ to the scan command.
+
+2004-05-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/scan.n: Added examples.
+
+2004-05-10 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinPipe.c (BuildCommandLine): Moved non-obvious appending
+ logic to outside the loop and added commentary for its purpose. Also
+ use the existence of contents in the linePtr rather than the scratch
+ DString post the append, as this more clear.
+
+ (TclpCreateProcess): When under NT, with no console, and executing a
+ DOS application, the path priming does not need an ending space as
+ BuildCommandLine() will do this for us.
+
+2004-05-08 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c:
+ * generic/tclIOUtil.c: remove some compiler warnings on MacOS X.
+
+2004-05-07 Chengye Mao <chengye.geo@yahoo.com>
+
+ * win/tclWinPipe.c: refixed bug 789040 re-entered in rev 1.41. Let's
+ be careful and don't re-enter previously fixed bugs.
+
+2004-05-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/format.n: Added examples.
+
+2004-05-07 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/unset.n: added upvar.n to the "see also" list
+
+2004-05-07 Reinhard Max <max@suse.de>
+
+ * generic/tclEncoding.c:
+ * tests/encoding.test: added support and tests for translating
+ embedded null characters between real nullbytes and the internal
+ representation on input/output [Bug 949905].
+
+2004-05-07 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c:
+ * generic/tclIOUtil.c:
+ * generic/tclFileSystem.h:
+ * tests/fileSystem.test: fix for [Bug 943995], in which vfs-registered
+ root volumes were not handled correctly as glob patterns in all
+ circumstances.
+
+2004-05-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclObj.c (TclFreeObj): made TclFreeObj use the new macro
+ TclFreeObjMacro(), so that the allocation and freeing of Tcl_Obj is
+ defined in a single spot (the macros in tclInt.h), with the exception
+ of the TCL_MEM_DEBUG case.
+ The #ifdef logic for the corresponding macros has been reformulated to
+ make it clearer.
+
+2004-05-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/break.n, doc/continue.n, doc/for.n, doc/while.n: More examples.
+
+2004-05-05 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/unixInit.test (unixInit-2.10): Test correction for Mac OSX.
+ Be sure to consistently compare normalized path names. Thanks to
+ Steven Abner (tauvan). [Bug 948177]
+
+2004-05-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/CrtObjCmd.3: Remove reference to Tcl_RenameCommand; there is no
+ such API. [Bug 848440]
+
+2004-05-05 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinSock.c (SocketEventProc) : connect errors should fire both
+ the readable and writable handlers because this is how it works on
+ UNIX [Bug 794839]
+
+ * generic/tclEncoding.c (TclFinalizeEncodingSubsystem):
+ FreeEncoding(systemEncoding); moved to before the hash table iteration
+ as it was causing a double free attempt under some conditions.
+
+ * win/coffbase.txt: Added the tls extension to the list of preferred
+ load addresses.
+
+2004-05-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/fileSystem.test (filesystem-1.39): replace 'file volumes'
+ * tests/fileName.test (filename-12.9,10): lindex with direct C:/
+ hard-coded because A:/ was being used and that is empty for most.
+
+ * tests/winFCmd.test (winFCmd-16.12): test volumerelative $HOME
+
+2004-05-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclAlloc.c: Make sure Tclp*Alloc* routines get
+ * generic/tclInt.h: declared in the TCL_MEM_DEBUG and
+ * generic/tclThreadAlloc.c: TCL_THREADS configuration. [Bug 947564]
+
+ * tests/tcltest.test: Test corrections for Mac OSX. Thanks to Steven
+ Abner (tauvan). [Bug 947440]
+
+2004-05-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclEvent.c (TclSetLibraryPath): Suppress a warning.
+
+2004-05-03 Andreas Kupries <andreask@activestate.com>
+
+ * Applied [Patch 868853], fixing a mem leak in TtySetOptionProc.
+ Report and Patch provided by Stuart Cassoff <stwo@users.sf.net>.
+
+2004-05-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclCreateProc): comments corrected.
+
+2004-05-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript): setting the compilation
+ namespace outside of the loop.
+
+2004-05-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:
+ * generic/tclInt.h: reverted fix for [Bug 926445] of 2004-04-02,
+ restoring TCL_ALIGN to the header file. Todd Helfter reported that the
+ macro is required by tbcload.
+
+2004-05-03 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclWin32Dll.c (TclpCheckStackSpace):
+ * tests/stack.test (stack-3.1): Fix for undetected stack overflow in
+ TclReExec on Windows. [Bug 947070]
+
+2004-05-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl: Corrected unique prefix matching of
+ interactive command completion in [unknown]. [Bug 946952]
+
+2004-05-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclObjInvokeProc):
+ * tests/proc.test (proc-3.6): fix for bad quoting of multi-word proc
+ names in error messages [Bug 942757]
+
+2004-04-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/glob.n, doc/incr.n, doc/set.n: More examples.
+ * doc/if.n, doc/rename.n, doc/time.n:
+
+2004-04-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Replaced Kevin Kenny's temporary
+ * generic/tclThreadAlloc.c: fix for Bug 945447 with a cleaner,
+ more permanent replacement.
+
+2004-04-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclThreadAlloc.c: Added a temporary (or so I hope!)
+ inclusion of "tclWinInt.h" to avoid problems when compiling on
+ Win32-VC++ with --enable-threads. [Bug 945447]
+
+2004-04-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/puts.n: Added a few examples.
+
+2004-04-29 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/execute.test (execute-8.2): Avoid crashes when there is
+ limited system stack space (threads-enabled).
+
+2004-04-28 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/global.n:
+ * doc/upvar.n:
+ * generic/tclVar.c (ObjMakeUpvar):
+ * tests/upvar.test (upvar-8.11):
+ * tests/var.test (var-3.11): Avoid creation of unusable variables:
+ [Bug 600812] [TIP 184].
+
+2004-04-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n: Fixed fault in documentation of -index option [943448]
+
+2004-04-26 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixFCmd.c (TclpObjNormalizePath): Corrected improper
+ positioning of returned checkpoint. [Bug 941108]
+
+2004-04-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/open.n, doc/close.n: Updated (thanks to David Welton) to be
+ clearer about pipeline errors and added example to open(n) that shows
+ simple pipeline use. [Patches 941377,941380]
+
+ * doc/DictObj.3: Added warning about the use of Tcl_DictObjDone and an
+ example of use of iteration. [Bug 940843]
+
+ * doc/Thread.3: Reworked to remove references to testing interfaces
+ and instead promote the use of the Thread package. [Patch 932527]
+ Also reworked and reordered the page for better readability.
+
+2004-04-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Removed obsolete declarations and #include's.
+ * generic/tclInt.h: [Bugs 926459, 926486]
+
+2004-04-24 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWin32Dll.c (DllMain): Added DisableThreadLibraryCalls() for
+ the DLL_PROCESS_ATTACH case. We're not interested in knowing about
+ DLL_THREAD_ATTACH, so disable the notices.
+
+2004-04-24 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclPort.h:
+ * macosx/Makefile:
+ * unix/Makefile.in: followup on tcl header reform [FR 922727]: removed
+ use of relative #include paths in tclPort.h to allow installation of
+ private headers outside of tcl source tree; added 'unix' dir to
+ compiler header search path; add newly required tcl private headers to
+ Tcl.framework on Mac OSX.
+
+2004-04-23 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (Tcl_SetChannelOption): Fixed [SF Tcl Bug 930851].
+ When changing the eofchar we have to zap the related flags to prevent
+ them from prematurely aborting the next read.
+
+2004-04-25 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix to [Bug 940281]. Tcl_FSJoinPath will now
+ always return a valid Tcl_Obj when the input is valid.
+ * generic/tclIOUtil.c: fix to [Bug 931823] for a more consistent
+ Tcl_FSPathSeparator() implementation which allows filesystems not to
+ implement their Tcl_FSFilesystemSeparatorProc if they wish to use the
+ default '/'. Also fixed associated memory leak seen with, e.g., tclvfs
+ package.
+ * doc/FileSystem.3: documented Tcl_FSJoinPath return values more
+ clearly, and Tcl_FSFilesystemSeparatorProc requirements.
+
+2004-04-23 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWin32Dll.c: Removed my mistake from 4/19 of adding an exit
+ handler to TclWinInit. TclWinEncodingsCleanup called from
+ TclFinalizeFilesystem does the Tcl_FreeEncoding for us.
+
+ * win/tclWinChan.c (Tcl_MakeFileChannel): Case for CloseHandle
+ returning zero and not throwing a
+ RaiseException(EXCEPTION_INVALID_HANDLE) now being done.
+
+2004-04-22 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclEvent.c: TclSetLibraryPath's use of caching the stringrep
+ of the pathPtr object to TclGetLibraryPath called from another thread
+ was ineffective if the original's stringrep had been invalidated as
+ what happens when it gets muted to a list.
+
+ * win/tclWinTime.c: If the Tcl_ExitProc (StopCalibration) is called
+ from the stack frame of DllMain's PROCESS_DETACH, the wait operation
+ should timeout and continue.
+
+ * generic/tclInt.h:
+ * generic/tclThread.c:
+ * generic/tclEvent.c:
+ * unix/tclUnixThrd.c:
+ * win/tclWinThrd.c: Provisions made so masterLock, initLock, allocLock
+ and joinLock mutexes can be recovered during Tcl_Finalize.
+
+2004-04-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/switch.n: Reworked the examples to be more systematically named
+ and to cover some TIP#75 capabilities.
+
+ * doc/cd.n: Documentation clarification from David Welton.
+
+ * doc/exec.n: Added some examples, Windows ones from Arjen Markus and
+ Unix ones by myself.
+
+2004-04-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/Hash.3: Added note to Tcl_{First,Next}HashEntry docs that
+ deleting the element they return is supported (and is in fact the only
+ safe update you can do to the structure of a hashtable while an
+ iteration is going over it.)
+
+ * doc/bgerror.n: Added example from David Welton. [Patch 939473]
+
+ * doc/after.n: Added examples from David Welton. [Patch 938820]
+
+2004-04-19 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWin32Dll.c: Added an exit handler in TclWinInit() so
+ tclWinTCharEncoding could be freed during Tcl_Finalize().
+
+ * generic/tclEncoding.c: Added FreeEncoding(systemEncoding) in
+ TclFinalizeEncodingSubsystem because its ref count was incremented in
+ TclInitEncodingSubsystem.
+
+2004-04-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/read.n: Added example from David Welton. [Patch 938056]
+
+2004-04-19 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclObj.c (Tcl_GetDoubleFromObj) Corrected "short circuit"
+ conversion of int to double. Reported by Jeff Hobbs on the Tcl'ers
+ Chat.
+
+2004-04-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lreplace.n, doc/lrange.n, doc/llength.n: More examples for
+ * doc/linsert.n, doc/lappend.n: the documentation.
+
+2004-04-16 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/FileSystem.3: Corrected documentation of Tcl_FSUtime, and the
+ corresponding filesystem driver Tcl_FSUtimeProc. [Bug 935838]
+
+2004-04-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/socket.n: Added example from [Patch 936245].
+ * doc/gets.n: Added example based on [Patch 935911].
+
+2004-04-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclClock.c (Tcl_ClockObjCmd): Minor fault in a [clock
+ clicks] error message.
+
+2004-04-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinInit.c (TclpSetInitialEncodings): note that WIN32_CE is
+ also a unicode platform.
+ * generic/tclEncoding.c (TclFindEncodings, Tcl_FindExecutable):
+ * generic/tclInt.h: Correct handling of UTF
+ * unix/tclUnixInit.c (TclpInitLibraryPath): data that is actually
+ * win/tclWinFile.c (TclpFindExecutable): "clean", allowing the
+ * win/tclWinInit.c (TclpInitLibraryPath): loading of Tcl from paths
+ that contain multi-byte chars on Windows [Bug 920667]
+
+ * win/configure: define TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC,
+ * win/configure.in: TCL_LIB_SPEC, TCL_PACKAGE_PATH in tclConfig.sh.
+
+2004-04-06 Don Porter <dgp@users.sourceforge.net>
+
+ Patch 922727 committed. Implements three changes:
+
+ * generic/tclInt.h: Reworked the Tcl header files into a clean
+ * unix/tclUnixPort.h: hierarchy where tcl.h < tclPort.h < tclInt.h
+ * win/tclWinInt.h: and every C source file should #include
+ * win/tclWinPort.h: at most one of those files to satisfy its
+ declaration needs. tclWinInt.h and tclWinPort.h also better organized
+ so that tclWinPort.h includes the Windows implementation of
+ cross-platform declarations, while tclWinInt.h makes declarations that
+ are available on Windows only.
+
+ * generic/tclBinary.c (TCL_NO_MATH): Deleted the generic/tclMath.h
+ * generic/tclMath.h (removed): header file. The internal Tcl
+ * macosx/Makefile (PRIVATE_HEADERS): header, tclInt.h, has a
+ * win/tcl.dsp: #include <math.h> directly,
+ and file external to Tcl needing libm should do the same.
+
+ * win/Makefile.in (WIN_OBJS): Deleted the win/tclWinMtherr.c file.
+ * win/makefile.bc (TCLOBJS): It's a vestige from matherr() days
+ * win/makefile.vc (TCLOBJS): gone by.
+ * win/tcl.dsp:
+ * win/tclWinMtherr.c (removed):
+
+ End Patch 922727.
+
+ * tests/unixInit.test (unixInit-3.1): Default encoding on Darwin
+ systems is utf-8. Thanks to Steven Abner (tauvan). [Bug 928808]
+
+2004-04-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/cmdAH.test (cmdAH-18.2): Added constraint because
+ access(...,X_OK) is defined to be permitted to be meaningless when
+ running as root, and OSX exhibits this. [Bug 929892]
+
+2004-04-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:
+ * generic/tclInt.h: removed the macro TCL_ALIGN() from tclInt.h,
+ replaced by the static macro ALIGN() in tclCompile.c [Bug 926445]
+
+2004-04-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.h: removed redundant #ifdef _TCLINT [Bug 928415],
+ reported by tauvan.
+
+2004-04-02 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/tcltest.test: Corrected constraint typos: "nonRoot" ->
+ "notRoot". Thanks to Steven Abner (tauvan). [Bug 928353]
+
+2004-04-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Removed obsolete tclBlockTime* declarations. [Bug
+ 926454]
+
+2004-04-01 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: Fix to privately reported vfs bug with 'glob
+ -type d -dir . *' across a vfs boundary. No tests for this are
+ currently possible without effectively moving tclvfs into Tcl's test
+ suite.
+
+2004-03-31 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/msgcat.n: Clarified message catalog file encodings. [Bug 811457]
+ * library/msgcat/msgcat.tcl: Updated internals to make use of [dict]s
+ to store message catalog data and to use [source -encoding utf-8] to
+ access catalog files. Thanks to Michael Sclenker. [Patch 875055, RFE
+ 811459] Corrected [mcset] to be able to successfully set a translation
+ to the empty string. [mcset $loc $src {}] was incorrectly set the $loc
+ translation of $src back to $src. Also changed [ConvertLocale] to
+ minimally require a non-empty "language" part in the locale value. If
+ not, an error raised prompts [Init] to keep looking for a valid locale
+ value, or ultimately fall back on the "C" locale. [Bug 811461].
+ * library/msgcat/pkgIndex.tcl: Bump to msgcat 1.4.1.
+
+2004-03-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclHash.c (HashStringKey): Cleaned up. This function is not
+ faster, but it is a little bit clearer.
+ * generic/tclLiteral.c (HashString): Applied logic from HashObjKey.
+ * generic/tclObj.c (HashObjKey): Rewrote to fix fault which hashed
+ every single-character object to the same hash bucket. The new code is
+ shorter, simpler, clearer, and (happily) faster.
+
+2004-03-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TEBC): reverting to the previous method for
+ async tests in TEBC, as the new method turned out to be too costly.
+ Async tests now run every 64 instructions.
+
+2004-03-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: New instruction code INST_START_CMD that
+ * generic/tclCompile.h: allows checking the bytecode's validity
+ * generic/tclExecute.c: [Bug 729692] and the interp's readyness
+ * tests/interp.test (18.9): [Bug 495830] before running the command.
+ * tests/proc.test (7.1): It also changes the mechanics of the async
+ * tests/rename.test (6.1): tests in TEBC, doing it now at command
+ start instead of every 16 instructions.
+
+2004-03-30 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c: Fix to Windows glob where the pattern is a
+ * generic/tclIOUtil.c: volume relative path or a network share [Bug
+ * tests/fileName.test: 898238]. On windows 'glob' will now return
+ * tests/fileSystem.test: the results of 'glob /foo/bar' and 'glob
+ \\foo\\bar' as 'C:/foo/bar', i.e. a correct absolute path (rather than
+ a volume relative path).
+
+ Note that the test suite does not test commands like
+ 'glob //Machine/Shared/*' (on a network share).
+
+2004-03-30 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Fix to filename bugs recently
+ * tests/fileName.test: introduced [Bug 918320].
+
+2004-03-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclMain.c (Tcl_Main, StdinProc): Append newline only
+ * tests/basic.test (basic-46.1): to incomplete scripts
+ as part of multi-line script construction. Do not add an extra
+ trailing newline to the complete script. [Bug 833150]
+
+2004-03-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript): corrected possible segfault
+ when a compilation returns TCL_OUTLINE_COMPILE after having grown the
+ compile environment [Bug 925121].
+
+2004-03-27 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/array.n: added documentation for trace-realted behaviour of
+ 'array get' [Bug 449893]
+
+2004-03-26 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bumped version number to 8.5a2 to distinguish
+ * tools/tcl.wse.in: HEAD of CVS development from the recent 8.5a1
+ * unix/configure.in: release.
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.57
+ * win/configure:
+
+2004-03-26 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Fix to Windows-only volume relative path
+ * tests/fileSystem.test: normalization. [Bug 923568]. Also fixed
+ another volume relative bug found while testing.
+
+2004-03-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (NsEnsembleImplementationCmd): Fix messed up
+ handling of strncmp result which just happened to work in some libc
+ implementations. [Bug 922752]
+
+2004-03-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/StringObj.3: Inverted the sense of the documentation of how the
+ bytes parameter is documented to match behaviour. [Bug 921464]
+
+2004-03-19 Kevin B. Kenny <kennykb@acm.org>
+
+ * compat/strtoll.c:
+ * compat/strtoull.c:
+ * generic/tclIntDecls.h:
+ * generic/tclMain.c:
+ * generic/tclObj.c:
+ * win/tclWinDde.c:
+ * win/tclWinReg.c:
+ * win/tclWinTime.c: Made HEAD build on Windows VC++ again.
+
+2004-03-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclIntDecls.h: Made HEAD build on Solaris again by applying
+ fix recommended by Don Porter.
+
+2004-03-18 Reinhard Max <max@suse.de>
+
+ * generic/tclIntDecls.h: Removed TclpTime_t. It wasn't really needed,
+ * generic/tclInt.h: but caused warnings related to
+ * generic/tclInt.decls: strict aliasing with GCC 3.3.
+ * generic/tclClock.c:
+ * generic/tclDate.c:
+ * generic/tclGetDate.y:
+ * win/tclWinTime.c:
+ * unix/tclUnixTime.c:
+
+ * generic/tclNamesp.c: Added temporary pointer variables to work
+ * generic/tclStubLib.c: around warnings related to
+ * unix/tclUnixChan.c: strict aliasing with GCC 3.3.
+
+ * unix/tcl.m4: Removed -Wno-strict-aliasing.
+
+2004-03-18 Daniel Steffen <das@users.sourceforge.net>
+
+ Removed support for Mac OS Classic platform [Patch 918142]
+
+ * README:
+ * compat/string.h:
+ * doc/Encoding.3:
+ * doc/FileSystem.3:
+ * doc/Init.3:
+ * doc/Macintosh.3 (removed):
+ * doc/OpenFileChnl.3:
+ * doc/OpenTcp.3:
+ * doc/SourceRCFile.3:
+ * doc/Thread.3:
+ * doc/clock.n:
+ * doc/exec.n:
+ * doc/fconfigure.n:
+ * doc/file.n:
+ * doc/filename.n:
+ * doc/glob.n:
+ * doc/open.n:
+ * doc/puts.n:
+ * doc/resource.n (removed):
+ * doc/safe.n:
+ * doc/source.n:
+ * doc/tclvars.n:
+ * doc/unload.n:
+ * generic/README:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclAlloc.c:
+ * generic/tclBasic.c:
+ * generic/tclCmdAH.c:
+ * generic/tclDate.c:
+ * generic/tclDecls.h:
+ * generic/tclFCmd.c:
+ * generic/tclFileName.c:
+ * generic/tclGetDate.y:
+ * generic/tclIOCmd.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInitScript.h:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclMain.c:
+ * generic/tclMath.h:
+ * generic/tclNotify.c:
+ * generic/tclPathObj.c:
+ * generic/tclPlatDecls.h:
+ * generic/tclPort.h:
+ * generic/tclStubInit.c:
+ * generic/tclTest.c:
+ * generic/tclThreadJoin.c:
+ * library/auto.tcl:
+ * library/init.tcl:
+ * library/package.tcl:
+ * library/safe.tcl:
+ * library/tclIndex:
+ * mac/AppleScript.html (removed):
+ * mac/Background.doc (removed):
+ * mac/MW_TclAppleScriptHeader.h (removed):
+ * mac/MW_TclAppleScriptHeader.pch (removed):
+ * mac/MW_TclBuildLibHeader.h (removed):
+ * mac/MW_TclBuildLibHeader.pch (removed):
+ * mac/MW_TclHeader.h (removed):
+ * mac/MW_TclHeader.pch (removed):
+ * mac/MW_TclHeaderCommon.h (removed):
+ * mac/MW_TclStaticHeader.h (removed):
+ * mac/MW_TclStaticHeader.pch (removed):
+ * mac/MW_TclTestHeader.h (removed):
+ * mac/MW_TclTestHeader.pch (removed):
+ * mac/README (removed):
+ * mac/bugs.doc (removed):
+ * mac/libmoto.doc (removed):
+ * mac/morefiles.doc (removed):
+ * mac/porting.notes (removed):
+ * mac/tclMac.h (removed):
+ * mac/tclMacAETE.r (removed):
+ * mac/tclMacAlloc.c (removed):
+ * mac/tclMacAppInit.c (removed):
+ * mac/tclMacApplication.r (removed):
+ * mac/tclMacBOAAppInit.c (removed):
+ * mac/tclMacBOAMain.c (removed):
+ * mac/tclMacChan.c (removed):
+ * mac/tclMacCommonPch.h (removed):
+ * mac/tclMacDNR.c (removed):
+ * mac/tclMacEnv.c (removed):
+ * mac/tclMacExit.c (removed):
+ * mac/tclMacFCmd.c (removed):
+ * mac/tclMacFile.c (removed):
+ * mac/tclMacInit.c (removed):
+ * mac/tclMacInt.h (removed):
+ * mac/tclMacInterupt.c (removed):
+ * mac/tclMacLibrary.c (removed):
+ * mac/tclMacLibrary.r (removed):
+ * mac/tclMacLoad.c (removed):
+ * mac/tclMacMath.h (removed):
+ * mac/tclMacNotify.c (removed):
+ * mac/tclMacOSA.c (removed):
+ * mac/tclMacOSA.r (removed):
+ * mac/tclMacPanic.c (removed):
+ * mac/tclMacPkgConfig.c (removed):
+ * mac/tclMacPort.h (removed):
+ * mac/tclMacProjects.sea.hqx (removed):
+ * mac/tclMacResource.c (removed):
+ * mac/tclMacResource.r (removed):
+ * mac/tclMacSock.c (removed):
+ * mac/tclMacTclCode.r (removed):
+ * mac/tclMacTest.c (removed):
+ * mac/tclMacThrd.c (removed):
+ * mac/tclMacThrd.h (removed):
+ * mac/tclMacTime.c (removed):
+ * mac/tclMacUnix.c (removed):
+ * mac/tclMacUtil.c (removed):
+ * mac/tcltkMacBuildSupport.sea.hqx (removed):
+ * tests/all.tcl:
+ * tests/binary.test:
+ * tests/cmdAH.test:
+ * tests/cmdMZ.test:
+ * tests/fCmd.test:
+ * tests/fileName.test:
+ * tests/fileSystem.test:
+ * tests/interp.test:
+ * tests/io.test:
+ * tests/ioCmd.test:
+ * tests/load.test:
+ * tests/macFCmd.test (removed):
+ * tests/osa.test (removed):
+ * tests/resource.test (removed):
+ * tests/socket.test:
+ * tests/source.test:
+ * tests/unload.test:
+ * tools/cvtEOL.tcl (removed):
+ * tools/genStubs.tcl:
+ * unix/Makefile.in:
+ * unix/README:
+ * unix/mkLinks:
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/tcl.dsp:
+
+2004-03-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n: Improved examples on the advanced capabilities of
+ lsearch (with the right options, set element removal can be done)
+ following discussion on tkchat.
+
+2004-03-16 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/catch.n: Compiled [catch] no longer fails to catch syntax
+ errors. Removed the claims in the documentation that it does.
+ * doc/return.n: Updated example to use [dict merge].
+
+2004-03-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure, unix/tcl.m4: add -Wno-strict-aliasing for GCC to
+ suppress useless type puning warnings.
+
+2004-03-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/file.n: *roff formatting fix. [Bug 917171]
+
+2004-03-15 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinNotify.c: Fixed a mistake where the return value of
+ MsgWaitForMultipleObjectsEx for "a message is in the queue" wasn't
+ accurate. I removed the check on the case result==(WAIT_OBJECT_0 + 1)
+ This was having the error of falling into GetMessage and waiting there
+ by accident, which wasn't alertable through Tcl_AlertNotifier. I'll do
+ some more study on this and try to find-out why.
+
+2004-03-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ IMPLEMENTATION OF TIP#163
+ * generic/tclDictObj.c (DictMergeCmd): This is based on work by Joe
+ * tests/dict.test (dict-20.*): English in Tcl [FRQ 745851]
+ * doc/dict.n: but not exactly.
+
+2004-03-10 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclGetDate.y (TclGetDate): Fix so that [clock scan
+ <timeOfDay> -gmt true] uses the GMT base date instead of the local
+ one. [Bug 913513]
+ * tests/clock.test: Added test cases for wrong ISO8601 week number
+ [Bug 500285] and wrong GMT base date [Bug 913513]. Several tests still
+ fail on Windows, and these are actual faults in [clock scan]. Fix is
+ still pending.
+ * generic/tclDate.c: Regenerated.
+
+2004-03-08 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c: Fix to 'glob -path' near the root
+ * tests/fileName.test: of the filesystem. [Bug 910525]
+
+2004-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c (TclParseInit): Modified TclParseInit so
+ * generic/tclTest.c ([testexprparser]): that Tcl_Parse initialization
+ conforms to documented promised about what fields will not be
+ modified by what Tcl_Parse* routines. [Bug 910595]
+
+2004-03-05 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/configure: Regen.
+ * win/configure.in: Check for define of MWMO_ALERTABLE in winuser.h.
+ * win/tclWinPort.h: If MWMO_ALERTABLE is not defined in winuser.h then
+ define it. This is needed for Mingw.
+
+2004-03-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclTest.c: Modified TesteventObjCmd to use a
+ Tcl_QueuePosition in place of an 'int' for the enumerated queue
+ position, to avoid a compiler warning on SGI. [Bug 771960]
+
+2004-03-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/registry.test: Applied fix from [Patch 910174] to make the test
+ for an English-language system include any country code, rather than
+ just English-United States.1252. Thanks to Pat Thoyts for the changes.
+
+2004-03-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/registry.test: Applied fixed from [Bug 766159] to skip two
+ tests on Win98 that depend on a Unicode registry (NT specific).
+
+2004-03-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h (TclParseInit): Factored the common code
+ * generic/tclParse.c (TclParseInit): for initializing a Tcl_Parse
+ * generic/tclParseExpr.c: struct into one routine.
+
+2004-03-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/reg/pkgIndex.tcl: Added TIP #100 support to the
+ * win/tclWinReg.c: registry package [patch 903831]
+ This provides a Windows test of the TIP #100 mechanism and a sample to
+ show how unloading an extension can be done.
+
+2004-03-04 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/dltest/pkgua.c: Fix minor syntax problems. [Bug 909288]
+
+2004-03-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ *** 8.5a1 TAGGED FOR RELEASE ***
+
+ * changes: updated for 8.5a1
+
+2004-03-03 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: default environment variable for VC++ is %MSDevDir%
+ not %MSVCDir%, although vcvars32.bat sets both.
+
+ * win/tclWinNotify.c (Tcl_WaitForEvent) : Allows an idling notifier to
+ service "Asynchronous Procedure Calls" from its wait state. Only
+ useful for extension authors who decide they might want to try
+ "completion routines" with WriteFileEx(), as an example. From
+ experience, I recommend that "completion ports" should be used instead
+ as the execution of the callbacks are more managable.
+
+2004-03-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README: update patchlevel to 8.5a1
+ * generic/tcl.h:
+ * tools/tcl.wse.in, tools/tclSplash.bmp:
+ * unix/configure, unix/configure.in, unix/tcl.spec:
+ * win/README.binary, win/configure, win/configure.in:
+
+ * unix/tcl.m4: update HP-11 build libs setup
+
+2004-03-01 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow 64-bit enabling on
+ IRIX64-6.5* systems. [Bug 218561]
+ * unix/configure: autoconf-2.57
+
+ * generic/tclTrace.c (TclCheckInterpTraces): The TIP 62
+ * generic/tclTest.c (TestcmdtraceCmd): implementation introduced a
+ * tests/trace.test (trace-29.10): bug by testing the CallFrame
+ level instead of the iPtr->numLevels level when deciding what traces
+ created by Tcl_Create(Obj)Trace to call. Added test to expose the
+ error, and made fix. [FRQ 462580]
+
+2004-02-28 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * tests/fileSystem.test: fix to Tcl Bug 905163.
+ * tests/fileName.test: fix to Tcl Bug 904705.
+
+ * doc/{various}.n: removed 'the the' typos.
+
+2004-02-26 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Makefile: fixed copyright year in Tcl.framework Info.plist
+
+2004-02-25 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/basic.test: Made several tests more robust to the
+ * tests/cmdMZ.test: list-quoting of path names that might contain
+ * tests/exec.test: Tcl-special chars like { or [. Should help us
+ * tests/io.test: sort out [Bug 554068]
+ * tests/pid.test:
+ * tests/socket.test:
+ * tests/source.test:
+ * tests/unixInit.test:
+
+2004-02-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclLoad.c (Tcl_LoadObjCmd): Missing dereference caused
+ segfault with non-loadable extension. [Bug 904307]
+
+ * unix/tclUnixChan.c (TcpGetOptionProc): Stop memory leak with very
+ long hostnames. [Bug 888777]
+
+2004-02-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinDde.c: Removed some gcc warnings - except for the
+ -Wconversion warning for GetGlobalAtomName. gcc is just wrong about
+ this.
+
+2004-02-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ IMPLEMENTATION OF TIP#100 FROM GEORGIOS PETASIS
+ * generic/tclLoad.c (Tcl_UnloadObjCmd): Implementation.
+ * tests/unload.test: Test suite.
+ * unix/dltest/pkgua.c: Helper for test suite.
+ * doc/unload.n: Documentation.
+ Also assorted changes (mostly small) to several other files.
+
+2004-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/regc_locale.c (cclass): Buffer was having its size reset
+ instead of being released => memleak. [Bug 902562]
+
+2004-02-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclLoad.c (Tcl_LoadObjCmd): Fixed memory leak due to an
+ improper error exit route.
+
+2004-02-20 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinSock.c (SocketThreadExitHandler): Don't call
+ TerminateThread when WaitForSingleObject returns a timeout.
+ Tcl_Finalize called from DllMain will pause all threads. Trust that
+ the thread will get the close notice at a later time if it does ever
+ wake up before being cleaned up by the system anyway.
+
+2004-02-17 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/tcltest.n:
+ * library/tcltest/tcltest.tcl: Changed -verbose default value to
+ {body error} so that detailed information on unexpected errors in
+ tests is provided by default, even after the fix for [Bug 725253]
+
+2004-02-17 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/unixInit.test (unixInit-7.1):
+ * unix/tclUnixInit.c (TclpInitPlatform): ensure the std fds exist to
+ prevent crash condition [Bug 772288]
+
+2004-02-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Bozo mistake in memory
+ releasing order when in an error case. [Bug 898910]
+
+2004-02-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclTrace.c (TclTraceExecutionObjCmd)
+ (TclTraceCommandObjCmd): fix possible mem leak in trace info.
+
+2004-02-12 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/tclWinInit.c (AppendEnvironment): Use the tail component of the
+ passed in lib path instead of just blindly using lib+4. That worked
+ when lib was "lib/..." but fails for other values. Thanks go to
+ Patrick Samson for pointing this out.
+
+2004-02-10 David Gravereaux <davygrvy@pobox.com>
+
+ * win/nmakehlp.c: better macro grepping logic.
+
+2004-02-07 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc:
+ * win/rules.vc:
+ * win/tcl.rc:
+ * win/tclsh.rc: Added an 'unchecked' option to the OPTS macro so a
+ core built with symbols can be linked to the non-debug enabled C
+ run-time. As per discussion with Kevin Kenny. Called like this:
+
+ nmake -af makefile.vc OPTS=unchecked,symbols
+
+ This clarifies the meaning of the 'g' naming suffix to mean only that
+ the binary requires the debug enabled C run-time. Whether the binary
+ contains symbols or not is a different condition.
+
+2004-02-06 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/clock.n: Removed reference to non-existent [file ctime].
+
+2004-02-05 David Gravereaux <davygrvy@pobox.com>
+
+ * docs/tclvars.n: Added clarification of the tcl_platform(debug) var
+ that it only refers to the flavor of the C run-time, and not whether
+ the core contains symbols.
+
+2004-02-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileName.c (SkipToChar): Corrected CONST and type-casting
+ issues that caused compiler warnings.
+
+2004-02-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c (StoreStatData): Removed improper refcount
+ decrement of the varName parameter. This error was causing segfaults
+ following test cmdAH-28.7.
+
+ * library/tcltest/tcltest.tcl: Corrected references to non-existent
+ $name variable in [cleanupTests]. [Bug 833637]
+
+2004-02-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Corrected parsing of single command
+ line argument (option with missing value) [Bug 833910]
+ * library/tcltest/pkgIndex.tcl: Bump to version 2.2.5.
+
+2004-02-02 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclIO.c (Tcl_Ungets): Fixes improper filling of the channel
+ buffer. This is the buffer before the splice. [Bug 405995]
+
+2004-02-01 David Gravereaux <davygrvy@pobox.com>
+
+ * tests/winPipe.test: more pass-thru commandline verifications.
+ * win/tclWinPipe.c (BuildCommandLine): Special case quoting for '{'
+ not required by the c-runtimes's parse_cmdline().
+ * win/tclAppInit.c: Removed our custom setargv() in favor of the work
+ provided by the c-runtime. [Bug 672938]
+
+ * win/nmakehlp.c: defensive techniques to avoid static buffer
+ overflows and a couple envars upsetting invokations of cl.exe and
+ link.exe. [Bug 885537]
+
+ * tests/winPipe.test: Added proof that BuildCommandLine() is not doing
+ the "N backslashes followed a quote -> insert N * 2 + 1 backslashes
+ then a quote" rule needed for the crt's parse_cmdline().
+ * win/tclWinPipe.c: Fixed BuildCommandLine() to pass the new cases.
+
+2004-01-30 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Use the -GZ compiler switch when building for
+ symbols. This is supposed to emulate the release build better to avoid
+ hiding problems that only show themselves in a release build.
+
+2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix to [Bug 883143] in file normalization
+
+2004-01-29 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/file.n:
+ * generic/tclFCmd.c
+ * generic/tclTest.c
+ * library/init.tcl
+ * mac/tclMacFile.c
+ * tests/fileSystem.test: fix to [Bug 886352] where 'file copy -force'
+ had inconsistent behaviour wrt target files with insufficient
+ permissions, particular from vfs->native fs. Behaviour of '-force' is
+ now always consistent (and now consistent with behaviour of 'file
+ delete -force'). Added new tests and documentation and cleaned up the
+ 'simplefs' test filesystem.
+
+ * generic/tclIOUtil.c
+ * unix/tclUnixFCmd.c
+ * unix/tclUnixFile.c
+ * win/tclWinFile.c: made native filesystems more robust to C code
+ which asks for mount lists.
+
+ * generic/tclPathObj.c: fix to [Bug 886607] removing warning/error
+ with some compilers.
+
+2004-01-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclObj.c (SetBooleanFromAny): Rewrite to do more efficient
+ string->bool conversion.
+ Many other minor whitespace/style fixes to this file too.
+
+2004-01-27 David Gravereaux <davygrvy@pobox.com>
+
+ * win/nmakehlp.c: Use '.\nul' as the sourcefile name instead of 'nul'
+ so VC 5.2 doesn't try searching the path for it and failing with a
+ possible dialogbox popping up about having to add a CD to an empty
+ drive. Also added a SetErrorMode() call to disable any dialogs that
+ cl.exe or link.exe might create. [Bug 885537]
+
+2004-01-22 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/file.n: clarified documentation of 'file system' [Bug 883825]
+ * tests/fCmd.test: improved test result in failure case.
+
+2004-01-22 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * tests/fileSystem.test: 3 new tests
+ * generic/tclPathObj.c: fix to [Bug 879555] in file normalization.
+ * doc/filename.n: small clarification to Windows behaviour with
+ filenames like '.....', 'a.....', '.....a'.
+
+ * generic/tclIOUtil.c: slight improvement to native cwd caching on
+ Windows.
+
+2004-01-21 David Gravereaux <davygrvy@pobox.com>
+
+ * doc/Panic.3: Mentions of 'panic' and 'panicVA' removed from the
+ documentation.
+
+2004-01-21 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * doc/FileSystem.3:
+ * generic/tcl.decls:
+ * generic/tclCmdAH.c
+ * generic/tclDecls.h
+ * generic/tclFCmd.c
+ * generic/tclFileName.c
+ * generic/tclFileSystem.h
+ * generic/tclIOUtil.c
+ * generic/tclInt.decls
+ * generic/tclInt.h
+ * generic/tclIntDecls.h
+ * generic/tclPathObj.c
+ * generic/tclStubInit.c
+ * generic/tclTest.c
+ * mac/tclMacFile.c
+ * tests/fileName.test
+ * tests/fileSystem.test
+ * tests/winFCmd.test
+ * unix/tclUnixFile.c
+ * win/tclWin32Dll.c
+ * win/tclWinFCmd.c
+ * win/tclWinFile.c
+ * win/tclWinInt.h
+
+ Three main issues accomplished: (1) cleaned up variable names in the
+ filesystem code so that 'pathPtr' is used throughout. (2) applied a
+ round of filesystem optimisation with better handling and caching of
+ relative and absolute paths, requiring fewer conversions. (3)
+ clarifications to the documentation, particularly regarding the
+ acceptable refCounts of objects. Some new tests added. Tcl benchmarks
+ show a significant improvement over 8.4.5, and on Windows typically a
+ small improvement over 8.3.5 (Unix still appears to require
+ optimisation). TCL_FILESYSTEM_VERSION_2 introduced, but for internal
+ use only. There should be no public incompatibilities from these
+ changes. Thanks to dgp for extensive testing.
+
+2004-01-19 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem with
+ the process list. The delayed cut operation after the wait was going
+ stale by being outside the list lock. It now cuts within the lock and
+ does a locked splice for when it needs to instead. [Bug 859820]
+
+2004-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompile.c, generic/tclCompile.h: Two new opcodes,
+ INST_LIST_INDEX_IMM and INST_LIST_RANGE_IMM, that have operand(s) of
+ new type OPERAND_IDX4 which represents indexes into things like lists
+ (and perhaps other things eventually.)
+ * generic/tclExecute.c (TclExecuteByteCode): Implementation of the new
+ opcodes. INST_LIST_INDEX_IMM does a simple [lindex] with either front-
+ or end-based simple indexing. INST_LIST_RANGE_IMM does an [lrange]
+ with front- or end-based simple indexing for both the reference to the
+ first and last items in the range.
+ * generic/tclCompCmds.c (TclCompileLassignCmd): Generate bytecode for
+ the [lassign] command.
+
+2004-01-17 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinInit.c: added #pragma comment(lib, "advapi32.lib") when
+ compiling under VC++ so we don't need to specify it when linking.
+
+2004-01-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Add more shimmering
+ protection for when the list is also one of the variables.
+
+ BASIC IMPLEMENTATION OF TIP#57
+ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Implementation of the
+ [lassign] command that takes full advantage of Tcl's object API.
+ * doc/lassign.n: New file documenting the command.
+ * tests/cmdIL.test (cmdIL-6.*): Test suite for the command.
+
+2004-01-15 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinReg.c: Placed the requirement for advapi.lib into the
+ object file itself with #pragma comment (lib, ...) when built with
+ VC++. This will simplify linking for users of the static library.
+
+ * win/rules.vc: Added new 'fullwarn' to the CHECKS commandline macro;
+ sets $(FULLWARNINGS).
+
+ * win/makefile.vc: Removed 'advapi.lib' from $(baselibs). Added new
+ logic to crank-up the warning levels for both compile and link when
+ $(FULLWARNINGS) is set. Some clean-up with how the resource files are
+ built and how -DTCL_USE_STATIC_PACKAGES is sent when compiling the
+ shells.
+
+ * win/tclAppInit.c: Small change in how TCL_USE_STATIC_PACKAGES is
+ used.
+
+ * win/tcl.rc:
+ * win/tclsh.rc: Some clean-up with how the resource files are built.
+ Fixed 'OriginalFilename' problem that still thought a debug suffix was
+ still 'd', now is 'g'.
+
+2004-01-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted
+ behaviour of [dict exists] so a failure to look up a dictionary along
+ the path of dicts doesn't trigger an error. This is how it was
+ documented to behave previously... [Bug 871387]
+
+ * generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth relating
+ to [Bug 876170].
+ (SetDictFromAny): Make sure that lists retain their ordering even when
+ converted to dictionaries and back.
+ (TraceDictPath): Correct object reference count handling!
+ (DictReplaceCmd, DictRemoveCmd): Stop object leak.
+ (DictIncrCmd,DictLappendCmd,DictAppendCmd,DictSetCmd,DictUnsetCmd):
+ Simpler handling of reference counts when assigning to variables.
+ * tests/dict.test (dict-19.2): Memory leak stress test
+
+2004-01-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Silence compiler warnings.
+
+ Patch 876451: restores performance of [return]. Also allows forms such
+ as [return -code error $msg] to be bytecompiled.
+
+ * generic/tclInt.h: Factored Tcl_ReturnObjCmd() into two pieces:
+ * generic/tclCmdMZ.c: TclMergeReturnOptions(), which can parse the
+ options to [return], check their validity, and create the
+ corresponding return options dictionary, and TclProcessReturn(), which
+ takes that return options dictionary and performs the [return]
+ operation.
+
+ * generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to call
+ TclMergeReturnOptions() at compile time so the return options
+ dictionary is computed at compile time (when it is fully known). The
+ dictionary is pushed on the stack along with the result, and the code
+ and level values are included in the bytecode as operands. Also
+ supports optimized compilation of un-[catch]ed [return]s from procs
+ with default options into the INST_DONE instruction.
+
+ * generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve
+ the code and level operands, pop the return options from the stack,
+ and call TclProcessReturn() to perform the [return] operation.
+
+ * generic/tclCompile.h: New utilities include TclEmitInt4 macro
+ * generic/tclCompile.c: and TclWordKnownAtCompileTime().
+
+ End Patch 876451.
+
+ * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to management
+ of the interp result by Tcl_GetIndexFromObj() exposed improper interp
+ result management in the [glob] command procedure. Corrected by
+ adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. This stopped
+ a segfault in test filename-11.36. [Bug 877677]
+
+2004-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs):
+ Create fresh objects instead of using the one currently in the
+ interpreter, which isn't guaranteed to be fresh and unshared. The cost
+ for the core will be minimal because of the object cache, and this
+ fixes [Bug 875395].
+
+2004-01-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompExpr.c (CompileLandOrLorExpr): cosmetic changes.
+
+2004-01-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer
+ instructions. As a side effect, the instructions INST_LOR and
+ INST_LAND are now never used.
+ * generic/tclExecute.c (INST_JUMP*): small optimisation; fix a bug in
+ debug code.
+
+2004-01-11 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be dereferenced
+ to see if there are waiters else uninitialized datum is manipulated.
+ [Bug 849007 789338 745068]
+
+2004-01-09 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tcl.h: Renamed and deprecated #defines moved to within the
+ #ifndef TCL_NO_DEPRECATED block. This allows us to build Tcl to check
+ for deprecated functions in use, such as panic() and Tcl_Ckalloc(). By
+ request from DKF. Extensions that build with -DTCL_NO_DEPRECATED now
+ have these macros as restricted.
+ ***POTENTIAL INCOMPATIBILITY***
+
+ * win/makefile.vc:
+ * win/rules.vc: Added -DTCL_NO_DEPRECATED usage to makefile.vc.
+ Called like this: nmake -af makefile.vc CHECKS=nodep
+
+2004-01-09 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: fix to infinite loop in TclFinalizeFilesystem
+ [Bug 873311]
+
+ ******************************************************************
+ *** 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.2005 b/ChangeLog.2005
new file mode 100644
index 0000000..0d1d7cf
--- /dev/null
+++ b/ChangeLog.2005
@@ -0,0 +1,3822 @@
+2005-12-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStubLib.c: Corrected a typo in "missing Stubs table
+ pointer."
+
+2005-12-27 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tcl.decls: Destubbed TclTomMathInitializeStubs - it is in
+ * generic/tcl.h: the stub library, not the main shared
+ * generic/tclBasic.c: library. Exported Tcl_InitBignumFromDouble.
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclStrToD.c:
+
+ * generic/tclDecls.h:
+ * generic/tclStubLib.c:
+ * generic/tclStubInit.c: Regenerated.
+
+ * generic/clock.tcl: Reverted to using the time zone abbreviation and
+ not its name to "stop the bleeding" on [Bug 1386377]. This is *not* a
+ good long-term solution, but there may not be one.
+
+ * libtommath/bn_mp_sqrt.c: Improved the initial approximation to the
+ square root, roughly doubling the speed of the routine. (This is a
+ local change that needs to be communicated to Tom.)
+
+ * win/Makefile.in: Corrected a bug where tommath_class.h and
+ tommath_superclass.h were not installed, making it impossible for
+ client code to compile against the tommath stubs.
+
+ * library/tzdata: Updated to Olson's tzdata2005r. (Latest changes to
+ Daylight Saving Time in Canada, plus redefinition of the Posix-style
+ zones [e.g., EST5EDT] to be locale-independent.)
+
+ * libtommath: Updated to Tom St.Denis's release 0.37.
+
+2005-12-20 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Format values as longs
+ and not ints, so they are less likely to wrap on 64-bit machines.
+
+2005-12-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: Modified [string is double] to use
+ * tests/string.test: TclParseNumber() to parse trailing whitespace.
+ Ensures consistency, and makes it easier to cleanup after invalid
+ internal reps left behind by parsing [Bugs 1360532 1382287].
+
+ * generic/tclParseExpr.c: Added TCL_PARSE_NO_WHITESPACE to
+ * generic/tclScan.c: TclParseNumber() calls since [scan] and [expr]
+ * tests/scan.test: parsing don't want spaces in parsed numbers.
+
+ * generic/tclInt.h: Added TCL_PARSE_NO_WHITESPACE flag to the
+ * generic/tclStrToD.c: TclParseNumber() interface.
+
+2005-12-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/Tcl.n: Clarify what is going on in variable substitution
+ following thread on comp.lang.tcl.
+
+2005-12-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileDictCmd): Ensure that we only do an
+ 'endCatch' when there's a preceding 'beginCatch'. [Bug 1382528] Many
+ thanks to Anton Kovalenko for finding this and pointing out that it was
+ a catch stack handling problem!
+
+2005-12-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: workaround gcc warning "comparison is always
+ * generic/tclTest.c: false due to limited range of data type".
+
+ * macosx/Tcl.xcode/project.pbxproj:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+ * unix/Makefile.in: add new tclTomMath* files.
+
+ * generic/tclBasic.c: replace panic with Tcl_Panic.
+
+2005-12-13 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tcl.decls: Added changes to export an additional stubs
+ * generic/tclBasic.c: table to represent the 'libtommath' routines
+ * generic/tclDecls.h: that Tcl uses and export them to callers.
+ * generic/tclInt.decls: Reran 'genstubs'
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c:
+ * generic/tclTomMath.decls:
+ * generic/tclTomMath.h:
+ * generic/tclTomMathDecls.h:
+ * generic/tclTomMathInterface.c:
+ * generic/tommath.h:
+ * tools/fix_tommath_h.tcl:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+ * generic/tclClock.c: Made changes to silence a number of compiler
+ * generic/tclIO.c: warnings when building with mingw.
+ * generic/tclIORChan.c:
+ * generic/tclLink.c:
+ * generic/tclListObj.c:
+ * generic/tclObj.c:
+ * generic/tclParseExpr.c:
+ * generic/tclProc.c:
+ * generic/tclTimer.c:
+ * win/tclWinChan.c:
+ * win/tclWinConsole.c:
+ * win/tclWinDde.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+ * win/tclWinReg.c:
+ * win/tclWinSock.c:
+
+2005-12-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclExecute.c (TEBC:DICT_FIRST,DICT_DONE): Only decrease the
+ references to the dictionary once the iteration completes. Do this by
+ storing the dict in the iterator context variable. [Bug 1379349] Thanks
+ to Ulrich Ring and Tobias Hippler for finding this.
+
+2005-12-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tcl.m4, unix/configure: Fix sh quoting error reported in
+ bash-3.1+ [Bug 1377619] (schafer)
+
+2005-12-12 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/mathfunc.n: Changed two examples from the incorrect 'tcl::math::'
+ to 'tcl::mathfunc::' [Bug 1378818]
+
+2005-12-09 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Define MACHINE for gcc builds. The
+ lack of a definition of this variable in the manifest file was causing
+ a runtime error in wish built with gcc.
+
+2005-12-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/lsearch.test (lsearch-10.8..10): If the -start is off the end,
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): searching should find nothing
+ at all. [Bug 1374778]
+
+2005-12-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/Makefile.in, win/makefile.vc: Add Win x64 and CE build support
+ * win/tcl.m4, win/configure: CE still requires C code fixes.
+
+ * generic/tcl.h: use struct __stat64 (not _stat64) for MSC_VER >= 1400
+ (i.e. latest Platform SDK).
+
+2005-12-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/socket.n: Cross-referenced the socket documentation better to the
+ fconfigure documentation on the topic of asynch sockets.
+ * doc/fconfigure.n: Added keyword to documentation of -blocking option
+ so that people looking for "asynch" can find it as well.
+
+2005-12-05 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixPort.h (Darwin): fix incorrect __DARWIN_UNIX03 configure
+ overrides that were originally copied from Darwin CVS (rdar://3693001)
+
+2005-12-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * tools/tclZIC.tcl: Updated to reflect changes in calling sequence when
+ GetJulianDateFromEraYearMonthDay moved to C.
+ * library/tzdata: Regenerated from Olson's tzdata2005p.tar.gz - the
+ 'systemv' changes appear not to affect Tcl's processing of the dates.
+
+2005-12-05 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/configure.in: move check for fts API to configure.in and run it
+ * unix/tcl.m4: on all platforms, since Linux glibc2 and *BSDs
+ also have this; using fts is more efficient than a recursive
+ opendir/readdir.
+ * unix/tclUnixFCmd.c (TraverseUnixTree): add support to fts code for
+ platforms with stat64.
+ * unix/configure:
+ * unix/tclConfig.h.in: regen.
+
+2005-12-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure: Use fts file API on Darwin if available.
+ * unix/tcl.m4: Addresses file delete issues in readdir noted
+ * unix/tclUnixFCmd.c: in [Bug 1034337]. (steffen)
+ Remove redundant stat call for each file in DoCopyFile. (steffen)
+
+2005-12-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c: Moved a tiny bit more of [clock format] from run
+ * library/clock.tcl: time to compile time, and fixed a l10n bug in the
+ process. [Bug 1371446]. Also, conditoned the call to SetupTimeZone to
+ speed the common case where TZData($timezone) already exists, and
+ achieved a puny speedup by making ::tcl::clock::getenv not throw
+ errors.
+ * unix/Makefile.in: Made some changes to support a 'make' command that
+ is present on some antiquated versions of Solaris.
+
+2005-12-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Continued rationalizing the code, eliminating
+ numerous redundant [mc] calls. Added another time boost by precompiling
+ a [::format] command to do the bulk of the work of [clock format].
+
+2005-12-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/Makefile.in: Add remaining dependency info. While automated
+ maintenance of this information would be good, having it at all is much
+ better than a poke in the eye with a sharp stick...
+
+2005-12-01 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclClock.c: fix warning.
+
+ * unix/tcl.m4 (Darwin): fix error when MACOSX_DEPLOYMENT_TARGET unset
+ * unix/configure: regen.
+
+2005-11-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/Makefile.in: Add dependency information relating to tclCompile.h
+ since when the list of opcodes changes it is usually useful to rebuild
+ everything that depends on it (but which is nonetheless a small
+ fraction of the total set of Tcl source files).
+
+ ***POTENTIAL INCOMPATIBILITY*** for bytecode savers/loaders. See below
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Arrange for very simple
+ [switch] invokations to be compiled into hash lookups into jump tables;
+ only a very specific kind of [switch] can be safely compiled this way,
+ but that happens to be the most common kind. This makes around 5-10%
+ difference to the speed of execution of clock.test.
+ * generic/tclExecute.c (TEBC:INST_JUMP_TABLE): New instruction to allow
+ for jumps to locations looked up in a hashtable. Requires a new AuxData
+ type, tclJumptableInfoType (supported by the functions DupJumptableInfo
+ and FreeJumptableInfo in tclCompCmds.c) so anything that saves bytecode
+ containing this *must* be updated!
+
+2005-11-30 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c: Fixed a bad refcount in previous commit that led
+ to a corrupted heap. Also silenced a warning that some compilers gave
+ about the excessively long constant for JULIAN_SEC_POSIX_EPOCH. Also
+ fixed a bug where [clock format] would fail in the :localtime zone for
+ times before the Posix Epoch. Thanks to Miguel Sofer for pointing out
+ all of these. Also rationalized the code a little bit by moving parts
+ of [clock scan] into C, eliminating some code that was duplicated in
+ the C and Tcl layers.
+
+2005-11-29 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclBasic.c: Moved a big part of [clock format] down
+ * generic/tclClock.c: to the C level in order to make it go faster.
+ * generic/tclInt.h: Preliminary measurements suggest that it
+ * generic/clock.tcl: more than doubles in speed with this change.
+
+2005-11-29 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Allow [lsearch -regexp] to
+ process REs that contain backreferences. This expensive mode of
+ operation is only used if the RE would otherwise cause a compilation
+ failure. [Bug 1366683]
+
+2005-11-28 Kevin Kenny <kennykb@acm.org>
+
+ * tools/tclZIC.tcl (convertTimeOfDay): Corrected a typo that caused
+ wrong DST transitions in any time zone where the transition is
+ specified as local Standard Time (as opposed to wall-clock or UTC).
+ (Also updated the code to be bignum-safe.)
+ * tests/clock.test (clock-51.1): Added regression test for the above.
+ * library/tzdata: Updated to Olson's 'tzdata2005o' (changes for Cuba,
+ Nicaragua, Jordan, and Georgia) and regenerated. Thanks to Paul
+ Mackerras for reporting this problem.
+
+2005-11-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(),
+ add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to
+ configure (flag can't be present twice, so can't be in both CFLAGS and
+ LDFLAGS during configure), don't use -prebind when deploying on 10.4,
+ define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542).
+ (SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete
+ autoconf macros. Sync with tk/unix/tcl.m4.
+
+ * unix/configure.in: fix obsolete autoconf macros, sync gratuitous
+ formatting/ordering differences with tk/unix/configure.in.
+
+ * unix/Makefile.in: add CFLAGS to tclsh/tcltest link to make executable
+ linking the same as during configure (needed to avoid losing any linker
+ relevant flags in CFLAGS, in particular flags that cannot be in
+ LDFLAGS). Avoid concurrent linking of tclsh and compiling of
+ tclTestInit.o or xtTestInit.o during parallel make.
+ (checkstubs, checkdoc, checkexports): dependency and Darwin fixes
+ (dist): add new macosx files.
+
+ * unix/tclLoadDyld.c (TclpDlopen): use NSADDIMAGE_OPTION_WITH_SEARCHING
+ on second NSAddImage only. [Bug 1204237]
+ (TclGuessPackageName): should not be MODULE_SCOPE.
+ (TclpLoadMemory): ppc64 and endian (i386) fixes, add support for
+ loading universal (fat) bundles from memory.
+
+ * unix/tclUnixFCmd.c:
+ * macosx/tclMacOSXFCmd.c: ppc64 and endian (i386) fixes.
+ (TclMacOSXCopyFileAttributes): add support for new Tiger copyfile() API
+ to enable copying of xattrs & ACLs by [file copy].
+
+ * generic/tcl.h: add Darwin specifc configure overrides for TCL_WIDE
+ defines to support fat compiles of ppc and ppc64 at the same time,
+ (replaces Darwin CVS fix by emoy, rdar://3693001). add/correct location
+ of version numbers in macosx files.
+
+ * generic/tclInt.h: clarify fat compile comment.
+
+ * unix/tclUnixPort.h: add Darwin specifc configure overrides to support
+ fat compiles, where configure runs only once for multiple architectures
+ (replaces Darwin CVS fix by emoy, rdar://3693001).
+
+ * macosx/tclMacOSXBundle.c:
+ * macosx/tclMacOSXNotify.c:
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixPort.h: fix #include order to support compile time
+ override of HAVE_COREFOUNDATION in tclUnixPort.h when building for
+ ppc64
+
+ * macosx/Tcl.pbproj/default.pbxuser (new file):
+ * macosx/Tcl.pbproj/jingham.pbxuser:
+ * macosx/Tcl.pbproj/project.pbxproj:
+ * macosx/Tcl.xcode/default.pbxuser (new file):
+ * macosx/Tcl.xcode/project.pbxproj (new file):
+ * macosx/Tcl.xcodeproj/default.pbxuser (new file):
+ * macosx/Tcl.xcodeproj/project.pbxproj (new file): new/updated
+ projects for Xcode 2.2 on 10.4, Xcode 1.5 on 10.3 & ProjectBuilder on
+ 10.2, with native tcltest targets and support for universal (fat)
+ compiles.
+
+ * macosx/README: clarification/cleanup, document new Xcode projects and
+ universal (fat) builds via CFLAGS (i.e. all of ppc ppc64 i386 at once).
+
+ * unix/Makefile.in:
+ * unix/aclocal.m4:
+ * unix/configure.in:
+ * unix/dltest/Makefile.in:
+ * macosx/configure.ac (new file): add support for inclusion of
+ unix/configure.in by macosx/configure.ac, allows generation of a config
+ headers enabled configure script in macosx (required by Xcode
+ projects).
+
+ * macosx/GNUmakefile: rename from Makefile to avoid overwriting by
+ configure run in tcl/macosx, add support for reusing configure cache,
+ build target fixes, remove GENERIC_FLAGS override now handled by
+ tcl.m4.
+
+ * generic/tcl.decls: add Tcl_Main declaration as comment to avoid
+ 'checkstubs' target complaining about it missing from stubs.
+
+ * generic/regex.h:
+ * generic/tclDate.c:
+ * generic/tclEnv.c:
+ * generic/tclGetDate.y:
+ * generic/tclIOUtil.c:
+ * generic/tclObj.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c:
+ * generic/tclPathObj.c:
+ * generic/tclThreadAlloc.c:
+ * generic/tclThreadStorage.c:
+ * generic/tclTrace.c:
+ * generic/tclVar.c:
+ * generic/tommath.h:
+ * tools/fix_tommath_h.tcl:
+ * unix/tclUnixFCmd.c: ensure externally visible symbols not contained
+ in stubs table are declared as MODULE_SCOPE (or as static if not used
+ outside of own source file). These changes allow 'make checkstubs' to
+ complete without error on Darwin with gcc 4.
+
+ * generic/rege_dfa.c (getvacant):
+ * generic/regexec.c (cfind):
+ * generic/tclCompExpr.c (CompileSubExpr):
+ * generic/tclNamesp.c (NamespaceEnsembleCmd):
+ * unix/tclUnixChan.c (TclUnixWaitForFile): initialise variables to
+ silence gcc 4 warnings.
+
+ * generic/tclExecute.c (TclExecuteByteCode): fix unused variable
+ warning when NO_WIDE_TYPE is defined.
+
+ * generic/regguts.h: only #define NDEBUG if not already #defined.
+
+ * unix/tclUnixNotfy.c:
+ * macosx/tclMacOSXNotify.c: sync whitespace & comments.
+
+ * unix/tclUnixPort.h:
+ * win/tclWinPort.h: remove declaration of obsolete&unused TclpMutex
+ API.
+
+ * unix/configure:
+ * unix/tclConfig.h.in: regen.
+
+2005-11-21 Andreas Kupries <andreask@activestate.com>
+
+ * unix/Makefile.in (install-libraries): Updated Makefile to new
+ * win/Makefile.in (install-libraries): version of the http package.
+ This fixes the ifneeded/provide mismatch reported when trying to
+ require http. Should we maybe try to automatically extract the version
+ number from the http code to prevent future breakage ?
+
+ This follows the update of the version number by dgp on Nov 15 (No
+ entry found in the ChangeLog).
+
+2005-11-20 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclStubLib.c: Don't set tclStubsPtr to 0 when
+ Tcl_PkgRequireEx() fails [Fix for [Bug 1091431] "Tcl_InitStubs failure
+ crashes wish"]
+
+2005-11-18 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/trace.test (trace-34.5): [Bug 1047286], added a second test
+ illustrating the role of "ns in callStack" in the ns's visibility
+ during deletion traces.
+
+2005-11-18 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n: Restored several missing lines near the %w format group
+ so that %w and %W are documented with their actual behaviour. [Bug
+ 1359183]
+
+2005-11-18 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclIO.c (TclFinalizeIOSubsystem): preserve statePtr until we
+ retrieve the next statePtr from it.
+
+2005-11-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclObj.c (GetBignumFromObj): replace NULL with
+ tclEmptyStringRep to stop memcpy from complaining in a debug build
+ (the corresponding branch is eliminated by the optimiser otherwise).
+
+2005-11-18 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' patch
+ for [Bug 1359094]. This moves the retrieval of the next channel state
+ to the end of the loop, as the called closeproc may close other
+ channels, i.e. modify the list we are iterating, invalidating any
+ pointer retrieved earlier.
+
+2005-11-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c: Restored the SetListFromAny routine to the
+ * generic/tclObj.c: "list" Tcl_ObjType, and restored the
+ Tcl_RegisterObjType() call for "list". This addresses the needs of some
+ "bridge" extensions to examine whether the Tcl_ObjType of a Tcl_Obj is
+ that of the "list" Tcl_ObjType.
+
+2005-11-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * library/http/http.tcl (http::geturl): Improved syntactic validation
+ of URLs, and better error messages in some cases. [Bug 1358369]
+
+2005-11-17 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/namespace.test: fix comment
+
+2005-11-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStrToD.c: More data in the "can't happen" Tcl_Panic to
+ aid debugging.
+
+ * generic/tclBasic.c (CallCommandTraces): Save/restore the interp
+ result during traces to fix [Bug 1355342].
+
+2005-11-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * tests/namespace.test: fix for [Bug 1354540] and [Bug 1355942]. The
+ new tests 7.3-6 and the modified 51.13 fail due to the unrelated [Bug
+ 1355342]
+
+ * tests/trace.test: added tests 20.13-16 for [Bug 1355342]
+
+2005-11-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken):
+ * generic/tclObj.c (Tcl_GetCommandFromObj): more partial fixes for
+ [Bug 1354540] - making sure that cached references to a command being
+ deleted cannot be made reusable by a delete trace.
+
+2005-11-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_FindCommand): Do not find commands in dead
+ namespaces on the path. Partial fix for [Bug 1354540].
+
+2005-11-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Revised TclParseNumber interface to enable
+ * generic/tclScan.c: revision to the [scan] command implementation
+ * generic/tclStrToD.c: to permit tests scan-4.44,55 to pass again.
+ [Bug 1348067].
+
+2005-11-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken):
+ * generic/tclObj.c (Tcl_GetCommandFromObj): bump the cmd epoch early
+ to insure that cached references to this command are invalidated.
+ Partial fix for [Bug 1352734] - at least insures that namespace-51.13
+ does not cause a panic. The test is still marked as knownbug, pending
+ resolution of what is actually the correct return value ([Bug
+ 1354540])
+
+2005-11-09 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclTimer.c: Changed [after] so that it behaves correctly
+ * tests/timer.test: with negative arguments [Bug 1350293] and
+ arguments that overflow a 32-bit word. [Bug 1350291]
+
+2005-11-08 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/compile.test: Updated tests with changed behavior
+ * tests/execute.test: due to addition of bignums.
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/parseExpr.test:
+ * tests/platform.test:
+ * tests/string.test:
+
+2005-11-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixFCmd.c (MAX_READDIR_UNLINK_THRESHOLD): reduce to 130
+ based on errors seen on OS X 10.3 with lots of links in a dir.
+ [Bug 1034337 followup]
+
+2005-11-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/Makefile.in (gdb-test): Added a new target to make it easier to
+ run the test suite inside a debugger.
+
+2005-11-08 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/compExpr-old.test: Updated tests with changed behavior due
+ to addition of bignums.
+
+ * tests/expr.test: Portable tests expr-46.13-18 [Bug 1341368]
+
+ * generic/tclPkg.c: Corrected inconsistencies in the value returned
+ * tests/pkg.test: by Tcl_PkgRequire(Ex) so that the returned
+ values will always agree with what is stored in the package database.
+ This way repeated calls to Tcl_PkgRequire(Ex) have the same results.
+ Thanks to Hemang Lavana. [Bug 1162286].
+
+2005-11-08 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclTrace.c (TraceVarEx): Factor out heart of Tcl_TraceVar2
+ (TclTraceVariableObjCmd,TraceVarProc): Use the new internal API to
+ arrange for the clientData to be cleaned up at the same time as the
+ rest of the main trace record. This simplifies the code a bit at the
+ same time.
+
+2005-11-07 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug
+ 1348775]. The recently added trace-8.9 test is now 13.4.
+
+2005-11-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/dict.test (dict-19.2): arrange for the stress testing code to
+ only stress test the dict code and not the trace code as well. [Bug
+ 1342858]
+
+2005-11-05 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/trace.test (trace-8.9): added test to detect leak, see [Bug
+ 1348775].
+
+2005-11-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinPort.h: Applied [Patch 1267871] by Matt Newman for
+ * win/tclWinPipe.c: extended error code support on Windows.
+ * tests/exec.test: Tests for extended error codes.
+ * generic/tclPipe.c: Permit long codes (platform macros permitting).
+
+2005-11-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBinary.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * generic/tclIOCmd.c:
+ * generic/tclLink.c:
+ * generic/tclTest.c:
+ * generic/tclVar.c: fix for [Bug 1334947]. The functions TclPtrSetVar,
+ Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume the newValuePtr
+ argument - i.e., they will free a 0-refCount object if they failed to
+ set the variable. Fixed all callers in the core.
+
+2005-11-04 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclGetDate.y: Added abbreviations for the Korean
+ * library/clock.tcl: timezone. [Patch 1298737]
+ * generic/tclDate.c: Regenerated.
+
+ * tools/findBadExternals.tcl: Added this script, which locates external
+ symbols that do not begin with 'Tcl' or 'tcl' and hence might be in
+ conflict with other link libraries. Thanks to George Peter Staplin for
+ the idea and the initial version of the script. [Bug 1263012]
+
+ * unix/Makefile.in: Trimmed a bunch of fat out of the tommath/
+ directory in 'make dist'. [RFE 1333318]
+
+ * unix/tcl.m4: Added code to enable [load] on LynxOS. Thanks to
+ heidibr@users.sf.net for the patch. [Bug 1163896]. Removed the last
+ vestiges of GNU dld from the Unix build [RFE 1071992].
+
+ * unix/tclLoadDld.c: Removed.
+ * unix/configure: Regenerated.
+
+2005-11-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * generic/tclVar.c:
+ * tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use the
+ same approach as the 8.4 patch in the ticket (i.e., removed the patch
+ committed on 2005-31-10).
+
+2005-11-03 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWin32Dll.c: Applied [Patch 1256872] to provide unicode
+ * win/tclWinConsole.c: support in the console on suitable systems.
+ * win/tclWinInt.h: Patch by Anton Kovalenko
+
+2005-11-02 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ Applied [Patch 1096916] to support building with MSVC 8.
+ * generic/regerror.c: Avoid use of reserved word.
+ * generic/tcl.h: Select the right Tcl_Stat structure
+ * generic/tclDate.c: Casts to handle 64 bit time_t case.
+ * tests/env.test: Include essential envvar on Win32
+ * win/nmakehlp.c: Handle new return codes.
+ * win/makefile.vc: Use the selected options.
+ * win/rules.vc: Check options are applicable
+ * win/tclWinPort.h: Disable deprecated function warnings
+ * win/tclWinSock.c: Provide default value to avoid warning.
+ * win/tclWinTime.c: Add casts to handle 64bit time_t type.
+
+2005-11-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTrace.c (TclCheckExecutionTraces): Corrected mistaken
+ assumption that all command traces are set at the script level.
+ Report/fix from Jacques H. de Villiers. [Bug 1337941]
+
+ * tests/unixNotfy.test (1.1,2): Update error message whitespace to
+ match changes in code.
+
+ * tests/expr-old.test (expr-32.52): Use int(.) to restrict result of
+ left shift to the C long range.
+
+ * expr.test (expr-46.13): Added test that illustrates shortcoming of
+ [Patch 1340260].
+
+2005-10-31 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c: fix for [Bugs 1338280/1337229]. Thanks Don.
+ * tests/trace.test: fix duplicate test numbers
+
+2005-10-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * win/tclWinSerial.c (SerialSetOptionProc): Cleaned up option parsing
+ to produce more informative error messages and separate error and
+ non-error code paths better.
+ * tests/ioCmd.test (iocmd-8-19): Updated.
+
+2005-10-29 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclTrace.c (TraceVarProc): [Bug 1337229], partial fix. Ensure
+ that a second call with TCL_TRACE_DESTROYED does not lead to a second
+ call to Tcl_EventuallyFree(). It is still true that that second call
+ should not happen, so the bug is not completely fixed.
+ * tests/trace.test (test-18.3-4): added tests for [Bug 1337229] and
+ [Bug 1338280].
+
+2005-10-23 Vince Darley <vincentdarley@sourceforge.net>
+
+ * generic/tclFileName.c: fix to memory leak in glob [Bug 1335006] Obj
+ leak detection and patch by Eric Melbardis.
+
+ * tests/fCmd.test:
+ * win/tclWinFile.c: where appropriate windows API is available, try to
+ set 'nlink' and 'ino' stat fields (previously they were always 0). [Bug
+ 1325803]
+
+2005-10-22 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/foreach.test (foreach-8.1): added test for [Bug 1189274]
+
+2005-10-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_INCR_*): fixed [Bug 1334570]. Obj leak
+ detection and patch by Eric Melbardis.
+
+2005-10-21 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (RefineApproximation): Plugged a memory leak
+ where two intermediate results were not freed on one return path. [Bug
+ 1334461]. Thanks to Eric Melbardis for the patch.
+
+2005-10-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/binary.n: Clarify that virtually all code that uses the 'h'
+ format in [binary scan] should be using the 'H' format instead. It is
+ nearly always a bug to use the other!
+
+2005-10-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclListObj.c (TclLsetFlat):
+ * tests/lset.test (lset-10.3): fixed handling of unshared lists with
+ shared sublists, [Bug 1333036] reported by neuronstorm.
+
+2005-10-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIORChan.c (PassReceivedError,PassReceivedErrorInterp):
+ Fix crash caused by passing -1 as the length to TclNewStringObj(). Only
+ Tcl_NewStringObj (the function call, not the macro) handles that sort
+ of thing correctly. This makes ioCmd.test pass again.
+
+2005-10-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclClock.c: Removed some dead code.
+ * generic/tclCmdIL.c:
+ * generic/tclCompCmds.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * generic/tclLiteral.c:
+ * generic/tclParseExpr.c:
+ * generic/tclScan.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+
+2005-10-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclIORChan.c: General cleanup, removing checks that are
+ unnecessary due to the general contracts of other functions in the
+ core, converting to using ANSI declarations, etc. Note that nearly the
+ whole file has changed, but it is often just cosmetic.
+
+2005-10-19 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_DICT_APPEND, INST_DICT_LAPPEND): fixed
+ faulty peephole optimisation that can cause crashes, [Bug 1331475]
+ reported by Aric Bills.
+
+2005-10-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Added optimization for I32L64 systems to avoid
+ using bignums to perform int multiplies. The improvement shows up most
+ dramatically in tclbench's matrix.bench.
+
+2005-10-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Restored some optimizations of the
+ INST_INCR_SCALAR1_IMM opcode.
+
+2005-10-14 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclIO.c (Tcl_ClearChannelHandlers): removed change dated
+ 2005-10-04 (see below). Look into [Bug 1323992] for detailed
+ discussion.
+
+ * generic/tcl.h: Fixed bad definition of CRTEXPORT which should have
+ been CRTIMPORT rather. This broke compilation of generic/tclMain.c and
+ was probably introduced by mistake while applying the fix for [Bug
+ 1256937] below.
+
+2005-10-14 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c (TclIncrObj, TclExecuteByteCode): Tidied up a
+ couple of infelicitous do {...} while(0) constructs.
+
+2005-10-14 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tcl.h: Fix for [Bug 1256937] - correctly decorate
+ * generic/tclMain.c: imported functions from msvcrt in static builds.
+
+2005-10-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/format.test: "Forward"-port of test updates relating to [Bug
+ 1284178]. The bug itself was fixed by TIP#237.
+
+2005-10-13 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclIO.c (Tcl_ClearChannelHandlers): temporary ifdef
+ TCL_THREADS changes done to de-activate pending event processing when
+ channel is being closed/cutted.
+
+2005-10-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Removed obsolete use of NO_ERRNO_H.
+ * tools/man2tcl.c:
+ * unix/tcl.m4:
+ * unix/tclConfig.h.in:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * compat/tclErrno.h: Removed obsolete file.
+
+ * generic/tclStrToD.c (TclParseNumber): Missing goto caused crash when
+ parsing "Na". [Bug 1325833]
+
+2005-10-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (GetNumberFromObj): Restored some lost
+ optimizations for empty string values. We avoid cost of a call to
+ TclParseNumber just to tell us an empty string isn't a number.
+
+2005-10-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclPathObj.c (SetFsPathFromAny): TclGetString macro must not
+ be combined with post-increment arguments. [Bug 1325099]
+
+2005-10-12 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c (Tcl_ExecuteByteCode, TclIncrObj): Several
+ common cases inlined in hopes of gaining a little performance in [incr]
+
+2005-10-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c: New convenience macro CompileTokens().
+
+2005-10-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrections to the NO_WIDE_TYPE build. Also
+ added missing "break" to a switch that broke wide XOR operations.
+
+2005-10-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (DeleteScriptLimitCallback)
+ (SetScriptLimitCallback): Improve the interlocking between the script
+ limit callback record and the hash table of current such records, to
+ prevent crashes in callbacks that create callbacks.
+ (Tcl_LimitSetTime): Reset the correct flag. Problem reported by
+ Nicolas Castagne <castagne@imag.fr> on comp.lang.tcl
+
+2005-10-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Fixing errors in last commit. (Two commits, the
+ second removes wrong comment).
+
+2005-10-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclStrToD.c:
+ * generic/tclStringObj.c: Initialise variables to avoid compiler
+ warnings ([Bug 1320818] among others).
+
+2005-10-08 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#237 IMPLEMENTATION
+
+ [kennykb-numerics-branch] Resynchronized with the HEAD; at this
+ checkpoint [-rkennykb-numerics-branch-20051008], the HEAD and
+ kennykb-numerics-branch contain identical code.
+
+ [kennykb-numerics-branch] Merge updates from HEAD
+
+ * generic/tclExecute.c: More performance macros and special handling of
+ the wide integer type for performance on 32-bit systems.
+
+2005-10-07 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Macro GetNumberFromObj() is version of
+ TclGetNumberFromObj() that saves a function call for common uses.
+
+ * generic/tclInt.h: Made #undef NO_WIDE_TYPE the default on 32-bit
+ systems. Being able to use 64-bit values without leaping to mp_int
+ should help with performance.
+
+ * generic/tclObj.c: Bug fixes in the #undef NO_WIDE_TYPE
+ * generic/tclExecute.c: configuration.
+
+ * generic/tclExecute.c: Improved performance of comparison opcodes and
+ bitwise operations and removed yet more dead code.
+
+2005-10-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to
+ * tests/fCmd.test (fCmd-20.2): account for NFS special files
+ with a readdir rewind threshold. [Bug 1034337]
+
+2005-10-06 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Improved performance of INST_RSHIFT and
+ INST_LSHIFT.
+
+2005-10-05 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Improved performance of INST_MULT, INST_DIV,
+ INST_ADD, and INST_SUB and replaced a "goto... label" with a "break
+ from loop" in TclIncrObj() and removed some dead code.
+
+2005-10-05 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclPipe.c (TclCreatePipeline): Fixed [Bug 1109294]. Applied
+ the patch provided by David Gravereaux.
+
+ * doc/CrtChannel.3: Fixed [Bug 1104682], by application of David
+ Welton's patch for it, and added a note about wideSeekProc.
+
+ * generic/tclIORChan.c (RcClose): Removed unreachable panic/return
+ statements. This fixes the remainder of [Bug 1286256].
+
+2005-10-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/env.test (env-6.1):
+ * win/tclWinPort.h: define USE_PUTENV_FOR_UNSET 1
+ * generic/tclEnv.c (TclSetEnv, TclUnsetEnv): add USE_PUTENV_FOR_UNSET
+ to existing USE_PUTENV define to account for various systems that have
+ putenv(), but can't unset env vars with it. Note difference between
+ Windows and Linux for actually unsetting the env var (use of '=').
+ Correct the resizing of the environ array. We assume that we are in
+ full ownership, but that's not correct.[Bug 979640]
+
+2005-10-04 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+ * generic/tclExecute.c: Updated TclIncrObj() to more efficiently add
+ native long integers. Also updated IllegalExprOperandType and the
+ INST_UMINUS, INST_UPLUS, INST_BITNOT, and INST_TRY_CVT_TO_NUMERIC
+ sections for performance.
+
+ * generic/tclBasic.c: Updated more callers to make use of
+ TclGetNumberFromObj. Removed some dead code.
+
+2005-10-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinSerial.c (SerialSetOptionProc): free argv [Bug 1067708]
+
+ * tests/http.test: do not URI encode -._~ according
+ * library/http/http.tcl (init): to RFC3986. [Bug 1182373] (aho)
+
+ * unix/tclLoadShl.c (TclpDlopen): use DYNAMIC_PATH on second shl_load
+ only. [Bug 1204237]
+
+ * doc/scan.n: scan %[] requires "one or more chars" [Bug 1277503]
+
+ * tests/winFile.test (getuser): allow valid Windows usernames. [Bug
+ 1311285]
+
+ * generic/tclParse.c (Tcl_ParseCommand): add code that recognizes {} in
+ addition to {expand} for word expansion (make with
+ -DALLOW_EMPTY_EXPAND).
+
+2005-10-04 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclIO.c (Tcl_ClearChannelHandlers): now deletes any
+ outstanding timer for the channel. Also, prevents events still in the
+ event queue from triggering on the current channel.
+
+ * generic/tclTimer.c (Tcl_DeleteTimerHandler): bail out early if passed
+ NULL argument.
+
+2005-10-03 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclBasic.c: Re-implemented ExprRoundFunc and
+ ExprEntierFunc to use TclGetNumberFromObj.
+
+ * generic/tclInt.h: Added new routine TclGetNumberFromObj to
+ * generic/tclObj.c: provide efficient access to the actual
+ internal rep of a numeric Tcl_Obj without conversions.
+
+2005-10-03 Kevin Kenny <kennykb@acm.org>
+
+ * tools/loadICU.tcl: Changed the file names of message catalogs to
+ lowercase.
+ * tools/makeTestCases.tcl:
+ * library/tzdata/*: Olson's tzdata2005n.tar.gz. Includes new DST
+ rules for USA and a number of changes to other locales.
+ * tests/clock.test: Regenerated for new US DST rules.
+
+2005-09-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclMain.c: Separate encoding conversion of command line
+ arguments from list formatting. [Bug 1306162].
+
+2005-09-30 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclStringObj.c: Bug fix: Missing cast to large enough
+ integral size before << operations led to broken [format %llx] results.
+ Thanks to Robert Henry for reporting the bug.
+
+2005-09-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/mathfunc.n: implementation for TIP #255, expr min/max
+ * library/init.tcl:
+ * tests/info.test, tests/expr-old.test:
+
+2005-09-27 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tcl.h: Changed name of the new Tcl_Obj intrep field
+ * generic/tclObj.c: from "bignumValue" to "ptrAndLongRep" as
+ * generic/tclProc.c: described in TIP 237, and more suitable for
+ other more general uses.
+
+2005-09-27 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/binary.test (binary-14.18): Added test for [Bug 1116542] though
+ the bug itself was already fixed by unrelated changes.
+
+2005-09-26 Kevin Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merge updates from HEAD.
+
+2005-09-26 Kevin Kenny <kennykb@acm.org>
+
+ * libtommath/: Updated to release 0.36.
+ * generic/tommath.h: Regenerated.
+ * generic/tclTomMathInterface.h: Added ten missing aliases for mp_*
+ functions to avoid namespace pollution in Tcl's exported symbols. [Bug
+ 1263012]
+
+2005-09-23 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * unix/Makefile.in: Added -DMP_PREC=4 switch to all compiles so
+ * win/Makefile.in: that minimum memory requirements of mp_int's
+ * win/makefile.vc: will not be quite so large. [Bug 1299153].
+
+ * generic/tclStrToD.c: Fixed memory leak. [Bug 1299803].
+ * generic/tclObj.c:
+
+2005-09-20 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Revise TclIncrObj() to call
+ Tcl_GetBignumAndClearObj.
+
+ * generic/tcl.decls: Add Tcl_GetBignumAndClearObj.
+ * generic/tclObj.c:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2005-09-16 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclInt.h: Added TclBNInitBigNumFromWideInt() so
+ * generic/tclTomMathInterface.c: that every caller isn't required to
+ duplicate the sign logic to use the unsigned interface.
+
+ * generic/tclBasic.c: Reduce the number of places where Tcl intrudes
+ * generic/tclExecute.c: into the internal format details of the mp_int
+ * generic/tclObj.c: struct.
+ * generic/tclStrToD.c:
+ * generic/tcLStringObj.c:
+
+ * generic/tclTomMath.h: Added mp_cmp_d to routines from libtommath
+ * unix/Makefile.in: used by Tcl.
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+ * libtommath/bn_mp_add_d.c: Bug fix. For mp_add_d(&a, d, &c), when &a
+ has the value -d, then the value &c computed should be zero, but
+ mp_add_d was producing an inconsistent zero value with a sign field of
+ MP_NEG, something like a value of -0, which other routines in
+ libtommath can't handle.
+
+ * generic/tclExecute.c: Dropped all creation of "bigOne" values and
+ just use tommath routines that accept the value "1" directly.
+
+2005-09-15 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/ParseCmd.3: copy/paste fix [Bug 1292427]
+
+2005-09-15 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merge updates from HEAD.
+
+ * generic/tclStringObj.c (TclAppendFormattedObjs): Revision to
+ eliminate one round of string copying.
+
+ * generic/tclBasic.c: More callers of TclObjPrintf and
+ * generic/tclCkalloc.c: TclFormatToErrorInfo.
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c:
+ * generic/tclIORChan.c:
+ * generic/tclMain.c:
+ * generic/tclProc.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c
+
+ * unix/configure: autoconf-2.59
+
+2005-09-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl to
+ transparently open large files on RHEL 3. [Bug 1287638]
+
+2005-09-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to
+ support "*" fields and needed to interpret precision limits on %s
+ conversions as a maximum number of bytes, not Tcl_UniChars, to take
+ from the (char *) argument.
+
+ * generic/tclBasic.c: Updated several callers to use
+ * generic/tclCkalloc.c: TclFormatToErrorInfo() and/or
+ * generic/tclCmdAH.c: TclObjPrintf().
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * generic/tclIORChan.c:
+ * generic/tclIOUtil.c:
+ * generic/tclNamesp.c:
+ * generic/tclProc.c:
+
+ * library/init.tcl: Keep [unknown] in sync with errorInfo
+ formatting rules.
+
+2005-09-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: First caller of TclFormatToErrorInfo.
+
+ * generic/tclInt.h: Using stdarg.h conventions, add more
+ * generic/tclStringObj.c: fixed arguments to TclFormatObj() and
+ TclObjPrintf(). Added new routine TclFormatToErrorInfo().
+
+ * generic/tcl.h: Explicitly standardized on the use of stdarg.h
+ * generic/tclBasic.c: conventions for functions with variable number
+ * generic/tclInt.h: of arguments. Support for varargs.h has been
+ * generic/tclPanic.c: implicitly gone for some time now. All
+ * generic/tclResult.c: TCL_VARARGS* macros purged from Tcl sources,
+ * generic/tclStringObj.c: leaving only some deprecated #define's
+ * tools/genStubs.tcl: in tcl.h for the sake of older extensions.
+
+ * generic/tclDecls.h: make genstubs
+
+ * doc/AddErrInfo.3: Replaced all documented requirement for use of
+ * doc/Eval.3: TCL_VARARGS_START() with requirement for use of
+ * doc/Panic.3: va_start().
+ * doc/SetResult.3:
+ * doc/StringObj.3:
+
+2005-09-12 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merge updates from HEAD.
+
+ * generic/tclCmdAH.c: Added support for the "ll" width
+ * generic/tclStringObj.c: specifier to [format].
+
+ * generic/tclStringObj.c (TclAppendFormattedObjs): Bug fix: make
+ sure %ld formats force the collection of a wide value, when the value
+ could be a different long.
+
+2005-09-09 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c (RcDecodeEventMask): Added missing type
+ declaration for the parameter 'mask'. This fixes the [Bug 1286256]. The
+ other warning can be removed only by removing the panic/return code.
+
+2005-09-09 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merge updates from HEAD.
+
+2005-09-09 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclStringObj.c: Added two missing casts to silence messages
+ from MSVC6.
+
+2005-09-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: New internal routine TclObjPrintf()
+ * generic/tclStringObj.c: is similar to TclFormatObj() but
+ accepts arguments in non-Tcl_Obj format.
+
+ * generic/tclInt.h: New internal routines TclFormatObj()
+ * generic/tclStringObj.c: and TclAppendFormattedObjs() to offer
+ sprintf()-like means to append to Tcl_Obj. Work in progress toward
+ [RFE 572392].
+
+ * generic/tclCmdAH.c: Compiler directive NEW_FORMAT when #define'd
+ directs the [format] command to be implemented in terms of the new
+ TclAppendFormattedObjs() routine.
+
+2005-09-08 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ TIP#254 IMPLEMENTATION
+
+ * generic/tclLink.c (LinkTraceProc,ObjValue): Added many new of C var
+ * generic/tcl.h: to link to, making it
+ * doc/LinkVar.3: easier to seamlessly
+ * generic/tclTest.c (TestlinkCmd): couple C code and Tcl
+ * tests/link.test: scripts in an
+ application. [Patch 1242844]
+
+2005-09-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtf.c (Tcl_UniCharToUtf): Corrected handling of negative
+ * tests/utf.test (utf-1.5): Tcl_UniChar input value. Incorrect
+ handling was producing byte sequences outside of Tcl's legal internal
+ encoding. [Bug 1283976].
+
+2005-09-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInt.h (List): Added flag to keep track of whether a list
+ * generic/tclListObj.c: with a string rep is provably canonical.
+ * generic/tclUtil.c (Tcl_ConcatObj): Do efficient concatenation and
+ * generic/tclBasic.c (Tcl_EvalObjEx): evaluation when the list is
+ canonical, and not just when the list is pure. This should make the
+ "pure list" hacking introduced in 8.3 much more robust.
+
+2005-09-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclObj.c (pendingObjDataKey): Added missing 'static' to stop
+ symbol from leaking outside the Tcl library. [Bug 1263012]
+
+2005-09-02 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclScan.c: Bug fix: The %o, %x, %i formats of [scan] must
+ not accept any 0b or 0o prefixes. [scan $s %o] must continue to work
+ even with KILL_OCTAL enabled.
+
+ * generic/tclInt.h: Added TCL_PARSE_SCAN_PREFIXES to the flags
+ * generic/tclStrToD.c: accepted by TclParseNumber.
+
+2005-09-01 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixSock.c (InitializeHostName): Synchronized use of static
+ modifier in declaration and definition of function.
+
+ * unix/tclUnixChan.c (FileTruncateProc): Synchronized use of static
+ modifier in declaration and definition of function.
+
+ * generic/tclResult.c (ReleaseKeys): Synchronized use of static
+ modifier in declaration and definition of function.
+
+ * generic/tclListObj.c (NewListIntRep): Synchronized use of static
+ modifier in declaration and definition of function.
+
+ * generic/tclEncoding.c (InitializeEncodingSearchPath): Synchronized
+ use of static modifier in declaration and definition of function.
+
+ * generic/tclEncoding.c (FillEncodingFileMap): Synchronized use of
+ static modifier in declaration and definition of function.
+
+ * generic/tclIORChan.c (RcNewHandle): Synchronized use of static
+ modifier in declaration and definition of function.
+
+2005-09-01 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclObj.c: TclParseNumber calls meant to parse an integer
+ value now pass the TCL_PARSE_INTEGER_ONLY flag.
+
+ * generic/tclScan.c: Extended [scan] to accept the %lld, %llo, %llx,
+ and %lli formats. Numeric scanning is now done via TclParseNumber calls
+
+ * generic/tclInt.h: Extended TclParseNumber to accept new flag
+ * generic/tclStrToD.c: values TCL_PARSE_INTEGER_ONLY,
+ TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller
+ more control over the parsing rules.
+
+2005-08-31 Vince Darley <vincentdarley@sourceforge.net>
+
+ * doc/FileSystem.3:
+ * unix/tclUnixFile.c:
+ * windows/tclWinFile.c: clarify that Tcl_FSMatchInDirectory may be
+ called with a NULL interpreter, and fix the code so this is allowed.
+ Tcl's core itself (tclEncoding.c:FillEncodingFileMap()) calls this
+ with a NULL interpreter.
+
+2005-08-30 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclObj.c: Extended bignum support to include bignums so
+ large they will not pack into a Tcl_Obj. When they outgrow Tcl's string
+ rep length limits, a panic will result.
+
+ * generic/tclTomMath.h: Added mp_sqrt to routines from
+ * unix/Makefile.in: libtommath used by Tcl.
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+ * generic/tclBasic.c: Extended sqrt(.) so that range covers the
+ entire double range, accepting as many bignums in the domain as that
+ will allow.
+
+2005-08-29 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl (::tcl::tm::roots): Accepted Don Porter's patch for
+ [Bug 1189657]. Syncs the implementation to the specification (TIP #189)
+
+2005-08-29 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merge updates from HEAD.
+
+ * generic/tclBasic.c: Restored round(.) to the Tcl 8.4 rules.
+
+2005-08-29 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclBasic.c (ExprMathFunc): Restored "round away from zero"
+ * tests/expr.test (expr-46.*): behaviour to the "round" function.
+ Added test cases for the behavior, including the awkward case of a
+ number whose fractional part is 1/2-1/2ulp. [Bug 1275043]
+
+2005-08-26 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c: Moved Tcl_{Cut,Splice}Channel to
+ {Cut,Splice}Channel for internal use, and created new public functions
+ for Tcl_{Cut,Splice}Channel which walk the whole stack of
+ transformations and invoke the necessary thread actions. Added code to
+ Tcl_(Un)StackChannel to properly invoke the thread actions when pushing
+ and popping transformations on/from a channel.
+
+2005-08-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (NamespaceEnsembleCmd): Reset the result after
+ creating an ensemble to clear any result object sharing (potentially
+ caused by delete traces) so that we can safely return the name of the
+ ensemble. Previously, this caused crashes in Snit's test suite.
+
+2005-08-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclListObj.c (UpdateStringOfList): Stop uncontrolled and
+ unsafe crashes from happening when working with very large string
+ representations. [Bug 1267380]
+
+ * generic/tclExecute.c (TEBC:INST_DICT_LAPPEND): Stop dropping a
+ duplicated object on the floor, which was a memory leak (and a wrong
+ result too). Thanks to Andreas Kupries for reporting this.
+
+2005-08-25 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merge updates from HEAD
+
+ * generic/tclExecute.c: Bug fix. INST_RSHIFT: shift of negative values
+ produced incorrect results.
+
+ * generic/tclExecute.c: Bug fix. INST_*SHIFT opcodes stack management.
+ [expr 0<<6] should be 0, not 6.
+
+ * generic/tclBasic.c: Extended the domain of round(.) to all non-Inf,
+ non-NaN doubles, using bignums for the result as needed.
+
+2005-08-24 Andreas Kupries <andreask@activestate.com>
+
+ TIP#219 IMPLEMENTATION
+
+ * doc/SetChanErr.3: ** New File **. Documentation of the new channel
+ API functions.
+ * generic/tcl.decls: Stub declarations of the new channel API.
+ * generic/tclDecls.h: Regenerated
+ * generic/tclStubInit.c:
+
+ * tclIORChan.c: ** New File **. Implementation of the reflected
+ channel.
+ * generic/tclInt.h: Integration of reflected channel and new error
+ * generic/tclIO.c: propagation into the generic I/O core.
+ * generic/tclIOCmd.c:
+ * generic/tclIO.h:
+ * library/init.tcl:
+
+ * tests/io.test: Extended testsuite.
+ * tests/ioCmd.test:
+ * tests/chan.test:
+ * generic/tclTest.c:
+ * generic/tclThreadTest.c:
+
+ * unix/Makefile.in: Integration into the build machinery.
+ * win/Makefile.in:
+ * win/Makefile.vc:
+
+2005-08-24 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of
+ * tests/binary.test (binary-65.*) formatting floating point
+ numbers with the largest and smallest possible significands, and added
+ test cases for them.
+
+2005-08-24 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Corrected some TRACE bugs that prevented
+ compilation with --enable-symbols=all.
+ * generic/tclStrToD.c: Revised commentary to prepare for a renaming of
+ the file, removed some dead code, and fixed a bug where
+ TclBignumToDouble failed on huge negative numbers.
+ * tests/binary.test (binary-65.*): Added missing 'ieeeFloatingPoint'
+ to large/small significand tests.
+ * tests/expr.test (expr-45.*) Added missing braces around expressions.
+
+2005-08-24 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclBasic.c: Revised implementation of the ceil(.) and
+ * generic/tclInt.h: floor(.) math functions in light of the
+ * generic/tclStrToD.c: revised comparison operators, so that it is
+ always true that ($x <= ceil($x)) and ($x >= floor($x)). The simple
+ approach of "convert to double and call ceil() or floor()" could not
+ guarantee that.
+
+ * generic/tclExecute.c: Bug fix: TclBignumToDouble return -Inf when
+ appropriate. Removed declarations of removed routines.
+
+ * generic/tclExecute.c: Revised the type promotion rules of the
+ comparison operators so that they form proper equivalence classes over
+ the set of numeric strings.
+
+2005-08-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure.in:
+ * win/configure: Regen.
+ * win/configure.in: Update minimum autoconf version to 2.59.
+
+2005-08-23 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * generic/tclInt.h:
+ * generic/tclObj.c (Tcl_GetBooleanFromObj, SetDoubleFromAny,
+ Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetBignumFromObj):
+ * generic/tclParseExpr.c (GetLexeme):
+ * generic/tclScan.c (Tcl_ScanObjCmd):
+ * generic/tclStrToD.c (TclParseNumber):
+ * tests/binary.test (binary-62.1-65.7):
+ * tests/expr.test (expr-40.1-42.1):
+ * scan.test (scan-14.1,14.2):
+ Modified Tcl_ParseNumber to accept an argument to force interpretation
+ as decimal, and modified [scan] to use it. Corrected a bug where Not a
+ Number with hexadecimal information bits returned consistently
+ incorrect values. #ifdef-ed out some code that is needed only for IBM
+ hexadecimal floating point. Fixed bugs in code to handle the corner
+ cases of smallest and largest significands. Added test cases to improve
+ test coverage in generic/tclStrToD.c. Added test cases for 0b notation
+ (TIP #114). Removed TclStrToD, and the static functions that it calls,
+ which are now dead code (TclParseNumber now does all input
+ floating-point conversions.)
+
+2005-08-23 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclStrToD.c: Bug fix: set shift magnitude properly whether
+ we're expanding to mp_int type or not.
+
+ * generic/tclExecute.c: Bug fix: ACCEPT_NAN under INST_UMINUS.
+
+ * generic/tclStrToD.c: New macros TIP_114_FORMATS and KILL_OCTAL to
+ configure acceptance of 0o and 0b numbers and rejection of "leading
+ zero as octal".
+
+ * generic/tclBasic.c: Re-used the guts of int(.) and wide(.) math
+ functions to perform conversions in OldMathFuncProc.
+
+ * generic/tclBasic.c: Support for ACCEPT_NAN.
+ * generic/tclExecute.c:
+
+ * generic/tclInt.decls: Restored TclExprFloatError to internal stubs
+ * generic/tclBasic.c: table, and moved definition back to
+ * generic/tclExecute.c: tclExecute.c from tclBasic.c to handle #undef
+ ACCEPT_NAN.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclInt.h: New internal macros TclIsNaN and TclIsInfinite
+ * generic/tclBasic.c: replace the IS_NAN and IS_INF macros scattered
+ * generic/tclExecute.c: here and there.
+ * generic/tclObj.c:
+ * generic/tclStrToD.c:
+ * generic/tclUtil.c:
+
+2005-08-22 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclConfig.h.in: autoheader-2.59.
+
+2005-08-22 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclInt.h: New ACCEPT_NAN macro to mark code that
+ * generic/tclCmdAH.c: supports or disables accepting of the NaN
+ * generic/tclExecute.c: value at various points.
+ * generic/tclLink.c:
+
+ * generic/tclStrToD.c: Bug fix. Parsing of +/- Infinity was reversed.
+
+ * generic/tclTestObj.c: Disabled unused [testconvertobj] command.
+
+ * generic/tclBasic: Added [expr {entier(.)}]. Rewrote int(.) and
+ wide(.) to use the same guts, accepting all non-Inf doubles as
+ arguments.
+
+ * generic/tclInt.h: New routine TclInitBignumFromDouble.
+ * generic/tclStrToD.c: Modified to return code and write error
+ message.
+
+ * generic/tclInt.h: TCL_WIDE_INT_IS_LONG implies NO_WIDE_TYPE.
+ * generic/tclObj.c: Removed now unnecessary tests of the
+ * generic/tclStrToD.c: TCL_WIDE_INT_IS_LONG definition.
+
+ * generic/tclInt.h: New internal routine TclSetBignumIntRep
+ * generic/tclObj.c: consolidates packing of bignum value into a
+ * generic/tclStrToD.c: Tcl_Obj within one source code file.
+
+ * tests/expr.test: Corrected the wideIs64bit constraint.
+ * tests/format.test:
+ * tests/scan.test:
+
+2005-08-21 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclInt.h: Moved TclParseInteger to tclUtil.c and
+ * generic/tclParseExpr.c: made it static.
+ * generic/tclUtil.c:
+
+ * generic/tclInt.decls: Moved TclExprFloatError to tclBasic.c and made
+ * generic/tclBasic.c: it static.
+ * generic/tclExecute.c:
+
+ * generitc/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclExecute.c: errno, IS_NAN, IS_INF, LLD no longer called in
+ this file; dropped/disabled support for them.
+
+ * generic/tclCompExpr.c: errno no longer used in these files;
+ * generic/tclParseExpr.c: dropped support "hack" for it.
+
+ * generic/tclStrToD.c: Disabled out of date support "hack" for errno.
+
+ * generic/tclBasic.c: Eliminated VerifyExprObjType. Initialize errno
+ to zero in OldMathFuncProc.
+
+2005-08-19 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclBasic.c: Updated OldMathFuncProc and ExprAbsFunc to do
+ less invasion into numeric Tcl_Obj internals. Made ExprDoubleFunc,
+ ExprIntFunc, ExprWideFunc, and ExprRoundFunc bignum-aware. Revised
+ ExprSrandFunc error message.
+
+ * generic/tclProc.c: Wrapped a few tclWideIntType uses in
+ * generic/tclCmdMZ.c: #ifndef NO_WIDE_TYPE.
+
+ * generic/tclInt.h: #define'd NO_WIDE_TYPE.
+
+ * generic/tclVar.c: Replaced TclPtrIncrVar and TclPtrIncrWideVar
+ * generic/tclInt.h: with TclPtrIncrObjVar and replaced TclIncrVar2
+ * generic/tclInt.decls: and TclIncrWideVar2 with TclIncrObjVar2. New
+ routines call on TclIncrObj to do the work.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclCmdIL.c: Rework Tcl_IncrObjCmd and the INST_*INCR*
+ * generic/tclExecute.c: opcodes to use the new routines.
+
+2005-08-18 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Fixed string rep invalidation bug in
+ * tests/dict.test (dict-11.17): INST_DICT_INCR_IMM rewrite.
+
+ * generic/tclDictObj.c: DictIncrCmd rewrite to use TclIncrObj.
+
+ * generic/tclInt.h: TclIncrObj static -> internal
+ * generic/tclExecute.c:
+
+2005-08-17 George Peter Staplin <GeorgePS@XMission.com>
+
+ * generic/tclBasic.c: eliminate a namespace clash caused by
+ BuiltinFuncTable not being static.
+
+ * generic/tclObj.c: fix a namespace clash caused by a missing
+ static for pendingObjData.
+
+2005-08-17 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclEvent.c (Tcl_Finalize): Removed a copy-and-paste accident
+ that caused a (mostly harmless) double finalize of the load and
+ filesystem subsystems.
+ * tests/clock.test: Eliminated the bad test clock-43.1, and split
+ clock-50.1 into two tests, with a more permissive check on the error
+ message for an out-of-range value.
+
+2005-08-17 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclBasic.c (Tcl_Expr{Long,Double}{,Obj}): Updated to
+ * generic/tclTest.c: deal with
+ * tests/expr-old.test: bignums (well,
+ * tests/expr.test: mostly).
+ Added a missing "errno=0;" in ExprUnaryFunc so that spurious error
+ returns aren't detected.
+ Added test cases for Tcl_Expr* and Tcl_Expr*Obj because there was very
+ poor test coverage in those areas.
+ * generic/tclParseExpr.c: Reworked parsing of numbers to call
+ TclParseNumber rather than trying to do things locally.
+ * generic/tclStrToD.c: Corrected a comment. Changed so that *endPtrPtr
+ does not include any trailing whitespace.
+
+2005-08-17 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: New routine TclIncrObj to centralize the
+ increment operation needed in many places. Updated INST_DICT_INCR_IMM
+ to make use of it.
+
+2005-08-16 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Made bit shifting opcodes and INST_MOD
+ bignum-aware.
+
+ * tests/scan.test: Making << bignum-aware means that repeated
+ * tests/string.test: left shifting cannot turn a positive into a
+ negative. Revised [int_range] and [largest_int] utility commands in the
+ test suite that relied on that happening. Without revision they became
+ infinite loops.
+
+ * generic/tclExecute.c: Made binary bitwise opcodes bignum-aware.
+
+ * generic/tclTomMath.h: Added mp_or and mp_xor to routines from
+ * unix/Makefile.in: libtommath used by Tcl.
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+2005-08-15 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Updates from HEAD.
+ * generic/tclExecute.c: More revisions to IllegalExprOperandType.
+ Merged INST_BITNOT with INST_UMINUS and make it bignum-aware according
+ to the rule: ~a = -a - 1. Disabled unused code and noted more TODOs.
+
+ * generic/tclInt.decls: Disabled TclLooksLikeInt() and all callers.
+ * generic/tclUtil.c:
+ * generic/tclCompCmds.c:
+
+ * generic/tclBasic.c: Rewrite of VerifyExprObjType().
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclExecute.c: Updated execution of comparison bytecodes to
+ be bignum-aware, routing string compares through INST_STR_CMP.
+
+2005-08-14 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Updated execution of arithmetic bytecodes to
+ be bignum-aware, and to allow calculations on NaN to produce a NaN
+ result. INST_UMINUS updated to call mp_neg.
+
+ * generic/tclTomMath.h: Added mp_and, mp_expt_d, and mp_neg to
+ * unix/Makefile.in: routines from libtommath used by Tcl.
+ * win/Makefile.in:
+ * win/makefile.vc:
+
+2005-08-13 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclObj.c: Extended Bignum auto-narrowing to auto-narrow
+ to tclWideIntType when appropriate; this helps keep things working as
+ the bytecode execution code is migrated to supporting bignums.
+
+ * generic/tclExecute.c: Major overhaul of IllegalExprOperandType.
+ Changed several TclNewFooObj() calls to more logically appropriate
+ ones. Added several TODO comments marking opportunies for future work.
+ Made more use of the eePtr->constants. Made INST_UMINUS bignum aware.
+
+2005-08-12 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Simplify doCondJump. Use eePtr->constants as
+ result of INST_DICT_NEXT, INST_LAND, and INST_LOR. Separate INST_LNOT
+ from INST_UMINUS and simplify.
+
+2005-08-12 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (MktimeObjCmd):
+ * library/clock.tcl (GetSystemTimeZone, LoadZoneinfoFile)
+ (ReadZoneinfoFile):
+ * tests/clock.test (clock-50.1):
+ Added functionality to read /etc/localtime if it exists, so that Tcl's
+ time can track system time on Linux even if TZ is not set. Changed
+ ::tcl::clock::Mktime to check for failure, and added a test case that
+ mimics failure but is really success.
+
+2005-08-11 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclExecute.c: Rewrite of INST_LAND/INST_LOR to take advantage
+ of loss of "pure double" issues. Merged INST_UPLUS with
+ INST_TRY_CVT_TO_NUMERIC and updated to use improved rules for impure
+ "double"s as well.
+
+ * generic/tclStrToD.c: Restored conditional generation of
+ tclWideIntType values by TclParseNumber so that Tcl's not completely
+ broken while bignum calculation support is incomplete. The NO_WIDE_TYPE
+ macro can be used to disable this.
+
+ * generic/tclBasic.c (ExprAbsFunc): First pass making [expr abs(.)]
+ bignum-aware.
+
+2005-08-11 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclEvent.c: Eliminated the USE_THREAD_STORAGE option
+ * generic/tclInt.h: (which is on in every build generated by
+ * generic/tclThread.c: by the standard configurator).
+ * generic/tclThreadStorage.c: Eliminated the code for thread specific
+ * unix/configure: data without USE_THREAD_STORAGE and
+ * unix/tcl.m4: radically refactored the code for
+ * unix/tclConfig.h.in: USE_THREAD_STORAGE so that it has fewer
+ * unix/tclUnixThrd.c: dependencies on the order of
+ * win/configure: finalization. (Also, made 'make
+ * win/Makefile.in: distclean' on Windows clean just a little
+ * win/rules.vc: bit cleaner.)
+ * win/tcl.m4:
+ * win/tclWinThrd.c:
+
+2005-08-10 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclTomMath.h: Added mp_shrink, mp_to_unsigned_bin,
+ * unix/Makefile.in: mp_to_unsigned_bin_n, and mp_unsigned_bin_size
+ * win/Makefile.in: to routines from libtommath used by Tcl.
+ * win/makefile.vc:
+
+ * generic/tommath.h: make gentommath_h
+
+ * generic/tclObj.c: Substantial rewrite to make all number parsing
+ flow through TclParseNumber(). Also established the NO_WIDE_TYPE and
+ BIGNUM_AUTO_NARROW #ifdef's to help track the assumptions of different
+ portions of the code.
+
+ * generic/tclInt.h: Added NO_WIDE_TYPE #ifdefs
+
+2005-08-10 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclEvent.c (Tcl_Finalize): Pushed Tcl_FinalizeLoad and
+ Tcl_ResetFilesystem down after Tcl_FinalizeThreadAlloc because we can't
+ unload DLL's until after their TSD keys are finalized. (Note that we'll
+ still see aborts if an unloaded DLL has TSD - that still needs to be
+ fixed.
+
+ * tests/compExpr-old.test (compExpr-3.8): Made tests conditional on
+ * tests/expr.test (expr-3.8): 'unix' because they get
+ stack overflows on Win32 threaded builds,
+
+2005-08-09 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix to [file rootname] bug in optimized code
+ path reported on comp.lang.tcl.
+
+2005-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclObj.c: Replaced some goto's with loops and started
+ use of BIGNUM_AUTO_NARROW and NO_WIDE_TYPE.
+
+2005-08-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclThreadStorage.c: Stop exposing the guts of the thread
+ storage system through the internal stubs table. Client code should
+ always use the standard API.
+
+2005-08-05 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch]
+ * generic/tclObj.c: Rewrote Tcl_GetDoubleFromObj().
+
+2005-08-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixInit.c (localeTable): Solaris uses a non-standard name
+ for the cp1251 charset. Thanks to Victor Wagner for reporting this.
+ [Bug 1252475]
+
+2005-08-05 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ * win/makefile.vc: Removed unused file ldAout.tcl.
+ * win/makefile.bc: [Bug 1244361]
+
+ * tests/binary.test: Cleaned up testing for scanning of NaN. [Bug
+ 1246264]
+
+ * generic/tclBasic.c (ExprAbsFunc): Added code to handle the corner
+ * tests/expr.test (expr-38.1): case of applying 'abs' to the
+ smallest 32-bit integer. [Bug 1241572]
+
+2005-08-04 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (CloseChannel): Fixed comment nit, added apparently
+ missing word to complete a sentence.
+
+ * generic/tclObj.c (Tcl_DbDecrRefCount): Fixed whitespace nit in panic
+ message.
+
+2005-08-04 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Updated from HEAD
+
+ * generic/tclObj.c: Rewrote Tcl_GetBooleanFromObj() and supporting
+ routines to make use of TclParseNumber. This reduces the potential
+ number of times a string value must be scanned.
+
+ * generic/tclObj.c: Simplified routines that manage the typeTable.
+ Deleted the UpdateStringOfBoolean() routine, that can never be called.
+
+2005-08-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Untangled some dependencies in the
+ * generic/tclEvent.c: order of finalization routines.
+ * generic/tclInt.h: [Bug 1251399]
+ * generic/tclObj.c:
+
+2005-08-02 Don Porter <dgp@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Updated from HEAD
+
+2005-07-30 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclLoadDyld.c (TclpDlopen, TclpLoadMemory): workarounds for
+ bugs/changes in behaviour in Mac OS X 10.4 Tiger.
+
+2005-07-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode, still
+ have to take care with non-existant variables. [Bug 1247135]
+
+2005-07-28 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/README: Update link to msys_mingw8.zip.
+
+2005-07-28 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/compExpr-old.test: Still more conversion of "nonPortable"
+ * tests/error.test: tests into tests with constraints that
+ * tests/expr-old.test: describe the limits of their
+ * tests/expr.test: portability. Also more consolidation
+ * tests/fileName.test: of constraint synonyms.
+ * tests/format.test: wideis64bit, 64bitInts => wideIs64bit
+ * tests/get.test: wideIntegerUnparsed => wideIs32bit
+ * tests/load.test: wideIntExpressions => wideBiggerThanInt
+ * tests/obj.test:
+ * tests/parseExpr.test: Dropped "roundOffBug" constraint that
+ * tests/string.test: protected from buggy sprintf.
+
+2005-07-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclPipe.c (TclCreatePipeline): Arrange for POSIX systems to
+ * unix/tclUnixPipe.c (TclpOpenFile): use the O_APPEND flag for
+ * tests/exec.test (exec-19.1): files opened in a pipeline
+ like ">>this". Note that Windows cannot support such access; there is
+ no equivalent flag on the handle that can be set at the kernel-call
+ level. The test is unix-specific in every way. [Bug 1245953]
+
+2005-07-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: Converted the $::tcl_precision value to be kept
+ per-thread to prevent different threads from stomping on each others'
+ formatting prescriptions.
+
+ ***POTENTIAL INCOMPATIBILITY*** Multi-threaded programs that set the
+ value of ::tcl_precision will now have to set it in each thread.
+
+ * tests/expr.test: Consolidated equivalent constraints into
+ * tests/fileName.test: single definitions and (more precise) names:
+ * tests/get.test: longis32bit, 32bit, !intsAre64bit => longIs32bit
+ * tests/listObj.test: empty => emptyTest; winOnly => win
+ * tests/obj.test: intsAre64bit => longIs64bit
+ Also updated some "nonPortable" tests to use constraints that mark
+ precisely what about them isn't portable, so the tests can run where
+ they work.
+
+ * library/init.tcl ([unknown]): Corrected return code handling in the
+ portions of [unknown] that expand incomplete commands during
+ interactive operations. [Bug 1214462].
+
+2005-07-26 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Check for a $prefix/share directory and add it the
+ the package if found. This will check for Tcl packages in
+ /usr/local/share when Tcl is configured with the default dist install.
+ [Patch 1231015]
+
+2005-07-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_CallWhenDeleted): Converted to use
+ per-thread counter, rather than a process global one that required
+ mutex protection. [RFE 1077194]
+
+ * generic/tclNamesp.c (TclTeardownNamespace): Re-ordering so that
+ * tests/trace.test (trace-34.4): command delete traces fire
+ while the command still exists. [Bug 1047286]
+
+2005-07-24 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH):
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search
+ for tclsh on PATH and build and install locations into two macros.
+ SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the
+ name of the tclsh executable in the Tcl build directory. [Bug 1160114]
+ [Patch 1244153]
+
+2005-07-23 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: Updates to the Tcl script library to make use
+ * library/history.tcl: of Tcl 8.4 features. Forward port of
+ * library/init.tcl: appropriate portions of [Patch 1237755].
+ * library/package.tcl:
+ * library/safe.tcl:
+ * library/word.tcl:
+
+2005-07-23 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/string.test: Add string is tests for functionality that was not
+ tested.
+ * win/README: Update msys + mingw URL. Remove old Cygwin + mingw info.
+
+2005-07-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_DICT_*): stop 2 compiler warnings for
+ uninitialised variables.
+
+2005-07-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TEBC:INST_DICT_INCR_IMM): Fix the incrementor
+ to work correctly with wide values.
+
+2005-07-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictCmd): First run at a compiler
+ * generic/tclExecute.c (TclExecuteByteCode): for dictionaries. Also
+ added an instruction to support 'finally'-like clauses, exposed more of
+ the dict guts to the rest of the core, and defined a few tests to
+ exercise more obscure parts of the compiler's operation that were bugs
+ during development.
+
+2005-07-21 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/ldAout.tcl (***REMOVED***): Removed support for ancient
+ * unix/configure: BSD's, IRIX 4, RISCos and
+ * unix/Makefile.in: Ultrix. Removed two files whose
+ * unix/tcl.m4: code is used only on those
+ * unix/tclLoadAout.c (***REMOVED***): antique platforms.
+
+ ***POTENTIAL INCOMPATIBILITY*** if anyone actually uses those
+ platforms; it is to be noted though, that an error in the installer has
+ actually not caused a necessary file to be installed on those platforms
+ in several releases, and nobody's complained.
+
+2005-07-16 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (RefineResult): Plugged a stupid memory leak in
+ RefineResult (called from Tcl_StrToD). [Tk Bug 1227781]
+
+2005-07-15 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (TclClockLocaltimeObjCmd,ThreadSafeLocalTime):
+ * library/clock.tcl (GuessWindowsTimeZone, ClearCaches):
+ * tests/clock.test (clock-49.1, clock-49.2):
+ Handle correctly the case where localtime() returns NULL to report a
+ conversion error. Also handle the case where the Windows registry
+ contains timezone values that can be mapped to a tzdata file name but
+ the corresponding file does not exist or is corrupted, by falling back
+ on a Posix timezone string instead; this last case will avoid calls to
+ localtime() in starpacks on Windows. [Bug 1237907]
+
+2005-07-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompile.c: Update to follow style guidelines.
+ (TclPrintInstruction): Reorganize to do better printing out of bytecode
+ with far fewer "special hacks" for particular opcodes.
+ * generic/tclCompile.h: Requires two new opcode types.
+
+2005-07-13 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixSock.c: Use a ProcessGlobalValue to store the value
+ * win/tclWinSock.c: returned by Tcl_GetHostName() ([info
+ hostname]). Also re-order initialization of the value on Windows to
+ favor GetComputerName() over gethostname() as a source of the
+ information.
+
+2005-07-12 Kevin Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Updated from HEAD
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * generic/tclInt.h:
+ * generic/tclObj.c (Tcl_GetDoubleFromObj, SetDoubleFromAny)
+ (Tcl_GetIntFromObj, SetIntOrWideFromAny):
+ * generic/tclStrToD.c (TclParseNumber, etc.):
+ * tclTomMathInterface.c (TclBNInitBignumFromWideUInt):
+ * tests/obj.test (obj-1.1, obj-2.2, obj-3.1, obj-3.2):
+
+ Initial attempt at an implementation of TIP #249, comprising a unified
+ parser and modifications to the Tcl_Get*FromObj routines to use it.
+ Further integration of the parser is necessary and planned.
+
+2005-07-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/lsearch.n: Clarify documentation of -exact option; wording was
+ open to misinterpretation by non-English speakers.
+
+2005-07-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c: General style cleanup.
+
+2005-07-08 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Reimplement long and wide
+ type integer division and modulus operations so that the smallest and
+ largest integer values are handled properly. The divide operation is
+ more efficient since it no longer does a modulus or negation and only
+ checks for a remainder when the quotient will be a negative number.
+ The modulus operation is now a bit more complex because of a number of
+ special cases dealing with the smallest and largest integers.
+ * tests/expr.test: Add test cases for division and modulus operations
+ on the smallest and largest integer values for 32 and 64 bit types.
+ [Patch 1230205]
+
+2005-07-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclLink.c: Simplified LinkTraceProc [Bug 1208108].
+
+2005-07-05 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: Purged use of TCLTESTARGS [RFE 1161550].
+
+ * generic/tclUtil.c: Converted TclFormatInt() into a macro.
+ * generic/tclInt.decls: [RFE 1194015]
+ * generic/tclInt.h:
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclNamesp.c: Allow for [namespace import] of a command
+ * tests/namespace.test: over a previous [namespace import] of itself
+ without throwing an error. [RFE 1230597]
+
+2005-07-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictForCmd, DictFilterCmd): Interlocking of
+ dictionary internal representations is now done in the core of the dict
+ iterator. Purge the last attempts at doing it at a higher level as they
+ didn't work and were no longer needed.
+
+2005-07-01 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixNotfy.c: protect against spurious wake-ups while waiting
+ on the condition variable when tearing down the notifier thread [Bug
+ 1222872].
+
+2005-06-28 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): When parsing an integer
+ operand for a unary minus expression operator, check for a wide integer
+ that is actually LONG_MIN. If found, convert back to a long int type.
+ * tests/expr.test: Add constraint for 32bit long int type and 64bit
+ wide int type. Add tests that parse the smallest/largest long int and
+ wide int values.
+
+2005-06-24 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclEvent.c (Tcl_Finalize):
+ * generic/tclInt.h:
+ * generic/tclPreserve.c (TclFinalizePreserve): Changed the finalization
+ logic so that Tcl_Preserve finalizes after exit handlers run; a lot of
+ code called from Tk's exit handlers presumes that Tcl_Preserve will
+ still work even from an exit handler.
+
+2005-06-24 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: Make file safe to re-[source] without
+ destroying registered auto_mkindex_parser hooks.
+
+2005-06-23 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclWinChan.c: More rewriting of __asm__ blocks that implement
+ * win/tclWinFCmd.c: SEH in GCC, because mingw's gcc 3.4.2 is not as
+ forgiving of violations committed by the old code and caused panics.
+ [Bug 1225957]
+
+2005-06-23 Daniel Steffen <das@users.sourceforge.net>
+
+ * tools/tcltk-man2html.tcl: fixed useversion glob pattern to accept
+ multi-digit patchlevels.
+
+2005-06-22 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinFile.c: Potential buffer overflow. [Bug 1225571] Thanks to
+ Pat Thoyts for discovery and fix.
+
+2005-06-22 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclInt.h: Changed the finalization
+ * generic/tclEvent.c (Tcl_Finalize): logic to defer the
+ * generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe
+ * unix/tclUnixPipe.c (TclFinalizePipes): management until after all
+ * win/tclWinPipe.c (TclFinalizePipes): channels have been closed,
+ in order to avoid a situation where the Windows PipeCloseProc2 would
+ re-establish the exit handler after exit handlers had already run,
+ corrupting the heap. [Bug 1225727] Also corrected a potential read of
+ uninitialized memory in PipeClose2Proc [Bug 1225044]
+
+2005-06-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel
+ Steffen. There are compilers (*) who error out on the redefinition of
+ WORDS_BIGENDIAN. We have to undef the previous definition (on the
+ command line) first to make this acceptable. (*): AIX native.
+
+2005-06-21 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclFileName.c: Changed [file split] and [file join] to treat
+ Windows drive letters similarly to ~ syntax and make sure that they
+ appear with "./" in front when they are in intermediate components of
+ the path. [Bug 1194458]
+ * tests/fileName.test: Added test for the above bug.
+
+2005-06-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Added missing walk of the list of active
+ * generic/tclTrace.c: traces to cleanup references to traces being
+ * generic/tclInt.h: deleted. [Bug 1201035] Made the walk of the
+ * tests/trace.test (trace-34.*): active trace list aware of the
+ direction of trace scanning, so the proper correction can be made.
+ [Bug 1224585]
+
+2005-06-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' special
+ debugging feature when requested in configure.in; removes irrelevant
+ junk from the configure files of extensions that use Tcl's tcl.m4.
+
+2005-06-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompile.h (INST_PUSH_RETURN_OPTIONS): New opcode to allow
+ * generic/tclCompCmds.c (TclCompileCatchCmd): compilation of
+ * generic/tclCompile.c: TIP#90 catch [Bug
+ * generic/tclExecute.c (TclExecuteByteCode): 1219112]
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Ensure we spill to the
+ command form in all cases where it generates an error.
+
+2005-06-20 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Generate an error if a mode
+ argument like -exact is passed more than once to the switch command.
+ The previous implementation silently accepted invalid switch
+ invocations like [switch -exact -glob $str ...].
+ * tests/for.test: Check some error cases when invoking continue and
+ break inside a for loop next script.
+ * tests/switch.test: Add checks for shortened version of a mode
+ argument like -exact. Add test for more than one mode argument. Add
+ test for odd case of passing a variable as a body script.
+
+2005-06-18 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclInt.h: ensure WORDS_BIGENDIAN is defined correctly with
+ fat compiles on Darwin (i.e. ppc and i386 at the same time), the
+ configure AC_C_BIGENDIAN check is not sufficient in this case because a
+ single run of the compiler builds for two architectures with different
+ endianness.
+
+ * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to
+ ensure we can always relocate binaries with install_name_tool.
+
+ * unix/configure: autoconf-2.59
+
+2005-06-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Fix for [Bug 1154163]; only
+ * tests/format.test: insert 'l' modifier when it is needed.
+
+2005-06-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclTimer.c (AfterDelay): Split out the code to manage
+ synchronous-delay [after] commands.
+ * tests/interp.test (interp-34.10): Time limits and synch-delay [after]
+ did not mix well... [Bug 1221395]
+
+2005-06-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a
+ * tests/namespace.test (namespace-49.2): command from the hashtable on
+ reentrant processing if it has not been already deleted; at least three
+ deletes of the same command are possible. [Bug 1220058]
+ * generic/tclTrace.c (TraceCommandProc): Remove bogus error message
+ creation when traces trigger in situations where the command has
+ already been deleted.
+
+2005-06-13 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFCmd.c: correct fix to file mkdir 2005-06-09 [Bug 1219176]
+
+2005-06-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c: Factor out some common idioms into named forms
+ for greater clarity.
+
+2005-06-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/chan.n: Fold in the descriptive parts of the documentation for
+ all the commands that [chan] builds on top of.
+
+2005-06-09 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFCmd.c: fix to race condition in file mkdir [Bug 1217375]
+ * doc/glob.n: improve glob documentation [Bug 1190891]
+
+2005-06-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/expr.n, doc/mathfunc.n: Fix minor typos [Bug 1211078] and add
+ mention of distinctly-relevant [namespace path] subcommand.
+
+2005-06-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Reduced the Tcl_ObjTypes "index",
+ * generic/tclIndexObj.c: "ensembleCmd", "localVarName", and
+ * generic/tclNamesp.c: "levelReference" to file static scope.
+ * generic/tclProc.c:
+ * generic/tclVar.c:
+
+ * generic/tclObj.c: Restored registration of the "procbody"
+ Tcl_ObjType, as required by the tclcompiler application.
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2005-06-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIO.c (Tcl_ChannelTruncateProc): Stop proliferation of
+ * generic/tcl.h: channel type versions
+ * doc/CrtChannel.3: following advice from AKu
+
+ Bump patchlevel to a4 to distinguish from a3 release.
+
+ * generic/tclInt.h (INTERP_TRACE_IN_PROGRESS): Add flag so the error
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): messages from ensembles
+ * generic/tclIOCmd.c (Tcl_ReadObjCmd): can be correct.
+
+ TIP#208 IMPLEMENTATION
+
+ * library/init.tcl: Create the chan ensemble.
+ * tests/chan.test: Rudimentary test suite.
+ * doc/chan.n: General documentation.
+
+ TRUNCATION API (part of TIP#208)
+ * generic/tcl.h, generic/tcl.decls: Declaration of the API.
+ * doc/CrtChannel.3, doc/OpenFileChnl.3: Documentation of the API.
+ * generic/tclBasic.c (Tcl_CreateInterp): Create the mapping into Tcl.
+ * generic/tclIOCmd.c (TclChanTruncateObjCmd): Implementation of
+ Tcl-level truncation API.
+ * generic/tclIO.c (Tcl_TruncateChannel): Generic C-level truncation API
+ implementation.
+ * unix/tclUnixChan.c (FileTruncateProc): Basic implementation of
+ truncating driver.
+
+ * win/tclWinChan.c (FileTruncateProc): Added implementation of file
+ truncation for Windows.
+ * tests/chan.test (chan-15.2): Added real test of truncation.
+
+2005-06-06 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWin32Dll.c: Corrected another buglet in the assembly code for
+ stack probing on Win32/gcc. [Bug 1213678]
+ * generic/tclObj,c: Added missing 'static' on definition of
+ UpdateStringOfBignum, and removed a 'switch' on a 'long long' operand
+ (which HP-UX native 'cc' seems unable to handle). [Bug 1215775]
+
+2005-06-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ *** 8.5a3 TAGGED FOR RELEASE ***
+
+ * unix/Makefile.in (dist): add libtommath
+
+2005-06-03 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * library/parray.tcl (parray): Only generate the sorted list of element
+ names once. Thanks to Andreas Leitgeb for spotting this.
+
+2005-06-03 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Makefile: fixed 'embedded' target.
+
+2005-06-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in (html): add BUILD_HTML_FLAGS optional var
+ * tools/tcltk-man2html.tcl: add a --useversion to prevent confusion
+ when multiple Tcl source dirs exist.
+
+2005-06-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: For compatibility with earlier Tcl releases,
+ * generic/tclResult.c: when a command procedure simply does a
+ * generic/tclTest.c: "return TCL_RETURN;" we must interpret that
+ * tests/result.test: the same as
+ "return Tcl_SetReturnOptions(interp, Tcl_NewObj());" [Bug 1209759].
+
+2005-06-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Allow compilation of
+ -nocase -glob [switch]es (only one we know how to compile).
+
+ TIP#241 IMPLEMENTATION from Joe Mistachkin
+
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Implementation of -nocase
+ option for [lsearch], [lsort] and [switch] commands.
+ * win/tclWinPort.h: Win uses nonstandard function names...
+ * tests/cmdIL.test, tests/lsearch.test, tests/switch.test: Tests
+ * doc/lsearch.n, doc/lsort.n, doc/switch.n: Docs
+
+ * generic/tclCompCmds.c (TclCompileLindexCmd): Compile the most common
+ case of [lindex] more efficiently.
+
+ * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier): Pass the correct number
+ of arguments to Tcl_JoinThread.
+
+2005-05-31 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/configure.in, unix/tcl.m4: Standardize generation of help
+ messages to always use AC_HELP_STRING and always (except for --with-tcl
+ and --with-tk, where the default is complex) say what the default is.
+
+2005-05-31 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixNotfy.c: the notifier thread is now created as joinable
+ thread and it is properly joined in Tcl_FinalizeNotifier. This is an
+ attempt to fix the [Bug 1082283].
+
+2005-05-30 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * win/tclWinThrd.c: Fixed [Bug 1204064]
+
+2005-05-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP #229 IMPLEMENTATION
+
+ * generic/tclNamesp.c (Tcl_FindCommand, TclResetShadowedCmdRefs)
+ (NamespacePathCmd, SetNsPath, UnlinkNsPath, TclInvalidateNsPath):
+ Implementation of the [namespace path] command and the command name
+ resolution engine.
+ * doc/info.n, doc/namespace.n: Doc updates.
+ * tests/namespace.test (namespace-51.*): Test updates.
+ * generic/tclResolve.c (BumpCmdRefEpochs, Tcl_SetNamespaceResolvers):
+ * generic/tclBasic.c (Tcl_CreateCommand, Tcl_CreateObjCommand): Ensure
+ that people don't see stale paths.
+ * generic/tclInt.h (Namespace, NamespacePathEntry): Structure defs.
+ * generic/tclCmdIL.c (InfoCommandsCmd): Updates to [info commands].
+
+2005-05-26 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Makefile: moved & corrected EMBEDDED_BUILD check.
+
+ * unix/configure.in: corrected framework finalization to softlink stub
+ library to Versions/8.x subdir instead of Versions/Current.
+ * unix/configure: autoconf-2.59
+
+2005-05-25 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCmdMZ.c (Tcl_TimeObjCmd): add necessary cast
+
+2005-05-25 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#182 IMPLEMENTATION [Patch 1165062]
+
+ * doc/mathfunc.n: New built-in math function bool().
+ * generic/tclBasic.c:
+ * tests/expr.test:
+ * tests/info.test:
+
+2005-05-24 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl: Updated [unknown] to be sure the [return]
+ * tests/init.test: options from an auto-loaded command are seen
+ correctly by the caller.
+
+2005-05-24 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/env.test: added DYLD_FRAMEWORK_PATH to the list of env vars
+ that need to be handled specially.
+
+ * macosx/Makefile:
+ * macosx/README:
+ * macosx/Tcl-Info.plist.in (new file):
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * unix/tclUnixInit.c: moved all Darwin framework build support from
+ macosx/Makefile into the standard unix configure/make buildsystem, the
+ macosx/Makefile is no longer required to build Tcl.framework (but its
+ functionality is still available for backwards compatibility).
+ * unix/configure: autoconf-2.59
+
+ * generic/tclIOUtil.c (TclLoadFile):
+ * generic/tclInt.h:
+ * unix/tcl.m4:
+ * unix/tclLoadDyld.c: added support for [load]ing .bundle binaries in
+ addition to .dylib's: .bundle's can be [unload]ed (unlike .dylib's),
+ and can be [load]ed from memory, e.g. directly from VFS without needing
+ to be written out to a temporary location first. [Bug 1202209]
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * generic/tclCmdMZ.c (Tcl_TimeObjCmd): change [time] called with a
+ count > 1 to return a string with a float value instead of a rounded
+ off integer. [Bug 1202178]
+
+ * doc/expr.n:
+ * doc/string.n: fixed roff syntax complaints from 'make html'.
+
+2005-05-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Corrected parser to recognize all
+ boolean literals accepted by Tcl_GetBoolean, including prefixes like
+ "y" and "f", and to allow "eq" and "ne" as function names in the proper
+ context. [Bug 1201589].
+
+2005-05-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (TclEvalObjvInternal): Rewrite for greater
+ clarity; although 'goto' is Bad, the contortions you have to go through
+ to avoid it can be worse...
+
+2005-05-19 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): fixed crashing CFRelease
+ of runLoopSource in Tcl_InitNotifier (reported by Zoran):
+ CFRunLoopAddSource doesn't CFRetain, so can only CFRelease the
+ runLoopSource in Tcl_FinalizeNotifier.
+
+2005-05-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_ExprBoolean): Rewrite as wrapper around
+ Tcl_ExprBooleanObj.
+
+ * generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite dropping
+ string-based Tcl_GetBoolean call, so that internal reps are kept for
+ subsequent quick boolean operations.
+
+ * generic/tclExecute.c: Dropped most special handling of the "boolean"
+ Tcl_ObjType, since that type should now be rarely encountered.
+
+ * doc/BoolObj.3: Rewrite of documentation dropping many details
+ about the internals of Tcl_Objs. Shorter documentation focuses on the
+ function and use of the routines.
+
+ * generic/tclInt.h: Revision to the "boolean" Tcl_ObjType, so that
+ * generic/tclObj.c: only string values like "yes" and "false" are
+ * tests/obj.test: kept as the "boolean" Tcl_ObjType. The string
+ values "0" and "1" are kept as "int" Tcl_ObjType, which also produce
+ quick calls to Tcl_GetBooleanFromObj(). Since this internal change
+ means a Tcl_ConvertToType to a "boolean" Tcl_ObjType might not produce
+ a Tcl_Obj of type "boolean", the registration of the "boolean" type is
+ also removed.
+ ***POTENTIAL INCOMPATIBILITY***
+ For callers of Tcl_GetObjType on the type name "boolean".
+
+2005-05-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclObj.c (TclInitObjSubsystem): Removed the
+ * tests/listObj.test: registration of the Tcl_ObjType's "list",
+ * tests/obj.test: "procbody", "index", "ensembleCommand",
+ "localVarName", and "levelReference". The only reason to register a
+ Tcl_ObjType is to have it returned by Tcl_GetObjType, and the only
+ reason for that is to retrieve a (Tcl_ObjType *) to pass to
+ Tcl_ConvertToType(). None of the types above can support a
+ Tcl_ConvertToType() call; they panic. Better not to offer something
+ than to lead users into a panic.
+ ***POTENTIAL INCOMPATIBILITY***
+ For callers of Tcl_GetObjType on the type names listed above.
+
+2005-05-15 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ * win/tclWin32Dll.c: conditioned definition of EXCEPTION_REGISTRATION
+ structures on HAVE_NO_SEH, to fix a bug in buildability on MSVC.
+
+2005-05-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclInt.decls:
+ * generic/tclTest.c:
+ * generic/tclUtil.c:
+ * win/tclWin32Dll.c: fixed link error due to direct access by tclTest.c
+ to the MODULE_SCOPE tclPlatform global: renamed existing
+ TclWinGetPlatform() accessor to TclGetPlatform() and moved it to
+ generic code so that it can be used by on all platforms where
+ MODULE_SCOPE is enforced.
+
+ * macosx/tclMacOSXBundle.c:
+ * unix/tclUnixInit.c:
+ * unix/tcl.m4 (Darwin): made use of CoreFoundation API configurable and
+ added test of CoreFoundation availablility to allow building on ppc64,
+ replaced HAVE_CFBUNDLE by HAVE_COREFOUNDATION; test for availability of
+ Tiger or later OSSpinLockLock API.
+
+ * unix/tclUnixNotfy.c:
+ * unix/Makefile.in:
+ * macosx/tclMacOSXNotify.c (new file): when CoreFoundation is
+ available, use new CFRunLoop based notifier: allows easy integration
+ with other event loops on Mac OS X, in particular the TkAqua Carbon
+ event loop is now integrated via a standard tcl event source (instead
+ of TkAqua upon loading having to finalize the exsting notifier and
+ replace it with its custom version). [Patch 1202052]
+
+ * tests/unixNotfy.test: don't run unthreaded tests on Darwin since
+ notifier may be using threads even in unthreaded core.
+
+ * unix/tclUnixPort.h:
+ * unix/tcl.m4 (Darwin): test for thread-unsafe realpath during
+ configure, as Darwin 7 and later realpath is threadsafe.
+
+ * macosx/Makefile: enable configure caching.
+
+ * unix/configure.in: wrap tclConfig.h header in #ifndef _TCLCONFIG so
+ that it can be included more than once without warnings from gcc4.0 (as
+ happens e.g. when including both tclInt.h and tclPort.h)
+
+ * macosx/tclMacOSXBundle.c:
+ * unix/tclUnixChan.c:
+ * unix/tclLoadDyld.c:
+ * unix/tclUnixInit.c: fixed gcc 4.0 warnings.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c: make genstubs
+
+2005-05-13 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclWin32Dll.c: Further rework of the SEH logic. All
+ EXCEPTION_REGISTRATION records are now in the activation record rather
+ than pushed on the stack.
+
+2005-05-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Dropped the TCL_NO_MATH configuration. It's
+ * generic/tclBinary.c: believed this has not been working in a long
+ * generic/tclExecute.c: time. Tcl needs math.h. [RFE 1200680]
+ * unix/Makefile.in:
+
+2005-05-12 Kevin Kenny <kennykb@acm.org>
+
+ * doc/mathfunc.n: Changed NAME line to match the name of the page.
+
+2005-05-11 Kevin Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Resynchronized with the HEAD; at this
+ checkpoint [-rkennykb-numerics-branch-20050511], the HEAD and
+ kennykb-numerics-branch contain identical code.
+
+2005-05-11 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c (TclStrToD, RefineResult, ParseNaN): Changed the
+ code to cast 'char' to UCHAR explicitly when using ctype macros, to
+ silence complaints from the Solaris compiler.
+
+2005-05-10 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly
+ compliant compilers that don't like trailing ,s.
+
+ * tests/string.test: string-10.[21-30]
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to prevent
+ possible UMR in unichar cmp function for string map.
+
+2005-05-10 Kevin Kenny <kennykb@acm.org>
+
+ * generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's resulted
+ in reads of uninitialized memory when using 'd', 'q', or 'Q' format.
+ * generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to handle
+ the peculiarities of HP's PA_RISC, which uses a different 'quiet' bit
+ in NaN from everyone else.
+ * libtommath/tommath_superclass.h: Corrected C++-style comment.
+
+2005-05-10 Kevin Kenny <kennykb@acm.org>
+
+ Merged all changes on kennykb-numerics-branch back into the HEAD.
+ TIP's 132 and 232 are now Final.
+
+2005-05-10 Kevin Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged changes from HEAD.
+
+2005-05-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (ExponLong, ExponWide):
+ * tests/expr.test (expr-23.34/35): fixed special case 'i**0' for i>0
+ [Bug 1198892]
+
+2005-05-09 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+ * win/tclWin32Dll.c (TclpCheckStackSpace, TclWinCPUID): Reworked
+ structured event handling to function even with -fomit-frame-pointers.
+
+2005-05-08 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+ * generic/tclStrToD.c: Made code more portable by finding a workaround
+ for MSVC's 'volatile' issue that does not require conditional
+ compilation.
+ * win/tclWin32Dll.c (TclWinCPUID): Removed structured event handling
+ from the GCC code since (a) bad code is generated by the instruction
+ scheduling with -O2, and (b) it's not needed on any reasonably modern
+ CPU.
+
+2005-05-07 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+ * generic/tclEvent.c: Moved initialization of tclStrToD.c's
+ * generic/tclInt.h: static constants into a procedure called
+ * generic/tclStrToD.c: from TclInitSubsystems to avoid double checked
+ locking protocol. Cleaned up an issue where MSVC ignored the
+ 'volatile' specifier, causing incorrect comparison of an underflowed
+ number against zero.
+
+2005-05-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and add
+ support for x86_64 Solaris cc builds.
+
+2005-05-05 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged with HEAD.
+
+2005-05-05 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWinThrd.c: Corrected a compilation error on the
+ --enable-threads configuration.
+
+2005-05-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decls: Converted TclMatchIsTrivial to a macro.
+ * generic/tclInt.h:
+ * generic/tclUtil.c:
+ * generic/tclIntDecls.h: `make genstubs`
+ * generic/tclStubInit.c:
+ * generic/tclBasic.c: Added callers of TclMatchIsTrivial where a
+ * generic/tclCmdIL.c: search can be done more efficiently when it is
+ * generic/tclCompCmds.c:recognized that a pattern match is really an
+ * generic/tclDictObj.c: exact match. [Patch 1076088]
+ * generic/tclIO.c:
+ * generic/tclNamesp.c:
+ * generic/tclVar.c:
+
+ * generic/tclCompCmds.c: Factored common efficiency trick into a
+ macro named CompileWord.
+
+ * generic/tclCompCmds.c: Replaced all instance of
+ * generic/tclCompile.c: TCL_OUT_LINE_COMPILE with TCL_ERROR.
+ * generic/tclInt.h: Now that we've eradicated the mistaken
+ * tests/appendComp.test: notion of a "compile-time error", we
+ can use the TCL_ERROR return code to signal any failure to produce
+ bytecode.
+
+2005-05-03 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/DString.3: Eliminated use of identifier "string" in Tcl's
+ * doc/Environment.3: public C API to avoid conflict/confusion with
+ * doc/Eval.3: the std::string of C++.
+ * doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3:
+ * doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3:
+ * doc/Utf.3, generic/tcl.decls, generic/tclBasic.c, generic/tclEnv.c:
+ * generic/tclGet.c, generic/tclParse.c, generic/tclParseExpr.c:
+ * generic/tclRegexp.c, generic/tclResult.c, generic/tclUtf.c:
+ * generic/tclUtil.c, unix/tclUnixChan.c:
+
+ * generic/tclDecls.h: `make genstubs`
+
+2005-05-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.decls:
+ * generic/tclBasic.c: Simplified implementation of Tcl_ExprString.
+ * tests/expr-old.test:
+
+ * generic/tclDecls.h: `make genstubs`
+
+2005-04-30 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes.
+
+2005-04-29 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#176 IMPLEMENTATION [Patch 1165695]
+
+ * generic/tclUtil.c: Extended TclGetIntForIndex to recognize index
+ formats including end+integer and integer+/-integer.
+
+ * generic/tclCmdMZ.c: Extended the -start switch of [regexp] and
+ [regsub] to accept all index formats known by TclGetIntForIndex.
+
+ * doc/lindex.n: Updated docs to note new index formats.
+ * doc/linsert.n, doc/lrange.n, doc/lreplace.n, doc/lsearch.n:
+ * doc/lset.n, doc/lsort.n, doc/regexp.n, doc/regsub.n, doc/string.n:
+
+ * tests/cmdIL.test: Updated tests.
+ * tests/compile.test, tests/lindex.test, tests/linsert.test:
+ * tests/lrange.test, tests/lreplace.test, tests/lsearch.test:
+ * tests/lset.test, tests/regexp.test, tests/regexpComp.test:
+ * tests/string.test, tests/stringComp.test, tests/util.test:
+
+2005-04-28 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/unixInit.test (7.1): Alternative fix for the 2004-11-11 commit.
+
+2005-04-27 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl: Corrected flaw in interactive command
+ * tests/main.test: auto-completion. [Bug 1191409].
+
+ TIP#183 IMPLEMENTATION [Patch 577093]
+
+ * generic/tclIOUtil.c (TclGetOpenModeEx): New routine.
+ * generic/tclInt.h:
+
+ * generic/tclIO.c (Tcl_OpenObjCmd): Support for "b" and
+ * doc/open.n: "BINARY" in "access" argument to [open].
+ * tests/ioCmd.test:
+
+2005-04-26 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ * generic/tclBinary.c (FormatNumber): Dredge the NaN out of the
+ internal representation if Tcl_GetDoubleFromObj returns TCL_ERROR on a
+ NaN.
+
+ * generic/tclObj.c (Tcl_GetDoubleFromObj): Restored silent
+ overflow/underflow behaviour that the merge of 2004-04-25 messed up.
+ Thanks to Don Porter for calling attention to this bug. Also removed an
+ uninitialised memory reference in this function that valgrind caught.
+ Also changed to return TCL_ERROR on a pure NaN.
+
+ * generic/tclStrToD.c (RefineResult): Added a test for the initial
+ approximation being HUGE_VAL; this test avoids EDOM being returned from
+ ldexp on some platforms on input values exceeding the floating point
+ range.
+
+ * tests/expr.test (expr-29.*, expr-30.*): Added further tests of
+ overflow/underflow on input conversions.
+
+2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ [kennykb-numerics-branch] Merged with HEAD.
+
+ * doc/CrtMathFunc.n: Revised documentation for TIP 232
+
+2005-04-25 Daniel Steffen <das@users.sourceforge.net>
+
+ * compat/string.h: fixed memchr() protoype for __APPLE__ so that we
+ build on Mac OS X 10.1 again.
+
+ * generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being
+ finalized in unthreaded core (was testing for notifier initialization
+ in current thread by checking thread id != 0 but thread id is always 0
+ in untreaded core).
+
+ * win/tclWinNotify.c (Tcl_WaitForEvent):
+ * unix/tclUnixNotfy.c (Tcl_WaitForEvent): don't call ScaleTimeProc for
+ zero wait times (as specified in TIP 233).
+
+ * unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS
+ from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS.
+
+ * unix/tcl.m4 (Darwin): added configure checks for recently added
+ linker flags -single_module and -search_paths_first to allow building
+ with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD
+ and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of
+ symbols from libtclstub to avoid duplicate symbol warnings, added
+ PLAT_SRCS definition for Mac OS X, defined MODULE_SCOPE to
+ __private_extern__.
+ (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check.
+
+ * unix/configure: autoconf-2.59
+
+2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ * library/tzdata/America/Boise:
+ * library/tzdata/America/Chicago:
+ * library/tzdata/America/Denver
+ * library/tzdata/America/Indianapolis:
+ * library/tzdata/America/Los_Angeles:
+ * library/tzdata/America/Louisville:
+ * library/tzdata/America/Managua:
+ * library/tzdata/America/New_York:
+ * library/tzdata/America/Phoenix:
+ * library/tzdata/America/Port-au-Prince:
+ * library/tzdata/America/Indiana/Knox:
+ * library/tzdata/America/Indiana/Marengo:
+ * library/tzdata/America/Indiana/Vevay:
+ * library/tzdata/America/Kentucky/Monticello:
+ * library/tzdata/America/North_Dakota/Center:
+ * library/tzdata/Asia/Tehran:
+ Olson's tzdata2005i. Corrects exact time at which Standard Time was
+ adopted in the US (generally, noon, Standard Time, rather than noon,
+ Local Mean Time). Adopts new civil rules for Nicaragua and Iran.
+
+2005-04-25 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl: Use "ni" and "in" operators.
+
+2005-04-25 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fix for [Bug 1189274].
+
+2005-04-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclLiteral.c: Silence compiler warnings.
+ * generic/tclObj.c: [Bug 1188863].
+
+2005-04-22 Don Porter <dgp@users.sourceforge.net>
+
+ The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring it
+ into agreement with its docs. Further investigation reveals it was the
+ docs that were incorrect.
+
+ * doc/BoolObj.3: Corrections to the documentation of
+ Tcl_GetBooleanFromObj to bring it into agreement with what this public
+ interface has always done, including noting the difference in function
+ between Tcl_GetBooleanFromObj and Tcl_GetBoolean.
+
+ * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a
+ wrapper around Tcl_GetBooleanFromObj (different function!).
+
+ * generic/tclObj.c: Removed TclGetTruthValueFromObj routine that
+ was added yesterday. Revisions so that only Tcl_GetBoolean-approved
+ values get the "boolean" Tcl_ObjType. This retains the fix for [Bug
+ 1187123].
+ * tests/string.test: Test string-23.0 for Bug 1187123.
+
+ * generic/tclInt.h: Revert most recent change.
+ * generic/tclBasic.c:
+ * generic/tclCompCmds.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * tests/obj.test:
+
+2005-04-21 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/GetInt.3: Convert argument "string" to "str" to agree with code.
+ Also clarified a few details on int and double formats.
+ * generic/tclGet.c: Radical code simplification. Converted
+ Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj(). Reduces
+ code duplication, and the resulting potential for inconsistency.
+
+ * generic/tclObj.c: Several changes:
+
+ - Re-ordered error detection code so all values with trailing garbage
+ receive a "not an integer" message instead of an "integer too large"
+ message.
+ - Removed inactive code meant to deal with strtoul* routines that fail
+ to parse leading signs. All of them do, and if any are detected that
+ do not, the correct fix is replacement with compat/strtoul*.c, not a
+ lot of special care by the callers.
+ - Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep.
+ - Fixed Tcl_GetBooleanFromObj to agree with its documentation and with
+ Tcl_GetBoolean, accepting only "0" and "1" and not other numeric
+ strings. [Bug 1187123]
+ - Added new private routine TclGetTruthValueFromObj to perform the more
+ permissive conversion of numeric values to boolean that is needed by
+ the [expr] machinery.
+
+ * generic/tclInt.h (TclGetTruthValueFromObj): New routine.
+ * generic/tclExecute.c: Updated callers to call new routine.
+ * generic/tclBasic.c: Updated callers to call new routine.
+ * generic/tclCompCmds.c: Updated callers to call new routine.
+ * generic/tclDictObj.c: Updated callers to call new routine.
+ * tests/obj.test: Corrected bad tests that actually expected
+ values like "47" and "0xac" to be accepted as booleans.
+
+ * generic/tclLiteral.c: Disabled the code that forces some literals
+ into the "int" Tcl_ObjType during registration. We can re-enable it if
+ this change causes trouble, but it seems more sensible to let Tcl's
+ "on-demand" shimmering rule, and not try to pre-guess things.
+
+2005-04-20 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+ * doc/expr.n:
+ * doc/mathfunc.n (new file): Revised documentation for TIP 232
+
+2005-04-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclGet.c (Tcl_GetInt): Corrected error that did not
+ * generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be
+ recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869].
+
+2005-04-20 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclFileName.c: Silenced a compiler warning about '/*' within
+ a comment.
+
+2005-04-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Added unsupported command
+ * generic/tclCmdAH.c: [::tcl::unsupported::EncodingDirs] to permit
+ * generic/tclInt.h: query/set of the encoding search path at
+ * generic/tclInterp.c: the script level. Updated init.tcl to make
+ * library/init.tcl: use of the new command. Also updated several
+ coding practices in init.tcl ("eq" for [string equal], etc.)
+
+2005-04-19 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (Initialize): Put initialization code into a proc
+ to avoid inadvertently clobbering global variables. [Bug 1185933]
+ * tests/clock.test (clock-48.1): Added regression test for the above
+ bug.
+ Thanks to Ulrich Ring for reporting this bug.
+
+2005-04-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/Var.c (Tcl_ArrayObjCmd - ARRAY_NAMES): fix Tcl_Obj leak. [Bug
+ 1084111]
+
+2005-04-16 Zoran Vasiljevic <vasiljevic@users.sf.net>
+
+ * generic/tclIOUtil.c: force clenaup of the interp result in
+ TclLoadFile(). Some implementations of TclpFindSymbol() will seed the
+ interp result with error message when unable to find the requested
+ symbol (this is not considered to be an error).
+
+ Set of changes correcting huge memory waste (not a leak) when a thread
+ exits. This has been introduced in 8.4.7 within an attempt to correctly
+ cleanup after ourselves when Tcl library is being unloaded with the
+ Tcl_Finalize() call.
+
+ This fixes the [Bug 1178445]
+
+ * generic/tclInt.h: added prototypes for TclpFreeAllocCache() and
+ TclFreeAllocCache()
+
+ * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() to
+ explicitly call TclpFreeAllocCache with the NULL-ptr as argument
+ signalling cleanup of private tsd key used only by the threading
+ allocator.
+
+ * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize when
+ being called with NULL argument. This is a signal for it to clean up
+ the tsd key associated with the threading allocator.
+
+ * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache
+ and fixed to recognize when being called with NULL argument. This is a
+ signal for it to clean up the tsd key associated with the threading
+ allocator.
+
+2005-04-13 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/unixInit.test: Disabled obsolete tests and removed code
+ * tests/encoding.test: that supported them.
+ * generic/tclInterp.c:
+
+ * library/init.tcl: Use auto-loading to bring in Tcl Module support
+ * library/tclIndex: as needed. This reduces startup time by
+ * library/tm.tcl: delaying this initialization to a later time.
+
+2005-04-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: missing semicolons caused failure to compile
+ with TCL_COMPILE_DEBUG.
+
+2005-04-13 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit
+ * tests/io.test: changed from ten bytes to one byte. Need for
+ * tests/iogt.test: this change was proven by Ross Cartlidge
+ <rossc@cisco.com> where [read stdin 1] was grabbing 10 bytes followed
+ by starting a child process that was intended to continue reading from
+ stdin. Even with -buffersize set to one, nine chars were getting lost
+ by the buffersize over reading for the native read() caused by [read].
+
+2005-04-13 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/tclUnixInit.c (TclpGetEncodingNameFromEnvironment): Reversed
+ order of verifying candidate [encoding system] value, checking against
+ a table in memory first before calling Tcl_GetEncoding and potentially
+ scanning through the filesystem. Also ordered the table so that a
+ binary search could be used within it. Improves startup time a bit more
+ on some systems.
+
+2005-04-13 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.n: Added a missing '--' on several [switch] commands to
+ improve performance of [clock format] and related operations. [FRQ
+ 1182459]
+
+2005-04-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/fcopy.n: Improved documentation on copying binary files, added an
+ example and mentioned the use of [file copy].
+ * doc/fconfigure.n: Improved documentation of -encoding binary option.
+ This is all following comments from Steve Manning <steve@manning.net>
+ on comp.lang.tcl that the current documentation was not clear.
+
+2005-04-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c:Commented out the functions
+ TclPrintInstruction(), TclPrintObject() and TclPrintSource() when not
+ debugging the compiler, as they are never called in that case.
+
+2005-04-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInterp.c: Corrected bad syntax of Tcl_Panic() call.
+
+ * generic/tclUtil.c (TclGetProcessGlobalValue): More robust handling
+ of bad TclInitProcessGlobalValueProc behavior; an immediate panic
+ rather than a mysterious crash later.
+
+ * generic/tclEncoding.c: Several changes to the way the
+ encodingFileMap cache is maintained. Previously, it was attempted to
+ keep the file map filled and up to date with changes in the encoding
+ search path. This contributed to slow startup times since it required
+ an expensive "glob" operation to fill the cache. Now the validity of
+ items in the cache are checked at the time they are used, so the cache
+ is permitted to fall out of sync with the encoding search path. Only
+ [encoding names] and Tcl_GetEncodingNames() now pay the full expense.
+ [Bug 1177363]
+
+2005-04-12 Kevin B. Kenny <kennykb@acm.org>
+
+ * compat/strstr.c: Added default definition of NULL to accommodate
+ building on systems with badly broken headers. [Bug 1175161]
+
+2005-04-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tools/tclZIC.tcl: Rewrote to take advantage of more features of Tcl
+ 8.5 (on which it was dependent anyway). Also added a [package require]
+ line to formalize the relationship.
+
+2005-04-11 Kevin Kenny <kennykb@users.sf.net>
+
+ [kennykb-numerics-branch] Merged with HEAD. Updated to libtommath 0.35.
+
+ * generic/tclBasic.c: Attempted to repeat changes that applied to
+ tclExecute.c in Miguel Sofer's commit of 2005-04-01, together with
+ (possibly) a few more uses of his new object creation macros. Also
+ plugged a memory leak in TclObjInvoke. [Bug 1180368]
+
+2005-04-10 Kevin Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Montevideo:
+ * library/tzdata/Asia/Almaty:
+ * library/tzdata/Asia/Aqtau:
+ * library/tzdata/Asia/Aqtobe:
+ * library/tzdata/Asia/Baku:
+ * library/tzdata/Asia/Jerusalem:
+ * library/tzdata/Asia/Oral:
+ * library/tzdata/Asia/Qyzylorda:
+ * library/tzdata/Indian/Chagos:
+ * library/tzdata/Indian/Cocos: Olson's tzdata2005h
+
+2005-04-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclObjInvoke): Plug memory leak. [Bug 1180368]
+
+2005-04-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fix possible leak of expansion Tcl_Objs
+
+2005-04-09 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/README: updated requirements for OS & developer tool versions
+ and other small fixes/cleanup.
+
+ * generic/tclListObj.c (Tcl_ListObjIndex): added missing NULL return
+ when getting index from an empty list.
+
+ * unix/tcl.m4 (Darwin): added -single_module linker flag to
+ TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS.
+ * unix/configure: autoconf-2.59
+
+2005-04-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h (TclGetEncodingFromObj): New function to
+ * generic/tclEncoding.c (TclGetEncodingFromObj): retrieve a
+ Tcl_Encoding value, as well as cache it in the internal rep of a new
+ "encoding" Tcl_ObjType.
+ * generic/tclCmdAH.c (Tcl_EncodingObjCmd): Updated to call new
+ function so that Tcl_Encoding's used by [encoding convert*] routines
+ are not freed too quickly. [Bug 1077262]
+
+2005-04-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Rewritten to be able to
+ handle the other form of [switch] and generate slightly simpler (but
+ longer) code.
+
+2005-04-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/upvar.n, doc/unset.n, doc/tell.n, doc/tclvars.n, doc/subst.n:
+ * doc/seek.n, doc/scan.n, doc/regsub.n, doc/registry.n, doc/regexp.n:
+ * doc/read.n, doc/puts.n, doc/pkgMkIndex.n, doc/open.n, doc/lreplace.n:
+ * doc/lrange.n, doc/load.n, doc/llength.n, doc/linsert.n, doc/lindex.n:
+ * doc/lappend.n, doc/info.n, doc/gets.n, doc/format.n, doc/flush.n:
+ * doc/fileevent.n, doc/file.n, doc/fblocked.n, doc/close.n:
+ * doc/array.n, doc/Utf.3, doc/TraceVar.3, doc/StrMatch.3, doc/RegExp.3:
+ * doc/PrintDbl.3, doc/OpenTcp.3, doc/OpenFileChnl.3, doc/Object.3:
+ * doc/Notifier.3, doc/LinkVar.3, doc/IntObj.3, doc/Interp.3:
+ * doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3, doc/CrtMathFnc.3:
+ * doc/CrtFileHdlr.3, doc/CrtCommand.3, doc/CrtChannel.3:
+ * doc/Backslash.3: Purge old .VS/.VE macro instances.
+
+ * tools/man2html2.tcl (IPmacro): Rewrote to understand what .IP really
+ is (.IP and .TP are really just two ways of doing the same thing).
+ Change below made this relevant.
+ * doc/re_syntax.n: Change some uses of .TP to .IP to work around bugs
+ in various *roff implementations. Also reworded the atom descriptions
+ slightly.
+
+2005-04-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (ExprSrandFunc): Replaced incursions into the
+ * generic/tclUtil.c (TclGetIntForIndex): intreps of numeric types with
+ simpler calls of Tcl_GetIntFromObj and Tcl_GetLongFromObj, now that
+ those routines are better behaved wrt shimmering. [Patch 1177219]
+
+2005-04-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclObj.c: Change in TclDecrRefCount and TclFreeObj, to speed
+ up the freeing of simple Tcl_Obj [Patch 1174551]
+
+2005-04-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: small opts in obj handling
+
+2005-04-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: converted a few function calls to macros.
+
+2005-04-01 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/ListObj.3:
+ * generic/tclBasic.c:
+ * generic/tclCmdIL.c:
+ * generic/tclConfig.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclListObj.c:
+ * generic/tclStubInit.c:
+ * generic/tclVar.c: Changed the internal representation of lists to
+ (a) reduce the malloc/free calls at list creation (from 2 to 1), (b)
+ reduce the cost of handling empty lists (we now never create a list
+ internal rep for them), (c) allow refcounting of the list internal rep.
+ The latter permits insuring that the pointers returned by
+ Tcl_ListObjGetElements remain valid even if the object shimmers away
+ from its original list type. This is [Patch 1158008]
+
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclObj.c:
+ * generic/tclStringObj.c:
+ (1) defined new internal macros for creating and setting frequently
+ used obj types (int,long, wideInt, double, string). Changed TEBC to use
+ eg 'TclNewIntObj(objPtr, i)' to avoid the function call in 'objPtr =
+ Tcl_NewIntObj(i)'
+ (2) ExecEnv now stores two Tcl_Obj* pointing to the constants "0" and
+ "1", for use by TEBC.
+ (3) slight reduction in cost of INST_START_CMD
+
+2005-03-31 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_JUMP_TRUE/FALSE): replaced "test and
+ branch" with "compute index into table"
+
+2005-03-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/FileSystem.3: Defined loadHandle argument. [Bug 1172401]
+
+2005-03-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tcl.m4, win/configure: do not require cygpath in macros to allow
+ msys alone as an alternative.
+
+2005-03-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.h: Move the TclInterpReady() declaration from
+ * generic/tclInt.h: tclCompile.h to tclInt.h. Should have been done
+ as part of the 1115904 bug fix on 2005-03-18.
+
+ * generic/tclThreadTest.c: Stop providing the phony package
+ "Thread 1.0" when the [::testthread] command is defined. It's never
+ used by anything, and conflicts with loading the real "Thread" package.
+
+2005-03-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompCmds.c (TclCompileIncrCmd): Corrected checks for
+ immediate operand usage to permit leading space and sign characters.
+ Restores more efficient bytecode for [incr x -1] that got lost in the
+ CONST string reforms of Tcl 8.4. [Bug 1165671]
+
+ * generic/tclBasic.c (Tcl_EvalEx): Restored recursion limit
+ * generic/tclParse.c (TclSubstTokens): testing in nested command
+ * tests/basic.test (basic-46.4): substitutions within direct
+ * tests/parse.test (parse-19.*): script evaluation (Tcl_EvalEx)
+ that got lost in the parser reforms of Tcl 8.1. Added tests for correct
+ behavior. [Bug 1115904]
+
+2005-03-15 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c:
+ * win/tclWinFile.c:
+ * tests/winFCMd.test: fix to 'file pathtype' and 'file norm' failures
+ on reserved filenames like 'COM1:', etc.
+
+2005-03-15 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * unix/tcl.m4: Updated the OpenBSD configuration and regenerated
+ * unix/configure: the configure script.
+
+2005-03-15 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged with HEAD.
+
+ * generic/tclBasic.c (many):
+ * generic/tclCompExpr.c (CompileMathFuncCall):
+ * generic/tclCompile.h:
+ * generic/tclExecute.c (many):
+ * generic/tclParseExpr.c (ParsePrimaryExpr):
+ * tests/compExpr-old.test:
+ * tests/compExpr.test:
+ * tests/compile.test:
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/for.test:
+ * tests/parseExpr.test: Initial implementation of TIP #232.
+
+ * generic/tclObj.c (Tcl_DbNewBignumObj): Fixed typo that broke
+ --enable-symbols=mem build
+ * tests/binary.test (binary-40.3, binary-40.6): Corrected tests to
+ allow NaN(7ffffffffffff).
+
+2005-03-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fixed INST_PUSH1's debugging code (wrong obj
+ ref passed to TRACE_WITH_OBJ).
+
+2005-03-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: fixed INST_RETURN's stack effect in
+ tclInstructionTable (-1 instead of -2)
+
+2005-03-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c: removed debugging line
+
+2005-03-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTrace.c (TclCheckInterpTraces): Corrected mistaken cast
+ of ClientData to (TraceCommandInfo *) when not warranted. Thanks to
+ Yuri Victorovich for the report. [Bug 1153871]
+ * generic/tcl.h: Moved flag values TCL_TRACE_ENTER_EXEC and
+ * generic/tclInt.h: TCL_TRACE_LEAVE_EXEC from public interface into
+ private. Should be used only by internal workings of execution traces.
+
+2005-03-09 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged from HEAD.
+
+ * doc/PrintDbl.3:
+ * doc/tclVars.n: Documented new semantics for tcl_precision.
+ * generic/tclExecute.c (Tcl_ExecuteByteCode): Removed the check for
+ division-by-zero on IEEE-754 machines.
+ * generic/tclUtil.c (Tcl_PrintDouble): Corrected bug where numbers in
+ the range [1e-4 .. 1.) were printed incorrectly.
+ * tests/compExpr-old.test (compExpr-old-11.13): Revised test case for
+ division by zero.
+ * tests/expr-old.test (expr-34.11, expr-34.12): Revised test cases for
+ overflow in pow() to deal with infinities.
+ * tests/expr.test (expr-11.13, expr-29.1, expr-29.2): Revised test case
+ for division by zero and for underflow on input conversions.
+ * tests/parseExpr.test (parseExpr-16.11): Revised test case for
+ overflow on input conversion.
+ * tests/string.test (string-6.38 deleted): Removed test case for
+ underflow on input conversion, which is no longer an error.
+ * tests/util.test (util-10.*): Added test case for the bug in tclUtil.c
+
+2005-03-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/makefile.vc: clarify necessary defined vars that can come from
+ MSVC or the Platform SDK.
+
+2005-03-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/string.n: Minor typo. [Bug 1158247]
+
+2005-03-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: new peephole optimisation for INST_PUSH1; fixed
+ the peephole opt in INST_POP so that it is not used when
+ TCL_COMPILE_DEBUG is defined.
+
+2005-03-04 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclCmdMZ.c: Changed [scan] to treat out-of-range floating
+ point values as infinities and zeroes.
+ * generic/tclExecute.c: Changed [expr] to be permissive about
+ infinities, allowing them to propagate.
+ * generic/tclGet.c: Changed Tcl_GetDouble to be permissive about
+ over/underflow.
+ * generic/tclObj.c: Changed SetDoubleFromAny to be permissive about
+ over/underflow.
+ * generic/tclParseExpr.c: Made [expr] permissive about input numbers
+ out of range.
+
+2005-03-03 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclInt.h:
+ * generic/tclStrToD.c (Tcl_DoubleDigits, TclFormatNaN):
+ * generic/tclUtil.c (Tcl_PrintDouble): Changed the signature of
+ TclDoubleDigits so that it accepts a pointer to the signum of the
+ argument, and returns the signum via that pointer. Added very hacky
+ code to handle IEEE signed zeroes in Tcl_DoubleDigits. (It can't be
+ done other than as a hack until C9x; C89 simply doesn't deal with the
+ concept of -0.0). Added output conversion of tagged NaN values.
+ * generic/tclBinary.c (FormatNumber): Changed to allow [binary format]
+ to handle NaN.
+ * tests/binary.test (binary-60.1): Added a quick-n-dirty test to make
+ sure that NaN's can be scanned and formatted.
+ * generic/tclParseExpr.c (GetLexeme, ParseMaxDoubleLength): Modified so
+ that tagged NaN (e.g., NaN(DEADBEEF)) can be recognized.
+
+2005-03-02 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged with HEAD as of 2005-02-23.
+
+ * generic/tclExecute.c: Broadened test for NaN to work on Windows.
+ * generic/tclInt.h:
+ * generic/tclStrToD.c (Tcl_DoubleDigits):
+ * generic/tclUtil.c (Tcl_PrintDouble, TclPrecTraceProc): Added
+ Tcl_DoubleDigits to format 'double' numbers with the minimum number of
+ significant digits to yield correct rounding. Modified tcl_precision
+ to accept 0 as a precision (meaning "minimum digits"), and made 0 the
+ default. [TIP #132]
+ * generic/tclObj.c: Made NaN's throw an error in Tcl_GetDoubleFromObj.
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: Added libtommath/bn_mp_init_set.c to the build.
+ * libtommath/tommath.h (mp_iseven): Fixed a bug that caused zero to
+ test 'odd'.
+ * generic/tommath.h: Regenerated.
+ * tests/binary.test:
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/scan.test: Corrected a number of tests that depended on
+ tcl_precision, and removed the {eformat} condition from tests that no
+ longer require it.
+ * tests/util.test: Corrected a number of tests that depended on
+ tcl_precision, and removed the {eformat} condition from tests that no
+ longer require it. Added a series of tests for correct rounding in
+ Tcl_PrintDouble. [TIP #132].
+
+2005-03-01 David N. Welton <davidw@dedasys.com>
+
+ * doc/CrtSlave.3: Changed to Tcl_Object to Tcl_Obj in the man page.
+
+2005-02-24 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Better use of [glob -types] to avoid
+ * tests/tcltest.test: failed attempts to [source] a directory, and
+ similar matters. Thanks to "mpettigr". [Bug 1119798]
+
+ * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8
+ * unix/Makefile.in:
+ * win/Makefile.in:
+
+2005-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605]
+
+2005-02-17 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinFCmd.c (TraverseWinTree): use wcslen on wchar, not
+ Tcl_UniCharLen.
+
+2005-02-16 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/variable.n: fix for [Bug 1124160], variables are detected by
+ [info vars] but not by [info locals].
+
+2005-02-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined into
+ * unix/tcl.m4: SHLIB_LD). Combine AIX-* and AIX-5 branches in
+ * unix/configure: SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+
+ and HP-UX-11. autoconf-2.59 gen'd.
+
+2005-02-11 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/basic.test (basic-26.3): new test
+
+2005-02-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_EvalObjEx):
+ * tests/basic.test (basic-26.2): preserve the arguments passed to TEOV
+ in the pure-list branch, in case the list shimmers away. Fix for [Bug
+ 1119369], reported by Peter MacDonald.
+
+2005-02-10 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c: fix for test failures introduced on 2005-01-17
+ [Bug 1119092]
+
+2005-02-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/binary.n: Made the documentation of sign bit masking and [binary
+ scan] consistent. [Bug 1117017]
+
+2005-02-08 David N. Welton <davidw@dedasys.com>
+
+ * doc/CrtChannel.3: Typo: return->returns.
+
+2005-02-06 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclStrToD.c (TclStrToD, SafeLdExp): Added code to manage the
+ FPU precision on gcc+x86. Enabled fast conversion of floats with small
+ exponents now that precision is correct.
+ * tests/expr.test: Corrected test for the smallest representible value
+ to the right IEEE values.
+
+2005-02-06 David N. Welton <davidw@dedasys.com>
+
+ * doc/Thread.3: One-word grammar fix.
+
+2005-02-05 David N. Welton <davidw@dedasys.com>
+
+ * doc/Thread.3: Fixed sentence describing flags for Tcl_CreateThread.
+
+ * doc/FileSystem.3: Cleaned up typo in Tcl_FSNewNativePath
+ documentation.
+
+ * generic/tclPathObj.c: Cleaned up typo in comment.
+
+2005-02-03 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+
+ * generic/tclStrToD.c (TclStrToD, RefineResult, SafeLdExp): Added code
+ to ensure that 'ldexp' is never called with a value that will underflow
+ * tests/expr.test: Added tests for the smallest representible value,
+ and rounding between it and zero. (The tests reflect current
+ behaviour; plan is to change the specification of Tcl so that input
+ conversion of doubles underflows silently.)
+
+2005-02-02 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclProc.c (TclInitCompiledLocals): Add check for type of the
+ framePtr->procPtr->bodyPtr passed to TclInitCompiledLocals and panic if
+ it is not the correct type. If the body of the proc is not of the
+ compiled byte code type then the code will crash. This was discovered
+ while tracking down a crash in Itcl, that crash is fixed by Itcl patch
+ 1115085.
+
+2005-02-01 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Merged with HEAD as of today.
+
+ * generic/tclInt.decls: Changed numbers of new stubs to resolve a
+ conflict.
+ * generic/tclInt.h: Added new TclStrToD routine that replaces the
+ native 'strtod' throughout Tcl.
+ * generic/tclCmdMZ (Tcl_StringObjCmd):
+ * generic/tclGet.c (Tcl_GetDouble):
+ * generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny):
+ * generic/tclParseExpr.c (GetLexeme):
+ * generic/tclScan.c (Tcl_ScanObjCmd): Replaced all uses of the native
+ 'strtod' with a TclStrToD routine that performs correct rounding and
+ handles denormals.
+ * generic/tclStrToD.c: (new file)
+ New scanning function for extracting 'double' from a string that rounds
+ correctly, and handles denormals and infinities.
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc:
+ Added tclStrToD.c and the tommath routines that support it.
+
+ These changes represent a partial implementation of TIP #132. Output
+ conversion of floating point numbers, and proper handling of infinities
+ within expressions, still need to be addressed.
+
+2005-02-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (TclCompEvalObj): Removed stray statement left
+ behind in prior code reorganization.
+
+2005-01-31 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/configure: autoconf-2.57
+
+2005-01-30 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/configure.in: Restored two double-evals that were removed in the
+ DBGX purge; these are still needed on some platforms to account for
+ TCL_TRIM_DOTS. [Bug 1112654]
+
+ * unix/configure: NOT REGENERATED: only have autoconf 2.59 here, need
+ to find someone with autoconf 2.57.
+
+2005-01-28 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure, unix/tcl.m4: add solaris 64-bit gcc build support.
+ [Bug 1021871]
+
+2005-01-28 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/expr-old.test (expr-old-37.2): Added test for [Bug 1109484]
+
+2005-01-27 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble)
+ (Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484]
+
+2005-01-26 Andreas Kupries <andreask@activestate.com>
+
+ TIP#218 IMPLEMENTATION
+
+ * generic/tclDecls.h: Regenerated from tcl.decls.
+ * generic/tclStubInit.c:
+
+ * doc/CrtChannel.3: Documentation of extended API,
+ * generic/tcl.decls: extended testsuite, and
+ * generic/tcl.h: implementation. Removal of old
+ * generic/tclIO.c: driver-specific TclpCut/Splice
+ * generic/tclInt.h: functions. Replaced with generic
+ * tests/io.test: thread-action calls through the
+ * unix/tclUnixChan.c: new hooks. Update of all builtin
+ * unix/tclUnixPipe.c: channel drivers to version 4.
+ * unix/tclUnixSock.c: Windows drivers extended to
+ * win/tclWinChan.c: manage thread state in a thread
+ * win/tclWinConsole.c: action handler.
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c:
+ * win/tclWinSock.c:
+
+2005-01-25 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: Updated [auto_reset] to clear auto-loaded
+ commands in namespaces other than :: and to clear auto-loaded commands
+ that do not happen to be procs. [Bug 1101670]
+ ***POTENTIAL INCOMPATIBILITY***
+
+2005-01-25 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic
+ library in /usr/lib etc instead of linking to static library earlier in
+ search path. [Bug 956908] Removed obsolete references to Rhapsody.
+ * unix/configure: autoconf-2.57
+
+2005-01-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclStubInit.c: Regenerated the stubs support code from the
+ * generic/tclDecls.h: modified tcl.decls (TIP #233, see below).
+
+ * doc/GetTime.3: Implemented TIP #233, i.e. the
+ * generic/tcl.decls: 'Virtualization of Tcl's Sense of Time'.
+ * generic/tcl.h: Declared, implemented, and documented the
+ * generic/tclInt.h: specified new API functions. Moved the
+ * unix/tclUnixEvent.c: native (OS) access to time information
+ * unix/tclUnixNotfy.c: into standard handler functions. Inserted
+ * unix/tclUnixTime.c: hooks calling on the handlers where native
+ * win/tclWinNotify.c: access was done before, and where scaling
+ * win/tclWinTime.c: between domains (real/virtual) is required.
+
+2005-01-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclThread.c: Typo police. Fixed some nits
+ * generic/tclCmdAH.c: in header comments of functions.
+ * generic/tclBasic.c: (Missing --).
+ * generic/tclFileName.c:
+
+2005-01-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/FileSystem.3: Add missing ARGUMENTS section definitions for
+ arguments to Tcl_FSLink. [Bug 1106272]
+
+2005-01-21 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch]
+
+ * unix/Makefile.in: Updated Makefile to build libtommath on Unix as
+ well as Windows. [Bug 1106865]
+
+ * generic/tclTestObj.c (TestbignumobjCmd): Silenced a compiler warning
+ about a mismatched 'const'.
+
+2005-01-20 Kevin B. Kenny <kennykb@acm.org>
+
+ [kennykb-numerics-branch] Development checkpoint.
+
+ * compat/strtoll.c: Reverted to HEAD.
+ * compat/strtoull.c:
+ * doc/Ensemble.3:
+ * generic/tclBasic.c:
+ * generic/tclCmdIL.c:
+ * generic/tclNamesp.c:
+ * generic/tclPathObj.c:
+ * generic/tclPort.h:
+ * unix/configure:
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * win/configure:
+ * win/configure.in:
+ * win/rules.vc:
+ * win/tcl.m4:
+
+ * generic/tcl.h: Added declarations for bignum types, and for a
+ 'bignumValue' in the Tcl_Obj structure.
+ * generic/tclInt.h: Added declarations of interface procedures for
+ memory allocation in libtommath.
+
+ * generic/tcl.decls: Added new interface to bignum objects.
+ * generic/tclInt.decls: Added internal stubs for bignum routines used
+ by the test code in tclTestObj.c.
+
+ * generic/tclDecls/h: Regen.
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.h:
+
+ * tools/fix_tommath_h.tcl: (New file) Script to edit
+ libtommath/tommath.h and produce generic/tommath.h so that storage
+ classes, allocation routines, and data types conform to Tcl's
+ conventions.
+ * generic/tommath.h: (New file) Generated by the above.
+
+ * generic/tclTomMath.h: (New file) Additional declarations to be
+ included in tommath.h when building Tcl.
+
+ * generic/tclTomMathInterface.c: (New file) Small 'glue' routines
+ adapting tommath's API to Tcl.
+
+ * libtommath/bn_fast_s_mp_mul_digs.c:
+ * libtommath/bn_mp_mul_d.c:
+ * libtommath/bn_mp_read_radix.c:
+ * libtommath/tommath.h: Applied suggested changes from Tom St Denis
+ that correct an off-by-one error in single-digit multiplication
+ (leading to a pointer smash if uncorrected) and change the string
+ argument to 'mp_read_radix' from 'char*' to 'const char*'.
+
+ * libtommath/bn_mp_radix_size.c: Local patch to ensure that sufficient
+ memory is requested even if the number has a single digit.
+
+ * libtommath/bn_mp_read_radix.c: Local patch to return MP_VAL if the
+ input string contains an invalid character.
+
+ * generic/tclObj.c: Added accessor functions for bignums.
+ * generic/tclTestObj.c: Added a 'testbignumobj' command to exercise the
+ accessor functions for bignums.
+
+ * win/Makefile.in: Added rules for making libtommath.
+
+2005-01-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ TIP#235 IMPLEMENTATION
+
+ * doc/Ensemble.3: Documentation for the new public API.
+ * generic/tclNamesp.c (Tcl_CreateEnsemble,...): Rename of
+ * generic/tcl.decls: existing API into TIPped form.
+
+2005-01-19 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/tclWinChan.c (FileCloseProc): Invoke TclpCutFileChannel() to
+ remove a FileInfo from the thread local list before deallocating it.
+ This should have been done via an earlier call to Tcl_CutChannel, but I
+ was running into a crash in the next call to Tcl_CutChannel during the
+ I/O finalization stage.
+
+2005-01-18 Kevin Kenny <kennykb@acm.org>
+
+ * library/tzdata/GMT+0:
+ * library/tzdata/GMT-0:
+ * library/tzdata/GMT0:
+ * library/tzdata/Greenwich:
+ * library/tzdata/Navajo:
+ * library/tzdata/Universal:
+ * library/tzdata/Zulu:
+ * library/tzdata/America/Asuncion:
+ * library/tzdata/America/Rosario:
+ * library/tzdata/Asia/Jerusalem:
+ * library/tzdata/Brazil/Acre:
+ Routine update per Olson's tzdata2005c. Removed links to links
+ (Greenwich in several aliases; Navajo; Acre). Updated Paraguayan DST
+ rules and "best guess" at this year's Israeli rules.
+
+2005-01-17 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c: fix for glob failure on Windows shares [Bug
+ 1100542].
+
+ * doc/pkgMkIndex.n: added documentation that 'pkg_mkIndex -lazy' is not
+ a good idea. [Bug 1101678]
+
+2005-01-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tests/compile.test (compile-17.1): Document known issue with binding
+ time of compiled command interpretations in [expr].
+
+ * generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so that
+ we don't need to hard-code attribute indexes. [Bug 1100671]
+
+2005-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/string.n: Removed the term 'set' from the documentation of the
+ [string trim] commands, as it caused confusion.
+
+2005-01-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tcl.m4 (SC_PATH_{TCL,TK}CONFIG): Added code to detect the case
+ when the --with-tcl/--with-tk arguments point to the config scripts
+ themselves and not their directory. If this is the case, they now
+ complain but keep working. [FRQ 951247]
+ * unix/configure: autoconf-2.57
+
+2005-01-10 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/Makefile.in, unix/configure.in, unix/tcl.m4,
+ * unix/tclConfig.sh.in, unix/dltest/Makefile.in:
+ Remove ${DBGX}, ${TCL_DBGX} from Tcl build system [Patch 1081595].
+ * unix/configure: regenerated
+
+2005-01-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixFCmd.c (TclUnixCopyFile): Convert u_int to unsigned to
+ make clashes with types in standard C headers less of a problem. [Bug
+ 1098829]
+
+2005-01-09 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/tclUnixThrd.c, unix/tclUnixPort.h: Remove readdir_r() and
+ related #ifdeffery (see [Bug 1095909]).
+ * unix/tcl.m4, unix/tclConfig.h.in: Don't check for HAVE_READDIR_R.
+ * unix/configure: Regenerated.
+
+2005-01-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * library/http/http.tcl (http::mapReply): Significant performance
+ enhancement by using [string map] instead of [regsub]/[subst], and
+ update version requirement to Tcl8.4. [Bug 1020491]
+
+2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/lsearch.n, doc/re_syntax.n: Convert to other form of emacs mode
+ control comment to prevent problems with old versions of man. [Bug
+ 1085127]
+
+2005-01-05 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/winDde.test: Fixed broken test result.
+
+2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInt.h, generic/tclPort.h: Move the #include of tclConfig.h
+ *first* before any reference to tcl.h so that the build configuration
+ is loaded before the first reference to any system headers. Issue
+ reported by Art Haas on tcl-core.
+
+2005-01-04 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/fCmd.test (fCmd-18.10): Added notNetworkFilesystem constraint.
+ [Bug 456665]
+
+ ******************************************************************
+ *** 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.2007 b/ChangeLog.2007
new file mode 100644
index 0000000..5995956
--- /dev/null
+++ b/ChangeLog.2007
@@ -0,0 +1,5921 @@
+2007-12-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/dict.n: Clarified meaning of dictionary values following
+ discussion on comp.lang.tcl.
+
+2007-12-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c: More [lsort] data handling streamlines. The
+ function MergeSort is gone, essentially inlined into Tcl_LsortObjCmd.
+ It is not a straight inlining, two loops over all lists elements where
+ merged in the process: the linked list elements are now built and
+ merged into the temporary sublists in the same pass.
+
+2007-12-25 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c: More [lsort] data handling streamlines. Extra
+ mem reqs of latest patches removed, restored to previous mem profile.
+ Improved -unique handling, now eliminating repeated elems immediately
+ instead of marking them to avoid reinsertion at the end.
+
+2007-12-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): TCL_REG_NOSUB cannot
+ * tests/regexp.test (regexp-22.2): be used because it
+ * tests/regexpComp.test: [Bug 1857126] disallows backrefs.
+
+2007-12-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c: Speed patch for lsort. [Patch 1856994]
+
+2007-12-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd, Tcl_LsearchObjCmd): Avoid
+ calling SelectObjFromSublist when there are no sublists.
+
+2007-12-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Preallocate a listObj of
+ sufficient length for the sorted list instead of growing it. Second
+ commit replaces calls to Tcl_ListObjAppenElement with direct access to
+ the internal rep.
+
+2007-12-19 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5.0 TAGGED FOR RELEASE ***
+
+ * changes: Updated for 8.5.0 release.
+
+2007-12-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): update switch -regexp
+ * tests/switch.test-14.*: compilation to pass
+ the cflags to INST_REGEXP (changed on 12-07). Added tests for switch
+ -regexp compilation (need more). [Bug 1854399]
+
+2007-12-18 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.0 release.
+
+2007-12-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/regguts.h, generic/regc_color.c, generic/regc_nfa.c:
+ Fixes for problems created when processing regular expressions that
+ generate very large automata. An enormous number of thanks to Will
+ Drewry <wad_at_google.com>, Tavis Ormandy <taviso_at_google.com>,
+ and Tom Lane <tgl_at_sss.pgh.pa.us> from the Postgresql crowd for
+ their help in tracking these problems down. [Bug 1810264]
+
+2007-12-17 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updated for 8.5.0 release.
+
+2007-12-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclAlloc.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclThreadAlloc.c: Fix alignment for memory returned by
+ TclStackAlloc; insure that all memory allocators align to 16-byte
+ boundaries on 64 bit platforms [Bug 1851832, 1851524]
+
+2007-12-14 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclIOUtil.c (FsAddMountsToGlobResult): fix the tail
+ conversion of vfs mounts. [Bug 1602539]
+
+ * win/README: updated notes
+
+2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/winFile.test: Fixed tests for win2k with long machine name
+
+2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/nmakehlp.c: Support compilation with MSVC9 for AMD64.
+ * win/makefile.vc:
+
+2007-12-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/trace.n: Clarified documentation of enterstep and leavestep
+ traces, including adding example. [Bug 614282, 1701540, 1755984]
+
+2007-12-12 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/IntObj.3: Update docs for the Tcl_GetBignumAndClearObj() ->
+ Tcl_TakeBignumFromObj() revision [TIP 298]. Added docs for the
+ Tcl_InitBignumFromDouble() routine. [Bug 1446971]
+
+ * changes: Updated for 8.5.0 release.
+
+2007-12-10 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclUtil.c (TclReToGlob): reduce escapes in conversion
+ when not necessary
+
+ * generic/tclInt.decls: move TclByteArrayMatch and TclReToGlob
+ * generic/tclIntDecls.h: to tclInt.h from stubs.
+ * generic/tclStubInit.c: Add flags var to TclByteArrayMatch for
+ * generic/tclInt.h: future extensibility
+ * generic/tcl.h: define TCL_MATCH_EXACT doc for Tcl_StringCaseMatch.
+ * doc/StrMatch.3: It is compatible with existing usage.
+ * generic/tclExecute.c (INST_STR_MATCH): flag for TclByteArrayMatch
+ * generic/tclUtil.c (TclByteArrayMatch, TclStringMatchObj):
+ * generic/tclRegexp.c (Tcl_RegExpExecObj):
+ * generic/tclCmdMZ.c (StringMatchCmd): Use TclStringMatchObj
+ * tests/string.test (11.9.* 11.10.*): more tests
+
+2007-12-10 Joe English <jenglish@users.sourceforge.net>
+
+ * doc/string.n, doc/UniCharIsAlpha.3: Fix markup errors.
+ * doc/CrtCommand.3, doc/CrtMathFnc.3, doc/FileSystem.3,
+ * doc/GetStdChan.3, doc/OpenFileChnl.3, doc/SetChanErr.3,
+ * doc/eval.n, doc/filename.n: Consistency: Move "KEYWORDS" section
+ after "SEE ALSO".
+
+2007-12-10 Daniel Steffen <das@users.sourceforge.net>
+
+ * tools/genStubs.tcl: fix numerous issues handling 'macosx',
+ 'aqua' or 'x11' entries interleaved
+ with 'unix' entries [Bug 1834288]; add
+ genStubs::export command
+ [Tk FR 1716117]; cleanup formatting.
+
+ * generic/tcl.decls: use new genstubs 'export' command to
+ * generic/tclInt.decls: mark exported symbols not in stubs
+ * generic/tclTomMath.decls: table [Tk FR 1716117]; cleanup
+ formatting.
+
+ * generic/tclDecls.h: regen with new genStubs.tcl.
+ * generic/tclIntDecls.h: [Bug 1834288]
+ * generic/tclIntPlatDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclStubInit.c:
+
+2007-12-09 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/io.test, tests/chanio.test (io-73.1): Make sure to invalidate
+ * generic/tclIO.c (SetChannelFromAny): internal rep only after
+ validating channel rep. [Bug 1847044]
+
+2007-12-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/expr.n, doc/mathop.n: Improved the documentation of the
+ operators. [Bug 1823622]
+
+ * generic/tclBasic.c (builtInCmds): Corrected list of hidden and
+ * doc/interp.n (SAFE INTERPRETERS): exposed commands so that the
+ documentation and reality now match. [Bug 1662436]
+
+2007-12-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclExecute.c (TclExecuteByteCode INST_REGEXP):
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): Pass correct RE
+ compile flags at compile time, and use TCL_REG_NOSUB.
+
+ * generic/tclIOCmd.c (FinalizeIOCmdTSD, Tcl_PutsObjCmd): cache
+ stdout channel object for [puts $str] calls.
+
+2007-12-06 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Remove mention of dead comp.lang.tcl.announce
+ newsgroup. [Bug 1846433]
+
+ * unix/README: Mention the stub library created by `make` and warn
+ about the effect of embedded paths in the installed binaries.
+ Thanks to Larry Virden. [Bug 1794084]
+
+ * doc/AddErrInfo.3: Documentation for the new routines in TIP 270.
+ * doc/Interp.3:
+ * doc/StringObj.3:
+
+2007-12-06 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/namespace.n: Documentation for zero-argument form of
+ [namespace import] (TIP 261) [Bug 1596416]
+
+2007-12-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclInt.h: add TclGetChannelFromObj decl
+ (TclMatchIsTrivial): simplify TclMatchIsTrivial to remove ] check.
+
+2007-12-06 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Simplify the setting up of
+ * generic/tclIOCmd.c (TclInitChanCmd): the [chan] ensemble. This
+ * library/init.tcl: gets rid of quite a bit of
+ code and makes it possible to understand the whole with less effort.
+
+ * generic/tclCompCmds.c (TclCompileEnsemble): Ensure that the right
+ number of tokens are copied. [Bug 1845320]
+
+ * generic/tclNamesp.c (TclMakeEnsemble): Added missing release of a
+ DString. [Bug 1845397]
+
+2007-12-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclIO.h: Create Tcl_Obj for Tcl channels to reduce
+ * generic/tclIO.c: overhead in lookup by Tcl_GetChannel. New
+ * generic/tclIOCmd.c: TclGetChannelFromObj for internal use.
+ * generic/tclIO.c (WriteBytes, WriteChars): add opt check to avoid
+ EOL translation when not linebuffered or using lf. [Bug 1845092]
+
+2007-12-05 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/stack.test: made the tests for stack overflow not care
+ about which mechanism caused the error (interp's recursion limit
+ or C-stack depth detector).
+
+2007-12-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/configure, win/tcl.m4 (LIBS_GUI): mingw needs -lole32
+ -loleaut32 but not msvc for Tk's [send]. [Bug 1844749]
+
+2007-12-05 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Prevent shimmering crash
+ when -exact and -integer/-real are mixed. [Bug 1844789]
+
+2007-12-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixChan.c (CreateSocketAddress): Add extra #ifdef-fery to
+ make code compile on BSD 5. [Bug 1618235, again]
+
+2007-12-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Bump tcltest to version 2.3.0 so that
+ * library/tcltest/pkgIndex.tcl: we release a stable tcltest with a
+ * unix/Makefile.in: stable Tcl.
+ * win/Makefile.in:
+
+2007-12-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib
+
+2007-12-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Adjusted the [switch]
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): command so that when
+ passed two arguments, no check for options are performed. This is OK
+ since in the two-arg case, detecting an option would definitely lead
+ to a syntax error. [Patch 1836519]
+
+2007-11-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/makefile.vc: add ws2_32.lib to baselibs
+ * win/configure, win/tcl.m4: add ws2_32.lib / -lws2_32 to build.
+ * win/tclWinSock.c: remove dyn loading of winsock, assume that it is
+ always available now.
+
+2007-11-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclWinSock.c (InitializeHostName): Correct error in
+ buffer length tracking. After gethostname() writes into a buffer,
+ convert only the written string to internal encoding, not the whole
+ buffer.
+
+2007-11-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclConfig.c: Corrected failure of the [::foo::pkgconfig]
+ command to clean up registered configuration data when the query
+ command is deleted from the interp. [Bug 983501]
+
+ * generic/tclNamesp.c (Tcl_SetEnsembleMappingDict): Added checks
+ that the dict value passed in is in the format required to make the
+ internals of ensembles work. [Bug 1436096]
+
+ * generic/tclIO.c: Simplify test and improve accuracy of error
+ message in latest changes.
+
+2007-11-28 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclIO.c: -eofchar must support no eofchar.
+
+2007-11-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: remove unneeded call in Tcl_CreateInterp, add
+ comments.
+
+2007-11-27 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinSock.c: Add mising encoding conversion of the [info
+ hostname] value from the system encoding to Tcl's internal encoding.
+
+ * doc/chan.n: "Fix" the limitation on channel -eofchar
+ * doc/fconfigure.n: values to single byte characters by
+ * generic/tclIO.c: documenting it and making it fail loudly.
+ * tests/chan.test: Thanks to Stuart Cassoff for contributing the
+ fix. [Bug 800753]
+
+2007-11-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * unix/tclUnixInit.c:
+ * unix/tclUnixThrd.c: Fix stack checking via workaround for bug in
+ glibc's pthread_attr_get_np, patch from [Bug 1815573]. Many thanks to
+ Sergei Golovan (aka Teo) for detecting the bug and helping diagnose
+ and develop the fix.
+
+2007-11-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix bug in [dict
+ append] compiler which caused strange stack corruption. [Bug 1837392]
+
+2007-11-23 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c: Fixed a problem with reflected channels. 'chan
+ postevent' is defined to work only from within the interpreter
+ containing the handler command. Sensible, we want only handler
+ commands to use it. It identifies the channel by handle. The channel
+ moves to a different interpreter or thread. The interpreter containing
+ the handler command doesn't know the channel any longer. 'chan
+ postevent' fails, not finding the channel any longer. Uhm.
+
+ Fixed by creating a second per-interpreter channel table, just for
+ reflected channels, where each interpreter remembers for which
+ reflected channels it has the handler command. This info does not move
+ with the channel itself. The table is updated by 'chan create', and
+ used by 'chan postevent'.
+
+ * tests/ioCmd.test: Updated the testsuite.
+
+2007-11-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclVar.c (Tcl_ArrayObjCmd): handle the right data for
+ * tests/var.test (var-14.2): [array names $var -glob $ptn]
+
+2007-11-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdMZ.c (String*Cmd, TclInitStringCmd): Rebuilt [string]
+ * generic/tclCompCmds.c (TclCompileString*Cmd): as an ensemble.
+
+2007-11-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (Dict*Cmd,TclInitDictCmd): Rebuilt the [dict]
+ * generic/tclCompCmds.c (TclCompileDict*Cmd): command as an ensemble.
+
+2007-11-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Rewrote the [string] and
+ * generic/tclDictObj.c (Tcl_DictObjCmd): [dict] implementations to be
+ ready for conversion to ensembles.
+
+ * tests/string.test (string-12.22): Flag shimmering bug found in
+ [string range].
+
+2007-11-21 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileEnsemble): Rewrote the ensemble
+ compiler to remove many of the limitations. Can now compile scripts
+ that use unique prefixes of subcommands, and which have mappings of a
+ command to multiple words (provided the first is a compilable command
+ of course).
+
+2007-11-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclNamesp.c (TclMakeEnsemble): Factor out the code to set up
+ a core ensemble from a table of information about subcommands, ready
+ for reuse within the core.
+
+ * generic/various: Start to return more useful Error codes, currently
+ mainly on assorted lookup failures.
+
+2007-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c: Changed the underlying implementation of the
+ hash table used in dictionaries to additionally keep all entries in
+ the hash table in a linked list, which is only ever added to at the
+ end. This makes iteration over all entries in the dictionary in
+ key insertion order a trivial operation, and so cleans up a great deal
+ of complexity relating to dictionary representation and stability of
+ iteration order.
+
+ ***POTENTIAL INCOMPATIBILITY***
+ For any code that depended on the (strange) old iteration order.
+
+ * generic/tclConfig.c (QueryConfigObjCmd): Correct usage of
+ Tcl_WrongNumArgs.
+
+2007-11-19 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5b3 TAGGED FOR RELEASE ***
+
+ * README: Bump version number to 8.5b3.
+ * 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: Updated for 8.5b3 release.
+
+2007-11-19 Kevin Kenny <kennykb@users.sourceforge.net>
+
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/America/Campo_Grande:
+ * library/tzdata/America/Caracas:
+ * library/tzdata/America/Cuiaba:
+ * library/tzdata/America/Havana:
+ * library/tzdata/America/Sao_Paulo:
+ * library/tzdata/Asia/Damascus:
+ * library/tzdata/Asia/Gaza:
+ * library/tzdata/Asia/Tehran: Olson's tzdata2007i imported.
+
+2007-11-18 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): Fix read
+ traces not firing on non-existent array elements. [Bug 1833522]
+
+2007-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdIL.c (TclInitInfoCmd): Rename the implementation
+ commands for [info] to be something more "expected".
+
+ * generic/tclCompCmds.c (TclCompileInfoExistsCmd): Compiler for the
+ [info exists] subcommand.
+ (TclCompileEnsemble): Cleaned up version of ensemble compiler that was
+ in TclCompileInfoCmd, but which is now much more generally applicable.
+
+ * generic/tclInt.h (ENSEMBLE_COMPILE): Added flag to allow for cleaner
+ turning on and off of ensemble bytecode compilation.
+
+ * generic/tclCompile.c (TclCompileScript): Add the cmdPtr to the list
+ of arguments passed to command compilers.
+
+2007-11-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/regc_nfa.c: Fixed infinite loop in the regexp compiler.
+ [Bug 1810038]
+
+ * generic/regc_nfa.c: Corrected looping logic in fixempties() to
+ avoid wasting time walking a list of dead states. [Bug 1832612]
+
+2007-11-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclNamesp.c (NamespaceEnsembleCmd): Must pass a non-NULL
+ interp to Tcl_SetEnsemble* functions.
+
+ * doc/re_syntax.n: Try to make this easier to read. It's still a very
+ difficult manual page!
+
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow people to turn off the -rpath
+ option to their linker if they so desire. This is a configuration only
+ recommended for (some) vendors. Relates to [Patch 1231022].
+
+2007-11-15 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWin32Dll.c: Prefer UINT_PTR to DWORD_PTR when casting
+ pointers to integer types for greater portability. [Bug 1831253]
+
+2007-11-15 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add new chanio.test.
+ * macosx/Tcl.xcode/project.pbxproj:
+
+2007-11-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompile.c (TclCompileScript): Ensure that we get our
+ count in our INST_START_CMD calls right, even when there's a failure
+ to compile a command directly.
+
+ * generic/tclNamesp.c (Tcl_SetEnsembleSubcommandList)
+ (Tcl_SetEnsembleMappingDict): Special code to make sure that
+ * generic/tclCmdIL.c (TclInitInfoCmd): [info exists] is compiled
+ right while not allowing changes to the ensemble to cause havok.
+
+ * generic/tclCompCmds.c (TclCompileInfoCmd): Simple compiler for the
+ [info] command that only handles [info exists].
+
+ * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): New
+ instructions to allow the testing of whether a variable exists.
+
+2007-11-14 Andreas Kupries <andreask@activestate.com>
+
+ * tests/chanio.test: New file. This is essentially a duplicate of
+ 'io.test', with all channel commands converted to their 'chan xxx'
+ notation.
+ * tests/io.test: Fixed typo in test description.
+
+2007-11-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/regc*.c: Eliminate multi-char collating element code
+ completely. Simplifies the code quite a bit. If people still want the
+ full code, it will remain on the 8.4 branch. [Bug 1831425]
+
+2007-11-13 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): clean up comments, only
+ free dstring on OK from TclReToGlob.
+ (TclCompileSwitchCmd): simplify TclReToGlob usage.
+
+2007-11-14 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/regc*.c: #ifdef/comment out the code that deals with
+ multi-character collating elements, which have never been supported.
+ Cuts the memory consumption of the RE compiler. [Bug 1831425]
+
+2007-11-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd, TclCompileRegexpCmd):
+ Extend [switch] compiler to handle regular expressions as long as
+ things are not too complex. Fix [regexp] compiler so that non-trivial
+ literal regexps get fed to INST_REGEXP.
+
+ * doc/mathop.n: Clarify definitions of some operations.
+
+2007-11-13 Miguel Sofer <msofer@users.sf.net>
+
+ * unix/tclUnixInit.c: the TCL_NO_STACK_CHECK was being incorrectly
+ undefined here; this should be set (or not) in the compile options, it
+ is used elsewhere and needs to be consistent.
+
+2007-11-13 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * unix/tcl.m4: Added autoconf goo to detect and make use of
+ * unix/configure.in: getaddrinfo and friends.
+ * unix/configure: (regenerated)
+
+2007-11-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixCompat.c (TclpGetHostByName): The six-argument form of
+ getaddressbyname_r() uses the fifth argument to indicate whether the
+ lookup succeeded or not on at least one platform. [Bug 1618235]
+
+2007-11-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/regcomp.c: Convert optst() from expensive no-op to a
+ cheap no-op.
+
+2007-11-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixChan.c (CreateSocketAddress): Rewrote to use the
+ thread-safe version of gethostbyname() by forward-porting the code
+ used in 8.4, and added rudimentary support for getaddrinfo() (not
+ enabled by default, as no autoconf-ery written). Part of fix for [Bug
+ 1618235].
+
+2007-11-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclGet.c (Tcl_Get, Tcl_GetInt): revert use of TclGet* macros
+ due to compiler warning. These cases won't save time either.
+
+ * generic/tclUtil.c (TclReToGlob): add more comments, set interp
+ result if specified on error.
+
+2007-11-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: New macro TclResetResult, new iPtr
+ * generic/tclExecute.c: flag bit INTERP_RESULT_UNCLEAN:
+ * generic/tclInt.h: shortcut for Tcl_ResetResult for the
+ * generic/tclProc.c: "normal" case: TCL_OK, no return
+ * generic/tclResult.c: options, no errorCode nor errorInfo,
+ * generic/tclStubLib.c: return at normal level. [Patch
+ * generic/tclUtil.c: 1830184]
+
+ THIS PATCH WAS REVERTED: initial (mis)measurements overstated the
+ perfomance wins, which turn out to be tiny. Not worth the
+ complication.
+
+2007-11-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCompCmds.c, generic/tclCompile.c, generic/tclCompile.h:
+ * generic/tclExecute.c, generic/tclInt.decls, generic/tclIntDecls.h:
+ * generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and fully
+ * generic/tclStubInit.c, generic/tclUtil.c: compiled [regexp] for the
+ * tests/regexpComp.test: [Bug 1830166] simple cases. Also added
+ TclReToGlob function to convert RE to glob patterns and use these in
+ the possible cases.
+
+2007-11-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclResult.c (ResetObjResult): clarify the logic.
+
+ * generic/tclBasic.c: Increased usage of macros to detect
+ * generic/tclBinary.c: and take advantage of objTypes. Added
+ * generic/tclClock.c: macros TclGet(Int|Long)FromObj,
+ * generic/tclCmdAH.c: TclGetIntForIndexM & TclListObjLength,
+ * generic/tclCmdIL.c: modified TclListObjGetElements.
+ * generic/tclCmdMZ.c:
+ * generic/tclCompCmds.c: The TclGetInt* macros are only a
+ * generic/tclCompExpr.c: shortcut on platforms where 'long' is
+ * generic/tclCompile.c: 'int'; it may be worthwhile to extend
+ * generic/tclDictObj.c: their functionality to other cases.
+ * generic/tclExecute.c:
+ * generic/tclGet.c: As this patch touches many files it
+ * generic/tclIO.c: has been recorded as [Patch 1830038]
+ * generic/tclIOCmd.c: in order to facilitate reviewing.
+ * generic/tclIOGT.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+ * generic/tclListObj.c:
+ * generic/tclLiteral.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclParse.c:
+ * generic/tclProc.c:
+ * generic/tclRegexp.c:
+ * generic/tclResult.c:
+ * generic/tclScan.c:
+ * generic/tclStringObj.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+
+2007-11-11 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixTime.c (TclpWideClicksToNanoseconds): Fix issues with
+ * generic/tclInt.h: int64_t overflow.
+
+ * generic/tclBasic.c: Fix stack check failure case if stack grows up
+ * unix/tclUnixInit.c: Simplify non-crosscompiled case.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2007-11-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: Fast path for INST_LIST_INDEX when the index
+ is not a list.
+
+ * generic/tclBasic.c:
+ * unix/configure.in:
+ * unix/tclUnixInit.c: Detect stack grwoth direction at compile time,
+ only fall to runtime detection when crosscompiling.
+
+ * unix/configure: autoconf 2.61
+
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * tests/interp.test:
+ * unix/tclUnixInit.c:
+ * win/tclWin32Dll.c: Restore simpler behaviour for stack checking, not
+ adaptive to stack size changes after a thread is launched. Consensus
+ is that "nobody does that", and so it is not worth the cost. Improved
+ failure comments (mistachkin).
+
+2007-11-10 Kevin Kenny <kennykb@acm.org>
+
+ * win/tclWin32Dll.c: Rewrote the Windows stack checking algorithm to
+ use information from VirtualQuery to determine the bound of the stack.
+ This change fixes a bug where the guard page of the stack was never
+ restored after an overflow. It also eliminates a nasty piece of
+ assembly code for structured exception handling on mingw. It
+ introduces an assumption that the stack is a single memory arena
+ returned from VirtualAlloc, but the code in MSVCRT makes the same
+ assumption, so it should be fairly safe.
+
+2007-11-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * unix/tclUnixInit.c:
+ * unix/tclUnixPort.h:
+ * win/tclWin32Dll.c: Modify the stack checking algorithm to recheck in
+ case of failure. The working assumptions are now that (a) a thread's
+ stack is never moved, and (b) a thread's stack can grow but not
+ shrink. Port to windows - could be more efficient, but is already
+ cheaper than it was.
+
+2007-11-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclResult.c (ResetObjResult): new shortcut.
+
+ * generic/tclAsync.c:
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclUnixInit.c:
+ * generic/tclUnixPort.h: New fields in interp (ekeko!) to cache TSD
+ data that is accessed at each command invocation, access macros to
+ replace Tcl_AsyncReady and TclpCheckStackSpace by much faster variants
+ [Patch 1829248]
+
+2007-11-09 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclInt.decls, generic/tclIntDecls.h: Use unsigned char for
+ * generic/tclExecute.c, generic/tclUtil.c: TclByteArrayMatch and
+ don't allow a nocase option. [Bug 1828296]
+ For INST_STR_MATCH, ignore pattern type for TclByteArrayMatch case.
+
+ * generic/tclBinary.c (Tcl_GetByteArrayFromObj): check type before
+ func jump (perf).
+
+2007-11-07 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclStubInit.c: Added TclByteArrayMatch
+ * generic/tclInt.decls: for efficient glob
+ * generic/tclIntDecls.h: matching of ByteArray
+ * generic/tclUtil.c (TclByteArrayMatch): Tcl_Objs, used in
+ * generic/tclExecute.c (TclExecuteByteCode): INST_STR_MATCH. [Bug
+ 1827996]
+
+ * generic/tclIO.c (TclGetsObjBinary): Add an efficient binary path for
+ [gets].
+ (DoWriteChars): Special case for 1-byte channel write.
+
+2007-11-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclEncoding.c: Version of the embedded iso8859-1 encoding
+ handler that is faster (functions to do the encoding know exactly what
+ they're doing instead of pulling it from a table, though the table
+ itself has to be retained for use by shift encodings that depend on
+ iso8859-1). [Patch 1826906], committing for dkf.
+
+2007-11-05 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclConfig.c (Tcl_RegisterConfig): Modified to not extend the
+ config database if the encoding provided by the user is not found
+ (venc == NULL). Scripts expecting the data will error out, however we
+ neither crash nor provide bogus information. See [Bug 983509] for more
+ discussion.
+
+ * unix/tclUnixChan.c (TtyGetOptionProc): Accepted [Patch 1823576]
+ provided by Stuart Cassof <stwo@users.sourceforge.net>. The patch adds
+ the necessary utf/external conversions to the handling of the
+ arguments of option -xchar which will allow the use of \0 and similar
+ characters.
+
+2007-11-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclTest.c (TestSetCmd2):
+ * generic/tclVar.c (TclObjLookupVarEx):
+ * tests/set.test (set-5.1): Fix error branch when array name looks
+ like array element (code not normally exercised).
+
+2007-11-01 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/tcltk-man2html.tcl (output-directive): Convert .DS/.DE pairs
+ into tables since that is now all that they are used for.
+
+ * doc/RegExp.3: Clarified documentation of RE flags. [Bug 1167840]
+
+ * doc/refchan.n: Adjust internal name to be consistent with the file
+ name for reduced user confusion. After comment by Dan Steffen.
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd, UniCharIsAscii): Remember, the
+ NUL character is in ASCII too. [Bug 1808258]
+
+ * doc/file.n: Clarified use of [file normalize]. [Bug 1185154]
+
+2007-10-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Bump version number to 8.5b2.1 to distinguish
+ * library/init.tcl: CVS development snapshots from the 8.5b2
+ * unix/configure.in: release.
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * unix/configure: autoconf (2.59)
+ * win/configure:
+
+2007-10-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/expr.n, doc/mathfunc.n: Improve documentation to try to make
+ clearer what is going on.
+
+ * doc/interp.n: Shorten the basic descriptive text for some interp
+ subcommands so Solaris nroff doesn't truncate them. [Bug 1822268]
+
+2007-10-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl (output-widget-options): Enhance the HTML
+ generator so that it can produce multi-line option descriptions.
+
+2007-10-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the
+ concatenees being empty objs. [Bug 1447328]
+
+2007-10-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclEncoding.c (TclInitEncodingSubsystem): Hard code the
+ iso8859-1 encoding, as it's needed for more than just text (especially
+ binary encodings...) Note that other encodings rely on the encoding
+ being a table encoding (!) so we can't use more efficient encoding
+ mapping functions.
+
+2007-10-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/regc_lex.c (lexescape): Close off one of the problems
+ mentioned in [Bug 1810264].
+
+2007-10-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (Tcl_FindCommand): insure that FQ command names
+ are searched from the global namespace, ie, bypassing resolvers of the
+ current namespace. [Bug 1114355]
+
+ * doc/apply.n: fixed example [Bug 1811791]
+ * doc/namespace.n: improved example [Bug 1788984]
+ * doc/AddErrInfo.3: typo [Bug 1715087]
+ * doc/CrtMathFnc.3: fixed Tcl_ListMathFuncs entry [Bug 1672219]
+
+ * generic/tclCompile.h:
+ * generic/tclInt.h: moved declaration of TclSetCmdNameObj from
+ tclCompile.h to tclInt.h, reverting linker [Bug 1821159] caused by
+ commit of 2007-10-11 (both I and gcc missed one dep).
+
+ * generic/tclVar.c: try to preserve Tcl_Objs when doing variable
+ lookups by name, partially addressing [Bug 1793601].
+
+2007-10-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * tools/tcltk-man2html.tcl (make-man-pages, htmlize-text)
+ (process-text): Make the man->HTML scraper work better.
+
+2007-10-26 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5b2 TAGGED FOR RELEASE ***
+
+ * changes: Updated for 8.5b2 release.
+
+ * doc/*.1: Revert doc changes that broke
+ * doc/*.3: `make html` so we can get the release
+ * doc/*.n: out the door.
+
+ * README: Bump version number to 8.5b2.
+ * 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:
+
+2007-10-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2help2.tcl, tools/man2tcl.c: Made some of the tooling code
+ to do man->other formats work better with current manpage set. Long
+ way still to go.
+
+2007-10-25 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclThread.c: Added TclpMasterLock/Unlock arround calls to
+ ForgetSyncObject in Tcl_MutexFinalize and Tcl_ConditionFinalize to
+ prevent from garbling the internal lists that track sync objects. [Bug
+ 1726873]
+
+2007-10-24 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * tools/man2html2.tcl (macro): Added support for converting the new
+ macros into HTML.
+
+ * doc/man.macros (QW,PQ,QR,MT): New macros that hide the ugly mess
+ needed to get proper GOOBE quoting in the manual pages.
+ * doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the
+ new macros.
+
+2007-10-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: Fix comments.
+ * generic/tclExecute.c:
+
+2007-10-18 David Gravereaux <davygrvy@pobox.com>
+
+ * tools/mkdepend.tcl: sort the dep list for a more humanly readable
+ output.
+
+2007-10-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclResult.c (TclMergeReturnOptions): Make sure any -code
+ values get pulled out of the dictionary, even if they are integer
+ valued.
+
+ * generic/tclCompCmds.c (TclCompileReturnCmd): Added code to more
+ optimally compile [return -level 0 $x] to "push $x". [RFE 1794073]
+
+ * compat/tmpnam.c (removed): The routine tmpnam() is no longer
+ * unix/Makefile.in: called by Tcl source code. Remove autogoo the
+ * unix/configure.in: supplied a replacement version on systems
+ * win/tcl.dsp: where the routine was not available. [RFE
+ 1811848]
+
+ * unix/configure: autoconf-2.59
+
+ * generic/tcl.h: Remove TCL_LL_MODIFIER_SIZE. [RFE 1811837]
+
+2007-10-17 David Gravereaux <davygrvy@pobox.com>
+
+ * tools/mkdepend.tcl: Improved defense from malformed object list
+ infile.
+
+2007-10-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tools/man2html2.tcl: Convert .DS/.DE into HTML tables, not
+ preformatted text.
+
+2007-10-17 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclCompExpr.c: Moved a misplaced declaration that blocked
+ compilation on VC++.
+ * generic/tclExecute.c: Silenced several VC++ compiler warnings about
+ converting 'long' to 'unsigned short'.
+
+2007-10-16 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: removed old dependency cruft that is no longer
+ needed.
+
+2007-10-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOCmd.c: Revise [open] so that it interprets leading
+ zero strings passed as the "permissions" argument as octal numbers,
+ even if Tcl itself no longer parses integers in that way.
+
+ * unix/tclUnixFCmd.c: Revise the "-permissions" [file attribute] so
+ that it interprets leading zero strings as octal numbers, even if Tcl
+ itself no longer parses integers in that way.
+
+ * generic/tclCompExpr.c: Corrections to code that produces
+ * generic/tclUtil.c: extended "bad octal" error messages.
+
+ * tests/cmdAH.test: Test revisions so that tests pass whether or
+ * tests/cmdIL.test: not Tcl parses leading zero strings as octal.
+ * tests/compExpr-old.test:
+ * tests/compExpr.test:
+ * tests/compile.test:
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/incr.test:
+ * tests/io.test:
+ * tests/lindex.test:
+ * tests/link.test:
+ * tests/mathop.test:
+ * tests/parseExpr.test:
+ * tests/set.test:
+ * tests/string.test:
+ * tests/stringComp.test:
+
+2007-10-15 David Gravereaux <davygrvy@pobox.com>
+
+ * tools/mkdepend.tcl: Produces usable output. Include path problem
+ * win/makefile.vc: fixed. Never fight city hall when it comes to
+ levels of quoting issues.
+
+2007-10-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclParse.c (Tcl_ParseBraces): fix for possible read after
+ the end of buffer. [Bug 1813528] (Joe Mistachkin)
+
+2007-10-14 David Gravereaux <davygrvy@pobox.com>
+
+ * tools/mkdepend.tcl (new): Initial stab at generating automatic
+ * win/makefile.vc: dependencies.
+
+2007-10-12 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Mine all version information from headers.
+ * win/rules.vc: Sync tcl and tk and bring extension versions
+ * win/nmakehlp.c: closer together. Try and avoid using tclsh to do
+ substitutions as we may cross compile.
+ * win/coffbase.txt: Added offsets for snack dlls.
+
+2007-10-11 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Fixed my bad spelling mistakes from years back.
+ Dedependency, duh! Rather funny.
+
+2007-10-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c: Correct [string is (wide)integer] failure
+ * tests/string.test: to report correct failindex values for
+ non-decimal integer strings. [Bug 1805887]
+
+ * compat/strtoll.c (removed): The routines strtoll() and strtoull()
+ * compat/strtoull.c (removed): are no longer called by the Tcl source
+ * generic/tcl.h: code. (Their functionality has been replaced
+ * unix/Makefile.in: by TclParseNumber().) Remove outdated comments
+ * unix/configure.in: and mountains of configury autogoo that
+ * unix/tclUnixPort.h: allegedly support the mythical systems where
+ * win/Makefile.in: these routines might not have been available.
+ * win/makefile.bc:
+ * win/makefile.vc:
+ * win/tclWinPort.h:
+
+ * unix/configure: autoconf-2.59
+
+2007-10-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclObj.c: remove superfluous #include of tclCompile.h
+
+2007-10-08 George Peter Staplin <georgeps@xmission.com>
+
+ * doc/Hash.3: Correct the valid usage of the flags member for the
+ Tcl_HashKeyType. It should be 0 or more of the flags mentioned.
+
+2007-10-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tcl.h (Tcl_DecrRefCount): Update change from 2006-05-29 to
+ make macro more warning-robust in unbraced if code.
+
+2007-10-02 Don Porter <dgp@users.sourceforge.net>
+
+ [core-stabilizer-branch]
+
+ * README: Bump version number to 8.5.0
+ * 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:
+
+2007-10-02 Andreas Kupries <andreask@activestate.com>
+
+ * library/tclIndex: Added 'tcl::tm::path' to the tclIndex. This fixes
+ [Bug 1806422] reported by Don Porter.
+
+2007-09-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclProc.c (Tcl_DisassembleObjCmd): Define a command,
+ ::tcl::unsupported::disassemble, which can disassemble procedures,
+ lambdas and general scripts.
+ * generic/tclCompile.c (TclDisassembleByteCodeObj): Split apart the
+ code to print disassemblies of bytecode so that there is reusable code
+ that spits it out in a Tcl_Obj and then that code is used when doing
+ tracing.
+
+2007-09-20 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5b1 TAGGED FOR RELEASE ***
+
+ * changes: updates for 8.5b1 release.
+
+2007-09-19 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bump version number to 8.5b1
+ * generic/tcl.h: Merge from core-stabilizer-branch.
+ * library/init.tcl: Stabilizing toward 8.5b1 release now done on
+ * tools/tcl.wse.in: the HEAD. core-stabilizer-branch is now
+ * unix/configure.in: suspended.
+ * unix/tcl.spec:
+ * win/configure.in:
+
+2007-09-19 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclStubLib.: Replaced isdigit with internal implementation.
+
+2007-09-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStubLib.c: Remove C library calls from Tcl_InitStubs() so
+ * win/makefile.vc: that we don't need the C library linked in to
+ libtclStub.
+
+2007-09-17 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Add crt flags for tclStubLib now it uses C-library
+ functions.
+
+2007-09-17 Joe English <jenglish@users.sourceforge.net>
+
+ * tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' to build
+ shared libraries on current NetBSDs. [Bug 1749251]
+ * unix/configure: regenerated (autoconf-2.59).
+
+2007-09-17 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: Update `make dist` so that tclDTrace.d is
+ included in the source code distribution.
+
+ * generic/tcl.h: Revised Tcl_InitStubs() to restore Tcl 8.4
+ * generic/tclPkg.c: source compatibility with callers of
+ * generic/tclStubLib.c: Tcl_InitStubs(interp, TCL_VERSION, 1). [Bug
+ 1578344]
+
+2007-09-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclTrace.c (Tcl_TraceObjCmd, TraceExecutionObjCmd)
+ (TraceCommandObjCmd, TraceVariableObjCmd): Generate literal values
+ * generic/tclNamesp.c (NamespaceCodeCmd): more efficiently using
+ * generic/tclFCmd.c (CopyRenameOneFile): TclNewLiteralStringObj
+ * generic/tclEvent.c (TclSetBgErrorHandler): macro.
+
+2007-09-15 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4: replace all direct references to compiler by ${CC} to
+ enable CC overriding at configure & make time; run
+ check for visibility "hidden" with all compilers;
+ quoting fixes from TEA tcl.m4.
+ (SunOS-5.1x): replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by
+ 'cc' compiler driver.
+ * unix/configure: autoconf-2.59
+
+2007-09-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclBasic.c (Tcl_CreateObjCommand): Only invalidate along the
+ namespace path once; that is enough. [Bug 1519940]
+
+2007-09-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclDTrace.d (new file): Add DTrace provider for Tcl; allows
+ * generic/tclCompile.h: tracing of proc and command entry &
+ * generic/tclBasic.c: return, bytecode execution, object
+ * generic/tclExecute.c: allocation and more; with
+ * generic/tclInt.h: essentially zero cost when tracing
+ * generic/tclObj.c: is inactive; enable with
+ * generic/tclProc.c: --enable-dtrace configure arg
+ * unix/Makefile.in: (disabled by default, will only
+ * unix/configure.in: enable if DTrace is present). [Patch
+ 1793984]
+
+ * macosx/GNUmakefile: Enable DTrace support.
+ * macosx/Tcl-Common.xcconfig:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+
+ * generic/tclCmdIL.c: Factor out core of InfoFrameCmd() into
+ internal TclInfoFrame() for use by DTrace
+ probes.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2007-09-12 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: Perform missing updates of the tcltest Tcl
+ * win/Makefile.in: Module installed filename that should have
+ been part of the bump to tcltest 2.3b1. Thanks Larry Virden.
+
+2007-09-12 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc, win/rules.vc, win/nmakehlp.c: Use nmakehlp to
+ substitute values for tclConfig.sh (helps cross-compiling).
+
+2007-09-11 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Accept underscores and colons in
+ * library/tcltest/pkgIndex.tcl: constraint names. Properly handle
+ constraint expressions that return non-numeric boolean results like
+ "false". Bump to tcltest 2.3b1. [Bug 1772989; RFE 1071322]
+ * tests/info.test: Disable fragile tests.
+
+ * doc/package.n: Restored the functioning of [package require
+ * generic/tclPkg.c: -exact] to be compatible with Tcl 8.4. [Bug
+ * tests/pkg.test: 1578344]
+
+2007-09-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictCmd-update):
+ * generic/tclCompile.c (tclInstructionTable):
+ * generic/tclExecute.c (INST_DICT_UPDATE_END): fix stack management in
+ compiled [dict update]. [Bug 1786481]
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Scripts that were precompiled on earlier versions of 8.5 and use [dict
+ update] will crash. Workaround: recompile.
+
+2007-09-11 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c: Corrected an off-by-one error in the setting
+ of MaxBaseWide for certain powers. [Bug 1767293 - problem reported in
+ comments when bug was reopened]
+
+2007-09-10 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclLink.c (Tcl_UpdateLinkedVar): guard against var being
+ unlinked. [Bug 1740631] (maros)
+
+2007-09-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: fix tclInstructionTable entry for
+ dictUpdateEnd
+
+ * generic/tclExecute.c: remove unneeded setting of 'cleanup' variable
+ before jumping to checkForCatch.
+
+2007-09-10 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/package.n: Restored the document parallel syntax of the
+ * generic/tclPkg.c: [package present] and [package require]
+ * tests/pkg.test: commands. [Bug 1723675]
+
+2007-09-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: Removed the "nsName" Tcl_ObjType from the
+ * generic/tclNamesp.c: registered set. Revised the management of the
+ * generic/tclObj.c: intrep of that Tcl_ObjType. Revised the
+ * tests/obj.test: TclGetNamespaceFromObj() routine to return
+ TCL_ERROR and write a consistent error message when a namespace is not
+ found. [Bug 1588842. Patch 1686862]
+
+ ***POTENTIAL INCOMPATIBILITY***
+ For callers of Tcl_GetObjType() on the name "nsName".
+
+ * generic/tclExecute.c: Update TclGetNamespaceFromObj() callers.
+ * generic/tclProc.c:
+
+ * tests/apply.test: Updated tests to expect new consistent
+ * tests/namespace-old.test: error message when a namespace is not
+ * tests/namespace.test: found.
+ * tests/upvar.test:
+
+ * generic/tclCompCmds.c: Use the new INST_REVERSE instruction
+ * tests/mathop.test: to correct the compiled versions of math
+ operator commands. [Bug 1724437]
+
+ * generic/tclCompile.c: New bytecode instruction INST_REVERSE to
+ * generic/tclCompile.h: reverse the order of N items at the top of
+ * generic/tclExecute.c: stack.
+
+ * generic/tclCompCmds.c (TclCompilePowOpCmd): Make a separate
+ routine to compile ** to account for its different associativity.
+
+2007-09-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (Tcl_SetVar2, TclPtrSetVar): [Bug 1710710] fixed
+ correctly, reverted fix of 2007-05-01.
+
+2007-09-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictUpdateCmd, DictWithCmd): Plug a hole that
+ * generic/tclExecute.c (TEBC,INST_DICT_UPDATE_END): allowed a careful
+ * tests/dict.test (dict-21.16,21.17,22.11): attacker to craft a dict
+ containing a recursive link to itself, violating one of Tcl's
+ fundamental datatype assumptions and causing a stack crash when the
+ dict was converted to a string. [Bug 1786481]
+
+2007-09-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEvent.c ([::tcl::Bgerror]): Corrections to Tcl's
+ * tests/event.test: default [interp bgerror] handler so that when
+ it falls back to a hidden [bgerror] in a safe interp, it gets the
+ right error context data. [Bug 1790274]
+
+2007-09-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclInitCompiledLocals): the refCount of resolved
+ variables was being managed without checking if they were Var or
+ VarInHash: itcl [Bug 1790184]
+
+2007-09-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclResult.c (Tcl_GetReturnOptions): Take care that a
+ * tests/init.test: non-TCL_ERROR code doesn't cause existing
+ -errorinfo, -errorcode, and -errorline entries to be omitted.
+ * generic/tclEvent.c: With -errorInfo no longer lost, generate more
+ complete ::errorInfo when calling [bgerror] after a non-TCL_ERROR
+ background exception.
+
+2007-09-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInterp.c (Tcl_Init): Removed constraint on ability
+ to define a custom [tclInit] before calling Tcl_Init(). Until now the
+ custom command had to be a proc. Now it can be any command.
+
+ * generic/tclInt.decls: New internal routine TclBackgroundException()
+ * generic/tclEvent.c: that for the first time permits non-TCL_ERROR
+ exceptions to trigger [interp bgerror] handling. Closes a gap in TIP
+ 221. When falling back to [bgerror] (which is designed only to handle
+ TCL_ERROR), convert exceptions into errors complaining about the
+ exception.
+
+ * generic/tclInterp.c: Convert Tcl_BackgroundError() callers to call
+ * generic/tclIO.c: TclBackgroundException().
+ * generic/tclIOCmd.c:
+ * generic/tclTimer.c:
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+2007-09-06 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcode/project.pbxproj: discontinue unmaintained support
+ * macosx/Tcl.xcode/default.pbxuser: for Xcode 1.5; replace by Xcode2
+ project for use on Tiger (with Tcl.xcodeproj to be used on Leopard).
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: updates for Xcode 2.5 and 3.0.
+ * macosx/Tcl.xcodeproj/default.pbxuser:
+ * macosx/Tcl.xcode/project.pbxproj:
+ * macosx/Tcl.xcode/default.pbxuser:
+ * macosx/Tcl-Common.xcconfig:
+
+ * macosx/README: document project changes.
+
+2007-09-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Removed support for the unmaintained
+ * generic/tclExecute.c: -DTCL_GENERIC_ONLY configuration. [Bug
+ * unix/Makefile.in: 1264623]
+
+2007-09-04 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/Makefile.in: It's unreliable to count on the release
+ manager to remember to `make genstubs` before `make dist`. Let the
+ Makefile remember the dependency for us.
+
+ * unix/Makefile.in: Corrections to `make dist` dependencies to be
+ sure that macosx/configure gets generated whenever it does not exist.
+
+2007-09-03 Kevin B, Kenny <kennykb@acm.org>
+
+ * library/tzdata/Africa/Cairo:
+ * library/tzdata/America/Grand_Turk:
+ * library/tzdata/America/Port-au-Prince:
+ * library/tzdata/America/Indiana/Petersburg:
+ * library/tzdata/America/Indiana/Tell_City:
+ * library/tzdata/America/Indiana/Vincennes:
+ * library/tzdata/Antarctica/McMurdo:
+ * library/tzdata/Australia/Adelaide:
+ * library/tzdata/Australia/Broken_Hill:
+ * library/tzdata/Australia/Currie:
+ * library/tzdata/Australia/Hobart:
+ * library/tzdata/Australia/Lord_Howe:
+ * library/tzdata/Australia/Melbourne:
+ * library/tzdata/Australia/Sydney:
+ * library/tzdata/Pacific/Auckland:
+ * library/tzdata/Pacific/Chatham: Olson's tzdata2007g.
+
+ * generic/tclListObj.c (TclLindexFlat):
+ * tests/lindex.test (lindex-17.[01]): Added code to detect the error
+ when a script does [lindex {} end foo]; an overaggressive optimisation
+ caused this call to return an empty object rather than an error.
+
+2007-09-03 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclObj.c (TclInitObjSubsystem): restore registration of the
+ "wideInt" Tcl_ObjType for compatibility with 8.4 extensions that
+ access the tclWideIntType Tcl_ObjType; add setFromAnyProc for
+ tclWideIntType.
+
+2007-09-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/lsearch.n: Added note that order of results with the -all option
+ is that of the input list. It always was, but this makes it crystal.
+
+2007-08-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Added fflush() calls following all callers of
+ * generic/tclExecute.c: TclPrintByteCodeObj() so that tcl_traceCompile
+ output is less likely to get mangled when writes to stdout interleave
+ with other code.
+
+2007-08-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Use a table lookup in ParseLexeme() to
+ determine lexemes with single-byte representations.
+
+ * generic/tclBasic.c: Used unions to better clarify overloading of
+ * generic/tclCompExpr.c: the fields of the OpCmdInfo and
+ * generic/tclCompile.h: TclOpCmdClientData structs.
+
+2007-08-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Call TclCompileSyntaxError() when
+ expression syntax errors are found when compiling expressions. With
+ this in place, convert TclCompileExpr to return void, since there's no
+ longer any need to report TCL_ERROR.
+ * generic/tclCompile.c: Update callers.
+ * generic/tclExecute.c:
+
+ * generic/tclCompCmds.c: New routine TclCompileSyntaxError()
+ * generic/tclCompile.h: to directly compile bytecodes that report a
+ * generic/tclCompile.c: syntax error, rather than (ab)use a call to
+ TclCompileReturnCmd. Also, undo the most recent commit that papered
+ over some issues with that (ab)use. New routine produces a new opcode
+ INST_SYNTAX, which is a minor variation of INST_RETURN_IMM. Also a bit
+ of constification.
+
+ * generic/tclCompile.c: Move the deallocation of local LiteralTable
+ * generic/tclCompExpr.c: entries into TclFreeCompileEnv().
+ * generic/tclExecute.c: Update callers.
+
+ * generic/tclCompExpr.c: Force numeric and boolean literals in
+ expressions to register with their intreps intact, even if that means
+ overwriting existing intreps in already registered literals.
+
+2007-08-25 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Added code to handle
+ * tests/expr.test (expr-23.48-53) integer exponentiation
+ that results in 32- and 64-bit integer results, avoiding calls to wide
+ integer exponentiation routines in this common case. [Bug 1767293]
+
+ * library/clock.tcl (ParseClockScanFormat): Modified code to allow
+ * tests/clock.test (clock-60.*): case-insensitive matching
+ of time zone and month names. [Bug 1781282]
+
+2007-08-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Register literals found in expressions
+ * tests/compExpr.test: to restore literal sharing. Preserve numeric
+ intreps when literals are created for the first time. Correct memleak
+ in ExecConstantExprTree() and add test for the leak.
+
+2007-08-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c: replaced copy loop that tripped some compilers
+ with memmove. [Bug 1780870]
+
+2007-08-23 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl ([auto_load_index]): Delete stray "]" that created
+ an expr syntax error (masked by a [catch]).
+
+ * generic/tclCompCmds.c (TclCompileReturnCmd): Added crash protection
+ to handle callers other than TclCompileScript() failing to meet the
+ initialization assumptions of the TIP 280 code in CompileWord().
+
+ * generic/tclCompExpr.c: Suppress the attempt to convert to
+ numeric when pre-compiling a constant expresion indicates an error.
+
+2007-08-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TEBC): disable the new shortcut to frequent
+ INSTs for debug builds. REVERTED (collision with alternative fix)
+
+2007-08-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclMain.c: Corrected the logic of dropping the last
+ * tests/main.test: newline from an interactively typed command.
+ [Bug 1775878]
+
+2007-08-21 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/thread.test: thread-4.4: clear ::errorInfo in the thread as a
+ message is left here from init.tcl on windows due to no tcl_pkgPath.
+
+2007-08-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_SUB): fix usage of the new macro for
+ overflow detection in sums, adapt to subtraction. Lengthy comment
+ added.
+
+2007-08-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (Overflowing, TclIncrObj, TclExecuteByteCode):
+ Encapsulate Miguel's last change in a more mnemonic macro.
+
+2007-08-19 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: changed the check for overflow in sums,
+ reducing objsize, number of branches and cache misses (according to
+ cachegrind). Non-overflow for s=a+b:
+ previous
+ ((a >= 0 || b >= 0 || s < 0) && (s >= 0 || b < 0 || a < 0))
+ now
+ (((a^s) >= 0) || ((a^b) < 0))
+ This expresses: "a and s have the same sign or else a and b have
+ different sign".
+
+2007-08-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/interp.n (RESOURCE LIMITS): Added text to better explain why
+ time limits are described using absolute times. [Bug 1752148]
+
+2007-08-16 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: improved localVarNameType caching to leverage
+ the new availability of Tcl_Obj in variable names, avoiding string
+ comparisons to verify that the cached value is usable.
+
+ * generic/tclExecute.c: check the two most frequent instructions
+ before the switch. Reduces both runtime and obj size a tiny bit.
+
+2007-08-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Added a "constant" field to the OpNode
+ struct (again "free" due to alignment requirements) to mark those
+ subexpressions that are completely known at compile time. Enhanced
+ CompileExprTree() and its callers to precompute these constant
+ subexpressions at compile time. This resolves the issue raised in [Bug
+ 1564517].
+
+2007-08-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclIOUtil.c (TclGetOpenModeEx): Only set the O_APPEND flag
+ * tests/ioUtil.test (ioUtil-4.1): on a channel for the 'a'
+ mode and not for 'a+'. [Bug 1773127]
+
+2007-08-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_INVOKE*): peephole opt, do not get the
+ interp's result if it will be pushed/popped.
+
+2007-08-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Use fully qualified variable names for
+ * tests/thread.test: ::errorInfo and ::errorCode so that string
+ * tests/trace.test: reported to variable traces are fully
+ qualified in agreement with Tcl 8.4 operations.
+
+2007-08-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclLoadDyld.c: use dlfcn API on Mac OS X 10.4 and later; fix
+ issues with loading from memory on intel and 64bit; add debug messages
+
+ * tests/load.test: add test load-10.1 for loading from vfs.
+
+ * unix/dltest/pkga.c: whitespace & comment cleanup, remove
+ * unix/dltest/pkgb.c: unused pkgf.c.
+ * unix/dltest/pkgc.c:
+ * unix/dltest/pkge.c:
+ * unix/dltest/pkgf.c (removed):
+ * unix/dltest/pkgua.c:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+
+2007-08-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Provide DECACHE/CACHE protection to the
+ * tests/trace.test: Tcl_LogCommandInfo() call. [Bug 1773040]
+
+2007-08-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdMZ.c (Tcl_SplitObjCmd): use TclNewStringObj macro
+ instead of calling the function.
+
+ * generic/tcl_Obj.c (TclAllocateFreeObjects): remove unneeded memset
+ to 0 of all allocated objects.
+
+2007-08-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h: remove redundant ops in TclNewStringObj macro.
+
+2007-08-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h: fix the TclSetVarNamespaceVar macro, was causing a
+ leak.
+
+2007-08-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Revise CompileExprTree() to use the
+ OpNode mark field scheme of tree traversal. This eliminates the need
+ to use magic values in the left and right fields for that purpose.
+ Also stop abusing the left field within ParseExpr() to store the
+ number of arguments in a parsed function call. CompileExprTree() now
+ determines that for itself at compile time. Then reorder code to
+ eliminate duplication.
+
+2007-08-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclCreateProc): better comments on the required
+ varflag values when loading precompiled procs.
+
+ * generic/tclExecute.c (INST_STORE_ARRAY):
+ * tests/trace.test (trace-2.6): whole array write traces on compiled
+ local variables were not firing. [Bug 1770591]
+
+2007-08-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclProc.c (InitLocalCache): reference firstLocalPtr via
+ procPtr. codePtr->procPtr == NULL exposed by tbcload.
+
+2007-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrected failure to compile/link in the
+ -DNO_WIDE_TYPE configuration.
+
+ * generic/tclExecute.c: Corrected improper use of bignum arguments to
+ * tests/expr.test: *SHIFT operations. [Bug 1770224]
+
+2007-08-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h: remove comments refering to VAR_SCALAR, as that
+ flag bit does not exist any longer.
+ * generic/tclProc.c (InitCompiledLocals): removed optimisation for
+ non-resolved case, as the function is never called in that case.
+ Renamed the function to InitResolvedLocals to calrify the point.
+
+ * generic/tclInt.decls: Exporting via stubs to help xotcl adapt to
+ * generic/tclInt.h: VarReform.
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+
+2007-08-07 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclEnv.c: improve environ handling on Mac OS X (adapted
+ * unix/tclUnixPort.h: from Apple changes in Darwin tcl-64).
+
+ * unix/Makefile.in: add support for compile flags specific to
+ object files linked directly into executables.
+
+ * unix/configure.in (Darwin): only use -seg1addr flag when prebinding;
+ use -mdynamic-no-pic flag for object files linked directly into exes;
+ support overriding TCL_PACKAGE_PATH/TCL_MODULE_PATH in environment.
+
+ * unix/configure: autoconf-2.59
+
+2007-08-06 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/parseExpr.test: Update source file name of expr parser code.
+
+ * generic/tclCompExpr.c: Added a "mark" field to the OpNode
+ struct, which is used to guide tree traversal. This field costs
+ nothing since alignement requirements used the memory already.
+ Rewrote ConvertTreeToTokens() to use the new field, which permitted
+ consolidation of utility routines CopyTokens() and
+ GenerateTokensForLiteral().
+
+2007-08-06 Kevin B. Kenny <kennykb@users.sf.net>
+
+ * generic/tclGetDate.y: Added a cast to the definition of YYFREE to
+ silence compiler warnings.
+ * generic/tclDate.c: Regenerated
+ * win/tclWinTest.c: Added a cast to GetSecurityDescriptorDacl call
+ to silence compiler warnings.
+
+2007-08-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.decls: Exporting via stubs to help itcl adapt to
+ * generic/tclInt.h: VarReform. Added localCache initialization
+ * generic/tclIntDecls.h: to TclInitCompiledLocals (which only exists
+ * generic/tclProc.c: for itcl).
+ * generic/tclStubInit.c:
+ * generic/tclVar.c:
+
+2007-08-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * library/word.tcl: Rewrote for greater efficiency. [Bug 1764318]
+
+2007-08-01 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclInt.h: Added a TclOffset macro ala Tk_Offset to
+ * generic/tclVar.c: abstract out 'offsetof' which may not be
+ * generic/tclExceute.c: defined (eg: msvc6).
+
+2007-08-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclCleanupVar): fix [Bug 1765225], thx Larry
+ Virden.
+
+2007-07-31 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/Hash.3:
+ * generic/tclHash.c:
+ * generic/tclObj.c:
+ * generic/tclThreadStorage.c: (changes part of the patch below)
+ Stop Tcl_CreateHashVar from resetting hPtr->clientData to NULL after
+ calling the allocEntryProc for a custom table.
+
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCompCmds.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclHash.c:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclLiteral.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclProc.c:
+ * generic/tclThreadStorage.c:
+ * generic/tclTrace.c:
+ * generic/tclVar.c: VarReform [Patch 1750051]
+
+ *** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)
+ Extensions that access internals defined in tclInt.h and/or
+ tclCompile.h may lose both binary and source compatibility. The
+ relevant changes are:
+ 1. 'struct Var' is completely changed, all acceses to its internals
+ (either direct or via the TclSetVar* and TclIsVar* macros) will
+ malfunction. Var flag values and semantics changed too.
+ 2. 'struct Bytecode' has an additional field that has to be
+ initialised to NULL
+ 3. 'struct Namespace' is larger, as the varTable is now one pointer
+ larger than a Tcl_HashTable. Direct access to its fields will
+ malfunction.
+ 4. 'struct CallFrame' grew one more field (the second such growth with
+ respect to Tcl8.4).
+ 5. API change for the functions TclFindCompiledLocal, TclDeleteVars
+ and many internal functions in tclVar.c
+
+ Additionally, direct access to variable hash tables via the standard
+ Tcl_Hash* interface is to be considered as deprecated. It still works
+ in the present version, but will be broken by further specialisation
+ of these hash tables. This concerns especially the table of array
+ elements in an array, as well as the varTable field in the Namespace
+ struct.
+
+2007-07-31 Miguel Sofer <msofer@users.sf.net>
+
+ * unix/configure.in: allow use of 'inline' in Tcl sources. [Patch
+ * win/configure.in: 1754128]
+ * win/makefile.vc: Regen with autoconf 2.61
+
+2007-07-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/tclUnixInit.c (TclpSetVariables): Use the thread-safe getpwuid
+ replacement to fill the tcl_platform(user) field as it is not subject
+ to spoofing. [Bug 681877]
+
+ * unix/tclUnixCompat.c: Simplify the #ifdef logic.
+
+ * unix/tclUnixChan.c (FileWatchProc): Fix test failures.
+
+2007-07-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/tclUnixChan.c (SET_BITS, CLEAR_BITS): Added macros to make this
+ file clearer.
+
+2007-07-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOvI, GetCommandSource):
+ * generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd):
+ * generic/tclInt.h:
+ * generic/tclTrace.c (TclCheck(Interp|Execution)Traces):
+ Removed the need for TEBC to inspect the command before calling TEOvI,
+ leveraging the TIP 280 infrastructure. Moved the generation of a
+ correct nul-terminated command string away from the trace code, back
+ into TEOvI/GetCommandSource.
+
+2007-07-20 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/platform.tcl: Fixed bug in 'platform::patterns'
+ * library/platform/pkgIndex.tcl: where identifiers not matching
+ * unix/Makefile.in: the special linux and solaris forms would not
+ * win/Makefile.in: get 'tcl' as an acceptable platform added to
+ * doc/platform.n: the result. Bumped package to version 1.0.3 and
+ * doc/platform_shell.n: updated documentation and Makefiles. Also
+ fixed bad version info in the documentation of platform::shell.
+
+2007-07-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParse.c: In contexts where interp and parsePtr->interp
+ might be different, be sure to use the latter for error reporting.
+ Also pulled the interp argument back out of ParseTokens() since we
+ already had a parsePtr->interp to work with.
+
+2007-07-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Removed unused arguments and variables
+
+2007-07-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c (ParseExpr): While adding comments to
+ explain the operations of ParseExpr(), made significant revisions to
+ the code so it would be easier to explain, and in the process made the
+ code simpler and clearer as well.
+
+2007-07-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: More commentary.
+ * tests/parseExpr.test: Several tests of syntax error messages
+ to check that when expression substrings are truncated they leave
+ visible the context relevant to the reported error.
+
+2007-07-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Factored out, corrected, and commented
+ common code for reporting syntax errors in LEAF elements.
+
+2007-07-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileWhileCmd):
+ * generic/tclCompile.c (TclCompileScript):
+ Corrected faulty avoidance of INST_START_CMD when the first opcode in
+ a script is within a loop (as produced by 'while 1'), so that the
+ corresponding command is properly counted. [Bug 1752146]
+
+2007-07-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Added a "parseOnly" flag argument to
+ ParseExpr() to indicate whether the caller is Tcl_ParseExpr(), with an
+ end goal of filling a Tcl_Parse with Tcl_Tokens representing the
+ parsed expression, or TclCompileExpr() with the goal of compiling and
+ executing the expression. In the latter case, more aggressive
+ conversion of QUOTED and BRACED lexeme to literals is done. In the
+ former case, all such conversion is avoided, since Tcl_Token
+ production would revert it anyway. This enables simplifications to the
+ GenerateTokensForLiteral() routine as well.
+
+2007-07-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Added a field for operator precedence
+ to be stored directly in the parse tree. There's no memory cost to
+ this addition, since that memory would have been lost to alignment
+ issues anyway. Also, converted precedence definitions and lookup
+ tables to use symbolic constants instead of raw number for improved
+ readability, and continued extending/improving/correcting comments.
+ Removed some unused counter variables. Renamed some variables for
+ clarity and replaced some cryptic logic with more readable macros.
+
+2007-07-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Revision so that the END lexeme never
+ gets inserted into the parse tree. Later tree traversal never reaches
+ it since its location in the tree is not variable. Starting and
+ stopping with the START lexeme (node 0) is sufficient. Also finished
+ lexeme code commentary.
+
+ * generic/tclCompExpr.c: Added missing creation and return of
+ the Tcl_Parse fields that indicate error conditions. [Bug 1749987]
+
+2007-07-05 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl (unknown): Corrected inconsistent error message
+ in interactive [unknown] when empty command is invoked. [Bug 1743676]
+
+2007-07-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (SetNsNameFromAny):
+ * generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary
+ ckfree/ckalloc when the old structs can be reused.
+
+2007-07-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c: Fix case where a FQ cmd or ns was being cached
+ * generic/tclObj.c: in a different interp, tkcon. [Bug 1747512]
+
+2007-07-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Revised #define values so that there
+ is now more expansion room to define more BINARY operators.
+
+2007-07-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclHash.c (CompareStringKeys): Always use the strcmp()
+ version; the operation is functionally equivalent, the speed is
+ identical (up to measurement limitations), and yet the code is
+ simpler. [FRQ 951168]
+
+2007-07-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Removed TCL_PRESERVE_BINARY_COMPATIBILITY and
+ * generic/tclHash.c: any code enabled when it is set to 0. We will
+ * generic/tclStubInit.c: always want to preserve binary compat
+ of the structs that appear in the interface through the 8.* series of
+ releases, so it's pointless to drag around this never-enabled
+ alternative.
+
+ * generic/tclIO.c: Removed dead code.
+ * unix/tclUnixChan.c:
+
+ * generic/tclCompExpr.c: Removed dead code, old implementations
+ * generic/tclEvent.c: of expr parsing and compiling, including the
+ * generic/tclInt.h: routine TclFinalizeCompilation().
+
+2007-06-30 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Plug a memory leak caused by a
+ missing Tcl_DecrRefCount on an error path. [Bug 1717186]
+
+2007-06-30 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclThread.c: Prevent RemeberSyncObj() from growing the sync
+ object lists by reusing already free'd slots, if possible. See
+ discussion on Bug 1726873 for more information.
+
+2007-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/DictObj.3 (Tcl_DictObjDone): Improved documentation of this
+ function to make it clearer how to use it. [Bug 1710795]
+
+2007-06-29 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclAlloc.c: on Darwin, ensure memory allocated by
+ * generic/tclThreadAlloc.c: the custom TclpAlloc()s is aligned to
+ 16 byte boundaries (as is the case with the Darwin system malloc).
+
+ * generic/tclGetDate.y: use ckalloc/ckfree instead of malloc/free.
+ * generic/tclDate.c: bison 1.875e
+
+ * generic/tclBasic.c (TclEvalEx): fix warnings.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: better support for renamed tcl
+ * macosx/Tcl.xcodeproj/default.pbxuser: source dir; add 10.5 SDK build
+ * macosx/Tcl-Common.xcconfig: config; remove tclMathOp.c.
+
+ * macosx/README: document Tcl.xcodeproj changes.
+
+2007-06-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Removed dead code, including the
+ * generic/tclExecute.c: entire file tclMathOp.c.
+ * generic/tclInt.h:
+ * generic/tclMathOp.c (removed):
+ * generic/tclTestObj.c:
+ * win/tclWinFile.c:
+
+ * unix/Makefile.in: Updated to reflect deletion of tclMathOp.c.
+ * win/Makefile.in:
+ * win/makefile.bc:
+ * win/makefile.vc:
+
+2007-06-28 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclBasic.c: Silence constness warnings for TclStackFree
+ * generic/tclCompCmds.c: when building with msvc.
+ * generic/tclFCmd.c:
+ * generic/tclIOCmd.c:
+ * generic/tclTrace.c:
+
+2007-06-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (UnsetVarStruct): fix possible segfault.
+
+2007-06-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTrace.c: Corrected broken trace reversal logic in
+ * generic/tclTest.c: TclCheckInterpTraces that led to infinite loop
+ * tests/trace.test: when multiple Tcl_CreateTrace traces were set
+ and one of them did not fire due to level restrictions. [Bug 1743931]
+
+2007-06-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclEvalEx): Moved some arrays from the C
+ stack to the Tcl stack.
+
+2007-06-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (UnsetVarStruct): more streamlining.
+
+2007-06-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Safety checks to avoid crashes in the
+ TclStack* routines when called with an incompletely initialized
+ interp. [Bug 1743302]
+
+2007-06-25 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (UnsetVarStruct): fixing incomplete change, more
+ streamlining.
+
+2007-06-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclDeleteCompiledLocalVars): removed inlining that
+ ended up not really optimising (limited benchmarks). Now calling
+ UnsetVarStruct (streamlined old code is #ifdef'ed out, in case better
+ benchmarks do show a difference).
+
+ * generic/tclVar.c (UnsetVarStruct): fixed a leak introduced in last
+ commit.
+
+2007-06-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (UnsetVarStruct, TclDeleteVars): made the logic
+ slightly clearer, eliminated some duplicated code.
+
+ *** POTENTIAL INCOMPATIBILITY *** (tclInt.h and Var struct users)
+ The core never builds VAR_LINK variable to have traces. Such a
+ "monster", should one exist, will now have its unset traces called
+ *before* it is unlinked.
+
+2007-06-23 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c (AtForkChild): don't call CoreFoundation
+ APIs after fork() on systems where that would lead to an abort().
+
+2007-06-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Revised TclStackRealloc() signature to better
+ * generic/tclInt.h: parallel (and fall back on) Tcl_Realloc.
+
+ * generic/tclNamesp.c (TclResetShadowesCmdRefs): Replaced
+ ckrealloc based allocations with TclStackRealloc allocations.
+
+ * generic/tclCmdIL.c: More conversions to use TclStackAlloc.
+ * generic/tclScan.c:
+
+2007-06-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Move most instances of the Tcl_Parse struct
+ * generic/tclCompExpr.c: off the C stack and onto the Tcl stack. This
+ * generic/tclCompile.c: is a rather large struct (> 3kB).
+ * generic/tclParse.c:
+
+2007-06-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOvI): Made sure that leave traces
+ * generic/tclExecute.c (INST_INVOKE): that were created during
+ * tests/trace.test (trace-36.2): execution of an originally
+ untraced command do not fire [Bug 1740962], partial fix.
+
+2007-06-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tcl.h, generic/tclCompile.h, generic/tclCompile.c: Remove
+ references in comments to obsolete {expand} notation. [Bug 1740859]
+
+2007-06-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c: streamline namespace vars deletion: only compute
+ the variable's full name if the variable is traced.
+
+2007-06-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decls: Revised the interfaces of the routines
+ * generic/tclExecute.c: TclStackAlloc and TclStackFree to make them
+ easier for callers to use (or more precisely, harder to misuse).
+ TclStackFree now takes a (void *) argument which is the pointer
+ intended to be freed. TclStackFree will panic if that's not actually
+ the memory the call will free. TSA/TSF also now tolerate receiving
+ (interp == NULL), in which case they simply fall back to be calls to
+ Tcl_Alloc/Tcl_Free.
+
+ * generic/tclIntDecls.h: make genstubs
+
+ * generic/tclBasic.c: Updated callers
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclFCmd.c:
+ * generic/tclFileName.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * generic/tclProc.c:
+ * generic/tclTrace.c:
+ * unix/tclUnixPipe.c:
+
+2007-06-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tools/tcltk-man2html.tcl: revamp of html doc output to use CSS,
+ standardized headers, subheaders, dictionary sorting of names.
+
+2007-06-18 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tools/tcltk-man2html.tcl: clean up copyright merging and output.
+ clean up coding constructs.
+
+2007-06-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c (InfoFrameCmd):
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
+ * generic/tclCompile.c (TclInitCompileEnv):
+ * generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Moved the
+ CmdFrame off the C stack and onto the Tcl stack.
+
+ * generic/tclExecute.c (TEBC): Moved the CmdFrame off the C stack and
+ onto the Tcl stack, between the catch and the execution stacks
+
+2007-06-18 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (TclEvalEx,TclEvalObjEx): Moved the CmdFrame off
+ the C stack and onto the Tcl stack.
+
+2007-06-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (TclObjInterpProcCore): Minor fixes to make
+ * generic/tclExecute.c (TclExecuteByteCode): compilation debugging
+ builds work again. [Bug 1738542]
+
+2007-06-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (TclObjInterpProcCore): Use switch instead of a
+ chain of if's for a modest performance gain and a little more clarity.
+
+2007-06-15 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c: Simplified [variable] compiler and executor.
+ * generic/tclExecute.c: Missed updates to "there is always a valid
+ frame".
+
+ * generic/tclCompile.c: reverted TclEvalObjvInternal and INST_INVOKE
+ * generic/tclExecute.c: to essentially what they were previous to the
+ * generic/tclBasic.c: commit of 2007-04-03 [Patch 1693802] and the
+ subsequent optimisations, as they break the new trace tests described
+ below.
+
+ * generic/trace.test: added tests 36 to 38 for dynamic trace creation
+ and addition. These tests expose a change in dynamics due to a recent
+ round of optimisations. The "correct" behaviour is not described in
+ docs nor TIP 62.
+
+2007-06-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.decls: Modif to the internals of TclObjInterpProc
+ * generic/tclInt.h: to reduce stack consumption and improve task
+ * generic/tclIntDecls.h: separation. Changes the interface of
+ * generic/tclProc.c: TclObjInterpProcCore (patching TclOO
+ simultaneously).
+
+ * generic/tclProc.c (TclObjInterpProcCore): simplified obj management
+ in wrongNumArgs calls.
+
+2007-06-14 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: SetByteCodeFromAny() can no longer return any
+ * generic/tclExecute.c: code other than TCL_OK, so remove code that
+ * generic/tclProc.c: formerly handled exceptional codes.
+
+2007-06-13 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclCompEvalObj): missed update to "there is
+ always a valid frame".
+
+ * generic/tclProc.c (TclObjInterpProcCore): call TEBC directly instead
+ of going through TclCompEvalObj - no need to check the compilation's
+ freshness, this has already been done. This improves speed and should
+ also provide some relief to [Bug 1066755].
+
+2007-06-12 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Turn the [info] command into
+ * generic/tclCmdIL.c (TclInitInfoCmd): an ensemble, making it easier
+ for third-party code to plug into.
+
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs):
+ * generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make
+ Tcl_WrongNumArgs do replacement correctly with ensembles and other
+ sorts of complex replacement strategies.
+
+2007-06-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: comments added to explain iPtr->numLevels
+ management.
+
+ * generic/tclNamesp.c: tweaks to Tcl_GetCommandFromObj and
+ * generic/tclObj.c: TclGetNamespaceFromObj; modified the usage of
+ structs ResolvedCmdName and ResolvedNsname so that the field refNsPtr
+ is NULL for fully qualified names.
+
+2007-06-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Further TEOvI split, creating a new
+ * generic/tclCompile.h: TclEvalObjvKnownCommand() function to handle
+ * generic/tclExecute.c: commands that are already known and are not
+ traced. INST_INVOKE now calls into this function instead of inlining
+ parts of TEOvI. Same perf, better isolation.
+
+ ***POTENTIAL INCOMPAT*** There is a subtle issue with the timing of
+ execution traces that is changed here - first change appeared in my
+ commit of 2007-04-03 [Patch 1693802], which caused some divergence
+ between compiled and non-compiled code.
+ ***THIS CHANGE IS UNDER REVIEW***
+
+2007-06-10 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README: updated links. [Bug 1715081]
+
+ * generic/tclExecute.c (TclExecuteByteCode): restore support for
+ INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 bytecodes to support 8.4-
+ precompiled sources (math functions). [Bug 1720895]
+
+2007-06-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclvar.c: new macros TclGetCurrentNamespace() and
+ TclGetGlobalNamespace(); Tcl_GetCommandFromObj and
+ TclGetNamespaceFromObj rewritten to make the logic clearer; slightly
+ faster too.
+
+2007-06-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_INVOKE): isolated two vars to the small
+ block where they are actually used.
+
+ * generic/tclObj.c (Tcl_GetCommandFromObj): rewritten to make the
+ logic clearer; slightly faster too.
+
+ * generic/tclBasic.c: Split TEOv in two, by separating a processor
+ for non-TCL_OK returns. Also split TEOvI in a full version that
+ handles non-existing and traced commands, and a separate shorter
+ version for the regular case.
+
+ * generic/tclBasic.c: Moved the generation of command strings for
+ * generic/tclTrace.c: traces: previously in Tcl_EvalObjv(), now in
+ TclCheck[Interp|Execution]Traces(). Also insured that the strings are
+ properly NUL terminated at the correct length. [Bug 1693986]
+
+ ***POTENTIAL INCOMPATIBILITY in internal API***
+ The functions TclCheckInterpTraces() and TclCheckExecutionTraces() (in
+ internal stubs) used to be noops if the command string was NULL, this
+ is not true anymore: if the command string is NULL, they generate an
+ appropriate string from (objc,objv) and use it to call the traces. The
+ caller might as well not call them with a NULL string if he was
+ expecting a noop.
+
+ * generic/tclBasic.c: Extend usage of TclLimitReady() and
+ * generic/tclExecute.c: (new) TclLimitExceeded() macros.
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+
+ * generic/tclInt.h: New TclCleanupCommandMacro for core usage.
+ * generic/tclBasic.c:
+ * generic/tclExecute.c:
+ * generic/tclObj.c:
+
+2007-06-09 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add new Tclsh-Info.plist.in.
+
+2007-06-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed [string first] and
+ * doc/string.n: [string last] so that they have clearer descriptions
+ for those people who know the adage about needles and haystacks. This
+ follows suggestions on comp.lang.tcl...
+
+2007-06-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclParse.c: fix for uninit read. [Bug 1732414]
+
+2007-06-06 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add settings for Fix&Continue.
+
+ * unix/configure.in (Darwin): add plist for tclsh; link the
+ * unix/Makefile.in (Darwin): Tcl and tclsh plists into
+ * macosx/Tclsh-Info.plist.in (new): their binaries in all cases.
+ * macosx/Tcl-Common.xcconfig:
+
+ * unix/tcl.m4 (Darwin): fix CF checks in fat 32&64bit builds.
+ * unix/configure: autoconf-2.59
+
+2007-06-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Added interp flag value ERR_LEGACY_COPY to
+ * generic/tclInt.h: control the timing with which the global
+ * generic/tclNamesp.c: variables ::errorCode and ::errorInfo get
+ * generic/tclProc.c: updated after an error. This keeps more
+ * generic/tclResult.c: precise compatibility with Tcl 8.4.
+ * tests/result.test (result-6.2): [Bug 1649062]
+
+2007-06-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.h:
+ * generic/tclExecute.c: Tcl-stack reform, [Patch 1701202]
+
+2007-06-03 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: add datarootdir to silence autoconf-2.6x warning.
+
+2007-05-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Removed code that dealt with
+ * generic/tclCompile.c: TCL_TOKEN_EXPAND_WORD tokens representing
+ * generic/tclCompile.h: expanded literal words. These sections were
+ mostly in place to enable [info frame] to discover line information in
+ expanded literals. Since the parser now generates a token for each
+ post-expansion word referring to the right location in the original
+ script string, [info frame] gets all the data it needs.
+
+ * generic/tclInt.h: Revised the parser so that it never produces
+ * generic/tclParse.c: TCL_TOKEN_EXPAND_WORD tokens when parsing an
+ * tests/parse.test: expanded literal word; that is, something like
+ {*}{x y z}. Instead, generate the series of TCL_TOKEN_SIMPLE_WORD
+ tokens to represent the words that expansion of the literal string
+ produces. [RFE 1725186]
+
+2007-05-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixThrd.c (Tcl_JoinThread): fix for 64-bit handling of
+ pthread_join exit return code storage. [Bug 1712723]
+
+2007-05-22 Don Porter <dgp@users.sourceforge.net>
+
+ [core-stabilizer-branch]
+
+ * unix/configure: autoconf-2.59 (FC6 fork)
+ * win/configure:
+
+ * README: Bump version number to 8.5b1
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+2007-05-18 Don Porter <dgp@users.sourceforge.net>
+
+ * unix/configure: autoconf-2.59 (FC6 fork)
+ * win/configure:
+
+ * README: Bump version number to 8.5a7
+ * generic/tcl.h:
+ * library/init.tcl:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+
+ * generic/tclParse.c: Disable and remove the ALLOW_EXPAND sections
+ * tests/info.test: that continued to support the deprecated
+ * tests/mathop.test: {expand} syntax. Updated the few remaining
+ users of that syntax in the test suite.
+
+2007-05-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclLimitReady): Created a macro version of
+ Tcl_LimitReady just for TEBC, to reduce the amount of times that the
+ bytecode engine calls out to external functions on the critical path.
+ * generic/tclInterp.c (Tcl_LimitReady): Added note to remind anyone
+ doing maintenance that there is a macro version to update.
+
+2007-05-17 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tcl.decls: workaround 'make checkstubs' failures from
+ tclStubLib.c MODULE_SCOPE revert. [Bug 1716117]
+
+2007-05-16 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/tclStubLib.c: Change Tcl_InitStubs(), tclStubsPtr, and the
+ auxilliary stubs table pointers back to public visibility.
+
+ These symbols need to be exported so that stub-enabled extensions may
+ be statically linked into an extended tclsh or Big Wish with a
+ dynamically-linked libtcl. [Bug 1716117]
+
+2007-05-15 Don Porter <dgp@users.sourceforge.net>
+
+ * win/configure: autoconf-2.59 (FC6 fork)
+
+ * library/reg/pkgIndex.tcl: Bump to registry 1.2.1 to account for
+ * win/configure.in: [Bug 1682211] fix.
+ * win/makefile.bc:
+ * win/tclWinReg.c:
+
+2007-05-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclInt.h: Removed TclEvalObjEx and TclGetSrcInfoForPc from
+ tclInt.h now they are in the internal stubs table.
+
+2007-05-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: TclFinalizeThreadAlloc() is always defined, so
+ make sure it is also always declared (with MODULE_SCOPE).
+
+2007-05-09 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclInt.h: fix warning when building threaded with -DPURIFY.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugUnthreaded' &
+ * macosx/Tcl.xcodeproj/default.pbxuser: 'DebugLeaks' configs and env
+ var settings needed to run the 'leaks' tool.
+
+2007-05-07 Don Porter <dgp@users.sourceforge.net>
+
+ [Tcl Bug 1706140]
+
+ * generic/tclLink.c (LinkTraceProc): Update Tcl_VarTraceProcs so
+ * generic/tclNamesp.c (Error*Read): they call Tcl_InterpDeleted()
+ * generic/tclTrace.c (Trace*Proc): for themselves, and do not
+ * generic/tclUtil.c (TclPrecTraceProc): rely on (frequently buggy)
+ setting of the TCL_INTERP_DESTROYED flag by the trace core.
+
+ * generic/tclVar.c: Update callers of TclCallVarTraces to not pass
+ in the TCL_INTERP_DESTROYED flag. Also apply filters so that public
+ routines only pass documented flag values down to lower level routines
+
+ * generic/tclTrace.c (TclCallVarTraces): The setting of the
+ TCL_INTERP_DESTROYED flag is now done entirely within the
+ TclCallVarTraces routine, the only place it can be done right.
+
+2007-05-06 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (ExtraFrameInfo): Create a new mechanism for
+ * generic/tclCmdIL.c (InfoFrameCmd): conveying what information needs
+ to be added to the results of [info frame] to replace the hack that
+ was there before.
+ * generic/tclProc.c (Tcl_ApplyObjCmd): Use the new mechanism for the
+ [apply] command, the only part of Tcl itself that needs it (so far).
+
+ * generic/tclInt.decls (TclEvalObjEx, TclGetSrcInfoForPc): Expose
+ these two functions through the internal stubs table, necessary for
+ extensions that need to integrate deeply with TIP#280.
+
+2007-05-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tclWinFile.c (TclpGetUserHome): Squelch type-pun warnings in
+ * win/tclWinInit.c (TclpSetVariables): Win-specific code not found
+ * win/tclWinReg.c (AppendSystemError): during earlier work on Unix.
+
+2007-05-04 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclIO.c (TclFinalizeIOSubsystem): Added an initializer to
+ silence a spurious gcc warning about use of an uninitialized
+ variable.
+ * tests/encoding.test: Modified so that encoding tests happen in a
+ private namespace, to avoid polluting the global one. This problem was
+ discovered when running the test suite '-singleproc 1 -skip exec.test'
+ because the 'path' variable in encoding.test conflicted with the one
+ in io.test.
+ * tests/io.test: Made more of the working variables private to the
+ namespace.
+
+2007-05-02 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclTest.c (SimpleMatchInDirectory): Corrected a refcount
+ imbalance that affected the filesystem-[147]* tests in the test suite.
+ Thanks to Don Porter for the patch. [Bug 1710707]
+ * generic/tclPathObj.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath):
+ Corrected several memory leaks that caused refcount imbalances
+ resulting in memory leaks on Windows. Thanks to Joe Mistachkin for the
+ patch.
+
+2007-05-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclPtrSetVar): fixed leak whenever newvaluePtr had
+ refCount 0 and was used for appending (but not lappending). Thanks to
+ mistachkin and kbk. [Bug 1710710]
+
+2007-05-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclIO.c (DeleteChannelTable): Made changes so that
+ DeleteChannelTable tries to close all open channels, not just the
+ first. [Bug 1710285]
+ * generic/tclThread.c (TclFinalizeSynchronization): Make sure that TSD
+ blocks get freed on non-threaded builds. [Bug 1710825]
+ * tests/utf.test (utf-25.1--utf-25.4): Modified tests to clean up
+ after the 'testobj' extension to avoid spurious reports of memory
+ leaks.
+
+2007-05-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (STR_MAP): When [string map] has a pure dict map,
+ a missing Tcl_DictObjDone() call led to a memleak. [Bug 1710709]
+
+2007-04-30 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in: add 'tclsh' dependency to install targets that
+ rely on tclsh, fixes parallel 'make install' from empty build dir.
+
+2007-04-30 Andreas Kupries <andreask@gactivestate.com>
+
+ * generic/tclIO.c (FixLevelCode): Corrected reference count
+ mismanagement of newlevel, newcode. Changed to allocate the Tcl_Obj's
+ as late as possible, and only when actually needed. [Bug 1705778, leak
+ K29]
+
+2007-04-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Corrected
+ reference count mismanagement on the name of the source file in the
+ TIP 280 code. [Bug 1705778, leak K02 among other manifestations]
+
+2007-04-25 Donal K. Fellows <dkf@users.sf.net>
+
+ *** 8.5a6 TAGGED FOR RELEASE ***
+
+ * generic/tclProc.c (TclObjInterpProcCore): Only allocate objects for
+ error message generation when associated with argument names that are
+ really used. [Bug 1705778, leak K15]
+
+2007-04-25 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclIOUtil.c (Tcl_FSChdir): Changed the memory management so
+ that the path returned from Tcl_FSGetNativePath is not duplicated
+ before being stored as the current directory, to avoid a memory leak.
+ [Bug 1705778, leak K01 among other manifestations]
+
+2007-04-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c (ParseExpr): Revised to be sure that an
+ error return doesn't prevent all literals getting placed on the
+ litList to be returned to the caller for freeing. Corrects some
+ memleaks. [Bug 1705778, leak K23]
+
+2007-04-25 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in (dist): add macosx/*.xcconfig files to src dist;
+ copy license.terms to dist macosx dir; fix autoheader bits.
+
+2007-04-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclListObj.c: reverting [Patch 738900] (committed on
+ 2007-04-20). Causes some Tk test breakage of unknown importance, but
+ the impact of the patch itself is likely to be so small that it does
+ not warrant investigation at this time.
+
+2007-04-24 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c (DictKeysCmd): Rewrote so that the lock on the
+ internal representation of a dict is only set when necessary. [Bug
+ 1705778, leak K04]
+ (DictFilterCmd): Added code to drop the lock in the trivial match
+ case. [Bug 1705778, leak K05]
+
+2007-04-24 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclBinary.c: Addressed several code paths where the error
+ return from the 'binary format' command leaked the result buffer.
+ * generic/tclListObj.c (TclLsetFlat): Fixed a bug where the new list
+ under construction was leaked in the error case. [Bug 1705778, leaks
+ K13 and K14]
+
+2007-04-24 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/Makefile.in (dist): add platform library package to src dist
+
+2007-04-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c (ParseExpr): Memory leak in error case; the
+ literal Tcl_Obj was not getting freed. [Bug 1705778, leak #1 (new)]
+
+ * generic/tclNamesp.c (Tcl_DeleteNamespace): Corrected flaw in the
+ flag marking scheme to be sure that global namespaces are freed when
+ their interp is deleted. [Bug 1705778]
+
+2007-04-24 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Plugged six memory leaks
+ in bignum arithmetic.
+ * generic/tclIOCmd.c (Tcl_ReadObjCmd): Plugged a leak of the buffer
+ object if the physical read returned an error and the bypass area had
+ no message.
+ * generic/tclIORChan.c (TclChanCreateObjCmd): Plugged a leak of the
+ return value from the "initialize" method of a channel handler.
+ (All of the above under [Bug 1705778])
+
+2007-04-23 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclCkalloc.c: fix warnings from gcc build configured with
+ * generic/tclCompile.c: --enable-64bit --enable-symbols=all.
+ * generic/tclExecute.c:
+
+ * unix/tclUnixFCmd.c: add workaround for crashing bug in fts_open()
+ * unix/tclUnixInit.c: without FTS_NOSTAT on 64bit Darwin 8 or earlier.
+
+ * unix/tclLoadDyld.c (TclpLoadMemory): fix (void*) arithmetic.
+
+ * macosx/Tcl-Common.xcconfig: enable more warnings.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugMemCompile' build
+ configuration that calls configure with --enable-symbols=all; override
+ configure check for __attribute__((__visibility__("hidden"))) in Debug
+ configuration to restore availability of ZeroLink.
+
+ * macosx/tclMacOSXNotify.c: fix warnings.
+
+ * macosx/tclMacOSXFCmd.c: const fixes.
+
+ * macosx/Tcl-Common.xcconfig: fix whitespace.
+ * macosx/Tcl-Debug.xcconfig:
+ * macosx/Tcl-Release.xcconfig:
+ * macosx/README:
+
+ * macosx/GNUmakefile: fix/add copyright and license refs.
+ * macosx/tclMacOSXBundle.c:
+ * macosx/Tcl-Info.plist.in:
+ * macosx/Tcl.xcode/project.pbxproj:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+
+ * unix/configure.in: install license.terms into Tcl.framework.
+ * unix/configure: autoconf-2.59
+
+2007-04-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclVar.c (UnsetVarStruct): Make sure the
+ TCL_INTERP_DESTROYED flags gets passed to unset trace routines so they
+ can respond appropriately. [Bug 1705778, leak #9]
+
+2007-04-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.c (TclFreeCompileEnv): Tip 280's new field
+ extCmdMapPtr was not being freed. [Bug 1705778, leak #1]
+
+2007-04-23 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclCompCmds.c (TclCompileUpvarCmd): Plugged a memory leak in
+ 'upvar' when compiling (a) upvar outside a proc, (b) upvar with a
+ syntax error, or (c) upvar where the frame index is not known at
+ compile time.
+ * generic/tclCompExpr.c (ParseExpr): Plugged a memory leak when
+ parsing expressions that contain syntax errors.
+ * generic/tclEnv.c (ReplaceString): Clear memory correctly when
+ growing the cache to avoid reads of uninitialised data.
+ * generic/tclIORChan.c (TclChanCreateObjCmd, FreeReflectedChannel):
+ Plugged two memory leaks.
+ * generic/tclStrToD.c (AccumulateDecimalDigit): Fixed a mistake where
+ we'd run beyond the end of the 'pow10_wide' array if a number begins
+ with a string of more than 'maxpow10_wide' zeroes.
+ * generic/tclTest.c (Testregexpobjcmd): Removed an invalid access
+ beyond the end of 'objv' in 'testregexp -about'.
+ All of these issues reported under [Bug 1705778] - detected with the
+ existing test suite, no new regression tests required.
+
+2007-04-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclDeleteNamespaceVars): fixed access to freed
+ memory detected by valgrind: Tcl_GetCurrentNamespace was being
+ called after freeing root CallFrame (on interp deletion).
+
+2007-04-20 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclListObj.c (SetListFromAny): avoid discarding internal
+ reps of objects converted to singleton lists. [Patch 738900]
+
+2007-04-20 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/clock.n: Corrected a silly error (transposed 'uppercase' and
+ 'lowercase' in clock.n. [Bug 1656002]
+ Clarified that [clock scan] does not recognize a locale's alternative
+ calendar.
+ Deleted an entirely superfluous (and also incorrect) remark about the
+ effect of Daylight Saving Time on relative times in [clock scan]. [Bug
+ 1582951]
+ * library/clock.tcl: Corrected an error in skipping over the %Ey field
+ on input.
+ * library/msgs/ja.msg:
+ * tools/loadICU.tcl: Corrected several localisation faults in the
+ Japanese locale (most notably, incorrect dates for the Emperors'
+ eras). Many thanks to SourceForge user 'nyademo' for pointing this out
+ and developing a fix. [Bug 1637471]
+ * generic/tclPathObj.c: Corrected a 'const'ness fault that caused
+ bitter complaints from MSVC.
+ * tests/clock.test (clock-40.1, clock-58.1, clock-59.1): Corrected a
+ test case that depended on ":localtime" being able to handle dates
+ prior to the Posix epoch. [Bug 1618445] Added a test case for the
+ dates of the Japanese emperors. [Bug 1637471] Added a regression test
+ for military time zone input conversion. [Bug 1586828]
+ * generic/tclGetDate.y (MilitaryTable): Fixed an ancient bug where the
+ military NZA time zones had the signs reversed. [Bug 1586828]
+ * generic/tclDate.c: Regenerated.
+ * doc/Notifier.3: Documented Tcl_SetNotifier and Tcl_ServiceModeHook.
+ Quite against my better judgment. [Bug 414933]
+ * generic/tclBasic.c, generic/tclCkalloc.c, generic/tclClock.c:
+ * generic/tclCmdIL.c, generic/tclCmdMZ.c, generic/tclFCmd.c:
+ * generic/tclFileName.c, generic/tclInterp.c, generic/tclIO.c:
+ * generic/tclIOUtil.c, generic/tclNamesp.c, generic/tclObj.c:
+ * generic/tclPathObj.c, generic/tclPipe.c, generic/tclPkg.c:
+ * generic/tclResult.c, generic/tclTest.c, generic/tclTestObj.c:
+ * generic/tclVar.c, unix/tclUnixChan.c, unix/tclUnixTest.c:
+ * win/tclWinLoad.c, win/tclWinSerial.c: Replaced commas in varargs
+ with string concatenation where possible. [Patch 1515234]
+ * library/tzdata/America/Tegucigalpa:
+ * library/tzdata/Asia/Damascus: Olson's tzdata 2007e.
+
+2007-04-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/regcomp.c, generic/regc_cvec.c, generic/regc_lex.c,
+ * generic/regc_locale.c: Improve the const-correctness of the RE
+ compiler.
+
+2007-04-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_LSHIFT): fixed a mistake introduced in
+ version 1.266 ('=' became '=='), which effectively turned the block
+ that handles native shifts into dead code. This explains why the
+ testsuite did not pick this mistake. Rewrote to make the intention
+ clear.
+
+ * generic/tclInt.h (TclDecrRefCount): change the order of the
+ branches, use empty 'if ; else' to handle use in unbraced outer
+ if/else conditions (as already done in tcl.h)
+
+ * generic/tclExecute.c: slight changes in Tcl_Obj management.
+
+2007-04-17 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Fixed the naming of
+ ::tcl::clock::ReadZoneinfoFile because (yoicks!) it was in the global
+ namespace.
+ * doc/clock.n: Clarified the cases in which legacy time zone is
+ recognized. [Bug 1656002]
+
+2007-04-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: fixed checkInterp logic [Bug 1702212]
+
+2007-04-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * various (including generic/tclTest.c): Complete the purge of K&R
+ function definitions from manually-written code.
+
+2007-04-15 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclCompCmds.c: added a cast to silence a compiler error on
+ VC2005.
+ * library/clock.tcl: Restored unique-prefix matching of keywords on
+ the [clock] command. [Bug 1690041]
+ * tests/clock.test: Added rudimentary test cases for unique-prefix
+ matching of keywords.
+
+2007-04-14 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: removed some code at INST_EXPAND_SKTOP that
+ duplicates functionality already present at checkForCatch.
+
+2007-04-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: new macros OBJ_AT_TOS, OBJ_UNDER_TOS,
+ OBJ_AT_DEPTH(n) and CURR_DEPTH that remove all direct references to
+ tosPtr from TEBC (after initialisation and the code at the label
+ cleanupV_pushObjResultPtr).
+
+2007-04-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c: moved all exceptDepth management to the
+ macros - the decreasing half was managed by hand.
+
+2007-04-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInt.h (TclNewLiteralStringObj): New macro to make
+ allocating literal string objects (i.e. objects whose value is a
+ constant string) easier and more efficient, by allowing the omission
+ of the length argument. Based on [Patch 1529526] (afredd)
+ * generic/*.c: Make use of this (in many files).
+
+2007-04-08 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile (tclInstructionTable): Fixed bugs in description
+ of dict instructions.
+
+2007-04-07 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile (tclInstructionTable): Fixed bug in description
+ of INST_START_COMMAND.
+
+ * generic/tclExecute.c (TEBC): Small code reduction.
+
+2007-04-06 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TEBC):
+ * generic/tclNamespace.c (NsEnsembleImplementationCmd):
+ * generic/tclProc.c (InitCompiledLocals, ObjInterpProcEx)
+ (TclObjInterpProcCore, ProcCompileProc): Code reordering to reduce
+ branching and improve branch prediction (assume that forward branches
+ are typically not taken).
+
+2007-04-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: INST_INVOKE optimisation. [Patch 1693802]
+
+2007-04-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c: Revised ErrorCodeRead and ErrorInfoRead trace
+ routines so they guarantee the ::errorCode and ::errorInfo variable
+ always appear to exist. [Bug 1693252]
+
+2007-04-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInt.decls: Moved TclGetNamespaceFromObj() to the
+ * generic/tclInt.h: internal stubs table; regen.
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+
+2007-04-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Added bytecode compilers for the variable
+ * generic/tclCompCmds.c: linking commands: 'global', 'variable',
+ * generic/tclCompile.h: 'upvar', 'namespace upvar' [Patch 1688593]
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclVar.c:
+
+2007-04-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Replace arrays on the C stack and ckalloc
+ * generic/tclExecute.c: calls with TclStackAlloc calls to use memory
+ * generic/tclFCmd.c: on Tcl's evaluation stack.
+ * generic/tclFileName.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * generic/tclTrace.c:
+ * unix/tclUnixPipe.c:
+
+2007-04-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript, TclPrintInstruction):
+ * generic/tclExecute.c (TclExecuteByteCode): Changed the definition of
+ INST_START_CMD so that it knows how many commands start at the current
+ location. This makes the interpreter command counter correct without
+ requiring a large number of instructions to be issued. (See my change
+ from 2007-01-19 for what triggered this.)
+
+2007-03-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompCmds.c: Replace arrays on the C stack and
+ ckalloc calls with TclStackAlloc calls to use memory on Tcl's
+ evaluation stack.
+
+ * generic/tclCmdMZ.c: Revised [string to* $s $first $last]
+ implementation to reduce number of allocs/copies.
+
+ * tests/string.test: More [string reverse] tests.
+
+2007-03-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: optimise the lookup of elements of indexed
+ arrays.
+
+2007-03-29 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (Tcl_ApplyObjCmd):
+ * tests/apply.test (9.3): Fixed Tcl_Obj leak on error return; an
+ unneeded ref to lambdaPtr was being set and not released on an error
+ return path.
+
+2007-03-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (STR_REVERSE): Implement the actual [string
+ reverse] command in terms of the new TclStringObjReverse() routine.
+
+ * generic/tclInt.h (TclStringObjReverse): New internal routine
+ * generic/tclStringObj.c (TclStringObjReverse): that implements the
+ [string reverse] operation, making use of knowledge/surgery of the
+ String intrep to minimize the number of allocs and copies needed to do
+ the job.
+
+2007-03-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdMZ.c (STR_MAP): Replace ckalloc calls with
+ TclStackAlloc calls.
+
+2007-03-24 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * win/tclWinThrd.c: Thread exit handler marks the current thread as
+ un-initialized. This allows exit handlers that are registered later to
+ re-initialize this subsystem in case they need to use some sync
+ primitives (cond variables) from this file again.
+
+2007-03-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (DeleteInterpProc): pop the root frame pointer
+ before deleting the global namespace [Bug 1658572]
+
+2007-03-23 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/Makefile.in: Added code to keep a Cygwin path name from leaking
+ into LIBRARY_DIR when doing 'make test' or 'make runtest'.
+
+2007-03-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Replaced arrays on the
+ C stack and ckalloc calls with TclStackAlloc calls to use memory on
+ Tcl's evaluation stack.
+
+ * generic/tclExecute.c: Revised GrowEvaluationStack to take an
+ argument specifying the growth required by the caller, so that a
+ single reallocation / copy is the most that will ever be needed even
+ when required growth is large.
+
+2007-03-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: More ckalloc -> ckrealloc conversions.
+ * generic/tclLiteral.c:
+ * generic/tclNamesp.c:
+ * generic/tclParse.c:
+ * generic/tclPreserve.c:
+ * generic/tclStringObj.c:
+ * generic/tclUtil.c:
+
+2007-03-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEnv.c: Some more ckalloc -> ckrealloc replacements.
+ * generic/tclLink.c:
+
+2007-03-20 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclDate.c: Rebuilt, despite Donal Fellows's comment when
+ committing it that no rebuild was required.
+ * generic/tclGetDate.y: According to Donal Fellows, "Introduce modern
+ formatting standards; no need for rebuild of tclDate.c."
+
+ * library/tzdata/America/Cambridge_Bay:
+ * library/tzdata/America/Havana:
+ * library/tzdata/America/Inuvik:
+ * library/tzdata/America/Iqaluit:
+ * library/tzdata/America/Pangnirtung:
+ * library/tzdata/America/Rankin_Inlet:
+ * library/tzdata/America/Resolute:
+ * library/tzdata/America/Yellowknife:
+ * library/tzdata/Asia/Choibalsan:
+ * library/tzdata/Asia/Dili:
+ * library/tzdata/Asia/Hovd:
+ * library/tzdata/Asia/Jakarta:
+ * library/tzdata/Asia/Jayapura:
+ * library/tzdata/Asia/Makassar:
+ * library/tzdata/Asia/Pontianak:
+ * library/tzdata/Asia/Ulaanbaatar:
+ * library/tzdata/Europe/Istanbul: Upgraded to Olson's tzdata2007d.
+
+ * generic/tclListObj.c (TclLsetList, TclLsetFlat):
+ * tests/lset.test: Changes to deal with shared internal representation
+ for lists passed to the [lset] command. Thanks to Don Porter for
+ fixing this issue. [Bug 1677512]
+
+2007-03-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Revise the various expansion routines for
+ CompileEnv fields to use ckrealloc() where appropriate.
+
+ * generic/tclBinary.c (Tcl_SetByteArrayLength): Replaced ckalloc() /
+ memcpy() sequence with ckrealloc() call.
+
+ * generic/tclBasic.c (Tcl_CreateMathFunc): Replaced some calls to
+ * generic/tclEvent.c (Tcl_CreateThread): Tcl_Alloc() with calls
+ * generic/tclObj.c (UpdateStringOfBignum): to ckalloc(), which
+ * unix/tclUnixTime.c (SetTZIfNecessary): better supports memory
+ * win/tclAppInit.c (setargv): debugging.
+
+2007-03-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/regsub.n: Corrected example so that it doesn't recommend
+ potentially unsafe practice. Many thanks to Konstantin Kushnir
+ <chpock@gmail.com> for reporting this.
+
+2007-03-17 Kevin B. Kenny <kennykb@acm.org>
+
+ * win/tclWinReg.c (GetKeyNames): Size the buffer for enumerating key
+ names correctly, so that Unicode names exceeding 127 chars can be
+ retrieved without crashing. [Bug 1682211]
+ * tests/registry.test (registry-4.9): Added test case for the above
+ bug.
+
+2007-03-15 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclIOUtil.c (Tcl_Stat): Reimplement workaround to avoid gcc
+ warning by using local variables. When the macro argument is of type
+ long long instead of long, the incorrect warning is not generated.
+
+2007-03-15 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/Makefile.in: Fully qualify LIBRARY_DIR so that `make test` does
+ not depend on working dir.
+
+2007-03-15 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * tests/parse.test: Add two backslash newline parse tests.
+
+2007-03-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (INST_FOREACH_STEP4): Make private copy of
+ * tests/foreach.test (foreach-10.1): value list to be assigned to
+ variables so that shimmering of that list doesn't lead to invalid
+ pointers. [Bug 1671087]
+
+ * generic/tclEvent.c (HandleBgErrors): Make efficient private copy
+ * tests/event.test (event-5.3): of the command prefix for the interp's
+ background error handling command to avoid panics due to pointers to
+ memory invalid after shimmering. [Bug 1670155]
+
+ * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make efficient
+ * tests/namespace.test (namespace-42.8): private copy of the
+ command prefix as we invoke the command appropriate to a particular
+ subcommand of a particular ensemble to avoid panic due to shimmering
+ of the List intrep. [Bug 1670091]
+
+ * generic/tclVar.c (TclArraySet): Make efficient private copy of
+ * tests/var.test (var-17.1): the "list" argument to [array set] to
+ avoid crash due to shimmering invalidating pointers. [Bug 1669489]
+
+2007-03-12 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix problems with declaration
+ positioning and memory leaks. [Bug 1679072]
+
+2007-03-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Ensure that a list is
+ correctly reversed even if its internal representation is shared
+ without the object itself being shared. [Bug 1675044]
+
+2007-03-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL (Tcl_LsortObjCmd): changed fix to [Bug 1675116] to
+ use the cheaper TclListObjCopy() instead of Tcl_DuplicateObj().
+
+2007-03-09 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/shell.tcl: Made more robust if an older platform
+ * library/platform/pkgIndex.tcl: package is present in the inspected
+ * unix/Makefile.in: shell. Package forget it to prevent errors. Bumped
+ * win/Makefile.in: package version to 1.1.3, and updated the Makefiles
+ installing it as Tcl Module.
+
+2007-03-09 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss
+ * tests/cmdIL.test (cmdIL-1.29): of list rep during sorting due
+ to shimmering. [Bug 1675116]
+
+2007-03-09 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl (ReadZoneinfoFile): Added Y2038 compliance to the
+ code for version-2 'zoneinfo' files.
+ * tests/clock.test (clock-56.3): Added a test case for Y2038 and
+ 'zoneinfo'. Modified test initialisation to use the
+ 'loadTestedCommands' function of tcltest to bring in the correct path
+ for the registry library.
+
+2007-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c (TclLsetList): Rewrite so that the routine
+ itself does not do any direct intrep surgery. Better isolates those
+ things into the implementation of the "list" Tcl_ObjType.
+
+2007-03-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclListObj.c (TclLindexList, TclLindexFlat): Moved these
+ functions to tclListObj.c from tclCmdIL.c to mirror the way that the
+ equivalent functions for [lset]'s guts are arranged.
+
+2007-03-08 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Further tweaks to the Windows time zone table
+ (restoring missing Mexican time zones). Added rudimentary handling of
+ version-2 'zoneinfo' files. Update US DST rules so that zones such as
+ 'EST5EDT' get the correct transition dates.
+ * tests/clock.test: Added rudimentary test cases for 'zoneinfo'
+ parsing. Adjusted several tests that depended on obsolete US DST
+ transition rules.
+
+2007-03-07 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c: add spinlock debugging and sanity checks.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: ensure gcc version used by
+ * macosx/Tcl.xcodeproj/default.pbxuser: Xcode and configure/make are
+ * macosx/Tcl-Common.xcconfig: consistent and independent of
+ gcc_select default and CC env var; fixes for Xcode 3.0.
+
+ * unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check
+ * unix/configure: autoconf-2.59
+
+2007-03-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdIL.c (TclLindex*): Rewrites to make efficient
+ private copies of the list and indexlist arguments, so we can operate
+ on the list elements directly with no fear of shimmering effects.
+ Replaces defensive coding schemes that are otherwise required. End
+ result is that TclLindexList is entirely a wrapper around
+ TclLindexFlat, which is now the core engine of all [lindex]
+ operations.
+
+ * generic/tclObj.c (Tcl_AppendAllObjTypes): Converted to simpler
+ list validity test.
+
+2007-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclRegexp.c (TclRegAbout): Generate information about a
+ regexp as a Tcl_Obj instead of as a string, which is more efficient.
+
+2007-03-07 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/clock.tcl: Adjusted Windows time zone table to handle new US
+ DST rules by locale rather than as Posix time zone spec.
+ * tests/clock.test (clock-39.6, clock-49.2, testclock::registry):
+ Adjusted tests to simulate new US rules.
+ * library/tzdata/America/Indiana/Winamac:
+ * library/tzdata/Europe/Istanbul:
+ * library/tzdata/Pacific/Easter:
+ Olson's tzdata2007c.
+
+2007-03-05 Andreas Kupries <andreask@activestate.com>
+
+ * library/platform/shell.tcl (::platform::shell::RUN): In the case of
+ * library/platform/pkgIndex.tcl: a failure put the captured stderr
+ * unix/Makefile.in: into the error message to aid in debugging. Bumped
+ * win/Makefile.in: package version to 1.1.2, and updated the makefiles
+ installing it as Tcl Module.
+
+2007-03-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclLink.c (LinkedVar): Added macro to conceal at least some
+ of the pointer hackery.
+
+2007-03-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Added missing
+ TclInvalidateStringRep() call when we directly manipulate the intrep
+ of an unshared "list" Tcl_Obj. [Bug 1672585]
+
+ * generic/tclCmdIL.c (Tcl_JoinObjCmd): Revised [join] implementation
+ to append Tcl_Obj's instead of strings. [RFE 1669420]
+
+ * generic/tclCmdIL.c (Info*Cmd): Code simplifications and
+ optimizations.
+
+2007-03-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompile.c (TclPrintInstruction): Added a scheme to allow
+ * generic/tclCompile.h (AuxDataPrintProc): aux-data to be printed
+ * generic/tclCompCmds.c (Print*Info): out for debugging. For
+ this to work, immediate operands referring to aux-data must be
+ identified as such in the instruction descriptor table using
+ OPERAND_AUX4 (all are always 4 bytes).
+
+ * generic/tclExecute.c (TclExecuteByteCode): Rewrote the compiled
+ * generic/tclCompCmds.c (TclCompileDictCmd): [dict update] so that it
+ * generic/tclCompile.h (DictUpdateInfo): stores critical
+ * tests/dict.test (dict-21.{14,15}): non-varying data in an
+ aux-data value instead of a (shimmerable) literal. [Bug 1671001]
+
+2007-03-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdIL.c (Tcl_LinsertObjCmd): Code simplifications
+ and optimizations.
+
+ * generic/tclCmdIL.c (Tcl_LreplaceObjCmd): Code simplifications
+ and optimizations.
+
+ * generic/tclCmdIL.c (Tcl_LrangeObjCmd): Rewrite in the same
+ spirit; avoid shimmer effects rather than react to them.
+
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stop throwing away
+ * tests/foreach.test (foreach-1.14): useful error information when
+ loop variable sets fail.
+
+ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Rewrite to make an
+ efficient private copy of the list argument, so we can operate on the
+ list elements directly with no fear of shimmering effects. Replaces
+ defensive coding schemes that are otherwise required.
+
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Rewrite to make
+ efficient private copies of the variable and value lists, so we can
+ operate on them without any special shimmer defense coding schemes.
+
+2007-03-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileForeachCmd): Prevent an unexpected
+ * tests/foreach.test (foreach-9.1): infinite loop when the
+ variable list is empty and the foreach is compiled. [Bug 1671138]
+
+2007-02-26 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c (FreeReflectedChannel): Added the missing
+ refcount release between NewRC and FreeRC for the channel handle
+ object, spotted by Don Porter. [Bug 1667990]
+
+2007-02-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Removed surplus
+ copying of the objv array that used to be a workaround for [Bug
+ 404865]. That bug is long fixed.
+
+2007-02-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Use new interface in Tcl_EvalObjEx so that the
+ recounting logic of the List internal rep need not be repeated there.
+ Better encapsulation of internal details.
+
+ * generic/tclInt.h: New internal routine TclListObjCopy() used
+ * generic/tclListObj.c: to efficiently do the equivalent of [lrange
+ $list 0 end]. After some experience with this, might be a good
+ candidate for exposure as a public interface. It's useful for callers
+ of Tcl_ListObjGetElements() who want to control the ongoing validity
+ of the returned objv pointer.
+
+2007-02-22 Andreas Kupries <andreask@activestate.com>
+
+ * tests/pkg.test: Added tests for the case of an alpha package
+ satisfying a require for the regular package, demonstrating a corner
+ case specified in TIP#280. More notes in the comments to the test.
+
+2007-02-20 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: Added "const" specifiers in TclSockGetPort
+ * generic/tclIntDecls.h: regenerated
+ * generic/*.c:
+ * unix/tclUnixChan.c
+ * unix/tclUnixPipe.c
+ * win/tclWinPipe.c
+ * win/tclWinSock.c: Added many "const" specifiers in implementation.
+
+2007-02-20 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/tcltest.n: Typo fix. [Bug 1663539]
+
+2007-02-20 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tclFileName.c: Handle extended paths on Windows NT and
+ * generic/tclPathObj.c: above. These have a \\?\ prefix. [Bug
+ * win/tclWinFile.c: 1479814]
+ * tests/winFCmd.test: Tests for extended path handling.
+
+2007-02-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch.
+ * unix/configure: autoconf-2.59
+
+ * generic/tclIOUtil.c (Tcl_FSEvalFileEx): safe incr of objPtr ref.
+
+2007-02-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/chan.n, doc/clock.n, doc/eval.n, doc/exit.n, doc/expr.n:
+ * doc/interp.n, doc/open.n, doc/platform_shell.n, doc/pwd.n:
+ * doc/refchan.n, doc/regsub.n, doc/scan.n, doc/tclvars.n, doc/tm.n:
+ * doc/unload.n: Apply [Bug 1610310] to fix typos. Thanks to Larry
+ Virden for spotting them.
+
+ * doc/interp.n: Partial fix of [Bug 1662436]; rest requires some
+ policy decisions on what should and shouldn't be safe commands from
+ the "new in 8.5" set.
+
+2007-02-13 Kevin B. Kenny <kennykb@acm.org>
+
+ * tools/fix_tommath_h.tcl: Further tweaking for the x86-64. The change
+ is to make 'mp_digit' be an 'unsigned int' on that platform; since
+ we're using only 32 bits of it, there's no reason to make it a 64-bit
+ 'unsigned long.'
+ * generic/tclTomMath.h: Regenerated.
+
+2007-02-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/re_syntax.n: Corrected description of 'print' class [Bug
+ 1614687] and enhanced description of 'graph' class.
+
+2007-02-12 Kevin B. Kenny <kennykb@acm.org>
+
+ * tools/fix_tommath_h.tcl: Added code to patch out a check for
+ __x86_64__ that caused Tommath to use __attributes(TI)__ for the
+ mp_word type. Tetra-int's simply fail on too many gcc-glibc-OS
+ combinations to be ready for shipment today, even if they work for
+ some of us. This change allows reversion of das's change of 2006-08-18
+ that accomplised the same thing on Darwin. [Bugs 1601380, 1603737,
+ 1609936, 1656265]
+ * generic/tclTomMath.h: Regenerated.
+ * library/tzdata/Africa/Asmara:
+ * library/tzdata/Africa/Asmera:
+ * library/tzdata/America/Nassau:
+ * library/tzdata/Atlantic/Faeroe:
+ * library/tzdata/Atlantic/Faroe:
+ * library/tzdata/Australia/Eucla:
+ * library/tzdata/Pacific/Easter: Rebuilt from Olson's tzdata2007b.
+
+2007-02-09 Joe Mistachkin <joe@mistachkin.com>
+
+ * win/nmakehlp.c: Properly cleanup after nmakehlp, including the
+ * win/makefile.vc: vcX0.pch file.
+
+2007-02-08 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixInit.c (TclpCheckStackSpace): do stack size checks with
+ unsigned size_t to correctly validate stackSize in the 2^31+ range.
+ [Bug 1654104]
+
+2007-02-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c: Corrected broken logic in Tcl_DeleteNamespace
+ * tests/namespace.test: introduced in Patch 1577278 that caused
+ [namespace delete ::] to be effective only at level #0. New test
+ namespace-7.7 should prevent similar error in the future [Bug 1655305]
+
+2007-02-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c: Corrected broken implementation of the
+ * tests/namespace.test: TclMatchIsTrivial optimization on [namespace
+ children $namespace $pattern].
+
+2007-02-04 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4: use gcc4's __attribute__((__visibility__("hidden"))) if
+ available to define MODULE_SCOPE effective on all platforms.
+ * unix/configure.in: add caching to -pipe and zoneinfo checks.
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2007-02-03 Joe Mistachkin <joe@mistachkin.com>
+
+ * win/rules.vc: Fix platform specific file copy macros for downlevel
+ Windows.
+
+2007-01-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclResult.c: Added optimization case to TclTransferResult to
+ cover common case where there's big savings over the fully general
+ path. Thanks to Peter MacDonald. [Bug 1626518]
+
+ * generic/tclLink.c: Broken linked float logic corrected. Thanks to
+ Andy Goth. [Bug 1602538]
+
+ * doc/fcopy.n: Typo fix. [Bug 1630627]
+
+2007-01-28 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: extract build settings that
+ * macosx/Tcl.xcodeproj/default.pbxuser: were common to multiple
+ * macosx/Tcl-Common.xcconfig (new file): configurations into external
+ * macosx/Tcl-Debug.xcconfig (new file): xcconfig files; add extra
+ * macosx/Tcl-Release.xcconfig (new file): configurations for building
+ with SDKs and 64bit; convert legacy jam-based 'Tcl' target to native
+ target with single script phase; correct syntax of build setting
+ references to use $() throughout.
+
+ * macosx/README: document new Tcl.xcodeproj configurations; other
+ minor updates/corrections.
+
+ * generic/tcl.h: update location of version numbers in macosx files.
+
+ * macosx/Tcl.xcode/project.pbxproj: restore 'tcltest' target to
+ * macosx/Tcl.xcode/default.pbxuser: working order by replicating
+ applicable changes to Tcl.xcodeproj since 2006-07-20.
+
+2007-01-25 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4: integrate CPPFLAGS into CFLAGS as late as possible and
+ move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS
+ to avoid errors about multiple -isysroot flags from some older gcc
+ builds.
+
+ * unix/configure: autoconf-2.59
+
+2007-01-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * compat/memcmp.c (memcmp): Reworked so that arithmetic is never
+ performed upon void pointers, since that is illegal. [Bug 1631017]
+
+2007-01-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompile.c (TclCompileScript): Reduce the frequency with
+ which we issue INST_START_CMD, making bytecode both more compact and
+ somewhat faster. The optimized case is where we would otherwise be
+ issuing a sequence of those instructions; in those cases, it is only
+ ever the first one encountered that could possibly trigger.
+
+2007-01-19 Joe Mistachkin <joe@mistachkin.com>
+
+ * tools/man2tcl.c: Include stdlib.h for exit() and improve comment
+ detection.
+ * win/nmakehlp.c: Update usage.
+ * win/makefile.vc: Properly build man2tcl.c for MSVC8.
+
+2007-01-19 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXFCmd.c (TclMacOSXSetFileAttribute): on some versions
+ of Mac OS X, truncate() fails on resource forks, in that case use
+ open() with O_TRUNC instead.
+
+ * macosx/tclMacOSXNotify.c: accommodate changes to prototypes of
+ OSSpinLock(Un)Lock API.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: ensure HOME and USER env vars
+ * macosx/Tcl.xcodeproj/default.pbxuser: are defined when running
+ testsuite from Xcode.
+
+ * tests/env.test: add extra system env vars that need to be preserved
+ on some Mac OS X versions for testsuite to work.
+
+ * unix/Makefile.in: Move libtommath defines into configure.in to
+ * unix/configure.in: avoid replicating them across multiple
+ * macosx/Tcl.xcodeproj/project.pbxproj: buildsystems.
+
+ * unix/tcl.m4: ensure CPPFLAGS env var is used when set. [Bug 1586861]
+ (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS
+ when present in CFLAGS to avoid discrepancies between what headers
+ configure sees during preprocessing tests and compiling tests.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2007-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompile.c (TclCompileScript): Make sure that when parsing
+ an expanded literal fails, a correct bytecode sequence is still
+ issued. [Bug 1638414]. Also make sure that the start of the expansion
+ bytecode sequence falls inside the span of bytecodes for a command.
+ * tests/compile.test (compile-16.24): Added test for [Bug 1638414]
+
+2007-01-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIO.c: Added macros to make usage of ChannelBuffers
+ clearer.
+
+2007-01-11 Joe English <jenglish@users.sourceforge.net>
+
+ * win/tcl.m4(CFLAGS_WARNING): Remove "-Wconversion". This was removed
+ from unix/tcl.m4 2004-07-16 but not from here.
+ * win/configure: Regenerated.
+
+2007-01-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Fixes to work better on Win98. Read version numbers
+ * win/nmakehlp.c: from package index file to avoid keeping numbers in
+ * win/rules.vc: the makefile where they may become de-synchronized.
+
+2007-01-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/regcomp.c (compile, freev): Define a strategy for
+ * generic/regexec.c (exec): managing the internal
+ * generic/regguts.h (AllocVars, FreeVars): vars of the RE engine to
+ * generic/regcustom.h (AllocVars, FreeVars): reduce C stack usage.
+ This will make Tcl as a whole much less likely to run out of stack
+ space...
+
+2007-01-09 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileLindexCmd):
+ * tests/lindex.test (lindex-9.2): Fix silly bug that ended up
+ sometimes compiling list arguments in the wrong order. [Bug 1631364]
+
+2007-01-03 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclDate.c: Regenerated to recover a lost fix from patthoyts.
+ [Bug 1618523]
+
+2006-12-26 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclIO.c (Tcl_GetsObj): Avoid checking for for the LF in a
+ possible CRLF sequence when EOF has already been found.
+
+2006-12-26 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * generic/tclEncoding.c (EscapeFromUtfProc): Clear the
+ TCL_ENCODING_END flag when end bytes are written. This fix keep this
+ method from writing escape bytes for an encoding like iso2022-jp
+ multiple times when the escape byte overlap with the end of the IO
+ buffer.
+ * tests/io.test: Add test for escape byte overlap issue.
+
+2006-12-19 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * unix/tclUnixThrd.c (Tcl_GetAllocMutex, TclpNewAllocMutex): Add
+ intermediate variables to shut up unwanted warnings. [Bug 1618838]
+
+2006-12-19 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixThrd.c (TclpInetNtoa): fix for 64 bit.
+
+ * unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit
+ -arch flag succeeds before enabling 64bit build.
+ * unix/configure: autoconf-2.59
+
+2006-12-17 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/macOSXLoad.test (new file): add testing of .bundle loading and
+ * tests/load.test: unloading on Darwin (in addition
+ * tests/unload.test: to existing tests of .dylib
+ loading).
+ * macosx/Tcl.xcodeproj/project.pbxproj: add building of dltest
+ binaries so that testsuite run from Xcode can use them; fix testsuite
+ run script
+ * unix/configure.in: add support for building dltest binaries as
+ * unix/dltest/Makefile.in: .bundle (in addition to .dylib) on Darwin.
+ * unix/Makefile.in: add stub lib dependency to dltest target.
+ * unix/configure: autoconf-2.59
+
+ * tests/append.test: fix cleanup failure when all tests are skipped.
+
+ * tests/chan.test (chan-16.9): cleanup chan event handler to avoid
+ causing error in event.test when running testsuite with -singleproc 1.
+
+ * tests/info.test: add !singleTestInterp constraint to tests that fail
+ when running testsuite with -singleproc 1. [Bug 1605269]
+
+2006-12-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/string.n: Fix example. [Bug 1615277]
+
+2006-12-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Now that the new internal structs are
+ in use to support operator commands, might as well make them the
+ default for [expr] as well and avoid passing every parsed expression
+ through the inefficient Tcl_Token array format. This addresses most
+ issues in [RFE 1517602]. Assuming no performance disasters result from
+ this, much dead code supporting the other implementation might now be
+ removed.
+
+ * generic/tclBasic.c: Final step routing all direct evaluation forms
+ * generic/tclCompExpr.c: of the operator commands through TEBC,
+ * generic/tclCompile.h: dropping all the routines in tclMathOp.c.
+ * generic/tclMathOp.c: Still needs Engineering Manual attention.
+
+2006-12-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Another step with all sorting operator
+ * generic/tclCompExpr.c: commands now routing through TEBC via
+ * generic/tclCompile.h: TclSortingOpCmd().
+
+2006-12-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Another step down the path of re-using
+ * generic/tclCompExpr.c: TclExecuteByteCode to implement the TIP 174
+ * generic/tclCompile.h: commands instead of using a mass of code
+ * generic/tclMathOp.c: duplication. Now all operator commands that
+ * tests/mathop.test: demand exactly one operation are implemented
+ via TclSingleOpCmd and a call to TEBC.
+
+ * generic/tclCompExpr.c: Revised implementation of TclInvertOpCmd to
+ * generic/tclMathOp.c: perform a bytecode compile / execute sequence.
+ This demonstrates a path toward avoiding mountains of code duplication
+ in tclMathOp.c and tclExecute.c.
+
+ * generic/tclCompile.h: Change TclExecuteByteCode() from static to
+ * generic/tclExecute.c: MODULE_SCOPE so all files including
+ tclCompile.h may call it.
+
+ * generic/tclMathOp.c: More revisions to make tests pass.
+ * tests/mathop.test:
+
+2006-12-08 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclNamesp.c (TclTeardownNamespace): Ensure that dying
+ namespaces unstitch themselves from their referents. [Bug 1571056]
+ (NsEnsembleImplementationCmd): Silence GCC warning.
+
+ * tests/mathop.test: Full tests for & | and ^ operators
+
+2006-12-08 Daniel Steffen <das@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".
+
+2006-12-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompCmds.c: Additional commits correct most
+ * generic/tclExecute.c: failing tests illustrating bugs
+ * generic/tclMathOp.c: uncovered in [Patch 1578137].
+
+ * generic/tclBasic.c: Biggest source of TIP 174 failures was that
+ the commands were not [namespace export]ed from the ::tcl::mathop
+ namespace. More bits from [Patch 1578137] correct that.
+
+ * tests/mathop.test: Commmitted several new tests from Peter Spjuth
+ found in [Patch 1578137]. Many failures now demonstrate issues to fix
+ in the TIP 174 implementation.
+
+2006-12-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/mathop.test: Added tests for ! ~ eq operators.
+ * generic/tclMathOp.c (TclInvertOpCmd): Add in check for non-integral
+ numeric values.
+ * generic/tclCompCmds.c (CompileCompareOpCmd): Factor out the code
+ generation for the chained comparison operators.
+
+2006-12-07 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/exec.test: Fixed line endings (caused win32 problems).
+
+2006-12-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompCmds.c: Revised and consolidated into utility
+ * tests/mathop.test: routines some of routines that compile
+ the new TIP 174 commands. This corrects some known bugs. More to come.
+
+2006-12-06 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/expr.test (expr-47.12): Improved error reporting in hopes of
+ having more information to pursue [Bug 1609936].
+
+2006-12-05 Andreas Kupries <andreask@activestate.com>
+
+ TIP#291 IMPLEMENTATION
+
+ * generic/tclBasic.c: Define tcl_platform element for pointerSize.
+ * doc/tclvars.n:
+
+ * win/Makefile.in: Added installation instructions for the platform
+ * win/makefile.vc: package. Added the platform package.
+ * win/makefile.bc:
+ * unix/Makefile.in:
+
+ * tests/platform.test:
+ * tests/safe.test:
+
+ * library/platform/platform.tcl:
+ * library/platform/shell.tcl:
+ * library/platform/pkgIndex.tcl:
+
+ * doc/platform.n:
+ * doc/platform_shell.n:
+
+2006-12-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPkg.c: When no requirements are supplied to a
+ * tests/pkg.test: [package require $pkg] and [package unknown]
+ is invoked to find a satisfying package, pass the requirement argument
+ "0-" (which means all versions are acceptable). This permits a
+ registered [package unknown] command to call [package vsatisfies
+ $testVersion {*}$args] without any special handling of the empty $args
+ case. This fixes/avoids a bug in [::tcl::tm::UnknownHandler] that was
+ causing old TM versions to be provided in preference to newer TM
+ versions. Thanks to Julian Noble for discovering the issue.
+
+2006-12-04 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP#267 IMPLEMENTATION
+
+ * generic/tclIOCmd.c (Tcl_ExecObjCmd): Added -ignorestderr option,
+ * tests/exec.test, doc/exec.n: loosely from [Patch 1476191]
+
+2006-12-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Added implementation for the
+ CompileExprTree() routine that can produce expression bytecode
+ directly from internal structures with no need to pass through the
+ Tcl_Token array representation. Still disabled by default. #undef
+ USE_EXPR_TOKENS to try it out.
+
+2006-12-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Added expr parsing routines that
+ produce a different set of internal structures representing the parsed
+ expression, as well as routines that go on to convert those structures
+ into the traditional Tcl_Token array format. Use of these routines is
+ currently disabled. #undef PARSE_DIRECT_EXPR_TOKENS to enable them.
+ These routines will only become really useful when more routines that
+ compile directly from the new internal structures are completed.
+
+2006-12-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/file.n: Clarification of [file pathtype] docs. [Bug 1606454]
+
+2006-12-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * libtommath/bn_mp_add.c: Corrected the effects of a
+ * libtommath/bn_mp_div.c: bollixed 'cvs merge' operation
+ * libtommath/bncore.c: that inadvertently committed some
+ * libtommath/tommath_class.h: half-developed code.
+
+ TIP#299 IMPLEMENTATION
+
+ * doc/mathfunc.n: Added isqrt() function to docs
+ * generic/tclBasic.c: Added isqrt() math function (ExprIsqrtFunc)
+ * tests/expr.test (expr-47.*): Added tests for isqrt()
+ * tests/info.test (info-20.2): Added isqrt() to expected math funcs.
+
+2006-12-01 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/chan.test: Correct timing sensitivity in new test. [Bug
+ 1606860]
+
+ TIP#287 IMPLEMENTATION
+
+ * doc/chan.n: New subcommand [chan pending].
+ * generic/tclBasic.c: Thanks to Michael Cleverly for proposal
+ * generic/tclInt.h: and implementation.
+ * generic/tclIOCmd.c:
+ * library/init.tcl:
+ * tests/chan.test:
+ * tests/ioCmd.test:
+
+ TIP#298 IMPLEMENTATION
+
+ * generic/tcl.decls: Tcl_GetBignumAndClearObj -> Tcl_TakeBignumFromObj
+ * generic/tclObj.c:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclExecute.c: Update callers.
+ * generic/tclMathOp.c:
+
+2006-11-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata: Olson's tzdata2006p.
+ * libtommath/bn_mp_sqrt.c: Fixed a bug where the initial approximation
+ to the square root could be on the wrong side, causing failure of
+ convergence.
+
+2006-11-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c (Tcl_AppendObjToErrorInfo): Added
+ Tcl_DecrRefCount() on the objPtr argument to plug memory leaks. This
+ makes the routine a consumer, which makes it easiest to use.
+
+2006-11-28 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: TIP #280 implementation.
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInt.h:
+ * generic/tclInterp.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclProc.c:
+ * tests/compile.test:
+ * tests/info.test:
+ * tests/platform.test:
+ * tests/safe.test:
+
+2006-11-27 Kevin B. Kenny <kennykb@acm.org>
+
+ * unix/tclUnixChan.c (TclUnixWaitForFile):
+ * tests/event.test (event-14.*): Corrected a bug where
+ TclUnixWaitForFile would present select() with the wrong mask on an
+ LP64 machine if a fd number exceeds 32. Thanks to Jean-Luc Fontaine
+ for reporting and diagnosing. [Bug 1602208]
+
+2006-11-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (TclIncrObj): Correct failure to detect
+ floating-point increment values. Thanks to William Coleda [Bug
+ 1602991]
+
+2006-11-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/mathop.test, doc/mathop.n: More bits and pieces of the TIP#174
+ implementation. Note that the test suite is not yet complete.
+
+2006-11-26 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4 (Linux): --enable-64bit support. [Patch 1597389]
+ * unix/configure: autoconf-2.59 [Bug 1230558]
+
+2006-11-25 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP#174 IMPLEMENTATION
+
+ * generic/tclMathOp.c (new file): Completed the implementation of the
+ interpreted versions of all the tcl::mathop commands. Moved to a new
+ file to make tclCompCmds.c more focused in purpose.
+
+2006-11-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (Tcl*OpCmd, TclCompile*OpCmd):
+ * generic/tclBasic.c (Tcl_CreateInterp): Partial implementation of
+ TIP#174; the commands are compiled, but (mostly) not interpreted yet.
+
+2006-11-22 Donal K. Fellows <dkf@users.sf.net>
+
+ TIP#269 IMPLEMENTATION
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Implementation of the [string
+ * tests/string.test (string-25.*): is list] command, based on
+ * doc/string.n: work by Joe Mistachkin, with
+ enhancements by Donal Fellows for better failindex behaviour.
+
+2006-11-22 Don Porter <dgp@users.sourceforge.net>
+
+ * tools/genWinImage.tcl (removed): Removed two files used in
+ * win/README.binary (removed): production of binary distributions
+ for Windows, a task we no longer perform. [Bug 1476980]
+ * generic/tcl.h: Remove mention of win/README.binary in comment
+
+ * generic/tcl.h: Moved TCL_REG_BOSONLY #define from tcl.h to
+ * generic/tclInt.h: tclInt.h. Only know user is Expect, which
+ already #include's tclInt.h. No need to continue greater exposure.
+ [Bug 926500]
+
+2006-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_CreateInterp, TclHideUnsafeCommands):
+ * library/init.tcl: Refactored the [chan] command's guts so that it
+ does not use aliases to global commands, making the code more robust.
+
+2006-11-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (INST_EXPON): Corrected crash on
+ [expr 2**(1<<63)]. Was operating on cleared bignum Tcl_Obj.
+
+2006-11-16 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/apply.n, doc/chan.n: Added examples.
+
+2006-11-15 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#270 IMPLEMENTATION
+
+ * generic/tcl.decls: New public routines Tcl_ObjPrintf,
+ * generic/tclStringObj.c: Tcl_AppendObjToErrorInfo, Tcl_Format,
+ * generic/tclInt.h: Tcl_AppendLimitedToObj,
+ Tcl_AppendFormatToObj and Tcl_AppendPrintfToObj. Former internal
+ versions removed.
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclBasic.c: Updated callers.
+ * generic/tclCkalloc.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclDictObj.c:
+ * generic/tclExecute.c:
+ * generic/tclIORChan.c:
+ * generic/tclIOUtil.c:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclStrToD.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c:
+
+ * tools/genStubs.tcl: Updated script to no longer produce the
+ _ANSI_ARGS_ wrapper in generated declarations. Also revised to accept
+ variadic prototypes with more than one fixed argument. (This is
+ possible since TCL_VARARGS and its limitations are no longer in use).
+ * generic/tcl.h: Some reordering so that macro definitions do
+ not interfere with the now _ANSI_ARGS_-less stub declarations.
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclTomMathDecls.h:
+
+2006-11-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/ChnlStack.3, doc/CrtObjCmd.3, doc/GetIndex.3, doc/OpenTcp.3:
+ * doc/chan.n, doc/fconfigure.n, doc/fcopy.n, doc/foreach.n:
+ * doc/history.n, doc/http.n, doc/library.n, doc/lindex.n:
+ * doc/lrepeat.n, doc/lreverse.n, doc/pkgMkIndex.n, doc/re_syntax.n:
+ Convert \fP to \fR so that man-page scrapers have an easier time.
+
+2006-11-14 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#261 IMPLEMENTATION
+
+ * generic/tclNamesp.c: [namespace import] with 0 arguments
+ introspects the list of imported commands.
+
+2006-11-13 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ * generic/tclThreadStorage.c (Tcl_InitThreadStorage):
+ (Tcl_FinalizeThreadStorage): Silence a compiler warning about
+ presenting a volatile pointer to 'memset'.
+
+2006-11-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIO.c: When [gets] on a binary channel needs to use
+ the "iso8859-1" encoding, save a copy of that encoding per-thread to
+ avoid repeated freeing and re-loading of it from the file system. This
+ replaces the cached copy of this encoding that the platform
+ initialization code used to keep in pre-8.5 releases.
+
+2006-11-13 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Fix gcc warnings about 'cast to/from
+ * generic/tclEncoding.c: pointer from/to integer of different
+ * generic/tclEvent.c: size' on 64-bit platforms by casting
+ * generic/tclExecute.c: to intermediate types
+ * generic/tclHash.c: intptr_t/uintptr_t via new PTR2INT(),
+ * generic/tclIO.c: INT2PTR(), PTR2UINT() and UINT2PTR()
+ * generic/tclInt.h: macros. [Patch 1592791]
+ * generic/tclProc.c:
+ * generic/tclTest.c:
+ * generic/tclThreadStorage.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/configure.in:
+ * unix/tclUnixChan.c:
+ * unix/tclUnixPipe.c:
+ * unix/tclUnixPort.h:
+ * unix/tclUnixTest.c:
+ * unix/tclUnixThrd.c:
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2006-11-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h, generic/tclInt.decls: Transfer TclPtrMakeUpvar and
+ TclObjLookupVar to the internal stubs table.
+
+2006-11-10 Daniel Steffen <das@users.sourceforge.net>
+
+ * tests/fCmd.test (fCmd-6.26): fix failure when env(HOME) path
+ contains symlinks.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: remove tclParseExpr.c; when
+ running testsuite from inside Xcdoe, skip stack-3.1 (it only fails
+ under those circumstances).
+
+ * unix/tcl.m4 (Darwin): suppress linker arch warnings when building
+ universal for both 32 & 64 bit and no 64bit CoreFoundation is
+ available; sync with tk tcl.m4 change.
+ * unix/configure.in: whitespace.
+ * unix/configure: autoconf-2.59
+
+2006-11-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c (removed): Moved all the code of
+ * generic/tclCompExpr.c: tclParseExpr.c into tclCompExpr.c.
+ * unix/Makefile.in: This sets the stage for expr compiling to work
+ * win/Makefile.in: directly with the full parse tree structures,
+ * win/makefile.bc: and not have to pass through the information
+ * win/makefile.vc: lossy format of an array of Tcl_Tokens.
+ * win/tcl.dsp:
+
+2006-11-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ TIP#272 IMPLEMENTATION
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Implementation of the
+ * tests/string.test, tests/stringComp.test: [string reverse] command
+ * doc/string.n: from TIP#272.
+
+ * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Implementation of the
+ * generic/tclBasic.c, generic/tclInt.h: [lreverse] command from
+ * tests/cmdIL.test (cmdIL-7.*): TIP#272.
+ * doc/lreverse.n:
+
+2006-11-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclIO.c, generic/tclPkg.c: Style & clarity rewrites.
+
+2006-11-07 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixFCmd.c (CopyFile): Added code to fall back to a
+ hardwired default block size should the filesystem report a bogus
+ value. [Bug 1586470]
+
+2006-11-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Changed Tcl_ObjPrintf() response to an
+ invalid format specifier string. No longer panics; now produces an
+ error message as output.
+
+ TIP#274 IMPLEMENTATION
+
+ * generic/tclParseExpr.c: Exponentiation operator is now right
+ * tests/expr.test: associative. [Patch 1556802]
+
+2006-11-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOVI): fix por possible leak of a Command in
+ the presence of execution traces that delete it.
+
+ * generic/tclBasic.c (TEOVI):
+ * tests/trace.test (trace-21.11): fix for [Bug 1590232], execution
+ traces may cause a second command resolution in the wrong namespace.
+
+2006-11-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/event.test (event-11.5): Rewrote tests to stop Tcl from
+ * tests/io.test (multiple tests): opening sockets that are
+ * tests/ioCmd.test (iocmd-15.1,16,17): reachable from outside hosts
+ * tests/iogt.test (__echo_srv__.tcl): where not necessary. This is
+ * tests/socket.test (multiple tests): noticably annoying on some
+ * tests/unixInit.test (unixInit-1.2): systems (e.g., Windows).
+
+2006-11-02 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: check autoconf/autoheader exit
+ status and stop build if they fail.
+
+2006-11-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/ParseCmd.3, doc/Tcl.n, doc/eval.n, doc/exec.n:
+ * doc/fconfigure.n, doc/interp.n, doc/unknown.n:
+ * library/auto.tcl, library/init.tcl, library/package.tcl:
+ * library/safe.tcl, library/tm.tcl, library/msgcat/msgcat.tcl:
+ * tests/all.tcl, tests/basic.test, tests/cmdInfo.test:
+ * tests/compile.test, tests/encoding.test, tests/execute.test:
+ * tests/fCmd.test, tests/http.test, tests/init.test:
+ * tests/interp.test, tests/io.test, tests/ioUtil.test:
+ * tests/iogt.test, tests/namespace-old.test, tests/namespace.test:
+ * tests/parse.test, tests/pkg.test, tests/pkgMkIndex.test:
+ * tests/proc.test, tests/reg.test, tests/trace.test:
+ * tests/upvar.test, tests/winConsole.test, tests/winFCmd.test:
+ * tools/tclZIC.tcl:
+ * generic/tclParse.c (Tcl_ParseCommand): Replace {expand} with {*}
+ officially (TIP #293). Leave -DALLOW_EXPAND=0|1 option to keep
+ {expand} syntax for transition users. [Bug 1589629]
+
+2006-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclBasic.c, generic/tclInterp.c, generic/tclProc.c: Silence
+ warnings from gcc over signed/unsigned and TclStackAlloc().
+ * generic/tclCmdMZ.c: Update to more compact and clearer coding style.
+
+2006-11-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c: Further revisions to produce the routines
+ * generic/tclInt.h: TclFormat() and TclAppendFormatToObj() that
+ * generic/tclNamesp.c: accept (objc, objv) arguments rather than
+ * generic/tclStringObj.c: any varargs stuff.
+
+ * generic/tclBasic.c: Further revised TclAppendPrintToObj() and
+ * generic/tclCkalloc.c: TclObjPrintf() routines to panic when unable
+ * generic/tclCmdAH.c: to complete their formatting operations,
+ * generic/tclCmdIL.c: rather than report an error message. This
+ * generic/tclCmdMZ.c: means an interp argument for error message
+ * generic/tclDictObj.c: recording is no longer needed, further
+ * generic/tclExecute.c: simplifying the interface for callers.
+ * generic/tclIORChan.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInt.h:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclParseExpr.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclStringObj.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c:
+
+2006-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/winPipe.test (winpipe-4.[2345]): Made robust when run in
+ directory with spaces in its name.
+
+ * generic/tclCmdAH.c: Clean up uses of cast NULLs.
+
+ * generic/tclInterp.c (AliasObjCmd): Added more explanatory comments.
+
+ * generic/tclBasic.c (TclEvalObjvInternal): Rewrote so that comments
+ are relevant and informative once more. Also made the unknown handler
+ processing use the Tcl execution stack for working space, and not the
+ general heap.
+
+2006-11-01 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixPort.h: ensure MODULE_SCOPE is defined before use, so
+ that tclPort.h can once again be included without tclInt.h.
+
+ * generic/tclEnv.c (Darwin): mark _environ symbol as unexported even
+ when MODULE_SCOPE != __private_extern__.
+
+2006-10-31 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Refactored and renamed the routines
+ * generic/tclCkalloc.c: TclObjPrintf, TclFormatObj, and
+ * generic/tclCmdAH.c: TclFormatToErrorInfo to a new set of routines
+ * generic/tclCmdIL.c: TclAppendPrintfToObj, TclAppendFormatToObj,
+ * generic/tclCmdMZ.c: TclObjPrintf, and TclObjFormat, with the
+ * generic/tclDictObj.c: intent of making the latter list, plus
+ * generic/tclExecute.c: TclAppendLimitedToObj and
+ * generic/tclIORChan.c: TclAppendObjToErrorInfo, public via a revised
+ * generic/tclIOUtil.c: TIP 270.
+ * generic/tclInt.h:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclParseExpr.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclStringObj.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c:
+
+2006-10-31 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c, generic/tcl.h, generic/tclInterp.c:
+ * generic/tclNamesp.c: removing the flag bit TCL_EVAL_NOREWRITE, the
+ last remnant of the callObjc/v fiasco. It is not needed, as it is now
+ always set and checked or'ed with TCL_EVAL_INVOKE.
+
+2006-10-31 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/rules.vc: Fix for [Bug 1582769] - options conflict with VC2003.
+
+2006-10-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c, generic/tclNamesp.c, generic/tclProc.c:
+ * generic/tclInt.h: Removed the callObjc and callObjv fields from the
+ Interp structure. They did not function correctly and made other parts
+ of the core amazingly complex, resulting in a substantive change to
+ [info level] behaviour. [Bug 1587618]
+ * library/clock.tcl: Removed use of [info level 0] for calculating the
+ command name as used by the user and replace with a literal. What's
+ there now is sucky, but at least appears to be right to most users.
+ * tests/namespace.test (namespace-42.7,namespace-47.1): Reverted
+ changes to these tests.
+ * tests/info.test (info-9.11,info-9.12): Added knownBug constraint
+ since these tests require a different behaviour of [info level] than
+ is possible because of other dependencies.
+
+2006-10-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tools/tcltk-man2html.tcl (option-toc): handle any kind of options
+ defined toc section (needed for ttk docs)
+
+2006-10-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOVI): insured that the interp's callObjc/v
+ fields are restored after traces run, as they be spoiled. This was
+ causing a segfault in tcllib's profiler tests.
+
+2006-10-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (INST_MOD): Corrected improper testing of the
+ * tests/expr.test: sign of bignums when applying Tcl's
+ division rules. Thanks to Peter Spjuth. [Bug 1585704]
+
+2006-10-29 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclNamesp.c (EnsembleImplementationCmd):
+ * tests/namespace.test (47.7-8): reverted a wrong "optimisation" that
+ completely broke snit; added two tests.
+
+2006-10-28 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclProc.c (ObjInterpProcEx, TclObjInterpProcCore): Split the
+ core of procedures to make it easier to build procedure-like code
+ without going through horrible contortions. This is the last critical
+ component to make advanced OO systems workable as simple loadable
+ extensions. TOIPC is now in the internal stub table.
+ (MakeProcError, MakeLambdaError): Refactored ProcessProcResultCode to
+ be simpler, some of which goes to TclObjInterpProcCore, and the rest
+ of which is now in these far simpler routines which just do errorInfo
+ stack generation for different types of procedure-like entity.
+ * tests/apply.test (apply-5.1): Updated to expect the more informative
+ form of message.
+
+2006-10-27 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclVar.c (HasLocalVars): New macro to make various bits and
+ pieces cleaner.
+
+ * generic/tclNamesp.c (TclSetNsPath): Expose SetNsPath() through
+ internal stubs table with semi-external name.
+
+ * generic/tclInt.h (CallFrame): Add a field for handling context data
+ for extensions (like object systems) that should be tied to a call
+ frame (and not a command or interpreter).
+
+ * generic/tclBasic.c (TclRenameCommand): Change to take CONST args;
+ they were only ever used in a constant way anyway, so this appears to
+ be a spot that was missed during TIP#27 work.
+
+2006-10-26 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (SetLambdaFromAny): minor change, eliminate
+ redundant call to Tcl_GetString (thanks aku).
+
+ * generic/tclInterp.c (ApplyObjCmd):
+ * generic/tclNamesp.c (EnsembleImplementationCmd): replaced ckalloc
+ (heap) with TclStackAlloc (execution stack).
+
+2006-10-24 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/info.test (info-9.11-12): tests for [Bug 1577492]
+ * tests/apply.test (apply-4.3-5): tests for [Bug 1574835]
+
+ * generic/tclProc.c (ObjInterpProcEx): disable itcl hacks for calls
+ from ApplyObjCmd (islambda==1), as they mess apply's error messages
+ [Bug 1583266]
+
+2006-10-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (ApplyObjCmd): fix wrong#args for apply by using
+ the ensemble rewrite engine. [Bug 1574835]
+ * generic/tclInterp.c (AliasObjCmd): previous commit missed usage of
+ TCL_EVAL_NOREWRITE for aliases.
+
+ * generic/tclBasic.c (TclEvalObjvInternal): removed redundant check
+ for ensembles. [Bug 1577628]
+
+ * library/clock.tcl (format, scan): corrected wrong # args messages to
+ * tests/clock.test (3.1, 34.1): make use of the new rewrite
+ capabilities of [info level]
+
+ * generic/tcl.h: Lets TEOV update the iPtr->callObj[cv] new
+ * generic/tclBasic.c: fields, except when the flag bit
+ * generic/tclInt.h: TCL_EVAL_NOREWRITE is present. These values
+ * generic/tclNamesp.c: are used by Tcl_PushCallFrame to initialise
+ * generic/tclProc.c: the frame's obj[cv] fields, and allows
+ * tests/namespace.test: [info level] to know and use ensemble
+ rewrites. [Bug 1577492]
+
+ ***POTENTIAL INCOMPATIBILITY***
+ The return value from [info level 0] on interp alias calls is changed:
+ previously returned the target command (including curried values), now
+ returns the source - what was actually called.
+
+2006-10-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tcl.h: Modified the Tcl call stack so there is
+ * generic/tclBasic.c: always a valid CallFrame, even at level 0
+ * generic/tclCmdIL.c: [Patch 1577278]. Most of the changes
+ * generic/tclInt.h: involve removing tests for a NULL
+ * generic/tclNamesp.c: iPtr->(var)framePtr. There is now a
+ * generic/tclObj.c: CallFrame pushed at interp creation with a
+ * generic/tclProc.c: pointer to it stored in iPtr->rootFramePtr.
+ * generic/tclTrace.c: A second unused field in Interp is
+ * generic/tclVar.c: hijacked to enable further functionality,
+ currently unused (but with several FRQs depending on it).
+
+ ***POTENTIAL INCOMPATIBILITY***
+ Any user that includes tclInt.h and needs to determine if it is
+ running at level 0 should change (iPtr->varFramePtr == NULL) to
+ (iPtr->varFramePtr == iPtr->rootFramePtr).
+
+2006-10-23 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bump version number to 8.5a6
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+2006-10-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tcl.h, generic/tclHash.c: Tcl_FindHashEntry now calls
+ Tcl_CreateHashEntry with a newPtr set to NULL: this would have caused
+ a segfault previously and eliminates duplicated code. A macro has been
+ added to tcl.h (only used when TCL_PRESERVE_BINARY_COMPATABALITY is
+ not set - i.e., not by default).
+
+2006-10-20 Reinhard Max <max@tclers.tk>
+
+ * unix/configure.in: Added autodetection for OS-supplied timezone
+ * unix/Makefile.in: files and configure switches to override the
+ * unix/configure: detected default.
+
+2006-10-20 Daniel Steffen <das@users.sourceforge.net>
+
+ *** 8.5a5 TAGGED FOR RELEASE ***
+
+ * tools/tcltk-man2html.tcl: add support for alpha & beta versions to
+ useversion glob pattern. [Bug 1579941]
+
+2006-10-18 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: 8.5a5 release date set
+
+ * doc/Encoding.3: Missing doc updates (mostly Table of
+ * doc/Ensemble.3: Contents) exposed by `make checkdoc`
+ * doc/FileSystem.3:
+ * doc/GetTime.3:
+ * doc/PkgRequire.3:
+
+2006-10-17 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInterp.c (ApplyObjCmd): fixed bad error in 2006-10-12
+ commit: interp released too early. Spotted by mistachkin.
+
+2006-10-16 Miguel Sofer <msofer@users.sf.net>
+
+ * tclProc.c (SetLambdaFromAny):
+ * tests/apply.test (9.1-9.2): plugged intrep leak [Bug 1578454],
+ found by mjanssen.
+
+2006-10-16 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: Moved TIP#219 cleanup to DeleteInterpProc.
+
+2006-10-16 Daniel Steffen <das@users.sourceforge.net>
+
+ * changes: updates for 8.5a5 release.
+
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): Darwin: fix for main
+ thread, where pthread_get_stacksize_np() returns incorrect info.
+
+ * macosx/GNUmakefile: don't redo prebinding of non-prebound binaires.
+
+2006-10-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPkg.c (ExactRequirement): Plugged memory leak. Also
+ changed Tcl_Alloc()/Tcl_Free() calls to ckalloc()/ckfree() for easier
+ memory debugging in the future. [Bug 1568373]
+
+ * library/tcltest/tcltest.tcl: Revise tcltest bump to 2.3a1.
+ * library/tcltest/pkgIndex.tcl: This permits more features to be
+ * unix/Makefile.in: added to tcltest before we reach version 2.3.0
+ * win/Makefile.in: best timed to match the release of Tcl 8.5.0.
+ * win/makefile.vc: This also serves as a demo of TIP 268 features
+
+2006-10-13 Colin McCormack <coldstore@users.sf.net>
+
+ * win/tclWinFile.c: corrected erroneous attempt to protect against
+ NULL return from Tcl_FSGetNormalizedPath per [Bug 1548263] causing
+ [Bug 1575837].
+ * win/tclWinFile.c: alfredd supplied patch to fix [Bug 1575837]
+
+2006-10-13 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): on Darwin, use
+ * unix/tcl.m4: pthread_get_stacksize_np() API to get thread stack size
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2006-10-12 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclInterp.c (ApplyObjCmd):
+ * tests/interp.test (interp-14.5-10): made [interp alias] use the
+ ensemble rewrite machinery to produce better error messages [Bug
+ 1576006]
+
+2006-10-12 David Gravereaux <davygrvy@pobox.com>
+
+ * win/nmakehlp.c: Replaced all wnsprintf() calls with snprintf().
+ wnsprintf was not in my shwlapi header file (VC++6)
+
+2006-10-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPkg.c (Tcl_PackageRequireEx): Corrected crash when
+ argument version=NULL passed in.
+
+2006-10-10 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for 8.5a5 release.
+
+ * generic/tclNamespace.c (TclTeardownNamespace): After the
+ commandPathSourceList of a namespace is cleared, set the
+ commandPathSourceList to NULL so we don't try to walk the list a
+ second time, possibly after it is freed. [Bug 1566526]
+ * tests/namespace.test (namespace-51.16): Added test.
+
+2006-10-09 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/UpVar.3: brough the docs in accordance to the code. Ever since
+ 8.0, Tcl_UpVar(2)? accepts TCL_NAMESPACE_ONLY as a flag value, and
+ var-3.4 tests for proper behaviour. The docs only allowed 0 and
+ TCL_GLOBAL_ONLY. [Bug 1574099]
+
+2006-10-09 Miguel Sofer <msofer@users.sf.net>
+
+ * tests/*.test: updated all tests to refer explicitly to the global
+ variables ::errorInfo, ::errorCode, ::env and ::tcl_platform: many
+ were relying on the alternative lookup in the global namespace, that
+ feature is tested specifically in namespace and variable tests.
+
+ The modified testfiles are: apply.test, basic.test, case.test,
+ cmdIL.test, cmdMZ.test, compExpr-old.test, error.test, eval.test,
+ event.test, expr.test, fileSystem.test, for.test, http.test, if.test,
+ incr-old.test, incr.test, interp.test, io.test, ioCmd.test, load.test,
+ misc.test, namespace.test, parse.test, parseOld.test, pkg.test,
+ proc-old.test, set.test, switch.test, tcltest.test, thread.test,
+ var.test, while-old.test, while.test.
+
+2006-10-06 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/rules.vc: [Bug 1571954] avoid /RTCc flag with MSVC8
+
+2006-10-06 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * doc/binary.n: TIP #275: Support unsigned values in binary
+ * generic/tclBinary.c: command. Tests and documentation updated.
+ * tests/binary.test:
+
+2006-10-05 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl: Fixed bug in TIP #189 implementation, now allowing
+ '_' in module names.
+
+2006-10-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/http/http.tcl (http::geturl): only do geturl url rfc 3986
+ validity checking if $::http::strict is true (default true for 8.5).
+ [Bug 1560506]
+
+ * generic/tcl.h: note limitation on changing Tcl_UniChar size
+ * generic/tclEncoding.c (UtfToUnicodeProc, UnicodeToUtfProc):
+ * tests/encoding.test (encoding-16.1): fix alignment issues in
+ unicode <> utf conversion procs. [Bug 1122671]
+
+2006-10-05 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (Tcl_LappendObjCmd):
+ * tests/append.test(4.21-22): fix for longstanding [Bug 1570718],
+ lappending nothing to non-list. Reported by lvirden
+
+2006-10-04 Kevin B. Kenny <kennykb@acm.org>
+
+ * tzdata/: Olson's tzdata2006m.
+
+2006-10-01 Kevin B. Kenny <kennykb@acm.org>
+
+ * tests/clock.test (clock-49.2): Removed a locale dependency that
+ caused a spurious failure in the German locale. [Bug 1567956]
+
+2006-10-01 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/Eval.3 (TclEvalObjv): added note on refCount management for the
+ elements of objv. [Bug 730244]
+
+2006-10-01 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinFile.c: Handle possible missing define.
+
+ * win/tclWinFile.c (TclpUtime): [Bug 1420432] file mtime fails for
+ * tests/cmdAH.test: directories on windows
+
+ * tests/winFile.test: Handle Msys environment a little differently in
+ getuser function. [Bug 1567956]
+
+2006-09-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclUtil.c (Tcl_SplitList): optimisation, [Patch 1344747] by
+ dgp.
+
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclObj.c:
+ * generic/tclStubInit.c: added an internal function TclObjBeingDeleted
+ to provide info as to the reason for the loss of an internal rep. [FR
+ 1512138]
+
+ * generic/tclCompile.c:
+ * generic/tclHistory.c:
+ * generic/tclInt.h:
+ * generic/tclProc.c: made Tcl_RecordAndEvalObj not call "history" if
+ it has been redefined to an empty proc, in order to reduce the noise
+ when debugging [FR 1190441]. Moved TclCompileNoOp from tclProc.c to
+ tclCompile.c
+
+2006-09-28 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths
+ * tests/pkg.test: before comparison. The shorter string is the smaller
+ number. Added testcases as well. Interestingly all existing test cases
+ for vcompare compared numbers of the same length with each other. [Bug
+ 1563836]
+
+2006-09-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclIO.c (Tcl_GetsObj): added two test'n'panic guards for
+ possible NULL derefs, [Bug 1566382] and coverity #33.
+
+2006-09-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrected error in INST_LSHIFT in the
+ * tests/expr.test: calculation done to determine whether a shift
+ in the (long int) type is possible. The calculation had literal value
+ "1" where it needed a value "1L" to compute the correct result. Error
+ detected via testing with the math::bigfloat package [Bug 1567222]
+
+ * generic/tclPkg.c (CompareVersion): Flatten strcmp() results to
+ {-1, 0, 1} to match expectations of CompareVersion() callers.
+
+2006-09-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/regc_color.c (singleton):
+ * generic/regc_cvec.c (addmcce):
+ * generic/regcomp.c (compile, dovec): the static function addmcce does
+ nothing when called with two NULL pointers; the only call is by
+ compile with two NULL pointers (regcomp.c #includes regc_cvec.c).
+ Large parts (all?) the code for mcce (multi character collating
+ element) that we do not use is ifdef'ed out with the macro
+ REGEXP_MCCE_ENABLE.
+ This silences coverity bugs 7, 16, 80
+
+ * generic/regc_color.c (uncolorchain):
+ * generic/regc_nfa.c (freearc): changed tests and asserts to
+ equivalent formulation, designed to avoid an explicit comparison to
+ NULL and satisfy coverity that 6 and 9 are not bugs.
+
+2006-09-27 Andreas Kupries <andreask@activestate.com>
+
+ * tests/pkg.test: Added test for version comparison at the 32bit
+ boundary. [Bug 1563836]
+
+ * generic/tclPkg.c: Rewrote CompareVersion to perform string
+ comparison instead of numeric. This breaks through the 32bit limit on
+ version numbers. See code for details (handling of leading zeros,
+ signs, etc.). un-CONSTed some arguments of CompareVersions,
+ RequirementSatisfied, and AllRequirementsSatisfied. The new compare
+ modifies the string (temporary string terminators). All callers use
+ heap-allocated ver-intreps, so we are good with that. [Bug 1563836]
+
+2006-09-27 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclFileName.c (TclGlob): added a panic for a call with
+ TCL_GLOBMODE_TAILS and pathPrefix==NULL. This would cause a segfault,
+ as found by coverity #26.
+
+2006-09-26 Kevin B. Kenny <kennykb@acm.org>
+
+ * doc/Encoding.3: Added covariant 'const' qualifier for the
+ * generic/tcl.decls: Tcl_EncodingType argument to
+ * generic/tclEncoding.c: Tcl_CreateEncoding. [Further TIP#27 work.]
+ * generic/tclDecls.h: Reran 'make genstubs'.
+
+2006-09-26 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc: Additional compiler flags and amd64 support.
+ * win/nmakehlp.c:
+ * win/rules.vc:
+
+2006-09-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: As 2006-09-22 commit from Donal K. Fellows
+ demonstrates, "#define NULL 0" is just wrong, and as a quotable chat
+ figure observed, "If NULL isn't defined, we're not using a C compiler"
+ Improper fallback definition of NULL removed.
+
+2006-09-25 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * generic/tcl.h: More fixing which struct stat to refer to.
+ * generic/tclGetDate.y: Some casts from time_t to int required.
+ * generic/tclTimer.c: Tcl_Time structure members are longs.
+ * win/makefile.vc: Support for varying compiler options
+ * win/rules.vc: and build to platform-specific subdirs.
+
+2006-09-25 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (Tcl_StackChannel): Fixed [Bug 1564642], aka
+ coverity #51. Extended loop condition, added checking for NULL to
+ prevent seg.fault.
+
+2006-09-25 Andreas Kupries <andreask@activestate.com>
+
+ * doc/package.n: Fixed nits reported by Daniel Steffen in the TIP#268
+ changes.
+
+2006-09-25 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclNotify.c (Tcl_DeleteEvents): Simplified the code in hopes
+ of making the invariants clearer and proving to Coverity that the
+ event queue memory is managed correctly.
+
+2006-09-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNotify.c (Tcl_DeleteEvents): Make it clear what happens
+ when the event queue is mismanaged. [Bug 1564677], coverity bug #10.
+
+2006-09-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclParse.c (Tcl_ParseCommand): also return an error if
+ start==NULL and numBytes<0. This is coverity's bug #20
+
+ * generic/tclStringObj.c (STRING_SIZE): fix allocation for 0-length
+ strings. This is coverity's bugs #54-5
+
+2006-09-22 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclInt.h: Moved TIP#268's field 'packagePrefer' to the end
+ of the structure, for better backward compatibility.
+
+2006-09-22 Andreas Kupries <andreask@activestate.com>
+
+ TIP#268 IMPLEMENTATION
+
+ * generic/tclDecls.h: Regenerated from tcl.decls.
+ * generic/tclStubInit.c:
+
+ * doc/PkgRequire.3: Documentation of extended API, extended testsuite.
+ * doc/package.n:
+ * tests/pkg.test:
+
+ * generic/tcl.decls: Implementation.
+ * generic/tclBasic.c:
+ * generic/tclConfig.c:
+ * generic/tclInt.h:
+ * generic/tclPkg.c:
+ * generic/tclTest.c:
+ * generic/tclTomMathInterface.c:
+ * library/init.tcl:
+ * library/package.tcl:
+ * library/tm.tcl:
+
+2006-09-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclThreadTest.c (TclCreateThread): Use NULL instead of 0 as
+ end-of-strings marker to Tcl_AppendResult; the difference matters on
+ 64-bit machines. [Bug 1562528]
+
+2006-09-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclUtil.c: Dropped ParseInteger() routine. TclParseNumber
+ covers the task just fine.
+
+2006-09-19 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclEvent.c (Tcl_VwaitObjCmd): Rewrite so that an exceeded
+ limit trapped in a vwait cannot cause a dangerous dangling trace.
+
+2006-09-19 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c (INST_EXPON): Native type overflow detection
+ * tests/expr.test: was completely broken. Falling back on use of
+ bignums for all non-trivial ** calculations until
+ native-type-constrained special cases can be done carefully and
+ correctly. [Bug 1561260]
+
+2006-09-15 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/http/http.tcl: Change " " -> "+" url encoding mapping
+ * library/http/pkgIndex.tcl: to " " -> "%20" as per RFC 3986.
+ * tests/http.test (http-5.1): bump http to 2.5.3
+ * unix/Makefile.in:
+ * win/Makefile.in:
+
+2006-09-12 Andreas Kupries <andreask@activestate.com>
+
+ * unix/configure.in (HAVE_MTSAFE_GETHOST*): Modified to recognize
+ HP-UX 11.00 and beyond as having mt-safe implementations of the
+ gethost functions.
+ * unix/configure: Regenerated, using autoconf 2.59
+
+ * unix/tclUnixCompat.c (PadBuffer): Fixed bug in calculation of the
+ increment needed to align the pointer, and added documentation
+ explaining why the macro is implemented as it is.
+
+2006-09-11 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/rules.vc: Updated to install http, tcltest and msgcat as
+ * win/makefile.vc: Tcl Modules (as per Makefile.in).
+ * win/makefile.vc: Added tommath_(super)class headers.
+
+2006-09-11 Andreas Kupries <andreask@activestate.com>
+
+ * unix/Makefile.in (install-libraries): Fixed typo tcltest 2.3.9 ->
+ 2.3.0.
+
+2006-09-11 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixCompat.c: make compatLock static and only declare it
+ when it will actually be used; #ifdef parts of TSD that are not always
+ needed; adjust #ifdefs to cover all possible cases; fix whitespace.
+
+2006-09-11 Andreas Kupries <andreask@activestate.com>
+
+ * tests/msgcat.test: Bumped version in auxiliary files as well.
+ * doc/msgcat.n:
+
+2006-09-11 Kevin B. Kenny <kennykb@acm.org>
+
+ * unix/Makefile.in: Bumped msgcat version to 1.4.2 to be
+ * win/Makefile.in: consistent with dgp's commits of 2006-09-10.
+
+2006-09-11 Don Porter <dgp@users.sourceforge.net>
+
+ * library/msgcat/msgcat.tcl: Removed some unneeded [uplevel]s.
+
+2006-09-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrected INST_EXPON flaw that treated
+ * tests/expr.test: $x**1 as $x**3. [Bug 1555371]
+
+ * doc/tcltest.n: Bump to version tcltest 2.3.0 to
+ * library/tcltest/pkgIndex.tcl: account for new "-verbose line"
+ * library/tcltest/tcltest.tcl: feature.
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.bc:
+ * win/makefile.vc:
+
+ * library/msgcat/msgcat.tcl: Bump to version msgcat 1.4.2 to
+ * library/msgcat/pkgIndex.tcl: account for modifications.
+
+2006-09-10 Daniel Steffen <das@users.sourceforge.net>
+
+ * library/msgcat/msgcat.tcl (msgcat::Init): on Darwin, add fallback of
+ * tests/msgcat.test: default msgcat locale to
+ * unix/tclUnixInit.c (TclpSetVariables): current CFLocale
+ identifier if available (via private ::tcl::mac::locale global, set at
+ interp init when on Mac OS X 10.3 or later with CoreFoundation).
+
+ * library/tcltest/tcltest.tcl: add 'line' verbose level: prints source
+ * doc/tcltest.n: file line information of failing tests.
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add new tclUnixCompat.c file;
+ revise tests target to use new tcltest 'line' verbose level.
+
+ * unix/configure.in: add descriptions to new AC_DEFINEs for MT-safe.
+ * unix/tcl.m4: add caching to new SC_TCL_* macros for MT-safe wrappers
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2006-09-08 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixCompat.c: Added fallback to gethostbyname() and
+ gethostbyaddr() if the implementation is known to be MT-safe
+ (currently for Darwin 6 or later only).
+
+ * unix/configure.in: Assume gethostbyname() and gethostbyaddr() are
+ MT-safe starting with Darwin 6 (Mac OSX 10.2).
+
+ * unix/configure: Regenerated with autoconf V2.59
+
+2006-09-08 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixCompat.c: Fixed conditions for CopyArray/CopyString, and
+ CopyHostent. Also fixed bad var names in TclpGetHostByName.
+
+2006-09-07 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixCompat.c: Added fallback to MT-unsafe library calls if
+ TCL_THREADS is not defined.
+ Fixed alignment of arrays copied by CopyArray() to be on the
+ sizeof(char *) boundary.
+
+2006-09-07 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixChan.c: Rewritten MT-safe wrappers to return ptrs to
+ * unix/tclUnixCompat.c: TSD storage making them all look like their
+ * unix/tclUnixFCmd.c: MT-unsafe pendants API-wise.
+ * unix/tclUnixPort.h:
+ * unix/tclUnixSock.c:
+
+2006-09-06 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * unix/tclUnixChan.c: Added TCL_THREADS ifdef'ed usage of MT-safe
+ * unix/tclUnixFCmd.c: calls like: getpwuid, getpwnam, getgrgid,
+ * unix/tclUnixSock.c: getgrnam, gethostbyname and gethostbyaddr.
+ * unix/tclUnixPort.h: See [Bug 999544]
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * unix/configure: Regenerated.
+
+ * unix/tclUnixCompat.c: New file containing MT-safe implementation of
+ some library calls.
+
+2006-09-04 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Removed much complexity that is no
+ longer needed.
+
+ * tests/main.text (Tcl_Main-4.4): Test corrected to not be
+ timing sensitive to the Bug 1481986 fix. [Bug 1550858]
+
+2006-09-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/package.n: correct package example
+
+2006-08-31 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Corrected flawed logic for disabling
+ the INST_TRY_CVT_TO_NUMERIC instruction at the end of an expression
+ when function arguments contain operators. [Bug 1541274]
+
+ * tests/expr-old.test: The remaining failing tests reported in
+ * tests/expr.test: [Bug 1381715] are all new in Tcl 8.5, so
+ there's really no issue of compatibility with Tcl 8.4 result to deal
+ with. Fixed by updating tests to expect 8.5 results.
+
+2006-08-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Dropped the old expr parser.
+
+2006-08-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclBasic.c (Tcl_CreateInterp): init iPtr->threadId
+
+ * win/tclWinChan.c [Bug 819667] Improve logic for identifying COM
+ ports.
+
+ * generic/tclIOGT.c (ExecuteCallback):
+ * generic/tclPkg.c (Tcl_PkgRequireEx): replace Tcl_GlobalEval(Obj)
+ with more efficient Tcl_Eval(Obj)Ex
+
+ * unix/Makefile.in (valgrindshell): add valgrindshell target and
+ update default VALGRINDARGS. User can override, or add to it with
+ VALGRIND_OPTS env var.
+
+ * generic/tclFileName.c (DoGlob): match incrs with decrs.
+
+2006-08-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Use the "parent" field of orphan
+ ExprNodes to store the closure of left pointers. This lets us avoid
+ repeated re-scanning leftward for the left boundary of subexpressions,
+ which in worst case led to near O(N^2) runtime.
+
+2006-08-29 Joe Mistachkin <joe@mistachkin.com>
+
+ * unix/tclUnixInit.c: Fixed the issue (typo) that was causing
+ * unix/tclUnixThrd.c (TclpThreadGetStackSize): stack.test to fail on
+ FreeBSD (and possibly other Unix platforms).
+
+2006-08-29 Colin McCormack <coldstore@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: Added test for NULL return from
+ * generic/tclPathObj.c: Tcl_FSGetNormalizedPath which was causing
+ * unix/tclUnixFile.c: segv's per [Bug 1548263]
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+
+2006-08-28 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata/America/Havana: Regenerated from Olson's
+ * library/tzdata/America/Tegucigalpa: tzdata2006k.
+ * library/tzdata/Asia/Gaza:
+
+2006-08-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStringObj.c: Revised ObjPrintfVA to take care to
+ * generic/tclParseExpr.c: copy only whole characters when doing
+ %s formatting. This relieves callers of TclObjPrintf() and
+ TclFormatToErrorInfo() from needing to fix arguments to character
+ boundaries. Tcl_ParseExpr() simplified by taking advantage. [Bug
+ 1547786]
+
+ * generic/tclStringObj.c: Corrected TclFormatObj's failure to
+ count up the number of arguments required by examining the format
+ string. [Bug 1547681]
+
+2006-08-27 Joe Mistachkin <joe@mistachkin.com>
+
+ * generic/tclClock.c (ClockClicksObjCmd): Fix nested macro breakage
+ with TCL_MEM_DEBUG enabled. [Bug 1547662]
+
+2006-08-26 Miguel Sofer <msofer@users.sf.net>
+
+ * doc/namespace.n:
+ * generic/tclNamesp.c:
+ * tests/upvar.test: bugfix, docs clarification and new tests for
+ [namespace upvar] as follow up to [Bug 1546833], reported by Will
+ Duquette.
+
+2006-08-24 Kevin B. Kenny <kennykb@acm.org>
+
+ * library/tzdata: Regenerated, including several new files, from
+ Olson's tzdata2006j.
+ * library/clock.tcl:
+ * tests/clock.test: Removed an early testing hack that allowed loading
+ 'registry' from the build tree rather than an installed one. This is a
+ workaround for [Bug 15232730], which remains open because it's a
+ symptom of a deeper underlying problem.
+
+2006-08-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Minimal collection of new tests
+ * tests/parseExpr.test: testing the error messages of the new
+ expr parser. Several bug fixes and code simplifications that appeared
+ during that effort.
+
+2006-08-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: Revisions to complete the thread finalization
+ of the cwdPathPtr. [Bug 1536142]
+
+ * generic/tclParseExpr.c: Revised mistaken call to
+ TclCheckBadOctal(), so both [expr 08] and [expr 08z] have same
+ additional info in error message.
+
+ * tests/compExpr-old.test: Update existing tests to not fail with
+ * tests/compExpr.test: the new expr parser.
+ * tests/compile.test:
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/for.test:
+ * tests/if.test:
+ * tests/parseExpr.test:
+ * tests/while.test:
+
+2006-08-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * win/Makefile.in (gdb): Make this target work so that debugging an
+ msys build is possible.
+
+2006-08-21 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c (Tcl_WaitForEvent): if the run loop is
+ already running (e.g. if Tcl_WaitForEvent was called recursively),
+ re-run it in a custom run loop mode containing only the source for the
+ notifier thread, otherwise wakeups from other sources added to the
+ common run loop modes might get lost.
+
+ * unix/tclUnixNotfy.c (Tcl_WaitForEvent): 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 on that platform. [Bug 1457797]
+
+ * generic/tclClock.c (ClockClicksObjCmd): add support for Darwin
+ * generic/tclCmdMZ.c (Tcl_TimeObjCmd): nanosecond resolution timer
+ * generic/tclInt.h: to [clock clicks] and [time]
+ * unix/configure.in (Darwin): when TCL_WIDE_CLICKS defined
+ * unix/tclUnixTime.c (TclpGetWideClicks, TclpWideClicksToNanoseconds):
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * unix/tclUnixPort.h (Darwin): override potentially faulty configure
+ detection of termios availability in all cases, since termios is known
+ to be present on all Mac OS X releases since 10.0. [Bug 497147]
+
+2006-08-18 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for
+ universal builds including x86_64, for 64-bit CoreFoundation on
+ Leopard and for use of -mmacosx-version-min instead of
+ MACOSX_DEPLOYMENT_TARGET
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * generic/tcl.h: add fixes for building on Leopard and
+ * unix/tclUnixPort.h: support for 64-bit CoreFoundation on Leopard
+ * macosx/tclMacOSXFCmd.c:
+
+ * unix/tclUnixPort.h: on Darwin x86_64, disable use of vfork as it
+ causes execve to fail intermittently. (rdar://4685553)
+
+ * generic/tclTomMath.h: on Darwin 64-bit, for now disable use of
+ 128-bit arithmetic through __attribute__ ((mode(TI))), as it leads to
+ link errors due to missing fallbacks. (rdar://4685527)
+
+ * macosx/Tcl.xcodeproj/project.pbxproj: add x86_64 to universal build,
+ switch native release targets to use DWARF with dSYM, Xcode 3.0
+ changes
+ * macosx/README: updates for x86_64 and Xcode 2.4.
+
+ * macosx/Tcl.xcodeproj/default.pbxuser: add test suite target that
+ * macosx/Tcl.xcodeproj/project.pbxproj: runs the tcl test suite at
+ build time and shows clickable test suite errors in the GUI build
+ window.
+
+ * tests/macOSXFCmd.test: fix use of deprecated resource fork paths.
+
+ * unix/tclUnixInit.c (TclpInitLibraryPath): move code that is only
+ needed when TCL_LIBRARY is defined to run only in that case.
+
+ * generic/tclLink.c (LinkTraceProc): fix 64-bit signed-with-unsigned
+ comparison warning from gcc4 -Wextra.
+
+ * unix/tclUnixChan.c (TclUnixWaitForFile): with timeout < 0, if
+ select() returns early (e.g. due to a signal), call it again instead
+ of returning a timeout result. Fixes intermittent event-13.8 failures.
+
+2006-08-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Revised the new set of expression
+ * generic/tclParseExpr.c: parse error messages.
+
+2006-08-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Replace PrecedenceOf() function with
+ prec[] static array.
+
+2006-08-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * library/clock.tcl (::tcl::clock::add): Added missing braces to
+ clockval validation code. Pointed out on comp.lang.tcl.
+
+2006-08-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclNamesp.c: Improvements in buffer management to make
+ namespace creation faster. Plus selected other minor improvements to
+ code quality. [Patch 1352382]
+
+2006-08-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ Misc patches to make code more efficient. [Bug 1530474] (afredd)
+ * generic/*.c, macosx/tclMacOSXNotify.c, unix/tclUnixNotfy.c,
+ * win/tclWinThrd.c: Tidy up invokations of Tcl_Panic() to promote
+ string constant sharing and consistent style.
+ * generic/tclBasic.c (Tcl_CreateInterp): More efficient handling of
+ * generic/tclClock.c (TclClockInit): registration of commands not
+ in global namespace.
+ * generic/tclVar.c (Tcl_UnsetObjCmd): Remove unreachable clause.
+
+2006-08-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEncoding.c: Replace buffer copy in for loop with
+ call to memcpy(). Thanks to afredd. [Patch 1530262]
+
+2006-08-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCmdIL.c (Tcl_LassignObjCmd): Make the wrong#args message
+ a bit more consistent with those used elsewhere. [Bug 1534628]
+
+ * generic/tclDictObj.c (DictForCmd): Stop crash when attempting to
+ iterate over an invalid dictionary. [Bug 1531184]
+
+ * doc/ParseCmd.3, doc/expr.n, doc/set.n, doc/subst.n, doc/switch.n:
+ * doc/tclvars.n: Ensure that uses of [expr] in documentation examples
+ are also good style (with braces) unless otherwise necessary. [Bug
+ 1526581]
+
+2006-08-03 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixPipe.c (TclpCreateProcess): for USE_VFORK: ensure
+ standard channels are initialized before vfork() so that the child
+ doesn't potentially corrupt global state in the parent's address space
+
+ * tests/compExpr-old.test: add 'oldExprParser' constraint to all tests
+ * tests/compExpr.test: that depend on the exact format of the
+ * tests/compile.test: error messages of the pre-2006-07-05
+ * tests/expr-old.test: expression parser. The constraint is on by
+ * tests/expr.test: default (i.e those tests still fail), but
+ * tests/for.test: can be turned off by passing '-constraints
+ * tests/if.test: newExprParser' to tcltest, which will skip
+ * tests/parseExpr.test: the 196 failing tests in the testsuite that
+ * tests/while.test: are caused by the new expression parser
+ error messages.
+
+2006-07-31 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (ConvertLocalToUTCUsingC): Corrected a regression
+ that caused dates before 1969 to be one day off in the :localtime time
+ zone if TZ is not set. [Bug 1531530]
+
+2006-07-30 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (GetJulianDayFromEraYearMonthDay): Corrected
+ several errors in converting dates before the Common Era [Bug 1426279]
+ * library/clock.tcl: Corrected syntax errors in generated code for %EC
+ %Ey, and %W format groups [Bug 1505383]. Corrected a bug in cache
+ management for format strings containing [glob] metacharacters [Bug
+ 1494664]. Corrected several errors in formatting/scanning of years
+ prior to the Common Era, and added the missing %EE format group to
+ indicate the era.
+ * tools/makeTestCases.tcl: Added code to make sure that %U and %V
+ format groups are included in the tests. (The code depends on %U and
+ %V formatting working correctly when 'makeTestCases.tcl' is run,
+ rather than making a completely independent check.) Added tests for
+ [glob] metacharacters in strings. Added tests for years prior to the
+ Common Era.
+ * tests/clock.test: Rebuilt with new test cases for all the above.
+
+2006-07-30 Joe English <jenglish@users.sourceforge.net>
+
+ * doc/AppInit.3: Fix typo [Bug 1496886]
+
+2006-07-26 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrected flawed overflow detection in
+ * tests/expr.test: INST_EXPON that caused [expr 2**64] to return
+ 0 instead of the same value as [expr 1<<64].
+
+2006-07-24 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinSock.c: Correct un-initialized Tcl_DString. Thanks to
+ afredd. [Bug 1518166]
+
+2006-07-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c:
+ * tests/execute.test (execute-9.1): dgp's fix for [Bug 1522803].
+
+2006-07-20 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c (Tcl_InitNotifier, Tcl_WaitForEvent):
+ create notifier thread lazily upon first call to Tcl_WaitForEvent()
+ rather than in Tcl_InitNotifier(). Allows calling exeve() in processes
+ where the event loop has not yet been run (Darwin's execve() fails in
+ processes with more than one thread), in particular allows embedders
+ to call fork() followed by execve(), previously the pthread_atfork()
+ child handler's call to Tcl_InitNotifier() would immediately recreate
+ the notifier thread in the child after a fork.
+
+ * macosx/tclMacOSXFCmd.c (TclMacOSXCopyFileAttributes): add support
+ * macosx/tclMacOSXNotify.c (Tcl_InitNotifier): for weakly
+ * unix/tclUnixInit.c (Tcl_GetEncodingNameFromEnvironment): importing
+ symbols not available on OSX 10.2 or 10.3, enables binaires built on
+ later OSX versions to run on earlier ones.
+ * macosx/Tcl.xcodeproj/project.pbxproj: enable weak-linking; turn on
+ extra warnings.
+ * macosx/README: document how to enable weak-linking; cleanup.
+ * unix/tclUnixPort.h: add support for weak-linking; conditionalize
+ AvailabilityMacros.h inclusion; only disable realpath on 10.2 or
+ earlier when threads are enabled.
+ * unix/tclLoadDyld.c (TclpLoadMemoryGetBuffer): change runtime Darwin
+ * unix/tclUnixInit.c (TclpInitPlatform): release check to use
+ global initialized
+ once
+ * unix/tclUnixFCmd.c (DoRenameFile, TclpObjNormalizePath): add runtime
+ Darwin release check to determine if realpath is threadsafe.
+ * unix/configure.in: add check on Darwin for compiler support of weak
+ * unix/tcl.m4: import and for AvailabilityMacros.h header; move
+ Darwin specific checks & defines that are only relevant to the tcl
+ build out of tcl.m4; restrict framework option to Darwin; clean up
+ quoting and help messages.
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+ * generic/regc_locale.c (cclass):
+ * generic/tclExecute.c (TclExecuteByteCode):
+ * generic/tclIOCmd.c (Tcl_ExecObjCmd):
+ * generic/tclListObj.c (NewListIntRep):
+ * generic/tclObj.c (Tcl_GetLongFromObj, Tcl_GetWideIntFromObj)
+ (FreeBignum, Tcl_SetBignumObj):
+ * generic/tclParseExpr.c (Tcl_ParseExpr):
+ * generic/tclStrToD.c (TclParseNumber):
+ * generic/tclStringObj.c (TclAppendFormattedObjs):
+ * unix/tclLoadDyld.c (TclpLoadMemory):
+ * unix/tclUnixPipe.c (TclpCreateProcess): fix signed-with-unsigned
+ comparison and other warnings from gcc4 -Wextra.
+
+2006-07-13 Andreas Kupries <andreask@activestate.com>
+
+ * unix/tclUnixPort.h: Added the inclusion of <AvailabilityMacros.h>.
+ The missing header caused the upcoming #if conditions to wrongly
+ exclude realpath, causing file normalize to ignore symbolic links in
+ the path.
+
+2006-07-11 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclAsync.c: Made Tcl_AsyncDelete() more tolerant when called
+ after all thread TSD has been garbage-collected.
+
+2006-07-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclParseExpr.c: Completely new expression parser that
+ builds a parse tree instead of operating with deep recursion. This
+ corrects reports of stack-blowing crashes parsing long expressions
+ [Bug 906201] and replaces a fundamentally O(N^2) algorithm with an
+ O(N) one [RFE 903765]. The new parser is better able to generate error
+ messages that clearly report both the nature and context of the syntax
+ error [Bugs 1029267, 1381715]. For now, the code for the old parser is
+ still present and can be activated with a "#define OLD_EXPR_PARSER
+ 1". This is for the sake of a clean implementation patch, and for ease
+ of benchmarking. The new parser is non-recursive, so much lighter in
+ stack consumption, but it does use more heap, so there may be cases
+ where parsing of long expressions that succeeded with the old parser
+ will lead to out of memory panics with the new one. There are still
+ more improvements possible on that point, though significant progress
+ may require changes to the Tcl_Token specifications documented for the
+ public Tcl_Parse*() routines.
+ ***POTENTIAL INCOMPATIBILITY*** for any callers that rely on the exact
+ (usually terrible) error messages generated by the old parser. This
+ includes a large number of tests in the test suite.
+
+ * generic/tclInt.h: Replaced TclParseWhiteSpace() with
+ * generic/tclParse.c: TclParseAllWhiteSpace() which is what
+ * generic/tclParseExpr.c: all the callers really needed.
+ Breaking whitespace runs at newlines is useful only to the command
+ parsing function, and it can call the file scoped routine
+ ParseWhiteSpace() to do that.
+
+ * tests/expr-old.test: Removed knownBug constraints that masked
+ * tests/expr.test: failures due to revised error messages.
+ * tests/parseExpr.test:
+
+2006-06-20 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIOUtil.c: Changed default configuration to
+ * generic/tclInt.decls: #undef USE_OBSOLETE_FS_HOOKS which disables
+ * generic/tclTest.c: access to the Tcl 8.3 internal routines for
+ hooking into filesystem operations. Everyone ought to have migrated to
+ Tcl_Filesystems by now.
+ ***POTENTIAL INCOMPATIBILITY*** for any code still stuck in the
+ pre-Tcl_Filesystem era.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ * generic/tclStrToD.c: Removed dead code that permitted disabling of
+ recognition of the new 0b and 0o numeric formats.
+
+ * generic/tclExecute.c: Removed dead code that implemented alternative
+ * generic/tclObj.c: design where numeric values did not
+ automatically narrow to the smallest Tcl_ObjType required to hold them
+
+ * generic/tclCmdAH.c: Removed dead code that was old implementation
+ of [format].
+
+2006-06-14 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tclUnixPort.h (Darwin): support MAC_OS_X_VERSION_MAX_ALLOWED
+ define from AvailabilityMacros.h: override configure detection and
+ only use API available in the indicated OS version or earlier.
+
+2006-06-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/format.n, doc/scan.n: Added examples for converting between
+ characters and their numeric interpretations following user prompting.
+
+2006-06-13 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclLoadDl.c (TclpDlopen): Workaround for a compiler bug in Sun
+ Forte 6. [Bug 1503729]
+
+2006-06-06 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/GetStdChan.3: Added recommendation that each call to
+ Tcl_SetStdChannel() be accompanied by a call to Tcl_RegisterChannel().
+
+2006-06-05 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/Alloc.3: Added documentation of promise that Tcl_Realloc(NULL,x)
+ is the same as Tcl_Alloc(x), as discussed in comp.lang.tcl. Also fixed
+ nonsense sentence to say something meaningful.
+
+2006-05-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tcl.h (Tcl_DecrRefCount): use if/else construct to allow
+ placement in unbraced outer if/else conditions. (jcw)
+
+2006-05-27 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tclMacOSXNotify.c: implemented pthread_atfork() handler that
+ * unix/tcl.m4 (Darwin): recreates CoreFoundation state and
+ notifier thread in the child after a fork(). Note that pthread_atfork
+ is available starting with Tiger only. Because vfork() is used by the
+ core on Darwin, [exec]/[open] are not affected by this fix, only
+ extensions or embedders that call fork() directly (such as TclX).
+ However, this only makes fork() safe from corefoundation tcl with
+ --disable-threads; as on all platforms, forked children may deadlock
+ in threaded tcl due to the potential for stale locked mutexes in the
+ child. [Patch 923072]
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2006-05-24 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/tcl.m4 (SC_CONFIG_SYSTEM): Fixed quoting of command script to
+ awk; it was a rarely used branch, but it was wrong. [Bug 1494160]
+
+2006-05-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * doc/chan.n, doc/refchan.n: Tighten up the documentation to follow a
+ slightly more consistent style with regard to argument capitalization.
+
+2006-05-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclProc.c (ProcCompileProc): When a bump of the compile
+ epoch forces the re-compile of a proc body, take care not to overwrite
+ any Proc struct that may be referred to on the active call stack. Note
+ that the fix will not be effective for code that calls the private
+ routine TclProcCompileProc() directly. [Bug 1482718]
+
+2006-05-13 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclEvent.c (HandleBgErrors): fix leak. [Coverity issue 86]
+
+2006-05-05 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclMain.c (Tcl_Main): Corrected flaw that required
+ * tests/main.test: (Tcl_Main-4.5): processing of one interactive
+ command before passing control to the loop routine registered with
+ Tcl_SetMainLoop(). [Bug 1481986]
+
+2006-05-04 Don Porter <dgp@users.sourceforge.net>
+
+ * README: Bump version number to 8.5a5
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/configure.in:
+
+ * unix/configure: autoconf-2.59
+ * win/configure:
+
+ * generic/tclBasic.c (ExprSrandFunc): Restore acceptance of wide/big
+ * doc/mathfunc.n: integer values by srand(). [Bug 1480509]
+
+2006-04-26 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.5a4 TAGGED FOR RELEASE ***
+
+ * changes: Updates for another RC.
+
+ * generic/tclBinary.c: Revised the handling of the Q and q format
+ * generic/tclInt.h: specifiers for [binary] to account for the
+ * generic/tclStrToD.c: "middle endian" floating point format used in
+ Nokia N770.
+
+2006-04-25 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/DoubleObj.3: More doc updates for TIP 237.
+ * doc/expr.n:
+ * doc/format.n:
+ * doc/mathfunc.n:
+ * doc/scan.n:
+ * doc/string.n:
+
+ * generic/tclScan.c: [scan $s %u] is documented to accept only
+ * tests/scan.test: decimal formatted integers. Fixed to match.
+
+2006-04-19 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclStrToD.c: Added code to support the "middle endian"
+ floating point format used in the Nokia N770's software-based floating
+ point. Thanks to Bruce Johnson for reporting this bug, originally on
+ http://wiki.tcl.tk/15408.
+ * library/clock.tcl: Fixed a bug with Daylight Saving Time and Posix
+ time zone specifiers reported by Martin Lemburg in
+ http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0
+ (and not at SourceForge).
+ * tests/clock.test: Added test case for the above bug.
+
+2006-04-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/IntObj.3: Minor review fixes, including better documentation of
+ the behaviour of Tcl_GetBignumAndClearObj.
+
+2006-04-17 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/IntObj.3: Documentation changes to account for TIP 237 changes.
+ * doc/Object.3: [Bug 1446971]
+
+2006-04-12 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/regc_locale.c (cclass): Redefined the meaning of [:print:]
+ to be exactly UNICODE letters, numbers, punctuation, symbols and
+ spaces (*not* whitespace). [Bug 1376892]
+
+2006-04-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTrace.c: Stop some interference between enter traces
+ * tests/trace.test: and enterstep traces. [Bug 1458266]
+
+2006-04-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Yet another revised fix for the [Bug 1379287]
+ * tests/fileSystem.test: family of path normalization bugs.
+
+2006-04-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclRegexp.c (FinalizeRegexp): full reset data to indicate
+ readiness for reinitialization.
+
+2006-04-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): It seems there
+ * tests/indexObj.test: are extensions that rely on the prior behavior
+ * doc/GetIndex.3: that the empty string cannot succeed as a
+ unique prefix matcher, so I'm restoring Donal Fellows's solution.
+ Added mention of this detail to the documentation. [Bug 1464039]
+
+ * tests/compExpr-old.test: Updated testmathfunctions constraint
+ * tests/compExpr.test: to post-TIP-232 world.
+ * tests/expr-old.test:
+ * tests/expr.test:
+ * tests/info.test:
+
+ * tests/indexObj.test: Corrected other test errors revealed by
+ * tests/upvar.test: testing outside the tcltest application.
+
+ * generic/tclPathObj.c: Revised fix for the [Bug 1379287] family of
+ path normalization bugs.
+
+2006-04-06 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/tcl.m4: removed TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
+ define on Darwin. [Bug 1457515]
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
+2006-04-05 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinInit.c: More careful calls to Tcl_DStringSetLength()
+ * win/tclWinSock.c: to avoid creating invalid DString states. Bump
+ * win/tclWinDde.c: to version 1.3.2. [RFE 1366195]
+ * library/dde/pkgIndex.tcl:
+
+ * library/reg/pkgIndex.tcl: Bump to registry 1.2 because
+ * win/tclWinReg.c: Registry_Unload() is a new public routine
+ * win/Makefile.in: compared to the 1.1.* releases.
+
+ * win/configure.in: Bump package version numbers.
+ * win/configure: autoconf 2.59
+
+2006-04-05 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Allow empty
+ strings to be matched by the Tcl_GetIndexFromObj machinery, in the
+ same manner as any other key. [Bug 1464039]
+
+2006-04-03 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIO.c (ReadChars): Added check, panic and commentary to a
+ piece of code which relies on BUFFER_PADDING to create enough space at
+ the beginning of each buffer for the insertion of partial multibyte
+ data at the beginning of a buffer. Commentary explains why this code
+ is OK, and the panic is as a precaution if someone twiddled the
+ BUFFER_PADDING into uselessness.
+
+ * generic/tclIO.c (ReadChars): Temporarily suppress the use of
+ TCL_ENCODING_END set when EOF was reached while the buffer we are
+ converting is not truly the last buffer in the queue. Together with
+ the Utf bug below it was possible to completely wreck the buffer data
+ structures, eventually crashing Tcl. [Bug 1462248]
+
+ * generic/tclEncoding.c (UtfToUtfProc): Stop accessing memory beyond
+ the end of the input buffer when TCL_ENCODING_END is set and the last
+ bytes of the buffer start a multi-byte sequence. This bug contributed
+ to [Bug 1462248].
+
+2006-03-30 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c: remove unused var and silence gcc warning
+
+2006-03-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\"
+ path-as-escape issue.
+
+2006-03-29 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for another RC.
+
+ * generic/tclPathObj.c: More fixes for path normalization when /../
+ * tests/fileSystem.test: tries to go beyond root.[Bug 1379287]
+
+ * generic/tclExecute.c: Revised INST_MOD implementation to do
+ calculations in native types as much as possible, moving to mp_ints
+ only when necessary.
+
+2006-03-28 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinPipe.c (TclpCreateProcess): change panics to Tcl errors
+ and do proper refcounting of noe objPtr. [Bug 1194429]
+
+ * unix/tcl.m4, win/tcl.m4: []-quote AC_DEFUN functions.
+
+2006-03-28 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/Tcl.xcode/default.pbxuser: add '-singleproc 1' cli arg to
+ * macosx/Tcl.xcodeproj/default.pbxuser: tcltest to ease test debugging
+
+ * macosx/Tcl.xcode/project.pbxproj: removed $prefix/share from
+ * macosx/Tcl.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change
+ to unix/configure.in of 2006-03-13.
+
+ * unix/tclUnixFCmd.c (TclpObjNormalizePath): deal with *BSD/Darwin
+ realpath() converting relative paths into absolute paths [Bug 1064247]
+
+2006-03-28 Vince Darley <vincentdarley@sourceforge.net>
+
+ * generic/tclIOUtil.c: fix to nativeFilesystemRecord comparisons
+ (lesser part of [Bug 1064247])
+
+2006-03-27 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinTest.c: Fixes for [Bug 1456373] (mingw-gcc issue)
+
+2006-03-27 Andreas Kupries <andreask@activestate.com>
+
+ * doc/CrtChannel.3: Added TCL_CHANNEL_VERSION_5, made it the
+ * generic/tcl.h: version where the "truncateProc" is defined at,
+ * generic/tclIO.c: and moved all channel drivers of Tcl to v5.
+ * generic/tclIOGT.c, generic/tclIORChan.c, unix/tclUnixChan.c:
+ * unix/tclUnixPipe.c, win/tclWinChan.c, win/tclWinConsole.c:
+ * win/tclWinPipe.c, win/tclWinSerial.c, win/tclWinSock.c:
+
+2006-03-27 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Merge INST_MOD computation in with the
+ INST_?SHIFT instructions, which also operate only on two integral
+ values. Also corrected flaw that made INST_BITNOT of wide values
+ require mp_int calculations. Also corrected type that missed optimized
+ handling of the tclBooleanType by the TclGetBooleanFromObj macro.
+
+ * changes: Updates for another RC.
+
+2006-03-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Corrections to INST_EXPON detection of
+ overflow to use mp_int calculations.
+
+2006-03-24 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclExecute.c (TclExecuteByteCode): Added a couple of missing
+ casts to 'int' that were affecting compilablity on VC6.
+
+2006-03-24 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEncoding.c: Reverted latest change [Bug 506653] since it
+ reportedly killed test performance on Windows.
+
+ * generic/tclExecute.c: Revised INST_EXPON implementation to do
+ calculations in native types as much as possible, moving to mp_ints
+ only when necessary.
+
+2006-03-23 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Merged INST_EXPON handling in with the other
+ binary operators that operate on all number types (INST_ADD, etc.).
+
+ * tests/env.test: With case preserved (see 2006-03-21 commit) be sure
+ to do case-insensitive filtering. [Bug 1457065]
+
+2006-03-23 Reinhard Max <max@suse.de>
+
+ * unix/tcl.spec: Cleaned up and completed the spec file. An RPM can
+ now be built from the tcl source distribution with "rpmbuild -tb
+ <tarball>"
+
+2006-03-22 Reinhard Max <max@suse.de>
+
+ * tests/stack.test: Run the stack tests in subshells, so that they are
+ reported as failed tests rather than bugs in the test suite if the
+ recursion causes a segfault.
+
+2006-03-21 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Updates for another RC.
+
+ * generic/tclStrToD.c: One of the branches of AccumulateDecimalDigit
+ * tests/parseExpr.test: did not. [Bug 1451233]
+
+ * tests/env.test: Preserve case of saved env vars. [Bug 1409272]
+
+2006-03-21 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclInt.decls: implement globbing for HFS creator & type
+ * macosx/tclMacOSXFCmd.c:codes and 'hidden' flag, as documented in
+ * tests/macOSXFCmd.test: glob.n; objectified OSType handling in [glob]
+ * unix/tclUnixFile.c: and [file attributes]; fix globbing for
+ hidden files with pattern==NULL arg. [Bug 823329]
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c: make genstubs
+
+2006-03-20 Andreas Kupries <andreask@activestate.com>
+
+ * win/Makefile.in (install-libraries): Generate tcl8/8.4 directory
+ under Windows as well (cygwin Makefile). Related entry: 2006-03-07,
+ dgp. This moved the installation of http from 8.2 to 8.4, partially. A
+ fix of the required directory creation was done for unix on Mar 10,
+ without entry in the Changelog. This entry is for the fix of the
+ directory creation under Windows.
+
+ * unix/installManPage: There is always one even more broken "sed".
+ Moved the # comment starting character in the sed script to the
+ beginning of their respective lines. The AIX sed will not recognize
+ them as comments otherwise :( The actual text stays indented for
+ better association with the commands they belong to.
+
+2006-03-20 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * tests/cmdAH.test, tests/fCmd.test, tests/unixFCmd.test:
+ * tests/winFCmd.test: Cleanup of some test constraint handling, and a
+ few other minor issues.
+
+2006-03-18 Vince Darley <vincentdarley@sourceforge.net>
+
+ * generic/tclFileName.c:
+ * doc/FileSystem.3:
+ * tests/fileName.test: Fix to [Bug 1084705] so that 'glob -nocomplain'
+ finally agrees with its documentation and doesn't swallow genuine
+ errors.
+
+ ***POTENTIAL INCOMPATIBILITY*** for scripts that assumed '-nocomplain'
+ removes the need for 'catch' to deal with non-understood path names.
+
+ Small optimisation to implementation of pattern==NULL case of TclGlob,
+ and clarification to the documentation. [Tclvfs bug 1405317]
+
+2006-03-18 Vince Darley <vincentdarley@sourceforge.net>
+
+ * tests/fCmd.test: added knownBug test case for [Bug 1394972]
+
+ * tests/winFCmd.test:
+ * tests/tcltest.test: corrected tests to better account for behaviour
+ of writable/non-writable directories on Windows 2000/XP. This, with
+ the previous patches, closes [Bug 1193497]
+
+2006-03-17 Andreas Kupries <andreask@activestate.com>
+
+ * doc/chan.n: Updated with documentation for the commands 'chan
+ create' and 'chan postevent' (TIP #219).
+
+ * doc/refchan.n: New file. Documentation of the command handler API
+ for reflected channels (TIP #219).
+
+2006-03-17 Joe Mistachkin <joe@mistachkin.com>
+
+ * unix/tclUnixPort.h: Include pthread.h prior to pthread_np.h [Bug
+ 1444692]
+
+ * win/tclWinTest.c: Corrected typo of 'initializeMutex' that prevented
+ successful compilation.
+
+2006-03-16 Andreas Kupries <andreask@activestate.com>
+
+ * doc/open.n: Documented the changed behaviour of 'a'ppend mode.
+
+ * tests/io.test (io-43.1 io-44.[1234]): Rewritten to be self-contained
+ with regard to setup and cleanup. [Bug 681793]
+
+ * generic/tclIOUtil.c (TclGetOpenMode): Added the flag O_APPEND to the
+ list of POSIX modes used when opening a file for 'a'ppend. This
+ enables the proper automatic seek-to-end-on-write by the OS. See [Bug
+ 680143] for longer discussion.
+
+ * tests/ioCmd.test (iocmd-13.7.*): Extended the testsuite to check the
+ new handling of 'a'.
+
+2006-03-15 Andreas Kupries <andreask@activestate.com>
+
+ * tests/socket.test: Extended the timeout in socket-11.11 from 10 to
+ 40 seconds to allow for really slow machines. Also extended
+ actual/expected results with value of variable 'done' to make it
+ clearer when a test fails due to a timeout. [Bug 792159]
+
+2006-03-15 Vince Darley <vincentdarley@sourceforge.net>
+
+ * win/fCmd.test: add proper test constraints so the new tests don't
+ run on Unix.
+
+2006-03-14 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclPipe.c (TclCreatePipeline): Modified the processing of
+ pipebars to fail if the last bar is followed only by redirections.
+ [Bug 768659]
+
+2006-03-14 Andreas Kupries <andreask@activestate.com>
+
+ * doc/fconfigure.n: Clarified that -translation is binary is reported
+ as lf when queried, because it is identical to lf, except for the
+ special additional behaviour when setting it. [Bug 666770]
+
+2006-03-14 Andreas Kupries <andreask@activestate.com>
+
+ * doc/clock.n: Removed double-quotes around section title NAME; not
+ needed.
+ * unix/installManpage: Reverted part to handle double-quotes in
+ section NAME, chokes older sed installations.
+
+2006-03-14 Andreas Kupries <andreask@activestate.com>
+
+ * library/tm.tcl (::tcl::tm::Defaults): Fixed handling of environment
+ variable TCLX.y_TM_PATH, bad variable reference. Thanks to Julian
+ Noble. [Bug 1448251]
+
+2006-03-14 Vince Darley <vincentdarley@sourceforge.net>
+
+ * win/tclWinFile.c: updated patch to deal with 'file writable' issues
+ on Windows XP/2000.
+ * generic/tclTest.c:
+ * unix/tclUnixTest.c:
+ * win/tclWinTest.c:
+ * tests/fCmd.test: updated test suite to deal with correct permissions
+ setting and differences between XP/2000 and 95/98 3 tests still fail;
+ to be dealt with shortly
+
+2006-03-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEncoding.c: Report error when an escape encoding is
+ missing one of its sub-encodings. [Bug 506653]
+
+ * unix/configure.in: Revert change from 2005-07-26 that sometimes
+ * unix/configure: added $prefix/share to the tcl_pkgPath. See
+ [Patch 1231015]. autoconf-2.59.
+
+2006-03-10 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (ObjInterpProcEx):
+ * tests/apply.test (apply-5.1): Fix [apply] error messages so that
+ they quote the lambda expression. [Bug 1447355]
+
+2006-03-10 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ -- Summary of changes fixing [Bug 1437595] --
+
+ * generic/tclEvent.c: Cosmetic touches and identation
+ * generic/tclInt.h: Added TclpFinalizeSockets() call.
+
+ * generic/tclIO.c: Calls TclpFinalizeSockets() as part of the
+ TclFinalizeIOSubsystem().
+
+ * unix/tclUnixSock.c: Added no-op TclpFinalizeSockets().
+
+ * win/tclWinPipe.c, win/tclWinSock.c: Finalization of sockets/pipes is
+ now solely done in TclpFinalizeSockets() and TclpFinalizePipes() and
+ not over the thread-exit handler, because the order of actions the Tcl
+ generic core will impose may result in cores/hangs if the thread exit
+ handler tears down corresponding subsystem(s) too early.
+
+2006-03-10 Vince Darley <vincentdarley@sourceforge.net>
+
+ * win/tclWinFile.c: previous patch breaks tests, so removed.
+
+2006-03-09 Vince Darley <vincentdarley@sourceforge.net>
+
+ * win/tclWinFile.c: fix to 'file writable' in certain XP directories.
+ Thanks to fvogel and jfg. [Patch 1344540] Modified patch to make use
+ of existing use of getSecurityProc.
+
+2006-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclExecute.c: Complete missing bit of TIP 215 implementation
+ * tests/incr.test:
+
+2006-03-07 Joe English <jenglish@users.sourceforge.net>
+
+ * unix/tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, as per the
+ other *BSD variants. [Bug 1334613]
+ * unix/configure: Regenerated.
+
+2006-03-07 Don Porter <dgp@users.sourceforge.net>
+
+ * changes: Update in prep. for 8.5a4 release.
+
+ * unix/Makefile.in: Package http 2.5.2 requires Tcl 8.4, so the
+ * win/Makefile.in: *.tm installation has to be placed in an "8.4"
+ directory, not an "8.2" directory.
+
+2006-03-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Revised handling of TCL_EVAL_* flags to
+ * tests/parse.test: simplify TclEvalObjvInternal and to correct
+ the auto-loading of alias targets (parse-8.12). [Bug 1444291]
+
+2006-03-03 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Revised yesterday's fix for [Bug 1379287] to
+ work on Windows.
+
+ * generic/tclObj.c: Compatibility support for existing code that
+ calls Tcl_GetObjType("boolean").
+
+2006-03-02 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclPathObj.c: Fix for failed normalization of paths
+ * tests/fileSystem.test: with /../ that lead back to the root
+ of the filesystem, like /foo/.. [Bug 1379287]
+
+2006-03-01 Reinhard Max <max@suse.de>
+
+ * unix/installManPage: Fix the script for manpages that have quotes
+ around the .SH arguments, as doctools produces them. [Bug 1292145]
+ Some minor cleanups and improvements.
+
+2006-02-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL
+ * tests/namespace.test: evaluations act the same as [uplevel #0]
+ * tests/parse.test: evaluations, even when execution traces or
+ * tests/trace.test: invocations of [::unknown] are present. [Bug
+ 1439836]
+
+2006-02-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Corrected a few bugs in how [namespace
+ * tests/namespace.test: unknown] interacts with TCL_EVAL_* flags.
+ [Patch 958222]
+
+2006-02-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIORChan.c: Revised error message generation and handling
+ * tests/ioCmd.test: of exceptional return codes in the channel
+ reflection layer. [Bug 1372348]
+
+2006-02-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIndexObj.c: Disallow the "ambiguous" error message
+ * tests/indexObj.test: when TCL_EXACT matching is requested.
+ * tests/ioCmd.test:
+
+2006-02-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclIO.c: Made several routines tolerant of
+ * generic/tclIORChan.c: interp == NULL arguments. [Bug 1380662]
+ * generic/tclIOUtil.c:
+
+2006-02-09 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#215 IMPLEMENTATION
+
+ * doc/incr.n: Revised [incr] to auto-initialize when varName
+ * generic/tclExecute.c: argument is unset. [Patch 1413115]
+ * generic/tclVar.c:
+ * tests/compile.test:
+ * tests/incr-old.test:
+ * tests/incr.test:
+ * tests/set.test:
+
+ * tests/main.test (Tcl_Main-6.7): Improved robustness of
+ command auto-completion test. [Bug 1422736]
+
+2006-02-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/Encoding.3, doc/encoding.n: Updates due to review at request of
+ Don Porter. Mostly minor changes.
+
+2006-02-08 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#258 IMPLEMENTATION
+
+ * doc/Encoding.3: New subcommand [encoding dirs].
+ * doc/encoding.n: New routine Tcl_GetEncodingNameFromEnvironment
+ * generic/tcl.decls: Made public:
+ * generic/tclBasic.c: TclGetEncodingFromObj
+ * generic/tclCmdAH.c: -> Tcl_GetEncodingFromObj
+ * generic/tclEncoding.c:TclGetEncodingSearchPath
+ * generic/tclInt.decls: -> Tcl_GetEncodingSearchPath
+ * generic/tclInt.h: TclSetEncodingSearchPath
+ * generic/tclTest.c: -> Tcl_SetEncodingSearchPath
+ * library/init.tcl: Removed commands:
+ * tests/cmdAH.test: [tcl::unsupported::EncodingDirs]
+ * tests/encoding.test: [testencoding path] (Tcltest)
+ * unix/tclUnixInit.c: [Patch 1413934]
+ * win/tclWinInit.c:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+
+2006-02-01 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c: minor improvements to [apply]
+ * tests/apply.test: new tests; apply-5.1 currently fails to indicate
+ missing work in error reporting
+
+2006-02-01 Don Porter <dgp@users.sourceforge.net>
+
+ TIP#194 IMPLEMENTATION
+
+ * doc/apply.n: (New file) New command [apply]. [Patch 944803]
+ * doc/uplevel.n:
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * generic/tclProc.c:
+ * tests/apply.test: (New file)
+ * tests/proc-old.test:
+ * tests/proc.test:
+
+ TIP#181 IMPLEMENTATION
+
+ * doc/Namespace.3: New command [namespace unknown]. New public C
+ * doc/namespace.n: routines Tcl_(Get|Set)NamespaceUnknownHandler.
+ * doc/unknown.n: [Patch 958222]
+ * generic/tcl.decls:
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * tests/namespace.test:
+
+ * generic/tclDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
+ TIP#250 IMPLEMENTATION
+
+ * doc/namespace.n: New command [namespace upvar]. [Patch 1275435]
+ * generic/tclInt.h:
+ * generic/tclNamesp.c:
+ * generic/tclVar.c:
+ * tests/namespace.test:
+ * tests/upvar.test:
+
+2006-01-26 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/dict.n: Fixed silly bug in example. Thanks to Heiner Marxen
+ <heiner.marxen@unsel.de> for catching this! [Bug 1415725]
+
+2006-01-26 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/tclUnixChan.c (TclpOpenFileChannel): Tidy up and comment the
+ mess to do with setting up serial channels. This (deliberately) breaks
+ a broken FreeBSD port, indicates what we're really doing, and reduces
+ the amount of conditional compilation sections for better maintenance.
+
+2006-01-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixInit.c (TclpInitPlatform): Improved conditions on when
+ to update the FP rounding mode on FreeBSD, taken from FreeBSD port.
+
+2006-01-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/string.test (string-12.21): Added test for [Bug 1410553] based
+ on original bug report.
+
+2006-01-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclStringObj.c: fixed incorrect handling of internal rep in
+ Tcl_GetRange. Thanks to twylite and Peter Spjuth. [Bug 1410553]
+
+ * generic/tclProc.c: fixed args handling for precompiled bodies [Bug
+ 1412695]; thanks to Uwe Traum.
+
+2006-01-16 Reinhard Max <max@suse.de>
+
+ * generic/tclPipe.c (FileForRedirect): Prevent nameString from being
+ freed without having been initialized.
+ * tests/exec.test: Added a test for the above.
+
+2006-01-12 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
+
+ * generic/tclPathObj.c (Tcl_FSGetInternalRep): backported patch from
+ core-8-4-branch. A freed pointer has been overwritten causing all
+ sorts of coredumps.
+
+2006-01-12 Vince Darley <vincentdarley@sourceforge.net>
+
+ * win/tclWinFile.c: fix to sharing violation [Bug 1366227]
+
+2006-01-11 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Moved Tcl_LogCommandInfo from tclBasic.c to
+ * generic/tclNamesp.c: tclNamesp.c to get access to identifier with
+ * tests/error.test (error-7.0): file scope. Added check for traces on
+ ::errorInfo, and when present fall back to contruction of the stack
+ trace in the variable so that write trace notification timings are
+ compatible with earlier Tcl releases. This reduces, but does not
+ completely eliminate the ***POTENTIAL INCOMPATIBILITY*** created by
+ the 2004-10-15 commit. [Bug 1397843]
+
+2006-01-10 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/configure: add caching, use AC_CACHE_CHECK instead of
+ * unix/configure.in: AC_CACHE_VAL where possible, consistent message
+ * unix/tcl.m4: quoting, sync relevant tclconfig/tcl.m4 changes
+ and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with
+ default argument, Darwin improvements to SC_LOAD_*CONFIG.
+
+2006-01-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclNamesp.c (NamespaceInscopeCmd): [namespace inscope]
+ * tests/namespace.test: commands were not reported by [info level].
+ [Bug 1400572]
+
+2006-01-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclTrace.c: Stop exporting the guts of the trace command;
+ nothing outside this file needs to see it. [Bug 971336]
+
+2006-01-05 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * unix/tcl.m4 (TCL_CONFIG_SYSTEM): Factor out the code to determine
+ the operating system version number, as it was replicated in several
+ places.
+
+2006-01-04 David Gravereaux <davygrvy@pobox.com>
+
+ * win/tclAppInit.c: WIN32 native console signal handler removed. This
+ was found to be interfering with TWAPI extension one. IMO, special
+ services such as signal handlers should best be done with extensions
+ to the core after discussions on c.l.t. about Roy Terry's tclsh
+ children of a real windows service shell.
+
+ ******************************************************************
+ *** 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.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 d027e26..7004bc5 100644
--- a/README
+++ b/README
@@ -1,11 +1,7 @@
README: Tcl
- This is the Tcl 8.5a4 source distribution.
- Tcl/Tk is also available through NetCVS:
- 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.56 2005/06/07 14:03:48 dkf Exp $
+ This is the Tcl 8.6.1 source distribution.
+ http://sourceforge.net/projects/tcl/files/Tcl/
+ You can get any source release of Tcl from the URL above.
Contents
--------
@@ -14,10 +10,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,9 +26,14 @@ 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:
+Source code development and tracking of bug reports and feature requests
+takes place at:
+
+ http://core.tcl.tk/
+
+Tcl/Tk release and mailing list services are hosted by SourceForge:
- http://tcl.sourceforge.net/
+ http://sourceforge.net/projects/tcl/
with the Tcl Developer Xchange hosted at:
@@ -48,17 +49,21 @@ and selling it either in whole or in part. See the file
Extensive documentation is available at our website.
The home page for this release, including new features, is
- http://www.tcl.tk/software/tcltk/8.5.html
+ http://www.tcl.tk/software/tcltk/8.6.html
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/Tcl/
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/_/ref?N=25206
-There have been many Tcl books on the market. Most are listed at
- http://www.tcl.tk/resource/doc/books/
+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
----------------------
@@ -98,19 +103,14 @@ about building Tcl from sources at
http://www.tcl.tk/doc/howto/compile.html
-4. TclPro Development tools
+4. Development tools
---------------------------
-A high quality set of commercial quality development tools is available to
-accelerate your Tcl application development. The TclPro product provides a
-debugger, static code checker, packaging utility, and bytecode compiler.
-TclPro was open-sourced when Scriptics/Ajuba was acquired by Interwoven.
-Visit its home at SourceForge for more information and source/binaries:
-
- http://tclpro.sourceforge.net/
-
-ActiveState has picked up support for commercial Tcl development tools.
-More information can be found at
+ActiveState produces a high quality set of commercial quality development
+tools that is available to accelerate your Tcl application development.
+Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
+static code checker, single-file wrapping utility, bytecode compiler and
+more. More information can be found at
http://www.ActiveState.com/Tcl
@@ -119,33 +119,23 @@ More information can be found at
There is a USENET news group, "comp.lang.tcl", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
-great place to ask general information questions. There is also
-a USENET news group, "comp.lang.tcl.announce", intended to announce new
-releases of software, training, and more. For bug reports, please
+great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
-6. Tcl contributed archive
---------------------------
+6. Tcl'ers Wiki
+---------------
-Many people have created exciting packages and applications based on Tcl
-and/or Tk and made them freely available to the Tcl community. An archive
-of these contributions is kept on the machine ftp://archives.tcl.tk/pub/tcl
-(aka ftp://ftp.procplace.com/pub/tcl). You can access the archive using
-anonymous FTP. The archive also contains several FAQ ("frequently asked
-questions") documents that provide solutions to problems that are commonly
-encountered by Tcl newcomers.
+A Wiki-based open community site covering all aspects of Tcl/Tk is at:
-7. Tcl Resource Center
-----------------------
+ http://wiki.tcl.tk/
-Visit http://www.tcl.tk/resource/ to see an annotated index of
-many Tcl resources available on the World Wide Web. This includes
-papers, books, and FAQs, as well as development tools, extensions,
-applications, binary releases, and patches. You can also recommend
-additional URLs for the resource center using the forms labeled "Add a
-Resource".
+It is dedicated to the Tcl programming language and its extensions. A
+wealth of useful information can be found there. It contains code
+snippets, references to papers, books, and FAQs, as well as pointers to
+development tools, extensions, and applications. You can also recommend
+additional URLs by editing the wiki yourself.
-8. Mailing lists
+7. Mailing lists
----------------
Several mailing lists are hosted at SourceForge to discuss development or
@@ -156,22 +146,17 @@ to subscribe, visit:
and go to the Mailing Lists page.
-9. Support and Training
+8. Support and Training
------------------------
We are very interested in receiving bug reports, patches, and suggestions
-for improvements. We prefer that you send this information to us via the
-bug form at SourceForge, rather than emailing us directly. The bug
-database is at:
+for improvements. We prefer that you send this information to us as
+tickets entered into our tracker at:
- http://tcl.sourceforge.net/
-
-The bug form was designed to give uniform structure to bug reports as
-well as to solicit enough information to minimize followup questions.
+ http://core.tcl.tk/tcl/reportlist
We will log and follow-up on each bug, although we cannot promise a
-specific turn-around time. Enhancements, reported via the Feature
-Requests form at the same web site, may take longer and may not happen
+specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
@@ -184,7 +169,13 @@ questions for which no one else is likely to know the answer. In addition,
see the following Web site for links to other organizations that offer
Tcl/Tk training:
- http://www.tcl.tk/resource/community/commercial/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 9ac6151..659319c 100644
--- a/changes
+++ b/changes
@@ -1,7 +1,5 @@
Recent user-visible changes to Tcl:
-RCS: @(#) $Id: changes,v 1.97 2005/06/27 18:00:55 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
@@ -6492,4 +6490,1817 @@ Can support [load] from memory as well (steffen)
Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.]
---- Released 8.5a3, June 4, 2004 --- See ChangeLog for details ---
+--- Released 8.5a3, June 4, 2005 --- See ChangeLog for details ---
+
+2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny)
+
+2005-06-07 (new feature)[TIP 208] [chan] and [chan truncate] (fellows)
+
+2005-06-07 (revert) Restored registration of "procbody" Tcl_ObjType (porter)
+Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.
+
+2005-06-13 (bug fix)[1217375,1219176] [file mkdir] race (diekhans,darley)
+
+2005-06-14 (bug fix)[1220058] [namespace delete] crash (duquette,fellows)
+
+2005-06-17 (bug fix)[1221395] Tcl_LimitSetTime able to break [vwait] (fellows)
+
+2005-06-18 (bug fix)[1154163] [format %h] on 64-bit OS's (kraft,fellows)
+
+2005-06-21 (bug fix)[1201035,1224585] execution trace crashes (porter)
+
+2005-06-21 (bug fix)[1194458] Windows: [file split] (kenny,porter)
+
+2005-06-22 (bug fix)[1225727] Windows: pipe finalization crash (kenny)
+
+2005-06-22 (bug fix)[1225571] Windows: [file pathtype] buffer overflow (thoyts)
+
+2005-06-22 (bug fix)[1225044] Windows: UMR in pipe close (kenny)
+
+2005-06-23 (bug fix)[1225957] Windows/gcc: crashes in assembler code (kenny)
+
+2005-06-24 (bug fix) make Tcl_Preserve safe in Tk exit handlers (kenny)
+
+2005-07-01 (bug fix)[1222872] notifier spurious wake-up protection (vasiljevic)
+
+2005-07-05 (bug fix)[1230597] allow idempotent [namespace import] (porter)
+
+2005-07-15 (bug fix)[1237907] localtime() => NULL => crash (kenny)
+
+2005-07-21 (dropped support) IRIX 4, RISCos, Ultrix, and ancient BSD (kenny)
+***POTENTIAL INCOMPATIBILITY***
+
+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-26 (bug fix)[1047286] cmd delete traces during namespace delete (porter)
+
+2005-07-26 (new unix feature)[1231015] ${prefix}/share on ::tcl_pkgPath (dejong)
+***POTENTIAL INCOMPATIBILITY***
+
+2005-07-27 (bug fix)[1214462] [unknown] can return exceptions (porter)
+
+2005-07-27 (new feature) value of ::tcl_precision now kept per-thread (porter)
+***POTENTIAL INCOMPATIBILITY***
+
+2005-07-28 (unix bug fix)[1245953] O_APPEND for >> redirection (fellows)
+
+2005-07-29 (bug fix)[1247135] [info globals] return only existing vars (fellows)
+
+2005-07-30 (new Darwin feature) TCL_LOAD_FROM_MEMORY configuration (steffen)
+
+2005-08-05 (bug fix)[1241572] correct [expr abs($LONG_MIN)] (kenny)
+
+2005-08-05 (Solaris bug fix)[1252475] recognize cp1251 encoding (wagner,fellows)
+
+2005-08-11 (config options) eliminated USE_THREAD_STORAGE option (kenny)
+
+2005-08-23 (toolchain support) autoconf-2.59 now required (dejong)
+
+2005-08-24 (new feature)[TIP 219] reflected channels ([chan create]) (kupries)
+
+2005-08-25 (bug fix)[1267380] [lrepeat] buffer overflow prevention (fellows)
+
+2005-08-26 (bug fix) fix [namespace ensemble] crashes in Snit (fellows)
+
+2005-08-29 (bug fix)[1275043] restore round() away from zero (kenny)
+
+2005-08-29 (bug fix)[1189657] correct [tcl::tm::roots] (porter)
+
+2005-09-07 (bug fix)[1283976] invalid [format %c -1] result (porter)
+
+2005-09-08 (new feature)[1242844][TIP 254] new types for Tcl_LinkVar (fellows)
+
+2005-09-07 (toolchain support) deprecate TCL_VARARGS*; stdarg.h assumed (porter)
+***POTENTIAL INCOMPATIBILITY***
+
+2005-09-15 (RHEL bug fix)[1287638] support open >2GB files RHEL 3 (palan)
+
+2005-09-08 (new feature)[TIP 255] [expr min()] and [expr max()] (hobbs)
+
+2005-09-30 (bug fix)[1306162] $argv encoding and list formatting (porter)
+
+2005-10-04 (bug fix)[1067708] [fconfigure -ttycontrol] leak (hobbs)
+
+2005-10-04 (bug fix)[1182373] [http::mapReply] update to RFC 3986 (aho,hobbs)
+=> http 2.5.2
+
+2005-10-04 (HPUX bug fix)[1204237] shl_load() and DYNAMIC_PATH (collins,hobbs)
+
+2005-10-05 (bug fix)[979640] buffer overrun mixing putenv(), ::env (bold,hobbs)
+
+2005-10-08 (new feature)[TIP 237] unlimited range for integers (kenny,porter)
+***POTENTIAL INCOMPATIBILITY*** for any code that relies on implicit truncation
+of integer calculations to the range of a C long
+
+2005-10-14 (platform support)[1256937] MSVC++ static builds (thoyts)
+
+2005-10-19 (bug fix)[1331475] [dict append] crash (bills,sofer)
+
+2005-10-20 (bug fix)[1333036] [lset] shared sublist handling (sofer)
+
+2005-10-23 (bug fix)[1335006] memleack in [glob] (melbardis,darley)
+
+2005-10-23 (bug fix)[1325803] Win: [file stat] on links (bonilla,darley)
+
+2005-11-01 (bug fix)[1337941] Tcl_TraceCommand() -> crash (devilliers,porter)
+
+2005-11-02 (platform support)[1256937] MSVC 8 support (thoyts)
+
+2005-11-03 (new Win NT/XP feature) Unicode console support (kovalenko,thoyts)
+
+2005-11-04 (bug fix)[1337229,1338280] [namespace delete] / unset traces (sofer)
+
+2005-11-04 (enhancement) Korean timezone abbreviations (kenny)
+
+2005-11-04 (platform support)[1163896] LynxOS [load] (heidibr)
+
+2005-11-04 (bug fix)[1334947] value refcount error in var setting (sofer)
+
+2005-11-04 (Win enhancement)[1267871] extended exit codes (newman,thoyts)
+
+2005-11-07 (bug fix)[1348775] unset trace memory leak (sofer)
+
+2005-11-08 (bug fix)[1162286] [package require] checks that the script
+registered by [package ifneeded] provides the version it claims (lavana,porter)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2005-11-09 (bug fix)[1350293,1350291] [after $negative $script] fixed (kenny)
+
+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)
+=> http 2.5.2
+
+2005-11-18 (revert) Restored registration of "list" Tcl_ObjType (porter)
+Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.
+
+2005-11-18 (bug fix)[1359094] Tclkit crash (thoyts, kupries)
+
+2005-11-20 (bug fix)[1091431] Tcl_InitStubs failure crashes wish (english)
+
+2005-11-27 (platform support) Darwin 64bit, Tiger copyfile(), and
+Max OSX universal binaries support (steffen)
+
+2005-11-28 (bug fix) [clock] DST transition error (mackerras,kenny)
+
+2005-11-29 (bug fix)[1366683] [lsearch -regexp] backrefs (cleverly,fellows)
+
+2005-11-30 (performance) recoded portions of [clock] in C (kenny)
+
+2005-11-30 (enhancement) improved bytecode compiling of [switch] (fellows)
+*** POTENTIAL INCOMPATIBILITY ***
+For loading bytecode compiled and saved by earlier 8.5alpha releases
+
+2005-12-05 (Darwin bug fix)[1034337] NFS recursive file delete (steffen)
+
+2005-12-08 (platform support) Win x64 build (hobbs)
+
+2005-12-09 (bug fix)[1374778] [lsearch -start $pastEnd] => -1 (fellows)
+
+2005-12-12 (bug fix)[1377619] configure syntax error exposed in bash-3.1 (hobbs)
+
+2005-12-13 (bug fix)[1379349] [dict for] CoW error (ring,hippler,fellows)
+
+2005-12-18 (bug fix)[1382528] [dict for {k v} {} {}] crash (kovalenko,fellows)
+
+2005-12-27 clock tzdata updated to Olson's tzdata2005r (kenny)
+
+2005-12-27 libtommath updated to release 0.37 (kenny)
+
+2006-01-09 (bug fix)[1480572] [info level $l] => "namespace inscope" (porter)
+
+2006-01-11 (compat support)[1397843] when ::errorInfo is traced, fall back to
+old pattern of stack trace construction (porter).
+Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2004-10-05.
+
+2006-01-12 (bug fix)[1366227] Win: [file stat] sharing violation (darley)
+
+2006-01-23 (bug fix)[1410553] Tcl_GetRange Unicode confusion (twylite,spjuth)
+
+2006-01-23 (bug fix)[1412695] args handling in precompiled procs (traum,sofer)
+
+2006-02-01 (new feature)[1275435][TIP 250] [namespace upvar] (sofer)
+
+2006-02-01 (new feature)[958222][TIP 181] [namespace unknown] (madden)
+
+2006-02-01 (new feature)[944803][TIP 194] [apply] (mistachkin)
+
+2006-02-08 (new feature)[1413934][TIP 258] [encoding dirs], etc. (porter)
+
+2006-02-09 (new feature)[1413115][TIP 215] auto-init [incr] (leitgeb)
+
+2006-03-02 (bug fix)[1379287] norm of paths with /../ back to root (porter)
+
+2006-03-03 (compat support) Restored registration of a "boolean" Tcl_ObjType
+(porter)
+Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.
+
+2006-03-06 (bug fix)[1439836,1444291] fix TCL_EVAL_{GLOBAL,INVOKE} handling
+when auto-loading or exec traces are present (porter)
+
+2006-03-10 (bug fix)[1437595] Win socket finalize with threads (vasiljevic)
+
+2006-03-13 (revert 2005-07-26 change) ${prefix}/share on ::tcl_pkgPath (porter)
+
+2006-03-14 (bug fix)[1448251] TCLX.y_TM_PATH handling (noble, kupries)
+
+2006-03-14 (bug fix)[768659] pipeline error when last command missing (kupries)
+
+2006-03-18 (bug fix)[1193497] Win porting of [file writable] (darley,vogel)
+
+2006-03-18 (bug fix)[1084705] [glob -nocomplain] silence empty result only,
+no other errors (darley)
+***POTENTIAL INCOMPATIBILITY***
+
+2006-03-21 (platform enhancement)[823329] HFS globbing support (steffen)
+
+2006-03-23 (platform support) updated tcl.spec file (max)
+
+2006-03-28 (bug fix)[1064247] BSD: path normalization with realpath() (steffen)
+
+2006-04-03 (bug fix)[1462248] crash reading utf-8 chars spanning multiple
+buffers at end of file (kraft,kupries)
+
+2006-04-05 (bug fix)[1464039] Tcl_GetIndexFromObj: empty key (fellows)
+
+2006-04-05 (bug fix) overdue dde, registry patchelevel increments (porter)
+=> dde 1.3.2
+=> registry 1.2
+
+2006-04-06 (bug fix)[1457515] TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
+removed (steffen)
+
+2006-04-11 (bug fix)[1458266] enter/enterstep trace interference (leunissen)
+
+2006-04-12 (feature change)[1376892] revised definition of [:print:] (fellows)
+
+(platform support) Use of _ANSI_ARGS_ purged. ANSI compiler required (fellows)
+
+Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183,
+1415725,666770]
+
+--- Released 8.5a4, April 27, 2006 --- See ChangeLog for details ---
+
+2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd)
+
+2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin)
+
+2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous
+bytecode while references still on the stack (porter,ryazanov)
+
+2006-05-27 (bug fix)[923072] Darwin: made unthreaded CoreFoundation notifier
+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
+interface for virtual filesystems
+
+2006-07-05 (enhancement) Expression parser rewrite avoids stack overflow,
+reduces from O(N^2) to O(N) complexity, and greatly improves syntas error
+messages (porter)
+***POTENTIAL INCOMPATIBILITY***
+For any code relying on exact error messages.
+
+2006-07-20 (platform support) Mac OS X weak linking (steffen)
+
+2006-07-20 (bug fix) Darwin: execve() works iff event loop not yet run (steffen)
+
+2006-07-24 (bug fix)[1518166] Uninitialized Tcl_DString (afredd)
+
+2006-07-30 (bug fix)[1426279,1505383,1494664,1531530] [clock] fixes (kenny)
+
+2006-08-09 (bug fix)[1531184] [dict for {file stat} x {}] crash (fellows)
+
+2006-08-10 (bug fix)[1538262,1530474] code cleanup; optimizations (afredd)
+
+2006-08-18 (bug fix) intermittent failures in TclUnixWaitForFile() (steffen)
+
+2006-08-18 (platform support) Darwin x86_64 (steffen)
+
+2006-08-21 (bug fix)[1457797] Darwin 64-bit notifier hang (steffen)
+
+2006-08-21 (bug fix) Darwin: recursively called event loop (steffen)
+
+2006-08-21 (enhancement) Darwin: nanosec resolution clicks and [time] (steffen)
+
+2006-08-28 (bug fix)[1547681] TclFormatObj count arguments (mistachkin,porter)
+
+2006-08-28 (bug fix) stack.test failure on FreeBSD (mistachkin)
+
+2006-08-30 (bug fix)[1548263] filesystem segfaults (hobbs,mccormack)
+
+2006-08-31 (bug fix)[1541274] [expr {sqrt(-1)}] => -NaN (suchenwirth,porter)
+
+2006-09-06 (bug fix)[999544] use of MT-safe system calls (vasiljevic)
+
+2006-09-10 (platform support) Darwin: msgcat use CFLocale (steffen)
+=> msgcat 1.4.2
+
+2006-09-10 (new feature) tcltest option: -verbose line (steffen)
+=> tcltest 2.3a1
+
+2006-09-19 (bug fix)[1555271,1561260] Several ** operator bugs (porter)
+
+2006-09-22 (bug fix)[1562528] NULL terminates variadic calls (fellows,ryazanov)
+
+2006-09-22 (new feature)[1520767][TIP 268] [package] alpha/beta version;
+[package require] ranges, [package prefer] selection mode (kupries)
+
+2006-09-26 (platform support) MSVC8 AMD64 support (thoyts)
+
+2006-09-27 (bug fix)[1567222] bignum << errors (porter)
+
+2006-09-30 (enhancement)[1190441] quiet no-op [history] (sofer)
+
+2006-10-04 clock tzdata updated to Olson's tzdata2006m (kenny)
+
+2006-10-05 (bug fix)[1570718] make [lappend $nonList] complain (sofer,virden)
+
+2006-10-05 (bug fix)[1122671] alignment fixes in unicode encoding routines
+(hobbs,staplin)
+
+2006-10-05 (enhancement) Allow "_" in Tcl Module filenames (kupries)
+
+2006-10-05 (new feature) [set ::http::strict 0] (default value is 1) to disable
+URL validity checking against RFC 2986 (hobbs)
+=> http 2.5.3
+
+2006-10-06 (new feature)[1565751][TIP 275] [binary scan] unsigned (thoyts)
+
+2006-10-10 (bug fix)[1566526] crash cleaning up [namespace path] data (porter)
+
+2006-10-12 (bug fix)[1576006] better error messages from [interp alias] (sofer)
+
+2006-10-13 (platform support) get stack size on Darwin (steffen)
+
+--- Released 8.5a5, October 20, 2006 --- See ChangeLog for details ---
+
+2006-10-20 (configure change) Added autodetection for OS-supplied timezone
+files (max)
+
+2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a
+CallFrame, even at level 0 (sofer)
+ *** POTENTIAL INCOMPATIBILITY for users of tclInt.h ***
+
+2006-10-23 (enhancement)[1577492] Tcl_PushCallFrame and [info level]
+enhanced for ensemble rewrites (sofer)
+ *** POTENTIAL INCOMPATIBILITY for [info level 0] on interp alias ***
+
+2006-11-02 (feature change)[TIP 293] Replace {expand} with {*} (hobbs)
+ *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only ***
+
+2006-11-04 (new feature)[TIP 274] Exponentiation operator is right
+associative (porter)
+
+2006-11-09 (new feature)[TIP 272] Added [lreverse] and [string reverse]
+commands (fellows)
+
+2006-11-14 (new feature)[TIP 261] [namespace import] returns list of
+imported commands (porter)
+
+2006-11-15 (new feature)[TIP 270] New C routines Tcl_ObjPrintf,
+Tcl_AppendObjToErrorInfo, Tcl_Format, Tcl_AppendLimitedToObj,
+Tcl_AppendFormatToObj, Tcl_AppendPrintfToObj (porter)
+
+2006-11-22 (feature change) Moved TCL_REG_BOSONLY from tcl.h to tclInt (porter)
+
+2006-11-22 (new feature)[TIP 269] Added [string is list] classification
+command (mistackin, fellows)
+
+2006-11-25 (new feature)[TIP 174] Added commands corresponding to most
+expr operators in ::tcl::mathop (fellows)
+
+2006-11-26 (platform support)[1230558] --enable-64bit on more systems (steffen)
+
+2006-11-27 (bug fix)[1602208] Fix 64-bit handling of select() on unix where
+fd was greater than 32 (fontaine, kenny)
+
+2006-11-28 (new feature)[TIP 280] Added [info frame] command for more
+Tcl-level debugging information (kupries)
+
+2006-12-01 (feature change)[TIP 298] Change Tcl_GetBignumAndClearObj to
+Tcl_TakeBignumFromObj (porter)
+
+2006-12-01 (new feature)[TIP 287] Added [chan pending] subcommand (cleverly)
+
+2006-12-01 (new feature)[TIP 299] Added isqrt() expr operator (kenny)
+
+2006-12-04 (new feature)[TIP 267] Added -ignorestderr option to exec (fellows)
+
+2006-12-05 (new feature)[TIP 291] ::tcl_platform(pointerSize) key (kupries)
+
+2007-01-11 (configure change) Remove "-Wconversion" from deflt CFLAGS (english)
+
+2007-01-25 (configure change) Ensure CPPFLAGS env var is used when set (steffen)
+
+2007-02-19 (configure change) Use SHLIB_SUFFIX=".so" on HP-UX IA64 (was
+".sl") (hobbs)
+
+2007-02-20 (bug fix)[1479814] Handle Windows NT \\?\... extended paths (thoyts)
+
+2007-03-01 (bug fix)[1671138] Fix infinite loop in compiled foreach with an
+empty list (fellows)
+
+2007-03-07 (enhancement) Improved Windows time zone tables to handle new US
+DST rules (kenny)
+
+2007-03-09 (enhancement) Improved Y2038 compliance of zoneinfo files (kenny)
+
+2007-04-02 (enhancement) Added bytecode compilation for global, variable,
+upvar and namespace upvar (sofer)
+
+2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny)
+
+2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny)
+
+2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen)
+
+--- Released 8.5a6, April 25, 2007 --- See ChangeLog for details ---
+
+2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected
+
+2007-05-01 (bug fix)[1710709] leak in [string map] (porter)
+
+2007-05-02 (bug fix)[1710707] leaks in filesystem paths (mistachkin,kenny)
+
+2007-05-18 (feature change) {expand} syntax support removed. (porter)
+ *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only ***
+
+2007-05-29 (bug fix)[1712723] Joinable thread death on 64-bit (virden,hobbs)
+
+2007-05-30 (feature change)[1725186] When expanded literals are parsed,
+(example: {*}{1 2 3}), TCL_TOKEN_EXPAND_WORD token is no longer returned.
+Tokens reflecting the expansion are returned instead. (porter)
+ *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only ***
+
+2007-06-06 (platform support) Darwin: add plist to tclsh (steffen)
+
+2007-06-12 (enhancement) [info] is now a [namespace ensemble] (fellows)
+
+2007-06-20 (enhancement) better `make html` results (hobbs)
+
+2007-06-21 (feature change)[1740962] leave traces created during execution
+of traced command do not fire (sofer)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2007-06-23 (bug fix) Darwin: prevent post-fork() abort() (steffen)
+
+2007-06-27 (bug fix)[1743941] Infinite loop in Tcl_CreateTrace traces (porter)
+
+2007-06-29 (enhancement) Tcl_Alloc alignment on Darwin (steffen)
+
+2007-06-30 (bug fix)[1726873] crash in thread sync objects (vasiljevic,twylite)
+
+2007-06-30 (bug fix)[1717186] [lsort -command \{ $l] leak (afredd,fellows)
+
+2007-07-05 (bug fix)[1743676] no command named "" error message (porter,virden)
+
+2007-07-11 (bug fix)[1752146] [while 1 {}] & [interp limit] on commands (sofer)
+
+2007-07-31 (bug fix)[681877] tcl_platform(user) from system, not env (fellows)
+
+2007-07-31 (enhancement)[1750051] space efficiency of Tcl variables (sofer)
+ *** POTENTIAL INCOMPATIBILITY for C code that accesses internal
+ Tcl structs Var, Bytecode, Namespace, or CallFrame. ***
+
+2007-08-01 (enhancement)[1764318] word.tcl proc rewrites (petasis,fellows)
+
+2007-08-08 (bug fix)[1770224] [tcl::mathop::>> $big1 $big2] errors (porter)
+
+2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen)
+
+2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows)
+
+2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter)
+
+2007-08-16 (performance)[1564517] pre-compile constant expressions (porter)
+
+2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to
+prompt for continuation line (porter)
+
+2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny)
+
+2007-08-25 (performance)[1767293] ** on native integer types (kenny)
+
+2007-09-03 clock tzdata updated to Olson's tzdata2007g (kenny)
+
+2007-09-06 (platform support) Darwin: drop support for Xcode 1.5 project, add
+project for Xcode 3.0 (steffen)
+
+2007-09-08 (bug fix)[1786481] nested [dict update] crash (fellows)
+
+2007-09-08 (bug fix)[1710710] TclPtrSetVar leak (mistachkin,sofer)
+
+2005-09-09 (feature removed) Tcl_ObjType "nsName" no longer registered (porter)
+ *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("nsName") ***
+
+2007-09-10 (bug fix)[1740631] Linked variable unlink prevention (maros,hobbs)
+
+2007-09-11 (bug fix)[1786481] [dict update] stack management (sofer)
+ *** POTENTIAL INCOMPATIBILITY with previous 8.5 alpha bytecode only ***
+
+2007-09-11 (bug fix)[1578344] [package require -exact] 8.4 compat (porter)
+ *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only ***
+
+2007-09-11 (bug fix)[1772989,1071322] Support _, : in test constraints (porter)
+=> tcltest 2.3b1
+
+2007-09-11 (platform support) Windows AMD64 support (thoyts)
+
+2007-09-14 (enhancement)[1793984] DTrace provider for Tcl (steffen)
+
+2007-09-14 (bug fix)[1519940] surplus ns path invalidation (fellows,bauer)
+
+2007-09-15 (platform support) SunOS-5.1x link with cc, not ld (steffen)
+
+2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english)
+
+(bug fix)[1066755] Several stack efficiency efforts increases recursion limit
+on Windows to be larger than the default [interp recursionlimit] value
+
+--- Released 8.5b1, September 26, 2007 --- See ChangeLog for details ---
+
+2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter)
+
+2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin)
+
+2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter)
+
+2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin)
+
+2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic)
+
+--- Released 8.5b2, October 26, 2007 --- See ChangeLog for details ---
+
+2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer)
+
+2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows)
+
+2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows)
+
+2007-11-01 (bug fix)[1808258] [string is ascii \000] (fellows)
+
+2007-11-05 (bug fix)[1823576] [fconfigure $serial -xchar \000] (cassof)
+
+2007-11-07 (performance)[1827996] binary glob matching (hobbs)
+
+2007-11-07 (performance) binary [gets] (hobbs)
+
+2007-11-09 (performance)[1829248] interp state reset (sofer)
+
+2007-11-10 (performance) stack checking (sofer)
+
+2007-11-10 (performance) list indexing bytecode (sofer)
+
+2007-11-11 (performance)[1830038] macros to fetch Tcl_Obj intreps (sofer)
+
+2007-11-11 (performance)[1830166] RE bytecode for simple cases (hobbs)
+
+2007-11-13 (performance) [switch] & [regexp] use RE bytecode (hobbs, fellows)
+
+2007-11-14 (performance) bytecode for [info exists] (fellows)
+
+2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows)
+
+2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter)
+
+Many significant documentation improvements (fellows, sofer)
+
+--- Released 8.5b3, November 19, 2007 --- See ChangeLog for details ---
+
+2007-11-20 (enhancement) string rep of dict has stable order (fellows)
+
+2007-11-21 (enhancement) compiled ensemble support (fellows)
+
+2007-11-22 (enhancement) [dict] is now an ensemble (fellows)
+
+2007-11-23 (enhancement) [string] is now an ensemble (fellows)
+
+2007-11-26 (bug fix)[1815573] Correct stack checking failure (sofer,golovan)
+
+2007-11-27 (bug fix)[800753] Document single byte char limit for
+[chan configure -eofchar] (cassoff)
+
+2007-12-03 (enhancement)[1836519] [switch $val $body] safe/fast (fellows,spjuth)
+
+2007-12-03 (release) tcltest package bump to 2.3.0 (porter)
+
+2007-12-03 (bug fix)[1618235] fix BSD compile errors (fellows)
+
+2007-12-05 (bug fix)[1844789] fix [lsearch -exact -integer] crash (fellows)
+
+2007-12-05 (performance)[1845092] Tcl_ObjType for channel names (hobbs)
+
+2007-12-14 (bug fix)[1602539] NUL pollution in [glob] result (hobbs)
+
+2007-12-17 (bug fix)[1851832,1851524] memory alignment correction (sofer)
+
+2007-12-18 (bug fix)[1810264] revised regexp engine to prevent debilitating
+over-consumption of resources (drewry,lane,ormandy,fellows)
+
+Several documentation and release notes improvements
+
+--- Released 8.5.0, December 20, 2007 --- See ChangeLog for details ---
+
+2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs)
+
+2007-12-26 (enhancement)[1856994] [lsort] performance (sofer)
+
+2008-01-10 (bug fix)[1867855] fix [format %lli 0] crash (porter)
+
+2008-01-11 (bug fix)[1850424,1860425] stack checking on *bsd (sofer,noble)
+
+2008-01-13 (bug fix)[1353846] crash in read-only serial (hobbs,newman)
+
+2008-01-15 (bug fix)[1869989] mem leak; expr literals (porter,melbardis)
+
+2008-01-20 (bug fix)[1869405] binary [gets]; stacked channels (hobbs,ficicchia)
+
+2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden)
+
+2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na)
+
+Several documentation and release notes improvements
+
+--- Released 8.5.1, February 5, 2008 --- See ChangeLog for details ---
+
+2008-02-06 (enhancement) [clock format] performance (kenny)
+
+2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows)
+
+2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts)
+=> http 2.5.4
+
+2008-02-26 (bug fix)[1868845] corrected [eof] ordering (thoyts)
+
+2008-02-26 (new feature) [http::meta] command (thoyts)
+=> http 2.5.5
+
+2008-02-26 (bug fix)[1902436] fixed regexps ending in \* (hobbs)
+
+2008-02-27 (bug fix)[1862555,1902423] [clock] range & l10n (kenny)
+
+2008-02-28 (bug fix) [return -level 0] memory leak (porter)
+
+2008-02-28 (bug fix) [format %llx $big] memory leak (porter)
+
+2008-02-28 (bug fix) expression parser error message memory leak (porter)
+
+2008-02-28 (bug fix) memory leak when enter trace modifies command (porter)
+
+2008-02-29 (enhancement) Consumer refcounting for Tcl_SetReturnOptions()
+and Tcl_AddObjToErrorInfo() (spjuth,porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-03-07 (bug fix)[1899164] Avoid expr and script bytecode confusion (porter)
+
+2008-03-07 (bug fix)[1904907] finalize crash in Tcl_GetReturnOptions (kupries)
+
+2008-03-10 (bug fix)[1893815] expr {abs(-1e-350)} => -0.0 (porter)
+
+2008-03-10 (bug fix)[1901113] crash in [tcl::Bgerror {} {}] (madden,porter)
+
+2008-03-11 (bug fix)[1911919] unset trace inf loop in namespace delete (sofer)
+
+2008-03-12 (new feature) some HTTP 1.1 support in http (and more!) (hobbs)
+=> http 2.7
+
+2008-03-13 (enhancement) support space in INSTALL_ROOT or $builddir (steffen)
+
+2008-03-16 (bug fix)[1903325] bytecode stack space prediction crash (fellows)
+
+2008-03-18 (bug fix)[1914604] Tcl Modules: encoding fixed to utf-8; environment
+variables without "." added to customization hooks (kupries)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-03-18 (bug fix)[1914503] alignment of TclStackAlloc() return (sofer)\
+
+2008-03-20 (bug fix)[1868171] expose Tcl_GetMemoryInfo (for AOLserver) (fellows)
+
+2008-03-24 (bug fix)[1923966] crash in [binary format x0s] (thoyts)
+
+2008-03-27 (platform support)[1921166] Solaris 64bit build fixes (steffen)
+
+2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny)
+
+--- Released 8.5.2, March 28, 2008 --- See ChangeLog for details ---
+
+2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin)
+
+2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker)
+
+2008-04-02 (bug fix)[780533,1932639] [fcopy] callbacks unreliable (ferrieux)
+
+2008-04-02 (interface)[1819422] libtclstub symbols MODULE_SCOPE (steffen)
+
+2008-04-04 (bug fix) [chan postevent] crash (kupries)
+
+2008-04-07 (bug fix) Fix broken [format {% d}] (max)
+
+2008-04-07 (bug fix)[1350564] Bi-directional [fcopy] now supported (ferrieux)
+
+2008-04-16 (bug fix)[1938497] Tcl_SetNotifier() fixes (steffen)
+
+2008-04-16 (interface)[1938497] make stubs tables 'static const' (steffen)
+
+2008-05-02 (new feature) [binary] is now a [namespace ensemble] (thoyts)
+
+2008-05-07 (bug fix) [dict append] crash (mccormack,fellows)
+
+2008-05-21 (bug fix)[1968882] [info complete "\\\n"] => 0 (porter)
+
+2008-05-22 (bug fix)[1968245] Tcl_LogCommandInfo() accept length=-1 (darroch)
+
+2008-05-23 (bug fix)[1965787] 32-bit overflow in [tell] result (ferrieux)
+
+2008-05-31 (new feature)[TIP 257] [oo::*] commands from TclOO (fellows)
+
+2008-06-04 (new feature)[TIP 317] [binary encode]; [binary decode] (thoyts)
+
+2008-06-06 (new feature)[TIP 230] [chan push]; [chan pop] (kupries)
+
+2008-06-08 (enhancement)[1973096] bytecompiled [uplevel] scripts (sofer)
+
+2008-06-12 (platform support) Solaris static build with DTrace (steffen)
+
+2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen)
+
+2008-06-13 (new feature)[TIP 285] [interp cancel]; Tcl_CancelEval() (mistachkin)
+
+2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter)
+
+2008-06-23 (bug fix)[1972879] bad path intrep caching (porter)
+
+2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter)
+
+2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries)
+
+--- Released 8.6a1, June 25, 2008 --- See ChangeLog for details ---
+
+2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen)
+
+2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows)
+
+2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos)
+
+2008-07-03 (bug fix)[1987821] mem leak in [seek] on reflected chan (kupries)
+
+2008-07-13 (enhancement)[2017110] new Non-Recursive Evaluation implementation
+enables deep Tcl evaluation stacks without deep C stacks. (sofer)
+
+2008-07-20 (enhancement)[2008248] dict->list preserve item intreps (pasadyn)
+
+2008-07-21 (bug fix)[582506] imported cmds now fire execution traces (sofer)
+
+2008-07-21 (bug fix)[2015723] [file] bad use of inodes on Windows (thoyts)
+
+2008-07-21 (new feature)[TIP 304] [chan pipe] (ferrieux)
+
+2008-07-21 (bug fix)[2021443] more consistent "wrong # args" msgs (nijtmans)
+
+2008-07-21 (enhancement) [info frame] returns file data in more cases (kupries)
+
+2008-07-29 (bug fix)[2030670] fix rare panic in TclStackFree (pasadyn,sofer)
+
+2008-08-01 Tcl_Finalize() no longer called implicitly on DLL_PROCESS_DETACH.
+
+2008-08-05 (enhancement)[1994512] async connect logic simplified (jenglish)
+
+2008-08-06 (bug fix)[2040295] stopped supplying a workaround for bugs
+in Itcl's use of [namespace code]. Itcl now supplies its own workaround.
+ *** POTENTIAL INCOMPATIBILITY for older Itcl releases ***
+
+2008-08-06 (bug fix)[2039178] repaired guard against dispatching oo methods
+in a deleted interp. (porter)
+
+2008-08-08 tzdata updated to Olson's tzdata2008e (kenny)
+
+2008-08-11 (bug fix)[2046846] 64bit support for http zlib crc (thoyts)
+=> http 2.7.1
+
+2008-08-11 (enhancement) automatic [package provide] for TMs (kupries)
+
+2008-08-17 (bug fix)[2055782] crash involving Tcl_ConcatObj (sofer)
+
+2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *),
+(Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter)
+
+--- Released 8.6a2, August 25, 2008 --- See ChangeLog for details ---
+
+2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows)
+
+2008-09-01 oo methods called during interp deletion no longer skipped if
+they do not need the dying interp (fellows)
+
+2008-09-02 (support) Dropped support for pre-ANSI compilers. (porter)
+
+2008-09-04 (bug fix)[2093947] var unset trace in coroutine (fellows,sofer)
+
+2008-09-10 (enhancement) efficient list->dict conversion (elby,fellows)
+
+2008-09-10 (bug fix)[2102930] faulty numLevels count (madden,sofer)
+
+2008-09-16 (bug fix)[2114165] eval failure following cancel (sofer)
+
+2008-09-17 (bug fix)[2116053] export [min] and [max] from tcl::mathfunc (sofer)
+
+2008-09-22 (new feature)[TIP 320] oo common variable declaration (fellows)
+
+2008-09-24 (new feature)[TIP 316] portable access to Tcl_StatBuf (fellows)
+
+2008-09-24 (new feature)[TIP 323] [file delete], [file mkdir] zero pathNames (porter)
+
+2008-09-25 (new feature)[TIP 315] new var: tcl_platform(pathSeparator) (vu,fellows)
+
+2008-09-25 (new feature)[TIP 323] [global], [variable] zero varNames (porter)
+
+2008-09-26 (new feature)[TIP 323] [lassign], [namespace upvar], [my variable] zero varNames (porter)
+
+2008-09-26 (new feature)[TIP 323] [tcl::tm::path add|remove] zero pathNames (porter)
+
+2008-09-26 (new feature)[TIP 323] [lrepeat] zero elements; zero repeats (porter)
+
+2008-09-27 (bug fix)[2130992] prevent overflow crash in [lrepeat] (fellows)
+
+2008-09-28 (new feature)[TIP 314] ensemble parameters before subcommand (hellström,fellows)
+
+2008-09-29 (new feature)[TIP 318] revised defaults for [string trim] (poser)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-09-29 (new feature)[TIP 313] [lsearch -bisect] (spjuth)
+
+2008-09-29 (new feature)[TIP 326] [lsort -stride] (elby)
+
+2008-09-29 (new feature)[TIP 323] [linsert] zero elements (porter)
+
+2008-09-29 (new feature)[TIP 323] [glob] zero patterns (porter)
+
+2008-10-02 (new feature)[TIP 330] interp->result access disabled (kenny)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-03 (new feature)[TIP 265] Tcl_ParseArgv() (bromley)
+
+2008-10-03 (new feature)[TIP 195] [tcl::prefix] (spjuth)
+
+2008-10-04 (new feature) CONST-ified Tcl routines Tcl_GetIndexFromObj,
+Tcl_RegisterConfig, Tcl_InitCustomHashTable, and routines passing
+(Tcl_ChannelType *). (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-04 (bug fix)[2059262] unload only libraries marked unloadable (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-05 (new feature)[TIP 331] [lset listVar end+1 $value] (kenny)
+
+2008-10-05 (bug fix)[2143288] correct bad isqrt() results (boffey,kenny)
+
+2008-10-05 (new feature) CONST-ified return value of the
+Tcl_FSFileAttrStringsProc prototype. (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY for Tcl_Filesystems ***
+
+2008-10-07 (new feature)[TIP 327] [tailcall] (sofer)
+
+2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer)
+
+2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter)
+
+2008-10-10 (bug fix)[2155658] crash in oo method export (fellows)
+
+--- Released 8.6a3, October 10, 2008 --- See ChangeLog for details ---
+
+2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)
+
+2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was
+broken by NRE reform (sofer,porter)
+
+2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts)
+=> http 2.7.2
+
+2008-10-27 (enhancement) system encoding at startup is now "iso8859-1", and
+no longer "identity". Use of identity encoding minimized (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2008-10-31 (bug fix)[2200824] revised [oo::define] to include caller
+context when resolving names. (nassau,fellows)
+
+2008-11-10 (bug fix)[2255235] [platform::shell::LOCATE] update (ring,kupries)
+=> platform::shell 1.1.4
+
+2008-11-13 (bug fix)[2269431] VFS [load] -> tempfile litter (ficicchia,nijtmans)
+
+2008-11-26 (bug fix)[2114900] updated tclIndex file (cassoff,kenny)
+
+2008-11-27 (bug fix)[2251175] [{*}{\{}] errors (hellström,ferrieux,porter)
+
+2008-11-29 (new feature)[TIP 210] [file tempfile] (techentin,fellows)
+
+2008-11-30 (bug fix)[2362156] [clock]: colon in format string (mizuno,kenny)
+
+2008-12-02 (bug fix)[2270477] hang in channel finalization (ferrieux,kupries)
+
+2008-12-02 (new feature)[TIP 336] Tcl_*ErrorLine() routines. Direct access
+to the errorLine field of the interp struct denied by default. (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+ *** Define USE_INTERP_ERRORLINE to restore access for legacy code ***
+
+2008-12-04 (bug fix)[2385549] [file normalize] failed on some paths (porter)
+
+2008-12-05 (new feature)[TIP 307] Tcl_TransferResult() (leunissen,fellows)
+
+2008-12-05 (new feature)[TIP 335] Tcl_InterpActive() (mistachkin,fellows)
+
+2008-12-09 (new feature)[TIP 337] Tcl_BackgroundException() (porter)
+
+2008-12-10 (new feature)[TIP 341] >1 [dict filter] patterns (hellström,fellows)
+
+2008-12-10 (new feature)[TIP 343] [format %b $n] [scan $s %b] (ferrieux)
+
+2008-12-10 tzdata updated to Olson's tzdata2008i (kenny)
+
+2008-12-11 (new feature)[TIP 234] [zlib] and Tcl_Zlib*() (sheffers,fellows)
+
+2008-12-11 (bug fix)[2407783] spoil ChannelState when channel name passes
+among multiple interps (kupries)
+
+2008-12-12 (new feature)[TIP 322] Tcl_NR*() routines to enabled non-recursive
+evaluation in extensions (sofer,kenny)
+
+2008-12-09 (new feature)[TIP 338] Tcl_*StartupScript() (porter)
+ *** POTENTIAL INCOMPATIBILITY for callers of Tcl*Startup* routines ***
+
+2008-12-16 (new feature)[TIP 329] [try] [throw] (davel,fellows)
+
+2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny)
+
+2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux)
+
+2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter)
+
+--- Released 8.6b1, December 19, 2008 --- See ChangeLog for details ---
+
+2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows)
+ *** INCOMPATIBILITY with interface of 8.6b1 ***
+
+2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows)
+
+2009-01-03 (bug fix)[2481670] [clock add] error message (talvo)
+
+2009-01-05 (bug fix)[2412068] NR-enable [source] (fellows)
+
+2009-01-06 (bug fix)[2489836] crash unknown method dispatch (nadkarni,fellows)
+
+2009-01-06 (bug fix)[2481109] fix context of instance name check (fellows)
+
+2009-01-08 (enhancement) more -errorcode values (fellows)
+
+2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tclConfig.sh goes (cassoff)
+
+2009-01-19 (platform support) better tools for BSD ports (cassoff)
+
+2009-01-21 (bug fix)[2458202] exit crash with [chan create]d channel (kupries)
+
+2009-01-26 (bug fix)[2446662] uniformly declare EOF on RST on sockets (ferrieux)
+
+2009-01-26 (bug fix)[1028264] delay WSACleanup() from under our feet (ferrieux)
+
+2009-01-29 (bug fix)[2519474] Tcl_FindCommand() bug exposed by oo (fellows)
+
+2009-01-29 (bug fix)[2537939] Fix Tcl_OOInitStubs() for no-stubs build (fellows)
+
+2009-02-04 (bug fix)[2561746] [string repeat] overflow crash (porter)
+
+2009-02-05 (enhancement) optimize string operations on bytearrays (fellows)
+
+2009-02-12 (bug fix) enable simpler [oo::define] extension (ferri,fellows)
+
+2009-02-15 (bug fix)[2603158] Tcl_AppendObjToObj: append to self crash (porter)
+
+2009-02-17 (platform support) MSVC and _WIN64 (hobbs)
+
+2009-02-20 (bug fix)[2571597] [file pathtype /a] wrong result (nadkarni,porter)
+
+2009-03-03 (bug fix)[2662434] [zlib crc32] result now unsigned (gavilan,fellows)
+
+2009-03-15 (platform support) translate SIGINFO where defined (BSD) (teterin)
+
+2009-03-15 (bug fix)[2687952] TSD struct memleak (mistachkin)
+
+2009-03-18 (bug fix)[2688184] memleak in [file normalize] (mistachkin)
+
+2009-03-20 (bug fix)[2597185] crash in Tcl_AppendStringToObj (porter)
+
+2009-03-20 (bug fix)[2561794,2669109,2494093,2553906] string overflow (porter)
+
+2009-03-22 (bug fix)[2502037] NR-enable [namespace unknown] (sofer)
+
+2009-03-27 (bug fix)[2710920] [file dirname|tail /foo/] errors (epler,porter)
+
+2009-04-08 (bug fix)[2570363] unsafe [eval]s in tcltest (bron,porter)
+=> tcltest 2.3.1
+
+2009-04-08 (platform support) more Darwin kernel patterns (steffen)
+=> platform 1.0.4
+
+2009-04-09 (bug fix)[26245326] [http::geturl] connection failures (golovan)
+=> http 2.7.3
+
+2009-04-10 (new feature) Darwin: embeddable CoreFoundation notifier (steffen)
+
+2009-04-10 (bug fix)[1961211] Darwin [load] back-compatibility (steffen)
+
+2009-04-09 (new feature) http chunked+gzip modes (thoyts)
+=> http 2.8.0
+
+2009-04-11 (enhancement) clarified cmd name resolution in oo forwards (fellows)
+
+20009-04-19 (bug fix)[2715421] http: excess bytes after POST (thoyts)
+=> http 2.8.1
+
+2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer)
+
+2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer)
+
+2009-05-08 (bug fix)[2414858] tailcall in oo constructor (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
+
+2009-06-02 (bug fix)[2798543] incorrect [expr] integer ** results (porter)
+
+2009-06-10 (bug fix)[2801413] overflow in [format] (porter)
+
+2009-06-13 (bug fix)[2802881] corrected compile env context (tasada,porter)
+
+2009-06-17 (redesign) reduced ambition of [exit] finalization with aim to
+avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux)
+ *** POTENTIAL INCOMPATIBILITY for exit handlers ***
+
+2009-06-26 (platform support) updates for Xcode 3.1 & 3.2 (steffen)
+
+2009-06-30 (platform support) clang static analyzer macros (steffen)
+
+2009-07-01 (bug fix)[2806622] Win: bad tcl_platform(user) value (thoyts)
+
+2009-07-05 (bug fix) zlib support asynch [chan copy] on chan transform (fellows)
+
+2009-07-12 (bug fix)[1895546] TclOO support for Itcl 4 method caching (fellows)
+
+2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries)
+
+2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny)
+
+2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter)
+
+2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows)
+
+2009-07-20 (performance) favor [string is] success cases over empty (fellows)
+
+2009-07-22 (interface) removed TclpPanic() routine (nijtmans)
+
+2009-07-23 (bug fix)[2820349] plug event leak in notifier (mistachkin)
+
+2009-07-24 (bug fix)[2826248] crash in Tcl_GetChannelHandle (sonnenburg,kupries)
+
+2009-07-31 (bug fix)[2830354] overflow in [format] (misch,porter)
+
+2009-08-06 (bug fix)[2827000] reflected channels can signal EGAIN (kupries)
+
+2009-08-12 (new feature)[TIP 353] Tcl_NRExprObj() (porter)
+
+2009-08-20 (bug fix)[2823276] NR-enable [if], [for], [while] (fellows)
+
+2009-08-20 (bug fix)[2806250] EIAS violation in ~foo pathnames (porter)
+
+2009-08-21 (bug fix)[2837800] [glob */foo] return ./~x/foo (porter)
+
+2009-08-24 (bug fix) nested event loop notifier w/TkAqua Cocoa (alaoui,steffen)
+
+2009-08-25 (bug fix) [info frame] account for continuation lines (kupries)
+
+2009-08-27 (bug fix)[2845535] overflows in [format] (porter)
+
+2009-09-01 (bug fix) improved error message in tcltest (porter)
+=> tcltest 2.3.2
+
+2009-09-11 (bug fix)[2849860] http handle "quoted" charset value (fellows)
+=> http 2.7.4
+
+2009-09-11 (enhancement)[2314561] [subst] now bytecompiled, NR-enabled (porter)
+
+2009-09-24 (new feature)[TIP 356] Tcl_NRSubstObj() (porter)
+
+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
+introduced by first versions of the NRE conversion (nadkarni,porter)
+
+2009-10-06 (bug fix)[1941434] broken tclTomMath.h includes (porter)
+
+2009-10-07 (bug fix)[2871908] leaked hash table (mistachkin,kupries)
+
+2009-10-08 (bug fix)[2874678] bignum leak in [dict incr] (fellows)
+
+2009-10-17 (bug fix)[2629338] crash in var unset traces (raney,fellows)
+
+2009-10-19 (bug fix)[2107634] extend [read] and [gets] to Tcl string limits
+(morrison,parker,porter)
+
+2009-10-21 (bug fix)[2882561] Haiku OS signal support (morrison,fellows)
+
+2009-10-22 (bug fix)[2883857] [my varname arr(index)] (boudaillier,fellows)
+
+2009-10-23 (bug fix) 0-length writes: spurious SIG_PIPE (teterin,kupries)
+
+2009-10-24 Broken DST applied EU rules to US zones (lehenbauer,kenny)
+
+2009-10-29 (bug fix)[2800740] halved bignum memory on 64-bit systems (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2009-11-05 (bug fix)[2854929] TM search path support in Safe Base (kupries)
+
+2009-11-05 (enhancement) rewrite of the Safe Base commands (kupries)
+
+2009-11-11 (bug fix)[2888099] [close] loses ENOSPC error (khomoutov,ferrieux)
+
+2009-11-11 (bug fix)[2891171] RFC 3986 compliance for ? in URL (nijtmans)
+=> http 2.8.2
+
+2009-11-12 (bug fix)[2895565] [fcopy -size] miscounts when converting encodings
+(kupries)
+
+2009-11-16 (bug fix)[2891556] encoding finalization crash (mistachkin,ferrieux)
+
+2009-11-18 (bug fix)[2849797] consistent names for std chans (nijtmans,fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2009-11-19 (enhancement) [load]able Tcltest extension (nijtmans)
+
+2009-11-24 (bug fix)[2893771] [file stat] on Win locked files (thoyts)
+
+2009-11-24 (bug fix)[2903011] crash call destructor from constructor (fellows)
+
+2009-12-03 (bug fix)[2906841] Safe Base [glob ../*] fixes (fellows)
+
+2009-12-09 (bug fix)[2901998] consistent I/O buffering (ferrieux,kupries)
+
+2009-12-11 (bug fix)[2806407] NR-enabled coroutines (sofer)
+
+2009-12-16 (bug fix)[2913616] msgcat: improved safe interp support (fellows)
+=> msgcat 1.4.3
+
+2009-12-22 (bug fix)[2918962] [lsort -index -stride] crash (moore,fellows)
+
+2009-12-23 (bug fix)[2913625] [info script/nameof] in safe interps (fellows)
+
+2009-12-28 (bug fix)[2891362] enable time limit in child interps (fellows)
+
+2009-12-29 (bug fix)[2922555] [binary decode hex { }] crash (thoyts)
+
+2009-12-29 (bug fix)[2895741] enable min(), max() in safe interps (fellows)
+
+2009-12-30 (bug fix)[2824981] guard [unknown] against [set] undef (sofer)
+
+2010-01-05 (bug fix)[2918610] [file rootname] corruption (magerya,porter)
+
+2010-01-18 (bug fix)[2932421] less [format %s] shimmer (ferrieux)
+
+2010-01-18 (bug fix)[2918110] [chan postevent] crash (bron,kupries)
+
+2010-01-21 (bug fix)[2910748] NR-enable epoch fallback direct eval (sofer)
+
+2010-01-30 (enhancement) [unset] now bytecompiled (fellows)
+
+2010-02-01 (bug fix)[2942697] faster match: some pathological regexp patterns
+(lane,fellows)
+
+2010-02-01 (bug fix)[2939073] [array unset] unset trace crash (ferrieux)
+
+2010-02-02 (bug fix)[2944404] crash in oo destructor (fellows)
+
+2010-02-02 (new feature) [array] is now a [namespace ensemble] (fellows)
+
+2010-02-05 (enhancement) [error] now bytecompiled (fellows)
+
+2010-02-08 (bug fix)[2947783] Tcl_Zlib*flate fail on shared values (fellows)
+
+2010-02-09 (enhancement) [try] now bytecompiled (fellows)
+
+2010-02-11 (bug fix)[2826551] line-sensitive matching in regexp (dejong)
+
+2010-02-11 (bug fix)[2949740] [open |noSuch rb] crash (kovalenko,fellows)
+
+2010-02-15 (bug fix)[2950259] harden (delete obj ns -> delete obj) (fellows)
+
+2010-02-21 (bug fix)[2954959] get sign of abs($zero) right (nijtmans)
+
+2010-02-22 (bug fix)[2762041] zlib chan transforms read EOF too early (kupries)
+
+2010-02-27 (bug fix)[801429] Tcl_SetMainLoop() thread safety (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-03-02 (enhancement) -fvisibility-hidden build support (nijtmans)
+
+2010-03-04 (bug fix)[2962664] [oo::class destroy] crash (fellows)
+
+2010-03-05 (interface) TclOO typedefs for function pointers (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-03-09 (bug fix)[2936225] stop [chan copy] to slow channel consuming all
+memory with buffer backup (ferrieux)
+
+2010-03-17 (bug fix)[2921116] crash in chan transfrom teardown (kupries)
+
+2010-03-19 (enhancement) [throw] now bytecompiled (fellows)
+
+2010-03-20 (enhancement) permit [fcopy] of > 2**31 bytes (fellows)
+
+2010-03-24 (new feature) [info object methodtype] (fellows)
+
+2010-03-24 (bug fix)[2383005] [return -errorcode] reject non-list (porter)
+
+2010-03-25 (bug fix)[2976504] broken fstatfs() call (reeuwijk,fellows)
+
+2010-03-30 (new feature)[TIP 362] [registry -32bit|-64bit] (courtney,fellows)
+=> registry 1.3
+
+2010-03-30 (bug fix)[2978773] refchan mem preservation (kupries)
+
+2010-04-02 (new feature)[TIP 357] Tcl_LoadFile, Tcl_FindSymbol, etc. (kenny)
+
+2010-04-05 (configure change)[TIP 364] default build: --enable-threads (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-04-02 (new feature)[TIP 348] [info errorstack], [return -errorstack]
+(ferrieux)
+
+2010-04-20 (enhancement) update bundled zlib to 1.2.5 (nijtmans)
+
+2010-04-29 (enhancement)[2992970] optimize bytearray appends (fellows)
+
+2010-05-19 (bug fix)[3004007] dict/list shimmer w/o string rep loss (fellows)
+
+2010-06-09 (bug fixes) platform: several fixes for 64 bit systems (kupries)
+=> platform 1.0.9
+
+2010-06-16 (bug fix)[3016135] [clock format] in he_IL locale (nijtmans)
+
+2010-06-18 (bug fix)[3017997] Add .cmd to file extensions for [exec] (fellows)
+
+2010-06-28 (bug fix)[3019634] support errno.h changes in MSVC++ 2010 (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2010-07-02 (enhancement) -errorcode for [expr] domain errors (fellows)
+
+2010-07-28 (bug fix)[3037525] crash deleting vars @ callframe pop (sofer)
+
+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)
+
+2010-08-04 (platform support) panic on detection of win9x system (hobbs)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+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 ---
+
+2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)
+
+2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)
+
+2013-01-04 (bug fix) memleak in [format] compiler (fellows)
+
+2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points
+
+2013-01-09 (bug fix)[3599395] status line processing (nijtmans)
+2013-01-23 (bug fix)[2911139] repair async connection management (fellows)
+=> http 2.8.6
+
+2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans)
+
+2013-01-28 (enhancement) improve ensemble bytecode (fellows)
+
+2013-01-30 (enhancement) selected script code improvements (fradin)
+=> tcltest 2.3.6
+
+2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries)
+=> platform 1.0.11
+
+2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff)
+
+2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin)
+
+2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows)
+
+2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows)
+
+2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans)
+=> msgcat 1.5.1
+
+2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick)
+
+2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter)
+
+2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max)
+
+2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane)
+
+2013-03-03 (bug fix)[3606258] major serial port update (english)
+
+2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
+(grathwohl,lane,porter)
+
+2013-03-12 (enhancement) better build support for Debian arch (shadura)
+
+2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)
+
+2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin)
+
+2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter
+
+2013-04-04 (bug fix) Support URLs with query but no path (max)
+=> http 2.8.7
+
+2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas)
+
+2013-04-29 (enhancement) [array set] compile improvement (fellows)
+
+2013-04-30 (enhancement) broaden glibc version detection (kupries)
+=> platform 1.0.12
+
+2013-05-06 (platform support) Cygwin64 (nijtmans)
+
+2013-05-15 (enhancement) Improved [list {*}...] compile (fellows)
+
+2013-05-16 (platform support) mingw-4.0 (nijtmans)
+
+2013-05-19 (platform support) FreeBSD updates (cerutti)
+
+2013-05-20 (bug fix)[3613567] access error temp file creation (keene)
+
+2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene)
+
+2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows)
+
+2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann)
+=> msgcat 1.5.2
+
+2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)
+
+2013-06-03 Restored lost performance appending to long strings (elby,porter)
+
+2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
+
+2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
+
+2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
+
+2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)
+
+2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)
+
+2013-07-06 tzdata updated to Olson's tzdata2013d (kenny)
+
+2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter)
+
+2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter)
+
+2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane)
+
+2013-07-29 [string is space \u202f] => 1 (nijtmans)
+
+2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans)
+
+2013-08-01 (bug fix)[1905562] RE recursion limit increased to support
+reported usage of large expressions (porter)
+
+2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)
+
+2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows)
+
+2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter)
+
+2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter)
+
+2013-08-15 Errors from execution traces become errors of the command (porter)
+
+2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)
+
+2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)
+
+2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)
+
+2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter)
+
+2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows)
+=> TclOO 1.0.1
+
+2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows)
+
+2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter)
+
+2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter)
+
+Many optmizations, improvements, and tightened stack management in bytecode.
+
+--- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ 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 7c2406c..5be08ba 100644
--- a/compat/dirent2.h
+++ b/compat/dirent2.h
@@ -9,17 +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: dirent2.h,v 1.2 1998/09/14 18:39:44 stanton Exp $
*/
#ifndef _DIRENT
#define _DIRENT
-#ifndef _TCL
-#include <tcl.h>
-#endif
-
/*
* Dirent structure, which holds information about a single
* directory entry.
@@ -52,8 +46,8 @@ typedef struct _dirdesc {
* Procedures defined for reading directories:
*/
-extern void closedir _ANSI_ARGS_((DIR *dirp));
-extern DIR * opendir _ANSI_ARGS_((char *name));
-extern struct dirent * readdir _ANSI_ARGS_((DIR *dirp));
+extern void closedir (DIR *dirp);
+extern DIR * opendir (char *name);
+extern struct dirent * readdir (DIR *dirp);
#endif /* _DIRENT */
diff --git a/compat/dlfcn.h b/compat/dlfcn.h
index 1dee078..fb27ea0 100644
--- a/compat/dlfcn.h
+++ b/compat/dlfcn.h
@@ -1,4 +1,4 @@
-/*
+/*
* dlfcn.h --
*
* This file provides a replacement for the header file "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.2 1998/09/14 18:39:44 stanton 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
*/
@@ -29,10 +26,6 @@
#ifndef __dlfcn_h__
#define __dlfcn_h__
-#ifndef _TCL
-#include <tcl.h>
-#endif
-
#ifdef __cplusplus
extern "C" {
#endif
@@ -49,14 +42,14 @@ extern "C" {
* that contains functions to be called to initialize and terminate.
*/
struct dl_info {
- void (*init) _ANSI_ARGS_((void));
- void (*fini) _ANSI_ARGS_((void));
+ void (*init) (void);
+ void (*fini) (void);
};
-VOID *dlopen _ANSI_ARGS_((const char *path, int mode));
-VOID *dlsym _ANSI_ARGS_((void *handle, const char *symbol));
-char *dlerror _ANSI_ARGS_((void));
-int dlclose _ANSI_ARGS_((void *handle));
+void *dlopen (const char *path, int mode);
+void *dlsym (void *handle, const char *symbol);
+char *dlerror (void);
+int dlclose (void *handle);
#ifdef __cplusplus
}
diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c
new file mode 100644
index 0000000..3b91041
--- /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) {
+ size_t 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
+fake_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((unsigned short)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 165b7d1..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.2 1998/09/14 18:39:44 stanton Exp $
*/
#include <stdio.h>
@@ -22,12 +20,12 @@
* somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
*/
-extern double strtod();
+extern double strtod(char *, char **);
double
-fixstrtod(string, endPtr)
- char *string;
- char **endPtr;
+fixstrtod(
+ char *string,
+ char **endPtr)
{
double d;
d = strtod(string, endPtr);
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 98758e6..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.3 2004/04/06 22:25:47 dgp Exp $
*/
#include "tclPort.h"
@@ -18,11 +16,12 @@
#undef timezone
int
-gettimeofday(tp, tz)
-struct timeval *tp;
-struct timezone *tz;
+gettimeofday(
+ struct timeval *tp,
+ struct timezone *tz)
{
struct timeb t;
+
ftime(&t);
tp->tv_sec = t.time;
tp->tv_usec = t. millitm * 1000;
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 68e18c5..c4e25a8 100644
--- a/compat/memcmp.c
+++ b/compat/memcmp.c
@@ -1,25 +1,21 @@
-/*
+/*
* memcmp.c --
*
* Source code for the "memcmp" library routine.
*
* 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: @(#) memcmp.c 1.2 98/01/19 10:48:58
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
/*
- * Here is the prototype just in case it is not included
- * in tclPort.h.
+ * Here is the prototype just in case it is not included in tclPort.h.
*/
-int memcmp _ANSI_ARGS_((CONST VOID *s1,
- CONST VOID *s2, size_t n));
+int memcmp(const void *s1, const void *s2, size_t n);
/*
*----------------------------------------------------------------------
@@ -29,11 +25,10 @@ int memcmp _ANSI_ARGS_((CONST VOID *s1,
* Compares two bytes sequences.
*
* Results:
- * compares its arguments, looking at the first n
- * bytes (each interpreted as an unsigned char), and returns
- * an integer less than, equal to, or greater than 0, accord-
- * ing as s1 is less than, equal to, or
- * greater than s2 when taken to be unsigned 8 bit numbers.
+ * Compares its arguments, looking at the first n bytes (each interpreted
+ * as an unsigned char), and returns an integer less than, equal to, or
+ * greater than 0, according as s1 is less than, equal to, or greater
+ * than s2 when taken to be unsigned 8 bit numbers.
*
* Side effects:
* None.
@@ -42,19 +37,28 @@ int memcmp _ANSI_ARGS_((CONST VOID *s1,
*/
int
-memcmp(s1, s2, n)
- CONST VOID *s1; /* First string. */
- CONST VOID *s2; /* Second string. */
- size_t n; /* Length to compare. */
+memcmp(
+ const void *s1, /* First string. */
+ const void *s2, /* Second string. */
+ size_t n) /* Length to compare. */
{
- unsigned char u1, u2;
+ const unsigned char *ptr1 = (const unsigned char *) s1;
+ const unsigned char *ptr2 = (const unsigned char *) s2;
+
+ for ( ; n-- ; ptr1++, ptr2++) {
+ unsigned char u1 = *ptr1, u2 = *ptr2;
- for ( ; n-- ; s1++, s2++) {
- u1 = * (unsigned char *) s1;
- u2 = * (unsigned char *) s2;
- if ( u1 != u2) {
+ if (u1 != u2) {
return (u1-u2);
}
}
return 0;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/compat/mkstemp.c b/compat/mkstemp.c
new file mode 100644
index 0000000..eaa0b66
--- /dev/null
+++ b/compat/mkstemp.c
@@ -0,0 +1,78 @@
+/*
+ * mkstemp.c --
+ *
+ * Source code for the "mkstemp" library routine.
+ *
+ * Copyright (c) 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.
+ */
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * mkstemp --
+ *
+ * Create an open temporary file from a template.
+ *
+ * Results:
+ * A file descriptor, or -1 (with errno set) in the case of an error.
+ *
+ * Side effects:
+ * The template is updated to contain the real filename.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+mkstemp(
+ char *template) /* Template for filename. */
+{
+ static const char alphanumerics[] =
+ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
+ register char *a, *b;
+ int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */
+
+ a = template + strlen(template);
+ while (a > template && *(a-1) == 'X') {
+ a--;
+ }
+
+ if (a == template) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ /*
+ * We'll only try up to 10 times; after that, we're suffering from enemy
+ * action and should let the caller know.
+ */
+
+ count = 10;
+ do {
+ /*
+ * Replace the X's in the original template with random alphanumeric
+ * digits.
+ */
+
+ for (b=a ; *b ; b++) {
+ float r = rand() / ((float) RAND_MAX);
+
+ *b = alphanumerics[(int)(r * alphanumericsLen)];
+ }
+
+ /*
+ * Template is now realized; try to open (with correct options).
+ */
+
+ fd = open(template, O_RDWR|O_CREAT|O_EXCL, 0600);
+ } while (fd == -1 && errno == EEXIST && --count > 0);
+
+ return fd;
+}
diff --git a/compat/opendir.c b/compat/opendir.c
index 0b97156..a18f96b 100644
--- a/compat/opendir.c
+++ b/compat/opendir.c
@@ -1,42 +1,42 @@
/*
* opendir.c --
*
- * 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.3 2004/04/06 22:25:48 dgp Exp $
+ * 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.
*/
#include "tclInt.h"
#undef DIRSIZ
#define DIRSIZ(dp) \
- ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
+ ((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
/*
* open a directory.
*/
+
DIR *
-opendir(name)
-char *name;
+opendir(
+ char *name)
{
- register DIR *dirp;
- register int fd;
- char *myname;
+ register DIR *dirp;
+ register int fd;
+ char *myname;
- myname = ((*name == '\0') ? "." : name);
- if ((fd = open(myname, 0, 0)) == -1)
- return NULL;
- if ((dirp = (DIR *)ckalloc(sizeof(DIR))) == NULL) {
- close (fd);
- return NULL;
- }
- dirp->dd_fd = fd;
- dirp->dd_loc = 0;
- return dirp;
+ myname = ((*name == '\0') ? "." : name);
+ if ((fd = open(myname, 0, 0)) == -1) {
+ return NULL;
+ }
+ dirp = (DIR *) ckalloc(sizeof(DIR));
+ if (dirp == NULL) {
+ /* unreachable? */
+ close(fd);
+ return NULL;
+ }
+ dirp->dd_fd = fd;
+ dirp->dd_loc = 0;
+ return dirp;
}
/*
@@ -45,63 +45,66 @@ char *name;
#ifndef pyr
#define ODIRSIZ 14
-struct olddirect {
- ino_t od_ino;
- char od_name[ODIRSIZ];
+struct olddirect {
+ ino_t od_ino;
+ char od_name[ODIRSIZ];
};
#else /* a Pyramid in the ATT universe */
#define ODIRSIZ 248
-struct olddirect {
- long od_ino;
- short od_fill1, od_fill2;
- char od_name[ODIRSIZ];
+struct olddirect {
+ long od_ino;
+ short od_fill1, od_fill2;
+ char od_name[ODIRSIZ];
};
#endif
/*
* get next entry in a directory.
*/
+
struct dirent *
-readdir(dirp)
-register DIR *dirp;
+readdir(
+ register DIR *dirp)
{
- register struct olddirect *dp;
- static struct dirent dir;
+ register struct olddirect *dp;
+ static struct dirent dir;
- for (;;) {
- if (dirp->dd_loc == 0) {
- dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf,
- DIRBLKSIZ);
- if (dirp->dd_size <= 0)
- return NULL;
- }
- if (dirp->dd_loc >= dirp->dd_size) {
- dirp->dd_loc = 0;
- continue;
- }
- dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
- dirp->dd_loc += sizeof(struct olddirect);
- if (dp->od_ino == 0)
- continue;
- dir.d_ino = dp->od_ino;
- strncpy(dir.d_name, dp->od_name, ODIRSIZ);
- dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
- dir.d_namlen = strlen(dir.d_name);
- dir.d_reclen = DIRSIZ(&dir);
- return (&dir);
+ for (;;) {
+ if (dirp->dd_loc == 0) {
+ dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
+ if (dirp->dd_size <= 0) {
+ return NULL;
+ }
+ }
+ if (dirp->dd_loc >= dirp->dd_size) {
+ dirp->dd_loc = 0;
+ continue;
}
+ dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
+ dirp->dd_loc += sizeof(struct olddirect);
+ if (dp->od_ino == 0) {
+ continue;
+ }
+ dir.d_ino = dp->od_ino;
+ strncpy(dir.d_name, dp->od_name, ODIRSIZ);
+ dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
+ dir.d_namlen = strlen(dir.d_name);
+ dir.d_reclen = DIRSIZ(&dir);
+ return &dir;
+ }
}
/*
* close a directory.
*/
+
void
-closedir(dirp)
-register DIR *dirp;
+closedir(
+ register DIR *dirp)
{
- close(dirp->dd_fd);
- dirp->dd_fd = -1;
- dirp->dd_loc = 0;
- ckfree((char *) dirp);
+ close(dirp->dd_fd);
+ dirp->dd_fd = -1;
+ dirp->dd_loc = 0;
+ ckfree((char *) dirp);
}
diff --git a/compat/stdlib.h b/compat/stdlib.h
index 6edeeae..0ad4c1d 100644
--- a/compat/stdlib.h
+++ b/compat/stdlib.h
@@ -1,45 +1,36 @@
/*
* stdlib.h --
*
- * Declares facilities exported by the "stdlib" portion of
- * the C library. This file isn't complete in the ANSI-C
- * sense; it only declares things that are needed by Tcl.
- * This file is needed even on many systems with their own
- * stdlib.h (e.g. SunOS) because not all stdlib.h files
- * declare all the procedures needed here (such as strtod).
+ * Declares facilities exported by the "stdlib" portion of the C library.
+ * This file isn't complete in the ANSI-C sense; it only declares things
+ * that are needed by Tcl. This file is needed even on many systems with
+ * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
+ * all the procedures needed here (such as strtod).
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994-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.
- *
- * RCS: @(#) $Id: stdlib.h,v 1.3 1999/04/16 00:46:30 stanton Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STDLIB
#define _STDLIB
-#include <tcl.h>
-
-extern void abort _ANSI_ARGS_((void));
-extern double atof _ANSI_ARGS_((CONST char *string));
-extern int atoi _ANSI_ARGS_((CONST char *string));
-extern long atol _ANSI_ARGS_((CONST char *string));
-extern char * calloc _ANSI_ARGS_((unsigned int numElements,
- unsigned int size));
-extern void exit _ANSI_ARGS_((int status));
-extern int free _ANSI_ARGS_((char *blockPtr));
-extern char * getenv _ANSI_ARGS_((CONST char *name));
-extern char * malloc _ANSI_ARGS_((unsigned int numBytes));
-extern void qsort _ANSI_ARGS_((VOID *base, int n, int size,
- int (*compar)(CONST VOID *element1, CONST VOID
- *element2)));
-extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
-extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
-extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
- int base));
-extern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
- char **endPtr, int base));
+extern void abort(void);
+extern double atof(const char *string);
+extern int atoi(const char *string);
+extern long atol(const char *string);
+extern char * calloc(unsigned int numElements, unsigned int size);
+extern void exit(int status);
+extern int free(char *blockPtr);
+extern char * getenv(const char *name);
+extern char * malloc(unsigned int numBytes);
+extern void qsort(void *base, int n, int size, int (*compar)(
+ const void *element1, const void *element2));
+extern char * realloc(char *ptr, unsigned int numBytes);
+extern double strtod(const char *string, char **endPtr);
+extern long strtol(const char *string, char **endPtr, int base);
+extern unsigned long strtoul(const char *string, char **endPtr, int base);
#endif /* _STDLIB */
diff --git a/compat/string.h b/compat/string.h
index 128b458..42be10c 100644
--- a/compat/string.h
+++ b/compat/string.h
@@ -6,68 +6,52 @@
* Copyright (c) 1991-1993 The Regents of the University of California.
* Copyright (c) 1994-1996 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: string.h,v 1.7 2005/05/10 18:33:53 kennykb Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STRING
#define _STRING
-#include <tcl.h>
-
/*
- * The following #include is needed to define size_t. (This used to
- * include sys/stdtypes.h but that doesn't exist on older versions
- * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully
- * it exists everywhere)
+ * The following #include is needed to define size_t. (This used to include
+ * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g.
+ * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere)
*/
#include <sys/types.h>
#ifdef __APPLE__
-extern VOID * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
+extern void * memchr(const void *s, int c, size_t n);
#else
-extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
+extern char * memchr(const void *s, int c, size_t n);
#endif
-extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2,
- size_t n));
-extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n));
+extern int memcmp(const void *s1, const void *s2, size_t n);
+extern char * memcpy(void *t, const void *f, size_t n);
#ifdef NO_MEMMOVE
-#define memmove(d, s, n) bcopy ((s), (d), (n))
+#define memmove(d,s,n) (bcopy((s), (d), (n)))
#else
-extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f,
- size_t n));
+extern char * memmove(void *t, const void *f, size_t n);
#endif
-extern char * memset _ANSI_ARGS_((VOID *s, int c, size_t n));
+extern char * memset(void *s, int c, size_t n);
-extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2));
-extern char * strcat _ANSI_ARGS_((char *dst, CONST char *src));
-extern char * strchr _ANSI_ARGS_((CONST char *string, int c));
-extern int strcmp _ANSI_ARGS_((CONST char *s1, CONST char *s2));
-extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
-extern size_t strcspn _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strdup _ANSI_ARGS_((CONST char *string));
-extern char * strerror _ANSI_ARGS_((int error));
-extern size_t strlen _ANSI_ARGS_((CONST char *string));
-extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
-extern char * strncat _ANSI_ARGS_((char *dst, CONST char *src,
- size_t numChars));
-extern int strncmp _ANSI_ARGS_((CONST char *s1, CONST char *s2,
- size_t nChars));
-extern char * strncpy _ANSI_ARGS_((char *dst, CONST char *src,
- size_t numChars));
-extern char * strpbrk _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
-extern size_t strspn _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strstr _ANSI_ARGS_((CONST char *string,
- CONST char *substring));
-extern char * strtok _ANSI_ARGS_((char *s, CONST char *delim));
+extern int strcasecmp(const char *s1, const char *s2);
+extern char * strcat(char *dst, const char *src);
+extern char * strchr(const char *string, int c);
+extern int strcmp(const char *s1, const char *s2);
+extern char * strcpy(char *dst, const char *src);
+extern size_t strcspn(const char *string, const char *chars);
+extern char * strdup(const char *string);
+extern char * strerror(int error);
+extern size_t strlen(const char *string);
+extern int strncasecmp(const char *s1, const char *s2, size_t n);
+extern char * strncat(char *dst, const char *src, size_t numChars);
+extern int strncmp(const char *s1, const char *s2, size_t nChars);
+extern char * strncpy(char *dst, const char *src, size_t numChars);
+extern char * strpbrk(const char *string, const char *chars);
+extern char * strrchr(const char *string, int c);
+extern size_t strspn(const char *string, const char *chars);
+extern char * strstr(const char *string, const char *substring);
+extern char * strtok(char *s, const char *delim);
#endif /* _STRING */
diff --git a/compat/strncasecmp.c b/compat/strncasecmp.c
index ca2bf91..299715d 100644
--- a/compat/strncasecmp.c
+++ b/compat/strncasecmp.c
@@ -6,21 +6,19 @@
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1995-1996 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: strncasecmp.c,v 1.2 1998/09/14 18:39:45 stanton Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
/*
- * This array is designed for mapping upper and lower case letter
- * together for a case independent comparison. The mappings are
- * based upon ASCII character sequences.
+ * This array is designed for mapping upper and lower case letter together for
+ * a case independent comparison. The mappings are based upon ASCII character
+ * sequences.
*/
-static unsigned char charmap[] = {
+static const unsigned char charmap[] = {
0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
@@ -56,14 +54,11 @@ static unsigned char charmap[] = {
};
/*
- * Here are the prototypes just in case they are not included
- * in tclPort.h.
+ * Here are the prototypes just in case they are not included in tclPort.h.
*/
-int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
-int strcasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2));
+int strncasecmp(const char *s1, const char *s2, size_t n);
+int strcasecmp(const char *s1, const char *s2);
/*
*----------------------------------------------------------------------
@@ -73,9 +68,8 @@ int strcasecmp _ANSI_ARGS_((CONST char *s1,
* Compares two strings, ignoring case differences.
*
* Results:
- * Compares two null-terminated strings s1 and s2, returning -1, 0,
- * or 1 if s1 is lexicographically less than, equal to, or greater
- * than s2.
+ * Compares two null-terminated strings s1 and s2, returning -1, 0, or 1
+ * if s1 is lexicographically less than, equal to, or greater than s2.
*
* Side effects:
* None.
@@ -84,9 +78,9 @@ int strcasecmp _ANSI_ARGS_((CONST char *s1,
*/
int
-strcasecmp(s1, s2)
- CONST char *s1; /* First string. */
- CONST char *s2; /* Second string. */
+strcasecmp(
+ const char *s1, /* First string. */
+ const char *s2) /* Second string. */
{
unsigned char u1, u2;
@@ -108,9 +102,9 @@ strcasecmp(s1, s2)
* Compares two strings, ignoring case differences.
*
* Results:
- * Compares up to length chars of s1 and s2, returning -1, 0, or 1
- * if s1 is lexicographically less than, equal to, or greater
- * than s2 over those characters.
+ * Compares up to length chars of s1 and s2, returning -1, 0, or 1 if s1
+ * is lexicographically less than, equal to, or greater than s2 over
+ * those characters.
*
* Side effects:
* None.
@@ -119,10 +113,10 @@ strcasecmp(s1, s2)
*/
int
-strncasecmp(s1, s2, length)
- CONST char *s1; /* First string. */
- CONST char *s2; /* Second string. */
- size_t length; /* Maximum number of characters to compare
+strncasecmp(
+ const char *s1, /* First string. */
+ const char *s2, /* Second string. */
+ size_t length) /* Maximum number of characters to compare
* (stop earlier if the end of either string
* is reached). */
{
diff --git a/compat/strstr.c b/compat/strstr.c
index 015d61b..6698c9f 100644
--- a/compat/strstr.c
+++ b/compat/strstr.c
@@ -6,10 +6,8 @@
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 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: strstr.c,v 1.6 2005/05/10 18:33:54 kennykb Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
@@ -25,12 +23,10 @@
* Locate the first instance of a substring in a string.
*
* Results:
- * If string contains substring, the return value is the
- * location of the first matching instance of substring
- * in string. If string doesn't contain substring, the
- * return value is 0. Matching is done on an exact
- * character-for-character basis with no wildcards or special
- * characters.
+ * If string contains substring, the return value is the location of the
+ * first matching instance of substring in string. If string doesn't
+ * contain substring, the return value is 0. Matching is done on an exact
+ * character-for-character basis with no wildcards or special characters.
*
* Side effects:
* None.
@@ -39,15 +35,16 @@
*/
char *
-strstr(string, substring)
- register char *string; /* String to search. */
- char *substring; /* Substring to try to find in string. */
+strstr(
+ register char *string, /* String to search. */
+ char *substring) /* Substring to try to find in string. */
{
register char *a, *b;
- /* First scan quickly through the two strings looking for a
- * single-character match. When it's found, then compare the
- * rest of the substring.
+ /*
+ * First scan quickly through the two strings looking for a
+ * single-character match. When it's found, then compare the rest of the
+ * substring.
*/
b = substring;
diff --git a/compat/strtod.c b/compat/strtod.c
index b75d72e..cb9f76d 100644
--- a/compat/strtod.c
+++ b/compat/strtod.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: strtod.c,v 1.7 2004/04/06 22:25:48 dgp Exp $
*/
#include "tclInt.h"
-#include <ctype.h>
#ifndef TRUE
#define TRUE 1
@@ -23,12 +20,12 @@
#define NULL 0
#endif
-static int maxExponent = 511; /* Largest possible base 10 exponent. Any
+static const int maxExponent = 511; /* Largest possible base 10 exponent. Any
* exponent larger than this will already
* produce underflow or overflow, so there's
* no need to worry about additional digits.
*/
-static double powersOf10[] = { /* Table giving binary powers of 10. Entry */
+static const double powersOf10[] = { /* Table giving binary powers of 10. Entry */
10., /* is 10^2^i. Used to convert decimal */
100., /* exponents into floating-point numbers. */
1.0e4,
@@ -62,41 +59,41 @@ static double powersOf10[] = { /* Table giving binary powers of 10. Entry */
*/
double
-strtod(string, endPtr)
- CONST char *string; /* A decimal ASCII floating-point number,
- * optionally preceded by white space.
- * Must have form "-I.FE-X", where I is the
- * integer part of the mantissa, F is the
- * fractional part of the mantissa, and X
- * is the exponent. Either of the signs
- * may be "+", "-", or omitted. Either I
- * or F may be omitted, or both. The decimal
- * point isn't necessary unless F is present.
- * The "E" may actually be an "e". E and X
- * may both be omitted (but not just one).
- */
- char **endPtr; /* If non-NULL, store terminating character's
+strtod(
+ const char *string, /* A decimal ASCII floating-point number,
+ * optionally preceded by white space. Must
+ * have form "-I.FE-X", where I is the integer
+ * part of the mantissa, F is the fractional
+ * part of the mantissa, and X is the
+ * exponent. Either of the signs may be "+",
+ * "-", or omitted. Either I or F may be
+ * omitted, or both. The decimal point isn't
+ * necessary unless F is present. The "E" may
+ * actually be an "e". E and X may both be
+ * omitted (but not just one). */
+ char **endPtr) /* If non-NULL, store terminating character's
* address here. */
{
int sign, expSign = FALSE;
- double fraction, dblExp, *d;
- register CONST char *p;
+ double fraction, dblExp;
+ const double *d;
+ register const char *p;
register int c;
int exp = 0; /* Exponent read from "EX" field. */
int fracExp = 0; /* Exponent that derives from the fractional
- * part. Under normal circumstatnces, it is
+ * part. Under normal circumstatnces, it is
* the negative of the number of digits in F.
* However, if I is very long, the last digits
* of I get dropped (otherwise a long I with a
* large negative exponent could cause an
- * unnecessary overflow on I alone). In this
+ * unnecessary overflow on I alone). In this
* case, fracExp is incremented one for each
* dropped digit. */
int mantSize; /* Number of digits in mantissa. */
int decPt; /* Number of mantissa digits BEFORE decimal
* point. */
- CONST char *pExp; /* Temporarily holds location of exponent
- * in string. */
+ const char *pExp; /* Temporarily holds location of exponent in
+ * string. */
/*
* Strip off leading blanks and check for a sign.
@@ -135,10 +132,10 @@ strtod(string, endPtr)
}
/*
- * Now suck up the digits in the mantissa. Use two integers to
- * collect 9 digits each (this is faster than using floating-point).
- * If the mantissa has more than 18 digits, ignore the extras, since
- * they can't affect the value anyway.
+ * Now suck up the digits in the mantissa. Use two integers to collect 9
+ * digits each (this is faster than using floating-point). If the mantissa
+ * has more than 18 digits, ignore the extras, since they can't affect the
+ * value anyway.
*/
pExp = p;
@@ -146,7 +143,7 @@ strtod(string, endPtr)
if (decPt < 0) {
decPt = mantSize;
} else {
- mantSize -= 1; /* One of the digits was the point. */
+ mantSize -= 1; /* One of the digits was the point. */
}
if (mantSize > 18) {
fracExp = decPt - 18;
@@ -160,9 +157,9 @@ strtod(string, endPtr)
goto done;
} else {
int frac1, frac2;
+
frac1 = 0;
- for ( ; mantSize > 9; mantSize -= 1)
- {
+ for ( ; mantSize > 9; mantSize -= 1) {
c = *p;
p += 1;
if (c == '.') {
@@ -172,8 +169,7 @@ strtod(string, endPtr)
frac1 = 10*frac1 + (c - '0');
}
frac2 = 0;
- for (; mantSize > 0; mantSize -= 1)
- {
+ for (; mantSize > 0; mantSize -= 1) {
c = *p;
p += 1;
if (c == '.') {
@@ -217,10 +213,9 @@ strtod(string, endPtr)
}
/*
- * Generate a floating-point number that represents the exponent.
- * Do this by processing the exponent one bit at a time to combine
- * many powers of 2 of 10. Then combine the exponent with the
- * fraction.
+ * Generate a floating-point number that represents the exponent. Do this
+ * by processing the exponent one bit at a time to combine many powers of
+ * 2 of 10. Then combine the exponent with the fraction.
*/
if (exp < 0) {
@@ -234,7 +229,7 @@ strtod(string, endPtr)
errno = ERANGE;
}
dblExp = 1.0;
- for (d = powersOf10; exp != 0; exp >>= 1, d += 1) {
+ for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
if (exp & 01) {
dblExp *= *d;
}
@@ -245,7 +240,7 @@ strtod(string, endPtr)
fraction *= dblExp;
}
-done:
+ done:
if (endPtr != NULL) {
*endPtr = (char *) p;
}
diff --git a/compat/strtol.c b/compat/strtol.c
index b91e7d0..b111d97 100644
--- a/compat/strtol.c
+++ b/compat/strtol.c
@@ -6,15 +6,11 @@
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 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: strtol.c,v 1.5 2004/04/06 22:25:48 dgp Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <ctype.h>
#include "tclInt.h"
-
/*
*----------------------------------------------------------------------
@@ -24,11 +20,10 @@
* Convert an ASCII string into an integer.
*
* Results:
- * The return value is the integer equivalent of string. If endPtr
- * is non-NULL, then *endPtr is filled in with the character
- * after the last one that was part of the integer. If string
- * doesn't contain a valid integer value, then zero is returned
- * and *endPtr is set to string.
+ * The return value is the integer equivalent of string. If endPtr is
+ * non-NULL, then *endPtr is filled in with the character after the last
+ * one that was part of the integer. If string doesn't contain a valid
+ * integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
@@ -37,22 +32,20 @@
*/
long int
-strtol(string, endPtr, base)
- CONST char *string; /* String of ASCII digits, possibly
- * preceded by white space. For bases
- * greater than 10, either lower- or
- * upper-case digits may be used.
- */
- char **endPtr; /* Where to store address of terminating
+strtol(
+ const char *string, /* String of ASCII digits, possibly preceded
+ * by white space. For bases greater than 10,
+ * either lower- or upper-case digits may be
+ * used. */
+ char **endPtr, /* Where to store address of terminating
* character, or NULL. */
- int base; /* Base for conversion. Must be less
- * than 37. If 0, then the base is chosen
- * from the leading characters of string:
- * "0x" means hex, "0" means octal, anything
- * else means decimal.
- */
+ int base) /* Base for conversion. Must be less than 37.
+ * If 0, then the base is chosen from the
+ * leading characters of string: "0x" means
+ * hex, "0" means octal, anything else means
+ * decimal. */
{
- register CONST char *p;
+ register const char *p;
long result;
/*
diff --git a/compat/strtoll.c b/compat/strtoll.c
deleted file mode 100644
index 50edd41..0000000
--- a/compat/strtoll.c
+++ /dev/null
@@ -1,110 +0,0 @@
-/*
- * strtoll.c --
- *
- * Source code for the "strtoll" library procedure.
- *
- * Copyright (c) 1988 The Regents of the University of California.
- * Copyright (c) 1994 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: strtoll.c,v 1.8 2005/05/10 18:33:54 kennykb Exp $
- */
-
-#include "tclInt.h"
-#include <ctype.h>
-
-#define TCL_WIDEINT_MAX (((Tcl_WideUInt)Tcl_LongAsWide(-1))>>1)
-
-
-/*
- *----------------------------------------------------------------------
- *
- * strtoll --
- *
- * Convert an ASCII string into an integer.
- *
- * Results:
- * The return value is the integer equivalent of string. If endPtr
- * is non-NULL, then *endPtr is filled in with the character
- * after the last one that was part of the integer. If string
- * doesn't contain a valid integer value, then zero is returned
- * and *endPtr is set to string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#if TCL_WIDE_INT_IS_LONG
-long long
-#else
-Tcl_WideInt
-#endif
-strtoll(string, endPtr, base)
- CONST char *string; /* String of ASCII digits, possibly
- * preceded by white space. For bases
- * greater than 10, either lower- or
- * upper-case digits may be used.
- */
- char **endPtr; /* Where to store address of terminating
- * character, or NULL. */
- int base; /* Base for conversion. Must be less
- * than 37. If 0, then the base is chosen
- * from the leading characters of string:
- * "0x" means hex, "0" means octal, anything
- * else means decimal.
- */
-{
- register CONST char *p;
- Tcl_WideInt result = Tcl_LongAsWide(0);
- Tcl_WideUInt uwResult;
-
- /*
- * Skip any leading blanks.
- */
-
- p = string;
- while (isspace(UCHAR(*p))) {
- p += 1;
- }
-
- /*
- * Check for a sign.
- */
-
- errno = 0;
- if (*p == '-') {
- p += 1;
- uwResult = strtoull(p, endPtr, base);
- if (errno != ERANGE) {
- if (uwResult > TCL_WIDEINT_MAX+1) {
- errno = ERANGE;
- return Tcl_LongAsWide(-1);
- } else if (uwResult > TCL_WIDEINT_MAX) {
- return ~((Tcl_WideInt)TCL_WIDEINT_MAX);
- } else {
- result = -((Tcl_WideInt) uwResult);
- }
- }
- } else {
- if (*p == '+') {
- p += 1;
- }
- uwResult = strtoull(p, endPtr, base);
- if (errno != ERANGE) {
- if (uwResult > TCL_WIDEINT_MAX) {
- errno = ERANGE;
- return Tcl_LongAsWide(-1);
- } else {
- result = uwResult;
- }
- }
- }
- if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
- *endPtr = (char *) string;
- }
- return result;
-}
diff --git a/compat/strtoul.c b/compat/strtoul.c
index 92637e1..d572c2b 100644
--- a/compat/strtoul.c
+++ b/compat/strtoul.c
@@ -6,21 +6,19 @@
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 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: strtoul.c,v 1.6 2004/04/06 22:25:48 dgp 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"
/*
- * The table below is used to convert from ASCII digits to a
- * numerical equivalent. It maps from '0' through 'z' to integers
- * (100 for non-digit characters).
+ * The table below is used to convert from ASCII digits to a numerical
+ * equivalent. It maps from '0' through 'z' to integers (100 for non-digit
+ * characters).
*/
-static char cvtIn[] = {
+static const char cvtIn[] = {
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
100, 100, 100, 100, 100, 100, 100, /* punctuation */
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
@@ -39,11 +37,10 @@ static char cvtIn[] = {
* Convert an ASCII string into an integer.
*
* Results:
- * The return value is the integer equivalent of string. If endPtr
- * is non-NULL, then *endPtr is filled in with the character
- * after the last one that was part of the integer. If string
- * doesn't contain a valid integer value, then zero is returned
- * and *endPtr is set to string.
+ * The return value is the integer equivalent of string. If endPtr is
+ * non-NULL, then *endPtr is filled in with the character after the last
+ * one that was part of the integer. If string doesn't contain a valid
+ * integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
@@ -52,22 +49,20 @@ static char cvtIn[] = {
*/
unsigned long int
-strtoul(string, endPtr, base)
- CONST char *string; /* String of ASCII digits, possibly
- * preceded by white space. For bases
- * greater than 10, either lower- or
- * upper-case digits may be used.
- */
- char **endPtr; /* Where to store address of terminating
+strtoul(
+ const char *string, /* String of ASCII digits, possibly preceded
+ * by white space. For bases greater than 10,
+ * either lower- or upper-case digits may be
+ * used. */
+ char **endPtr, /* Where to store address of terminating
* character, or NULL. */
- int base; /* Base for conversion. Must be less
- * than 37. If 0, then the base is chosen
- * from the leading characters of string:
- * "0x" means hex, "0" means octal, anything
- * else means decimal.
- */
+ int base) /* Base for conversion. Must be less than 37.
+ * If 0, then the base is chosen from the
+ * leading characters of string: "0x" means
+ * hex, "0" means octal, anything else means
+ * decimal. */
{
- register CONST char *p;
+ register const char *p;
register unsigned long int result = 0;
register unsigned digit;
int anyDigits = 0;
@@ -92,31 +87,29 @@ strtoul(string, endPtr, base)
}
/*
- * If no base was provided, pick one from the leading characters
- * of the string.
+ * If no base was provided, pick one from the leading characters of the
+ * string.
*/
- if (base == 0)
- {
+ if (base == 0) {
if (*p == '0') {
p += 1;
if ((*p == 'x') || (*p == 'X')) {
p += 1;
base = 16;
} else {
-
/*
- * Must set anyDigits here, otherwise "0" produces a
- * "no digits" error.
+ * Must set anyDigits here, otherwise "0" produces a "no
+ * digits" error.
*/
anyDigits = 1;
base = 8;
}
+ } else {
+ base = 10;
}
- else base = 10;
} else if (base == 16) {
-
/*
* Skip a leading "0x" from hex numbers.
*/
@@ -127,12 +120,13 @@ strtoul(string, endPtr, base)
}
/*
- * Sorry this code is so messy, but speed seems important. Do
- * different things for base 8, 10, 16, and other.
+ * Sorry this code is so messy, but speed seems important. Do different
+ * things for base 8, 10, 16, and other.
*/
if (base == 8) {
unsigned long maxres = ULONG_MAX >> 3;
+
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 7) {
@@ -146,6 +140,7 @@ strtoul(string, endPtr, base)
}
} else if (base == 10) {
unsigned long maxres = ULONG_MAX / 10;
+
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 9) {
@@ -159,6 +154,7 @@ strtoul(string, endPtr, base)
}
} else if (base == 16) {
unsigned long maxres = ULONG_MAX >> 4;
+
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
@@ -174,8 +170,9 @@ strtoul(string, endPtr, base)
result += digit;
anyDigits = 1;
}
- } else if ( base >= 2 && base <= 36 ) {
+ } else if (base >= 2 && base <= 36) {
unsigned long maxres = ULONG_MAX / base;
+
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
diff --git a/compat/strtoull.c b/compat/strtoull.c
deleted file mode 100644
index 027c593..0000000
--- a/compat/strtoull.c
+++ /dev/null
@@ -1,260 +0,0 @@
-/*
- * strtoull.c --
- *
- * Source code for the "strtoull" library procedure.
- *
- * Copyright (c) 1988 The Regents of the University of California.
- * Copyright (c) 1994 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: strtoull.c,v 1.8 2005/05/10 18:33:54 kennykb Exp $
- */
-
-#include "tclInt.h"
-#include <ctype.h>
-
-/*
- * The table below is used to convert from ASCII digits to a
- * numerical equivalent. It maps from '0' through 'z' to integers
- * (100 for non-digit characters).
- */
-
-static char cvtIn[] = {
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
- 100, 100, 100, 100, 100, 100, 100, /* punctuation */
- 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
- 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
- 30, 31, 32, 33, 34, 35,
- 100, 100, 100, 100, 100, 100, /* punctuation */
- 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */
- 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
- 30, 31, 32, 33, 34, 35};
-
-
-/*
- *----------------------------------------------------------------------
- *
- * strtoull --
- *
- * Convert an ASCII string into an integer.
- *
- * Results:
- * The return value is the integer equivalent of string. If endPtr
- * is non-NULL, then *endPtr is filled in with the character
- * after the last one that was part of the integer. If string
- * doesn't contain a valid integer value, then zero is returned
- * and *endPtr is set to string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#if TCL_WIDE_INT_IS_LONG
-unsigned long long
-#else
-Tcl_WideUInt
-#endif
-strtoull(string, endPtr, base)
- CONST char *string; /* String of ASCII digits, possibly
- * preceded by white space. For bases
- * greater than 10, either lower- or
- * upper-case digits may be used.
- */
- char **endPtr; /* Where to store address of terminating
- * character, or NULL. */
- int base; /* Base for conversion. Must be less
- * than 37. If 0, then the base is chosen
- * from the leading characters of string:
- * "0x" means hex, "0" means octal, anything
- * else means decimal.
- */
-{
- register CONST char *p;
- register Tcl_WideUInt result = 0;
- register unsigned digit;
- register Tcl_WideUInt shifted;
- int anyDigits = 0, negative = 0;
-
- /*
- * Skip any leading blanks.
- */
-
- p = string;
- while (isspace(UCHAR(*p))) { /* INTL: locale-dependent */
- p += 1;
- }
-
- /*
- * Check for a sign.
- */
-
- if (*p == '-') {
- p += 1;
- negative = 1;
- } else {
- if (*p == '+') {
- p += 1;
- }
- }
-
- /*
- * If no base was provided, pick one from the leading characters
- * of the string.
- */
-
- if (base == 0) {
- if (*p == '0') {
- p += 1;
- if (*p == 'x' || *p == 'X') {
- p += 1;
- base = 16;
- } else {
-
- /*
- * Must set anyDigits here, otherwise "0" produces a
- * "no digits" error.
- */
-
- anyDigits = 1;
- base = 8;
- }
- } else {
- base = 10;
- }
- } else if (base == 16) {
-
- /*
- * Skip a leading "0x" from hex numbers.
- */
-
- if ((p[0] == '0') && (p[1] == 'x' || *p == 'X')) {
- p += 2;
- }
- }
-
- /*
- * Sorry this code is so messy, but speed seems important. Do
- * different things for base 8, 10, 16, and other.
- */
-
- if (base == 8) {
- for ( ; ; p += 1) {
- digit = *p - '0';
- if (digit > 7) {
- break;
- }
- shifted = result << 3;
- if ((shifted >> 3) != result) {
- goto overflow;
- }
- result = shifted + digit;
- if ( result < shifted ) {
- goto overflow;
- }
- anyDigits = 1;
- }
- } else if (base == 10) {
- for ( ; ; p += 1) {
- digit = *p - '0';
- if (digit > 9) {
- break;
- }
- shifted = 10 * result;
- if ((shifted / 10) != result) {
- goto overflow;
- }
- result = shifted + digit;
- if ( result < shifted ) {
- goto overflow;
- }
- anyDigits = 1;
- }
- } else if (base == 16) {
- for ( ; ; p += 1) {
- digit = *p - '0';
- if (digit > ('z' - '0')) {
- break;
- }
- digit = cvtIn[digit];
- if (digit > 15) {
- break;
- }
- shifted = result << 4;
- if ((shifted >> 4) != result) {
- goto overflow;
- }
- result = shifted + digit;
- if ( result < shifted ) {
- goto overflow;
- }
- anyDigits = 1;
- }
- } else if ( base >= 2 && base <= 36 ) {
- for ( ; ; p += 1) {
- digit = *p - '0';
- if (digit > ('z' - '0')) {
- break;
- }
- digit = cvtIn[digit];
- if (digit >= (unsigned) base) {
- break;
- }
- shifted = result * base;
- if ((shifted/base) != result) {
- goto overflow;
- }
- result = shifted + digit;
- if ( result < shifted ) {
- goto overflow;
- }
- anyDigits = 1;
- }
- }
-
- /*
- * Negate if we found a '-' earlier.
- */
-
- if (negative) {
- result = (Tcl_WideUInt)(-((Tcl_WideInt)result));
- }
-
- /*
- * See if there were any digits at all.
- */
-
- if (!anyDigits) {
- p = string;
- }
-
- if (endPtr != 0) {
- *endPtr = (char *) p;
- }
-
- return result;
-
- /*
- * On overflow generate the right output
- */
-
- overflow:
- errno = ERANGE;
- if (endPtr != 0) {
- for ( ; ; p += 1) {
- digit = *p - '0';
- if (digit > ('z' - '0')) {
- break;
- }
- digit = cvtIn[digit];
- if (digit >= (unsigned) base) {
- break;
- }
- }
- *endPtr = (char *) p;
- }
- return (Tcl_WideUInt)Tcl_LongAsWide(-1);
-}
diff --git a/compat/tclErrno.h b/compat/tclErrno.h
deleted file mode 100644
index bcbc984..0000000
--- a/compat/tclErrno.h
+++ /dev/null
@@ -1,99 +0,0 @@
-/*
- * tclErrno.h --
- *
- * This header file contains the various POSIX errno definitions that
- * are used by Tcl. This file is derived from the spec POSIX 2.4 and
- * previous implementations for Berkeley UNIX.
- *
- * Copyright (c) 1982, 1986, 1989 Regents of the University of California.
- * Copyright (c) 1996 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: tclErrno.h,v 1.3 2002/06/07 08:50:22 dkf Exp $
- */
-
-extern int errno; /* global error number */
-
-#define EPERM 1 /* Operation not permitted */
-#define ENOENT 2 /* No such file or directory */
-#define ESRCH 3 /* No such process */
-#define EINTR 4 /* Interrupted system call */
-#define EIO 5 /* Input/output error */
-#define ENXIO 6 /* Device not configured */
-#define E2BIG 7 /* Argument list too long */
-#define ENOEXEC 8 /* Exec format error */
-#define EBADF 9 /* Bad file descriptor */
-#define ECHILD 10 /* No child processes */
-#define EDEADLK 11 /* Resource deadlock avoided */
- /* 11 was EAGAIN */
-#define ENOMEM 12 /* Cannot allocate memory */
-#define EACCES 13 /* Permission denied */
-#define EFAULT 14 /* Bad address */
-#define ENOTBLK 15 /* Block device required */
-#define EBUSY 16 /* Device busy */
-#define EEXIST 17 /* File exists */
-#define EXDEV 18 /* Cross-device link */
-#define ENODEV 19 /* Operation not supported by device */
-#define ENOTDIR 20 /* Not a directory */
-#define EISDIR 21 /* Is a directory */
-#define EINVAL 22 /* Invalid argument */
-#define ENFILE 23 /* Too many open files in system */
-#define EMFILE 24 /* Too many open files */
-#define ENOTTY 25 /* Inappropriate ioctl for device */
-#define ETXTBSY 26 /* Text file busy */
-#define EFBIG 27 /* File too large */
-#define ENOSPC 28 /* No space left on device */
-#define ESPIPE 29 /* Illegal seek */
-#define EROFS 30 /* Read-only file system */
-#define EMLINK 31 /* Too many links */
-#define EPIPE 32 /* Broken pipe */
-#define EDOM 33 /* Numerical argument out of domain */
-#define ERANGE 34 /* Result too large */
-#define EAGAIN 35 /* Resource temporarily unavailable */
-#define EWOULDBLOCK EAGAIN /* Operation would block */
-#define EINPROGRESS 36 /* Operation now in progress */
-#define EALREADY 37 /* Operation already in progress */
-#define ENOTSOCK 38 /* Socket operation on non-socket */
-#define EDESTADDRREQ 39 /* Destination address required */
-#define EMSGSIZE 40 /* Message too long */
-#define EPROTOTYPE 41 /* Protocol wrong type for socket */
-#define ENOPROTOOPT 42 /* Protocol not available */
-#define EPROTONOSUPPORT 43 /* Protocol not supported */
-#define ESOCKTNOSUPPORT 44 /* Socket type not supported */
-#define EOPNOTSUPP 45 /* Operation not supported on socket */
-#define EPFNOSUPPORT 46 /* Protocol family not supported */
-#define EAFNOSUPPORT 47 /* Address family not supported by protocol family */
-#define EADDRINUSE 48 /* Address already in use */
-#define EADDRNOTAVAIL 49 /* Can't assign requested address */
-#define ENETDOWN 50 /* Network is down */
-#define ENETUNREACH 51 /* Network is unreachable */
-#define ENETRESET 52 /* Network dropped connection on reset */
-#define ECONNABORTED 53 /* Software caused connection abort */
-#define ECONNRESET 54 /* Connection reset by peer */
-#define ENOBUFS 55 /* No buffer space available */
-#define EISCONN 56 /* Socket is already connected */
-#define ENOTCONN 57 /* Socket is not connected */
-#define ESHUTDOWN 58 /* Can't send after socket shutdown */
-#define ETOOMANYREFS 59 /* Too many references: can't splice */
-#define ETIMEDOUT 60 /* Connection timed out */
-#define ECONNREFUSED 61 /* Connection refused */
-#define ELOOP 62 /* Too many levels of symbolic links */
-#define ENAMETOOLONG 63 /* File name too long */
-#define EHOSTDOWN 64 /* Host is down */
-#define EHOSTUNREACH 65 /* No route to host */
-#define ENOTEMPTY 66 /* Directory not empty */
-#define EPROCLIM 67 /* Too many processes */
-#define EUSERS 68 /* Too many users */
-#define EDQUOT 69 /* Disc quota exceeded */
-#define ESTALE 70 /* Stale NFS file handle */
-#define EREMOTE 71 /* Too many levels of remote in path */
-#define EBADRPC 72 /* RPC struct is bad */
-#define ERPCMISMATCH 73 /* RPC version wrong */
-#define EPROGUNAVAIL 74 /* RPC prog. not avail */
-#define EPROGMISMATCH 75 /* Program version wrong */
-#define EPROCUNAVAIL 76 /* Bad procedure for program */
-#define ENOLCK 77 /* No locks available */
-#define ENOSYS 78 /* Function not implemented */
-#define EOVERFLOW 79 /* Value too large to be stored in data type */
diff --git a/compat/tmpnam.c b/compat/tmpnam.c
deleted file mode 100644
index 89bfc6a..0000000
--- a/compat/tmpnam.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * Copyright (c) 1988 Regents of the University of California.
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms are permitted
- * provided that this notice is preserved and that due credit is given
- * to the University of California at Berkeley. The name of the University
- * may not be used to endorse or promote products derived from this
- * software without specific written prior permission. This software
- * is provided ``as is'' without express or implied warranty.
- *
- * RCS: @(#) $Id: tmpnam.c,v 1.2 1998/09/14 18:39:45 stanton Exp $
- */
-
-#include <sys/param.h>
-#include <sys/stat.h>
-#include <sys/file.h>
-#include <stdio.h>
-
-/*
- * Use /tmp instead of /usr/tmp, because L_tmpname is only 14 chars
- * on some machines (like NeXT machines) and /usr/tmp will cause
- * buffer overflows.
- */
-
-#ifdef P_tmpdir
-# undef P_tmpdir
-#endif
-#define P_tmpdir "/tmp"
-
-char *
-tmpnam(s)
- char *s;
-{
- static char name[50];
- char *mktemp();
-
- if (!s)
- s = name;
- (void)sprintf(s, "%s/XXXXXX", P_tmpdir);
- return(mktemp(s));
-}
diff --git a/compat/unistd.h b/compat/unistd.h
index 0b791e0..2de5bd0 100644
--- a/compat/unistd.h
+++ b/compat/unistd.h
@@ -1,84 +1,76 @@
/*
* unistd.h --
*
- * Macros, CONSTants and prototypes for Posix conformance.
+ * Macros, constants and prototypes for Posix conformance.
*
- * Copyright 1989 Regents of the University of California
- * Permission to use, copy, modify, and distribute this
- * software and its documentation for any purpose and without
- * fee is hereby granted, provided that the above 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.2 1998/09/14 18:39:45 stanton Exp $
+ * Copyright 1989 Regents of the University of California Permission to use,
+ * copy, modify, and distribute this software and its documentation for any
+ * purpose and without fee is hereby granted, provided that the above
+ * 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.
*/
#ifndef _UNISTD
#define _UNISTD
#include <sys/types.h>
-#ifndef _TCL
-# include "tcl.h"
-#endif
#ifndef NULL
#define NULL 0
#endif
/*
- * Strict POSIX stuff goes here. Extensions go down below, in the
- * ifndef _POSIX_SOURCE section.
+ * Strict POSIX stuff goes here. Extensions go down below, in the ifndef
+ * _POSIX_SOURCE section.
*/
-extern void _exit _ANSI_ARGS_((int status));
-extern int access _ANSI_ARGS_((CONST char *path, int mode));
-extern int chdir _ANSI_ARGS_((CONST char *path));
-extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group));
-extern int close _ANSI_ARGS_((int fd));
-extern int dup _ANSI_ARGS_((int oldfd));
-extern int dup2 _ANSI_ARGS_((int oldfd, int newfd));
-extern int execl _ANSI_ARGS_((CONST char *path, ...));
-extern int execle _ANSI_ARGS_((CONST char *path, ...));
-extern int execlp _ANSI_ARGS_((CONST char *file, ...));
-extern int execv _ANSI_ARGS_((CONST char *path, char **argv));
-extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp));
-extern int execvp _ANSI_ARGS_((CONST char *file, char **argv));
-extern pid_t fork _ANSI_ARGS_((void));
-extern char *getcwd _ANSI_ARGS_((char *buf, size_t size));
-extern gid_t getegid _ANSI_ARGS_((void));
-extern uid_t geteuid _ANSI_ARGS_((void));
-extern gid_t getgid _ANSI_ARGS_((void));
-extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer));
-extern pid_t getpid _ANSI_ARGS_((void));
-extern uid_t getuid _ANSI_ARGS_((void));
-extern int isatty _ANSI_ARGS_((int fd));
-extern long lseek _ANSI_ARGS_((int fd, long offset, int whence));
-extern int pipe _ANSI_ARGS_((int *fildes));
-extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
-extern int setgid _ANSI_ARGS_((gid_t group));
-extern int setuid _ANSI_ARGS_((uid_t user));
-extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds));
-extern char *ttyname _ANSI_ARGS_((int fd));
-extern int unlink _ANSI_ARGS_((CONST char *path));
-extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size));
+extern void _exit(int status);
+extern int access(const char *path, int mode);
+extern int chdir(const char *path);
+extern int chown(const char *path, uid_t owner, gid_t group);
+extern int close(int fd);
+extern int dup(int oldfd);
+extern int dup2(int oldfd, int newfd);
+extern int execl(const char *path, ...);
+extern int execle(const char *path, ...);
+extern int execlp(const char *file, ...);
+extern int execv(const char *path, char **argv);
+extern int execve(const char *path, char **argv, char **envp);
+extern int execvpw(const char *file, char **argv);
+extern pid_t fork(void);
+extern char * getcwd(char *buf, size_t size);
+extern gid_t getegid(void);
+extern uid_t geteuid(void);
+extern gid_t getgid(void);
+extern int getgroups(int bufSize, int *buffer);
+extern pid_t getpid(void);
+extern uid_t getuid(void);
+extern int isatty(int fd);
+extern long lseek(int fd, long offset, int whence);
+extern int pipe(int *fildes);
+extern int read(int fd, char *buf, size_t size);
+extern int setgid(gid_t group);
+extern int setuid(uid_t user);
+extern unsigned sleep(unsigned seconds);
+extern char * ttyname(int fd);
+extern int unlink(const char *path);
+extern int write(int fd, const char *buf, size_t size);
#ifndef _POSIX_SOURCE
-extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *));
-extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group));
-extern int flock _ANSI_ARGS_((int fd, int operation));
-extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length));
-extern int ioctl _ANSI_ARGS_((int fd, int request, ...));
-extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize));
-extern int setegid _ANSI_ARGS_((gid_t group));
-extern int seteuid _ANSI_ARGS_((uid_t user));
-extern int setreuid _ANSI_ARGS_((int ruid, int euid));
-extern int symlink _ANSI_ARGS_((CONST char *, CONST char *));
-extern int ttyslot _ANSI_ARGS_((void));
-extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
-extern int vfork _ANSI_ARGS_((void));
+extern char * crypt(const char *, const char *);
+extern int fchown(int fd, uid_t owner, gid_t group);
+extern int flock(int fd, int operation);
+extern int ftruncate(int fd, unsigned long length);
+extern int ioctl(int fd, int request, ...);
+extern int readlink(const char *path, char *buf, int bufsize);
+extern int setegid(gid_t group);
+extern int seteuidw(uid_t user);
+extern int setreuid(int ruid, int euid);
+extern int symlink(const char *, const char *);
+extern int ttyslot(void);
+extern int truncate(const char *path, unsigned long length);
+extern int vfork(void);
#endif /* _POSIX_SOURCE */
#endif /* _UNISTD */
-
diff --git a/compat/waitpid.c b/compat/waitpid.c
index 365d51e..8f65799 100644
--- a/compat/waitpid.c
+++ b/compat/waitpid.c
@@ -1,18 +1,15 @@
/*
* waitpid.c --
*
- * This procedure emulates the POSIX waitpid kernel call on
- * BSD systems that don't have waitpid but do have wait3.
- * This code is based on a prototype version written by
- * Mark Diekhans and Karl Lehenbauer.
+ * This procedure emulates the POSIX waitpid kernel call on BSD systems
+ * that don't have waitpid but do have wait3. This code is based on a
+ * prototype version written by Mark Diekhans and Karl Lehenbauer.
*
* Copyright (c) 1993 The Regents of the University of California.
* Copyright (c) 1994 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: waitpid.c,v 1.4 2004/04/06 22:25:48 dgp Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
@@ -22,40 +19,37 @@
#endif
/*
- * A linked list of the following structures is used to keep track
- * of processes for which we received notification from the kernel,
- * but the application hasn't waited for them yet (this can happen
- * because wait may not return the process we really want). We
- * save the information here until the application finally does
- * wait for the process.
+ * A linked list of the following structures is used to keep track of
+ * processes for which we received notification from the kernel, but the
+ * application hasn't waited for them yet (this can happen because wait may
+ * not return the process we really want). We save the information here until
+ * the application finally does wait for the process.
*/
typedef struct WaitInfo {
- pid_t pid; /* Pid of process that exited. */
- WAIT_STATUS_TYPE status; /* Status returned when child exited
- * or suspended. */
- struct WaitInfo *nextPtr; /* Next in list of exited processes. */
+ pid_t pid; /* Pid of process that exited. */
+ WAIT_STATUS_TYPE status; /* Status returned when child exited or
+ * suspended. */
+ struct WaitInfo *nextPtr; /* Next in list of exited processes. */
} WaitInfo;
-static WaitInfo *deadList = NULL; /* First in list of all dead
- * processes. */
+static WaitInfo *deadList = NULL;
+ /* First in list of all dead processes. */
/*
*----------------------------------------------------------------------
*
* waitpid --
*
- * This procedure emulates the functionality of the POSIX
- * waitpid kernel call, using the BSD wait3 kernel call.
- * Note: it doesn't emulate absolutely all of the waitpid
- * functionality, in that it doesn't support pid's of 0
- * or < -1.
+ * This procedure emulates the functionality of the POSIX waitpid kernel
+ * call, using the BSD wait3 kernel call. Note: it doesn't emulate
+ * absolutely all of the waitpid functionality, in that it doesn't
+ * support pid's of 0 or < -1.
*
* Results:
- * -1 is returned if there is an error in the wait kernel call.
- * Otherwise the pid of an exited or suspended process is
- * returned and *statusPtr is set to the status value of the
- * process.
+ * -1 is returned if there is an error in the wait kernel call. Otherwise
+ * the pid of an exited or suspended process is returned and *statusPtr
+ * is set to the status value of the process.
*
* Side effects:
* None.
@@ -68,12 +62,12 @@ static WaitInfo *deadList = NULL; /* First in list of all dead
#endif
pid_t
-waitpid(pid, statusPtr, options)
- pid_t pid; /* The pid to wait on. Must be -1 or
- * greater than zero. */
- int *statusPtr; /* Where to store wait status for the
+waitpid(
+ pid_t pid, /* The pid to wait on. Must be -1 or greater
+ * than zero. */
+ int *statusPtr, /* Where to store wait status for the
* process. */
- int options; /* OR'ed combination of WNOHANG and
+ int options) /* OR'ed combination of WNOHANG and
* WUNTRACED. */
{
register WaitInfo *waitPtr, *prevPtr;
@@ -86,9 +80,9 @@ waitpid(pid, statusPtr, options)
}
/*
- * See if there's a suitable process that has already stopped or
- * exited. If so, remove it from the list of exited processes and
- * return its information.
+ * See if there's a suitable process that has already stopped or exited.
+ * If so, remove it from the list of exited processes and return its
+ * information.
*/
for (waitPtr = deadList, prevPtr = NULL; waitPtr != NULL;
@@ -111,12 +105,12 @@ waitpid(pid, statusPtr, options)
}
/*
- * Wait for any process to stop or exit. If it's an acceptable one
- * then return it to the caller; otherwise store information about it
- * in the list of exited processes and try again. On systems that
- * have only wait but not wait3, there are several situations we can't
- * handle, but we do the best we can (e.g. can still handle some
- * combinations of options by invoking wait instead of wait3).
+ * Wait for any process to stop or exit. If it's an acceptable one then
+ * return it to the caller; otherwise store information about it in the
+ * list of exited processes and try again. On systems that have only wait
+ * but not wait3, there are several situations we can't handle, but we do
+ * the best we can (e.g. can still handle some combinations of options by
+ * invoking wait instead of wait3).
*/
while (1) {
@@ -149,13 +143,13 @@ waitpid(pid, statusPtr, options)
return result;
/*
- * Can't return this info to caller. Save it in the list of
- * stopped or exited processes. Tricky point: first check for
- * an existing entry for the process and overwrite it if it
- * exists (e.g. a previously stopped process might now be dead).
+ * Can't return this info to caller. Save it in the list of stopped or
+ * exited processes. Tricky point: first check for an existing entry
+ * for the process and overwrite it if it exists (e.g. a previously
+ * stopped process might now be dead).
*/
- saveInfo:
+ saveInfo:
for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
if (waitPtr->pid == result) {
waitPtr->status = status;
@@ -168,6 +162,7 @@ waitpid(pid, statusPtr, options)
waitPtr->nextPtr = deadList;
deadList = waitPtr;
- waitAgain: continue;
+ waitAgain:
+ continue;
}
}
diff --git a/compat/zlib/CMakeLists.txt b/compat/zlib/CMakeLists.txt
new file mode 100644
index 0000000..0c0247c
--- /dev/null
+++ b/compat/zlib/CMakeLists.txt
@@ -0,0 +1,249 @@
+cmake_minimum_required(VERSION 2.4.4)
+set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON)
+
+project(zlib C)
+
+set(VERSION "1.2.8")
+
+option(ASM686 "Enable building i686 assembly implementation")
+option(AMD64 "Enable building amd64 assembly implementation")
+
+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)
+include(CheckIncludeFile)
+include(CheckCSourceCompiles)
+enable_testing()
+
+check_include_file(sys/types.h HAVE_SYS_TYPES_H)
+check_include_file(stdint.h HAVE_STDINT_H)
+check_include_file(stddef.h HAVE_STDDEF_H)
+
+#
+# Check to see if we have large file support
+#
+set(CMAKE_REQUIRED_DEFINITIONS -D_LARGEFILE64_SOURCE=1)
+# We add these other definitions here because CheckTypeSize.cmake
+# in CMake 2.4.x does not automatically do so and we want
+# compatibility with CMake 2.4.x.
+if(HAVE_SYS_TYPES_H)
+ list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_SYS_TYPES_H)
+endif()
+if(HAVE_STDINT_H)
+ list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_STDINT_H)
+endif()
+if(HAVE_STDDEF_H)
+ list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_STDDEF_H)
+endif()
+check_type_size(off64_t OFF64_T)
+if(HAVE_OFF64_T)
+ add_definitions(-D_LARGEFILE64_SOURCE=1)
+endif()
+set(CMAKE_REQUIRED_DEFINITIONS) # clear variable
+
+#
+# Check for fseeko
+#
+check_function_exists(fseeko HAVE_FSEEKO)
+if(NOT HAVE_FSEEKO)
+ add_definitions(-DNO_FSEEKO)
+endif()
+
+#
+# Check for unistd.h
+#
+check_include_file(unistd.h Z_HAVE_UNISTD_H)
+
+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(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()
+
+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})
+
+
+#============================================================================
+# zlib
+#============================================================================
+
+set(ZLIB_PUBLIC_HDRS
+ ${CMAKE_CURRENT_BINARY_DIR}/zconf.h
+ zlib.h
+)
+set(ZLIB_PRIVATE_HDRS
+ crc32.h
+ deflate.h
+ gzguts.h
+ inffast.h
+ inffixed.h
+ inflate.h
+ inftrees.h
+ trees.h
+ zutil.h
+)
+set(ZLIB_SRCS
+ adler32.c
+ compress.c
+ crc32.c
+ deflate.c
+ gzclose.c
+ gzlib.c
+ gzread.c
+ gzwrite.c
+ inflate.c
+ infback.c
+ inftrees.c
+ inffast.c
+ trees.c
+ uncompr.c
+ zutil.c
+)
+
+if(NOT MINGW)
+ set(ZLIB_DLL_SRCS
+ win32/zlib1.rc # If present will override custom build rule below.
+ )
+endif()
+
+if(CMAKE_COMPILER_IS_GNUCC)
+ if(ASM686)
+ set(ZLIB_ASMS contrib/asm686/match.S)
+ elseif (AMD64)
+ set(ZLIB_ASMS contrib/amd64/amd64-match.S)
+ endif ()
+
+ if(ZLIB_ASMS)
+ add_definitions(-DASMV)
+ set_source_files_properties(${ZLIB_ASMS} PROPERTIES LANGUAGE C COMPILE_FLAGS -DNO_UNDERLINE)
+ endif()
+endif()
+
+if(MSVC)
+ if(ASM686)
+ ENABLE_LANGUAGE(ASM_MASM)
+ set(ZLIB_ASMS
+ contrib/masmx86/inffas32.asm
+ contrib/masmx86/match686.asm
+ )
+ elseif (AMD64)
+ ENABLE_LANGUAGE(ASM_MASM)
+ set(ZLIB_ASMS
+ contrib/masmx64/gvmat64.asm
+ contrib/masmx64/inffasx64.asm
+ )
+ endif()
+
+ if(ZLIB_ASMS)
+ add_definitions(-DASMV -DASMINF)
+ endif()
+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.]+)\".*"
+ "\\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 ${CMAKE_RC_COMPILER}
+ -D GCC_WINDRES
+ -I ${CMAKE_CURRENT_SOURCE_DIR}
+ -I ${CMAKE_CURRENT_BINARY_DIR}
+ -o ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj
+ -i ${CMAKE_CURRENT_SOURCE_DIR}/win32/zlib1.rc)
+ set(ZLIB_DLL_SRCS ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj)
+endif(MINGW)
+
+add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_ASMS} ${ZLIB_DLL_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
+add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_ASMS} ${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)
+ # This property causes shared libraries on Linux to have the full version
+ # encoded into their final filename. We disable this on Cygwin because
+ # it causes cygz-${ZLIB_FULL_VERSION}.dll to be created when cygz.dll
+ # seems to be the default.
+ #
+ # This has no effect with MSVC, on that platform the version info for
+ # the DLL comes from the resource file win32/zlib1.rc
+ set_target_properties(zlib PROPERTIES VERSION ${ZLIB_FULL_VERSION})
+endif()
+
+if(UNIX)
+ # On unix-like platforms the library is almost always called libz
+ set_target_properties(zlib zlibstatic PROPERTIES OUTPUT_NAME z)
+ if(NOT APPLE)
+ set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,\"${CMAKE_CURRENT_SOURCE_DIR}/zlib.map\"")
+ endif()
+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 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 "${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_PC} DESTINATION "${INSTALL_PKGCONFIG_DIR}")
+endif()
+
+#============================================================================
+# Example binaries
+#============================================================================
+
+add_executable(example test/example.c)
+target_link_libraries(example zlib)
+add_test(example example)
+
+add_executable(minigzip test/minigzip.c)
+target_link_libraries(minigzip zlib)
+
+if(HAVE_OFF64_T)
+ 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 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
new file mode 100644
index 0000000..f22aaba
--- /dev/null
+++ b/compat/zlib/ChangeLog
@@ -0,0 +1,1472 @@
+
+ ChangeLog file for zlib
+
+Changes in 1.2.8 (28 Apr 2013)
+- Update contrib/minizip/iowin32.c for Windows RT [Vollant]
+- Do not force Z_CONST for C++
+- Clean up contrib/vstudio [Ro§]
+- Correct spelling error in zlib.h
+- Fix mixed line endings in contrib/vstudio
+
+Changes in 1.2.7.3 (13 Apr 2013)
+- Fix version numbers and DLL names in contrib/vstudio/*/zlib.rc
+
+Changes in 1.2.7.2 (13 Apr 2013)
+- Change check for a four-byte type back to hexadecimal
+- Fix typo in win32/Makefile.msc
+- Add casts in gzwrite.c for pointer differences
+
+Changes in 1.2.7.1 (24 Mar 2013)
+- Replace use of unsafe string functions with snprintf if available
+- Avoid including stddef.h on Windows for Z_SOLO compile [Niessink]
+- Fix gzgetc undefine when Z_PREFIX set [Turk]
+- Eliminate use of mktemp in Makefile (not always available)
+- Fix bug in 'F' mode for gzopen()
+- Add inflateGetDictionary() function
+- Correct comment in deflate.h
+- Use _snprintf for snprintf in Microsoft C
+- On Darwin, only use /usr/bin/libtool if libtool is not Apple
+- Delete "--version" file if created by "ar --version" [Richard G.]
+- Fix configure check for veracity of compiler error return codes
+- Fix CMake compilation of static lib for MSVC2010 x64
+- Remove unused variable in infback9.c
+- Fix argument checks in gzlog_compress() and gzlog_write()
+- Clean up the usage of z_const and respect const usage within zlib
+- Clean up examples/gzlog.[ch] comparisons of different types
+- Avoid shift equal to bits in type (caused endless loop)
+- Fix unintialized value bug in gzputc() introduced by const patches
+- Fix memory allocation error in examples/zran.c [Nor]
+- Fix bug where gzopen(), gzclose() would write an empty file
+- Fix bug in gzclose() when gzwrite() runs out of memory
+- Check for input buffer malloc failure in examples/gzappend.c
+- Add note to contrib/blast to use binary mode in stdio
+- Fix comparisons of differently signed integers in contrib/blast
+- Check for invalid code length codes in contrib/puff
+- Fix serious but very rare decompression bug in inftrees.c
+- Update inflateBack() comments, since inflate() can be faster
+- Use underscored I/O function names for WINAPI_FAMILY
+- Add _tr_flush_bits to the external symbols prefixed by --zprefix
+- Add contrib/vstudio/vc10 pre-build step for static only
+- Quote --version-script argument in CMakeLists.txt
+- Don't specify --version-script on Apple platforms in CMakeLists.txt
+- Fix casting error in contrib/testzlib/testzlib.c
+- Fix types in contrib/minizip to match result of get_crc_table()
+- Simplify contrib/vstudio/vc10 with 'd' suffix
+- Add TOP support to win32/Makefile.msc
+- Suport i686 and amd64 assembler builds in CMakeLists.txt
+- Fix typos in the use of _LARGEFILE64_SOURCE in zconf.h
+- Add vc11 and vc12 build files to contrib/vstudio
+- Add gzvprintf() as an undocumented function in zlib
+- Fix configure for Sun shell
+- Remove runtime check in configure for four-byte integer type
+- Add casts and consts to ease user conversion to C++
+- Add man pages for minizip and miniunzip
+- In Makefile uninstall, don't rm if preceding cd fails
+- Do not return Z_BUF_ERROR if deflateParam() has nothing to write
+
+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]
+- Set LDFLAGS in Makefile.in [Bar-Lev]
+- Avoid mkdir objs race condition in Makefile.in [Bowler]
+- Add ZLIB_INTERNAL in front of internal inter-module functions and arrays
+- Define ZLIB_INTERNAL to hide internal functions and arrays for GNU C
+- Don't use hidden attribute when it is a warning generator (e.g. Solaris)
+
+Changes in 1.2.4.4 (18 Apr 2010)
+- Fix CROSS_PREFIX executable testing, CHOST extract, mingw* [Torok]
+- Undefine _LARGEFILE64_SOURCE in zconf.h if it is zero, but not if empty
+- Try to use bash or ksh regardless of functionality of /bin/sh
+- Fix configure incompatibility with NetBSD sh
+- Remove attempt to run under bash or ksh since have better NetBSD fix
+- Fix win32/Makefile.gcc for MinGW [Bar-Lev]
+- Add diagnostic messages when using CROSS_PREFIX in configure
+- Added --sharedlibdir option to configure [Weigelt]
+- Use hidden visibility attribute when available [Frysinger]
+
+Changes in 1.2.4.3 (10 Apr 2010)
+- Only use CROSS_PREFIX in configure for ar and ranlib if they exist
+- Use CROSS_PREFIX for nm [Bar-Lev]
+- Assume _LARGEFILE64_SOURCE defined is equivalent to true
+- Avoid use of undefined symbols in #if with && and ||
+- Make *64 prototypes in gzguts.h consistent with functions
+- Add -shared load option for MinGW in configure [Bowler]
+- Move z_off64_t to public interface, use instead of off64_t
+- Remove ! from shell test in configure (not portable to Solaris)
+- Change +0 macro tests to -0 for possibly increased portability
+
+Changes in 1.2.4.2 (9 Apr 2010)
+- Add consistent carriage returns to readme.txt's in masmx86 and masmx64
+- Really provide prototypes for *64 functions when building without LFS
+- Only define unlink() in minigzip.c if unistd.h not included
+- Update README to point to contrib/vstudio project files
+- Move projects/vc6 to old/ and remove projects/
+- Include stdlib.h in minigzip.c for setmode() definition under WinCE
+- Clean up assembler builds in win32/Makefile.msc [Rowe]
+- Include sys/types.h for Microsoft for off_t definition
+- Fix memory leak on error in gz_open()
+- Symbolize nm as $NM in configure [Weigelt]
+- Use TEST_LDSHARED instead of LDSHARED to link test programs [Weigelt]
+- Add +0 to _FILE_OFFSET_BITS and _LFS64_LARGEFILE in case not defined
+- Fix bug in gzeof() to take into account unused input data
+- Avoid initialization of structures with variables in puff.c
+- Updated win32/README-WIN32.txt [Rowe]
+
+Changes in 1.2.4.1 (28 Mar 2010)
+- Remove the use of [a-z] constructs for sed in configure [gentoo 310225]
+- Remove $(SHAREDLIB) from LIBS in Makefile.in [Creech]
+- Restore "for debugging" comment on sprintf() in gzlib.c
+- Remove fdopen for MVS from gzguts.h
+- Put new README-WIN32.txt in win32 [Rowe]
+- Add check for shell to configure and invoke another shell if needed
+- Fix big fat stinking bug in gzseek() on uncompressed files
+- Remove vestigial F_OPEN64 define in zutil.h
+- Set and check the value of _LARGEFILE_SOURCE and _LARGEFILE64_SOURCE
+- Avoid errors on non-LFS systems when applications define LFS macros
+- Set EXE to ".exe" in configure for MINGW [Kahle]
+- Match crc32() in crc32.c exactly to the prototype in zlib.h [Sherrill]
+- Add prefix for cross-compilation in win32/makefile.gcc [Bar-Lev]
+- Add DLL install in win32/makefile.gcc [Bar-Lev]
+- Allow Linux* or linux* from uname in configure [Bar-Lev]
+- Allow ldconfig to be redefined in configure and Makefile.in [Bar-Lev]
+- Add cross-compilation prefixes to configure [Bar-Lev]
+- Match type exactly in gz_load() invocation in gzread.c
+- Match type exactly of zcalloc() in zutil.c to zlib.h alloc_func
+- Provide prototypes for *64 functions when building zlib without LFS
+- Don't use -lc when linking shared library on MinGW
+- Remove errno.h check in configure and vestigial errno code in zutil.h
+
+Changes in 1.2.4 (14 Mar 2010)
+- Fix VER3 extraction in configure for no fourth subversion
+- Update zlib.3, add docs to Makefile.in to make .pdf out of it
+- Add zlib.3.pdf to distribution
+- Don't set error code in gzerror() if passed pointer is NULL
+- Apply destination directory fixes to CMakeLists.txt [Lowman]
+- Move #cmakedefine's to a new zconf.in.cmakein
+- Restore zconf.h for builds that don't use configure or cmake
+- Add distclean to dummy Makefile for convenience
+- Update and improve INDEX, README, and FAQ
+- Update CMakeLists.txt for the return of zconf.h [Lowman]
+- Update contrib/vstudio/vc9 and vc10 [Vollant]
+- Change libz.dll.a back to libzdll.a in win32/Makefile.gcc
+- Apply license and readme changes to contrib/asm686 [Raiter]
+- Check file name lengths and add -c option in minigzip.c [Li]
+- Update contrib/amd64 and contrib/masmx86/ [Vollant]
+- Avoid use of "eof" parameter in trees.c to not shadow library variable
+- Update make_vms.com for removal of zlibdefs.h [Zinser]
+- Update assembler code and vstudio projects in contrib [Vollant]
+- Remove outdated assembler code contrib/masm686 and contrib/asm586
+- Remove old vc7 and vc8 from contrib/vstudio
+- Update win32/Makefile.msc, add ZLIB_VER_SUBREVISION [Rowe]
+- Fix memory leaks in gzclose_r() and gzclose_w(), file leak in gz_open()
+- Add contrib/gcc_gvmat64 for longest_match and inflate_fast [Vollant]
+- Remove *64 functions from win32/zlib.def (they're not 64-bit yet)
+- Fix bug in void-returning vsprintf() case in gzwrite.c
+- Fix name change from inflate.h in contrib/inflate86/inffas86.c
+- Check if temporary file exists before removing in make_vms.com [Zinser]
+- Fix make install and uninstall for --static option
+- Fix usage of _MSC_VER in gzguts.h and zutil.h [Truta]
+- Update readme.txt in contrib/masmx64 and masmx86 to assemble
+
+Changes in 1.2.3.9 (21 Feb 2010)
+- Expunge gzio.c
+- Move as400 build information to old
+- Fix updates in contrib/minizip and contrib/vstudio
+- Add const to vsnprintf test in configure to avoid warnings [Weigelt]
+- Delete zconf.h (made by configure) [Weigelt]
+- Change zconf.in.h to zconf.h.in per convention [Weigelt]
+- Check for NULL buf in gzgets()
+- Return empty string for gzgets() with len == 1 (like fgets())
+- Fix description of gzgets() in zlib.h for end-of-file, NULL return
+- Update minizip to 1.1 [Vollant]
+- Avoid MSVC loss of data warnings in gzread.c, gzwrite.c
+- Note in zlib.h that gzerror() should be used to distinguish from EOF
+- Remove use of snprintf() from gzlib.c
+- Fix bug in gzseek()
+- Update contrib/vstudio, adding vc9 and vc10 [Kuno, Vollant]
+- Fix zconf.h generation in CMakeLists.txt [Lowman]
+- Improve comments in zconf.h where modified by configure
+
+Changes in 1.2.3.8 (13 Feb 2010)
+- Clean up text files (tabs, trailing whitespace, etc.) [Oberhumer]
+- Use z_off64_t in gz_zero() and gz_skip() to match state->skip
+- Avoid comparison problem when sizeof(int) == sizeof(z_off64_t)
+- Revert to Makefile.in from 1.2.3.6 (live with the clutter)
+- Fix missing error return in gzflush(), add zlib.h note
+- Add *64 functions to zlib.map [Levin]
+- Fix signed/unsigned comparison in gz_comp()
+- Use SFLAGS when testing shared linking in configure
+- Add --64 option to ./configure to use -m64 with gcc
+- Fix ./configure --help to correctly name options
+- Have make fail if a test fails [Levin]
+- Avoid buffer overrun in contrib/masmx64/gvmat64.asm [Simpson]
+- Remove assembler object files from contrib
+
+Changes in 1.2.3.7 (24 Jan 2010)
+- Always gzopen() with O_LARGEFILE if available
+- Fix gzdirect() to work immediately after gzopen() or gzdopen()
+- Make gzdirect() more precise when the state changes while reading
+- Improve zlib.h documentation in many places
+- Catch memory allocation failure in gz_open()
+- Complete close operation if seek forward in gzclose_w() fails
+- Return Z_ERRNO from gzclose_r() if close() fails
+- Return Z_STREAM_ERROR instead of EOF for gzclose() being passed NULL
+- Return zero for gzwrite() errors to match zlib.h description
+- Return -1 on gzputs() error to match zlib.h description
+- Add zconf.in.h to allow recovery from configure modification [Weigelt]
+- Fix static library permissions in Makefile.in [Weigelt]
+- Avoid warnings in configure tests that hide functionality [Weigelt]
+- Add *BSD and DragonFly to Linux case in configure [gentoo 123571]
+- Change libzdll.a to libz.dll.a in win32/Makefile.gcc [gentoo 288212]
+- Avoid access of uninitialized data for first inflateReset2 call [Gomes]
+- Keep object files in subdirectories to reduce the clutter somewhat
+- Remove default Makefile and zlibdefs.h, add dummy Makefile
+- Add new external functions to Z_PREFIX, remove duplicates, z_z_ -> z_
+- Remove zlibdefs.h completely -- modify zconf.h instead
+
+Changes in 1.2.3.6 (17 Jan 2010)
+- Avoid void * arithmetic in gzread.c and gzwrite.c
+- Make compilers happier with const char * for gz_error message
+- Avoid unused parameter warning in inflate.c
+- Avoid signed-unsigned comparison warning in inflate.c
+- Indent #pragma's for traditional C
+- Fix usage of strwinerror() in glib.c, change to gz_strwinerror()
+- Correct email address in configure for system options
+- Update make_vms.com and add make_vms.com to contrib/minizip [Zinser]
+- Update zlib.map [Brown]
+- Fix Makefile.in for Solaris 10 make of example64 and minizip64 [Torok]
+- Apply various fixes to CMakeLists.txt [Lowman]
+- Add checks on len in gzread() and gzwrite()
+- Add error message for no more room for gzungetc()
+- Remove zlib version check in gzwrite()
+- Defer compression of gzprintf() result until need to
+- Use snprintf() in gzdopen() if available
+- Remove USE_MMAP configuration determination (only used by minigzip)
+- Remove examples/pigz.c (available separately)
+- Update examples/gun.c to 1.6
+
+Changes in 1.2.3.5 (8 Jan 2010)
+- Add space after #if in zutil.h for some compilers
+- Fix relatively harmless bug in deflate_fast() [Exarevsky]
+- Fix same problem in deflate_slow()
+- Add $(SHAREDLIBV) to LIBS in Makefile.in [Brown]
+- Add deflate_rle() for faster Z_RLE strategy run-length encoding
+- Add deflate_huff() for faster Z_HUFFMAN_ONLY encoding
+- Change name of "write" variable in inffast.c to avoid library collisions
+- Fix premature EOF from gzread() in gzio.c [Brown]
+- Use zlib header window size if windowBits is 0 in inflateInit2()
+- Remove compressBound() call in deflate.c to avoid linking compress.o
+- Replace use of errno in gz* with functions, support WinCE [Alves]
+- Provide alternative to perror() in minigzip.c for WinCE [Alves]
+- Don't use _vsnprintf on later versions of MSVC [Lowman]
+- Add CMake build script and input file [Lowman]
+- Update contrib/minizip to 1.1 [Svensson, Vollant]
+- Moved nintendods directory from contrib to .
+- Replace gzio.c with a new set of routines with the same functionality
+- Add gzbuffer(), gzoffset(), gzclose_r(), gzclose_w() as part of above
+- Update contrib/minizip to 1.1b
+- Change gzeof() to return 0 on error instead of -1 to agree with zlib.h
+
+Changes in 1.2.3.4 (21 Dec 2009)
+- Use old school .SUFFIXES in Makefile.in for FreeBSD compatibility
+- Update comments in configure and Makefile.in for default --shared
+- Fix test -z's in configure [Marquess]
+- Build examplesh and minigzipsh when not testing
+- Change NULL's to Z_NULL's in deflate.c and in comments in zlib.h
+- Import LDFLAGS from the environment in configure
+- Fix configure to populate SFLAGS with discovered CFLAGS options
+- Adapt make_vms.com to the new Makefile.in [Zinser]
+- Add zlib2ansi script for C++ compilation [Marquess]
+- Add _FILE_OFFSET_BITS=64 test to make test (when applicable)
+- Add AMD64 assembler code for longest match to contrib [Teterin]
+- Include options from $SFLAGS when doing $LDSHARED
+- Simplify 64-bit file support by introducing z_off64_t type
+- Make shared object files in objs directory to work around old Sun cc
+- Use only three-part version number for Darwin shared compiles
+- Add rc option to ar in Makefile.in for when ./configure not run
+- Add -WI,-rpath,. to LDFLAGS for OSF 1 V4*
+- Set LD_LIBRARYN32_PATH for SGI IRIX shared compile
+- Protect against _FILE_OFFSET_BITS being defined when compiling zlib
+- Rename Makefile.in targets allstatic to static and allshared to shared
+- Fix static and shared Makefile.in targets to be independent
+- Correct error return bug in gz_open() by setting state [Brown]
+- Put spaces before ;;'s in configure for better sh compatibility
+- Add pigz.c (parallel implementation of gzip) to examples/
+- Correct constant in crc32.c to UL [Leventhal]
+- Reject negative lengths in crc32_combine()
+- Add inflateReset2() function to work like inflateEnd()/inflateInit2()
+- Include sys/types.h for _LARGEFILE64_SOURCE [Brown]
+- Correct typo in doc/algorithm.txt [Janik]
+- Fix bug in adler32_combine() [Zhu]
+- Catch missing-end-of-block-code error in all inflates and in puff
+ Assures that random input to inflate eventually results in an error
+- Added enough.c (calculation of ENOUGH for inftrees.h) to examples/
+- Update ENOUGH and its usage to reflect discovered bounds
+- Fix gzerror() error report on empty input file [Brown]
+- Add ush casts in trees.c to avoid pedantic runtime errors
+- Fix typo in zlib.h uncompress() description [Reiss]
+- Correct inflate() comments with regard to automatic header detection
+- Remove deprecation comment on Z_PARTIAL_FLUSH (it stays)
+- Put new version of gzlog (2.0) in examples with interruption recovery
+- Add puff compile option to permit invalid distance-too-far streams
+- Add puff TEST command options, ability to read piped input
+- Prototype the *64 functions in zlib.h when _FILE_OFFSET_BITS == 64, but
+ _LARGEFILE64_SOURCE not defined
+- Fix Z_FULL_FLUSH to truly erase the past by resetting s->strstart
+- Fix deflateSetDictionary() to use all 32K for output consistency
+- Remove extraneous #define MIN_LOOKAHEAD in deflate.c (in deflate.h)
+- 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 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
+- Add inflateMark() to return current state information for random access
+- Add Makefile for NintendoDS to contrib [Costa]
+- Add -w in configure compile tests to avoid spurious warnings [Beucler]
+- Fix typos in zlib.h comments for deflateSetDictionary()
+- Fix EOF detection in transparent gzread() [Maier]
+
+Changes in 1.2.3.3 (2 October 2006)
+- Make --shared the default for configure, add a --static option
+- Add compile option to permit invalid distance-too-far streams
+- Add inflateUndermine() function which is required to enable above
+- Remove use of "this" variable name for C++ compatibility [Marquess]
+- Add testing of shared library in make test, if shared library built
+- Use ftello() and fseeko() if available instead of ftell() and fseek()
+- Provide two versions of all functions that use the z_off_t type for
+ binary compatibility -- a normal version and a 64-bit offset version,
+ per the Large File Support Extension when _LARGEFILE64_SOURCE is
+ defined; use the 64-bit versions by default when _FILE_OFFSET_BITS
+ is defined to be 64
+- Add a --uname= option to configure to perhaps help with cross-compiling
+
+Changes in 1.2.3.2 (3 September 2006)
+- Turn off silly Borland warnings [Hay]
+- Use off64_t and define _LARGEFILE64_SOURCE when present
+- Fix missing dependency on inffixed.h in Makefile.in
+- Rig configure --shared to build both shared and static [Teredesai, Truta]
+- Remove zconf.in.h and instead create a new zlibdefs.h file
+- Fix contrib/minizip/unzip.c non-encrypted after encrypted [Vollant]
+- Add treebuild.xml (see http://treebuild.metux.de/) [Weigelt]
+
+Changes in 1.2.3.1 (16 August 2006)
+- Add watcom directory with OpenWatcom make files [Daniel]
+- Remove #undef of FAR in zconf.in.h for MVS [Fedtke]
+- Update make_vms.com [Zinser]
+- Use -fPIC for shared build in configure [Teredesai, Nicholson]
+- Use only major version number for libz.so on IRIX and OSF1 [Reinholdtsen]
+- Use fdopen() (not _fdopen()) for Interix in zutil.h [BŠck]
+- Add some FAQ entries about the contrib directory
+- Update the MVS question in the FAQ
+- Avoid extraneous reads after EOF in gzio.c [Brown]
+- Correct spelling of "successfully" in gzio.c [Randers-Pehrson]
+- Add comments to zlib.h about gzerror() usage [Brown]
+- Set extra flags in gzip header in gzopen() like deflate() does
+- Make configure options more compatible with double-dash conventions
+ [Weigelt]
+- Clean up compilation under Solaris SunStudio cc [Rowe, Reinholdtsen]
+- Fix uninstall target in Makefile.in [Truta]
+- Add pkgconfig support [Weigelt]
+- Use $(DESTDIR) macro in Makefile.in [Reinholdtsen, Weigelt]
+- Replace set_data_type() with a more accurate detect_data_type() in
+ trees.c, according to the txtvsbin.txt document [Truta]
+- Swap the order of #include <stdio.h> and #include "zlib.h" in
+ gzio.c, example.c and minigzip.c [Truta]
+- Shut up annoying VS2005 warnings about standard C deprecation [Rowe,
+ Truta] (where?)
+- Fix target "clean" from win32/Makefile.bor [Truta]
+- Create .pdb and .manifest files in win32/makefile.msc [Ziegler, Rowe]
+- Update zlib www home address in win32/DLL_FAQ.txt [Truta]
+- Update contrib/masmx86/inffas32.asm for VS2005 [Vollant, Van Wassenhove]
+- Enable browse info in the "Debug" and "ASM Debug" configurations in
+ the Visual C++ 6 project, and set (non-ASM) "Debug" as default [Truta]
+- Add pkgconfig support [Weigelt]
+- Add ZLIB_VER_MAJOR, ZLIB_VER_MINOR and ZLIB_VER_REVISION in zlib.h,
+ for use in win32/zlib1.rc [Polushin, Rowe, Truta]
+- Add a document that explains the new text detection scheme to
+ doc/txtvsbin.txt [Truta]
+- Add rfc1950.txt, rfc1951.txt and rfc1952.txt to doc/ [Truta]
+- Move algorithm.txt into doc/ [Truta]
+- Synchronize FAQ with website
+- Fix compressBound(), was low for some pathological cases [Fearnley]
+- Take into account wrapper variations in deflateBound()
+- Set examples/zpipe.c input and output to binary mode for Windows
+- Update examples/zlib_how.html with new zpipe.c (also web site)
+- Fix some warnings in examples/gzlog.c and examples/zran.c (it seems
+ that gcc became pickier in 4.0)
+- Add zlib.map for Linux: "All symbols from zlib-1.1.4 remain
+ un-versioned, the patch adds versioning only for symbols introduced in
+ zlib-1.2.0 or later. It also declares as local those symbols which are
+ not designed to be exported." [Levin]
+- Update Z_PREFIX list in zconf.in.h, add --zprefix option to configure
+- Do not initialize global static by default in trees.c, add a response
+ NO_INIT_GLOBAL_POINTERS to initialize them if needed [Marquess]
+- Don't use strerror() in gzio.c under WinCE [Yakimov]
+- Don't use errno.h in zutil.h under WinCE [Yakimov]
+- Move arguments for AR to its usage to allow replacing ar [Marot]
+- Add HAVE_VISIBILITY_PRAGMA in zconf.in.h for Mozilla [Randers-Pehrson]
+- Improve inflateInit() and inflateInit2() documentation
+- Fix structure size comment in inflate.h
+- Change configure help option from --h* to --help [Santos]
+
+Changes in 1.2.3 (18 July 2005)
+- Apply security vulnerability fixes to contrib/infback9 as well
+- Clean up some text files (carriage returns, trailing space)
+- Update testzlib, vstudio, masmx64, and masmx86 in contrib [Vollant]
+
+Changes in 1.2.2.4 (11 July 2005)
+- Add inflatePrime() function for starting inflation at bit boundary
+- Avoid some Visual C warnings in deflate.c
+- Avoid more silly Visual C warnings in inflate.c and inftrees.c for 64-bit
+ compile
+- Fix some spelling errors in comments [Betts]
+- Correct inflateInit2() error return documentation in zlib.h
+- Add zran.c example of compressed data random access to examples
+ directory, shows use of inflatePrime()
+- Fix cast for assignments to strm->state in inflate.c and infback.c
+- Fix zlibCompileFlags() in zutil.c to use 1L for long shifts [Oberhumer]
+- Move declarations of gf2 functions to right place in crc32.c [Oberhumer]
+- Add cast in trees.c t avoid a warning [Oberhumer]
+- Avoid some warnings in fitblk.c, gun.c, gzjoin.c in examples [Oberhumer]
+- Update make_vms.com [Zinser]
+- Initialize state->write in inflateReset() since copied in inflate_fast()
+- Be more strict on incomplete code sets in inflate_table() and increase
+ ENOUGH and MAXD -- this repairs a possible security vulnerability for
+ invalid inflate input. Thanks to Tavis Ormandy and Markus Oberhumer for
+ discovering the vulnerability and providing test cases.
+- Add ia64 support to configure for HP-UX [Smith]
+- Add error return to gzread() for format or i/o error [Levin]
+- Use malloc.h for OS/2 [Necasek]
+
+Changes in 1.2.2.3 (27 May 2005)
+- Replace 1U constants in inflate.c and inftrees.c for 64-bit compile
+- Typecast fread() return values in gzio.c [Vollant]
+- Remove trailing space in minigzip.c outmode (VC++ can't deal with it)
+- Fix crc check bug in gzread() after gzungetc() [Heiner]
+- Add the deflateTune() function to adjust internal compression parameters
+- Add a fast gzip decompressor, gun.c, to examples (use of inflateBack)
+- Remove an incorrect assertion in examples/zpipe.c
+- Add C++ wrapper in infback9.h [Donais]
+- Fix bug in inflateCopy() when decoding fixed codes
+- Note in zlib.h how much deflateSetDictionary() actually uses
+- Remove USE_DICT_HEAD in deflate.c (would mess up inflate if used)
+- Add _WIN32_WCE to define WIN32 in zconf.in.h [Spencer]
+- Don't include stderr.h or errno.h for _WIN32_WCE in zutil.h [Spencer]
+- Add gzdirect() function to indicate transparent reads
+- Update contrib/minizip [Vollant]
+- Fix compilation of deflate.c when both ASMV and FASTEST [Oberhumer]
+- Add casts in crc32.c to avoid warnings [Oberhumer]
+- Add contrib/masmx64 [Vollant]
+- Update contrib/asm586, asm686, masmx86, testzlib, vstudio [Vollant]
+
+Changes in 1.2.2.2 (30 December 2004)
+- Replace structure assignments in deflate.c and inflate.c with zmemcpy to
+ avoid implicit memcpy calls (portability for no-library compilation)
+- Increase sprintf() buffer size in gzdopen() to allow for large numbers
+- Add INFLATE_STRICT to check distances against zlib header
+- Improve WinCE errno handling and comments [Chang]
+- Remove comment about no gzip header processing in FAQ
+- Add Z_FIXED strategy option to deflateInit2() to force fixed trees
+- Add updated make_vms.com [Coghlan], update README
+- Create a new "examples" directory, move gzappend.c there, add zpipe.c,
+ fitblk.c, gzlog.[ch], gzjoin.c, and zlib_how.html.
+- Add FAQ entry and comments in deflate.c on uninitialized memory access
+- Add Solaris 9 make options in configure [Gilbert]
+- Allow strerror() usage in gzio.c for STDC
+- Fix DecompressBuf in contrib/delphi/ZLib.pas [ManChesTer]
+- Update contrib/masmx86/inffas32.asm and gvmat32.asm [Vollant]
+- Use z_off_t for adler32_combine() and crc32_combine() lengths
+- Make adler32() much faster for small len
+- Use OS_CODE in deflate() default gzip header
+
+Changes in 1.2.2.1 (31 October 2004)
+- Allow inflateSetDictionary() call for raw inflate
+- Fix inflate header crc check bug for file names and comments
+- Add deflateSetHeader() and gz_header structure for custom gzip headers
+- Add inflateGetheader() to retrieve gzip headers
+- Add crc32_combine() and adler32_combine() functions
+- Add alloc_func, free_func, in_func, out_func to Z_PREFIX list
+- Use zstreamp consistently in zlib.h (inflate_back functions)
+- Remove GUNZIP condition from definition of inflate_mode in inflate.h
+ and in contrib/inflate86/inffast.S [Truta, Anderson]
+- Add support for AMD64 in contrib/inflate86/inffas86.c [Anderson]
+- Update projects/README.projects and projects/visualc6 [Truta]
+- Update win32/DLL_FAQ.txt [Truta]
+- Avoid warning under NO_GZCOMPRESS in gzio.c; fix typo [Truta]
+- Deprecate Z_ASCII; use Z_TEXT instead [Truta]
+- Use a new algorithm for setting strm->data_type in trees.c [Truta]
+- Do not define an exit() prototype in zutil.c unless DEBUG defined
+- Remove prototype of exit() from zutil.c, example.c, minigzip.c [Truta]
+- Add comment in zlib.h for Z_NO_FLUSH parameter to deflate()
+- Fix Darwin build version identification [Peterson]
+
+Changes in 1.2.2 (3 October 2004)
+- Update zlib.h comments on gzip in-memory processing
+- Set adler to 1 in inflateReset() to support Java test suite [Walles]
+- Add contrib/dotzlib [Ravn]
+- Update win32/DLL_FAQ.txt [Truta]
+- Update contrib/minizip [Vollant]
+- Move contrib/visual-basic.txt to old/ [Truta]
+- Fix assembler builds in projects/visualc6/ [Truta]
+
+Changes in 1.2.1.2 (9 September 2004)
+- Update INDEX file
+- Fix trees.c to update strm->data_type (no one ever noticed!)
+- Fix bug in error case in inflate.c, infback.c, and infback9.c [Brown]
+- Add "volatile" to crc table flag declaration (for DYNAMIC_CRC_TABLE)
+- Add limited multitasking protection to DYNAMIC_CRC_TABLE
+- Add NO_vsnprintf for VMS in zutil.h [Mozilla]
+- Don't declare strerror() under VMS [Mozilla]
+- Add comment to DYNAMIC_CRC_TABLE to use get_crc_table() to initialize
+- Update contrib/ada [Anisimkov]
+- Update contrib/minizip [Vollant]
+- Fix configure to not hardcode directories for Darwin [Peterson]
+- Fix gzio.c to not return error on empty files [Brown]
+- Fix indentation; update version in contrib/delphi/ZLib.pas and
+ contrib/pascal/zlibpas.pas [Truta]
+- Update mkasm.bat in contrib/masmx86 [Truta]
+- Update contrib/untgz [Truta]
+- Add projects/README.projects [Truta]
+- Add project for MS Visual C++ 6.0 in projects/visualc6 [Cadieux, Truta]
+- Update win32/DLL_FAQ.txt [Truta]
+- Update list of Z_PREFIX symbols in zconf.h [Randers-Pehrson, Truta]
+- Remove an unnecessary assignment to curr in inftrees.c [Truta]
+- Add OS/2 to exe builds in configure [Poltorak]
+- Remove err dummy parameter in zlib.h [Kientzle]
+
+Changes in 1.2.1.1 (9 January 2004)
+- Update email address in README
+- Several FAQ updates
+- Fix a big fat bug in inftrees.c that prevented decoding valid
+ dynamic blocks with only literals and no distance codes --
+ Thanks to "Hot Emu" for the bug report and sample file
+- Add a note to puff.c on no distance codes case.
+
+Changes in 1.2.1 (17 November 2003)
+- Remove a tab in contrib/gzappend/gzappend.c
+- Update some interfaces in contrib for new zlib functions
+- Update zlib version number in some contrib entries
+- Add Windows CE definition for ptrdiff_t in zutil.h [Mai, Truta]
+- Support shared libraries on Hurd and KFreeBSD [Brown]
+- Fix error in NO_DIVIDE option of adler32.c
+
+Changes in 1.2.0.8 (4 November 2003)
+- Update version in contrib/delphi/ZLib.pas and contrib/pascal/zlibpas.pas
+- Add experimental NO_DIVIDE #define in adler32.c
+ - Possibly faster on some processors (let me know if it is)
+- Correct Z_BLOCK to not return on first inflate call if no wrap
+- Fix strm->data_type on inflate() return to correctly indicate EOB
+- Add deflatePrime() function for appending in the middle of a byte
+- Add contrib/gzappend for an example of appending to a stream
+- Update win32/DLL_FAQ.txt [Truta]
+- Delete Turbo C comment in README [Truta]
+- Improve some indentation in zconf.h [Truta]
+- Fix infinite loop on bad input in configure script [Church]
+- Fix gzeof() for concatenated gzip files [Johnson]
+- Add example to contrib/visual-basic.txt [Michael B.]
+- Add -p to mkdir's in Makefile.in [vda]
+- Fix configure to properly detect presence or lack of printf functions
+- Add AS400 support [Monnerat]
+- Add a little Cygwin support [Wilson]
+
+Changes in 1.2.0.7 (21 September 2003)
+- Correct some debug formats in contrib/infback9
+- Cast a type in a debug statement in trees.c
+- Change search and replace delimiter in configure from % to # [Beebe]
+- Update contrib/untgz to 0.2 with various fixes [Truta]
+- Add build support for Amiga [Nikl]
+- Remove some directories in old that have been updated to 1.2
+- Add dylib building for Mac OS X in configure and Makefile.in
+- Remove old distribution stuff from Makefile
+- Update README to point to DLL_FAQ.txt, and add comment on Mac OS X
+- Update links in README
+
+Changes in 1.2.0.6 (13 September 2003)
+- Minor FAQ updates
+- Update contrib/minizip to 1.00 [Vollant]
+- Remove test of gz functions in example.c when GZ_COMPRESS defined [Truta]
+- Update POSTINC comment for 68060 [Nikl]
+- Add contrib/infback9 with deflate64 decoding (unsupported)
+- For MVS define NO_vsnprintf and undefine FAR [van Burik]
+- Add pragma for fdopen on MVS [van Burik]
+
+Changes in 1.2.0.5 (8 September 2003)
+- Add OF to inflateBackEnd() declaration in zlib.h
+- Remember start when using gzdopen in the middle of a file
+- Use internal off_t counters in gz* functions to properly handle seeks
+- Perform more rigorous check for distance-too-far in inffast.c
+- Add Z_BLOCK flush option to return from inflate at block boundary
+- Set strm->data_type on return from inflate
+ - Indicate bits unused, if at block boundary, and if in last block
+- Replace size_t with ptrdiff_t in crc32.c, and check for correct size
+- Add condition so old NO_DEFLATE define still works for compatibility
+- FAQ update regarding the Windows DLL [Truta]
+- INDEX update: add qnx entry, remove aix entry [Truta]
+- Install zlib.3 into mandir [Wilson]
+- Move contrib/zlib_dll_FAQ.txt to win32/DLL_FAQ.txt; update [Truta]
+- Adapt the zlib interface to the new DLL convention guidelines [Truta]
+- Introduce ZLIB_WINAPI macro to allow the export of functions using
+ the WINAPI calling convention, for Visual Basic [Vollant, Truta]
+- Update msdos and win32 scripts and makefiles [Truta]
+- Export symbols by name, not by ordinal, in win32/zlib.def [Truta]
+- Add contrib/ada [Anisimkov]
+- Move asm files from contrib/vstudio/vc70_32 to contrib/asm386 [Truta]
+- Rename contrib/asm386 to contrib/masmx86 [Truta, Vollant]
+- Add contrib/masm686 [Truta]
+- Fix offsets in contrib/inflate86 and contrib/masmx86/inffas32.asm
+ [Truta, Vollant]
+- Update contrib/delphi; rename to contrib/pascal; add example [Truta]
+- Remove contrib/delphi2; add a new contrib/delphi [Truta]
+- Avoid inclusion of the nonstandard <memory.h> in contrib/iostream,
+ and fix some method prototypes [Truta]
+- Fix the ZCR_SEED2 constant to avoid warnings in contrib/minizip
+ [Truta]
+- Avoid the use of backslash (\) in contrib/minizip [Vollant]
+- Fix file time handling in contrib/untgz; update makefiles [Truta]
+- Update contrib/vstudio/vc70_32 to comply with the new DLL guidelines
+ [Vollant]
+- Remove contrib/vstudio/vc15_16 [Vollant]
+- Rename contrib/vstudio/vc70_32 to contrib/vstudio/vc7 [Truta]
+- Update README.contrib [Truta]
+- Invert the assignment order of match_head and s->prev[...] in
+ INSERT_STRING [Truta]
+- Compare TOO_FAR with 32767 instead of 32768, to avoid 16-bit warnings
+ [Truta]
+- Compare function pointers with 0, not with NULL or Z_NULL [Truta]
+- Fix prototype of syncsearch in inflate.c [Truta]
+- Introduce ASMINF macro to be enabled when using an ASM implementation
+ of inflate_fast [Truta]
+- Change NO_DEFLATE to NO_GZCOMPRESS [Truta]
+- Modify test_gzio in example.c to take a single file name as a
+ parameter [Truta]
+- Exit the example.c program if gzopen fails [Truta]
+- Add type casts around strlen in example.c [Truta]
+- Remove casting to sizeof in minigzip.c; give a proper type
+ to the variable compared with SUFFIX_LEN [Truta]
+- Update definitions of STDC and STDC99 in zconf.h [Truta]
+- Synchronize zconf.h with the new Windows DLL interface [Truta]
+- Use SYS16BIT instead of __32BIT__ to distinguish between
+ 16- and 32-bit platforms [Truta]
+- Use far memory allocators in small 16-bit memory models for
+ Turbo C [Truta]
+- Add info about the use of ASMV, ASMINF and ZLIB_WINAPI in
+ zlibCompileFlags [Truta]
+- Cygwin has vsnprintf [Wilson]
+- In Windows16, OS_CODE is 0, as in MSDOS [Truta]
+- In Cygwin, OS_CODE is 3 (Unix), not 11 (Windows32) [Wilson]
+
+Changes in 1.2.0.4 (10 August 2003)
+- Minor FAQ updates
+- Be more strict when checking inflateInit2's windowBits parameter
+- Change NO_GUNZIP compile option to NO_GZIP to cover deflate as well
+- Add gzip wrapper option to deflateInit2 using windowBits
+- Add updated QNX rule in configure and qnx directory [Bonnefoy]
+- Make inflate distance-too-far checks more rigorous
+- Clean up FAR usage in inflate
+- Add casting to sizeof() in gzio.c and minigzip.c
+
+Changes in 1.2.0.3 (19 July 2003)
+- Fix silly error in gzungetc() implementation [Vollant]
+- Update contrib/minizip and contrib/vstudio [Vollant]
+- Fix printf format in example.c
+- Correct cdecl support in zconf.in.h [Anisimkov]
+- Minor FAQ updates
+
+Changes in 1.2.0.2 (13 July 2003)
+- Add ZLIB_VERNUM in zlib.h for numerical preprocessor comparisons
+- Attempt to avoid warnings in crc32.c for pointer-int conversion
+- Add AIX to configure, remove aix directory [Bakker]
+- Add some casts to minigzip.c
+- Improve checking after insecure sprintf() or vsprintf() calls
+- Remove #elif's from crc32.c
+- Change leave label to inf_leave in inflate.c and infback.c to avoid
+ library conflicts
+- Remove inflate gzip decoding by default--only enable gzip decoding by
+ special request for stricter backward compatibility
+- Add zlibCompileFlags() function to return compilation information
+- More typecasting in deflate.c to avoid warnings
+- Remove leading underscore from _Capital #defines [Truta]
+- Fix configure to link shared library when testing
+- Add some Windows CE target adjustments [Mai]
+- Remove #define ZLIB_DLL in zconf.h [Vollant]
+- Add zlib.3 [Rodgers]
+- Update RFC URL in deflate.c and algorithm.txt [Mai]
+- Add zlib_dll_FAQ.txt to contrib [Truta]
+- Add UL to some constants [Truta]
+- Update minizip and vstudio [Vollant]
+- Remove vestigial NEED_DUMMY_RETURN from zconf.in.h
+- Expand use of NO_DUMMY_DECL to avoid all dummy structures
+- Added iostream3 to contrib [Schwardt]
+- Replace rewind() with fseek() for WinCE [Truta]
+- Improve setting of zlib format compression level flags
+ - Report 0 for huffman and rle strategies and for level == 0 or 1
+ - Report 2 only for level == 6
+- Only deal with 64K limit when necessary at compile time [Truta]
+- Allow TOO_FAR check to be turned off at compile time [Truta]
+- Add gzclearerr() function [Souza]
+- Add gzungetc() function
+
+Changes in 1.2.0.1 (17 March 2003)
+- Add Z_RLE strategy for run-length encoding [Truta]
+ - When Z_RLE requested, restrict matches to distance one
+ - Update zlib.h, minigzip.c, gzopen(), gzdopen() for Z_RLE
+- Correct FASTEST compilation to allow level == 0
+- Clean up what gets compiled for FASTEST
+- Incorporate changes to zconf.in.h [Vollant]
+ - Refine detection of Turbo C need for dummy returns
+ - Refine ZLIB_DLL compilation
+ - Include additional header file on VMS for off_t typedef
+- Try to use _vsnprintf where it supplants vsprintf [Vollant]
+- Add some casts in inffast.c
+- Enchance comments in zlib.h on what happens if gzprintf() tries to
+ write more than 4095 bytes before compression
+- Remove unused state from inflateBackEnd()
+- Remove exit(0) from minigzip.c, example.c
+- Get rid of all those darn tabs
+- Add "check" target to Makefile.in that does the same thing as "test"
+- Add "mostlyclean" and "maintainer-clean" targets to Makefile.in
+- Update contrib/inflate86 [Anderson]
+- Update contrib/testzlib, contrib/vstudio, contrib/minizip [Vollant]
+- Add msdos and win32 directories with makefiles [Truta]
+- More additions and improvements to the FAQ
+
+Changes in 1.2.0 (9 March 2003)
+- New and improved inflate code
+ - About 20% faster
+ - Does not allocate 32K window unless and until needed
+ - Automatically detects and decompresses gzip streams
+ - Raw inflate no longer needs an extra dummy byte at end
+ - Added inflateBack functions using a callback interface--even faster
+ than inflate, useful for file utilities (gzip, zip)
+ - Added inflateCopy() function to record state for random access on
+ externally generated deflate streams (e.g. in gzip files)
+ - More readable code (I hope)
+- New and improved crc32()
+ - About 50% faster, thanks to suggestions from Rodney Brown
+- Add deflateBound() and compressBound() functions
+- Fix memory leak in deflateInit2()
+- Permit setting dictionary for raw deflate (for parallel deflate)
+- Fix const declaration for gzwrite()
+- Check for some malloc() failures in gzio.c
+- Fix bug in gzopen() on single-byte file 0x1f
+- Fix bug in gzread() on concatenated file with 0x1f at end of buffer
+ and next buffer doesn't start with 0x8b
+- Fix uncompress() to return Z_DATA_ERROR on truncated input
+- Free memory at end of example.c
+- Remove MAX #define in trees.c (conflicted with some libraries)
+- Fix static const's in deflate.c, gzio.c, and zutil.[ch]
+- Declare malloc() and free() in gzio.c if STDC not defined
+- Use malloc() instead of calloc() in zutil.c if int big enough
+- Define STDC for AIX
+- Add aix/ with approach for compiling shared library on AIX
+- Add HP-UX support for shared libraries in configure
+- Add OpenUNIX support for shared libraries in configure
+- Use $cc instead of gcc to build shared library
+- Make prefix directory if needed when installing
+- Correct Macintosh avoidance of typedef Byte in zconf.h
+- Correct Turbo C memory allocation when under Linux
+- Use libz.a instead of -lz in Makefile (assure use of compiled library)
+- Update configure to check for snprintf or vsnprintf functions and their
+ return value, warn during make if using an insecure function
+- Fix configure problem with compile-time knowledge of HAVE_UNISTD_H that
+ is lost when library is used--resolution is to build new zconf.h
+- Documentation improvements (in zlib.h):
+ - Document raw deflate and inflate
+ - Update RFCs URL
+ - Point out that zlib and gzip formats are different
+ - Note that Z_BUF_ERROR is not fatal
+ - Document string limit for gzprintf() and possible buffer overflow
+ - Note requirement on avail_out when flushing
+ - Note permitted values of flush parameter of inflate()
+- Add some FAQs (and even answers) to the FAQ
+- Add contrib/inflate86/ for x86 faster inflate
+- Add contrib/blast/ for PKWare Data Compression Library decompression
+- Add contrib/puff/ simple inflate for deflate format description
+
+Changes in 1.1.4 (11 March 2002)
+- ZFREE was repeated on same allocation on some error conditions.
+ This creates a security problem described in
+ http://www.zlib.org/advisory-2002-03-11.txt
+- Returned incorrect error (Z_MEM_ERROR) on some invalid data
+- Avoid accesses before window for invalid distances with inflate window
+ less than 32K.
+- force windowBits > 8 to avoid a bug in the encoder for a window size
+ of 256 bytes. (A complete fix will be available in 1.1.5).
+
+Changes in 1.1.3 (9 July 1998)
+- fix "an inflate input buffer bug that shows up on rare but persistent
+ occasions" (Mark)
+- fix gzread and gztell for concatenated .gz files (Didier Le Botlan)
+- fix gzseek(..., SEEK_SET) in write mode
+- fix crc check after a gzeek (Frank Faubert)
+- fix miniunzip when the last entry in a zip file is itself a zip file
+ (J Lillge)
+- add contrib/asm586 and contrib/asm686 (Brian Raiter)
+ See http://www.muppetlabs.com/~breadbox/software/assembly.html
+- add support for Delphi 3 in contrib/delphi (Bob Dellaca)
+- add support for C++Builder 3 and Delphi 3 in contrib/delphi2 (Davide Moretti)
+- do not exit prematurely in untgz if 0 at start of block (Magnus Holmgren)
+- use macro EXTERN instead of extern to support DLL for BeOS (Sander Stoks)
+- added a FAQ file
+
+- Support gzdopen on Mac with Metrowerks (Jason Linhart)
+- Do not redefine Byte on Mac (Brad Pettit & Jason Linhart)
+- define SEEK_END too if SEEK_SET is not defined (Albert Chin-A-Young)
+- avoid some warnings with Borland C (Tom Tanner)
+- fix a problem in contrib/minizip/zip.c for 16-bit MSDOS (Gilles Vollant)
+- emulate utime() for WIN32 in contrib/untgz (Gilles Vollant)
+- allow several arguments to configure (Tim Mooney, Frodo Looijaard)
+- use libdir and includedir in Makefile.in (Tim Mooney)
+- support shared libraries on OSF1 V4 (Tim Mooney)
+- remove so_locations in "make clean" (Tim Mooney)
+- fix maketree.c compilation error (Glenn, Mark)
+- Python interface to zlib now in Python 1.5 (Jeremy Hylton)
+- new Makefile.riscos (Rich Walker)
+- initialize static descriptors in trees.c for embedded targets (Nick Smith)
+- use "foo-gz" in example.c for RISCOS and VMS (Nick Smith)
+- add the OS/2 files in Makefile.in too (Andrew Zabolotny)
+- fix fdopen and halloc macros for Microsoft C 6.0 (Tom Lane)
+- fix maketree.c to allow clean compilation of inffixed.h (Mark)
+- fix parameter check in deflateCopy (Gunther Nikl)
+- cleanup trees.c, use compressed_len only in debug mode (Christian Spieler)
+- Many portability patches by Christian Spieler:
+ . zutil.c, zutil.h: added "const" for zmem*
+ . Make_vms.com: fixed some typos
+ . Make_vms.com: msdos/Makefile.*: removed zutil.h from some dependency lists
+ . msdos/Makefile.msc: remove "default rtl link library" info from obj files
+ . msdos/Makefile.*: use model-dependent name for the built zlib library
+ . msdos/Makefile.emx, nt/Makefile.emx, nt/Makefile.gcc:
+ new makefiles, for emx (DOS/OS2), emx&rsxnt and mingw32 (Windows 9x / NT)
+- use define instead of typedef for Bytef also for MSC small/medium (Tom Lane)
+- replace __far with _far for better portability (Christian Spieler, Tom Lane)
+- fix test for errno.h in configure (Tim Newsham)
+
+Changes in 1.1.2 (19 March 98)
+- added contrib/minzip, mini zip and unzip based on zlib (Gilles Vollant)
+ See http://www.winimage.com/zLibDll/unzip.html
+- preinitialize the inflate tables for fixed codes, to make the code
+ completely thread safe (Mark)
+- some simplifications and slight speed-up to the inflate code (Mark)
+- fix gzeof on non-compressed files (Allan Schrum)
+- add -std1 option in configure for OSF1 to fix gzprintf (Martin Mokrejs)
+- use default value of 4K for Z_BUFSIZE for 16-bit MSDOS (Tim Wegner + Glenn)
+- added os2/Makefile.def and os2/zlib.def (Andrew Zabolotny)
+- add shared lib support for UNIX_SV4.2MP (MATSUURA Takanori)
+- do not wrap extern "C" around system includes (Tom Lane)
+- mention zlib binding for TCL in README (Andreas Kupries)
+- added amiga/Makefile.pup for Amiga powerUP SAS/C PPC (Andreas Kleinert)
+- allow "make install prefix=..." even after configure (Glenn Randers-Pehrson)
+- allow "configure --prefix $HOME" (Tim Mooney)
+- remove warnings in example.c and gzio.c (Glenn Randers-Pehrson)
+- move Makefile.sas to amiga/Makefile.sas
+
+Changes in 1.1.1 (27 Feb 98)
+- fix macros _tr_tally_* in deflate.h for debug mode (Glenn Randers-Pehrson)
+- remove block truncation heuristic which had very marginal effect for zlib
+ (smaller lit_bufsize than in gzip 1.2.4) and degraded a little the
+ compression ratio on some files. This also allows inlining _tr_tally for
+ matches in deflate_slow.
+- added msdos/Makefile.w32 for WIN32 Microsoft Visual C++ (Bob Frazier)
+
+Changes in 1.1.0 (24 Feb 98)
+- do not return STREAM_END prematurely in inflate (John Bowler)
+- revert to the zlib 1.0.8 inflate to avoid the gcc 2.8.0 bug (Jeremy Buhler)
+- compile with -DFASTEST to get compression code optimized for speed only
+- in minigzip, try mmap'ing the input file first (Miguel Albrecht)
+- increase size of I/O buffers in minigzip.c and gzio.c (not a big gain
+ on Sun but significant on HP)
+
+- add a pointer to experimental unzip library in README (Gilles Vollant)
+- initialize variable gcc in configure (Chris Herborth)
+
+Changes in 1.0.9 (17 Feb 1998)
+- added gzputs and gzgets functions
+- do not clear eof flag in gzseek (Mark Diekhans)
+- fix gzseek for files in transparent mode (Mark Diekhans)
+- do not assume that vsprintf returns the number of bytes written (Jens Krinke)
+- replace EXPORT with ZEXPORT to avoid conflict with other programs
+- added compress2 in zconf.h, zlib.def, zlib.dnt
+- new asm code from Gilles Vollant in contrib/asm386
+- simplify the inflate code (Mark):
+ . Replace ZALLOC's in huft_build() with single ZALLOC in inflate_blocks_new()
+ . ZALLOC the length list in inflate_trees_fixed() instead of using stack
+ . ZALLOC the value area for huft_build() instead of using stack
+ . Simplify Z_FINISH check in inflate()
+
+- Avoid gcc 2.8.0 comparison bug a little differently than zlib 1.0.8
+- in inftrees.c, avoid cc -O bug on HP (Farshid Elahi)
+- in zconf.h move the ZLIB_DLL stuff earlier to avoid problems with
+ the declaration of FAR (Gilles VOllant)
+- install libz.so* with mode 755 (executable) instead of 644 (Marc Lehmann)
+- read_buf buf parameter of type Bytef* instead of charf*
+- zmemcpy parameters are of type Bytef*, not charf* (Joseph Strout)
+- do not redeclare unlink in minigzip.c for WIN32 (John Bowler)
+- fix check for presence of directories in "make install" (Ian Willis)
+
+Changes in 1.0.8 (27 Jan 1998)
+- fixed offsets in contrib/asm386/gvmat32.asm (Gilles Vollant)
+- fix gzgetc and gzputc for big endian systems (Markus Oberhumer)
+- added compress2() to allow setting the compression level
+- include sys/types.h to get off_t on some systems (Marc Lehmann & QingLong)
+- use constant arrays for the static trees in trees.c instead of computing
+ them at run time (thanks to Ken Raeburn for this suggestion). To create
+ trees.h, compile with GEN_TREES_H and run "make test".
+- check return code of example in "make test" and display result
+- pass minigzip command line options to file_compress
+- simplifying code of inflateSync to avoid gcc 2.8 bug
+
+- support CC="gcc -Wall" in configure -s (QingLong)
+- avoid a flush caused by ftell in gzopen for write mode (Ken Raeburn)
+- fix test for shared library support to avoid compiler warnings
+- zlib.lib -> zlib.dll in msdos/zlib.rc (Gilles Vollant)
+- check for TARGET_OS_MAC in addition to MACOS (Brad Pettit)
+- do not use fdopen for Metrowerks on Mac (Brad Pettit))
+- add checks for gzputc and gzputc in example.c
+- avoid warnings in gzio.c and deflate.c (Andreas Kleinert)
+- use const for the CRC table (Ken Raeburn)
+- fixed "make uninstall" for shared libraries
+- use Tracev instead of Trace in infblock.c
+- in example.c use correct compressed length for test_sync
+- suppress +vnocompatwarnings in configure for HPUX (not always supported)
+
+Changes in 1.0.7 (20 Jan 1998)
+- fix gzseek which was broken in write mode
+- return error for gzseek to negative absolute position
+- fix configure for Linux (Chun-Chung Chen)
+- increase stack space for MSC (Tim Wegner)
+- get_crc_table and inflateSyncPoint are EXPORTed (Gilles Vollant)
+- define EXPORTVA for gzprintf (Gilles Vollant)
+- added man page zlib.3 (Rick Rodgers)
+- for contrib/untgz, fix makedir() and improve Makefile
+
+- check gzseek in write mode in example.c
+- allocate extra buffer for seeks only if gzseek is actually called
+- avoid signed/unsigned comparisons (Tim Wegner, Gilles Vollant)
+- add inflateSyncPoint in zconf.h
+- fix list of exported functions in nt/zlib.dnt and mdsos/zlib.def
+
+Changes in 1.0.6 (19 Jan 1998)
+- add functions gzprintf, gzputc, gzgetc, gztell, gzeof, gzseek, gzrewind and
+ gzsetparams (thanks to Roland Giersig and Kevin Ruland for some of this code)
+- Fix a deflate bug occurring only with compression level 0 (thanks to
+ Andy Buckler for finding this one).
+- In minigzip, pass transparently also the first byte for .Z files.
+- return Z_BUF_ERROR instead of Z_OK if output buffer full in uncompress()
+- check Z_FINISH in inflate (thanks to Marc Schluper)
+- Implement deflateCopy (thanks to Adam Costello)
+- make static libraries by default in configure, add --shared option.
+- move MSDOS or Windows specific files to directory msdos
+- suppress the notion of partial flush to simplify the interface
+ (but the symbol Z_PARTIAL_FLUSH is kept for compatibility with 1.0.4)
+- suppress history buffer provided by application to simplify the interface
+ (this feature was not implemented anyway in 1.0.4)
+- next_in and avail_in must be initialized before calling inflateInit or
+ inflateInit2
+- add EXPORT in all exported functions (for Windows DLL)
+- added Makefile.nt (thanks to Stephen Williams)
+- added the unsupported "contrib" directory:
+ contrib/asm386/ by Gilles Vollant <info@winimage.com>
+ 386 asm code replacing longest_match().
+ contrib/iostream/ by Kevin Ruland <kevin@rodin.wustl.edu>
+ A C++ I/O streams interface to the zlib gz* functions
+ contrib/iostream2/ by Tyge Løvset <Tyge.Lovset@cmr.no>
+ Another C++ I/O streams interface
+ contrib/untgz/ by "Pedro A. Aranda Guti\irrez" <paag@tid.es>
+ A very simple tar.gz file extractor using zlib
+ contrib/visual-basic.txt by Carlos Rios <c_rios@sonda.cl>
+ How to use compress(), uncompress() and the gz* functions from VB.
+- pass params -f (filtered data), -h (huffman only), -1 to -9 (compression
+ level) in minigzip (thanks to Tom Lane)
+
+- use const for rommable constants in deflate
+- added test for gzseek and gztell in example.c
+- add undocumented function inflateSyncPoint() (hack for Paul Mackerras)
+- add undocumented function zError to convert error code to string
+ (for Tim Smithers)
+- Allow compilation of gzio with -DNO_DEFLATE to avoid the compression code.
+- Use default memcpy for Symantec MSDOS compiler.
+- Add EXPORT keyword for check_func (needed for Windows DLL)
+- add current directory to LD_LIBRARY_PATH for "make test"
+- create also a link for libz.so.1
+- added support for FUJITSU UXP/DS (thanks to Toshiaki Nomura)
+- use $(SHAREDLIB) instead of libz.so in Makefile.in (for HPUX)
+- added -soname for Linux in configure (Chun-Chung Chen,
+- assign numbers to the exported functions in zlib.def (for Windows DLL)
+- add advice in zlib.h for best usage of deflateSetDictionary
+- work around compiler bug on Atari (cast Z_NULL in call of s->checkfn)
+- allow compilation with ANSI keywords only enabled for TurboC in large model
+- avoid "versionString"[0] (Borland bug)
+- add NEED_DUMMY_RETURN for Borland
+- use variable z_verbose for tracing in debug mode (L. Peter Deutsch).
+- allow compilation with CC
+- defined STDC for OS/2 (David Charlap)
+- limit external names to 8 chars for MVS (Thomas Lund)
+- in minigzip.c, use static buffers only for 16-bit systems
+- fix suffix check for "minigzip -d foo.gz"
+- do not return an error for the 2nd of two consecutive gzflush() (Felix Lee)
+- 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$. 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
+- do not flush twice in gzclose (thanks to Ken Raeburn)
+- rename FOPEN as F_OPEN to avoid clash with /usr/include/sys/file.h
+- use NO_ERRNO_H instead of enumeration of operating systems with errno.h
+- work around buggy fclose on pipes for HP/UX
+- support zlib DLL with BORLAND C++ 5.0 (thanks to Glenn Randers-Pehrson)
+- fix configure if CC is already equal to gcc
+
+Changes in 1.0.5 (3 Jan 98)
+- Fix inflate to terminate gracefully when fed corrupted or invalid data
+- Use const for rommable constants in inflate
+- Eliminate memory leaks on error conditions in inflate
+- Removed some vestigial code in inflate
+- Update web address in README
+
+Changes in 1.0.4 (24 Jul 96)
+- In very rare conditions, deflate(s, Z_FINISH) could fail to produce an EOF
+ bit, so the decompressor could decompress all the correct data but went
+ on to attempt decompressing extra garbage data. This affected minigzip too.
+- zlibVersion and gzerror return const char* (needed for DLL)
+- port to RISCOS (no fdopen, no multiple dots, no unlink, no fileno)
+- use z_error only for DEBUG (avoid problem with DLLs)
+
+Changes in 1.0.3 (2 Jul 96)
+- use z_streamp instead of z_stream *, which is now a far pointer in MSDOS
+ small and medium models; this makes the library incompatible with previous
+ versions for these models. (No effect in large model or on other systems.)
+- return OK instead of BUF_ERROR if previous deflate call returned with
+ avail_out as zero but there is nothing to do
+- added memcmp for non STDC compilers
+- define NO_DUMMY_DECL for more Mac compilers (.h files merged incorrectly)
+- define __32BIT__ if __386__ or i386 is defined (pb. with Watcom and SCO)
+- better check for 16-bit mode MSC (avoids problem with Symantec)
+
+Changes in 1.0.2 (23 May 96)
+- added Windows DLL support
+- added a function zlibVersion (for the DLL support)
+- fixed declarations using Bytef in infutil.c (pb with MSDOS medium model)
+- Bytef is define's instead of typedef'd only for Borland C
+- avoid reading uninitialized memory in example.c
+- mention in README that the zlib format is now RFC1950
+- updated Makefile.dj2
+- added algorithm.doc
+
+Changes in 1.0.1 (20 May 96) [1.0 skipped to avoid confusion]
+- fix array overlay in deflate.c which sometimes caused bad compressed data
+- fix inflate bug with empty stored block
+- fix MSDOS medium model which was broken in 0.99
+- fix deflateParams() which could generated bad compressed data.
+- Bytef is define'd instead of typedef'ed (work around Borland bug)
+- added an INDEX file
+- new makefiles for DJGPP (Makefile.dj2), 32-bit Borland (Makefile.b32),
+ Watcom (Makefile.wat), Amiga SAS/C (Makefile.sas)
+- speed up adler32 for modern machines without auto-increment
+- added -ansi for IRIX in configure
+- static_init_done in trees.c is an int
+- define unlink as delete for VMS
+- fix configure for QNX
+- add configure branch for SCO and HPUX
+- avoid many warnings (unused variables, dead assignments, etc...)
+- no fdopen for BeOS
+- fix the Watcom fix for 32 bit mode (define FAR as empty)
+- removed redefinition of Byte for MKWERKS
+- work around an MWKERKS bug (incorrect merge of all .h files)
+
+Changes in 0.99 (27 Jan 96)
+- allow preset dictionary shared between compressor and decompressor
+- allow compression level 0 (no compression)
+- add deflateParams in zlib.h: allow dynamic change of compression level
+ and compression strategy.
+- test large buffers and deflateParams in example.c
+- add optional "configure" to build zlib as a shared library
+- suppress Makefile.qnx, use configure instead
+- fixed deflate for 64-bit systems (detected on Cray)
+- fixed inflate_blocks for 64-bit systems (detected on Alpha)
+- declare Z_DEFLATED in zlib.h (possible parameter for deflateInit2)
+- always return Z_BUF_ERROR when deflate() has nothing to do
+- deflateInit and inflateInit are now macros to allow version checking
+- prefix all global functions and types with z_ with -DZ_PREFIX
+- make falloc completely reentrant (inftrees.c)
+- fixed very unlikely race condition in ct_static_init
+- free in reverse order of allocation to help memory manager
+- use zlib-1.0/* instead of zlib/* inside the tar.gz
+- make zlib warning-free with "gcc -O3 -Wall -Wwrite-strings -Wpointer-arith
+ -Wconversion -Wstrict-prototypes -Wmissing-prototypes"
+- allow gzread on concatenated .gz files
+- deflateEnd now returns Z_DATA_ERROR if it was premature
+- deflate is finally (?) fully deterministic (no matches beyond end of input)
+- Document Z_SYNC_FLUSH
+- add uninstall in Makefile
+- Check for __cpluplus in zlib.h
+- Better test in ct_align for partial flush
+- avoid harmless warnings for Borland C++
+- initialize hash_head in deflate.c
+- avoid warning on fdopen (gzio.c) for HP cc -Aa
+- include stdlib.h for STDC compilers
+- include errno.h for Cray
+- ignore error if ranlib doesn't exist
+- call ranlib twice for NeXTSTEP
+- use exec_prefix instead of prefix for libz.a
+- renamed ct_* as _tr_* to avoid conflict with applications
+- clear z->msg in inflateInit2 before any error return
+- initialize opaque in example.c, gzio.c, deflate.c and inflate.c
+- fixed typo in zconf.h (_GNUC__ => __GNUC__)
+- check for WIN32 in zconf.h and zutil.c (avoid farmalloc in 32-bit mode)
+- fix typo in Make_vms.com (f$trnlnm -> f$getsyi)
+- in fcalloc, normalize pointer if size > 65520 bytes
+- don't use special fcalloc for 32 bit Borland C++
+- use STDC instead of __GO32__ to avoid redeclaring exit, calloc, etc...
+- use Z_BINARY instead of BINARY
+- document that gzclose after gzdopen will close the file
+- allow "a" as mode in gzopen.
+- fix error checking in gzread
+- allow skipping .gz extra-field on pipes
+- added reference to Perl interface in README
+- put the crc table in FAR data (I dislike more and more the medium model :)
+- added get_crc_table
+- added a dimension to all arrays (Borland C can't count).
+- workaround Borland C bug in declaration of inflate_codes_new & inflate_fast
+- guard against multiple inclusion of *.h (for precompiled header on Mac)
+- Watcom C pretends to be Microsoft C small model even in 32 bit mode.
+- don't use unsized arrays to avoid silly warnings by Visual C++:
+ warning C4746: 'inflate_mask' : unsized array treated as '__far'
+ (what's wrong with far data in far model?).
+- define enum out of inflate_blocks_state to allow compilation with C++
+
+Changes in 0.95 (16 Aug 95)
+- fix MSDOS small and medium model (now easier to adapt to any compiler)
+- inlined send_bits
+- fix the final (:-) bug for deflate with flush (output was correct but
+ not completely flushed in rare occasions).
+- default window size is same for compression and decompression
+ (it's now sufficient to set MAX_WBITS in zconf.h).
+- voidp -> voidpf and voidnp -> voidp (for consistency with other
+ typedefs and because voidnp was not near in large model).
+
+Changes in 0.94 (13 Aug 95)
+- support MSDOS medium model
+- fix deflate with flush (could sometimes generate bad output)
+- fix deflateReset (zlib header was incorrectly suppressed)
+- added support for VMS
+- allow a compression level in gzopen()
+- gzflush now calls fflush
+- For deflate with flush, flush even if no more input is provided.
+- rename libgz.a as libz.a
+- avoid complex expression in infcodes.c triggering Turbo C bug
+- work around a problem with gcc on Alpha (in INSERT_STRING)
+- don't use inline functions (problem with some gcc versions)
+- allow renaming of Byte, uInt, etc... with #define.
+- avoid warning about (unused) pointer before start of array in deflate.c
+- avoid various warnings in gzio.c, example.c, infblock.c, adler32.c, zutil.c
+- avoid reserved word 'new' in trees.c
+
+Changes in 0.93 (25 June 95)
+- temporarily disable inline functions
+- make deflate deterministic
+- give enough lookahead for PARTIAL_FLUSH
+- Set binary mode for stdin/stdout in minigzip.c for OS/2
+- don't even use signed char in inflate (not portable enough)
+- fix inflate memory leak for segmented architectures
+
+Changes in 0.92 (3 May 95)
+- don't assume that char is signed (problem on SGI)
+- Clear bit buffer when starting a stored block
+- no memcpy on Pyramid
+- suppressed inftest.c
+- optimized fill_window, put longest_match inline for gcc
+- optimized inflate on stored blocks.
+- untabify all sources to simplify patches
+
+Changes in 0.91 (2 May 95)
+- Default MEM_LEVEL is 8 (not 9 for Unix) as documented in zlib.h
+- Document the memory requirements in zconf.h
+- added "make install"
+- fix sync search logic in inflateSync
+- deflate(Z_FULL_FLUSH) now works even if output buffer too short
+- after inflateSync, don't scare people with just "lo world"
+- added support for DJGPP
+
+Changes in 0.9 (1 May 95)
+- don't assume that zalloc clears the allocated memory (the TurboC bug
+ was Mark's bug after all :)
+- let again gzread copy uncompressed data unchanged (was working in 0.71)
+- deflate(Z_FULL_FLUSH), inflateReset and inflateSync are now fully implemented
+- added a test of inflateSync in example.c
+- moved MAX_WBITS to zconf.h because users might want to change that.
+- document explicitly that zalloc(64K) on MSDOS must return a normalized
+ pointer (zero offset)
+- added Makefiles for Microsoft C, Turbo C, Borland C++
+- faster crc32()
+
+Changes in 0.8 (29 April 95)
+- added fast inflate (inffast.c)
+- deflate(Z_FINISH) now returns Z_STREAM_END when done. Warning: this
+ is incompatible with previous versions of zlib which returned Z_OK.
+- work around a TurboC compiler bug (bad code for b << 0, see infutil.h)
+ (actually that was not a compiler bug, see 0.81 above)
+- gzread no longer reads one extra byte in certain cases
+- In gzio destroy(), don't reference a freed structure
+- avoid many warnings for MSDOS
+- avoid the ERROR symbol which is used by MS Windows
+
+Changes in 0.71 (14 April 95)
+- Fixed more MSDOS compilation problems :( There is still a bug with
+ TurboC large model.
+
+Changes in 0.7 (14 April 95)
+- Added full inflate support.
+- Simplified the crc32() interface. The pre- and post-conditioning
+ (one's complement) is now done inside crc32(). WARNING: this is
+ incompatible with previous versions; see zlib.h for the new usage.
+
+Changes in 0.61 (12 April 95)
+- workaround for a bug in TurboC. example and minigzip now work on MSDOS.
+
+Changes in 0.6 (11 April 95)
+- added minigzip.c
+- added gzdopen to reopen a file descriptor as gzFile
+- added transparent reading of non-gziped files in gzread.
+- fixed bug in gzread (don't read crc as data)
+- fixed bug in destroy (gzio.c) (don't return Z_STREAM_END for gzclose).
+- don't allocate big arrays in the stack (for MSDOS)
+- fix some MSDOS compilation problems
+
+Changes in 0.5:
+- do real compression in deflate.c. Z_PARTIAL_FLUSH is supported but
+ not yet Z_FULL_FLUSH.
+- support decompression but only in a single step (forced Z_FINISH)
+- added opaque object for zalloc and zfree.
+- added deflateReset and inflateReset
+- added a variable zlib_version for consistency checking.
+- renamed the 'filter' parameter of deflateInit2 as 'strategy'.
+ Added Z_FILTERED and Z_HUFFMAN_ONLY constants.
+
+Changes in 0.4:
+- avoid "zip" everywhere, use zlib instead of ziplib.
+- suppress Z_BLOCK_FLUSH, interpret Z_PARTIAL_FLUSH as block flush
+ if compression method == 8.
+- added adler32 and crc32
+- renamed deflateOptions as deflateInit2, call one or the other but not both
+- added the method parameter for deflateInit2.
+- added inflateInit2
+- simplied considerably deflateInit and inflateInit by not supporting
+ user-provided history buffer. This is supported only in deflateInit2
+ and inflateInit2.
+
+Changes in 0.3:
+- prefix all macro names with Z_
+- use Z_FINISH instead of deflateEnd to finish compression.
+- added Z_HUFFMAN_ONLY
+- added gzerror()
diff --git a/compat/zlib/FAQ b/compat/zlib/FAQ
new file mode 100644
index 0000000..99b7cf9
--- /dev/null
+++ b/compat/zlib/FAQ
@@ -0,0 +1,368 @@
+
+ Frequently Asked Questions about zlib
+
+
+If your question is not there, please check the zlib home page
+http://zlib.net/ which may have more recent information.
+The lastest zlib FAQ is at http://zlib.net/zlib_faq.html
+
+
+ 1. Is zlib Y2K-compliant?
+
+ Yes. zlib doesn't handle dates.
+
+ 2. Where can I get a Windows DLL version?
+
+ The zlib sources can be compiled without change to produce a DLL. See the
+ file win32/DLL_FAQ.txt in the zlib distribution. Pointers to the
+ precompiled DLL are found in the zlib web site at http://zlib.net/ .
+
+ 3. Where can I get a Visual Basic interface to zlib?
+
+ See
+ * http://marknelson.us/1997/01/01/zlib-engine/
+ * win32/DLL_FAQ.txt in the zlib distribution
+
+ 4. compress() returns Z_BUF_ERROR.
+
+ Make sure that before the call of compress(), the length of the compressed
+ buffer is equal to the available size of the compressed buffer and not
+ zero. For Visual Basic, check that this parameter is passed by reference
+ ("as any"), not by value ("as long").
+
+ 5. deflate() or inflate() returns Z_BUF_ERROR.
+
+ Before making the call, make sure that avail_in and avail_out are not zero.
+ When setting the parameter flush equal to Z_FINISH, also make sure that
+ avail_out is big enough to allow processing all pending input. Note that a
+ Z_BUF_ERROR is not fatal--another call to deflate() or inflate() can be
+ made with more input or output space. A Z_BUF_ERROR may in fact be
+ unavoidable depending on how the functions are used, since it is not
+ possible to tell whether or not there is more output pending when
+ strm.avail_out returns with zero. See http://zlib.net/zlib_how.html for a
+ heavily annotated example.
+
+ 6. Where's the zlib documentation (man pages, etc.)?
+
+ 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 ...?
+
+ Because we would like to keep zlib as a very small and simple package.
+ zlib is rather portable and doesn't need much configuration.
+
+ 8. I found a bug in zlib.
+
+ Most of the time, such problems are due to an incorrect usage of zlib.
+ Please try to reproduce the problem with a small program and send the
+ corresponding source to us at zlib@gzip.org . Do not send multi-megabyte
+ data files without prior agreement.
+
+ 9. Why do I get "undefined reference to gzputc"?
+
+ If "make test" produces something like
+
+ example.o(.text+0x154): undefined reference to `gzputc'
+
+ check that you don't have old files libz.* in /usr/lib, /usr/local/lib or
+ /usr/X11R6/lib. Remove any old versions, then do "make install".
+
+10. I need a Delphi interface to zlib.
+
+ See the contrib/delphi directory in the zlib distribution.
+
+11. Can zlib handle .zip archives?
+
+ Not by itself, no. See the directory contrib/minizip in the zlib
+ distribution.
+
+12. Can zlib handle .Z files?
+
+ No, sorry. You have to spawn an uncompress or gunzip subprocess, or adapt
+ the code of uncompress on your own.
+
+13. How can I make a Unix shared library?
+
+ 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?
+
+ After the above, then:
+
+ make install
+
+ However, many flavors of Unix come with a shared zlib already installed.
+ Before going to the trouble of compiling a shared version of zlib and
+ trying to install it, you may want to check if it's already there! If you
+ can #include <zlib.h>, it's there. The -lz option will probably link to
+ it. You can check the version at the top of zlib.h or with the
+ ZLIB_VERSION symbol defined in zlib.h .
+
+15. I have a question about OttoPDF.
+
+ We are not the authors of OttoPDF. The real author is on the OttoPDF web
+ site: Joel Hainley, jhainley@myndkryme.com.
+
+16. Can zlib decode Flate data in an Adobe PDF file?
+
+ Yes. See http://www.pdflib.com/ . To modify PDF forms, see
+ http://sourceforge.net/projects/acroformtool/ .
+
+17. Why am I getting this "register_frame_info not found" error on Solaris?
+
+ After installing zlib 1.1.4 on Solaris 2.6, running applications using zlib
+ generates an error such as:
+
+ ld.so.1: rpm: fatal: relocation error: file /usr/local/lib/libz.so:
+ symbol __register_frame_info: referenced symbol not found
+
+ The symbol __register_frame_info is not part of zlib, it is generated by
+ the C compiler (cc or gcc). You must recompile applications using zlib
+ which have this problem. This problem is specific to Solaris. See
+ http://www.sunfreeware.com for Solaris versions of zlib and applications
+ using zlib.
+
+18. Why does gzip give an error on a file I make with compress/deflate?
+
+ The compress and deflate functions produce data in the zlib format, which
+ is different and incompatible with the gzip format. The gz* functions in
+ zlib on the other hand use the gzip format. Both the zlib and gzip formats
+ use the same compressed data format internally, but have different headers
+ and trailers around the compressed data.
+
+19. Ok, so why are there two different formats?
+
+ The gzip format was designed to retain the directory information about a
+ single file, such as the name and last modification date. The zlib format
+ on the other hand was designed for in-memory and communication channel
+ applications, and has a much more compact header and trailer and uses a
+ faster integrity check than gzip.
+
+20. Well that's nice, but how do I make a gzip file in memory?
+
+ You can request that deflate write the gzip format instead of the zlib
+ format using deflateInit2(). You can also request that inflate decode the
+ gzip format using inflateInit2(). Read zlib.h for more details.
+
+21. Is zlib thread-safe?
+
+ Yes. However any library routines that zlib uses and any application-
+ provided memory allocation routines must also be thread-safe. zlib's gz*
+ functions use stdio library routines, and most of zlib's functions use the
+ library memory allocation routines by default. zlib's *Init* functions
+ allow for the application to provide custom memory allocation routines.
+
+ Of course, you should only operate on any given zlib or gzip stream from a
+ single thread at a time.
+
+22. Can I use zlib in my commercial application?
+
+ Yes. Please read the license in zlib.h.
+
+23. Is zlib under the GNU license?
+
+ No. Please read the license in zlib.h.
+
+24. The license says that altered source versions must be "plainly marked". So
+ what exactly do I need to do to meet that requirement?
+
+ You need to change the ZLIB_VERSION and ZLIB_VERNUM #defines in zlib.h. In
+ particular, the final version number needs to be changed to "f", and an
+ identification string should be appended to ZLIB_VERSION. Version numbers
+ x.x.x.f are reserved for modifications to zlib by others than the zlib
+ maintainers. For example, if the version of the base zlib you are altering
+ is "1.2.3.4", then in zlib.h you should change ZLIB_VERNUM to 0x123f, and
+ ZLIB_VERSION to something like "1.2.3.f-zachary-mods-v3". You can also
+ update the version strings in deflate.c and inftrees.c.
+
+ For altered source distributions, you should also note the origin and
+ nature of the changes in zlib.h, as well as in ChangeLog and README, along
+ with the dates of the alterations. The origin should include at least your
+ name (or your company's name), and an email address to contact for help or
+ issues with the library.
+
+ Note that distributing a compiled zlib library along with zlib.h and
+ zconf.h is also a source distribution, and so you should change
+ ZLIB_VERSION and ZLIB_VERNUM and note the origin and nature of the changes
+ in zlib.h as you would for a full source distribution.
+
+25. Will zlib work on a big-endian or little-endian architecture, and can I
+ exchange compressed data between them?
+
+ Yes and yes.
+
+26. Will zlib work on a 64-bit machine?
+
+ Yes. It has been tested on 64-bit machines, and has no dependence on any
+ data types being limited to 32-bits in length. If you have any
+ difficulties, please provide a complete problem report to zlib@gzip.org
+
+27. Will zlib decompress data from the PKWare Data Compression Library?
+
+ No. The PKWare DCL uses a completely different compressed data format than
+ does PKZIP and zlib. However, you can look in zlib's contrib/blast
+ directory for a possible solution to your problem.
+
+28. Can I access data randomly in a compressed stream?
+
+ No, not without some preparation. If when compressing you periodically use
+ Z_FULL_FLUSH, carefully write all the pending data at those points, and
+ keep an index of those locations, then you can start decompression at those
+ points. You have to be careful to not use Z_FULL_FLUSH too often, since it
+ can significantly degrade compression. Alternatively, you can scan a
+ deflate stream once to generate an index, and then use that index for
+ random access. See examples/zran.c .
+
+29. Does zlib work on MVS, OS/390, CICS, etc.?
+
+ It has in the past, but we have not heard of any recent evidence. There
+ were working ports of zlib 1.1.4 to MVS, but those links no longer work.
+ If you know of recent, successful applications of zlib on these operating
+ systems, please let us know. Thanks.
+
+30. Is there some simpler, easier to read version of inflate I can look at to
+ understand the deflate format?
+
+ First off, you should read RFC 1951. Second, yes. Look in zlib's
+ contrib/puff directory.
+
+31. Does zlib infringe on any patents?
+
+ As far as we know, no. In fact, that was originally the whole point behind
+ zlib. Look here for some more information:
+
+ http://www.gzip.org/#faq11
+
+32. Can zlib work with greater than 4 GB of data?
+
+ Yes. inflate() and deflate() will process any amount of data correctly.
+ Each call of inflate() or deflate() is limited to input and output chunks
+ of the maximum value that can be stored in the compiler's "unsigned int"
+ type, but there is no limit to the number of chunks. Note however that the
+ strm.total_in and strm_total_out counters may be limited to 4 GB. These
+ counters are provided as a convenience and are not used internally by
+ inflate() or deflate(). The application can easily set up its own counters
+ updated after each call of inflate() or deflate() to count beyond 4 GB.
+ compress() and uncompress() may be limited to 4 GB, since they operate in a
+ single call. gzseek() and gztell() may be limited to 4 GB depending on how
+ zlib is compiled. See the zlibCompileFlags() function in zlib.h.
+
+ The word "may" appears several times above since there is a 4 GB limit only
+ if the compiler's "long" type is 32 bits. If the compiler's "long" type is
+ 64 bits, then the limit is 16 exabytes.
+
+33. Does zlib have any security vulnerabilities?
+
+ The only one that we are aware of is potentially in gzprintf(). If zlib is
+ compiled to use sprintf() or vsprintf(), then there is no protection
+ against a buffer overflow of an 8K string space (or other value as set by
+ gzbuffer()), other than the caller of gzprintf() assuring that the output
+ will not exceed 8K. On the other hand, if zlib is compiled to use
+ snprintf() or vsnprintf(), which should normally be the case, then there is
+ no vulnerability. The ./configure script will display warnings if an
+ insecure variation of sprintf() will be used by gzprintf(). Also the
+ zlibCompileFlags() function will return information on what variant of
+ sprintf() is used by gzprintf().
+
+ If you don't have snprintf() or vsnprintf() and would like one, you can
+ find a portable implementation here:
+
+ http://www.ijs.si/software/snprintf/
+
+ Note that you should be using the most recent version of zlib. Versions
+ 1.1.3 and before were subject to a double-free vulnerability, and versions
+ 1.2.1 and 1.2.2 were subject to an access exception when decompressing
+ invalid compressed data.
+
+34. Is there a Java version of zlib?
+
+ Probably what you want is to use zlib in Java. zlib is already included
+ as part of the Java SDK in the java.util.zip package. If you really want
+ a version of zlib written in the Java language, look on the zlib home
+ page for links: http://zlib.net/ .
+
+35. I get this or that compiler or source-code scanner warning when I crank it
+ up to maximally-pedantic. Can't you guys write proper code?
+
+ Many years ago, we gave up attempting to avoid warnings on every compiler
+ in the universe. It just got to be a waste of time, and some compilers
+ were downright silly as well as contradicted each other. So now, we simply
+ make sure that the code always works.
+
+36. Valgrind (or some similar memory access checker) says that deflate is
+ performing a conditional jump that depends on an uninitialized value.
+ Isn't that a bug?
+
+ No. That is intentional for performance reasons, and the output of deflate
+ is not affected. This only started showing up recently since zlib 1.2.x
+ uses malloc() by default for allocations, whereas earlier versions used
+ calloc(), which zeros out the allocated memory. Even though the code was
+ correct, versions 1.2.4 and later was changed to not stimulate these
+ checkers.
+
+37. Will zlib read the (insert any ancient or arcane format here) compressed
+ data format?
+
+ Probably not. Look in the comp.compression FAQ for pointers to various
+ formats and associated software.
+
+38. How can I encrypt/decrypt zip files with zlib?
+
+ zlib doesn't support encryption. The original PKZIP encryption is very
+ weak and can be broken with freely available programs. To get strong
+ encryption, use GnuPG, http://www.gnupg.org/ , which already includes zlib
+ compression. For PKZIP compatible "encryption", look at
+ http://www.info-zip.org/
+
+39. What's the difference between the "gzip" and "deflate" HTTP 1.1 encodings?
+
+ "gzip" is the gzip format, and "deflate" is the zlib format. They should
+ probably have called the second one "zlib" instead to avoid confusion with
+ the raw deflate compressed data format. While the HTTP 1.1 RFC 2616
+ 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
+ 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
+ an unfortunate choice of name on the part of the HTTP 1.1 authors.
+
+ Bottom line: use the gzip format for HTTP 1.1 encoding.
+
+40. Does zlib support the new "Deflate64" format introduced by PKWare?
+
+ No. PKWare has apparently decided to keep that format proprietary, since
+ they have not documented it as they have previous compression formats. In
+ any case, the compression improvements are so modest compared to other more
+ modern approaches, that it's not worth the effort to implement.
+
+41. I'm having a problem with the zip functions in zlib, can you help?
+
+ There are no zip functions in zlib. You are probably using minizip by
+ Giles Vollant, which is found in the contrib directory of zlib. It is not
+ part of zlib. In fact none of the stuff in contrib is part of zlib. The
+ files in there are not supported by the zlib authors. You need to contact
+ the authors of the respective contribution for help.
+
+42. The match.asm code in contrib is under the GNU General Public License.
+ Since it's part of zlib, doesn't that mean that all of zlib falls under the
+ GNU GPL?
+
+ No. The files in contrib are not part of zlib. They were contributed by
+ other authors and are provided as a convenience to the user within the zlib
+ distribution. Each item in contrib has its own license.
+
+43. Is zlib subject to export controls? What is its ECCN?
+
+ zlib is not subject to export controls, and so is classified as EAR99.
+
+44. Can you please sign these lengthy legal documents and fax them back to us
+ so that we can use your software in our product?
+
+ No. Go away. Shoo.
diff --git a/compat/zlib/INDEX b/compat/zlib/INDEX
new file mode 100644
index 0000000..2ba0641
--- /dev/null
+++ b/compat/zlib/INDEX
@@ -0,0 +1,68 @@
+CMakeLists.txt cmake build file
+ChangeLog history of changes
+FAQ Frequently Asked Questions about zlib
+INDEX this file
+Makefile dummy Makefile that tells you to ./configure
+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
+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
+old/ makefiles for various architectures and zlib documentation
+ files that have not yet been updated for zlib 1.2.x
+qnx/ makefiles for QNX
+watcom/ makefiles for OpenWatcom
+win32/ makefiles for Windows
+
+ zlib public header files (required for library use):
+zconf.h
+zlib.h
+
+ private source files used to build the zlib library:
+adler32.c
+compress.c
+crc32.c
+crc32.h
+deflate.c
+deflate.h
+gzclose.c
+gzguts.h
+gzlib.c
+gzread.c
+gzwrite.c
+infback.c
+inffast.c
+inffast.h
+inffixed.h
+inflate.c
+inflate.h
+inftrees.c
+inftrees.h
+trees.c
+trees.h
+uncompr.c
+zutil.c
+zutil.h
+
+ source files for sample programs
+See examples/README.examples
+
+ unsupported contributions by third parties
+See contrib/README.contrib
diff --git a/compat/zlib/Makefile b/compat/zlib/Makefile
new file mode 100644
index 0000000..6bba86c
--- /dev/null
+++ b/compat/zlib/Makefile
@@ -0,0 +1,5 @@
+all:
+ -@echo "Please use ./configure first. Thank you."
+
+distclean:
+ make -f Makefile.in distclean
diff --git a/compat/zlib/Makefile.in b/compat/zlib/Makefile.in
new file mode 100644
index 0000000..c61aa30
--- /dev/null
+++ b/compat/zlib/Makefile.in
@@ -0,0 +1,288 @@
+# Makefile for zlib
+# Copyright (C) 1995-2013 Jean-loup Gailly, Mark Adler
+# For conditions of distribution and use, see copyright notice in zlib.h
+
+# To compile and test, type:
+# ./configure; make test
+# Normally configure builds both a static and a shared library.
+# If you want to build just a static library, use: ./configure --static
+
+# To use the asm code, type:
+# cp contrib/asm?86/match.S ./match.S
+# make LOC=-DASMV OBJA=match.o
+
+# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type:
+# make install
+# To install in $HOME instead of /usr/local, use:
+# make install prefix=$HOME
+
+CC=cc
+
+CFLAGS=-O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-g -DDEBUG
+#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+# -Wstrict-prototypes -Wmissing-prototypes
+
+SFLAGS=-O
+LDFLAGS=
+TEST_LDFLAGS=-L. libz.a
+LDSHARED=$(CC)
+CPP=$(CC) -E
+
+STATICLIB=libz.a
+SHAREDLIB=libz.so
+SHAREDLIBV=libz.so.1.2.8
+SHAREDLIBM=libz.so.1
+LIBS=$(STATICLIB) $(SHAREDLIBV)
+
+AR=ar
+ARFLAGS=rc
+RANLIB=ranlib
+LDCONFIG=ldconfig
+LDSHAREDLIBC=-lc
+TAR=tar
+SHELL=/bin/sh
+EXE=
+
+prefix = /usr/local
+exec_prefix = ${prefix}
+libdir = ${exec_prefix}/lib
+sharedlibdir = ${libdir}
+includedir = ${prefix}/include
+mandir = ${prefix}/share/man
+man3dir = ${mandir}/man3
+pkgconfigdir = ${libdir}/pkgconfig
+
+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_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 =
+PIC_OBJA =
+
+OBJS = $(OBJC) $(OBJA)
+
+PIC_OBJS = $(PIC_OBJC) $(PIC_OBJA)
+
+all: static shared
+
+static: example$(EXE) minigzip$(EXE)
+
+shared: examplesh$(EXE) minigzipsh$(EXE)
+
+all64: example64$(EXE) minigzip64$(EXE)
+
+check: test
+
+test: all teststatic testshared
+
+teststatic: static
+ @TMPST=tmpst_$$; \
+ if echo hello world | ./minigzip | ./minigzip -d && ./example $$TMPST ; then \
+ echo ' *** zlib test OK ***'; \
+ else \
+ echo ' *** zlib test FAILED ***'; false; \
+ 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; \
+ TMPSH=tmpsh_$$; \
+ 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 $$TMPSH
+
+test64: all64
+ @TMP64=tmp64_$$; \
+ 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 $$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) $(ARFLAGS) $@ $(OBJS)
+ -@ ($(RANLIB) $@ || true) >/dev/null 2>&1
+
+match.o: match.S
+ $(CPP) match.S > _match.s
+ $(CC) -c _match.s
+ mv _match.o match.o
+ rm -f _match.s
+
+match.lo: match.S
+ $(CPP) match.S > _match.s
+ $(CC) -c -fPIC _match.s
+ mv _match.o match.lo
+ rm -f _match.s
+
+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: test/minigzip.c zlib.h zconf.h
+ $(CC) $(CFLAGS) -I. -D_FILE_OFFSET_BITS=64 -c -o $@ test/minigzip.c
+
+.SUFFIXES: .lo
+
+.c.lo:
+ -@mkdir objs 2>/dev/null || test -d objs
+ $(CC) $(SFLAGS) -DPIC -c -o objs/$*.o $<
+ -@mv objs/$*.o $@
+
+placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a
+ $(LDSHARED) $(SFLAGS) -o $@ $(PIC_OBJS) $(LDSHAREDLIBC) $(LDFLAGS)
+ rm -f $(SHAREDLIB) $(SHAREDLIBM)
+ ln -s $@ $(SHAREDLIB)
+ ln -s $@ $(SHAREDLIBM)
+ -@rmdir objs
+
+example$(EXE): example.o $(STATICLIB)
+ $(CC) $(CFLAGS) -o $@ example.o $(TEST_LDFLAGS)
+
+minigzip$(EXE): minigzip.o $(STATICLIB)
+ $(CC) $(CFLAGS) -o $@ minigzip.o $(TEST_LDFLAGS)
+
+examplesh$(EXE): example.o $(SHAREDLIBV)
+ $(CC) $(CFLAGS) -o $@ example.o -L. $(SHAREDLIBV)
+
+minigzipsh$(EXE): minigzip.o $(SHAREDLIBV)
+ $(CC) $(CFLAGS) -o $@ minigzip.o -L. $(SHAREDLIBV)
+
+example64$(EXE): example64.o $(STATICLIB)
+ $(CC) $(CFLAGS) -o $@ example64.o $(TEST_LDFLAGS)
+
+minigzip64$(EXE): minigzip64.o $(STATICLIB)
+ $(CC) $(CFLAGS) -o $@ minigzip64.o $(TEST_LDFLAGS)
+
+install-libs: $(LIBS)
+ -@if [ ! -d $(DESTDIR)$(exec_prefix) ]; then mkdir -p $(DESTDIR)$(exec_prefix); fi
+ -@if [ ! -d $(DESTDIR)$(libdir) ]; then mkdir -p $(DESTDIR)$(libdir); fi
+ -@if [ ! -d $(DESTDIR)$(sharedlibdir) ]; then mkdir -p $(DESTDIR)$(sharedlibdir); fi
+ -@if [ ! -d $(DESTDIR)$(man3dir) ]; then mkdir -p $(DESTDIR)$(man3dir); fi
+ -@if [ ! -d $(DESTDIR)$(pkgconfigdir) ]; then mkdir -p $(DESTDIR)$(pkgconfigdir); fi
+ cp $(STATICLIB) $(DESTDIR)$(libdir)
+ 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)
+ chmod 644 $(DESTDIR)$(man3dir)/zlib.3
+ cp zlib.pc $(DESTDIR)$(pkgconfigdir)
+ chmod 644 $(DESTDIR)$(pkgconfigdir)/zlib.pc
+# The ranlib in install is needed on NeXTSTEP which checks file times
+# ldconfig is for Linux
+
+install: install-libs
+ -@if [ ! -d $(DESTDIR)$(includedir) ]; then mkdir -p $(DESTDIR)$(includedir); fi
+ cp zlib.h zconf.h $(DESTDIR)$(includedir)
+ chmod 644 $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h
+
+uninstall:
+ cd $(DESTDIR)$(includedir) && rm -f zlib.h zconf.h
+ cd $(DESTDIR)$(libdir) && rm -f libz.a; \
+ if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
+ rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \
+ fi
+ cd $(DESTDIR)$(man3dir) && rm -f zlib.3
+ cd $(DESTDIR)$(pkgconfigdir) && rm -f zlib.pc
+
+docs: zlib.3.pdf
+
+zlib.3.pdf: zlib.3
+ groff -mandoc -f H -T ps zlib.3 | ps2pdf - zlib.3.pdf
+
+zconf.h.cmakein: zconf.h.in
+ -@ TEMPFILE=zconfh_$$; \
+ 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
+
+mostlyclean: clean
+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 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
+ -@touch -r Makefile.in Makefile
+
+tags:
+ etags *.[ch]
+
+depend:
+ makedepend -- $(CFLAGS) -- *.[ch]
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+adler32.o zutil.o: zutil.h zlib.h zconf.h
+gzclose.o gzlib.o gzread.o gzwrite.o: zlib.h zconf.h gzguts.h
+compress.o example.o minigzip.o uncompr.o: zlib.h zconf.h
+crc32.o: zutil.h zlib.h zconf.h crc32.h
+deflate.o: deflate.h zutil.h zlib.h zconf.h
+infback.o inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h inffixed.h
+inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
+inftrees.o: zutil.h zlib.h zconf.h inftrees.h
+trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
+
+adler32.lo zutil.lo: zutil.h zlib.h zconf.h
+gzclose.lo gzlib.lo gzread.lo gzwrite.lo: zlib.h zconf.h gzguts.h
+compress.lo example.lo minigzip.lo uncompr.lo: zlib.h zconf.h
+crc32.lo: zutil.h zlib.h zconf.h crc32.h
+deflate.lo: deflate.h zutil.h zlib.h zconf.h
+infback.lo inflate.lo: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h inffixed.h
+inffast.lo: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
+inftrees.lo: zutil.h zlib.h zconf.h inftrees.h
+trees.lo: deflate.h zutil.h zlib.h zconf.h trees.h
diff --git a/compat/zlib/README b/compat/zlib/README
new file mode 100644
index 0000000..5ca9d12
--- /dev/null
+++ b/compat/zlib/README
@@ -0,0 +1,115 @@
+ZLIB DATA COMPRESSION LIBRARY
+
+zlib 1.2.8 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://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 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
+make_vms.com.
+
+Questions about zlib should be sent to <zlib@gzip.org>, or to Gilles Vollant
+<info@winimage.com> for the Windows DLL version. The zlib home page is
+http://zlib.net/ . Before reporting a problem, please check this site to
+verify that you have the latest version of zlib; otherwise get the latest
+version and check whether the problem still exists or not.
+
+PLEASE read the zlib FAQ http://zlib.net/zlib_faq.html before asking for help.
+
+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.8 are documented in the file ChangeLog.
+
+Unsupported third party contributions are provided in directory contrib/ .
+
+zlib is available in Java using the java.util.zip package, documented at
+http://java.sun.com/developer/technicalArticles/Programming/compression/ .
+
+A Perl interface to zlib written by Paul Marquess <pmqs@cpan.org> is available
+at CPAN (Comprehensive Perl Archive Network) sites, including
+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://docs.python.org/library/zlib.html .
+
+zlib is built into tcl: http://wiki.tcl.tk/4610 .
+
+An experimental package to read and write files in .zip format, written on top
+of zlib by Gilles Vollant <info@winimage.com>, is available in the
+contrib/minizip directory of zlib.
+
+
+Notes for some targets:
+
+- For Windows DLL versions, please see win32/DLL_FAQ.txt
+
+- For 64-bit Irix, deflate.c must be compiled without any optimization. With
+ -O, one libpng test fails. The test works in 32 bit mode (with the -n32
+ compiler flag). The compiler bug has been reported to SGI.
+
+- zlib doesn't work with gcc 2.6.3 on a DEC 3000/300LX under OSF/1 2.1 it works
+ when compiled with cc.
+
+- On Digital Unix 4.0D (formely OSF/1) on AlphaServer, the cc option -std1 is
+ necessary to get gzprintf working correctly. This is done by configure.
+
+- zlib doesn't work on HP-UX 9.05 with some versions of /bin/cc. It works with
+ other compilers. Use "make test" to check your compiler.
+
+- gzdopen is not supported on RISCOS or BEOS.
+
+- For PalmOs, see http://palmzlib.sourceforge.net/
+
+
+Acknowledgments:
+
+ The deflate format used by zlib was defined by Phil Katz. The deflate and
+ zlib specifications were written by L. Peter Deutsch. Thanks to all the
+ people who reported problems and suggested various improvements in zlib; they
+ are too numerous to cite here.
+
+Copyright notice:
+
+ (C) 1995-2013 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
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup@gzip.org madler@alumni.caltech.edu
+
+If you use the zlib library in a product, we would appreciate *not* receiving
+lengthy legal documents to sign. The sources are provided for free but without
+warranty of any kind. The library has been entirely written by Jean-loup
+Gailly and Mark Adler; it does not include third-party code.
+
+If you redistribute modified sources, we would appreciate that you include in
+the file ChangeLog history information documenting your changes. Please read
+the FAQ for more information on the distribution of modified source versions.
diff --git a/compat/zlib/adler32.c b/compat/zlib/adler32.c
new file mode 100644
index 0000000..a868f07
--- /dev/null
+++ b/compat/zlib/adler32.c
@@ -0,0 +1,179 @@
+/* adler32.c -- compute the Adler-32 checksum of a data stream
+ * Copyright (C) 1995-2011 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#include "zutil.h"
+
+#define local static
+
+local uLong adler32_combine_ OF((uLong adler1, uLong adler2, z_off64_t len2));
+
+#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 */
+
+#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;}
+#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
+#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
+#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 --
+ try it both ways to see which is faster */
+#ifdef NO_DIVIDE
+/* 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 { \
+ CHOP(a); \
+ if (a >= BASE) a -= BASE; \
+ } while (0)
+# define MOD(a) \
+ do { \
+ 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 MOD28(a) a %= BASE
+# define MOD63(a) a %= BASE
+#endif
+
+/* ========================================================================= */
+uLong ZEXPORT adler32(adler, buf, len)
+ uLong adler;
+ const Bytef *buf;
+ uInt len;
+{
+ unsigned long sum2;
+ unsigned n;
+
+ /* split Adler-32 into component sums */
+ sum2 = (adler >> 16) & 0xffff;
+ adler &= 0xffff;
+
+ /* in case user likes doing a byte at a time, keep it fast */
+ if (len == 1) {
+ adler += buf[0];
+ if (adler >= BASE)
+ adler -= BASE;
+ sum2 += adler;
+ if (sum2 >= BASE)
+ sum2 -= BASE;
+ return adler | (sum2 << 16);
+ }
+
+ /* initial Adler-32 value (deferred check for len == 1 speed) */
+ if (buf == Z_NULL)
+ return 1L;
+
+ /* in case short lengths are provided, keep it somewhat fast */
+ if (len < 16) {
+ while (len--) {
+ adler += *buf++;
+ sum2 += adler;
+ }
+ if (adler >= BASE)
+ adler -= BASE;
+ MOD28(sum2); /* only added so many BASE's */
+ return adler | (sum2 << 16);
+ }
+
+ /* do length NMAX blocks -- requires just one modulo operation */
+ while (len >= NMAX) {
+ len -= NMAX;
+ n = NMAX / 16; /* NMAX is divisible by 16 */
+ do {
+ DO16(buf); /* 16 sums unrolled */
+ buf += 16;
+ } while (--n);
+ MOD(adler);
+ MOD(sum2);
+ }
+
+ /* do remaining bytes (less than NMAX, still just one modulo) */
+ if (len) { /* avoid modulos if none remaining */
+ while (len >= 16) {
+ len -= 16;
+ DO16(buf);
+ buf += 16;
+ }
+ while (len--) {
+ adler += *buf++;
+ sum2 += adler;
+ }
+ MOD(adler);
+ MOD(sum2);
+ }
+
+ /* return recombined sums */
+ return adler | (sum2 << 16);
+}
+
+/* ========================================================================= */
+local uLong adler32_combine_(adler1, adler2, len2)
+ uLong adler1;
+ uLong adler2;
+ z_off64_t len2;
+{
+ unsigned long sum1;
+ 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 */
+ MOD63(len2); /* assumes len2 >= 0 */
+ rem = (unsigned)len2;
+ sum1 = adler1 & 0xffff;
+ sum2 = rem * sum1;
+ MOD(sum2);
+ sum1 += (adler2 & 0xffff) + BASE - 1;
+ sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem;
+ if (sum1 >= BASE) sum1 -= BASE;
+ if (sum1 >= BASE) sum1 -= BASE;
+ if (sum2 >= (BASE << 1)) sum2 -= (BASE << 1);
+ if (sum2 >= BASE) sum2 -= BASE;
+ return sum1 | (sum2 << 16);
+}
+
+/* ========================================================================= */
+uLong ZEXPORT adler32_combine(adler1, adler2, len2)
+ uLong adler1;
+ uLong adler2;
+ z_off_t len2;
+{
+ return adler32_combine_(adler1, adler2, len2);
+}
+
+uLong ZEXPORT adler32_combine64(adler1, adler2, len2)
+ uLong adler1;
+ uLong adler2;
+ z_off64_t len2;
+{
+ return adler32_combine_(adler1, adler2, len2);
+}
diff --git a/compat/zlib/amiga/Makefile.pup b/compat/zlib/amiga/Makefile.pup
new file mode 100644
index 0000000..8940c12
--- /dev/null
+++ b/compat/zlib/amiga/Makefile.pup
@@ -0,0 +1,69 @@
+# Amiga powerUP (TM) Makefile
+# makefile for libpng and SAS C V6.58/7.00 PPC compiler
+# Copyright (C) 1998 by Andreas R. Kleinert
+
+LIBNAME = libzip.a
+
+CC = scppc
+CFLAGS = NOSTKCHK NOSINT OPTIMIZE OPTGO OPTPEEP OPTINLOCAL OPTINL \
+ OPTLOOP OPTRDEP=8 OPTDEP=8 OPTCOMP=8 NOVER
+AR = ppc-amigaos-ar cr
+RANLIB = ppc-amigaos-ranlib
+LD = ppc-amigaos-ld -r
+LDFLAGS = -o
+LDLIBS = LIB:scppc.a LIB:end.o
+RM = delete quiet
+
+OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
+ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example minigzip
+
+check: test
+test: all
+ example
+ echo hello world | minigzip | minigzip -d
+
+$(LIBNAME): $(OBJS)
+ $(AR) $@ $(OBJS)
+ -$(RANLIB) $@
+
+example: example.o $(LIBNAME)
+ $(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)
+
+minigzip: minigzip.o $(LIBNAME)
+ $(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)
+
+mostlyclean: clean
+clean:
+ $(RM) *.o example minigzip $(LIBNAME) foo.gz
+
+zip:
+ zip -ul9 zlib README ChangeLog Makefile Make????.??? Makefile.?? \
+ descrip.mms *.[ch]
+
+tgz:
+ cd ..; tar cfz zlib/zlib.tgz zlib/README zlib/ChangeLog zlib/Makefile \
+ zlib/Make????.??? zlib/Makefile.?? zlib/descrip.mms zlib/*.[ch]
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+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
+gzwrite.o: zlib.h zconf.h gzguts.h
+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/amiga/Makefile.sas b/compat/zlib/amiga/Makefile.sas
new file mode 100644
index 0000000..749e291
--- /dev/null
+++ b/compat/zlib/amiga/Makefile.sas
@@ -0,0 +1,68 @@
+# SMakefile for zlib
+# Modified from the standard UNIX Makefile Copyright Jean-loup Gailly
+# Osma Ahvenlampi <Osma.Ahvenlampi@hut.fi>
+# Amiga, SAS/C 6.56 & Smake
+
+CC=sc
+CFLAGS=OPT
+#CFLAGS=OPT CPU=68030
+#CFLAGS=DEBUG=LINE
+LDFLAGS=LIB z.lib
+
+SCOPTIONS=OPTSCHED OPTINLINE OPTALIAS OPTTIME OPTINLOCAL STRMERGE \
+ NOICONS PARMS=BOTH NOSTACKCHECK UTILLIB NOVERSION ERRORREXX \
+ DEF=POSTINC
+
+OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
+ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: SCOPTIONS example minigzip
+
+check: test
+test: all
+ example
+ echo hello world | minigzip | minigzip -d
+
+install: z.lib
+ copy clone zlib.h zconf.h INCLUDE:
+ copy clone z.lib LIB:
+
+z.lib: $(OBJS)
+ oml z.lib r $(OBJS)
+
+example: example.o z.lib
+ $(CC) $(CFLAGS) LINK TO $@ example.o $(LDFLAGS)
+
+minigzip: minigzip.o z.lib
+ $(CC) $(CFLAGS) LINK TO $@ minigzip.o $(LDFLAGS)
+
+mostlyclean: clean
+clean:
+ -delete force quiet example minigzip *.o z.lib foo.gz *.lnk SCOPTIONS
+
+SCOPTIONS: Makefile.sas
+ copy to $@ <from <
+$(SCOPTIONS)
+<
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+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
+gzwrite.o: zlib.h zconf.h gzguts.h
+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/as400/bndsrc b/compat/zlib/as400/bndsrc
new file mode 100644
index 0000000..98814fd
--- /dev/null
+++ b/compat/zlib/as400/bndsrc
@@ -0,0 +1,215 @@
+STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('ZLIB')
+
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+/* Version 1.1.3 entry points. */
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+
+/********************************************************************/
+/* *MODULE ADLER32 ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("adler32")
+
+/********************************************************************/
+/* *MODULE COMPRESS ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("compress")
+ EXPORT SYMBOL("compress2")
+
+/********************************************************************/
+/* *MODULE CRC32 ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("crc32")
+ EXPORT SYMBOL("get_crc_table")
+
+/********************************************************************/
+/* *MODULE DEFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("deflate")
+ EXPORT SYMBOL("deflateEnd")
+ EXPORT SYMBOL("deflateSetDictionary")
+ EXPORT SYMBOL("deflateCopy")
+ EXPORT SYMBOL("deflateReset")
+ EXPORT SYMBOL("deflateParams")
+ EXPORT SYMBOL("deflatePrime")
+ EXPORT SYMBOL("deflateInit_")
+ EXPORT SYMBOL("deflateInit2_")
+
+/********************************************************************/
+/* *MODULE GZIO ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzopen")
+ EXPORT SYMBOL("gzdopen")
+ EXPORT SYMBOL("gzsetparams")
+ EXPORT SYMBOL("gzread")
+ EXPORT SYMBOL("gzwrite")
+ EXPORT SYMBOL("gzprintf")
+ EXPORT SYMBOL("gzputs")
+ EXPORT SYMBOL("gzgets")
+ EXPORT SYMBOL("gzputc")
+ EXPORT SYMBOL("gzgetc")
+ EXPORT SYMBOL("gzflush")
+ EXPORT SYMBOL("gzseek")
+ EXPORT SYMBOL("gzrewind")
+ EXPORT SYMBOL("gztell")
+ EXPORT SYMBOL("gzeof")
+ EXPORT SYMBOL("gzclose")
+ EXPORT SYMBOL("gzerror")
+
+/********************************************************************/
+/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflate")
+ EXPORT SYMBOL("inflateEnd")
+ EXPORT SYMBOL("inflateSetDictionary")
+ EXPORT SYMBOL("inflateSync")
+ EXPORT SYMBOL("inflateReset")
+ EXPORT SYMBOL("inflateInit_")
+ EXPORT SYMBOL("inflateInit2_")
+ EXPORT SYMBOL("inflateSyncPoint")
+
+/********************************************************************/
+/* *MODULE UNCOMPR ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("uncompress")
+
+/********************************************************************/
+/* *MODULE ZUTIL ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("zlibVersion")
+ EXPORT SYMBOL("zError")
+
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+/* Version 1.2.1 additional entry points. */
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+
+/********************************************************************/
+/* *MODULE COMPRESS ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("compressBound")
+
+/********************************************************************/
+/* *MODULE DEFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("deflateBound")
+
+/********************************************************************/
+/* *MODULE GZIO ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("gzungetc")
+ EXPORT SYMBOL("gzclearerr")
+
+/********************************************************************/
+/* *MODULE INFBACK ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflateBack")
+ EXPORT SYMBOL("inflateBackEnd")
+ EXPORT SYMBOL("inflateBackInit_")
+
+/********************************************************************/
+/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflateCopy")
+
+/********************************************************************/
+/* *MODULE ZUTIL ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ 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")
+
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+/* Version 1.2.8 additional entry points. */
+/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
+
+/********************************************************************/
+/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */
+/********************************************************************/
+
+ EXPORT SYMBOL("inflateGetDictionary")
+
+ENDPGMEXP
diff --git a/compat/zlib/as400/compile.clp b/compat/zlib/as400/compile.clp
new file mode 100644
index 0000000..e3f47c6
--- /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.8') TGTRLS(&TGTRLS)
+
+ ENDPGM
diff --git a/compat/zlib/as400/readme.txt b/compat/zlib/as400/readme.txt
new file mode 100644
index 0000000..7b5d93b
--- /dev/null
+++ b/compat/zlib/as400/readme.txt
@@ -0,0 +1,115 @@
+ ZLIB version 1.2.8 for AS400 installation instructions
+
+I) From an AS400 *SAVF file:
+
+1) Unpacking archive to an AS400 save file
+
+On the AS400:
+
+_ Create the ZLIB AS400 library:
+
+ CRTLIB LIB(ZLIB) TYPE(*PROD) TEXT('ZLIB compression API library')
+
+_ Create a work save file, for example:
+
+ CRTSAVF FILE(ZLIB/ZLIBSAVF)
+
+On a PC connected to the target AS400:
+
+_ Unpack the save file image to a PC file "ZLIBSAVF"
+_ Upload this file into the save file on the AS400, for example
+ using ftp in BINARY mode.
+
+
+2) Populating the ZLIB AS400 source library
+
+On the AS400:
+
+_ Extract the saved objects into the ZLIB AS400 library using:
+
+RSTOBJ OBJ(*ALL) SAVLIB(ZLIB) DEV(*SAVF) SAVF(ZLIB/ZLIBSAVF) RSTLIB(ZLIB)
+
+
+3) Customize installation:
+
+_ Edit CL member ZLIB/TOOLS(COMPILE) and change parameters if needed,
+ according to the comments.
+
+_ Compile this member with:
+
+ CRTCLPGM PGM(ZLIB/COMPILE) SRCFILE(ZLIB/TOOLS) SRCMBR(COMPILE)
+
+
+4) Compile and generate the service program:
+
+_ This can now be done by executing:
+
+ CALL PGM(ZLIB/COMPILE)
+
+
+
+II) From the original source distribution:
+
+1) On the AS400, create the source library:
+
+ CRTLIB LIB(ZLIB) TYPE(*PROD) TEXT('ZLIB compression API library')
+
+2) Create the source files:
+
+ CRTSRCPF FILE(ZLIB/SOURCES) RCDLEN(112) TEXT('ZLIB library modules')
+ CRTSRCPF FILE(ZLIB/H) RCDLEN(112) TEXT('ZLIB library includes')
+ CRTSRCPF FILE(ZLIB/TOOLS) RCDLEN(112) TEXT('ZLIB library control utilities')
+
+3) From the machine hosting the distribution files, upload them (with
+ FTP in text mode, for example) according to the following table:
+
+ Original AS400 AS400 AS400 AS400
+ file file member type description
+ SOURCES Original ZLIB C subprogram sources
+ adler32.c ADLER32 C ZLIB - Compute the Adler-32 checksum of a dta strm
+ 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
+ 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
+ inftrees.c INFTREES C ZLIB - Generate Huffman trees for efficient decode
+ trees.c TREES C ZLIB - Output deflated data using Huffman coding
+ uncompr.c UNCOMPR C ZLIB - Decompress a memory buffer
+ zutil.c ZUTIL C ZLIB - Target dependent utility functions
+ 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
+ inftrees.h INFTREES C ZLIB - Header to use inftrees.c
+ trees.h TREES C ZLIB - Created automatically with -DGEN_TREES_H
+ zconf.h ZCONF C ZLIB - Compression library configuration
+ zlib.h ZLIB C ZLIB - Compression library C user interface
+ as400/zlib.inc ZLIB.INC RPGLE ZLIB - Compression library ILE RPG user interface
+ zutil.h ZUTIL C ZLIB - Internal interface and configuration
+ TOOLS Building source software & AS/400 README
+ as400/bndsrc BNDSRC Entry point exportation list
+ as400/compile.clp COMPILE CLP Compile sources & generate service program
+ as400/readme.txt README TXT Installation instructions
+
+4) Continue as in I)3).
+
+
+
+
+Notes: For AS400 ILE RPG programmers, a /copy member defining the ZLIB
+ API prototypes for ILE RPG can be found in ZLIB/H(ZLIB.INC).
+ Please read comments in this member for more information.
+
+ Remember that most foreign textual data are ASCII coded: this
+ implementation does not handle conversion from/to ASCII, so
+ text data code conversions must be done explicitely.
+
+ Mainly for the reason above, always open zipped files in binary mode.
diff --git a/compat/zlib/as400/zlib.inc b/compat/zlib/as400/zlib.inc
new file mode 100644
index 0000000..7341a6d
--- /dev/null
+++ b/compat/zlib/as400/zlib.inc
@@ -0,0 +1,451 @@
+ * ZLIB.INC - Interface to the general purpose compression library
+ *
+ * ILE RPG400 version by Patrick Monnerat, DATASPHERE.
+ * Version 1.2.8
+ *
+ *
+ * WARNING:
+ * Procedures inflateInit(), inflateInit2(), deflateInit(),
+ * deflateInit2() and inflateBackInit() need to be called with
+ * two additional arguments:
+ * the package version string and the stream control structure.
+ * size. This is needed because RPG lacks some macro feature.
+ * Call these procedures as:
+ * inflateInit(...: ZLIB_VERSION: %size(z_stream))
+ *
+ /if not defined(ZLIB_H_)
+ /define ZLIB_H_
+ *
+ **************************************************************************
+ * Constants
+ **************************************************************************
+ *
+ * Versioning information.
+ *
+ D ZLIB_VERSION C '1.2.8'
+ D ZLIB_VERNUM C X'1280'
+ D ZLIB_VER_MAJOR C 1
+ D ZLIB_VER_MINOR C 2
+ D ZLIB_VER_REVISION...
+ D C 8
+ 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
+ D Z_NEED_DICT C 2
+ D Z_ERRNO C -1
+ D Z_STREAM_ERROR C -2
+ D Z_DATA_ERROR C -3
+ D Z_MEM_ERROR C -4
+ D Z_BUF_ERROR C -5
+ DZ_VERSION_ERROR C -6
+ *
+ D Z_NO_COMPRESSION...
+ D C 0
+ D Z_BEST_SPEED C 1
+ D Z_BEST_COMPRESSION...
+ D C 9
+ D Z_DEFAULT_COMPRESSION...
+ D C -1
+ *
+ D Z_FILTERED C 1
+ D Z_HUFFMAN_ONLY C 2
+ D Z_RLE C 3
+ D Z_DEFAULT_STRATEGY...
+ D C 0
+ *
+ D Z_BINARY C 0
+ D Z_ASCII C 1
+ D Z_UNKNOWN C 2
+ *
+ D Z_DEFLATED C 8
+ *
+ D Z_NULL C 0
+ *
+ **************************************************************************
+ * Types
+ **************************************************************************
+ *
+ 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
+ **************************************************************************
+ *
+ * The GZIP encode/decode stream support structure.
+ *
+ D z_stream DS align based(z_streamp)
+ D zs_next_in * Next input byte
+ D zs_avail_in 10U 0 Byte cnt at next_in
+ D zs_total_in 10U 0 Total bytes read
+ D zs_next_out * Output buffer ptr
+ D zs_avail_out 10U 0 Room left @ next_out
+ D zs_total_out 10U 0 Total bytes written
+ D zs_msg * Last errmsg or null
+ D zs_state * Internal state
+ D zs_zalloc * procptr Int. state allocator
+ D zs_free * procptr Int. state dealloc.
+ D zs_opaque * Private alloc. data
+ D zs_data_type 10i 0 ASC/BIN best guess
+ D zs_adler 10u 0 Uncompr. adler32 val
+ D 10U 0 Reserved
+ D 10U 0 Ptr. alignment
+ *
+ **************************************************************************
+ * Utility function prototypes
+ **************************************************************************
+ *
+ D compress PR 10I 0 extproc('compress')
+ D dest 65535 options(*varsize) Destination buffer
+ D destLen 10U 0 Destination length
+ D source 65535 const options(*varsize) Source buffer
+ D sourceLen 10u 0 value Source length
+ *
+ D compress2 PR 10I 0 extproc('compress2')
+ D dest 65535 options(*varsize) Destination buffer
+ D destLen 10U 0 Destination length
+ D source 65535 const options(*varsize) Source buffer
+ D sourceLen 10U 0 value Source length
+ D level 10I 0 value Compression level
+ *
+ D compressBound PR 10U 0 extproc('compressBound')
+ D sourceLen 10U 0 value
+ *
+ D uncompress PR 10I 0 extproc('uncompress')
+ D dest 65535 options(*varsize) Destination buffer
+ D destLen 10U 0 Destination length
+ 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 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 gzread PR 10I 0 extproc('gzread')
+ D file value like(gzFile) File pointer
+ 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 65535 const options(*varsize) Buffer
+ D len 10u 0 value Buffer length
+ *
+ D gzputs PR 10I 0 extproc('gzputs')
+ D file value like(gzFile) File pointer
+ D s * value options(*string) String to output
+ *
+ D gzgets PR * extproc('gzgets')
+ D file value like(gzFile) File pointer
+ 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
+ *
+ D gzerror PR * extproc('gzerror') Error string
+ D file value like(gzFile) File pointer
+ D errnum 10I 0 Error code
+ *
+ D gzclearerr PR extproc('gzclearerr')
+ D file value like(gzFile) File pointer
+ *
+ **************************************************************************
+ * Basic function prototypes
+ **************************************************************************
+ *
+ D zlibVersion PR * extproc('zlibVersion') Version string
+ *
+ D deflateInit PR 10I 0 extproc('deflateInit_') Init. compression
+ D strm like(z_stream) Compression stream
+ D level 10I 0 value Compression level
+ D version * value options(*string) Version string
+ D stream_size 10i 0 value Stream struct. size
+ *
+ D deflate PR 10I 0 extproc('deflate') Compress data
+ D strm like(z_stream) Compression stream
+ D flush 10I 0 value Flush type required
+ *
+ D deflateEnd PR 10I 0 extproc('deflateEnd') Termin. compression
+ D strm like(z_stream) Compression stream
+ *
+ D inflateInit PR 10I 0 extproc('inflateInit_') Init. expansion
+ D strm like(z_stream) Expansion stream
+ D version * value options(*string) Version string
+ D stream_size 10i 0 value Stream struct. size
+ *
+ D inflate PR 10I 0 extproc('inflate') Expand data
+ D strm like(z_stream) Expansion stream
+ D flush 10I 0 value Flush type required
+ *
+ D inflateEnd PR 10I 0 extproc('inflateEnd') Termin. expansion
+ D strm like(z_stream) Expansion stream
+ *
+ **************************************************************************
+ * Advanced function prototypes
+ **************************************************************************
+ *
+ D deflateInit2 PR 10I 0 extproc('deflateInit2_') Init. compression
+ D strm like(z_stream) Compression stream
+ D level 10I 0 value Compression level
+ D method 10I 0 value Compression method
+ D windowBits 10I 0 value log2(window size)
+ D memLevel 10I 0 value Mem/cmpress tradeoff
+ D strategy 10I 0 value Compression stategy
+ D version * value options(*string) Version string
+ D stream_size 10i 0 value Stream struct. size
+ *
+ D deflateSetDictionary...
+ D PR 10I 0 extproc('deflateSetDictionary') Init. dictionary
+ D strm like(z_stream) Compression stream
+ 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
+ D dest like(z_stream) Destination stream
+ D source like(z_stream) Source stream
+ *
+ D deflateReset PR 10I 0 extproc('deflateReset') End and init. stream
+ D strm like(z_stream) Compression stream
+ *
+ D deflateParams PR 10I 0 extproc('deflateParams') Change level & strat
+ D strm like(z_stream) Compression stream
+ D level 10I 0 value Compression level
+ D strategy 10I 0 value Compression stategy
+ *
+ D deflateBound PR 10U 0 extproc('deflateBound') Change level & strat
+ 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 # of bits to insert
+ D value 10I 0 value Bits to insert
+ *
+ D inflateInit2 PR 10I 0 extproc('inflateInit2_') Init. expansion
+ D strm like(z_stream) Expansion stream
+ D windowBits 10I 0 value log2(window size)
+ D version * value options(*string) Version string
+ D stream_size 10i 0 value Stream struct. size
+ *
+ D inflateSetDictionary...
+ D PR 10I 0 extproc('inflateSetDictionary') Init. dictionary
+ D strm like(z_stream) Expansion stream
+ D dictionary 65535 const options(*varsize) Dictionary bytes
+ D dictLength 10U 0 value Dictionary length
+ *
+ D inflateGetDictionary...
+ D PR 10I 0 extproc('inflateGetDictionary') Get dictionary
+ D strm like(z_stream) Expansion stream
+ D dictionary 65535 options(*varsize) Dictionary bytes
+ D dictLength 10U 0 Dictionary length
+ *
+ D inflateSync PR 10I 0 extproc('inflateSync') Sync. expansion
+ D strm like(z_stream) Expansion stream
+ *
+ D inflateCopy PR 10I 0 extproc('inflateCopy')
+ D dest like(z_stream) Destination stream
+ D source like(z_stream) Source stream
+ *
+ 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 65535 options(*varsize) Buffer
+ D version * value options(*string) Version string
+ D stream_size 10i 0 value Stream struct. size
+ *
+ D inflateBack PR 10I 0 extproc('inflateBack')
+ D strm like(z_stream) Expansion stream
+ D in * value procptr Input function
+ D in_desc * value Input descriptor
+ D out * value procptr Output function
+ D out_desc * value Output descriptor
+ *
+ D inflateBackEnd PR 10I 0 extproc('inflateBackEnd')
+ D strm like(z_stream) Expansion stream
+ *
+ D zlibCompileFlags...
+ D PR 10U 0 extproc('zlibCompileFlags')
+ *
+ **************************************************************************
+ * Checksum function prototypes
+ **************************************************************************
+ *
+ D adler32 PR 10U 0 extproc('adler32') New checksum
+ D adler 10U 0 value Old checksum
+ 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 65535 const options(*varsize) Bytes to accumulate
+ D len 10U 0 value Buffer length
+ *
+ **************************************************************************
+ * Miscellaneous function prototypes
+ **************************************************************************
+ *
+ D zError PR * extproc('zError') Error string
+ D err 10I 0 value Error code
+ *
+ D inflateSyncPoint...
+ D PR 10I 0 extproc('inflateSyncPoint')
+ D strm like(z_stream) Expansion stream
+ *
+ 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
new file mode 100644
index 0000000..6e97626
--- /dev/null
+++ b/compat/zlib/compress.c
@@ -0,0 +1,80 @@
+/* compress.c -- compress a memory buffer
+ * Copyright (C) 1995-2005 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#define ZLIB_INTERNAL
+#include "zlib.h"
+
+/* ===========================================================================
+ Compresses the source buffer into the destination buffer. The level
+ parameter has the same meaning as in deflateInit. sourceLen is the byte
+ length of the source buffer. Upon entry, destLen is the total size of the
+ destination buffer, which must be at least 0.1% larger than sourceLen plus
+ 12 bytes. Upon exit, destLen is the actual size of the compressed buffer.
+
+ compress2 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,
+ Z_STREAM_ERROR if the level parameter is invalid.
+*/
+int ZEXPORT compress2 (dest, destLen, source, sourceLen, level)
+ Bytef *dest;
+ uLongf *destLen;
+ const Bytef *source;
+ uLong sourceLen;
+ int level;
+{
+ z_stream stream;
+ int err;
+
+ stream.next_in = (z_const Bytef *)source;
+ stream.avail_in = (uInt)sourceLen;
+#ifdef MAXSEG_64K
+ /* Check for source > 64K on 16-bit machine: */
+ if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR;
+#endif
+ stream.next_out = dest;
+ stream.avail_out = (uInt)*destLen;
+ if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR;
+
+ stream.zalloc = (alloc_func)0;
+ stream.zfree = (free_func)0;
+ stream.opaque = (voidpf)0;
+
+ err = deflateInit(&stream, level);
+ if (err != Z_OK) return err;
+
+ err = deflate(&stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ deflateEnd(&stream);
+ return err == Z_OK ? Z_BUF_ERROR : err;
+ }
+ *destLen = stream.total_out;
+
+ err = deflateEnd(&stream);
+ return err;
+}
+
+/* ===========================================================================
+ */
+int ZEXPORT compress (dest, destLen, source, sourceLen)
+ Bytef *dest;
+ uLongf *destLen;
+ const Bytef *source;
+ uLong sourceLen;
+{
+ return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION);
+}
+
+/* ===========================================================================
+ If the default memLevel or windowBits for deflateInit() is changed, then
+ this function needs to be updated.
+ */
+uLong ZEXPORT compressBound (sourceLen)
+ uLong sourceLen;
+{
+ return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
+ (sourceLen >> 25) + 13;
+}
diff --git a/compat/zlib/configure b/compat/zlib/configure
new file mode 100755
index 0000000..b77a8a8
--- /dev/null
+++ b/compat/zlib/configure
@@ -0,0 +1,831 @@
+#!/bin/sh
+# configure script for zlib.
+#
+# Normally configure builds both a static and a shared library.
+# If you want to build just a static library, use: ./configure --static
+#
+# To impose specific compiler or flags or install directory, use for example:
+# prefix=$HOME CC=cc CFLAGS="-O4" ./configure
+# or for csh/tcsh users:
+# (setenv prefix $HOME; setenv CC cc; setenv CFLAGS "-O4"; ./configure)
+
+# Incorrect settings of CC or CFLAGS may prevent creating a shared library.
+# 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/'`"
+ CROSS_PREFIX="${CHOST}-"
+fi
+
+# destination name for static library
+STATICLIB=libz.a
+
+# 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} | tee -a configure.log
+else
+ AR=${AR-"ar"}
+ test -n "${CROSS_PREFIX}" && echo Using ${AR} | tee -a configure.log
+fi
+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} | 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} | 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'}
+sharedlibdir=${sharedlibdir-'${libdir}'}
+includedir=${includedir-'${prefix}/include'}
+mandir=${mandir-'${prefix}/share/man'}
+shared_ext='.so'
+shared=1
+solo=0
+cover=0
+zprefix=0
+zconst=0
+build64=0
+gcc=0
+old_cc="$CC"
+old_cflags="$CFLAGS"
+OBJC='$(OBJZ) $(OBJG)'
+PIC_OBJC='$(PIC_OBJZ) $(PIC_OBJG)'
+
+# leave this script, optionally in a bad way
+leave()
+{
+ if test "$*" != "0"; then
+ echo "** $0 aborting." | tee -a configure.log
+ fi
+ rm -f $test.[co] $test $test$shared_ext $test.gcno ./--version
+ echo -------------------- >> configure.log
+ echo >> configure.log
+ echo >> configure.log
+ exit $1
+}
+
+# process command line options
+while test $# -ge 1
+do
+case "$1" in
+ -h* | --help)
+ echo 'usage:' | tee -a configure.log
+ echo ' configure [--const] [--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 ;;
+ -l*=* | --libdir=*) libdir=`echo $1 | sed 's/.*=//'`; shift ;;
+ --sharedlibdir=*) sharedlibdir=`echo $1 | sed 's/.*=//'`; shift ;;
+ -i*=* | --includedir=*) includedir=`echo $1 | sed 's/.*=//'`;shift ;;
+ -u*=* | --uname=*) uname=`echo $1 | sed 's/.*=//'`;shift ;;
+ -p* | --prefix) prefix="$2"; shift; shift ;;
+ -e* | --eprefix) exec_prefix="$2"; shift; shift ;;
+ -l* | --libdir) libdir="$2"; shift; shift ;;
+ -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 ;;
+ -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 ;;
+ -c* | --const) zconst=1; shift ;;
+ *)
+ echo "unknown option: $1" | tee -a configure.log
+ echo "$0 --help for help" | tee -a configure.log
+ leave 1;;
+ esac
+done
+
+# temporary file name
+test=ztest$$
+
+# put arguments in log, also put test file in log if used in arguments
+show()
+{
+ case "$*" in
+ *$test.c*)
+ echo === $test.c === >> configure.log
+ cat $test.c >> configure.log
+ echo === >> configure.log;;
+ esac
+ 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... | 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
+
+show $cc -c $test.c
+if test "$gcc" -eq 1 && ($cc -c $test.c) >> configure.log 2>&1; then
+ echo ... using gcc >> configure.log
+ CC="$cc"
+ CFLAGS="${CFLAGS--O3} ${ARCHS}"
+ SFLAGS="${CFLAGS--O3} -fPIC"
+ LDFLAGS="${LDFLAGS} ${ARCHS}"
+ if test $build64 -eq 1; then
+ CFLAGS="${CFLAGS} -m64"
+ SFLAGS="${SFLAGS} -m64"
+ fi
+ if test "${ZLIBGCCWARN}" = "YES"; then
+ if test "$zconst" -eq 1; then
+ CFLAGS="${CFLAGS} -Wall -Wextra -Wcast-qual -pedantic -DZLIB_CONST"
+ else
+ CFLAGS="${CFLAGS} -Wall -Wextra -pedantic"
+ fi
+ fi
+ if test -z "$uname"; then
+ uname=`(uname -s || echo unknown) 2>/dev/null`
+ fi
+ case "$uname" in
+ 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*)
+# temporary bypass
+ rm -f $test.[co] $test $test$shared_ext
+ echo "Please use win32/Makefile.gcc instead." | tee -a configure.log
+ leave 1
+ LDSHARED=${LDSHARED-"$cc -shared"}
+ LDSHAREDLIBC=""
+ EXE='.exe' ;;
+ QNX*) # This is for QNX6. I suppose that the QNX rule below is for QNX2,QNX4
+ # (alain.bonnefoy@icbt.com)
+ LDSHARED=${LDSHARED-"$cc -shared -Wl,-hlibz.so.1"} ;;
+ HP-UX*)
+ LDSHARED=${LDSHARED-"$cc -shared $SFLAGS"}
+ case `(uname -m || echo unknown) 2>/dev/null` in
+ ia64)
+ shared_ext='.so'
+ SHAREDLIB='libz.so' ;;
+ *)
+ shared_ext='.sl'
+ SHAREDLIB='libz.sl' ;;
+ esac ;;
+ 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"}
+ if libtool -V 2>&1 | grep Apple > /dev/null; then
+ AR="libtool"
+ else
+ AR="/usr/bin/libtool"
+ fi
+ 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
+ case "$uname" in
+ HP-UX*) SFLAGS=${CFLAGS-"-O +z"}
+ CFLAGS=${CFLAGS-"-O"}
+# LDSHARED=${LDSHARED-"ld -b +vnocompatwarnings"}
+ LDSHARED=${LDSHARED-"ld -b"}
+ case `(uname -m || echo unknown) 2>/dev/null` in
+ ia64)
+ shared_ext='.so'
+ SHAREDLIB='libz.so' ;;
+ *)
+ shared_ext='.sl'
+ SHAREDLIB='libz.sl' ;;
+ esac ;;
+ IRIX*) SFLAGS=${CFLAGS-"-ansi -O2 -rpath ."}
+ CFLAGS=${CFLAGS-"-ansi -O2"}
+ LDSHARED=${LDSHARED-"cc -shared -Wl,-soname,libz.so.1"} ;;
+ OSF1\ V4*) SFLAGS=${CFLAGS-"-O -std1"}
+ CFLAGS=${CFLAGS-"-O -std1"}
+ LDFLAGS="${LDFLAGS} -Wl,-rpath,."
+ LDSHARED=${LDSHARED-"cc -shared -Wl,-soname,libz.so -Wl,-msym -Wl,-rpath,$(libdir) -Wl,-set_version,${VER}:1.0"} ;;
+ OSF1*) SFLAGS=${CFLAGS-"-O -std1"}
+ CFLAGS=${CFLAGS-"-O -std1"}
+ LDSHARED=${LDSHARED-"cc -shared -Wl,-soname,libz.so.1"} ;;
+ QNX*) SFLAGS=${CFLAGS-"-4 -O"}
+ CFLAGS=${CFLAGS-"-4 -O"}
+ LDSHARED=${LDSHARED-"cc"}
+ RANLIB=${RANLIB-"true"}
+ AR="cc"
+ ARFLAGS="-A" ;;
+ SCO_SV\ 3.2*) SFLAGS=${CFLAGS-"-O3 -dy -KPIC "}
+ CFLAGS=${CFLAGS-"-O3"}
+ LDSHARED=${LDSHARED-"cc -dy -KPIC -G"} ;;
+ 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"} ;;
+ SunStudio\ 9*) SFLAGS=${CFLAGS-"-fast -xcode=pic32 -xtarget=ultra3 -xarch=v9b"}
+ CFLAGS=${CFLAGS-"-fast -xtarget=ultra3 -xarch=v9b"}
+ LDSHARED=${LDSHARED-"cc -xarch=v9b"} ;;
+ UNIX_System_V\ 4.2.0)
+ SFLAGS=${CFLAGS-"-KPIC -O"}
+ CFLAGS=${CFLAGS-"-O"}
+ LDSHARED=${LDSHARED-"cc -G"} ;;
+ UNIX_SV\ 4.2MP)
+ SFLAGS=${CFLAGS-"-Kconform_pic -O"}
+ CFLAGS=${CFLAGS-"-O"}
+ LDSHARED=${LDSHARED-"cc -G"} ;;
+ OpenUNIX\ 5)
+ SFLAGS=${CFLAGS-"-KPIC -O"}
+ CFLAGS=${CFLAGS-"-O"}
+ LDSHARED=${LDSHARED-"cc -G"} ;;
+ AIX*) # Courtesy of dbakker@arrayasolutions.com
+ SFLAGS=${CFLAGS-"-O -qmaxmem=8192"}
+ CFLAGS=${CFLAGS-"-O -qmaxmem=8192"}
+ LDSHARED=${LDSHARED-"xlc -G"} ;;
+ # send working options for other systems to zlib@gzip.org
+ *) SFLAGS=${CFLAGS-"-O"}
+ CFLAGS=${CFLAGS-"-O"}
+ LDSHARED=${LDSHARED-"cc -shared"} ;;
+ 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
+
+# define functions for testing compiler and library characteristics and logging the results
+
+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" = ""
+}
+
+cat > $test.c << EOF
+int foo() { return 0; }
+EOF
+echo "Checking for obsessive-compulsive compiler options..." >> configure.log
+if try $CC -c $CFLAGS $test.c; then
+ :
+else
+ echo "Compiler error reporting is too harsh for $0 (perhaps remove -Werror)." | tee -a configure.log
+ leave 1
+fi
+
+echo >> configure.log
+
+# see if shared library build supported
+cat > $test.c <<EOF
+extern int getchar();
+int hello() {return getchar();}
+EOF
+if test $shared -eq 1; then
+ 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 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. | tee -a configure.log
+ shared=0;
+ else
+ echo 'No shared library support; try without defining CC and CFLAGS' | tee -a configure.log
+ shared=0;
+ fi
+fi
+if test $shared -eq 0; then
+ LDSHARED="$CC"
+ ALL="static"
+ TEST="all teststatic"
+ SHAREDLIB=""
+ SHAREDLIBV=""
+ SHAREDLIBM=""
+ echo Building static library $STATICLIB version $VER with $CC. | tee -a configure.log
+else
+ ALL="static shared"
+ TEST="all teststatic testshared"
+fi
+
+# 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 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." | tee -a configure.log
+ echo "Checking for fseeko... Yes." | tee -a configure.log
+else
+ echo "Checking for off64_t... No." | tee -a configure.log
+ echo >> configure.log
+ cat > $test.c <<EOF
+#include <stdio.h>
+int main(void) {
+ fseeko(NULL, 0, 0);
+ return 0;
+}
+EOF
+ 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." | 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 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." | tee -a configure.log
+else
+ 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 >> 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
+
+ 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
+
+ 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 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." | 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." | 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 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." | 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()." | 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 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 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." | 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." | 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 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." | 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
+#define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
+int ZLIB_INTERNAL foo;
+int main()
+{
+ return 0;
+}
+EOF
+ 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
+ echo "Checking for attribute(visibility) support... No." | tee -a configure.log
+ fi
+fi
+
+# 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
+
+# udpate Makefile with the configure results
+sed < Makefile.in "
+/^CC *=/s#=.*#=$CC#
+/^CFLAGS *=/s#=.*#=$CFLAGS#
+/^SFLAGS *=/s#=.*#=$SFLAGS#
+/^LDFLAGS *=/s#=.*#=$LDFLAGS#
+/^LDSHARED *=/s#=.*#=$LDSHARED#
+/^CPP *=/s#=.*#=$CPP#
+/^STATICLIB *=/s#=.*#=$STATICLIB#
+/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
+/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
+/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
+/^AR *=/s#=.*#=$AR#
+/^ARFLAGS *=/s#=.*#=$ARFLAGS#
+/^RANLIB *=/s#=.*#=$RANLIB#
+/^LDCONFIG *=/s#=.*#=$LDCONFIG#
+/^LDSHAREDLIBC *=/s#=.*#=$LDSHAREDLIBC#
+/^EXE *=/s#=.*#=$EXE#
+/^prefix *=/s#=.*#=$prefix#
+/^exec_prefix *=/s#=.*#=$exec_prefix#
+/^libdir *=/s#=.*#=$libdir#
+/^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#
+/^CPP *=/s#=.*#=$CPP#
+/^LDSHARED *=/s#=.*#=$LDSHARED#
+/^STATICLIB *=/s#=.*#=$STATICLIB#
+/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
+/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
+/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
+/^AR *=/s#=.*#=$AR#
+/^ARFLAGS *=/s#=.*#=$ARFLAGS#
+/^RANLIB *=/s#=.*#=$RANLIB#
+/^EXE *=/s#=.*#=$EXE#
+/^prefix *=/s#=.*#=$prefix#
+/^exec_prefix *=/s#=.*#=$exec_prefix#
+/^libdir *=/s#=.*#=$libdir#
+/^sharedlibdir *=/s#=.*#=$sharedlibdir#
+/^includedir *=/s#=.*#=$includedir#
+/^mandir *=/s#=.*#=$mandir#
+/^LDFLAGS *=/s#=.*#=$LDFLAGS#
+" | sed -e "
+s/\@VERSION\@/$VER/g;
+" > zlib.pc
+
+# done
+leave 0
diff --git a/compat/zlib/contrib/README.contrib b/compat/zlib/contrib/README.contrib
new file mode 100644
index 0000000..c66349b
--- /dev/null
+++ b/compat/zlib/contrib/README.contrib
@@ -0,0 +1,78 @@
+All files under this contrib directory are UNSUPPORTED. There were
+provided by users of zlib and were not tested by the authors of zlib.
+Use at your own risk. Please contact the authors of the contributions
+for help about these, not the zlib authors. Thanks.
+
+
+ada/ by Dmitriy Anisimkov <anisimkov@yahoo.com>
+ Support for Ada
+ See http://zlib-ada.sourceforge.net/
+
+amd64/ by Mikhail Teterin <mi@ALDAN.algebra.com>
+ asm code for AMD64
+ See patch at http://www.freebsd.org/cgi/query-pr.cgi?pr=bin/96393
+
+asm686/ by Brian Raiter <breadbox@muppetlabs.com>
+ asm code for Pentium and PPro/PII, using the AT&T (GNU as) syntax
+ See http://www.muppetlabs.com/~breadbox/software/assembly.html
+
+blast/ by Mark Adler <madler@alumni.caltech.edu>
+ Decompressor for output of PKWare Data Compression Library (DCL)
+
+delphi/ by Cosmin Truta <cosmint@cs.ubbcluj.ro>
+ Support for Delphi and C++ Builder
+
+dotzlib/ by Henrik Ravn <henrik@ravn.com>
+ Support for Microsoft .Net and Visual C++ .Net
+
+gcc_gvmat64/by Gilles Vollant <info@winimage.com>
+ GCC Version of x86 64-bit (AMD64 and Intel EM64t) code for x64
+ assembler to replace longest_match() and inflate_fast()
+
+infback9/ by Mark Adler <madler@alumni.caltech.edu>
+ Unsupported diffs to infback to decode the deflate64 format
+
+inflate86/ by Chris Anderson <christop@charm.net>
+ Tuned x86 gcc asm code to replace inflate_fast()
+
+iostream/ by Kevin Ruland <kevin@rodin.wustl.edu>
+ A C++ I/O streams interface to the zlib gz* functions
+
+iostream2/ by Tyge Løvset <Tyge.Lovset@cmr.no>
+ Another C++ I/O streams interface
+
+iostream3/ by Ludwig Schwardt <schwardt@sun.ac.za>
+ and Kevin Ruland <kevin@rodin.wustl.edu>
+ Yet another C++ I/O streams interface
+
+masmx64/ by Gilles Vollant <info@winimage.com>
+ x86 64-bit (AMD64 and Intel EM64t) code for x64 assembler to
+ replace longest_match() and inflate_fast(), also masm x86
+ 64-bits translation of Chris Anderson inflate_fast()
+
+masmx86/ by Gilles Vollant <info@winimage.com>
+ x86 asm code to replace longest_match() and inflate_fast(),
+ for Visual C++ and MASM (32 bits).
+ Based on Brian Raiter (asm686) and Chris Anderson (inflate86)
+
+minizip/ by Gilles Vollant <info@winimage.com>
+ Mini zip and unzip based on zlib
+ Includes Zip64 support by Mathias Svensson <mathias@result42.com>
+ See http://www.winimage.com/zLibDll/unzip.html
+
+pascal/ by Bob Dellaca <bobdl@xtra.co.nz> et al.
+ Support for Pascal
+
+puff/ by Mark Adler <madler@alumni.caltech.edu>
+ Small, low memory usage inflate. Also serves to provide an
+ unambiguous description of the deflate format.
+
+testzlib/ by Gilles Vollant <info@winimage.com>
+ Example of the use of zlib
+
+untgz/ by Pedro A. Aranda Gutierrez <paag@tid.es>
+ A very simple tar.gz file extractor using zlib
+
+vstudio/ by Gilles Vollant <info@winimage.com>
+ Building a minizip-enhanced zlib with Microsoft Visual Studio
+ Includes vc11 from kreuzerkrieg and vc12 from davispuh
diff --git a/compat/zlib/contrib/ada/buffer_demo.adb b/compat/zlib/contrib/ada/buffer_demo.adb
new file mode 100644
index 0000000..46b8638
--- /dev/null
+++ b/compat/zlib/contrib/ada/buffer_demo.adb
@@ -0,0 +1,106 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+--
+-- $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>
+--
+-- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
+-- of exactly the correct size is used for decompressed data, and the last
+-- few bytes passed in to Zlib are checksum bytes.
+
+-- This program compresses a string of text, and then decompresses the
+-- compressed text into a buffer of the same size as the original text.
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Text_IO;
+
+with ZLib; use ZLib;
+
+procedure Buffer_Demo is
+ EOL : Character renames ASCII.LF;
+ Text : constant String
+ := "Four score and seven years ago our fathers brought forth," & EOL &
+ "upon this continent, a new nation, conceived in liberty," & EOL &
+ "and dedicated to the proposition that `all men are created equal'.";
+
+ Source : Stream_Element_Array (1 .. Text'Length);
+ for Source'Address use Text'Address;
+
+begin
+ Ada.Text_IO.Put (Text);
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line
+ ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
+
+ declare
+ Compressed_Data : Stream_Element_Array (1 .. Text'Length);
+ L : Stream_Element_Offset;
+ begin
+ Compress : declare
+ Compressor : Filter_Type;
+ I : Stream_Element_Offset;
+ begin
+ Deflate_Init (Compressor);
+
+ -- Compress the whole of T at once.
+
+ Translate (Compressor, Source, I, Compressed_Data, L, Finish);
+ pragma Assert (I = Source'Last);
+
+ Close (Compressor);
+
+ Ada.Text_IO.Put_Line
+ ("Compressed size : "
+ & Stream_Element_Offset'Image (L) & " bytes");
+ end Compress;
+
+ -- Now we decompress the data, passing short blocks of data to Zlib
+ -- (because this demonstrates the problem - the last block passed will
+ -- contain checksum information and there will be no output, only a
+ -- check inside Zlib that the checksum is correct).
+
+ Decompress : declare
+ Decompressor : Filter_Type;
+
+ Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
+
+ Block_Size : constant := 4;
+ -- This makes sure that the last block contains
+ -- only Adler checksum data.
+
+ P : Stream_Element_Offset := Compressed_Data'First - 1;
+ O : Stream_Element_Offset;
+ begin
+ Inflate_Init (Decompressor);
+
+ loop
+ Translate
+ (Decompressor,
+ Compressed_Data
+ (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
+ P,
+ Uncompressed_Data
+ (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
+ O,
+ No_Flush);
+
+ Ada.Text_IO.Put_Line
+ ("Total in : " & Count'Image (Total_In (Decompressor)) &
+ ", out : " & Count'Image (Total_Out (Decompressor)));
+
+ exit when P = L;
+ end loop;
+
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line
+ ("Decompressed text matches original text : "
+ & Boolean'Image (Uncompressed_Data = Source));
+ end Decompress;
+ end;
+end Buffer_Demo;
diff --git a/compat/zlib/contrib/ada/mtest.adb b/compat/zlib/contrib/ada/mtest.adb
new file mode 100644
index 0000000..c4dfd08
--- /dev/null
+++ b/compat/zlib/contrib/ada/mtest.adb
@@ -0,0 +1,156 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+-- 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.4 2004/07/23 07:49:54 vagul Exp $
+
+with ZLib;
+with Ada.Streams;
+with Ada.Numerics.Discrete_Random;
+with Ada.Text_IO;
+with Ada.Exceptions;
+with Ada.Task_Identification;
+
+procedure MTest is
+ use Ada.Streams;
+ use ZLib;
+
+ Stop : Boolean := False;
+
+ pragma Atomic (Stop);
+
+ subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is
+ new Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ task type Test_Task;
+
+ task body Test_Task is
+ Buffer : Stream_Element_Array (1 .. 100_000);
+ Gen : Random_Elements.Generator;
+
+ Buffer_First : Stream_Element_Offset;
+ Compare_First : Stream_Element_Offset;
+
+ Deflate : Filter_Type;
+ Inflate : Filter_Type;
+
+ procedure Further (Item : in Stream_Element_Array);
+
+ procedure Read_Buffer
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+
+ -------------
+ -- Further --
+ -------------
+
+ procedure Further (Item : in Stream_Element_Array) is
+
+ procedure Compare (Item : in Stream_Element_Array);
+
+ -------------
+ -- Compare --
+ -------------
+
+ procedure Compare (Item : in Stream_Element_Array) is
+ Next_First : Stream_Element_Offset := Compare_First + Item'Length;
+ begin
+ if Buffer (Compare_First .. Next_First - 1) /= Item then
+ raise Program_Error;
+ end if;
+
+ Compare_First := Next_First;
+ end Compare;
+
+ procedure Compare_Write is new ZLib.Write (Write => Compare);
+ begin
+ Compare_Write (Inflate, Item, No_Flush);
+ end Further;
+
+ -----------------
+ -- Read_Buffer --
+ -----------------
+
+ procedure Read_Buffer
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset)
+ is
+ Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;
+ Next_First : Stream_Element_Offset;
+ begin
+ if Item'Length <= Buff_Diff then
+ Last := Item'Last;
+
+ Next_First := Buffer_First + Item'Length;
+
+ Item := Buffer (Buffer_First .. Next_First - 1);
+
+ Buffer_First := Next_First;
+ else
+ Last := Item'First + Buff_Diff;
+ Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
+ Buffer_First := Buffer'Last + 1;
+ end if;
+ end Read_Buffer;
+
+ procedure Translate is new Generic_Translate
+ (Data_In => Read_Buffer,
+ Data_Out => Further);
+
+ begin
+ Random_Elements.Reset (Gen);
+
+ Buffer := (others => 20);
+
+ Main : loop
+ for J in Buffer'Range loop
+ Buffer (J) := Random_Elements.Random (Gen);
+
+ Deflate_Init (Deflate);
+ Inflate_Init (Inflate);
+
+ Buffer_First := Buffer'First;
+ Compare_First := Buffer'First;
+
+ Translate (Deflate);
+
+ if Compare_First /= Buffer'Last + 1 then
+ raise Program_Error;
+ end if;
+
+ Ada.Text_IO.Put_Line
+ (Ada.Task_Identification.Image
+ (Ada.Task_Identification.Current_Task)
+ & Stream_Element_Offset'Image (J)
+ & ZLib.Count'Image (Total_Out (Deflate)));
+
+ Close (Deflate);
+ Close (Inflate);
+
+ exit Main when Stop;
+ end loop;
+ end loop Main;
+ exception
+ when E : others =>
+ Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
+ Stop := True;
+ end Test_Task;
+
+ Test : array (1 .. 4) of Test_Task;
+
+ pragma Unreferenced (Test);
+
+ Dummy : Character;
+
+begin
+ Ada.Text_IO.Get_Immediate (Dummy);
+ Stop := True;
+end MTest;
diff --git a/compat/zlib/contrib/ada/read.adb b/compat/zlib/contrib/ada/read.adb
new file mode 100644
index 0000000..1f2efbf
--- /dev/null
+++ b/compat/zlib/contrib/ada/read.adb
@@ -0,0 +1,156 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
+
+-- Test/demo program for the generic read interface.
+
+with Ada.Numerics.Discrete_Random;
+with Ada.Streams;
+with Ada.Text_IO;
+
+with ZLib;
+
+procedure Read is
+
+ use Ada.Streams;
+
+ ------------------------------------
+ -- Test configuration parameters --
+ ------------------------------------
+
+ File_Size : Stream_Element_Offset := 100_000;
+
+ Continuous : constant Boolean := False;
+ -- If this constant is True, the test would be repeated again and again,
+ -- with increment File_Size for every iteration.
+
+ Header : constant ZLib.Header_Type := ZLib.Default;
+ -- Do not use Header other than Default in ZLib versions 1.1.4 and older.
+
+ Init_Random : constant := 8;
+ -- We are using the same random sequence, in case of we catch bug,
+ -- so we would be able to reproduce it.
+
+ -- End --
+
+ Pack_Size : Stream_Element_Offset;
+ Offset : Stream_Element_Offset;
+
+ Filter : ZLib.Filter_Type;
+
+ subtype Visible_Symbols
+ is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is new
+ Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ Gen : Random_Elements.Generator;
+ Period : constant Stream_Element_Offset := 200;
+ -- Period constant variable for random generator not to be very random.
+ -- Bigger period, harder random.
+
+ Read_Buffer : Stream_Element_Array (1 .. 2048);
+ Read_First : Stream_Element_Offset;
+ Read_Last : Stream_Element_Offset;
+
+ procedure Reset;
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Read
+ -- reading data from the File_In.
+
+ procedure Read is new ZLib.Read
+ (Read,
+ Read_Buffer,
+ Rest_First => Read_First,
+ Rest_Last => Read_Last);
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Last := Stream_Element_Offset'Min
+ (Item'Last,
+ Item'First + File_Size - Offset);
+
+ for J in Item'First .. Last loop
+ if J < Item'First + Period then
+ Item (J) := Random_Elements.Random (Gen);
+ else
+ Item (J) := Item (J - Period);
+ end if;
+
+ Offset := Offset + 1;
+ end loop;
+ end Read;
+
+ -----------
+ -- Reset --
+ -----------
+
+ procedure Reset is
+ begin
+ Random_Elements.Reset (Gen, Init_Random);
+ Pack_Size := 0;
+ Offset := 1;
+ Read_First := Read_Buffer'Last + 1;
+ Read_Last := Read_Buffer'Last;
+ end Reset;
+
+begin
+ Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
+
+ loop
+ for Level in ZLib.Compression_Level'Range loop
+
+ Ada.Text_IO.Put ("Level ="
+ & ZLib.Compression_Level'Image (Level));
+
+ -- Deflate using generic instantiation.
+
+ ZLib.Deflate_Init
+ (Filter,
+ Level,
+ Header => Header);
+
+ Reset;
+
+ Ada.Text_IO.Put
+ (Stream_Element_Offset'Image (File_Size) & " ->");
+
+ loop
+ declare
+ Buffer : Stream_Element_Array (1 .. 1024);
+ Last : Stream_Element_Offset;
+ begin
+ Read (Filter, Buffer, Last);
+
+ Pack_Size := Pack_Size + Last - Buffer'First + 1;
+
+ exit when Last < Buffer'Last;
+ end;
+ end loop;
+
+ Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
+
+ ZLib.Close (Filter);
+ end loop;
+
+ exit when not Continuous;
+
+ File_Size := File_Size + 1;
+ end loop;
+end Read;
diff --git a/compat/zlib/contrib/ada/readme.txt b/compat/zlib/contrib/ada/readme.txt
new file mode 100644
index 0000000..ce4d2ca
--- /dev/null
+++ b/compat/zlib/contrib/ada/readme.txt
@@ -0,0 +1,65 @@
+ ZLib for Ada thick binding (ZLib.Ada)
+ Release 1.3
+
+ZLib.Ada is a thick binding interface to the popular ZLib data
+compression library, available at http://www.gzip.org/zlib/.
+It provides Ada-style access to the ZLib C library.
+
+
+ Here are the main changes since ZLib.Ada 1.2:
+
+- Attension: ZLib.Read generic routine have a initialization requirement
+ for Read_Last parameter now. It is a bit incompartible with previous version,
+ but extends functionality, we could use new parameters Allow_Read_Some and
+ Flush now.
+
+- Added Is_Open routines to ZLib and ZLib.Streams packages.
+
+- Add pragma Assert to check Stream_Element is 8 bit.
+
+- Fix extraction to buffer with exact known decompressed size. Error reported by
+ Steve Sangwine.
+
+- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
+ computers. Patch provided by Pascal Obry.
+
+- Add Status_Error exception definition.
+
+- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.
+
+
+ How to build ZLib.Ada under GNAT
+
+You should have the ZLib library already build on your computer, before
+building ZLib.Ada. Make the directory of ZLib.Ada sources current and
+issue the command:
+
+ gnatmake test -largs -L<directory where libz.a is> -lz
+
+Or use the GNAT project file build for GNAT 3.15 or later:
+
+ gnatmake -Pzlib.gpr -L<directory where libz.a is>
+
+
+ How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2
+
+1. Make a project with all *.ads and *.adb files from the distribution.
+2. Build the libz.a library from the ZLib C sources.
+3. Rename libz.a to z.lib.
+4. Add the library z.lib to the project.
+5. Add the libc.lib library from the ObjectAda distribution to the project.
+6. Build the executable using test.adb as a main procedure.
+
+
+ How to use ZLib.Ada
+
+The source files test.adb and read.adb are small demo programs that show
+the main functionality of ZLib.Ada.
+
+The routines from the package specifications are commented.
+
+
+Homepage: http://zlib-ada.sourceforge.net/
+Author: Dmitriy Anisimkov <anisimkov@yahoo.com>
+
+Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk>
diff --git a/compat/zlib/contrib/ada/test.adb b/compat/zlib/contrib/ada/test.adb
new file mode 100644
index 0000000..90773ac
--- /dev/null
+++ b/compat/zlib/contrib/ada/test.adb
@@ -0,0 +1,463 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $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.
+-- 2. Show the example of use main functionality of the ZLib.Ada95 binding.
+-- 3. Build this program automatically compile all ZLib.Ada95 packages under
+-- GNAT Ada95 compiler.
+
+with ZLib.Streams;
+with Ada.Streams.Stream_IO;
+with Ada.Numerics.Discrete_Random;
+
+with Ada.Text_IO;
+
+with Ada.Calendar;
+
+procedure Test is
+
+ use Ada.Streams;
+ use Stream_IO;
+
+ ------------------------------------
+ -- Test configuration parameters --
+ ------------------------------------
+
+ File_Size : Count := 100_000;
+ Continuous : constant Boolean := False;
+
+ Header : constant ZLib.Header_Type := ZLib.Default;
+ -- ZLib.None;
+ -- ZLib.Auto;
+ -- ZLib.GZip;
+ -- Do not use Header other then Default in ZLib versions 1.1.4
+ -- and older.
+
+ Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
+ Init_Random : constant := 10;
+
+ -- End --
+
+ In_File_Name : constant String := "testzlib.in";
+ -- Name of the input file
+
+ Z_File_Name : constant String := "testzlib.zlb";
+ -- Name of the compressed file.
+
+ Out_File_Name : constant String := "testzlib.out";
+ -- Name of the decompressed file.
+
+ File_In : File_Type;
+ File_Out : File_Type;
+ File_Back : File_Type;
+ File_Z : ZLib.Streams.Stream_Type;
+
+ Filter : ZLib.Filter_Type;
+
+ Time_Stamp : Ada.Calendar.Time;
+
+ procedure Generate_File;
+ -- Generate file of spetsified size with some random data.
+ -- The random data is repeatable, for the good compression.
+
+ procedure Compare_Streams
+ (Left, Right : in out Root_Stream_Type'Class);
+ -- The procedure compearing data in 2 streams.
+ -- It is for compare data before and after compression/decompression.
+
+ procedure Compare_Files (Left, Right : String);
+ -- Compare files. Based on the Compare_Streams.
+
+ procedure Copy_Streams
+ (Source, Target : in out Root_Stream_Type'Class;
+ Buffer_Size : in Stream_Element_Offset := 1024);
+ -- Copying data from one stream to another. It is for test stream
+ -- interface of the library.
+
+ procedure Data_In
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Generic_Translate.
+ -- reading data from the File_In.
+
+ procedure Data_Out (Item : in Stream_Element_Array);
+ -- this procedure is for generic instantiation of
+ -- ZLib.Generic_Translate.
+ -- writing data to the File_Out.
+
+ procedure Stamp;
+ -- Store the timestamp to the local variable.
+
+ procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
+ -- Print the time statistic with the message.
+
+ procedure Translate is new ZLib.Generic_Translate
+ (Data_In => Data_In,
+ Data_Out => Data_Out);
+ -- This procedure is moving data from File_In to File_Out
+ -- with compression or decompression, depend on initialization of
+ -- Filter parameter.
+
+ -------------------
+ -- Compare_Files --
+ -------------------
+
+ procedure Compare_Files (Left, Right : String) is
+ Left_File, Right_File : File_Type;
+ begin
+ Open (Left_File, In_File, Left);
+ Open (Right_File, In_File, Right);
+ Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
+ Close (Left_File);
+ Close (Right_File);
+ end Compare_Files;
+
+ ---------------------
+ -- Compare_Streams --
+ ---------------------
+
+ procedure Compare_Streams
+ (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
+ is
+ Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
+ Left_Last, Right_Last : Stream_Element_Offset;
+ begin
+ loop
+ Read (Left, Left_Buffer, Left_Last);
+ Read (Right, Right_Buffer, Right_Last);
+
+ if Left_Last /= Right_Last then
+ Ada.Text_IO.Put_Line ("Compare error :"
+ & Stream_Element_Offset'Image (Left_Last)
+ & " /= "
+ & Stream_Element_Offset'Image (Right_Last));
+
+ raise Constraint_Error;
+
+ elsif Left_Buffer (0 .. Left_Last)
+ /= Right_Buffer (0 .. Right_Last)
+ then
+ Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
+ raise Constraint_Error;
+
+ end if;
+
+ exit when Left_Last < Left_Buffer'Last;
+ end loop;
+ end Compare_Streams;
+
+ ------------------
+ -- Copy_Streams --
+ ------------------
+
+ procedure Copy_Streams
+ (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
+ Buffer_Size : in Stream_Element_Offset := 1024)
+ is
+ Buffer : Stream_Element_Array (1 .. Buffer_Size);
+ Last : Stream_Element_Offset;
+ begin
+ loop
+ Read (Source, Buffer, Last);
+ Write (Target, Buffer (1 .. Last));
+
+ exit when Last < Buffer'Last;
+ end loop;
+ end Copy_Streams;
+
+ -------------
+ -- Data_In --
+ -------------
+
+ procedure Data_In
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Read (File_In, Item, Last);
+ end Data_In;
+
+ --------------
+ -- Data_Out --
+ --------------
+
+ procedure Data_Out (Item : in Stream_Element_Array) is
+ begin
+ Write (File_Out, Item);
+ end Data_Out;
+
+ -------------------
+ -- Generate_File --
+ -------------------
+
+ procedure Generate_File is
+ subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
+
+ package Random_Elements is
+ new Ada.Numerics.Discrete_Random (Visible_Symbols);
+
+ Gen : Random_Elements.Generator;
+ Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
+
+ Buffer_Count : constant Count := File_Size / Buffer'Length;
+ -- Number of same buffers in the packet.
+
+ Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
+
+ procedure Fill_Buffer (J, D : in Count);
+ -- Change the part of the buffer.
+
+ -----------------
+ -- Fill_Buffer --
+ -----------------
+
+ procedure Fill_Buffer (J, D : in Count) is
+ begin
+ for K in 0 .. D loop
+ Buffer
+ (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
+ := Random_Elements.Random (Gen);
+
+ end loop;
+ end Fill_Buffer;
+
+ begin
+ Random_Elements.Reset (Gen, Init_Random);
+
+ Create (File_In, Out_File, In_File_Name);
+
+ Fill_Buffer (1, Buffer'Length - 2);
+
+ for J in 1 .. Buffer_Count loop
+ Write (File_In, Buffer);
+
+ Fill_Buffer (J, Density);
+ end loop;
+
+ -- fill remain size.
+
+ Write
+ (File_In,
+ Buffer
+ (1 .. Stream_Element_Offset
+ (File_Size - Buffer'Length * Buffer_Count)));
+
+ Flush (File_In);
+ Close (File_In);
+ end Generate_File;
+
+ ---------------------
+ -- Print_Statistic --
+ ---------------------
+
+ procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
+ use Ada.Calendar;
+ use Ada.Text_IO;
+
+ package Count_IO is new Integer_IO (ZLib.Count);
+
+ Curr_Dur : Duration := Clock - Time_Stamp;
+ begin
+ Put (Msg);
+
+ Set_Col (20);
+ Ada.Text_IO.Put ("size =");
+
+ Count_IO.Put
+ (Data_Size,
+ Width => Stream_IO.Count'Image (File_Size)'Length);
+
+ Put_Line (" duration =" & Duration'Image (Curr_Dur));
+ end Print_Statistic;
+
+ -----------
+ -- Stamp --
+ -----------
+
+ procedure Stamp is
+ begin
+ Time_Stamp := Ada.Calendar.Clock;
+ end Stamp;
+
+begin
+ Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
+
+ loop
+ Generate_File;
+
+ for Level in ZLib.Compression_Level'Range loop
+
+ Ada.Text_IO.Put_Line ("Level ="
+ & ZLib.Compression_Level'Image (Level));
+
+ -- Test generic interface.
+ Open (File_In, In_File, In_File_Name);
+ Create (File_Out, Out_File, Z_File_Name);
+
+ Stamp;
+
+ -- Deflate using generic instantiation.
+
+ ZLib.Deflate_Init
+ (Filter => Filter,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Translate (Filter);
+ Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
+ ZLib.Close (Filter);
+
+ Close (File_In);
+ Close (File_Out);
+
+ Open (File_In, In_File, Z_File_Name);
+ Create (File_Out, Out_File, Out_File_Name);
+
+ Stamp;
+
+ -- Inflate using generic instantiation.
+
+ ZLib.Inflate_Init (Filter, Header => Header);
+
+ Translate (Filter);
+ Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
+
+ ZLib.Close (Filter);
+
+ Close (File_In);
+ Close (File_Out);
+
+ Compare_Files (In_File_Name, Out_File_Name);
+
+ -- Test stream interface.
+
+ -- Compress to the back stream.
+
+ Open (File_In, In_File, In_File_Name);
+ Create (File_Back, Out_File, Z_File_Name);
+
+ Stamp;
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.Out_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => True,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Copy_Streams
+ (Source => Stream (File_In).all,
+ Target => File_Z);
+
+ -- Flushing internal buffers to the back stream.
+
+ ZLib.Streams.Flush (File_Z, ZLib.Finish);
+
+ Print_Statistic ("Write compress",
+ ZLib.Streams.Write_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+
+ Close (File_In);
+ Close (File_Back);
+
+ -- Compare reading from original file and from
+ -- decompression stream.
+
+ Open (File_In, In_File, In_File_Name);
+ Open (File_Back, In_File, Z_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.In_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => True,
+ Header => Header);
+
+ Stamp;
+ Compare_Streams (Stream (File_In).all, File_Z);
+
+ Print_Statistic ("Read decompress",
+ ZLib.Streams.Read_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+ Close (File_In);
+ Close (File_Back);
+
+ -- Compress by reading from compression stream.
+
+ Open (File_Back, In_File, In_File_Name);
+ Create (File_Out, Out_File, Z_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.In_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => False,
+ Level => Level,
+ Strategy => Strategy,
+ Header => Header);
+
+ Stamp;
+ Copy_Streams
+ (Source => File_Z,
+ Target => Stream (File_Out).all);
+
+ Print_Statistic ("Read compress",
+ ZLib.Streams.Read_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+
+ Close (File_Out);
+ Close (File_Back);
+
+ -- Decompress to decompression stream.
+
+ Open (File_In, In_File, Z_File_Name);
+ Create (File_Back, Out_File, Out_File_Name);
+
+ ZLib.Streams.Create
+ (Stream => File_Z,
+ Mode => ZLib.Streams.Out_Stream,
+ Back => ZLib.Streams.Stream_Access
+ (Stream (File_Back)),
+ Back_Compressed => False,
+ Header => Header);
+
+ Stamp;
+
+ Copy_Streams
+ (Source => Stream (File_In).all,
+ Target => File_Z);
+
+ Print_Statistic ("Write decompress",
+ ZLib.Streams.Write_Total_Out (File_Z));
+
+ ZLib.Streams.Close (File_Z);
+ Close (File_In);
+ Close (File_Back);
+
+ Compare_Files (In_File_Name, Out_File_Name);
+ end loop;
+
+ Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
+
+ exit when not Continuous;
+
+ File_Size := File_Size + 1;
+ end loop;
+end Test;
diff --git a/compat/zlib/contrib/ada/zlib-streams.adb b/compat/zlib/contrib/ada/zlib-streams.adb
new file mode 100644
index 0000000..b6497ba
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib-streams.adb
@@ -0,0 +1,225 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
+
+with Ada.Unchecked_Deallocation;
+
+package body ZLib.Streams is
+
+ -----------
+ -- Close --
+ -----------
+
+ procedure Close (Stream : in out Stream_Type) is
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Stream_Element_Array, Buffer_Access);
+ begin
+ if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
+ -- We should flush the data written by the writer.
+
+ Flush (Stream, Finish);
+
+ Close (Stream.Writer);
+ end if;
+
+ if Stream.Mode = In_Stream or Stream.Mode = Duplex then
+ Close (Stream.Reader);
+ Free (Stream.Buffer);
+ end if;
+ end Close;
+
+ ------------
+ -- Create --
+ ------------
+
+ procedure Create
+ (Stream : out Stream_Type;
+ Mode : in Stream_Mode;
+ Back : in Stream_Access;
+ Back_Compressed : in Boolean;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Header : in Header_Type := Default;
+ Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size)
+ is
+
+ subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
+
+ procedure Init_Filter
+ (Filter : in out Filter_Type;
+ Compress : in Boolean);
+
+ -----------------
+ -- Init_Filter --
+ -----------------
+
+ procedure Init_Filter
+ (Filter : in out Filter_Type;
+ Compress : in Boolean) is
+ begin
+ if Compress then
+ Deflate_Init
+ (Filter, Level, Strategy, Header => Header);
+ else
+ Inflate_Init (Filter, Header => Header);
+ end if;
+ end Init_Filter;
+
+ begin
+ Stream.Back := Back;
+ Stream.Mode := Mode;
+
+ if Mode = Out_Stream or Mode = Duplex then
+ Init_Filter (Stream.Writer, Back_Compressed);
+ Stream.Buffer_Size := Write_Buffer_Size;
+ else
+ Stream.Buffer_Size := 0;
+ end if;
+
+ if Mode = In_Stream or Mode = Duplex then
+ Init_Filter (Stream.Reader, not Back_Compressed);
+
+ Stream.Buffer := new Buffer_Subtype;
+ Stream.Rest_First := Stream.Buffer'Last + 1;
+ Stream.Rest_Last := Stream.Buffer'Last;
+ end if;
+ end Create;
+
+ -----------
+ -- Flush --
+ -----------
+
+ procedure Flush
+ (Stream : in out Stream_Type;
+ Mode : in Flush_Mode := Sync_Flush)
+ is
+ Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
+ Last : Stream_Element_Offset;
+ begin
+ loop
+ Flush (Stream.Writer, Buffer, Last, Mode);
+
+ Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
+
+ exit when Last < Buffer'Last;
+ end loop;
+ end Flush;
+
+ -------------
+ -- Is_Open --
+ -------------
+
+ function Is_Open (Stream : Stream_Type) return Boolean is
+ begin
+ return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
+ end Is_Open;
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Stream : in out Stream_Type;
+ Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset)
+ is
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Item : out Stream_Element_Array;
+ Last : out Stream_Element_Offset) is
+ begin
+ Ada.Streams.Read (Stream.Back.all, Item, Last);
+ end Read;
+
+ procedure Read is new ZLib.Read
+ (Read => Read,
+ Buffer => Stream.Buffer.all,
+ Rest_First => Stream.Rest_First,
+ Rest_Last => Stream.Rest_Last);
+
+ begin
+ Read (Stream.Reader, Item, Last);
+ end Read;
+
+ -------------------
+ -- Read_Total_In --
+ -------------------
+
+ function Read_Total_In (Stream : in Stream_Type) return Count is
+ begin
+ return Total_In (Stream.Reader);
+ end Read_Total_In;
+
+ --------------------
+ -- Read_Total_Out --
+ --------------------
+
+ function Read_Total_Out (Stream : in Stream_Type) return Count is
+ begin
+ return Total_Out (Stream.Reader);
+ end Read_Total_Out;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (Stream : in out Stream_Type;
+ Item : in Stream_Element_Array)
+ is
+
+ procedure Write (Item : in Stream_Element_Array);
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write (Item : in Stream_Element_Array) is
+ begin
+ Ada.Streams.Write (Stream.Back.all, Item);
+ end Write;
+
+ procedure Write is new ZLib.Write
+ (Write => Write,
+ Buffer_Size => Stream.Buffer_Size);
+
+ begin
+ Write (Stream.Writer, Item, No_Flush);
+ end Write;
+
+ --------------------
+ -- Write_Total_In --
+ --------------------
+
+ function Write_Total_In (Stream : in Stream_Type) return Count is
+ begin
+ return Total_In (Stream.Writer);
+ end Write_Total_In;
+
+ ---------------------
+ -- Write_Total_Out --
+ ---------------------
+
+ function Write_Total_Out (Stream : in Stream_Type) return Count is
+ begin
+ return Total_Out (Stream.Writer);
+ end Write_Total_Out;
+
+end ZLib.Streams;
diff --git a/compat/zlib/contrib/ada/zlib-streams.ads b/compat/zlib/contrib/ada/zlib-streams.ads
new file mode 100644
index 0000000..f0193c6b
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib-streams.ads
@@ -0,0 +1,114 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
+
+package ZLib.Streams is
+
+ type Stream_Mode is (In_Stream, Out_Stream, Duplex);
+
+ type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
+
+ type Stream_Type is
+ new Ada.Streams.Root_Stream_Type with private;
+
+ procedure Read
+ (Stream : in out Stream_Type;
+ Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+
+ procedure Write
+ (Stream : in out Stream_Type;
+ Item : in Ada.Streams.Stream_Element_Array);
+
+ procedure Flush
+ (Stream : in out Stream_Type;
+ Mode : in Flush_Mode := Sync_Flush);
+ -- Flush the written data to the back stream,
+ -- all data placed to the compressor is flushing to the Back stream.
+ -- Should not be used untill necessary, becouse it is decreasing
+ -- compression.
+
+ function Read_Total_In (Stream : in Stream_Type) return Count;
+ pragma Inline (Read_Total_In);
+ -- Return total number of bytes read from back stream so far.
+
+ function Read_Total_Out (Stream : in Stream_Type) return Count;
+ pragma Inline (Read_Total_Out);
+ -- Return total number of bytes read so far.
+
+ function Write_Total_In (Stream : in Stream_Type) return Count;
+ pragma Inline (Write_Total_In);
+ -- Return total number of bytes written so far.
+
+ function Write_Total_Out (Stream : in Stream_Type) return Count;
+ pragma Inline (Write_Total_Out);
+ -- Return total number of bytes written to the back stream.
+
+ procedure Create
+ (Stream : out Stream_Type;
+ Mode : in Stream_Mode;
+ Back : in Stream_Access;
+ Back_Compressed : in Boolean;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Header : in Header_Type := Default;
+ Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size);
+ -- Create the Comression/Decompression stream.
+ -- If mode is In_Stream then Write operation is disabled.
+ -- If mode is Out_Stream then Read operation is disabled.
+
+ -- If Back_Compressed is true then
+ -- Data written to the Stream is compressing to the Back stream
+ -- and data read from the Stream is decompressed data from the Back stream.
+
+ -- If Back_Compressed is false then
+ -- Data written to the Stream is decompressing to the Back stream
+ -- and data read from the Stream is compressed data from the Back stream.
+
+ -- !!! When the Need_Header is False ZLib-Ada is using undocumented
+ -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
+
+ function Is_Open (Stream : Stream_Type) return Boolean;
+
+ procedure Close (Stream : in out Stream_Type);
+
+private
+
+ use Ada.Streams;
+
+ type Buffer_Access is access all Stream_Element_Array;
+
+ type Stream_Type
+ is new Root_Stream_Type with
+ record
+ Mode : Stream_Mode;
+
+ Buffer : Buffer_Access;
+ Rest_First : Stream_Element_Offset;
+ Rest_Last : Stream_Element_Offset;
+ -- Buffer for Read operation.
+ -- We need to have this buffer in the record
+ -- becouse not all read data from back stream
+ -- could be processed during the read operation.
+
+ Buffer_Size : Stream_Element_Offset;
+ -- Buffer size for write operation.
+ -- We do not need to have this buffer
+ -- in the record becouse all data could be
+ -- processed in the write operation.
+
+ Back : Stream_Access;
+ Reader : Filter_Type;
+ Writer : Filter_Type;
+ end record;
+
+end ZLib.Streams;
diff --git a/compat/zlib/contrib/ada/zlib-thin.adb b/compat/zlib/contrib/ada/zlib-thin.adb
new file mode 100644
index 0000000..0ca4a71
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib-thin.adb
@@ -0,0 +1,141 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
+
+package body ZLib.Thin is
+
+ ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
+
+ Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;
+
+ --------------
+ -- Avail_In --
+ --------------
+
+ function Avail_In (Strm : in Z_Stream) return UInt is
+ begin
+ return Strm.Avail_In;
+ end Avail_In;
+
+ ---------------
+ -- Avail_Out --
+ ---------------
+
+ function Avail_Out (Strm : in Z_Stream) return UInt is
+ begin
+ return Strm.Avail_Out;
+ end Avail_Out;
+
+ ------------------
+ -- Deflate_Init --
+ ------------------
+
+ function Deflate_Init
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int)
+ return Int is
+ begin
+ return deflateInit2
+ (strm,
+ level,
+ method,
+ windowBits,
+ memLevel,
+ strategy,
+ ZLIB_VERSION,
+ Z_Stream_Size);
+ end Deflate_Init;
+
+ ------------------
+ -- Inflate_Init --
+ ------------------
+
+ function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
+ begin
+ return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
+ end Inflate_Init;
+
+ ------------------------
+ -- Last_Error_Message --
+ ------------------------
+
+ function Last_Error_Message (Strm : in Z_Stream) return String is
+ use Interfaces.C.Strings;
+ begin
+ if Strm.msg = Null_Ptr then
+ return "";
+ else
+ return Value (Strm.msg);
+ end if;
+ end Last_Error_Message;
+
+ ------------
+ -- Set_In --
+ ------------
+
+ procedure Set_In
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt) is
+ begin
+ Strm.Next_In := Buffer;
+ Strm.Avail_In := Size;
+ end Set_In;
+
+ ------------------
+ -- Set_Mem_Func --
+ ------------------
+
+ procedure Set_Mem_Func
+ (Strm : in out Z_Stream;
+ Opaque : in Voidp;
+ Alloc : in alloc_func;
+ Free : in free_func) is
+ begin
+ Strm.opaque := Opaque;
+ Strm.zalloc := Alloc;
+ Strm.zfree := Free;
+ end Set_Mem_Func;
+
+ -------------
+ -- Set_Out --
+ -------------
+
+ procedure Set_Out
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt) is
+ begin
+ Strm.Next_Out := Buffer;
+ Strm.Avail_Out := Size;
+ end Set_Out;
+
+ --------------
+ -- Total_In --
+ --------------
+
+ function Total_In (Strm : in Z_Stream) return ULong is
+ begin
+ return Strm.Total_In;
+ end Total_In;
+
+ ---------------
+ -- Total_Out --
+ ---------------
+
+ function Total_Out (Strm : in Z_Stream) return ULong is
+ begin
+ return Strm.Total_Out;
+ end Total_Out;
+
+end ZLib.Thin;
diff --git a/compat/zlib/contrib/ada/zlib-thin.ads b/compat/zlib/contrib/ada/zlib-thin.ads
new file mode 100644
index 0000000..d4407eb
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib-thin.ads
@@ -0,0 +1,450 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
+
+with Interfaces.C.Strings;
+
+with System;
+
+private package ZLib.Thin is
+
+ -- From zconf.h
+
+ MAX_MEM_LEVEL : constant := 9; -- zconf.h:105
+ -- zconf.h:105
+ MAX_WBITS : constant := 15; -- zconf.h:115
+ -- 32K LZ77 window
+ -- zconf.h:115
+ SEEK_SET : constant := 8#0000#; -- zconf.h:244
+ -- Seek from beginning of file.
+ -- zconf.h:244
+ SEEK_CUR : constant := 1; -- zconf.h:245
+ -- Seek from current position.
+ -- zconf.h:245
+ SEEK_END : constant := 2; -- zconf.h:246
+ -- Set file pointer to EOF plus "offset"
+ -- zconf.h:246
+
+ type Byte is new Interfaces.C.unsigned_char; -- 8 bits
+ -- zconf.h:214
+ type UInt is new Interfaces.C.unsigned; -- 16 bits or more
+ -- zconf.h:216
+ type Int is new Interfaces.C.int;
+
+ type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
+ -- zconf.h:217
+ subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
+
+ type ULong_Access is access ULong;
+ type Int_Access is access Int;
+
+ subtype Voidp is System.Address; -- zconf.h:232
+
+ subtype Byte_Access is Voidp;
+
+ Nul : constant Voidp := System.Null_Address;
+ -- end from zconf
+
+ Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
+ -- zlib.h:125
+ Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126
+ -- will be removed, use
+ -- Z_SYNC_FLUSH instead
+ -- zlib.h:126
+ Z_SYNC_FLUSH : constant := 2; -- zlib.h:127
+ -- zlib.h:127
+ Z_FULL_FLUSH : constant := 3; -- zlib.h:128
+ -- zlib.h:128
+ Z_FINISH : constant := 4; -- zlib.h:129
+ -- zlib.h:129
+ Z_OK : constant := 8#0000#; -- zlib.h:132
+ -- zlib.h:132
+ Z_STREAM_END : constant := 1; -- zlib.h:133
+ -- zlib.h:133
+ Z_NEED_DICT : constant := 2; -- zlib.h:134
+ -- zlib.h:134
+ Z_ERRNO : constant := -1; -- zlib.h:135
+ -- zlib.h:135
+ Z_STREAM_ERROR : constant := -2; -- zlib.h:136
+ -- zlib.h:136
+ Z_DATA_ERROR : constant := -3; -- zlib.h:137
+ -- zlib.h:137
+ Z_MEM_ERROR : constant := -4; -- zlib.h:138
+ -- zlib.h:138
+ Z_BUF_ERROR : constant := -5; -- zlib.h:139
+ -- zlib.h:139
+ Z_VERSION_ERROR : constant := -6; -- zlib.h:140
+ -- zlib.h:140
+ Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145
+ -- zlib.h:145
+ Z_BEST_SPEED : constant := 1; -- zlib.h:146
+ -- zlib.h:146
+ Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147
+ -- zlib.h:147
+ Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148
+ -- zlib.h:148
+ Z_FILTERED : constant := 1; -- zlib.h:151
+ -- zlib.h:151
+ Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152
+ -- zlib.h:152
+ Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153
+ -- zlib.h:153
+ Z_BINARY : constant := 8#0000#; -- zlib.h:156
+ -- zlib.h:156
+ Z_ASCII : constant := 1; -- zlib.h:157
+ -- zlib.h:157
+ Z_UNKNOWN : constant := 2; -- zlib.h:158
+ -- zlib.h:158
+ Z_DEFLATED : constant := 8; -- zlib.h:161
+ -- zlib.h:161
+ Z_NULL : constant := 8#0000#; -- zlib.h:164
+ -- for initializing zalloc, zfree, opaque
+ -- zlib.h:164
+ type gzFile is new Voidp; -- zlib.h:646
+
+ type Z_Stream is private;
+
+ type Z_Streamp is access all Z_Stream; -- zlib.h:89
+
+ type alloc_func is access function
+ (Opaque : Voidp;
+ Items : UInt;
+ Size : UInt)
+ return Voidp; -- zlib.h:63
+
+ type free_func is access procedure (opaque : Voidp; address : Voidp);
+
+ function zlibVersion return Chars_Ptr;
+
+ function Deflate (strm : Z_Streamp; flush : Int) return Int;
+
+ function DeflateEnd (strm : Z_Streamp) return Int;
+
+ function Inflate (strm : Z_Streamp; flush : Int) return Int;
+
+ function InflateEnd (strm : Z_Streamp) return Int;
+
+ function deflateSetDictionary
+ (strm : Z_Streamp;
+ dictionary : Byte_Access;
+ dictLength : UInt)
+ return Int;
+
+ function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
+ -- zlib.h:478
+
+ function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495
+
+ function deflateParams
+ (strm : Z_Streamp;
+ level : Int;
+ strategy : Int)
+ return Int; -- zlib.h:506
+
+ function inflateSetDictionary
+ (strm : Z_Streamp;
+ dictionary : Byte_Access;
+ dictLength : UInt)
+ return Int; -- zlib.h:548
+
+ function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565
+
+ function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580
+
+ function compress
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong)
+ return Int; -- zlib.h:601
+
+ function compress2
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong;
+ level : Int)
+ return Int; -- zlib.h:615
+
+ function uncompress
+ (dest : Byte_Access;
+ destLen : ULong_Access;
+ source : Byte_Access;
+ sourceLen : ULong)
+ return Int;
+
+ function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;
+
+ function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;
+
+ function gzsetparams
+ (file : gzFile;
+ level : Int;
+ strategy : Int)
+ return Int;
+
+ function gzread
+ (file : gzFile;
+ buf : Voidp;
+ len : UInt)
+ return Int;
+
+ function gzwrite
+ (file : in gzFile;
+ buf : in Voidp;
+ len : in UInt)
+ return Int;
+
+ function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;
+
+ function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;
+
+ function gzgets
+ (file : gzFile;
+ buf : Chars_Ptr;
+ len : Int)
+ return Chars_Ptr;
+
+ function gzputc (file : gzFile; char : Int) return Int;
+
+ function gzgetc (file : gzFile) return Int;
+
+ function gzflush (file : gzFile; flush : Int) return Int;
+
+ function gzseek
+ (file : gzFile;
+ offset : Int;
+ whence : Int)
+ return Int;
+
+ function gzrewind (file : gzFile) return Int;
+
+ function gztell (file : gzFile) return Int;
+
+ function gzeof (file : gzFile) return Int;
+
+ function gzclose (file : gzFile) return Int;
+
+ function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;
+
+ function adler32
+ (adler : ULong;
+ buf : Byte_Access;
+ len : UInt)
+ return ULong;
+
+ function crc32
+ (crc : ULong;
+ buf : Byte_Access;
+ len : UInt)
+ return ULong;
+
+ function deflateInit
+ (strm : Z_Streamp;
+ level : Int;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function deflateInit2
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function Deflate_Init
+ (strm : Z_Streamp;
+ level : Int;
+ method : Int;
+ windowBits : Int;
+ memLevel : Int;
+ strategy : Int)
+ return Int;
+ pragma Inline (Deflate_Init);
+
+ function inflateInit
+ (strm : Z_Streamp;
+ version : Chars_Ptr;
+ stream_size : Int)
+ return Int;
+
+ function inflateInit2
+ (strm : in Z_Streamp;
+ windowBits : in Int;
+ version : in Chars_Ptr;
+ stream_size : in Int)
+ return Int;
+
+ function inflateBackInit
+ (strm : in Z_Streamp;
+ windowBits : in Int;
+ window : in Byte_Access;
+ version : in Chars_Ptr;
+ stream_size : in Int)
+ return Int;
+ -- Size of window have to be 2**windowBits.
+
+ function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
+ pragma Inline (Inflate_Init);
+
+ function zError (err : Int) return Chars_Ptr;
+
+ function inflateSyncPoint (z : Z_Streamp) return Int;
+
+ function get_crc_table return ULong_Access;
+
+ -- Interface to the available fields of the z_stream structure.
+ -- The application must update next_in and avail_in when avail_in has
+ -- dropped to zero. It must update next_out and avail_out when avail_out
+ -- has dropped to zero. The application must initialize zalloc, zfree and
+ -- opaque before calling the init function.
+
+ procedure Set_In
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt);
+ pragma Inline (Set_In);
+
+ procedure Set_Out
+ (Strm : in out Z_Stream;
+ Buffer : in Voidp;
+ Size : in UInt);
+ pragma Inline (Set_Out);
+
+ procedure Set_Mem_Func
+ (Strm : in out Z_Stream;
+ Opaque : in Voidp;
+ Alloc : in alloc_func;
+ Free : in free_func);
+ pragma Inline (Set_Mem_Func);
+
+ function Last_Error_Message (Strm : in Z_Stream) return String;
+ pragma Inline (Last_Error_Message);
+
+ function Avail_Out (Strm : in Z_Stream) return UInt;
+ pragma Inline (Avail_Out);
+
+ function Avail_In (Strm : in Z_Stream) return UInt;
+ pragma Inline (Avail_In);
+
+ function Total_In (Strm : in Z_Stream) return ULong;
+ pragma Inline (Total_In);
+
+ function Total_Out (Strm : in Z_Stream) return ULong;
+ pragma Inline (Total_Out);
+
+ function inflateCopy
+ (dest : in Z_Streamp;
+ Source : in Z_Streamp)
+ return Int;
+
+ function compressBound (Source_Len : in ULong) return ULong;
+
+ function deflateBound
+ (Strm : in Z_Streamp;
+ Source_Len : in ULong)
+ return ULong;
+
+ function gzungetc (C : in Int; File : in gzFile) return Int;
+
+ function zlibCompileFlags return ULong;
+
+private
+
+ type Z_Stream is record -- zlib.h:68
+ Next_In : Voidp := Nul; -- next input byte
+ Avail_In : UInt := 0; -- number of bytes available at next_in
+ Total_In : ULong := 0; -- total nb of input bytes read so far
+ Next_Out : Voidp := Nul; -- next output byte should be put there
+ Avail_Out : UInt := 0; -- remaining free space at next_out
+ Total_Out : ULong := 0; -- total nb of bytes output so far
+ msg : Chars_Ptr; -- last error message, NULL if no error
+ state : Voidp; -- not visible by applications
+ zalloc : alloc_func := null; -- used to allocate the internal state
+ zfree : free_func := null; -- used to free the internal state
+ opaque : Voidp; -- private data object passed to
+ -- zalloc and zfree
+ data_type : Int; -- best guess about the data type:
+ -- ascii or binary
+ adler : ULong; -- adler32 value of the uncompressed
+ -- data
+ reserved : ULong; -- reserved for future use
+ end record;
+
+ pragma Convention (C, Z_Stream);
+
+ pragma Import (C, zlibVersion, "zlibVersion");
+ pragma Import (C, Deflate, "deflate");
+ pragma Import (C, DeflateEnd, "deflateEnd");
+ pragma Import (C, Inflate, "inflate");
+ pragma Import (C, InflateEnd, "inflateEnd");
+ pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
+ pragma Import (C, deflateCopy, "deflateCopy");
+ pragma Import (C, deflateReset, "deflateReset");
+ pragma Import (C, deflateParams, "deflateParams");
+ pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
+ pragma Import (C, inflateSync, "inflateSync");
+ pragma Import (C, inflateReset, "inflateReset");
+ pragma Import (C, compress, "compress");
+ pragma Import (C, compress2, "compress2");
+ pragma Import (C, uncompress, "uncompress");
+ pragma Import (C, gzopen, "gzopen");
+ pragma Import (C, gzdopen, "gzdopen");
+ pragma Import (C, gzsetparams, "gzsetparams");
+ pragma Import (C, gzread, "gzread");
+ pragma Import (C, gzwrite, "gzwrite");
+ pragma Import (C, gzprintf, "gzprintf");
+ pragma Import (C, gzputs, "gzputs");
+ pragma Import (C, gzgets, "gzgets");
+ pragma Import (C, gzputc, "gzputc");
+ pragma Import (C, gzgetc, "gzgetc");
+ pragma Import (C, gzflush, "gzflush");
+ pragma Import (C, gzseek, "gzseek");
+ pragma Import (C, gzrewind, "gzrewind");
+ pragma Import (C, gztell, "gztell");
+ pragma Import (C, gzeof, "gzeof");
+ pragma Import (C, gzclose, "gzclose");
+ pragma Import (C, gzerror, "gzerror");
+ pragma Import (C, adler32, "adler32");
+ pragma Import (C, crc32, "crc32");
+ pragma Import (C, deflateInit, "deflateInit_");
+ pragma Import (C, inflateInit, "inflateInit_");
+ pragma Import (C, deflateInit2, "deflateInit2_");
+ pragma Import (C, inflateInit2, "inflateInit2_");
+ pragma Import (C, zError, "zError");
+ pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
+ pragma Import (C, get_crc_table, "get_crc_table");
+
+ -- since zlib 1.2.0:
+
+ pragma Import (C, inflateCopy, "inflateCopy");
+ pragma Import (C, compressBound, "compressBound");
+ pragma Import (C, deflateBound, "deflateBound");
+ pragma Import (C, gzungetc, "gzungetc");
+ pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
+
+ pragma Import (C, inflateBackInit, "inflateBackInit_");
+
+ -- I stopped binding the inflateBack routines, becouse realize that
+ -- it does not support zlib and gzip headers for now, and have no
+ -- symmetric deflateBack routines.
+ -- ZLib-Ada is symmetric regarding deflate/inflate data transformation
+ -- and has a similar generic callback interface for the
+ -- deflate/inflate transformation based on the regular Deflate/Inflate
+ -- routines.
+
+ -- pragma Import (C, inflateBack, "inflateBack");
+ -- pragma Import (C, inflateBackEnd, "inflateBackEnd");
+
+end ZLib.Thin;
diff --git a/compat/zlib/contrib/ada/zlib.adb b/compat/zlib/contrib/ada/zlib.adb
new file mode 100644
index 0000000..8b6fd68
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib.adb
@@ -0,0 +1,701 @@
+----------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
+-- --
+-- Open source license information is in the zlib.ads file. --
+----------------------------------------------------------------
+
+-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
+
+with Ada.Exceptions;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+
+with Interfaces.C.Strings;
+
+with ZLib.Thin;
+
+package body ZLib is
+
+ use type Thin.Int;
+
+ type Z_Stream is new Thin.Z_Stream;
+
+ type Return_Code_Enum is
+ (OK,
+ STREAM_END,
+ NEED_DICT,
+ ERRNO,
+ STREAM_ERROR,
+ DATA_ERROR,
+ MEM_ERROR,
+ BUF_ERROR,
+ VERSION_ERROR);
+
+ type Flate_Step_Function is access
+ function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
+ pragma Convention (C, Flate_Step_Function);
+
+ type Flate_End_Function is access
+ function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
+ pragma Convention (C, Flate_End_Function);
+
+ type Flate_Type is record
+ Step : Flate_Step_Function;
+ Done : Flate_End_Function;
+ end record;
+
+ subtype Footer_Array is Stream_Element_Array (1 .. 8);
+
+ Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
+ := (16#1f#, 16#8b#, -- Magic header
+ 16#08#, -- Z_DEFLATED
+ 16#00#, -- Flags
+ 16#00#, 16#00#, 16#00#, 16#00#, -- Time
+ 16#00#, -- XFlags
+ 16#03# -- OS code
+ );
+ -- The simplest gzip header is not for informational, but just for
+ -- gzip format compatibility.
+ -- Note that some code below is using assumption
+ -- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
+ -- Simple_GZip_Header'Last <= Footer_Array'Last.
+
+ Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
+ := (0 => OK,
+ 1 => STREAM_END,
+ 2 => NEED_DICT,
+ -1 => ERRNO,
+ -2 => STREAM_ERROR,
+ -3 => DATA_ERROR,
+ -4 => MEM_ERROR,
+ -5 => BUF_ERROR,
+ -6 => VERSION_ERROR);
+
+ Flate : constant array (Boolean) of Flate_Type
+ := (True => (Step => Thin.Deflate'Access,
+ Done => Thin.DeflateEnd'Access),
+ False => (Step => Thin.Inflate'Access,
+ Done => Thin.InflateEnd'Access));
+
+ Flush_Finish : constant array (Boolean) of Flush_Mode
+ := (True => Finish, False => No_Flush);
+
+ procedure Raise_Error (Stream : in Z_Stream);
+ pragma Inline (Raise_Error);
+
+ procedure Raise_Error (Message : in String);
+ pragma Inline (Raise_Error);
+
+ procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Z_Stream, Z_Stream_Access);
+
+ function To_Thin_Access is new Ada.Unchecked_Conversion
+ (Z_Stream_Access, Thin.Z_Streamp);
+
+ procedure Translate_GZip
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode);
+ -- Separate translate routine for make gzip header.
+
+ procedure Translate_Auto
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode);
+ -- translate routine without additional headers.
+
+ -----------------
+ -- Check_Error --
+ -----------------
+
+ procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
+ use type Thin.Int;
+ begin
+ if Code /= Thin.Z_OK then
+ Raise_Error
+ (Return_Code_Enum'Image (Return_Code (Code))
+ & ": " & Last_Error_Message (Stream));
+ end if;
+ end Check_Error;
+
+ -----------
+ -- Close --
+ -----------
+
+ procedure Close
+ (Filter : in out Filter_Type;
+ Ignore_Error : in Boolean := False)
+ is
+ Code : Thin.Int;
+ begin
+ if not Ignore_Error and then not Is_Open (Filter) then
+ raise Status_Error;
+ end if;
+
+ Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
+
+ if Ignore_Error or else Code = Thin.Z_OK then
+ Free (Filter.Strm);
+ else
+ declare
+ Error_Message : constant String
+ := Last_Error_Message (Filter.Strm.all);
+ begin
+ Free (Filter.Strm);
+ Ada.Exceptions.Raise_Exception
+ (ZLib_Error'Identity,
+ Return_Code_Enum'Image (Return_Code (Code))
+ & ": " & Error_Message);
+ end;
+ end if;
+ end Close;
+
+ -----------
+ -- CRC32 --
+ -----------
+
+ function CRC32
+ (CRC : in Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array)
+ return Unsigned_32
+ is
+ use Thin;
+ begin
+ return Unsigned_32 (crc32 (ULong (CRC),
+ Data'Address,
+ Data'Length));
+ end CRC32;
+
+ procedure CRC32
+ (CRC : in out Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array) is
+ begin
+ CRC := CRC32 (CRC, Data);
+ end CRC32;
+
+ ------------------
+ -- Deflate_Init --
+ ------------------
+
+ procedure Deflate_Init
+ (Filter : in out Filter_Type;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Method : in Compression_Method := Deflated;
+ Window_Bits : in Window_Bits_Type := Default_Window_Bits;
+ Memory_Level : in Memory_Level_Type := Default_Memory_Level;
+ Header : in Header_Type := Default)
+ is
+ use type Thin.Int;
+ Win_Bits : Thin.Int := Thin.Int (Window_Bits);
+ begin
+ if Is_Open (Filter) then
+ raise Status_Error;
+ end if;
+
+ -- We allow ZLib to make header only in case of default header type.
+ -- Otherwise we would either do header by ourselfs, or do not do
+ -- header at all.
+
+ if Header = None or else Header = GZip then
+ Win_Bits := -Win_Bits;
+ end if;
+
+ -- For the GZip CRC calculation and make headers.
+
+ if Header = GZip then
+ Filter.CRC := 0;
+ Filter.Offset := Simple_GZip_Header'First;
+ else
+ Filter.Offset := Simple_GZip_Header'Last + 1;
+ end if;
+
+ Filter.Strm := new Z_Stream;
+ Filter.Compression := True;
+ Filter.Stream_End := False;
+ Filter.Header := Header;
+
+ if Thin.Deflate_Init
+ (To_Thin_Access (Filter.Strm),
+ Level => Thin.Int (Level),
+ method => Thin.Int (Method),
+ windowBits => Win_Bits,
+ memLevel => Thin.Int (Memory_Level),
+ strategy => Thin.Int (Strategy)) /= Thin.Z_OK
+ then
+ Raise_Error (Filter.Strm.all);
+ end if;
+ end Deflate_Init;
+
+ -----------
+ -- Flush --
+ -----------
+
+ procedure Flush
+ (Filter : in out Filter_Type;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode)
+ is
+ No_Data : Stream_Element_Array := (1 .. 0 => 0);
+ Last : Stream_Element_Offset;
+ begin
+ Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
+ end Flush;
+
+ -----------------------
+ -- Generic_Translate --
+ -----------------------
+
+ procedure Generic_Translate
+ (Filter : in out ZLib.Filter_Type;
+ In_Buffer_Size : in Integer := Default_Buffer_Size;
+ Out_Buffer_Size : in Integer := Default_Buffer_Size)
+ is
+ In_Buffer : Stream_Element_Array
+ (1 .. Stream_Element_Offset (In_Buffer_Size));
+ Out_Buffer : Stream_Element_Array
+ (1 .. Stream_Element_Offset (Out_Buffer_Size));
+ Last : Stream_Element_Offset;
+ In_Last : Stream_Element_Offset;
+ In_First : Stream_Element_Offset;
+ Out_Last : Stream_Element_Offset;
+ begin
+ Main : loop
+ Data_In (In_Buffer, Last);
+
+ In_First := In_Buffer'First;
+
+ loop
+ Translate
+ (Filter => Filter,
+ In_Data => In_Buffer (In_First .. Last),
+ In_Last => In_Last,
+ Out_Data => Out_Buffer,
+ Out_Last => Out_Last,
+ Flush => Flush_Finish (Last < In_Buffer'First));
+
+ if Out_Buffer'First <= Out_Last then
+ Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
+ end if;
+
+ exit Main when Stream_End (Filter);
+
+ -- The end of in buffer.
+
+ exit when In_Last = Last;
+
+ In_First := In_Last + 1;
+ end loop;
+ end loop Main;
+
+ end Generic_Translate;
+
+ ------------------
+ -- Inflate_Init --
+ ------------------
+
+ procedure Inflate_Init
+ (Filter : in out Filter_Type;
+ Window_Bits : in Window_Bits_Type := Default_Window_Bits;
+ Header : in Header_Type := Default)
+ is
+ use type Thin.Int;
+ Win_Bits : Thin.Int := Thin.Int (Window_Bits);
+
+ procedure Check_Version;
+ -- Check the latest header types compatibility.
+
+ procedure Check_Version is
+ begin
+ if Version <= "1.1.4" then
+ Raise_Error
+ ("Inflate header type " & Header_Type'Image (Header)
+ & " incompatible with ZLib version " & Version);
+ end if;
+ end Check_Version;
+
+ begin
+ if Is_Open (Filter) then
+ raise Status_Error;
+ end if;
+
+ case Header is
+ when None =>
+ Check_Version;
+
+ -- Inflate data without headers determined
+ -- by negative Win_Bits.
+
+ Win_Bits := -Win_Bits;
+ when GZip =>
+ Check_Version;
+
+ -- Inflate gzip data defined by flag 16.
+
+ Win_Bits := Win_Bits + 16;
+ when Auto =>
+ Check_Version;
+
+ -- Inflate with automatic detection
+ -- of gzip or native header defined by flag 32.
+
+ Win_Bits := Win_Bits + 32;
+ when Default => null;
+ end case;
+
+ Filter.Strm := new Z_Stream;
+ Filter.Compression := False;
+ Filter.Stream_End := False;
+ Filter.Header := Header;
+
+ if Thin.Inflate_Init
+ (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
+ then
+ Raise_Error (Filter.Strm.all);
+ end if;
+ end Inflate_Init;
+
+ -------------
+ -- Is_Open --
+ -------------
+
+ function Is_Open (Filter : in Filter_Type) return Boolean is
+ begin
+ return Filter.Strm /= null;
+ end Is_Open;
+
+ -----------------
+ -- Raise_Error --
+ -----------------
+
+ procedure Raise_Error (Message : in String) is
+ begin
+ Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
+ end Raise_Error;
+
+ procedure Raise_Error (Stream : in Z_Stream) is
+ begin
+ Raise_Error (Last_Error_Message (Stream));
+ end Raise_Error;
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Filter : in out Filter_Type;
+ Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode := No_Flush)
+ is
+ In_Last : Stream_Element_Offset;
+ Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
+ V_Flush : Flush_Mode := Flush;
+
+ begin
+ pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
+ pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
+
+ loop
+ if Rest_Last = Buffer'First - 1 then
+ V_Flush := Finish;
+
+ elsif Rest_First > Rest_Last then
+ Read (Buffer, Rest_Last);
+ Rest_First := Buffer'First;
+
+ if Rest_Last < Buffer'First then
+ V_Flush := Finish;
+ end if;
+ end if;
+
+ Translate
+ (Filter => Filter,
+ In_Data => Buffer (Rest_First .. Rest_Last),
+ In_Last => In_Last,
+ Out_Data => Item (Item_First .. Item'Last),
+ Out_Last => Last,
+ Flush => V_Flush);
+
+ Rest_First := In_Last + 1;
+
+ exit when Stream_End (Filter)
+ or else Last = Item'Last
+ or else (Last >= Item'First and then Allow_Read_Some);
+
+ Item_First := Last + 1;
+ end loop;
+ end Read;
+
+ ----------------
+ -- Stream_End --
+ ----------------
+
+ function Stream_End (Filter : in Filter_Type) return Boolean is
+ begin
+ if Filter.Header = GZip and Filter.Compression then
+ return Filter.Stream_End
+ and then Filter.Offset = Footer_Array'Last + 1;
+ else
+ return Filter.Stream_End;
+ end if;
+ end Stream_End;
+
+ --------------
+ -- Total_In --
+ --------------
+
+ function Total_In (Filter : in Filter_Type) return Count is
+ begin
+ return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
+ end Total_In;
+
+ ---------------
+ -- Total_Out --
+ ---------------
+
+ function Total_Out (Filter : in Filter_Type) return Count is
+ begin
+ return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
+ end Total_Out;
+
+ ---------------
+ -- Translate --
+ ---------------
+
+ procedure Translate
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode) is
+ begin
+ if Filter.Header = GZip and then Filter.Compression then
+ Translate_GZip
+ (Filter => Filter,
+ In_Data => In_Data,
+ In_Last => In_Last,
+ Out_Data => Out_Data,
+ Out_Last => Out_Last,
+ Flush => Flush);
+ else
+ Translate_Auto
+ (Filter => Filter,
+ In_Data => In_Data,
+ In_Last => In_Last,
+ Out_Data => Out_Data,
+ Out_Last => Out_Last,
+ Flush => Flush);
+ end if;
+ end Translate;
+
+ --------------------
+ -- Translate_Auto --
+ --------------------
+
+ procedure Translate_Auto
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode)
+ is
+ use type Thin.Int;
+ Code : Thin.Int;
+
+ begin
+ if not Is_Open (Filter) then
+ raise Status_Error;
+ end if;
+
+ if Out_Data'Length = 0 and then In_Data'Length = 0 then
+ raise Constraint_Error;
+ end if;
+
+ Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
+ Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
+
+ Code := Flate (Filter.Compression).Step
+ (To_Thin_Access (Filter.Strm),
+ Thin.Int (Flush));
+
+ if Code = Thin.Z_STREAM_END then
+ Filter.Stream_End := True;
+ else
+ Check_Error (Filter.Strm.all, Code);
+ end if;
+
+ In_Last := In_Data'Last
+ - Stream_Element_Offset (Avail_In (Filter.Strm.all));
+ Out_Last := Out_Data'Last
+ - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
+ end Translate_Auto;
+
+ --------------------
+ -- Translate_GZip --
+ --------------------
+
+ procedure Translate_GZip
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode)
+ is
+ Out_First : Stream_Element_Offset;
+
+ procedure Add_Data (Data : in Stream_Element_Array);
+ -- Add data to stream from the Filter.Offset till necessary,
+ -- used for add gzip headr/footer.
+
+ procedure Put_32
+ (Item : in out Stream_Element_Array;
+ Data : in Unsigned_32);
+ pragma Inline (Put_32);
+
+ --------------
+ -- Add_Data --
+ --------------
+
+ procedure Add_Data (Data : in Stream_Element_Array) is
+ Data_First : Stream_Element_Offset renames Filter.Offset;
+ Data_Last : Stream_Element_Offset;
+ Data_Len : Stream_Element_Offset; -- -1
+ Out_Len : Stream_Element_Offset; -- -1
+ begin
+ Out_First := Out_Last + 1;
+
+ if Data_First > Data'Last then
+ return;
+ end if;
+
+ Data_Len := Data'Last - Data_First;
+ Out_Len := Out_Data'Last - Out_First;
+
+ if Data_Len <= Out_Len then
+ Out_Last := Out_First + Data_Len;
+ Data_Last := Data'Last;
+ else
+ Out_Last := Out_Data'Last;
+ Data_Last := Data_First + Out_Len;
+ end if;
+
+ Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
+
+ Data_First := Data_Last + 1;
+ Out_First := Out_Last + 1;
+ end Add_Data;
+
+ ------------
+ -- Put_32 --
+ ------------
+
+ procedure Put_32
+ (Item : in out Stream_Element_Array;
+ Data : in Unsigned_32)
+ is
+ D : Unsigned_32 := Data;
+ begin
+ for J in Item'First .. Item'First + 3 loop
+ Item (J) := Stream_Element (D and 16#FF#);
+ D := Shift_Right (D, 8);
+ end loop;
+ end Put_32;
+
+ begin
+ Out_Last := Out_Data'First - 1;
+
+ if not Filter.Stream_End then
+ Add_Data (Simple_GZip_Header);
+
+ Translate_Auto
+ (Filter => Filter,
+ In_Data => In_Data,
+ In_Last => In_Last,
+ Out_Data => Out_Data (Out_First .. Out_Data'Last),
+ Out_Last => Out_Last,
+ Flush => Flush);
+
+ CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
+ end if;
+
+ if Filter.Stream_End and then Out_Last <= Out_Data'Last then
+ -- This detection method would work only when
+ -- Simple_GZip_Header'Last > Footer_Array'Last
+
+ if Filter.Offset = Simple_GZip_Header'Last + 1 then
+ Filter.Offset := Footer_Array'First;
+ end if;
+
+ declare
+ Footer : Footer_Array;
+ begin
+ Put_32 (Footer, Filter.CRC);
+ Put_32 (Footer (Footer'First + 4 .. Footer'Last),
+ Unsigned_32 (Total_In (Filter)));
+ Add_Data (Footer);
+ end;
+ end if;
+ end Translate_GZip;
+
+ -------------
+ -- Version --
+ -------------
+
+ function Version return String is
+ begin
+ return Interfaces.C.Strings.Value (Thin.zlibVersion);
+ end Version;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (Filter : in out Filter_Type;
+ Item : in Ada.Streams.Stream_Element_Array;
+ Flush : in Flush_Mode := No_Flush)
+ is
+ Buffer : Stream_Element_Array (1 .. Buffer_Size);
+ In_Last : Stream_Element_Offset;
+ Out_Last : Stream_Element_Offset;
+ In_First : Stream_Element_Offset := Item'First;
+ begin
+ if Item'Length = 0 and Flush = No_Flush then
+ return;
+ end if;
+
+ loop
+ Translate
+ (Filter => Filter,
+ In_Data => Item (In_First .. Item'Last),
+ In_Last => In_Last,
+ Out_Data => Buffer,
+ Out_Last => Out_Last,
+ Flush => Flush);
+
+ if Out_Last >= Buffer'First then
+ Write (Buffer (1 .. Out_Last));
+ end if;
+
+ exit when In_Last = Item'Last or Stream_End (Filter);
+
+ In_First := In_Last + 1;
+ end loop;
+ end Write;
+
+end ZLib;
diff --git a/compat/zlib/contrib/ada/zlib.ads b/compat/zlib/contrib/ada/zlib.ads
new file mode 100644
index 0000000..79ffc40
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib.ads
@@ -0,0 +1,328 @@
+------------------------------------------------------------------------------
+-- ZLib for Ada thick binding. --
+-- --
+-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
+-- --
+-- This library is free software; you can redistribute it and/or modify --
+-- it under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or (at --
+-- your option) any later version. --
+-- --
+-- This library is distributed in the hope that it will be useful, but --
+-- WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. --
+-- --
+-- You should have received a copy of the GNU General Public License --
+-- along with this library; if not, write to the Free Software Foundation, --
+-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+------------------------------------------------------------------------------
+
+-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $
+
+with Ada.Streams;
+
+with Interfaces;
+
+package ZLib is
+
+ ZLib_Error : exception;
+ Status_Error : exception;
+
+ type Compression_Level is new Integer range -1 .. 9;
+
+ type Flush_Mode is private;
+
+ type Compression_Method is private;
+
+ type Window_Bits_Type is new Integer range 8 .. 15;
+
+ type Memory_Level_Type is new Integer range 1 .. 9;
+
+ type Unsigned_32 is new Interfaces.Unsigned_32;
+
+ type Strategy_Type is private;
+
+ type Header_Type is (None, Auto, Default, GZip);
+ -- Header type usage have a some limitation for inflate.
+ -- See comment for Inflate_Init.
+
+ subtype Count is Ada.Streams.Stream_Element_Count;
+
+ Default_Memory_Level : constant Memory_Level_Type := 8;
+ Default_Window_Bits : constant Window_Bits_Type := 15;
+
+ ----------------------------------
+ -- Compression method constants --
+ ----------------------------------
+
+ Deflated : constant Compression_Method;
+ -- Only one method allowed in this ZLib version
+
+ ---------------------------------
+ -- Compression level constants --
+ ---------------------------------
+
+ No_Compression : constant Compression_Level := 0;
+ Best_Speed : constant Compression_Level := 1;
+ Best_Compression : constant Compression_Level := 9;
+ Default_Compression : constant Compression_Level := -1;
+
+ --------------------------
+ -- Flush mode constants --
+ --------------------------
+
+ No_Flush : constant Flush_Mode;
+ -- Regular way for compression, no flush
+
+ Partial_Flush : constant Flush_Mode;
+ -- Will be removed, use Z_SYNC_FLUSH instead
+
+ Sync_Flush : constant Flush_Mode;
+ -- All pending output is flushed to the output buffer and the output
+ -- is aligned on a byte boundary, so that the decompressor can get all
+ -- input data available so far. (In particular avail_in is zero after the
+ -- call if enough output space has been provided before the call.)
+ -- Flushing may degrade compression for some compression algorithms and so
+ -- it should be used only when necessary.
+
+ Block_Flush : constant Flush_Mode;
+ -- Z_BLOCK requests that inflate() stop
+ -- if and when it get to the next deflate block boundary. When decoding the
+ -- zlib or gzip format, this will cause inflate() to return immediately
+ -- after the header and before the first block. When doing a raw inflate,
+ -- inflate() will go ahead and process the first block, and will return
+ -- when it gets to the end of that block, or when it runs out of data.
+
+ Full_Flush : constant Flush_Mode;
+ -- All output is flushed as with SYNC_FLUSH, and the compression state
+ -- is reset so that decompression can restart from this point if previous
+ -- compressed data has been damaged or if random access is desired. Using
+ -- Full_Flush too often can seriously degrade the compression.
+
+ Finish : constant Flush_Mode;
+ -- Just for tell the compressor that input data is complete.
+
+ ------------------------------------
+ -- Compression strategy constants --
+ ------------------------------------
+
+ -- RLE stategy could be used only in version 1.2.0 and later.
+
+ Filtered : constant Strategy_Type;
+ Huffman_Only : constant Strategy_Type;
+ RLE : constant Strategy_Type;
+ Default_Strategy : constant Strategy_Type;
+
+ Default_Buffer_Size : constant := 4096;
+
+ type Filter_Type is tagged limited private;
+ -- The filter is for compression and for decompression.
+ -- The usage of the type is depend of its initialization.
+
+ function Version return String;
+ pragma Inline (Version);
+ -- Return string representation of the ZLib version.
+
+ procedure Deflate_Init
+ (Filter : in out Filter_Type;
+ Level : in Compression_Level := Default_Compression;
+ Strategy : in Strategy_Type := Default_Strategy;
+ Method : in Compression_Method := Deflated;
+ Window_Bits : in Window_Bits_Type := Default_Window_Bits;
+ Memory_Level : in Memory_Level_Type := Default_Memory_Level;
+ Header : in Header_Type := Default);
+ -- Compressor initialization.
+ -- When Header parameter is Auto or Default, then default zlib header
+ -- would be provided for compressed data.
+ -- When Header is GZip, then gzip header would be set instead of
+ -- default header.
+ -- When Header is None, no header would be set for compressed data.
+
+ procedure Inflate_Init
+ (Filter : in out Filter_Type;
+ Window_Bits : in Window_Bits_Type := Default_Window_Bits;
+ Header : in Header_Type := Default);
+ -- Decompressor initialization.
+ -- Default header type mean that ZLib default header is expecting in the
+ -- input compressed stream.
+ -- Header type None mean that no header is expecting in the input stream.
+ -- GZip header type mean that GZip header is expecting in the
+ -- input compressed stream.
+ -- Auto header type mean that header type (GZip or Native) would be
+ -- detected automatically in the input stream.
+ -- Note that header types parameter values None, GZip and Auto are
+ -- supported for inflate routine only in ZLib versions 1.2.0.2 and later.
+ -- Deflate_Init is supporting all header types.
+
+ function Is_Open (Filter : in Filter_Type) return Boolean;
+ pragma Inline (Is_Open);
+ -- Is the filter opened for compression or decompression.
+
+ procedure Close
+ (Filter : in out Filter_Type;
+ Ignore_Error : in Boolean := False);
+ -- Closing the compression or decompressor.
+ -- If stream is closing before the complete and Ignore_Error is False,
+ -- The exception would be raised.
+
+ generic
+ with procedure Data_In
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+ with procedure Data_Out
+ (Item : in Ada.Streams.Stream_Element_Array);
+ procedure Generic_Translate
+ (Filter : in out Filter_Type;
+ In_Buffer_Size : in Integer := Default_Buffer_Size;
+ Out_Buffer_Size : in Integer := Default_Buffer_Size);
+ -- Compress/decompress data fetch from Data_In routine and pass the result
+ -- to the Data_Out routine. User should provide Data_In and Data_Out
+ -- for compression/decompression data flow.
+ -- Compression or decompression depend on Filter initialization.
+
+ function Total_In (Filter : in Filter_Type) return Count;
+ pragma Inline (Total_In);
+ -- Returns total number of input bytes read so far
+
+ function Total_Out (Filter : in Filter_Type) return Count;
+ pragma Inline (Total_Out);
+ -- Returns total number of bytes output so far
+
+ function CRC32
+ (CRC : in Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array)
+ return Unsigned_32;
+ pragma Inline (CRC32);
+ -- Compute CRC32, it could be necessary for make gzip format
+
+ procedure CRC32
+ (CRC : in out Unsigned_32;
+ Data : in Ada.Streams.Stream_Element_Array);
+ pragma Inline (CRC32);
+ -- Compute CRC32, it could be necessary for make gzip format
+
+ -------------------------------------------------
+ -- Below is more complex low level routines. --
+ -------------------------------------------------
+
+ procedure Translate
+ (Filter : in out Filter_Type;
+ In_Data : in Ada.Streams.Stream_Element_Array;
+ In_Last : out Ada.Streams.Stream_Element_Offset;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode);
+ -- Compress/decompress the In_Data buffer and place the result into
+ -- Out_Data. In_Last is the index of last element from In_Data accepted by
+ -- the Filter. Out_Last is the last element of the received data from
+ -- Filter. To tell the filter that incoming data are complete put the
+ -- Flush parameter to Finish.
+
+ function Stream_End (Filter : in Filter_Type) return Boolean;
+ pragma Inline (Stream_End);
+ -- Return the true when the stream is complete.
+
+ procedure Flush
+ (Filter : in out Filter_Type;
+ Out_Data : out Ada.Streams.Stream_Element_Array;
+ Out_Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode);
+ pragma Inline (Flush);
+ -- Flushing the data from the compressor.
+
+ generic
+ with procedure Write
+ (Item : in Ada.Streams.Stream_Element_Array);
+ -- User should provide this routine for accept
+ -- compressed/decompressed data.
+
+ Buffer_Size : in Ada.Streams.Stream_Element_Offset
+ := Default_Buffer_Size;
+ -- Buffer size for Write user routine.
+
+ procedure Write
+ (Filter : in out Filter_Type;
+ Item : in Ada.Streams.Stream_Element_Array;
+ Flush : in Flush_Mode := No_Flush);
+ -- Compress/Decompress data from Item to the generic parameter procedure
+ -- Write. Output buffer size could be set in Buffer_Size generic parameter.
+
+ generic
+ with procedure Read
+ (Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset);
+ -- User should provide data for compression/decompression
+ -- thru this routine.
+
+ Buffer : in out Ada.Streams.Stream_Element_Array;
+ -- Buffer for keep remaining data from the previous
+ -- back read.
+
+ Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
+ -- Rest_First have to be initialized to Buffer'Last + 1
+ -- Rest_Last have to be initialized to Buffer'Last
+ -- before usage.
+
+ Allow_Read_Some : in Boolean := False;
+ -- Is it allowed to return Last < Item'Last before end of data.
+
+ procedure Read
+ (Filter : in out Filter_Type;
+ Item : out Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset;
+ Flush : in Flush_Mode := No_Flush);
+ -- Compress/Decompress data from generic parameter procedure Read to the
+ -- Item. User should provide Buffer and initialized Rest_First, Rest_Last
+ -- indicators. If Allow_Read_Some is True, Read routines could return
+ -- Last < Item'Last only at end of stream.
+
+private
+
+ use Ada.Streams;
+
+ pragma Assert (Ada.Streams.Stream_Element'Size = 8);
+ pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8);
+
+ type Flush_Mode is new Integer range 0 .. 5;
+
+ type Compression_Method is new Integer range 8 .. 8;
+
+ type Strategy_Type is new Integer range 0 .. 3;
+
+ No_Flush : constant Flush_Mode := 0;
+ Partial_Flush : constant Flush_Mode := 1;
+ Sync_Flush : constant Flush_Mode := 2;
+ Full_Flush : constant Flush_Mode := 3;
+ Finish : constant Flush_Mode := 4;
+ Block_Flush : constant Flush_Mode := 5;
+
+ Filtered : constant Strategy_Type := 1;
+ Huffman_Only : constant Strategy_Type := 2;
+ RLE : constant Strategy_Type := 3;
+ Default_Strategy : constant Strategy_Type := 0;
+
+ Deflated : constant Compression_Method := 8;
+
+ type Z_Stream;
+
+ type Z_Stream_Access is access all Z_Stream;
+
+ type Filter_Type is tagged limited record
+ Strm : Z_Stream_Access;
+ Compression : Boolean;
+ Stream_End : Boolean;
+ Header : Header_Type;
+ CRC : Unsigned_32;
+ Offset : Stream_Element_Offset;
+ -- Offset for gzip header/footer output.
+ end record;
+
+end ZLib;
diff --git a/compat/zlib/contrib/ada/zlib.gpr b/compat/zlib/contrib/ada/zlib.gpr
new file mode 100644
index 0000000..296b22a
--- /dev/null
+++ b/compat/zlib/contrib/ada/zlib.gpr
@@ -0,0 +1,20 @@
+project Zlib is
+
+ for Languages use ("Ada");
+ for Source_Dirs use (".");
+ for Object_Dir use ".";
+ for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
+
+ package Compiler is
+ for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
+ end Compiler;
+
+ package Linker is
+ for Default_Switches ("ada") use ("-lz");
+ end Linker;
+
+ package Builder is
+ for Default_Switches ("ada") use ("-s", "-gnatQ");
+ end Builder;
+
+end Zlib;
diff --git a/compat/zlib/contrib/amd64/amd64-match.S b/compat/zlib/contrib/amd64/amd64-match.S
new file mode 100644
index 0000000..81d4a1c
--- /dev/null
+++ b/compat/zlib/contrib/amd64/amd64-match.S
@@ -0,0 +1,452 @@
+/*
+ * match.S -- optimized version of longest_match()
+ * based on the similar work by Gilles Vollant, and Brian Raiter, written 1998
+ *
+ * This is free software; you can redistribute it and/or modify it
+ * under the terms of the BSD License. Use by owners of Che Guevarra
+ * parafernalia is prohibited, where possible, and highly discouraged
+ * elsewhere.
+ */
+
+#ifndef NO_UNDERLINE
+# define match_init _match_init
+# define longest_match _longest_match
+#endif
+
+#define scanend ebx
+#define scanendw bx
+#define chainlenwmask edx /* high word: current chain len low word: s->wmask */
+#define curmatch rsi
+#define curmatchd esi
+#define windowbestlen r8
+#define scanalign r9
+#define scanalignd r9d
+#define window r10
+#define bestlen r11
+#define bestlend r11d
+#define scanstart r12d
+#define scanstartw r12w
+#define scan r13
+#define nicematch r14d
+#define limit r15
+#define limitd r15d
+#define prev rcx
+
+/*
+ * The 258 is a "magic number, not a parameter -- changing it
+ * breaks the hell loose
+ */
+#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 LocalVarsSize (112)
+#define _chainlenwmask ( 8-LocalVarsSize)(%rsp)
+#define _windowbestlen (16-LocalVarsSize)(%rsp)
+#define save_r14 (24-LocalVarsSize)(%rsp)
+#define save_rsi (32-LocalVarsSize)(%rsp)
+#define save_rbx (40-LocalVarsSize)(%rsp)
+#define save_r12 (56-LocalVarsSize)(%rsp)
+#define save_r13 (64-LocalVarsSize)(%rsp)
+#define save_r15 (80-LocalVarsSize)(%rsp)
+
+
+.globl match_init, longest_match
+
+/*
+ * On AMD64 the first argument of a function (in our case -- the pointer to
+ * deflate_state structure) is passed in %rdi, hence our offsets below are
+ * all off of that.
+ */
+
+/* you can check the structure offset by running
+
+#include <stdlib.h>
+#include <stdio.h>
+#include "deflate.h"
+
+void print_depl()
+{
+deflate_state ds;
+deflate_state *s=&ds;
+printf("size pointer=%u\n",(int)sizeof(void*));
+
+printf("#define dsWSize (%3u)(%%rdi)\n",(int)(((char*)&(s->w_size))-((char*)s)));
+printf("#define dsWMask (%3u)(%%rdi)\n",(int)(((char*)&(s->w_mask))-((char*)s)));
+printf("#define dsWindow (%3u)(%%rdi)\n",(int)(((char*)&(s->window))-((char*)s)));
+printf("#define dsPrev (%3u)(%%rdi)\n",(int)(((char*)&(s->prev))-((char*)s)));
+printf("#define dsMatchLen (%3u)(%%rdi)\n",(int)(((char*)&(s->match_length))-((char*)s)));
+printf("#define dsPrevMatch (%3u)(%%rdi)\n",(int)(((char*)&(s->prev_match))-((char*)s)));
+printf("#define dsStrStart (%3u)(%%rdi)\n",(int)(((char*)&(s->strstart))-((char*)s)));
+printf("#define dsMatchStart (%3u)(%%rdi)\n",(int)(((char*)&(s->match_start))-((char*)s)));
+printf("#define dsLookahead (%3u)(%%rdi)\n",(int)(((char*)&(s->lookahead))-((char*)s)));
+printf("#define dsPrevLen (%3u)(%%rdi)\n",(int)(((char*)&(s->prev_length))-((char*)s)));
+printf("#define dsMaxChainLen (%3u)(%%rdi)\n",(int)(((char*)&(s->max_chain_length))-((char*)s)));
+printf("#define dsGoodMatch (%3u)(%%rdi)\n",(int)(((char*)&(s->good_match))-((char*)s)));
+printf("#define dsNiceMatch (%3u)(%%rdi)\n",(int)(((char*)&(s->nice_match))-((char*)s)));
+}
+
+*/
+
+
+/*
+ to compile for XCode 3.2 on MacOSX x86_64
+ - run "gcc -g -c -DXCODE_MAC_X64_STRUCTURE amd64-match.S"
+ */
+
+
+#ifndef CURRENT_LINX_XCODE_MAC_X64_STRUCTURE
+#define dsWSize ( 68)(%rdi)
+#define dsWMask ( 76)(%rdi)
+#define dsWindow ( 80)(%rdi)
+#define dsPrev ( 96)(%rdi)
+#define dsMatchLen (144)(%rdi)
+#define dsPrevMatch (148)(%rdi)
+#define dsStrStart (156)(%rdi)
+#define dsMatchStart (160)(%rdi)
+#define dsLookahead (164)(%rdi)
+#define dsPrevLen (168)(%rdi)
+#define dsMaxChainLen (172)(%rdi)
+#define dsGoodMatch (188)(%rdi)
+#define dsNiceMatch (192)(%rdi)
+
+#else
+
+#ifndef STRUCT_OFFSET
+# define STRUCT_OFFSET (0)
+#endif
+
+
+#define dsWSize ( 56 + STRUCT_OFFSET)(%rdi)
+#define dsWMask ( 64 + STRUCT_OFFSET)(%rdi)
+#define dsWindow ( 72 + STRUCT_OFFSET)(%rdi)
+#define dsPrev ( 88 + STRUCT_OFFSET)(%rdi)
+#define dsMatchLen (136 + STRUCT_OFFSET)(%rdi)
+#define dsPrevMatch (140 + STRUCT_OFFSET)(%rdi)
+#define dsStrStart (148 + STRUCT_OFFSET)(%rdi)
+#define dsMatchStart (152 + STRUCT_OFFSET)(%rdi)
+#define dsLookahead (156 + STRUCT_OFFSET)(%rdi)
+#define dsPrevLen (160 + STRUCT_OFFSET)(%rdi)
+#define dsMaxChainLen (164 + STRUCT_OFFSET)(%rdi)
+#define dsGoodMatch (180 + STRUCT_OFFSET)(%rdi)
+#define dsNiceMatch (184 + STRUCT_OFFSET)(%rdi)
+
+#endif
+
+
+
+
+.text
+
+/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */
+
+longest_match:
+/*
+ * Retrieve the function arguments. %curmatch will hold cur_match
+ * throughout the entire function (passed via rsi on amd64).
+ * rdi will hold the pointer to the deflate_state (first arg on amd64)
+ */
+ mov %rsi, save_rsi
+ mov %rbx, save_rbx
+ mov %r12, save_r12
+ mov %r13, save_r13
+ mov %r14, save_r14
+ mov %r15, save_r15
+
+/* uInt wmask = s->w_mask; */
+/* unsigned chain_length = s->max_chain_length; */
+/* if (s->prev_length >= s->good_match) { */
+/* chain_length >>= 2; */
+/* } */
+
+ movl dsPrevLen, %eax
+ movl dsGoodMatch, %ebx
+ cmpl %ebx, %eax
+ movl dsWMask, %eax
+ movl dsMaxChainLen, %chainlenwmask
+ jl LastMatchGood
+ shrl $2, %chainlenwmask
+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. */
+
+ decl %chainlenwmask
+ shll $16, %chainlenwmask
+ orl %eax, %chainlenwmask
+
+/* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; */
+
+ movl dsNiceMatch, %eax
+ movl dsLookahead, %ebx
+ cmpl %eax, %ebx
+ jl LookaheadLess
+ movl %eax, %ebx
+LookaheadLess: movl %ebx, %nicematch
+
+/* register Bytef *scan = s->window + s->strstart; */
+
+ mov dsWindow, %window
+ movl dsStrStart, %limitd
+ lea (%limit, %window), %scan
+
+/* Determine how many bytes the scan ptr is off from being */
+/* dword-aligned. */
+
+ mov %scan, %scanalign
+ negl %scanalignd
+ andl $3, %scanalignd
+
+/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ? */
+/* s->strstart - (IPos)MAX_DIST(s) : NIL; */
+
+ movl dsWSize, %eax
+ subl $MIN_LOOKAHEAD, %eax
+ xorl %ecx, %ecx
+ subl %eax, %limitd
+ cmovng %ecx, %limitd
+
+/* int best_len = s->prev_length; */
+
+ movl dsPrevLen, %bestlend
+
+/* Store the sum of s->window + best_len in %windowbestlen locally, and in memory. */
+
+ lea (%window, %bestlen), %windowbestlen
+ mov %windowbestlen, _windowbestlen
+
+/* register ush scan_start = *(ushf*)scan; */
+/* register ush scan_end = *(ushf*)(scan+best_len-1); */
+/* Posf *prev = s->prev; */
+
+ movzwl (%scan), %scanstart
+ movzwl -1(%scan, %bestlen), %scanend
+ mov dsPrev, %prev
+
+/* Jump into the main loop. */
+
+ movl %chainlenwmask, _chainlenwmask
+ 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.
+ */
+LookupLoop:
+ andl %chainlenwmask, %curmatchd
+ movzwl (%prev, %curmatch, 2), %curmatchd
+ cmpl %limitd, %curmatchd
+ jbe LeaveNow
+ subl $0x00010000, %chainlenwmask
+ js LeaveNow
+LoopEntry: cmpw -1(%windowbestlen, %curmatch), %scanendw
+ jne LookupLoop
+ cmpw %scanstartw, (%window, %curmatch)
+ jne LookupLoop
+
+/* Store the current value of chainlen. */
+ movl %chainlenwmask, _chainlenwmask
+
+/* %scan is the string under scrutiny, and %prev 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 $(-MAX_MATCH_8), %rdx
+ lea (%curmatch, %window), %windowbestlen
+ lea MAX_MATCH_8(%windowbestlen, %scanalign), %windowbestlen
+ lea MAX_MATCH_8(%scan, %scanalign), %prev
+
+/* the prefetching below makes very little difference... */
+ prefetcht1 (%windowbestlen, %rdx)
+ prefetcht1 (%prev, %rdx)
+
+/*
+ * Test the strings for equality, 8 bytes at a time. At the end,
+ * adjust %rdx so that it is offset to the exact byte that mismatched.
+ *
+ * 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 -- unrolling it, for example, makes no difference.
+ */
+
+#undef USE_SSE /* works, but is 6-7% slower, than non-SSE... */
+
+LoopCmps:
+#ifdef USE_SSE
+ /* Preload the SSE registers */
+ movdqu (%windowbestlen, %rdx), %xmm1
+ movdqu (%prev, %rdx), %xmm2
+ pcmpeqb %xmm2, %xmm1
+ movdqu 16(%windowbestlen, %rdx), %xmm3
+ movdqu 16(%prev, %rdx), %xmm4
+ pcmpeqb %xmm4, %xmm3
+ movdqu 32(%windowbestlen, %rdx), %xmm5
+ movdqu 32(%prev, %rdx), %xmm6
+ pcmpeqb %xmm6, %xmm5
+ movdqu 48(%windowbestlen, %rdx), %xmm7
+ movdqu 48(%prev, %rdx), %xmm8
+ pcmpeqb %xmm8, %xmm7
+
+ /* Check the comparisions' results */
+ pmovmskb %xmm1, %rax
+ notw %ax
+ bsfw %ax, %ax
+ jnz LeaveLoopCmps
+
+ /* this is the only iteration of the loop with a possibility of having
+ incremented rdx by 0x108 (each loop iteration add 16*4 = 0x40
+ and (0x40*4)+8=0x108 */
+ add $8, %rdx
+ jz LenMaximum
+ add $8, %rdx
+
+
+ pmovmskb %xmm3, %rax
+ notw %ax
+ bsfw %ax, %ax
+ jnz LeaveLoopCmps
+
+
+ add $16, %rdx
+
+
+ pmovmskb %xmm5, %rax
+ notw %ax
+ bsfw %ax, %ax
+ jnz LeaveLoopCmps
+
+ add $16, %rdx
+
+
+ pmovmskb %xmm7, %rax
+ notw %ax
+ bsfw %ax, %ax
+ jnz LeaveLoopCmps
+
+ add $16, %rdx
+
+ jmp LoopCmps
+LeaveLoopCmps: add %rax, %rdx
+#else
+ mov (%windowbestlen, %rdx), %rax
+ xor (%prev, %rdx), %rax
+ jnz LeaveLoopCmps
+
+ mov 8(%windowbestlen, %rdx), %rax
+ xor 8(%prev, %rdx), %rax
+ jnz LeaveLoopCmps8
+
+ mov 16(%windowbestlen, %rdx), %rax
+ xor 16(%prev, %rdx), %rax
+ jnz LeaveLoopCmps16
+
+ add $24, %rdx
+ jnz LoopCmps
+ jmp LenMaximum
+# if 0
+/*
+ * This three-liner is tantalizingly simple, but bsf is a slow instruction,
+ * and the complicated alternative down below is quite a bit faster. Sad...
+ */
+
+LeaveLoopCmps: bsf %rax, %rax /* find the first non-zero bit */
+ shrl $3, %eax /* divide by 8 to get the byte */
+ add %rax, %rdx
+# else
+LeaveLoopCmps16:
+ add $8, %rdx
+LeaveLoopCmps8:
+ add $8, %rdx
+LeaveLoopCmps: testl $0xFFFFFFFF, %eax /* Check the first 4 bytes */
+ jnz Check16
+ add $4, %rdx
+ shr $32, %rax
+Check16: testw $0xFFFF, %ax
+ jnz LenLower
+ add $2, %rdx
+ shrl $16, %eax
+LenLower: subb $1, %al
+ adc $0, %rdx
+# endif
+#endif
+
+/* 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 (%prev, %rdx), %rax
+ sub %scan, %rax
+ 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. */
+
+ cmpl %bestlend, %eax
+ jg LongerMatch
+ mov _windowbestlen, %windowbestlen
+ mov dsPrev, %prev
+ movl _chainlenwmask, %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 %eax, %bestlend
+ movl %curmatchd, dsMatchStart
+ cmpl %nicematch, %eax
+ jge LeaveNow
+
+ lea (%window, %bestlen), %windowbestlen
+ mov %windowbestlen, _windowbestlen
+
+ movzwl -1(%scan, %rax), %scanend
+ mov dsPrev, %prev
+ movl _chainlenwmask, %chainlenwmask
+ jmp LookupLoop
+
+/* Accept the current string, with the maximum possible length. */
+
+LenMaximum:
+ movl $MAX_MATCH, %bestlend
+ movl %curmatchd, dsMatchStart
+
+/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len; */
+/* return s->lookahead; */
+
+LeaveNow:
+ movl dsLookahead, %eax
+ cmpl %eax, %bestlend
+ cmovngl %bestlend, %eax
+LookaheadRet:
+
+/* Restore the registers and return from whence we came. */
+
+ mov save_rsi, %rsi
+ mov save_rbx, %rbx
+ mov save_r12, %r12
+ mov save_r13, %r13
+ mov save_r14, %r14
+ mov save_r15, %r15
+
+ ret
+
+match_init: ret
diff --git a/compat/zlib/contrib/asm686/README.686 b/compat/zlib/contrib/asm686/README.686
new file mode 100644
index 0000000..a0bf3be
--- /dev/null
+++ b/compat/zlib/contrib/asm686/README.686
@@ -0,0 +1,51 @@
+This is a patched version of zlib, modified to use
+Pentium-Pro-optimized assembly code in the deflation algorithm. The
+files changed/added by this patch are:
+
+README.686
+match.S
+
+The speedup that this patch provides varies, depending on whether the
+compiler used to build the original version of zlib falls afoul of the
+PPro's speed traps. My own tests show a speedup of around 10-20% at
+the default compression level, and 20-30% using -9, against a version
+compiled using gcc 2.7.2.3. Your mileage may vary.
+
+Note that this code has been tailored for the PPro/PII in particular,
+and will not perform particuarly well on a Pentium.
+
+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
+
+
+Update:
+
+I've been ignoring these assembly routines for years, believing that
+gcc's generated code had caught up with it sometime around gcc 2.95
+and the major rearchitecting of the Pentium 4. However, I recently
+learned that, despite what I believed, this code still has some life
+in it. On the Pentium 4 and AMD64 chips, it continues to run about 8%
+faster than the code produced by gcc 4.1.
+
+In acknowledgement of its continuing usefulness, I've altered the
+license to match that of the rest of zlib. Share and Enjoy!
+
+Brian Raiter
+breadbox@muppetlabs.com
+April, 2007
diff --git a/compat/zlib/contrib/asm686/match.S b/compat/zlib/contrib/asm686/match.S
new file mode 100644
index 0000000..fa42109
--- /dev/null
+++ b/compat/zlib/contrib/asm686/match.S
@@ -0,0 +1,357 @@
+/* match.S -- x86 assembly version of the zlib longest_match() function.
+ * Optimized for the Intel 686 chips (PPro and later).
+ *
+ * Copyright (C) 1998, 2007 Brian Raiter <breadbox@muppetlabs.com>
+ *
+ * This software is provided 'as-is', without any express or implied
+ * warranty. In no event will the author be held liable for any damages
+ * arising from the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software
+ * in a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+#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 chainlenwmask 0 /* high word: current chain len */
+ /* low word: s->wmask */
+#define window 4 /* local copy of s->window */
+#define windowbestlen 8 /* s->window + bestlen */
+#define scanstart 16 /* first two bytes of string */
+#define scanend 12 /* last 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
+
+/* 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) */
+.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 */
+/* deflate_state structure during the function's setup (before */
+/* entering the main loop). */
+
+ movl deflatestate(%esp), %edx
+ movl curmatch(%esp), %ecx
+
+/* uInt wmask = s->w_mask; */
+/* 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 dsWMask(%edx), %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 wmask */
+/* value, which it will always accompany. */
+
+ decl %ebx
+ shll $16, %ebx
+ orl %eax, %ebx
+ movl %ebx, chainlenwmask(%esp)
+
+/* 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:
+
+/* 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); */
+/* Posf *prev = s->prev; */
+
+ movzwl (%edi), %ebx
+ movl %ebx, scanstart(%esp)
+ movzwl -1(%edi,%eax), %ebx
+ movl %ebx, scanend(%esp)
+ movl dsPrev(%edx), %edi
+
+/* Jump into the main loop. */
+
+ movl chainlenwmask(%esp), %edx
+ 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 = scanend
+ * %ecx = curmatch
+ * %edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
+ * %esi = windowbestlen - i.e., (window + bestlen)
+ * %edi = prev
+ * %ebp = limit
+ */
+LookupLoop:
+ andl %edx, %ecx
+ movzwl (%edi,%ecx,2), %ecx
+ cmpl %ebp, %ecx
+ jbe LeaveNow
+ subl $0x00010000, %edx
+ js LeaveNow
+LoopEntry: movzwl -1(%esi,%ecx), %eax
+ cmpl %ebx, %eax
+ jnz LookupLoop
+ movl window(%esp), %eax
+ movzwl (%eax,%ecx), %eax
+ cmpl scanstart(%esp), %eax
+ jnz LookupLoop
+
+/* Store the current value of chainlen. */
+
+ movl %edx, chainlenwmask(%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
+ xorl (%edi,%edx), %eax
+ jnz LeaveLoopCmps
+ movl 4(%esi,%edx), %eax
+ xorl 4(%edi,%edx), %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 windowbestlen(%esp), %esi
+ movl dsPrev(%edx), %edi
+ movl scanend(%esp), %ebx
+ movl chainlenwmask(%esp), %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)
+ movzwl -1(%edi,%eax), %ebx
+ movl dsPrev(%edx), %edi
+ movl %ebx, scanend(%esp)
+ movl chainlenwmask(%esp), %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
+ .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/blast/Makefile b/compat/zlib/contrib/blast/Makefile
new file mode 100644
index 0000000..9be80ba
--- /dev/null
+++ b/compat/zlib/contrib/blast/Makefile
@@ -0,0 +1,8 @@
+blast: blast.c blast.h
+ cc -DTEST -o blast blast.c
+
+test: blast
+ blast < test.pk | cmp - test.txt
+
+clean:
+ rm -f blast blast.o
diff --git a/compat/zlib/contrib/blast/README b/compat/zlib/contrib/blast/README
new file mode 100644
index 0000000..e3a60b3
--- /dev/null
+++ b/compat/zlib/contrib/blast/README
@@ -0,0 +1,4 @@
+Read blast.h for purpose and usage.
+
+Mark Adler
+madler@alumni.caltech.edu
diff --git a/compat/zlib/contrib/blast/blast.c b/compat/zlib/contrib/blast/blast.c
new file mode 100644
index 0000000..69ef0fe
--- /dev/null
+++ b/compat/zlib/contrib/blast/blast.c
@@ -0,0 +1,446 @@
+/* blast.c
+ * Copyright (C) 2003, 2012 Mark Adler
+ * For conditions of distribution and use, see copyright notice in blast.h
+ * version 1.2, 24 Oct 2012
+ *
+ * blast.c decompresses data compressed by the PKWare Compression Library.
+ * This function provides functionality similar to the explode() function of
+ * the PKWare library, hence the name "blast".
+ *
+ * This decompressor is based on the excellent format description provided by
+ * Ben Rudiak-Gould in comp.compression on August 13, 2001. Interestingly, the
+ * example Ben provided in the post is incorrect. The distance 110001 should
+ * instead be 111000. When corrected, the example byte stream becomes:
+ *
+ * 00 04 82 24 25 8f 80 7f
+ *
+ * which decompresses to "AIAIAIAIAIAIA" (without the quotes).
+ */
+
+/*
+ * Change history:
+ *
+ * 1.0 12 Feb 2003 - First version
+ * 1.1 16 Feb 2003 - Fixed distance check for > 4 GB uncompressed data
+ * 1.2 24 Oct 2012 - Add note about using binary mode in stdio
+ * - Fix comparisons of differently signed integers
+ */
+
+#include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */
+#include "blast.h" /* prototype for blast() */
+
+#define local static /* for local function definitions */
+#define MAXBITS 13 /* maximum code length */
+#define MAXWIN 4096 /* maximum window size */
+
+/* input and output state */
+struct state {
+ /* input state */
+ blast_in infun; /* input function provided by user */
+ void *inhow; /* opaque information passed to infun() */
+ unsigned char *in; /* next input location */
+ unsigned left; /* available input at in */
+ int bitbuf; /* bit buffer */
+ int bitcnt; /* number of bits in bit buffer */
+
+ /* input limit error return state for bits() and decode() */
+ jmp_buf env;
+
+ /* output state */
+ blast_out outfun; /* output function provided by user */
+ void *outhow; /* opaque information passed to outfun() */
+ unsigned next; /* index of next write location in out[] */
+ int first; /* true to check distances (for first 4K) */
+ unsigned char out[MAXWIN]; /* output buffer and sliding window */
+};
+
+/*
+ * Return need bits from the input stream. This always leaves less than
+ * eight bits in the buffer. bits() works properly for need == 0.
+ *
+ * Format notes:
+ *
+ * - Bits are stored in bytes from the least significant bit to the most
+ * significant bit. Therefore bits are dropped from the bottom of the bit
+ * buffer, using shift right, and new bytes are appended to the top of the
+ * bit buffer, using shift left.
+ */
+local int bits(struct state *s, int need)
+{
+ int val; /* bit accumulator */
+
+ /* load at least need bits into val */
+ val = s->bitbuf;
+ while (s->bitcnt < need) {
+ if (s->left == 0) {
+ s->left = s->infun(s->inhow, &(s->in));
+ if (s->left == 0) longjmp(s->env, 1); /* out of input */
+ }
+ val |= (int)(*(s->in)++) << s->bitcnt; /* load eight bits */
+ s->left--;
+ s->bitcnt += 8;
+ }
+
+ /* drop need bits and update buffer, always zero to seven bits left */
+ s->bitbuf = val >> need;
+ s->bitcnt -= need;
+
+ /* return need bits, zeroing the bits above that */
+ return val & ((1 << need) - 1);
+}
+
+/*
+ * Huffman code decoding tables. count[1..MAXBITS] is the number of symbols of
+ * each length, which for a canonical code are stepped through in order.
+ * symbol[] are the symbol values in canonical order, where the number of
+ * entries is the sum of the counts in count[]. The decoding process can be
+ * seen in the function decode() below.
+ */
+struct huffman {
+ short *count; /* number of symbols of each length */
+ short *symbol; /* canonically ordered symbols */
+};
+
+/*
+ * Decode a code from the stream s using huffman table h. Return the symbol or
+ * a negative value if there is an error. If all of the lengths are zero, i.e.
+ * an empty code, or if the code is incomplete and an invalid code is received,
+ * then -9 is returned after reading MAXBITS bits.
+ *
+ * Format notes:
+ *
+ * - The codes as stored in the compressed data are bit-reversed relative to
+ * a simple integer ordering of codes of the same lengths. Hence below the
+ * bits are pulled from the compressed data one at a time and used to
+ * build the code value reversed from what is in the stream in order to
+ * permit simple integer comparisons for decoding.
+ *
+ * - The first code for the shortest length is all ones. Subsequent codes of
+ * the same length are simply integer decrements of the previous code. When
+ * moving up a length, a one bit is appended to the code. For a complete
+ * code, the last code of the longest length will be all zeros. To support
+ * this ordering, the bits pulled during decoding are inverted to apply the
+ * more "natural" ordering starting with all zeros and incrementing.
+ */
+local int decode(struct state *s, struct huffman *h)
+{
+ int len; /* current number of bits in code */
+ int code; /* len bits being decoded */
+ int first; /* first code of length len */
+ int count; /* number of codes of length len */
+ int index; /* index of first code of length len in symbol table */
+ int bitbuf; /* bits from stream */
+ int left; /* bits left in next or left to process */
+ short *next; /* next number of codes */
+
+ bitbuf = s->bitbuf;
+ left = s->bitcnt;
+ code = first = index = 0;
+ len = 1;
+ next = h->count + 1;
+ while (1) {
+ while (left--) {
+ code |= (bitbuf & 1) ^ 1; /* invert code */
+ bitbuf >>= 1;
+ count = *next++;
+ if (code < first + count) { /* if length len, return symbol */
+ s->bitbuf = bitbuf;
+ s->bitcnt = (s->bitcnt - len) & 7;
+ return h->symbol[index + (code - first)];
+ }
+ index += count; /* else update for next length */
+ first += count;
+ first <<= 1;
+ code <<= 1;
+ len++;
+ }
+ left = (MAXBITS+1) - len;
+ if (left == 0) break;
+ if (s->left == 0) {
+ s->left = s->infun(s->inhow, &(s->in));
+ if (s->left == 0) longjmp(s->env, 1); /* out of input */
+ }
+ bitbuf = *(s->in)++;
+ s->left--;
+ if (left > 8) left = 8;
+ }
+ return -9; /* ran out of codes */
+}
+
+/*
+ * Given a list of repeated code lengths rep[0..n-1], where each byte is a
+ * count (high four bits + 1) and a code length (low four bits), generate the
+ * list of code lengths. This compaction reduces the size of the object code.
+ * Then given the list of code lengths length[0..n-1] representing a canonical
+ * Huffman code for n symbols, construct the tables required to decode those
+ * codes. Those tables are the number of codes of each length, and the symbols
+ * sorted by length, retaining their original order within each length. The
+ * return value is zero for a complete code set, negative for an over-
+ * subscribed code set, and positive for an incomplete code set. The tables
+ * can be used if the return value is zero or positive, but they cannot be used
+ * if the return value is negative. If the return value is zero, it is not
+ * possible for decode() using that table to return an error--any stream of
+ * enough bits will resolve to a symbol. If the return value is positive, then
+ * it is possible for decode() using that table to return an error for received
+ * codes past the end of the incomplete lengths.
+ */
+local int construct(struct huffman *h, const unsigned char *rep, int n)
+{
+ int symbol; /* current symbol when stepping through length[] */
+ int len; /* current length when stepping through h->count[] */
+ int left; /* number of possible codes left of current length */
+ short offs[MAXBITS+1]; /* offsets in symbol table for each length */
+ short length[256]; /* code lengths */
+
+ /* convert compact repeat counts into symbol bit length list */
+ symbol = 0;
+ do {
+ len = *rep++;
+ left = (len >> 4) + 1;
+ len &= 15;
+ do {
+ length[symbol++] = len;
+ } while (--left);
+ } while (--n);
+ n = symbol;
+
+ /* count number of codes of each length */
+ for (len = 0; len <= MAXBITS; len++)
+ h->count[len] = 0;
+ for (symbol = 0; symbol < n; symbol++)
+ (h->count[length[symbol]])++; /* assumes lengths are within bounds */
+ if (h->count[0] == n) /* no codes! */
+ return 0; /* complete, but decode() will fail */
+
+ /* check for an over-subscribed or incomplete set of lengths */
+ left = 1; /* one possible code of zero length */
+ 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 */
+ } /* left > 0 means incomplete */
+
+ /* generate offsets into symbol table for each length for sorting */
+ offs[1] = 0;
+ for (len = 1; len < MAXBITS; len++)
+ offs[len + 1] = offs[len] + h->count[len];
+
+ /*
+ * put symbols in table sorted by length, by symbol order within each
+ * length
+ */
+ for (symbol = 0; symbol < n; symbol++)
+ if (length[symbol] != 0)
+ h->symbol[offs[length[symbol]]++] = symbol;
+
+ /* return zero for complete set, positive for incomplete set */
+ return left;
+}
+
+/*
+ * Decode PKWare Compression Library stream.
+ *
+ * Format notes:
+ *
+ * - First byte is 0 if literals are uncoded or 1 if they are coded. Second
+ * byte is 4, 5, or 6 for the number of extra bits in the distance code.
+ * This is the base-2 logarithm of the dictionary size minus six.
+ *
+ * - Compressed data is a combination of literals and length/distance pairs
+ * terminated by an end code. Literals are either Huffman coded or
+ * uncoded bytes. A length/distance pair is a coded length followed by a
+ * coded distance to represent a string that occurs earlier in the
+ * uncompressed data that occurs again at the current location.
+ *
+ * - A bit preceding a literal or length/distance pair indicates which comes
+ * next, 0 for literals, 1 for length/distance.
+ *
+ * - If literals are uncoded, then the next eight bits are the literal, in the
+ * normal bit order in th stream, i.e. no bit-reversal is needed. Similarly,
+ * no bit reversal is needed for either the length extra bits or the distance
+ * extra bits.
+ *
+ * - Literal bytes are simply written to the output. A length/distance pair is
+ * an instruction to copy previously uncompressed bytes to the output. The
+ * copy is from distance bytes back in the output stream, copying for length
+ * bytes.
+ *
+ * - Distances pointing before the beginning of the output data are not
+ * permitted.
+ *
+ * - Overlapped copies, where the length is greater than the distance, are
+ * allowed and common. For example, a distance of one and a length of 518
+ * simply copies the last byte 518 times. A distance of four and a length of
+ * twelve copies the last four bytes three times. A simple forward copy
+ * ignoring whether the length is greater than the distance or not implements
+ * this correctly.
+ */
+local int decomp(struct state *s)
+{
+ int lit; /* true if literals are coded */
+ int dict; /* log2(dictionary size) - 6 */
+ int symbol; /* decoded symbol, extra bits for distance */
+ int len; /* length for copy */
+ unsigned dist; /* distance for copy */
+ int copy; /* copy counter */
+ unsigned char *from, *to; /* copy pointers */
+ static int virgin = 1; /* build tables once */
+ static short litcnt[MAXBITS+1], litsym[256]; /* litcode memory */
+ static short lencnt[MAXBITS+1], lensym[16]; /* lencode memory */
+ static short distcnt[MAXBITS+1], distsym[64]; /* distcode memory */
+ static struct huffman litcode = {litcnt, litsym}; /* length code */
+ static struct huffman lencode = {lencnt, lensym}; /* length code */
+ static struct huffman distcode = {distcnt, distsym};/* distance code */
+ /* bit lengths of literal codes */
+ static const unsigned char litlen[] = {
+ 11, 124, 8, 7, 28, 7, 188, 13, 76, 4, 10, 8, 12, 10, 12, 10, 8, 23, 8,
+ 9, 7, 6, 7, 8, 7, 6, 55, 8, 23, 24, 12, 11, 7, 9, 11, 12, 6, 7, 22, 5,
+ 7, 24, 6, 11, 9, 6, 7, 22, 7, 11, 38, 7, 9, 8, 25, 11, 8, 11, 9, 12,
+ 8, 12, 5, 38, 5, 38, 5, 11, 7, 5, 6, 21, 6, 10, 53, 8, 7, 24, 10, 27,
+ 44, 253, 253, 253, 252, 252, 252, 13, 12, 45, 12, 45, 12, 61, 12, 45,
+ 44, 173};
+ /* bit lengths of length codes 0..15 */
+ static const unsigned char lenlen[] = {2, 35, 36, 53, 38, 23};
+ /* bit lengths of distance codes 0..63 */
+ static const unsigned char distlen[] = {2, 20, 53, 230, 247, 151, 248};
+ static const short base[16] = { /* base for length codes */
+ 3, 2, 4, 5, 6, 7, 8, 9, 10, 12, 16, 24, 40, 72, 136, 264};
+ static const char extra[16] = { /* extra bits for length codes */
+ 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8};
+
+ /* set up decoding tables (once--might not be thread-safe) */
+ if (virgin) {
+ construct(&litcode, litlen, sizeof(litlen));
+ construct(&lencode, lenlen, sizeof(lenlen));
+ construct(&distcode, distlen, sizeof(distlen));
+ virgin = 0;
+ }
+
+ /* read header */
+ lit = bits(s, 8);
+ if (lit > 1) return -1;
+ dict = bits(s, 8);
+ if (dict < 4 || dict > 6) return -2;
+
+ /* decode literals and length/distance pairs */
+ do {
+ if (bits(s, 1)) {
+ /* get length */
+ symbol = decode(s, &lencode);
+ len = base[symbol] + bits(s, extra[symbol]);
+ if (len == 519) break; /* end code */
+
+ /* get distance */
+ symbol = len == 2 ? 2 : dict;
+ dist = decode(s, &distcode) << symbol;
+ dist += bits(s, symbol);
+ dist++;
+ if (s->first && dist > s->next)
+ return -3; /* distance too far back */
+
+ /* copy length bytes from distance bytes back */
+ do {
+ to = s->out + s->next;
+ from = to - dist;
+ copy = MAXWIN;
+ if (s->next < dist) {
+ from += copy;
+ copy = dist;
+ }
+ copy -= s->next;
+ if (copy > len) copy = len;
+ len -= copy;
+ s->next += copy;
+ do {
+ *to++ = *from++;
+ } while (--copy);
+ if (s->next == MAXWIN) {
+ if (s->outfun(s->outhow, s->out, s->next)) return 1;
+ s->next = 0;
+ s->first = 0;
+ }
+ } while (len != 0);
+ }
+ else {
+ /* get literal and write it */
+ symbol = lit ? decode(s, &litcode) : bits(s, 8);
+ s->out[s->next++] = symbol;
+ if (s->next == MAXWIN) {
+ if (s->outfun(s->outhow, s->out, s->next)) return 1;
+ s->next = 0;
+ s->first = 0;
+ }
+ }
+ } while (1);
+ return 0;
+}
+
+/* See comments in blast.h */
+int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow)
+{
+ struct state s; /* input/output state */
+ int err; /* return value */
+
+ /* initialize input state */
+ s.infun = infun;
+ s.inhow = inhow;
+ s.left = 0;
+ s.bitbuf = 0;
+ s.bitcnt = 0;
+
+ /* initialize output state */
+ s.outfun = outfun;
+ s.outhow = outhow;
+ s.next = 0;
+ s.first = 1;
+
+ /* return if bits() or decode() tries to read past available input */
+ if (setjmp(s.env) != 0) /* if came back here via longjmp(), */
+ err = 2; /* then skip decomp(), return error */
+ else
+ err = decomp(&s); /* decompress */
+
+ /* write any leftover output and update the error code if needed */
+ if (err != 1 && s.next && s.outfun(s.outhow, s.out, s.next) && err == 0)
+ err = 1;
+ return err;
+}
+
+#ifdef TEST
+/* Example of how to use blast() */
+#include <stdio.h>
+#include <stdlib.h>
+
+#define CHUNK 16384
+
+local unsigned inf(void *how, unsigned char **buf)
+{
+ static unsigned char hold[CHUNK];
+
+ *buf = hold;
+ return fread(hold, 1, CHUNK, (FILE *)how);
+}
+
+local int outf(void *how, unsigned char *buf, unsigned len)
+{
+ return fwrite(buf, 1, len, (FILE *)how) != len;
+}
+
+/* Decompress a PKWare Compression Library stream from stdin to stdout */
+int main(void)
+{
+ int ret, n;
+
+ /* decompress to stdout */
+ ret = blast(inf, stdin, outf, stdout);
+ if (ret != 0) fprintf(stderr, "blast error: %d\n", ret);
+
+ /* see if there are any leftover bytes */
+ n = 0;
+ while (getchar() != EOF) n++;
+ if (n) fprintf(stderr, "blast warning: %d unused bytes of input\n", n);
+
+ /* return blast() error code */
+ return ret;
+}
+#endif
diff --git a/compat/zlib/contrib/blast/blast.h b/compat/zlib/contrib/blast/blast.h
new file mode 100644
index 0000000..658cfd3
--- /dev/null
+++ b/compat/zlib/contrib/blast/blast.h
@@ -0,0 +1,75 @@
+/* blast.h -- interface for blast.c
+ Copyright (C) 2003, 2012 Mark Adler
+ version 1.2, 24 Oct 2012
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Mark Adler madler@alumni.caltech.edu
+ */
+
+
+/*
+ * blast() decompresses the PKWare Data Compression Library (DCL) compressed
+ * format. It provides the same functionality as the explode() function in
+ * that library. (Note: PKWare overused the "implode" verb, and the format
+ * used by their library implode() function is completely different and
+ * incompatible with the implode compression method supported by PKZIP.)
+ *
+ * The binary mode for stdio functions should be used to assure that the
+ * compressed data is not corrupted when read or written. For example:
+ * fopen(..., "rb") and fopen(..., "wb").
+ */
+
+
+typedef unsigned (*blast_in)(void *how, unsigned char **buf);
+typedef int (*blast_out)(void *how, unsigned char *buf, unsigned len);
+/* Definitions for input/output functions passed to blast(). See below for
+ * what the provided functions need to do.
+ */
+
+
+int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow);
+/* Decompress input to output using the provided infun() and outfun() calls.
+ * On success, the return value of blast() is zero. If there is an error in
+ * the source data, i.e. it is not in the proper format, then a negative value
+ * is returned. If there is not enough input available or there is not enough
+ * output space, then a positive error is returned.
+ *
+ * The input function is invoked: len = infun(how, &buf), where buf is set by
+ * infun() to point to the input buffer, and infun() returns the number of
+ * available bytes there. If infun() returns zero, then blast() returns with
+ * an input error. (blast() only asks for input if it needs it.) inhow is for
+ * use by the application to pass an input descriptor to infun(), if desired.
+ *
+ * The output function is invoked: err = outfun(how, buf, len), where the bytes
+ * to be written are buf[0..len-1]. If err is not zero, then blast() returns
+ * with an output error. outfun() is always called with len <= 4096. outhow
+ * is for use by the application to pass an output descriptor to outfun(), if
+ * desired.
+ *
+ * The return codes are:
+ *
+ * 2: ran out of input before completing decompression
+ * 1: output error before completing decompression
+ * 0: successful decompression
+ * -1: literal flag not zero or one
+ * -2: dictionary size not in 4..6
+ * -3: distance is too far back
+ *
+ * At the bottom of blast.c is an example program that uses blast() that can be
+ * compiled to produce a command-line decompression filter by defining TEST.
+ */
diff --git a/compat/zlib/contrib/blast/test.pk b/compat/zlib/contrib/blast/test.pk
new file mode 100644
index 0000000..be10b2b
--- /dev/null
+++ b/compat/zlib/contrib/blast/test.pk
Binary files differ
diff --git a/compat/zlib/contrib/blast/test.txt b/compat/zlib/contrib/blast/test.txt
new file mode 100644
index 0000000..bfdf1c5
--- /dev/null
+++ b/compat/zlib/contrib/blast/test.txt
@@ -0,0 +1 @@
+AIAIAIAIAIAIA \ No newline at end of file
diff --git a/compat/zlib/contrib/delphi/ZLib.pas b/compat/zlib/contrib/delphi/ZLib.pas
new file mode 100644
index 0000000..a579974
--- /dev/null
+++ b/compat/zlib/contrib/delphi/ZLib.pas
@@ -0,0 +1,557 @@
+{*******************************************************}
+{ }
+{ Borland Delphi Supplemental Components }
+{ ZLIB Data Compression Interface Unit }
+{ }
+{ Copyright (c) 1997,99 Borland Corporation }
+{ }
+{*******************************************************}
+
+{ Updated for zlib 1.2.x by Cosmin Truta <cosmint@cs.ubbcluj.ro> }
+
+unit ZLib;
+
+interface
+
+uses SysUtils, Classes;
+
+type
+ TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
+ TFree = procedure (AppData, Block: Pointer); cdecl;
+
+ // Internal structure. Ignore.
+ TZStreamRec = packed record
+ next_in: PChar; // next input byte
+ avail_in: Integer; // number of bytes available at next_in
+ total_in: Longint; // total nb of input bytes read so far
+
+ next_out: PChar; // next output byte should be put here
+ avail_out: Integer; // remaining free space at next_out
+ total_out: Longint; // total nb of bytes output so far
+
+ msg: PChar; // last error message, NULL if no error
+ internal: Pointer; // not visible by applications
+
+ zalloc: TAlloc; // used to allocate the internal state
+ zfree: TFree; // used to free the internal state
+ AppData: Pointer; // private data object passed to zalloc and zfree
+
+ data_type: Integer; // best guess about the data type: ascii or binary
+ adler: Longint; // adler32 value of the uncompressed data
+ reserved: Longint; // reserved for future use
+ end;
+
+ // Abstract ancestor class
+ TCustomZlibStream = class(TStream)
+ private
+ FStrm: TStream;
+ FStrmPos: Integer;
+ FOnProgress: TNotifyEvent;
+ FZRec: TZStreamRec;
+ FBuffer: array [Word] of Char;
+ protected
+ procedure Progress(Sender: TObject); dynamic;
+ property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
+ constructor Create(Strm: TStream);
+ end;
+
+{ TCompressionStream compresses data on the fly as data is written to it, and
+ stores the compressed data to another stream.
+
+ TCompressionStream is write-only and strictly sequential. Reading from the
+ stream will raise an exception. Using Seek to move the stream pointer
+ will raise an exception.
+
+ Output data is cached internally, written to the output stream only when
+ the internal output buffer is full. All pending output data is flushed
+ when the stream is destroyed.
+
+ The Position property returns the number of uncompressed bytes of
+ data that have been written to the stream so far.
+
+ CompressionRate returns the on-the-fly percentage by which the original
+ data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
+ If raw data size = 100 and compressed data size = 25, the CompressionRate
+ is 75%
+
+ The OnProgress event is called each time the output buffer is filled and
+ written to the output stream. This is useful for updating a progress
+ indicator when you are writing a large chunk of data to the compression
+ stream in a single call.}
+
+
+ TCompressionLevel = (clNone, clFastest, clDefault, clMax);
+
+ TCompressionStream = class(TCustomZlibStream)
+ private
+ function GetCompressionRate: Single;
+ public
+ constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
+ destructor Destroy; override;
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ property CompressionRate: Single read GetCompressionRate;
+ property OnProgress;
+ end;
+
+{ TDecompressionStream decompresses data on the fly as data is read from it.
+
+ Compressed data comes from a separate source stream. TDecompressionStream
+ is read-only and unidirectional; you can seek forward in the stream, but not
+ backwards. The special case of setting the stream position to zero is
+ allowed. Seeking forward decompresses data until the requested position in
+ the uncompressed data has been reached. Seeking backwards, seeking relative
+ to the end of the stream, requesting the size of the stream, and writing to
+ the stream will raise an exception.
+
+ The Position property returns the number of bytes of uncompressed data that
+ have been read from the stream so far.
+
+ The OnProgress event is called each time the internal input buffer of
+ compressed data is exhausted and the next block is read from the input stream.
+ This is useful for updating a progress indicator when you are reading a
+ large chunk of data from the decompression stream in a single call.}
+
+ TDecompressionStream = class(TCustomZlibStream)
+ public
+ constructor Create(Source: TStream);
+ destructor Destroy; override;
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ property OnProgress;
+ end;
+
+
+
+{ CompressBuf compresses data, buffer to buffer, in one call.
+ In: InBuf = ptr to compressed data
+ InBytes = number of bytes in InBuf
+ Out: OutBuf = ptr to newly allocated buffer containing decompressed data
+ OutBytes = number of bytes in OutBuf }
+procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
+ out OutBuf: Pointer; out OutBytes: Integer);
+
+
+{ DecompressBuf decompresses data, buffer to buffer, in one call.
+ In: InBuf = ptr to compressed data
+ InBytes = number of bytes in InBuf
+ OutEstimate = zero, or est. size of the decompressed data
+ Out: OutBuf = ptr to newly allocated buffer containing decompressed data
+ OutBytes = number of bytes in OutBuf }
+procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
+ OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
+
+{ DecompressToUserBuf decompresses data, buffer to buffer, in one call.
+ In: InBuf = ptr to compressed data
+ InBytes = number of bytes in InBuf
+ Out: OutBuf = ptr to user-allocated buffer to contain decompressed data
+ BufSize = number of bytes in OutBuf }
+procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
+ const OutBuf: Pointer; BufSize: Integer);
+
+const
+ zlib_version = '1.2.8';
+
+type
+ EZlibError = class(Exception);
+ ECompressionError = class(EZlibError);
+ EDecompressionError = class(EZlibError);
+
+implementation
+
+uses ZLibConst;
+
+const
+ Z_NO_FLUSH = 0;
+ Z_PARTIAL_FLUSH = 1;
+ Z_SYNC_FLUSH = 2;
+ Z_FULL_FLUSH = 3;
+ Z_FINISH = 4;
+
+ Z_OK = 0;
+ Z_STREAM_END = 1;
+ Z_NEED_DICT = 2;
+ Z_ERRNO = (-1);
+ Z_STREAM_ERROR = (-2);
+ Z_DATA_ERROR = (-3);
+ Z_MEM_ERROR = (-4);
+ Z_BUF_ERROR = (-5);
+ Z_VERSION_ERROR = (-6);
+
+ Z_NO_COMPRESSION = 0;
+ Z_BEST_SPEED = 1;
+ Z_BEST_COMPRESSION = 9;
+ Z_DEFAULT_COMPRESSION = (-1);
+
+ Z_FILTERED = 1;
+ Z_HUFFMAN_ONLY = 2;
+ Z_RLE = 3;
+ Z_DEFAULT_STRATEGY = 0;
+
+ Z_BINARY = 0;
+ Z_ASCII = 1;
+ Z_UNKNOWN = 2;
+
+ Z_DEFLATED = 8;
+
+
+{$L adler32.obj}
+{$L compress.obj}
+{$L crc32.obj}
+{$L deflate.obj}
+{$L infback.obj}
+{$L inffast.obj}
+{$L inflate.obj}
+{$L inftrees.obj}
+{$L trees.obj}
+{$L uncompr.obj}
+{$L zutil.obj}
+
+procedure adler32; external;
+procedure compressBound; external;
+procedure crc32; external;
+procedure deflateInit2_; external;
+procedure deflateParams; external;
+
+function _malloc(Size: Integer): Pointer; cdecl;
+begin
+ Result := AllocMem(Size);
+end;
+
+procedure _free(Block: Pointer); cdecl;
+begin
+ FreeMem(Block);
+end;
+
+procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
+begin
+ FillChar(P^, count, B);
+end;
+
+procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
+begin
+ Move(source^, dest^, count);
+end;
+
+
+
+// deflate compresses data
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
+ recsize: Integer): Integer; external;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function deflateEnd(var strm: TZStreamRec): Integer; external;
+
+// inflate decompresses data
+function inflateInit_(var strm: TZStreamRec; version: PChar;
+ recsize: Integer): Integer; external;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function inflateEnd(var strm: TZStreamRec): Integer; external;
+function inflateReset(var strm: TZStreamRec): Integer; external;
+
+
+function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
+begin
+// GetMem(Result, Items*Size);
+ Result := AllocMem(Items * Size);
+end;
+
+procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
+begin
+ FreeMem(Block);
+end;
+
+{function zlibCheck(code: Integer): Integer;
+begin
+ Result := code;
+ if code < 0 then
+ raise EZlibError.Create('error'); //!!
+end;}
+
+function CCheck(code: Integer): Integer;
+begin
+ Result := code;
+ if code < 0 then
+ raise ECompressionError.Create('error'); //!!
+end;
+
+function DCheck(code: Integer): Integer;
+begin
+ Result := code;
+ if code < 0 then
+ raise EDecompressionError.Create('error'); //!!
+end;
+
+procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
+ out OutBuf: Pointer; out OutBytes: Integer);
+var
+ strm: TZStreamRec;
+ P: Pointer;
+begin
+ FillChar(strm, sizeof(strm), 0);
+ strm.zalloc := zlibAllocMem;
+ strm.zfree := zlibFreeMem;
+ OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
+ GetMem(OutBuf, OutBytes);
+ try
+ strm.next_in := InBuf;
+ strm.avail_in := InBytes;
+ strm.next_out := OutBuf;
+ strm.avail_out := OutBytes;
+ CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
+ try
+ while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
+ begin
+ P := OutBuf;
+ Inc(OutBytes, 256);
+ ReallocMem(OutBuf, OutBytes);
+ strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
+ strm.avail_out := 256;
+ end;
+ finally
+ CCheck(deflateEnd(strm));
+ end;
+ ReallocMem(OutBuf, strm.total_out);
+ OutBytes := strm.total_out;
+ except
+ FreeMem(OutBuf);
+ raise
+ end;
+end;
+
+
+procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
+ OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
+var
+ strm: TZStreamRec;
+ P: Pointer;
+ BufInc: Integer;
+begin
+ FillChar(strm, sizeof(strm), 0);
+ strm.zalloc := zlibAllocMem;
+ strm.zfree := zlibFreeMem;
+ BufInc := (InBytes + 255) and not 255;
+ if OutEstimate = 0 then
+ OutBytes := BufInc
+ else
+ OutBytes := OutEstimate;
+ GetMem(OutBuf, OutBytes);
+ try
+ strm.next_in := InBuf;
+ strm.avail_in := InBytes;
+ strm.next_out := OutBuf;
+ strm.avail_out := OutBytes;
+ DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
+ try
+ while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do
+ begin
+ P := OutBuf;
+ Inc(OutBytes, BufInc);
+ ReallocMem(OutBuf, OutBytes);
+ strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
+ strm.avail_out := BufInc;
+ end;
+ finally
+ DCheck(inflateEnd(strm));
+ end;
+ ReallocMem(OutBuf, strm.total_out);
+ OutBytes := strm.total_out;
+ except
+ FreeMem(OutBuf);
+ raise
+ end;
+end;
+
+procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
+ const OutBuf: Pointer; BufSize: Integer);
+var
+ strm: TZStreamRec;
+begin
+ FillChar(strm, sizeof(strm), 0);
+ strm.zalloc := zlibAllocMem;
+ strm.zfree := zlibFreeMem;
+ strm.next_in := InBuf;
+ strm.avail_in := InBytes;
+ strm.next_out := OutBuf;
+ strm.avail_out := BufSize;
+ DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
+ try
+ if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then
+ raise EZlibError.CreateRes(@sTargetBufferTooSmall);
+ finally
+ DCheck(inflateEnd(strm));
+ end;
+end;
+
+// TCustomZlibStream
+
+constructor TCustomZLibStream.Create(Strm: TStream);
+begin
+ inherited Create;
+ FStrm := Strm;
+ FStrmPos := Strm.Position;
+ FZRec.zalloc := zlibAllocMem;
+ FZRec.zfree := zlibFreeMem;
+end;
+
+procedure TCustomZLibStream.Progress(Sender: TObject);
+begin
+ if Assigned(FOnProgress) then FOnProgress(Sender);
+end;
+
+
+// TCompressionStream
+
+constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
+ Dest: TStream);
+const
+ Levels: array [TCompressionLevel] of ShortInt =
+ (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
+begin
+ inherited Create(Dest);
+ FZRec.next_out := FBuffer;
+ FZRec.avail_out := sizeof(FBuffer);
+ CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
+end;
+
+destructor TCompressionStream.Destroy;
+begin
+ FZRec.next_in := nil;
+ FZRec.avail_in := 0;
+ try
+ if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+ while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
+ and (FZRec.avail_out = 0) do
+ begin
+ FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
+ FZRec.next_out := FBuffer;
+ FZRec.avail_out := sizeof(FBuffer);
+ end;
+ if FZRec.avail_out < sizeof(FBuffer) then
+ FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
+ finally
+ deflateEnd(FZRec);
+ end;
+ inherited Destroy;
+end;
+
+function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
+begin
+ raise ECompressionError.CreateRes(@sInvalidStreamOp);
+end;
+
+function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
+begin
+ FZRec.next_in := @Buffer;
+ FZRec.avail_in := Count;
+ if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+ while (FZRec.avail_in > 0) do
+ begin
+ CCheck(deflate(FZRec, 0));
+ if FZRec.avail_out = 0 then
+ begin
+ FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
+ FZRec.next_out := FBuffer;
+ FZRec.avail_out := sizeof(FBuffer);
+ FStrmPos := FStrm.Position;
+ Progress(Self);
+ end;
+ end;
+ Result := Count;
+end;
+
+function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+ if (Offset = 0) and (Origin = soFromCurrent) then
+ Result := FZRec.total_in
+ else
+ raise ECompressionError.CreateRes(@sInvalidStreamOp);
+end;
+
+function TCompressionStream.GetCompressionRate: Single;
+begin
+ if FZRec.total_in = 0 then
+ Result := 0
+ else
+ Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
+end;
+
+
+// TDecompressionStream
+
+constructor TDecompressionStream.Create(Source: TStream);
+begin
+ inherited Create(Source);
+ FZRec.next_in := FBuffer;
+ FZRec.avail_in := 0;
+ DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
+end;
+
+destructor TDecompressionStream.Destroy;
+begin
+ FStrm.Seek(-FZRec.avail_in, 1);
+ inflateEnd(FZRec);
+ inherited Destroy;
+end;
+
+function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
+begin
+ FZRec.next_out := @Buffer;
+ FZRec.avail_out := Count;
+ if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+ while (FZRec.avail_out > 0) do
+ begin
+ if FZRec.avail_in = 0 then
+ begin
+ FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
+ if FZRec.avail_in = 0 then
+ begin
+ Result := Count - FZRec.avail_out;
+ Exit;
+ end;
+ FZRec.next_in := FBuffer;
+ FStrmPos := FStrm.Position;
+ Progress(Self);
+ end;
+ CCheck(inflate(FZRec, 0));
+ end;
+ Result := Count;
+end;
+
+function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
+begin
+ raise EDecompressionError.CreateRes(@sInvalidStreamOp);
+end;
+
+function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
+var
+ I: Integer;
+ Buf: array [0..4095] of Char;
+begin
+ if (Offset = 0) and (Origin = soFromBeginning) then
+ begin
+ DCheck(inflateReset(FZRec));
+ FZRec.next_in := FBuffer;
+ FZRec.avail_in := 0;
+ FStrm.Position := 0;
+ FStrmPos := 0;
+ end
+ else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
+ ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
+ begin
+ if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
+ if Offset > 0 then
+ begin
+ for I := 1 to Offset div sizeof(Buf) do
+ ReadBuffer(Buf, sizeof(Buf));
+ ReadBuffer(Buf, Offset mod sizeof(Buf));
+ end;
+ end
+ else
+ raise EDecompressionError.CreateRes(@sInvalidStreamOp);
+ Result := FZRec.total_out;
+end;
+
+
+end.
diff --git a/compat/zlib/contrib/delphi/ZLibConst.pas b/compat/zlib/contrib/delphi/ZLibConst.pas
new file mode 100644
index 0000000..cdfe136
--- /dev/null
+++ b/compat/zlib/contrib/delphi/ZLibConst.pas
@@ -0,0 +1,11 @@
+unit ZLibConst;
+
+interface
+
+resourcestring
+ sTargetBufferTooSmall = 'ZLib error: target buffer may be too small';
+ sInvalidStreamOp = 'Invalid stream operation';
+
+implementation
+
+end.
diff --git a/compat/zlib/contrib/delphi/readme.txt b/compat/zlib/contrib/delphi/readme.txt
new file mode 100644
index 0000000..2dc9a8b
--- /dev/null
+++ b/compat/zlib/contrib/delphi/readme.txt
@@ -0,0 +1,76 @@
+
+Overview
+========
+
+This directory contains an update to the ZLib interface unit,
+distributed by Borland as a Delphi supplemental component.
+
+The original ZLib unit is Copyright (c) 1997,99 Borland Corp.,
+and is based on zlib version 1.0.4. There are a series of bugs
+and security problems associated with that old zlib version, and
+we recommend the users to update their ZLib unit.
+
+
+Summary of modifications
+========================
+
+- Improved makefile, adapted to zlib version 1.2.1.
+
+- Some field types from TZStreamRec are changed from Integer to
+ Longint, for consistency with the zlib.h header, and for 64-bit
+ readiness.
+
+- The zlib_version constant is updated.
+
+- The new Z_RLE strategy has its corresponding symbolic constant.
+
+- The allocation and deallocation functions and function types
+ (TAlloc, TFree, zlibAllocMem and zlibFreeMem) are now cdecl,
+ and _malloc and _free are added as C RTL stubs. As a result,
+ the original C sources of zlib can be compiled out of the box,
+ and linked to the ZLib unit.
+
+
+Suggestions for improvements
+============================
+
+Currently, the ZLib unit provides only a limited wrapper around
+the zlib library, and much of the original zlib functionality is
+missing. Handling compressed file formats like ZIP/GZIP or PNG
+cannot be implemented without having this functionality.
+Applications that handle these formats are either using their own,
+duplicated code, or not using the ZLib unit at all.
+
+Here are a few suggestions:
+
+- Checksum class wrappers around adler32() and crc32(), similar
+ to the Java classes that implement the java.util.zip.Checksum
+ interface.
+
+- The ability to read and write raw deflate streams, without the
+ zlib stream header and trailer. Raw deflate streams are used
+ in the ZIP file format.
+
+- The ability to read and write gzip streams, used in the GZIP
+ file format, and normally produced by the gzip program.
+
+- The ability to select a different compression strategy, useful
+ to PNG and MNG image compression, and to multimedia compression
+ in general. Besides the compression level
+
+ TCompressionLevel = (clNone, clFastest, clDefault, clMax);
+
+ which, in fact, could have used the 'z' prefix and avoided
+ TColor-like symbols
+
+ TCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
+
+ there could be a compression strategy
+
+ TCompressionStrategy = (zsDefault, zsFiltered, zsHuffmanOnly, zsRle);
+
+- ZIP and GZIP stream handling via TStreams.
+
+
+--
+Cosmin Truta <cosmint@cs.ubbcluj.ro>
diff --git a/compat/zlib/contrib/delphi/zlibd32.mak b/compat/zlib/contrib/delphi/zlibd32.mak
new file mode 100644
index 0000000..9bb00b7
--- /dev/null
+++ b/compat/zlib/contrib/delphi/zlibd32.mak
@@ -0,0 +1,99 @@
+# Makefile for zlib
+# For use with Delphi and C++ Builder under Win32
+# Updated for zlib 1.2.x by Cosmin Truta
+
+# ------------ Borland C++ ------------
+
+# This project uses the Delphi (fastcall/register) calling convention:
+LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl
+
+CC = bcc32
+LD = bcc32
+AR = tlib
+# do not use "-pr" in CFLAGS
+CFLAGS = -a -d -k- -O2 $(LOC)
+LDFLAGS =
+
+
+# variables
+ZLIB_LIB = zlib.lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
+OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(CFLAGS) $*.c
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.c zlib.h zconf.h
+
+minigzip.obj: test/minigzip.c zlib.h zconf.h
+
+
+# For the sake of the old Borland make,
+# the command line is cut to fit in the MS-DOS 128 byte limit:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2)
+ -del $(ZLIB_LIB)
+ $(AR) $(ZLIB_LIB) $(OBJP1)
+ $(AR) $(ZLIB_LIB) $(OBJP2)
+
+
+# testing
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
+
+
+# cleanup
+clean:
+ -del *.obj
+ -del *.exe
+ -del *.lib
+ -del *.tds
+ -del zlib.bak
+ -del foo.gz
+
diff --git a/compat/zlib/contrib/dotzlib/DotZLib.build b/compat/zlib/contrib/dotzlib/DotZLib.build
new file mode 100644
index 0000000..7f90d6b
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib.build
@@ -0,0 +1,33 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<project name="DotZLib" default="build" basedir="./DotZLib">
+ <description>A .Net wrapper library around ZLib1.dll</description>
+
+ <property name="nunit.location" value="c:/program files/NUnit V2.1/bin" />
+ <property name="build.root" value="bin" />
+
+ <property name="debug" value="true" />
+ <property name="nunit" value="true" />
+
+ <property name="build.folder" value="${build.root}/debug/" if="${debug}" />
+ <property name="build.folder" value="${build.root}/release/" unless="${debug}" />
+
+ <target name="clean" description="Remove all generated files">
+ <delete dir="${build.root}" failonerror="false" />
+ </target>
+
+ <target name="build" description="compiles the source code">
+
+ <mkdir dir="${build.folder}" />
+ <csc target="library" output="${build.folder}DotZLib.dll" debug="${debug}">
+ <references basedir="${nunit.location}">
+ <includes if="${nunit}" name="nunit.framework.dll" />
+ </references>
+ <sources>
+ <includes name="*.cs" />
+ <excludes name="UnitTests.cs" unless="${nunit}" />
+ </sources>
+ <arg value="/d:nunit" if="${nunit}" />
+ </csc>
+ </target>
+
+</project> \ No newline at end of file
diff --git a/compat/zlib/contrib/dotzlib/DotZLib.chm b/compat/zlib/contrib/dotzlib/DotZLib.chm
new file mode 100644
index 0000000..f214a44
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib.chm
Binary files differ
diff --git a/compat/zlib/contrib/dotzlib/DotZLib.sln b/compat/zlib/contrib/dotzlib/DotZLib.sln
new file mode 100644
index 0000000..ac45ca0
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib.sln
@@ -0,0 +1,21 @@
+Microsoft Visual Studio Solution File, Format Version 8.00
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "DotZLib", "DotZLib\DotZLib.csproj", "{BB1EE0B1-1808-46CB-B786-949D91117FC5}"
+ ProjectSection(ProjectDependencies) = postProject
+ EndProjectSection
+EndProject
+Global
+ GlobalSection(SolutionConfiguration) = preSolution
+ Debug = Debug
+ Release = Release
+ EndGlobalSection
+ GlobalSection(ProjectConfiguration) = postSolution
+ {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.ActiveCfg = Debug|.NET
+ {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.Build.0 = Debug|.NET
+ {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.ActiveCfg = Release|.NET
+ {BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.Build.0 = Release|.NET
+ EndGlobalSection
+ GlobalSection(ExtensibilityGlobals) = postSolution
+ EndGlobalSection
+ GlobalSection(ExtensibilityAddIns) = postSolution
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs b/compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs
new file mode 100644
index 0000000..0491bfc
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs
@@ -0,0 +1,58 @@
+using System.Reflection;
+using System.Runtime.CompilerServices;
+
+//
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+//
+[assembly: AssemblyTitle("DotZLib")]
+[assembly: AssemblyDescription(".Net bindings for ZLib compression dll 1.2.x")]
+[assembly: AssemblyConfiguration("")]
+[assembly: AssemblyCompany("Henrik Ravn")]
+[assembly: AssemblyProduct("")]
+[assembly: AssemblyCopyright("(c) 2004 by Henrik Ravn")]
+[assembly: AssemblyTrademark("")]
+[assembly: AssemblyCulture("")]
+
+//
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// You can specify all the values or you can default the Revision and Build Numbers
+// by using the '*' as shown below:
+
+[assembly: AssemblyVersion("1.0.*")]
+
+//
+// In order to sign your assembly you must specify a key to use. Refer to the
+// Microsoft .NET Framework documentation for more information on assembly signing.
+//
+// Use the attributes below to control which key is used for signing.
+//
+// Notes:
+// (*) If no key is specified, the assembly is not signed.
+// (*) KeyName refers to a key that has been installed in the Crypto Service
+// Provider (CSP) on your machine. KeyFile refers to a file which contains
+// a key.
+// (*) If the KeyFile and the KeyName values are both specified, the
+// following processing occurs:
+// (1) If the KeyName can be found in the CSP, that key is used.
+// (2) If the KeyName does not exist and the KeyFile does exist, the key
+// in the KeyFile is installed into the CSP and used.
+// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
+// When specifying the KeyFile, the location of the KeyFile should be
+// relative to the project output directory which is
+// %Project Directory%\obj\<configuration>. For example, if your KeyFile is
+// located in the project directory, you would specify the AssemblyKeyFile
+// attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
+// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
+// documentation for more information on this.
+//
+[assembly: AssemblyDelaySign(false)]
+[assembly: AssemblyKeyFile("")]
+[assembly: AssemblyKeyName("")]
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs b/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs
new file mode 100644
index 0000000..788b2fc
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs
@@ -0,0 +1,202 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Runtime.InteropServices;
+using System.Text;
+
+
+namespace DotZLib
+{
+ #region ChecksumGeneratorBase
+ /// <summary>
+ /// Implements the common functionality needed for all <see cref="ChecksumGenerator"/>s
+ /// </summary>
+ /// <example></example>
+ public abstract class ChecksumGeneratorBase : ChecksumGenerator
+ {
+ /// <summary>
+ /// The value of the current checksum
+ /// </summary>
+ protected uint _current;
+
+ /// <summary>
+ /// Initializes a new instance of the checksum generator base - the current checksum is
+ /// set to zero
+ /// </summary>
+ public ChecksumGeneratorBase()
+ {
+ _current = 0;
+ }
+
+ /// <summary>
+ /// Initializes a new instance of the checksum generator basewith a specified value
+ /// </summary>
+ /// <param name="initialValue">The value to set the current checksum to</param>
+ public ChecksumGeneratorBase(uint initialValue)
+ {
+ _current = initialValue;
+ }
+
+ /// <summary>
+ /// Resets the current checksum to zero
+ /// </summary>
+ public void Reset() { _current = 0; }
+
+ /// <summary>
+ /// Gets the current checksum value
+ /// </summary>
+ public uint Value { get { return _current; } }
+
+ /// <summary>
+ /// Updates the current checksum with part of an array of bytes
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ /// <param name="offset">Where in <c>data</c> to start updating</param>
+ /// <param name="count">The number of bytes from <c>data</c> to use</param>
+ /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
+ /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
+ /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
+ /// <remarks>All the other <c>Update</c> methods are implmeneted in terms of this one.
+ /// This is therefore the only method a derived class has to implement</remarks>
+ public abstract void Update(byte[] data, int offset, int count);
+
+ /// <summary>
+ /// Updates the current checksum with an array of bytes.
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ public void Update(byte[] data)
+ {
+ Update(data, 0, data.Length);
+ }
+
+ /// <summary>
+ /// Updates the current checksum with the data from a string
+ /// </summary>
+ /// <param name="data">The string to update the checksum with</param>
+ /// <remarks>The characters in the string are converted by the UTF-8 encoding</remarks>
+ public void Update(string data)
+ {
+ Update(Encoding.UTF8.GetBytes(data));
+ }
+
+ /// <summary>
+ /// Updates the current checksum with the data from a string, using a specific encoding
+ /// </summary>
+ /// <param name="data">The string to update the checksum with</param>
+ /// <param name="encoding">The encoding to use</param>
+ public void Update(string data, Encoding encoding)
+ {
+ Update(encoding.GetBytes(data));
+ }
+
+ }
+ #endregion
+
+ #region CRC32
+ /// <summary>
+ /// Implements a CRC32 checksum generator
+ /// </summary>
+ public sealed class CRC32Checksum : ChecksumGeneratorBase
+ {
+ #region DLL imports
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern uint crc32(uint crc, int data, uint length);
+
+ #endregion
+
+ /// <summary>
+ /// Initializes a new instance of the CRC32 checksum generator
+ /// </summary>
+ public CRC32Checksum() : base() {}
+
+ /// <summary>
+ /// Initializes a new instance of the CRC32 checksum generator with a specified value
+ /// </summary>
+ /// <param name="initialValue">The value to set the current checksum to</param>
+ public CRC32Checksum(uint initialValue) : base(initialValue) {}
+
+ /// <summary>
+ /// Updates the current checksum with part of an array of bytes
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ /// <param name="offset">Where in <c>data</c> to start updating</param>
+ /// <param name="count">The number of bytes from <c>data</c> to use</param>
+ /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
+ /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
+ /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
+ public override void Update(byte[] data, int offset, int count)
+ {
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > data.Length) throw new ArgumentException();
+ GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned);
+ try
+ {
+ _current = crc32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count);
+ }
+ finally
+ {
+ hData.Free();
+ }
+ }
+
+ }
+ #endregion
+
+ #region Adler
+ /// <summary>
+ /// Implements a checksum generator that computes the Adler checksum on data
+ /// </summary>
+ public sealed class AdlerChecksum : ChecksumGeneratorBase
+ {
+ #region DLL imports
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern uint adler32(uint adler, int data, uint length);
+
+ #endregion
+
+ /// <summary>
+ /// Initializes a new instance of the Adler checksum generator
+ /// </summary>
+ public AdlerChecksum() : base() {}
+
+ /// <summary>
+ /// Initializes a new instance of the Adler checksum generator with a specified value
+ /// </summary>
+ /// <param name="initialValue">The value to set the current checksum to</param>
+ public AdlerChecksum(uint initialValue) : base(initialValue) {}
+
+ /// <summary>
+ /// Updates the current checksum with part of an array of bytes
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ /// <param name="offset">Where in <c>data</c> to start updating</param>
+ /// <param name="count">The number of bytes from <c>data</c> to use</param>
+ /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
+ /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
+ /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
+ public override void Update(byte[] data, int offset, int count)
+ {
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > data.Length) throw new ArgumentException();
+ GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned);
+ try
+ {
+ _current = adler32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count);
+ }
+ finally
+ {
+ hData.Free();
+ }
+ }
+
+ }
+ #endregion
+
+} \ No newline at end of file
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs b/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs
new file mode 100644
index 0000000..c1cab3a
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs
@@ -0,0 +1,83 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Diagnostics;
+
+namespace DotZLib
+{
+
+ /// <summary>
+ /// This class implements a circular buffer
+ /// </summary>
+ internal class CircularBuffer
+ {
+ #region Private data
+ private int _capacity;
+ private int _head;
+ private int _tail;
+ private int _size;
+ private byte[] _buffer;
+ #endregion
+
+ public CircularBuffer(int capacity)
+ {
+ Debug.Assert( capacity > 0 );
+ _buffer = new byte[capacity];
+ _capacity = capacity;
+ _head = 0;
+ _tail = 0;
+ _size = 0;
+ }
+
+ public int Size { get { return _size; } }
+
+ public int Put(byte[] source, int offset, int count)
+ {
+ Debug.Assert( count > 0 );
+ int trueCount = Math.Min(count, _capacity - Size);
+ for (int i = 0; i < trueCount; ++i)
+ _buffer[(_tail+i) % _capacity] = source[offset+i];
+ _tail += trueCount;
+ _tail %= _capacity;
+ _size += trueCount;
+ return trueCount;
+ }
+
+ public bool Put(byte b)
+ {
+ if (Size == _capacity) // no room
+ return false;
+ _buffer[_tail++] = b;
+ _tail %= _capacity;
+ ++_size;
+ return true;
+ }
+
+ public int Get(byte[] destination, int offset, int count)
+ {
+ int trueCount = Math.Min(count,Size);
+ for (int i = 0; i < trueCount; ++i)
+ destination[offset + i] = _buffer[(_head+i) % _capacity];
+ _head += trueCount;
+ _head %= _capacity;
+ _size -= trueCount;
+ return trueCount;
+ }
+
+ public int Get()
+ {
+ if (Size == 0)
+ return -1;
+
+ int result = (int)_buffer[_head++ % _capacity];
+ --_size;
+ return result;
+ }
+
+ }
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs b/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs
new file mode 100644
index 0000000..42e6da3
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs
@@ -0,0 +1,198 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Runtime.InteropServices;
+
+namespace DotZLib
+{
+ /// <summary>
+ /// Implements the common functionality needed for all <see cref="Codec"/>s
+ /// </summary>
+ public abstract class CodecBase : Codec, IDisposable
+ {
+
+ #region Data members
+
+ /// <summary>
+ /// Instance of the internal zlib buffer structure that is
+ /// passed to all functions in the zlib dll
+ /// </summary>
+ internal ZStream _ztream = new ZStream();
+
+ /// <summary>
+ /// True if the object instance has been disposed, false otherwise
+ /// </summary>
+ protected bool _isDisposed = false;
+
+ /// <summary>
+ /// The size of the internal buffers
+ /// </summary>
+ protected const int kBufferSize = 16384;
+
+ private byte[] _outBuffer = new byte[kBufferSize];
+ private byte[] _inBuffer = new byte[kBufferSize];
+
+ private GCHandle _hInput;
+ private GCHandle _hOutput;
+
+ private uint _checksum = 0;
+
+ #endregion
+
+ /// <summary>
+ /// Initializes a new instance of the <c>CodeBase</c> class.
+ /// </summary>
+ public CodecBase()
+ {
+ try
+ {
+ _hInput = GCHandle.Alloc(_inBuffer, GCHandleType.Pinned);
+ _hOutput = GCHandle.Alloc(_outBuffer, GCHandleType.Pinned);
+ }
+ catch (Exception)
+ {
+ CleanUp(false);
+ throw;
+ }
+ }
+
+
+ #region Codec Members
+
+ /// <summary>
+ /// Occurs when more processed data are available.
+ /// </summary>
+ public event DataAvailableHandler DataAvailable;
+
+ /// <summary>
+ /// Fires the <see cref="DataAvailable"/> event
+ /// </summary>
+ protected void OnDataAvailable()
+ {
+ if (_ztream.total_out > 0)
+ {
+ if (DataAvailable != null)
+ DataAvailable( _outBuffer, 0, (int)_ztream.total_out);
+ resetOutput();
+ }
+ }
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ public void Add(byte[] data)
+ {
+ Add(data,0,data.Length);
+ }
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <param name="offset">The index of the first byte to add from <c>data</c></param>
+ /// <param name="count">The number of bytes to add</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ /// <remarks>This must be implemented by a derived class</remarks>
+ public abstract void Add(byte[] data, int offset, int count);
+
+ /// <summary>
+ /// Finishes up any pending data that needs to be processed and handled.
+ /// </summary>
+ /// <remarks>This must be implemented by a derived class</remarks>
+ public abstract void Finish();
+
+ /// <summary>
+ /// Gets the checksum of the data that has been added so far
+ /// </summary>
+ public uint Checksum { get { return _checksum; } }
+
+ #endregion
+
+ #region Destructor & IDisposable stuff
+
+ /// <summary>
+ /// Destroys this instance
+ /// </summary>
+ ~CodecBase()
+ {
+ CleanUp(false);
+ }
+
+ /// <summary>
+ /// Releases any unmanaged resources and calls the <see cref="CleanUp()"/> method of the derived class
+ /// </summary>
+ public void Dispose()
+ {
+ CleanUp(true);
+ }
+
+ /// <summary>
+ /// Performs any codec specific cleanup
+ /// </summary>
+ /// <remarks>This must be implemented by a derived class</remarks>
+ protected abstract void CleanUp();
+
+ // performs the release of the handles and calls the dereived CleanUp()
+ private void CleanUp(bool isDisposing)
+ {
+ if (!_isDisposed)
+ {
+ CleanUp();
+ if (_hInput.IsAllocated)
+ _hInput.Free();
+ if (_hOutput.IsAllocated)
+ _hOutput.Free();
+
+ _isDisposed = true;
+ }
+ }
+
+
+ #endregion
+
+ #region Helper methods
+
+ /// <summary>
+ /// Copies a number of bytes to the internal codec buffer - ready for proccesing
+ /// </summary>
+ /// <param name="data">The byte array that contains the data to copy</param>
+ /// <param name="startIndex">The index of the first byte to copy</param>
+ /// <param name="count">The number of bytes to copy from <c>data</c></param>
+ protected void copyInput(byte[] data, int startIndex, int count)
+ {
+ Array.Copy(data, startIndex, _inBuffer,0, count);
+ _ztream.next_in = _hInput.AddrOfPinnedObject();
+ _ztream.total_in = 0;
+ _ztream.avail_in = (uint)count;
+
+ }
+
+ /// <summary>
+ /// Resets the internal output buffers to a known state - ready for processing
+ /// </summary>
+ protected void resetOutput()
+ {
+ _ztream.total_out = 0;
+ _ztream.avail_out = kBufferSize;
+ _ztream.next_out = _hOutput.AddrOfPinnedObject();
+ }
+
+ /// <summary>
+ /// Updates the running checksum property
+ /// </summary>
+ /// <param name="newSum">The new checksum value</param>
+ protected void setChecksum(uint newSum)
+ {
+ _checksum = newSum;
+ }
+ #endregion
+
+ }
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs b/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs
new file mode 100644
index 0000000..c247792
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs
@@ -0,0 +1,106 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Diagnostics;
+using System.Runtime.InteropServices;
+
+namespace DotZLib
+{
+
+ /// <summary>
+ /// Implements a data compressor, using the deflate algorithm in the ZLib dll
+ /// </summary>
+ public sealed class Deflater : CodecBase
+ {
+ #region Dll imports
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
+ private static extern int deflateInit_(ref ZStream sz, int level, string vs, int size);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int deflate(ref ZStream sz, int flush);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int deflateReset(ref ZStream sz);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int deflateEnd(ref ZStream sz);
+ #endregion
+
+ /// <summary>
+ /// Constructs an new instance of the <c>Deflater</c>
+ /// </summary>
+ /// <param name="level">The compression level to use for this <c>Deflater</c></param>
+ public Deflater(CompressLevel level) : base()
+ {
+ int retval = deflateInit_(ref _ztream, (int)level, Info.Version, Marshal.SizeOf(_ztream));
+ if (retval != 0)
+ throw new ZLibException(retval, "Could not initialize deflater");
+
+ resetOutput();
+ }
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <param name="offset">The index of the first byte to add from <c>data</c></param>
+ /// <param name="count">The number of bytes to add</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ public override void Add(byte[] data, int offset, int count)
+ {
+ if (data == null) throw new ArgumentNullException();
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > data.Length) throw new ArgumentException();
+
+ int total = count;
+ int inputIndex = offset;
+ int err = 0;
+
+ while (err >= 0 && inputIndex < total)
+ {
+ copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize));
+ while (err >= 0 && _ztream.avail_in > 0)
+ {
+ err = deflate(ref _ztream, (int)FlushTypes.None);
+ if (err == 0)
+ while (_ztream.avail_out == 0)
+ {
+ OnDataAvailable();
+ err = deflate(ref _ztream, (int)FlushTypes.None);
+ }
+ inputIndex += (int)_ztream.total_in;
+ }
+ }
+ setChecksum( _ztream.adler );
+ }
+
+
+ /// <summary>
+ /// Finishes up any pending data that needs to be processed and handled.
+ /// </summary>
+ public override void Finish()
+ {
+ int err;
+ do
+ {
+ err = deflate(ref _ztream, (int)FlushTypes.Finish);
+ OnDataAvailable();
+ }
+ while (err == 0);
+ setChecksum( _ztream.adler );
+ deflateReset(ref _ztream);
+ resetOutput();
+ }
+
+ /// <summary>
+ /// Closes the internal zlib deflate stream
+ /// </summary>
+ protected override void CleanUp() { deflateEnd(ref _ztream); }
+
+ }
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs
new file mode 100644
index 0000000..be184b4
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs
@@ -0,0 +1,288 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.IO;
+using System.Runtime.InteropServices;
+using System.Text;
+
+
+namespace DotZLib
+{
+
+ #region Internal types
+
+ /// <summary>
+ /// Defines constants for the various flush types used with zlib
+ /// </summary>
+ internal enum FlushTypes
+ {
+ None, Partial, Sync, Full, Finish, Block
+ }
+
+ #region ZStream structure
+ // internal mapping of the zlib zstream structure for marshalling
+ [StructLayoutAttribute(LayoutKind.Sequential, Pack=4, Size=0, CharSet=CharSet.Ansi)]
+ internal struct ZStream
+ {
+ public IntPtr next_in;
+ public uint avail_in;
+ public uint total_in;
+
+ public IntPtr next_out;
+ public uint avail_out;
+ public uint total_out;
+
+ [MarshalAs(UnmanagedType.LPStr)]
+ string msg;
+ uint state;
+
+ uint zalloc;
+ uint zfree;
+ uint opaque;
+
+ int data_type;
+ public uint adler;
+ uint reserved;
+ }
+
+ #endregion
+
+ #endregion
+
+ #region Public enums
+ /// <summary>
+ /// Defines constants for the available compression levels in zlib
+ /// </summary>
+ public enum CompressLevel : int
+ {
+ /// <summary>
+ /// The default compression level with a reasonable compromise between compression and speed
+ /// </summary>
+ Default = -1,
+ /// <summary>
+ /// No compression at all. The data are passed straight through.
+ /// </summary>
+ None = 0,
+ /// <summary>
+ /// The maximum compression rate available.
+ /// </summary>
+ Best = 9,
+ /// <summary>
+ /// The fastest available compression level.
+ /// </summary>
+ Fastest = 1
+ }
+ #endregion
+
+ #region Exception classes
+ /// <summary>
+ /// The exception that is thrown when an error occurs on the zlib dll
+ /// </summary>
+ public class ZLibException : ApplicationException
+ {
+ /// <summary>
+ /// Initializes a new instance of the <see cref="ZLibException"/> class with a specified
+ /// error message and error code
+ /// </summary>
+ /// <param name="errorCode">The zlib error code that caused the exception</param>
+ /// <param name="msg">A message that (hopefully) describes the error</param>
+ public ZLibException(int errorCode, string msg) : base(String.Format("ZLib error {0} {1}", errorCode, msg))
+ {
+ }
+
+ /// <summary>
+ /// Initializes a new instance of the <see cref="ZLibException"/> class with a specified
+ /// error code
+ /// </summary>
+ /// <param name="errorCode">The zlib error code that caused the exception</param>
+ public ZLibException(int errorCode) : base(String.Format("ZLib error {0}", errorCode))
+ {
+ }
+ }
+ #endregion
+
+ #region Interfaces
+
+ /// <summary>
+ /// Declares methods and properties that enables a running checksum to be calculated
+ /// </summary>
+ public interface ChecksumGenerator
+ {
+ /// <summary>
+ /// Gets the current value of the checksum
+ /// </summary>
+ uint Value { get; }
+
+ /// <summary>
+ /// Clears the current checksum to 0
+ /// </summary>
+ void Reset();
+
+ /// <summary>
+ /// Updates the current checksum with an array of bytes
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ void Update(byte[] data);
+
+ /// <summary>
+ /// Updates the current checksum with part of an array of bytes
+ /// </summary>
+ /// <param name="data">The data to update the checksum with</param>
+ /// <param name="offset">Where in <c>data</c> to start updating</param>
+ /// <param name="count">The number of bytes from <c>data</c> to use</param>
+ /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
+ /// <exception cref="ArgumentNullException"><c>data</c> is a null reference</exception>
+ /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
+ void Update(byte[] data, int offset, int count);
+
+ /// <summary>
+ /// Updates the current checksum with the data from a string
+ /// </summary>
+ /// <param name="data">The string to update the checksum with</param>
+ /// <remarks>The characters in the string are converted by the UTF-8 encoding</remarks>
+ void Update(string data);
+
+ /// <summary>
+ /// Updates the current checksum with the data from a string, using a specific encoding
+ /// </summary>
+ /// <param name="data">The string to update the checksum with</param>
+ /// <param name="encoding">The encoding to use</param>
+ void Update(string data, Encoding encoding);
+ }
+
+
+ /// <summary>
+ /// Represents the method that will be called from a codec when new data
+ /// are available.
+ /// </summary>
+ /// <paramref name="data">The byte array containing the processed data</paramref>
+ /// <paramref name="startIndex">The index of the first processed byte in <c>data</c></paramref>
+ /// <paramref name="count">The number of processed bytes available</paramref>
+ /// <remarks>On return from this method, the data may be overwritten, so grab it while you can.
+ /// You cannot assume that startIndex will be zero.
+ /// </remarks>
+ public delegate void DataAvailableHandler(byte[] data, int startIndex, int count);
+
+ /// <summary>
+ /// Declares methods and events for implementing compressors/decompressors
+ /// </summary>
+ public interface Codec
+ {
+ /// <summary>
+ /// Occurs when more processed data are available.
+ /// </summary>
+ event DataAvailableHandler DataAvailable;
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ void Add(byte[] data);
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <param name="offset">The index of the first byte to add from <c>data</c></param>
+ /// <param name="count">The number of bytes to add</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ void Add(byte[] data, int offset, int count);
+
+ /// <summary>
+ /// Finishes up any pending data that needs to be processed and handled.
+ /// </summary>
+ void Finish();
+
+ /// <summary>
+ /// Gets the checksum of the data that has been added so far
+ /// </summary>
+ uint Checksum { get; }
+
+
+ }
+
+ #endregion
+
+ #region Classes
+ /// <summary>
+ /// Encapsulates general information about the ZLib library
+ /// </summary>
+ public class Info
+ {
+ #region DLL imports
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern uint zlibCompileFlags();
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern string zlibVersion();
+ #endregion
+
+ #region Private stuff
+ private uint _flags;
+
+ // helper function that unpacks a bitsize mask
+ private static int bitSize(uint bits)
+ {
+ switch (bits)
+ {
+ case 0: return 16;
+ case 1: return 32;
+ case 2: return 64;
+ }
+ return -1;
+ }
+ #endregion
+
+ /// <summary>
+ /// Constructs an instance of the <c>Info</c> class.
+ /// </summary>
+ public Info()
+ {
+ _flags = zlibCompileFlags();
+ }
+
+ /// <summary>
+ /// True if the library is compiled with debug info
+ /// </summary>
+ public bool HasDebugInfo { get { return 0 != (_flags & 0x100); } }
+
+ /// <summary>
+ /// True if the library is compiled with assembly optimizations
+ /// </summary>
+ public bool UsesAssemblyCode { get { return 0 != (_flags & 0x200); } }
+
+ /// <summary>
+ /// Gets the size of the unsigned int that was compiled into Zlib
+ /// </summary>
+ public int SizeOfUInt { get { return bitSize(_flags & 3); } }
+
+ /// <summary>
+ /// Gets the size of the unsigned long that was compiled into Zlib
+ /// </summary>
+ public int SizeOfULong { get { return bitSize((_flags >> 2) & 3); } }
+
+ /// <summary>
+ /// Gets the size of the pointers that were compiled into Zlib
+ /// </summary>
+ public int SizeOfPointer { get { return bitSize((_flags >> 4) & 3); } }
+
+ /// <summary>
+ /// Gets the size of the z_off_t type that was compiled into Zlib
+ /// </summary>
+ public int SizeOfOffset { get { return bitSize((_flags >> 6) & 3); } }
+
+ /// <summary>
+ /// Gets the version of ZLib as a string, e.g. "1.2.1"
+ /// </summary>
+ public static string Version { get { return zlibVersion(); } }
+ }
+
+ #endregion
+
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj
new file mode 100644
index 0000000..71eeb85
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj
@@ -0,0 +1,141 @@
+<VisualStudioProject>
+ <CSHARP
+ ProjectType = "Local"
+ ProductVersion = "7.10.3077"
+ SchemaVersion = "2.0"
+ ProjectGuid = "{BB1EE0B1-1808-46CB-B786-949D91117FC5}"
+ >
+ <Build>
+ <Settings
+ ApplicationIcon = ""
+ AssemblyKeyContainerName = ""
+ AssemblyName = "DotZLib"
+ AssemblyOriginatorKeyFile = ""
+ DefaultClientScript = "JScript"
+ DefaultHTMLPageLayout = "Grid"
+ DefaultTargetSchema = "IE50"
+ DelaySign = "false"
+ OutputType = "Library"
+ PreBuildEvent = ""
+ PostBuildEvent = ""
+ RootNamespace = "DotZLib"
+ RunPostBuildEvent = "OnBuildSuccess"
+ StartupObject = ""
+ >
+ <Config
+ Name = "Debug"
+ AllowUnsafeBlocks = "false"
+ BaseAddress = "285212672"
+ CheckForOverflowUnderflow = "false"
+ ConfigurationOverrideFile = ""
+ DefineConstants = "DEBUG;TRACE"
+ DocumentationFile = "docs\DotZLib.xml"
+ DebugSymbols = "true"
+ FileAlignment = "4096"
+ IncrementalBuild = "false"
+ NoStdLib = "false"
+ NoWarn = "1591"
+ Optimize = "false"
+ OutputPath = "bin\Debug\"
+ RegisterForComInterop = "false"
+ RemoveIntegerChecks = "false"
+ TreatWarningsAsErrors = "false"
+ WarningLevel = "4"
+ />
+ <Config
+ Name = "Release"
+ AllowUnsafeBlocks = "false"
+ BaseAddress = "285212672"
+ CheckForOverflowUnderflow = "false"
+ ConfigurationOverrideFile = ""
+ DefineConstants = "TRACE"
+ DocumentationFile = "docs\DotZLib.xml"
+ DebugSymbols = "false"
+ FileAlignment = "4096"
+ IncrementalBuild = "false"
+ NoStdLib = "false"
+ NoWarn = ""
+ Optimize = "true"
+ OutputPath = "bin\Release\"
+ RegisterForComInterop = "false"
+ RemoveIntegerChecks = "false"
+ TreatWarningsAsErrors = "false"
+ WarningLevel = "4"
+ />
+ </Settings>
+ <References>
+ <Reference
+ Name = "System"
+ AssemblyName = "System"
+ HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.dll"
+ />
+ <Reference
+ Name = "System.Data"
+ AssemblyName = "System.Data"
+ HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.Data.dll"
+ />
+ <Reference
+ Name = "System.XML"
+ AssemblyName = "System.Xml"
+ HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.XML.dll"
+ />
+ <Reference
+ Name = "nunit.framework"
+ AssemblyName = "nunit.framework"
+ HintPath = "E:\apps\NUnit V2.1\\bin\nunit.framework.dll"
+ AssemblyFolderKey = "hklm\dn\nunit.framework"
+ />
+ </References>
+ </Build>
+ <Files>
+ <Include>
+ <File
+ RelPath = "AssemblyInfo.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "ChecksumImpl.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "CircularBuffer.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "CodecBase.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "Deflater.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "DotZLib.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "GZipStream.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "Inflater.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ <File
+ RelPath = "UnitTests.cs"
+ SubType = "Code"
+ BuildAction = "Compile"
+ />
+ </Include>
+ </Files>
+ </CSHARP>
+</VisualStudioProject>
+
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs b/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs
new file mode 100644
index 0000000..b161300
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs
@@ -0,0 +1,301 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.IO;
+using System.Runtime.InteropServices;
+
+namespace DotZLib
+{
+ /// <summary>
+ /// Implements a compressed <see cref="Stream"/>, in GZip (.gz) format.
+ /// </summary>
+ public class GZipStream : Stream, IDisposable
+ {
+ #region Dll Imports
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
+ private static extern IntPtr gzopen(string name, string mode);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int gzclose(IntPtr gzFile);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int gzwrite(IntPtr gzFile, int data, int length);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int gzread(IntPtr gzFile, int data, int length);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int gzgetc(IntPtr gzFile);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int gzputc(IntPtr gzFile, int c);
+
+ #endregion
+
+ #region Private data
+ private IntPtr _gzFile;
+ private bool _isDisposed = false;
+ private bool _isWriting;
+ #endregion
+
+ #region Constructors
+ /// <summary>
+ /// Creates a new file as a writeable GZipStream
+ /// </summary>
+ /// <param name="fileName">The name of the compressed file to create</param>
+ /// <param name="level">The compression level to use when adding data</param>
+ /// <exception cref="ZLibException">If an error occurred in the internal zlib function</exception>
+ public GZipStream(string fileName, CompressLevel level)
+ {
+ _isWriting = true;
+ _gzFile = gzopen(fileName, String.Format("wb{0}", (int)level));
+ if (_gzFile == IntPtr.Zero)
+ throw new ZLibException(-1, "Could not open " + fileName);
+ }
+
+ /// <summary>
+ /// Opens an existing file as a readable GZipStream
+ /// </summary>
+ /// <param name="fileName">The name of the file to open</param>
+ /// <exception cref="ZLibException">If an error occurred in the internal zlib function</exception>
+ public GZipStream(string fileName)
+ {
+ _isWriting = false;
+ _gzFile = gzopen(fileName, "rb");
+ if (_gzFile == IntPtr.Zero)
+ throw new ZLibException(-1, "Could not open " + fileName);
+
+ }
+ #endregion
+
+ #region Access properties
+ /// <summary>
+ /// Returns true of this stream can be read from, false otherwise
+ /// </summary>
+ public override bool CanRead
+ {
+ get
+ {
+ return !_isWriting;
+ }
+ }
+
+
+ /// <summary>
+ /// Returns false.
+ /// </summary>
+ public override bool CanSeek
+ {
+ get
+ {
+ return false;
+ }
+ }
+
+ /// <summary>
+ /// Returns true if this tsream is writeable, false otherwise
+ /// </summary>
+ public override bool CanWrite
+ {
+ get
+ {
+ return _isWriting;
+ }
+ }
+ #endregion
+
+ #region Destructor & IDispose stuff
+
+ /// <summary>
+ /// Destroys this instance
+ /// </summary>
+ ~GZipStream()
+ {
+ cleanUp(false);
+ }
+
+ /// <summary>
+ /// Closes the external file handle
+ /// </summary>
+ public void Dispose()
+ {
+ cleanUp(true);
+ }
+
+ // Does the actual closing of the file handle.
+ private void cleanUp(bool isDisposing)
+ {
+ if (!_isDisposed)
+ {
+ gzclose(_gzFile);
+ _isDisposed = true;
+ }
+ }
+ #endregion
+
+ #region Basic reading and writing
+ /// <summary>
+ /// Attempts to read a number of bytes from the stream.
+ /// </summary>
+ /// <param name="buffer">The destination data buffer</param>
+ /// <param name="offset">The index of the first destination byte in <c>buffer</c></param>
+ /// <param name="count">The number of bytes requested</param>
+ /// <returns>The number of bytes read</returns>
+ /// <exception cref="ArgumentNullException">If <c>buffer</c> is null</exception>
+ /// <exception cref="ArgumentOutOfRangeException">If <c>count</c> or <c>offset</c> are negative</exception>
+ /// <exception cref="ArgumentException">If <c>offset</c> + <c>count</c> is &gt; buffer.Length</exception>
+ /// <exception cref="NotSupportedException">If this stream is not readable.</exception>
+ /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
+ public override int Read(byte[] buffer, int offset, int count)
+ {
+ if (!CanRead) throw new NotSupportedException();
+ if (buffer == null) throw new ArgumentNullException();
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > buffer.Length) throw new ArgumentException();
+ if (_isDisposed) throw new ObjectDisposedException("GZipStream");
+
+ GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned);
+ int result;
+ try
+ {
+ result = gzread(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count);
+ if (result < 0)
+ throw new IOException();
+ }
+ finally
+ {
+ h.Free();
+ }
+ return result;
+ }
+
+ /// <summary>
+ /// Attempts to read a single byte from the stream.
+ /// </summary>
+ /// <returns>The byte that was read, or -1 in case of error or End-Of-File</returns>
+ public override int ReadByte()
+ {
+ if (!CanRead) throw new NotSupportedException();
+ if (_isDisposed) throw new ObjectDisposedException("GZipStream");
+ return gzgetc(_gzFile);
+ }
+
+ /// <summary>
+ /// Writes a number of bytes to the stream
+ /// </summary>
+ /// <param name="buffer"></param>
+ /// <param name="offset"></param>
+ /// <param name="count"></param>
+ /// <exception cref="ArgumentNullException">If <c>buffer</c> is null</exception>
+ /// <exception cref="ArgumentOutOfRangeException">If <c>count</c> or <c>offset</c> are negative</exception>
+ /// <exception cref="ArgumentException">If <c>offset</c> + <c>count</c> is &gt; buffer.Length</exception>
+ /// <exception cref="NotSupportedException">If this stream is not writeable.</exception>
+ /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
+ public override void Write(byte[] buffer, int offset, int count)
+ {
+ if (!CanWrite) throw new NotSupportedException();
+ if (buffer == null) throw new ArgumentNullException();
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > buffer.Length) throw new ArgumentException();
+ if (_isDisposed) throw new ObjectDisposedException("GZipStream");
+
+ GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned);
+ try
+ {
+ int result = gzwrite(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count);
+ if (result < 0)
+ throw new IOException();
+ }
+ finally
+ {
+ h.Free();
+ }
+ }
+
+ /// <summary>
+ /// Writes a single byte to the stream
+ /// </summary>
+ /// <param name="value">The byte to add to the stream.</param>
+ /// <exception cref="NotSupportedException">If this stream is not writeable.</exception>
+ /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
+ public override void WriteByte(byte value)
+ {
+ if (!CanWrite) throw new NotSupportedException();
+ if (_isDisposed) throw new ObjectDisposedException("GZipStream");
+
+ int result = gzputc(_gzFile, (int)value);
+ if (result < 0)
+ throw new IOException();
+ }
+ #endregion
+
+ #region Position & length stuff
+ /// <summary>
+ /// Not supported.
+ /// </summary>
+ /// <param name="value"></param>
+ /// <exception cref="NotSupportedException">Always thrown</exception>
+ public override void SetLength(long value)
+ {
+ throw new NotSupportedException();
+ }
+
+ /// <summary>
+ /// Not suppported.
+ /// </summary>
+ /// <param name="offset"></param>
+ /// <param name="origin"></param>
+ /// <returns></returns>
+ /// <exception cref="NotSupportedException">Always thrown</exception>
+ public override long Seek(long offset, SeekOrigin origin)
+ {
+ throw new NotSupportedException();
+ }
+
+ /// <summary>
+ /// Flushes the <c>GZipStream</c>.
+ /// </summary>
+ /// <remarks>In this implementation, this method does nothing. This is because excessive
+ /// flushing may degrade the achievable compression rates.</remarks>
+ public override void Flush()
+ {
+ // left empty on purpose
+ }
+
+ /// <summary>
+ /// Gets/sets the current position in the <c>GZipStream</c>. Not suppported.
+ /// </summary>
+ /// <remarks>In this implementation this property is not supported</remarks>
+ /// <exception cref="NotSupportedException">Always thrown</exception>
+ public override long Position
+ {
+ get
+ {
+ throw new NotSupportedException();
+ }
+ set
+ {
+ throw new NotSupportedException();
+ }
+ }
+
+ /// <summary>
+ /// Gets the size of the stream. Not suppported.
+ /// </summary>
+ /// <remarks>In this implementation this property is not supported</remarks>
+ /// <exception cref="NotSupportedException">Always thrown</exception>
+ public override long Length
+ {
+ get
+ {
+ throw new NotSupportedException();
+ }
+ }
+ #endregion
+ }
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs b/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs
new file mode 100644
index 0000000..8ed5451
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs
@@ -0,0 +1,105 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Diagnostics;
+using System.Runtime.InteropServices;
+
+namespace DotZLib
+{
+
+ /// <summary>
+ /// Implements a data decompressor, using the inflate algorithm in the ZLib dll
+ /// </summary>
+ public class Inflater : CodecBase
+ {
+ #region Dll imports
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
+ private static extern int inflateInit_(ref ZStream sz, string vs, int size);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int inflate(ref ZStream sz, int flush);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int inflateReset(ref ZStream sz);
+
+ [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
+ private static extern int inflateEnd(ref ZStream sz);
+ #endregion
+
+ /// <summary>
+ /// Constructs an new instance of the <c>Inflater</c>
+ /// </summary>
+ public Inflater() : base()
+ {
+ int retval = inflateInit_(ref _ztream, Info.Version, Marshal.SizeOf(_ztream));
+ if (retval != 0)
+ throw new ZLibException(retval, "Could not initialize inflater");
+
+ resetOutput();
+ }
+
+
+ /// <summary>
+ /// Adds more data to the codec to be processed.
+ /// </summary>
+ /// <param name="data">Byte array containing the data to be added to the codec</param>
+ /// <param name="offset">The index of the first byte to add from <c>data</c></param>
+ /// <param name="count">The number of bytes to add</param>
+ /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
+ public override void Add(byte[] data, int offset, int count)
+ {
+ if (data == null) throw new ArgumentNullException();
+ if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
+ if ((offset+count) > data.Length) throw new ArgumentException();
+
+ int total = count;
+ int inputIndex = offset;
+ int err = 0;
+
+ while (err >= 0 && inputIndex < total)
+ {
+ copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize));
+ err = inflate(ref _ztream, (int)FlushTypes.None);
+ if (err == 0)
+ while (_ztream.avail_out == 0)
+ {
+ OnDataAvailable();
+ err = inflate(ref _ztream, (int)FlushTypes.None);
+ }
+
+ inputIndex += (int)_ztream.total_in;
+ }
+ setChecksum( _ztream.adler );
+ }
+
+
+ /// <summary>
+ /// Finishes up any pending data that needs to be processed and handled.
+ /// </summary>
+ public override void Finish()
+ {
+ int err;
+ do
+ {
+ err = inflate(ref _ztream, (int)FlushTypes.Finish);
+ OnDataAvailable();
+ }
+ while (err == 0);
+ setChecksum( _ztream.adler );
+ inflateReset(ref _ztream);
+ resetOutput();
+ }
+
+ /// <summary>
+ /// Closes the internal zlib inflate stream
+ /// </summary>
+ protected override void CleanUp() { inflateEnd(ref _ztream); }
+
+
+ }
+}
diff --git a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
new file mode 100644
index 0000000..b273d54
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
@@ -0,0 +1,274 @@
+//
+// © Copyright Henrik Ravn 2004
+//
+// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+using System;
+using System.Collections;
+using System.IO;
+
+// uncomment the define below to include unit tests
+//#define nunit
+#if nunit
+using NUnit.Framework;
+
+// Unit tests for the DotZLib class library
+// ----------------------------------------
+//
+// Use this with NUnit 2 from http://www.nunit.org
+//
+
+namespace DotZLibTests
+{
+ using DotZLib;
+
+ // helper methods
+ internal class Utils
+ {
+ public static bool byteArrEqual( byte[] lhs, byte[] rhs )
+ {
+ if (lhs.Length != rhs.Length)
+ return false;
+ for (int i = lhs.Length-1; i >= 0; --i)
+ if (lhs[i] != rhs[i])
+ return false;
+ return true;
+ }
+
+ }
+
+
+ [TestFixture]
+ public class CircBufferTests
+ {
+ #region Circular buffer tests
+ [Test]
+ public void SinglePutGet()
+ {
+ CircularBuffer buf = new CircularBuffer(10);
+ Assert.AreEqual( 0, buf.Size );
+ Assert.AreEqual( -1, buf.Get() );
+
+ Assert.IsTrue(buf.Put( 1 ));
+ Assert.AreEqual( 1, buf.Size );
+ Assert.AreEqual( 1, buf.Get() );
+ Assert.AreEqual( 0, buf.Size );
+ Assert.AreEqual( -1, buf.Get() );
+ }
+
+ [Test]
+ public void BlockPutGet()
+ {
+ CircularBuffer buf = new CircularBuffer(10);
+ byte[] arr = {1,2,3,4,5,6,7,8,9,10};
+ Assert.AreEqual( 10, buf.Put(arr,0,10) );
+ Assert.AreEqual( 10, buf.Size );
+ Assert.IsFalse( buf.Put(11) );
+ Assert.AreEqual( 1, buf.Get() );
+ Assert.IsTrue( buf.Put(11) );
+
+ byte[] arr2 = (byte[])arr.Clone();
+ Assert.AreEqual( 9, buf.Get(arr2,1,9) );
+ Assert.IsTrue( Utils.byteArrEqual(arr,arr2) );
+ }
+
+ #endregion
+ }
+
+ [TestFixture]
+ public class ChecksumTests
+ {
+ #region CRC32 Tests
+ [Test]
+ public void CRC32_Null()
+ {
+ CRC32Checksum crc32 = new CRC32Checksum();
+ Assert.AreEqual( 0, crc32.Value );
+
+ crc32 = new CRC32Checksum(1);
+ Assert.AreEqual( 1, crc32.Value );
+
+ crc32 = new CRC32Checksum(556);
+ Assert.AreEqual( 556, crc32.Value );
+ }
+
+ [Test]
+ public void CRC32_Data()
+ {
+ CRC32Checksum crc32 = new CRC32Checksum();
+ byte[] data = { 1,2,3,4,5,6,7 };
+ crc32.Update(data);
+ Assert.AreEqual( 0x70e46888, crc32.Value );
+
+ crc32 = new CRC32Checksum();
+ crc32.Update("penguin");
+ Assert.AreEqual( 0x0e5c1a120, crc32.Value );
+
+ crc32 = new CRC32Checksum(1);
+ crc32.Update("penguin");
+ Assert.AreEqual(0x43b6aa94, crc32.Value);
+
+ }
+ #endregion
+
+ #region Adler tests
+
+ [Test]
+ public void Adler_Null()
+ {
+ AdlerChecksum adler = new AdlerChecksum();
+ Assert.AreEqual(0, adler.Value);
+
+ adler = new AdlerChecksum(1);
+ Assert.AreEqual( 1, adler.Value );
+
+ adler = new AdlerChecksum(556);
+ Assert.AreEqual( 556, adler.Value );
+ }
+
+ [Test]
+ public void Adler_Data()
+ {
+ AdlerChecksum adler = new AdlerChecksum(1);
+ byte[] data = { 1,2,3,4,5,6,7 };
+ adler.Update(data);
+ Assert.AreEqual( 0x5b001d, adler.Value );
+
+ adler = new AdlerChecksum();
+ adler.Update("penguin");
+ Assert.AreEqual(0x0bcf02f6, adler.Value );
+
+ adler = new AdlerChecksum(1);
+ adler.Update("penguin");
+ Assert.AreEqual(0x0bd602f7, adler.Value);
+
+ }
+ #endregion
+ }
+
+ [TestFixture]
+ public class InfoTests
+ {
+ #region Info tests
+ [Test]
+ public void Info_Version()
+ {
+ Info info = new Info();
+ Assert.AreEqual("1.2.8", Info.Version);
+ Assert.AreEqual(32, info.SizeOfUInt);
+ Assert.AreEqual(32, info.SizeOfULong);
+ Assert.AreEqual(32, info.SizeOfPointer);
+ Assert.AreEqual(32, info.SizeOfOffset);
+ }
+ #endregion
+ }
+
+ [TestFixture]
+ public class DeflateInflateTests
+ {
+ #region Deflate tests
+ [Test]
+ public void Deflate_Init()
+ {
+ using (Deflater def = new Deflater(CompressLevel.Default))
+ {
+ }
+ }
+
+ private ArrayList compressedData = new ArrayList();
+ private uint adler1;
+
+ private ArrayList uncompressedData = new ArrayList();
+ private uint adler2;
+
+ public void CDataAvail(byte[] data, int startIndex, int count)
+ {
+ for (int i = 0; i < count; ++i)
+ compressedData.Add(data[i+startIndex]);
+ }
+
+ [Test]
+ public void Deflate_Compress()
+ {
+ compressedData.Clear();
+
+ byte[] testData = new byte[35000];
+ for (int i = 0; i < testData.Length; ++i)
+ testData[i] = 5;
+
+ using (Deflater def = new Deflater((CompressLevel)5))
+ {
+ def.DataAvailable += new DataAvailableHandler(CDataAvail);
+ def.Add(testData);
+ def.Finish();
+ adler1 = def.Checksum;
+ }
+ }
+ #endregion
+
+ #region Inflate tests
+ [Test]
+ public void Inflate_Init()
+ {
+ using (Inflater inf = new Inflater())
+ {
+ }
+ }
+
+ private void DDataAvail(byte[] data, int startIndex, int count)
+ {
+ for (int i = 0; i < count; ++i)
+ uncompressedData.Add(data[i+startIndex]);
+ }
+
+ [Test]
+ public void Inflate_Expand()
+ {
+ uncompressedData.Clear();
+
+ using (Inflater inf = new Inflater())
+ {
+ inf.DataAvailable += new DataAvailableHandler(DDataAvail);
+ inf.Add((byte[])compressedData.ToArray(typeof(byte)));
+ inf.Finish();
+ adler2 = inf.Checksum;
+ }
+ Assert.AreEqual( adler1, adler2 );
+ }
+ #endregion
+ }
+
+ [TestFixture]
+ public class GZipStreamTests
+ {
+ #region GZipStream test
+ [Test]
+ public void GZipStream_WriteRead()
+ {
+ using (GZipStream gzOut = new GZipStream("gzstream.gz", CompressLevel.Best))
+ {
+ BinaryWriter writer = new BinaryWriter(gzOut);
+ writer.Write("hi there");
+ writer.Write(Math.PI);
+ writer.Write(42);
+ }
+
+ using (GZipStream gzIn = new GZipStream("gzstream.gz"))
+ {
+ BinaryReader reader = new BinaryReader(gzIn);
+ string s = reader.ReadString();
+ Assert.AreEqual("hi there",s);
+ double d = reader.ReadDouble();
+ Assert.AreEqual(Math.PI, d);
+ int i = reader.ReadInt32();
+ Assert.AreEqual(42,i);
+ }
+
+ }
+ #endregion
+ }
+}
+
+#endif
diff --git a/compat/zlib/contrib/dotzlib/LICENSE_1_0.txt b/compat/zlib/contrib/dotzlib/LICENSE_1_0.txt
new file mode 100644
index 0000000..30aac2c
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/LICENSE_1_0.txt
@@ -0,0 +1,23 @@
+Boost Software License - Version 1.0 - August 17th, 2003
+
+Permission is hereby granted, free of charge, to any person or organization
+obtaining a copy of the software and accompanying documentation covered by
+this license (the "Software") to use, reproduce, display, distribute,
+execute, and transmit the Software, and to prepare derivative works of the
+Software, and to permit third-parties to whom the Software is furnished to
+do so, all subject to the following:
+
+The copyright notices in the Software and this entire statement, including
+the above license grant, this restriction and the following disclaimer,
+must be included in all copies of the Software, in whole or in part, and
+all derivative works of the Software, unless such copies or derivative
+works are solely in the form of machine-executable object code generated by
+a source language processor.
+
+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, TITLE AND NON-INFRINGEMENT. IN NO EVENT
+SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
+FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE. \ No newline at end of file
diff --git a/compat/zlib/contrib/dotzlib/readme.txt b/compat/zlib/contrib/dotzlib/readme.txt
new file mode 100644
index 0000000..b239572
--- /dev/null
+++ b/compat/zlib/contrib/dotzlib/readme.txt
@@ -0,0 +1,58 @@
+This directory contains a .Net wrapper class library for the ZLib1.dll
+
+The wrapper includes support for inflating/deflating memory buffers,
+.Net streaming wrappers for the gz streams part of zlib, and wrappers
+for the checksum parts of zlib. See DotZLib/UnitTests.cs for examples.
+
+Directory structure:
+--------------------
+
+LICENSE_1_0.txt - License file.
+readme.txt - This file.
+DotZLib.chm - Class library documentation
+DotZLib.build - NAnt build file
+DotZLib.sln - Microsoft Visual Studio 2003 solution file
+
+DotZLib\*.cs - Source files for the class library
+
+Unit tests:
+-----------
+The file DotZLib/UnitTests.cs contains unit tests for use with NUnit 2.1 or higher.
+To include unit tests in the build, define nunit before building.
+
+
+Build instructions:
+-------------------
+
+1. Using Visual Studio.Net 2003:
+ Open DotZLib.sln in VS.Net and build from there. Output file (DotZLib.dll)
+ will be found ./DotZLib/bin/release or ./DotZLib/bin/debug, depending on
+ you are building the release or debug version of the library. Check
+ DotZLib/UnitTests.cs for instructions on how to include unit tests in the
+ build.
+
+2. Using NAnt:
+ Open a command prompt with access to the build environment and run nant
+ in the same directory as the DotZLib.build file.
+ You can define 2 properties on the nant command-line to control the build:
+ debug={true|false} to toggle between release/debug builds (default=true).
+ nunit={true|false} to include or esclude unit tests (default=true).
+ Also the target clean will remove binaries.
+ Output file (DotZLib.dll) will be found in either ./DotZLib/bin/release
+ or ./DotZLib/bin/debug, depending on whether you are building the release
+ or debug version of the library.
+
+ Examples:
+ nant -D:debug=false -D:nunit=false
+ will build a release mode version of the library without unit tests.
+ nant
+ will build a debug version of the library with unit tests
+ nant clean
+ will remove all previously built files.
+
+
+---------------------------------
+Copyright (c) Henrik Ravn 2004
+
+Use, modification and distribution are subject to the Boost Software License, Version 1.0.
+(See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
diff --git a/compat/zlib/contrib/gcc_gvmat64/gvmat64.S b/compat/zlib/contrib/gcc_gvmat64/gvmat64.S
new file mode 100644
index 0000000..dd858dd
--- /dev/null
+++ b/compat/zlib/contrib/gcc_gvmat64/gvmat64.S
@@ -0,0 +1,574 @@
+/*
+;uInt longest_match_x64(
+; deflate_state *s,
+; IPos cur_match); // current match
+
+; gvmat64.S -- Asm portion of the optimized longest_match for 32 bits x86_64
+; (AMD64 on Athlon 64, Opteron, Phenom
+; and Intel EM64T on Pentium 4 with EM64T, Pentium D, Core 2 Duo, Core I5/I7)
+; this file is translation from gvmat64.asm to GCC 4.x (for Linux, Mac XCode)
+; Copyright (C) 1995-2010 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
+;
+; File written by Gilles Vollant, by converting to assembly the longest_match
+; from Jean-loup Gailly in deflate.c of zLib and infoZip zip.
+; and by taking inspiration on asm686 with masm, optimised assembly code
+; from Brian Raiter, written 1998
+;
+; This software is provided 'as-is', without any express or implied
+; warranty. In no event will the authors be held liable for any damages
+; arising from the use of this software.
+;
+; Permission is granted to anyone to use this software for any purpose,
+; including commercial applications, and to alter it and redistribute it
+; freely, subject to the following restrictions:
+;
+; 1. The origin of this software must not be misrepresented; you must not
+; claim that you wrote the original software. If you use this software
+; in a product, an acknowledgment in the product documentation would be
+; appreciated but is not required.
+; 2. Altered source versions must be plainly marked as such, and must not be
+; misrepresented as being the original software
+; 3. This notice may not be removed or altered from any source distribution.
+;
+; http://www.zlib.net
+; http://www.winimage.com/zLibDll
+; http://www.muppetlabs.com/~breadbox/software/assembly.html
+;
+; to compile this file for zLib, I use option:
+; gcc -c -arch x86_64 gvmat64.S
+
+
+;uInt longest_match(s, cur_match)
+; deflate_state *s;
+; IPos cur_match; // current match /
+;
+; with XCode for Mac, I had strange error with some jump on intel syntax
+; this is why BEFORE_JMP and AFTER_JMP are used
+ */
+
+
+#define BEFORE_JMP .att_syntax
+#define AFTER_JMP .intel_syntax noprefix
+
+#ifndef NO_UNDERLINE
+# define match_init _match_init
+# define longest_match _longest_match
+#endif
+
+.intel_syntax noprefix
+
+.globl match_init, longest_match
+.text
+longest_match:
+
+
+
+#define LocalVarsSize 96
+/*
+; register used : rax,rbx,rcx,rdx,rsi,rdi,r8,r9,r10,r11,r12
+; free register : r14,r15
+; register can be saved : rsp
+*/
+
+#define chainlenwmask (rsp + 8 - LocalVarsSize)
+#define nicematch (rsp + 16 - LocalVarsSize)
+
+#define save_rdi (rsp + 24 - LocalVarsSize)
+#define save_rsi (rsp + 32 - LocalVarsSize)
+#define save_rbx (rsp + 40 - LocalVarsSize)
+#define save_rbp (rsp + 48 - LocalVarsSize)
+#define save_r12 (rsp + 56 - LocalVarsSize)
+#define save_r13 (rsp + 64 - LocalVarsSize)
+#define save_r14 (rsp + 72 - LocalVarsSize)
+#define save_r15 (rsp + 80 - LocalVarsSize)
+
+
+/*
+; all the +4 offsets are due to the addition of pending_buf_size (in zlib
+; in the deflate_state structure since the asm code was first written
+; (if you compile with zlib 1.0.4 or older, remove the +4).
+; Note : these value are good with a 8 bytes boundary pack structure
+*/
+
+#define MAX_MATCH 258
+#define MIN_MATCH 3
+#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1)
+
+/*
+;;; 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").
+*/
+
+
+
+/* you can check the structure offset by running
+
+#include <stdlib.h>
+#include <stdio.h>
+#include "deflate.h"
+
+void print_depl()
+{
+deflate_state ds;
+deflate_state *s=&ds;
+printf("size pointer=%u\n",(int)sizeof(void*));
+
+printf("#define dsWSize %u\n",(int)(((char*)&(s->w_size))-((char*)s)));
+printf("#define dsWMask %u\n",(int)(((char*)&(s->w_mask))-((char*)s)));
+printf("#define dsWindow %u\n",(int)(((char*)&(s->window))-((char*)s)));
+printf("#define dsPrev %u\n",(int)(((char*)&(s->prev))-((char*)s)));
+printf("#define dsMatchLen %u\n",(int)(((char*)&(s->match_length))-((char*)s)));
+printf("#define dsPrevMatch %u\n",(int)(((char*)&(s->prev_match))-((char*)s)));
+printf("#define dsStrStart %u\n",(int)(((char*)&(s->strstart))-((char*)s)));
+printf("#define dsMatchStart %u\n",(int)(((char*)&(s->match_start))-((char*)s)));
+printf("#define dsLookahead %u\n",(int)(((char*)&(s->lookahead))-((char*)s)));
+printf("#define dsPrevLen %u\n",(int)(((char*)&(s->prev_length))-((char*)s)));
+printf("#define dsMaxChainLen %u\n",(int)(((char*)&(s->max_chain_length))-((char*)s)));
+printf("#define dsGoodMatch %u\n",(int)(((char*)&(s->good_match))-((char*)s)));
+printf("#define dsNiceMatch %u\n",(int)(((char*)&(s->nice_match))-((char*)s)));
+}
+*/
+
+#define dsWSize 68
+#define dsWMask 76
+#define dsWindow 80
+#define dsPrev 96
+#define dsMatchLen 144
+#define dsPrevMatch 148
+#define dsStrStart 156
+#define dsMatchStart 160
+#define dsLookahead 164
+#define dsPrevLen 168
+#define dsMaxChainLen 172
+#define dsGoodMatch 188
+#define dsNiceMatch 192
+
+#define window_size [ rcx + dsWSize]
+#define WMask [ rcx + dsWMask]
+#define window_ad [ rcx + dsWindow]
+#define prev_ad [ rcx + dsPrev]
+#define strstart [ rcx + dsStrStart]
+#define match_start [ rcx + dsMatchStart]
+#define Lookahead [ rcx + dsLookahead] //; 0ffffffffh on infozip
+#define prev_length [ rcx + dsPrevLen]
+#define max_chain_length [ rcx + dsMaxChainLen]
+#define good_match [ rcx + dsGoodMatch]
+#define nice_match [ rcx + dsNiceMatch]
+
+/*
+; windows:
+; parameter 1 in rcx(deflate state s), param 2 in rdx (cur match)
+
+; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
+; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
+;
+; All registers must be preserved across the call, except for
+; rax, rcx, rdx, r8, r9, r10, and r11, which are scratch.
+
+;
+; gcc on macosx-linux:
+; see http://www.x86-64.org/documentation/abi-0.99.pdf
+; param 1 in rdi, param 2 in rsi
+; rbx, rsp, rbp, r12 to r15 must be preserved
+
+;;; Save registers that the compiler may be using, and adjust esp to
+;;; make room for our stack frame.
+
+
+;;; Retrieve the function arguments. r8d 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.
+
+; ms: parameter 1 in rcx (deflate_state* s), param 2 in edx -> r8 (cur match)
+; mac: param 1 in rdi, param 2 rsi
+; this clear high 32 bits of r8, which can be garbage in both r8 and rdx
+*/
+ mov [save_rbx],rbx
+ mov [save_rbp],rbp
+
+
+ mov rcx,rdi
+
+ mov r8d,esi
+
+
+ mov [save_r12],r12
+ mov [save_r13],r13
+ mov [save_r14],r14
+ mov [save_r15],r15
+
+
+//;;; uInt wmask = s->w_mask;
+//;;; unsigned chain_length = s->max_chain_length;
+//;;; if (s->prev_length >= s->good_match) {
+//;;; chain_length >>= 2;
+//;;; }
+
+
+ mov edi, prev_length
+ mov esi, good_match
+ mov eax, WMask
+ mov ebx, max_chain_length
+ cmp edi, esi
+ 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
+
+//;;; on zlib only
+//;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+
+
+
+ mov eax, nice_match
+ mov [chainlenwmask], ebx
+ mov r10d, Lookahead
+ cmp r10d, eax
+ cmovnl r10d, eax
+ mov [nicematch],r10d
+
+
+
+//;;; register Bytef *scan = s->window + s->strstart;
+ mov r10, window_ad
+ mov ebp, strstart
+ lea r13, [r10 + rbp]
+
+//;;; Determine how many bytes the scan ptr is off from being
+//;;; dword-aligned.
+
+ mov r9,r13
+ neg r13
+ and r13,3
+
+//;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+//;;; s->strstart - (IPos)MAX_DIST(s) : NIL;
+
+
+ mov eax, window_size
+ sub eax, MIN_LOOKAHEAD
+
+
+ xor edi,edi
+ sub ebp, eax
+
+ mov r11d, prev_length
+
+ cmovng ebp,edi
+
+//;;; int best_len = s->prev_length;
+
+
+//;;; Store the sum of s->window + best_len in esi locally, and in esi.
+
+ lea rsi,[r10+r11]
+
+//;;; register ush scan_start = *(ushf*)scan;
+//;;; register ush scan_end = *(ushf*)(scan+best_len-1);
+//;;; Posf *prev = s->prev;
+
+ movzx r12d,word ptr [r9]
+ movzx ebx, word ptr [r9 + r11 - 1]
+
+ mov rdi, prev_ad
+
+//;;; Jump into the main loop.
+
+ mov edx, [chainlenwmask]
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ jz LookupLoopIsZero
+
+
+
+LookupLoop1:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ jbe LeaveNow
+
+
+
+ sub edx, 0x00010000
+ BEFORE_JMP
+ js LeaveNow
+ AFTER_JMP
+
+LoopEntry1:
+ cmp bx,word ptr [rsi + r8 - 1]
+ BEFORE_JMP
+ jz LookupLoopIsZero
+ AFTER_JMP
+
+LookupLoop2:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ BEFORE_JMP
+ jbe LeaveNow
+ AFTER_JMP
+ sub edx, 0x00010000
+ BEFORE_JMP
+ js LeaveNow
+ AFTER_JMP
+
+LoopEntry2:
+ cmp bx,word ptr [rsi + r8 - 1]
+ BEFORE_JMP
+ jz LookupLoopIsZero
+ AFTER_JMP
+
+LookupLoop4:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ BEFORE_JMP
+ jbe LeaveNow
+ AFTER_JMP
+ sub edx, 0x00010000
+ BEFORE_JMP
+ js LeaveNow
+ AFTER_JMP
+
+LoopEntry4:
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ BEFORE_JMP
+ jnz LookupLoop1
+ jmp LookupLoopIsZero
+ AFTER_JMP
+/*
+;;; 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
+;;; r8d = curmatch
+;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
+;;; esi = windowbestlen - i.e., (window + bestlen)
+;;; edi = prev
+;;; ebp = limit
+*/
+.balign 16
+LookupLoop:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ BEFORE_JMP
+ jbe LeaveNow
+ AFTER_JMP
+ sub edx, 0x00010000
+ BEFORE_JMP
+ js LeaveNow
+ AFTER_JMP
+
+LoopEntry:
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ BEFORE_JMP
+ jnz LookupLoop1
+ AFTER_JMP
+LookupLoopIsZero:
+ cmp r12w, word ptr [r10 + r8]
+ BEFORE_JMP
+ jnz LookupLoop1
+ AFTER_JMP
+
+
+//;;; 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).
+*/
+ lea rsi,[r8+r10]
+ mov rdx, 0xfffffffffffffef8 //; -(MAX_MATCH_8)
+ lea rsi, [rsi + r13 + 0x0108] //;MAX_MATCH_8]
+ lea rdi, [r9 + r13 + 0x0108] //;MAX_MATCH_8]
+
+ prefetcht1 [rsi+rdx]
+ prefetcht1 [rdi+rdx]
+
+/*
+;;; Test the strings for equality, 8 bytes at a time. At the end,
+;;; adjust rdx 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. (rsi 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 rax, [rsi + rdx]
+ xor rax, [rdi + rdx]
+ jnz LeaveLoopCmps
+
+ mov rax, [rsi + rdx + 8]
+ xor rax, [rdi + rdx + 8]
+ jnz LeaveLoopCmps8
+
+
+ mov rax, [rsi + rdx + 8+8]
+ xor rax, [rdi + rdx + 8+8]
+ jnz LeaveLoopCmps16
+
+ add rdx,8+8+8
+
+ BEFORE_JMP
+ jnz LoopCmps
+ jmp LenMaximum
+ AFTER_JMP
+
+LeaveLoopCmps16: add rdx,8
+LeaveLoopCmps8: add rdx,8
+LeaveLoopCmps:
+
+ test eax, 0x0000FFFF
+ jnz LenLower
+
+ test eax,0xffffffff
+
+ jnz LenLower32
+
+ add rdx,4
+ shr rax,32
+ or ax,ax
+ BEFORE_JMP
+ jnz LenLower
+ AFTER_JMP
+
+LenLower32:
+ shr eax,16
+ add rdx,2
+
+LenLower:
+ sub al, 1
+ adc rdx, 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 rax, [rdi + rdx]
+ sub rax, r9
+ cmp eax, MAX_MATCH
+ BEFORE_JMP
+ jge LenMaximum
+ AFTER_JMP
+/*
+;;; 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.
+;///////////////////////////////////
+*/
+ cmp eax, r11d
+ jg LongerMatch
+
+ lea rsi,[r10+r11]
+
+ mov rdi, prev_ad
+ mov edx, [chainlenwmask]
+ BEFORE_JMP
+ jmp LookupLoop
+ AFTER_JMP
+/*
+;;; s->match_start = cur_match;
+;;; best_len = len;
+;;; if (len >= nice_match) break;
+;;; scan_end = *(ushf*)(scan+best_len-1);
+*/
+LongerMatch:
+ mov r11d, eax
+ mov match_start, r8d
+ cmp eax, [nicematch]
+ BEFORE_JMP
+ jge LeaveNow
+ AFTER_JMP
+
+ lea rsi,[r10+rax]
+
+ movzx ebx, word ptr [r9 + rax - 1]
+ mov rdi, prev_ad
+ mov edx, [chainlenwmask]
+ BEFORE_JMP
+ jmp LookupLoop
+ AFTER_JMP
+
+//;;; Accept the current string, with the maximum possible length.
+
+LenMaximum:
+ mov r11d,MAX_MATCH
+ mov match_start, r8d
+
+//;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
+//;;; return s->lookahead;
+
+LeaveNow:
+ mov eax, Lookahead
+ cmp r11d, eax
+ cmovng eax, r11d
+
+
+
+//;;; Restore the stack and return from whence we came.
+
+
+// mov rsi,[save_rsi]
+// mov rdi,[save_rdi]
+ mov rbx,[save_rbx]
+ mov rbp,[save_rbp]
+ mov r12,[save_r12]
+ mov r13,[save_r13]
+ mov r14,[save_r14]
+ mov r15,[save_r15]
+
+
+ ret 0
+//; please don't remove this string !
+//; Your can freely use gvmat64 in any free or commercial app
+//; but it is far better don't remove the string in the binary!
+ // db 0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998, converted to amd 64 by Gilles Vollant 2005",0dh,0ah,0
+
+
+match_init:
+ ret 0
+
+
diff --git a/compat/zlib/contrib/infback9/README b/compat/zlib/contrib/infback9/README
new file mode 100644
index 0000000..e75ed13
--- /dev/null
+++ b/compat/zlib/contrib/infback9/README
@@ -0,0 +1 @@
+See infback9.h for what this is and how to use it.
diff --git a/compat/zlib/contrib/infback9/infback9.c b/compat/zlib/contrib/infback9/infback9.c
new file mode 100644
index 0000000..05fb3e3
--- /dev/null
+++ b/compat/zlib/contrib/infback9/infback9.c
@@ -0,0 +1,615 @@
+/* infback9.c -- inflate deflate64 data using a call-back interface
+ * Copyright (C) 1995-2008 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "infback9.h"
+#include "inftree9.h"
+#include "inflate9.h"
+
+#define WSIZE 65536UL
+
+/*
+ strm provides memory allocation functions in zalloc and zfree, or
+ Z_NULL to use the library memory allocation functions.
+
+ window is a user-supplied window and output buffer that is 64K bytes.
+ */
+int ZEXPORT inflateBack9Init_(strm, window, version, stream_size)
+z_stream FAR *strm;
+unsigned char FAR *window;
+const char *version;
+int stream_size;
+{
+ struct inflate_state FAR *state;
+
+ if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
+ stream_size != (int)(sizeof(z_stream)))
+ return Z_VERSION_ERROR;
+ if (strm == Z_NULL || window == Z_NULL)
+ return Z_STREAM_ERROR;
+ strm->msg = Z_NULL; /* in case we return an error */
+ if (strm->zalloc == (alloc_func)0) {
+ strm->zalloc = zcalloc;
+ strm->opaque = (voidpf)0;
+ }
+ if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+ state = (struct inflate_state FAR *)ZALLOC(strm, 1,
+ sizeof(struct inflate_state));
+ if (state == Z_NULL) return Z_MEM_ERROR;
+ Tracev((stderr, "inflate: allocated\n"));
+ strm->state = (voidpf)state;
+ state->window = window;
+ return Z_OK;
+}
+
+/*
+ Build and output length and distance decoding tables for fixed code
+ decoding.
+ */
+#ifdef MAKEFIXED
+#include <stdio.h>
+
+void makefixed9(void)
+{
+ unsigned sym, bits, low, size;
+ code *next, *lenfix, *distfix;
+ struct inflate_state state;
+ code fixed[544];
+
+ /* literal/length table */
+ sym = 0;
+ while (sym < 144) state.lens[sym++] = 8;
+ while (sym < 256) state.lens[sym++] = 9;
+ while (sym < 280) state.lens[sym++] = 7;
+ while (sym < 288) state.lens[sym++] = 8;
+ next = fixed;
+ lenfix = next;
+ bits = 9;
+ inflate_table9(LENS, state.lens, 288, &(next), &(bits), state.work);
+
+ /* distance table */
+ sym = 0;
+ while (sym < 32) state.lens[sym++] = 5;
+ distfix = next;
+ bits = 5;
+ inflate_table9(DISTS, state.lens, 32, &(next), &(bits), state.work);
+
+ /* write tables */
+ puts(" /* inffix9.h -- table for decoding deflate64 fixed codes");
+ puts(" * Generated automatically by makefixed9().");
+ puts(" */");
+ puts("");
+ puts(" /* WARNING: this file should *not* be used by applications.");
+ puts(" It is part of the implementation of this library and is");
+ puts(" subject to change. Applications should only use zlib.h.");
+ puts(" */");
+ puts("");
+ size = 1U << 9;
+ printf(" static const code lenfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 6) == 0) printf("\n ");
+ printf("{%u,%u,%d}", lenfix[low].op, lenfix[low].bits,
+ lenfix[low].val);
+ if (++low == size) break;
+ putchar(',');
+ }
+ puts("\n };");
+ size = 1U << 5;
+ printf("\n static const code distfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 5) == 0) printf("\n ");
+ printf("{%u,%u,%d}", distfix[low].op, distfix[low].bits,
+ distfix[low].val);
+ if (++low == size) break;
+ putchar(',');
+ }
+ puts("\n };");
+}
+#endif /* MAKEFIXED */
+
+/* Macros for inflateBack(): */
+
+/* Clear the input bit accumulator */
+#define INITBITS() \
+ do { \
+ hold = 0; \
+ bits = 0; \
+ } while (0)
+
+/* Assure that some input is available. If input is requested, but denied,
+ then return a Z_BUF_ERROR from inflateBack(). */
+#define PULL() \
+ do { \
+ if (have == 0) { \
+ have = in(in_desc, &next); \
+ if (have == 0) { \
+ next = Z_NULL; \
+ ret = Z_BUF_ERROR; \
+ goto inf_leave; \
+ } \
+ } \
+ } while (0)
+
+/* Get a byte of input into the bit accumulator, or return from inflateBack()
+ with an error if there is no input available. */
+#define PULLBYTE() \
+ do { \
+ PULL(); \
+ have--; \
+ hold += (unsigned long)(*next++) << bits; \
+ bits += 8; \
+ } while (0)
+
+/* Assure that there are at least n bits in the bit accumulator. If there is
+ not enough available input to do that, then return from inflateBack() with
+ an error. */
+#define NEEDBITS(n) \
+ do { \
+ while (bits < (unsigned)(n)) \
+ PULLBYTE(); \
+ } while (0)
+
+/* Return the low n bits of the bit accumulator (n <= 16) */
+#define BITS(n) \
+ ((unsigned)hold & ((1U << (n)) - 1))
+
+/* Remove n bits from the bit accumulator */
+#define DROPBITS(n) \
+ do { \
+ hold >>= (n); \
+ bits -= (unsigned)(n); \
+ } while (0)
+
+/* Remove zero to seven bits as needed to go to a byte boundary */
+#define BYTEBITS() \
+ do { \
+ hold >>= bits & 7; \
+ bits -= bits & 7; \
+ } while (0)
+
+/* Assure that some output space is available, by writing out the window
+ if it's full. If the write fails, return from inflateBack() with a
+ Z_BUF_ERROR. */
+#define ROOM() \
+ do { \
+ if (left == 0) { \
+ put = window; \
+ left = WSIZE; \
+ wrap = 1; \
+ if (out(out_desc, put, (unsigned)left)) { \
+ ret = Z_BUF_ERROR; \
+ goto inf_leave; \
+ } \
+ } \
+ } while (0)
+
+/*
+ strm provides the memory allocation functions and window buffer on input,
+ and provides information on the unused input on return. For Z_DATA_ERROR
+ returns, strm will also provide an error message.
+
+ in() and out() are the call-back input and output functions. When
+ inflateBack() needs more input, it calls in(). When inflateBack() has
+ filled the window with output, or when it completes with data in the
+ window, it calls out() to write out the data. The application must not
+ change the provided input until in() is called again or inflateBack()
+ returns. The application must not change the window/output buffer until
+ inflateBack() returns.
+
+ in() and out() are called with a descriptor parameter provided in the
+ inflateBack() call. This parameter can be a structure that provides the
+ information required to do the read or write, as well as accumulated
+ information on the input and output such as totals and check values.
+
+ in() should return zero on failure. out() should return non-zero on
+ failure. If either in() or out() fails, than inflateBack() returns a
+ Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it
+ was in() or out() that caused in the error. Otherwise, inflateBack()
+ returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format
+ error, or Z_MEM_ERROR if it could not allocate memory for the state.
+ inflateBack() can also return Z_STREAM_ERROR if the input parameters
+ are not correct, i.e. strm is Z_NULL or the state was not initialized.
+ */
+int ZEXPORT inflateBack9(strm, in, in_desc, out, out_desc)
+z_stream FAR *strm;
+in_func in;
+void FAR *in_desc;
+out_func out;
+void FAR *out_desc;
+{
+ struct inflate_state FAR *state;
+ z_const unsigned char FAR *next; /* next input */
+ unsigned char FAR *put; /* next output */
+ unsigned have; /* available input */
+ unsigned long left; /* available output */
+ inflate_mode mode; /* current inflate mode */
+ int lastblock; /* true if processing last block */
+ int wrap; /* true if the window has wrapped */
+ unsigned char FAR *window; /* allocated sliding window, if needed */
+ unsigned long hold; /* bit buffer */
+ unsigned bits; /* bits in bit buffer */
+ unsigned extra; /* extra bits needed */
+ unsigned long length; /* literal or length of data to copy */
+ unsigned long offset; /* distance back to copy string from */
+ unsigned long copy; /* number of stored or match bytes to copy */
+ unsigned char FAR *from; /* where to copy match bytes from */
+ code const FAR *lencode; /* starting table for length/literal codes */
+ code const FAR *distcode; /* starting table for distance codes */
+ unsigned lenbits; /* index bits for lencode */
+ unsigned distbits; /* index bits for distcode */
+ code here; /* current decoding table entry */
+ code last; /* parent table entry */
+ unsigned len; /* length to copy for repeats, bits to drop */
+ int ret; /* return code */
+ static const unsigned short order[19] = /* permutation of code lengths */
+ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
+#include "inffix9.h"
+
+ /* Check that the strm exists and that the state was initialized */
+ if (strm == Z_NULL || strm->state == Z_NULL)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* Reset the state */
+ strm->msg = Z_NULL;
+ mode = TYPE;
+ lastblock = 0;
+ wrap = 0;
+ window = state->window;
+ next = strm->next_in;
+ have = next != Z_NULL ? strm->avail_in : 0;
+ hold = 0;
+ bits = 0;
+ put = window;
+ left = WSIZE;
+ lencode = Z_NULL;
+ distcode = Z_NULL;
+
+ /* Inflate until end of block marked as last */
+ for (;;)
+ switch (mode) {
+ case TYPE:
+ /* determine and dispatch block type */
+ if (lastblock) {
+ BYTEBITS();
+ mode = DONE;
+ break;
+ }
+ NEEDBITS(3);
+ lastblock = BITS(1);
+ DROPBITS(1);
+ switch (BITS(2)) {
+ case 0: /* stored block */
+ Tracev((stderr, "inflate: stored block%s\n",
+ lastblock ? " (last)" : ""));
+ mode = STORED;
+ break;
+ case 1: /* fixed block */
+ lencode = lenfix;
+ lenbits = 9;
+ distcode = distfix;
+ distbits = 5;
+ Tracev((stderr, "inflate: fixed codes block%s\n",
+ lastblock ? " (last)" : ""));
+ mode = LEN; /* decode codes */
+ break;
+ case 2: /* dynamic block */
+ Tracev((stderr, "inflate: dynamic codes block%s\n",
+ lastblock ? " (last)" : ""));
+ mode = TABLE;
+ break;
+ case 3:
+ strm->msg = (char *)"invalid block type";
+ mode = BAD;
+ }
+ DROPBITS(2);
+ break;
+
+ case STORED:
+ /* get and verify stored block length */
+ BYTEBITS(); /* go to byte boundary */
+ NEEDBITS(32);
+ if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
+ strm->msg = (char *)"invalid stored block lengths";
+ mode = BAD;
+ break;
+ }
+ length = (unsigned)hold & 0xffff;
+ Tracev((stderr, "inflate: stored length %lu\n",
+ length));
+ INITBITS();
+
+ /* copy stored block from input to output */
+ while (length != 0) {
+ copy = length;
+ PULL();
+ ROOM();
+ if (copy > have) copy = have;
+ if (copy > left) copy = left;
+ zmemcpy(put, next, copy);
+ have -= copy;
+ next += copy;
+ left -= copy;
+ put += copy;
+ length -= copy;
+ }
+ Tracev((stderr, "inflate: stored end\n"));
+ mode = TYPE;
+ break;
+
+ case TABLE:
+ /* get dynamic table entries descriptor */
+ NEEDBITS(14);
+ state->nlen = BITS(5) + 257;
+ DROPBITS(5);
+ state->ndist = BITS(5) + 1;
+ DROPBITS(5);
+ state->ncode = BITS(4) + 4;
+ DROPBITS(4);
+ if (state->nlen > 286) {
+ strm->msg = (char *)"too many length symbols";
+ mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: table sizes ok\n"));
+
+ /* get code length code lengths (not a typo) */
+ state->have = 0;
+ while (state->have < state->ncode) {
+ NEEDBITS(3);
+ state->lens[order[state->have++]] = (unsigned short)BITS(3);
+ DROPBITS(3);
+ }
+ while (state->have < 19)
+ state->lens[order[state->have++]] = 0;
+ state->next = state->codes;
+ lencode = (code const FAR *)(state->next);
+ lenbits = 7;
+ ret = inflate_table9(CODES, state->lens, 19, &(state->next),
+ &(lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid code lengths set";
+ mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: code lengths ok\n"));
+
+ /* get length and distance code code lengths */
+ state->have = 0;
+ while (state->have < state->nlen + state->ndist) {
+ for (;;) {
+ here = lencode[BITS(lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.val < 16) {
+ NEEDBITS(here.bits);
+ DROPBITS(here.bits);
+ state->lens[state->have++] = here.val;
+ }
+ else {
+ if (here.val == 16) {
+ NEEDBITS(here.bits + 2);
+ DROPBITS(here.bits);
+ if (state->have == 0) {
+ strm->msg = (char *)"invalid bit length repeat";
+ mode = BAD;
+ break;
+ }
+ len = (unsigned)(state->lens[state->have - 1]);
+ copy = 3 + BITS(2);
+ DROPBITS(2);
+ }
+ else if (here.val == 17) {
+ NEEDBITS(here.bits + 3);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 3 + BITS(3);
+ DROPBITS(3);
+ }
+ else {
+ NEEDBITS(here.bits + 7);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 11 + BITS(7);
+ DROPBITS(7);
+ }
+ if (state->have + copy > state->nlen + state->ndist) {
+ strm->msg = (char *)"invalid bit length repeat";
+ mode = BAD;
+ break;
+ }
+ while (copy--)
+ state->lens[state->have++] = (unsigned short)len;
+ }
+ }
+
+ /* handle error breaks in while */
+ if (mode == BAD) break;
+
+ /* check for end-of-block code (better have one) */
+ if (state->lens[256] == 0) {
+ strm->msg = (char *)"invalid code -- missing end-of-block";
+ mode = BAD;
+ break;
+ }
+
+ /* build code tables -- note: do not change the lenbits or distbits
+ values here (9 and 6) without reading the comments in inftree9.h
+ concerning the ENOUGH constants, which depend on those values */
+ state->next = state->codes;
+ lencode = (code const FAR *)(state->next);
+ lenbits = 9;
+ ret = inflate_table9(LENS, state->lens, state->nlen,
+ &(state->next), &(lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid literal/lengths set";
+ mode = BAD;
+ break;
+ }
+ distcode = (code const FAR *)(state->next);
+ distbits = 6;
+ ret = inflate_table9(DISTS, state->lens + state->nlen,
+ state->ndist, &(state->next), &(distbits),
+ state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid distances set";
+ mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: codes ok\n"));
+ mode = LEN;
+
+ case LEN:
+ /* get a literal, length, or end-of-block code */
+ for (;;) {
+ here = lencode[BITS(lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.op && (here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = lencode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ }
+ DROPBITS(here.bits);
+ length = (unsigned)here.val;
+
+ /* process literal */
+ if (here.op == 0) {
+ Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+ "inflate: literal '%c'\n" :
+ "inflate: literal 0x%02x\n", here.val));
+ ROOM();
+ *put++ = (unsigned char)(length);
+ left--;
+ mode = LEN;
+ break;
+ }
+
+ /* process end of block */
+ if (here.op & 32) {
+ Tracevv((stderr, "inflate: end of block\n"));
+ mode = TYPE;
+ break;
+ }
+
+ /* invalid code */
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid literal/length code";
+ mode = BAD;
+ break;
+ }
+
+ /* length code -- get extra bits, if any */
+ extra = (unsigned)(here.op) & 31;
+ if (extra != 0) {
+ NEEDBITS(extra);
+ length += BITS(extra);
+ DROPBITS(extra);
+ }
+ Tracevv((stderr, "inflate: length %lu\n", length));
+
+ /* get distance code */
+ for (;;) {
+ here = distcode[BITS(distbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if ((here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = distcode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ }
+ DROPBITS(here.bits);
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid distance code";
+ mode = BAD;
+ break;
+ }
+ offset = (unsigned)here.val;
+
+ /* get distance extra bits, if any */
+ extra = (unsigned)(here.op) & 15;
+ if (extra != 0) {
+ NEEDBITS(extra);
+ offset += BITS(extra);
+ DROPBITS(extra);
+ }
+ if (offset > WSIZE - (wrap ? 0: left)) {
+ strm->msg = (char *)"invalid distance too far back";
+ mode = BAD;
+ break;
+ }
+ Tracevv((stderr, "inflate: distance %lu\n", offset));
+
+ /* copy match from window to output */
+ do {
+ ROOM();
+ copy = WSIZE - offset;
+ if (copy < left) {
+ from = put + copy;
+ copy = left - copy;
+ }
+ else {
+ from = put - offset;
+ copy = left;
+ }
+ if (copy > length) copy = length;
+ length -= copy;
+ left -= copy;
+ do {
+ *put++ = *from++;
+ } while (--copy);
+ } while (length != 0);
+ break;
+
+ case DONE:
+ /* inflate stream terminated properly -- write leftover output */
+ ret = Z_STREAM_END;
+ if (left < WSIZE) {
+ if (out(out_desc, window, (unsigned)(WSIZE - left)))
+ ret = Z_BUF_ERROR;
+ }
+ goto inf_leave;
+
+ case BAD:
+ ret = Z_DATA_ERROR;
+ goto inf_leave;
+
+ default: /* can't happen, but makes compilers happy */
+ ret = Z_STREAM_ERROR;
+ goto inf_leave;
+ }
+
+ /* Return unused input */
+ inf_leave:
+ strm->next_in = next;
+ strm->avail_in = have;
+ return ret;
+}
+
+int ZEXPORT inflateBack9End(strm)
+z_stream FAR *strm;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+ Tracev((stderr, "inflate: end\n"));
+ return Z_OK;
+}
diff --git a/compat/zlib/contrib/infback9/infback9.h b/compat/zlib/contrib/infback9/infback9.h
new file mode 100644
index 0000000..1073c0a
--- /dev/null
+++ b/compat/zlib/contrib/infback9/infback9.h
@@ -0,0 +1,37 @@
+/* infback9.h -- header for using inflateBack9 functions
+ * Copyright (C) 2003 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * This header file and associated patches provide a decoder for PKWare's
+ * undocumented deflate64 compression method (method 9). Use with infback9.c,
+ * inftree9.h, inftree9.c, and inffix9.h. These patches are not supported.
+ * This should be compiled with zlib, since it uses zutil.h and zutil.o.
+ * This code has not yet been tested on 16-bit architectures. See the
+ * comments in zlib.h for inflateBack() usage. These functions are used
+ * identically, except that there is no windowBits parameter, and a 64K
+ * window must be provided. Also if int's are 16 bits, then a zero for
+ * the third parameter of the "out" function actually means 65536UL.
+ * zlib.h must be included before this header file.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ZEXTERN int ZEXPORT inflateBack9 OF((z_stream FAR *strm,
+ in_func in, void FAR *in_desc,
+ out_func out, void FAR *out_desc));
+ZEXTERN int ZEXPORT inflateBack9End OF((z_stream FAR *strm));
+ZEXTERN int ZEXPORT inflateBack9Init_ OF((z_stream FAR *strm,
+ unsigned char FAR *window,
+ const char *version,
+ int stream_size));
+#define inflateBack9Init(strm, window) \
+ inflateBack9Init_((strm), (window), \
+ ZLIB_VERSION, sizeof(z_stream))
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/compat/zlib/contrib/infback9/inffix9.h b/compat/zlib/contrib/infback9/inffix9.h
new file mode 100644
index 0000000..ee5671d
--- /dev/null
+++ b/compat/zlib/contrib/infback9/inffix9.h
@@ -0,0 +1,107 @@
+ /* inffix9.h -- table for decoding deflate64 fixed codes
+ * Generated automatically by makefixed9().
+ */
+
+ /* 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] = {
+ {96,7,0},{0,8,80},{0,8,16},{132,8,115},{130,7,31},{0,8,112},
+ {0,8,48},{0,9,192},{128,7,10},{0,8,96},{0,8,32},{0,9,160},
+ {0,8,0},{0,8,128},{0,8,64},{0,9,224},{128,7,6},{0,8,88},
+ {0,8,24},{0,9,144},{131,7,59},{0,8,120},{0,8,56},{0,9,208},
+ {129,7,17},{0,8,104},{0,8,40},{0,9,176},{0,8,8},{0,8,136},
+ {0,8,72},{0,9,240},{128,7,4},{0,8,84},{0,8,20},{133,8,227},
+ {131,7,43},{0,8,116},{0,8,52},{0,9,200},{129,7,13},{0,8,100},
+ {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},
+ {128,7,8},{0,8,92},{0,8,28},{0,9,152},{132,7,83},{0,8,124},
+ {0,8,60},{0,9,216},{130,7,23},{0,8,108},{0,8,44},{0,9,184},
+ {0,8,12},{0,8,140},{0,8,76},{0,9,248},{128,7,3},{0,8,82},
+ {0,8,18},{133,8,163},{131,7,35},{0,8,114},{0,8,50},{0,9,196},
+ {129,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},{0,8,130},
+ {0,8,66},{0,9,228},{128,7,7},{0,8,90},{0,8,26},{0,9,148},
+ {132,7,67},{0,8,122},{0,8,58},{0,9,212},{130,7,19},{0,8,106},
+ {0,8,42},{0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},
+ {128,7,5},{0,8,86},{0,8,22},{65,8,0},{131,7,51},{0,8,118},
+ {0,8,54},{0,9,204},{129,7,15},{0,8,102},{0,8,38},{0,9,172},
+ {0,8,6},{0,8,134},{0,8,70},{0,9,236},{128,7,9},{0,8,94},
+ {0,8,30},{0,9,156},{132,7,99},{0,8,126},{0,8,62},{0,9,220},
+ {130,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142},
+ {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{133,8,131},
+ {130,7,31},{0,8,113},{0,8,49},{0,9,194},{128,7,10},{0,8,97},
+ {0,8,33},{0,9,162},{0,8,1},{0,8,129},{0,8,65},{0,9,226},
+ {128,7,6},{0,8,89},{0,8,25},{0,9,146},{131,7,59},{0,8,121},
+ {0,8,57},{0,9,210},{129,7,17},{0,8,105},{0,8,41},{0,9,178},
+ {0,8,9},{0,8,137},{0,8,73},{0,9,242},{128,7,4},{0,8,85},
+ {0,8,21},{144,8,3},{131,7,43},{0,8,117},{0,8,53},{0,9,202},
+ {129,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},
+ {0,8,69},{0,9,234},{128,7,8},{0,8,93},{0,8,29},{0,9,154},
+ {132,7,83},{0,8,125},{0,8,61},{0,9,218},{130,7,23},{0,8,109},
+ {0,8,45},{0,9,186},{0,8,13},{0,8,141},{0,8,77},{0,9,250},
+ {128,7,3},{0,8,83},{0,8,19},{133,8,195},{131,7,35},{0,8,115},
+ {0,8,51},{0,9,198},{129,7,11},{0,8,99},{0,8,35},{0,9,166},
+ {0,8,3},{0,8,131},{0,8,67},{0,9,230},{128,7,7},{0,8,91},
+ {0,8,27},{0,9,150},{132,7,67},{0,8,123},{0,8,59},{0,9,214},
+ {130,7,19},{0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},
+ {0,8,75},{0,9,246},{128,7,5},{0,8,87},{0,8,23},{77,8,0},
+ {131,7,51},{0,8,119},{0,8,55},{0,9,206},{129,7,15},{0,8,103},
+ {0,8,39},{0,9,174},{0,8,7},{0,8,135},{0,8,71},{0,9,238},
+ {128,7,9},{0,8,95},{0,8,31},{0,9,158},{132,7,99},{0,8,127},
+ {0,8,63},{0,9,222},{130,7,27},{0,8,111},{0,8,47},{0,9,190},
+ {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},
+ {0,8,16},{132,8,115},{130,7,31},{0,8,112},{0,8,48},{0,9,193},
+ {128,7,10},{0,8,96},{0,8,32},{0,9,161},{0,8,0},{0,8,128},
+ {0,8,64},{0,9,225},{128,7,6},{0,8,88},{0,8,24},{0,9,145},
+ {131,7,59},{0,8,120},{0,8,56},{0,9,209},{129,7,17},{0,8,104},
+ {0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},{0,9,241},
+ {128,7,4},{0,8,84},{0,8,20},{133,8,227},{131,7,43},{0,8,116},
+ {0,8,52},{0,9,201},{129,7,13},{0,8,100},{0,8,36},{0,9,169},
+ {0,8,4},{0,8,132},{0,8,68},{0,9,233},{128,7,8},{0,8,92},
+ {0,8,28},{0,9,153},{132,7,83},{0,8,124},{0,8,60},{0,9,217},
+ {130,7,23},{0,8,108},{0,8,44},{0,9,185},{0,8,12},{0,8,140},
+ {0,8,76},{0,9,249},{128,7,3},{0,8,82},{0,8,18},{133,8,163},
+ {131,7,35},{0,8,114},{0,8,50},{0,9,197},{129,7,11},{0,8,98},
+ {0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229},
+ {128,7,7},{0,8,90},{0,8,26},{0,9,149},{132,7,67},{0,8,122},
+ {0,8,58},{0,9,213},{130,7,19},{0,8,106},{0,8,42},{0,9,181},
+ {0,8,10},{0,8,138},{0,8,74},{0,9,245},{128,7,5},{0,8,86},
+ {0,8,22},{65,8,0},{131,7,51},{0,8,118},{0,8,54},{0,9,205},
+ {129,7,15},{0,8,102},{0,8,38},{0,9,173},{0,8,6},{0,8,134},
+ {0,8,70},{0,9,237},{128,7,9},{0,8,94},{0,8,30},{0,9,157},
+ {132,7,99},{0,8,126},{0,8,62},{0,9,221},{130,7,27},{0,8,110},
+ {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},
+ {96,7,0},{0,8,81},{0,8,17},{133,8,131},{130,7,31},{0,8,113},
+ {0,8,49},{0,9,195},{128,7,10},{0,8,97},{0,8,33},{0,9,163},
+ {0,8,1},{0,8,129},{0,8,65},{0,9,227},{128,7,6},{0,8,89},
+ {0,8,25},{0,9,147},{131,7,59},{0,8,121},{0,8,57},{0,9,211},
+ {129,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},{0,8,137},
+ {0,8,73},{0,9,243},{128,7,4},{0,8,85},{0,8,21},{144,8,3},
+ {131,7,43},{0,8,117},{0,8,53},{0,9,203},{129,7,13},{0,8,101},
+ {0,8,37},{0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},
+ {128,7,8},{0,8,93},{0,8,29},{0,9,155},{132,7,83},{0,8,125},
+ {0,8,61},{0,9,219},{130,7,23},{0,8,109},{0,8,45},{0,9,187},
+ {0,8,13},{0,8,141},{0,8,77},{0,9,251},{128,7,3},{0,8,83},
+ {0,8,19},{133,8,195},{131,7,35},{0,8,115},{0,8,51},{0,9,199},
+ {129,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131},
+ {0,8,67},{0,9,231},{128,7,7},{0,8,91},{0,8,27},{0,9,151},
+ {132,7,67},{0,8,123},{0,8,59},{0,9,215},{130,7,19},{0,8,107},
+ {0,8,43},{0,9,183},{0,8,11},{0,8,139},{0,8,75},{0,9,247},
+ {128,7,5},{0,8,87},{0,8,23},{77,8,0},{131,7,51},{0,8,119},
+ {0,8,55},{0,9,207},{129,7,15},{0,8,103},{0,8,39},{0,9,175},
+ {0,8,7},{0,8,135},{0,8,71},{0,9,239},{128,7,9},{0,8,95},
+ {0,8,31},{0,9,159},{132,7,99},{0,8,127},{0,8,63},{0,9,223},
+ {130,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},
+ {0,8,79},{0,9,255}
+ };
+
+ static const code distfix[32] = {
+ {128,5,1},{135,5,257},{131,5,17},{139,5,4097},{129,5,5},
+ {137,5,1025},{133,5,65},{141,5,16385},{128,5,3},{136,5,513},
+ {132,5,33},{140,5,8193},{130,5,9},{138,5,2049},{134,5,129},
+ {142,5,32769},{128,5,2},{135,5,385},{131,5,25},{139,5,6145},
+ {129,5,7},{137,5,1537},{133,5,97},{141,5,24577},{128,5,4},
+ {136,5,769},{132,5,49},{140,5,12289},{130,5,13},{138,5,3073},
+ {134,5,193},{142,5,49153}
+ };
diff --git a/compat/zlib/contrib/infback9/inflate9.h b/compat/zlib/contrib/infback9/inflate9.h
new file mode 100644
index 0000000..ee9a793
--- /dev/null
+++ b/compat/zlib/contrib/infback9/inflate9.h
@@ -0,0 +1,47 @@
+/* inflate9.h -- internal inflate state definition
+ * Copyright (C) 1995-2003 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* Possible inflate modes between inflate() calls */
+typedef enum {
+ TYPE, /* i: waiting for type bits, including last-flag bit */
+ STORED, /* i: waiting for stored size (length and complement) */
+ TABLE, /* i: waiting for dynamic block table lengths */
+ LEN, /* i: waiting for length/lit code */
+ DONE, /* finished check, done -- remain here until reset */
+ BAD /* got a data error -- remain here until reset */
+} inflate_mode;
+
+/*
+ State transitions between above modes -
+
+ (most modes can go to the BAD mode -- not shown for clarity)
+
+ Read deflate blocks:
+ TYPE -> STORED or TABLE or LEN or DONE
+ STORED -> TYPE
+ TABLE -> LENLENS -> CODELENS -> LEN
+ Read deflate codes:
+ LEN -> LEN or TYPE
+ */
+
+/* state maintained between inflate() calls. Approximately 7K bytes. */
+struct inflate_state {
+ /* sliding window */
+ unsigned char FAR *window; /* allocated sliding window, if needed */
+ /* dynamic table building */
+ unsigned ncode; /* number of code length code lengths */
+ unsigned nlen; /* number of length code lengths */
+ unsigned ndist; /* number of distance code lengths */
+ unsigned have; /* number of code lengths in lens[] */
+ code FAR *next; /* next available space in codes[] */
+ unsigned short lens[320]; /* temporary storage for code lengths */
+ unsigned short work[288]; /* work area for code table building */
+ code codes[ENOUGH]; /* space for code tables */
+};
diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c
new file mode 100644
index 0000000..4a73ad2
--- /dev/null
+++ b/compat/zlib/contrib/infback9/inftree9.c
@@ -0,0 +1,324 @@
+/* inftree9.c -- generate Huffman trees for efficient decoding
+ * Copyright (C) 1995-2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "inftree9.h"
+
+#define MAXBITS 15
+
+const char inflate9_copyright[] =
+ " inflate9 1.2.8 Copyright 1995-2013 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
+ include such an acknowledgment, I would appreciate that you keep this
+ copyright string in the executable of your product.
+ */
+
+/*
+ Build a set of tables to decode the provided canonical Huffman code.
+ The code lengths are lens[0..codes-1]. The result starts at *table,
+ whose indices are 0..2^bits-1. work is a writable array of at least
+ lens shorts, which is used as a work area. type is the type of code
+ to be generated, CODES, LENS, or DISTS. On return, zero is success,
+ -1 is an invalid code, and +1 means that ENOUGH isn't enough. table
+ on return points to the next available entry's address. bits is the
+ requested root table index bits, and on return it is the actual root
+ table index bits. It will differ if the request is greater than the
+ longest code or if it is less than the shortest code.
+ */
+int inflate_table9(type, lens, codes, table, bits, work)
+codetype type;
+unsigned short FAR *lens;
+unsigned codes;
+code FAR * FAR *table;
+unsigned FAR *bits;
+unsigned short FAR *work;
+{
+ unsigned len; /* a code's length in bits */
+ unsigned sym; /* index of code symbols */
+ unsigned min, max; /* minimum and maximum code lengths */
+ unsigned root; /* number of index bits for root table */
+ unsigned curr; /* number of index bits for current table */
+ unsigned drop; /* code bits to drop for sub-table */
+ int left; /* number of prefix codes available */
+ unsigned used; /* code entries in table used */
+ unsigned huff; /* Huffman code */
+ unsigned incr; /* for incrementing code, index */
+ unsigned fill; /* index for replicating entries */
+ unsigned low; /* low bits for current root entry */
+ unsigned mask; /* mask for low root bits */
+ code this; /* table entry for duplication */
+ code FAR *next; /* next available space in table */
+ const unsigned short FAR *base; /* base value table to use */
+ const unsigned short FAR *extra; /* extra bits table to use */
+ int end; /* use base and extra for symbol > end */
+ unsigned short count[MAXBITS+1]; /* number of codes of each length */
+ unsigned short offs[MAXBITS+1]; /* offsets in table for each length */
+ static const unsigned short lbase[31] = { /* Length codes 257..285 base */
+ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17,
+ 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115,
+ 131, 163, 195, 227, 3, 0, 0};
+ 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, 72, 78};
+ 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,
+ 4097, 6145, 8193, 12289, 16385, 24577, 32769, 49153};
+ static const unsigned short dext[32] = { /* Distance codes 0..31 extra */
+ 128, 128, 128, 128, 129, 129, 130, 130, 131, 131, 132, 132,
+ 133, 133, 134, 134, 135, 135, 136, 136, 137, 137, 138, 138,
+ 139, 139, 140, 140, 141, 141, 142, 142};
+
+ /*
+ Process a set of code lengths to create a canonical Huffman code. The
+ code lengths are lens[0..codes-1]. Each length corresponds to the
+ symbols 0..codes-1. The Huffman code is generated by first sorting the
+ symbols by length from short to long, and retaining the symbol order
+ for codes with equal lengths. Then the code starts with all zero bits
+ for the first code of the shortest length, and the codes are integer
+ increments for the same length, and zeros are appended as the length
+ increases. For the deflate format, these bits are stored backwards
+ from their more natural integer increment ordering, and so when the
+ decoding tables are built in the large loop below, the integer codes
+ are incremented backwards.
+
+ This routine assumes, but does not check, that all of the entries in
+ lens[] are in the range 0..MAXBITS. The caller must assure this.
+ 1..MAXBITS is interpreted as that code length. zero means that that
+ symbol does not occur in this code.
+
+ The codes are sorted by computing a count of codes for each length,
+ creating from that a table of starting indices for each length in the
+ sorted table, and then entering the symbols in order in the sorted
+ table. The sorted table is work[], with that space being provided by
+ the caller.
+
+ The length counts are used for other purposes as well, i.e. finding
+ the minimum and maximum length codes, determining if there are any
+ codes at all, checking for a valid set of lengths, and looking ahead
+ at length counts to determine sub-table sizes when building the
+ decoding tables.
+ */
+
+ /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */
+ for (len = 0; len <= MAXBITS; len++)
+ count[len] = 0;
+ for (sym = 0; sym < codes; sym++)
+ count[lens[sym]]++;
+
+ /* bound code lengths, force root to be within code lengths */
+ root = *bits;
+ for (max = MAXBITS; max >= 1; max--)
+ if (count[max] != 0) break;
+ if (root > max) root = max;
+ if (max == 0) return -1; /* no codes! */
+ for (min = 1; min <= MAXBITS; min++)
+ if (count[min] != 0) break;
+ if (root < min) root = min;
+
+ /* check for an over-subscribed or incomplete set of lengths */
+ left = 1;
+ for (len = 1; len <= MAXBITS; len++) {
+ left <<= 1;
+ left -= count[len];
+ if (left < 0) return -1; /* over-subscribed */
+ }
+ if (left > 0 && (type == CODES || max != 1))
+ return -1; /* incomplete set */
+
+ /* generate offsets into symbol table for each length for sorting */
+ offs[1] = 0;
+ for (len = 1; len < MAXBITS; len++)
+ offs[len + 1] = offs[len] + count[len];
+
+ /* sort symbols by length, by symbol order within each length */
+ for (sym = 0; sym < codes; sym++)
+ if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym;
+
+ /*
+ Create and fill in decoding tables. In this loop, the table being
+ filled is at next and has curr index bits. The code being used is huff
+ with length len. That code is converted to an index by dropping drop
+ bits off of the bottom. For codes where len is less than drop + curr,
+ those top drop + curr - len bits are incremented through all values to
+ fill the table with replicated entries.
+
+ root is the number of index bits for the root table. When len exceeds
+ root, sub-tables are created pointed to by the root entry with an index
+ of the low root bits of huff. This is saved in low to check for when a
+ new sub-table should be started. drop is zero when the root table is
+ being filled, and drop is root when sub-tables are being filled.
+
+ When a new sub-table is needed, it is necessary to look ahead in the
+ code lengths to determine what size sub-table is needed. The length
+ counts are used for this, and so count[] is decremented as codes are
+ entered in the tables.
+
+ used keeps track of how many table entries have been allocated from the
+ provided *table space. It is checked for LENS and DIST tables against
+ the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in
+ the initial root table size constants. See the comments in inftree9.h
+ for more information.
+
+ sym increments through all symbols, and the loop terminates when
+ all codes of length max, i.e. all codes, have been processed. This
+ routine permits incomplete codes, so another loop after this one fills
+ in the rest of the decoding tables with invalid code markers.
+ */
+
+ /* set up for code type */
+ switch (type) {
+ case CODES:
+ base = extra = work; /* dummy value--not used */
+ end = 19;
+ break;
+ case LENS:
+ base = lbase;
+ base -= 257;
+ extra = lext;
+ extra -= 257;
+ end = 256;
+ break;
+ default: /* DISTS */
+ base = dbase;
+ extra = dext;
+ end = -1;
+ }
+
+ /* initialize state for loop */
+ huff = 0; /* starting code */
+ sym = 0; /* starting code symbol */
+ len = min; /* starting code length */
+ next = *table; /* current table to fill in */
+ curr = root; /* current table index bits */
+ drop = 0; /* current bits to drop from code for index */
+ low = (unsigned)(-1); /* trigger new sub-table when len > root */
+ used = 1U << root; /* use root table entries */
+ mask = used - 1; /* mask for comparing low */
+
+ /* check available table space */
+ if ((type == LENS && used >= ENOUGH_LENS) ||
+ (type == DISTS && used >= ENOUGH_DISTS))
+ return 1;
+
+ /* process all codes and make table entries */
+ for (;;) {
+ /* create table entry */
+ this.bits = (unsigned char)(len - drop);
+ if ((int)(work[sym]) < end) {
+ this.op = (unsigned char)0;
+ this.val = work[sym];
+ }
+ else if ((int)(work[sym]) > end) {
+ this.op = (unsigned char)(extra[work[sym]]);
+ this.val = base[work[sym]];
+ }
+ else {
+ this.op = (unsigned char)(32 + 64); /* end of block */
+ this.val = 0;
+ }
+
+ /* replicate for those indices with low len bits equal to huff */
+ incr = 1U << (len - drop);
+ fill = 1U << curr;
+ do {
+ fill -= incr;
+ next[(huff >> drop) + fill] = this;
+ } while (fill != 0);
+
+ /* 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;
+
+ /* go to next symbol, update count, len */
+ sym++;
+ if (--(count[len]) == 0) {
+ if (len == max) break;
+ len = lens[work[sym]];
+ }
+
+ /* create new sub-table if needed */
+ if (len > root && (huff & mask) != low) {
+ /* if first time, transition to sub-tables */
+ if (drop == 0)
+ drop = root;
+
+ /* increment past last table */
+ next += 1U << curr;
+
+ /* determine length of next table */
+ curr = len - drop;
+ left = (int)(1 << curr);
+ while (curr + drop < max) {
+ left -= count[curr + drop];
+ if (left <= 0) break;
+ curr++;
+ left <<= 1;
+ }
+
+ /* check for enough space */
+ used += 1U << curr;
+ if ((type == LENS && used >= ENOUGH_LENS) ||
+ (type == DISTS && used >= ENOUGH_DISTS))
+ return 1;
+
+ /* point entry in root table to sub-table */
+ low = huff & mask;
+ (*table)[low].op = (unsigned char)curr;
+ (*table)[low].bits = (unsigned char)root;
+ (*table)[low].val = (unsigned short)(next - *table);
+ }
+ }
+
+ /*
+ 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.
+ */
+ this.op = (unsigned char)64; /* invalid code marker */
+ this.bits = (unsigned char)(len - drop);
+ this.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;
+ curr = root;
+ this.bits = (unsigned char)len;
+ }
+
+ /* put invalid code marker in table */
+ next[huff >> drop] = this;
+
+ /* 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;
+ }
+
+ /* set return parameters */
+ *table += used;
+ *bits = root;
+ return 0;
+}
diff --git a/compat/zlib/contrib/infback9/inftree9.h b/compat/zlib/contrib/infback9/inftree9.h
new file mode 100644
index 0000000..5ab21f0
--- /dev/null
+++ b/compat/zlib/contrib/infback9/inftree9.h
@@ -0,0 +1,61 @@
+/* inftree9.h -- header to use inftree9.c
+ * Copyright (C) 1995-2008 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* Structure for decoding tables. Each entry provides either the
+ information needed to do the operation requested by the code that
+ indexed that table entry, or it provides a pointer to another
+ table that indexes more bits of the code. op indicates whether
+ the entry is a pointer to another table, a literal, a length or
+ distance, an end-of-block, or an invalid code. For a table
+ pointer, the low four bits of op is the number of index bits of
+ that table. For a length or distance, the low four bits of op
+ is the number of extra bits to get after the code. bits is
+ the number of bits in this code or part of the code to drop off
+ of the bit buffer. val is the actual byte to output in the case
+ of a literal, the base length or distance, or the offset from
+ the current table to the next table. Each entry is four bytes. */
+typedef struct {
+ unsigned char op; /* operation, extra bits, table bits */
+ unsigned char bits; /* bits in this part of the code */
+ unsigned short val; /* offset in table or code value */
+} code;
+
+/* op values as set by inflate_table():
+ 00000000 - literal
+ 0000tttt - table link, tttt != 0 is the number of table index bits
+ 100eeeee - length or distance, eeee is the number of extra bits
+ 01100000 - end of block
+ 01000000 - invalid code
+ */
+
+/* Maximum size of the dynamic table. The maximum number of code structures is
+ 1446, which is the sum of 852 for literal/length codes and 594 for distance
+ codes. These values were found by exhaustive searches using the program
+ examples/enough.c found in the zlib distribtution. The arguments to that
+ program are the number of symbols, the initial root table size, and the
+ maximum bit length of a code. "enough 286 9 15" for literal/length codes
+ returns returns 852, and "enough 32 6 15" for distance codes returns 594.
+ The initial root table size (9 or 6) is found in the fifth argument of the
+ inflate_table() calls in infback9.c. If the root table size is changed,
+ then these maximum sizes would be need to be recalculated and updated. */
+#define ENOUGH_LENS 852
+#define ENOUGH_DISTS 594
+#define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS)
+
+/* Type of code to build for inflate_table9() */
+typedef enum {
+ CODES,
+ LENS,
+ DISTS
+} codetype;
+
+extern int inflate_table9 OF((codetype type, unsigned short FAR *lens,
+ unsigned codes, code FAR * FAR *table,
+ unsigned FAR *bits, unsigned short FAR *work));
diff --git a/compat/zlib/contrib/inflate86/inffas86.c b/compat/zlib/contrib/inflate86/inffas86.c
new file mode 100644
index 0000000..7292f67
--- /dev/null
+++ b/compat/zlib/contrib/inflate86/inffas86.c
@@ -0,0 +1,1157 @@
+/* inffas86.c is a hand tuned assembler version of
+ *
+ * inffast.c -- fast decoding
+ * Copyright (C) 1995-2003 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ *
+ * Copyright (C) 2003 Chris Anderson <christop@charm.net>
+ * Please use the copyright conditions above.
+ *
+ * Dec-29-2003 -- I added AMD64 inflate asm support. This version is also
+ * slightly quicker on x86 systems because, instead of using rep movsb to copy
+ * data, it uses rep movsw, which moves data in 2-byte chunks instead of single
+ * bytes. I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
+ * from http://fedora.linux.duke.edu/fc1_x86_64
+ * which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
+ * 1GB ram. The 64-bit version is about 4% faster than the 32-bit version,
+ * when decompressing mozilla-source-1.3.tar.gz.
+ *
+ * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
+ * the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at
+ * the moment. I have successfully compiled and tested this code with gcc2.96,
+ * gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S
+ * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
+ * enabled. I will attempt to merge the MMX code into this version. Newer
+ * versions of this and inffast.S can be found at
+ * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+/* Mark Adler's comments from inffast.c: */
+
+/*
+ Decode literal, length, and distance codes and write out the resulting
+ literal and match bytes until either not enough input or output is
+ available, an end-of-block is encountered, or a data error is encountered.
+ When large enough input and output buffers are supplied to inflate(), for
+ example, a 16K input buffer and a 64K output buffer, more than 95% of the
+ inflate execution time is spent in this routine.
+
+ Entry assumptions:
+
+ state->mode == LEN
+ strm->avail_in >= 6
+ strm->avail_out >= 258
+ start >= strm->avail_out
+ state->bits < 8
+
+ On return, state->mode is one of:
+
+ LEN -- ran out of enough output space or enough available input
+ TYPE -- reached end of block code, inflate() to interpret next block
+ BAD -- error in block data
+
+ Notes:
+
+ - The maximum input bits used by a length/distance pair is 15 bits for the
+ length code, 5 bits for the length extra, 15 bits for the distance code,
+ and 13 bits for the distance extra. This totals 48 bits, or six bytes.
+ Therefore if strm->avail_in >= 6, then there is enough input to avoid
+ checking for available input while decoding.
+
+ - The maximum bytes that a single length/distance pair can output is 258
+ bytes, which is the maximum length that can be coded. inflate_fast()
+ requires strm->avail_out >= 258 for each loop to avoid checking for
+ output space.
+ */
+void inflate_fast(strm, start)
+z_streamp strm;
+unsigned start; /* inflate()'s starting value for strm->avail_out */
+{
+ struct inflate_state FAR *state;
+ struct inffast_ar {
+/* 64 32 x86 x86_64 */
+/* ar offset register */
+/* 0 0 */ void *esp; /* esp save */
+/* 8 4 */ void *ebp; /* ebp save */
+/* 16 8 */ unsigned char FAR *in; /* esi rsi local strm->next_in */
+/* 24 12 */ unsigned char FAR *last; /* r9 while in < last */
+/* 32 16 */ unsigned char FAR *out; /* edi rdi local strm->next_out */
+/* 40 20 */ unsigned char FAR *beg; /* inflate()'s init next_out */
+/* 48 24 */ unsigned char FAR *end; /* r10 while out < end */
+/* 56 28 */ unsigned char FAR *window;/* size of window, wsize!=0 */
+/* 64 32 */ code const FAR *lcode; /* ebp rbp local strm->lencode */
+/* 72 36 */ code const FAR *dcode; /* r11 local strm->distcode */
+/* 80 40 */ unsigned long hold; /* edx rdx local strm->hold */
+/* 88 44 */ unsigned bits; /* ebx rbx local strm->bits */
+/* 92 48 */ unsigned wsize; /* window size */
+/* 96 52 */ unsigned write; /* window write index */
+/*100 56 */ unsigned lmask; /* r12 mask for lcode */
+/*104 60 */ unsigned dmask; /* r13 mask for dcode */
+/*108 64 */ unsigned len; /* r14 match length */
+/*112 68 */ unsigned dist; /* r15 match distance */
+/*116 72 */ unsigned status; /* set when state chng*/
+ } ar;
+
+#if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )
+#define PAD_AVAIL_IN 6
+#define PAD_AVAIL_OUT 258
+#else
+#define PAD_AVAIL_IN 5
+#define PAD_AVAIL_OUT 257
+#endif
+
+ /* copy state to local variables */
+ state = (struct inflate_state FAR *)strm->state;
+ ar.in = strm->next_in;
+ ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
+ ar.out = strm->next_out;
+ ar.beg = ar.out - (start - strm->avail_out);
+ ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
+ ar.wsize = state->wsize;
+ ar.write = state->wnext;
+ ar.window = state->window;
+ ar.hold = state->hold;
+ ar.bits = state->bits;
+ ar.lcode = state->lencode;
+ ar.dcode = state->distcode;
+ ar.lmask = (1U << state->lenbits) - 1;
+ ar.dmask = (1U << state->distbits) - 1;
+
+ /* decode literals and length/distances until end-of-block or not enough
+ input data or output space */
+
+ /* align in on 1/2 hold size boundary */
+ while (((unsigned long)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
+ ar.hold += (unsigned long)*ar.in++ << ar.bits;
+ ar.bits += 8;
+ }
+
+#if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )
+ __asm__ __volatile__ (
+" leaq %0, %%rax\n"
+" movq %%rbp, 8(%%rax)\n" /* save regs rbp and rsp */
+" movq %%rsp, (%%rax)\n"
+" movq %%rax, %%rsp\n" /* make rsp point to &ar */
+" movq 16(%%rsp), %%rsi\n" /* rsi = in */
+" movq 32(%%rsp), %%rdi\n" /* rdi = out */
+" movq 24(%%rsp), %%r9\n" /* r9 = last */
+" movq 48(%%rsp), %%r10\n" /* r10 = end */
+" movq 64(%%rsp), %%rbp\n" /* rbp = lcode */
+" movq 72(%%rsp), %%r11\n" /* r11 = dcode */
+" movq 80(%%rsp), %%rdx\n" /* rdx = hold */
+" movl 88(%%rsp), %%ebx\n" /* ebx = bits */
+" movl 100(%%rsp), %%r12d\n" /* r12d = lmask */
+" movl 104(%%rsp), %%r13d\n" /* r13d = dmask */
+ /* r14d = len */
+ /* r15d = dist */
+" cld\n"
+" cmpq %%rdi, %%r10\n"
+" je .L_one_time\n" /* if only one decode left */
+" cmpq %%rsi, %%r9\n"
+" je .L_one_time\n"
+" jmp .L_do_loop\n"
+
+".L_one_time:\n"
+" movq %%r12, %%r8\n" /* r8 = lmask */
+" cmpb $32, %%bl\n"
+" ja .L_get_length_code_one_time\n"
+
+" lodsl\n" /* eax = *(uint *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $32, %%bl\n" /* bits += 32 */
+" shlq %%cl, %%rax\n"
+" orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */
+" jmp .L_get_length_code_one_time\n"
+
+".align 32,0x90\n"
+".L_while_test:\n"
+" cmpq %%rdi, %%r10\n"
+" jbe .L_break_loop\n"
+" cmpq %%rsi, %%r9\n"
+" jbe .L_break_loop\n"
+
+".L_do_loop:\n"
+" movq %%r12, %%r8\n" /* r8 = lmask */
+" cmpb $32, %%bl\n"
+" ja .L_get_length_code\n" /* if (32 < bits) */
+
+" lodsl\n" /* eax = *(uint *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $32, %%bl\n" /* bits += 32 */
+" shlq %%cl, %%rax\n"
+" orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */
+
+".L_get_length_code:\n"
+" andq %%rdx, %%r8\n" /* r8 &= hold */
+" movl (%%rbp,%%r8,4), %%eax\n" /* eax = lcode[hold & lmask] */
+
+" movb %%ah, %%cl\n" /* cl = this.bits */
+" subb %%ah, %%bl\n" /* bits -= this.bits */
+" shrq %%cl, %%rdx\n" /* hold >>= this.bits */
+
+" testb %%al, %%al\n"
+" jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */
+
+" movq %%r12, %%r8\n" /* r8 = lmask */
+" shrl $16, %%eax\n" /* output this.val char */
+" stosb\n"
+
+".L_get_length_code_one_time:\n"
+" andq %%rdx, %%r8\n" /* r8 &= hold */
+" movl (%%rbp,%%r8,4), %%eax\n" /* eax = lcode[hold & lmask] */
+
+".L_dolen:\n"
+" movb %%ah, %%cl\n" /* cl = this.bits */
+" subb %%ah, %%bl\n" /* bits -= this.bits */
+" shrq %%cl, %%rdx\n" /* hold >>= this.bits */
+
+" testb %%al, %%al\n"
+" jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */
+
+" shrl $16, %%eax\n" /* output this.val char */
+" stosb\n"
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_test_for_length_base:\n"
+" movl %%eax, %%r14d\n" /* len = this */
+" shrl $16, %%r14d\n" /* len = this.val */
+" movb %%al, %%cl\n"
+
+" testb $16, %%al\n"
+" jz .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */
+" andb $15, %%cl\n" /* op &= 15 */
+" jz .L_decode_distance\n" /* if (!op) */
+
+".L_add_bits_to_len:\n"
+" subb %%cl, %%bl\n"
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" shrq %%cl, %%rdx\n"
+" addl %%eax, %%r14d\n" /* len += hold & mask[op] */
+
+".L_decode_distance:\n"
+" movq %%r13, %%r8\n" /* r8 = dmask */
+" cmpb $32, %%bl\n"
+" ja .L_get_distance_code\n" /* if (32 < bits) */
+
+" lodsl\n" /* eax = *(uint *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $32, %%bl\n" /* bits += 32 */
+" shlq %%cl, %%rax\n"
+" orq %%rax, %%rdx\n" /* hold |= *((uint *)in)++ << bits */
+
+".L_get_distance_code:\n"
+" andq %%rdx, %%r8\n" /* r8 &= hold */
+" movl (%%r11,%%r8,4), %%eax\n" /* eax = dcode[hold & dmask] */
+
+".L_dodist:\n"
+" movl %%eax, %%r15d\n" /* dist = this */
+" shrl $16, %%r15d\n" /* dist = this.val */
+" movb %%ah, %%cl\n"
+" subb %%ah, %%bl\n" /* bits -= this.bits */
+" shrq %%cl, %%rdx\n" /* hold >>= this.bits */
+" movb %%al, %%cl\n" /* cl = this.op */
+
+" testb $16, %%al\n" /* if ((op & 16) == 0) */
+" jz .L_test_for_second_level_dist\n"
+" andb $15, %%cl\n" /* op &= 15 */
+" jz .L_check_dist_one\n"
+
+".L_add_bits_to_dist:\n"
+" subb %%cl, %%bl\n"
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n" /* (1 << op) - 1 */
+" andl %%edx, %%eax\n" /* eax &= hold */
+" shrq %%cl, %%rdx\n"
+" addl %%eax, %%r15d\n" /* dist += hold & ((1 << op) - 1) */
+
+".L_check_window:\n"
+" movq %%rsi, %%r8\n" /* save in so from can use it's reg */
+" movq %%rdi, %%rax\n"
+" subq 40(%%rsp), %%rax\n" /* nbytes = out - beg */
+
+" cmpl %%r15d, %%eax\n"
+" jb .L_clip_window\n" /* if (dist > nbytes) 4.2% */
+
+" movl %%r14d, %%ecx\n" /* ecx = len */
+" movq %%rdi, %%rsi\n"
+" subq %%r15, %%rsi\n" /* from = out - dist */
+
+" sarl %%ecx\n"
+" jnc .L_copy_two\n" /* if len % 2 == 0 */
+
+" rep movsw\n"
+" movb (%%rsi), %%al\n"
+" movb %%al, (%%rdi)\n"
+" incq %%rdi\n"
+
+" movq %%r8, %%rsi\n" /* move in back to %rsi, toss from */
+" jmp .L_while_test\n"
+
+".L_copy_two:\n"
+" rep movsw\n"
+" movq %%r8, %%rsi\n" /* move in back to %rsi, toss from */
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_check_dist_one:\n"
+" cmpl $1, %%r15d\n" /* if dist 1, is a memset */
+" jne .L_check_window\n"
+" cmpq %%rdi, 40(%%rsp)\n" /* if out == beg, outside window */
+" je .L_check_window\n"
+
+" movl %%r14d, %%ecx\n" /* ecx = len */
+" movb -1(%%rdi), %%al\n"
+" movb %%al, %%ah\n"
+
+" sarl %%ecx\n"
+" jnc .L_set_two\n"
+" movb %%al, (%%rdi)\n"
+" incq %%rdi\n"
+
+".L_set_two:\n"
+" rep stosw\n"
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_test_for_second_level_length:\n"
+" testb $64, %%al\n"
+" jnz .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */
+
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" addl %%r14d, %%eax\n" /* eax += len */
+" movl (%%rbp,%%rax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/
+" jmp .L_dolen\n"
+
+".align 32,0x90\n"
+".L_test_for_second_level_dist:\n"
+" testb $64, %%al\n"
+" jnz .L_invalid_distance_code\n" /* if ((op & 64) != 0) */
+
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" addl %%r15d, %%eax\n" /* eax += dist */
+" movl (%%r11,%%rax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/
+" jmp .L_dodist\n"
+
+".align 32,0x90\n"
+".L_clip_window:\n"
+" movl %%eax, %%ecx\n" /* ecx = nbytes */
+" movl 92(%%rsp), %%eax\n" /* eax = wsize, prepare for dist cmp */
+" negl %%ecx\n" /* nbytes = -nbytes */
+
+" cmpl %%r15d, %%eax\n"
+" jb .L_invalid_distance_too_far\n" /* if (dist > wsize) */
+
+" addl %%r15d, %%ecx\n" /* nbytes = dist - nbytes */
+" cmpl $0, 96(%%rsp)\n"
+" jne .L_wrap_around_window\n" /* if (write != 0) */
+
+" movq 56(%%rsp), %%rsi\n" /* from = window */
+" subl %%ecx, %%eax\n" /* eax -= nbytes */
+" addq %%rax, %%rsi\n" /* from += wsize - nbytes */
+
+" movl %%r14d, %%eax\n" /* eax = len */
+" cmpl %%ecx, %%r14d\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* eax -= nbytes */
+" rep movsb\n"
+" movq %%rdi, %%rsi\n"
+" subq %%r15, %%rsi\n" /* from = &out[ -dist ] */
+" jmp .L_do_copy\n"
+
+".align 32,0x90\n"
+".L_wrap_around_window:\n"
+" movl 96(%%rsp), %%eax\n" /* eax = write */
+" cmpl %%eax, %%ecx\n"
+" jbe .L_contiguous_in_window\n" /* if (write >= nbytes) */
+
+" movl 92(%%rsp), %%esi\n" /* from = wsize */
+" addq 56(%%rsp), %%rsi\n" /* from += window */
+" addq %%rax, %%rsi\n" /* from += write */
+" subq %%rcx, %%rsi\n" /* from -= nbytes */
+" subl %%eax, %%ecx\n" /* nbytes -= write */
+
+" movl %%r14d, %%eax\n" /* eax = len */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movq 56(%%rsp), %%rsi\n" /* from = window */
+" movl 96(%%rsp), %%ecx\n" /* nbytes = write */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movq %%rdi, %%rsi\n"
+" subq %%r15, %%rsi\n" /* from = out - dist */
+" jmp .L_do_copy\n"
+
+".align 32,0x90\n"
+".L_contiguous_in_window:\n"
+" movq 56(%%rsp), %%rsi\n" /* rsi = window */
+" addq %%rax, %%rsi\n"
+" subq %%rcx, %%rsi\n" /* from += write - nbytes */
+
+" movl %%r14d, %%eax\n" /* eax = len */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movq %%rdi, %%rsi\n"
+" subq %%r15, %%rsi\n" /* from = out - dist */
+" jmp .L_do_copy\n" /* if (nbytes >= len) */
+
+".align 32,0x90\n"
+".L_do_copy:\n"
+" movl %%eax, %%ecx\n" /* ecx = len */
+" rep movsb\n"
+
+" movq %%r8, %%rsi\n" /* move in back to %esi, toss from */
+" jmp .L_while_test\n"
+
+".L_test_for_end_of_block:\n"
+" testb $32, %%al\n"
+" jz .L_invalid_literal_length_code\n"
+" movl $1, 116(%%rsp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_literal_length_code:\n"
+" movl $2, 116(%%rsp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_distance_code:\n"
+" movl $3, 116(%%rsp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_distance_too_far:\n"
+" movl $4, 116(%%rsp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_break_loop:\n"
+" movl $0, 116(%%rsp)\n"
+
+".L_break_loop_with_status:\n"
+/* put in, out, bits, and hold back into ar and pop esp */
+" movq %%rsi, 16(%%rsp)\n" /* in */
+" movq %%rdi, 32(%%rsp)\n" /* out */
+" movl %%ebx, 88(%%rsp)\n" /* bits */
+" movq %%rdx, 80(%%rsp)\n" /* hold */
+" movq (%%rsp), %%rax\n" /* restore rbp and rsp */
+" movq 8(%%rsp), %%rbp\n"
+" movq %%rax, %%rsp\n"
+ :
+ : "m" (ar)
+ : "memory", "%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi",
+ "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15"
+ );
+#elif ( defined( __GNUC__ ) || defined( __ICC ) ) && defined( __i386 )
+ __asm__ __volatile__ (
+" leal %0, %%eax\n"
+" movl %%esp, (%%eax)\n" /* save esp, ebp */
+" movl %%ebp, 4(%%eax)\n"
+" movl %%eax, %%esp\n"
+" movl 8(%%esp), %%esi\n" /* esi = in */
+" movl 16(%%esp), %%edi\n" /* edi = out */
+" movl 40(%%esp), %%edx\n" /* edx = hold */
+" movl 44(%%esp), %%ebx\n" /* ebx = bits */
+" movl 32(%%esp), %%ebp\n" /* ebp = lcode */
+
+" cld\n"
+" jmp .L_do_loop\n"
+
+".align 32,0x90\n"
+".L_while_test:\n"
+" cmpl %%edi, 24(%%esp)\n" /* out < end */
+" jbe .L_break_loop\n"
+" cmpl %%esi, 12(%%esp)\n" /* in < last */
+" jbe .L_break_loop\n"
+
+".L_do_loop:\n"
+" cmpb $15, %%bl\n"
+" ja .L_get_length_code\n" /* if (15 < bits) */
+
+" xorl %%eax, %%eax\n"
+" lodsw\n" /* al = *(ushort *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $16, %%bl\n" /* bits += 16 */
+" shll %%cl, %%eax\n"
+" orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */
+
+".L_get_length_code:\n"
+" movl 56(%%esp), %%eax\n" /* eax = lmask */
+" andl %%edx, %%eax\n" /* eax &= hold */
+" movl (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[hold & lmask] */
+
+".L_dolen:\n"
+" movb %%ah, %%cl\n" /* cl = this.bits */
+" subb %%ah, %%bl\n" /* bits -= this.bits */
+" shrl %%cl, %%edx\n" /* hold >>= this.bits */
+
+" testb %%al, %%al\n"
+" jnz .L_test_for_length_base\n" /* if (op != 0) 45.7% */
+
+" shrl $16, %%eax\n" /* output this.val char */
+" stosb\n"
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_test_for_length_base:\n"
+" movl %%eax, %%ecx\n" /* len = this */
+" shrl $16, %%ecx\n" /* len = this.val */
+" movl %%ecx, 64(%%esp)\n" /* save len */
+" movb %%al, %%cl\n"
+
+" testb $16, %%al\n"
+" jz .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */
+" andb $15, %%cl\n" /* op &= 15 */
+" jz .L_decode_distance\n" /* if (!op) */
+" cmpb %%cl, %%bl\n"
+" jae .L_add_bits_to_len\n" /* if (op <= bits) */
+
+" movb %%cl, %%ch\n" /* stash op in ch, freeing cl */
+" xorl %%eax, %%eax\n"
+" lodsw\n" /* al = *(ushort *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $16, %%bl\n" /* bits += 16 */
+" shll %%cl, %%eax\n"
+" orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */
+" movb %%ch, %%cl\n" /* move op back to ecx */
+
+".L_add_bits_to_len:\n"
+" subb %%cl, %%bl\n"
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" shrl %%cl, %%edx\n"
+" addl %%eax, 64(%%esp)\n" /* len += hold & mask[op] */
+
+".L_decode_distance:\n"
+" cmpb $15, %%bl\n"
+" ja .L_get_distance_code\n" /* if (15 < bits) */
+
+" xorl %%eax, %%eax\n"
+" lodsw\n" /* al = *(ushort *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $16, %%bl\n" /* bits += 16 */
+" shll %%cl, %%eax\n"
+" orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */
+
+".L_get_distance_code:\n"
+" movl 60(%%esp), %%eax\n" /* eax = dmask */
+" movl 36(%%esp), %%ecx\n" /* ecx = dcode */
+" andl %%edx, %%eax\n" /* eax &= hold */
+" movl (%%ecx,%%eax,4), %%eax\n"/* eax = dcode[hold & dmask] */
+
+".L_dodist:\n"
+" movl %%eax, %%ebp\n" /* dist = this */
+" shrl $16, %%ebp\n" /* dist = this.val */
+" movb %%ah, %%cl\n"
+" subb %%ah, %%bl\n" /* bits -= this.bits */
+" shrl %%cl, %%edx\n" /* hold >>= this.bits */
+" movb %%al, %%cl\n" /* cl = this.op */
+
+" testb $16, %%al\n" /* if ((op & 16) == 0) */
+" jz .L_test_for_second_level_dist\n"
+" andb $15, %%cl\n" /* op &= 15 */
+" jz .L_check_dist_one\n"
+" cmpb %%cl, %%bl\n"
+" jae .L_add_bits_to_dist\n" /* if (op <= bits) 97.6% */
+
+" movb %%cl, %%ch\n" /* stash op in ch, freeing cl */
+" xorl %%eax, %%eax\n"
+" lodsw\n" /* al = *(ushort *)in++ */
+" movb %%bl, %%cl\n" /* cl = bits, needs it for shifting */
+" addb $16, %%bl\n" /* bits += 16 */
+" shll %%cl, %%eax\n"
+" orl %%eax, %%edx\n" /* hold |= *((ushort *)in)++ << bits */
+" movb %%ch, %%cl\n" /* move op back to ecx */
+
+".L_add_bits_to_dist:\n"
+" subb %%cl, %%bl\n"
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n" /* (1 << op) - 1 */
+" andl %%edx, %%eax\n" /* eax &= hold */
+" shrl %%cl, %%edx\n"
+" addl %%eax, %%ebp\n" /* dist += hold & ((1 << op) - 1) */
+
+".L_check_window:\n"
+" movl %%esi, 8(%%esp)\n" /* save in so from can use it's reg */
+" movl %%edi, %%eax\n"
+" subl 20(%%esp), %%eax\n" /* nbytes = out - beg */
+
+" cmpl %%ebp, %%eax\n"
+" jb .L_clip_window\n" /* if (dist > nbytes) 4.2% */
+
+" movl 64(%%esp), %%ecx\n" /* ecx = len */
+" movl %%edi, %%esi\n"
+" subl %%ebp, %%esi\n" /* from = out - dist */
+
+" sarl %%ecx\n"
+" jnc .L_copy_two\n" /* if len % 2 == 0 */
+
+" rep movsw\n"
+" movb (%%esi), %%al\n"
+" movb %%al, (%%edi)\n"
+" incl %%edi\n"
+
+" movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */
+" movl 32(%%esp), %%ebp\n" /* ebp = lcode */
+" jmp .L_while_test\n"
+
+".L_copy_two:\n"
+" rep movsw\n"
+" movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */
+" movl 32(%%esp), %%ebp\n" /* ebp = lcode */
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_check_dist_one:\n"
+" cmpl $1, %%ebp\n" /* if dist 1, is a memset */
+" jne .L_check_window\n"
+" cmpl %%edi, 20(%%esp)\n"
+" je .L_check_window\n" /* out == beg, if outside window */
+
+" movl 64(%%esp), %%ecx\n" /* ecx = len */
+" movb -1(%%edi), %%al\n"
+" movb %%al, %%ah\n"
+
+" sarl %%ecx\n"
+" jnc .L_set_two\n"
+" movb %%al, (%%edi)\n"
+" incl %%edi\n"
+
+".L_set_two:\n"
+" rep stosw\n"
+" movl 32(%%esp), %%ebp\n" /* ebp = lcode */
+" jmp .L_while_test\n"
+
+".align 32,0x90\n"
+".L_test_for_second_level_length:\n"
+" testb $64, %%al\n"
+" jnz .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */
+
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" addl 64(%%esp), %%eax\n" /* eax += len */
+" movl (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/
+" jmp .L_dolen\n"
+
+".align 32,0x90\n"
+".L_test_for_second_level_dist:\n"
+" testb $64, %%al\n"
+" jnz .L_invalid_distance_code\n" /* if ((op & 64) != 0) */
+
+" xorl %%eax, %%eax\n"
+" incl %%eax\n"
+" shll %%cl, %%eax\n"
+" decl %%eax\n"
+" andl %%edx, %%eax\n" /* eax &= hold */
+" addl %%ebp, %%eax\n" /* eax += dist */
+" movl 36(%%esp), %%ecx\n" /* ecx = dcode */
+" movl (%%ecx,%%eax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/
+" jmp .L_dodist\n"
+
+".align 32,0x90\n"
+".L_clip_window:\n"
+" movl %%eax, %%ecx\n"
+" movl 48(%%esp), %%eax\n" /* eax = wsize */
+" negl %%ecx\n" /* nbytes = -nbytes */
+" movl 28(%%esp), %%esi\n" /* from = window */
+
+" cmpl %%ebp, %%eax\n"
+" jb .L_invalid_distance_too_far\n" /* if (dist > wsize) */
+
+" addl %%ebp, %%ecx\n" /* nbytes = dist - nbytes */
+" cmpl $0, 52(%%esp)\n"
+" jne .L_wrap_around_window\n" /* if (write != 0) */
+
+" subl %%ecx, %%eax\n"
+" addl %%eax, %%esi\n" /* from += wsize - nbytes */
+
+" movl 64(%%esp), %%eax\n" /* eax = len */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movl %%edi, %%esi\n"
+" subl %%ebp, %%esi\n" /* from = out - dist */
+" jmp .L_do_copy\n"
+
+".align 32,0x90\n"
+".L_wrap_around_window:\n"
+" movl 52(%%esp), %%eax\n" /* eax = write */
+" cmpl %%eax, %%ecx\n"
+" jbe .L_contiguous_in_window\n" /* if (write >= nbytes) */
+
+" addl 48(%%esp), %%esi\n" /* from += wsize */
+" addl %%eax, %%esi\n" /* from += write */
+" subl %%ecx, %%esi\n" /* from -= nbytes */
+" subl %%eax, %%ecx\n" /* nbytes -= write */
+
+" movl 64(%%esp), %%eax\n" /* eax = len */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movl 28(%%esp), %%esi\n" /* from = window */
+" movl 52(%%esp), %%ecx\n" /* nbytes = write */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movl %%edi, %%esi\n"
+" subl %%ebp, %%esi\n" /* from = out - dist */
+" jmp .L_do_copy\n"
+
+".align 32,0x90\n"
+".L_contiguous_in_window:\n"
+" addl %%eax, %%esi\n"
+" subl %%ecx, %%esi\n" /* from += write - nbytes */
+
+" movl 64(%%esp), %%eax\n" /* eax = len */
+" cmpl %%ecx, %%eax\n"
+" jbe .L_do_copy\n" /* if (nbytes >= len) */
+
+" subl %%ecx, %%eax\n" /* len -= nbytes */
+" rep movsb\n"
+" movl %%edi, %%esi\n"
+" subl %%ebp, %%esi\n" /* from = out - dist */
+" jmp .L_do_copy\n" /* if (nbytes >= len) */
+
+".align 32,0x90\n"
+".L_do_copy:\n"
+" movl %%eax, %%ecx\n"
+" rep movsb\n"
+
+" movl 8(%%esp), %%esi\n" /* move in back to %esi, toss from */
+" movl 32(%%esp), %%ebp\n" /* ebp = lcode */
+" jmp .L_while_test\n"
+
+".L_test_for_end_of_block:\n"
+" testb $32, %%al\n"
+" jz .L_invalid_literal_length_code\n"
+" movl $1, 72(%%esp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_literal_length_code:\n"
+" movl $2, 72(%%esp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_distance_code:\n"
+" movl $3, 72(%%esp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_invalid_distance_too_far:\n"
+" movl 8(%%esp), %%esi\n"
+" movl $4, 72(%%esp)\n"
+" jmp .L_break_loop_with_status\n"
+
+".L_break_loop:\n"
+" movl $0, 72(%%esp)\n"
+
+".L_break_loop_with_status:\n"
+/* put in, out, bits, and hold back into ar and pop esp */
+" movl %%esi, 8(%%esp)\n" /* save in */
+" movl %%edi, 16(%%esp)\n" /* save out */
+" movl %%ebx, 44(%%esp)\n" /* save bits */
+" movl %%edx, 40(%%esp)\n" /* save hold */
+" movl 4(%%esp), %%ebp\n" /* restore esp, ebp */
+" movl (%%esp), %%esp\n"
+ :
+ : "m" (ar)
+ : "memory", "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi"
+ );
+#elif defined( _MSC_VER ) && ! defined( _M_AMD64 )
+ __asm {
+ lea eax, ar
+ mov [eax], esp /* save esp, ebp */
+ mov [eax+4], ebp
+ mov esp, eax
+ mov esi, [esp+8] /* esi = in */
+ mov edi, [esp+16] /* edi = out */
+ mov edx, [esp+40] /* edx = hold */
+ mov ebx, [esp+44] /* ebx = bits */
+ mov ebp, [esp+32] /* ebp = lcode */
+
+ cld
+ jmp L_do_loop
+
+ALIGN 4
+L_while_test:
+ cmp [esp+24], edi
+ jbe L_break_loop
+ cmp [esp+12], esi
+ jbe L_break_loop
+
+L_do_loop:
+ cmp bl, 15
+ ja L_get_length_code /* if (15 < bits) */
+
+ xor eax, eax
+ lodsw /* al = *(ushort *)in++ */
+ mov cl, bl /* cl = bits, needs it for shifting */
+ add bl, 16 /* bits += 16 */
+ shl eax, cl
+ or edx, eax /* hold |= *((ushort *)in)++ << bits */
+
+L_get_length_code:
+ mov eax, [esp+56] /* eax = lmask */
+ and eax, edx /* eax &= hold */
+ mov eax, [ebp+eax*4] /* eax = lcode[hold & lmask] */
+
+L_dolen:
+ mov cl, ah /* cl = this.bits */
+ sub bl, ah /* bits -= this.bits */
+ shr edx, cl /* hold >>= this.bits */
+
+ test al, al
+ jnz L_test_for_length_base /* if (op != 0) 45.7% */
+
+ shr eax, 16 /* output this.val char */
+ stosb
+ jmp L_while_test
+
+ALIGN 4
+L_test_for_length_base:
+ mov ecx, eax /* len = this */
+ shr ecx, 16 /* len = this.val */
+ mov [esp+64], ecx /* save len */
+ mov cl, al
+
+ test al, 16
+ jz L_test_for_second_level_length /* if ((op & 16) == 0) 8% */
+ and cl, 15 /* op &= 15 */
+ jz L_decode_distance /* if (!op) */
+ cmp bl, cl
+ jae L_add_bits_to_len /* if (op <= bits) */
+
+ mov ch, cl /* stash op in ch, freeing cl */
+ xor eax, eax
+ lodsw /* al = *(ushort *)in++ */
+ mov cl, bl /* cl = bits, needs it for shifting */
+ add bl, 16 /* bits += 16 */
+ shl eax, cl
+ or edx, eax /* hold |= *((ushort *)in)++ << bits */
+ mov cl, ch /* move op back to ecx */
+
+L_add_bits_to_len:
+ sub bl, cl
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx /* eax &= hold */
+ shr edx, cl
+ add [esp+64], eax /* len += hold & mask[op] */
+
+L_decode_distance:
+ cmp bl, 15
+ ja L_get_distance_code /* if (15 < bits) */
+
+ xor eax, eax
+ lodsw /* al = *(ushort *)in++ */
+ mov cl, bl /* cl = bits, needs it for shifting */
+ add bl, 16 /* bits += 16 */
+ shl eax, cl
+ or edx, eax /* hold |= *((ushort *)in)++ << bits */
+
+L_get_distance_code:
+ mov eax, [esp+60] /* eax = dmask */
+ mov ecx, [esp+36] /* ecx = dcode */
+ and eax, edx /* eax &= hold */
+ mov eax, [ecx+eax*4]/* eax = dcode[hold & dmask] */
+
+L_dodist:
+ mov ebp, eax /* dist = this */
+ shr ebp, 16 /* dist = this.val */
+ mov cl, ah
+ sub bl, ah /* bits -= this.bits */
+ shr edx, cl /* hold >>= this.bits */
+ mov cl, al /* cl = this.op */
+
+ test al, 16 /* if ((op & 16) == 0) */
+ jz L_test_for_second_level_dist
+ and cl, 15 /* op &= 15 */
+ jz L_check_dist_one
+ cmp bl, cl
+ jae L_add_bits_to_dist /* if (op <= bits) 97.6% */
+
+ mov ch, cl /* stash op in ch, freeing cl */
+ xor eax, eax
+ lodsw /* al = *(ushort *)in++ */
+ mov cl, bl /* cl = bits, needs it for shifting */
+ add bl, 16 /* bits += 16 */
+ shl eax, cl
+ or edx, eax /* hold |= *((ushort *)in)++ << bits */
+ mov cl, ch /* move op back to ecx */
+
+L_add_bits_to_dist:
+ sub bl, cl
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax /* (1 << op) - 1 */
+ and eax, edx /* eax &= hold */
+ shr edx, cl
+ add ebp, eax /* dist += hold & ((1 << op) - 1) */
+
+L_check_window:
+ mov [esp+8], esi /* save in so from can use it's reg */
+ mov eax, edi
+ sub eax, [esp+20] /* nbytes = out - beg */
+
+ cmp eax, ebp
+ jb L_clip_window /* if (dist > nbytes) 4.2% */
+
+ mov ecx, [esp+64] /* ecx = len */
+ mov esi, edi
+ sub esi, ebp /* from = out - dist */
+
+ sar ecx, 1
+ jnc L_copy_two
+
+ rep movsw
+ mov al, [esi]
+ mov [edi], al
+ inc edi
+
+ mov esi, [esp+8] /* move in back to %esi, toss from */
+ mov ebp, [esp+32] /* ebp = lcode */
+ jmp L_while_test
+
+L_copy_two:
+ rep movsw
+ mov esi, [esp+8] /* move in back to %esi, toss from */
+ mov ebp, [esp+32] /* ebp = lcode */
+ jmp L_while_test
+
+ALIGN 4
+L_check_dist_one:
+ cmp ebp, 1 /* if dist 1, is a memset */
+ jne L_check_window
+ cmp [esp+20], edi
+ je L_check_window /* out == beg, if outside window */
+
+ mov ecx, [esp+64] /* ecx = len */
+ mov al, [edi-1]
+ mov ah, al
+
+ sar ecx, 1
+ jnc L_set_two
+ mov [edi], al /* memset out with from[-1] */
+ inc edi
+
+L_set_two:
+ rep stosw
+ mov ebp, [esp+32] /* ebp = lcode */
+ jmp L_while_test
+
+ALIGN 4
+L_test_for_second_level_length:
+ test al, 64
+ jnz L_test_for_end_of_block /* if ((op & 64) != 0) */
+
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx /* eax &= hold */
+ add eax, [esp+64] /* eax += len */
+ mov eax, [ebp+eax*4] /* eax = lcode[val+(hold&mask[op])]*/
+ jmp L_dolen
+
+ALIGN 4
+L_test_for_second_level_dist:
+ test al, 64
+ jnz L_invalid_distance_code /* if ((op & 64) != 0) */
+
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx /* eax &= hold */
+ add eax, ebp /* eax += dist */
+ mov ecx, [esp+36] /* ecx = dcode */
+ mov eax, [ecx+eax*4] /* eax = dcode[val+(hold&mask[op])]*/
+ jmp L_dodist
+
+ALIGN 4
+L_clip_window:
+ mov ecx, eax
+ mov eax, [esp+48] /* eax = wsize */
+ neg ecx /* nbytes = -nbytes */
+ mov esi, [esp+28] /* from = window */
+
+ cmp eax, ebp
+ jb L_invalid_distance_too_far /* if (dist > wsize) */
+
+ add ecx, ebp /* nbytes = dist - nbytes */
+ cmp dword ptr [esp+52], 0
+ jne L_wrap_around_window /* if (write != 0) */
+
+ sub eax, ecx
+ add esi, eax /* from += wsize - nbytes */
+
+ mov eax, [esp+64] /* eax = len */
+ cmp eax, ecx
+ jbe L_do_copy /* if (nbytes >= len) */
+
+ sub eax, ecx /* len -= nbytes */
+ rep movsb
+ mov esi, edi
+ sub esi, ebp /* from = out - dist */
+ jmp L_do_copy
+
+ALIGN 4
+L_wrap_around_window:
+ mov eax, [esp+52] /* eax = write */
+ cmp ecx, eax
+ jbe L_contiguous_in_window /* if (write >= nbytes) */
+
+ add esi, [esp+48] /* from += wsize */
+ add esi, eax /* from += write */
+ sub esi, ecx /* from -= nbytes */
+ sub ecx, eax /* nbytes -= write */
+
+ mov eax, [esp+64] /* eax = len */
+ cmp eax, ecx
+ jbe L_do_copy /* if (nbytes >= len) */
+
+ sub eax, ecx /* len -= nbytes */
+ rep movsb
+ mov esi, [esp+28] /* from = window */
+ mov ecx, [esp+52] /* nbytes = write */
+ cmp eax, ecx
+ jbe L_do_copy /* if (nbytes >= len) */
+
+ sub eax, ecx /* len -= nbytes */
+ rep movsb
+ mov esi, edi
+ sub esi, ebp /* from = out - dist */
+ jmp L_do_copy
+
+ALIGN 4
+L_contiguous_in_window:
+ add esi, eax
+ sub esi, ecx /* from += write - nbytes */
+
+ mov eax, [esp+64] /* eax = len */
+ cmp eax, ecx
+ jbe L_do_copy /* if (nbytes >= len) */
+
+ sub eax, ecx /* len -= nbytes */
+ rep movsb
+ mov esi, edi
+ sub esi, ebp /* from = out - dist */
+ jmp L_do_copy
+
+ALIGN 4
+L_do_copy:
+ mov ecx, eax
+ rep movsb
+
+ mov esi, [esp+8] /* move in back to %esi, toss from */
+ mov ebp, [esp+32] /* ebp = lcode */
+ jmp L_while_test
+
+L_test_for_end_of_block:
+ test al, 32
+ jz L_invalid_literal_length_code
+ mov dword ptr [esp+72], 1
+ jmp L_break_loop_with_status
+
+L_invalid_literal_length_code:
+ mov dword ptr [esp+72], 2
+ jmp L_break_loop_with_status
+
+L_invalid_distance_code:
+ mov dword ptr [esp+72], 3
+ jmp L_break_loop_with_status
+
+L_invalid_distance_too_far:
+ mov esi, [esp+4]
+ mov dword ptr [esp+72], 4
+ jmp L_break_loop_with_status
+
+L_break_loop:
+ mov dword ptr [esp+72], 0
+
+L_break_loop_with_status:
+/* put in, out, bits, and hold back into ar and pop esp */
+ mov [esp+8], esi /* save in */
+ mov [esp+16], edi /* save out */
+ mov [esp+44], ebx /* save bits */
+ mov [esp+40], edx /* save hold */
+ mov ebp, [esp+4] /* restore esp, ebp */
+ mov esp, [esp]
+ }
+#else
+#error "x86 architecture not defined"
+#endif
+
+ if (ar.status > 1) {
+ if (ar.status == 2)
+ strm->msg = "invalid literal/length code";
+ else if (ar.status == 3)
+ strm->msg = "invalid distance code";
+ else
+ strm->msg = "invalid distance too far back";
+ state->mode = BAD;
+ }
+ else if ( ar.status == 1 ) {
+ state->mode = TYPE;
+ }
+
+ /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
+ ar.len = ar.bits >> 3;
+ ar.in -= ar.len;
+ ar.bits -= ar.len << 3;
+ ar.hold &= (1U << ar.bits) - 1;
+
+ /* update state and return */
+ strm->next_in = ar.in;
+ strm->next_out = ar.out;
+ strm->avail_in = (unsigned)(ar.in < ar.last ?
+ PAD_AVAIL_IN + (ar.last - ar.in) :
+ PAD_AVAIL_IN - (ar.in - ar.last));
+ strm->avail_out = (unsigned)(ar.out < ar.end ?
+ PAD_AVAIL_OUT + (ar.end - ar.out) :
+ PAD_AVAIL_OUT - (ar.out - ar.end));
+ state->hold = ar.hold;
+ state->bits = ar.bits;
+ return;
+}
+
diff --git a/compat/zlib/contrib/inflate86/inffast.S b/compat/zlib/contrib/inflate86/inffast.S
new file mode 100644
index 0000000..2245a29
--- /dev/null
+++ b/compat/zlib/contrib/inflate86/inffast.S
@@ -0,0 +1,1368 @@
+/*
+ * inffast.S is a hand tuned assembler version of:
+ *
+ * inffast.c -- fast decoding
+ * Copyright (C) 1995-2003 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ *
+ * Copyright (C) 2003 Chris Anderson <christop@charm.net>
+ * Please use the copyright conditions above.
+ *
+ * This version (Jan-23-2003) of inflate_fast was coded and tested under
+ * GNU/Linux on a pentium 3, using the gcc-3.2 compiler distribution. On that
+ * machine, I found that gzip style archives decompressed about 20% faster than
+ * the gcc-3.2 -O3 -fomit-frame-pointer compiled version. Your results will
+ * depend on how large of a buffer is used for z_stream.next_in & next_out
+ * (8K-32K worked best for my 256K cpu cache) and how much overhead there is in
+ * stream processing I/O and crc32/addler32. In my case, this routine used
+ * 70% of the cpu time and crc32 used 20%.
+ *
+ * I am confident that this version will work in the general case, but I have
+ * not tested a wide variety of datasets or a wide variety of platforms.
+ *
+ * Jan-24-2003 -- Added -DUSE_MMX define for slightly faster inflating.
+ * It should be a runtime flag instead of compile time flag...
+ *
+ * Jan-26-2003 -- Added runtime check for MMX support with cpuid instruction.
+ * With -DUSE_MMX, only MMX code is compiled. With -DNO_MMX, only non-MMX code
+ * is compiled. Without either option, runtime detection is enabled. Runtime
+ * detection should work on all modern cpus and the recomended algorithm (flip
+ * ID bit on eflags and then use the cpuid instruction) is used in many
+ * multimedia applications. Tested under win2k with gcc-2.95 and gas-2.12
+ * distributed with cygwin3. Compiling with gcc-2.95 -c inffast.S -o
+ * inffast.obj generates a COFF object which can then be linked with MSVC++
+ * compiled code. Tested under FreeBSD 4.7 with gcc-2.95.
+ *
+ * Jan-28-2003 -- Tested Athlon XP... MMX mode is slower than no MMX (and
+ * slower than compiler generated code). Adjusted cpuid check to use the MMX
+ * code only for Pentiums < P4 until I have more data on the P4. Speed
+ * improvment is only about 15% on the Athlon when compared with code generated
+ * with MSVC++. Not sure yet, but I think the P4 will also be slower using the
+ * MMX mode because many of it's x86 ALU instructions execute in .5 cycles and
+ * have less latency than MMX ops. Added code to buffer the last 11 bytes of
+ * the input stream since the MMX code grabs bits in chunks of 32, which
+ * differs from the inffast.c algorithm. I don't think there would have been
+ * read overruns where a page boundary was crossed (a segfault), but there
+ * could have been overruns when next_in ends on unaligned memory (unintialized
+ * memory read).
+ *
+ * Mar-13-2003 -- P4 MMX is slightly slower than P4 NO_MMX. I created a C
+ * version of the non-MMX code so that it doesn't depend on zstrm and zstate
+ * structure offsets which are hard coded in this file. This was last tested
+ * with zlib-1.2.0 which is currently in beta testing, newer versions of this
+ * and inffas86.c can be found at http://www.eetbeetee.com/zlib/ and
+ * http://www.charm.net/~christop/zlib/
+ */
+
+
+/*
+ * if you have underscore linking problems (_inflate_fast undefined), try
+ * using -DGAS_COFF
+ */
+#if ! defined( GAS_COFF ) && ! defined( GAS_ELF )
+
+#if defined( WIN32 ) || defined( __CYGWIN__ )
+#define GAS_COFF /* windows object format */
+#else
+#define GAS_ELF
+#endif
+
+#endif /* ! GAS_COFF && ! GAS_ELF */
+
+
+#if defined( GAS_COFF )
+
+/* coff externals have underscores */
+#define inflate_fast _inflate_fast
+#define inflate_fast_use_mmx _inflate_fast_use_mmx
+
+#endif /* GAS_COFF */
+
+
+.file "inffast.S"
+
+.globl inflate_fast
+
+.text
+.align 4,0
+.L_invalid_literal_length_code_msg:
+.string "invalid literal/length code"
+
+.align 4,0
+.L_invalid_distance_code_msg:
+.string "invalid distance code"
+
+.align 4,0
+.L_invalid_distance_too_far_msg:
+.string "invalid distance too far back"
+
+#if ! defined( NO_MMX )
+.align 4,0
+.L_mask: /* mask[N] = ( 1 << N ) - 1 */
+.long 0
+.long 1
+.long 3
+.long 7
+.long 15
+.long 31
+.long 63
+.long 127
+.long 255
+.long 511
+.long 1023
+.long 2047
+.long 4095
+.long 8191
+.long 16383
+.long 32767
+.long 65535
+.long 131071
+.long 262143
+.long 524287
+.long 1048575
+.long 2097151
+.long 4194303
+.long 8388607
+.long 16777215
+.long 33554431
+.long 67108863
+.long 134217727
+.long 268435455
+.long 536870911
+.long 1073741823
+.long 2147483647
+.long 4294967295
+#endif /* NO_MMX */
+
+.text
+
+/*
+ * struct z_stream offsets, in zlib.h
+ */
+#define next_in_strm 0 /* strm->next_in */
+#define avail_in_strm 4 /* strm->avail_in */
+#define next_out_strm 12 /* strm->next_out */
+#define avail_out_strm 16 /* strm->avail_out */
+#define msg_strm 24 /* strm->msg */
+#define state_strm 28 /* strm->state */
+
+/*
+ * struct inflate_state offsets, in inflate.h
+ */
+#define mode_state 0 /* state->mode */
+#define wsize_state 32 /* state->wsize */
+#define write_state 40 /* state->write */
+#define window_state 44 /* state->window */
+#define hold_state 48 /* state->hold */
+#define bits_state 52 /* state->bits */
+#define lencode_state 68 /* state->lencode */
+#define distcode_state 72 /* state->distcode */
+#define lenbits_state 76 /* state->lenbits */
+#define distbits_state 80 /* state->distbits */
+
+/*
+ * inflate_fast's activation record
+ */
+#define local_var_size 64 /* how much local space for vars */
+#define strm_sp 88 /* first arg: z_stream * (local_var_size + 24) */
+#define start_sp 92 /* second arg: unsigned int (local_var_size + 28) */
+
+/*
+ * offsets for local vars on stack
+ */
+#define out 60 /* unsigned char* */
+#define window 56 /* unsigned char* */
+#define wsize 52 /* unsigned int */
+#define write 48 /* unsigned int */
+#define in 44 /* unsigned char* */
+#define beg 40 /* unsigned char* */
+#define buf 28 /* char[ 12 ] */
+#define len 24 /* unsigned int */
+#define last 20 /* unsigned char* */
+#define end 16 /* unsigned char* */
+#define dcode 12 /* code* */
+#define lcode 8 /* code* */
+#define dmask 4 /* unsigned int */
+#define lmask 0 /* unsigned int */
+
+/*
+ * typedef enum inflate_mode consts, in inflate.h
+ */
+#define INFLATE_MODE_TYPE 11 /* state->mode flags enum-ed in inflate.h */
+#define INFLATE_MODE_BAD 26
+
+
+#if ! defined( USE_MMX ) && ! defined( NO_MMX )
+
+#define RUN_TIME_MMX
+
+#define CHECK_MMX 1
+#define DO_USE_MMX 2
+#define DONT_USE_MMX 3
+
+.globl inflate_fast_use_mmx
+
+.data
+
+.align 4,0
+inflate_fast_use_mmx: /* integer flag for run time control 1=check,2=mmx,3=no */
+.long CHECK_MMX
+
+#if defined( GAS_ELF )
+/* elf info */
+.type inflate_fast_use_mmx,@object
+.size inflate_fast_use_mmx,4
+#endif
+
+#endif /* RUN_TIME_MMX */
+
+#if defined( GAS_COFF )
+/* coff info: scl 2 = extern, type 32 = function */
+.def inflate_fast; .scl 2; .type 32; .endef
+#endif
+
+.text
+
+.align 32,0x90
+inflate_fast:
+ pushl %edi
+ pushl %esi
+ pushl %ebp
+ pushl %ebx
+ pushf /* save eflags (strm_sp, state_sp assumes this is 32 bits) */
+ subl $local_var_size, %esp
+ cld
+
+#define strm_r %esi
+#define state_r %edi
+
+ movl strm_sp(%esp), strm_r
+ movl state_strm(strm_r), state_r
+
+ /* in = strm->next_in;
+ * out = strm->next_out;
+ * last = in + strm->avail_in - 11;
+ * beg = out - (start - strm->avail_out);
+ * end = out + (strm->avail_out - 257);
+ */
+ movl avail_in_strm(strm_r), %edx
+ movl next_in_strm(strm_r), %eax
+
+ addl %eax, %edx /* avail_in += next_in */
+ subl $11, %edx /* avail_in -= 11 */
+
+ movl %eax, in(%esp)
+ movl %edx, last(%esp)
+
+ movl start_sp(%esp), %ebp
+ movl avail_out_strm(strm_r), %ecx
+ movl next_out_strm(strm_r), %ebx
+
+ subl %ecx, %ebp /* start -= avail_out */
+ negl %ebp /* start = -start */
+ addl %ebx, %ebp /* start += next_out */
+
+ subl $257, %ecx /* avail_out -= 257 */
+ addl %ebx, %ecx /* avail_out += out */
+
+ movl %ebx, out(%esp)
+ movl %ebp, beg(%esp)
+ movl %ecx, end(%esp)
+
+ /* wsize = state->wsize;
+ * write = state->write;
+ * window = state->window;
+ * hold = state->hold;
+ * bits = state->bits;
+ * lcode = state->lencode;
+ * dcode = state->distcode;
+ * lmask = ( 1 << state->lenbits ) - 1;
+ * dmask = ( 1 << state->distbits ) - 1;
+ */
+
+ movl lencode_state(state_r), %eax
+ movl distcode_state(state_r), %ecx
+
+ movl %eax, lcode(%esp)
+ movl %ecx, dcode(%esp)
+
+ movl $1, %eax
+ movl lenbits_state(state_r), %ecx
+ shll %cl, %eax
+ decl %eax
+ movl %eax, lmask(%esp)
+
+ movl $1, %eax
+ movl distbits_state(state_r), %ecx
+ shll %cl, %eax
+ decl %eax
+ movl %eax, dmask(%esp)
+
+ movl wsize_state(state_r), %eax
+ movl write_state(state_r), %ecx
+ movl window_state(state_r), %edx
+
+ movl %eax, wsize(%esp)
+ movl %ecx, write(%esp)
+ movl %edx, window(%esp)
+
+ movl hold_state(state_r), %ebp
+ movl bits_state(state_r), %ebx
+
+#undef strm_r
+#undef state_r
+
+#define in_r %esi
+#define from_r %esi
+#define out_r %edi
+
+ movl in(%esp), in_r
+ movl last(%esp), %ecx
+ cmpl in_r, %ecx
+ ja .L_align_long /* if in < last */
+
+ addl $11, %ecx /* ecx = &in[ avail_in ] */
+ subl in_r, %ecx /* ecx = avail_in */
+ movl $12, %eax
+ subl %ecx, %eax /* eax = 12 - avail_in */
+ leal buf(%esp), %edi
+ rep movsb /* memcpy( buf, in, avail_in ) */
+ movl %eax, %ecx
+ xorl %eax, %eax
+ rep stosb /* memset( &buf[ avail_in ], 0, 12 - avail_in ) */
+ leal buf(%esp), in_r /* in = buf */
+ movl in_r, last(%esp) /* last = in, do just one iteration */
+ jmp .L_is_aligned
+
+ /* align in_r on long boundary */
+.L_align_long:
+ testl $3, in_r
+ jz .L_is_aligned
+ xorl %eax, %eax
+ movb (in_r), %al
+ incl in_r
+ movl %ebx, %ecx
+ addl $8, %ebx
+ shll %cl, %eax
+ orl %eax, %ebp
+ jmp .L_align_long
+
+.L_is_aligned:
+ movl out(%esp), out_r
+
+#if defined( NO_MMX )
+ jmp .L_do_loop
+#endif
+
+#if defined( USE_MMX )
+ jmp .L_init_mmx
+#endif
+
+/*** Runtime MMX check ***/
+
+#if defined( RUN_TIME_MMX )
+.L_check_mmx:
+ cmpl $DO_USE_MMX, inflate_fast_use_mmx
+ je .L_init_mmx
+ ja .L_do_loop /* > 2 */
+
+ pushl %eax
+ pushl %ebx
+ pushl %ecx
+ pushl %edx
+ pushf
+ movl (%esp), %eax /* copy eflags to eax */
+ xorl $0x200000, (%esp) /* try toggling ID bit of eflags (bit 21)
+ * to see if cpu supports cpuid...
+ * ID bit method not supported by NexGen but
+ * bios may load a cpuid instruction and
+ * cpuid may be disabled on Cyrix 5-6x86 */
+ popf
+ pushf
+ popl %edx /* copy new eflags to edx */
+ xorl %eax, %edx /* test if ID bit is flipped */
+ jz .L_dont_use_mmx /* not flipped if zero */
+ xorl %eax, %eax
+ cpuid
+ cmpl $0x756e6547, %ebx /* check for GenuineIntel in ebx,ecx,edx */
+ jne .L_dont_use_mmx
+ cmpl $0x6c65746e, %ecx
+ jne .L_dont_use_mmx
+ cmpl $0x49656e69, %edx
+ jne .L_dont_use_mmx
+ movl $1, %eax
+ cpuid /* get cpu features */
+ shrl $8, %eax
+ andl $15, %eax
+ cmpl $6, %eax /* check for Pentium family, is 0xf for P4 */
+ jne .L_dont_use_mmx
+ testl $0x800000, %edx /* test if MMX feature is set (bit 23) */
+ jnz .L_use_mmx
+ jmp .L_dont_use_mmx
+.L_use_mmx:
+ movl $DO_USE_MMX, inflate_fast_use_mmx
+ jmp .L_check_mmx_pop
+.L_dont_use_mmx:
+ movl $DONT_USE_MMX, inflate_fast_use_mmx
+.L_check_mmx_pop:
+ popl %edx
+ popl %ecx
+ popl %ebx
+ popl %eax
+ jmp .L_check_mmx
+#endif
+
+
+/*** Non-MMX code ***/
+
+#if defined ( NO_MMX ) || defined( RUN_TIME_MMX )
+
+#define hold_r %ebp
+#define bits_r %bl
+#define bitslong_r %ebx
+
+.align 32,0x90
+.L_while_test:
+ /* while (in < last && out < end)
+ */
+ cmpl out_r, end(%esp)
+ jbe .L_break_loop /* if (out >= end) */
+
+ cmpl in_r, last(%esp)
+ jbe .L_break_loop
+
+.L_do_loop:
+ /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out
+ *
+ * do {
+ * if (bits < 15) {
+ * hold |= *((unsigned short *)in)++ << bits;
+ * bits += 16
+ * }
+ * this = lcode[hold & lmask]
+ */
+ cmpb $15, bits_r
+ ja .L_get_length_code /* if (15 < bits) */
+
+ xorl %eax, %eax
+ lodsw /* al = *(ushort *)in++ */
+ movb bits_r, %cl /* cl = bits, needs it for shifting */
+ addb $16, bits_r /* bits += 16 */
+ shll %cl, %eax
+ orl %eax, hold_r /* hold |= *((ushort *)in)++ << bits */
+
+.L_get_length_code:
+ movl lmask(%esp), %edx /* edx = lmask */
+ movl lcode(%esp), %ecx /* ecx = lcode */
+ andl hold_r, %edx /* edx &= hold */
+ movl (%ecx,%edx,4), %eax /* eax = lcode[hold & lmask] */
+
+.L_dolen:
+ /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out
+ *
+ * dolen:
+ * bits -= this.bits;
+ * hold >>= this.bits
+ */
+ movb %ah, %cl /* cl = this.bits */
+ subb %ah, bits_r /* bits -= this.bits */
+ shrl %cl, hold_r /* hold >>= this.bits */
+
+ /* check if op is a literal
+ * if (op == 0) {
+ * PUP(out) = this.val;
+ * }
+ */
+ testb %al, %al
+ jnz .L_test_for_length_base /* if (op != 0) 45.7% */
+
+ shrl $16, %eax /* output this.val char */
+ stosb
+ jmp .L_while_test
+
+.L_test_for_length_base:
+ /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out, %edx = len
+ *
+ * else if (op & 16) {
+ * len = this.val
+ * op &= 15
+ * if (op) {
+ * if (op > bits) {
+ * hold |= *((unsigned short *)in)++ << bits;
+ * bits += 16
+ * }
+ * len += hold & mask[op];
+ * bits -= op;
+ * hold >>= op;
+ * }
+ */
+#define len_r %edx
+ movl %eax, len_r /* len = this */
+ shrl $16, len_r /* len = this.val */
+ movb %al, %cl
+
+ testb $16, %al
+ jz .L_test_for_second_level_length /* if ((op & 16) == 0) 8% */
+ andb $15, %cl /* op &= 15 */
+ jz .L_save_len /* if (!op) */
+ cmpb %cl, bits_r
+ jae .L_add_bits_to_len /* if (op <= bits) */
+
+ movb %cl, %ch /* stash op in ch, freeing cl */
+ xorl %eax, %eax
+ lodsw /* al = *(ushort *)in++ */
+ movb bits_r, %cl /* cl = bits, needs it for shifting */
+ addb $16, bits_r /* bits += 16 */
+ shll %cl, %eax
+ orl %eax, hold_r /* hold |= *((ushort *)in)++ << bits */
+ movb %ch, %cl /* move op back to ecx */
+
+.L_add_bits_to_len:
+ movl $1, %eax
+ shll %cl, %eax
+ decl %eax
+ subb %cl, bits_r
+ andl hold_r, %eax /* eax &= hold */
+ shrl %cl, hold_r
+ addl %eax, len_r /* len += hold & mask[op] */
+
+.L_save_len:
+ movl len_r, len(%esp) /* save len */
+#undef len_r
+
+.L_decode_distance:
+ /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ *
+ * if (bits < 15) {
+ * hold |= *((unsigned short *)in)++ << bits;
+ * bits += 16
+ * }
+ * this = dcode[hold & dmask];
+ * dodist:
+ * bits -= this.bits;
+ * hold >>= this.bits;
+ * op = this.op;
+ */
+
+ cmpb $15, bits_r
+ ja .L_get_distance_code /* if (15 < bits) */
+
+ xorl %eax, %eax
+ lodsw /* al = *(ushort *)in++ */
+ movb bits_r, %cl /* cl = bits, needs it for shifting */
+ addb $16, bits_r /* bits += 16 */
+ shll %cl, %eax
+ orl %eax, hold_r /* hold |= *((ushort *)in)++ << bits */
+
+.L_get_distance_code:
+ movl dmask(%esp), %edx /* edx = dmask */
+ movl dcode(%esp), %ecx /* ecx = dcode */
+ andl hold_r, %edx /* edx &= hold */
+ movl (%ecx,%edx,4), %eax /* eax = dcode[hold & dmask] */
+
+#define dist_r %edx
+.L_dodist:
+ movl %eax, dist_r /* dist = this */
+ shrl $16, dist_r /* dist = this.val */
+ movb %ah, %cl
+ subb %ah, bits_r /* bits -= this.bits */
+ shrl %cl, hold_r /* hold >>= this.bits */
+
+ /* if (op & 16) {
+ * dist = this.val
+ * op &= 15
+ * if (op > bits) {
+ * hold |= *((unsigned short *)in)++ << bits;
+ * bits += 16
+ * }
+ * dist += hold & mask[op];
+ * bits -= op;
+ * hold >>= op;
+ */
+ movb %al, %cl /* cl = this.op */
+
+ testb $16, %al /* if ((op & 16) == 0) */
+ jz .L_test_for_second_level_dist
+ andb $15, %cl /* op &= 15 */
+ jz .L_check_dist_one
+ cmpb %cl, bits_r
+ jae .L_add_bits_to_dist /* if (op <= bits) 97.6% */
+
+ movb %cl, %ch /* stash op in ch, freeing cl */
+ xorl %eax, %eax
+ lodsw /* al = *(ushort *)in++ */
+ movb bits_r, %cl /* cl = bits, needs it for shifting */
+ addb $16, bits_r /* bits += 16 */
+ shll %cl, %eax
+ orl %eax, hold_r /* hold |= *((ushort *)in)++ << bits */
+ movb %ch, %cl /* move op back to ecx */
+
+.L_add_bits_to_dist:
+ movl $1, %eax
+ shll %cl, %eax
+ decl %eax /* (1 << op) - 1 */
+ subb %cl, bits_r
+ andl hold_r, %eax /* eax &= hold */
+ shrl %cl, hold_r
+ addl %eax, dist_r /* dist += hold & ((1 << op) - 1) */
+ jmp .L_check_window
+
+.L_check_window:
+ /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ * %ecx = nbytes
+ *
+ * nbytes = out - beg;
+ * if (dist <= nbytes) {
+ * from = out - dist;
+ * do {
+ * PUP(out) = PUP(from);
+ * } while (--len > 0) {
+ * }
+ */
+
+ movl in_r, in(%esp) /* save in so from can use it's reg */
+ movl out_r, %eax
+ subl beg(%esp), %eax /* nbytes = out - beg */
+
+ cmpl dist_r, %eax
+ jb .L_clip_window /* if (dist > nbytes) 4.2% */
+
+ movl len(%esp), %ecx
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+
+ subl $3, %ecx
+ movb (from_r), %al
+ movb %al, (out_r)
+ movb 1(from_r), %al
+ movb 2(from_r), %dl
+ addl $3, from_r
+ movb %al, 1(out_r)
+ movb %dl, 2(out_r)
+ addl $3, out_r
+ rep movsb
+
+ movl in(%esp), in_r /* move in back to %esi, toss from */
+ jmp .L_while_test
+
+.align 16,0x90
+.L_check_dist_one:
+ cmpl $1, dist_r
+ jne .L_check_window
+ cmpl out_r, beg(%esp)
+ je .L_check_window
+
+ decl out_r
+ movl len(%esp), %ecx
+ movb (out_r), %al
+ subl $3, %ecx
+
+ movb %al, 1(out_r)
+ movb %al, 2(out_r)
+ movb %al, 3(out_r)
+ addl $4, out_r
+ rep stosb
+
+ jmp .L_while_test
+
+.align 16,0x90
+.L_test_for_second_level_length:
+ /* else if ((op & 64) == 0) {
+ * this = lcode[this.val + (hold & mask[op])];
+ * }
+ */
+ testb $64, %al
+ jnz .L_test_for_end_of_block /* if ((op & 64) != 0) */
+
+ movl $1, %eax
+ shll %cl, %eax
+ decl %eax
+ andl hold_r, %eax /* eax &= hold */
+ addl %edx, %eax /* eax += this.val */
+ movl lcode(%esp), %edx /* edx = lcode */
+ movl (%edx,%eax,4), %eax /* eax = lcode[val + (hold&mask[op])] */
+ jmp .L_dolen
+
+.align 16,0x90
+.L_test_for_second_level_dist:
+ /* else if ((op & 64) == 0) {
+ * this = dcode[this.val + (hold & mask[op])];
+ * }
+ */
+ testb $64, %al
+ jnz .L_invalid_distance_code /* if ((op & 64) != 0) */
+
+ movl $1, %eax
+ shll %cl, %eax
+ decl %eax
+ andl hold_r, %eax /* eax &= hold */
+ addl %edx, %eax /* eax += this.val */
+ movl dcode(%esp), %edx /* edx = dcode */
+ movl (%edx,%eax,4), %eax /* eax = dcode[val + (hold&mask[op])] */
+ jmp .L_dodist
+
+.align 16,0x90
+.L_clip_window:
+ /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ * %ecx = nbytes
+ *
+ * else {
+ * if (dist > wsize) {
+ * invalid distance
+ * }
+ * from = window;
+ * nbytes = dist - nbytes;
+ * if (write == 0) {
+ * from += wsize - nbytes;
+ */
+#define nbytes_r %ecx
+ movl %eax, nbytes_r
+ movl wsize(%esp), %eax /* prepare for dist compare */
+ negl nbytes_r /* nbytes = -nbytes */
+ movl window(%esp), from_r /* from = window */
+
+ cmpl dist_r, %eax
+ jb .L_invalid_distance_too_far /* if (dist > wsize) */
+
+ addl dist_r, nbytes_r /* nbytes = dist - nbytes */
+ cmpl $0, write(%esp)
+ jne .L_wrap_around_window /* if (write != 0) */
+
+ subl nbytes_r, %eax
+ addl %eax, from_r /* from += wsize - nbytes */
+
+ /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ * %ecx = nbytes, %eax = len
+ *
+ * if (nbytes < len) {
+ * len -= nbytes;
+ * do {
+ * PUP(out) = PUP(from);
+ * } while (--nbytes);
+ * from = out - dist;
+ * }
+ * }
+ */
+#define len_r %eax
+ movl len(%esp), len_r
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1 /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1
+
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1 /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1
+
+.L_wrap_around_window:
+ /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ * %ecx = nbytes, %eax = write, %eax = len
+ *
+ * else if (write < nbytes) {
+ * from += wsize + write - nbytes;
+ * nbytes -= write;
+ * if (nbytes < len) {
+ * len -= nbytes;
+ * do {
+ * PUP(out) = PUP(from);
+ * } while (--nbytes);
+ * from = window;
+ * nbytes = write;
+ * if (nbytes < len) {
+ * len -= nbytes;
+ * do {
+ * PUP(out) = PUP(from);
+ * } while(--nbytes);
+ * from = out - dist;
+ * }
+ * }
+ * }
+ */
+#define write_r %eax
+ movl write(%esp), write_r
+ cmpl write_r, nbytes_r
+ jbe .L_contiguous_in_window /* if (write >= nbytes) */
+
+ addl wsize(%esp), from_r
+ addl write_r, from_r
+ subl nbytes_r, from_r /* from += wsize + write - nbytes */
+ subl write_r, nbytes_r /* nbytes -= write */
+#undef write_r
+
+ movl len(%esp), len_r
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1 /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl window(%esp), from_r /* from = window */
+ movl write(%esp), nbytes_r /* nbytes = write */
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1 /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1
+
+.L_contiguous_in_window:
+ /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
+ * %ecx = nbytes, %eax = write, %eax = len
+ *
+ * else {
+ * from += write - nbytes;
+ * if (nbytes < len) {
+ * len -= nbytes;
+ * do {
+ * PUP(out) = PUP(from);
+ * } while (--nbytes);
+ * from = out - dist;
+ * }
+ * }
+ */
+#define write_r %eax
+ addl write_r, from_r
+ subl nbytes_r, from_r /* from += write - nbytes */
+#undef write_r
+
+ movl len(%esp), len_r
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1 /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+
+.L_do_copy1:
+ /* regs: %esi = from, %esi = in, %ebp = hold, %bl = bits, %edi = out
+ * %eax = len
+ *
+ * while (len > 0) {
+ * PUP(out) = PUP(from);
+ * len--;
+ * }
+ * }
+ * } while (in < last && out < end);
+ */
+#undef nbytes_r
+#define in_r %esi
+ movl len_r, %ecx
+ rep movsb
+
+ movl in(%esp), in_r /* move in back to %esi, toss from */
+ jmp .L_while_test
+
+#undef len_r
+#undef dist_r
+
+#endif /* NO_MMX || RUN_TIME_MMX */
+
+
+/*** MMX code ***/
+
+#if defined( USE_MMX ) || defined( RUN_TIME_MMX )
+
+.align 32,0x90
+.L_init_mmx:
+ emms
+
+#undef bits_r
+#undef bitslong_r
+#define bitslong_r %ebp
+#define hold_mm %mm0
+ movd %ebp, hold_mm
+ movl %ebx, bitslong_r
+
+#define used_mm %mm1
+#define dmask2_mm %mm2
+#define lmask2_mm %mm3
+#define lmask_mm %mm4
+#define dmask_mm %mm5
+#define tmp_mm %mm6
+
+ movd lmask(%esp), lmask_mm
+ movq lmask_mm, lmask2_mm
+ movd dmask(%esp), dmask_mm
+ movq dmask_mm, dmask2_mm
+ pxor used_mm, used_mm
+ movl lcode(%esp), %ebx /* ebx = lcode */
+ jmp .L_do_loop_mmx
+
+.align 32,0x90
+.L_while_test_mmx:
+ /* while (in < last && out < end)
+ */
+ cmpl out_r, end(%esp)
+ jbe .L_break_loop /* if (out >= end) */
+
+ cmpl in_r, last(%esp)
+ jbe .L_break_loop
+
+.L_do_loop_mmx:
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+
+ cmpl $32, bitslong_r
+ ja .L_get_length_code_mmx /* if (32 < bits) */
+
+ movd bitslong_r, tmp_mm
+ movd (in_r), %mm7
+ addl $4, in_r
+ psllq tmp_mm, %mm7
+ addl $32, bitslong_r
+ por %mm7, hold_mm /* hold_mm |= *((uint *)in)++ << bits */
+
+.L_get_length_code_mmx:
+ pand hold_mm, lmask_mm
+ movd lmask_mm, %eax
+ movq lmask2_mm, lmask_mm
+ movl (%ebx,%eax,4), %eax /* eax = lcode[hold & lmask] */
+
+.L_dolen_mmx:
+ movzbl %ah, %ecx /* ecx = this.bits */
+ movd %ecx, used_mm
+ subl %ecx, bitslong_r /* bits -= this.bits */
+
+ testb %al, %al
+ jnz .L_test_for_length_base_mmx /* if (op != 0) 45.7% */
+
+ shrl $16, %eax /* output this.val char */
+ stosb
+ jmp .L_while_test_mmx
+
+.L_test_for_length_base_mmx:
+#define len_r %edx
+ movl %eax, len_r /* len = this */
+ shrl $16, len_r /* len = this.val */
+
+ testb $16, %al
+ jz .L_test_for_second_level_length_mmx /* if ((op & 16) == 0) 8% */
+ andl $15, %eax /* op &= 15 */
+ jz .L_decode_distance_mmx /* if (!op) */
+
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+ movd %eax, used_mm
+ movd hold_mm, %ecx
+ subl %eax, bitslong_r
+ andl .L_mask(,%eax,4), %ecx
+ addl %ecx, len_r /* len += hold & mask[op] */
+
+.L_decode_distance_mmx:
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+
+ cmpl $32, bitslong_r
+ ja .L_get_dist_code_mmx /* if (32 < bits) */
+
+ movd bitslong_r, tmp_mm
+ movd (in_r), %mm7
+ addl $4, in_r
+ psllq tmp_mm, %mm7
+ addl $32, bitslong_r
+ por %mm7, hold_mm /* hold_mm |= *((uint *)in)++ << bits */
+
+.L_get_dist_code_mmx:
+ movl dcode(%esp), %ebx /* ebx = dcode */
+ pand hold_mm, dmask_mm
+ movd dmask_mm, %eax
+ movq dmask2_mm, dmask_mm
+ movl (%ebx,%eax,4), %eax /* eax = dcode[hold & lmask] */
+
+.L_dodist_mmx:
+#define dist_r %ebx
+ movzbl %ah, %ecx /* ecx = this.bits */
+ movl %eax, dist_r
+ shrl $16, dist_r /* dist = this.val */
+ subl %ecx, bitslong_r /* bits -= this.bits */
+ movd %ecx, used_mm
+
+ testb $16, %al /* if ((op & 16) == 0) */
+ jz .L_test_for_second_level_dist_mmx
+ andl $15, %eax /* op &= 15 */
+ jz .L_check_dist_one_mmx
+
+.L_add_bits_to_dist_mmx:
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+ movd %eax, used_mm /* save bit length of current op */
+ movd hold_mm, %ecx /* get the next bits on input stream */
+ subl %eax, bitslong_r /* bits -= op bits */
+ andl .L_mask(,%eax,4), %ecx /* ecx = hold & mask[op] */
+ addl %ecx, dist_r /* dist += hold & mask[op] */
+
+.L_check_window_mmx:
+ movl in_r, in(%esp) /* save in so from can use it's reg */
+ movl out_r, %eax
+ subl beg(%esp), %eax /* nbytes = out - beg */
+
+ cmpl dist_r, %eax
+ jb .L_clip_window_mmx /* if (dist > nbytes) 4.2% */
+
+ movl len_r, %ecx
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+
+ subl $3, %ecx
+ movb (from_r), %al
+ movb %al, (out_r)
+ movb 1(from_r), %al
+ movb 2(from_r), %dl
+ addl $3, from_r
+ movb %al, 1(out_r)
+ movb %dl, 2(out_r)
+ addl $3, out_r
+ rep movsb
+
+ movl in(%esp), in_r /* move in back to %esi, toss from */
+ movl lcode(%esp), %ebx /* move lcode back to %ebx, toss dist */
+ jmp .L_while_test_mmx
+
+.align 16,0x90
+.L_check_dist_one_mmx:
+ cmpl $1, dist_r
+ jne .L_check_window_mmx
+ cmpl out_r, beg(%esp)
+ je .L_check_window_mmx
+
+ decl out_r
+ movl len_r, %ecx
+ movb (out_r), %al
+ subl $3, %ecx
+
+ movb %al, 1(out_r)
+ movb %al, 2(out_r)
+ movb %al, 3(out_r)
+ addl $4, out_r
+ rep stosb
+
+ movl lcode(%esp), %ebx /* move lcode back to %ebx, toss dist */
+ jmp .L_while_test_mmx
+
+.align 16,0x90
+.L_test_for_second_level_length_mmx:
+ testb $64, %al
+ jnz .L_test_for_end_of_block /* if ((op & 64) != 0) */
+
+ andl $15, %eax
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+ movd hold_mm, %ecx
+ andl .L_mask(,%eax,4), %ecx
+ addl len_r, %ecx
+ movl (%ebx,%ecx,4), %eax /* eax = lcode[hold & lmask] */
+ jmp .L_dolen_mmx
+
+.align 16,0x90
+.L_test_for_second_level_dist_mmx:
+ testb $64, %al
+ jnz .L_invalid_distance_code /* if ((op & 64) != 0) */
+
+ andl $15, %eax
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+ movd hold_mm, %ecx
+ andl .L_mask(,%eax,4), %ecx
+ movl dcode(%esp), %eax /* ecx = dcode */
+ addl dist_r, %ecx
+ movl (%eax,%ecx,4), %eax /* eax = lcode[hold & lmask] */
+ jmp .L_dodist_mmx
+
+.align 16,0x90
+.L_clip_window_mmx:
+#define nbytes_r %ecx
+ movl %eax, nbytes_r
+ movl wsize(%esp), %eax /* prepare for dist compare */
+ negl nbytes_r /* nbytes = -nbytes */
+ movl window(%esp), from_r /* from = window */
+
+ cmpl dist_r, %eax
+ jb .L_invalid_distance_too_far /* if (dist > wsize) */
+
+ addl dist_r, nbytes_r /* nbytes = dist - nbytes */
+ cmpl $0, write(%esp)
+ jne .L_wrap_around_window_mmx /* if (write != 0) */
+
+ subl nbytes_r, %eax
+ addl %eax, from_r /* from += wsize - nbytes */
+
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1_mmx /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1_mmx
+
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1_mmx /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1_mmx
+
+.L_wrap_around_window_mmx:
+#define write_r %eax
+ movl write(%esp), write_r
+ cmpl write_r, nbytes_r
+ jbe .L_contiguous_in_window_mmx /* if (write >= nbytes) */
+
+ addl wsize(%esp), from_r
+ addl write_r, from_r
+ subl nbytes_r, from_r /* from += wsize + write - nbytes */
+ subl write_r, nbytes_r /* nbytes -= write */
+#undef write_r
+
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1_mmx /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl window(%esp), from_r /* from = window */
+ movl write(%esp), nbytes_r /* nbytes = write */
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1_mmx /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+ jmp .L_do_copy1_mmx
+
+.L_contiguous_in_window_mmx:
+#define write_r %eax
+ addl write_r, from_r
+ subl nbytes_r, from_r /* from += write - nbytes */
+#undef write_r
+
+ cmpl nbytes_r, len_r
+ jbe .L_do_copy1_mmx /* if (nbytes >= len) */
+
+ subl nbytes_r, len_r /* len -= nbytes */
+ rep movsb
+ movl out_r, from_r
+ subl dist_r, from_r /* from = out - dist */
+
+.L_do_copy1_mmx:
+#undef nbytes_r
+#define in_r %esi
+ movl len_r, %ecx
+ rep movsb
+
+ movl in(%esp), in_r /* move in back to %esi, toss from */
+ movl lcode(%esp), %ebx /* move lcode back to %ebx, toss dist */
+ jmp .L_while_test_mmx
+
+#undef hold_r
+#undef bitslong_r
+
+#endif /* USE_MMX || RUN_TIME_MMX */
+
+
+/*** USE_MMX, NO_MMX, and RUNTIME_MMX from here on ***/
+
+.L_invalid_distance_code:
+ /* else {
+ * strm->msg = "invalid distance code";
+ * state->mode = BAD;
+ * }
+ */
+ movl $.L_invalid_distance_code_msg, %ecx
+ movl $INFLATE_MODE_BAD, %edx
+ jmp .L_update_stream_state
+
+.L_test_for_end_of_block:
+ /* else if (op & 32) {
+ * state->mode = TYPE;
+ * break;
+ * }
+ */
+ testb $32, %al
+ jz .L_invalid_literal_length_code /* if ((op & 32) == 0) */
+
+ movl $0, %ecx
+ movl $INFLATE_MODE_TYPE, %edx
+ jmp .L_update_stream_state
+
+.L_invalid_literal_length_code:
+ /* else {
+ * strm->msg = "invalid literal/length code";
+ * state->mode = BAD;
+ * }
+ */
+ movl $.L_invalid_literal_length_code_msg, %ecx
+ movl $INFLATE_MODE_BAD, %edx
+ jmp .L_update_stream_state
+
+.L_invalid_distance_too_far:
+ /* strm->msg = "invalid distance too far back";
+ * state->mode = BAD;
+ */
+ movl in(%esp), in_r /* from_r has in's reg, put in back */
+ movl $.L_invalid_distance_too_far_msg, %ecx
+ movl $INFLATE_MODE_BAD, %edx
+ jmp .L_update_stream_state
+
+.L_update_stream_state:
+ /* set strm->msg = %ecx, strm->state->mode = %edx */
+ movl strm_sp(%esp), %eax
+ testl %ecx, %ecx /* if (msg != NULL) */
+ jz .L_skip_msg
+ movl %ecx, msg_strm(%eax) /* strm->msg = msg */
+.L_skip_msg:
+ movl state_strm(%eax), %eax /* state = strm->state */
+ movl %edx, mode_state(%eax) /* state->mode = edx (BAD | TYPE) */
+ jmp .L_break_loop
+
+.align 32,0x90
+.L_break_loop:
+
+/*
+ * Regs:
+ *
+ * bits = %ebp when mmx, and in %ebx when non-mmx
+ * hold = %hold_mm when mmx, and in %ebp when non-mmx
+ * in = %esi
+ * out = %edi
+ */
+
+#if defined( USE_MMX ) || defined( RUN_TIME_MMX )
+
+#if defined( RUN_TIME_MMX )
+
+ cmpl $DO_USE_MMX, inflate_fast_use_mmx
+ jne .L_update_next_in
+
+#endif /* RUN_TIME_MMX */
+
+ movl %ebp, %ebx
+
+.L_update_next_in:
+
+#endif
+
+#define strm_r %eax
+#define state_r %edx
+
+ /* len = bits >> 3;
+ * in -= len;
+ * bits -= len << 3;
+ * hold &= (1U << bits) - 1;
+ * state->hold = hold;
+ * state->bits = bits;
+ * strm->next_in = in;
+ * strm->next_out = out;
+ */
+ movl strm_sp(%esp), strm_r
+ movl %ebx, %ecx
+ movl state_strm(strm_r), state_r
+ shrl $3, %ecx
+ subl %ecx, in_r
+ shll $3, %ecx
+ subl %ecx, %ebx
+ movl out_r, next_out_strm(strm_r)
+ movl %ebx, bits_state(state_r)
+ movl %ebx, %ecx
+
+ leal buf(%esp), %ebx
+ cmpl %ebx, last(%esp)
+ jne .L_buf_not_used /* if buf != last */
+
+ subl %ebx, in_r /* in -= buf */
+ movl next_in_strm(strm_r), %ebx
+ movl %ebx, last(%esp) /* last = strm->next_in */
+ addl %ebx, in_r /* in += strm->next_in */
+ movl avail_in_strm(strm_r), %ebx
+ subl $11, %ebx
+ addl %ebx, last(%esp) /* last = &strm->next_in[ avail_in - 11 ] */
+
+.L_buf_not_used:
+ movl in_r, next_in_strm(strm_r)
+
+ movl $1, %ebx
+ shll %cl, %ebx
+ decl %ebx
+
+#if defined( USE_MMX ) || defined( RUN_TIME_MMX )
+
+#if defined( RUN_TIME_MMX )
+
+ cmpl $DO_USE_MMX, inflate_fast_use_mmx
+ jne .L_update_hold
+
+#endif /* RUN_TIME_MMX */
+
+ psrlq used_mm, hold_mm /* hold_mm >>= last bit length */
+ movd hold_mm, %ebp
+
+ emms
+
+.L_update_hold:
+
+#endif /* USE_MMX || RUN_TIME_MMX */
+
+ andl %ebx, %ebp
+ movl %ebp, hold_state(state_r)
+
+#define last_r %ebx
+
+ /* strm->avail_in = in < last ? 11 + (last - in) : 11 - (in - last) */
+ movl last(%esp), last_r
+ cmpl in_r, last_r
+ jbe .L_last_is_smaller /* if (in >= last) */
+
+ subl in_r, last_r /* last -= in */
+ addl $11, last_r /* last += 11 */
+ movl last_r, avail_in_strm(strm_r)
+ jmp .L_fixup_out
+.L_last_is_smaller:
+ subl last_r, in_r /* in -= last */
+ negl in_r /* in = -in */
+ addl $11, in_r /* in += 11 */
+ movl in_r, avail_in_strm(strm_r)
+
+#undef last_r
+#define end_r %ebx
+
+.L_fixup_out:
+ /* strm->avail_out = out < end ? 257 + (end - out) : 257 - (out - end)*/
+ movl end(%esp), end_r
+ cmpl out_r, end_r
+ jbe .L_end_is_smaller /* if (out >= end) */
+
+ subl out_r, end_r /* end -= out */
+ addl $257, end_r /* end += 257 */
+ movl end_r, avail_out_strm(strm_r)
+ jmp .L_done
+.L_end_is_smaller:
+ subl end_r, out_r /* out -= end */
+ negl out_r /* out = -out */
+ addl $257, out_r /* out += 257 */
+ movl out_r, avail_out_strm(strm_r)
+
+#undef end_r
+#undef strm_r
+#undef state_r
+
+.L_done:
+ addl $local_var_size, %esp
+ popf
+ popl %ebx
+ popl %ebp
+ popl %esi
+ popl %edi
+ ret
+
+#if defined( GAS_ELF )
+/* elf info */
+.type inflate_fast,@function
+.size inflate_fast,.-inflate_fast
+#endif
diff --git a/compat/zlib/contrib/iostream/test.cpp b/compat/zlib/contrib/iostream/test.cpp
new file mode 100644
index 0000000..7d265b3
--- /dev/null
+++ b/compat/zlib/contrib/iostream/test.cpp
@@ -0,0 +1,24 @@
+
+#include "zfstream.h"
+
+int main() {
+
+ // Construct a stream object with this filebuffer. Anything sent
+ // to this stream will go to standard out.
+ gzofstream os( 1, ios::out );
+
+ // This text is getting compressed and sent to stdout.
+ // To prove this, run 'test | zcat'.
+ os << "Hello, Mommy" << endl;
+
+ os << setcompressionlevel( Z_NO_COMPRESSION );
+ os << "hello, hello, hi, ho!" << endl;
+
+ setcompressionlevel( os, Z_DEFAULT_COMPRESSION )
+ << "I'm compressing again" << endl;
+
+ os.close();
+
+ return 0;
+
+}
diff --git a/compat/zlib/contrib/iostream/zfstream.cpp b/compat/zlib/contrib/iostream/zfstream.cpp
new file mode 100644
index 0000000..d0cd85f
--- /dev/null
+++ b/compat/zlib/contrib/iostream/zfstream.cpp
@@ -0,0 +1,329 @@
+
+#include "zfstream.h"
+
+gzfilebuf::gzfilebuf() :
+ file(NULL),
+ mode(0),
+ own_file_descriptor(0)
+{ }
+
+gzfilebuf::~gzfilebuf() {
+
+ sync();
+ if ( own_file_descriptor )
+ close();
+
+}
+
+gzfilebuf *gzfilebuf::open( const char *name,
+ int io_mode ) {
+
+ if ( is_open() )
+ return NULL;
+
+ char char_mode[10];
+ char *p = char_mode;
+
+ if ( io_mode & ios::in ) {
+ mode = ios::in;
+ *p++ = 'r';
+ } else if ( io_mode & ios::app ) {
+ mode = ios::app;
+ *p++ = 'a';
+ } else {
+ mode = ios::out;
+ *p++ = 'w';
+ }
+
+ if ( io_mode & ios::binary ) {
+ mode |= ios::binary;
+ *p++ = 'b';
+ }
+
+ // Hard code the compression level
+ if ( io_mode & (ios::out|ios::app )) {
+ *p++ = '9';
+ }
+
+ // Put the end-of-string indicator
+ *p = '\0';
+
+ if ( (file = gzopen(name, char_mode)) == NULL )
+ return NULL;
+
+ own_file_descriptor = 1;
+
+ return this;
+
+}
+
+gzfilebuf *gzfilebuf::attach( int file_descriptor,
+ int io_mode ) {
+
+ if ( is_open() )
+ return NULL;
+
+ char char_mode[10];
+ char *p = char_mode;
+
+ if ( io_mode & ios::in ) {
+ mode = ios::in;
+ *p++ = 'r';
+ } else if ( io_mode & ios::app ) {
+ mode = ios::app;
+ *p++ = 'a';
+ } else {
+ mode = ios::out;
+ *p++ = 'w';
+ }
+
+ if ( io_mode & ios::binary ) {
+ mode |= ios::binary;
+ *p++ = 'b';
+ }
+
+ // Hard code the compression level
+ if ( io_mode & (ios::out|ios::app )) {
+ *p++ = '9';
+ }
+
+ // Put the end-of-string indicator
+ *p = '\0';
+
+ if ( (file = gzdopen(file_descriptor, char_mode)) == NULL )
+ return NULL;
+
+ own_file_descriptor = 0;
+
+ return this;
+
+}
+
+gzfilebuf *gzfilebuf::close() {
+
+ if ( is_open() ) {
+
+ sync();
+ gzclose( file );
+ file = NULL;
+
+ }
+
+ return this;
+
+}
+
+int gzfilebuf::setcompressionlevel( int comp_level ) {
+
+ return gzsetparams(file, comp_level, -2);
+
+}
+
+int gzfilebuf::setcompressionstrategy( int comp_strategy ) {
+
+ return gzsetparams(file, -2, comp_strategy);
+
+}
+
+
+streampos gzfilebuf::seekoff( streamoff off, ios::seek_dir dir, int which ) {
+
+ return streampos(EOF);
+
+}
+
+int gzfilebuf::underflow() {
+
+ // If the file hasn't been opened for reading, error.
+ if ( !is_open() || !(mode & ios::in) )
+ return EOF;
+
+ // if a buffer doesn't exists, allocate one.
+ if ( !base() ) {
+
+ if ( (allocate()) == EOF )
+ return EOF;
+ setp(0,0);
+
+ } else {
+
+ if ( in_avail() )
+ return (unsigned char) *gptr();
+
+ if ( out_waiting() ) {
+ if ( flushbuf() == EOF )
+ return EOF;
+ }
+
+ }
+
+ // Attempt to fill the buffer.
+
+ int result = fillbuf();
+ if ( result == EOF ) {
+ // disable get area
+ setg(0,0,0);
+ return EOF;
+ }
+
+ return (unsigned char) *gptr();
+
+}
+
+int gzfilebuf::overflow( int c ) {
+
+ if ( !is_open() || !(mode & ios::out) )
+ return EOF;
+
+ if ( !base() ) {
+ if ( allocate() == EOF )
+ return EOF;
+ setg(0,0,0);
+ } else {
+ if (in_avail()) {
+ return EOF;
+ }
+ if (out_waiting()) {
+ if (flushbuf() == EOF)
+ return EOF;
+ }
+ }
+
+ int bl = blen();
+ setp( base(), base() + bl);
+
+ if ( c != EOF ) {
+
+ *pptr() = c;
+ pbump(1);
+
+ }
+
+ return 0;
+
+}
+
+int gzfilebuf::sync() {
+
+ if ( !is_open() )
+ return EOF;
+
+ if ( out_waiting() )
+ return flushbuf();
+
+ return 0;
+
+}
+
+int gzfilebuf::flushbuf() {
+
+ int n;
+ char *q;
+
+ q = pbase();
+ n = pptr() - q;
+
+ if ( gzwrite( file, q, n) < n )
+ return EOF;
+
+ setp(0,0);
+
+ return 0;
+
+}
+
+int gzfilebuf::fillbuf() {
+
+ int required;
+ char *p;
+
+ p = base();
+
+ required = blen();
+
+ int t = gzread( file, p, required );
+
+ if ( t <= 0) return EOF;
+
+ setg( base(), base(), base()+t);
+
+ return t;
+
+}
+
+gzfilestream_common::gzfilestream_common() :
+ ios( gzfilestream_common::rdbuf() )
+{ }
+
+gzfilestream_common::~gzfilestream_common()
+{ }
+
+void gzfilestream_common::attach( int fd, int io_mode ) {
+
+ if ( !buffer.attach( fd, io_mode) )
+ clear( ios::failbit | ios::badbit );
+ else
+ clear();
+
+}
+
+void gzfilestream_common::open( const char *name, int io_mode ) {
+
+ if ( !buffer.open( name, io_mode ) )
+ clear( ios::failbit | ios::badbit );
+ else
+ clear();
+
+}
+
+void gzfilestream_common::close() {
+
+ if ( !buffer.close() )
+ clear( ios::failbit | ios::badbit );
+
+}
+
+gzfilebuf *gzfilestream_common::rdbuf()
+{
+ return &buffer;
+}
+
+gzifstream::gzifstream() :
+ ios( gzfilestream_common::rdbuf() )
+{
+ clear( ios::badbit );
+}
+
+gzifstream::gzifstream( const char *name, int io_mode ) :
+ ios( gzfilestream_common::rdbuf() )
+{
+ gzfilestream_common::open( name, io_mode );
+}
+
+gzifstream::gzifstream( int fd, int io_mode ) :
+ ios( gzfilestream_common::rdbuf() )
+{
+ gzfilestream_common::attach( fd, io_mode );
+}
+
+gzifstream::~gzifstream() { }
+
+gzofstream::gzofstream() :
+ ios( gzfilestream_common::rdbuf() )
+{
+ clear( ios::badbit );
+}
+
+gzofstream::gzofstream( const char *name, int io_mode ) :
+ ios( gzfilestream_common::rdbuf() )
+{
+ gzfilestream_common::open( name, io_mode );
+}
+
+gzofstream::gzofstream( int fd, int io_mode ) :
+ ios( gzfilestream_common::rdbuf() )
+{
+ gzfilestream_common::attach( fd, io_mode );
+}
+
+gzofstream::~gzofstream() { }
diff --git a/compat/zlib/contrib/iostream/zfstream.h b/compat/zlib/contrib/iostream/zfstream.h
new file mode 100644
index 0000000..ed79098
--- /dev/null
+++ b/compat/zlib/contrib/iostream/zfstream.h
@@ -0,0 +1,128 @@
+
+#ifndef zfstream_h
+#define zfstream_h
+
+#include <fstream.h>
+#include "zlib.h"
+
+class gzfilebuf : public streambuf {
+
+public:
+
+ gzfilebuf( );
+ virtual ~gzfilebuf();
+
+ gzfilebuf *open( const char *name, int io_mode );
+ gzfilebuf *attach( int file_descriptor, int io_mode );
+ gzfilebuf *close();
+
+ int setcompressionlevel( int comp_level );
+ int setcompressionstrategy( int comp_strategy );
+
+ inline int is_open() const { return (file !=NULL); }
+
+ virtual streampos seekoff( streamoff, ios::seek_dir, int );
+
+ virtual int sync();
+
+protected:
+
+ virtual int underflow();
+ virtual int overflow( int = EOF );
+
+private:
+
+ gzFile file;
+ short mode;
+ short own_file_descriptor;
+
+ int flushbuf();
+ int fillbuf();
+
+};
+
+class gzfilestream_common : virtual public ios {
+
+ friend class gzifstream;
+ friend class gzofstream;
+ friend gzofstream &setcompressionlevel( gzofstream &, int );
+ friend gzofstream &setcompressionstrategy( gzofstream &, int );
+
+public:
+ virtual ~gzfilestream_common();
+
+ void attach( int fd, int io_mode );
+ void open( const char *name, int io_mode );
+ void close();
+
+protected:
+ gzfilestream_common();
+
+private:
+ gzfilebuf *rdbuf();
+
+ gzfilebuf buffer;
+
+};
+
+class gzifstream : public gzfilestream_common, public istream {
+
+public:
+
+ gzifstream();
+ gzifstream( const char *name, int io_mode = ios::in );
+ gzifstream( int fd, int io_mode = ios::in );
+
+ virtual ~gzifstream();
+
+};
+
+class gzofstream : public gzfilestream_common, public ostream {
+
+public:
+
+ gzofstream();
+ gzofstream( const char *name, int io_mode = ios::out );
+ gzofstream( int fd, int io_mode = ios::out );
+
+ virtual ~gzofstream();
+
+};
+
+template<class T> class gzomanip {
+ friend gzofstream &operator<<(gzofstream &, const gzomanip<T> &);
+public:
+ gzomanip(gzofstream &(*f)(gzofstream &, T), T v) : func(f), val(v) { }
+private:
+ gzofstream &(*func)(gzofstream &, T);
+ T val;
+};
+
+template<class T> gzofstream &operator<<(gzofstream &s, const gzomanip<T> &m)
+{
+ return (*m.func)(s, m.val);
+}
+
+inline gzofstream &setcompressionlevel( gzofstream &s, int l )
+{
+ (s.rdbuf())->setcompressionlevel(l);
+ return s;
+}
+
+inline gzofstream &setcompressionstrategy( gzofstream &s, int l )
+{
+ (s.rdbuf())->setcompressionstrategy(l);
+ return s;
+}
+
+inline gzomanip<int> setcompressionlevel(int l)
+{
+ return gzomanip<int>(&setcompressionlevel,l);
+}
+
+inline gzomanip<int> setcompressionstrategy(int l)
+{
+ return gzomanip<int>(&setcompressionstrategy,l);
+}
+
+#endif
diff --git a/compat/zlib/contrib/iostream2/zstream.h b/compat/zlib/contrib/iostream2/zstream.h
new file mode 100644
index 0000000..43d2332
--- /dev/null
+++ b/compat/zlib/contrib/iostream2/zstream.h
@@ -0,0 +1,307 @@
+/*
+ *
+ * Copyright (c) 1997
+ * Christian Michelsen Research AS
+ * Advanced Computing
+ * Fantoftvegen 38, 5036 BERGEN, Norway
+ * http://www.cmr.no
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Christian Michelsen Research AS makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef ZSTREAM__H
+#define ZSTREAM__H
+
+/*
+ * zstream.h - C++ interface to the 'zlib' general purpose compression library
+ * $Id: zstream.h 1.1 1997-06-25 12:00:56+02 tyge Exp tyge $
+ */
+
+#include <strstream.h>
+#include <string.h>
+#include <stdio.h>
+#include "zlib.h"
+
+#if defined(_WIN32)
+# include <fcntl.h>
+# include <io.h>
+# define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
+#else
+# define SET_BINARY_MODE(file)
+#endif
+
+class zstringlen {
+public:
+ zstringlen(class izstream&);
+ zstringlen(class ozstream&, const char*);
+ size_t value() const { return val.word; }
+private:
+ struct Val { unsigned char byte; size_t word; } val;
+};
+
+// ----------------------------- izstream -----------------------------
+
+class izstream
+{
+ public:
+ izstream() : m_fp(0) {}
+ izstream(FILE* fp) : m_fp(0) { open(fp); }
+ izstream(const char* name) : m_fp(0) { open(name); }
+ ~izstream() { close(); }
+
+ /* Opens a gzip (.gz) file for reading.
+ * open() can be used to read a file which is not in gzip format;
+ * in this case read() will directly read from the file without
+ * decompression. errno can be checked to distinguish two error
+ * cases (if errno is zero, the zlib error is Z_MEM_ERROR).
+ */
+ void open(const char* name) {
+ if (m_fp) close();
+ m_fp = ::gzopen(name, "rb");
+ }
+
+ void open(FILE* fp) {
+ SET_BINARY_MODE(fp);
+ if (m_fp) close();
+ m_fp = ::gzdopen(fileno(fp), "rb");
+ }
+
+ /* Flushes all pending input if necessary, closes the compressed file
+ * and deallocates all the (de)compression state. The return value is
+ * the zlib error number (see function error() below).
+ */
+ int close() {
+ int r = ::gzclose(m_fp);
+ m_fp = 0; return r;
+ }
+
+ /* Binary read the given number of bytes from the compressed file.
+ */
+ int read(void* buf, size_t len) {
+ return ::gzread(m_fp, buf, len);
+ }
+
+ /* Returns the error message for the last error which occurred on the
+ * given compressed file. errnum is set to zlib error number. If an
+ * error occurred in the file system and not in the compression library,
+ * errnum is set to Z_ERRNO and the application may consult errno
+ * to get the exact error code.
+ */
+ const char* error(int* errnum) {
+ return ::gzerror(m_fp, errnum);
+ }
+
+ gzFile fp() { return m_fp; }
+
+ private:
+ gzFile m_fp;
+};
+
+/*
+ * Binary read the given (array of) object(s) from the compressed file.
+ * If the input file was not in gzip format, read() copies the objects number
+ * of bytes into the buffer.
+ * returns the number of uncompressed bytes actually read
+ * (0 for end of file, -1 for error).
+ */
+template <class T, class Items>
+inline int read(izstream& zs, T* x, Items items) {
+ return ::gzread(zs.fp(), x, items*sizeof(T));
+}
+
+/*
+ * Binary input with the '>' operator.
+ */
+template <class T>
+inline izstream& operator>(izstream& zs, T& x) {
+ ::gzread(zs.fp(), &x, sizeof(T));
+ return zs;
+}
+
+
+inline zstringlen::zstringlen(izstream& zs) {
+ zs > val.byte;
+ if (val.byte == 255) zs > val.word;
+ else val.word = val.byte;
+}
+
+/*
+ * Read length of string + the string with the '>' operator.
+ */
+inline izstream& operator>(izstream& zs, char* x) {
+ zstringlen len(zs);
+ ::gzread(zs.fp(), x, len.value());
+ x[len.value()] = '\0';
+ return zs;
+}
+
+inline char* read_string(izstream& zs) {
+ zstringlen len(zs);
+ char* x = new char[len.value()+1];
+ ::gzread(zs.fp(), x, len.value());
+ x[len.value()] = '\0';
+ return x;
+}
+
+// ----------------------------- ozstream -----------------------------
+
+class ozstream
+{
+ public:
+ ozstream() : m_fp(0), m_os(0) {
+ }
+ ozstream(FILE* fp, int level = Z_DEFAULT_COMPRESSION)
+ : m_fp(0), m_os(0) {
+ open(fp, level);
+ }
+ ozstream(const char* name, int level = Z_DEFAULT_COMPRESSION)
+ : m_fp(0), m_os(0) {
+ open(name, level);
+ }
+ ~ozstream() {
+ close();
+ }
+
+ /* Opens a gzip (.gz) file for writing.
+ * The compression level parameter should be in 0..9
+ * errno can be checked to distinguish two error cases
+ * (if errno is zero, the zlib error is Z_MEM_ERROR).
+ */
+ void open(const char* name, int level = Z_DEFAULT_COMPRESSION) {
+ char mode[4] = "wb\0";
+ if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level;
+ if (m_fp) close();
+ m_fp = ::gzopen(name, mode);
+ }
+
+ /* open from a FILE pointer.
+ */
+ void open(FILE* fp, int level = Z_DEFAULT_COMPRESSION) {
+ SET_BINARY_MODE(fp);
+ char mode[4] = "wb\0";
+ if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level;
+ if (m_fp) close();
+ m_fp = ::gzdopen(fileno(fp), mode);
+ }
+
+ /* Flushes all pending output if necessary, closes the compressed file
+ * and deallocates all the (de)compression state. The return value is
+ * the zlib error number (see function error() below).
+ */
+ int close() {
+ if (m_os) {
+ ::gzwrite(m_fp, m_os->str(), m_os->pcount());
+ delete[] m_os->str(); delete m_os; m_os = 0;
+ }
+ int r = ::gzclose(m_fp); m_fp = 0; return r;
+ }
+
+ /* Binary write the given number of bytes into the compressed file.
+ */
+ int write(const void* buf, size_t len) {
+ return ::gzwrite(m_fp, (voidp) buf, len);
+ }
+
+ /* Flushes all pending output into the compressed file. The parameter
+ * _flush is as in the deflate() function. The return value is the zlib
+ * error number (see function gzerror below). flush() returns Z_OK if
+ * the flush_ parameter is Z_FINISH and all output could be flushed.
+ * flush() should be called only when strictly necessary because it can
+ * degrade compression.
+ */
+ int flush(int _flush) {
+ os_flush();
+ return ::gzflush(m_fp, _flush);
+ }
+
+ /* Returns the error message for the last error which occurred on the
+ * given compressed file. errnum is set to zlib error number. If an
+ * error occurred in the file system and not in the compression library,
+ * errnum is set to Z_ERRNO and the application may consult errno
+ * to get the exact error code.
+ */
+ const char* error(int* errnum) {
+ return ::gzerror(m_fp, errnum);
+ }
+
+ gzFile fp() { return m_fp; }
+
+ ostream& os() {
+ if (m_os == 0) m_os = new ostrstream;
+ return *m_os;
+ }
+
+ void os_flush() {
+ if (m_os && m_os->pcount()>0) {
+ ostrstream* oss = new ostrstream;
+ oss->fill(m_os->fill());
+ oss->flags(m_os->flags());
+ oss->precision(m_os->precision());
+ oss->width(m_os->width());
+ ::gzwrite(m_fp, m_os->str(), m_os->pcount());
+ delete[] m_os->str(); delete m_os; m_os = oss;
+ }
+ }
+
+ private:
+ gzFile m_fp;
+ ostrstream* m_os;
+};
+
+/*
+ * Binary write the given (array of) object(s) into the compressed file.
+ * returns the number of uncompressed bytes actually written
+ * (0 in case of error).
+ */
+template <class T, class Items>
+inline int write(ozstream& zs, const T* x, Items items) {
+ return ::gzwrite(zs.fp(), (voidp) x, items*sizeof(T));
+}
+
+/*
+ * Binary output with the '<' operator.
+ */
+template <class T>
+inline ozstream& operator<(ozstream& zs, const T& x) {
+ ::gzwrite(zs.fp(), (voidp) &x, sizeof(T));
+ return zs;
+}
+
+inline zstringlen::zstringlen(ozstream& zs, const char* x) {
+ val.byte = 255; val.word = ::strlen(x);
+ if (val.word < 255) zs < (val.byte = val.word);
+ else zs < val;
+}
+
+/*
+ * Write length of string + the string with the '<' operator.
+ */
+inline ozstream& operator<(ozstream& zs, const char* x) {
+ zstringlen len(zs, x);
+ ::gzwrite(zs.fp(), (voidp) x, len.value());
+ return zs;
+}
+
+#ifdef _MSC_VER
+inline ozstream& operator<(ozstream& zs, char* const& x) {
+ return zs < (const char*) x;
+}
+#endif
+
+/*
+ * Ascii write with the << operator;
+ */
+template <class T>
+inline ostream& operator<<(ozstream& zs, const T& x) {
+ zs.os_flush();
+ return zs.os() << x;
+}
+
+#endif
diff --git a/compat/zlib/contrib/iostream2/zstream_test.cpp b/compat/zlib/contrib/iostream2/zstream_test.cpp
new file mode 100644
index 0000000..6273f62
--- /dev/null
+++ b/compat/zlib/contrib/iostream2/zstream_test.cpp
@@ -0,0 +1,25 @@
+#include "zstream.h"
+#include <math.h>
+#include <stdlib.h>
+#include <iomanip.h>
+
+void main() {
+ char h[256] = "Hello";
+ char* g = "Goodbye";
+ ozstream out("temp.gz");
+ out < "This works well" < h < g;
+ out.close();
+
+ izstream in("temp.gz"); // read it back
+ char *x = read_string(in), *y = new char[256], z[256];
+ in > y > z;
+ in.close();
+ cout << x << endl << y << endl << z << endl;
+
+ out.open("temp.gz"); // try ascii output; zcat temp.gz to see the results
+ out << setw(50) << setfill('#') << setprecision(20) << x << endl << y << endl << z << endl;
+ out << z << endl << y << endl << x << endl;
+ out << 1.1234567890123456789 << endl;
+
+ delete[] x; delete[] y;
+}
diff --git a/compat/zlib/contrib/iostream3/README b/compat/zlib/contrib/iostream3/README
new file mode 100644
index 0000000..f7b319a
--- /dev/null
+++ b/compat/zlib/contrib/iostream3/README
@@ -0,0 +1,35 @@
+These classes provide a C++ stream interface to the zlib library. It allows you
+to do things like:
+
+ gzofstream outf("blah.gz");
+ outf << "These go into the gzip file " << 123 << endl;
+
+It does this by deriving a specialized stream buffer for gzipped files, which is
+the way Stroustrup would have done it. :->
+
+The gzifstream and gzofstream classes were originally written by Kevin Ruland
+and made available in the zlib contrib/iostream directory. The older version still
+compiles under gcc 2.xx, but not under gcc 3.xx, which sparked the development of
+this version.
+
+The new classes are as standard-compliant as possible, closely following the
+approach of the standard library's fstream classes. It compiles under gcc versions
+3.2 and 3.3, but not under gcc 2.xx. This is mainly due to changes in the standard
+library naming scheme. The new version of gzifstream/gzofstream/gzfilebuf differs
+from the previous one in the following respects:
+- added showmanyc
+- added setbuf, with support for unbuffered output via setbuf(0,0)
+- a few bug fixes of stream behavior
+- gzipped output file opened with default compression level instead of maximum level
+- setcompressionlevel()/strategy() members replaced by single setcompression()
+
+The code is provided "as is", with the permission to use, copy, modify, distribute
+and sell it for any purpose without fee.
+
+Ludwig Schwardt
+<schwardt@sun.ac.za>
+
+DSP Lab
+Electrical & Electronic Engineering Department
+University of Stellenbosch
+South Africa
diff --git a/compat/zlib/contrib/iostream3/TODO b/compat/zlib/contrib/iostream3/TODO
new file mode 100644
index 0000000..7032f97
--- /dev/null
+++ b/compat/zlib/contrib/iostream3/TODO
@@ -0,0 +1,17 @@
+Possible upgrades to gzfilebuf:
+
+- The ability to do putback (e.g. putbackfail)
+
+- The ability to seek (zlib supports this, but could be slow/tricky)
+
+- Simultaneous read/write access (does it make sense?)
+
+- Support for ios_base::ate open mode
+
+- Locale support?
+
+- Check public interface to see which calls give problems
+ (due to dependence on library internals)
+
+- Override operator<<(ostream&, gzfilebuf*) to allow direct copying
+ of stream buffer to stream ( i.e. os << is.rdbuf(); )
diff --git a/compat/zlib/contrib/iostream3/test.cc b/compat/zlib/contrib/iostream3/test.cc
new file mode 100644
index 0000000..9423533
--- /dev/null
+++ b/compat/zlib/contrib/iostream3/test.cc
@@ -0,0 +1,50 @@
+/*
+ * Test program for gzifstream and gzofstream
+ *
+ * by Ludwig Schwardt <schwardt@sun.ac.za>
+ * original version by Kevin Ruland <kevin@rodin.wustl.edu>
+ */
+
+#include "zfstream.h"
+#include <iostream> // for cout
+
+int main() {
+
+ gzofstream outf;
+ gzifstream inf;
+ char buf[80];
+
+ outf.open("test1.txt.gz");
+ outf << "The quick brown fox sidestepped the lazy canine\n"
+ << 1.3 << "\nPlan " << 9 << std::endl;
+ outf.close();
+ std::cout << "Wrote the following message to 'test1.txt.gz' (check with zcat or zless):\n"
+ << "The quick brown fox sidestepped the lazy canine\n"
+ << 1.3 << "\nPlan " << 9 << std::endl;
+
+ std::cout << "\nReading 'test1.txt.gz' (buffered) produces:\n";
+ inf.open("test1.txt.gz");
+ while (inf.getline(buf,80,'\n')) {
+ std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n";
+ }
+ inf.close();
+
+ outf.rdbuf()->pubsetbuf(0,0);
+ outf.open("test2.txt.gz");
+ outf << setcompression(Z_NO_COMPRESSION)
+ << "The quick brown fox sidestepped the lazy canine\n"
+ << 1.3 << "\nPlan " << 9 << std::endl;
+ outf.close();
+ std::cout << "\nWrote the same message to 'test2.txt.gz' in uncompressed form";
+
+ std::cout << "\nReading 'test2.txt.gz' (unbuffered) produces:\n";
+ inf.rdbuf()->pubsetbuf(0,0);
+ inf.open("test2.txt.gz");
+ while (inf.getline(buf,80,'\n')) {
+ std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n";
+ }
+ inf.close();
+
+ return 0;
+
+}
diff --git a/compat/zlib/contrib/iostream3/zfstream.cc b/compat/zlib/contrib/iostream3/zfstream.cc
new file mode 100644
index 0000000..94eb933
--- /dev/null
+++ b/compat/zlib/contrib/iostream3/zfstream.cc
@@ -0,0 +1,479 @@
+/*
+ * A C++ I/O streams interface to the zlib gz* functions
+ *
+ * by Ludwig Schwardt <schwardt@sun.ac.za>
+ * original version by Kevin Ruland <kevin@rodin.wustl.edu>
+ *
+ * This version is standard-compliant and compatible with gcc 3.x.
+ */
+
+#include "zfstream.h"
+#include <cstring> // for strcpy, strcat, strlen (mode strings)
+#include <cstdio> // for BUFSIZ
+
+// Internal buffer sizes (default and "unbuffered" versions)
+#define BIGBUFSIZE BUFSIZ
+#define SMALLBUFSIZE 1
+
+/*****************************************************************************/
+
+// Default constructor
+gzfilebuf::gzfilebuf()
+: file(NULL), io_mode(std::ios_base::openmode(0)), own_fd(false),
+ buffer(NULL), buffer_size(BIGBUFSIZE), own_buffer(true)
+{
+ // No buffers to start with
+ this->disable_buffer();
+}
+
+// Destructor
+gzfilebuf::~gzfilebuf()
+{
+ // Sync output buffer and close only if responsible for file
+ // (i.e. attached streams should be left open at this stage)
+ this->sync();
+ if (own_fd)
+ this->close();
+ // Make sure internal buffer is deallocated
+ this->disable_buffer();
+}
+
+// Set compression level and strategy
+int
+gzfilebuf::setcompression(int comp_level,
+ int comp_strategy)
+{
+ return gzsetparams(file, comp_level, comp_strategy);
+}
+
+// Open gzipped file
+gzfilebuf*
+gzfilebuf::open(const char *name,
+ std::ios_base::openmode mode)
+{
+ // Fail if file already open
+ if (this->is_open())
+ return NULL;
+ // Don't support simultaneous read/write access (yet)
+ if ((mode & std::ios_base::in) && (mode & std::ios_base::out))
+ return NULL;
+
+ // Build mode string for gzopen and check it [27.8.1.3.2]
+ char char_mode[6] = "\0\0\0\0\0";
+ if (!this->open_mode(mode, char_mode))
+ return NULL;
+
+ // Attempt to open file
+ if ((file = gzopen(name, char_mode)) == NULL)
+ return NULL;
+
+ // On success, allocate internal buffer and set flags
+ this->enable_buffer();
+ io_mode = mode;
+ own_fd = true;
+ return this;
+}
+
+// Attach to gzipped file
+gzfilebuf*
+gzfilebuf::attach(int fd,
+ std::ios_base::openmode mode)
+{
+ // Fail if file already open
+ if (this->is_open())
+ return NULL;
+ // Don't support simultaneous read/write access (yet)
+ if ((mode & std::ios_base::in) && (mode & std::ios_base::out))
+ return NULL;
+
+ // Build mode string for gzdopen and check it [27.8.1.3.2]
+ char char_mode[6] = "\0\0\0\0\0";
+ if (!this->open_mode(mode, char_mode))
+ return NULL;
+
+ // Attempt to attach to file
+ if ((file = gzdopen(fd, char_mode)) == NULL)
+ return NULL;
+
+ // On success, allocate internal buffer and set flags
+ this->enable_buffer();
+ io_mode = mode;
+ own_fd = false;
+ return this;
+}
+
+// Close gzipped file
+gzfilebuf*
+gzfilebuf::close()
+{
+ // Fail immediately if no file is open
+ if (!this->is_open())
+ return NULL;
+ // Assume success
+ gzfilebuf* retval = this;
+ // Attempt to sync and close gzipped file
+ if (this->sync() == -1)
+ retval = NULL;
+ if (gzclose(file) < 0)
+ retval = NULL;
+ // File is now gone anyway (postcondition [27.8.1.3.8])
+ file = NULL;
+ own_fd = false;
+ // Destroy internal buffer if it exists
+ this->disable_buffer();
+ return retval;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+// Convert int open mode to mode string
+bool
+gzfilebuf::open_mode(std::ios_base::openmode mode,
+ char* c_mode) const
+{
+ bool testb = mode & std::ios_base::binary;
+ bool testi = mode & std::ios_base::in;
+ bool testo = mode & std::ios_base::out;
+ bool testt = mode & std::ios_base::trunc;
+ bool testa = mode & std::ios_base::app;
+
+ // Check for valid flag combinations - see [27.8.1.3.2] (Table 92)
+ // Original zfstream hardcoded the compression level to maximum here...
+ // Double the time for less than 1% size improvement seems
+ // excessive though - keeping it at the default level
+ // To change back, just append "9" to the next three mode strings
+ if (!testi && testo && !testt && !testa)
+ strcpy(c_mode, "w");
+ if (!testi && testo && !testt && testa)
+ strcpy(c_mode, "a");
+ if (!testi && testo && testt && !testa)
+ strcpy(c_mode, "w");
+ if (testi && !testo && !testt && !testa)
+ strcpy(c_mode, "r");
+ // No read/write mode yet
+// if (testi && testo && !testt && !testa)
+// strcpy(c_mode, "r+");
+// if (testi && testo && testt && !testa)
+// strcpy(c_mode, "w+");
+
+ // Mode string should be empty for invalid combination of flags
+ if (strlen(c_mode) == 0)
+ return false;
+ if (testb)
+ strcat(c_mode, "b");
+ return true;
+}
+
+// Determine number of characters in internal get buffer
+std::streamsize
+gzfilebuf::showmanyc()
+{
+ // Calls to underflow will fail if file not opened for reading
+ if (!this->is_open() || !(io_mode & std::ios_base::in))
+ return -1;
+ // Make sure get area is in use
+ if (this->gptr() && (this->gptr() < this->egptr()))
+ return std::streamsize(this->egptr() - this->gptr());
+ else
+ return 0;
+}
+
+// Fill get area from gzipped file
+gzfilebuf::int_type
+gzfilebuf::underflow()
+{
+ // If something is left in the get area by chance, return it
+ // (this shouldn't normally happen, as underflow is only supposed
+ // to be called when gptr >= egptr, but it serves as error check)
+ if (this->gptr() && (this->gptr() < this->egptr()))
+ return traits_type::to_int_type(*(this->gptr()));
+
+ // If the file hasn't been opened for reading, produce error
+ if (!this->is_open() || !(io_mode & std::ios_base::in))
+ return traits_type::eof();
+
+ // Attempt to fill internal buffer from gzipped file
+ // (buffer must be guaranteed to exist...)
+ int bytes_read = gzread(file, buffer, buffer_size);
+ // Indicates error or EOF
+ if (bytes_read <= 0)
+ {
+ // Reset get area
+ this->setg(buffer, buffer, buffer);
+ return traits_type::eof();
+ }
+ // Make all bytes read from file available as get area
+ this->setg(buffer, buffer, buffer + bytes_read);
+
+ // Return next character in get area
+ return traits_type::to_int_type(*(this->gptr()));
+}
+
+// Write put area to gzipped file
+gzfilebuf::int_type
+gzfilebuf::overflow(int_type c)
+{
+ // Determine whether put area is in use
+ if (this->pbase())
+ {
+ // Double-check pointer range
+ if (this->pptr() > this->epptr() || this->pptr() < this->pbase())
+ return traits_type::eof();
+ // Add extra character to buffer if not EOF
+ if (!traits_type::eq_int_type(c, traits_type::eof()))
+ {
+ *(this->pptr()) = traits_type::to_char_type(c);
+ this->pbump(1);
+ }
+ // Number of characters to write to file
+ int bytes_to_write = this->pptr() - this->pbase();
+ // Overflow doesn't fail if nothing is to be written
+ if (bytes_to_write > 0)
+ {
+ // If the file hasn't been opened for writing, produce error
+ if (!this->is_open() || !(io_mode & std::ios_base::out))
+ return traits_type::eof();
+ // If gzipped file won't accept all bytes written to it, fail
+ if (gzwrite(file, this->pbase(), bytes_to_write) != bytes_to_write)
+ return traits_type::eof();
+ // Reset next pointer to point to pbase on success
+ this->pbump(-bytes_to_write);
+ }
+ }
+ // Write extra character to file if not EOF
+ else if (!traits_type::eq_int_type(c, traits_type::eof()))
+ {
+ // If the file hasn't been opened for writing, produce error
+ if (!this->is_open() || !(io_mode & std::ios_base::out))
+ return traits_type::eof();
+ // Impromptu char buffer (allows "unbuffered" output)
+ char_type last_char = traits_type::to_char_type(c);
+ // If gzipped file won't accept this character, fail
+ if (gzwrite(file, &last_char, 1) != 1)
+ return traits_type::eof();
+ }
+
+ // If you got here, you have succeeded (even if c was EOF)
+ // The return value should therefore be non-EOF
+ if (traits_type::eq_int_type(c, traits_type::eof()))
+ return traits_type::not_eof(c);
+ else
+ return c;
+}
+
+// Assign new buffer
+std::streambuf*
+gzfilebuf::setbuf(char_type* p,
+ std::streamsize n)
+{
+ // First make sure stuff is sync'ed, for safety
+ if (this->sync() == -1)
+ return NULL;
+ // If buffering is turned off on purpose via setbuf(0,0), still allocate one...
+ // "Unbuffered" only really refers to put [27.8.1.4.10], while get needs at
+ // least a buffer of size 1 (very inefficient though, therefore make it bigger?)
+ // This follows from [27.5.2.4.3]/12 (gptr needs to point at something, it seems)
+ if (!p || !n)
+ {
+ // Replace existing buffer (if any) with small internal buffer
+ this->disable_buffer();
+ buffer = NULL;
+ buffer_size = 0;
+ own_buffer = true;
+ this->enable_buffer();
+ }
+ else
+ {
+ // Replace existing buffer (if any) with external buffer
+ this->disable_buffer();
+ buffer = p;
+ buffer_size = n;
+ own_buffer = false;
+ this->enable_buffer();
+ }
+ return this;
+}
+
+// Write put area to gzipped file (i.e. ensures that put area is empty)
+int
+gzfilebuf::sync()
+{
+ return traits_type::eq_int_type(this->overflow(), traits_type::eof()) ? -1 : 0;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+// Allocate internal buffer
+void
+gzfilebuf::enable_buffer()
+{
+ // If internal buffer required, allocate one
+ if (own_buffer && !buffer)
+ {
+ // Check for buffered vs. "unbuffered"
+ if (buffer_size > 0)
+ {
+ // Allocate internal buffer
+ buffer = new char_type[buffer_size];
+ // Get area starts empty and will be expanded by underflow as need arises
+ this->setg(buffer, buffer, buffer);
+ // Setup entire internal buffer as put area.
+ // The one-past-end pointer actually points to the last element of the buffer,
+ // so that overflow(c) can safely add the extra character c to the sequence.
+ // These pointers remain in place for the duration of the buffer
+ this->setp(buffer, buffer + buffer_size - 1);
+ }
+ else
+ {
+ // Even in "unbuffered" case, (small?) get buffer is still required
+ buffer_size = SMALLBUFSIZE;
+ buffer = new char_type[buffer_size];
+ this->setg(buffer, buffer, buffer);
+ // "Unbuffered" means no put buffer
+ this->setp(0, 0);
+ }
+ }
+ else
+ {
+ // If buffer already allocated, reset buffer pointers just to make sure no
+ // stale chars are lying around
+ this->setg(buffer, buffer, buffer);
+ this->setp(buffer, buffer + buffer_size - 1);
+ }
+}
+
+// Destroy internal buffer
+void
+gzfilebuf::disable_buffer()
+{
+ // If internal buffer exists, deallocate it
+ if (own_buffer && buffer)
+ {
+ // Preserve unbuffered status by zeroing size
+ if (!this->pbase())
+ buffer_size = 0;
+ delete[] buffer;
+ buffer = NULL;
+ this->setg(0, 0, 0);
+ this->setp(0, 0);
+ }
+ else
+ {
+ // Reset buffer pointers to initial state if external buffer exists
+ this->setg(buffer, buffer, buffer);
+ if (buffer)
+ this->setp(buffer, buffer + buffer_size - 1);
+ else
+ this->setp(0, 0);
+ }
+}
+
+/*****************************************************************************/
+
+// Default constructor initializes stream buffer
+gzifstream::gzifstream()
+: std::istream(NULL), sb()
+{ this->init(&sb); }
+
+// Initialize stream buffer and open file
+gzifstream::gzifstream(const char* name,
+ std::ios_base::openmode mode)
+: std::istream(NULL), sb()
+{
+ this->init(&sb);
+ this->open(name, mode);
+}
+
+// Initialize stream buffer and attach to file
+gzifstream::gzifstream(int fd,
+ std::ios_base::openmode mode)
+: std::istream(NULL), sb()
+{
+ this->init(&sb);
+ this->attach(fd, mode);
+}
+
+// Open file and go into fail() state if unsuccessful
+void
+gzifstream::open(const char* name,
+ std::ios_base::openmode mode)
+{
+ if (!sb.open(name, mode | std::ios_base::in))
+ this->setstate(std::ios_base::failbit);
+ else
+ this->clear();
+}
+
+// Attach to file and go into fail() state if unsuccessful
+void
+gzifstream::attach(int fd,
+ std::ios_base::openmode mode)
+{
+ if (!sb.attach(fd, mode | std::ios_base::in))
+ this->setstate(std::ios_base::failbit);
+ else
+ this->clear();
+}
+
+// Close file
+void
+gzifstream::close()
+{
+ if (!sb.close())
+ this->setstate(std::ios_base::failbit);
+}
+
+/*****************************************************************************/
+
+// Default constructor initializes stream buffer
+gzofstream::gzofstream()
+: std::ostream(NULL), sb()
+{ this->init(&sb); }
+
+// Initialize stream buffer and open file
+gzofstream::gzofstream(const char* name,
+ std::ios_base::openmode mode)
+: std::ostream(NULL), sb()
+{
+ this->init(&sb);
+ this->open(name, mode);
+}
+
+// Initialize stream buffer and attach to file
+gzofstream::gzofstream(int fd,
+ std::ios_base::openmode mode)
+: std::ostream(NULL), sb()
+{
+ this->init(&sb);
+ this->attach(fd, mode);
+}
+
+// Open file and go into fail() state if unsuccessful
+void
+gzofstream::open(const char* name,
+ std::ios_base::openmode mode)
+{
+ if (!sb.open(name, mode | std::ios_base::out))
+ this->setstate(std::ios_base::failbit);
+ else
+ this->clear();
+}
+
+// Attach to file and go into fail() state if unsuccessful
+void
+gzofstream::attach(int fd,
+ std::ios_base::openmode mode)
+{
+ if (!sb.attach(fd, mode | std::ios_base::out))
+ this->setstate(std::ios_base::failbit);
+ else
+ this->clear();
+}
+
+// Close file
+void
+gzofstream::close()
+{
+ if (!sb.close())
+ this->setstate(std::ios_base::failbit);
+}
diff --git a/compat/zlib/contrib/iostream3/zfstream.h b/compat/zlib/contrib/iostream3/zfstream.h
new file mode 100644
index 0000000..8574479
--- /dev/null
+++ b/compat/zlib/contrib/iostream3/zfstream.h
@@ -0,0 +1,466 @@
+/*
+ * A C++ I/O streams interface to the zlib gz* functions
+ *
+ * by Ludwig Schwardt <schwardt@sun.ac.za>
+ * original version by Kevin Ruland <kevin@rodin.wustl.edu>
+ *
+ * This version is standard-compliant and compatible with gcc 3.x.
+ */
+
+#ifndef ZFSTREAM_H
+#define ZFSTREAM_H
+
+#include <istream> // not iostream, since we don't need cin/cout
+#include <ostream>
+#include "zlib.h"
+
+/*****************************************************************************/
+
+/**
+ * @brief Gzipped file stream buffer class.
+ *
+ * This class implements basic_filebuf for gzipped files. It doesn't yet support
+ * seeking (allowed by zlib but slow/limited), putback and read/write access
+ * (tricky). Otherwise, it attempts to be a drop-in replacement for the standard
+ * file streambuf.
+*/
+class gzfilebuf : public std::streambuf
+{
+public:
+ // Default constructor.
+ gzfilebuf();
+
+ // Destructor.
+ virtual
+ ~gzfilebuf();
+
+ /**
+ * @brief Set compression level and strategy on the fly.
+ * @param comp_level Compression level (see zlib.h for allowed values)
+ * @param comp_strategy Compression strategy (see zlib.h for allowed values)
+ * @return Z_OK on success, Z_STREAM_ERROR otherwise.
+ *
+ * Unfortunately, these parameters cannot be modified separately, as the
+ * previous zfstream version assumed. Since the strategy is seldom changed,
+ * it can default and setcompression(level) then becomes like the old
+ * setcompressionlevel(level).
+ */
+ int
+ setcompression(int comp_level,
+ int comp_strategy = Z_DEFAULT_STRATEGY);
+
+ /**
+ * @brief Check if file is open.
+ * @return True if file is open.
+ */
+ bool
+ is_open() const { return (file != NULL); }
+
+ /**
+ * @brief Open gzipped file.
+ * @param name File name.
+ * @param mode Open mode flags.
+ * @return @c this on success, NULL on failure.
+ */
+ gzfilebuf*
+ open(const char* name,
+ std::ios_base::openmode mode);
+
+ /**
+ * @brief Attach to already open gzipped file.
+ * @param fd File descriptor.
+ * @param mode Open mode flags.
+ * @return @c this on success, NULL on failure.
+ */
+ gzfilebuf*
+ attach(int fd,
+ std::ios_base::openmode mode);
+
+ /**
+ * @brief Close gzipped file.
+ * @return @c this on success, NULL on failure.
+ */
+ gzfilebuf*
+ close();
+
+protected:
+ /**
+ * @brief Convert ios open mode int to mode string used by zlib.
+ * @return True if valid mode flag combination.
+ */
+ bool
+ open_mode(std::ios_base::openmode mode,
+ char* c_mode) const;
+
+ /**
+ * @brief Number of characters available in stream buffer.
+ * @return Number of characters.
+ *
+ * This indicates number of characters in get area of stream buffer.
+ * These characters can be read without accessing the gzipped file.
+ */
+ virtual std::streamsize
+ showmanyc();
+
+ /**
+ * @brief Fill get area from gzipped file.
+ * @return First character in get area on success, EOF on error.
+ *
+ * This actually reads characters from gzipped file to stream
+ * buffer. Always buffered.
+ */
+ virtual int_type
+ underflow();
+
+ /**
+ * @brief Write put area to gzipped file.
+ * @param c Extra character to add to buffer contents.
+ * @return Non-EOF on success, EOF on error.
+ *
+ * This actually writes characters in stream buffer to
+ * gzipped file. With unbuffered output this is done one
+ * character at a time.
+ */
+ virtual int_type
+ overflow(int_type c = traits_type::eof());
+
+ /**
+ * @brief Installs external stream buffer.
+ * @param p Pointer to char buffer.
+ * @param n Size of external buffer.
+ * @return @c this on success, NULL on failure.
+ *
+ * Call setbuf(0,0) to enable unbuffered output.
+ */
+ virtual std::streambuf*
+ setbuf(char_type* p,
+ std::streamsize n);
+
+ /**
+ * @brief Flush stream buffer to file.
+ * @return 0 on success, -1 on error.
+ *
+ * This calls underflow(EOF) to do the job.
+ */
+ virtual int
+ sync();
+
+//
+// Some future enhancements
+//
+// virtual int_type uflow();
+// virtual int_type pbackfail(int_type c = traits_type::eof());
+// virtual pos_type
+// seekoff(off_type off,
+// std::ios_base::seekdir way,
+// std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out);
+// virtual pos_type
+// seekpos(pos_type sp,
+// std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out);
+
+private:
+ /**
+ * @brief Allocate internal buffer.
+ *
+ * This function is safe to call multiple times. It will ensure
+ * that a proper internal buffer exists if it is required. If the
+ * buffer already exists or is external, the buffer pointers will be
+ * reset to their original state.
+ */
+ void
+ enable_buffer();
+
+ /**
+ * @brief Destroy internal buffer.
+ *
+ * This function is safe to call multiple times. It will ensure
+ * that the internal buffer is deallocated if it exists. In any
+ * case, it will also reset the buffer pointers.
+ */
+ void
+ disable_buffer();
+
+ /**
+ * Underlying file pointer.
+ */
+ gzFile file;
+
+ /**
+ * Mode in which file was opened.
+ */
+ std::ios_base::openmode io_mode;
+
+ /**
+ * @brief True if this object owns file descriptor.
+ *
+ * This makes the class responsible for closing the file
+ * upon destruction.
+ */
+ bool own_fd;
+
+ /**
+ * @brief Stream buffer.
+ *
+ * For simplicity this remains allocated on the free store for the
+ * entire life span of the gzfilebuf object, unless replaced by setbuf.
+ */
+ char_type* buffer;
+
+ /**
+ * @brief Stream buffer size.
+ *
+ * Defaults to system default buffer size (typically 8192 bytes).
+ * Modified by setbuf.
+ */
+ std::streamsize buffer_size;
+
+ /**
+ * @brief True if this object owns stream buffer.
+ *
+ * This makes the class responsible for deleting the buffer
+ * upon destruction.
+ */
+ bool own_buffer;
+};
+
+/*****************************************************************************/
+
+/**
+ * @brief Gzipped file input stream class.
+ *
+ * This class implements ifstream for gzipped files. Seeking and putback
+ * is not supported yet.
+*/
+class gzifstream : public std::istream
+{
+public:
+ // Default constructor
+ gzifstream();
+
+ /**
+ * @brief Construct stream on gzipped file to be opened.
+ * @param name File name.
+ * @param mode Open mode flags (forced to contain ios::in).
+ */
+ explicit
+ gzifstream(const char* name,
+ std::ios_base::openmode mode = std::ios_base::in);
+
+ /**
+ * @brief Construct stream on already open gzipped file.
+ * @param fd File descriptor.
+ * @param mode Open mode flags (forced to contain ios::in).
+ */
+ explicit
+ gzifstream(int fd,
+ std::ios_base::openmode mode = std::ios_base::in);
+
+ /**
+ * Obtain underlying stream buffer.
+ */
+ gzfilebuf*
+ rdbuf() const
+ { return const_cast<gzfilebuf*>(&sb); }
+
+ /**
+ * @brief Check if file is open.
+ * @return True if file is open.
+ */
+ bool
+ is_open() { return sb.is_open(); }
+
+ /**
+ * @brief Open gzipped file.
+ * @param name File name.
+ * @param mode Open mode flags (forced to contain ios::in).
+ *
+ * Stream will be in state good() if file opens successfully;
+ * otherwise in state fail(). This differs from the behavior of
+ * ifstream, which never sets the state to good() and therefore
+ * won't allow you to reuse the stream for a second file unless
+ * you manually clear() the state. The choice is a matter of
+ * convenience.
+ */
+ void
+ open(const char* name,
+ std::ios_base::openmode mode = std::ios_base::in);
+
+ /**
+ * @brief Attach to already open gzipped file.
+ * @param fd File descriptor.
+ * @param mode Open mode flags (forced to contain ios::in).
+ *
+ * Stream will be in state good() if attach succeeded; otherwise
+ * in state fail().
+ */
+ void
+ attach(int fd,
+ std::ios_base::openmode mode = std::ios_base::in);
+
+ /**
+ * @brief Close gzipped file.
+ *
+ * Stream will be in state fail() if close failed.
+ */
+ void
+ close();
+
+private:
+ /**
+ * Underlying stream buffer.
+ */
+ gzfilebuf sb;
+};
+
+/*****************************************************************************/
+
+/**
+ * @brief Gzipped file output stream class.
+ *
+ * This class implements ofstream for gzipped files. Seeking and putback
+ * is not supported yet.
+*/
+class gzofstream : public std::ostream
+{
+public:
+ // Default constructor
+ gzofstream();
+
+ /**
+ * @brief Construct stream on gzipped file to be opened.
+ * @param name File name.
+ * @param mode Open mode flags (forced to contain ios::out).
+ */
+ explicit
+ gzofstream(const char* name,
+ std::ios_base::openmode mode = std::ios_base::out);
+
+ /**
+ * @brief Construct stream on already open gzipped file.
+ * @param fd File descriptor.
+ * @param mode Open mode flags (forced to contain ios::out).
+ */
+ explicit
+ gzofstream(int fd,
+ std::ios_base::openmode mode = std::ios_base::out);
+
+ /**
+ * Obtain underlying stream buffer.
+ */
+ gzfilebuf*
+ rdbuf() const
+ { return const_cast<gzfilebuf*>(&sb); }
+
+ /**
+ * @brief Check if file is open.
+ * @return True if file is open.
+ */
+ bool
+ is_open() { return sb.is_open(); }
+
+ /**
+ * @brief Open gzipped file.
+ * @param name File name.
+ * @param mode Open mode flags (forced to contain ios::out).
+ *
+ * Stream will be in state good() if file opens successfully;
+ * otherwise in state fail(). This differs from the behavior of
+ * ofstream, which never sets the state to good() and therefore
+ * won't allow you to reuse the stream for a second file unless
+ * you manually clear() the state. The choice is a matter of
+ * convenience.
+ */
+ void
+ open(const char* name,
+ std::ios_base::openmode mode = std::ios_base::out);
+
+ /**
+ * @brief Attach to already open gzipped file.
+ * @param fd File descriptor.
+ * @param mode Open mode flags (forced to contain ios::out).
+ *
+ * Stream will be in state good() if attach succeeded; otherwise
+ * in state fail().
+ */
+ void
+ attach(int fd,
+ std::ios_base::openmode mode = std::ios_base::out);
+
+ /**
+ * @brief Close gzipped file.
+ *
+ * Stream will be in state fail() if close failed.
+ */
+ void
+ close();
+
+private:
+ /**
+ * Underlying stream buffer.
+ */
+ gzfilebuf sb;
+};
+
+/*****************************************************************************/
+
+/**
+ * @brief Gzipped file output stream manipulator class.
+ *
+ * This class defines a two-argument manipulator for gzofstream. It is used
+ * as base for the setcompression(int,int) manipulator.
+*/
+template<typename T1, typename T2>
+ class gzomanip2
+ {
+ public:
+ // Allows insertor to peek at internals
+ template <typename Ta, typename Tb>
+ friend gzofstream&
+ operator<<(gzofstream&,
+ const gzomanip2<Ta,Tb>&);
+
+ // Constructor
+ gzomanip2(gzofstream& (*f)(gzofstream&, T1, T2),
+ T1 v1,
+ T2 v2);
+ private:
+ // Underlying manipulator function
+ gzofstream&
+ (*func)(gzofstream&, T1, T2);
+
+ // Arguments for manipulator function
+ T1 val1;
+ T2 val2;
+ };
+
+/*****************************************************************************/
+
+// Manipulator function thunks through to stream buffer
+inline gzofstream&
+setcompression(gzofstream &gzs, int l, int s = Z_DEFAULT_STRATEGY)
+{
+ (gzs.rdbuf())->setcompression(l, s);
+ return gzs;
+}
+
+// Manipulator constructor stores arguments
+template<typename T1, typename T2>
+ inline
+ gzomanip2<T1,T2>::gzomanip2(gzofstream &(*f)(gzofstream &, T1, T2),
+ T1 v1,
+ T2 v2)
+ : func(f), val1(v1), val2(v2)
+ { }
+
+// Insertor applies underlying manipulator function to stream
+template<typename T1, typename T2>
+ inline gzofstream&
+ operator<<(gzofstream& s, const gzomanip2<T1,T2>& m)
+ { return (*m.func)(s, m.val1, m.val2); }
+
+// Insert this onto stream to simplify setting of compression level
+inline gzomanip2<int,int>
+setcompression(int l, int s = Z_DEFAULT_STRATEGY)
+{ return gzomanip2<int,int>(&setcompression, l, s); }
+
+#endif // ZFSTREAM_H
diff --git a/compat/zlib/contrib/masmx64/bld_ml64.bat b/compat/zlib/contrib/masmx64/bld_ml64.bat
new file mode 100644
index 0000000..8f9343d
--- /dev/null
+++ b/compat/zlib/contrib/masmx64/bld_ml64.bat
@@ -0,0 +1,2 @@
+ml64.exe /Flinffasx64 /c /Zi inffasx64.asm
+ml64.exe /Flgvmat64 /c /Zi gvmat64.asm
diff --git a/compat/zlib/contrib/masmx64/gvmat64.asm b/compat/zlib/contrib/masmx64/gvmat64.asm
new file mode 100644
index 0000000..9879c28
--- /dev/null
+++ b/compat/zlib/contrib/masmx64/gvmat64.asm
@@ -0,0 +1,553 @@
+;uInt longest_match_x64(
+; deflate_state *s,
+; IPos cur_match); /* current match */
+
+; gvmat64.asm -- Asm portion of the optimized longest_match for 32 bits x86_64
+; (AMD64 on Athlon 64, Opteron, Phenom
+; and Intel EM64T on Pentium 4 with EM64T, Pentium D, Core 2 Duo, Core I5/I7)
+; Copyright (C) 1995-2010 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
+;
+; File written by Gilles Vollant, by converting to assembly the longest_match
+; from Jean-loup Gailly in deflate.c of zLib and infoZip zip.
+;
+; and by taking inspiration on asm686 with masm, optimised assembly code
+; from Brian Raiter, written 1998
+;
+; This software is provided 'as-is', without any express or implied
+; warranty. In no event will the authors be held liable for any damages
+; arising from the use of this software.
+;
+; Permission is granted to anyone to use this software for any purpose,
+; including commercial applications, and to alter it and redistribute it
+; freely, subject to the following restrictions:
+;
+; 1. The origin of this software must not be misrepresented; you must not
+; claim that you wrote the original software. If you use this software
+; in a product, an acknowledgment in the product documentation would be
+; appreciated but is not required.
+; 2. Altered source versions must be plainly marked as such, and must not be
+; misrepresented as being the original software
+; 3. This notice may not be removed or altered from any source distribution.
+;
+;
+;
+; http://www.zlib.net
+; http://www.winimage.com/zLibDll
+; http://www.muppetlabs.com/~breadbox/software/assembly.html
+;
+; to compile this file for infozip Zip, I use option:
+; ml64.exe /Flgvmat64 /c /Zi /DINFOZIP gvmat64.asm
+;
+; to compile this file for zLib, I use option:
+; ml64.exe /Flgvmat64 /c /Zi gvmat64.asm
+; Be carrefull to adapt zlib1222add below to your version of zLib
+; (if you use a version of zLib before 1.0.4 or after 1.2.2.2, change
+; value of zlib1222add later)
+;
+; This file compile with Microsoft Macro Assembler (x64) for AMD64
+;
+; ml64.exe is given with Visual Studio 2005/2008/2010 and Windows WDK
+;
+; (you can get Windows WDK with ml64 for AMD64 from
+; http://www.microsoft.com/whdc/Devtools/wdk/default.mspx for low price)
+;
+
+
+;uInt longest_match(s, cur_match)
+; deflate_state *s;
+; IPos cur_match; /* current match */
+.code
+longest_match PROC
+
+
+;LocalVarsSize equ 88
+ LocalVarsSize equ 72
+
+; register used : rax,rbx,rcx,rdx,rsi,rdi,r8,r9,r10,r11,r12
+; free register : r14,r15
+; register can be saved : rsp
+
+ chainlenwmask equ rsp + 8 - LocalVarsSize ; high word: current chain len
+ ; low word: s->wmask
+;window equ rsp + xx - LocalVarsSize ; local copy of s->window ; stored in r10
+;windowbestlen equ rsp + xx - LocalVarsSize ; s->window + bestlen , use r10+r11
+;scanstart equ rsp + xx - LocalVarsSize ; first two bytes of string ; stored in r12w
+;scanend equ rsp + xx - LocalVarsSize ; last two bytes of string use ebx
+;scanalign equ rsp + xx - LocalVarsSize ; dword-misalignment of string r13
+;bestlen equ rsp + xx - LocalVarsSize ; size of best match so far -> r11d
+;scan equ rsp + xx - LocalVarsSize ; ptr to string wanting match -> r9
+IFDEF INFOZIP
+ELSE
+ nicematch equ (rsp + 16 - LocalVarsSize) ; a good enough match size
+ENDIF
+
+save_rdi equ rsp + 24 - LocalVarsSize
+save_rsi equ rsp + 32 - LocalVarsSize
+save_rbx equ rsp + 40 - LocalVarsSize
+save_rbp equ rsp + 48 - LocalVarsSize
+save_r12 equ rsp + 56 - LocalVarsSize
+save_r13 equ rsp + 64 - LocalVarsSize
+;save_r14 equ rsp + 72 - LocalVarsSize
+;save_r15 equ rsp + 80 - LocalVarsSize
+
+
+; summary of register usage
+; scanend ebx
+; scanendw bx
+; chainlenwmask edx
+; curmatch rsi
+; curmatchd esi
+; windowbestlen r8
+; scanalign r9
+; scanalignd r9d
+; window r10
+; bestlen r11
+; bestlend r11d
+; scanstart r12d
+; scanstartw r12w
+; scan r13
+; nicematch r14d
+; limit r15
+; limitd r15d
+; prev rcx
+
+; all the +4 offsets are due to the addition of pending_buf_size (in zlib
+; in the deflate_state structure since the asm code was first written
+; (if you compile with zlib 1.0.4 or older, remove the +4).
+; Note : these value are good with a 8 bytes boundary pack structure
+
+
+ MAX_MATCH equ 258
+ MIN_MATCH equ 3
+ MIN_LOOKAHEAD equ (MAX_MATCH+MIN_MATCH+1)
+
+
+;;; 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").
+
+
+IFDEF INFOZIP
+
+_DATA SEGMENT
+COMM window_size:DWORD
+; WMask ; 7fff
+COMM window:BYTE:010040H
+COMM prev:WORD:08000H
+; MatchLen : unused
+; PrevMatch : unused
+COMM strstart:DWORD
+COMM match_start:DWORD
+; Lookahead : ignore
+COMM prev_length:DWORD ; PrevLen
+COMM max_chain_length:DWORD
+COMM good_match:DWORD
+COMM nice_match:DWORD
+prev_ad equ OFFSET prev
+window_ad equ OFFSET window
+nicematch equ nice_match
+_DATA ENDS
+WMask equ 07fffh
+
+ELSE
+
+ IFNDEF zlib1222add
+ zlib1222add equ 8
+ ENDIF
+dsWSize equ 56+zlib1222add+(zlib1222add/2)
+dsWMask equ 64+zlib1222add+(zlib1222add/2)
+dsWindow equ 72+zlib1222add
+dsPrev equ 88+zlib1222add
+dsMatchLen equ 128+zlib1222add
+dsPrevMatch equ 132+zlib1222add
+dsStrStart equ 140+zlib1222add
+dsMatchStart equ 144+zlib1222add
+dsLookahead equ 148+zlib1222add
+dsPrevLen equ 152+zlib1222add
+dsMaxChainLen equ 156+zlib1222add
+dsGoodMatch equ 172+zlib1222add
+dsNiceMatch equ 176+zlib1222add
+
+window_size equ [ rcx + dsWSize]
+WMask equ [ rcx + dsWMask]
+window_ad equ [ rcx + dsWindow]
+prev_ad equ [ rcx + dsPrev]
+strstart equ [ rcx + dsStrStart]
+match_start equ [ rcx + dsMatchStart]
+Lookahead equ [ rcx + dsLookahead] ; 0ffffffffh on infozip
+prev_length equ [ rcx + dsPrevLen]
+max_chain_length equ [ rcx + dsMaxChainLen]
+good_match equ [ rcx + dsGoodMatch]
+nice_match equ [ rcx + dsNiceMatch]
+ENDIF
+
+; parameter 1 in r8(deflate state s), param 2 in rdx (cur match)
+
+; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
+; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
+;
+; All registers must be preserved across the call, except for
+; rax, rcx, rdx, r8, r9, r10, and r11, which are scratch.
+
+
+
+;;; Save registers that the compiler may be using, and adjust esp to
+;;; make room for our stack frame.
+
+
+;;; Retrieve the function arguments. r8d 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.
+
+; parameter 1 in rcx (deflate_state* s), param 2 in edx -> r8 (cur match)
+
+; this clear high 32 bits of r8, which can be garbage in both r8 and rdx
+
+ mov [save_rdi],rdi
+ mov [save_rsi],rsi
+ mov [save_rbx],rbx
+ mov [save_rbp],rbp
+IFDEF INFOZIP
+ mov r8d,ecx
+ELSE
+ mov r8d,edx
+ENDIF
+ mov [save_r12],r12
+ mov [save_r13],r13
+; mov [save_r14],r14
+; mov [save_r15],r15
+
+
+;;; uInt wmask = s->w_mask;
+;;; unsigned chain_length = s->max_chain_length;
+;;; if (s->prev_length >= s->good_match) {
+;;; chain_length >>= 2;
+;;; }
+
+ mov edi, prev_length
+ mov esi, good_match
+ mov eax, WMask
+ mov ebx, max_chain_length
+ cmp edi, esi
+ 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
+
+;;; on zlib only
+;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+
+IFDEF INFOZIP
+ mov [chainlenwmask], ebx
+; on infozip nice_match = [nice_match]
+ELSE
+ mov eax, nice_match
+ mov [chainlenwmask], ebx
+ mov r10d, Lookahead
+ cmp r10d, eax
+ cmovnl r10d, eax
+ mov [nicematch],r10d
+ENDIF
+
+;;; register Bytef *scan = s->window + s->strstart;
+ mov r10, window_ad
+ mov ebp, strstart
+ lea r13, [r10 + rbp]
+
+;;; Determine how many bytes the scan ptr is off from being
+;;; dword-aligned.
+
+ mov r9,r13
+ neg r13
+ and r13,3
+
+;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+;;; s->strstart - (IPos)MAX_DIST(s) : NIL;
+IFDEF INFOZIP
+ mov eax,07efah ; MAX_DIST = (WSIZE-MIN_LOOKAHEAD) (0x8000-(3+8+1))
+ELSE
+ mov eax, window_size
+ sub eax, MIN_LOOKAHEAD
+ENDIF
+ xor edi,edi
+ sub ebp, eax
+
+ mov r11d, prev_length
+
+ cmovng ebp,edi
+
+;;; int best_len = s->prev_length;
+
+
+;;; Store the sum of s->window + best_len in esi locally, and in esi.
+
+ lea rsi,[r10+r11]
+
+;;; register ush scan_start = *(ushf*)scan;
+;;; register ush scan_end = *(ushf*)(scan+best_len-1);
+;;; Posf *prev = s->prev;
+
+ movzx r12d,word ptr [r9]
+ movzx ebx, word ptr [r9 + r11 - 1]
+
+ mov rdi, prev_ad
+
+;;; Jump into the main loop.
+
+ mov edx, [chainlenwmask]
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ jz LookupLoopIsZero
+
+LookupLoop1:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ jbe LeaveNow
+ sub edx, 00010000h
+ js LeaveNow
+
+LoopEntry1:
+ cmp bx,word ptr [rsi + r8 - 1]
+ jz LookupLoopIsZero
+
+LookupLoop2:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ jbe LeaveNow
+ sub edx, 00010000h
+ js LeaveNow
+
+LoopEntry2:
+ cmp bx,word ptr [rsi + r8 - 1]
+ jz LookupLoopIsZero
+
+LookupLoop4:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ jbe LeaveNow
+ sub edx, 00010000h
+ js LeaveNow
+
+LoopEntry4:
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ jnz LookupLoop1
+ jmp LookupLoopIsZero
+
+
+;;; 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
+;;; r8d = curmatch
+;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
+;;; esi = windowbestlen - i.e., (window + bestlen)
+;;; edi = prev
+;;; ebp = limit
+
+LookupLoop:
+ and r8d, edx
+
+ movzx r8d, word ptr [rdi + r8*2]
+ cmp r8d, ebp
+ jbe LeaveNow
+ sub edx, 00010000h
+ js LeaveNow
+
+LoopEntry:
+
+ cmp bx,word ptr [rsi + r8 - 1]
+ jnz LookupLoop1
+LookupLoopIsZero:
+ cmp r12w, word ptr [r10 + r8]
+ jnz LookupLoop1
+
+
+;;; 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).
+
+ lea rsi,[r8+r10]
+ mov rdx, 0fffffffffffffef8h; -(MAX_MATCH_8)
+ lea rsi, [rsi + r13 + 0108h] ;MAX_MATCH_8]
+ lea rdi, [r9 + r13 + 0108h] ;MAX_MATCH_8]
+
+ prefetcht1 [rsi+rdx]
+ prefetcht1 [rdi+rdx]
+
+
+;;; Test the strings for equality, 8 bytes at a time. At the end,
+;;; adjust rdx 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. (rsi 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 rax, [rsi + rdx]
+ xor rax, [rdi + rdx]
+ jnz LeaveLoopCmps
+
+ mov rax, [rsi + rdx + 8]
+ xor rax, [rdi + rdx + 8]
+ jnz LeaveLoopCmps8
+
+
+ mov rax, [rsi + rdx + 8+8]
+ xor rax, [rdi + rdx + 8+8]
+ jnz LeaveLoopCmps16
+
+ add rdx,8+8+8
+
+ jnz short LoopCmps
+ jmp short LenMaximum
+LeaveLoopCmps16: add rdx,8
+LeaveLoopCmps8: add rdx,8
+LeaveLoopCmps:
+
+ test eax, 0000FFFFh
+ jnz LenLower
+
+ test eax,0ffffffffh
+
+ jnz LenLower32
+
+ add rdx,4
+ shr rax,32
+ or ax,ax
+ jnz LenLower
+
+LenLower32:
+ shr eax,16
+ add rdx,2
+LenLower: sub al, 1
+ adc rdx, 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 rax, [rdi + rdx]
+ sub rax, r9
+ 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.
+;///////////////////////////////////
+
+ cmp eax, r11d
+ jg LongerMatch
+
+ lea rsi,[r10+r11]
+
+ mov rdi, prev_ad
+ 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 r11d, eax
+ mov match_start, r8d
+ cmp eax, [nicematch]
+ jge LeaveNow
+
+ lea rsi,[r10+rax]
+
+ movzx ebx, word ptr [r9 + rax - 1]
+ mov rdi, prev_ad
+ mov edx, [chainlenwmask]
+ jmp LookupLoop
+
+;;; Accept the current string, with the maximum possible length.
+
+LenMaximum:
+ mov r11d,MAX_MATCH
+ mov match_start, r8d
+
+;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
+;;; return s->lookahead;
+
+LeaveNow:
+IFDEF INFOZIP
+ mov eax,r11d
+ELSE
+ mov eax, Lookahead
+ cmp r11d, eax
+ cmovng eax, r11d
+ENDIF
+
+;;; Restore the stack and return from whence we came.
+
+
+ mov rsi,[save_rsi]
+ mov rdi,[save_rdi]
+ mov rbx,[save_rbx]
+ mov rbp,[save_rbp]
+ mov r12,[save_r12]
+ mov r13,[save_r13]
+; mov r14,[save_r14]
+; mov r15,[save_r15]
+
+
+ ret 0
+; please don't remove this string !
+; Your can freely use gvmat64 in any free or commercial app
+; but it is far better don't remove the string in the binary!
+ db 0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998, converted to amd 64 by Gilles Vollant 2005",0dh,0ah,0
+longest_match ENDP
+
+match_init PROC
+ ret 0
+match_init ENDP
+
+
+END
diff --git a/compat/zlib/contrib/masmx64/inffas8664.c b/compat/zlib/contrib/masmx64/inffas8664.c
new file mode 100644
index 0000000..e8af06f
--- /dev/null
+++ b/compat/zlib/contrib/masmx64/inffas8664.c
@@ -0,0 +1,186 @@
+/* inffas8664.c is a hand tuned assembler version of inffast.c - fast decoding
+ * version for AMD64 on Windows using Microsoft C compiler
+ *
+ * Copyright (C) 1995-2003 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ *
+ * Copyright (C) 2003 Chris Anderson <christop@charm.net>
+ * Please use the copyright conditions above.
+ *
+ * 2005 - Adaptation to Microsoft C Compiler for AMD64 by Gilles Vollant
+ *
+ * inffas8664.c call function inffas8664fnc in inffasx64.asm
+ * inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
+ *
+ * Dec-29-2003 -- I added AMD64 inflate asm support. This version is also
+ * slightly quicker on x86 systems because, instead of using rep movsb to copy
+ * data, it uses rep movsw, which moves data in 2-byte chunks instead of single
+ * bytes. I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
+ * from http://fedora.linux.duke.edu/fc1_x86_64
+ * which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
+ * 1GB ram. The 64-bit version is about 4% faster than the 32-bit version,
+ * when decompressing mozilla-source-1.3.tar.gz.
+ *
+ * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
+ * the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at
+ * the moment. I have successfully compiled and tested this code with gcc2.96,
+ * gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S
+ * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
+ * enabled. I will attempt to merge the MMX code into this version. Newer
+ * versions of this and inffast.S can be found at
+ * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
+ *
+ */
+
+#include <stdio.h>
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+/* Mark Adler's comments from inffast.c: */
+
+/*
+ Decode literal, length, and distance codes and write out the resulting
+ literal and match bytes until either not enough input or output is
+ available, an end-of-block is encountered, or a data error is encountered.
+ When large enough input and output buffers are supplied to inflate(), for
+ example, a 16K input buffer and a 64K output buffer, more than 95% of the
+ inflate execution time is spent in this routine.
+
+ Entry assumptions:
+
+ state->mode == LEN
+ strm->avail_in >= 6
+ strm->avail_out >= 258
+ start >= strm->avail_out
+ state->bits < 8
+
+ On return, state->mode is one of:
+
+ LEN -- ran out of enough output space or enough available input
+ TYPE -- reached end of block code, inflate() to interpret next block
+ BAD -- error in block data
+
+ Notes:
+
+ - The maximum input bits used by a length/distance pair is 15 bits for the
+ length code, 5 bits for the length extra, 15 bits for the distance code,
+ and 13 bits for the distance extra. This totals 48 bits, or six bytes.
+ Therefore if strm->avail_in >= 6, then there is enough input to avoid
+ checking for available input while decoding.
+
+ - The maximum bytes that a single length/distance pair can output is 258
+ bytes, which is the maximum length that can be coded. inflate_fast()
+ requires strm->avail_out >= 258 for each loop to avoid checking for
+ output space.
+ */
+
+
+
+ typedef struct inffast_ar {
+/* 64 32 x86 x86_64 */
+/* ar offset register */
+/* 0 0 */ void *esp; /* esp save */
+/* 8 4 */ void *ebp; /* ebp save */
+/* 16 8 */ unsigned char FAR *in; /* esi rsi local strm->next_in */
+/* 24 12 */ unsigned char FAR *last; /* r9 while in < last */
+/* 32 16 */ unsigned char FAR *out; /* edi rdi local strm->next_out */
+/* 40 20 */ unsigned char FAR *beg; /* inflate()'s init next_out */
+/* 48 24 */ unsigned char FAR *end; /* r10 while out < end */
+/* 56 28 */ unsigned char FAR *window;/* size of window, wsize!=0 */
+/* 64 32 */ code const FAR *lcode; /* ebp rbp local strm->lencode */
+/* 72 36 */ code const FAR *dcode; /* r11 local strm->distcode */
+/* 80 40 */ size_t /*unsigned long */hold; /* edx rdx local strm->hold */
+/* 88 44 */ unsigned bits; /* ebx rbx local strm->bits */
+/* 92 48 */ unsigned wsize; /* window size */
+/* 96 52 */ unsigned write; /* window write index */
+/*100 56 */ unsigned lmask; /* r12 mask for lcode */
+/*104 60 */ unsigned dmask; /* r13 mask for dcode */
+/*108 64 */ unsigned len; /* r14 match length */
+/*112 68 */ unsigned dist; /* r15 match distance */
+/*116 72 */ unsigned status; /* set when state chng*/
+ } type_ar;
+#ifdef ASMINF
+
+void inflate_fast(strm, start)
+z_streamp strm;
+unsigned start; /* inflate()'s starting value for strm->avail_out */
+{
+ struct inflate_state FAR *state;
+ type_ar ar;
+ void inffas8664fnc(struct inffast_ar * par);
+
+
+
+#if (defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )) || (defined(_MSC_VER) && defined(_M_AMD64))
+#define PAD_AVAIL_IN 6
+#define PAD_AVAIL_OUT 258
+#else
+#define PAD_AVAIL_IN 5
+#define PAD_AVAIL_OUT 257
+#endif
+
+ /* copy state to local variables */
+ state = (struct inflate_state FAR *)strm->state;
+
+ ar.in = strm->next_in;
+ ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
+ ar.out = strm->next_out;
+ ar.beg = ar.out - (start - strm->avail_out);
+ ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
+ ar.wsize = state->wsize;
+ ar.write = state->wnext;
+ ar.window = state->window;
+ ar.hold = state->hold;
+ ar.bits = state->bits;
+ ar.lcode = state->lencode;
+ ar.dcode = state->distcode;
+ ar.lmask = (1U << state->lenbits) - 1;
+ ar.dmask = (1U << state->distbits) - 1;
+
+ /* decode literals and length/distances until end-of-block or not enough
+ input data or output space */
+
+ /* align in on 1/2 hold size boundary */
+ while (((size_t)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
+ ar.hold += (unsigned long)*ar.in++ << ar.bits;
+ ar.bits += 8;
+ }
+
+ inffas8664fnc(&ar);
+
+ if (ar.status > 1) {
+ if (ar.status == 2)
+ strm->msg = "invalid literal/length code";
+ else if (ar.status == 3)
+ strm->msg = "invalid distance code";
+ else
+ strm->msg = "invalid distance too far back";
+ state->mode = BAD;
+ }
+ else if ( ar.status == 1 ) {
+ state->mode = TYPE;
+ }
+
+ /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
+ ar.len = ar.bits >> 3;
+ ar.in -= ar.len;
+ ar.bits -= ar.len << 3;
+ ar.hold &= (1U << ar.bits) - 1;
+
+ /* update state and return */
+ strm->next_in = ar.in;
+ strm->next_out = ar.out;
+ strm->avail_in = (unsigned)(ar.in < ar.last ?
+ PAD_AVAIL_IN + (ar.last - ar.in) :
+ PAD_AVAIL_IN - (ar.in - ar.last));
+ strm->avail_out = (unsigned)(ar.out < ar.end ?
+ PAD_AVAIL_OUT + (ar.end - ar.out) :
+ PAD_AVAIL_OUT - (ar.out - ar.end));
+ state->hold = (unsigned long)ar.hold;
+ state->bits = ar.bits;
+ return;
+}
+
+#endif
diff --git a/compat/zlib/contrib/masmx64/inffasx64.asm b/compat/zlib/contrib/masmx64/inffasx64.asm
new file mode 100644
index 0000000..60a8d89
--- /dev/null
+++ b/compat/zlib/contrib/masmx64/inffasx64.asm
@@ -0,0 +1,396 @@
+; inffasx64.asm is a hand tuned assembler version of inffast.c - fast decoding
+; version for AMD64 on Windows using Microsoft C compiler
+;
+; inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
+; inffasx64.asm is called by inffas8664.c, which contain more info.
+
+
+; to compile this file, I use option
+; ml64.exe /Flinffasx64 /c /Zi inffasx64.asm
+; with Microsoft Macro Assembler (x64) for AMD64
+;
+
+; This file compile with Microsoft Macro Assembler (x64) for AMD64
+;
+; ml64.exe is given with Visual Studio 2005/2008/2010 and Windows WDK
+;
+; (you can get Windows WDK with ml64 for AMD64 from
+; http://www.microsoft.com/whdc/Devtools/wdk/default.mspx for low price)
+;
+
+
+.code
+inffas8664fnc PROC
+
+; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
+; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
+;
+; All registers must be preserved across the call, except for
+; rax, rcx, rdx, r8, r-9, r10, and r11, which are scratch.
+
+
+ mov [rsp-8],rsi
+ mov [rsp-16],rdi
+ mov [rsp-24],r12
+ mov [rsp-32],r13
+ mov [rsp-40],r14
+ mov [rsp-48],r15
+ mov [rsp-56],rbx
+
+ mov rax,rcx
+
+ mov [rax+8], rbp ; /* save regs rbp and rsp */
+ mov [rax], rsp
+
+ mov rsp, rax ; /* make rsp point to &ar */
+
+ mov rsi, [rsp+16] ; /* rsi = in */
+ mov rdi, [rsp+32] ; /* rdi = out */
+ mov r9, [rsp+24] ; /* r9 = last */
+ mov r10, [rsp+48] ; /* r10 = end */
+ mov rbp, [rsp+64] ; /* rbp = lcode */
+ mov r11, [rsp+72] ; /* r11 = dcode */
+ mov rdx, [rsp+80] ; /* rdx = hold */
+ mov ebx, [rsp+88] ; /* ebx = bits */
+ mov r12d, [rsp+100] ; /* r12d = lmask */
+ mov r13d, [rsp+104] ; /* r13d = dmask */
+ ; /* r14d = len */
+ ; /* r15d = dist */
+
+
+ cld
+ cmp r10, rdi
+ je L_one_time ; /* if only one decode left */
+ cmp r9, rsi
+
+ jne L_do_loop
+
+
+L_one_time:
+ mov r8, r12 ; /* r8 = lmask */
+ cmp bl, 32
+ ja L_get_length_code_one_time
+
+ lodsd ; /* eax = *(uint *)in++ */
+ mov cl, bl ; /* cl = bits, needs it for shifting */
+ add bl, 32 ; /* bits += 32 */
+ shl rax, cl
+ or rdx, rax ; /* hold |= *((uint *)in)++ << bits */
+ jmp L_get_length_code_one_time
+
+ALIGN 4
+L_while_test:
+ cmp r10, rdi
+ jbe L_break_loop
+ cmp r9, rsi
+ jbe L_break_loop
+
+L_do_loop:
+ mov r8, r12 ; /* r8 = lmask */
+ cmp bl, 32
+ ja L_get_length_code ; /* if (32 < bits) */
+
+ lodsd ; /* eax = *(uint *)in++ */
+ mov cl, bl ; /* cl = bits, needs it for shifting */
+ add bl, 32 ; /* bits += 32 */
+ shl rax, cl
+ or rdx, rax ; /* hold |= *((uint *)in)++ << bits */
+
+L_get_length_code:
+ and r8, rdx ; /* r8 &= hold */
+ mov eax, [rbp+r8*4] ; /* eax = lcode[hold & lmask] */
+
+ mov cl, ah ; /* cl = this.bits */
+ sub bl, ah ; /* bits -= this.bits */
+ shr rdx, cl ; /* hold >>= this.bits */
+
+ test al, al
+ jnz L_test_for_length_base ; /* if (op != 0) 45.7% */
+
+ mov r8, r12 ; /* r8 = lmask */
+ shr eax, 16 ; /* output this.val char */
+ stosb
+
+L_get_length_code_one_time:
+ and r8, rdx ; /* r8 &= hold */
+ mov eax, [rbp+r8*4] ; /* eax = lcode[hold & lmask] */
+
+L_dolen:
+ mov cl, ah ; /* cl = this.bits */
+ sub bl, ah ; /* bits -= this.bits */
+ shr rdx, cl ; /* hold >>= this.bits */
+
+ test al, al
+ jnz L_test_for_length_base ; /* if (op != 0) 45.7% */
+
+ shr eax, 16 ; /* output this.val char */
+ stosb
+ jmp L_while_test
+
+ALIGN 4
+L_test_for_length_base:
+ mov r14d, eax ; /* len = this */
+ shr r14d, 16 ; /* len = this.val */
+ mov cl, al
+
+ test al, 16
+ jz L_test_for_second_level_length ; /* if ((op & 16) == 0) 8% */
+ and cl, 15 ; /* op &= 15 */
+ jz L_decode_distance ; /* if (!op) */
+
+L_add_bits_to_len:
+ sub bl, cl
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx ; /* eax &= hold */
+ shr rdx, cl
+ add r14d, eax ; /* len += hold & mask[op] */
+
+L_decode_distance:
+ mov r8, r13 ; /* r8 = dmask */
+ cmp bl, 32
+ ja L_get_distance_code ; /* if (32 < bits) */
+
+ lodsd ; /* eax = *(uint *)in++ */
+ mov cl, bl ; /* cl = bits, needs it for shifting */
+ add bl, 32 ; /* bits += 32 */
+ shl rax, cl
+ or rdx, rax ; /* hold |= *((uint *)in)++ << bits */
+
+L_get_distance_code:
+ and r8, rdx ; /* r8 &= hold */
+ mov eax, [r11+r8*4] ; /* eax = dcode[hold & dmask] */
+
+L_dodist:
+ mov r15d, eax ; /* dist = this */
+ shr r15d, 16 ; /* dist = this.val */
+ mov cl, ah
+ sub bl, ah ; /* bits -= this.bits */
+ shr rdx, cl ; /* hold >>= this.bits */
+ mov cl, al ; /* cl = this.op */
+
+ test al, 16 ; /* if ((op & 16) == 0) */
+ jz L_test_for_second_level_dist
+ and cl, 15 ; /* op &= 15 */
+ jz L_check_dist_one
+
+L_add_bits_to_dist:
+ sub bl, cl
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax ; /* (1 << op) - 1 */
+ and eax, edx ; /* eax &= hold */
+ shr rdx, cl
+ add r15d, eax ; /* dist += hold & ((1 << op) - 1) */
+
+L_check_window:
+ mov r8, rsi ; /* save in so from can use it's reg */
+ mov rax, rdi
+ sub rax, [rsp+40] ; /* nbytes = out - beg */
+
+ cmp eax, r15d
+ jb L_clip_window ; /* if (dist > nbytes) 4.2% */
+
+ mov ecx, r14d ; /* ecx = len */
+ mov rsi, rdi
+ sub rsi, r15 ; /* from = out - dist */
+
+ sar ecx, 1
+ jnc L_copy_two ; /* if len % 2 == 0 */
+
+ rep movsw
+ mov al, [rsi]
+ mov [rdi], al
+ inc rdi
+
+ mov rsi, r8 ; /* move in back to %rsi, toss from */
+ jmp L_while_test
+
+L_copy_two:
+ rep movsw
+ mov rsi, r8 ; /* move in back to %rsi, toss from */
+ jmp L_while_test
+
+ALIGN 4
+L_check_dist_one:
+ cmp r15d, 1 ; /* if dist 1, is a memset */
+ jne L_check_window
+ cmp [rsp+40], rdi ; /* if out == beg, outside window */
+ je L_check_window
+
+ mov ecx, r14d ; /* ecx = len */
+ mov al, [rdi-1]
+ mov ah, al
+
+ sar ecx, 1
+ jnc L_set_two
+ mov [rdi], al
+ inc rdi
+
+L_set_two:
+ rep stosw
+ jmp L_while_test
+
+ALIGN 4
+L_test_for_second_level_length:
+ test al, 64
+ jnz L_test_for_end_of_block ; /* if ((op & 64) != 0) */
+
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx ; /* eax &= hold */
+ add eax, r14d ; /* eax += len */
+ mov eax, [rbp+rax*4] ; /* eax = lcode[val+(hold&mask[op])]*/
+ jmp L_dolen
+
+ALIGN 4
+L_test_for_second_level_dist:
+ test al, 64
+ jnz L_invalid_distance_code ; /* if ((op & 64) != 0) */
+
+ xor eax, eax
+ inc eax
+ shl eax, cl
+ dec eax
+ and eax, edx ; /* eax &= hold */
+ add eax, r15d ; /* eax += dist */
+ mov eax, [r11+rax*4] ; /* eax = dcode[val+(hold&mask[op])]*/
+ jmp L_dodist
+
+ALIGN 4
+L_clip_window:
+ mov ecx, eax ; /* ecx = nbytes */
+ mov eax, [rsp+92] ; /* eax = wsize, prepare for dist cmp */
+ neg ecx ; /* nbytes = -nbytes */
+
+ cmp eax, r15d
+ jb L_invalid_distance_too_far ; /* if (dist > wsize) */
+
+ add ecx, r15d ; /* nbytes = dist - nbytes */
+ cmp dword ptr [rsp+96], 0
+ jne L_wrap_around_window ; /* if (write != 0) */
+
+ mov rsi, [rsp+56] ; /* from = window */
+ sub eax, ecx ; /* eax -= nbytes */
+ add rsi, rax ; /* from += wsize - nbytes */
+
+ mov eax, r14d ; /* eax = len */
+ cmp r14d, ecx
+ jbe L_do_copy ; /* if (nbytes >= len) */
+
+ sub eax, ecx ; /* eax -= nbytes */
+ rep movsb
+ mov rsi, rdi
+ sub rsi, r15 ; /* from = &out[ -dist ] */
+ jmp L_do_copy
+
+ALIGN 4
+L_wrap_around_window:
+ mov eax, [rsp+96] ; /* eax = write */
+ cmp ecx, eax
+ jbe L_contiguous_in_window ; /* if (write >= nbytes) */
+
+ mov esi, [rsp+92] ; /* from = wsize */
+ add rsi, [rsp+56] ; /* from += window */
+ add rsi, rax ; /* from += write */
+ sub rsi, rcx ; /* from -= nbytes */
+ sub ecx, eax ; /* nbytes -= write */
+
+ mov eax, r14d ; /* eax = len */
+ cmp eax, ecx
+ jbe L_do_copy ; /* if (nbytes >= len) */
+
+ sub eax, ecx ; /* len -= nbytes */
+ rep movsb
+ mov rsi, [rsp+56] ; /* from = window */
+ mov ecx, [rsp+96] ; /* nbytes = write */
+ cmp eax, ecx
+ jbe L_do_copy ; /* if (nbytes >= len) */
+
+ sub eax, ecx ; /* len -= nbytes */
+ rep movsb
+ mov rsi, rdi
+ sub rsi, r15 ; /* from = out - dist */
+ jmp L_do_copy
+
+ALIGN 4
+L_contiguous_in_window:
+ mov rsi, [rsp+56] ; /* rsi = window */
+ add rsi, rax
+ sub rsi, rcx ; /* from += write - nbytes */
+
+ mov eax, r14d ; /* eax = len */
+ cmp eax, ecx
+ jbe L_do_copy ; /* if (nbytes >= len) */
+
+ sub eax, ecx ; /* len -= nbytes */
+ rep movsb
+ mov rsi, rdi
+ sub rsi, r15 ; /* from = out - dist */
+ jmp L_do_copy ; /* if (nbytes >= len) */
+
+ALIGN 4
+L_do_copy:
+ mov ecx, eax ; /* ecx = len */
+ rep movsb
+
+ mov rsi, r8 ; /* move in back to %esi, toss from */
+ jmp L_while_test
+
+L_test_for_end_of_block:
+ test al, 32
+ jz L_invalid_literal_length_code
+ mov dword ptr [rsp+116], 1
+ jmp L_break_loop_with_status
+
+L_invalid_literal_length_code:
+ mov dword ptr [rsp+116], 2
+ jmp L_break_loop_with_status
+
+L_invalid_distance_code:
+ mov dword ptr [rsp+116], 3
+ jmp L_break_loop_with_status
+
+L_invalid_distance_too_far:
+ mov dword ptr [rsp+116], 4
+ jmp L_break_loop_with_status
+
+L_break_loop:
+ mov dword ptr [rsp+116], 0
+
+L_break_loop_with_status:
+; /* put in, out, bits, and hold back into ar and pop esp */
+ mov [rsp+16], rsi ; /* in */
+ mov [rsp+32], rdi ; /* out */
+ mov [rsp+88], ebx ; /* bits */
+ mov [rsp+80], rdx ; /* hold */
+
+ mov rax, [rsp] ; /* restore rbp and rsp */
+ mov rbp, [rsp+8]
+ mov rsp, rax
+
+
+
+ mov rsi,[rsp-8]
+ mov rdi,[rsp-16]
+ mov r12,[rsp-24]
+ mov r13,[rsp-32]
+ mov r14,[rsp-40]
+ mov r15,[rsp-48]
+ mov rbx,[rsp-56]
+
+ ret 0
+; :
+; : "m" (ar)
+; : "memory", "%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi",
+; "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15"
+; );
+
+inffas8664fnc ENDP
+;_TEXT ENDS
+END
diff --git a/compat/zlib/contrib/masmx64/readme.txt b/compat/zlib/contrib/masmx64/readme.txt
new file mode 100644
index 0000000..2da6733
--- /dev/null
+++ b/compat/zlib/contrib/masmx64/readme.txt
@@ -0,0 +1,31 @@
+Summary
+-------
+This directory contains ASM implementations of the functions
+longest_match() and inflate_fast(), for 64 bits x86 (both AMD64 and Intel EM64t),
+for use with Microsoft Macro Assembler (x64) for AMD64 and Microsoft C++ 64 bits.
+
+gvmat64.asm is written by Gilles Vollant (2005), by using Brian Raiter 686/32 bits
+ assembly optimized version from Jean-loup Gailly original longest_match function
+
+inffasx64.asm and inffas8664.c were written by Chris Anderson, by optimizing
+ original function from Mark Adler
+
+Use instructions
+----------------
+Assemble the .asm files using MASM and put the object files into the zlib source
+directory. You can also get object files here:
+
+ http://www.winimage.com/zLibDll/zlib124_masm_obj.zip
+
+define ASMV and ASMINF in your project. Include inffas8664.c in your source tree,
+and inffasx64.obj and gvmat64.obj as object to link.
+
+
+Build instructions
+------------------
+run bld_64.bat with Microsoft Macro Assembler (x64) for AMD64 (ml64.exe)
+
+ml64.exe is given with Visual Studio 2005, Windows 2003 server DDK
+
+You can get Windows 2003 server DDK with ml64 and cl for AMD64 from
+ http://www.microsoft.com/whdc/devtools/ddk/default.mspx for low price)
diff --git a/compat/zlib/contrib/masmx86/bld_ml32.bat b/compat/zlib/contrib/masmx86/bld_ml32.bat
new file mode 100644
index 0000000..e1b86bf
--- /dev/null
+++ b/compat/zlib/contrib/masmx86/bld_ml32.bat
@@ -0,0 +1,2 @@
+ml /coff /Zi /c /Flmatch686.lst match686.asm
+ml /coff /Zi /c /Flinffas32.lst inffas32.asm
diff --git a/compat/zlib/contrib/masmx86/inffas32.asm b/compat/zlib/contrib/masmx86/inffas32.asm
new file mode 100644
index 0000000..03d20f8
--- /dev/null
+++ b/compat/zlib/contrib/masmx86/inffas32.asm
@@ -0,0 +1,1080 @@
+;/* inffas32.asm is a hand tuned assembler version of inffast.c -- fast decoding
+; *
+; * inffas32.asm is derivated from inffas86.c, with translation of assembly code
+; *
+; * Copyright (C) 1995-2003 Mark Adler
+; * For conditions of distribution and use, see copyright notice in zlib.h
+; *
+; * Copyright (C) 2003 Chris Anderson <christop@charm.net>
+; * Please use the copyright conditions above.
+; *
+; * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
+; * the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at
+; * the moment. I have successfully compiled and tested this code with gcc2.96,
+; * gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S
+; * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
+; * enabled. I will attempt to merge the MMX code into this version. Newer
+; * versions of this and inffast.S can be found at
+; * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
+; *
+; * 2005 : modification by Gilles Vollant
+; */
+; 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/
+;
+;
+; compile with command line option
+; ml /coff /Zi /c /Flinffas32.lst inffas32.asm
+
+; if you define NO_GZIP (see inflate.h), compile with
+; ml /coff /Zi /c /Flinffas32.lst /DNO_GUNZIP inffas32.asm
+
+
+; zlib122sup is 0 fort zlib 1.2.2.1 and lower
+; zlib122sup is 8 fort zlib 1.2.2.2 and more (with addition of dmax and head
+; in inflate_state in inflate.h)
+zlib1222sup equ 8
+
+
+IFDEF GUNZIP
+ INFLATE_MODE_TYPE equ 11
+ INFLATE_MODE_BAD equ 26
+ELSE
+ IFNDEF NO_GUNZIP
+ INFLATE_MODE_TYPE equ 11
+ INFLATE_MODE_BAD equ 26
+ ELSE
+ INFLATE_MODE_TYPE equ 3
+ INFLATE_MODE_BAD equ 17
+ ENDIF
+ENDIF
+
+
+; 75 "inffast.S"
+;FILE "inffast.S"
+
+;;;GLOBAL _inflate_fast
+
+;;;SECTION .text
+
+
+
+ .586p
+ .mmx
+
+ name inflate_fast_x86
+ .MODEL FLAT
+
+_DATA segment
+inflate_fast_use_mmx:
+ dd 1
+
+
+_TEXT segment
+
+
+
+ALIGN 4
+ db 'Fast decoding Code from Chris Anderson'
+ db 0
+
+ALIGN 4
+invalid_literal_length_code_msg:
+ db 'invalid literal/length code'
+ db 0
+
+ALIGN 4
+invalid_distance_code_msg:
+ db 'invalid distance code'
+ db 0
+
+ALIGN 4
+invalid_distance_too_far_msg:
+ db 'invalid distance too far back'
+ db 0
+
+
+ALIGN 4
+inflate_fast_mask:
+dd 0
+dd 1
+dd 3
+dd 7
+dd 15
+dd 31
+dd 63
+dd 127
+dd 255
+dd 511
+dd 1023
+dd 2047
+dd 4095
+dd 8191
+dd 16383
+dd 32767
+dd 65535
+dd 131071
+dd 262143
+dd 524287
+dd 1048575
+dd 2097151
+dd 4194303
+dd 8388607
+dd 16777215
+dd 33554431
+dd 67108863
+dd 134217727
+dd 268435455
+dd 536870911
+dd 1073741823
+dd 2147483647
+dd 4294967295
+
+
+mode_state equ 0 ;/* state->mode */
+wsize_state equ (32+zlib1222sup) ;/* state->wsize */
+write_state equ (36+4+zlib1222sup) ;/* state->write */
+window_state equ (40+4+zlib1222sup) ;/* state->window */
+hold_state equ (44+4+zlib1222sup) ;/* state->hold */
+bits_state equ (48+4+zlib1222sup) ;/* state->bits */
+lencode_state equ (64+4+zlib1222sup) ;/* state->lencode */
+distcode_state equ (68+4+zlib1222sup) ;/* state->distcode */
+lenbits_state equ (72+4+zlib1222sup) ;/* state->lenbits */
+distbits_state equ (76+4+zlib1222sup) ;/* state->distbits */
+
+
+;;SECTION .text
+; 205 "inffast.S"
+;GLOBAL inflate_fast_use_mmx
+
+;SECTION .data
+
+
+; GLOBAL inflate_fast_use_mmx:object
+;.size inflate_fast_use_mmx, 4
+; 226 "inffast.S"
+;SECTION .text
+
+ALIGN 4
+_inflate_fast proc near
+.FPO (16, 4, 0, 0, 1, 0)
+ push edi
+ push esi
+ push ebp
+ push ebx
+ pushfd
+ sub esp,64
+ cld
+
+
+
+
+ mov esi, [esp+88]
+ mov edi, [esi+28]
+
+
+
+
+
+
+
+ mov edx, [esi+4]
+ mov eax, [esi+0]
+
+ add edx,eax
+ sub edx,11
+
+ mov [esp+44],eax
+ mov [esp+20],edx
+
+ mov ebp, [esp+92]
+ mov ecx, [esi+16]
+ mov ebx, [esi+12]
+
+ sub ebp,ecx
+ neg ebp
+ add ebp,ebx
+
+ sub ecx,257
+ add ecx,ebx
+
+ mov [esp+60],ebx
+ mov [esp+40],ebp
+ mov [esp+16],ecx
+; 285 "inffast.S"
+ mov eax, [edi+lencode_state]
+ mov ecx, [edi+distcode_state]
+
+ mov [esp+8],eax
+ mov [esp+12],ecx
+
+ mov eax,1
+ mov ecx, [edi+lenbits_state]
+ shl eax,cl
+ dec eax
+ mov [esp+0],eax
+
+ mov eax,1
+ mov ecx, [edi+distbits_state]
+ shl eax,cl
+ dec eax
+ mov [esp+4],eax
+
+ mov eax, [edi+wsize_state]
+ mov ecx, [edi+write_state]
+ mov edx, [edi+window_state]
+
+ mov [esp+52],eax
+ mov [esp+48],ecx
+ mov [esp+56],edx
+
+ mov ebp, [edi+hold_state]
+ mov ebx, [edi+bits_state]
+; 321 "inffast.S"
+ mov esi, [esp+44]
+ mov ecx, [esp+20]
+ cmp ecx,esi
+ ja L_align_long
+
+ add ecx,11
+ sub ecx,esi
+ mov eax,12
+ sub eax,ecx
+ lea edi, [esp+28]
+ rep movsb
+ mov ecx,eax
+ xor eax,eax
+ rep stosb
+ lea esi, [esp+28]
+ mov [esp+20],esi
+ jmp L_is_aligned
+
+
+L_align_long:
+ test esi,3
+ jz L_is_aligned
+ xor eax,eax
+ mov al, [esi]
+ inc esi
+ mov ecx,ebx
+ add ebx,8
+ shl eax,cl
+ or ebp,eax
+ jmp L_align_long
+
+L_is_aligned:
+ mov edi, [esp+60]
+; 366 "inffast.S"
+L_check_mmx:
+ cmp dword ptr [inflate_fast_use_mmx],2
+ je L_init_mmx
+ ja L_do_loop
+
+ push eax
+ push ebx
+ push ecx
+ push edx
+ pushfd
+ mov eax, [esp]
+ xor dword ptr [esp],0200000h
+
+
+
+
+ popfd
+ pushfd
+ pop edx
+ xor edx,eax
+ jz L_dont_use_mmx
+ xor eax,eax
+ cpuid
+ cmp ebx,0756e6547h
+ jne L_dont_use_mmx
+ cmp ecx,06c65746eh
+ jne L_dont_use_mmx
+ cmp edx,049656e69h
+ jne L_dont_use_mmx
+ mov eax,1
+ cpuid
+ shr eax,8
+ and eax,15
+ cmp eax,6
+ jne L_dont_use_mmx
+ test edx,0800000h
+ jnz L_use_mmx
+ jmp L_dont_use_mmx
+L_use_mmx:
+ mov dword ptr [inflate_fast_use_mmx],2
+ jmp L_check_mmx_pop
+L_dont_use_mmx:
+ mov dword ptr [inflate_fast_use_mmx],3
+L_check_mmx_pop:
+ pop edx
+ pop ecx
+ pop ebx
+ pop eax
+ jmp L_check_mmx
+; 426 "inffast.S"
+ALIGN 4
+L_do_loop:
+; 437 "inffast.S"
+ cmp bl,15
+ ja L_get_length_code
+
+ xor eax,eax
+ lodsw
+ mov cl,bl
+ add bl,16
+ shl eax,cl
+ or ebp,eax
+
+L_get_length_code:
+ mov edx, [esp+0]
+ mov ecx, [esp+8]
+ and edx,ebp
+ mov eax, [ecx+edx*4]
+
+L_dolen:
+
+
+
+
+
+
+ mov cl,ah
+ sub bl,ah
+ shr ebp,cl
+
+
+
+
+
+
+ test al,al
+ jnz L_test_for_length_base
+
+ shr eax,16
+ stosb
+
+L_while_test:
+
+
+ cmp [esp+16],edi
+ jbe L_break_loop
+
+ cmp [esp+20],esi
+ ja L_do_loop
+ jmp L_break_loop
+
+L_test_for_length_base:
+; 502 "inffast.S"
+ mov edx,eax
+ shr edx,16
+ mov cl,al
+
+ test al,16
+ jz L_test_for_second_level_length
+ and cl,15
+ jz L_save_len
+ cmp bl,cl
+ jae L_add_bits_to_len
+
+ mov ch,cl
+ xor eax,eax
+ lodsw
+ mov cl,bl
+ add bl,16
+ shl eax,cl
+ or ebp,eax
+ mov cl,ch
+
+L_add_bits_to_len:
+ mov eax,1
+ shl eax,cl
+ dec eax
+ sub bl,cl
+ and eax,ebp
+ shr ebp,cl
+ add edx,eax
+
+L_save_len:
+ mov [esp+24],edx
+
+
+L_decode_distance:
+; 549 "inffast.S"
+ cmp bl,15
+ ja L_get_distance_code
+
+ xor eax,eax
+ lodsw
+ mov cl,bl
+ add bl,16
+ shl eax,cl
+ or ebp,eax
+
+L_get_distance_code:
+ mov edx, [esp+4]
+ mov ecx, [esp+12]
+ and edx,ebp
+ mov eax, [ecx+edx*4]
+
+
+L_dodist:
+ mov edx,eax
+ shr edx,16
+ mov cl,ah
+ sub bl,ah
+ shr ebp,cl
+; 584 "inffast.S"
+ mov cl,al
+
+ test al,16
+ jz L_test_for_second_level_dist
+ and cl,15
+ jz L_check_dist_one
+ cmp bl,cl
+ jae L_add_bits_to_dist
+
+ mov ch,cl
+ xor eax,eax
+ lodsw
+ mov cl,bl
+ add bl,16
+ shl eax,cl
+ or ebp,eax
+ mov cl,ch
+
+L_add_bits_to_dist:
+ mov eax,1
+ shl eax,cl
+ dec eax
+ sub bl,cl
+ and eax,ebp
+ shr ebp,cl
+ add edx,eax
+ jmp L_check_window
+
+L_check_window:
+; 625 "inffast.S"
+ mov [esp+44],esi
+ mov eax,edi
+ sub eax, [esp+40]
+
+ cmp eax,edx
+ jb L_clip_window
+
+ mov ecx, [esp+24]
+ mov esi,edi
+ sub esi,edx
+
+ sub ecx,3
+ mov al, [esi]
+ mov [edi],al
+ mov al, [esi+1]
+ mov dl, [esi+2]
+ add esi,3
+ mov [edi+1],al
+ mov [edi+2],dl
+ add edi,3
+ rep movsb
+
+ mov esi, [esp+44]
+ jmp L_while_test
+
+ALIGN 4
+L_check_dist_one:
+ cmp edx,1
+ jne L_check_window
+ cmp [esp+40],edi
+ je L_check_window
+
+ dec edi
+ mov ecx, [esp+24]
+ mov al, [edi]
+ sub ecx,3
+
+ mov [edi+1],al
+ mov [edi+2],al
+ mov [edi+3],al
+ add edi,4
+ rep stosb
+
+ jmp L_while_test
+
+ALIGN 4
+L_test_for_second_level_length:
+
+
+
+
+ test al,64
+ jnz L_test_for_end_of_block
+
+ mov eax,1
+ shl eax,cl
+ dec eax
+ and eax,ebp
+ add eax,edx
+ mov edx, [esp+8]
+ mov eax, [edx+eax*4]
+ jmp L_dolen
+
+ALIGN 4
+L_test_for_second_level_dist:
+
+
+
+
+ test al,64
+ jnz L_invalid_distance_code
+
+ mov eax,1
+ shl eax,cl
+ dec eax
+ and eax,ebp
+ add eax,edx
+ mov edx, [esp+12]
+ mov eax, [edx+eax*4]
+ jmp L_dodist
+
+ALIGN 4
+L_clip_window:
+; 721 "inffast.S"
+ mov ecx,eax
+ mov eax, [esp+52]
+ neg ecx
+ mov esi, [esp+56]
+
+ cmp eax,edx
+ jb L_invalid_distance_too_far
+
+ add ecx,edx
+ cmp dword ptr [esp+48],0
+ jne L_wrap_around_window
+
+ sub eax,ecx
+ add esi,eax
+; 749 "inffast.S"
+ mov eax, [esp+24]
+ cmp eax,ecx
+ jbe L_do_copy1
+
+ sub eax,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,edx
+ jmp L_do_copy1
+
+ cmp eax,ecx
+ jbe L_do_copy1
+
+ sub eax,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,edx
+ jmp L_do_copy1
+
+L_wrap_around_window:
+; 793 "inffast.S"
+ mov eax, [esp+48]
+ cmp ecx,eax
+ jbe L_contiguous_in_window
+
+ add esi, [esp+52]
+ add esi,eax
+ sub esi,ecx
+ sub ecx,eax
+
+
+ mov eax, [esp+24]
+ cmp eax,ecx
+ jbe L_do_copy1
+
+ sub eax,ecx
+ rep movsb
+ mov esi, [esp+56]
+ mov ecx, [esp+48]
+ cmp eax,ecx
+ jbe L_do_copy1
+
+ sub eax,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,edx
+ jmp L_do_copy1
+
+L_contiguous_in_window:
+; 836 "inffast.S"
+ add esi,eax
+ sub esi,ecx
+
+
+ mov eax, [esp+24]
+ cmp eax,ecx
+ jbe L_do_copy1
+
+ sub eax,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,edx
+
+L_do_copy1:
+; 862 "inffast.S"
+ mov ecx,eax
+ rep movsb
+
+ mov esi, [esp+44]
+ jmp L_while_test
+; 878 "inffast.S"
+ALIGN 4
+L_init_mmx:
+ emms
+
+
+
+
+
+ movd mm0,ebp
+ mov ebp,ebx
+; 896 "inffast.S"
+ movd mm4,dword ptr [esp+0]
+ movq mm3,mm4
+ movd mm5,dword ptr [esp+4]
+ movq mm2,mm5
+ pxor mm1,mm1
+ mov ebx, [esp+8]
+ jmp L_do_loop_mmx
+
+ALIGN 4
+L_do_loop_mmx:
+ psrlq mm0,mm1
+
+ cmp ebp,32
+ ja L_get_length_code_mmx
+
+ movd mm6,ebp
+ movd mm7,dword ptr [esi]
+ add esi,4
+ psllq mm7,mm6
+ add ebp,32
+ por mm0,mm7
+
+L_get_length_code_mmx:
+ pand mm4,mm0
+ movd eax,mm4
+ movq mm4,mm3
+ mov eax, [ebx+eax*4]
+
+L_dolen_mmx:
+ movzx ecx,ah
+ movd mm1,ecx
+ sub ebp,ecx
+
+ test al,al
+ jnz L_test_for_length_base_mmx
+
+ shr eax,16
+ stosb
+
+L_while_test_mmx:
+
+
+ cmp [esp+16],edi
+ jbe L_break_loop
+
+ cmp [esp+20],esi
+ ja L_do_loop_mmx
+ jmp L_break_loop
+
+L_test_for_length_base_mmx:
+
+ mov edx,eax
+ shr edx,16
+
+ test al,16
+ jz L_test_for_second_level_length_mmx
+ and eax,15
+ jz L_decode_distance_mmx
+
+ psrlq mm0,mm1
+ movd mm1,eax
+ movd ecx,mm0
+ sub ebp,eax
+ and ecx, [inflate_fast_mask+eax*4]
+ add edx,ecx
+
+L_decode_distance_mmx:
+ psrlq mm0,mm1
+
+ cmp ebp,32
+ ja L_get_dist_code_mmx
+
+ movd mm6,ebp
+ movd mm7,dword ptr [esi]
+ add esi,4
+ psllq mm7,mm6
+ add ebp,32
+ por mm0,mm7
+
+L_get_dist_code_mmx:
+ mov ebx, [esp+12]
+ pand mm5,mm0
+ movd eax,mm5
+ movq mm5,mm2
+ mov eax, [ebx+eax*4]
+
+L_dodist_mmx:
+
+ movzx ecx,ah
+ mov ebx,eax
+ shr ebx,16
+ sub ebp,ecx
+ movd mm1,ecx
+
+ test al,16
+ jz L_test_for_second_level_dist_mmx
+ and eax,15
+ jz L_check_dist_one_mmx
+
+L_add_bits_to_dist_mmx:
+ psrlq mm0,mm1
+ movd mm1,eax
+ movd ecx,mm0
+ sub ebp,eax
+ and ecx, [inflate_fast_mask+eax*4]
+ add ebx,ecx
+
+L_check_window_mmx:
+ mov [esp+44],esi
+ mov eax,edi
+ sub eax, [esp+40]
+
+ cmp eax,ebx
+ jb L_clip_window_mmx
+
+ mov ecx,edx
+ mov esi,edi
+ sub esi,ebx
+
+ sub ecx,3
+ mov al, [esi]
+ mov [edi],al
+ mov al, [esi+1]
+ mov dl, [esi+2]
+ add esi,3
+ mov [edi+1],al
+ mov [edi+2],dl
+ add edi,3
+ rep movsb
+
+ mov esi, [esp+44]
+ mov ebx, [esp+8]
+ jmp L_while_test_mmx
+
+ALIGN 4
+L_check_dist_one_mmx:
+ cmp ebx,1
+ jne L_check_window_mmx
+ cmp [esp+40],edi
+ je L_check_window_mmx
+
+ dec edi
+ mov ecx,edx
+ mov al, [edi]
+ sub ecx,3
+
+ mov [edi+1],al
+ mov [edi+2],al
+ mov [edi+3],al
+ add edi,4
+ rep stosb
+
+ mov ebx, [esp+8]
+ jmp L_while_test_mmx
+
+ALIGN 4
+L_test_for_second_level_length_mmx:
+ test al,64
+ jnz L_test_for_end_of_block
+
+ and eax,15
+ psrlq mm0,mm1
+ movd ecx,mm0
+ and ecx, [inflate_fast_mask+eax*4]
+ add ecx,edx
+ mov eax, [ebx+ecx*4]
+ jmp L_dolen_mmx
+
+ALIGN 4
+L_test_for_second_level_dist_mmx:
+ test al,64
+ jnz L_invalid_distance_code
+
+ and eax,15
+ psrlq mm0,mm1
+ movd ecx,mm0
+ and ecx, [inflate_fast_mask+eax*4]
+ mov eax, [esp+12]
+ add ecx,ebx
+ mov eax, [eax+ecx*4]
+ jmp L_dodist_mmx
+
+ALIGN 4
+L_clip_window_mmx:
+
+ mov ecx,eax
+ mov eax, [esp+52]
+ neg ecx
+ mov esi, [esp+56]
+
+ cmp eax,ebx
+ jb L_invalid_distance_too_far
+
+ add ecx,ebx
+ cmp dword ptr [esp+48],0
+ jne L_wrap_around_window_mmx
+
+ sub eax,ecx
+ add esi,eax
+
+ cmp edx,ecx
+ jbe L_do_copy1_mmx
+
+ sub edx,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,ebx
+ jmp L_do_copy1_mmx
+
+ cmp edx,ecx
+ jbe L_do_copy1_mmx
+
+ sub edx,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,ebx
+ jmp L_do_copy1_mmx
+
+L_wrap_around_window_mmx:
+
+ mov eax, [esp+48]
+ cmp ecx,eax
+ jbe L_contiguous_in_window_mmx
+
+ add esi, [esp+52]
+ add esi,eax
+ sub esi,ecx
+ sub ecx,eax
+
+
+ cmp edx,ecx
+ jbe L_do_copy1_mmx
+
+ sub edx,ecx
+ rep movsb
+ mov esi, [esp+56]
+ mov ecx, [esp+48]
+ cmp edx,ecx
+ jbe L_do_copy1_mmx
+
+ sub edx,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,ebx
+ jmp L_do_copy1_mmx
+
+L_contiguous_in_window_mmx:
+
+ add esi,eax
+ sub esi,ecx
+
+
+ cmp edx,ecx
+ jbe L_do_copy1_mmx
+
+ sub edx,ecx
+ rep movsb
+ mov esi,edi
+ sub esi,ebx
+
+L_do_copy1_mmx:
+
+
+ mov ecx,edx
+ rep movsb
+
+ mov esi, [esp+44]
+ mov ebx, [esp+8]
+ jmp L_while_test_mmx
+; 1174 "inffast.S"
+L_invalid_distance_code:
+
+
+
+
+
+ mov ecx, invalid_distance_code_msg
+ mov edx,INFLATE_MODE_BAD
+ jmp L_update_stream_state
+
+L_test_for_end_of_block:
+
+
+
+
+
+ test al,32
+ jz L_invalid_literal_length_code
+
+ mov ecx,0
+ mov edx,INFLATE_MODE_TYPE
+ jmp L_update_stream_state
+
+L_invalid_literal_length_code:
+
+
+
+
+
+ mov ecx, invalid_literal_length_code_msg
+ mov edx,INFLATE_MODE_BAD
+ jmp L_update_stream_state
+
+L_invalid_distance_too_far:
+
+
+
+ mov esi, [esp+44]
+ mov ecx, invalid_distance_too_far_msg
+ mov edx,INFLATE_MODE_BAD
+ jmp L_update_stream_state
+
+L_update_stream_state:
+
+ mov eax, [esp+88]
+ test ecx,ecx
+ jz L_skip_msg
+ mov [eax+24],ecx
+L_skip_msg:
+ mov eax, [eax+28]
+ mov [eax+mode_state],edx
+ jmp L_break_loop
+
+ALIGN 4
+L_break_loop:
+; 1243 "inffast.S"
+ cmp dword ptr [inflate_fast_use_mmx],2
+ jne L_update_next_in
+
+
+
+ mov ebx,ebp
+
+L_update_next_in:
+; 1266 "inffast.S"
+ mov eax, [esp+88]
+ mov ecx,ebx
+ mov edx, [eax+28]
+ shr ecx,3
+ sub esi,ecx
+ shl ecx,3
+ sub ebx,ecx
+ mov [eax+12],edi
+ mov [edx+bits_state],ebx
+ mov ecx,ebx
+
+ lea ebx, [esp+28]
+ cmp [esp+20],ebx
+ jne L_buf_not_used
+
+ sub esi,ebx
+ mov ebx, [eax+0]
+ mov [esp+20],ebx
+ add esi,ebx
+ mov ebx, [eax+4]
+ sub ebx,11
+ add [esp+20],ebx
+
+L_buf_not_used:
+ mov [eax+0],esi
+
+ mov ebx,1
+ shl ebx,cl
+ dec ebx
+
+
+
+
+
+ cmp dword ptr [inflate_fast_use_mmx],2
+ jne L_update_hold
+
+
+
+ psrlq mm0,mm1
+ movd ebp,mm0
+
+ emms
+
+L_update_hold:
+
+
+
+ and ebp,ebx
+ mov [edx+hold_state],ebp
+
+
+
+
+ mov ebx, [esp+20]
+ cmp ebx,esi
+ jbe L_last_is_smaller
+
+ sub ebx,esi
+ add ebx,11
+ mov [eax+4],ebx
+ jmp L_fixup_out
+L_last_is_smaller:
+ sub esi,ebx
+ neg esi
+ add esi,11
+ mov [eax+4],esi
+
+
+
+
+L_fixup_out:
+
+ mov ebx, [esp+16]
+ cmp ebx,edi
+ jbe L_end_is_smaller
+
+ sub ebx,edi
+ add ebx,257
+ mov [eax+16],ebx
+ jmp L_done
+L_end_is_smaller:
+ sub edi,ebx
+ neg edi
+ add edi,257
+ mov [eax+16],edi
+
+
+
+
+
+L_done:
+ add esp,64
+ popfd
+ pop ebx
+ pop ebp
+ pop esi
+ pop edi
+ ret
+_inflate_fast endp
+
+_TEXT ends
+end
diff --git a/compat/zlib/contrib/masmx86/match686.asm b/compat/zlib/contrib/masmx86/match686.asm
new file mode 100644
index 0000000..3b09212
--- /dev/null
+++ b/compat/zlib/contrib/masmx86/match686.asm
@@ -0,0 +1,479 @@
+; match686.asm -- Asm portion of the optimized longest_match for 32 bits x86
+; Copyright (C) 1995-1996 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
+; File written by Gilles Vollant, by converting match686.S from Brian Raiter
+; for MASM. This is as assembly version of 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 distributed in
+; http://www.microsoft.com/downloads/details.aspx?FamilyID=7a1c9da0-0510-44a2-b042-7ef370530c64
+;
+; this file contain two implementation of longest_match
+;
+; this longest_match was written by Brian raiter (1998), optimized for Pentium Pro
+; (and the faster known version of match_init on modern Core 2 Duo and AMD Phenom)
+;
+; for using an assembly version of longest_match, you need define ASMV in project
+;
+; compile the asm file running
+; ml /coff /Zi /c /Flmatch686.lst match686.asm
+; and do not include match686.obj in your project
+;
+; note: contrib of zLib 1.2.3 and earlier contained both a deprecated version for
+; Pentium (prior Pentium Pro) and this version for Pentium Pro and modern processor
+; with autoselect (with cpu detection code)
+; if you want support the old pentium optimization, you can still use these version
+;
+; this file is not optimized for old pentium, but it compatible with all x86 32 bits
+; processor (starting 80386)
+;
+;
+; see below : zlib1222add must be adjuster if you use a zlib version < 1.2.2.2
+
+;uInt longest_match(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
+ public longest_match
+ public match_init
+ELSE
+ public _longest_match
+ public _match_init
+ENDIF
+
+ MAX_MATCH equ 258
+ MIN_MATCH equ 3
+ MIN_LOOKAHEAD equ (MAX_MATCH+MIN_MATCH+1)
+
+
+
+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
+
+
+;;; match686.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 software is provided 'as-is', without any express or implied
+;; warranty. In no event will the authors be held liable for any damages
+;; arising from the use of this software.
+;;
+;; Permission is granted to anyone to use this software for any purpose,
+;; including commercial applications, and to alter it and redistribute it
+;; freely, subject to the following restrictions:
+;;
+;; 1. The origin of this software must not be misrepresented; you must not
+;; claim that you wrote the original software. If you use this software
+;; in a product, an acknowledgment in the product documentation would be
+;; appreciated but is not required.
+;; 2. Altered source versions must be plainly marked as such, and must not be
+;; misrepresented as being the original software
+;; 3. This notice may not be removed or altered from any source distribution.
+;;
+
+;GLOBAL _longest_match, _match_init
+
+
+;SECTION .text
+
+;;; uInt longest_match(deflate_state *deflatestate, IPos curmatch)
+
+;_longest_match:
+ IFDEF NOUNDERLINE
+ longest_match proc near
+ 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.
+
+ 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 match686 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 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
+
+
+_TEXT ends
+end
diff --git a/compat/zlib/contrib/masmx86/readme.txt b/compat/zlib/contrib/masmx86/readme.txt
new file mode 100644
index 0000000..3271f72
--- /dev/null
+++ b/compat/zlib/contrib/masmx86/readme.txt
@@ -0,0 +1,27 @@
+
+Summary
+-------
+This directory contains ASM implementations of the functions
+longest_match() and inflate_fast().
+
+
+Use instructions
+----------------
+Assemble using MASM, and copy the object files into the zlib source
+directory, then run the appropriate makefile, as suggested below. You can
+donwload MASM from here:
+
+ http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=7a1c9da0-0510-44a2-b042-7ef370530c64
+
+You can also get objects files here:
+
+ http://www.winimage.com/zLibDll/zlib124_masm_obj.zip
+
+Build instructions
+------------------
+* With Microsoft C and MASM:
+nmake -f win32/Makefile.msc LOC="-DASMV -DASMINF" OBJA="match686.obj inffas32.obj"
+
+* With Borland C and TASM:
+make -f win32/Makefile.bor LOCAL_ZLIB="-DASMV -DASMINF" OBJA="match686.obj inffas32.obj" OBJPA="+match686c.obj+match686.obj+inffas32.obj"
+
diff --git a/compat/zlib/contrib/minizip/Makefile b/compat/zlib/contrib/minizip/Makefile
new file mode 100644
index 0000000..84eaad2
--- /dev/null
+++ b/compat/zlib/contrib/minizip/Makefile
@@ -0,0 +1,25 @@
+CC=cc
+CFLAGS=-O -I../..
+
+UNZ_OBJS = miniunz.o unzip.o ioapi.o ../../libz.a
+ZIP_OBJS = minizip.o zip.o ioapi.o ../../libz.a
+
+.c.o:
+ $(CC) -c $(CFLAGS) $*.c
+
+all: miniunz minizip
+
+miniunz: $(UNZ_OBJS)
+ $(CC) $(CFLAGS) -o $@ $(UNZ_OBJS)
+
+minizip: $(ZIP_OBJS)
+ $(CC) $(CFLAGS) -o $@ $(ZIP_OBJS)
+
+test: miniunz minizip
+ ./minizip test readme.txt
+ ./miniunz -l test.zip
+ mv readme.txt readme.old
+ ./miniunz test.zip
+
+clean:
+ /bin/rm -f *.o *~ minizip miniunz
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/MiniZip64_Changes.txt b/compat/zlib/contrib/minizip/MiniZip64_Changes.txt
new file mode 100644
index 0000000..13a1bd9
--- /dev/null
+++ b/compat/zlib/contrib/minizip/MiniZip64_Changes.txt
@@ -0,0 +1,6 @@
+
+MiniZip 1.1 was derrived from MiniZip at version 1.01f
+
+Change in 1.0 (Okt 2009)
+ - **TODO - Add history**
+
diff --git a/compat/zlib/contrib/minizip/MiniZip64_info.txt b/compat/zlib/contrib/minizip/MiniZip64_info.txt
new file mode 100644
index 0000000..57d7152
--- /dev/null
+++ b/compat/zlib/contrib/minizip/MiniZip64_info.txt
@@ -0,0 +1,74 @@
+MiniZip - Copyright (c) 1998-2010 - by Gilles Vollant - version 1.1 64 bits from Mathias Svensson
+
+Introduction
+---------------------
+MiniZip 1.1 is built from MiniZip 1.0 by Gilles Vollant ( http://www.winimage.com/zLibDll/minizip.html )
+
+When adding ZIP64 support into minizip it would result into risk of breaking compatibility with minizip 1.0.
+All possible work was done for compatibility.
+
+
+Background
+---------------------
+When adding ZIP64 support Mathias Svensson found that Even Rouault have added ZIP64
+support for unzip.c into minizip for a open source project called gdal ( http://www.gdal.org/ )
+
+That was used as a starting point. And after that ZIP64 support was added to zip.c
+some refactoring and code cleanup was also done.
+
+
+Changed from MiniZip 1.0 to MiniZip 1.1
+---------------------------------------
+* Added ZIP64 support for unzip ( by Even Rouault )
+* Added ZIP64 support for zip ( by Mathias Svensson )
+* Reverted some changed that Even Rouault did.
+* Bunch of patches received from Gulles Vollant that he received for MiniZip from various users.
+* Added unzip patch for BZIP Compression method (patch create by Daniel Borca)
+* Added BZIP Compress method for zip
+* Did some refactoring and code cleanup
+
+
+Credits
+
+ Gilles Vollant - Original MiniZip author
+ Even Rouault - ZIP64 unzip Support
+ Daniel Borca - BZip Compression method support in unzip
+ Mathias Svensson - ZIP64 zip support
+ Mathias Svensson - BZip Compression method support in zip
+
+ Resources
+
+ ZipLayout http://result42.com/projects/ZipFileLayout
+ Command line tool for Windows that shows the layout and information of the headers in a zip archive.
+ Used when debugging and validating the creation of zip files using MiniZip64
+
+
+ ZIP App Note http://www.pkware.com/documents/casestudies/APPNOTE.TXT
+ Zip File specification
+
+
+Notes.
+ * To be able to use BZip compression method in zip64.c or unzip64.c the BZIP2 lib is needed and HAVE_BZIP2 need to be defined.
+
+License
+----------------------------------------------------------
+ Condition of use and distribution are the same than zlib :
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+----------------------------------------------------------
+
diff --git a/compat/zlib/contrib/minizip/configure.ac b/compat/zlib/contrib/minizip/configure.ac
new file mode 100644
index 0000000..827a4e0
--- /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.8], [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/crypt.h b/compat/zlib/contrib/minizip/crypt.h
new file mode 100644
index 0000000..1e9e820
--- /dev/null
+++ b/compat/zlib/contrib/minizip/crypt.h
@@ -0,0 +1,131 @@
+/* crypt.h -- base code for crypt/uncrypt ZIPfile
+
+
+ Version 1.01e, February 12th, 2005
+
+ Copyright (C) 1998-2005 Gilles Vollant
+
+ This code is a modified version of crypting code in Infozip distribution
+
+ The encryption/decryption parts of this source code (as opposed to the
+ non-echoing password parts) were originally written in Europe. The
+ whole source package can be freely distributed, including from the USA.
+ (Prior to January 2000, re-export from the US was a violation of US law.)
+
+ This encryption code is a direct transcription of the algorithm from
+ Roger Schlafly, described by Phil Katz in the file appnote.txt. This
+ file (appnote.txt) is distributed with the PKZIP program (even in the
+ version without encryption capabilities).
+
+ If you don't need crypting in your application, just define symbols
+ NOCRYPT and NOUNCRYPT.
+
+ This code support the "Traditional PKWARE Encryption".
+
+ The new AES encryption added on Zip format by Winzip (see the page
+ http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong
+ Encryption is not supported.
+*/
+
+#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8))
+
+/***********************************************************************
+ * Return the next byte in the pseudo-random sequence
+ */
+static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab)
+{
+ unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an
+ * unpredictable manner on 16-bit systems; not a problem
+ * with any known compiler so far, though */
+
+ temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2;
+ return (int)(((temp * (temp ^ 1)) >> 8) & 0xff);
+}
+
+/***********************************************************************
+ * Update the encryption keys with the next byte of plain text
+ */
+static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c)
+{
+ (*(pkeys+0)) = CRC32((*(pkeys+0)), c);
+ (*(pkeys+1)) += (*(pkeys+0)) & 0xff;
+ (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1;
+ {
+ register int keyshift = (int)((*(pkeys+1)) >> 24);
+ (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift);
+ }
+ return c;
+}
+
+
+/***********************************************************************
+ * Initialize the encryption keys and the random header according to
+ * the given password.
+ */
+static void init_keys(const char* passwd,unsigned long* pkeys,const z_crc_t* pcrc_32_tab)
+{
+ *(pkeys+0) = 305419896L;
+ *(pkeys+1) = 591751049L;
+ *(pkeys+2) = 878082192L;
+ while (*passwd != '\0') {
+ update_keys(pkeys,pcrc_32_tab,(int)*passwd);
+ passwd++;
+ }
+}
+
+#define zdecode(pkeys,pcrc_32_tab,c) \
+ (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab)))
+
+#define zencode(pkeys,pcrc_32_tab,c,t) \
+ (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), t^(c))
+
+#ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED
+
+#define RAND_HEAD_LEN 12
+ /* "last resort" source for second part of crypt seed pattern */
+# ifndef ZCR_SEED2
+# define ZCR_SEED2 3141592654UL /* use PI as default pattern */
+# endif
+
+static int crypthead(const char* passwd, /* password string */
+ unsigned char* buf, /* where to write header */
+ int bufSize,
+ unsigned long* pkeys,
+ const z_crc_t* pcrc_32_tab,
+ unsigned long crcForCrypting)
+{
+ int n; /* index in random header */
+ int t; /* temporary */
+ int c; /* random byte */
+ unsigned char header[RAND_HEAD_LEN-2]; /* random header */
+ static unsigned calls = 0; /* ensure different random header each time */
+
+ if (bufSize<RAND_HEAD_LEN)
+ return 0;
+
+ /* First generate RAND_HEAD_LEN-2 random bytes. We encrypt the
+ * output of rand() to get less predictability, since rand() is
+ * often poorly implemented.
+ */
+ if (++calls == 1)
+ {
+ srand((unsigned)(time(NULL) ^ ZCR_SEED2));
+ }
+ init_keys(passwd, pkeys, pcrc_32_tab);
+ for (n = 0; n < RAND_HEAD_LEN-2; n++)
+ {
+ c = (rand() >> 7) & 0xff;
+ header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t);
+ }
+ /* Encrypt random header (last two bytes is high word of crc) */
+ init_keys(passwd, pkeys, pcrc_32_tab);
+ for (n = 0; n < RAND_HEAD_LEN-2; n++)
+ {
+ buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t);
+ }
+ buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t);
+ buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t);
+ return n;
+}
+
+#endif
diff --git a/compat/zlib/contrib/minizip/ioapi.c b/compat/zlib/contrib/minizip/ioapi.c
new file mode 100644
index 0000000..7f5c191
--- /dev/null
+++ b/compat/zlib/contrib/minizip/ioapi.c
@@ -0,0 +1,247 @@
+/* ioapi.h -- IO base function header for compress/uncompress .zip
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+*/
+
+#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)
+{
+ if (pfilefunc->zfile_func64.zopen64_file != NULL)
+ return (*(pfilefunc->zfile_func64.zopen64_file)) (pfilefunc->zfile_func64.opaque,filename,mode);
+ else
+ {
+ return (*(pfilefunc->zopen32_file))(pfilefunc->zfile_func64.opaque,(const char*)filename,mode);
+ }
+}
+
+long call_zseek64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin)
+{
+ if (pfilefunc->zfile_func64.zseek64_file != NULL)
+ return (*(pfilefunc->zfile_func64.zseek64_file)) (pfilefunc->zfile_func64.opaque,filestream,offset,origin);
+ else
+ {
+ uLong offsetTruncated = (uLong)offset;
+ if (offsetTruncated != offset)
+ return -1;
+ else
+ return (*(pfilefunc->zseek32_file))(pfilefunc->zfile_func64.opaque,filestream,offsetTruncated,origin);
+ }
+}
+
+ZPOS64_T call_ztell64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream)
+{
+ if (pfilefunc->zfile_func64.zseek64_file != NULL)
+ return (*(pfilefunc->zfile_func64.ztell64_file)) (pfilefunc->zfile_func64.opaque,filestream);
+ else
+ {
+ uLong tell_uLong = (*(pfilefunc->ztell32_file))(pfilefunc->zfile_func64.opaque,filestream);
+ if ((tell_uLong) == MAXU32)
+ return (ZPOS64_T)-1;
+ else
+ return tell_uLong;
+ }
+}
+
+void fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32,const zlib_filefunc_def* p_filefunc32)
+{
+ p_filefunc64_32->zfile_func64.zopen64_file = NULL;
+ p_filefunc64_32->zopen32_file = p_filefunc32->zopen_file;
+ p_filefunc64_32->zfile_func64.zerror_file = p_filefunc32->zerror_file;
+ p_filefunc64_32->zfile_func64.zread_file = p_filefunc32->zread_file;
+ p_filefunc64_32->zfile_func64.zwrite_file = p_filefunc32->zwrite_file;
+ p_filefunc64_32->zfile_func64.ztell64_file = NULL;
+ p_filefunc64_32->zfile_func64.zseek64_file = NULL;
+ p_filefunc64_32->zfile_func64.zclose_file = p_filefunc32->zclose_file;
+ p_filefunc64_32->zfile_func64.zerror_file = p_filefunc32->zerror_file;
+ p_filefunc64_32->zfile_func64.opaque = p_filefunc32->opaque;
+ p_filefunc64_32->zseek32_file = p_filefunc32->zseek_file;
+ p_filefunc64_32->ztell32_file = p_filefunc32->ztell_file;
+}
+
+
+
+static voidpf ZCALLBACK fopen_file_func OF((voidpf opaque, const char* filename, int mode));
+static uLong ZCALLBACK fread_file_func OF((voidpf opaque, voidpf stream, void* buf, uLong size));
+static uLong ZCALLBACK fwrite_file_func OF((voidpf opaque, voidpf stream, const void* buf,uLong size));
+static ZPOS64_T ZCALLBACK ftell64_file_func OF((voidpf opaque, voidpf stream));
+static long ZCALLBACK fseek64_file_func OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
+static int ZCALLBACK fclose_file_func OF((voidpf opaque, voidpf stream));
+static int ZCALLBACK ferror_file_func OF((voidpf opaque, voidpf stream));
+
+static voidpf ZCALLBACK fopen_file_func (voidpf opaque, const char* filename, int mode)
+{
+ FILE* file = NULL;
+ const char* mode_fopen = NULL;
+ if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
+ mode_fopen = "rb";
+ else
+ if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
+ mode_fopen = "r+b";
+ else
+ if (mode & ZLIB_FILEFUNC_MODE_CREATE)
+ mode_fopen = "wb";
+
+ if ((filename!=NULL) && (mode_fopen != NULL))
+ file = fopen(filename, mode_fopen);
+ return file;
+}
+
+static voidpf ZCALLBACK fopen64_file_func (voidpf opaque, const void* filename, int mode)
+{
+ FILE* file = NULL;
+ const char* mode_fopen = NULL;
+ if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
+ mode_fopen = "rb";
+ else
+ if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
+ mode_fopen = "r+b";
+ else
+ if (mode & ZLIB_FILEFUNC_MODE_CREATE)
+ mode_fopen = "wb";
+
+ if ((filename!=NULL) && (mode_fopen != NULL))
+ file = FOPEN_FUNC((const char*)filename, mode_fopen);
+ return file;
+}
+
+
+static uLong ZCALLBACK fread_file_func (voidpf opaque, voidpf stream, void* buf, uLong size)
+{
+ uLong ret;
+ ret = (uLong)fread(buf, 1, (size_t)size, (FILE *)stream);
+ return ret;
+}
+
+static uLong ZCALLBACK fwrite_file_func (voidpf opaque, voidpf stream, const void* buf, uLong size)
+{
+ uLong ret;
+ ret = (uLong)fwrite(buf, 1, (size_t)size, (FILE *)stream);
+ return ret;
+}
+
+static long ZCALLBACK ftell_file_func (voidpf opaque, voidpf stream)
+{
+ long ret;
+ ret = ftell((FILE *)stream);
+ return ret;
+}
+
+
+static ZPOS64_T ZCALLBACK ftell64_file_func (voidpf opaque, voidpf stream)
+{
+ ZPOS64_T ret;
+ ret = FTELLO_FUNC((FILE *)stream);
+ return ret;
+}
+
+static long ZCALLBACK fseek_file_func (voidpf opaque, voidpf stream, uLong offset, int origin)
+{
+ int fseek_origin=0;
+ long ret;
+ switch (origin)
+ {
+ case ZLIB_FILEFUNC_SEEK_CUR :
+ fseek_origin = SEEK_CUR;
+ break;
+ case ZLIB_FILEFUNC_SEEK_END :
+ fseek_origin = SEEK_END;
+ break;
+ case ZLIB_FILEFUNC_SEEK_SET :
+ fseek_origin = SEEK_SET;
+ break;
+ default: return -1;
+ }
+ ret = 0;
+ if (fseek((FILE *)stream, offset, fseek_origin) != 0)
+ ret = -1;
+ return ret;
+}
+
+static long ZCALLBACK fseek64_file_func (voidpf opaque, voidpf stream, ZPOS64_T offset, int origin)
+{
+ int fseek_origin=0;
+ long ret;
+ switch (origin)
+ {
+ case ZLIB_FILEFUNC_SEEK_CUR :
+ fseek_origin = SEEK_CUR;
+ break;
+ case ZLIB_FILEFUNC_SEEK_END :
+ fseek_origin = SEEK_END;
+ break;
+ case ZLIB_FILEFUNC_SEEK_SET :
+ fseek_origin = SEEK_SET;
+ break;
+ default: return -1;
+ }
+ ret = 0;
+
+ if(FSEEKO_FUNC((FILE *)stream, offset, fseek_origin) != 0)
+ ret = -1;
+
+ return ret;
+}
+
+
+static int ZCALLBACK fclose_file_func (voidpf opaque, voidpf stream)
+{
+ int ret;
+ ret = fclose((FILE *)stream);
+ return ret;
+}
+
+static int ZCALLBACK ferror_file_func (voidpf opaque, voidpf stream)
+{
+ int ret;
+ ret = ferror((FILE *)stream);
+ return ret;
+}
+
+void fill_fopen_filefunc (pzlib_filefunc_def)
+ zlib_filefunc_def* pzlib_filefunc_def;
+{
+ pzlib_filefunc_def->zopen_file = fopen_file_func;
+ pzlib_filefunc_def->zread_file = fread_file_func;
+ pzlib_filefunc_def->zwrite_file = fwrite_file_func;
+ pzlib_filefunc_def->ztell_file = ftell_file_func;
+ pzlib_filefunc_def->zseek_file = fseek_file_func;
+ pzlib_filefunc_def->zclose_file = fclose_file_func;
+ pzlib_filefunc_def->zerror_file = ferror_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
+
+void fill_fopen64_filefunc (zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ pzlib_filefunc_def->zopen64_file = fopen64_file_func;
+ pzlib_filefunc_def->zread_file = fread_file_func;
+ pzlib_filefunc_def->zwrite_file = fwrite_file_func;
+ pzlib_filefunc_def->ztell64_file = ftell64_file_func;
+ pzlib_filefunc_def->zseek64_file = fseek64_file_func;
+ pzlib_filefunc_def->zclose_file = fclose_file_func;
+ pzlib_filefunc_def->zerror_file = ferror_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
diff --git a/compat/zlib/contrib/minizip/ioapi.h b/compat/zlib/contrib/minizip/ioapi.h
new file mode 100644
index 0000000..8dcbdb0
--- /dev/null
+++ b/compat/zlib/contrib/minizip/ioapi.h
@@ -0,0 +1,208 @@
+/* ioapi.h -- IO base function header for compress/uncompress .zip
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+ Changes
+
+ Oct-2009 - Defined ZPOS64_T to fpos_t on windows and u_int64_t on linux. (might need to find a better why for this)
+ Oct-2009 - Change to fseeko64, ftello64 and fopen64 so large files would work on linux.
+ More if/def section may be needed to support other platforms
+ Oct-2009 - Defined fxxxx64 calls to normal fopen/ftell/fseek so they would compile on windows.
+ (but you should use iowin32.c for windows instead)
+
+*/
+
+#ifndef _ZLIBIOAPI64_H
+#define _ZLIBIOAPI64_H
+
+#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.
+
+ #ifndef __USE_FILE_OFFSET64
+ #define __USE_FILE_OFFSET64
+ #endif
+ #ifndef __USE_LARGEFILE64
+ #define __USE_LARGEFILE64
+ #endif
+ #ifndef _LARGEFILE64_SOURCE
+ #define _LARGEFILE64_SOURCE
+ #endif
+ #ifndef _FILE_OFFSET_BIT
+ #define _FILE_OFFSET_BIT 64
+ #endif
+
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "zlib.h"
+
+#if defined(USE_FILE32API)
+#define fopen64 fopen
+#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)))
+ #define ftello64 _ftelli64
+ #define fseeko64 _fseeki64
+ #else // old MSC
+ #define ftello64 ftell
+ #define fseeko64 fseek
+ #endif
+#endif
+#endif
+
+/*
+#ifndef ZPOS64_T
+ #ifdef _WIN32
+ #define ZPOS64_T fpos_t
+ #else
+ #include <stdint.h>
+ #define ZPOS64_T uint64_t
+ #endif
+#endif
+*/
+
+#ifdef HAVE_MINIZIP64_CONF_H
+#include "mz64conf.h"
+#endif
+
+/* a type choosen by DEFINE */
+#ifdef HAVE_64BIT_INT_CUSTOM
+typedef 64BIT_INT_CUSTOM_TYPE ZPOS64_T;
+#else
+#ifdef HAS_STDINT_H
+#include "stdint.h"
+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;
+#else
+typedef unsigned long long int ZPOS64_T;
+#endif
+#endif
+#endif
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#define ZLIB_FILEFUNC_SEEK_CUR (1)
+#define ZLIB_FILEFUNC_SEEK_END (2)
+#define ZLIB_FILEFUNC_SEEK_SET (0)
+
+#define ZLIB_FILEFUNC_MODE_READ (1)
+#define ZLIB_FILEFUNC_MODE_WRITE (2)
+#define ZLIB_FILEFUNC_MODE_READWRITEFILTER (3)
+
+#define ZLIB_FILEFUNC_MODE_EXISTING (4)
+#define ZLIB_FILEFUNC_MODE_CREATE (8)
+
+
+#ifndef ZCALLBACK
+ #if (defined(WIN32) || defined(_WIN32) || defined (WINDOWS) || defined (_WINDOWS)) && defined(CALLBACK) && defined (USEWINDOWS_CALLBACK)
+ #define ZCALLBACK CALLBACK
+ #else
+ #define ZCALLBACK
+ #endif
+#endif
+
+
+
+
+typedef voidpf (ZCALLBACK *open_file_func) OF((voidpf opaque, const char* filename, int mode));
+typedef uLong (ZCALLBACK *read_file_func) OF((voidpf opaque, voidpf stream, void* buf, uLong size));
+typedef uLong (ZCALLBACK *write_file_func) OF((voidpf opaque, voidpf stream, const void* buf, uLong size));
+typedef int (ZCALLBACK *close_file_func) OF((voidpf opaque, voidpf stream));
+typedef int (ZCALLBACK *testerror_file_func) OF((voidpf opaque, voidpf stream));
+
+typedef long (ZCALLBACK *tell_file_func) OF((voidpf opaque, voidpf stream));
+typedef long (ZCALLBACK *seek_file_func) OF((voidpf opaque, voidpf stream, uLong offset, int origin));
+
+
+/* here is the "old" 32 bits structure structure */
+typedef struct zlib_filefunc_def_s
+{
+ open_file_func zopen_file;
+ read_file_func zread_file;
+ write_file_func zwrite_file;
+ tell_file_func ztell_file;
+ seek_file_func zseek_file;
+ close_file_func zclose_file;
+ testerror_file_func zerror_file;
+ voidpf opaque;
+} zlib_filefunc_def;
+
+typedef ZPOS64_T (ZCALLBACK *tell64_file_func) OF((voidpf opaque, voidpf stream));
+typedef long (ZCALLBACK *seek64_file_func) OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
+typedef voidpf (ZCALLBACK *open64_file_func) OF((voidpf opaque, const void* filename, int mode));
+
+typedef struct zlib_filefunc64_def_s
+{
+ open64_file_func zopen64_file;
+ read_file_func zread_file;
+ write_file_func zwrite_file;
+ tell64_file_func ztell64_file;
+ seek64_file_func zseek64_file;
+ close_file_func zclose_file;
+ testerror_file_func zerror_file;
+ voidpf opaque;
+} zlib_filefunc64_def;
+
+void fill_fopen64_filefunc OF((zlib_filefunc64_def* pzlib_filefunc_def));
+void fill_fopen_filefunc OF((zlib_filefunc_def* pzlib_filefunc_def));
+
+/* now internal definition, only for zip.c and unzip.h */
+typedef struct zlib_filefunc64_32_def_s
+{
+ zlib_filefunc64_def zfile_func64;
+ open_file_func zopen32_file;
+ tell_file_func ztell32_file;
+ seek_file_func zseek32_file;
+} zlib_filefunc64_32_def;
+
+
+#define ZREAD64(filefunc,filestream,buf,size) ((*((filefunc).zfile_func64.zread_file)) ((filefunc).zfile_func64.opaque,filestream,buf,size))
+#define ZWRITE64(filefunc,filestream,buf,size) ((*((filefunc).zfile_func64.zwrite_file)) ((filefunc).zfile_func64.opaque,filestream,buf,size))
+//#define ZTELL64(filefunc,filestream) ((*((filefunc).ztell64_file)) ((filefunc).opaque,filestream))
+//#define ZSEEK64(filefunc,filestream,pos,mode) ((*((filefunc).zseek64_file)) ((filefunc).opaque,filestream,pos,mode))
+#define ZCLOSE64(filefunc,filestream) ((*((filefunc).zfile_func64.zclose_file)) ((filefunc).zfile_func64.opaque,filestream))
+#define ZERROR64(filefunc,filestream) ((*((filefunc).zfile_func64.zerror_file)) ((filefunc).zfile_func64.opaque,filestream))
+
+voidpf call_zopen64 OF((const zlib_filefunc64_32_def* pfilefunc,const void*filename,int mode));
+long call_zseek64 OF((const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin));
+ZPOS64_T call_ztell64 OF((const zlib_filefunc64_32_def* pfilefunc,voidpf filestream));
+
+void fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32,const zlib_filefunc_def* p_filefunc32);
+
+#define ZOPEN64(filefunc,filename,mode) (call_zopen64((&(filefunc)),(filename),(mode)))
+#define ZTELL64(filefunc,filestream) (call_ztell64((&(filefunc)),(filestream)))
+#define ZSEEK64(filefunc,filestream,pos,mode) (call_zseek64((&(filefunc)),(filestream),(pos),(mode)))
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/compat/zlib/contrib/minizip/iowin32.c b/compat/zlib/contrib/minizip/iowin32.c
new file mode 100644
index 0000000..a46d96c
--- /dev/null
+++ b/compat/zlib/contrib/minizip/iowin32.c
@@ -0,0 +1,461 @@
+/* iowin32.c -- IO base function header for compress/uncompress .zip
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+*/
+
+#include <stdlib.h>
+
+#include "zlib.h"
+#include "ioapi.h"
+#include "iowin32.h"
+
+#ifndef INVALID_HANDLE_VALUE
+#define INVALID_HANDLE_VALUE (0xFFFFFFFF)
+#endif
+
+#ifndef INVALID_SET_FILE_POINTER
+#define INVALID_SET_FILE_POINTER ((DWORD)-1)
+#endif
+
+
+#if defined(WINAPI_FAMILY_PARTITION) && (!(defined(IOWIN32_USING_WINRT_API)))
+#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP)
+#define IOWIN32_USING_WINRT_API 1
+#endif
+#endif
+
+voidpf ZCALLBACK win32_open_file_func OF((voidpf opaque, const char* filename, int mode));
+uLong ZCALLBACK win32_read_file_func OF((voidpf opaque, voidpf stream, void* buf, uLong size));
+uLong ZCALLBACK win32_write_file_func OF((voidpf opaque, voidpf stream, const void* buf, uLong size));
+ZPOS64_T ZCALLBACK win32_tell64_file_func OF((voidpf opaque, voidpf stream));
+long ZCALLBACK win32_seek64_file_func OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
+int ZCALLBACK win32_close_file_func OF((voidpf opaque, voidpf stream));
+int ZCALLBACK win32_error_file_func OF((voidpf opaque, voidpf stream));
+
+typedef struct
+{
+ HANDLE hf;
+ int error;
+} WIN32FILE_IOWIN;
+
+
+static void win32_translate_open_mode(int mode,
+ DWORD* lpdwDesiredAccess,
+ DWORD* lpdwCreationDisposition,
+ DWORD* lpdwShareMode,
+ DWORD* lpdwFlagsAndAttributes)
+{
+ *lpdwDesiredAccess = *lpdwShareMode = *lpdwFlagsAndAttributes = *lpdwCreationDisposition = 0;
+
+ if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
+ {
+ *lpdwDesiredAccess = GENERIC_READ;
+ *lpdwCreationDisposition = OPEN_EXISTING;
+ *lpdwShareMode = FILE_SHARE_READ;
+ }
+ else if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
+ {
+ *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ;
+ *lpdwCreationDisposition = OPEN_EXISTING;
+ }
+ else if (mode & ZLIB_FILEFUNC_MODE_CREATE)
+ {
+ *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ;
+ *lpdwCreationDisposition = CREATE_ALWAYS;
+ }
+}
+
+static voidpf win32_build_iowin(HANDLE hFile)
+{
+ voidpf ret=NULL;
+
+ if ((hFile != NULL) && (hFile != INVALID_HANDLE_VALUE))
+ {
+ WIN32FILE_IOWIN w32fiow;
+ w32fiow.hf = hFile;
+ w32fiow.error = 0;
+ ret = malloc(sizeof(WIN32FILE_IOWIN));
+
+ if (ret==NULL)
+ CloseHandle(hFile);
+ else
+ *((WIN32FILE_IOWIN*)ret) = w32fiow;
+ }
+ return ret;
+}
+
+voidpf ZCALLBACK win32_open64_file_func (voidpf opaque,const void* filename,int mode)
+{
+ const char* mode_fopen = NULL;
+ DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
+ HANDLE hFile = NULL;
+
+ win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);
+
+#ifdef IOWIN32_USING_WINRT_API
+#ifdef UNICODE
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ {
+ WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
+ MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
+ hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
+ }
+#endif
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
+#endif
+
+ return win32_build_iowin(hFile);
+}
+
+
+voidpf ZCALLBACK win32_open64_file_funcA (voidpf opaque,const void* filename,int mode)
+{
+ const char* mode_fopen = NULL;
+ DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
+ HANDLE hFile = NULL;
+
+ win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);
+
+#ifdef IOWIN32_USING_WINRT_API
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ {
+ WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
+ MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
+ hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
+ }
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFileA((LPCSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
+#endif
+
+ return win32_build_iowin(hFile);
+}
+
+
+voidpf ZCALLBACK win32_open64_file_funcW (voidpf opaque,const void* filename,int mode)
+{
+ const char* mode_fopen = NULL;
+ DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
+ HANDLE hFile = NULL;
+
+ win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);
+
+#ifdef IOWIN32_USING_WINRT_API
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFile2((LPCWSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition,NULL);
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFileW((LPCWSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
+#endif
+
+ return win32_build_iowin(hFile);
+}
+
+
+voidpf ZCALLBACK win32_open_file_func (voidpf opaque,const char* filename,int mode)
+{
+ const char* mode_fopen = NULL;
+ DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
+ HANDLE hFile = NULL;
+
+ win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);
+
+#ifdef IOWIN32_USING_WINRT_API
+#ifdef UNICODE
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ {
+ WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
+ MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
+ hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
+ }
+#endif
+#else
+ if ((filename!=NULL) && (dwDesiredAccess != 0))
+ hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
+#endif
+
+ return win32_build_iowin(hFile);
+}
+
+
+uLong ZCALLBACK win32_read_file_func (voidpf opaque, voidpf stream, void* buf,uLong size)
+{
+ uLong ret=0;
+ HANDLE hFile = NULL;
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
+
+ if (hFile != NULL)
+ {
+ if (!ReadFile(hFile, buf, size, &ret, NULL))
+ {
+ DWORD dwErr = GetLastError();
+ if (dwErr == ERROR_HANDLE_EOF)
+ dwErr = 0;
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ }
+ }
+
+ return ret;
+}
+
+
+uLong ZCALLBACK win32_write_file_func (voidpf opaque,voidpf stream,const void* buf,uLong size)
+{
+ uLong ret=0;
+ HANDLE hFile = NULL;
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
+
+ if (hFile != NULL)
+ {
+ if (!WriteFile(hFile, buf, size, &ret, NULL))
+ {
+ DWORD dwErr = GetLastError();
+ if (dwErr == ERROR_HANDLE_EOF)
+ dwErr = 0;
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ }
+ }
+
+ return ret;
+}
+
+static BOOL MySetFilePointerEx(HANDLE hFile, LARGE_INTEGER pos, LARGE_INTEGER *newPos, DWORD dwMoveMethod)
+{
+#ifdef IOWIN32_USING_WINRT_API
+ return SetFilePointerEx(hFile, pos, newPos, dwMoveMethod);
+#else
+ LONG lHigh = pos.HighPart;
+ DWORD dwNewPos = SetFilePointer(hFile, pos.LowPart, &lHigh, FILE_CURRENT);
+ BOOL fOk = TRUE;
+ if (dwNewPos == 0xFFFFFFFF)
+ if (GetLastError() != NO_ERROR)
+ fOk = FALSE;
+ if ((newPos != NULL) && (fOk))
+ {
+ newPos->LowPart = dwNewPos;
+ newPos->HighPart = lHigh;
+ }
+ return fOk;
+#endif
+}
+
+long ZCALLBACK win32_tell_file_func (voidpf opaque,voidpf stream)
+{
+ long ret=-1;
+ HANDLE hFile = NULL;
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
+ if (hFile != NULL)
+ {
+ LARGE_INTEGER pos;
+ pos.QuadPart = 0;
+
+ if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT))
+ {
+ DWORD dwErr = GetLastError();
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ ret = -1;
+ }
+ else
+ ret=(long)pos.LowPart;
+ }
+ return ret;
+}
+
+ZPOS64_T ZCALLBACK win32_tell64_file_func (voidpf opaque, voidpf stream)
+{
+ ZPOS64_T ret= (ZPOS64_T)-1;
+ HANDLE hFile = NULL;
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream)->hf;
+
+ if (hFile)
+ {
+ LARGE_INTEGER pos;
+ pos.QuadPart = 0;
+
+ if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT))
+ {
+ DWORD dwErr = GetLastError();
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ ret = (ZPOS64_T)-1;
+ }
+ else
+ ret=pos.QuadPart;
+ }
+ return ret;
+}
+
+
+long ZCALLBACK win32_seek_file_func (voidpf opaque,voidpf stream,uLong offset,int origin)
+{
+ DWORD dwMoveMethod=0xFFFFFFFF;
+ HANDLE hFile = NULL;
+
+ long ret=-1;
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
+ switch (origin)
+ {
+ case ZLIB_FILEFUNC_SEEK_CUR :
+ dwMoveMethod = FILE_CURRENT;
+ break;
+ case ZLIB_FILEFUNC_SEEK_END :
+ dwMoveMethod = FILE_END;
+ break;
+ case ZLIB_FILEFUNC_SEEK_SET :
+ dwMoveMethod = FILE_BEGIN;
+ break;
+ default: return -1;
+ }
+
+ if (hFile != NULL)
+ {
+ LARGE_INTEGER pos;
+ pos.QuadPart = offset;
+ if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod))
+ {
+ DWORD dwErr = GetLastError();
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ ret = -1;
+ }
+ else
+ ret=0;
+ }
+ return ret;
+}
+
+long ZCALLBACK win32_seek64_file_func (voidpf opaque, voidpf stream,ZPOS64_T offset,int origin)
+{
+ DWORD dwMoveMethod=0xFFFFFFFF;
+ HANDLE hFile = NULL;
+ long ret=-1;
+
+ if (stream!=NULL)
+ hFile = ((WIN32FILE_IOWIN*)stream)->hf;
+
+ switch (origin)
+ {
+ case ZLIB_FILEFUNC_SEEK_CUR :
+ dwMoveMethod = FILE_CURRENT;
+ break;
+ case ZLIB_FILEFUNC_SEEK_END :
+ dwMoveMethod = FILE_END;
+ break;
+ case ZLIB_FILEFUNC_SEEK_SET :
+ dwMoveMethod = FILE_BEGIN;
+ break;
+ default: return -1;
+ }
+
+ if (hFile)
+ {
+ LARGE_INTEGER pos;
+ pos.QuadPart = offset;
+ if (!MySetFilePointerEx(hFile, pos, NULL, FILE_CURRENT))
+ {
+ DWORD dwErr = GetLastError();
+ ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
+ ret = -1;
+ }
+ else
+ ret=0;
+ }
+ return ret;
+}
+
+int ZCALLBACK win32_close_file_func (voidpf opaque, voidpf stream)
+{
+ int ret=-1;
+
+ if (stream!=NULL)
+ {
+ HANDLE hFile;
+ hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
+ if (hFile != NULL)
+ {
+ CloseHandle(hFile);
+ ret=0;
+ }
+ free(stream);
+ }
+ return ret;
+}
+
+int ZCALLBACK win32_error_file_func (voidpf opaque,voidpf stream)
+{
+ int ret=-1;
+ if (stream!=NULL)
+ {
+ ret = ((WIN32FILE_IOWIN*)stream) -> error;
+ }
+ return ret;
+}
+
+void fill_win32_filefunc (zlib_filefunc_def* pzlib_filefunc_def)
+{
+ pzlib_filefunc_def->zopen_file = win32_open_file_func;
+ pzlib_filefunc_def->zread_file = win32_read_file_func;
+ pzlib_filefunc_def->zwrite_file = win32_write_file_func;
+ pzlib_filefunc_def->ztell_file = win32_tell_file_func;
+ pzlib_filefunc_def->zseek_file = win32_seek_file_func;
+ pzlib_filefunc_def->zclose_file = win32_close_file_func;
+ pzlib_filefunc_def->zerror_file = win32_error_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
+
+void fill_win32_filefunc64(zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ pzlib_filefunc_def->zopen64_file = win32_open64_file_func;
+ pzlib_filefunc_def->zread_file = win32_read_file_func;
+ pzlib_filefunc_def->zwrite_file = win32_write_file_func;
+ pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
+ pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
+ pzlib_filefunc_def->zclose_file = win32_close_file_func;
+ pzlib_filefunc_def->zerror_file = win32_error_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
+
+
+void fill_win32_filefunc64A(zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ pzlib_filefunc_def->zopen64_file = win32_open64_file_funcA;
+ pzlib_filefunc_def->zread_file = win32_read_file_func;
+ pzlib_filefunc_def->zwrite_file = win32_write_file_func;
+ pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
+ pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
+ pzlib_filefunc_def->zclose_file = win32_close_file_func;
+ pzlib_filefunc_def->zerror_file = win32_error_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
+
+
+void fill_win32_filefunc64W(zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ pzlib_filefunc_def->zopen64_file = win32_open64_file_funcW;
+ pzlib_filefunc_def->zread_file = win32_read_file_func;
+ pzlib_filefunc_def->zwrite_file = win32_write_file_func;
+ pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
+ pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
+ pzlib_filefunc_def->zclose_file = win32_close_file_func;
+ pzlib_filefunc_def->zerror_file = win32_error_file_func;
+ pzlib_filefunc_def->opaque = NULL;
+}
diff --git a/compat/zlib/contrib/minizip/iowin32.h b/compat/zlib/contrib/minizip/iowin32.h
new file mode 100644
index 0000000..0ca0969
--- /dev/null
+++ b/compat/zlib/contrib/minizip/iowin32.h
@@ -0,0 +1,28 @@
+/* iowin32.h -- IO base function header for compress/uncompress .zip
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+*/
+
+#include <windows.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void fill_win32_filefunc OF((zlib_filefunc_def* pzlib_filefunc_def));
+void fill_win32_filefunc64 OF((zlib_filefunc64_def* pzlib_filefunc_def));
+void fill_win32_filefunc64A OF((zlib_filefunc64_def* pzlib_filefunc_def));
+void fill_win32_filefunc64W OF((zlib_filefunc64_def* pzlib_filefunc_def));
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/compat/zlib/contrib/minizip/make_vms.com b/compat/zlib/contrib/minizip/make_vms.com
new file mode 100644
index 0000000..9ac13a9
--- /dev/null
+++ b/compat/zlib/contrib/minizip/make_vms.com
@@ -0,0 +1,25 @@
+$ if f$search("ioapi.h_orig") .eqs. "" then copy ioapi.h ioapi.h_orig
+$ open/write zdef vmsdefs.h
+$ copy sys$input: zdef
+$ deck
+#define unix
+#define fill_zlib_filefunc64_32_def_from_filefunc32 fillzffunc64from
+#define Write_Zip64EndOfCentralDirectoryLocator Write_Zip64EoDLocator
+#define Write_Zip64EndOfCentralDirectoryRecord Write_Zip64EoDRecord
+#define Write_EndOfCentralDirectoryRecord Write_EoDRecord
+$ eod
+$ close zdef
+$ copy vmsdefs.h,ioapi.h_orig ioapi.h
+$ cc/include=[--]/prefix=all ioapi.c
+$ cc/include=[--]/prefix=all miniunz.c
+$ cc/include=[--]/prefix=all unzip.c
+$ cc/include=[--]/prefix=all minizip.c
+$ cc/include=[--]/prefix=all zip.c
+$ link miniunz,unzip,ioapi,[--]libz.olb/lib
+$ link minizip,zip,ioapi,[--]libz.olb/lib
+$ mcr []minizip test minizip_info.txt
+$ mcr []miniunz -l test.zip
+$ rename minizip_info.txt; minizip_info.txt_old
+$ mcr []miniunz test.zip
+$ delete test.zip;*
+$exit
diff --git a/compat/zlib/contrib/minizip/miniunz.c b/compat/zlib/contrib/minizip/miniunz.c
new file mode 100644
index 0000000..3d65401
--- /dev/null
+++ b/compat/zlib/contrib/minizip/miniunz.c
@@ -0,0 +1,660 @@
+/*
+ miniunz.c
+ Version 1.1, February 14h, 2010
+ sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications of Unzip for Zip64
+ Copyright (C) 2007-2008 Even Rouault
+
+ Modifications for Zip64 support on both zip and unzip
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+*/
+
+#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
+ #ifndef __USE_FILE_OFFSET64
+ #define __USE_FILE_OFFSET64
+ #endif
+ #ifndef __USE_LARGEFILE64
+ #define __USE_LARGEFILE64
+ #endif
+ #ifndef _LARGEFILE64_SOURCE
+ #define _LARGEFILE64_SOURCE
+ #endif
+ #ifndef _FILE_OFFSET_BIT
+ #define _FILE_OFFSET_BIT 64
+ #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>
+#include <time.h>
+#include <errno.h>
+#include <fcntl.h>
+
+#ifdef _WIN32
+# include <direct.h>
+# include <io.h>
+#else
+# include <unistd.h>
+# include <utime.h>
+#endif
+
+
+#include "unzip.h"
+
+#define CASESENSITIVITY (0)
+#define WRITEBUFFERSIZE (8192)
+#define MAXFILENAME (256)
+
+#ifdef _WIN32
+#define USEWIN32IOAPI
+#include "iowin32.h"
+#endif
+/*
+ mini unzip, demo of unzip package
+
+ usage :
+ Usage : miniunz [-exvlo] file.zip [file_to_extract] [-d extractdir]
+
+ list the file in the zipfile, and print the content of FILE_ID.ZIP or README.TXT
+ if it exists
+*/
+
+
+/* change_file_date : change the date/time of a file
+ filename : the filename of the file where date/time must be modified
+ dosdate : the new date at the MSDos format (4 bytes)
+ tmu_date : the SAME new date at the tm_unz format */
+void change_file_date(filename,dosdate,tmu_date)
+ const char *filename;
+ uLong dosdate;
+ tm_unz tmu_date;
+{
+#ifdef _WIN32
+ HANDLE hFile;
+ FILETIME ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite;
+
+ hFile = CreateFileA(filename,GENERIC_READ | GENERIC_WRITE,
+ 0,NULL,OPEN_EXISTING,0,NULL);
+ GetFileTime(hFile,&ftCreate,&ftLastAcc,&ftLastWrite);
+ DosDateTimeToFileTime((WORD)(dosdate>>16),(WORD)dosdate,&ftLocal);
+ LocalFileTimeToFileTime(&ftLocal,&ftm);
+ SetFileTime(hFile,&ftm,&ftLastAcc,&ftm);
+ CloseHandle(hFile);
+#else
+#ifdef unix || __APPLE__
+ struct utimbuf ut;
+ struct tm newdate;
+ newdate.tm_sec = tmu_date.tm_sec;
+ newdate.tm_min=tmu_date.tm_min;
+ newdate.tm_hour=tmu_date.tm_hour;
+ newdate.tm_mday=tmu_date.tm_mday;
+ newdate.tm_mon=tmu_date.tm_mon;
+ if (tmu_date.tm_year > 1900)
+ newdate.tm_year=tmu_date.tm_year - 1900;
+ else
+ newdate.tm_year=tmu_date.tm_year ;
+ newdate.tm_isdst=-1;
+
+ ut.actime=ut.modtime=mktime(&newdate);
+ utime(filename,&ut);
+#endif
+#endif
+}
+
+
+/* mymkdir and change_file_date are not 100 % portable
+ As I don't know well Unix, I wait feedback for the unix portion */
+
+int mymkdir(dirname)
+ const char* dirname;
+{
+ int ret=0;
+#ifdef _WIN32
+ ret = _mkdir(dirname);
+#elif unix
+ ret = mkdir (dirname,0775);
+#elif __APPLE__
+ ret = mkdir (dirname,0775);
+#endif
+ return ret;
+}
+
+int makedir (newdir)
+ char *newdir;
+{
+ char *buffer ;
+ char *p;
+ int len = (int)strlen(newdir);
+
+ if (len <= 0)
+ return 0;
+
+ buffer = (char*)malloc(len+1);
+ if (buffer==NULL)
+ {
+ printf("Error allocating memory\n");
+ return UNZ_INTERNALERROR;
+ }
+ strcpy(buffer,newdir);
+
+ if (buffer[len-1] == '/') {
+ buffer[len-1] = '\0';
+ }
+ if (mymkdir(buffer) == 0)
+ {
+ free(buffer);
+ return 1;
+ }
+
+ p = buffer+1;
+ while (1)
+ {
+ char hold;
+
+ while(*p && *p != '\\' && *p != '/')
+ p++;
+ hold = *p;
+ *p = 0;
+ if ((mymkdir(buffer) == -1) && (errno == ENOENT))
+ {
+ printf("couldn't create directory %s\n",buffer);
+ free(buffer);
+ return 0;
+ }
+ if (hold == 0)
+ break;
+ *p++ = hold;
+ }
+ free(buffer);
+ return 1;
+}
+
+void do_banner()
+{
+ printf("MiniUnz 1.01b, demo of zLib + Unz package written by Gilles Vollant\n");
+ printf("more info at http://www.winimage.com/zLibDll/unzip.html\n\n");
+}
+
+void do_help()
+{
+ printf("Usage : miniunz [-e] [-x] [-v] [-l] [-o] [-p password] file.zip [file_to_extr.] [-d extractdir]\n\n" \
+ " -e Extract without pathname (junk paths)\n" \
+ " -x Extract with pathname\n" \
+ " -v list files\n" \
+ " -l list files\n" \
+ " -d directory to extract into\n" \
+ " -o overwrite files without prompting\n" \
+ " -p extract crypted file using password\n\n");
+}
+
+void Display64BitsSize(ZPOS64_T n, int size_char)
+{
+ /* to avoid compatibility problem , we do here the conversion */
+ char number[21];
+ int offset=19;
+ int pos_string = 19;
+ number[20]=0;
+ for (;;) {
+ number[offset]=(char)((n%10)+'0');
+ if (number[offset] != '0')
+ pos_string=offset;
+ n/=10;
+ if (offset==0)
+ break;
+ offset--;
+ }
+ {
+ int size_display_string = 19-pos_string;
+ while (size_char > size_display_string)
+ {
+ size_char--;
+ printf(" ");
+ }
+ }
+
+ printf("%s",&number[pos_string]);
+}
+
+int do_list(uf)
+ unzFile uf;
+{
+ uLong i;
+ unz_global_info64 gi;
+ int err;
+
+ err = unzGetGlobalInfo64(uf,&gi);
+ if (err!=UNZ_OK)
+ printf("error %d with zipfile in unzGetGlobalInfo \n",err);
+ printf(" Length Method Size Ratio Date Time CRC-32 Name\n");
+ printf(" ------ ------ ---- ----- ---- ---- ------ ----\n");
+ for (i=0;i<gi.number_entry;i++)
+ {
+ char filename_inzip[256];
+ unz_file_info64 file_info;
+ uLong ratio=0;
+ const char *string_method;
+ char charCrypt=' ';
+ err = unzGetCurrentFileInfo64(uf,&file_info,filename_inzip,sizeof(filename_inzip),NULL,0,NULL,0);
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzGetCurrentFileInfo\n",err);
+ break;
+ }
+ if (file_info.uncompressed_size>0)
+ ratio = (uLong)((file_info.compressed_size*100)/file_info.uncompressed_size);
+
+ /* display a '*' if the file is crypted */
+ if ((file_info.flag & 1) != 0)
+ charCrypt='*';
+
+ if (file_info.compression_method==0)
+ string_method="Stored";
+ else
+ if (file_info.compression_method==Z_DEFLATED)
+ {
+ uInt iLevel=(uInt)((file_info.flag & 0x6)/2);
+ if (iLevel==0)
+ string_method="Defl:N";
+ else if (iLevel==1)
+ string_method="Defl:X";
+ else if ((iLevel==2) || (iLevel==3))
+ string_method="Defl:F"; /* 2:fast , 3 : extra fast*/
+ }
+ else
+ if (file_info.compression_method==Z_BZIP2ED)
+ {
+ string_method="BZip2 ";
+ }
+ else
+ string_method="Unkn. ";
+
+ Display64BitsSize(file_info.uncompressed_size,7);
+ printf(" %6s%c",string_method,charCrypt);
+ Display64BitsSize(file_info.compressed_size,7);
+ printf(" %3lu%% %2.2lu-%2.2lu-%2.2lu %2.2lu:%2.2lu %8.8lx %s\n",
+ ratio,
+ (uLong)file_info.tmu_date.tm_mon + 1,
+ (uLong)file_info.tmu_date.tm_mday,
+ (uLong)file_info.tmu_date.tm_year % 100,
+ (uLong)file_info.tmu_date.tm_hour,(uLong)file_info.tmu_date.tm_min,
+ (uLong)file_info.crc,filename_inzip);
+ if ((i+1)<gi.number_entry)
+ {
+ err = unzGoToNextFile(uf);
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzGoToNextFile\n",err);
+ break;
+ }
+ }
+ }
+
+ return 0;
+}
+
+
+int do_extract_currentfile(uf,popt_extract_without_path,popt_overwrite,password)
+ unzFile uf;
+ const int* popt_extract_without_path;
+ int* popt_overwrite;
+ const char* password;
+{
+ char filename_inzip[256];
+ char* filename_withoutpath;
+ char* p;
+ int err=UNZ_OK;
+ FILE *fout=NULL;
+ void* buf;
+ uInt size_buf;
+
+ unz_file_info64 file_info;
+ uLong ratio=0;
+ err = unzGetCurrentFileInfo64(uf,&file_info,filename_inzip,sizeof(filename_inzip),NULL,0,NULL,0);
+
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzGetCurrentFileInfo\n",err);
+ return err;
+ }
+
+ size_buf = WRITEBUFFERSIZE;
+ buf = (void*)malloc(size_buf);
+ if (buf==NULL)
+ {
+ printf("Error allocating memory\n");
+ return UNZ_INTERNALERROR;
+ }
+
+ p = filename_withoutpath = filename_inzip;
+ while ((*p) != '\0')
+ {
+ if (((*p)=='/') || ((*p)=='\\'))
+ filename_withoutpath = p+1;
+ p++;
+ }
+
+ if ((*filename_withoutpath)=='\0')
+ {
+ if ((*popt_extract_without_path)==0)
+ {
+ printf("creating directory: %s\n",filename_inzip);
+ mymkdir(filename_inzip);
+ }
+ }
+ else
+ {
+ const char* write_filename;
+ int skip=0;
+
+ if ((*popt_extract_without_path)==0)
+ write_filename = filename_inzip;
+ else
+ write_filename = filename_withoutpath;
+
+ err = unzOpenCurrentFilePassword(uf,password);
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzOpenCurrentFilePassword\n",err);
+ }
+
+ if (((*popt_overwrite)==0) && (err==UNZ_OK))
+ {
+ char rep=0;
+ FILE* ftestexist;
+ ftestexist = FOPEN_FUNC(write_filename,"rb");
+ if (ftestexist!=NULL)
+ {
+ fclose(ftestexist);
+ do
+ {
+ char answer[128];
+ int ret;
+
+ printf("The file %s exists. Overwrite ? [y]es, [n]o, [A]ll: ",write_filename);
+ ret = scanf("%1s",answer);
+ if (ret != 1)
+ {
+ exit(EXIT_FAILURE);
+ }
+ rep = answer[0] ;
+ if ((rep>='a') && (rep<='z'))
+ rep -= 0x20;
+ }
+ while ((rep!='Y') && (rep!='N') && (rep!='A'));
+ }
+
+ if (rep == 'N')
+ skip = 1;
+
+ if (rep == 'A')
+ *popt_overwrite=1;
+ }
+
+ if ((skip==0) && (err==UNZ_OK))
+ {
+ 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))
+ {
+ char c=*(filename_withoutpath-1);
+ *(filename_withoutpath-1)='\0';
+ makedir(write_filename);
+ *(filename_withoutpath-1)=c;
+ fout=FOPEN_FUNC(write_filename,"wb");
+ }
+
+ if (fout==NULL)
+ {
+ printf("error opening %s\n",write_filename);
+ }
+ }
+
+ if (fout!=NULL)
+ {
+ printf(" extracting: %s\n",write_filename);
+
+ do
+ {
+ err = unzReadCurrentFile(uf,buf,size_buf);
+ if (err<0)
+ {
+ printf("error %d with zipfile in unzReadCurrentFile\n",err);
+ break;
+ }
+ if (err>0)
+ if (fwrite(buf,err,1,fout)!=1)
+ {
+ printf("error in writing extracted file\n");
+ err=UNZ_ERRNO;
+ break;
+ }
+ }
+ while (err>0);
+ if (fout)
+ fclose(fout);
+
+ if (err==0)
+ change_file_date(write_filename,file_info.dosDate,
+ file_info.tmu_date);
+ }
+
+ if (err==UNZ_OK)
+ {
+ err = unzCloseCurrentFile (uf);
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzCloseCurrentFile\n",err);
+ }
+ }
+ else
+ unzCloseCurrentFile(uf); /* don't lose the error */
+ }
+
+ free(buf);
+ return err;
+}
+
+
+int do_extract(uf,opt_extract_without_path,opt_overwrite,password)
+ unzFile uf;
+ int opt_extract_without_path;
+ int opt_overwrite;
+ const char* password;
+{
+ uLong i;
+ unz_global_info64 gi;
+ int err;
+ FILE* fout=NULL;
+
+ err = unzGetGlobalInfo64(uf,&gi);
+ if (err!=UNZ_OK)
+ printf("error %d with zipfile in unzGetGlobalInfo \n",err);
+
+ for (i=0;i<gi.number_entry;i++)
+ {
+ if (do_extract_currentfile(uf,&opt_extract_without_path,
+ &opt_overwrite,
+ password) != UNZ_OK)
+ break;
+
+ if ((i+1)<gi.number_entry)
+ {
+ err = unzGoToNextFile(uf);
+ if (err!=UNZ_OK)
+ {
+ printf("error %d with zipfile in unzGoToNextFile\n",err);
+ break;
+ }
+ }
+ }
+
+ return 0;
+}
+
+int do_extract_onefile(uf,filename,opt_extract_without_path,opt_overwrite,password)
+ unzFile uf;
+ const char* filename;
+ int opt_extract_without_path;
+ int opt_overwrite;
+ const char* password;
+{
+ int err = UNZ_OK;
+ if (unzLocateFile(uf,filename,CASESENSITIVITY)!=UNZ_OK)
+ {
+ printf("file %s not found in the zipfile\n",filename);
+ return 2;
+ }
+
+ if (do_extract_currentfile(uf,&opt_extract_without_path,
+ &opt_overwrite,
+ password) == UNZ_OK)
+ return 0;
+ else
+ return 1;
+}
+
+
+int main(argc,argv)
+ int argc;
+ char *argv[];
+{
+ const char *zipfilename=NULL;
+ const char *filename_to_extract=NULL;
+ const char *password=NULL;
+ char filename_try[MAXFILENAME+16] = "";
+ int i;
+ int ret_value=0;
+ int opt_do_list=0;
+ int opt_do_extract=1;
+ int opt_do_extract_withoutpath=0;
+ int opt_overwrite=0;
+ int opt_extractdir=0;
+ const char *dirname=NULL;
+ unzFile uf=NULL;
+
+ do_banner();
+ if (argc==1)
+ {
+ do_help();
+ return 0;
+ }
+ else
+ {
+ for (i=1;i<argc;i++)
+ {
+ if ((*argv[i])=='-')
+ {
+ const char *p=argv[i]+1;
+
+ while ((*p)!='\0')
+ {
+ char c=*(p++);;
+ if ((c=='l') || (c=='L'))
+ opt_do_list = 1;
+ if ((c=='v') || (c=='V'))
+ opt_do_list = 1;
+ if ((c=='x') || (c=='X'))
+ opt_do_extract = 1;
+ if ((c=='e') || (c=='E'))
+ opt_do_extract = opt_do_extract_withoutpath = 1;
+ if ((c=='o') || (c=='O'))
+ opt_overwrite=1;
+ if ((c=='d') || (c=='D'))
+ {
+ opt_extractdir=1;
+ dirname=argv[i+1];
+ }
+
+ if (((c=='p') || (c=='P')) && (i+1<argc))
+ {
+ password=argv[i+1];
+ i++;
+ }
+ }
+ }
+ else
+ {
+ if (zipfilename == NULL)
+ zipfilename = argv[i];
+ else if ((filename_to_extract==NULL) && (!opt_extractdir))
+ filename_to_extract = argv[i] ;
+ }
+ }
+ }
+
+ if (zipfilename!=NULL)
+ {
+
+# ifdef USEWIN32IOAPI
+ zlib_filefunc64_def ffunc;
+# endif
+
+ strncpy(filename_try, zipfilename,MAXFILENAME-1);
+ /* strncpy doesnt append the trailing NULL, of the string is too long. */
+ filename_try[ MAXFILENAME ] = '\0';
+
+# ifdef USEWIN32IOAPI
+ fill_win32_filefunc64A(&ffunc);
+ uf = unzOpen2_64(zipfilename,&ffunc);
+# else
+ uf = unzOpen64(zipfilename);
+# endif
+ if (uf==NULL)
+ {
+ strcat(filename_try,".zip");
+# ifdef USEWIN32IOAPI
+ uf = unzOpen2_64(filename_try,&ffunc);
+# else
+ uf = unzOpen64(filename_try);
+# endif
+ }
+ }
+
+ if (uf==NULL)
+ {
+ printf("Cannot open %s or %s.zip\n",zipfilename,zipfilename);
+ return 1;
+ }
+ printf("%s opened\n",filename_try);
+
+ if (opt_do_list==1)
+ ret_value = do_list(uf);
+ else if (opt_do_extract==1)
+ {
+#ifdef _WIN32
+ if (opt_extractdir && _chdir(dirname))
+#else
+ if (opt_extractdir && chdir(dirname))
+#endif
+ {
+ printf("Error changing into %s, aborting\n", dirname);
+ exit(-1);
+ }
+
+ if (filename_to_extract == NULL)
+ ret_value = do_extract(uf, opt_do_extract_withoutpath, opt_overwrite, password);
+ else
+ ret_value = do_extract_onefile(uf, filename_to_extract, opt_do_extract_withoutpath, opt_overwrite, password);
+ }
+
+ unzClose(uf);
+
+ return ret_value;
+}
diff --git a/compat/zlib/contrib/minizip/miniunzip.1 b/compat/zlib/contrib/minizip/miniunzip.1
new file mode 100644
index 0000000..111ac69
--- /dev/null
+++ b/compat/zlib/contrib/minizip/miniunzip.1
@@ -0,0 +1,63 @@
+.\" Hey, EMACS: -*- nroff -*-
+.TH miniunzip 1 "Nov 7, 2001"
+.\" Please adjust this date whenever revising the manpage.
+.\"
+.\" Some roff macros, for reference:
+.\" .nh disable hyphenation
+.\" .hy enable hyphenation
+.\" .ad l left justify
+.\" .ad b justify to both left and right margins
+.\" .nf disable filling
+.\" .fi enable filling
+.\" .br insert line break
+.\" .sp <n> insert n+1 empty lines
+.\" for manpage-specific macros, see man(7)
+.SH NAME
+miniunzip - uncompress and examine ZIP archives
+.SH SYNOPSIS
+.B miniunzip
+.RI [ -exvlo ]
+zipfile [ files_to_extract ] [-d tempdir]
+.SH DESCRIPTION
+.B minizip
+is a simple tool which allows the extraction of compressed file
+archives in the ZIP format used by the MS-DOS utility PKZIP. It was
+written as a demonstration of the
+.IR zlib (3)
+library and therefore lack many of the features of the
+.IR unzip (1)
+program.
+.SH OPTIONS
+A number of options are supported. With the exception of
+.BI \-d\ tempdir
+these must be supplied before any
+other arguments and are:
+.TP
+.BI \-l\ ,\ \-\-v
+List the files in the archive without extracting them.
+.TP
+.B \-o
+Overwrite files without prompting for confirmation.
+.TP
+.B \-x
+Extract files (default).
+.PP
+The
+.I zipfile
+argument is the name of the archive to process. The next argument can be used
+to specify a single file to extract from the archive.
+
+Lastly, the following option can be specified at the end of the command-line:
+.TP
+.BI \-d\ tempdir
+Extract the archive in the directory
+.I tempdir
+rather than the current directory.
+.SH SEE ALSO
+.BR minizip (1),
+.BR zlib (3),
+.BR unzip (1).
+.SH AUTHOR
+This program was written by Gilles Vollant. This manual page was
+written by Mark Brown <broonie@sirena.org.uk>. The -d tempdir option
+was added by Dirk Eddelbuettel <edd@debian.org>.
diff --git a/compat/zlib/contrib/minizip/minizip.1 b/compat/zlib/contrib/minizip/minizip.1
new file mode 100644
index 0000000..1154484
--- /dev/null
+++ b/compat/zlib/contrib/minizip/minizip.1
@@ -0,0 +1,46 @@
+.\" Hey, EMACS: -*- nroff -*-
+.TH minizip 1 "May 2, 2001"
+.\" Please adjust this date whenever revising the manpage.
+.\"
+.\" Some roff macros, for reference:
+.\" .nh disable hyphenation
+.\" .hy enable hyphenation
+.\" .ad l left justify
+.\" .ad b justify to both left and right margins
+.\" .nf disable filling
+.\" .fi enable filling
+.\" .br insert line break
+.\" .sp <n> insert n+1 empty lines
+.\" for manpage-specific macros, see man(7)
+.SH NAME
+minizip - create ZIP archives
+.SH SYNOPSIS
+.B minizip
+.RI [ -o ]
+zipfile [ " files" ... ]
+.SH DESCRIPTION
+.B minizip
+is a simple tool which allows the creation of compressed file archives
+in the ZIP format used by the MS-DOS utility PKZIP. It was written as
+a demonstration of the
+.IR zlib (3)
+library and therefore lack many of the features of the
+.IR zip (1)
+program.
+.SH OPTIONS
+The first argument supplied is the name of the ZIP archive to create or
+.RI -o
+in which case it is ignored and the second argument treated as the
+name of the ZIP file. If the ZIP file already exists it will be
+overwritten.
+.PP
+Subsequent arguments specify a list of files to place in the ZIP
+archive. If none are specified then an empty archive will be created.
+.SH SEE ALSO
+.BR miniunzip (1),
+.BR zlib (3),
+.BR zip (1).
+.SH AUTHOR
+This program was written by Gilles Vollant. This manual page was
+written by Mark Brown <broonie@sirena.org.uk>.
+
diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c
new file mode 100644
index 0000000..4288962
--- /dev/null
+++ b/compat/zlib/contrib/minizip/minizip.c
@@ -0,0 +1,520 @@
+/*
+ minizip.c
+ Version 1.1, February 14h, 2010
+ sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications of Unzip for Zip64
+ Copyright (C) 2007-2008 Even Rouault
+
+ Modifications for Zip64 support on both zip and unzip
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+*/
+
+
+#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
+ #ifndef __USE_FILE_OFFSET64
+ #define __USE_FILE_OFFSET64
+ #endif
+ #ifndef __USE_LARGEFILE64
+ #define __USE_LARGEFILE64
+ #endif
+ #ifndef _LARGEFILE64_SOURCE
+ #define _LARGEFILE64_SOURCE
+ #endif
+ #ifndef _FILE_OFFSET_BIT
+ #define _FILE_OFFSET_BIT 64
+ #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>
+#include <time.h>
+#include <errno.h>
+#include <fcntl.h>
+
+#ifdef _WIN32
+# include <direct.h>
+# include <io.h>
+#else
+# include <unistd.h>
+# include <utime.h>
+# include <sys/types.h>
+# include <sys/stat.h>
+#endif
+
+#include "zip.h"
+
+#ifdef _WIN32
+ #define USEWIN32IOAPI
+ #include "iowin32.h"
+#endif
+
+
+
+#define WRITEBUFFERSIZE (16384)
+#define MAXFILENAME (256)
+
+#ifdef _WIN32
+uLong filetime(f, tmzip, dt)
+ char *f; /* name of file to get info on */
+ tm_zip *tmzip; /* return value: access, modific. and creation times */
+ uLong *dt; /* dostime */
+{
+ int ret = 0;
+ {
+ FILETIME ftLocal;
+ HANDLE hFind;
+ WIN32_FIND_DATAA ff32;
+
+ hFind = FindFirstFileA(f,&ff32);
+ if (hFind != INVALID_HANDLE_VALUE)
+ {
+ FileTimeToLocalFileTime(&(ff32.ftLastWriteTime),&ftLocal);
+ FileTimeToDosDateTime(&ftLocal,((LPWORD)dt)+1,((LPWORD)dt)+0);
+ FindClose(hFind);
+ ret = 1;
+ }
+ }
+ return ret;
+}
+#else
+#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 */
+ uLong *dt; /* dostime */
+{
+ int ret=0;
+ struct stat s; /* results of stat() */
+ struct tm* filedate;
+ time_t tm_t=0;
+
+ if (strcmp(f,"-")!=0)
+ {
+ char name[MAXFILENAME+1];
+ int len = strlen(f);
+ if (len > MAXFILENAME)
+ len = MAXFILENAME;
+
+ strncpy(name, f,MAXFILENAME-1);
+ /* strncpy doesnt append the trailing NULL, of the string is too long. */
+ name[ MAXFILENAME ] = '\0';
+
+ if (name[len - 1] == '/')
+ name[len - 1] = '\0';
+ /* not all systems allow stat'ing a file with / appended */
+ if (stat(name,&s)==0)
+ {
+ tm_t = s.st_mtime;
+ ret = 1;
+ }
+ }
+ filedate = localtime(&tm_t);
+
+ tmzip->tm_sec = filedate->tm_sec;
+ tmzip->tm_min = filedate->tm_min;
+ tmzip->tm_hour = filedate->tm_hour;
+ tmzip->tm_mday = filedate->tm_mday;
+ tmzip->tm_mon = filedate->tm_mon ;
+ tmzip->tm_year = filedate->tm_year;
+
+ return ret;
+}
+#else
+uLong filetime(f, tmzip, dt)
+ char *f; /* name of file to get info on */
+ tm_zip *tmzip; /* return value: access, modific. and creation times */
+ uLong *dt; /* dostime */
+{
+ return 0;
+}
+#endif
+#endif
+
+
+
+
+int check_exist_file(filename)
+ const char* filename;
+{
+ FILE* ftestexist;
+ int ret = 1;
+ ftestexist = FOPEN_FUNC(filename,"rb");
+ if (ftestexist==NULL)
+ ret = 0;
+ else
+ fclose(ftestexist);
+ return ret;
+}
+
+void do_banner()
+{
+ printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n");
+ printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n");
+}
+
+void do_help()
+{
+ printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
+ " -o Overwrite existing file.zip\n" \
+ " -a Append to existing file.zip\n" \
+ " -0 Store only\n" \
+ " -1 Compress faster\n" \
+ " -9 Compress better\n\n" \
+ " -j exclude path. store only the file name.\n\n");
+}
+
+/* calculate the CRC32 of a file,
+ because to encrypt a file, we need known the CRC32 of the file before */
+int getFileCrc(const char* filenameinzip,void*buf,unsigned long size_buf,unsigned long* result_crc)
+{
+ unsigned long calculate_crc=0;
+ int err=ZIP_OK;
+ FILE * fin = FOPEN_FUNC(filenameinzip,"rb");
+
+ unsigned long size_read = 0;
+ unsigned long total_read = 0;
+ if (fin==NULL)
+ {
+ err = ZIP_ERRNO;
+ }
+
+ if (err == ZIP_OK)
+ do
+ {
+ err = ZIP_OK;
+ size_read = (int)fread(buf,1,size_buf,fin);
+ if (size_read < size_buf)
+ if (feof(fin)==0)
+ {
+ printf("error in reading %s\n",filenameinzip);
+ err = ZIP_ERRNO;
+ }
+
+ if (size_read>0)
+ calculate_crc = crc32(calculate_crc,buf,size_read);
+ total_read += size_read;
+
+ } while ((err == ZIP_OK) && (size_read>0));
+
+ if (fin)
+ fclose(fin);
+
+ *result_crc=calculate_crc;
+ printf("file %s crc %lx\n", filenameinzip, calculate_crc);
+ return err;
+}
+
+int isLargeFile(const char* filename)
+{
+ int largeFile = 0;
+ ZPOS64_T pos = 0;
+ FILE* pFile = FOPEN_FUNC(filename, "rb");
+
+ if(pFile != NULL)
+ {
+ int n = FSEEKO_FUNC(pFile, 0, SEEK_END);
+ pos = FTELLO_FUNC(pFile);
+
+ printf("File : %s is %lld bytes\n", filename, pos);
+
+ if(pos >= 0xffffffff)
+ largeFile = 1;
+
+ fclose(pFile);
+ }
+
+ return largeFile;
+}
+
+int main(argc,argv)
+ int argc;
+ char *argv[];
+{
+ int i;
+ int opt_overwrite=0;
+ int opt_compress_level=Z_DEFAULT_COMPRESSION;
+ int opt_exclude_path=0;
+ int zipfilenamearg = 0;
+ char filename_try[MAXFILENAME+16];
+ int zipok;
+ int err=0;
+ int size_buf=0;
+ void* buf=NULL;
+ const char* password=NULL;
+
+
+ do_banner();
+ if (argc==1)
+ {
+ do_help();
+ return 0;
+ }
+ else
+ {
+ for (i=1;i<argc;i++)
+ {
+ if ((*argv[i])=='-')
+ {
+ const char *p=argv[i]+1;
+
+ while ((*p)!='\0')
+ {
+ char c=*(p++);;
+ if ((c=='o') || (c=='O'))
+ opt_overwrite = 1;
+ if ((c=='a') || (c=='A'))
+ opt_overwrite = 2;
+ if ((c>='0') && (c<='9'))
+ opt_compress_level = c-'0';
+ if ((c=='j') || (c=='J'))
+ opt_exclude_path = 1;
+
+ if (((c=='p') || (c=='P')) && (i+1<argc))
+ {
+ password=argv[i+1];
+ i++;
+ }
+ }
+ }
+ else
+ {
+ if (zipfilenamearg == 0)
+ {
+ zipfilenamearg = i ;
+ }
+ }
+ }
+ }
+
+ size_buf = WRITEBUFFERSIZE;
+ buf = (void*)malloc(size_buf);
+ if (buf==NULL)
+ {
+ printf("Error allocating memory\n");
+ return ZIP_INTERNALERROR;
+ }
+
+ if (zipfilenamearg==0)
+ {
+ zipok=0;
+ }
+ else
+ {
+ int i,len;
+ int dot_found=0;
+
+ zipok = 1 ;
+ strncpy(filename_try, argv[zipfilenamearg],MAXFILENAME-1);
+ /* strncpy doesnt append the trailing NULL, of the string is too long. */
+ filename_try[ MAXFILENAME ] = '\0';
+
+ len=(int)strlen(filename_try);
+ for (i=0;i<len;i++)
+ if (filename_try[i]=='.')
+ dot_found=1;
+
+ if (dot_found==0)
+ strcat(filename_try,".zip");
+
+ if (opt_overwrite==2)
+ {
+ /* if the file don't exist, we not append file */
+ if (check_exist_file(filename_try)==0)
+ opt_overwrite=1;
+ }
+ else
+ if (opt_overwrite==0)
+ if (check_exist_file(filename_try)!=0)
+ {
+ char rep=0;
+ do
+ {
+ char answer[128];
+ int ret;
+ printf("The file %s exists. Overwrite ? [y]es, [n]o, [a]ppend : ",filename_try);
+ ret = scanf("%1s",answer);
+ if (ret != 1)
+ {
+ exit(EXIT_FAILURE);
+ }
+ rep = answer[0] ;
+ if ((rep>='a') && (rep<='z'))
+ rep -= 0x20;
+ }
+ while ((rep!='Y') && (rep!='N') && (rep!='A'));
+ if (rep=='N')
+ zipok = 0;
+ if (rep=='A')
+ opt_overwrite = 2;
+ }
+ }
+
+ if (zipok==1)
+ {
+ zipFile zf;
+ int errclose;
+# ifdef USEWIN32IOAPI
+ zlib_filefunc64_def ffunc;
+ fill_win32_filefunc64A(&ffunc);
+ zf = zipOpen2_64(filename_try,(opt_overwrite==2) ? 2 : 0,NULL,&ffunc);
+# else
+ zf = zipOpen64(filename_try,(opt_overwrite==2) ? 2 : 0);
+# endif
+
+ if (zf == NULL)
+ {
+ printf("error opening %s\n",filename_try);
+ err= ZIP_ERRNO;
+ }
+ else
+ printf("creating %s\n",filename_try);
+
+ for (i=zipfilenamearg+1;(i<argc) && (err==ZIP_OK);i++)
+ {
+ if (!((((*(argv[i]))=='-') || ((*(argv[i]))=='/')) &&
+ ((argv[i][1]=='o') || (argv[i][1]=='O') ||
+ (argv[i][1]=='a') || (argv[i][1]=='A') ||
+ (argv[i][1]=='p') || (argv[i][1]=='P') ||
+ ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
+ (strlen(argv[i]) == 2)))
+ {
+ FILE * fin;
+ int size_read;
+ const char* filenameinzip = argv[i];
+ const char *savefilenameinzip;
+ zip_fileinfo zi;
+ unsigned long crcFile=0;
+ int zip64 = 0;
+
+ zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
+ zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
+ zi.dosDate = 0;
+ zi.internal_fa = 0;
+ zi.external_fa = 0;
+ filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
+
+/*
+ err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
+ NULL,0,NULL,0,NULL / * comment * /,
+ (opt_compress_level != 0) ? Z_DEFLATED : 0,
+ opt_compress_level);
+*/
+ if ((password != NULL) && (err==ZIP_OK))
+ err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
+
+ zip64 = isLargeFile(filenameinzip);
+
+ /* The path name saved, should not include a leading slash. */
+ /*if it did, windows/xp and dynazip couldn't read the zip file. */
+ savefilenameinzip = filenameinzip;
+ while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
+ {
+ savefilenameinzip++;
+ }
+
+ /*should the zip file contain any path at all?*/
+ if( opt_exclude_path )
+ {
+ const char *tmpptr;
+ const char *lastslash = 0;
+ for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
+ {
+ if( *tmpptr == '\\' || *tmpptr == '/')
+ {
+ lastslash = tmpptr;
+ }
+ }
+ if( lastslash != NULL )
+ {
+ savefilenameinzip = lastslash+1; // base filename follows last slash.
+ }
+ }
+
+ /**/
+ err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
+ NULL,0,NULL,0,NULL /* comment*/,
+ (opt_compress_level != 0) ? Z_DEFLATED : 0,
+ opt_compress_level,0,
+ /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ password,crcFile, zip64);
+
+ if (err != ZIP_OK)
+ printf("error in opening %s in zipfile\n",filenameinzip);
+ else
+ {
+ fin = FOPEN_FUNC(filenameinzip,"rb");
+ if (fin==NULL)
+ {
+ err=ZIP_ERRNO;
+ printf("error in opening %s for reading\n",filenameinzip);
+ }
+ }
+
+ if (err == ZIP_OK)
+ do
+ {
+ err = ZIP_OK;
+ size_read = (int)fread(buf,1,size_buf,fin);
+ if (size_read < size_buf)
+ if (feof(fin)==0)
+ {
+ printf("error in reading %s\n",filenameinzip);
+ err = ZIP_ERRNO;
+ }
+
+ if (size_read>0)
+ {
+ err = zipWriteInFileInZip (zf,buf,size_read);
+ if (err<0)
+ {
+ printf("error in writing %s in the zipfile\n",
+ filenameinzip);
+ }
+
+ }
+ } while ((err == ZIP_OK) && (size_read>0));
+
+ if (fin)
+ fclose(fin);
+
+ if (err<0)
+ err=ZIP_ERRNO;
+ else
+ {
+ err = zipCloseFileInZip(zf);
+ if (err!=ZIP_OK)
+ printf("error in closing %s in the zipfile\n",
+ filenameinzip);
+ }
+ }
+ }
+ errclose = zipClose(zf,NULL);
+ if (errclose != ZIP_OK)
+ printf("error in closing %s\n",filename_try);
+ }
+ else
+ {
+ do_help();
+ }
+
+ free(buf);
+ return 0;
+}
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
new file mode 100644
index 0000000..96891c2
--- /dev/null
+++ b/compat/zlib/contrib/minizip/mztools.c
@@ -0,0 +1,291 @@
+/*
+ Additional tools for Minizip
+ Code: Xavier Roche '2004
+ License: Same as ZLIB (www.gzip.org)
+*/
+
+/* Code */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "zlib.h"
+#include "unzip.h"
+
+#define READ_8(adr) ((unsigned char)*(adr))
+#define READ_16(adr) ( READ_8(adr) | (READ_8(adr+1) << 8) )
+#define READ_32(adr) ( READ_16(adr) | (READ_16((adr)+2) << 16) )
+
+#define WRITE_8(buff, n) do { \
+ *((unsigned char*)(buff)) = (unsigned char) ((n) & 0xff); \
+} while(0)
+#define WRITE_16(buff, n) do { \
+ WRITE_8((unsigned char*)(buff), n); \
+ WRITE_8(((unsigned char*)(buff)) + 1, (n) >> 8); \
+} while(0)
+#define WRITE_32(buff, n) do { \
+ WRITE_16((unsigned char*)(buff), (n) & 0xffff); \
+ WRITE_16((unsigned char*)(buff) + 2, (n) >> 16); \
+} while(0)
+
+extern int ZEXPORT unzRepair(file, fileOut, fileOutTmp, nRecovered, bytesRecovered)
+const char* file;
+const char* fileOut;
+const char* fileOutTmp;
+uLong* nRecovered;
+uLong* bytesRecovered;
+{
+ int err = Z_OK;
+ FILE* fpZip = fopen(file, "rb");
+ FILE* fpOut = fopen(fileOut, "wb");
+ FILE* fpOutCD = fopen(fileOutTmp, "wb");
+ if (fpZip != NULL && fpOut != NULL) {
+ int entries = 0;
+ uLong totalBytes = 0;
+ char header[30];
+ char filename[1024];
+ char extra[1024];
+ int offset = 0;
+ int offsetCD = 0;
+ while ( fread(header, 1, 30, fpZip) == 30 ) {
+ int currentOffset = offset;
+
+ /* File entry */
+ if (READ_32(header) == 0x04034b50) {
+ unsigned int version = READ_16(header + 4);
+ unsigned int gpflag = READ_16(header + 6);
+ unsigned int method = READ_16(header + 8);
+ unsigned int filetime = READ_16(header + 10);
+ unsigned int filedate = READ_16(header + 12);
+ unsigned int crc = READ_32(header + 14); /* crc */
+ unsigned int cpsize = READ_32(header + 18); /* compressed size */
+ unsigned int uncpsize = READ_32(header + 22); /* uncompressed sz */
+ unsigned int fnsize = READ_16(header + 26); /* file name length */
+ unsigned int extsize = READ_16(header + 28); /* extra field length */
+ filename[0] = extra[0] = '\0';
+
+ /* Header */
+ if (fwrite(header, 1, 30, fpOut) == 30) {
+ offset += 30;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+
+ /* Filename */
+ if (fnsize > 0) {
+ 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;
+ }
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ } else {
+ err = Z_STREAM_ERROR;
+ break;
+ }
+
+ /* Extra field */
+ if (extsize > 0) {
+ 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;
+ }
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ }
+
+ /* Data */
+ {
+ int dataSize = cpsize;
+ if (dataSize == 0) {
+ dataSize = uncpsize;
+ }
+ if (dataSize > 0) {
+ char* data = malloc(dataSize);
+ if (data != NULL) {
+ if ((int)fread(data, 1, dataSize, fpZip) == dataSize) {
+ if ((int)fwrite(data, 1, dataSize, fpOut) == dataSize) {
+ offset += dataSize;
+ totalBytes += dataSize;
+ } else {
+ err = Z_ERRNO;
+ }
+ } else {
+ err = Z_ERRNO;
+ }
+ free(data);
+ if (err != Z_OK) {
+ break;
+ }
+ } else {
+ err = Z_MEM_ERROR;
+ break;
+ }
+ }
+ }
+
+ /* Central directory entry */
+ {
+ char header[46];
+ char* comment = "";
+ int comsize = (int) strlen(comment);
+ WRITE_32(header, 0x02014b50);
+ WRITE_16(header + 4, version);
+ WRITE_16(header + 6, version);
+ WRITE_16(header + 8, gpflag);
+ WRITE_16(header + 10, method);
+ WRITE_16(header + 12, filetime);
+ WRITE_16(header + 14, filedate);
+ WRITE_32(header + 16, crc);
+ WRITE_32(header + 20, cpsize);
+ WRITE_32(header + 24, uncpsize);
+ WRITE_16(header + 28, fnsize);
+ WRITE_16(header + 30, extsize);
+ WRITE_16(header + 32, comsize);
+ WRITE_16(header + 34, 0); /* disk # */
+ WRITE_16(header + 36, 0); /* int attrb */
+ WRITE_32(header + 38, 0); /* ext attrb */
+ WRITE_32(header + 42, currentOffset);
+ /* Header */
+ if (fwrite(header, 1, 46, fpOutCD) == 46) {
+ offsetCD += 46;
+
+ /* Filename */
+ if (fnsize > 0) {
+ if (fwrite(filename, 1, fnsize, fpOutCD) == fnsize) {
+ offsetCD += fnsize;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ } else {
+ err = Z_STREAM_ERROR;
+ break;
+ }
+
+ /* Extra field */
+ if (extsize > 0) {
+ if (fwrite(extra, 1, extsize, fpOutCD) == extsize) {
+ offsetCD += extsize;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ }
+
+ /* Comment field */
+ if (comsize > 0) {
+ if ((int)fwrite(comment, 1, comsize, fpOutCD) == comsize) {
+ offsetCD += comsize;
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ }
+
+
+ } else {
+ err = Z_ERRNO;
+ break;
+ }
+ }
+
+ /* Success */
+ entries++;
+
+ } else {
+ break;
+ }
+ }
+
+ /* Final central directory */
+ {
+ int entriesZip = entries;
+ char header[22];
+ char* comment = ""; // "ZIP File recovered by zlib/minizip/mztools";
+ int comsize = (int) strlen(comment);
+ if (entriesZip > 0xffff) {
+ entriesZip = 0xffff;
+ }
+ WRITE_32(header, 0x06054b50);
+ WRITE_16(header + 4, 0); /* disk # */
+ WRITE_16(header + 6, 0); /* disk # */
+ WRITE_16(header + 8, entriesZip); /* hack */
+ WRITE_16(header + 10, entriesZip); /* hack */
+ WRITE_32(header + 12, offsetCD); /* size of CD */
+ WRITE_32(header + 16, offset); /* offset to CD */
+ WRITE_16(header + 20, comsize); /* comment */
+
+ /* Header */
+ if (fwrite(header, 1, 22, fpOutCD) == 22) {
+
+ /* Comment field */
+ if (comsize > 0) {
+ if ((int)fwrite(comment, 1, comsize, fpOutCD) != comsize) {
+ err = Z_ERRNO;
+ }
+ }
+
+ } else {
+ err = Z_ERRNO;
+ }
+ }
+
+ /* Final merge (file + central directory) */
+ fclose(fpOutCD);
+ if (err == Z_OK) {
+ fpOutCD = fopen(fileOutTmp, "rb");
+ if (fpOutCD != NULL) {
+ int nRead;
+ char buffer[8192];
+ while ( (nRead = (int)fread(buffer, 1, sizeof(buffer), fpOutCD)) > 0) {
+ if ((int)fwrite(buffer, 1, nRead, fpOut) != nRead) {
+ err = Z_ERRNO;
+ break;
+ }
+ }
+ fclose(fpOutCD);
+ }
+ }
+
+ /* Close */
+ fclose(fpZip);
+ fclose(fpOut);
+
+ /* Wipe temporary file */
+ (void)remove(fileOutTmp);
+
+ /* Number of recovered entries */
+ if (err == Z_OK) {
+ if (nRecovered != NULL) {
+ *nRecovered = entries;
+ }
+ if (bytesRecovered != NULL) {
+ *bytesRecovered = totalBytes;
+ }
+ }
+ } else {
+ err = Z_STREAM_ERROR;
+ }
+ return err;
+}
diff --git a/compat/zlib/contrib/minizip/mztools.h b/compat/zlib/contrib/minizip/mztools.h
new file mode 100644
index 0000000..a49a426
--- /dev/null
+++ b/compat/zlib/contrib/minizip/mztools.h
@@ -0,0 +1,37 @@
+/*
+ Additional tools for Minizip
+ Code: Xavier Roche '2004
+ License: Same as ZLIB (www.gzip.org)
+*/
+
+#ifndef _zip_tools_H
+#define _zip_tools_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef _ZLIB_H
+#include "zlib.h"
+#endif
+
+#include "unzip.h"
+
+/* Repair a ZIP file (missing central directory)
+ file: file to recover
+ fileOut: output file after recovery
+ fileOutTmp: temporary file name used for recovery
+*/
+extern int ZEXPORT unzRepair(const char* file,
+ const char* fileOut,
+ const char* fileOutTmp,
+ uLong* nRecovered,
+ uLong* bytesRecovered);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif
diff --git a/compat/zlib/contrib/minizip/unzip.c b/compat/zlib/contrib/minizip/unzip.c
new file mode 100644
index 0000000..9093504
--- /dev/null
+++ b/compat/zlib/contrib/minizip/unzip.c
@@ -0,0 +1,2125 @@
+/* unzip.c -- IO for uncompress .zip files using zlib
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications of Unzip for Zip64
+ Copyright (C) 2007-2008 Even Rouault
+
+ Modifications for Zip64 support on both zip and unzip
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+
+ ------------------------------------------------------------------------------------
+ Decryption code comes from crypt.c by Info-ZIP but has been greatly reduced in terms of
+ compatibility with older software. The following is from the original crypt.c.
+ Code woven in by Terry Thorsen 1/2003.
+
+ Copyright (c) 1990-2000 Info-ZIP. All rights reserved.
+
+ See the accompanying file LICENSE, version 2000-Apr-09 or later
+ (the contents of which are also included in zip.h) for terms of use.
+ If, for some reason, all these files are missing, the Info-ZIP license
+ also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html
+
+ crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h]
+
+ The encryption/decryption parts of this source code (as opposed to the
+ non-echoing password parts) were originally written in Europe. The
+ whole source package can be freely distributed, including from the USA.
+ (Prior to January 2000, re-export from the US was a violation of US law.)
+
+ This encryption code is a direct transcription of the algorithm from
+ Roger Schlafly, described by Phil Katz in the file appnote.txt. This
+ file (appnote.txt) is distributed with the PKZIP program (even in the
+ version without encryption capabilities).
+
+ ------------------------------------------------------------------------------------
+
+ Changes in unzip.c
+
+ 2007-2008 - Even Rouault - Addition of cpl_unzGetCurrentFileZStreamPos
+ 2007-2008 - Even Rouault - Decoration of symbol names unz* -> cpl_unz*
+ 2007-2008 - Even Rouault - Remove old C style function prototypes
+ 2007-2008 - Even Rouault - Add unzip support for ZIP64
+
+ Copyright (C) 2007-2008 Even Rouault
+
+
+ Oct-2009 - Mathias Svensson - Removed cpl_* from symbol names (Even Rouault added them but since this is now moved to a new project (minizip64) I renamed them again).
+ Oct-2009 - Mathias Svensson - Fixed problem if uncompressed size was > 4G and compressed size was <4G
+ should only read the compressed/uncompressed size from the Zip64 format if
+ the size from normal header was 0xFFFFFFFF
+ Oct-2009 - Mathias Svensson - Applied some bug fixes from paches recived from Gilles Vollant
+ Oct-2009 - Mathias Svensson - Applied support to unzip files with compression mathod BZIP2 (bzip2 lib is required)
+ Patch created by Daniel Borca
+
+ Jan-2010 - back to unzip and minizip 1.0 name scheme, with compatibility layer
+
+ Copyright (C) 1998 - 2010 Gilles Vollant, Even Rouault, Mathias Svensson
+
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifndef NOUNCRYPT
+ #define NOUNCRYPT
+#endif
+
+#include "zlib.h"
+#include "unzip.h"
+
+#ifdef STDC
+# include <stddef.h>
+# include <string.h>
+# include <stdlib.h>
+#endif
+#ifdef NO_ERRNO_H
+ extern int errno;
+#else
+# include <errno.h>
+#endif
+
+
+#ifndef local
+# define local static
+#endif
+/* compile with -Dlocal if your debugger can't find static symbols */
+
+
+#ifndef CASESENSITIVITYDEFAULT_NO
+# if !defined(unix) && !defined(CASESENSITIVITYDEFAULT_YES)
+# define CASESENSITIVITYDEFAULT_NO
+# endif
+#endif
+
+
+#ifndef UNZ_BUFSIZE
+#define UNZ_BUFSIZE (16384)
+#endif
+
+#ifndef UNZ_MAXFILENAMEINZIP
+#define UNZ_MAXFILENAMEINZIP (256)
+#endif
+
+#ifndef ALLOC
+# define ALLOC(size) (malloc(size))
+#endif
+#ifndef TRYFREE
+# define TRYFREE(p) {if (p) free(p);}
+#endif
+
+#define SIZECENTRALDIRITEM (0x2e)
+#define SIZEZIPLOCALHEADER (0x1e)
+
+
+const char unz_copyright[] =
+ " unzip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll";
+
+/* unz_file_info_interntal contain internal info about a file in zipfile*/
+typedef struct unz_file_info64_internal_s
+{
+ ZPOS64_T offset_curfile;/* relative offset of local header 8 bytes */
+} unz_file_info64_internal;
+
+
+/* file_in_zip_read_info_s contain internal information about a file in zipfile,
+ when reading and decompress it */
+typedef struct
+{
+ char *read_buffer; /* internal buffer for compressed data */
+ z_stream stream; /* zLib stream structure for inflate */
+
+#ifdef HAVE_BZIP2
+ bz_stream bstream; /* bzLib stream structure for bziped */
+#endif
+
+ ZPOS64_T pos_in_zipfile; /* position in byte on the zipfile, for fseek*/
+ uLong stream_initialised; /* flag set if stream structure is initialised*/
+
+ ZPOS64_T offset_local_extrafield;/* offset of the local extra field */
+ uInt size_local_extrafield;/* size of the local extra field */
+ ZPOS64_T pos_local_extrafield; /* position in the local extra field in read*/
+ ZPOS64_T total_out_64;
+
+ uLong crc32; /* crc32 of all data uncompressed */
+ uLong crc32_wait; /* crc32 we must obtain after decompress all */
+ ZPOS64_T rest_read_compressed; /* number of byte to be decompressed */
+ ZPOS64_T rest_read_uncompressed;/*number of byte to be obtained after decomp*/
+ zlib_filefunc64_32_def z_filefunc;
+ voidpf filestream; /* io structore of the zipfile */
+ uLong compression_method; /* compression method (0==store) */
+ ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/
+ int raw;
+} file_in_zip64_read_info_s;
+
+
+/* unz64_s contain internal information about the zipfile
+*/
+typedef struct
+{
+ zlib_filefunc64_32_def z_filefunc;
+ int is64bitOpenFunction;
+ voidpf filestream; /* io structore of the zipfile */
+ unz_global_info64 gi; /* public global information */
+ ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/
+ ZPOS64_T num_file; /* number of the current file in the zipfile*/
+ ZPOS64_T pos_in_central_dir; /* pos of the current file in the central dir*/
+ ZPOS64_T current_file_ok; /* flag about the usability of the current file*/
+ ZPOS64_T central_pos; /* position of the beginning of the central dir*/
+
+ ZPOS64_T size_central_dir; /* size of the central directory */
+ ZPOS64_T offset_central_dir; /* offset of start of central directory with
+ respect to the starting disk number */
+
+ unz_file_info64 cur_file_info; /* public info about the current file in zip*/
+ unz_file_info64_internal cur_file_info_internal; /* private info about it*/
+ file_in_zip64_read_info_s* pfile_in_zip_read; /* structure about the current
+ file if we are decompressing it */
+ int encrypted;
+
+ int isZip64;
+
+# ifndef NOUNCRYPT
+ unsigned long keys[3]; /* keys defining the pseudo-random sequence */
+ const z_crc_t* pcrc_32_tab;
+# endif
+} unz64_s;
+
+
+#ifndef NOUNCRYPT
+#include "crypt.h"
+#endif
+
+/* ===========================================================================
+ Read a byte from a gz_stream; update next_in and avail_in. Return EOF
+ for end of file.
+ IN assertion: the stream s has been sucessfully opened for reading.
+*/
+
+
+local int unz64local_getByte OF((
+ const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ int *pi));
+
+local int unz64local_getByte(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, int *pi)
+{
+ unsigned char c;
+ int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,&c,1);
+ if (err==1)
+ {
+ *pi = (int)c;
+ return UNZ_OK;
+ }
+ else
+ {
+ if (ZERROR64(*pzlib_filefunc_def,filestream))
+ return UNZ_ERRNO;
+ else
+ return UNZ_EOF;
+ }
+}
+
+
+/* ===========================================================================
+ Reads a long in LSB order from the given gz_stream. Sets
+*/
+local int unz64local_getShort OF((
+ const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ uLong *pX));
+
+local int unz64local_getShort (const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ uLong *pX)
+{
+ uLong x ;
+ int i = 0;
+ int err;
+
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (uLong)i;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((uLong)i)<<8;
+
+ if (err==UNZ_OK)
+ *pX = x;
+ else
+ *pX = 0;
+ return err;
+}
+
+local int unz64local_getLong OF((
+ const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ uLong *pX));
+
+local int unz64local_getLong (const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ uLong *pX)
+{
+ uLong x ;
+ int i = 0;
+ int err;
+
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (uLong)i;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((uLong)i)<<8;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((uLong)i)<<16;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((uLong)i)<<24;
+
+ if (err==UNZ_OK)
+ *pX = x;
+ else
+ *pX = 0;
+ return err;
+}
+
+local int unz64local_getLong64 OF((
+ const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ ZPOS64_T *pX));
+
+
+local int unz64local_getLong64 (const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream,
+ ZPOS64_T *pX)
+{
+ ZPOS64_T x ;
+ int i = 0;
+ int err;
+
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (ZPOS64_T)i;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<8;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<16;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<24;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<32;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<40;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<48;
+
+ if (err==UNZ_OK)
+ err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x |= ((ZPOS64_T)i)<<56;
+
+ if (err==UNZ_OK)
+ *pX = x;
+ else
+ *pX = 0;
+ return err;
+}
+
+/* My own strcmpi / strcasecmp */
+local int strcmpcasenosensitive_internal (const char* fileName1, const char* fileName2)
+{
+ for (;;)
+ {
+ char c1=*(fileName1++);
+ char c2=*(fileName2++);
+ if ((c1>='a') && (c1<='z'))
+ c1 -= 0x20;
+ if ((c2>='a') && (c2<='z'))
+ c2 -= 0x20;
+ if (c1=='\0')
+ return ((c2=='\0') ? 0 : -1);
+ if (c2=='\0')
+ return 1;
+ if (c1<c2)
+ return -1;
+ if (c1>c2)
+ return 1;
+ }
+}
+
+
+#ifdef CASESENSITIVITYDEFAULT_NO
+#define CASESENSITIVITYDEFAULTVALUE 2
+#else
+#define CASESENSITIVITYDEFAULTVALUE 1
+#endif
+
+#ifndef STRCMPCASENOSENTIVEFUNCTION
+#define STRCMPCASENOSENTIVEFUNCTION strcmpcasenosensitive_internal
+#endif
+
+/*
+ Compare two filename (fileName1,fileName2).
+ If iCaseSenisivity = 1, comparision is case sensitivity (like strcmp)
+ If iCaseSenisivity = 2, comparision is not case sensitivity (like strcmpi
+ or strcasecmp)
+ If iCaseSenisivity = 0, case sensitivity is defaut of your operating system
+ (like 1 on Unix, 2 on Windows)
+
+*/
+extern int ZEXPORT unzStringFileNameCompare (const char* fileName1,
+ const char* fileName2,
+ int iCaseSensitivity)
+
+{
+ if (iCaseSensitivity==0)
+ iCaseSensitivity=CASESENSITIVITYDEFAULTVALUE;
+
+ if (iCaseSensitivity==1)
+ return strcmp(fileName1,fileName2);
+
+ return STRCMPCASENOSENTIVEFUNCTION(fileName1,fileName2);
+}
+
+#ifndef BUFREADCOMMENT
+#define BUFREADCOMMENT (0x400)
+#endif
+
+/*
+ Locate the Central directory of a zipfile (at the end, just before
+ the global comment)
+*/
+local ZPOS64_T unz64local_SearchCentralDir OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));
+local ZPOS64_T unz64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
+{
+ unsigned char* buf;
+ ZPOS64_T uSizeFile;
+ ZPOS64_T uBackRead;
+ ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
+ ZPOS64_T uPosFound=0;
+
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
+ return 0;
+
+
+ uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);
+
+ if (uMaxBack>uSizeFile)
+ uMaxBack = uSizeFile;
+
+ buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
+ if (buf==NULL)
+ return 0;
+
+ uBackRead = 4;
+ while (uBackRead<uMaxBack)
+ {
+ uLong uReadSize;
+ ZPOS64_T uReadPos ;
+ int i;
+ if (uBackRead+BUFREADCOMMENT>uMaxBack)
+ uBackRead = uMaxBack;
+ else
+ uBackRead+=BUFREADCOMMENT;
+ uReadPos = uSizeFile-uBackRead ;
+
+ uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
+ (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ break;
+
+ if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
+ break;
+
+ for (i=(int)uReadSize-3; (i--)>0;)
+ if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
+ ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06))
+ {
+ uPosFound = uReadPos+i;
+ break;
+ }
+
+ if (uPosFound!=0)
+ break;
+ }
+ TRYFREE(buf);
+ return uPosFound;
+}
+
+
+/*
+ Locate the Central directory 64 of a zipfile (at the end, just before
+ the global comment)
+*/
+local ZPOS64_T unz64local_SearchCentralDir64 OF((
+ const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream));
+
+local ZPOS64_T unz64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def,
+ voidpf filestream)
+{
+ unsigned char* buf;
+ ZPOS64_T uSizeFile;
+ ZPOS64_T uBackRead;
+ ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
+ ZPOS64_T uPosFound=0;
+ uLong uL;
+ ZPOS64_T relativeOffset;
+
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
+ return 0;
+
+
+ uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);
+
+ if (uMaxBack>uSizeFile)
+ uMaxBack = uSizeFile;
+
+ buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
+ if (buf==NULL)
+ return 0;
+
+ uBackRead = 4;
+ while (uBackRead<uMaxBack)
+ {
+ uLong uReadSize;
+ ZPOS64_T uReadPos;
+ int i;
+ if (uBackRead+BUFREADCOMMENT>uMaxBack)
+ uBackRead = uMaxBack;
+ else
+ uBackRead+=BUFREADCOMMENT;
+ uReadPos = uSizeFile-uBackRead ;
+
+ uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
+ (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ break;
+
+ if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
+ break;
+
+ for (i=(int)uReadSize-3; (i--)>0;)
+ if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
+ ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07))
+ {
+ uPosFound = uReadPos+i;
+ break;
+ }
+
+ if (uPosFound!=0)
+ break;
+ }
+ TRYFREE(buf);
+ if (uPosFound == 0)
+ return 0;
+
+ /* Zip64 end of central directory locator */
+ if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return 0;
+
+ /* the signature, already checked */
+ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
+ return 0;
+
+ /* number of the disk with the start of the zip64 end of central directory */
+ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
+ return 0;
+ if (uL != 0)
+ return 0;
+
+ /* relative offset of the zip64 end of central directory record */
+ if (unz64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=UNZ_OK)
+ return 0;
+
+ /* total number of disks */
+ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
+ return 0;
+ if (uL != 1)
+ return 0;
+
+ /* Goto end of central directory record */
+ if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return 0;
+
+ /* the signature */
+ if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
+ return 0;
+
+ if (uL != 0x06064b50)
+ return 0;
+
+ return relativeOffset;
+}
+
+/*
+ Open a Zip file. path contain the full pathname (by example,
+ on a Windows NT computer "c:\\test\\zlib114.zip" or on an Unix computer
+ "zlib/zlib114.zip".
+ If the zipfile cannot be opened (file doesn't exist or in not valid), the
+ return value is NULL.
+ Else, the return value is a unzFile Handle, usable with other function
+ of this unzip package.
+*/
+local unzFile unzOpenInternal (const void *path,
+ zlib_filefunc64_32_def* pzlib_filefunc64_32_def,
+ int is64bitOpenFunction)
+{
+ unz64_s us;
+ unz64_s *s;
+ ZPOS64_T central_pos;
+ uLong uL;
+
+ uLong number_disk; /* number of the current dist, used for
+ spaning ZIP, unsupported, always 0*/
+ uLong number_disk_with_CD; /* number the the disk with central dir, used
+ for spaning ZIP, unsupported, always 0*/
+ ZPOS64_T number_entry_CD; /* total number of entries in
+ the central dir
+ (same than number_entry on nospan) */
+
+ int err=UNZ_OK;
+
+ if (unz_copyright[0]!=' ')
+ return NULL;
+
+ us.z_filefunc.zseek32_file = NULL;
+ us.z_filefunc.ztell32_file = NULL;
+ if (pzlib_filefunc64_32_def==NULL)
+ fill_fopen64_filefunc(&us.z_filefunc.zfile_func64);
+ else
+ us.z_filefunc = *pzlib_filefunc64_32_def;
+ us.is64bitOpenFunction = is64bitOpenFunction;
+
+
+
+ us.filestream = ZOPEN64(us.z_filefunc,
+ path,
+ ZLIB_FILEFUNC_MODE_READ |
+ ZLIB_FILEFUNC_MODE_EXISTING);
+ if (us.filestream==NULL)
+ return NULL;
+
+ central_pos = unz64local_SearchCentralDir64(&us.z_filefunc,us.filestream);
+ if (central_pos)
+ {
+ uLong uS;
+ ZPOS64_T uL64;
+
+ us.isZip64 = 1;
+
+ if (ZSEEK64(us.z_filefunc, us.filestream,
+ central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err=UNZ_ERRNO;
+
+ /* the signature, already checked */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* size of zip64 end of central directory record */
+ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&uL64)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* version made by */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* version needed to extract */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* number of this disk */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* number of the disk with the start of the central directory */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* total number of entries in the central directory on this disk */
+ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.gi.number_entry)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* total number of entries in the central directory */
+ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&number_entry_CD)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if ((number_entry_CD!=us.gi.number_entry) ||
+ (number_disk_with_CD!=0) ||
+ (number_disk!=0))
+ err=UNZ_BADZIPFILE;
+
+ /* size of the central directory */
+ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.size_central_dir)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* offset of start of central directory with respect to the
+ starting disk number */
+ if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.offset_central_dir)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ us.gi.size_comment = 0;
+ }
+ else
+ {
+ central_pos = unz64local_SearchCentralDir(&us.z_filefunc,us.filestream);
+ if (central_pos==0)
+ err=UNZ_ERRNO;
+
+ us.isZip64 = 0;
+
+ if (ZSEEK64(us.z_filefunc, us.filestream,
+ central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err=UNZ_ERRNO;
+
+ /* the signature, already checked */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* number of this disk */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* number of the disk with the start of the central directory */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* total number of entries in the central dir on this disk */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+ us.gi.number_entry = uL;
+
+ /* total number of entries in the central dir */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+ number_entry_CD = uL;
+
+ if ((number_entry_CD!=us.gi.number_entry) ||
+ (number_disk_with_CD!=0) ||
+ (number_disk!=0))
+ err=UNZ_BADZIPFILE;
+
+ /* size of the central directory */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+ us.size_central_dir = uL;
+
+ /* offset of start of central directory with respect to the
+ starting disk number */
+ if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
+ err=UNZ_ERRNO;
+ us.offset_central_dir = uL;
+
+ /* zipfile comment length */
+ if (unz64local_getShort(&us.z_filefunc, us.filestream,&us.gi.size_comment)!=UNZ_OK)
+ err=UNZ_ERRNO;
+ }
+
+ if ((central_pos<us.offset_central_dir+us.size_central_dir) &&
+ (err==UNZ_OK))
+ err=UNZ_BADZIPFILE;
+
+ if (err!=UNZ_OK)
+ {
+ ZCLOSE64(us.z_filefunc, us.filestream);
+ return NULL;
+ }
+
+ us.byte_before_the_zipfile = central_pos -
+ (us.offset_central_dir+us.size_central_dir);
+ us.central_pos = central_pos;
+ us.pfile_in_zip_read = NULL;
+ us.encrypted = 0;
+
+
+ s=(unz64_s*)ALLOC(sizeof(unz64_s));
+ if( s != NULL)
+ {
+ *s=us;
+ unzGoToFirstFile((unzFile)s);
+ }
+ return (unzFile)s;
+}
+
+
+extern unzFile ZEXPORT unzOpen2 (const char *path,
+ zlib_filefunc_def* pzlib_filefunc32_def)
+{
+ if (pzlib_filefunc32_def != NULL)
+ {
+ zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
+ fill_zlib_filefunc64_32_def_from_filefunc32(&zlib_filefunc64_32_def_fill,pzlib_filefunc32_def);
+ return unzOpenInternal(path, &zlib_filefunc64_32_def_fill, 0);
+ }
+ else
+ return unzOpenInternal(path, NULL, 0);
+}
+
+extern unzFile ZEXPORT unzOpen2_64 (const void *path,
+ zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ if (pzlib_filefunc_def != NULL)
+ {
+ zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
+ zlib_filefunc64_32_def_fill.zfile_func64 = *pzlib_filefunc_def;
+ zlib_filefunc64_32_def_fill.ztell32_file = NULL;
+ zlib_filefunc64_32_def_fill.zseek32_file = NULL;
+ return unzOpenInternal(path, &zlib_filefunc64_32_def_fill, 1);
+ }
+ else
+ return unzOpenInternal(path, NULL, 1);
+}
+
+extern unzFile ZEXPORT unzOpen (const char *path)
+{
+ return unzOpenInternal(path, NULL, 0);
+}
+
+extern unzFile ZEXPORT unzOpen64 (const void *path)
+{
+ return unzOpenInternal(path, NULL, 1);
+}
+
+/*
+ Close a ZipFile opened with unzOpen.
+ If there is files inside the .Zip opened with unzOpenCurrentFile (see later),
+ these files MUST be closed with unzCloseCurrentFile before call unzClose.
+ return UNZ_OK if there is no problem. */
+extern int ZEXPORT unzClose (unzFile file)
+{
+ unz64_s* s;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+
+ if (s->pfile_in_zip_read!=NULL)
+ unzCloseCurrentFile(file);
+
+ ZCLOSE64(s->z_filefunc, s->filestream);
+ TRYFREE(s);
+ return UNZ_OK;
+}
+
+
+/*
+ Write info about the ZipFile in the *pglobal_info structure.
+ No preparation of the structure is needed
+ return UNZ_OK if there is no problem. */
+extern int ZEXPORT unzGetGlobalInfo64 (unzFile file, unz_global_info64* pglobal_info)
+{
+ unz64_s* s;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ *pglobal_info=s->gi;
+ return UNZ_OK;
+}
+
+extern int ZEXPORT unzGetGlobalInfo (unzFile file, unz_global_info* pglobal_info32)
+{
+ unz64_s* s;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ /* to do : check if number_entry is not truncated */
+ pglobal_info32->number_entry = (uLong)s->gi.number_entry;
+ pglobal_info32->size_comment = s->gi.size_comment;
+ return UNZ_OK;
+}
+/*
+ Translate date/time from Dos format to tm_unz (readable more easilty)
+*/
+local void unz64local_DosDateToTmuDate (ZPOS64_T ulDosDate, tm_unz* ptm)
+{
+ ZPOS64_T uDate;
+ uDate = (ZPOS64_T)(ulDosDate>>16);
+ ptm->tm_mday = (uInt)(uDate&0x1f) ;
+ ptm->tm_mon = (uInt)((((uDate)&0x1E0)/0x20)-1) ;
+ ptm->tm_year = (uInt)(((uDate&0x0FE00)/0x0200)+1980) ;
+
+ ptm->tm_hour = (uInt) ((ulDosDate &0xF800)/0x800);
+ ptm->tm_min = (uInt) ((ulDosDate&0x7E0)/0x20) ;
+ ptm->tm_sec = (uInt) (2*(ulDosDate&0x1f)) ;
+}
+
+/*
+ Get Info about the current file in the zipfile, with internal only info
+*/
+local int unz64local_GetCurrentFileInfoInternal OF((unzFile file,
+ unz_file_info64 *pfile_info,
+ unz_file_info64_internal
+ *pfile_info_internal,
+ char *szFileName,
+ uLong fileNameBufferSize,
+ void *extraField,
+ uLong extraFieldBufferSize,
+ char *szComment,
+ uLong commentBufferSize));
+
+local int unz64local_GetCurrentFileInfoInternal (unzFile file,
+ unz_file_info64 *pfile_info,
+ unz_file_info64_internal
+ *pfile_info_internal,
+ char *szFileName,
+ uLong fileNameBufferSize,
+ void *extraField,
+ uLong extraFieldBufferSize,
+ char *szComment,
+ uLong commentBufferSize)
+{
+ unz64_s* s;
+ unz_file_info64 file_info;
+ unz_file_info64_internal file_info_internal;
+ int err=UNZ_OK;
+ uLong uMagic;
+ long lSeek=0;
+ uLong uL;
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ if (ZSEEK64(s->z_filefunc, s->filestream,
+ s->pos_in_central_dir+s->byte_before_the_zipfile,
+ ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err=UNZ_ERRNO;
+
+
+ /* we check the magic */
+ if (err==UNZ_OK)
+ {
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK)
+ err=UNZ_ERRNO;
+ else if (uMagic!=0x02014b50)
+ err=UNZ_BADZIPFILE;
+ }
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version_needed) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.flag) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.compression_method) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.dosDate) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ unz64local_DosDateToTmuDate(file_info.dosDate,&file_info.tmu_date);
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.crc) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
+ err=UNZ_ERRNO;
+ file_info.compressed_size = uL;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
+ err=UNZ_ERRNO;
+ file_info.uncompressed_size = uL;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_filename) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_extra) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_comment) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.disk_num_start) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.internal_fa) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.external_fa) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ // relative offset of local header
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
+ err=UNZ_ERRNO;
+ file_info_internal.offset_curfile = uL;
+
+ lSeek+=file_info.size_filename;
+ if ((err==UNZ_OK) && (szFileName!=NULL))
+ {
+ uLong uSizeRead ;
+ if (file_info.size_filename<fileNameBufferSize)
+ {
+ *(szFileName+file_info.size_filename)='\0';
+ uSizeRead = file_info.size_filename;
+ }
+ else
+ uSizeRead = fileNameBufferSize;
+
+ if ((file_info.size_filename>0) && (fileNameBufferSize>0))
+ if (ZREAD64(s->z_filefunc, s->filestream,szFileName,uSizeRead)!=uSizeRead)
+ err=UNZ_ERRNO;
+ lSeek -= uSizeRead;
+ }
+
+ // Read extrafield
+ if ((err==UNZ_OK) && (extraField!=NULL))
+ {
+ ZPOS64_T uSizeRead ;
+ if (file_info.size_file_extra<extraFieldBufferSize)
+ uSizeRead = file_info.size_file_extra;
+ else
+ uSizeRead = extraFieldBufferSize;
+
+ if (lSeek!=0)
+ {
+ if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
+ lSeek=0;
+ else
+ err=UNZ_ERRNO;
+ }
+
+ if ((file_info.size_file_extra>0) && (extraFieldBufferSize>0))
+ if (ZREAD64(s->z_filefunc, s->filestream,extraField,(uLong)uSizeRead)!=uSizeRead)
+ err=UNZ_ERRNO;
+
+ lSeek += file_info.size_file_extra - (uLong)uSizeRead;
+ }
+ else
+ lSeek += file_info.size_file_extra;
+
+
+ if ((err==UNZ_OK) && (file_info.size_file_extra != 0))
+ {
+ uLong acc = 0;
+
+ // since lSeek now points to after the extra field we need to move back
+ lSeek -= file_info.size_file_extra;
+
+ if (lSeek!=0)
+ {
+ if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
+ lSeek=0;
+ else
+ err=UNZ_ERRNO;
+ }
+
+ while(acc < file_info.size_file_extra)
+ {
+ uLong headerId;
+ uLong dataSize;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&headerId) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&dataSize) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ /* ZIP64 extra fields */
+ if (headerId == 0x0001)
+ {
+ uLong uL;
+
+ 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 == MAXU32)
+ {
+ if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.compressed_size) != UNZ_OK)
+ err=UNZ_ERRNO;
+ }
+
+ 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 == MAXU32)
+ {
+ /* Disk Start Number */
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
+ err=UNZ_ERRNO;
+ }
+
+ }
+ else
+ {
+ if (ZSEEK64(s->z_filefunc, s->filestream,dataSize,ZLIB_FILEFUNC_SEEK_CUR)!=0)
+ err=UNZ_ERRNO;
+ }
+
+ acc += 2 + 2 + dataSize;
+ }
+ }
+
+ if ((err==UNZ_OK) && (szComment!=NULL))
+ {
+ uLong uSizeRead ;
+ if (file_info.size_file_comment<commentBufferSize)
+ {
+ *(szComment+file_info.size_file_comment)='\0';
+ uSizeRead = file_info.size_file_comment;
+ }
+ else
+ uSizeRead = commentBufferSize;
+
+ if (lSeek!=0)
+ {
+ if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
+ lSeek=0;
+ else
+ err=UNZ_ERRNO;
+ }
+
+ if ((file_info.size_file_comment>0) && (commentBufferSize>0))
+ if (ZREAD64(s->z_filefunc, s->filestream,szComment,uSizeRead)!=uSizeRead)
+ err=UNZ_ERRNO;
+ lSeek+=file_info.size_file_comment - uSizeRead;
+ }
+ else
+ lSeek+=file_info.size_file_comment;
+
+
+ if ((err==UNZ_OK) && (pfile_info!=NULL))
+ *pfile_info=file_info;
+
+ if ((err==UNZ_OK) && (pfile_info_internal!=NULL))
+ *pfile_info_internal=file_info_internal;
+
+ return err;
+}
+
+
+
+/*
+ Write info about the ZipFile in the *pglobal_info structure.
+ No preparation of the structure is needed
+ return UNZ_OK if there is no problem.
+*/
+extern int ZEXPORT unzGetCurrentFileInfo64 (unzFile file,
+ unz_file_info64 * pfile_info,
+ char * szFileName, uLong fileNameBufferSize,
+ void *extraField, uLong extraFieldBufferSize,
+ char* szComment, uLong commentBufferSize)
+{
+ return unz64local_GetCurrentFileInfoInternal(file,pfile_info,NULL,
+ szFileName,fileNameBufferSize,
+ extraField,extraFieldBufferSize,
+ szComment,commentBufferSize);
+}
+
+extern int ZEXPORT unzGetCurrentFileInfo (unzFile file,
+ unz_file_info * pfile_info,
+ char * szFileName, uLong fileNameBufferSize,
+ void *extraField, uLong extraFieldBufferSize,
+ char* szComment, uLong commentBufferSize)
+{
+ int err;
+ unz_file_info64 file_info64;
+ err = unz64local_GetCurrentFileInfoInternal(file,&file_info64,NULL,
+ szFileName,fileNameBufferSize,
+ extraField,extraFieldBufferSize,
+ szComment,commentBufferSize);
+ if ((err==UNZ_OK) && (pfile_info != NULL))
+ {
+ pfile_info->version = file_info64.version;
+ pfile_info->version_needed = file_info64.version_needed;
+ pfile_info->flag = file_info64.flag;
+ pfile_info->compression_method = file_info64.compression_method;
+ pfile_info->dosDate = file_info64.dosDate;
+ pfile_info->crc = file_info64.crc;
+
+ pfile_info->size_filename = file_info64.size_filename;
+ pfile_info->size_file_extra = file_info64.size_file_extra;
+ pfile_info->size_file_comment = file_info64.size_file_comment;
+
+ pfile_info->disk_num_start = file_info64.disk_num_start;
+ pfile_info->internal_fa = file_info64.internal_fa;
+ pfile_info->external_fa = file_info64.external_fa;
+
+ pfile_info->tmu_date = file_info64.tmu_date,
+
+
+ pfile_info->compressed_size = (uLong)file_info64.compressed_size;
+ pfile_info->uncompressed_size = (uLong)file_info64.uncompressed_size;
+
+ }
+ return err;
+}
+/*
+ Set the current file of the zipfile to the first file.
+ return UNZ_OK if there is no problem
+*/
+extern int ZEXPORT unzGoToFirstFile (unzFile file)
+{
+ int err=UNZ_OK;
+ unz64_s* s;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ s->pos_in_central_dir=s->offset_central_dir;
+ s->num_file=0;
+ err=unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
+ &s->cur_file_info_internal,
+ NULL,0,NULL,0,NULL,0);
+ s->current_file_ok = (err == UNZ_OK);
+ return err;
+}
+
+/*
+ Set the current file of the zipfile to the next file.
+ return UNZ_OK if there is no problem
+ return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest.
+*/
+extern int ZEXPORT unzGoToNextFile (unzFile file)
+{
+ unz64_s* s;
+ int err;
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ if (!s->current_file_ok)
+ return UNZ_END_OF_LIST_OF_FILE;
+ if (s->gi.number_entry != 0xffff) /* 2^16 files overflow hack */
+ if (s->num_file+1==s->gi.number_entry)
+ return UNZ_END_OF_LIST_OF_FILE;
+
+ s->pos_in_central_dir += SIZECENTRALDIRITEM + s->cur_file_info.size_filename +
+ s->cur_file_info.size_file_extra + s->cur_file_info.size_file_comment ;
+ s->num_file++;
+ err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
+ &s->cur_file_info_internal,
+ NULL,0,NULL,0,NULL,0);
+ s->current_file_ok = (err == UNZ_OK);
+ return err;
+}
+
+
+/*
+ Try locate the file szFileName in the zipfile.
+ For the iCaseSensitivity signification, see unzStringFileNameCompare
+
+ return value :
+ UNZ_OK if the file is found. It becomes the current file.
+ UNZ_END_OF_LIST_OF_FILE if the file is not found
+*/
+extern int ZEXPORT unzLocateFile (unzFile file, const char *szFileName, int iCaseSensitivity)
+{
+ unz64_s* s;
+ int err;
+
+ /* We remember the 'current' position in the file so that we can jump
+ * back there if we fail.
+ */
+ unz_file_info64 cur_file_infoSaved;
+ unz_file_info64_internal cur_file_info_internalSaved;
+ ZPOS64_T num_fileSaved;
+ ZPOS64_T pos_in_central_dirSaved;
+
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+
+ if (strlen(szFileName)>=UNZ_MAXFILENAMEINZIP)
+ return UNZ_PARAMERROR;
+
+ s=(unz64_s*)file;
+ if (!s->current_file_ok)
+ return UNZ_END_OF_LIST_OF_FILE;
+
+ /* Save the current state */
+ num_fileSaved = s->num_file;
+ pos_in_central_dirSaved = s->pos_in_central_dir;
+ cur_file_infoSaved = s->cur_file_info;
+ cur_file_info_internalSaved = s->cur_file_info_internal;
+
+ err = unzGoToFirstFile(file);
+
+ while (err == UNZ_OK)
+ {
+ char szCurrentFileName[UNZ_MAXFILENAMEINZIP+1];
+ err = unzGetCurrentFileInfo64(file,NULL,
+ szCurrentFileName,sizeof(szCurrentFileName)-1,
+ NULL,0,NULL,0);
+ if (err == UNZ_OK)
+ {
+ if (unzStringFileNameCompare(szCurrentFileName,
+ szFileName,iCaseSensitivity)==0)
+ return UNZ_OK;
+ err = unzGoToNextFile(file);
+ }
+ }
+
+ /* We failed, so restore the state of the 'current file' to where we
+ * were.
+ */
+ s->num_file = num_fileSaved ;
+ s->pos_in_central_dir = pos_in_central_dirSaved ;
+ s->cur_file_info = cur_file_infoSaved;
+ s->cur_file_info_internal = cur_file_info_internalSaved;
+ return err;
+}
+
+
+/*
+///////////////////////////////////////////
+// Contributed by Ryan Haksi (mailto://cryogen@infoserve.net)
+// I need random access
+//
+// Further optimization could be realized by adding an ability
+// to cache the directory in memory. The goal being a single
+// comprehensive file read to put the file I need in a memory.
+*/
+
+/*
+typedef struct unz_file_pos_s
+{
+ ZPOS64_T pos_in_zip_directory; // offset in file
+ ZPOS64_T num_of_file; // # of file
+} unz_file_pos;
+*/
+
+extern int ZEXPORT unzGetFilePos64(unzFile file, unz64_file_pos* file_pos)
+{
+ unz64_s* s;
+
+ if (file==NULL || file_pos==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ if (!s->current_file_ok)
+ return UNZ_END_OF_LIST_OF_FILE;
+
+ file_pos->pos_in_zip_directory = s->pos_in_central_dir;
+ file_pos->num_of_file = s->num_file;
+
+ return UNZ_OK;
+}
+
+extern int ZEXPORT unzGetFilePos(
+ unzFile file,
+ unz_file_pos* file_pos)
+{
+ unz64_file_pos file_pos64;
+ int err = unzGetFilePos64(file,&file_pos64);
+ if (err==UNZ_OK)
+ {
+ file_pos->pos_in_zip_directory = (uLong)file_pos64.pos_in_zip_directory;
+ file_pos->num_of_file = (uLong)file_pos64.num_of_file;
+ }
+ return err;
+}
+
+extern int ZEXPORT unzGoToFilePos64(unzFile file, const unz64_file_pos* file_pos)
+{
+ unz64_s* s;
+ int err;
+
+ if (file==NULL || file_pos==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+
+ /* jump to the right spot */
+ s->pos_in_central_dir = file_pos->pos_in_zip_directory;
+ s->num_file = file_pos->num_of_file;
+
+ /* set the current file */
+ err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
+ &s->cur_file_info_internal,
+ NULL,0,NULL,0,NULL,0);
+ /* return results */
+ s->current_file_ok = (err == UNZ_OK);
+ return err;
+}
+
+extern int ZEXPORT unzGoToFilePos(
+ unzFile file,
+ unz_file_pos* file_pos)
+{
+ unz64_file_pos file_pos64;
+ if (file_pos == NULL)
+ return UNZ_PARAMERROR;
+
+ file_pos64.pos_in_zip_directory = file_pos->pos_in_zip_directory;
+ file_pos64.num_of_file = file_pos->num_of_file;
+ return unzGoToFilePos64(file,&file_pos64);
+}
+
+/*
+// Unzip Helper Functions - should be here?
+///////////////////////////////////////////
+*/
+
+/*
+ Read the local header of the current zipfile
+ Check the coherency of the local header and info in the end of central
+ directory about this file
+ store in *piSizeVar the size of extra info in local header
+ (filename and size of extra field data)
+*/
+local int unz64local_CheckCurrentFileCoherencyHeader (unz64_s* s, uInt* piSizeVar,
+ ZPOS64_T * poffset_local_extrafield,
+ uInt * psize_local_extrafield)
+{
+ uLong uMagic,uData,uFlags;
+ uLong size_filename;
+ uLong size_extra_field;
+ int err=UNZ_OK;
+
+ *piSizeVar = 0;
+ *poffset_local_extrafield = 0;
+ *psize_local_extrafield = 0;
+
+ if (ZSEEK64(s->z_filefunc, s->filestream,s->cur_file_info_internal.offset_curfile +
+ s->byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return UNZ_ERRNO;
+
+
+ if (err==UNZ_OK)
+ {
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK)
+ err=UNZ_ERRNO;
+ else if (uMagic!=0x04034b50)
+ err=UNZ_BADZIPFILE;
+ }
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK)
+ err=UNZ_ERRNO;
+/*
+ else if ((err==UNZ_OK) && (uData!=s->cur_file_info.wVersion))
+ err=UNZ_BADZIPFILE;
+*/
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&uFlags) != UNZ_OK)
+ err=UNZ_ERRNO;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK)
+ err=UNZ_ERRNO;
+ else if ((err==UNZ_OK) && (uData!=s->cur_file_info.compression_method))
+ err=UNZ_BADZIPFILE;
+
+ if ((err==UNZ_OK) && (s->cur_file_info.compression_method!=0) &&
+/* #ifdef HAVE_BZIP2 */
+ (s->cur_file_info.compression_method!=Z_BZIP2ED) &&
+/* #endif */
+ (s->cur_file_info.compression_method!=Z_DEFLATED))
+ err=UNZ_BADZIPFILE;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* date/time */
+ err=UNZ_ERRNO;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* crc */
+ err=UNZ_ERRNO;
+ else if ((err==UNZ_OK) && (uData!=s->cur_file_info.crc) && ((uFlags & 8)==0))
+ err=UNZ_BADZIPFILE;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size compr */
+ err=UNZ_ERRNO;
+ else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.compressed_size) && ((uFlags & 8)==0))
+ err=UNZ_BADZIPFILE;
+
+ if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size uncompr */
+ err=UNZ_ERRNO;
+ else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.uncompressed_size) && ((uFlags & 8)==0))
+ err=UNZ_BADZIPFILE;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_filename) != UNZ_OK)
+ err=UNZ_ERRNO;
+ else if ((err==UNZ_OK) && (size_filename!=s->cur_file_info.size_filename))
+ err=UNZ_BADZIPFILE;
+
+ *piSizeVar += (uInt)size_filename;
+
+ if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_extra_field) != UNZ_OK)
+ err=UNZ_ERRNO;
+ *poffset_local_extrafield= s->cur_file_info_internal.offset_curfile +
+ SIZEZIPLOCALHEADER + size_filename;
+ *psize_local_extrafield = (uInt)size_extra_field;
+
+ *piSizeVar += (uInt)size_extra_field;
+
+ return err;
+}
+
+/*
+ Open for reading data the current file in the zipfile.
+ If there is no error and the file is opened, the return value is UNZ_OK.
+*/
+extern int ZEXPORT unzOpenCurrentFile3 (unzFile file, int* method,
+ int* level, int raw, const char* password)
+{
+ int err=UNZ_OK;
+ uInt iSizeVar;
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ ZPOS64_T offset_local_extrafield; /* offset of the local extra field */
+ uInt size_local_extrafield; /* size of the local extra field */
+# ifndef NOUNCRYPT
+ char source[12];
+# else
+ if (password != NULL)
+ return UNZ_PARAMERROR;
+# endif
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ if (!s->current_file_ok)
+ return UNZ_PARAMERROR;
+
+ if (s->pfile_in_zip_read != NULL)
+ unzCloseCurrentFile(file);
+
+ if (unz64local_CheckCurrentFileCoherencyHeader(s,&iSizeVar, &offset_local_extrafield,&size_local_extrafield)!=UNZ_OK)
+ return UNZ_BADZIPFILE;
+
+ pfile_in_zip_read_info = (file_in_zip64_read_info_s*)ALLOC(sizeof(file_in_zip64_read_info_s));
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_INTERNALERROR;
+
+ pfile_in_zip_read_info->read_buffer=(char*)ALLOC(UNZ_BUFSIZE);
+ pfile_in_zip_read_info->offset_local_extrafield = offset_local_extrafield;
+ pfile_in_zip_read_info->size_local_extrafield = size_local_extrafield;
+ pfile_in_zip_read_info->pos_local_extrafield=0;
+ pfile_in_zip_read_info->raw=raw;
+
+ if (pfile_in_zip_read_info->read_buffer==NULL)
+ {
+ TRYFREE(pfile_in_zip_read_info);
+ return UNZ_INTERNALERROR;
+ }
+
+ pfile_in_zip_read_info->stream_initialised=0;
+
+ if (method!=NULL)
+ *method = (int)s->cur_file_info.compression_method;
+
+ if (level!=NULL)
+ {
+ *level = 6;
+ switch (s->cur_file_info.flag & 0x06)
+ {
+ case 6 : *level = 1; break;
+ case 4 : *level = 2; break;
+ case 2 : *level = 9; break;
+ }
+ }
+
+ if ((s->cur_file_info.compression_method!=0) &&
+/* #ifdef HAVE_BZIP2 */
+ (s->cur_file_info.compression_method!=Z_BZIP2ED) &&
+/* #endif */
+ (s->cur_file_info.compression_method!=Z_DEFLATED))
+
+ err=UNZ_BADZIPFILE;
+
+ pfile_in_zip_read_info->crc32_wait=s->cur_file_info.crc;
+ pfile_in_zip_read_info->crc32=0;
+ pfile_in_zip_read_info->total_out_64=0;
+ pfile_in_zip_read_info->compression_method = s->cur_file_info.compression_method;
+ pfile_in_zip_read_info->filestream=s->filestream;
+ pfile_in_zip_read_info->z_filefunc=s->z_filefunc;
+ pfile_in_zip_read_info->byte_before_the_zipfile=s->byte_before_the_zipfile;
+
+ pfile_in_zip_read_info->stream.total_out = 0;
+
+ if ((s->cur_file_info.compression_method==Z_BZIP2ED) && (!raw))
+ {
+#ifdef HAVE_BZIP2
+ pfile_in_zip_read_info->bstream.bzalloc = (void *(*) (void *, int, int))0;
+ pfile_in_zip_read_info->bstream.bzfree = (free_func)0;
+ pfile_in_zip_read_info->bstream.opaque = (voidpf)0;
+ pfile_in_zip_read_info->bstream.state = (voidpf)0;
+
+ pfile_in_zip_read_info->stream.zalloc = (alloc_func)0;
+ pfile_in_zip_read_info->stream.zfree = (free_func)0;
+ pfile_in_zip_read_info->stream.opaque = (voidpf)0;
+ pfile_in_zip_read_info->stream.next_in = (voidpf)0;
+ pfile_in_zip_read_info->stream.avail_in = 0;
+
+ err=BZ2_bzDecompressInit(&pfile_in_zip_read_info->bstream, 0, 0);
+ if (err == Z_OK)
+ pfile_in_zip_read_info->stream_initialised=Z_BZIP2ED;
+ else
+ {
+ TRYFREE(pfile_in_zip_read_info);
+ return err;
+ }
+#else
+ pfile_in_zip_read_info->raw=1;
+#endif
+ }
+ else if ((s->cur_file_info.compression_method==Z_DEFLATED) && (!raw))
+ {
+ pfile_in_zip_read_info->stream.zalloc = (alloc_func)0;
+ pfile_in_zip_read_info->stream.zfree = (free_func)0;
+ pfile_in_zip_read_info->stream.opaque = (voidpf)0;
+ pfile_in_zip_read_info->stream.next_in = 0;
+ pfile_in_zip_read_info->stream.avail_in = 0;
+
+ err=inflateInit2(&pfile_in_zip_read_info->stream, -MAX_WBITS);
+ if (err == Z_OK)
+ pfile_in_zip_read_info->stream_initialised=Z_DEFLATED;
+ else
+ {
+ TRYFREE(pfile_in_zip_read_info);
+ return err;
+ }
+ /* windowBits is passed < 0 to tell that there is no zlib header.
+ * Note that in this case inflate *requires* an extra "dummy" byte
+ * after the compressed stream in order to complete decompression and
+ * return Z_STREAM_END.
+ * In unzip, i don't wait absolutely Z_STREAM_END because I known the
+ * size of both compressed and uncompressed data
+ */
+ }
+ pfile_in_zip_read_info->rest_read_compressed =
+ s->cur_file_info.compressed_size ;
+ pfile_in_zip_read_info->rest_read_uncompressed =
+ s->cur_file_info.uncompressed_size ;
+
+
+ pfile_in_zip_read_info->pos_in_zipfile =
+ s->cur_file_info_internal.offset_curfile + SIZEZIPLOCALHEADER +
+ iSizeVar;
+
+ pfile_in_zip_read_info->stream.avail_in = (uInt)0;
+
+ s->pfile_in_zip_read = pfile_in_zip_read_info;
+ s->encrypted = 0;
+
+# ifndef NOUNCRYPT
+ if (password != NULL)
+ {
+ int i;
+ s->pcrc_32_tab = get_crc_table();
+ init_keys(password,s->keys,s->pcrc_32_tab);
+ if (ZSEEK64(s->z_filefunc, s->filestream,
+ s->pfile_in_zip_read->pos_in_zipfile +
+ s->pfile_in_zip_read->byte_before_the_zipfile,
+ SEEK_SET)!=0)
+ return UNZ_INTERNALERROR;
+ if(ZREAD64(s->z_filefunc, s->filestream,source, 12)<12)
+ return UNZ_INTERNALERROR;
+
+ for (i = 0; i<12; i++)
+ zdecode(s->keys,s->pcrc_32_tab,source[i]);
+
+ s->pfile_in_zip_read->pos_in_zipfile+=12;
+ s->encrypted=1;
+ }
+# endif
+
+
+ return UNZ_OK;
+}
+
+extern int ZEXPORT unzOpenCurrentFile (unzFile file)
+{
+ return unzOpenCurrentFile3(file, NULL, NULL, 0, NULL);
+}
+
+extern int ZEXPORT unzOpenCurrentFilePassword (unzFile file, const char* password)
+{
+ return unzOpenCurrentFile3(file, NULL, NULL, 0, password);
+}
+
+extern int ZEXPORT unzOpenCurrentFile2 (unzFile file, int* method, int* level, int raw)
+{
+ return unzOpenCurrentFile3(file, method, level, raw, NULL);
+}
+
+/** Addition for GDAL : START */
+
+extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64( unzFile file)
+{
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ s=(unz64_s*)file;
+ if (file==NULL)
+ return 0; //UNZ_PARAMERROR;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+ if (pfile_in_zip_read_info==NULL)
+ return 0; //UNZ_PARAMERROR;
+ return pfile_in_zip_read_info->pos_in_zipfile +
+ pfile_in_zip_read_info->byte_before_the_zipfile;
+}
+
+/** Addition for GDAL : END */
+
+/*
+ Read bytes from the current file.
+ buf contain buffer where data must be copied
+ len the size of buf.
+
+ return the number of byte copied if somes bytes are copied
+ return 0 if the end of file was reached
+ return <0 with error code if there is an error
+ (UNZ_ERRNO for IO error, or zLib error for uncompress error)
+*/
+extern int ZEXPORT unzReadCurrentFile (unzFile file, voidp buf, unsigned len)
+{
+ int err=UNZ_OK;
+ uInt iRead = 0;
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_PARAMERROR;
+
+
+ if (pfile_in_zip_read_info->read_buffer == NULL)
+ return UNZ_END_OF_LIST_OF_FILE;
+ if (len==0)
+ return 0;
+
+ pfile_in_zip_read_info->stream.next_out = (Bytef*)buf;
+
+ pfile_in_zip_read_info->stream.avail_out = (uInt)len;
+
+ if ((len>pfile_in_zip_read_info->rest_read_uncompressed) &&
+ (!(pfile_in_zip_read_info->raw)))
+ pfile_in_zip_read_info->stream.avail_out =
+ (uInt)pfile_in_zip_read_info->rest_read_uncompressed;
+
+ if ((len>pfile_in_zip_read_info->rest_read_compressed+
+ pfile_in_zip_read_info->stream.avail_in) &&
+ (pfile_in_zip_read_info->raw))
+ pfile_in_zip_read_info->stream.avail_out =
+ (uInt)pfile_in_zip_read_info->rest_read_compressed+
+ pfile_in_zip_read_info->stream.avail_in;
+
+ while (pfile_in_zip_read_info->stream.avail_out>0)
+ {
+ if ((pfile_in_zip_read_info->stream.avail_in==0) &&
+ (pfile_in_zip_read_info->rest_read_compressed>0))
+ {
+ uInt uReadThis = UNZ_BUFSIZE;
+ if (pfile_in_zip_read_info->rest_read_compressed<uReadThis)
+ uReadThis = (uInt)pfile_in_zip_read_info->rest_read_compressed;
+ if (uReadThis == 0)
+ return UNZ_EOF;
+ if (ZSEEK64(pfile_in_zip_read_info->z_filefunc,
+ pfile_in_zip_read_info->filestream,
+ pfile_in_zip_read_info->pos_in_zipfile +
+ pfile_in_zip_read_info->byte_before_the_zipfile,
+ ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return UNZ_ERRNO;
+ if (ZREAD64(pfile_in_zip_read_info->z_filefunc,
+ pfile_in_zip_read_info->filestream,
+ pfile_in_zip_read_info->read_buffer,
+ uReadThis)!=uReadThis)
+ return UNZ_ERRNO;
+
+
+# ifndef NOUNCRYPT
+ if(s->encrypted)
+ {
+ uInt i;
+ for(i=0;i<uReadThis;i++)
+ pfile_in_zip_read_info->read_buffer[i] =
+ zdecode(s->keys,s->pcrc_32_tab,
+ pfile_in_zip_read_info->read_buffer[i]);
+ }
+# endif
+
+
+ pfile_in_zip_read_info->pos_in_zipfile += uReadThis;
+
+ pfile_in_zip_read_info->rest_read_compressed-=uReadThis;
+
+ pfile_in_zip_read_info->stream.next_in =
+ (Bytef*)pfile_in_zip_read_info->read_buffer;
+ pfile_in_zip_read_info->stream.avail_in = (uInt)uReadThis;
+ }
+
+ if ((pfile_in_zip_read_info->compression_method==0) || (pfile_in_zip_read_info->raw))
+ {
+ uInt uDoCopy,i ;
+
+ if ((pfile_in_zip_read_info->stream.avail_in == 0) &&
+ (pfile_in_zip_read_info->rest_read_compressed == 0))
+ return (iRead==0) ? UNZ_EOF : iRead;
+
+ if (pfile_in_zip_read_info->stream.avail_out <
+ pfile_in_zip_read_info->stream.avail_in)
+ uDoCopy = pfile_in_zip_read_info->stream.avail_out ;
+ else
+ uDoCopy = pfile_in_zip_read_info->stream.avail_in ;
+
+ for (i=0;i<uDoCopy;i++)
+ *(pfile_in_zip_read_info->stream.next_out+i) =
+ *(pfile_in_zip_read_info->stream.next_in+i);
+
+ pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uDoCopy;
+
+ pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,
+ pfile_in_zip_read_info->stream.next_out,
+ uDoCopy);
+ pfile_in_zip_read_info->rest_read_uncompressed-=uDoCopy;
+ pfile_in_zip_read_info->stream.avail_in -= uDoCopy;
+ pfile_in_zip_read_info->stream.avail_out -= uDoCopy;
+ pfile_in_zip_read_info->stream.next_out += uDoCopy;
+ pfile_in_zip_read_info->stream.next_in += uDoCopy;
+ pfile_in_zip_read_info->stream.total_out += uDoCopy;
+ iRead += uDoCopy;
+ }
+ else if (pfile_in_zip_read_info->compression_method==Z_BZIP2ED)
+ {
+#ifdef HAVE_BZIP2
+ uLong uTotalOutBefore,uTotalOutAfter;
+ const Bytef *bufBefore;
+ uLong uOutThis;
+
+ pfile_in_zip_read_info->bstream.next_in = (char*)pfile_in_zip_read_info->stream.next_in;
+ pfile_in_zip_read_info->bstream.avail_in = pfile_in_zip_read_info->stream.avail_in;
+ pfile_in_zip_read_info->bstream.total_in_lo32 = pfile_in_zip_read_info->stream.total_in;
+ pfile_in_zip_read_info->bstream.total_in_hi32 = 0;
+ pfile_in_zip_read_info->bstream.next_out = (char*)pfile_in_zip_read_info->stream.next_out;
+ pfile_in_zip_read_info->bstream.avail_out = pfile_in_zip_read_info->stream.avail_out;
+ pfile_in_zip_read_info->bstream.total_out_lo32 = pfile_in_zip_read_info->stream.total_out;
+ pfile_in_zip_read_info->bstream.total_out_hi32 = 0;
+
+ uTotalOutBefore = pfile_in_zip_read_info->bstream.total_out_lo32;
+ bufBefore = (const Bytef *)pfile_in_zip_read_info->bstream.next_out;
+
+ err=BZ2_bzDecompress(&pfile_in_zip_read_info->bstream);
+
+ uTotalOutAfter = pfile_in_zip_read_info->bstream.total_out_lo32;
+ uOutThis = uTotalOutAfter-uTotalOutBefore;
+
+ pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis;
+
+ pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,bufBefore, (uInt)(uOutThis));
+ pfile_in_zip_read_info->rest_read_uncompressed -= uOutThis;
+ iRead += (uInt)(uTotalOutAfter - uTotalOutBefore);
+
+ pfile_in_zip_read_info->stream.next_in = (Bytef*)pfile_in_zip_read_info->bstream.next_in;
+ pfile_in_zip_read_info->stream.avail_in = pfile_in_zip_read_info->bstream.avail_in;
+ pfile_in_zip_read_info->stream.total_in = pfile_in_zip_read_info->bstream.total_in_lo32;
+ pfile_in_zip_read_info->stream.next_out = (Bytef*)pfile_in_zip_read_info->bstream.next_out;
+ pfile_in_zip_read_info->stream.avail_out = pfile_in_zip_read_info->bstream.avail_out;
+ pfile_in_zip_read_info->stream.total_out = pfile_in_zip_read_info->bstream.total_out_lo32;
+
+ if (err==BZ_STREAM_END)
+ return (iRead==0) ? UNZ_EOF : iRead;
+ if (err!=BZ_OK)
+ break;
+#endif
+ } // end Z_BZIP2ED
+ else
+ {
+ ZPOS64_T uTotalOutBefore,uTotalOutAfter;
+ const Bytef *bufBefore;
+ ZPOS64_T uOutThis;
+ int flush=Z_SYNC_FLUSH;
+
+ uTotalOutBefore = pfile_in_zip_read_info->stream.total_out;
+ bufBefore = pfile_in_zip_read_info->stream.next_out;
+
+ /*
+ if ((pfile_in_zip_read_info->rest_read_uncompressed ==
+ pfile_in_zip_read_info->stream.avail_out) &&
+ (pfile_in_zip_read_info->rest_read_compressed == 0))
+ flush = Z_FINISH;
+ */
+ err=inflate(&pfile_in_zip_read_info->stream,flush);
+
+ if ((err>=0) && (pfile_in_zip_read_info->stream.msg!=NULL))
+ err = Z_DATA_ERROR;
+
+ uTotalOutAfter = pfile_in_zip_read_info->stream.total_out;
+ uOutThis = uTotalOutAfter-uTotalOutBefore;
+
+ pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis;
+
+ pfile_in_zip_read_info->crc32 =
+ crc32(pfile_in_zip_read_info->crc32,bufBefore,
+ (uInt)(uOutThis));
+
+ pfile_in_zip_read_info->rest_read_uncompressed -=
+ uOutThis;
+
+ iRead += (uInt)(uTotalOutAfter - uTotalOutBefore);
+
+ if (err==Z_STREAM_END)
+ return (iRead==0) ? UNZ_EOF : iRead;
+ if (err!=Z_OK)
+ break;
+ }
+ }
+
+ if (err==Z_OK)
+ return iRead;
+ return err;
+}
+
+
+/*
+ Give the current position in uncompressed data
+*/
+extern z_off_t ZEXPORT unztell (unzFile file)
+{
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_PARAMERROR;
+
+ return (z_off_t)pfile_in_zip_read_info->stream.total_out;
+}
+
+extern ZPOS64_T ZEXPORT unztell64 (unzFile file)
+{
+
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ if (file==NULL)
+ return (ZPOS64_T)-1;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return (ZPOS64_T)-1;
+
+ return pfile_in_zip_read_info->total_out_64;
+}
+
+
+/*
+ return 1 if the end of file was reached, 0 elsewhere
+*/
+extern int ZEXPORT unzeof (unzFile file)
+{
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_PARAMERROR;
+
+ if (pfile_in_zip_read_info->rest_read_uncompressed == 0)
+ return 1;
+ else
+ return 0;
+}
+
+
+
+/*
+Read extra field from the current file (opened by unzOpenCurrentFile)
+This is the local-header version of the extra field (sometimes, there is
+more info in the local-header version than in the central-header)
+
+ if buf==NULL, it return the size of the local extra field that can be read
+
+ if buf!=NULL, len is the size of the buffer, the extra header is copied in
+ buf.
+ the return value is the number of bytes copied in buf, or (if <0)
+ the error code
+*/
+extern int ZEXPORT unzGetLocalExtrafield (unzFile file, voidp buf, unsigned len)
+{
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ uInt read_now;
+ ZPOS64_T size_to_read;
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_PARAMERROR;
+
+ size_to_read = (pfile_in_zip_read_info->size_local_extrafield -
+ pfile_in_zip_read_info->pos_local_extrafield);
+
+ if (buf==NULL)
+ return (int)size_to_read;
+
+ if (len>size_to_read)
+ read_now = (uInt)size_to_read;
+ else
+ read_now = (uInt)len ;
+
+ if (read_now==0)
+ return 0;
+
+ if (ZSEEK64(pfile_in_zip_read_info->z_filefunc,
+ pfile_in_zip_read_info->filestream,
+ pfile_in_zip_read_info->offset_local_extrafield +
+ pfile_in_zip_read_info->pos_local_extrafield,
+ ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return UNZ_ERRNO;
+
+ if (ZREAD64(pfile_in_zip_read_info->z_filefunc,
+ pfile_in_zip_read_info->filestream,
+ buf,read_now)!=read_now)
+ return UNZ_ERRNO;
+
+ return (int)read_now;
+}
+
+/*
+ Close the file in zip opened with unzOpenCurrentFile
+ Return UNZ_CRCERROR if all the file was read but the CRC is not good
+*/
+extern int ZEXPORT unzCloseCurrentFile (unzFile file)
+{
+ int err=UNZ_OK;
+
+ unz64_s* s;
+ file_in_zip64_read_info_s* pfile_in_zip_read_info;
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ pfile_in_zip_read_info=s->pfile_in_zip_read;
+
+ if (pfile_in_zip_read_info==NULL)
+ return UNZ_PARAMERROR;
+
+
+ if ((pfile_in_zip_read_info->rest_read_uncompressed == 0) &&
+ (!pfile_in_zip_read_info->raw))
+ {
+ if (pfile_in_zip_read_info->crc32 != pfile_in_zip_read_info->crc32_wait)
+ err=UNZ_CRCERROR;
+ }
+
+
+ TRYFREE(pfile_in_zip_read_info->read_buffer);
+ pfile_in_zip_read_info->read_buffer = NULL;
+ if (pfile_in_zip_read_info->stream_initialised == Z_DEFLATED)
+ inflateEnd(&pfile_in_zip_read_info->stream);
+#ifdef HAVE_BZIP2
+ else if (pfile_in_zip_read_info->stream_initialised == Z_BZIP2ED)
+ BZ2_bzDecompressEnd(&pfile_in_zip_read_info->bstream);
+#endif
+
+
+ pfile_in_zip_read_info->stream_initialised = 0;
+ TRYFREE(pfile_in_zip_read_info);
+
+ s->pfile_in_zip_read=NULL;
+
+ return err;
+}
+
+
+/*
+ Get the global comment string of the ZipFile, in the szComment buffer.
+ uSizeBuf is the size of the szComment buffer.
+ return the number of byte copied or an error code <0
+*/
+extern int ZEXPORT unzGetGlobalComment (unzFile file, char * szComment, uLong uSizeBuf)
+{
+ unz64_s* s;
+ uLong uReadThis ;
+ if (file==NULL)
+ return (int)UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+
+ uReadThis = uSizeBuf;
+ if (uReadThis>s->gi.size_comment)
+ uReadThis = s->gi.size_comment;
+
+ if (ZSEEK64(s->z_filefunc,s->filestream,s->central_pos+22,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return UNZ_ERRNO;
+
+ if (uReadThis>0)
+ {
+ *szComment='\0';
+ if (ZREAD64(s->z_filefunc,s->filestream,szComment,uReadThis)!=uReadThis)
+ return UNZ_ERRNO;
+ }
+
+ if ((szComment != NULL) && (uSizeBuf > s->gi.size_comment))
+ *(szComment+s->gi.size_comment)='\0';
+ return (int)uReadThis;
+}
+
+/* Additions by RX '2004 */
+extern ZPOS64_T ZEXPORT unzGetOffset64(unzFile file)
+{
+ unz64_s* s;
+
+ if (file==NULL)
+ return 0; //UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+ if (!s->current_file_ok)
+ return 0;
+ if (s->gi.number_entry != 0 && s->gi.number_entry != 0xffff)
+ if (s->num_file==s->gi.number_entry)
+ return 0;
+ return s->pos_in_central_dir;
+}
+
+extern uLong ZEXPORT unzGetOffset (unzFile file)
+{
+ ZPOS64_T offset64;
+
+ if (file==NULL)
+ return 0; //UNZ_PARAMERROR;
+ offset64 = unzGetOffset64(file);
+ return (uLong)offset64;
+}
+
+extern int ZEXPORT unzSetOffset64(unzFile file, ZPOS64_T pos)
+{
+ unz64_s* s;
+ int err;
+
+ if (file==NULL)
+ return UNZ_PARAMERROR;
+ s=(unz64_s*)file;
+
+ s->pos_in_central_dir = pos;
+ s->num_file = s->gi.number_entry; /* hack */
+ err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
+ &s->cur_file_info_internal,
+ NULL,0,NULL,0,NULL,0);
+ s->current_file_ok = (err == UNZ_OK);
+ return err;
+}
+
+extern int ZEXPORT unzSetOffset (unzFile file, uLong pos)
+{
+ return unzSetOffset64(file,pos);
+}
diff --git a/compat/zlib/contrib/minizip/unzip.h b/compat/zlib/contrib/minizip/unzip.h
new file mode 100644
index 0000000..2104e39
--- /dev/null
+++ b/compat/zlib/contrib/minizip/unzip.h
@@ -0,0 +1,437 @@
+/* unzip.h -- IO for uncompress .zip files using zlib
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications of Unzip for Zip64
+ Copyright (C) 2007-2008 Even Rouault
+
+ Modifications for Zip64 support on both zip and unzip
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+ ---------------------------------------------------------------------------------
+
+ Condition of use and distribution are the same than zlib :
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ ---------------------------------------------------------------------------------
+
+ Changes
+
+ See header of unzip64.c
+
+*/
+
+#ifndef _unz64_H
+#define _unz64_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef _ZLIB_H
+#include "zlib.h"
+#endif
+
+#ifndef _ZLIBIOAPI_H
+#include "ioapi.h"
+#endif
+
+#ifdef HAVE_BZIP2
+#include "bzlib.h"
+#endif
+
+#define Z_BZIP2ED 12
+
+#if defined(STRICTUNZIP) || defined(STRICTZIPUNZIP)
+/* like the STRICT of WIN32, we define a pointer that cannot be converted
+ from (void*) without cast */
+typedef struct TagunzFile__ { int unused; } unzFile__;
+typedef unzFile__ *unzFile;
+#else
+typedef voidp unzFile;
+#endif
+
+
+#define UNZ_OK (0)
+#define UNZ_END_OF_LIST_OF_FILE (-100)
+#define UNZ_ERRNO (Z_ERRNO)
+#define UNZ_EOF (0)
+#define UNZ_PARAMERROR (-102)
+#define UNZ_BADZIPFILE (-103)
+#define UNZ_INTERNALERROR (-104)
+#define UNZ_CRCERROR (-105)
+
+/* tm_unz contain date/time info */
+typedef struct tm_unz_s
+{
+ uInt tm_sec; /* seconds after the minute - [0,59] */
+ uInt tm_min; /* minutes after the hour - [0,59] */
+ uInt tm_hour; /* hours since midnight - [0,23] */
+ uInt tm_mday; /* day of the month - [1,31] */
+ uInt tm_mon; /* months since January - [0,11] */
+ uInt tm_year; /* years - [1980..2044] */
+} tm_unz;
+
+/* unz_global_info structure contain global data about the ZIPfile
+ These data comes from the end of central dir */
+typedef struct unz_global_info64_s
+{
+ ZPOS64_T number_entry; /* total number of entries in
+ the central dir on this disk */
+ uLong size_comment; /* size of the global comment of the zipfile */
+} unz_global_info64;
+
+typedef struct unz_global_info_s
+{
+ uLong number_entry; /* total number of entries in
+ the central dir on this disk */
+ uLong size_comment; /* size of the global comment of the zipfile */
+} unz_global_info;
+
+/* unz_file_info contain information about a file in the zipfile */
+typedef struct unz_file_info64_s
+{
+ uLong version; /* version made by 2 bytes */
+ uLong version_needed; /* version needed to extract 2 bytes */
+ uLong flag; /* general purpose bit flag 2 bytes */
+ uLong compression_method; /* compression method 2 bytes */
+ uLong dosDate; /* last mod file date in Dos fmt 4 bytes */
+ uLong crc; /* crc-32 4 bytes */
+ ZPOS64_T compressed_size; /* compressed size 8 bytes */
+ ZPOS64_T uncompressed_size; /* uncompressed size 8 bytes */
+ uLong size_filename; /* filename length 2 bytes */
+ uLong size_file_extra; /* extra field length 2 bytes */
+ uLong size_file_comment; /* file comment length 2 bytes */
+
+ uLong disk_num_start; /* disk number start 2 bytes */
+ uLong internal_fa; /* internal file attributes 2 bytes */
+ uLong external_fa; /* external file attributes 4 bytes */
+
+ tm_unz tmu_date;
+} unz_file_info64;
+
+typedef struct unz_file_info_s
+{
+ uLong version; /* version made by 2 bytes */
+ uLong version_needed; /* version needed to extract 2 bytes */
+ uLong flag; /* general purpose bit flag 2 bytes */
+ uLong compression_method; /* compression method 2 bytes */
+ uLong dosDate; /* last mod file date in Dos fmt 4 bytes */
+ uLong crc; /* crc-32 4 bytes */
+ uLong compressed_size; /* compressed size 4 bytes */
+ uLong uncompressed_size; /* uncompressed size 4 bytes */
+ uLong size_filename; /* filename length 2 bytes */
+ uLong size_file_extra; /* extra field length 2 bytes */
+ uLong size_file_comment; /* file comment length 2 bytes */
+
+ uLong disk_num_start; /* disk number start 2 bytes */
+ uLong internal_fa; /* internal file attributes 2 bytes */
+ uLong external_fa; /* external file attributes 4 bytes */
+
+ tm_unz tmu_date;
+} unz_file_info;
+
+extern int ZEXPORT unzStringFileNameCompare OF ((const char* fileName1,
+ const char* fileName2,
+ int iCaseSensitivity));
+/*
+ Compare two filename (fileName1,fileName2).
+ If iCaseSenisivity = 1, comparision is case sensitivity (like strcmp)
+ If iCaseSenisivity = 2, comparision is not case sensitivity (like strcmpi
+ or strcasecmp)
+ If iCaseSenisivity = 0, case sensitivity is defaut of your operating system
+ (like 1 on Unix, 2 on Windows)
+*/
+
+
+extern unzFile ZEXPORT unzOpen OF((const char *path));
+extern unzFile ZEXPORT unzOpen64 OF((const void *path));
+/*
+ Open a Zip file. path contain the full pathname (by example,
+ on a Windows XP computer "c:\\zlib\\zlib113.zip" or on an Unix computer
+ "zlib/zlib113.zip".
+ If the zipfile cannot be opened (file don't exist or in not valid), the
+ return value is NULL.
+ Else, the return value is a unzFile Handle, usable with other function
+ of this unzip package.
+ the "64" function take a const void* pointer, because the path is just the
+ value passed to the open64_file_func callback.
+ Under Windows, if UNICODE is defined, using fill_fopen64_filefunc, the path
+ is a pointer to a wide unicode string (LPCTSTR is LPCWSTR), so const char*
+ does not describe the reality
+*/
+
+
+extern unzFile ZEXPORT unzOpen2 OF((const char *path,
+ zlib_filefunc_def* pzlib_filefunc_def));
+/*
+ Open a Zip file, like unzOpen, but provide a set of file low level API
+ for read/write the zip file (see ioapi.h)
+*/
+
+extern unzFile ZEXPORT unzOpen2_64 OF((const void *path,
+ zlib_filefunc64_def* pzlib_filefunc_def));
+/*
+ Open a Zip file, like unz64Open, but provide a set of file low level API
+ for read/write the zip file (see ioapi.h)
+*/
+
+extern int ZEXPORT unzClose OF((unzFile file));
+/*
+ Close a ZipFile opened with unzOpen.
+ If there is files inside the .Zip opened with unzOpenCurrentFile (see later),
+ these files MUST be closed with unzCloseCurrentFile before call unzClose.
+ return UNZ_OK if there is no problem. */
+
+extern int ZEXPORT unzGetGlobalInfo OF((unzFile file,
+ unz_global_info *pglobal_info));
+
+extern int ZEXPORT unzGetGlobalInfo64 OF((unzFile file,
+ unz_global_info64 *pglobal_info));
+/*
+ Write info about the ZipFile in the *pglobal_info structure.
+ No preparation of the structure is needed
+ return UNZ_OK if there is no problem. */
+
+
+extern int ZEXPORT unzGetGlobalComment OF((unzFile file,
+ char *szComment,
+ uLong uSizeBuf));
+/*
+ Get the global comment string of the ZipFile, in the szComment buffer.
+ uSizeBuf is the size of the szComment buffer.
+ return the number of byte copied or an error code <0
+*/
+
+
+/***************************************************************************/
+/* Unzip package allow you browse the directory of the zipfile */
+
+extern int ZEXPORT unzGoToFirstFile OF((unzFile file));
+/*
+ Set the current file of the zipfile to the first file.
+ return UNZ_OK if there is no problem
+*/
+
+extern int ZEXPORT unzGoToNextFile OF((unzFile file));
+/*
+ Set the current file of the zipfile to the next file.
+ return UNZ_OK if there is no problem
+ return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest.
+*/
+
+extern int ZEXPORT unzLocateFile OF((unzFile file,
+ const char *szFileName,
+ int iCaseSensitivity));
+/*
+ Try locate the file szFileName in the zipfile.
+ For the iCaseSensitivity signification, see unzStringFileNameCompare
+
+ return value :
+ UNZ_OK if the file is found. It becomes the current file.
+ UNZ_END_OF_LIST_OF_FILE if the file is not found
+*/
+
+
+/* ****************************************** */
+/* Ryan supplied functions */
+/* unz_file_info contain information about a file in the zipfile */
+typedef struct unz_file_pos_s
+{
+ uLong pos_in_zip_directory; /* offset in zip file directory */
+ uLong num_of_file; /* # of file */
+} unz_file_pos;
+
+extern int ZEXPORT unzGetFilePos(
+ unzFile file,
+ unz_file_pos* file_pos);
+
+extern int ZEXPORT unzGoToFilePos(
+ unzFile file,
+ unz_file_pos* file_pos);
+
+typedef struct unz64_file_pos_s
+{
+ ZPOS64_T pos_in_zip_directory; /* offset in zip file directory */
+ ZPOS64_T num_of_file; /* # of file */
+} unz64_file_pos;
+
+extern int ZEXPORT unzGetFilePos64(
+ unzFile file,
+ unz64_file_pos* file_pos);
+
+extern int ZEXPORT unzGoToFilePos64(
+ unzFile file,
+ const unz64_file_pos* file_pos);
+
+/* ****************************************** */
+
+extern int ZEXPORT unzGetCurrentFileInfo64 OF((unzFile file,
+ unz_file_info64 *pfile_info,
+ char *szFileName,
+ uLong fileNameBufferSize,
+ void *extraField,
+ uLong extraFieldBufferSize,
+ char *szComment,
+ uLong commentBufferSize));
+
+extern int ZEXPORT unzGetCurrentFileInfo OF((unzFile file,
+ unz_file_info *pfile_info,
+ char *szFileName,
+ uLong fileNameBufferSize,
+ void *extraField,
+ uLong extraFieldBufferSize,
+ char *szComment,
+ uLong commentBufferSize));
+/*
+ Get Info about the current file
+ if pfile_info!=NULL, the *pfile_info structure will contain somes info about
+ the current file
+ if szFileName!=NULL, the filemane string will be copied in szFileName
+ (fileNameBufferSize is the size of the buffer)
+ if extraField!=NULL, the extra field information will be copied in extraField
+ (extraFieldBufferSize is the size of the buffer).
+ This is the Central-header version of the extra field
+ if szComment!=NULL, the comment string of the file will be copied in szComment
+ (commentBufferSize is the size of the buffer)
+*/
+
+
+/** Addition for GDAL : START */
+
+extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64 OF((unzFile file));
+
+/** Addition for GDAL : END */
+
+
+/***************************************************************************/
+/* for reading the content of the current zipfile, you can open it, read data
+ from it, and close it (you can close it before reading all the file)
+ */
+
+extern int ZEXPORT unzOpenCurrentFile OF((unzFile file));
+/*
+ Open for reading data the current file in the zipfile.
+ If there is no error, the return value is UNZ_OK.
+*/
+
+extern int ZEXPORT unzOpenCurrentFilePassword OF((unzFile file,
+ const char* password));
+/*
+ Open for reading data the current file in the zipfile.
+ password is a crypting password
+ If there is no error, the return value is UNZ_OK.
+*/
+
+extern int ZEXPORT unzOpenCurrentFile2 OF((unzFile file,
+ int* method,
+ int* level,
+ int raw));
+/*
+ Same than unzOpenCurrentFile, but open for read raw the file (not uncompress)
+ if raw==1
+ *method will receive method of compression, *level will receive level of
+ compression
+ note : you can set level parameter as NULL (if you did not want known level,
+ but you CANNOT set method parameter as NULL
+*/
+
+extern int ZEXPORT unzOpenCurrentFile3 OF((unzFile file,
+ int* method,
+ int* level,
+ int raw,
+ const char* password));
+/*
+ Same than unzOpenCurrentFile, but open for read raw the file (not uncompress)
+ if raw==1
+ *method will receive method of compression, *level will receive level of
+ compression
+ note : you can set level parameter as NULL (if you did not want known level,
+ but you CANNOT set method parameter as NULL
+*/
+
+
+extern int ZEXPORT unzCloseCurrentFile OF((unzFile file));
+/*
+ Close the file in zip opened with unzOpenCurrentFile
+ Return UNZ_CRCERROR if all the file was read but the CRC is not good
+*/
+
+extern int ZEXPORT unzReadCurrentFile OF((unzFile file,
+ voidp buf,
+ unsigned len));
+/*
+ Read bytes from the current file (opened by unzOpenCurrentFile)
+ buf contain buffer where data must be copied
+ len the size of buf.
+
+ return the number of byte copied if somes bytes are copied
+ return 0 if the end of file was reached
+ return <0 with error code if there is an error
+ (UNZ_ERRNO for IO error, or zLib error for uncompress error)
+*/
+
+extern z_off_t ZEXPORT unztell OF((unzFile file));
+
+extern ZPOS64_T ZEXPORT unztell64 OF((unzFile file));
+/*
+ Give the current position in uncompressed data
+*/
+
+extern int ZEXPORT unzeof OF((unzFile file));
+/*
+ return 1 if the end of file was reached, 0 elsewhere
+*/
+
+extern int ZEXPORT unzGetLocalExtrafield OF((unzFile file,
+ voidp buf,
+ unsigned len));
+/*
+ Read extra field from the current file (opened by unzOpenCurrentFile)
+ This is the local-header version of the extra field (sometimes, there is
+ more info in the local-header version than in the central-header)
+
+ if buf==NULL, it return the size of the local extra field
+
+ if buf!=NULL, len is the size of the buffer, the extra header is copied in
+ buf.
+ the return value is the number of bytes copied in buf, or (if <0)
+ the error code
+*/
+
+/***************************************************************************/
+
+/* Get the current file offset */
+extern ZPOS64_T ZEXPORT unzGetOffset64 (unzFile file);
+extern uLong ZEXPORT unzGetOffset (unzFile file);
+
+/* Set the current file offset */
+extern int ZEXPORT unzSetOffset64 (unzFile file, ZPOS64_T pos);
+extern int ZEXPORT unzSetOffset (unzFile file, uLong pos);
+
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _unz64_H */
diff --git a/compat/zlib/contrib/minizip/zip.c b/compat/zlib/contrib/minizip/zip.c
new file mode 100644
index 0000000..ea54853
--- /dev/null
+++ b/compat/zlib/contrib/minizip/zip.c
@@ -0,0 +1,2007 @@
+/* zip.c -- IO on .zip files using zlib
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+ Changes
+ Oct-2009 - Mathias Svensson - Remove old C style function prototypes
+ Oct-2009 - Mathias Svensson - Added Zip64 Support when creating new file archives
+ Oct-2009 - Mathias Svensson - Did some code cleanup and refactoring to get better overview of some functions.
+ Oct-2009 - Mathias Svensson - Added zipRemoveExtraInfoBlock to strip extra field data from its ZIP64 data
+ It is used when recreting zip archive with RAW when deleting items from a zip.
+ ZIP64 data is automaticly added to items that needs it, and existing ZIP64 data need to be removed.
+ Oct-2009 - Mathias Svensson - Added support for BZIP2 as compression mode (bzip2 lib is required)
+ Jan-2010 - back to unzip and minizip 1.0 name scheme, with compatibility layer
+
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+#include "zlib.h"
+#include "zip.h"
+
+#ifdef STDC
+# include <stddef.h>
+# include <string.h>
+# include <stdlib.h>
+#endif
+#ifdef NO_ERRNO_H
+ extern int errno;
+#else
+# include <errno.h>
+#endif
+
+
+#ifndef local
+# define local static
+#endif
+/* compile with -Dlocal if your debugger can't find static symbols */
+
+#ifndef VERSIONMADEBY
+# define VERSIONMADEBY (0x0) /* platform depedent */
+#endif
+
+#ifndef Z_BUFSIZE
+#define Z_BUFSIZE (64*1024) //(16384)
+#endif
+
+#ifndef Z_MAXFILENAMEINZIP
+#define Z_MAXFILENAMEINZIP (256)
+#endif
+
+#ifndef ALLOC
+# define ALLOC(size) (malloc(size))
+#endif
+#ifndef TRYFREE
+# define TRYFREE(p) {if (p) free(p);}
+#endif
+
+/*
+#define SIZECENTRALDIRITEM (0x2e)
+#define SIZEZIPLOCALHEADER (0x1e)
+*/
+
+/* I've found an old Unix (a SunOS 4.1.3_U1) without all SEEK_* defined.... */
+
+
+// NOT sure that this work on ALL platform
+#define MAKEULONG64(a, b) ((ZPOS64_T)(((unsigned long)(a)) | ((ZPOS64_T)((unsigned long)(b))) << 32))
+
+#ifndef SEEK_CUR
+#define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#endif
+
+#ifndef DEF_MEM_LEVEL
+#if MAX_MEM_LEVEL >= 8
+# define DEF_MEM_LEVEL 8
+#else
+# define DEF_MEM_LEVEL MAX_MEM_LEVEL
+#endif
+#endif
+const char zip_copyright[] =" zip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll";
+
+
+#define SIZEDATA_INDATABLOCK (4096-(4*4))
+
+#define LOCALHEADERMAGIC (0x04034b50)
+#define CENTRALHEADERMAGIC (0x02014b50)
+#define ENDHEADERMAGIC (0x06054b50)
+#define ZIP64ENDHEADERMAGIC (0x6064b50)
+#define ZIP64ENDLOCHEADERMAGIC (0x7064b50)
+
+#define FLAG_LOCALHEADER_OFFSET (0x06)
+#define CRC_LOCALHEADER_OFFSET (0x0e)
+
+#define SIZECENTRALHEADER (0x2e) /* 46 */
+
+typedef struct linkedlist_datablock_internal_s
+{
+ struct linkedlist_datablock_internal_s* next_datablock;
+ uLong avail_in_this_block;
+ uLong filled_in_this_block;
+ uLong unused; /* for future use and alignement */
+ unsigned char data[SIZEDATA_INDATABLOCK];
+} linkedlist_datablock_internal;
+
+typedef struct linkedlist_data_s
+{
+ linkedlist_datablock_internal* first_block;
+ linkedlist_datablock_internal* last_block;
+} linkedlist_data;
+
+
+typedef struct
+{
+ z_stream stream; /* zLib stream structure for inflate */
+#ifdef HAVE_BZIP2
+ bz_stream bstream; /* bzLib stream structure for bziped */
+#endif
+
+ int stream_initialised; /* 1 is stream is initialised */
+ uInt pos_in_buffered_data; /* last written byte in buffered_data */
+
+ ZPOS64_T pos_local_header; /* offset of the local header of the file
+ currenty writing */
+ char* central_header; /* central header data for the current file */
+ uLong size_centralExtra;
+ uLong size_centralheader; /* size of the central header for cur file */
+ uLong size_centralExtraFree; /* Extra bytes allocated to the centralheader but that are not used */
+ uLong flag; /* flag of the file currently writing */
+
+ int method; /* compression method of file currenty wr.*/
+ int raw; /* 1 for directly writing raw data */
+ Byte buffered_data[Z_BUFSIZE];/* buffer contain compressed data to be writ*/
+ uLong dosDate;
+ uLong crc32;
+ int encrypt;
+ int zip64; /* Add ZIP64 extened information in the extra field */
+ ZPOS64_T pos_zip64extrainfo;
+ ZPOS64_T totalCompressedData;
+ ZPOS64_T totalUncompressedData;
+#ifndef NOCRYPT
+ unsigned long keys[3]; /* keys defining the pseudo-random sequence */
+ const z_crc_t* pcrc_32_tab;
+ int crypt_header_size;
+#endif
+} curfile64_info;
+
+typedef struct
+{
+ zlib_filefunc64_32_def z_filefunc;
+ voidpf filestream; /* io structore of the zipfile */
+ linkedlist_data central_dir;/* datablock with central dir in construction*/
+ int in_opened_file_inzip; /* 1 if a file in the zip is currently writ.*/
+ curfile64_info ci; /* info on the file curretly writing */
+
+ ZPOS64_T begin_pos; /* position of the beginning of the zipfile */
+ ZPOS64_T add_position_when_writting_offset;
+ ZPOS64_T number_entry;
+
+#ifndef NO_ADDFILEINEXISTINGZIP
+ char *globalcomment;
+#endif
+
+} zip64_internal;
+
+
+#ifndef NOCRYPT
+#define INCLUDECRYPTINGCODE_IFCRYPTALLOWED
+#include "crypt.h"
+#endif
+
+local linkedlist_datablock_internal* allocate_new_datablock()
+{
+ linkedlist_datablock_internal* ldi;
+ ldi = (linkedlist_datablock_internal*)
+ ALLOC(sizeof(linkedlist_datablock_internal));
+ if (ldi!=NULL)
+ {
+ ldi->next_datablock = NULL ;
+ ldi->filled_in_this_block = 0 ;
+ ldi->avail_in_this_block = SIZEDATA_INDATABLOCK ;
+ }
+ return ldi;
+}
+
+local void free_datablock(linkedlist_datablock_internal* ldi)
+{
+ while (ldi!=NULL)
+ {
+ linkedlist_datablock_internal* ldinext = ldi->next_datablock;
+ TRYFREE(ldi);
+ ldi = ldinext;
+ }
+}
+
+local void init_linkedlist(linkedlist_data* ll)
+{
+ ll->first_block = ll->last_block = NULL;
+}
+
+local void free_linkedlist(linkedlist_data* ll)
+{
+ free_datablock(ll->first_block);
+ ll->first_block = ll->last_block = NULL;
+}
+
+
+local int add_data_in_datablock(linkedlist_data* ll, const void* buf, uLong len)
+{
+ linkedlist_datablock_internal* ldi;
+ const unsigned char* from_copy;
+
+ if (ll==NULL)
+ return ZIP_INTERNALERROR;
+
+ if (ll->last_block == NULL)
+ {
+ ll->first_block = ll->last_block = allocate_new_datablock();
+ if (ll->first_block == NULL)
+ return ZIP_INTERNALERROR;
+ }
+
+ ldi = ll->last_block;
+ from_copy = (unsigned char*)buf;
+
+ while (len>0)
+ {
+ uInt copy_this;
+ uInt i;
+ unsigned char* to_copy;
+
+ if (ldi->avail_in_this_block==0)
+ {
+ ldi->next_datablock = allocate_new_datablock();
+ if (ldi->next_datablock == NULL)
+ return ZIP_INTERNALERROR;
+ ldi = ldi->next_datablock ;
+ ll->last_block = ldi;
+ }
+
+ if (ldi->avail_in_this_block < len)
+ copy_this = (uInt)ldi->avail_in_this_block;
+ else
+ copy_this = (uInt)len;
+
+ to_copy = &(ldi->data[ldi->filled_in_this_block]);
+
+ for (i=0;i<copy_this;i++)
+ *(to_copy+i)=*(from_copy+i);
+
+ ldi->filled_in_this_block += copy_this;
+ ldi->avail_in_this_block -= copy_this;
+ from_copy += copy_this ;
+ len -= copy_this;
+ }
+ return ZIP_OK;
+}
+
+
+
+/****************************************************************************/
+
+#ifndef NO_ADDFILEINEXISTINGZIP
+/* ===========================================================================
+ Inputs a long in LSB order to the given file
+ nbByte == 1, 2 ,4 or 8 (byte, short or long, ZPOS64_T)
+*/
+
+local int zip64local_putValue OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T x, int nbByte));
+local int zip64local_putValue (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T x, int nbByte)
+{
+ unsigned char buf[8];
+ int n;
+ for (n = 0; n < nbByte; n++)
+ {
+ buf[n] = (unsigned char)(x & 0xff);
+ x >>= 8;
+ }
+ if (x != 0)
+ { /* data overflow - hack for ZIP64 (X Roche) */
+ for (n = 0; n < nbByte; n++)
+ {
+ buf[n] = 0xff;
+ }
+ }
+
+ if (ZWRITE64(*pzlib_filefunc_def,filestream,buf,nbByte)!=(uLong)nbByte)
+ return ZIP_ERRNO;
+ else
+ return ZIP_OK;
+}
+
+local void zip64local_putValue_inmemory OF((void* dest, ZPOS64_T x, int nbByte));
+local void zip64local_putValue_inmemory (void* dest, ZPOS64_T x, int nbByte)
+{
+ unsigned char* buf=(unsigned char*)dest;
+ int n;
+ for (n = 0; n < nbByte; n++) {
+ buf[n] = (unsigned char)(x & 0xff);
+ x >>= 8;
+ }
+
+ if (x != 0)
+ { /* data overflow - hack for ZIP64 */
+ for (n = 0; n < nbByte; n++)
+ {
+ buf[n] = 0xff;
+ }
+ }
+}
+
+/****************************************************************************/
+
+
+local uLong zip64local_TmzDateToDosDate(const tm_zip* ptm)
+{
+ uLong year = (uLong)ptm->tm_year;
+ if (year>=1980)
+ year-=1980;
+ else if (year>=80)
+ year-=80;
+ return
+ (uLong) (((ptm->tm_mday) + (32 * (ptm->tm_mon+1)) + (512 * year)) << 16) |
+ ((ptm->tm_sec/2) + (32* ptm->tm_min) + (2048 * (uLong)ptm->tm_hour));
+}
+
+
+/****************************************************************************/
+
+local int zip64local_getByte OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, int *pi));
+
+local int zip64local_getByte(const zlib_filefunc64_32_def* pzlib_filefunc_def,voidpf filestream,int* pi)
+{
+ unsigned char c;
+ int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,&c,1);
+ if (err==1)
+ {
+ *pi = (int)c;
+ return ZIP_OK;
+ }
+ else
+ {
+ if (ZERROR64(*pzlib_filefunc_def,filestream))
+ return ZIP_ERRNO;
+ else
+ return ZIP_EOF;
+ }
+}
+
+
+/* ===========================================================================
+ Reads a long in LSB order from the given gz_stream. Sets
+*/
+local int zip64local_getShort OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX));
+
+local int zip64local_getShort (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX)
+{
+ uLong x ;
+ int i = 0;
+ int err;
+
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (uLong)i;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((uLong)i)<<8;
+
+ if (err==ZIP_OK)
+ *pX = x;
+ else
+ *pX = 0;
+ return err;
+}
+
+local int zip64local_getLong OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX));
+
+local int zip64local_getLong (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX)
+{
+ uLong x ;
+ int i = 0;
+ int err;
+
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (uLong)i;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((uLong)i)<<8;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((uLong)i)<<16;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((uLong)i)<<24;
+
+ if (err==ZIP_OK)
+ *pX = x;
+ else
+ *pX = 0;
+ return err;
+}
+
+local int zip64local_getLong64 OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX));
+
+
+local int zip64local_getLong64 (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX)
+{
+ ZPOS64_T x;
+ int i = 0;
+ int err;
+
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x = (ZPOS64_T)i;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<8;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<16;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<24;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<32;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<40;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<48;
+
+ if (err==ZIP_OK)
+ err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
+ x += ((ZPOS64_T)i)<<56;
+
+ if (err==ZIP_OK)
+ *pX = x;
+ else
+ *pX = 0;
+
+ return err;
+}
+
+#ifndef BUFREADCOMMENT
+#define BUFREADCOMMENT (0x400)
+#endif
+/*
+ Locate the Central directory of a zipfile (at the end, just before
+ the global comment)
+*/
+local ZPOS64_T zip64local_SearchCentralDir OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));
+
+local ZPOS64_T zip64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
+{
+ unsigned char* buf;
+ ZPOS64_T uSizeFile;
+ ZPOS64_T uBackRead;
+ ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
+ ZPOS64_T uPosFound=0;
+
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
+ return 0;
+
+
+ uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);
+
+ if (uMaxBack>uSizeFile)
+ uMaxBack = uSizeFile;
+
+ buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
+ if (buf==NULL)
+ return 0;
+
+ uBackRead = 4;
+ while (uBackRead<uMaxBack)
+ {
+ uLong uReadSize;
+ ZPOS64_T uReadPos ;
+ int i;
+ if (uBackRead+BUFREADCOMMENT>uMaxBack)
+ uBackRead = uMaxBack;
+ else
+ uBackRead+=BUFREADCOMMENT;
+ uReadPos = uSizeFile-uBackRead ;
+
+ uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
+ (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ break;
+
+ if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
+ break;
+
+ for (i=(int)uReadSize-3; (i--)>0;)
+ if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
+ ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06))
+ {
+ uPosFound = uReadPos+i;
+ break;
+ }
+
+ if (uPosFound!=0)
+ break;
+ }
+ TRYFREE(buf);
+ return uPosFound;
+}
+
+/*
+Locate the End of Zip64 Central directory locator and from there find the CD of a zipfile (at the end, just before
+the global comment)
+*/
+local ZPOS64_T zip64local_SearchCentralDir64 OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));
+
+local ZPOS64_T zip64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
+{
+ unsigned char* buf;
+ ZPOS64_T uSizeFile;
+ ZPOS64_T uBackRead;
+ ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
+ ZPOS64_T uPosFound=0;
+ uLong uL;
+ ZPOS64_T relativeOffset;
+
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
+ return 0;
+
+ uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);
+
+ if (uMaxBack>uSizeFile)
+ uMaxBack = uSizeFile;
+
+ buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
+ if (buf==NULL)
+ return 0;
+
+ uBackRead = 4;
+ while (uBackRead<uMaxBack)
+ {
+ uLong uReadSize;
+ ZPOS64_T uReadPos;
+ int i;
+ if (uBackRead+BUFREADCOMMENT>uMaxBack)
+ uBackRead = uMaxBack;
+ else
+ uBackRead+=BUFREADCOMMENT;
+ uReadPos = uSizeFile-uBackRead ;
+
+ uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
+ (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
+ if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ break;
+
+ if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
+ break;
+
+ for (i=(int)uReadSize-3; (i--)>0;)
+ {
+ // Signature "0x07064b50" Zip64 end of central directory locater
+ if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07))
+ {
+ uPosFound = uReadPos+i;
+ break;
+ }
+ }
+
+ if (uPosFound!=0)
+ break;
+ }
+
+ TRYFREE(buf);
+ if (uPosFound == 0)
+ return 0;
+
+ /* Zip64 end of central directory locator */
+ if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return 0;
+
+ /* the signature, already checked */
+ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
+ return 0;
+
+ /* number of the disk with the start of the zip64 end of central directory */
+ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
+ return 0;
+ if (uL != 0)
+ return 0;
+
+ /* relative offset of the zip64 end of central directory record */
+ if (zip64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=ZIP_OK)
+ return 0;
+
+ /* total number of disks */
+ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
+ return 0;
+ if (uL != 1)
+ return 0;
+
+ /* Goto Zip64 end of central directory record */
+ if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ return 0;
+
+ /* the signature */
+ if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
+ return 0;
+
+ if (uL != 0x06064b50) // signature of 'Zip64 end of central directory'
+ return 0;
+
+ return relativeOffset;
+}
+
+int LoadCentralDirectoryRecord(zip64_internal* pziinit)
+{
+ int err=ZIP_OK;
+ ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/
+
+ ZPOS64_T size_central_dir; /* size of the central directory */
+ ZPOS64_T offset_central_dir; /* offset of start of central directory */
+ ZPOS64_T central_pos;
+ uLong uL;
+
+ uLong number_disk; /* number of the current dist, used for
+ spaning ZIP, unsupported, always 0*/
+ uLong number_disk_with_CD; /* number the the disk with central dir, used
+ for spaning ZIP, unsupported, always 0*/
+ ZPOS64_T number_entry;
+ ZPOS64_T number_entry_CD; /* total number of entries in
+ the central dir
+ (same than number_entry on nospan) */
+ uLong VersionMadeBy;
+ uLong VersionNeeded;
+ uLong size_comment;
+
+ int hasZIP64Record = 0;
+
+ // check first if we find a ZIP64 record
+ central_pos = zip64local_SearchCentralDir64(&pziinit->z_filefunc,pziinit->filestream);
+ if(central_pos > 0)
+ {
+ hasZIP64Record = 1;
+ }
+ else if(central_pos == 0)
+ {
+ central_pos = zip64local_SearchCentralDir(&pziinit->z_filefunc,pziinit->filestream);
+ }
+
+/* disable to allow appending to empty ZIP archive
+ if (central_pos==0)
+ err=ZIP_ERRNO;
+*/
+
+ if(hasZIP64Record)
+ {
+ ZPOS64_T sizeEndOfCentralDirectory;
+ if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos, ZLIB_FILEFUNC_SEEK_SET) != 0)
+ err=ZIP_ERRNO;
+
+ /* the signature, already checked */
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* size of zip64 end of central directory record */
+ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &sizeEndOfCentralDirectory)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* version made by */
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionMadeBy)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* version needed to extract */
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionNeeded)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* number of this disk */
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* number of the disk with the start of the central directory */
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* total number of entries in the central directory on this disk */
+ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &number_entry)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* total number of entries in the central directory */
+ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&number_entry_CD)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0))
+ err=ZIP_BADZIPFILE;
+
+ /* size of the central directory */
+ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&size_central_dir)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* offset of start of central directory with respect to the
+ starting disk number */
+ if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&offset_central_dir)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ // TODO..
+ // read the comment from the standard central header.
+ size_comment = 0;
+ }
+ else
+ {
+ // Read End of central Directory info
+ if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err=ZIP_ERRNO;
+
+ /* the signature, already checked */
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* number of this disk */
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* number of the disk with the start of the central directory */
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK)
+ err=ZIP_ERRNO;
+
+ /* total number of entries in the central dir on this disk */
+ number_entry = 0;
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+ else
+ number_entry = uL;
+
+ /* total number of entries in the central dir */
+ number_entry_CD = 0;
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+ else
+ number_entry_CD = uL;
+
+ if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0))
+ err=ZIP_BADZIPFILE;
+
+ /* size of the central directory */
+ size_central_dir = 0;
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+ else
+ size_central_dir = uL;
+
+ /* offset of start of central directory with respect to the starting disk number */
+ offset_central_dir = 0;
+ if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
+ err=ZIP_ERRNO;
+ else
+ offset_central_dir = uL;
+
+
+ /* zipfile global comment length */
+ if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &size_comment)!=ZIP_OK)
+ err=ZIP_ERRNO;
+ }
+
+ if ((central_pos<offset_central_dir+size_central_dir) &&
+ (err==ZIP_OK))
+ err=ZIP_BADZIPFILE;
+
+ if (err!=ZIP_OK)
+ {
+ ZCLOSE64(pziinit->z_filefunc, pziinit->filestream);
+ return ZIP_ERRNO;
+ }
+
+ if (size_comment>0)
+ {
+ pziinit->globalcomment = (char*)ALLOC(size_comment+1);
+ if (pziinit->globalcomment)
+ {
+ size_comment = ZREAD64(pziinit->z_filefunc, pziinit->filestream, pziinit->globalcomment,size_comment);
+ pziinit->globalcomment[size_comment]=0;
+ }
+ }
+
+ byte_before_the_zipfile = central_pos - (offset_central_dir+size_central_dir);
+ pziinit->add_position_when_writting_offset = byte_before_the_zipfile;
+
+ {
+ ZPOS64_T size_central_dir_to_read = size_central_dir;
+ size_t buf_size = SIZEDATA_INDATABLOCK;
+ void* buf_read = (void*)ALLOC(buf_size);
+ if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir + byte_before_the_zipfile, ZLIB_FILEFUNC_SEEK_SET) != 0)
+ err=ZIP_ERRNO;
+
+ while ((size_central_dir_to_read>0) && (err==ZIP_OK))
+ {
+ ZPOS64_T read_this = SIZEDATA_INDATABLOCK;
+ if (read_this > size_central_dir_to_read)
+ read_this = size_central_dir_to_read;
+
+ if (ZREAD64(pziinit->z_filefunc, pziinit->filestream,buf_read,(uLong)read_this) != read_this)
+ err=ZIP_ERRNO;
+
+ if (err==ZIP_OK)
+ err = add_data_in_datablock(&pziinit->central_dir,buf_read, (uLong)read_this);
+
+ size_central_dir_to_read-=read_this;
+ }
+ TRYFREE(buf_read);
+ }
+ pziinit->begin_pos = byte_before_the_zipfile;
+ pziinit->number_entry = number_entry_CD;
+
+ if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir+byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET) != 0)
+ err=ZIP_ERRNO;
+
+ return err;
+}
+
+
+#endif /* !NO_ADDFILEINEXISTINGZIP*/
+
+
+/************************************************************/
+extern zipFile ZEXPORT zipOpen3 (const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_32_def* pzlib_filefunc64_32_def)
+{
+ zip64_internal ziinit;
+ zip64_internal* zi;
+ int err=ZIP_OK;
+
+ ziinit.z_filefunc.zseek32_file = NULL;
+ ziinit.z_filefunc.ztell32_file = NULL;
+ if (pzlib_filefunc64_32_def==NULL)
+ fill_fopen64_filefunc(&ziinit.z_filefunc.zfile_func64);
+ else
+ ziinit.z_filefunc = *pzlib_filefunc64_32_def;
+
+ ziinit.filestream = ZOPEN64(ziinit.z_filefunc,
+ pathname,
+ (append == APPEND_STATUS_CREATE) ?
+ (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_CREATE) :
+ (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_EXISTING));
+
+ if (ziinit.filestream == NULL)
+ return NULL;
+
+ if (append == APPEND_STATUS_CREATEAFTER)
+ ZSEEK64(ziinit.z_filefunc,ziinit.filestream,0,SEEK_END);
+
+ ziinit.begin_pos = ZTELL64(ziinit.z_filefunc,ziinit.filestream);
+ ziinit.in_opened_file_inzip = 0;
+ ziinit.ci.stream_initialised = 0;
+ ziinit.number_entry = 0;
+ ziinit.add_position_when_writting_offset = 0;
+ init_linkedlist(&(ziinit.central_dir));
+
+
+
+ zi = (zip64_internal*)ALLOC(sizeof(zip64_internal));
+ if (zi==NULL)
+ {
+ ZCLOSE64(ziinit.z_filefunc,ziinit.filestream);
+ return NULL;
+ }
+
+ /* now we add file in a zipfile */
+# ifndef NO_ADDFILEINEXISTINGZIP
+ ziinit.globalcomment = NULL;
+ if (append == APPEND_STATUS_ADDINZIP)
+ {
+ // Read and Cache Central Directory Records
+ err = LoadCentralDirectoryRecord(&ziinit);
+ }
+
+ if (globalcomment)
+ {
+ *globalcomment = ziinit.globalcomment;
+ }
+# endif /* !NO_ADDFILEINEXISTINGZIP*/
+
+ if (err != ZIP_OK)
+ {
+# ifndef NO_ADDFILEINEXISTINGZIP
+ TRYFREE(ziinit.globalcomment);
+# endif /* !NO_ADDFILEINEXISTINGZIP*/
+ TRYFREE(zi);
+ return NULL;
+ }
+ else
+ {
+ *zi = ziinit;
+ return (zipFile)zi;
+ }
+}
+
+extern zipFile ZEXPORT zipOpen2 (const char *pathname, int append, zipcharpc* globalcomment, zlib_filefunc_def* pzlib_filefunc32_def)
+{
+ if (pzlib_filefunc32_def != NULL)
+ {
+ zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
+ fill_zlib_filefunc64_32_def_from_filefunc32(&zlib_filefunc64_32_def_fill,pzlib_filefunc32_def);
+ return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill);
+ }
+ else
+ return zipOpen3(pathname, append, globalcomment, NULL);
+}
+
+extern zipFile ZEXPORT zipOpen2_64 (const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_def* pzlib_filefunc_def)
+{
+ if (pzlib_filefunc_def != NULL)
+ {
+ zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
+ zlib_filefunc64_32_def_fill.zfile_func64 = *pzlib_filefunc_def;
+ zlib_filefunc64_32_def_fill.ztell32_file = NULL;
+ zlib_filefunc64_32_def_fill.zseek32_file = NULL;
+ return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill);
+ }
+ else
+ return zipOpen3(pathname, append, globalcomment, NULL);
+}
+
+
+
+extern zipFile ZEXPORT zipOpen (const char* pathname, int append)
+{
+ return zipOpen3((const void*)pathname,append,NULL,NULL);
+}
+
+extern zipFile ZEXPORT zipOpen64 (const void* pathname, int append)
+{
+ return zipOpen3(pathname,append,NULL,NULL);
+}
+
+int Write_LocalFileHeader(zip64_internal* zi, const char* filename, uInt size_extrafield_local, const void* extrafield_local)
+{
+ /* write the local header */
+ int err;
+ uInt size_filename = (uInt)strlen(filename);
+ uInt size_extrafield = size_extrafield_local;
+
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)LOCALHEADERMAGIC, 4);
+
+ if (err==ZIP_OK)
+ {
+ if(zi->ci.zip64)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);/* version needed to extract */
+ else
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)20,2);/* version needed to extract */
+ }
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.flag,2);
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.method,2);
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.dosDate,4);
+
+ // CRC / Compressed size / Uncompressed size will be filled in later and rewritten later
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* crc 32, unknown */
+ if (err==ZIP_OK)
+ {
+ if(zi->ci.zip64)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* compressed size, unknown */
+ else
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* compressed size, unknown */
+ }
+ if (err==ZIP_OK)
+ {
+ if(zi->ci.zip64)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* uncompressed size, unknown */
+ else
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* uncompressed size, unknown */
+ }
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_filename,2);
+
+ if(zi->ci.zip64)
+ {
+ size_extrafield += 20;
+ }
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_extrafield,2);
+
+ if ((err==ZIP_OK) && (size_filename > 0))
+ {
+ if (ZWRITE64(zi->z_filefunc,zi->filestream,filename,size_filename)!=size_filename)
+ err = ZIP_ERRNO;
+ }
+
+ if ((err==ZIP_OK) && (size_extrafield_local > 0))
+ {
+ if (ZWRITE64(zi->z_filefunc, zi->filestream, extrafield_local, size_extrafield_local) != size_extrafield_local)
+ err = ZIP_ERRNO;
+ }
+
+
+ if ((err==ZIP_OK) && (zi->ci.zip64))
+ {
+ // write the Zip64 extended info
+ short HeaderID = 1;
+ short DataSize = 16;
+ ZPOS64_T CompressedSize = 0;
+ ZPOS64_T UncompressedSize = 0;
+
+ // Remember position of Zip64 extended info for the local file header. (needed when we update size after done with file)
+ zi->ci.pos_zip64extrainfo = ZTELL64(zi->z_filefunc,zi->filestream);
+
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (short)HeaderID,2);
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (short)DataSize,2);
+
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)UncompressedSize,8);
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)CompressedSize,8);
+ }
+
+ return err;
+}
+
+/*
+ NOTE.
+ When writing RAW the ZIP64 extended information in extrafield_local and extrafield_global needs to be stripped
+ before calling this function it can be done with zipRemoveExtraInfoBlock
+
+ It is not done here because then we need to realloc a new buffer since parameters are 'const' and I want to minimize
+ unnecessary allocations.
+ */
+extern int ZEXPORT zipOpenNewFileInZip4_64 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw,
+ int windowBits,int memLevel, int strategy,
+ const char* password, uLong crcForCrypting,
+ uLong versionMadeBy, uLong flagBase, int zip64)
+{
+ zip64_internal* zi;
+ uInt size_filename;
+ uInt size_comment;
+ uInt i;
+ int err = ZIP_OK;
+
+# ifdef NOCRYPT
+ (crcForCrypting);
+ if (password != NULL)
+ return ZIP_PARAMERROR;
+# endif
+
+ if (file == NULL)
+ return ZIP_PARAMERROR;
+
+#ifdef HAVE_BZIP2
+ if ((method!=0) && (method!=Z_DEFLATED) && (method!=Z_BZIP2ED))
+ return ZIP_PARAMERROR;
+#else
+ if ((method!=0) && (method!=Z_DEFLATED))
+ return ZIP_PARAMERROR;
+#endif
+
+ zi = (zip64_internal*)file;
+
+ if (zi->in_opened_file_inzip == 1)
+ {
+ err = zipCloseFileInZip (file);
+ if (err != ZIP_OK)
+ return err;
+ }
+
+ if (filename==NULL)
+ filename="-";
+
+ if (comment==NULL)
+ size_comment = 0;
+ else
+ size_comment = (uInt)strlen(comment);
+
+ size_filename = (uInt)strlen(filename);
+
+ if (zipfi == NULL)
+ zi->ci.dosDate = 0;
+ else
+ {
+ if (zipfi->dosDate != 0)
+ zi->ci.dosDate = zipfi->dosDate;
+ else
+ zi->ci.dosDate = zip64local_TmzDateToDosDate(&zipfi->tmz_date);
+ }
+
+ zi->ci.flag = flagBase;
+ if ((level==8) || (level==9))
+ zi->ci.flag |= 2;
+ if (level==2)
+ zi->ci.flag |= 4;
+ if (level==1)
+ zi->ci.flag |= 6;
+ if (password != NULL)
+ zi->ci.flag |= 1;
+
+ zi->ci.crc32 = 0;
+ zi->ci.method = method;
+ zi->ci.encrypt = 0;
+ zi->ci.stream_initialised = 0;
+ zi->ci.pos_in_buffered_data = 0;
+ zi->ci.raw = raw;
+ zi->ci.pos_local_header = ZTELL64(zi->z_filefunc,zi->filestream);
+
+ zi->ci.size_centralheader = SIZECENTRALHEADER + size_filename + size_extrafield_global + size_comment;
+ zi->ci.size_centralExtraFree = 32; // Extra space we have reserved in case we need to add ZIP64 extra info data
+
+ zi->ci.central_header = (char*)ALLOC((uInt)zi->ci.size_centralheader + zi->ci.size_centralExtraFree);
+
+ zi->ci.size_centralExtra = size_extrafield_global;
+ zip64local_putValue_inmemory(zi->ci.central_header,(uLong)CENTRALHEADERMAGIC,4);
+ /* version info */
+ zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)versionMadeBy,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)20,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+8,(uLong)zi->ci.flag,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+10,(uLong)zi->ci.method,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+12,(uLong)zi->ci.dosDate,4);
+ zip64local_putValue_inmemory(zi->ci.central_header+16,(uLong)0,4); /*crc*/
+ zip64local_putValue_inmemory(zi->ci.central_header+20,(uLong)0,4); /*compr size*/
+ zip64local_putValue_inmemory(zi->ci.central_header+24,(uLong)0,4); /*uncompr size*/
+ zip64local_putValue_inmemory(zi->ci.central_header+28,(uLong)size_filename,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)size_extrafield_global,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+32,(uLong)size_comment,2);
+ zip64local_putValue_inmemory(zi->ci.central_header+34,(uLong)0,2); /*disk nm start*/
+
+ if (zipfi==NULL)
+ zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)0,2);
+ else
+ zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)zipfi->internal_fa,2);
+
+ if (zipfi==NULL)
+ zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)0,4);
+ else
+ zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)zipfi->external_fa,4);
+
+ if(zi->ci.pos_local_header >= 0xffffffff)
+ zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)0xffffffff,4);
+ else
+ zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)zi->ci.pos_local_header - zi->add_position_when_writting_offset,4);
+
+ for (i=0;i<size_filename;i++)
+ *(zi->ci.central_header+SIZECENTRALHEADER+i) = *(filename+i);
+
+ for (i=0;i<size_extrafield_global;i++)
+ *(zi->ci.central_header+SIZECENTRALHEADER+size_filename+i) =
+ *(((const char*)extrafield_global)+i);
+
+ for (i=0;i<size_comment;i++)
+ *(zi->ci.central_header+SIZECENTRALHEADER+size_filename+
+ size_extrafield_global+i) = *(comment+i);
+ if (zi->ci.central_header == NULL)
+ return ZIP_INTERNALERROR;
+
+ zi->ci.zip64 = zip64;
+ zi->ci.totalCompressedData = 0;
+ zi->ci.totalUncompressedData = 0;
+ zi->ci.pos_zip64extrainfo = 0;
+
+ err = Write_LocalFileHeader(zi, filename, size_extrafield_local, extrafield_local);
+
+#ifdef HAVE_BZIP2
+ zi->ci.bstream.avail_in = (uInt)0;
+ zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
+ zi->ci.bstream.total_in_hi32 = 0;
+ zi->ci.bstream.total_in_lo32 = 0;
+ zi->ci.bstream.total_out_hi32 = 0;
+ zi->ci.bstream.total_out_lo32 = 0;
+#endif
+
+ zi->ci.stream.avail_in = (uInt)0;
+ zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.stream.next_out = zi->ci.buffered_data;
+ zi->ci.stream.total_in = 0;
+ zi->ci.stream.total_out = 0;
+ zi->ci.stream.data_type = Z_BINARY;
+
+#ifdef HAVE_BZIP2
+ if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED || zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
+#else
+ if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
+#endif
+ {
+ if(zi->ci.method == Z_DEFLATED)
+ {
+ zi->ci.stream.zalloc = (alloc_func)0;
+ zi->ci.stream.zfree = (free_func)0;
+ zi->ci.stream.opaque = (voidpf)0;
+
+ if (windowBits>0)
+ windowBits = -windowBits;
+
+ err = deflateInit2(&zi->ci.stream, level, Z_DEFLATED, windowBits, memLevel, strategy);
+
+ if (err==Z_OK)
+ zi->ci.stream_initialised = Z_DEFLATED;
+ }
+ else if(zi->ci.method == Z_BZIP2ED)
+ {
+#ifdef HAVE_BZIP2
+ // Init BZip stuff here
+ zi->ci.bstream.bzalloc = 0;
+ zi->ci.bstream.bzfree = 0;
+ zi->ci.bstream.opaque = (voidpf)0;
+
+ err = BZ2_bzCompressInit(&zi->ci.bstream, level, 0,35);
+ if(err == BZ_OK)
+ zi->ci.stream_initialised = Z_BZIP2ED;
+#endif
+ }
+
+ }
+
+# ifndef NOCRYPT
+ zi->ci.crypt_header_size = 0;
+ if ((err==Z_OK) && (password != NULL))
+ {
+ unsigned char bufHead[RAND_HEAD_LEN];
+ unsigned int sizeHead;
+ zi->ci.encrypt = 1;
+ zi->ci.pcrc_32_tab = get_crc_table();
+ /*init_keys(password,zi->ci.keys,zi->ci.pcrc_32_tab);*/
+
+ sizeHead=crypthead(password,bufHead,RAND_HEAD_LEN,zi->ci.keys,zi->ci.pcrc_32_tab,crcForCrypting);
+ zi->ci.crypt_header_size = sizeHead;
+
+ if (ZWRITE64(zi->z_filefunc,zi->filestream,bufHead,sizeHead) != sizeHead)
+ err = ZIP_ERRNO;
+ }
+# endif
+
+ if (err==Z_OK)
+ zi->in_opened_file_inzip = 1;
+ return err;
+}
+
+extern int ZEXPORT zipOpenNewFileInZip4 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw,
+ int windowBits,int memLevel, int strategy,
+ const char* password, uLong crcForCrypting,
+ uLong versionMadeBy, uLong flagBase)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, raw,
+ windowBits, memLevel, strategy,
+ password, crcForCrypting, versionMadeBy, flagBase, 0);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip3 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw,
+ int windowBits,int memLevel, int strategy,
+ const char* password, uLong crcForCrypting)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, raw,
+ windowBits, memLevel, strategy,
+ password, crcForCrypting, VERSIONMADEBY, 0, 0);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip3_64(zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw,
+ int windowBits,int memLevel, int strategy,
+ const char* password, uLong crcForCrypting, int zip64)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, raw,
+ windowBits, memLevel, strategy,
+ password, crcForCrypting, VERSIONMADEBY, 0, zip64);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip2(zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, raw,
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ NULL, 0, VERSIONMADEBY, 0, 0);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip2_64(zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void* extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int raw, int zip64)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, raw,
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ NULL, 0, VERSIONMADEBY, 0, zip64);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip64 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void*extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level, int zip64)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, 0,
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ NULL, 0, VERSIONMADEBY, 0, zip64);
+}
+
+extern int ZEXPORT zipOpenNewFileInZip (zipFile file, const char* filename, const zip_fileinfo* zipfi,
+ const void* extrafield_local, uInt size_extrafield_local,
+ const void*extrafield_global, uInt size_extrafield_global,
+ const char* comment, int method, int level)
+{
+ return zipOpenNewFileInZip4_64 (file, filename, zipfi,
+ extrafield_local, size_extrafield_local,
+ extrafield_global, size_extrafield_global,
+ comment, method, level, 0,
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ NULL, 0, VERSIONMADEBY, 0, 0);
+}
+
+local int zip64FlushWriteBuffer(zip64_internal* zi)
+{
+ int err=ZIP_OK;
+
+ if (zi->ci.encrypt != 0)
+ {
+#ifndef NOCRYPT
+ uInt i;
+ int t;
+ for (i=0;i<zi->ci.pos_in_buffered_data;i++)
+ zi->ci.buffered_data[i] = zencode(zi->ci.keys, zi->ci.pcrc_32_tab, zi->ci.buffered_data[i],t);
+#endif
+ }
+
+ if (ZWRITE64(zi->z_filefunc,zi->filestream,zi->ci.buffered_data,zi->ci.pos_in_buffered_data) != zi->ci.pos_in_buffered_data)
+ err = ZIP_ERRNO;
+
+ zi->ci.totalCompressedData += zi->ci.pos_in_buffered_data;
+
+#ifdef HAVE_BZIP2
+ if(zi->ci.method == Z_BZIP2ED)
+ {
+ zi->ci.totalUncompressedData += zi->ci.bstream.total_in_lo32;
+ zi->ci.bstream.total_in_lo32 = 0;
+ zi->ci.bstream.total_in_hi32 = 0;
+ }
+ else
+#endif
+ {
+ zi->ci.totalUncompressedData += zi->ci.stream.total_in;
+ zi->ci.stream.total_in = 0;
+ }
+
+
+ zi->ci.pos_in_buffered_data = 0;
+
+ return err;
+}
+
+extern int ZEXPORT zipWriteInFileInZip (zipFile file,const void* buf,unsigned int len)
+{
+ zip64_internal* zi;
+ int err=ZIP_OK;
+
+ if (file == NULL)
+ return ZIP_PARAMERROR;
+ zi = (zip64_internal*)file;
+
+ if (zi->in_opened_file_inzip == 0)
+ return ZIP_PARAMERROR;
+
+ zi->ci.crc32 = crc32(zi->ci.crc32,buf,(uInt)len);
+
+#ifdef HAVE_BZIP2
+ if(zi->ci.method == Z_BZIP2ED && (!zi->ci.raw))
+ {
+ zi->ci.bstream.next_in = (void*)buf;
+ zi->ci.bstream.avail_in = len;
+ err = BZ_RUN_OK;
+
+ while ((err==BZ_RUN_OK) && (zi->ci.bstream.avail_in>0))
+ {
+ if (zi->ci.bstream.avail_out == 0)
+ {
+ if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
+ err = ZIP_ERRNO;
+ zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
+ }
+
+
+ if(err != BZ_RUN_OK)
+ break;
+
+ if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
+ {
+ uLong uTotalOutBefore_lo = zi->ci.bstream.total_out_lo32;
+// uLong uTotalOutBefore_hi = zi->ci.bstream.total_out_hi32;
+ err=BZ2_bzCompress(&zi->ci.bstream, BZ_RUN);
+
+ zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore_lo) ;
+ }
+ }
+
+ if(err == BZ_RUN_OK)
+ err = ZIP_OK;
+ }
+ else
+#endif
+ {
+ zi->ci.stream.next_in = (Bytef*)buf;
+ zi->ci.stream.avail_in = len;
+
+ while ((err==ZIP_OK) && (zi->ci.stream.avail_in>0))
+ {
+ if (zi->ci.stream.avail_out == 0)
+ {
+ if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
+ err = ZIP_ERRNO;
+ zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.stream.next_out = zi->ci.buffered_data;
+ }
+
+
+ if(err != ZIP_OK)
+ break;
+
+ if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
+ {
+ uLong uTotalOutBefore = zi->ci.stream.total_out;
+ err=deflate(&zi->ci.stream, Z_NO_FLUSH);
+ if(uTotalOutBefore > zi->ci.stream.total_out)
+ {
+ int bBreak = 0;
+ bBreak++;
+ }
+
+ zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ;
+ }
+ else
+ {
+ uInt copy_this,i;
+ if (zi->ci.stream.avail_in < zi->ci.stream.avail_out)
+ copy_this = zi->ci.stream.avail_in;
+ else
+ copy_this = zi->ci.stream.avail_out;
+
+ for (i = 0; i < copy_this; i++)
+ *(((char*)zi->ci.stream.next_out)+i) =
+ *(((const char*)zi->ci.stream.next_in)+i);
+ {
+ zi->ci.stream.avail_in -= copy_this;
+ zi->ci.stream.avail_out-= copy_this;
+ zi->ci.stream.next_in+= copy_this;
+ zi->ci.stream.next_out+= copy_this;
+ zi->ci.stream.total_in+= copy_this;
+ zi->ci.stream.total_out+= copy_this;
+ zi->ci.pos_in_buffered_data += copy_this;
+ }
+ }
+ }// while(...)
+ }
+
+ return err;
+}
+
+extern int ZEXPORT zipCloseFileInZipRaw (zipFile file, uLong uncompressed_size, uLong crc32)
+{
+ return zipCloseFileInZipRaw64 (file, uncompressed_size, crc32);
+}
+
+extern int ZEXPORT zipCloseFileInZipRaw64 (zipFile file, ZPOS64_T uncompressed_size, uLong crc32)
+{
+ zip64_internal* zi;
+ ZPOS64_T compressed_size;
+ uLong invalidValue = 0xffffffff;
+ short datasize = 0;
+ int err=ZIP_OK;
+
+ if (file == NULL)
+ return ZIP_PARAMERROR;
+ zi = (zip64_internal*)file;
+
+ if (zi->in_opened_file_inzip == 0)
+ return ZIP_PARAMERROR;
+ zi->ci.stream.avail_in = 0;
+
+ if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
+ {
+ while (err==ZIP_OK)
+ {
+ uLong uTotalOutBefore;
+ if (zi->ci.stream.avail_out == 0)
+ {
+ if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
+ err = ZIP_ERRNO;
+ zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.stream.next_out = zi->ci.buffered_data;
+ }
+ uTotalOutBefore = zi->ci.stream.total_out;
+ err=deflate(&zi->ci.stream, Z_FINISH);
+ zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ;
+ }
+ }
+ else if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
+ {
+#ifdef HAVE_BZIP2
+ err = BZ_FINISH_OK;
+ while (err==BZ_FINISH_OK)
+ {
+ uLong uTotalOutBefore;
+ if (zi->ci.bstream.avail_out == 0)
+ {
+ if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
+ err = ZIP_ERRNO;
+ zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
+ zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
+ }
+ uTotalOutBefore = zi->ci.bstream.total_out_lo32;
+ err=BZ2_bzCompress(&zi->ci.bstream, BZ_FINISH);
+ if(err == BZ_STREAM_END)
+ err = Z_STREAM_END;
+
+ zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore);
+ }
+
+ if(err == BZ_FINISH_OK)
+ err = ZIP_OK;
+#endif
+ }
+
+ if (err==Z_STREAM_END)
+ err=ZIP_OK; /* this is normal */
+
+ if ((zi->ci.pos_in_buffered_data>0) && (err==ZIP_OK))
+ {
+ if (zip64FlushWriteBuffer(zi)==ZIP_ERRNO)
+ err = ZIP_ERRNO;
+ }
+
+ if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
+ {
+ int tmp_err = deflateEnd(&zi->ci.stream);
+ if (err == ZIP_OK)
+ err = tmp_err;
+ zi->ci.stream_initialised = 0;
+ }
+#ifdef HAVE_BZIP2
+ else if((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
+ {
+ int tmperr = BZ2_bzCompressEnd(&zi->ci.bstream);
+ if (err==ZIP_OK)
+ err = tmperr;
+ zi->ci.stream_initialised = 0;
+ }
+#endif
+
+ if (!zi->ci.raw)
+ {
+ crc32 = (uLong)zi->ci.crc32;
+ uncompressed_size = zi->ci.totalUncompressedData;
+ }
+ compressed_size = zi->ci.totalCompressedData;
+
+# ifndef NOCRYPT
+ compressed_size += zi->ci.crypt_header_size;
+# endif
+
+ // update Current Item crc and sizes,
+ if(compressed_size >= 0xffffffff || uncompressed_size >= 0xffffffff || zi->ci.pos_local_header >= 0xffffffff)
+ {
+ /*version Made by*/
+ zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)45,2);
+ /*version needed*/
+ zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)45,2);
+
+ }
+
+ zip64local_putValue_inmemory(zi->ci.central_header+16,crc32,4); /*crc*/
+
+
+ if(compressed_size >= 0xffffffff)
+ zip64local_putValue_inmemory(zi->ci.central_header+20, invalidValue,4); /*compr size*/
+ else
+ zip64local_putValue_inmemory(zi->ci.central_header+20, compressed_size,4); /*compr size*/
+
+ /// set internal file attributes field
+ if (zi->ci.stream.data_type == Z_ASCII)
+ zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)Z_ASCII,2);
+
+ if(uncompressed_size >= 0xffffffff)
+ zip64local_putValue_inmemory(zi->ci.central_header+24, invalidValue,4); /*uncompr size*/
+ else
+ zip64local_putValue_inmemory(zi->ci.central_header+24, uncompressed_size,4); /*uncompr size*/
+
+ // Add ZIP64 extra info field for uncompressed size
+ if(uncompressed_size >= 0xffffffff)
+ datasize += 8;
+
+ // Add ZIP64 extra info field for compressed size
+ if(compressed_size >= 0xffffffff)
+ datasize += 8;
+
+ // Add ZIP64 extra info field for relative offset to local file header of current file
+ if(zi->ci.pos_local_header >= 0xffffffff)
+ datasize += 8;
+
+ if(datasize > 0)
+ {
+ char* p = NULL;
+
+ if((uLong)(datasize + 4) > zi->ci.size_centralExtraFree)
+ {
+ // we can not write more data to the buffer that we have room for.
+ return ZIP_BADZIPFILE;
+ }
+
+ p = zi->ci.central_header + zi->ci.size_centralheader;
+
+ // Add Extra Information Header for 'ZIP64 information'
+ zip64local_putValue_inmemory(p, 0x0001, 2); // HeaderID
+ p += 2;
+ zip64local_putValue_inmemory(p, datasize, 2); // DataSize
+ p += 2;
+
+ if(uncompressed_size >= 0xffffffff)
+ {
+ zip64local_putValue_inmemory(p, uncompressed_size, 8);
+ p += 8;
+ }
+
+ if(compressed_size >= 0xffffffff)
+ {
+ zip64local_putValue_inmemory(p, compressed_size, 8);
+ p += 8;
+ }
+
+ if(zi->ci.pos_local_header >= 0xffffffff)
+ {
+ zip64local_putValue_inmemory(p, zi->ci.pos_local_header, 8);
+ p += 8;
+ }
+
+ // Update how much extra free space we got in the memory buffer
+ // and increase the centralheader size so the new ZIP64 fields are included
+ // ( 4 below is the size of HeaderID and DataSize field )
+ zi->ci.size_centralExtraFree -= datasize + 4;
+ zi->ci.size_centralheader += datasize + 4;
+
+ // Update the extra info size field
+ zi->ci.size_centralExtra += datasize + 4;
+ zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)zi->ci.size_centralExtra,2);
+ }
+
+ if (err==ZIP_OK)
+ err = add_data_in_datablock(&zi->central_dir, zi->ci.central_header, (uLong)zi->ci.size_centralheader);
+
+ free(zi->ci.central_header);
+
+ if (err==ZIP_OK)
+ {
+ // Update the LocalFileHeader with the new values.
+
+ ZPOS64_T cur_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream);
+
+ if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_local_header + 14,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err = ZIP_ERRNO;
+
+ if (err==ZIP_OK)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,crc32,4); /* crc 32, unknown */
+
+ if(uncompressed_size >= 0xffffffff || compressed_size >= 0xffffffff )
+ {
+ if(zi->ci.pos_zip64extrainfo > 0)
+ {
+ // Update the size in the ZIP64 extended field.
+ if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_zip64extrainfo + 4,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err = ZIP_ERRNO;
+
+ if (err==ZIP_OK) /* compressed size, unknown */
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, uncompressed_size, 8);
+
+ 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
+ {
+ if (err==ZIP_OK) /* compressed size, unknown */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,compressed_size,4);
+
+ if (err==ZIP_OK) /* uncompressed size, unknown */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,uncompressed_size,4);
+ }
+
+ if (ZSEEK64(zi->z_filefunc,zi->filestream, cur_pos_inzip,ZLIB_FILEFUNC_SEEK_SET)!=0)
+ err = ZIP_ERRNO;
+ }
+
+ zi->number_entry ++;
+ zi->in_opened_file_inzip = 0;
+
+ return err;
+}
+
+extern int ZEXPORT zipCloseFileInZip (zipFile file)
+{
+ return zipCloseFileInZipRaw (file,0,0);
+}
+
+int Write_Zip64EndOfCentralDirectoryLocator(zip64_internal* zi, ZPOS64_T zip64eocd_pos_inzip)
+{
+ int err = ZIP_OK;
+ ZPOS64_T pos = zip64eocd_pos_inzip - zi->add_position_when_writting_offset;
+
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDLOCHEADERMAGIC,4);
+
+ /*num disks*/
+ if (err==ZIP_OK) /* number of the disk with the start of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);
+
+ /*relative offset*/
+ if (err==ZIP_OK) /* Relative offset to the Zip64EndOfCentralDirectory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream, pos,8);
+
+ /*total disks*/ /* Do not support spawning of disk so always say 1 here*/
+ if (err==ZIP_OK) /* number of the disk with the start of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)1,4);
+
+ return err;
+}
+
+int Write_Zip64EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip)
+{
+ int err = ZIP_OK;
+
+ uLong Zip64DataSize = 44;
+
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDHEADERMAGIC,4);
+
+ if (err==ZIP_OK) /* size of this 'zip64 end of central directory' */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)Zip64DataSize,8); // why ZPOS64_T of this ?
+
+ if (err==ZIP_OK) /* version made by */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);
+
+ if (err==ZIP_OK) /* version needed */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);
+
+ if (err==ZIP_OK) /* number of this disk */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);
+
+ if (err==ZIP_OK) /* number of the disk with the start of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);
+
+ if (err==ZIP_OK) /* total number of entries in the central dir on this disk */
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8);
+
+ if (err==ZIP_OK) /* total number of entries in the central dir */
+ err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8);
+
+ if (err==ZIP_OK) /* size of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)size_centraldir,8);
+
+ if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */
+ {
+ ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writting_offset;
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (ZPOS64_T)pos,8);
+ }
+ return err;
+}
+int Write_EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip)
+{
+ int err = ZIP_OK;
+
+ /*signature*/
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ENDHEADERMAGIC,4);
+
+ if (err==ZIP_OK) /* number of this disk */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2);
+
+ if (err==ZIP_OK) /* number of the disk with the start of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2);
+
+ if (err==ZIP_OK) /* total number of entries in the central dir on this disk */
+ {
+ {
+ if(zi->number_entry >= 0xFFFF)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record
+ else
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2);
+ }
+ }
+
+ if (err==ZIP_OK) /* total number of entries in the central dir */
+ {
+ if(zi->number_entry >= 0xFFFF)
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record
+ else
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2);
+ }
+
+ if (err==ZIP_OK) /* size of the central directory */
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_centraldir,4);
+
+ if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */
+ {
+ ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writting_offset;
+ if(pos >= 0xffffffff)
+ {
+ 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);
+ }
+
+ return err;
+}
+
+int Write_GlobalComment(zip64_internal* zi, const char* global_comment)
+{
+ int err = ZIP_OK;
+ uInt size_global_comment = 0;
+
+ if(global_comment != NULL)
+ size_global_comment = (uInt)strlen(global_comment);
+
+ err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_global_comment,2);
+
+ if (err == ZIP_OK && size_global_comment > 0)
+ {
+ if (ZWRITE64(zi->z_filefunc,zi->filestream, global_comment, size_global_comment) != size_global_comment)
+ err = ZIP_ERRNO;
+ }
+ return err;
+}
+
+extern int ZEXPORT zipClose (zipFile file, const char* global_comment)
+{
+ zip64_internal* zi;
+ int err = 0;
+ uLong size_centraldir = 0;
+ ZPOS64_T centraldir_pos_inzip;
+ ZPOS64_T pos;
+
+ if (file == NULL)
+ return ZIP_PARAMERROR;
+
+ zi = (zip64_internal*)file;
+
+ if (zi->in_opened_file_inzip == 1)
+ {
+ err = zipCloseFileInZip (file);
+ }
+
+#ifndef NO_ADDFILEINEXISTINGZIP
+ if (global_comment==NULL)
+ global_comment = zi->globalcomment;
+#endif
+
+ centraldir_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream);
+
+ if (err==ZIP_OK)
+ {
+ linkedlist_datablock_internal* ldi = zi->central_dir.first_block;
+ while (ldi!=NULL)
+ {
+ if ((err==ZIP_OK) && (ldi->filled_in_this_block>0))
+ {
+ if (ZWRITE64(zi->z_filefunc,zi->filestream, ldi->data, ldi->filled_in_this_block) != ldi->filled_in_this_block)
+ err = ZIP_ERRNO;
+ }
+
+ size_centraldir += ldi->filled_in_this_block;
+ ldi = ldi->next_datablock;
+ }
+ }
+ free_linkedlist(&(zi->central_dir));
+
+ pos = centraldir_pos_inzip - zi->add_position_when_writting_offset;
+ if(pos >= 0xffffffff || zi->number_entry > 0xFFFF)
+ {
+ ZPOS64_T Zip64EOCDpos = ZTELL64(zi->z_filefunc,zi->filestream);
+ Write_Zip64EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip);
+
+ Write_Zip64EndOfCentralDirectoryLocator(zi, Zip64EOCDpos);
+ }
+
+ if (err==ZIP_OK)
+ err = Write_EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip);
+
+ if(err == ZIP_OK)
+ err = Write_GlobalComment(zi, global_comment);
+
+ if (ZCLOSE64(zi->z_filefunc,zi->filestream) != 0)
+ if (err == ZIP_OK)
+ err = ZIP_ERRNO;
+
+#ifndef NO_ADDFILEINEXISTINGZIP
+ TRYFREE(zi->globalcomment);
+#endif
+ TRYFREE(zi);
+
+ return err;
+}
+
+extern int ZEXPORT zipRemoveExtraInfoBlock (char* pData, int* dataLen, short sHeader)
+{
+ char* p = pData;
+ int size = 0;
+ char* pNewHeader;
+ char* pTmp;
+ short header;
+ short dataSize;
+
+ int retVal = ZIP_OK;
+
+ if(pData == NULL || *dataLen < 4)
+ return ZIP_PARAMERROR;
+
+ pNewHeader = (char*)ALLOC(*dataLen);
+ pTmp = pNewHeader;
+
+ while(p < (pData + *dataLen))
+ {
+ header = *(short*)p;
+ dataSize = *(((short*)p)+1);
+
+ if( header == sHeader ) // Header found.
+ {
+ p += dataSize + 4; // skip it. do not copy to temp buffer
+ }
+ else
+ {
+ // Extra Info block should not be removed, So copy it to the temp buffer.
+ memcpy(pTmp, p, dataSize + 4);
+ p += dataSize + 4;
+ size += dataSize + 4;
+ }
+
+ }
+
+ if(size < *dataLen)
+ {
+ // clean old extra info block.
+ memset(pData,0, *dataLen);
+
+ // copy the new extra info block over the old
+ if(size > 0)
+ memcpy(pData, pNewHeader, size);
+
+ // set the new extra info size
+ *dataLen = size;
+
+ retVal = ZIP_OK;
+ }
+ else
+ retVal = ZIP_ERRNO;
+
+ TRYFREE(pNewHeader);
+
+ return retVal;
+}
diff --git a/compat/zlib/contrib/minizip/zip.h b/compat/zlib/contrib/minizip/zip.h
new file mode 100644
index 0000000..8aaebb6
--- /dev/null
+++ b/compat/zlib/contrib/minizip/zip.h
@@ -0,0 +1,362 @@
+/* zip.h -- IO on .zip files using zlib
+ Version 1.1, February 14h, 2010
+ part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )
+
+ Modifications for Zip64 support
+ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
+
+ For more info read MiniZip_info.txt
+
+ ---------------------------------------------------------------------------
+
+ Condition of use and distribution are the same than zlib :
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ ---------------------------------------------------------------------------
+
+ Changes
+
+ See header of zip.h
+
+*/
+
+#ifndef _zip12_H
+#define _zip12_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+//#define HAVE_BZIP2
+
+#ifndef _ZLIB_H
+#include "zlib.h"
+#endif
+
+#ifndef _ZLIBIOAPI_H
+#include "ioapi.h"
+#endif
+
+#ifdef HAVE_BZIP2
+#include "bzlib.h"
+#endif
+
+#define Z_BZIP2ED 12
+
+#if defined(STRICTZIP) || defined(STRICTZIPUNZIP)
+/* like the STRICT of WIN32, we define a pointer that cannot be converted
+ from (void*) without cast */
+typedef struct TagzipFile__ { int unused; } zipFile__;
+typedef zipFile__ *zipFile;
+#else
+typedef voidp zipFile;
+#endif
+
+#define ZIP_OK (0)
+#define ZIP_EOF (0)
+#define ZIP_ERRNO (Z_ERRNO)
+#define ZIP_PARAMERROR (-102)
+#define ZIP_BADZIPFILE (-103)
+#define ZIP_INTERNALERROR (-104)
+
+#ifndef DEF_MEM_LEVEL
+# if MAX_MEM_LEVEL >= 8
+# define DEF_MEM_LEVEL 8
+# else
+# define DEF_MEM_LEVEL MAX_MEM_LEVEL
+# endif
+#endif
+/* default memLevel */
+
+/* tm_zip contain date/time info */
+typedef struct tm_zip_s
+{
+ uInt tm_sec; /* seconds after the minute - [0,59] */
+ uInt tm_min; /* minutes after the hour - [0,59] */
+ uInt tm_hour; /* hours since midnight - [0,23] */
+ uInt tm_mday; /* day of the month - [1,31] */
+ uInt tm_mon; /* months since January - [0,11] */
+ uInt tm_year; /* years - [1980..2044] */
+} tm_zip;
+
+typedef struct
+{
+ tm_zip tmz_date; /* date in understandable format */
+ uLong dosDate; /* if dos_date == 0, tmu_date is used */
+/* uLong flag; */ /* general purpose bit flag 2 bytes */
+
+ uLong internal_fa; /* internal file attributes 2 bytes */
+ uLong external_fa; /* external file attributes 4 bytes */
+} zip_fileinfo;
+
+typedef const char* zipcharpc;
+
+
+#define APPEND_STATUS_CREATE (0)
+#define APPEND_STATUS_CREATEAFTER (1)
+#define APPEND_STATUS_ADDINZIP (2)
+
+extern zipFile ZEXPORT zipOpen OF((const char *pathname, int append));
+extern zipFile ZEXPORT zipOpen64 OF((const void *pathname, int append));
+/*
+ Create a zipfile.
+ pathname contain on Windows XP a filename like "c:\\zlib\\zlib113.zip" or on
+ an Unix computer "zlib/zlib113.zip".
+ if the file pathname exist and append==APPEND_STATUS_CREATEAFTER, the zip
+ will be created at the end of the file.
+ (useful if the file contain a self extractor code)
+ if the file pathname exist and append==APPEND_STATUS_ADDINZIP, we will
+ add files in existing zip (be sure you don't add file that doesn't exist)
+ If the zipfile cannot be opened, the return value is NULL.
+ Else, the return value is a zipFile Handle, usable with other function
+ of this zip package.
+*/
+
+/* Note : there is no delete function into a zipfile.
+ If you want delete file into a zipfile, you must open a zipfile, and create another
+ Of couse, you can use RAW reading and writing to copy the file you did not want delte
+*/
+
+extern zipFile ZEXPORT zipOpen2 OF((const char *pathname,
+ int append,
+ zipcharpc* globalcomment,
+ zlib_filefunc_def* pzlib_filefunc_def));
+
+extern zipFile ZEXPORT zipOpen2_64 OF((const void *pathname,
+ int append,
+ zipcharpc* globalcomment,
+ zlib_filefunc64_def* pzlib_filefunc_def));
+
+extern int ZEXPORT zipOpenNewFileInZip OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level));
+
+extern int ZEXPORT zipOpenNewFileInZip64 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int zip64));
+
+/*
+ Open a file in the ZIP for writing.
+ filename : the filename in zip (if NULL, '-' without quote will be used
+ *zipfi contain supplemental information
+ if extrafield_local!=NULL and size_extrafield_local>0, extrafield_local
+ contains the extrafield data the the local header
+ if extrafield_global!=NULL and size_extrafield_global>0, extrafield_global
+ contains the extrafield data the the local header
+ if comment != NULL, comment contain the comment string
+ method contain the compression method (0 for store, Z_DEFLATED for deflate)
+ level contain the level of compression (can be Z_DEFAULT_COMPRESSION)
+ zip64 is set to 1 if a zip64 extended information block should be added to the local file header.
+ this MUST be '1' if the uncompressed size is >= 0xffffffff.
+
+*/
+
+
+extern int ZEXPORT zipOpenNewFileInZip2 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw));
+
+
+extern int ZEXPORT zipOpenNewFileInZip2_64 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw,
+ int zip64));
+/*
+ Same than zipOpenNewFileInZip, except if raw=1, we write raw file
+ */
+
+extern int ZEXPORT zipOpenNewFileInZip3 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw,
+ int windowBits,
+ int memLevel,
+ int strategy,
+ const char* password,
+ uLong crcForCrypting));
+
+extern int ZEXPORT zipOpenNewFileInZip3_64 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw,
+ int windowBits,
+ int memLevel,
+ int strategy,
+ const char* password,
+ uLong crcForCrypting,
+ int zip64
+ ));
+
+/*
+ Same than zipOpenNewFileInZip2, except
+ windowBits,memLevel,,strategy : see parameter strategy in deflateInit2
+ password : crypting password (NULL for no crypting)
+ crcForCrypting : crc of file to compress (needed for crypting)
+ */
+
+extern int ZEXPORT zipOpenNewFileInZip4 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw,
+ int windowBits,
+ int memLevel,
+ int strategy,
+ const char* password,
+ uLong crcForCrypting,
+ uLong versionMadeBy,
+ uLong flagBase
+ ));
+
+
+extern int ZEXPORT zipOpenNewFileInZip4_64 OF((zipFile file,
+ const char* filename,
+ const zip_fileinfo* zipfi,
+ const void* extrafield_local,
+ uInt size_extrafield_local,
+ const void* extrafield_global,
+ uInt size_extrafield_global,
+ const char* comment,
+ int method,
+ int level,
+ int raw,
+ int windowBits,
+ int memLevel,
+ int strategy,
+ const char* password,
+ uLong crcForCrypting,
+ uLong versionMadeBy,
+ uLong flagBase,
+ int zip64
+ ));
+/*
+ Same than zipOpenNewFileInZip4, except
+ versionMadeBy : value for Version made by field
+ flag : value for flag field (compression level info will be added)
+ */
+
+
+extern int ZEXPORT zipWriteInFileInZip OF((zipFile file,
+ const void* buf,
+ unsigned len));
+/*
+ Write data in the zipfile
+*/
+
+extern int ZEXPORT zipCloseFileInZip OF((zipFile file));
+/*
+ Close the current file in the zipfile
+*/
+
+extern int ZEXPORT zipCloseFileInZipRaw OF((zipFile file,
+ uLong uncompressed_size,
+ uLong crc32));
+
+extern int ZEXPORT zipCloseFileInZipRaw64 OF((zipFile file,
+ ZPOS64_T uncompressed_size,
+ uLong crc32));
+
+/*
+ Close the current file in the zipfile, for file opened with
+ parameter raw=1 in zipOpenNewFileInZip2
+ uncompressed_size and crc32 are value for the uncompressed size
+*/
+
+extern int ZEXPORT zipClose OF((zipFile file,
+ const char* global_comment));
+/*
+ Close the zipfile
+*/
+
+
+extern int ZEXPORT zipRemoveExtraInfoBlock OF((char* pData, int* dataLen, short sHeader));
+/*
+ zipRemoveExtraInfoBlock - Added by Mathias Svensson
+
+ Remove extra information block from a extra information data for the local file header or central directory header
+
+ It is needed to remove ZIP64 extra information blocks when before data is written if using RAW mode.
+
+ 0x0001 is the signature header for the ZIP64 extra information blocks
+
+ usage.
+ Remove ZIP64 Extra information from a central director extra field data
+ zipRemoveExtraInfoBlock(pCenDirExtraFieldData, &nCenDirExtraFieldDataLen, 0x0001);
+
+ Remove ZIP64 Extra information from a Local File Header extra field data
+ zipRemoveExtraInfoBlock(pLocalHeaderExtraFieldData, &nLocalHeaderExtraFieldDataLen, 0x0001);
+*/
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _zip64_H */
diff --git a/compat/zlib/contrib/pascal/example.pas b/compat/zlib/contrib/pascal/example.pas
new file mode 100644
index 0000000..5518b36
--- /dev/null
+++ b/compat/zlib/contrib/pascal/example.pas
@@ -0,0 +1,599 @@
+(* example.c -- usage example of the zlib compression library
+ * Copyright (C) 1995-2003 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ *
+ * Pascal translation
+ * Copyright (C) 1998 by Jacques Nomssi Nzali.
+ * For conditions of distribution and use, see copyright notice in readme.txt
+ *
+ * Adaptation to the zlibpas interface
+ * Copyright (C) 2003 by Cosmin Truta.
+ * For conditions of distribution and use, see copyright notice in readme.txt
+ *)
+
+program example;
+
+{$DEFINE TEST_COMPRESS}
+{DO NOT $DEFINE TEST_GZIO}
+{$DEFINE TEST_DEFLATE}
+{$DEFINE TEST_INFLATE}
+{$DEFINE TEST_FLUSH}
+{$DEFINE TEST_SYNC}
+{$DEFINE TEST_DICT}
+
+uses SysUtils, zlibpas;
+
+const TESTFILE = 'foo.gz';
+
+(* "hello world" would be more standard, but the repeated "hello"
+ * stresses the compression code better, sorry...
+ *)
+const hello: PChar = 'hello, hello!';
+
+const dictionary: PChar = 'hello';
+
+var dictId: LongInt; (* Adler32 value of the dictionary *)
+
+procedure CHECK_ERR(err: Integer; msg: String);
+begin
+ if err <> Z_OK then
+ begin
+ WriteLn(msg, ' error: ', err);
+ Halt(1);
+ end;
+end;
+
+procedure EXIT_ERR(const msg: String);
+begin
+ WriteLn('Error: ', msg);
+ Halt(1);
+end;
+
+(* ===========================================================================
+ * Test compress and uncompress
+ *)
+{$IFDEF TEST_COMPRESS}
+procedure test_compress(compr: Pointer; comprLen: LongInt;
+ uncompr: Pointer; uncomprLen: LongInt);
+var err: Integer;
+ len: LongInt;
+begin
+ len := StrLen(hello)+1;
+
+ err := compress(compr, comprLen, hello, len);
+ CHECK_ERR(err, 'compress');
+
+ StrCopy(PChar(uncompr), 'garbage');
+
+ err := uncompress(uncompr, uncomprLen, compr, comprLen);
+ CHECK_ERR(err, 'uncompress');
+
+ if StrComp(PChar(uncompr), hello) <> 0 then
+ EXIT_ERR('bad uncompress')
+ else
+ WriteLn('uncompress(): ', PChar(uncompr));
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test read/write of .gz files
+ *)
+{$IFDEF TEST_GZIO}
+procedure test_gzio(const fname: PChar; (* compressed file name *)
+ uncompr: Pointer;
+ uncomprLen: LongInt);
+var err: Integer;
+ len: Integer;
+ zfile: gzFile;
+ pos: LongInt;
+begin
+ len := StrLen(hello)+1;
+
+ zfile := gzopen(fname, 'wb');
+ if zfile = NIL then
+ begin
+ WriteLn('gzopen error');
+ Halt(1);
+ end;
+ gzputc(zfile, 'h');
+ if gzputs(zfile, 'ello') <> 4 then
+ begin
+ WriteLn('gzputs err: ', gzerror(zfile, err));
+ Halt(1);
+ end;
+ {$IFDEF GZ_FORMAT_STRING}
+ if gzprintf(zfile, ', %s!', 'hello') <> 8 then
+ begin
+ WriteLn('gzprintf err: ', gzerror(zfile, err));
+ Halt(1);
+ end;
+ {$ELSE}
+ if gzputs(zfile, ', hello!') <> 8 then
+ begin
+ WriteLn('gzputs err: ', gzerror(zfile, err));
+ Halt(1);
+ end;
+ {$ENDIF}
+ gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *)
+ gzclose(zfile);
+
+ zfile := gzopen(fname, 'rb');
+ if zfile = NIL then
+ begin
+ WriteLn('gzopen error');
+ Halt(1);
+ end;
+
+ StrCopy(PChar(uncompr), 'garbage');
+
+ if gzread(zfile, uncompr, uncomprLen) <> len then
+ begin
+ WriteLn('gzread err: ', gzerror(zfile, err));
+ Halt(1);
+ end;
+ if StrComp(PChar(uncompr), hello) <> 0 then
+ begin
+ WriteLn('bad gzread: ', PChar(uncompr));
+ Halt(1);
+ end
+ else
+ WriteLn('gzread(): ', PChar(uncompr));
+
+ pos := gzseek(zfile, -8, SEEK_CUR);
+ if (pos <> 6) or (gztell(zfile) <> pos) then
+ begin
+ WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile));
+ Halt(1);
+ end;
+
+ if gzgetc(zfile) <> ' ' then
+ begin
+ WriteLn('gzgetc error');
+ Halt(1);
+ end;
+
+ if gzungetc(' ', zfile) <> ' ' then
+ begin
+ WriteLn('gzungetc error');
+ Halt(1);
+ end;
+
+ gzgets(zfile, PChar(uncompr), uncomprLen);
+ uncomprLen := StrLen(PChar(uncompr));
+ if uncomprLen <> 7 then (* " hello!" *)
+ begin
+ WriteLn('gzgets err after gzseek: ', gzerror(zfile, err));
+ Halt(1);
+ end;
+ if StrComp(PChar(uncompr), hello + 6) <> 0 then
+ begin
+ WriteLn('bad gzgets after gzseek');
+ Halt(1);
+ end
+ else
+ WriteLn('gzgets() after gzseek: ', PChar(uncompr));
+
+ gzclose(zfile);
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test deflate with small buffers
+ *)
+{$IFDEF TEST_DEFLATE}
+procedure test_deflate(compr: Pointer; comprLen: LongInt);
+var c_stream: z_stream; (* compression stream *)
+ err: Integer;
+ len: LongInt;
+begin
+ len := StrLen(hello)+1;
+
+ c_stream.zalloc := NIL;
+ c_stream.zfree := NIL;
+ c_stream.opaque := NIL;
+
+ err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
+ CHECK_ERR(err, 'deflateInit');
+
+ c_stream.next_in := hello;
+ c_stream.next_out := compr;
+
+ while (c_stream.total_in <> len) and
+ (c_stream.total_out < comprLen) do
+ begin
+ c_stream.avail_out := 1; { force small buffers }
+ c_stream.avail_in := 1;
+ err := deflate(c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, 'deflate');
+ end;
+
+ (* Finish the stream, still forcing small buffers: *)
+ while TRUE do
+ begin
+ c_stream.avail_out := 1;
+ err := deflate(c_stream, Z_FINISH);
+ if err = Z_STREAM_END then
+ break;
+ CHECK_ERR(err, 'deflate');
+ end;
+
+ err := deflateEnd(c_stream);
+ CHECK_ERR(err, 'deflateEnd');
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test inflate with small buffers
+ *)
+{$IFDEF TEST_INFLATE}
+procedure test_inflate(compr: Pointer; comprLen : LongInt;
+ uncompr: Pointer; uncomprLen : LongInt);
+var err: Integer;
+ d_stream: z_stream; (* decompression stream *)
+begin
+ StrCopy(PChar(uncompr), 'garbage');
+
+ d_stream.zalloc := NIL;
+ d_stream.zfree := NIL;
+ d_stream.opaque := NIL;
+
+ d_stream.next_in := compr;
+ d_stream.avail_in := 0;
+ d_stream.next_out := uncompr;
+
+ err := inflateInit(d_stream);
+ CHECK_ERR(err, 'inflateInit');
+
+ while (d_stream.total_out < uncomprLen) and
+ (d_stream.total_in < comprLen) do
+ begin
+ d_stream.avail_out := 1; (* force small buffers *)
+ d_stream.avail_in := 1;
+ err := inflate(d_stream, Z_NO_FLUSH);
+ if err = Z_STREAM_END then
+ break;
+ CHECK_ERR(err, 'inflate');
+ end;
+
+ err := inflateEnd(d_stream);
+ CHECK_ERR(err, 'inflateEnd');
+
+ if StrComp(PChar(uncompr), hello) <> 0 then
+ EXIT_ERR('bad inflate')
+ else
+ WriteLn('inflate(): ', PChar(uncompr));
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test deflate with large buffers and dynamic change of compression level
+ *)
+{$IFDEF TEST_DEFLATE}
+procedure test_large_deflate(compr: Pointer; comprLen: LongInt;
+ uncompr: Pointer; uncomprLen: LongInt);
+var c_stream: z_stream; (* compression stream *)
+ err: Integer;
+begin
+ c_stream.zalloc := NIL;
+ c_stream.zfree := NIL;
+ c_stream.opaque := NIL;
+
+ err := deflateInit(c_stream, Z_BEST_SPEED);
+ CHECK_ERR(err, 'deflateInit');
+
+ c_stream.next_out := compr;
+ c_stream.avail_out := Integer(comprLen);
+
+ (* At this point, uncompr is still mostly zeroes, so it should compress
+ * very well:
+ *)
+ c_stream.next_in := uncompr;
+ c_stream.avail_in := Integer(uncomprLen);
+ err := deflate(c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, 'deflate');
+ if c_stream.avail_in <> 0 then
+ EXIT_ERR('deflate not greedy');
+
+ (* Feed in already compressed data and switch to no compression: *)
+ deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
+ c_stream.next_in := compr;
+ c_stream.avail_in := Integer(comprLen div 2);
+ err := deflate(c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, 'deflate');
+
+ (* Switch back to compressing mode: *)
+ deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
+ c_stream.next_in := uncompr;
+ c_stream.avail_in := Integer(uncomprLen);
+ err := deflate(c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, 'deflate');
+
+ err := deflate(c_stream, Z_FINISH);
+ if err <> Z_STREAM_END then
+ EXIT_ERR('deflate should report Z_STREAM_END');
+
+ err := deflateEnd(c_stream);
+ CHECK_ERR(err, 'deflateEnd');
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test inflate with large buffers
+ *)
+{$IFDEF TEST_INFLATE}
+procedure test_large_inflate(compr: Pointer; comprLen: LongInt;
+ uncompr: Pointer; uncomprLen: LongInt);
+var err: Integer;
+ d_stream: z_stream; (* decompression stream *)
+begin
+ StrCopy(PChar(uncompr), 'garbage');
+
+ d_stream.zalloc := NIL;
+ d_stream.zfree := NIL;
+ d_stream.opaque := NIL;
+
+ d_stream.next_in := compr;
+ d_stream.avail_in := Integer(comprLen);
+
+ err := inflateInit(d_stream);
+ CHECK_ERR(err, 'inflateInit');
+
+ while TRUE do
+ begin
+ d_stream.next_out := uncompr; (* discard the output *)
+ d_stream.avail_out := Integer(uncomprLen);
+ err := inflate(d_stream, Z_NO_FLUSH);
+ if err = Z_STREAM_END then
+ break;
+ CHECK_ERR(err, 'large inflate');
+ end;
+
+ err := inflateEnd(d_stream);
+ CHECK_ERR(err, 'inflateEnd');
+
+ if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then
+ begin
+ WriteLn('bad large inflate: ', d_stream.total_out);
+ Halt(1);
+ end
+ else
+ WriteLn('large_inflate(): OK');
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test deflate with full flush
+ *)
+{$IFDEF TEST_FLUSH}
+procedure test_flush(compr: Pointer; var comprLen : LongInt);
+var c_stream: z_stream; (* compression stream *)
+ err: Integer;
+ len: Integer;
+begin
+ len := StrLen(hello)+1;
+
+ c_stream.zalloc := NIL;
+ c_stream.zfree := NIL;
+ c_stream.opaque := NIL;
+
+ err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
+ CHECK_ERR(err, 'deflateInit');
+
+ c_stream.next_in := hello;
+ c_stream.next_out := compr;
+ c_stream.avail_in := 3;
+ c_stream.avail_out := Integer(comprLen);
+ err := deflate(c_stream, Z_FULL_FLUSH);
+ CHECK_ERR(err, 'deflate');
+
+ Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *)
+ c_stream.avail_in := len - 3;
+
+ err := deflate(c_stream, Z_FINISH);
+ if err <> Z_STREAM_END then
+ CHECK_ERR(err, 'deflate');
+
+ err := deflateEnd(c_stream);
+ CHECK_ERR(err, 'deflateEnd');
+
+ comprLen := c_stream.total_out;
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test inflateSync()
+ *)
+{$IFDEF TEST_SYNC}
+procedure test_sync(compr: Pointer; comprLen: LongInt;
+ uncompr: Pointer; uncomprLen : LongInt);
+var err: Integer;
+ d_stream: z_stream; (* decompression stream *)
+begin
+ StrCopy(PChar(uncompr), 'garbage');
+
+ d_stream.zalloc := NIL;
+ d_stream.zfree := NIL;
+ d_stream.opaque := NIL;
+
+ d_stream.next_in := compr;
+ d_stream.avail_in := 2; (* just read the zlib header *)
+
+ err := inflateInit(d_stream);
+ CHECK_ERR(err, 'inflateInit');
+
+ d_stream.next_out := uncompr;
+ d_stream.avail_out := Integer(uncomprLen);
+
+ inflate(d_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, 'inflate');
+
+ d_stream.avail_in := Integer(comprLen-2); (* read all compressed data *)
+ err := inflateSync(d_stream); (* but skip the damaged part *)
+ CHECK_ERR(err, 'inflateSync');
+
+ err := inflate(d_stream, Z_FINISH);
+ if err <> Z_DATA_ERROR then
+ EXIT_ERR('inflate should report DATA_ERROR');
+ (* Because of incorrect adler32 *)
+
+ err := inflateEnd(d_stream);
+ CHECK_ERR(err, 'inflateEnd');
+
+ WriteLn('after inflateSync(): hel', PChar(uncompr));
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test deflate with preset dictionary
+ *)
+{$IFDEF TEST_DICT}
+procedure test_dict_deflate(compr: Pointer; comprLen: LongInt);
+var c_stream: z_stream; (* compression stream *)
+ err: Integer;
+begin
+ c_stream.zalloc := NIL;
+ c_stream.zfree := NIL;
+ c_stream.opaque := NIL;
+
+ err := deflateInit(c_stream, Z_BEST_COMPRESSION);
+ CHECK_ERR(err, 'deflateInit');
+
+ err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary));
+ CHECK_ERR(err, 'deflateSetDictionary');
+
+ dictId := c_stream.adler;
+ c_stream.next_out := compr;
+ c_stream.avail_out := Integer(comprLen);
+
+ c_stream.next_in := hello;
+ c_stream.avail_in := StrLen(hello)+1;
+
+ err := deflate(c_stream, Z_FINISH);
+ if err <> Z_STREAM_END then
+ EXIT_ERR('deflate should report Z_STREAM_END');
+
+ err := deflateEnd(c_stream);
+ CHECK_ERR(err, 'deflateEnd');
+end;
+{$ENDIF}
+
+(* ===========================================================================
+ * Test inflate with a preset dictionary
+ *)
+{$IFDEF TEST_DICT}
+procedure test_dict_inflate(compr: Pointer; comprLen: LongInt;
+ uncompr: Pointer; uncomprLen: LongInt);
+var err: Integer;
+ d_stream: z_stream; (* decompression stream *)
+begin
+ StrCopy(PChar(uncompr), 'garbage');
+
+ d_stream.zalloc := NIL;
+ d_stream.zfree := NIL;
+ d_stream.opaque := NIL;
+
+ d_stream.next_in := compr;
+ d_stream.avail_in := Integer(comprLen);
+
+ err := inflateInit(d_stream);
+ CHECK_ERR(err, 'inflateInit');
+
+ d_stream.next_out := uncompr;
+ d_stream.avail_out := Integer(uncomprLen);
+
+ while TRUE do
+ begin
+ err := inflate(d_stream, Z_NO_FLUSH);
+ if err = Z_STREAM_END then
+ break;
+ if err = Z_NEED_DICT then
+ begin
+ if d_stream.adler <> dictId then
+ EXIT_ERR('unexpected dictionary');
+ err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary));
+ end;
+ CHECK_ERR(err, 'inflate with dict');
+ end;
+
+ err := inflateEnd(d_stream);
+ CHECK_ERR(err, 'inflateEnd');
+
+ if StrComp(PChar(uncompr), hello) <> 0 then
+ EXIT_ERR('bad inflate with dict')
+ else
+ WriteLn('inflate with dictionary: ', PChar(uncompr));
+end;
+{$ENDIF}
+
+var compr, uncompr: Pointer;
+ comprLen, uncomprLen: LongInt;
+
+begin
+ if zlibVersion^ <> ZLIB_VERSION[1] then
+ EXIT_ERR('Incompatible zlib version');
+
+ WriteLn('zlib version: ', zlibVersion);
+ WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags]));
+
+ comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *)
+ uncomprLen := comprLen;
+ GetMem(compr, comprLen);
+ GetMem(uncompr, uncomprLen);
+ if (compr = NIL) or (uncompr = NIL) then
+ EXIT_ERR('Out of memory');
+ (* compr and uncompr are cleared to avoid reading uninitialized
+ * data and to ensure that uncompr compresses well.
+ *)
+ FillChar(compr^, comprLen, 0);
+ FillChar(uncompr^, uncomprLen, 0);
+
+ {$IFDEF TEST_COMPRESS}
+ WriteLn('** Testing compress');
+ test_compress(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+
+ {$IFDEF TEST_GZIO}
+ WriteLn('** Testing gzio');
+ if ParamCount >= 1 then
+ test_gzio(ParamStr(1), uncompr, uncomprLen)
+ else
+ test_gzio(TESTFILE, uncompr, uncomprLen);
+ {$ENDIF}
+
+ {$IFDEF TEST_DEFLATE}
+ WriteLn('** Testing deflate with small buffers');
+ test_deflate(compr, comprLen);
+ {$ENDIF}
+ {$IFDEF TEST_INFLATE}
+ WriteLn('** Testing inflate with small buffers');
+ test_inflate(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+
+ {$IFDEF TEST_DEFLATE}
+ WriteLn('** Testing deflate with large buffers');
+ test_large_deflate(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+ {$IFDEF TEST_INFLATE}
+ WriteLn('** Testing inflate with large buffers');
+ test_large_inflate(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+
+ {$IFDEF TEST_FLUSH}
+ WriteLn('** Testing deflate with full flush');
+ test_flush(compr, comprLen);
+ {$ENDIF}
+ {$IFDEF TEST_SYNC}
+ WriteLn('** Testing inflateSync');
+ test_sync(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+ comprLen := uncomprLen;
+
+ {$IFDEF TEST_DICT}
+ WriteLn('** Testing deflate and inflate with preset dictionary');
+ test_dict_deflate(compr, comprLen);
+ test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
+ {$ENDIF}
+
+ FreeMem(compr, comprLen);
+ FreeMem(uncompr, uncomprLen);
+end.
diff --git a/compat/zlib/contrib/pascal/readme.txt b/compat/zlib/contrib/pascal/readme.txt
new file mode 100644
index 0000000..60e87c8
--- /dev/null
+++ b/compat/zlib/contrib/pascal/readme.txt
@@ -0,0 +1,76 @@
+
+This directory contains a Pascal (Delphi, Kylix) interface to the
+zlib data compression library.
+
+
+Directory listing
+=================
+
+zlibd32.mak makefile for Borland C++
+example.pas usage example of zlib
+zlibpas.pas the Pascal interface to zlib
+readme.txt this file
+
+
+Compatibility notes
+===================
+
+- Although the name "zlib" would have been more normal for the
+ zlibpas unit, this name is already taken by Borland's ZLib unit.
+ This is somehow unfortunate, because that unit is not a genuine
+ interface to the full-fledged zlib functionality, but a suite of
+ class wrappers around zlib streams. Other essential features,
+ such as checksums, are missing.
+ It would have been more appropriate for that unit to have a name
+ like "ZStreams", or something similar.
+
+- The C and zlib-supplied types int, uInt, long, uLong, etc. are
+ translated directly into Pascal types of similar sizes (Integer,
+ LongInt, etc.), to avoid namespace pollution. In particular,
+ there is no conversion of unsigned int into a Pascal unsigned
+ integer. The Word type is non-portable and has the same size
+ (16 bits) both in a 16-bit and in a 32-bit environment, unlike
+ Integer. Even if there is a 32-bit Cardinal type, there is no
+ real need for unsigned int in zlib under a 32-bit environment.
+
+- Except for the callbacks, the zlib function interfaces are
+ assuming the calling convention normally used in Pascal
+ (__pascal for DOS and Windows16, __fastcall for Windows32).
+ Since the cdecl keyword is used, the old Turbo Pascal does
+ not work with this interface.
+
+- The gz* function interfaces are not translated, to avoid
+ interfacing problems with the C runtime library. Besides,
+ gzprintf(gzFile file, const char *format, ...)
+ cannot be translated into Pascal.
+
+
+Legal issues
+============
+
+The zlibpas interface is:
+ Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler.
+ Copyright (C) 1998 by Bob Dellaca.
+ Copyright (C) 2003 by Cosmin Truta.
+
+The example program is:
+ Copyright (C) 1995-2003 by Jean-loup Gailly.
+ Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali.
+ Copyright (C) 2003 by Cosmin Truta.
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
diff --git a/compat/zlib/contrib/pascal/zlibd32.mak b/compat/zlib/contrib/pascal/zlibd32.mak
new file mode 100644
index 0000000..9bb00b7
--- /dev/null
+++ b/compat/zlib/contrib/pascal/zlibd32.mak
@@ -0,0 +1,99 @@
+# Makefile for zlib
+# For use with Delphi and C++ Builder under Win32
+# Updated for zlib 1.2.x by Cosmin Truta
+
+# ------------ Borland C++ ------------
+
+# This project uses the Delphi (fastcall/register) calling convention:
+LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl
+
+CC = bcc32
+LD = bcc32
+AR = tlib
+# do not use "-pr" in CFLAGS
+CFLAGS = -a -d -k- -O2 $(LOC)
+LDFLAGS =
+
+
+# variables
+ZLIB_LIB = zlib.lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
+OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(CFLAGS) $*.c
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.c zlib.h zconf.h
+
+minigzip.obj: test/minigzip.c zlib.h zconf.h
+
+
+# For the sake of the old Borland make,
+# the command line is cut to fit in the MS-DOS 128 byte limit:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2)
+ -del $(ZLIB_LIB)
+ $(AR) $(ZLIB_LIB) $(OBJP1)
+ $(AR) $(ZLIB_LIB) $(OBJP2)
+
+
+# testing
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
+
+
+# cleanup
+clean:
+ -del *.obj
+ -del *.exe
+ -del *.lib
+ -del *.tds
+ -del zlib.bak
+ -del foo.gz
+
diff --git a/compat/zlib/contrib/pascal/zlibpas.pas b/compat/zlib/contrib/pascal/zlibpas.pas
new file mode 100644
index 0000000..e6a0782
--- /dev/null
+++ b/compat/zlib/contrib/pascal/zlibpas.pas
@@ -0,0 +1,276 @@
+(* zlibpas -- Pascal interface to the zlib data compression library
+ *
+ * Copyright (C) 2003 Cosmin Truta.
+ * Derived from original sources by Bob Dellaca.
+ * For conditions of distribution and use, see copyright notice in readme.txt
+ *)
+
+unit zlibpas;
+
+interface
+
+const
+ ZLIB_VERSION = '1.2.8';
+ ZLIB_VERNUM = $1280;
+
+type
+ alloc_func = function(opaque: Pointer; items, size: Integer): Pointer;
+ cdecl;
+ free_func = procedure(opaque, address: Pointer);
+ cdecl;
+
+ in_func = function(opaque: Pointer; var buf: PByte): Integer;
+ cdecl;
+ out_func = function(opaque: Pointer; buf: PByte; size: Integer): Integer;
+ cdecl;
+
+ z_streamp = ^z_stream;
+ z_stream = packed record
+ next_in: PChar; (* next input byte *)
+ avail_in: Integer; (* number of bytes available at next_in *)
+ total_in: LongInt; (* total nb of input bytes read so far *)
+
+ next_out: PChar; (* next output byte should be put there *)
+ avail_out: Integer; (* remaining free space at next_out *)
+ total_out: LongInt; (* total nb of bytes output so far *)
+
+ msg: PChar; (* last error message, NULL if no error *)
+ state: Pointer; (* not visible by applications *)
+
+ zalloc: alloc_func; (* used to allocate the internal state *)
+ zfree: free_func; (* used to free the internal state *)
+ opaque: Pointer; (* private data object passed to zalloc and zfree *)
+
+ data_type: Integer; (* best guess about the data type: ascii or binary *)
+ adler: LongInt; (* adler32 value of the uncompressed data *)
+ 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;
+ Z_PARTIAL_FLUSH = 1;
+ Z_SYNC_FLUSH = 2;
+ Z_FULL_FLUSH = 3;
+ Z_FINISH = 4;
+ Z_BLOCK = 5;
+ Z_TREES = 6;
+
+ Z_OK = 0;
+ Z_STREAM_END = 1;
+ Z_NEED_DICT = 2;
+ Z_ERRNO = -1;
+ Z_STREAM_ERROR = -2;
+ Z_DATA_ERROR = -3;
+ Z_MEM_ERROR = -4;
+ Z_BUF_ERROR = -5;
+ Z_VERSION_ERROR = -6;
+
+ Z_NO_COMPRESSION = 0;
+ Z_BEST_SPEED = 1;
+ Z_BEST_COMPRESSION = 9;
+ Z_DEFAULT_COMPRESSION = -1;
+
+ 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;
+
+ Z_DEFLATED = 8;
+
+(* basic functions *)
+function zlibVersion: PChar;
+function deflateInit(var strm: z_stream; level: Integer): Integer;
+function deflate(var strm: z_stream; flush: Integer): Integer;
+function deflateEnd(var strm: z_stream): Integer;
+function inflateInit(var strm: z_stream): Integer;
+function inflate(var strm: z_stream; flush: Integer): Integer;
+function inflateEnd(var strm: z_stream): Integer;
+
+(* advanced functions *)
+function deflateInit2(var strm: z_stream; level, method, windowBits,
+ memLevel, strategy: Integer): Integer;
+function deflateSetDictionary(var strm: z_stream; const dictionary: PChar;
+ dictLength: Integer): Integer;
+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;
+ out_fn: out_func; out_desc: Pointer): Integer;
+function inflateBackEnd(var strm: z_stream): Integer;
+function zlibCompileFlags: LongInt;
+
+(* utility functions *)
+function compress(dest: PChar; var destLen: LongInt;
+ const source: PChar; sourceLen: LongInt): Integer;
+function compress2(dest: PChar; var destLen: LongInt;
+ const source: PChar; sourceLen: LongInt;
+ level: Integer): Integer;
+function compressBound(sourceLen: LongInt): LongInt;
+function uncompress(dest: PChar; var destLen: LongInt;
+ const source: PChar; sourceLen: LongInt): Integer;
+
+(* 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;
+ const version: PChar; stream_size: Integer): Integer;
+function inflateInit_(var strm: z_stream; const version: PChar;
+ stream_size: Integer): Integer;
+function deflateInit2_(var strm: z_stream;
+ level, method, windowBits, memLevel, strategy: Integer;
+ const version: PChar; stream_size: Integer): Integer;
+function inflateInit2_(var strm: z_stream; windowBits: Integer;
+ const version: PChar; stream_size: Integer): Integer;
+function inflateBackInit_(var strm: z_stream;
+ windowBits: Integer; window: PChar;
+ const version: PChar; stream_size: Integer): Integer;
+
+
+implementation
+
+{$L adler32.obj}
+{$L compress.obj}
+{$L crc32.obj}
+{$L deflate.obj}
+{$L infback.obj}
+{$L inffast.obj}
+{$L inflate.obj}
+{$L inftrees.obj}
+{$L trees.obj}
+{$L uncompr.obj}
+{$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;
+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;
+function zlibCompileFlags; external;
+function zlibVersion; external;
+
+function deflateInit(var strm: z_stream; level: Integer): Integer;
+begin
+ Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel,
+ strategy: Integer): Integer;
+begin
+ Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
+ ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function inflateInit(var strm: z_stream): Integer;
+begin
+ Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
+begin
+ Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function inflateBackInit(var strm: z_stream;
+ windowBits: Integer; window: PChar): Integer;
+begin
+ Result := inflateBackInit_(strm, windowBits, window,
+ ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function _malloc(Size: Integer): Pointer; cdecl;
+begin
+ GetMem(Result, Size);
+end;
+
+procedure _free(Block: Pointer); cdecl;
+begin
+ FreeMem(Block);
+end;
+
+procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
+begin
+ FillChar(P^, count, B);
+end;
+
+procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
+begin
+ Move(source^, dest^, count);
+end;
+
+end.
diff --git a/compat/zlib/contrib/puff/Makefile b/compat/zlib/contrib/puff/Makefile
new file mode 100644
index 0000000..0e2594c
--- /dev/null
+++ b/compat/zlib/contrib/puff/Makefile
@@ -0,0 +1,42 @@
+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 puft *.o *.gc*
diff --git a/compat/zlib/contrib/puff/README b/compat/zlib/contrib/puff/README
new file mode 100644
index 0000000..bbc4cb5
--- /dev/null
+++ b/compat/zlib/contrib/puff/README
@@ -0,0 +1,63 @@
+Puff -- A Simple Inflate
+3 Mar 2003
+Mark Adler
+madler@alumni.caltech.edu
+
+What this is --
+
+puff.c provides the routine puff() to decompress the deflate data format. It
+does so more slowly than zlib, but the code is about one-fifth the size of the
+inflate code in zlib, and written to be very easy to read.
+
+Why I wrote this --
+
+puff.c was written to document the deflate format unambiguously, by virtue of
+being working C code. It is meant to supplement RFC 1951, which formally
+describes the deflate format. I have received many questions on details of the
+deflate format, and I hope that reading this code will answer those questions.
+puff.c is heavily commented with details of the deflate format, especially
+those little nooks and cranies of the format that might not be obvious from a
+specification.
+
+puff.c may also be useful in applications where code size or memory usage is a
+very limited resource, and speed is not as important.
+
+How to use it --
+
+Well, most likely you should just be reading puff.c and using zlib for actual
+applications, but if you must ...
+
+Include puff.h in your code, which provides this prototype:
+
+int puff(unsigned char *dest, /* pointer to destination pointer */
+ unsigned long *destlen, /* amount of output space */
+ unsigned char *source, /* pointer to source data pointer */
+ unsigned long *sourcelen); /* amount of input available */
+
+Then you can call puff() to decompress a deflate stream that is in memory in
+its entirety at source, to a sufficiently sized block of memory for the
+decompressed data at dest. puff() is the only external symbol in puff.c The
+only C library functions that puff.c needs are setjmp() and longjmp(), which
+are used to simplify error checking in the code to improve readabilty. puff.c
+does no memory allocation, and uses less than 2K bytes off of the stack.
+
+If destlen is not enough space for the uncompressed data, then inflate will
+return an error without writing more than destlen bytes. Note that this means
+that in order to decompress the deflate data successfully, you need to know
+the size of the uncompressed data ahead of time.
+
+If needed, puff() can determine the size of the uncompressed data with no
+output space. This is done by passing dest equal to (unsigned char *)0. Then
+the initial value of *destlen is ignored and *destlen is set to the length of
+the uncompressed data. So if the size of the uncompressed data is not known,
+then two passes of puff() can be used--first to determine the size, and second
+to do the actual inflation after allocating the appropriate memory. Not
+pretty, but it works. (This is one of the reasons you should be using zlib.)
+
+The deflate format is self-terminating. If the deflate stream does not end
+in *sourcelen bytes, puff() will return an error without reading at or past
+endsource.
+
+On return, *sourcelen is updated to the amount of input data consumed, and
+*destlen is updated to the size of the uncompressed data. See the comments
+in puff.c for the possible return codes for puff().
diff --git a/compat/zlib/contrib/puff/puff.c b/compat/zlib/contrib/puff/puff.c
new file mode 100644
index 0000000..ba58483
--- /dev/null
+++ b/compat/zlib/contrib/puff/puff.c
@@ -0,0 +1,840 @@
+/*
+ * puff.c
+ * Copyright (C) 2002-2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in puff.h
+ * version 2.3, 21 Jan 2013
+ *
+ * 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
+ * side benefit, this code might actually be useful when small code is more
+ * important than speed, such as bootstrap applications. For typical deflate
+ * data, zlib's inflate() is about four times as fast as puff(). zlib's
+ * inflate compiles to around 20K on my machine, whereas puff.c compiles to
+ * around 4K on my machine (a PowerPC using GNU cc). If the faster decode()
+ * function here is used, then puff() is only twice as slow as zlib's
+ * inflate().
+ *
+ * All dynamically allocated memory comes from the stack. The stack required
+ * is less than 2K bytes. This code is compatible with 16-bit int's and
+ * assumes that long's are at least 32 bits. puff.c uses the short data type,
+ * assumed to be 16 bits, for arrays in order to to conserve memory. The code
+ * works whether integers are stored big endian or little endian.
+ *
+ * In the comments below are "Format notes" that describe the inflate process
+ * and document some of the less obvious aspects of the format. This source
+ * code is meant to supplement RFC 1951, which formally describes the deflate
+ * format:
+ *
+ * http://www.zlib.org/rfc-deflate.html
+ */
+
+/*
+ * Change history:
+ *
+ * 1.0 10 Feb 2002 - First version
+ * 1.1 17 Feb 2002 - Clarifications of some comments and notes
+ * - Update puff() dest and source pointers on negative
+ * errors to facilitate debugging deflators
+ * - Remove longest from struct huffman -- not needed
+ * - Simplify offs[] index in construct()
+ * - Add input size and checking, using longjmp() to
+ * maintain easy readability
+ * - Use short data type for large arrays
+ * - Use pointers instead of long to specify source and
+ * destination sizes to avoid arbitrary 4 GB limits
+ * 1.2 17 Mar 2002 - Add faster version of decode(), doubles speed (!),
+ * but leave simple version for readabilty
+ * - Make sure invalid distances detected if pointers
+ * are 16 bits
+ * - 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 [Gailly]
+ * - Add a puff.h file for the interface
+ * - 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
+ * - Add FIXLCODES #define
+ * 1.5 6 Apr 2002 - Minor comment fixes
+ * 1.6 7 Aug 2002 - Minor format changes
+ * 1.7 3 Mar 2003 - Added test code for distribution
+ * - Added zlib-like license
+ * 1.8 9 Jan 2004 - Added some comments on no distance codes case
+ * 1.9 21 Feb 2008 - Fix bug on 16-bit integer architectures [Pohland]
+ * - Catch missing end-of-block symbol error
+ * 2.0 25 Jul 2008 - Add #define to permit distance too far back
+ * - Add option in TEST code for puff to write the data
+ * - Add option in TEST code to skip input bytes
+ * - 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
+ * 2.3 21 Jan 2013 - Check for invalid code length codes in dynamic blocks
+ */
+
+#include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */
+#include "puff.h" /* prototype for puff() */
+
+#define local static /* for local function definitions */
+
+/*
+ * Maximums for allocations and loops. It is not useful to change these --
+ * they are fixed by the deflate format.
+ */
+#define MAXBITS 15 /* maximum bits in a code */
+#define MAXLCODES 286 /* maximum number of literal/length codes */
+#define MAXDCODES 30 /* maximum number of distance codes */
+#define MAXCODES (MAXLCODES+MAXDCODES) /* maximum codes lengths to read */
+#define FIXLCODES 288 /* number of fixed literal/length codes */
+
+/* input and output state */
+struct state {
+ /* output state */
+ unsigned char *out; /* output buffer */
+ unsigned long outlen; /* available space at out */
+ unsigned long outcnt; /* bytes written to out so far */
+
+ /* input state */
+ const unsigned char *in; /* input buffer */
+ unsigned long inlen; /* available input at in */
+ unsigned long incnt; /* bytes read so far */
+ int bitbuf; /* bit buffer */
+ int bitcnt; /* number of bits in bit buffer */
+
+ /* input limit error return state for bits() and decode() */
+ jmp_buf env;
+};
+
+/*
+ * Return need bits from the input stream. This always leaves less than
+ * eight bits in the buffer. bits() works properly for need == 0.
+ *
+ * Format notes:
+ *
+ * - Bits are stored in bytes from the least significant bit to the most
+ * significant bit. Therefore bits are dropped from the bottom of the bit
+ * buffer, using shift right, and new bytes are appended to the top of the
+ * bit buffer, using shift left.
+ */
+local int bits(struct state *s, int need)
+{
+ long val; /* bit accumulator (can use up to 20 bits) */
+
+ /* 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 */
+ val |= (long)(s->in[s->incnt++]) << s->bitcnt; /* load eight bits */
+ s->bitcnt += 8;
+ }
+
+ /* drop need bits and update buffer, always zero to seven bits left */
+ s->bitbuf = (int)(val >> need);
+ s->bitcnt -= need;
+
+ /* return need bits, zeroing the bits above that */
+ return (int)(val & ((1L << need) - 1));
+}
+
+/*
+ * Process a stored block.
+ *
+ * Format notes:
+ *
+ * - After the two-bit stored block type (00), the stored block length and
+ * stored bytes are byte-aligned for fast copying. Therefore any leftover
+ * bits in the byte that has the last bit of the type, as many as seven, are
+ * discarded. The value of the discarded bits are not defined and should not
+ * be checked against any expectation.
+ *
+ * - The second inverted copy of the stored block length does not have to be
+ * checked, but it's probably a good idea to do so anyway.
+ *
+ * - A stored block can have zero length. This is sometimes used to byte-align
+ * subsets of the compressed data for random access or partial recovery.
+ */
+local int stored(struct state *s)
+{
+ unsigned len; /* length of stored block */
+
+ /* discard leftover bits from current byte (assumes s->bitcnt < 8) */
+ s->bitbuf = 0;
+ s->bitcnt = 0;
+
+ /* get length and check against its one's complement */
+ 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) ||
+ s->in[s->incnt++] != ((~len >> 8) & 0xff))
+ 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->out != NIL) {
+ if (s->outcnt + len > s->outlen)
+ return 1; /* not enough output space */
+ while (len--)
+ s->out[s->outcnt++] = s->in[s->incnt++];
+ }
+ else { /* just scanning */
+ s->outcnt += len;
+ s->incnt += len;
+ }
+
+ /* done with a valid stored block */
+ return 0;
+}
+
+/*
+ * Huffman code decoding tables. count[1..MAXBITS] is the number of symbols of
+ * each length, which for a canonical code are stepped through in order.
+ * symbol[] are the symbol values in canonical order, where the number of
+ * entries is the sum of the counts in count[]. The decoding process can be
+ * seen in the function decode() below.
+ */
+struct huffman {
+ short *count; /* number of symbols of each length */
+ short *symbol; /* canonically ordered symbols */
+};
+
+/*
+ * Decode a code from the stream s using huffman table h. Return the symbol or
+ * a negative value if there is an error. If all of the lengths are zero, i.e.
+ * an empty code, or if the code is incomplete and an invalid code is received,
+ * then -10 is returned after reading MAXBITS bits.
+ *
+ * Format notes:
+ *
+ * - The codes as stored in the compressed data are bit-reversed relative to
+ * a simple integer ordering of codes of the same lengths. Hence below the
+ * bits are pulled from the compressed data one at a time and used to
+ * build the code value reversed from what is in the stream in order to
+ * permit simple integer comparisons for decoding. A table-based decoding
+ * scheme (as used in zlib) does not need to do this reversal.
+ *
+ * - The first code for the shortest length is all zeros. Subsequent codes of
+ * the same length are simply integer increments of the previous code. When
+ * moving up a length, a zero bit is appended to the code. For a complete
+ * code, the last code of the longest length will be all ones.
+ *
+ * - Incomplete codes are handled by this decoder, since they are permitted
+ * in the deflate format. See the format notes for fixed() and dynamic().
+ */
+#ifdef SLOW
+local int decode(struct state *s, const struct huffman *h)
+{
+ int len; /* current number of bits in code */
+ int code; /* len bits being decoded */
+ int first; /* first code of length len */
+ int count; /* number of codes of length len */
+ int index; /* index of first code of length len in symbol table */
+
+ code = first = index = 0;
+ for (len = 1; len <= MAXBITS; len++) {
+ code |= bits(s, 1); /* get next bit */
+ count = h->count[len];
+ if (code - count < first) /* if length len, return symbol */
+ return h->symbol[index + (code - first)];
+ index += count; /* else update for next length */
+ first += count;
+ first <<= 1;
+ code <<= 1;
+ }
+ return -10; /* ran out of codes */
+}
+
+/*
+ * A faster version of decode() for real applications of this code. It's not
+ * as readable, but it makes puff() twice as fast. And it only makes the code
+ * a few percent larger.
+ */
+#else /* !SLOW */
+local int decode(struct state *s, const struct huffman *h)
+{
+ int len; /* current number of bits in code */
+ int code; /* len bits being decoded */
+ int first; /* first code of length len */
+ int count; /* number of codes of length len */
+ int index; /* index of first code of length len in symbol table */
+ int bitbuf; /* bits from stream */
+ int left; /* bits left in next or left to process */
+ short *next; /* next number of codes */
+
+ bitbuf = s->bitbuf;
+ left = s->bitcnt;
+ code = first = index = 0;
+ len = 1;
+ next = h->count + 1;
+ while (1) {
+ while (left--) {
+ code |= bitbuf & 1;
+ bitbuf >>= 1;
+ count = *next++;
+ if (code - count < first) { /* if length len, return symbol */
+ s->bitbuf = bitbuf;
+ s->bitcnt = (s->bitcnt - len) & 7;
+ return h->symbol[index + (code - first)];
+ }
+ index += count; /* else update for next length */
+ first += count;
+ first <<= 1;
+ code <<= 1;
+ len++;
+ }
+ left = (MAXBITS+1) - len;
+ 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;
+ }
+ return -10; /* ran out of codes */
+}
+#endif /* SLOW */
+
+/*
+ * Given the list of code lengths length[0..n-1] representing a canonical
+ * Huffman code for n symbols, construct the tables required to decode those
+ * codes. Those tables are the number of codes of each length, and the symbols
+ * sorted by length, retaining their original order within each length. The
+ * return value is zero for a complete code set, negative for an over-
+ * subscribed code set, and positive for an incomplete code set. The tables
+ * can be used if the return value is zero or positive, but they cannot be used
+ * if the return value is negative. If the return value is zero, it is not
+ * possible for decode() using that table to return an error--any stream of
+ * enough bits will resolve to a symbol. If the return value is positive, then
+ * it is possible for decode() using that table to return an error for received
+ * codes past the end of the incomplete lengths.
+ *
+ * Not used by decode(), but used for error checking, h->count[0] is the number
+ * of the n symbols not in the code. So n - h->count[0] is the number of
+ * codes. This is useful for checking for incomplete codes that have more than
+ * one symbol, which is an error in a dynamic block.
+ *
+ * Assumption: for all i in 0..n-1, 0 <= length[i] <= MAXBITS
+ * This is assured by the construction of the length arrays in dynamic() and
+ * fixed() and is not verified by construct().
+ *
+ * Format notes:
+ *
+ * - Permitted and expected examples of incomplete codes are one of the fixed
+ * codes and any code with a single symbol which in deflate is coded as one
+ * bit instead of zero bits. See the format notes for fixed() and dynamic().
+ *
+ * - Within a given code length, the symbols are kept in ascending order for
+ * the code bits definition.
+ */
+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[] */
+ int left; /* number of possible codes left of current length */
+ short offs[MAXBITS+1]; /* offsets in symbol table for each length */
+
+ /* count number of codes of each length */
+ for (len = 0; len <= MAXBITS; len++)
+ h->count[len] = 0;
+ for (symbol = 0; symbol < n; symbol++)
+ (h->count[length[symbol]])++; /* assumes lengths are within bounds */
+ if (h->count[0] == n) /* no codes! */
+ return 0; /* complete, but decode() will fail */
+
+ /* check for an over-subscribed or incomplete set of lengths */
+ left = 1; /* one possible code of zero length */
+ 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 */
+ } /* left > 0 means incomplete */
+
+ /* generate offsets into symbol table for each length for sorting */
+ offs[1] = 0;
+ for (len = 1; len < MAXBITS; len++)
+ offs[len + 1] = offs[len] + h->count[len];
+
+ /*
+ * put symbols in table sorted by length, by symbol order within each
+ * length
+ */
+ for (symbol = 0; symbol < n; symbol++)
+ if (length[symbol] != 0)
+ h->symbol[offs[length[symbol]]++] = symbol;
+
+ /* return zero for complete set, positive for incomplete set */
+ return left;
+}
+
+/*
+ * Decode literal/length and distance codes until an end-of-block code.
+ *
+ * Format notes:
+ *
+ * - Compressed data that is after the block type if fixed or after the code
+ * description if dynamic is a combination of literals and length/distance
+ * pairs terminated by and end-of-block code. Literals are simply Huffman
+ * coded bytes. A length/distance pair is a coded length followed by a
+ * coded distance to represent a string that occurs earlier in the
+ * uncompressed data that occurs again at the current location.
+ *
+ * - Literals, lengths, and the end-of-block code are combined into a single
+ * code of up to 286 symbols. They are 256 literals (0..255), 29 length
+ * symbols (257..285), and the end-of-block symbol (256).
+ *
+ * - There are 256 possible lengths (3..258), and so 29 symbols are not enough
+ * to represent all of those. Lengths 3..10 and 258 are in fact represented
+ * by just a length symbol. Lengths 11..257 are represented as a symbol and
+ * some number of extra bits that are added as an integer to the base length
+ * of the length symbol. The number of extra bits is determined by the base
+ * length symbol. These are in the static arrays below, lens[] for the base
+ * lengths and lext[] for the corresponding number of extra bits.
+ *
+ * - The reason that 258 gets its own symbol is that the longest length is used
+ * often in highly redundant files. Note that 258 can also be coded as the
+ * base value 227 plus the maximum extra value of 31. While a good deflate
+ * should never do this, it is not an error, and should be decoded properly.
+ *
+ * - If a length is decoded, including its extra bits if any, then it is
+ * followed a distance code. There are up to 30 distance symbols. Again
+ * there are many more possible distances (1..32768), so extra bits are added
+ * to a base value represented by the symbol. The distances 1..4 get their
+ * own symbol, but the rest require extra bits. The base distances and
+ * corresponding number of extra bits are below in the static arrays dist[]
+ * and dext[].
+ *
+ * - Literal bytes are simply written to the output. A length/distance pair is
+ * an instruction to copy previously uncompressed bytes to the output. The
+ * copy is from distance bytes back in the output stream, copying for length
+ * bytes.
+ *
+ * - Distances pointing before the beginning of the output data are not
+ * permitted.
+ *
+ * - Overlapped copies, where the length is greater than the distance, are
+ * allowed and common. For example, a distance of one and a length of 258
+ * simply copies the last byte 258 times. A distance of four and a length of
+ * twelve copies the last four bytes three times. A simple forward copy
+ * ignoring whether the length is greater than the distance or not implements
+ * this correctly. You should not use memcpy() since its behavior is not
+ * defined for overlapped arrays. You should not use memmove() or bcopy()
+ * since though their behavior -is- defined for overlapping arrays, it is
+ * defined to do the wrong thing in this case.
+ */
+local int codes(struct state *s,
+ const struct huffman *lencode,
+ const struct huffman *distcode)
+{
+ int symbol; /* decoded symbol */
+ int len; /* length for copy */
+ unsigned dist; /* distance for copy */
+ static const short lens[29] = { /* Size base for length codes 257..285 */
+ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
+ 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258};
+ static const short lext[29] = { /* Extra bits for length codes 257..285 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
+ 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0};
+ static const short dists[30] = { /* Offset base for distance codes 0..29 */
+ 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,
+ 8193, 12289, 16385, 24577};
+ static const short dext[30] = { /* Extra bits for distance codes 0..29 */
+ 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
+ 7, 7, 8, 8, 9, 9, 10, 10, 11, 11,
+ 12, 12, 13, 13};
+
+ /* decode literals and length/distance pairs */
+ do {
+ symbol = decode(s, lencode);
+ 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;
+ s->out[s->outcnt] = symbol;
+ }
+ s->outcnt++;
+ }
+ else if (symbol > 256) { /* length */
+ /* get and compute length */
+ symbol -= 257;
+ 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 */
+ dist = dists[symbol] + bits(s, dext[symbol]);
+#ifndef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ if (dist > s->outcnt)
+ return -11; /* distance too far back */
+#endif
+
+ /* copy length bytes from distance bytes back */
+ if (s->out != NIL) {
+ 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 :
+#endif
+ s->out[s->outcnt - dist];
+ s->outcnt++;
+ }
+ }
+ else
+ s->outcnt += len;
+ }
+ } while (symbol != 256); /* end of block symbol */
+
+ /* done with a valid fixed or dynamic block */
+ return 0;
+}
+
+/*
+ * Process a fixed codes block.
+ *
+ * Format notes:
+ *
+ * - This block type can be useful for compressing small amounts of data for
+ * which the size of the code descriptions in a dynamic block exceeds the
+ * benefit of custom codes for that block. For fixed codes, no bits are
+ * spent on code descriptions. Instead the code lengths for literal/length
+ * codes and distance codes are fixed. The specific lengths for each symbol
+ * can be seen in the "for" loops below.
+ *
+ * - The literal/length code is complete, but has two symbols that are invalid
+ * and should result in an error if received. This cannot be implemented
+ * simply as an incomplete code since those two symbols are in the "middle"
+ * of the code. They are eight bits long and the longest literal/length\
+ * code is nine bits. Therefore the code must be constructed with those
+ * symbols, and the invalid symbols must be detected after decoding.
+ *
+ * - The fixed distance codes also have two invalid symbols that should result
+ * in an error if received. Since all of the distance codes are the same
+ * length, this can be implemented as an incomplete code. Then the invalid
+ * codes are detected while decoding.
+ */
+local int fixed(struct state *s)
+{
+ static int virgin = 1;
+ static short lencnt[MAXBITS+1], lensym[FIXLCODES];
+ static short distcnt[MAXBITS+1], distsym[MAXDCODES];
+ static struct huffman lencode, distcode;
+
+ /* build fixed huffman tables if first call (may not be thread safe) */
+ if (virgin) {
+ 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;
+ for (; symbol < 256; symbol++)
+ lengths[symbol] = 9;
+ for (; symbol < 280; symbol++)
+ lengths[symbol] = 7;
+ for (; symbol < FIXLCODES; symbol++)
+ lengths[symbol] = 8;
+ construct(&lencode, lengths, FIXLCODES);
+
+ /* distance table */
+ for (symbol = 0; symbol < MAXDCODES; symbol++)
+ lengths[symbol] = 5;
+ construct(&distcode, lengths, MAXDCODES);
+
+ /* do this just once */
+ virgin = 0;
+ }
+
+ /* decode data until end-of-block code */
+ return codes(s, &lencode, &distcode);
+}
+
+/*
+ * Process a dynamic codes block.
+ *
+ * Format notes:
+ *
+ * - A dynamic block starts with a description of the literal/length and
+ * distance codes for that block. New dynamic blocks allow the compressor to
+ * rapidly adapt to changing data with new codes optimized for that data.
+ *
+ * - The codes used by the deflate format are "canonical", which means that
+ * the actual bits of the codes are generated in an unambiguous way simply
+ * from the number of bits in each code. Therefore the code descriptions
+ * are simply a list of code lengths for each symbol.
+ *
+ * - The code lengths are stored in order for the symbols, so lengths are
+ * provided for each of the literal/length symbols, and for each of the
+ * distance symbols.
+ *
+ * - If a symbol is not used in the block, this is represented by a zero as
+ * as the code length. This does not mean a zero-length code, but rather
+ * that no code should be created for this symbol. There is no way in the
+ * deflate format to represent a zero-length code.
+ *
+ * - The maximum number of bits in a code is 15, so the possible lengths for
+ * any code are 1..15.
+ *
+ * - The fact that a length of zero is not permitted for a code has an
+ * interesting consequence. Normally if only one symbol is used for a given
+ * code, then in fact that code could be represented with zero bits. However
+ * in deflate, that code has to be at least one bit. So for example, if
+ * only a single distance base symbol appears in a block, then it will be
+ * represented by a single code of length one, in particular one 0 bit. This
+ * is an incomplete code, since if a 1 bit is received, it has no meaning,
+ * and should result in an error. So incomplete distance codes of one symbol
+ * should be permitted, and the receipt of invalid codes should be handled.
+ *
+ * - It is also possible to have a single literal/length code, but that code
+ * must be the end-of-block code, since every dynamic block has one. This
+ * is not the most efficient way to create an empty block (an empty fixed
+ * block is fewer bits), but it is allowed by the format. So incomplete
+ * literal/length codes of one symbol should also be permitted.
+ *
+ * - If there are only literal codes and no lengths, then there are no distance
+ * codes. This is represented by one distance code with zero bits.
+ *
+ * - The list of up to 286 length/literal lengths and up to 30 distance lengths
+ * are themselves compressed using Huffman codes and run-length encoding. In
+ * the list of code lengths, a 0 symbol means no code, a 1..15 symbol means
+ * that length, and the symbols 16, 17, and 18 are run-length instructions.
+ * Each of 16, 17, and 18 are follwed by extra bits to define the length of
+ * the run. 16 copies the last length 3 to 6 times. 17 represents 3 to 10
+ * zero lengths, and 18 represents 11 to 138 zero lengths. Unused symbols
+ * are common, hence the special coding for zero lengths.
+ *
+ * - The symbols for 0..18 are Huffman coded, and so that code must be
+ * described first. This is simply a sequence of up to 19 three-bit values
+ * representing no code (0) or the code length for that symbol (1..7).
+ *
+ * - A dynamic block starts with three fixed-size counts from which is computed
+ * the number of literal/length code lengths, the number of distance code
+ * lengths, and the number of code length code lengths (ok, you come up with
+ * a better name!) in the code descriptions. For the literal/length and
+ * distance codes, lengths after those provided are considered zero, i.e. no
+ * code. The code length code lengths are received in a permuted order (see
+ * the order[] array below) to make a short code length code length list more
+ * likely. As it turns out, very short and very long codes are less likely
+ * to be seen in a dynamic code description, hence what may appear initially
+ * to be a peculiar ordering.
+ *
+ * - Given the number of literal/length code lengths (nlen) and distance code
+ * lengths (ndist), then they are treated as one long list of nlen + ndist
+ * code lengths. Therefore run-length coding can and often does cross the
+ * boundary between the two sets of lengths.
+ *
+ * - So to summarize, the code description at the start of a dynamic block is
+ * three counts for the number of code lengths for the literal/length codes,
+ * the distance codes, and the code length codes. This is followed by the
+ * code length code lengths, three bits each. This is used to construct the
+ * code length code which is used to read the remainder of the lengths. Then
+ * the literal/length code lengths and distance lengths are read as a single
+ * set of lengths using the code length codes. Codes are constructed from
+ * the resulting two sets of lengths, and then finally you can start
+ * decoding actual compressed data in the block.
+ *
+ * - For reference, a "typical" size for the code description in a dynamic
+ * block is around 80 bytes.
+ */
+local int dynamic(struct state *s)
+{
+ int nlen, ndist, ncode; /* number of lengths in descriptor */
+ int index; /* index of lengths[] */
+ int err; /* construct() return value */
+ short lengths[MAXCODES]; /* descriptor code lengths */
+ short lencnt[MAXBITS+1], lensym[MAXLCODES]; /* lencode memory */
+ short distcnt[MAXBITS+1], distsym[MAXDCODES]; /* distcode memory */
+ struct huffman lencode, distcode; /* length and distance codes */
+ static const short order[19] = /* permutation of code length codes */
+ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
+
+ /* construct lencode and distcode */
+ lencode.count = lencnt;
+ lencode.symbol = lensym;
+ distcode.count = distcnt;
+ distcode.symbol = distsym;
+
+ /* get number of lengths in each table, check lengths */
+ nlen = bits(s, 5) + 257;
+ ndist = bits(s, 5) + 1;
+ ncode = bits(s, 4) + 4;
+ if (nlen > MAXLCODES || ndist > MAXDCODES)
+ return -3; /* bad counts */
+
+ /* read code length code lengths (really), missing lengths are zero */
+ for (index = 0; index < ncode; index++)
+ lengths[order[index]] = bits(s, 3);
+ for (; index < 19; index++)
+ lengths[order[index]] = 0;
+
+ /* build huffman table for code lengths codes (use lencode temporarily) */
+ err = construct(&lencode, lengths, 19);
+ if (err != 0) /* require complete code set here */
+ return -4;
+
+ /* read length/literal and distance code length tables */
+ index = 0;
+ while (index < nlen + ndist) {
+ int symbol; /* decoded value */
+ int len; /* last length to repeat */
+
+ symbol = decode(s, &lencode);
+ if (symbol < 0)
+ return symbol; /* invalid symbol */
+ if (symbol < 16) /* length in 0..15 */
+ lengths[index++] = symbol;
+ 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! */
+ len = lengths[index - 1]; /* last length */
+ symbol = 3 + bits(s, 2);
+ }
+ else if (symbol == 17) /* repeat zero 3..10 times */
+ symbol = 3 + bits(s, 3);
+ else /* == 18, repeat zero 11..138 times */
+ symbol = 11 + bits(s, 7);
+ if (index + symbol > nlen + ndist)
+ return -6; /* too many lengths! */
+ while (symbol--) /* repeat last or zero symbol times */
+ lengths[index++] = len;
+ }
+ }
+
+ /* check for end-of-block code -- there better be one! */
+ if (lengths[256] == 0)
+ return -9;
+
+ /* build huffman table for literal/length codes */
+ err = construct(&lencode, lengths, nlen);
+ 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 && (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);
+}
+
+/*
+ * Inflate source to dest. On return, destlen and sourcelen are updated to the
+ * size of the uncompressed data and the size of the deflate data respectively.
+ * On success, the return value of puff() is zero. If there is an error in the
+ * source data, i.e. it is not in the deflate format, then a negative value is
+ * returned. If there is not enough input available or there is not enough
+ * output space, then a positive error is returned. In that case, destlen and
+ * sourcelen are not updated to facilitate retrying from the beginning with the
+ * provision of more input data or more output space. In the case of invalid
+ * inflate data (a negative error), the dest and source pointers are updated to
+ * facilitate the debugging of deflators.
+ *
+ * puff() also has a mode to determine the size of the uncompressed output with
+ * no output written. For this dest must be (unsigned char *)0. In this case,
+ * the input value of *destlen is ignored, and on return *destlen is set to the
+ * size of the uncompressed output.
+ *
+ * The return codes are:
+ *
+ * 2: available inflate data did not terminate
+ * 1: output space exhausted before completing inflate
+ * 0: successful inflate
+ * -1: invalid block type (type == 3)
+ * -2: stored block length did not match one's complement
+ * -3: dynamic block code description: too many length or distance codes
+ * -4: dynamic block code description: code lengths codes incomplete
+ * -5: dynamic block code description: repeat lengths with no first length
+ * -6: dynamic block code description: repeat more than specified lengths
+ * -7: dynamic block code description: invalid literal/length code lengths
+ * -8: dynamic block code description: invalid distance code lengths
+ * -9: dynamic block code description: missing end-of-block code
+ * -10: invalid literal/length or distance code in fixed or dynamic block
+ * -11: distance is too far back in fixed or dynamic block
+ *
+ * Format notes:
+ *
+ * - Three bits are read for each block to determine the kind of block and
+ * whether or not it is the last block. Then the block is decoded and the
+ * process repeated if it was not the last block.
+ *
+ * - The leftover bits in the last byte of the deflate data after the last
+ * block (if it was a fixed or dynamic block) are undefined and have no
+ * expected values to check.
+ */
+int puff(unsigned char *dest, /* pointer to destination pointer */
+ unsigned long *destlen, /* amount of output space */
+ const unsigned char *source, /* pointer to source data pointer */
+ unsigned long *sourcelen) /* amount of input available */
+{
+ struct state s; /* input/output state */
+ int last, type; /* block information */
+ int err; /* return value */
+
+ /* initialize output state */
+ s.out = dest;
+ s.outlen = *destlen; /* ignored if dest is NIL */
+ s.outcnt = 0;
+
+ /* initialize input state */
+ s.in = source;
+ s.inlen = *sourcelen;
+ s.incnt = 0;
+ s.bitbuf = 0;
+ s.bitcnt = 0;
+
+ /* return if bits() or decode() tries to read past available input */
+ if (setjmp(s.env) != 0) /* if came back here via longjmp() */
+ err = 2; /* then skip do-loop, return error */
+ else {
+ /* process blocks until last block or error */
+ 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 */
+ } while (!last);
+ }
+
+ /* update the lengths and return */
+ if (err <= 0) {
+ *destlen = s.outcnt;
+ *sourcelen = s.incnt;
+ }
+ return err;
+}
diff --git a/compat/zlib/contrib/puff/puff.h b/compat/zlib/contrib/puff/puff.h
new file mode 100644
index 0000000..e23a245
--- /dev/null
+++ b/compat/zlib/contrib/puff/puff.h
@@ -0,0 +1,35 @@
+/* puff.h
+ Copyright (C) 2002-2013 Mark Adler, all rights reserved
+ version 2.3, 21 Jan 2013
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Mark Adler madler@alumni.caltech.edu
+ */
+
+
+/*
+ * 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 */
+ 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..7764814
--- /dev/null
+++ b/compat/zlib/contrib/puff/pufftest.c
@@ -0,0 +1,165 @@
+/*
+ * pufftest.c
+ * Copyright (C) 2002-2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in puff.h
+ * version 2.3, 21 Jan 2013
+ */
+
+/* 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
new file mode 100644
index 0000000..0a90e76
--- /dev/null
+++ b/compat/zlib/contrib/puff/zeros.raw
Binary files differ
diff --git a/compat/zlib/contrib/testzlib/testzlib.c b/compat/zlib/contrib/testzlib/testzlib.c
new file mode 100644
index 0000000..5f659de
--- /dev/null
+++ b/compat/zlib/contrib/testzlib/testzlib.c
@@ -0,0 +1,275 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <windows.h>
+
+#include "zlib.h"
+
+
+void MyDoMinus64(LARGE_INTEGER *R,LARGE_INTEGER A,LARGE_INTEGER B)
+{
+ R->HighPart = A.HighPart - B.HighPart;
+ if (A.LowPart >= B.LowPart)
+ R->LowPart = A.LowPart - B.LowPart;
+ else
+ {
+ R->LowPart = A.LowPart - B.LowPart;
+ R->HighPart --;
+ }
+}
+
+#ifdef _M_X64
+// see http://msdn2.microsoft.com/library/twchhe95(en-us,vs.80).aspx for __rdtsc
+unsigned __int64 __rdtsc(void);
+void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
+{
+ // printf("rdtsc = %I64x\n",__rdtsc());
+ pbeginTime64->QuadPart=__rdtsc();
+}
+
+LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
+{
+ LARGE_INTEGER LIres;
+ unsigned _int64 res=__rdtsc()-((unsigned _int64)(beginTime64.QuadPart));
+ LIres.QuadPart=res;
+ // printf("rdtsc = %I64x\n",__rdtsc());
+ return LIres;
+}
+#else
+#ifdef _M_IX86
+void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
+{
+ DWORD dwEdx,dwEax;
+ _asm
+ {
+ rdtsc
+ mov dwEax,eax
+ mov dwEdx,edx
+ }
+ pbeginTime64->LowPart=dwEax;
+ pbeginTime64->HighPart=dwEdx;
+}
+
+void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
+{
+ myGetRDTSC32(pbeginTime64);
+}
+
+LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
+{
+ LARGE_INTEGER LIres,endTime64;
+ myGetRDTSC32(&endTime64);
+
+ LIres.LowPart=LIres.HighPart=0;
+ MyDoMinus64(&LIres,endTime64,beginTime64);
+ return LIres;
+}
+#else
+void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
+{
+}
+
+void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
+{
+}
+
+LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
+{
+ LARGE_INTEGER lr;
+ lr.QuadPart=0;
+ return lr;
+}
+#endif
+#endif
+
+void BeginCountPerfCounter(LARGE_INTEGER * pbeginTime64,BOOL fComputeTimeQueryPerf)
+{
+ if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(pbeginTime64)))
+ {
+ pbeginTime64->LowPart = GetTickCount();
+ pbeginTime64->HighPart = 0;
+ }
+}
+
+DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
+{
+ LARGE_INTEGER endTime64,ticksPerSecond,ticks;
+ DWORDLONG ticksShifted,tickSecShifted;
+ DWORD dwLog=16+0;
+ DWORD dwRet;
+ if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(&endTime64)))
+ dwRet = (GetTickCount() - beginTime64.LowPart)*1;
+ else
+ {
+ MyDoMinus64(&ticks,endTime64,beginTime64);
+ QueryPerformanceFrequency(&ticksPerSecond);
+
+
+ {
+ ticksShifted = Int64ShrlMod32(*(DWORDLONG*)&ticks,dwLog);
+ tickSecShifted = Int64ShrlMod32(*(DWORDLONG*)&ticksPerSecond,dwLog);
+
+ }
+
+ dwRet = (DWORD)((((DWORD)ticksShifted)*1000)/(DWORD)(tickSecShifted));
+ dwRet *=1;
+ }
+ return dwRet;
+}
+
+int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr)
+{
+ FILE* stream;
+ unsigned char* ptr;
+ int retVal=1;
+ stream=fopen(filename, "rb");
+ if (stream==NULL)
+ return 0;
+
+ fseek(stream,0,SEEK_END);
+
+ *plFileSize=ftell(stream);
+ fseek(stream,0,SEEK_SET);
+ ptr=malloc((*plFileSize)+1);
+ if (ptr==NULL)
+ retVal=0;
+ else
+ {
+ if (fread(ptr, 1, *plFileSize,stream) != (*plFileSize))
+ retVal=0;
+ }
+ fclose(stream);
+ *pFilePtr=ptr;
+ return retVal;
+}
+
+int main(int argc, char *argv[])
+{
+ int BlockSizeCompress=0x8000;
+ int BlockSizeUncompress=0x8000;
+ int cprLevel=Z_DEFAULT_COMPRESSION ;
+ long lFileSize;
+ unsigned char* FilePtr;
+ long lBufferSizeCpr;
+ long lBufferSizeUncpr;
+ long lCompressedSize=0;
+ unsigned char* CprPtr;
+ unsigned char* UncprPtr;
+ long lSizeCpr,lSizeUncpr;
+ DWORD dwGetTick,dwMsecQP;
+ LARGE_INTEGER li_qp,li_rdtsc,dwResRdtsc;
+
+ if (argc<=1)
+ {
+ printf("run TestZlib <File> [BlockSizeCompress] [BlockSizeUncompress] [compres. level]\n");
+ return 0;
+ }
+
+ if (ReadFileMemory(argv[1],&lFileSize,&FilePtr)==0)
+ {
+ printf("error reading %s\n",argv[1]);
+ return 1;
+ }
+ else printf("file %s read, %u bytes\n",argv[1],lFileSize);
+
+ if (argc>=3)
+ BlockSizeCompress=atol(argv[2]);
+
+ if (argc>=4)
+ BlockSizeUncompress=atol(argv[3]);
+
+ if (argc>=5)
+ cprLevel=(int)atol(argv[4]);
+
+ lBufferSizeCpr = lFileSize + (lFileSize/0x10) + 0x200;
+ lBufferSizeUncpr = lBufferSizeCpr;
+
+ CprPtr=(unsigned char*)malloc(lBufferSizeCpr + BlockSizeCompress);
+
+ BeginCountPerfCounter(&li_qp,TRUE);
+ dwGetTick=GetTickCount();
+ BeginCountRdtsc(&li_rdtsc);
+ {
+ z_stream zcpr;
+ int ret=Z_OK;
+ long lOrigToDo = lFileSize;
+ long lOrigDone = 0;
+ int step=0;
+ memset(&zcpr,0,sizeof(z_stream));
+ deflateInit(&zcpr,cprLevel);
+
+ zcpr.next_in = FilePtr;
+ zcpr.next_out = CprPtr;
+
+
+ do
+ {
+ long all_read_before = zcpr.total_in;
+ zcpr.avail_in = min(lOrigToDo,BlockSizeCompress);
+ zcpr.avail_out = BlockSizeCompress;
+ ret=deflate(&zcpr,(zcpr.avail_in==lOrigToDo) ? Z_FINISH : Z_SYNC_FLUSH);
+ lOrigDone += (zcpr.total_in-all_read_before);
+ lOrigToDo -= (zcpr.total_in-all_read_before);
+ step++;
+ } while (ret==Z_OK);
+
+ lSizeCpr=zcpr.total_out;
+ deflateEnd(&zcpr);
+ dwGetTick=GetTickCount()-dwGetTick;
+ dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
+ dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
+ printf("total compress size = %u, in %u step\n",lSizeCpr,step);
+ printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
+ printf("defcpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
+ printf("defcpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
+ }
+
+ CprPtr=(unsigned char*)realloc(CprPtr,lSizeCpr);
+ UncprPtr=(unsigned char*)malloc(lBufferSizeUncpr + BlockSizeUncompress);
+
+ BeginCountPerfCounter(&li_qp,TRUE);
+ dwGetTick=GetTickCount();
+ BeginCountRdtsc(&li_rdtsc);
+ {
+ z_stream zcpr;
+ int ret=Z_OK;
+ long lOrigToDo = lSizeCpr;
+ long lOrigDone = 0;
+ int step=0;
+ memset(&zcpr,0,sizeof(z_stream));
+ inflateInit(&zcpr);
+
+ zcpr.next_in = CprPtr;
+ zcpr.next_out = UncprPtr;
+
+
+ do
+ {
+ long all_read_before = zcpr.total_in;
+ zcpr.avail_in = min(lOrigToDo,BlockSizeUncompress);
+ zcpr.avail_out = BlockSizeUncompress;
+ ret=inflate(&zcpr,Z_SYNC_FLUSH);
+ lOrigDone += (zcpr.total_in-all_read_before);
+ lOrigToDo -= (zcpr.total_in-all_read_before);
+ step++;
+ } while (ret==Z_OK);
+
+ lSizeUncpr=zcpr.total_out;
+ inflateEnd(&zcpr);
+ dwGetTick=GetTickCount()-dwGetTick;
+ dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
+ dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
+ printf("total uncompress size = %u, in %u step\n",lSizeUncpr,step);
+ printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
+ printf("uncpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
+ printf("uncpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
+ }
+
+ if (lSizeUncpr==lFileSize)
+ {
+ if (memcmp(FilePtr,UncprPtr,lFileSize)==0)
+ printf("compare ok\n");
+
+ }
+
+ return 0;
+}
diff --git a/compat/zlib/contrib/testzlib/testzlib.txt b/compat/zlib/contrib/testzlib/testzlib.txt
new file mode 100644
index 0000000..62258f1
--- /dev/null
+++ b/compat/zlib/contrib/testzlib/testzlib.txt
@@ -0,0 +1,10 @@
+To build testzLib with Visual Studio 2005:
+
+copy to a directory file from :
+- root of zLib tree
+- contrib/testzlib
+- contrib/masmx86
+- contrib/masmx64
+- contrib/vstudio/vc7
+
+and open testzlib8.sln \ No newline at end of file
diff --git a/compat/zlib/contrib/untgz/Makefile b/compat/zlib/contrib/untgz/Makefile
new file mode 100644
index 0000000..b54266f
--- /dev/null
+++ b/compat/zlib/contrib/untgz/Makefile
@@ -0,0 +1,14 @@
+CC=cc
+CFLAGS=-g
+
+untgz: untgz.o ../../libz.a
+ $(CC) $(CFLAGS) -o untgz untgz.o -L../.. -lz
+
+untgz.o: untgz.c ../../zlib.h
+ $(CC) $(CFLAGS) -c -I../.. untgz.c
+
+../../libz.a:
+ cd ../..; ./configure; make
+
+clean:
+ rm -f untgz untgz.o *~
diff --git a/compat/zlib/contrib/untgz/Makefile.msc b/compat/zlib/contrib/untgz/Makefile.msc
new file mode 100644
index 0000000..77b8602
--- /dev/null
+++ b/compat/zlib/contrib/untgz/Makefile.msc
@@ -0,0 +1,17 @@
+CC=cl
+CFLAGS=-MD
+
+untgz.exe: untgz.obj ..\..\zlib.lib
+ $(CC) $(CFLAGS) untgz.obj ..\..\zlib.lib
+
+untgz.obj: untgz.c ..\..\zlib.h
+ $(CC) $(CFLAGS) -c -I..\.. untgz.c
+
+..\..\zlib.lib:
+ cd ..\..
+ $(MAKE) -f win32\makefile.msc
+ cd contrib\untgz
+
+clean:
+ -del untgz.obj
+ -del untgz.exe
diff --git a/compat/zlib/contrib/untgz/untgz.c b/compat/zlib/contrib/untgz/untgz.c
new file mode 100644
index 0000000..2c391e5
--- /dev/null
+++ b/compat/zlib/contrib/untgz/untgz.c
@@ -0,0 +1,674 @@
+/*
+ * untgz.c -- Display contents and extract files from a gzip'd TAR file
+ *
+ * written by Pedro A. Aranda Gutierrez <paag@tid.es>
+ * adaptation to Unix by Jean-loup Gailly <jloup@gzip.org>
+ * various fixes by Cosmin Truta <cosmint@cs.ubbcluj.ro>
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+#include <errno.h>
+
+#include "zlib.h"
+
+#ifdef unix
+# include <unistd.h>
+#else
+# include <direct.h>
+# include <io.h>
+#endif
+
+#ifdef WIN32
+#include <windows.h>
+# ifndef F_OK
+# define F_OK 0
+# endif
+# define mkdir(dirname,mode) _mkdir(dirname)
+# ifdef _MSC_VER
+# define access(path,mode) _access(path,mode)
+# define chmod(path,mode) _chmod(path,mode)
+# define strdup(str) _strdup(str)
+# endif
+#else
+# include <utime.h>
+#endif
+
+
+/* values used in typeflag field */
+
+#define REGTYPE '0' /* regular file */
+#define AREGTYPE '\0' /* regular file */
+#define LNKTYPE '1' /* link */
+#define SYMTYPE '2' /* reserved */
+#define CHRTYPE '3' /* character special */
+#define BLKTYPE '4' /* block special */
+#define DIRTYPE '5' /* directory */
+#define FIFOTYPE '6' /* FIFO special */
+#define CONTTYPE '7' /* reserved */
+
+/* GNU tar extensions */
+
+#define GNUTYPE_DUMPDIR 'D' /* file names from dumped directory */
+#define GNUTYPE_LONGLINK 'K' /* long link name */
+#define GNUTYPE_LONGNAME 'L' /* long file name */
+#define GNUTYPE_MULTIVOL 'M' /* continuation of file from another volume */
+#define GNUTYPE_NAMES 'N' /* file name that does not fit into main hdr */
+#define GNUTYPE_SPARSE 'S' /* sparse file */
+#define GNUTYPE_VOLHDR 'V' /* tape/volume header */
+
+
+/* tar header */
+
+#define BLOCKSIZE 512
+#define SHORTNAMESIZE 100
+
+struct tar_header
+{ /* byte offset */
+ char name[100]; /* 0 */
+ char mode[8]; /* 100 */
+ char uid[8]; /* 108 */
+ char gid[8]; /* 116 */
+ char size[12]; /* 124 */
+ char mtime[12]; /* 136 */
+ char chksum[8]; /* 148 */
+ char typeflag; /* 156 */
+ char linkname[100]; /* 157 */
+ char magic[6]; /* 257 */
+ char version[2]; /* 263 */
+ char uname[32]; /* 265 */
+ char gname[32]; /* 297 */
+ char devmajor[8]; /* 329 */
+ char devminor[8]; /* 337 */
+ char prefix[155]; /* 345 */
+ /* 500 */
+};
+
+union tar_buffer
+{
+ char buffer[BLOCKSIZE];
+ struct tar_header header;
+};
+
+struct attr_item
+{
+ struct attr_item *next;
+ char *fname;
+ int mode;
+ time_t time;
+};
+
+enum { TGZ_EXTRACT, TGZ_LIST, TGZ_INVALID };
+
+char *TGZfname OF((const char *));
+void TGZnotfound OF((const char *));
+
+int getoct OF((char *, int));
+char *strtime OF((time_t *));
+int setfiletime OF((char *, time_t));
+void push_attr OF((struct attr_item **, char *, int, time_t));
+void restore_attr OF((struct attr_item **));
+
+int ExprMatch OF((char *, char *));
+
+int makedir OF((char *));
+int matchname OF((int, int, char **, char *));
+
+void error OF((const char *));
+int tar OF((gzFile, int, int, int, char **));
+
+void help OF((int));
+int main OF((int, char **));
+
+char *prog;
+
+const char *TGZsuffix[] = { "\0", ".tar", ".tar.gz", ".taz", ".tgz", NULL };
+
+/* return the file name of the TGZ archive */
+/* or NULL if it does not exist */
+
+char *TGZfname (const char *arcname)
+{
+ static char buffer[1024];
+ int origlen,i;
+
+ strcpy(buffer,arcname);
+ origlen = strlen(buffer);
+
+ for (i=0; TGZsuffix[i]; i++)
+ {
+ strcpy(buffer+origlen,TGZsuffix[i]);
+ if (access(buffer,F_OK) == 0)
+ return buffer;
+ }
+ return NULL;
+}
+
+
+/* error message for the filename */
+
+void TGZnotfound (const char *arcname)
+{
+ int i;
+
+ fprintf(stderr,"%s: Couldn't find ",prog);
+ for (i=0;TGZsuffix[i];i++)
+ fprintf(stderr,(TGZsuffix[i+1]) ? "%s%s, " : "or %s%s\n",
+ arcname,
+ TGZsuffix[i]);
+ exit(1);
+}
+
+
+/* convert octal digits to int */
+/* on error return -1 */
+
+int getoct (char *p,int width)
+{
+ int result = 0;
+ char c;
+
+ while (width--)
+ {
+ c = *p++;
+ if (c == 0)
+ break;
+ if (c == ' ')
+ continue;
+ if (c < '0' || c > '7')
+ return -1;
+ result = result * 8 + (c - '0');
+ }
+ return result;
+}
+
+
+/* convert time_t to string */
+/* use the "YYYY/MM/DD hh:mm:ss" format */
+
+char *strtime (time_t *t)
+{
+ struct tm *local;
+ static char result[32];
+
+ local = localtime(t);
+ sprintf(result,"%4d/%02d/%02d %02d:%02d:%02d",
+ local->tm_year+1900, local->tm_mon+1, local->tm_mday,
+ local->tm_hour, local->tm_min, local->tm_sec);
+ return result;
+}
+
+
+/* set file time */
+
+int setfiletime (char *fname,time_t ftime)
+{
+#ifdef WIN32
+ static int isWinNT = -1;
+ SYSTEMTIME st;
+ FILETIME locft, modft;
+ struct tm *loctm;
+ HANDLE hFile;
+ int result;
+
+ loctm = localtime(&ftime);
+ if (loctm == NULL)
+ return -1;
+
+ st.wYear = (WORD)loctm->tm_year + 1900;
+ st.wMonth = (WORD)loctm->tm_mon + 1;
+ st.wDayOfWeek = (WORD)loctm->tm_wday;
+ st.wDay = (WORD)loctm->tm_mday;
+ st.wHour = (WORD)loctm->tm_hour;
+ st.wMinute = (WORD)loctm->tm_min;
+ st.wSecond = (WORD)loctm->tm_sec;
+ st.wMilliseconds = 0;
+ if (!SystemTimeToFileTime(&st, &locft) ||
+ !LocalFileTimeToFileTime(&locft, &modft))
+ return -1;
+
+ if (isWinNT < 0)
+ isWinNT = (GetVersion() < 0x80000000) ? 1 : 0;
+ hFile = CreateFile(fname, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
+ (isWinNT ? FILE_FLAG_BACKUP_SEMANTICS : 0),
+ NULL);
+ if (hFile == INVALID_HANDLE_VALUE)
+ return -1;
+ result = SetFileTime(hFile, NULL, NULL, &modft) ? 0 : -1;
+ CloseHandle(hFile);
+ return result;
+#else
+ struct utimbuf settime;
+
+ settime.actime = settime.modtime = ftime;
+ return utime(fname,&settime);
+#endif
+}
+
+
+/* push file attributes */
+
+void push_attr(struct attr_item **list,char *fname,int mode,time_t time)
+{
+ struct attr_item *item;
+
+ item = (struct attr_item *)malloc(sizeof(struct attr_item));
+ if (item == NULL)
+ error("Out of memory");
+ item->fname = strdup(fname);
+ item->mode = mode;
+ item->time = time;
+ item->next = *list;
+ *list = item;
+}
+
+
+/* restore file attributes */
+
+void restore_attr(struct attr_item **list)
+{
+ struct attr_item *item, *prev;
+
+ for (item = *list; item != NULL; )
+ {
+ setfiletime(item->fname,item->time);
+ chmod(item->fname,item->mode);
+ prev = item;
+ item = item->next;
+ free(prev);
+ }
+ *list = NULL;
+}
+
+
+/* match regular expression */
+
+#define ISSPECIAL(c) (((c) == '*') || ((c) == '/'))
+
+int ExprMatch (char *string,char *expr)
+{
+ while (1)
+ {
+ if (ISSPECIAL(*expr))
+ {
+ if (*expr == '/')
+ {
+ if (*string != '\\' && *string != '/')
+ return 0;
+ string ++; expr++;
+ }
+ else if (*expr == '*')
+ {
+ if (*expr ++ == 0)
+ return 1;
+ while (*++string != *expr)
+ if (*string == 0)
+ return 0;
+ }
+ }
+ else
+ {
+ if (*string != *expr)
+ return 0;
+ if (*expr++ == 0)
+ return 1;
+ string++;
+ }
+ }
+}
+
+
+/* recursive mkdir */
+/* abort on ENOENT; ignore other errors like "directory already exists" */
+/* return 1 if OK */
+/* 0 on error */
+
+int makedir (char *newdir)
+{
+ char *buffer = strdup(newdir);
+ char *p;
+ int len = strlen(buffer);
+
+ if (len <= 0) {
+ free(buffer);
+ return 0;
+ }
+ if (buffer[len-1] == '/') {
+ buffer[len-1] = '\0';
+ }
+ if (mkdir(buffer, 0755) == 0)
+ {
+ free(buffer);
+ return 1;
+ }
+
+ p = buffer+1;
+ while (1)
+ {
+ char hold;
+
+ while(*p && *p != '\\' && *p != '/')
+ p++;
+ hold = *p;
+ *p = 0;
+ if ((mkdir(buffer, 0755) == -1) && (errno == ENOENT))
+ {
+ fprintf(stderr,"%s: Couldn't create directory %s\n",prog,buffer);
+ free(buffer);
+ return 0;
+ }
+ if (hold == 0)
+ break;
+ *p++ = hold;
+ }
+ free(buffer);
+ return 1;
+}
+
+
+int matchname (int arg,int argc,char **argv,char *fname)
+{
+ if (arg == argc) /* no arguments given (untgz tgzarchive) */
+ return 1;
+
+ while (arg < argc)
+ if (ExprMatch(fname,argv[arg++]))
+ return 1;
+
+ return 0; /* ignore this for the moment being */
+}
+
+
+/* tar file list or extract */
+
+int tar (gzFile in,int action,int arg,int argc,char **argv)
+{
+ union tar_buffer buffer;
+ int len;
+ int err;
+ int getheader = 1;
+ int remaining = 0;
+ FILE *outfile = NULL;
+ char fname[BLOCKSIZE];
+ int tarmode;
+ time_t tartime;
+ struct attr_item *attributes = NULL;
+
+ if (action == TGZ_LIST)
+ printf(" date time size file\n"
+ " ---------- -------- --------- -------------------------------------\n");
+ while (1)
+ {
+ len = gzread(in, &buffer, BLOCKSIZE);
+ if (len < 0)
+ error(gzerror(in, &err));
+ /*
+ * Always expect complete blocks to process
+ * the tar information.
+ */
+ if (len != BLOCKSIZE)
+ {
+ action = TGZ_INVALID; /* force error exit */
+ remaining = 0; /* force I/O cleanup */
+ }
+
+ /*
+ * If we have to get a tar header
+ */
+ if (getheader >= 1)
+ {
+ /*
+ * if we met the end of the tar
+ * or the end-of-tar block,
+ * we are done
+ */
+ if (len == 0 || buffer.header.name[0] == 0)
+ break;
+
+ tarmode = getoct(buffer.header.mode,8);
+ tartime = (time_t)getoct(buffer.header.mtime,12);
+ if (tarmode == -1 || tartime == (time_t)-1)
+ {
+ buffer.header.name[0] = 0;
+ action = TGZ_INVALID;
+ }
+
+ if (getheader == 1)
+ {
+ strncpy(fname,buffer.header.name,SHORTNAMESIZE);
+ if (fname[SHORTNAMESIZE-1] != 0)
+ fname[SHORTNAMESIZE] = 0;
+ }
+ else
+ {
+ /*
+ * The file name is longer than SHORTNAMESIZE
+ */
+ if (strncmp(fname,buffer.header.name,SHORTNAMESIZE-1) != 0)
+ error("bad long name");
+ getheader = 1;
+ }
+
+ /*
+ * Act according to the type flag
+ */
+ switch (buffer.header.typeflag)
+ {
+ case DIRTYPE:
+ if (action == TGZ_LIST)
+ printf(" %s <dir> %s\n",strtime(&tartime),fname);
+ if (action == TGZ_EXTRACT)
+ {
+ makedir(fname);
+ push_attr(&attributes,fname,tarmode,tartime);
+ }
+ break;
+ case REGTYPE:
+ case AREGTYPE:
+ remaining = getoct(buffer.header.size,12);
+ if (remaining == -1)
+ {
+ action = TGZ_INVALID;
+ break;
+ }
+ if (action == TGZ_LIST)
+ printf(" %s %9d %s\n",strtime(&tartime),remaining,fname);
+ else if (action == TGZ_EXTRACT)
+ {
+ if (matchname(arg,argc,argv,fname))
+ {
+ outfile = fopen(fname,"wb");
+ if (outfile == NULL) {
+ /* try creating directory */
+ char *p = strrchr(fname, '/');
+ if (p != NULL) {
+ *p = '\0';
+ makedir(fname);
+ *p = '/';
+ outfile = fopen(fname,"wb");
+ }
+ }
+ if (outfile != NULL)
+ printf("Extracting %s\n",fname);
+ else
+ fprintf(stderr, "%s: Couldn't create %s",prog,fname);
+ }
+ else
+ outfile = NULL;
+ }
+ getheader = 0;
+ break;
+ case GNUTYPE_LONGLINK:
+ case GNUTYPE_LONGNAME:
+ remaining = getoct(buffer.header.size,12);
+ if (remaining < 0 || remaining >= BLOCKSIZE)
+ {
+ action = TGZ_INVALID;
+ break;
+ }
+ len = gzread(in, fname, BLOCKSIZE);
+ if (len < 0)
+ error(gzerror(in, &err));
+ if (fname[BLOCKSIZE-1] != 0 || (int)strlen(fname) > remaining)
+ {
+ action = TGZ_INVALID;
+ break;
+ }
+ getheader = 2;
+ break;
+ default:
+ if (action == TGZ_LIST)
+ printf(" %s <---> %s\n",strtime(&tartime),fname);
+ break;
+ }
+ }
+ else
+ {
+ unsigned int bytes = (remaining > BLOCKSIZE) ? BLOCKSIZE : remaining;
+
+ if (outfile != NULL)
+ {
+ if (fwrite(&buffer,sizeof(char),bytes,outfile) != bytes)
+ {
+ fprintf(stderr,
+ "%s: Error writing %s -- skipping\n",prog,fname);
+ fclose(outfile);
+ outfile = NULL;
+ remove(fname);
+ }
+ }
+ remaining -= bytes;
+ }
+
+ if (remaining == 0)
+ {
+ getheader = 1;
+ if (outfile != NULL)
+ {
+ fclose(outfile);
+ outfile = NULL;
+ if (action != TGZ_INVALID)
+ push_attr(&attributes,fname,tarmode,tartime);
+ }
+ }
+
+ /*
+ * Abandon if errors are found
+ */
+ if (action == TGZ_INVALID)
+ {
+ error("broken archive");
+ break;
+ }
+ }
+
+ /*
+ * Restore file modes and time stamps
+ */
+ restore_attr(&attributes);
+
+ if (gzclose(in) != Z_OK)
+ error("failed gzclose");
+
+ return 0;
+}
+
+
+/* ============================================================ */
+
+void help(int exitval)
+{
+ printf("untgz version 0.2.1\n"
+ " using zlib version %s\n\n",
+ zlibVersion());
+ printf("Usage: untgz file.tgz extract all files\n"
+ " untgz file.tgz fname ... extract selected files\n"
+ " untgz -l file.tgz list archive contents\n"
+ " untgz -h display this help\n");
+ exit(exitval);
+}
+
+void error(const char *msg)
+{
+ fprintf(stderr, "%s: %s\n", prog, msg);
+ exit(1);
+}
+
+
+/* ============================================================ */
+
+#if defined(WIN32) && defined(__GNUC__)
+int _CRT_glob = 0; /* disable argument globbing in MinGW */
+#endif
+
+int main(int argc,char **argv)
+{
+ int action = TGZ_EXTRACT;
+ int arg = 1;
+ char *TGZfile;
+ gzFile *f;
+
+ prog = strrchr(argv[0],'\\');
+ if (prog == NULL)
+ {
+ prog = strrchr(argv[0],'/');
+ if (prog == NULL)
+ {
+ prog = strrchr(argv[0],':');
+ if (prog == NULL)
+ prog = argv[0];
+ else
+ prog++;
+ }
+ else
+ prog++;
+ }
+ else
+ prog++;
+
+ if (argc == 1)
+ help(0);
+
+ if (strcmp(argv[arg],"-l") == 0)
+ {
+ action = TGZ_LIST;
+ if (argc == ++arg)
+ help(0);
+ }
+ else if (strcmp(argv[arg],"-h") == 0)
+ {
+ help(0);
+ }
+
+ if ((TGZfile = TGZfname(argv[arg])) == NULL)
+ TGZnotfound(argv[arg]);
+
+ ++arg;
+ if ((action == TGZ_LIST) && (arg != argc))
+ help(1);
+
+/*
+ * Process the TGZ file
+ */
+ switch(action)
+ {
+ case TGZ_LIST:
+ case TGZ_EXTRACT:
+ f = gzopen(TGZfile,"rb");
+ if (f == NULL)
+ {
+ fprintf(stderr,"%s: Couldn't gzopen %s\n",prog,TGZfile);
+ return 1;
+ }
+ exit(tar(f, action, arg, argc, argv));
+ break;
+
+ default:
+ error("Unknown option");
+ exit(1);
+ }
+
+ return 0;
+}
diff --git a/compat/zlib/contrib/vstudio/readme.txt b/compat/zlib/contrib/vstudio/readme.txt
new file mode 100644
index 0000000..bfdcd9d
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/readme.txt
@@ -0,0 +1,65 @@
+Building instructions for the DLL versions of Zlib 1.2.8
+========================================================
+
+This directory contains projects that build zlib and minizip using
+Microsoft Visual C++ 9.0/10.0.
+
+You don't need to build these projects yourself. You can download the
+binaries from:
+ http://www.winimage.com/zLibDll
+
+More information can be found at this site.
+
+
+
+
+
+Build instructions for Visual Studio 2008 (32 bits or 64 bits)
+--------------------------------------------------------------
+- Uncompress current zlib, including all contrib/* files
+- 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
+
+Build instructions for Visual Studio 2012 (32 bits or 64 bits)
+--------------------------------------------------------------
+- Uncompress current zlib, including all contrib/* files
+- Open contrib\vstudio\vc11\zlibvc.sln with Microsoft Visual C++ 2012
+
+
+Important
+---------
+- To use zlibwapi.dll in your application, you must define the
+ macro ZLIB_WINAPI when compiling your application's source files.
+
+
+Additional notes
+----------------
+- This DLL, named zlibwapi.dll, is compatible to the old zlib.dll built
+ by Gilles Vollant from the zlib 1.1.x sources, and distributed at
+ http://www.winimage.com/zLibDll
+ It uses the WINAPI calling convention for the exported functions, and
+ includes the minizip functionality. If your application needs that
+ particular build of zlib.dll, you can rename zlibwapi.dll to zlib.dll.
+
+- The new DLL was renamed because there exist several incompatible
+ versions of zlib.dll on the Internet.
+
+- There is also an official DLL build of zlib, named zlib1.dll. This one
+ is exporting the functions using the CDECL convention. See the file
+ win32\DLL_FAQ.txt found in this zlib distribution.
+
+- There used to be a ZLIB_DLL macro in zlib 1.1.x, but now this symbol
+ has a slightly different effect. To avoid compatibility problems, do
+ not define it here.
+
+
+Gilles Vollant
+info@winimage.com
diff --git a/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj b/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj
new file mode 100644
index 0000000..74e15c9
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj
@@ -0,0 +1,310 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\miniunz.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters
new file mode 100644
index 0000000..0b2a3de
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters
@@ -0,0 +1,22 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{048af943-022b-4db6-beeb-a54c34774ee2}</UniqueIdentifier>
+ <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
+ </Filter>
+ <Filter Include="Header Files">
+ <UniqueIdentifier>{c1d600d2-888f-4aea-b73e-8b0dd9befa0c}</UniqueIdentifier>
+ <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
+ </Filter>
+ <Filter Include="Resource Files">
+ <UniqueIdentifier>{0844199a-966b-4f19-81db-1e0125e141b9}</UniqueIdentifier>
+ <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\miniunz.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj b/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj
new file mode 100644
index 0000000..917e156
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj
@@ -0,0 +1,307 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\minizip.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters
new file mode 100644
index 0000000..dd73cd3
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters
@@ -0,0 +1,22 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{c0419b40-bf50-40da-b153-ff74215b79de}</UniqueIdentifier>
+ <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
+ </Filter>
+ <Filter Include="Header Files">
+ <UniqueIdentifier>{bb87b070-735b-478e-92ce-7383abb2f36c}</UniqueIdentifier>
+ <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
+ </Filter>
+ <Filter Include="Resource Files">
+ <UniqueIdentifier>{f46ab6a6-548f-43cb-ae96-681abb5bd5db}</UniqueIdentifier>
+ <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\minizip.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj b/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj
new file mode 100644
index 0000000..9088d17
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj
@@ -0,0 +1,420 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <RootNamespace>testzlib</RootNamespace>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters
new file mode 100644
index 0000000..249daa8
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters
@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{c1f6a2e3-5da5-4955-8653-310d3efe05a9}</UniqueIdentifier>
+ <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
+ </Filter>
+ <Filter Include="Header Files">
+ <UniqueIdentifier>{c2aaffdc-2c95-4d6f-8466-4bec5890af2c}</UniqueIdentifier>
+ <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
+ </Filter>
+ <Filter Include="Resource Files">
+ <UniqueIdentifier>{c274fe07-05f2-461c-964b-f6341e4e7eb5}</UniqueIdentifier>
+ <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\compress.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\crc32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\deflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\infback.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inftrees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\testzlib\testzlib.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\trees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\uncompr.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj
new file mode 100644
index 0000000..bcb08ff
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj
@@ -0,0 +1,310 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters
new file mode 100644
index 0000000..53a8693
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters
@@ -0,0 +1,22 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{fa61a89f-93fc-4c89-b29e-36224b7592f4}</UniqueIdentifier>
+ <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
+ </Filter>
+ <Filter Include="Header Files">
+ <UniqueIdentifier>{d4b85da0-2ba2-4934-b57f-e2584e3848ee}</UniqueIdentifier>
+ <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
+ </Filter>
+ <Filter Include="Resource Files">
+ <UniqueIdentifier>{e573e075-00bd-4a7d-bd67-a8cc9bfc5aca}</UniqueIdentifier>
+ <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\testzlib\testzlib.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/zlib.rc b/compat/zlib/contrib/vstudio/vc10/zlib.rc
new file mode 100644
index 0000000..73f6476
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlib.rc
@@ -0,0 +1,32 @@
+#include <windows.h>
+
+#define IDR_VERSION1 1
+IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,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 and ZIP file I/O library\0"
+ VALUE "FileVersion", "1.2.8\0"
+ VALUE "InternalName", "zlib\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
+ VALUE "ProductName", "ZLib.DLL\0"
+ VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0409, 1252
+ END
+END
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj
new file mode 100644
index 0000000..b9f2bbe
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj
@@ -0,0 +1,473 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c" />
+ <ClCompile Include="..\..\minizip\zip.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters
new file mode 100644
index 0000000..c8c7f7e
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters
@@ -0,0 +1,77 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{174213f6-7f66-4ae8-a3a8-a1e0a1e6ffdd}</UniqueIdentifier>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\compress.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\crc32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\deflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzclose.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzlib.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzread.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzwrite.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\infback.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inftrees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\ioapi.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\trees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\uncompr.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\unzip.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\zip.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc">
+ <Filter>Source Files</Filter>
+ </ResourceCompile>
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def">
+ <Filter>Source Files</Filter>
+ </None>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.def b/compat/zlib/contrib/vstudio/vc10/zlibvc.def
new file mode 100644
index 0000000..6367046
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.def
@@ -0,0 +1,143 @@
+LIBRARY
+; zlib data compression and ZIP file I/O library
+
+VERSION 1.2.8
+
+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
+ deflatePending @52
+
+ 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
+
+; zlibwapi v1.2.4 added:
+ fill_win32_filefunc64 @111
+ fill_win32_filefunc64A @112
+ fill_win32_filefunc64W @113
+
+ unzOpen64 @120
+ unzOpen2_64 @121
+ unzGetGlobalInfo64 @122
+ unzGetCurrentFileInfo64 @124
+ unzGetCurrentFileZStreamPos64 @125
+ unztell64 @126
+ unzGetFilePos64 @127
+ unzGoToFilePos64 @128
+
+ zipOpen64 @130
+ zipOpen2_64 @131
+ zipOpenNewFileInZip64 @132
+ zipOpenNewFileInZip2_64 @133
+ zipOpenNewFileInZip3_64 @134
+ zipOpenNewFileInZip4_64 @135
+ zipCloseFileInZipRaw64 @136
+
+; zlib1 v1.2.4 added:
+ adler32_combine @140
+ crc32_combine @142
+ deflateSetHeader @144
+ deflateTune @145
+ gzbuffer @146
+ gzclose_r @147
+ gzclose_w @148
+ gzdirect @149
+ gzoffset @150
+ inflateGetHeader @156
+ inflateMark @157
+ 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
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.sln b/compat/zlib/contrib/vstudio/vc10/zlibvc.sln
new file mode 100644
index 0000000..6f6ffd5
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.sln
@@ -0,0 +1,135 @@
+
+Microsoft Visual Studio Solution File, Format Version 11.00
+# Visual Studio 2010
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Itanium = Debug|Itanium
+ Debug|Win32 = Debug|Win32
+ Debug|x64 = Debug|x64
+ Release|Itanium = Release|Itanium
+ Release|Win32 = Release|Win32
+ Release|x64 = Release|x64
+ ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
+ ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
+ ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|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 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|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|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {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|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {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|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj
new file mode 100644
index 0000000..6ff9ddb
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj
@@ -0,0 +1,657 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <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'">zlibwapid</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapid</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>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <SubSystem>Windows</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\minizip\iowin32.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\zip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <ItemGroup>
+ <ClInclude Include="..\..\..\deflate.h" />
+ <ClInclude Include="..\..\..\infblock.h" />
+ <ClInclude Include="..\..\..\infcodes.h" />
+ <ClInclude Include="..\..\..\inffast.h" />
+ <ClInclude Include="..\..\..\inftrees.h" />
+ <ClInclude Include="..\..\..\infutil.h" />
+ <ClInclude Include="..\..\..\zconf.h" />
+ <ClInclude Include="..\..\..\zlib.h" />
+ <ClInclude Include="..\..\..\zutil.h" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters
new file mode 100644
index 0000000..180b71c
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters
@@ -0,0 +1,118 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup>
+ <Filter Include="Source Files">
+ <UniqueIdentifier>{07934a85-8b61-443d-a0ee-b2eedb74f3cd}</UniqueIdentifier>
+ <Extensions>cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90</Extensions>
+ </Filter>
+ <Filter Include="Header Files">
+ <UniqueIdentifier>{1d99675b-433d-4a21-9e50-ed4ab8b19762}</UniqueIdentifier>
+ <Extensions>h;hpp;hxx;hm;inl;fi;fd</Extensions>
+ </Filter>
+ <Filter Include="Resource Files">
+ <UniqueIdentifier>{431c0958-fa71-44d0-9084-2d19d100c0cc}</UniqueIdentifier>
+ <Extensions>ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe</Extensions>
+ </Filter>
+ </ItemGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\compress.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\crc32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\deflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzclose.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzlib.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzread.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\gzwrite.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\infback.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inflate.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inftrees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\ioapi.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\iowin32.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\trees.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\uncompr.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\unzip.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\zip.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c">
+ <Filter>Source Files</Filter>
+ </ClCompile>
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc">
+ <Filter>Source Files</Filter>
+ </ResourceCompile>
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def">
+ <Filter>Source Files</Filter>
+ </None>
+ </ItemGroup>
+ <ItemGroup>
+ <ClInclude Include="..\..\..\deflate.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\infblock.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\infcodes.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\inffast.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\inftrees.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\infutil.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\zconf.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\zlib.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ <ClInclude Include="..\..\..\zutil.h">
+ <Filter>Header Files</Filter>
+ </ClInclude>
+ </ItemGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj b/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj
new file mode 100644
index 0000000..8f9f20b
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj
@@ -0,0 +1,314 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\miniunz.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj b/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj
new file mode 100644
index 0000000..c93d9e6
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj
@@ -0,0 +1,311 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\minizip.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj b/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj
new file mode 100644
index 0000000..6d55954
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj
@@ -0,0 +1,426 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <RootNamespace>testzlib</RootNamespace>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj b/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj
new file mode 100644
index 0000000..9f20c78
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj
@@ -0,0 +1,314 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/zlib.rc b/compat/zlib/contrib/vstudio/vc11/zlib.rc
new file mode 100644
index 0000000..73f6476
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/zlib.rc
@@ -0,0 +1,32 @@
+#include <windows.h>
+
+#define IDR_VERSION1 1
+IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,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 and ZIP file I/O library\0"
+ VALUE "FileVersion", "1.2.8\0"
+ VALUE "InternalName", "zlib\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
+ VALUE "ProductName", "ZLib.DLL\0"
+ VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0409, 1252
+ END
+END
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj b/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj
new file mode 100644
index 0000000..806b76a
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj
@@ -0,0 +1,464 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ <CharacterSet>Unicode</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c" />
+ <ClCompile Include="..\..\minizip\zip.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.def b/compat/zlib/contrib/vstudio/vc11/zlibvc.def
new file mode 100644
index 0000000..6367046
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.def
@@ -0,0 +1,143 @@
+LIBRARY
+; zlib data compression and ZIP file I/O library
+
+VERSION 1.2.8
+
+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
+ deflatePending @52
+
+ 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
+
+; zlibwapi v1.2.4 added:
+ fill_win32_filefunc64 @111
+ fill_win32_filefunc64A @112
+ fill_win32_filefunc64W @113
+
+ unzOpen64 @120
+ unzOpen2_64 @121
+ unzGetGlobalInfo64 @122
+ unzGetCurrentFileInfo64 @124
+ unzGetCurrentFileZStreamPos64 @125
+ unztell64 @126
+ unzGetFilePos64 @127
+ unzGoToFilePos64 @128
+
+ zipOpen64 @130
+ zipOpen2_64 @131
+ zipOpenNewFileInZip64 @132
+ zipOpenNewFileInZip2_64 @133
+ zipOpenNewFileInZip3_64 @134
+ zipOpenNewFileInZip4_64 @135
+ zipCloseFileInZipRaw64 @136
+
+; zlib1 v1.2.4 added:
+ adler32_combine @140
+ crc32_combine @142
+ deflateSetHeader @144
+ deflateTune @145
+ gzbuffer @146
+ gzclose_r @147
+ gzclose_w @148
+ gzdirect @149
+ gzoffset @150
+ inflateGetHeader @156
+ inflateMark @157
+ 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
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.sln b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln
new file mode 100644
index 0000000..9fcbafd
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln
@@ -0,0 +1,117 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2012
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Itanium = Debug|Itanium
+ Debug|Win32 = Debug|Win32
+ Debug|x64 = Debug|x64
+ Release|Itanium = Release|Itanium
+ Release|Win32 = Release|Win32
+ Release|x64 = Release|x64
+ ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
+ ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
+ ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj b/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj
new file mode 100644
index 0000000..c65b95f
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj
@@ -0,0 +1,688 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ <CharacterSet>Unicode</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <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>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <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>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <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>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\minizip\iowin32.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\zip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <ItemGroup>
+ <ClInclude Include="..\..\..\deflate.h" />
+ <ClInclude Include="..\..\..\infblock.h" />
+ <ClInclude Include="..\..\..\infcodes.h" />
+ <ClInclude Include="..\..\..\inffast.h" />
+ <ClInclude Include="..\..\..\inftrees.h" />
+ <ClInclude Include="..\..\..\infutil.h" />
+ <ClInclude Include="..\..\..\zconf.h" />
+ <ClInclude Include="..\..\..\zlib.h" />
+ <ClInclude Include="..\..\..\zutil.h" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project> \ No newline at end of file
diff --git a/compat/zlib/contrib/vstudio/vc9/miniunz.vcproj b/compat/zlib/contrib/vstudio/vc9/miniunz.vcproj
new file mode 100644
index 0000000..7da32b9
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/miniunz.vcproj
@@ -0,0 +1,565 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9.00"
+ Name="miniunz"
+ ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+ Keyword="Win32Proj"
+ TargetFrameworkVersion="131072"
+ >
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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|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/vc9/minizip.vcproj b/compat/zlib/contrib/vstudio/vc9/minizip.vcproj
new file mode 100644
index 0000000..e57e07d
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/minizip.vcproj
@@ -0,0 +1,562 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9.00"
+ Name="minizip"
+ ProjectGUID="{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+ Keyword="Win32Proj"
+ TargetFrameworkVersion="131072"
+ >
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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|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/vc9/testzlib.vcproj b/compat/zlib/contrib/vstudio/vc9/testzlib.vcproj
new file mode 100644
index 0000000..9cb0bf8
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/testzlib.vcproj
@@ -0,0 +1,852 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9,00"
+ Name="testzlib"
+ ProjectGUID="{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+ RootNamespace="testzlib"
+ Keyword="Win32Proj"
+ TargetFrameworkVersion="131072"
+ >
+ <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;_CRT_NONSTDC_NO_WARNINGS"
+ 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\match686.obj ..\..\masmx86\inffas32.obj"
+ OutputFile="$(OutDir)/testzlib.exe"
+ LinkIncremental="2"
+ GenerateManifest="false"
+ GenerateDebugInformation="true"
+ ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
+ SubSystem="1"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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;_CRT_NONSTDC_NO_WARNINGS"
+ 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="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;_CRT_NONSTDC_NO_WARNINGS;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="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;_CRT_NONSTDC_NO_WARNINGS"
+ 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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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;_CRT_NONSTDC_NO_WARNINGS"
+ 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="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;_CRT_NONSTDC_NO_WARNINGS;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="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;_CRT_NONSTDC_NO_WARNINGS"
+ 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\match686.obj ..\..\masmx86\inffas32.obj"
+ OutputFile="$(OutDir)/testzlib.exe"
+ LinkIncremental="1"
+ GenerateManifest="false"
+ GenerateDebugInformation="true"
+ SubSystem="1"
+ OptimizeReferences="2"
+ EnableCOMDATFolding="2"
+ OptimizeForWindows98="1"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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;_CRT_NONSTDC_NO_WARNINGS"
+ BasicRuntimeChecks="0"
+ RuntimeLibrary="0"
+ 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="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;_CRT_NONSTDC_NO_WARNINGS;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="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="..\..\..\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/vc9/testzlibdll.vcproj b/compat/zlib/contrib/vstudio/vc9/testzlibdll.vcproj
new file mode 100644
index 0000000..b1ddde0
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/testzlibdll.vcproj
@@ -0,0 +1,565 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9.00"
+ Name="TestZlibDll"
+ ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+ Keyword="Win32Proj"
+ TargetFrameworkVersion="131072"
+ >
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ TargetMachine="1"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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|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/vc9/zlib.rc b/compat/zlib/contrib/vstudio/vc9/zlib.rc
new file mode 100644
index 0000000..73f6476
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/zlib.rc
@@ -0,0 +1,32 @@
+#include <windows.h>
+
+#define IDR_VERSION1 1
+IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,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 and ZIP file I/O library\0"
+ VALUE "FileVersion", "1.2.8\0"
+ VALUE "InternalName", "zlib\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
+ VALUE "ProductName", "ZLib.DLL\0"
+ VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0409, 1252
+ END
+END
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj b/compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj
new file mode 100644
index 0000000..61c76c7
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj
@@ -0,0 +1,835 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9,00"
+ Name="zlibstat"
+ ProjectGUID="{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+ TargetFrameworkVersion="131072"
+ >
+ <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;_CRT_NONSTDC_NO_WARNINGS"
+ 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;_CRT_NONSTDC_NO_WARNINGS;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;_CRT_NONSTDC_NO_WARNINGS;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;_CRT_NONSTDC_NO_WARNINGS;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\match686.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;_CRT_NONSTDC_NO_WARNINGS;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;_CRT_NONSTDC_NO_WARNINGS;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;_CRT_NONSTDC_NO_WARNINGS"
+ 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;_CRT_NONSTDC_NO_WARNINGS;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;_CRT_NONSTDC_NO_WARNINGS;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="..\..\..\gzclose.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzguts.h"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzlib.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzread.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzwrite.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/vc9/zlibvc.def b/compat/zlib/contrib/vstudio/vc9/zlibvc.def
new file mode 100644
index 0000000..6367046
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.def
@@ -0,0 +1,143 @@
+LIBRARY
+; zlib data compression and ZIP file I/O library
+
+VERSION 1.2.8
+
+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
+ deflatePending @52
+
+ 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
+
+; zlibwapi v1.2.4 added:
+ fill_win32_filefunc64 @111
+ fill_win32_filefunc64A @112
+ fill_win32_filefunc64W @113
+
+ unzOpen64 @120
+ unzOpen2_64 @121
+ unzGetGlobalInfo64 @122
+ unzGetCurrentFileInfo64 @124
+ unzGetCurrentFileZStreamPos64 @125
+ unztell64 @126
+ unzGetFilePos64 @127
+ unzGoToFilePos64 @128
+
+ zipOpen64 @130
+ zipOpen2_64 @131
+ zipOpenNewFileInZip64 @132
+ zipOpenNewFileInZip2_64 @133
+ zipOpenNewFileInZip3_64 @134
+ zipOpenNewFileInZip4_64 @135
+ zipCloseFileInZipRaw64 @136
+
+; zlib1 v1.2.4 added:
+ adler32_combine @140
+ crc32_combine @142
+ deflateSetHeader @144
+ deflateTune @145
+ gzbuffer @146
+ gzclose_r @147
+ gzclose_w @148
+ gzdirect @149
+ gzoffset @150
+ inflateGetHeader @156
+ inflateMark @157
+ 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
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibvc.sln b/compat/zlib/contrib/vstudio/vc9/zlibvc.sln
new file mode 100644
index 0000000..b482967
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.sln
@@ -0,0 +1,144 @@
+
+Microsoft Visual Studio Solution File, Format Version 10.00
+# Visual Studio 2008
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+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 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|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|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {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|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {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|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj b/compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj
new file mode 100644
index 0000000..c9a8947
--- /dev/null
+++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj
@@ -0,0 +1,1156 @@
+<?xml version="1.0" encoding="Windows-1252"?>
+<VisualStudioProject
+ ProjectType="Visual C++"
+ Version="9,00"
+ Name="zlibvc"
+ ProjectGUID="{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+ RootNamespace="zlibvc"
+ TargetFrameworkVersion="131072"
+ >
+ <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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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\match686.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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ ImportLibrary="$(OutDir)/zlibwapi.lib"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ ImportLibrary="$(OutDir)/zlibwapi.lib"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF"
+ StringPooling="true"
+ ExceptionHandling="0"
+ RuntimeLibrary="0"
+ 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\match686.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"
+ RandomizedBaseAddress="1"
+ DataExecutionPrevention="0"
+ ImportLibrary="$(OutDir)/zlibwapi.lib"
+ />
+ <Tool
+ Name="VCALinkTool"
+ />
+ <Tool
+ Name="VCManifestTool"
+ />
+ <Tool
+ Name="VCXDCMakeTool"
+ />
+ <Tool
+ Name="VCBscMakeTool"
+ />
+ <Tool
+ Name="VCFxCopTool"
+ />
+ <Tool
+ Name="VCAppVerifierTool"
+ />
+ <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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;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="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="..\..\..\gzclose.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzguts.h"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzlib.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzread.c"
+ >
+ </File>
+ <File
+ RelativePath="..\..\..\gzwrite.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/crc32.c b/compat/zlib/crc32.c
new file mode 100644
index 0000000..979a719
--- /dev/null
+++ b/compat/zlib/crc32.c
@@ -0,0 +1,425 @@
+/* crc32.c -- compute the CRC-32 of a data stream
+ * 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
+ * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing
+ * tables for updating the shift register in one step with three exclusive-ors
+ * instead of four steps with four exclusive-ors. This results in about a
+ * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3.
+ */
+
+/* @(#) $Id$ */
+
+/*
+ Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore
+ protection on the static variables used to control the first-use generation
+ 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
+# include <stdio.h>
+# ifndef DYNAMIC_CRC_TABLE
+# define DYNAMIC_CRC_TABLE
+# endif /* !DYNAMIC_CRC_TABLE */
+#endif /* MAKECRCH */
+
+#include "zutil.h" /* for STDC and FAR definitions */
+
+#define local static
+
+/* Definitions for doing the crc four data bytes at a time. */
+#if !defined(NOBYFOUR) && defined(Z_U4)
+# define BYFOUR
+#endif
+#ifdef BYFOUR
+ local unsigned long crc32_little OF((unsigned long,
+ const unsigned char FAR *, unsigned));
+ local unsigned long crc32_big OF((unsigned long,
+ const unsigned char FAR *, unsigned));
+# define TBLS 8
+#else
+# define TBLS 1
+#endif /* BYFOUR */
+
+/* Local functions for crc concatenation */
+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_ OF((uLong crc1, uLong crc2, z_off64_t len2));
+
+
+#ifdef DYNAMIC_CRC_TABLE
+
+local volatile int crc_table_empty = 1;
+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 z_crc_t FAR *));
+#endif /* MAKECRCH */
+/*
+ Generate tables for a byte-wise 32-bit CRC calculation on the polynomial:
+ x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.
+
+ Polynomials over GF(2) are represented in binary, one bit per coefficient,
+ with the lowest powers in the most significant bit. Then adding polynomials
+ is just exclusive-or, and multiplying a polynomial by x is a right shift by
+ one. If we call the above polynomial p, and represent a byte as the
+ polynomial q, also with the lowest power in the most significant bit (so the
+ byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
+ where a mod b means the remainder after dividing a by b.
+
+ This calculation is done using the shift-register method of multiplying and
+ taking the remainder. The register is initialized to zero, and for each
+ incoming bit, x^32 is added mod p to the register if the bit is a one (where
+ x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
+ x (which is shifting right by one and adding x^32 mod p if the bit shifted
+ out is a one). We start with the highest power (least significant bit) of
+ q and repeat for all eight bits of q.
+
+ The first table is simply the CRC of all possible eight bit values. This is
+ all the information needed to generate CRCs on data a byte at a time for all
+ combinations of CRC register values and incoming bytes. The remaining tables
+ allow for word-at-a-time CRC calculation for both big-endian and little-
+ endian machines, where a word is four bytes.
+*/
+local void make_crc_table()
+{
+ z_crc_t c;
+ int n, k;
+ 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};
+
+ /* See if another task is already doing this (not thread-safe, but better
+ than nothing -- significantly reduces duration of vulnerability in
+ case the advice about DYNAMIC_CRC_TABLE is ignored) */
+ if (first) {
+ first = 0;
+
+ /* make exclusive-or pattern from polynomial (0xedb88320UL) */
+ 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 = (z_crc_t)n;
+ for (k = 0; k < 8; k++)
+ c = c & 1 ? poly ^ (c >> 1) : c >> 1;
+ crc_table[0][n] = c;
+ }
+
+#ifdef BYFOUR
+ /* generate crc for each value followed by one, two, and three zeros,
+ 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] = 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] = ZSWAP32(c);
+ }
+ }
+#endif /* BYFOUR */
+
+ crc_table_empty = 0;
+ }
+ else { /* not first */
+ /* wait for the other guy to finish (not efficient, but rare) */
+ while (crc_table_empty)
+ ;
+ }
+
+#ifdef MAKECRCH
+ /* write out CRC tables to crc32.h */
+ {
+ FILE *out;
+
+ out = fopen("crc32.h", "w");
+ 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 z_crc_t FAR ");
+ fprintf(out, "crc_table[TBLS][256] =\n{\n {\n");
+ write_table(out, crc_table[0]);
+# ifdef BYFOUR
+ fprintf(out, "#ifdef BYFOUR\n");
+ for (k = 1; k < 8; k++) {
+ fprintf(out, " },\n {\n");
+ write_table(out, crc_table[k]);
+ }
+ fprintf(out, "#endif\n");
+# endif /* BYFOUR */
+ fprintf(out, " }\n};\n");
+ fclose(out);
+ }
+#endif /* MAKECRCH */
+}
+
+#ifdef MAKECRCH
+local void write_table(out, table)
+ FILE *out;
+ const z_crc_t FAR *table;
+{
+ int n;
+
+ for (n = 0; n < 256; n++)
+ fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ",
+ (unsigned long)(table[n]),
+ n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", "));
+}
+#endif /* MAKECRCH */
+
+#else /* !DYNAMIC_CRC_TABLE */
+/* ========================================================================
+ * Tables of CRC-32s of all single-byte values, made by make_crc_table().
+ */
+#include "crc32.h"
+#endif /* DYNAMIC_CRC_TABLE */
+
+/* =========================================================================
+ * This function can be used by asm versions of crc32()
+ */
+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 z_crc_t FAR *)crc_table;
+}
+
+/* ========================================================================= */
+#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8)
+#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1
+
+/* ========================================================================= */
+unsigned long ZEXPORT crc32(crc, buf, len)
+ unsigned long crc;
+ const unsigned char FAR *buf;
+ uInt len;
+{
+ if (buf == Z_NULL) return 0UL;
+
+#ifdef DYNAMIC_CRC_TABLE
+ if (crc_table_empty)
+ make_crc_table();
+#endif /* DYNAMIC_CRC_TABLE */
+
+#ifdef BYFOUR
+ if (sizeof(void *) == sizeof(ptrdiff_t)) {
+ z_crc_t endian;
+
+ endian = 1;
+ if (*((unsigned char *)(&endian)))
+ return crc32_little(crc, buf, len);
+ else
+ return crc32_big(crc, buf, len);
+ }
+#endif /* BYFOUR */
+ crc = crc ^ 0xffffffffUL;
+ while (len >= 8) {
+ DO8;
+ len -= 8;
+ }
+ if (len) do {
+ DO1;
+ } while (--len);
+ return crc ^ 0xffffffffUL;
+}
+
+#ifdef BYFOUR
+
+/* ========================================================================= */
+#define DOLIT4 c ^= *buf4++; \
+ c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \
+ crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24]
+#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4
+
+/* ========================================================================= */
+local unsigned long crc32_little(crc, buf, len)
+ unsigned long crc;
+ const unsigned char FAR *buf;
+ unsigned len;
+{
+ register z_crc_t c;
+ register const z_crc_t FAR *buf4;
+
+ 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 z_crc_t FAR *)(const void FAR *)buf;
+ while (len >= 32) {
+ DOLIT32;
+ len -= 32;
+ }
+ while (len >= 4) {
+ DOLIT4;
+ len -= 4;
+ }
+ buf = (const unsigned char FAR *)buf4;
+
+ if (len) do {
+ c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
+ } while (--len);
+ c = ~c;
+ return (unsigned long)c;
+}
+
+/* ========================================================================= */
+#define DOBIG4 c ^= *++buf4; \
+ c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \
+ crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24]
+#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4
+
+/* ========================================================================= */
+local unsigned long crc32_big(crc, buf, len)
+ unsigned long crc;
+ const unsigned char FAR *buf;
+ unsigned len;
+{
+ register z_crc_t c;
+ register const z_crc_t FAR *buf4;
+
+ 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 z_crc_t FAR *)(const void FAR *)buf;
+ buf4--;
+ while (len >= 32) {
+ DOBIG32;
+ len -= 32;
+ }
+ while (len >= 4) {
+ DOBIG4;
+ len -= 4;
+ }
+ buf4++;
+ buf = (const unsigned char FAR *)buf4;
+
+ if (len) do {
+ c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
+ } while (--len);
+ c = ~c;
+ return (unsigned long)(ZSWAP32(c));
+}
+
+#endif /* BYFOUR */
+
+#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */
+
+/* ========================================================================= */
+local unsigned long gf2_matrix_times(mat, vec)
+ unsigned long *mat;
+ unsigned long vec;
+{
+ unsigned long sum;
+
+ sum = 0;
+ while (vec) {
+ if (vec & 1)
+ sum ^= *mat;
+ vec >>= 1;
+ mat++;
+ }
+ return sum;
+}
+
+/* ========================================================================= */
+local void gf2_matrix_square(square, mat)
+ unsigned long *square;
+ unsigned long *mat;
+{
+ int n;
+
+ for (n = 0; n < GF2_DIM; n++)
+ square[n] = gf2_matrix_times(mat, mat[n]);
+}
+
+/* ========================================================================= */
+local uLong crc32_combine_(crc1, crc2, len2)
+ uLong crc1;
+ uLong crc2;
+ z_off64_t len2;
+{
+ int n;
+ unsigned long row;
+ unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */
+ unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */
+
+ /* degenerate case (also disallow negative lengths) */
+ if (len2 <= 0)
+ return crc1;
+
+ /* put operator for one zero bit in odd */
+ odd[0] = 0xedb88320UL; /* CRC-32 polynomial */
+ row = 1;
+ for (n = 1; n < GF2_DIM; n++) {
+ odd[n] = row;
+ row <<= 1;
+ }
+
+ /* put operator for two zero bits in even */
+ gf2_matrix_square(even, odd);
+
+ /* put operator for four zero bits in odd */
+ gf2_matrix_square(odd, even);
+
+ /* apply len2 zeros to crc1 (first square will put the operator for one
+ zero byte, eight zero bits, in even) */
+ do {
+ /* apply zeros operator for this bit of len2 */
+ gf2_matrix_square(even, odd);
+ if (len2 & 1)
+ crc1 = gf2_matrix_times(even, crc1);
+ len2 >>= 1;
+
+ /* if no more bits set, then done */
+ if (len2 == 0)
+ break;
+
+ /* another iteration of the loop with odd and even swapped */
+ gf2_matrix_square(odd, even);
+ if (len2 & 1)
+ crc1 = gf2_matrix_times(odd, crc1);
+ len2 >>= 1;
+
+ /* if no more bits set, then done */
+ } while (len2 != 0);
+
+ /* return combined crc */
+ crc1 ^= crc2;
+ return crc1;
+}
+
+/* ========================================================================= */
+uLong ZEXPORT crc32_combine(crc1, crc2, len2)
+ uLong crc1;
+ uLong crc2;
+ z_off_t len2;
+{
+ return crc32_combine_(crc1, crc2, len2);
+}
+
+uLong ZEXPORT crc32_combine64(crc1, crc2, len2)
+ uLong crc1;
+ uLong crc2;
+ z_off64_t len2;
+{
+ return crc32_combine_(crc1, crc2, len2);
+}
diff --git a/compat/zlib/crc32.h b/compat/zlib/crc32.h
new file mode 100644
index 0000000..9e0c778
--- /dev/null
+++ b/compat/zlib/crc32.h
@@ -0,0 +1,441 @@
+/* crc32.h -- tables for rapid CRC calculation
+ * Generated automatically by crc32.c
+ */
+
+local const z_crc_t FAR crc_table[TBLS][256] =
+{
+ {
+ 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL,
+ 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL,
+ 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL,
+ 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL,
+ 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL,
+ 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL,
+ 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL,
+ 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL,
+ 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL,
+ 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL,
+ 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL,
+ 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL,
+ 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL,
+ 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL,
+ 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL,
+ 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL,
+ 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL,
+ 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL,
+ 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL,
+ 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL,
+ 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL,
+ 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL,
+ 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL,
+ 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL,
+ 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL,
+ 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL,
+ 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL,
+ 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL,
+ 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL,
+ 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL,
+ 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL,
+ 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL,
+ 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL,
+ 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL,
+ 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL,
+ 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL,
+ 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL,
+ 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL,
+ 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL,
+ 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL,
+ 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL,
+ 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL,
+ 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL,
+ 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL,
+ 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL,
+ 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL,
+ 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL,
+ 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL,
+ 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL,
+ 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL,
+ 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL,
+ 0x2d02ef8dUL
+#ifdef BYFOUR
+ },
+ {
+ 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL,
+ 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL,
+ 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL,
+ 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL,
+ 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL,
+ 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL,
+ 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL,
+ 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL,
+ 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL,
+ 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL,
+ 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL,
+ 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL,
+ 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL,
+ 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL,
+ 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL,
+ 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL,
+ 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL,
+ 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL,
+ 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL,
+ 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL,
+ 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL,
+ 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL,
+ 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL,
+ 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL,
+ 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL,
+ 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL,
+ 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL,
+ 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL,
+ 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL,
+ 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL,
+ 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL,
+ 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL,
+ 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL,
+ 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL,
+ 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL,
+ 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL,
+ 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL,
+ 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL,
+ 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL,
+ 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL,
+ 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL,
+ 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL,
+ 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL,
+ 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL,
+ 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL,
+ 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL,
+ 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL,
+ 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL,
+ 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL,
+ 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL,
+ 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL,
+ 0x9324fd72UL
+ },
+ {
+ 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL,
+ 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL,
+ 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL,
+ 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL,
+ 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL,
+ 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL,
+ 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL,
+ 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL,
+ 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL,
+ 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL,
+ 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL,
+ 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL,
+ 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL,
+ 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL,
+ 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL,
+ 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL,
+ 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL,
+ 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL,
+ 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL,
+ 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL,
+ 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL,
+ 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL,
+ 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL,
+ 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL,
+ 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL,
+ 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL,
+ 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL,
+ 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL,
+ 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL,
+ 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL,
+ 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL,
+ 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL,
+ 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL,
+ 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL,
+ 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL,
+ 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL,
+ 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL,
+ 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL,
+ 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL,
+ 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL,
+ 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL,
+ 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL,
+ 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL,
+ 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL,
+ 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL,
+ 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL,
+ 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL,
+ 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL,
+ 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL,
+ 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL,
+ 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL,
+ 0xbe9834edUL
+ },
+ {
+ 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL,
+ 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL,
+ 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL,
+ 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL,
+ 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL,
+ 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL,
+ 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL,
+ 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL,
+ 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL,
+ 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL,
+ 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL,
+ 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL,
+ 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL,
+ 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL,
+ 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL,
+ 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL,
+ 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL,
+ 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL,
+ 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL,
+ 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL,
+ 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL,
+ 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL,
+ 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL,
+ 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL,
+ 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL,
+ 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL,
+ 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL,
+ 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL,
+ 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL,
+ 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL,
+ 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL,
+ 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL,
+ 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL,
+ 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL,
+ 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL,
+ 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL,
+ 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL,
+ 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL,
+ 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL,
+ 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL,
+ 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL,
+ 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL,
+ 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL,
+ 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL,
+ 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL,
+ 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL,
+ 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL,
+ 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL,
+ 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL,
+ 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL,
+ 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL,
+ 0xde0506f1UL
+ },
+ {
+ 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL,
+ 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL,
+ 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL,
+ 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL,
+ 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL,
+ 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL,
+ 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL,
+ 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL,
+ 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL,
+ 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL,
+ 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL,
+ 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL,
+ 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL,
+ 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL,
+ 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL,
+ 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL,
+ 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL,
+ 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL,
+ 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL,
+ 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL,
+ 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL,
+ 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL,
+ 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL,
+ 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL,
+ 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL,
+ 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL,
+ 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL,
+ 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL,
+ 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL,
+ 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL,
+ 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL,
+ 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL,
+ 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL,
+ 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL,
+ 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL,
+ 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL,
+ 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL,
+ 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL,
+ 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL,
+ 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL,
+ 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL,
+ 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL,
+ 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL,
+ 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL,
+ 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL,
+ 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL,
+ 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL,
+ 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL,
+ 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL,
+ 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL,
+ 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL,
+ 0x8def022dUL
+ },
+ {
+ 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL,
+ 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL,
+ 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL,
+ 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL,
+ 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL,
+ 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL,
+ 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL,
+ 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL,
+ 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL,
+ 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL,
+ 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL,
+ 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL,
+ 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL,
+ 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL,
+ 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL,
+ 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL,
+ 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL,
+ 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL,
+ 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL,
+ 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL,
+ 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL,
+ 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL,
+ 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL,
+ 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL,
+ 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL,
+ 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL,
+ 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL,
+ 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL,
+ 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL,
+ 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL,
+ 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL,
+ 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL,
+ 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL,
+ 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL,
+ 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL,
+ 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL,
+ 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL,
+ 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL,
+ 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL,
+ 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL,
+ 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL,
+ 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL,
+ 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL,
+ 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL,
+ 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL,
+ 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL,
+ 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL,
+ 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL,
+ 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL,
+ 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL,
+ 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL,
+ 0x72fd2493UL
+ },
+ {
+ 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL,
+ 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL,
+ 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL,
+ 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL,
+ 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL,
+ 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL,
+ 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL,
+ 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL,
+ 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL,
+ 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL,
+ 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL,
+ 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL,
+ 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL,
+ 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL,
+ 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL,
+ 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL,
+ 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL,
+ 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL,
+ 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL,
+ 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL,
+ 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL,
+ 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL,
+ 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL,
+ 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL,
+ 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL,
+ 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL,
+ 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL,
+ 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL,
+ 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL,
+ 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL,
+ 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL,
+ 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL,
+ 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL,
+ 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL,
+ 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL,
+ 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL,
+ 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL,
+ 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL,
+ 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL,
+ 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL,
+ 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL,
+ 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL,
+ 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL,
+ 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL,
+ 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL,
+ 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL,
+ 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL,
+ 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL,
+ 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL,
+ 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL,
+ 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL,
+ 0xed3498beUL
+ },
+ {
+ 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL,
+ 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL,
+ 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL,
+ 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL,
+ 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL,
+ 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL,
+ 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL,
+ 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL,
+ 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL,
+ 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL,
+ 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL,
+ 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL,
+ 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL,
+ 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL,
+ 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL,
+ 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL,
+ 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL,
+ 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL,
+ 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL,
+ 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL,
+ 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL,
+ 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL,
+ 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL,
+ 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL,
+ 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL,
+ 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL,
+ 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL,
+ 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL,
+ 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL,
+ 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL,
+ 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL,
+ 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL,
+ 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL,
+ 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL,
+ 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL,
+ 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL,
+ 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL,
+ 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL,
+ 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL,
+ 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL,
+ 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL,
+ 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL,
+ 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL,
+ 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL,
+ 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL,
+ 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL,
+ 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL,
+ 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL,
+ 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL,
+ 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL,
+ 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL,
+ 0xf10605deUL
+#endif
+ }
+};
diff --git a/compat/zlib/deflate.c b/compat/zlib/deflate.c
new file mode 100644
index 0000000..6969577
--- /dev/null
+++ b/compat/zlib/deflate.c
@@ -0,0 +1,1967 @@
+/* deflate.c -- compress data using the deflation algorithm
+ * Copyright (C) 1995-2013 Jean-loup Gailly and Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * ALGORITHM
+ *
+ * The "deflation" process depends on being able to identify portions
+ * of the input text which are identical to earlier input (within a
+ * sliding window trailing behind the input currently being processed).
+ *
+ * The most straightforward technique turns out to be the fastest for
+ * most input files: try all possible matches and select the longest.
+ * The key feature of this algorithm is that insertions into the string
+ * dictionary are very simple and thus fast, and deletions are avoided
+ * completely. Insertions are performed at each input character, whereas
+ * string matches are performed only when the previous match ends. So it
+ * is preferable to spend more time in matches to allow very fast string
+ * insertions and avoid deletions. The matching algorithm for small
+ * strings is inspired from that of Rabin & Karp. A brute force approach
+ * is used to find longer strings when a small match has been found.
+ * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze
+ * (by Leonid Broukhis).
+ * A previous version of this file used a more sophisticated algorithm
+ * (by Fiala and Greene) which is guaranteed to run in linear amortized
+ * time, but has a larger average cost, uses more memory and is patented.
+ * However the F&G algorithm may be faster for some highly redundant
+ * files if the parameter max_chain_length (described below) is too large.
+ *
+ * ACKNOWLEDGEMENTS
+ *
+ * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and
+ * I found it in 'freeze' written by Leonid Broukhis.
+ * Thanks to many people for bug reports and testing.
+ *
+ * REFERENCES
+ *
+ * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification".
+ * 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.
+ *
+ * Fiala,E.R., and Greene,D.H.
+ * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595
+ *
+ */
+
+/* @(#) $Id$ */
+
+#include "deflate.h"
+
+const char deflate_copyright[] =
+ " deflate 1.2.8 Copyright 1995-2013 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
+ include such an acknowledgment, I would appreciate that you keep this
+ copyright string in the executable of your product.
+ */
+
+/* ===========================================================================
+ * Function prototypes.
+ */
+typedef enum {
+ need_more, /* block not completed, need more input or more output */
+ block_done, /* block flush performed */
+ finish_started, /* finish started, need only more output at next deflate */
+ finish_done /* finish done, accept no more input or output */
+} block_state;
+
+typedef block_state (*compress_func) OF((deflate_state *s, int flush));
+/* Compression function. Returns the block state after the call. */
+
+local void fill_window OF((deflate_state *s));
+local block_state deflate_stored OF((deflate_state *s, int flush));
+local block_state deflate_fast OF((deflate_state *s, int flush));
+#ifndef FASTEST
+local block_state deflate_slow OF((deflate_state *s, int flush));
+#endif
+local block_state deflate_rle OF((deflate_state *s, int flush));
+local block_state deflate_huff OF((deflate_state *s, int flush));
+local void lm_init OF((deflate_state *s));
+local void putShortMSB OF((deflate_state *s, uInt b));
+local void flush_pending OF((z_streamp strm));
+local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size));
+#ifdef ASMV
+ void match_init OF((void)); /* asm code initialization */
+ uInt longest_match OF((deflate_state *s, IPos cur_match));
+#else
+local uInt longest_match OF((deflate_state *s, IPos cur_match));
+#endif
+
+#ifdef DEBUG
+local void check_match OF((deflate_state *s, IPos start, IPos match,
+ int length));
+#endif
+
+/* ===========================================================================
+ * Local data
+ */
+
+#define NIL 0
+/* Tail of hash chains */
+
+#ifndef TOO_FAR
+# define TOO_FAR 4096
+#endif
+/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */
+
+/* Values for max_lazy_match, good_match and max_chain_length, depending on
+ * the desired pack level (0..9). The values given below have been tuned to
+ * exclude worst case performance for pathological files. Better values may be
+ * found for specific files.
+ */
+typedef struct config_s {
+ ush good_length; /* reduce lazy search above this match length */
+ ush max_lazy; /* do not perform lazy search above this match length */
+ ush nice_length; /* quit search above this match length */
+ ush max_chain;
+ compress_func func;
+} config;
+
+#ifdef FASTEST
+local const config configuration_table[2] = {
+/* good lazy nice chain */
+/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */
+/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */
+#else
+local const config configuration_table[10] = {
+/* good lazy nice chain */
+/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */
+/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */
+/* 2 */ {4, 5, 16, 8, deflate_fast},
+/* 3 */ {4, 6, 32, 32, deflate_fast},
+
+/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */
+/* 5 */ {8, 16, 32, 32, deflate_slow},
+/* 6 */ {8, 16, 128, 128, deflate_slow},
+/* 7 */ {8, 32, 128, 256, deflate_slow},
+/* 8 */ {32, 128, 258, 1024, deflate_slow},
+/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */
+#endif
+
+/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
+ * For deflate_fast() (levels <= 3) good is ignored and lazy has a different
+ * meaning.
+ */
+
+#define EQUAL 0
+/* result of memcmp for equal strings */
+
+#ifndef NO_DUMMY_DECL
+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
+ * input characters, so that a running hash key can be computed from the
+ * previous key instead of complete recalculation each time.
+ */
+#define UPDATE_HASH(s,h,c) (h = (((h)<<s->hash_shift) ^ (c)) & s->hash_mask)
+
+
+/* ===========================================================================
+ * Insert string str in the dictionary and set match_head to the previous head
+ * of the hash chain (the most recent string with same hash key). Return
+ * the previous length of the hash chain.
+ * If this file is compiled with -DFASTEST, the compression level is forced
+ * to 1, and no hash chains are maintained.
+ * IN assertion: all calls to to INSERT_STRING are made with consecutive
+ * input characters and the first MIN_MATCH bytes of str are valid
+ * (except for the last MIN_MATCH-1 bytes of the input file).
+ */
+#ifdef FASTEST
+#define INSERT_STRING(s, str, match_head) \
+ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
+ match_head = s->head[s->ins_h], \
+ s->head[s->ins_h] = (Pos)(str))
+#else
+#define INSERT_STRING(s, str, match_head) \
+ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
+ match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \
+ s->head[s->ins_h] = (Pos)(str))
+#endif
+
+/* ===========================================================================
+ * Initialize the hash table (avoiding 64K overflow for 16 bit systems).
+ * prev[] will be initialized on the fly.
+ */
+#define CLEAR_HASH(s) \
+ s->head[s->hash_size-1] = NIL; \
+ zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head));
+
+/* ========================================================================= */
+int ZEXPORT deflateInit_(strm, level, version, stream_size)
+ z_streamp strm;
+ int level;
+ const char *version;
+ int stream_size;
+{
+ return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL,
+ Z_DEFAULT_STRATEGY, version, stream_size);
+ /* To do: ignore strm->next_in if we use it as window */
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
+ version, stream_size)
+ z_streamp strm;
+ int level;
+ int method;
+ int windowBits;
+ int memLevel;
+ int strategy;
+ const char *version;
+ int stream_size;
+{
+ deflate_state *s;
+ int wrap = 1;
+ static const char my_version[] = ZLIB_VERSION;
+
+ ushf *overlay;
+ /* We overlay pending_buf and d_buf+l_buf. This works since the average
+ * output size for (length,distance) codes is <= 24 bits.
+ */
+
+ if (version == Z_NULL || version[0] != my_version[0] ||
+ stream_size != sizeof(z_stream)) {
+ return Z_VERSION_ERROR;
+ }
+ if (strm == Z_NULL) return Z_STREAM_ERROR;
+
+ 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)
+#ifdef Z_SOLO
+ return Z_STREAM_ERROR;
+#else
+ strm->zfree = zcfree;
+#endif
+
+#ifdef FASTEST
+ if (level != 0) level = 1;
+#else
+ if (level == Z_DEFAULT_COMPRESSION) level = 6;
+#endif
+
+ if (windowBits < 0) { /* suppress zlib wrapper */
+ wrap = 0;
+ windowBits = -windowBits;
+ }
+#ifdef GZIP
+ else if (windowBits > 15) {
+ wrap = 2; /* write gzip wrapper instead */
+ windowBits -= 16;
+ }
+#endif
+ if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED ||
+ windowBits < 8 || windowBits > 15 || level < 0 || level > 9 ||
+ strategy < 0 || strategy > Z_FIXED) {
+ return Z_STREAM_ERROR;
+ }
+ if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */
+ s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state));
+ if (s == Z_NULL) return Z_MEM_ERROR;
+ strm->state = (struct internal_state FAR *)s;
+ s->strm = strm;
+
+ s->wrap = wrap;
+ s->gzhead = Z_NULL;
+ s->w_bits = windowBits;
+ s->w_size = 1 << s->w_bits;
+ s->w_mask = s->w_size - 1;
+
+ s->hash_bits = memLevel + 7;
+ s->hash_size = 1 << s->hash_bits;
+ s->hash_mask = s->hash_size - 1;
+ s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH);
+
+ s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte));
+ s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos));
+ s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos));
+
+ s->high_water = 0; /* nothing written to s->window yet */
+
+ s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */
+
+ overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2);
+ s->pending_buf = (uchf *) overlay;
+ s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L);
+
+ if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL ||
+ s->pending_buf == Z_NULL) {
+ s->status = FINISH_STATE;
+ strm->msg = ERR_MSG(Z_MEM_ERROR);
+ deflateEnd (strm);
+ return Z_MEM_ERROR;
+ }
+ s->d_buf = overlay + s->lit_bufsize/sizeof(ush);
+ s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize;
+
+ s->level = level;
+ s->strategy = strategy;
+ s->method = (Byte)method;
+
+ return deflateReset(strm);
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength)
+ z_streamp strm;
+ const Bytef *dictionary;
+ uInt dictLength;
+{
+ deflate_state *s;
+ uInt str, n;
+ int wrap;
+ unsigned avail;
+ z_const unsigned char *next;
+
+ if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL)
+ return Z_STREAM_ERROR;
+ s = strm->state;
+ wrap = s->wrap;
+ if (wrap == 2 || (wrap == 1 && s->status != INIT_STATE) || s->lookahead)
+ return Z_STREAM_ERROR;
+
+ /* 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;
+ }
+
+ /* insert dictionary into window and hash */
+ avail = strm->avail_in;
+ next = strm->next_in;
+ strm->avail_in = dictLength;
+ strm->next_in = (z_const 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);
+ }
+ 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 deflateResetKeep (strm)
+ z_streamp strm;
+{
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL ||
+ strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) {
+ return Z_STREAM_ERROR;
+ }
+
+ strm->total_in = strm->total_out = 0;
+ strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */
+ strm->data_type = Z_UNKNOWN;
+
+ s = (deflate_state *)strm->state;
+ s->pending = 0;
+ s->pending_out = s->pending_buf;
+
+ if (s->wrap < 0) {
+ s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */
+ }
+ s->status = s->wrap ? INIT_STATE : BUSY_STATE;
+ strm->adler =
+#ifdef GZIP
+ s->wrap == 2 ? crc32(0L, Z_NULL, 0) :
+#endif
+ adler32(0L, Z_NULL, 0);
+ s->last_flush = Z_NO_FLUSH;
+
+ _tr_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;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ if (strm->state->wrap != 2) return Z_STREAM_ERROR;
+ strm->state->gzhead = head;
+ return Z_OK;
+}
+
+/* ========================================================================= */
+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;
+ 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;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateParams(strm, level, strategy)
+ z_streamp strm;
+ int level;
+ int strategy;
+{
+ deflate_state *s;
+ compress_func func;
+ int err = Z_OK;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ s = strm->state;
+
+#ifdef FASTEST
+ if (level != 0) level = 1;
+#else
+ if (level == Z_DEFAULT_COMPRESSION) level = 6;
+#endif
+ if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) {
+ return Z_STREAM_ERROR;
+ }
+ func = configuration_table[s->level].func;
+
+ if ((strategy != s->strategy || func != configuration_table[level].func) &&
+ strm->total_in != 0) {
+ /* Flush the last buffer: */
+ err = deflate(strm, Z_BLOCK);
+ if (err == Z_BUF_ERROR && s->pending == 0)
+ err = Z_OK;
+ }
+ if (s->level != level) {
+ s->level = level;
+ s->max_lazy_match = configuration_table[level].max_lazy;
+ s->good_match = configuration_table[level].good_length;
+ s->nice_match = configuration_table[level].nice_length;
+ s->max_chain_length = configuration_table[level].max_chain;
+ }
+ s->strategy = strategy;
+ return err;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain)
+ z_streamp strm;
+ int good_length;
+ int max_lazy;
+ int nice_length;
+ int max_chain;
+{
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ s = strm->state;
+ s->good_match = good_length;
+ s->max_lazy_match = max_lazy;
+ s->nice_match = nice_length;
+ s->max_chain_length = max_chain;
+ return Z_OK;
+}
+
+/* =========================================================================
+ * For the default windowBits of 15 and memLevel of 8, this function returns
+ * a close to exact, as well as small, upper bound on the compressed size.
+ * They are coded as constants here for a reason--if the #define's are
+ * changed, then this function needs to be changed as well. The return
+ * value for 15 and 8 only works for those exact settings.
+ *
+ * For any setting other than those defaults for windowBits and memLevel,
+ * the value returned is a conservative worst case for the maximum expansion
+ * resulting from using fixed blocks instead of stored blocks, which deflate
+ * can emit on compressed data for some combinations of the parameters.
+ *
+ * This function could be more sophisticated to provide closer upper bounds for
+ * every combination of windowBits and memLevel. But even the conservative
+ * upper bound of about 14% expansion does not seem onerous for output buffer
+ * allocation.
+ */
+uLong ZEXPORT deflateBound(strm, sourceLen)
+ z_streamp strm;
+ uLong sourceLen;
+{
+ deflate_state *s;
+ uLong complen, wraplen;
+ Bytef *str;
+
+ /* conservative upper bound for compressed data */
+ complen = sourceLen +
+ ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 5;
+
+ /* if can't get parameters, return conservative bound plus zlib wrapper */
+ if (strm == Z_NULL || strm->state == Z_NULL)
+ return complen + 6;
+
+ /* compute wrapper length */
+ s = strm->state;
+ switch (s->wrap) {
+ case 0: /* raw deflate */
+ wraplen = 0;
+ break;
+ case 1: /* zlib wrapper */
+ wraplen = 6 + (s->strstart ? 4 : 0);
+ break;
+ case 2: /* gzip wrapper */
+ wraplen = 18;
+ if (s->gzhead != Z_NULL) { /* user-supplied gzip header */
+ if (s->gzhead->extra != Z_NULL)
+ wraplen += 2 + s->gzhead->extra_len;
+ str = s->gzhead->name;
+ if (str != Z_NULL)
+ do {
+ wraplen++;
+ } while (*str++);
+ str = s->gzhead->comment;
+ if (str != Z_NULL)
+ do {
+ wraplen++;
+ } while (*str++);
+ if (s->gzhead->hcrc)
+ wraplen += 2;
+ }
+ break;
+ default: /* for compiler happiness */
+ wraplen = 6;
+ }
+
+ /* if not default parameters, return conservative bound */
+ if (s->w_bits != 15 || s->hash_bits != 8 + 7)
+ return complen + wraplen;
+
+ /* default settings: return tight bound for that case */
+ return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
+ (sourceLen >> 25) + 13 - 6 + wraplen;
+}
+
+/* =========================================================================
+ * Put a short in the pending buffer. The 16-bit value is put in MSB order.
+ * IN assertion: the stream state is correct and there is enough room in
+ * pending_buf.
+ */
+local void putShortMSB (s, b)
+ deflate_state *s;
+ uInt b;
+{
+ put_byte(s, (Byte)(b >> 8));
+ put_byte(s, (Byte)(b & 0xff));
+}
+
+/* =========================================================================
+ * Flush as much pending output as possible. All deflate() output goes
+ * through this function so some applications may wish to modify it
+ * to avoid allocating a large strm->next_out buffer and copying into it.
+ * (See also read_buf()).
+ */
+local void flush_pending(strm)
+ z_streamp strm;
+{
+ 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, s->pending_out, len);
+ strm->next_out += len;
+ s->pending_out += len;
+ strm->total_out += len;
+ strm->avail_out -= len;
+ s->pending -= len;
+ if (s->pending == 0) {
+ s->pending_out = s->pending_buf;
+ }
+}
+
+/* ========================================================================= */
+int ZEXPORT deflate (strm, flush)
+ z_streamp strm;
+ int flush;
+{
+ int old_flush; /* value of flush param for previous deflate call */
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL ||
+ flush > Z_BLOCK || flush < 0) {
+ return Z_STREAM_ERROR;
+ }
+ s = strm->state;
+
+ if (strm->next_out == Z_NULL ||
+ (strm->next_in == Z_NULL && strm->avail_in != 0) ||
+ (s->status == FINISH_STATE && flush != Z_FINISH)) {
+ ERR_RETURN(strm, Z_STREAM_ERROR);
+ }
+ if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR);
+
+ s->strm = strm; /* just in case */
+ old_flush = s->last_flush;
+ s->last_flush = flush;
+
+ /* Write the header */
+ if (s->status == INIT_STATE) {
+#ifdef GZIP
+ if (s->wrap == 2) {
+ strm->adler = crc32(0L, Z_NULL, 0);
+ put_byte(s, 31);
+ put_byte(s, 139);
+ put_byte(s, 8);
+ if (s->gzhead == Z_NULL) {
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, s->level == 9 ? 2 :
+ (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
+ 4 : 0));
+ put_byte(s, OS_CODE);
+ s->status = BUSY_STATE;
+ }
+ else {
+ put_byte(s, (s->gzhead->text ? 1 : 0) +
+ (s->gzhead->hcrc ? 2 : 0) +
+ (s->gzhead->extra == Z_NULL ? 0 : 4) +
+ (s->gzhead->name == Z_NULL ? 0 : 8) +
+ (s->gzhead->comment == Z_NULL ? 0 : 16)
+ );
+ put_byte(s, (Byte)(s->gzhead->time & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff));
+ put_byte(s, s->level == 9 ? 2 :
+ (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
+ 4 : 0));
+ put_byte(s, s->gzhead->os & 0xff);
+ if (s->gzhead->extra != Z_NULL) {
+ put_byte(s, s->gzhead->extra_len & 0xff);
+ put_byte(s, (s->gzhead->extra_len >> 8) & 0xff);
+ }
+ if (s->gzhead->hcrc)
+ strm->adler = crc32(strm->adler, s->pending_buf,
+ s->pending);
+ s->gzindex = 0;
+ s->status = EXTRA_STATE;
+ }
+ }
+ else
+#endif
+ {
+ uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8;
+ uInt level_flags;
+
+ if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2)
+ level_flags = 0;
+ else if (s->level < 6)
+ level_flags = 1;
+ else if (s->level == 6)
+ level_flags = 2;
+ else
+ level_flags = 3;
+ header |= (level_flags << 6);
+ if (s->strstart != 0) header |= PRESET_DICT;
+ header += 31 - (header % 31);
+
+ s->status = BUSY_STATE;
+ putShortMSB(s, header);
+
+ /* Save the adler32 of the preset dictionary: */
+ if (s->strstart != 0) {
+ putShortMSB(s, (uInt)(strm->adler >> 16));
+ putShortMSB(s, (uInt)(strm->adler & 0xffff));
+ }
+ strm->adler = adler32(0L, Z_NULL, 0);
+ }
+ }
+#ifdef GZIP
+ if (s->status == EXTRA_STATE) {
+ if (s->gzhead->extra != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+
+ while (s->gzindex < (s->gzhead->extra_len & 0xffff)) {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size)
+ break;
+ }
+ put_byte(s, s->gzhead->extra[s->gzindex]);
+ s->gzindex++;
+ }
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (s->gzindex == s->gzhead->extra_len) {
+ s->gzindex = 0;
+ s->status = NAME_STATE;
+ }
+ }
+ else
+ s->status = NAME_STATE;
+ }
+ if (s->status == NAME_STATE) {
+ if (s->gzhead->name != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+ int val;
+
+ do {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size) {
+ val = 1;
+ break;
+ }
+ }
+ val = s->gzhead->name[s->gzindex++];
+ put_byte(s, val);
+ } while (val != 0);
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (val == 0) {
+ s->gzindex = 0;
+ s->status = COMMENT_STATE;
+ }
+ }
+ else
+ s->status = COMMENT_STATE;
+ }
+ if (s->status == COMMENT_STATE) {
+ if (s->gzhead->comment != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+ int val;
+
+ do {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size) {
+ val = 1;
+ break;
+ }
+ }
+ val = s->gzhead->comment[s->gzindex++];
+ put_byte(s, val);
+ } while (val != 0);
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (val == 0)
+ s->status = HCRC_STATE;
+ }
+ else
+ s->status = HCRC_STATE;
+ }
+ if (s->status == HCRC_STATE) {
+ if (s->gzhead->hcrc) {
+ if (s->pending + 2 > s->pending_buf_size)
+ flush_pending(strm);
+ if (s->pending + 2 <= s->pending_buf_size) {
+ put_byte(s, (Byte)(strm->adler & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
+ strm->adler = crc32(0L, Z_NULL, 0);
+ s->status = BUSY_STATE;
+ }
+ }
+ else
+ s->status = BUSY_STATE;
+ }
+#endif
+
+ /* Flush as much pending output as possible */
+ if (s->pending != 0) {
+ flush_pending(strm);
+ if (strm->avail_out == 0) {
+ /* Since avail_out is 0, deflate will be called again with
+ * more output space, but possibly with both pending and
+ * avail_in equal to zero. There won't be anything to do,
+ * but this is not an error situation so make sure we
+ * return OK instead of BUF_ERROR at next call of deflate:
+ */
+ s->last_flush = -1;
+ return Z_OK;
+ }
+
+ /* Make sure there is something to do and avoid duplicate consecutive
+ * 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 && RANK(flush) <= RANK(old_flush) &&
+ flush != Z_FINISH) {
+ ERR_RETURN(strm, Z_BUF_ERROR);
+ }
+
+ /* User must not provide more input after the first FINISH: */
+ if (s->status == FINISH_STATE && strm->avail_in != 0) {
+ ERR_RETURN(strm, Z_BUF_ERROR);
+ }
+
+ /* Start a new block or continue the current one.
+ */
+ if (strm->avail_in != 0 || s->lookahead != 0 ||
+ (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) {
+ block_state bstate;
+
+ bstate = s->strategy == Z_HUFFMAN_ONLY ? deflate_huff(s, flush) :
+ (s->strategy == Z_RLE ? deflate_rle(s, flush) :
+ (*(configuration_table[s->level].func))(s, flush));
+
+ if (bstate == finish_started || bstate == finish_done) {
+ s->status = FINISH_STATE;
+ }
+ if (bstate == need_more || bstate == finish_started) {
+ if (strm->avail_out == 0) {
+ s->last_flush = -1; /* avoid BUF_ERROR next call, see above */
+ }
+ return Z_OK;
+ /* If flush != Z_NO_FLUSH && avail_out == 0, the next call
+ * of deflate should use the same flush parameter to make sure
+ * that the flush is complete. So we don't have to output an
+ * empty block here, this will be done at next call. This also
+ * ensures that for a very small output buffer, we emit at most
+ * one empty block.
+ */
+ }
+ if (bstate == block_done) {
+ if (flush == Z_PARTIAL_FLUSH) {
+ _tr_align(s);
+ } else if (flush != Z_BLOCK) { /* FULL_FLUSH or SYNC_FLUSH */
+ _tr_stored_block(s, (char*)0, 0L, 0);
+ /* For a full flush, this empty block will be recognized
+ * as a special marker by inflate_sync().
+ */
+ if (flush == Z_FULL_FLUSH) {
+ CLEAR_HASH(s); /* forget history */
+ if (s->lookahead == 0) {
+ s->strstart = 0;
+ s->block_start = 0L;
+ s->insert = 0;
+ }
+ }
+ }
+ flush_pending(strm);
+ if (strm->avail_out == 0) {
+ s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */
+ return Z_OK;
+ }
+ }
+ }
+ Assert(strm->avail_out > 0, "bug2");
+
+ if (flush != Z_FINISH) return Z_OK;
+ if (s->wrap <= 0) return Z_STREAM_END;
+
+ /* Write the trailer */
+#ifdef GZIP
+ if (s->wrap == 2) {
+ put_byte(s, (Byte)(strm->adler & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 16) & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 24) & 0xff));
+ put_byte(s, (Byte)(strm->total_in & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 8) & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 16) & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 24) & 0xff));
+ }
+ else
+#endif
+ {
+ putShortMSB(s, (uInt)(strm->adler >> 16));
+ putShortMSB(s, (uInt)(strm->adler & 0xffff));
+ }
+ flush_pending(strm);
+ /* If avail_out is zero, the application will call deflate again
+ * to flush the rest.
+ */
+ if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */
+ return s->pending != 0 ? Z_OK : Z_STREAM_END;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateEnd (strm)
+ z_streamp strm;
+{
+ int status;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+
+ status = strm->state->status;
+ if (status != INIT_STATE &&
+ status != EXTRA_STATE &&
+ status != NAME_STATE &&
+ status != COMMENT_STATE &&
+ status != HCRC_STATE &&
+ status != BUSY_STATE &&
+ status != FINISH_STATE) {
+ return Z_STREAM_ERROR;
+ }
+
+ /* Deallocate in reverse order of allocations: */
+ TRY_FREE(strm, strm->state->pending_buf);
+ TRY_FREE(strm, strm->state->head);
+ TRY_FREE(strm, strm->state->prev);
+ TRY_FREE(strm, strm->state->window);
+
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+
+ return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK;
+}
+
+/* =========================================================================
+ * Copy the source state to the destination state.
+ * To simplify the source, this is not supported for 16-bit MSDOS (which
+ * doesn't have enough memory anyway to duplicate compression states).
+ */
+int ZEXPORT deflateCopy (dest, source)
+ z_streamp dest;
+ z_streamp source;
+{
+#ifdef MAXSEG_64K
+ return Z_STREAM_ERROR;
+#else
+ deflate_state *ds;
+ deflate_state *ss;
+ ushf *overlay;
+
+
+ if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) {
+ return Z_STREAM_ERROR;
+ }
+
+ ss = source->state;
+
+ 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((voidpf)ds, (voidpf)ss, sizeof(deflate_state));
+ ds->strm = dest;
+
+ ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte));
+ ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos));
+ ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos));
+ overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2);
+ ds->pending_buf = (uchf *) overlay;
+
+ if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL ||
+ ds->pending_buf == Z_NULL) {
+ deflateEnd (dest);
+ return Z_MEM_ERROR;
+ }
+ /* following zmemcpy do not work for 16-bit MSDOS */
+ zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte));
+ 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);
+ ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush);
+ ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize;
+
+ ds->l_desc.dyn_tree = ds->dyn_ltree;
+ ds->d_desc.dyn_tree = ds->dyn_dtree;
+ ds->bl_desc.dyn_tree = ds->bl_tree;
+
+ return Z_OK;
+#endif /* MAXSEG_64K */
+}
+
+/* ===========================================================================
+ * Read a new buffer from the current input stream, update the adler32
+ * and total number of bytes read. All deflate() input goes through
+ * this function so some applications may wish to modify it to avoid
+ * allocating a large strm->next_in buffer and copying from it.
+ * (See also flush_pending()).
+ */
+local int read_buf(strm, buf, size)
+ z_streamp strm;
+ Bytef *buf;
+ unsigned size;
+{
+ unsigned len = strm->avail_in;
+
+ if (len > size) len = size;
+ if (len == 0) return 0;
+
+ strm->avail_in -= len;
+
+ zmemcpy(buf, strm->next_in, len);
+ if (strm->state->wrap == 1) {
+ strm->adler = adler32(strm->adler, buf, len);
+ }
+#ifdef GZIP
+ else if (strm->state->wrap == 2) {
+ strm->adler = crc32(strm->adler, buf, len);
+ }
+#endif
+ strm->next_in += len;
+ strm->total_in += len;
+
+ return (int)len;
+}
+
+/* ===========================================================================
+ * Initialize the "longest match" routines for a new zlib stream
+ */
+local void lm_init (s)
+ deflate_state *s;
+{
+ s->window_size = (ulg)2L*s->w_size;
+
+ CLEAR_HASH(s);
+
+ /* Set the default configuration parameters:
+ */
+ s->max_lazy_match = configuration_table[s->level].max_lazy;
+ s->good_match = configuration_table[s->level].good_length;
+ s->nice_match = configuration_table[s->level].nice_length;
+ s->max_chain_length = configuration_table[s->level].max_chain;
+
+ 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;
+#ifndef FASTEST
+#ifdef ASMV
+ match_init(); /* initialize the asm code */
+#endif
+#endif
+}
+
+#ifndef FASTEST
+/* ===========================================================================
+ * Set match_start to the longest match starting at the given string and
+ * return its length. Matches shorter or equal to prev_length are discarded,
+ * in which case the result is equal to prev_length and match_start is
+ * garbage.
+ * IN assertions: cur_match is the head of the hash chain for the current
+ * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
+ * OUT assertion: the match length is not greater than s->lookahead.
+ */
+#ifndef ASMV
+/* For 80x86 and 680x0, an optimized version will be provided in match.asm or
+ * match.S. The code will be functionally equivalent.
+ */
+local uInt longest_match(s, cur_match)
+ deflate_state *s;
+ IPos cur_match; /* current match */
+{
+ unsigned chain_length = s->max_chain_length;/* max hash chain length */
+ register Bytef *scan = s->window + s->strstart; /* current string */
+ register Bytef *match; /* matched string */
+ register int len; /* length of current match */
+ int best_len = s->prev_length; /* best match length so far */
+ int nice_match = s->nice_match; /* stop if match long enough */
+ IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+ s->strstart - (IPos)MAX_DIST(s) : NIL;
+ /* Stop when cur_match becomes <= limit. To simplify the code,
+ * we prevent matches with the string of window index 0.
+ */
+ Posf *prev = s->prev;
+ uInt wmask = s->w_mask;
+
+#ifdef UNALIGNED_OK
+ /* Compare two bytes at a time. Note: this is not always beneficial.
+ * Try with and without -DUNALIGNED_OK to check.
+ */
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1;
+ register ush scan_start = *(ushf*)scan;
+ register ush scan_end = *(ushf*)(scan+best_len-1);
+#else
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH;
+ register Byte scan_end1 = scan[best_len-1];
+ register Byte scan_end = scan[best_len];
+#endif
+
+ /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+ * It is easy to get rid of this optimization if necessary.
+ */
+ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");
+
+ /* Do not waste too much time if we already have a good match: */
+ if (s->prev_length >= s->good_match) {
+ chain_length >>= 2;
+ }
+ /* Do not look for matches beyond the end of the input. This is necessary
+ * to make deflate deterministic.
+ */
+ if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+
+ Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");
+
+ do {
+ Assert(cur_match < s->strstart, "no future");
+ match = s->window + cur_match;
+
+ /* Skip to next match if the match length cannot increase
+ * or if the match length is less than 2. Note that the checks below
+ * for insufficient lookahead only occur occasionally for performance
+ * reasons. Therefore uninitialized memory will be accessed, and
+ * conditional jumps will be made that depend on those values.
+ * However the length of the match is limited to the lookahead, so
+ * the output of deflate is not affected by the uninitialized values.
+ */
+#if (defined(UNALIGNED_OK) && MAX_MATCH == 258)
+ /* This code assumes sizeof(unsigned short) == 2. Do not use
+ * UNALIGNED_OK if your compiler uses a different size.
+ */
+ if (*(ushf*)(match+best_len-1) != scan_end ||
+ *(ushf*)match != scan_start) continue;
+
+ /* It is not necessary to compare scan[2] and match[2] since they are
+ * always equal when the other bytes match, given that the hash keys
+ * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at
+ * strstart+3, +5, ... up to strstart+257. We check for insufficient
+ * lookahead only every 4th comparison; the 128th check will be made
+ * at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
+ * necessary to put more guard bytes at the end of the window, or
+ * to check more often for insufficient lookahead.
+ */
+ Assert(scan[2] == match[2], "scan[2]?");
+ scan++, match++;
+ do {
+ } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ scan < strend);
+ /* The funny "do {}" generates better code on most compilers */
+
+ /* Here, scan <= window+strstart+257 */
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+ if (*scan == *match) scan++;
+
+ len = (MAX_MATCH - 1) - (int)(strend-scan);
+ scan = strend - (MAX_MATCH-1);
+
+#else /* UNALIGNED_OK */
+
+ if (match[best_len] != scan_end ||
+ match[best_len-1] != scan_end1 ||
+ *match != *scan ||
+ *++match != scan[1]) continue;
+
+ /* The check at best_len-1 can be removed because it will be made
+ * again later. (This heuristic is not always a win.)
+ * It is not necessary to compare scan[2] and match[2] since they
+ * are always equal when the other bytes match, given that
+ * the hash keys are equal and that HASH_BITS >= 8.
+ */
+ scan += 2, match++;
+ Assert(*scan == *match, "match[2]?");
+
+ /* We check for insufficient lookahead only every 8th comparison;
+ * the 256th check will be made at strstart+258.
+ */
+ do {
+ } while (*++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ scan < strend);
+
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+
+ len = MAX_MATCH - (int)(strend - scan);
+ scan = strend - MAX_MATCH;
+
+#endif /* UNALIGNED_OK */
+
+ if (len > best_len) {
+ s->match_start = cur_match;
+ best_len = len;
+ if (len >= nice_match) break;
+#ifdef UNALIGNED_OK
+ scan_end = *(ushf*)(scan+best_len-1);
+#else
+ scan_end1 = scan[best_len-1];
+ scan_end = scan[best_len];
+#endif
+ }
+ } while ((cur_match = prev[cur_match & wmask]) > limit
+ && --chain_length != 0);
+
+ if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
+ return s->lookahead;
+}
+#endif /* ASMV */
+
+#else /* FASTEST */
+
+/* ---------------------------------------------------------------------------
+ * Optimized version for FASTEST only
+ */
+local uInt longest_match(s, cur_match)
+ deflate_state *s;
+ IPos cur_match; /* current match */
+{
+ register Bytef *scan = s->window + s->strstart; /* current string */
+ register Bytef *match; /* matched string */
+ register int len; /* length of current match */
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH;
+
+ /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+ * It is easy to get rid of this optimization if necessary.
+ */
+ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");
+
+ Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");
+
+ Assert(cur_match < s->strstart, "no future");
+
+ match = s->window + cur_match;
+
+ /* Return failure if the match length is less than 2:
+ */
+ if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1;
+
+ /* The check at best_len-1 can be removed because it will be made
+ * again later. (This heuristic is not always a win.)
+ * It is not necessary to compare scan[2] and match[2] since they
+ * are always equal when the other bytes match, given that
+ * the hash keys are equal and that HASH_BITS >= 8.
+ */
+ scan += 2, match += 2;
+ Assert(*scan == *match, "match[2]?");
+
+ /* We check for insufficient lookahead only every 8th comparison;
+ * the 256th check will be made at strstart+258.
+ */
+ do {
+ } while (*++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ scan < strend);
+
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+
+ len = MAX_MATCH - (int)(strend - scan);
+
+ if (len < MIN_MATCH) return MIN_MATCH - 1;
+
+ s->match_start = cur_match;
+ return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead;
+}
+
+#endif /* FASTEST */
+
+#ifdef DEBUG
+/* ===========================================================================
+ * Check that the match at match_start is indeed a match.
+ */
+local void check_match(s, start, match, length)
+ deflate_state *s;
+ IPos start, match;
+ int length;
+{
+ /* check that the match is indeed a match */
+ if (zmemcmp(s->window + match,
+ s->window + start, length) != EQUAL) {
+ fprintf(stderr, " start %u, match %u, length %d\n",
+ start, match, length);
+ do {
+ fprintf(stderr, "%c%c", s->window[match++], s->window[start++]);
+ } while (--length != 0);
+ z_error("invalid match");
+ }
+ if (z_verbose > 1) {
+ fprintf(stderr,"\\[%d,%d]", start-match, length);
+ do { putc(s->window[start++], stderr); } while (--length != 0);
+ }
+}
+#else
+# define check_match(s, start, match, length)
+#endif /* DEBUG */
+
+/* ===========================================================================
+ * Fill the window when the lookahead becomes insufficient.
+ * Updates strstart and lookahead.
+ *
+ * IN assertion: lookahead < MIN_LOOKAHEAD
+ * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD
+ * At least one byte has been read, or avail_in == 0; reads are
+ * performed for at least two bytes (required for the zip translate_eol
+ * option -- not supported here).
+ */
+local void fill_window(s)
+ deflate_state *s;
+{
+ register unsigned n, m;
+ register Posf *p;
+ 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);
+
+ /* Deal with !@#$% 64K limit: */
+ if (sizeof(int) <= 2) {
+ if (more == 0 && s->strstart == 0 && s->lookahead == 0) {
+ more = wsize;
+
+ } else if (more == (unsigned)(-1)) {
+ /* Very unlikely, but possible on 16 bit machine if
+ * strstart == 0 && lookahead == 1 (input done a byte at time)
+ */
+ more--;
+ }
+ }
+
+ /* If the window is almost full and there is insufficient lookahead,
+ * move the upper half to the lower one to make room in the upper half.
+ */
+ if (s->strstart >= wsize+MAX_DIST(s)) {
+
+ zmemcpy(s->window, s->window+wsize, (unsigned)wsize);
+ s->match_start -= wsize;
+ s->strstart -= wsize; /* we now have strstart >= MAX_DIST */
+ s->block_start -= (long) wsize;
+
+ /* Slide the hash table (could be avoided with 32 bit values
+ at the expense of memory usage). We slide even when level == 0
+ to keep the hash table consistent if we switch back to level > 0
+ later. (Using level 0 permanently is not an optimal usage of
+ zlib, so we don't care about this pathological case.)
+ */
+ n = s->hash_size;
+ p = &s->head[n];
+ do {
+ m = *--p;
+ *p = (Pos)(m >= wsize ? m-wsize : NIL);
+ } while (--n);
+
+ n = wsize;
+#ifndef FASTEST
+ p = &s->prev[n];
+ do {
+ m = *--p;
+ *p = (Pos)(m >= wsize ? m-wsize : NIL);
+ /* If n is not on any hash chain, prev[n] is garbage but
+ * its value will never be used.
+ */
+ } while (--n);
+#endif
+ more += wsize;
+ }
+ if (s->strm->avail_in == 0) break;
+
+ /* If there was no sliding:
+ * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
+ * more == window_size - lookahead - strstart
+ * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)
+ * => more >= window_size - 2*WSIZE + 2
+ * In the BIG_MEM or MMAP case (not yet supported),
+ * window_size == input_size + MIN_LOOKAHEAD &&
+ * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.
+ * Otherwise, window_size == 2*WSIZE so more >= 2.
+ * If there was sliding, more >= WSIZE. So in all cases, more >= 2.
+ */
+ Assert(more >= 2, "more < 2");
+
+ n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more);
+ s->lookahead += n;
+
+ /* Initialize the hash value now that we have some input: */
+ 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.
+ */
+
+ } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0);
+
+ /* If the WIN_INIT bytes after the end of the current data have never been
+ * written, then zero those bytes in order to avoid memory check reports of
+ * the use of uninitialized (or uninitialised as Julian writes) bytes by
+ * the longest match routines. Update the high water mark for the next
+ * time through here. WIN_INIT is set to MAX_MATCH since the longest match
+ * routines allow scanning to strstart + MAX_MATCH, ignoring lookahead.
+ */
+ if (s->high_water < s->window_size) {
+ ulg curr = s->strstart + (ulg)(s->lookahead);
+ ulg init;
+
+ if (s->high_water < curr) {
+ /* Previous high water mark below current data -- zero WIN_INIT
+ * bytes or up to end of window, whichever is less.
+ */
+ init = s->window_size - curr;
+ if (init > WIN_INIT)
+ init = WIN_INIT;
+ zmemzero(s->window + curr, (unsigned)init);
+ s->high_water = curr + init;
+ }
+ else if (s->high_water < (ulg)curr + WIN_INIT) {
+ /* High water mark at or above current data, but below current data
+ * plus WIN_INIT -- zero out to current data plus WIN_INIT, or up
+ * to end of window, whichever is less.
+ */
+ init = (ulg)curr + WIN_INIT - s->high_water;
+ if (init > s->window_size - s->high_water)
+ init = s->window_size - s->high_water;
+ zmemzero(s->window + s->high_water, (unsigned)init);
+ s->high_water += init;
+ }
+ }
+
+ Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD,
+ "not enough room for search");
+}
+
+/* ===========================================================================
+ * Flush the current block, with given end-of-file flag.
+ * IN assertion: strstart is set to the end of the current match.
+ */
+#define FLUSH_BLOCK_ONLY(s, last) { \
+ _tr_flush_block(s, (s->block_start >= 0L ? \
+ (charf *)&s->window[(unsigned)s->block_start] : \
+ (charf *)Z_NULL), \
+ (ulg)((long)s->strstart - s->block_start), \
+ (last)); \
+ s->block_start = s->strstart; \
+ flush_pending(s->strm); \
+ Tracev((stderr,"[FLUSH]")); \
+}
+
+/* Same but force premature exit if necessary. */
+#define FLUSH_BLOCK(s, last) { \
+ FLUSH_BLOCK_ONLY(s, last); \
+ if (s->strm->avail_out == 0) return (last) ? finish_started : need_more; \
+}
+
+/* ===========================================================================
+ * Copy without compression as much as possible from the input stream, return
+ * the current block state.
+ * This function does not insert new strings in the dictionary since
+ * uncompressible data is probably not useful. This function is used
+ * only for the level=0 compression option.
+ * NOTE: this function should be optimized to avoid extra copying from
+ * window to pending_buf.
+ */
+local block_state deflate_stored(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ /* Stored blocks are limited to 0xffff bytes, pending_buf is limited
+ * to pending_buf_size, and each stored block has a 5 byte header:
+ */
+ ulg max_block_size = 0xffff;
+ ulg max_start;
+
+ if (max_block_size > s->pending_buf_size - 5) {
+ max_block_size = s->pending_buf_size - 5;
+ }
+
+ /* Copy as much as possible from input to output: */
+ for (;;) {
+ /* Fill the window as much as possible: */
+ if (s->lookahead <= 1) {
+
+ Assert(s->strstart < s->w_size+MAX_DIST(s) ||
+ s->block_start >= (long)s->w_size, "slide too late");
+
+ fill_window(s);
+ if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more;
+
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+ Assert(s->block_start >= 0L, "block gone");
+
+ s->strstart += s->lookahead;
+ s->lookahead = 0;
+
+ /* Emit a stored block if pending_buf will be full: */
+ max_start = s->block_start + max_block_size;
+ if (s->strstart == 0 || (ulg)s->strstart >= max_start) {
+ /* strstart == 0 is possible when wraparound on 16-bit machine */
+ s->lookahead = (uInt)(s->strstart - max_start);
+ s->strstart = (uInt)max_start;
+ FLUSH_BLOCK(s, 0);
+ }
+ /* Flush if we may have to slide, otherwise block_start may become
+ * negative and the data will be gone:
+ */
+ if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) {
+ FLUSH_BLOCK(s, 0);
+ }
+ }
+ 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;
+}
+
+/* ===========================================================================
+ * Compress as much as possible from the input stream, return the current
+ * block state.
+ * This function does not perform lazy evaluation of matches and inserts
+ * new strings in the dictionary only for unmatched strings or for short
+ * matches. It is used only for the fast compression options.
+ */
+local block_state deflate_fast(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ IPos hash_head; /* head of the hash chain */
+ int bflush; /* set if current block must be flushed */
+
+ for (;;) {
+ /* Make sure that we always have enough lookahead, except
+ * at the end of the input file. We need MAX_MATCH bytes
+ * for the next match, plus MIN_MATCH bytes to insert the
+ * string following the next match.
+ */
+ if (s->lookahead < MIN_LOOKAHEAD) {
+ fill_window(s);
+ if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* Insert the string window[strstart .. strstart+2] in the
+ * dictionary, and set hash_head to the head of the hash chain:
+ */
+ hash_head = NIL;
+ if (s->lookahead >= MIN_MATCH) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+
+ /* Find the longest match, discarding those <= prev_length.
+ * At this point we have always match_length < MIN_MATCH
+ */
+ if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) {
+ /* To simplify the code, we prevent matches with the string
+ * of window index 0 (in particular we have to avoid a match
+ * of the string with itself at the start of the input file).
+ */
+ s->match_length = longest_match (s, hash_head);
+ /* longest_match() sets match_start */
+ }
+ if (s->match_length >= MIN_MATCH) {
+ check_match(s, s->strstart, s->match_start, s->match_length);
+
+ _tr_tally_dist(s, s->strstart - s->match_start,
+ s->match_length - MIN_MATCH, bflush);
+
+ s->lookahead -= s->match_length;
+
+ /* Insert new strings in the hash table only if the match length
+ * is not too large. This saves time but degrades compression.
+ */
+#ifndef FASTEST
+ if (s->match_length <= s->max_insert_length &&
+ s->lookahead >= MIN_MATCH) {
+ s->match_length--; /* string at strstart already in table */
+ do {
+ s->strstart++;
+ INSERT_STRING(s, s->strstart, hash_head);
+ /* strstart never exceeds WSIZE-MAX_MATCH, so there are
+ * always MIN_MATCH bytes ahead.
+ */
+ } while (--s->match_length != 0);
+ s->strstart++;
+ } else
+#endif
+ {
+ s->strstart += s->match_length;
+ s->match_length = 0;
+ s->ins_h = s->window[s->strstart];
+ UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]);
+#if MIN_MATCH != 3
+ Call UPDATE_HASH() MIN_MATCH-3 more times
+#endif
+ /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not
+ * matter since it will be recomputed at next deflate call.
+ */
+ }
+ } else {
+ /* No match, output a literal byte */
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ }
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ 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
+/* ===========================================================================
+ * Same as above, but achieves better compression. We use a lazy
+ * evaluation for matches: a match is finally adopted only if there is
+ * no better match at the next window position.
+ */
+local block_state deflate_slow(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ IPos hash_head; /* head of hash chain */
+ int bflush; /* set if current block must be flushed */
+
+ /* Process the input block. */
+ for (;;) {
+ /* Make sure that we always have enough lookahead, except
+ * at the end of the input file. We need MAX_MATCH bytes
+ * for the next match, plus MIN_MATCH bytes to insert the
+ * string following the next match.
+ */
+ if (s->lookahead < MIN_LOOKAHEAD) {
+ fill_window(s);
+ if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* Insert the string window[strstart .. strstart+2] in the
+ * dictionary, and set hash_head to the head of the hash chain:
+ */
+ hash_head = NIL;
+ if (s->lookahead >= MIN_MATCH) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+
+ /* Find the longest match, discarding those <= prev_length.
+ */
+ s->prev_length = s->match_length, s->prev_match = s->match_start;
+ s->match_length = MIN_MATCH-1;
+
+ if (hash_head != NIL && s->prev_length < s->max_lazy_match &&
+ s->strstart - hash_head <= MAX_DIST(s)) {
+ /* To simplify the code, we prevent matches with the string
+ * of window index 0 (in particular we have to avoid a match
+ * of the string with itself at the start of the input file).
+ */
+ s->match_length = longest_match (s, hash_head);
+ /* longest_match() sets match_start */
+
+ if (s->match_length <= 5 && (s->strategy == Z_FILTERED
+#if TOO_FAR <= 32767
+ || (s->match_length == MIN_MATCH &&
+ s->strstart - s->match_start > TOO_FAR)
+#endif
+ )) {
+
+ /* If prev_match is also MIN_MATCH, match_start is garbage
+ * but we will ignore the current match anyway.
+ */
+ s->match_length = MIN_MATCH-1;
+ }
+ }
+ /* If there was a match at the previous step and the current
+ * match is not better, output the previous match:
+ */
+ if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) {
+ uInt max_insert = s->strstart + s->lookahead - MIN_MATCH;
+ /* Do not insert strings in hash table beyond this. */
+
+ check_match(s, s->strstart-1, s->prev_match, s->prev_length);
+
+ _tr_tally_dist(s, s->strstart -1 - s->prev_match,
+ s->prev_length - MIN_MATCH, bflush);
+
+ /* Insert in hash table all strings up to the end of the match.
+ * strstart-1 and strstart are already inserted. If there is not
+ * enough lookahead, the last two strings are not inserted in
+ * the hash table.
+ */
+ s->lookahead -= s->prev_length-1;
+ s->prev_length -= 2;
+ do {
+ if (++s->strstart <= max_insert) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+ } while (--s->prev_length != 0);
+ s->match_available = 0;
+ s->match_length = MIN_MATCH-1;
+ s->strstart++;
+
+ if (bflush) FLUSH_BLOCK(s, 0);
+
+ } else if (s->match_available) {
+ /* If there was no match at the previous position, output a
+ * single literal. If there was a match but the current match
+ * is longer, truncate the previous match to a single literal.
+ */
+ Tracevv((stderr,"%c", s->window[s->strstart-1]));
+ _tr_tally_lit(s, s->window[s->strstart-1], bflush);
+ if (bflush) {
+ FLUSH_BLOCK_ONLY(s, 0);
+ }
+ s->strstart++;
+ s->lookahead--;
+ if (s->strm->avail_out == 0) return need_more;
+ } else {
+ /* There is no previous match to compare with, wait for
+ * the next step to decide.
+ */
+ s->match_available = 1;
+ s->strstart++;
+ s->lookahead--;
+ }
+ }
+ Assert (flush != Z_NO_FLUSH, "no flush?");
+ if (s->match_available) {
+ Tracevv((stderr,"%c", s->window[s->strstart-1]));
+ _tr_tally_lit(s, s->window[s->strstart-1], bflush);
+ s->match_available = 0;
+ }
+ 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 */
+
+/* ===========================================================================
+ * For Z_RLE, simply look for runs of bytes, generate matches only of distance
+ * one. Do not maintain a hash table. (It will be regenerated if this run of
+ * deflate switches away from Z_RLE.)
+ */
+local block_state deflate_rle(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ int bflush; /* set if current block must be flushed */
+ uInt prev; /* byte at distance one to match */
+ Bytef *scan, *strend; /* scan goes up to strend for length of run */
+
+ 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 run, plus one for the unrolled loop.
+ */
+ if (s->lookahead <= MAX_MATCH) {
+ fill_window(s);
+ if (s->lookahead <= MAX_MATCH && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* See how many times the previous byte repeats */
+ s->match_length = 0;
+ if (s->lookahead >= MIN_MATCH && s->strstart > 0) {
+ scan = s->window + s->strstart - 1;
+ prev = *scan;
+ if (prev == *++scan && prev == *++scan && prev == *++scan) {
+ strend = s->window + s->strstart + MAX_MATCH;
+ do {
+ } while (prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ scan < strend);
+ s->match_length = MAX_MATCH - (int)(strend - scan);
+ 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 */
+ if (s->match_length >= MIN_MATCH) {
+ check_match(s, s->strstart, s->strstart - 1, s->match_length);
+
+ _tr_tally_dist(s, 1, s->match_length - MIN_MATCH, bflush);
+
+ s->lookahead -= s->match_length;
+ s->strstart += s->match_length;
+ s->match_length = 0;
+ } else {
+ /* No match, output a literal byte */
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ }
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ 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;
+}
+
+/* ===========================================================================
+ * For Z_HUFFMAN_ONLY, do not look for matches. Do not maintain a hash table.
+ * (It will be regenerated if this run of deflate switches away from Huffman.)
+ */
+local block_state deflate_huff(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ int bflush; /* set if current block must be flushed */
+
+ for (;;) {
+ /* Make sure that we have a literal to write. */
+ if (s->lookahead == 0) {
+ fill_window(s);
+ if (s->lookahead == 0) {
+ if (flush == Z_NO_FLUSH)
+ return need_more;
+ break; /* flush the current block */
+ }
+ }
+
+ /* Output a literal byte */
+ s->match_length = 0;
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ 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
new file mode 100644
index 0000000..ce0299e
--- /dev/null
+++ b/compat/zlib/deflate.h
@@ -0,0 +1,346 @@
+/* deflate.h -- internal compression state
+ * Copyright (C) 1995-2012 Jean-loup Gailly
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* @(#) $Id$ */
+
+#ifndef DEFLATE_H
+#define DEFLATE_H
+
+#include "zutil.h"
+
+/* define NO_GZIP when compiling if you want to disable gzip header and
+ trailer creation by deflate(). NO_GZIP would be used to avoid linking in
+ the crc code when it is not needed. For shared libraries, gzip encoding
+ should be left enabled. */
+#ifndef NO_GZIP
+# define GZIP
+#endif
+
+/* ===========================================================================
+ * Internal compression state.
+ */
+
+#define LENGTH_CODES 29
+/* number of length codes, not counting the special END_BLOCK code */
+
+#define LITERALS 256
+/* number of literal bytes 0..255 */
+
+#define L_CODES (LITERALS+1+LENGTH_CODES)
+/* number of Literal or Length codes, including the END_BLOCK code */
+
+#define D_CODES 30
+/* number of distance codes */
+
+#define BL_CODES 19
+/* number of codes used to transfer the bit lengths */
+
+#define HEAP_SIZE (2*L_CODES+1)
+/* maximum heap size */
+
+#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
+#define COMMENT_STATE 91
+#define HCRC_STATE 103
+#define BUSY_STATE 113
+#define FINISH_STATE 666
+/* Stream status */
+
+
+/* Data structure describing a single value and its code string. */
+typedef struct ct_data_s {
+ union {
+ ush freq; /* frequency count */
+ ush code; /* bit string */
+ } fc;
+ union {
+ ush dad; /* father node in Huffman tree */
+ ush len; /* length of bit string */
+ } dl;
+} FAR ct_data;
+
+#define Freq fc.freq
+#define Code fc.code
+#define Dad dl.dad
+#define Len dl.len
+
+typedef struct static_tree_desc_s static_tree_desc;
+
+typedef struct tree_desc_s {
+ ct_data *dyn_tree; /* the dynamic tree */
+ int max_code; /* largest code with non zero frequency */
+ static_tree_desc *stat_desc; /* the corresponding static tree */
+} FAR tree_desc;
+
+typedef ush Pos;
+typedef Pos FAR Posf;
+typedef unsigned IPos;
+
+/* A Pos is an index in the character window. We use short instead of int to
+ * save space in the various tables. IPos is used only for parameter passing.
+ */
+
+typedef struct internal_state {
+ z_streamp strm; /* pointer back to this zlib stream */
+ int status; /* as the name implies */
+ Bytef *pending_buf; /* output still pending */
+ ulg pending_buf_size; /* size of pending_buf */
+ Bytef *pending_out; /* next pending byte to output to the stream */
+ uInt pending; /* nb of bytes in the pending buffer */
+ int wrap; /* bit 0 true for zlib, bit 1 true for gzip */
+ gz_headerp gzhead; /* gzip header information to write */
+ uInt gzindex; /* where in extra, name, or comment */
+ Byte method; /* can only be DEFLATED */
+ int last_flush; /* value of flush param for previous deflate call */
+
+ /* used by deflate.c: */
+
+ uInt w_size; /* LZ77 window size (32K by default) */
+ uInt w_bits; /* log2(w_size) (8..16) */
+ uInt w_mask; /* w_size - 1 */
+
+ Bytef *window;
+ /* Sliding window. Input bytes are read into the second half of the window,
+ * and move to the first half later to keep a dictionary of at least wSize
+ * bytes. With this organization, matches are limited to a distance of
+ * wSize-MAX_MATCH bytes, but this ensures that IO is always
+ * performed with a length multiple of the block size. Also, it limits
+ * the window size to 64K, which is quite useful on MSDOS.
+ * To do: use the user input buffer as sliding window.
+ */
+
+ ulg window_size;
+ /* Actual size of window: 2*wSize, except when the user input buffer
+ * is directly used as sliding window.
+ */
+
+ Posf *prev;
+ /* Link to older string with same hash index. To limit the size of this
+ * array to 64K, this link is maintained only for the last 32K strings.
+ * An index in this array is thus a window index modulo 32K.
+ */
+
+ Posf *head; /* Heads of the hash chains or NIL. */
+
+ uInt ins_h; /* hash index of string to be inserted */
+ uInt hash_size; /* number of elements in hash table */
+ uInt hash_bits; /* log2(hash_size) */
+ uInt hash_mask; /* hash_size-1 */
+
+ uInt hash_shift;
+ /* Number of bits by which ins_h must be shifted at each input
+ * step. It must be such that after MIN_MATCH steps, the oldest
+ * byte no longer takes part in the hash key, that is:
+ * hash_shift * MIN_MATCH >= hash_bits
+ */
+
+ long block_start;
+ /* Window position at the beginning of the current output block. Gets
+ * negative when the window is moved backwards.
+ */
+
+ uInt match_length; /* length of best match */
+ IPos prev_match; /* previous match */
+ int match_available; /* set if previous match exists */
+ uInt strstart; /* start of string to insert */
+ uInt match_start; /* start of matching string */
+ uInt lookahead; /* number of valid bytes ahead in window */
+
+ uInt prev_length;
+ /* Length of the best match at previous step. Matches not greater than this
+ * are discarded. This is used in the lazy match evaluation.
+ */
+
+ uInt max_chain_length;
+ /* To speed up deflation, hash chains are never searched beyond this
+ * length. A higher limit improves compression ratio but degrades the
+ * speed.
+ */
+
+ uInt max_lazy_match;
+ /* Attempt to find a better match only when the current match is strictly
+ * smaller than this value. This mechanism is used only for compression
+ * levels >= 4.
+ */
+# define max_insert_length max_lazy_match
+ /* Insert new strings in the hash table only if the match length is not
+ * greater than this length. This saves time but degrades compression.
+ * max_insert_length is used only for compression levels <= 3.
+ */
+
+ int level; /* compression level (1..9) */
+ int strategy; /* favor or force Huffman coding*/
+
+ uInt good_match;
+ /* Use a faster search when the previous match is longer than this */
+
+ int nice_match; /* Stop searching when current match exceeds this */
+
+ /* used by trees.c: */
+ /* 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 */
+
+ struct tree_desc_s l_desc; /* desc. for literal tree */
+ struct tree_desc_s d_desc; /* desc. for distance tree */
+ struct tree_desc_s bl_desc; /* desc. for bit length tree */
+
+ ush bl_count[MAX_BITS+1];
+ /* number of codes at each bit length for an optimal tree */
+
+ int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */
+ int heap_len; /* number of elements in the heap */
+ int heap_max; /* element of largest frequency */
+ /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used.
+ * The same heap array is used to build all trees.
+ */
+
+ uch depth[2*L_CODES+1];
+ /* Depth of each subtree used as tie breaker for trees of equal frequency
+ */
+
+ uchf *l_buf; /* buffer for literals or lengths */
+
+ uInt lit_bufsize;
+ /* Size of match buffer for literals/lengths. There are 4 reasons for
+ * limiting lit_bufsize to 64K:
+ * - frequencies can be kept in 16 bit counters
+ * - if compression is not successful for the first block, all input
+ * data is still in the window so we can still emit a stored block even
+ * when input comes from standard input. (This can also be done for
+ * all blocks if lit_bufsize is not greater than 32K.)
+ * - if compression is not successful for a file smaller than 64K, we can
+ * even emit a stored file instead of a stored block (saving 5 bytes).
+ * This is applicable only for zip (not gzip or zlib).
+ * - creating new Huffman trees less frequently may not provide fast
+ * adaptation to changes in the input data statistics. (Take for
+ * example a binary file with poorly compressible code followed by
+ * a highly compressible string table.) Smaller buffer sizes give
+ * fast adaptation but have of course the overhead of transmitting
+ * trees more frequently.
+ * - I can't count above 4
+ */
+
+ uInt last_lit; /* running index in l_buf */
+
+ ushf *d_buf;
+ /* Buffer for distances. To simplify the code, d_buf and l_buf have
+ * the same number of elements. To use different lengths, an extra flag
+ * array would be necessary.
+ */
+
+ 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 */
+ uInt insert; /* bytes at end of window left to insert */
+
+#ifdef DEBUG
+ ulg compressed_len; /* total bit length of compressed file mod 2^32 */
+ ulg bits_sent; /* bit length of compressed data sent mod 2^32 */
+#endif
+
+ ush bi_buf;
+ /* Output buffer. bits are inserted starting at the bottom (least
+ * significant bits).
+ */
+ int bi_valid;
+ /* Number of valid bits in bi_buf. All bits above the last valid bit
+ * are always zero.
+ */
+
+ ulg high_water;
+ /* High water mark offset in window for initialized bytes -- bytes above
+ * this are set to zero in order to avoid memory check warnings when
+ * longest match routines access bytes past the input. This is then
+ * updated to the new high water mark.
+ */
+
+} FAR deflate_state;
+
+/* Output a byte on the stream.
+ * IN assertion: there is enough room in pending_buf.
+ */
+#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);}
+
+
+#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1)
+/* Minimum amount of lookahead, except at the end of the input file.
+ * See deflate.c for comments about the MIN_MATCH+1.
+ */
+
+#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD)
+/* In order to simplify the code, particularly on 16 bit machines, match
+ * distances are limited to MAX_DIST instead of WSIZE.
+ */
+
+#define WIN_INIT MAX_MATCH
+/* Number of bytes after end of data in window to initialize in order to avoid
+ memory checker errors from longest match routines */
+
+ /* in trees.c */
+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));
+
+#define d_code(dist) \
+ ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)])
+/* Mapping from a distance to a distance code. dist is the distance - 1 and
+ * must not have side effects. _dist_code[256] and _dist_code[257] are never
+ * used.
+ */
+
+#ifndef DEBUG
+/* Inline versions of _tr_tally for speed: */
+
+#if defined(GEN_TREES_H) || !defined(STDC)
+ extern uch ZLIB_INTERNAL _length_code[];
+ extern uch ZLIB_INTERNAL _dist_code[];
+#else
+ extern const uch ZLIB_INTERNAL _length_code[];
+ extern const uch ZLIB_INTERNAL _dist_code[];
+#endif
+
+# define _tr_tally_lit(s, c, flush) \
+ { uch cc = (c); \
+ s->d_buf[s->last_lit] = 0; \
+ s->l_buf[s->last_lit++] = cc; \
+ s->dyn_ltree[cc].Freq++; \
+ flush = (s->last_lit == s->lit_bufsize-1); \
+ }
+# define _tr_tally_dist(s, distance, length, flush) \
+ { uch len = (length); \
+ ush dist = (distance); \
+ s->d_buf[s->last_lit] = dist; \
+ s->l_buf[s->last_lit++] = len; \
+ dist--; \
+ s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \
+ s->dyn_dtree[d_code(dist)].Freq++; \
+ flush = (s->last_lit == s->lit_bufsize-1); \
+ }
+#else
+# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c)
+# define _tr_tally_dist(s, distance, length, flush) \
+ flush = _tr_tally(s, distance, length)
+#endif
+
+#endif /* DEFLATE_H */
diff --git a/compat/zlib/doc/algorithm.txt b/compat/zlib/doc/algorithm.txt
new file mode 100644
index 0000000..c97f495
--- /dev/null
+++ b/compat/zlib/doc/algorithm.txt
@@ -0,0 +1,209 @@
+1. Compression algorithm (deflate)
+
+The deflation algorithm used by gzip (also zip and zlib) is a variation of
+LZ77 (Lempel-Ziv 1977, see reference below). It finds duplicated strings in
+the input data. The second occurrence of a string is replaced by a
+pointer to the previous string, in the form of a pair (distance,
+length). Distances are limited to 32K bytes, and lengths are limited
+to 258 bytes. When a string does not occur anywhere in the previous
+32K bytes, it is emitted as a sequence of literal bytes. (In this
+description, `string' must be taken as an arbitrary sequence of bytes,
+and is not restricted to printable characters.)
+
+Literals or match lengths are compressed with one Huffman tree, and
+match distances are compressed with another tree. The trees are stored
+in a compact form at the start of each block. The blocks can have any
+size (except that the compressed data for one block must fit in
+available memory). A block is terminated when deflate() determines that
+it would be useful to start another block with fresh trees. (This is
+somewhat similar to the behavior of LZW-based _compress_.)
+
+Duplicated strings are found using a hash table. All input strings of
+length 3 are inserted in the hash table. A hash index is computed for
+the next 3 bytes. If the hash chain for this index is not empty, all
+strings in the chain are compared with the current input string, and
+the longest match is selected.
+
+The hash chains are searched starting with the most recent strings, to
+favor small distances and thus take advantage of the Huffman encoding.
+The hash chains are singly linked. There are no deletions from the
+hash chains, the algorithm simply discards matches that are too old.
+
+To avoid a worst-case situation, very long hash chains are arbitrarily
+truncated at a certain length, determined by a runtime option (level
+parameter of deflateInit). So deflate() does not always find the longest
+possible match but generally finds a match which is long enough.
+
+deflate() also defers the selection of matches with a lazy evaluation
+mechanism. After a match of length N has been found, deflate() searches for
+a longer match at the next input byte. If a longer match is found, the
+previous match is truncated to a length of one (thus producing a single
+literal byte) and the process of lazy evaluation begins again. Otherwise,
+the original match is kept, and the next match search is attempted only N
+steps later.
+
+The lazy match evaluation is also subject to a runtime parameter. If
+the current match is long enough, deflate() reduces the search for a longer
+match, thus speeding up the whole process. If compression ratio is more
+important than speed, deflate() attempts a complete second search even if
+the first match is already long enough.
+
+The lazy match evaluation is not performed for the fastest compression
+modes (level parameter 1 to 3). For these fast modes, new strings
+are inserted in the hash table only when no match was found, or
+when the match is not too long. This degrades the compression ratio
+but saves time since there are both fewer insertions and fewer searches.
+
+
+2. Decompression algorithm (inflate)
+
+2.1 Introduction
+
+The key question is how to represent a Huffman code (or any prefix code) so
+that you can decode fast. The most important characteristic is that shorter
+codes are much more common than longer codes, so pay attention to decoding the
+short codes fast, and let the long codes take longer to decode.
+
+inflate() sets up a first level table that covers some number of bits of
+input less than the length of longest code. It gets that many bits from the
+stream, and looks it up in the table. The table will tell if the next
+code is that many bits or less and how many, and if it is, it will tell
+the value, else it will point to the next level table for which inflate()
+grabs more bits and tries to decode a longer code.
+
+How many bits to make the first lookup is a tradeoff between the time it
+takes to decode and the time it takes to build the table. If building the
+table took no time (and if you had infinite memory), then there would only
+be a first level table to cover all the way to the longest code. However,
+building the table ends up taking a lot longer for more bits since short
+codes are replicated many times in such a table. What inflate() does is
+simply to make the number of bits in the first table a variable, and then
+to set that variable for the maximum speed.
+
+For inflate, which has 286 possible codes for the literal/length tree, the size
+of the first table is nine bits. Also the distance trees have 30 possible
+values, and the size of the first table is six bits. Note that for each of
+those cases, the table ended up one bit longer than the ``average'' code
+length, i.e. the code length of an approximately flat code which would be a
+little more than eight bits for 286 symbols and a little less than five bits
+for 30 symbols.
+
+
+2.2 More details on the inflate table lookup
+
+Ok, you want to know what this cleverly obfuscated inflate tree actually
+looks like. You are correct that it's not a Huffman tree. It is simply a
+lookup table for the first, let's say, nine bits of a Huffman symbol. The
+symbol could be as short as one bit or as long as 15 bits. If a particular
+symbol is shorter than nine bits, then that symbol's translation is duplicated
+in all those entries that start with that symbol's bits. For example, if the
+symbol is four bits, then it's duplicated 32 times in a nine-bit table. If a
+symbol is nine bits long, it appears in the table once.
+
+If the symbol is longer than nine bits, then that entry in the table points
+to another similar table for the remaining bits. Again, there are duplicated
+entries as needed. The idea is that most of the time the symbol will be short
+and there will only be one table look up. (That's whole idea behind data
+compression in the first place.) For the less frequent long symbols, there
+will be two lookups. If you had a compression method with really long
+symbols, you could have as many levels of lookups as is efficient. For
+inflate, two is enough.
+
+So a table entry either points to another table (in which case nine bits in
+the above example are gobbled), or it contains the translation for the symbol
+and the number of bits to gobble. Then you start again with the next
+ungobbled bit.
+
+You may wonder: why not just have one lookup table for how ever many bits the
+longest symbol is? The reason is that if you do that, you end up spending
+more time filling in duplicate symbol entries than you do actually decoding.
+At least for deflate's output that generates new trees every several 10's of
+kbytes. You can imagine that filling in a 2^15 entry table for a 15-bit code
+would take too long if you're only decoding several thousand symbols. At the
+other extreme, you could make a new table for every bit in the code. In fact,
+that's essentially a Huffman tree. But then you spend too much time
+traversing the tree while decoding, even for short symbols.
+
+So the number of bits for the first lookup table is a trade of the time to
+fill out the table vs. the time spent looking at the second level and above of
+the table.
+
+Here is an example, scaled down:
+
+The code being decoded, with 10 symbols, from 1 to 6 bits long:
+
+A: 0
+B: 10
+C: 1100
+D: 11010
+E: 11011
+F: 11100
+G: 11101
+H: 11110
+I: 111110
+J: 111111
+
+Let's make the first table three bits long (eight entries):
+
+000: A,1
+001: A,1
+010: A,1
+011: A,1
+100: B,2
+101: B,2
+110: -> table X (gobble 3 bits)
+111: -> table Y (gobble 3 bits)
+
+Each entry is what the bits decode as and how many bits that is, i.e. how
+many bits to gobble. Or the entry points to another table, with the number of
+bits to gobble implicit in the size of the table.
+
+Table X is two bits long since the longest code starting with 110 is five bits
+long:
+
+00: C,1
+01: C,1
+10: D,2
+11: E,2
+
+Table Y is three bits long since the longest code starting with 111 is six
+bits long:
+
+000: F,2
+001: F,2
+010: G,2
+011: G,2
+100: H,2
+101: H,2
+110: I,3
+111: J,3
+
+So what we have here are three tables with a total of 20 entries that had to
+be constructed. That's compared to 64 entries for a single table. Or
+compared to 16 entries for a Huffman tree (six two entry tables and one four
+entry table). Assuming that the code ideally represents the probability of
+the symbols, it takes on the average 1.25 lookups per symbol. That's compared
+to one lookup for the single table, or 1.66 lookups per symbol for the
+Huffman tree.
+
+There, I think that gives you a picture of what's going on. For inflate, the
+meaning of a particular symbol is often more than just a letter. It can be a
+byte (a "literal"), or it can be either a length or a distance which
+indicates a base value and a number of bits to fetch after the code that is
+added to the base value. Or it might be the special end-of-block code. The
+data structures created in inftrees.c try to encode all that information
+compactly in the tables.
+
+
+Jean-loup Gailly Mark Adler
+jloup@gzip.org madler@alumni.caltech.edu
+
+
+References:
+
+[LZ77] Ziv J., Lempel A., ``A Universal Algorithm for Sequential Data
+Compression,'' IEEE Transactions on Information Theory, Vol. 23, No. 3,
+pp. 337-343.
+
+``DEFLATE Compressed Data Format Specification'' available in
+http://tools.ietf.org/html/rfc1951
diff --git a/compat/zlib/doc/rfc1950.txt b/compat/zlib/doc/rfc1950.txt
new file mode 100644
index 0000000..ce6428a
--- /dev/null
+++ b/compat/zlib/doc/rfc1950.txt
@@ -0,0 +1,619 @@
+
+
+
+
+
+
+Network Working Group P. Deutsch
+Request for Comments: 1950 Aladdin Enterprises
+Category: Informational J-L. Gailly
+ Info-ZIP
+ May 1996
+
+
+ ZLIB Compressed Data Format Specification version 3.3
+
+Status of This Memo
+
+ This memo provides information for the Internet community. This memo
+ does not specify an Internet standard of any kind. Distribution of
+ this memo is unlimited.
+
+IESG Note:
+
+ The IESG takes no position on the validity of any Intellectual
+ Property Rights statements contained in this document.
+
+Notices
+
+ Copyright (c) 1996 L. Peter Deutsch and Jean-Loup Gailly
+
+ Permission is granted to copy and distribute this document for any
+ purpose and without charge, including translations into other
+ languages and incorporation into compilations, provided that the
+ copyright notice and this notice are preserved, and that any
+ substantive changes or deletions from the original are clearly
+ marked.
+
+ A pointer to the latest version of this and related documentation in
+ HTML format can be found at the URL
+ <ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
+
+Abstract
+
+ This specification defines a lossless compressed data format. The
+ data can be produced or consumed, even for an arbitrarily long
+ sequentially presented input data stream, using only an a priori
+ bounded amount of intermediate storage. The format presently uses
+ the DEFLATE compression method but can be easily extended to use
+ other compression methods. It can be implemented readily in a manner
+ not covered by patents. This specification also defines the ADLER-32
+ checksum (an extension and improvement of the Fletcher checksum),
+ used for detection of data corruption, and provides an algorithm for
+ computing it.
+
+
+
+
+Deutsch & Gailly Informational [Page 1]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+Table of Contents
+
+ 1. Introduction ................................................... 2
+ 1.1. Purpose ................................................... 2
+ 1.2. Intended audience ......................................... 3
+ 1.3. Scope ..................................................... 3
+ 1.4. Compliance ................................................ 3
+ 1.5. Definitions of terms and conventions used ................ 3
+ 1.6. Changes from previous versions ............................ 3
+ 2. Detailed specification ......................................... 3
+ 2.1. Overall conventions ....................................... 3
+ 2.2. Data format ............................................... 4
+ 2.3. Compliance ................................................ 7
+ 3. References ..................................................... 7
+ 4. Source code .................................................... 8
+ 5. Security Considerations ........................................ 8
+ 6. Acknowledgements ............................................... 8
+ 7. Authors' Addresses ............................................. 8
+ 8. Appendix: Rationale ............................................ 9
+ 9. Appendix: Sample code ..........................................10
+
+1. Introduction
+
+ 1.1. Purpose
+
+ The purpose of this specification is to define a lossless
+ compressed data format that:
+
+ * Is independent of CPU type, operating system, file system,
+ and character set, and hence can be used for interchange;
+
+ * Can be produced or consumed, even for an arbitrarily long
+ sequentially presented input data stream, using only an a
+ priori bounded amount of intermediate storage, and hence can
+ be used in data communications or similar structures such as
+ Unix filters;
+
+ * Can use a number of different compression methods;
+
+ * Can be implemented readily in a manner not covered by
+ patents, and hence can be practiced freely.
+
+ The data format defined by this specification does not attempt to
+ allow random access to compressed data.
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 2]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ 1.2. Intended audience
+
+ This specification is intended for use by implementors of software
+ to compress data into zlib format and/or decompress data from zlib
+ format.
+
+ The text of the specification assumes a basic background in
+ programming at the level of bits and other primitive data
+ representations.
+
+ 1.3. Scope
+
+ The specification specifies a compressed data format that can be
+ used for in-memory compression of a sequence of arbitrary bytes.
+
+ 1.4. Compliance
+
+ Unless otherwise indicated below, a compliant decompressor must be
+ able to accept and decompress any data set that conforms to all
+ the specifications presented here; a compliant compressor must
+ produce data sets that conform to all the specifications presented
+ here.
+
+ 1.5. Definitions of terms and conventions used
+
+ byte: 8 bits stored or transmitted as a unit (same as an octet).
+ (For this specification, a byte is exactly 8 bits, even on
+ machines which store a character on a number of bits different
+ from 8.) See below, for the numbering of bits within a byte.
+
+ 1.6. Changes from previous versions
+
+ Version 3.1 was the first public release of this specification.
+ In version 3.2, some terminology was changed and the Adler-32
+ sample code was rewritten for clarity. In version 3.3, the
+ support for a preset dictionary was introduced, and the
+ specification was converted to RFC style.
+
+2. Detailed specification
+
+ 2.1. Overall conventions
+
+ In the diagrams below, a box like this:
+
+ +---+
+ | | <-- the vertical bars might be missing
+ +---+
+
+
+
+
+Deutsch & Gailly Informational [Page 3]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ represents one byte; a box like this:
+
+ +==============+
+ | |
+ +==============+
+
+ represents a variable number of bytes.
+
+ Bytes stored within a computer do not have a "bit order", since
+ they are always treated as a unit. However, a byte considered as
+ an integer between 0 and 255 does have a most- and least-
+ significant bit, and since we write numbers with the most-
+ significant digit on the left, we also write bytes with the most-
+ significant bit on the left. In the diagrams below, we number the
+ bits of a byte so that bit 0 is the least-significant bit, i.e.,
+ the bits are numbered:
+
+ +--------+
+ |76543210|
+ +--------+
+
+ Within a computer, a number may occupy multiple bytes. All
+ multi-byte numbers in the format described here are stored with
+ the MOST-significant byte first (at the lower memory address).
+ For example, the decimal number 520 is stored as:
+
+ 0 1
+ +--------+--------+
+ |00000010|00001000|
+ +--------+--------+
+ ^ ^
+ | |
+ | + less significant byte = 8
+ + more significant byte = 2 x 256
+
+ 2.2. Data format
+
+ A zlib stream has the following structure:
+
+ 0 1
+ +---+---+
+ |CMF|FLG| (more-->)
+ +---+---+
+
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 4]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ (if FLG.FDICT set)
+
+ 0 1 2 3
+ +---+---+---+---+
+ | DICTID | (more-->)
+ +---+---+---+---+
+
+ +=====================+---+---+---+---+
+ |...compressed data...| ADLER32 |
+ +=====================+---+---+---+---+
+
+ Any data which may appear after ADLER32 are not part of the zlib
+ stream.
+
+ CMF (Compression Method and flags)
+ This byte is divided into a 4-bit compression method and a 4-
+ bit information field depending on the compression method.
+
+ bits 0 to 3 CM Compression method
+ bits 4 to 7 CINFO Compression info
+
+ CM (Compression method)
+ This identifies the compression method used in the file. CM = 8
+ denotes the "deflate" compression method with a window size up
+ to 32K. This is the method used by gzip and PNG (see
+ references [1] and [2] in Chapter 3, below, for the reference
+ documents). CM = 15 is reserved. It might be used in a future
+ version of this specification to indicate the presence of an
+ extra field before the compressed data.
+
+ CINFO (Compression info)
+ For CM = 8, CINFO is the base-2 logarithm of the LZ77 window
+ size, minus eight (CINFO=7 indicates a 32K window size). Values
+ of CINFO above 7 are not allowed in this version of the
+ specification. CINFO is not defined in this specification for
+ CM not equal to 8.
+
+ FLG (FLaGs)
+ This flag byte is divided as follows:
+
+ bits 0 to 4 FCHECK (check bits for CMF and FLG)
+ bit 5 FDICT (preset dictionary)
+ bits 6 to 7 FLEVEL (compression level)
+
+ The FCHECK value must be such that CMF and FLG, when viewed as
+ a 16-bit unsigned integer stored in MSB order (CMF*256 + FLG),
+ is a multiple of 31.
+
+
+
+
+Deutsch & Gailly Informational [Page 5]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ FDICT (Preset dictionary)
+ If FDICT is set, a DICT dictionary identifier is present
+ immediately after the FLG byte. The dictionary is a sequence of
+ bytes which are initially fed to the compressor without
+ producing any compressed output. DICT is the Adler-32 checksum
+ of this sequence of bytes (see the definition of ADLER32
+ below). The decompressor can use this identifier to determine
+ which dictionary has been used by the compressor.
+
+ FLEVEL (Compression level)
+ These flags are available for use by specific compression
+ methods. The "deflate" method (CM = 8) sets these flags as
+ follows:
+
+ 0 - compressor used fastest algorithm
+ 1 - compressor used fast algorithm
+ 2 - compressor used default algorithm
+ 3 - compressor used maximum compression, slowest algorithm
+
+ The information in FLEVEL is not needed for decompression; it
+ is there to indicate if recompression might be worthwhile.
+
+ compressed data
+ For compression method 8, the compressed data is stored in the
+ deflate compressed data format as described in the document
+ "DEFLATE Compressed Data Format Specification" by L. Peter
+ Deutsch. (See reference [3] in Chapter 3, below)
+
+ Other compressed data formats are not specified in this version
+ of the zlib specification.
+
+ ADLER32 (Adler-32 checksum)
+ This contains a checksum value of the uncompressed data
+ (excluding any dictionary data) computed according to Adler-32
+ algorithm. This algorithm is a 32-bit extension and improvement
+ of the Fletcher algorithm, used in the ITU-T X.224 / ISO 8073
+ standard. See references [4] and [5] in Chapter 3, below)
+
+ Adler-32 is composed of two sums accumulated per byte: s1 is
+ the sum of all bytes, s2 is the sum of all s1 values. Both sums
+ are done modulo 65521. s1 is initialized to 1, s2 to zero. The
+ Adler-32 checksum is stored as s2*65536 + s1 in most-
+ significant-byte first (network) order.
+
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 6]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ 2.3. Compliance
+
+ A compliant compressor must produce streams with correct CMF, FLG
+ and ADLER32, but need not support preset dictionaries. When the
+ zlib data format is used as part of another standard data format,
+ the compressor may use only preset dictionaries that are specified
+ by this other data format. If this other format does not use the
+ preset dictionary feature, the compressor must not set the FDICT
+ flag.
+
+ A compliant decompressor must check CMF, FLG, and ADLER32, and
+ provide an error indication if any of these have incorrect values.
+ A compliant decompressor must give an error indication if CM is
+ not one of the values defined in this specification (only the
+ value 8 is permitted in this version), since another value could
+ indicate the presence of new features that would cause subsequent
+ data to be interpreted incorrectly. A compliant decompressor must
+ give an error indication if FDICT is set and DICTID is not the
+ identifier of a known preset dictionary. A decompressor may
+ ignore FLEVEL and still be compliant. When the zlib data format
+ is being used as a part of another standard format, a compliant
+ decompressor must support all the preset dictionaries specified by
+ the other format. When the other format does not use the preset
+ dictionary feature, a compliant decompressor must reject any
+ stream in which the FDICT flag is set.
+
+3. References
+
+ [1] Deutsch, L.P.,"GZIP Compressed Data Format Specification",
+ available in ftp://ftp.uu.net/pub/archiving/zip/doc/
+
+ [2] Thomas Boutell, "PNG (Portable Network Graphics) specification",
+ available in ftp://ftp.uu.net/graphics/png/documents/
+
+ [3] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification",
+ available in ftp://ftp.uu.net/pub/archiving/zip/doc/
+
+ [4] Fletcher, J. G., "An Arithmetic Checksum for Serial
+ Transmissions," IEEE Transactions on Communications, Vol. COM-30,
+ No. 1, January 1982, pp. 247-252.
+
+ [5] ITU-T Recommendation X.224, Annex D, "Checksum Algorithms,"
+ November, 1993, pp. 144, 145. (Available from
+ gopher://info.itu.ch). ITU-T X.244 is also the same as ISO 8073.
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 7]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+4. Source code
+
+ Source code for a C language implementation of a "zlib" compliant
+ library is available at ftp://ftp.uu.net/pub/archiving/zip/zlib/.
+
+5. Security Considerations
+
+ A decoder that fails to check the ADLER32 checksum value may be
+ subject to undetected data corruption.
+
+6. Acknowledgements
+
+ Trademarks cited in this document are the property of their
+ respective owners.
+
+ Jean-Loup Gailly and Mark Adler designed the zlib format and wrote
+ the related software described in this specification. Glenn
+ Randers-Pehrson converted this document to RFC and HTML format.
+
+7. Authors' Addresses
+
+ L. Peter Deutsch
+ Aladdin Enterprises
+ 203 Santa Margarita Ave.
+ Menlo Park, CA 94025
+
+ Phone: (415) 322-0103 (AM only)
+ FAX: (415) 322-1734
+ EMail: <ghost@aladdin.com>
+
+
+ Jean-Loup Gailly
+
+ EMail: <gzip@prep.ai.mit.edu>
+
+ Questions about the technical content of this specification can be
+ sent by email to
+
+ Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
+ Mark Adler <madler@alumni.caltech.edu>
+
+ Editorial comments on this specification can be sent by email to
+
+ L. Peter Deutsch <ghost@aladdin.com> and
+ Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 8]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+8. Appendix: Rationale
+
+ 8.1. Preset dictionaries
+
+ A preset dictionary is specially useful to compress short input
+ sequences. The compressor can take advantage of the dictionary
+ context to encode the input in a more compact manner. The
+ decompressor can be initialized with the appropriate context by
+ virtually decompressing a compressed version of the dictionary
+ without producing any output. However for certain compression
+ algorithms such as the deflate algorithm this operation can be
+ achieved without actually performing any decompression.
+
+ The compressor and the decompressor must use exactly the same
+ dictionary. The dictionary may be fixed or may be chosen among a
+ certain number of predefined dictionaries, according to the kind
+ of input data. The decompressor can determine which dictionary has
+ been chosen by the compressor by checking the dictionary
+ identifier. This document does not specify the contents of
+ predefined dictionaries, since the optimal dictionaries are
+ application specific. Standard data formats using this feature of
+ the zlib specification must precisely define the allowed
+ dictionaries.
+
+ 8.2. The Adler-32 algorithm
+
+ The Adler-32 algorithm is much faster than the CRC32 algorithm yet
+ still provides an extremely low probability of undetected errors.
+
+ The modulo on unsigned long accumulators can be delayed for 5552
+ bytes, so the modulo operation time is negligible. If the bytes
+ are a, b, c, the second sum is 3a + 2b + c + 3, and so is position
+ and order sensitive, unlike the first sum, which is just a
+ checksum. That 65521 is prime is important to avoid a possible
+ large class of two-byte errors that leave the check unchanged.
+ (The Fletcher checksum uses 255, which is not prime and which also
+ makes the Fletcher check insensitive to single byte changes 0 <->
+ 255.)
+
+ The sum s1 is initialized to 1 instead of zero to make the length
+ of the sequence part of s2, so that the length does not have to be
+ checked separately. (Any sequence of zeroes has a Fletcher
+ checksum of zero.)
+
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 9]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+9. Appendix: Sample code
+
+ The following C code computes the Adler-32 checksum of a data buffer.
+ It is written for clarity, not for speed. The sample code is in the
+ ANSI C programming language. Non C users may find it easier to read
+ with these hints:
+
+ & Bitwise AND operator.
+ >> Bitwise right shift operator. When applied to an
+ unsigned quantity, as here, right shift inserts zero bit(s)
+ at the left.
+ << Bitwise left shift operator. Left shift inserts zero
+ bit(s) at the right.
+ ++ "n++" increments the variable n.
+ % modulo operator: a % b is the remainder of a divided by b.
+
+ #define BASE 65521 /* largest prime smaller than 65536 */
+
+ /*
+ Update a running Adler-32 checksum with the bytes buf[0..len-1]
+ and return the updated checksum. The Adler-32 checksum should be
+ initialized to 1.
+
+ Usage example:
+
+ unsigned long adler = 1L;
+
+ while (read_buffer(buffer, length) != EOF) {
+ adler = update_adler32(adler, buffer, length);
+ }
+ if (adler != original_adler) error();
+ */
+ unsigned long update_adler32(unsigned long adler,
+ unsigned char *buf, int len)
+ {
+ unsigned long s1 = adler & 0xffff;
+ unsigned long s2 = (adler >> 16) & 0xffff;
+ int n;
+
+ for (n = 0; n < len; n++) {
+ s1 = (s1 + buf[n]) % BASE;
+ s2 = (s2 + s1) % BASE;
+ }
+ return (s2 << 16) + s1;
+ }
+
+ /* Return the adler32 of the bytes buf[0..len-1] */
+
+
+
+
+Deutsch & Gailly Informational [Page 10]
+
+RFC 1950 ZLIB Compressed Data Format Specification May 1996
+
+
+ unsigned long adler32(unsigned char *buf, int len)
+ {
+ return update_adler32(1L, buf, len);
+ }
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Deutsch & Gailly Informational [Page 11]
+
diff --git a/compat/zlib/doc/rfc1951.txt b/compat/zlib/doc/rfc1951.txt
new file mode 100644
index 0000000..403c8c7
--- /dev/null
+++ b/compat/zlib/doc/rfc1951.txt
@@ -0,0 +1,955 @@
+
+
+
+
+
+
+Network Working Group P. Deutsch
+Request for Comments: 1951 Aladdin Enterprises
+Category: Informational May 1996
+
+
+ DEFLATE Compressed Data Format Specification version 1.3
+
+Status of This Memo
+
+ This memo provides information for the Internet community. This memo
+ does not specify an Internet standard of any kind. Distribution of
+ this memo is unlimited.
+
+IESG Note:
+
+ The IESG takes no position on the validity of any Intellectual
+ Property Rights statements contained in this document.
+
+Notices
+
+ Copyright (c) 1996 L. Peter Deutsch
+
+ Permission is granted to copy and distribute this document for any
+ purpose and without charge, including translations into other
+ languages and incorporation into compilations, provided that the
+ copyright notice and this notice are preserved, and that any
+ substantive changes or deletions from the original are clearly
+ marked.
+
+ A pointer to the latest version of this and related documentation in
+ HTML format can be found at the URL
+ <ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
+
+Abstract
+
+ This specification defines a lossless compressed data format that
+ compresses data using a combination of the LZ77 algorithm and Huffman
+ coding, with efficiency comparable to the best currently available
+ general-purpose compression methods. The data can be produced or
+ consumed, even for an arbitrarily long sequentially presented input
+ data stream, using only an a priori bounded amount of intermediate
+ storage. The format can be implemented readily in a manner not
+ covered by patents.
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 1]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+Table of Contents
+
+ 1. Introduction ................................................... 2
+ 1.1. Purpose ................................................... 2
+ 1.2. Intended audience ......................................... 3
+ 1.3. Scope ..................................................... 3
+ 1.4. Compliance ................................................ 3
+ 1.5. Definitions of terms and conventions used ................ 3
+ 1.6. Changes from previous versions ............................ 4
+ 2. Compressed representation overview ............................. 4
+ 3. Detailed specification ......................................... 5
+ 3.1. Overall conventions ....................................... 5
+ 3.1.1. Packing into bytes .................................. 5
+ 3.2. Compressed block format ................................... 6
+ 3.2.1. Synopsis of prefix and Huffman coding ............... 6
+ 3.2.2. Use of Huffman coding in the "deflate" format ....... 7
+ 3.2.3. Details of block format ............................. 9
+ 3.2.4. Non-compressed blocks (BTYPE=00) ................... 11
+ 3.2.5. Compressed blocks (length and distance codes) ...... 11
+ 3.2.6. Compression with fixed Huffman codes (BTYPE=01) .... 12
+ 3.2.7. Compression with dynamic Huffman codes (BTYPE=10) .. 13
+ 3.3. Compliance ............................................... 14
+ 4. Compression algorithm details ................................. 14
+ 5. References .................................................... 16
+ 6. Security Considerations ....................................... 16
+ 7. Source code ................................................... 16
+ 8. Acknowledgements .............................................. 16
+ 9. Author's Address .............................................. 17
+
+1. Introduction
+
+ 1.1. Purpose
+
+ The purpose of this specification is to define a lossless
+ compressed data format that:
+ * Is independent of CPU type, operating system, file system,
+ and character set, and hence can be used for interchange;
+ * Can be produced or consumed, even for an arbitrarily long
+ sequentially presented input data stream, using only an a
+ priori bounded amount of intermediate storage, and hence
+ can be used in data communications or similar structures
+ such as Unix filters;
+ * Compresses data with efficiency comparable to the best
+ currently available general-purpose compression methods,
+ and in particular considerably better than the "compress"
+ program;
+ * Can be implemented readily in a manner not covered by
+ patents, and hence can be practiced freely;
+
+
+
+Deutsch Informational [Page 2]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ * Is compatible with the file format produced by the current
+ widely used gzip utility, in that conforming decompressors
+ will be able to read data produced by the existing gzip
+ compressor.
+
+ The data format defined by this specification does not attempt to:
+
+ * Allow random access to compressed data;
+ * Compress specialized data (e.g., raster graphics) as well
+ as the best currently available specialized algorithms.
+
+ A simple counting argument shows that no lossless compression
+ algorithm can compress every possible input data set. For the
+ format defined here, the worst case expansion is 5 bytes per 32K-
+ byte block, i.e., a size increase of 0.015% for large data sets.
+ English text usually compresses by a factor of 2.5 to 3;
+ executable files usually compress somewhat less; graphical data
+ such as raster images may compress much more.
+
+ 1.2. Intended audience
+
+ This specification is intended for use by implementors of software
+ to compress data into "deflate" format and/or decompress data from
+ "deflate" format.
+
+ The text of the specification assumes a basic background in
+ programming at the level of bits and other primitive data
+ representations. Familiarity with the technique of Huffman coding
+ is helpful but not required.
+
+ 1.3. Scope
+
+ The specification specifies a method for representing a sequence
+ of bytes as a (usually shorter) sequence of bits, and a method for
+ packing the latter bit sequence into bytes.
+
+ 1.4. Compliance
+
+ Unless otherwise indicated below, a compliant decompressor must be
+ able to accept and decompress any data set that conforms to all
+ the specifications presented here; a compliant compressor must
+ produce data sets that conform to all the specifications presented
+ here.
+
+ 1.5. Definitions of terms and conventions used
+
+ Byte: 8 bits stored or transmitted as a unit (same as an octet).
+ For this specification, a byte is exactly 8 bits, even on machines
+
+
+
+Deutsch Informational [Page 3]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ which store a character on a number of bits different from eight.
+ See below, for the numbering of bits within a byte.
+
+ String: a sequence of arbitrary bytes.
+
+ 1.6. Changes from previous versions
+
+ There have been no technical changes to the deflate format since
+ version 1.1 of this specification. In version 1.2, some
+ terminology was changed. Version 1.3 is a conversion of the
+ specification to RFC style.
+
+2. Compressed representation overview
+
+ A compressed data set consists of a series of blocks, corresponding
+ to successive blocks of input data. The block sizes are arbitrary,
+ except that non-compressible blocks are limited to 65,535 bytes.
+
+ Each block is compressed using a combination of the LZ77 algorithm
+ and Huffman coding. The Huffman trees for each block are independent
+ of those for previous or subsequent blocks; the LZ77 algorithm may
+ use a reference to a duplicated string occurring in a previous block,
+ up to 32K input bytes before.
+
+ Each block consists of two parts: a pair of Huffman code trees that
+ describe the representation of the compressed data part, and a
+ compressed data part. (The Huffman trees themselves are compressed
+ using Huffman encoding.) The compressed data consists of a series of
+ elements of two types: literal bytes (of strings that have not been
+ detected as duplicated within the previous 32K input bytes), and
+ pointers to duplicated strings, where a pointer is represented as a
+ pair <length, backward distance>. The representation used in the
+ "deflate" format limits distances to 32K bytes and lengths to 258
+ bytes, but does not limit the size of a block, except for
+ uncompressible blocks, which are limited as noted above.
+
+ Each type of value (literals, distances, and lengths) in the
+ compressed data is represented using a Huffman code, using one code
+ tree for literals and lengths and a separate code tree for distances.
+ The code trees for each block appear in a compact form just before
+ the compressed data for that block.
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 4]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+3. Detailed specification
+
+ 3.1. Overall conventions In the diagrams below, a box like this:
+
+ +---+
+ | | <-- the vertical bars might be missing
+ +---+
+
+ represents one byte; a box like this:
+
+ +==============+
+ | |
+ +==============+
+
+ represents a variable number of bytes.
+
+ Bytes stored within a computer do not have a "bit order", since
+ they are always treated as a unit. However, a byte considered as
+ an integer between 0 and 255 does have a most- and least-
+ significant bit, and since we write numbers with the most-
+ significant digit on the left, we also write bytes with the most-
+ significant bit on the left. In the diagrams below, we number the
+ bits of a byte so that bit 0 is the least-significant bit, i.e.,
+ the bits are numbered:
+
+ +--------+
+ |76543210|
+ +--------+
+
+ Within a computer, a number may occupy multiple bytes. All
+ multi-byte numbers in the format described here are stored with
+ the least-significant byte first (at the lower memory address).
+ For example, the decimal number 520 is stored as:
+
+ 0 1
+ +--------+--------+
+ |00001000|00000010|
+ +--------+--------+
+ ^ ^
+ | |
+ | + more significant byte = 2 x 256
+ + less significant byte = 8
+
+ 3.1.1. Packing into bytes
+
+ This document does not address the issue of the order in which
+ bits of a byte are transmitted on a bit-sequential medium,
+ since the final data format described here is byte- rather than
+
+
+
+Deutsch Informational [Page 5]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ bit-oriented. However, we describe the compressed block format
+ in below, as a sequence of data elements of various bit
+ lengths, not a sequence of bytes. We must therefore specify
+ how to pack these data elements into bytes to form the final
+ compressed byte sequence:
+
+ * Data elements are packed into bytes in order of
+ increasing bit number within the byte, i.e., starting
+ with the least-significant bit of the byte.
+ * Data elements other than Huffman codes are packed
+ starting with the least-significant bit of the data
+ element.
+ * Huffman codes are packed starting with the most-
+ significant bit of the code.
+
+ In other words, if one were to print out the compressed data as
+ a sequence of bytes, starting with the first byte at the
+ *right* margin and proceeding to the *left*, with the most-
+ significant bit of each byte on the left as usual, one would be
+ able to parse the result from right to left, with fixed-width
+ elements in the correct MSB-to-LSB order and Huffman codes in
+ bit-reversed order (i.e., with the first bit of the code in the
+ relative LSB position).
+
+ 3.2. Compressed block format
+
+ 3.2.1. Synopsis of prefix and Huffman coding
+
+ Prefix coding represents symbols from an a priori known
+ alphabet by bit sequences (codes), one code for each symbol, in
+ a manner such that different symbols may be represented by bit
+ sequences of different lengths, but a parser can always parse
+ an encoded string unambiguously symbol-by-symbol.
+
+ We define a prefix code in terms of a binary tree in which the
+ two edges descending from each non-leaf node are labeled 0 and
+ 1 and in which the leaf nodes correspond one-for-one with (are
+ labeled with) the symbols of the alphabet; then the code for a
+ symbol is the sequence of 0's and 1's on the edges leading from
+ the root to the leaf labeled with that symbol. For example:
+
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 6]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ /\ Symbol Code
+ 0 1 ------ ----
+ / \ A 00
+ /\ B B 1
+ 0 1 C 011
+ / \ D 010
+ A /\
+ 0 1
+ / \
+ D C
+
+ A parser can decode the next symbol from an encoded input
+ stream by walking down the tree from the root, at each step
+ choosing the edge corresponding to the next input bit.
+
+ Given an alphabet with known symbol frequencies, the Huffman
+ algorithm allows the construction of an optimal prefix code
+ (one which represents strings with those symbol frequencies
+ using the fewest bits of any possible prefix codes for that
+ alphabet). Such a code is called a Huffman code. (See
+ reference [1] in Chapter 5, references for additional
+ information on Huffman codes.)
+
+ Note that in the "deflate" format, the Huffman codes for the
+ various alphabets must not exceed certain maximum code lengths.
+ This constraint complicates the algorithm for computing code
+ lengths from symbol frequencies. Again, see Chapter 5,
+ references for details.
+
+ 3.2.2. Use of Huffman coding in the "deflate" format
+
+ The Huffman codes used for each alphabet in the "deflate"
+ format have two additional rules:
+
+ * All codes of a given bit length have lexicographically
+ consecutive values, in the same order as the symbols
+ they represent;
+
+ * Shorter codes lexicographically precede longer codes.
+
+
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 7]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ We could recode the example above to follow this rule as
+ follows, assuming that the order of the alphabet is ABCD:
+
+ Symbol Code
+ ------ ----
+ A 10
+ B 0
+ C 110
+ D 111
+
+ I.e., 0 precedes 10 which precedes 11x, and 110 and 111 are
+ lexicographically consecutive.
+
+ Given this rule, we can define the Huffman code for an alphabet
+ just by giving the bit lengths of the codes for each symbol of
+ the alphabet in order; this is sufficient to determine the
+ actual codes. In our example, the code is completely defined
+ by the sequence of bit lengths (2, 1, 3, 3). The following
+ algorithm generates the codes as integers, intended to be read
+ from most- to least-significant bit. The code lengths are
+ initially in tree[I].Len; the codes are produced in
+ tree[I].Code.
+
+ 1) Count the number of codes for each code length. Let
+ bl_count[N] be the number of codes of length N, N >= 1.
+
+ 2) Find the numerical value of the smallest code for each
+ code length:
+
+ code = 0;
+ bl_count[0] = 0;
+ for (bits = 1; bits <= MAX_BITS; bits++) {
+ code = (code + bl_count[bits-1]) << 1;
+ next_code[bits] = code;
+ }
+
+ 3) Assign numerical values to all codes, using consecutive
+ values for all codes of the same length with the base
+ values determined at step 2. Codes that are never used
+ (which have a bit length of zero) must not be assigned a
+ value.
+
+ for (n = 0; n <= max_code; n++) {
+ len = tree[n].Len;
+ if (len != 0) {
+ tree[n].Code = next_code[len];
+ next_code[len]++;
+ }
+
+
+
+Deutsch Informational [Page 8]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ }
+
+ Example:
+
+ Consider the alphabet ABCDEFGH, with bit lengths (3, 3, 3, 3,
+ 3, 2, 4, 4). After step 1, we have:
+
+ N bl_count[N]
+ - -----------
+ 2 1
+ 3 5
+ 4 2
+
+ Step 2 computes the following next_code values:
+
+ N next_code[N]
+ - ------------
+ 1 0
+ 2 0
+ 3 2
+ 4 14
+
+ Step 3 produces the following code values:
+
+ Symbol Length Code
+ ------ ------ ----
+ A 3 010
+ B 3 011
+ C 3 100
+ D 3 101
+ E 3 110
+ F 2 00
+ G 4 1110
+ H 4 1111
+
+ 3.2.3. Details of block format
+
+ Each block of compressed data begins with 3 header bits
+ containing the following data:
+
+ first bit BFINAL
+ next 2 bits BTYPE
+
+ Note that the header bits do not necessarily begin on a byte
+ boundary, since a block does not necessarily occupy an integral
+ number of bytes.
+
+
+
+
+
+Deutsch Informational [Page 9]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ BFINAL is set if and only if this is the last block of the data
+ set.
+
+ BTYPE specifies how the data are compressed, as follows:
+
+ 00 - no compression
+ 01 - compressed with fixed Huffman codes
+ 10 - compressed with dynamic Huffman codes
+ 11 - reserved (error)
+
+ The only difference between the two compressed cases is how the
+ Huffman codes for the literal/length and distance alphabets are
+ defined.
+
+ In all cases, the decoding algorithm for the actual data is as
+ follows:
+
+ do
+ read block header from input stream.
+ if stored with no compression
+ skip any remaining bits in current partially
+ processed byte
+ read LEN and NLEN (see next section)
+ copy LEN bytes of data to output
+ otherwise
+ if compressed with dynamic Huffman codes
+ read representation of code trees (see
+ subsection below)
+ loop (until end of block code recognized)
+ decode literal/length value from input stream
+ if value < 256
+ copy value (literal byte) to output stream
+ otherwise
+ if value = end of block (256)
+ break from loop
+ otherwise (value = 257..285)
+ decode distance from input stream
+
+ move backwards distance bytes in the output
+ stream, and copy length bytes from this
+ position to the output stream.
+ end loop
+ while not last block
+
+ Note that a duplicated string reference may refer to a string
+ in a previous block; i.e., the backward distance may cross one
+ or more block boundaries. However a distance cannot refer past
+ the beginning of the output stream. (An application using a
+
+
+
+Deutsch Informational [Page 10]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ preset dictionary might discard part of the output stream; a
+ distance can refer to that part of the output stream anyway)
+ Note also that the referenced string may overlap the current
+ position; for example, if the last 2 bytes decoded have values
+ X and Y, a string reference with <length = 5, distance = 2>
+ adds X,Y,X,Y,X to the output stream.
+
+ We now specify each compression method in turn.
+
+ 3.2.4. Non-compressed blocks (BTYPE=00)
+
+ Any bits of input up to the next byte boundary are ignored.
+ The rest of the block consists of the following information:
+
+ 0 1 2 3 4...
+ +---+---+---+---+================================+
+ | LEN | NLEN |... LEN bytes of literal data...|
+ +---+---+---+---+================================+
+
+ LEN is the number of data bytes in the block. NLEN is the
+ one's complement of LEN.
+
+ 3.2.5. Compressed blocks (length and distance codes)
+
+ As noted above, encoded data blocks in the "deflate" format
+ consist of sequences of symbols drawn from three conceptually
+ distinct alphabets: either literal bytes, from the alphabet of
+ byte values (0..255), or <length, backward distance> pairs,
+ where the length is drawn from (3..258) and the distance is
+ drawn from (1..32,768). In fact, the literal and length
+ alphabets are merged into a single alphabet (0..285), where
+ values 0..255 represent literal bytes, the value 256 indicates
+ end-of-block, and values 257..285 represent length codes
+ (possibly in conjunction with extra bits following the symbol
+ code) as follows:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 11]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ Extra Extra Extra
+ Code Bits Length(s) Code Bits Lengths Code Bits Length(s)
+ ---- ---- ------ ---- ---- ------- ---- ---- -------
+ 257 0 3 267 1 15,16 277 4 67-82
+ 258 0 4 268 1 17,18 278 4 83-98
+ 259 0 5 269 2 19-22 279 4 99-114
+ 260 0 6 270 2 23-26 280 4 115-130
+ 261 0 7 271 2 27-30 281 5 131-162
+ 262 0 8 272 2 31-34 282 5 163-194
+ 263 0 9 273 3 35-42 283 5 195-226
+ 264 0 10 274 3 43-50 284 5 227-257
+ 265 1 11,12 275 3 51-58 285 0 258
+ 266 1 13,14 276 3 59-66
+
+ The extra bits should be interpreted as a machine integer
+ stored with the most-significant bit first, e.g., bits 1110
+ represent the value 14.
+
+ Extra Extra Extra
+ Code Bits Dist Code Bits Dist Code Bits Distance
+ ---- ---- ---- ---- ---- ------ ---- ---- --------
+ 0 0 1 10 4 33-48 20 9 1025-1536
+ 1 0 2 11 4 49-64 21 9 1537-2048
+ 2 0 3 12 5 65-96 22 10 2049-3072
+ 3 0 4 13 5 97-128 23 10 3073-4096
+ 4 1 5,6 14 6 129-192 24 11 4097-6144
+ 5 1 7,8 15 6 193-256 25 11 6145-8192
+ 6 2 9-12 16 7 257-384 26 12 8193-12288
+ 7 2 13-16 17 7 385-512 27 12 12289-16384
+ 8 3 17-24 18 8 513-768 28 13 16385-24576
+ 9 3 25-32 19 8 769-1024 29 13 24577-32768
+
+ 3.2.6. Compression with fixed Huffman codes (BTYPE=01)
+
+ The Huffman codes for the two alphabets are fixed, and are not
+ represented explicitly in the data. The Huffman code lengths
+ for the literal/length alphabet are:
+
+ Lit Value Bits Codes
+ --------- ---- -----
+ 0 - 143 8 00110000 through
+ 10111111
+ 144 - 255 9 110010000 through
+ 111111111
+ 256 - 279 7 0000000 through
+ 0010111
+ 280 - 287 8 11000000 through
+ 11000111
+
+
+
+Deutsch Informational [Page 12]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ The code lengths are sufficient to generate the actual codes,
+ as described above; we show the codes in the table for added
+ clarity. Literal/length values 286-287 will never actually
+ occur in the compressed data, but participate in the code
+ construction.
+
+ Distance codes 0-31 are represented by (fixed-length) 5-bit
+ codes, with possible additional bits as shown in the table
+ shown in Paragraph 3.2.5, above. Note that distance codes 30-
+ 31 will never actually occur in the compressed data.
+
+ 3.2.7. Compression with dynamic Huffman codes (BTYPE=10)
+
+ The Huffman codes for the two alphabets appear in the block
+ immediately after the header bits and before the actual
+ compressed data, first the literal/length code and then the
+ distance code. Each code is defined by a sequence of code
+ lengths, as discussed in Paragraph 3.2.2, above. For even
+ greater compactness, the code length sequences themselves are
+ compressed using a Huffman code. The alphabet for code lengths
+ is as follows:
+
+ 0 - 15: Represent code lengths of 0 - 15
+ 16: Copy the previous code length 3 - 6 times.
+ The next 2 bits indicate repeat length
+ (0 = 3, ... , 3 = 6)
+ Example: Codes 8, 16 (+2 bits 11),
+ 16 (+2 bits 10) will expand to
+ 12 code lengths of 8 (1 + 6 + 5)
+ 17: Repeat a code length of 0 for 3 - 10 times.
+ (3 bits of length)
+ 18: Repeat a code length of 0 for 11 - 138 times
+ (7 bits of length)
+
+ A code length of 0 indicates that the corresponding symbol in
+ the literal/length or distance alphabet will not occur in the
+ block, and should not participate in the Huffman code
+ construction algorithm given earlier. If only one distance
+ code is used, it is encoded using one bit, not zero bits; in
+ this case there is a single code length of one, with one unused
+ code. One distance code of zero bits means that there are no
+ distance codes used at all (the data is all literals).
+
+ We can now define the format of the block:
+
+ 5 Bits: HLIT, # of Literal/Length codes - 257 (257 - 286)
+ 5 Bits: HDIST, # of Distance codes - 1 (1 - 32)
+ 4 Bits: HCLEN, # of Code Length codes - 4 (4 - 19)
+
+
+
+Deutsch Informational [Page 13]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ (HCLEN + 4) x 3 bits: code lengths for the code length
+ alphabet given just above, in the order: 16, 17, 18,
+ 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15
+
+ These code lengths are interpreted as 3-bit integers
+ (0-7); as above, a code length of 0 means the
+ corresponding symbol (literal/length or distance code
+ length) is not used.
+
+ HLIT + 257 code lengths for the literal/length alphabet,
+ encoded using the code length Huffman code
+
+ HDIST + 1 code lengths for the distance alphabet,
+ encoded using the code length Huffman code
+
+ The actual compressed data of the block,
+ encoded using the literal/length and distance Huffman
+ codes
+
+ The literal/length symbol 256 (end of data),
+ encoded using the literal/length Huffman code
+
+ The code length repeat codes can cross from HLIT + 257 to the
+ HDIST + 1 code lengths. In other words, all code lengths form
+ a single sequence of HLIT + HDIST + 258 values.
+
+ 3.3. Compliance
+
+ A compressor may limit further the ranges of values specified in
+ the previous section and still be compliant; for example, it may
+ limit the range of backward pointers to some value smaller than
+ 32K. Similarly, a compressor may limit the size of blocks so that
+ a compressible block fits in memory.
+
+ A compliant decompressor must accept the full range of possible
+ values defined in the previous section, and must accept blocks of
+ arbitrary size.
+
+4. Compression algorithm details
+
+ While it is the intent of this document to define the "deflate"
+ compressed data format without reference to any particular
+ compression algorithm, the format is related to the compressed
+ formats produced by LZ77 (Lempel-Ziv 1977, see reference [2] below);
+ since many variations of LZ77 are patented, it is strongly
+ recommended that the implementor of a compressor follow the general
+ algorithm presented here, which is known not to be patented per se.
+ The material in this section is not part of the definition of the
+
+
+
+Deutsch Informational [Page 14]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+ specification per se, and a compressor need not follow it in order to
+ be compliant.
+
+ The compressor terminates a block when it determines that starting a
+ new block with fresh trees would be useful, or when the block size
+ fills up the compressor's block buffer.
+
+ The compressor uses a chained hash table to find duplicated strings,
+ using a hash function that operates on 3-byte sequences. At any
+ given point during compression, let XYZ be the next 3 input bytes to
+ be examined (not necessarily all different, of course). First, the
+ compressor examines the hash chain for XYZ. If the chain is empty,
+ the compressor simply writes out X as a literal byte and advances one
+ byte in the input. If the hash chain is not empty, indicating that
+ the sequence XYZ (or, if we are unlucky, some other 3 bytes with the
+ same hash function value) has occurred recently, the compressor
+ compares all strings on the XYZ hash chain with the actual input data
+ sequence starting at the current point, and selects the longest
+ match.
+
+ The compressor searches the hash chains starting with the most recent
+ strings, to favor small distances and thus take advantage of the
+ Huffman encoding. The hash chains are singly linked. There are no
+ deletions from the hash chains; the algorithm simply discards matches
+ that are too old. To avoid a worst-case situation, very long hash
+ chains are arbitrarily truncated at a certain length, determined by a
+ run-time parameter.
+
+ To improve overall compression, the compressor optionally defers the
+ selection of matches ("lazy matching"): after a match of length N has
+ been found, the compressor searches for a longer match starting at
+ the next input byte. If it finds a longer match, it truncates the
+ previous match to a length of one (thus producing a single literal
+ byte) and then emits the longer match. Otherwise, it emits the
+ original match, and, as described above, advances N bytes before
+ continuing.
+
+ Run-time parameters also control this "lazy match" procedure. If
+ compression ratio is most important, the compressor attempts a
+ complete second search regardless of the length of the first match.
+ In the normal case, if the current match is "long enough", the
+ compressor reduces the search for a longer match, thus speeding up
+ the process. If speed is most important, the compressor inserts new
+ strings in the hash table only when no match was found, or when the
+ match is not "too long". This degrades the compression ratio but
+ saves time since there are both fewer insertions and fewer searches.
+
+
+
+
+
+Deutsch Informational [Page 15]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+5. References
+
+ [1] Huffman, D. A., "A Method for the Construction of Minimum
+ Redundancy Codes", Proceedings of the Institute of Radio
+ Engineers, September 1952, Volume 40, Number 9, pp. 1098-1101.
+
+ [2] Ziv J., Lempel A., "A Universal Algorithm for Sequential Data
+ Compression", IEEE Transactions on Information Theory, Vol. 23,
+ No. 3, pp. 337-343.
+
+ [3] Gailly, J.-L., and Adler, M., ZLIB documentation and sources,
+ available in ftp://ftp.uu.net/pub/archiving/zip/doc/
+
+ [4] Gailly, J.-L., and Adler, M., GZIP documentation and sources,
+ available as gzip-*.tar in ftp://prep.ai.mit.edu/pub/gnu/
+
+ [5] Schwartz, E. S., and Kallick, B. "Generating a canonical prefix
+ encoding." Comm. ACM, 7,3 (Mar. 1964), pp. 166-169.
+
+ [6] Hirschberg and Lelewer, "Efficient decoding of prefix codes,"
+ Comm. ACM, 33,4, April 1990, pp. 449-459.
+
+6. Security Considerations
+
+ Any data compression method involves the reduction of redundancy in
+ the data. Consequently, any corruption of the data is likely to have
+ severe effects and be difficult to correct. Uncompressed text, on
+ the other hand, will probably still be readable despite the presence
+ of some corrupted bytes.
+
+ It is recommended that systems using this data format provide some
+ means of validating the integrity of the compressed data. See
+ reference [3], for example.
+
+7. Source code
+
+ Source code for a C language implementation of a "deflate" compliant
+ compressor and decompressor is available within the zlib package at
+ ftp://ftp.uu.net/pub/archiving/zip/zlib/.
+
+8. Acknowledgements
+
+ Trademarks cited in this document are the property of their
+ respective owners.
+
+ Phil Katz designed the deflate format. Jean-Loup Gailly and Mark
+ Adler wrote the related software described in this specification.
+ Glenn Randers-Pehrson converted this document to RFC and HTML format.
+
+
+
+Deutsch Informational [Page 16]
+
+RFC 1951 DEFLATE Compressed Data Format Specification May 1996
+
+
+9. Author's Address
+
+ L. Peter Deutsch
+ Aladdin Enterprises
+ 203 Santa Margarita Ave.
+ Menlo Park, CA 94025
+
+ Phone: (415) 322-0103 (AM only)
+ FAX: (415) 322-1734
+ EMail: <ghost@aladdin.com>
+
+ Questions about the technical content of this specification can be
+ sent by email to:
+
+ Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
+ Mark Adler <madler@alumni.caltech.edu>
+
+ Editorial comments on this specification can be sent by email to:
+
+ L. Peter Deutsch <ghost@aladdin.com> and
+ Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 17]
+
diff --git a/compat/zlib/doc/rfc1952.txt b/compat/zlib/doc/rfc1952.txt
new file mode 100644
index 0000000..a8e51b4
--- /dev/null
+++ b/compat/zlib/doc/rfc1952.txt
@@ -0,0 +1,675 @@
+
+
+
+
+
+
+Network Working Group P. Deutsch
+Request for Comments: 1952 Aladdin Enterprises
+Category: Informational May 1996
+
+
+ GZIP file format specification version 4.3
+
+Status of This Memo
+
+ This memo provides information for the Internet community. This memo
+ does not specify an Internet standard of any kind. Distribution of
+ this memo is unlimited.
+
+IESG Note:
+
+ The IESG takes no position on the validity of any Intellectual
+ Property Rights statements contained in this document.
+
+Notices
+
+ Copyright (c) 1996 L. Peter Deutsch
+
+ Permission is granted to copy and distribute this document for any
+ purpose and without charge, including translations into other
+ languages and incorporation into compilations, provided that the
+ copyright notice and this notice are preserved, and that any
+ substantive changes or deletions from the original are clearly
+ marked.
+
+ A pointer to the latest version of this and related documentation in
+ HTML format can be found at the URL
+ <ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
+
+Abstract
+
+ This specification defines a lossless compressed data format that is
+ compatible with the widely used GZIP utility. The format includes a
+ cyclic redundancy check value for detecting data corruption. The
+ format presently uses the DEFLATE method of compression but can be
+ easily extended to use other compression methods. The format can be
+ implemented readily in a manner not covered by patents.
+
+
+
+
+
+
+
+
+
+
+Deutsch Informational [Page 1]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+Table of Contents
+
+ 1. Introduction ................................................... 2
+ 1.1. Purpose ................................................... 2
+ 1.2. Intended audience ......................................... 3
+ 1.3. Scope ..................................................... 3
+ 1.4. Compliance ................................................ 3
+ 1.5. Definitions of terms and conventions used ................. 3
+ 1.6. Changes from previous versions ............................ 3
+ 2. Detailed specification ......................................... 4
+ 2.1. Overall conventions ....................................... 4
+ 2.2. File format ............................................... 5
+ 2.3. Member format ............................................. 5
+ 2.3.1. Member header and trailer ........................... 6
+ 2.3.1.1. Extra field ................................... 8
+ 2.3.1.2. Compliance .................................... 9
+ 3. References .................................................. 9
+ 4. Security Considerations .................................... 10
+ 5. Acknowledgements ........................................... 10
+ 6. Author's Address ........................................... 10
+ 7. Appendix: Jean-Loup Gailly's gzip utility .................. 11
+ 8. Appendix: Sample CRC Code .................................. 11
+
+1. Introduction
+
+ 1.1. Purpose
+
+ The purpose of this specification is to define a lossless
+ compressed data format that:
+
+ * Is independent of CPU type, operating system, file system,
+ and character set, and hence can be used for interchange;
+ * Can compress or decompress a data stream (as opposed to a
+ randomly accessible file) to produce another data stream,
+ using only an a priori bounded amount of intermediate
+ storage, and hence can be used in data communications or
+ similar structures such as Unix filters;
+ * Compresses data with efficiency comparable to the best
+ currently available general-purpose compression methods,
+ and in particular considerably better than the "compress"
+ program;
+ * Can be implemented readily in a manner not covered by
+ patents, and hence can be practiced freely;
+ * Is compatible with the file format produced by the current
+ widely used gzip utility, in that conforming decompressors
+ will be able to read data produced by the existing gzip
+ compressor.
+
+
+
+
+Deutsch Informational [Page 2]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ The data format defined by this specification does not attempt to:
+
+ * Provide random access to compressed data;
+ * Compress specialized data (e.g., raster graphics) as well as
+ the best currently available specialized algorithms.
+
+ 1.2. Intended audience
+
+ This specification is intended for use by implementors of software
+ to compress data into gzip format and/or decompress data from gzip
+ format.
+
+ The text of the specification assumes a basic background in
+ programming at the level of bits and other primitive data
+ representations.
+
+ 1.3. Scope
+
+ The specification specifies a compression method and a file format
+ (the latter assuming only that a file can store a sequence of
+ arbitrary bytes). It does not specify any particular interface to
+ a file system or anything about character sets or encodings
+ (except for file names and comments, which are optional).
+
+ 1.4. Compliance
+
+ Unless otherwise indicated below, a compliant decompressor must be
+ able to accept and decompress any file that conforms to all the
+ specifications presented here; a compliant compressor must produce
+ files that conform to all the specifications presented here. The
+ material in the appendices is not part of the specification per se
+ and is not relevant to compliance.
+
+ 1.5. Definitions of terms and conventions used
+
+ byte: 8 bits stored or transmitted as a unit (same as an octet).
+ (For this specification, a byte is exactly 8 bits, even on
+ machines which store a character on a number of bits different
+ from 8.) See below for the numbering of bits within a byte.
+
+ 1.6. Changes from previous versions
+
+ There have been no technical changes to the gzip format since
+ version 4.1 of this specification. In version 4.2, some
+ terminology was changed, and the sample CRC code was rewritten for
+ clarity and to eliminate the requirement for the caller to do pre-
+ and post-conditioning. Version 4.3 is a conversion of the
+ specification to RFC style.
+
+
+
+Deutsch Informational [Page 3]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+2. Detailed specification
+
+ 2.1. Overall conventions
+
+ In the diagrams below, a box like this:
+
+ +---+
+ | | <-- the vertical bars might be missing
+ +---+
+
+ represents one byte; a box like this:
+
+ +==============+
+ | |
+ +==============+
+
+ represents a variable number of bytes.
+
+ Bytes stored within a computer do not have a "bit order", since
+ they are always treated as a unit. However, a byte considered as
+ an integer between 0 and 255 does have a most- and least-
+ significant bit, and since we write numbers with the most-
+ significant digit on the left, we also write bytes with the most-
+ significant bit on the left. In the diagrams below, we number the
+ bits of a byte so that bit 0 is the least-significant bit, i.e.,
+ the bits are numbered:
+
+ +--------+
+ |76543210|
+ +--------+
+
+ This document does not address the issue of the order in which
+ bits of a byte are transmitted on a bit-sequential medium, since
+ the data format described here is byte- rather than bit-oriented.
+
+ Within a computer, a number may occupy multiple bytes. All
+ multi-byte numbers in the format described here are stored with
+ the least-significant byte first (at the lower memory address).
+ For example, the decimal number 520 is stored as:
+
+ 0 1
+ +--------+--------+
+ |00001000|00000010|
+ +--------+--------+
+ ^ ^
+ | |
+ | + more significant byte = 2 x 256
+ + less significant byte = 8
+
+
+
+Deutsch Informational [Page 4]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ 2.2. File format
+
+ A gzip file consists of a series of "members" (compressed data
+ sets). The format of each member is specified in the following
+ section. The members simply appear one after another in the file,
+ with no additional information before, between, or after them.
+
+ 2.3. Member format
+
+ Each member has the following structure:
+
+ +---+---+---+---+---+---+---+---+---+---+
+ |ID1|ID2|CM |FLG| MTIME |XFL|OS | (more-->)
+ +---+---+---+---+---+---+---+---+---+---+
+
+ (if FLG.FEXTRA set)
+
+ +---+---+=================================+
+ | XLEN |...XLEN bytes of "extra field"...| (more-->)
+ +---+---+=================================+
+
+ (if FLG.FNAME set)
+
+ +=========================================+
+ |...original file name, zero-terminated...| (more-->)
+ +=========================================+
+
+ (if FLG.FCOMMENT set)
+
+ +===================================+
+ |...file comment, zero-terminated...| (more-->)
+ +===================================+
+
+ (if FLG.FHCRC set)
+
+ +---+---+
+ | CRC16 |
+ +---+---+
+
+ +=======================+
+ |...compressed blocks...| (more-->)
+ +=======================+
+
+ 0 1 2 3 4 5 6 7
+ +---+---+---+---+---+---+---+---+
+ | CRC32 | ISIZE |
+ +---+---+---+---+---+---+---+---+
+
+
+
+
+Deutsch Informational [Page 5]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ 2.3.1. Member header and trailer
+
+ ID1 (IDentification 1)
+ ID2 (IDentification 2)
+ These have the fixed values ID1 = 31 (0x1f, \037), ID2 = 139
+ (0x8b, \213), to identify the file as being in gzip format.
+
+ CM (Compression Method)
+ This identifies the compression method used in the file. CM
+ = 0-7 are reserved. CM = 8 denotes the "deflate"
+ compression method, which is the one customarily used by
+ gzip and which is documented elsewhere.
+
+ FLG (FLaGs)
+ This flag byte is divided into individual bits as follows:
+
+ bit 0 FTEXT
+ bit 1 FHCRC
+ bit 2 FEXTRA
+ bit 3 FNAME
+ bit 4 FCOMMENT
+ bit 5 reserved
+ bit 6 reserved
+ bit 7 reserved
+
+ If FTEXT is set, the file is probably ASCII text. This is
+ an optional indication, which the compressor may set by
+ checking a small amount of the input data to see whether any
+ non-ASCII characters are present. In case of doubt, FTEXT
+ is cleared, indicating binary data. For systems which have
+ different file formats for ascii text and binary data, the
+ decompressor can use FTEXT to choose the appropriate format.
+ We deliberately do not specify the algorithm used to set
+ this bit, since a compressor always has the option of
+ leaving it cleared and a decompressor always has the option
+ of ignoring it and letting some other program handle issues
+ of data conversion.
+
+ If FHCRC is set, a CRC16 for the gzip header is present,
+ immediately before the compressed data. The CRC16 consists
+ of the two least significant bytes of the CRC32 for all
+ bytes of the gzip header up to and not including the CRC16.
+ [The FHCRC bit was never set by versions of gzip up to
+ 1.2.4, even though it was documented with a different
+ meaning in gzip 1.2.4.]
+
+ If FEXTRA is set, optional extra fields are present, as
+ described in a following section.
+
+
+
+Deutsch Informational [Page 6]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ If FNAME is set, an original file name is present,
+ terminated by a zero byte. The name must consist of ISO
+ 8859-1 (LATIN-1) characters; on operating systems using
+ EBCDIC or any other character set for file names, the name
+ must be translated to the ISO LATIN-1 character set. This
+ is the original name of the file being compressed, with any
+ directory components removed, and, if the file being
+ compressed is on a file system with case insensitive names,
+ forced to lower case. There is no original file name if the
+ data was compressed from a source other than a named file;
+ for example, if the source was stdin on a Unix system, there
+ is no file name.
+
+ If FCOMMENT is set, a zero-terminated file comment is
+ present. This comment is not interpreted; it is only
+ intended for human consumption. The comment must consist of
+ ISO 8859-1 (LATIN-1) characters. Line breaks should be
+ denoted by a single line feed character (10 decimal).
+
+ Reserved FLG bits must be zero.
+
+ MTIME (Modification TIME)
+ This gives the most recent modification time of the original
+ file being compressed. The time is in Unix format, i.e.,
+ seconds since 00:00:00 GMT, Jan. 1, 1970. (Note that this
+ may cause problems for MS-DOS and other systems that use
+ local rather than Universal time.) If the compressed data
+ did not come from a file, MTIME is set to the time at which
+ compression started. MTIME = 0 means no time stamp is
+ available.
+
+ XFL (eXtra FLags)
+ These flags are available for use by specific compression
+ methods. The "deflate" method (CM = 8) sets these flags as
+ follows:
+
+ XFL = 2 - compressor used maximum compression,
+ slowest algorithm
+ XFL = 4 - compressor used fastest algorithm
+
+ OS (Operating System)
+ This identifies the type of file system on which compression
+ took place. This may be useful in determining end-of-line
+ convention for text files. The currently defined values are
+ as follows:
+
+
+
+
+
+
+Deutsch Informational [Page 7]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ 0 - FAT filesystem (MS-DOS, OS/2, NT/Win32)
+ 1 - Amiga
+ 2 - VMS (or OpenVMS)
+ 3 - Unix
+ 4 - VM/CMS
+ 5 - Atari TOS
+ 6 - HPFS filesystem (OS/2, NT)
+ 7 - Macintosh
+ 8 - Z-System
+ 9 - CP/M
+ 10 - TOPS-20
+ 11 - NTFS filesystem (NT)
+ 12 - QDOS
+ 13 - Acorn RISCOS
+ 255 - unknown
+
+ XLEN (eXtra LENgth)
+ If FLG.FEXTRA is set, this gives the length of the optional
+ extra field. See below for details.
+
+ CRC32 (CRC-32)
+ This contains a Cyclic Redundancy Check value of the
+ uncompressed data computed according to CRC-32 algorithm
+ used in the ISO 3309 standard and in section 8.1.1.6.2 of
+ ITU-T recommendation V.42. (See http://www.iso.ch for
+ ordering ISO documents. See gopher://info.itu.ch for an
+ online version of ITU-T V.42.)
+
+ ISIZE (Input SIZE)
+ This contains the size of the original (uncompressed) input
+ data modulo 2^32.
+
+ 2.3.1.1. Extra field
+
+ If the FLG.FEXTRA bit is set, an "extra field" is present in
+ the header, with total length XLEN bytes. It consists of a
+ series of subfields, each of the form:
+
+ +---+---+---+---+==================================+
+ |SI1|SI2| LEN |... LEN bytes of subfield data ...|
+ +---+---+---+---+==================================+
+
+ SI1 and SI2 provide a subfield ID, typically two ASCII letters
+ with some mnemonic value. Jean-Loup Gailly
+ <gzip@prep.ai.mit.edu> is maintaining a registry of subfield
+ IDs; please send him any subfield ID you wish to use. Subfield
+ IDs with SI2 = 0 are reserved for future use. The following
+ IDs are currently defined:
+
+
+
+Deutsch Informational [Page 8]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ SI1 SI2 Data
+ ---------- ---------- ----
+ 0x41 ('A') 0x70 ('P') Apollo file type information
+
+ LEN gives the length of the subfield data, excluding the 4
+ initial bytes.
+
+ 2.3.1.2. Compliance
+
+ A compliant compressor must produce files with correct ID1,
+ ID2, CM, CRC32, and ISIZE, but may set all the other fields in
+ the fixed-length part of the header to default values (255 for
+ OS, 0 for all others). The compressor must set all reserved
+ bits to zero.
+
+ A compliant decompressor must check ID1, ID2, and CM, and
+ provide an error indication if any of these have incorrect
+ values. It must examine FEXTRA/XLEN, FNAME, FCOMMENT and FHCRC
+ at least so it can skip over the optional fields if they are
+ present. It need not examine any other part of the header or
+ trailer; in particular, a decompressor may ignore FTEXT and OS
+ and always produce binary output, and still be compliant. A
+ compliant decompressor must give an error indication if any
+ reserved bit is non-zero, since such a bit could indicate the
+ presence of a new field that would cause subsequent data to be
+ interpreted incorrectly.
+
+3. References
+
+ [1] "Information Processing - 8-bit single-byte coded graphic
+ character sets - Part 1: Latin alphabet No.1" (ISO 8859-1:1987).
+ The ISO 8859-1 (Latin-1) character set is a superset of 7-bit
+ ASCII. Files defining this character set are available as
+ iso_8859-1.* in ftp://ftp.uu.net/graphics/png/documents/
+
+ [2] ISO 3309
+
+ [3] ITU-T recommendation V.42
+
+ [4] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification",
+ available in ftp://ftp.uu.net/pub/archiving/zip/doc/
+
+ [5] Gailly, J.-L., GZIP documentation, available as gzip-*.tar in
+ ftp://prep.ai.mit.edu/pub/gnu/
+
+ [6] Sarwate, D.V., "Computation of Cyclic Redundancy Checks via Table
+ Look-Up", Communications of the ACM, 31(8), pp.1008-1013.
+
+
+
+
+Deutsch Informational [Page 9]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ [7] Schwaderer, W.D., "CRC Calculation", April 85 PC Tech Journal,
+ pp.118-133.
+
+ [8] ftp://ftp.adelaide.edu.au/pub/rocksoft/papers/crc_v3.txt,
+ describing the CRC concept.
+
+4. Security Considerations
+
+ Any data compression method involves the reduction of redundancy in
+ the data. Consequently, any corruption of the data is likely to have
+ severe effects and be difficult to correct. Uncompressed text, on
+ the other hand, will probably still be readable despite the presence
+ of some corrupted bytes.
+
+ It is recommended that systems using this data format provide some
+ means of validating the integrity of the compressed data, such as by
+ setting and checking the CRC-32 check value.
+
+5. Acknowledgements
+
+ Trademarks cited in this document are the property of their
+ respective owners.
+
+ Jean-Loup Gailly designed the gzip format and wrote, with Mark Adler,
+ the related software described in this specification. Glenn
+ Randers-Pehrson converted this document to RFC and HTML format.
+
+6. Author's Address
+
+ L. Peter Deutsch
+ Aladdin Enterprises
+ 203 Santa Margarita Ave.
+ Menlo Park, CA 94025
+
+ Phone: (415) 322-0103 (AM only)
+ FAX: (415) 322-1734
+ EMail: <ghost@aladdin.com>
+
+ Questions about the technical content of this specification can be
+ sent by email to:
+
+ Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
+ Mark Adler <madler@alumni.caltech.edu>
+
+ Editorial comments on this specification can be sent by email to:
+
+ L. Peter Deutsch <ghost@aladdin.com> and
+ Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
+
+
+
+Deutsch Informational [Page 10]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+7. Appendix: Jean-Loup Gailly's gzip utility
+
+ The most widely used implementation of gzip compression, and the
+ original documentation on which this specification is based, were
+ created by Jean-Loup Gailly <gzip@prep.ai.mit.edu>. Since this
+ implementation is a de facto standard, we mention some more of its
+ features here. Again, the material in this section is not part of
+ the specification per se, and implementations need not follow it to
+ be compliant.
+
+ When compressing or decompressing a file, gzip preserves the
+ protection, ownership, and modification time attributes on the local
+ file system, since there is no provision for representing protection
+ attributes in the gzip file format itself. Since the file format
+ includes a modification time, the gzip decompressor provides a
+ command line switch that assigns the modification time from the file,
+ rather than the local modification time of the compressed input, to
+ the decompressed output.
+
+8. Appendix: Sample CRC Code
+
+ The following sample code represents a practical implementation of
+ the CRC (Cyclic Redundancy Check). (See also ISO 3309 and ITU-T V.42
+ for a formal specification.)
+
+ The sample code is in the ANSI C programming language. Non C users
+ may find it easier to read with these hints:
+
+ & Bitwise AND operator.
+ ^ Bitwise exclusive-OR operator.
+ >> Bitwise right shift operator. When applied to an
+ unsigned quantity, as here, right shift inserts zero
+ bit(s) at the left.
+ ! Logical NOT operator.
+ ++ "n++" increments the variable n.
+ 0xNNN 0x introduces a hexadecimal (base 16) constant.
+ Suffix L indicates a long value (at least 32 bits).
+
+ /* Table of CRCs of all 8-bit messages. */
+ unsigned long crc_table[256];
+
+ /* Flag: has the table been computed? Initially false. */
+ int crc_table_computed = 0;
+
+ /* Make the table for a fast CRC. */
+ void make_crc_table(void)
+ {
+ unsigned long c;
+
+
+
+Deutsch Informational [Page 11]
+
+RFC 1952 GZIP File Format Specification May 1996
+
+
+ int n, k;
+ for (n = 0; n < 256; n++) {
+ c = (unsigned long) n;
+ for (k = 0; k < 8; k++) {
+ if (c & 1) {
+ c = 0xedb88320L ^ (c >> 1);
+ } else {
+ c = c >> 1;
+ }
+ }
+ crc_table[n] = c;
+ }
+ crc_table_computed = 1;
+ }
+
+ /*
+ Update a running crc with the bytes buf[0..len-1] and return
+ the updated crc. The crc should be initialized to zero. Pre- and
+ post-conditioning (one's complement) is performed within this
+ function so it shouldn't be done by the caller. Usage example:
+
+ unsigned long crc = 0L;
+
+ while (read_buffer(buffer, length) != EOF) {
+ crc = update_crc(crc, buffer, length);
+ }
+ if (crc != original_crc) error();
+ */
+ unsigned long update_crc(unsigned long crc,
+ unsigned char *buf, int len)
+ {
+ unsigned long c = crc ^ 0xffffffffL;
+ int n;
+
+ if (!crc_table_computed)
+ make_crc_table();
+ for (n = 0; n < len; n++) {
+ c = crc_table[(c ^ buf[n]) & 0xff] ^ (c >> 8);
+ }
+ return c ^ 0xffffffffL;
+ }
+
+ /* Return the CRC of the bytes buf[0..len-1]. */
+ unsigned long crc(unsigned char *buf, int len)
+ {
+ return update_crc(0L, buf, len);
+ }
+
+
+
+
+Deutsch Informational [Page 12]
+
diff --git a/compat/zlib/doc/txtvsbin.txt b/compat/zlib/doc/txtvsbin.txt
new file mode 100644
index 0000000..3d0f063
--- /dev/null
+++ b/compat/zlib/doc/txtvsbin.txt
@@ -0,0 +1,107 @@
+A Fast Method for Identifying Plain Text Files
+==============================================
+
+
+Introduction
+------------
+
+Given a file coming from an unknown source, it is sometimes desirable
+to find out whether the format of that file is plain text. Although
+this may appear like a simple task, a fully accurate detection of the
+file type requires heavy-duty semantic analysis on the file contents.
+It is, however, possible to obtain satisfactory results by employing
+various heuristics.
+
+Previous versions of PKZip and other zip-compatible compression tools
+were using a crude detection scheme: if more than 80% (4/5) of the bytes
+found in a certain buffer are within the range [7..127], the file is
+labeled as plain text, otherwise it is labeled as binary. A prominent
+limitation of this scheme is the restriction to Latin-based alphabets.
+Other alphabets, like Greek, Cyrillic or Asian, make extensive use of
+the bytes within the range [128..255], and texts using these alphabets
+are most often misidentified by this scheme; in other words, the rate
+of false negatives is sometimes too high, which means that the recall
+is low. Another weakness of this scheme is a reduced precision, due to
+the false positives that may occur when binary files containing large
+amounts of textual characters are misidentified as plain text.
+
+In this article we propose a new, simple detection scheme that features
+a much increased precision and a near-100% recall. This scheme is
+designed to work on ASCII, Unicode and other ASCII-derived alphabets,
+and it handles single-byte encodings (ISO-8859, MacRoman, KOI8, etc.)
+and variable-sized encodings (ISO-2022, UTF-8, etc.). Wider encodings
+(UCS-2/UTF-16 and UCS-4/UTF-32) are not handled, however.
+
+
+The Algorithm
+-------------
+
+The algorithm works by dividing the set of bytecodes [0..255] into three
+categories:
+- The white list of textual bytecodes:
+ 9 (TAB), 10 (LF), 13 (CR), 32 (SPACE) to 255.
+- The gray list of tolerated bytecodes:
+ 7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB), 27 (ESC).
+- The black list of undesired, non-textual bytecodes:
+ 0 (NUL) to 6, 14 to 31.
+
+If a file contains at least one byte that belongs to the white list and
+no byte that belongs to the black list, then the file is categorized as
+plain text; otherwise, it is categorized as binary. (The boundary case,
+when the file is empty, automatically falls into the latter category.)
+
+
+Rationale
+---------
+
+The idea behind this algorithm relies on two observations.
+
+The first observation is that, although the full range of 7-bit codes
+[0..127] is properly specified by the ASCII standard, most control
+characters in the range [0..31] are not used in practice. The only
+widely-used, almost universally-portable control codes are 9 (TAB),
+10 (LF) and 13 (CR). There are a few more control codes that are
+recognized on a reduced range of platforms and text viewers/editors:
+7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB) and 27 (ESC); but these
+codes are rarely (if ever) used alone, without being accompanied by
+some printable text. Even the newer, portable text formats such as
+XML avoid using control characters outside the list mentioned here.
+
+The second observation is that most of the binary files tend to contain
+control characters, especially 0 (NUL). Even though the older text
+detection schemes observe the presence of non-ASCII codes from the range
+[128..255], the precision rarely has to suffer if this upper range is
+labeled as textual, because the files that are genuinely binary tend to
+contain both control characters and codes from the upper range. On the
+other hand, the upper range needs to be labeled as textual, because it
+is used by virtually all ASCII extensions. In particular, this range is
+used for encoding non-Latin scripts.
+
+Since there is no counting involved, other than simply observing the
+presence or the absence of some byte values, the algorithm produces
+consistent results, regardless what alphabet encoding is being used.
+(If counting were involved, it could be possible to obtain different
+results on a text encoded, say, using ISO-8859-16 versus UTF-8.)
+
+There is an extra category of plain text files that are "polluted" with
+one or more black-listed codes, either by mistake or by peculiar design
+considerations. In such cases, a scheme that tolerates a small fraction
+of black-listed codes would provide an increased recall (i.e. more true
+positives). This, however, incurs a reduced precision overall, since
+false positives are more likely to appear in binary files that contain
+large chunks of textual data. Furthermore, "polluted" plain text should
+be regarded as binary by general-purpose text detection schemes, because
+general-purpose text processing algorithms might not be applicable.
+Under this premise, it is safe to say that our detection method provides
+a near-100% recall.
+
+Experiments have been run on many files coming from various platforms
+and applications. We tried plain text files, system logs, source code,
+formatted office documents, compiled object code, etc. The results
+confirm the optimistic assumptions about the capabilities of this
+algorithm.
+
+
+--
+Cosmin Truta
+Last updated: 2006-May-28
diff --git a/compat/zlib/examples/README.examples b/compat/zlib/examples/README.examples
new file mode 100644
index 0000000..56a3171
--- /dev/null
+++ b/compat/zlib/examples/README.examples
@@ -0,0 +1,49 @@
+This directory contains examples of the use of zlib and other relevant
+programs and documentation.
+
+enough.c
+ calculation and justification of ENOUGH parameter in inftrees.h
+ - calculates the maximum table space used in inflate tree
+ construction over all possible Huffman codes
+
+fitblk.c
+ compress just enough input to nearly fill a requested output size
+ - zlib isn't designed to do this, but fitblk does it anyway
+
+gun.c
+ uncompress a gzip file
+ - illustrates the use of inflateBack() for high speed file-to-file
+ decompression using call-back functions
+ - is approximately twice as fast as gzip -d
+ - also provides Unix uncompress functionality, again twice as fast
+
+gzappend.c
+ append to a gzip file
+ - illustrates the use of the Z_BLOCK flush parameter for inflate()
+ - illustrates the use of deflatePrime() to start at any bit
+
+gzjoin.c
+ join gzip files without recalculating the crc or recompressing
+ - illustrates the use of the Z_BLOCK flush parameter for inflate()
+ - illustrates the use of crc32_combine()
+
+gzlog.c
+gzlog.h
+ efficiently and robustly maintain a message log file in gzip format
+ - illustrates use of raw deflate, Z_PARTIAL_FLUSH, deflatePrime(),
+ and deflateSetDictionary()
+ - illustrates use of a gzip header extra field
+
+zlib_how.html
+ painfully comprehensive description of zpipe.c (see below)
+ - describes in excruciating detail the use of deflate() and inflate()
+
+zpipe.c
+ reads and writes zlib streams from stdin to stdout
+ - illustrates the proper use of deflate() and inflate()
+ - deeply commented in zlib_how.html (see above)
+
+zran.c
+ index a zlib or gzip stream and randomly access it
+ - illustrates the use of Z_BLOCK, inflatePrime(), and
+ inflateSetDictionary() to provide random access
diff --git a/compat/zlib/examples/enough.c b/compat/zlib/examples/enough.c
new file mode 100644
index 0000000..b991144
--- /dev/null
+++ b/compat/zlib/examples/enough.c
@@ -0,0 +1,572 @@
+/* enough.c -- determine the maximum size of inflate's Huffman code tables over
+ * all possible valid and complete Huffman codes, subject to a length limit.
+ * Copyright (C) 2007, 2008, 2012 Mark Adler
+ * Version 1.4 18 August 2012 Mark Adler
+ */
+
+/* Version history:
+ 1.0 3 Jan 2007 First version (derived from codecount.c version 1.4)
+ 1.1 4 Jan 2007 Use faster incremental table usage computation
+ Prune examine() search on previously visited states
+ 1.2 5 Jan 2007 Comments clean up
+ As inflate does, decrease root for short codes
+ Refuse cases where inflate would increase root
+ 1.3 17 Feb 2008 Add argument for initial root table size
+ Fix bug for initial root table size == max - 1
+ Use a macro to compute the history index
+ 1.4 18 Aug 2012 Avoid shifts more than bits in type (caused endless loop!)
+ Clean up comparisons of different types
+ Clean up code indentation
+ */
+
+/*
+ Examine all possible Huffman codes for a given number of symbols and a
+ maximum code length in bits to determine the maximum table size for zilb's
+ inflate. Only complete Huffman codes are counted.
+
+ Two codes are considered distinct if the vectors of the number of codes per
+ length are not identical. So permutations of the symbol assignments result
+ in the same code for the counting, as do permutations of the assignments of
+ the bit values to the codes (i.e. only canonical codes are counted).
+
+ We build a code from shorter to longer lengths, determining how many symbols
+ are coded at each length. At each step, we have how many symbols remain to
+ be coded, what the last code length used was, and how many bit patterns of
+ that length remain unused. Then we add one to the code length and double the
+ number of unused patterns to graduate to the next code length. We then
+ assign all portions of the remaining symbols to that code length that
+ preserve the properties of a correct and eventually complete code. Those
+ properties are: we cannot use more bit patterns than are available; and when
+ all the symbols are used, there are exactly zero possible bit patterns
+ remaining.
+
+ The inflate Huffman decoding algorithm uses two-level lookup tables for
+ speed. There is a single first-level table to decode codes up to root bits
+ in length (root == 9 in the current inflate implementation). The table
+ has 1 << root entries and is indexed by the next root bits of input. Codes
+ shorter than root bits have replicated table entries, so that the correct
+ entry is pointed to regardless of the bits that follow the short code. If
+ the code is longer than root bits, then the table entry points to a second-
+ level table. The size of that table is determined by the longest code with
+ that root-bit prefix. If that longest code has length len, then the table
+ has size 1 << (len - root), to index the remaining bits in that set of
+ codes. Each subsequent root-bit prefix then has its own sub-table. The
+ total number of table entries required by the code is calculated
+ incrementally as the number of codes at each bit length is populated. When
+ all of the codes are shorter than root bits, then root is reduced to the
+ longest code length, resulting in a single, smaller, one-level table.
+
+ The inflate algorithm also provides for small values of root (relative to
+ the log2 of the number of symbols), where the shortest code has more bits
+ than root. In that case, root is increased to the length of the shortest
+ code. This program, by design, does not handle that case, so it is verified
+ that the number of symbols is less than 2^(root + 1).
+
+ In order to speed up the examination (by about ten orders of magnitude for
+ the default arguments), the intermediate states in the build-up of a code
+ are remembered and previously visited branches are pruned. The memory
+ required for this will increase rapidly with the total number of symbols and
+ the maximum code length in bits. However this is a very small price to pay
+ for the vast speedup.
+
+ First, all of the possible Huffman codes are counted, and reachable
+ intermediate states are noted by a non-zero count in a saved-results array.
+ Second, the intermediate states that lead to (root + 1) bit or longer codes
+ are used to look at all sub-codes from those junctures for their inflate
+ memory usage. (The amount of memory used is not affected by the number of
+ codes of root bits or less in length.) Third, the visited states in the
+ construction of those sub-codes and the associated calculation of the table
+ size is recalled in order to avoid recalculating from the same juncture.
+ Beginning the code examination at (root + 1) bit codes, which is enabled by
+ identifying the reachable nodes, accounts for about six of the orders of
+ magnitude of improvement for the default arguments. About another four
+ orders of magnitude come from not revisiting previous states. Out of
+ approximately 2x10^16 possible Huffman codes, only about 2x10^6 sub-codes
+ need to be examined to cover all of the possible table memory usage cases
+ for the default arguments of 286 symbols limited to 15-bit codes.
+
+ Note that an unsigned long long type is used for counting. It is quite easy
+ to exceed the capacity of an eight-byte integer with a large number of
+ symbols and a large maximum code length, so multiple-precision arithmetic
+ would need to replace the unsigned long long arithmetic in that case. This
+ program will abort if an overflow occurs. The big_t type identifies where
+ the counting takes place.
+
+ An unsigned long long type is also used for calculating the number of
+ possible codes remaining at the maximum length. This limits the maximum
+ code length to the number of bits in a long long minus the number of bits
+ needed to represent the symbols in a flat code. The code_t type identifies
+ where the bit pattern counting takes place.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+#define local static
+
+/* special data types */
+typedef unsigned long long big_t; /* type for code counting */
+typedef unsigned long long code_t; /* type for bit pattern counting */
+struct tab { /* type for been here check */
+ size_t len; /* length of bit vector in char's */
+ char *vec; /* allocated bit vector */
+};
+
+/* The array for saving results, num[], is indexed with this triplet:
+
+ syms: number of symbols remaining to code
+ left: number of available bit patterns at length len
+ len: number of bits in the codes currently being assigned
+
+ Those indices are constrained thusly when saving results:
+
+ syms: 3..totsym (totsym == total symbols to code)
+ left: 2..syms - 1, but only the evens (so syms == 8 -> 2, 4, 6)
+ len: 1..max - 1 (max == maximum code length in bits)
+
+ syms == 2 is not saved since that immediately leads to a single code. left
+ must be even, since it represents the number of available bit patterns at
+ the current length, which is double the number at the previous length.
+ left ends at syms-1 since left == syms immediately results in a single code.
+ (left > sym is not allowed since that would result in an incomplete code.)
+ len is less than max, since the code completes immediately when len == max.
+
+ The offset into the array is calculated for the three indices with the
+ first one (syms) being outermost, and the last one (len) being innermost.
+ We build the array with length max-1 lists for the len index, with syms-3
+ of those for each symbol. There are totsym-2 of those, with each one
+ varying in length as a function of sym. See the calculation of index in
+ count() for the index, and the calculation of size in main() for the size
+ of the array.
+
+ For the deflate example of 286 symbols limited to 15-bit codes, the array
+ has 284,284 entries, taking up 2.17 MB for an 8-byte big_t. More than
+ half of the space allocated for saved results is actually used -- not all
+ possible triplets are reached in the generation of valid Huffman codes.
+ */
+
+/* The array for tracking visited states, done[], is itself indexed identically
+ to the num[] array as described above for the (syms, left, len) triplet.
+ Each element in the array is further indexed by the (mem, rem) doublet,
+ where mem is the amount of inflate table space used so far, and rem is the
+ remaining unused entries in the current inflate sub-table. Each indexed
+ element is simply one bit indicating whether the state has been visited or
+ not. Since the ranges for mem and rem are not known a priori, each bit
+ vector is of a variable size, and grows as needed to accommodate the visited
+ states. mem and rem are used to calculate a single index in a triangular
+ array. Since the range of mem is expected in the default case to be about
+ ten times larger than the range of rem, the array is skewed to reduce the
+ memory usage, with eight times the range for mem than for rem. See the
+ calculations for offset and bit in beenhere() for the details.
+
+ For the deflate example of 286 symbols limited to 15-bit codes, the bit
+ vectors grow to total approximately 21 MB, in addition to the 4.3 MB done[]
+ array itself.
+ */
+
+/* Globals to avoid propagating constants or constant pointers recursively */
+local int max; /* maximum allowed bit length for the codes */
+local int root; /* size of base code table in bits */
+local int large; /* largest code table so far */
+local size_t size; /* number of elements in num and done */
+local int *code; /* number of symbols assigned to each bit length */
+local big_t *num; /* saved results array for code counting */
+local struct tab *done; /* states already evaluated array */
+
+/* Index function for num[] and done[] */
+#define INDEX(i,j,k) (((size_t)((i-1)>>1)*((i-2)>>1)+(j>>1)-1)*(max-1)+k-1)
+
+/* Free allocated space. Uses globals code, num, and done. */
+local void cleanup(void)
+{
+ size_t n;
+
+ if (done != NULL) {
+ for (n = 0; n < size; n++)
+ if (done[n].len)
+ free(done[n].vec);
+ free(done);
+ }
+ if (num != NULL)
+ free(num);
+ if (code != NULL)
+ free(code);
+}
+
+/* Return the number of possible Huffman codes using bit patterns of lengths
+ len through max inclusive, coding syms symbols, with left bit patterns of
+ length len unused -- return -1 if there is an overflow in the counting.
+ Keep a record of previous results in num to prevent repeating the same
+ calculation. Uses the globals max and num. */
+local big_t count(int syms, int len, int left)
+{
+ big_t sum; /* number of possible codes from this juncture */
+ big_t got; /* value returned from count() */
+ int least; /* least number of syms to use at this juncture */
+ int most; /* most number of syms to use at this juncture */
+ int use; /* number of bit patterns to use in next call */
+ size_t index; /* index of this case in *num */
+
+ /* see if only one possible code */
+ if (syms == left)
+ return 1;
+
+ /* note and verify the expected state */
+ assert(syms > left && left > 0 && len < max);
+
+ /* see if we've done this one already */
+ index = INDEX(syms, left, len);
+ got = num[index];
+ if (got)
+ return got; /* we have -- return the saved result */
+
+ /* we need to use at least this many bit patterns so that the code won't be
+ incomplete at the next length (more bit patterns than symbols) */
+ least = (left << 1) - syms;
+ if (least < 0)
+ least = 0;
+
+ /* we can use at most this many bit patterns, lest there not be enough
+ available for the remaining symbols at the maximum length (if there were
+ no limit to the code length, this would become: most = left - 1) */
+ most = (((code_t)left << (max - len)) - syms) /
+ (((code_t)1 << (max - len)) - 1);
+
+ /* count all possible codes from this juncture and add them up */
+ sum = 0;
+ for (use = least; use <= most; use++) {
+ got = count(syms - use, len + 1, (left - use) << 1);
+ sum += got;
+ if (got == (big_t)0 - 1 || sum < got) /* overflow */
+ return (big_t)0 - 1;
+ }
+
+ /* verify that all recursive calls are productive */
+ assert(sum != 0);
+
+ /* save the result and return it */
+ num[index] = sum;
+ return sum;
+}
+
+/* Return true if we've been here before, set to true if not. Set a bit in a
+ bit vector to indicate visiting this state. Each (syms,len,left) state
+ has a variable size bit vector indexed by (mem,rem). The bit vector is
+ lengthened if needed to allow setting the (mem,rem) bit. */
+local int beenhere(int syms, int len, int left, int mem, int rem)
+{
+ size_t index; /* index for this state's bit vector */
+ size_t offset; /* offset in this state's bit vector */
+ int bit; /* mask for this state's bit */
+ size_t length; /* length of the bit vector in bytes */
+ char *vector; /* new or enlarged bit vector */
+
+ /* point to vector for (syms,left,len), bit in vector for (mem,rem) */
+ index = INDEX(syms, left, len);
+ mem -= 1 << root;
+ offset = (mem >> 3) + rem;
+ offset = ((offset * (offset + 1)) >> 1) + rem;
+ bit = 1 << (mem & 7);
+
+ /* see if we've been here */
+ length = done[index].len;
+ if (offset < length && (done[index].vec[offset] & bit) != 0)
+ return 1; /* done this! */
+
+ /* we haven't been here before -- set the bit to show we have now */
+
+ /* see if we need to lengthen the vector in order to set the bit */
+ if (length <= offset) {
+ /* if we have one already, enlarge it, zero out the appended space */
+ if (length) {
+ do {
+ length <<= 1;
+ } while (length <= offset);
+ vector = realloc(done[index].vec, length);
+ if (vector != NULL)
+ memset(vector + done[index].len, 0, length - done[index].len);
+ }
+
+ /* otherwise we need to make a new vector and zero it out */
+ else {
+ length = 1 << (len - root);
+ while (length <= offset)
+ length <<= 1;
+ vector = calloc(length, sizeof(char));
+ }
+
+ /* in either case, bail if we can't get the memory */
+ if (vector == NULL) {
+ fputs("abort: unable to allocate enough memory\n", stderr);
+ cleanup();
+ exit(1);
+ }
+
+ /* install the new vector */
+ done[index].len = length;
+ done[index].vec = vector;
+ }
+
+ /* set the bit */
+ done[index].vec[offset] |= bit;
+ return 0;
+}
+
+/* Examine all possible codes from the given node (syms, len, left). Compute
+ the amount of memory required to build inflate's decoding tables, where the
+ number of code structures used so far is mem, and the number remaining in
+ the current sub-table is rem. Uses the globals max, code, root, large, and
+ done. */
+local void examine(int syms, int len, int left, int mem, int rem)
+{
+ int least; /* least number of syms to use at this juncture */
+ int most; /* most number of syms to use at this juncture */
+ int use; /* number of bit patterns to use in next call */
+
+ /* see if we have a complete code */
+ if (syms == left) {
+ /* set the last code entry */
+ code[len] = left;
+
+ /* complete computation of memory used by this code */
+ while (rem < left) {
+ left -= rem;
+ rem = 1 << (len - root);
+ mem += rem;
+ }
+ assert(rem == left);
+
+ /* if this is a new maximum, show the entries used and the sub-code */
+ if (mem > large) {
+ large = mem;
+ printf("max %d: ", mem);
+ for (use = root + 1; use <= max; use++)
+ if (code[use])
+ printf("%d[%d] ", code[use], use);
+ putchar('\n');
+ fflush(stdout);
+ }
+
+ /* remove entries as we drop back down in the recursion */
+ code[len] = 0;
+ return;
+ }
+
+ /* prune the tree if we can */
+ if (beenhere(syms, len, left, mem, rem))
+ return;
+
+ /* we need to use at least this many bit patterns so that the code won't be
+ incomplete at the next length (more bit patterns than symbols) */
+ least = (left << 1) - syms;
+ if (least < 0)
+ least = 0;
+
+ /* we can use at most this many bit patterns, lest there not be enough
+ available for the remaining symbols at the maximum length (if there were
+ no limit to the code length, this would become: most = left - 1) */
+ most = (((code_t)left << (max - len)) - syms) /
+ (((code_t)1 << (max - len)) - 1);
+
+ /* occupy least table spaces, creating new sub-tables as needed */
+ use = least;
+ while (rem < use) {
+ use -= rem;
+ rem = 1 << (len - root);
+ mem += rem;
+ }
+ rem -= use;
+
+ /* examine codes from here, updating table space as we go */
+ for (use = least; use <= most; use++) {
+ code[len] = use;
+ examine(syms - use, len + 1, (left - use) << 1,
+ mem + (rem ? 1 << (len - root) : 0), rem << 1);
+ if (rem == 0) {
+ rem = 1 << (len - root);
+ mem += rem;
+ }
+ rem--;
+ }
+
+ /* remove entries as we drop back down in the recursion */
+ code[len] = 0;
+}
+
+/* Look at all sub-codes starting with root + 1 bits. Look at only the valid
+ intermediate code states (syms, left, len). For each completed code,
+ calculate the amount of memory required by inflate to build the decoding
+ tables. Find the maximum amount of memory required and show the code that
+ requires that maximum. Uses the globals max, root, and num. */
+local void enough(int syms)
+{
+ int n; /* number of remaing symbols for this node */
+ int left; /* number of unused bit patterns at this length */
+ size_t index; /* index of this case in *num */
+
+ /* clear code */
+ for (n = 0; n <= max; n++)
+ code[n] = 0;
+
+ /* look at all (root + 1) bit and longer codes */
+ large = 1 << root; /* base table */
+ if (root < max) /* otherwise, there's only a base table */
+ for (n = 3; n <= syms; n++)
+ for (left = 2; left < n; left += 2)
+ {
+ /* look at all reachable (root + 1) bit nodes, and the
+ resulting codes (complete at root + 2 or more) */
+ index = INDEX(n, left, root + 1);
+ if (root + 1 < max && num[index]) /* reachable node */
+ examine(n, root + 1, left, 1 << root, 0);
+
+ /* also look at root bit codes with completions at root + 1
+ bits (not saved in num, since complete), just in case */
+ if (num[index - 1] && n <= left << 1)
+ examine((n - left) << 1, root + 1, (n - left) << 1,
+ 1 << root, 0);
+ }
+
+ /* done */
+ printf("done: maximum of %d table entries\n", large);
+}
+
+/*
+ Examine and show the total number of possible Huffman codes for a given
+ maximum number of symbols, initial root table size, and maximum code length
+ in bits -- those are the command arguments in that order. The default
+ values are 286, 9, and 15 respectively, for the deflate literal/length code.
+ The possible codes are counted for each number of coded symbols from two to
+ the maximum. The counts for each of those and the total number of codes are
+ shown. The maximum number of inflate table entires is then calculated
+ across all possible codes. Each new maximum number of table entries and the
+ associated sub-code (starting at root + 1 == 10 bits) is shown.
+
+ To count and examine Huffman codes that are not length-limited, provide a
+ maximum length equal to the number of symbols minus one.
+
+ For the deflate literal/length code, use "enough". For the deflate distance
+ code, use "enough 30 6".
+
+ This uses the %llu printf format to print big_t numbers, which assumes that
+ big_t is an unsigned long long. If the big_t type is changed (for example
+ to a multiple precision type), the method of printing will also need to be
+ updated.
+ */
+int main(int argc, char **argv)
+{
+ int syms; /* total number of symbols to code */
+ int n; /* number of symbols to code for this run */
+ big_t got; /* return value of count() */
+ big_t sum; /* accumulated number of codes over n */
+ code_t word; /* for counting bits in code_t */
+
+ /* set up globals for cleanup() */
+ code = NULL;
+ num = NULL;
+ done = NULL;
+
+ /* get arguments -- default to the deflate literal/length code */
+ syms = 286;
+ root = 9;
+ max = 15;
+ if (argc > 1) {
+ syms = atoi(argv[1]);
+ if (argc > 2) {
+ root = atoi(argv[2]);
+ if (argc > 3)
+ max = atoi(argv[3]);
+ }
+ }
+ if (argc > 4 || syms < 2 || root < 1 || max < 1) {
+ fputs("invalid arguments, need: [sym >= 2 [root >= 1 [max >= 1]]]\n",
+ stderr);
+ return 1;
+ }
+
+ /* if not restricting the code length, the longest is syms - 1 */
+ if (max > syms - 1)
+ max = syms - 1;
+
+ /* determine the number of bits in a code_t */
+ for (n = 0, word = 1; word; n++, word <<= 1)
+ ;
+
+ /* make sure that the calculation of most will not overflow */
+ if (max > n || (code_t)(syms - 2) >= (((code_t)0 - 1) >> (max - 1))) {
+ fputs("abort: code length too long for internal types\n", stderr);
+ return 1;
+ }
+
+ /* reject impossible code requests */
+ if ((code_t)(syms - 1) > ((code_t)1 << max) - 1) {
+ fprintf(stderr, "%d symbols cannot be coded in %d bits\n",
+ syms, max);
+ return 1;
+ }
+
+ /* allocate code vector */
+ code = calloc(max + 1, sizeof(int));
+ if (code == NULL) {
+ fputs("abort: unable to allocate enough memory\n", stderr);
+ return 1;
+ }
+
+ /* determine size of saved results array, checking for overflows,
+ allocate and clear the array (set all to zero with calloc()) */
+ if (syms == 2) /* iff max == 1 */
+ num = NULL; /* won't be saving any results */
+ else {
+ size = syms >> 1;
+ if (size > ((size_t)0 - 1) / (n = (syms - 1) >> 1) ||
+ (size *= n, size > ((size_t)0 - 1) / (n = max - 1)) ||
+ (size *= n, size > ((size_t)0 - 1) / sizeof(big_t)) ||
+ (num = calloc(size, sizeof(big_t))) == NULL) {
+ fputs("abort: unable to allocate enough memory\n", stderr);
+ cleanup();
+ return 1;
+ }
+ }
+
+ /* count possible codes for all numbers of symbols, add up counts */
+ sum = 0;
+ for (n = 2; n <= syms; n++) {
+ got = count(n, 1, 2);
+ sum += got;
+ if (got == (big_t)0 - 1 || sum < got) { /* overflow */
+ fputs("abort: can't count that high!\n", stderr);
+ cleanup();
+ return 1;
+ }
+ printf("%llu %d-codes\n", got, n);
+ }
+ printf("%llu total codes for 2 to %d symbols", sum, syms);
+ if (max < syms - 1)
+ printf(" (%d-bit length limit)\n", max);
+ else
+ puts(" (no length limit)");
+
+ /* allocate and clear done array for beenhere() */
+ if (syms == 2)
+ done = NULL;
+ else if (size > ((size_t)0 - 1) / sizeof(struct tab) ||
+ (done = calloc(size, sizeof(struct tab))) == NULL) {
+ fputs("abort: unable to allocate enough memory\n", stderr);
+ cleanup();
+ return 1;
+ }
+
+ /* find and show maximum inflate table usage */
+ if (root > max) /* reduce root to max length */
+ root = max;
+ if ((code_t)syms < ((code_t)1 << (root + 1)))
+ enough(syms);
+ else
+ puts("cannot handle minimum code lengths > root");
+
+ /* done */
+ cleanup();
+ return 0;
+}
diff --git a/compat/zlib/examples/fitblk.c b/compat/zlib/examples/fitblk.c
new file mode 100644
index 0000000..c61de5c
--- /dev/null
+++ b/compat/zlib/examples/fitblk.c
@@ -0,0 +1,233 @@
+/* fitblk.c: example of fitting compressed output to a specified size
+ Not copyrighted -- provided to the public domain
+ Version 1.1 25 November 2004 Mark Adler */
+
+/* Version history:
+ 1.0 24 Nov 2004 First version
+ 1.1 25 Nov 2004 Change deflateInit2() to deflateInit()
+ Use fixed-size, stack-allocated raw buffers
+ Simplify code moving compression to subroutines
+ Use assert() for internal errors
+ Add detailed description of approach
+ */
+
+/* Approach to just fitting a requested compressed size:
+
+ fitblk performs three compression passes on a portion of the input
+ data in order to determine how much of that input will compress to
+ nearly the requested output block size. The first pass generates
+ enough deflate blocks to produce output to fill the requested
+ output size plus a specfied excess amount (see the EXCESS define
+ below). The last deflate block may go quite a bit past that, but
+ is discarded. The second pass decompresses and recompresses just
+ the compressed data that fit in the requested plus excess sized
+ buffer. The deflate process is terminated after that amount of
+ input, which is less than the amount consumed on the first pass.
+ The last deflate block of the result will be of a comparable size
+ to the final product, so that the header for that deflate block and
+ the compression ratio for that block will be about the same as in
+ the final product. The third compression pass decompresses the
+ result of the second step, but only the compressed data up to the
+ requested size minus an amount to allow the compressed stream to
+ complete (see the MARGIN define below). That will result in a
+ final compressed stream whose length is less than or equal to the
+ requested size. Assuming sufficient input and a requested size
+ greater than a few hundred bytes, the shortfall will typically be
+ less than ten bytes.
+
+ If the input is short enough that the first compression completes
+ before filling the requested output size, then that compressed
+ stream is return with no recompression.
+
+ EXCESS is chosen to be just greater than the shortfall seen in a
+ two pass approach similar to the above. That shortfall is due to
+ the last deflate block compressing more efficiently with a smaller
+ header on the second pass. EXCESS is set to be large enough so
+ that there is enough uncompressed data for the second pass to fill
+ out the requested size, and small enough so that the final deflate
+ block of the second pass will be close in size to the final deflate
+ block of the third and final pass. MARGIN is chosen to be just
+ large enough to assure that the final compression has enough room
+ to complete in all cases.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "zlib.h"
+
+#define local static
+
+/* print nastygram and leave */
+local void quit(char *why)
+{
+ fprintf(stderr, "fitblk abort: %s\n", why);
+ exit(1);
+}
+
+#define RAWLEN 4096 /* intermediate uncompressed buffer size */
+
+/* compress from file to def until provided buffer is full or end of
+ input reached; return last deflate() return value, or Z_ERRNO if
+ there was read error on the file */
+local int partcompress(FILE *in, z_streamp def)
+{
+ int ret, flush;
+ unsigned char raw[RAWLEN];
+
+ flush = Z_NO_FLUSH;
+ do {
+ def->avail_in = fread(raw, 1, RAWLEN, in);
+ if (ferror(in))
+ return Z_ERRNO;
+ def->next_in = raw;
+ if (feof(in))
+ flush = Z_FINISH;
+ ret = deflate(def, flush);
+ assert(ret != Z_STREAM_ERROR);
+ } while (def->avail_out != 0 && flush == Z_NO_FLUSH);
+ return ret;
+}
+
+/* recompress from inf's input to def's output; the input for inf and
+ the output for def are set in those structures before calling;
+ return last deflate() return value, or Z_MEM_ERROR if inflate()
+ was not able to allocate enough memory when it needed to */
+local int recompress(z_streamp inf, z_streamp def)
+{
+ int ret, flush;
+ unsigned char raw[RAWLEN];
+
+ flush = Z_NO_FLUSH;
+ do {
+ /* decompress */
+ inf->avail_out = RAWLEN;
+ inf->next_out = raw;
+ ret = inflate(inf, Z_NO_FLUSH);
+ assert(ret != Z_STREAM_ERROR && ret != Z_DATA_ERROR &&
+ ret != Z_NEED_DICT);
+ if (ret == Z_MEM_ERROR)
+ return ret;
+
+ /* compress what was decompresed until done or no room */
+ def->avail_in = RAWLEN - inf->avail_out;
+ def->next_in = raw;
+ if (inf->avail_out != 0)
+ flush = Z_FINISH;
+ ret = deflate(def, flush);
+ assert(ret != Z_STREAM_ERROR);
+ } while (ret != Z_STREAM_END && def->avail_out != 0);
+ return ret;
+}
+
+#define EXCESS 256 /* empirically determined stream overage */
+#define MARGIN 8 /* amount to back off for completion */
+
+/* compress from stdin to fixed-size block on stdout */
+int main(int argc, char **argv)
+{
+ int ret; /* return code */
+ unsigned size; /* requested fixed output block size */
+ unsigned have; /* bytes written by deflate() call */
+ unsigned char *blk; /* intermediate and final stream */
+ unsigned char *tmp; /* close to desired size stream */
+ z_stream def, inf; /* zlib deflate and inflate states */
+
+ /* get requested output size */
+ if (argc != 2)
+ quit("need one argument: size of output block");
+ ret = strtol(argv[1], argv + 1, 10);
+ if (argv[1][0] != 0)
+ quit("argument must be a number");
+ if (ret < 8) /* 8 is minimum zlib stream size */
+ quit("need positive size of 8 or greater");
+ size = (unsigned)ret;
+
+ /* allocate memory for buffers and compression engine */
+ blk = malloc(size + EXCESS);
+ def.zalloc = Z_NULL;
+ def.zfree = Z_NULL;
+ def.opaque = Z_NULL;
+ ret = deflateInit(&def, Z_DEFAULT_COMPRESSION);
+ if (ret != Z_OK || blk == NULL)
+ quit("out of memory");
+
+ /* compress from stdin until output full, or no more input */
+ def.avail_out = size + EXCESS;
+ def.next_out = blk;
+ ret = partcompress(stdin, &def);
+ if (ret == Z_ERRNO)
+ quit("error reading input");
+
+ /* if it all fit, then size was undersubscribed -- done! */
+ if (ret == Z_STREAM_END && def.avail_out >= EXCESS) {
+ /* write block to stdout */
+ have = size + EXCESS - def.avail_out;
+ if (fwrite(blk, 1, have, stdout) != have || ferror(stdout))
+ quit("error writing output");
+
+ /* clean up and print results to stderr */
+ ret = deflateEnd(&def);
+ assert(ret != Z_STREAM_ERROR);
+ free(blk);
+ fprintf(stderr,
+ "%u bytes unused out of %u requested (all input)\n",
+ size - have, size);
+ return 0;
+ }
+
+ /* it didn't all fit -- set up for recompression */
+ inf.zalloc = Z_NULL;
+ inf.zfree = Z_NULL;
+ inf.opaque = Z_NULL;
+ inf.avail_in = 0;
+ inf.next_in = Z_NULL;
+ ret = inflateInit(&inf);
+ tmp = malloc(size + EXCESS);
+ if (ret != Z_OK || tmp == NULL)
+ quit("out of memory");
+ ret = deflateReset(&def);
+ assert(ret != Z_STREAM_ERROR);
+
+ /* do first recompression close to the right amount */
+ inf.avail_in = size + EXCESS;
+ inf.next_in = blk;
+ def.avail_out = size + EXCESS;
+ def.next_out = tmp;
+ ret = recompress(&inf, &def);
+ if (ret == Z_MEM_ERROR)
+ quit("out of memory");
+
+ /* set up for next reocmpression */
+ ret = inflateReset(&inf);
+ assert(ret != Z_STREAM_ERROR);
+ ret = deflateReset(&def);
+ assert(ret != Z_STREAM_ERROR);
+
+ /* do second and final recompression (third compression) */
+ inf.avail_in = size - MARGIN; /* assure stream will complete */
+ inf.next_in = tmp;
+ def.avail_out = size;
+ def.next_out = blk;
+ ret = recompress(&inf, &def);
+ if (ret == Z_MEM_ERROR)
+ quit("out of memory");
+ assert(ret == Z_STREAM_END); /* otherwise MARGIN too small */
+
+ /* done -- write block to stdout */
+ have = size - def.avail_out;
+ if (fwrite(blk, 1, have, stdout) != have || ferror(stdout))
+ quit("error writing output");
+
+ /* clean up and print results to stderr */
+ free(tmp);
+ ret = inflateEnd(&inf);
+ assert(ret != Z_STREAM_ERROR);
+ ret = deflateEnd(&def);
+ assert(ret != Z_STREAM_ERROR);
+ free(blk);
+ fprintf(stderr,
+ "%u bytes unused out of %u requested (%lu input)\n",
+ size - have, size, def.total_in);
+ return 0;
+}
diff --git a/compat/zlib/examples/gun.c b/compat/zlib/examples/gun.c
new file mode 100644
index 0000000..89e484f
--- /dev/null
+++ b/compat/zlib/examples/gun.c
@@ -0,0 +1,702 @@
+/* gun.c -- simple gunzip to give an example of the use of inflateBack()
+ * Copyright (C) 2003, 2005, 2008, 2010, 2012 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ Version 1.7 12 August 2012 Mark Adler */
+
+/* Version history:
+ 1.0 16 Feb 2003 First version for testing of inflateBack()
+ 1.1 21 Feb 2005 Decompress concatenated gzip streams
+ Remove use of "this" variable (C++ keyword)
+ Fix return value for in()
+ Improve allocation failure checking
+ Add typecasting for void * structures
+ Add -h option for command version and usage
+ Add a bunch of comments
+ 1.2 20 Mar 2005 Add Unix compress (LZW) decompression
+ Copy file attributes from input file to output file
+ 1.3 12 Jun 2005 Add casts for error messages [Oberhumer]
+ 1.4 8 Dec 2006 LZW decompression speed improvements
+ 1.5 9 Feb 2008 Avoid warning in latest version of gcc
+ 1.6 17 Jan 2010 Avoid signed/unsigned comparison warnings
+ 1.7 12 Aug 2012 Update for z_const usage in zlib 1.2.8
+ */
+
+/*
+ gun [ -t ] [ name ... ]
+
+ decompresses the data in the named gzip files. If no arguments are given,
+ gun will decompress from stdin to stdout. The names must end in .gz, -gz,
+ .z, -z, _z, or .Z. The uncompressed data will be written to a file name
+ with the suffix stripped. On success, the original file is deleted. On
+ failure, the output file is deleted. For most failures, the command will
+ continue to process the remaining names on the command line. A memory
+ allocation failure will abort the command. If -t is specified, then the
+ listed files or stdin will be tested as gzip files for integrity (without
+ checking for a proper suffix), no output will be written, and no files
+ will be deleted.
+
+ Like gzip, gun allows concatenated gzip streams and will decompress them,
+ writing all of the uncompressed data to the output. Unlike gzip, gun allows
+ an empty file on input, and will produce no error writing an empty output
+ file.
+
+ gun will also decompress files made by Unix compress, which uses LZW
+ compression. These files are automatically detected by virtue of their
+ magic header bytes. Since the end of Unix compress stream is marked by the
+ end-of-file, they cannot be concantenated. If a Unix compress stream is
+ encountered in an input file, it is the last stream in that file.
+
+ Like gunzip and uncompress, the file attributes of the orignal compressed
+ file are maintained in the final uncompressed file, to the extent that the
+ user permissions allow it.
+
+ On my Mac OS X PowerPC G4, gun is almost twice as fast as gunzip (version
+ 1.2.4) is on the same file, when gun is linked with zlib 1.2.2. Also the
+ LZW decompression provided by gun is about twice as fast as the standard
+ Unix uncompress command.
+ */
+
+/* external functions and related types and constants */
+#include <stdio.h> /* fprintf() */
+#include <stdlib.h> /* malloc(), free() */
+#include <string.h> /* strerror(), strcmp(), strlen(), memcpy() */
+#include <errno.h> /* errno */
+#include <fcntl.h> /* open() */
+#include <unistd.h> /* read(), write(), close(), chown(), unlink() */
+#include <sys/types.h>
+#include <sys/stat.h> /* stat(), chmod() */
+#include <utime.h> /* utime() */
+#include "zlib.h" /* inflateBackInit(), inflateBack(), */
+ /* inflateBackEnd(), crc32() */
+
+/* function declaration */
+#define local static
+
+/* buffer constants */
+#define SIZE 32768U /* input and output buffer sizes */
+#define PIECE 16384 /* limits i/o chunks for 16-bit int case */
+
+/* structure for infback() to pass to input function in() -- it maintains the
+ input file and a buffer of size SIZE */
+struct ind {
+ int infile;
+ unsigned char *inbuf;
+};
+
+/* Load input buffer, assumed to be empty, and return bytes loaded and a
+ pointer to them. read() is called until the buffer is full, or until it
+ returns end-of-file or error. Return 0 on error. */
+local unsigned in(void *in_desc, z_const unsigned char **buf)
+{
+ int ret;
+ unsigned len;
+ unsigned char *next;
+ struct ind *me = (struct ind *)in_desc;
+
+ next = me->inbuf;
+ *buf = next;
+ len = 0;
+ do {
+ ret = PIECE;
+ if ((unsigned)ret > SIZE - len)
+ ret = (int)(SIZE - len);
+ ret = (int)read(me->infile, next, ret);
+ if (ret == -1) {
+ len = 0;
+ break;
+ }
+ next += ret;
+ len += ret;
+ } while (ret != 0 && len < SIZE);
+ return len;
+}
+
+/* structure for infback() to pass to output function out() -- it maintains the
+ output file, a running CRC-32 check on the output and the total number of
+ bytes output, both for checking against the gzip trailer. (The length in
+ the gzip trailer is stored modulo 2^32, so it's ok if a long is 32 bits and
+ the output is greater than 4 GB.) */
+struct outd {
+ int outfile;
+ int check; /* true if checking crc and total */
+ unsigned long crc;
+ unsigned long total;
+};
+
+/* Write output buffer and update the CRC-32 and total bytes written. write()
+ is called until all of the output is written or an error is encountered.
+ On success out() returns 0. For a write failure, out() returns 1. If the
+ output file descriptor is -1, then nothing is written.
+ */
+local int out(void *out_desc, unsigned char *buf, unsigned len)
+{
+ int ret;
+ struct outd *me = (struct outd *)out_desc;
+
+ if (me->check) {
+ me->crc = crc32(me->crc, buf, len);
+ me->total += len;
+ }
+ if (me->outfile != -1)
+ do {
+ ret = PIECE;
+ if ((unsigned)ret > len)
+ ret = (int)len;
+ ret = (int)write(me->outfile, buf, ret);
+ if (ret == -1)
+ return 1;
+ buf += ret;
+ len -= ret;
+ } while (len != 0);
+ return 0;
+}
+
+/* next input byte macro for use inside lunpipe() and gunpipe() */
+#define NEXT() (have ? 0 : (have = in(indp, &next)), \
+ last = have ? (have--, (int)(*next++)) : -1)
+
+/* memory for gunpipe() and lunpipe() --
+ the first 256 entries of prefix[] and suffix[] are never used, could
+ have offset the index, but it's faster to waste the memory */
+unsigned char inbuf[SIZE]; /* input buffer */
+unsigned char outbuf[SIZE]; /* output buffer */
+unsigned short prefix[65536]; /* index to LZW prefix string */
+unsigned char suffix[65536]; /* one-character LZW suffix */
+unsigned char match[65280 + 2]; /* buffer for reversed match or gzip
+ 32K sliding window */
+
+/* throw out what's left in the current bits byte buffer (this is a vestigial
+ aspect of the compressed data format derived from an implementation that
+ made use of a special VAX machine instruction!) */
+#define FLUSHCODE() \
+ do { \
+ left = 0; \
+ rem = 0; \
+ if (chunk > have) { \
+ chunk -= have; \
+ have = 0; \
+ if (NEXT() == -1) \
+ break; \
+ chunk--; \
+ if (chunk > have) { \
+ chunk = have = 0; \
+ break; \
+ } \
+ } \
+ have -= chunk; \
+ next += chunk; \
+ chunk = 0; \
+ } while (0)
+
+/* Decompress a compress (LZW) file from indp to outfile. The compress magic
+ header (two bytes) has already been read and verified. There are have bytes
+ of buffered input at next. strm is used for passing error information back
+ to gunpipe().
+
+ lunpipe() will return Z_OK on success, Z_BUF_ERROR for an unexpected end of
+ file, read error, or write error (a write error indicated by strm->next_in
+ not equal to Z_NULL), or Z_DATA_ERROR for invalid input.
+ */
+local int lunpipe(unsigned have, z_const unsigned char *next, struct ind *indp,
+ int outfile, z_stream *strm)
+{
+ int last; /* last byte read by NEXT(), or -1 if EOF */
+ unsigned chunk; /* bytes left in current chunk */
+ int left; /* bits left in rem */
+ unsigned rem; /* unused bits from input */
+ int bits; /* current bits per code */
+ unsigned code; /* code, table traversal index */
+ unsigned mask; /* mask for current bits codes */
+ int max; /* maximum bits per code for this stream */
+ unsigned flags; /* compress flags, then block compress flag */
+ unsigned end; /* last valid entry in prefix/suffix tables */
+ unsigned temp; /* current code */
+ unsigned prev; /* previous code */
+ unsigned final; /* last character written for previous code */
+ unsigned stack; /* next position for reversed string */
+ unsigned outcnt; /* bytes in output buffer */
+ struct outd outd; /* output structure */
+ unsigned char *p;
+
+ /* set up output */
+ outd.outfile = outfile;
+ outd.check = 0;
+
+ /* process remainder of compress header -- a flags byte */
+ flags = NEXT();
+ if (last == -1)
+ return Z_BUF_ERROR;
+ if (flags & 0x60) {
+ strm->msg = (char *)"unknown lzw flags set";
+ return Z_DATA_ERROR;
+ }
+ max = flags & 0x1f;
+ if (max < 9 || max > 16) {
+ strm->msg = (char *)"lzw bits out of range";
+ return Z_DATA_ERROR;
+ }
+ if (max == 9) /* 9 doesn't really mean 9 */
+ max = 10;
+ flags &= 0x80; /* true if block compress */
+
+ /* clear table */
+ bits = 9;
+ mask = 0x1ff;
+ end = flags ? 256 : 255;
+
+ /* set up: get first 9-bit code, which is the first decompressed byte, but
+ don't create a table entry until the next code */
+ if (NEXT() == -1) /* no compressed data is ok */
+ return Z_OK;
+ final = prev = (unsigned)last; /* low 8 bits of code */
+ if (NEXT() == -1) /* missing a bit */
+ return Z_BUF_ERROR;
+ if (last & 1) { /* code must be < 256 */
+ strm->msg = (char *)"invalid lzw code";
+ return Z_DATA_ERROR;
+ }
+ rem = (unsigned)last >> 1; /* remaining 7 bits */
+ left = 7;
+ chunk = bits - 2; /* 7 bytes left in this chunk */
+ outbuf[0] = (unsigned char)final; /* write first decompressed byte */
+ outcnt = 1;
+
+ /* decode codes */
+ stack = 0;
+ for (;;) {
+ /* if the table will be full after this, increment the code size */
+ if (end >= mask && bits < max) {
+ FLUSHCODE();
+ bits++;
+ mask <<= 1;
+ mask++;
+ }
+
+ /* get a code of length bits */
+ if (chunk == 0) /* decrement chunk modulo bits */
+ chunk = bits;
+ code = rem; /* low bits of code */
+ if (NEXT() == -1) { /* EOF is end of compressed data */
+ /* write remaining buffered output */
+ if (outcnt && out(&outd, outbuf, outcnt)) {
+ strm->next_in = outbuf; /* signal write error */
+ return Z_BUF_ERROR;
+ }
+ return Z_OK;
+ }
+ code += (unsigned)last << left; /* middle (or high) bits of code */
+ left += 8;
+ chunk--;
+ if (bits > left) { /* need more bits */
+ if (NEXT() == -1) /* can't end in middle of code */
+ return Z_BUF_ERROR;
+ code += (unsigned)last << left; /* high bits of code */
+ left += 8;
+ chunk--;
+ }
+ code &= mask; /* mask to current code length */
+ left -= bits; /* number of unused bits */
+ rem = (unsigned)last >> (8 - left); /* unused bits from last byte */
+
+ /* process clear code (256) */
+ if (code == 256 && flags) {
+ FLUSHCODE();
+ bits = 9; /* initialize bits and mask */
+ mask = 0x1ff;
+ end = 255; /* empty table */
+ continue; /* get next code */
+ }
+
+ /* special code to reuse last match */
+ temp = code; /* save the current code */
+ if (code > end) {
+ /* Be picky on the allowed code here, and make sure that the code
+ we drop through (prev) will be a valid index so that random
+ input does not cause an exception. The code != end + 1 check is
+ empirically derived, and not checked in the original uncompress
+ code. If this ever causes a problem, that check could be safely
+ removed. Leaving this check in greatly improves gun's ability
+ to detect random or corrupted input after a compress header.
+ In any case, the prev > end check must be retained. */
+ if (code != end + 1 || prev > end) {
+ strm->msg = (char *)"invalid lzw code";
+ return Z_DATA_ERROR;
+ }
+ match[stack++] = (unsigned char)final;
+ code = prev;
+ }
+
+ /* walk through linked list to generate output in reverse order */
+ p = match + stack;
+ while (code >= 256) {
+ *p++ = suffix[code];
+ code = prefix[code];
+ }
+ stack = p - match;
+ match[stack++] = (unsigned char)code;
+ final = code;
+
+ /* link new table entry */
+ if (end < mask) {
+ end++;
+ prefix[end] = (unsigned short)prev;
+ suffix[end] = (unsigned char)final;
+ }
+
+ /* set previous code for next iteration */
+ prev = temp;
+
+ /* write output in forward order */
+ while (stack > SIZE - outcnt) {
+ while (outcnt < SIZE)
+ outbuf[outcnt++] = match[--stack];
+ if (out(&outd, outbuf, outcnt)) {
+ strm->next_in = outbuf; /* signal write error */
+ return Z_BUF_ERROR;
+ }
+ outcnt = 0;
+ }
+ p = match + stack;
+ do {
+ outbuf[outcnt++] = *--p;
+ } while (p > match);
+ stack = 0;
+
+ /* loop for next code with final and prev as the last match, rem and
+ left provide the first 0..7 bits of the next code, end is the last
+ valid table entry */
+ }
+}
+
+/* Decompress a gzip file from infile to outfile. strm is assumed to have been
+ successfully initialized with inflateBackInit(). The input file may consist
+ of a series of gzip streams, in which case all of them will be decompressed
+ to the output file. If outfile is -1, then the gzip stream(s) integrity is
+ checked and nothing is written.
+
+ The return value is a zlib error code: Z_MEM_ERROR if out of memory,
+ Z_DATA_ERROR if the header or the compressed data is invalid, or if the
+ trailer CRC-32 check or length doesn't match, Z_BUF_ERROR if the input ends
+ prematurely or a write error occurs, or Z_ERRNO if junk (not a another gzip
+ stream) follows a valid gzip stream.
+ */
+local int gunpipe(z_stream *strm, int infile, int outfile)
+{
+ int ret, first, last;
+ unsigned have, flags, len;
+ z_const unsigned char *next = NULL;
+ struct ind ind, *indp;
+ struct outd outd;
+
+ /* setup input buffer */
+ ind.infile = infile;
+ ind.inbuf = inbuf;
+ indp = &ind;
+
+ /* decompress concatenated gzip streams */
+ have = 0; /* no input data read in yet */
+ first = 1; /* looking for first gzip header */
+ strm->next_in = Z_NULL; /* so Z_BUF_ERROR means EOF */
+ for (;;) {
+ /* look for the two magic header bytes for a gzip stream */
+ if (NEXT() == -1) {
+ ret = Z_OK;
+ break; /* empty gzip stream is ok */
+ }
+ if (last != 31 || (NEXT() != 139 && last != 157)) {
+ strm->msg = (char *)"incorrect header check";
+ ret = first ? Z_DATA_ERROR : Z_ERRNO;
+ break; /* not a gzip or compress header */
+ }
+ first = 0; /* next non-header is junk */
+
+ /* process a compress (LZW) file -- can't be concatenated after this */
+ if (last == 157) {
+ ret = lunpipe(have, next, indp, outfile, strm);
+ break;
+ }
+
+ /* process remainder of gzip header */
+ ret = Z_BUF_ERROR;
+ if (NEXT() != 8) { /* only deflate method allowed */
+ if (last == -1) break;
+ strm->msg = (char *)"unknown compression method";
+ ret = Z_DATA_ERROR;
+ break;
+ }
+ flags = NEXT(); /* header flags */
+ NEXT(); /* discard mod time, xflgs, os */
+ NEXT();
+ NEXT();
+ NEXT();
+ NEXT();
+ NEXT();
+ if (last == -1) break;
+ if (flags & 0xe0) {
+ strm->msg = (char *)"unknown header flags set";
+ ret = Z_DATA_ERROR;
+ break;
+ }
+ if (flags & 4) { /* extra field */
+ len = NEXT();
+ len += (unsigned)(NEXT()) << 8;
+ if (last == -1) break;
+ while (len > have) {
+ len -= have;
+ have = 0;
+ if (NEXT() == -1) break;
+ len--;
+ }
+ if (last == -1) break;
+ have -= len;
+ next += len;
+ }
+ if (flags & 8) /* file name */
+ while (NEXT() != 0 && last != -1)
+ ;
+ if (flags & 16) /* comment */
+ while (NEXT() != 0 && last != -1)
+ ;
+ if (flags & 2) { /* header crc */
+ NEXT();
+ NEXT();
+ }
+ if (last == -1) break;
+
+ /* set up output */
+ outd.outfile = outfile;
+ outd.check = 1;
+ outd.crc = crc32(0L, Z_NULL, 0);
+ outd.total = 0;
+
+ /* decompress data to output */
+ strm->next_in = next;
+ strm->avail_in = have;
+ ret = inflateBack(strm, in, indp, out, &outd);
+ if (ret != Z_STREAM_END) break;
+ next = strm->next_in;
+ have = strm->avail_in;
+ strm->next_in = Z_NULL; /* so Z_BUF_ERROR means EOF */
+
+ /* check trailer */
+ ret = Z_BUF_ERROR;
+ if (NEXT() != (int)(outd.crc & 0xff) ||
+ NEXT() != (int)((outd.crc >> 8) & 0xff) ||
+ NEXT() != (int)((outd.crc >> 16) & 0xff) ||
+ NEXT() != (int)((outd.crc >> 24) & 0xff)) {
+ /* crc error */
+ if (last != -1) {
+ strm->msg = (char *)"incorrect data check";
+ ret = Z_DATA_ERROR;
+ }
+ break;
+ }
+ if (NEXT() != (int)(outd.total & 0xff) ||
+ NEXT() != (int)((outd.total >> 8) & 0xff) ||
+ NEXT() != (int)((outd.total >> 16) & 0xff) ||
+ NEXT() != (int)((outd.total >> 24) & 0xff)) {
+ /* length error */
+ if (last != -1) {
+ strm->msg = (char *)"incorrect length check";
+ ret = Z_DATA_ERROR;
+ }
+ break;
+ }
+
+ /* go back and look for another gzip stream */
+ }
+
+ /* clean up and return */
+ return ret;
+}
+
+/* Copy file attributes, from -> to, as best we can. This is best effort, so
+ no errors are reported. The mode bits, including suid, sgid, and the sticky
+ bit are copied (if allowed), the owner's user id and group id are copied
+ (again if allowed), and the access and modify times are copied. */
+local void copymeta(char *from, char *to)
+{
+ struct stat was;
+ struct utimbuf when;
+
+ /* get all of from's Unix meta data, return if not a regular file */
+ if (stat(from, &was) != 0 || (was.st_mode & S_IFMT) != S_IFREG)
+ return;
+
+ /* set to's mode bits, ignore errors */
+ (void)chmod(to, was.st_mode & 07777);
+
+ /* copy owner's user and group, ignore errors */
+ (void)chown(to, was.st_uid, was.st_gid);
+
+ /* copy access and modify times, ignore errors */
+ when.actime = was.st_atime;
+ when.modtime = was.st_mtime;
+ (void)utime(to, &when);
+}
+
+/* Decompress the file inname to the file outnname, of if test is true, just
+ decompress without writing and check the gzip trailer for integrity. If
+ inname is NULL or an empty string, read from stdin. If outname is NULL or
+ an empty string, write to stdout. strm is a pre-initialized inflateBack
+ structure. When appropriate, copy the file attributes from inname to
+ outname.
+
+ gunzip() returns 1 if there is an out-of-memory error or an unexpected
+ return code from gunpipe(). Otherwise it returns 0.
+ */
+local int gunzip(z_stream *strm, char *inname, char *outname, int test)
+{
+ int ret;
+ int infile, outfile;
+
+ /* open files */
+ if (inname == NULL || *inname == 0) {
+ inname = "-";
+ infile = 0; /* stdin */
+ }
+ else {
+ infile = open(inname, O_RDONLY, 0);
+ if (infile == -1) {
+ fprintf(stderr, "gun cannot open %s\n", inname);
+ return 0;
+ }
+ }
+ if (test)
+ outfile = -1;
+ else if (outname == NULL || *outname == 0) {
+ outname = "-";
+ outfile = 1; /* stdout */
+ }
+ else {
+ outfile = open(outname, O_CREAT | O_TRUNC | O_WRONLY, 0666);
+ if (outfile == -1) {
+ close(infile);
+ fprintf(stderr, "gun cannot create %s\n", outname);
+ return 0;
+ }
+ }
+ errno = 0;
+
+ /* decompress */
+ ret = gunpipe(strm, infile, outfile);
+ if (outfile > 2) close(outfile);
+ if (infile > 2) close(infile);
+
+ /* interpret result */
+ switch (ret) {
+ case Z_OK:
+ case Z_ERRNO:
+ if (infile > 2 && outfile > 2) {
+ copymeta(inname, outname); /* copy attributes */
+ unlink(inname);
+ }
+ if (ret == Z_ERRNO)
+ fprintf(stderr, "gun warning: trailing garbage ignored in %s\n",
+ inname);
+ break;
+ case Z_DATA_ERROR:
+ if (outfile > 2) unlink(outname);
+ fprintf(stderr, "gun data error on %s: %s\n", inname, strm->msg);
+ break;
+ case Z_MEM_ERROR:
+ if (outfile > 2) unlink(outname);
+ fprintf(stderr, "gun out of memory error--aborting\n");
+ return 1;
+ case Z_BUF_ERROR:
+ if (outfile > 2) unlink(outname);
+ if (strm->next_in != Z_NULL) {
+ fprintf(stderr, "gun write error on %s: %s\n",
+ outname, strerror(errno));
+ }
+ else if (errno) {
+ fprintf(stderr, "gun read error on %s: %s\n",
+ inname, strerror(errno));
+ }
+ else {
+ fprintf(stderr, "gun unexpected end of file on %s\n",
+ inname);
+ }
+ break;
+ default:
+ if (outfile > 2) unlink(outname);
+ fprintf(stderr, "gun internal error--aborting\n");
+ return 1;
+ }
+ return 0;
+}
+
+/* Process the gun command line arguments. See the command syntax near the
+ beginning of this source file. */
+int main(int argc, char **argv)
+{
+ int ret, len, test;
+ char *outname;
+ unsigned char *window;
+ z_stream strm;
+
+ /* initialize inflateBack state for repeated use */
+ window = match; /* reuse LZW match buffer */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ ret = inflateBackInit(&strm, 15, window);
+ if (ret != Z_OK) {
+ fprintf(stderr, "gun out of memory error--aborting\n");
+ return 1;
+ }
+
+ /* decompress each file to the same name with the suffix removed */
+ argc--;
+ argv++;
+ test = 0;
+ if (argc && strcmp(*argv, "-h") == 0) {
+ fprintf(stderr, "gun 1.6 (17 Jan 2010)\n");
+ fprintf(stderr, "Copyright (C) 2003-2010 Mark Adler\n");
+ fprintf(stderr, "usage: gun [-t] [file1.gz [file2.Z ...]]\n");
+ return 0;
+ }
+ if (argc && strcmp(*argv, "-t") == 0) {
+ test = 1;
+ argc--;
+ argv++;
+ }
+ if (argc)
+ do {
+ if (test)
+ outname = NULL;
+ else {
+ len = (int)strlen(*argv);
+ if (strcmp(*argv + len - 3, ".gz") == 0 ||
+ strcmp(*argv + len - 3, "-gz") == 0)
+ len -= 3;
+ else if (strcmp(*argv + len - 2, ".z") == 0 ||
+ strcmp(*argv + len - 2, "-z") == 0 ||
+ strcmp(*argv + len - 2, "_z") == 0 ||
+ strcmp(*argv + len - 2, ".Z") == 0)
+ len -= 2;
+ else {
+ fprintf(stderr, "gun error: no gz type on %s--skipping\n",
+ *argv);
+ continue;
+ }
+ outname = malloc(len + 1);
+ if (outname == NULL) {
+ fprintf(stderr, "gun out of memory error--aborting\n");
+ ret = 1;
+ break;
+ }
+ memcpy(outname, *argv, len);
+ outname[len] = 0;
+ }
+ ret = gunzip(&strm, *argv, outname, test);
+ if (outname != NULL) free(outname);
+ if (ret) break;
+ } while (argv++, --argc);
+ else
+ ret = gunzip(&strm, NULL, NULL, test);
+
+ /* clean up */
+ inflateBackEnd(&strm);
+ return ret;
+}
diff --git a/compat/zlib/examples/gzappend.c b/compat/zlib/examples/gzappend.c
new file mode 100644
index 0000000..662dec3
--- /dev/null
+++ b/compat/zlib/examples/gzappend.c
@@ -0,0 +1,504 @@
+/* gzappend -- command to append to a gzip file
+
+ Copyright (C) 2003, 2012 Mark Adler, all rights reserved
+ version 1.2, 11 Oct 2012
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Mark Adler madler@alumni.caltech.edu
+ */
+
+/*
+ * Change history:
+ *
+ * 1.0 19 Oct 2003 - First version
+ * 1.1 4 Nov 2003 - Expand and clarify some comments and notes
+ * - Add version and copyright to help
+ * - Send help to stdout instead of stderr
+ * - Add some preemptive typecasts
+ * - Add L to constants in lseek() calls
+ * - Remove some debugging information in error messages
+ * - Use new data_type definition for zlib 1.2.1
+ * - Simplfy and unify file operations
+ * - Finish off gzip file in gztack()
+ * - Use deflatePrime() instead of adding empty blocks
+ * - Keep gzip file clean on appended file read errors
+ * - Use in-place rotate instead of auxiliary buffer
+ * (Why you ask? Because it was fun to write!)
+ * 1.2 11 Oct 2012 - Fix for proper z_const usage
+ * - Check for input buffer malloc failure
+ */
+
+/*
+ gzappend takes a gzip file and appends to it, compressing files from the
+ command line or data from stdin. The gzip file is written to directly, to
+ avoid copying that file, in case it's large. Note that this results in the
+ unfriendly behavior that if gzappend fails, the gzip file is corrupted.
+
+ This program was written to illustrate the use of the new Z_BLOCK option of
+ zlib 1.2.x's inflate() function. This option returns from inflate() at each
+ block boundary to facilitate locating and modifying the last block bit at
+ the start of the final deflate block. Also whether using Z_BLOCK or not,
+ another required feature of zlib 1.2.x is that inflate() now provides the
+ number of unusued bits in the last input byte used. gzappend will not work
+ with versions of zlib earlier than 1.2.1.
+
+ gzappend first decompresses the gzip file internally, discarding all but
+ the last 32K of uncompressed data, and noting the location of the last block
+ bit and the number of unused bits in the last byte of the compressed data.
+ The gzip trailer containing the CRC-32 and length of the uncompressed data
+ is verified. This trailer will be later overwritten.
+
+ Then the last block bit is cleared by seeking back in the file and rewriting
+ the byte that contains it. Seeking forward, the last byte of the compressed
+ data is saved along with the number of unused bits to initialize deflate.
+
+ A deflate process is initialized, using the last 32K of the uncompressed
+ data from the gzip file to initialize the dictionary. If the total
+ uncompressed data was less than 32K, then all of it is used to initialize
+ the dictionary. The deflate output bit buffer is also initialized with the
+ last bits from the original deflate stream. From here on, the data to
+ append is simply compressed using deflate, and written to the gzip file.
+ When that is complete, the new CRC-32 and uncompressed length are written
+ as the trailer of the gzip file.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include "zlib.h"
+
+#define local static
+#define LGCHUNK 14
+#define CHUNK (1U << LGCHUNK)
+#define DSIZE 32768U
+
+/* print an error message and terminate with extreme prejudice */
+local void bye(char *msg1, char *msg2)
+{
+ fprintf(stderr, "gzappend error: %s%s\n", msg1, msg2);
+ exit(1);
+}
+
+/* return the greatest common divisor of a and b using Euclid's algorithm,
+ modified to be fast when one argument much greater than the other, and
+ coded to avoid unnecessary swapping */
+local unsigned gcd(unsigned a, unsigned b)
+{
+ unsigned c;
+
+ while (a && b)
+ if (a > b) {
+ c = b;
+ while (a - c >= c)
+ c <<= 1;
+ a -= c;
+ }
+ else {
+ c = a;
+ while (b - c >= c)
+ c <<= 1;
+ b -= c;
+ }
+ return a + b;
+}
+
+/* rotate list[0..len-1] left by rot positions, in place */
+local void rotate(unsigned char *list, unsigned len, unsigned rot)
+{
+ unsigned char tmp;
+ unsigned cycles;
+ unsigned char *start, *last, *to, *from;
+
+ /* normalize rot and handle degenerate cases */
+ if (len < 2) return;
+ if (rot >= len) rot %= len;
+ if (rot == 0) return;
+
+ /* pointer to last entry in list */
+ last = list + (len - 1);
+
+ /* do simple left shift by one */
+ if (rot == 1) {
+ tmp = *list;
+ memcpy(list, list + 1, len - 1);
+ *last = tmp;
+ return;
+ }
+
+ /* do simple right shift by one */
+ if (rot == len - 1) {
+ tmp = *last;
+ memmove(list + 1, list, len - 1);
+ *list = tmp;
+ return;
+ }
+
+ /* otherwise do rotate as a set of cycles in place */
+ cycles = gcd(len, rot); /* number of cycles */
+ do {
+ start = from = list + cycles; /* start index is arbitrary */
+ tmp = *from; /* save entry to be overwritten */
+ for (;;) {
+ to = from; /* next step in cycle */
+ from += rot; /* go right rot positions */
+ if (from > last) from -= len; /* (pointer better not wrap) */
+ if (from == start) break; /* all but one shifted */
+ *to = *from; /* shift left */
+ }
+ *to = tmp; /* complete the circle */
+ } while (--cycles);
+}
+
+/* structure for gzip file read operations */
+typedef struct {
+ int fd; /* file descriptor */
+ int size; /* 1 << size is bytes in buf */
+ unsigned left; /* bytes available at next */
+ unsigned char *buf; /* buffer */
+ z_const unsigned char *next; /* next byte in buffer */
+ char *name; /* file name for error messages */
+} file;
+
+/* reload buffer */
+local int readin(file *in)
+{
+ int len;
+
+ len = read(in->fd, in->buf, 1 << in->size);
+ if (len == -1) bye("error reading ", in->name);
+ in->left = (unsigned)len;
+ in->next = in->buf;
+ return len;
+}
+
+/* read from file in, exit if end-of-file */
+local int readmore(file *in)
+{
+ if (readin(in) == 0) bye("unexpected end of ", in->name);
+ return 0;
+}
+
+#define read1(in) (in->left == 0 ? readmore(in) : 0, \
+ in->left--, *(in->next)++)
+
+/* skip over n bytes of in */
+local void skip(file *in, unsigned n)
+{
+ unsigned bypass;
+
+ if (n > in->left) {
+ n -= in->left;
+ bypass = n & ~((1U << in->size) - 1);
+ if (bypass) {
+ if (lseek(in->fd, (off_t)bypass, SEEK_CUR) == -1)
+ bye("seeking ", in->name);
+ n -= bypass;
+ }
+ readmore(in);
+ if (n > in->left)
+ bye("unexpected end of ", in->name);
+ }
+ in->left -= n;
+ in->next += n;
+}
+
+/* read a four-byte unsigned integer, little-endian, from in */
+unsigned long read4(file *in)
+{
+ unsigned long val;
+
+ val = read1(in);
+ val += (unsigned)read1(in) << 8;
+ val += (unsigned long)read1(in) << 16;
+ val += (unsigned long)read1(in) << 24;
+ return val;
+}
+
+/* skip over gzip header */
+local void gzheader(file *in)
+{
+ int flags;
+ unsigned n;
+
+ if (read1(in) != 31 || read1(in) != 139) bye(in->name, " not a gzip file");
+ if (read1(in) != 8) bye("unknown compression method in", in->name);
+ flags = read1(in);
+ if (flags & 0xe0) bye("unknown header flags set in", in->name);
+ skip(in, 6);
+ if (flags & 4) {
+ n = read1(in);
+ n += (unsigned)(read1(in)) << 8;
+ skip(in, n);
+ }
+ if (flags & 8) while (read1(in) != 0) ;
+ if (flags & 16) while (read1(in) != 0) ;
+ if (flags & 2) skip(in, 2);
+}
+
+/* decompress gzip file "name", return strm with a deflate stream ready to
+ continue compression of the data in the gzip file, and return a file
+ descriptor pointing to where to write the compressed data -- the deflate
+ stream is initialized to compress using level "level" */
+local int gzscan(char *name, z_stream *strm, int level)
+{
+ int ret, lastbit, left, full;
+ unsigned have;
+ unsigned long crc, tot;
+ unsigned char *window;
+ off_t lastoff, end;
+ file gz;
+
+ /* open gzip file */
+ gz.name = name;
+ gz.fd = open(name, O_RDWR, 0);
+ if (gz.fd == -1) bye("cannot open ", name);
+ gz.buf = malloc(CHUNK);
+ if (gz.buf == NULL) bye("out of memory", "");
+ gz.size = LGCHUNK;
+ gz.left = 0;
+
+ /* skip gzip header */
+ gzheader(&gz);
+
+ /* prepare to decompress */
+ window = malloc(DSIZE);
+ if (window == NULL) bye("out of memory", "");
+ strm->zalloc = Z_NULL;
+ strm->zfree = Z_NULL;
+ strm->opaque = Z_NULL;
+ ret = inflateInit2(strm, -15);
+ if (ret != Z_OK) bye("out of memory", " or library mismatch");
+
+ /* decompress the deflate stream, saving append information */
+ lastbit = 0;
+ lastoff = lseek(gz.fd, 0L, SEEK_CUR) - gz.left;
+ left = 0;
+ strm->avail_in = gz.left;
+ strm->next_in = gz.next;
+ crc = crc32(0L, Z_NULL, 0);
+ have = full = 0;
+ do {
+ /* if needed, get more input */
+ if (strm->avail_in == 0) {
+ readmore(&gz);
+ strm->avail_in = gz.left;
+ strm->next_in = gz.next;
+ }
+
+ /* set up output to next available section of sliding window */
+ strm->avail_out = DSIZE - have;
+ strm->next_out = window + have;
+
+ /* inflate and check for errors */
+ ret = inflate(strm, Z_BLOCK);
+ if (ret == Z_STREAM_ERROR) bye("internal stream error!", "");
+ if (ret == Z_MEM_ERROR) bye("out of memory", "");
+ if (ret == Z_DATA_ERROR)
+ bye("invalid compressed data--format violated in", name);
+
+ /* update crc and sliding window pointer */
+ crc = crc32(crc, window + have, DSIZE - have - strm->avail_out);
+ if (strm->avail_out)
+ have = DSIZE - strm->avail_out;
+ else {
+ have = 0;
+ full = 1;
+ }
+
+ /* process end of block */
+ if (strm->data_type & 128) {
+ if (strm->data_type & 64)
+ left = strm->data_type & 0x1f;
+ else {
+ lastbit = strm->data_type & 0x1f;
+ lastoff = lseek(gz.fd, 0L, SEEK_CUR) - strm->avail_in;
+ }
+ }
+ } while (ret != Z_STREAM_END);
+ inflateEnd(strm);
+ gz.left = strm->avail_in;
+ gz.next = strm->next_in;
+
+ /* save the location of the end of the compressed data */
+ end = lseek(gz.fd, 0L, SEEK_CUR) - gz.left;
+
+ /* check gzip trailer and save total for deflate */
+ if (crc != read4(&gz))
+ bye("invalid compressed data--crc mismatch in ", name);
+ tot = strm->total_out;
+ if ((tot & 0xffffffffUL) != read4(&gz))
+ bye("invalid compressed data--length mismatch in", name);
+
+ /* if not at end of file, warn */
+ if (gz.left || readin(&gz))
+ fprintf(stderr,
+ "gzappend warning: junk at end of gzip file overwritten\n");
+
+ /* clear last block bit */
+ lseek(gz.fd, lastoff - (lastbit != 0), SEEK_SET);
+ if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name);
+ *gz.buf = (unsigned char)(*gz.buf ^ (1 << ((8 - lastbit) & 7)));
+ lseek(gz.fd, -1L, SEEK_CUR);
+ if (write(gz.fd, gz.buf, 1) != 1) bye("writing after seek to ", name);
+
+ /* if window wrapped, build dictionary from window by rotating */
+ if (full) {
+ rotate(window, DSIZE, have);
+ have = DSIZE;
+ }
+
+ /* set up deflate stream with window, crc, total_in, and leftover bits */
+ ret = deflateInit2(strm, level, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY);
+ if (ret != Z_OK) bye("out of memory", "");
+ deflateSetDictionary(strm, window, have);
+ strm->adler = crc;
+ strm->total_in = tot;
+ if (left) {
+ lseek(gz.fd, --end, SEEK_SET);
+ if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name);
+ deflatePrime(strm, 8 - left, *gz.buf);
+ }
+ lseek(gz.fd, end, SEEK_SET);
+
+ /* clean up and return */
+ free(window);
+ free(gz.buf);
+ return gz.fd;
+}
+
+/* append file "name" to gzip file gd using deflate stream strm -- if last
+ is true, then finish off the deflate stream at the end */
+local void gztack(char *name, int gd, z_stream *strm, int last)
+{
+ int fd, len, ret;
+ unsigned left;
+ unsigned char *in, *out;
+
+ /* open file to compress and append */
+ fd = 0;
+ if (name != NULL) {
+ fd = open(name, O_RDONLY, 0);
+ if (fd == -1)
+ fprintf(stderr, "gzappend warning: %s not found, skipping ...\n",
+ name);
+ }
+
+ /* allocate buffers */
+ in = malloc(CHUNK);
+ out = malloc(CHUNK);
+ if (in == NULL || out == NULL) bye("out of memory", "");
+
+ /* compress input file and append to gzip file */
+ do {
+ /* get more input */
+ len = read(fd, in, CHUNK);
+ if (len == -1) {
+ fprintf(stderr,
+ "gzappend warning: error reading %s, skipping rest ...\n",
+ name);
+ len = 0;
+ }
+ strm->avail_in = (unsigned)len;
+ strm->next_in = in;
+ if (len) strm->adler = crc32(strm->adler, in, (unsigned)len);
+
+ /* compress and write all available output */
+ do {
+ strm->avail_out = CHUNK;
+ strm->next_out = out;
+ ret = deflate(strm, last && len == 0 ? Z_FINISH : Z_NO_FLUSH);
+ left = CHUNK - strm->avail_out;
+ while (left) {
+ len = write(gd, out + CHUNK - strm->avail_out - left, left);
+ if (len == -1) bye("writing gzip file", "");
+ left -= (unsigned)len;
+ }
+ } while (strm->avail_out == 0 && ret != Z_STREAM_END);
+ } while (len != 0);
+
+ /* write trailer after last entry */
+ if (last) {
+ deflateEnd(strm);
+ out[0] = (unsigned char)(strm->adler);
+ out[1] = (unsigned char)(strm->adler >> 8);
+ out[2] = (unsigned char)(strm->adler >> 16);
+ out[3] = (unsigned char)(strm->adler >> 24);
+ out[4] = (unsigned char)(strm->total_in);
+ out[5] = (unsigned char)(strm->total_in >> 8);
+ out[6] = (unsigned char)(strm->total_in >> 16);
+ out[7] = (unsigned char)(strm->total_in >> 24);
+ len = 8;
+ do {
+ ret = write(gd, out + 8 - len, len);
+ if (ret == -1) bye("writing gzip file", "");
+ len -= ret;
+ } while (len);
+ close(gd);
+ }
+
+ /* clean up and return */
+ free(out);
+ free(in);
+ if (fd > 0) close(fd);
+}
+
+/* process the compression level option if present, scan the gzip file, and
+ append the specified files, or append the data from stdin if no other file
+ names are provided on the command line -- the gzip file must be writable
+ and seekable */
+int main(int argc, char **argv)
+{
+ int gd, level;
+ z_stream strm;
+
+ /* ignore command name */
+ argc--; argv++;
+
+ /* provide usage if no arguments */
+ if (*argv == NULL) {
+ printf(
+ "gzappend 1.2 (11 Oct 2012) Copyright (C) 2003, 2012 Mark Adler\n"
+ );
+ printf(
+ "usage: gzappend [-level] file.gz [ addthis [ andthis ... ]]\n");
+ return 0;
+ }
+
+ /* set compression level */
+ level = Z_DEFAULT_COMPRESSION;
+ if (argv[0][0] == '-') {
+ if (argv[0][1] < '0' || argv[0][1] > '9' || argv[0][2] != 0)
+ bye("invalid compression level", "");
+ level = argv[0][1] - '0';
+ if (*++argv == NULL) bye("no gzip file name after options", "");
+ }
+
+ /* prepare to append to gzip file */
+ gd = gzscan(*argv++, &strm, level);
+
+ /* append files on command line, or from stdin if none */
+ if (*argv == NULL)
+ gztack(NULL, gd, &strm, 1);
+ else
+ do {
+ gztack(*argv, gd, &strm, argv[1] == NULL);
+ } while (*++argv != NULL);
+ return 0;
+}
diff --git a/compat/zlib/examples/gzjoin.c b/compat/zlib/examples/gzjoin.c
new file mode 100644
index 0000000..89e8098
--- /dev/null
+++ b/compat/zlib/examples/gzjoin.c
@@ -0,0 +1,449 @@
+/* gzjoin -- command to join gzip files into one gzip file
+
+ Copyright (C) 2004, 2005, 2012 Mark Adler, all rights reserved
+ version 1.2, 14 Aug 2012
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Mark Adler madler@alumni.caltech.edu
+ */
+
+/*
+ * Change history:
+ *
+ * 1.0 11 Dec 2004 - First version
+ * 1.1 12 Jun 2005 - Changed ssize_t to long for portability
+ * 1.2 14 Aug 2012 - Clean up for z_const usage
+ */
+
+/*
+ gzjoin takes one or more gzip files on the command line and writes out a
+ single gzip file that will uncompress to the concatenation of the
+ uncompressed data from the individual gzip files. gzjoin does this without
+ having to recompress any of the data and without having to calculate a new
+ crc32 for the concatenated uncompressed data. gzjoin does however have to
+ decompress all of the input data in order to find the bits in the compressed
+ data that need to be modified to concatenate the streams.
+
+ gzjoin does not do an integrity check on the input gzip files other than
+ checking the gzip header and decompressing the compressed data. They are
+ otherwise assumed to be complete and correct.
+
+ Each joint between gzip files removes at least 18 bytes of previous trailer
+ and subsequent header, and inserts an average of about three bytes to the
+ compressed data in order to connect the streams. The output gzip file
+ has a minimal ten-byte gzip header with no file name or modification time.
+
+ This program was written to illustrate the use of the Z_BLOCK option of
+ inflate() and the crc32_combine() function. gzjoin will not compile with
+ versions of zlib earlier than 1.2.3.
+ */
+
+#include <stdio.h> /* fputs(), fprintf(), fwrite(), putc() */
+#include <stdlib.h> /* exit(), malloc(), free() */
+#include <fcntl.h> /* open() */
+#include <unistd.h> /* close(), read(), lseek() */
+#include "zlib.h"
+ /* crc32(), crc32_combine(), inflateInit2(), inflate(), inflateEnd() */
+
+#define local static
+
+/* exit with an error (return a value to allow use in an expression) */
+local int bail(char *why1, char *why2)
+{
+ fprintf(stderr, "gzjoin error: %s%s, output incomplete\n", why1, why2);
+ exit(1);
+ return 0;
+}
+
+/* -- simple buffered file input with access to the buffer -- */
+
+#define CHUNK 32768 /* must be a power of two and fit in unsigned */
+
+/* bin buffered input file type */
+typedef struct {
+ char *name; /* name of file for error messages */
+ int fd; /* file descriptor */
+ unsigned left; /* bytes remaining at next */
+ unsigned char *next; /* next byte to read */
+ unsigned char *buf; /* allocated buffer of length CHUNK */
+} bin;
+
+/* close a buffered file and free allocated memory */
+local void bclose(bin *in)
+{
+ if (in != NULL) {
+ if (in->fd != -1)
+ close(in->fd);
+ if (in->buf != NULL)
+ free(in->buf);
+ free(in);
+ }
+}
+
+/* open a buffered file for input, return a pointer to type bin, or NULL on
+ failure */
+local bin *bopen(char *name)
+{
+ bin *in;
+
+ in = malloc(sizeof(bin));
+ if (in == NULL)
+ return NULL;
+ in->buf = malloc(CHUNK);
+ in->fd = open(name, O_RDONLY, 0);
+ if (in->buf == NULL || in->fd == -1) {
+ bclose(in);
+ return NULL;
+ }
+ in->left = 0;
+ in->next = in->buf;
+ in->name = name;
+ return in;
+}
+
+/* load buffer from file, return -1 on read error, 0 or 1 on success, with
+ 1 indicating that end-of-file was reached */
+local int bload(bin *in)
+{
+ long len;
+
+ if (in == NULL)
+ return -1;
+ if (in->left != 0)
+ return 0;
+ in->next = in->buf;
+ do {
+ len = (long)read(in->fd, in->buf + in->left, CHUNK - in->left);
+ if (len < 0)
+ return -1;
+ in->left += (unsigned)len;
+ } while (len != 0 && in->left < CHUNK);
+ return len == 0 ? 1 : 0;
+}
+
+/* get a byte from the file, bail if end of file */
+#define bget(in) (in->left ? 0 : bload(in), \
+ in->left ? (in->left--, *(in->next)++) : \
+ bail("unexpected end of file on ", in->name))
+
+/* get a four-byte little-endian unsigned integer from file */
+local unsigned long bget4(bin *in)
+{
+ unsigned long val;
+
+ val = bget(in);
+ val += (unsigned long)(bget(in)) << 8;
+ val += (unsigned long)(bget(in)) << 16;
+ val += (unsigned long)(bget(in)) << 24;
+ return val;
+}
+
+/* skip bytes in file */
+local void bskip(bin *in, unsigned skip)
+{
+ /* check pointer */
+ if (in == NULL)
+ return;
+
+ /* easy case -- skip bytes in buffer */
+ if (skip <= in->left) {
+ in->left -= skip;
+ in->next += skip;
+ return;
+ }
+
+ /* skip what's in buffer, discard buffer contents */
+ skip -= in->left;
+ in->left = 0;
+
+ /* seek past multiples of CHUNK bytes */
+ if (skip > CHUNK) {
+ unsigned left;
+
+ left = skip & (CHUNK - 1);
+ if (left == 0) {
+ /* exact number of chunks: seek all the way minus one byte to check
+ for end-of-file with a read */
+ lseek(in->fd, skip - 1, SEEK_CUR);
+ if (read(in->fd, in->buf, 1) != 1)
+ bail("unexpected end of file on ", in->name);
+ return;
+ }
+
+ /* skip the integral chunks, update skip with remainder */
+ lseek(in->fd, skip - left, SEEK_CUR);
+ skip = left;
+ }
+
+ /* read more input and skip remainder */
+ bload(in);
+ if (skip > in->left)
+ bail("unexpected end of file on ", in->name);
+ in->left -= skip;
+ in->next += skip;
+}
+
+/* -- end of buffered input functions -- */
+
+/* skip the gzip header from file in */
+local void gzhead(bin *in)
+{
+ int flags;
+
+ /* verify gzip magic header and compression method */
+ if (bget(in) != 0x1f || bget(in) != 0x8b || bget(in) != 8)
+ bail(in->name, " is not a valid gzip file");
+
+ /* get and verify flags */
+ flags = bget(in);
+ if ((flags & 0xe0) != 0)
+ bail("unknown reserved bits set in ", in->name);
+
+ /* skip modification time, extra flags, and os */
+ bskip(in, 6);
+
+ /* skip extra field if present */
+ if (flags & 4) {
+ unsigned len;
+
+ len = bget(in);
+ len += (unsigned)(bget(in)) << 8;
+ bskip(in, len);
+ }
+
+ /* skip file name if present */
+ if (flags & 8)
+ while (bget(in) != 0)
+ ;
+
+ /* skip comment if present */
+ if (flags & 16)
+ while (bget(in) != 0)
+ ;
+
+ /* skip header crc if present */
+ if (flags & 2)
+ bskip(in, 2);
+}
+
+/* write a four-byte little-endian unsigned integer to out */
+local void put4(unsigned long val, FILE *out)
+{
+ putc(val & 0xff, out);
+ putc((val >> 8) & 0xff, out);
+ putc((val >> 16) & 0xff, out);
+ putc((val >> 24) & 0xff, out);
+}
+
+/* Load up zlib stream from buffered input, bail if end of file */
+local void zpull(z_streamp strm, bin *in)
+{
+ if (in->left == 0)
+ bload(in);
+ if (in->left == 0)
+ bail("unexpected end of file on ", in->name);
+ strm->avail_in = in->left;
+ strm->next_in = in->next;
+}
+
+/* Write header for gzip file to out and initialize trailer. */
+local void gzinit(unsigned long *crc, unsigned long *tot, FILE *out)
+{
+ fwrite("\x1f\x8b\x08\0\0\0\0\0\0\xff", 1, 10, out);
+ *crc = crc32(0L, Z_NULL, 0);
+ *tot = 0;
+}
+
+/* Copy the compressed data from name, zeroing the last block bit of the last
+ block if clr is true, and adding empty blocks as needed to get to a byte
+ boundary. If clr is false, then the last block becomes the last block of
+ the output, and the gzip trailer is written. crc and tot maintains the
+ crc and length (modulo 2^32) of the output for the trailer. The resulting
+ gzip file is written to out. gzinit() must be called before the first call
+ of gzcopy() to write the gzip header and to initialize crc and tot. */
+local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot,
+ FILE *out)
+{
+ int ret; /* return value from zlib functions */
+ int pos; /* where the "last block" bit is in byte */
+ int last; /* true if processing the last block */
+ bin *in; /* buffered input file */
+ unsigned char *start; /* start of compressed data in buffer */
+ unsigned char *junk; /* buffer for uncompressed data -- discarded */
+ z_off_t len; /* length of uncompressed data (support > 4 GB) */
+ z_stream strm; /* zlib inflate stream */
+
+ /* open gzip file and skip header */
+ in = bopen(name);
+ if (in == NULL)
+ bail("could not open ", name);
+ gzhead(in);
+
+ /* allocate buffer for uncompressed data and initialize raw inflate
+ stream */
+ junk = malloc(CHUNK);
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, -15);
+ if (junk == NULL || ret != Z_OK)
+ bail("out of memory", "");
+
+ /* inflate and copy compressed data, clear last-block bit if requested */
+ len = 0;
+ zpull(&strm, in);
+ start = in->next;
+ last = start[0] & 1;
+ if (last && clr)
+ start[0] &= ~1;
+ strm.avail_out = 0;
+ for (;;) {
+ /* if input used and output done, write used input and get more */
+ if (strm.avail_in == 0 && strm.avail_out != 0) {
+ fwrite(start, 1, strm.next_in - start, out);
+ start = in->buf;
+ in->left = 0;
+ zpull(&strm, in);
+ }
+
+ /* decompress -- return early when end-of-block reached */
+ strm.avail_out = CHUNK;
+ strm.next_out = junk;
+ ret = inflate(&strm, Z_BLOCK);
+ switch (ret) {
+ case Z_MEM_ERROR:
+ bail("out of memory", "");
+ case Z_DATA_ERROR:
+ bail("invalid compressed data in ", in->name);
+ }
+
+ /* update length of uncompressed data */
+ len += CHUNK - strm.avail_out;
+
+ /* check for block boundary (only get this when block copied out) */
+ if (strm.data_type & 128) {
+ /* if that was the last block, then done */
+ if (last)
+ break;
+
+ /* number of unused bits in last byte */
+ pos = strm.data_type & 7;
+
+ /* find the next last-block bit */
+ if (pos != 0) {
+ /* next last-block bit is in last used byte */
+ pos = 0x100 >> pos;
+ last = strm.next_in[-1] & pos;
+ if (last && clr)
+ in->buf[strm.next_in - in->buf - 1] &= ~pos;
+ }
+ else {
+ /* next last-block bit is in next unused byte */
+ if (strm.avail_in == 0) {
+ /* don't have that byte yet -- get it */
+ fwrite(start, 1, strm.next_in - start, out);
+ start = in->buf;
+ in->left = 0;
+ zpull(&strm, in);
+ }
+ last = strm.next_in[0] & 1;
+ if (last && clr)
+ in->buf[strm.next_in - in->buf] &= ~1;
+ }
+ }
+ }
+
+ /* update buffer with unused input */
+ in->left = strm.avail_in;
+ in->next = in->buf + (strm.next_in - in->buf);
+
+ /* copy used input, write empty blocks to get to byte boundary */
+ pos = strm.data_type & 7;
+ fwrite(start, 1, in->next - start - 1, out);
+ last = in->next[-1];
+ if (pos == 0 || !clr)
+ /* already at byte boundary, or last file: write last byte */
+ putc(last, out);
+ else {
+ /* append empty blocks to last byte */
+ last &= ((0x100 >> pos) - 1); /* assure unused bits are zero */
+ if (pos & 1) {
+ /* odd -- append an empty stored block */
+ putc(last, out);
+ if (pos == 1)
+ putc(0, out); /* two more bits in block header */
+ fwrite("\0\0\xff\xff", 1, 4, out);
+ }
+ else {
+ /* even -- append 1, 2, or 3 empty fixed blocks */
+ switch (pos) {
+ case 6:
+ putc(last | 8, out);
+ last = 0;
+ case 4:
+ putc(last | 0x20, out);
+ last = 0;
+ case 2:
+ putc(last | 0x80, out);
+ putc(0, out);
+ }
+ }
+ }
+
+ /* update crc and tot */
+ *crc = crc32_combine(*crc, bget4(in), len);
+ *tot += (unsigned long)len;
+
+ /* clean up */
+ inflateEnd(&strm);
+ free(junk);
+ bclose(in);
+
+ /* write trailer if this is the last gzip file */
+ if (!clr) {
+ put4(*crc, out);
+ put4(*tot, out);
+ }
+}
+
+/* join the gzip files on the command line, write result to stdout */
+int main(int argc, char **argv)
+{
+ unsigned long crc, tot; /* running crc and total uncompressed length */
+
+ /* skip command name */
+ argc--;
+ argv++;
+
+ /* show usage if no arguments */
+ if (argc == 0) {
+ fputs("gzjoin usage: gzjoin f1.gz [f2.gz [f3.gz ...]] > fjoin.gz\n",
+ stderr);
+ return 0;
+ }
+
+ /* join gzip files on command line and write to stdout */
+ gzinit(&crc, &tot, stdout);
+ while (argc--)
+ gzcopy(*argv++, argc, &crc, &tot, stdout);
+
+ /* done */
+ return 0;
+}
diff --git a/compat/zlib/examples/gzlog.c b/compat/zlib/examples/gzlog.c
new file mode 100644
index 0000000..922f878
--- /dev/null
+++ b/compat/zlib/examples/gzlog.c
@@ -0,0 +1,1059 @@
+/*
+ * gzlog.c
+ * Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved
+ * For conditions of distribution and use, see copyright notice in gzlog.h
+ * version 2.2, 14 Aug 2012
+ */
+
+/*
+ gzlog provides a mechanism for frequently appending short strings to a gzip
+ file that is efficient both in execution time and compression ratio. The
+ strategy is to write the short strings in an uncompressed form to the end of
+ the gzip file, only compressing when the amount of uncompressed data has
+ reached a given threshold.
+
+ gzlog also provides protection against interruptions in the process due to
+ system crashes. The status of the operation is recorded in an extra field
+ in the gzip file, and is only updated once the gzip file is brought to a
+ valid state. The last data to be appended or compressed is saved in an
+ auxiliary file, so that if the operation is interrupted, it can be completed
+ the next time an append operation is attempted.
+
+ gzlog maintains another auxiliary file with the last 32K of data from the
+ compressed portion, which is preloaded for the compression of the subsequent
+ data. This minimizes the impact to the compression ratio of appending.
+ */
+
+/*
+ Operations Concept:
+
+ Files (log name "foo"):
+ foo.gz -- gzip file with the complete log
+ foo.add -- last message to append or last data to compress
+ foo.dict -- dictionary of the last 32K of data for next compression
+ foo.temp -- temporary dictionary file for compression after this one
+ foo.lock -- lock file for reading and writing the other files
+ foo.repairs -- log file for log file recovery operations (not compressed)
+
+ gzip file structure:
+ - fixed-length (no file name) header with extra field (see below)
+ - compressed data ending initially with empty stored block
+ - uncompressed data filling out originally empty stored block and
+ subsequent stored blocks as needed (16K max each)
+ - gzip trailer
+ - no junk at end (no other gzip streams)
+
+ When appending data, the information in the first three items above plus the
+ foo.add file are sufficient to recover an interrupted append operation. The
+ extra field has the necessary information to restore the start of the last
+ stored block and determine where to append the data in the foo.add file, as
+ well as the crc and length of the gzip data before the append operation.
+
+ The foo.add file is created before the gzip file is marked for append, and
+ deleted after the gzip file is marked as complete. So if the append
+ operation is interrupted, the data to add will still be there. If due to
+ some external force, the foo.add file gets deleted between when the append
+ operation was interrupted and when recovery is attempted, the gzip file will
+ still be restored, but without the appended data.
+
+ When compressing data, the information in the first two items above plus the
+ foo.add file are sufficient to recover an interrupted compress operation.
+ The extra field has the necessary information to find the end of the
+ compressed data, and contains both the crc and length of just the compressed
+ data and of the complete set of data including the contents of the foo.add
+ file.
+
+ Again, the foo.add file is maintained during the compress operation in case
+ of an interruption. If in the unlikely event the foo.add file with the data
+ to be compressed is missing due to some external force, a gzip file with
+ just the previous compressed data will be reconstructed. In this case, all
+ of the data that was to be compressed is lost (approximately one megabyte).
+ This will not occur if all that happened was an interruption of the compress
+ operation.
+
+ The third state that is marked is the replacement of the old dictionary with
+ the new dictionary after a compress operation. Once compression is
+ complete, the gzip file is marked as being in the replace state. This
+ completes the gzip file, so an interrupt after being so marked does not
+ result in recompression. Then the dictionary file is replaced, and the gzip
+ file is marked as completed. This state prevents the possibility of
+ restarting compression with the wrong dictionary file.
+
+ All three operations are wrapped by a lock/unlock procedure. In order to
+ gain exclusive access to the log files, first a foo.lock file must be
+ exclusively created. When all operations are complete, the lock is
+ released by deleting the foo.lock file. If when attempting to create the
+ lock file, it already exists and the modify time of the lock file is more
+ than five minutes old (set by the PATIENCE define below), then the old
+ lock file is considered stale and deleted, and the exclusive creation of
+ the lock file is retried. To assure that there are no false assessments
+ of the staleness of the lock file, the operations periodically touch the
+ lock file to update the modified date.
+
+ Following is the definition of the extra field with all of the information
+ required to enable the above append and compress operations and their
+ recovery if interrupted. Multi-byte values are stored little endian
+ (consistent with the gzip format). File pointers are eight bytes long.
+ The crc's and lengths for the gzip trailer are four bytes long. (Note that
+ the length at the end of a gzip file is used for error checking only, and
+ for large files is actually the length modulo 2^32.) The stored block
+ length is two bytes long. The gzip extra field two-byte identification is
+ "ap" for append. It is assumed that writing the extra field to the file is
+ an "atomic" operation. That is, either all of the extra field is written
+ to the file, or none of it is, if the operation is interrupted right at the
+ point of updating the extra field. This is a reasonable assumption, since
+ the extra field is within the first 52 bytes of the file, which is smaller
+ than any expected block size for a mass storage device (usually 512 bytes or
+ larger).
+
+ Extra field (35 bytes):
+ - Pointer to first stored block length -- this points to the two-byte length
+ of the first stored block, which is followed by the two-byte, one's
+ complement of that length. The stored block length is preceded by the
+ three-bit header of the stored block, which is the actual start of the
+ stored block in the deflate format. See the bit offset field below.
+ - Pointer to the last stored block length. This is the same as above, but
+ for the last stored block of the uncompressed data in the gzip file.
+ Initially this is the same as the first stored block length pointer.
+ When the stored block gets to 16K (see the MAX_STORE define), then a new
+ stored block as added, at which point the last stored block length pointer
+ is different from the first stored block length pointer. When they are
+ different, the first bit of the last stored block header is eight bits, or
+ one byte back from the block length.
+ - Compressed data crc and length. This is the crc and length of the data
+ that is in the compressed portion of the deflate stream. These are used
+ only in the event that the foo.add file containing the data to compress is
+ lost after a compress operation is interrupted.
+ - Total data crc and length. This is the crc and length of all of the data
+ stored in the gzip file, compressed and uncompressed. It is used to
+ reconstruct the gzip trailer when compressing, as well as when recovering
+ interrupted operations.
+ - Final stored block length. This is used to quickly find where to append,
+ and allows the restoration of the original final stored block state when
+ an append operation is interrupted.
+ - First stored block start as the number of bits back from the final stored
+ block first length byte. This value is in the range of 3..10, and is
+ stored as the low three bits of the final byte of the extra field after
+ subtracting three (0..7). This allows the last-block bit of the stored
+ block header to be updated when a new stored block is added, for the case
+ when the first stored block and the last stored block are the same. (When
+ they are different, the numbers of bits back is known to be eight.) This
+ also allows for new compressed data to be appended to the old compressed
+ data in the compress operation, overwriting the previous first stored
+ block, or for the compressed data to be terminated and a valid gzip file
+ reconstructed on the off chance that a compression operation was
+ interrupted and the data to compress in the foo.add file was deleted.
+ - The operation in process. This is the next two bits in the last byte (the
+ bits under the mask 0x18). The are interpreted as 0: nothing in process,
+ 1: append in process, 2: compress in process, 3: replace in process.
+ - The top three bits of the last byte in the extra field are reserved and
+ are currently set to zero.
+
+ Main procedure:
+ - Exclusively create the foo.lock file using the O_CREAT and O_EXCL modes of
+ the system open() call. If the modify time of an existing lock file is
+ more than PATIENCE seconds old, then the lock file is deleted and the
+ exclusive create is retried.
+ - Load the extra field from the foo.gz file, and see if an operation was in
+ progress but not completed. If so, apply the recovery procedure below.
+ - Perform the append procedure with the provided data.
+ - If the uncompressed data in the foo.gz file is 1MB or more, apply the
+ compress procedure.
+ - Delete the foo.lock file.
+
+ Append procedure:
+ - Put what to append in the foo.add file so that the operation can be
+ restarted if this procedure is interrupted.
+ - Mark the foo.gz extra field with the append operation in progress.
+ + Restore the original last-block bit and stored block length of the last
+ stored block from the information in the extra field, in case a previous
+ append operation was interrupted.
+ - Append the provided data to the last stored block, creating new stored
+ blocks as needed and updating the stored blocks last-block bits and
+ lengths.
+ - Update the crc and length with the new data, and write the gzip trailer.
+ - Write over the extra field (with a single write operation) with the new
+ pointers, lengths, and crc's, and mark the gzip file as not in process.
+ Though there is still a foo.add file, it will be ignored since nothing
+ is in process. If a foo.add file is leftover from a previously
+ completed operation, it is truncated when writing new data to it.
+ - Delete the foo.add file.
+
+ Compress and replace procedures:
+ - Read all of the uncompressed data in the stored blocks in foo.gz and write
+ it to foo.add. Also write foo.temp with the last 32K of that data to
+ provide a dictionary for the next invocation of this procedure.
+ - Rewrite the extra field marking foo.gz with a compression in process.
+ * If there is no data provided to compress (due to a missing foo.add file
+ when recovering), reconstruct and truncate the foo.gz file to contain
+ only the previous compressed data and proceed to the step after the next
+ one. Otherwise ...
+ - Compress the data with the dictionary in foo.dict, and write to the
+ foo.gz file starting at the bit immediately following the last previously
+ compressed block. If there is no foo.dict, proceed anyway with the
+ compression at slightly reduced efficiency. (For the foo.dict file to be
+ missing requires some external failure beyond simply the interruption of
+ a compress operation.) During this process, the foo.lock file is
+ periodically touched to assure that that file is not considered stale by
+ another process before we're done. The deflation is terminated with a
+ non-last empty static block (10 bits long), that is then located and
+ written over by a last-bit-set empty stored block.
+ - Append the crc and length of the data in the gzip file (previously
+ calculated during the append operations).
+ - Write over the extra field with the updated stored block offsets, bits
+ back, crc's, and lengths, and mark foo.gz as in process for a replacement
+ of the dictionary.
+ @ Delete the foo.add file.
+ - Replace foo.dict with foo.temp.
+ - Write over the extra field, marking foo.gz as complete.
+
+ Recovery procedure:
+ - If not a replace recovery, read in the foo.add file, and provide that data
+ to the appropriate recovery below. If there is no foo.add file, provide
+ a zero data length to the recovery. In that case, the append recovery
+ restores the foo.gz to the previous compressed + uncompressed data state.
+ For the the compress recovery, a missing foo.add file results in foo.gz
+ being restored to the previous compressed-only data state.
+ - Append recovery:
+ - Pick up append at + step above
+ - Compress recovery:
+ - Pick up compress at * step above
+ - Replace recovery:
+ - Pick up compress at @ step above
+ - Log the repair with a date stamp in foo.repairs
+ */
+
+#include <sys/types.h>
+#include <stdio.h> /* rename, fopen, fprintf, fclose */
+#include <stdlib.h> /* malloc, free */
+#include <string.h> /* strlen, strrchr, strcpy, strncpy, strcmp */
+#include <fcntl.h> /* open */
+#include <unistd.h> /* lseek, read, write, close, unlink, sleep, */
+ /* ftruncate, fsync */
+#include <errno.h> /* errno */
+#include <time.h> /* time, ctime */
+#include <sys/stat.h> /* stat */
+#include <sys/time.h> /* utimes */
+#include "zlib.h" /* crc32 */
+
+#include "gzlog.h" /* header for external access */
+
+#define local static
+typedef unsigned int uint;
+typedef unsigned long ulong;
+
+/* Macro for debugging to deterministically force recovery operations */
+#ifdef DEBUG
+ #include <setjmp.h> /* longjmp */
+ jmp_buf gzlog_jump; /* where to go back to */
+ int gzlog_bail = 0; /* which point to bail at (1..8) */
+ int gzlog_count = -1; /* number of times through to wait */
+# define BAIL(n) do { if (n == gzlog_bail && gzlog_count-- == 0) \
+ longjmp(gzlog_jump, gzlog_bail); } while (0)
+#else
+# define BAIL(n)
+#endif
+
+/* how old the lock file can be in seconds before considering it stale */
+#define PATIENCE 300
+
+/* maximum stored block size in Kbytes -- must be in 1..63 */
+#define MAX_STORE 16
+
+/* number of stored Kbytes to trigger compression (must be >= 32 to allow
+ dictionary construction, and <= 204 * MAX_STORE, in order for >> 10 to
+ discard the stored block headers contribution of five bytes each) */
+#define TRIGGER 1024
+
+/* size of a deflate dictionary (this cannot be changed) */
+#define DICT 32768U
+
+/* values for the operation (2 bits) */
+#define NO_OP 0
+#define APPEND_OP 1
+#define COMPRESS_OP 2
+#define REPLACE_OP 3
+
+/* macros to extract little-endian integers from an unsigned byte buffer */
+#define PULL2(p) ((p)[0]+((uint)((p)[1])<<8))
+#define PULL4(p) (PULL2(p)+((ulong)PULL2(p+2)<<16))
+#define PULL8(p) (PULL4(p)+((off_t)PULL4(p+4)<<32))
+
+/* macros to store integers into a byte buffer in little-endian order */
+#define PUT2(p,a) do {(p)[0]=a;(p)[1]=(a)>>8;} while(0)
+#define PUT4(p,a) do {PUT2(p,a);PUT2(p+2,a>>16);} while(0)
+#define PUT8(p,a) do {PUT4(p,a);PUT4(p+4,a>>32);} while(0)
+
+/* internal structure for log information */
+#define LOGID "\106\035\172" /* should be three non-zero characters */
+struct log {
+ char id[4]; /* contains LOGID to detect inadvertent overwrites */
+ int fd; /* file descriptor for .gz file, opened read/write */
+ char *path; /* allocated path, e.g. "/var/log/foo" or "foo" */
+ char *end; /* end of path, for appending suffices such as ".gz" */
+ off_t first; /* offset of first stored block first length byte */
+ int back; /* location of first block id in bits back from first */
+ uint stored; /* bytes currently in last stored block */
+ off_t last; /* offset of last stored block first length byte */
+ ulong ccrc; /* crc of compressed data */
+ ulong clen; /* length (modulo 2^32) of compressed data */
+ ulong tcrc; /* crc of total data */
+ ulong tlen; /* length (modulo 2^32) of total data */
+ time_t lock; /* last modify time of our lock file */
+};
+
+/* gzip header for gzlog */
+local unsigned char log_gzhead[] = {
+ 0x1f, 0x8b, /* magic gzip id */
+ 8, /* compression method is deflate */
+ 4, /* there is an extra field (no file name) */
+ 0, 0, 0, 0, /* no modification time provided */
+ 0, 0xff, /* no extra flags, no OS specified */
+ 39, 0, 'a', 'p', 35, 0 /* extra field with "ap" subfield */
+ /* 35 is EXTRA, 39 is EXTRA + 4 */
+};
+
+#define HEAD sizeof(log_gzhead) /* should be 16 */
+
+/* initial gzip extra field content (52 == HEAD + EXTRA + 1) */
+local unsigned char log_gzext[] = {
+ 52, 0, 0, 0, 0, 0, 0, 0, /* offset of first stored block length */
+ 52, 0, 0, 0, 0, 0, 0, 0, /* offset of last stored block length */
+ 0, 0, 0, 0, 0, 0, 0, 0, /* compressed data crc and length */
+ 0, 0, 0, 0, 0, 0, 0, 0, /* total data crc and length */
+ 0, 0, /* final stored block data length */
+ 5 /* op is NO_OP, last bit 8 bits back */
+};
+
+#define EXTRA sizeof(log_gzext) /* should be 35 */
+
+/* initial gzip data and trailer */
+local unsigned char log_gzbody[] = {
+ 1, 0, 0, 0xff, 0xff, /* empty stored block (last) */
+ 0, 0, 0, 0, /* crc */
+ 0, 0, 0, 0 /* uncompressed length */
+};
+
+#define BODY sizeof(log_gzbody)
+
+/* Exclusively create foo.lock in order to negotiate exclusive access to the
+ foo.* files. If the modify time of an existing lock file is greater than
+ PATIENCE seconds in the past, then consider the lock file to have been
+ abandoned, delete it, and try the exclusive create again. Save the lock
+ file modify time for verification of ownership. Return 0 on success, or -1
+ on failure, usually due to an access restriction or invalid path. Note that
+ if stat() or unlink() fails, it may be due to another process noticing the
+ abandoned lock file a smidge sooner and deleting it, so those are not
+ flagged as an error. */
+local int log_lock(struct log *log)
+{
+ int fd;
+ struct stat st;
+
+ strcpy(log->end, ".lock");
+ while ((fd = open(log->path, O_CREAT | O_EXCL, 0644)) < 0) {
+ if (errno != EEXIST)
+ return -1;
+ if (stat(log->path, &st) == 0 && time(NULL) - st.st_mtime > PATIENCE) {
+ unlink(log->path);
+ continue;
+ }
+ sleep(2); /* relinquish the CPU for two seconds while waiting */
+ }
+ close(fd);
+ if (stat(log->path, &st) == 0)
+ log->lock = st.st_mtime;
+ return 0;
+}
+
+/* Update the modify time of the lock file to now, in order to prevent another
+ task from thinking that the lock is stale. Save the lock file modify time
+ for verification of ownership. */
+local void log_touch(struct log *log)
+{
+ struct stat st;
+
+ strcpy(log->end, ".lock");
+ utimes(log->path, NULL);
+ if (stat(log->path, &st) == 0)
+ log->lock = st.st_mtime;
+}
+
+/* Check the log file modify time against what is expected. Return true if
+ this is not our lock. If it is our lock, touch it to keep it. */
+local int log_check(struct log *log)
+{
+ struct stat st;
+
+ strcpy(log->end, ".lock");
+ if (stat(log->path, &st) || st.st_mtime != log->lock)
+ return 1;
+ log_touch(log);
+ return 0;
+}
+
+/* Unlock a previously acquired lock, but only if it's ours. */
+local void log_unlock(struct log *log)
+{
+ if (log_check(log))
+ return;
+ strcpy(log->end, ".lock");
+ unlink(log->path);
+ log->lock = 0;
+}
+
+/* Check the gzip header and read in the extra field, filling in the values in
+ the log structure. Return op on success or -1 if the gzip header was not as
+ expected. op is the current operation in progress last written to the extra
+ field. This assumes that the gzip file has already been opened, with the
+ file descriptor log->fd. */
+local int log_head(struct log *log)
+{
+ int op;
+ unsigned char buf[HEAD + EXTRA];
+
+ if (lseek(log->fd, 0, SEEK_SET) < 0 ||
+ read(log->fd, buf, HEAD + EXTRA) != HEAD + EXTRA ||
+ memcmp(buf, log_gzhead, HEAD)) {
+ return -1;
+ }
+ log->first = PULL8(buf + HEAD);
+ log->last = PULL8(buf + HEAD + 8);
+ log->ccrc = PULL4(buf + HEAD + 16);
+ log->clen = PULL4(buf + HEAD + 20);
+ log->tcrc = PULL4(buf + HEAD + 24);
+ log->tlen = PULL4(buf + HEAD + 28);
+ log->stored = PULL2(buf + HEAD + 32);
+ log->back = 3 + (buf[HEAD + 34] & 7);
+ op = (buf[HEAD + 34] >> 3) & 3;
+ return op;
+}
+
+/* Write over the extra field contents, marking the operation as op. Use fsync
+ to assure that the device is written to, and in the requested order. This
+ operation, and only this operation, is assumed to be atomic in order to
+ assure that the log is recoverable in the event of an interruption at any
+ point in the process. Return -1 if the write to foo.gz failed. */
+local int log_mark(struct log *log, int op)
+{
+ int ret;
+ unsigned char ext[EXTRA];
+
+ PUT8(ext, log->first);
+ PUT8(ext + 8, log->last);
+ PUT4(ext + 16, log->ccrc);
+ PUT4(ext + 20, log->clen);
+ PUT4(ext + 24, log->tcrc);
+ PUT4(ext + 28, log->tlen);
+ PUT2(ext + 32, log->stored);
+ ext[34] = log->back - 3 + (op << 3);
+ fsync(log->fd);
+ ret = lseek(log->fd, HEAD, SEEK_SET) < 0 ||
+ write(log->fd, ext, EXTRA) != EXTRA ? -1 : 0;
+ fsync(log->fd);
+ return ret;
+}
+
+/* Rewrite the last block header bits and subsequent zero bits to get to a byte
+ boundary, setting the last block bit if last is true, and then write the
+ remainder of the stored block header (length and one's complement). Leave
+ the file pointer after the end of the last stored block data. Return -1 if
+ there is a read or write failure on the foo.gz file */
+local int log_last(struct log *log, int last)
+{
+ int back, len, mask;
+ unsigned char buf[6];
+
+ /* determine the locations of the bytes and bits to modify */
+ back = log->last == log->first ? log->back : 8;
+ len = back > 8 ? 2 : 1; /* bytes back from log->last */
+ mask = 0x80 >> ((back - 1) & 7); /* mask for block last-bit */
+
+ /* get the byte to modify (one or two back) into buf[0] -- don't need to
+ read the byte if the last-bit is eight bits back, since in that case
+ the entire byte will be modified */
+ buf[0] = 0;
+ if (back != 8 && (lseek(log->fd, log->last - len, SEEK_SET) < 0 ||
+ read(log->fd, buf, 1) != 1))
+ return -1;
+
+ /* change the last-bit of the last stored block as requested -- note
+ that all bits above the last-bit are set to zero, per the type bits
+ of a stored block being 00 and per the convention that the bits to
+ bring the stream to a byte boundary are also zeros */
+ buf[1] = 0;
+ buf[2 - len] = (*buf & (mask - 1)) + (last ? mask : 0);
+
+ /* write the modified stored block header and lengths, move the file
+ pointer to after the last stored block data */
+ PUT2(buf + 2, log->stored);
+ PUT2(buf + 4, log->stored ^ 0xffff);
+ return lseek(log->fd, log->last - len, SEEK_SET) < 0 ||
+ write(log->fd, buf + 2 - len, len + 4) != len + 4 ||
+ lseek(log->fd, log->stored, SEEK_CUR) < 0 ? -1 : 0;
+}
+
+/* Append len bytes from data to the locked and open log file. len may be zero
+ if recovering and no .add file was found. In that case, the previous state
+ of the foo.gz file is restored. The data is appended uncompressed in
+ deflate stored blocks. Return -1 if there was an error reading or writing
+ the foo.gz file. */
+local int log_append(struct log *log, unsigned char *data, size_t len)
+{
+ uint put;
+ off_t end;
+ unsigned char buf[8];
+
+ /* set the last block last-bit and length, in case recovering an
+ interrupted append, then position the file pointer to append to the
+ block */
+ if (log_last(log, 1))
+ return -1;
+
+ /* append, adding stored blocks and updating the offset of the last stored
+ block as needed, and update the total crc and length */
+ while (len) {
+ /* append as much as we can to the last block */
+ put = (MAX_STORE << 10) - log->stored;
+ if (put > len)
+ put = (uint)len;
+ if (put) {
+ if (write(log->fd, data, put) != put)
+ return -1;
+ BAIL(1);
+ log->tcrc = crc32(log->tcrc, data, put);
+ log->tlen += put;
+ log->stored += put;
+ data += put;
+ len -= put;
+ }
+
+ /* if we need to, add a new empty stored block */
+ if (len) {
+ /* mark current block as not last */
+ if (log_last(log, 0))
+ return -1;
+
+ /* point to new, empty stored block */
+ log->last += 4 + log->stored + 1;
+ log->stored = 0;
+ }
+
+ /* mark last block as last, update its length */
+ if (log_last(log, 1))
+ return -1;
+ BAIL(2);
+ }
+
+ /* write the new crc and length trailer, and truncate just in case (could
+ be recovering from partial append with a missing foo.add file) */
+ PUT4(buf, log->tcrc);
+ PUT4(buf + 4, log->tlen);
+ if (write(log->fd, buf, 8) != 8 ||
+ (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end))
+ return -1;
+
+ /* write the extra field, marking the log file as done, delete .add file */
+ if (log_mark(log, NO_OP))
+ return -1;
+ strcpy(log->end, ".add");
+ unlink(log->path); /* ignore error, since may not exist */
+ return 0;
+}
+
+/* Replace the foo.dict file with the foo.temp file. Also delete the foo.add
+ file, since the compress operation may have been interrupted before that was
+ done. Returns 1 if memory could not be allocated, or -1 if reading or
+ writing foo.gz fails, or if the rename fails for some reason other than
+ foo.temp not existing. foo.temp not existing is a permitted error, since
+ the replace operation may have been interrupted after the rename is done,
+ but before foo.gz is marked as complete. */
+local int log_replace(struct log *log)
+{
+ int ret;
+ char *dest;
+
+ /* delete foo.add file */
+ strcpy(log->end, ".add");
+ unlink(log->path); /* ignore error, since may not exist */
+ BAIL(3);
+
+ /* rename foo.name to foo.dict, replacing foo.dict if it exists */
+ strcpy(log->end, ".dict");
+ dest = malloc(strlen(log->path) + 1);
+ if (dest == NULL)
+ return -2;
+ strcpy(dest, log->path);
+ strcpy(log->end, ".temp");
+ ret = rename(log->path, dest);
+ free(dest);
+ if (ret && errno != ENOENT)
+ return -1;
+ BAIL(4);
+
+ /* mark the foo.gz file as done */
+ return log_mark(log, NO_OP);
+}
+
+/* Compress the len bytes at data and append the compressed data to the
+ foo.gz deflate data immediately after the previous compressed data. This
+ overwrites the previous uncompressed data, which was stored in foo.add
+ and is the data provided in data[0..len-1]. If this operation is
+ interrupted, it picks up at the start of this routine, with the foo.add
+ file read in again. If there is no data to compress (len == 0), then we
+ simply terminate the foo.gz file after the previously compressed data,
+ appending a final empty stored block and the gzip trailer. Return -1 if
+ reading or writing the log.gz file failed, or -2 if there was a memory
+ allocation failure. */
+local int log_compress(struct log *log, unsigned char *data, size_t len)
+{
+ int fd;
+ uint got, max;
+ ssize_t dict;
+ off_t end;
+ z_stream strm;
+ unsigned char buf[DICT];
+
+ /* compress and append compressed data */
+ if (len) {
+ /* set up for deflate, allocating memory */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ if (deflateInit2(&strm, Z_DEFAULT_COMPRESSION, Z_DEFLATED, -15, 8,
+ Z_DEFAULT_STRATEGY) != Z_OK)
+ return -2;
+
+ /* read in dictionary (last 32K of data that was compressed) */
+ strcpy(log->end, ".dict");
+ fd = open(log->path, O_RDONLY, 0);
+ if (fd >= 0) {
+ dict = read(fd, buf, DICT);
+ close(fd);
+ if (dict < 0) {
+ deflateEnd(&strm);
+ return -1;
+ }
+ if (dict)
+ deflateSetDictionary(&strm, buf, (uint)dict);
+ }
+ log_touch(log);
+
+ /* prime deflate with last bits of previous block, position write
+ pointer to write those bits and overwrite what follows */
+ if (lseek(log->fd, log->first - (log->back > 8 ? 2 : 1),
+ SEEK_SET) < 0 ||
+ read(log->fd, buf, 1) != 1 || lseek(log->fd, -1, SEEK_CUR) < 0) {
+ deflateEnd(&strm);
+ return -1;
+ }
+ deflatePrime(&strm, (8 - log->back) & 7, *buf);
+
+ /* compress, finishing with a partial non-last empty static block */
+ strm.next_in = data;
+ max = (((uint)0 - 1) >> 1) + 1; /* in case int smaller than size_t */
+ do {
+ strm.avail_in = len > max ? max : (uint)len;
+ len -= strm.avail_in;
+ do {
+ strm.avail_out = DICT;
+ strm.next_out = buf;
+ deflate(&strm, len ? Z_NO_FLUSH : Z_PARTIAL_FLUSH);
+ got = DICT - strm.avail_out;
+ if (got && write(log->fd, buf, got) != got) {
+ deflateEnd(&strm);
+ return -1;
+ }
+ log_touch(log);
+ } while (strm.avail_out == 0);
+ } while (len);
+ deflateEnd(&strm);
+ BAIL(5);
+
+ /* find start of empty static block -- scanning backwards the first one
+ bit is the second bit of the block, if the last byte is zero, then
+ we know the byte before that has a one in the top bit, since an
+ empty static block is ten bits long */
+ if ((log->first = lseek(log->fd, -1, SEEK_CUR)) < 0 ||
+ read(log->fd, buf, 1) != 1)
+ return -1;
+ log->first++;
+ if (*buf) {
+ log->back = 1;
+ while ((*buf & ((uint)1 << (8 - log->back++))) == 0)
+ ; /* guaranteed to terminate, since *buf != 0 */
+ }
+ else
+ log->back = 10;
+
+ /* update compressed crc and length */
+ log->ccrc = log->tcrc;
+ log->clen = log->tlen;
+ }
+ else {
+ /* no data to compress -- fix up existing gzip stream */
+ log->tcrc = log->ccrc;
+ log->tlen = log->clen;
+ }
+
+ /* complete and truncate gzip stream */
+ log->last = log->first;
+ log->stored = 0;
+ PUT4(buf, log->tcrc);
+ PUT4(buf + 4, log->tlen);
+ if (log_last(log, 1) || write(log->fd, buf, 8) != 8 ||
+ (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end))
+ return -1;
+ BAIL(6);
+
+ /* mark as being in the replace operation */
+ if (log_mark(log, REPLACE_OP))
+ return -1;
+
+ /* execute the replace operation and mark the file as done */
+ return log_replace(log);
+}
+
+/* log a repair record to the .repairs file */
+local void log_log(struct log *log, int op, char *record)
+{
+ time_t now;
+ FILE *rec;
+
+ now = time(NULL);
+ strcpy(log->end, ".repairs");
+ rec = fopen(log->path, "a");
+ if (rec == NULL)
+ return;
+ fprintf(rec, "%.24s %s recovery: %s\n", ctime(&now), op == APPEND_OP ?
+ "append" : (op == COMPRESS_OP ? "compress" : "replace"), record);
+ fclose(rec);
+ return;
+}
+
+/* Recover the interrupted operation op. First read foo.add for recovering an
+ append or compress operation. Return -1 if there was an error reading or
+ writing foo.gz or reading an existing foo.add, or -2 if there was a memory
+ allocation failure. */
+local int log_recover(struct log *log, int op)
+{
+ int fd, ret = 0;
+ unsigned char *data = NULL;
+ size_t len = 0;
+ struct stat st;
+
+ /* log recovery */
+ log_log(log, op, "start");
+
+ /* load foo.add file if expected and present */
+ if (op == APPEND_OP || op == COMPRESS_OP) {
+ strcpy(log->end, ".add");
+ if (stat(log->path, &st) == 0 && st.st_size) {
+ len = (size_t)(st.st_size);
+ if ((off_t)len != st.st_size ||
+ (data = malloc(st.st_size)) == NULL) {
+ log_log(log, op, "allocation failure");
+ return -2;
+ }
+ if ((fd = open(log->path, O_RDONLY, 0)) < 0) {
+ log_log(log, op, ".add file read failure");
+ return -1;
+ }
+ ret = (size_t)read(fd, data, len) != len;
+ close(fd);
+ if (ret) {
+ log_log(log, op, ".add file read failure");
+ return -1;
+ }
+ log_log(log, op, "loaded .add file");
+ }
+ else
+ log_log(log, op, "missing .add file!");
+ }
+
+ /* recover the interrupted operation */
+ switch (op) {
+ case APPEND_OP:
+ ret = log_append(log, data, len);
+ break;
+ case COMPRESS_OP:
+ ret = log_compress(log, data, len);
+ break;
+ case REPLACE_OP:
+ ret = log_replace(log);
+ }
+
+ /* log status */
+ log_log(log, op, ret ? "failure" : "complete");
+
+ /* clean up */
+ if (data != NULL)
+ free(data);
+ return ret;
+}
+
+/* Close the foo.gz file (if open) and release the lock. */
+local void log_close(struct log *log)
+{
+ if (log->fd >= 0)
+ close(log->fd);
+ log->fd = -1;
+ log_unlock(log);
+}
+
+/* Open foo.gz, verify the header, and load the extra field contents, after
+ first creating the foo.lock file to gain exclusive access to the foo.*
+ files. If foo.gz does not exist or is empty, then write the initial header,
+ extra, and body content of an empty foo.gz log file. If there is an error
+ creating the lock file due to access restrictions, or an error reading or
+ writing the foo.gz file, or if the foo.gz file is not a proper log file for
+ this object (e.g. not a gzip file or does not contain the expected extra
+ field), then return true. If there is an error, the lock is released.
+ Otherwise, the lock is left in place. */
+local int log_open(struct log *log)
+{
+ int op;
+
+ /* release open file resource if left over -- can occur if lock lost
+ between gzlog_open() and gzlog_write() */
+ if (log->fd >= 0)
+ close(log->fd);
+ log->fd = -1;
+
+ /* negotiate exclusive access */
+ if (log_lock(log) < 0)
+ return -1;
+
+ /* open the log file, foo.gz */
+ strcpy(log->end, ".gz");
+ log->fd = open(log->path, O_RDWR | O_CREAT, 0644);
+ if (log->fd < 0) {
+ log_close(log);
+ return -1;
+ }
+
+ /* if new, initialize foo.gz with an empty log, delete old dictionary */
+ if (lseek(log->fd, 0, SEEK_END) == 0) {
+ if (write(log->fd, log_gzhead, HEAD) != HEAD ||
+ write(log->fd, log_gzext, EXTRA) != EXTRA ||
+ write(log->fd, log_gzbody, BODY) != BODY) {
+ log_close(log);
+ return -1;
+ }
+ strcpy(log->end, ".dict");
+ unlink(log->path);
+ }
+
+ /* verify log file and load extra field information */
+ if ((op = log_head(log)) < 0) {
+ log_close(log);
+ return -1;
+ }
+
+ /* check for interrupted process and if so, recover */
+ if (op != NO_OP && log_recover(log, op)) {
+ log_close(log);
+ return -1;
+ }
+
+ /* touch the lock file to prevent another process from grabbing it */
+ log_touch(log);
+ return 0;
+}
+
+/* See gzlog.h for the description of the external methods below */
+gzlog *gzlog_open(char *path)
+{
+ size_t n;
+ struct log *log;
+
+ /* check arguments */
+ if (path == NULL || *path == 0)
+ return NULL;
+
+ /* allocate and initialize log structure */
+ log = malloc(sizeof(struct log));
+ if (log == NULL)
+ return NULL;
+ strcpy(log->id, LOGID);
+ log->fd = -1;
+
+ /* save path and end of path for name construction */
+ n = strlen(path);
+ log->path = malloc(n + 9); /* allow for ".repairs" */
+ if (log->path == NULL) {
+ free(log);
+ return NULL;
+ }
+ strcpy(log->path, path);
+ log->end = log->path + n;
+
+ /* gain exclusive access and verify log file -- may perform a
+ recovery operation if needed */
+ if (log_open(log)) {
+ free(log->path);
+ free(log);
+ return NULL;
+ }
+
+ /* return pointer to log structure */
+ return log;
+}
+
+/* gzlog_compress() return values:
+ 0: all good
+ -1: file i/o error (usually access issue)
+ -2: memory allocation failure
+ -3: invalid log pointer argument */
+int gzlog_compress(gzlog *logd)
+{
+ int fd, ret;
+ uint block;
+ size_t len, next;
+ unsigned char *data, buf[5];
+ struct log *log = logd;
+
+ /* check arguments */
+ if (log == NULL || strcmp(log->id, LOGID))
+ return -3;
+
+ /* see if we lost the lock -- if so get it again and reload the extra
+ field information (it probably changed), recover last operation if
+ necessary */
+ if (log_check(log) && log_open(log))
+ return -1;
+
+ /* create space for uncompressed data */
+ len = ((size_t)(log->last - log->first) & ~(((size_t)1 << 10) - 1)) +
+ log->stored;
+ if ((data = malloc(len)) == NULL)
+ return -2;
+
+ /* do statement here is just a cheap trick for error handling */
+ do {
+ /* read in the uncompressed data */
+ if (lseek(log->fd, log->first - 1, SEEK_SET) < 0)
+ break;
+ next = 0;
+ while (next < len) {
+ if (read(log->fd, buf, 5) != 5)
+ break;
+ block = PULL2(buf + 1);
+ if (next + block > len ||
+ read(log->fd, (char *)data + next, block) != block)
+ break;
+ next += block;
+ }
+ if (lseek(log->fd, 0, SEEK_CUR) != log->last + 4 + log->stored)
+ break;
+ log_touch(log);
+
+ /* write the uncompressed data to the .add file */
+ strcpy(log->end, ".add");
+ fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
+ if (fd < 0)
+ break;
+ ret = (size_t)write(fd, data, len) != len;
+ if (ret | close(fd))
+ break;
+ log_touch(log);
+
+ /* write the dictionary for the next compress to the .temp file */
+ strcpy(log->end, ".temp");
+ fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
+ if (fd < 0)
+ break;
+ next = DICT > len ? len : DICT;
+ ret = (size_t)write(fd, (char *)data + len - next, next) != next;
+ if (ret | close(fd))
+ break;
+ log_touch(log);
+
+ /* roll back to compressed data, mark the compress in progress */
+ log->last = log->first;
+ log->stored = 0;
+ if (log_mark(log, COMPRESS_OP))
+ break;
+ BAIL(7);
+
+ /* compress and append the data (clears mark) */
+ ret = log_compress(log, data, len);
+ free(data);
+ return ret;
+ } while (0);
+
+ /* broke out of do above on i/o error */
+ free(data);
+ return -1;
+}
+
+/* gzlog_write() return values:
+ 0: all good
+ -1: file i/o error (usually access issue)
+ -2: memory allocation failure
+ -3: invalid log pointer argument */
+int gzlog_write(gzlog *logd, void *data, size_t len)
+{
+ int fd, ret;
+ struct log *log = logd;
+
+ /* check arguments */
+ if (log == NULL || strcmp(log->id, LOGID))
+ return -3;
+ if (data == NULL || len <= 0)
+ return 0;
+
+ /* see if we lost the lock -- if so get it again and reload the extra
+ field information (it probably changed), recover last operation if
+ necessary */
+ if (log_check(log) && log_open(log))
+ return -1;
+
+ /* create and write .add file */
+ strcpy(log->end, ".add");
+ fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
+ if (fd < 0)
+ return -1;
+ ret = (size_t)write(fd, data, len) != len;
+ if (ret | close(fd))
+ return -1;
+ log_touch(log);
+
+ /* mark log file with append in progress */
+ if (log_mark(log, APPEND_OP))
+ return -1;
+ BAIL(8);
+
+ /* append data (clears mark) */
+ if (log_append(log, data, len))
+ return -1;
+
+ /* check to see if it's time to compress -- if not, then done */
+ if (((log->last - log->first) >> 10) + (log->stored >> 10) < TRIGGER)
+ return 0;
+
+ /* time to compress */
+ return gzlog_compress(log);
+}
+
+/* gzlog_close() return values:
+ 0: ok
+ -3: invalid log pointer argument */
+int gzlog_close(gzlog *logd)
+{
+ struct log *log = logd;
+
+ /* check arguments */
+ if (log == NULL || strcmp(log->id, LOGID))
+ return -3;
+
+ /* close the log file and release the lock */
+ log_close(log);
+
+ /* free structure and return */
+ if (log->path != NULL)
+ free(log->path);
+ strcpy(log->id, "bad");
+ free(log);
+ return 0;
+}
diff --git a/compat/zlib/examples/gzlog.h b/compat/zlib/examples/gzlog.h
new file mode 100644
index 0000000..86f0cec
--- /dev/null
+++ b/compat/zlib/examples/gzlog.h
@@ -0,0 +1,91 @@
+/* gzlog.h
+ Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved
+ version 2.2, 14 Aug 2012
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the author be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Mark Adler madler@alumni.caltech.edu
+ */
+
+/* Version History:
+ 1.0 26 Nov 2004 First version
+ 2.0 25 Apr 2008 Complete redesign for recovery of interrupted operations
+ Interface changed slightly in that now path is a prefix
+ Compression now occurs as needed during gzlog_write()
+ gzlog_write() now always leaves the log file as valid gzip
+ 2.1 8 Jul 2012 Fix argument checks in gzlog_compress() and gzlog_write()
+ 2.2 14 Aug 2012 Clean up signed comparisons
+ */
+
+/*
+ The gzlog object allows writing short messages to a gzipped log file,
+ opening the log file locked for small bursts, and then closing it. The log
+ object works by appending stored (uncompressed) data to the gzip file until
+ 1 MB has been accumulated. At that time, the stored data is compressed, and
+ replaces the uncompressed data in the file. The log file is truncated to
+ its new size at that time. After each write operation, the log file is a
+ valid gzip file that can decompressed to recover what was written.
+
+ The gzlog operations can be interupted at any point due to an application or
+ system crash, and the log file will be recovered the next time the log is
+ opened with gzlog_open().
+ */
+
+#ifndef GZLOG_H
+#define GZLOG_H
+
+/* gzlog object type */
+typedef void gzlog;
+
+/* Open a gzlog object, creating the log file if it does not exist. Return
+ NULL on error. Note that gzlog_open() could take a while to complete if it
+ has to wait to verify that a lock is stale (possibly for five minutes), or
+ if there is significant contention with other instantiations of this object
+ when locking the resource. path is the prefix of the file names created by
+ this object. If path is "foo", then the log file will be "foo.gz", and
+ other auxiliary files will be created and destroyed during the process:
+ "foo.dict" for a compression dictionary, "foo.temp" for a temporary (next)
+ dictionary, "foo.add" for data being added or compressed, "foo.lock" for the
+ lock file, and "foo.repairs" to log recovery operations performed due to
+ interrupted gzlog operations. A gzlog_open() followed by a gzlog_close()
+ will recover a previously interrupted operation, if any. */
+gzlog *gzlog_open(char *path);
+
+/* Write to a gzlog object. Return zero on success, -1 if there is a file i/o
+ error on any of the gzlog files (this should not happen if gzlog_open()
+ succeeded, unless the device has run out of space or leftover auxiliary
+ files have permissions or ownership that prevent their use), -2 if there is
+ a memory allocation failure, or -3 if the log argument is invalid (e.g. if
+ it was not created by gzlog_open()). This function will write data to the
+ file uncompressed, until 1 MB has been accumulated, at which time that data
+ will be compressed. The log file will be a valid gzip file upon successful
+ return. */
+int gzlog_write(gzlog *log, void *data, size_t len);
+
+/* Force compression of any uncompressed data in the log. This should be used
+ sparingly, if at all. The main application would be when a log file will
+ not be appended to again. If this is used to compress frequently while
+ appending, it will both significantly increase the execution time and
+ reduce the compression ratio. The return codes are the same as for
+ gzlog_write(). */
+int gzlog_compress(gzlog *log);
+
+/* Close a gzlog object. Return zero on success, -3 if the log argument is
+ invalid. The log object is freed, and so cannot be referenced again. */
+int gzlog_close(gzlog *log);
+
+#endif
diff --git a/compat/zlib/examples/zlib_how.html b/compat/zlib/examples/zlib_how.html
new file mode 100644
index 0000000..444ff1c
--- /dev/null
+++ b/compat/zlib/examples/zlib_how.html
@@ -0,0 +1,545 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
+<title>zlib Usage Example</title>
+<!-- Copyright (c) 2004, 2005 Mark Adler. -->
+</head>
+<body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#00A000">
+<h2 align="center"> zlib Usage Example </h2>
+We often get questions about how the <tt>deflate()</tt> and <tt>inflate()</tt> functions should be used.
+Users wonder when they should provide more input, when they should use more output,
+what to do with a <tt>Z_BUF_ERROR</tt>, how to make sure the process terminates properly, and
+so on. So for those who have read <tt>zlib.h</tt> (a few times), and
+would like further edification, below is an annotated example in C of simple routines to compress and decompress
+from an input file to an output file using <tt>deflate()</tt> and <tt>inflate()</tt> respectively. The
+annotations are interspersed between lines of the code. So please read between the lines.
+We hope this helps explain some of the intricacies of <em>zlib</em>.
+<p>
+Without further adieu, here is the program <a href="zpipe.c"><tt>zpipe.c</tt></a>:
+<pre><b>
+/* zpipe.c: example of proper use of zlib's inflate() and deflate()
+ Not copyrighted -- provided to the public domain
+ Version 1.4 11 December 2005 Mark Adler */
+
+/* Version history:
+ 1.0 30 Oct 2004 First version
+ 1.1 8 Nov 2004 Add void casting for unused return values
+ Use switch statement for inflate() return values
+ 1.2 9 Nov 2004 Add assertions to document zlib guarantees
+ 1.3 6 Apr 2005 Remove incorrect assertion in inf()
+ 1.4 11 Dec 2005 Add hack to avoid MSDOS end-of-line conversions
+ Avoid some compiler warnings for input and output buffers
+ */
+</b></pre><!-- -->
+We now include the header files for the required definitions. From
+<tt>stdio.h</tt> we use <tt>fopen()</tt>, <tt>fread()</tt>, <tt>fwrite()</tt>,
+<tt>feof()</tt>, <tt>ferror()</tt>, and <tt>fclose()</tt> for file i/o, and
+<tt>fputs()</tt> for error messages. From <tt>string.h</tt> we use
+<tt>strcmp()</tt> for command line argument processing.
+From <tt>assert.h</tt> we use the <tt>assert()</tt> macro.
+From <tt>zlib.h</tt>
+we use the basic compression functions <tt>deflateInit()</tt>,
+<tt>deflate()</tt>, and <tt>deflateEnd()</tt>, and the basic decompression
+functions <tt>inflateInit()</tt>, <tt>inflate()</tt>, and
+<tt>inflateEnd()</tt>.
+<pre><b>
+#include &lt;stdio.h&gt;
+#include &lt;string.h&gt;
+#include &lt;assert.h&gt;
+#include "zlib.h"
+</b></pre><!-- -->
+This is an ugly hack required to avoid corruption of the input and output data on
+Windows/MS-DOS systems. Without this, those systems would assume that the input and output
+files are text, and try to convert the end-of-line characters from one standard to
+another. That would corrupt binary data, and in particular would render the compressed data unusable.
+This sets the input and output to binary which suppresses the end-of-line conversions.
+<tt>SET_BINARY_MODE()</tt> will be used later on <tt>stdin</tt> and <tt>stdout</tt>, at the beginning of <tt>main()</tt>.
+<pre><b>
+#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
+# include &lt;fcntl.h&gt;
+# include &lt;io.h&gt;
+# define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
+#else
+# define SET_BINARY_MODE(file)
+#endif
+</b></pre><!-- -->
+<tt>CHUNK</tt> is simply the buffer size for feeding data to and pulling data
+from the <em>zlib</em> routines. Larger buffer sizes would be more efficient,
+especially for <tt>inflate()</tt>. If the memory is available, buffers sizes
+on the order of 128K or 256K bytes should be used.
+<pre><b>
+#define CHUNK 16384
+</b></pre><!-- -->
+The <tt>def()</tt> routine compresses data from an input file to an output file. The output data
+will be in the <em>zlib</em> format, which is different from the <em>gzip</em> or <em>zip</em>
+formats. The <em>zlib</em> format has a very small header of only two bytes to identify it as
+a <em>zlib</em> stream and to provide decoding information, and a four-byte trailer with a fast
+check value to verify the integrity of the uncompressed data after decoding.
+<pre><b>
+/* Compress from file source to file dest until EOF on source.
+ def() returns Z_OK on success, Z_MEM_ERROR if memory could not be
+ allocated for processing, Z_STREAM_ERROR if an invalid compression
+ level is supplied, Z_VERSION_ERROR if the version of zlib.h and the
+ version of the library linked do not match, or Z_ERRNO if there is
+ an error reading or writing the files. */
+int def(FILE *source, FILE *dest, int level)
+{
+</b></pre>
+Here are the local variables for <tt>def()</tt>. <tt>ret</tt> will be used for <em>zlib</em>
+return codes. <tt>flush</tt> will keep track of the current flushing state for <tt>deflate()</tt>,
+which is either no flushing, or flush to completion after the end of the input file is reached.
+<tt>have</tt> is the amount of data returned from <tt>deflate()</tt>. The <tt>strm</tt> structure
+is used to pass information to and from the <em>zlib</em> routines, and to maintain the
+<tt>deflate()</tt> state. <tt>in</tt> and <tt>out</tt> are the input and output buffers for
+<tt>deflate()</tt>.
+<pre><b>
+ int ret, flush;
+ unsigned have;
+ z_stream strm;
+ unsigned char in[CHUNK];
+ unsigned char out[CHUNK];
+</b></pre><!-- -->
+The first thing we do is to initialize the <em>zlib</em> state for compression using
+<tt>deflateInit()</tt>. This must be done before the first use of <tt>deflate()</tt>.
+The <tt>zalloc</tt>, <tt>zfree</tt>, and <tt>opaque</tt> fields in the <tt>strm</tt>
+structure must be initialized before calling <tt>deflateInit()</tt>. Here they are
+set to the <em>zlib</em> constant <tt>Z_NULL</tt> to request that <em>zlib</em> use
+the default memory allocation routines. An application may also choose to provide
+custom memory allocation routines here. <tt>deflateInit()</tt> will allocate on the
+order of 256K bytes for the internal state.
+(See <a href="zlib_tech.html"><em>zlib Technical Details</em></a>.)
+<p>
+<tt>deflateInit()</tt> is called with a pointer to the structure to be initialized and
+the compression level, which is an integer in the range of -1 to 9. Lower compression
+levels result in faster execution, but less compression. Higher levels result in
+greater compression, but slower execution. The <em>zlib</em> constant Z_DEFAULT_COMPRESSION,
+equal to -1,
+provides a good compromise between compression and speed and is equivalent to level 6.
+Level 0 actually does no compression at all, and in fact expands the data slightly to produce
+the <em>zlib</em> format (it is not a byte-for-byte copy of the input).
+More advanced applications of <em>zlib</em>
+may use <tt>deflateInit2()</tt> here instead. Such an application may want to reduce how
+much memory will be used, at some price in compression. Or it may need to request a
+<em>gzip</em> header and trailer instead of a <em>zlib</em> header and trailer, or raw
+encoding with no header or trailer at all.
+<p>
+We must check the return value of <tt>deflateInit()</tt> against the <em>zlib</em> constant
+<tt>Z_OK</tt> to make sure that it was able to
+allocate memory for the internal state, and that the provided arguments were valid.
+<tt>deflateInit()</tt> will also check that the version of <em>zlib</em> that the <tt>zlib.h</tt>
+file came from matches the version of <em>zlib</em> actually linked with the program. This
+is especially important for environments in which <em>zlib</em> is a shared library.
+<p>
+Note that an application can initialize multiple, independent <em>zlib</em> streams, which can
+operate in parallel. The state information maintained in the structure allows the <em>zlib</em>
+routines to be reentrant.
+<pre><b>
+ /* allocate deflate state */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ ret = deflateInit(&amp;strm, level);
+ if (ret != Z_OK)
+ return ret;
+</b></pre><!-- -->
+With the pleasantries out of the way, now we can get down to business. The outer <tt>do</tt>-loop
+reads all of the input file and exits at the bottom of the loop once end-of-file is reached.
+This loop contains the only call of <tt>deflate()</tt>. So we must make sure that all of the
+input data has been processed and that all of the output data has been generated and consumed
+before we fall out of the loop at the bottom.
+<pre><b>
+ /* compress until end of file */
+ do {
+</b></pre>
+We start off by reading data from the input file. The number of bytes read is put directly
+into <tt>avail_in</tt>, and a pointer to those bytes is put into <tt>next_in</tt>. We also
+check to see if end-of-file on the input has been reached. If we are at the end of file, then <tt>flush</tt> is set to the
+<em>zlib</em> constant <tt>Z_FINISH</tt>, which is later passed to <tt>deflate()</tt> to
+indicate that this is the last chunk of input data to compress. We need to use <tt>feof()</tt>
+to check for end-of-file as opposed to seeing if fewer than <tt>CHUNK</tt> bytes have been read. The
+reason is that if the input file length is an exact multiple of <tt>CHUNK</tt>, we will miss
+the fact that we got to the end-of-file, and not know to tell <tt>deflate()</tt> to finish
+up the compressed stream. If we are not yet at the end of the input, then the <em>zlib</em>
+constant <tt>Z_NO_FLUSH</tt> will be passed to <tt>deflate</tt> to indicate that we are still
+in the middle of the uncompressed data.
+<p>
+If there is an error in reading from the input file, the process is aborted with
+<tt>deflateEnd()</tt> being called to free the allocated <em>zlib</em> state before returning
+the error. We wouldn't want a memory leak, now would we? <tt>deflateEnd()</tt> can be called
+at any time after the state has been initialized. Once that's done, <tt>deflateInit()</tt> (or
+<tt>deflateInit2()</tt>) would have to be called to start a new compression process. There is
+no point here in checking the <tt>deflateEnd()</tt> return code. The deallocation can't fail.
+<pre><b>
+ strm.avail_in = fread(in, 1, CHUNK, source);
+ if (ferror(source)) {
+ (void)deflateEnd(&amp;strm);
+ return Z_ERRNO;
+ }
+ flush = feof(source) ? Z_FINISH : Z_NO_FLUSH;
+ strm.next_in = in;
+</b></pre><!-- -->
+The inner <tt>do</tt>-loop passes our chunk of input data to <tt>deflate()</tt>, and then
+keeps calling <tt>deflate()</tt> until it is done producing output. Once there is no more
+new output, <tt>deflate()</tt> is guaranteed to have consumed all of the input, i.e.,
+<tt>avail_in</tt> will be zero.
+<pre><b>
+ /* run deflate() on input until output buffer not full, finish
+ compression if all of source has been read in */
+ do {
+</b></pre>
+Output space is provided to <tt>deflate()</tt> by setting <tt>avail_out</tt> to the number
+of available output bytes and <tt>next_out</tt> to a pointer to that space.
+<pre><b>
+ strm.avail_out = CHUNK;
+ strm.next_out = out;
+</b></pre>
+Now we call the compression engine itself, <tt>deflate()</tt>. It takes as many of the
+<tt>avail_in</tt> bytes at <tt>next_in</tt> as it can process, and writes as many as
+<tt>avail_out</tt> bytes to <tt>next_out</tt>. Those counters and pointers are then
+updated past the input data consumed and the output data written. It is the amount of
+output space available that may limit how much input is consumed.
+Hence the inner loop to make sure that
+all of the input is consumed by providing more output space each time. Since <tt>avail_in</tt>
+and <tt>next_in</tt> are updated by <tt>deflate()</tt>, we don't have to mess with those
+between <tt>deflate()</tt> calls until it's all used up.
+<p>
+The parameters to <tt>deflate()</tt> are a pointer to the <tt>strm</tt> structure containing
+the input and output information and the internal compression engine state, and a parameter
+indicating whether and how to flush data to the output. Normally <tt>deflate</tt> will consume
+several K bytes of input data before producing any output (except for the header), in order
+to accumulate statistics on the data for optimum compression. It will then put out a burst of
+compressed data, and proceed to consume more input before the next burst. Eventually,
+<tt>deflate()</tt>
+must be told to terminate the stream, complete the compression with provided input data, and
+write out the trailer check value. <tt>deflate()</tt> will continue to compress normally as long
+as the flush parameter is <tt>Z_NO_FLUSH</tt>. Once the <tt>Z_FINISH</tt> parameter is provided,
+<tt>deflate()</tt> will begin to complete the compressed output stream. However depending on how
+much output space is provided, <tt>deflate()</tt> may have to be called several times until it
+has provided the complete compressed stream, even after it has consumed all of the input. The flush
+parameter must continue to be <tt>Z_FINISH</tt> for those subsequent calls.
+<p>
+There are other values of the flush parameter that are used in more advanced applications. You can
+force <tt>deflate()</tt> to produce a burst of output that encodes all of the input data provided
+so far, even if it wouldn't have otherwise, for example to control data latency on a link with
+compressed data. You can also ask that <tt>deflate()</tt> do that as well as erase any history up to
+that point so that what follows can be decompressed independently, for example for random access
+applications. Both requests will degrade compression by an amount depending on how often such
+requests are made.
+<p>
+<tt>deflate()</tt> has a return value that can indicate errors, yet we do not check it here. Why
+not? Well, it turns out that <tt>deflate()</tt> can do no wrong here. Let's go through
+<tt>deflate()</tt>'s return values and dispense with them one by one. The possible values are
+<tt>Z_OK</tt>, <tt>Z_STREAM_END</tt>, <tt>Z_STREAM_ERROR</tt>, or <tt>Z_BUF_ERROR</tt>. <tt>Z_OK</tt>
+is, well, ok. <tt>Z_STREAM_END</tt> is also ok and will be returned for the last call of
+<tt>deflate()</tt>. This is already guaranteed by calling <tt>deflate()</tt> with <tt>Z_FINISH</tt>
+until it has no more output. <tt>Z_STREAM_ERROR</tt> is only possible if the stream is not
+initialized properly, but we did initialize it properly. There is no harm in checking for
+<tt>Z_STREAM_ERROR</tt> here, for example to check for the possibility that some
+other part of the application inadvertently clobbered the memory containing the <em>zlib</em> state.
+<tt>Z_BUF_ERROR</tt> will be explained further below, but
+suffice it to say that this is simply an indication that <tt>deflate()</tt> could not consume
+more input or produce more output. <tt>deflate()</tt> can be called again with more output space
+or more available input, which it will be in this code.
+<pre><b>
+ ret = deflate(&amp;strm, flush); /* no bad return value */
+ assert(ret != Z_STREAM_ERROR); /* state not clobbered */
+</b></pre>
+Now we compute how much output <tt>deflate()</tt> provided on the last call, which is the
+difference between how much space was provided before the call, and how much output space
+is still available after the call. Then that data, if any, is written to the output file.
+We can then reuse the output buffer for the next call of <tt>deflate()</tt>. Again if there
+is a file i/o error, we call <tt>deflateEnd()</tt> before returning to avoid a memory leak.
+<pre><b>
+ have = CHUNK - strm.avail_out;
+ if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
+ (void)deflateEnd(&amp;strm);
+ return Z_ERRNO;
+ }
+</b></pre>
+The inner <tt>do</tt>-loop is repeated until the last <tt>deflate()</tt> call fails to fill the
+provided output buffer. Then we know that <tt>deflate()</tt> has done as much as it can with
+the provided input, and that all of that input has been consumed. We can then fall out of this
+loop and reuse the input buffer.
+<p>
+The way we tell that <tt>deflate()</tt> has no more output is by seeing that it did not fill
+the output buffer, leaving <tt>avail_out</tt> greater than zero. However suppose that
+<tt>deflate()</tt> has no more output, but just so happened to exactly fill the output buffer!
+<tt>avail_out</tt> is zero, and we can't tell that <tt>deflate()</tt> has done all it can.
+As far as we know, <tt>deflate()</tt>
+has more output for us. So we call it again. But now <tt>deflate()</tt> produces no output
+at all, and <tt>avail_out</tt> remains unchanged as <tt>CHUNK</tt>. That <tt>deflate()</tt> call
+wasn't able to do anything, either consume input or produce output, and so it returns
+<tt>Z_BUF_ERROR</tt>. (See, I told you I'd cover this later.) However this is not a problem at
+all. Now we finally have the desired indication that <tt>deflate()</tt> is really done,
+and so we drop out of the inner loop to provide more input to <tt>deflate()</tt>.
+<p>
+With <tt>flush</tt> set to <tt>Z_FINISH</tt>, this final set of <tt>deflate()</tt> calls will
+complete the output stream. Once that is done, subsequent calls of <tt>deflate()</tt> would return
+<tt>Z_STREAM_ERROR</tt> if the flush parameter is not <tt>Z_FINISH</tt>, and do no more processing
+until the state is reinitialized.
+<p>
+Some applications of <em>zlib</em> have two loops that call <tt>deflate()</tt>
+instead of the single inner loop we have here. The first loop would call
+without flushing and feed all of the data to <tt>deflate()</tt>. The second loop would call
+<tt>deflate()</tt> with no more
+data and the <tt>Z_FINISH</tt> parameter to complete the process. As you can see from this
+example, that can be avoided by simply keeping track of the current flush state.
+<pre><b>
+ } while (strm.avail_out == 0);
+ assert(strm.avail_in == 0); /* all input will be used */
+</b></pre><!-- -->
+Now we check to see if we have already processed all of the input file. That information was
+saved in the <tt>flush</tt> variable, so we see if that was set to <tt>Z_FINISH</tt>. If so,
+then we're done and we fall out of the outer loop. We're guaranteed to get <tt>Z_STREAM_END</tt>
+from the last <tt>deflate()</tt> call, since we ran it until the last chunk of input was
+consumed and all of the output was generated.
+<pre><b>
+ /* done when last data in file processed */
+ } while (flush != Z_FINISH);
+ assert(ret == Z_STREAM_END); /* stream will be complete */
+</b></pre><!-- -->
+The process is complete, but we still need to deallocate the state to avoid a memory leak
+(or rather more like a memory hemorrhage if you didn't do this). Then
+finally we can return with a happy return value.
+<pre><b>
+ /* clean up and return */
+ (void)deflateEnd(&amp;strm);
+ return Z_OK;
+}
+</b></pre><!-- -->
+Now we do the same thing for decompression in the <tt>inf()</tt> routine. <tt>inf()</tt>
+decompresses what is hopefully a valid <em>zlib</em> stream from the input file and writes the
+uncompressed data to the output file. Much of the discussion above for <tt>def()</tt>
+applies to <tt>inf()</tt> as well, so the discussion here will focus on the differences between
+the two.
+<pre><b>
+/* Decompress from file source to file dest until stream ends or EOF.
+ inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be
+ allocated for processing, Z_DATA_ERROR if the deflate data is
+ invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and
+ the version of the library linked do not match, or Z_ERRNO if there
+ is an error reading or writing the files. */
+int inf(FILE *source, FILE *dest)
+{
+</b></pre>
+The local variables have the same functionality as they do for <tt>def()</tt>. The
+only difference is that there is no <tt>flush</tt> variable, since <tt>inflate()</tt>
+can tell from the <em>zlib</em> stream itself when the stream is complete.
+<pre><b>
+ int ret;
+ unsigned have;
+ z_stream strm;
+ unsigned char in[CHUNK];
+ unsigned char out[CHUNK];
+</b></pre><!-- -->
+The initialization of the state is the same, except that there is no compression level,
+of course, and two more elements of the structure are initialized. <tt>avail_in</tt>
+and <tt>next_in</tt> must be initialized before calling <tt>inflateInit()</tt>. This
+is because the application has the option to provide the start of the zlib stream in
+order for <tt>inflateInit()</tt> to have access to information about the compression
+method to aid in memory allocation. In the current implementation of <em>zlib</em>
+(up through versions 1.2.x), the method-dependent memory allocations are deferred to the first call of
+<tt>inflate()</tt> anyway. However those fields must be initialized since later versions
+of <em>zlib</em> that provide more compression methods may take advantage of this interface.
+In any case, no decompression is performed by <tt>inflateInit()</tt>, so the
+<tt>avail_out</tt> and <tt>next_out</tt> fields do not need to be initialized before calling.
+<p>
+Here <tt>avail_in</tt> is set to zero and <tt>next_in</tt> is set to <tt>Z_NULL</tt> to
+indicate that no input data is being provided.
+<pre><b>
+ /* allocate inflate state */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit(&amp;strm);
+ if (ret != Z_OK)
+ return ret;
+</b></pre><!-- -->
+The outer <tt>do</tt>-loop decompresses input until <tt>inflate()</tt> indicates
+that it has reached the end of the compressed data and has produced all of the uncompressed
+output. This is in contrast to <tt>def()</tt> which processes all of the input file.
+If end-of-file is reached before the compressed data self-terminates, then the compressed
+data is incomplete and an error is returned.
+<pre><b>
+ /* decompress until deflate stream ends or end of file */
+ do {
+</b></pre>
+We read input data and set the <tt>strm</tt> structure accordingly. If we've reached the
+end of the input file, then we leave the outer loop and report an error, since the
+compressed data is incomplete. Note that we may read more data than is eventually consumed
+by <tt>inflate()</tt>, if the input file continues past the <em>zlib</em> stream.
+For applications where <em>zlib</em> streams are embedded in other data, this routine would
+need to be modified to return the unused data, or at least indicate how much of the input
+data was not used, so the application would know where to pick up after the <em>zlib</em> stream.
+<pre><b>
+ strm.avail_in = fread(in, 1, CHUNK, source);
+ if (ferror(source)) {
+ (void)inflateEnd(&amp;strm);
+ return Z_ERRNO;
+ }
+ if (strm.avail_in == 0)
+ break;
+ strm.next_in = in;
+</b></pre><!-- -->
+The inner <tt>do</tt>-loop has the same function it did in <tt>def()</tt>, which is to
+keep calling <tt>inflate()</tt> until has generated all of the output it can with the
+provided input.
+<pre><b>
+ /* run inflate() on input until output buffer not full */
+ do {
+</b></pre>
+Just like in <tt>def()</tt>, the same output space is provided for each call of <tt>inflate()</tt>.
+<pre><b>
+ strm.avail_out = CHUNK;
+ strm.next_out = out;
+</b></pre>
+Now we run the decompression engine itself. There is no need to adjust the flush parameter, since
+the <em>zlib</em> format is self-terminating. The main difference here is that there are
+return values that we need to pay attention to. <tt>Z_DATA_ERROR</tt>
+indicates that <tt>inflate()</tt> detected an error in the <em>zlib</em> compressed data format,
+which means that either the data is not a <em>zlib</em> stream to begin with, or that the data was
+corrupted somewhere along the way since it was compressed. The other error to be processed is
+<tt>Z_MEM_ERROR</tt>, which can occur since memory allocation is deferred until <tt>inflate()</tt>
+needs it, unlike <tt>deflate()</tt>, whose memory is allocated at the start by <tt>deflateInit()</tt>.
+<p>
+Advanced applications may use
+<tt>deflateSetDictionary()</tt> to prime <tt>deflate()</tt> with a set of likely data to improve the
+first 32K or so of compression. This is noted in the <em>zlib</em> header, so <tt>inflate()</tt>
+requests that that dictionary be provided before it can start to decompress. Without the dictionary,
+correct decompression is not possible. For this routine, we have no idea what the dictionary is,
+so the <tt>Z_NEED_DICT</tt> indication is converted to a <tt>Z_DATA_ERROR</tt>.
+<p>
+<tt>inflate()</tt> can also return <tt>Z_STREAM_ERROR</tt>, which should not be possible here,
+but could be checked for as noted above for <tt>def()</tt>. <tt>Z_BUF_ERROR</tt> does not need to be
+checked for here, for the same reasons noted for <tt>def()</tt>. <tt>Z_STREAM_END</tt> will be
+checked for later.
+<pre><b>
+ ret = inflate(&amp;strm, Z_NO_FLUSH);
+ assert(ret != Z_STREAM_ERROR); /* state not clobbered */
+ switch (ret) {
+ case Z_NEED_DICT:
+ ret = Z_DATA_ERROR; /* and fall through */
+ case Z_DATA_ERROR:
+ case Z_MEM_ERROR:
+ (void)inflateEnd(&amp;strm);
+ return ret;
+ }
+</b></pre>
+The output of <tt>inflate()</tt> is handled identically to that of <tt>deflate()</tt>.
+<pre><b>
+ have = CHUNK - strm.avail_out;
+ if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
+ (void)inflateEnd(&amp;strm);
+ return Z_ERRNO;
+ }
+</b></pre>
+The inner <tt>do</tt>-loop ends when <tt>inflate()</tt> has no more output as indicated
+by not filling the output buffer, just as for <tt>deflate()</tt>. In this case, we cannot
+assert that <tt>strm.avail_in</tt> will be zero, since the deflate stream may end before the file
+does.
+<pre><b>
+ } while (strm.avail_out == 0);
+</b></pre><!-- -->
+The outer <tt>do</tt>-loop ends when <tt>inflate()</tt> reports that it has reached the
+end of the input <em>zlib</em> stream, has completed the decompression and integrity
+check, and has provided all of the output. This is indicated by the <tt>inflate()</tt>
+return value <tt>Z_STREAM_END</tt>. The inner loop is guaranteed to leave <tt>ret</tt>
+equal to <tt>Z_STREAM_END</tt> if the last chunk of the input file read contained the end
+of the <em>zlib</em> stream. So if the return value is not <tt>Z_STREAM_END</tt>, the
+loop continues to read more input.
+<pre><b>
+ /* done when inflate() says it's done */
+ } while (ret != Z_STREAM_END);
+</b></pre><!-- -->
+At this point, decompression successfully completed, or we broke out of the loop due to no
+more data being available from the input file. If the last <tt>inflate()</tt> return value
+is not <tt>Z_STREAM_END</tt>, then the <em>zlib</em> stream was incomplete and a data error
+is returned. Otherwise, we return with a happy return value. Of course, <tt>inflateEnd()</tt>
+is called first to avoid a memory leak.
+<pre><b>
+ /* clean up and return */
+ (void)inflateEnd(&amp;strm);
+ return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR;
+}
+</b></pre><!-- -->
+That ends the routines that directly use <em>zlib</em>. The following routines make this
+a command-line program by running data through the above routines from <tt>stdin</tt> to
+<tt>stdout</tt>, and handling any errors reported by <tt>def()</tt> or <tt>inf()</tt>.
+<p>
+<tt>zerr()</tt> is used to interpret the possible error codes from <tt>def()</tt>
+and <tt>inf()</tt>, as detailed in their comments above, and print out an error message.
+Note that these are only a subset of the possible return values from <tt>deflate()</tt>
+and <tt>inflate()</tt>.
+<pre><b>
+/* report a zlib or i/o error */
+void zerr(int ret)
+{
+ fputs("zpipe: ", stderr);
+ switch (ret) {
+ case Z_ERRNO:
+ if (ferror(stdin))
+ fputs("error reading stdin\n", stderr);
+ if (ferror(stdout))
+ fputs("error writing stdout\n", stderr);
+ break;
+ case Z_STREAM_ERROR:
+ fputs("invalid compression level\n", stderr);
+ break;
+ case Z_DATA_ERROR:
+ fputs("invalid or incomplete deflate data\n", stderr);
+ break;
+ case Z_MEM_ERROR:
+ fputs("out of memory\n", stderr);
+ break;
+ case Z_VERSION_ERROR:
+ fputs("zlib version mismatch!\n", stderr);
+ }
+}
+</b></pre><!-- -->
+Here is the <tt>main()</tt> routine used to test <tt>def()</tt> and <tt>inf()</tt>. The
+<tt>zpipe</tt> command is simply a compression pipe from <tt>stdin</tt> to <tt>stdout</tt>, if
+no arguments are given, or it is a decompression pipe if <tt>zpipe -d</tt> is used. If any other
+arguments are provided, no compression or decompression is performed. Instead a usage
+message is displayed. Examples are <tt>zpipe < foo.txt > foo.txt.z</tt> to compress, and
+<tt>zpipe -d < foo.txt.z > foo.txt</tt> to decompress.
+<pre><b>
+/* compress or decompress from stdin to stdout */
+int main(int argc, char **argv)
+{
+ int ret;
+
+ /* avoid end-of-line conversions */
+ SET_BINARY_MODE(stdin);
+ SET_BINARY_MODE(stdout);
+
+ /* do compression if no arguments */
+ if (argc == 1) {
+ ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION);
+ if (ret != Z_OK)
+ zerr(ret);
+ return ret;
+ }
+
+ /* do decompression if -d specified */
+ else if (argc == 2 &amp;&amp; strcmp(argv[1], "-d") == 0) {
+ ret = inf(stdin, stdout);
+ if (ret != Z_OK)
+ zerr(ret);
+ return ret;
+ }
+
+ /* otherwise, report usage */
+ else {
+ fputs("zpipe usage: zpipe [-d] &lt; source &gt; dest\n", stderr);
+ return 1;
+ }
+}
+</b></pre>
+<hr>
+<i>Copyright (c) 2004, 2005 by Mark Adler<br>Last modified 11 December 2005</i>
+</body>
+</html>
diff --git a/compat/zlib/examples/zpipe.c b/compat/zlib/examples/zpipe.c
new file mode 100644
index 0000000..83535d1
--- /dev/null
+++ b/compat/zlib/examples/zpipe.c
@@ -0,0 +1,205 @@
+/* zpipe.c: example of proper use of zlib's inflate() and deflate()
+ Not copyrighted -- provided to the public domain
+ Version 1.4 11 December 2005 Mark Adler */
+
+/* Version history:
+ 1.0 30 Oct 2004 First version
+ 1.1 8 Nov 2004 Add void casting for unused return values
+ Use switch statement for inflate() return values
+ 1.2 9 Nov 2004 Add assertions to document zlib guarantees
+ 1.3 6 Apr 2005 Remove incorrect assertion in inf()
+ 1.4 11 Dec 2005 Add hack to avoid MSDOS end-of-line conversions
+ Avoid some compiler warnings for input and output buffers
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <assert.h>
+#include "zlib.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 CHUNK 16384
+
+/* Compress from file source to file dest until EOF on source.
+ def() returns Z_OK on success, Z_MEM_ERROR if memory could not be
+ allocated for processing, Z_STREAM_ERROR if an invalid compression
+ level is supplied, Z_VERSION_ERROR if the version of zlib.h and the
+ version of the library linked do not match, or Z_ERRNO if there is
+ an error reading or writing the files. */
+int def(FILE *source, FILE *dest, int level)
+{
+ int ret, flush;
+ unsigned have;
+ z_stream strm;
+ unsigned char in[CHUNK];
+ unsigned char out[CHUNK];
+
+ /* allocate deflate state */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ ret = deflateInit(&strm, level);
+ if (ret != Z_OK)
+ return ret;
+
+ /* compress until end of file */
+ do {
+ strm.avail_in = fread(in, 1, CHUNK, source);
+ if (ferror(source)) {
+ (void)deflateEnd(&strm);
+ return Z_ERRNO;
+ }
+ flush = feof(source) ? Z_FINISH : Z_NO_FLUSH;
+ strm.next_in = in;
+
+ /* run deflate() on input until output buffer not full, finish
+ compression if all of source has been read in */
+ do {
+ strm.avail_out = CHUNK;
+ strm.next_out = out;
+ ret = deflate(&strm, flush); /* no bad return value */
+ assert(ret != Z_STREAM_ERROR); /* state not clobbered */
+ have = CHUNK - strm.avail_out;
+ if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
+ (void)deflateEnd(&strm);
+ return Z_ERRNO;
+ }
+ } while (strm.avail_out == 0);
+ assert(strm.avail_in == 0); /* all input will be used */
+
+ /* done when last data in file processed */
+ } while (flush != Z_FINISH);
+ assert(ret == Z_STREAM_END); /* stream will be complete */
+
+ /* clean up and return */
+ (void)deflateEnd(&strm);
+ return Z_OK;
+}
+
+/* Decompress from file source to file dest until stream ends or EOF.
+ inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be
+ allocated for processing, Z_DATA_ERROR if the deflate data is
+ invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and
+ the version of the library linked do not match, or Z_ERRNO if there
+ is an error reading or writing the files. */
+int inf(FILE *source, FILE *dest)
+{
+ int ret;
+ unsigned have;
+ z_stream strm;
+ unsigned char in[CHUNK];
+ unsigned char out[CHUNK];
+
+ /* allocate inflate state */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit(&strm);
+ if (ret != Z_OK)
+ return ret;
+
+ /* decompress until deflate stream ends or end of file */
+ do {
+ strm.avail_in = fread(in, 1, CHUNK, source);
+ if (ferror(source)) {
+ (void)inflateEnd(&strm);
+ return Z_ERRNO;
+ }
+ if (strm.avail_in == 0)
+ break;
+ strm.next_in = in;
+
+ /* run inflate() on input until output buffer not full */
+ do {
+ strm.avail_out = CHUNK;
+ strm.next_out = out;
+ ret = inflate(&strm, Z_NO_FLUSH);
+ assert(ret != Z_STREAM_ERROR); /* state not clobbered */
+ switch (ret) {
+ case Z_NEED_DICT:
+ ret = Z_DATA_ERROR; /* and fall through */
+ case Z_DATA_ERROR:
+ case Z_MEM_ERROR:
+ (void)inflateEnd(&strm);
+ return ret;
+ }
+ have = CHUNK - strm.avail_out;
+ if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
+ (void)inflateEnd(&strm);
+ return Z_ERRNO;
+ }
+ } while (strm.avail_out == 0);
+
+ /* done when inflate() says it's done */
+ } while (ret != Z_STREAM_END);
+
+ /* clean up and return */
+ (void)inflateEnd(&strm);
+ return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR;
+}
+
+/* report a zlib or i/o error */
+void zerr(int ret)
+{
+ fputs("zpipe: ", stderr);
+ switch (ret) {
+ case Z_ERRNO:
+ if (ferror(stdin))
+ fputs("error reading stdin\n", stderr);
+ if (ferror(stdout))
+ fputs("error writing stdout\n", stderr);
+ break;
+ case Z_STREAM_ERROR:
+ fputs("invalid compression level\n", stderr);
+ break;
+ case Z_DATA_ERROR:
+ fputs("invalid or incomplete deflate data\n", stderr);
+ break;
+ case Z_MEM_ERROR:
+ fputs("out of memory\n", stderr);
+ break;
+ case Z_VERSION_ERROR:
+ fputs("zlib version mismatch!\n", stderr);
+ }
+}
+
+/* compress or decompress from stdin to stdout */
+int main(int argc, char **argv)
+{
+ int ret;
+
+ /* avoid end-of-line conversions */
+ SET_BINARY_MODE(stdin);
+ SET_BINARY_MODE(stdout);
+
+ /* do compression if no arguments */
+ if (argc == 1) {
+ ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION);
+ if (ret != Z_OK)
+ zerr(ret);
+ return ret;
+ }
+
+ /* do decompression if -d specified */
+ else if (argc == 2 && strcmp(argv[1], "-d") == 0) {
+ ret = inf(stdin, stdout);
+ if (ret != Z_OK)
+ zerr(ret);
+ return ret;
+ }
+
+ /* otherwise, report usage */
+ else {
+ fputs("zpipe usage: zpipe [-d] < source > dest\n", stderr);
+ return 1;
+ }
+}
diff --git a/compat/zlib/examples/zran.c b/compat/zlib/examples/zran.c
new file mode 100644
index 0000000..278f9ad
--- /dev/null
+++ b/compat/zlib/examples/zran.c
@@ -0,0 +1,409 @@
+/* zran.c -- example of zlib/gzip stream indexing and random access
+ * Copyright (C) 2005, 2012 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ Version 1.1 29 Sep 2012 Mark Adler */
+
+/* Version History:
+ 1.0 29 May 2005 First version
+ 1.1 29 Sep 2012 Fix memory reallocation error
+ */
+
+/* Illustrate the use of Z_BLOCK, inflatePrime(), and inflateSetDictionary()
+ for random access of a compressed file. A file containing a zlib or gzip
+ stream is provided on the command line. The compressed stream is decoded in
+ its entirety, and an index built with access points about every SPAN bytes
+ in the uncompressed output. The compressed file is left open, and can then
+ be read randomly, having to decompress on the average SPAN/2 uncompressed
+ bytes before getting to the desired block of data.
+
+ An access point can be created at the start of any deflate block, by saving
+ the starting file offset and bit of that block, and the 32K bytes of
+ uncompressed data that precede that block. Also the uncompressed offset of
+ that block is saved to provide a referece for locating a desired starting
+ point in the uncompressed stream. build_index() works by decompressing the
+ input zlib or gzip stream a block at a time, and at the end of each block
+ deciding if enough uncompressed data has gone by to justify the creation of
+ a new access point. If so, that point is saved in a data structure that
+ grows as needed to accommodate the points.
+
+ To use the index, an offset in the uncompressed data is provided, for which
+ the latest accees point at or preceding that offset is located in the index.
+ The input file is positioned to the specified location in the index, and if
+ necessary the first few bits of the compressed data is read from the file.
+ inflate is initialized with those bits and the 32K of uncompressed data, and
+ the decompression then proceeds until the desired offset in the file is
+ reached. Then the decompression continues to read the desired uncompressed
+ data from the file.
+
+ Another approach would be to generate the index on demand. In that case,
+ requests for random access reads from the compressed data would try to use
+ the index, but if a read far enough past the end of the index is required,
+ then further index entries would be generated and added.
+
+ There is some fair bit of overhead to starting inflation for the random
+ access, mainly copying the 32K byte dictionary. So if small pieces of the
+ file are being accessed, it would make sense to implement a cache to hold
+ some lookahead and avoid many calls to extract() for small lengths.
+
+ Another way to build an index would be to use inflateCopy(). That would
+ not be constrained to have access points at block boundaries, but requires
+ more memory per access point, and also cannot be saved to file due to the
+ use of pointers in the state. The approach here allows for storage of the
+ index in a file.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "zlib.h"
+
+#define local static
+
+#define SPAN 1048576L /* desired distance between access points */
+#define WINSIZE 32768U /* sliding window size */
+#define CHUNK 16384 /* file input buffer size */
+
+/* access point entry */
+struct point {
+ off_t out; /* corresponding offset in uncompressed data */
+ off_t in; /* offset in input file of first full byte */
+ int bits; /* number of bits (1-7) from byte at in - 1, or 0 */
+ unsigned char window[WINSIZE]; /* preceding 32K of uncompressed data */
+};
+
+/* access point list */
+struct access {
+ int have; /* number of list entries filled in */
+ int size; /* number of list entries allocated */
+ struct point *list; /* allocated list */
+};
+
+/* Deallocate an index built by build_index() */
+local void free_index(struct access *index)
+{
+ if (index != NULL) {
+ free(index->list);
+ free(index);
+ }
+}
+
+/* Add an entry to the access point list. If out of memory, deallocate the
+ existing list and return NULL. */
+local struct access *addpoint(struct access *index, int bits,
+ off_t in, off_t out, unsigned left, unsigned char *window)
+{
+ struct point *next;
+
+ /* if list is empty, create it (start with eight points) */
+ if (index == NULL) {
+ index = malloc(sizeof(struct access));
+ if (index == NULL) return NULL;
+ index->list = malloc(sizeof(struct point) << 3);
+ if (index->list == NULL) {
+ free(index);
+ return NULL;
+ }
+ index->size = 8;
+ index->have = 0;
+ }
+
+ /* if list is full, make it bigger */
+ else if (index->have == index->size) {
+ index->size <<= 1;
+ next = realloc(index->list, sizeof(struct point) * index->size);
+ if (next == NULL) {
+ free_index(index);
+ return NULL;
+ }
+ index->list = next;
+ }
+
+ /* fill in entry and increment how many we have */
+ next = index->list + index->have;
+ next->bits = bits;
+ next->in = in;
+ next->out = out;
+ if (left)
+ memcpy(next->window, window + WINSIZE - left, left);
+ if (left < WINSIZE)
+ memcpy(next->window + left, window, WINSIZE - left);
+ index->have++;
+
+ /* return list, possibly reallocated */
+ return index;
+}
+
+/* Make one entire pass through the compressed stream and build an index, with
+ access points about every span bytes of uncompressed output -- span is
+ chosen to balance the speed of random access against the memory requirements
+ of the list, about 32K bytes per access point. Note that data after the end
+ of the first zlib or gzip stream in the file is ignored. build_index()
+ returns the number of access points on success (>= 1), Z_MEM_ERROR for out
+ of memory, Z_DATA_ERROR for an error in the input file, or Z_ERRNO for a
+ file read error. On success, *built points to the resulting index. */
+local int build_index(FILE *in, off_t span, struct access **built)
+{
+ int ret;
+ off_t totin, totout; /* our own total counters to avoid 4GB limit */
+ off_t last; /* totout value of last access point */
+ struct access *index; /* access points being generated */
+ z_stream strm;
+ unsigned char input[CHUNK];
+ unsigned char window[WINSIZE];
+
+ /* initialize inflate */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, 47); /* automatic zlib or gzip decoding */
+ if (ret != Z_OK)
+ return ret;
+
+ /* inflate the input, maintain a sliding window, and build an index -- this
+ also validates the integrity of the compressed data using the check
+ information at the end of the gzip or zlib stream */
+ totin = totout = last = 0;
+ index = NULL; /* will be allocated by first addpoint() */
+ strm.avail_out = 0;
+ do {
+ /* get some compressed data from input file */
+ strm.avail_in = fread(input, 1, CHUNK, in);
+ if (ferror(in)) {
+ ret = Z_ERRNO;
+ goto build_index_error;
+ }
+ if (strm.avail_in == 0) {
+ ret = Z_DATA_ERROR;
+ goto build_index_error;
+ }
+ strm.next_in = input;
+
+ /* process all of that, or until end of stream */
+ do {
+ /* reset sliding window if necessary */
+ if (strm.avail_out == 0) {
+ strm.avail_out = WINSIZE;
+ strm.next_out = window;
+ }
+
+ /* inflate until out of input, output, or at end of block --
+ update the total input and output counters */
+ totin += strm.avail_in;
+ totout += strm.avail_out;
+ ret = inflate(&strm, Z_BLOCK); /* return at end of block */
+ totin -= strm.avail_in;
+ totout -= strm.avail_out;
+ if (ret == Z_NEED_DICT)
+ ret = Z_DATA_ERROR;
+ if (ret == Z_MEM_ERROR || ret == Z_DATA_ERROR)
+ goto build_index_error;
+ if (ret == Z_STREAM_END)
+ break;
+
+ /* if at end of block, consider adding an index entry (note that if
+ data_type indicates an end-of-block, then all of the
+ uncompressed data from that block has been delivered, and none
+ of the compressed data after that block has been consumed,
+ except for up to seven bits) -- the totout == 0 provides an
+ entry point after the zlib or gzip header, and assures that the
+ index always has at least one access point; we avoid creating an
+ access point after the last block by checking bit 6 of data_type
+ */
+ if ((strm.data_type & 128) && !(strm.data_type & 64) &&
+ (totout == 0 || totout - last > span)) {
+ index = addpoint(index, strm.data_type & 7, totin,
+ totout, strm.avail_out, window);
+ if (index == NULL) {
+ ret = Z_MEM_ERROR;
+ goto build_index_error;
+ }
+ last = totout;
+ }
+ } while (strm.avail_in != 0);
+ } while (ret != Z_STREAM_END);
+
+ /* clean up and return index (release unused entries in list) */
+ (void)inflateEnd(&strm);
+ index->list = realloc(index->list, sizeof(struct point) * index->have);
+ index->size = index->have;
+ *built = index;
+ return index->size;
+
+ /* return error */
+ build_index_error:
+ (void)inflateEnd(&strm);
+ if (index != NULL)
+ free_index(index);
+ return ret;
+}
+
+/* Use the index to read len bytes from offset into buf, return bytes read or
+ negative for error (Z_DATA_ERROR or Z_MEM_ERROR). If data is requested past
+ the end of the uncompressed data, then extract() will return a value less
+ than len, indicating how much as actually read into buf. This function
+ should not return a data error unless the file was modified since the index
+ was generated. extract() may also return Z_ERRNO if there is an error on
+ reading or seeking the input file. */
+local int extract(FILE *in, struct access *index, off_t offset,
+ unsigned char *buf, int len)
+{
+ int ret, skip;
+ z_stream strm;
+ struct point *here;
+ unsigned char input[CHUNK];
+ unsigned char discard[WINSIZE];
+
+ /* proceed only if something reasonable to do */
+ if (len < 0)
+ return 0;
+
+ /* find where in stream to start */
+ here = index->list;
+ ret = index->have;
+ while (--ret && here[1].out <= offset)
+ here++;
+
+ /* initialize file and inflate state to start there */
+ strm.zalloc = Z_NULL;
+ strm.zfree = Z_NULL;
+ strm.opaque = Z_NULL;
+ strm.avail_in = 0;
+ strm.next_in = Z_NULL;
+ ret = inflateInit2(&strm, -15); /* raw inflate */
+ if (ret != Z_OK)
+ return ret;
+ ret = fseeko(in, here->in - (here->bits ? 1 : 0), SEEK_SET);
+ if (ret == -1)
+ goto extract_ret;
+ if (here->bits) {
+ ret = getc(in);
+ if (ret == -1) {
+ ret = ferror(in) ? Z_ERRNO : Z_DATA_ERROR;
+ goto extract_ret;
+ }
+ (void)inflatePrime(&strm, here->bits, ret >> (8 - here->bits));
+ }
+ (void)inflateSetDictionary(&strm, here->window, WINSIZE);
+
+ /* skip uncompressed bytes until offset reached, then satisfy request */
+ offset -= here->out;
+ strm.avail_in = 0;
+ skip = 1; /* while skipping to offset */
+ do {
+ /* define where to put uncompressed data, and how much */
+ if (offset == 0 && skip) { /* at offset now */
+ strm.avail_out = len;
+ strm.next_out = buf;
+ skip = 0; /* only do this once */
+ }
+ if (offset > WINSIZE) { /* skip WINSIZE bytes */
+ strm.avail_out = WINSIZE;
+ strm.next_out = discard;
+ offset -= WINSIZE;
+ }
+ else if (offset != 0) { /* last skip */
+ strm.avail_out = (unsigned)offset;
+ strm.next_out = discard;
+ offset = 0;
+ }
+
+ /* uncompress until avail_out filled, or end of stream */
+ do {
+ if (strm.avail_in == 0) {
+ strm.avail_in = fread(input, 1, CHUNK, in);
+ if (ferror(in)) {
+ ret = Z_ERRNO;
+ goto extract_ret;
+ }
+ if (strm.avail_in == 0) {
+ ret = Z_DATA_ERROR;
+ goto extract_ret;
+ }
+ strm.next_in = input;
+ }
+ ret = inflate(&strm, Z_NO_FLUSH); /* normal inflate */
+ if (ret == Z_NEED_DICT)
+ ret = Z_DATA_ERROR;
+ if (ret == Z_MEM_ERROR || ret == Z_DATA_ERROR)
+ goto extract_ret;
+ if (ret == Z_STREAM_END)
+ break;
+ } while (strm.avail_out != 0);
+
+ /* if reach end of stream, then don't keep trying to get more */
+ if (ret == Z_STREAM_END)
+ break;
+
+ /* do until offset reached and requested data read, or stream ends */
+ } while (skip);
+
+ /* compute number of uncompressed bytes read after offset */
+ ret = skip ? 0 : len - strm.avail_out;
+
+ /* clean up and return bytes read or error */
+ extract_ret:
+ (void)inflateEnd(&strm);
+ return ret;
+}
+
+/* Demonstrate the use of build_index() and extract() by processing the file
+ provided on the command line, and the extracting 16K from about 2/3rds of
+ the way through the uncompressed output, and writing that to stdout. */
+int main(int argc, char **argv)
+{
+ int len;
+ off_t offset;
+ FILE *in;
+ struct access *index = NULL;
+ unsigned char buf[CHUNK];
+
+ /* open input file */
+ if (argc != 2) {
+ fprintf(stderr, "usage: zran file.gz\n");
+ return 1;
+ }
+ in = fopen(argv[1], "rb");
+ if (in == NULL) {
+ fprintf(stderr, "zran: could not open %s for reading\n", argv[1]);
+ return 1;
+ }
+
+ /* build index */
+ len = build_index(in, SPAN, &index);
+ if (len < 0) {
+ fclose(in);
+ switch (len) {
+ case Z_MEM_ERROR:
+ fprintf(stderr, "zran: out of memory\n");
+ break;
+ case Z_DATA_ERROR:
+ fprintf(stderr, "zran: compressed data error in %s\n", argv[1]);
+ break;
+ case Z_ERRNO:
+ fprintf(stderr, "zran: read error on %s\n", argv[1]);
+ break;
+ default:
+ fprintf(stderr, "zran: error %d while building index\n", len);
+ }
+ return 1;
+ }
+ fprintf(stderr, "zran: built index with %d access points\n", len);
+
+ /* use index by reading some bytes from an arbitrary offset */
+ offset = (index->list[index->have - 1].out << 1) / 3;
+ len = extract(in, index, offset, buf, CHUNK);
+ if (len < 0)
+ fprintf(stderr, "zran: extraction failed: %s error\n",
+ len == Z_MEM_ERROR ? "out of memory" : "input corrupted");
+ else {
+ fwrite(buf, 1, len, stdout);
+ fprintf(stderr, "zran: extracted %d bytes at %llu\n", len, offset);
+ }
+
+ /* clean up and exit */
+ free_index(index);
+ fclose(in);
+ return 0;
+}
diff --git a/compat/zlib/gzclose.c b/compat/zlib/gzclose.c
new file mode 100644
index 0000000..caeb99a
--- /dev/null
+++ b/compat/zlib/gzclose.c
@@ -0,0 +1,25 @@
+/* gzclose.c -- zlib gzclose() function
+ * Copyright (C) 2004, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "gzguts.h"
+
+/* gzclose() is in a separate file so that it is linked in only if it is used.
+ That way the other gzclose functions can be used instead to avoid linking in
+ unneeded compression or decompression routines. */
+int ZEXPORT gzclose(file)
+ gzFile file;
+{
+#ifndef NO_GZCOMPRESS
+ gz_statep state;
+
+ if (file == NULL)
+ return Z_STREAM_ERROR;
+ state = (gz_statep)file;
+
+ return state->mode == GZ_READ ? gzclose_r(file) : gzclose_w(file);
+#else
+ return gzclose_r(file);
+#endif
+}
diff --git a/compat/zlib/gzguts.h b/compat/zlib/gzguts.h
new file mode 100644
index 0000000..d87659d
--- /dev/null
+++ b/compat/zlib/gzguts.h
@@ -0,0 +1,209 @@
+/* gzguts.h -- zlib internal header definitions for gz* operations
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#ifdef _LARGEFILE64_SOURCE
+# ifndef _LARGEFILE_SOURCE
+# define _LARGEFILE_SOURCE 1
+# endif
+# ifdef _FILE_OFFSET_BITS
+# undef _FILE_OFFSET_BITS
+# endif
+#endif
+
+#ifdef HAVE_HIDDEN
+# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
+#else
+# define ZLIB_INTERNAL
+#endif
+
+#include <stdio.h>
+#include "zlib.h"
+#ifdef STDC
+# include <string.h>
+# include <stdlib.h>
+# include <limits.h>
+#endif
+#include <fcntl.h>
+
+#ifdef _WIN32
+# include <stddef.h>
+#endif
+
+#if defined(__TURBOC__) || defined(_MSC_VER) || defined(_WIN32)
+# include <io.h>
+#endif
+
+#ifdef WINAPI_FAMILY
+# define open _open
+# define read _read
+# define write _write
+# define close _close
+#endif
+
+#ifdef NO_DEFLATE /* for compatibility with old definition */
+# define NO_GZCOMPRESS
+#endif
+
+#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
+
+/* unlike snprintf (which is required in C99, yet still not supported by
+ Microsoft more than a decade later!), _snprintf does not guarantee null
+ termination of the result -- however this is only used in gzlib.c where
+ the result is assured to fit in the space provided */
+#ifdef _MSC_VER
+# define snprintf _snprintf
+#endif
+
+#ifndef local
+# define local static
+#endif
+/* compile with -Dlocal if your debugger can't find static symbols */
+
+/* gz* functions always use library allocation functions */
+#ifndef STDC
+ extern voidp malloc OF((uInt size));
+ extern void free OF((voidpf ptr));
+#endif
+
+/* get errno and strerror definition */
+#if defined UNDER_CE
+# include <windows.h>
+# define zstrerror() gz_strwinerror((DWORD)GetLastError())
+#else
+# ifndef NO_STRERROR
+# include <errno.h>
+# define zstrerror() strerror(errno)
+# else
+# define zstrerror() "stdio error (consult errno)"
+# endif
+#endif
+
+/* provide prototypes for these when building zlib without LFS */
+#if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0
+ 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));
+ 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 (this and
+ twice this must be able to fit in an unsigned type) */
+#define GZBUFSIZE 8192
+
+/* gzip modes, also provide a little integrity check on the passed structure */
+#define GZ_NONE 0
+#define GZ_READ 7247
+#define GZ_WRITE 31153
+#define GZ_APPEND 1 /* mode set to GZ_WRITE after the file is opened */
+
+/* values for gz_state how */
+#define LOOK 0 /* look for a gzip header */
+#define COPY 1 /* copy input directly */
+#define GZIP 2 /* decompress a gzip stream */
+
+/* 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 */
+ 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) */
+ int direct; /* 0 if processing gzip, 1 if transparent */
+ /* just for reading */
+ int how; /* 0: get header, 1: copy, 2: decompress */
+ 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 */
+ /* seek request */
+ z_off64_t skip; /* amount to skip (already rewound if backwards) */
+ int seek; /* true if seek request pending */
+ /* error information */
+ int err; /* error code */
+ char *msg; /* error message */
+ /* zlib inflate or deflate stream */
+ z_stream strm; /* stream structure in-place (not a pointer) */
+} gz_state;
+typedef gz_state FAR *gz_statep;
+
+/* shared functions */
+void ZLIB_INTERNAL gz_error OF((gz_statep, int, const char *));
+#if defined UNDER_CE
+char ZLIB_INTERNAL *gz_strwinerror OF((DWORD error));
+#endif
+
+/* GT_OFF(x), where x is an unsigned value, is true if x > maximum z_off64_t
+ value -- needed when comparing unsigned to z_off64_t, which is signed
+ (possible z_off64_t types off_t, off64_t, and long are all signed) */
+#ifdef INT_MAX
+# define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > INT_MAX)
+#else
+unsigned ZLIB_INTERNAL gz_intmax OF((void));
+# define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > gz_intmax())
+#endif
diff --git a/compat/zlib/gzlib.c b/compat/zlib/gzlib.c
new file mode 100644
index 0000000..fae202e
--- /dev/null
+++ b/compat/zlib/gzlib.c
@@ -0,0 +1,634 @@
+/* gzlib.c -- zlib functions common to reading and writing gzip files
+ * Copyright (C) 2004, 2010, 2011, 2012, 2013 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 void *, int, const char *));
+
+#if defined UNDER_CE
+
+/* Map the Windows error number in ERROR to a locale-dependent error message
+ string and return a pointer to it. Typically, the values for ERROR come
+ from GetLastError.
+
+ The string pointed to shall not be modified by the application, but may be
+ overwritten by a subsequent call to gz_strwinerror
+
+ The gz_strwinerror function does not change the current setting of
+ GetLastError. */
+char ZLIB_INTERNAL *gz_strwinerror (error)
+ DWORD error;
+{
+ static char buf[1024];
+
+ wchar_t *msgbuf;
+ DWORD lasterr = GetLastError();
+ DWORD chars = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER,
+ NULL,
+ error,
+ 0, /* Default language */
+ (LPVOID)&msgbuf,
+ 0,
+ NULL);
+ if (chars != 0) {
+ /* If there is an \r\n appended, zap it. */
+ if (chars >= 2
+ && msgbuf[chars - 2] == '\r' && msgbuf[chars - 1] == '\n') {
+ chars -= 2;
+ msgbuf[chars] = 0;
+ }
+
+ if (chars > sizeof (buf) - 1) {
+ chars = sizeof (buf) - 1;
+ msgbuf[chars] = 0;
+ }
+
+ wcstombs(buf, msgbuf, chars + 1);
+ LocalFree(msgbuf);
+ }
+ else {
+ sprintf(buf, "unknown win32 error (%ld)", error);
+ }
+
+ SetLastError(lasterr);
+ return buf;
+}
+
+#endif /* UNDER_CE */
+
+/* Reset gzip file state */
+local void gz_reset(state)
+ gz_statep state;
+{
+ state->x.have = 0; /* no output data available */
+ if (state->mode == GZ_READ) { /* for reading ... */
+ 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->seek = 0; /* no seek request pending */
+ gz_error(state, Z_OK, NULL); /* clear error */
+ 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 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 = (gz_statep)malloc(sizeof(gz_state));
+ if (state == NULL)
+ return NULL;
+ state->size = 0; /* no buffers allocated yet */
+ state->want = GZBUFSIZE; /* requested buffer size */
+ state->msg = NULL; /* no error message yet */
+
+ /* interpret 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';
+ else
+ switch (*mode) {
+ case 'r':
+ state->mode = GZ_READ;
+ break;
+#ifndef NO_GZCOMPRESS
+ case 'w':
+ state->mode = GZ_WRITE;
+ break;
+ case 'a':
+ state->mode = GZ_APPEND;
+ break;
+#endif
+ case '+': /* can't read and write at the same time */
+ free(state);
+ 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;
+ case 'h':
+ state->strategy = Z_HUFFMAN_ONLY;
+ break;
+ case 'R':
+ state->strategy = Z_RLE;
+ break;
+ case 'F':
+ state->strategy = Z_FIXED;
+ break;
+ case 'T':
+ state->direct = 1;
+ break;
+ default: /* could consider as an error, but just ignore */
+ ;
+ }
+ mode++;
+ }
+
+ /* must provide an "r", "w", or "a" */
+ if (state->mode == GZ_NONE) {
+ free(state);
+ 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 */
+#ifdef _WIN32
+ if (fd == -2) {
+ len = wcstombs(NULL, path, 0);
+ if (len == (size_t)-1)
+ len = 0;
+ }
+ else
+#endif
+ len = strlen((const char *)path);
+ state->path = (char *)malloc(len + 1);
+ if (state->path == NULL) {
+ free(state);
+ return NULL;
+ }
+#ifdef _WIN32
+ if (fd == -2)
+ if (len)
+ wcstombs(state->path, path, len + 1);
+ else
+ *(state->path) = 0;
+ else
+#endif
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(state->path, len + 1, "%s", (const char *)path);
+#else
+ strcpy(state->path, path);
+#endif
+
+ /* compute the flags for open() */
+ oflag =
+#ifdef O_LARGEFILE
+ O_LARGEFILE |
+#endif
+#ifdef O_BINARY
+ O_BINARY |
+#endif
+#ifdef O_CLOEXEC
+ (cloexec ? O_CLOEXEC : 0) |
+#endif
+ (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((const char *)path, oflag, 0666));
+ if (state->fd == -1) {
+ free(state->path);
+ free(state);
+ return NULL;
+ }
+ if (state->mode == GZ_APPEND)
+ state->mode = GZ_WRITE; /* simplify later checks */
+
+ /* save the current position for rewinding (only if reading) */
+ if (state->mode == GZ_READ) {
+ state->start = LSEEK(state->fd, 0, SEEK_CUR);
+ if (state->start == -1) state->start = 0;
+ }
+
+ /* initialize stream */
+ gz_reset(state);
+
+ /* return stream */
+ return (gzFile)state;
+}
+
+/* -- see zlib.h -- */
+gzFile ZEXPORT gzopen(path, mode)
+ const char *path;
+ const char *mode;
+{
+ return gz_open(path, -1, mode);
+}
+
+/* -- see zlib.h -- */
+gzFile ZEXPORT gzopen64(path, mode)
+ const char *path;
+ const char *mode;
+{
+ return gz_open(path, -1, mode);
+}
+
+/* -- see zlib.h -- */
+gzFile ZEXPORT gzdopen(fd, mode)
+ int fd;
+ const char *mode;
+{
+ char *path; /* identifier for error messages */
+ gzFile gz;
+
+ if (fd == -1 || (path = (char *)malloc(7 + 3 * sizeof(int))) == NULL)
+ return NULL;
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(path, 7 + 3 * sizeof(int), "<fd:%d>", fd); /* for debugging */
+#else
+ sprintf(path, "<fd:%d>", fd); /* for debugging */
+#endif
+ gz = gz_open(path, fd, mode);
+ free(path);
+ return gz;
+}
+
+/* -- 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;
+{
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return -1;
+
+ /* make sure we haven't already allocated memory */
+ if (state->size != 0)
+ return -1;
+
+ /* check and set requested size */
+ if (size < 2)
+ size = 2; /* need two bytes to check magic header */
+ state->want = size;
+ return 0;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzrewind(file)
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ 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 && state->err != Z_BUF_ERROR))
+ return -1;
+
+ /* back up and start over */
+ if (LSEEK(state->fd, state->start, SEEK_SET) == -1)
+ return -1;
+ gz_reset(state);
+ return 0;
+}
+
+/* -- see zlib.h -- */
+z_off64_t ZEXPORT gzseek64(file, offset, whence)
+ gzFile file;
+ z_off64_t offset;
+ int whence;
+{
+ unsigned n;
+ z_off64_t ret;
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return -1;
+
+ /* check that there's no error */
+ if (state->err != Z_OK && state->err != Z_BUF_ERROR)
+ return -1;
+
+ /* can only seek from start or relative to current position */
+ if (whence != SEEK_SET && whence != SEEK_CUR)
+ return -1;
+
+ /* normalize offset to a SEEK_CUR specification */
+ if (whence == SEEK_SET)
+ 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->x.pos + offset >= 0) {
+ ret = LSEEK(state->fd, offset - state->x.have, SEEK_CUR);
+ if (ret == -1)
+ return -1;
+ 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->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->x.pos;
+ if (offset < 0) /* before start of file! */
+ return -1;
+ if (gzrewind(file) == -1) /* rewind, then skip to offset */
+ return -1;
+ }
+
+ /* if reading, skip what's in output buffer (one less gzgetc() check) */
+ if (state->mode == GZ_READ) {
+ 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;
+ }
+
+ /* request skip (if not zero) */
+ if (offset) {
+ state->seek = 1;
+ state->skip = offset;
+ }
+ return state->x.pos + offset;
+}
+
+/* -- see zlib.h -- */
+z_off_t ZEXPORT gzseek(file, offset, whence)
+ gzFile file;
+ z_off_t offset;
+ int whence;
+{
+ z_off64_t ret;
+
+ ret = gzseek64(file, (z_off64_t)offset, whence);
+ return ret == (z_off_t)ret ? (z_off_t)ret : -1;
+}
+
+/* -- see zlib.h -- */
+z_off64_t ZEXPORT gztell64(file)
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return -1;
+
+ /* return position */
+ return state->x.pos + (state->seek ? state->skip : 0);
+}
+
+/* -- see zlib.h -- */
+z_off_t ZEXPORT gztell(file)
+ gzFile file;
+{
+ z_off64_t ret;
+
+ ret = gztell64(file);
+ return ret == (z_off_t)ret ? (z_off_t)ret : -1;
+}
+
+/* -- see zlib.h -- */
+z_off64_t ZEXPORT gzoffset64(file)
+ gzFile file;
+{
+ z_off64_t offset;
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return -1;
+
+ /* compute and return effective offset in file */
+ offset = LSEEK(state->fd, 0, SEEK_CUR);
+ if (offset == -1)
+ return -1;
+ if (state->mode == GZ_READ) /* reading */
+ offset -= state->strm.avail_in; /* don't count buffered input */
+ return offset;
+}
+
+/* -- see zlib.h -- */
+z_off_t ZEXPORT gzoffset(file)
+ gzFile file;
+{
+ z_off64_t ret;
+
+ ret = gzoffset64(file);
+ return ret == (z_off_t)ret ? (z_off_t)ret : -1;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzeof(file)
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return 0;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return 0;
+
+ /* return end-of-file state */
+ return state->mode == GZ_READ ? state->past : 0;
+}
+
+/* -- see zlib.h -- */
+const char * ZEXPORT gzerror(file, errnum)
+ gzFile file;
+ int *errnum;
+{
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return NULL;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return NULL;
+
+ /* return error information */
+ if (errnum != NULL)
+ *errnum = state->err;
+ return state->err == Z_MEM_ERROR ? "out of memory" :
+ (state->msg == NULL ? "" : state->msg);
+}
+
+/* -- see zlib.h -- */
+void ZEXPORT gzclearerr(file)
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure and check integrity */
+ if (file == NULL)
+ return;
+ state = (gz_statep)file;
+ if (state->mode != GZ_READ && state->mode != GZ_WRITE)
+ return;
+
+ /* clear error and end-of-file */
+ if (state->mode == GZ_READ) {
+ state->eof = 0;
+ state->past = 0;
+ }
+ gz_error(state, Z_OK, NULL);
+}
+
+/* Create an error message in allocated memory and set state->err and
+ state->msg accordingly. Free any previous error message already there. Do
+ not try to free or allocate space if the error is Z_MEM_ERROR (out of
+ memory). Simply save the error message as a static string. If there is an
+ allocation failure constructing the error message, then convert the error to
+ out of memory. */
+void ZLIB_INTERNAL gz_error(state, err, msg)
+ gz_statep state;
+ int err;
+ const char *msg;
+{
+ /* free previously allocated message and clear */
+ if (state->msg != NULL) {
+ if (state->err != Z_MEM_ERROR)
+ free(state->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)
+ return;
+
+ /* for an out of memory error, return literal string when requested */
+ if (err == Z_MEM_ERROR)
+ return;
+
+ /* construct error message with path */
+ if ((state->msg = (char *)malloc(strlen(state->path) + strlen(msg) + 3)) ==
+ NULL) {
+ state->err = Z_MEM_ERROR;
+ return;
+ }
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(state->msg, strlen(state->path) + strlen(msg) + 3,
+ "%s%s%s", state->path, ": ", msg);
+#else
+ strcpy(state->msg, state->path);
+ strcat(state->msg, ": ");
+ strcat(state->msg, msg);
+#endif
+ return;
+}
+
+#ifndef INT_MAX
+/* portably return maximum value for an int (when limits.h presumed not
+ available) -- we need to do this to cover cases where 2's complement not
+ used, since C standard permits 1's complement and sign-bit representations,
+ otherwise we could just use ((unsigned)-1) >> 1 */
+unsigned ZLIB_INTERNAL gz_intmax()
+{
+ unsigned p, q;
+
+ p = 1;
+ do {
+ q = p;
+ p <<= 1;
+ p++;
+ } while (p > q);
+ return q >> 1;
+}
+#endif
diff --git a/compat/zlib/gzread.c b/compat/zlib/gzread.c
new file mode 100644
index 0000000..bf4538e
--- /dev/null
+++ b/compat/zlib/gzread.c
@@ -0,0 +1,594 @@
+/* gzread.c -- zlib functions for reading gzip files
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "gzguts.h"
+
+/* Local functions */
+local int gz_load OF((gz_statep, unsigned char *, unsigned, unsigned *));
+local int gz_avail OF((gz_statep));
+local int gz_look OF((gz_statep));
+local int gz_decomp 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
+ state->fd, and update state->eof, state->err, and state->msg as appropriate.
+ This function needs to loop on read(), since read() is not guaranteed to
+ read the number of bytes requested, depending on the type of descriptor. */
+local int gz_load(state, buf, len, have)
+ gz_statep state;
+ unsigned char *buf;
+ unsigned len;
+ unsigned *have;
+{
+ int ret;
+
+ *have = 0;
+ do {
+ ret = read(state->fd, buf + *have, len - *have);
+ if (ret <= 0)
+ break;
+ *have += ret;
+ } while (*have < len);
+ if (ret < 0) {
+ gz_error(state, Z_ERRNO, zstrerror());
+ return -1;
+ }
+ if (ret == 0)
+ state->eof = 1;
+ return 0;
+}
+
+/* Load up input buffer and set eof flag if last data loaded -- return -1 on
+ 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.
+ 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 && state->err != Z_BUF_ERROR)
+ return -1;
+ if (state->eof == 0) {
+ if (strm->avail_in) { /* copy what's there to the start */
+ unsigned char *p = state->in;
+ unsigned const char *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;
+}
+
+/* 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. 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);
+
+ /* allocate read buffers and inflate memory */
+ if (state->size == 0) {
+ /* allocate buffers */
+ state->in = (unsigned char *)malloc(state->want);
+ state->out = (unsigned char *)malloc(state->want << 1);
+ if (state->in == NULL || state->out == NULL) {
+ if (state->out != NULL)
+ free(state->out);
+ if (state->in != NULL)
+ free(state->in);
+ gz_error(state, Z_MEM_ERROR, "out of memory");
+ return -1;
+ }
+ state->size = state->want;
+
+ /* allocate inflate memory */
+ state->strm.zalloc = Z_NULL;
+ state->strm.zfree = Z_NULL;
+ state->strm.opaque = Z_NULL;
+ state->strm.avail_in = 0;
+ state->strm.next_in = Z_NULL;
+ if (inflateInit2(&(state->strm), 15 + 16) != Z_OK) { /* gunzip */
+ free(state->out);
+ free(state->in);
+ state->size = 0;
+ gz_error(state, Z_MEM_ERROR, "out of memory");
+ return -1;
+ }
+ }
+
+ /* 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 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, 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->x.next, strm->next_in, strm->avail_in);
+ state->x.have = strm->avail_in;
+ strm->avail_in = 0;
+ }
+ state->how = COPY;
+ state->direct = 1;
+ return 0;
+}
+
+/* Decompress from input to the provided next_out and avail_out in the state.
+ 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 = Z_OK;
+ unsigned had;
+ z_streamp strm = &(state->strm);
+
+ /* fill output buffer up to end of deflate stream */
+ had = strm->avail_out;
+ do {
+ /* get more input for inflate() */
+ if (strm->avail_in == 0 && gz_avail(state) == -1)
+ return -1;
+ if (strm->avail_in == 0) {
+ 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");
+ return -1;
+ }
+ if (ret == Z_MEM_ERROR) {
+ gz_error(state, Z_MEM_ERROR, "out of memory");
+ return -1;
+ }
+ if (ret == Z_DATA_ERROR) { /* deflate stream invalid */
+ gz_error(state, Z_DATA_ERROR,
+ strm->msg == NULL ? "compressed data error" : strm->msg);
+ return -1;
+ }
+ } while (strm->avail_out && ret != Z_STREAM_END);
+
+ /* update available output */
+ state->x.have = had - strm->avail_out;
+ state->x.next = strm->next_out - state->x.have;
+
+ /* if the gzip stream completed successfully, look for another */
+ if (ret == Z_STREAM_END)
+ state->how = LOOK;
+
+ /* good decompression */
+ return 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 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);
+
+ 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;
+ 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;
+}
+
+/* Skip len uncompressed bytes of output. Return -1 on error, 0 on success. */
+local int gz_skip(state, len)
+ gz_statep state;
+ z_off64_t len;
+{
+ unsigned n;
+
+ /* skip over len bytes or reach end-of-file, whichever comes first */
+ while (len)
+ /* skip over whatever is in output buffer */
+ 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;
+ }
+
+ /* output buffer empty -- return if we're at the end of the input */
+ else if (state->eof && state->strm.avail_in == 0)
+ break;
+
+ /* need more data to skip -- load up output buffer */
+ else {
+ /* get more output, looking for header if required */
+ if (gz_fetch(state) == -1)
+ return -1;
+ }
+ return 0;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzread(file, buf, len)
+ gzFile file;
+ voidp buf;
+ unsigned len;
+{
+ unsigned got, n;
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ strm = &(state->strm);
+
+ /* 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_DATA_ERROR, "requested length does not fit in int");
+ return -1;
+ }
+
+ /* if len is zero, avoid unnecessary operations */
+ if (len == 0)
+ return 0;
+
+ /* process a skip request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_skip(state, state->skip) == -1)
+ return -1;
+ }
+
+ /* get len bytes to buf, or less than len if at the end */
+ got = 0;
+ do {
+ /* first just try copying data from the output buffer */
+ 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) {
+ 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_fetch(state) == -1)
+ return -1;
+ 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 */
+ }
+
+ /* large len -- read directly into user buffer */
+ else if (state->how == COPY) { /* read directly */
+ if (gz_load(state, (unsigned char *)buf, len, &n) == -1)
+ return -1;
+ }
+
+ /* large len -- decompress directly into user buffer */
+ else { /* state->how == GZIP */
+ strm->avail_out = len;
+ strm->next_out = (unsigned char *)buf;
+ if (gz_decomp(state) == -1)
+ return -1;
+ n = state->x.have;
+ state->x.have = 0;
+ }
+
+ /* update progress */
+ len -= n;
+ buf = (char *)buf + n;
+ got += n;
+ state->x.pos += n;
+ } while (len);
+
+ /* return number of bytes read into user buffer (will fit in int) */
+ return (int)got;
+}
+
+/* -- see zlib.h -- */
+#ifdef Z_PREFIX_SET
+# undef z_gzgetc
+#else
+# undef gzgetc
+#endif
+int ZEXPORT gzgetc(file)
+ gzFile file;
+{
+ int ret;
+ unsigned char buf[1];
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+
+ /* 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->x.have) {
+ state->x.have--;
+ state->x.pos++;
+ return *(state->x.next)++;
+ }
+
+ /* nothing there -- try gzread() */
+ ret = gzread(file, buf, 1);
+ 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;
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+
+ /* 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 */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_skip(state, state->skip) == -1)
+ return -1;
+ }
+
+ /* can't push EOF */
+ if (c < 0)
+ return -1;
+
+ /* if output buffer empty, put byte at end (allows more pushing) */
+ 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->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->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->x.next = dest;
+ }
+ state->x.have++;
+ state->x.next--;
+ state->x.next[0] = c;
+ state->x.pos--;
+ state->past = 0;
+ return c;
+}
+
+/* -- see zlib.h -- */
+char * ZEXPORT gzgets(file, buf, len)
+ gzFile file;
+ char *buf;
+ int len;
+{
+ unsigned left, n;
+ char *str;
+ unsigned char *eol;
+ gz_statep state;
+
+ /* check parameters and get internal structure */
+ if (file == NULL || buf == NULL || len < 1)
+ return NULL;
+ state = (gz_statep)file;
+
+ /* 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 */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_skip(state, state->skip) == -1)
+ return NULL;
+ }
+
+ /* copy output bytes up to new line or len - 1, whichever comes first --
+ append a terminating zero to the string (we don't check for a zero in
+ the contents, let the user worry about that) */
+ str = buf;
+ left = (unsigned)len - 1;
+ if (left) do {
+ /* assure that something is in the output buffer */
+ 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->x.have > left ? left : state->x.have;
+ eol = (unsigned char *)memchr(state->x.next, '\n', n);
+ if (eol != NULL)
+ n = (unsigned)(eol - state->x.next) + 1;
+
+ /* copy through end-of-line, or remainder if not found */
+ 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);
+
+ /* return terminated string, or if nothing, end of file */
+ if (buf == str)
+ return NULL;
+ buf[0] = 0;
+ return str;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzdirect(file)
+ gzFile file;
+{
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return 0;
+ state = (gz_statep)file;
+
+ /* 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->mode == GZ_READ && state->how == LOOK && state->x.have == 0)
+ (void)gz_look(state);
+
+ /* return 1 if transparent, 0 if processing a gzip stream */
+ return state->direct;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzclose_r(file)
+ gzFile file;
+{
+ int ret, err;
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return Z_STREAM_ERROR;
+ state = (gz_statep)file;
+
+ /* check that we're reading */
+ if (state->mode != GZ_READ)
+ return Z_STREAM_ERROR;
+
+ /* free memory and close file */
+ if (state->size) {
+ inflateEnd(&(state->strm));
+ 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 : err;
+}
diff --git a/compat/zlib/gzwrite.c b/compat/zlib/gzwrite.c
new file mode 100644
index 0000000..aa767fb
--- /dev/null
+++ b/compat/zlib/gzwrite.c
@@ -0,0 +1,577 @@
+/* gzwrite.c -- zlib functions for writing gzip files
+ * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "gzguts.h"
+
+/* Local functions */
+local int gz_init OF((gz_statep));
+local int gz_comp OF((gz_statep, int));
+local int gz_zero OF((gz_statep, z_off64_t));
+
+/* Initialize state for writing a gzip file. Mark initialization by setting
+ state->size to non-zero. Return -1 on failure or 0 on success. */
+local int gz_init(state)
+ gz_statep state;
+{
+ int ret;
+ z_streamp strm = &(state->strm);
+
+ /* allocate input buffer */
+ state->in = (unsigned char *)malloc(state->want);
+ if (state->in == NULL) {
+ 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 = (unsigned char *)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 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. 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;
+{
+ int ret, got;
+ unsigned have;
+ z_streamp strm = &(state->strm);
+
+ /* allocate memory if this is the first time through */
+ 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 {
+ /* write out current buffer contents if full, or if flushing, but if
+ 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->x.next);
+ if (have && ((got = write(state->fd, state->x.next, have)) < 0 ||
+ (unsigned)got != have)) {
+ gz_error(state, Z_ERRNO, zstrerror());
+ return -1;
+ }
+ if (strm->avail_out == 0) {
+ strm->avail_out = state->size;
+ strm->next_out = state->out;
+ }
+ state->x.next = strm->next_out;
+ }
+
+ /* compress */
+ have = strm->avail_out;
+ ret = deflate(strm, flush);
+ if (ret == Z_STREAM_ERROR) {
+ gz_error(state, Z_STREAM_ERROR,
+ "internal error: deflate stream corrupt");
+ return -1;
+ }
+ have -= strm->avail_out;
+ } while (have);
+
+ /* if that completed a deflate stream, allow another to start */
+ if (flush == Z_FINISH)
+ deflateReset(strm);
+
+ /* all done, no errors */
+ return 0;
+}
+
+/* Compress len zeros to output. Return -1 on error, 0 on success. */
+local int gz_zero(state, len)
+ gz_statep state;
+ z_off64_t len;
+{
+ int first;
+ unsigned n;
+ z_streamp strm = &(state->strm);
+
+ /* consume whatever's left in the input buffer */
+ if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
+ return -1;
+
+ /* compress len zeros (len guaranteed > 0) */
+ first = 1;
+ while (len) {
+ n = GT_OFF(state->size) || (z_off64_t)state->size > len ?
+ (unsigned)len : state->size;
+ if (first) {
+ memset(state->in, 0, n);
+ first = 0;
+ }
+ strm->avail_in = n;
+ strm->next_in = state->in;
+ state->x.pos += n;
+ if (gz_comp(state, Z_NO_FLUSH) == -1)
+ return -1;
+ len -= n;
+ }
+ return 0;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzwrite(file, buf, len)
+ gzFile file;
+ voidpc buf;
+ unsigned len;
+{
+ unsigned put = len;
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return 0;
+ state = (gz_statep)file;
+ strm = &(state->strm);
+
+ /* check that we're writing and that there's no error */
+ if (state->mode != GZ_WRITE || state->err != Z_OK)
+ return 0;
+
+ /* 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_DATA_ERROR, "requested length does not fit in int");
+ return 0;
+ }
+
+ /* if len is zero, avoid unnecessary operations */
+ if (len == 0)
+ return 0;
+
+ /* allocate memory if this is the first time through */
+ if (state->size == 0 && gz_init(state) == -1)
+ return 0;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return 0;
+ }
+
+ /* for small len, copy to input buffer, otherwise compress directly */
+ if (len < state->size) {
+ /* copy to input buffer, compress when full */
+ do {
+ unsigned have, copy;
+
+ if (strm->avail_in == 0)
+ strm->next_in = state->in;
+ have = (unsigned)((strm->next_in + strm->avail_in) - state->in);
+ copy = state->size - have;
+ if (copy > len)
+ copy = len;
+ memcpy(state->in + have, buf, copy);
+ strm->avail_in += copy;
+ state->x.pos += copy;
+ buf = (const char *)buf + copy;
+ len -= copy;
+ if (len && gz_comp(state, Z_NO_FLUSH) == -1)
+ return 0;
+ } while (len);
+ }
+ else {
+ /* consume whatever's left in the input buffer */
+ if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
+ return 0;
+
+ /* directly compress user buffer to file */
+ strm->avail_in = len;
+ strm->next_in = (z_const Bytef *)buf;
+ state->x.pos += len;
+ if (gz_comp(state, Z_NO_FLUSH) == -1)
+ return 0;
+ }
+
+ /* input was all buffered or compressed (put will fit in int) */
+ return (int)put;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzputc(file, c)
+ gzFile file;
+ int c;
+{
+ unsigned have;
+ unsigned char buf[1];
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ strm = &(state->strm);
+
+ /* check that we're writing and that there's no error */
+ if (state->mode != GZ_WRITE || state->err != Z_OK)
+ return -1;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return -1;
+ }
+
+ /* try writing to input buffer for speed (state->size == 0 if buffer not
+ initialized) */
+ if (state->size) {
+ if (strm->avail_in == 0)
+ strm->next_in = state->in;
+ have = (unsigned)((strm->next_in + strm->avail_in) - state->in);
+ if (have < state->size) {
+ state->in[have] = c;
+ strm->avail_in++;
+ 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 & 0xff;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzputs(file, str)
+ gzFile file;
+ const char *str;
+{
+ int ret;
+ unsigned len;
+
+ /* write string */
+ len = (unsigned)strlen(str);
+ ret = gzwrite(file, str, len);
+ return ret == 0 && len != 0 ? -1 : ret;
+}
+
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+#include <stdarg.h>
+
+/* -- see zlib.h -- */
+int ZEXPORTVA gzvprintf(gzFile file, const char *format, va_list va)
+{
+ int size, len;
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+ strm = &(state->strm);
+
+ /* check that we're writing and that there's no error */
+ if (state->mode != GZ_WRITE || state->err != Z_OK)
+ return 0;
+
+ /* make sure we have some buffer space */
+ if (state->size == 0 && gz_init(state) == -1)
+ return 0;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return 0;
+ }
+
+ /* consume whatever's left in the input buffer */
+ if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
+ return 0;
+
+ /* do the printf() into the input buffer, put length in len */
+ size = (int)(state->size);
+ state->in[size - 1] = 0;
+#ifdef NO_vsnprintf
+# ifdef HAS_vsprintf_void
+ (void)vsprintf((char *)(state->in), format, va);
+ for (len = 0; len < size; len++)
+ if (state->in[len] == 0) break;
+# else
+ len = vsprintf((char *)(state->in), format, va);
+# endif
+#else
+# ifdef HAS_vsnprintf_void
+ (void)vsnprintf((char *)(state->in), size, format, va);
+ len = strlen((char *)(state->in));
+# else
+ len = vsnprintf((char *)(state->in), size, format, va);
+# endif
+#endif
+
+ /* check that printf() results fit in buffer */
+ if (len <= 0 || len >= (int)size || state->in[size - 1] != 0)
+ return 0;
+
+ /* update buffer and position, defer compression until needed */
+ strm->avail_in = (unsigned)len;
+ strm->next_in = state->in;
+ state->x.pos += len;
+ return len;
+}
+
+int ZEXPORTVA gzprintf(gzFile file, const char *format, ...)
+{
+ va_list va;
+ int ret;
+
+ va_start(va, format);
+ ret = gzvprintf(file, format, va);
+ va_end(va);
+ return ret;
+}
+
+#else /* !STDC && !Z_HAVE_STDARG_H */
+
+/* -- see zlib.h -- */
+int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
+ a11, a12, a13, a14, a15, a16, a17, a18, a19, a20)
+ gzFile file;
+ const char *format;
+ int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
+ a11, a12, a13, a14, a15, a16, a17, a18, a19, a20;
+{
+ int size, len;
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ 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;
+
+ /* make sure we have some buffer space */
+ if (state->size == 0 && gz_init(state) == -1)
+ return 0;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return 0;
+ }
+
+ /* consume whatever's left in the input buffer */
+ if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
+ return 0;
+
+ /* do the printf() into the input buffer, put length in len */
+ size = (int)(state->size);
+ state->in[size - 1] = 0;
+#ifdef NO_snprintf
+# ifdef HAS_sprintf_void
+ 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((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((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((char *)(state->in));
+# else
+ 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
+
+ /* check that printf() results fit in buffer */
+ if (len <= 0 || len >= (int)size || state->in[size - 1] != 0)
+ return 0;
+
+ /* update buffer and position, defer compression until needed */
+ strm->avail_in = (unsigned)len;
+ strm->next_in = state->in;
+ state->x.pos += len;
+ return len;
+}
+
+#endif
+
+/* -- see zlib.h -- */
+int ZEXPORT gzflush(file, flush)
+ gzFile file;
+ int flush;
+{
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return -1;
+ state = (gz_statep)file;
+
+ /* check that we're writing and that there's no error */
+ if (state->mode != GZ_WRITE || state->err != Z_OK)
+ return Z_STREAM_ERROR;
+
+ /* check flush parameter */
+ if (flush < 0 || flush > Z_FINISH)
+ return Z_STREAM_ERROR;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return -1;
+ }
+
+ /* compress remaining data with requested flush */
+ gz_comp(state, flush);
+ return state->err;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzsetparams(file, level, strategy)
+ gzFile file;
+ int level;
+ int strategy;
+{
+ gz_statep state;
+ z_streamp strm;
+
+ /* get internal structure */
+ if (file == NULL)
+ return Z_STREAM_ERROR;
+ state = (gz_statep)file;
+ strm = &(state->strm);
+
+ /* check that we're writing and that there's no error */
+ if (state->mode != GZ_WRITE || state->err != Z_OK)
+ return Z_STREAM_ERROR;
+
+ /* if no change is requested, then do nothing */
+ if (level == state->level && strategy == state->strategy)
+ return Z_OK;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ return -1;
+ }
+
+ /* change compression parameters for subsequent input */
+ if (state->size) {
+ /* flush previous input with previous parameters before changing */
+ if (strm->avail_in && gz_comp(state, Z_PARTIAL_FLUSH) == -1)
+ return state->err;
+ deflateParams(strm, level, strategy);
+ }
+ state->level = level;
+ state->strategy = strategy;
+ return Z_OK;
+}
+
+/* -- see zlib.h -- */
+int ZEXPORT gzclose_w(file)
+ gzFile file;
+{
+ int ret = Z_OK;
+ gz_statep state;
+
+ /* get internal structure */
+ if (file == NULL)
+ return Z_STREAM_ERROR;
+ state = (gz_statep)file;
+
+ /* check that we're writing */
+ if (state->mode != GZ_WRITE)
+ return Z_STREAM_ERROR;
+
+ /* check for seek request */
+ if (state->seek) {
+ state->seek = 0;
+ if (gz_zero(state, state->skip) == -1)
+ ret = state->err;
+ }
+
+ /* flush, free memory, and close file */
+ if (gz_comp(state, Z_FINISH) == -1)
+ ret = state->err;
+ if (state->size) {
+ if (!state->direct) {
+ (void)deflateEnd(&(state->strm));
+ free(state->out);
+ }
+ free(state->in);
+ }
+ gz_error(state, Z_OK, NULL);
+ free(state->path);
+ if (close(state->fd) == -1)
+ ret = Z_ERRNO;
+ free(state);
+ return ret;
+}
diff --git a/compat/zlib/infback.c b/compat/zlib/infback.c
new file mode 100644
index 0000000..f3833c2
--- /dev/null
+++ b/compat/zlib/infback.c
@@ -0,0 +1,640 @@
+/* infback.c -- inflate using a call-back interface
+ * Copyright (C) 1995-2011 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ This code is largely copied from inflate.c. Normally either infback.o or
+ inflate.o would be linked into an application--not both. The interface
+ with inffast.c is retained so that optimized assembler-coded versions of
+ inflate_fast() can be used with either inflate.c or infback.c.
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+/* function prototypes */
+local void fixedtables OF((struct inflate_state FAR *state));
+
+/*
+ strm provides memory allocation functions in zalloc and zfree, or
+ Z_NULL to use the library memory allocation functions.
+
+ windowBits is in the range 8..15, and window is a user-supplied
+ window and output buffer that is 2**windowBits bytes.
+ */
+int ZEXPORT inflateBackInit_(strm, windowBits, window, version, stream_size)
+z_streamp strm;
+int windowBits;
+unsigned char FAR *window;
+const char *version;
+int stream_size;
+{
+ struct inflate_state FAR *state;
+
+ if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
+ stream_size != (int)(sizeof(z_stream)))
+ return Z_VERSION_ERROR;
+ if (strm == Z_NULL || window == Z_NULL ||
+ windowBits < 8 || windowBits > 15)
+ 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)
+#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;
+ Tracev((stderr, "inflate: allocated\n"));
+ strm->state = (struct internal_state FAR *)state;
+ state->dmax = 32768U;
+ state->wbits = windowBits;
+ state->wsize = 1U << windowBits;
+ state->window = window;
+ state->wnext = 0;
+ state->whave = 0;
+ return Z_OK;
+}
+
+/*
+ Return state with length and distance decoding tables and index sizes set to
+ fixed code decoding. Normally this returns fixed tables from inffixed.h.
+ If BUILDFIXED is defined, then instead this routine builds the tables the
+ first time it's called, and returns those tables the first time and
+ thereafter. This reduces the size of the code by about 2K bytes, in
+ exchange for a little execution time. However, BUILDFIXED should not be
+ used for threaded applications, since the rewriting of the tables and virgin
+ may not be thread-safe.
+ */
+local void fixedtables(state)
+struct inflate_state FAR *state;
+{
+#ifdef BUILDFIXED
+ static int virgin = 1;
+ static code *lenfix, *distfix;
+ static code fixed[544];
+
+ /* build fixed huffman tables if first call (may not be thread safe) */
+ if (virgin) {
+ unsigned sym, bits;
+ static code *next;
+
+ /* literal/length table */
+ sym = 0;
+ while (sym < 144) state->lens[sym++] = 8;
+ while (sym < 256) state->lens[sym++] = 9;
+ while (sym < 280) state->lens[sym++] = 7;
+ while (sym < 288) state->lens[sym++] = 8;
+ next = fixed;
+ lenfix = next;
+ bits = 9;
+ inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work);
+
+ /* distance table */
+ sym = 0;
+ while (sym < 32) state->lens[sym++] = 5;
+ distfix = next;
+ bits = 5;
+ inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work);
+
+ /* do this just once */
+ virgin = 0;
+ }
+#else /* !BUILDFIXED */
+# include "inffixed.h"
+#endif /* BUILDFIXED */
+ state->lencode = lenfix;
+ state->lenbits = 9;
+ state->distcode = distfix;
+ state->distbits = 5;
+}
+
+/* Macros for inflateBack(): */
+
+/* Load returned state from inflate_fast() */
+#define LOAD() \
+ do { \
+ put = strm->next_out; \
+ left = strm->avail_out; \
+ next = strm->next_in; \
+ have = strm->avail_in; \
+ hold = state->hold; \
+ bits = state->bits; \
+ } while (0)
+
+/* Set state from registers for inflate_fast() */
+#define RESTORE() \
+ do { \
+ strm->next_out = put; \
+ strm->avail_out = left; \
+ strm->next_in = next; \
+ strm->avail_in = have; \
+ state->hold = hold; \
+ state->bits = bits; \
+ } while (0)
+
+/* Clear the input bit accumulator */
+#define INITBITS() \
+ do { \
+ hold = 0; \
+ bits = 0; \
+ } while (0)
+
+/* Assure that some input is available. If input is requested, but denied,
+ then return a Z_BUF_ERROR from inflateBack(). */
+#define PULL() \
+ do { \
+ if (have == 0) { \
+ have = in(in_desc, &next); \
+ if (have == 0) { \
+ next = Z_NULL; \
+ ret = Z_BUF_ERROR; \
+ goto inf_leave; \
+ } \
+ } \
+ } while (0)
+
+/* Get a byte of input into the bit accumulator, or return from inflateBack()
+ with an error if there is no input available. */
+#define PULLBYTE() \
+ do { \
+ PULL(); \
+ have--; \
+ hold += (unsigned long)(*next++) << bits; \
+ bits += 8; \
+ } while (0)
+
+/* Assure that there are at least n bits in the bit accumulator. If there is
+ not enough available input to do that, then return from inflateBack() with
+ an error. */
+#define NEEDBITS(n) \
+ do { \
+ while (bits < (unsigned)(n)) \
+ PULLBYTE(); \
+ } while (0)
+
+/* Return the low n bits of the bit accumulator (n < 16) */
+#define BITS(n) \
+ ((unsigned)hold & ((1U << (n)) - 1))
+
+/* Remove n bits from the bit accumulator */
+#define DROPBITS(n) \
+ do { \
+ hold >>= (n); \
+ bits -= (unsigned)(n); \
+ } while (0)
+
+/* Remove zero to seven bits as needed to go to a byte boundary */
+#define BYTEBITS() \
+ do { \
+ hold >>= bits & 7; \
+ bits -= bits & 7; \
+ } while (0)
+
+/* Assure that some output space is available, by writing out the window
+ if it's full. If the write fails, return from inflateBack() with a
+ Z_BUF_ERROR. */
+#define ROOM() \
+ do { \
+ if (left == 0) { \
+ put = state->window; \
+ left = state->wsize; \
+ state->whave = left; \
+ if (out(out_desc, put, left)) { \
+ ret = Z_BUF_ERROR; \
+ goto inf_leave; \
+ } \
+ } \
+ } while (0)
+
+/*
+ strm provides the memory allocation functions and window buffer on input,
+ and provides information on the unused input on return. For Z_DATA_ERROR
+ returns, strm will also provide an error message.
+
+ in() and out() are the call-back input and output functions. When
+ inflateBack() needs more input, it calls in(). When inflateBack() has
+ filled the window with output, or when it completes with data in the
+ window, it calls out() to write out the data. The application must not
+ change the provided input until in() is called again or inflateBack()
+ returns. The application must not change the window/output buffer until
+ inflateBack() returns.
+
+ in() and out() are called with a descriptor parameter provided in the
+ inflateBack() call. This parameter can be a structure that provides the
+ information required to do the read or write, as well as accumulated
+ information on the input and output such as totals and check values.
+
+ in() should return zero on failure. out() should return non-zero on
+ failure. If either in() or out() fails, than inflateBack() returns a
+ Z_BUF_ERROR. strm->next_in can be checked for Z_NULL to see whether it
+ was in() or out() that caused in the error. Otherwise, inflateBack()
+ returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format
+ error, or Z_MEM_ERROR if it could not allocate memory for the state.
+ inflateBack() can also return Z_STREAM_ERROR if the input parameters
+ are not correct, i.e. strm is Z_NULL or the state was not initialized.
+ */
+int ZEXPORT inflateBack(strm, in, in_desc, out, out_desc)
+z_streamp strm;
+in_func in;
+void FAR *in_desc;
+out_func out;
+void FAR *out_desc;
+{
+ struct inflate_state FAR *state;
+ z_const unsigned char FAR *next; /* next input */
+ unsigned char FAR *put; /* next output */
+ unsigned have, left; /* available input and output */
+ unsigned long hold; /* bit buffer */
+ unsigned bits; /* bits in bit buffer */
+ unsigned copy; /* number of stored or match bytes to copy */
+ unsigned char FAR *from; /* where to copy match bytes from */
+ code here; /* current decoding table entry */
+ code last; /* parent table entry */
+ unsigned len; /* length to copy for repeats, bits to drop */
+ int ret; /* return code */
+ static const unsigned short order[19] = /* permutation of code lengths */
+ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
+
+ /* Check that the strm exists and that the state was initialized */
+ if (strm == Z_NULL || strm->state == Z_NULL)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* Reset the state */
+ strm->msg = Z_NULL;
+ state->mode = TYPE;
+ state->last = 0;
+ state->whave = 0;
+ next = strm->next_in;
+ have = next != Z_NULL ? strm->avail_in : 0;
+ hold = 0;
+ bits = 0;
+ put = state->window;
+ left = state->wsize;
+
+ /* Inflate until end of block marked as last */
+ for (;;)
+ switch (state->mode) {
+ case TYPE:
+ /* determine and dispatch block type */
+ if (state->last) {
+ BYTEBITS();
+ state->mode = DONE;
+ break;
+ }
+ NEEDBITS(3);
+ state->last = BITS(1);
+ DROPBITS(1);
+ switch (BITS(2)) {
+ case 0: /* stored block */
+ Tracev((stderr, "inflate: stored block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = STORED;
+ break;
+ case 1: /* fixed block */
+ fixedtables(state);
+ Tracev((stderr, "inflate: fixed codes block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = LEN; /* decode codes */
+ break;
+ case 2: /* dynamic block */
+ Tracev((stderr, "inflate: dynamic codes block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = TABLE;
+ break;
+ case 3:
+ strm->msg = (char *)"invalid block type";
+ state->mode = BAD;
+ }
+ DROPBITS(2);
+ break;
+
+ case STORED:
+ /* get and verify stored block length */
+ BYTEBITS(); /* go to byte boundary */
+ NEEDBITS(32);
+ if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
+ strm->msg = (char *)"invalid stored block lengths";
+ state->mode = BAD;
+ break;
+ }
+ state->length = (unsigned)hold & 0xffff;
+ Tracev((stderr, "inflate: stored length %u\n",
+ state->length));
+ INITBITS();
+
+ /* copy stored block from input to output */
+ while (state->length != 0) {
+ copy = state->length;
+ PULL();
+ ROOM();
+ if (copy > have) copy = have;
+ if (copy > left) copy = left;
+ zmemcpy(put, next, copy);
+ have -= copy;
+ next += copy;
+ left -= copy;
+ put += copy;
+ state->length -= copy;
+ }
+ Tracev((stderr, "inflate: stored end\n"));
+ state->mode = TYPE;
+ break;
+
+ case TABLE:
+ /* get dynamic table entries descriptor */
+ NEEDBITS(14);
+ state->nlen = BITS(5) + 257;
+ DROPBITS(5);
+ state->ndist = BITS(5) + 1;
+ DROPBITS(5);
+ state->ncode = BITS(4) + 4;
+ DROPBITS(4);
+#ifndef PKZIP_BUG_WORKAROUND
+ if (state->nlen > 286 || state->ndist > 30) {
+ strm->msg = (char *)"too many length or distance symbols";
+ state->mode = BAD;
+ break;
+ }
+#endif
+ Tracev((stderr, "inflate: table sizes ok\n"));
+
+ /* get code length code lengths (not a typo) */
+ state->have = 0;
+ while (state->have < state->ncode) {
+ NEEDBITS(3);
+ state->lens[order[state->have++]] = (unsigned short)BITS(3);
+ DROPBITS(3);
+ }
+ while (state->have < 19)
+ state->lens[order[state->have++]] = 0;
+ state->next = state->codes;
+ state->lencode = (code const FAR *)(state->next);
+ state->lenbits = 7;
+ ret = inflate_table(CODES, state->lens, 19, &(state->next),
+ &(state->lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid code lengths set";
+ state->mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: code lengths ok\n"));
+
+ /* get length and distance code code lengths */
+ state->have = 0;
+ while (state->have < state->nlen + state->ndist) {
+ for (;;) {
+ here = state->lencode[BITS(state->lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.val < 16) {
+ DROPBITS(here.bits);
+ state->lens[state->have++] = here.val;
+ }
+ else {
+ if (here.val == 16) {
+ NEEDBITS(here.bits + 2);
+ DROPBITS(here.bits);
+ if (state->have == 0) {
+ strm->msg = (char *)"invalid bit length repeat";
+ state->mode = BAD;
+ break;
+ }
+ len = (unsigned)(state->lens[state->have - 1]);
+ copy = 3 + BITS(2);
+ DROPBITS(2);
+ }
+ else if (here.val == 17) {
+ NEEDBITS(here.bits + 3);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 3 + BITS(3);
+ DROPBITS(3);
+ }
+ else {
+ NEEDBITS(here.bits + 7);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 11 + BITS(7);
+ DROPBITS(7);
+ }
+ if (state->have + copy > state->nlen + state->ndist) {
+ strm->msg = (char *)"invalid bit length repeat";
+ state->mode = BAD;
+ break;
+ }
+ while (copy--)
+ state->lens[state->have++] = (unsigned short)len;
+ }
+ }
+
+ /* handle error breaks in while */
+ if (state->mode == BAD) break;
+
+ /* check for end-of-block code (better have one) */
+ if (state->lens[256] == 0) {
+ strm->msg = (char *)"invalid code -- missing end-of-block";
+ state->mode = BAD;
+ break;
+ }
+
+ /* build code tables -- note: do not change the lenbits or distbits
+ values here (9 and 6) without reading the comments in inftrees.h
+ concerning the ENOUGH constants, which depend on those values */
+ state->next = state->codes;
+ state->lencode = (code const FAR *)(state->next);
+ state->lenbits = 9;
+ ret = inflate_table(LENS, state->lens, state->nlen, &(state->next),
+ &(state->lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid literal/lengths set";
+ state->mode = BAD;
+ break;
+ }
+ state->distcode = (code const FAR *)(state->next);
+ state->distbits = 6;
+ ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist,
+ &(state->next), &(state->distbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid distances set";
+ state->mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: codes ok\n"));
+ state->mode = LEN;
+
+ case LEN:
+ /* use inflate_fast() if we have enough input and output */
+ if (have >= 6 && left >= 258) {
+ RESTORE();
+ if (state->whave < state->wsize)
+ state->whave = state->wsize - left;
+ inflate_fast(strm, state->wsize);
+ LOAD();
+ break;
+ }
+
+ /* get a literal, length, or end-of-block code */
+ for (;;) {
+ here = state->lencode[BITS(state->lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.op && (here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = state->lencode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ }
+ DROPBITS(here.bits);
+ state->length = (unsigned)here.val;
+
+ /* process literal */
+ if (here.op == 0) {
+ Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+ "inflate: literal '%c'\n" :
+ "inflate: literal 0x%02x\n", here.val));
+ ROOM();
+ *put++ = (unsigned char)(state->length);
+ left--;
+ state->mode = LEN;
+ break;
+ }
+
+ /* process end of block */
+ if (here.op & 32) {
+ Tracevv((stderr, "inflate: end of block\n"));
+ state->mode = TYPE;
+ break;
+ }
+
+ /* invalid code */
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid literal/length code";
+ state->mode = BAD;
+ break;
+ }
+
+ /* length code -- get extra bits, if any */
+ state->extra = (unsigned)(here.op) & 15;
+ if (state->extra != 0) {
+ NEEDBITS(state->extra);
+ state->length += BITS(state->extra);
+ DROPBITS(state->extra);
+ }
+ Tracevv((stderr, "inflate: length %u\n", state->length));
+
+ /* get distance code */
+ for (;;) {
+ here = state->distcode[BITS(state->distbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if ((here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = state->distcode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ }
+ DROPBITS(here.bits);
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid distance code";
+ state->mode = BAD;
+ break;
+ }
+ state->offset = (unsigned)here.val;
+
+ /* get distance extra bits, if any */
+ state->extra = (unsigned)(here.op) & 15;
+ if (state->extra != 0) {
+ NEEDBITS(state->extra);
+ state->offset += BITS(state->extra);
+ DROPBITS(state->extra);
+ }
+ if (state->offset > state->wsize - (state->whave < state->wsize ?
+ left : 0)) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+ Tracevv((stderr, "inflate: distance %u\n", state->offset));
+
+ /* copy match from window to output */
+ do {
+ ROOM();
+ copy = state->wsize - state->offset;
+ if (copy < left) {
+ from = put + copy;
+ copy = left - copy;
+ }
+ else {
+ from = put - state->offset;
+ copy = left;
+ }
+ if (copy > state->length) copy = state->length;
+ state->length -= copy;
+ left -= copy;
+ do {
+ *put++ = *from++;
+ } while (--copy);
+ } while (state->length != 0);
+ break;
+
+ case DONE:
+ /* inflate stream terminated properly -- write leftover output */
+ ret = Z_STREAM_END;
+ if (left < state->wsize) {
+ if (out(out_desc, state->window, state->wsize - left))
+ ret = Z_BUF_ERROR;
+ }
+ goto inf_leave;
+
+ case BAD:
+ ret = Z_DATA_ERROR;
+ goto inf_leave;
+
+ default: /* can't happen, but makes compilers happy */
+ ret = Z_STREAM_ERROR;
+ goto inf_leave;
+ }
+
+ /* Return unused input */
+ inf_leave:
+ strm->next_in = next;
+ strm->avail_in = have;
+ return ret;
+}
+
+int ZEXPORT inflateBackEnd(strm)
+z_streamp strm;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+ Tracev((stderr, "inflate: end\n"));
+ return Z_OK;
+}
diff --git a/compat/zlib/inffast.c b/compat/zlib/inffast.c
new file mode 100644
index 0000000..bda59ce
--- /dev/null
+++ b/compat/zlib/inffast.c
@@ -0,0 +1,340 @@
+/* inffast.c -- fast decoding
+ * Copyright (C) 1995-2008, 2010, 2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+#ifndef ASMINF
+
+/* Allow machine dependent optimization for post-increment or pre-increment.
+ Based on testing to date,
+ Pre-increment preferred for:
+ - PowerPC G3 (Adler)
+ - MIPS R5000 (Randers-Pehrson)
+ Post-increment preferred for:
+ - none
+ No measurable difference:
+ - Pentium III (Anderson)
+ - M68060 (Nikl)
+ */
+#ifdef POSTINC
+# define OFF 0
+# define PUP(a) *(a)++
+#else
+# define OFF 1
+# define PUP(a) *++(a)
+#endif
+
+/*
+ Decode literal, length, and distance codes and write out the resulting
+ literal and match bytes until either not enough input or output is
+ available, an end-of-block is encountered, or a data error is encountered.
+ When large enough input and output buffers are supplied to inflate(), for
+ example, a 16K input buffer and a 64K output buffer, more than 95% of the
+ inflate execution time is spent in this routine.
+
+ Entry assumptions:
+
+ state->mode == LEN
+ strm->avail_in >= 6
+ strm->avail_out >= 258
+ start >= strm->avail_out
+ state->bits < 8
+
+ On return, state->mode is one of:
+
+ LEN -- ran out of enough output space or enough available input
+ TYPE -- reached end of block code, inflate() to interpret next block
+ BAD -- error in block data
+
+ Notes:
+
+ - The maximum input bits used by a length/distance pair is 15 bits for the
+ length code, 5 bits for the length extra, 15 bits for the distance code,
+ and 13 bits for the distance extra. This totals 48 bits, or six bytes.
+ Therefore if strm->avail_in >= 6, then there is enough input to avoid
+ checking for available input while decoding.
+
+ - The maximum bytes that a single length/distance pair can output is 258
+ bytes, which is the maximum length that can be coded. inflate_fast()
+ requires strm->avail_out >= 258 for each loop to avoid checking for
+ output space.
+ */
+void ZLIB_INTERNAL inflate_fast(strm, start)
+z_streamp strm;
+unsigned start; /* inflate()'s starting value for strm->avail_out */
+{
+ struct inflate_state FAR *state;
+ z_const unsigned char FAR *in; /* local strm->next_in */
+ z_const unsigned char FAR *last; /* have enough input while in < last */
+ unsigned char FAR *out; /* local strm->next_out */
+ unsigned char FAR *beg; /* inflate()'s initial strm->next_out */
+ unsigned char FAR *end; /* while out < end, enough space available */
+#ifdef INFLATE_STRICT
+ unsigned dmax; /* maximum distance from zlib header */
+#endif
+ unsigned wsize; /* window size or zero if not using window */
+ unsigned whave; /* valid bytes in the window */
+ unsigned wnext; /* window write index */
+ unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */
+ unsigned long hold; /* local strm->hold */
+ unsigned bits; /* local strm->bits */
+ code const FAR *lcode; /* local strm->lencode */
+ code const FAR *dcode; /* local strm->distcode */
+ unsigned lmask; /* mask for first level of length codes */
+ unsigned dmask; /* mask for first level of distance codes */
+ code here; /* retrieved table entry */
+ unsigned op; /* code bits, operation, extra bits, or */
+ /* window position, window bytes to copy */
+ unsigned len; /* match length, unused bytes */
+ unsigned dist; /* match distance */
+ unsigned char FAR *from; /* where to copy match from */
+
+ /* copy state to local variables */
+ state = (struct inflate_state FAR *)strm->state;
+ in = strm->next_in - OFF;
+ last = in + (strm->avail_in - 5);
+ out = strm->next_out - OFF;
+ beg = out - (start - strm->avail_out);
+ end = out + (strm->avail_out - 257);
+#ifdef INFLATE_STRICT
+ dmax = state->dmax;
+#endif
+ wsize = state->wsize;
+ whave = state->whave;
+ wnext = state->wnext;
+ window = state->window;
+ hold = state->hold;
+ bits = state->bits;
+ lcode = state->lencode;
+ dcode = state->distcode;
+ lmask = (1U << state->lenbits) - 1;
+ dmask = (1U << state->distbits) - 1;
+
+ /* decode literals and length/distances until end-of-block or not enough
+ input data or output space */
+ do {
+ if (bits < 15) {
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ }
+ here = lcode[hold & lmask];
+ dolen:
+ op = (unsigned)(here.bits);
+ hold >>= op;
+ bits -= op;
+ op = (unsigned)(here.op);
+ if (op == 0) { /* literal */
+ Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+ "inflate: literal '%c'\n" :
+ "inflate: literal 0x%02x\n", here.val));
+ PUP(out) = (unsigned char)(here.val);
+ }
+ else if (op & 16) { /* length base */
+ len = (unsigned)(here.val);
+ op &= 15; /* number of extra bits */
+ if (op) {
+ if (bits < op) {
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ }
+ len += (unsigned)hold & ((1U << op) - 1);
+ hold >>= op;
+ bits -= op;
+ }
+ Tracevv((stderr, "inflate: length %u\n", len));
+ if (bits < 15) {
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ }
+ here = dcode[hold & dmask];
+ dodist:
+ op = (unsigned)(here.bits);
+ hold >>= op;
+ bits -= op;
+ op = (unsigned)(here.op);
+ if (op & 16) { /* distance base */
+ dist = (unsigned)(here.val);
+ op &= 15; /* number of extra bits */
+ if (bits < op) {
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ if (bits < op) {
+ hold += (unsigned long)(PUP(in)) << bits;
+ bits += 8;
+ }
+ }
+ dist += (unsigned)hold & ((1U << op) - 1);
+#ifdef INFLATE_STRICT
+ if (dist > dmax) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#endif
+ hold >>= op;
+ bits -= op;
+ Tracevv((stderr, "inflate: distance %u\n", dist));
+ op = (unsigned)(out - beg); /* max distance in output */
+ if (dist > op) { /* see if copy from window */
+ op = dist - op; /* distance back in window */
+ if (op > whave) {
+ if (state->sane) {
+ strm->msg =
+ (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ if (len <= op - whave) {
+ do {
+ PUP(out) = 0;
+ } while (--len);
+ continue;
+ }
+ len -= op - whave;
+ do {
+ PUP(out) = 0;
+ } while (--op > whave);
+ if (op == 0) {
+ from = out - dist;
+ do {
+ PUP(out) = PUP(from);
+ } while (--len);
+ continue;
+ }
+#endif
+ }
+ from = window - OFF;
+ if (wnext == 0) { /* very common case */
+ from += wsize - op;
+ if (op < len) { /* some from window */
+ len -= op;
+ do {
+ PUP(out) = PUP(from);
+ } while (--op);
+ from = out - dist; /* rest from output */
+ }
+ }
+ else if (wnext < op) { /* wrap around window */
+ from += wsize + wnext - op;
+ op -= wnext;
+ if (op < len) { /* some from end of window */
+ len -= op;
+ do {
+ PUP(out) = PUP(from);
+ } while (--op);
+ from = window - OFF;
+ if (wnext < len) { /* some from start of window */
+ op = wnext;
+ len -= op;
+ do {
+ PUP(out) = PUP(from);
+ } while (--op);
+ from = out - dist; /* rest from output */
+ }
+ }
+ }
+ else { /* contiguous in window */
+ from += wnext - op;
+ if (op < len) { /* some from window */
+ len -= op;
+ do {
+ PUP(out) = PUP(from);
+ } while (--op);
+ from = out - dist; /* rest from output */
+ }
+ }
+ while (len > 2) {
+ PUP(out) = PUP(from);
+ PUP(out) = PUP(from);
+ PUP(out) = PUP(from);
+ len -= 3;
+ }
+ if (len) {
+ PUP(out) = PUP(from);
+ if (len > 1)
+ PUP(out) = PUP(from);
+ }
+ }
+ else {
+ from = out - dist; /* copy direct from output */
+ do { /* minimum length is three */
+ PUP(out) = PUP(from);
+ PUP(out) = PUP(from);
+ PUP(out) = PUP(from);
+ len -= 3;
+ } while (len > 2);
+ if (len) {
+ PUP(out) = PUP(from);
+ if (len > 1)
+ PUP(out) = PUP(from);
+ }
+ }
+ }
+ else if ((op & 64) == 0) { /* 2nd level distance code */
+ here = dcode[here.val + (hold & ((1U << op) - 1))];
+ goto dodist;
+ }
+ else {
+ strm->msg = (char *)"invalid distance code";
+ state->mode = BAD;
+ break;
+ }
+ }
+ else if ((op & 64) == 0) { /* 2nd level length code */
+ here = lcode[here.val + (hold & ((1U << op) - 1))];
+ goto dolen;
+ }
+ else if (op & 32) { /* end-of-block */
+ Tracevv((stderr, "inflate: end of block\n"));
+ state->mode = TYPE;
+ break;
+ }
+ else {
+ strm->msg = (char *)"invalid literal/length code";
+ state->mode = BAD;
+ break;
+ }
+ } while (in < last && out < end);
+
+ /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
+ len = bits >> 3;
+ in -= len;
+ bits -= len << 3;
+ hold &= (1U << bits) - 1;
+
+ /* update state and return */
+ strm->next_in = in + OFF;
+ strm->next_out = out + OFF;
+ strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last));
+ strm->avail_out = (unsigned)(out < end ?
+ 257 + (end - out) : 257 - (out - end));
+ state->hold = hold;
+ state->bits = bits;
+ return;
+}
+
+/*
+ inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe):
+ - Using bit fields for code structure
+ - Different op definition to avoid & for extra bits (do & for table bits)
+ - Three separate decoding do-loops for direct, window, and wnext == 0
+ - Special case for distance > 1 copies to do overlapped load and store copy
+ - Explicit branch predictions (based on measured branch probabilities)
+ - Deferring match copy and interspersed it with decoding subsequent codes
+ - Swapping literal/length else
+ - Swapping window/direct else
+ - Larger unrolled copy loops (three is about right)
+ - Moving len -= 3 statement into middle of loop
+ */
+
+#endif /* !ASMINF */
diff --git a/compat/zlib/inffast.h b/compat/zlib/inffast.h
new file mode 100644
index 0000000..e5c1aa4
--- /dev/null
+++ b/compat/zlib/inffast.h
@@ -0,0 +1,11 @@
+/* inffast.h -- header to use inffast.c
+ * Copyright (C) 1995-2003, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+void ZLIB_INTERNAL inflate_fast OF((z_streamp strm, unsigned start));
diff --git a/compat/zlib/inffixed.h b/compat/zlib/inffixed.h
new file mode 100644
index 0000000..d628327
--- /dev/null
+++ b/compat/zlib/inffixed.h
@@ -0,0 +1,94 @@
+ /* inffixed.h -- table for decoding fixed codes
+ * Generated automatically by makefixed().
+ */
+
+ /* 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] = {
+ {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48},
+ {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128},
+ {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59},
+ {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176},
+ {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20},
+ {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100},
+ {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8},
+ {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216},
+ {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76},
+ {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114},
+ {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},
+ {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148},
+ {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42},
+ {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86},
+ {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15},
+ {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236},
+ {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62},
+ {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142},
+ {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31},
+ {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162},
+ {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25},
+ {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105},
+ {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4},
+ {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202},
+ {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69},
+ {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125},
+ {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13},
+ {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195},
+ {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35},
+ {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91},
+ {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19},
+ {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246},
+ {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55},
+ {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135},
+ {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99},
+ {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190},
+ {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16},
+ {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96},
+ {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6},
+ {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209},
+ {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},
+ {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116},
+ {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4},
+ {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153},
+ {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44},
+ {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82},
+ {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11},
+ {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229},
+ {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58},
+ {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138},
+ {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51},
+ {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173},
+ {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30},
+ {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110},
+ {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0},
+ {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195},
+ {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65},
+ {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121},
+ {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},
+ {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258},
+ {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37},
+ {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93},
+ {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23},
+ {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251},
+ {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51},
+ {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131},
+ {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67},
+ {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183},
+ {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23},
+ {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103},
+ {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9},
+ {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223},
+ {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79},
+ {0,9,255}
+ };
+
+ static const code distfix[32] = {
+ {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025},
+ {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193},
+ {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385},
+ {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577},
+ {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073},
+ {22,5,193},{64,5,0}
+ };
diff --git a/compat/zlib/inflate.c b/compat/zlib/inflate.c
new file mode 100644
index 0000000..870f89b
--- /dev/null
+++ b/compat/zlib/inflate.c
@@ -0,0 +1,1512 @@
+/* inflate.c -- zlib decompression
+ * Copyright (C) 1995-2012 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * Change history:
+ *
+ * 1.2.beta0 24 Nov 2002
+ * - First version -- complete rewrite of inflate to simplify code, avoid
+ * creation of window when not needed, minimize use of window when it is
+ * needed, make inffast.c even faster, implement gzip decoding, and to
+ * improve code readability and style over the previous zlib inflate code
+ *
+ * 1.2.beta1 25 Nov 2002
+ * - Use pointers for available input and output checking in inffast.c
+ * - Remove input and output counters in inffast.c
+ * - Change inffast.c entry and loop from avail_in >= 7 to >= 6
+ * - Remove unnecessary second byte pull from length extra in inffast.c
+ * - Unroll direct copy to three copies per loop in inffast.c
+ *
+ * 1.2.beta2 4 Dec 2002
+ * - Change external routine names to reduce potential conflicts
+ * - Correct filename to inffixed.h for fixed tables in inflate.c
+ * - Make hbuf[] unsigned char to match parameter type in inflate.c
+ * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset)
+ * to avoid negation problem on Alphas (64 bit) in inflate.c
+ *
+ * 1.2.beta3 22 Dec 2002
+ * - Add comments on state->bits assertion in inffast.c
+ * - Add comments on op field in inftrees.h
+ * - Fix bug in reuse of allocated window after inflateReset()
+ * - Remove bit fields--back to byte structure for speed
+ * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths
+ * - Change post-increments to pre-increments in inflate_fast(), PPC biased?
+ * - Add compile time option, POSTINC, to use post-increments instead (Intel?)
+ * - Make MATCH copy in inflate() much faster for when inflate_fast() not used
+ * - Use local copies of stream next and avail values, as well as local bit
+ * buffer and bit count in inflate()--for speed when inflate_fast() not used
+ *
+ * 1.2.beta4 1 Jan 2003
+ * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings
+ * - Move a comment on output buffer sizes from inffast.c to inflate.c
+ * - Add comments in inffast.c to introduce the inflate_fast() routine
+ * - Rearrange window copies in inflate_fast() for speed and simplification
+ * - Unroll last copy for window match in inflate_fast()
+ * - Use local copies of window variables in inflate_fast() for speed
+ * - Pull out common wnext == 0 case for speed in inflate_fast()
+ * - Make op and len in inflate_fast() unsigned for consistency
+ * - Add FAR to lcode and dcode declarations in inflate_fast()
+ * - Simplified bad distance check in inflate_fast()
+ * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new
+ * source file infback.c to provide a call-back interface to inflate for
+ * programs like gzip and unzip -- uses window as output buffer to avoid
+ * window copying
+ *
+ * 1.2.beta5 1 Jan 2003
+ * - Improved inflateBack() interface to allow the caller to provide initial
+ * input in strm.
+ * - Fixed stored blocks bug in inflateBack()
+ *
+ * 1.2.beta6 4 Jan 2003
+ * - Added comments in inffast.c on effectiveness of POSTINC
+ * - Typecasting all around to reduce compiler warnings
+ * - Changed loops from while (1) or do {} while (1) to for (;;), again to
+ * make compilers happy
+ * - Changed type of window in inflateBackInit() to unsigned char *
+ *
+ * 1.2.beta7 27 Jan 2003
+ * - Changed many types to unsigned or unsigned short to avoid warnings
+ * - Added inflateCopy() function
+ *
+ * 1.2.0 9 Mar 2003
+ * - Changed inflateBack() interface to provide separate opaque descriptors
+ * for the in() and out() functions
+ * - Changed inflateBack() argument and in_func typedef to swap the length
+ * and buffer address return values for the input function
+ * - Check next_in and next_out for Z_NULL on entry to inflate()
+ *
+ * The history for versions after 1.2.0 are in ChangeLog in zlib distribution.
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+#ifdef MAKEFIXED
+# ifndef BUILDFIXED
+# define BUILDFIXED
+# endif
+#endif
+
+/* function prototypes */
+local void fixedtables OF((struct inflate_state FAR *state));
+local int updatewindow OF((z_streamp strm, const unsigned char FAR *end,
+ unsigned copy));
+#ifdef BUILDFIXED
+ void makefixed OF((void));
+#endif
+local unsigned syncsearch OF((unsigned FAR *have, const unsigned char FAR *buf,
+ unsigned len));
+
+int ZEXPORT inflateResetKeep(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;
+ strm->total_in = strm->total_out = state->total = 0;
+ strm->msg = Z_NULL;
+ 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->hold = 0;
+ state->bits = 0;
+ state->lencode = state->distcode = state->next = state->codes;
+ state->sane = 1;
+ state->back = -1;
+ Tracev((stderr, "inflate: reset\n"));
+ 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;
+{
+ int wrap;
+ struct inflate_state FAR *state;
+
+ /* get the state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* extract wrap request from windowBits parameter */
+ if (windowBits < 0) {
+ wrap = 0;
+ windowBits = -windowBits;
+ }
+ else {
+ wrap = (windowBits >> 4) + 1;
+#ifdef GUNZIP
+ if (windowBits < 48)
+ windowBits &= 15;
+#endif
+ }
+
+ /* set number of window bits, free window if different */
+ if (windowBits && (windowBits < 8 || windowBits > 15))
+ return Z_STREAM_ERROR;
+ if (state->window != Z_NULL && state->wbits != (unsigned)windowBits) {
+ ZFREE(strm, state->window);
+ state->window = Z_NULL;
+ }
+
+ /* update state and reset the rest of it */
+ state->wrap = wrap;
+ state->wbits = (unsigned)windowBits;
+ return inflateReset(strm);
+}
+
+int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size)
+z_streamp strm;
+int windowBits;
+const char *version;
+int stream_size;
+{
+ int ret;
+ struct inflate_state FAR *state;
+
+ if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
+ stream_size != (int)(sizeof(z_stream)))
+ return Z_VERSION_ERROR;
+ 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)
+#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;
+ Tracev((stderr, "inflate: allocated\n"));
+ strm->state = (struct internal_state FAR *)state;
+ state->window = Z_NULL;
+ ret = inflateReset2(strm, windowBits);
+ if (ret != Z_OK) {
+ ZFREE(strm, state);
+ strm->state = Z_NULL;
+ }
+ return ret;
+}
+
+int ZEXPORT inflateInit_(strm, version, stream_size)
+z_streamp strm;
+const char *version;
+int stream_size;
+{
+ return inflateInit2_(strm, DEF_WBITS, version, stream_size);
+}
+
+int ZEXPORT inflatePrime(strm, bits, value)
+z_streamp strm;
+int bits;
+int value;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (bits < 0) {
+ state->hold = 0;
+ state->bits = 0;
+ return Z_OK;
+ }
+ if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR;
+ value &= (1L << bits) - 1;
+ state->hold += value << state->bits;
+ state->bits += bits;
+ return Z_OK;
+}
+
+/*
+ Return state with length and distance decoding tables and index sizes set to
+ fixed code decoding. Normally this returns fixed tables from inffixed.h.
+ If BUILDFIXED is defined, then instead this routine builds the tables the
+ first time it's called, and returns those tables the first time and
+ thereafter. This reduces the size of the code by about 2K bytes, in
+ exchange for a little execution time. However, BUILDFIXED should not be
+ used for threaded applications, since the rewriting of the tables and virgin
+ may not be thread-safe.
+ */
+local void fixedtables(state)
+struct inflate_state FAR *state;
+{
+#ifdef BUILDFIXED
+ static int virgin = 1;
+ static code *lenfix, *distfix;
+ static code fixed[544];
+
+ /* build fixed huffman tables if first call (may not be thread safe) */
+ if (virgin) {
+ unsigned sym, bits;
+ static code *next;
+
+ /* literal/length table */
+ sym = 0;
+ while (sym < 144) state->lens[sym++] = 8;
+ while (sym < 256) state->lens[sym++] = 9;
+ while (sym < 280) state->lens[sym++] = 7;
+ while (sym < 288) state->lens[sym++] = 8;
+ next = fixed;
+ lenfix = next;
+ bits = 9;
+ inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work);
+
+ /* distance table */
+ sym = 0;
+ while (sym < 32) state->lens[sym++] = 5;
+ distfix = next;
+ bits = 5;
+ inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work);
+
+ /* do this just once */
+ virgin = 0;
+ }
+#else /* !BUILDFIXED */
+# include "inffixed.h"
+#endif /* BUILDFIXED */
+ state->lencode = lenfix;
+ state->lenbits = 9;
+ state->distcode = distfix;
+ state->distbits = 5;
+}
+
+#ifdef MAKEFIXED
+#include <stdio.h>
+
+/*
+ Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also
+ defines BUILDFIXED, so the tables are built on the fly. makefixed() writes
+ those tables to stdout, which would be piped to inffixed.h. A small program
+ can simply call makefixed to do this:
+
+ void makefixed(void);
+
+ int main(void)
+ {
+ makefixed();
+ return 0;
+ }
+
+ Then that can be linked with zlib built with MAKEFIXED defined and run:
+
+ a.out > inffixed.h
+ */
+void makefixed()
+{
+ unsigned low, size;
+ struct inflate_state state;
+
+ fixedtables(&state);
+ puts(" /* inffixed.h -- table for decoding fixed codes");
+ puts(" * Generated automatically by makefixed().");
+ puts(" */");
+ puts("");
+ puts(" /* WARNING: this file should *not* be used by applications.");
+ puts(" It is part of the implementation of this library and is");
+ puts(" subject to change. Applications should only use zlib.h.");
+ puts(" */");
+ puts("");
+ size = 1U << 9;
+ printf(" static const code lenfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 7) == 0) printf("\n ");
+ 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(',');
+ }
+ puts("\n };");
+ size = 1U << 5;
+ printf("\n static const code distfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 6) == 0) printf("\n ");
+ printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits,
+ state.distcode[low].val);
+ if (++low == size) break;
+ putchar(',');
+ }
+ puts("\n };");
+}
+#endif /* MAKEFIXED */
+
+/*
+ Update the window with the last wsize (normally 32K) bytes written before
+ returning. If window does not exist yet, create it. This is only called
+ when a window is already in use, or when output has been written during this
+ inflate call, but the end of the deflate stream has not been reached yet.
+ It is also called to create a window for dictionary data when a dictionary
+ is loaded.
+
+ Providing output buffers larger than 32K to inflate() should provide a speed
+ advantage, since only the last 32K of output is copied to the sliding window
+ upon return from inflate(), and since all distances after the first 32K of
+ output will fall in the output data, making match copies simpler and faster.
+ The advantage may be dependent on the size of the processor's data caches.
+ */
+local int updatewindow(strm, end, copy)
+z_streamp strm;
+const Bytef *end;
+unsigned copy;
+{
+ struct inflate_state FAR *state;
+ unsigned dist;
+
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* if it hasn't been done already, allocate space for the window */
+ if (state->window == Z_NULL) {
+ state->window = (unsigned char FAR *)
+ ZALLOC(strm, 1U << state->wbits,
+ sizeof(unsigned char));
+ if (state->window == Z_NULL) return 1;
+ }
+
+ /* if window not in use yet, initialize */
+ if (state->wsize == 0) {
+ state->wsize = 1U << state->wbits;
+ state->wnext = 0;
+ state->whave = 0;
+ }
+
+ /* copy state->wsize or less output bytes into the circular window */
+ if (copy >= state->wsize) {
+ zmemcpy(state->window, end - state->wsize, state->wsize);
+ state->wnext = 0;
+ state->whave = state->wsize;
+ }
+ else {
+ dist = state->wsize - state->wnext;
+ if (dist > copy) dist = copy;
+ zmemcpy(state->window + state->wnext, end - copy, dist);
+ copy -= dist;
+ if (copy) {
+ zmemcpy(state->window, end - copy, copy);
+ state->wnext = copy;
+ state->whave = state->wsize;
+ }
+ else {
+ state->wnext += dist;
+ if (state->wnext == state->wsize) state->wnext = 0;
+ if (state->whave < state->wsize) state->whave += dist;
+ }
+ }
+ return 0;
+}
+
+/* Macros for inflate(): */
+
+/* check function to use adler32() for zlib or crc32() for gzip */
+#ifdef GUNZIP
+# define UPDATE(check, buf, len) \
+ (state->flags ? crc32(check, buf, len) : adler32(check, buf, len))
+#else
+# define UPDATE(check, buf, len) adler32(check, buf, len)
+#endif
+
+/* check macros for header crc */
+#ifdef GUNZIP
+# define CRC2(check, word) \
+ do { \
+ hbuf[0] = (unsigned char)(word); \
+ hbuf[1] = (unsigned char)((word) >> 8); \
+ check = crc32(check, hbuf, 2); \
+ } while (0)
+
+# define CRC4(check, word) \
+ do { \
+ hbuf[0] = (unsigned char)(word); \
+ hbuf[1] = (unsigned char)((word) >> 8); \
+ hbuf[2] = (unsigned char)((word) >> 16); \
+ hbuf[3] = (unsigned char)((word) >> 24); \
+ check = crc32(check, hbuf, 4); \
+ } while (0)
+#endif
+
+/* Load registers with state in inflate() for speed */
+#define LOAD() \
+ do { \
+ put = strm->next_out; \
+ left = strm->avail_out; \
+ next = strm->next_in; \
+ have = strm->avail_in; \
+ hold = state->hold; \
+ bits = state->bits; \
+ } while (0)
+
+/* Restore state from registers in inflate() */
+#define RESTORE() \
+ do { \
+ strm->next_out = put; \
+ strm->avail_out = left; \
+ strm->next_in = next; \
+ strm->avail_in = have; \
+ state->hold = hold; \
+ state->bits = bits; \
+ } while (0)
+
+/* Clear the input bit accumulator */
+#define INITBITS() \
+ do { \
+ hold = 0; \
+ bits = 0; \
+ } while (0)
+
+/* Get a byte of input into the bit accumulator, or return from inflate()
+ if there is no input available. */
+#define PULLBYTE() \
+ do { \
+ if (have == 0) goto inf_leave; \
+ have--; \
+ hold += (unsigned long)(*next++) << bits; \
+ bits += 8; \
+ } while (0)
+
+/* Assure that there are at least n bits in the bit accumulator. If there is
+ not enough available input to do that, then return from inflate(). */
+#define NEEDBITS(n) \
+ do { \
+ while (bits < (unsigned)(n)) \
+ PULLBYTE(); \
+ } while (0)
+
+/* Return the low n bits of the bit accumulator (n < 16) */
+#define BITS(n) \
+ ((unsigned)hold & ((1U << (n)) - 1))
+
+/* Remove n bits from the bit accumulator */
+#define DROPBITS(n) \
+ do { \
+ hold >>= (n); \
+ bits -= (unsigned)(n); \
+ } while (0)
+
+/* Remove zero to seven bits as needed to go to a byte boundary */
+#define BYTEBITS() \
+ do { \
+ hold >>= bits & 7; \
+ bits -= bits & 7; \
+ } while (0)
+
+/*
+ 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
+ structured roughly as follows:
+
+ for (;;) switch (state) {
+ ...
+ case STATEn:
+ if (not enough input data or output space to make progress)
+ return;
+ ... make progress ...
+ state = STATEm;
+ break;
+ ...
+ }
+
+ so when inflate() is called again, the same case is attempted again, and
+ if the appropriate resources are provided, the machine proceeds to the
+ next state. The NEEDBITS() macro is usually the way the state evaluates
+ whether it can proceed or should return. NEEDBITS() does the return if
+ the requested bits are not available. The typical use of the BITS macros
+ is:
+
+ NEEDBITS(n);
+ ... do something with BITS(n) ...
+ DROPBITS(n);
+
+ where NEEDBITS(n) either returns from inflate() if there isn't enough
+ input left to load n bits into the accumulator, or it continues. BITS(n)
+ gives the low n bits in the accumulator. When done, DROPBITS(n) drops
+ the low n bits off the accumulator. INITBITS() clears the accumulator
+ and sets the number of available bits to zero. BYTEBITS() discards just
+ enough bits to put the accumulator on a byte boundary. After BYTEBITS()
+ and a NEEDBITS(8), then BITS(8) would return the next byte in the stream.
+
+ NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return
+ if there is no input available. The decoding of variable length codes uses
+ PULLBYTE() directly in order to pull just enough bytes to decode the next
+ code, and no more.
+
+ Some states loop until they get enough input, making sure that enough
+ state information is maintained to continue the loop where it left off
+ if NEEDBITS() returns in the loop. For example, want, need, and keep
+ would all have to actually be part of the saved state in case NEEDBITS()
+ returns:
+
+ case STATEw:
+ while (want < need) {
+ NEEDBITS(n);
+ keep[want++] = BITS(n);
+ DROPBITS(n);
+ }
+ state = STATEx;
+ case STATEx:
+
+ As shown above, if the next state is also the next case, then the break
+ is omitted.
+
+ A state may also return if there is not enough output space available to
+ complete that state. Those states are copying stored data, writing a
+ literal byte, and copying a matching string.
+
+ When returning, a "goto inf_leave" is used to update the total counters,
+ update the check value, and determine whether any progress has been made
+ during that inflate() call in order to return the proper return code.
+ Progress is defined as a change in either strm->avail_in or strm->avail_out.
+ When there is a window, goto inf_leave will update the window with the last
+ output written. If a goto inf_leave occurs in the middle of decompression
+ and there is no window currently, goto inf_leave will create one and copy
+ output to the window for the next call of inflate().
+
+ In this implementation, the flush parameter of inflate() only affects the
+ return code (per zlib.h). inflate() always writes as much as possible to
+ strm->next_out, given the space available and the provided input--the effect
+ documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers
+ the allocation of and copying into a sliding window until necessary, which
+ provides the effect documented in zlib.h for Z_FINISH when the entire input
+ stream available. So the only thing the flush parameter actually does is:
+ when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it
+ will return Z_BUF_ERROR if it has not reached the end of the stream.
+ */
+
+int ZEXPORT inflate(strm, flush)
+z_streamp strm;
+int flush;
+{
+ struct inflate_state FAR *state;
+ z_const unsigned char FAR *next; /* next input */
+ unsigned char FAR *put; /* next output */
+ unsigned have, left; /* available input and output */
+ unsigned long hold; /* bit buffer */
+ unsigned bits; /* bits in bit buffer */
+ unsigned in, out; /* save starting available input and output */
+ unsigned copy; /* number of stored or match bytes to copy */
+ unsigned char FAR *from; /* where to copy match bytes from */
+ code here; /* current decoding table entry */
+ code last; /* parent table entry */
+ unsigned len; /* length to copy for repeats, bits to drop */
+ int ret; /* return code */
+#ifdef GUNZIP
+ unsigned char hbuf[4]; /* buffer for gzip header crc calculation */
+#endif
+ static const unsigned short order[19] = /* permutation of code lengths */
+ {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
+
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL ||
+ (strm->next_in == Z_NULL && strm->avail_in != 0))
+ return Z_STREAM_ERROR;
+
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */
+ LOAD();
+ in = have;
+ out = left;
+ ret = Z_OK;
+ for (;;)
+ switch (state->mode) {
+ case HEAD:
+ if (state->wrap == 0) {
+ state->mode = TYPEDO;
+ break;
+ }
+ NEEDBITS(16);
+#ifdef GUNZIP
+ if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */
+ state->check = crc32(0L, Z_NULL, 0);
+ CRC2(state->check, hold);
+ INITBITS();
+ state->mode = FLAGS;
+ break;
+ }
+ state->flags = 0; /* expect zlib header */
+ if (state->head != Z_NULL)
+ state->head->done = -1;
+ if (!(state->wrap & 1) || /* check if zlib header allowed */
+#else
+ if (
+#endif
+ ((BITS(8) << 8) + (hold >> 8)) % 31) {
+ strm->msg = (char *)"incorrect header check";
+ state->mode = BAD;
+ break;
+ }
+ if (BITS(4) != Z_DEFLATED) {
+ strm->msg = (char *)"unknown compression method";
+ state->mode = BAD;
+ break;
+ }
+ DROPBITS(4);
+ len = BITS(4) + 8;
+ if (state->wbits == 0)
+ state->wbits = len;
+ else if (len > state->wbits) {
+ strm->msg = (char *)"invalid window size";
+ state->mode = BAD;
+ break;
+ }
+ state->dmax = 1U << len;
+ Tracev((stderr, "inflate: zlib header ok\n"));
+ strm->adler = state->check = adler32(0L, Z_NULL, 0);
+ state->mode = hold & 0x200 ? DICTID : TYPE;
+ INITBITS();
+ break;
+#ifdef GUNZIP
+ case FLAGS:
+ NEEDBITS(16);
+ state->flags = (int)(hold);
+ if ((state->flags & 0xff) != Z_DEFLATED) {
+ strm->msg = (char *)"unknown compression method";
+ state->mode = BAD;
+ break;
+ }
+ if (state->flags & 0xe000) {
+ strm->msg = (char *)"unknown header flags set";
+ state->mode = BAD;
+ break;
+ }
+ if (state->head != Z_NULL)
+ state->head->text = (int)((hold >> 8) & 1);
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ state->mode = TIME;
+ case TIME:
+ NEEDBITS(32);
+ if (state->head != Z_NULL)
+ state->head->time = hold;
+ if (state->flags & 0x0200) CRC4(state->check, hold);
+ INITBITS();
+ state->mode = OS;
+ case OS:
+ NEEDBITS(16);
+ if (state->head != Z_NULL) {
+ state->head->xflags = (int)(hold & 0xff);
+ state->head->os = (int)(hold >> 8);
+ }
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ state->mode = EXLEN;
+ case EXLEN:
+ if (state->flags & 0x0400) {
+ NEEDBITS(16);
+ state->length = (unsigned)(hold);
+ if (state->head != Z_NULL)
+ state->head->extra_len = (unsigned)hold;
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ }
+ else if (state->head != Z_NULL)
+ state->head->extra = Z_NULL;
+ state->mode = EXTRA;
+ case EXTRA:
+ if (state->flags & 0x0400) {
+ copy = state->length;
+ if (copy > have) copy = have;
+ if (copy) {
+ if (state->head != Z_NULL &&
+ state->head->extra != Z_NULL) {
+ len = state->head->extra_len - state->length;
+ zmemcpy(state->head->extra + len, next,
+ len + copy > state->head->extra_max ?
+ state->head->extra_max - len : copy);
+ }
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ state->length -= copy;
+ }
+ if (state->length) goto inf_leave;
+ }
+ state->length = 0;
+ state->mode = NAME;
+ case NAME:
+ if (state->flags & 0x0800) {
+ if (have == 0) goto inf_leave;
+ copy = 0;
+ do {
+ len = (unsigned)(next[copy++]);
+ if (state->head != Z_NULL &&
+ state->head->name != Z_NULL &&
+ state->length < state->head->name_max)
+ state->head->name[state->length++] = len;
+ } while (len && copy < have);
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ if (len) goto inf_leave;
+ }
+ else if (state->head != Z_NULL)
+ state->head->name = Z_NULL;
+ state->length = 0;
+ state->mode = COMMENT;
+ case COMMENT:
+ if (state->flags & 0x1000) {
+ if (have == 0) goto inf_leave;
+ copy = 0;
+ do {
+ len = (unsigned)(next[copy++]);
+ if (state->head != Z_NULL &&
+ state->head->comment != Z_NULL &&
+ state->length < state->head->comm_max)
+ state->head->comment[state->length++] = len;
+ } while (len && copy < have);
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ if (len) goto inf_leave;
+ }
+ else if (state->head != Z_NULL)
+ state->head->comment = Z_NULL;
+ state->mode = HCRC;
+ case HCRC:
+ if (state->flags & 0x0200) {
+ NEEDBITS(16);
+ if (hold != (state->check & 0xffff)) {
+ strm->msg = (char *)"header crc mismatch";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ }
+ if (state->head != Z_NULL) {
+ state->head->hcrc = (int)((state->flags >> 9) & 1);
+ state->head->done = 1;
+ }
+ strm->adler = state->check = crc32(0L, Z_NULL, 0);
+ state->mode = TYPE;
+ break;
+#endif
+ case DICTID:
+ NEEDBITS(32);
+ strm->adler = state->check = ZSWAP32(hold);
+ INITBITS();
+ state->mode = DICT;
+ case DICT:
+ if (state->havedict == 0) {
+ RESTORE();
+ return Z_NEED_DICT;
+ }
+ strm->adler = state->check = adler32(0L, Z_NULL, 0);
+ state->mode = TYPE;
+ case TYPE:
+ if (flush == Z_BLOCK || flush == Z_TREES) goto inf_leave;
+ case TYPEDO:
+ if (state->last) {
+ BYTEBITS();
+ state->mode = CHECK;
+ break;
+ }
+ NEEDBITS(3);
+ state->last = BITS(1);
+ DROPBITS(1);
+ switch (BITS(2)) {
+ case 0: /* stored block */
+ Tracev((stderr, "inflate: stored block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = STORED;
+ break;
+ case 1: /* fixed block */
+ fixedtables(state);
+ Tracev((stderr, "inflate: fixed codes block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = LEN_; /* decode codes */
+ if (flush == Z_TREES) {
+ DROPBITS(2);
+ goto inf_leave;
+ }
+ break;
+ case 2: /* dynamic block */
+ Tracev((stderr, "inflate: dynamic codes block%s\n",
+ state->last ? " (last)" : ""));
+ state->mode = TABLE;
+ break;
+ case 3:
+ strm->msg = (char *)"invalid block type";
+ state->mode = BAD;
+ }
+ DROPBITS(2);
+ break;
+ case STORED:
+ BYTEBITS(); /* go to byte boundary */
+ NEEDBITS(32);
+ if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
+ strm->msg = (char *)"invalid stored block lengths";
+ state->mode = BAD;
+ break;
+ }
+ state->length = (unsigned)hold & 0xffff;
+ Tracev((stderr, "inflate: stored length %u\n",
+ state->length));
+ INITBITS();
+ state->mode = COPY_;
+ if (flush == Z_TREES) goto inf_leave;
+ case COPY_:
+ state->mode = COPY;
+ case COPY:
+ copy = state->length;
+ if (copy) {
+ if (copy > have) copy = have;
+ if (copy > left) copy = left;
+ if (copy == 0) goto inf_leave;
+ zmemcpy(put, next, copy);
+ have -= copy;
+ next += copy;
+ left -= copy;
+ put += copy;
+ state->length -= copy;
+ break;
+ }
+ Tracev((stderr, "inflate: stored end\n"));
+ state->mode = TYPE;
+ break;
+ case TABLE:
+ NEEDBITS(14);
+ state->nlen = BITS(5) + 257;
+ DROPBITS(5);
+ state->ndist = BITS(5) + 1;
+ DROPBITS(5);
+ state->ncode = BITS(4) + 4;
+ DROPBITS(4);
+#ifndef PKZIP_BUG_WORKAROUND
+ if (state->nlen > 286 || state->ndist > 30) {
+ strm->msg = (char *)"too many length or distance symbols";
+ state->mode = BAD;
+ break;
+ }
+#endif
+ Tracev((stderr, "inflate: table sizes ok\n"));
+ state->have = 0;
+ state->mode = LENLENS;
+ case LENLENS:
+ while (state->have < state->ncode) {
+ NEEDBITS(3);
+ state->lens[order[state->have++]] = (unsigned short)BITS(3);
+ DROPBITS(3);
+ }
+ while (state->have < 19)
+ state->lens[order[state->have++]] = 0;
+ state->next = state->codes;
+ state->lencode = (const code FAR *)(state->next);
+ state->lenbits = 7;
+ ret = inflate_table(CODES, state->lens, 19, &(state->next),
+ &(state->lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid code lengths set";
+ state->mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: code lengths ok\n"));
+ state->have = 0;
+ state->mode = CODELENS;
+ case CODELENS:
+ while (state->have < state->nlen + state->ndist) {
+ for (;;) {
+ here = state->lencode[BITS(state->lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.val < 16) {
+ DROPBITS(here.bits);
+ state->lens[state->have++] = here.val;
+ }
+ else {
+ if (here.val == 16) {
+ NEEDBITS(here.bits + 2);
+ DROPBITS(here.bits);
+ if (state->have == 0) {
+ strm->msg = (char *)"invalid bit length repeat";
+ state->mode = BAD;
+ break;
+ }
+ len = state->lens[state->have - 1];
+ copy = 3 + BITS(2);
+ DROPBITS(2);
+ }
+ else if (here.val == 17) {
+ NEEDBITS(here.bits + 3);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 3 + BITS(3);
+ DROPBITS(3);
+ }
+ else {
+ NEEDBITS(here.bits + 7);
+ DROPBITS(here.bits);
+ len = 0;
+ copy = 11 + BITS(7);
+ DROPBITS(7);
+ }
+ if (state->have + copy > state->nlen + state->ndist) {
+ strm->msg = (char *)"invalid bit length repeat";
+ state->mode = BAD;
+ break;
+ }
+ while (copy--)
+ state->lens[state->have++] = (unsigned short)len;
+ }
+ }
+
+ /* handle error breaks in while */
+ if (state->mode == BAD) break;
+
+ /* check for end-of-block code (better have one) */
+ if (state->lens[256] == 0) {
+ strm->msg = (char *)"invalid code -- missing end-of-block";
+ state->mode = BAD;
+ break;
+ }
+
+ /* build code tables -- note: do not change the lenbits or distbits
+ values here (9 and 6) without reading the comments in inftrees.h
+ concerning the ENOUGH constants, which depend on those values */
+ state->next = state->codes;
+ state->lencode = (const code FAR *)(state->next);
+ state->lenbits = 9;
+ ret = inflate_table(LENS, state->lens, state->nlen, &(state->next),
+ &(state->lenbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid literal/lengths set";
+ state->mode = BAD;
+ break;
+ }
+ state->distcode = (const code FAR *)(state->next);
+ state->distbits = 6;
+ ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist,
+ &(state->next), &(state->distbits), state->work);
+ if (ret) {
+ strm->msg = (char *)"invalid distances set";
+ state->mode = BAD;
+ break;
+ }
+ Tracev((stderr, "inflate: codes ok\n"));
+ state->mode = LEN_;
+ if (flush == Z_TREES) goto inf_leave;
+ case LEN_:
+ state->mode = LEN;
+ case LEN:
+ if (have >= 6 && left >= 258) {
+ RESTORE();
+ inflate_fast(strm, out);
+ LOAD();
+ if (state->mode == TYPE)
+ state->back = -1;
+ break;
+ }
+ state->back = 0;
+ for (;;) {
+ here = state->lencode[BITS(state->lenbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if (here.op && (here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = state->lencode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ state->back += last.bits;
+ }
+ DROPBITS(here.bits);
+ state->back += here.bits;
+ state->length = (unsigned)here.val;
+ if ((int)(here.op) == 0) {
+ Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+ "inflate: literal '%c'\n" :
+ "inflate: literal 0x%02x\n", here.val));
+ state->mode = LIT;
+ break;
+ }
+ if (here.op & 32) {
+ Tracevv((stderr, "inflate: end of block\n"));
+ state->back = -1;
+ state->mode = TYPE;
+ break;
+ }
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid literal/length code";
+ state->mode = BAD;
+ break;
+ }
+ state->extra = (unsigned)(here.op) & 15;
+ state->mode = LENEXT;
+ case LENEXT:
+ if (state->extra) {
+ NEEDBITS(state->extra);
+ state->length += BITS(state->extra);
+ DROPBITS(state->extra);
+ state->back += state->extra;
+ }
+ Tracevv((stderr, "inflate: length %u\n", state->length));
+ state->was = state->length;
+ state->mode = DIST;
+ case DIST:
+ for (;;) {
+ here = state->distcode[BITS(state->distbits)];
+ if ((unsigned)(here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ if ((here.op & 0xf0) == 0) {
+ last = here;
+ for (;;) {
+ here = state->distcode[last.val +
+ (BITS(last.bits + last.op) >> last.bits)];
+ if ((unsigned)(last.bits + here.bits) <= bits) break;
+ PULLBYTE();
+ }
+ DROPBITS(last.bits);
+ state->back += last.bits;
+ }
+ DROPBITS(here.bits);
+ state->back += here.bits;
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid distance code";
+ state->mode = BAD;
+ break;
+ }
+ state->offset = (unsigned)here.val;
+ state->extra = (unsigned)(here.op) & 15;
+ state->mode = DISTEXT;
+ case DISTEXT:
+ if (state->extra) {
+ NEEDBITS(state->extra);
+ state->offset += BITS(state->extra);
+ DROPBITS(state->extra);
+ state->back += state->extra;
+ }
+#ifdef INFLATE_STRICT
+ if (state->offset > state->dmax) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#endif
+ Tracevv((stderr, "inflate: distance %u\n", state->offset));
+ state->mode = MATCH;
+ case MATCH:
+ if (left == 0) goto inf_leave;
+ copy = out - left;
+ if (state->offset > copy) { /* copy from window */
+ copy = state->offset - copy;
+ if (copy > state->whave) {
+ if (state->sane) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ Trace((stderr, "inflate.c too far\n"));
+ copy -= state->whave;
+ if (copy > state->length) copy = state->length;
+ if (copy > left) copy = left;
+ left -= copy;
+ state->length -= copy;
+ do {
+ *put++ = 0;
+ } while (--copy);
+ if (state->length == 0) state->mode = LEN;
+ break;
+#endif
+ }
+ if (copy > state->wnext) {
+ copy -= state->wnext;
+ from = state->window + (state->wsize - copy);
+ }
+ else
+ from = state->window + (state->wnext - copy);
+ if (copy > state->length) copy = state->length;
+ }
+ else { /* copy from output */
+ from = put - state->offset;
+ copy = state->length;
+ }
+ if (copy > left) copy = left;
+ left -= copy;
+ state->length -= copy;
+ do {
+ *put++ = *from++;
+ } while (--copy);
+ if (state->length == 0) state->mode = LEN;
+ break;
+ case LIT:
+ if (left == 0) goto inf_leave;
+ *put++ = (unsigned char)(state->length);
+ left--;
+ state->mode = LEN;
+ break;
+ case CHECK:
+ if (state->wrap) {
+ NEEDBITS(32);
+ out -= left;
+ strm->total_out += out;
+ state->total += out;
+ if (out)
+ strm->adler = state->check =
+ UPDATE(state->check, put - out, out);
+ out = left;
+ if ((
+#ifdef GUNZIP
+ state->flags ? hold :
+#endif
+ ZSWAP32(hold)) != state->check) {
+ strm->msg = (char *)"incorrect data check";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ Tracev((stderr, "inflate: check matches trailer\n"));
+ }
+#ifdef GUNZIP
+ state->mode = LENGTH;
+ case LENGTH:
+ if (state->wrap && state->flags) {
+ NEEDBITS(32);
+ if (hold != (state->total & 0xffffffffUL)) {
+ strm->msg = (char *)"incorrect length check";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ Tracev((stderr, "inflate: length matches trailer\n"));
+ }
+#endif
+ state->mode = DONE;
+ case DONE:
+ ret = Z_STREAM_END;
+ goto inf_leave;
+ case BAD:
+ ret = Z_DATA_ERROR;
+ goto inf_leave;
+ case MEM:
+ return Z_MEM_ERROR;
+ case SYNC:
+ default:
+ return Z_STREAM_ERROR;
+ }
+
+ /*
+ Return from inflate(), updating the total counts and the check value.
+ If there was no progress during the inflate() call, return a buffer
+ error. Call updatewindow() to create and/or update the window state.
+ Note: a memory error from inflate() is non-recoverable.
+ */
+ inf_leave:
+ RESTORE();
+ if (state->wsize || (out != strm->avail_out && state->mode < BAD &&
+ (state->mode < CHECK || flush != Z_FINISH)))
+ if (updatewindow(strm, strm->next_out, out - strm->avail_out)) {
+ state->mode = MEM;
+ return Z_MEM_ERROR;
+ }
+ in -= strm->avail_in;
+ out -= strm->avail_out;
+ strm->total_in += in;
+ strm->total_out += out;
+ state->total += out;
+ if (state->wrap && out)
+ strm->adler = state->check =
+ UPDATE(state->check, strm->next_out - out, out);
+ strm->data_type = state->bits + (state->last ? 64 : 0) +
+ (state->mode == TYPE ? 128 : 0) +
+ (state->mode == LEN_ || state->mode == COPY_ ? 256 : 0);
+ if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK)
+ ret = Z_BUF_ERROR;
+ return ret;
+}
+
+int ZEXPORT inflateEnd(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->window != Z_NULL) ZFREE(strm, state->window);
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+ Tracev((stderr, "inflate: end\n"));
+ return Z_OK;
+}
+
+int ZEXPORT inflateGetDictionary(strm, dictionary, dictLength)
+z_streamp strm;
+Bytef *dictionary;
+uInt *dictLength;
+{
+ struct inflate_state FAR *state;
+
+ /* check state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* copy dictionary */
+ if (state->whave && dictionary != Z_NULL) {
+ zmemcpy(dictionary, state->window + state->wnext,
+ state->whave - state->wnext);
+ zmemcpy(dictionary + state->whave - state->wnext,
+ state->window, state->wnext);
+ }
+ if (dictLength != Z_NULL)
+ *dictLength = state->whave;
+ return Z_OK;
+}
+
+int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength)
+z_streamp strm;
+const Bytef *dictionary;
+uInt dictLength;
+{
+ struct inflate_state FAR *state;
+ unsigned long dictid;
+ int ret;
+
+ /* check state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->wrap != 0 && state->mode != DICT)
+ return Z_STREAM_ERROR;
+
+ /* check for correct dictionary identifier */
+ if (state->mode == DICT) {
+ dictid = adler32(0L, Z_NULL, 0);
+ dictid = adler32(dictid, dictionary, dictLength);
+ if (dictid != state->check)
+ return Z_DATA_ERROR;
+ }
+
+ /* copy dictionary to window using updatewindow(), which will amend the
+ existing dictionary if appropriate */
+ ret = updatewindow(strm, dictionary + dictLength, dictLength);
+ if (ret) {
+ state->mode = MEM;
+ return Z_MEM_ERROR;
+ }
+ state->havedict = 1;
+ Tracev((stderr, "inflate: dictionary set\n"));
+ return Z_OK;
+}
+
+int ZEXPORT inflateGetHeader(strm, head)
+z_streamp strm;
+gz_headerp head;
+{
+ struct inflate_state FAR *state;
+
+ /* check state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if ((state->wrap & 2) == 0) return Z_STREAM_ERROR;
+
+ /* save header structure */
+ state->head = head;
+ head->done = 0;
+ return Z_OK;
+}
+
+/*
+ Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found
+ or when out of input. When called, *have is the number of pattern bytes
+ found in order so far, in 0..3. On return *have is updated to the new
+ state. If on return *have equals four, then the pattern was found and the
+ return value is how many bytes were read including the last byte of the
+ pattern. If *have is less than four, then the pattern has not been found
+ yet and the return value is len. In the latter case, syncsearch() can be
+ called again with more data and the *have state. *have is initialized to
+ zero for the first call.
+ */
+local unsigned syncsearch(have, buf, len)
+unsigned FAR *have;
+const unsigned char FAR *buf;
+unsigned len;
+{
+ unsigned got;
+ unsigned next;
+
+ got = *have;
+ next = 0;
+ while (next < len && got < 4) {
+ if ((int)(buf[next]) == (got < 2 ? 0 : 0xff))
+ got++;
+ else if (buf[next])
+ got = 0;
+ else
+ got = 4 - got;
+ next++;
+ }
+ *have = got;
+ return next;
+}
+
+int ZEXPORT inflateSync(strm)
+z_streamp strm;
+{
+ unsigned len; /* number of bytes to look at or looked at */
+ unsigned long in, out; /* temporary to save total_in and total_out */
+ unsigned char buf[4]; /* to restore bit buffer to byte string */
+ struct inflate_state FAR *state;
+
+ /* check parameters */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR;
+
+ /* if first time, start search in bit buffer */
+ if (state->mode != SYNC) {
+ state->mode = SYNC;
+ state->hold <<= state->bits & 7;
+ state->bits -= state->bits & 7;
+ len = 0;
+ while (state->bits >= 8) {
+ buf[len++] = (unsigned char)(state->hold);
+ state->hold >>= 8;
+ state->bits -= 8;
+ }
+ state->have = 0;
+ syncsearch(&(state->have), buf, len);
+ }
+
+ /* search available input */
+ len = syncsearch(&(state->have), strm->next_in, strm->avail_in);
+ strm->avail_in -= len;
+ strm->next_in += len;
+ strm->total_in += len;
+
+ /* return no joy or set up to restart inflate() on a new block */
+ if (state->have != 4) return Z_DATA_ERROR;
+ in = strm->total_in; out = strm->total_out;
+ inflateReset(strm);
+ strm->total_in = in; strm->total_out = out;
+ state->mode = TYPE;
+ return Z_OK;
+}
+
+/*
+ Returns true if inflate is currently at the end of a block generated by
+ Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP
+ implementation to provide an additional safety check. PPP uses
+ Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored
+ block. When decompressing, PPP checks that at the end of input packet,
+ inflate is waiting for these length bytes.
+ */
+int ZEXPORT inflateSyncPoint(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;
+ return state->mode == STORED && state->bits == 0;
+}
+
+int ZEXPORT inflateCopy(dest, source)
+z_streamp dest;
+z_streamp source;
+{
+ struct inflate_state FAR *state;
+ struct inflate_state FAR *copy;
+ unsigned char FAR *window;
+ unsigned wsize;
+
+ /* check input */
+ if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL ||
+ source->zalloc == (alloc_func)0 || source->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)source->state;
+
+ /* allocate space */
+ copy = (struct inflate_state FAR *)
+ ZALLOC(source, 1, sizeof(struct inflate_state));
+ if (copy == Z_NULL) return Z_MEM_ERROR;
+ window = Z_NULL;
+ if (state->window != Z_NULL) {
+ window = (unsigned char FAR *)
+ ZALLOC(source, 1U << state->wbits, sizeof(unsigned char));
+ if (window == Z_NULL) {
+ ZFREE(source, copy);
+ return Z_MEM_ERROR;
+ }
+ }
+
+ /* copy 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);
+ copy->distcode = copy->codes + (state->distcode - state->codes);
+ }
+ copy->next = copy->codes + (state->next - state->codes);
+ if (window != Z_NULL) {
+ wsize = 1U << state->wbits;
+ zmemcpy(window, state->window, wsize);
+ }
+ copy->window = window;
+ dest->state = (struct internal_state FAR *)copy;
+ return Z_OK;
+}
+
+int ZEXPORT inflateUndermine(strm, subvert)
+z_streamp strm;
+int subvert;
+{
+ 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->sane = !subvert;
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ return Z_OK;
+#else
+ state->sane = 1;
+ return Z_DATA_ERROR;
+#endif
+}
+
+long ZEXPORT inflateMark(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return -1L << 16;
+ state = (struct inflate_state FAR *)strm->state;
+ return ((long)(state->back) << 16) +
+ (state->mode == COPY ? state->length :
+ (state->mode == MATCH ? state->was - state->length : 0));
+}
diff --git a/compat/zlib/inflate.h b/compat/zlib/inflate.h
new file mode 100644
index 0000000..95f4986
--- /dev/null
+++ b/compat/zlib/inflate.h
@@ -0,0 +1,122 @@
+/* inflate.h -- internal inflate state definition
+ * Copyright (C) 1995-2009 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* define NO_GZIP when compiling if you want to disable gzip header and
+ trailer decoding by inflate(). NO_GZIP would be used to avoid linking in
+ the crc code when it is not needed. For shared libraries, gzip decoding
+ should be left enabled. */
+#ifndef NO_GZIP
+# define GUNZIP
+#endif
+
+/* Possible inflate modes between inflate() calls */
+typedef enum {
+ HEAD, /* i: waiting for magic header */
+ FLAGS, /* i: waiting for method and flags (gzip) */
+ TIME, /* i: waiting for modification time (gzip) */
+ OS, /* i: waiting for extra flags and operating system (gzip) */
+ EXLEN, /* i: waiting for extra length (gzip) */
+ EXTRA, /* i: waiting for extra bytes (gzip) */
+ NAME, /* i: waiting for end of file name (gzip) */
+ COMMENT, /* i: waiting for end of comment (gzip) */
+ HCRC, /* i: waiting for header crc (gzip) */
+ DICTID, /* i: waiting for dictionary check value */
+ DICT, /* waiting for inflateSetDictionary() call */
+ TYPE, /* i: waiting for type bits, including last-flag bit */
+ TYPEDO, /* i: same, but skip check to exit inflate on new block */
+ STORED, /* i: waiting for stored size (length and complement) */
+ COPY_, /* i/o: same as COPY below, but only first time in */
+ COPY, /* i/o: waiting for input or output to copy stored block */
+ TABLE, /* i: waiting for dynamic block table lengths */
+ LENLENS, /* i: waiting for code length code lengths */
+ CODELENS, /* i: waiting for length/lit and distance code lengths */
+ LEN_, /* i: same as LEN below, but only first time in */
+ LEN, /* i: waiting for length/lit/eob code */
+ LENEXT, /* i: waiting for length extra bits */
+ DIST, /* i: waiting for distance code */
+ DISTEXT, /* i: waiting for distance extra bits */
+ MATCH, /* o: waiting for output space to copy string */
+ LIT, /* o: waiting for output space to write literal */
+ CHECK, /* i: waiting for 32-bit check value */
+ LENGTH, /* i: waiting for 32-bit length (gzip) */
+ DONE, /* finished check, done -- remain here until reset */
+ BAD, /* got a data error -- remain here until reset */
+ MEM, /* got an inflate() memory error -- remain here until reset */
+ SYNC /* looking for synchronization bytes to restart inflate() */
+} inflate_mode;
+
+/*
+ State transitions between above modes -
+
+ (most modes can go to BAD or MEM on error -- not shown for clarity)
+
+ Process header:
+ HEAD -> (gzip) or (zlib) or (raw)
+ (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -> COMMENT ->
+ HCRC -> TYPE
+ (zlib) -> DICTID or TYPE
+ DICTID -> DICT -> TYPE
+ (raw) -> TYPEDO
+ Read deflate blocks:
+ TYPE -> TYPEDO -> STORED or TABLE or LEN_ or CHECK
+ STORED -> COPY_ -> COPY -> TYPE
+ TABLE -> LENLENS -> CODELENS -> LEN_
+ LEN_ -> LEN
+ Read deflate codes in fixed or dynamic block:
+ LEN -> LENEXT or LIT or TYPE
+ LENEXT -> DIST -> DISTEXT -> MATCH -> LEN
+ LIT -> LEN
+ Process trailer:
+ CHECK -> LENGTH -> DONE
+ */
+
+/* state maintained between inflate() calls. Approximately 10K bytes. */
+struct inflate_state {
+ inflate_mode mode; /* current inflate mode */
+ int last; /* true if processing last block */
+ int wrap; /* bit 0 true for zlib, bit 1 true for gzip */
+ int havedict; /* true if dictionary provided */
+ int flags; /* gzip header method and flags (0 if zlib) */
+ unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */
+ unsigned long check; /* protected copy of check value */
+ unsigned long total; /* protected copy of output count */
+ gz_headerp head; /* where to save gzip header information */
+ /* sliding window */
+ unsigned wbits; /* log base 2 of requested window size */
+ unsigned wsize; /* window size or zero if not using window */
+ unsigned whave; /* valid bytes in the window */
+ unsigned wnext; /* window write index */
+ unsigned char FAR *window; /* allocated sliding window, if needed */
+ /* bit accumulator */
+ unsigned long hold; /* input bit accumulator */
+ unsigned bits; /* number of bits in "in" */
+ /* for string and stored block copying */
+ unsigned length; /* literal or length of data to copy */
+ unsigned offset; /* distance back to copy string from */
+ /* for table and code decoding */
+ unsigned extra; /* extra bits needed */
+ /* fixed and dynamic code tables */
+ code const FAR *lencode; /* starting table for length/literal codes */
+ code const FAR *distcode; /* starting table for distance codes */
+ unsigned lenbits; /* index bits for lencode */
+ unsigned distbits; /* index bits for distcode */
+ /* dynamic table building */
+ unsigned ncode; /* number of code length code lengths */
+ unsigned nlen; /* number of length code lengths */
+ unsigned ndist; /* number of distance code lengths */
+ unsigned have; /* number of code lengths in lens[] */
+ code FAR *next; /* next available space in codes[] */
+ unsigned short lens[320]; /* temporary storage for code lengths */
+ unsigned short work[288]; /* work area for code table building */
+ code codes[ENOUGH]; /* space for code tables */
+ int sane; /* if false, allow invalid distance too far */
+ int back; /* bits back of last unprocessed length/lit */
+ unsigned was; /* initial length of match */
+};
diff --git a/compat/zlib/inftrees.c b/compat/zlib/inftrees.c
new file mode 100644
index 0000000..44d89cf
--- /dev/null
+++ b/compat/zlib/inftrees.c
@@ -0,0 +1,306 @@
+/* inftrees.c -- generate Huffman trees for efficient decoding
+ * Copyright (C) 1995-2013 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+
+#define MAXBITS 15
+
+const char inflate_copyright[] =
+ " inflate 1.2.8 Copyright 1995-2013 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
+ include such an acknowledgment, I would appreciate that you keep this
+ copyright string in the executable of your product.
+ */
+
+/*
+ Build a set of tables to decode the provided canonical Huffman code.
+ The code lengths are lens[0..codes-1]. The result starts at *table,
+ whose indices are 0..2^bits-1. work is a writable array of at least
+ lens shorts, which is used as a work area. type is the type of code
+ to be generated, CODES, LENS, or DISTS. On return, zero is success,
+ -1 is an invalid code, and +1 means that ENOUGH isn't enough. table
+ on return points to the next available entry's address. bits is the
+ requested root table index bits, and on return it is the actual root
+ table index bits. It will differ if the request is greater than the
+ longest code or if it is less than the shortest code.
+ */
+int ZLIB_INTERNAL inflate_table(type, lens, codes, table, bits, work)
+codetype type;
+unsigned short FAR *lens;
+unsigned codes;
+code FAR * FAR *table;
+unsigned FAR *bits;
+unsigned short FAR *work;
+{
+ unsigned len; /* a code's length in bits */
+ unsigned sym; /* index of code symbols */
+ unsigned min, max; /* minimum and maximum code lengths */
+ unsigned root; /* number of index bits for root table */
+ unsigned curr; /* number of index bits for current table */
+ unsigned drop; /* code bits to drop for sub-table */
+ int left; /* number of prefix codes available */
+ unsigned used; /* code entries in table used */
+ unsigned huff; /* Huffman code */
+ unsigned incr; /* for incrementing code, index */
+ unsigned fill; /* index for replicating entries */
+ unsigned low; /* low bits for current root entry */
+ unsigned mask; /* mask for low root bits */
+ code here; /* table entry for duplication */
+ code FAR *next; /* next available space in table */
+ const unsigned short FAR *base; /* base value table to use */
+ const unsigned short FAR *extra; /* extra bits table to use */
+ int end; /* use base and extra for symbol > end */
+ unsigned short count[MAXBITS+1]; /* number of codes of each length */
+ unsigned short offs[MAXBITS+1]; /* offsets in table for each length */
+ static const unsigned short lbase[31] = { /* Length codes 257..285 base */
+ 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
+ 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, 72, 78};
+ 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,
+ 8193, 12289, 16385, 24577, 0, 0};
+ static const unsigned short dext[32] = { /* Distance codes 0..29 extra */
+ 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22,
+ 23, 23, 24, 24, 25, 25, 26, 26, 27, 27,
+ 28, 28, 29, 29, 64, 64};
+
+ /*
+ Process a set of code lengths to create a canonical Huffman code. The
+ code lengths are lens[0..codes-1]. Each length corresponds to the
+ symbols 0..codes-1. The Huffman code is generated by first sorting the
+ symbols by length from short to long, and retaining the symbol order
+ for codes with equal lengths. Then the code starts with all zero bits
+ for the first code of the shortest length, and the codes are integer
+ increments for the same length, and zeros are appended as the length
+ increases. For the deflate format, these bits are stored backwards
+ from their more natural integer increment ordering, and so when the
+ decoding tables are built in the large loop below, the integer codes
+ are incremented backwards.
+
+ This routine assumes, but does not check, that all of the entries in
+ lens[] are in the range 0..MAXBITS. The caller must assure this.
+ 1..MAXBITS is interpreted as that code length. zero means that that
+ symbol does not occur in this code.
+
+ The codes are sorted by computing a count of codes for each length,
+ creating from that a table of starting indices for each length in the
+ sorted table, and then entering the symbols in order in the sorted
+ table. The sorted table is work[], with that space being provided by
+ the caller.
+
+ The length counts are used for other purposes as well, i.e. finding
+ the minimum and maximum length codes, determining if there are any
+ codes at all, checking for a valid set of lengths, and looking ahead
+ at length counts to determine sub-table sizes when building the
+ decoding tables.
+ */
+
+ /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */
+ for (len = 0; len <= MAXBITS; len++)
+ count[len] = 0;
+ for (sym = 0; sym < codes; sym++)
+ count[lens[sym]]++;
+
+ /* bound code lengths, force root to be within code lengths */
+ root = *bits;
+ for (max = MAXBITS; max >= 1; max--)
+ if (count[max] != 0) break;
+ if (root > max) root = max;
+ if (max == 0) { /* no symbols to code at all */
+ here.op = (unsigned char)64; /* invalid code marker */
+ here.bits = (unsigned char)1;
+ here.val = (unsigned short)0;
+ *(*table)++ = here; /* make a table to force an error */
+ *(*table)++ = here;
+ *bits = 1;
+ return 0; /* no symbols, but wait for decoding to report error */
+ }
+ for (min = 1; min < max; min++)
+ if (count[min] != 0) break;
+ if (root < min) root = min;
+
+ /* check for an over-subscribed or incomplete set of lengths */
+ left = 1;
+ for (len = 1; len <= MAXBITS; len++) {
+ left <<= 1;
+ left -= count[len];
+ if (left < 0) return -1; /* over-subscribed */
+ }
+ if (left > 0 && (type == CODES || max != 1))
+ return -1; /* incomplete set */
+
+ /* generate offsets into symbol table for each length for sorting */
+ offs[1] = 0;
+ for (len = 1; len < MAXBITS; len++)
+ offs[len + 1] = offs[len] + count[len];
+
+ /* sort symbols by length, by symbol order within each length */
+ for (sym = 0; sym < codes; sym++)
+ if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym;
+
+ /*
+ Create and fill in decoding tables. In this loop, the table being
+ filled is at next and has curr index bits. The code being used is huff
+ with length len. That code is converted to an index by dropping drop
+ bits off of the bottom. For codes where len is less than drop + curr,
+ those top drop + curr - len bits are incremented through all values to
+ fill the table with replicated entries.
+
+ root is the number of index bits for the root table. When len exceeds
+ root, sub-tables are created pointed to by the root entry with an index
+ of the low root bits of huff. This is saved in low to check for when a
+ new sub-table should be started. drop is zero when the root table is
+ being filled, and drop is root when sub-tables are being filled.
+
+ When a new sub-table is needed, it is necessary to look ahead in the
+ code lengths to determine what size sub-table is needed. The length
+ counts are used for this, and so count[] is decremented as codes are
+ entered in the tables.
+
+ used keeps track of how many table entries have been allocated from the
+ provided *table space. It is checked for LENS and DIST tables against
+ the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in
+ the initial root table size constants. See the comments in inftrees.h
+ for more information.
+
+ sym increments through all symbols, and the loop terminates when
+ all codes of length max, i.e. all codes, have been processed. This
+ routine permits incomplete codes, so another loop after this one fills
+ in the rest of the decoding tables with invalid code markers.
+ */
+
+ /* set up for code type */
+ switch (type) {
+ case CODES:
+ base = extra = work; /* dummy value--not used */
+ end = 19;
+ break;
+ case LENS:
+ base = lbase;
+ base -= 257;
+ extra = lext;
+ extra -= 257;
+ end = 256;
+ break;
+ default: /* DISTS */
+ base = dbase;
+ extra = dext;
+ end = -1;
+ }
+
+ /* initialize state for loop */
+ huff = 0; /* starting code */
+ sym = 0; /* starting code symbol */
+ len = min; /* starting code length */
+ next = *table; /* current table to fill in */
+ curr = root; /* current table index bits */
+ drop = 0; /* current bits to drop from code for index */
+ low = (unsigned)(-1); /* trigger new sub-table when len > root */
+ used = 1U << root; /* use root table entries */
+ mask = used - 1; /* mask for comparing low */
+
+ /* check available table space */
+ if ((type == LENS && used > ENOUGH_LENS) ||
+ (type == DISTS && used > ENOUGH_DISTS))
+ return 1;
+
+ /* process all codes and make table entries */
+ for (;;) {
+ /* create table entry */
+ here.bits = (unsigned char)(len - drop);
+ if ((int)(work[sym]) < end) {
+ here.op = (unsigned char)0;
+ here.val = work[sym];
+ }
+ else if ((int)(work[sym]) > end) {
+ here.op = (unsigned char)(extra[work[sym]]);
+ here.val = base[work[sym]];
+ }
+ else {
+ here.op = (unsigned char)(32 + 64); /* end of block */
+ here.val = 0;
+ }
+
+ /* replicate for those indices with low len bits equal to huff */
+ incr = 1U << (len - drop);
+ fill = 1U << curr;
+ min = fill; /* save offset to next table */
+ do {
+ fill -= incr;
+ next[(huff >> drop) + fill] = here;
+ } while (fill != 0);
+
+ /* 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;
+
+ /* go to next symbol, update count, len */
+ sym++;
+ if (--(count[len]) == 0) {
+ if (len == max) break;
+ len = lens[work[sym]];
+ }
+
+ /* create new sub-table if needed */
+ if (len > root && (huff & mask) != low) {
+ /* if first time, transition to sub-tables */
+ if (drop == 0)
+ drop = root;
+
+ /* increment past last table */
+ next += min; /* here min is 1 << curr */
+
+ /* determine length of next table */
+ curr = len - drop;
+ left = (int)(1 << curr);
+ while (curr + drop < max) {
+ left -= count[curr + drop];
+ if (left <= 0) break;
+ curr++;
+ left <<= 1;
+ }
+
+ /* check for enough space */
+ used += 1U << curr;
+ if ((type == LENS && used > ENOUGH_LENS) ||
+ (type == DISTS && used > ENOUGH_DISTS))
+ return 1;
+
+ /* point entry in root table to sub-table */
+ low = huff & mask;
+ (*table)[low].op = (unsigned char)curr;
+ (*table)[low].bits = (unsigned char)root;
+ (*table)[low].val = (unsigned short)(next - *table);
+ }
+ }
+
+ /* 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 */
+ *table += used;
+ *bits = root;
+ return 0;
+}
diff --git a/compat/zlib/inftrees.h b/compat/zlib/inftrees.h
new file mode 100644
index 0000000..baa53a0
--- /dev/null
+++ b/compat/zlib/inftrees.h
@@ -0,0 +1,62 @@
+/* inftrees.h -- header to use inftrees.c
+ * Copyright (C) 1995-2005, 2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* Structure for decoding tables. Each entry provides either the
+ information needed to do the operation requested by the code that
+ indexed that table entry, or it provides a pointer to another
+ table that indexes more bits of the code. op indicates whether
+ the entry is a pointer to another table, a literal, a length or
+ distance, an end-of-block, or an invalid code. For a table
+ pointer, the low four bits of op is the number of index bits of
+ that table. For a length or distance, the low four bits of op
+ is the number of extra bits to get after the code. bits is
+ the number of bits in this code or part of the code to drop off
+ of the bit buffer. val is the actual byte to output in the case
+ of a literal, the base length or distance, or the offset from
+ the current table to the next table. Each entry is four bytes. */
+typedef struct {
+ unsigned char op; /* operation, extra bits, table bits */
+ unsigned char bits; /* bits in this part of the code */
+ unsigned short val; /* offset in table or code value */
+} code;
+
+/* op values as set by inflate_table():
+ 00000000 - literal
+ 0000tttt - table link, tttt != 0 is the number of table index bits
+ 0001eeee - length or distance, eeee is the number of extra bits
+ 01100000 - end of block
+ 01000000 - invalid code
+ */
+
+/* Maximum size of the dynamic table. The maximum number of code structures is
+ 1444, which is the sum of 852 for literal/length codes and 592 for distance
+ codes. These values were found by exhaustive searches using the program
+ examples/enough.c found in the zlib distribtution. The arguments to that
+ program are the number of symbols, the initial root table size, and the
+ maximum bit length of a code. "enough 286 9 15" for literal/length codes
+ returns returns 852, and "enough 30 6 15" for distance codes returns 592.
+ The initial root table size (9 or 6) is found in the fifth argument of the
+ inflate_table() calls in inflate.c and infback.c. If the root table size is
+ changed, then these maximum sizes would be need to be recalculated and
+ updated. */
+#define ENOUGH_LENS 852
+#define ENOUGH_DISTS 592
+#define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS)
+
+/* Type of code to build for inflate_table() */
+typedef enum {
+ CODES,
+ LENS,
+ DISTS
+} codetype;
+
+int ZLIB_INTERNAL inflate_table OF((codetype type, unsigned short FAR *lens,
+ unsigned codes, code FAR * FAR *table,
+ unsigned FAR *bits, unsigned short FAR *work));
diff --git a/compat/zlib/make_vms.com b/compat/zlib/make_vms.com
new file mode 100644
index 0000000..65e9d0c
--- /dev/null
+++ b/compat/zlib/make_vms.com
@@ -0,0 +1,867 @@
+$! make libz under VMS written by
+$! Martin P.J. Zinser
+$!
+$! In case of problems with the install you might contact me at
+$! zinser@zinser.no-ip.info(preferred) or
+$! martin.zinser@eurexchange.com (work)
+$!
+$! Make procedure history for Zlib
+$!
+$!------------------------------------------------------------------------------
+$! Version history
+$! 0.01 20060120 First version to receive a number
+$! 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
+$!
+$ true = 1
+$ false = 0
+$ tmpnam = "temp_" + f$getjpi("","pid")
+$ tt = tmpnam + ".txt"
+$ tc = tmpnam + ".c"
+$ th = tmpnam + ".h"
+$ define/nolog tconfig 'th'
+$ its_decc = false
+$ its_vaxc = false
+$ its_gnuc = false
+$ s_case = False
+$!
+$! Setup variables holding "config" information
+$!
+$ Make = "''p1'"
+$ name = "Zlib"
+$ version = "?.?.?"
+$ v_string = "ZLIB_VERSION"
+$ v_file = "zlib.h"
+$ ccopt = "/include = []"
+$ lopts = ""
+$ dnsrl = ""
+$ 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
+$!
+$! 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 (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
+$!
+$ open/write topt tmp.opt
+$ open/write optf 'optfile'
+$!
+$ gosub check_opts
+$!
+$! Look for the compiler used
+$!
+$ gosub check_compiler
+$ close topt
+$ close optf
+$!
+$ if its_decc
+$ then
+$ ccopt = "/prefix=all" + ccopt
+$ if f$trnlnm("SYS") .eqs. ""
+$ then
+$ if axp
+$ then
+$ define sys sys$library:
+$ else
+$ 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
+$ if f$trnlnm("SYS").eqs."" then define sys sys$library:
+$ endif
+$!
+$! Build a fake configure input header
+$!
+$ open/write conf_hin config.hin
+$ write conf_hin "#undef _LARGEFILE64_SOURCE"
+$ close conf_hin
+$!
+$!
+$ i = 0
+$FIND_ACONF:
+$ fname = f$element(i,"#",aconf_in_file)
+$ if fname .eqs. "#" then goto AMISS_ERR
+$ if f$search(fname) .eqs. ""
+$ then
+$ i = i + 1
+$ goto find_aconf
+$ endif
+$ open/read/err=aconf_err aconf_in 'fname'
+$ open/write aconf zconf.h
+$ACONF_LOOP:
+$ read/end_of_file=aconf_exit aconf_in line
+$ work = f$edit(line, "compress,trim")
+$ if f$extract(0,6,work) .nes. "#undef"
+$ then
+$ if f$extract(0,12,work) .nes. "#cmakedefine"
+$ then
+$ write aconf line
+$ endif
+$ else
+$ cdef = f$element(1," ",work)
+$ 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 "#endif"
+$ write aconf "#if !defined( __VAX) && (__CRTL_VER >= 70312000)"
+$ write aconf "# define HAVE_VSNPRINTF"
+$ write aconf "#endif"
+$ close aconf_in
+$ close aconf
+$ if f$search("''th'") .nes. "" then delete 'th';*
+$! Build the thing plain or with mms
+$!
+$ write sys$output "Compiling Zlib sources ..."
+$ if make.eqs.""
+$ 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" -
+ compress.c zlib.h zconf.h
+$ CALL MAKE crc32.OBJ "CC ''CCOPT' crc32" -
+ crc32.c zlib.h zconf.h
+$ CALL MAKE deflate.OBJ "CC ''CCOPT' deflate" -
+ deflate.c deflate.h zutil.h zlib.h zconf.h
+$ CALL MAKE gzclose.OBJ "CC ''CCOPT' gzclose" -
+ gzclose.c zutil.h zlib.h zconf.h
+$ CALL MAKE gzlib.OBJ "CC ''CCOPT' gzlib" -
+ gzlib.c zutil.h zlib.h zconf.h
+$ CALL MAKE gzread.OBJ "CC ''CCOPT' gzread" -
+ gzread.c zutil.h zlib.h zconf.h
+$ CALL MAKE gzwrite.OBJ "CC ''CCOPT' gzwrite" -
+ gzwrite.c zutil.h zlib.h zconf.h
+$ CALL MAKE infback.OBJ "CC ''CCOPT' infback" -
+ infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
+$ CALL MAKE inffast.OBJ "CC ''CCOPT' inffast" -
+ inffast.c zutil.h zlib.h zconf.h inffast.h
+$ CALL MAKE inflate.OBJ "CC ''CCOPT' inflate" -
+ inflate.c zutil.h zlib.h zconf.h infblock.h
+$ CALL MAKE inftrees.OBJ "CC ''CCOPT' inftrees" -
+ inftrees.c zutil.h zlib.h zconf.h inftrees.h
+$ CALL MAKE trees.OBJ "CC ''CCOPT' trees" -
+ trees.c deflate.h zutil.h zlib.h zconf.h
+$ CALL MAKE uncompr.OBJ "CC ''CCOPT' uncompr" -
+ uncompr.c zlib.h zconf.h
+$ CALL MAKE zutil.OBJ "CC ''CCOPT' zutil" -
+ zutil.c zutil.h zlib.h zconf.h
+$ 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' [.test]example" -
+ [.test]example.c zlib.h zconf.h
+$ call make example.exe "LINK example,libz.olb/lib" example.obj libz.olb
+$ 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
+$!
+$! Create shareable image
+$!
+$ 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
+$ERR_EXIT:
+$ set message/facil/ident/sever/text
+$ close/nolog optf
+$ close/nolog topt
+$ close/nolog aconf_in
+$ close/nolog aconf
+$ close/nolog out
+$ close/nolog min
+$ close/nolog mod
+$ close/nolog h_in
+$ write sys$output "Exiting..."
+$ exit 2
+$!
+$!
+$MAKE: SUBROUTINE !SUBROUTINE TO CHECK DEPENDENCIES
+$ V = 'F$Verify(0)
+$! P1 = What we are trying to make
+$! P2 = Command to make it
+$! P3 - P8 What it depends on
+$
+$ If F$Search(P1) .Eqs. "" Then Goto Makeit
+$ Time = F$CvTime(F$File(P1,"RDT"))
+$arg=3
+$Loop:
+$ Argument = P'arg
+$ If Argument .Eqs. "" Then Goto Exit
+$ El=0
+$Loop2:
+$ File = F$Element(El," ",Argument)
+$ If File .Eqs. " " Then Goto Endl
+$ AFile = ""
+$Loop3:
+$ OFile = AFile
+$ AFile = F$Search(File)
+$ If AFile .Eqs. "" .Or. AFile .Eqs. OFile Then Goto NextEl
+$ If F$CvTime(F$File(AFile,"RDT")) .Ges. Time Then Goto Makeit
+$ Goto Loop3
+$NextEL:
+$ El = El + 1
+$ Goto Loop2
+$EndL:
+$ arg=arg+1
+$ If arg .Le. 8 Then Goto Loop
+$ Goto Exit
+$
+$Makeit:
+$ VV=F$VERIFY(0)
+$ write sys$output P2
+$ 'P2
+$ VV='F$Verify(VV)
+$Exit:
+$ If V Then Set Verify
+$ENDSUBROUTINE
+$!------------------------------------------------------------------------------
+$!
+$! Check command line options and set symbols accordingly
+$!
+$!------------------------------------------------------------------------------
+$! Version history
+$! 0.01 20041206 First version to receive a number
+$! 0.02 20060126 Add new "HELP" target
+$ CHECK_OPTS:
+$ i = 1
+$ OPT_LOOP:
+$ if i .lt. 9
+$ then
+$ cparm = f$edit(p'i',"upcase")
+$!
+$! Check if parameter actually contains something
+$!
+$ if f$edit(cparm,"trim") .nes. ""
+$ then
+$ if cparm .eqs. "DEBUG"
+$ then
+$ ccopt = ccopt + "/noopt/deb"
+$ lopts = lopts + "/deb"
+$ endif
+$ if f$locate("CCOPT=",cparm) .lt. f$length(cparm)
+$ then
+$ start = f$locate("=",cparm) + 1
+$ len = f$length(cparm) - start
+$ ccopt = ccopt + f$extract(start,len,cparm)
+$ if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) -
+ then s_case = true
+$ endif
+$ if cparm .eqs. "LINK" then linkonly = true
+$ if f$locate("LOPTS=",cparm) .lt. f$length(cparm)
+$ then
+$ start = f$locate("=",cparm) + 1
+$ len = f$length(cparm) - start
+$ lopts = lopts + f$extract(start,len,cparm)
+$ endif
+$ if f$locate("CC=",cparm) .lt. f$length(cparm)
+$ then
+$ start = f$locate("=",cparm) + 1
+$ len = f$length(cparm) - start
+$ cc_com = f$extract(start,len,cparm)
+ if (cc_com .nes. "DECC") .and. -
+ (cc_com .nes. "VAXC") .and. -
+ (cc_com .nes. "GNUC")
+$ then
+$ write sys$output "Unsupported compiler choice ''cc_com' ignored"
+$ write sys$output "Use DECC, VAXC, or GNUC instead"
+$ else
+$ if cc_com .eqs. "DECC" then its_decc = true
+$ if cc_com .eqs. "VAXC" then its_vaxc = true
+$ if cc_com .eqs. "GNUC" then its_gnuc = true
+$ endif
+$ endif
+$ if f$locate("MAKE=",cparm) .lt. f$length(cparm)
+$ then
+$ start = f$locate("=",cparm) + 1
+$ len = f$length(cparm) - start
+$ mmks = f$extract(start,len,cparm)
+$ if (mmks .eqs. "MMK") .or. (mmks .eqs. "MMS")
+$ then
+$ make = mmks
+$ else
+$ write sys$output "Unsupported make choice ''mmks' ignored"
+$ write sys$output "Use MMK or MMS instead"
+$ endif
+$ endif
+$ if cparm .eqs. "HELP" then gosub bhelp
+$ endif
+$ i = i + 1
+$ goto opt_loop
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Look for the compiler used
+$!
+$! Version history
+$! 0.01 20040223 First version to receive a number
+$! 0.02 20040229 Save/set value of decc$no_rooted_search_lists
+$! 0.03 20060202 Extend handling of GNU C
+$! 0.04 20090402 Compaq -> hp
+$CHECK_COMPILER:
+$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
+$ then
+$ its_decc = (f$search("SYS$SYSTEM:DECC$COMPILER.EXE") .nes. "")
+$ its_vaxc = .not. its_decc .and. (F$Search("SYS$System:VAXC.Exe") .nes. "")
+$ its_gnuc = .not. (its_decc .or. its_vaxc) .and. (f$trnlnm("gnu_cc") .nes. "")
+$ endif
+$!
+$! Exit if no compiler available
+$!
+$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
+$ then goto CC_ERR
+$ else
+$ if its_decc
+$ then
+$ write sys$output "CC compiler check ... hp C"
+$ if f$trnlnm("decc$no_rooted_search_lists") .nes. ""
+$ then
+$ dnrsl = f$trnlnm("decc$no_rooted_search_lists")
+$ endif
+$ define/nolog decc$no_rooted_search_lists 1
+$ else
+$ if its_vaxc then write sys$output "CC compiler check ... VAX C"
+$ if its_gnuc
+$ then
+$ write sys$output "CC compiler check ... GNU C"
+$ if f$trnlnm(topt) then write topt "gnu_cc:[000000]gcclib.olb/lib"
+$ if f$trnlnm(optf) then write optf "gnu_cc:[000000]gcclib.olb/lib"
+$ cc = "gcc"
+$ endif
+$ if f$trnlnm(topt) then write topt "sys$share:vaxcrtl.exe/share"
+$ if f$trnlnm(optf) then write optf "sys$share:vaxcrtl.exe/share"
+$ endif
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! If MMS/MMK are available dump out the descrip.mms if required
+$!
+$CREA_MMS:
+$ write sys$output "Creating descrip.mms..."
+$ create descrip.mms
+$ open/append out descrip.mms
+$ 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 martin.zinser@eurexchange.com>
+
+OBJS = adler32.obj, compress.obj, crc32.obj, gzclose.obj, gzlib.obj\
+ gzread.obj, gzwrite.obj, uncompr.obj, infback.obj\
+ deflate.obj, trees.obj, zutil.obj, inflate.obj, \
+ inftrees.obj, inffast.obj
+
+$ eod
+$ write out "CFLAGS=", ccopt
+$ write out "LOPTS=", lopts
+$ write out "all : example.exe minigzip.exe libz.olb"
+$ copy sys$input: out
+$ deck
+ @ write sys$output " Example applications available"
+
+libz.olb : libz.olb($(OBJS))
+ @ write sys$output " libz available"
+
+example.exe : example.obj libz.olb
+ link $(LOPTS) example,libz.olb/lib
+
+minigzip.exe : minigzip.obj libz.olb
+ link $(LOPTS) minigzip,libz.olb/lib
+
+clean :
+ delete *.obj;*,libz.olb;*,*.opt;*,*.exe;*
+
+
+# Other dependencies.
+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 : [.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
+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 : [.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
+infback.obj : infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
+$ eod
+$ close out
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Read list of core library sources from makefile.in and create options
+$! needed to build shareable image
+$!
+$CREA_OLIST:
+$ open/read min makefile.in
+$ open/write mod modules.opt
+$ src_check_list = "OBJZ =#OBJG ="
+$MRLOOP:
+$ read/end=mrdone min rec
+$ 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 mrloop
+$MRSLOOP:
+$ read/end=mrdone min rec
+$ gosub extra_filnam
+$ if (f$element(1,"\",rec) .nes. "\") then goto mrsloop
+$MRDONE:
+$ close min
+$ close mod
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Take record extracted in crea_olist and split it into single filenames
+$!
+$EXTRA_FILNAM:
+$ myrec = f$edit(rec - "\", "trim,compress")
+$ i = 0
+$FELOOP:
+$ srcfil = f$element(i," ", myrec)
+$ if (srcfil .nes. " ")
+$ then
+$ write mod f$parse(srcfil,,,"NAME"), ".obj"
+$ i = i + 1
+$ goto feloop
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Find current Zlib version number
+$!
+$FIND_VERSION:
+$ open/read h_in 'v_file'
+$hloop:
+$ read/end=hdone h_in rec
+$ rec = f$edit(rec,"TRIM")
+$ if (f$extract(0,1,rec) .nes. "#") then goto hloop
+$ rec = f$edit(rec - "#", "TRIM")
+$ if f$element(0," ",rec) .nes. "define" then goto hloop
+$ if f$element(1," ",rec) .eqs. v_string
+$ then
+$ version = 'f$element(2," ",rec)'
+$ goto hdone
+$ endif
+$ goto hloop
+$hdone:
+$ close h_in
+$ return
+$!------------------------------------------------------------------------------
+$!
+$CHECK_CONFIG:
+$!
+$ in_ldef = f$locate(cdef,libdefs)
+$ if (in_ldef .lt. f$length(libdefs))
+$ then
+$ write aconf "#define ''cdef' 1"
+$ libdefs = f$extract(0,in_ldef,libdefs) + -
+ f$extract(in_ldef + f$length(cdef) + 1, -
+ f$length(libdefs) - in_ldef - f$length(cdef) - 1, -
+ libdefs)
+$ else
+$ if (f$type('cdef') .eqs. "INTEGER")
+$ then
+$ write aconf "#define ''cdef' ", 'cdef'
+$ else
+$ if (f$type('cdef') .eqs. "STRING")
+$ then
+$ write aconf "#define ''cdef' ", """", '''cdef'', """"
+$ else
+$ gosub check_cc_def
+$ endif
+$ endif
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Check if this is a define relating to the properties of the C/C++
+$! compiler
+$!
+$ CHECK_CC_DEF:
+$ if (cdef .eqs. "_LARGEFILE64_SOURCE")
+$ then
+$ copy sys$input: 'tc'
+$ deck
+#include "tconfig"
+#define _LARGEFILE
+#include <stdio.h>
+
+int main(){
+FILE *fp;
+ fp = fopen("temp.txt","r");
+ fseeko(fp,1,SEEK_SET);
+ fclose(fp);
+}
+
+$ eod
+$ test_inv = false
+$ comm_h = false
+$ gosub cc_prop_check
+$ return
+$ endif
+$ write aconf "/* ", line, " */"
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Check for properties of C/C++ compiler
+$!
+$! Version history
+$! 0.01 20031020 First version to receive a number
+$! 0.02 20031022 Added logic for defines with value
+$! 0.03 20040309 Make sure local config file gets not deleted
+$! 0.04 20041230 Also write include for configure run
+$! 0.05 20050103 Add processing of "comment defines"
+$CC_PROP_CHECK:
+$ cc_prop = true
+$ is_need = false
+$ is_need = (f$extract(0,4,cdef) .eqs. "NEED") .or. (test_inv .eq. true)
+$ if f$search(th) .eqs. "" then create 'th'
+$ set message/nofac/noident/nosever/notext
+$ on error then continue
+$ cc 'tmpnam'
+$ if .not. ($status) then cc_prop = false
+$ on error then continue
+$! The headers might lie about the capabilities of the RTL
+$ link 'tmpnam',tmp.opt/opt
+$ if .not. ($status) then cc_prop = false
+$ set message/fac/ident/sever/text
+$ on error then goto err_exit
+$ delete/nolog 'tmpnam'.*;*/exclude='th'
+$ if (cc_prop .and. .not. is_need) .or. -
+ (.not. cc_prop .and. is_need)
+$ then
+$ write sys$output "Checking for ''cdef'... yes"
+$ if f$type('cdef_val'_yes) .nes. ""
+$ then
+$ if f$type('cdef_val'_yes) .eqs. "INTEGER" -
+ then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_yes)
+$ if f$type('cdef_val'_yes) .eqs. "STRING" -
+ then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_yes)
+$ else
+$ call write_config f$fao("#define !AS 1",cdef)
+$ endif
+$ if (cdef .eqs. "HAVE_FSEEKO") .or. (cdef .eqs. "_LARGE_FILES") .or. -
+ (cdef .eqs. "_LARGEFILE64_SOURCE") then -
+ call write_config f$string("#define _LARGEFILE 1")
+$ else
+$ write sys$output "Checking for ''cdef'... no"
+$ if (comm_h)
+$ then
+ call write_config f$fao("/* !AS */",line)
+$ else
+$ if f$type('cdef_val'_no) .nes. ""
+$ then
+$ if f$type('cdef_val'_no) .eqs. "INTEGER" -
+ then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_no)
+$ if f$type('cdef_val'_no) .eqs. "STRING" -
+ then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_no)
+$ else
+$ call write_config f$fao("#undef !AS",cdef)
+$ endif
+$ endif
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! Check for properties of C/C++ compiler with multiple result values
+$!
+$! Version history
+$! 0.01 20040127 First version
+$! 0.02 20050103 Reconcile changes from cc_prop up to version 0.05
+$CC_MPROP_CHECK:
+$ cc_prop = true
+$ i = 1
+$ idel = 1
+$ MT_LOOP:
+$ if f$type(result_'i') .eqs. "STRING"
+$ then
+$ set message/nofac/noident/nosever/notext
+$ on error then continue
+$ cc 'tmpnam'_'i'
+$ if .not. ($status) then cc_prop = false
+$ on error then continue
+$! The headers might lie about the capabilities of the RTL
+$ link 'tmpnam'_'i',tmp.opt/opt
+$ if .not. ($status) then cc_prop = false
+$ set message/fac/ident/sever/text
+$ on error then goto err_exit
+$ delete/nolog 'tmpnam'_'i'.*;*
+$ if (cc_prop)
+$ then
+$ write sys$output "Checking for ''cdef'... ", mdef_'i'
+$ if f$type(mdef_'i') .eqs. "INTEGER" -
+ then call write_config f$fao("#define !AS !UL",cdef,mdef_'i')
+$ if f$type('cdef_val'_yes) .eqs. "STRING" -
+ then call write_config f$fao("#define !AS !AS",cdef,mdef_'i')
+$ goto msym_clean
+$ else
+$ i = i + 1
+$ goto mt_loop
+$ endif
+$ endif
+$ write sys$output "Checking for ''cdef'... no"
+$ call write_config f$fao("#undef !AS",cdef)
+$ MSYM_CLEAN:
+$ if (idel .le. msym_max)
+$ then
+$ delete/sym mdef_'idel'
+$ idel = idel + 1
+$ goto msym_clean
+$ endif
+$ return
+$!------------------------------------------------------------------------------
+$!
+$! 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
+$!------------------------------------------------------------------------------
+$!
+$! 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
+$!
+$ SAY := "WRITE_ SYS$OUTPUT"
+$!
+$ IF F$SEARCH("''P1'") .EQS. ""
+$ THEN
+$ SAY "MAP_2_SHOPT-E-NOSUCHFILE: Error, inputfile ''p1' not available"
+$ goto exit_m2s
+$ ENDIF
+$ IF "''P2'" .EQS. ""
+$ THEN
+$ SAY "MAP_2_SHOPT: Error, no output file provided"
+$ goto exit_m2s
+$ ENDIF
+$!
+$ 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
+$ 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
+$ EXIT_M2S:
+$ close/nolog map
+$ close/nolog libopt
+$ endsubroutine
diff --git a/compat/zlib/msdos/Makefile.bor b/compat/zlib/msdos/Makefile.bor
new file mode 100644
index 0000000..3d12a2c
--- /dev/null
+++ b/compat/zlib/msdos/Makefile.bor
@@ -0,0 +1,115 @@
+# Makefile for zlib
+# Borland C++
+# Last updated: 15-Mar-2003
+
+# To use, do "make -fmakefile.bor"
+# To compile in small model, set below: MODEL=s
+
+# WARNING: the small model is supported but only for small values of
+# MAX_WBITS and MAX_MEM_LEVEL. For example:
+# -DMAX_WBITS=11 -DDEF_WBITS=11 -DMAX_MEM_LEVEL=3
+# If you wish to reduce the memory requirements (default 256K for big
+# objects plus a few K), you can add to the LOC macro below:
+# -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
+# See zconf.h for details about the memory requirements.
+
+# ------------ Turbo C++, Borland C++ ------------
+
+# Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
+# should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added
+# to the declaration of LOC here:
+LOC = $(LOCAL_ZLIB)
+
+# type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc.
+CPU_TYP = 0
+
+# memory model: one of s, m, c, l (small, medium, compact, large)
+MODEL=l
+
+# replace bcc with tcc for Turbo C++ 1.0, with bcc32 for the 32 bit version
+CC=bcc
+LD=bcc
+AR=tlib
+
+# compiler flags
+# replace "-O2" by "-O -G -a -d" for Turbo C++ 1.0
+CFLAGS=-O2 -Z -m$(MODEL) $(LOC)
+
+LDFLAGS=-m$(MODEL) -f-
+
+
+# variables
+ZLIB_LIB = zlib_$(MODEL).lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
+OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(CFLAGS) $*.c
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.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:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2)
+ -del $(ZLIB_LIB)
+ $(AR) $(ZLIB_LIB) $(OBJP1)
+ $(AR) $(ZLIB_LIB) $(OBJP2)
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
+
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+clean:
+ -del *.obj
+ -del *.lib
+ -del *.exe
+ -del zlib_*.bak
+ -del foo.gz
diff --git a/compat/zlib/msdos/Makefile.dj2 b/compat/zlib/msdos/Makefile.dj2
new file mode 100644
index 0000000..29b0395
--- /dev/null
+++ b/compat/zlib/msdos/Makefile.dj2
@@ -0,0 +1,104 @@
+# Makefile for zlib. Modified for djgpp v2.0 by F. J. Donahoe, 3/15/96.
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h
+
+# To compile, or to compile and test, type:
+#
+# make -fmakefile.dj2; make test -fmakefile.dj2
+#
+# To install libz.a, zconf.h and zlib.h in the djgpp directories, type:
+#
+# make install -fmakefile.dj2
+#
+# after first defining LIBRARY_PATH and INCLUDE_PATH in djgpp.env as
+# in the sample below if the pattern of the DJGPP distribution is to
+# be followed. Remember that, while <sp>'es around <=> are ignored in
+# makefiles, they are *not* in batch files or in djgpp.env.
+# - - - - -
+# [make]
+# INCLUDE_PATH=%\>;INCLUDE_PATH%%\DJDIR%\include
+# LIBRARY_PATH=%\>;LIBRARY_PATH%%\DJDIR%\lib
+# BUTT=-m486
+# - - - - -
+# Alternately, these variables may be defined below, overriding the values
+# in djgpp.env, as
+# INCLUDE_PATH=c:\usr\include
+# LIBRARY_PATH=c:\usr\lib
+
+CC=gcc
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+ -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f." If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lz
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=libz.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
+ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
+
+OBJA =
+# to use the asm code: make OBJA=match.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+check: test
+test: all
+ ./example
+ echo hello world | .\minigzip | .\minigzip -d
+
+%.o : %.c
+ $(CC) $(CFLAGS) -c $< -o $@
+
+libz.a: $(OBJS) $(OBJA)
+ $(AR) $@ $(OBJS) $(OBJA)
+
+%.exe : %.o $(LIBS)
+ $(LD) $@ $< $(LDLIBS)
+
+# INCLUDE_PATH and LIBRARY_PATH were set for [make] in djgpp.env .
+
+.PHONY : uninstall clean
+
+install: $(INCL) $(LIBS)
+ -@if not exist $(INCLUDE_PATH)\nul mkdir $(INCLUDE_PATH)
+ -@if not exist $(LIBRARY_PATH)\nul mkdir $(LIBRARY_PATH)
+ $(INSTALL) zlib.h $(INCLUDE_PATH)
+ $(INSTALL) zconf.h $(INCLUDE_PATH)
+ $(INSTALL) libz.a $(LIBRARY_PATH)
+
+uninstall:
+ $(RM) $(INCLUDE_PATH)\zlib.h
+ $(RM) $(INCLUDE_PATH)\zconf.h
+ $(RM) $(LIBRARY_PATH)\libz.a
+
+clean:
+ $(RM) *.d
+ $(RM) *.o
+ $(RM) *.exe
+ $(RM) libz.a
+ $(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
diff --git a/compat/zlib/msdos/Makefile.emx b/compat/zlib/msdos/Makefile.emx
new file mode 100644
index 0000000..9c1b57a
--- /dev/null
+++ b/compat/zlib/msdos/Makefile.emx
@@ -0,0 +1,69 @@
+# Makefile for zlib. Modified for emx 0.9c by Chr. Spieler, 6/17/98.
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h
+
+# To compile, or to compile and test, type:
+#
+# make -fmakefile.emx; make test -fmakefile.emx
+#
+
+CC=gcc
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+ -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f." If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lzlib
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=zlib.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
+ uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+test: all
+ ./example
+ echo hello world | .\minigzip | .\minigzip -d
+
+%.o : %.c
+ $(CC) $(CFLAGS) -c $< -o $@
+
+zlib.a: $(OBJS)
+ $(AR) $@ $(OBJS)
+
+%.exe : %.o $(LIBS)
+ $(LD) $@ $< $(LDLIBS)
+
+
+.PHONY : clean
+
+clean:
+ $(RM) *.d
+ $(RM) *.o
+ $(RM) *.exe
+ $(RM) zlib.a
+ $(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
diff --git a/compat/zlib/msdos/Makefile.msc b/compat/zlib/msdos/Makefile.msc
new file mode 100644
index 0000000..ae83786
--- /dev/null
+++ b/compat/zlib/msdos/Makefile.msc
@@ -0,0 +1,112 @@
+# Makefile for zlib
+# Microsoft C 5.1 or later
+# Last updated: 19-Mar-2003
+
+# To use, do "make makefile.msc"
+# To compile in small model, set below: MODEL=S
+
+# If you wish to reduce the memory requirements (default 256K for big
+# objects plus a few K), you can add to the LOC macro below:
+# -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
+# See zconf.h for details about the memory requirements.
+
+# ------------- Microsoft C 5.1 and later -------------
+
+# Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
+# should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added
+# to the declaration of LOC here:
+LOC = $(LOCAL_ZLIB)
+
+# Type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc.
+CPU_TYP = 0
+
+# Memory model: one of S, M, C, L (small, medium, compact, large)
+MODEL=L
+
+CC=cl
+CFLAGS=-nologo -A$(MODEL) -G$(CPU_TYP) -W3 -Oait -Gs $(LOC)
+#-Ox generates bad code with MSC 5.1
+LIB_CFLAGS=-Zl $(CFLAGS)
+
+LD=link
+LDFLAGS=/noi/e/st:0x1500/noe/farcall/packcode
+# "/farcall/packcode" are only useful for `large code' memory models
+# but should be a "no-op" for small code models.
+
+
+# variables
+ZLIB_LIB = zlib_$(MODEL).lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(LIB_CFLAGS) $*.c
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.c zlib.h zconf.h
+ $(CC) -c $(CFLAGS) $*.c
+
+minigzip.obj: test/minigzip.c zlib.h zconf.h
+ $(CC) -c $(CFLAGS) $*.c
+
+
+# the command line is cut to fit in the MS-DOS 128 byte limit:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2)
+ if exist $(ZLIB_LIB) del $(ZLIB_LIB)
+ lib $(ZLIB_LIB) $(OBJ1);
+ lib $(ZLIB_LIB) $(OBJ2);
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj,,,$(ZLIB_LIB);
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj,,,$(ZLIB_LIB);
+
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+clean:
+ -del *.obj
+ -del *.lib
+ -del *.exe
+ -del *.map
+ -del zlib_*.bak
+ -del foo.gz
diff --git a/compat/zlib/msdos/Makefile.tc b/compat/zlib/msdos/Makefile.tc
new file mode 100644
index 0000000..5aec82a
--- /dev/null
+++ b/compat/zlib/msdos/Makefile.tc
@@ -0,0 +1,100 @@
+# Makefile for zlib
+# Turbo C 2.01, Turbo C++ 1.01
+# Last updated: 15-Mar-2003
+
+# To use, do "make -fmakefile.tc"
+# To compile in small model, set below: MODEL=s
+
+# WARNING: the small model is supported but only for small values of
+# MAX_WBITS and MAX_MEM_LEVEL. For example:
+# -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3
+# If you wish to reduce the memory requirements (default 256K for big
+# objects plus a few K), you can add to CFLAGS below:
+# -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
+# See zconf.h for details about the memory requirements.
+
+# ------------ Turbo C 2.01, Turbo C++ 1.01 ------------
+MODEL=l
+CC=tcc
+LD=tcc
+AR=tlib
+# CFLAGS=-O2 -G -Z -m$(MODEL) -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3
+CFLAGS=-O2 -G -Z -m$(MODEL)
+LDFLAGS=-m$(MODEL) -f-
+
+
+# variables
+ZLIB_LIB = zlib_$(MODEL).lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
+OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(CFLAGS) $*.c
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.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:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2)
+ -del $(ZLIB_LIB)
+ $(AR) $(ZLIB_LIB) $(OBJP1)
+ $(AR) $(ZLIB_LIB) $(OBJP2)
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
+
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+clean:
+ -del *.obj
+ -del *.lib
+ -del *.exe
+ -del zlib_*.bak
+ -del foo.gz
diff --git a/compat/zlib/nintendods/Makefile b/compat/zlib/nintendods/Makefile
new file mode 100644
index 0000000..21337d0
--- /dev/null
+++ b/compat/zlib/nintendods/Makefile
@@ -0,0 +1,126 @@
+#---------------------------------------------------------------------------------
+.SUFFIXES:
+#---------------------------------------------------------------------------------
+
+ifeq ($(strip $(DEVKITARM)),)
+$(error "Please set DEVKITARM in your environment. export DEVKITARM=<path to>devkitARM")
+endif
+
+include $(DEVKITARM)/ds_rules
+
+#---------------------------------------------------------------------------------
+# TARGET is the name of the output
+# BUILD is the directory where object files & intermediate files will be placed
+# SOURCES is a list of directories containing source code
+# DATA is a list of directories containing data files
+# INCLUDES is a list of directories containing header files
+#---------------------------------------------------------------------------------
+TARGET := $(shell basename $(CURDIR))
+BUILD := build
+SOURCES := ../../
+DATA := data
+INCLUDES := include
+
+#---------------------------------------------------------------------------------
+# options for code generation
+#---------------------------------------------------------------------------------
+ARCH := -mthumb -mthumb-interwork
+
+CFLAGS := -Wall -O2\
+ -march=armv5te -mtune=arm946e-s \
+ -fomit-frame-pointer -ffast-math \
+ $(ARCH)
+
+CFLAGS += $(INCLUDE) -DARM9
+CXXFLAGS := $(CFLAGS) -fno-rtti -fno-exceptions
+
+ASFLAGS := $(ARCH) -march=armv5te -mtune=arm946e-s
+LDFLAGS = -specs=ds_arm9.specs -g $(ARCH) -Wl,-Map,$(notdir $*.map)
+
+#---------------------------------------------------------------------------------
+# list of directories containing libraries, this must be the top level containing
+# include and lib
+#---------------------------------------------------------------------------------
+LIBDIRS := $(LIBNDS)
+
+#---------------------------------------------------------------------------------
+# no real need to edit anything past this point unless you need to add additional
+# rules for different file extensions
+#---------------------------------------------------------------------------------
+ifneq ($(BUILD),$(notdir $(CURDIR)))
+#---------------------------------------------------------------------------------
+
+export OUTPUT := $(CURDIR)/lib/libz.a
+
+export VPATH := $(foreach dir,$(SOURCES),$(CURDIR)/$(dir)) \
+ $(foreach dir,$(DATA),$(CURDIR)/$(dir))
+
+export DEPSDIR := $(CURDIR)/$(BUILD)
+
+CFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.c)))
+CPPFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.cpp)))
+SFILES := $(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.s)))
+BINFILES := $(foreach dir,$(DATA),$(notdir $(wildcard $(dir)/*.*)))
+
+#---------------------------------------------------------------------------------
+# use CXX for linking C++ projects, CC for standard C
+#---------------------------------------------------------------------------------
+ifeq ($(strip $(CPPFILES)),)
+#---------------------------------------------------------------------------------
+ export LD := $(CC)
+#---------------------------------------------------------------------------------
+else
+#---------------------------------------------------------------------------------
+ export LD := $(CXX)
+#---------------------------------------------------------------------------------
+endif
+#---------------------------------------------------------------------------------
+
+export OFILES := $(addsuffix .o,$(BINFILES)) \
+ $(CPPFILES:.cpp=.o) $(CFILES:.c=.o) $(SFILES:.s=.o)
+
+export INCLUDE := $(foreach dir,$(INCLUDES),-I$(CURDIR)/$(dir)) \
+ $(foreach dir,$(LIBDIRS),-I$(dir)/include) \
+ -I$(CURDIR)/$(BUILD)
+
+.PHONY: $(BUILD) clean all
+
+#---------------------------------------------------------------------------------
+all: $(BUILD)
+ @[ -d $@ ] || mkdir -p include
+ @cp ../../*.h include
+
+lib:
+ @[ -d $@ ] || mkdir -p $@
+
+$(BUILD): lib
+ @[ -d $@ ] || mkdir -p $@
+ @$(MAKE) --no-print-directory -C $(BUILD) -f $(CURDIR)/Makefile
+
+#---------------------------------------------------------------------------------
+clean:
+ @echo clean ...
+ @rm -fr $(BUILD) lib
+
+#---------------------------------------------------------------------------------
+else
+
+DEPENDS := $(OFILES:.o=.d)
+
+#---------------------------------------------------------------------------------
+# main targets
+#---------------------------------------------------------------------------------
+$(OUTPUT) : $(OFILES)
+
+#---------------------------------------------------------------------------------
+%.bin.o : %.bin
+#---------------------------------------------------------------------------------
+ @echo $(notdir $<)
+ @$(bin2o)
+
+
+-include $(DEPENDS)
+
+#---------------------------------------------------------------------------------------
+endif
+#---------------------------------------------------------------------------------------
diff --git a/compat/zlib/nintendods/README b/compat/zlib/nintendods/README
new file mode 100644
index 0000000..ba7a37d
--- /dev/null
+++ b/compat/zlib/nintendods/README
@@ -0,0 +1,5 @@
+This Makefile requires devkitARM (http://www.devkitpro.org/category/devkitarm/) and works inside "contrib/nds". It is based on a devkitARM template.
+
+Eduardo Costa <eduardo.m.costa@gmail.com>
+January 3, 2009
+
diff --git a/compat/zlib/old/Makefile.emx b/compat/zlib/old/Makefile.emx
new file mode 100644
index 0000000..4d6ab0e
--- /dev/null
+++ b/compat/zlib/old/Makefile.emx
@@ -0,0 +1,69 @@
+# Makefile for zlib. Modified for emx/rsxnt by Chr. Spieler, 6/16/98.
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h
+
+# To compile, or to compile and test, type:
+#
+# make -fmakefile.emx; make test -fmakefile.emx
+#
+
+CC=gcc -Zwin32
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+ -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f." If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lzlib
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=zlib.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = 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
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+test: all
+ ./example
+ echo hello world | .\minigzip | .\minigzip -d
+
+%.o : %.c
+ $(CC) $(CFLAGS) -c $< -o $@
+
+zlib.a: $(OBJS)
+ $(AR) $@ $(OBJS)
+
+%.exe : %.o $(LIBS)
+ $(LD) $@ $< $(LDLIBS)
+
+
+.PHONY : clean
+
+clean:
+ $(RM) *.d
+ $(RM) *.o
+ $(RM) *.exe
+ $(RM) zlib.a
+ $(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
diff --git a/compat/zlib/old/Makefile.riscos b/compat/zlib/old/Makefile.riscos
new file mode 100644
index 0000000..57e29d3
--- /dev/null
+++ b/compat/zlib/old/Makefile.riscos
@@ -0,0 +1,151 @@
+# Project: zlib_1_03
+# Patched for zlib 1.1.2 rw@shadow.org.uk 19980430
+# test works out-of-the-box, installs `somewhere' on demand
+
+# Toolflags:
+CCflags = -c -depend !Depend -IC: -g -throwback -DRISCOS -fah
+C++flags = -c -depend !Depend -IC: -throwback
+Linkflags = -aif -c++ -o $@
+ObjAsmflags = -throwback -NoCache -depend !Depend
+CMHGflags =
+LibFileflags = -c -l -o $@
+Squeezeflags = -o $@
+
+# change the line below to where _you_ want the library installed.
+libdest = lib:zlib
+
+# Final targets:
+@.lib: @.o.adler32 @.o.compress @.o.crc32 @.o.deflate @.o.gzio \
+ @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil @.o.trees \
+ @.o.uncompr @.o.zutil
+ LibFile $(LibFileflags) @.o.adler32 @.o.compress @.o.crc32 @.o.deflate \
+ @.o.gzio @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil \
+ @.o.trees @.o.uncompr @.o.zutil
+test: @.minigzip @.example @.lib
+ @copy @.lib @.libc A~C~DF~L~N~P~Q~RS~TV
+ @echo running tests: hang on.
+ @/@.minigzip -f -9 libc
+ @/@.minigzip -d libc-gz
+ @/@.minigzip -f -1 libc
+ @/@.minigzip -d libc-gz
+ @/@.minigzip -h -9 libc
+ @/@.minigzip -d libc-gz
+ @/@.minigzip -h -1 libc
+ @/@.minigzip -d libc-gz
+ @/@.minigzip -9 libc
+ @/@.minigzip -d libc-gz
+ @/@.minigzip -1 libc
+ @/@.minigzip -d libc-gz
+ @diff @.lib @.libc
+ @echo that should have reported '@.lib and @.libc identical' if you have diff.
+ @/@.example @.fred @.fred
+ @echo that will have given lots of hello!'s.
+
+@.minigzip: @.o.minigzip @.lib C:o.Stubs
+ Link $(Linkflags) @.o.minigzip @.lib C:o.Stubs
+@.example: @.o.example @.lib C:o.Stubs
+ Link $(Linkflags) @.o.example @.lib C:o.Stubs
+
+install: @.lib
+ cdir $(libdest)
+ cdir $(libdest).h
+ @copy @.h.zlib $(libdest).h.zlib A~C~DF~L~N~P~Q~RS~TV
+ @copy @.h.zconf $(libdest).h.zconf A~C~DF~L~N~P~Q~RS~TV
+ @copy @.lib $(libdest).lib A~C~DF~L~N~P~Q~RS~TV
+ @echo okay, installed zlib in $(libdest)
+
+clean:; remove @.minigzip
+ remove @.example
+ remove @.libc
+ -wipe @.o.* F~r~cV
+ remove @.fred
+
+# User-editable dependencies:
+.c.o:
+ cc $(ccflags) -o $@ $<
+
+# Static dependencies:
+
+# Dynamic dependencies:
+o.example: c.example
+o.example: h.zlib
+o.example: h.zconf
+o.minigzip: c.minigzip
+o.minigzip: h.zlib
+o.minigzip: h.zconf
+o.adler32: c.adler32
+o.adler32: h.zlib
+o.adler32: h.zconf
+o.compress: c.compress
+o.compress: h.zlib
+o.compress: h.zconf
+o.crc32: c.crc32
+o.crc32: h.zlib
+o.crc32: h.zconf
+o.deflate: c.deflate
+o.deflate: h.deflate
+o.deflate: h.zutil
+o.deflate: h.zlib
+o.deflate: h.zconf
+o.gzio: c.gzio
+o.gzio: h.zutil
+o.gzio: h.zlib
+o.gzio: h.zconf
+o.infblock: c.infblock
+o.infblock: h.zutil
+o.infblock: h.zlib
+o.infblock: h.zconf
+o.infblock: h.infblock
+o.infblock: h.inftrees
+o.infblock: h.infcodes
+o.infblock: h.infutil
+o.infcodes: c.infcodes
+o.infcodes: h.zutil
+o.infcodes: h.zlib
+o.infcodes: h.zconf
+o.infcodes: h.inftrees
+o.infcodes: h.infblock
+o.infcodes: h.infcodes
+o.infcodes: h.infutil
+o.infcodes: h.inffast
+o.inffast: c.inffast
+o.inffast: h.zutil
+o.inffast: h.zlib
+o.inffast: h.zconf
+o.inffast: h.inftrees
+o.inffast: h.infblock
+o.inffast: h.infcodes
+o.inffast: h.infutil
+o.inffast: h.inffast
+o.inflate: c.inflate
+o.inflate: h.zutil
+o.inflate: h.zlib
+o.inflate: h.zconf
+o.inflate: h.infblock
+o.inftrees: c.inftrees
+o.inftrees: h.zutil
+o.inftrees: h.zlib
+o.inftrees: h.zconf
+o.inftrees: h.inftrees
+o.inftrees: h.inffixed
+o.infutil: c.infutil
+o.infutil: h.zutil
+o.infutil: h.zlib
+o.infutil: h.zconf
+o.infutil: h.infblock
+o.infutil: h.inftrees
+o.infutil: h.infcodes
+o.infutil: h.infutil
+o.trees: c.trees
+o.trees: h.deflate
+o.trees: h.zutil
+o.trees: h.zlib
+o.trees: h.zconf
+o.trees: h.trees
+o.uncompr: c.uncompr
+o.uncompr: h.zlib
+o.uncompr: h.zconf
+o.zutil: c.zutil
+o.zutil: h.zutil
+o.zutil: h.zlib
+o.zutil: h.zconf
diff --git a/compat/zlib/old/README b/compat/zlib/old/README
new file mode 100644
index 0000000..800bf07
--- /dev/null
+++ b/compat/zlib/old/README
@@ -0,0 +1,3 @@
+This directory contains files that have not been updated for zlib 1.2.x
+
+(Volunteers are encouraged to help clean this up. Thanks.)
diff --git a/compat/zlib/old/descrip.mms b/compat/zlib/old/descrip.mms
new file mode 100644
index 0000000..7066da5
--- /dev/null
+++ b/compat/zlib/old/descrip.mms
@@ -0,0 +1,48 @@
+# descrip.mms: MMS description file for building zlib on VMS
+# written by Martin P.J. Zinser <m.zinser@gsi.de>
+
+cc_defs =
+c_deb =
+
+.ifdef __DECC__
+pref = /prefix=all
+.endif
+
+OBJS = adler32.obj, compress.obj, crc32.obj, gzio.obj, uncompr.obj,\
+ deflate.obj, trees.obj, zutil.obj, inflate.obj, infblock.obj,\
+ inftrees.obj, infcodes.obj, infutil.obj, inffast.obj
+
+CFLAGS= $(C_DEB) $(CC_DEFS) $(PREF)
+
+all : example.exe minigzip.exe
+ @ write sys$output " Example applications available"
+libz.olb : libz.olb($(OBJS))
+ @ write sys$output " libz available"
+
+example.exe : example.obj libz.olb
+ link example,libz.olb/lib
+
+minigzip.exe : minigzip.obj libz.olb
+ link minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib
+
+clean :
+ delete *.obj;*,libz.olb;*
+
+
+# Other dependencies.
+adler32.obj : zutil.h zlib.h zconf.h
+compress.obj : zlib.h zconf.h
+crc32.obj : zutil.h zlib.h zconf.h
+deflate.obj : deflate.h zutil.h zlib.h zconf.h
+example.obj : zlib.h zconf.h
+gzio.obj : zutil.h zlib.h zconf.h
+infblock.obj : zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h
+infcodes.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h infcodes.h inffast.h
+inffast.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h inffast.h
+inflate.obj : zutil.h zlib.h zconf.h infblock.h
+inftrees.obj : zutil.h zlib.h zconf.h inftrees.h
+infutil.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h
+minigzip.obj : zlib.h zconf.h
+trees.obj : deflate.h zutil.h zlib.h zconf.h
+uncompr.obj : zlib.h zconf.h
+zutil.obj : zutil.h zlib.h zconf.h
diff --git a/compat/zlib/old/os2/Makefile.os2 b/compat/zlib/old/os2/Makefile.os2
new file mode 100644
index 0000000..a105aaa
--- /dev/null
+++ b/compat/zlib/old/os2/Makefile.os2
@@ -0,0 +1,136 @@
+# Makefile for zlib under OS/2 using GCC (PGCC)
+# For conditions of distribution and use, see copyright notice in zlib.h
+
+# To compile and test, type:
+# cp Makefile.os2 ..
+# cd ..
+# make -f Makefile.os2 test
+
+# This makefile will build a static library z.lib, a shared library
+# z.dll and a import library zdll.lib. You can use either z.lib or
+# zdll.lib by specifying either -lz or -lzdll on gcc's command line
+
+CC=gcc -Zomf -s
+
+CFLAGS=-O6 -Wall
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-g -DDEBUG
+#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+# -Wstrict-prototypes -Wmissing-prototypes
+
+#################### BUG WARNING: #####################
+## infcodes.c hits a bug in pgcc-1.0, so you have to use either
+## -O# where # <= 4 or one of (-fno-ommit-frame-pointer or -fno-force-mem)
+## This bug is reportedly fixed in pgcc >1.0, but this was not tested
+CFLAGS+=-fno-force-mem
+
+LDFLAGS=-s -L. -lzdll -Zcrtdll
+LDSHARED=$(CC) -s -Zomf -Zdll -Zcrtdll
+
+VER=1.1.0
+ZLIB=z.lib
+SHAREDLIB=z.dll
+SHAREDLIBIMP=zdll.lib
+LIBS=$(ZLIB) $(SHAREDLIB) $(SHAREDLIBIMP)
+
+AR=emxomfar cr
+IMPLIB=emximp
+RANLIB=echo
+TAR=tar
+SHELL=bash
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
+ zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+DISTFILES = README INDEX ChangeLog configure Make*[a-z0-9] *.[ch] descrip.mms \
+ algorithm.txt zlib.3 msdos/Make*[a-z0-9] msdos/zlib.def msdos/zlib.rc \
+ nt/Makefile.nt nt/zlib.dnt contrib/README.contrib contrib/*.txt \
+ contrib/asm386/*.asm contrib/asm386/*.c \
+ contrib/asm386/*.bat contrib/asm386/zlibvc.d?? contrib/iostream/*.cpp \
+ contrib/iostream/*.h contrib/iostream2/*.h contrib/iostream2/*.cpp \
+ contrib/untgz/Makefile contrib/untgz/*.c contrib/untgz/*.w32
+
+all: example.exe minigzip.exe
+
+test: all
+ @LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
+ echo hello world | ./minigzip | ./minigzip -d || \
+ echo ' *** minigzip test FAILED ***' ; \
+ if ./example; then \
+ echo ' *** zlib test OK ***'; \
+ else \
+ echo ' *** zlib test FAILED ***'; \
+ fi
+
+$(ZLIB): $(OBJS)
+ $(AR) $@ $(OBJS)
+ -@ ($(RANLIB) $@ || true) >/dev/null 2>&1
+
+$(SHAREDLIB): $(OBJS) os2/z.def
+ $(LDSHARED) -o $@ $^
+
+$(SHAREDLIBIMP): os2/z.def
+ $(IMPLIB) -o $@ $^
+
+example.exe: example.o $(LIBS)
+ $(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS)
+
+minigzip.exe: minigzip.o $(LIBS)
+ $(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS)
+
+clean:
+ rm -f *.o *~ example minigzip libz.a libz.so* foo.gz
+
+distclean: clean
+
+zip:
+ mv Makefile Makefile~; cp -p Makefile.in Makefile
+ rm -f test.c ztest*.c
+ v=`sed -n -e 's/\.//g' -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
+ zip -ul9 zlib$$v $(DISTFILES)
+ mv Makefile~ Makefile
+
+dist:
+ mv Makefile Makefile~; cp -p Makefile.in Makefile
+ rm -f test.c ztest*.c
+ d=zlib-`sed -n '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
+ rm -f $$d.tar.gz; \
+ if test ! -d ../$$d; then rm -f ../$$d; ln -s `pwd` ../$$d; fi; \
+ files=""; \
+ for f in $(DISTFILES); do files="$$files $$d/$$f"; done; \
+ cd ..; \
+ GZIP=-9 $(TAR) chofz $$d/$$d.tar.gz $$files; \
+ if test ! -d $$d; then rm -f $$d; fi
+ mv Makefile~ Makefile
+
+tags:
+ etags *.[ch]
+
+depend:
+ makedepend -- $(CFLAGS) -- *.[ch]
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+adler32.o: zlib.h zconf.h
+compress.o: zlib.h zconf.h
+crc32.o: zlib.h zconf.h
+deflate.o: deflate.h zutil.h zlib.h zconf.h
+example.o: zlib.h zconf.h
+gzio.o: zutil.h zlib.h zconf.h
+infblock.o: infblock.h inftrees.h infcodes.h infutil.h zutil.h zlib.h zconf.h
+infcodes.o: zutil.h zlib.h zconf.h
+infcodes.o: inftrees.h infblock.h infcodes.h infutil.h inffast.h
+inffast.o: zutil.h zlib.h zconf.h inftrees.h
+inffast.o: infblock.h infcodes.h infutil.h inffast.h
+inflate.o: zutil.h zlib.h zconf.h infblock.h
+inftrees.o: zutil.h zlib.h zconf.h inftrees.h
+infutil.o: zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.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/old/os2/zlib.def b/compat/zlib/old/os2/zlib.def
new file mode 100644
index 0000000..4c753f1
--- /dev/null
+++ b/compat/zlib/old/os2/zlib.def
@@ -0,0 +1,51 @@
+;
+; Slightly modified version of ../nt/zlib.dnt :-)
+;
+
+LIBRARY Z
+DESCRIPTION "Zlib compression library for OS/2"
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+
+EXPORTS
+ adler32
+ compress
+ crc32
+ deflate
+ deflateCopy
+ deflateEnd
+ deflateInit2_
+ deflateInit_
+ deflateParams
+ deflateReset
+ deflateSetDictionary
+ gzclose
+ gzdopen
+ gzerror
+ gzflush
+ gzopen
+ gzread
+ gzwrite
+ inflate
+ inflateEnd
+ inflateInit2_
+ inflateInit_
+ inflateReset
+ inflateSetDictionary
+ inflateSync
+ uncompress
+ zlibVersion
+ gzprintf
+ gzputc
+ gzgetc
+ gzseek
+ gzrewind
+ gztell
+ gzeof
+ gzsetparams
+ zError
+ inflateSyncPoint
+ get_crc_table
+ compress2
+ gzputs
+ gzgets
diff --git a/compat/zlib/old/visual-basic.txt b/compat/zlib/old/visual-basic.txt
new file mode 100644
index 0000000..57efe58
--- /dev/null
+++ b/compat/zlib/old/visual-basic.txt
@@ -0,0 +1,160 @@
+See below some functions declarations for Visual Basic.
+
+Frequently Asked Question:
+
+Q: Each time I use the compress function I get the -5 error (not enough
+ room in the output buffer).
+
+A: Make sure that the length of the compressed buffer is passed by
+ reference ("as any"), not by value ("as long"). Also check that
+ before the call of compress this length is equal to the total size of
+ the compressed buffer and not zero.
+
+
+From: "Jon Caruana" <jon-net@usa.net>
+Subject: Re: How to port zlib declares to vb?
+Date: Mon, 28 Oct 1996 18:33:03 -0600
+
+Got the answer! (I haven't had time to check this but it's what I got, and
+looks correct):
+
+He has the following routines working:
+ compress
+ uncompress
+ gzopen
+ gzwrite
+ gzread
+ gzclose
+
+Declares follow: (Quoted from Carlos Rios <c_rios@sonda.cl>, in Vb4 form)
+
+#If Win16 Then 'Use Win16 calls.
+Declare Function compress Lib "ZLIB.DLL" (ByVal compr As
+ String, comprLen As Any, ByVal buf As String, ByVal buflen
+ As Long) As Integer
+Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr
+ As String, uncomprLen As Any, ByVal compr As String, ByVal
+ lcompr As Long) As Integer
+Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As
+ String, ByVal mode As String) As Long
+Declare Function gzread Lib "ZLIB.DLL" (ByVal file As
+ Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
+ As Integer
+Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As
+ Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
+ As Integer
+Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As
+ Long) As Integer
+#Else
+Declare Function compress Lib "ZLIB32.DLL"
+ (ByVal compr As String, comprLen As Any, ByVal buf As
+ String, ByVal buflen As Long) As Integer
+Declare Function uncompress Lib "ZLIB32.DLL"
+ (ByVal uncompr As String, uncomprLen As Any, ByVal compr As
+ String, ByVal lcompr As Long) As Long
+Declare Function gzopen Lib "ZLIB32.DLL"
+ (ByVal file As String, ByVal mode As String) As Long
+Declare Function gzread Lib "ZLIB32.DLL"
+ (ByVal file As Long, ByVal uncompr As String, ByVal
+ uncomprLen As Long) As Long
+Declare Function gzwrite Lib "ZLIB32.DLL"
+ (ByVal file As Long, ByVal uncompr As String, ByVal
+ uncomprLen As Long) As Long
+Declare Function gzclose Lib "ZLIB32.DLL"
+ (ByVal file As Long) As Long
+#End If
+
+-Jon Caruana
+jon-net@usa.net
+Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member
+
+
+Here is another example from Michael <michael_borgsys@hotmail.com> that he
+says conforms to the VB guidelines, and that solves the problem of not
+knowing the uncompressed size by storing it at the end of the file:
+
+'Calling the functions:
+'bracket meaning: <parameter> [optional] {Range of possible values}
+'Call subCompressFile(<path with filename to compress> [, <path with
+filename to write to>, [level of compression {1..9}]])
+'Call subUncompressFile(<path with filename to compress>)
+
+Option Explicit
+Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'
+Private Const SUCCESS As Long = 0
+Private Const strFilExt As String = ".cpr"
+Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef
+dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,
+ByVal level As Integer) As Long
+Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef
+dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)
+As Long
+
+Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal
+strargCprFilPth As String, Optional ByVal intLvl As Integer = 9)
+ Dim strCprPth As String
+ Dim lngOriSiz As Long
+ Dim lngCprSiz As Long
+ Dim bytaryOri() As Byte
+ Dim bytaryCpr() As Byte
+ lngOriSiz = FileLen(strargOriFilPth)
+ ReDim bytaryOri(lngOriSiz - 1)
+ Open strargOriFilPth For Binary Access Read As #1
+ Get #1, , bytaryOri()
+ Close #1
+ strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth)
+'Select file path and name
+ strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) =
+strFilExt, "", strFilExt) 'Add file extension if not exists
+ lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit
+more space then original file size
+ ReDim bytaryCpr(lngCprSiz - 1)
+ If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =
+SUCCESS Then
+ lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100
+ ReDim Preserve bytaryCpr(lngCprSiz - 1)
+ Open strCprPth For Binary Access Write As #1
+ Put #1, , bytaryCpr()
+ Put #1, , lngOriSiz 'Add the the original size value to the end
+(last 4 bytes)
+ Close #1
+ Else
+ MsgBox "Compression error"
+ End If
+ Erase bytaryCpr
+ Erase bytaryOri
+End Sub
+
+Public Sub subUncompressFile(ByVal strargFilPth As String)
+ Dim bytaryCpr() As Byte
+ Dim bytaryOri() As Byte
+ Dim lngOriSiz As Long
+ Dim lngCprSiz As Long
+ Dim strOriPth As String
+ lngCprSiz = FileLen(strargFilPth)
+ ReDim bytaryCpr(lngCprSiz - 1)
+ Open strargFilPth For Binary Access Read As #1
+ Get #1, , bytaryCpr()
+ Close #1
+ 'Read the original file size value:
+ lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _
+ + bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _
+ + bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _
+ + bytaryCpr(lngCprSiz - 4)
+ ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value
+ ReDim bytaryOri(lngOriSiz - 1)
+ If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS
+Then
+ strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt))
+ Open strOriPth For Binary Access Write As #1
+ Put #1, , bytaryOri()
+ Close #1
+ Else
+ MsgBox "Uncompression error"
+ End If
+ Erase bytaryCpr
+ Erase bytaryOri
+End Sub
+Public Property Get lngPercentSmaller() As Long
+ lngPercentSmaller = lngpvtPcnSml
+End Property
diff --git a/compat/zlib/qnx/package.qpg b/compat/zlib/qnx/package.qpg
new file mode 100644
index 0000000..aebf6e3
--- /dev/null
+++ b/compat/zlib/qnx/package.qpg
@@ -0,0 +1,141 @@
+<QPG:Generation>
+ <QPG:Options>
+ <QPG:User unattended="no" verbosity="2" listfiles="yes"/>
+ <QPG:Defaults type="qnx_package"/>
+ <QPG:Source></QPG:Source>
+ <QPG:Release number="+"/>
+ <QPG:Build></QPG:Build>
+ <QPG:FileSorting strip="yes"/>
+ <QPG:Package targets="combine"/>
+ <QPG:Repository generate="yes"/>
+ <QPG:FinalDir></QPG:FinalDir>
+ <QPG:Cleanup></QPG:Cleanup>
+ </QPG:Options>
+
+ <QPG:Responsible>
+ <QPG:Company></QPG:Company>
+ <QPG:Department></QPG:Department>
+ <QPG:Group></QPG:Group>
+ <QPG:Team></QPG:Team>
+ <QPG:Employee></QPG:Employee>
+ <QPG:EmailAddress></QPG:EmailAddress>
+ </QPG:Responsible>
+
+ <QPG:Values>
+ <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.8" 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.8"/>
+ <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.8"/>
+ <QPG:Add file="../libz.so.1.2.8" install="/opt/lib/" component="slib"/>
+ </QPG:Files>
+
+ <QPG:PackageFilter>
+ <QPM:PackageManifest>
+ <QPM:PackageDescription>
+ <QPM:PackageType>Library</QPM:PackageType>
+ <QPM:PackageReleaseNotes></QPM:PackageReleaseNotes>
+ <QPM:PackageReleaseUrgency>Medium</QPM:PackageReleaseUrgency>
+ <QPM:PackageRepository></QPM:PackageRepository>
+ <QPM:FileVersion>2.0</QPM:FileVersion>
+ </QPM:PackageDescription>
+
+ <QPM:ProductDescription>
+ <QPM:ProductName>zlib</QPM:ProductName>
+ <QPM:ProductIdentifier>zlib</QPM:ProductIdentifier>
+ <QPM:ProductEmail>alain.bonnefoy@icbt.com</QPM:ProductEmail>
+ <QPM:VendorName>Public</QPM:VendorName>
+ <QPM:VendorInstallName>public</QPM:VendorInstallName>
+ <QPM:VendorURL>www.gzip.org/zlib</QPM:VendorURL>
+ <QPM:VendorEmbedURL></QPM:VendorEmbedURL>
+ <QPM:VendorEmail></QPM:VendorEmail>
+ <QPM:AuthorName>Jean-Loup Gailly,Mark Adler</QPM:AuthorName>
+ <QPM:AuthorURL>www.gzip.org/zlib</QPM:AuthorURL>
+ <QPM:AuthorEmbedURL></QPM:AuthorEmbedURL>
+ <QPM:AuthorEmail>zlib@gzip.org</QPM:AuthorEmail>
+ <QPM:ProductIconSmall></QPM:ProductIconSmall>
+ <QPM:ProductIconLarge></QPM:ProductIconLarge>
+ <QPM:ProductDescriptionShort>A massively spiffy yet delicately unobtrusive compression library.</QPM:ProductDescriptionShort>
+ <QPM:ProductDescriptionLong>zlib is designed to be a free, general-purpose, legally unencumbered, lossless data compression library for use on virtually any computer hardware and operating system.</QPM:ProductDescriptionLong>
+ <QPM:ProductDescriptionURL>http://www.gzip.org/zlib</QPM:ProductDescriptionURL>
+ <QPM:ProductDescriptionEmbedURL></QPM:ProductDescriptionEmbedURL>
+ </QPM:ProductDescription>
+
+ <QPM:ReleaseDescription>
+ <QPM:ReleaseVersion>1.2.8</QPM:ReleaseVersion>
+ <QPM:ReleaseUrgency>Medium</QPM:ReleaseUrgency>
+ <QPM:ReleaseStability>Stable</QPM:ReleaseStability>
+ <QPM:ReleaseNoteMinor></QPM:ReleaseNoteMinor>
+ <QPM:ReleaseNoteMajor></QPM:ReleaseNoteMajor>
+ <QPM:ExcludeCountries>
+ <QPM:Country></QPM:Country>
+ </QPM:ExcludeCountries>
+
+ <QPM:ReleaseCopyright>No License</QPM:ReleaseCopyright>
+ </QPM:ReleaseDescription>
+
+ <QPM:ContentDescription>
+ <QPM:ContentTopic xmlmultiple="true">Software Development/Libraries and Extensions/C Libraries</QPM:ContentTopic>
+ <QPM:ContentKeyword>zlib,compression</QPM:ContentKeyword>
+ <QPM:TargetOS>qnx6</QPM:TargetOS>
+ <QPM:HostOS>qnx6</QPM:HostOS>
+ <QPM:DisplayEnvironment xmlmultiple="true">None</QPM:DisplayEnvironment>
+ <QPM:TargetAudience xmlmultiple="true">Developer</QPM:TargetAudience>
+ </QPM:ContentDescription>
+ </QPM:PackageManifest>
+ </QPG:PackageFilter>
+
+ <QPG:PackageFilter proc="none" target="none">
+ <QPM:PackageManifest>
+ <QPM:ProductInstallationDependencies>
+ <QPM:ProductRequirements></QPM:ProductRequirements>
+ </QPM:ProductInstallationDependencies>
+
+ <QPM:ProductInstallationProcedure>
+ <QPM:Script xmlmultiple="true">
+ <QPM:ScriptName></QPM:ScriptName>
+ <QPM:ScriptType>Install</QPM:ScriptType>
+ <QPM:ScriptTiming>Post</QPM:ScriptTiming>
+ <QPM:ScriptBlocking>No</QPM:ScriptBlocking>
+ <QPM:ScriptResult>Ignore</QPM:ScriptResult>
+ <QPM:ShortDescription></QPM:ShortDescription>
+ <QPM:UseBinaries>No</QPM:UseBinaries>
+ <QPM:Priority>Optional</QPM:Priority>
+ </QPM:Script>
+ </QPM:ProductInstallationProcedure>
+ </QPM:PackageManifest>
+
+ <QPM:Launch>
+ </QPM:Launch>
+ </QPG:PackageFilter>
+
+ <QPG:PackageFilter type="core" component="none">
+ <QPM:PackageManifest>
+ <QPM:ProductInstallationProcedure>
+ <QPM:OrderDependency xmlmultiple="true">
+ <QPM:Order>InstallOver</QPM:Order>
+ <QPM:Product>zlib</QPM:Product>
+ </QPM:OrderDependency>
+ </QPM:ProductInstallationProcedure>
+ </QPM:PackageManifest>
+
+ <QPM:Launch>
+ </QPM:Launch>
+ </QPG:PackageFilter>
+
+ <QPG:PackageFilter type="core" component="dev">
+ <QPM:PackageManifest>
+ <QPM:ProductInstallationProcedure>
+ <QPM:OrderDependency xmlmultiple="true">
+ <QPM:Order>InstallOver</QPM:Order>
+ <QPM:Product>zlib-dev</QPM:Product>
+ </QPM:OrderDependency>
+ </QPM:ProductInstallationProcedure>
+ </QPM:PackageManifest>
+
+ <QPM:Launch>
+ </QPM:Launch>
+ </QPG:PackageFilter>
+ </QPG:Values>
+</QPG:Generation>
diff --git a/compat/zlib/test/example.c b/compat/zlib/test/example.c
new file mode 100644
index 0000000..138a699
--- /dev/null
+++ b/compat/zlib/test/example.c
@@ -0,0 +1,601 @@
+/* example.c -- usage example of the zlib compression library
+ * Copyright (C) 1995-2006, 2011 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#include "zlib.h"
+#include <stdio.h>
+
+#ifdef STDC
+# include <string.h>
+# include <stdlib.h>
+#endif
+
+#if defined(VMS) || defined(RISCOS)
+# define TESTFILE "foo-gz"
+#else
+# define TESTFILE "foo.gz"
+#endif
+
+#define CHECK_ERR(err, msg) { \
+ if (err != Z_OK) { \
+ fprintf(stderr, "%s error: %d\n", msg, err); \
+ exit(1); \
+ } \
+}
+
+z_const char hello[] = "hello, hello!";
+/* "hello world" would be more standard, but the repeated "hello"
+ * stresses the compression code better, sorry...
+ */
+
+const char dictionary[] = "hello";
+uLong dictId; /* Adler32 value of the dictionary */
+
+void test_deflate OF((Byte *compr, uLong comprLen));
+void test_inflate OF((Byte *compr, uLong comprLen,
+ Byte *uncompr, uLong uncomprLen));
+void test_large_deflate OF((Byte *compr, uLong comprLen,
+ Byte *uncompr, uLong uncomprLen));
+void test_large_inflate OF((Byte *compr, uLong comprLen,
+ Byte *uncompr, uLong uncomprLen));
+void test_flush OF((Byte *compr, uLong *comprLen));
+void test_sync OF((Byte *compr, uLong comprLen,
+ Byte *uncompr, uLong uncomprLen));
+void test_dict_deflate OF((Byte *compr, uLong comprLen));
+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()
+ */
+void test_compress(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ int err;
+ uLong len = (uLong)strlen(hello)+1;
+
+ err = compress(compr, &comprLen, (const Bytef*)hello, len);
+ CHECK_ERR(err, "compress");
+
+ strcpy((char*)uncompr, "garbage");
+
+ err = uncompress(uncompr, &uncomprLen, compr, comprLen);
+ CHECK_ERR(err, "uncompress");
+
+ if (strcmp((char*)uncompr, hello)) {
+ fprintf(stderr, "bad uncompress\n");
+ exit(1);
+ } else {
+ printf("uncompress(): %s\n", (char *)uncompr);
+ }
+}
+
+/* ===========================================================================
+ * Test read/write of .gz files
+ */
+void test_gzio(fname, uncompr, uncomprLen)
+ const char *fname; /* compressed file name */
+ Byte *uncompr;
+ uLong uncomprLen;
+{
+#ifdef NO_GZCOMPRESS
+ fprintf(stderr, "NO_GZCOMPRESS -- gz* functions cannot compress\n");
+#else
+ int err;
+ int len = (int)strlen(hello)+1;
+ gzFile file;
+ z_off_t pos;
+
+ file = gzopen(fname, "wb");
+ if (file == NULL) {
+ fprintf(stderr, "gzopen error\n");
+ exit(1);
+ }
+ gzputc(file, 'h');
+ if (gzputs(file, "ello") != 4) {
+ fprintf(stderr, "gzputs err: %s\n", gzerror(file, &err));
+ exit(1);
+ }
+ if (gzprintf(file, ", %s!", "hello") != 8) {
+ fprintf(stderr, "gzprintf err: %s\n", gzerror(file, &err));
+ exit(1);
+ }
+ gzseek(file, 1L, SEEK_CUR); /* add one zero byte */
+ gzclose(file);
+
+ file = gzopen(fname, "rb");
+ if (file == NULL) {
+ fprintf(stderr, "gzopen error\n");
+ exit(1);
+ }
+ strcpy((char*)uncompr, "garbage");
+
+ if (gzread(file, uncompr, (unsigned)uncomprLen) != len) {
+ fprintf(stderr, "gzread err: %s\n", gzerror(file, &err));
+ exit(1);
+ }
+ if (strcmp((char*)uncompr, hello)) {
+ fprintf(stderr, "bad gzread: %s\n", (char*)uncompr);
+ exit(1);
+ } else {
+ printf("gzread(): %s\n", (char*)uncompr);
+ }
+
+ pos = gzseek(file, -8L, SEEK_CUR);
+ if (pos != 6 || gztell(file) != pos) {
+ fprintf(stderr, "gzseek error, pos=%ld, gztell=%ld\n",
+ (long)pos, (long)gztell(file));
+ exit(1);
+ }
+
+ if (gzgetc(file) != ' ') {
+ fprintf(stderr, "gzgetc error\n");
+ exit(1);
+ }
+
+ if (gzungetc(' ', file) != ' ') {
+ fprintf(stderr, "gzungetc error\n");
+ exit(1);
+ }
+
+ gzgets(file, (char*)uncompr, (int)uncomprLen);
+ if (strlen((char*)uncompr) != 7) { /* " hello!" */
+ fprintf(stderr, "gzgets err after gzseek: %s\n", gzerror(file, &err));
+ exit(1);
+ }
+ if (strcmp((char*)uncompr, hello + 6)) {
+ fprintf(stderr, "bad gzgets after gzseek\n");
+ exit(1);
+ } else {
+ printf("gzgets() after gzseek: %s\n", (char*)uncompr);
+ }
+
+ gzclose(file);
+#endif
+}
+
+#endif /* Z_SOLO */
+
+/* ===========================================================================
+ * Test deflate() with small buffers
+ */
+void test_deflate(compr, comprLen)
+ Byte *compr;
+ uLong comprLen;
+{
+ z_stream c_stream; /* compression stream */
+ int err;
+ uLong len = (uLong)strlen(hello)+1;
+
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
+ c_stream.opaque = (voidpf)0;
+
+ err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
+ CHECK_ERR(err, "deflateInit");
+
+ c_stream.next_in = (z_const unsigned char *)hello;
+ c_stream.next_out = compr;
+
+ while (c_stream.total_in != len && c_stream.total_out < comprLen) {
+ c_stream.avail_in = c_stream.avail_out = 1; /* force small buffers */
+ err = deflate(&c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, "deflate");
+ }
+ /* Finish the stream, still forcing small buffers: */
+ for (;;) {
+ c_stream.avail_out = 1;
+ err = deflate(&c_stream, Z_FINISH);
+ if (err == Z_STREAM_END) break;
+ CHECK_ERR(err, "deflate");
+ }
+
+ err = deflateEnd(&c_stream);
+ CHECK_ERR(err, "deflateEnd");
+}
+
+/* ===========================================================================
+ * Test inflate() with small buffers
+ */
+void test_inflate(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ int err;
+ z_stream d_stream; /* decompression stream */
+
+ strcpy((char*)uncompr, "garbage");
+
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
+ d_stream.opaque = (voidpf)0;
+
+ d_stream.next_in = compr;
+ d_stream.avail_in = 0;
+ d_stream.next_out = uncompr;
+
+ err = inflateInit(&d_stream);
+ CHECK_ERR(err, "inflateInit");
+
+ while (d_stream.total_out < uncomprLen && d_stream.total_in < comprLen) {
+ d_stream.avail_in = d_stream.avail_out = 1; /* force small buffers */
+ err = inflate(&d_stream, Z_NO_FLUSH);
+ if (err == Z_STREAM_END) break;
+ CHECK_ERR(err, "inflate");
+ }
+
+ err = inflateEnd(&d_stream);
+ CHECK_ERR(err, "inflateEnd");
+
+ if (strcmp((char*)uncompr, hello)) {
+ fprintf(stderr, "bad inflate\n");
+ exit(1);
+ } else {
+ printf("inflate(): %s\n", (char *)uncompr);
+ }
+}
+
+/* ===========================================================================
+ * Test deflate() with large buffers and dynamic change of compression level
+ */
+void test_large_deflate(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ z_stream c_stream; /* compression stream */
+ int err;
+
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
+ c_stream.opaque = (voidpf)0;
+
+ err = deflateInit(&c_stream, Z_BEST_SPEED);
+ CHECK_ERR(err, "deflateInit");
+
+ c_stream.next_out = compr;
+ c_stream.avail_out = (uInt)comprLen;
+
+ /* At this point, uncompr is still mostly zeroes, so it should compress
+ * very well:
+ */
+ c_stream.next_in = uncompr;
+ c_stream.avail_in = (uInt)uncomprLen;
+ err = deflate(&c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, "deflate");
+ if (c_stream.avail_in != 0) {
+ fprintf(stderr, "deflate not greedy\n");
+ exit(1);
+ }
+
+ /* Feed in already compressed data and switch to no compression: */
+ deflateParams(&c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
+ c_stream.next_in = compr;
+ c_stream.avail_in = (uInt)comprLen/2;
+ err = deflate(&c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, "deflate");
+
+ /* Switch back to compressing mode: */
+ deflateParams(&c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
+ c_stream.next_in = uncompr;
+ c_stream.avail_in = (uInt)uncomprLen;
+ err = deflate(&c_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, "deflate");
+
+ err = deflate(&c_stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ fprintf(stderr, "deflate should report Z_STREAM_END\n");
+ exit(1);
+ }
+ err = deflateEnd(&c_stream);
+ CHECK_ERR(err, "deflateEnd");
+}
+
+/* ===========================================================================
+ * Test inflate() with large buffers
+ */
+void test_large_inflate(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ int err;
+ z_stream d_stream; /* decompression stream */
+
+ strcpy((char*)uncompr, "garbage");
+
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
+ d_stream.opaque = (voidpf)0;
+
+ d_stream.next_in = compr;
+ d_stream.avail_in = (uInt)comprLen;
+
+ err = inflateInit(&d_stream);
+ CHECK_ERR(err, "inflateInit");
+
+ for (;;) {
+ d_stream.next_out = uncompr; /* discard the output */
+ d_stream.avail_out = (uInt)uncomprLen;
+ err = inflate(&d_stream, Z_NO_FLUSH);
+ if (err == Z_STREAM_END) break;
+ CHECK_ERR(err, "large inflate");
+ }
+
+ err = inflateEnd(&d_stream);
+ CHECK_ERR(err, "inflateEnd");
+
+ if (d_stream.total_out != 2*uncomprLen + comprLen/2) {
+ fprintf(stderr, "bad large inflate: %ld\n", d_stream.total_out);
+ exit(1);
+ } else {
+ printf("large_inflate(): OK\n");
+ }
+}
+
+/* ===========================================================================
+ * Test deflate() with full flush
+ */
+void test_flush(compr, comprLen)
+ Byte *compr;
+ uLong *comprLen;
+{
+ z_stream c_stream; /* compression stream */
+ int err;
+ uInt len = (uInt)strlen(hello)+1;
+
+ c_stream.zalloc = zalloc;
+ c_stream.zfree = zfree;
+ c_stream.opaque = (voidpf)0;
+
+ err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
+ CHECK_ERR(err, "deflateInit");
+
+ c_stream.next_in = (z_const unsigned char *)hello;
+ c_stream.next_out = compr;
+ c_stream.avail_in = 3;
+ c_stream.avail_out = (uInt)*comprLen;
+ err = deflate(&c_stream, Z_FULL_FLUSH);
+ CHECK_ERR(err, "deflate");
+
+ compr[3]++; /* force an error in first compressed block */
+ c_stream.avail_in = len - 3;
+
+ err = deflate(&c_stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ CHECK_ERR(err, "deflate");
+ }
+ err = deflateEnd(&c_stream);
+ CHECK_ERR(err, "deflateEnd");
+
+ *comprLen = c_stream.total_out;
+}
+
+/* ===========================================================================
+ * Test inflateSync()
+ */
+void test_sync(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ int err;
+ z_stream d_stream; /* decompression stream */
+
+ strcpy((char*)uncompr, "garbage");
+
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
+ d_stream.opaque = (voidpf)0;
+
+ d_stream.next_in = compr;
+ d_stream.avail_in = 2; /* just read the zlib header */
+
+ err = inflateInit(&d_stream);
+ CHECK_ERR(err, "inflateInit");
+
+ d_stream.next_out = uncompr;
+ d_stream.avail_out = (uInt)uncomprLen;
+
+ inflate(&d_stream, Z_NO_FLUSH);
+ CHECK_ERR(err, "inflate");
+
+ d_stream.avail_in = (uInt)comprLen-2; /* read all compressed data */
+ err = inflateSync(&d_stream); /* but skip the damaged part */
+ CHECK_ERR(err, "inflateSync");
+
+ err = inflate(&d_stream, Z_FINISH);
+ if (err != Z_DATA_ERROR) {
+ fprintf(stderr, "inflate should report DATA_ERROR\n");
+ /* Because of incorrect adler32 */
+ exit(1);
+ }
+ err = inflateEnd(&d_stream);
+ CHECK_ERR(err, "inflateEnd");
+
+ printf("after inflateSync(): hel%s\n", (char *)uncompr);
+}
+
+/* ===========================================================================
+ * Test deflate() with preset dictionary
+ */
+void test_dict_deflate(compr, comprLen)
+ Byte *compr;
+ uLong comprLen;
+{
+ z_stream c_stream; /* compression stream */
+ int err;
+
+ 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, (int)sizeof(dictionary));
+ CHECK_ERR(err, "deflateSetDictionary");
+
+ dictId = c_stream.adler;
+ c_stream.next_out = compr;
+ c_stream.avail_out = (uInt)comprLen;
+
+ c_stream.next_in = (z_const unsigned char *)hello;
+ c_stream.avail_in = (uInt)strlen(hello)+1;
+
+ err = deflate(&c_stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ fprintf(stderr, "deflate should report Z_STREAM_END\n");
+ exit(1);
+ }
+ err = deflateEnd(&c_stream);
+ CHECK_ERR(err, "deflateEnd");
+}
+
+/* ===========================================================================
+ * Test inflate() with a preset dictionary
+ */
+void test_dict_inflate(compr, comprLen, uncompr, uncomprLen)
+ Byte *compr, *uncompr;
+ uLong comprLen, uncomprLen;
+{
+ int err;
+ z_stream d_stream; /* decompression stream */
+
+ strcpy((char*)uncompr, "garbage");
+
+ d_stream.zalloc = zalloc;
+ d_stream.zfree = zfree;
+ d_stream.opaque = (voidpf)0;
+
+ d_stream.next_in = compr;
+ d_stream.avail_in = (uInt)comprLen;
+
+ err = inflateInit(&d_stream);
+ CHECK_ERR(err, "inflateInit");
+
+ d_stream.next_out = uncompr;
+ d_stream.avail_out = (uInt)uncomprLen;
+
+ for (;;) {
+ err = inflate(&d_stream, Z_NO_FLUSH);
+ if (err == Z_STREAM_END) break;
+ if (err == Z_NEED_DICT) {
+ if (d_stream.adler != dictId) {
+ fprintf(stderr, "unexpected dictionary");
+ exit(1);
+ }
+ err = inflateSetDictionary(&d_stream, (const Bytef*)dictionary,
+ (int)sizeof(dictionary));
+ }
+ CHECK_ERR(err, "inflate with dict");
+ }
+
+ err = inflateEnd(&d_stream);
+ CHECK_ERR(err, "inflateEnd");
+
+ if (strcmp((char*)uncompr, hello)) {
+ fprintf(stderr, "bad inflate with dict\n");
+ exit(1);
+ } else {
+ printf("inflate with dictionary: %s\n", (char *)uncompr);
+ }
+}
+
+/* ===========================================================================
+ * Usage: example [output.gz [input.gz]]
+ */
+
+int main(argc, argv)
+ int argc;
+ char *argv[];
+{
+ Byte *compr, *uncompr;
+ uLong comprLen = 10000*sizeof(int); /* don't overflow on MSDOS */
+ uLong uncomprLen = comprLen;
+ static const char* myVersion = ZLIB_VERSION;
+
+ if (zlibVersion()[0] != myVersion[0]) {
+ fprintf(stderr, "incompatible zlib version\n");
+ exit(1);
+
+ } else if (strcmp(zlibVersion(), ZLIB_VERSION) != 0) {
+ fprintf(stderr, "warning: different zlib version\n");
+ }
+
+ printf("zlib version %s = 0x%04x, compile flags = 0x%lx\n",
+ ZLIB_VERSION, ZLIB_VERNUM, zlibCompileFlags());
+
+ compr = (Byte*)calloc((uInt)comprLen, 1);
+ uncompr = (Byte*)calloc((uInt)uncomprLen, 1);
+ /* compr and uncompr are cleared to avoid reading uninitialized
+ * data and to ensure that uncompr compresses well.
+ */
+ if (compr == Z_NULL || uncompr == Z_NULL) {
+ 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);
+
+ test_large_deflate(compr, comprLen, uncompr, uncomprLen);
+ test_large_inflate(compr, comprLen, uncompr, uncomprLen);
+
+ test_flush(compr, &comprLen);
+ test_sync(compr, comprLen, uncompr, uncomprLen);
+ comprLen = uncomprLen;
+
+ test_dict_deflate(compr, comprLen);
+ test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
+
+ free(compr);
+ free(uncompr);
+
+ return 0;
+}
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/test/minigzip.c b/compat/zlib/test/minigzip.c
new file mode 100644
index 0000000..b3025a4
--- /dev/null
+++ b/compat/zlib/test/minigzip.c
@@ -0,0 +1,651 @@
+/* minigzip.c -- simulate gzip using the zlib compression library
+ * Copyright (C) 1995-2006, 2010, 2011 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * minigzip is a minimal implementation of the gzip utility. This is
+ * only an example of using zlib and isn't meant to replace the
+ * full-featured gzip. No attempt is made to deal with file systems
+ * limiting names to 14 or 8+3 characters, etc... Error checking is
+ * very limited. So use minigzip only for testing; use gzip for the
+ * real thing. On MSDOS, use only on file names without extension
+ * or in pipe mode.
+ */
+
+/* @(#) $Id$ */
+
+#include "zlib.h"
+#include <stdio.h>
+
+#ifdef STDC
+# include <string.h>
+# include <stdlib.h>
+#endif
+
+#ifdef USE_MMAP
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/stat.h>
+#endif
+
+#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
+# include <fcntl.h>
+# include <io.h>
+# ifdef UNDER_CE
+# include <stdlib.h>
+# endif
+# define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
+#else
+# define SET_BINARY_MODE(file)
+#endif
+
+#ifdef _MSC_VER
+# define snprintf _snprintf
+#endif
+
+#ifdef VMS
+# define unlink delete
+# define GZ_SUFFIX "-gz"
+#endif
+#ifdef RISCOS
+# define unlink remove
+# define GZ_SUFFIX "-gz"
+# define fileno(file) file->__file
+#endif
+#if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
+# include <unix.h> /* for fileno */
+#endif
+
+#if !defined(Z_HAVE_UNISTD_H) && !defined(_LARGEFILE64_SOURCE)
+#ifndef WIN32 /* unlink already in stdio.h for WIN32 */
+ extern int unlink OF((const char *));
+#endif
+#endif
+
+#if defined(UNDER_CE)
+# include <windows.h>
+# define perror(s) pwinerror(s)
+
+/* Map the Windows error number in ERROR to a locale-dependent error
+ message string and return a pointer to it. Typically, the values
+ for ERROR come from GetLastError.
+
+ The string pointed to shall not be modified by the application,
+ but may be overwritten by a subsequent call to strwinerror
+
+ The strwinerror function does not change the current setting
+ of GetLastError. */
+
+static char *strwinerror (error)
+ DWORD error;
+{
+ static char buf[1024];
+
+ wchar_t *msgbuf;
+ DWORD lasterr = GetLastError();
+ DWORD chars = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER,
+ NULL,
+ error,
+ 0, /* Default language */
+ (LPVOID)&msgbuf,
+ 0,
+ NULL);
+ if (chars != 0) {
+ /* If there is an \r\n appended, zap it. */
+ if (chars >= 2
+ && msgbuf[chars - 2] == '\r' && msgbuf[chars - 1] == '\n') {
+ chars -= 2;
+ msgbuf[chars] = 0;
+ }
+
+ if (chars > sizeof (buf) - 1) {
+ chars = sizeof (buf) - 1;
+ msgbuf[chars] = 0;
+ }
+
+ wcstombs(buf, msgbuf, chars + 1);
+ LocalFree(msgbuf);
+ }
+ else {
+ sprintf(buf, "unknown win32 error (%ld)", error);
+ }
+
+ SetLastError(lasterr);
+ return buf;
+}
+
+static void pwinerror (s)
+ const char *s;
+{
+ if (s && *s)
+ fprintf(stderr, "%s: %s\n", s, strwinerror(GetLastError ()));
+ else
+ fprintf(stderr, "%s\n", strwinerror(GetLastError ()));
+}
+
+#endif /* UNDER_CE */
+
+#ifndef GZ_SUFFIX
+# define GZ_SUFFIX ".gz"
+#endif
+#define SUFFIX_LEN (sizeof(GZ_SUFFIX)-1)
+
+#define BUFLEN 16384
+#define MAX_NAME_LEN 1024
+
+#ifdef MAXSEG_64K
+# define local static
+ /* Needed for systems with limitation on stack size. */
+#else
+# 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));
+void gz_compress OF((FILE *in, gzFile out));
+#ifdef USE_MMAP
+int gz_compress_mmap OF((FILE *in, gzFile out));
+#endif
+void gz_uncompress OF((gzFile in, FILE *out));
+void file_compress OF((char *file, char *mode));
+void file_uncompress OF((char *file));
+int main OF((int argc, char *argv[]));
+
+/* ===========================================================================
+ * Display error message and exit
+ */
+void error(msg)
+ const char *msg;
+{
+ fprintf(stderr, "%s: %s\n", prog, msg);
+ exit(1);
+}
+
+/* ===========================================================================
+ * Compress input to output then close both files.
+ */
+
+void gz_compress(in, out)
+ FILE *in;
+ gzFile out;
+{
+ local char buf[BUFLEN];
+ int len;
+ int err;
+
+#ifdef USE_MMAP
+ /* Try first compressing with mmap. If mmap fails (minigzip used in a
+ * pipe), use the normal fread loop.
+ */
+ if (gz_compress_mmap(in, out) == Z_OK) return;
+#endif
+ for (;;) {
+ len = (int)fread(buf, 1, sizeof(buf), in);
+ if (ferror(in)) {
+ perror("fread");
+ exit(1);
+ }
+ if (len == 0) break;
+
+ if (gzwrite(out, buf, (unsigned)len) != len) error(gzerror(out, &err));
+ }
+ fclose(in);
+ if (gzclose(out) != Z_OK) error("failed gzclose");
+}
+
+#ifdef USE_MMAP /* MMAP version, Miguel Albrecht <malbrech@eso.org> */
+
+/* Try compressing the input file at once using mmap. Return Z_OK if
+ * if success, Z_ERRNO otherwise.
+ */
+int gz_compress_mmap(in, out)
+ FILE *in;
+ gzFile out;
+{
+ int len;
+ int err;
+ int ifd = fileno(in);
+ caddr_t buf; /* mmap'ed buffer for the entire input file */
+ off_t buf_len; /* length of the input file */
+ struct stat sb;
+
+ /* Determine the size of the file, needed for mmap: */
+ if (fstat(ifd, &sb) < 0) return Z_ERRNO;
+ buf_len = sb.st_size;
+ if (buf_len <= 0) return Z_ERRNO;
+
+ /* Now do the actual mmap: */
+ buf = mmap((caddr_t) 0, buf_len, PROT_READ, MAP_SHARED, ifd, (off_t)0);
+ if (buf == (caddr_t)(-1)) return Z_ERRNO;
+
+ /* Compress the whole file at once: */
+ len = gzwrite(out, (char *)buf, (unsigned)buf_len);
+
+ if (len != (int)buf_len) error(gzerror(out, &err));
+
+ munmap(buf, buf_len);
+ fclose(in);
+ if (gzclose(out) != Z_OK) error("failed gzclose");
+ return Z_OK;
+}
+#endif /* USE_MMAP */
+
+/* ===========================================================================
+ * Uncompress input to output then close both files.
+ */
+void gz_uncompress(in, out)
+ gzFile in;
+ FILE *out;
+{
+ local char buf[BUFLEN];
+ int len;
+ int err;
+
+ for (;;) {
+ len = gzread(in, buf, sizeof(buf));
+ if (len < 0) error (gzerror(in, &err));
+ if (len == 0) break;
+
+ if ((int)fwrite(buf, 1, (unsigned)len, out) != len) {
+ error("failed fwrite");
+ }
+ }
+ if (fclose(out)) error("failed fclose");
+
+ if (gzclose(in) != Z_OK) error("failed gzclose");
+}
+
+
+/* ===========================================================================
+ * Compress the given file: create a corresponding .gz file and remove the
+ * original.
+ */
+void file_compress(file, mode)
+ char *file;
+ char *mode;
+{
+ local char outfile[MAX_NAME_LEN];
+ FILE *in;
+ gzFile out;
+
+ if (strlen(file) + strlen(GZ_SUFFIX) >= sizeof(outfile)) {
+ fprintf(stderr, "%s: filename too long\n", prog);
+ exit(1);
+ }
+
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(outfile, sizeof(outfile), "%s%s", file, GZ_SUFFIX);
+#else
+ strcpy(outfile, file);
+ strcat(outfile, GZ_SUFFIX);
+#endif
+
+ in = fopen(file, "rb");
+ if (in == NULL) {
+ perror(file);
+ exit(1);
+ }
+ out = gzopen(outfile, mode);
+ if (out == NULL) {
+ fprintf(stderr, "%s: can't gzopen %s\n", prog, outfile);
+ exit(1);
+ }
+ gz_compress(in, out);
+
+ unlink(file);
+}
+
+
+/* ===========================================================================
+ * Uncompress the given file and remove the original.
+ */
+void file_uncompress(file)
+ char *file;
+{
+ local char buf[MAX_NAME_LEN];
+ char *infile, *outfile;
+ FILE *out;
+ gzFile in;
+ size_t len = strlen(file);
+
+ if (len + strlen(GZ_SUFFIX) >= sizeof(buf)) {
+ fprintf(stderr, "%s: filename too long\n", prog);
+ exit(1);
+ }
+
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(buf, sizeof(buf), "%s", file);
+#else
+ strcpy(buf, file);
+#endif
+
+ if (len > SUFFIX_LEN && strcmp(file+len-SUFFIX_LEN, GZ_SUFFIX) == 0) {
+ infile = file;
+ outfile = buf;
+ outfile[len-3] = '\0';
+ } else {
+ outfile = file;
+ infile = buf;
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(buf + len, sizeof(buf) - len, "%s", GZ_SUFFIX);
+#else
+ strcat(infile, GZ_SUFFIX);
+#endif
+ }
+ in = gzopen(infile, "rb");
+ if (in == NULL) {
+ fprintf(stderr, "%s: can't gzopen %s\n", prog, infile);
+ exit(1);
+ }
+ out = fopen(outfile, "wb");
+ if (out == NULL) {
+ perror(file);
+ exit(1);
+ }
+
+ gz_uncompress(in, out);
+
+ unlink(infile);
+}
+
+
+/* ===========================================================================
+ * Usage: minigzip [-c] [-d] [-f] [-h] [-r] [-1 to -9] [files...]
+ * -c : write to standard output
+ * -d : decompress
+ * -f : compress with Z_FILTERED
+ * -h : compress with Z_HUFFMAN_ONLY
+ * -r : compress with Z_RLE
+ * -1 to -9 : compression level
+ */
+
+int main(argc, argv)
+ int argc;
+ char *argv[];
+{
+ int copyout = 0;
+ int uncompr = 0;
+ gzFile file;
+ char *bname, outmode[20];
+
+#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
+ snprintf(outmode, sizeof(outmode), "%s", "wb6 ");
+#else
+ strcpy(outmode, "wb6 ");
+#endif
+
+ prog = argv[0];
+ bname = strrchr(argv[0], '/');
+ if (bname)
+ bname++;
+ else
+ bname = argv[0];
+ argc--, argv++;
+
+ if (!strcmp(bname, "gunzip"))
+ uncompr = 1;
+ else if (!strcmp(bname, "zcat"))
+ copyout = uncompr = 1;
+
+ while (argc > 0) {
+ if (strcmp(*argv, "-c") == 0)
+ copyout = 1;
+ else if (strcmp(*argv, "-d") == 0)
+ uncompr = 1;
+ else if (strcmp(*argv, "-f") == 0)
+ outmode[3] = 'f';
+ else if (strcmp(*argv, "-h") == 0)
+ outmode[3] = 'h';
+ else if (strcmp(*argv, "-r") == 0)
+ outmode[3] = 'R';
+ else if ((*argv)[0] == '-' && (*argv)[1] >= '1' && (*argv)[1] <= '9' &&
+ (*argv)[2] == 0)
+ outmode[2] = (*argv)[1];
+ else
+ break;
+ argc--, argv++;
+ }
+ if (outmode[3] == ' ')
+ outmode[3] = 0;
+ if (argc == 0) {
+ SET_BINARY_MODE(stdin);
+ SET_BINARY_MODE(stdout);
+ if (uncompr) {
+ file = gzdopen(fileno(stdin), "rb");
+ if (file == NULL) error("can't gzdopen stdin");
+ gz_uncompress(file, stdout);
+ } else {
+ file = gzdopen(fileno(stdout), outmode);
+ if (file == NULL) error("can't gzdopen stdout");
+ gz_compress(stdin, file);
+ }
+ } else {
+ if (copyout) {
+ SET_BINARY_MODE(stdout);
+ }
+ do {
+ if (uncompr) {
+ if (copyout) {
+ file = gzopen(*argv, "rb");
+ if (file == NULL)
+ fprintf(stderr, "%s: can't gzopen %s\n", prog, *argv);
+ else
+ gz_uncompress(file, stdout);
+ } else {
+ file_uncompress(*argv);
+ }
+ } else {
+ if (copyout) {
+ FILE * in = fopen(*argv, "rb");
+
+ if (in == NULL) {
+ perror(*argv);
+ } else {
+ file = gzdopen(fileno(stdout), outmode);
+ if (file == NULL) error("can't gzdopen stdout");
+
+ gz_compress(in, file);
+ }
+
+ } else {
+ file_compress(*argv, outmode);
+ }
+ }
+ } while (argv++, --argc);
+ }
+ return 0;
+}
diff --git a/compat/zlib/treebuild.xml b/compat/zlib/treebuild.xml
new file mode 100644
index 0000000..38d29d7
--- /dev/null
+++ b/compat/zlib/treebuild.xml
@@ -0,0 +1,116 @@
+<?xml version="1.0" ?>
+<package name="zlib" version="1.2.8">
+ <library name="zlib" dlversion="1.2.8" dlname="z">
+ <property name="description"> zip compression library </property>
+ <property name="include-target-dir" value="$(@PACKAGE/install-includedir)" />
+
+ <!-- fixme: not implemented yet -->
+ <property name="compiler/c/inline" value="yes" />
+
+ <include-file name="zlib.h" scope="public" mode="644" />
+ <include-file name="zconf.h" scope="public" mode="644" />
+
+ <source name="adler32.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ </source>
+ <source name="compress.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ </source>
+ <source name="crc32.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="crc32.h" />
+ </source>
+ <source name="gzclose.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="gzguts.h" />
+ </source>
+ <source name="gzlib.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="gzguts.h" />
+ </source>
+ <source name="gzread.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="gzguts.h" />
+ </source>
+ <source name="gzwrite.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="gzguts.h" />
+ </source>
+ <source name="uncompr.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ </source>
+ <source name="deflate.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="deflate.h" />
+ </source>
+ <source name="trees.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="deflate.h" />
+ <depend name="trees.h" />
+ </source>
+ <source name="zutil.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ </source>
+ <source name="inflate.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="inftrees.h" />
+ <depend name="inflate.h" />
+ <depend name="inffast.h" />
+ </source>
+ <source name="infback.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="inftrees.h" />
+ <depend name="inflate.h" />
+ <depend name="inffast.h" />
+ </source>
+ <source name="inftrees.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="inftrees.h" />
+ </source>
+ <source name="inffast.c">
+ <depend name="zlib.h" />
+ <depend name="zconf.h" />
+ <depend name="zutil.h" />
+ <depend name="inftrees.h" />
+ <depend name="inflate.h" />
+ <depend name="inffast.h" />
+ </source>
+ </library>
+</package>
+
+<!--
+CFLAGS=-O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-g -DDEBUG
+#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+# -Wstrict-prototypes -Wmissing-prototypes
+
+# OBJA =
+# to use the asm code: make OBJA=match.o
+#
+match.o: match.S
+ $(CPP) match.S > _match.s
+ $(CC) -c _match.s
+ mv _match.o match.o
+ rm -f _match.s
+-->
diff --git a/compat/zlib/trees.c b/compat/zlib/trees.c
new file mode 100644
index 0000000..1fd7759
--- /dev/null
+++ b/compat/zlib/trees.c
@@ -0,0 +1,1226 @@
+/* trees.c -- output deflated data using Huffman coding
+ * 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
+ */
+
+/*
+ * ALGORITHM
+ *
+ * The "deflation" process uses several Huffman trees. The more
+ * common source values are represented by shorter bit sequences.
+ *
+ * Each code tree is stored in a compressed form which is itself
+ * a Huffman encoding of the lengths of all the code strings (in
+ * ascending order by source values). The actual code strings are
+ * reconstructed from the lengths in the inflate process, as described
+ * in the deflate specification.
+ *
+ * REFERENCES
+ *
+ * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
+ * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
+ *
+ * Storer, James A.
+ * Data Compression: Methods and Theory, pp. 49-50.
+ * Computer Science Press, 1988. ISBN 0-7167-8156-5.
+ *
+ * Sedgewick, R.
+ * Algorithms, p290.
+ * Addison-Wesley, 1983. ISBN 0-201-06672-6.
+ */
+
+/* @(#) $Id$ */
+
+/* #define GEN_TREES_H */
+
+#include "deflate.h"
+
+#ifdef DEBUG
+# include <ctype.h>
+#endif
+
+/* ===========================================================================
+ * Constants
+ */
+
+#define MAX_BL_BITS 7
+/* Bit length codes must not exceed MAX_BL_BITS bits */
+
+#define END_BLOCK 256
+/* end of block literal code */
+
+#define REP_3_6 16
+/* repeat previous bit length 3-6 times (2 bits of repeat count) */
+
+#define REPZ_3_10 17
+/* repeat a zero length 3-10 times (3 bits of repeat count) */
+
+#define REPZ_11_138 18
+/* repeat a zero length 11-138 times (7 bits of repeat count) */
+
+local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */
+ = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0};
+
+local const int extra_dbits[D_CODES] /* extra bits for each distance code */
+ = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13};
+
+local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */
+ = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7};
+
+local const uch bl_order[BL_CODES]
+ = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15};
+/* The lengths of the bit length codes are sent in order of decreasing
+ * probability, to avoid transmitting the lengths for unused bit length codes.
+ */
+
+/* ===========================================================================
+ * Local data. These are initialized only once.
+ */
+
+#define DIST_CODE_LEN 512 /* see definition of array dist_code below */
+
+#if defined(GEN_TREES_H) || !defined(STDC)
+/* non ANSI compilers may not accept trees.h */
+
+local ct_data static_ltree[L_CODES+2];
+/* The static literal tree. Since the bit lengths are imposed, there is no
+ * need for the L_CODES extra codes used during heap construction. However
+ * The codes 286 and 287 are needed to build a canonical tree (see _tr_init
+ * below).
+ */
+
+local ct_data static_dtree[D_CODES];
+/* The static distance tree. (Actually a trivial tree since all codes use
+ * 5 bits.)
+ */
+
+uch _dist_code[DIST_CODE_LEN];
+/* Distance codes. The first 256 values correspond to the distances
+ * 3 .. 258, the last 256 values correspond to the top 8 bits of
+ * the 15 bit distances.
+ */
+
+uch _length_code[MAX_MATCH-MIN_MATCH+1];
+/* length code for each normalized match length (0 == MIN_MATCH) */
+
+local int base_length[LENGTH_CODES];
+/* First normalized length for each code (0 = MIN_MATCH) */
+
+local int base_dist[D_CODES];
+/* First normalized distance for each code (0 = distance of 1) */
+
+#else
+# include "trees.h"
+#endif /* GEN_TREES_H */
+
+struct static_tree_desc_s {
+ const ct_data *static_tree; /* static tree or NULL */
+ const intf *extra_bits; /* extra bits for each code or NULL */
+ int extra_base; /* base index for extra_bits */
+ int elems; /* max number of elements in the tree */
+ int max_length; /* max bit length for the codes */
+};
+
+local static_tree_desc static_l_desc =
+{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS};
+
+local static_tree_desc static_d_desc =
+{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS};
+
+local static_tree_desc static_bl_desc =
+{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS};
+
+/* ===========================================================================
+ * Local (static) routines in this file.
+ */
+
+local void tr_static_init OF((void));
+local void init_block OF((deflate_state *s));
+local void pqdownheap OF((deflate_state *s, ct_data *tree, int k));
+local void gen_bitlen OF((deflate_state *s, tree_desc *desc));
+local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count));
+local void build_tree OF((deflate_state *s, tree_desc *desc));
+local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code));
+local void send_tree OF((deflate_state *s, ct_data *tree, int max_code));
+local int build_bl_tree OF((deflate_state *s));
+local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes,
+ int blcodes));
+local void compress_block OF((deflate_state *s, const ct_data *ltree,
+ const ct_data *dtree));
+local int detect_data_type OF((deflate_state *s));
+local unsigned bi_reverse OF((unsigned value, int length));
+local void bi_windup OF((deflate_state *s));
+local void bi_flush OF((deflate_state *s));
+local void copy_block OF((deflate_state *s, charf *buf, unsigned len,
+ int header));
+
+#ifdef GEN_TREES_H
+local void gen_trees_header OF((void));
+#endif
+
+#ifndef DEBUG
+# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len)
+ /* Send a code of the given tree. c and tree must not have side effects */
+
+#else /* DEBUG */
+# define send_code(s, c, tree) \
+ { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \
+ send_bits(s, tree[c].Code, tree[c].Len); }
+#endif
+
+/* ===========================================================================
+ * Output a short LSB first on the stream.
+ * IN assertion: there is enough room in pendingBuf.
+ */
+#define put_short(s, w) { \
+ put_byte(s, (uch)((w) & 0xff)); \
+ put_byte(s, (uch)((ush)(w) >> 8)); \
+}
+
+/* ===========================================================================
+ * Send a value on a given number of bits.
+ * IN assertion: length <= 16 and value fits in length bits.
+ */
+#ifdef DEBUG
+local void send_bits OF((deflate_state *s, int value, int length));
+
+local void send_bits(s, value, length)
+ deflate_state *s;
+ int value; /* value to send */
+ int length; /* number of bits */
+{
+ Tracevv((stderr," l %2d v %4x ", length, value));
+ Assert(length > 0 && length <= 15, "invalid length");
+ s->bits_sent += (ulg)length;
+
+ /* If not enough room in bi_buf, use (valid) bits from bi_buf and
+ * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid))
+ * unused bits in value.
+ */
+ if (s->bi_valid > (int)Buf_size - length) {
+ s->bi_buf |= (ush)value << s->bi_valid;
+ put_short(s, s->bi_buf);
+ s->bi_buf = (ush)value >> (Buf_size - s->bi_valid);
+ s->bi_valid += length - Buf_size;
+ } else {
+ s->bi_buf |= (ush)value << s->bi_valid;
+ s->bi_valid += length;
+ }
+}
+#else /* !DEBUG */
+
+#define send_bits(s, value, length) \
+{ int len = length;\
+ if (s->bi_valid > (int)Buf_size - len) {\
+ int val = value;\
+ s->bi_buf |= (ush)val << s->bi_valid;\
+ put_short(s, s->bi_buf);\
+ s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\
+ s->bi_valid += len - Buf_size;\
+ } else {\
+ s->bi_buf |= (ush)(value) << s->bi_valid;\
+ s->bi_valid += len;\
+ }\
+}
+#endif /* DEBUG */
+
+
+/* the arguments must not have side effects */
+
+/* ===========================================================================
+ * Initialize the various 'constant' tables.
+ */
+local void tr_static_init()
+{
+#if defined(GEN_TREES_H) || !defined(STDC)
+ static int static_init_done = 0;
+ int n; /* iterates over tree elements */
+ int bits; /* bit counter */
+ int length; /* length value */
+ int code; /* code value */
+ int dist; /* distance index */
+ ush bl_count[MAX_BITS+1];
+ /* number of codes at each bit length for an optimal tree */
+
+ if (static_init_done) return;
+
+ /* For some embedded targets, global variables are not initialized: */
+#ifdef NO_INIT_GLOBAL_POINTERS
+ static_l_desc.static_tree = static_ltree;
+ static_l_desc.extra_bits = extra_lbits;
+ static_d_desc.static_tree = static_dtree;
+ static_d_desc.extra_bits = extra_dbits;
+ static_bl_desc.extra_bits = extra_blbits;
+#endif
+
+ /* Initialize the mapping length (0..255) -> length code (0..28) */
+ length = 0;
+ for (code = 0; code < LENGTH_CODES-1; code++) {
+ base_length[code] = length;
+ for (n = 0; n < (1<<extra_lbits[code]); n++) {
+ _length_code[length++] = (uch)code;
+ }
+ }
+ Assert (length == 256, "tr_static_init: length != 256");
+ /* Note that the length 255 (match length 258) can be represented
+ * in two different ways: code 284 + 5 bits or code 285, so we
+ * overwrite length_code[255] to use the best encoding:
+ */
+ _length_code[length-1] = (uch)code;
+
+ /* Initialize the mapping dist (0..32K) -> dist code (0..29) */
+ dist = 0;
+ for (code = 0 ; code < 16; code++) {
+ base_dist[code] = dist;
+ for (n = 0; n < (1<<extra_dbits[code]); n++) {
+ _dist_code[dist++] = (uch)code;
+ }
+ }
+ Assert (dist == 256, "tr_static_init: dist != 256");
+ dist >>= 7; /* from now on, all distances are divided by 128 */
+ for ( ; code < D_CODES; code++) {
+ base_dist[code] = dist << 7;
+ for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) {
+ _dist_code[256 + dist++] = (uch)code;
+ }
+ }
+ Assert (dist == 256, "tr_static_init: 256+dist != 512");
+
+ /* Construct the codes of the static literal tree */
+ for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0;
+ n = 0;
+ while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++;
+ while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++;
+ while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++;
+ while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++;
+ /* Codes 286 and 287 do not exist, but we must include them in the
+ * tree construction to get a canonical Huffman tree (longest code
+ * all ones)
+ */
+ gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count);
+
+ /* The static distance tree is trivial: */
+ for (n = 0; n < D_CODES; n++) {
+ static_dtree[n].Len = 5;
+ static_dtree[n].Code = bi_reverse((unsigned)n, 5);
+ }
+ static_init_done = 1;
+
+# ifdef GEN_TREES_H
+ gen_trees_header();
+# endif
+#endif /* defined(GEN_TREES_H) || !defined(STDC) */
+}
+
+/* ===========================================================================
+ * Genererate the file trees.h describing the static trees.
+ */
+#ifdef GEN_TREES_H
+# ifndef DEBUG
+# include <stdio.h>
+# endif
+
+# define SEPARATOR(i, last, width) \
+ ((i) == (last)? "\n};\n\n" : \
+ ((i) % (width) == (width)-1 ? ",\n" : ", "))
+
+void gen_trees_header()
+{
+ FILE *header = fopen("trees.h", "w");
+ int i;
+
+ Assert (header != NULL, "Can't open trees.h");
+ fprintf(header,
+ "/* header created automatically with -DGEN_TREES_H */\n\n");
+
+ fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n");
+ for (i = 0; i < L_CODES+2; i++) {
+ fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code,
+ static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
+ }
+
+ fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n");
+ for (i = 0; i < D_CODES; i++) {
+ fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code,
+ static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
+ }
+
+ fprintf(header, "const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {\n");
+ for (i = 0; i < DIST_CODE_LEN; i++) {
+ fprintf(header, "%2u%s", _dist_code[i],
+ SEPARATOR(i, DIST_CODE_LEN-1, 20));
+ }
+
+ fprintf(header,
+ "const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {\n");
+ for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) {
+ fprintf(header, "%2u%s", _length_code[i],
+ SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
+ }
+
+ fprintf(header, "local const int base_length[LENGTH_CODES] = {\n");
+ for (i = 0; i < LENGTH_CODES; i++) {
+ fprintf(header, "%1u%s", base_length[i],
+ SEPARATOR(i, LENGTH_CODES-1, 20));
+ }
+
+ fprintf(header, "local const int base_dist[D_CODES] = {\n");
+ for (i = 0; i < D_CODES; i++) {
+ fprintf(header, "%5u%s", base_dist[i],
+ SEPARATOR(i, D_CODES-1, 10));
+ }
+
+ fclose(header);
+}
+#endif /* GEN_TREES_H */
+
+/* ===========================================================================
+ * Initialize the tree data structures for a new zlib stream.
+ */
+void ZLIB_INTERNAL _tr_init(s)
+ deflate_state *s;
+{
+ tr_static_init();
+
+ s->l_desc.dyn_tree = s->dyn_ltree;
+ s->l_desc.stat_desc = &static_l_desc;
+
+ s->d_desc.dyn_tree = s->dyn_dtree;
+ s->d_desc.stat_desc = &static_d_desc;
+
+ s->bl_desc.dyn_tree = s->bl_tree;
+ s->bl_desc.stat_desc = &static_bl_desc;
+
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+#ifdef DEBUG
+ s->compressed_len = 0L;
+ s->bits_sent = 0L;
+#endif
+
+ /* Initialize the first block of the first file: */
+ init_block(s);
+}
+
+/* ===========================================================================
+ * Initialize a new block.
+ */
+local void init_block(s)
+ deflate_state *s;
+{
+ int n; /* iterates over tree elements */
+
+ /* Initialize the trees. */
+ for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0;
+ for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0;
+ for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0;
+
+ s->dyn_ltree[END_BLOCK].Freq = 1;
+ s->opt_len = s->static_len = 0L;
+ s->last_lit = s->matches = 0;
+}
+
+#define SMALLEST 1
+/* Index within the heap array of least frequent node in the Huffman tree */
+
+
+/* ===========================================================================
+ * Remove the smallest element from the heap and recreate the heap with
+ * one less element. Updates heap and heap_len.
+ */
+#define pqremove(s, tree, top) \
+{\
+ top = s->heap[SMALLEST]; \
+ s->heap[SMALLEST] = s->heap[s->heap_len--]; \
+ pqdownheap(s, tree, SMALLEST); \
+}
+
+/* ===========================================================================
+ * Compares to subtrees, using the tree depth as tie breaker when
+ * the subtrees have equal frequency. This minimizes the worst case length.
+ */
+#define smaller(tree, n, m, depth) \
+ (tree[n].Freq < tree[m].Freq || \
+ (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m]))
+
+/* ===========================================================================
+ * Restore the heap property by moving down the tree starting at node k,
+ * exchanging a node with the smallest of its two sons if necessary, stopping
+ * when the heap property is re-established (each father smaller than its
+ * two sons).
+ */
+local void pqdownheap(s, tree, k)
+ deflate_state *s;
+ ct_data *tree; /* the tree to restore */
+ int k; /* node to move down */
+{
+ int v = s->heap[k];
+ int j = k << 1; /* left son of k */
+ while (j <= s->heap_len) {
+ /* Set j to the smallest of the two sons: */
+ if (j < s->heap_len &&
+ smaller(tree, s->heap[j+1], s->heap[j], s->depth)) {
+ j++;
+ }
+ /* Exit if v is smaller than both sons */
+ if (smaller(tree, v, s->heap[j], s->depth)) break;
+
+ /* Exchange v with the smallest son */
+ s->heap[k] = s->heap[j]; k = j;
+
+ /* And continue down the tree, setting j to the left son of k */
+ j <<= 1;
+ }
+ s->heap[k] = v;
+}
+
+/* ===========================================================================
+ * Compute the optimal bit lengths for a tree and update the total bit length
+ * for the current block.
+ * IN assertion: the fields freq and dad are set, heap[heap_max] and
+ * above are the tree nodes sorted by increasing frequency.
+ * OUT assertions: the field len is set to the optimal bit length, the
+ * array bl_count contains the frequencies for each bit length.
+ * The length opt_len is updated; static_len is also updated if stree is
+ * not null.
+ */
+local void gen_bitlen(s, desc)
+ deflate_state *s;
+ tree_desc *desc; /* the tree descriptor */
+{
+ ct_data *tree = desc->dyn_tree;
+ int max_code = desc->max_code;
+ const ct_data *stree = desc->stat_desc->static_tree;
+ const intf *extra = desc->stat_desc->extra_bits;
+ int base = desc->stat_desc->extra_base;
+ int max_length = desc->stat_desc->max_length;
+ int h; /* heap index */
+ int n, m; /* iterate over the tree elements */
+ int bits; /* bit length */
+ int xbits; /* extra bits */
+ ush f; /* frequency */
+ int overflow = 0; /* number of elements with bit length too large */
+
+ for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0;
+
+ /* In a first pass, compute the optimal bit lengths (which may
+ * overflow in the case of the bit length tree).
+ */
+ tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */
+
+ for (h = s->heap_max+1; h < HEAP_SIZE; h++) {
+ n = s->heap[h];
+ bits = tree[tree[n].Dad].Len + 1;
+ if (bits > max_length) bits = max_length, overflow++;
+ tree[n].Len = (ush)bits;
+ /* We overwrite tree[n].Dad which is no longer needed */
+
+ if (n > max_code) continue; /* not a leaf node */
+
+ s->bl_count[bits]++;
+ xbits = 0;
+ if (n >= base) xbits = extra[n-base];
+ f = tree[n].Freq;
+ s->opt_len += (ulg)f * (bits + xbits);
+ if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits);
+ }
+ if (overflow == 0) return;
+
+ Trace((stderr,"\nbit length overflow\n"));
+ /* This happens for example on obj2 and pic of the Calgary corpus */
+
+ /* Find the first bit length which could increase: */
+ do {
+ bits = max_length-1;
+ while (s->bl_count[bits] == 0) bits--;
+ s->bl_count[bits]--; /* move one leaf down the tree */
+ s->bl_count[bits+1] += 2; /* move one overflow item as its brother */
+ s->bl_count[max_length]--;
+ /* The brother of the overflow item also moves one step up,
+ * but this does not affect bl_count[max_length]
+ */
+ overflow -= 2;
+ } while (overflow > 0);
+
+ /* Now recompute all bit lengths, scanning in increasing frequency.
+ * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all
+ * lengths instead of fixing only the wrong ones. This idea is taken
+ * from 'ar' written by Haruhiko Okumura.)
+ */
+ for (bits = max_length; bits != 0; bits--) {
+ n = s->bl_count[bits];
+ while (n != 0) {
+ m = s->heap[--h];
+ if (m > max_code) continue;
+ if ((unsigned) tree[m].Len != (unsigned) bits) {
+ Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits));
+ s->opt_len += ((long)bits - (long)tree[m].Len)
+ *(long)tree[m].Freq;
+ tree[m].Len = (ush)bits;
+ }
+ n--;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Generate the codes for a given tree and bit counts (which need not be
+ * optimal).
+ * IN assertion: the array bl_count contains the bit length statistics for
+ * the given tree and the field len is set for all tree elements.
+ * OUT assertion: the field code is set for all tree elements of non
+ * zero code length.
+ */
+local void gen_codes (tree, max_code, bl_count)
+ ct_data *tree; /* the tree to decorate */
+ int max_code; /* largest code with non zero frequency */
+ ushf *bl_count; /* number of codes at each bit length */
+{
+ ush next_code[MAX_BITS+1]; /* next code value for each bit length */
+ ush code = 0; /* running code value */
+ int bits; /* bit index */
+ int n; /* code index */
+
+ /* The distribution counts are first used to generate the code values
+ * without bit reversal.
+ */
+ for (bits = 1; bits <= MAX_BITS; bits++) {
+ next_code[bits] = code = (code + bl_count[bits-1]) << 1;
+ }
+ /* Check that the bit counts in bl_count are consistent. The last code
+ * must be all ones.
+ */
+ Assert (code + bl_count[MAX_BITS]-1 == (1<<MAX_BITS)-1,
+ "inconsistent bit counts");
+ Tracev((stderr,"\ngen_codes: max_code %d ", max_code));
+
+ for (n = 0; n <= max_code; n++) {
+ int len = tree[n].Len;
+ if (len == 0) continue;
+ /* Now reverse the bits */
+ tree[n].Code = bi_reverse(next_code[len]++, len);
+
+ Tracecv(tree != static_ltree, (stderr,"\nn %3d %c l %2d c %4x (%x) ",
+ n, (isgraph(n) ? n : ' '), len, tree[n].Code, next_code[len]-1));
+ }
+}
+
+/* ===========================================================================
+ * Construct one Huffman tree and assigns the code bit strings and lengths.
+ * Update the total bit length for the current block.
+ * IN assertion: the field freq is set for all tree elements.
+ * OUT assertions: the fields len and code are set to the optimal bit length
+ * and corresponding code. The length opt_len is updated; static_len is
+ * also updated if stree is not null. The field max_code is set.
+ */
+local void build_tree(s, desc)
+ deflate_state *s;
+ tree_desc *desc; /* the tree descriptor */
+{
+ ct_data *tree = desc->dyn_tree;
+ const ct_data *stree = desc->stat_desc->static_tree;
+ int elems = desc->stat_desc->elems;
+ int n, m; /* iterate over heap elements */
+ int max_code = -1; /* largest code with non zero frequency */
+ int node; /* new node being created */
+
+ /* Construct the initial heap, with least frequent element in
+ * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].
+ * heap[0] is not used.
+ */
+ s->heap_len = 0, s->heap_max = HEAP_SIZE;
+
+ for (n = 0; n < elems; n++) {
+ if (tree[n].Freq != 0) {
+ s->heap[++(s->heap_len)] = max_code = n;
+ s->depth[n] = 0;
+ } else {
+ tree[n].Len = 0;
+ }
+ }
+
+ /* The pkzip format requires that at least one distance code exists,
+ * and that at least one bit should be sent even if there is only one
+ * possible code. So to avoid special checks later on we force at least
+ * two codes of non zero frequency.
+ */
+ while (s->heap_len < 2) {
+ node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0);
+ tree[node].Freq = 1;
+ s->depth[node] = 0;
+ s->opt_len--; if (stree) s->static_len -= stree[node].Len;
+ /* node is 0 or 1 so it does not have extra bits */
+ }
+ desc->max_code = max_code;
+
+ /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
+ * establish sub-heaps of increasing lengths:
+ */
+ for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n);
+
+ /* Construct the Huffman tree by repeatedly combining the least two
+ * frequent nodes.
+ */
+ node = elems; /* next internal node of the tree */
+ do {
+ pqremove(s, tree, n); /* n = node of least frequency */
+ m = s->heap[SMALLEST]; /* m = node of next least frequency */
+
+ s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */
+ s->heap[--(s->heap_max)] = m;
+
+ /* Create a new node father of n and m */
+ tree[node].Freq = tree[n].Freq + tree[m].Freq;
+ s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ?
+ s->depth[n] : s->depth[m]) + 1);
+ tree[n].Dad = tree[m].Dad = (ush)node;
+#ifdef DUMP_BL_TREE
+ if (tree == s->bl_tree) {
+ fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)",
+ node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq);
+ }
+#endif
+ /* and insert the new node in the heap */
+ s->heap[SMALLEST] = node++;
+ pqdownheap(s, tree, SMALLEST);
+
+ } while (s->heap_len >= 2);
+
+ s->heap[--(s->heap_max)] = s->heap[SMALLEST];
+
+ /* At this point, the fields freq and dad are set. We can now
+ * generate the bit lengths.
+ */
+ gen_bitlen(s, (tree_desc *)desc);
+
+ /* The field len is now set, we can generate the bit codes */
+ gen_codes ((ct_data *)tree, max_code, s->bl_count);
+}
+
+/* ===========================================================================
+ * Scan a literal or distance tree to determine the frequencies of the codes
+ * in the bit length tree.
+ */
+local void scan_tree (s, tree, max_code)
+ deflate_state *s;
+ ct_data *tree; /* the tree to be scanned */
+ int max_code; /* and its largest code of non zero frequency */
+{
+ int n; /* iterates over all tree elements */
+ int prevlen = -1; /* last emitted length */
+ int curlen; /* length of current code */
+ int nextlen = tree[0].Len; /* length of next code */
+ int count = 0; /* repeat count of the current code */
+ int max_count = 7; /* max repeat count */
+ int min_count = 4; /* min repeat count */
+
+ if (nextlen == 0) max_count = 138, min_count = 3;
+ tree[max_code+1].Len = (ush)0xffff; /* guard */
+
+ for (n = 0; n <= max_code; n++) {
+ curlen = nextlen; nextlen = tree[n+1].Len;
+ if (++count < max_count && curlen == nextlen) {
+ continue;
+ } else if (count < min_count) {
+ s->bl_tree[curlen].Freq += count;
+ } else if (curlen != 0) {
+ if (curlen != prevlen) s->bl_tree[curlen].Freq++;
+ s->bl_tree[REP_3_6].Freq++;
+ } else if (count <= 10) {
+ s->bl_tree[REPZ_3_10].Freq++;
+ } else {
+ s->bl_tree[REPZ_11_138].Freq++;
+ }
+ count = 0; prevlen = curlen;
+ if (nextlen == 0) {
+ max_count = 138, min_count = 3;
+ } else if (curlen == nextlen) {
+ max_count = 6, min_count = 3;
+ } else {
+ max_count = 7, min_count = 4;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Send a literal or distance tree in compressed form, using the codes in
+ * bl_tree.
+ */
+local void send_tree (s, tree, max_code)
+ deflate_state *s;
+ ct_data *tree; /* the tree to be scanned */
+ int max_code; /* and its largest code of non zero frequency */
+{
+ int n; /* iterates over all tree elements */
+ int prevlen = -1; /* last emitted length */
+ int curlen; /* length of current code */
+ int nextlen = tree[0].Len; /* length of next code */
+ int count = 0; /* repeat count of the current code */
+ int max_count = 7; /* max repeat count */
+ int min_count = 4; /* min repeat count */
+
+ /* tree[max_code+1].Len = -1; */ /* guard already set */
+ if (nextlen == 0) max_count = 138, min_count = 3;
+
+ for (n = 0; n <= max_code; n++) {
+ curlen = nextlen; nextlen = tree[n+1].Len;
+ if (++count < max_count && curlen == nextlen) {
+ continue;
+ } else if (count < min_count) {
+ do { send_code(s, curlen, s->bl_tree); } while (--count != 0);
+
+ } else if (curlen != 0) {
+ if (curlen != prevlen) {
+ send_code(s, curlen, s->bl_tree); count--;
+ }
+ Assert(count >= 3 && count <= 6, " 3_6?");
+ send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2);
+
+ } else if (count <= 10) {
+ send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3);
+
+ } else {
+ send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7);
+ }
+ count = 0; prevlen = curlen;
+ if (nextlen == 0) {
+ max_count = 138, min_count = 3;
+ } else if (curlen == nextlen) {
+ max_count = 6, min_count = 3;
+ } else {
+ max_count = 7, min_count = 4;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Construct the Huffman tree for the bit lengths and return the index in
+ * bl_order of the last bit length code to send.
+ */
+local int build_bl_tree(s)
+ deflate_state *s;
+{
+ int max_blindex; /* index of last bit length code of non zero freq */
+
+ /* Determine the bit length frequencies for literal and distance trees */
+ scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code);
+ scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code);
+
+ /* Build the bit length tree: */
+ build_tree(s, (tree_desc *)(&(s->bl_desc)));
+ /* opt_len now includes the length of the tree representations, except
+ * the lengths of the bit lengths codes and the 5+5+4 bits for the counts.
+ */
+
+ /* Determine the number of bit length codes to send. The pkzip format
+ * requires that at least 4 bit length codes be sent. (appnote.txt says
+ * 3 but the actual value used is 4.)
+ */
+ for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) {
+ if (s->bl_tree[bl_order[max_blindex]].Len != 0) break;
+ }
+ /* Update opt_len to include the bit length tree and counts */
+ s->opt_len += 3*(max_blindex+1) + 5+5+4;
+ Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld",
+ s->opt_len, s->static_len));
+
+ return max_blindex;
+}
+
+/* ===========================================================================
+ * Send the header for a block using dynamic Huffman trees: the counts, the
+ * lengths of the bit length codes, the literal tree and the distance tree.
+ * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4.
+ */
+local void send_all_trees(s, lcodes, dcodes, blcodes)
+ deflate_state *s;
+ int lcodes, dcodes, blcodes; /* number of codes for each tree */
+{
+ int rank; /* index in bl_order */
+
+ Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes");
+ Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES,
+ "too many codes");
+ Tracev((stderr, "\nbl counts: "));
+ send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */
+ send_bits(s, dcodes-1, 5);
+ send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */
+ for (rank = 0; rank < blcodes; rank++) {
+ Tracev((stderr, "\nbl code %2d ", bl_order[rank]));
+ send_bits(s, s->bl_tree[bl_order[rank]].Len, 3);
+ }
+ Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent));
+
+ send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */
+ Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent));
+
+ send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */
+ Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent));
+}
+
+/* ===========================================================================
+ * Send a stored block
+ */
+void ZLIB_INTERNAL _tr_stored_block(s, buf, stored_len, last)
+ deflate_state *s;
+ charf *buf; /* input block */
+ ulg stored_len; /* length of input block */
+ int last; /* one if this is the last block for a file */
+{
+ send_bits(s, (STORED_BLOCK<<1)+last, 3); /* send block type */
+#ifdef DEBUG
+ s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L;
+ s->compressed_len += (stored_len + 4) << 3;
+#endif
+ copy_block(s, buf, (unsigned)stored_len, 1); /* with header */
+}
+
+/* ===========================================================================
+ * 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.
+ */
+void ZLIB_INTERNAL _tr_align(s)
+ deflate_state *s;
+{
+ send_bits(s, STATIC_TREES<<1, 3);
+ send_code(s, END_BLOCK, static_ltree);
+#ifdef DEBUG
+ s->compressed_len += 10L; /* 3 for block type, 7 for EOB */
+#endif
+ bi_flush(s);
+}
+
+/* ===========================================================================
+ * Determine the best encoding for the current block: dynamic trees, static
+ * trees or store, and output the encoded block to the zip file.
+ */
+void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last)
+ deflate_state *s;
+ charf *buf; /* input block, or NULL if too old */
+ ulg stored_len; /* length of input block */
+ int last; /* one if this is the last block for a file */
+{
+ ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */
+ int max_blindex = 0; /* index of last bit length code of non zero freq */
+
+ /* Build the Huffman trees unless a stored block is forced */
+ if (s->level > 0) {
+
+ /* Check if the file is binary or text */
+ if (s->strm->data_type == Z_UNKNOWN)
+ s->strm->data_type = detect_data_type(s);
+
+ /* Construct the literal and distance trees */
+ build_tree(s, (tree_desc *)(&(s->l_desc)));
+ Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len,
+ s->static_len));
+
+ build_tree(s, (tree_desc *)(&(s->d_desc)));
+ Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len,
+ s->static_len));
+ /* At this point, opt_len and static_len are the total bit lengths of
+ * the compressed block data, excluding the tree representations.
+ */
+
+ /* Build the bit length tree for the above two trees, and get the index
+ * in bl_order of the last bit length code to send.
+ */
+ max_blindex = build_bl_tree(s);
+
+ /* Determine the best encoding. Compute the block lengths in bytes. */
+ opt_lenb = (s->opt_len+3+7)>>3;
+ static_lenb = (s->static_len+3+7)>>3;
+
+ Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ",
+ opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len,
+ s->last_lit));
+
+ if (static_lenb <= opt_lenb) opt_lenb = static_lenb;
+
+ } else {
+ Assert(buf != (char*)0, "lost buf");
+ opt_lenb = static_lenb = stored_len + 5; /* force a stored block */
+ }
+
+#ifdef FORCE_STORED
+ if (buf != (char*)0) { /* force stored block */
+#else
+ if (stored_len+4 <= opt_lenb && buf != (char*)0) {
+ /* 4: two words for the lengths */
+#endif
+ /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE.
+ * Otherwise we can't have processed more than WSIZE input bytes since
+ * the last block flush, because compression would have been
+ * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to
+ * transform a block into a stored block.
+ */
+ _tr_stored_block(s, buf, stored_len, last);
+
+#ifdef FORCE_STATIC
+ } else if (static_lenb >= 0) { /* force static trees */
+#else
+ } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) {
+#endif
+ send_bits(s, (STATIC_TREES<<1)+last, 3);
+ compress_block(s, (const ct_data *)static_ltree,
+ (const ct_data *)static_dtree);
+#ifdef DEBUG
+ s->compressed_len += 3 + s->static_len;
+#endif
+ } else {
+ send_bits(s, (DYN_TREES<<1)+last, 3);
+ send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1,
+ max_blindex+1);
+ compress_block(s, (const ct_data *)s->dyn_ltree,
+ (const ct_data *)s->dyn_dtree);
+#ifdef DEBUG
+ s->compressed_len += 3 + s->opt_len;
+#endif
+ }
+ Assert (s->compressed_len == s->bits_sent, "bad compressed size");
+ /* The above check is made mod 2^32, for files larger than 512 MB
+ * and uLong implemented on 32 bits.
+ */
+ init_block(s);
+
+ if (last) {
+ bi_windup(s);
+#ifdef DEBUG
+ s->compressed_len += 7; /* align on byte boundary */
+#endif
+ }
+ Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3,
+ s->compressed_len-7*last));
+}
+
+/* ===========================================================================
+ * Save the match info and tally the frequency counts. Return true if
+ * the current block must be flushed.
+ */
+int ZLIB_INTERNAL _tr_tally (s, dist, lc)
+ deflate_state *s;
+ unsigned dist; /* distance of matched string */
+ unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */
+{
+ s->d_buf[s->last_lit] = (ush)dist;
+ s->l_buf[s->last_lit++] = (uch)lc;
+ if (dist == 0) {
+ /* lc is the unmatched char */
+ s->dyn_ltree[lc].Freq++;
+ } else {
+ s->matches++;
+ /* Here, lc is the match length - MIN_MATCH */
+ dist--; /* dist = match distance - 1 */
+ Assert((ush)dist < (ush)MAX_DIST(s) &&
+ (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) &&
+ (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match");
+
+ s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++;
+ s->dyn_dtree[d_code(dist)].Freq++;
+ }
+
+#ifdef TRUNCATE_BLOCK
+ /* Try to guess if it is profitable to stop the current block here */
+ if ((s->last_lit & 0x1fff) == 0 && s->level > 2) {
+ /* Compute an upper bound for the compressed length */
+ ulg out_length = (ulg)s->last_lit*8L;
+ ulg in_length = (ulg)((long)s->strstart - s->block_start);
+ int dcode;
+ for (dcode = 0; dcode < D_CODES; dcode++) {
+ out_length += (ulg)s->dyn_dtree[dcode].Freq *
+ (5L+extra_dbits[dcode]);
+ }
+ out_length >>= 3;
+ Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ",
+ s->last_lit, in_length, out_length,
+ 100L - out_length*100L/in_length));
+ if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1;
+ }
+#endif
+ return (s->last_lit == s->lit_bufsize-1);
+ /* We avoid equality with lit_bufsize because of wraparound at 64K
+ * on 16 bit machines and because stored blocks are restricted to
+ * 64K-1 bytes.
+ */
+}
+
+/* ===========================================================================
+ * Send the block data compressed using the given Huffman trees
+ */
+local void compress_block(s, ltree, dtree)
+ deflate_state *s;
+ const ct_data *ltree; /* literal tree */
+ const ct_data *dtree; /* distance tree */
+{
+ unsigned dist; /* distance of matched string */
+ int lc; /* match length or unmatched char (if dist == 0) */
+ unsigned lx = 0; /* running index in l_buf */
+ unsigned code; /* the code to send */
+ int extra; /* number of extra bits to send */
+
+ if (s->last_lit != 0) do {
+ dist = s->d_buf[lx];
+ lc = s->l_buf[lx++];
+ if (dist == 0) {
+ send_code(s, lc, ltree); /* send a literal byte */
+ Tracecv(isgraph(lc), (stderr," '%c' ", lc));
+ } else {
+ /* Here, lc is the match length - MIN_MATCH */
+ code = _length_code[lc];
+ send_code(s, code+LITERALS+1, ltree); /* send the length code */
+ extra = extra_lbits[code];
+ if (extra != 0) {
+ lc -= base_length[code];
+ send_bits(s, lc, extra); /* send the extra length bits */
+ }
+ dist--; /* dist is now the match distance - 1 */
+ code = d_code(dist);
+ Assert (code < D_CODES, "bad d_code");
+
+ send_code(s, code, dtree); /* send the distance code */
+ extra = extra_dbits[code];
+ if (extra != 0) {
+ dist -= base_dist[code];
+ send_bits(s, dist, extra); /* send the extra distance bits */
+ }
+ } /* literal or match pair ? */
+
+ /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */
+ Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx,
+ "pendingBuf overflow");
+
+ } while (lx < s->last_lit);
+
+ send_code(s, END_BLOCK, ltree);
+}
+
+/* ===========================================================================
+ * Check if the data type is TEXT or BINARY, using the following algorithm:
+ * - TEXT if the two conditions below are satisfied:
+ * a) There are no non-portable control characters belonging to the
+ * "black list" (0..6, 14..25, 28..31).
+ * b) There is at least one printable character belonging to the
+ * "white list" (9 {TAB}, 10 {LF}, 13 {CR}, 32..255).
+ * - BINARY otherwise.
+ * - The following partially-portable control characters form a
+ * "gray list" that is ignored in this detection algorithm:
+ * (7 {BEL}, 8 {BS}, 11 {VT}, 12 {FF}, 26 {SUB}, 27 {ESC}).
+ * IN assertion: the fields Freq of dyn_ltree are set.
+ */
+local int detect_data_type(s)
+ deflate_state *s;
+{
+ /* black_mask is the bit mask of black-listed bytes
+ * set bits 0..6, 14..25, and 28..31
+ * 0xf3ffc07f = binary 11110011111111111100000001111111
+ */
+ unsigned long black_mask = 0xf3ffc07fUL;
+ int n;
+
+ /* Check for non-textual ("black-listed") bytes. */
+ for (n = 0; n <= 31; n++, black_mask >>= 1)
+ if ((black_mask & 1) && (s->dyn_ltree[n].Freq != 0))
+ return Z_BINARY;
+
+ /* Check for textual ("white-listed") bytes. */
+ if (s->dyn_ltree[9].Freq != 0 || s->dyn_ltree[10].Freq != 0
+ || s->dyn_ltree[13].Freq != 0)
+ return Z_TEXT;
+ for (n = 32; n < LITERALS; n++)
+ if (s->dyn_ltree[n].Freq != 0)
+ return Z_TEXT;
+
+ /* There are no "black-listed" or "white-listed" bytes:
+ * this stream either is empty or has tolerated ("gray-listed") bytes only.
+ */
+ return Z_BINARY;
+}
+
+/* ===========================================================================
+ * Reverse the first len bits of a code, using straightforward code (a faster
+ * method would use a table)
+ * IN assertion: 1 <= len <= 15
+ */
+local unsigned bi_reverse(code, len)
+ unsigned code; /* the value to invert */
+ int len; /* its bit length */
+{
+ register unsigned res = 0;
+ do {
+ res |= code & 1;
+ code >>= 1, res <<= 1;
+ } while (--len > 0);
+ return res >> 1;
+}
+
+/* ===========================================================================
+ * Flush the bit buffer, keeping at most 7 bits in it.
+ */
+local void bi_flush(s)
+ deflate_state *s;
+{
+ if (s->bi_valid == 16) {
+ put_short(s, s->bi_buf);
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+ } else if (s->bi_valid >= 8) {
+ put_byte(s, (Byte)s->bi_buf);
+ s->bi_buf >>= 8;
+ s->bi_valid -= 8;
+ }
+}
+
+/* ===========================================================================
+ * Flush the bit buffer and align the output on a byte boundary
+ */
+local void bi_windup(s)
+ deflate_state *s;
+{
+ if (s->bi_valid > 8) {
+ put_short(s, s->bi_buf);
+ } else if (s->bi_valid > 0) {
+ put_byte(s, (Byte)s->bi_buf);
+ }
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+#ifdef DEBUG
+ s->bits_sent = (s->bits_sent+7) & ~7;
+#endif
+}
+
+/* ===========================================================================
+ * Copy a stored block, storing first the length and its
+ * one's complement if requested.
+ */
+local void copy_block(s, buf, len, header)
+ deflate_state *s;
+ charf *buf; /* the input data */
+ unsigned len; /* its length */
+ int header; /* true if block header must be written */
+{
+ bi_windup(s); /* align on byte boundary */
+
+ if (header) {
+ put_short(s, (ush)len);
+ put_short(s, (ush)~len);
+#ifdef DEBUG
+ s->bits_sent += 2*16;
+#endif
+ }
+#ifdef DEBUG
+ s->bits_sent += (ulg)len<<3;
+#endif
+ while (len--) {
+ put_byte(s, *buf++);
+ }
+}
diff --git a/compat/zlib/trees.h b/compat/zlib/trees.h
new file mode 100644
index 0000000..d35639d
--- /dev/null
+++ b/compat/zlib/trees.h
@@ -0,0 +1,128 @@
+/* header created automatically with -DGEN_TREES_H */
+
+local const ct_data static_ltree[L_CODES+2] = {
+{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}},
+{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}},
+{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}},
+{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}},
+{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}},
+{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}},
+{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}},
+{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}},
+{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}},
+{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}},
+{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}},
+{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}},
+{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}},
+{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}},
+{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}},
+{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}},
+{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}},
+{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}},
+{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}},
+{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}},
+{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}},
+{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}},
+{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}},
+{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}},
+{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}},
+{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}},
+{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}},
+{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}},
+{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}},
+{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}},
+{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}},
+{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}},
+{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}},
+{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}},
+{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}},
+{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}},
+{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}},
+{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}},
+{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}},
+{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}},
+{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}},
+{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}},
+{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}},
+{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}},
+{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}},
+{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}},
+{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}},
+{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}},
+{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}},
+{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}},
+{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}},
+{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}},
+{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}},
+{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}},
+{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}},
+{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}},
+{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}},
+{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}}
+};
+
+local const ct_data static_dtree[D_CODES] = {
+{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}},
+{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}},
+{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}},
+{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}},
+{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}},
+{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}}
+};
+
+const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {
+ 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,
+ 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10,
+10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
+12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 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, 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, 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, 15, 15, 15, 15, 15,
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 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, 16, 17,
+18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
+};
+
+const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12,
+13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
+17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
+19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
+21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
+22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
+};
+
+local const int base_length[LENGTH_CODES] = {
+0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
+64, 80, 96, 112, 128, 160, 192, 224, 0
+};
+
+local const int base_dist[D_CODES] = {
+ 0, 1, 2, 3, 4, 6, 8, 12, 16, 24,
+ 32, 48, 64, 96, 128, 192, 256, 384, 512, 768,
+ 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576
+};
+
diff --git a/compat/zlib/uncompr.c b/compat/zlib/uncompr.c
new file mode 100644
index 0000000..242e949
--- /dev/null
+++ b/compat/zlib/uncompr.c
@@ -0,0 +1,59 @@
+/* uncompr.c -- decompress a memory buffer
+ * Copyright (C) 1995-2003, 2010 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#define ZLIB_INTERNAL
+#include "zlib.h"
+
+/* ===========================================================================
+ Decompresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total
+ size of the destination buffer, which must be large enough to hold the
+ entire uncompressed data. (The size of the uncompressed data must have
+ been saved previously by the compressor and transmitted to the decompressor
+ by some mechanism outside the scope of this compression library.)
+ Upon exit, destLen is the actual size of the compressed buffer.
+
+ 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.
+*/
+int ZEXPORT uncompress (dest, destLen, source, sourceLen)
+ Bytef *dest;
+ uLongf *destLen;
+ const Bytef *source;
+ uLong sourceLen;
+{
+ z_stream stream;
+ int err;
+
+ stream.next_in = (z_const Bytef *)source;
+ stream.avail_in = (uInt)sourceLen;
+ /* Check for source > 64K on 16-bit machine: */
+ if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR;
+
+ stream.next_out = dest;
+ stream.avail_out = (uInt)*destLen;
+ if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR;
+
+ stream.zalloc = (alloc_func)0;
+ stream.zfree = (free_func)0;
+
+ err = inflateInit(&stream);
+ if (err != Z_OK) return err;
+
+ err = inflate(&stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ inflateEnd(&stream);
+ if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0))
+ return Z_DATA_ERROR;
+ return err;
+ }
+ *destLen = stream.total_out;
+
+ err = inflateEnd(&stream);
+ return err;
+}
diff --git a/compat/zlib/watcom/watcom_f.mak b/compat/zlib/watcom/watcom_f.mak
new file mode 100644
index 0000000..37f4d74
--- /dev/null
+++ b/compat/zlib/watcom/watcom_f.mak
@@ -0,0 +1,43 @@
+# Makefile for zlib
+# OpenWatcom flat model
+# Last updated: 28-Dec-2005
+
+# To use, do "wmake -f watcom_f.mak"
+
+C_SOURCE = adler32.c compress.c crc32.c deflate.c &
+ gzclose.c gzlib.c gzread.c gzwrite.c &
+ infback.c inffast.c inflate.c inftrees.c &
+ trees.c uncompr.c zutil.c
+
+OBJS = adler32.obj compress.obj crc32.obj deflate.obj &
+ gzclose.obj gzlib.obj gzread.obj gzwrite.obj &
+ infback.obj inffast.obj inflate.obj inftrees.obj &
+ trees.obj uncompr.obj zutil.obj
+
+CC = wcc386
+LINKER = wcl386
+CFLAGS = -zq -mf -3r -fp3 -s -bt=dos -oilrtfm -fr=nul -wx
+ZLIB_LIB = zlib_f.lib
+
+.C.OBJ:
+ $(CC) $(CFLAGS) $[@
+
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+$(ZLIB_LIB): $(OBJS)
+ wlib -b -c $(ZLIB_LIB) -+adler32.obj -+compress.obj -+crc32.obj
+ wlib -b -c $(ZLIB_LIB) -+gzclose.obj -+gzlib.obj -+gzread.obj -+gzwrite.obj
+ wlib -b -c $(ZLIB_LIB) -+deflate.obj -+infback.obj
+ wlib -b -c $(ZLIB_LIB) -+inffast.obj -+inflate.obj -+inftrees.obj
+ wlib -b -c $(ZLIB_LIB) -+trees.obj -+uncompr.obj -+zutil.obj
+
+example.exe: $(ZLIB_LIB) example.obj
+ $(LINKER) -ldos32a -fe=example.exe example.obj $(ZLIB_LIB)
+
+minigzip.exe: $(ZLIB_LIB) minigzip.obj
+ $(LINKER) -ldos32a -fe=minigzip.exe minigzip.obj $(ZLIB_LIB)
+
+clean: .SYMBOLIC
+ del *.obj
+ del $(ZLIB_LIB)
+ @echo Cleaning done
diff --git a/compat/zlib/watcom/watcom_l.mak b/compat/zlib/watcom/watcom_l.mak
new file mode 100644
index 0000000..193eed7
--- /dev/null
+++ b/compat/zlib/watcom/watcom_l.mak
@@ -0,0 +1,43 @@
+# Makefile for zlib
+# OpenWatcom large model
+# Last updated: 28-Dec-2005
+
+# To use, do "wmake -f watcom_l.mak"
+
+C_SOURCE = adler32.c compress.c crc32.c deflate.c &
+ gzclose.c gzlib.c gzread.c gzwrite.c &
+ infback.c inffast.c inflate.c inftrees.c &
+ trees.c uncompr.c zutil.c
+
+OBJS = adler32.obj compress.obj crc32.obj deflate.obj &
+ gzclose.obj gzlib.obj gzread.obj gzwrite.obj &
+ infback.obj inffast.obj inflate.obj inftrees.obj &
+ trees.obj uncompr.obj zutil.obj
+
+CC = wcc
+LINKER = wcl
+CFLAGS = -zq -ml -s -bt=dos -oilrtfm -fr=nul -wx
+ZLIB_LIB = zlib_l.lib
+
+.C.OBJ:
+ $(CC) $(CFLAGS) $[@
+
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+$(ZLIB_LIB): $(OBJS)
+ wlib -b -c $(ZLIB_LIB) -+adler32.obj -+compress.obj -+crc32.obj
+ wlib -b -c $(ZLIB_LIB) -+gzclose.obj -+gzlib.obj -+gzread.obj -+gzwrite.obj
+ wlib -b -c $(ZLIB_LIB) -+deflate.obj -+infback.obj
+ wlib -b -c $(ZLIB_LIB) -+inffast.obj -+inflate.obj -+inftrees.obj
+ wlib -b -c $(ZLIB_LIB) -+trees.obj -+uncompr.obj -+zutil.obj
+
+example.exe: $(ZLIB_LIB) example.obj
+ $(LINKER) -fe=example.exe example.obj $(ZLIB_LIB)
+
+minigzip.exe: $(ZLIB_LIB) minigzip.obj
+ $(LINKER) -fe=minigzip.exe minigzip.obj $(ZLIB_LIB)
+
+clean: .SYMBOLIC
+ del *.obj
+ del $(ZLIB_LIB)
+ @echo Cleaning done
diff --git a/compat/zlib/win32/DLL_FAQ.txt b/compat/zlib/win32/DLL_FAQ.txt
new file mode 100644
index 0000000..12c0090
--- /dev/null
+++ b/compat/zlib/win32/DLL_FAQ.txt
@@ -0,0 +1,397 @@
+
+ Frequently Asked Questions about ZLIB1.DLL
+
+
+This document describes the design, the rationale, and the usage
+of the official DLL build of zlib, named ZLIB1.DLL. If you have
+general questions about zlib, you should see the file "FAQ" found
+in the zlib distribution, or at the following location:
+ http://www.gzip.org/zlib/zlib_faq.html
+
+
+ 1. What is ZLIB1.DLL, and how can I get it?
+
+ - ZLIB1.DLL is the official build of zlib as a DLL.
+ (Please remark the character '1' in the name.)
+
+ Pointers to a precompiled ZLIB1.DLL can be found in the zlib
+ web site at:
+ http://www.zlib.net/
+
+ Applications that link to ZLIB1.DLL can rely on the following
+ specification:
+
+ * The exported symbols are exclusively defined in the source
+ files "zlib.h" and "zlib.def", found in an official zlib
+ source distribution.
+ * The symbols are exported by name, not by ordinal.
+ * The exported names are undecorated.
+ * The calling convention of functions is "C" (CDECL).
+ * The ZLIB1.DLL binary is linked to MSVCRT.DLL.
+
+ The archive in which ZLIB1.DLL is bundled contains compiled
+ test programs that must run with a valid build of ZLIB1.DLL.
+ It is recommended to download the prebuilt DLL from the zlib
+ web site, instead of building it yourself, to avoid potential
+ incompatibilities that could be introduced by your compiler
+ and build settings. If you do build the DLL yourself, please
+ make sure that it complies with all the above requirements,
+ and it runs with the precompiled test programs, bundled with
+ the original ZLIB1.DLL distribution.
+
+ If, for any reason, you need to build an incompatible DLL,
+ please use a different file name.
+
+
+ 2. Why did you change the name of the DLL to ZLIB1.DLL?
+ What happened to the old ZLIB.DLL?
+
+ - The old ZLIB.DLL, built from zlib-1.1.4 or earlier, required
+ compilation settings that were incompatible to those used by
+ a static build. The DLL settings were supposed to be enabled
+ by defining the macro ZLIB_DLL, before including "zlib.h".
+ Incorrect handling of this macro was silently accepted at
+ build time, resulting in two major problems:
+
+ * ZLIB_DLL was missing from the old makefile. When building
+ the DLL, not all people added it to the build options. In
+ consequence, incompatible incarnations of ZLIB.DLL started
+ to circulate around the net.
+
+ * When switching from using the static library to using the
+ DLL, applications had to define the ZLIB_DLL macro and
+ to recompile all the sources that contained calls to zlib
+ functions. Failure to do so resulted in creating binaries
+ that were unable to run with the official ZLIB.DLL build.
+
+ The only possible solution that we could foresee was to make
+ a binary-incompatible change in the DLL interface, in order to
+ remove the dependency on the ZLIB_DLL macro, and to release
+ the new DLL under a different name.
+
+ We chose the name ZLIB1.DLL, where '1' indicates the major
+ zlib version number. We hope that we will not have to break
+ the binary compatibility again, at least not as long as the
+ zlib-1.x series will last.
+
+ There is still a ZLIB_DLL macro, that can trigger a more
+ efficient build and use of the DLL, but compatibility no
+ longer dependents on it.
+
+
+ 3. Can I build ZLIB.DLL from the new zlib sources, and replace
+ an old ZLIB.DLL, that was built from zlib-1.1.4 or earlier?
+
+ - In principle, you can do it by assigning calling convention
+ keywords to the macros ZEXPORT and ZEXPORTVA. In practice,
+ it depends on what you mean by "an old ZLIB.DLL", because the
+ old DLL exists in several mutually-incompatible versions.
+ You have to find out first what kind of calling convention is
+ being used in your particular ZLIB.DLL build, and to use the
+ same one in the new build. If you don't know what this is all
+ about, you might be better off if you would just leave the old
+ DLL intact.
+
+
+ 4. Can I compile my application using the new zlib interface, and
+ link it to an old ZLIB.DLL, that was built from zlib-1.1.4 or
+ earlier?
+
+ - The official answer is "no"; the real answer depends again on
+ what kind of ZLIB.DLL you have. Even if you are lucky, this
+ course of action is unreliable.
+
+ If you rebuild your application and you intend to use a newer
+ version of zlib (post- 1.1.4), it is strongly recommended to
+ link it to the new ZLIB1.DLL.
+
+
+ 5. Why are the zlib symbols exported by name, and not by ordinal?
+
+ - Although exporting symbols by ordinal is a little faster, it
+ is risky. Any single glitch in the maintenance or use of the
+ DEF file that contains the ordinals can result in incompatible
+ builds and frustrating crashes. Simply put, the benefits of
+ exporting symbols by ordinal do not justify the risks.
+
+ Technically, it should be possible to maintain ordinals in
+ the DEF file, and still export the symbols by name. Ordinals
+ exist in every DLL, and even if the dynamic linking performed
+ at the DLL startup is searching for names, ordinals serve as
+ hints, for a faster name lookup. However, if the DEF file
+ contains ordinals, the Microsoft linker automatically builds
+ an implib that will cause the executables linked to it to use
+ those ordinals, and not the names. It is interesting to
+ notice that the GNU linker for Win32 does not suffer from this
+ problem.
+
+ It is possible to avoid the DEF file if the exported symbols
+ are accompanied by a "__declspec(dllexport)" attribute in the
+ source files. You can do this in zlib by predefining the
+ ZLIB_DLL macro.
+
+
+ 6. I see that the ZLIB1.DLL functions use the "C" (CDECL) calling
+ convention. Why not use the STDCALL convention?
+ STDCALL is the standard convention in Win32, and I need it in
+ my Visual Basic project!
+
+ (For readability, we use CDECL to refer to the convention
+ triggered by the "__cdecl" keyword, STDCALL to refer to
+ the convention triggered by "__stdcall", and FASTCALL to
+ refer to the convention triggered by "__fastcall".)
+
+ - Most of the native Windows API functions (without varargs) use
+ indeed the WINAPI convention (which translates to STDCALL in
+ Win32), but the standard C functions use CDECL. If a user
+ application is intrinsically tied to the Windows API (e.g.
+ it calls native Windows API functions such as CreateFile()),
+ sometimes it makes sense to decorate its own functions with
+ WINAPI. But if ANSI C or POSIX portability is a goal (e.g.
+ it calls standard C functions such as fopen()), it is not a
+ sound decision to request the inclusion of <windows.h>, or to
+ use non-ANSI constructs, for the sole purpose to make the user
+ functions STDCALL-able.
+
+ The functionality offered by zlib is not in the category of
+ "Windows functionality", but is more like "C functionality".
+
+ Technically, STDCALL is not bad; in fact, it is slightly
+ faster than CDECL, and it works with variable-argument
+ functions, just like CDECL. It is unfortunate that, in spite
+ of using STDCALL in the Windows API, it is not the default
+ convention used by the C compilers that run under Windows.
+ The roots of the problem reside deep inside the unsafety of
+ the K&R-style function prototypes, where the argument types
+ are not specified; but that is another story for another day.
+
+ The remaining fact is that CDECL is the default convention.
+ Even if an explicit convention is hard-coded into the function
+ prototypes inside C headers, problems may appear. The
+ necessity to expose the convention in users' callbacks is one
+ of these problems.
+
+ The calling convention issues are also important when using
+ zlib in other programming languages. Some of them, like Ada
+ (GNAT) and Fortran (GNU G77), have C bindings implemented
+ initially on Unix, and relying on the C calling convention.
+ On the other hand, the pre- .NET versions of Microsoft Visual
+ Basic require STDCALL, while Borland Delphi prefers, although
+ it does not require, FASTCALL.
+
+ In fairness to all possible uses of zlib outside the C
+ programming language, we choose the default "C" convention.
+ Anyone interested in different bindings or conventions is
+ encouraged to maintain specialized projects. The "contrib/"
+ directory from the zlib distribution already holds a couple
+ of foreign bindings, such as Ada, C++, and Delphi.
+
+
+ 7. I need a DLL for my Visual Basic project. What can I do?
+
+ - Define the ZLIB_WINAPI macro before including "zlib.h", when
+ building both the DLL and the user application (except that
+ you don't need to define anything when using the DLL in Visual
+ Basic). The ZLIB_WINAPI macro will switch on the WINAPI
+ (STDCALL) convention. The name of this DLL must be different
+ than the official ZLIB1.DLL.
+
+ Gilles Vollant has contributed a build named ZLIBWAPI.DLL,
+ with the ZLIB_WINAPI macro turned on, and with the minizip
+ functionality built in. For more information, please read
+ the notes inside "contrib/vstudio/readme.txt", found in the
+ zlib distribution.
+
+
+ 8. I need to use zlib in my Microsoft .NET project. What can I
+ do?
+
+ - Henrik Ravn has contributed a .NET wrapper around zlib. Look
+ into contrib/dotzlib/, inside the zlib distribution.
+
+
+ 9. If my application uses ZLIB1.DLL, should I link it to
+ MSVCRT.DLL? Why?
+
+ - It is not required, but it is recommended to link your
+ application to MSVCRT.DLL, if it uses ZLIB1.DLL.
+
+ The executables (.EXE, .DLL, etc.) that are involved in the
+ same process and are using the C run-time library (i.e. they
+ are calling standard C functions), must link to the same
+ library. There are several libraries in the Win32 system:
+ CRTDLL.DLL, MSVCRT.DLL, the static C libraries, etc.
+ Since ZLIB1.DLL is linked to MSVCRT.DLL, the executables that
+ depend on it should also be linked to MSVCRT.DLL.
+
+
+10. Why are you saying that ZLIB1.DLL and my application should
+ be linked to the same C run-time (CRT) library? I linked my
+ application and my DLLs to different C libraries (e.g. my
+ application to a static library, and my DLLs to MSVCRT.DLL),
+ and everything works fine.
+
+ - If a user library invokes only pure Win32 API (accessible via
+ <windows.h> and the related headers), its DLL build will work
+ in any context. But if this library invokes standard C API,
+ things get more complicated.
+
+ There is a single Win32 library in a Win32 system. Every
+ function in this library resides in a single DLL module, that
+ is safe to call from anywhere. On the other hand, there are
+ multiple versions of the C library, and each of them has its
+ own separate internal state. Standalone executables and user
+ DLLs that call standard C functions must link to a C run-time
+ (CRT) library, be it static or shared (DLL). Intermixing
+ occurs when an executable (not necessarily standalone) and a
+ DLL are linked to different CRTs, and both are running in the
+ same process.
+
+ Intermixing multiple CRTs is possible, as long as their
+ internal states are kept intact. The Microsoft Knowledge Base
+ articles KB94248 "HOWTO: Use the C Run-Time" and KB140584
+ "HOWTO: Link with the Correct C Run-Time (CRT) Library"
+ mention the potential problems raised by intermixing.
+
+ If intermixing works for you, it's because your application
+ and DLLs are avoiding the corruption of each of the CRTs'
+ internal states, maybe by careful design, or maybe by fortune.
+
+ Also note that linking ZLIB1.DLL to non-Microsoft CRTs, such
+ as those provided by Borland, raises similar problems.
+
+
+11. Why are you linking ZLIB1.DLL to MSVCRT.DLL?
+
+ - MSVCRT.DLL exists on every Windows 95 with a new service pack
+ installed, or with Microsoft Internet Explorer 4 or later, and
+ on all other Windows 4.x or later (Windows 98, Windows NT 4,
+ or later). It is freely distributable; if not present in the
+ system, it can be downloaded from Microsoft or from other
+ software provider for free.
+
+ The fact that MSVCRT.DLL does not exist on a virgin Windows 95
+ is not so problematic. Windows 95 is scarcely found nowadays,
+ Microsoft ended its support a long time ago, and many recent
+ applications from various vendors, including Microsoft, do not
+ even run on it. Furthermore, no serious user should run
+ Windows 95 without a proper update installed.
+
+
+12. Why are you not linking ZLIB1.DLL to
+ <<my favorite C run-time library>> ?
+
+ - We considered and abandoned the following alternatives:
+
+ * Linking ZLIB1.DLL to a static C library (LIBC.LIB, or
+ LIBCMT.LIB) is not a good option. People are using the DLL
+ mainly to save disk space. If you are linking your program
+ to a static C library, you may as well consider linking zlib
+ in statically, too.
+
+ * Linking ZLIB1.DLL to CRTDLL.DLL looks appealing, because
+ CRTDLL.DLL is present on every Win32 installation.
+ Unfortunately, it has a series of problems: it does not
+ work properly with Microsoft's C++ libraries, it does not
+ provide support for 64-bit file offsets, (and so on...),
+ and Microsoft discontinued its support a long time ago.
+
+ * Linking ZLIB1.DLL to MSVCR70.DLL or MSVCR71.DLL, supplied
+ with the Microsoft .NET platform, and Visual C++ 7.0/7.1,
+ raises problems related to the status of ZLIB1.DLL as a
+ system component. According to the Microsoft Knowledge Base
+ article KB326922 "INFO: Redistribution of the Shared C
+ Runtime Component in Visual C++ .NET", MSVCR70.DLL and
+ MSVCR71.DLL are not supposed to function as system DLLs,
+ because they may clash with MSVCRT.DLL. Instead, the
+ application's installer is supposed to put these DLLs
+ (if needed) in the application's private directory.
+ If ZLIB1.DLL depends on a non-system runtime, it cannot
+ function as a redistributable system component.
+
+ * Linking ZLIB1.DLL to non-Microsoft runtimes, such as
+ Borland's, or Cygwin's, raises problems related to the
+ reliable presence of these runtimes on Win32 systems.
+ It's easier to let the DLL build of zlib up to the people
+ who distribute these runtimes, and who may proceed as
+ explained in the answer to Question 14.
+
+
+13. If ZLIB1.DLL cannot be linked to MSVCR70.DLL or MSVCR71.DLL,
+ how can I build/use ZLIB1.DLL in Microsoft Visual C++ 7.0
+ (Visual Studio .NET) or newer?
+
+ - Due to the problems explained in the Microsoft Knowledge Base
+ article KB326922 (see the previous answer), the C runtime that
+ comes with the VC7 environment is no longer considered a
+ system component. That is, it should not be assumed that this
+ runtime exists, or may be installed in a system directory.
+ Since ZLIB1.DLL is supposed to be a system component, it may
+ not depend on a non-system component.
+
+ In order to link ZLIB1.DLL and your application to MSVCRT.DLL
+ in VC7, you need the library of Visual C++ 6.0 or older. If
+ you don't have this library at hand, it's probably best not to
+ use ZLIB1.DLL.
+
+ We are hoping that, in the future, Microsoft will provide a
+ way to build applications linked to a proper system runtime,
+ from the Visual C++ environment. Until then, you have a
+ couple of alternatives, such as linking zlib in statically.
+ If your application requires dynamic linking, you may proceed
+ as explained in the answer to Question 14.
+
+
+14. I need to link my own DLL build to a CRT different than
+ MSVCRT.DLL. What can I do?
+
+ - Feel free to rebuild the DLL from the zlib sources, and link
+ it the way you want. You should, however, clearly state that
+ your build is unofficial. You should give it a different file
+ name, and/or install it in a private directory that can be
+ accessed by your application only, and is not visible to the
+ others (i.e. it's neither in the PATH, nor in the SYSTEM or
+ SYSTEM32 directories). Otherwise, your build may clash with
+ applications that link to the official build.
+
+ For example, in Cygwin, zlib is linked to the Cygwin runtime
+ CYGWIN1.DLL, and it is distributed under the name CYGZ.DLL.
+
+
+15. May I include additional pieces of code that I find useful,
+ link them in ZLIB1.DLL, and export them?
+
+ - No. A legitimate build of ZLIB1.DLL must not include code
+ that does not originate from the official zlib source code.
+ But you can make your own private DLL build, under a different
+ file name, as suggested in the previous answer.
+
+ For example, zlib is a part of the VCL library, distributed
+ with Borland Delphi and C++ Builder. The DLL build of VCL
+ is a redistributable file, named VCLxx.DLL.
+
+
+16. May I remove some functionality out of ZLIB1.DLL, by enabling
+ macros like NO_GZCOMPRESS or NO_GZIP at compile time?
+
+ - No. A legitimate build of ZLIB1.DLL must provide the complete
+ zlib functionality, as implemented in the official zlib source
+ code. But you can make your own private DLL build, under a
+ different file name, as suggested in the previous answer.
+
+
+17. I made my own ZLIB1.DLL build. Can I test it for compliance?
+
+ - We prefer that you download the official DLL from the zlib
+ web site. If you need something peculiar from this DLL, you
+ can send your suggestion to the zlib mailing list.
+
+ However, in case you do rebuild the DLL yourself, you can run
+ it with the test programs found in the DLL distribution.
+ Running these test programs is not a guarantee of compliance,
+ but a failure can imply a detected problem.
+
+**
+
+This document is written and maintained by
+Cosmin Truta <cosmint@cs.ubbcluj.ro>
diff --git a/compat/zlib/win32/Makefile.bor b/compat/zlib/win32/Makefile.bor
new file mode 100644
index 0000000..d152bbb
--- /dev/null
+++ b/compat/zlib/win32/Makefile.bor
@@ -0,0 +1,110 @@
+# Makefile for zlib
+# Borland C++ for Win32
+#
+# Usage:
+# make -f win32/Makefile.bor
+# make -f win32/Makefile.bor LOCAL_ZLIB=-DASMV OBJA=match.obj OBJPA=+match.obj
+
+# ------------ Borland C++ ------------
+
+# Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
+# should be added to the environment via "set LOCAL_ZLIB=-DFOO" or
+# added to the declaration of LOC here:
+LOC = $(LOCAL_ZLIB)
+
+CC = bcc32
+AS = bcc32
+LD = bcc32
+AR = tlib
+CFLAGS = -a -d -k- -O2 $(LOC)
+ASFLAGS = $(LOC)
+LDFLAGS = $(LOC)
+
+
+# variables
+ZLIB_LIB = zlib.lib
+
+OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
+OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
+#OBJA =
+OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
+OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
+#OBJPA=
+
+
+# targets
+all: $(ZLIB_LIB) example.exe minigzip.exe
+
+.c.obj:
+ $(CC) -c $(CFLAGS) $<
+
+.asm.obj:
+ $(AS) -c $(ASFLAGS) $<
+
+adler32.obj: adler32.c zlib.h zconf.h
+
+compress.obj: compress.c zlib.h zconf.h
+
+crc32.obj: crc32.c zlib.h zconf.h crc32.h
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+
+gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
+
+gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
+
+gzread.obj: gzread.c zlib.h zconf.h gzguts.h
+
+gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
+
+infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
+ inffast.h inffixed.h
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+
+trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+
+example.obj: test/example.c zlib.h zconf.h
+
+minigzip.obj: test/minigzip.c zlib.h zconf.h
+
+
+# For the sake of the old Borland make,
+# the command line is cut to fit in the MS-DOS 128 byte limit:
+$(ZLIB_LIB): $(OBJ1) $(OBJ2) $(OBJA)
+ -del $(ZLIB_LIB)
+ $(AR) $(ZLIB_LIB) $(OBJP1)
+ $(AR) $(ZLIB_LIB) $(OBJP2)
+ $(AR) $(ZLIB_LIB) $(OBJPA)
+
+
+# testing
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+example.exe: example.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
+
+minigzip.exe: minigzip.obj $(ZLIB_LIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
+
+
+# cleanup
+clean:
+ -del $(ZLIB_LIB)
+ -del *.obj
+ -del *.exe
+ -del *.tds
+ -del zlib.bak
+ -del foo.gz
diff --git a/compat/zlib/win32/Makefile.gcc b/compat/zlib/win32/Makefile.gcc
new file mode 100644
index 0000000..6d1ded6
--- /dev/null
+++ b/compat/zlib/win32/Makefile.gcc
@@ -0,0 +1,182 @@
+# 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: 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 from the top level zlib directory:
+#
+# 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 -fwin32/Makefile.gcc
+#
+# To install libz.a, zconf.h and zlib.h in the system directories, type:
+#
+# 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),
+# the DLL name should be changed from "zlib1.dll".
+
+STATICLIB = libz.a
+SHAREDLIB = zlib1.dll
+IMPLIB = libz.dll.a
+
+#
+# Set to 1 if shared object needs to be installed
+#
+SHARED_MODE=0
+
+#LOC = -DASMV
+#LOC = -DDEBUG -g
+
+PREFIX =
+CC = $(PREFIX)gcc
+CFLAGS = $(LOC) -O3 -Wall
+
+AS = $(CC)
+ASFLAGS = $(LOC) -Wall
+
+LD = $(CC)
+LDFLAGS = $(LOC)
+
+AR = $(PREFIX)ar
+ARFLAGS = rcs
+
+RC = $(PREFIX)windres
+RCFLAGS = --define GCC_WINDRES
+
+STRIP = $(PREFIX)strip
+
+CP = cp -fp
+# If GNU install is available, replace $(CP) with install.
+INSTALL = $(CP)
+RM = rm -f
+
+prefix ?= /usr/local
+exec_prefix = $(prefix)
+
+OBJS = 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
+OBJA =
+
+all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) example.exe minigzip.exe example_d.exe minigzip_d.exe
+
+test: example.exe minigzip.exe
+ ./example
+ echo hello world | ./minigzip | ./minigzip -d
+
+testdll: example_d.exe minigzip_d.exe
+ ./example_d
+ echo hello world | ./minigzip_d | ./minigzip_d -d
+
+.c.o:
+ $(CC) $(CFLAGS) -c -o $@ $<
+
+.S.o:
+ $(AS) $(ASFLAGS) -c -o $@ $<
+
+$(STATICLIB): $(OBJS) $(OBJA)
+ $(AR) $(ARFLAGS) $@ $(OBJS) $(OBJA)
+
+$(IMPLIB): $(SHAREDLIB)
+
+$(SHAREDLIB): win32/zlib.def $(OBJS) $(OBJA) zlibrc.o
+ $(CC) -shared -Wl,--out-implib,$(IMPLIB) $(LDFLAGS) \
+ -o $@ win32/zlib.def $(OBJS) $(OBJA) zlibrc.o
+ $(STRIP) $@
+
+example.exe: example.o $(STATICLIB)
+ $(LD) $(LDFLAGS) -o $@ example.o $(STATICLIB)
+ $(STRIP) $@
+
+minigzip.exe: minigzip.o $(STATICLIB)
+ $(LD) $(LDFLAGS) -o $@ minigzip.o $(STATICLIB)
+ $(STRIP) $@
+
+example_d.exe: example.o $(IMPLIB)
+ $(LD) $(LDFLAGS) -o $@ example.o $(IMPLIB)
+ $(STRIP) $@
+
+minigzip_d.exe: minigzip.o $(IMPLIB)
+ $(LD) $(LDFLAGS) -o $@ minigzip.o $(IMPLIB)
+ $(STRIP) $@
+
+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
+
+zlibrc.o: win32/zlib1.rc
+ $(RC) $(RCFLAGS) -o $@ win32/zlib1.rc
+
+.PHONY: install uninstall clean
+
+install: zlib.h zconf.h $(STATICLIB) $(IMPLIB)
+ @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 '$(DESTDIR)$(BINARY_PATH)'; \
+ $(INSTALL) $(SHAREDLIB) '$(DESTDIR)$(BINARY_PATH)'; \
+ $(INSTALL) $(IMPLIB) '$(DESTDIR)$(LIBRARY_PATH)'; \
+ fi
+ -$(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) '$(DESTDIR)$(BINARY_PATH)'/$(SHAREDLIB); \
+ $(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(IMPLIB); \
+ fi
+ -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zlib.h
+ -$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zconf.h
+ -$(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(STATICLIB)
+
+clean:
+ -$(RM) $(STATICLIB)
+ -$(RM) $(SHAREDLIB)
+ -$(RM) $(IMPLIB)
+ -$(RM) *.o
+ -$(RM) *.exe
+ -$(RM) foo.gz
+
+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
+gzclose.o: zlib.h zconf.h gzguts.h
+gzlib.o: zlib.h zconf.h gzguts.h
+gzread.o: zlib.h zconf.h gzguts.h
+gzwrite.o: zlib.h zconf.h gzguts.h
+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
+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
new file mode 100644
index 0000000..67b7731
--- /dev/null
+++ b/compat/zlib/win32/Makefile.msc
@@ -0,0 +1,163 @@
+# Makefile for zlib using Microsoft (Visual) C
+# zlib is copyright (C) 1995-2006 Jean-loup Gailly and Mark Adler
+#
+# Usage:
+# nmake -f win32/Makefile.msc (standard build)
+# 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 -I." \
+# OBJA="inffasx64.obj gvmat64.obj inffas8664.obj" (use ASM code, x64)
+
+# The toplevel directory of the source tree.
+#
+TOP = .
+
+# optional build flags
+LOC =
+
+# variables
+STATICLIB = zlib.lib
+SHAREDLIB = zlib1.dll
+IMPLIB = zdll.lib
+
+CC = cl
+AS = ml
+LD = link
+AR = lib
+RC = rc
+CFLAGS = -nologo -MD -W3 -O2 -Oy- -Zi -Fd"zlib" $(LOC)
+WFLAGS = -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE
+ASFLAGS = -coff -Zi $(LOC)
+LDFLAGS = -nologo -debug -incremental:no -opt:ref
+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 inffast.obj trees.obj uncompr.obj zutil.obj
+OBJA =
+
+
+# targets
+all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) \
+ example.exe minigzip.exe example_d.exe minigzip_d.exe
+
+$(STATICLIB): $(OBJS) $(OBJA)
+ $(AR) $(ARFLAGS) -out:$@ $(OBJS) $(OBJA)
+
+$(IMPLIB): $(SHAREDLIB)
+
+$(SHAREDLIB): $(TOP)/win32/zlib.def $(OBJS) $(OBJA) zlib1.res
+ $(LD) $(LDFLAGS) -def:$(TOP)/win32/zlib.def -dll -implib:$(IMPLIB) \
+ -out:$@ -base:0x5A4C0000 $(OBJS) $(OBJA) zlib1.res
+ if exist $@.manifest \
+ mt -nologo -manifest $@.manifest -outputresource:$@;2
+
+example.exe: example.obj $(STATICLIB)
+ $(LD) $(LDFLAGS) example.obj $(STATICLIB)
+ if exist $@.manifest \
+ mt -nologo -manifest $@.manifest -outputresource:$@;1
+
+minigzip.exe: minigzip.obj $(STATICLIB)
+ $(LD) $(LDFLAGS) minigzip.obj $(STATICLIB)
+ if exist $@.manifest \
+ mt -nologo -manifest $@.manifest -outputresource:$@;1
+
+example_d.exe: example.obj $(IMPLIB)
+ $(LD) $(LDFLAGS) -out:$@ example.obj $(IMPLIB)
+ if exist $@.manifest \
+ mt -nologo -manifest $@.manifest -outputresource:$@;1
+
+minigzip_d.exe: minigzip.obj $(IMPLIB)
+ $(LD) $(LDFLAGS) -out:$@ minigzip.obj $(IMPLIB)
+ if exist $@.manifest \
+ mt -nologo -manifest $@.manifest -outputresource:$@;1
+
+{$(TOP)}.c.obj:
+ $(CC) -c $(WFLAGS) $(CFLAGS) $<
+
+{$(TOP)/test}.c.obj:
+ $(CC) -c -I$(TOP) $(WFLAGS) $(CFLAGS) $<
+
+{$(TOP)/contrib/masmx64}.c.obj:
+ $(CC) -c $(WFLAGS) $(CFLAGS) $<
+
+{$(TOP)/contrib/masmx64}.asm.obj:
+ $(AS) -c $(ASFLAGS) $<
+
+{$(TOP)/contrib/masmx86}.asm.obj:
+ $(AS) -c $(ASFLAGS) $<
+
+adler32.obj: $(TOP)/adler32.c $(TOP)/zlib.h $(TOP)/zconf.h
+
+compress.obj: $(TOP)/compress.c $(TOP)/zlib.h $(TOP)/zconf.h
+
+crc32.obj: $(TOP)/crc32.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/crc32.h
+
+deflate.obj: $(TOP)/deflate.c $(TOP)/deflate.h $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h
+
+gzclose.obj: $(TOP)/gzclose.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h
+
+gzlib.obj: $(TOP)/gzlib.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h
+
+gzread.obj: $(TOP)/gzread.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h
+
+gzwrite.obj: $(TOP)/gzwrite.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h
+
+infback.obj: $(TOP)/infback.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
+ $(TOP)/inffast.h $(TOP)/inffixed.h
+
+inffast.obj: $(TOP)/inffast.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
+ $(TOP)/inffast.h
+
+inflate.obj: $(TOP)/inflate.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
+ $(TOP)/inffast.h $(TOP)/inffixed.h
+
+inftrees.obj: $(TOP)/inftrees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h
+
+trees.obj: $(TOP)/trees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/deflate.h $(TOP)/trees.h
+
+uncompr.obj: $(TOP)/uncompr.c $(TOP)/zlib.h $(TOP)/zconf.h
+
+zutil.obj: $(TOP)/zutil.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h
+
+gvmat64.obj: $(TOP)/contrib\masmx64\gvmat64.asm
+
+inffasx64.obj: $(TOP)/contrib\masmx64\inffasx64.asm
+
+inffas8664.obj: $(TOP)/contrib\masmx64\inffas8664.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h \
+ $(TOP)/inftrees.h $(TOP)/inflate.h $(TOP)/inffast.h
+
+inffas32.obj: $(TOP)/contrib\masmx86\inffas32.asm
+
+match686.obj: $(TOP)/contrib\masmx86\match686.asm
+
+example.obj: $(TOP)/test/example.c $(TOP)/zlib.h $(TOP)/zconf.h
+
+minigzip.obj: $(TOP)/test/minigzip.c $(TOP)/zlib.h $(TOP)/zconf.h
+
+zlib1.res: $(TOP)/win32/zlib1.rc
+ $(RC) $(RCFLAGS) /fo$@ $(TOP)/win32/zlib1.rc
+
+# testing
+test: example.exe minigzip.exe
+ example
+ echo hello world | minigzip | minigzip -d
+
+testdll: example_d.exe minigzip_d.exe
+ example_d
+ echo hello world | minigzip_d | minigzip_d -d
+
+
+# cleanup
+clean:
+ -del $(STATICLIB)
+ -del $(SHAREDLIB)
+ -del $(IMPLIB)
+ -del *.obj
+ -del *.res
+ -del *.exp
+ -del *.exe
+ -del *.pdb
+ -del *.manifest
+ -del foo.gz
diff --git a/compat/zlib/win32/README-WIN32.txt b/compat/zlib/win32/README-WIN32.txt
new file mode 100644
index 0000000..3d77d52
--- /dev/null
+++ b/compat/zlib/win32/README-WIN32.txt
@@ -0,0 +1,103 @@
+ZLIB DATA COMPRESSION LIBRARY
+
+zlib 1.2.8 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).
+
+All functions of the compression library are documented in the file zlib.h
+(volunteer to write man pages welcome, contact zlib@gzip.org). Two compiled
+examples are distributed in this package, example and minigzip. The example_d
+and minigzip_d flavors validate that the zlib1.dll file is working correctly.
+
+Questions about zlib should be sent to <zlib@gzip.org>. The zlib home page
+is http://zlib.net/ . Before reporting a problem, please check this site to
+verify that you have the latest version of zlib; otherwise get the latest
+version and check whether the problem still exists or not.
+
+PLEASE read DLL_FAQ.txt, and the the zlib FAQ http://zlib.net/zlib_faq.html
+before asking for help.
+
+
+Manifest:
+
+The package zlib-1.2.8-win32-x86.zip will contain the following files:
+
+ README-WIN32.txt This document
+ ChangeLog Changes since previous zlib packages
+ DLL_FAQ.txt Frequently asked questions about zlib1.dll
+ zlib.3.pdf Documentation of this library in Adobe Acrobat format
+
+ example.exe A statically-bound example (using zlib.lib, not the dll)
+ example.pdb Symbolic information for debugging example.exe
+
+ example_d.exe A zlib1.dll bound example (using zdll.lib)
+ example_d.pdb Symbolic information for debugging example_d.exe
+
+ minigzip.exe A statically-bound test program (using zlib.lib, not the dll)
+ minigzip.pdb Symbolic information for debugging minigzip.exe
+
+ minigzip_d.exe A zlib1.dll bound test program (using zdll.lib)
+ minigzip_d.pdb Symbolic information for debugging minigzip_d.exe
+
+ zlib.h Install these files into the compilers' INCLUDE path to
+ zconf.h compile programs which use zlib.lib or zdll.lib
+
+ zdll.lib Install these files into the compilers' LIB path if linking
+ zdll.exp a compiled program to the zlib1.dll binary
+
+ zlib.lib Install these files into the compilers' LIB path to link zlib
+ zlib.pdb into compiled programs, without zlib1.dll runtime dependency
+ (zlib.pdb provides debugging info to the compile time linker)
+
+ zlib1.dll Install this binary shared library into the system PATH, or
+ the program's runtime directory (where the .exe resides)
+ zlib1.pdb Install in the same directory as zlib1.dll, in order to debug
+ an application crash using WinDbg or similar tools.
+
+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 zlib127.zip source package
+available from http://zlib.net/ - review that package's README file for details.
+
+
+Acknowledgments:
+
+The deflate format used by zlib was defined by Phil Katz. The deflate and
+zlib specifications were written by L. Peter Deutsch. Thanks to all the
+people who reported problems and suggested various improvements in zlib; they
+are too numerous to cite here.
+
+
+Copyright notice:
+
+ (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
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup@gzip.org madler@alumni.caltech.edu
+
+If you use the zlib library in a product, we would appreciate *not* receiving
+lengthy legal documents to sign. The sources are provided for free but without
+warranty of any kind. The library has been entirely written by Jean-loup
+Gailly and Mark Adler; it does not include third-party code.
+
+If you redistribute modified sources, we would appreciate that you include in
+the file ChangeLog history information documenting your changes. Please read
+the FAQ for more information on the distribution of modified source versions.
diff --git a/compat/zlib/win32/README.txt b/compat/zlib/win32/README.txt
new file mode 100644
index 0000000..34a13b3
--- /dev/null
+++ b/compat/zlib/win32/README.txt
@@ -0,0 +1,60 @@
+
+What's here
+===========
+ The official ZLIB1.DLL
+
+
+Source
+======
+ zlib version 1.2.8
+ available at http://www.gzip.org/zlib/
+
+
+Specification and rationale
+===========================
+ See the accompanying DLL_FAQ.txt
+
+
+Usage
+=====
+ See the accompanying USAGE.txt
+
+
+Build info
+==========
+ Contributed by Jan Nijtmans.
+
+ Compiler:
+ i686-w64-mingw32-gcc (GCC) 4.5.3
+ Library:
+ mingw64-i686-runtime/headers: 3.0b_svn5747-1
+ Build commands:
+ i686-w64-mingw32-gcc -c -DASMV contrib/asm686/match.S
+ i686-w64-mingw32-gcc -c -DASMINF -I. -O3 contrib/inflate86/inffas86.c
+ make -f win32/Makefile.gcc PREFIX=i686-w64-mingw32- LOC="-mms-bitfields -DASMV -DASMINF" OBJA="inffas86.o match.o"
+ Finally, from VS commandline (VS2005 or higher):
+ lib -machine:X86 -name:zlib1.dll -def:zlib.def -out:zdll.lib
+
+Copyright notice
+================
+ Copyright (C) 1995-2010 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
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup@gzip.org madler@alumni.caltech.edu
+
diff --git a/compat/zlib/win32/USAGE.txt b/compat/zlib/win32/USAGE.txt
new file mode 100644
index 0000000..48e594e
--- /dev/null
+++ b/compat/zlib/win32/USAGE.txt
@@ -0,0 +1,89 @@
+
+Installing ZLIB1.DLL
+====================
+ Copy ZLIB1.DLL to the SYSTEM or the SYSTEM32 directory.
+
+
+Using ZLIB1.DLL with Microsoft Visual C++
+=========================================
+ 1. Install the supplied header files "zlib.h" and "zconf.h"
+ into a directory found in the INCLUDE path list.
+
+ 2. Install the supplied library file "zdll.lib" into a
+ directory found in the LIB path list.
+
+ 3. Add "zdll.lib" to your project.
+
+
+Using ZLIB1.DLL with gcc/MinGW
+==============================
+ 1. Install the supplied header files "zlib.h" and "zconf.h"
+ into the INCLUDE directory.
+
+ 2. Copy the supplied library file "zdll.lib" to "libzdll.a":
+ cp lib/zdll.lib lib/libzdll.a
+
+ OR
+
+ 2' Build the import library from the supplied "zlib.def":
+ dlltool -D zlib1.dll -d lib/zlib.def -l lib/libzdll.a
+
+ 3. Install "libzdll.a" into the LIB directory.
+
+ 4. Add "libzdll.a" to your project, or use the -lzdll option.
+
+
+Using ZLIB1.DLL with gcc/Cygwin
+===============================
+ ZLIB1.DLL is not designed to work with Cygwin. The Cygwin
+ system has its own DLL build of zlib, named CYGZ.DLL.
+
+
+Using ZLIB1.DLL with Borland C++
+================================
+ 1. Install the supplied header files "zlib.h" and "zconf.h"
+ into a directory found in the INCLUDE path list.
+
+ 2. Build the import library using the IMPLIB tool:
+ implib -a -c -f lib\zdllbor.lib zlib1.dll
+
+ OR
+
+ 2' Convert the supplied library file "zdll.lib" to OMF format,
+ using the COFF2OMF tool:
+ coff2omf lib\zdll.lib lib\zdllbor.lib
+
+ 3. Install "zdllbor.lib" into a directory found in the LIB path
+ list.
+
+ 4. Add "zdllbor.lib" to your project.
+
+ Notes:
+ - The modules that are linked with "zdllbor.lib" must be compiled
+ using a 4-byte alignment (option -a):
+ bcc32 -a -c myprog.c
+ bcc32 myprog.obj zdllbor.lib
+ - If you wish, you may use "zlib1.lib" instead of "zdllbor.lib".
+
+
+Rebuilding ZLIB1.DLL
+====================
+ Depending on your build environment, use the appropriate
+ makefile from the win32/ directory, found in the zlib source
+ distribution.
+
+ Your custom build has to comply with the requirements stated
+ in DLL_FAQ.txt, including (but not limited to) the following:
+ - It must be built from an unaltered zlib source distribution.
+ - It must be linked to MSVCRT.DLL.
+ - The macros that compile out certain portions of the zlib
+ code (such as NO_GZCOMPRESS, NO_GZIP) must not be enabled.
+ - The ZLIB_WINAPI macro must not be enabled.
+
+ Furthermore, it has to run successfully with the test suite
+ found in this package.
+
+ It is recommended, however, to use the supplied ZLIB1.DLL,
+ instead of rebuilding it yourself. You should rebuild it
+ only if you have a special reason.
+
diff --git a/compat/zlib/win32/VisualC.txt b/compat/zlib/win32/VisualC.txt
new file mode 100644
index 0000000..579a5fc
--- /dev/null
+++ b/compat/zlib/win32/VisualC.txt
@@ -0,0 +1,3 @@
+
+To build zlib using the Microsoft Visual C++ environment,
+use the appropriate project from the projects/ directory.
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib
new file mode 100644
index 0000000..8e6f719
--- /dev/null
+++ b/compat/zlib/win32/zdll.lib
Binary files differ
diff --git a/compat/zlib/win32/zlib.def b/compat/zlib/win32/zlib.def
new file mode 100644
index 0000000..face655
--- /dev/null
+++ b/compat/zlib/win32/zlib.def
@@ -0,0 +1,86 @@
+; zlib data compression library
+EXPORTS
+; basic functions
+ zlibVersion
+ deflate
+ deflateEnd
+ inflate
+ inflateEnd
+; advanced functions
+ deflateSetDictionary
+ deflateCopy
+ deflateReset
+ deflateParams
+ deflateTune
+ deflateBound
+ deflatePending
+ deflatePrime
+ deflateSetHeader
+ inflateSetDictionary
+ inflateGetDictionary
+ inflateSync
+ inflateCopy
+ inflateReset
+ inflateReset2
+ inflatePrime
+ inflateMark
+ inflateGetHeader
+ inflateBack
+ inflateBackEnd
+ zlibCompileFlags
+; utility functions
+ compress
+ compress2
+ compressBound
+ uncompress
+ gzopen
+ gzdopen
+ gzbuffer
+ gzsetparams
+ gzread
+ gzwrite
+ gzprintf
+ gzvprintf
+ gzputs
+ gzgets
+ gzputc
+ gzgetc
+ gzungetc
+ gzflush
+ gzseek
+ gzrewind
+ gztell
+ gzoffset
+ gzeof
+ gzdirect
+ gzclose
+ gzclose_r
+ gzclose_w
+ gzerror
+ gzclearerr
+; large file functions
+ gzopen64
+ gzseek64
+ gztell64
+ gzoffset64
+ adler32_combine64
+ crc32_combine64
+; checksum functions
+ adler32
+ crc32
+ adler32_combine
+ crc32_combine
+; various hacks, don't look :)
+ deflateInit_
+ deflateInit2_
+ 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
new file mode 100755
index 0000000..9ea38d5
--- /dev/null
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win32/zlib1.rc b/compat/zlib/win32/zlib1.rc
new file mode 100644
index 0000000..5c0feed
--- /dev/null
+++ b/compat/zlib/win32/zlib1.rc
@@ -0,0 +1,40 @@
+#include <winver.h>
+#include "../zlib.h"
+
+#ifdef GCC_WINDRES
+VS_VERSION_INFO VERSIONINFO
+#else
+VS_VERSION_INFO VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
+#endif
+ FILEVERSION ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0
+ PRODUCTVERSION ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0
+ FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
+#ifdef _DEBUG
+ FILEFLAGS 1
+#else
+ FILEFLAGS 0
+#endif
+ FILEOS VOS__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", ZLIB_VERSION "\0"
+ VALUE "InternalName", "zlib1.dll\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
+ VALUE "OriginalFilename", "zlib1.dll\0"
+ VALUE "ProductName", "zlib\0"
+ VALUE "ProductVersion", ZLIB_VERSION "\0"
+ VALUE "Comments", "For more information visit http://www.zlib.net/\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0409, 1252
+ END
+END
diff --git a/compat/zlib/win64/libz.dll.a b/compat/zlib/win64/libz.dll.a
new file mode 100644
index 0000000..a3ae403
--- /dev/null
+++ b/compat/zlib/win64/libz.dll.a
Binary files differ
diff --git a/compat/zlib/win64/zdll.lib b/compat/zlib/win64/zdll.lib
new file mode 100644
index 0000000..ac9ffc9
--- /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 100755
index 0000000..bd1dbc6
--- /dev/null
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
diff --git a/compat/zlib/zconf.h b/compat/zlib/zconf.h
new file mode 100644
index 0000000..9987a77
--- /dev/null
+++ b/compat/zlib/zconf.h
@@ -0,0 +1,511 @@
+/* zconf.h -- configuration of the zlib compression library
+ * Copyright (C) 1995-2013 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#ifndef ZCONF_H
+#define ZCONF_H
+
+/*
+ * If you *really* need a unique prefix for all types and library functions,
+ * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
+ * Even better than compiling with -DZ_PREFIX would be to use configure to set
+ * 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
+# define _length_code z__length_code
+# define _tr_align z__tr_align
+# define _tr_flush_bits z__tr_flush_bits
+# define _tr_flush_block z__tr_flush_block
+# define _tr_init z__tr_init
+# define _tr_stored_block z__tr_stored_block
+# define _tr_tally z__tr_tally
+# define adler32 z_adler32
+# define adler32_combine z_adler32_combine
+# define adler32_combine64 z_adler32_combine64
+# 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
+# define deflate z_deflate
+# define deflateBound z_deflateBound
+# define deflateCopy z_deflateCopy
+# define deflateEnd z_deflateEnd
+# 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
+# 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 gzvprintf z_gzvprintf
+# 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
+# define inflateBackInit_ z_inflateBackInit_
+# define inflateCopy z_inflateCopy
+# define inflateEnd z_inflateEnd
+# define inflateGetHeader z_inflateGetHeader
+# define inflateInit2_ z_inflateInit2_
+# define inflateInit_ z_inflateInit_
+# define inflateMark z_inflateMark
+# define inflatePrime z_inflatePrime
+# define inflateReset z_inflateReset
+# define inflateReset2 z_inflateReset2
+# define inflateSetDictionary z_inflateSetDictionary
+# define inflateGetDictionary z_inflateGetDictionary
+# 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
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
+# define zError z_zError
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
+# define zlibCompileFlags z_zlibCompileFlags
+# define zlibVersion z_zlibVersion
+
+/* all zlib typedefs in zlib.h and zconf.h */
+# define Byte z_Byte
+# define Bytef z_Bytef
+# define alloc_func z_alloc_func
+# define charf z_charf
+# define free_func z_free_func
+# 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
+# define intf z_intf
+# define out_func z_out_func
+# define uInt z_uInt
+# define uIntf z_uIntf
+# define uLong z_uLong
+# define uLongf z_uLongf
+# define voidp z_voidp
+# define voidpc z_voidpc
+# define voidpf z_voidpf
+
+/* all zlib structs in zlib.h and zconf.h */
+# define gz_header_s z_gz_header_s
+# define internal_state z_internal_state
+
+#endif
+
+#if defined(__MSDOS__) && !defined(MSDOS)
+# define MSDOS
+#endif
+#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
+# define OS2
+#endif
+#if defined(_WINDOWS) && !defined(WINDOWS)
+# define WINDOWS
+#endif
+#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
+# ifndef WIN32
+# define WIN32
+# endif
+#endif
+#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
+# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
+# ifndef SYS16BIT
+# define SYS16BIT
+# endif
+# endif
+#endif
+
+/*
+ * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+ * than 64k bytes at a time (needed on systems with 16-bit int).
+ */
+#ifdef SYS16BIT
+# define MAXSEG_64K
+#endif
+#ifdef MSDOS
+# define UNALIGNED_OK
+#endif
+
+#ifdef __STDC_VERSION__
+# ifndef STDC
+# define STDC
+# endif
+# if __STDC_VERSION__ >= 199901L
+# ifndef STDC99
+# define STDC99
+# endif
+# endif
+#endif
+#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
+# define STDC
+#endif
+
+#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */
+# define STDC
+#endif
+
+#ifndef STDC
+# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
+# define const /* note: need a more gentle solution here */
+# 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
+#endif
+
+/* Maximum value for memLevel in deflateInit2 */
+#ifndef MAX_MEM_LEVEL
+# ifdef MAXSEG_64K
+# define MAX_MEM_LEVEL 8
+# else
+# define MAX_MEM_LEVEL 9
+# endif
+#endif
+
+/* Maximum value for windowBits in deflateInit2 and inflateInit2.
+ * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
+ * created by gzip. (Files created by minigzip can still be extracted by
+ * gzip.)
+ */
+#ifndef MAX_WBITS
+# define MAX_WBITS 15 /* 32K LZ77 window */
+#endif
+
+/* The memory requirements for deflate are (in bytes):
+ (1 << (windowBits+2)) + (1 << (memLevel+9))
+ that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+ make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 << windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects.
+*/
+
+ /* Type declarations */
+
+#ifndef OF /* function prototypes */
+# ifdef STDC
+# define OF(args) args
+# else
+# define OF(args) ()
+# 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
+ * to define NO_MEMCPY in zutil.h. If you don't need the mixed model,
+ * just define FAR to be empty.
+ */
+#ifdef SYS16BIT
+# if defined(M_I86SM) || defined(M_I86MM)
+ /* MSC small or medium model */
+# define SMALL_MEDIUM
+# ifdef _MSC_VER
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+# if (defined(__SMALL__) || defined(__MEDIUM__))
+ /* Turbo C small or medium model */
+# define SMALL_MEDIUM
+# ifdef __BORLANDC__
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+#endif
+
+#if defined(WINDOWS) || defined(WIN32)
+ /* If building or using zlib as a DLL, define ZLIB_DLL.
+ * This is not mandatory, but it offers a little performance increase.
+ */
+# ifdef ZLIB_DLL
+# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
+# ifdef ZLIB_INTERNAL
+# define ZEXTERN extern __declspec(dllexport)
+# else
+# define ZEXTERN extern __declspec(dllimport)
+# endif
+# endif
+# endif /* ZLIB_DLL */
+ /* If building or using zlib with the WINAPI/WINAPIV calling convention,
+ * define ZLIB_WINAPI.
+ * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
+ */
+# ifdef ZLIB_WINAPI
+# ifdef FAR
+# undef FAR
+# endif
+# include <windows.h>
+ /* No need for _export, use ZLIB.DEF instead. */
+ /* For complete Windows compatibility, use WINAPI, not __stdcall. */
+# define ZEXPORT WINAPI
+# ifdef WIN32
+# define ZEXPORTVA WINAPIV
+# else
+# define ZEXPORTVA FAR CDECL
+# endif
+# endif
+#endif
+
+#if defined (__BEOS__)
+# ifdef ZLIB_DLL
+# ifdef ZLIB_INTERNAL
+# define ZEXPORT __declspec(dllexport)
+# define ZEXPORTVA __declspec(dllexport)
+# else
+# define ZEXPORT __declspec(dllimport)
+# define ZEXPORTVA __declspec(dllimport)
+# endif
+# endif
+#endif
+
+#ifndef ZEXTERN
+# define ZEXTERN extern
+#endif
+#ifndef ZEXPORT
+# define ZEXPORT
+#endif
+#ifndef ZEXPORTVA
+# define ZEXPORTVA
+#endif
+
+#ifndef FAR
+# define FAR
+#endif
+
+#if !defined(__MACTYPES__)
+typedef unsigned char Byte; /* 8 bits */
+#endif
+typedef unsigned int uInt; /* 16 bits or more */
+typedef unsigned long uLong; /* 32 bits or more */
+
+#ifdef SMALL_MEDIUM
+ /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
+# define Bytef Byte FAR
+#else
+ typedef Byte FAR Bytef;
+#endif
+typedef char FAR charf;
+typedef int FAR intf;
+typedef uInt FAR uIntf;
+typedef uLong FAR uLongf;
+
+#ifdef STDC
+ typedef void const *voidpc;
+ typedef void FAR *voidpf;
+ typedef void *voidp;
+#else
+ typedef Byte const *voidpc;
+ typedef Byte FAR *voidpf;
+ typedef Byte *voidp;
+#endif
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# elif (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# elif (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# 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
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# ifndef Z_SOLO
+# include <stdarg.h> /* for va_list */
+# endif
+#endif
+
+#ifdef _WIN32
+# ifndef Z_SOLO
+# include <stddef.h> /* for wchar_t */
+# endif
+#endif
+
+/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
+ * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
+ * though the former does not conform to the LFS document), but considering
+ * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
+ * equivalently requesting no 64-bit operations
+ */
+#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
+# undef _LARGEFILE64_SOURCE
+#endif
+
+#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
+
+#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" */
+#endif
+
+#ifndef z_off_t
+# define z_off_t long
+#endif
+
+#if !defined(_WIN32) && defined(Z_LARGE64)
+# define z_off64_t off64_t
+#else
+# 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 */
+#if defined(__MVS__)
+ #pragma map(deflateInit_,"DEIN")
+ #pragma map(deflateInit2_,"DEIN2")
+ #pragma map(deflateEnd,"DEEND")
+ #pragma map(deflateBound,"DEBND")
+ #pragma map(inflateInit_,"ININ")
+ #pragma map(inflateInit2_,"ININ2")
+ #pragma map(inflateEnd,"INEND")
+ #pragma map(inflateSync,"INSY")
+ #pragma map(inflateSetDictionary,"INSEDI")
+ #pragma map(compressBound,"CMBND")
+ #pragma map(inflate_table,"INTABL")
+ #pragma map(inflate_fast,"INFA")
+ #pragma map(inflate_copyright,"INCOPY")
+#endif
+
+#endif /* ZCONF_H */
diff --git a/compat/zlib/zconf.h.cmakein b/compat/zlib/zconf.h.cmakein
new file mode 100644
index 0000000..043019c
--- /dev/null
+++ b/compat/zlib/zconf.h.cmakein
@@ -0,0 +1,513 @@
+/* zconf.h -- configuration of the zlib compression library
+ * Copyright (C) 1995-2013 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#ifndef ZCONF_H
+#define ZCONF_H
+#cmakedefine Z_PREFIX
+#cmakedefine Z_HAVE_UNISTD_H
+
+/*
+ * If you *really* need a unique prefix for all types and library functions,
+ * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
+ * Even better than compiling with -DZ_PREFIX would be to use configure to set
+ * 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
+# define _length_code z__length_code
+# define _tr_align z__tr_align
+# define _tr_flush_bits z__tr_flush_bits
+# define _tr_flush_block z__tr_flush_block
+# define _tr_init z__tr_init
+# define _tr_stored_block z__tr_stored_block
+# define _tr_tally z__tr_tally
+# define adler32 z_adler32
+# define adler32_combine z_adler32_combine
+# define adler32_combine64 z_adler32_combine64
+# 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
+# define deflate z_deflate
+# define deflateBound z_deflateBound
+# define deflateCopy z_deflateCopy
+# define deflateEnd z_deflateEnd
+# 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
+# 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 gzvprintf z_gzvprintf
+# 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
+# define inflateBackInit_ z_inflateBackInit_
+# define inflateCopy z_inflateCopy
+# define inflateEnd z_inflateEnd
+# define inflateGetHeader z_inflateGetHeader
+# define inflateInit2_ z_inflateInit2_
+# define inflateInit_ z_inflateInit_
+# define inflateMark z_inflateMark
+# define inflatePrime z_inflatePrime
+# define inflateReset z_inflateReset
+# define inflateReset2 z_inflateReset2
+# define inflateSetDictionary z_inflateSetDictionary
+# define inflateGetDictionary z_inflateGetDictionary
+# 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
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
+# define zError z_zError
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
+# define zlibCompileFlags z_zlibCompileFlags
+# define zlibVersion z_zlibVersion
+
+/* all zlib typedefs in zlib.h and zconf.h */
+# define Byte z_Byte
+# define Bytef z_Bytef
+# define alloc_func z_alloc_func
+# define charf z_charf
+# define free_func z_free_func
+# 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
+# define intf z_intf
+# define out_func z_out_func
+# define uInt z_uInt
+# define uIntf z_uIntf
+# define uLong z_uLong
+# define uLongf z_uLongf
+# define voidp z_voidp
+# define voidpc z_voidpc
+# define voidpf z_voidpf
+
+/* all zlib structs in zlib.h and zconf.h */
+# define gz_header_s z_gz_header_s
+# define internal_state z_internal_state
+
+#endif
+
+#if defined(__MSDOS__) && !defined(MSDOS)
+# define MSDOS
+#endif
+#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
+# define OS2
+#endif
+#if defined(_WINDOWS) && !defined(WINDOWS)
+# define WINDOWS
+#endif
+#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
+# ifndef WIN32
+# define WIN32
+# endif
+#endif
+#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
+# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
+# ifndef SYS16BIT
+# define SYS16BIT
+# endif
+# endif
+#endif
+
+/*
+ * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+ * than 64k bytes at a time (needed on systems with 16-bit int).
+ */
+#ifdef SYS16BIT
+# define MAXSEG_64K
+#endif
+#ifdef MSDOS
+# define UNALIGNED_OK
+#endif
+
+#ifdef __STDC_VERSION__
+# ifndef STDC
+# define STDC
+# endif
+# if __STDC_VERSION__ >= 199901L
+# ifndef STDC99
+# define STDC99
+# endif
+# endif
+#endif
+#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
+# define STDC
+#endif
+
+#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */
+# define STDC
+#endif
+
+#ifndef STDC
+# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
+# define const /* note: need a more gentle solution here */
+# 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
+#endif
+
+/* Maximum value for memLevel in deflateInit2 */
+#ifndef MAX_MEM_LEVEL
+# ifdef MAXSEG_64K
+# define MAX_MEM_LEVEL 8
+# else
+# define MAX_MEM_LEVEL 9
+# endif
+#endif
+
+/* Maximum value for windowBits in deflateInit2 and inflateInit2.
+ * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
+ * created by gzip. (Files created by minigzip can still be extracted by
+ * gzip.)
+ */
+#ifndef MAX_WBITS
+# define MAX_WBITS 15 /* 32K LZ77 window */
+#endif
+
+/* The memory requirements for deflate are (in bytes):
+ (1 << (windowBits+2)) + (1 << (memLevel+9))
+ that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+ make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 << windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects.
+*/
+
+ /* Type declarations */
+
+#ifndef OF /* function prototypes */
+# ifdef STDC
+# define OF(args) args
+# else
+# define OF(args) ()
+# 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
+ * to define NO_MEMCPY in zutil.h. If you don't need the mixed model,
+ * just define FAR to be empty.
+ */
+#ifdef SYS16BIT
+# if defined(M_I86SM) || defined(M_I86MM)
+ /* MSC small or medium model */
+# define SMALL_MEDIUM
+# ifdef _MSC_VER
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+# if (defined(__SMALL__) || defined(__MEDIUM__))
+ /* Turbo C small or medium model */
+# define SMALL_MEDIUM
+# ifdef __BORLANDC__
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+#endif
+
+#if defined(WINDOWS) || defined(WIN32)
+ /* If building or using zlib as a DLL, define ZLIB_DLL.
+ * This is not mandatory, but it offers a little performance increase.
+ */
+# ifdef ZLIB_DLL
+# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
+# ifdef ZLIB_INTERNAL
+# define ZEXTERN extern __declspec(dllexport)
+# else
+# define ZEXTERN extern __declspec(dllimport)
+# endif
+# endif
+# endif /* ZLIB_DLL */
+ /* If building or using zlib with the WINAPI/WINAPIV calling convention,
+ * define ZLIB_WINAPI.
+ * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
+ */
+# ifdef ZLIB_WINAPI
+# ifdef FAR
+# undef FAR
+# endif
+# include <windows.h>
+ /* No need for _export, use ZLIB.DEF instead. */
+ /* For complete Windows compatibility, use WINAPI, not __stdcall. */
+# define ZEXPORT WINAPI
+# ifdef WIN32
+# define ZEXPORTVA WINAPIV
+# else
+# define ZEXPORTVA FAR CDECL
+# endif
+# endif
+#endif
+
+#if defined (__BEOS__)
+# ifdef ZLIB_DLL
+# ifdef ZLIB_INTERNAL
+# define ZEXPORT __declspec(dllexport)
+# define ZEXPORTVA __declspec(dllexport)
+# else
+# define ZEXPORT __declspec(dllimport)
+# define ZEXPORTVA __declspec(dllimport)
+# endif
+# endif
+#endif
+
+#ifndef ZEXTERN
+# define ZEXTERN extern
+#endif
+#ifndef ZEXPORT
+# define ZEXPORT
+#endif
+#ifndef ZEXPORTVA
+# define ZEXPORTVA
+#endif
+
+#ifndef FAR
+# define FAR
+#endif
+
+#if !defined(__MACTYPES__)
+typedef unsigned char Byte; /* 8 bits */
+#endif
+typedef unsigned int uInt; /* 16 bits or more */
+typedef unsigned long uLong; /* 32 bits or more */
+
+#ifdef SMALL_MEDIUM
+ /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
+# define Bytef Byte FAR
+#else
+ typedef Byte FAR Bytef;
+#endif
+typedef char FAR charf;
+typedef int FAR intf;
+typedef uInt FAR uIntf;
+typedef uLong FAR uLongf;
+
+#ifdef STDC
+ typedef void const *voidpc;
+ typedef void FAR *voidpf;
+ typedef void *voidp;
+#else
+ typedef Byte const *voidpc;
+ typedef Byte FAR *voidpf;
+ typedef Byte *voidp;
+#endif
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# elif (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# elif (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# 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
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# ifndef Z_SOLO
+# include <stdarg.h> /* for va_list */
+# endif
+#endif
+
+#ifdef _WIN32
+# ifndef Z_SOLO
+# include <stddef.h> /* for wchar_t */
+# endif
+#endif
+
+/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
+ * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
+ * though the former does not conform to the LFS document), but considering
+ * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
+ * equivalently requesting no 64-bit operations
+ */
+#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
+# undef _LARGEFILE64_SOURCE
+#endif
+
+#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
+
+#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" */
+#endif
+
+#ifndef z_off_t
+# define z_off_t long
+#endif
+
+#if !defined(_WIN32) && defined(Z_LARGE64)
+# define z_off64_t off64_t
+#else
+# 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 */
+#if defined(__MVS__)
+ #pragma map(deflateInit_,"DEIN")
+ #pragma map(deflateInit2_,"DEIN2")
+ #pragma map(deflateEnd,"DEEND")
+ #pragma map(deflateBound,"DEBND")
+ #pragma map(inflateInit_,"ININ")
+ #pragma map(inflateInit2_,"ININ2")
+ #pragma map(inflateEnd,"INEND")
+ #pragma map(inflateSync,"INSY")
+ #pragma map(inflateSetDictionary,"INSEDI")
+ #pragma map(compressBound,"CMBND")
+ #pragma map(inflate_table,"INTABL")
+ #pragma map(inflate_fast,"INFA")
+ #pragma map(inflate_copyright,"INCOPY")
+#endif
+
+#endif /* ZCONF_H */
diff --git a/compat/zlib/zconf.h.in b/compat/zlib/zconf.h.in
new file mode 100644
index 0000000..9987a77
--- /dev/null
+++ b/compat/zlib/zconf.h.in
@@ -0,0 +1,511 @@
+/* zconf.h -- configuration of the zlib compression library
+ * Copyright (C) 1995-2013 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#ifndef ZCONF_H
+#define ZCONF_H
+
+/*
+ * If you *really* need a unique prefix for all types and library functions,
+ * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
+ * Even better than compiling with -DZ_PREFIX would be to use configure to set
+ * 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
+# define _length_code z__length_code
+# define _tr_align z__tr_align
+# define _tr_flush_bits z__tr_flush_bits
+# define _tr_flush_block z__tr_flush_block
+# define _tr_init z__tr_init
+# define _tr_stored_block z__tr_stored_block
+# define _tr_tally z__tr_tally
+# define adler32 z_adler32
+# define adler32_combine z_adler32_combine
+# define adler32_combine64 z_adler32_combine64
+# 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
+# define deflate z_deflate
+# define deflateBound z_deflateBound
+# define deflateCopy z_deflateCopy
+# define deflateEnd z_deflateEnd
+# 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
+# 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 gzvprintf z_gzvprintf
+# 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
+# define inflateBackInit_ z_inflateBackInit_
+# define inflateCopy z_inflateCopy
+# define inflateEnd z_inflateEnd
+# define inflateGetHeader z_inflateGetHeader
+# define inflateInit2_ z_inflateInit2_
+# define inflateInit_ z_inflateInit_
+# define inflateMark z_inflateMark
+# define inflatePrime z_inflatePrime
+# define inflateReset z_inflateReset
+# define inflateReset2 z_inflateReset2
+# define inflateSetDictionary z_inflateSetDictionary
+# define inflateGetDictionary z_inflateGetDictionary
+# 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
+# ifndef Z_SOLO
+# define uncompress z_uncompress
+# endif
+# define zError z_zError
+# ifndef Z_SOLO
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# endif
+# define zlibCompileFlags z_zlibCompileFlags
+# define zlibVersion z_zlibVersion
+
+/* all zlib typedefs in zlib.h and zconf.h */
+# define Byte z_Byte
+# define Bytef z_Bytef
+# define alloc_func z_alloc_func
+# define charf z_charf
+# define free_func z_free_func
+# 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
+# define intf z_intf
+# define out_func z_out_func
+# define uInt z_uInt
+# define uIntf z_uIntf
+# define uLong z_uLong
+# define uLongf z_uLongf
+# define voidp z_voidp
+# define voidpc z_voidpc
+# define voidpf z_voidpf
+
+/* all zlib structs in zlib.h and zconf.h */
+# define gz_header_s z_gz_header_s
+# define internal_state z_internal_state
+
+#endif
+
+#if defined(__MSDOS__) && !defined(MSDOS)
+# define MSDOS
+#endif
+#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
+# define OS2
+#endif
+#if defined(_WINDOWS) && !defined(WINDOWS)
+# define WINDOWS
+#endif
+#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
+# ifndef WIN32
+# define WIN32
+# endif
+#endif
+#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
+# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
+# ifndef SYS16BIT
+# define SYS16BIT
+# endif
+# endif
+#endif
+
+/*
+ * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+ * than 64k bytes at a time (needed on systems with 16-bit int).
+ */
+#ifdef SYS16BIT
+# define MAXSEG_64K
+#endif
+#ifdef MSDOS
+# define UNALIGNED_OK
+#endif
+
+#ifdef __STDC_VERSION__
+# ifndef STDC
+# define STDC
+# endif
+# if __STDC_VERSION__ >= 199901L
+# ifndef STDC99
+# define STDC99
+# endif
+# endif
+#endif
+#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
+# define STDC
+#endif
+
+#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */
+# define STDC
+#endif
+
+#ifndef STDC
+# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
+# define const /* note: need a more gentle solution here */
+# 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
+#endif
+
+/* Maximum value for memLevel in deflateInit2 */
+#ifndef MAX_MEM_LEVEL
+# ifdef MAXSEG_64K
+# define MAX_MEM_LEVEL 8
+# else
+# define MAX_MEM_LEVEL 9
+# endif
+#endif
+
+/* Maximum value for windowBits in deflateInit2 and inflateInit2.
+ * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
+ * created by gzip. (Files created by minigzip can still be extracted by
+ * gzip.)
+ */
+#ifndef MAX_WBITS
+# define MAX_WBITS 15 /* 32K LZ77 window */
+#endif
+
+/* The memory requirements for deflate are (in bytes):
+ (1 << (windowBits+2)) + (1 << (memLevel+9))
+ that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+ make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 << windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects.
+*/
+
+ /* Type declarations */
+
+#ifndef OF /* function prototypes */
+# ifdef STDC
+# define OF(args) args
+# else
+# define OF(args) ()
+# 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
+ * to define NO_MEMCPY in zutil.h. If you don't need the mixed model,
+ * just define FAR to be empty.
+ */
+#ifdef SYS16BIT
+# if defined(M_I86SM) || defined(M_I86MM)
+ /* MSC small or medium model */
+# define SMALL_MEDIUM
+# ifdef _MSC_VER
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+# if (defined(__SMALL__) || defined(__MEDIUM__))
+ /* Turbo C small or medium model */
+# define SMALL_MEDIUM
+# ifdef __BORLANDC__
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+#endif
+
+#if defined(WINDOWS) || defined(WIN32)
+ /* If building or using zlib as a DLL, define ZLIB_DLL.
+ * This is not mandatory, but it offers a little performance increase.
+ */
+# ifdef ZLIB_DLL
+# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
+# ifdef ZLIB_INTERNAL
+# define ZEXTERN extern __declspec(dllexport)
+# else
+# define ZEXTERN extern __declspec(dllimport)
+# endif
+# endif
+# endif /* ZLIB_DLL */
+ /* If building or using zlib with the WINAPI/WINAPIV calling convention,
+ * define ZLIB_WINAPI.
+ * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
+ */
+# ifdef ZLIB_WINAPI
+# ifdef FAR
+# undef FAR
+# endif
+# include <windows.h>
+ /* No need for _export, use ZLIB.DEF instead. */
+ /* For complete Windows compatibility, use WINAPI, not __stdcall. */
+# define ZEXPORT WINAPI
+# ifdef WIN32
+# define ZEXPORTVA WINAPIV
+# else
+# define ZEXPORTVA FAR CDECL
+# endif
+# endif
+#endif
+
+#if defined (__BEOS__)
+# ifdef ZLIB_DLL
+# ifdef ZLIB_INTERNAL
+# define ZEXPORT __declspec(dllexport)
+# define ZEXPORTVA __declspec(dllexport)
+# else
+# define ZEXPORT __declspec(dllimport)
+# define ZEXPORTVA __declspec(dllimport)
+# endif
+# endif
+#endif
+
+#ifndef ZEXTERN
+# define ZEXTERN extern
+#endif
+#ifndef ZEXPORT
+# define ZEXPORT
+#endif
+#ifndef ZEXPORTVA
+# define ZEXPORTVA
+#endif
+
+#ifndef FAR
+# define FAR
+#endif
+
+#if !defined(__MACTYPES__)
+typedef unsigned char Byte; /* 8 bits */
+#endif
+typedef unsigned int uInt; /* 16 bits or more */
+typedef unsigned long uLong; /* 32 bits or more */
+
+#ifdef SMALL_MEDIUM
+ /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
+# define Bytef Byte FAR
+#else
+ typedef Byte FAR Bytef;
+#endif
+typedef char FAR charf;
+typedef int FAR intf;
+typedef uInt FAR uIntf;
+typedef uLong FAR uLongf;
+
+#ifdef STDC
+ typedef void const *voidpc;
+ typedef void FAR *voidpf;
+ typedef void *voidp;
+#else
+ typedef Byte const *voidpc;
+ typedef Byte FAR *voidpf;
+ typedef Byte *voidp;
+#endif
+
+#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
+# include <limits.h>
+# if (UINT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned
+# elif (ULONG_MAX == 0xffffffffUL)
+# define Z_U4 unsigned long
+# elif (USHRT_MAX == 0xffffffffUL)
+# define Z_U4 unsigned short
+# 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
+# ifndef Z_SOLO
+# include <sys/types.h> /* for off_t */
+# endif
+#endif
+
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# ifndef Z_SOLO
+# include <stdarg.h> /* for va_list */
+# endif
+#endif
+
+#ifdef _WIN32
+# ifndef Z_SOLO
+# include <stddef.h> /* for wchar_t */
+# endif
+#endif
+
+/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
+ * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
+ * though the former does not conform to the LFS document), but considering
+ * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
+ * equivalently requesting no 64-bit operations
+ */
+#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
+# undef _LARGEFILE64_SOURCE
+#endif
+
+#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
+
+#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" */
+#endif
+
+#ifndef z_off_t
+# define z_off_t long
+#endif
+
+#if !defined(_WIN32) && defined(Z_LARGE64)
+# define z_off64_t off64_t
+#else
+# 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 */
+#if defined(__MVS__)
+ #pragma map(deflateInit_,"DEIN")
+ #pragma map(deflateInit2_,"DEIN2")
+ #pragma map(deflateEnd,"DEEND")
+ #pragma map(deflateBound,"DEBND")
+ #pragma map(inflateInit_,"ININ")
+ #pragma map(inflateInit2_,"ININ2")
+ #pragma map(inflateEnd,"INEND")
+ #pragma map(inflateSync,"INSY")
+ #pragma map(inflateSetDictionary,"INSEDI")
+ #pragma map(compressBound,"CMBND")
+ #pragma map(inflate_table,"INTABL")
+ #pragma map(inflate_fast,"INFA")
+ #pragma map(inflate_copyright,"INCOPY")
+#endif
+
+#endif /* ZCONF_H */
diff --git a/compat/zlib/zlib.3 b/compat/zlib/zlib.3
new file mode 100644
index 0000000..0160e62
--- /dev/null
+++ b/compat/zlib/zlib.3
@@ -0,0 +1,151 @@
+.TH ZLIB 3 "28 Apr 2013"
+.SH NAME
+zlib \- compression/decompression library
+.SH SYNOPSIS
+[see
+.I zlib.h
+for full description]
+.SH DESCRIPTION
+The
+.I zlib
+library is a general purpose data compression library.
+The code is thread safe, assuming that the standard library functions
+used are thread safe, such as memory allocation routines.
+It provides in-memory compression and decompression functions,
+including integrity checks of the uncompressed data.
+This version of the library supports only one compression method (deflation)
+but other algorithms may be added later
+with the same stream interface.
+.LP
+Compression can be done in a single step if the buffers are large enough
+or can be done by repeated calls of the compression function.
+In the latter case,
+the application must provide more input and/or consume the output
+(providing more output space) before each call.
+.LP
+The library also supports reading and writing files in
+.IR gzip (1)
+(.gz) format
+with an interface similar to that of stdio.
+.LP
+The library does not install any signal handler.
+The decoder checks the consistency of the compressed data,
+so the library should never crash even in the case of corrupted input.
+.LP
+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 test/example.c
+and
+.IR test/minigzip.c,
+as well as other examples in the
+.IR examples/
+directory.
+.LP
+Changes to this version are documented in the file
+.I ChangeLog
+that accompanies the source.
+.LP
+.I zlib
+is available in Java using the java.util.zip package:
+.IP
+http://java.sun.com/developer/technicalArticles/Programming/compression/
+.LP
+A Perl interface to
+.IR zlib ,
+written by Paul Marquess (pmqs@cpan.org),
+is available at CPAN (Comprehensive Perl Archive Network) sites,
+including:
+.IP
+http://search.cpan.org/~pmqs/IO-Compress-Zlib/
+.LP
+A Python interface to
+.IR zlib ,
+written by A.M. Kuchling (amk@magnet.com),
+is available in Python 1.5 and later versions:
+.IP
+http://docs.python.org/library/zlib.html
+.LP
+.I zlib
+is built into
+.IR tcl:
+.IP
+http://wiki.tcl.tk/4610
+.LP
+An experimental package to read and write files in .zip format,
+written on top of
+.I zlib
+by Gilles Vollant (info@winimage.com),
+is available at:
+.IP
+http://www.winimage.com/zLibDll/minizip.html
+and also in the
+.I contrib/minizip
+directory of the main
+.I zlib
+source distribution.
+.SH "SEE ALSO"
+The
+.I zlib
+web site can be found at:
+.IP
+http://zlib.net/
+.LP
+The data format used by the zlib library is described by RFC
+(Request for Comments) 1950 to 1952 in the files:
+.IP
+http://tools.ietf.org/html/rfc1950 (for the zlib header and trailer format)
+.br
+http://tools.ietf.org/html/rfc1951 (for the deflate compressed data format)
+.br
+http://tools.ietf.org/html/rfc1952 (for the gzip header and trailer format)
+.LP
+Mark Nelson wrote an article about
+.I zlib
+for the Jan. 1997 issue of Dr. Dobb's Journal;
+a copy of the article is available at:
+.IP
+http://marknelson.us/1997/01/01/zlib-engine/
+.SH "REPORTING PROBLEMS"
+Before reporting a problem,
+please check the
+.I zlib
+web site to verify that you have the latest version of
+.IR zlib ;
+otherwise,
+obtain the latest version and see if the problem still exists.
+Please read the
+.I zlib
+FAQ at:
+.IP
+http://zlib.net/zlib_faq.html
+.LP
+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.8
+Copyright (C) 1995-2013 Jean-loup Gailly (jloup@gzip.org)
+and Mark Adler (madler@alumni.caltech.edu).
+.LP
+This software is provided "as-is,"
+without any express or implied warranty.
+In no event will the authors be held liable for any damages
+arising from the use of this software.
+See the distribution directory with respect to requirements
+governing redistribution.
+The deflate format used by
+.I zlib
+was defined by Phil Katz.
+The deflate and
+.I zlib
+specifications were written by L. Peter Deutsch.
+Thanks to all the people who reported problems and suggested various
+improvements in
+.IR zlib ;
+who are too numerous to cite here.
+.LP
+UNIX manual page by R. P. C. Rodgers,
+U.S. National Library of Medicine (rodgers@nlm.nih.gov).
+.\" end of man page
diff --git a/compat/zlib/zlib.3.pdf b/compat/zlib/zlib.3.pdf
new file mode 100644
index 0000000..a346b5d
--- /dev/null
+++ b/compat/zlib/zlib.3.pdf
Binary files differ
diff --git a/compat/zlib/zlib.h b/compat/zlib/zlib.h
new file mode 100644
index 0000000..3e0c767
--- /dev/null
+++ b/compat/zlib/zlib.h
@@ -0,0 +1,1768 @@
+/* zlib.h -- interface of the 'zlib' general purpose compression library
+ version 1.2.8, April 28th, 2013
+
+ Copyright (C) 1995-2013 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
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup@gzip.org madler@alumni.caltech.edu
+
+
+ The data format used by the zlib library is described by RFCs (Request for
+ 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
+#define ZLIB_H
+
+#include "zconf.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define ZLIB_VERSION "1.2.8"
+#define ZLIB_VERNUM 0x1280
+#define ZLIB_VER_MAJOR 1
+#define ZLIB_VER_MINOR 2
+#define ZLIB_VER_REVISION 8
+#define ZLIB_VER_SUBREVISION 0
+
+/*
+ The 'zlib' compression library provides in-memory compression and
+ decompression functions, including integrity checks of the uncompressed data.
+ This version of the library supports only one compression method (deflation)
+ but other algorithms will be added later and will have the same stream
+ interface.
+
+ Compression can be done in a single step if the buffers are large enough,
+ or can be done by repeated calls of the compression function. In the latter
+ case, the application must provide more input and/or consume the output
+ (providing more output space) before each call.
+
+ The compressed data format used by default by the in-memory functions is
+ the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped
+ around a deflate stream, which is itself documented in RFC 1951.
+
+ The library also supports reading and writing files in gzip (.gz) format
+ with an interface similar to that of stdio using the functions that start
+ with "gz". The gzip format is different from the zlib format. gzip is a
+ gzip wrapper, documented in RFC 1952, wrapped around a deflate stream.
+
+ This library can optionally read and write gzip streams in memory as well.
+
+ The zlib format was designed to be compact and fast for use in memory
+ and on communications channels. The gzip format was designed for single-
+ file compression on file systems, has a larger header than zlib to maintain
+ directory information, and uses a different, slower check method than zlib.
+
+ The library does not install any signal handler. The decoder checks
+ the consistency of the compressed data, so the library should never crash
+ even in case of corrupted input.
+*/
+
+typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size));
+typedef void (*free_func) OF((voidpf opaque, voidpf address));
+
+struct internal_state;
+
+typedef struct z_stream_s {
+ z_const Bytef *next_in; /* next input byte */
+ uInt avail_in; /* number of bytes available at next_in */
+ 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 number of bytes output so far */
+
+ 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 */
+ free_func zfree; /* used to free the internal state */
+ voidpf opaque; /* private data object passed to zalloc and zfree */
+
+ int data_type; /* best guess about the data type: binary or text */
+ uLong adler; /* adler32 value of the uncompressed data */
+ uLong reserved; /* reserved for future use */
+} z_stream;
+
+typedef z_stream FAR *z_streamp;
+
+/*
+ gzip header information passed to and from zlib routines. See RFC 1952
+ for more details on the meanings of these fields.
+*/
+typedef struct gz_header_s {
+ int text; /* true if compressed data believed to be text */
+ uLong time; /* modification time */
+ int xflags; /* extra flags (not used when writing a gzip file) */
+ int os; /* operating system */
+ Bytef *extra; /* pointer to extra field or Z_NULL if none */
+ uInt extra_len; /* extra field length (valid if extra != Z_NULL) */
+ uInt extra_max; /* space at extra (only when reading header) */
+ Bytef *name; /* pointer to zero-terminated file name or Z_NULL */
+ uInt name_max; /* space at name (only when reading header) */
+ Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */
+ uInt comm_max; /* space at comment (only when reading header) */
+ int hcrc; /* true if there was or will be a header crc */
+ int done; /* true when done reading gzip header (not used
+ when writing a gzip file) */
+} gz_header;
+
+typedef gz_header FAR *gz_headerp;
+
+/*
+ The application must update next_in and avail_in when avail_in has dropped
+ to zero. It must update next_out and avail_out when avail_out has dropped
+ to zero. The application must initialize zalloc, zfree and opaque before
+ calling the init function. All other fields are set by the compression
+ library and must not be updated by the application.
+
+ The opaque value provided by the application will be passed as the first
+ parameter for calls of zalloc and zfree. This can be useful for custom
+ memory management. The compression library attaches no meaning to the
+ opaque value.
+
+ zalloc must return Z_NULL if there is not enough memory for the object.
+ If zlib is used in a multi-threaded application, zalloc and zfree must be
+ thread safe.
+
+ On 16-bit systems, the functions zalloc and zfree must be able to allocate
+ exactly 65536 bytes, but will not be required to allocate more than this if
+ the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, pointers
+ returned by zalloc for objects of exactly 65536 bytes *must* have their
+ offset normalized to zero. The default allocation function provided by this
+ library ensures this (see zutil.c). To reduce memory requirements and avoid
+ any allocation of 64K objects, at the expense of compression ratio, compile
+ the library with -DMAX_WBITS=14 (see zconf.h).
+
+ The fields total_in and total_out can be used for statistics or progress
+ reports. After compression, total_in holds the total size of the
+ uncompressed data and may be saved for use in the decompressor (particularly
+ if the decompressor wants to decompress everything in a single step).
+*/
+
+ /* constants */
+
+#define Z_NO_FLUSH 0
+#define Z_PARTIAL_FLUSH 1
+#define Z_SYNC_FLUSH 2
+#define Z_FULL_FLUSH 3
+#define Z_FINISH 4
+#define Z_BLOCK 5
+#define Z_TREES 6
+/* Allowed flush values; see deflate() and inflate() below for details */
+
+#define Z_OK 0
+#define Z_STREAM_END 1
+#define Z_NEED_DICT 2
+#define Z_ERRNO (-1)
+#define Z_STREAM_ERROR (-2)
+#define Z_DATA_ERROR (-3)
+#define Z_MEM_ERROR (-4)
+#define Z_BUF_ERROR (-5)
+#define Z_VERSION_ERROR (-6)
+/* Return codes for the compression/decompression functions. Negative values
+ * are errors, positive values are used for special but normal events.
+ */
+
+#define Z_NO_COMPRESSION 0
+#define Z_BEST_SPEED 1
+#define Z_BEST_COMPRESSION 9
+#define Z_DEFAULT_COMPRESSION (-1)
+/* compression levels */
+
+#define Z_FILTERED 1
+#define Z_HUFFMAN_ONLY 2
+#define Z_RLE 3
+#define Z_FIXED 4
+#define Z_DEFAULT_STRATEGY 0
+/* compression strategy; see deflateInit2() below for details */
+
+#define Z_BINARY 0
+#define Z_TEXT 1
+#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */
+#define Z_UNKNOWN 2
+/* Possible values of the data_type field (though see inflate()) */
+
+#define Z_DEFLATED 8
+/* The deflate compression method (the only one supported in this version) */
+
+#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */
+
+#define zlib_version zlibVersion()
+/* for compatibility with versions < 1.0.2 */
+
+
+ /* basic functions */
+
+ZEXTERN const char * ZEXPORT zlibVersion OF((void));
+/* The application can compare zlibVersion and ZLIB_VERSION for consistency.
+ If the first character differs, the library code actually used is not
+ compatible with the zlib.h header file used by the application. This check
+ is automatically made by deflateInit and inflateInit.
+ */
+
+/*
+ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level));
+
+ Initializes the internal stream state for compression. The fields
+ zalloc, zfree and opaque must be initialized before by the caller. If
+ zalloc and zfree are set to Z_NULL, deflateInit updates them to use default
+ allocation functions.
+
+ The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
+ 1 gives best speed, 9 gives best compression, 0 gives no compression at all
+ (the input data is simply copied a block at a time). Z_DEFAULT_COMPRESSION
+ requests a default compromise between speed and compression (currently
+ equivalent to level 6).
+
+ deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if level is not a valid compression level, or
+ Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
+ with the version assumed by the caller (ZLIB_VERSION). msg is set to null
+ if there is no error message. deflateInit does not perform any compression:
+ this will be done by deflate().
+*/
+
+
+ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush));
+/*
+ deflate compresses as much data as possible, and stops when the input
+ buffer becomes empty or the output buffer becomes full. It may introduce
+ some output latency (reading input without producing any output) except when
+ forced to flush.
+
+ The detailed semantics are as follows. deflate performs one or both of the
+ following actions:
+
+ - Compress more input starting at next_in and update next_in and avail_in
+ accordingly. If not all input can be processed (because there is not
+ enough room in the output buffer), next_in and avail_in are updated and
+ processing will resume at this point for the next call of deflate().
+
+ - Provide more output starting at next_out and update next_out and avail_out
+ accordingly. This action is forced if the parameter flush is non zero.
+ Forcing flush frequently degrades the compression ratio, so this parameter
+ should be set only when necessary (in interactive applications). Some
+ output may be provided even if flush is not set.
+
+ Before the call of deflate(), the application should ensure that at least
+ one of the actions is possible, by providing more input and/or consuming more
+ output, and updating avail_in or avail_out accordingly; avail_out should
+ never be zero before the call. The application can consume the compressed
+ output when it wants, for example when the output buffer is full (avail_out
+ == 0), or after each call of deflate(). If deflate returns Z_OK and with
+ zero avail_out, it must be called again after making room in the output
+ buffer because there might be more output pending.
+
+ Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to
+ decide how much data to accumulate before producing output, in order to
+ maximize compression.
+
+ If the parameter flush is set to Z_SYNC_FLUSH, all pending output is
+ flushed to the output buffer and the output is aligned on a byte boundary, so
+ that the decompressor can get all input data available so far. (In
+ particular avail_in is zero after the call if enough output space has been
+ provided before the call.) Flushing may degrade compression for some
+ compression algorithms and so it should be used only when necessary. This
+ completes the current deflate block and follows it with an empty stored block
+ that is three bits plus filler bits to the next byte, followed by four bytes
+ (00 00 ff ff).
+
+ If flush is set to Z_PARTIAL_FLUSH, all pending output is flushed to the
+ output buffer, but the output is not aligned to a byte boundary. All of the
+ input data so far will be available to the decompressor, as for Z_SYNC_FLUSH.
+ This completes the current deflate block and follows it with an empty fixed
+ codes block that is 10 bits long. This assures that enough bytes are output
+ in order for the decompressor to finish the block before the empty fixed code
+ block.
+
+ If flush is set to Z_BLOCK, a deflate block is completed and emitted, as
+ for Z_SYNC_FLUSH, but the output is not aligned on a byte boundary, and up to
+ seven bits of the current block are held to be written as the next byte after
+ the next deflate block is completed. In this case, the decompressor may not
+ be provided enough bits at this point in order to complete decompression of
+ the data provided so far to the compressor. It may need to wait for the next
+ block to be emitted. This is for advanced applications that need to control
+ the emission of deflate blocks.
+
+ If flush is set to Z_FULL_FLUSH, all output is flushed as with
+ Z_SYNC_FLUSH, and the compression state is reset so that decompression can
+ restart from this point if previous compressed data has been damaged or if
+ random access is desired. Using Z_FULL_FLUSH too often can seriously degrade
+ compression.
+
+ If deflate returns with avail_out == 0, this function must be called again
+ with the same value of the flush parameter and more output space (updated
+ avail_out), until the flush is complete (deflate returns with non-zero
+ avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that
+ avail_out is greater than six to avoid repeated flush markers due to
+ avail_out == 0 on return.
+
+ If the parameter flush is set to Z_FINISH, pending input is processed,
+ pending output is flushed and deflate returns with Z_STREAM_END if there was
+ enough output space; if deflate returns with Z_OK, this function must be
+ called again with Z_FINISH and more output space (updated avail_out) but no
+ more input data, until it returns with Z_STREAM_END or an error. After
+ deflate has returned Z_STREAM_END, the only possible operations on the stream
+ are deflateReset or deflateEnd.
+
+ 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). 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).
+
+ deflate() may update strm->data_type if it can make a good guess about
+ the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered
+ binary. This field is only for information purposes and does not affect the
+ compression algorithm in any manner.
+
+ deflate() returns Z_OK if some progress has been made (more input
+ processed or more output produced), Z_STREAM_END if all input has been
+ consumed and all output has been produced (only when flush is set to
+ Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
+ if next_in or next_out was Z_NULL), Z_BUF_ERROR if no progress is possible
+ (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not
+ fatal, and deflate() can be called again with more input and more output
+ space to continue compressing.
+*/
+
+
+ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm));
+/*
+ All dynamically allocated data structures for this stream are freed.
+ This function discards any unprocessed input and does not flush any pending
+ output.
+
+ deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the
+ stream state was inconsistent, Z_DATA_ERROR if the stream was freed
+ prematurely (some input or output was discarded). In the error case, msg
+ may be set but then points to a static string (which must not be
+ deallocated).
+*/
+
+
+/*
+ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm));
+
+ Initializes the internal stream state for decompression. The fields
+ next_in, avail_in, zalloc, zfree and opaque must be initialized before by
+ the caller. If next_in is not Z_NULL and avail_in is large enough (the
+ exact value depends on the compression method), inflateInit determines the
+ compression method from the zlib header and allocates all data structures
+ accordingly; otherwise the allocation will be deferred to the first call of
+ inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to
+ use default allocation functions.
+
+ inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
+ version assumed by the caller, or Z_STREAM_ERROR if the parameters are
+ invalid, such as a null pointer to the structure. msg is set to null if
+ there is no error message. inflateInit does not perform any decompression
+ apart from possibly reading the zlib header if present: actual decompression
+ will be done by inflate(). (So next_in and avail_in may be modified, but
+ next_out and avail_out are unused and unchanged.) The current implementation
+ of inflateInit() does not process any header information -- that is deferred
+ until inflate() is called.
+*/
+
+
+ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush));
+/*
+ inflate decompresses as much data as possible, and stops when the input
+ buffer becomes empty or the output buffer becomes full. It may introduce
+ some output latency (reading input without producing any output) except when
+ forced to flush.
+
+ The detailed semantics are as follows. inflate performs one or both of the
+ following actions:
+
+ - Decompress more input starting at next_in and update next_in and avail_in
+ accordingly. If not all input can be processed (because there is not
+ enough room in the output buffer), next_in is updated and processing will
+ resume at this point for the next call of inflate().
+
+ - Provide more output starting at next_out and update next_out and avail_out
+ accordingly. inflate() provides as much output as possible, until there is
+ no more input data or no more space in the output buffer (see below about
+ the flush parameter).
+
+ Before the call of inflate(), the application should ensure that at least
+ one of the actions is possible, by providing more input and/or consuming more
+ output, and updating the next_* and avail_* values accordingly. The
+ application can consume the uncompressed output when it wants, for example
+ when the output buffer is full (avail_out == 0), or after each call of
+ inflate(). If inflate returns Z_OK and with zero avail_out, it must be
+ called again after making room in the output buffer because there might be
+ more output pending.
+
+ The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FINISH,
+ Z_BLOCK, or Z_TREES. Z_SYNC_FLUSH requests that inflate() flush as much
+ output as possible to the output buffer. Z_BLOCK requests that inflate()
+ stop if and when it gets to the next deflate block boundary. When decoding
+ the zlib or gzip format, this will cause inflate() to return immediately
+ after the header and before the first block. When doing a raw inflate,
+ inflate() will go ahead and process the first block, and will return when it
+ gets to the end of that block, or when it runs out of data.
+
+ The Z_BLOCK option assists in appending to or combining deflate streams.
+ Also to assist in this, on return inflate() will set strm->data_type to the
+ number of unused bits in the last byte taken from strm->next_in, plus 64 if
+ inflate() is currently decoding the last block in the deflate stream, plus
+ 128 if inflate() returned immediately after decoding an end-of-block code or
+ decoding the complete header up to just before the first byte of the deflate
+ stream. The end-of-block will not be indicated until all of the uncompressed
+ data from that block has been written to strm->next_out. The number of
+ unused bits may in general be greater than seven, except when bit 7 of
+ data_type is set, in which case the number of unused bits will be less than
+ eight. data_type is set as noted here every time inflate() returns for all
+ flush options, and so can be used to determine the amount of currently
+ consumed input in bits.
+
+ The Z_TREES option behaves as Z_BLOCK does, but it also returns when the
+ end of each deflate block header is reached, before any actual data in that
+ block is decoded. This allows the caller to determine the length of the
+ deflate block header for later use in random access within a deflate block.
+ 256 is added to the value of strm->data_type when inflate() returns
+ immediately after reaching the end of the deflate block header.
+
+ inflate() should normally be called until it returns Z_STREAM_END or an
+ 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 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 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 Adler-32 checksum of the dictionary
+ chosen by the compressor and returns Z_NEED_DICT; otherwise it sets
+ 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
+ only if the checksum is correct.
+
+ inflate() can decompress and check either zlib-wrapped or gzip-wrapped
+ deflate data. The header type is detected automatically, if requested when
+ 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. 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
+ been reached and all uncompressed output has been produced, Z_NEED_DICT if a
+ preset dictionary is needed at this point, Z_DATA_ERROR if the input data was
+ corrupted (input stream not conforming to the zlib format or incorrect check
+ value), Z_STREAM_ERROR if the stream structure was inconsistent (for example
+ next_in or next_out was Z_NULL), Z_MEM_ERROR if there was not enough memory,
+ Z_BUF_ERROR if no progress is possible or if there was not enough room in the
+ output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and
+ inflate() can be called again with more input and more output space to
+ continue decompressing. If Z_DATA_ERROR is returned, the application may
+ then call inflateSync() to look for a good compression block if a partial
+ recovery of the data is desired.
+*/
+
+
+ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm));
+/*
+ All dynamically allocated data structures for this stream are freed.
+ This function discards any unprocessed input and does not flush any pending
+ output.
+
+ inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state
+ was inconsistent. In the error case, msg may be set but then points to a
+ static string (which must not be deallocated).
+*/
+
+
+ /* Advanced functions */
+
+/*
+ The following functions are needed only in some special applications.
+*/
+
+/*
+ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm,
+ int level,
+ int method,
+ int windowBits,
+ int memLevel,
+ int strategy));
+
+ This is another version of deflateInit with more compression options. The
+ fields next_in, zalloc, zfree and opaque must be initialized before by the
+ caller.
+
+ The method parameter is the compression method. It must be Z_DEFLATED in
+ this version of the library.
+
+ The windowBits parameter is the base two logarithm of the window size
+ (the size of the history buffer). It should be in the range 8..15 for this
+ version of the library. Larger values of this parameter result in better
+ compression at the expense of memory usage. The default value is 15 if
+ deflateInit is used instead.
+
+ windowBits can also be -8..-15 for raw deflate. In this case, -windowBits
+ determines the window size. deflate() will then generate raw deflate data
+ with no zlib header or trailer, and will not compute an adler32 check value.
+
+ windowBits can also be greater than 15 for optional gzip encoding. Add
+ 16 to windowBits to write a simple gzip header and trailer around the
+ compressed data instead of a zlib wrapper. The gzip header will have no
+ file name, no extra data, no comment, no modification time (set to zero), no
+ header crc, and the operating system will be set to 255 (unknown). If a
+ gzip stream is being written, strm->adler is a crc32 instead of an adler32.
+
+ The memLevel parameter specifies how much memory should be allocated
+ for the internal compression state. memLevel=1 uses minimum memory but is
+ slow and reduces compression ratio; memLevel=9 uses maximum memory for
+ optimal speed. The default value is 8. See zconf.h for total memory usage
+ as a function of windowBits and memLevel.
+
+ The strategy parameter is used to tune the compression algorithm. Use the
+ value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
+ filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no
+ string match), or Z_RLE to limit match distances to one (run-length
+ encoding). Filtered data consists mostly of small values with a somewhat
+ random distribution. In this case, the compression algorithm is tuned to
+ compress them better. The effect of Z_FILTERED is to force more Huffman
+ coding and less string matching; it is somewhat intermediate between
+ Z_DEFAULT_STRATEGY and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as
+ fast as Z_HUFFMAN_ONLY, but give better compression for PNG image data. The
+ strategy parameter only affects the compression ratio but not the
+ correctness of the compressed output even if it is not set appropriately.
+ Z_FIXED prevents the use of dynamic Huffman codes, allowing for a simpler
+ decoder for special applications.
+
+ deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if any parameter is invalid (such as an invalid
+ method), or Z_VERSION_ERROR if the zlib library version (zlib_version) is
+ incompatible with the version assumed by the caller (ZLIB_VERSION). msg is
+ set to null if there is no error message. deflateInit2 does not perform any
+ compression: this will be done by deflate().
+*/
+
+ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm,
+ const Bytef *dictionary,
+ uInt dictLength));
+/*
+ Initializes the compression dictionary from the given byte sequence
+ 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
+ used strings preferably put towards the end of the dictionary. Using a
+ dictionary is most useful when the data to be compressed is short and can be
+ predicted with good accuracy; the data can then be compressed better than
+ with the default empty dictionary.
+
+ Depending on the size of the compression data structures selected by
+ deflateInit or deflateInit2, a part of the dictionary may in effect be
+ discarded, for example if the dictionary is larger than the window size
+ provided in deflateInit or deflateInit2. Thus the strings most likely to be
+ useful should be put at the end of the dictionary, not at the front. In
+ addition, the current implementation of deflate will use at most the window
+ size minus 262 bytes of the provided dictionary.
+
+ Upon return of this function, strm->adler is set to the adler32 value
+ of the dictionary; the decompressor may later use this value to determine
+ which dictionary has been used by the compressor. (The adler32 value
+ applies to the whole dictionary even if only a subset of the dictionary is
+ actually used by the compressor.) If a raw deflate was requested, then the
+ adler32 value is not computed and strm->adler is not set.
+
+ 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 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,
+ z_streamp source));
+/*
+ Sets the destination stream as a complete copy of the source stream.
+
+ This function can be useful when several compression strategies will be
+ tried, for example when there are several ways of pre-processing the input
+ data with a filter. The streams that will be discarded should then be freed
+ by calling deflateEnd. Note that deflateCopy duplicates the internal
+ compression state which can be quite large, so this strategy is slow and can
+ consume lots of memory.
+
+ deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
+ (such as zalloc being Z_NULL). msg is left unchanged in both source and
+ destination.
+*/
+
+ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm));
+/*
+ This function is equivalent to deflateEnd followed by deflateInit,
+ but does not free and reallocate all the internal compression state. The
+ stream will keep the same compression level and any other attributes that
+ may have been set by deflateInit2.
+
+ deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL).
+*/
+
+ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm,
+ int level,
+ int strategy));
+/*
+ Dynamically update the compression level and compression strategy. The
+ interpretation of level and strategy is as in deflateInit2. This can be
+ used to switch between compression and straight copy of the input data, or
+ to switch to a different kind of input data requiring a different strategy.
+ If the compression level is changed, the input available so far is
+ compressed with the old level (and may be flushed); the new level will take
+ effect only at the next call of deflate().
+
+ Before the call of deflateParams, the stream state must be set as for
+ a call of deflate(), since the currently available input may have to be
+ compressed and flushed. In particular, strm->avail_out must be non-zero.
+
+ deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source
+ stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR if
+ strm->avail_out was zero.
+*/
+
+ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm,
+ int good_length,
+ int max_lazy,
+ int nice_length,
+ int max_chain));
+/*
+ Fine tune deflate's internal compression parameters. This should only be
+ used by someone who understands the algorithm used by zlib's deflate for
+ searching for the best matching string, and even then only by the most
+ fanatic optimizer trying to squeeze out the last compressed bit for their
+ specific input data. Read the deflate.c source code for the meaning of the
+ max_lazy, good_length, nice_length, and max_chain parameters.
+
+ deflateTune() can be called after deflateInit() or deflateInit2(), and
+ returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream.
+ */
+
+ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm,
+ uLong sourceLen));
+/*
+ deflateBound() returns an upper bound on the compressed size after
+ 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(). 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,
+ int value));
+/*
+ deflatePrime() inserts bits in the deflate output stream. The intent
+ is that this function is used to start off the deflate output with the bits
+ leftover from a previous deflate stream when appending to it. As such, this
+ function can only be used for raw deflate, and must be used before the first
+ deflate() call after a deflateInit2() or deflateReset(). bits must be less
+ 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, 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,
+ gz_headerp head));
+/*
+ deflateSetHeader() provides gzip header information for when a gzip
+ stream is requested by deflateInit2(). deflateSetHeader() may be called
+ after deflateInit2() or deflateReset() and before the first call of
+ deflate(). The text, time, os, extra field, name, and comment information
+ in the provided gz_header structure are written to the gzip header (xflag is
+ ignored -- the extra flags are set according to the compression level). The
+ caller must assure that, if not Z_NULL, name and comment are terminated with
+ a zero byte, and that if extra is not Z_NULL, that extra_len bytes are
+ available there. If hcrc is true, a gzip header crc is included. Note that
+ the current versions of the command-line version of gzip (up through version
+ 1.3.x) do not support header crc's, and will report that it is a "multi-part
+ gzip file" and give up.
+
+ If deflateSetHeader is not used, the default gzip header has text false,
+ the time set to zero, and os set to 255, with no extra, name, or comment
+ fields. The gzip header is returned to the default state by deflateReset().
+
+ deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm,
+ int windowBits));
+
+ This is another version of inflateInit with an extra parameter. The
+ fields next_in, avail_in, zalloc, zfree and opaque must be initialized
+ before by the caller.
+
+ The windowBits parameter is the base two logarithm of the maximum window
+ size (the size of the history buffer). It should be in the range 8..15 for
+ this version of the library. The default value is 15 if inflateInit is used
+ instead. windowBits must be greater than or equal to the windowBits value
+ provided to deflateInit2() while compressing, or it must be equal to 15 if
+ deflateInit2() was not used. If a compressed stream with a larger window
+ size is given as input, inflate() will return with the error code
+ Z_DATA_ERROR instead of trying to allocate a larger window.
+
+ windowBits can also be zero to request that inflate use the window size in
+ the zlib header of the compressed stream.
+
+ windowBits can also be -8..-15 for raw inflate. In this case, -windowBits
+ determines the window size. inflate() will then process raw deflate data,
+ not looking for a zlib or gzip header, not generating a check value, and not
+ looking for any check values for comparison at the end of the stream. This
+ is for use with other formats that use the deflate compressed data format
+ such as zip. Those formats provide their own check values. If a custom
+ format is developed using the raw deflate format for compressed data, it is
+ recommended that a check value such as an adler32 or a crc32 be applied to
+ the uncompressed data as is done in the zlib, gzip, and zip formats. For
+ most applications, the zlib format should be used as is. Note that comments
+ above on the use in deflateInit2() applies to the magnitude of windowBits.
+
+ windowBits can also be greater than 15 for optional gzip decoding. Add
+ 32 to windowBits to enable zlib and gzip decoding with automatic header
+ detection, or add 16 to decode only the gzip format (the zlib format will
+ return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is a
+ crc32 instead of an adler32.
+
+ inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
+ version assumed by the caller, or Z_STREAM_ERROR if the parameters are
+ invalid, such as a null pointer to the structure. msg is set to null if
+ there is no error message. inflateInit2 does not perform any decompression
+ apart from possibly reading the zlib header if present: actual decompression
+ will be done by inflate(). (So next_in and avail_in may be modified, but
+ next_out and avail_out are unused and unchanged.) The current implementation
+ of inflateInit2() does not process any header information -- that is
+ deferred until inflate() is called.
+*/
+
+ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm,
+ const Bytef *dictionary,
+ uInt dictLength));
+/*
+ Initializes the decompression dictionary from the given uncompressed byte
+ sequence. This function must be called immediately after a call of inflate,
+ 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 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
+ inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the
+ expected one (incorrect adler32 value). inflateSetDictionary does not
+ perform any decompression: this will be done by subsequent calls of
+ inflate().
+*/
+
+ZEXTERN int ZEXPORT inflateGetDictionary OF((z_streamp strm,
+ Bytef *dictionary,
+ uInt *dictLength));
+/*
+ Returns the sliding dictionary being maintained by inflate. dictLength is
+ set to the number of bytes in the dictionary, and that many bytes are copied
+ to dictionary. dictionary must have enough space, where 32768 bytes is
+ always enough. If inflateGetDictionary() is called with dictionary equal to
+ Z_NULL, then only the dictionary length is returned, and nothing is copied.
+ Similary, if dictLength is Z_NULL, then it is not set.
+
+ inflateGetDictionary returns Z_OK on success, or Z_STREAM_ERROR if the
+ stream state is inconsistent.
+*/
+
+ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm));
+/*
+ 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 searches for a 00 00 FF FF pattern in the compressed data.
+ All full flush points have this pattern, but not all occurrences 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,
+ z_streamp source));
+/*
+ Sets the destination stream as a complete copy of the source stream.
+
+ This function can be useful when randomly accessing a large stream. The
+ first pass through the stream can periodically record the inflate state,
+ allowing restarting inflate at those points when randomly accessing the
+ stream.
+
+ inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
+ (such as zalloc being Z_NULL). msg is left unchanged in both source and
+ destination.
+*/
+
+ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm));
+/*
+ This function is equivalent to inflateEnd followed by inflateInit,
+ but does not free and reallocate all the internal decompression state. The
+ stream will keep attributes that may have been set by inflateInit2.
+
+ inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL).
+*/
+
+ZEXTERN int ZEXPORT inflateReset2 OF((z_streamp strm,
+ int windowBits));
+/*
+ This function is the same as inflateReset, but it also permits changing
+ the wrap and window size requests. The windowBits parameter is interpreted
+ the same as it is for inflateInit2.
+
+ inflateReset2 returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL), or if
+ the windowBits parameter is invalid.
+*/
+
+ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm,
+ int bits,
+ int value));
+/*
+ This function inserts bits in the inflate input stream. The intent is
+ that this function is used to start inflating at a bit position in the
+ middle of a byte. The provided bits will be used before any bytes are used
+ from next_in. This function should only be used with raw inflate, and
+ should be used before the first inflate() call after inflateInit2() or
+ inflateReset(). bits must be less than or equal to 16, and that many of the
+ least significant bits of value will be inserted in the input.
+
+ If bits is negative, then the input stream bit buffer is emptied. Then
+ inflatePrime() can be called again to put bits in the buffer. This is used
+ to clear out bits leftover after feeding inflate a block description prior
+ to feeding inflate codes.
+
+ inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+ZEXTERN long ZEXPORT inflateMark OF((z_streamp strm));
+/*
+ This function returns two values, one in the lower 16 bits of the return
+ value, and the other in the remaining upper bits, obtained by shifting the
+ return value down 16 bits. If the upper value is -1 and the lower value is
+ zero, then inflate() is currently decoding information outside of a block.
+ If the upper value is -1 and the lower value is non-zero, then inflate is in
+ the middle of a stored block, with the lower value equaling the number of
+ bytes from the input remaining to copy. If the upper value is not -1, then
+ it is the number of bits back from the current bit position in the input of
+ the code (literal or length/distance pair) currently being processed. In
+ that case the lower value is the number of bytes already emitted for that
+ code.
+
+ A code is being processed if inflate is waiting for more input to complete
+ decoding of the code, or if it has completed decoding but is waiting for
+ more output space to write the literal or match data.
+
+ inflateMark() is used to mark locations in the input data for random
+ access, which may be at bit positions, and to note those cases where the
+ output of a code may span boundaries of random access blocks. The current
+ location in the input stream can be determined from avail_in and data_type
+ as noted in the description for the Z_BLOCK flush parameter for inflate.
+
+ inflateMark returns the value noted above or -1 << 16 if the provided
+ source stream state was inconsistent.
+*/
+
+ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm,
+ gz_headerp head));
+/*
+ inflateGetHeader() requests that gzip header information be stored in the
+ provided gz_header structure. inflateGetHeader() may be called after
+ inflateInit2() or inflateReset(), and before the first call of inflate().
+ As inflate() processes the gzip stream, head->done is zero until the header
+ is completed, at which time head->done is set to one. If a zlib stream is
+ being decoded, then head->done is set to -1 to indicate that there will be
+ no gzip header information forthcoming. Note that Z_BLOCK or Z_TREES can be
+ used to force inflate() to return immediately after header processing is
+ complete and before any actual data is decompressed.
+
+ The text, time, xflags, and os fields are filled in with the gzip header
+ contents. hcrc is set to true if there is a header CRC. (The header CRC
+ was valid if done is set to one.) If extra is not Z_NULL, then extra_max
+ contains the maximum number of bytes to write to extra. Once done is true,
+ extra_len contains the actual extra field length, and extra contains the
+ extra field, or that field truncated if extra_max is less than extra_len.
+ If name is not Z_NULL, then up to name_max characters are written there,
+ terminated with a zero unless the length is greater than name_max. If
+ comment is not Z_NULL, then up to comm_max characters are written there,
+ terminated with a zero unless the length is greater than comm_max. When any
+ of extra, name, or comment are not Z_NULL and the respective field is not
+ present in the header, then that field is set to Z_NULL to signal its
+ absence. This allows the use of deflateSetHeader() with the returned
+ structure to duplicate the header. However if those fields are set to
+ allocated memory, then the application will need to save those pointers
+ elsewhere so that they can be eventually freed.
+
+ If inflateGetHeader is not used, then the header information is simply
+ discarded. The header is always checked for validity, including the header
+ CRC if present. inflateReset() will reset the process to discard the header
+ information. The application would need to call inflateGetHeader() again to
+ retrieve the header from the next gzip stream.
+
+ inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window));
+
+ Initialize the internal stream state for decompression using inflateBack()
+ calls. The fields zalloc, zfree and opaque in strm must be initialized
+ before the call. If zalloc and zfree are Z_NULL, then the default library-
+ derived memory allocation routines are used. windowBits is the base two
+ logarithm of the window size, in the range 8..15. window is a caller
+ supplied buffer of that size. Except for special applications where it is
+ assured that deflate was used with small window sizes, windowBits must be 15
+ and a 32K byte window must be supplied to be able to decompress general
+ deflate streams.
+
+ See inflateBack() for the usage of these routines.
+
+ inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of
+ 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.
+*/
+
+typedef unsigned (*in_func) OF((void FAR *,
+ z_const unsigned char FAR * FAR *));
+typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned));
+
+ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm,
+ in_func in, void FAR *in_desc,
+ out_func out, void FAR *out_desc));
+/*
+ inflateBack() does a raw inflate with a single call using a call-back
+ interface for input and output. This is potentially more efficient than
+ inflate() for file i/o applications, in that it avoids copying between the
+ output and the sliding window by simply making the window itself the output
+ buffer. inflate() can be faster on modern CPUs when used with large
+ buffers. inflateBack() trusts the application to not change the output
+ buffer passed by the output function, at least until inflateBack() returns.
+
+ inflateBackInit() must be called first to allocate the internal state
+ and to initialize the state with the user-provided window buffer.
+ inflateBack() may then be used multiple times to inflate a complete, raw
+ deflate stream with each call. inflateBackEnd() is then called to free the
+ allocated state.
+
+ A raw deflate stream is one with no zlib or gzip header or trailer.
+ This routine would normally be used in a utility that reads zip or gzip
+ files and writes out uncompressed files. The utility would decode the
+ header and process the trailer on its own, hence this routine expects only
+ the raw deflate stream to decompress. This is different from the normal
+ behavior of inflate(), which expects either a zlib or gzip header and
+ trailer around the deflate stream.
+
+ inflateBack() uses two subroutines supplied by the caller that are then
+ called by inflateBack() for input and output. inflateBack() calls those
+ routines until it reads a complete deflate stream and writes out all of the
+ uncompressed data, or until it encounters an error. The function's
+ parameters and return types are defined above in the in_func and out_func
+ typedefs. inflateBack() will call in(in_desc, &buf) which should return the
+ number of bytes of provided input, and a pointer to that input in buf. If
+ there is no input available, in() must return zero--buf is ignored in that
+ case--and inflateBack() will return a buffer error. inflateBack() will call
+ out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out()
+ should return zero on success, or non-zero on failure. If out() returns
+ non-zero, inflateBack() will return with an error. Neither in() nor out()
+ are permitted to change the contents of the window provided to
+ inflateBackInit(), which is also the buffer that out() uses to write from.
+ The length written by out() will be at most the window size. Any non-zero
+ amount of input may be provided by in().
+
+ For convenience, inflateBack() can be provided input on the first call by
+ setting strm->next_in and strm->avail_in. If that input is exhausted, then
+ in() will be called. Therefore strm->next_in must be initialized before
+ calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called
+ immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in
+ must also be initialized, and then if strm->avail_in is not zero, input will
+ initially be taken from strm->next_in[0 .. strm->avail_in - 1].
+
+ The in_desc and out_desc parameters of inflateBack() is passed as the
+ first parameter of in() and out() respectively when they are called. These
+ descriptors can be optionally used to pass any information that the caller-
+ supplied in() and out() functions need to do their job.
+
+ On return, inflateBack() will set strm->next_in and strm->avail_in to
+ pass back any unused input that was provided by the last in() call. The
+ return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR
+ if in() or out() returned an error, Z_DATA_ERROR if there was a format error
+ in the deflate stream (in which case strm->msg is set to indicate the nature
+ of the error), or Z_STREAM_ERROR if the stream was not properly initialized.
+ In the case of Z_BUF_ERROR, an input or output error can be distinguished
+ using strm->next_in which will be Z_NULL only if in() returned an error. If
+ strm->next_in is not Z_NULL, then the Z_BUF_ERROR was due to out() returning
+ non-zero. (in() will always be called before out(), so strm->next_in is
+ assured to be defined if out() returns non-zero.) Note that inflateBack()
+ cannot return Z_OK.
+*/
+
+ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm));
+/*
+ All memory allocated by inflateBackInit() is freed.
+
+ inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream
+ state was inconsistent.
+*/
+
+ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void));
+/* Return flags indicating compile-time options.
+
+ Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other:
+ 1.0: size of uInt
+ 3.2: size of uLong
+ 5.4: size of voidpf (pointer)
+ 7.6: size of z_off_t
+
+ Compiler, assembler, and debug options:
+ 8: DEBUG
+ 9: ASMV or ASMINF -- use ASM code
+ 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention
+ 11: 0 (reserved)
+
+ One-time table building (smaller code, but not thread-safe if true):
+ 12: BUILDFIXED -- build static block decoding tables when needed
+ 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed
+ 14,15: 0 (reserved)
+
+ Library content (indicates missing functionality):
+ 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking
+ deflate code when not needed)
+ 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect
+ and decode gzip streams (to avoid linking crc code)
+ 18-19: 0 (reserved)
+
+ Operation variations (changes in library functionality):
+ 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate
+ 21: FASTEST -- deflate algorithm with only one, lowest compression level
+ 22,23: 0 (reserved)
+
+ The sprintf variant used by gzprintf (zero is best):
+ 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format
+ 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure!
+ 26: 0 = returns value, 1 = void -- 1 means inferred string length returned
+
+ Remainder:
+ 27-31: 0 (reserved)
+ */
+
+#ifndef Z_SOLO
+
+ /* utility functions */
+
+/*
+ The following utility functions are implemented on top of the basic
+ stream-oriented functions. To simplify the interface, some default options
+ are assumed (compression level and memory usage, standard memory allocation
+ functions). The source code of these utility functions can be modified if
+ you need special options.
+*/
+
+ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen));
+/*
+ Compresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total size
+ of the destination buffer, which must be at least the value returned by
+ compressBound(sourceLen). Upon exit, destLen is the actual size of the
+ compressed buffer.
+
+ compress 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.
+*/
+
+ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen,
+ int level));
+/*
+ Compresses the source buffer into the destination buffer. The level
+ parameter has the same meaning as in deflateInit. sourceLen is the byte
+ length of the source buffer. Upon entry, destLen is the total size of the
+ destination buffer, which must be at least the value returned by
+ compressBound(sourceLen). Upon exit, destLen is the actual size of the
+ compressed buffer.
+
+ compress2 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,
+ Z_STREAM_ERROR if the level parameter is invalid.
+*/
+
+ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen));
+/*
+ compressBound() returns an upper bound on the compressed size after
+ compress() or compress2() on sourceLen bytes. It would be used before a
+ compress() or compress2() call to allocate the destination buffer.
+*/
+
+ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen));
+/*
+ Decompresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total size
+ of the destination buffer, which must be large enough to hold the entire
+ uncompressed data. (The size of the uncompressed data must have been saved
+ previously by the compressor and transmitted to the decompressor by some
+ mechanism outside the scope of this compression library.) Upon exit, destLen
+ is the actual size of the uncompressed buffer.
+
+ 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. 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 */
+
+/*
+ This library supports reading and writing files in gzip (.gz) format with
+ an interface similar to that of stdio, using the functions that start with
+ "gz". The gzip format is different from the zlib format. gzip is a gzip
+ wrapper, documented in RFC 1952, wrapped around a deflate stream.
+*/
+
+typedef struct gzFile_s *gzFile; /* semi-opaque gzip file descriptor */
+
+/*
+ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode));
+
+ Opens a gzip (.gz) file for reading or writing. The mode parameter is as
+ in fopen ("rb" or "wb") but can also include a compression level ("wb9") or
+ 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.) '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. 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
+ specified (an 'r', 'w', or 'a' was not provided, or '+' was provided).
+ errno can be checked to determine if the reason gzopen failed was that the
+ file could not be opened.
+*/
+
+ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode));
+/*
+ gzdopen associates a gzFile with the file descriptor fd. File descriptors
+ are obtained from calls like open, dup, creat, pipe or fileno (if the file
+ has been previously opened with fopen). The mode parameter is as in gzopen.
+
+ The next call of gzclose on the returned gzFile will also close the file
+ 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. 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
+ provided, or '+' was provided), or if fd is -1. The file descriptor is not
+ used until the next gz* read, write, seek, or close operation, so gzdopen
+ will not detect if fd is invalid (unless fd is -1).
+*/
+
+ZEXTERN int ZEXPORT gzbuffer OF((gzFile file, unsigned size));
+/*
+ Set the internal buffer size used by this library's functions. The
+ default buffer size is 8192 bytes. This function must be called after
+ gzopen() or gzdopen(), and before any other calls that read or write the
+ file. The buffer memory allocation is always deferred to the first read or
+ write. Two buffers are allocated, either both of the specified size when
+ writing, or one of the specified size and the other twice that size when
+ reading. A larger buffer size of, for example, 64K or 128K bytes will
+ noticeably increase the speed of decompression (reading).
+
+ The new buffer size also affects the maximum length for gzprintf().
+
+ gzbuffer() returns 0 on success, or -1 on failure, such as being called
+ too late.
+*/
+
+ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy));
+/*
+ Dynamically update the compression level or strategy. See the description
+ of deflateInit2 for the meaning of these parameters.
+
+ gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not
+ opened for writing.
+*/
+
+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 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. 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.
+*/
+
+ZEXTERN int ZEXPORT gzwrite OF((gzFile file,
+ voidpc buf, unsigned len));
+/*
+ Writes the given number of uncompressed bytes into the compressed file.
+ gzwrite returns the number of uncompressed bytes written or 0 in case of
+ error.
+*/
+
+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
+ uncompressed bytes actually written, or 0 in case of error. The number of
+ uncompressed bytes written is limited to 8191, or one less than the buffer
+ size given to gzbuffer(). The caller should assure that this limit is not
+ exceeded. If it is exceeded, then gzprintf() will return an error (0) with
+ nothing written. In this case, there may also be a buffer overflow with
+ unpredictable consequences, which is possible only if zlib was compiled with
+ the insecure functions sprintf() or vsprintf() because the secure snprintf()
+ or vsnprintf() functions were not available. This can be determined using
+ zlibCompileFlags().
+*/
+
+ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s));
+/*
+ Writes the given null-terminated string to the compressed file, excluding
+ the terminating null character.
+
+ gzputs returns the number of characters written, or -1 in case of error.
+*/
+
+ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len));
+/*
+ Reads bytes from the compressed file until len-1 characters are read, or a
+ newline character is read and transferred to buf, or an end-of-file
+ condition is encountered. If any characters are read or if len == 1, the
+ string is terminated with a null character. If no characters are read due
+ to an end-of-file or len < 1, then the buffer is left untouched.
+
+ gzgets returns buf which is a null-terminated string, or it returns NULL
+ for end-of-file or in case of error. If there was an error, the contents at
+ buf are indeterminate.
+*/
+
+ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c));
+/*
+ Writes c, converted to an unsigned char, into the compressed file. gzputc
+ returns the value that was written, or -1 in case of error.
+*/
+
+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. 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));
+/*
+ Push one character back onto the stream to be read as the first character
+ on the next read. At least one character of push-back is allowed.
+ gzungetc() returns the character pushed, or -1 on failure. gzungetc() will
+ fail if c is -1, and may fail if a character has been pushed but not read
+ yet. If gzungetc is used immediately after gzopen or gzdopen, at least the
+ output buffer size of pushed characters is allowed. (See gzbuffer above.)
+ The pushed character will be discarded if the stream is repositioned with
+ gzseek() or gzrewind().
+*/
+
+ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush));
+/*
+ Flushes all pending output into the compressed file. The parameter flush
+ is as in the deflate() function. The return value is the zlib error number
+ (see function gzerror below). gzflush is only permitted when writing.
+
+ If the flush parameter is Z_FINISH, the remaining data is written and the
+ gzip stream is completed in the output. If gzwrite() is called again, a new
+ gzip stream will be started in the output. gzread() is able to read such
+ concatented gzip streams.
+
+ gzflush should be called only when strictly necessary because it will
+ degrade compression if called too often.
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file,
+ z_off_t offset, int whence));
+
+ Sets the starting position for the next gzread or gzwrite on the given
+ compressed file. The offset represents a number of bytes in the
+ uncompressed data stream. The whence parameter is defined as in lseek(2);
+ the value SEEK_END is not supported.
+
+ If the file is opened for reading, this function is emulated but can be
+ extremely slow. If the file is opened for writing, only forward seeks are
+ supported; gzseek then compresses a sequence of zeroes up to the new
+ starting position.
+
+ gzseek returns the resulting offset location as measured in bytes from
+ the beginning of the uncompressed stream, or -1 in case of error, in
+ particular if the file is opened for writing and the new starting position
+ would be before the current position.
+*/
+
+ZEXTERN int ZEXPORT gzrewind OF((gzFile file));
+/*
+ Rewinds the given file. This function is supported only for reading.
+
+ gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET)
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file));
+
+ Returns the starting position for the next gzread or gzwrite on the given
+ compressed file. This position represents a number of bytes in the
+ uncompressed data stream, and is zero when starting, even if appending or
+ reading a gzip stream from the middle of a file using gzdopen().
+
+ gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR)
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile file));
+
+ Returns the current offset in the file being read or written. This offset
+ includes the count of bytes that precede the gzip stream, for example when
+ appending or when using gzdopen() for reading. When reading, the offset
+ does not include as yet unused buffered input. This information can be used
+ for a progress indicator. On error, gzoffset() returns -1.
+*/
+
+ZEXTERN int ZEXPORT gzeof OF((gzFile file));
+/*
+ Returns true (1) if the end-of-file indicator has been set while reading,
+ false (0) otherwise. Note that the end-of-file indicator is set only if the
+ read tried to go past the end of the input, but came up short. Therefore,
+ just like feof(), gzeof() may return false even if there is no more data to
+ read, in the event that the last read request was for the exact number of
+ bytes remaining in the input file. This will happen if the input file size
+ is an exact multiple of the buffer size.
+
+ If gzeof() returns true, then the read functions will return no more data,
+ unless the end-of-file indicator is reset by gzclearerr() and the input file
+ has grown since the previous end of file was detected.
+*/
+
+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.
+
+ If the input file is empty, gzdirect() will return true, since the input
+ does not contain a gzip stream.
+
+ If gzdirect() is used immediately after gzopen() or gzdopen() it will
+ 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));
+/*
+ Flushes all pending output if necessary, closes the compressed file and
+ deallocates the (de)compression state. Note that once file is closed, you
+ cannot call gzerror with file, since its structures have been deallocated.
+ gzclose must not be called more than once on the same file, just as free
+ 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, 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));
+ZEXTERN int ZEXPORT gzclose_w OF((gzFile file));
+/*
+ Same as gzclose(), but gzclose_r() is only for use when reading, and
+ gzclose_w() is only for use when writing or appending. The advantage to
+ using these instead of gzclose() is that they avoid linking in zlib
+ compression or decompression code that is not used when only reading or only
+ writing respectively. If gzclose() is used, then both compression and
+ decompression code will be included the application when linking to a static
+ zlib library.
+*/
+
+ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum));
+/*
+ Returns the error message for the last error which occurred on the given
+ compressed file. errnum is set to zlib error number. If an error occurred
+ in the file system and not in the compression library, errnum is set to
+ Z_ERRNO and the application may consult errno to get the exact error code.
+
+ The application must not modify the returned string. Future calls to
+ this function may invalidate the previously returned string. If file is
+ closed, then the string previously returned by gzerror will no longer be
+ available.
+
+ gzerror() should be used to distinguish errors from end-of-file for those
+ functions above that do not distinguish those cases in their return values.
+*/
+
+ZEXTERN void ZEXPORT gzclearerr OF((gzFile file));
+/*
+ Clears the error and end-of-file flags for file. This is analogous to the
+ clearerr() function in stdio. This is useful for continuing to read a gzip
+ file that is being written concurrently.
+*/
+
+#endif /* !Z_SOLO */
+
+ /* checksum functions */
+
+/*
+ These functions are not related to compression but are exported
+ anyway because they might be useful in applications using the compression
+ library.
+*/
+
+ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len));
+/*
+ Update a running Adler-32 checksum with the bytes buf[0..len-1] and
+ return the updated checksum. If buf is Z_NULL, this function returns the
+ required initial value for the checksum.
+
+ An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
+ much faster.
+
+ Usage example:
+
+ uLong adler = adler32(0L, Z_NULL, 0);
+
+ while (read_buffer(buffer, length) != EOF) {
+ adler = adler32(adler, buffer, length);
+ }
+ if (adler != original_adler) error();
+*/
+
+/*
+ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2,
+ z_off_t len2));
+
+ 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. 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 crc. Pre- and post-conditioning (one's complement) is
+ performed within this function so it shouldn't be done by the application.
+
+ Usage example:
+
+ uLong crc = crc32(0L, Z_NULL, 0);
+
+ while (read_buffer(buffer, length) != EOF) {
+ crc = crc32(crc, buffer, length);
+ }
+ if (crc != original_crc) error();
+*/
+
+/*
+ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2));
+
+ Combine two CRC-32 check values into one. For two sequences of bytes,
+ seq1 and seq2 with lengths len1 and len2, CRC-32 check values were
+ calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32
+ check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and
+ len2.
+*/
+
+
+ /* various hacks, don't look :) */
+
+/* deflateInit and inflateInit are macros to allow checking the zlib version
+ * and the compiler's view of z_stream:
+ */
+ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method,
+ int windowBits, int memLevel,
+ int strategy, const char *version,
+ int stream_size));
+ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window,
+ const char *version,
+ int stream_size));
+#define deflateInit(strm, level) \
+ deflateInit_((strm), (level), ZLIB_VERSION, (int)sizeof(z_stream))
+#define inflateInit(strm) \
+ 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, (int)sizeof(z_stream))
+#define inflateInit2(strm, windowBits) \
+ inflateInit2_((strm), (windowBits), ZLIB_VERSION, \
+ (int)sizeof(z_stream))
+#define inflateBackInit(strm, windowBits, window) \
+ inflateBackInit_((strm), (windowBits), (window), \
+ 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
+ * both are true, the application gets the *64 functions, and the regular
+ * functions are changed to 64 bits) -- in case these are set on systems
+ * without large file support, _LFS64_LARGEFILE must also be true
+ */
+#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));
+ ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off64_t));
+ ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off64_t));
+#endif
+
+#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));
+ ZEXTERN z_off_t ZEXPORT gzoffset64 OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
+ ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
+# endif
+#else
+ ZEXTERN gzFile ZEXPORT gzopen OF((const char *, const char *));
+ ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile, z_off_t, int));
+ ZEXTERN z_off_t ZEXPORT gztell OF((gzFile));
+ ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t));
+ 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;};
+#endif
+
+/* undocumented functions */
+ZEXTERN const char * ZEXPORT zError OF((int));
+ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp));
+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
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# ifndef Z_SOLO
+ZEXTERN int ZEXPORTVA gzvprintf Z_ARG((gzFile file,
+ const char *format,
+ va_list va));
+# endif
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* ZLIB_H */
diff --git a/compat/zlib/zlib.map b/compat/zlib/zlib.map
new file mode 100644
index 0000000..55c6647
--- /dev/null
+++ b/compat/zlib/zlib.map
@@ -0,0 +1,83 @@
+ZLIB_1.2.0 {
+ global:
+ compressBound;
+ deflateBound;
+ inflateBack;
+ inflateBackEnd;
+ inflateBackInit_;
+ inflateCopy;
+ local:
+ deflate_copyright;
+ inflate_copyright;
+ inflate_fast;
+ inflate_table;
+ zcalloc;
+ zcfree;
+ z_errmsg;
+ gz_error;
+ gz_intmax;
+ _*;
+};
+
+ZLIB_1.2.0.2 {
+ gzclearerr;
+ gzungetc;
+ zlibCompileFlags;
+} ZLIB_1.2.0;
+
+ZLIB_1.2.0.8 {
+ deflatePrime;
+} ZLIB_1.2.0.2;
+
+ZLIB_1.2.2 {
+ adler32_combine;
+ crc32_combine;
+ deflateSetHeader;
+ inflateGetHeader;
+} ZLIB_1.2.0.8;
+
+ZLIB_1.2.2.3 {
+ deflateTune;
+ gzdirect;
+} ZLIB_1.2.2;
+
+ZLIB_1.2.2.4 {
+ inflatePrime;
+} ZLIB_1.2.2.3;
+
+ZLIB_1.2.3.3 {
+ adler32_combine64;
+ crc32_combine64;
+ gzopen64;
+ gzseek64;
+ gztell64;
+ inflateUndermine;
+} ZLIB_1.2.2.4;
+
+ZLIB_1.2.3.4 {
+ inflateReset2;
+ inflateMark;
+} ZLIB_1.2.3.3;
+
+ZLIB_1.2.3.5 {
+ gzbuffer;
+ gzoffset;
+ gzoffset64;
+ 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;
+
+ZLIB_1.2.7.1 {
+ inflateGetDictionary;
+ gzvprintf;
+} ZLIB_1.2.5.2;
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/zlib.pc.in b/compat/zlib/zlib.pc.in
new file mode 100644
index 0000000..7e5acf9
--- /dev/null
+++ b/compat/zlib/zlib.pc.in
@@ -0,0 +1,13 @@
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+sharedlibdir=@sharedlibdir@
+includedir=@includedir@
+
+Name: zlib
+Description: zlib compression library
+Version: @VERSION@
+
+Requires:
+Libs: -L${libdir} -L${sharedlibdir} -lz
+Cflags: -I${includedir}
diff --git a/compat/zlib/zlib2ansi b/compat/zlib/zlib2ansi
new file mode 100644
index 0000000..15e3e16
--- /dev/null
+++ b/compat/zlib/zlib2ansi
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+# Transform K&R C function definitions into ANSI equivalent.
+#
+# Author: Paul Marquess
+# Version: 1.0
+# Date: 3 October 2006
+
+# TODO
+#
+# Asumes no function pointer parameters. unless they are typedefed.
+# Assumes no literal strings that look like function definitions
+# Assumes functions start at the beginning of a line
+
+use strict;
+use warnings;
+
+local $/;
+$_ = <>;
+
+my $sp = qr{ \s* (?: /\* .*? \*/ )? \s* }x; # assume no nested comments
+
+my $d1 = qr{ $sp (?: [\w\*\s]+ $sp)* $sp \w+ $sp [\[\]\s]* $sp }x ;
+my $decl = qr{ $sp (?: \w+ $sp )+ $d1 }xo ;
+my $dList = qr{ $sp $decl (?: $sp , $d1 )* $sp ; $sp }xo ;
+
+
+while (s/^
+ ( # Start $1
+ ( # Start $2
+ .*? # Minimal eat content
+ ( ^ \w [\w\s\*]+ ) # $3 -- function name
+ \s* # optional whitespace
+ ) # $2 - Matched up to before parameter list
+
+ \( \s* # Literal "(" + optional whitespace
+ ( [^\)]+ ) # $4 - one or more anythings except ")"
+ \s* \) # optional whitespace surrounding a Literal ")"
+
+ ( (?: $dList )+ ) # $5
+
+ $sp ^ { # literal "{" at start of line
+ ) # Remember to $1
+ //xsom
+ )
+{
+ my $all = $1 ;
+ my $prefix = $2;
+ my $param_list = $4 ;
+ my $params = $5;
+
+ StripComments($params);
+ StripComments($param_list);
+ $param_list =~ s/^\s+//;
+ $param_list =~ s/\s+$//;
+
+ my $i = 0 ;
+ my %pList = map { $_ => $i++ }
+ split /\s*,\s*/, $param_list;
+ my $pMatch = '(\b' . join('|', keys %pList) . '\b)\W*$' ;
+
+ my @params = split /\s*;\s*/, $params;
+ my @outParams = ();
+ foreach my $p (@params)
+ {
+ if ($p =~ /,/)
+ {
+ my @bits = split /\s*,\s*/, $p;
+ my $first = shift @bits;
+ $first =~ s/^\s*//;
+ push @outParams, $first;
+ $first =~ /^(\w+\s*)/;
+ my $type = $1 ;
+ push @outParams, map { $type . $_ } @bits;
+ }
+ else
+ {
+ $p =~ s/^\s+//;
+ push @outParams, $p;
+ }
+ }
+
+
+ my %tmp = map { /$pMatch/; $_ => $pList{$1} }
+ @outParams ;
+
+ @outParams = map { " $_" }
+ sort { $tmp{$a} <=> $tmp{$b} }
+ @outParams ;
+
+ print $prefix ;
+ print "(\n" . join(",\n", @outParams) . ")\n";
+ print "{" ;
+
+}
+
+# Output any trailing code.
+print ;
+exit 0;
+
+
+sub StripComments
+{
+
+ no warnings;
+
+ # Strip C & C++ coments
+ # From the perlfaq
+ $_[0] =~
+
+ s{
+ /\* ## Start of /* ... */ comment
+ [^*]*\*+ ## Non-* followed by 1-or-more *'s
+ (
+ [^/*][^*]*\*+
+ )* ## 0-or-more things which don't start with /
+ ## but do end with '*'
+ / ## End of /* ... */ comment
+
+ | ## OR C++ Comment
+ // ## Start of C++ comment //
+ [^\n]* ## followed by 0-or-more non end of line characters
+
+ | ## OR various things which aren't comments:
+
+ (
+ " ## Start of " ... " string
+ (
+ \\. ## Escaped char
+ | ## OR
+ [^"\\] ## Non "\
+ )*
+ " ## End of " ... " string
+
+ | ## OR
+
+ ' ## Start of ' ... ' string
+ (
+ \\. ## Escaped char
+ | ## OR
+ [^'\\] ## Non '\
+ )*
+ ' ## End of ' ... ' string
+
+ | ## OR
+
+ . ## Anything other char
+ [^/"'\\]* ## Chars which doesn't start a comment, string or escape
+ )
+ }{$2}gxs;
+
+}
diff --git a/compat/zlib/zutil.c b/compat/zlib/zutil.c
new file mode 100644
index 0000000..23d2ebe
--- /dev/null
+++ b/compat/zlib/zutil.c
@@ -0,0 +1,324 @@
+/* zutil.c -- target dependent utility functions for the compression library
+ * Copyright (C) 1995-2005, 2010, 2011, 2012 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id$ */
+
+#include "zutil.h"
+#ifndef Z_SOLO
+# include "gzguts.h"
+#endif
+
+#ifndef NO_DUMMY_DECL
+struct internal_state {int dummy;}; /* for buggy compilers */
+#endif
+
+z_const char * const z_errmsg[10] = {
+"need dictionary", /* Z_NEED_DICT 2 */
+"stream end", /* Z_STREAM_END 1 */
+"", /* Z_OK 0 */
+"file error", /* Z_ERRNO (-1) */
+"stream error", /* Z_STREAM_ERROR (-2) */
+"data error", /* Z_DATA_ERROR (-3) */
+"insufficient memory", /* Z_MEM_ERROR (-4) */
+"buffer error", /* Z_BUF_ERROR (-5) */
+"incompatible version",/* Z_VERSION_ERROR (-6) */
+""};
+
+
+const char * ZEXPORT zlibVersion()
+{
+ return ZLIB_VERSION;
+}
+
+uLong ZEXPORT zlibCompileFlags()
+{
+ uLong flags;
+
+ flags = 0;
+ switch ((int)(sizeof(uInt))) {
+ case 2: break;
+ case 4: flags += 1; break;
+ case 8: flags += 2; break;
+ default: flags += 3;
+ }
+ switch ((int)(sizeof(uLong))) {
+ case 2: break;
+ case 4: flags += 1 << 2; break;
+ case 8: flags += 2 << 2; break;
+ default: flags += 3 << 2;
+ }
+ switch ((int)(sizeof(voidpf))) {
+ case 2: break;
+ case 4: flags += 1 << 4; break;
+ case 8: flags += 2 << 4; break;
+ default: flags += 3 << 4;
+ }
+ switch ((int)(sizeof(z_off_t))) {
+ case 2: break;
+ case 4: flags += 1 << 6; break;
+ case 8: flags += 2 << 6; break;
+ default: flags += 3 << 6;
+ }
+#ifdef DEBUG
+ flags += 1 << 8;
+#endif
+#if defined(ASMV) || defined(ASMINF)
+ flags += 1 << 9;
+#endif
+#ifdef ZLIB_WINAPI
+ flags += 1 << 10;
+#endif
+#ifdef BUILDFIXED
+ flags += 1 << 12;
+#endif
+#ifdef DYNAMIC_CRC_TABLE
+ flags += 1 << 13;
+#endif
+#ifdef NO_GZCOMPRESS
+ flags += 1L << 16;
+#endif
+#ifdef NO_GZIP
+ flags += 1L << 17;
+#endif
+#ifdef PKZIP_BUG_WORKAROUND
+ flags += 1L << 20;
+#endif
+#ifdef FASTEST
+ flags += 1L << 21;
+#endif
+#if defined(STDC) || defined(Z_HAVE_STDARG_H)
+# ifdef NO_vsnprintf
+ flags += 1L << 25;
+# ifdef HAS_vsprintf_void
+ flags += 1L << 26;
+# endif
+# else
+# ifdef HAS_vsnprintf_void
+ flags += 1L << 26;
+# endif
+# endif
+#else
+ flags += 1L << 24;
+# ifdef NO_snprintf
+ flags += 1L << 25;
+# ifdef HAS_sprintf_void
+ flags += 1L << 26;
+# endif
+# else
+# ifdef HAS_snprintf_void
+ flags += 1L << 26;
+# endif
+# endif
+#endif
+ return flags;
+}
+
+#ifdef DEBUG
+
+# ifndef verbose
+# define verbose 0
+# endif
+int ZLIB_INTERNAL z_verbose = verbose;
+
+void ZLIB_INTERNAL z_error (m)
+ char *m;
+{
+ fprintf(stderr, "%s\n", m);
+ exit(1);
+}
+#endif
+
+/* exported to allow conversion of error code to string for compress() and
+ * uncompress()
+ */
+const char * ZEXPORT zError(err)
+ int err;
+{
+ return ERR_MSG(err);
+}
+
+#if defined(_WIN32_WCE)
+ /* The Microsoft C Run-Time Library for Windows CE doesn't have
+ * errno. We define it as a global variable to simplify porting.
+ * Its value is always 0 and should not be used.
+ */
+ int errno = 0;
+#endif
+
+#ifndef HAVE_MEMCPY
+
+void ZLIB_INTERNAL zmemcpy(dest, source, len)
+ Bytef* dest;
+ const Bytef* source;
+ uInt len;
+{
+ if (len == 0) return;
+ do {
+ *dest++ = *source++; /* ??? to be unrolled */
+ } while (--len != 0);
+}
+
+int ZLIB_INTERNAL zmemcmp(s1, s2, len)
+ const Bytef* s1;
+ const Bytef* s2;
+ uInt len;
+{
+ uInt j;
+
+ for (j = 0; j < len; j++) {
+ if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1;
+ }
+ return 0;
+}
+
+void ZLIB_INTERNAL zmemzero(dest, len)
+ Bytef* dest;
+ uInt len;
+{
+ if (len == 0) return;
+ do {
+ *dest++ = 0; /* ??? to be unrolled */
+ } while (--len != 0);
+}
+#endif
+
+#ifndef Z_SOLO
+
+#ifdef SYS16BIT
+
+#ifdef __TURBOC__
+/* Turbo C in 16-bit mode */
+
+# define MY_ZCALLOC
+
+/* Turbo C malloc() does not allow dynamic allocation of 64K bytes
+ * and farmalloc(64K) returns a pointer with an offset of 8, so we
+ * must fix the pointer. Warning: the pointer must be put back to its
+ * original form in order to free it, use zcfree().
+ */
+
+#define MAX_PTR 10
+/* 10*64K = 640K */
+
+local int next_ptr = 0;
+
+typedef struct ptr_table_s {
+ voidpf org_ptr;
+ voidpf new_ptr;
+} ptr_table;
+
+local ptr_table table[MAX_PTR];
+/* This table is used to remember the original form of pointers
+ * to large buffers (64K). Such pointers are normalized with a zero offset.
+ * Since MSDOS is not a preemptive multitasking OS, this table is not
+ * protected from concurrent access. This hack doesn't work anyway on
+ * a protected system like OS/2. Use Microsoft C instead.
+ */
+
+voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, unsigned items, unsigned size)
+{
+ voidpf buf = opaque; /* just to make some compilers happy */
+ ulg bsize = (ulg)items*size;
+
+ /* If we allocate less than 65520 bytes, we assume that farmalloc
+ * will return a usable pointer which doesn't have to be normalized.
+ */
+ if (bsize < 65520L) {
+ buf = farmalloc(bsize);
+ if (*(ush*)&buf != 0) return buf;
+ } else {
+ buf = farmalloc(bsize + 16L);
+ }
+ if (buf == NULL || next_ptr >= MAX_PTR) return NULL;
+ table[next_ptr].org_ptr = buf;
+
+ /* Normalize the pointer to seg:0 */
+ *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4;
+ *(ush*)&buf = 0;
+ table[next_ptr++].new_ptr = buf;
+ return buf;
+}
+
+void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
+{
+ int n;
+ if (*(ush*)&ptr != 0) { /* object < 64K */
+ farfree(ptr);
+ return;
+ }
+ /* Find the original pointer */
+ for (n = 0; n < next_ptr; n++) {
+ if (ptr != table[n].new_ptr) continue;
+
+ farfree(table[n].org_ptr);
+ while (++n < next_ptr) {
+ table[n-1] = table[n];
+ }
+ next_ptr--;
+ return;
+ }
+ ptr = opaque; /* just to make some compilers happy */
+ Assert(0, "zcfree: ptr not found");
+}
+
+#endif /* __TURBOC__ */
+
+
+#ifdef M_I86
+/* Microsoft C in 16-bit mode */
+
+# define MY_ZCALLOC
+
+#if (!defined(_MSC_VER) || (_MSC_VER <= 600))
+# define _halloc halloc
+# define _hfree hfree
+#endif
+
+voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, uInt items, uInt size)
+{
+ if (opaque) opaque = 0; /* to make compiler happy */
+ return _halloc((long)items, size);
+}
+
+void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
+{
+ if (opaque) opaque = 0; /* to make compiler happy */
+ _hfree(ptr);
+}
+
+#endif /* M_I86 */
+
+#endif /* SYS16BIT */
+
+
+#ifndef MY_ZCALLOC /* Any system without a special alloc function */
+
+#ifndef STDC
+extern voidp malloc OF((uInt size));
+extern voidp calloc OF((uInt items, uInt size));
+extern void free OF((voidpf ptr));
+#endif
+
+voidpf ZLIB_INTERNAL zcalloc (opaque, items, size)
+ voidpf opaque;
+ unsigned items;
+ unsigned size;
+{
+ if (opaque) items += size - size; /* make compiler happy */
+ return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) :
+ (voidpf)calloc(items, size);
+}
+
+void ZLIB_INTERNAL zcfree (opaque, ptr)
+ voidpf opaque;
+ voidpf ptr;
+{
+ free(ptr);
+ if (opaque) return; /* make compiler happy */
+}
+
+#endif /* MY_ZCALLOC */
+
+#endif /* !Z_SOLO */
diff --git a/compat/zlib/zutil.h b/compat/zlib/zutil.h
new file mode 100644
index 0000000..24ab06b
--- /dev/null
+++ b/compat/zlib/zutil.h
@@ -0,0 +1,253 @@
+/* zutil.h -- internal interface and configuration of the compression library
+ * Copyright (C) 1995-2013 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* 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.
+ */
+
+/* @(#) $Id$ */
+
+#ifndef ZUTIL_H
+#define ZUTIL_H
+
+#ifdef HAVE_HIDDEN
+# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
+#else
+# define ZLIB_INTERNAL
+#endif
+
+#include "zlib.h"
+
+#if defined(STDC) && !defined(Z_SOLO)
+# if !(defined(_WIN32_WCE) && defined(_MSC_VER))
+# include <stddef.h>
+# endif
+# include <string.h>
+# 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
+/* compile with -Dlocal if your debugger can't find static symbols */
+
+typedef unsigned char uch;
+typedef uch FAR uchf;
+typedef unsigned short ush;
+typedef ush FAR ushf;
+typedef unsigned long ulg;
+
+extern z_const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
+/* (size given to avoid silly warnings with Visual C++) */
+
+#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)]
+
+#define ERR_RETURN(strm,err) \
+ return (strm->msg = ERR_MSG(err), (err))
+/* To be used only when the state is known to be valid */
+
+ /* common constants */
+
+#ifndef DEF_WBITS
+# define DEF_WBITS MAX_WBITS
+#endif
+/* default windowBits for decompression. MAX_WBITS is for compression only */
+
+#if MAX_MEM_LEVEL >= 8
+# define DEF_MEM_LEVEL 8
+#else
+# define DEF_MEM_LEVEL MAX_MEM_LEVEL
+#endif
+/* default memLevel */
+
+#define STORED_BLOCK 0
+#define STATIC_TREES 1
+#define DYN_TREES 2
+/* The three kinds of block type */
+
+#define MIN_MATCH 3
+#define MAX_MATCH 258
+/* The minimum and maximum match lengths */
+
+#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */
+
+ /* target dependencies */
+
+#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32))
+# define OS_CODE 0x00
+# 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
+# endif
+#endif
+
+#ifdef AMIGA
+# define OS_CODE 0x01
+#endif
+
+#if defined(VAXC) || defined(VMS)
+# define OS_CODE 0x02
+# define F_OPEN(name, mode) \
+ fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512")
+#endif
+
+#if defined(ATARI) || defined(atarist)
+# define OS_CODE 0x05
+#endif
+
+#ifdef OS2
+# define OS_CODE 0x06
+# if defined(M_I86) && !defined(Z_SOLO)
+# include <malloc.h>
+# endif
+#endif
+
+#if defined(MACOS) || defined(TARGET_OS_MAC)
+# define OS_CODE 0x07
+# 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
+
+#ifdef TOPS20
+# define OS_CODE 0x0a
+#endif
+
+#ifdef WIN32
+# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */
+# define OS_CODE 0x0b
+# endif
+#endif
+
+#ifdef __50SERIES /* Prime/PRIMOS */
+# define OS_CODE 0x0f
+#endif
+
+#if defined(_BEOS_) || defined(RISCOS)
+# define fdopen(fd,mode) NULL /* No fdopen() */
+#endif
+
+#if (defined(_MSC_VER) && (_MSC_VER > 600)) && !defined __INTERIX
+# if defined(_WIN32_WCE)
+# define fdopen(fd,mode) NULL /* No fdopen() */
+# ifndef _PTRDIFF_T_DEFINED
+ typedef int ptrdiff_t;
+# define _PTRDIFF_T_DEFINED
+# endif
+# else
+# define fdopen(fd,type) _fdopen(fd,type)
+# endif
+#endif
+
+#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(_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
+
+ /* common defaults */
+
+#ifndef OS_CODE
+# define OS_CODE 0x03 /* assume Unix */
+#endif
+
+#ifndef F_OPEN
+# define F_OPEN(name, mode) fopen((name), (mode))
+#endif
+
+ /* functions */
+
+#if defined(pyr) || defined(Z_SOLO)
+# define NO_MEMCPY
+#endif
+#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__)
+ /* Use our own functions for small and medium model with MSC <= 5.0.
+ * You may have to use the same strategy for Borland C (untested).
+ * The __SC__ check is for Symantec.
+ */
+# define NO_MEMCPY
+#endif
+#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY)
+# define HAVE_MEMCPY
+#endif
+#ifdef HAVE_MEMCPY
+# ifdef SMALL_MEDIUM /* MSDOS small or medium model */
+# define zmemcpy _fmemcpy
+# define zmemcmp _fmemcmp
+# define zmemzero(dest, len) _fmemset(dest, 0, len)
+# else
+# define zmemcpy memcpy
+# define zmemcmp memcmp
+# define zmemzero(dest, len) memset(dest, 0, len)
+# endif
+#else
+ void ZLIB_INTERNAL zmemcpy OF((Bytef* dest, const Bytef* source, uInt len));
+ int ZLIB_INTERNAL zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len));
+ void ZLIB_INTERNAL zmemzero OF((Bytef* dest, uInt len));
+#endif
+
+/* Diagnostic functions */
+#ifdef DEBUG
+# include <stdio.h>
+ extern int ZLIB_INTERNAL z_verbose;
+ extern void ZLIB_INTERNAL z_error OF((char *m));
+# define Assert(cond,msg) {if(!(cond)) z_error(msg);}
+# define Trace(x) {if (z_verbose>=0) fprintf x ;}
+# define Tracev(x) {if (z_verbose>0) fprintf x ;}
+# define Tracevv(x) {if (z_verbose>1) fprintf x ;}
+# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;}
+# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;}
+#else
+# define Assert(cond,msg)
+# define Trace(x)
+# define Tracev(x)
+# define Tracevv(x)
+# define Tracec(c,x)
+# define Tracecv(c,x)
+#endif
+
+#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 c464caa..668e1db 100644
--- a/doc/Access.3
+++ b/doc/Access.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Access.3,v 1.9 2004/10/07 14:44:31 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Access, Tcl_Stat \- check file permissions and other attributes
@@ -25,52 +23,49 @@ int
.AP char *path in
Native name of the file to check the attributes of.
.AP int mode in
-Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
-W_OK and X_OK request checking whether the file exists and has read,
-write and execute permissions, respectively. F_OK just requests
-checking for the existence of the file.
+Mask consisting of one or more of \fBR_OK\fR, \fBW_OK\fR, \fBX_OK\fR and
+\fBF_OK\fR. \fBR_OK\fR, \fBW_OK\fR and \fBX_OK\fR request checking whether the
+file exists and has read, write and execute permissions, respectively.
+\fBF_OK\fR just requests a check for the existence of the file.
.AP "struct stat" *statPtr out
The structure that contains the result.
.BE
-
.SH DESCRIPTION
.PP
-As of Tcl 8.4, the object-based APIs \fBTcl_FSAccess\fR and
-\fBTcl_FSStat\fR should be used in preference to \fBTcl_Access\fR and
-\fBTcl_Stat\fR, wherever possible.
+As of Tcl 8.4, the object-based APIs \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR
+should be used in preference to \fBTcl_Access\fR and \fBTcl_Stat\fR, wherever
+possible. Those functions also support Tcl's virtual filesystem layer, which
+these do not.
+.SS "OBSOLETE FUNCTIONS"
.PP
-There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR
-rather than calling system level functions \fBaccess\fR and \fBstat\fR
-directly. First, the Windows implementation of both functions fixes
-some bugs in the system level calls. Second, both \fBTcl_Access\fR
-and \fBTcl_Stat\fR (as well as \fBTcl_OpenFileChannelProc\fR) hook
-into a linked list of functions. This allows the possibility to reroute
-file access to alternative media or access methods.
+There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR rather
+than calling system level functions \fBaccess\fR and \fBstat\fR directly.
+First, the Windows implementation of both functions fixes some bugs in the
+system level calls. Second, both \fBTcl_Access\fR and \fBTcl_Stat\fR (as well
+as \fBTcl_OpenFileChannelProc\fR) hook into a linked list of functions. This
+allows the possibility to reroute file access to alternative media or access
+methods.
.PP
-\fBTcl_Access\fR checks whether the process would be allowed to read,
-write or test for existence of the file (or other file system object)
-whose name is pathname. If pathname is a symbolic link on Unix,
-then permissions of the file referred by this symbolic link are
-tested.
+\fBTcl_Access\fR checks whether the process would be allowed to read, write or
+test for existence of the file (or other file system object) whose name is
+\fIpath\fR. If \fIpath\fR is a symbolic link on Unix, then permissions of the
+file referred by this symbolic link are tested.
.PP
-On success (all requested permissions granted), zero is returned. On
-error (at least one bit in mode asked for a permission that is denied,
-or some other error occurred), -1 is returned.
+On success (all requested permissions granted), zero is returned. On error (at
+least one bit in mode asked for a permission that is denied, or some other
+error occurred), -1 is returned.
.PP
-\fBTcl_Stat\fR fills the stat structure \fIstatPtr\fR with information
-about the specified file. You do not need any access rights to the
-file to get this information but you need search rights 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.
+\fBTcl_Stat\fR fills the stat structure \fIstatPtr\fR with information about
+the specified file. You do not need any access rights to the file to get this
+information but you need search rights 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.
.PP
-If \fIpath\fR exists, \fBTcl_Stat\fR returns 0 and the stat structure
-is filled with data. Otherwise, -1 is returned, and no stat info is
-given.
-
+If \fIpath\fR exists, \fBTcl_Stat\fR returns 0 and the stat structure is
+filled with data. Otherwise, -1 is returned, and no stat info is given.
.SH KEYWORDS
stat, access
-
+.SH "SEE ALSO"
+Tcl_FSAccess(3), Tcl_FSStat(3)
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index bc32cd1..d4bf7d5 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -5,27 +5,25 @@
'\" 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.15 2005/09/13 21:23:51 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
+Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
-.VS 8.5
.sp
Tcl_Obj *
\fBTcl_GetReturnOptions\fR(\fIinterp, code\fR)
.sp
int
\fBTcl_SetReturnOptions\fR(\fIinterp, options\fR)
-.VE 8.5
.sp
\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
.sp
+\fBTcl_AppendObjToErrorInfo\fR(\fIinterp, objPtr\fR)
+.sp
\fBTcl_AddObjErrorInfo\fR(\fIinterp, message, length\fR)
.sp
\fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR)
@@ -34,6 +32,10 @@ int
.sp
\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
.sp
+\fBTcl_GetErrorLine\fR(\fIinterp\fR)
+.sp
+\fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR)
+.sp
const char *
\fBTcl_PosixError\fR(\fIinterp\fR)
.sp
@@ -49,24 +51,29 @@ The code returned from script evaluation.
A dictionary of return options.
.AP char *message in
For \fBTcl_AddErrorInfo\fR,
-this is a conventional C string to append to the \fB-errorinfo\fR return option.
+this is a conventional C string to append to the \fB\-errorinfo\fR return option.
For \fBTcl_AddObjErrorInfo\fR,
this points to the first byte of an array of \fIlength\fR bytes
-containing a string to append to the \fB-errorinfo\fR return option.
+containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is negative.
+.AP Tcl_Obj *objPtr in
+A message to be appended to the \fB\-errorinfo\fR return option
+in the form of a Tcl_Obj value.
.AP int length in
The number of bytes to copy from \fImessage\fR when
-appending to the \fB-errorinfo\fR return option.
+appending to the \fB\-errorinfo\fR return option.
If negative, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
-The \fB-errorcode\fR return option will be set to this value.
+The \fB\-errorcode\fR return option will be set to this value.
.AP char *element in
-String to record as one element of the \fB-errorcode\fR return option.
+String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
+.AP int lineNum
+The line number of a script where an error occurred.
.AP "const char" *script in
Pointer to first character in script containing command (must be <= command)
.AP "const char" *command in
@@ -74,10 +81,8 @@ Pointer to first character in command that generated the error
.AP int commandLength in
Number of bytes in command; -1 means use all bytes up to first null byte
.BE
-
.SH DESCRIPTION
.PP
-.VS 8.5
The \fBTcl_SetReturnOptions\fR and \fBTcl_GetReturnOptions\fR
routines expose the same capabilities as the \fBreturn\fR and
\fBcatch\fR commands, respectively, in the form of a C interface.
@@ -94,29 +99,36 @@ of return options. The integer completion code should be
passed as the \fIcode\fR argument to \fBTcl_GetReturnOptions\fR
so that all required options will be present in the dictionary.
Specifically, a \fIcode\fR value of \fBTCL_ERROR\fR will
-ensure that entries for the keys \fB-errorinfo\fR,
-\fB-errorcode\fR, and \fB-errorline\fR will appear in the
-dictionary. Also, the entries for the keys \fB-code\fR
-and \fB-level\fR will be adjusted if necessary to agree
+ensure that entries for the keys \fB\-errorinfo\fR,
+\fB\-errorcode\fR, and \fB\-errorline\fR will appear in the
+dictionary. Also, the entries for the keys \fB\-code\fR
+and \fB\-level\fR will be adjusted if necessary to agree
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
\fBTCL_ERROR\fR, like so:
+.PP
.CS
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
- Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
+ Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);
Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
Tcl_Obj *stackTrace;
Tcl_IncrRefCount(key);
Tcl_DictObjGet(NULL, options, key, &stackTrace);
Tcl_DecrRefCount(key);
/* Do something with stackTrace */
+ Tcl_DecrRefCount(options);
}
.CE
.PP
@@ -125,20 +137,22 @@ of \fIinterp\fR to be \fIoptions\fR. If \fIoptions\fR
contains any invalid value for any key, TCL_ERROR will
be returned, and the interp result will be set to an
appropriate error message. Otherwise, a completion code
-in agreement with the \fB-code\fR and \fB-level\fR
+in agreement with the \fB\-code\fR and \fB\-level\fR
keys in \fIoptions\fR will be returned.
.PP
As an example, Tcl's \fBreturn\fR command itself could
be implemented in terms of \fBTcl_SetReturnOptions\fR
like so:
+.PP
.CS
if ((objc % 2) == 0) { /* explicit result argument */
objc--;
Tcl_SetObjResult(interp, objv[objc]);
}
-return Tcl_SetReturnOptions(interp, Tcl_NewListObj(objc-1, objv+1));
+return \fBTcl_SetReturnOptions\fR(interp, Tcl_NewListObj(objc-1, objv+1));
.CE
-(It's not really implemented that way. Internal access
+.PP
+(It is not really implemented that way. Internal access
privileges allow for a more efficient alternative that meshes
better with the bytecode compiler.)
.PP
@@ -150,43 +164,46 @@ to any reference counting. This is analogous to
While \fBTcl_SetReturnOptions\fR provides a general interface
to set any collection of return options, there are a handful
of return options that are very frequently used. Most
-notably the \fB-errorinfo\fR and \fB-errorcode\fR return
+notably the \fB\-errorinfo\fR and \fB\-errorcode\fR return
options should be set properly when the command procedure
-of a command returns \fBTCL_ERROR\fR. Tcl provides several
-simpler interfaces to more directly set these return options.
-.VE 8.5
+of a command returns \fBTCL_ERROR\fR. The \fB\-errorline\fR
+return option is also read by commands that evaluate scripts
+and wish to supply detailed error location information in
+the stack trace text they append to the \fB\-errorinfo\fR option.
+Tcl provides several simpler interfaces to more directly set
+these return options.
.PP
-The \fB-errorinfo\fR option holds a stack trace of the
+The \fB\-errorinfo\fR option holds a stack trace of the
operations that were in progress when an error occurred,
and is intended to be human-readable.
-The \fB-errorcode\fR option holds a list of items that
+The \fB\-errorcode\fR option holds a Tcl list of items that
are intended to be machine-readable.
-The first item in the \fB-errocode\fR value identifies the class of
+The first item in the \fB\-errorcode\fR value identifies the class of
error that occurred
-(e.g. POSIX means an error occurred in a POSIX system call)
+(e.g., POSIX means an error occurred in a POSIX system call)
and additional elements hold additional pieces
of information that depend on the class.
-See the tclvars manual entry for details on the various
-formats for the \fB-errorcode\fR option used by
-Tcl's built-in commands.
+See the manual entry on the \fBerrorCode\fR variable for details on the
+various formats for the \fB\-errorcode\fR option used by Tcl's built-in
+commands.
.PP
-The \fB-errorinfo\fR option value is gradually built up as an
+The \fB\-errorinfo\fR option value is gradually built up as an
error unwinds through the nested operations.
Each time an error code is returned to \fBTcl_Eval\fR, or
any of the routines that performs script evaluation,
the procedure \fBTcl_AddErrorInfo\fR is called to add
-additional text to the \fB-errorinfo\fR value describing the
+additional text to the \fB\-errorinfo\fR value describing the
command that was being executed when the error occurred.
By the time the error has been passed all the way back
to the application, it will contain a complete trace
of the activity in progress when the error occurred.
.PP
It is sometimes useful to add additional information to
-the \fB-errorinfo\fR value beyond what can be supplied automatically
+the \fB\-errorinfo\fR value beyond what can be supplied automatically
by the script evaluation routines.
\fBTcl_AddErrorInfo\fR may be used for this purpose:
its \fImessage\fR argument is an additional
-string to be appended to the \fB-errorinfo\fR option.
+string to be appended to the \fB\-errorinfo\fR option.
For example, when an error arises during the \fBsource\fR command,
the procedure \fBTcl_AddErrorInfo\fR is called to
record the name of the file being processed and the
@@ -196,10 +213,15 @@ Tcl procedures, the procedure name and line number
within the procedure are recorded, and so on.
The best time to call \fBTcl_AddErrorInfo\fR is just after
a script evaluation routine has returned \fBTCL_ERROR\fR.
-The value of the \fB-errorline\fR return option (retrieved
+The value of the \fB\-errorline\fR return option (retrieved
via a call to \fBTcl_GetReturnOptions\fR) often makes up
a useful part of the \fImessage\fR passed to \fBTcl_AddErrorInfo\fR.
.PP
+\fBTcl_AppendObjToErrorInfo\fR is an alternative interface to the
+same functionality as \fBTcl_AddErrorInfo\fR. \fBTcl_AppendObjToErrorInfo\fR
+is called when the string value to be appended to the \fB\-errorinfo\fR option
+is available as a \fBTcl_Obj\fR instead of as a \fBchar\fR array.
+.PP
\fBTcl_AddObjErrorInfo\fR is nearly identical
to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR
argument. This allows the \fImessage\fR string to contain
@@ -210,26 +232,31 @@ 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
returned without calling \fBTcl_SetObjErrorCode\fR or
\fBTcl_SetErrorCode\fR the Tcl interpreter automatically sets
-the \fB-errorcode\fR return option to \fBNONE\fR.
+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
+\fB\-errorcode\fR return option. However, it takes one or more strings 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
instead of taking a variable number of arguments it takes an argument list.
.PP
+The procedure \fBTcl_GetErrorLine\fR is used to read the integer value
+of the \fB\-errorline\fR return option without the overhead of a full
+call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR
+sets the \fB\-errorline\fR return option value.
+.PP
\fBTcl_PosixError\fR
-sets the \fB-errorcode\fR variable after an error in a POSIX kernel call.
+sets the \fB\-errorcode\fR variable after an error in a POSIX kernel call.
It reads the value of the \fBerrno\fR C variable and calls
-\fBTcl_SetErrorCode\fR to set the \fB-errorcode\fR return
+\fBTcl_SetErrorCode\fR to set the \fB\-errorcode\fR return
option in the \fBPOSIX\fR format.
The caller must previously have called \fBTcl_SetErrno\fR to set
\fBerrno\fR; this is necessary on some platforms (e.g. Windows) where Tcl
@@ -240,14 +267,14 @@ occurs in a dynamically loaded extension. See the manual entry for
\fBTcl_PosixError\fR returns a human-readable diagnostic message
for the error
(this is the same value that will appear as the third element
-in the \fB-errorcode\fR value).
+in the \fB\-errorcode\fR value).
It may be convenient to include this string as part of the
error message returned to the application in
the interpreter's result.
.PP
\fBTcl_LogCommandInfo\fR is invoked after an error occurs in an
interpreter. It adds information about the command that was being
-executed when the error occurred to the \fB-errorinfo\fR value, and
+executed when the error occurred to the \fB\-errorinfo\fR value, and
the line number stored internally in the interpreter is set.
.PP
In older releases of Tcl, there was no \fBTcl_GetReturnOptions\fR
@@ -269,7 +296,7 @@ setting \fBerrorInfo\fR or \fBerrorCode\fR directly with
If the procedure \fBTcl_ResetResult\fR is called,
it clears all of the state of the interpreter associated with
script evaluation, including the entire return options dictionary.
-In particular, the \fB-errorinfo\fR and \fB-errorcode\fR options
+In particular, the \fB\-errorinfo\fR and \fB\-errorcode\fR options
are reset.
If an error had occurred, the \fBTcl_ResetResult\fR call will
clear the error state to make it appear as if no error had
@@ -278,9 +305,8 @@ The global variables \fBerrorInfo\fR and
\fBerrorCode\fR are not modified by \fBTcl_ResetResult\fR
so they continue to hold a record of information about the
most recent error seen in an interpreter.
-
.SH "SEE ALSO"
-Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_Interp, Tcl_ResetResult, Tcl_SetErrno
-
+Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
+Tcl_SetErrno(3), errorCode(n), errorInfo(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 541f300..585704a 100644
--- a/doc/Alloc.3
+++ b/doc/Alloc.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Alloc.3,v 1.9 2004/09/06 09:44:56 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
@@ -46,7 +44,7 @@ char *
\fBattemptckrealloc\fR(\fIptr, size\fR)
.SH ARGUMENTS
.AS char *size
-.AP int size in
+.AP "unsigned int" size in
Size in bytes of the memory block to allocate.
.AP char *ptr in
Pointer to memory block to free or realloc.
@@ -69,15 +67,17 @@ further allocation.
\fBTcl_Realloc\fR changes the size of the block pointed to by
\fIptr\fR to \fIsize\fR bytes and returns a pointer to the new block.
The contents will be unchanged up to the lesser of the new and old
-sizes. The returned location may be different from \fIptr\fR.
+sizes. The returned location may be different from \fIptr\fR. If
+\fIptr\fR is NULL, this is equivalent to calling \fBTcl_Alloc\fR with
+just the \fIsize\fR argument.
.PP
\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR are identical in
function to \fBTcl_Alloc\fR and \fBTcl_Realloc\fR, except that
\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR will not cause the Tcl
interpreter to \fBpanic\fR if the memory allocation fails. If the
allocation fails, these functions will return NULL. Note that on some
-platforms, attempting to allocate a block of memory will also cause
-these functions to return NULL.
+platforms, but not all, attempting to allocate a zero-sized block of
+memory will also cause these functions to return NULL.
.PP
The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR,
\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented
diff --git a/doc/AllowExc.3 b/doc/AllowExc.3
index 4e6be72..2343e66 100644
--- a/doc/AllowExc.3
+++ b/doc/AllowExc.3
@@ -5,10 +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: 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"
+.so man.macros
.BS
.SH NAME
Tcl_AllowExceptions \- allow all exceptions in next script evaluation
diff --git a/doc/AppInit.3 b/doc/AppInit.3
index a06e9c7..3e47c1f 100644
--- a/doc/AppInit.3
+++ b/doc/AppInit.3
@@ -5,10 +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: AppInit.3,v 1.4 2004/09/18 17:01:04 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_AppInit \- perform application-specific initialization
@@ -26,7 +24,9 @@ Interpreter for the application.
.SH DESCRIPTION
.PP
-\fBTcl_AppInit\fR is a ``hook'' procedure that is invoked by
+\fBTcl_AppInit\fR is a
+.QW hook
+procedure that is invoked by
the main programs for Tcl applications such as \fBtclsh\fR and \fBwish\fR.
Its purpose is to allow new Tcl applications to be created without
modifying the main programs provided as part of Tcl and Tk.
@@ -34,7 +34,7 @@ To create a new application you write a new version of
\fBTcl_AppInit\fR to replace the default version provided by Tcl,
then link your new \fBTcl_AppInit\fR with the Tcl library.
.PP
-\fBTcl_AppInit\fR is invoked after by \fBTcl_Main\fR and \fBTk_Main\fR
+\fBTcl_AppInit\fR is invoked by \fBTcl_Main\fR and \fBTk_Main\fR
after their own initialization and before entering the main loop
to process commands.
Here are some examples of things that \fBTcl_AppInit\fR might do:
@@ -48,6 +48,11 @@ Process command-line arguments, which can be accessed from the
Tcl variables \fBargv\fR and \fBargv0\fR in \fIinterp\fR.
.IP [3]
Invoke a startup script to initialize the application.
+.IP [4]
+Use the routines \fBTcl_SetStartupScript\fR and
+\fBTcl_GetStartupScript\fR to set or query the file and encoding
+that the active \fBTcl_Main\fR or \fBTk_Main\fR routine will
+use as a startup script.
.LP
\fBTcl_AppInit\fR returns \fBTCL_OK\fR or \fBTCL_ERROR\fR.
If it returns \fBTCL_ERROR\fR then it must leave an error message in
@@ -55,12 +60,14 @@ for the interpreter's result; otherwise the result is ignored.
.PP
In addition to \fBTcl_AppInit\fR, your application should also contain
a procedure \fBmain\fR that calls \fBTcl_Main\fR as follows:
+.PP
.CS
Tcl_Main(argc, argv, Tcl_AppInit);
.CE
+.PP
The third argument to \fBTcl_Main\fR gives the address of the
application-specific initialization procedure to invoke.
-This means that you don't have to use the name \fBTcl_AppInit\fR
+This means that you do not have to use the name \fBTcl_AppInit\fR
for the procedure, but in practice the name is nearly always
\fBTcl_AppInit\fR (in versions before Tcl 7.4 the name \fBTcl_AppInit\fR
was implicit; there was no way to specify the procedure explicitly).
@@ -69,5 +76,8 @@ The best way to get started is to make a copy of the file
It already contains a \fBmain\fR procedure and a template for
\fBTcl_AppInit\fR that you can modify for your application.
+.SH "SEE ALSO"
+Tcl_Main(3)
+
.SH KEYWORDS
application, argument, command, initialization, interpreter
diff --git a/doc/AssocData.3 b/doc/AssocData.3
index 6fb16ed..f819acb 100644
--- a/doc/AssocData.3
+++ b/doc/AssocData.3
@@ -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.
'\"
-'\"
-'\" RCS: @(#) $Id: AssocData.3,v 1.7 2004/10/07 15:15:35 dkf Exp $
-.so man.macros
.TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters
@@ -63,11 +61,13 @@ If the \fIdeleteProc\fR argument is non-NULL it specifies the address of a
procedure to invoke if the interpreter is deleted before the association
is deleted. \fIDeleteProc\fR should have arguments and result that match
the type \fBTcl_InterpDeleteProc\fR:
+.PP
.CS
-typedef void Tcl_InterpDeleteProc(
+typedef void \fBTcl_InterpDeleteProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR);
.CE
+.PP
When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as the corresponding arguments passed to
\fBTcl_SetAssocData\fR.
diff --git a/doc/Async.3 b/doc/Async.3
index 4be3aa6..558b511 100644
--- a/doc/Async.3
+++ b/doc/Async.3
@@ -5,10 +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: Async.3,v 1.9 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events
@@ -50,9 +48,9 @@ or 0 if \fIinterp\fR is NULL.
These procedures provide a safe mechanism for dealing with
asynchronous events such as signals.
If an event such as a signal occurs while a Tcl script is being
-evaluated then it isn't safe to take any substantive action to
+evaluated then it is not safe to take any substantive action to
process the event.
-For example, it isn't safe to evaluate a Tcl script since the
+For example, it is not safe to evaluate a Tcl script since the
interpreter may already be in the middle of evaluating a script;
it may not even be safe to allocate memory, since a memory
allocation could have been in progress when the event occurred.
@@ -83,12 +81,14 @@ the world is in a safe state, and \fIproc\fR can then carry out
the actions associated with the asynchronous event.
\fIProc\fR should have arguments and result that match the
type \fBTcl_AsyncProc\fR:
+.PP
.CS
-typedef int Tcl_AsyncProc(
+typedef int \fBTcl_AsyncProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIcode\fR);
.CE
+.PP
The \fIclientData\fR will be the same as the \fIclientData\fR
argument passed to \fBTcl_AsyncCreate\fR when the handler was
created.
@@ -142,7 +142,6 @@ If new handlers become ready while handlers are executing,
\fBTcl_AsyncInvoke\fR will invoke them all; at each point it
invokes the highest-priority (oldest) ready handler, repeating
this over and over until there are no longer any ready handlers.
-
.SH WARNING
.PP
It is almost always a bad idea for an asynchronous event
@@ -159,4 +158,4 @@ the interpreter's state by calling \fBTcl_RestoreInterpState\fR,
and then returning the \fIcode\fR argument.
.SH KEYWORDS
-asynchronous event, handler, signal, Tcl_SaveInterpState
+asynchronous event, handler, signal, Tcl_SaveInterpState, thread
diff --git a/doc/BackgdErr.3 b/doc/BackgdErr.3
index 315e3b9..4ebcb60 100644
--- a/doc/BackgdErr.3
+++ b/doc/BackgdErr.3
@@ -5,58 +5,74 @@
'\" 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.4 2004/11/20 00:17:31 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_BackgroundError \- report Tcl error that occurred in background processing
+Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurred in background processing
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+\fBTcl_BackgroundException\fR(\fIinterp, code\fR)
+.sp
\fBTcl_BackgroundError\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
-Interpreter in which the error occurred.
+Interpreter in which the exception occurred.
+.AP int code in
+The exceptional return code to be reported.
.BE
.SH DESCRIPTION
.PP
-This procedure is typically invoked when a Tcl error occurs during
-``background processing'' such as executing an event handler.
-When such an error occurs, the error condition is reported to Tcl
+This procedure is typically invoked when a Tcl exception (any
+return code other than TCL_OK) occurs during
+.QW "background processing"
+such as executing an event handler.
+When such an exception occurs, the condition is reported to Tcl
or to a widget or some other C code, and there is not usually any
-obvious way for that code to report the error to the user.
-In these cases the code calls \fBTcl_BackgroundError\fR with an
+obvious way for that code to report the exception to the user.
+In these cases the code calls \fBTcl_BackgroundException\fR with an
\fIinterp\fR argument identifying the interpreter in which the
-error occurred. At the time \fBTcl_BackgroundError\fR is invoked,
-the interpreter's result is expected to contain an error message.
-\fBTcl_BackgroundError\fR will invoke the command registered
+exception occurred, and a \fIcode\fR argument holding the return
+code value of the exception. The state of the interpreter, including
+any error message in the interpreter result, and the values of
+any entries in the return options dictionary, is captured and
+saved. \fBTcl_BackgroundException\fR then arranges for the event
+loop to invoke at some later time the command registered
in that interpreter to handle background errors by the
-\fBinterp bgerror\fR command.
-The registered handler command is meant to report the error
+\fBinterp bgerror\fR command, passing the captured values as
+arguments.
+The registered handler command is meant to report the exception
in an application-specific fashion. The handler command
receives two arguments, the result of the interp, and the
return options of the interp at the time the error occurred.
If the application registers no handler command, the default
handler command will attempt to call \fBbgerror\fR to report
the error. If an error condition arises while invoking the
-handler command, then \fBTcl_BackgroundError\fR reports the
+handler command, then \fBTcl_BackgroundException\fR reports the
error itself by printing a message on the standard error file.
.PP
-\fBTcl_BackgroundError\fR does not invoke the handler command immediately
+\fBTcl_BackgroundException\fR does not invoke the handler command immediately
because this could potentially interfere with scripts that are in process
at the time the error occurred.
Instead, it invokes the handler command later as an idle callback.
.PP
-It is possible for many background errors to accumulate before
-the handler command is invoked. When this happens, each of the errors
-is processed in order. However, if the handle command returns a
+It is possible for many background exceptions to accumulate before
+the handler command is invoked. When this happens, each of the exceptions
+is processed in order. However, if the handler command returns a
break exception, then all remaining error reports for the
interpreter are skipped.
+.PP
+The \fBTcl_BackgroundError\fR routine is an older and simpler interface
+useful when the exception code reported is \fBTCL_ERROR\fR. It is
+equivalent to:
+.PP
+.CS
+Tcl_BackgroundException(interp, TCL_ERROR);
+.CE
.SH KEYWORDS
background, bgerror, error, interp
diff --git a/doc/Backslash.3 b/doc/Backslash.3
index 57b73e9..f121c7c 100644
--- a/doc/Backslash.3
+++ b/doc/Backslash.3
@@ -5,10 +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: Backslash.3,v 1.7 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Backslash \- parse a backslash sequence
@@ -23,7 +21,7 @@ char
.AP char *src in
Pointer to a string starting with a backslash.
.AP int *countPtr out
-If \fIcountPtr\fR isn't NULL, \fI*countPtr\fR gets filled
+If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
in with number of characters in the backslash sequence, including
the backslash character.
.BE
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index da85372..5c8414d 100644
--- a/doc/BoolObj.3
+++ b/doc/BoolObj.3
@@ -5,10 +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: BoolObj.3,v 1.9 2005/05/18 19:09:07 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_BooleanObj 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve boolean value in a Tcl_Obj
@@ -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
@@ -59,7 +57,7 @@ write to a shared Tcl_Obj will panic. A successful write
of \fIboolValue\fR into \fI*objPtr\fR implies the freeing of
any former value stored in \fI*objPtr\fR.
.PP
-\fBTcl_GetBooleanFromObj\fR attempts to retrive a boolean value
+\fBTcl_GetBooleanFromObj\fR attempts to retrieve a boolean value
from the value stored in \fI*objPtr\fR.
If \fIobjPtr\fR holds a string value recognized by \fBTcl_GetBoolean\fR,
then the recognized boolean value is written at the address given
@@ -83,7 +81,9 @@ Note that the routines \fBTcl_GetBooleanFromObj\fR and
The set of values for which \fBTcl_GetBooleanFromObj\fR
will return \fBTCL_OK\fR is strictly larger than
the set of values for which \fBTcl_GetBoolean\fR will do the same.
-For example, the value "5" passed to \fBTcl_GetBooleanFromObj\fR
+For example, the value
+.QW 5
+passed to \fBTcl_GetBooleanFromObj\fR
will lead to a \fBTCL_OK\fR return (and the boolean value 1),
while the same value passed to \fBTcl_GetBoolean\fR will lead to
a \fBTCL_ERROR\fR return.
@@ -92,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 e7cc023..a1f9330 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.6 2004/10/07 15:15:35 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.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,63 +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.
+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.
+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
-representation.
+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
-invalidates the string representation.
+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 b72658a..766621a 100644
--- a/doc/CallDel.3
+++ b/doc/CallDel.3
@@ -5,10 +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: CallDel.3,v 1.3 2004/10/07 14:44:31 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interpreter is deleted
@@ -28,7 +26,6 @@ Procedure to call when \fIinterp\fR is deleted.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by
@@ -38,11 +35,13 @@ is deleted, but the interpreter will still be valid at the
time of the call.
\fIProc\fR should have arguments and result that match the
type \fBTcl_InterpDeleteProc\fR:
+.PP
.CS
-typedef void Tcl_InterpDeleteProc(
+typedef void \fBTcl_InterpDeleteProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR);
.CE
+.PP
The \fIclientData\fR and \fIinterp\fR parameters are
copies of the \fIclientData\fR and \fIinterp\fR arguments given
to \fBTcl_CallWhenDeleted\fR.
@@ -53,11 +52,16 @@ interpreter is about to go away.
.PP
\fBTcl_DontCallWhenDeleted\fR cancels a previous call to
\fBTcl_CallWhenDeleted\fR with the same arguments, so that
-\fIproc\fR won't be called after all when \fIinterp\fR is
+\fIproc\fR will not be called after all when \fIinterp\fR is
deleted.
If there is no deletion callback that matches \fIinterp\fR,
\fIproc\fR, and \fIclientData\fR then the call to
\fBTcl_DontCallWhenDeleted\fR has no effect.
-
+.PP
+Note that if the callback is being used to delete a resource that \fImust\fR
+be released on exit, \fBTcl_CreateExitHandler\fR should be used to ensure that
+a callback is received even if the application terminates without deleting the interpreter.
+.SH "SEE ALSO"
+Tcl_CreateExitHandler(3), Tcl_CreateThreadExitHandler(3)
.SH KEYWORDS
-callback, delete, interpreter
+callback, cleanup, delete, interpreter
diff --git a/doc/Cancel.3 b/doc/Cancel.3
new file mode 100644
index 0000000..5d258b7
--- /dev/null
+++ b/doc/Cancel.3
@@ -0,0 +1,66 @@
+'\"
+'\" Copyright (c) 2006-2008 Joe Mistachkin.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_Cancel 3 8.6 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_CancelEval, Tcl_Canceled \- cancel Tcl scripts
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+int
+\fBTcl_CancelEval\fR(\fIinterp, clientData, flags\fR)
+.sp
+int
+\fBTcl_Canceled\fR(\fIinterp, flags\fR)
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Interpreter in which to cancel the script.
+.AP int flags in
+ORed combination of flag bits that specify additional options.
+For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
+supported. For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
+\fBTCL_CANCEL_UNWIND\fR are currently supported.
+.AP ClientData clientData in
+Currently, reserved for future use.
+It should be set to NULL.
+.BE
+.SH DESCRIPTION
+.PP
+\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
+the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
+the return code for that script. This function is thread-safe and may be
+called from any thread in the process.
+.PP
+\fBTcl_Canceled\fR checks if the script in progress has been canceled and
+returns \fBTCL_ERROR\fR if it has. Otherwise, \fBTCL_OK\fR is returned.
+Extensions can use this function to check to see if they should abort a long
+running command. This function is thread sensitive and may only be called
+from the thread the interpreter was created in.
+.SH "FLAG BITS"
+Any ORed combination of the following values may be used for the
+\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
+.TP 23
+\fBTCL_CANCEL_UNWIND\fR
+This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
+For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
+is canceled and the evaluation stack for the interpreter is unwound.
+For \fBTcl_Canceled\fR, if this flag is set, the script in progress
+is considered to be canceled only if the evaluation stack for the
+interpreter is being unwound.
+.TP 23
+\fBTCL_LEAVE_ERR_MSG\fR
+This flag is only used by \fBTcl_Canceled\fR; it is ignored by
+other procedures. If an error is returned and this bit is set in
+\fIflags\fR, then an error message will be left in the interpreter's
+result, where it can be retrieved with \fBTcl_GetObjResult\fR or
+\fBTcl_GetStringResult\fR. If this flag bit is not set then no error
+message is left and the interpreter's result will not be modified.
+.SH "SEE ALSO"
+TIP 285
+.SH KEYWORDS
+cancel, unwind
diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3
index 0a656a5..b046cd2 100644
--- a/doc/ChnlStack.3
+++ b/doc/ChnlStack.3
@@ -3,10 +3,8 @@
'\"
'\" 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.7 2004/10/07 14:44:31 dkf Exp $
-.so man.macros
.TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -32,14 +30,14 @@ Tcl_Channel
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
-.AP Tcl_ChannelType *typePtr in
-The new channel I/O procedures to use for \fIchannel\fP.
+.AP "const Tcl_ChannelType" *typePtr in
+The new channel I/O procedures to use for \fIchannel\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to channel I/O procedures.
.AP int mask in
Conditions under which \fIchannel\fR will be used: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
-This can be a subset of the operations currently allowed on \fIchannel\fP.
+This can be a subset of the operations currently allowed on \fIchannel\fR.
.AP Tcl_Channel channel in
An existing Tcl channel such as returned by \fBTcl_CreateChannel\fR.
.BE
@@ -57,9 +55,9 @@ stacked channels. Anyone using stacked channels or creating stacked
channel drivers should update to the new \fBTCL_CHANNEL_VERSION_2\fR
\fBTcl_ChannelType\fR structure. See \fBTcl_CreateChannel\fR for details.
.PP
-\fBTcl_StackChannel\fR stacks a new \fIchannel\fP on an existing channel
-with the same name that was registered for \fIchannel\fP by
-\fBTcl_RegisterChannel\fP.
+\fBTcl_StackChannel\fR stacks a new \fIchannel\fR on an existing channel
+with the same name that was registered for \fIchannel\fR by
+\fBTcl_RegisterChannel\fR.
.PP
\fBTcl_StackChannel\fR works by creating a new channel structure and
placing itself on top of the channel stack. EOL translation, encoding and
@@ -70,7 +68,7 @@ remain at the top of the channel stack. A pointer to the new top channel
structure is returned. If an error occurs when stacking the channel, NULL
is returned instead.
.PP
-The \fImask\fP parameter specifies the operations that are allowed on the
+The \fImask\fR parameter specifies the operations that are allowed on the
new channel. These can be a subset of the operations allowed on the
original channel. For example, a read-write channel may become read-only
after the \fBTcl_StackChannel\fR call.
@@ -79,10 +77,10 @@ Closing a channel closes the channels stacked below it. The close of
stacked channels is executed in a way that allows buffered data to be
properly flushed.
.PP
-\fBTcl_UnstackChannel\fP reverses the process. The old channel is
+\fBTcl_UnstackChannel\fR reverses the process. The old channel is
associated with the channel name, and the processing module added by
\fBTcl_StackChannel\fR is destroyed. If there is no old channel, then
-\fBTcl_UnstackChannel\fP is equivalent to \fBTcl_Close\fP. If an error
+\fBTcl_UnstackChannel\fR is equivalent to \fBTcl_Close\fR. If an error
occurs unstacking the channel, \fBTCL_ERROR\fR is returned, otherwise
\fBTCL_OK\fR is returned.
.PP
diff --git a/doc/Class.3 b/doc/Class.3
new file mode 100644
index 0000000..7e421fe
--- /dev/null
+++ b/doc/Class.3
@@ -0,0 +1,236 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions"
+.so man.macros
+.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_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
+.sp
+Tcl_Object
+\fBTcl_GetObjectFromObj\fR(\fIinterp, objPtr\fR)
+.sp
+Tcl_Object
+\fBTcl_GetClassAsObject\fR(\fIclass\fR)
+.sp
+Tcl_Class
+\fBTcl_GetObjectAsClass\fR(\fIobject\fR)
+.sp
+Tcl_Obj *
+\fBTcl_GetObjectName\fR(\fIinterp, object\fR)
+.sp
+Tcl_Command
+\fBTcl_GetObjectCommand\fR(\fIobject\fR)
+.sp
+Tcl_Namespace *
+\fBTcl_GetObjectNamespace\fR(\fIobject\fR)
+.sp
+Tcl_Object
+\fBTcl_NewObjectInstance\fR(\fIinterp, class, name, nsName, objc, objv, skip\fR)
+.sp
+Tcl_Object
+\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
+.sp
+int
+\fBTcl_ObjectDeleted\fR(\fIobject\fR)
+.sp
+ClientData
+\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
+.sp
+\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
+.sp
+ClientData
+\fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR)
+.sp
+\fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR)
+.sp
+Tcl_ObjectMapMethodNameProc
+\fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR)
+.sp
+\fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR)
+.SH ARGUMENTS
+.AS ClientData metadata in/out
+.AP Tcl_Interp *interp in/out
+Interpreter providing the context for looking up or creating an object, and
+into whose result error messages will be written on failure.
+.AP Tcl_Obj *objPtr in
+The name of the object to look up.
+.AP Tcl_Object object in
+Reference to the object to operate upon.
+.AP Tcl_Class class in
+Reference to the class to operate upon.
+.AP "const char" *name in
+The name of the object to create, or NULL if a new unused name is to be
+automatically selected.
+.AP "const char" *nsName in
+The name of the namespace to create for the object's private use, or NULL if a
+new unused name is to be automatically selected.
+.AP int objc in
+The number of elements in the \fIobjv\fR array.
+.AP "Tcl_Obj *const" *objv in
+The arguments to the command to create the instance of the class.
+.AP int skip in
+The number of arguments at the start of the argument array, \fIobjv\fR, that
+are not arguments to any constructors.
+.AP Tcl_ObjectMetadataType *metaTypePtr in
+The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
+retrieved with \fBTcl_ClassGetMetadata\fR.
+.AP ClientData metadata in
+An item of metadata to attach to the class, or NULL to remove the metadata
+associated with a particular \fImetaTypePtr\fR.
+.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in
+A pointer to a function to call to adjust the mapping of objects and method
+names to implementations, or NULL when no such mapping is required.
+.BE
+.SH DESCRIPTION
+.PP
+Objects are typed entities that have a set of operations ("methods")
+associated with them. Classes are objects that can manufacture objects. Each
+class can be viewed as an object itself; the object view can be retrieved
+using \fBTcl_GetClassAsObject\fR which always returns the object when applied
+to a non-destroyed class, and an object can be viewed as a class with the aid
+of the \fBTcl_GetObjectAsClass\fR (which either returns the class, or NULL if
+the object is not a class). An object may be looked up using the
+\fBTcl_GetObjectFromObj\fR function, which either returns an object or NULL
+(with an error message in the interpreter result) if the object cannot be
+found. The correct way to look up a class by name is to look up the object
+with that name, and then to use \fBTcl_GetObjectAsClass\fR.
+.PP
+Every object has its own command and namespace associated with it. The command
+may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of
+the object (and hence the name of the command) with \fBTcl_GetObjectName\fR,
+and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR
+function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR
+is a shared reference.
+.PP
+Instances of classes are created using \fBTcl_NewObjectInstance\fR, which
+creates an object from any class (and which is internally called by both
+the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes
+parameters that optionally give the name of the object and namespace to
+create, and which describe the arguments to pass to the class's constructor
+(if any). The result of the function will be either a reference to the newly
+created object, or NULL if the creation failed (when an error message will be
+left in the interpreter result). In addition, objects may be copied by using
+\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
+any constructors.
+.SH "OBJECT AND CLASS METADATA"
+.PP
+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 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
+retrieved given its type using \fBTcl_ObjectGetMetadata\fR and
+\fBTcl_ClassGetMetadata\fR. If the \fImetadata\fR parameter to either
+\fBTcl_ObjectSetMetadata\fR or \fBTcl_ClassSetMetadata\fR is NULL, the
+metadata is removed if it was attached, and the results of
+\fBTcl_ObjectGetMetadata\fR and \fBTcl_ClassGetMetadata\fR are NULL if the
+given type of metadata was not attached. It is not an error to request or
+remove a piece of metadata that was not attached.
+.SS "TCL_OBJECTMETADATATYPE STRUCTURE"
+.PP
+The contents of the Tcl_ObjectMetadataType structure are as follows:
+.PP
+.CS
+typedef const struct {
+ int \fIversion\fR;
+ const char *\fIname\fR;
+ Tcl_ObjectMetadataDeleteProc *\fIdeleteProc\fR;
+ Tcl_CloneProc *\fIcloneProc\fR;
+} \fBTcl_ObjectMetadataType\fR;
+.CE
+.PP
+The \fIversion\fR field allows for future expansion of the structure, and
+should always be declared equal to TCL_OO_METADATA_VERSION_CURRENT. The
+\fIname\fR field provides a human-readable name for the type, and is reserved
+for debugging.
+.PP
+The \fIdeleteProc\fR field gives a function of type
+Tcl_ObjectMetadataDeleteProc that is used to delete a particular piece of
+metadata, and is called when the attached metadata is replaced or removed; the
+field must not be NULL.
+.PP
+The \fIcloneProc\fR field gives a function that is used to copy a piece of
+metadata (used when a copy of an object is created using
+\fBTcl_CopyObjectInstance\fR); if NULL, the metadata will be just directly
+copied.
+.SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to delete metadata associated with
+a class or object.
+.PP
+.CS
+typedef void \fBTcl_ObjectMetadataDeleteProc\fR(
+ ClientData \fImetadata\fR);
+.CE
+.PP
+The \fImetadata\fR argument gives the address of the metadata to be
+deleted.
+.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to create copies of metadata
+associated with a class or object.
+.PP
+.CS
+typedef int \fBTcl_CloneProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ ClientData \fIsrcMetadata\fR,
+ ClientData *\fIdstMetadataPtr\fR);
+.CE
+.PP
+The \fIinterp\fR argument gives a place to write an error message when the
+attempt to clone the object is to fail, in which case the clone procedure must
+also return TCL_ERROR; it should return TCL_OK otherwise.
+The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned,
+and the cloned metadata should be written into the variable pointed to by
+\fIdstMetadataPtr\fR; a NULL should be written if the metadata is to not be
+cloned but the overall object copy operation is still to succeed.
+.SH "OBJECT METHOD NAME MAPPING"
+It is possible to control, on a per-object basis, what methods are invoked
+when a particular method is invoked. Normally this is done by looking up the
+method name in the object and then in the class hierarchy, but fine control of
+exactly what the value used to perform the look up is afforded through the
+ability to set a method name mapper callback via
+\fBTcl_ObjectSetMethodNameMapper\fR (and its introspection counterpart,
+\fBTcl_ObjectGetMethodNameMapper\fR, which returns the current mapper). The
+current mapper (if any) is invoked immediately before looking up what chain of
+method implementations is to be used.
+.SS "TCL_OBJECTMAPMETHODNAMEPROC FUNCTION SIGNATURE"
+The \fITcl_ObjectMapMethodNameProc\fR callback is defined as follows:
+.PP
+.CS
+typedef int \fBTcl_ObjectMapMethodNameProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Object \fIobject\fR,
+ Tcl_Class *\fIstartClsPtr\fR,
+ Tcl_Obj *\fImethodNameObj\fR);
+.CE
+.PP
+If the result is TCL_OK, the remapping is assumed to have been done. If the
+result is TCL_ERROR, an error message will have been left in \fIinterp\fR and
+the method call will fail. If the result is TCL_BREAK, the standard method
+name lookup rules will be used; the behavior of other result codes is
+currently undefined. The \fIobject\fR parameter says which object is being
+processed. The \fIstartClsPtr\fR parameter points to a variable that contains
+the first class to provide a definition in the method chain to process, or
+NULL if the whole chain is to be processed (the argument itself is never
+NULL); this variable may be updated by the callback. The \fImethodNameObj\fR
+parameter gives an unshared object containing the name of the method being
+invoked, as provided by the user; this object may be updated by the callback.
+.SH "SEE ALSO"
+Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+class, constructor, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3
index 152655a..25b372e 100644
--- a/doc/CmdCmplt.3
+++ b/doc/CmdCmplt.3
@@ -5,10 +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: CmdCmplt.3,v 1.4 2004/10/07 15:15:35 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CommandComplete \- Check for unmatched braces in a Tcl command
diff --git a/doc/Concat.3 b/doc/Concat.3
index d4ba689..58a0fb6 100644
--- a/doc/Concat.3
+++ b/doc/Concat.3
@@ -5,10 +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: 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"
+.so man.macros
.BS
.SH NAME
Tcl_Concat \- concatenate a collection of strings
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index f4751b5..1c5c665 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -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.
-'\"
-'\" RCS: @(#) $Id: CrtChannel.3,v 1.31 2005/06/07 20:37:40 dkf Exp $
-.so man.macros
.TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -22,7 +20,7 @@ Tcl_Channel
ClientData
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
-Tcl_ChannelType *
+const Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
@@ -98,10 +96,8 @@ Tcl_DriverWideSeekProc *
Tcl_DriverThreadActionProc *
\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
.sp
-.VS 8.5
Tcl_DriverTruncateProc *
\fBTcl_ChannelTruncateProc\fR(\fItypePtr\fR)
-.VE 8.5
.sp
Tcl_DriverSetOptionProc *
\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
@@ -122,14 +118,16 @@ Tcl_DriverHandlerProc *
\fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR)
.sp
.SH ARGUMENTS
-.AS Tcl_ChannelType *channelName
-.AP Tcl_ChannelType *typePtr in
+.AS "const Tcl_ChannelType" *channelName
+.AP "const Tcl_ChannelType" *typePtr in
Points to a structure containing the addresses of procedures that
can be called to perform I/O and other functions on the channel.
.AP "const char" *channelName in
The name of this channel, such as \fBfile3\fR; must not be in use
by any other channel. Can be NULL, in which case the channel is
-created without a name.
+created without a name. If the created channel is assigned to one
+of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR),
+the assigned channel name will be the name of the standard channel.
.AP ClientData instanceData in
Arbitrary one-word value to be associated with this channel. This
value is passed to procedures in \fItypePtr\fR when they are invoked.
@@ -155,12 +153,11 @@ Current interpreter. (can be NULL)
.AP "const char" *optionName in
Name of the invalid option.
.AP "const char" *optionList in
-Specific options list (space separated words, without "-")
+Specific options list (space separated words, without
+.QW \- )
to append to the standard generic options list.
Can be NULL for generic options error message only.
-
.BE
-
.SH DESCRIPTION
.PP
Tcl uses a two-layered channel architecture. It provides a generic upper
@@ -214,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
@@ -253,8 +250,8 @@ the default value of 4096 is returned.
.PP
\fBTcl_SetChannelBufferSize\fR sets the size, in bytes, of buffers that
will be allocated in subsequent operations on the channel to store input or
-output. The \fIsize\fR argument should be between ten and one million,
-allowing buffers of ten bytes to one million bytes. If \fIsize\fR is
+output. The \fIsize\fR argument should be between one and one million,
+allowing buffers of one byte to one million bytes. If \fIsize\fR is
outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
4096.
.PP
@@ -289,22 +286,18 @@ name is registered in the (thread)-global list of all channels (result
(thread)global list of all channels (of the current thread).
Application to a channel still registered in some interpreter
is not allowed.
-.VS 8.5
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
\fBTcl_DriverThreadActionProc\fR is defined for it.
-.VE 8.5
.PP
\fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the
(thread)global list of all channels (of the current thread).
Application to a channel registered in some interpreter is not allowed.
-.VS 8.5
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
\fBTcl_DriverThreadActionProc\fR is defined for it.
-.VE 8.5
.PP
-\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
+\fBTcl_ClearChannelHandlers\fR removes all channel handlers and event
scripts associated with the specified \fIchannel\fR, thus shutting
down all event processing for this channel.
.SH TCL_CHANNELTYPE
@@ -317,9 +310,10 @@ channel drivers. See the \fBOLD CHANNEL TYPES\fR section below for
details about the old structure.
.PP
The \fBTcl_ChannelType\fR structure contains the following fields:
+.PP
.CS
typedef struct Tcl_ChannelType {
- char *\fItypeName\fR;
+ const char *\fItypeName\fR;
Tcl_ChannelTypeVersion \fIversion\fR;
Tcl_DriverCloseProc *\fIcloseProc\fR;
Tcl_DriverInputProc *\fIinputProc\fR;
@@ -334,20 +328,20 @@ typedef struct Tcl_ChannelType {
Tcl_DriverFlushProc *\fIflushProc\fR;
Tcl_DriverHandlerProc *\fIhandlerProc\fR;
Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
-.VS 8.5
Tcl_DriverThreadActionProc *\fIthreadActionProc\fR;
Tcl_DriverTruncateProc *\fItruncateProc\fR;
-.VE 8.5
-} Tcl_ChannelType;
+} \fBTcl_ChannelType\fR;
.CE
.PP
-The driver must provide implementations for all functions except
-\fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
-\fIgetOptionProc\fR, and \fIclose2Proc\fR, which may be specified as
-NULL. Other functions that can not be implemented for this type of
-device should return \fBEINVAL\fR when invoked to indicate that they
-are not implemented, except in the case of \fIflushProc\fR and
-\fIhandlerProc\fR, which should specified as NULL if not otherwise defined.
+It is not necessary to provide implementations for all channel
+operations. Those which are not necessary may be set to NULL in the
+struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
+\fIgetOptionProc\fR, and \fIclose2Proc\fR, in addition to
+\fIflushProc\fR, \fIhandlerProc\fR, \fIthreadActionProc\fR, and
+\fItruncateProc\fR. Other functions that cannot be implemented in a
+meaningful way should return \fBEINVAL\fR when called, to indicate
+that the operations they represent are not available. Also note that
+\fIwideSeekProc\fR can be NULL if \fIseekProc\fR is.
.PP
The user should only use the above structure for \fBTcl_ChannelType\fR
instantiation. When referencing fields in a \fBTcl_ChannelType\fR
@@ -357,9 +351,7 @@ structure, the following functions should be used to obtain the values:
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
\fBTcl_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR,
-.VS 8.5
\fBTcl_ChannelTruncateProc\fR,
-.VE 8.5
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
@@ -381,12 +373,12 @@ a pointer to the string.
The \fIversion\fR field should be set to the version of the structure
that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended.
-\fBTCL_CHANNEL_VERSION_3\fR must be set to specifiy the \fIwideSeekProc\fR member.
-.VS 8.5
-\fBTCL_CHANNEL_VERSION_4\fR must be set to specifiy the
-\fIthreadActionProc\fR and \fItruncateProc\fR members (includes
-\fIwideSeekProc\fR).
-.VE 8.5
+\fBTCL_CHANNEL_VERSION_3\fR must be set to specify the \fIwideSeekProc\fR member.
+\fBTCL_CHANNEL_VERSION_4\fR must be set to specify the \fIthreadActionProc\fR member
+(includes \fIwideSeekProc\fR).
+\fBTCL_CHANNEL_VERSION_5\fR must be set to specify the
+\fItruncateProc\fR members (includes
+\fIwideSeekProc\fR and \fIthreadActionProc\fR).
If it is not set to any of these, then this
\fBTcl_ChannelType\fR is assumed to have the original structure. See
\fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize
@@ -395,9 +387,8 @@ least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
.PP
This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
one of
-.VS 8.5
+\fBTCL_CHANNEL_VERSION_5\fR,
\fBTCL_CHANNEL_VERSION_4\fR,
-.VE 8.5
\fBTCL_CHANNEL_VERSION_3\fR,
\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
.SS BLOCKMODEPROC
@@ -407,7 +398,7 @@ the generic layer to set blocking and nonblocking mode on the device.
\fIBlockModeProc\fR should match the following prototype:
.PP
.CS
-typedef int Tcl_DriverBlockModeProc(
+typedef int \fBTcl_DriverBlockModeProc\fR(
ClientData \fIinstanceData\fR,
int \fImode\fR);
.CE
@@ -433,7 +424,7 @@ A channel driver \fBnot\fR supplying a \fIblockModeProc\fR has to be
very, very careful. It has to tell the generic layer exactly which
blocking mode is acceptable to it, and should this also document for
the user so that the blocking mode of the channel is not changed to an
-inacceptable value. Any confusion here may lead the interpreter into a
+unacceptable value. Any confusion here may lead the interpreter into a
(spurious and difficult to find) deadlock.
.SS "CLOSEPROC AND CLOSE2PROC"
.PP
@@ -442,7 +433,7 @@ generic layer to clean up driver-related information when the channel is
closed. \fICloseProc\fR must match the following prototype:
.PP
.CS
-typedef int Tcl_DriverCloseProc(
+typedef int \fBTcl_DriverCloseProc\fR(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR);
.CE
@@ -464,7 +455,7 @@ independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set
following prototype:
.PP
.CS
-typedef int Tcl_DriverClose2Proc(
+typedef int \fBTcl_DriverClose2Proc\fR(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIflags\fR);
@@ -495,7 +486,7 @@ generic layer to read data from the file or device and store it in an
internal buffer. \fIInputProc\fR must match the following prototype:
.PP
.CS
-typedef int Tcl_DriverInputProc(
+typedef int \fBTcl_DriverInputProc\fR(
ClientData \fIinstanceData\fR,
char *\fIbuf\fR,
int \fIbufSize\fR,
@@ -539,7 +530,7 @@ generic layer to transfer data from an internal buffer to the output device.
\fIOutputProc\fR must match the following prototype:
.PP
.CS
-typedef int Tcl_DriverOutputProc(
+typedef int \fBTcl_DriverOutputProc\fR(
ClientData \fIinstanceData\fR,
const char *\fIbuf\fR,
int \fItoWrite\fR,
@@ -578,7 +569,7 @@ operations will be applied. \fISeekProc\fR must match the following
prototype:
.PP
.CS
-typedef int Tcl_DriverSeekProc(
+typedef int \fBTcl_DriverSeekProc\fR(
ClientData \fIinstanceData\fR,
long \fIoffset\fR,
int \fIseekMode\fR,
@@ -608,7 +599,7 @@ in preference to the \fIseekProc\fR, but both must be defined if the
following prototype:
.PP
.CS
-typedef Tcl_WideInt Tcl_DriverWideSeekProc(
+typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
ClientData \fIinstanceData\fR,
Tcl_WideInt \fIoffset\fR,
int \fIseekMode\fR,
@@ -630,7 +621,7 @@ the generic layer to set a channel type specific option on a channel.
\fIsetOptionProc\fR must match the following prototype:
.PP
.CS
-typedef int Tcl_DriverSetOptionProc(
+typedef int \fBTcl_DriverSetOptionProc\fR(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR,
const char *\fIoptionName\fR,
@@ -644,7 +635,7 @@ created. The function should do whatever channel type specific action is
required to implement the new value of the option.
.PP
Some options are handled by the generic code and this function is never
-called to set them, e.g. \fB-blockmode\fR. Other options are specific to
+called to set them, e.g. \fB\-blockmode\fR. Other options are specific to
each channel type and the \fIsetOptionProc\fR procedure of the channel
driver will get called to implement them. The \fIsetOptionProc\fR field can
be NULL, which indicates that this channel type supports no type specific
@@ -671,7 +662,7 @@ the generic layer to get the value of a channel type specific option on a
channel. \fIgetOptionProc\fR must match the following prototype:
.PP
.CS
-typedef int Tcl_DriverGetOptionProc(
+typedef int \fBTcl_DriverGetOptionProc\fR(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR,
const char *\fIoptionName\fR,
@@ -693,7 +684,7 @@ function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
Some options are handled by the generic code and this function is never
-called to retrieve their value, e.g. \fB-blockmode\fR. Other options are
+called to retrieve their value, e.g. \fB\-blockmode\fR. Other options are
specific to each channel type and the \fIgetOptionProc\fR procedure of the
channel driver will get called to implement them. The \fIgetOptionProc\fR
field can be NULL, which indicates that this channel type supports no type
@@ -709,7 +700,7 @@ notice events of interest on this channel.
\fIWatchProc\fR should match the following prototype:
.PP
.CS
-typedef void Tcl_DriverWatchProc(
+typedef void \fBTcl_DriverWatchProc\fR(
ClientData \fIinstanceData\fR,
int \fImask\fR);
.CE
@@ -740,7 +731,7 @@ the generic layer to retrieve a device-specific handle from the channel.
\fIGetHandleProc\fR should match the following prototype:
.PP
.CS
-typedef int Tcl_DriverGetHandleProc(
+typedef int \fBTcl_DriverGetHandleProc\fR(
ClientData \fIinstanceData\fR,
int \fIdirection\fR,
ClientData *\fIhandlePtr\fR);
@@ -769,7 +760,7 @@ It should be set to NULL.
\fIFlushProc\fR should match the following prototype:
.PP
.CS
-typedef int Tcl_DriverFlushProc(
+typedef int \fBTcl_DriverFlushProc\fR(
ClientData \fIinstanceData\fR);
.CE
.PP
@@ -784,7 +775,7 @@ that occur on the underlying (stacked) channel.
\fIHandlerProc\fR should match the following prototype:
.PP
.CS
-typedef int Tcl_DriverHandlerProc(
+typedef int \fBTcl_DriverHandlerProc\fR(
ClientData \fIinstanceData\fR,
int \fIinterestMask\fR);
.CE
@@ -813,9 +804,9 @@ might be maintaining using the calling thread as the associate. See
\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
.PP
.CS
-typedef void Tcl_DriverThreadActionProc(
+typedef void \fBTcl_DriverThreadActionProc\fR(
ClientData \fIinstanceData\fR,
- int \fIaction\fR);
+ int \fIaction\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
@@ -830,7 +821,7 @@ called by the generic layer when a channel is truncated to some
length. It can be NULL.
.PP
.CS
-typedef int Tcl_DriverTruncateProc(
+typedef int \fBTcl_DriverTruncateProc\fR(
ClientData \fIinstanceData\fR,
Tcl_WideInt \fIlength\fR);
.CE
@@ -845,7 +836,9 @@ These values can be retrieved with \fBTcl_ChannelTruncateProc\fR,
which returns a pointer to the function.
.SH TCL_BADCHANNELOPTION
.PP
-This procedure generates a "bad option" error message in an
+This procedure generates a
+.QW "bad option"
+error message in an
(optional) interpreter. It is used by channel drivers when
an invalid Set/Get option is requested. Its purpose is to concatenate
the generic options list to the specific ones and factorize
@@ -853,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
@@ -866,30 +859,35 @@ so you get for instance:
-buffering, -buffersize, -eofchar, -translation,
-peername, or -sockname
.CE
-when called with \fIoptionList\fR="peername sockname"
+when called with \fIoptionList\fR equal to
+.QW "peername sockname"
.PP
-``blah'' is the \fIoptionName\fR argument and ``<specific options>''
+.QW blah
+is the \fIoptionName\fR argument and
+.QW "<specific options>"
is a space separated list of specific option words.
The function takes good care of inserting minus signs before
-each option, commas after, and an ``or'' before the last option.
+each option, commas after, and an
+.QW or
+before the last option.
.SH "OLD CHANNEL TYPES"
The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains
the following fields:
.PP
.CS
typedef struct Tcl_ChannelType {
- char *\fItypeName\fR;
- Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
- Tcl_DriverCloseProc *\fIcloseProc\fR;
- Tcl_DriverInputProc *\fIinputProc\fR;
- Tcl_DriverOutputProc *\fIoutputProc\fR;
- Tcl_DriverSeekProc *\fIseekProc\fR;
- Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
- Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
- Tcl_DriverWatchProc *\fIwatchProc\fR;
- Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
- Tcl_DriverClose2Proc *\fIclose2Proc\fR;
-} Tcl_ChannelType;
+ const char *\fItypeName\fR;
+ Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_DriverCloseProc *\fIcloseProc\fR;
+ Tcl_DriverInputProc *\fIinputProc\fR;
+ Tcl_DriverOutputProc *\fIoutputProc\fR;
+ Tcl_DriverSeekProc *\fIseekProc\fR;
+ Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
+ Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+ Tcl_DriverWatchProc *\fIwatchProc\fR;
+ Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+} \fBTcl_ChannelType\fR;
.CE
.PP
It is still possible to create channel with the above structure. The
@@ -904,29 +902,27 @@ contained the following fields:
.PP
.CS
typedef struct Tcl_ChannelType {
- char *\fItypeName\fR;
- Tcl_ChannelTypeVersion \fIversion\fR;
- Tcl_DriverCloseProc *\fIcloseProc\fR;
- Tcl_DriverInputProc *\fIinputProc\fR;
- Tcl_DriverOutputProc *\fIoutputProc\fR;
- Tcl_DriverSeekProc *\fIseekProc\fR;
- Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
- Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
- Tcl_DriverWatchProc *\fIwatchProc\fR;
- Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
- Tcl_DriverClose2Proc *\fIclose2Proc\fR;
- Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
- Tcl_DriverFlushProc *\fIflushProc\fR;
- Tcl_DriverHandlerProc *\fIhandlerProc\fR;
- Tcl_DriverTruncateProc *\fItruncateProc\fR;
-} Tcl_ChannelType;
+ const char *\fItypeName\fR;
+ Tcl_ChannelTypeVersion \fIversion\fR;
+ Tcl_DriverCloseProc *\fIcloseProc\fR;
+ Tcl_DriverInputProc *\fIinputProc\fR;
+ Tcl_DriverOutputProc *\fIoutputProc\fR;
+ Tcl_DriverSeekProc *\fIseekProc\fR;
+ Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
+ Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+ Tcl_DriverWatchProc *\fIwatchProc\fR;
+ Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+ Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_DriverFlushProc *\fIflushProc\fR;
+ Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+ Tcl_DriverTruncateProc *\fItruncateProc\fR;
+} \fBTcl_ChannelType\fR;
.CE
.PP
When the above structure is registered as a channel type, the
\fIversion\fR field should always be \fBTCL_CHANNEL_VERSION_2\fR.
-
.SH "SEE ALSO"
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3), Tcl_GetStdChannel(3)
-
.SH KEYWORDS
blocking, channel driver, channel registration, channel type, nonblocking
diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3
index 8988c63..0ecd3c9 100644
--- a/doc/CrtChnlHdlr.3
+++ b/doc/CrtChnlHdlr.3
@@ -4,9 +4,8 @@
'\" 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.3 2004/10/07 14:44:31 dkf Exp $
-.so man.macros
.TH Tcl_CreateChannelHandler 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -36,7 +35,6 @@ the conditions specified by \fImask\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the
@@ -47,8 +45,9 @@ invoked are specified by the \fImask\fR argument.
See the manual entry for \fBfileevent\fR for a precise description of
what it means for a channel to be readable or writable.
\fIProc\fR must conform to the following prototype:
+.PP
.CS
-typedef void Tcl_ChannelProc(
+typedef void \fBTcl_ChannelProc\fR(
ClientData \fIclientData\fR,
int \fImask\fR);
.CE
@@ -63,7 +62,7 @@ contain a subset of the bits from the \fImask\fR argument to
.PP
Each channel handler is identified by a unique combination of \fIchannel\fR,
\fIproc\fR and \fIclientData\fR.
-There may be many handlers for a given channel as long as they don't
+There may be many handlers for a given channel as long as they do not
have the same \fIchannel\fR, \fIproc\fR, and \fIclientData\fR.
If \fBTcl_CreateChannelHandler\fR is invoked when there is already a handler
for \fIchannel\fR, \fIproc\fR, and \fIclientData\fR, then no new
@@ -84,9 +83,7 @@ so that the channel is no longer readable when the second handler
is invoked.
For this reason it may be useful to use nonblocking I/O on channels
for which there are event handlers.
-
.SH "SEE ALSO"
Notifier(3), Tcl_CreateChannel(3), Tcl_OpenFileChannel(3), vwait(n).
-
.SH KEYWORDS
blocking, callback, channel, events, handler, nonblocking.
diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3
index 6d55d9d..bac2431 100644
--- a/doc/CrtCloseHdlr.3
+++ b/doc/CrtCloseHdlr.3
@@ -4,9 +4,8 @@
'\" 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.3 2004/10/07 14:44:31 dkf Exp $
-.so man.macros
.TH Tcl_CreateCloseHandler 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -30,7 +29,6 @@ The procedure to call as the callback.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when
@@ -39,7 +37,7 @@ Arbitrary one-word value to pass to \fIproc\fR.
\fIProc\fR should match the following prototype:
.PP
.CS
-typedef void Tcl_CloseProc(
+typedef void \fBTcl_CloseProc\fR(
ClientData \fIclientData\fR);
.CE
.PP
@@ -51,9 +49,7 @@ The \fIproc\fR and \fIclientData\fR identify which close callback to
remove; \fBTcl_DeleteCloseHandler\fR does nothing if its \fIproc\fR and
\fIclientData\fR arguments do not match the \fIproc\fR and \fIclientData\fR
for a close handler for \fIchannel\fR.
-
.SH "SEE ALSO"
close(n), Tcl_Close(3), Tcl_UnregisterChannel(3)
-
.SH KEYWORDS
callback, channel closing
diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3
index c4e042a..fca64ce 100644
--- a/doc/CrtCommand.3
+++ b/doc/CrtCommand.3
@@ -5,10 +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: CrtCommand.3,v 1.12 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CreateCommand \- implement new commands in C
@@ -34,7 +32,6 @@ Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateCommand\fR defines a new command in \fIinterp\fR and associates
@@ -44,20 +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
-and create a new Tcl object to hold the string result returned by the
-string-based command procedure.
+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
@@ -77,13 +72,15 @@ the process of being deleted, then it does not create a new command
and it returns NULL.
\fIProc\fR should have arguments and result that match the type
\fBTcl_CmdProc\fR:
+.PP
.CS
-typedef int Tcl_CmdProc(
+typedef int \fBTcl_CmdProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIargc\fR,
const char *\fIargv\fR[]);
.CE
+.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
parameters will be copies of the \fIclientData\fR and \fIinterp\fR
arguments given to \fBTcl_CreateCommand\fR.
@@ -107,7 +104,7 @@ version 8.1 of Tcl.
\fBTCL_CONTINUE\fR. See the Tcl overview man page
for details on what these codes mean. Most normal commands will only
return \fBTCL_OK\fR or \fBTCL_ERROR\fR. In addition, \fIproc\fR must set
-the interpreter result to point to a string value;
+the interpreter result;
in the case of a \fBTCL_OK\fR return code this gives the result
of the command, and in the case of \fBTCL_ERROR\fR it gives an error message.
The \fBTcl_SetResult\fR procedure provides an easy interface for setting
@@ -124,23 +121,23 @@ anywhere within the \fIargv\fR values.
Call \fBTcl_SetResult\fR with status \fBTCL_VOLATILE\fR if you want
to return something from the \fIargv\fR array.
.PP
-\fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted.
-This can occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
+\fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted. This can
+occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
or by replacing \fIcmdName\fR in another call to \fBTcl_CreateCommand\fR.
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command. \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
+.PP
.CS
-typedef void Tcl_CmdDeleteProc(
+typedef void \fBTcl_CmdDeleteProc\fR(
ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateCommand\fR.
-.PP
-
.SH "SEE ALSO"
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
-
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo,
+Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
.SH KEYWORDS
bind, command, create, delete, interpreter, namespace
diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3
index 9f504e6..c1bc1fa 100644
--- a/doc/CrtFileHdlr.3
+++ b/doc/CrtFileHdlr.3
@@ -5,10 +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: CrtFileHdlr.3,v 1.5 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices (Unix only)
@@ -34,7 +32,6 @@ by \fIfile\fR meets the conditions specified by \fImask\fR.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be
@@ -51,11 +48,13 @@ as \fBvwait\fR.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_FileProc\fR:
+.PP
.CS
-typedef void Tcl_FileProc(
+typedef void \fBTcl_FileProc\fR(
ClientData \fIclientData\fR,
int \fImask\fR);
.CE
+.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy
of the \fIclientData\fR
argument given to \fBTcl_CreateFileHandler\fR when the callback
@@ -66,7 +65,6 @@ of the requested conditions actually exists for the file; it
will contain a subset of the bits in the \fImask\fR argument
to \fBTcl_CreateFileHandler\fR.
.PP
-.PP
There may exist only one handler for a given file at a given time.
If \fBTcl_CreateFileHandler\fR is called when a handler already
exists for \fIfd\fR, then the new callback replaces the information
@@ -81,12 +79,13 @@ events while waiting for files to become ready for I/O. For this to work
correctly, the application may need to use non-blocking I/O operations on
the files for which handlers are declared. Otherwise the application may
block if it reads or writes too much data; while waiting for the I/O to
-complete the application won't be able to service other events. Use
+complete the application will not be able to service other events. Use
\fBTcl_SetChannelOption\fR with \fB\-blocking\fR to set the channel into
blocking or nonblocking mode as required.
.PP
Note that these interfaces are only supported by the Unix
-implementation of the Tcl notifier.
-
+implementation of the Tcl notifier.
+.SH "SEE ALSO"
+fileevent(n), Tcl_CreateTimerHandler(3), Tcl_DoWhenIdle(3)
.SH KEYWORDS
callback, file, handler
diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3
index b0dfc50..679795e 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.7 2002/06/26 11:50:52 msofer Exp $
-'\"
-.so man.macros
.TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.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
@@ -23,30 +21,35 @@ Tcl_Interp *
.sp
int
\fBTcl_InterpDeleted\fR(\fIinterp\fR)
+.sp
+.VS 8.6
+int
+\fBTcl_InterpActive\fR(\fIinterp\fR)
+.VE 8.6
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
-Token for interpreter to be destroyed.
+Token for interpreter to be destroyed or queried.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateInterp\fR creates a new interpreter structure and returns
-a token for it. The token is required in calls to most other Tcl
+a token for it. The token is required in calls to most other Tcl
procedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
-\fBTcl_DeleteInterp\fR.
-Clients are only allowed to access a few of the fields of
-Tcl_Interp structures; see the \fBTcl_Interp\fR
-and \fBTcl_CreateCommand\fR man pages for details.
+\fBTcl_DeleteInterp\fR. The token returned by \fBTcl_CreateInterp\fR
+may only be passed to Tcl routines called from the same thread as
+the original \fBTcl_CreateInterp\fR call. It is not safe for multiple
+threads to pass the same token to Tcl's routines.
The new interpreter is initialized with the built-in Tcl commands
-and with the variables documented in tclvars(n). To bind in
-additional commands, call \fBTcl_CreateCommand\fR.
+and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To
+bind in additional commands, call \fBTcl_CreateCommand\fR, and to
+create additional variables, call \fBTcl_SetVar\fR.
.PP
\fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter
will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have
been matched by calls to \fBTcl_Release\fR. At that time, all of the
resources associated with it, including variables, procedures, and
-application-specific command bindings, will be deleted. After
+application-specific command bindings, will be deleted. After
\fBTcl_DeleteInterp\fR returns any attempt to use \fBTcl_Eval\fR on the
interpreter will fail and return \fBTCL_ERROR\fR. After the call to
\fBTcl_DeleteInterp\fR it is safe to examine the interpreter's result,
@@ -66,7 +69,15 @@ between when only the memory the callback is responsible for is being
deleted and when the whole interpreter is being deleted. In the former case
the callback may recreate the data being deleted, but this would lead to an
infinite loop if the interpreter were being deleted.
-
+.PP
+.VS 8.6
+\fBTcl_InterpActive\fR is useful for determining whether there is any
+execution of scripts ongoing in an interpreter, which is a useful piece of
+information when Tcl is embedded in a garbage-collected environment and it
+becomes necessary to determine whether the interpreter is a candidate for
+deletion. The function returns a true value if the interpreter has at least
+one active execution running inside it, and a false value otherwise.
+.VE 8.6
.SH "INTERPRETERS AND MEMORY MANAGEMENT"
.PP
\fBTcl_DeleteInterp\fR can be called at any time on an interpreter that may
@@ -86,14 +97,16 @@ the last call to \fBTcl_Preserve\fR is matched by a call to
The rules for when the user of an interpreter must call \fBTcl_Preserve\fR
and \fBTcl_Release\fR are simple:
.TP
-Interpreters Passed As Arguments
+\fBInterpreters Passed As Arguments\fR
+.
Functions that are passed an interpreter as an argument can safely use the
interpreter without any special protection. Thus, when you write an
extension consisting of new Tcl commands, no special code is needed to
protect interpreters received as arguments. This covers the majority of all
uses.
.TP
-Interpreter Creation And Deletion
+\fBInterpreter Creation And Deletion\fR
+.
When a new interpreter is created and used in a call to \fBTcl_Eval\fR,
\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or
\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and
@@ -104,13 +117,16 @@ it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other
code already called \fBTcl_DeleteInterp\fR; if not, call
\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code.
.TP
-Retrieving An Interpreter From A Data Structure
+\fBRetrieving An Interpreter From A Data Structure\fR
+.
When an interpreter is retrieved from a data structure (e.g. the client
-data of a callback) for use in \fBTcl_Eval\fR, \fBTcl_VarEval\fR,
-\fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of
+data of a callback) for use in one of the evaluation functions
+(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_EvalObjv\fR,
+etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR,
+\fBTcl_SetVar2Ex\fR, etc.), a pair of
calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around
all uses of the interpreter; it is unsafe to reuse the interpreter once
-\fBTcl_Release\fR has been called. If an interpreter is stored inside a
+\fBTcl_Release\fR has been called. If an interpreter is stored inside a
callback data structure, an appropriate deletion cleanup mechanism should
be set up by the code that creates the data structure so that the
interpreter is removed from the data structure (e.g. by setting the field
@@ -121,9 +137,14 @@ reused.
All uses of interpreters in Tcl and Tk have already been protected.
Extension writers should ensure that their code also properly protects any
additional interpreters used, as described above.
-
+.PP
+.VS 8.6
+Note that the protection mechanisms do not work well with conventional garbage
+collection systems. When in such a managed environment, \fBTcl_InterpActive\fR
+should be used to determine when an interpreter is a candidate for deletion
+due to inactivity.
+.VE 8.6
.SH "SEE ALSO"
Tcl_Preserve(3), Tcl_Release(3)
-
.SH KEYWORDS
command, create, delete, interpreter
diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3
index db5a27e..84cde650 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.13 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.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
@@ -59,7 +64,6 @@ created if the function is not implemented directly in bytecode.
Pattern to match against function names so as to filter them (by
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE
-
.SH DESCRIPTION
.PP
Tcl allows a number of mathematical functions to be used in
@@ -74,7 +78,7 @@ in the \fBtcl::mathfunc\fR namespace.
.PP
In the \fBTcl_CreateMathFunc\fR interface,
\fIName\fR is the name of the function as it will appear in expressions.
-If \fIname\fR doesn't already exist in the \fB::tcl::mathfunc\fR
+If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
namespace, then a new command is created in that namespace.
If \fIname\fR does exist, then the existing function is replaced.
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
@@ -87,8 +91,9 @@ or any, respectively.
Whenever the function is invoked in an expression Tcl will invoke
\fIproc\fR. \fIProc\fR should have arguments and result that match
the type \fBTcl_MathProc\fR:
+.PP
.CS
-typedef int Tcl_MathProc(
+typedef int \fBTcl_MathProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
Tcl_Value *\fIargs\fR,
@@ -99,13 +104,14 @@ When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
which describe the actual arguments to the function:
+.PP
.CS
typedef struct Tcl_Value {
- Tcl_ValueType \fItype\fR;
- long \fIintValue\fR;
- double \fIdoubleValue\fR;
- Tcl_WideInt \fIwideValue\fR;
-} Tcl_Value;
+ Tcl_ValueType \fItype\fR;
+ long \fIintValue\fR;
+ double \fIdoubleValue\fR;
+ Tcl_WideInt \fIwideValue\fR;
+} \fBTcl_Value\fR;
.CE
.PP
The \fItype\fR field indicates the type of the argument and is
@@ -147,14 +153,10 @@ 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. In the case of an error, NULL is returned and an error
-message is left in the interpreter result, and otherwise the returned
-object will have a reference count of zero.
-
-.SH KEYWORDS
-expression, mathematical function
-
+\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
+expression, mathematical function
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 490ca94..e94c8cd 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.13 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
@@ -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
@@ -90,34 +88,36 @@ the process of being deleted, then it does not create a new command
and it returns NULL.
\fIproc\fR should have arguments and result that match the type
\fBTcl_ObjCmdProc\fR:
+.PP
.CS
-typedef int Tcl_ObjCmdProc(
+typedef int \fBTcl_ObjCmdProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIobjc\fR,
Tcl_Obj *const \fIobjv\fR[]);
.CE
+.PP
When \fIproc\fR is invoked, the \fIclientData\fR and \fIinterp\fR parameters
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
of the \fIobjv\fR array by assigning new pointer values to any element of the
array (for example, \fIobjv\fR[\fB2\fR] = \fBNULL\fR) because this will
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
+\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
@@ -133,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
@@ -161,17 +161,19 @@ or by replacing \fIname\fR in another call to \fBTcl_CreateObjCommand\fR.
application an opportunity to release any structures associated
with the command. \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
+.PP
.CS
-typedef void Tcl_CmdDeleteProc(
+typedef void \fBTcl_CmdDeleteProc\fR(
ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
-If \fIcmdName\fR isn't bound as a command in \fIinterp\fR then
+If \fIcmdName\fR is not bound as a command in \fIinterp\fR then
\fBTcl_DeleteCommand\fR does nothing and returns -1; otherwise
it returns 0.
There are no restrictions on \fIcmdName\fR: it may refer to
@@ -199,6 +201,7 @@ Otherwise it places information about the command
in the \fBTcl_CmdInfo\fR structure
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
+.PP
.CS
typedef struct Tcl_CmdInfo {
int \fIisNativeObjectProc\fR;
@@ -209,8 +212,9 @@ typedef struct Tcl_CmdInfo {
Tcl_CmdDeleteProc *\fIdeleteProc\fR;
ClientData \fIdeleteData\fR;
Tcl_Namespace *\fInamespacePtr\fR;
-} Tcl_CmdInfo;
+} \fBTcl_CmdInfo\fR;
.CE
+.PP
The \fIisNativeObjectProc\fR field has the value 1
if \fBTcl_CreateObjCommand\fR was called to register the command;
it is 0 if only \fBTcl_CreateCommand\fR was called.
@@ -221,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
@@ -231,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
@@ -280,20 +284,19 @@ This name does not include any \fB::\fR namespace qualifiers.
The command corresponding to \fItoken\fR must not have been deleted.
The string returned by \fBTcl_GetCommandName\fR is in dynamic memory
owned by Tcl and is only guaranteed to retain its value as long as the
-command isn't deleted or renamed; callers should copy the string if
+command is not deleted or renamed; callers should copy the string if
they need to keep it for a long time.
.PP
\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\fP.
+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\fP.
+specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
.SH "SEE ALSO"
-Tcl_CreateCommand, Tcl_ResetResult, Tcl_SetObjResult
-
+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 1ee41b0..fdcef6f 100644
--- a/doc/CrtSlave.3
+++ b/doc/CrtSlave.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: CrtSlave.3,v 1.16 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
@@ -61,7 +59,9 @@ Interpreter in which to execute the specified command.
.AP "const char" *slaveName in
Name of slave interpreter to create or manipulate.
.AP int isSafe in
-If non-zero, a ``safe'' slave that is suitable for running untrusted code
+If non-zero, a
+.QW safe
+slave that is suitable for running untrusted code
is created, otherwise a trusted slave is created.
.AP Tcl_Interp *slaveInterp in
Interpreter to use for creating the source command for an alias (see
@@ -78,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
@@ -97,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
@@ -126,16 +126,21 @@ It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
-If it is \fB1\fR, the command creates a ``safe'' slave in which Tcl code
-has access only to set of Tcl commands defined as ``Safe Tcl''; see the
-manual entry for the Tcl \fBinterp\fR command for details.
+If it is \fB1\fR, the command creates a
+.QW safe
+slave in which Tcl code has access only to set of Tcl commands defined as
+.QW "Safe Tcl" ;
+see the manual entry for the Tcl \fBinterp\fR command for details.
If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
.PP
-\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is ``safe'' (was created
-with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
+\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
+.QW safe
+(was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
\fB0\fR otherwise.
.PP
-\fBTcl_MakeSafe\fR marks \fIinterp\fR as ``safe'', so that future
+\fBTcl_MakeSafe\fR marks \fIinterp\fR as
+.QW safe ,
+so that future
calls to \fBTcl_IsSafe\fR will return 1. It also removes all known
potentially-unsafe core functionality (both commands and variables)
from \fIinterp\fR. However, it cannot know what parts of an extension
@@ -160,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
@@ -174,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
@@ -197,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.
@@ -207,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 57a3a7f..f3957c7 100644
--- a/doc/CrtTimerHdlr.3
+++ b/doc/CrtTimerHdlr.3
@@ -5,10 +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: CrtTimerHdlr.3,v 1.3 2004/09/06 09:44:56 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler \- call a procedure at a given time
@@ -32,7 +30,6 @@ Arbitrary one-word value to pass to \fIproc\fR.
Token for previously created timer handler (the return value
from some previous call to \fBTcl_CreateTimerHandler\fR).
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_CreateTimerHandler\fR arranges for \fIproc\fR to be
@@ -44,16 +41,19 @@ dispatch events through \fBTcl_DoOneEvent\fR or through Tcl commands
such as \fBvwait\fR.
The call to \fIproc\fR may not be made at the exact time given by
\fImilliseconds\fR: it will be made at the next opportunity
-after that time. For example, if \fBTcl_DoOneEvent\fR isn't
+after that time. For example, if \fBTcl_DoOneEvent\fR is not
called until long after the time has elapsed, or if there
are other pending events to process before the call to
\fIproc\fR, then the call to \fIproc\fR will be delayed.
.PP
\fIProc\fR should have arguments and return value that match
the type \fBTcl_TimerProc\fR:
+.PP
.CS
-typedef void Tcl_TimerProc(ClientData \fIclientData\fR);
+typedef void \fBTcl_TimerProc\fR(
+ ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateTimerHandler\fR when the callback
@@ -70,6 +70,7 @@ has been invoked then \fBTcl_DeleteTimerHandler\fR does nothing.
The tokens returned by \fBTcl_CreateTimerHandler\fR never have
a value of NULL, so if NULL is passed to \fBTcl_DeleteTimerHandler\fR
then the procedure does nothing.
-
+.SH "SEE ALSO"
+after(n), Tcl_CreateFileHandler(3), Tcl_DoWhenIdle(3)
.SH KEYWORDS
callback, clock, handler, timer
diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3
index 63db967..239941f 100644
--- a/doc/CrtTrace.3
+++ b/doc/CrtTrace.3
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2002 by Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2002 by Kevin B. Kenny <kennykb@acm.org>. 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: CrtTrace.3,v 1.10 2004/10/07 15:37:43 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
@@ -38,10 +36,10 @@ A value of 0 means that commands at any level are traced.
.AP int flags in
Flags governing the trace execution. See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
-Procedure to call for each command that's executed. See below for
+Procedure to call for each command that is executed. See below for
details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
-Procedure to call for each command that's executed. See below for
+Procedure to call for each command that is executed. See below for
details on the calling sequence.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
@@ -65,6 +63,7 @@ interpreter.
.PP
\fIobjProc\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc\fR:
+.PP
.CS
typedef int \fBTcl_CmdObjTraceProc\fR(
\fBClientData\fR \fIclientData\fR,
@@ -73,8 +72,9 @@ typedef int \fBTcl_CmdObjTraceProc\fR(
const char *\fIcommand\fR,
\fBTcl_Command\fR \fIcommandToken\fR,
int \fIobjc\fR,
- \fBTcl_Obj\fR *const \fIobjv\fR[] );
+ \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE
+.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIClientData\fR typically points to an application-specific data
@@ -87,7 +87,7 @@ points to a string containing the text of the command, before any
argument substitution. The \fIcommandToken\fR parameter is a Tcl
command token that identifies the command to be invoked. The token
may be passed to \fBTcl_GetCommandName\fR,
-\fBTcl_GetCommandTokenInfo\fR, or \fBTcl_SetCommandTokenInfo\fR to
+\fBTcl_GetCommandInfoFromToken\fR, or \fBTcl_SetCommandInfoFromToken\fR to
manipulate the definition of the command. The \fIobjc\fR and \fIobjv\fR
parameters designate the final parameter count and parameter vector
that will be passed to the command, and have had all substitutions
@@ -141,10 +141,12 @@ When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
\fIdeleteProc\fR that was passed as a parameter to
\fBTcl_CreateObjTrace\fR. The \fIdeleteProc\fR must match the type,
\fBTcl_CmdObjTraceDeleteProc\fR:
+.PP
.CS
typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
\fBClientData\fR \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR parameter will be the same as the
\fIclientData\fR parameter that was originally passed to
\fBTcl_CreateObjTrace\fR.
@@ -155,8 +157,9 @@ compatibility with code that was developed for older versions of the
Tcl interpreter. It is similar to \fBTcl_CreateObjTrace\fR, except
that its \fIproc\fR parameter should have arguments and result that
match the type \fBTcl_CmdTraceProc\fR:
+.PP
.CS
-typedef void Tcl_CmdTraceProc(
+typedef void \fBTcl_CmdTraceProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIlevel\fR,
@@ -166,6 +169,7 @@ typedef void Tcl_CmdTraceProc(
int \fIargc\fR,
const char *\fIargv\fR[]);
.CE
+.PP
The parameters to the \fIproc\fR callback are similar to those of the
\fIobjProc\fR callback above. The \fIcommandToken\fR is
replaced with \fIcmdProc\fR, a pointer to the (string-based) command
diff --git a/doc/DString.3 b/doc/DString.3
index 8c44bb2..0e571d2 100644
--- a/doc/DString.3
+++ b/doc/DString.3
@@ -5,10 +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: DString.3,v 1.13 2005/05/10 18:33:54 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
@@ -87,14 +85,16 @@ the new string. The string can also be retrieved from the
\fIstring\fR field of the Tcl_DString structure.
.PP
\fBTcl_DStringAppendElement\fR is similar to \fBTcl_DStringAppend\fR
-except that it doesn't take a \fIlength\fR argument (it appends
+except that it does not take a \fIlength\fR argument (it appends
all of \fIelement\fR) and it converts the string to a proper list element
before appending.
\fBTcl_DStringAppendElement\fR adds a separator space before the
new list element unless the new list element is the first in a
list or sub-list (i.e. either the current string is empty, or it
-contains the single character ``{'', or the last two characters of
-the current string are `` {'').
+contains the single character
+.QW { ,
+or the last two characters of the current string are
+.QW " {" ).
\fBTcl_DStringAppendElement\fR returns a pointer to the
characters of the new string.
.PP
@@ -132,7 +132,7 @@ will still need to be called.
This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
be used instead.
.PP
-\fBTcl_DStringFree\fR should be called when you're finished using
+\fBTcl_DStringFree\fR should be called when you are finished using
the string. It frees up any memory that was allocated for the string
and reinitializes the string's value to an empty string.
.PP
diff --git a/doc/DetachPids.3 b/doc/DetachPids.3
index 91535a9..39a51d3 100644
--- a/doc/DetachPids.3
+++ b/doc/DetachPids.3
@@ -5,10 +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: DetachPids.3,v 1.4 2004/10/07 14:44:32 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in background
@@ -51,16 +49,16 @@ overflow, even if all the children have exited.
\fBTcl_DetachPids\fR may be called to ask Tcl to take responsibility
for one or more processes whose process ids are contained in the
\fIpidPtr\fR array passed as argument. The caller presumably
-has started these processes running in background and doesn't
+has started these processes running in background and does not
want to have to deal with them again.
.PP
\fBTcl_ReapDetachedProcs\fR invokes the \fBwaitpid\fR kernel call
on each of the background processes so that its state can be cleaned
-up if it has exited. If the process hasn't exited yet,
-\fBTcl_ReapDetachedProcs\fR doesn't wait for it to exit; it will check again
+up if it has exited. If the process has not exited yet,
+\fBTcl_ReapDetachedProcs\fR does not wait for it to exit; it will check again
the next time it is invoked.
Tcl automatically calls \fBTcl_ReapDetachedProcs\fR each time the
-\fBexec\fR command is executed, so in most cases it isn't necessary
+\fBexec\fR command is executed, so in most cases it is not necessary
for any code outside of Tcl to invoke \fBTcl_ReapDetachedProcs\fR.
However, if you call \fBTcl_DetachPids\fR in situations where the
\fBexec\fR command may never get executed, you may wish to call
diff --git a/doc/DictObj.3 b/doc/DictObj.3
index fb9206e..90ca9e3 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.8 2004/10/07 15:15:36 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.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,24 +88,29 @@ 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
-efficient mapping from keys to values and which does not guarantee any
-particular ordering of keys within the dictionary (the underlying
-basic data-structure is a hash table created with \fBTcl_InitObjHashTable\fR).
+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
+added (which adds them to the end of the order). If reinterpreted as a
+list, the values at the even-valued indices in the list will be the
+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
@@ -158,16 +161,20 @@ The order of iteration is implementation-defined. If the
\fBTcl_DictObjFirst\fR returns \fBTCL_ERROR\fR and the iteration is not
commenced, and otherwise it returns \fBTCL_OK\fR.
.PP
-If the last call to \fBTcl_DictObjFirst\fR or \fBTcl_DictObjNext\fR
-(for a particular \fIsearchPtr\fR) set the variable indicated by the
-\fIdonePtr\fR argument to zero but no further key/value pairs are
-desired from that particular iteration, the \fIsearchPtr\fR argument
-must be passed to \fBTcl_DictObjDone\fR to release any internal locks
-held by the searching process. If \fBTcl_DictObjNext\fR is called on
-a particular \fIsearchPtr\fR after \fBTcl_DictObjDone\fR is called on
-it, the variable pointed to by \fIdonePtr\fR will always be set to 1
-(and nothing else will happen). It is safe to call
-\fBTcl_DictObjDone\fR multiple times on the same \fIsearchPtr\fR.
+When \fBTcl_DictObjFirst\fR is called upon a dictionary, a lock is placed on
+the dictionary to enable that dictionary to be iterated over safely without
+regard for whether the dictionary is modified during the iteration. Because of
+this, once the iteration over a dictionary's keys has finished (whether
+because all values have been iterated over as indicated by the variable
+indicated by the \fIdonePtr\fR argument being set to one, or because no
+further values are required) the \fBTcl_DictObjDone\fR function must be called
+with the same \fIsearchPtr\fR as was passed to \fBTcl_DictObjFirst\fR so that
+the internal locks can be released. Once a particular \fIsearchPtr\fR is
+passed to \fBTcl_DictObjDone\fR, passing it to \fBTcl_DictObjNext\fR (without
+first initializing it with \fBTcl_DictObjFirst\fR) will result in no values
+being produced and the variable pointed to by \fIdonePtr\fR being set to one.
+It is safe to call \fBTcl_DictObjDone\fR multiple times on the same
+\fIsearchPtr\fR for each call to \fBTcl_DictObjFirst\fR.
.PP
The procedures \fBTcl_DictObjPutKeyList\fR and
\fBTcl_DictObjRemoveKeyList\fR are the close analogues of
@@ -186,7 +193,7 @@ keys must exist and have dictionaries as their values.
.SH EXAMPLE
Using the dictionary iteration interface to search determine if there
is a key that maps to itself:
-
+.PP
.CS
Tcl_DictSearch search;
Tcl_Obj *key, *value;
@@ -203,26 +210,25 @@ int done;
* is performed. However it is safe to try to release the lock
* even if we've finished iterating over the loop.
*/
-if (Tcl_DictObjFirst(interp, objPtr, &search,
+if (\fBTcl_DictObjFirst\fR(interp, objPtr, &search,
&key, &value, &done) != TCL_OK) {
return TCL_ERROR;
}
-for (; done ; Tcl_DictObjNext(&search, &key, &value, &done)) {
+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))) {
break;
}
}
-Tcl_DictObjDone(&search);
+\fBTcl_DictObjDone\fR(&search);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!done));
return TCL_OK;
.CE
-
.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 dc3d6e6..6f08b34 100644
--- a/doc/DoOneEvent.3
+++ b/doc/DoOneEvent.3
@@ -5,10 +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: DoOneEvent.3,v 1.3 2004/09/18 17:01:05 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_DoOneEvent \- wait for events and invoke event handlers
@@ -73,7 +71,7 @@ Process all kinds of events: equivalent to OR-ing together all of the
above flags or specifying none of them.
.TP 27
\fBTCL_DONT_WAIT\fR \-
-Don't sleep: process only events that are ready at the time of the
+Do not sleep: process only events that are ready at the time of the
call.
.LP
If any of the flags \fBTCL_WINDOW_EVENTS\fR, \fBTCL_FILE_EVENTS\fR,
diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3
index 90a6aa7..3e28b4d 100644
--- a/doc/DoWhenIdle.3
+++ b/doc/DoWhenIdle.3
@@ -5,10 +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: DoWhenIdle.3,v 1.2 1998/09/14 18:39:48 stanton Exp $
-'\"
-.so man.macros
.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events
@@ -26,13 +24,12 @@ Procedure to invoke.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
when the application becomes idle. The application is
considered to be idle when \fBTcl_DoOneEvent\fR has been
-called, couldn't find any events to handle, and is about
+called, could not find any events to handle, and is about
to go to sleep waiting for an event to occur. At this
point all pending \fBTcl_DoWhenIdle\fR handlers are
invoked. For each call to \fBTcl_DoWhenIdle\fR there will
@@ -43,9 +40,12 @@ use \fBTcl_DoOneEvent\fR to dispatch events.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_IdleProc\fR:
+.PP
.CS
-typedef void Tcl_IdleProc(ClientData \fIclientData\fR);
+typedef void \fBTcl_IdleProc\fR(
+ ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
argument given to \fBTcl_DoWhenIdle\fR. Typically, \fIclientData\fR
points to a data structure containing application-specific information about
@@ -61,7 +61,7 @@ all of the handlers are removed. If no existing handlers match
\fIproc\fR and \fIclientData\fR then nothing happens.
.PP
\fBTcl_DoWhenIdle\fR is most useful in situations where
-(a) a piece of work will have to be done but (b) it's
+(a) a piece of work will have to be done but (b) it is
possible that something will happen in the near future
that will change what has to be done or require something
different to be done. \fBTcl_DoWhenIdle\fR allows the
@@ -81,6 +81,7 @@ continuously. This will interact badly with certain features of Tk
that attempt to wait for all idle callbacks to complete. If you would
like for an idle callback to reschedule itself continuously, it is
better to use a timer handler with a zero timeout period.
-
+.SH "SEE ALSO"
+after(n), Tcl_CreateFileHandler(3), Tcl_CreateTimerHandler(3)
.SH KEYWORDS
callback, defer, idle callback
diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3
index 4af284d..4b422d4 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.3 2004/09/06 09:44:56 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.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,55 +23,42 @@ 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 double 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 to be converted
-to double type.
-For \fBTcl_GetDoubleFromObj\fR, this refers to the object
-from which to get a double value;
-if \fIobjPtr\fR does not already point to a double object,
-an attempt will be made to convert it to one.
+For \fBTcl_SetDoubleObj\fR, this points to the value in which to store a
+double value.
+For \fBTcl_GetDoubleFromObj\fR, this refers to the value
+from which to retrieve a double value.
.AP Tcl_Interp *interp in/out
-If an error occurs during conversion,
-an error message is left in the interpreter's result object
-unless \fIinterp\fR is NULL.
+When non-NULL, an error message is left here when double value retrieval fails.
.AP double *doublePtr out
-Points to place to store the double value
-obtained from \fIobjPtr\fR.
+Points to place to store the double value obtained from \fIobjPtr\fR.
.BE
.SH DESCRIPTION
.PP
-These procedures are used to create, modify, and read
-double Tcl objects from C code.
-\fBTcl_NewDoubleObj\fR and \fBTcl_SetDoubleObj\fR
-will create a new object of double type
-or modify an existing object to have double type.
-Both of these procedures set the object to have the
-double-precision floating-point value given by \fIdoubleValue\fR;
-\fBTcl_NewDoubleObj\fR returns a pointer to a newly created object
-with reference count zero.
-Both procedures set the object's type to be double
-and assign the double value to the object's internal representation
-\fIdoubleValue\fR member.
-\fBTcl_SetDoubleObj\fR invalidates any old string representation
-and, if the object is not already a double object,
-frees any old internal representation.
+These procedures are used to create, modify, and read Tcl values that
+hold double-precision floating-point values.
.PP
-\fBTcl_GetDoubleFromObj\fR attempts to return a double value
-from the Tcl object \fIobjPtr\fR.
-If the object is not already a double object,
-it will attempt to convert it to one.
-If an error occurs during conversion, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
-unless \fIinterp\fR is NULL.
-Otherwise, it returns \fBTCL_OK\fR and stores the double value
-in the address given by \fIdoublePtr\fR.
-If the object is not already a double object,
-the conversion will free any old internal representation.
-
+\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 value pointed to
+by \fIobjPtr\fR to the double value \fIdoubleValue\fR. The \fIobjPtr\fR
+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 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.
+The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent
+calls to \fBTcl_GetDoubleFromObj\fR more efficient.
+'\" TODO: add discussion of treatment of NaN value
.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..f4d78d1 100644
--- a/doc/DumpActiveMemory.3
+++ b/doc/DumpActiveMemory.3
@@ -3,10 +3,8 @@
'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface
diff --git a/doc/Encoding.3 b/doc/Encoding.3
index c365aaf..1478c35 100644
--- a/doc/Encoding.3
+++ b/doc/Encoding.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: Encoding.3,v 1.20 2004/10/07 15:15:37 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
+Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,6 +19,9 @@ Tcl_Encoding
void
\fBTcl_FreeEncoding\fR(\fIencoding\fR)
.sp
+int
+\fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR)
+.sp
char *
\fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
@@ -47,20 +48,28 @@ const char *
int
\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
.sp
+const char *
+\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
+.sp
void
\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
.sp
Tcl_Encoding
\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
.sp
+Tcl_Obj *
+\fBTcl_GetEncodingSearchPath\fR()
+.sp
+int
+\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
+.sp
const char *
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
.sp
void
\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
-
.SH ARGUMENTS
-.AS Tcl_EncodingState *dstWrotePtr in/out
+.AS "const Tcl_EncodingType" *dstWrotePtr in/out
.AP Tcl_Interp *interp in
Interpreter to use for error reporting, or NULL if no error reporting is
desired.
@@ -69,6 +78,10 @@ Name of encoding to load.
.AP Tcl_Encoding encoding in
The encoding to query, free, or use for converting text. If \fIencoding\fR is
NULL, the current system encoding is used.
+.AP Tcl_Obj *objPtr in
+Name of encoding to get token for.
+.AP Tcl_Encoding *encodingPtr out
+Points to storage where encoding token is to be written.
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8. For the
@@ -93,7 +106,7 @@ block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state.
\fBTCL_ENCODING_STOPONERROR\fR signifies that the conversion routine should
-return immediately upon reading a source character that doesn't exist in
+return immediately upon reading a source character that does not exist in
the target encoding; otherwise a default fallback character will
automatically be substituted.
.AP Tcl_EncodingState *statePtr in/out
@@ -121,8 +134,12 @@ buffer as a result of the conversion. May be NULL.
.AP int *dstCharsPtr out
Filled with the number of characters that correspond to the number of bytes
stored in the output buffer. May be NULL.
-.AP Tcl_EncodingType *typePtr in
+.AP Tcl_DString *bufPtr out
+Storage for the prescribed system encoding name.
+.AP "const Tcl_EncodingType" *typePtr in
Structure that defines a new type of encoding.
+.AP Tcl_Obj *searchPath in
+List of filesystem directories in which to search for encoding data files.
.AP "const char" *path in
A path to the location of the encoding file.
.BE
@@ -171,6 +188,18 @@ anywhere (i.e., it has been freed as many times as it has been gotten)
\fBTcl_FreeEncoding\fR will release all storage the encoding was using
and delete it from the database.
.PP
+\fBTcl_GetEncodingFromObj\fR treats the string representation of
+\fIobjPtr\fR as an encoding name, and finds an encoding with that
+name, just as \fBTcl_GetEncoding\fR does. When an encoding is found,
+it is cached within the \fBobjPtr\fR value for future reference, the
+\fBTcl_Encoding\fR token is written to the storage pointed to by
+\fIencodingPtr\fR, and the value \fBTCL_OK\fR is returned. If no such
+encoding is found, the value \fBTCL_ERROR\fR is returned, and no
+writing to \fB*\fR\fIencodingPtr\fR takes place. Just as with
+\fBTcl_GetEncoding\fR, the caller should call \fBTcl_FreeEncoding\fR
+on the resulting encoding token when that token will no longer be
+used.
+.PP
\fBTcl_ExternalToUtfDString\fR converts a source buffer \fIsrc\fR from the
specified \fIencoding\fR into UTF-8. The converted bytes are stored in
\fIdstPtr\fR, which is then null-terminated. The caller should eventually
@@ -230,20 +259,28 @@ is filled with the corresponding number of bytes that were stored in
Windows-only convenience
functions for converting between UTF-8 and Windows strings. On Windows 95
(as with the Unix operating system),
-all strings exchanged between Tcl and the operating system are "char"
+all strings exchanged between Tcl and the operating system are
+.QW "char"
based. On Windows NT, some strings exchanged between Tcl and the
-operating system are "char" oriented while others are in Unicode. By
+operating system are
+.QW "char"
+oriented while others are in Unicode. By
convention, in Windows a TCHAR is a character in the ANSI code page
on Windows 95 and a Unicode character on Windows NT.
.PP
-If you planned to use the same "char" based interfaces on both Windows
+If you planned to use the same
+.QW "char"
+based interfaces on both Windows
95 and Windows NT, you could use \fBTcl_UtfToExternal\fR and
\fBTcl_ExternalToUtf\fR (or their \fBTcl_DString\fR equivalents) with an
encoding of NULL (the current system encoding). On the other hand,
if you planned to use the Unicode interface when running on Windows NT
-and the "char" interfaces when running on Windows 95, you would have
+and the
+.QW "char"
+interfaces when running on Windows 95, you would have
to perform the following type of test over and over in your program
(as represented in pseudo-code):
+.PP
.CS
if (running NT) {
encoding <- Tcl_GetEncoding("unicode");
@@ -253,6 +290,7 @@ if (running NT) {
nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer);
}
.CE
+.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR automatically
handle this test and use the proper encoding based on the current
operating system. \fBTcl_WinUtfToTChar\fR returns a pointer to
@@ -277,6 +315,13 @@ procedure increments the reference count of the new system encoding,
decrements the reference count of the old system encoding, and returns
\fBTCL_OK\fR.
.PP
+\fBTcl_GetEncodingNameFromEnvironment\fR provides a means for the Tcl
+library to report the encoding name it believes to be the correct one
+to use as the system encoding, based on system calls and examination of
+the environment suitable for the platform. It accepts \fIbufPtr\fR,
+a pointer to an uninitialized or freed \fBTcl_DString\fR and writes
+the encoding name to it. The \fBTcl_DStringValue\fR is returned.
+.PP
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
consisting of the names of all the encodings that are currently defined
or can be dynamically loaded, searching the encoding path specified by
@@ -303,13 +348,13 @@ convert between this encoding and UTF-8. It is defined as follows:
.PP
.CS
typedef struct Tcl_EncodingType {
- const char *\fIencodingName\fR;
- Tcl_EncodingConvertProc *\fItoUtfProc\fR;
- Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
- Tcl_EncodingFreeProc *\fIfreeProc\fR;
- ClientData \fIclientData\fR;
- int \fInullSize\fR;
-} Tcl_EncodingType;
+ const char *\fIencodingName\fR;
+ Tcl_EncodingConvertProc *\fItoUtfProc\fR;
+ Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
+ Tcl_EncodingFreeProc *\fIfreeProc\fR;
+ ClientData \fIclientData\fR;
+ int \fInullSize\fR;
+} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
@@ -337,7 +382,7 @@ The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the
type \fBTcl_EncodingConvertProc\fR:
.PP
.CS
-typedef int Tcl_EncodingConvertProc(
+typedef int \fBTcl_EncodingConvertProc\fR(
ClientData \fIclientData\fR,
const char *\fIsrc\fR,
int \fIsrcLen\fR,
@@ -367,8 +412,9 @@ procedure will be a non-NULL location.
.PP
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
\fBTcl_EncodingFreeProc\fR:
+.PP
.CS
-typedef void Tcl_EncodingFreeProc(
+typedef void \fBTcl_EncodingFreeProc\fR(
ClientData \fIclientData\fR);
.CE
.PP
@@ -376,13 +422,33 @@ This \fIfreeProc\fR function is called when the encoding is deleted. The
\fIclientData\fR parameter is the same as the \fIclientData\fR field
specified to \fBTcl_CreateEncoding\fR when the encoding was created.
.PP
-
+\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR
+are called to access and set the list of filesystem directories searched
+for encoding data files.
+.PP
+The value returned by \fBTcl_GetEncodingSearchPath\fR
+is the value stored by the last successful call to
+\fBTcl_SetEncodingSearchPath\fR. If no calls to
+\fBTcl_SetEncodingSearchPath\fR have occurred, Tcl will compute an initial
+value based on the environment. There is one encoding search path for the
+entire process, shared by all threads in the process.
+.PP
+\fBTcl_SetEncodingSearchPath\fR stores \fIsearchPath\fR and returns
+\fBTCL_OK\fR, unless \fIsearchPath\fR is not a valid Tcl list, which
+causes \fBTCL_ERROR\fR to be returned. The elements of \fIsearchPath\fR
+are not verified as existing readable filesystem directories. When
+searching for encoding data files takes place, and non-existent or
+non-readable filesystem directories on the \fIsearchPath\fR are silently
+ignored.
+.PP
\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
-access and set the directory to use when locating the default encoding
-files. If this value is not NULL, the \fBTclpInitLibraryPath\fR routine
-appends the path to the head of the search path, and uses this path as
-the first place to look into when trying to locate the encoding file.
-
+are obsolete interfaces best replaced with calls to
+\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR.
+They are called to access and set the first element of the \fIsearchPath\fR
+list. Since Tcl searches \fIsearchPath\fR for encoding data files in
+list order, these routines establish the
+.QW default
+directory in which to find encoding data files.
.SH "ENCODING FILES"
Space would prohibit precompiling into Tcl every possible encoding
algorithm, so many encodings are stored on disk as dynamically-loadable
@@ -394,7 +460,9 @@ external encoding may consist of single-byte, multi-byte, or double-byte
characters.
.PP
Each dynamically-loadable encoding is represented as a text file. The
-initial line of the file, beginning with a ``#'' symbol, is a comment
+initial line of the file, beginning with a
+.QW #
+symbol, is a comment
that provides a human-readable description of the file. The next line
identifies the type of encoding file. It can be one of the following
letters:
@@ -421,6 +489,7 @@ Cases [1], [2], and [3] are collectively referred to as table-based encoding
files. The lines in a table-based encoding file are in the same
format as this example taken from the \fBshiftjis\fR encoding (this is not
the complete file):
+.PP
.CS
# Encoding file: shiftjis, multi-byte
M
@@ -480,25 +549,26 @@ and 0x8163 in \fBshiftjis\fR map to 203E and 2026 in Unicode, respectively.
Following the first page will be all the other pages, each in the same
format as the first: one number identifying the page followed by 256
double-byte Unicode characters. If a character in the encoding maps to the
-Unicode character 0000, it means that the character doesn't actually exist.
+Unicode character 0000, it means that the character does not actually exist.
If all characters on a page would map to 0000, that page can be omitted.
.PP
Case [4] is the escape-sequence encoding file. The lines in an this type of
file are in the same format as this example taken from the \fBiso2022-jp\fR
encoding:
+.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init {}
final {}
-iso8859-1 \\x1b(B
-jis0201 \\x1b(J
-jis0208 \\x1b$@
-jis0208 \\x1b$B
-jis0212 \\x1b$(D
-gb2312 \\x1b$A
-ksc5601 \\x1b$(C
+iso8859-1 \ex1b(B
+jis0201 \ex1b(J
+jis0208 \ex1b$@
+jis0208 \ex1b$B
+jis0212 \ex1b$(D
+gb2312 \ex1b$A
+ksc5601 \ex1b$(C
.CE
.PP
In the file, the first column represents an option and the second column
@@ -507,8 +577,11 @@ the first character is converted, while \fBfinal\fR is a string to emit
or expect after the last character. All other options are names of
table-based encodings; the associated value is the escape-sequence that
marks that encoding. Tcl syntax is used for the values; in the above
-example, for instance, ``\fB{}\fR'' represents the empty string and
-``\fB\\x1b\fR'' represents character 27.
+example, for instance,
+.QW \fB{}\fR
+represents the empty string and
+.QW \fB\ex1b\fR
+represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
@@ -517,6 +590,3 @@ for its script library. If the encoding file exists, but is
malformed, an error message will be left in \fIinterp\fR.
.SH KEYWORDS
utf, encoding, convert
-
-
-
diff --git a/doc/Ensemble.3 b/doc/Ensemble.3
index b98c36c..8457ddc 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.2 2005/05/10 18:33:55 kennykb Exp $
-'\"
'\" This documents the C API introduced in TIP#235
'\"
-.so man.macros
.TH Tcl_Ensemble 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsmelbeSubcommandList, 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
@@ -38,6 +36,14 @@ int
int
\fBTcl_SetEnsembleMappingDict\fR(\fIinterp, token, dictObj\fR)
.sp
+.VS 8.6
+int
+\fBTcl_GetEnsembleParameterList\fR(\fIinterp, token, listObjPtr\fR)
+.sp
+int
+\fBTcl_SetEnsembleParameterList\fR(\fIinterp, token, listObj\fR)
+.VE 8.6
+.sp
int
\fBTcl_GetEnsembleSubcommandList\fR(\fIinterp, token, listObjPtr\fR)
.sp
@@ -56,7 +62,9 @@ int
.AS Tcl_Namespace **namespacePtrPtr in/out
.AP Tcl_Interp *interp in/out
The interpreter in which the ensemble is to be created or found. Also
-where error result messages are written.
+where error result messages are written. The functions whose names
+start with \fBTcl_GetEnsemble\fR may have a NULL for the \fIinterp\fR,
+but all other functions must not.
.AP "const char" *name in
The name of the ensemble command to be created.
.AP Tcl_Namespace *namespacePtr in
@@ -64,20 +72,20 @@ The namespace to which the ensemble command is to be bound, or NULL
for the current namespace.
.AP int ensFlags in
An ORed set of flag bits describing the basic configuration of the
-ensemble. Currently only one bit has meaning, TCL_ENSEMBLE_PREFIX,
+ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR,
which is present when the ensemble command should also match
unambiguous prefixes of subcommands.
.AP Tcl_Obj *cmdNameObj in
A value holding the name of the ensemble command to look up.
.AP int flags in
An ORed set of flag bits controlling the behavior of
-\fBTcl_FindEnsemble\fR. Currently only TCL_LEAVE_ERR_MSG is supported.
+\fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported.
.AP Tcl_Command token in
A normal command token that refers to an ensemble command, or which
you wish to use for testing as an ensemble command in \fBTcl_IsEnsemble\fR.
.AP int *ensFlagsPtr out
Pointer to a variable into which to write the current ensemble flag
-bits; currently only the bit TCL_ENSEMBLE_PREFIX is defined.
+bits; currently only the bit \fBTCL_ENSEMBLE_PREFIX\fR is defined.
.AP Tcl_Obj *dictObj in
A dictionary value to use for the subcommand to implementation command
prefix mapping dictionary in the ensemble. May be NULL if the mapping
@@ -86,17 +94,18 @@ dictionary is to be removed.
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 defined list of subcommands in the
-dictionary or the unknown subcommmand handler command prefix. May be
-NULL if the subcommand list or unknown handler are to be removed.
+A list value to use for the list of formal pre-subcommand parameters, the
+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
-Pointer to a variable into which to write the current defiend list of
-subcommands or the current unknown handler prefix.
+Pointer to a variable into which to write the current list of formal
+pre-subcommand parameters, the defined list of subcommands or the current
+unknown handler prefix.
.AP Tcl_Namespace **namespacePtrPtr out
Pointer to a variable into which to write the handle of the namespace
to which the ensemble is bound.
.BE
-
.SH DESCRIPTION
An ensemble is a command, bound to some namespace, which consists of a
collection of subcommands implemented by other Tcl commands. The first
@@ -108,13 +117,13 @@ arguments: the interpreter to work within, the name of the ensemble to
create, the namespace within the interpreter to bind the ensemble to,
and the default set of ensemble flags. The result of the function is
the command token for the ensemble, which may be used to further
-configure the ensemble using the API descibed below in \fBENSEMBLE
-PROPERTIES\fR.
+configure the ensemble using the API described below in
+\fBENSEMBLE PROPERTIES\fR.
.PP
Given the name of an ensemble command, the token for that command may
be retrieved using \fBTcl_FindEnsemble\fR. If the given command name
(in \fIcmdNameObj\fR) does not refer to an ensemble command, the
-result of the function is NULL and (if the TCL_LEAVE_ERR_MSG bit is
+result of the function is NULL and (if the \fBTCL_LEAVE_ERR_MSG\fR bit is
set in \fIflags\fR) an error message is left in the interpreter
result.
.PP
@@ -126,16 +135,18 @@ Every ensemble has four read-write properties and a read-only
property. The properties are:
.TP
\fBflags\fR (read-write)
+.
The set of flags for the ensemble, expressed as a
-bit-field. Currently, the only public flag is TCL_ENSEMBLE_PREFIX
+bit-field. Currently, the only public flag is \fBTCL_ENSEMBLE_PREFIX\fR
which is set when unambiguous prefixes of subcommands are permitted to
be resolved to implementations as well as exact matches. The flags may
be read and written using \fBTcl_GetEnsembleFlags\fR and
\fBTcl_SetEnsembleFlags\fR respectively. The result of both of those
-functions is a Tcl result code (TCL_OK, or TCL_ERROR if the token does
-not refer to an ensemble).
+functions is a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if
+the token does not refer to an ensemble).
.TP
\fBmapping dictionary\fR (read-write)
+.
A dictionary containing a mapping from subcommand names to lists of
words to use as a command prefix (replacing the first two words of the
command which are the ensemble command itself and the subcommand
@@ -144,24 +155,43 @@ the same unqualified name in the ensemble's bound namespace. Defaults
to NULL. May be read and written using
\fBTcl_GetEnsembleMappingDict\fR and \fBTcl_SetEnsembleMappingDict\fR
respectively. The result of both of those functions is a Tcl result
-code (TCL_OK, or TCL_ERROR if the token does not refer to an
+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
+A list of formal parameter names (the names only being used when generating
+error messages) that come at invocation of the ensemble between the name of
+the ensemble and the subcommand argument. NULL (the default) is equivalent to
+the empty list. May be read and written using
+\fBTcl_GetEnsembleParameterList\fR and \fBTcl_SetEnsembleParameterList\fR
+respectively. The result of both of those functions is a Tcl result code
+(\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an
+ensemble) and the
+dictionary obtained from \fBTcl_GetEnsembleParameterList\fR should always be
+treated as immutable even if it is unshared.
+.VE 8.6
.TP
\fBsubcommand list\fR (read-write)
+.
A list of all the subcommand names for the ensemble, or NULL if this
is to be derived from either the keys of the mapping dictionary (see
above) or (if that is also NULL) from the set of commands exported by
the bound namespace. May be read and written using
\fBTcl_GetEnsembleSubcommandList\fR and
\fBTcl_SetEnsembleSubcommandList\fR respectively. The result of both
-of those functions is a Tcl result code (TCL_OK, or TCL_ERROR if the
+of those functions is a Tcl result code (\fBTCL_OK\fR, or
+\fBTCL_ERROR\fR if the
token does not refer to an ensemble) and the list obtained from
-\fBTcl_GetEnsembleSubcommandList\fR should alays be treated as
+\fBTcl_GetEnsembleSubcommandList\fR should always be treated as
immutable even if it is unshared.
.TP
\fBunknown subcommand handler command prefix\fR (read-write)
+.
A list of words to prepend on the front of any subcommand when the
subcommand is unknown to the ensemble (according to the current prefix
handling rule); see the \fBnamespace ensemble\fR command for more
@@ -169,18 +199,21 @@ details. If NULL, the default behavior \- generate a suitable error
message \- will be used when an unknown subcommand is encountered. May
be read and written using \fBTcl_GetEnsembleUnknownHandler\fR and
\fBTcl_SetEnsembleUnknownHandler\fR respectively. The result of both
-functions is a Tcl result code (TCL_OK, or TCL_ERROR if the token does
+functions is a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if
+the token does
not refer to an ensemble) and the list obtained from
\fBTcl_GetEnsembleUnknownHandler\fR should always be treated as
immutable even if it is unshared.
.TP
\fBbound namespace\fR (read-only)
+.
The namespace to which the ensemble is bound; when the namespace is
deleted, so too will the ensemble, and this namespace is also the
namespace whose list of exported commands is used if both the mapping
dictionary and the subcommand list properties are NULL. May be read
using \fBTcl_GetEnsembleNamespace\fR which returns a Tcl result code
-(TCL_OK, or TCL_ERROR if the token does not refer to an ensemble).
-
+(\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble).
.SH "SEE ALSO"
namespace(n), Tcl_DeleteCommandFromToken(3)
+.SH KEYWORDS
+command, ensemble
diff --git a/doc/Environment.3 b/doc/Environment.3
index 16efd84..85880b4 100644
--- a/doc/Environment.3
+++ b/doc/Environment.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Environment.3,v 1.6 2005/05/10 18:33:55 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_PutEnv \- procedures to manipulate the environment
@@ -19,19 +17,22 @@ int
\fBTcl_PutEnv\fR(\fIassignment\fR)
.SH ARGUMENTS
.AS "const char" *assignment
-.AP "const char" *assignnment in
-Info about environment variable in the format NAME=value.
+.AP "const char" *assignment in
+Info about environment variable in the format
+.QW \fINAME\fB=\fIvalue\fR .
The \fIassignment\fR argument is in the system encoding.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_PutEnv\fR sets an environment variable. The information is
-passed in a single string of the form NAME=value. This procedure is
+passed in a single string of the form
+.QW \fINAME\fB=\fIvalue\fR .
+This procedure is
intended to be a stand-in for the UNIX \fBputenv\fR system call. All
Tcl-based applications using \fBputenv\fR should redefine it to
\fBTcl_PutEnv\fR so that they will interface properly to the Tcl
runtime.
-
+.SH "SEE ALSO"
+env(n)
.SH KEYWORDS
environment, variable
diff --git a/doc/Eval.3 b/doc/Eval.3
index d626964..c104f7a 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -6,10 +6,8 @@
'\" 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.22 2005/09/13 21:23:51 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
@@ -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
@@ -98,21 +96,30 @@ result; it can be retrieved using \fBTcl_GetObjResult\fR.
\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
its contents as a Tcl script. It returns the same information as
\fBTcl_EvalObjEx\fR.
-If the file couldn't be read then a Tcl error is returned to describe
-why the file couldn't be read.
-The eofchar for files is '\\32' (^Z) for all platforms.
-If you require a ``^Z'' in code for string comparison, you can use
-``\\032'' or ``\\u001a'', which will be safely substituted by the Tcl
-interpreter into ``^Z''.
+If the file could not be read then a Tcl error is returned to describe
+why the file could not be read.
+The eofchar for files is
+.QW \e32
+(^Z) for all platforms. If you require a
+.QW ^Z
+in code for string comparison, you can use
+.QW \e032
+or
+.QW \eu001a ,
+which will be safely substituted by the Tcl interpreter into
+.QW ^Z .
.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 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
@@ -122,10 +129,10 @@ 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
-doesn't do the copy.
+does not do the copy.
.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
additional arguments \fInumBytes\fR and \fIflags\fR. For the
@@ -152,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
-bytecodes won't be reused in a future execution. In this case,
-it's faster to execute the script directly.
+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
@@ -198,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 a821ad1..3ea09bf 100644
--- a/doc/Exit.3
+++ b/doc/Exit.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Exit.3,v 1.6 2003/09/29 21:47:38 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Exit 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitThread, Tcl_FinalizeThread, Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler, Tcl_SetExitProc \- end the application or thread (and invoke exit handlers)
@@ -31,10 +29,8 @@ Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitTh
.sp
\fBTcl_DeleteThreadExitHandler\fR(\fIproc, clientData\fR)
.sp
-.VS 8.5
Tcl_ExitProc *
\fBTcl_SetExitProc\fR(\fIproc\fR)
-.VE 8.5
.SH ARGUMENTS
.AS Tcl_ExitProc clientData
.AP int status in
@@ -66,24 +62,18 @@ otherwise causes the application to terminate without calling
\fBTcl_Exit\fR, the exit handlers will not be run.
\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
returns control to its caller.
-.VS 8.5
If an application exit handler has been installed (see
\fBTcl_SetExitProc\fR), that handler is invoked with an argument
consisting of the exit status (cast to ClientData); the application
exit handler should not return control to Tcl.
-.VE 8.5
.PP
\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
exit from the current process.
It is useful for cleaning up when a process is finished using \fBTcl\fR but
wishes to continue executing, and when \fBTcl\fR is used in a dynamically
loaded extension that is about to be unloaded.
-On some systems \fBTcl\fR is automatically notified when it is being
-unloaded, and it calls \fBTcl_Finalize\fR internally; on these systems it
-not necessary for the caller to explicitly call \fBTcl_Finalize\fR.
-However, to ensure portability, your code should always invoke
-\fBTcl_Finalize\fR when \fBTcl\fR is being unloaded, to ensure that the
-code will work on all platforms. \fBTcl_Finalize\fR can be safely called
+Your code should always invoke \fBTcl_Finalize\fR when \fBTcl\fR is being
+unloaded, to ensure proper cleanup. \fBTcl_Finalize\fR can be safely called
more than once.
.PP
\fBTcl_ExitThread\fR is used to terminate the current thread and invoke
@@ -100,9 +90,12 @@ by \fBTcl_FinalizeThread\fR and \fBTcl_ExitThread\fR.
This provides a hook for cleanup operations such as flushing buffers
and freeing global memory.
\fIProc\fR should match the type \fBTcl_ExitProc\fR:
+.PP
.CS
-typedef void Tcl_ExitProc(ClientData \fIclientData\fR);
+typedef void \fBTcl_ExitProc\fR(
+ ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when
@@ -118,7 +111,6 @@ indicated by \fIproc\fR and \fIclientData\fR so that no call
to \fIproc\fR will be made. If no such handler exists then
\fBTcl_DeleteExitHandler\fR or \fBTcl_DeleteThreadExitHandler\fR does nothing.
.PP
-.PP
\fBTcl_Finalize\fR and \fBTcl_Exit\fR execute all registered exit handlers,
in reverse order from the order in which they were registered.
This matches the natural order in which extensions are loaded and unloaded;
@@ -134,7 +126,6 @@ the process-wide exit handlers. This is because thread finalization shuts
down the I/O channel system, so any attempt at I/O by the global exit
handlers will vanish into the bitbucket.
.PP
-.VS 8.5
\fBTcl_SetExitProc\fR installs an application exit handler, returning
the previously-installed application exit handler or NULL if no
application handler was installed. If an application exit handler is
@@ -143,7 +134,7 @@ finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an
appropriate time. The argument passed to \fIproc\fR when it is
invoked will be the exit status code (as passed to \fBTcl_Exit\fR)
cast to a ClientData value.
-.VE 8.5
-
+.SH "SEE ALSO"
+exit(n)
.SH KEYWORDS
-callback, cleanup, dynamic loading, end application, exit, unloading, thread
+abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread
diff --git a/doc/ExprLong.3 b/doc/ExprLong.3
index 0600330..1615f88 100644
--- a/doc/ExprLong.3
+++ b/doc/ExprLong.3
@@ -5,10 +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: ExprLong.3,v 1.11 2005/05/10 18:33:55 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression
@@ -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
@@ -92,7 +90,11 @@ number, then they store 0 at \fI*booleanPtr\fR if
the value was zero and 1 otherwise.
If the expression's actual value is a non-numeric string then
it must be one of the values accepted by \fBTcl_GetBoolean\fR
-such as ``yes'' or ``no'', or else an error occurs.
+such as
+.QW yes
+or
+.QW no ,
+or else an error occurs.
.PP
\fBTcl_ExprString\fR returns the value of the expression as a
string stored in the interpreter's result.
@@ -101,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 82aabe7..35edb5f 100644
--- a/doc/ExprLongObj.3
+++ b/doc/ExprLongObj.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: ExprLongObj.3,v 1.5 2005/05/10 18:33:55 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression
@@ -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
@@ -88,17 +86,21 @@ number, then they store 0 at \fI*booleanPtr\fR if
the value was zero and 1 otherwise.
If the expression's actual value is a non-numeric string then
it must be one of the values accepted by \fBTcl_GetBoolean\fR
-such as ``yes'' or ``no'', or else an error occurs.
+such as
+.QW yes
+or
+.QW no ,
+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 3aee462..6a8158c 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -1,16 +1,15 @@
'\"
'\" Copyright (c) 2001 Vincent Darley
+'\" Copyright (c) 2008-2010 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: FileSystem.3,v 1.55 2005/08/31 15:12:18 vincentdarley Exp $
-'\"
-.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
+Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSUnloadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_GetAccessTimeFromStat, Tcl_GetBlockSizeFromStat, Tcl_GetBlocksFromStat, Tcl_GetChangeTimeFromStat, Tcl_GetDeviceTypeFromStat, Tcl_GetFSDeviceFromStat, Tcl_GetFSInodeFromStat, Tcl_GetGroupIdFromStat, Tcl_GetLinkCountFromStat, Tcl_GetModeFromStat, Tcl_GetModificationTimeFromStat, Tcl_GetSizeFromStat, Tcl_GetUserIdFromStat, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -27,7 +26,7 @@ ClientData
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
-Tcl_Filesystem*
+const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)
.sp
Tcl_PathType
@@ -51,25 +50,28 @@ int
int
\fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSListVolumes\fR(\fIvoid\fR)
.sp
-.VS 8.5
int
\fBTcl_FSEvalFileEx\fR(\fIinterp, pathPtr, encodingName\fR)
-.VE 8.5
.sp
int
\fBTcl_FSEvalFile\fR(\fIinterp, pathPtr\fR)
.sp
int
\fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- handlePtr, unloadProcPtr\fR)
+ loadHandlePtr, unloadProcPtr\fR)
+.sp
+.VS 8.6
+int
+\fBTcl_FSUnloadFile\fR(\fIinterp, loadHandle\fR)
+.VE 8.6
.sp
int
\fBTcl_FSMatchInDirectory\fR(\fIinterp, resultPtr, pathPtr, pattern, types\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSLink\fR(\fIlinkNamePtr, toPtr, linkAction\fR)
.sp
int
@@ -84,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
@@ -96,28 +98,28 @@ int
Tcl_Channel
\fBTcl_FSOpenFileChannel\fR(\fIinterp, pathPtr, modeString, permissions\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSGetCwd\fR(\fIinterp\fR)
.sp
int
\fBTcl_FSChdir\fR(\fIpathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSPathSeparator\fR(\fIpathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSJoinPath\fR(\fIlistObj, elements\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSSplitPath\fR(\fIpathPtr, lenPtr\fR)
.sp
int
\fBTcl_FSEqualPaths\fR(\fIfirstPtr, secondPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSGetNormalizedPath\fR(\fIinterp, pathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
@@ -132,25 +134,66 @@ Tcl_Obj *
const char *
\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSNewNativePath\fR(\fIfsPtr, clientData\fR)
.sp
-const char *
+const void *
\fBTcl_FSGetNativePath\fR(\fIpathPtr\fR)
.sp
-Tcl_Obj*
+Tcl_Obj *
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
-Tcl_StatBuf*
+Tcl_StatBuf *
\fBTcl_AllocStatBuf\fR()
+.sp
+.VS 8.6
+Tcl_WideInt
+\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
+.sp
+unsigned
+\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
+.sp
+Tcl_WideUInt
+\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
+.sp
+Tcl_WideInt
+\fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR)
+.sp
+int
+\fBTcl_GetDeviceTypeFromStat\fR(\fIstatPtr\fR)
+.sp
+unsigned
+\fBTcl_GetFSDeviceFromStat\fR(\fIstatPtr\fR)
+.sp
+unsigned
+\fBTcl_GetFSInodeFromStat\fR(\fIstatPtr\fR)
+.sp
+int
+\fBTcl_GetGroupIdFromStat\fR(\fIstatPtr\fR)
+.sp
+int
+\fBTcl_GetLinkCountFromStat\fR(\fIstatPtr\fR)
+.sp
+unsigned
+\fBTcl_GetModeFromStat\fR(\fIstatPtr\fR)
+.sp
+Tcl_WideInt
+\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
+.sp
+Tcl_WideUInt
+\fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR)
+.sp
+int
+\fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR)
+.VE 8.6
.SH ARGUMENTS
-.AS Tcl_FSUnloadFileProc **unloadProcPtr out
-.AP Tcl_Filesystem *fsPtr in
+.AS Tcl_GlobTypeData **srcPathPtr out
+.AP "const Tcl_Filesystem" *fsPtr in
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
@@ -160,41 +203,41 @@ As for \fIpathPtr\fR, but used for the destination filename for a copy or
rename operation.
.AP "const char" *encodingName in
The encoding of the data stored in the
-file identified by \fIpathPtr\fR and to be evaluted.
+file identified by \fIpathPtr\fR and to be evaluated.
.AP "const char" *pattern in
Only files or directories matching this pattern will be returned.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
-this structure will be returned. This parameter may be NULL.
+this structure will be returned. This parameter may be NULL.
.AP Tcl_Interp *interp in
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.
.AP int elements in
If non-negative, the number of elements in the \fIlistObj\fR which should
-be joined together. If negative, then all elements are joined.
+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
-Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
+Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
W_OK and X_OK request checking whether the file exists and has read,
-write and execute permissions, respectively. F_OK just requests
+write and execute permissions, respectively. F_OK just requests
checking for the existence of the file.
.AP Tcl_StatBuf *statPtr out
The structure that contains the result of a stat or lstat operation.
@@ -209,23 +252,25 @@ Filled with the safe-init function for this code.
.AP ClientData *clientDataPtr out
Filled with the clientData value to pass to this code's unload
function when it is called.
-.AP Tcl_LoadHandle *handlePtr out
+.AP Tcl_LoadHandle *loadHandlePtr out
Filled with an abstract token representing the loaded file.
.AP Tcl_FSUnloadFileProc **unloadProcPtr out
Filled with the function to use to unload this piece of code.
+.AP Tcl_LoadHandle loadHandle in
+Handle to the loaded library to be unloaded.
.AP utimbuf *tval in
The access and modification times in this structure are read and
used to set those values for a given file.
.AP "const char" *modeString in
-Specifies how the file is to be accessed. May have any of the values
+Specifies how the file is to be accessed. May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
-POSIX-style permission flags such as 0644. If a new file is created, these
+POSIX-style permission flags such as 0644. If a new file is created, these
permissions will be set on the created file.
.AP int *lenPtr out
If non-NULL, filled with the number of elements in the split path.
.AP Tcl_Obj *basePtr in
-The base path on to which to join the given elements. May be NULL.
+The base path on to which to join the given elements. May be NULL.
.AP int objc in
The number of elements in \fIobjv\fR.
.AP "Tcl_Obj *const" objv[] in
@@ -242,232 +287,286 @@ are \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
When both flags are set and the underlying filesystem can do either,
symbolic links are preferred.
.BE
-
.SH DESCRIPTION
.PP
There are several reasons for calling the \fBTcl_FS\fR API functions
-(e.g. \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR)
+(e.g.\ \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR)
rather than calling system level functions like \fBaccess\fR and
-\fBstat\fR directly. First, they will work cross-platform, so an
+\fBstat\fR directly. First, they will work cross-platform, so an
extension which calls them should work unmodified on Unix and
-Windows. Second, the Windows implementation of some of these functions
-fixes some bugs in the system level calls. Third, these function calls
-deal with any 'Utf to platform-native' path conversions which may be
+Windows. Second, the Windows implementation of some of these functions
+fixes some bugs in the system level calls. Third, these function calls
+deal with any
+.QW "Utf to platform-native"
+path conversions which may be
required (and may cache the results of such conversions for greater
-efficiency on subsequent calls). Fourth, and perhaps most importantly,
-all of these functions are 'virtual filesystem aware'. Any virtual
-filesystem (VFS for short) which has been registered (through
+efficiency on subsequent calls). Fourth, and perhaps most importantly,
+all of these functions are
+.QW "virtual filesystem aware" .
+Any virtual filesystem (VFS for short) which has been registered (through
\fBTcl_FSRegister\fR) may reroute file access to alternative
-media or access methods. This means that all of these functions (and
+media or access methods. This means that all of these functions (and
therefore the corresponding \fBfile\fR, \fBglob\fR, \fBpwd\fR, \fBcd\fR,
-\fBopen\fR, etc. Tcl commands) may be operate on 'files' which are not
-native files in the native filesystem. This also means that any Tcl
+\fBopen\fR, etc.\ Tcl commands) may be operate on
+.QW files
+which are not
+native files in the native filesystem. This also means that any Tcl
extension which accesses the filesystem (FS for short) through this API is
-automatically 'virtual filesystem aware'. Of course, if an extension
+automatically
+.QW "virtual filesystem aware" .
+Of course, if an extension
accesses the native filesystem directly (through platform-specific
APIs, for example), then Tcl cannot intercept such calls.
.PP
-If appropriate VFSes have been registered, the 'files' may, to give two
-examples, be remote (e.g. situated on a remote ftp server) or archived
-(e.g. lying inside a .zip archive). Such registered filesystems provide
+If appropriate VFSes have been registered, the
+.QW files
+may, to give two
+examples, be remote (e.g.\ situated on a remote ftp server) or archived
+(e.g.\ lying inside a .zip archive). Such registered filesystems provide
a lookup table of functions to implement all or some of the functionality
-listed here. Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls
-abstract away from what the 'struct stat' buffer is actually
+listed here. Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls
+abstract away from what the
+.QW "struct stat"
+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
-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
-with a reference count of zero to any of these functions. If such calls were
+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 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
+absolute for filesystem determination. The practical lesson to learn
from this is that
+.PP
.CS
Tcl_Obj *path = Tcl_NewStringObj(...);
Tcl_FS\fIWhatever\fR(path);
Tcl_DecrRefCount(path);
.CE
+.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
+path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
-filesystem's 'copy file' function is called (if it is non-NULL).
+filesystem's
+.QW "copy file"
+function is called (if it is non-NULL).
Otherwise the function returns -1 and sets the \fBerrno\fR global C
-variable to the 'EXDEV'
-POSIX error code (which signifies a 'cross-domain link').
+variable to the
+.QW EXDEV
+POSIX error code (which signifies a
+.QW "cross-domain link" ).
.PP
\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by \fIsrcPathPtr\fR to the
-path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
+path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
-filesystem's 'copy file' function is called (if it is non-NULL).
+filesystem's
+.QW "copy file"
+function is called (if it is non-NULL).
Otherwise the function returns -1 and sets the \fBerrno\fR global C
-variable to the 'EXDEV'
-POSIX error code (which signifies a 'cross-domain link').
+variable to the
+.QW EXDEV
+POSIX error code (which signifies a
+.QW "cross-domain link" ).
.PP
\fBTcl_FSCreateDirectory\fR attempts to create the directory given by
-\fIpathPtr\fR by calling the owning filesystem's 'create directory'
+\fIpathPtr\fR by calling the owning filesystem's
+.QW "create directory"
function.
.PP
\fBTcl_FSDeleteFile\fR attempts to delete the file given by
-\fIpathPtr\fR by calling the owning filesystem's 'delete file'
+\fIpathPtr\fR by calling the owning filesystem's
+.QW "delete file"
function.
.PP
\fBTcl_FSRemoveDirectory\fR attempts to remove the directory given by
-\fIpathPtr\fR by calling the owning filesystem's 'remove directory'
+\fIpathPtr\fR by calling the owning filesystem's
+.QW "remove directory"
function.
.PP
\fBTcl_FSRenameFile\fR attempts to rename the file or directory given by
-\fIsrcPathPtr\fR to the path name given by \fIdestPathPtr\fR. If the two paths
+\fIsrcPathPtr\fR to the path name given by \fIdestPathPtr\fR. If the two paths
given lie in the same filesystem (according to
-\fBTcl_FSGetFileSystemForPath\fR) then that filesystem's 'rename file'
-function is called (if it is non-NULL). Otherwise the function returns -1
-and sets the \fBerrno\fR global C variable to the 'EXDEV' POSIX error
-code (which signifies a 'cross-domain link').
-.PP
-\fBTcl_FSListVolumes\fR calls each filesystem which has a non-NULL 'list
-volumes' function and asks them to return their list of root volumes. It
+\fBTcl_FSGetFileSystemForPath\fR) then that filesystem's
+.QW "rename file"
+function is called (if it is non-NULL). Otherwise the function returns -1
+and sets the \fBerrno\fR global C variable to the
+.QW EXDEV
+POSIX error code (which signifies a
+.QW "cross-domain link" ).
+.PP
+\fBTcl_FSListVolumes\fR calls each filesystem which has a non-NULL
+.QW "list volumes"
+function and asks them to return their list of root volumes. It
accumulates the return values in a list which is returned to the
caller (with a reference count of 0).
.PP
-.VS 8.5
\fBTcl_FSEvalFileEx\fR reads the file given by \fIpathPtr\fR using
the encoding identified by \fIencodingName\fR and evaluates
-its contents as a Tcl script. It returns the same information as
+its contents as a Tcl script. It returns the same information as
\fBTcl_EvalObjEx\fR.
If \fIencodingName\fR is NULL, the system encoding is used for
reading the file contents.
-If the file couldn't be read then a Tcl error is returned to describe
-why the file couldn't be read.
-The eofchar for files is '\\32' (^Z) for all platforms.
-If you require a ``^Z'' in code for string comparison, you can use
-``\\032'' or ``\\u001a'', which will be safely substituted by the Tcl
-interpreter into ``^Z''.
+If the file could not be read then a Tcl error is returned to describe
+why the file could not be read.
+The eofchar for files is
+.QW \e32
+(^Z) for all platforms.
+If you require a
+.QW ^Z
+in code for string comparison, you can use
+.QW \e032
+or
+.QW \eu001a ,
+which will be safely substituted by the Tcl interpreter into
+.QW ^Z .
\fBTcl_FSEvalFile\fR is a simpler version of
\fBTcl_FSEvalFileEx\fR that always uses the system encoding
when reading the file.
-.VE 8.5
.PP
\fBTcl_FSLoadFile\fR dynamically loads a binary code file into memory and
returns the addresses of two procedures within that file, if they are
-defined. The appropriate function for the filesystem to which \fIpathPtr\fR
-belongs will be called. If that filesystem does not implement this
+defined. The appropriate function for the filesystem to which \fIpathPtr\fR
+belongs will be called. If that filesystem does not implement this
function (most virtual filesystems will not, because of OS limitations
in dynamically loading binary code), Tcl will attempt to copy the file
to a temporary directory and load that temporary file.
+.VS 8.6
+\fBTcl_FSUnloadFile\fR reverses the operation, asking for the library
+indicated by the \fIloadHandle\fR to be removed from the process. Note that,
+unlike with the \fBunload\fR command, this does not give the library any
+opportunity to clean up.
+.VE 8.6
+.PP
+Both the above functions return a standard Tcl completion code. If an error
+occurs, an error message is left in the \fIinterp\fR's result.
.PP
-Returns a standard Tcl completion code. If an error occurs, an error
-message is left in the \fIinterp\fR's result.
+.VS 8.6
+The token provided via the variable indicated by \fIloadHandlePtr\fR may be
+used with \fBTcl_FindSymbol\fR.
+.VE 8.6
.PP
\fBTcl_FSMatchInDirectory\fR is used by the globbing code to search a
-directory for all files which match a given pattern. The appropriate
+directory for all files which match a given pattern. The appropriate
function for the filesystem to which \fIpathPtr\fR belongs will be called.
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in globbing. Error messages are placed in interp (unless
+occurred in globbing. Error messages are placed in interp (unless
interp is NULL, which is allowed), but good results are placed in the
resultPtr given.
.PP
Note that the \fBglob\fR code implements recursive patterns internally, so
this function will only ever be passed simple patterns, which can be
-matched using the logic of \fBstring match\fR. To handle recursion, Tcl
+matched using the logic of \fBstring match\fR. To handle recursion, Tcl
will call this function frequently asking only for directories to be
-returned.
+returned. A special case of being called with a NULL pattern indicates
+that the path needs to be checked only for the correct type.
.PP
\fBTcl_FSLink\fR replaces the library version of \fBreadlink\fR, and
-extends it to support the creation of links. The appropriate function
+extends it to support the creation of links. The appropriate function
for the filesystem to which \fIlinkNamePtr\fR belongs will be called.
.PP
-If the \fItoPtr\fR is NULL, a 'read link' action is performed. The result
+If the \fItoPtr\fR is NULL, a
+.QW "read link"
+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
-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
+\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
+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.
-Where a choice exists (i.e. more than one flag is passed in), the Tcl
-convention is to prefer symbolic links. When a link is successfully
+Where a choice exists (i.e.\ more than one flag is passed in), the Tcl
+convention is to prefer symbolic links. When a link is successfully
created, the return value should be \fItoPtr\fR (which is therefore
-already owned by the caller). If unsuccessful, NULL is returned.
+already owned by the caller). If unsuccessful, NULL is returned.
.PP
-\fBTcl_FSLstat\fR fills the stat structure \fIstatPtr\fR with information
-about the specified file. You do not need any access rights to the
+\fBTcl_FSLstat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
+information about the specified file. You do not need any access rights to the
file to get this information but you need search rights to all
-directories named in the path leading to the file. The stat structure
-includes info regarding device, inode (always 0 on Windows),
+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.
+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
-is filled with data. Otherwise, -1 is returned, and no stat info is
+is filled with data. Otherwise, -1 is returned, and no stat info is
given.
.PP
\fBTcl_FSUtime\fR replaces the library version of utime.
.PP
This returns 0 on success and -1 on error (as per the \fButime\fR
-documentation). If successful, the function
-will update the 'atime' and 'mtime' values of the file given.
+documentation). If successful, the function
+will update the
+.QW atime
+and
+.QW mtime
+values of the file given.
.PP
\fBTcl_FSFileAttrsGet\fR implements read access for the hookable \fBfile
-attributes\fR subcommand. The appropriate function for the filesystem to
+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
\fBTcl_FSFileAttrsSet\fR implements write access for the hookable \fBfile
-attributes\fR subcommand. The appropriate function for the filesystem to
+attributes\fR subcommand. The appropriate function for the filesystem to
which \fIpathPtr\fR belongs will be called.
.PP
\fBTcl_FSFileAttrStrings\fR implements part of the hookable \fBfile
-attributes\fR subcommand. The appropriate function for the filesystem
+attributes\fR subcommand. The appropriate function for the filesystem
to which \fIpathPtr\fR belongs will be called.
.PP
The called procedure may either return an array of strings, or may
-instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
+instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
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
+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)
-whose name is \fIpathname\fR. If \fIpathname\fR is a symbolic link on Unix,
+whose name is \fIpathname\fR. If \fIpathname\fR is a symbolic link on Unix,
then permissions of the file referred by this symbolic link are
tested.
.PP
-On success (all requested permissions granted), zero is returned. On
+On success (all requested permissions granted), zero is returned. On
error (at least one bit in mode asked for a permission that is denied,
or some other error occurred), -1 is returned.
.PP
-\fBTcl_FSStat\fR fills the stat structure \fIstatPtr\fR with information
-about the specified file. You do not need any access rights to the
+\fBTcl_FSStat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
+information about the specified file. You do not need any access rights to the
file to get this information but you need search rights to all
-directories named in the path leading to the file. The stat structure
-includes info regarding device, inode (always 0 on Windows),
+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.
+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
-is filled with data. Otherwise, -1 is returned, and no stat info is
+is filled with data. Otherwise, -1 is returned, and no stat info is
given.
.PP
\fBTcl_FSOpenFileChannel\fR opens a file specified by \fIpathPtr\fR and
@@ -483,188 +582,202 @@ 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.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
.PP
\fBTcl_FSGetCwd\fR replaces the library version of \fBgetcwd\fR.
.PP
-It returns the Tcl library's current working directory. This may be
+It returns the Tcl library's current working directory. This may be
different to the native platform's working directory, which happens when
the current working directory is not in the native filesystem.
.PP
The result is a pointer to a Tcl_Obj specifying the current directory,
-or NULL if the current directory could not be determined. If NULL is
+or NULL if the current directory could not be determined. If NULL is
returned, an error message is left in the \fIinterp\fR's result.
.PP
-The result already has its reference count incremented for the caller. When
-it is no longer needed, that reference count should be decremented. This is
+The result already has its reference count incremented for the caller. When
+it is no longer needed, that reference count should be decremented. This is
needed for thread-safety purposes, to allow multiple threads to access
this and related functions, while ensuring the results are always
valid.
.PP
-\fBTcl_FSChdir\fR replaces the library version of \fBchdir\fR. The path is
-normalized and then passed to the filesystem which claims it. If that
+\fBTcl_FSChdir\fR replaces the library version of \fBchdir\fR. The path is
+normalized and then passed to the filesystem which claims it. If that
filesystem does not implement this function, Tcl will fallback to a
combination of \fBstat\fR and \fBaccess\fR to check whether the directory
exists and has appropriate permissions.
.PP
-For results, see \fBchdir\fR documentation. If successful, we keep a
+For results, see \fBchdir\fR documentation. If successful, we keep a
record of the successful path in \fIcwdPathPtr\fR for subsequent calls to
\fBTcl_FSGetCwd\fR.
.PP
\fBTcl_FSPathSeparator\fR returns the separator character to be used for
-most specific element of the path specified by \fIpathPtr\fR (i.e. the last
+most specific element of the path specified by \fIpathPtr\fR (i.e.\ the last
part of the path).
.PP
The separator is returned as a Tcl_Obj containing a string of length
-1. If the path is invalid, NULL is returned.
+1. If the path is invalid, NULL is returned.
.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
+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
+under some conditions), contains the joined path. The caller must
+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
-It returns 1 if the paths are equal, and 0 if they are different. If
+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
\fBTcl_FSGetNormalizedPath\fR this important function attempts to extract
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
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
+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
-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
+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 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.
-The filename may begin with "~" (to indicate current user's home
-directory) or "~<user>" (to indicate any user's home directory).
-.PP
-If the conversion succeeds (i.e. the object is a valid path in one of
-the current filesystems), then \fBTCL_OK\fR is returned. Otherwise
+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 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.
.PP
-Returns NULL or a valid internal path representation. This internal
+Returns NULL or a valid internal path representation. This internal
representation is cached, so that repeated calls to this function will
not require additional conversions.
.PP
\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
-returned. Otherwise NULL will be returned, and an error message may be
-left in the interpreter. A "translated" path is one which contains no
-"~" or "~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
-freed. This function is of little practical use, and
-\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
+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
+path is one which contains no
+.QW ~
+or
+.QW ~user
+sequences (these have been expanded to their current
+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_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
+which must store it or call \fBckfree\fR to ensure it is freed. Again,
+\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
+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 'path' object, which will only receive
-a Utf-8 string representation if that is required by some Tcl code.
+The resulting value is a pure
+.QW path
+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
filesystems, so that they can easily retrieve the native (char* or
-TCHAR*) representation of a path. This function is a convenience
-wrapper around \fBTcl_FSGetInternalRep\fR, and assumes the native
-representation is string-based. It may be desirable in the future to
-have non-string-based native representations (for example, on MacOSX, a
-representation using a fileSpec of FSRef structure would probably be
-more efficient). On Windows a full Unicode representation would allow
-for paths of unlimited length. Currently the representation is simply a
-character string which may contain either the relative path or a
-complete, absolute normalized path in the native encoding (complex
+TCHAR*) representation of a path. This function is a convenience
+wrapper around \fBTcl_FSGetInternalRep\fR. It may be desirable in the
+future to have non-string-based native representations (for example,
+on MacOSX, a representation using a fileSpec of FSRef structure would
+probably be more efficient). On Windows a full Unicode representation
+would allow for paths of unlimited length. Currently the representation
+is simply a character string which may contain either the relative path
+or a complete, absolute normalized path in the native encoding (complex
conditions dictate which of these will be provided, so neither can be
-relied upon, unless the path is known to be absolute). If you need a
+relied upon, unless the path is known to be absolute). If you need a
native path which must be absolute, then you should ask for the native
-version of a normalized path. If for some reason a non-absolute,
+version of a normalized path. If for some reason a non-absolute,
non-normalized version of the path is needed, that must be constructed
-separately (e.g. using \fBTcl_FSGetTranslatedPath\fR).
+separately (e.g.\ using \fBTcl_FSGetTranslatedPath\fR).
.PP
The native representation is cached so that repeated calls to this
-function will not require additional conversions. The return value is
+function will not require additional conversions. 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 native
representation may be freed any time the cwd changes).
.PP
-\fBTcl_FSFileSystemInfo\fR returns a list of two elements. The first
-element is the name of the filesystem (e.g. "native" or "vfs" or "zip"
-or "prowrap", perhaps), and the second is the particular type of the
-given path within that filesystem (which is filesystem dependent). The
+\fBTcl_FSFileSystemInfo\fR returns a list of two elements. The first
+element is the name of the filesystem (e.g.
+.QW native ,
+.QW vfs ,
+.QW zip ,
+or
+.QW prowrap ,
+perhaps), and the second is the particular type of the
+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 the a pointer to the
+\fBTcl_FSGetFileSystemForPath\fR returns a pointer to the
\fBTcl_Filesystem\fR which accepts this path as valid.
.PP
If no filesystem will accept the path, NULL is returned.
@@ -675,12 +788,38 @@ absolute.
.PP
It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or
\fBTCL_PATH_VOLUME_RELATIVE\fR
-.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 size of the buffer. That in turn
-depends on the flags used to build Tcl.
+.SS "PORTABLE STAT RESULT API"
+.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
+size of the buffer. That in turn depends on the flags used to build Tcl.
+.PP
+.VS 8.6
+The portable fields of a \fITcl_StatBuf\fR may be read using the following
+functions, each of which returns the value of the corresponding field listed
+in the table below. Note that on some platforms there may be other fields in
+the \fITcl_StatBuf\fR as it is an alias for a suitable system structure, but
+only the portable ones are made available here. See your system documentation
+for a full description of these fields.
+.DS
+.ta \w'\fBTcl_GetModificationTimeFromStat\fR\0\0\0\0'u
+\fIAccess Function\fR \fIField\fR
+ \fBTcl_GetFSDeviceFromStat\fR st_dev
+ \fBTcl_GetFSInodeFromStat\fR st_ino
+ \fBTcl_GetModeFromStat\fR st_mode
+ \fBTcl_GetLinkCountFromStat\fR st_nlink
+ \fBTcl_GetUserIdFromStat\fR st_uid
+ \fBTcl_GetGroupIdFromStat\fR st_gid
+ \fBTcl_GetDeviceTypeFromStat\fR st_rdev
+ \fBTcl_GetAccessTimeFromStat\fR st_atime
+ \fBTcl_GetModificationTimeFromStat\fR st_mtime
+ \fBTcl_GetChangeTimeFromStat\fR st_ctime
+ \fBTcl_GetSizeFromStat\fR st_size
+ \fBTcl_GetBlocksFromStat\fR st_blocks
+ \fBTcl_GetBlockSizeFromStat\fR st_blksize
+.DE
+.VE 8.6
.SH "THE VIRTUAL FILESYSTEM API"
.PP
A filesystem provides a \fBTcl_Filesystem\fR structure that contains
@@ -692,18 +831,18 @@ The \fBTcl_Filesystem\fR structures are manipulated using the following
methods.
.PP
\fBTcl_FSRegister\fR takes a pointer to a filesystem structure and an
-optional piece of data to associated with that filesystem. On calling
+optional piece of data to associated with that filesystem. On calling
this function, Tcl will attach the filesystem to the list of known
-filesystems, and it will become fully functional immediately. Tcl does
+filesystems, and it will become fully functional immediately. Tcl does
not check if the same filesystem is registered multiple times (and in
-general that is not a good thing to do). \fBTCL_OK\fR will be returned.
+general that is not a good thing to do). \fBTCL_OK\fR will be returned.
.PP
\fBTcl_FSUnregister\fR removes the given filesystem structure from
-the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If
+the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If
the filesystem is not currently registered, \fBTCL_ERROR\fR is returned.
.PP
\fBTcl_FSData\fR will return the ClientData associated with the given
-filesystem, if that filesystem is registered. Otherwise it will
+filesystem, if that filesystem is registered. Otherwise it will
return NULL.
.PP
\fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that
@@ -713,6 +852,7 @@ longer be correct.
.SS "THE TCL_FILESYSTEM STRUCTURE"
.PP
The \fBTcl_Filesystem\fR structure contains the following fields:
+.PP
.CS
typedef struct Tcl_Filesystem {
const char *\fItypeName\fR;
@@ -746,7 +886,7 @@ typedef struct Tcl_Filesystem {
Tcl_FSLoadFileProc *\fIloadFileProc\fR;
Tcl_FSGetCwdProc *\fIgetCwdProc\fR;
Tcl_FSChdirProc *\fIchdirProc\fR;
-} Tcl_Filesystem;
+} \fBTcl_Filesystem\fR;
.CE
.PP
Except for the first three fields in this structure which contain
@@ -760,7 +900,7 @@ implemented), operational functions (which must be implemented if a
complete filesystem is provided), and efficiency functions (which need
only be implemented if they can be done so efficiently, or if they have
side-effects which are required by the filesystem; Tcl has less
-efficient emulations it can fall back on). It is important to note
+efficient emulations it can fall back on). It is important to note
that, in the current version of Tcl, most of these fallbacks are only
used to handle commands initiated in Tcl, not in C. What this means is,
that if a \fBfile rename\fR command is issued in Tcl, and the relevant
@@ -768,20 +908,22 @@ filesystem(s) do not implement their \fITcl_FSRenameFileProc\fR, Tcl's
core will instead fallback on a combination of other filesystem
functions (it will use \fITcl_FSCopyFileProc\fR followed by
\fITcl_FSDeleteFileProc\fR, and if \fITcl_FSCopyFileProc\fR is not
-implemented there is a further fallback). However, if a
+implemented there is a further fallback). However, if a
\fITcl_FSRenameFileProc\fR command is issued at the C level, no such
-fallbacks occur. This is true except for the last four entries in the
+fallbacks occur. This is true except for the last four entries in the
filesystem table (\fBlstat\fR, \fBload\fR, \fBgetcwd\fR and \fBchdir\fR)
for which fallbacks do in fact occur at the C level.
.PP
Any functions which take path names in Tcl_Obj form take
-those names in UTF\-8 form. The filesystem infrastructure API is
+those names in UTF\-8 form. The filesystem infrastructure API is
designed to support efficient, cached conversion of these UTF\-8 paths
to other native representations.
.SS "EXAMPLE FILESYSTEM DEFINITION"
.PP
-Here is the filesystem lookup table used by the "vfs" extension which
-allows filesystem actions to be implemented in Tcl.
+Here is the filesystem lookup table used by the
+.QW vfs
+extension which allows filesystem actions to be implemented in Tcl.
+.PP
.CS
static Tcl_Filesystem vfsFilesystem = {
"tclvfs",
@@ -825,7 +967,7 @@ static Tcl_Filesystem vfsFilesystem = {
NULL,
/* Core will use stat for lstat */
NULL,
- /* No load; use the core fallback mechansism */
+ /* No load; use the core fallback mechanism */
NULL,
/* We don't need a getcwd or chdir; the core's own
* internal value is suitable */
@@ -844,7 +986,10 @@ representations.
.PP
The \fItypeName\fR field contains a null-terminated string that
identifies the type of the filesystem implemented, e.g.
-``native'' or ``zip'' or ```vfs''.
+.QW native ,
+.QW zip
+or
+.QW vfs .
.SS "STRUCTURE LENGTH"
.PP
The \fIstructureLength\fR field is generally implemented as
@@ -857,92 +1002,97 @@ 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
-filesystem or not. Tcl will only call the rest of the filesystem
+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
-for any other return value is not defined). If \fBTCL_OK\fR is returned,
+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
-efficiently by the other filesystem functions. Tcl will simultaneously
-cache the fact that this path belongs to this filesystem. Such caches
+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
Tcl's internal list of known filesystems.
.PP
.CS
-typedef int Tcl_FSPathInFilesystemProc(
+typedef int \fBTcl_FSPathInFilesystemProc\fR(
Tcl_Obj *\fIpathPtr\fR,
ClientData *\fIclientDataPtr\fR);
.CE
.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
.CS
-typedef ClientData Tcl_FSDupInternalRepProc(
+typedef ClientData \fBTcl_FSDupInternalRepProc\fR(
ClientData \fIclientData\fR);
.CE
.SS FREEINTERNALREPPROC
-Free the internal representation. This must be implemented if internal
-representations need freeing (i.e. if some memory is allocated when an
+Free the internal representation. This must be implemented if internal
+representations need freeing (i.e.\ if some memory is allocated when an
internal representation is generated), but may otherwise be NULL.
.PP
.CS
-typedef void Tcl_FSFreeInternalRepProc(
+typedef void \fBTcl_FSFreeInternalRepProc\fR(
ClientData \fIclientData\fR);
.CE
.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
+Function to convert internal representation to a normalized path. Only
+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
-typedef Tcl_Obj* Tcl_FSInternalToNormalizedProc(
+typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
ClientData \fIclientData\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
.CS
-typedef ClientData Tcl_FSCreateInternalRepProc(
+typedef ClientData \fBTcl_FSCreateInternalRepProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
-Function to normalize a path. Should be implemented for all
+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' must have a single unique 'normalized'
-string representation. Depending on the filesystem,
+path value. In Tcl, every
+.QW path
+must have a single unique
+.QW normalized
+string representation. Depending on the filesystem,
there may be more than one unnormalized string representation which
-refers to that path (e.g. a relative path, a path with different
+refers to that path (e.g.\ a relative path, a path with different
character case if the filesystem is case insensitive, a path contain a
-reference to a home directory such as '~', 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
-its case or other aspects should be made unique). All other path
-components should be converted from symbolic links. This one
+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 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
delete\fR, \fBfile rename\fR, \fBfile copy\fR operating on symbolic links.
This function may be called with \fInextCheckpoint\fR either
-at the beginning of the path (i.e. zero), at the end of the path, or
-at any intermediate file separator in the path. It will never
+at the beginning of the path (i.e.\ zero), at the end of the path, or
+at any intermediate file separator in the path. It will never
point to any other arbitrary position in the path. In the last of
the three valid cases, the implementation can assume that the path
up to and including the file separator is known and normalized.
.PP
.CS
-typedef int Tcl_FSNormalizePathProc(
+typedef int \fBTcl_FSNormalizePathProc\fR(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIpathPtr\fR,
int \fInextCheckpoint\fR);
@@ -951,97 +1101,105 @@ typedef int Tcl_FSNormalizePathProc(
.PP
The fields in this section of the structure contain addresses of
functions which are called to carry out the basic filesystem
-operations. A filesystem which expects to be used with the complete
-standard Tcl command set must implement all of these. If some of
+operations. A filesystem which expects to be used with the complete
+standard Tcl command set must implement all of these. If some of
them are not implemented, then certain Tcl commands may fail when
-operating on paths within that filesystem. However, in some instances
+operating on paths within that filesystem. However, in some instances
this may be desirable (for example, a read-only filesystem should not
implement the last four functions, and a filesystem which does not
support symbolic links need not implement the \fBreadlink\fR function,
-etc. The Tcl core expects filesystems to behave in this way).
+etc. The Tcl core expects filesystems to behave in this way).
.SS FILESYSTEMPATHTYPEPROC
.PP
-Function to determine the type of a path in this filesystem. May be
+Function to determine the type of a path in this filesystem. May be
NULL, in which case no type information will be available to users of
-the filesystem. The 'type' is used only for informational purposes,
+the filesystem. The
+.QW type
+is used only for informational purposes,
and should be returned as the string representation of the Tcl_Obj
-which is returned. A typical return value might be "networked", "zip"
-or "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
+which is returned. A typical return value might be
+.QW networked ,
+.QW zip
+or
+.QW ftp .
+The Tcl_Obj result is owned by the filesystem and so Tcl will
+increment the reference count of that value if it wishes to retain a reference
to it.
.PP
.CS
-typedef Tcl_Obj* Tcl_FSFilesystemPathTypeProc(
+typedef Tcl_Obj *\fBTcl_FSFilesystemPathTypeProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.SS FILESYSTEMSEPARATORPROC
.PP
Function to return the separator character(s) for this filesystem.
This need only be implemented if the filesystem wishes to use a
-different separator than the standard string "/". Amongst other
-uses, it is returned by the \fBfile separator\fR command. The
-return value should be an object with refCount of zero.
+different separator than the standard string
+.QW / .
+Amongst other
+uses, it is returned by the \fBfile separator\fR command. The
+return value should be a value with reference count of zero.
.PP
.CS
-typedef Tcl_Obj* Tcl_FSFilesystemSeparatorProc(
+typedef Tcl_Obj *\fBTcl_FSFilesystemSeparatorProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.SS STATPROC
.PP
-Function to process a \fBTcl_FSStat\fR call. Must be implemented for any
+Function to process a \fBTcl_FSStat\fR call. Must be implemented for any
reasonable filesystem, since many Tcl level commands depend crucially
-upon it (e.g. \fBfile atime\fR, \fBfile isdirectory\fR, \fBfile size\fR,
+upon it (e.g.\ \fBfile atime\fR, \fBfile isdirectory\fR, \fBfile size\fR,
\fBglob\fR).
.PP
.CS
-typedef int Tcl_FSStatProc(
+typedef int \fBTcl_FSStatProc\fR(
Tcl_Obj *\fIpathPtr\fR,
Tcl_StatBuf *\fIstatPtr\fR);
.CE
.PP
The \fBTcl_FSStatProc\fR fills the stat structure \fIstatPtr\fR with
-information about the specified file. You do not need any access
+information about the specified file. You do not need any access
rights to the file to get this information but you need search rights
-to all directories named in the path leading to the file. The stat
+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
-data. Otherwise, -1 is returned, and no stat info is given.
+data. Otherwise, -1 is returned, and no stat info is given.
.SS ACCESSPROC
.PP
-Function to process a \fBTcl_FSAccess\fR call. Must be implemented for
+Function to process a \fBTcl_FSAccess\fR call. Must be implemented for
any reasonable filesystem, since many Tcl level commands depend crucially
-upon it (e.g. \fBfile exists\fR, \fBfile readable\fR).
+upon it (e.g.\ \fBfile exists\fR, \fBfile readable\fR).
.PP
.CS
-typedef int Tcl_FSAccessProc(
+typedef int \fBTcl_FSAccessProc\fR(
Tcl_Obj *\fIpathPtr\fR,
int \fImode\fR);
.CE
.PP
The \fBTcl_FSAccessProc\fR checks whether the process would be allowed
to read, write or test for existence of the file (or other filesystem
-object) whose name is in \fIpathPtr\fR. If the pathname refers to a
+object) whose name is in \fIpathPtr\fR. If the pathname refers to a
symbolic link, then the
permissions of the file referred by this symbolic link should be tested.
.PP
-On success (all requested permissions granted), zero is returned. On
+On success (all requested permissions granted), zero is returned. On
error (at least one bit in mode asked for a permission that is denied,
or some other error occurred), -1 is returned.
.SS OPENFILECHANNELPROC
.PP
-Function to process a \fBTcl_FSOpenFileChannel\fR call. Must be
+Function to process a \fBTcl_FSOpenFileChannel\fR call. Must be
implemented for any reasonable filesystem, since any operations
which require open or accessing a file's contents will use it
-(e.g. \fBopen\fR, \fBencoding\fR, and many Tk commands).
+(e.g.\ \fBopen\fR, \fBencoding\fR, and many Tk commands).
.PP
.CS
-typedef Tcl_Channel Tcl_FSOpenFileChannelProc(
+typedef Tcl_Channel \fBTcl_FSOpenFileChannelProc\fR(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIpathPtr\fR,
int \fImode\fR,
@@ -1050,32 +1208,33 @@ typedef Tcl_Channel Tcl_FSOpenFileChannelProc(
.PP
The \fBTcl_FSOpenFileChannelProc\fR opens a file specified by
\fIpathPtr\fR and returns a channel handle that can be used to perform
-input and output on the file. This API is modeled after the \fBfopen\fR
-procedure of the Unix standard I/O library. The syntax and meaning of
+input and output on the file. This API is modeled after the \fBfopen\fR
+procedure of the Unix standard I/O library. The syntax and meaning of
all arguments is similar to those given in the Tcl \fBopen\fR command
when opening a file, where the \fImode\fR argument is a combination of
-the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
+the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
opening the channel, the \fBTcl_FSOpenFileChannelProc\fR returns NULL and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
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 standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
.SS MATCHINDIRECTORYPROC
.PP
-Function to process a \fBTcl_FSMatchInDirectory\fR call. If not
+Function to process a \fBTcl_FSMatchInDirectory\fR call. If not
implemented, then glob and recursive copy functionality will be lacking
in the filesystem (and this may impact commands like \fBencoding names\fR
which use glob functionality internally).
.PP
.CS
-typedef int Tcl_FSMatchInDirectoryProc(
- Tcl_Interp* \fIinterp\fR,
+typedef int \fBTcl_FSMatchInDirectoryProc\fR(
+ Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIresultPtr\fR,
Tcl_Obj *\fIpathPtr\fR,
const char *\fIpattern\fR,
@@ -1084,22 +1243,22 @@ typedef int Tcl_FSMatchInDirectoryProc(
.PP
The function should return all files or directories (or other filesystem
objects) which match the given pattern and accord with the \fItypes\fR
-specification given. There are two ways in which this function may be
-called. If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
+specification given. There are two ways in which this function may be
+called. If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
specification of a single file or directory which should be checked for
-existence and correct type. Otherwise, \fIpathPtr\fR is a directory, the
+existence and correct type. Otherwise, \fIpathPtr\fR is a directory, the
contents of which the function should search for files or directories
-which have the correct type. In either case, \fIpathPtr\fR can be
-assumed to be both non-NULL and non-empty. It is not currently
+which have the correct type. In either case, \fIpathPtr\fR can be
+assumed to be both non-NULL and non-empty. It is not currently
documented whether \fIpathPtr\fR will have a file separator at its end of
not, so code should be flexible to both possibilities.
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the matching process. Error messages are placed in
+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
-valid unshared Tcl list). The matches added
+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).
Note that if no matches are found, that simply leads to an empty
@@ -1108,39 +1267,40 @@ problems which may occur during the matching process.
.PP
The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR
parameter contains the following fields:
+.PP
.CS
typedef struct Tcl_GlobTypeData {
- /* Corresponds to bcdpfls as in 'find -t' */
- int \fItype\fR;
- /* Corresponds to file permissions */
- int \fIperm\fR;
- /* Acceptable mac type */
- Tcl_Obj *\fImacType\fR;
- /* Acceptable mac creator */
- Tcl_Obj *\fImacCreator\fR;
-} Tcl_GlobTypeData;
+ /* Corresponds to bcdpfls as in 'find -t' */
+ int \fItype\fR;
+ /* Corresponds to file permissions */
+ int \fIperm\fR;
+ /* Acceptable mac type */
+ Tcl_Obj *\fImacType\fR;
+ /* Acceptable mac creator */
+ Tcl_Obj *\fImacCreator\fR;
+} \fBTcl_GlobTypeData\fR;
.CE
.PP
There are two specific cases which it is important to handle correctly,
both when \fItypes\fR is non-NULL. The two cases are when \fItypes->types
& TCL_GLOB_TYPE_DIR\fR or \fItypes->types & TCL_GLOB_TYPE_MOUNT\fR are
-true (and in particular when the other flags are false). In the first of
-these cases, the function must list the contained directories. Tcl uses
+true (and in particular when the other flags are false). In the first of
+these cases, the function must list the contained directories. Tcl uses
this to implement recursive globbing, so it is critical that filesystems
-implement directory matching correctly. In the second of these cases,
+implement directory matching correctly. In the second of these cases,
with \fBTCL_GLOB_TYPE_MOUNT\fR, the filesystem must list the mount points
which lie within the given \fIpathPtr\fR (and in this case, \fIpathPtr\fR
need not lie within the same filesystem - different to all other cases in
-which this function is called). Support for this is critical if Tcl is
+which this function is called). Support for this is critical if Tcl is
to have seamless transitions between from one filesystem to another.
.SS UTIMEPROC
.PP
-Function to process a \fBTcl_FSUtime\fR call. Required to allow setting
+Function to process a \fBTcl_FSUtime\fR call. Required to allow setting
(not reading) of times with \fBfile mtime\fR, \fBfile atime\fR and the
open-r/open-w/fcopy implementation of \fBfile copy\fR.
.PP
.CS
-typedef int Tcl_FSUtimeProc(
+typedef int \fBTcl_FSUtimeProc\fR(
Tcl_Obj *\fIpathPtr\fR,
struct utimbuf *\fItval\fR);
.CE
@@ -1152,26 +1312,26 @@ The return value should be 0 on success and -1 on an error, as
with the system \fButime\fR.
.SS LINKPROC
.PP
-Function to process a \fBTcl_FSLink\fR call. Should be implemented
+Function to process a \fBTcl_FSLink\fR call. Should be implemented
only if the filesystem supports links, and may otherwise be NULL.
.PP
.CS
-typedef Tcl_Obj* Tcl_FSLinkProc(
+typedef Tcl_Obj *\fBTcl_FSLinkProc\fR(
Tcl_Obj *\fIlinkNamePtr\fR,
Tcl_Obj *\fItoPtr\fR,
int \fIlinkAction\fR);
.CE
.PP
If \fItoPtr\fR is NULL, the function is being asked to read the
-contents of a link. The result is a Tcl_Obj specifying the contents of
+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.
+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 \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
-(i.e. no ref count manipulation on either end is needed). See
+and NULL otherwise. In this case the result is not owned by the caller
+(i.e.\ no reference count manipulations on either end are needed). See
the documentation for \fBTcl_FSLink\fR for the correct interpretation
of the \fIlinkAction\fR flags.
.SS LISTVOLUMESPROC
@@ -1181,18 +1341,20 @@ Should be implemented only if the filesystem adds volumes at the head
of the filesystem, so that they can be returned by \fBfile volumes\fR.
.PP
.CS
-typedef Tcl_Obj* Tcl_FSListVolumesProc(void);
+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
-choose whether they actually want to retain a 'master list' of volumes
+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
@@ -1200,25 +1362,25 @@ Therefore, Tcl considers return values from this proc to be read-only.
.SS FILEATTRSTRINGSPROC
.PP
Function to list all attribute strings which are valid for this
-filesystem. If not implemented the filesystem will not support
-the \fBfile attributes\fR command. This allows arbitrary additional
-information to be attached to files in the filesystem. If it is
+filesystem. If not implemented the filesystem will not support
+the \fBfile attributes\fR command. This allows arbitrary additional
+information to be attached to files in the filesystem. If it is
not implemented, there is no need to implement the \fBget\fR and \fBset\fR
methods.
.PP
.CS
-typedef const char** Tcl_FSFileAttrStringsProc(
+typedef const char *const *\fBTcl_FSFileAttrStringsProc\fR(
Tcl_Obj *\fIpathPtr\fR,
- Tcl_Obj** \fIobjPtrRef\fR);
+ Tcl_Obj **\fIobjPtrRef\fR);
.CE
.PP
The called function may either return an array of strings, or may
-instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
+instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
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
+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 refererence count
+filesystem should ensure it returns a value with a reference count
of at least one.
.SS FILEATTRSGETPROC
.PP
@@ -1226,27 +1388,27 @@ Function to process a \fBTcl_FSFileAttrsGet\fR call, used by \fBfile
attributes\fR.
.PP
.CS
-typedef int Tcl_FSFileAttrsGetProc(
+typedef int \fBTcl_FSFileAttrsGetProc\fR(
Tcl_Interp *\fIinterp\fR,
int \fIindex\fR,
Tcl_Obj *\fIpathPtr\fR,
Tcl_Obj **\fIobjPtrRef\fR);
.CE
.PP
-Returns a standard Tcl return code. The attribute value retrieved,
+Returns a standard Tcl return code. The attribute value retrieved,
which corresponds to the \fIindex\fR'th element in the list returned by
the \fBTcl_FSFileAttrStringsProc\fR, is a Tcl_Obj placed in \fIobjPtrRef\fR (if
-\fBTCL_OK\fR was returned) and is likely to have a reference count of zero. Either
-way we must either store it somewhere (e.g. the Tcl result), or
+\fBTCL_OK\fR was returned) and is likely to have a reference count of zero. Either
+way we must either store it somewhere (e.g.\ the Tcl result), or
Incr/Decr its reference count to ensure it is properly freed.
.SS FILEATTRSSETPROC
.PP
Function to process a \fBTcl_FSFileAttrsSet\fR call, used by \fBfile
-attributes\fR. If the filesystem is read-only, there is no need
+attributes\fR. If the filesystem is read-only, there is no need
to implement this.
.PP
.CS
-typedef int Tcl_FSFileAttrsSetProc(
+typedef int \fBTcl_FSFileAttrsSetProc\fR(
Tcl_Interp *\fIinterp\fR,
int \fIindex\fR,
Tcl_Obj *\fIpathPtr\fR,
@@ -1257,51 +1419,53 @@ The attribute value of the \fIindex\fR'th element in the list returned by
the Tcl_FSFileAttrStringsProc should be set to the \fIobjPtr\fR given.
.SS CREATEDIRECTORYPROC
.PP
-Function to process a \fBTcl_FSCreateDirectory\fR call. Should be
+Function to process a \fBTcl_FSCreateDirectory\fR call. Should be
implemented unless the FS is read-only.
.PP
.CS
-typedef int Tcl_FSCreateDirectoryProc(
+typedef int \fBTcl_FSCreateDirectoryProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the process. If successful, a new directory should have
+occurred in the process. If successful, a new directory should have
been added to the filesystem in the location specified by
\fIpathPtr\fR.
.SS REMOVEDIRECTORYPROC
.PP
-Function to process a \fBTcl_FSRemoveDirectory\fR call. Should be
+Function to process a \fBTcl_FSRemoveDirectory\fR call. Should be
implemented unless the FS is read-only.
.PP
.CS
-typedef int Tcl_FSRemoveDirectoryProc(
+typedef int \fBTcl_FSRemoveDirectoryProc\fR(
Tcl_Obj *\fIpathPtr\fR,
int \fIrecursive\fR,
Tcl_Obj **\fIerrorPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the process. If successful, the directory specified by
-\fIpathPtr\fR should have been removed from the filesystem. If the
+occurred in the process. If successful, the directory specified by
+\fIpathPtr\fR should have been removed from the filesystem. If the
\fIrecursive\fR flag is given, then a non-empty directory should be
-deleted without error. If this flag is not given, then and the
-directory is non-empty a POSIX 'EEXIST' error should be signalled. If an
+deleted without error. If this flag is not given, then and the
+directory is non-empty a POSIX
+.QW EEXIST
+error should be signaled. If an
error does occur, the name of the file or directory which caused the
error should be placed in \fIerrorPtr\fR.
.SS DELETEFILEPROC
.PP
-Function to process a \fBTcl_FSDeleteFile\fR call. Should be implemented
+Function to process a \fBTcl_FSDeleteFile\fR call. Should be implemented
unless the FS is read-only.
.PP
.CS
-typedef int Tcl_FSDeleteFileProc(
+typedef int \fBTcl_FSDeleteFileProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the process. If successful, the file specified by
-\fIpathPtr\fR should have been removed from the filesystem. Note that,
+occurred in the process. If successful, the file specified by
+\fIpathPtr\fR should have been removed from the filesystem. Note that,
if the filesystem supports symbolic links, Tcl will always call this
function and not Tcl_FSRemoveDirectoryProc when needed to delete them
(even if they are symbolic links to directories).
@@ -1312,13 +1476,13 @@ because the core has a fallback implementation available. See each
individual description for the consequences of leaving the field NULL.
.SS LSTATPROC
.PP
-Function to process a \fBTcl_FSLstat\fR call. If not implemented, Tcl
-will attempt to use the \fIstatProc\fR defined above instead. Therefore
+Function to process a \fBTcl_FSLstat\fR call. If not implemented, Tcl
+will attempt to use the \fIstatProc\fR defined above instead. Therefore
it need only be implemented if a filesystem can differentiate between
\fBstat\fR and \fBlstat\fR calls.
.PP
.CS
-typedef int Tcl_FSLstatProc(
+typedef int \fBTcl_FSLstatProc\fR(
Tcl_Obj *\fIpathPtr\fR,
Tcl_StatBuf *\fIstatPtr\fR);
.CE
@@ -1329,153 +1493,152 @@ to a symbolic link, it returns information about the link, not
about the target file.
.SS COPYFILEPROC
.PP
-Function to process a \fBTcl_FSCopyFile\fR call. If not implemented Tcl
+Function to process a \fBTcl_FSCopyFile\fR call. If not implemented Tcl
will fall back on \fBopen\fR-r, \fBopen\fR-w and \fBfcopy\fR as a
copying mechanism.
Therefore it need only be implemented if the filesystem can perform
that action more efficiently.
.PP
.CS
-typedef int Tcl_FSCopyFileProc(
+typedef int \fBTcl_FSCopyFileProc\fR(
Tcl_Obj *\fIsrcPathPtr\fR,
Tcl_Obj *\fIdestPathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the copying process. Note that, \fIdestPathPtr\fR is the
+occurred in the copying process. Note that, \fIdestPathPtr\fR is the
name of the file which should become the copy of \fIsrcPathPtr\fR. It
is never the name of a directory into which \fIsrcPathPtr\fR could be
-copied (i.e. the function is much simpler than the Tcl level \fBfile
-copy\fR subcommand). Note that,
+copied (i.e.\ the function is much simpler than the Tcl level \fBfile
+copy\fR subcommand). Note that,
if the filesystem supports symbolic links, Tcl will always call this
function and not \fIcopyDirectoryProc\fR when needed to copy them
-(even if they are symbolic links to directories). Finally, if the
+(even if they are symbolic links to directories). Finally, if the
filesystem determines it cannot support the \fBfile copy\fR action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS RENAMEFILEPROC
.PP
-Function to process a \fBTcl_FSRenameFile\fR call. If not implemented,
-Tcl will fall back on a copy and delete mechanism. Therefore it need
+Function to process a \fBTcl_FSRenameFile\fR call. If not implemented,
+Tcl will fall back on a copy and delete mechanism. Therefore it need
only be implemented if the filesystem can perform that action more
efficiently.
.PP
.CS
-typedef int Tcl_FSRenameFileProc(
+typedef int \fBTcl_FSRenameFileProc\fR(
Tcl_Obj *\fIsrcPathPtr\fR,
Tcl_Obj *\fIdestPathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the renaming process. If the
+occurred in the renaming process. If the
filesystem determines it cannot support the \fBfile rename\fR action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS COPYDIRECTORYPROC
.PP
-Function to process a \fBTcl_FSCopyDirectory\fR call. If not
+Function to process a \fBTcl_FSCopyDirectory\fR call. If not
implemented, Tcl will fall back on a recursive \fBfile mkdir\fR, \fBfile copy\fR
-mechanism. Therefore it need only be implemented if the filesystem can
+mechanism. Therefore it need only be implemented if the filesystem can
perform that action more efficiently.
.PP
.CS
-typedef int Tcl_FSCopyDirectoryProc(
+typedef int \fBTcl_FSCopyDirectoryProc\fR(
Tcl_Obj *\fIsrcPathPtr\fR,
Tcl_Obj *\fIdestPathPtr\fR,
Tcl_Obj **\fIerrorPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in the copying process. If an error does occur, the name of
+occurred in the copying process. If an error does occur, the name of
the file or directory which caused the error should be placed in
\fIerrorPtr\fR. Note that, \fIdestPathPtr\fR is the name of the
directory-name which should become the mirror-image of
\fIsrcPathPtr\fR. It is not the name of a directory into which
-\fIsrcPathPtr\fR should be copied (i.e. the function is much simpler
-than the Tcl level \fBfile copy\fR subcommand). Finally, if the
+\fIsrcPathPtr\fR should be copied (i.e.\ the function is much simpler
+than the Tcl level \fBfile copy\fR subcommand). Finally, if the
filesystem determines it cannot support the directory copy action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS LOADFILEPROC
.PP
-Function to process a \fBTcl_FSLoadFile\fR call. If not implemented, Tcl
+Function to process a \fBTcl_FSLoadFile\fR call. If not implemented, Tcl
will fall back on a copy to native-temp followed by a \fBTcl_FSLoadFile\fR on
-that temporary copy. Therefore it need only be implemented if the
+that temporary copy. Therefore it need only be implemented if the
filesystem can load code directly, or it can be implemented simply to
return \fBTCL_ERROR\fR to disable load functionality in this filesystem
entirely.
.PP
.CS
-typedef int Tcl_FSLoadFileProc(
+typedef int \fBTcl_FSLoadFileProc\fR(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIpathPtr\fR,
Tcl_LoadHandle *\fIhandlePtr\fR,
Tcl_FSUnloadFileProc *\fIunloadProcPtr\fR);
.CE
.PP
-Returns a standard Tcl completion code. If an error occurs, an error
-message is left in the \fIinterp\fR's result. The function dynamically loads a
-binary code file into memory. On a successful load, the \fIhandlePtr\fR
+Returns a standard Tcl completion code. If an error occurs, an error
+message is left in the \fIinterp\fR's result. The function dynamically loads a
+binary code file into memory. On a successful load, the \fIhandlePtr\fR
should be filled with a token for the dynamically loaded file, and the
\fIunloadProcPtr\fR should be filled in with the address of a procedure.
The unload procedure will be called with the given \fBTcl_LoadHandle\fR as its
-only parameter when Tcl needs to unload the file. For example, for the
+only parameter when Tcl needs to unload the file. For example, for the
native filesystem, the \fBTcl_LoadHandle\fR returned is currently a token
which can be used in the private \fBTclpFindSymbol\fR to access functions
-in the new code. Each filesystem is free to define the
-\fBTcl_LoadHandle\fR as it requires. Finally, if the
+in the new code. Each filesystem is free to define the
+\fBTcl_LoadHandle\fR as it requires. Finally, if the
filesystem determines it cannot support the file load action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS UNLOADFILEPROC
.PP
-Function to unload a previously successfully loaded file. If load was
+Function to unload a previously successfully loaded file. If load was
implemented, then this should also be implemented, if there is any
cleanup action required.
.PP
.CS
-typedef void Tcl_FSUnloadFileProc(
+typedef void \fBTcl_FSUnloadFileProc\fR(
Tcl_LoadHandle \fIloadHandle\fR);
.CE
-.SS GETCWDPROC
+.SS GETCWDPROC
.PP
-Function to process a \fBTcl_FSGetCwd\fR call. Most filesystems need not
-implement this. It will usually only be called once, if \fBgetcwd\fR is
-called before \fBchdir\fR. May be NULL.
+Function to process a \fBTcl_FSGetCwd\fR call. Most filesystems need not
+implement this. It will usually only be called once, if \fBgetcwd\fR is
+called before \fBchdir\fR. May be NULL.
.PP
.CS
-typedef Tcl_Obj* Tcl_FSGetCwdProc(
+typedef Tcl_Obj *\fBTcl_FSGetCwdProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
If the filesystem supports a native notion of a current working
directory (which might perhaps change independent of Tcl), this
function should return that cwd as the result, or NULL if the current
-directory could not be determined (e.g. the user does not have
-appropriate permissions on the cwd directory). If NULL is returned, an
+directory could not be determined (e.g.\ the user does not have
+appropriate permissions on the cwd directory). If NULL is returned, an
error message is left in the \fIinterp\fR's result.
.SS CHDIRPROC
.PP
-Function to process a \fBTcl_FSChdir\fR call. If filesystems do not
+Function to process a \fBTcl_FSChdir\fR call. If filesystems do not
implement this, it will be emulated by a series of directory access
-checks. Otherwise, virtual filesystems which do implement it need only
+checks. Otherwise, virtual filesystems which do implement it need only
respond with a positive return result if the \fIpathPtr\fR is a valid,
-accessible directory in their filesystem. They need not remember the
+accessible directory in their filesystem. They need not remember the
result, since that will be automatically remembered for use by
\fBTcl_FSGetCwd\fR.
-Real filesystems should carry out the correct action (i.e. call the
+Real filesystems should carry out the correct action (i.e.\ call the
correct system \fBchdir\fR API).
.PP
.CS
-typedef int Tcl_FSChdirProc(
+typedef int \fBTcl_FSChdirProc\fR(
Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The \fBTcl_FSChdirProc\fR changes the applications current working
directory to the value specified in \fIpathPtr\fR. The function returns
-1 on error or 0 on success.
-
-.SH KEYWORDS
-stat, access, filesystem, vfs, virtual
.SH "SEE ALSO"
-cd(n), file(n), load(n), open(n), pwd(n), unload(n)
+cd(n), file(n), filename(n), load(n), open(n), pwd(n), source(n), unload(n)
+.SH KEYWORDS
+stat, access, filesystem, vfs, virtual filesystem
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index 10a3c72..b01315c 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -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.
'\"
-'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
@@ -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 554d6e3..58abcde 100755..100644
--- a/doc/GetCwd.3
+++ b/doc/GetCwd.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: GetCwd.3,v 1.6 2004/10/07 14:44:32 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory
@@ -41,7 +39,7 @@ the same functionality as the Tcl \fBpwd\fR command.
.PP
\fBTcl_GetCwd\fR returns a pointer to a string specifying the current
directory, or NULL if the current directory could not be determined.
-If NULL is returned, an error message is left in the interp's result.
+If NULL is returned, an error message is left in the \fIinterp\fR's result.
Storage for the result string is allocated in bufferPtr; the caller
must call \fBTcl_DStringFree()\fR when the result is no longer needed.
The format of the path is UTF\-8.
diff --git a/doc/GetHostName.3 b/doc/GetHostName.3
index 37252dc..8aed0dc 100644
--- a/doc/GetHostName.3
+++ b/doc/GetHostName.3
@@ -2,10 +2,8 @@
'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_GetHostName \- get the name of the local host
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index f476ea5..fc6f40b 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: GetIndex.3,v 1.18 2005/05/10 18:33:56 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords
@@ -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" **tablePtr in
+.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\fP type.
+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\fP.
+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.
@@ -51,16 +55,15 @@ operation. The only bit that is currently defined is \fBTCL_EXACT\fR.
The index of the string in \fItablePtr\fR that matches the value of
\fIobjPtr\fR is returned here.
.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 unique abbreviation
+\fItablePtr\fR, or if it is a non-empty unique abbreviation
for exactly one of the strings in \fItablePtr\fR and the
\fBTCL_EXACT\fR flag was not specified; in either case
the index of the matching entry is stored at \fI*indexPtr\fR
@@ -68,10 +71,10 @@ and \fBTCL_OK\fR is returned.
.PP
If there is no matching entry,
\fBTCL_ERROR\fR is returned and an error message is left in \fIinterp\fR's
-result if \fIinterp\fR isn't NULL. \fIMsg\fR is included in the
+result if \fIinterp\fR is not NULL. \fIMsg\fR is included in the
error message to indicate what was being looked up. For example,
if \fImsg\fR is \fBoption\fR the error message will have a form like
-\fBbad option "firt": must be first, second, or third\fR.
+.QW "\fBbad option \N'34'firt\N'34': must be first, second, or third\fR" .
.PP
If \fBTcl_GetIndexFromObj\fR completes successfully it modifies the
internal representation of \fIobjPtr\fR to hold the address of
@@ -95,9 +98,7 @@ array of characters at \fItablePtr\fR+\fIoffset\fR bytes, etc.)
This is particularly useful when processing things like
\fBTk_ConfigurationSpec\fR, whose string keys are in the same place in
each of several array elements.
-
.SH "SEE ALSO"
-Tcl_WrongNumArgs
-
+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 83cd2d6..4e9d636 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -5,10 +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: GetInt.3,v 1.10 2005/05/10 18:33:56 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean
@@ -47,7 +45,7 @@ integers). Each of the procedures takes a \fIsrc\fR argument,
converts it to an internal form of a particular type, and stores
the converted value at the location indicated by the procedure's
third argument. If all goes well, each of the procedures returns
-\fBTCL_OK\fR. If \fIsrc\fR doesn't have the proper syntax for the
+\fBTCL_OK\fR. If \fIsrc\fR does not have the proper syntax for the
desired type then \fBTCL_ERROR\fR is returned, an error message is left
in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
@@ -55,20 +53,25 @@ or *\fIdoublePtr\fR or *\fIboolPtr\fR.
\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded by
white space. If the first two characters of \fIsrc\fR
-after the optional white space and sign are ``0x''
+after the optional white space and sign are
+.QW 0x
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
-if the first such character is ``0'' then \fIsrc\fR
+if the first such character is
+.QW 0
+then \fIsrc\fR
is expected to be in octal form; otherwise, \fIsrc\fR is
expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
-decimal point; a sequence of digits; the letter ``e''; a
-signed decimal exponent ; and more white space.
+decimal point; a sequence of digits; the letter
+.QW e ;
+a signed decimal exponent; and more white space.
Any of the fields may be omitted, except that
the digits either before or after the decimal point must be present
-and if the ``e'' is present then it must be followed by the
-exponent number.
+and if the
+.QW e
+is present then it must be followed by the exponent number.
.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3
index 7524aeb..86d1b94 100644
--- a/doc/GetOpnFl.3
+++ b/doc/GetOpnFl.3
@@ -4,9 +4,8 @@
'\" 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.11 2005/05/10 18:33:56 kennykb Exp $
-.so man.macros
.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpreter (Unix only)
@@ -27,7 +26,7 @@ String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
Non-zero means the file will be used for writing, zero means it will
be used for reading.
.AP int checkUsage in
-If non-zero, then an error will be generated if the file wasn't opened
+If non-zero, then an error will be generated if the file was not opened
for the access indicated by \fIwrite\fR.
.AP ClientData *filePtr out
Points to word in which to store pointer to FILE structure for
@@ -46,8 +45,8 @@ In some cases, such as a channel that connects to a pipeline of
subprocesses, different FILE pointers will be returned for reading
and writing.
\fBTcl_GetOpenFile\fR normally returns \fBTCL_OK\fR.
-If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIchanID\fR didn't
-make any sense or \fIcheckUsage\fR was set and the file wasn't opened
+If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIchanID\fR did not
+make any sense or \fIcheckUsage\fR was set and the file was not opened
for the access specified by \fIwrite\fR) then \fBTCL_ERROR\fR is returned
and the interpreter's result will contain an error message.
In the current implementation \fIcheckUsage\fR is ignored and consistency
diff --git a/doc/GetStdChan.3 b/doc/GetStdChan.3
index cf17650..8af1e7e 100644
--- a/doc/GetStdChan.3
+++ b/doc/GetStdChan.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: GetStdChan.3,v 1.5 2004/10/07 14:44:32 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -53,6 +51,18 @@ by calling \fBTcl_SetStdChannel\fR with a new channel or NULL in the
\fBTcl_Close\fR, then the corresponding standard channel will automatically be
set to NULL.
.PP
+If a non-NULL value for \fIchannel\fR is passed to \fBTcl_SetStdChannel\fR,
+then that same value should be passed to \fBTcl_RegisterChannel\fR, like so:
+.PP
+.CS
+Tcl_RegisterChannel(NULL, channel);
+.CE
+.PP
+This is a workaround for a misfeature in \fBTcl_SetStdChannel\fR that it
+fails to do some reference counting housekeeping. This misfeature cannot
+be corrected without contradicting the assumptions of some existing
+code that calls \fBTcl_SetStdChannel\fR.
+.PP
If \fBTcl_GetStdChannel\fR is called before \fBTcl_SetStdChannel\fR, Tcl will
construct a new channel to wrap the appropriate platform-specific standard
file handle. If \fBTcl_SetStdChannel\fR is called before
@@ -67,8 +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.
-.PP
+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 22ffc53..6b885ee 100644
--- a/doc/GetTime.3
+++ b/doc/GetTime.3
@@ -1,16 +1,14 @@
'\"
-'\" Copyright (c) 2001 by Kevin B. Kenny.
+'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.
'\"
'\" 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"
+.so man.macros
.BS
.SH NAME
-Tcl_GetTime \- get date and time
+Tcl_GetTime, Tcl_SetTimeProc, Tcl_QueryTimeProc \- get date and time
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,27 +19,21 @@ Tcl_GetTime \- get date and time
.sp
\fBTcl_QueryTimeProc\fR(\fIgetProcPtr, scaleProcPtr, clientDataPtr\fR)
.SH ARGUMENTS
-.AS "Tcl_Time *" timePtr out
-.AP "Tcl_Time *" timePtr out
+.AS Tcl_GetTimeProc *getProc in
+.AP Tcl_Time *timePtr out
Points to memory in which to store the date and time information.
-.AS "Tcl_GetTimeProc *" getProc in
-.AP "Tcl_GetTimeProc *" getProc in
-Pointer to handler function replacing Tcl_GetTime's access to the OS.
-.AS "Tcl_ScaleTimeProc *" scaleProc in
-.AP "Tcl_ScaleTimeProc *" scaleProc in
+.AP Tcl_GetTimeProc getProc in
+Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
+.AP Tcl_ScaleTimeProc scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
-.AS "ClientData *" clientData in
-.AP "ClientData *" clientData in
+.AP ClientData clientData in
Value passed through to the two handler functions.
-.AS "Tcl_GetTimeProc **" getProcPtr inout
-.AP "Tcl_GetTimeProc **" getProcPtr inout
+.AP Tcl_GetTimeProc *getProcPtr out
Pointer to place the currently registered get handler function into.
-.AS "Tcl_ScaleTimeProc **" scaleProcPtr inout
-.AP "Tcl_ScaleTimeProc **" scaleProcPtr inout
+.AP Tcl_ScaleTimeProc *scaleProcPtr out
Pointer to place the currently registered scale handler function into.
-.AS "ClientData **" clientDataPtr inout
-.AP "ClientData **" clientDataPtr inout
+.AP ClientData *clientDataPtr out
Pointer to place the currently registered pass-through value into.
.BE
.SH DESCRIPTION
@@ -49,11 +41,12 @@ Pointer to place the currently registered pass-through value into.
The \fBTcl_GetTime\fR function retrieves the current time as a
\fITcl_Time\fR structure in memory the caller provides. This
structure has the following definition:
+.PP
.CS
typedef struct Tcl_Time {
- long sec;
- long usec;
-} Tcl_Time;
+ long \fIsec\fR;
+ long \fIusec\fR;
+} \fBTcl_Time\fR;
.CE
.PP
On return, the \fIsec\fR member of the structure is filled in with the
@@ -70,33 +63,47 @@ computer system. On multiprocessor variants of Windows, this number
may be limited to the 10- or 20-ms granularity of the system clock.
(On single-processor Windows systems, the \fIusec\fR field is derived
from a performance counter and is highly precise.)
+.SS "VIRTUALIZED TIME"
.PP
-The \fBTcl_SetTime\fR function registers two related handler functions
+The \fBTcl_SetTimeProc\fR function registers two related handler functions
with the core. The first handler function is a replacement for
\fBTcl_GetTime\fR, or rather the OS access made by
\fBTcl_GetTime\fR. The other handler function is used by the Tcl
notifier to convert wait/block times from the virtual domain into real
time.
.PP
-The \fBTcl_QueryTime\fR function returns the currently registered
+The \fBTcl_QueryTimeProc\fR function returns the currently registered
handler functions. If no external handlers were set then this will
return the standard handlers accessing and processing the native time
of the OS. The arguments to the function are allowed to be NULL; and
any argument which is NULL is ignored and not set.
.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.
+The signatures of the handler functions are as follows:
+.PP
+.CS
+typedef void \fBTcl_GetTimeProc\fR(
+ Tcl_Time *\fItimebuf\fR,
+ ClientData \fIclientData\fR);
+typedef void \fBTcl_ScaleTimeProc\fR(
+ Tcl_Time *\fItimebuf\fR,
+ ClientData \fIclientData\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.
+.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.
.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
+clock(n)
.SH KEYWORDS
date, time
diff --git a/doc/GetVersion.3 b/doc/GetVersion.3
index 8082425..89f63d5 100755..100644
--- a/doc/GetVersion.3
+++ b/doc/GetVersion.3
@@ -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.
'\"
-'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_GetVersion \- get the version of the library at runtime
diff --git a/doc/Hash.3 b/doc/Hash.3
index d21ba2b..fcc0d83a 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -5,10 +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: Hash.3,v 1.18 2004/10/07 16:05:14 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
@@ -37,7 +35,7 @@ ClientData
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
-char *
+void *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp
Tcl_HashEntry *
@@ -46,10 +44,10 @@ Tcl_HashEntry *
Tcl_HashEntry *
\fBTcl_NextHashEntry\fR(\fIsearchPtr\fR)
.sp
-const char *
+char *
\fBTcl_HashStats\fR(\fItablePtr\fR)
.SH ARGUMENTS
-.AS Tcl_HashKeyType *searchPtr out
+.AS "const Tcl_HashKeyType" *searchPtr out
.AP Tcl_HashTable *tablePtr in
Address of hash table structure (for all procedures but
\fBTcl_InitHashTable\fR, this must have been initialized by
@@ -59,8 +57,8 @@ 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.
-.AP "const char" *key in
+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.
.AP int *newPtr out
@@ -83,12 +81,14 @@ very quickly locate the entry, and hence its value. There may be at
most one entry in a hash table with a particular key, but many entries
may have the same value. Keys can take one of four forms: strings,
one-word values, integer arrays, or custom keys defined by a
-Tcl_HashKeyType structure (See section \fBTHE TCL_HASHKEYTYPE
-STRUCTURE\fR below). All of the keys in a given table have the same
+Tcl_HashKeyType structure (See section \fBTHE TCL_HASHKEYTYPE STRUCTURE\fR
+below). All of the keys in a given table have the same
form, which is specified when the table is initialized.
.PP
The value of a hash table entry can be anything that fits in the same
-space as a ``char *'' pointer. Values for hash table entries are
+space as a
+.QW "char *"
+pointer. Values for hash table entries are
managed entirely by clients, not by the hash module itself. Typically
each entry's value is a pointer to a data structure managed by client
code.
@@ -124,8 +124,10 @@ They are passed to hashing routines using the address of the
first character of the string.
.IP \fBTCL_ONE_WORD_KEYS\fR 25
Keys are single-word values; they are passed to hashing routines
-and stored in hash table entries as ``char *'' values.
-The pointer value is the key; it need not (and usually doesn't)
+and stored in hash table entries as
+.QW "char *"
+values.
+The pointer value is the key; it need not (and usually does not)
actually point to a string.
.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
Keys are of arbitrary type, and are stored in the entry. Hashing
@@ -140,7 +142,9 @@ structure is described in the section
.IP \fIother\fR 25
If \fIkeyType\fR is not one of the above,
then it must be an integer value greater than 1.
-In this case the keys will be arrays of ``int'' values, where
+In this case the keys will be arrays of
+.QW int
+values, where
\fIkeyType\fR gives the number of ints in each key.
This allows structures to be used as keys.
All keys must have the same size.
@@ -161,7 +165,7 @@ before deleting the table.
.PP
\fBTcl_CreateHashEntry\fR locates the entry corresponding to a
particular key, creating a new entry in the table if there
-wasn't already one with the given key.
+was not already one with the given key.
If an entry already existed with the given key then \fI*newPtr\fR
is set to zero.
If a new entry was created, then \fI*newPtr\fR is set to a non-zero
@@ -177,28 +181,34 @@ the client is responsible for any cleanup associated with the
entry's value, such as freeing a structure that it points to.
.PP
\fBTcl_FindHashEntry\fR is similar to \fBTcl_CreateHashEntry\fR
-except that it doesn't create a new entry if the key doesn't exist;
+except that it does not create a new entry if the key doesn't exist;
instead, it returns NULL as result.
.PP
\fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to
read and write an entry's value, respectively.
-Values are stored and retrieved as type ``ClientData'', which is
+Values are stored and retrieved as type
+.QW ClientData ,
+which is
large enough to hold a pointer value. On almost all machines this is
large enough to hold an integer value too.
.PP
\fBTcl_GetHashKey\fR returns the key for a given hash table entry,
-either as a pointer to a string, a one-word (``char *'') key, or
+either as a pointer to a string, a one-word
+.PQ "char *"
+key, or
as a pointer to the first word of an array of integers, depending
on the \fIkeyType\fR used to create a hash table.
In all cases \fBTcl_GetHashKey\fR returns a result with type
-``char *''.
+.QW "char *" .
When the key is a string or array, the result of \fBTcl_GetHashKey\fR
points to information in the table entry; this information will
remain valid until the entry is deleted or its table is deleted.
.PP
\fBTcl_FirstHashEntry\fR and \fBTcl_NextHashEntry\fR may be used
to scan all of the entries in a hash table.
-A structure of type ``Tcl_HashSearch'', provided by the client,
+A structure of type
+.QW Tcl_HashSearch ,
+provided by the client,
is used to keep track of progress through the table.
\fBTcl_FirstHashEntry\fR initializes the search record and
returns the first entry in the table (or NULL if the table is
@@ -209,7 +219,7 @@ NULL if the end of the table has been reached.
A call to \fBTcl_FirstHashEntry\fR followed by calls to
\fBTcl_NextHashEntry\fR will return each of the entries in
the table exactly once, in an arbitrary order.
-It is unadvisable to modify the structure of the table, e.g.
+It is inadvisable to modify the structure of the table, e.g.
by creating or deleting entries, while the search is in progress,
with the exception of deleting the entry returned by
\fBTcl_FirstHashEntry\fR or \fBTcl_NextHashEntry\fR.
@@ -231,10 +241,11 @@ to any of the fields of any of the hash-related data structures;
use the procedures and macros defined here.
.SH "THE TCL_HASHKEYTYPE STRUCTURE"
.PP
-Extension writers can define new hash key types by defining four
-procedures, initializing a Tcl_HashKeyType structure to describe
-the type, and calling \fBTcl_InitCustomHashTable\fR.
-The \fBTcl_HashKeyType\fR structure is defined as follows:
+Extension writers can define new hash key types by defining four procedures,
+initializing a \fBTcl_HashKeyType\fR structure to describe the type, and
+calling \fBTcl_InitCustomHashTable\fR. The \fBTcl_HashKeyType\fR structure is
+defined as follows:
+.PP
.CS
typedef struct Tcl_HashKeyType {
int \fIversion\fR;
@@ -243,77 +254,81 @@ typedef struct Tcl_HashKeyType {
Tcl_CompareHashKeysProc *\fIcompareKeysProc\fR;
Tcl_AllocHashEntryProc *\fIallocEntryProc\fR;
Tcl_FreeHashEntryProc *\fIfreeEntryProc\fR;
-} Tcl_HashKeyType;
+} \fBTcl_HashKeyType\fR;
.CE
.PP
-The \fIversion\fR member is the version of the table. If this
-structure is extended in future then the version can be used
-to distinguish between different structures. It should be set
-to \fBTCL_HASH_KEY_TYPE_VERSION\fR.
+The \fIversion\fR member is the version of the table. If this structure is
+extended in future then the version can be used to distinguish between
+different structures. It should be set to \fBTCL_HASH_KEY_TYPE_VERSION\fR.
.PP
-The \fIflags\fR member is one or more of the following values OR'ed together:
+The \fIflags\fR member is 0 or one or more of the following values OR'ed
+together:
.IP \fBTCL_HASH_KEY_RANDOMIZE_HASH\fR 25
-There are some things, pointers for example which don't hash well
-because they do not use the lower bits. If this flag is set then the
-hash table will attempt to rectify this by randomizing the bits and
-then using the upper N bits as the index into the table.
+There are some things, pointers for example which do not hash well because
+they do not use the lower bits. If this flag is set then the hash table will
+attempt to rectify this by randomizing the bits and then using the upper N
+bits as the index into the table.
.IP \fBTCL_HASH_KEY_SYSTEM_HASH\fR 25
-.VS 8.5
-This flag forces Tcl to use the memory allocation
-procedures provided by the operating system when allocating
-and freeing memory used to store the hash table data structures,
-and not any of Tcl's own customized memory allocation routines.
-This is important if the hash table is to be used in the
-implementation of a custom set of allocation routines, or something
-that a custom set of allocation routines might depend on, in
-order to avoid any circular dependency.
-.VE 8.5
-.PP
-The \fIhashKeyProc\fR member contains the address of a function
-called to calculate a hash value for the key.
+This flag forces Tcl to use the memory allocation procedures provided by the
+operating system when allocating and freeing memory used to store the hash
+table data structures, and not any of Tcl's own customized memory allocation
+routines. This is important if the hash table is to be used in the
+implementation of a custom set of allocation routines, or something that a
+custom set of allocation routines might depend on, in order to avoid any
+circular dependency.
+.PP
+The \fIhashKeyProc\fR member contains the address of a function called to
+calculate a hash value for the key.
+.PP
.CS
-typedef unsigned int (Tcl_HashKeyProc) (
+typedef unsigned int \fBTcl_HashKeyProc\fR(
Tcl_HashTable *\fItablePtr\fR,
void *\fIkeyPtr\fR);
.CE
-If this is NULL then \fIkeyPtr\fR is used and
+.PP
+If this is NULL then \fIkeyPtr\fR is used and
\fBTCL_HASH_KEY_RANDOMIZE_HASH\fR is assumed.
.PP
-The \fIcompareKeysProc\fR member contains the address of a function
-called to compare two keys.
+The \fIcompareKeysProc\fR member contains the address of a function called to
+compare two keys.
+.PP
.CS
-typedef int (Tcl_CompareHashKeysProc) (
+typedef int \fBTcl_CompareHashKeysProc\fR(
void *\fIkeyPtr\fR,
Tcl_HashEntry *\fIhPtr\fR);
.CE
-If this is NULL then the \fIkeyPtr\fR pointers are compared.
-If the keys don't match then the function returns 0, otherwise
-it returns 1.
.PP
-The \fIallocEntryProc\fR member contains the address of a function
-called to allocate space for an entry and initialize the key.
+If this is NULL then the \fIkeyPtr\fR pointers are compared. If the keys do
+not match then the function returns 0, otherwise it returns 1.
+.PP
+The \fIallocEntryProc\fR member contains the address of a function called to
+allocate space for an entry and initialize the key and clientData.
+.PP
.CS
-typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) (
+typedef Tcl_HashEntry *\fBTcl_AllocHashEntryProc\fR(
Tcl_HashTable *\fItablePtr\fR,
void *\fIkeyPtr\fR);
.CE
-If this is NULL then Tcl_Alloc is used to allocate enough space for a
-Tcl_HashEntry and the key pointer is assigned to key.oneWordValue.
-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.
-If
-.PP
-The \fIfreeEntryProc\fR member contains the address of a function
-called to free space for an entry.
+.PP
+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
+value.
+.PP
+The \fIfreeEntryProc\fR member contains the address of a function called to
+free space for an entry.
+.PP
.CS
-typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *\fIhPtr\fR);
+typedef void \fBTcl_FreeHashEntryProc\fR(
+ Tcl_HashEntry *\fIhPtr\fR);
.CE
-If this is NULL then Tcl_Free is used to free the space for the
-entry. Tcl_Obj * keys use this function to decrement the
-reference count on the object.
+.PP
+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
+value.
.SH KEYWORDS
hash table, key, lookup, search, value
diff --git a/doc/Init.3 b/doc/Init.3
index f293755..33c27a3 100644
--- a/doc/Init.3
+++ b/doc/Init.3
@@ -2,10 +2,8 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: Init.3,v 1.3 2004/10/07 15:37:43 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script
@@ -23,7 +21,7 @@ Interpreter to initialize.
.SH DESCRIPTION
.PP
-\fBTcl_Init\fR is a helper procedure that finds and \fBsource\fR's the
+\fBTcl_Init\fR is a helper procedure that finds and \fBsource\fRs the
\fBinit.tcl\fR script, which should exist somewhere on the Tcl library
path.
.PP
diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 0c42814..73c3437 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -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.
'\"
-'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_InitStubs \- initialize the Tcl stubs mechanism
@@ -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.6 ABI on Unix platforms,
+the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the
+library name is \fItclstub86.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 3bdac48..d42b44a 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.8 2005/05/10 18:33:56 kennykb Exp $
-'\"
+.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
-.TH Tcl_IntObj 3 8.0 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 \- manipulate Tcl objects as integers and wide integers
+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
@@ -38,92 +36,117 @@ int
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
+.sp
+.sp
+\fB#include <tclTomMath.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewBignumObj\fR(\fIbigValue\fR)
+.sp
+\fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR)
+.sp
+int
+\fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
+.sp
+int
+\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
+.sp
+int
+\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
-.AS Tcl_WideInt longValue in/out
+.AS Tcl_WideInt doubleValue in/out
.AP int intValue in
-Integer value used to initialize or set an integer object.
+Integer value used to initialize or set a Tcl value.
.AP long longValue in
-Long integer value used to initialize or set an integer object.
+Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
-Wide integer value (minimum 64-bits wide where supported by the
-compiler) used to initialize or set a wide integer 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, and
-\fBTcl_SetWideIntObj\fR, this points to the object to be converted to
-integer type. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
-and \fBTcl_GetWideIntFromObj\fR, this refers to the object from which
-to get an integer or long integer value; if \fIobjPtr\fR does not
-already point to an integer object (or a wide integer object in the
-case of \fBTcl_SetWideIntObj\fR and \fBTcl_GetWideIntFromObj\fR), an
-attempt will be made to convert it to one.
+For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR,
+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 value from which
+to retrieve an integral value.
.AP Tcl_Interp *interp in/out
-If an error occurs during conversion,
-an error message is left in the interpreter's result object
-unless \fIinterp\fR is NULL.
+When non-NULL, an error message is left here when integral value
+retrieval fails.
.AP int *intPtr out
-Points to place to store the integer value
-obtained by \fBTcl_GetIntFromObj\fR from \fIobjPtr\fR.
+Points to place to store the integer value retrieved from \fIobjPtr\fR.
.AP long *longPtr out
-Points to place to store the long integer value
-obtained by \fBTcl_GetLongFromObj\fR from \fIobjPtr\fR.
+Points to place to store the long integer value retrieved from \fIobjPtr\fR.
.AP Tcl_WideInt *widePtr out
-Points to place to store the wide integer value
-obtained by \fBTcl_GetWideIntFromObj\fR from \fIobjPtr\fR.
+Points to place to store the wide integer value retrieved from \fIobjPtr\fR.
+.AP mp_int *bigValue in/out
+Points to a multi-precision integer structure declared by the LibTomMath
+library.
+.AP double doubleValue in
+Double value from which the integer part is determined and
+used to initialize a multi-precision integer value.
.BE
-
.SH DESCRIPTION
.PP
-These procedures are used to create, modify, and read
-integer and wide integer Tcl objects from C code.
-\fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR,
-\fBTcl_SetIntObj\fR, and \fBTcl_SetLongObj\fR
-create a new object of integer type
-or modify an existing object to have integer type,
-and \fBTcl_NewWideIntObj\fR and \fBTcl_SetWideIntObj\fR create a new
-object of wide integer type or modify an existing object to have wide
-integer type.
-\fBTcl_NewIntObj\fR and \fBTcl_SetIntObj\fR set the object to have the
-integer value given by \fIintValue\fR,
-\fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR
-set the object to have the
-long integer value given by \fIlongValue\fR,
-and \fBTcl_NewWideIntObj\fR and \fBTcl_SetWideIntObj\fR set the object
-to have the wide integer value given by \fIwideValue\fR.
-\fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR and \fBTcl_NewWideIntObj\fR
-return a pointer to a newly created object with reference count zero.
-These procedures set the object's type to be integer
-and assign the integer value to the object's internal representation
-\fIlongValue\fR or \fIwideValue\fR member (as appropriate).
-\fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR
-and \fBTcl_SetWideIntObj\fR
-invalidate any old string representation and,
-if the object is not already an integer object,
-free any old internal representation.
+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
+with which values might be exchanged. The C integral types for which Tcl
+provides value exchange routines are \fBint\fR, \fBlong int\fR,
+\fBTcl_WideInt\fR, and \fBmp_int\fR. The \fBint\fR and \fBlong int\fR types
+are provided by the C language standard. The \fBTcl_WideInt\fR type is a
+typedef defined to be whatever signed integral type covers at least the
+64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending
+on the platform and the C compiler, the actual type might be
+\fBlong int\fR, \fBlong long int\fR, \fBint64\fR, or something else.
+The \fBmp_int\fR type is a multiple-precision integer type defined
+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 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 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 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
+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 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
+value exceeds the range of the target type. 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. 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 value
+\fIobjPtr\fR to an empty string in the process of retrieving the
+multiple-precision integer value.
+.PP
+The choice between \fBTcl_GetBignumFromObj\fR and
+\fBTcl_TakeBignumFromObj\fR is governed by how the caller will
+continue to use \fIobjPtr\fR. If after the \fBmp_int\fR value
+is retrieved from \fIobjPtr\fR, the caller will make no more
+use of \fIobjPtr\fR, then using \fBTcl_TakeBignumFromObj\fR
+permits Tcl to detect when an unshared \fIobjPtr\fR permits the
+value to be moved instead of copied, which should be more efficient.
+If anything later in the caller requires
+\fIobjPtr\fR to continue to hold the same value, then
+\fBTcl_GetBignumFromObj\fR must be chosen.
.PP
-\fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR
-attempt to return an integer value from the Tcl object \fIobjPtr\fR,
-and \fBTcl_GetWideIntFromObj\fR attempts to return a wide integer
-value from the Tcl object \fIobjPtr\fR.
-If the object is not already an integer object,
-or a wide integer object in the case of \fBTcl_GetWideIntFromObj\fR
-they will attempt to convert it to one.
-If an error occurs during conversion, they return \fBTCL_ERROR\fR
-and leave an error message in the interpreter's result object
-unless \fIinterp\fR is NULL.
-Also, if the long integer held in the object's internal representation
-\fIlongValue\fR member can not be represented in a (non-long) integer,
-\fBTcl_GetIntFromObj\fR returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
-unless \fIinterp\fR is NULL.
-Otherwise, all three procedures return \fBTCL_OK\fR and
-store the integer, long integer value
-or wide integer in the address given by \fIintPtr\fR, \fIlongPtr\fR
-and \fIwidePtr\fR
-respectively. If the object is not already an integer or wide integer
-object, the conversion will free any old internal representation.
-
+The \fBTcl_InitBignumFromDouble\fR routine is a utility procedure
+that extracts the integer part of \fIdoubleValue\fR and stores that
+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 c61ae40..b639add 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -5,10 +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: Interp.3,v 1.9 2005/05/10 18:33:56 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Interp \- client-visible fields of interpreter structures
@@ -17,25 +15,36 @@ Tcl_Interp \- client-visible fields of interpreter structures
\fB#include <tcl.h>\fR
.sp
typedef struct {
- char *\fIresult\fR;
- Tcl_FreeProc *\fIfreeProc\fR;
- int \fIerrorLine\fR;
-} Tcl_Interp;
+ char *\fIresult\fR;
+ Tcl_FreeProc *\fIfreeProc\fR;
+ int \fIerrorLine\fR;
+} \fBTcl_Interp\fR;
-typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+typedef void \fBTcl_FreeProc\fR(
+ char *\fIblockPtr\fR);
.BE
-
.SH DESCRIPTION
.PP
The \fBTcl_CreateInterp\fR procedure returns a pointer to a Tcl_Interp
-structure. This pointer is then passed into other Tcl procedures
-to process commands in the interpreter and perform other operations
-on the interpreter. Interpreter structures contain many fields
-that are used by Tcl, but only three that may be accessed by
-clients: \fIresult\fR, \fIfreeProc\fR, and \fIerrorLine\fR.
+structure. Callers of \fBTcl_CreateInterp\fR should use this pointer
+as an opaque token, suitable for nothing other than passing back to
+other routines in the Tcl interface. Accessing fields directly through
+the pointer as described below is no longer supported. The supported
+public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR,
+\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead.
.PP
-\fBNote that access to the \fIresult\fB and \fIfreeProc\fB fields is\fR
-\fBdeprecated.\fR Use \fBTcl_SetResult\fR and \fBTcl_GetResult\fR instead.
+For legacy programs and extensions no longer being maintained, compiles
+against the Tcl 8.6 header files are only possible with the compiler
+directives
+.CS
+#define USE_INTERP_RESULT
+.CE
+and/or
+.CS
+#define USE_INTERP_ERRORLINE
+.CE
+depending on which fields of the \fBTcl_Interp\fR struct are accessed.
+These directives may be embedded in code or supplied via compiler options.
.PP
The \fIresult\fR and \fIfreeProc\fR fields are used to return
results or error messages from commands.
@@ -43,7 +52,7 @@ This information is returned by command procedures back to \fBTcl_Eval\fR,
and by \fBTcl_Eval\fR back to its callers.
The \fIresult\fR field points to the string that represents the
result or error message, and the \fIfreeProc\fR field tells how
-to dispose of the storage for the string when it isn't needed anymore.
+to dispose of the storage for the string when it is not needed anymore.
The easiest way for command procedures to manipulate these
fields is to call procedures like \fBTcl_SetResult\fR
or \fBTcl_AppendResult\fR; they
diff --git a/doc/Limit.3 b/doc/Limit.3
index 002b422..20a2e02 100644
--- a/doc/Limit.3
+++ b/doc/Limit.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Limit.3,v 1.7 2004/11/12 09:01:25 das Exp $
-'\"
-.so man.macros
.TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_LimitAddHandler, Tcl_LimitCheck, Tcl_LimitExceeded, Tcl_LimitGetCommands, Tcl_LimitGetGranularity, Tcl_LimitGetTime, Tcl_LimitReady, Tcl_LimitRemoveHandler, Tcl_LimitSetCommands, Tcl_LimitSetGranularity, Tcl_LimitSetTime, Tcl_LimitTypeEnabled, Tcl_LimitTypeExceeded, Tcl_LimitTypeReset, Tcl_LimitTypeSet \- manage and check resource limits on interpreters
@@ -92,7 +90,6 @@ Arbitrary pointer-sized word used to pass some context to the
Function to call whenever a handler is deleted. May be NULL if the
\fIclientData\fR requires no deletion.
.BE
-
.SH DESCRIPTION
.PP
Tcl's interpreter resource limit subsystem allows for close control
@@ -164,13 +161,13 @@ the function that will actually be called; it should have the
following prototype:
.PP
.CS
-typedef void Tcl_LimitHandlerProc(
+typedef void \fBTcl_LimitHandlerProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR argument to the handler will be whatever is
-passed to the \fIclientData\fR argment to \fBTcl_LimitAddHandler\fR,
+passed to the \fIclientData\fR argument to \fBTcl_LimitAddHandler\fR,
and the \fIinterp\fR is the interpreter that had its limit exceeded.
.PP
The \fIdeleteProc\fR argument to \fBTcl_LimitAddHandler\fR is a
@@ -181,7 +178,7 @@ function to call to delete the \fIclientData\fR value. It may be
following prototype:
.PP
.CS
-typedef void Tcl_LimitHandlerDeleteProc(
+typedef void \fBTcl_LimitHandlerDeleteProc\fR(
ClientData \fIclientData\fR);
.CE
.PP
@@ -191,6 +188,5 @@ with \fBTcl_LimitAddHandler\fR) with exactly matching \fItype\fR,
\fIhandlerProc\fR and \fIclientData\fR arguments. This function
always invokes the \fIdeleteProc\fR on the \fIclientData\fR (unless
the \fIdeleteProc\fR was NULL or \fBTCL_STATIC\fR).
-
.SH KEYWORDS
interpreter, resource, limit, commands, time, callback
diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index 042d242..c64720b 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -5,10 +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: LinkVar.3,v 1.12 2005/09/08 10:49:19 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
@@ -33,20 +31,14 @@ Name of global variable.
Address of C variable that is to be linked to \fIvarName\fR.
.AP int type in
Type of C variable. Must be one of \fBTCL_LINK_INT\fR,
-.VS 8.5
\fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
\fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
-\fBTCL_LINK_ULONG\fR,
-.VE 8.5
-\fBTCL_LINK_WIDE_INT\fR,
-.VS 8.5
+\fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR,
-.VE 8.5
\fBTCL_LINK_DOUBLE\fR, \fBTCL_LINK_BOOLEAN\fR, or
\fBTCL_LINK_STRING\fR, optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR
to make Tcl variable read-only.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
@@ -70,7 +62,6 @@ Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors.
-.VS 8.5
.TP
\fBTCL_LINK_UINT\fR
The C variable is of type \fBunsigned int\fR.
@@ -124,7 +115,6 @@ integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned long\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors.
-.VE 8.5
.TP
\fBTCL_LINK_DOUBLE\fR
The C variable is of type \fBdouble\fR.
@@ -132,7 +122,6 @@ Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors.
-.VS 8.5
.TP
\fBTCL_LINK_FLOAT\fR
The C variable is of type \fBfloat\fR.
@@ -141,7 +130,6 @@ form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
range acceptable for a \fBfloat\fR; attempts to
write non-real values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors.
-.VE 8.5
.TP
\fBTCL_LINK_WIDE_INT\fR
The C variable is of type \fBTcl_WideInt\fR (which is an integer type
@@ -150,7 +138,6 @@ Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetWideIntFromObj\fR; attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors.
-.VS 8.5
.TP
\fBTCL_LINK_WIDE_UINT\fR
The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned
@@ -159,15 +146,16 @@ it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
-'\" FIXME! Use bignums instead.
+.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors.
-.VE 8.5
.TP
\fBTCL_LINK_BOOLEAN\fR
The C variable is of type \fBint\fR.
-If its value is zero then it will read from Tcl as ``0'';
-otherwise it will read from Tcl as ``1''.
+If its value is zero then it will read from Tcl as
+.QW 0 ;
+otherwise it will read from Tcl as
+.QW 1 .
Whenever \fIvarName\fR is
modified, the C variable will be set to a 0 or 1 value.
Any value written into the Tcl variable must have a proper boolean
@@ -183,7 +171,8 @@ Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
-will read as ``NULL''.
+will read as
+.QW NULL .
.PP
If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
variable will be read-only from Tcl, so that its value can only be
@@ -203,6 +192,16 @@ Tk widget that wishes to display the value of the variable), the
trace will not trigger when the C variable has changed.
\fBTcl_UpdateLinkedVar\fR ensures that any traces on the Tcl
variable are invoked.
-
+.PP
+Note that, as with any call to a Tcl interpreter, \fBTcl_UpdateLinkedVar\fR
+must be called from the same thread that created the interpreter. The safest
+mechanism is to ensure that the C variable is only ever updated from the same
+thread that created the interpreter (possibly in response to an event posted
+with \fBTcl_ThreadQueueEvent\fR), but when it is necessary to update the
+variable in a separate thread, it is advised that \fBTcl_AsyncMark\fR be used
+to indicate to the thread hosting the interpreter that it is ready to run
+\fBTcl_UpdateLinkedVar\fR.
+.SH "SEE ALSO"
+Tcl_TraceVar(3)
.SH KEYWORDS
-boolean, integer, link, read-only, real, string, traces, variable
+boolean, integer, link, read-only, real, string, trace, variable
diff --git a/doc/ListObj.3 b/doc/ListObj.3
index a17ab66..3af0e7e 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.10 2005/05/10 18:33:56 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.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,35 +210,42 @@ 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
-result = Tcl_ListObjReplace(interp, listPtr, index, 0, objc, objv);
+result = \fBTcl_ListObjReplace\fR(interp, listPtr, index, 0,
+ objc, objv);
.CE
-Similarly, the following code appends the \fIobjc\fR objects
+.PP
+Similarly, the following code appends the \fIobjc\fR values
referenced by the array \fIobjv\fR
to the end of the list \fIlistPtr\fR:
+.PP
.CS
-result = Tcl_ListObjLength(interp, listPtr, &length);
+result = \fBTcl_ListObjLength\fR(interp, listPtr, &length);
if (result == TCL_OK) {
- result = Tcl_ListObjReplace(interp, listPtr, length, 0, objc, objv);
+ result = \fBTcl_ListObjReplace\fR(interp, listPtr, length, 0,
+ objc, objv);
}
.CE
+.PP
The \fIcount\fR list elements starting at \fIfirst\fR can be deleted
by simply calling \fBTcl_ListObjReplace\fR
with a NULL \fIobjvPtr\fR:
+.PP
.CS
-result = Tcl_ListObjReplace(interp, listPtr, first, count, 0, NULL);
+result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
+ 0, NULL);
.CE
-
.SH "SEE ALSO"
-Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
-
+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
new file mode 100644
index 0000000..0ffaf57
--- /dev/null
+++ b/doc/Load.3
@@ -0,0 +1,70 @@
+'\"
+'\" Copyright (c) 2009-2010 Kevin B. Kenny
+'\" Copyright (c) 2010 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Load 3 8.6 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_LoadFile, Tcl_FindSymbol \- platform-independent dynamic library loading
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_LoadFile\fR(\fIinterp, pathPtr, symbols, flags, procPtrs, loadHandlePtr\fR)
+.sp
+void *
+\fBTcl_FindSymbol\fR(\fIinterp, loadHandle, symbol\fR)
+.SH ARGUMENTS
+.AS Tcl_LoadHandle loadHandle in
+.AP Tcl_Interp *interp in
+Interpreter to use for reporting error messages.
+.AP Tcl_Obj *pathPtr in
+The name of the file to load. If it is a single name, the library search path
+of the current environment will be used to resolve it.
+.AP "const char *const" symbols[] in
+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
+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.
+.AP Tcl_LoadHandle *loadHandlePtr out
+Points to a variable that will hold the handle to the abstract token
+describing the library that has been loaded.
+.AP Tcl_LoadHandle loadHandle in
+Abstract token describing the library to look up a symbol in.
+.AP "const char" *symbol in
+The name of the symbol to look up.
+.BE
+.SH DESCRIPTION
+.PP
+\fBTcl_LoadFile\fR loads a file from the filesystem (including potentially any
+virtual filesystem that has been installed) and provides a handle to it that
+may be used in further operations. The \fIsymbols\fR array, if non-NULL,
+supplies a set of names of symbols (typically functions) that must be resolved
+from the library and which will be stored in the array indicated by
+\fIprocPtrs\fR. If any of the symbols is not resolved, the loading of the file
+will fail with an error message left in the interpreter (if that is non-NULL).
+The result of \fBTcl_LoadFile\fR is a standard Tcl error code. The library may
+be unloaded with \fBTcl_FSUnloadFile\fR.
+.PP
+\fBTcl_FindSymbol\fR locates a symbol in a loaded library and returns it. If
+the symbol cannot be found, it returns NULL and sets an error message in the
+given \fIinterp\fR (if that is non-NULL). Note that it is unsafe to use this
+operation on a handle that has been passed to \fBTcl_FSUnloadFile\fR.
+.SH "SEE ALSO"
+Tcl_FSLoadFile(3), Tcl_FSUnloadFile(3), load(n), unload(n)
+.SH KEYWORDS
+binary code, loading, shared library
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/Method.3 b/doc/Method.3
new file mode 100644
index 0000000..550b64a
--- /dev/null
+++ b/doc/Method.3
@@ -0,0 +1,249 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
+.so man.macros
+.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_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
+.SH SYNOPSIS
+.nf
+\fB#include <tclOO.h>\fR
+.sp
+Tcl_Method
+\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
+ methodTypePtr, clientData\fR)
+.sp
+Tcl_Method
+\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
+ methodTypePtr, clientData\fR)
+.sp
+\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
+.sp
+\fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR)
+.sp
+Tcl_Class
+\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
+.sp
+Tcl_Object
+\fBTcl_MethodDeclarerObject\fR(\fImethod\fR)
+.sp
+Tcl_Obj *
+\fBTcl_MethodName\fR(\fImethod\fR)
+.sp
+int
+\fBTcl_MethodIsPublic\fR(\fImethod\fR)
+.sp
+int
+\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
+.sp
+int
+\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
+.sp
+int
+\fBTcl_ObjectContextIsFiltering\fR(\fIcontext\fR)
+.sp
+Tcl_Method
+\fBTcl_ObjectContextMethod\fR(\fIcontext\fR)
+.sp
+Tcl_Object
+\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
+.sp
+int
+\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
+.SH ARGUMENTS
+.AS ClientData clientData in
+.AP Tcl_Interp *interp in/out
+The interpreter holding the object or class to create or update a method in.
+.AP Tcl_Object object in
+The object to create the method in.
+.AP Tcl_Class class in
+The class to create the method in.
+.AP Tcl_Obj *nameObj in
+The name of the method to create. Should not be NULL unless creating
+constructors or destructors.
+.AP int isPublic in
+A boolean flag saying whether the method is to be exported.
+.AP Tcl_MethodType *methodTypePtr in
+A description of the type of the method to create, or the type of method to
+compare against.
+.AP ClientData clientData in
+A piece of data that is passed to the implementation of the method without
+interpretation.
+.AP ClientData *clientDataPtr out
+A pointer to a variable in which to write the \fIclientData\fR value supplied
+when the method was created. If NULL, the \fIclientData\fR value will not be
+retrieved.
+.AP Tcl_Method method in
+A reference to a method to query.
+.AP Tcl_ObjectContext context in
+A reference to a method-call context. Note that client code \fImust not\fR
+retain a reference to a context.
+.AP int objc in
+The number of arguments to pass to the method implementation.
+.AP "Tcl_Obj *const" *objv in
+An array of arguments to pass to the method implementation.
+.AP int skip in
+The number of arguments passed to the method implementation that do not
+represent "real" arguments.
+.BE
+.SH DESCRIPTION
+.PP
+A method is an operation carried out on an object that is associated with the
+object. Every method must be attached to either an object or a class; methods
+attached to a class are associated with all instances (direct and indirect) of
+that class.
+.PP
+Given a method, the entity that declared it can be found using
+\fBTcl_MethodDeclarerClass\fR which returns the class that the method is
+attached to (or NULL if the method is not attached to any class) and
+\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
+attached to (or NULL if the method is not attached to an object). The name of
+the method can be retrieved with \fBTcl_MethodName\fR and whether the method
+is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
+can also be introspected upon to a limited degree; the function
+\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
+assigning the per-method \fIclientData\fR to the variable pointed to by
+\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
+.SS "METHOD CREATION"
+.PP
+Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
+which
+create a method attached to a class or an object respectively. In both cases,
+the \fInameObj\fR argument gives the name of the method to create, the
+\fIisPublic\fR argument states whether the method should be exported
+initially, the \fImethodTypePtr\fR argument describes the implementation of
+the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
+argument gives some implementation-specific data that is passed on to the
+implementation of the method when it is called.
+.PP
+When the \fInameObj\fR argument to \fBTcl_NewMethod\fR is NULL, an
+unnamed method is created, which is used for constructors and destructors.
+Constructors should be installed into their class using the
+\fBTcl_ClassSetConstructor\fR function, and destructors (which must not
+require any arguments) should be installed into their class using the
+\fBTcl_ClassSetDestructor\fR function. Unnamed methods should not be used for
+any other purpose, and named methods should not be used as either constructors
+or destructors. Also note that a NULL \fImethodTypePtr\fR is used to provide
+internal signaling, and should not be used in client code.
+.SS "METHOD CALL CONTEXTS"
+.PP
+When a method is called, a method-call context reference is passed in as one
+of the arguments to the implementation function. This context can be inspected
+to provide information about the caller, but should not be retained beyond the
+moment when the method call terminates.
+.PP
+The method that is being called can be retrieved from the context by using
+\fBTcl_ObjectContextMethod\fR, and the object that caused the method to be
+invoked can be retrieved with \fBTcl_ObjectContextObject\fR. The number of
+arguments that are to be skipped (e.g. the object name and method name in a
+normal method call) is read with \fBTcl_ObjectContextSkippedArgs\fR, and the
+context can also report whether it is working as a filter for another method
+through \fBTcl_ObjectContextIsFiltering\fR.
+.PP
+During the execution of a method, the method implementation may choose to
+invoke the stages of the method call chain that come after the current method
+implementation. This (the core of the \fBnext\fR command) is done using
+\fBTcl_ObjectContextInvokeNext\fR. Note that this function does not manipulate
+the call-frame stack, unlike the \fBnext\fR command; if the method
+implementation has pushed one or more extra frames on the stack as part of its
+implementation, it is also responsible for temporarily popping those frames
+from the stack while the \fBTcl_ObjectContextInvokeNext\fR function is
+executing. Note also that the method-call context is \fInever\fR deleted
+during the execution of this function.
+.SH "METHOD TYPES"
+.PP
+The types of methods are described by a pointer to a Tcl_MethodType structure,
+which is defined as:
+.PP
+.CS
+typedef struct {
+ int \fIversion\fR;
+ const char *\fIname\fR;
+ Tcl_MethodCallProc *\fIcallProc\fR;
+ Tcl_MethodDeleteProc *\fIdeleteProc\fR;
+ Tcl_CloneProc *\fIcloneProc\fR;
+} \fBTcl_MethodType\fR;
+.CE
+.PP
+The \fIversion\fR field allows for future expansion of the structure, and
+should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The
+\fIname\fR field provides a human-readable name for the type, and is the value
+that is exposed via the \fBinfo class methodtype\fR and
+\fBinfo object methodtype\fR Tcl commands.
+.PP
+The \fIcallProc\fR field gives a function that is called when the method is
+invoked; it must never be NULL.
+.PP
+The \fIdeleteProc\fR field gives a function that is used to delete a
+particular method, and is called when the method is replaced or removed; if
+the field is NULL, it is assumed that the method's \fIclientData\fR needs no
+special action to delete.
+.PP
+The \fIcloneProc\fR field is either a function that is used to copy a method's
+\fIclientData\fR (as part of \fBTcl_CopyObjectInstance\fR) or NULL to indicate
+that the \fIclientData\fR can just be copied directly.
+.SS "TCL_METHODCALLPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are called when the method is invoked.
+.PP
+.CS
+typedef int \fBTcl_MethodCallProc\fR(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_ObjectContext \fIobjectContext\fR,
+ int \fIobjc\fR,
+ Tcl_Obj *const *\fIobjv\fR);
+.CE
+.PP
+The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
+given when the method was created, the \fIinterp\fR is a place in which to
+execute scripts and access variables as well as being where to put the result
+of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
+objects to the method. The calling context of the method can be discovered
+through the \fIobjectContext\fR argument, and the return value from a
+Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR).
+.SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used when a method is deleted, whether
+through a new method being created or because the object or class is deleted.
+.PP
+.CS
+typedef void \fBTcl_MethodDeleteProc\fR(
+ ClientData \fIclientData\fR);
+.CE
+.PP
+The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as
+the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or
+\fBTcl_NewInstanceMethod\fR when the method was created.
+.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to copy a method when the object or
+class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR).
+.PP
+.CS
+typedef int \fBTcl_CloneProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ ClientData \fIoldClientData\fR,
+ ClientData *\fInewClientDataPtr\fR);
+.CE
+.PP
+The \fIinterp\fR argument gives a place to write an error message when the
+attempt to clone the object is to fail, in which case the clone procedure must
+also return TCL_ERROR; it should return TCL_OK otherwise.
+The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
+method being copied from, and the \fInewClientDataPtr\fR field will point to
+a variable in which to write the value for the method being copied to.
+.SH "SEE ALSO"
+Class(3), oo::class(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+constructor, method, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/NRE.3 b/doc/NRE.3
new file mode 100644
index 0000000..a8ac477
--- /dev/null
+++ b/doc/NRE.3
@@ -0,0 +1,328 @@
+.\"
+.\" Copyright (c) 2008 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.
+'\"
+.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Command
+\fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData,
+ deleteProc\fR)
+.sp
+int
+\fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR)
+.sp
+int
+\fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR)
+.sp
+int
+\fBTcl_NREvalObjv\fR(\fIinterp, objc, objv, flags\fR)
+.sp
+int
+\fBTcl_NRCmdSwap\fR(\fIinterp, cmd, objc, objv, flags\fR)
+.sp
+int
+\fBTcl_NRExprObj\fR(\fIinterp, objPtr, resultPtr\fR)
+.sp
+void
+\fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR)
+.fi
+.SH ARGUMENTS
+.AS Tcl_CmdDeleteProc *interp in
+.AP Tcl_Interp *interp in
+Interpreter in which to create or evaluate a command.
+.AP char *cmdName in
+Name of a new command to create.
+.AP Tcl_ObjCmdProc *proc in
+Implementation of a command that will be called whenever \fIcmdName\fR
+is invoked as a command in the unoptimized way.
+.AP Tcl_ObjCmdProc *nreProc in
+Implementation of a command that will be called whenever \fIcmdName\fR
+is invoked and requested to conserve the C stack.
+.AP ClientData clientData in
+Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR,
+\fIdeleteProc\fR and \fIobjProc\fR.
+.AP Tcl_CmdDeleteProc *deleteProc in/out
+Procedure to call before \fIcmdName\fR is deleted from the interpreter.
+This procedure allows for command-specific cleanup. If \fIdeleteProc\fR
+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 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.
+.AP int flags in
+ORed combination of flag bits that specify additional options.
+\fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported.
+.\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and
+.\" TCL_EVAL_NOERR well enough to document them.
+.AP Tcl_Command cmd in
+Token for a command that is to be used instead of the currently
+executing command.
+.AP Tcl_Obj *resultPtr out
+Pointer to an unshared Tcl_Obj where the result of expression
+evaluation is written.
+.AP Tcl_NRPostProc *postProcPtr in
+Pointer to a function that will be invoked when the command currently
+executing in the interpreter designated by \fIinterp\fR completes.
+.AP ClientData data0 in
+.AP ClientData data1 in
+.AP ClientData data2 in
+.AP ClientData data3 in
+\fIdata0\fR through \fIdata3\fR are four one-word values that will be passed
+to the function designated by \fIpostProcPtr\fR when it is invoked.
+.BE
+.SH DESCRIPTION
+.PP
+This series of C functions provides an interface whereby commands that
+are implemented in C can be evaluated, and invoke Tcl commands scripts
+and scripts, without consuming space on the C stack. The non-recursive
+evaluation is done by installing a \fItrampoline\fR, a small piece of
+code that invokes a command or script, and then executes a series of
+callbacks when the command or script returns.
+.PP
+The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the
+interpreter designated by \fIinterp\fR that is prepared to handle
+nonrecursive evaluation with a trampoline. The \fIcmdName\fR argument
+gives the name of the new command. If \fIcmdName\fR contains any
+namespace qualifiers, then the new command is added to the specified
+namespace; otherwise, it is added to the global namespace. \fIproc\fR
+gives the procedure that will be called when the interpreter wishes to
+evaluate the command in an unoptimized manner, and \fInreProc\fR is
+the procedure that will be called when the interpreter wishes to
+evaluate the command using a trampoline. \fIdeleteProc\fR is a
+function that will be called before the command is deleted from the
+interpreter. When any of the three functions is invoked, it is passed
+the \fIclientData\fR parameter.
+.PP
+\fBTcl_NRCreateCommand\fR deletes any existing command
+\fIname\fR already associated with the interpreter
+(however see below for an exception where the existing command
+is not deleted).
+It returns a token that may be used to refer
+to the command in subsequent calls to \fBTcl_GetCommandName\fR.
+If \fBTcl_NRCreateCommand\fR is called for an interpreter that is in
+the process of being deleted, then it does not create a new command,
+does not delete any existing command of the same name, and returns NULL.
+.PP
+The \fIproc\fR and \fInreProc\fR function are expected to conform to
+all the rules set forth for the \fIproc\fR argument to
+\fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR).
+.PP
+When a command that is written to cope with evaluation via trampoline
+is invoked without a trampoline on the stack, it will usually respond
+to the invocation by creating a trampoline and calling the
+trampoline-enabled implementation of the same command. This call is done by
+means of \fBTcl_NRCallObjProc\fR. In the call to
+\fBTcl_NRCallObjProc\fR, the \fIinterp\fR, \fIclientData\fR,
+\fIobjc\fR and \fIobjv\fR parameters should be the same ones that were
+passed to \fIproc\fR. The \fInreProc\fR parameter should designate the
+trampoline-enabled implementation of the command.
+.PP
+\fBTcl_NREvalObj\fR arranges for the script contained in \fIobjPtr\fR
+to be evaluated in the interpreter designated by \fIinterp\fR after
+the current command (which must be trampoline-enabled) returns. It is
+the method by which a command may invoke a script without consuming
+space on the C stack. Similarly, \fBTcl_NREvalObjv\fR arranges to
+invoke a single Tcl command whose words have already been separated
+and substituted. The \fIobjc\fR and \fIobjv\fR parameters give the
+words of the command to be evaluated when execution reaches the
+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 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_NREvalObjv\fR.
+.PP
+\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR
+all accept a \fIflags\fR parameter, which is an OR-ed-together set of
+bits to control evaluation. At the present time, the only supported flag
+available to callers is \fBTCL_EVAL_GLOBAL\fR.
+.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE
+.\" and TCL_EVAL_NOERR?
+If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is
+evaluated in the global namespace. If it is not set, it is evaluated
+in the current namespace.
+.PP
+\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR
+to be evaluated in the interpreter designated by \fIinterp\fR after
+the current command (which must be trampoline-enabled) returns. It is
+the method by which a command may evaluate a Tcl expression without consuming
+space on the C stack. The argument \fIresultPtr\fR is a pointer to an
+unshared Tcl_Obj where the result of expression evaluation is to be written.
+If expression evaluation returns any code other than TCL_OK, the
+\fIresultPtr\fR value is left untouched.
+.PP
+All of the routines return \fBTCL_OK\fR if command or expression invocation
+has been scheduled successfully. If for any reason the scheduling cannot
+be completed (for example, if the interpreter is unable to find
+the requested command), they return \fBTCL_ERROR\fR with an
+appropriate message left in the interpreter's result.
+.PP
+\fBTcl_NRAddCallback\fR arranges to have a C function called when the
+current trampoline-enabled command in the Tcl interpreter designated
+by \fIinterp\fR returns. The \fIpostProcPtr\fR argument is a pointer
+to the callback function, which must have arguments and return value
+consistent with the \fBTcl_NRPostProc\fR data type:
+.PP
+.CS
+typedef int
+\fBTcl_NRPostProc\fR(
+ \fBClientData\fR \fIdata\fR[],
+ \fBTcl_Interp\fR *\fIinterp\fR,
+ int \fIresult\fR);
+.CE
+.PP
+When the trampoline invokes the callback function, the \fIdata\fR
+parameter will point to an array containing the four one-word
+quantities that were passed to \fBTcl_NRAddCallback\fR in the
+\fIdata0\fR through \fIdata3\fR parameters. The Tcl interpreter will
+be designated by the \fIinterp\fR parameter, and the \fIresult\fR
+parameter will contain the result (\fBTCL_OK\fR, \fBTCL_ERROR\fR,
+\fBTCL_RETURN\fR, \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR) that was
+returned by the command evaluation. The callback function is expected,
+in turn, either to return a \fIresult\fR to control further evaluation.
+.PP
+Multiple \fBTcl_NRAddCallback\fR invocations may request multiple
+callbacks, which may be to the same or different callback
+functions. If multiple callbacks are requested, they are executed in
+last-in, first-out order, that is, the most recently requested
+callback is executed first.
+.SH EXAMPLE
+.PP
+The usual pattern for Tcl commands that invoke other Tcl commands
+is something like:
+.PP
+.CS
+int
+\fITheCmdOldObjProc\fR(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int result;
+ Tcl_Obj *objPtr;
+
+ \fI... preparation ...\fR
+
+ result = \fBTcl_EvalObjEx\fR(interp, objPtr, 0);
+
+ \fI... postprocessing ...\fR
+
+ return result;
+}
+\fBTcl_CreateObjCommand\fR(interp, "theCommand",
+ \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
+.CE
+.PP
+To enable a command like this one for trampoline-based evaluation,
+it must be split into three pieces:
+.IP \(bu
+A non-trampoline implementation, \fITheCmdNewObjProc\fR,
+which will simply create a trampoline
+and invoke the trampoline-based implementation.
+.IP \(bu
+A trampoline-enabled implementation, \fITheCmdNRObjProc\fR. This
+function will perform the initialization, request that the trampoline
+call the postprocessing routine after command evaluation, and finally,
+request that the trampoline call the inner command.
+.IP \(bu
+A postprocessing routine, \fITheCmdPostProc\fR. This function will
+perform the postprocessing formerly done after the return from the
+inner command in \fITheCmdObjProc\fR.
+.PP
+The non-trampoline implementation is simple and stylized, containing
+a single statement:
+.PP
+.CS
+int
+\fITheCmdNewObjProc\fR(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
+ clientData, objc, objv);
+}
+.CE
+.PP
+The trampoline-enabled implementation requests postprocessing,
+and returns to the trampoline requesting command evaluation.
+.PP
+.CS
+int
+\fITheCmdNRObjProc\fR
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *objPtr;
+
+ \fI... preparation ...\fR
+
+ \fBTcl_NRAddCallback\fR(interp, \fITheCmdPostProc\fR,
+ data0, data1, data2, data3);
+ /* \fIdata0 .. data3\fR are up to four one-word items to
+ * pass to the postprocessing procedure */
+
+ return \fBTcl_NREvalObj\fR(interp, objPtr, 0);
+}
+.CE
+.PP
+The postprocessing procedure does whatever the original command did
+upon return from the inner evaluation.
+.PP
+.CS
+int
+\fITheCmdNRPostProc\fR(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ /* \fIdata[0] .. data[3]\fR are the four words of data
+ * passed to \fBTcl_NRAddCallback\fR */
+
+ \fI... postprocessing ...\fR
+
+ return result;
+}
+.CE
+.PP
+If \fItheCommand\fR is a command that results in multiple commands or
+scripts being evaluated, its postprocessing routine may schedule
+additional postprocessing and then request another command evaluation
+by means of \fBTcl_NREvalObj\fR or one of the other evaluation
+routines. Looping and sequencing constructs may be implemented in this way.
+.PP
+Finally, to install a trampoline-enabled command in the interpreter,
+\fBTcl_NRCreateCommand\fR is used in place of
+\fBTcl_CreateObjCommand\fR. It accepts two command procedures instead
+of one. The first is for use when no trampoline is yet on the stack,
+and the second is for use when there is already a trampoline in place.
+.PP
+.CS
+\fBTcl_NRCreateCommand\fR(interp, "theCommand",
+ \fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
+ TheCmdDeleteProc);
+.CE
+.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, value, result, script
+.SH COPYRIGHT
+Copyright (c) 2008 by Kevin B. Kenny
diff --git a/doc/Namespace.3 b/doc/Namespace.3
index 5f61f2b..be89597 100644
--- a/doc/Namespace.3
+++ b/doc/Namespace.3
@@ -4,16 +4,14 @@
'\" 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.7 2004/10/07 15:15:38 dkf Exp $
-'\"
'\" Note that some of these functions do not seem to belong, but they
'\" were all introduced with the same TIP (#139)
'\"
-.so man.macros
.TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGloblaNamespace, Tcl_Import \- manipulate namespaces
+Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGlobalNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -46,6 +44,12 @@ Tcl_Namespace *
.sp
Tcl_Command
\fBTcl_FindCommand\fR(\fIinterp, name, contextNsPtr, flags\fR)
+.sp
+Tcl_Obj *
+\fBTcl_GetNamespaceUnknownHandler(\fIinterp, nsPtr\fR)
+.sp
+int
+\fBTcl_SetNamespaceUnknownHandler(\fIinterp, nsPtr, handlerPtr\fR)
.SH ARGUMENTS
.AS Tcl_NamespaceDeleteProc allowOverwrite in/out
.AP Tcl_Interp *interp in/out
@@ -63,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
@@ -87,8 +91,10 @@ global namespace), \fBTCL_NAMESPACE_ONLY\fR (just for \fBTcl_FindCommand\fR;
indicates that the search is always to be conducted relative to the
context namespace), and \fBTCL_LEAVE_ERR_MSG\fR (indicates that an error
message should be left in the interpreter if the search fails.)
+.AP Tcl_Obj *handlerPtr in
+A script fragment to be installed as the unknown command handler for the
+namespace, or NULL to reset the handler to its default.
.BE
-
.SH DESCRIPTION
.PP
Namespaces are hierarchic naming contexts that can contain commands
@@ -108,11 +114,14 @@ the global namespace.)
.PP
\fBTcl_CreateNamespace\fR creates a new namespace. The
\fIdeleteProc\fR will have the following type signature:
+.PP
.CS
-typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
+typedef void \fBTcl_NamespaceDeleteProc\fR(
+ ClientData \fIclientData\fR);
.CE
.PP
-\fBTcl_DeleteNamespace\fR deletes a namespace.
+\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
+\fIdeleteProc\fR defined for the namespace (if any).
.PP
\fBTcl_AppendExportList\fR retrieves the export patterns for a
namespace given namespace and appends them (as list items) to
@@ -143,9 +152,14 @@ namespace cannot be found, NULL is returned.
\fBTcl_FindCommand\fR searches for a command named \fIname\fR within
the context of the namespace \fIcontextNsPtr\fR. If the command
cannot be found, NULL is returned.
-
+.PP
+\fBTcl_GetNamespaceUnknownHandler\fR returns the unknown command handler
+for the namespace, or NULL if none is set.
+.PP
+\fBTcl_SetNamespaceUnknownHandler\fR sets the unknown command handler for
+the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to
+its default.
.SH "SEE ALSO"
-Tcl_CreateCommand, Tcl_ListObjAppendElements, Tcl_SetVar
-
+Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3)
.SH KEYWORDS
namespace, command
diff --git a/doc/Notifier.3 b/doc/Notifier.3
index 7776610..f2976b1 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.15 2005/05/10 18:33:56 kennykb Exp $
-'\"
-.so man.macros
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.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
@@ -66,9 +64,14 @@ int
.sp
int
\fBTcl_SetServiceMode\fR(\fImode\fR)
-
+.sp
+void
+\fBTcl_ServiceModeHook\fR(\fImode\fR)
+.sp
+void
+\fBTcl_SetNotifier\fR(\fInotifierProcPtr\fR)
.SH ARGUMENTS
-.AS Tcl_EventDeleteProc *deleteProc
+.AS Tcl_EventDeleteProc *notifierProcPtr
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
@@ -78,7 +81,7 @@ queues them.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
-.AP Tcl_Time *timePtr in
+.AP "const Tcl_Time" *timePtr in
Indicates the maximum amount of time to wait for an event. This
is specified as an interval (how long to wait), not an absolute
time (when to wakeup). If the pointer passed to \fBTcl_WaitForEvent\fR
@@ -100,8 +103,11 @@ passed to \fBTcl_DoOneEvent\fR.
.AP int mode in
Indicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
+.AP Tcl_NotifierProcs* notifierProcPtr in
+Structure of function pointers describing notifier procedures that are
+to replace the ones installed in the executable. See
+\fBREPLACING THE NOTIFIER\fR for details.
.BE
-
.SH INTRODUCTION
.PP
The interfaces described here are used to customize the Tcl event
@@ -208,7 +214,6 @@ return.
.IP [7]
Either return 0 to indicate that no events were ready, or go back to
step [2] if blocking was requested by the caller.
-
.SH "CREATING A NEW EVENT SOURCE"
.PP
An event source consists of three procedures invoked by the notifier,
@@ -222,11 +227,13 @@ The procedure \fBTcl_CreateEventSource\fR creates a new event source.
Its arguments specify the setup procedure and check procedure for
the event source.
\fISetupProc\fR should match the following prototype:
+.PP
.CS
-typedef void Tcl_EventSetupProc(
+typedef void \fBTcl_EventSetupProc\fR(
ClientData \fIclientData\fR,
int \fIflags\fR);
.CE
+.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_CreateEventSource\fR; it is typically used to
point to private information managed by the event source.
@@ -234,7 +241,7 @@ The \fIflags\fR argument will be the same as the \fIflags\fR
argument passed to \fBTcl_DoOneEvent\fR except that it will never
be 0 (\fBTcl_DoOneEvent\fR replaces 0 with \fBTCL_ALL_EVENTS\fR).
\fIFlags\fR indicates what kinds of events should be considered;
-if the bit corresponding to this event source isn't set, the event
+if the bit corresponding to this event source is not set, the event
source should return immediately without doing anything. For
example, the file event source checks for the \fBTCL_FILE_EVENTS\fR
bit.
@@ -261,12 +268,14 @@ connection.
The \fItimePtr\fR argument to \fBTcl_WaitForEvent\fR points to
a structure that describes a time interval in seconds and
microseconds:
+.PP
.CS
typedef struct Tcl_Time {
- long \fIsec\fR;
- long \fIusec\fR;
-} Tcl_Time;
+ long \fIsec\fR;
+ long \fIusec\fR;
+} \fBTcl_Time\fR;
.CE
+.PP
The \fIusec\fR field should be less than 1000000.
.PP
Information provided to \fBTcl_SetMaxBlockTime\fR
@@ -296,11 +305,13 @@ The second procedure provided by each event source is its check
procedure, indicated by the \fIcheckProc\fR argument to
\fBTcl_CreateEventSource\fR. \fICheckProc\fR must match the
following prototype:
+.PP
.CS
-typedef void Tcl_EventCheckProc(
+typedef void \fBTcl_EventCheckProc\fR(
ClientData \fIclientData\fR,
int \fIflags\fR);
.CE
+.PP
The arguments to this procedure are the same as those for \fIsetupProc\fR.
\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
for events. Presumably at least one event source is now prepared to
@@ -319,12 +330,14 @@ to that event source. However, the first element of the structure
must be a structure of type \fBTcl_Event\fR, and the address of this
structure is used when communicating between the event source and the
rest of the notifier. A \fBTcl_Event\fR has the following definition:
+.PP
.CS
typedef struct {
Tcl_EventProc *\fIproc\fR;
struct Tcl_Event *\fInextPtr\fR;
-} Tcl_Event;
+} \fBTcl_Event\fR;
.CE
+.PP
The event source must fill in the \fIproc\fR field of
the event before calling \fBTcl_QueueEvent\fR.
The \fInextPtr\fR is used to link together the events in the queue
@@ -352,11 +365,13 @@ When it is time to handle an event from the queue (steps 1 and 4
above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
in the first queued \fBTcl_Event\fR structure.
\fIProc\fR must match the following prototype:
+.PP
.CS
-typedef int Tcl_EventProc(
+typedef int \fBTcl_EventProc\fR(
Tcl_Event *\fIevPtr\fR,
int \fIflags\fR);
.CE
+.PP
The first argument to \fIproc\fR is a pointer to the event, which will
be the same as the first argument to the \fBTcl_QueueEvent\fR call that
added the event to the queue.
@@ -376,7 +391,7 @@ There are several reasons why an event source might defer an event.
One possibility is that events of this type are excluded by the
\fIflags\fR argument.
For example, the file event source will always return 0 if the
-\fBTCL_FILE_EVENTS\fR bit isn't set in \fIflags\fR.
+\fBTCL_FILE_EVENTS\fR bit is not set in \fIflags\fR.
Another example of deferring events happens in Tk if
\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
of window events.
@@ -396,23 +411,26 @@ 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
-need to call \fBTcl_ThreadAlert\fR to "wake up" that thread's notifier to
-alert it to the new event.
+need to call \fBTcl_ThreadAlert\fR to
+.QW "wake up"
+that thread's notifier to alert it to the new event.
.PP
\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
events from the event queue. \fBTcl_DeleteEvents\fR calls \fIproc\fR
for each event in the queue, deleting those for with the procedure
returns 1. Events for which the procedure returns 0 are left in the
queue. \fIProc\fR should match the following prototype:
+.PP
.CS
-typedef int Tcl_EventDeleteProc(
+typedef int \fBTcl_EventDeleteProc\fR(
Tcl_Event *\fIevPtr\fR,
ClientData \fIclientData\fR);
.CE
+.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
private information managed by the event source. The \fIevPtr\fR will
@@ -422,7 +440,6 @@ point to the next event in the queue.
\fIcheckProc\fR, and \fIclientData\fR arguments must exactly match those
provided to the \fBTcl_CreateEventSource\fR for the event source to be deleted.
If no such source exists, \fBTcl_DeleteEventSource\fR has no effect.
-
.SH "CREATING A NEW NOTIFIER"
.PP
The notifier consists of all the procedures described in this manual
@@ -430,13 +447,13 @@ entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
available on all platforms, and \fBTcl_CreateFileHandler\fR and
\fBTcl_DeleteFileHandler\fR, which are Unix-specific. Most of these
procedures are generic, in that they are the same for all notifiers.
-However, eight of the procedures are notifier-dependent:
-\fBTcl_InitNotifier\fR, \fBTcl_AlertNotifier\fR, \fBTcl_FinalizeNotifier\fR,
-\fBTcl_SetTimer\fR, \fBTcl_Sleep\fR, \fBTcl_WaitForEvent\fR,
-\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR. To
-support a new platform or to integrate Tcl with an
-application-specific event loop, you must write new versions of these
-procedures.
+However, none of the procedures are notifier-dependent:
+\fBTcl_InitNotifier\fR, \fBTcl_AlertNotifier\fR,
+\fBTcl_FinalizeNotifier\fR, \fBTcl_SetTimer\fR, \fBTcl_Sleep\fR,
+\fBTcl_WaitForEvent\fR, \fBTcl_CreateFileHandler\fR,
+\fBTcl_DeleteFileHandler\fR and \fBTcl_ServiceModeHook\fR. To support a
+new platform or to integrate Tcl with an application-specific event loop,
+you must write new versions of these procedures.
.PP
\fBTcl_InitNotifier\fR initializes the notifier state and returns
a handle to the notifier state. Tcl calls this
@@ -445,7 +462,9 @@ procedure when initializing a Tcl interpreter. Similarly,
called by \fBTcl_Finalize\fR when shutting down a Tcl interpreter.
.PP
\fBTcl_WaitForEvent\fR is the lowest-level procedure in the notifier;
-it is responsible for waiting for an ``interesting'' event to occur or
+it is responsible for waiting for an
+.QW interesting
+event to occur or
for a given time to elapse. Before \fBTcl_WaitForEvent\fR is invoked,
each of the event sources' setup procedure will have been invoked.
The \fItimePtr\fR argument to
@@ -459,13 +478,13 @@ to occur; it should not actually process the event in any way.
Later on, the
event sources will process the raw events and create Tcl_Events on
the event queue in their \fIcheckProc\fR procedures.
-However, on some platforms (such as Windows) this isn't possible;
+However, on some platforms (such as Windows) this is not possible;
events may be processed in \fBTcl_WaitForEvent\fR, including queuing
Tcl_Events and more (for example, callbacks for native widgets may be
invoked). The return value from \fBTcl_WaitForEvent\fR must be either
0, 1, or \-1. On platforms such as Windows where events get processed in
\fBTcl_WaitForEvent\fR, a return value of 1 means that there may be more
-events still pending that haven't been processed. This is a sign to the
+events still pending that have not been processed. This is a sign to the
caller that it must call \fBTcl_WaitForEvent\fR again if it wants all
pending events to be processed. A 0 return value means that calling
\fBTcl_WaitForEvent\fR again will not have any effect: either this is a
@@ -480,7 +499,9 @@ forever because there were no active event sources and the timeout was
infinite.
.PP
\fBTcl_AlertNotifier\fR is used in multithreaded applications to allow
-any thread to "wake up" the notifier to alert it to new events on its
+any thread to
+.QW "wake up"
+the notifier to alert it to new events on its
queue. \fBTcl_AlertNotifier\fR requires as an argument the notifier
handle returned by \fBTcl_InitNotifier\fR.
.PP
@@ -490,11 +511,18 @@ invoked by \fBTcl_SetMaxBlockTime\fR whenever the maximum blocking
time has been reduced. \fBTcl_SetTimer\fR should arrange for the
external event loop to invoke \fBTcl_ServiceAll\fR after the specified
interval even if no events have occurred. This interface is needed
-because \fBTcl_WaitForEvent\fR isn't invoked when there is an external
+because \fBTcl_WaitForEvent\fR is not invoked when there is an external
event loop. If the
notifier will only be used from \fBTcl_DoOneEvent\fR, then
\fBTcl_SetTimer\fR need not do anything.
.PP
+\fBTcl_ServiceModeHook\fR is called by the platform-independent portion
+of the notifier when client code makes a call to
+\fBTcl_SetServiceMode\fR. This hook is provided to support operating
+systems that require special event handling when the application is in
+a modal loop (the Windows notifier, for instance, uses this hook to
+create a communication window).
+.PP
On Unix systems, the file event source also needs support from the
notifier. The file event source consists of the
\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR
@@ -507,7 +535,39 @@ in their respective manual pages.
The easiest way to create a new notifier is to look at the code
for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
or \fBwin/tclWinNotify.c\fR in the Tcl source distribution.
-
+.SH "REPLACING THE NOTIFIER"
+.PP
+A notifier that has been written according to the conventions above
+can also be installed in a running process in place of the standard
+notifier. This mechanism is used so that a single executable can be
+used (with the standard notifier) as a stand-alone program and reused
+(with a replacement notifier in a loadable extension) as an extension
+to another program, such as a Web browser plugin.
+.PP
+To do this, the extension makes a call to \fBTcl_SetNotifier\fR
+passing a pointer to a \fBTcl_NotifierProcs\fR data structure. The
+structure has the following layout:
+.PP
+.CS
+typedef struct Tcl_NotifierProcs {
+ Tcl_SetTimerProc *\fIsetTimerProc\fR;
+ Tcl_WaitForEventProc *\fIwaitForEventProc\fR;
+ Tcl_CreateFileHandlerProc *\fIcreateFileHandlerProc\fR;
+ Tcl_DeleteFileHandlerProc *\fIdeleteFileHandlerProc\fR;
+ Tcl_InitNotifierProc *\fIinitNotifierProc\fR;
+ Tcl_FinalizeNotifierProc *\fIfinalizeNotifierProc\fR;
+ Tcl_AlertNotifierProc *\fIalertNotifierProc\fR;
+ Tcl_ServiceModeHookProc *\fIserviceModeHookProc\fR;
+} \fBTcl_NotifierProcs\fR;
+.CE
+.PP
+Following the call to \fBTcl_SetNotifier\fR, the pointers given in
+the \fBTcl_NotifierProcs\fR structure replace whatever notifier had
+been installed in the process.
+.PP
+It is extraordinarily unwise to replace a running notifier. Normally,
+\fBTcl_SetNotifier\fR should be called at process initialization time
+before the first call to \fBTcl_InitNotifier\fR.
.SH "EXTERNAL EVENT LOOPS"
.PP
The notifier interfaces are designed so that Tcl can be embedded into
@@ -568,9 +628,8 @@ then calls to \fBTcl_ServiceAll\fR will behave normally.
mode, which should be restored when the recursive loop exits.
\fBTcl_GetServiceMode\fR returns the current value of the service
mode.
-
.SH "SEE ALSO"
-\fBTcl_CreateFileHandler\fR, \fBTcl_DeleteFileHandler\fR, \fBTcl_Sleep\fR,
-\fBTcl_DoOneEvent\fR, \fBThread(3)\fR
+Tcl_CreateFileHandler(3), Tcl_DeleteFileHandler(3), Tcl_Sleep(3),
+Tcl_DoOneEvent(3), Thread(3)
.SH KEYWORDS
event, notifier, event queue, event sources, file events, timer, idle, service mode, threads
diff --git a/doc/OOInitStubs.3 b/doc/OOInitStubs.3
new file mode 100644
index 0000000..bc42453
--- /dev/null
+++ b/doc/OOInitStubs.3
@@ -0,0 +1,54 @@
+'\"
+'\" Copyright (c) 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.
+'\"
+.TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_OOInitStubs \- initialize library access to TclOO functionality
+.SH SYNOPSIS
+.nf
+\fB#include <tclOO.h>\fR
+.sp
+const char *
+\fBTcl_OOInitStubs\fR(\fIinterp\fR)
+.fi
+.SH ARGUMENTS
+.AS Tcl_Interp *interp in
+.AP Tcl_Interp *interp in
+The Tcl interpreter that the TclOO API is integrated with and whose C
+interface is going to be used.
+.BE
+.SH DESCRIPTION
+.PP
+When an extension library is going to use the C interface exposed by TclOO, it
+should use \fBTcl_OOInitStubs\fR to initialize its access to that interface
+from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in
+the \fIinterp\fR that was passed into that routine as context. If the result
+of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an
+error message will have been left in the interpreter's result. Otherwise, the
+initialization succeeded and the TclOO API may thereafter be used; the
+version of the TclOO API is returned.
+.PP
+When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR
+should be defined and your library code linked against the Tcl stub library,
+or that #define symbol should \fInot\fR be defined and your library code
+linked against the Tcl main library directly.
+.SH "BACKWARD COMPATIBILITY NOTE"
+.PP
+If you are linking against the Tcl 8.5 forward compatibility package for
+TclOO, \fIonly\fR the stub-enabled configuration is supported and you should
+also link against the TclOO independent stub library; that library is an
+integrated part of the main Tcl stub library in Tcl 8.6.
+.SH KEYWORDS
+stubs
+.SH "SEE ALSO"
+Tcl_InitStubs(3)
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/Object.3 b/doc/Object.3
index 8f8c9ef..55451ab 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.12 2005/05/10 18:33:56 kennykb Exp $
-'\"
+.TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
-.TH Tcl_Obj 3 8.1 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,36 +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.
@@ -76,60 +74,66 @@ 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.
-Seven types are predefined in the Tcl core
+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 using the procedure \fBTcl_RegisterObjType\fR .
-
+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
typedef struct Tcl_Obj {
- int \fIrefCount\fR;
- char *\fIbytes\fR;
- int \fIlength\fR;
- Tcl_ObjType *\fItypePtr\fR;
- union {
- long \fIlongValue\fR;
- double \fIdoubleValue\fR;
- void *\fIotherValuePtr\fR;
- struct {
- void *\fIptr1\fR;
- void *\fIptr2\fR;
- } \fItwoPtrValue\fR;
- } \fIinternalRep\fR;
-} Tcl_Obj;
+ int \fIrefCount\fR;
+ char *\fIbytes\fR;
+ int \fIlength\fR;
+ const Tcl_ObjType *\fItypePtr\fR;
+ union {
+ long \fIlongValue\fR;
+ double \fIdoubleValue\fR;
+ void *\fIotherValuePtr\fR;
+ Tcl_WideInt \fIwideValue\fR;
+ struct {
+ void *\fIptr1\fR;
+ void *\fIptr2\fR;
+ } \fItwoPtrValue\fR;
+ struct {
+ void *\fIptr\fR;
+ unsigned long \fIvalue\fR;
+ } \fIptrAndLongRep\fR;
+ } \fIinternalRep\fR;
+} \fBTcl_Obj\fR;
.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.
@@ -139,30 +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,
-or two arbitrary pointers.
+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,
@@ -172,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
@@ -199,93 +204,99 @@ 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
-This assigns to \fIx\fR an untyped object whose
+.PP
+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
.CE
+.PP
\fIx\fR's string representation is valid (since \fIbytes\fR is non-NULL)
and is fetched for the command.
+.PP
.CS
\fBincr x\fR
.CE
-The \fBincr\fR command first gets an integer from \fIx\fR's object
+.PP
+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
no longer corresponds to the internal representation.
+.PP
.CS
\fBputs "x is now $x"\fR
.CE
-The string representation of \fIx\fR's object is needed
+.PP
+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
-it won't be freed too early or have its value change accidentally.
+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
@@ -293,45 +304,49 @@ 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 don't 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,
-the command procedure "owns" the object and can safely modify it directly.
+If the value is not shared,
+the command procedure
+.QW "owns"
+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
listPtr = objv[1];
-if (Tcl_IsShared(listPtr)) {
- listPtr = Tcl_DuplicateObj(listPtr);
+if (\fBTcl_IsShared\fR(listPtr)) {
+ listPtr = \fBTcl_DuplicateObj\fR(listPtr);
}
-result = Tcl_ListObjReplace(interp, listPtr, index, 0, (objc-3), &(objv[3]));
+result = Tcl_ListObjReplace(interp, listPtr, index, 0,
+ (objc-3), &(objv[3]));
.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, Tcl_GetIntFromObj, Tcl_ListObjAppendElement, Tcl_ListObjIndex, Tcl_ListObjReplace, Tcl_RegisterObjType
-
+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 9a4a2f8..424d560 100644
--- a/doc/ObjectType.3
+++ b/doc/ObjectType.3
@@ -4,20 +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: ObjectType.3,v 1.12 2004/10/07 15:15:38 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.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
.sp
\fBTcl_RegisterObjType\fR(\fItypePtr\fR)
.sp
-Tcl_ObjType *
+const Tcl_ObjType *
\fBTcl_GetObjType\fR(\fItypeName\fR)
.sp
int
@@ -26,30 +24,34 @@ int
int
\fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR)
.SH ARGUMENTS
-.AS Tcl_ObjType *typeName
-.AP Tcl_ObjType *typePtr in
-Points to the structure containing information about the Tcl object type.
+.AS "const char" *typeName
+.AP "const Tcl_ObjType" *typePtr in
+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 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 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
@@ -60,143 +62,195 @@ it is replaced with the new type.
The Tcl_ObjType structure is described
in the section \fBTHE TCL_OBJTYPE STRUCTURE\fR below.
.PP
-\fBTcl_GetObjType\fR returns a pointer to the Tcl_ObjType
+\fBTcl_GetObjType\fR returns a pointer to the registered Tcl_ObjType
with name \fItypeName\fR.
It returns NULL if no type with that name is registered.
.PP
-\fBTcl_AppendAllObjTypes\fR appends the name of each 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
-and sets its \fItypePtr\fR member to that type.
+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
as a test whether the conversion can be done (and in fact was done).
-
+.VS 8.5
+.PP
+In many cases, the \fItypePtr->setFromAnyProc\fR routine will
+set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR,
+but that is no longer guaranteed. The \fIsetFromAnyProc\fR is
+free to set the internal representation for \fIobjPtr\fR to make
+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
-procedures,
-initializing a Tcl_ObjType structure to describe the type,
-and calling \fBTcl_RegisterObjType\fR.
+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
+structure to \fBTcl_RegisterObjType\fR if they wish to permit
+other extensions to look up their Tcl_ObjType by name with
+the \fBTcl_GetObjType\fR routine.
The \fBTcl_ObjType\fR structure is defined as follows:
+.PP
.CS
typedef struct Tcl_ObjType {
- char *\fIname\fR;
- Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
- Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
- Tcl_UpdateStringProc *\fIupdateStringProc\fR;
- Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
-} Tcl_ObjType;
+ const char *\fIname\fR;
+ Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
+ Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
+ Tcl_UpdateStringProc *\fIupdateStringProc\fR;
+ Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
+} \fBTcl_ObjType\fR;
.CE
+.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
-Extension writers can look up an object type using its name
-with the \fBTcl_GetObjType\fR procedure.
+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 (Tcl_SetFromAnyProc) (Tcl_Interp *\fIinterp\fR, Tcl_Obj *\fIobjPtr\fR);
+typedef int \fBTcl_SetFromAnyProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Obj *\fIobjPtr\fR);
.CE
-If an internal representation can't be created from the string,
+.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,
sets \fIobjPtr\fR's \fItypePtr\fR member to point to
-\fIsetFromAnyProc\fR's \fBTcl_ObjType\fR, and returns \fBTCL_OK\fR.
+the \fBTcl_ObjType\fR struct corresponding to the new
+internal representation, and returns \fBTCL_OK\fR.
Before setting the new internal representation,
the \fIsetFromAnyProc\fR must free any internal representation
of \fIobjPtr\fR's old type;
it does this by calling the old type's \fIfreeIntRepProc\fR
if it is not NULL.
-As an example, the \fIsetFromAnyProc\fR for the built-in Tcl integer type
+.PP
+As an example, the \fIsetFromAnyProc\fR for the built-in Tcl list type
gets an up-to-date string representation for \fIobjPtr\fR
by calling \fBTcl_GetStringFromObj\fR.
-It parses the string to obtain an integer and,
-if this succeeds,
-stores the integer in \fIobjPtr\fR's internal representation
-and sets \fIobjPtr\fR's \fItypePtr\fR member to point to the integer type's
+It parses the string to verify it is in a valid list format and
+to obtain each element value in the list, and, if this succeeds,
+stores the list elements in \fIobjPtr\fR's internal representation
+and sets \fIobjPtr\fR's \fItypePtr\fR member to point to the list type's
Tcl_ObjType structure.
+.PP
Do not release \fIobjPtr\fR's old internal representation unless you
replace it with a new one or reset the \fItypePtr\fR member to NULL.
.PP
+The \fIsetFromAnyProc\fR member may be set to NULL, if the routines
+making use of the internal representation have no need to derive that
+internal representation from an arbitrary string value. However, in
+this case, passing a pointer to the type to \fBTcl_ConvertToType\fR will
+lead to a panic, so to avoid this possibility, the type
+should \fInot\fR be registered.
+.SS "THE UPDATESTRINGPROC FIELD"
+.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 (Tcl_UpdateStringProc) (Tcl_Obj *\fIobjPtr\fR);
+typedef void \fBTcl_UpdateStringProc\fR(
+ Tcl_Obj *\fIobjPtr\fR);
.CE
+.PP
\fIobjPtr\fR's \fIbytes\fR member is always NULL when it is called.
It must always set \fIbytes\fR non-NULL before returning.
We require the string representation's byte array
-to have a null after the last byte, at offset \fIlength\fR;
-this allows string representations that do not contain null bytes
+to have a null after the last byte, at offset \fIlength\fR,
+and to have no null bytes before that; this allows string representations
to be treated as conventional null character-terminated C strings.
+These restrictions are easily met by using Tcl's internal UTF encoding
+for the string representation, same as one would do for other
+Tcl routines accepting string values as arguments.
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR
or \fBckalloc\fR. Note that \fIupdateStringProc\fRs must allocate
enough storage for the string's bytes and the terminating null byte.
-The \fIupdateStringProc\fR for Tcl's built-in list type, for example,
-builds an array of strings for each element object
-and then calls \fBTcl_Merge\fR
-to construct a string with proper Tcl list structure.
-It stores this string as the list object's string representation.
+.PP
+The \fIupdateStringProc\fR for Tcl's built-in double type, for example,
+calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE,
+then allocates and copies the string representation to just enough
+space to hold it. A pointer to the allocated space is stored in
+the \fIbytes\fR member.
+.PP
+The \fIupdateStringProc\fR member may be set to NULL, if the routines
+making use of the internal representation are written so that the
+string representation is never invalidated. Failure to meet this
+obligation will lead to panics or crashes when \fBTcl_GetStringFromObj\fR
+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 (Tcl_DupInternalRepProc) (Tcl_Obj *\fIsrcPtr\fR, Tcl_Obj *\fIdupPtr\fR);
+typedef void \fBTcl_DupInternalRepProc\fR(
+ Tcl_Obj *\fIsrcPtr\fR,
+ Tcl_Obj *\fIdupPtr\fR);
.CE
+.PP
\fIdupPtr\fR's internal representation is made a copy of \fIsrcPtr\fR's
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
simply copies an integer.
-The built-in list type's \fIdupIntRepProc\fR
-allocates a new array that points at the original element objects;
-the elements are shared between the two lists
-(and their reference counts are incremented to reflect the new references).
+The built-in list type's \fIdupIntRepProc\fR uses a far more
+sophisticated scheme to continue sharing storage as much as it
+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 (Tcl_FreeInternalRepProc) (Tcl_Obj *\fIobjPtr\fR);
+typedef void \fBTcl_FreeInternalRepProc\fR(
+ Tcl_Obj *\fIobjPtr\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 example, Tcl list objects have an \fIinternalRep.otherValuePtr\fR
-that points to an array of pointers to each element in the list.
-The list type's \fIfreeIntRepProc\fR decrements
-the reference count for each element object
-(since the list will no longer refer to those objects),
-then deallocates the storage for the array of pointers.
+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 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 should not access the
-\fIbytes\fR member of the object, as this may potentially have already
-been deleted.
-
+The \fIfreeIntRepProc\fR implementation must not access the
+\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, Tcl_DecrRefCount, Tcl_IncrRefCount
-
+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 a5caee4..cca76c2 100644
--- a/doc/OpenFileChnl.3
+++ b/doc/OpenFileChnl.3
@@ -4,9 +4,8 @@
'\" 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.32 2005/06/06 23:45:42 dkf Exp $
-.so man.macros
.TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -99,10 +98,8 @@ Tcl_WideInt
Tcl_WideInt
\fBTcl_Tell\fR(\fIchannel\fR)
.sp
-.VS 8.5
int
\fBTcl_TruncateChannel\fR(\fIchannel, length\fR)
-.VE 8.5
.sp
int
\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
@@ -155,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
@@ -185,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
@@ -212,7 +209,6 @@ values. Must have been initialized by the caller.
.AP "const char" *newValue in
New value for the option given by \fIoptionName\fR.
.BE
-
.SH DESCRIPTION
.PP
The Tcl channel mechanism provides a device-independent and
@@ -230,7 +226,6 @@ The procedures described in this manual entry comprise the C APIs of the
generic layer of the channel architecture. For a description of the channel
driver architecture and how to implement channel drivers for new types of
channels, see the manual entry for \fBTcl_CreateChannel\fR.
-
.SH TCL_OPENFILECHANNEL
.PP
\fBTcl_OpenFileChannel\fR opens a file specified by \fIfileName\fR and
@@ -244,17 +239,14 @@ 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
-
-.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
.SH TCL_OPENCOMMANDCHANNEL
.PP
\fBTcl_OpenCommandChannel\fR provides a C-level interface to the
@@ -289,20 +281,18 @@ the interpreter's result if \fIinterp\fR is not NULL.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
.SH TCL_MAKEFILECHANNEL
.PP
\fBTcl_MakeFileChannel\fR makes a \fBTcl_Channel\fR from an existing,
platform-specific, file handle.
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
.SH TCL_GETCHANNEL
.PP
\fBTcl_GetChannel\fR returns a channel given the \fIchannelName\fR used to
@@ -315,12 +305,11 @@ 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,
and the error message is left in the interpreter's result.
-
.SH TCL_REGISTERCHANNEL
.PP
\fBTcl_RegisterChannel\fR adds a channel to the set of channels accessible
@@ -343,9 +332,8 @@ 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
\fBTcl_UnregisterChannel\fR removes a channel from the set of channels
@@ -360,14 +348,13 @@ that it no longer holds a reference to that channel. If this is the last
reference to the channel, it will now be closed. \fBTcl_UnregisterChannel\fR
is very similar to \fBTcl_DetachChannel\fR except that it will also
close the channel if no further references to it exist.
-
.SH TCL_DETACHCHANNEL
.PP
\fBTcl_DetachChannel\fR removes a channel from the set of channels
accessible in \fIinterp\fR. After this call, Tcl programs will no longer be
able to use the channel's name to refer to the channel in that interpreter.
Beyond that, this command has no further effect. It cannot be used on
-the standard channels (stdout, stderr, stdin), and will return
+the standard channels (\fBstdout\fR, \fBstderr\fR, \fBstdin\fR), and will return
\fBTCL_ERROR\fR if passed one of those channels.
.PP
Code not associated with a Tcl interpreter can call
@@ -375,16 +362,14 @@ Code not associated with a Tcl interpreter can call
that it no longer holds a reference to that channel. If this is the last
reference to the channel, unlike \fBTcl_UnregisterChannel\fR,
it will not be closed.
-
.SH TCL_ISSTANDARDCHANNEL
.PP
\fBTcl_IsStandardChannel\fR tests whether a channel is one of the
-three standard channels, stdin, stdout or stderr. If so, it returns
-1, otherwise 0.
+three standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR.
+If so, it returns 1, otherwise 0.
.PP
No attempt is made to check whether the given channel or the standard
channels are initialized or otherwise valid.
-
.SH TCL_CLOSE
.PP
\fBTcl_Close\fR destroys the channel \fIchannel\fR, which must denote a
@@ -414,7 +399,6 @@ been given as the \fBchan\fR argument in a call to
\fBTcl_UnregisterChannel\fR, which will internally call \fBTcl_Close\fR
when all calls to \fBTcl_RegisterChannel\fR have been matched by
corresponding calls to \fBTcl_UnregisterChannel\fR.
-
.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
@@ -425,7 +409,7 @@ that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the
return value is \-1 and \fBTcl_ReadChars\fR records a POSIX error code that
can be retrieved with \fBTcl_GetErrno\fR.
.PP
-Setting \fIcharsToRead\fR to \fB-1\fR will cause the command to read
+Setting \fIcharsToRead\fR to \fB\-1\fR will cause the command to read
all characters currently available (non-blocking) or everything until
eof (blocking mode).
.PP
@@ -451,14 +435,14 @@ 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
related functions, and then written to a channel without the expense of ever
converting to or from UTF-8.
.PP
-\fBTcl_Read\fR is similar to \fBTcl_ReadChars\fR, except that it doesn't do
+\fBTcl_Read\fR is similar to \fBTcl_ReadChars\fR, except that it does not do
encoding conversions, regardless of the channel's encoding. It is deprecated
and exists for backwards compatibility with non-internationalized Tcl
extensions. It consumes bytes from \fIchannel\fR and stores them in
@@ -475,7 +459,6 @@ stack the supplied channel is part of, \fBTcl_ReadRaw\fR does
not. Thus this function is \fBonly\fR usable for transformational
channel drivers, i.e. drivers used in the middle of a stack of
channels, to move data from the channel below into the transformation.
-
.SH "TCL_GETSOBJ AND TCL_GETS"
.PP
\fBTcl_GetsObj\fR consumes bytes from \fIchannel\fR, converting the bytes to
@@ -501,8 +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,
@@ -510,10 +492,11 @@ at either the head or tail of the queue. The pointer \fIinput\fR points
to the data that is to be added. The length of the input to add is given
by \fIinputLen\fR. A non-zero value of \fIaddAtEnd\fR indicates that the
data is to be added at the end of queue; otherwise it will be added at the
-head of the queue. If \fIchannel\fR has a "sticky" EOF set, no data will be
+head of the queue. If \fIchannel\fR has a
+.QW sticky
+EOF set, no data will be
added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or
--1 if an error occurs.
-
+\-1 if an error occurs.
.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE"
.PP
\fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at
@@ -540,19 +523,19 @@ 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.
.PP
-\fBTcl_Write\fR is similar to \fBTcl_WriteChars\fR except that it doesn't do
+\fBTcl_Write\fR is similar to \fBTcl_WriteChars\fR except that it does not do
encoding conversions, regardless of the channel's encoding. It is
deprecated and exists for backwards compatibility with non-internationalized
Tcl extensions. It accepts \fIbytesToWrite\fR bytes of data at
@@ -568,7 +551,6 @@ not. Thus this function is \fBonly\fR usable for transformational
channel drivers, i.e. drivers used in the middle of a stack of
channels, to move data from the transformation into the channel below
it.
-
.SH TCL_FLUSH
.PP
\fBTcl_Flush\fR causes all of the buffered output data for \fIchannel\fR
@@ -582,7 +564,6 @@ eventually, as fast as the channel is able to absorb it.
The return value is normally \fBTCL_OK\fR.
If an error occurs, \fBTcl_Flush\fR returns \fBTCL_ERROR\fR and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
-
.SH TCL_SEEK
.PP
\fBTcl_Seek\fR moves the access point in \fIchannel\fR where subsequent
@@ -593,20 +574,15 @@ buffered input is discarded, prior to the seek operation.
If an error occurs, \fBTcl_Seek\fR returns \-1 and records a POSIX error
code that can be retrieved with \fBTcl_GetErrno\fR.
After an error, the access point may or may not have been moved.
-
.SH TCL_TELL
.PP
\fBTcl_Tell\fR returns the current access point for a channel. The returned
value is \-1 if the channel does not support seeking.
-
.SH TCL_TRUNCATECHANNEL
.PP
-.VS 8.5
\fBTcl_TruncateChannel\fR truncates the file underlying \fIchannel\fR
to a given \fIlength\fR of bytes. It returns \fBTCL_OK\fR if the
operation succeeded, and \fBTCL_ERROR\fR otherwise.
-.VE 8.5
-
.SH TCL_GETCHANNELOPTION
.PP
\fBTcl_GetChannelOption\fR retrieves, in \fIoptionValue\fR, the value of one of
@@ -628,7 +604,6 @@ for the Tcl \fBsocket\fR command.
The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns
\fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
-
.SH TCL_SETCHANNELOPTION
.PP
\fBTcl_SetChannelOption\fR sets a new value \fInewValue\fR
@@ -636,30 +611,26 @@ for an option \fIoptionName\fR on \fIchannel\fR.
The procedure normally returns \fBTCL_OK\fR. If an error occurs,
it returns \fBTCL_ERROR\fR; in addition, if \fIinterp\fR is non-NULL,
\fBTcl_SetChannelOption\fR leaves an error message in the interpreter's result.
-
.SH TCL_EOF
.PP
\fBTcl_Eof\fR returns a nonzero value if \fIchannel\fR encountered
an end of file during the last input operation.
-
.SH TCL_INPUTBLOCKED
.PP
\fBTcl_InputBlocked\fR returns a nonzero value if \fIchannel\fR is in
nonblocking mode and the last input operation returned less data than
requested because there was insufficient data available.
The call always returns zero if the channel is in blocking mode.
-
.SH TCL_INPUTBUFFERED
.PP
\fBTcl_InputBuffered\fR returns the number of bytes of input currently
buffered in the internal buffers for a channel. If the channel is not open
for reading, this function always returns zero.
-
.SH TCL_OUTPUTBUFFERED
+.PP
\fBTcl_OutputBuffered\fR returns the number of bytes of output
currently buffered in the internal buffers for a channel. If the
channel is not open for writing, this function always returns zero.
-
.SH "PLATFORM ISSUES"
.PP
The handles returned from \fBTcl_GetChannelHandle\fR depend on the
@@ -670,10 +641,8 @@ the channel was created with \fBTcl_OpenFileChannel\fR,
\fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR. Other
channel types may return a different type of handle on Windows
platforms.
-
.SH "SEE ALSO"
DString(3), fconfigure(n), filename(n), fopen(3), Tcl_CreateChannel(3)
-
.SH KEYWORDS
access point, blocking, buffered I/O, channel, channel driver, end of file,
flush, input, nonblocking, output, read, seek, write
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index f5b733d..9fe2615 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -4,9 +4,8 @@
'\" 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.10 2005/05/10 18:33:57 kennykb Exp $
-.so man.macros
.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -50,15 +49,13 @@ accepted via the socket.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
-
.SH DESCRIPTION
.PP
These functions are convenience procedures for creating
channels that communicate over TCP sockets.
The operations on a channel
are described in the manual entry for \fBTcl_OpenFileChannel\fR.
-
-.SH TCL_OPENTCPCLIENT
+.SS TCL_OPENTCPCLIENT
.PP
\fBTcl_OpenTcpClient\fR opens a client TCP socket connected to a \fIport\fR
on a specific \fIhost\fR, and returns a channel that can be used to
@@ -95,43 +92,42 @@ is left in the interpreter's result.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
-.SH TCL_MAKETCPCLIENTCHANNEL
+.SS TCL_MAKETCPCLIENTCHANNEL
.PP
\fBTcl_MakeTcpClientChannel\fR creates a \fBTcl_Channel\fR around an
existing, platform specific, handle for a client TCP socket.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
-.SH TCL_OPENTCPSERVER
+.SS TCL_OPENTCPSERVER
.PP
\fBTcl_OpenTcpServer\fR opens a TCP socket on the local host on a specified
\fIport\fR and uses the Tcl event mechanism to accept requests from clients
-to connect to it. The \fImyaddr\fP argument specifies the network interface.
-If \fImyaddr\fP is NULL the special address INADDR_ANY should be used to
+to connect to it. The \fImyaddr\fR argument specifies the network interface.
+If \fImyaddr\fR is NULL the special address INADDR_ANY should be used to
allow connections from any network interface.
Each time a client connects to this socket, Tcl creates a channel
for the new connection and invokes \fIproc\fR with information about
-the channel. \fIProc\fR must match the following prototype:
+the channel. \fIProc\fR must match the following prototype:
+.PP
.CS
-typedef void Tcl_TcpAcceptProc(
+typedef void \fBTcl_TcpAcceptProc\fR(
ClientData \fIclientData\fR,
Tcl_Channel \fIchannel\fR,
char *\fIhostName\fR,
- int \fIport\fP);
+ int \fIport\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_OpenTcpServer\fR, \fIchannel\fR will be the handle
for the new channel, \fIhostName\fR points to a string containing
-the name of the client host making the connection, and \fIport\fP
+the name of the client host making the connection, and \fIport\fR
will contain the client's port number.
The new channel
is opened for both input and output.
@@ -159,18 +155,15 @@ a remote client is pending.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR.
-If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
+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.
-
.SH "PLATFORM ISSUES"
.PP
On Unix platforms, the socket handle is a Unix file descriptor as
returned by the \fBsocket\fR system call. On the Windows platform, the
socket handle is a \fBSOCKET\fR as defined in the WinSock API.
-
.SH "SEE ALSO"
Tcl_OpenFileChannel(3), Tcl_RegisterChannel(3), vwait(n)
-
.SH KEYWORDS
-client, server, TCP
+channel, client, server, socket, TCP
diff --git a/doc/Panic.3 b/doc/Panic.3
index 0b2ec03..28d56fa 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -2,10 +2,8 @@
'\" 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.8 2005/09/13 21:23:51 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -35,9 +33,7 @@ Must have been initialized using \fBva_start\fR,
and cleared using \fBva_end\fR.
.AP Tcl_PanicProc *panicProc in
Procedure to report fatal error message and abort.
-
.BE
-
.SH DESCRIPTION
.PP
When the Tcl library detects that its internal data structures are in an
@@ -53,33 +49,31 @@ 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
type \fBTcl_PanicProc\fR:
.PP
.CS
-typedef void Tcl_PanicProc(
+typedef void \fBTcl_PanicProc\fR(
const char *\fBformat\fR,
\fBarg\fR, \fBarg\fR,...);
.CE
.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
@@ -89,10 +83,7 @@ will be displayed.
.PP
\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of
taking a variable number of arguments it takes an argument list.
-
.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)
-
.SH KEYWORDS
abort, fatal, error
-
diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3
new file mode 100644
index 0000000..df0ad33
--- /dev/null
+++ b/doc/ParseArgs.3
@@ -0,0 +1,198 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_ParseArgsObjv \- parse arguments according to a tabular description
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR)
+.SH ARGUMENTS
+.AS "const Tcl_ArgvInfo" ***remObjv in/out
+.AP Tcl_Interp *interp out
+Where to store error messages.
+.AP "const Tcl_ArgvInfo" *argTable in
+Pointer to array of option descriptors.
+.AP int *objcPtr in/out
+A pointer to variable holding number of arguments in \fIobjv\fR. Will be
+modified to hold number of arguments left in the unprocessed argument list
+stored in \fIremObjv\fR.
+.AP "Tcl_Obj *const" *objv in
+The array of arguments to be parsed.
+.AP Tcl_Obj ***remObjv out
+Pointer to a variable that will hold the array of unprocessed arguments.
+Should be NULL if no return of unprocessed arguments is required. If
+\fIobjcPtr\fR is updated to a non-zero value, the array returned through this
+must be deallocated using \fBckfree\fR.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument
+lists of the form
+.QW "\fB\-someName \fIsomeValue\fR ..." .
+Such argument lists are commonly found both in the arguments to a program and
+in the arguments to an individual Tcl command. This parser assumes that the
+order of the arguments does not matter, other than in so far as later copies
+of a duplicated option overriding earlier ones.
+.PP
+The argument array is described by the \fIobjcPtr\fR and \fIobjv\fR
+parameters, and an array of unprocessed arguments is returned through the
+\fIobjcPtr\fR and \fIremObjv\fR parameters; if no return of unprocessed
+arguments is desired, the \fIremObjv\fR parameter should be NULL. If any
+problems happen, including if the
+.QW "generate help"
+option is selected, an error message is left in the interpreter result and
+TCL_ERROR is returned. Otherwise, the interpreter result is left unchanged and
+TCL_OK is returned.
+.PP
+The collection of arguments to be parsed is described by the \fIargTable\fR
+parameter. This points to a table of descriptor structures that is terminated
+by an entry with the \fItype\fR field set to TCL_ARGV_END. As convenience, the
+following prototypical entries are provided:
+.TP
+\fBTCL_ARGV_AUTO_HELP\fR
+.
+Enables the argument processor to provide help when passed the argument
+.QW \fB\-help\fR .
+.TP
+\fBTCL_ARGV_AUTO_REST\fR
+.
+Instructs the argument processor that arguments after
+.QW \fB\-\-\fR
+are to be unprocessed.
+.TP
+\fBTCL_ARGV_TABLE_END\fR
+.
+Marks the end of the table of argument descriptors.
+.SS "ARGUMENT DESCRIPTOR ENTRIES"
+.PP
+Each entry of the argument descriptor table must be a structure of type
+\fBTcl_ArgvInfo\fR. The structure is defined as this:
+.PP
+.CS
+typedef struct {
+ int \fItype\fR;
+ const char *\fIkeyStr\fR;
+ void *\fIsrcPtr\fR;
+ void *\fIdstPtr\fR;
+ const char *\fIhelpStr\fR;
+ ClientData \fIclientData\fR;
+} \fBTcl_ArgvInfo\fR;
+.CE
+.PP
+The \fIkeyStr\fR field contains the name of the option; by convention, this
+will normally begin with a
+.QW \fB\-\fR
+character. The \fItype\fR, \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR
+fields describe the interpretation of the value of the argument, as described
+below. The \fIhelpStr\fR field gives some text that is used to provide help to
+users when they request it.
+.PP
+As noted above, the \fItype\fR field is used to describe the interpretation of
+the argument's value. The following values are acceptable values for
+\fItype\fR:
+.TP
+\fBTCL_ARGV_CONSTANT\fR
+.
+The argument does not take any following value argument. If this argument is
+present, the int pointed to by the \fIsrcPtr\fR field is copied to the
+\fIdstPtr\fR field. The \fIclientData\fR field is ignored.
+.TP
+\fBTCL_ARGV_END\fR
+.
+This value marks the end of all option descriptors in the table. All other
+fields are ignored.
+.TP
+\fBTCL_ARGV_FLOAT\fR
+.
+This argument takes a following floating point value argument. The value (once
+parsed by \fBTcl_GetDoubleFromObj\fR) will be stored as a double-precision
+value in the variable pointed to by the \fIdstPtr\fR field. The \fIsrcPtr\fR
+and \fIclientData\fR fields are ignored.
+.TP
+\fBTCL_ARGV_FUNC\fR
+.
+This argument optionally takes a following value argument; it is up to the
+handler callback function passed in \fIsrcPtr\fR to decide. That function will
+have the following signature:
+.RS
+.PP
+.CS
+typedef int (\fBTcl_ArgvFuncProc\fR)(
+ ClientData \fIclientData\fR,
+ Tcl_Obj *\fIobjPtr\fR,
+ void *\fIdstPtr\fR);
+.CE
+.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 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
+.TP
+\fBTCL_ARGV_GENFUNC\fR
+.
+This argument takes zero or more following arguments; the handler callback
+function passed in \fIsrcPtr\fR returns how many (or a negative number to
+signal an error, in which case it should also set the interpreter result). The
+function will have the following signature:
+.RS
+.PP
+.CS
+typedef int (\fBTcl_ArgvGenFuncProc\fR)(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ int \fIobjc\fR,
+ Tcl_Obj *const *\fIobjv\fR,
+ void *\fIdstPtr\fR);
+.CE
+.PP
+The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is
+where to store any error messages, the \fIkeyStr\fR is the name of the
+argument, \fIobjc\fR and \fIobjv\fR describe an array of all the remaining
+arguments, and \fIdstPtr\fR argument to the \fBTcl_ArgvGenFuncProc\fR is the
+location to write the parsed value (or values) to.
+.RE
+.TP
+\fBTCL_ARGV_HELP\fR
+.
+This special argument does not take any following value argument, but instead
+causes \fBTcl_ParseArgsObjv\fR to generate an error message describing the
+arguments supported. All other fields except the \fIhelpStr\fR field are
+ignored.
+.TP
+\fBTCL_ARGV_INT\fR
+.
+This argument takes a following integer value argument. The value (once parsed
+by \fBTcl_GetIntFromObj\fR) will be stored as an int in the variable pointed
+to by the \fIdstPtr\fR field. The \fIsrcPtr\fR field is ignored.
+.TP
+\fBTCL_ARGV_REST\fR
+.
+This special argument does not take any following value argument, but instead
+marks all following arguments to be left unprocessed. The \fIsrcPtr\fR,
+\fIdstPtr\fR and \fIclientData\fR fields are ignored.
+.TP
+\fBTCL_ARGV_STRING\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 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"
+Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3)
+.SH KEYWORDS
+argument, parse
+'\" Local Variables:
+'\" fill-column: 78
+'\" End:
diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3
index 921ba22..7090dd3 100644
--- a/doc/ParseCmd.3
+++ b/doc/ParseCmd.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: ParseCmd.3,v 1.22 2005/09/15 23:13:32 msofer Exp $
-'\"
-.so man.macros
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
@@ -82,7 +80,6 @@ if the parse was successful.
Points to structure that was filled in by a previous call to
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseVarName\fR, etc.
.BE
-
.SH DESCRIPTION
.PP
These procedures parse Tcl commands or portions of Tcl commands such as
@@ -92,7 +89,7 @@ and fills in the structure pointed to by \fIparsePtr\fR
with a collection of tokens describing the information that was parsed.
The procedures normally return \fBTCL_OK\fR.
However, if an error occurs then they return \fBTCL_ERROR\fR,
-leave an error message in \fIinterp's\fR result
+leave an error message in \fIinterp\fR's result
(if \fIinterp\fR is not NULL),
and leave nothing in \fIparsePtr\fR.
.PP
@@ -119,7 +116,7 @@ result, and no information is left at \fI*parsePtr\fR.
.PP
\fBTcl_ParseBraces\fR parses a string or command argument
enclosed in braces such as
-\fB{hello}\fR or \fB{string \\t with \\t tabs}\fR
+\fB{hello}\fR or \fB{string \et with \et tabs}\fR
from the beginning of its argument \fIstart\fR.
The first character of \fIstart\fR must be \fB{\fR.
If the braced string was parsed successfully,
@@ -135,15 +132,15 @@ an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
.PP
\fBTcl_ParseQuotedString\fR parses a double-quoted string such as
-\fB"sum is [expr $a+$b]"\fR
+\fB"sum is [expr {$a+$b}]"\fR
from the beginning of the argument \fIstart\fR.
-The first character of \fIstart\fR must be \fB"\fR.
+The first character of \fIstart\fR must be \fB\N'34'\fR.
If the double-quoted string was parsed successfully,
\fBTcl_ParseQuotedString\fR returns \fBTCL_OK\fR,
fills in the structure pointed to by \fIparsePtr\fR
with information about the structure of the string
(see below for details),
-and stores a pointer to the character just after the terminating \fB"\fR
+and stores a pointer to the character just after the terminating \fB\N'34'\fR
in the location given by \fI*termPtr\fR.
If an error occurs while parsing the string
then \fBTCL_ERROR\fR is returned,
@@ -151,7 +148,7 @@ an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
.PP
\fBTcl_ParseVarName\fR parses a Tcl variable reference such as
-\fB$abc\fR or \fB$x([expr $index + 1])\fR from the beginning of its
+\fB$abc\fR or \fB$x([expr {$index + 1}])\fR from the beginning of its
\fIstart\fR argument.
The first character of \fIstart\fR must be \fB$\fR.
If a variable name was parsed successfully, \fBTcl_ParseVarName\fR
@@ -159,11 +156,11 @@ returns \fBTCL_OK\fR and fills in the structure pointed to by
\fIparsePtr\fR with information about the structure of the variable name
(see below for details). If an error
occurs while parsing the command then \fBTCL_ERROR\fR is returned, an
-error message is left in \fIinterp\fR's result (if \fIinterp\fR isn't
+error message is left in \fIinterp\fR's result (if \fIinterp\fR is not
NULL), and no information is left at \fI*parsePtr\fR.
.PP
\fBTcl_ParseVar\fR parse a Tcl variable reference such as \fB$abc\fR
-or \fB$x([expr $index + 1])\fR from the beginning of its \fIstart\fR
+or \fB$x([expr {$index + 1}])\fR from the beginning of its \fIstart\fR
argument. The first character of \fIstart\fR must be \fB$\fR. If
the variable name is parsed successfully, \fBTcl_ParseVar\fR returns a
pointer to the string value of the variable. If an error occurs while
@@ -197,37 +194,37 @@ 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
of \fBTcl_EvalTokens\fR is deprecated.
-
.SH "TCL_PARSE STRUCTURE"
.PP
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
return parse information in two data structures, Tcl_Parse and Tcl_Token:
+.PP
.CS
typedef struct Tcl_Parse {
- const char *\fIcommentStart\fR;
- int \fIcommentSize\fR;
- const char *\fIcommandStart\fR;
- int \fIcommandSize\fR;
- int \fInumWords\fR;
- Tcl_Token *\fItokenPtr\fR;
- int \fInumTokens\fR;
- ...
-} Tcl_Parse;
+ const char *\fIcommentStart\fR;
+ int \fIcommentSize\fR;
+ const char *\fIcommandStart\fR;
+ int \fIcommandSize\fR;
+ int \fInumWords\fR;
+ Tcl_Token *\fItokenPtr\fR;
+ int \fInumTokens\fR;
+ ...
+} \fBTcl_Parse\fR;
typedef struct Tcl_Token {
- int \fItype\fR;
- const char *\fIstart\fR;
- int \fIsize\fR;
- int \fInumComponents\fR;
-} Tcl_Token;
+ int \fItype\fR;
+ const char *\fIstart\fR;
+ int \fIsize\fR;
+ int \fInumComponents\fR;
+} \fBTcl_Token\fR;
.CE
.PP
The first five fields of a Tcl_Parse structure
@@ -269,6 +266,7 @@ the \fInumComponents\fR field describes how many of these there are.
The \fItype\fR field has one of the following values:
.TP 20
\fBTCL_TOKEN_WORD\fR
+.
This token ordinarily describes one word of a command
but it may also describe a quoted or braced string in an expression.
The token describes a component of the script that is
@@ -283,29 +281,32 @@ number of sub-tokens that make up the word, including sub-tokens
of \fBTCL_TOKEN_VARIABLE\fR and \fBTCL_TOKEN_BS\fR tokens.
.TP
\fBTCL_TOKEN_SIMPLE_WORD\fR
+.
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the word is guaranteed to consist of a single \fBTCL_TOKEN_TEXT\fR
sub-token. The \fInumComponents\fR field is always 1.
.TP
\fBTCL_TOKEN_EXPAND_WORD\fR
-.VS 8.5
+.
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the command parser notes this word began with the expansion
-prefix \fB{expand}\fR, indicating that after substitution,
+prefix \fB{*}\fR, indicating that after substitution,
the list value of this word should be expanded to form multiple
arguments in command evaluation. This
token type can only be created by Tcl_ParseCommand.
-.VE 8.5
.TP
\fBTCL_TOKEN_TEXT\fR
+.
The token describes a range of literal text that is part of a word.
The \fInumComponents\fR field is always 0.
.TP
\fBTCL_TOKEN_BS\fR
+.
The token describes a backslash sequence such as \fB\en\fR or \fB\e0xa3\fR.
The \fInumComponents\fR field is always 0.
.TP
\fBTCL_TOKEN_COMMAND\fR
+.
The token describes a command whose result must be substituted into
the word. The token includes the square brackets that surround the
command. The \fInumComponents\fR field is always 0 (the nested command
@@ -313,6 +314,7 @@ is not parsed; call \fBTcl_ParseCommand\fR recursively if you want to
see its tokens).
.TP
\fBTCL_TOKEN_VARIABLE\fR
+.
The token describes a variable substitution, including the
\fB$\fR, variable name, and array index (if there is one) up through the
close parenthesis that terminates the index. This token is followed
@@ -328,6 +330,7 @@ array index. The \fInumComponents\fR field includes nested sub-tokens
that are part of \fBTCL_TOKEN_VARIABLE\fR tokens in the array index.
.TP
\fBTCL_TOKEN_SUB_EXPR\fR
+.
The token describes one subexpression of an expression
(or an entire expression).
A subexpression may consist of a value
@@ -354,6 +357,7 @@ counts the total number of sub-tokens that make up the subexpression;
this includes the sub-tokens for any nested \fBTCL_TOKEN_SUB_EXPR\fR tokens.
.TP
\fBTCL_TOKEN_OPERATOR\fR
+.
The token describes one operator of an expression
such as \fB&&\fR or \fBhypot\fR.
A \fBTCL_TOKEN_OPERATOR\fR token is always preceded by a
@@ -364,7 +368,7 @@ can be used to determine the number of operands.
A binary operator such as \fB*\fR
is followed by two \fBTCL_TOKEN_SUB_EXPR\fR tokens
that describe its operands.
-A unary operator like \fB-\fR
+A unary operator like \fB\-\fR
is followed by a single \fBTCL_TOKEN_SUB_EXPR\fR token
for its operand.
If the operator is a math function such as \fBlog10\fR,
@@ -385,7 +389,6 @@ is always 0.
After \fBTcl_ParseCommand\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_WORD\fR or
-.VS 8.5
\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.
It is followed by the sub-tokens
that must be concatenated to produce the value of that word.
@@ -394,7 +397,6 @@ of \fBTCL_TOKEN_EXPAND_WORD\fR token for the second word,
followed by sub-tokens for that
word, and so on until all \fInumWords\fR have been accounted
for.
-.VE 8.5
.PP
After \fBTcl_ParseExpr\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
@@ -461,6 +463,5 @@ There are additional fields in the Tcl_Parse structure after the
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be
referenced by code outside of these procedures.
-
.SH KEYWORDS
backslash substitution, braces, command, expression, parse, token, variable substitution
diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3
index 4cb939a..5c9fdca 100644
--- a/doc/PkgRequire.3
+++ b/doc/PkgRequire.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: PkgRequire.3,v 1.9 2004/10/07 15:15:47 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control
+Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgRequireProc, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,6 +19,9 @@ const char *
const char *
\fBTcl_PkgRequireEx\fR(\fIinterp, name, version, exact, clientDataPtr\fR)
.sp
+int
+\fBTcl_PkgRequireProc\fR(\fIinterp, name, objc, objv, clientDataPtr\fR)
+.sp
const char *
\fBTcl_PkgPresent\fR(\fIinterp, name, version, exact\fR)
.sp
@@ -33,7 +34,7 @@ int
int
\fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
.SH ARGUMENTS
-.AS ClientData clientDataPtr out
+.AS void *clientDataPtr out
.AP Tcl_Interp *interp in
Interpreter where package is needed or available.
.AP "const char" *name in
@@ -47,14 +48,18 @@ Non-zero means that only the particular version specified by
Zero means that newer versions than \fIversion\fR are also
acceptable as long as they have the same major version number
as \fIversion\fR.
-.AP ClientData clientData in
+.AP "const void" *clientData in
Arbitrary value to be associated with the package.
-.AP ClientData *clientDataPtr out
+.AP void *clientDataPtr out
Pointer to place to store the value associated with the matching
package. It is only changed if the pointer is not NULL and the
-function completed successfully.
+function completed successfully. The storage can be any pointer
+type with the same size as a void pointer.
+.AP int objc in
+Number of requirements.
+.AP Tcl_Obj* objv[] in
+Array of requirements.
.BE
-
.SH DESCRIPTION
.PP
These procedures provide C-level interfaces to Tcl's package and
@@ -82,6 +87,11 @@ in the interpreter's result.
allow the setting and retrieving of the client data associated with
the package. In all other respects they are equivalent to the matching
functions.
-
+.PP
+\fBTcl_PkgRequireProc\fR is the form of \fBpackage require\fR handling
+multiple requirements. The other forms are present for backward
+compatibility and translate their invocations to this form.
.SH KEYWORDS
package, present, provide, require, version
+.SH "SEE ALSO"
+package(n), Tcl_StaticPackage(3)
diff --git a/doc/Preserve.3 b/doc/Preserve.3
index b0197db..970bded 100644
--- a/doc/Preserve.3
+++ b/doc/Preserve.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: Preserve.3,v 1.4 2002/02/26 02:22:20 hobbs Exp $
-'\"
-.so man.macros
.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it's being used
+Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it is being used
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -29,7 +27,6 @@ to memory for structure.
.AP Tcl_FreeProc *freeProc in
Procedure to invoke to free \fIclientData\fR.
.BE
-
.SH DESCRIPTION
.PP
These three procedures help implement a simple reference count mechanism
@@ -38,7 +35,7 @@ having to do with widget deletion, but are also useful in many other
situations. When a widget is deleted, its
widget record (the structure holding information specific to the
widget) must be returned to the storage allocator.
-However, it's possible that the widget record is in active use
+However, it is possible that the widget record is in active use
by one of the procedures on the stack at the time of the deletion.
This can happen, for example, if the command associated with a button
widget causes the button to be destroyed: an X event causes an
@@ -80,9 +77,12 @@ calls to \fBTcl_Release\fR then \fIfreeProc\fR will be called by
All the work of freeing the object is carried out by \fIfreeProc\fR.
\fIFreeProc\fR must have arguments and result that match the
type \fBTcl_FreeProc\fR:
+.PP
.CS
-typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+typedef void \fBTcl_FreeProc\fR(
+ char *\fIblockPtr\fR);
.CE
+.PP
The \fIblockPtr\fR argument to \fIfreeProc\fR will be the
same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
@@ -104,9 +104,7 @@ mechanism for long-term reference counts.
The implementation does not depend in any way on the internal
structure of the objects being freed; it keeps the reference
counts in a separate structure.
-
.SH "SEE ALSO"
Tcl_Interp, Tcl_Alloc
-
.SH KEYWORDS
free, reference count, storage
diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3
index 4588126..730794f 100644
--- a/doc/PrintDbl.3
+++ b/doc/PrintDbl.3
@@ -5,10 +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: PrintDbl.3,v 1.7 2005/05/10 18:33:57 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_PrintDouble \- Convert floating value to string
@@ -30,17 +28,18 @@ Floating-point value to be converted.
Where to store the string representing \fIvalue\fR. Must have at
least \fBTCL_DOUBLE_SPACE\fR characters of storage.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_PrintDouble\fR generates a string that represents the value
of \fIvalue\fR and stores it in memory at the location given by
\fIdst\fR. It uses \fB%g\fR format to generate the string, with one
-special twist: the string is guaranteed to contain either
-a ``.'' or an ``e'' so that it doesn't look like an integer. Where
-\fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR
-adds ``.0''.
-.VS 8.5
+special twist: the string is guaranteed to contain either a
+.QW .
+or an
+.QW e
+so that it does not look like an integer. Where \fB%g\fR would
+generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds
+.QW .0 .
.PP
If the \fBtcl_precision\fR value is non-zero, the result will have
precisely that many digits of significance. If the value is zero
@@ -48,7 +47,5 @@ precisely that many digits of significance. If the value is zero
represent the number in such a way that \fBTcl_NewDoubleObj\fR
will generate the same number when presented with the given string.
IEEE semantics of rounding to even apply to the conversion.
-.VE
-
.SH KEYWORDS
conversion, double-precision, floating-point, string
diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3
index 742524c..387cc44 100644
--- a/doc/RecEvalObj.3
+++ b/doc/RecEvalObj.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: RecEvalObj.3,v 1.5 2004/09/18 17:01:06 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_RecordAndEvalObj \- save command on history list before evaluating
@@ -22,11 +20,11 @@ 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
-command but don't evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate
+command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate
the command at global level instead of the current stack level.
.BE
@@ -37,10 +35,10 @@ 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 don't want the command recorded on the history list then
+If you do not want the command recorded on the history list then
you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR.
Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level
commands typed by the user, since the purpose of history is to
@@ -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 68cdd9a..e1625ff 100644
--- a/doc/RecordEval.3
+++ b/doc/RecordEval.3
@@ -5,10 +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: RecordEval.3,v 1.7 2004/10/07 15:15:47 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_RecordAndEval \- save command on history list before evaluating
@@ -26,7 +24,7 @@ Tcl interpreter in which to evaluate command.
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
-command but don't evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate
+command but do not evaluate it. \fBTCL_EVAL_GLOBAL\fR means evaluate
the command at global level instead of the current stack level.
.BE
@@ -37,7 +35,7 @@ on the history list and then execute it using \fBTcl_Eval\fR
(or \fBTcl_GlobalEval\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_Eval\fR
and it leaves information in the interpreter's result.
-If you don't want the command recorded on the history list then
+If you do not want the command recorded on the history list then
you should invoke \fBTcl_Eval\fR instead of \fBTcl_RecordAndEval\fR.
Normally \fBTcl_RecordAndEval\fR is only called with top-level
commands typed by the user, since the purpose of history is to
@@ -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 908c2ec..d73e3d7 100644
--- a/doc/RegConfig.3
+++ b/doc/RegConfig.3
@@ -4,9 +4,8 @@
'\" 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.6 2004/10/07 15:15:47 dkf Exp $
-.so man.macros
.TH Tcl_RegisterConfig 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -27,7 +26,7 @@ registered for. Must not be NULL.
Contains the name of the package registering the embedded
configuration as ASCII string. This means that this information is in
UTF-8 too. Must not be NULL.
-.AP Tcl_Config *configuration in
+.AP "const Tcl_Config" *configuration in
Refers to an array of Tcl_Config entries containing the information
embedded in the binary library. Must not be NULL. The end of the array
is signaled by either a key identical to NULL, or a key referring to
@@ -37,7 +36,6 @@ Contains the name of the encoding used to store the configuration
values as ASCII string. This means that this information is in UTF-8
too. Must not be NULL.
.BE
-
.SH DESCRIPTION
.PP
The function described here has its base in TIP 59 and provides
@@ -72,9 +70,9 @@ NULL. The function makes \fBno\fR copy of the \fIconfiguration\fR
array. This means that the caller has to make sure that the memory
holding this array is never released. This is the meaning behind the
word \fBnon-volatile\fR used earlier. The easiest way to accomplish
-this is to define a global static array of Tcl_Config entries. See the
-file "generic/tclPkgConfig.c" in the sources of the Tcl core for an
-example.
+this is to define a global static array of Tcl_Config entries. See the file
+.QW generic/tclPkgConfig.c
+in the sources of the Tcl core for an example.
.PP
When called \fBTcl_RegisterConfig\fR will
.IP (1)
@@ -82,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
@@ -97,20 +95,17 @@ Returns a list containing the names of all defined keys.
Returns the configuration value associated with the specified
\fIkey\fR.
.RE
-
.SH TCL_CONFIG
-
+.PP
The \fBTcl_Config\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_Config {
- const char* key;
- const char* value;
-} Tcl_Config;
+ const char *\fIkey\fR;
+ const char *\fIvalue\fR;
+} \fBTcl_Config\fR;
.CE
-
-'\" No cross references yet.
-'\" .SH "SEE ALSO"
-
+.\" No cross references yet.
+.\" .SH "SEE ALSO"
.SH KEYWORDS
-embedding, configuration, bianry library
+embedding, configuration, binary library
diff --git a/doc/RegExp.3 b/doc/RegExp.3
index 48cbd65..63f650b 100644
--- a/doc/RegExp.3
+++ b/doc/RegExp.3
@@ -6,10 +6,8 @@
'\" 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.23 2005/05/10 18:33:57 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegExpFromObj, Tcl_RegExpMatchObj, Tcl_RegExpExecObj, Tcl_RegExpGetInfo \- Pattern matching with regular expressions
@@ -40,19 +38,19 @@ int
.sp
void
\fBTcl_RegExpGetInfo\fR(\fIregexp\fR, \fIinfoPtr\fR)
-
+.fi
.SH ARGUMENTS
.AS Tcl_RegExpInfo *interp in/out
.AP Tcl_Interp *interp in
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
@@ -63,8 +61,9 @@ by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
-If it isn't the same as \fItext\fR, then no \fB^\fR matches
-will be allowed.
+If it is not the same as \fItext\fR, then no
+.QW \fB^\fR
+matches will be allowed.
.AP int index in
Specifies which range is desired: 0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
@@ -76,7 +75,11 @@ NULL if there is no such range.
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.AP int cflags in
-OR-ed combination of compilation flags. See below for more information.
+OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
+\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
+\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
+\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
+\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP int offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches. This
@@ -84,18 +87,17 @@ behavior is controlled by \fIeflags\fR.
.AP int nmatches in
The number of matching subexpressions that should be remembered for
later use. If this value is 0, then no subexpression match
-information will be computed. If the value is -1, then
+information will be computed. If the value is \-1, then
all of the matching subexpressions will be remembered. Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
-OR-ed combination of the values \fBTCL_REG_NOTBOL\fR and \fBTCL_REG_NOTEOL\fR.
-See below for more information.
+OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
+\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out
The address of the location where information about a previous match
should be stored by \fBTcl_RegExpGetInfo\fR.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
@@ -108,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.
@@ -139,7 +141,9 @@ For example, when searching for the second occurrence of a
match, the \fItext\fR argument might point to the character
just after the first match; however, it is important for the
pattern matcher to know that this is not the start of the entire string,
-so that it doesn't allow \fB^\fR atoms in the pattern to match.
+so that it does not allow
+.QW \fB^\fR
+atoms in the pattern to match.
The \fIstart\fR argument provides this information by pointing
to the start of the overall string containing \fItext\fR.
\fIStart\fR will be less than or equal to \fItext\fR; if it
@@ -160,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
@@ -180,23 +184,29 @@ occurs while compiling the regular expression then
\fBTcl_GetRegExpFromObj\fR returns NULL and leaves an error message in
the interpreter result. The regular expression token can be used as
long as the internal representation of \fIpatObj\fR refers to the
-compiled form. The \fIeflags\fR argument is a bit-wise OR of
+compiled form. The \fIcflags\fR argument is a bit-wise OR of
zero or more of the following flags that control the compilation of
\fIpatObj\fR:
.RS 2
.TP
\fBTCL_REG_ADVANCED\fR
-Compile advanced regular expressions (`AREs'). This mode corresponds to
+Compile advanced regular expressions
+.PQ ARE s .
+This mode corresponds to
the normal regular expression syntax accepted by the Tcl \fBregexp\fR and
\fBregsub\fR commands.
.TP
\fBTCL_REG_EXTENDED\fR
-Compile extended regular expressions (`EREs'). This mode corresponds
+Compile extended regular expressions
+.PQ ERE s .
+This mode corresponds
to the regular expression syntax recognized by Tcl 8.0 and earlier
versions.
.TP
\fBTCL_REG_BASIC\fR
-Compile basic regular expressions (`BREs'). This mode corresponds
+Compile basic regular expressions
+.PQ BRE s .
+This mode corresponds
to the regular expression syntax recognized by common Unix utilities
like \fBsed\fR and \fBgrep\fR. This is the default if no flags are
specified.
@@ -216,9 +226,16 @@ Compile for matching that ignores upper/lower case distinctions.
\fBTCL_REG_NEWLINE\fR
Compile for newline-sensitive matching. By default, newline is a
completely ordinary character with no special meaning in either
-regular expressions or strings. With this flag, `[^' bracket
-expressions and `.' never match newline, `^' matches an empty string
-after any newline in addition to its normal function, and `$' matches
+regular expressions or strings. With this flag,
+.QW [^
+bracket expressions and
+.QW .
+never match newline,
+.QW ^
+matches an empty string
+after any newline in addition to its normal function, and
+.QW $
+matches
an empty string before any newline in addition to its normal function.
\fBREG_NEWLINE\fR is the bit-wise OR of \fBREG_NLSTOP\fR and
\fBREG_NLANCH\fR.
@@ -226,16 +243,37 @@ an empty string before any newline in addition to its normal function.
\fBTCL_REG_NLSTOP\fR
Compile for partial newline-sensitive matching,
with the behavior of
-`[^' bracket expressions and `.' affected,
-but not the behavior of `^' and `$'. In this mode, `[^' bracket
-expressions and `.' never match newline.
+.QW [^
+bracket expressions and
+.QW .
+affected, but not the behavior of
+.QW ^
+and
+.QW $ .
+In this mode,
+.QW [^
+bracket expressions and
+.QW .
+never match newline.
.TP
\fBTCL_REG_NLANCH\fR
Compile for inverse partial newline-sensitive matching,
-with the behavior
-of `^' and `$' (the ``anchors'') affected, but not the behavior of
-`[^' bracket expressions and `.'. In this mode `^' matches an empty string
-after any newline in addition to its normal function, and `$' matches
+with the behavior of
+.QW ^
+and
+.QW $
+(the
+.QW anchors )
+affected, but not the behavior of
+.QW [^
+bracket expressions and
+.QW . .
+In this mode
+.QW ^
+matches an empty string
+after any newline in addition to its normal function, and
+.QW $
+matches
an empty string before any newline in addition to its normal function.
.TP
\fBTCL_REG_NOSUB\fR
@@ -263,7 +301,7 @@ error message in the interpreter result. The \fInmatches\fR value
indicates to the matcher how many subexpressions are of interest. If
\fInmatches\fR is 0, then no subexpression match information is
recorded, which may allow the matcher to make various optimizations.
-If the value is -1, then all of the subexpressions in the pattern are
+If the value is \-1, then all of the subexpressions in the pattern are
remembered. If the value is a positive integer, then only that number
of subexpressions will be remembered. Matching begins at the
specified Unicode character index given by \fIoffset\fR. Unlike
@@ -275,13 +313,21 @@ zero or more of the following flags:
.TP
\fBTCL_REG_NOTBOL\fR
The starting character will not be treated as the beginning of a
-line or the beginning of the string, so `^' will not match there.
-Note that this flag has no effect on how `\fB\eA\fR' matches.
+line or the beginning of the string, so
+.QW ^
+will not match there.
+Note that this flag has no effect on how
+.QW \fB\eA\fR
+matches.
.TP
\fBTCL_REG_NOTEOL\fR
The last character in the string will not be treated as the end of a
-line or the end of the string, so '$' will not match there.
-Note that this flag has no effect on how `\fB\eZ\fR' matches.
+line or the end of the string, so
+.QW $
+will not match there.
+Note that this flag has no effect on how
+.QW \fB\eZ\fR
+matches.
.RE
.PP
\fBTcl_RegExpGetInfo\fR retrieves information about the last match
@@ -291,16 +337,16 @@ defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
- int \fInsubs\fR;
- Tcl_RegExpIndices *\fImatches\fR;
- long \fIextendStart\fR;
-} Tcl_RegExpInfo;
+ int \fInsubs\fR;
+ Tcl_RegExpIndices *\fImatches\fR;
+ long \fIextendStart\fR;
+} \fBTcl_RegExpInfo\fR;
.CE
.PP
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
@@ -309,9 +355,9 @@ follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
- long \fIstart\fR;
- long \fIend\fR;
-} Tcl_RegExpIndices;
+ long \fIstart\fR;
+ long \fIend\fR;
+} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
@@ -321,7 +367,7 @@ subexpression. The \fIend\fR index identifies the first character
after the matched subexpression. If the subexpression matched the
empty string, then \fIstart\fR and \fIend\fR will be equal. If the
subexpression did not participate in the match, then \fIstart\fR and
-\fIend\fR will be set to -1.
+\fIend\fR will be set to \-1.
.PP
The \fIextendStart\fR field in \fBTcl_RegExpInfo\fR is only set if the
\fBTCL_REG_CANMATCH\fR flag was used. It indicates the first
@@ -330,8 +376,7 @@ found, this will be the same as the beginning of the current match.
If no match was found, then it indicates the earliest point at which a
match might occur if additional text is appended to the string. If it
is no match is possible even with further text, this field will be set
-to -1.
-
+to \-1.
.SH "SEE ALSO"
re_syntax(n)
.SH KEYWORDS
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index a8af63e..557391d 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -5,10 +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: SaveResult.3,v 1.7 2005/05/10 18:33:57 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
@@ -40,10 +38,8 @@ Saved state token to be restored or discarded.
.AP Tcl_SavedResult *savedPtr in
Pointer to location where interpreter result should be saved or restored.
.BE
-
.SH DESCRIPTION
.PP
-.VS 8.5
These routines allows a C procedure to take a snapshot of the current
state of an interpreter so that it can be restored after a call
to \fBTcl_Eval\fR or some other routine that modifies the interpreter
@@ -62,8 +58,8 @@ These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
that is used to store enough information to restore the interpreter result.
This structure can be allocated on the stack of the calling
procedure. These routines do not save the state of any error
-information in the interpreter (e.g. the \fB-errorcode\fR or
-\fB-errorinfo\fR return options, when an error is in progress).
+information in the interpreter (e.g. the \fB\-errorcode\fR or
+\fB\-errorinfo\fR return options, when an error is in progress).
.PP
Because the routines \fBTcl_SaveInterpState\fR,
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
@@ -77,7 +73,7 @@ of existing programs that may already be using them.
interpreter state that make up the full result of script evaluation.
This include the interpreter result, the return code (passed in
as the \fIstatus\fR argument, and any return options, including
-\fB-errorinfo\fR and \fB-errorcode\fR when an error is in progress.
+\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
The call to \fBTcl_SaveInterpState\fR does not itself change the
state of the interpreter. Unlike \fBTcl_SaveResult\fR, it does
@@ -99,14 +95,13 @@ must eventually be passed to either \fBTcl_RestoreInterpState\fR
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.
-.VE 8.5
.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
@@ -121,6 +116,5 @@ Once \fBTcl_SaveResult\fR is called to save the interpreter
result, either \fBTcl_RestoreResult\fR or
\fBTcl_DiscardResult\fR must be called to properly clean up the
memory associated with the saved state.
-
.SH KEYWORDS
result, state, interp
diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3
index 881768f..5bb86be 100644
--- a/doc/SetChanErr.3
+++ b/doc/SetChanErr.3
@@ -4,9 +4,8 @@
'\" 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.1 2005/08/24 17:56:23 andreas_kupries Exp $
-.so man.macros
.TH Tcl_SetChannelError 3 8.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -34,65 +33,60 @@ Refers to the Tcl channel whose bypass area is accessed.
.AP Tcl_Interp* interp in
Refers to the Tcl interpreter whose bypass area is accessed.
.AP Tcl_Obj* msg in
-Error message put into a bypass area. A list of return options and
-values, followed by a string message. Both message and the
-option/value information are optional.
+Error message put into a bypass area. A list of return options and values,
+followed by a string message. Both message and the option/value information
+are optional.
.AP Tcl_Obj** msgPtr out
-Reference to a place where the message stored in the accessed bypass
-area can be stored in.
+Reference to a place where the message stored in the accessed bypass area can
+be stored in.
.BE
.SH DESCRIPTION
.PP
-The current definition of a Tcl channel driver does not permit the
-direct return of arbitrary error messages, except for the setting and
-retrieval of channel options. All other functions are restricted to
-POSIX error codes.
+The current definition of a Tcl channel driver does not permit the direct
+return of arbitrary error messages, except for the setting and retrieval of
+channel options. All other functions are restricted to POSIX error codes.
.PP
-The functions described here overcome this limitation. Channel drivers
-are allowed to use \fBTcl_SetChannelError\fR and
-\fBTcl_SetChannelErrorInterp\fR to place arbitrary error messages in
-\fBbypass areas\fI 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 used now if and only if no messages are present.
+The functions described here overcome this limitation. Channel drivers are
+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
+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\fI
-object 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.
+\fBTcl_SetChannelError\fR stores error information in the bypass area of the
+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\fI object 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.
+\fBTcl_SetChannelErrorInterp\fR stores error information in the bypass area of
+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.
.PP
-\fBTcl_GetChannelError\fR places either the error message held in the
-bypass area of the specified channel into \fImsgPtr\fR, or NULL; and
-resets the bypass. I.e. after an invokation all following invokations
-will return NULL, until an intervening invokation 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.
+\fBTcl_GetChannelError\fR places either the error message held in the bypass
+area of the specified channel into \fImsgPtr\fR, or NULL; and resets the
+bypass, that is, after an invocation all following invocations will return
+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 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 resets the bypass. I.e. after an invokation all following
-invokations will return NULL, until an intervening invokation of
-\fBTcl_SetChannelErrorInterp\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 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.
-.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 messages in the bypass areas.
+\fBTcl_GetChannelErrorInterp\fR places either the error message held in the
+bypass area of the specified interpreter into \fImsgPtr\fR, or NULL; and
+resets the bypass, that is, after an invocation all following invocations will
+return NULL, until an intervening invocation of
+\fBTcl_SetChannelErrorInterp\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 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 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
+messages in the bypass areas.
.IP \fBTcl_DriverCloseProc\fR
May use \fBTcl_SetChannelErrorInterp\fR, and only this function.
.IP \fBTcl_DriverInputProc\fR
@@ -101,55 +95,46 @@ May use \fBTcl_SetChannelError\fR, and only this function.
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverSeekProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
-.IP \fBTcl_DriverWideSeekProc
+.IP \fBTcl_DriverWideSeekProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverSetOptionProc\fR
-Has already the ability to pass arbitrary error messages. Must
-\fBnot\fR use any of the new functions.
+Has already the ability to pass arbitrary error messages. Must \fInot\fR use
+any of the new functions.
.IP \fBTcl_DriverGetOptionProc\fR
Has already the ability to pass arbitrary error messages. Must
-\fBnot\fR use any of the new functions.
+\fInot\fR use any of the new functions.
.IP \fBTcl_DriverWatchProc\fR
-Must \fBnot\fR use any of the new functions. Is internally called and
-has no ability to return any type of error whatsoever.
+Must \fInot\fR use any of the new functions. Is internally called and has no
+ability to return any type of error whatsoever.
.IP \fBTcl_DriverBlockModeProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverGetHandleProc\fR
-Must \fBnot\fR use any of the new functions. It is only a low-level
-function, and not used by Tcl commands.
+Must \fInot\fR use any of the new functions. It is only a low-level function,
+and not used by Tcl commands.
.IP \fBTcl_DriverHandlerProc\fR
-Must \fBnot\fR use any of the new functions. Is internally called and
-has no ability to return any type of error whatsoever.
+Must \fInot\fR use any of the new functions. Is internally called and has no
+ability to return any type of error whatsoever.
.PP
-Given the information above the following public functions of the Tcl
-C API are affected by these changes. I.e. when these functions are
-called the channel may now contain a stored arbitrary error message
-requiring processing by the caller.
+Given the information above the following public functions of the Tcl C API
+are affected by these changes; when these functions are called, the channel
+may now contain a stored arbitrary error message requiring processing by the
+caller.
+.DS
+.ta 1.9i 4i
+\fBTcl_Flush\fR \fBTcl_GetsObj\fR \fBTcl_Gets\fR
+\fBTcl_ReadChars\fR \fBTcl_ReadRaw\fR \fBTcl_Read\fR
+\fBTcl_Seek\fR \fBTcl_StackChannel\fR \fBTcl_Tell\fR
+\fBTcl_WriteChars\fR \fBTcl_WriteObj\fR \fBTcl_WriteRaw\fR
+\fBTcl_Write\fR
+.DE
.PP
-.IP \fBTcl_StackChannel\fR
-.IP \fBTcl_Seek\fR
-.IP \fBTcl_Tell\fR
-.IP \fBTcl_ReadRaw\fR
-.IP \fBTcl_Read\fR
-.IP \fBTcl_ReadChars\fR
-.IP \fBTcl_Gets\fR
-.IP \fBTcl_GetsObj\fR
-.IP \fBTcl_Flush\fR
-.IP \fBTcl_WriteRaw\fR
-.IP \fBTcl_WriteObj\fR
-.IP \fBTcl_Write\fR
-.IP \fBTcl_WriteChars\fR
-.PP
-All other API functions are unchanged. Especially the functions below
+All other API functions are unchanged. In particular, the functions below
leave all their error information in the interpreter result.
-.PP
-.IP \fBTcl_Close\fR
-.IP \fBTcl_UnregisterChannel\fR
-.IP \fBTcl_UnstackChannel\fR
-.PP
-
+.DS
+.ta 1.9i 4i
+\fBTcl_Close\fR \fBTcl_UnstackChannel\fR \fBTcl_UnregisterChannel\fR
+.DE
.SH "SEE ALSO"
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3)
-
.SH KEYWORDS
channel driver, error messages, channel type
diff --git a/doc/SetErrno.3 b/doc/SetErrno.3
index 133353e..21648b1 100644
--- a/doc/SetErrno.3
+++ b/doc/SetErrno.3
@@ -4,9 +4,8 @@
'\" 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.7 2004/10/07 15:15:48 dkf Exp $
-.so man.macros
.TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to store and retrieve error codes
@@ -53,9 +52,11 @@ instead of accessing \fBerrno\fR directly.
\fBTcl_ErrnoId\fR and \fBTcl_ErrnoMsg\fR return string
representations of \fBerrno\fR values. \fBTcl_ErrnoId\fR
returns a machine-readable textual identifier such as
-"EACCES" that corresponds to the current value of \fBerrno\fR.
+.QW EACCES
+that corresponds to the current value of \fBerrno\fR.
\fBTcl_ErrnoMsg\fR returns a human-readable string such as
-"permission denied" that corresponds to the value of its
+.QW "permission denied"
+that corresponds to the value of its
\fIerrorCode\fR argument. The \fIerrorCode\fR argument is
typically the value returned by \fBTcl_GetErrno\fR.
The strings returned by these functions are
diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3
index 599e46f..904d4ab 100644
--- a/doc/SetRecLmt.3
+++ b/doc/SetRecLmt.3
@@ -5,10 +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: 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"
+.so man.macros
.BS
.SH NAME
Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index 99aaff2..1f86340 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.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: SetResult.3,v 1.14 2005/09/13 21:23:51 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_FreeResult \- manipulate Tcl result
+Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -30,21 +28,25 @@ const char *
.sp
\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR)
.sp
-\fBTcl_AppendElement\fR(\fIinterp, element\fR)
-.sp
\fBTcl_ResetResult\fR(\fIinterp\fR)
.sp
+.VS 8.6
+\fBTcl_TransferResult\fR(\fIsourceInterp, result, targetInterp\fR)
+.VE 8.6
+.sp
+\fBTcl_AppendElement\fR(\fIinterp, element\fR)
+.sp
\fBTcl_FreeResult\fR(\fIinterp\fR)
.SH ARGUMENTS
-.AS Tcl_FreeProc freeProc out
+.AS Tcl_FreeProc sourceInterp out
.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.
-.AP char *element in
+.AP "const char" *element in
String value to append as a list element
to the existing result of \fIinterp\fR.
.AP Tcl_FreeProc *freeProc in
@@ -54,38 +56,50 @@ Address of procedure to call to release storage at
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
+.AP Tcl_Interp *sourceInterp in
+.VS 8.6
+Interpreter that the result and error information should be copied from.
+.VE 8.6
+.AP Tcl_Interp *targetInterp in
+.VS 8.6
+Interpreter that the result and error information should be copied to.
+.VE 8.6
+.AP int result in
+.VS 8.6
+If \fBTCL_OK\fR, only copy the result. If \fBTCL_ERROR\fR, copy the error
+information as well.
+.VE 8.6
.BE
-
.SH DESCRIPTION
.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
@@ -101,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
@@ -133,20 +147,27 @@ of the result are produced.
storage management issues associated with managing \fIinterp\fR's
result, such as allocating a larger result area if necessary.
It also manages conversion to and from the \fIresult\fR field of the
-\fIinterp\fR so as to handle backward-compatability with old-style
+\fIinterp\fR so as to handle backward-compatibility with old-style
extensions.
Any number of \fIresult\fR arguments may be passed in a single
call; the last argument in the list must be a NULL pointer.
.PP
\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
instead of taking a variable number of arguments it takes an argument list.
-
-.SH "OLD STRING PROCEDURES"
+.PP
+.VS 8.6
+\fBTcl_TransferResult\fR moves a result from one interpreter to another,
+optionally (dependent on the \fIresult\fR parameter) including the error
+information dictionary as well. The interpreters must be in the same thread.
+The source interpreter will have its result reset by this operation.
+.VE 8.6
+.SH "DEPRECATED INTERFACES"
+.SS "OLD STRING PROCEDURES"
.PP
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
@@ -163,28 +184,32 @@ list element, so that the list elements in the result are properly
separated.
However if the new list element is the first in a list or sub-list
(i.e. \fIinterp\fR's current result is empty, or consists of the
-single character ``{'', or ends in the characters `` {'') then no
-space is added.
+single character
+.QW { ,
+or ends in the characters
+.QW " {" )
+then no space is added.
.PP
\fBTcl_FreeResult\fR performs part of the work
of \fBTcl_ResetResult\fR.
It frees up the memory associated with \fIinterp\fR's result.
-It also sets \fIinterp->freeProc\fR to zero, but doesn't
+It also sets \fIinterp->freeProc\fR to zero, but does not
change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
-
-.SH "DIRECT ACCESS TO INTERP->RESULT IS DEPRECATED"
+.SS "DIRECT ACCESS TO INTERP->RESULT"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
-to manipulate the interpreter result.
-Direct access to \fIinterp->result\fR is now strongly deprecated
-because it can make the result's string and object forms inconsistent.
-Programs should always read the result
-using the procedures \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR,
-and write the result using \fBTcl_SetObjResult\fR or \fBTcl_SetResult\fR.
-
+to manipulate the interpreter result. The Tcl headers no longer
+permit this access by default, and C code still doing this must
+be updated to use supported routines \fBTcl_GetObjResult\fR,
+\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
+As a migration aid, access can be restored with the compiler directive
+.CS
+#define USE_INTERP_RESULT
+.CE
+but this is meant only to offer life support to otherwise dead code.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
@@ -209,21 +234,22 @@ In this case \fBTcl_SetResult\fR will make a copy of the string in
dynamically allocated storage and arrange for the copy to be the
result for the current Tcl command.
.PP
-If \fIfreeProc\fR isn't one of the values \fBTCL_STATIC\fR,
+If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR,
\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
of a procedure that Tcl should call to free the string.
This allows applications to use non-standard storage allocators.
When Tcl no longer needs the storage for the string, it will
call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and
result that match the type \fBTcl_FreeProc\fR:
+.PP
.CS
-typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+typedef void \fBTcl_FreeProc\fR(
+ char *\fIblockPtr\fR);
.CE
+.PP
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
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 dc43c54..1bef20b 100644
--- a/doc/SetVar.3
+++ b/doc/SetVar.3
@@ -5,10 +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: SetVar.3,v 1.12 2004/10/07 16:05:15 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables
@@ -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
@@ -119,7 +117,7 @@ returned as a pointer to a Tcl_Obj. For \fBTcl_GetVar\fR and
usually less efficient, so \fBTcl_GetVar2Ex\fR or \fBTcl_ObjGetVar2\fR
are preferred.
If an error occurs while reading the variable (e.g. the variable
-doesn't exist or an array element is specified for a scalar
+does not exist or an array element is specified for a scalar
variable), then NULL is returned and an error message is left
in \fIinterp\fR's result if the \fBTCL_LEAVE_ERR_MSG\fR \fIflag\fR
bit is set.
@@ -130,7 +128,7 @@ an error.
The arguments to these procedures are treated in the same way
as the arguments to the procedures above.
If the variable is successfully removed then \fBTCL_OK\fR is returned.
-If the variable cannot be removed because it doesn't exist then
+If the variable cannot be removed because it does not exist then
\fBTCL_ERROR\fR is returned and an error message is left
in \fIinterp\fR's result if the \fBTCL_LEAVE_ERR_MSG\fR \fIflag\fR
bit is set.
@@ -150,7 +148,7 @@ close parenthesis, then the value between the parentheses is
treated as an index (which can have any string value) and
the characters before the first open
parenthesis are treated as the name of an array variable.
-If \fIvarName\fR doesn't have parentheses as described above, then
+If \fIvarName\fR does not have parentheses as described above, then
the entire string is treated as the name of a scalar variable.
.IP [2]
If the \fIname1\fR and \fIname2\fR arguments are provided and
@@ -192,7 +190,7 @@ If an error is returned and this bit is set in \fIflags\fR, then
an error message will be left in the interpreter's result,
where it can be retrieved with \fBTcl_GetObjResult\fR
or \fBTcl_GetStringResult\fR.
-If this flag bit isn't set then no error message is left
+If this flag bit is not set then no error message is left
and the interpreter's result will not be modified.
.TP
\fBTCL_APPEND_VALUE\fR
@@ -207,7 +205,10 @@ Tcl list element before setting (or appending to) the variable.
A separator space is appended before the new list element unless
the list element is going to be the first element in a list or
sublist (i.e. the variable's current value is empty, or contains
-the single character ``{'', or ends in `` }'').
+the single character
+.QW { ,
+or ends in
+.QW " }" ).
When appending, the original value of the variable must also be
a valid list, so that the operation is the appending of a new
list element onto a list.
@@ -225,7 +226,7 @@ and \fBTCL_LEAVE_ERR_MSG\fR, both of
which have
the same meaning as for \fBTcl_SetVar\fR.
If an error occurs in reading the variable (e.g. the variable
-doesn't exist or an array element is specified for a scalar
+does not exist or an array element is specified for a scalar
variable), then NULL is returned.
.PP
\fBTcl_UnsetVar\fR and \fBTcl_UnsetVar2\fR may be used to remove
@@ -234,7 +235,7 @@ for the variable will return an error.
The arguments to these procedures are treated in the same way
as the arguments to \fBTcl_GetVar\fR and \fBTcl_GetVar2\fR.
If the variable is successfully removed then \fBTCL_OK\fR is returned.
-If the variable cannot be removed because it doesn't exist then
+If the variable cannot be removed because it does not exist then
\fBTCL_ERROR\fR is returned.
If an array element is specified, the given element is removed
but the array remains.
@@ -245,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 a28a680..70b9d91 100644
--- a/doc/Signal.3
+++ b/doc/Signal.3
@@ -4,9 +4,8 @@
'\" 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.4 2004/10/07 15:15:48 dkf Exp $
-.so man.macros
.TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SignalId, Tcl_SignalMsg \- Convert signal codes
@@ -31,8 +30,11 @@ A POSIX signal number such as \fBSIGPIPE\fR.
\fBTcl_SignalId\fR and \fBTcl_SignalMsg\fR return a string
representation of the provided signal number (\fIsig\fR).
\fBTcl_SignalId\fR returns a machine-readable textual identifier such
-as "SIGPIPE". \fBTcl_SignalMsg\fR returns a human-readable string such
-as "bus error". The strings returned by these functions are
+as
+.QW SIGPIPE .
+\fBTcl_SignalMsg\fR returns a human-readable string such as
+.QW "bus error" .
+The strings returned by these functions are
statically allocated and the caller must not free or modify them.
.SH KEYWORDS
diff --git a/doc/Sleep.3 b/doc/Sleep.3
index a76d671..2d36697 100644
--- a/doc/Sleep.3
+++ b/doc/Sleep.3
@@ -5,10 +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: Sleep.3,v 1.3 2004/10/07 14:44:34 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_Sleep \- delay execution for a given number of milliseconds
@@ -22,17 +20,15 @@ Tcl_Sleep \- delay execution for a given number of milliseconds
.AP int ms in
Number of milliseconds to sleep.
.BE
-
.SH DESCRIPTION
.PP
This procedure delays the calling process by the number of
milliseconds given by the \fIms\fR parameter and returns
after that time has elapsed. It is typically used for things
like flashing a button, where the delay is short and the
-application needn't do anything while it waits. For longer
+application need not do anything while it waits. For longer
delays where the application needs to respond to other events
during the delay, the procedure \fBTcl_CreateTimerHandler\fR
should be used instead of \fBTcl_Sleep\fR.
-
.SH KEYWORDS
sleep, time, wait
diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3
index f003a8c..0afb66b 100644
--- a/doc/SourceRCFile.3
+++ b/doc/SourceRCFile.3
@@ -1,12 +1,9 @@
'\"
'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_SourceRCFile \- source the Tcl rc file
diff --git a/doc/SplitList.3 b/doc/SplitList.3
index 5726f86..3439f2e 100644
--- a/doc/SplitList.3
+++ b/doc/SplitList.3
@@ -5,10 +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: SplitList.3,v 1.9 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement, Tcl_ScanCountedElement, Tcl_ConvertCountedElement \- manipulate Tcl lists
@@ -67,7 +65,6 @@ Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed
with \fBTCL_DONT_USE_BRACES\fR.
.BE
-
.SH DESCRIPTION
.PP
These procedures may be used to disassemble and reassemble Tcl lists.
@@ -82,15 +79,18 @@ also holds copies of all the list elements. It is the caller's
responsibility to free up all of this storage.
For example, suppose that you have called \fBTcl_SplitList\fR with
the following code:
+.PP
.CS
int argc, code;
char *string;
char **argv;
\&...
-code = Tcl_SplitList(interp, string, &argc, &argv);
+code = \fBTcl_SplitList\fR(interp, string, &argc, &argv);
.CE
+.PP
Then you should eventually free the storage with a call like the
following:
+.PP
.CS
Tcl_Free((char *) argv);
.CE
@@ -153,7 +153,7 @@ include spaces between adjacent list elements.
\fBTcl_ConvertElement\fR uses one of two different approaches to
handle the special characters in \fIsrc\fR. Wherever possible, it
handles special characters by surrounding the string with braces.
-This produces clean-looking output, but can't be used in some situations,
+This produces clean-looking output, but cannot be used in some situations,
such as when \fIsrc\fR contains unmatched braces.
In these situations, \fBTcl_ConvertElement\fR handles special
characters by generating backslash sequences for them.
@@ -166,22 +166,23 @@ used to generate a portion of an argument for a Tcl command.
In this case, surrounding \fIsrc\fR with curly braces would cause
the command not to be parsed correctly.
.PP
-.VS 8.5
By default, \fBTcl_ConvertElement\fR will use quoting in its output
to be sure the first character of an element is not the hash
-character (``#''). This is to be sure the first element of any list
+character
+.PQ # .
+This is to be sure the first element of any list
passed to \fBeval\fR is not mis-parsed as the beginning of a comment.
When a list element is not the first element of a list, this quoting
is not necessary. When the caller can be sure that the element is
not the first element of a list, it can disable quoting of the leading
hash character by OR-ing the flag value returned by \fBTcl_ScanElement\fR
with \fBTCL_DONT_QUOTE_HASH\fR.
-.VE 8.5
.PP
\fBTcl_ScanCountedElement\fR and \fBTcl_ConvertCountedElement\fR are
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
diff --git a/doc/SplitPath.3 b/doc/SplitPath.3
index d7380de..19cee05 100644
--- a/doc/SplitPath.3
+++ b/doc/SplitPath.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: SplitPath.3,v 1.9 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_SplitPath, Tcl_JoinPath, Tcl_GetPathType \- manipulate platform-dependent file paths
@@ -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
@@ -61,6 +59,7 @@ holds copies of all the path elements. It is the caller's
responsibility to free all of this storage.
For example, suppose that you have called \fBTcl_SplitPath\fR with the
following code:
+.PP
.CS
int argc;
char *path;
@@ -68,8 +67,10 @@ char **argv;
\&...
Tcl_SplitPath(string, &argc, &argv);
.CE
+.PP
Then you should eventually free the storage with a call like the
following:
+.PP
.CS
Tcl_Free((char *) argv);
.CE
diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3
index 0947202..5700ea7 100644
--- a/doc/StaticPkg.3
+++ b/doc/StaticPkg.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: StaticPkg.3,v 1.6 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_StaticPackage \- make a statically linked package available via the `load' command
+Tcl_StaticPackage \- make a statically linked package available via the 'load' command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -22,7 +20,7 @@ Tcl_StaticPackage \- make a statically linked package available via the `load' c
If not NULL, points to an interpreter into which the package has
already been loaded (i.e., the caller has already invoked the
appropriate initialization procedure). NULL means the package
-hasn't yet been incorporated into any interpreter.
+has not yet been incorporated into any interpreter.
.AP "const char" *pkgName in
Name of the package; should be properly capitalized (first letter
upper-case, all others lower-case).
@@ -31,10 +29,9 @@ Procedure to invoke to incorporate this package into a trusted
interpreter.
.AP Tcl_PackageInitProc *safeInitProc in
Procedure to call to incorporate this package into a safe interpreter
-(one that will execute untrusted scripts). NULL means the package
-can't be used in safe interpreters.
+(one that will execute untrusted scripts). NULL means the package
+cannot be used in safe interpreters.
.BE
-
.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a package has been
@@ -54,9 +51,12 @@ be invoked, depending on whether the target interpreter is safe
or not.
\fIinitProc\fR and \fIsafeInitProc\fR must both match the
following prototype:
+.PP
.CS
-typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
+typedef int \fBTcl_PackageInitProc\fR(
+ Tcl_Interp *\fIinterp\fR);
.CE
+.PP
The \fIinterp\fR argument identifies the interpreter in which the package
is to be loaded. The initialization procedure must return \fBTCL_OK\fR or
\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
@@ -64,6 +64,7 @@ the event of an error it should set the interpreter's result to point to an
error message. The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
-
.SH KEYWORDS
initialization procedure, package, static linking
+.SH "SEE ALSO"
+load(n), package(n), Tcl_PkgRequire(3)
diff --git a/doc/StdChannels.3 b/doc/StdChannels.3
index 73a5776..651ad7d 100644
--- a/doc/StdChannels.3
+++ b/doc/StdChannels.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: StdChannels.3,v 1.9 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -28,8 +26,7 @@ output and the other for error messages.
.PP
Tcl generalizes this concept in a cross-platform way and
exposes standard channels to the script level.
-
-.SH APIs
+.SS "APPLICATION PROGRAMMING INTERFACES"
.PP
The public API procedures dealing directly with standard channels are
\fBTcl_GetStdChannel\fR and \fBTcl_SetStdChannel\fR. Additional public
@@ -43,7 +40,9 @@ channel information, or when implicitly required during registration
of a new channel.
.PP
These cases differ in how they handle unavailable platform- specific
-standard channels. (A channel is not ``available'' if it could not be
+standard channels. (A channel is not
+.QW available
+if it could not be
successfully opened; for example, in a Tcl application run as a
Windows NT service.)
.TP
@@ -51,9 +50,11 @@ Windows NT service.)
A single standard channel is initialized when it is explicitly
specified in a call to \fBTcl_SetStdChannel\fR. The states of the
other standard channels are unaffected.
-.sp
+.RS
+.PP
Missing platform-specific standard channels do not matter here. This
approach is not available at the script level.
+.RE
.TP
2)
All uninitialized standard channels are initialized to
@@ -69,9 +70,7 @@ when information about any standard channel is requested with a call
to \fBTcl_GetStdChannel\fR, or with a call to \fBTcl_GetChannel\fR
which specifies one of the standard names (\fBstdin\fR, \fBstdout\fR
and \fBstderr\fR).
-.RE
-.sp
-.RS
+.PP
In case of missing platform-specific standard channels, the Tcl
standard channels are considered as initialized and then immediately
closed. This means that the first three Tcl channels then opened by
@@ -82,14 +81,13 @@ the application are designated as the Tcl standard channels.
All uninitialized standard channels are initialized to
platform-specific default values when a user-requested channel is
registered with \fBTcl_RegisterChannel\fR.
-.sp
+.PP
In case of unavailable platform-specific standard channels the channel
whose creation caused the initialization of the Tcl standard channels
is made a normal channel. The next three Tcl channels opened by the
application are designated as the Tcl standard channels. In other
words, of the first four Tcl channels opened by the application the
second to fourth are designated as the Tcl standard channels.
-.PP
.SH "RE-INITIALIZATION OF TCL STANDARD CHANNELS"
.PP
Once a Tcl standard channel is initialized through one of the methods
@@ -103,21 +101,20 @@ channel, too. If more than one Tcl standard channel was closed
that slot was not initialized before. It is this behavior which
enables an application to employ method 1 of initialization, i.e. to
create and designate their own Tcl standard channels.
-
-.SH tclsh
+.SH "SHELL-SPECIFIC DETAILS"
+.SS tclsh
.PP
-The Tcl shell (or rather \fBTcl_Main\fR) uses method 2 to initialize
+The Tcl shell (or rather the function \fBTcl_Main\fR, which forms the
+core of the shell's implementation) uses method 2 to initialize
the standard channels.
-
-.SH wish
+.SS wish
.PP
-The windowing shell (or rather \fBTk_MainEx\fR) uses method 1 to
+The windowing shell (or rather the function \fBTk_MainEx\fR, which
+forms the core of the shell's implementation) uses method 1 to
initialize the standard channels (See \fBTk_InitConsoleChannels\fR)
on non-Unix platforms. On Unix platforms, \fBTk_MainEx\fR implicitly
uses method 2 to initialize the standard channels.
-
.SH "SEE ALSO"
Tcl_CreateChannel(3), Tcl_RegisterChannel(3), Tcl_GetChannel(3), Tcl_GetStdChannel(3), Tcl_SetStdChannel(3), Tk_InitConsoleChannels(3), tclsh(1), wish(1), Tcl_Main(3), Tk_MainEx(3)
-
.SH KEYWORDS
standard channels
diff --git a/doc/StrMatch.3 b/doc/StrMatch.3
index e09a2d6..f9c2be3 100644
--- a/doc/StrMatch.3
+++ b/doc/StrMatch.3
@@ -5,10 +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: StrMatch.3,v 1.9 2005/05/10 18:33:57 kennykb Exp $
-'\"
+.TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
-.TH Tcl_StringMatch 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
@@ -20,7 +18,7 @@ int
\fBTcl_StringMatch\fR(\fIstr\fR, \fIpattern\fR)
.sp
int
-\fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fInocase\fR)
+\fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fIflags\fR)
.SH ARGUMENTS
.AS "const char" *pattern
.AP "const char" *str in
@@ -28,9 +26,9 @@ String to test.
.AP "const char" *pattern in
Pattern to match against string. May contain special
characters from the set *?\e[].
-.AP int nocase in
-Specifies whether the match should be done case-sensitive (0) or
-case-insensitive (1).
+.AP int flags in
+OR-ed combination of match flags, currently only \fBTCL_MATCH_NOCASE\fR.
+0 specifies a case-sensitive search.
.BE
.SH DESCRIPTION
@@ -38,14 +36,14 @@ case-insensitive (1).
This utility procedure determines whether a string matches
a given pattern. If it does, then \fBTcl_StringMatch\fR returns
1. Otherwise \fBTcl_StringMatch\fR returns 0. The algorithm
-used for matching is the same algorithm used in the ``string match''
+used for matching is the same algorithm used in the \fBstring match\fR
Tcl command and is similar to the algorithm used by the C-shell
for file name matching; see the Tcl manual entry for details.
.PP
-In \fBTcl_StringCaseMatch\fR, the algorithm is the same, but you have
-the option to make the matching case-insensitive. If you choose this
-(by passing \fBnocase\fR as 1), then the string and pattern are
-essentially matched in the lower case.
+In \fBTcl_StringCaseMatch\fR, the algorithm is
+the same, but you have the option to make the matching case-insensitive.
+If you choose this (by passing \fBTCL_MATCH_NOCASE\fR), then the string and
+pattern are essentially matched in the lower case.
.SH KEYWORDS
match, pattern, string
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index f326315..d81f23d 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.20 2005/09/13 21:23:51 dgp Exp $
-'\"
-.so man.macros
.TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.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_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj, Tcl_AttemptSetObjLength \- 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
@@ -64,6 +62,21 @@ void
\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR)
.sp
void
+\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
+.sp
+Tcl_Obj *
+\fBTcl_Format\fR(\fIinterp, format, objc, objv\fR)
+.sp
+int
+\fBTcl_AppendFormatToObj\fR(\fIinterp, objPtr, format, objc, objv\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ObjPrintf\fR(\fIformat, ...\fR)
+.sp
+void
+\fBTcl_AppendPrintfToObj\fR(\fIobjPtr, format, ...\fR)
+.sp
+void
\fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR)
.sp
int
@@ -75,89 +88,97 @@ 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\\700\\600\fR, use
+should represent them as the two-byte sequence \fI\e700\e600\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
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.
+.AP "const char" *ellipsis in
+Suffix to append when the limit leads to string truncation.
+If NULL is passed then the suffix
+.QW "..."
+is used.
+.AP "const char" *format in
+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 values to format or concatenate.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
-.AP int objc in
-The number of elements to concatenate.
-.AP Tcl_Obj *objv[] in
-The array of objects to concatenate.
.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 doesn't have to be copied for each append.
+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
@@ -173,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
@@ -229,16 +250,109 @@ must be a NULL pointer to indicate the end of the list.
except that instead of taking a variable number of arguments it takes an
argument list.
.PP
+\fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR
+except that it imposes a limit on how many bytes are appended.
+This can be handy when the string to be appended might be
+very large, but the value being constructed should not be allowed to grow
+without bound. A common usage is when constructing an error message, where the
+end result should be kept short enough to be read.
+Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more
+than \fIlimit\fR bytes total are to be appended. If the limit prevents
+all \fIlength\fR bytes that are available from being appended, then the
+appending is done so that the last bytes appended are from the
+string \fIellipsis\fR. This allows for an indication of the truncation
+to be left in the string.
+When \fIlength\fR is \fB-1\fR, all bytes up to the first zero byte are appended,
+subject to the limit. When \fIellipsis\fR is NULL, the default
+string \fB...\fR is used. When \fIellipsis\fR is non-NULL, it must point
+to a zero-byte-terminated string in Tcl's internal UTF encoding.
+The number of bytes appended can be less than the lesser
+of \fIlength\fR and \fIlimit\fR when appending fewer
+bytes is necessary to append only whole multi-byte characters.
+.PP
+\fBTcl_Format\fR is the C-level interface to the engine of the \fBformat\fR
+command. The actual command procedure for \fBformat\fR is little more
+than
+.PP
+.CS
+\fBTcl_Format\fR(interp, \fBTcl_GetString\fR(objv[1]), objc-2, objv+2);
+.CE
+.PP
+The \fIobjc\fR Tcl_Obj values in \fIobjv\fR are formatted into a string
+according to the conversion specification in \fIformat\fR argument, following
+the documentation for the \fBformat\fR command. The resulting formatted
+string is converted to a new Tcl_Obj with refcount of zero and returned.
+If some error happens during production of the formatted string, NULL is
+returned, and an error message is recorded in \fIinterp\fR, if \fIinterp\fR
+is non-NULL.
+.PP
+\fBTcl_AppendFormatToObj\fR is an appending alternative form
+of \fBTcl_Format\fR with functionality equivalent to:
+.PP
+.CS
+Tcl_Obj *newPtr = \fBTcl_Format\fR(interp, format, objc, objv);
+if (newPtr == NULL) return TCL_ERROR;
+\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
+return TCL_OK;
+.CE
+.PP
+but with greater convenience and efficiency when the appending
+functionality is needed.
+.PP
+\fBTcl_ObjPrintf\fR serves as a replacement for the common sequence
+.PP
+.CS
+char buf[SOME_SUITABLE_LENGTH];
+sprintf(buf, format, ...);
+\fBTcl_NewStringObj\fR(buf, -1);
+.CE
+.PP
+but with greater convenience and no need to
+determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same
+core formatting engine used by \fBTcl_Format\fR. This means the set of
+supported conversion specifiers is that of the \fBformat\fR command and
+not that of the \fBsprintf\fR routine where the two sets differ. When a
+conversion specifier passed to \fBTcl_ObjPrintf\fR includes a precision,
+the value is taken as a number of bytes, as \fBsprintf\fR does, and not
+as a number of characters, as \fBformat\fR does. This is done on the
+assumption that C code is more likely to know how many bytes it is
+passing around than the number of encoded characters those bytes happen
+to represent. The variable number of arguments passed in should be of
+the types that would be suitable for passing to \fBsprintf\fR. Note in
+this example usage, \fIx\fR is of type \fBint\fR.
+.PP
+.CS
+int x = 5;
+Tcl_Obj *objPtr = \fBTcl_ObjPrintf\fR("Value is %d", x);
+.CE
+.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.
+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
+.PP
+.CS
+\fBTcl_AppendObjToObj\fR(objPtr, \fBTcl_ObjPrintf\fR(format, ...));
+.CE
+.PP
+but with greater convenience and efficiency when the appending
+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.
@@ -247,26 +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, Tcl_IncrRefCount, Tcl_DecrRefCount
-
+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 5f39c15..f582c5a 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.3 2004/10/07 14:44:34 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.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,
@@ -32,14 +30,13 @@ perform. The flags \fBTCL_SUBST_COMMANDS\fR,
currently supported, and \fBTCL_SUBST_ALL\fR is provided as a
convenience for the common case where all substitutions are desired.
.BE
-
.SH DESCRIPTION
.PP
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.
@@ -55,17 +52,17 @@ replaced by the contents of the named variable.
.PP
When the \fBTCL_SUBST_COMMANDS\fR bit is set in \fIflags\fR, sequences
that look like command substitutions for Tcl commands are replaced by
-the result of evaluating that script. Where an uncaught `continue
-exception' occurs during the evaluation of a command substitution, an
-empty string is substituted for the command. Where an uncaught `break
-exception' occurs during the evaluation of a command substitution, the
+the result of evaluating that script. Where an uncaught
+.QW "continue exception"
+occurs during the evaluation of a command substitution, an
+empty string is substituted for the command. Where an uncaught
+.QW "break exception"
+occurs during the evaluation of a command substitution, the
result of the whole substitution on \fIobjPtr\fR will be truncated at
the point immediately before the start of the command substitution,
and no characters will be added to the result or substitutions
performed after that point.
-
.SH "SEE ALSO"
subst(n)
-
.SH KEYWORDS
backslash substitution, command substitution, variable substitution
diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3
index 6052238..e3a6809 100644
--- a/doc/TCL_MEM_DEBUG.3
+++ b/doc/TCL_MEM_DEBUG.3
@@ -3,22 +3,18 @@
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: TCL_MEM_DEBUG.3,v 1.7 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging
.BE
-
.SH DESCRIPTION
When Tcl is compiled with \fBTCL_MEM_DEBUG\fR defined, a powerful set
of memory debugging aids is included in the compiled binary. This
includes C and Tcl functions which can aid with debugging
memory leaks, memory allocation overruns, and other memory related
errors.
-
.SH "ENABLING MEMORY DEBUGGING"
.PP
To enable memory debugging, Tcl should be recompiled from scratch with
@@ -30,34 +26,37 @@ 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,
and the Tcl \fBmemory\fR command can be used to validate and examine
memory usage.
-
.SH "GUARD ZONES"
.PP
When memory debugging is enabled, whenever a call to \fBckalloc\fR is
-made, slightly more memory than requested is allocated so the memory debugging
-code can keep track of the allocated memory, and eight-byte ``guard
-zones'' are placed in front of and behind the space that will be
+made, slightly more memory than requested is allocated so the memory
+debugging code can keep track of the allocated memory, and eight-byte
+.QW "guard zones"
+are placed in front of and behind the space that will be
returned to the caller. (The sizes of the guard zones are defined by the
C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR
-in the file \fIgeneric/tclCkalloc.c\fR -- it can
+in the file \fIgeneric/tclCkalloc.c\fR \(em it can
be extended if you suspect large overwrite problems, at some cost in
performance.) A known pattern is written into the guard zones and, on
a call to \fBckfree\fR, the guard zones of the space being freed are
checked to see if either zone has been modified in any way. If one
has been, the guard bytes and their new contents are identified, and a
-``low guard failed'' or ``high guard failed'' message is issued. The
-``guard failed'' message includes the address of the memory packet and
+.QW "low guard failed"
+or
+.QW "high guard failed"
+message is issued. The
+.QW "guard failed"
+message includes the address of the memory packet and
the file name and line number of the code that called \fBckfree\fR.
This allows you to detect the common sorts of one-off problems, where
not enough space was allocated to contain the data written, for
example.
-
.SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS"
.PP
Normally, Tcl compiled with memory debugging enabled will make it easy
@@ -70,16 +69,12 @@ This will enable memory validation from the first call to
\fBckalloc\fR, again, at a large performance impact.
.PP
If you are desperate and validating memory on every call to
-\fBckalloc\fR and \fBckfree\fR isn't enough, you can explicitly call
+\fBckalloc\fR and \fBckfree\fR is not enough, you can explicitly call
\fBTcl_ValidateAllMemory\fR directly at any point. It takes a \fIchar
*\fR and an \fIint\fR which are normally the filename and line number
of the caller, but they can actually be anything you want. Remember
to remove the calls after you find the problem.
-
.SH "SEE ALSO"
ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
-
.SH KEYWORDS
memory, debug
-
-
diff --git a/doc/Tcl.n b/doc/Tcl.n
index 919a24e..c7fa9f6 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.12 2004/03/09 12:59:04 vincentdarley Exp $
'\"
+.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.so man.macros
-.TH Tcl n "8.5" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
Tcl \- Tool Command Language
@@ -30,7 +28,7 @@ First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.
These substitutions are performed in the same way for all
commands.
-The first word is used to locate a command procedure to
+Secondly, the first word is used to locate a command procedure to
carry out the command, then all of the words of the command are
passed to the command procedure.
The command procedure is free to interpret each of its words
@@ -41,28 +39,35 @@ Different commands interpret their words differently.
Words of a command are separated by white space (except for
newlines, which are command separators).
.IP "[4] \fBDouble quotes.\fR"
-If the first character of a word is double-quote (``"'') then
-the word is terminated by the next double-quote character.
+If the first character of a word is double-quote
+.PQ \N'34'
+then the word is terminated by the next double-quote character.
If semi-colons, close brackets, or white space characters
(including newlines) appear between the quotes then they are treated
as ordinary characters and included in the word.
Command substitution, variable substitution, and backslash substitution
are performed on the characters between the quotes as described below.
The double-quotes are not retained as part of the word.
-.VS 8.5 br
.IP "[5] \fBArgument expansion.\fR"
-If a word starts with the string ``{expand}'' followed by a
-non-whitespace character, then the leading ``{expand}'' is removed
-and the rest of the word is parsed and substituted as any other
-word. After substitution, the word is parsed again without
-substitutions, and its words are added to the command being
-substituted. For instance, ``cmd a {expand}{b c} d {expand}{e f}'' is
-equivalent to ``cmd a b c d e f''.
-.VE 8.5
+If a word starts with the string
+.QW {*}
+followed by a non-whitespace character, then the leading
+.QW {*}
+is removed and the rest of the word is parsed and substituted as any other
+word. After substitution, the word is parsed as a list (without command or
+variable substitutions; backslash substitutions are performed as is normal for
+a list and individual internal words may be surrounded by either braces or
+double-quote characters), and its words are added to the command being
+substituted. For instance,
+.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}"
+is equivalent to
+.QW "cmd a b {[c]} d {$e} f {g h}" .
.IP "[6] \fBBraces.\fR"
-If the first character of a word is an open brace (``{'') and
-rule [5] does not apply, then
-the word is terminated by the matching close brace (``}'').
+If the first character of a word is an open brace
+.PQ {
+and rule [5] does not apply, then
+the word is terminated by the matching close brace
+.PQ } "" .
Braces nest within the word: for each additional open
brace there must be an additional close brace (however,
if an open brace or close brace within the word is
@@ -75,47 +80,73 @@ or white space receive any special interpretation.
The word will consist of exactly the characters between the
outer braces, not including the braces themselves.
.IP "[7] \fBCommand substitution.\fR"
-If a word contains an open bracket (``['') then Tcl performs
-\fIcommand substitution\fR.
+If a word contains an open bracket
+.PQ [
+then Tcl performs \fIcommand substitution\fR.
To do this it invokes the Tcl interpreter recursively to process
the characters following the open bracket as a Tcl script.
The script may contain any number of commands and must be terminated
-by a close bracket (``]'').
+by a close bracket
+.PQ ] "" .
The result of the script (i.e. the result of its last command) is
substituted into the word in place of the brackets and all of the
characters between them.
There may be any number of command substitutions in a single word.
Command substitution is not performed on words enclosed in braces.
.IP "[8] \fBVariable substitution.\fR"
-If a word contains a dollar-sign (``$'') then Tcl performs \fIvariable
+If a word contains a dollar-sign
+.PQ $
+followed by one of the forms
+described below, then Tcl performs \fIvariable
substitution\fR: the dollar-sign and the following characters are
replaced in the word by the value of a variable.
Variable substitution may take any of the following forms:
.RS
.TP 15
\fB$\fIname\fR
+.
\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\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
+.
\fIName\fR gives the name of an array variable and \fIindex\fR gives
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\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
-\fIName\fR is the name of a scalar variable. It may contain any
-characters whatsoever except for close braces.
-.LP
+.
+\fIName\fR is the name of a scalar variable or array element. It may contain
+any characters whatsoever except for close braces. It indicates an array
+element if \fIname\fR is in the form
+.QW \fIarrayName\fB(\fIindex\fB)\fR
+where \fIarrayName\fR does not contain any open parenthesis characters,
+.QW \fB(\fR ,
+or close brace characters,
+.QW \fB}\fR ,
+and \fIindex\fR can be any sequence of characters except for close brace
+characters. No further
+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 (``\e'') appears within a word then
-\fIbackslash substitution\fR occurs.
+If a backslash
+.PQ \e
+appears within a word then \fIbackslash substitution\fR occurs.
In all cases but those described below the backslash is dropped and
the following character is treated as an ordinary
character and included in the word.
@@ -127,25 +158,25 @@ handled specially, along with the value that replaces each sequence.
.RS
.TP 7
\e\fBa\fR
-Audible alert (bell) (0x7).
+Audible alert (bell) (Unicode U+000007).
.TP 7
\e\fBb\fR
-Backspace (0x8).
+Backspace (Unicode U+000008).
.TP 7
\e\fBf\fR
-Form feed (0xc).
+Form feed (Unicode U+00000C).
.TP 7
\e\fBn\fR
-Newline (0xa).
+Newline (Unicode U+00000A).
.TP 7
\e\fBr\fR
-Carriage-return (0xd).
+Carriage-return (Unicode U+00000D).
.TP 7
\e\fBt\fR
-Tab (0x9).
+Tab (Unicode U+000009).
.TP 7
\e\fBv\fR
-Vertical tab (0xb).
+Vertical tab (Unicode U+00000B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
@@ -153,37 +184,55 @@ A single space character replaces the backslash, newline, and all spaces
and tabs after the newline. This backslash sequence is unique in that it
is replaced in a separate pre-pass before the command is actually parsed.
This means that it will be replaced even when it occurs between braces,
-and the resulting space will be treated as a word separator if it isn't
+and the resulting space will be treated as a word separator if it is not
in braces or quotes.
.TP 7
\e\e
-Backslash (``\e'').
+Backslash
+.PQ \e "" .
.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\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
+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 (i.e., the character will be in the
+range U+000000\(enU+0000FF).
.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.
-.LP
+inserted. The upper bits of the Unicode character will be 0 (i.e., the
+character will be in the range U+000000\(enU+00FFFF).
+.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+000000\(enU+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.
+.RS
+.PP
+The range U+010000\(enU+10FFFD is reserved for the future.
+.RE
+.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
-If a hash character (``#'') appears at a point where Tcl is
+If a hash character
+.PQ #
+appears at a point where Tcl is
expecting the first character of the first word of a command,
then the hash character and the characters that follow it, up
through the next newline, are treated as a comment and ignored.
@@ -201,13 +250,15 @@ no substitutions are performed before making the recursive
call and no additional substitutions are performed on the result
of the nested script.
.RS
-.LP
+.PP
Substitutions take place from left to right, and each substitution is
evaluated completely before attempting to evaluate the next. Thus, a
sequence like
+.PP
.CS
set y [set x 0][incr x][incr x]
.CE
+.PP
will always set the variable \fIy\fR to the value, \fI012\fR.
.RE
.IP "[12] \fBSubstitution and word boundaries.\fR"
@@ -216,3 +267,9 @@ except for argument expansion as specified in rule [5].
For example, during variable substitution the entire value of
the variable becomes part of a single word, even if the variable's
value contains spaces.
+.SH KEYWORDS
+backslash, command, comment, script, substitution, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/TclZlib.3 b/doc/TclZlib.3
new file mode 100644
index 0000000..c6a6417
--- /dev/null
+++ b/doc/TclZlib.3
@@ -0,0 +1,276 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH TclZlib 3 8.6 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_ZlibAdler32, Tcl_ZlibCRC32, Tcl_ZlibDeflate, Tcl_ZlibInflate, Tcl_ZlibStreamChecksum, Tcl_ZlibStreamClose, Tcl_ZlibStreamEof, Tcl_ZlibStreamGet, Tcl_ZlibStreamGetCommandName, Tcl_ZlibStreamInit, Tcl_ZlibStreamPut \- compression and decompression functions
+.SH SYNOPSIS
+.nf
+#include <tcl.h>
+.sp
+int
+\fBTcl_ZlibDeflate\fR(\fIinterp, format, dataObj, level, dictObj\fR)
+.sp
+int
+\fBTcl_ZlibInflate\fR(\fIinterp, format, dataObj, dictObj\fR)
+.sp
+unsigned int
+\fBTcl_ZlibCRC32\fR(\fIinitValue, bytes, length\fR)
+.sp
+unsigned int
+\fBTcl_ZlibAdler32\fR(\fIinitValue, bytes, length\fR)
+.sp
+int
+\fBTcl_ZlibStreamInit\fR(\fIinterp, mode, format, level, dictObj, zshandlePtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ZlibStreamGetCommandName\fR(\fIzshandle\fR)
+.sp
+int
+\fBTcl_ZlibStreamEof\fR(\fIzshandle\fR)
+.sp
+int
+\fBTcl_ZlibStreamClose\fR(\fIzshandle\fR)
+.sp
+int
+\fBTcl_ZlibStreamReset\fR(\fIzshandle\fR)
+.sp
+int
+\fBTcl_ZlibStreamChecksum\fR(\fIzshandle\fR)
+.sp
+int
+\fBTcl_ZlibStreamPut\fR(\fIzshandle, dataObj, flush\fR)
+.sp
+int
+\fBTcl_ZlibStreamGet\fR(\fIzshandle, dataObj, count\fR)
+.sp
+\fBTcl_ZlibStreamSetCompressionDictionary\fR(\fIzshandle, compDict\fR)
+.fi
+.SH ARGUMENTS
+.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
+be NULL to create a stream that is not bound to a command.
+.AP int format in
+What format of compressed data to work with. Must be one of
+\fBTCL_ZLIB_FORMAT_ZLIB\fR for zlib-format data, \fBTCL_ZLIB_FORMAT_GZIP\fR
+for gzip-format data, or \fBTCL_ZLIB_FORMAT_RAW\fR for raw compressed data. In
+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 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
+What level of compression to use. Should be a number from 0 to 9 or one of the
+following: \fBTCL_ZLIB_COMPRESS_NONE\fR for no compression,
+\fBTCL_ZLIB_COMPRESS_FAST\fR for fast but inefficient compression,
+\fBTCL_ZLIB_COMPRESS_BEST\fR for slow but maximal compression, or
+\fBTCL_ZLIB_COMPRESS_DEFAULT\fR for the level recommended by the zlib library.
+.AP Tcl_Obj *dictObj in/out
+A dictionary that contains, or which will be updated to contain, a description
+of the gzip header associated with the compressed data. Only useful when the
+\fIformat\fR is \fBTCL_ZLIB_FORMAT_GZIP\fR or \fBTCL_ZLIB_FORMAT_AUTO\fR. If
+a NULL is passed, a default header will be used on compression and the header
+will be ignored (apart from integrity checks) on decompression. See the
+section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
+dictionary.
+.AP "unsigned int" initValue in
+The initial value for the checksum algorithm.
+.AP "unsigned char" *bytes in
+An array of bytes to run the checksum algorithm over, or NULL to get the
+recommended initial value for the checksum algorithm.
+.AP int length in
+The number of bytes in the array.
+.AP int mode in
+What mode to operate the stream in. Should be either
+\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
+\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
+.AP Tcl_ZlibStream *zshandlePtr out
+A pointer to a variable in which to write the abstract token for the stream
+upon successful creation.
+.AP Tcl_ZlibStream zshandle in
+The abstract token for the stream to operate on.
+.AP int flush in
+Whether and how to flush the stream after writing the data to it. Must be one
+of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
+if the currently compressed data must be made available for access using
+\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
+into a state where the decompressor can recover from on corruption, or
+\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
+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
+library by Jean-loup Gailly and Mark Adler.
+.PP
+\fBTcl_ZlibDeflate\fR and \fBTcl_ZlibInflate\fR respectively compress and
+decompress the data contained in the \fIdataObj\fR argument, according to the
+\fIformat\fR and, for compression, \fIlevel\fR arguments. The dictionary in
+the \fIdictObj\fR parameter is used to convey additional header information
+about the compressed data when the compression format supports it; currently,
+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 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
+bytes, returning the computed checksum. Checksums are computed incrementally,
+allowing data to be processed one block at a time, but this requires the
+caller to maintain the current checksum and pass it in as the \fIinitValue\fR
+parameter; the initial value to use for this can be obtained by using NULL for
+the \fIbytes\fR parameter instead of a pointer to the array of bytes to
+compute the checksum over. Thus, typical usage in the single data block case
+is like this:
+.PP
+.CS
+checksum = \fBTcl_ZlibCRC32\fR(\fBTcl_ZlibCRC32\fR(0,NULL,0), data, length);
+.CE
+.PP
+Note that the Adler-32 algorithm is not a real checksum, but instead is a
+related type of hash that works best on longer data.
+.SS "ZLIB STREAMS"
+.PP
+\fBTcl_ZlibStreamInit\fR creates a compressing or decompressing stream that is
+linked to a Tcl command, according to its arguments, and provides an abstract
+token for the stream and returns a normal Tcl result code;
+\fBTcl_ZlibStreamGetCommandName\fR returns the name of that command given the
+stream token, or NULL if the stream has no command. Streams are not designed
+to be thread-safe; each stream should only ever be used from the thread that
+created it. When working with gzip streams, a dictionary (fields as given in
+the \fBGZIP OPTIONS DICTIONARY\fR section below) can be given via the
+\fIdictObj\fR parameter that on compression allows control over the generated
+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 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
+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 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
+\fBTcl_ZlibStreamChecksum\fR returns the checksum computed over the
+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
+registered with an interpreter, an error message will be left in the
+interpreter result when this function returns TCL_ERROR.
+Finally, \fBTcl_ZlibStreamClose\fR will clean up the stream and delete the
+associated command: using \fBTcl_DeleteCommand\fR on the stream's command is
+equivalent (when such a command exists).
+.SH "GZIP OPTIONS DICTIONARY"
+.PP
+The \fIdictObj\fR parameter to \fBTcl_ZlibDeflate\fR, \fBTcl_ZlibInflate\fR
+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 value).
+.PP
+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
+.
+This holds the comment field of the header, if present. If absent, no comment
+was supplied (on decompression) or will be created (on compression).
+.TP
+\fBcrc\fR
+.
+A boolean value describing whether a CRC of the header is computed. Note that
+the \fBgzip\fR program does \fInot\fR use or allow a CRC on the header.
+.TP
+\fBfilename\fR
+.
+The name of the file that held the uncompressed data. This should not contain
+any directory separators, and should be sanitized before use on decompression
+with \fBfile tail\fR.
+.TP
+\fBos\fR
+.
+The operating system type code field from the header (if not the
+.QW unknown
+value). See RFC 1952 for the meaning of these codes. On compression, if this
+is absent then the field will be set to the
+.QW unknown
+value.
+.TP
+\fBsize\fR
+.
+The size of the uncompressed data. This is ignored on compression; the size
+of the data compressed depends on how much data is supplied to the
+compression engine.
+.TP
+\fBtime\fR
+.
+The time field from the header if non-zero, expected to be the time that the
+file named by the \fBfilename\fR field was modified. Suitable for use with
+\fBclock format\fR. On creation, the right value to use is that from
+\fBclock seconds\fR or \fBfile mtime\fR.
+.TP
+\fBtype\fR
+.
+The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if
+known.
+.SH "PORTABILITY NOTES"
+These functions will fail gracefully if Tcl is not linked with the zlib
+library.
+.SH "SEE ALSO"
+Tcl_NewByteArrayObj(3), zlib(n)
+'\"Tcl_StackChannel(3)
+.SH "KEYWORDS"
+compress, decompress, deflate, gzip, inflate
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index 6c02a9e..5fd5002 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -6,37 +6,49 @@
'\" 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.11 2004/10/07 14:44:34 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
-Tcl_Main, Tcl_SetMainLoop \- main program and event loop definition for Tcl-based applications
+Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_Main\fR(\fIargc, argv, appInitProc\fR)
.sp
+\fBTcl_SetStartupScript\fR(\fIpath, encoding\fR)
+.sp
+Tcl_Obj *
+\fBTcl_GetStartupScript\fR(\fIencodingPtr\fR)
+.sp
\fBTcl_SetMainLoop\fR(\fImainLoopProc\fR)
.SH ARGUMENTS
.AS Tcl_MainLoopProc *mainLoopProc
.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.
+.AP Tcl_Obj *path in
+Name of file to use as startup script, or NULL.
+.AP "const char" *encoding in
+Encoding of file to use as startup script, or NULL.
+.AP "const char" **encodingPtr out
+If non-NULL, location to write a copy of the (const char *)
+pointing to the encoding name.
.AP Tcl_MainLoopProc *mainLoopProc in
Address of an application-specific event loop procedure.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_Main\fR can serve as the main program for Tcl-based shell
-applications. A ``shell application'' is a program
+applications. A
+.QW "shell application"
+is a program
like tclsh or wish that supports both interactive interpretation
of Tcl and evaluation of a script contained in a file given as
a command line argument. \fBTcl_Main\fR is offered as a convenience
@@ -46,7 +58,7 @@ library and interactive shell operation. Other styles of embedding
Tcl in an application are not supported by \fBTcl_Main\fR. Those
must be achieved by calling lower level functions in the Tcl library
directly.
-
+.PP
The \fBTcl_Main\fR function has been offered by the Tcl library
since release Tcl 7.4. In older releases of Tcl, the Tcl library
itself defined a function \fBmain\fR, but that lacks flexibility
@@ -75,41 +87,76 @@ restriction is not a problem with normal use described above.
channels to their default values. See \fBTcl_StandardChannels\fR for
more information.
.PP
-\fBTcl_Main\fR supports two modes of operation, depending on the
-values of \fIargc\fR and \fIargv\fR. If the first few arguments
-in \fIargv\fR match ?\fB-encoding \fIname\fR? ?\fIfileName\fR?,
-where \fIfileName\fR does not begin with the character \fI-\fR,
+\fBTcl_Main\fR supports two modes of operation, depending on
+whether the filename and encoding of a startup script has been
+established. The routines \fBTcl_SetStartupScript\fR and
+\fBTcl_GetStartupScript\fR are the tools for controlling this
+configuration of \fBTcl_Main\fR.
+.PP
+\fBTcl_SetStartupScript\fR registers the value \fIpath\fR
+as the name of the file for \fBTcl_Main\fR to evaluate as
+its startup script. The value \fIencoding\fR is Tcl's name
+for the encoding used to store the text in that file. A
+value of \fBNULL\fR for \fIencoding\fR is a signal to use
+the system encoding. A value of \fBNULL\fR for \fIpath\fR
+erases any existing registration so that \fBTcl_Main\fR
+will not evaluate any startup script.
+.PP
+\fBTcl_GetStartupScript\fR queries the registered file name
+and encoding set by the most recent \fBTcl_SetStartupScript\fR
+call in the same thread. The stored file name is returned,
+and the stored encoding name is written to space pointed to
+by \fIencodingPtr\fR, when that is not NULL.
+.PP
+The file name and encoding values managed by the routines
+\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
+are stored per-thread. Although the storage and retrieval
+functions of these routines work in any thread, only those
+calls in the same master thread as \fBTcl_Main\fR can have
+any influence on it.
+.PP
+The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
+first to establish its desired startup script. If \fBTcl_Main\fR
+finds that no such startup script has been established, it consults
+the first few arguments in \fIargv\fR. If they match
+?\fB\-encoding \fIname\fR? \fIfileName\fR,
+where \fIfileName\fR does not begin with the character \fI\-\fR,
then \fIfileName\fR is taken to be the name of a file containing
a \fIstartup script\fR, and \fIname\fR is taken to be the name
-of the encoding of the contents of that file, which \fBTcl_Main\fR
-will attempt to evaluate. Otherwise, \fBTcl_Main\fR will enter an
-interactive mode.
+of the encoding of the contents of that file. \fBTcl_Main\fR
+then calls \fBTcl_SetStartupScript\fR with these values.
.PP
-In either mode, \fBTcl_Main\fR will define in its master interpreter
+\fBTcl_Main\fR then defines in its master interpreter
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
.PP
When it has finished its own initialization, but before it processes
commands, \fBTcl_Main\fR calls the procedure given by the
-\fIappInitProc\fR argument. This procedure provides a ``hook'' for
-the application to perform its own initialization of the interpreter
+\fIappInitProc\fR argument. This procedure provides a
+.QW hook
+for the application to perform its own initialization of the interpreter
created by \fBTcl_Main\fR, such as defining application-specific
-commands. The procedure must have an interface that matches the
-type \fBTcl_AppInitProc\fR:
+commands. The application initialization routine might also
+call \fBTcl_SetStartupScript\fR to (re-)set the file and encoding
+to be used as a startup script. The procedure must have an interface
+that matches the type \fBTcl_AppInitProc\fR:
+.PP
.CS
-typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
+typedef int \fBTcl_AppInitProc\fR(
+ Tcl_Interp *\fIinterp\fR);
.CE
-
+.PP
\fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR; for more
details on this procedure, see the documentation for \fBTcl_AppInit\fR.
.PP
-When the \fIappInitProc\fR is finished, \fBTcl_Main\fR enters one
-of its two modes. If a startup script has been provided, \fBTcl_Main\fR
-attempts to evaluate it. Otherwise, interactive mode begins with
-examination of the variable \fItcl_rcFileName\fR in the master
-interpreter. If that variable exists and holds the name of a readable
-file, the contents of that file are evaluated in the master interpreter.
-Then interactive operations begin,
+When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
+\fBTcl_GetStartupScript\fR to determine what startup script has
+been requested, if any. If a startup script has been provided,
+\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive
+mode begins with examination of the variable \fItcl_rcFileName\fR
+in the master interpreter. If that variable exists and holds the
+name of a readable file, the contents of that file are evaluated
+in the master interpreter. Then interactive operations begin,
with prompts and command evaluation results written to the standard
output channel, and commands read from the standard input channel
and then evaluated. The prompts written to the standard output
@@ -128,8 +175,9 @@ When the loop procedure returns in interactive mode, interactive operation
will continue.
The main loop procedure must have an interface that matches the type
\fBTcl_MainLoopProc\fR:
+.PP
.CS
-typedef void Tcl_MainLoopProc(void);
+typedef void \fBTcl_MainLoopProc\fR(void);
.CE
.PP
\fBTcl_Main\fR does not return. Normally a program based on
@@ -141,10 +189,8 @@ procedure (if any) returns. In non-interactive mode, after
\fBTcl_Main\fR evaluates the startup script, and the main loop
procedure (if any) returns, \fBTcl_Main\fR will also evaluate
the \fBexit\fR command.
-
.SH "SEE ALSO"
tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3),
-exit(n)
-
+exit(n), encoding(n)
.SH KEYWORDS
application-specific initialization, command-line arguments, main program
diff --git a/doc/Thread.3 b/doc/Thread.3
index 7a236b8..ac5f2ba 100644
--- a/doc/Thread.3
+++ b/doc/Thread.3
@@ -5,10 +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: Thread.3,v 1.24 2005/05/10 18:33:57 kennykb Exp $
-'\"
-.so man.macros
.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
@@ -38,19 +36,19 @@ void
\fBTcl_MutexFinalize\fR(\fImutexPtr\fR)
.sp
int
-\fBTcl_CreateThread\fR(\fIidPtr, threadProc, clientData, stackSize, flags\fR)
+\fBTcl_CreateThread\fR(\fIidPtr, proc, clientData, stackSize, flags\fR)
.sp
int
\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
-.AS Tcl_CreateThreadProc threadProc out
+.AS Tcl_CreateThreadProc proc out
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
A mutex lock.
-.AP Tcl_Time *timePtr in
+.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait. NULL to wait forever.
-Note that a polling value of 0 seconds doesn't make much sense.
+Note that a polling value of 0 seconds does not make much sense.
.AP Tcl_ThreadDataKey *keyPtr in
This identifies a block of thread local storage. The key should be
static and process-wide, yet each thread will end up associating
@@ -64,15 +62,15 @@ The referred storage will contain the id of the newly created thread as
returned by the operating system.
.AP Tcl_ThreadId id in
Id of the thread waited upon.
-.AP Tcl_ThreadCreateProc threadProc in
+.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP ClientData clientData in
-Arbitrary information. Passed as sole argument to the \fIthreadProc\fR.
+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
@@ -82,7 +80,7 @@ waited upon into it.
Beginning with the 8.1 release, the Tcl core is thread safe, which
allows you to incorporate Tcl into multithreaded applications without
customizing the Tcl core. To enable Tcl multithreading support,
-you must include the \fB--enable-threads\fR option to \fBconfigure\fR
+you must include the \fB\-\|\-enable-threads\fR option to \fBconfigure\fR
when you configure and compile your Tcl core.
.PP
An important constraint of the Tcl threads implementation is that
@@ -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
@@ -182,13 +180,59 @@ explicitly by calls to \fBTcl_MutexFinalize\fR or
\fBTcl_ConditionFinalize\fR.
Thread local storage is reclaimed during \fBTcl_FinalizeThread\fR.
.SH "SCRIPT-LEVEL ACCESS TO THREADS"
-.VS 8.5
+.PP
Tcl provides no built-in commands for scripts to use to create,
manage, or join threads, nor any script-level access to mutex or
condition variables. It provides such facilities only via C
interfaces, and leaves it up to packages to expose these matters to
the script level. One such package is the \fBThread\fR package.
-.VE 8.5
+.SH EXAMPLE
+.PP
+To create a thread with portable code, its implementation function should be
+declared as follows:
+.PP
+.CS
+static \fBTcl_ThreadCreateProc\fR MyThreadImplFunc;
+.CE
+.PP
+It should then be defined like this example, which just counts up to a given
+value and then finishes.
+.PP
+.CS
+static \fBTcl_ThreadCreateType\fR
+MyThreadImplFunc(
+ ClientData clientData)
+{
+ int i, limit = (int) clientData;
+ for (i=0 ; i<limit ; i++) {
+ /* doing nothing at all here */
+ }
+ \fBTCL_THREAD_CREATE_RETURN\fR;
+}
+.CE
+.PP
+To create the above thread, make it execute, and wait for it to finish, we
+would do this:
+.PP
+.CS
+int limit = 1000000000;
+ClientData limitData = (void*)((intptr_t) limit);
+Tcl_ThreadId id; \fI/* holds identity of thread created */\fR
+int result;
+
+if (\fBTcl_CreateThread\fR(&id, MyThreadImplFunc, limitData,
+ \fBTCL_THREAD_STACK_DEFAULT\fR,
+ \fBTCL_THREAD_JOINABLE\fR) != TCL_OK) {
+ \fI/* Thread did not create correctly */\fR
+ return;
+}
+\fI/* Do something else for a while here */\fR
+if (\fBTcl_JoinThread\fR(id, &result) != TCL_OK) {
+ \fI/* Thread did not finish properly */\fR
+ return;
+}
+\fI/* All cleaned up nicely */\fR
+.CE
.SH "SEE ALSO"
Tcl_GetCurrentThread(3), Tcl_ThreadQueueEvent(3), Tcl_ThreadAlert(3),
Tcl_ExitThread(3), Tcl_FinalizeThread(3), Tcl_CreateThreadExitHandler(3),
diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
index 15539ad..587e76b 100644
--- a/doc/ToUpper.3
+++ b/doc/ToUpper.3
@@ -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.
'\"
-'\" 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"
+.so man.macros
.BS
.SH NAME
Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_UtfToLower, Tcl_UtfToTitle \- routines for manipulating the case of Unicode characters and UTF-8 strings
diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3
index 10714a1..1244576 100644
--- a/doc/TraceCmd.3
+++ b/doc/TraceCmd.3
@@ -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.
'\"
-'\" CVS: @(#) $Id: TraceCmd.3,v 1.8 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command
@@ -30,7 +28,7 @@ Interpreter containing the command.
.AP "const char" *cmdName in
Name of command.
.AP int flags in
-OR-ed collection of the values \fBTCL_TRACE_RENAME\fR and
+OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR.
.AP Tcl_CommandTraceProc *proc in
Procedure to call when specified operations occur to \fIcmdName\fR.
@@ -41,7 +39,6 @@ If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR,
so this call will return information about next trace. If NULL, this
call will return information about first trace.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_TraceCommand\fR allows a C procedure to monitor operations
@@ -53,7 +50,7 @@ occurred (e.g. \fIcmdName\fR specifies a non-existent command) then
interpreter's result.
.PP
The \fIflags\fR argument to \fBTcl_TraceCommand\fR indicates when the
-trace procedure is to be invoked. It consists of an OR-ed combination
+trace procedure is to be invoked. It consists of an OR'ed combination
of any of the following values:
.TP
\fBTCL_TRACE_RENAME\fR
@@ -65,14 +62,16 @@ Invoke \fIproc\fR when the command is deleted.
Whenever one of the specified operations occurs to the command,
\fIproc\fR will be invoked. It should have arguments and result that
match the type \fBTcl_CommandTraceProc\fR:
+.PP
.CS
-typedef void Tcl_CommandTraceProc(
+typedef void \fBTcl_CommandTraceProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
const char *\fIoldName\fR,
const char *\fInewName\fR,
int \fIflags\fR);
.CE
+.PP
The \fIclientData\fR and \fIinterp\fR parameters will have the same
values as those passed to \fBTcl_TraceCommand\fR when the trace was
created. \fIClientData\fR typically points to an application-specific
@@ -80,7 +79,7 @@ data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
an empty string or NULL when the command is being deleted.)
-\fIFlags\fR is an OR-ed combination of bits potentially providing
+\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information. One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which
operation is being performed on the command. The bit
@@ -112,7 +111,7 @@ argument.
If the \fIprevClientData\fR argument is NULL then the return
value corresponds to the first (most recently created) matching
trace, or NULL if there are no matching traces.
-If the \fIprevClientData\fR argument isn't NULL, then it should
+If the \fIprevClientData\fR argument is not NULL, then it should
be the return value from a previous call to \fBTcl_CommandTraceInfo\fR.
In this case, the new return value will correspond to the next
matching trace after the one whose \fIclientData\fR matches
@@ -120,7 +119,6 @@ matching trace after the one whose \fIclientData\fR matches
or if there are no more matching traces after it.
This mechanism makes it possible to step through all of the
traces for a given command that have the same \fIproc\fR.
-
.SH "CALLING COMMANDS DURING TRACES"
.PP
During rename traces, the command being renamed is visible with both
@@ -128,7 +126,6 @@ names simultaneously, and the command still exists during delete
traces (if \fBTCL_INTERP_DESTROYED\fR is not set). However, there is no
mechanism for signaling that an error occurred in a trace procedure,
so great care should be taken that errors do not get silently lost.
-
.SH "MULTIPLE TRACES"
.PP
It is possible for multiple traces to exist on the same command.
@@ -140,14 +137,11 @@ If the command being renamed is renamed by one of its rename traces,
that renaming takes precedence over the one that triggered the trace
and the collection of traces will not be reexecuted; if several traces
rename the command, the last renaming takes precedence.
-
.SH "TCL_TRACE_DESTROYED FLAG"
.PP
In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR.
-
-'\" Perhaps need some more comments here? - DKF
-
+.\" Perhaps need some more comments here? - DKF
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
@@ -160,12 +154,10 @@ It is not safe for the procedures to invoke any Tcl procedures
on the interpreter, since its state is partially deleted.
All that trace procedures should do under these circumstances is
to clean up and free their own internal data structures.
-
.SH BUGS
.PP
-Tcl doesn't do any error checking to prevent trace procedures
+Tcl does not do any error checking to prevent trace procedures
from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
set.
-
.SH KEYWORDS
clientData, trace, command
diff --git a/doc/TraceVar.3 b/doc/TraceVar.3
index a659f03..97d035b 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -5,10 +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: TraceVar.3,v 1.15 2005/05/10 18:33:57 kennykb Exp $
-'\"
-.so man.macros
.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable
@@ -62,7 +60,6 @@ If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or
next trace. If NULL, this call will return information about first
trace.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_TraceVar\fR allows a C procedure to monitor and control
@@ -70,7 +67,7 @@ access to a Tcl variable, so that the C procedure is invoked
whenever the variable is read or written or unset.
If the trace is created successfully then \fBTcl_TraceVar\fR returns
\fBTCL_OK\fR. If an error occurred (e.g. \fIvarName\fR specifies an element
-of an array, but the actual variable isn't an array) then \fBTCL_ERROR\fR
+of an array, but the actual variable is not an array) then \fBTCL_ERROR\fR
is returned and an error message is left in the interpreter's result.
.PP
The \fIflags\fR argument to \fBTcl_TraceVar\fR indicates when the
@@ -124,14 +121,16 @@ Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
+.PP
.CS
-typedef char *Tcl_VarTraceProc(
+typedef char *\fBTcl_VarTraceProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
char *\fIname1\fR,
char *\fIname2\fR,
int \fIflags\fR);
.CE
+.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
@@ -188,7 +187,7 @@ argument.
If the \fIprevClientData\fR argument is NULL then the return
value corresponds to the first (most recently created) matching
trace, or NULL if there are no matching traces.
-If the \fIprevClientData\fR argument isn't NULL, then it should
+If the \fIprevClientData\fR argument is not NULL, then it should
be the return value from a previous call to \fBTcl_VarTraceInfo\fR.
In this case, the new return value will correspond to the next
matching trace after the one whose \fIclientData\fR matches
@@ -196,7 +195,6 @@ matching trace after the one whose \fIclientData\fR matches
or if there are no more matching traces after it.
This mechanism makes it possible to step through all of the
traces for a given variable that have the same \fIproc\fR.
-
.SH "TWO-PART NAMES"
.PP
The procedures \fBTcl_TraceVar2\fR, \fBTcl_UntraceVar2\fR, and
@@ -213,13 +211,10 @@ treated as an element name (which can have any string value) and
the characters before the first open
parenthesis are treated as the name of an array variable.
If \fIname2\fR is NULL and \fIname1\fR does not refer
-to an array element
-it means that either the variable is
+to an array element it means that either the variable is
a scalar or the trace is to be set on the entire array rather
than an individual element (see WHOLE-ARRAY TRACES below for
more information).
-
-
.SH "ACCESSING VARIABLES DURING TRACES"
.PP
During read, write, and array traces, the
@@ -245,7 +240,6 @@ from the variable before any trace procedures are invoked.
If new traces are set by unset trace procedures, these traces
will be invoked on accesses to the variable by the trace
procedures.
-
.SH "CALLBACK TIMING"
.PP
When read tracing has been specified for a variable, the trace
@@ -285,7 +279,6 @@ When unset tracing has been specified, the trace procedure
will be invoked whenever the variable is destroyed.
The traces will be called after the variable has been
completely unset.
-
.SH "WHOLE-ARRAY TRACES"
.PP
If a call to \fBTcl_TraceVar\fR or \fBTcl_TraceVar2\fR specifies
@@ -298,7 +291,6 @@ When an array is unset, a whole-array trace will be invoked
just once, with \fIname1\fR equal to the name of the array
and \fIname2\fR NULL; it will not be invoked once for each
element.
-
.SH "MULTIPLE TRACES"
.PP
It is possible for multiple traces to exist on the same variable.
@@ -310,7 +302,6 @@ before the individual-element traces.
If a read or write trace unsets the variable then all of the unset
traces will be invoked but the remainder of the read and write traces
will be skipped.
-
.SH "ERROR RETURNS"
.PP
Under normal conditions trace procedures should return NULL, indicating
@@ -337,7 +328,6 @@ The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
-
.SH "RESTRICTIONS"
.PP
A trace procedure can be called at any time, even when there
@@ -346,26 +336,24 @@ the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must save the original values of
the interpreter's \fBresult\fR and \fBfreeProc\fR fields and restore
them before it returns.
-
.SH "UNDEFINED VARIABLES"
.PP
It is legal to set a trace on an undefined variable.
The variable will still appear to be undefined until the
first time its value is set.
If an undefined variable is traced and then unset, the unset will fail
-with an error (``no such variable''), but the trace
-procedure will still be invoked.
-
+with an error
+.PQ "no such variable" "" ,
+but the trace procedure will still be invoked.
.SH "TCL_TRACE_DESTROYED FLAG"
.PP
In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR if the trace is being removed as part
of the deletion.
Traces on a variable are always removed whenever the variable
-is deleted; the only time \fBTCL_TRACE_DESTROYED\fR isn't set is for
+is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for
a whole-array trace invoked when only a single element of an
array is unset.
-
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
@@ -378,15 +366,15 @@ It is not safe for the procedures to invoke any Tcl procedures
on the interpreter, since its state is partially deleted.
All that trace procedures should do under these circumstances is
to clean up and free their own internal data structures.
-
.SH BUGS
.PP
-Tcl doesn't do any error checking to prevent trace procedures
+Tcl does not do any error checking to prevent trace procedures
from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
set.
.PP
-Array traces are not yet integrated with the Tcl "info exists" command,
+Array traces are not yet integrated with the Tcl \fBinfo exists\fR command,
nor is there Tcl-level access to array traces.
-
+.SH "SEE ALSO"
+trace(n)
.SH KEYWORDS
clientData, trace, variable
diff --git a/doc/Translate.3 b/doc/Translate.3
index f496e6f..0f223e4 100644
--- a/doc/Translate.3
+++ b/doc/Translate.3
@@ -5,10 +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: Translate.3,v 1.9 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory
@@ -23,14 +21,14 @@ char *
.AP Tcl_Interp *interp in
Interpreter in which to report an error, if any.
.AP "const char" *name in
-File name, which may start with a ``~''.
+File name, which may start with a
+.QW ~ .
.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
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
@@ -39,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
@@ -55,7 +53,7 @@ After \fBTcl_TranslateFileName\fR returns a non-NULL result, the caller must
eventually invoke \fBTcl_DStringFree\fR to free any information
placed in \fI*bufferPtr\fR. The caller need not know whether or
not \fBTcl_TranslateFileName\fR actually used the string; \fBTcl_TranslateFileName\fR
-initializes \fI*bufferPtr\fR even if it doesn't use it, so the call to
+initializes \fI*bufferPtr\fR even if it does not use it, so the call to
\fBTcl_DStringFree\fR will be safe in either case.
.PP
If an error occurs (e.g. because there was no user by the given
@@ -67,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 a53cacf..ea6fc5b 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: UniCharIsAlpha.3,v 1.3 2004/10/07 14:44:35 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters
@@ -64,7 +62,7 @@ with the various routines.
Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
fixed-size quantity.
-.SH CHARACTER CLASSES
+.SH "CHARACTER CLASSES"
.PP
\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode character.
.PP
diff --git a/doc/UpVar.3 b/doc/UpVar.3
index 56aba45..8e7ba08 100644
--- a/doc/UpVar.3
+++ b/doc/UpVar.3
@@ -5,10 +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: UpVar.3,v 1.10 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_UpVar, Tcl_UpVar2 \- link one variable to another
@@ -39,9 +37,10 @@ variable so that references to \fIdestName\fR
refer to the other variable. Must not currently exist except as
an upvar-ed variable.
.AP int flags in
-Either \fBTCL_GLOBAL_ONLY\fR or 0; if non-zero, then \fIdestName\fR is
-a global variable; otherwise it is a local to the current procedure
-(or global if no procedure is active).
+One of \fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR or 0; if non-zero,
+then \fIdestName\fR is a global or namespace variable; otherwise it is
+local to the current procedure (or current namespace if no procedure is
+active).
.AP "const char" *name1 in
First part of source variable's name (scalar name, or name of array
without array index).
diff --git a/doc/Utf.3 b/doc/Utf.3
index b1f29ca..3b2ef91 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: Utf.3,v 1.23 2005/05/10 18:33:58 kennykb Exp $
-'\"
-.so man.macros
.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
@@ -15,7 +13,7 @@ Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_Ut
.nf
\fB#include <tcl.h>\fR
.sp
-typedef ... Tcl_UniChar;
+typedef ... \fBTcl_UniChar\fR;
.sp
int
\fBTcl_UniCharToUtf\fR(\fIch, buf\fR)
@@ -156,8 +154,9 @@ end of the \fBTcl_DString\fR.
\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
storing the result in the previously initialized \fBTcl_DString\fR.
In the argument \fIlength\fR, you may either specify the length of
-the given UTF-8 string in bytes or "-1", in which
-case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
+the given UTF-8 string in bytes or
+.QW \-1 ,
+in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
calculate the length. The return value is a pointer to the Unicode
representation of the UTF-8 string. Storage for the return value
is appended to the end of the \fBTcl_DString\fR. The Unicode string
diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3
index 2a9adc2..33807d5 100644
--- a/doc/WrongNumArgs.3
+++ b/doc/WrongNumArgs.3
@@ -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.
'\"
-'\" RCS: @(#) $Id: WrongNumArgs.3,v 1.8 2004/10/07 15:15:48 dkf Exp $
-'\"
-.so man.macros
.TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_WrongNumArgs \- generate standard error message for wrong number of arguments
@@ -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.
@@ -31,48 +29,51 @@ Additional error information to print after leading arguments
from \fIobjv\fR. This typically gives the acceptable syntax
of the command. This argument may be NULL.
.BE
-
.SH DESCRIPTION
.PP
\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 ``\fBfileName count\fR''
-then \fIinterp\fR's result object will be set to the following
+\fIobjc\fR is 1, and \fImessage\fR is
+.QW "\fBfileName count\fR"
+then \fIinterp\fR's result value will be set to the following
string:
+.PP
.CS
wrong # args: should be "foo fileName count"
.CE
+.PP
If \fIobjc\fR is 2, the result will be set to the following string:
+.PP
.CS
wrong # args: should be "foo bar fileName count"
.CE
+.PP
\fIObjc\fR is usually 1, but may be 2 or more for commands like
\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
wrong # args: should be "foo barfly fileName count"
.CE
-
.SH "SEE ALSO"
-Tcl_GetIndexFromObj
-
+Tcl_GetIndexFromObj(3)
.SH KEYWORDS
command, error message, wrong number of arguments
diff --git a/doc/after.n b/doc/after.n
index bd778dc..e61bb88 100644
--- a/doc/after.n
+++ b/doc/after.n
@@ -5,10 +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: after.n,v 1.7 2004/11/20 00:17:31 dgp Exp $
-'\"
-.so man.macros
.TH after n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -26,7 +24,6 @@ after \- Execute a command after a time delay
.sp
\fBafter info \fR?\fIid\fR?
.BE
-
.SH DESCRIPTION
.PP
This command is used to delay execution of the program or to execute
@@ -34,12 +31,14 @@ a command in background sometime in the future. It has several forms,
depending on the first argument to the command:
.TP
\fBafter \fIms\fR
+.
\fIMs\fR must be an integer giving a time in milliseconds.
The command sleeps for \fIms\fR milliseconds and then returns.
While the command is sleeping the application does not respond to
events.
.TP
\fBafter \fIms \fR?\fIscript script script ...\fR?
+.
In this form the command returns immediately, but it arranges
for a Tcl command to be executed \fIms\fR milliseconds later as an
event handler.
@@ -50,11 +49,12 @@ 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
\fBafter cancel \fIid\fR
+.
Cancels the execution of a delayed command that
was previously scheduled.
\fIId\fR indicates which command should be canceled; it must have
@@ -63,14 +63,16 @@ If the command given by \fIid\fR has already been executed then
the \fBafter cancel\fR command has no effect.
.TP
\fBafter cancel \fIscript script ...\fR
+.
This command also cancels the execution of a delayed command.
The \fIscript\fR arguments are concatenated together with space
separators (just as in the \fBconcat\fR command).
If there is a pending command that matches the string, it is
-cancelled and will never be executed; if no such command is
+canceled and will never be executed; if no such command is
currently pending then the \fBafter cancel\fR command has no effect.
.TP
\fBafter idle \fIscript \fR?\fIscript script ...\fR?
+.
Concatenates the \fIscript\fR arguments together with space
separators (just as in the \fBconcat\fR command), and arranges
for the resulting script to be evaluated later as an idle callback.
@@ -80,9 +82,10 @@ 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?
+.
This command returns information about existing event handlers.
If no \fIid\fR argument is supplied, the command returns
a list of the identifiers for all existing
@@ -90,7 +93,7 @@ event handlers created by the \fBafter\fR command for this
interpreter.
If \fIid\fR is supplied, it specifies an existing handler;
\fIid\fR must have been the return value from some previous call
-to \fBafter\fR and it must not have triggered yet or been cancelled.
+to \fBafter\fR and it must not have triggered yet or been canceled.
In this case the command returns a list with two elements.
The first element of the list is the script associated
with \fIid\fR, and the second element is either
@@ -106,14 +109,16 @@ and \fBupdate\fR commands.
.SH "EXAMPLES"
This defines a command to make Tcl do nothing at all for \fIN\fR
seconds:
+.PP
.CS
proc sleep {N} {
- \fBafter\fR [expr {int($N * 1000)}]
+ \fBafter\fR [expr {int($N * 1000)}]
}
.CE
.PP
This arranges for the command \fIwake_up\fR to be run in eight hours
(providing the event loop is active at that time):
+.PP
.CS
\fBafter\fR [expr {1000 * 60 * 60 * 8}] wake_up
.CE
@@ -128,17 +133,19 @@ processing steps (arranging for the next step to be done using an
already-triggered timer event only when the event queue has been
drained) and is useful when you want to ensure that a Tk GUI remains
responsive during a slow task.
+.PP
.CS
proc doOneStep {} {
- if {[::my_calc::one_step]} {
- \fBafter idle\fR [list \fBafter\fR 0 doOneStep]
- }
+ if {[::my_calc::one_step]} {
+ \fBafter idle\fR [list \fBafter\fR 0 doOneStep]
+ }
}
doOneStep
.CE
-
.SH "SEE ALSO"
concat(n), interp(n), update(n), vwait(n)
-
.SH KEYWORDS
cancel, delay, idle callback, sleep, time
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/append.n b/doc/append.n
index cf03418..4b3cfd0 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -5,10 +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: append.n,v 1.6 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH append n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,32 +14,36 @@ append \- Append to variable
.SH SYNOPSIS
\fBappend \fIvarName \fR?\fIvalue value value ...\fR?
.BE
-
.SH DESCRIPTION
.PP
Append all of the \fIvalue\fR arguments to the current value
-of variable \fIvarName\fR. If \fIvarName\fR doesn't exist,
+of variable \fIvarName\fR. If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.
The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
variables incrementally.
-For example, ``\fBappend a $b\fR'' is much more efficient than
-``\fBset a $a$b\fR'' if \fB$a\fR is long.
+For example,
+.QW "\fBappend a $b\fR"
+is much more efficient than
+.QW "\fBset a $a$b\fR"
+if \fB$a\fR is long.
.SH EXAMPLE
Building a string of comma-separated numbers piecemeal using a loop.
+.PP
.CS
set var 0
for {set i 1} {$i<=10} {incr i} {
- \fBappend\fR var "," $i
+ \fBappend\fR var "," $i
}
puts $var
# Prints 0,1,2,3,4,5,6,7,8,9,10
.CE
-
.SH "SEE ALSO"
concat(n), lappend(n)
-
.SH KEYWORDS
append, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/apply.n b/doc/apply.n
new file mode 100644
index 0000000..4b730ff
--- /dev/null
+++ b/doc/apply.n
@@ -0,0 +1,102 @@
+'\"
+'\" Copyright (c) 2006 Miguel Sofer
+'\" Copyright (c) 2006 Donal K. Fellows
+'\"
+.TH apply n "" Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+apply \- Apply an anonymous function
+.SH SYNOPSIS
+\fBapply \fIfunc\fR ?\fIarg1 arg2 ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The command \fBapply\fR applies the function \fIfunc\fR to the arguments
+\fIarg1 arg2 ...\fR and returns the result.
+.PP
+The function \fIfunc\fR is a two element list \fI{args body}\fR or a three
+element list \fI{args body namespace}\fR (as if the
+\fBlist\fR command had been used).
+The first element \fIargs\fR specifies the formal arguments to
+\fIfunc\fR. The specification of the formal arguments \fIargs\fR
+is shared with the \fBproc\fR command, and is described in detail in the
+corresponding manual page.
+.PP
+The contents of \fIbody\fR are executed by the Tcl interpreter
+after the local variables corresponding to the formal arguments are given
+the values of the actual parameters \fIarg1 arg2 ...\fR.
+When \fIbody\fR is being executed, variable names normally refer to
+local variables, which are created automatically when referenced and
+deleted when \fBapply\fR returns. One local variable is automatically
+created for each of the function's arguments.
+Global variables can only be accessed by invoking
+the \fBglobal\fR command or the \fBupvar\fR command.
+Namespace variables can only be accessed by invoking
+the \fBvariable\fR command or the \fBupvar\fR command.
+.PP
+The invocation of \fBapply\fR adds a call frame to Tcl's evaluation stack
+(the stack of frames accessed via \fBuplevel\fR). The execution of \fIbody\fR
+proceeds in this call frame, in the namespace given by \fInamespace\fR or
+in the global namespace if none was specified. If given, \fInamespace\fR is
+interpreted relative to the global namespace even if its name does not start
+with
+.QW :: .
+.PP
+The semantics of \fBapply\fR can also be described by:
+.PP
+.CS
+proc apply {fun args} {
+ set len [llength $fun]
+ if {($len < 2) || ($len > 3)} {
+ error "can't interpret \e"$fun\e" as anonymous function"
+ }
+ lassign $fun argList body ns
+ set name ::$ns::[getGloballyUniqueName]
+ set body0 {
+ rename [lindex [info level 0] 0] {}
+ }
+ proc $name $argList ${body0}$body
+ set code [catch {uplevel 1 $name $args} res opt]
+ return -options $opt $res
+}
+.CE
+.SH EXAMPLES
+.PP
+This shows how to make a simple general command that applies a transformation
+to each element of a list.
+.PP
+.CS
+proc map {lambda list} {
+ set result {}
+ foreach item $list {
+ lappend result [\fBapply\fR $lambda $item]
+ }
+ return $result
+}
+map {x {return [string length $x]:$x}} {a bb ccc dddd}
+ \fI\(-> 1:a 2:bb 3:ccc 4:dddd\fR
+map {x {expr {$x**2 + 3*$x - 2}}} {-4 -3 -2 -1 0 1 2 3 4}
+ \fI\(-> 2 -2 -4 -4 -2 2 8 16 26\fR
+.CE
+.PP
+The \fBapply\fR command is also useful for defining callbacks for use in the
+\fBtrace\fR command:
+.PP
+.CS
+set vbl "123abc"
+trace add variable vbl write {\fBapply\fR {{v1 v2 op} {
+ upvar 1 $v1 v
+ puts "updated variable to \e"$v\e""
+}}}
+set vbl 123
+set vbl abc
+.CE
+.SH "SEE ALSO"
+proc(n), uplevel(n)
+.SH KEYWORDS
+anonymous function, argument, lambda, procedure,
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/array.n b/doc/array.n
index 1a39b7b..e253a37 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,10 +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: array.n,v 1.15 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH array n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ array \- Manipulate array variables
.SH SYNOPSIS
\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command performs one of several operations on the
@@ -36,7 +33,7 @@ check, and must have been the return value from a previous
invocation of \fBarray startsearch\fR.
This option is particularly useful if an array has an element
with an empty name, since the return value from
-\fBarray nextelement\fR won't indicate whether the search
+\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray donesearch \fIarrayName searchId\fR
@@ -60,24 +57,24 @@ array are included in the result.
If \fIpattern\fR is specified, then only those elements whose names
match \fIpattern\fR (using the matching rules of
\fBstring match\fR) are included.
-If \fIarrayName\fR isn't the name of an array variable, or if
+If \fIarrayName\fR is not the name of an array variable, or if
the array contains no elements, then an empty list is returned.
-If traces on the array modify the list of elements, the elements
-returned are those that exist both before and after the call to
+If traces on the array modify the list of elements, the elements
+returned are those that exist both before and after the call to
\fBarray get\fR.
.TP
\fBarray names \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
Returns a list containing the names of all of the elements in
the array that match \fIpattern\fR. \fIMode\fR may be one of
-\fB-exact\fR, \fB-glob\fR, or \fB-regexp\fR. If specified, \fImode\fR
+\fB\-exact\fR, \fB\-glob\fR, or \fB\-regexp\fR. If specified, \fImode\fR
designates which matching rules to use to match \fIpattern\fR against
the names of the elements in the array. If not specified, \fImode\fR
-defaults to \fB-glob\fR. See the documentation for \fBstring match\fR
+defaults to \fB\-glob\fR. See the documentation for \fBstring match\fR
for information on glob style matching, and the documentation for
\fBregexp\fR for information on regexp matching.
If \fIpattern\fR is omitted then the command returns all of
the element names in the array. If there are no (matching) elements
-in the array, or if \fIarrayName\fR isn't the name of an array
+in the array, or if \fIarrayName\fR is not the name of an array
variable, then an empty string is returned.
.TP
\fBarray nextelement \fIarrayName searchId\fR
@@ -105,7 +102,7 @@ and \fIlist\fR is empty,
\fBarray size \fIarrayName\fR
Returns a decimal string giving the number of elements in the
array.
-If \fIarrayName\fR isn't the name of an array then 0 is returned.
+If \fIarrayName\fR is not the name of an array then 0 is returned.
.TP
\fBarray startsearch \fIarrayName\fR
This command initializes an element-by-element search through the
@@ -131,7 +128,7 @@ the buckets.
.TP
\fBarray unset \fIarrayName\fR ?\fIpattern\fR?
Unsets all of the elements in the array that match \fIpattern\fR (using the
-matching rules of \fBstring match\fR). If \fIarrayName\fR isn't the name
+matching rules of \fBstring match\fR). If \fIarrayName\fR is not the name
of an array variable or there are no matching elements in the array, no
error will be raised. If \fIpattern\fR is omitted and \fIarrayName\fR is
an array variable, then the command unsets the entire array.
@@ -139,38 +136,38 @@ The command always returns an empty string.
.SH EXAMPLES
.CS
\fBarray set\fR colorcount {
- red 1
- green 5
- blue 4
- white 9
+ red 1
+ green 5
+ blue 4
+ white 9
}
foreach {color count} [\fBarray get\fR colorcount] {
- puts "Color: $color Count: $count"
+ puts "Color: $color Count: $count"
}
- => Color: blue Count: 4
+ \fB\(->\fR Color: blue Count: 4
Color: white Count: 9
Color: green Count: 5
Color: red Count: 1
foreach color [\fBarray names\fR colorcount] {
- puts "Color: $color Count: $colorcount($color)"
+ puts "Color: $color Count: $colorcount($color)"
}
- => Color: blue Count: 4
+ \fB\(->\fR Color: blue Count: 4
Color: white Count: 9
Color: green Count: 5
Color: red Count: 1
foreach color [lsort [\fBarray names\fR colorcount]] {
- puts "Color: $color Count: $colorcount($color)"
+ puts "Color: $color Count: $colorcount($color)"
}
- => Color: blue Count: 4
+ \fB\(->\fR Color: blue Count: 4
Color: green Count: 5
Color: red Count: 1
Color: white Count: 9
\fBarray statistics\fR colorcount
- => 4 entries in table, 4 buckets
+ \fB\(->\fR 4 entries in table, 4 buckets
number of buckets with 0 entries: 1
number of buckets with 1 entries: 2
number of buckets with 2 entries: 1
@@ -184,9 +181,7 @@ foreach color [lsort [\fBarray names\fR colorcount]] {
number of buckets with 10 or more entries: 0
average search distance for entry: 1.2
.CE
-
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
-
.SH KEYWORDS
array, element names, search
diff --git a/doc/bgerror.n b/doc/bgerror.n
index 88922c0..ea8fe2a 100644
--- a/doc/bgerror.n
+++ b/doc/bgerror.n
@@ -5,10 +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: bgerror.n,v 1.9 2004/11/20 00:17:31 dgp Exp $
-'\"
-.so man.macros
.TH bgerror n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,9 +14,8 @@ bgerror \- Command invoked to process background errors
.SH SYNOPSIS
\fBbgerror \fImessage\fR
.BE
-
.SH DESCRIPTION
-.VS 8.5
+.PP
Release 8.5 of Tcl supports the \fBinterp bgerror\fR command,
which allows applications to register in an interpreter the command
that will handle background errors in that interpreter. In older
@@ -30,15 +27,14 @@ describes the interface requirements of the \fBbgerror\fR command
an application might define to retain compatibility with pre-8.5
releases of Tcl. Applications intending to support only
Tcl releases 8.5 and later should simply make use of \fBinterp bgerror\fR.
-.VE 8.5
.PP
-The \fBbgerror\fR command doesn't exist as built-in part of Tcl. Instead,
+The \fBbgerror\fR command does not exist as built-in part of Tcl. Instead,
individual applications or users can define a \fBbgerror\fR
command (e.g. as a Tcl procedure) if they wish to handle background
errors.
.PP
A background error is one that occurs in an event handler or some
-other command that didn't originate with the application.
+other command that did not originate with the application.
For example, if an error occurs while executing a command specified
with the \fBafter\fR command, then it is a background error.
For a non-background error, the error can simply be returned up
@@ -77,7 +73,9 @@ The reason for this is that the application programmer may also want
to define a \fBbgerror\fR, or use other code that does and thus will
have trouble integrating your code.
.SH "EXAMPLE"
+.PP
This \fBbgerror\fR procedure appends errors to a file, with a timestamp.
+.PP
.CS
proc bgerror {message} {
set timestamp [clock format [clock seconds]]
@@ -86,9 +84,10 @@ proc bgerror {message} {
close $fl
}
.CE
-
.SH "SEE ALSO"
-after(n), interp(n), tclvars(n)
-
+after(n), errorCode(n), errorInfo(n), interp(n)
.SH KEYWORDS
background error, reporting
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/binary.n b/doc/binary.n
index f2b7155..014704d 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -1,32 +1,134 @@
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
+'\" Copyright (c) 2008 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: binary.n,v 1.26 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
binary \- Insert and extract fields from binary strings
.SH SYNOPSIS
+.VS 8.6
+\fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
+.br
+\fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
+.br
+.VE 8.6
\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
.br
\fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command provides facilities for manipulating binary data. The
-first form, \fBbinary format\fR, creates a binary string from normal
+subcommand \fBbinary format\fR creates a binary string from normal
Tcl values. For example, given the values 16 and 22, on a 32-bit
architecture, it might produce an 8-byte binary string consisting of
-two 4-byte integers, one for each of the numbers. The second form of
-the command, \fBbinary scan\fR, does the opposite: it extracts data
+two 4-byte integers, one for each of the numbers. The subcommand
+\fBbinary scan\fR, does the opposite: it extracts data
from a binary string and returns it as ordinary Tcl string values.
+.VS 8.6
+The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
+binary data to or from string encodings such as base64 (used in MIME
+messages for example).
+.VE 8.6
+.PP
+Note that other operations on binary data, such as taking a subsequence of it,
+getting its length, or reinterpreting it as a string in some encoding, are
+done by other Tcl commands (respectively \fBstring range\fR,
+\fBstring length\fR and \fBencoding convertfrom\fR in the example cases). A
+binary string in Tcl is merely one where all the characters it contains are in
+the range \eu0000\-\eu00FF.
+.SH "BINARY ENCODE AND DECODE"
+.VS 8.6
+.PP
+When encoding binary data as a readable string, the starting binary data is
+passed to the \fBbinary encode\fR command, together with the name of the
+encoding to use and any encoding-specific options desired. Data which has been
+encoded can be converted back to binary form using \fBbinary decode\fR. The
+following formats and options are supported.
+.TP
+\fBbase64\fR
+.
+The \fBbase64\fR binary encoding is commonly used in mail messages and XML
+documents, and uses mostly upper and lower case letters and digits. It has the
+distinction of being able to be rewrapped arbitrarily without losing
+information.
+.RS
+.PP
+During encoding, the following options are supported:
+.TP
+\fB\-maxlen \fIlength\fR
+.
+Indicates that the output should be split into lines of no more than
+\fIlength\fR characters. By default, lines are not split.
+.TP
+\fB\-wrapchar \fIcharacter\fR
+.
+Indicates that, when lines are split because of the \fB\-maxlen\fR option,
+\fIcharacter\fR should be used to separate lines. By default, this is a
+newline character,
+.QW \en .
+.PP
+During decoding, the following options are supported:
+.TP
+\fB\-strict\fR
+.
+Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
+.RE
+.TP
+\fBhex\fR
+.
+The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal
+digits in big-endian form.
+.RS
+.PP
+No options are supported during encoding. During decoding, the following
+options are supported:
+.TP
+\fB\-strict\fR
+.
+Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
+.RE
+.TP
+\fBuuencode\fR
+.
+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 superseded by the \fBbase64\fR binary encoding.
+.RS
+.PP
+During encoding, the following options are supported (though changing them may
+produce files that other implementations of decoders cannot process):
+.TP
+\fB\-maxlen \fIlength\fR
+.
+Indicates that the output should be split into lines of no more than
+\fIlength\fR characters. By default, lines are split every 61 characters, and
+this must be in the range 3 to 85 due to limitations in the encoding.
+.TP
+\fB\-wrapchar \fIcharacter\fR
+.
+Indicates that, when lines are split because of the \fB\-maxlen\fR option,
+\fIcharacter\fR should be used to separate lines. By default, this is a
+newline character,
+.QW \en .
+.PP
+During decoding, the following options are supported:
+.TP
+\fB\-strict\fR
+.
+Instructs the decoder to throw an error if it encounters unexpected whitespace
+characters. Otherwise it ignores them.
+.PP
+Note that neither the encoder nor the decoder handle the header and footer of
+the uuencode format.
+.RE
+.VE 8.6
.SH "BINARY FORMAT"
.PP
The \fBbinary format\fR command generates a binary string whose layout
@@ -35,7 +137,8 @@ the additional arguments. The resulting binary value is returned.
.PP
The \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces. Each field specifier is
-a single type character followed by an optional numeric \fIcount\fR.
+a single type character followed by an optional flag character followed
+by an optional numeric \fIcount\fR.
Most field specifiers consume one argument to obtain the value to be
formatted. The type character specifies how the value is to be
formatted. The \fIcount\fR typically indicates how many items of the
@@ -43,7 +146,8 @@ specified type are taken from the value. If present, the \fIcount\fR
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.
+that consume arguments, then an error is generated. The flag character
+is ignored for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
@@ -66,10 +170,11 @@ the following characters:
Stores a byte string of length \fIcount\fR in the output string.
Every character is taken as modulo 256 (i.e. the low byte of every
character is used, and the high byte discarded) so when storing
-character strings not wholly expressible using the characters \\u0000-\\u00ff,
-the \fBencoding convertto\fR command should be used
-first if this truncation is not desired (i.e. if the characters are
-not part of the ISO 8859-1 character set.)
+character strings not wholly expressible using the characters \eu0000-\eu00ff,
+the \fBencoding convertto\fR command should be used first to change
+the string into an external representation
+if this truncation is not desired (i.e. if the characters are
+not part of the ISO 8859\-1 character set.)
If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero
bytes are used to pad out the field. If \fIarg\fR is longer than the
specified length, the extra characters will be ignored. If
@@ -80,12 +185,24 @@ formatted. For example,
.CS
\fBbinary format\fR a7a*a alpha bravo charlie
.CE
-will return a string equivalent to \fBalpha\\000\\000bravoc\fR and
+will return a string equivalent to \fBalpha\e000\e000bravoc\fR,
.CS
-\fBbinary format\fR a* [encoding convertto utf-8 \\u20ac]
+\fBbinary format\fR a* [encoding convertto utf-8 \eu20ac]
.CE
-will return a string equivalent to \fB\\342\\202\\254\fR (which is the
-UTF-8 byte sequence for a Euro-currency character).
+will return a string equivalent to \fB\e342\e202\e254\fR (which is the
+UTF-8 byte sequence for a Euro-currency character) and
+.CS
+\fBbinary format\fR a* [encoding convertto iso8859-15 \eu20ac]
+.CE
+will return a string equivalent to \fB\e244\fR (which is the ISO
+8859\-15 byte sequence for a Euro-currency character). Contrast these
+last two with:
+.CS
+\fBbinary format\fR a* \eu20ac
+.CE
+which returns a string equivalent to \fB\e254\fR (i.e. \fB\exac\fR) by
+truncating the high-bits of the character, and which is probably not
+what is desired.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
@@ -113,7 +230,7 @@ will be zeros. For example,
.CS
\fBbinary format\fR b5b* 11100 111000011010
.CE
-will return a string equivalent to \fB\\x07\\x87\\x05\fR.
+will return a string equivalent to \fB\ex07\ex87\ex05\fR.
.RE
.IP \fBB\fR 5
This form is the same as \fBb\fR except that the bits are stored in
@@ -122,14 +239,15 @@ high-to-low order within each byte. For example,
.CS
\fBbinary format\fR B5B* 11100 111000011010
.CE
-will return a string equivalent to \fB\\xe0\\xe1\\xa0\fR.
+will return a string equivalent to \fB\exe0\exe1\exa0\fR.
.RE
-.IP \fBh\fR 5
-Stores a string of \fIcount\fR hexadecimal digits in low-to-high
+.IP \fBH\fR 5
+Stores a string of \fIcount\fR hexadecimal digits in high-to-low
within each byte in the output string. \fIArg\fR must contain a
-sequence of characters in the set ``0123456789abcdefABCDEF''. The
-resulting bytes are emitted in first to last order with the hex digits
-being formatted in low-to-high order within each byte. If \fIarg\fR
+sequence of characters in the set
+.QW 0123456789abcdefABCDEF .
+The resulting bytes are emitted in first to last order with the hex digits
+being formatted in high-to-low order within each byte. If \fIarg\fR
has fewer than \fIcount\fR digits, then zeros will be used for the
remaining digits. If \fIarg\fR has more than the specified number of
digits, the extra digits will be ignored. If \fIcount\fR is
@@ -139,35 +257,34 @@ number of digits formatted does not end at a byte boundary, the
remaining bits of the last byte will be zeros. For example,
.RS
.CS
-\fBbinary format\fR h3h* AB def
+\fBbinary format\fR H3H*H2 ab DEF 987
.CE
-will return a string equivalent to \fB\\xba\\x00\\xed\\x0f\fR.
+will return a string equivalent to \fB\exab\ex00\exde\exf0\ex98\fR.
.RE
-.IP \fBH\fR 5
-This form is the same as \fBh\fR except that the digits are stored in
-high-to-low order within each byte. For example,
+.IP \fBh\fR 5
+This form is the same as \fBH\fR except that the digits are stored in
+low-to-high order within each byte. This is seldom required. For example,
.RS
.CS
-\fBbinary format\fR H3H* ab DEF
+\fBbinary format\fR h3h*h2 AB def 987
.CE
-will return a string equivalent to \fB\\xab\\x00\\xde\\xf0\fR.
+will return a string equivalent to \fB\exba\ex00\exed\ex0f\ex89\fR.
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string. If no
\fIcount\fR is specified, then \fIarg\fR must consist of an integer
-value; otherwise \fIarg\fR must consist of a list containing at least
-\fIcount\fR integer elements. The low-order 8 bits of each integer
+value. If \fIcount\fR is specified, \fIarg\fR must consist of a list
+containing at least that many integers. The low-order 8 bits of each integer
are stored as a one-byte value at the cursor position. If \fIcount\fR
-is \fB*\fR, then all of the integers in the list are formatted. If
-the number of elements in the list is fewer than \fIcount\fR, then an
-error is generated. If the number of elements in the list is greater
+is \fB*\fR, then all of the integers in the list are formatted. If the
+number of elements in the list is greater
than \fIcount\fR, then the extra elements are ignored. For example,
.RS
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
will return a string equivalent to
-\fB\\x03\\xfd\\x80\\x04\\x02\\x05\fR, whereas
+\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR, whereas
.CS
\fBbinary format\fR c {2 5}
.CE
@@ -184,7 +301,7 @@ example,
\fBbinary format\fR s3 {3 -3 258 1}
.CE
will return a string equivalent to
-\fB\\x03\\x00\\xfd\\xff\\x02\\x01\fR.
+\fB\ex03\ex00\exfd\exff\ex02\ex01\fR.
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
@@ -195,16 +312,14 @@ example,
\fBbinary format\fR S3 {3 -3 258 1}
.CE
will return a string equivalent to
-\fB\\x00\\x03\\xff\\xfd\\x01\\x02\fR.
+\fB\ex00\ex03\exff\exfd\ex01\ex02\fR.
.RE
.IP \fBt\fR 5
-.VS 8.5
This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
except that it stores the 16-bit integers in the output string in the
native byte order of the machine where the Tcl script is running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBi\fR 5
This form is the same as \fBc\fR except that it stores one or more
32-bit integers in little-endian byte order in the output string. The
@@ -216,7 +331,7 @@ example,
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
will return a string equivalent to
-\fB\\x03\\x00\\x00\\x00\\xfd\\xff\\xff\\xff\\x00\\x00\\x01\\x00\fR
+\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
@@ -227,17 +342,15 @@ For example,
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
will return a string equivalent to
-\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR
+\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.RE
.IP \fBn\fR 5
-.VS 8.5
This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
output string in the native byte order of the machine where the Tcl
script is running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBw\fR 5
This form is the same as \fBc\fR except that it stores one or more
64-bit integers in little-endian byte order in the output string. The
@@ -261,14 +374,12 @@ For example,
will return the string \fBBigEndian\fR
.RE
.IP \fBm\fR 5
-.VS 8.5
This form (mnemonically the mirror of \fBw\fR) is the same as \fBw\fR
and \fBW\fR except that it stores the 64-bit integers in the output
string in the native byte order of the machine where the Tcl script is
running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
or more single-precision floating point numbers in the machine's native
@@ -287,21 +398,17 @@ on a Windows system running on an Intel Pentium processor,
\fBbinary format\fR f2 {1.6 3.4}
.CE
will return a string equivalent to
-\fB\\xcd\\xcc\\xcc\\x3f\\x9a\\x99\\x59\\x40\fR.
+\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR.
.RE
.IP \fBr\fR 5
-.VS 8.5
This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
it stores the single-precision floating point numbers in little-endian
order. This conversion only produces meaningful output when used on
machines which use the IEEE floating point representation (very
common, but not universal.)
-.VE 8.5
.IP \fBR\fR 5
-.VS 8.5
This form is the same as \fBr\fR except that it stores the
single-precision floating point numbers in big-endian order.
-.VE 8.5
.IP \fBd\fR 5
This form is the same as \fBf\fR except that it stores one or more one
or more double-precision floating point numbers in the machine's native
@@ -312,21 +419,17 @@ Windows system running on an Intel Pentium processor,
\fBbinary format\fR d1 {1.6}
.CE
will return a string equivalent to
-\fB\\x9a\\x99\\x99\\x99\\x99\\x99\\xf9\\x3f\fR.
+\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR.
.RE
.IP \fBq\fR 5
-.VS 8.5
This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
except that it stores the double-precision floating point numbers in
little-endian order. This conversion only produces meaningful output
when used on machines which use the IEEE floating point representation
(very common, but not universal.)
-.VE 8.5
.IP \fBQ\fR 5
-.VS 8.5
This form is the same as \fBq\fR except that it stores the
double-precision floating point numbers in big-endian order.
-.VE 8.5
.IP \fBx\fR 5
Stores \fIcount\fR null bytes in the output string. If \fIcount\fR is
not specified, stores one null byte. If \fIcount\fR is \fB*\fR,
@@ -336,7 +439,7 @@ example,
.CS
\fBbinary format\fR a3xa3x2a3 abc def ghi
.CE
-will return a string equivalent to \fBabc\\000def\\000\\000ghi\fR.
+will return a string equivalent to \fBabc\e000def\e000\e000ghi\fR.
.RE
.IP \fBX\fR 5
Moves the cursor back \fIcount\fR bytes in the output string. If
@@ -364,13 +467,15 @@ generated. This type does not consume an argument. For example,
.CS
\fBbinary format\fR a5@2a1@*a3@10a1 abcde f ghi j
.CE
-will return \fBabfdeghi\\000\\000j\fR.
+will return \fBabfdeghi\e000\e000j\fR.
.RE
.SH "BINARY SCAN"
.PP
The \fBbinary scan\fR command parses fields from a binary string,
returning the number of conversions performed. \fIString\fR gives the
-input to be parsed and \fIformatString\fR indicates how to parse it.
+input bytes to be parsed (one byte per character, and characters not
+representable as a byte have their high bits chopped)
+and \fIformatString\fR indicates how to parse it.
Each \fIvarName\fR gives the name of a variable; when a field is
scanned from \fIstring\fR the result is assigned to the corresponding
variable.
@@ -378,7 +483,8 @@ variable.
As with \fBbinary format\fR, the \fIformatString\fR consists of a
sequence of zero or more field specifiers separated by zero or more
spaces. Each field specifier is a single type character followed by
-an optional numeric \fIcount\fR. Most field specifiers consume one
+an optional flag character followed by an optional numeric \fIcount\fR.
+Most field specifiers consume one
argument to obtain the variable into which the scanned values should
be placed. The type character specifies how the binary data is to be
interpreted. The \fIcount\fR typically indicates how many items of
@@ -390,7 +496,10 @@ position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set. If there are
not enough arguments for all of the fields in the format string that
-consume arguments, then an error is generated.
+consume arguments, then an error is generated. The flag character
+.QW u
+may be given to cause some types to be read as unsigned values. The flag
+is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
@@ -427,11 +536,13 @@ will be sign extended. Thus the following will occur:
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE
-If you want to produce an unsigned value, then you can mask the return
-value to the desired size. For example, to produce an unsigned short
-value:
+If you require unsigned values you can include the
+.QW u
+flag character following
+the field type. For example, to read an unsigned short value:
.CS
-set val [expr { $val & 0xFFFF }]; \fI# val == 0x8000\fR
+set signShort [\fBbinary format\fR s1 0x8000]
+\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
.CE
.PP
Each type-count pair moves an imaginary cursor through the binary data,
@@ -444,28 +555,37 @@ is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be
scanned into the variable. If \fIcount\fR is omitted, then one
byte will be scanned.
All bytes scanned will be interpreted as being characters in the
-range \\u0000-\\u00ff so the \fBencoding convertfrom\fR command might be
-needed if the string is not an ISO 8859\-1 string.
+range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command will be
+needed if the string is not a binary string or a string encoded in ISO
+8859\-1.
For example,
.RS
.CS
-\fBbinary scan\fR abcde\\000fghi a6a10 var1 var2
+\fBbinary scan\fR abcde\e000fghi a6a10 var1 var2
+.CE
+will return \fB1\fR with the string equivalent to \fBabcde\e000\fR
+stored in \fIvar1\fR and \fIvar2\fR left unmodified, and
+.CS
+\fBbinary scan\fR \e342\e202\e254 a* var1
+set var2 [encoding convertfrom utf-8 $var1]
.CE
-will return \fB1\fR with the string equivalent to \fBabcde\\000\fR
-stored in \fIvar1\fR and \fIvar2\fR left unmodified.
+will store a Euro-currency character in \fIvar2\fR.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from
the scanned value before it is stored in the variable. For example,
.RS
.CS
-\fBbinary scan\fR "abc efghi \\000" A* var1
+\fBbinary scan\fR "abc efghi \e000" A* var1
.CE
will return \fB1\fR with \fBabc efghi\fR stored in \fIvar1\fR.
.RE
.IP \fBb\fR 5
The data is turned into a string of \fIcount\fR binary digits in
-low-to-high order represented as a sequence of ``1'' and ``0''
+low-to-high order represented as a sequence of
+.QW 1
+and
+.QW 0
characters. The data bytes are scanned in first to last order with
the bits being taken in low-to-high order within each byte. Any extra
bits in the last byte are ignored. If \fIcount\fR is \fB*\fR, then
@@ -473,7 +593,7 @@ all of the remaining bits in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one bit will be scanned. For example,
.RS
.CS
-\fBbinary scan\fR \\x07\\x87\\x05 b5b* var1 var2
+\fBbinary scan\fR \ex07\ex87\ex05 b5b* var1 var2
.CE
will return \fB2\fR with \fB11100\fR stored in \fIvar1\fR and
\fB1110000110100000\fR stored in \fIvar2\fR.
@@ -483,36 +603,40 @@ This form is the same as \fBb\fR, except the bits are taken in
high-to-low order within each byte. For example,
.RS
.CS
-\fBbinary scan\fR \\x70\\x87\\x05 B5B* var1 var2
+\fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2
.CE
will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and
\fB1000011100000101\fR stored in \fIvar2\fR.
.RE
-.IP \fBh\fR 5
+.IP \fBH\fR 5
The data is turned into a string of \fIcount\fR hexadecimal digits in
-low-to-high order represented as a sequence of characters in the set
-``0123456789abcdef''. The data bytes are scanned in first to last
-order with the hex digits being taken in low-to-high order within each
-byte. Any extra bits in the last byte are ignored. If \fIcount\fR
-is \fB*\fR, then all of the remaining hex digits in \fIstring\fR will be
-scanned. If \fIcount\fR is omitted, then one hex digit will be
-scanned. For example,
+high-to-low order represented as a sequence of characters in the set
+.QW 0123456789abcdef .
+The data bytes are scanned in first to last
+order with the hex digits being taken in high-to-low order within each
+byte. Any extra bits in the last byte are ignored. If \fIcount\fR is
+\fB*\fR, then all of the remaining hex digits in \fIstring\fR will be
+scanned. If \fIcount\fR is omitted, then one hex digit will be
+scanned. For example,
.RS
.CS
-\fBbinary scan\fR \\x07\\x86\\x05 h3h* var1 var2
+\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
.CE
-will return \fB2\fR with \fB706\fR stored in \fIvar1\fR and
-\fB50\fR stored in \fIvar2\fR.
+will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
+\fB051f34\fR stored in \fIvar2\fR.
.RE
-.IP \fBH\fR 5
-This form is the same as \fBh\fR, except the digits are taken in
-high-to-low order within each byte. For example,
+.IP \fBh\fR 5
+This form is the same as \fBH\fR, except the digits are taken in
+reverse (low-to-high) order within each byte. For example,
.RS
.CS
-\fBbinary scan\fR \\x07\\x86\\x05 H3H* var1 var2
+\fBbinary scan\fR \ex07\ex86\ex05\ex12\ex34 h3h* var1 var2
.CE
-will return \fB2\fR with \fB078\fR stored in \fIvar1\fR and
-\fB05\fR stored in \fIvar2\fR.
+will return \fB2\fR with \fB706\fR stored in \fIvar1\fR and
+\fB502143\fR stored in \fIvar2\fR.
+.PP
+Note that most code that wishes to parse the hexadecimal digits from
+multiple bytes in order should use the \fBH\fR format.
.RE
.IP \fBc\fR 5
The data is turned into \fIcount\fR 8-bit signed integers and stored
@@ -522,7 +646,7 @@ then all of the remaining bytes in \fIstring\fR will be scanned. If
example,
.RS
.CS
-\fBbinary scan\fR \\x07\\x86\\x05 c2c* var1 var2
+\fBbinary scan\fR \ex07\ex86\ex05 c2c* var1 var2
.CE
will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR
stored in \fIvar2\fR. Note that the integers returned are signed, but
@@ -541,9 +665,9 @@ all of the remaining bytes in \fIstring\fR will be scanned. If
example,
.RS
.CS
-\fBbinary scan\fR \\x05\\x00\\x07\\x00\\xf0\\xff s2s* var1 var2
+\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
.CE
-will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB-16\fR
+will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR. Note that the integers returned are signed, but
they can be converted to unsigned 16-bit quantities using an expression
like:
@@ -557,19 +681,17 @@ as \fIcount\fR 16-bit signed integers represented in big-endian byte
order. For example,
.RS
.CS
-\fBbinary scan\fR \\x00\\x05\\x00\\x07\\xff\\xf0 S2S* var1 var2
+\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
-will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB-16\fR
+will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
-.VS 8.5
The data is interpreted as \fIcount\fR 16-bit signed integers
represented in the native byte order of the machine running the Tcl
script. It is otherwise identical to \fBs\fR and \fBS\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBi\fR 5
The data is interpreted as \fIcount\fR 32-bit signed integers
represented in little-endian byte order. The integers are stored in
@@ -579,10 +701,10 @@ all of the remaining bytes in \fIstring\fR will be scanned. If
example,
.RS
.CS
-set str \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff
+set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE
-will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB-16\fR
+will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR. Note that the integers returned are signed, but
they can be converted to unsigned 32-bit quantities using an expression
like:
@@ -596,20 +718,18 @@ as \fIcount\fR 32-bit signed integers represented in big-endian byte
order. For example,
.RS
.CS
-set str \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0
+set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE
-will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB-16\fR
+will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
-.VS 8.5
The data is interpreted as \fIcount\fR 32-bit signed integers
represented in the native byte order of the machine running the Tcl
script. It is otherwise identical to \fBi\fR and \fBI\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBw\fR 5
The data is interpreted as \fIcount\fR 64-bit signed integers
represented in little-endian byte order. The integers are stored in
@@ -619,11 +739,11 @@ all of the remaining bytes in \fIstring\fR will be scanned. If
example,
.RS
.CS
-set str \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff
+set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
-\fB-16\fR stored in \fIvar2\fR. Note that the integers returned are
+\fB\-16\fR stored in \fIvar2\fR. Note that the integers returned are
signed and cannot be represented by Tcl as unsigned values.
.RE
.IP \fBW\fR 5
@@ -632,20 +752,18 @@ as \fIcount\fR 64-bit signed integers represented in big-endian byte
order. For example,
.RS
.CS
-set str \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0
+set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE
-will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB-16\fR
+will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
-.VS 8.5
The data is interpreted as \fIcount\fR 64-bit signed integers
represented in the native byte order of the machine running the Tcl
script. It is otherwise identical to \fBw\fR and \fBW\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
-.VE 8.5
.IP \fBf\fR 5
The data is interpreted as \fIcount\fR single-precision floating point
numbers in the machine's native representation. The floating point
@@ -660,25 +778,21 @@ compiler dependent. For example, on a Windows system running on an
Intel Pentium processor,
.RS
.CS
-\fBbinary scan\fR \\x3f\\xcc\\xcc\\xcd f var1
+\fBbinary scan\fR \ex3f\excc\excc\excd f var1
.CE
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
.RE
.IP \fBr\fR 5
-.VS 8.5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in little-endian
-order. This conversion is not portable to systems not using IEEE
-floating point representations.
-.VE 8.5
+order. This conversion is not portable to the minority of systems not
+using IEEE floating point representations.
.IP \fBR\fR 5
-.VS 8.5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in big-endian
-order. This conversion is not portable to systems not using IEEE
-floating point representations.
-.VE 8.5
+order. This conversion is not portable to the minority of systems not
+using IEEE floating point representations.
.IP \fBd\fR 5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
@@ -686,25 +800,21 @@ machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
.RS
.CS
-\fBbinary scan\fR \\x9a\\x99\\x99\\x99\\x99\\x99\\xf9\\x3f d var1
+\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
.RE
.IP \fBq\fR 5
-.VS 8.5
This form is the same as \fBd\fR except that the data is interpreted
as \fIcount\fR double-precision floating point number in little-endian
-order. This conversion is not portable to systems not using IEEE
-floating point representations.
-.VE 8.5
+order. This conversion is not portable to the minority of systems not
+using IEEE floating point representations.
.IP \fBQ\fR 5
-.VS 8.5
This form is the same as \fBd\fR except that the data is interpreted
as \fIcount\fR double-precision floating point number in big-endian
-order. This conversion is not portable to systems not using IEEE
-floating point representations.
-.VE 8.5
+order. This conversion is not portable to the minority of systems not
+using IEEE floating point representations.
.IP \fBx\fR 5
Moves the cursor forward \fIcount\fR bytes in \fIstring\fR. If
\fIcount\fR is \fB*\fR or is larger than the number of bytes after the
@@ -714,7 +824,7 @@ cursor is moved forward one byte. Note that this type does not
consume an argument. For example,
.RS
.CS
-\fBbinary scan\fR \\x01\\x02\\x03\\x04 x2H* var1
+\fBbinary scan\fR \ex01\ex02\ex03\ex04 x2H* var1
.CE
will return \fB1\fR with \fB0304\fR stored in \fIvar1\fR.
.RE
@@ -727,7 +837,7 @@ is omitted then the cursor is moved back one byte. Note that this
type does not consume an argument. For example,
.RS
.CS
-\fBbinary scan\fR \\x01\\x02\\x03\\x04 c2XH* var1 var2
+\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2XH* var1 var2
.CE
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
@@ -740,12 +850,13 @@ by \fIcount\fR. Note that position 0 refers to the first byte in
\fIcount\fR is omitted, then an error will be generated. For example,
.RS
.CS
-\fBbinary scan\fR \\x01\\x02\\x03\\x04 c2@1H* var1 var2
+\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2@1H* var1 var2
.CE
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
.RE
.SH "PORTABILITY ISSUES"
+.PP
The \fBr\fR, \fBR\fR, \fBq\fR and \fBQ\fR conversions will only work
reliably for transferring data between computers which are all using
IEEE floating point representations. This is very common, but not
@@ -753,8 +864,10 @@ universal. To transfer floating-point numbers portably between all
architectures, use their textual representation (as produced by
\fBformat\fR) instead.
.SH EXAMPLES
+.PP
This is a procedure to write a Tcl string to a binary-encoded channel as
UTF-8 data preceded by a length word:
+.PP
.CS
proc \fIwriteString\fR {channel string} {
set data [encoding convertto utf-8 $string]
@@ -765,6 +878,7 @@ proc \fIwriteString\fR {channel string} {
.PP
This procedure reads a string from a channel that was written by the
previously presented \fIwriteString\fR procedure:
+.PP
.CS
proc \fIreadString\fR {channel} {
if {![\fBbinary scan\fR [read $channel 4] I length]} {
@@ -774,9 +888,21 @@ proc \fIreadString\fR {channel} {
return [encoding convertfrom utf-8 $data]
}
.CE
-
+.PP
+This converts the contents of a file (named in the variable \fIfilename\fR) to
+base64 and prints them:
+.PP
+.CS
+set f [open $filename rb]
+set data [read $f]
+close $f
+puts [\fBbinary encode\fR base64 \-maxlen 64 $data]
+.CE
.SH "SEE ALSO"
-format(n), scan(n), tclvars(n)
-
+encoding(n), format(n), scan(n), string(n), tcl_platform(n)
.SH KEYWORDS
binary, format, scan
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/break.n b/doc/break.n
index 53cae77..3e4ce5f 100644
--- a/doc/break.n
+++ b/doc/break.n
@@ -5,10 +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: break.n,v 1.7 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH break n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,12 +14,11 @@ break \- Abort looping command
.SH SYNOPSIS
\fBbreak\fR
.BE
-
.SH DESCRIPTION
.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
@@ -30,18 +27,21 @@ Break exceptions are also handled in a few other situations, such
as the \fBcatch\fR command, Tk event bindings, and the outermost
scripts of procedure bodies.
.SH EXAMPLE
+.PP
Print a line for each of the integers from 0 to 5:
+.PP
.CS
for {set x 0} {$x<10} {incr x} {
- if {$x > 5} {
- \fBbreak\fR
- }
- puts "x is $x"
+ if {$x > 5} {
+ \fBbreak\fR
+ }
+ puts "x is $x"
}
.CE
-
.SH "SEE ALSO"
catch(n), continue(n), for(n), foreach(n), return(n), while(n)
-
.SH KEYWORDS
abort, break, loop
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/case.n b/doc/case.n
index 63ad7e1..54d5bf4 100644
--- a/doc/case.n
+++ b/doc/case.n
@@ -5,10 +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: 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"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
diff --git a/doc/catch.n b/doc/catch.n
index 4b346cb..94fa5dd 100644
--- a/doc/catch.n
+++ b/doc/catch.n
@@ -6,10 +6,8 @@
'\" 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.13 2004/11/09 10:02:16 dkf Exp $
-'\"
-.so man.macros
.TH catch n "8.5" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,12 +15,11 @@ catch \- Evaluate script and trap exceptional returns
.SH SYNOPSIS
\fBcatch\fI script \fR?\fIresultVarName\fR? ?\fIoptionsVarName\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBcatch\fR command may be used to prevent errors from aborting command
-interpretation. The \fBcatch\fR command calls the Tcl interpreter recursively to
-execute \fIscript\fR, and always returns without raising an error,
+interpretation. The \fBcatch\fR command calls the Tcl interpreter recursively
+to execute \fIscript\fR, and always returns without raising an error,
regardless of any errors that might occur while executing \fIscript\fR.
.PP
If \fIscript\fR raises an error, \fBcatch\fR will return a non-zero integer
@@ -35,64 +32,94 @@ by a return code of \fBTCL_ERROR\fR. The other exceptional return codes are
returned by the \fBreturn\fR, \fBbreak\fR, and \fBcontinue\fR commands
and in other special situations as documented. Tcl packages can define
new commands that return other integer values as return codes as well,
-and scripts that make use of the \fBreturn -code\fR command can also
+and scripts that make use of the \fBreturn \-code\fR command can also
have return codes other than the five defined by Tcl.
.PP
If the \fIresultVarName\fR argument is given, then the variable it names is
-set to the result of the script evaluation. When the return code from
-the script is 1 (\fBTCL_ERROR\fR), the value stored in \fIresultVarName\fR is an error
-message. When the return code from the script is 0 (\fBTCL_OK\fR), the value
-stored in \fIresultVarName\fR is the value returned from \fIscript\fR.
+set to the result of the script evaluation. When the return code from the
+script is 1 (\fBTCL_ERROR\fR), the value stored in \fIresultVarName\fR is an
+error message. When the return code from the script is 0 (\fBTCL_OK\fR), the
+value stored in \fIresultVarName\fR is the value returned from \fIscript\fR.
.PP
-.VS 8.5
If the \fIoptionsVarName\fR argument is given, then the variable it
names is set to a dictionary of return options returned by evaluation
of \fIscript\fR. Tcl specifies two entries that are always
-defined in the dictionary: \fB-code\fR and \fB-level\fR. When
+defined in the dictionary: \fB\-code\fR and \fB\-level\fR. When
the return code from evaluation of \fIscript\fR is not \fBTCL_RETURN\fR,
-the value of the \fB-level\fR entry will be 0, and the value
-of the \fB-code\fR entry will be the same as the return code.
+the value of the \fB\-level\fR entry will be 0, and the value
+of the \fB\-code\fR entry will be the same as the return code.
Only when the return code is \fBTCL_RETURN\fR will the values of
-the \fB-level\fR and \fB-code\fR entries be something else, as
+the \fB\-level\fR and \fB\-code\fR entries be something else, as
further described in the documentation for the \fBreturn\fR command.
.PP
-When the return code from evaluation of \fIscript\fR is \fBTCL_ERROR\fR,
-three additional entries are defined in the dictionary of return options
-stored in \fIoptionsVarName\fR: \fB-errorinfo\fR, \fB-errorcode\fR,
-and \fB-errorline\fR. The value of the \fB-errorinfo\fR entry
-is a formatted stack trace containing more information about
-the context in which the error happened. The formatted stack
-trace is meant to be read by a person. The value of
-the \fB-errorcode\fR entry is additional information about the
-error stored as a list. The \fB-errorcode\fR value is meant to
-be further processed by programs, and may not be particularly
-readable by people. The value of the \fB-errorline\fR entry
-is an integer indicating which line of \fIscript\fR was being
-evaluated when the error occurred. The values of the \fB-errorinfo\fR
-and \fB-errorcode\fR entries of the most recent error are also
-available as values of the global variables \fB::errorInfo\fR
-and \fB::errorCode\fR respectively.
+When the return code from evaluation of \fIscript\fR is
+\fBTCL_ERROR\fR, four additional entries are defined in the dictionary
+of return options stored in \fIoptionsVarName\fR: \fB\-errorinfo\fR,
+\fB\-errorcode\fR, \fB\-errorline\fR, and
+.VS 8.6
+\fB\-errorstack\fR.
+.VE 8.6
+The value of the \fB\-errorinfo\fR entry is a formatted stack trace containing
+more information about the context in which the error happened. The formatted
+stack trace is meant to be read by a person. The value of the
+\fB\-errorcode\fR entry is additional information about the error stored as a
+list. The \fB\-errorcode\fR value is meant to be further processed by
+programs, and may not be particularly readable by people. The value of the
+\fB\-errorline\fR entry is an integer indicating which line of \fIscript\fR
+was being evaluated when the error occurred.
+.VS 8.6
+The value of the \fB\-errorstack\fR entry is an
+even-sized list made of token-parameter pairs accumulated while
+unwinding the stack. The token may be
+.QW \fBCALL\fR ,
+in which case the parameter is a list made of the proc name and arguments at
+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 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]
+it contains the true (substituted) values passed to the functions, instead of
+the static text of the calling sites, and
+.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
+.PP
+The values of the \fB\-errorinfo\fR and \fB\-errorcode\fR entries of
+the most recent error are also available as values of the global
+variables \fB::errorInfo\fR and \fB::errorCode\fR respectively.
+.VS 8.6
+The value of the \fB\-errorstack\fR entry surfaces as \fBinfo errorstack\fR.
+.VE 8.6
.PP
Tcl packages may provide commands that set other entries in the
dictionary of return options, and the \fBreturn\fR command may be
used by scripts to set return options in addition to those defined
above.
-.VE 8.5
.SH EXAMPLES
+.PP
The \fBcatch\fR command may be used in an \fBif\fR to branch based on
the success of a script.
+.PP
.CS
if { [\fBcatch\fR {open $someFile w} fid] } {
- puts stderr "Could not open $someFile for writing\\n$fid"
+ puts stderr "Could not open $someFile for writing\en$fid"
exit 1
}
.CE
.PP
There are more complex examples of \fBcatch\fR usage in the
documentation for the \fBreturn\fR command.
-
.SH "SEE ALSO"
-break(n), continue(n), dict(n), error(n), return(n), tclvars(n)
-
+break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n),
+return(n)
.SH KEYWORDS
-catch, error
+catch, error, exception
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/cd.n b/doc/cd.n
index 7cf138a..67cdd17 100644
--- a/doc/cd.n
+++ b/doc/cd.n
@@ -5,10 +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: cd.n,v 1.6 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH cd n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ cd \- Change working directory
.SH SYNOPSIS
\fBcd \fR?\fIdirName\fR?
.BE
-
.SH DESCRIPTION
.PP
Change the current working directory to \fIdirName\fR, or to the
@@ -27,19 +24,20 @@ Note that the current working directory is a per-process resource; the
\fBcd\fR command changes the working directory for all interpreters
and (in a threaded environment) all threads.
.SH EXAMPLES
+.PP
Change to the home directory of the user \fBfred\fR:
+.PP
.CS
\fBcd\fR ~fred
.CE
.PP
Change to the directory \fBlib\fR that is a sibling directory of the
current one:
+.PP
.CS
\fBcd\fR ../lib
.CE
-
.SH "SEE ALSO"
filename(n), glob(n), pwd(n)
-
.SH KEYWORDS
working directory
diff --git a/doc/chan.n b/doc/chan.n
index 21484f6..12b2c81 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -1,12 +1,10 @@
'\"
-'\" Copyright (c) 2005 Donal K. Fellows
+'\" Copyright (c) 2005-2006 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: chan.n,v 1.2 2005/06/10 15:22:43 dkf Exp $
-.so man.macros
.TH chan n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -14,7 +12,6 @@ chan \- Read, write and manipulate channels
.SH SYNOPSIS
\fBchan \fIoption\fR ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command provides several operations for reading from, writing to
@@ -34,22 +31,35 @@ otherwise. Note that this only ever returns 1 when the channel has
been configured to be non-blocking; all Tcl channels have blocking
turned on by default.
.TP
-\fBchan close \fIchannelId\fR
+\fBchan close \fIchannelId\fR ?\fIdirection\fR?
.
Close and destroy the channel called \fIchannelId\fR. Note that this
deletes all existing file-events registered on the channel.
+.VS 8.6
+If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or
+any unique abbreviation of them) is present, the channel will only be
+half-closed, so that it can go from being read-write to write-only or
+read-only respectively. If a read-only channel is closed for reading, it is
+the same as if the channel is fully closed, and respectively similar for
+write-only channels. Without the \fIdirection\fR argument, the channel is
+closed for both reading and writing (but only if those directions are
+currently open). It is an error to close a read-only channel for writing, or a
+write-only channel for reading.
+.VE 8.6
.RS
.PP
As part of closing the channel, all buffered output is flushed to the
-channel's outpuot device, any buffered input is discarded, the
-underlying operating system resource is closed and \fIchannelId\fR
-becomes unavailable for future use.
-.PP
-If the channel is blocking, 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 command returns
-immediately; output will be flushed in the background and the channel
-will be closed when all the flushing is complete.
+channel's output device (only if the channel is ceasing to be writable), any
+buffered input is discarded (only if the channel is ceasing to be readable),
+the underlying operating system resource is closed and \fIchannelId\fR becomes
+unavailable for future use (both only if the channel is being completely
+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
+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
If \fIchannelId\fR is a blocking channel for a command pipeline then
\fBchan close\fR waits for the child processes to complete.
@@ -59,10 +69,12 @@ makes \fIchannelId\fR unavailable in the invoking interpreter but has
no other effect until all of the sharing interpreters have closed the
channel. When the last interpreter in which the channel is registered
invokes \fBchan close\fR (or \fBclose\fR), the cleanup actions
-described above occur. See the \fBinterp\fR command for a description
-of channel sharing.
+described above occur. With half-closing, the half-close of the channel only
+applies to the current interpreter's view of the channel until all channels
+have closed it in that direction (or completely).
+See the \fBinterp\fR command for a description of channel sharing.
.PP
-Channels are automatically closed when an interpreter is destroyed and
+Channels are automatically fully 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.
.PP
@@ -70,6 +82,13 @@ The command returns an empty string, and may generate an error if
an error occurs while flushing output. If a command in a command
pipeline created with \fBopen\fR returns an error, \fBchan close\fR
generates an error (similar to the \fBexec\fR command.)
+.PP
+.VS 8.6
+Note that half-closes of sockets and command pipelines can have important side
+effects because they result in a shutdown() or close() of the underlying
+system resource, which can change how other processes or systems respond to
+the Tcl program.
+.VE 8.6
.RE
.TP
\fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
@@ -88,20 +107,21 @@ 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
-example, see the manual entry for the \fBsocket\fR command for its
-additional options.
+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.
.TP
\fB\-blocking\fR \fIboolean\fR
.
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).
@@ -174,6 +194,9 @@ returned. The default value for \fB\-eofchar\fR is the empty string
in all cases except for files under Windows. In that case the
\fB\-eofchar\fR is Control-z (\ex1a) for reading and the empty string
for writing.
+The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
+attempting to set \fB\-eofchar\fR to a value outside of this range will
+generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
@@ -185,11 +208,11 @@ of a line may be represented differently on different platforms, or
even for different devices on the same platform. For example, under
UNIX newlines are used in files, whereas carriage-return-linefeed
sequences are normally used in network connections. On input (i.e.,
-with \fBchan gets\fP and \fBchan read\fP) the Tcl I/O system
+with \fBchan gets\fR and \fBchan read\fR) the Tcl I/O system
automatically translates the external end-of-line representation into
-newline characters. Upon output (i.e., with \fBchan puts\fP), the I/O
+newline characters. Upon output (i.e., with \fBchan puts\fR), the I/O
system translates newlines to the external end-of-line representation.
-The default translation mode, \fBauto\fP, handles all the common cases
+The default translation mode, \fBauto\fR, handles all the common cases
automatically, but the \fB\-translation\fR option provides explicit
control over the end of line translations.
.RS
@@ -207,8 +230,8 @@ currently supported:
\fBauto\fR
.
As the input translation mode, \fBauto\fR treats any of newline
-(\fBlf\fP), carriage return (\fBcr\fP), or carriage return followed by
-a newline (\fBcrlf\fP) as the end of line representation. The end of
+(\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by
+a newline (\fBcrlf\fR) as the end of line representation. The end of
line representation can even change from line-to-line, and all cases
are translated to a newline. As the output translation mode,
\fBauto\fR chooses a platform specific representation; for sockets on
@@ -220,7 +243,7 @@ for both input and output.
\fBbinary\fR
.
No end-of-line translations are performed. This is nearly identical
-to \fBlf\fP mode, except that in addition \fBbinary\fP mode also sets
+to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets
the end-of-file character to the empty string (which disables it) and
sets the encoding to \fBbinary\fR (which disables encoding filtering).
See the description of \fB\-eofchar\fR and \fB\-encoding\fR for more
@@ -230,17 +253,17 @@ information.
.
The end of a line in the underlying file or device is represented by a
single carriage return character. As the input translation mode,
-\fBcr\fP mode converts carriage returns to newline characters. As the
-output translation mode, \fBcr\fP mode translates newline characters
+\fBcr\fR mode converts carriage returns to newline characters. As the
+output translation mode, \fBcr\fR mode translates newline characters
to carriage returns.
.TP
\fBcrlf\fR
.
The end of a line in the underlying file or device is represented by a
carriage return character followed by a linefeed character. As the
-input translation mode, \fBcrlf\fP mode converts
+input translation mode, \fBcrlf\fR mode converts
carriage-return-linefeed sequences to newline characters. As the
-output translation mode, \fBcrlf\fP mode translates newline characters
+output translation mode, \fBcrlf\fR mode translates newline characters
to carriage-return-linefeed sequences. This mode is typically used on
Windows platforms and for network connections.
.TP
@@ -263,38 +286,40 @@ buffering too much data in main memory when copying large files to
slow destinations like network sockets.
.RS
.PP
-The \fBchan copy\fP command transfers data from \fIinputChan\fR until
-end of file or \fIsize\fP bytes have been transferred. If no
-\fB\-size\fP argument is given, then the copy goes until end of file.
+The \fBchan copy\fR command transfers data from \fIinputChan\fR until
+end of file or \fIsize\fR bytes have been transferred. If no
+\fB\-size\fR argument is given, then the copy goes until end of file.
All the data read from \fIinputChan\fR is copied to \fIoutputChan\fR.
-Without the \fB\-command\fP option, \fBchan copy\fP blocks until the
+Without the \fB\-command\fR option, \fBchan copy\fR blocks until the
copy is complete and returns the number of bytes written to
\fIoutputChan\fR.
.PP
-The \fB\-command\fP argument makes \fBchan copy\fP work in the
+The \fB\-command\fR argument makes \fBchan copy\fR work in the
background. In this case it returns immediately and the
-\fIcallback\fP is invoked later when the copy completes. The
-\fIcallback\fP is called with one or two additional arguments that
+\fIcallback\fR is invoked later when the copy completes. The
+\fIcallback\fR is called with one or two additional arguments that
indicates how many bytes were written to \fIoutputChan\fR. If an
error occurred during the background copy, the second argument is the
error string associated with the error. With a background copy, it is
not necessary to put \fIinputChan\fR or \fIoutputChan\fR into
-non-blocking mode; the \fBchan copy\fP command takes care of that
+non-blocking mode; the \fBchan copy\fR command takes care of that
automatically. However, it is necessary to enter the event loop by
-using the \fBvwait\fP command or by using Tk.
+using the \fBvwait\fR command or by using Tk.
.PP
You are not allowed to do other I/O operations with \fIinputChan\fR or
\fIoutputChan\fR during a background \fBchan copy\fR. If either
\fIinputChan\fR or \fIoutputChan\fR get closed while the copy is in
progress, the current copy is stopped and the command callback is
-\fInot\fP made. If \fIinputChan\fR is closed, then all data already
+\fInot\fR made. If \fIinputChan\fR is closed, then all data already
queued for \fIoutputChan\fR is written out.
.PP
Note that \fIinputChan\fR can become readable during a background
-copy. You should turn off any \fBchan event\fP or \fBfileevent\fR
+copy. You should turn off any \fBchan event\fR or \fBfileevent\fR
handlers during a background copy so those handlers do not interfere
with the copy. Any I/O attempted by a \fBchan event\fR or
-\fBfileevent\fP handler will get a "channel busy" error.
+\fBfileevent\fR handler will get a
+.QW "channel busy"
+error.
.PP
\fBChan copy\fR translates end-of-line sequences in \fIinputChan\fR
and \fIoutputChan\fR according to the \fB\-translation\fR option for
@@ -302,8 +327,8 @@ these channels (see \fBchan configure\fR above). The translations
mean that the number of bytes read from \fIinputChan\fR can be
different than the number of bytes written to \fIoutputChan\fR. Only
the number of bytes written to \fIoutputChan\fR is reported, either as
-the return value of a synchronous \fBchan copy\fP or as the argument
-to the callback for an asynchronous \fBchan copy\fP.
+the return value of a synchronous \fBchan copy\fR or as the argument
+to the callback for an asynchronous \fBchan copy\fR.
.PP
\fBChan copy\fR obeys the encodings and character translations
configured for the channels. This means that the incoming characters
@@ -320,11 +345,77 @@ to the output encoding. The behaviour of the system for bytes which
are not valid UTF-8 characters is undefined in this case.
.RE
.TP
+\fBchan create \fImode cmdPrefix\fR
+.
+This subcommand creates a new script level channel using the command
+prefix \fIcmdPrefix\fR as its handler. Any such channel is called a
+\fBreflected\fR channel. The specified command prefix, \fBcmdPrefix\fR,
+must be a non-empty list, and should provide the API described in the
+\fBrefchan\fR manual page. The handle of the new channel is
+returned as the result of the \fBchan create\fR command, and the
+channel is open. Use either \fBclose\fR or \fBchan close\fR to remove
+the channel.
+.RS
+.PP
+The argument \fImode\fR specifies if the new channel is opened for
+reading, writing, or both. It has to be a list containing any of the
+strings
+.QW \fBread\fR
+or
+.QW \fBwrite\fR .
+The list must have at least one
+element, as a channel you can neither write to nor read from makes no
+sense. The handler command for the new channel must support the chosen
+mode, or an error is thrown.
+.PP
+The command prefix is executed in the global namespace, at the top of
+call stack, following the appending of arguments as described in the
+\fBrefchan\fR manual page. Command resolution happens at the
+time of the call. Renaming the command, or destroying it means that
+the next call of a handler method may fail, causing the channel
+command invoking the handler to fail as well. Depending on the
+subcommand being invoked, the error message may not be able to explain
+the reason for that failure.
+.PP
+Every channel created with this subcommand knows which interpreter it
+was created in, and only ever executes its handler command in that
+interpreter, even if the channel was shared with and/or was moved into
+a different interpreter. Each reflected channel also knows the thread
+it was created in, and executes its handler command only in that
+thread, even if the channel was moved into a different thread. To this
+end all invocations of the handler are forwarded to the original
+thread by posting special events to it. This means that the original
+thread (i.e. the thread that executed the \fBchan create\fR command)
+must have an active event loop, i.e. it must be able to process such
+events. Otherwise the thread sending them will \fIblock
+indefinitely\fR. Deadlock may occur.
+.PP
+Note that this permits the creation of a channel whose two endpoints
+live in two different threads, providing a stream-oriented bridge
+between these threads. In other words, we can provide a way for
+regular stream communication between threads instead of having to send
+commands.
+.PP
+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 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
+handles.
+.PP
+This subcommand is \fBsafe\fR and made accessible to safe
+interpreters. While it arranges for the execution of arbitrary Tcl
+code the system also makes sure that the code is always executed
+within the safe interpreter.
+.RE
+.TP
\fBchan eof \fIchannelId\fR
.
Test whether the last input operation on the channel called
\fIchannelId\fR failed because the end of the data stream was reached,
-returning 1 if end-fo-file was reached, and 0 otherwise.
+returning 1 if end-of-file was reached, and 0 otherwise.
.TP
\fBchan event \fIchannelId event\fR ?\fIscript\fR?
.
@@ -350,9 +441,11 @@ while waiting for the data to arrive. If an application invokes
\fBchan gets\fR or \fBchan read\fR on a blocking channel when there is
no input data available, the process will block; until the input data
arrives, it will not be able to service other events, so it will
-appear to the user to ``freeze up''. With \fBchan event\fR, the
+appear to the user to
+.QW "freeze up" .
+With \fBchan event\fR, the
process can tell when data is present and only invoke \fBchan gets\fR
-or \fBchan read\fR when they won't block.
+or \fBchan read\fR when they will not block.
.PP
A channel is considered to be readable if there is unread data
available on the underlying device. A channel is also considered to
@@ -360,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
@@ -375,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
@@ -400,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.
@@ -423,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
@@ -433,6 +526,86 @@ Produces a list of all channel names. If \fIpattern\fR is specified,
only those channel names that match it (according to the rules of
\fBstring match\fR) will be returned.
.TP
+\fBchan pending \fImode channelId\fR
+.
+Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR,
+returns the number of
+bytes of input or output (respectively) currently buffered
+internally for \fIchannelId\fR (especially useful in a readable event
+callback to impose application-specific limits on input line lengths to avoid
+a potential denial-of-service attack where a hostile user crafts
+an extremely long line that exceeds the available memory to buffer it).
+Returns -1 if the channel was not opened for the mode in question.
+.TP
+\fBchan pipe\fR
+.VS 8.6
+Creates a standalone pipe whose read- and write-side channels are
+returned as a 2-element list, the first element being the read side and
+the second the write side. Can be useful e.g. to redirect
+separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
+this, spawn with "2>@" or
+">@" redirection operators onto the write side of a pipe, and then
+immediately close it in the parent. This is necessary to get an EOF on
+the read side once the child has exited or otherwise closed its output.
+.VE 8.6
+.TP
+\fBchan pop \fIchannelId\fR
+.VS 8.6
+Removes the topmost transformation from the channel \fIchannelId\fR, if there
+is any. If there are no transformations added to \fIchannelId\fR, this is
+equivalent to \fBchan close\fR of that channel. The result is normally the
+empty string, but can be an error in some situations (i.e. where the
+underlying system stream is closed and that results in an error).
+.VE 8.6
+.TP
+\fBchan postevent \fIchannelId eventSpec\fR
+.
+This subcommand is used by command handlers specified with \fBchan
+create\fR. It notifies the channel represented by the handle
+\fIchannelId\fR that the event(s) listed in the \fIeventSpec\fR have
+occurred. The argument has to be a list containing any of the strings
+\fBread\fR and \fBwrite\fR. The list must contain at least one
+element as it does not make sense to invoke the command if there are
+no events to post.
+.RS
+.PP
+Note that this subcommand can only be used with channel handles that
+were created/opened by \fBchan create\fR. All other channels will
+cause this subcommand to report an error.
+.PP
+As only the Tcl level of a channel, i.e. its command handler, should
+post events to it we also restrict the usage of this command to the
+interpreter that created the channel. In other words, posting events
+to a reflected channel from an interpreter that does not contain it's
+implementation is not allowed. Attempting to post an event from any
+other interpreter will cause this subcommand to report an error.
+.PP
+Another restriction is that it is not possible to post events that the
+I/O core has not registered an interest in. Trying to do so will cause
+the method to throw an error. See the command handler method
+\fBwatch\fR described in \fBrefchan\fR, the document specifying
+the API of command handlers for reflected channels.
+.PP
+This command is \fBsafe\fR and made accessible to safe interpreters.
+It can trigger the execution of \fBchan event\fR handlers, whether in the
+current interpreter or in other interpreters or other threads, even
+where the event is posted from a safe interpreter and listened for by
+a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR
+executed in the interpreter that set them up.
+.RE
+.TP
+\fBchan push \fIchannelId cmdPrefix\fR
+.VS 8.6
+Adds a new transformation on top of the channel \fIchannelId\fR. The
+\fIcmdPrefix\fR argument describes a list of one or more words which represent
+a handler that will be used to implement the transformation. The command
+prefix must provide the API described in the \fBtranschan\fR manual page.
+The result of this subcommand is a handle to the transformation. Note that it
+is important to make sure that the transformation is capable of supporting the
+channel mode that it is used with or this can make the channel neither
+readable nor writable.
+.VE 8.6
+.TP
\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
.
Writes \fIstring\fR to the channel named \fIchannelId\fR followed by a
@@ -457,18 +630,18 @@ 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
-(don't invoke \fBchan puts\fR unless you have recently been notified
+(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).
.RE
.TP
@@ -486,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
@@ -502,21 +675,23 @@ 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.
.CE
+.PP
Then \fBchan read\fR behaves much like described above. Note that
most serial ports are comparatively slow; it is entirely possible to
get a \fBreadable\fR event for each character read from them. Care
must be taken when using \fBchan read\fR on blocking serial ports:
.TP
-\fBchan read \fIchannelId numChars\fR
+\fBchan read \fIchannelId numChars\fR
.
In this form \fBchan read\fR blocks until \fInumChars\fR have been
received from the serial port.
.TP
-\fBchan read \fIchannelId\fR
+\fBchan read \fIchannelId\fR
.
In this form \fBchan read\fR blocks until the reception of the
end-of-file character, see \fBchan configure -eofchar\fR. If there no
@@ -553,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.
@@ -578,11 +753,84 @@ Sets the byte length of the underlying data stream for the channel
named \fIchannelId\fR to be \fIlength\fR (or to the current byte
offset within the underlying data stream if \fIlength\fR is
omitted). The channel is flushed before truncation.
+.
+.SH EXAMPLES
+.PP
+This opens a file using a known encoding (CP1252, a very common encoding
+on Windows), searches for a string, rewrites that part, and truncates the
+file after a further two lines.
+.PP
+.CS
+set f [open somefile.txt r+]
+\fBchan configure\fR $f -encoding cp1252
+set offset 0
+
+\fI# Search for string "FOOBAR" in the file\fR
+while {[\fBchan gets\fR $f line] >= 0} {
+ set idx [string first FOOBAR $line]
+ if {$idx > -1} {
+ \fI# Found it; rewrite line\fR
+
+ \fBchan seek\fR $f [expr {$offset + $idx}]
+ \fBchan puts\fR -nonewline $f BARFOO
+
+ \fI# Skip to end of following line, and truncate\fR
+ \fBchan gets\fR $f
+ \fBchan gets\fR $f
+ \fBchan truncate\fR $f
+ \fI# Stop searching the file now\fR
+ break
+ }
+
+ \fI# Save offset of start of next line for later\fR
+ set offset [\fBchan tell\fR $f]
+}
+\fBchan close\fR $f
+.CE
+.PP
+A network server that does echoing of its input line-by-line without
+preventing servicing of other connections at the same time.
+.PP
+.CS
+# This is a very simple logger...
+proc log {message} {
+ \fBchan puts\fR stdout $message
+}
+
+# This is called whenever a new client connects to the server
+proc connect {chan host port} {
+ set clientName [format <%s:%d> $host $port]
+ log "connection from $clientName"
+ \fBchan configure\fR $chan -blocking 0 -buffering line
+ \fBchan event\fR $chan readable [list echoLine $chan $clientName]
+}
+
+# This is called whenever either at least one byte of input
+# data is available, or the channel was closed by the client.
+proc echoLine {chan clientName} {
+ \fBchan gets\fR $chan line
+ if {[\fBchan eof\fR $chan]} {
+ log "finishing connection from $clientName"
+ \fBchan close\fR $chan
+ } elseif {![\fBchan blocked\fR $chan]} {
+ # Didn't block waiting for end-of-line
+ log "$clientName - $line"
+ \fBchan puts\fR $chan $line
+ }
+}
+
+# Create the server socket and enter the event-loop to wait
+# for incoming connections...
+socket -server connect 12345
+vwait forever
+.CE
.SH "SEE ALSO"
close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n),
fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n),
-socket(n), tell(n)
-
+socket(n), tell(n), refchan(n), transchan(n)
.SH KEYWORDS
channel, input, output, events, offset
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/class.n b/doc/class.n
new file mode 100644
index 0000000..198ae41
--- /dev/null
+++ b/doc/class.n
@@ -0,0 +1,136 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH class n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::class \- class of all classes
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::class\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+ \(-> \fBoo::class\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+Classes are objects that can manufacture other objects according to a pattern
+stored in the factory object (the class). An instance of the class is created
+by calling one of the class's factory methods, typically either \fBcreate\fR
+if an explicit name is being given, or \fBnew\fR if an arbitrary unique name
+is to be automatically selected.
+.PP
+The \fBoo::class\fR class is the class of all classes; every class is an
+instance of this class, which is consequently an instance of itself. This
+class is a subclass of \fBoo::object\fR, so every class is also an object.
+Additional metaclasses (i.e., classes of classes) can be defined if necessary
+by subclassing \fBoo::class\fR. Note that the \fBoo::class\fR object hides the
+\fBnew\fR method on itself, so new classes should always be made using the
+\fBcreate\fR method.
+.SS CONSTRUCTOR
+.PP
+The constructor of the \fBoo::class\fR class takes an optional argument which,
+if present, is sent to the \fBoo::define\fR command (along with the name of
+the newly-created class) to allow the class to be conveniently configured at
+creation time.
+.SS DESTRUCTOR
+The \fBoo::class\fR class does not define an explicit destructor. However,
+when a class is destroyed, all its subclasses and instances are also
+destroyed, along with all objects that it has been mixed into.
+.SS "EXPORTED METHODS"
+.TP
+\fIcls \fBcreate \fIname \fR?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
+resolved within the calling context's namespace if not fully qualified),
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). If the constructor fails (i.e.
+returns a non-OK result) then the object is destroyed and the error message is
+the result of this method call.
+.TP
+\fIcls \fBnew \fR?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR with a new unique name,
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). If the constructor fails (i.e.,
+returns a non-OK result) then the object is destroyed and the error message is
+the result of this method call.
+.RS
+.PP
+Note that this method is not exported by the \fBoo::class\fR object itself, so
+classes should not be created using this method.
+.RE
+.SS "NON-EXPORTED METHODS"
+.PP
+The \fBoo::class\fR class supports the following non-exported methods:
+.TP
+\fIcls \fBcreateWithNamespace\fI name nsName\fR ?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
+resolved within the calling context's namespace if not fully qualified),
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). The name of the instance's
+internal namespace will be \fInsName\fR unless that namespace already exists
+(when an arbitrary name will be chosen instead). If the constructor fails
+(i.e., returns a non-OK result) then the object is destroyed and the error
+message is the result of this method call.
+.SH EXAMPLES
+.PP
+This example defines a simple class hierarchy and creates a new instance of
+it. It then invokes a method of the object before destroying the hierarchy and
+showing that the destruction is transitive.
+.PP
+.CS
+\fBoo::class create\fR fruit {
+ method eat {} {
+ puts "yummy!"
+ }
+}
+\fBoo::class create\fR banana {
+ superclass fruit
+ constructor {} {
+ my variable peeled
+ set peeled 0
+ }
+ method peel {} {
+ my variable peeled
+ set peeled 1
+ puts "skin now off"
+ }
+ method edible? {} {
+ my variable peeled
+ return $peeled
+ }
+ method eat {} {
+ if {![my edible?]} {
+ my peel
+ }
+ next
+ }
+}
+set b [banana \fBnew\fR]
+$b eat \fI\(-> prints "skin now off" and "yummy!"\fR
+fruit destroy
+$b eat \fI\(-> error "unknown command"\fR
+.CE
+.SH "SEE ALSO"
+oo::define(n), oo::object(n)
+.SH KEYWORDS
+class, metaclass, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/clock.n b/doc/clock.n
index 0c913c9..42dca80 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -2,25 +2,25 @@
'\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\"
-.so man.macros
.TH "clock" n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
-.SH "NAME"
+.SH NAME
clock \- Obtain and manipulate dates and times
.SH "SYNOPSIS"
package require \fBTcl 8.5\fR
.sp
-\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI-option value\fR?
+\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
.sp
-\fBclock clicks\fR ?\fI-option\fR?
+\fBclock clicks\fR ?\fI\-option\fR?
.sp
-\fBclock format\fR \fItimeVal\fR ?\fI-option value\fR...?
+\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
.sp
\fBclock microseconds\fR
.sp
\fBclock milliseconds\fR
.sp
-\fBclock scan\fR \fIinputString\fR ?\fI-option value\fR...?
+\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
.sp
\fBclock seconds\fR
.sp
@@ -31,27 +31,29 @@ The \fBclock\fR command performs several operations that obtain and
manipulate values that represent times. The command supports several
subcommands that determine what action is carried out by the command.
.TP
-\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI-option value\fR?
+\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
Adds a (possibly negative) offset to a time that is expressed as an
integer number of seconds. See \fBCLOCK ARITHMETIC\fR for a full description.
.TP
-\fBclock clicks\fR ?\fI-option\fR?
-If no \fI-option\fR argument is supplied, returns a high-resolution
+\fBclock clicks\fR ?\fI\-option\fR?
+If no \fI\-option\fR argument is supplied, returns a high-resolution
time value as a system-dependent integer value. The unit of the value
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.
-.sp
-If the \fI-option\fR argument is \fI-milliseconds\fR, then the command
+.RS
+.PP
+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.
-.sp
-If the \fI-option\fR argument is \fI-microseconds\fR, then the command
+.PP
+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.
+.RE
.TP
-\fBclock format\fR \fItimeVal\fR ?\fI-option value\fR...?
+\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
Formats a time that is expressed as an integer number of seconds into a format
intended for consumption by users or external programs.
See \fBFORMATTING TIMES\fR for a full description.
@@ -62,14 +64,14 @@ Returns the current time as an integer number of microseconds. See \fBHIGH RESO
\fBclock milliseconds\fR
Returns the current time as an integer number of milliseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.TP
-\fBclock scan\fR \fIinputString\fR ?\fI-option value\fR...?
+\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
Scans a time that is expressed as a character string and produces an
integer number of seconds.
See \fBSCANNING TIMES\fR for a full description.
.TP
\fBclock seconds\fR
Returns the current time as an integer number of seconds.
-.SH "PARAMETERS"
+.SS "PARAMETERS"
.TP
\fIcount\fR
An integer representing a count of some unit of time. See
@@ -88,62 +90,67 @@ have 59 or 61 seconds.
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
-any unique prefix of such a word. Used in conjuction with \fIcount\fR
+any unique prefix of such a word. Used in conjunction with \fIcount\fR
to identify an interval of time, for example, \fI3 seconds\fR or
\fI1 year\fR.
-.SH "OPTIONS"
+.SS "OPTIONS"
.TP
-\fB-base\fR time
+\fB\-base\fR time
Specifies that any relative times present in a \fBclock scan\fR command
are to be given relative to \fItime\fR. \fItime\fR must be expressed as
a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC.
.TP
-\fB-format\fR format
+\fB\-format\fR format
Specifies the desired output format for \fBclock format\fR or the
expected input format for \fBclock scan\fR. The \fIformat\fR string consists
-of any number of characters other than the per-cent sign ('\fI%\fR')
+of any number of characters other than the per-cent sign
+.PQ \fB%\fR
interspersed with any number of \fIformat groups\fR, which are two-character
sequences beginning with the per-cent sign. The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.RS
.PP
On \fBclock format\fR, the default format is
+.PP
.CS
%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 "free format scan" is requested; see \fBFREE FORM SCAN\fR for a
-description of what happens.
+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
.TP
-\fB-gmt\fR boolean
+\fB\-gmt\fR boolean
If \fIboolean\fR is true, specifies that a time specified to \fBclock add\fR,
\fBclock format\fR or \fBclock scan\fR should be processed in
UTC. If \fIboolean\fR is false, the processing defaults to the local time
zone. This usage is obsolete; the correct current usage is to
-specify the UTC time zone with '\fB-timezone\fR \fI:UTC\fR' or any of
-the equivalent ways to specify it.
+specify the UTC time zone with
+.QW "\fB\-timezone\fR \fI:UTC\fR"
+or any of the equivalent ways to specify it.
.TP
-\fB-locale\fR localeName
+\fB\-locale\fR localeName
Specifies that locale-dependent scanning and formatting (and date arithmetic
for dates preceding the adoption of the Gregorian calendar) is to be done in
the locale identified by \fIlocaleName\fR. The locale name may be any of
the locales acceptable to the \fBmsgcat\fR package, or it may be the special
name \fIsystem\fR, which represents the current locale of the process, or
the null string, which represents Tcl's default locale.
-.sp
+.RS
+.PP
The effect of locale on scanning and formatting is discussed in the
descriptions of the individual format groups under \fBFORMAT GROUPS\fR.
The effect of locale on clock arithmetic is discussed under
\fBCLOCK ARITHMETIC\fR.
+.RE
.TP
-\fB-timezone\fR zoneName
+\fB\-timezone\fR zoneName
Specifies that clock arithmetic, formatting, and scanning are to be done
according to the rules for the time zone specified by \fIzoneName\fR.
The permissible values, and their interpretation, are discussed under
\fBTIME ZONES\fR.
-On subcommands that expect a \fB-timezone\fR argument, the default
+On subcommands that expect a \fB\-timezone\fR argument, the default
is to use the \fIcurrent time zone\fR. The current time zone is
determined, in order of preference, by:
.RS
@@ -154,16 +161,18 @@ the environment variable \fBTZ\fR.
.IP [3]
on Windows systems, the time zone settings from the Control Panel.
.RE
+.PP
If none of these is present, the C \fBlocaltime\fR and \fBmktime\fR
functions are used to attempt to convert times between local and
Greenwich. On 32-bit systems, this approach is likely to have bugs,
particularly for times that lie outside the window (approximately the
years 1902 to 2037) that can be represented in a 32-bit integer.
.SH "CLOCK ARITHMETIC"
+.PP
The \fBclock add\fR command performs clock arithmetic on a value
(expressed as nominal seconds from the epoch time of 1 January 1970, 00:00 UTC)
given as its first argument. The remaining arguments (other than the
-possible \fB-timezone\fR, \fB-locale\fR and \fB-gmt\fR options)
+possible \fB\-timezone\fR, \fB\-locale\fR and \fB\-gmt\fR options)
are integers and keywords in alternation, where the keywords are chosen
from \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
@@ -189,11 +198,13 @@ absolute time means that it will add fixed amounts of time in time zones
that observe summer time (Daylight Saving Time). For example,
the following code sets the value of \fBx\fR to \fB04:00:00\fR because
the clock has changed in the interval in question.
+.PP
.CS
-set s [\fBclock scan\fR {2004-10-30 05:00:00} \\
- -format {%Y-%m-%d %H:%M:%S} -timezone :America/New_York]
+set s [\fBclock scan\fR {2004-10-30 05:00:00} \e
+ -format {%Y-%m-%d %H:%M:%S} \e
+ -timezone :America/New_York]
set a [\fBclock add\fR $s 24 hours -timezone :America/New_York]
-set x [\fBclock format\fR $a \\
+set x [\fBclock format\fR $a \e
-format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
@@ -208,11 +219,13 @@ Adding and subtracting a given number of days across the point that
the time changes at the start or end of summer time (Daylight Saving Time)
results in the \fIsame local time\fR on the day in question. For
instance, the following code sets the value of \fBx\fR to \fB05:00:00\fR.
+.PP
.CS
-set s [\fBclock scan\fR {2004-10-30 05:00:00} \\
- -format {%Y-%m-%d %H:%M:%S} -timezone :America/New_York]
+set s [\fBclock scan\fR {2004-10-30 05:00:00} \e
+ -format {%Y-%m-%d %H:%M:%S} \e
+ -timezone :America/New_York]
set a [\fBclock add\fR $s 1 day -timezone :America/New_York]
-set x [\fBclock format\fR $a \\
+set x [\fBclock format\fR $a \e
-format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
@@ -222,17 +235,20 @@ yields an impossible time (for instance, 02:30 during the Spring
Daylight Saving Time change using US rules), the time is converted
as if the clock had not changed. Thus, the following code
will set the value of \fBx\fR to \fB03:30:00\fR.
+.PP
.CS
-set s [\fBclock scan\fR {2004-04-03 02:30:00} \\
- -format {%Y-%m-%d %H:%M:%S} -timezone :America/New_York]
+set s [\fBclock scan\fR {2004-04-03 02:30:00} \e
+ -format {%Y-%m-%d %H:%M:%S} \e
+ -timezone :America/New_York]
set a [\fBclock add\fR $s 1 day -timezone :America/New_York]
-set x [\fBclock format\fR $a \\
+set x [\fBclock format\fR $a \e
-format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
Adding a given number of days or weeks works correctly across the conversion
between the Julian and Gregorian calendars; the omitted days are skipped.
The following code sets \fBz\fR to \fB1752-09-14\fR.
+.PP
.CS
set x [\fBclock scan\fR 1752-09-02 -format %Y-%m-%d -locale en_US]
set y [\fBclock add\fR $x 1 day -locale en_US]
@@ -261,13 +277,14 @@ years as they are when adding/subtracting days and weeks.
If multiple \fIcount unit\fR pairs are present on the command, they
are evaluated consecutively, from left to right.
.SH "HIGH RESOLUTION TIMERS"
+.PP
Most of the subcommands supported by the \fBclock\fR command deal with
times represented as a count of seconds from the epoch time, and this is the
representation that \fBclock seconds\fR returns. There are three exceptions,
which are all intended for use where higher-resolution times are required.
\fBclock milliseconds\fR returns the count of milliseconds from the
epoch time, and \fBclock microseconds\fR returns the count of microseconds
-from the epoch time. In addition, there js a \fBclock clicks\fR command
+from the epoch time. In addition, there is a \fBclock clicks\fR command
that returns a platform-dependent high-resolution timer. Unlike
\fBclock seconds\fR and \fBclock milliseconds\fR, the value
of \fBclock clicks\fR is not guaranteed to be tied to any fixed
@@ -275,76 +292,83 @@ epoch; it is simply intended to be the most precise interval timer
available, and is intended only for relative timing studies such as
benchmarks.
.SH "FORMATTING TIMES"
+.PP
The \fBclock format\fR command produces times for display to a user
or writing to an external medium. The command accepts times that are
expressed in seconds from the epoch time of 1 January 1970, 00:00 UTC,
as returned by \fBclock seconds\fR, \fBclock scan\fR, \fBclock add\fR,
\fBfile atime\fR or \fBfile mtime\fR.
.PP
-If a \fB-format\fR option is present, the following argument is
+If a \fB\-format\fR option is present, the following argument is
a string that specifies how the date and time are to be formatted.
The string consists
-of any number of characters other than the per-cent sign ('\fI%\fR')
+of any number of characters other than the per-cent sign
+.PQ \fB%\fR
interspersed with any number of \fIformat groups\fR, which are two-character
sequences beginning with the per-cent sign. The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.PP
-If a \fB-timezone\fR option is present, the following
+If a \fB\-timezone\fR option is present, the following
argument is a string that specifies the time zone in which the date and time
-are to be formatted. As an alternative to \fB-timezone\fR \fI:UTC\fR,
-the obsolete usage \fB-gmt\fR \fItrue\fR may be used. See
+are to be formatted. As an alternative to
+.QW "\fB\-timezone\fR \fI:UTC\fR" ,
+the obsolete usage
+.QW "\fB\-gmt\fR \fItrue\fR"
+may be used. See
\fBTIME ZONES\fR for the permissible variants for the time zone.
.PP
-If a \fB-locale\fR option is present, the following argument is
+If a \fB\-locale\fR option is present, the following argument is
a string that specifies the locale in which the time is to be formatted,
in the same format that is used for the \fBmsgcat\fR package. Note
-that the default, if \fB-locale\fR is not specified, is the root locale
+that the default, if \fB\-locale\fR is not specified, is the root locale
\fB{}\fR rather than the current locale. The current locale may
-be obtained by using \fB-locale\fR \fBcurrent\fR.
+be obtained by using \fB\-locale\fR \fBcurrent\fR.
In addition, some platforms support a \fBsystem\fR locale that
reflects the user's current choices. For instance, on Windows, the
format that the user has selected from dates and times in the Control
Panel can be obtained by using the \fBsystem\fR locale. On
platforms that do not define a user selection of date and time formats
-separate from \fBLC_TIME\fR, \fB-locale\fR \fBsystem\fR is
-synonymous with \fB-locale\fR \fBcurrent\fR.
+separate from \fBLC_TIME\fR, \fB\-locale\fR \fBsystem\fR is
+synonymous with \fB\-locale\fR \fBcurrent\fR.
.SH "SCANNING TIMES"
+.PP
The \fBclock scan\fR command accepts times that are formatted as
strings and converts them to counts of seconds from the epoch time
-of 1 January 1970, 00:00 UTC. It normally takes a \fB-format\fR
+of 1 January 1970, 00:00 UTC. It normally takes a \fB\-format\fR
option that is followed by a string describing
the expected format of the input. (See
\fBFREE FORM SCAN\fR for the effect of \fBclock scan\fR
without such an argument.) The string consists of any number of
-characters other than the per-cent sign ('\fI%\fR'),
+characters other than the per-cent sign
+.PQ \fB%\fR "" ,
interspersed with any number of \fIformat groups\fR, which are two-character
sequences beginning with the per-cent sign. The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.PP
-If a \fB-timezone\fR option is present, the following
+If a \fB\-timezone\fR option is present, the following
argument is a string that specifies the time zone in which the date and time
-are to be interpreted. As an alternative to \fB-timezone\fR \fI:UTC\fR,
-the obsolete usage \fB-gmt\fR \fItrue\fR may be used. See
+are to be interpreted. As an alternative to \fB\-timezone\fR \fI:UTC\fR,
+the obsolete usage \fB\-gmt\fR \fItrue\fR may be used. See
\fBTIME ZONES\fR for the permissible variants for the time zone.
.PP
-If a \fB-locale\fR option is present, the following argument is
+If a \fB\-locale\fR option is present, the following argument is
a string that specifies the locale in which the time is to be interpreted,
in the same format that is used for the \fBmsgcat\fR package. Note
-that the default, if \fB-locale\fR is not specified, is the root locale
+that the default, if \fB\-locale\fR is not specified, is the root locale
\fB{}\fR rather than the current locale. The current locale may
-be obtained by using \fB-locale\fR \fBcurrent\fR.
+be obtained by using \fB\-locale\fR \fBcurrent\fR.
In addition, some platforms support a \fBsystem\fR locale that
reflects the user's current choices. For instance, on Windows, the
format that the user has selected from dates and times in the Control
Panel can be obtained by using the \fBsystem\fR locale. On
platforms that do not define a user selection of date and time formats
-separate from \fBLC_TIME\fR, \fB-locale\fR \fBsystem\fR is
-synonymous with \fB-locale\fR \fBcurrent\fR.
+separate from \fBLC_TIME\fR, \fB\-locale\fR \fBsystem\fR is
+synonymous with \fB\-locale\fR \fBcurrent\fR.
.PP
-If a \fB-base\fR option is present, the following argument is
+If a \fB\-base\fR option is present, the following argument is
a time (expressed in seconds from the epoch time) that is used as
a \fIbase time\fR for interpreting relative times. If no
-\fB-base\fR option is present, the base time is the current time.
+\fB\-base\fR option is present, the base time is the current time.
.PP
Scanning of times in fixed format works by determining three things:
the date, the time of day, and the time zone. These three are then
@@ -383,8 +407,9 @@ combined and used to determine the date. If more than one complete
set is present, the one at the rightmost position in the string is
used. The year is presumed to lie in the range 1938 to 2037 inclusive.
.IP [5]
-If the string entirely lacks any specification for the year,
-but contains a set of format groups specifying month and day of month,
+If the string entirely lacks any specification for the year
+(or contains the year only on the locale's alternative calendar)
+and contains a set of format groups specifying month and day of month,
day of year, or week of year and day of week, those groups are
combined and used to determine the date. If more than one complete
set is present, the one at the rightmost position in the string is
@@ -418,7 +443,7 @@ combines with the hour and minute.
If the string contains neither a \fB%s\fR format group nor
a group specifying the hour of the day, then midnight (\fB00:00\fR, the start
of the given date) is used.
-The time zone is determined by either the \fB-timezone\fR or \fB-gmt\fR
+The time zone is determined by either the \fB\-timezone\fR or \fB\-gmt\fR
options, or by using the current time zone.
.PP
If a format string lacks a \fB%z\fR or \fB%Z\fR format group,
@@ -429,6 +454,7 @@ If this situation occurs, the first occurrence of the time is chosen.
time zone when converting local times. This caveat does not apply to
UTC times.)
.SH "FORMAT GROUPS"
+.PP
The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
@@ -459,7 +485,7 @@ any unique prefix of either form).
\fB%c\fR
On output, receives a localized representation of date and time of day;
the localized representation is expected to use the Gregorian calendar.
-On input, matches whatever %c produces.
+On input, matches whatever \fB%c\fR produces.
.TP
\fB%C\fR
On output, receives the number of the century in Indo-Arabic numerals.
@@ -485,7 +511,7 @@ whitespace, that are expected to be the number of the day of the month.
\fB%Ec\fR
On output, produces a locale-dependent representation of the date and
time of day in the locale's alternative calendar. On input, matches
-whatever %Ec produces. The locale's alternative calendar need not
+whatever \fB%Ec\fR produces. The locale's alternative calendar need not
be the Gregorian calendar.
.TP
\fB%EC\fR
@@ -493,16 +519,25 @@ On output, produces a locale-dependent name of an era in the locale's
alternative calendar. On input, matches the name of the era or any
unique prefix.
.TP
+\fB%EE\fR
+On output, produces the string \fBB.C.E.\fR or \fBC.E.\fR, or a
+string of the same meaning in the locale, to indicate whether \fB%Y\fR refers
+to years before or after Year 1 of the Common Era. On input, accepts
+the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the
+abbreviation appropriate to the current locale, and uses it to fix
+whether \fB%Y\fR refers to years before or after Year 1 of the
+Common Era.
+.TP
\fB%Ex\fR
On output, produces a locale-dependent representation of the date
in the locale's alternative calendar. On input, matches
-whatever %Ex produces. The locale's alternative calendar need not
+whatever \fB%Ex\fR produces. The locale's alternative calendar need not
be the Gregorian calendar.
.TP
\fB%EX\fR
On output, produces a locale-dependent representation of the
time of day in the locale's alternative numerals. On input, matches
-whatever %EX produces.
+whatever \fB%EX\fR produces.
.TP
\fB%Ey\fR
On output, produces a locale-dependent number of the year of the era
@@ -568,27 +603,30 @@ with exactly two digits. On input, accepts two digits and interprets them
as the number of the minute of the hour.
.TP
\fB%N\fR
-On output, produces the number of the month (1-12) with one or two digits.
-digits. On input, accepts one or two digits, possibly with leading whitespace,
+On output, produces the number of the month (1-12) with one or two digits,
+and a leading blank for one-digit dates.
+On input, accepts one or two digits, possibly with leading whitespace,
and interprets them as the number of the month.
.TP
\fB%Od\fR, \fB%Oe\fR, \fB%OH\fR, \fB%OI\fR, \fB%Ok\fR, \fB%Ol\fR, \fB%Om\fR, \fB%OM\fR, \fB%OS\fR, \fB%Ou\fR, \fB%Ow\fR, \fB%Oy\fR
All of these format groups are synonymous with their counterparts
-without the '\fBO\fR', except that the string is produced and parsed in the
+without the
+.QW \fBO\fR ,
+except that the string is produced and parsed in the
locale-dependent alternative numerals.
.TP
\fB%p\fR
-On output, produces an indicator for the part of the day, \fBA.M.\fR
-or \fBP.M.\fR, appropriate to the given locale. If the script of the
-given locale supports multiple letterforms, uppercase is preferred.
-On input, matches the representation \fBA.M.\fR or \fBP.M.\fR in
+On output, produces an indicator for the part of the day, \fBAM\fR
+or \fBPM\fR, appropriate to the given locale. If the script of the
+given locale supports multiple letterforms, lowercase is preferred.
+On input, matches the representation \fBAM\fR or \fBPM\fR in
the given locale, in either case.
.TP
\fB%P\fR
-On output, produces an indicator for the part of the day, \fBA.M.\fR
-or \fBP.M.\fR, appropriate to the given locale. If the script of the
-given locale supports multiple letterforms, lowercase is preferred.
-On input, matches the representation \fBA.M.\fR or \fBP.M.\fR in
+On output, produces an indicator for the part of the day, \fBam\fR
+or \fBpm\fR, appropriate to the given locale. If the script of the
+given locale supports multiple letterforms, uppercase is preferred.
+On input, matches the representation \fBAM\fR or \fBPM\fR in
the given locale, in either case.
.TP
\fB%Q\fR
@@ -622,7 +660,7 @@ Synonymous with \fB%H:%M:%S\fR.
.TP
\fB%u\fR
On output, produces the number of the day of the week
-(\fB1\fR-Monday, \fB7\fR-Sunday). On input, accepts a single digit and
+(\fB1\fR\(->Monday, \fB7\fR\(->Sunday). On input, accepts a single digit and
interprets it as the day of the week. Sunday may be either \fB0\fR or
\fB7\fR.
.TP
@@ -643,6 +681,13 @@ equivalent). Each week begins on a Monday. On input, accepts the
ISO8601 week number.
.TP
\fB%w\fR
+On output, produces the ordinal number of the day of the week
+(Sunday==0; Saturday==6). On input, accepts a single digit and
+interprets it as the day of the week; Sunday may be represented as
+either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number,
+which is produced and accepted by \fB%u\fR.
+.TP
+\fB%W\fR
On output, produces a week number (00-53) within the year; week 01
begins on the first Monday of the year. On input, accepts two digits,
which are otherwise ignored. This format group is never used in
@@ -674,7 +719,7 @@ week number \fB%V\fR; programs should use \fB%G\fR for that purpose.
.TP
\fB%z\fR
On output, produces the current time zone, expressed in hours and
-minutes east (+hhmm) or west (-hhmm) of Greenwich. On input, accepts a
+minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a
time zone specifier (see \fBTIME ZONES\fR below) that will be used to
determine the time zone.
.TP
@@ -689,12 +734,17 @@ Brazilian Standard Time. It is recommended that date/time strings for
use by computers use numeric time zones instead.
.TP
\fB%%\fR
-On output, produces a literal '\fB%\fR' charater. On input, matches
-a literal '\fB%\fR' character.
+On output, produces a literal
+.QW \fB%\fR
+character. On input, matches a literal
+.QW \fB%\fR
+character.
.TP
\fB%+\fR
-Synonymous with '\fB%a %b %e %H:%M:%S %Z %Y\fR'.
+Synonymous with
+.QW "\fB%a %b %e %H:%M:%S %Z %Y\fR" .
.SH "TIME ZONES"
+.PP
When the \fBclock\fR command is processing a local time, it has several
possible sources for the time zone to use. In order of preference, they
are:
@@ -702,8 +752,8 @@ are:
A time zone specified inside a string being parsed and matched by a \fB%z\fR
or \fB%Z\fR format group.
.IP [2]
-A time zone specified with the \fB-timezone\fR option to the \fBclock\fR
-command (or, equivalently, by \fB-gmt\fR \fB1\fR).
+A time zone specified with the \fB\-timezone\fR option to the \fBclock\fR
+command (or, equivalently, by \fB\-gmt\fR \fB1\fR).
.IP [3]
A time zone specified in an environment variable \fBTCL_TZ\fR.
.IP [4]
@@ -714,10 +764,9 @@ The local time zone from the Control Panel on Windows systems.
The C library's idea of the local time zone, as defined by the
\fBmktime\fR and \fBlocaltime\fR functions.
.PP
-Whatever the source of the time zone string, the same set of rules
-is used to parse it. First, if it was obtained from a \fB%z\fR
-or \fB%Z\fR format group, it is checked to see if it is one of
-the strings,
+In case [1] \fIonly,\fR the string is tested to see if it is one
+of the strings:
+.PP
.CS
gmt ut utc bst wet wat at
nft nst ndt ast adt est edt
@@ -729,52 +778,78 @@ the strings,
cadt east eadt gst nzt nzst nzdt
idle
.CE
+.PP
If it is a string in the above list, it designates a known
time zone, and is interpreted as such.
.PP
-The next check is for a string beginning with a colon.
+For time zones in case [1] that do not match any of the above strings,
+and always for cases [2]-[6], the following rules apply.
+.PP
If the time zone begins with a colon, it is one of a
standardized list of names like \fB:America/New_York\fR
that give the rules for various locales. A complete list
of the location names is too lengthy to be listed here.
On most Tcl installations, the definitions of the locations
are to be found in named files in the directory
- "\fI/no_backup/tools/lib/tcl8.5/clock/tzdata\fR". On some Unix systems, these
-files are omitted, and the definitions are instead
-obtained from system files in "\fI/usr/share/zoneinfo\fR",
- "\fI/usr/share/lib/zoneinfo\fR" or "\fI/usr/local/etc/zoneinfo\fR".
+.QW "\fI/no_backup/tools/lib/tcl8.5/clock/tzdata\fR" .
+On some Unix systems, these files are omitted, and the definitions are
+instead obtained from system files in
+.QW "\fI/usr/share/zoneinfo\fR" ,
+.QW "\fI/usr/share/lib/zoneinfo\fR"
+or
+.QW "\fI/usr/local/etc/zoneinfo\fR" .
As a special case, the name \fB:localtime\fR refers to
the local time zone as defined by the C library.
.PP
-A string consisting of a plus or minus sign followed by
+A time zone string consisting of a plus or minus sign followed by
four or six decimal digits is interpreted as an offset in
hours, minutes, and seconds (if six digits are present) from
UTC. The plus sign denotes a sign east of Greenwich;
the minus sign one west of Greenwich.
.PP
-A string conforming to the Posix specification of the \fBTZ\fR
+A time zone string conforming to the Posix specification of the \fBTZ\fR
environment variable will be recognized. The specification
may be found at
\fIhttp://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html\fR.
.PP
-Any other string is processed by prefixing a colon and attempting
+If the Posix time zone string contains a DST (Daylight Savings Time)
+part, but doesn't contain a rule stating when DST starts or ends,
+then default rules are used. For Timezones with an offset between 0
+and +12, the current European/Russian rules are used, otherwise the
+current US rules are used. In Europe (offset +0 to +2) the switch
+to summertime is done each last Sunday in March at 1:00 GMT, and
+the switch back is each last Sunday in October at 2:00 GMT. In
+Russia (offset +3 to +12), the switch dates are the same, only
+the switch to summertime is at 2:00 local time, and the switch
+back is at 3:00 local time in all time zones. The US switch to
+summertime takes place each second Sunday in March at 2:00 local
+time, and the switch back is each first Sunday in November at
+3:00 local time. These default rules mean that in all European,
+Russian and US (or compatible) time zones, DST calculations will
+be correct for dates in 2007 and later, unless in the future the
+rules change again.
+.PP
+Any other time zone string is processed by prefixing a colon and attempting
to use it as a location name, as above.
.SH "LOCALIZATION"
+.PP
Developers wishing to localize the date and time formatting and parsing
are referred to \fIhttp://tip.tcl.tk/173\fR for a
specification.
.SH "FREE FORM SCAN"
-If the \fBclock scan\fR command is invoked without a \fB-format\fR
+.PP
+If the \fBclock scan\fR command is invoked without a \fB\-format\fR
option, then it requests a \fIfree-form scan.\fR \fI
This form of scan is deprecated.\fR The reason for the deprecation
-is that there are too many ambiguities. (Does the string '2000'
+is that there are too many ambiguities. (Does the string
+.QW 2000
represent a year, a time of day, or a quantity?) No set of rules
for interpreting free-form dates and times has been found to
give unsurprising results in all cases.
.PP
-If free-form scan is used, only the \fB-base\fR and \fB-gmt\fR
-options are accepted. The \fB-timezone\fR and \fB-locale\fR
-options will result in an error if \fB-format\fR is not supplied.
+If free-form scan is used, only the \fB\-base\fR and \fB\-gmt\fR
+options are accepted. The \fB\-timezone\fR and \fB\-locale\fR
+options will result in an error if \fB\-format\fR is not supplied.
.PP
For the benefit of users who need to understand legacy code that
uses free-form scan, the documentation for how free-form scan
@@ -783,13 +858,13 @@ interprets a string is included here:
If only a time is
specified, the current date is assumed. If the \fIinputString\fR
does not contain a
-time zone mnemonic, the local time zone is assumed, unless the \fB-gmt\fR
+time zone mnemonic, the local time zone is assumed, unless the \fB\-gmt\fR
argument is true, in which case the clock value is calculated assuming
that the specified time is relative to Greenwich Mean Time.
-\fB-gmt\fR, if specified, affects only the computed time value; it does not
-impact the interpretation of \fB-base\fR.
+\fB\-gmt\fR, if specified, affects only the computed time value; it does not
+impact the interpretation of \fB\-base\fR.
.PP
-If the \fB-base\fR flag is specified, the next argument should contain
+If the \fB\-base\fR flag is specified, the next argument should contain
an integer clock value. Only the date in this value is used, not the
time. This is useful for determining the time on a specific day or
doing other date-relative conversions.
@@ -805,24 +880,31 @@ a 24-hour clock.
.TP
\fIdate\fR
A specific month and day with optional year. The
-acceptable formats are "\fBmm/dd\fR?\fB/yy\fR?",
- "\fBmonthname dd\fR?\fB, yy\fR?",
- "\fBday, dd monthname \fR?\fByy\fR?",
- "\fBdd monthname yy\fR",
- "?\fBCC\fR?\fByymmdd\fR", and
- "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR".
+acceptable formats are
+.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
+.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
+.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
+.QW "\fBdd monthname yy\fR" ,
+.QW "?\fBCC\fR?\fByymmdd\fR" ,
+and
+.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
The default year is the current year. If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999. Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
-An ISO 8601 point-in-time specification, such as \fBCCyymmddThhmmss\fR,
-where \fBT\fR is the literal T, "\fBCCyymmdd hhmmss\fR", or
-\fBCCyymmddThh:mm:ss\fR. Note that only these three formats are accepted.
+An ISO 8601 point-in-time specification, such as
+.QW \fICCyymmdd\fBT\fIhhmmss\fR,
+where \fBT\fR is the literal
+.QW T ,
+.QW "\fICCyymmdd hhmmss\fR" ,
+or
+.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
+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
@@ -833,6 +915,7 @@ unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
\fBlast\fR, \fBthis\fR, \fBnext\fR, \fBago\fR.
+.PP
The actual date is calculated according to the following steps.
.PP
First, any absolute date and/or time is processed and converted.
@@ -843,19 +926,12 @@ used. Finally, a correction is applied so that the correct hour of
the day is produced after allowing for daylight savings time
differences and the correct date is given when going from the end
of a long month to a short month.
-.PP
-Daylight savings time correction is applied only when the relative time
-is specified in units of days or more, i.e.\ days, weeks, fortnights, months or
-years. This means that when crossing the daylight savings time boundary,
-different results will be given for \fBclock scan "1 day"\fR and
-\fBclock scan "24 hours"\fR:
-.CS
-% \fBclock scan\fR "1 day" -base [\fBclock scan\fR 1999-10-31]
-941443200
-% \fBclock scan\fR "24 hours" -base [\fBclock scan\fR 1999-10-31]
-941439600
-.CE
.SH "SEE ALSO"
-msgcat
+msgcat(n)
+.SH KEYWORDS
+clock, date, time
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/close.n b/doc/close.n
index 23aae91..63da75b 100644
--- a/doc/close.n
+++ b/doc/close.n
@@ -5,28 +5,27 @@
'\" 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.10 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH close n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
.SH SYNOPSIS
-\fBclose \fIchannelId\fR
+\fBclose \fIchannelId\fR ?r(ead)|w(rite)?
.BE
-
.SH DESCRIPTION
.PP
-Closes the channel given by \fIchannelId\fR.
+Closes or half-closes the channel given by \fIchannelId\fR.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
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
-All buffered output is flushed to the channel's output device,
+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.
.PP
@@ -49,17 +48,45 @@ 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
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
+.QW "half-close" :
+given a bidirectional channel like a
+socket or command pipeline and a (possibly abbreviated) direction, it closes
+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 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
+abnormal exit error.
+.PP
+Currently only sockets and command pipelines support half-close. A future
+extension will allow reflected and stacked channels to do so.
+.VE 8.6
.SH EXAMPLE
+.PP
This illustrates how you can use Tcl to ensure that files get closed
even when errors happen by combining \fBcatch\fR, \fBclose\fR and
\fBreturn\fR:
+.PP
.CS
proc withOpenFile {filename channelVar script} {
upvar 1 $channelVar chan
@@ -71,9 +98,11 @@ proc withOpenFile {filename channelVar script} {
return -options $options $result
}
.CE
-
.SH "SEE ALSO"
file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
-blocking, channel, close, nonblocking
+blocking, channel, close, nonblocking, half-close
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/concat.n b/doc/concat.n
index 882ebbc..575b9df 100644
--- a/doc/concat.n
+++ b/doc/concat.n
@@ -5,10 +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: concat.n,v 1.6 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH concat n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,37 +14,45 @@ concat \- Join lists together
.SH SYNOPSIS
\fBconcat\fI \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command joins each of its arguments together with spaces after
-trimming leading and trailing white-space from each of them. If all the
+trimming leading and trailing white-space from each of them. If all of the
arguments are lists, this has the same effect as concatenating them
into a single list.
It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
-Although \fBconcat\fR will concatenate lists (so the command:
+Although \fBconcat\fR will concatenate lists, flattening them in the process
+(so giving the following interactive session):
+.PP
.CS
-\fBconcat\fR a b {c d e} {f {g h}}
+\fI%\fR \fBconcat\fR a b {c d e} {f {g h}}
+\fIa b c d e f {g h}\fR
.CE
-will return "\fBa b c d e f {g h}\fR" as its result), it will also
-concatenate things that are not lists, and hence the command:
+.PP
+it will also concatenate things that are not lists, as can be seen from this
+session:
+.PP
.CS
-\fBconcat\fR " a b {c " d " e} f"
+\fI%\fR \fBconcat\fR " a b {c " d " e} f"
+\fIa b {c d e} f\fR
.CE
-will return "\fBa b {c d e} f\fR" as its result.
.PP
-Note that the concatenation does not remove spaces from the middle of
-its arguments, so the command:
+Note also that the concatenation does not remove spaces from the middle of
+values, as can be seen here:
+.PP
.CS
-\fBconcat\fR "a b c" { d e f }
+\fI%\fR \fBconcat\fR "a b c" { d e f }
+\fIa b c d e f\fR
.CE
-will return "\fBa b c d e f\fR" (i.e. with three spaces between
-the \fBa\fR, the \fBb\fR and the \fBc\fR).
-
+.PP
+(i.e., there are three spaces between each of the \fBa\fR, the \fBb\fR and the
+\fBc\fR).
.SH "SEE ALSO"
-append(n), eval(n)
-
+append(n), eval(n), join(n)
.SH KEYWORDS
-concatenate, join, lists
+concatenate, join, list
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/continue.n b/doc/continue.n
index d2240b5..17d16b4 100644
--- a/doc/continue.n
+++ b/doc/continue.n
@@ -5,10 +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: continue.n,v 1.7 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH continue n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,13 +14,12 @@ continue \- Skip to the next iteration of a loop
.SH SYNOPSIS
\fBcontinue\fR
.BE
-
.SH DESCRIPTION
.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.
@@ -30,18 +27,21 @@ Catch exceptions are also handled in a few other situations, such
as the \fBcatch\fR command and the outermost scripts of procedure
bodies.
.SH EXAMPLE
+.PP
Print a line for each of the integers from 0 to 10 \fIexcept\fR 5:
+.PP
.CS
for {set x 0} {$x<10} {incr x} {
- if {$x == 5} {
- \fBcontinue\fR
- }
- puts "x is $x"
+ if {$x == 5} {
+ \fBcontinue\fR
+ }
+ puts "x is $x"
}
.CE
-
.SH "SEE ALSO"
break(n), for(n), foreach(n), return(n), while(n)
-
.SH KEYWORDS
continue, iteration, loop
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/copy.n b/doc/copy.n
new file mode 100644
index 0000000..100d564
--- /dev/null
+++ b/doc/copy.n
@@ -0,0 +1,66 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH copy n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::copy \- create copies of objects and classes
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR?
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBoo::copy\fR command creates a copy of an object or class. It takes the
+name of the object or class to be copied, \fIsourceObject\fR, and optionally
+the name of the object or class to create, \fItargetObject\fR, which will be
+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.
+.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
+then demonstrates that the copied object is indeed a copy.
+.PP
+.CS
+oo::object create src
+oo::objdefine src method msg {} {puts foo}
+\fBoo::copy\fR src dst
+oo::objdefine src method msg {} {puts bar}
+src msg \fI\(-> prints "bar"\fR
+dst msg \fI\(-> prints "foo"\fR
+.CE
+.SH "SEE ALSO"
+oo::class(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+clone, copy, duplication, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/coroutine.n b/doc/coroutine.n
new file mode 100644
index 0000000..c99f8d3
--- /dev/null
+++ b/doc/coroutine.n
@@ -0,0 +1,205 @@
+'\"
+'\" Copyright (c) 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.
+'\"
+.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+coroutine, yield, yieldto \- Create and produce values from coroutines
+.SH SYNOPSIS
+.nf
+\fBcoroutine \fIname command\fR ?\fIarg...\fR?
+\fByield\fR ?\fIvalue\fR?
+.VS TIP396
+\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
+\fIname\fR ?\fIvalue...\fR?
+.VE TIP396
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBcoroutine\fR command creates a new coroutine context (with associated
+command) named \fIname\fR and executes that context by calling \fIcommand\fR,
+passing in the other remaining arguments without further interpretation. Once
+\fIcommand\fR returns normally or with an exception (e.g., an error) the
+coroutine context \fIname\fR is deleted.
+.PP
+Within the context, values may be generated as results by using the
+\fByield\fR command; if no \fIvalue\fR is supplied, the empty string is used.
+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 \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.
+If there are deletion traces on variables in the coroutine's
+implementation, they will fire at the point when the coroutine is explicitly
+deleted (or, naturally, if the command returns conventionally).
+.PP
+At the point when \fIcommand\fR is called, the current namespace will be the
+global namespace and there will be no stack frames above it (in the sense of
+\fBupvar\fR and \fBuplevel\fR). However, which command to call will be
+determined in the namespace that the \fBcoroutine\fR command was called from.
+.SH EXAMPLES
+.PP
+This example shows a coroutine that will produce an infinite sequence of
+even values, and a loop that consumes the first ten of them.
+.PP
+.CS
+proc allNumbers {} {
+ \fByield\fR
+ set i 0
+ while 1 {
+ \fByield\fR $i
+ incr i 2
+ }
+}
+\fBcoroutine\fR nextNumber allNumbers
+for {set i 0} {$i < 10} {incr i} {
+ puts "received [\fInextNumber\fR]"
+}
+rename nextNumber {}
+.CE
+.PP
+In this example, the coroutine acts to add up the arguments passed to it.
+.PP
+.CS
+\fBcoroutine\fR accumulator apply {{} {
+ set x 0
+ while 1 {
+ incr x [\fByield\fR $x]
+ }
+}}
+for {set i 0} {$i < 10} {incr i} {
+ puts "$i -> [\fIaccumulator\fR $i]"
+}
+.CE
+.PP
+This example demonstrates the use of coroutines to implement the classic Sieve
+of Eratosthenes algorithm for finding prime numbers. Note the creation of
+coroutines inside a coroutine.
+.PP
+.CS
+proc filterByFactor {source n} {
+ \fByield\fR [info coroutine]
+ while 1 {
+ set x [\fI$source\fR]
+ if {$x % $n} {
+ \fByield\fR $x
+ }
+ }
+}
+\fBcoroutine\fR allNumbers apply {{} {while 1 {\fByield\fR [incr x]}}}
+\fBcoroutine\fR eratosthenes apply {c {
+ \fByield\fR
+ while 1 {
+ set n [\fI$c\fR]
+ \fByield\fR $n
+ set c [\fBcoroutine\fR prime$n filterByFactor $c $n]
+ }
+}} allNumbers
+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.
+.PP
+.CS
+proc report {where level} {
+ # Where was the caller called from?
+ set ns [uplevel 2 {namespace current}]
+ \fByield\fR "made $where $level context=$ns name=[info coroutine]"
+}
+proc example {} {
+ report outer [info level]
+}
+namespace eval demo {
+ proc example {} {
+ report inner [info level]
+ }
+ proc makeExample {} {
+ puts "making from [info level]"
+ puts [\fBcoroutine\fR coroEg example]
+ }
+ makeExample
+}
+.CE
+.PP
+Which produces the output below. In particular, we can see that stack
+manipulation has occurred (comparing the levels from the first and second
+line) and that the parent level in the coroutine is the global namespace. We
+can also see that coroutine names are local to the current namespace if not
+qualified, and that coroutines may yield at depth (e.g., in called
+procedures).
+.PP
+.CS
+making from 2
+made inner 1 context=:: name=::demo::coroEg
+.CE
+.SH "SEE ALSO"
+apply(n), info(n), proc(n), return(n)
+.SH KEYWORDS
+coroutine, generator
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/dde.n b/doc/dde.n
index a558505..37d491b 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.17 2004/11/25 11:28:22 dkf Exp $
-'\"
+.TH dde n 1.4 dde "Tcl Bundled Packages"
.so man.macros
-.TH dde n 1.3 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?
+\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
@@ -47,24 +47,32 @@ has the service name \fBExcel\fR.
The following commands are a subset of the full Dynamic Data Exchange
set of commands.
.TP
-\fBdde servername \fR?\fB-force\fR? ?\fB-handler \fIproc\fR? ?\fB--\fR? ?\fItopic\fR?
+\fBdde servername \fR?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
+.
\fBdde servername\fR registers the interpreter as a DDE server with
the service name \fBTclEval\fR and the topic name specified by \fItopic\fR.
If no \fItopic\fR is given, \fBdde servername\fR returns the name
of the current topic or the empty string if it is not registered as a
service. If the given \fItopic\fR name is already in use, then a
-suffix of the form ' #2' or ' #3' is appended to the name to make it
+suffix of the form
+.QW " #2"
+or
+.QW " #3"
+is appended to the name to make it
unique. The command's result will be the name actually used. The
-\fB-force\fR option is used to force registration of precisely the
+\fB\-force\fR option is used to force registration of precisely the
given \fItopic\fR name.
-.IP
-The \fB-handler\fR option specifies a Tcl procedure that will be called to
+.RS
+.PP
+The \fB\-handler\fR option specifies a Tcl procedure that will be called to
process calls to the dde server. If the package has been loaded into a
-safe interpreter then a \fB-handler\fR procedure must be defined. The
+safe interpreter then a \fB\-handler\fR procedure must be defined. The
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,
\fIservice\fR is the name of an application, and \fItopic\fR is a file to
@@ -74,8 +82,16 @@ 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,
\fIservice\fR is the name of an application. \fItopic\fR is application
@@ -83,8 +99,16 @@ 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
+.
\fBdde request\fR is typically used to get the value of something; the
value of a cell in Microsoft Excel or the text of a selection in
Microsoft Word. \fIservice\fR is typically the name of an application,
@@ -95,6 +119,7 @@ string with terminating null. If \fB\-binary\fR is specified, the
result is returned as a byte array.
.TP
\fBdde services \fIservice topic\fR
+.
\fBdde services\fR returns a list of service-topic pairs that
currently exist on the machine. If \fIservice\fR and \fItopic\fR are
both empty strings ({}), then all service-topic pairs currently
@@ -106,6 +131,7 @@ service-topic pair currently exists, it is returned; otherwise, an
empty string is returned.
.TP
\fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR?
+.
\fBdde eval\fR evaluates a command and its arguments using the interpreter
specified by \fItopic\fR. The DDE service must be the \fBTclEval\fR
service. The \fB\-async\fR option requests asynchronous invocation. The
@@ -113,6 +139,7 @@ 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. This command can be used to replace send on Windows.
.SH "DDE AND TCL"
+.PP
A Tcl interpreter always has a service name of \fBTclEval\fR. Each
different interpreter of all running Tcl applications must be
given a unique
@@ -134,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
@@ -145,15 +172,18 @@ If for any reason the event queue is not flushed, DDE commands may
hang until the event queue is flushed. This can create a deadlock
situation.
.SH EXAMPLE
+.PP
This asks Internet Explorer (which must already be running) to go to a
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
new file mode 100644
index 0000000..7599ec0
--- /dev/null
+++ b/doc/define.n
@@ -0,0 +1,404 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH define n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::define, oo::objdefine \- define and configure classes and objects
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::define\fI class defScript\fR
+\fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR?
+\fBoo::objdefine\fI object defScript\fR
+\fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBoo::define\fR command is used to control the configuration of classes,
+and the \fBoo::objdefine\fR command is used to control the configuration of
+objects (including classes as instance objects), with the configuration being
+applied to the entity named in the \fIclass\fR or the \fIobject\fR argument.
+Configuring a class also updates the
+configuration of all subclasses of the class and all objects that are
+instances of that class or which mix it in (as modified by any per-instance
+configuration). The way in which the configuration is done is controlled by
+either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following
+\fIarg\fR arguments; when the second is present, it is exactly as if all the
+arguments from \fIsubcommand\fR onwards are made into a list and that list is
+used as the \fIdefScript\fR argument.
+.SS "CONFIGURING CLASSES"
+.PP
+The following commands are supported in the \fIdefScript\fR for
+\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
+.TP
+\fBconstructor\fI argList bodyScript\fR
+.
+This creates or updates the constructor for a class. The formal arguments to
+the constructor (defined using the same format as for the Tcl \fBproc\fR
+command) will be \fIargList\fR, and the body of the constructor will be
+\fIbodyScript\fR. When the body of the constructor is evaluated, the current
+namespace of the constructor will be a namespace that is unique to the object
+being constructed. Within the constructor, the \fBnext\fR command should be
+used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
+string, the constructor will be deleted.
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR
+.
+This deletes each of the methods called \fIname\fR from a class. The methods
+must have previously existed in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified).
+.TP
+\fBdestructor\fI bodyScript\fR
+.
+This creates or updates the destructor for a class. Destructors take no
+arguments, and the body of the destructor will be \fIbodyScript\fR. The
+destructor is called when objects of the class are deleted, and when called
+will have the object's unique namespace as the current namespace. Destructors
+should use the \fBnext\fR command to call the superclasses' destructors. Note
+that destructors are not called in all situations (e.g. if the interpreter is
+destroyed). If \fIbodyScript\fR is the empty string, the destructor will be
+deleted.
+.RS
+Note that errors during the evaluation of a destructor \fIare not returned\fR
+to the code that causes the destruction of an object. Instead, they are passed
+to the currently-defined \fBbgerror\fR handler.
+.RE
+.TP
+\fBexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be exported
+(i.e. usable outside an instance through the instance object's command) by the
+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 ?\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.
+.VS
+By default, this slot works by appending.
+.VE
+.TP
+\fBforward\fI name cmdName \fR?\fIarg ...\fR?
+.
+This creates or updates a forwarded method called \fIname\fR. The method is
+defined be forwarded to the command called \fIcmdName\fR, with additional
+arguments, \fIarg\fR etc., added before those arguments specified by the
+caller of the method. The \fIcmdName\fR will always be resolved using the
+rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not
+fully-qualified, the command will be searched for in each object's namespace,
+using the instances' namespace's path, or by looking in the global namespace.
+The method will be exported if \fIname\fR starts with a lower-case letter, and
+non-exported otherwise.
+.TP
+\fBmethod\fI name argList bodyScript\fR
+.
+This creates or updates a method that is implemented as a procedure-like
+script. The name of the method is \fIname\fR, the formal arguments to the
+method (defined using the same format as for the Tcl \fBproc\fR command) will
+be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
+the body of the method is evaluated, the current namespace of the method will
+be a namespace that is unique to the current object. The method will be
+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 ?\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.
+.VS
+By default, this slot works by replacement.
+.VE
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
+method must have previously existed in the class, and \fItoName\fR must not
+previously refer to a method in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified). Does
+not change the export status of the method; if it was exported before, it will
+be afterwards.
+.TP
+\fBself\fI subcommand arg ...\fR
+.TP
+\fBself\fI script\fR
+.
+This command is equivalent to calling \fBoo::objdefine\fR on the class being
+defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
+supported values of \fIsubcommand\fR). It follows the same general pattern of
+argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
+and
+.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
+operates identically to
+.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
+.TP
+\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, 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?
+.
+This arranges for each of the named methods, \fIname\fR, to be not exported
+(i.e. not usable outside the instance through the instance object's command,
+but instead just through the \fBmy\fR command visible in each object's
+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 ?\fI\-slotOperation\fR? ?\fIname ...\fR?
+.VS
+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. 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. By default, this slot works by appending.
+.VE
+.SS "CONFIGURING OBJECTS"
+.PP
+The following commands are supported in the \fIdefScript\fR for
+\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
+form:
+.TP
+\fBclass\fI className\fR
+.
+This allows the class of an object to be changed after creation. Note that the
+class's constructors are not called when this is done, and so the object may
+well be in an inconsistent state unless additional configuration work is done.
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR
+.
+This deletes each of the methods called \fIname\fR from an object. The methods
+must have previously existed in that object. Does not affect the classes that
+the object is an instance of.
+.TP
+\fBexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be exported
+(i.e. usable outside the object through the object's command) by the object
+being defined. Note that the methods themselves may be actually defined by a
+class or superclass; object exports override class visibility.
+.TP
+\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. 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?
+.
+This creates or updates a forwarded object method called \fIname\fR. The
+method is defined be forwarded to the command called \fIcmdName\fR, with
+additional arguments, \fIarg\fR etc., added before those arguments specified
+by the caller of the method. Forwarded methods should be deleted using the
+\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
+a lower-case letter, and non-exported otherwise.
+.TP
+\fBmethod\fI name argList bodyScript\fR
+.
+This creates, updates or deletes an object method. The name of the method is
+\fIname\fR, the formal arguments to the method (defined using the same format
+as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
+method will be \fIbodyScript\fR. When the body of the method is evaluated, the
+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 ?\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.
+.VS
+By default, this slot works by replacement.
+.VE
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in an object to \fItoName\fR.
+The method must have previously existed in the object, and \fItoName\fR must
+not previously refer to a method in that object. Does not affect the classes
+that the object is an instance of. Does not change the export status of the
+method; if it was exported before, it will be afterwards.
+.TP
+\fBunexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be not exported
+(i.e. not usable outside the object through the object's command, but instead
+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 ?\fI\-slotOperation\fR? ?\fIname ...\fR?
+.VS
+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
+\fBoo::objdefine\fR commands (they work in the same way), as well as
+illustrating four of the subcommands of them.
+.PP
+.CS
+oo::class create c
+c create o
+\fBoo::define\fR c \fBmethod\fR foo {} {
+ puts "world"
+}
+\fBoo::objdefine\fR o {
+ \fBmethod\fR bar {} {
+ my Foo "hello "
+ my foo
+ }
+ \fBforward\fR Foo ::puts -nonewline
+ \fBunexport\fR foo
+}
+o bar \fI\(-> prints "hello world"\fR
+o foo \fI\(-> error "unknown method foo"\fR
+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, slot
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/dict.n b/doc/dict.n
index f0d4ea9..77c460b 100644
--- a/doc/dict.n
+++ b/doc/dict.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.
'\"
-'\" RCS: @(#) $Id: dict.n,v 1.11 2004/11/12 09:01:25 das Exp $
-'\"
-.so man.macros
.TH dict n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -15,7 +13,6 @@ dict \- Manipulate dictionaries
.SH SYNOPSIS
\fBdict \fIoption arg \fR?\fIarg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
Performs one of several operations on dictionary values or variables
@@ -24,33 +21,40 @@ below for a description), depending on \fIoption\fR. The legal
\fIoption\fRs (which may be abbreviated) are:
.TP
\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
+.
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string.
.TP
\fBdict create \fR?\fIkey value ...\fR?
+.
Create a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP
\fBdict exists \fIdictionaryValue key \fR?\fIkey ...\fR?
+.
This returns a boolean value indicating whether the given key (or path
of keys through a set of nested dictionaries) exists in the given
dictionary value. This returns a true value exactly when \fBdict
get\fR on that path will succeed.
.TP
\fBdict filter \fIdictionaryValue filterType arg \fR?\fIarg ...\fR?
+.
This takes a dictionary value and returns a new dictionary that
contains just those key/value pairs that match the specified filter
type (which may be abbreviated.) Supported filter types are:
.RS
.TP
-\fBdict filter \fIdictionaryValue \fBkey \fIglobPattern\fR
-The key rule only matches those key/value pairs whose keys match the
-given pattern (in the style of \fBstring match\fR.)
+\fBdict filter \fIdictionaryValue \fBkey\fR ?\fIglobPattern ...\fR?
+.VS 8.6
+The key rule only matches those key/value pairs whose keys match any
+of the given patterns (in the style of \fBstring match\fR.)
+.VE 8.6
.TP
\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR
+.
The script rule tests for matching by assigning the key to the
\fIkeyVar\fR and the value to the \fIvalueVar\fR, and then evaluating
the given script which should return a boolean value (with the
@@ -60,14 +64,18 @@ argument after the rule selection word is a two-element list. If the
\fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further
key/value pairs are considered for inclusion in the resulting
dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
-result. The order in which the key/value pairs are tested is undefined.
+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
-The value rule only matches those key/value pairs whose values match
-the given pattern (in the style of \fBstring match\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.)
+.VE 8.6
.RE
.TP
\fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR
+.
This command takes three arguments, the first 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,
@@ -78,9 +86,11 @@ body generates a \fBTCL_BREAK\fR result, no further pairs from the
dictionary will be iterated over and the \fBdict for\fR command will
terminate successfully immediately. If any evaluation of the body
generates a \fBTCL_CONTINUE\fR result, this shall be treated exactly like a
-normal \fBTCL_OK\fR result. The order of iteration is undefined.
+normal \fBTCL_OK\fR result. The order of iteration is the order in
+which the keys were inserted into the dictionary.
.TP
\fBdict get \fIdictionaryValue \fR?\fIkey ...\fR?
+.
Given a dictionary value (first argument) and a key (second argument),
this will retrieve the value for that key. Where several keys are
supplied, the behaviour of the command shall be as if the result of
@@ -89,20 +99,23 @@ supplied, the behaviour of the command shall be as if the result of
subsequent) arguments. This facilitates lookups in nested
dictionaries. For example, the following two commands are equivalent:
.RS
+.PP
.CS
dict get $dict foo bar spong
dict get [dict get [dict get $dict foo] bar] spong
.CE
-If no keys are provided, dict would return a list containing pairs of
+.PP
+If no keys are provided, \fBdict get\fR will return a list containing pairs of
elements in a manner similar to \fBarray get\fR. That is, the first
element of each pair would be the key and the second element would be
the value for that key.
-
+.PP
It is an error to attempt to retrieve a value for a key that is not
present in the dictionary.
.RE
.TP
\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
+.
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
@@ -111,22 +124,22 @@ are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer.
.TP
\fBdict info \fIdictionaryValue\fR
+.
This returns information (intended for display to people) about the
given dictionary though the format of this data is dependent on the
implementation of the dictionary. For dictionaries that are
implemented by hash tables, it is expected that this will return the
-string produced by \fBTcl_HashStats\fR, similar to \fBarray info\fR.
+string produced by \fBTcl_HashStats\fR, similar to \fBarray statistics\fR.
.TP
\fBdict keys \fIdictionaryValue \fR?\fIglobPattern\fR?
+.
Return a list of all keys in the given dictionary value. If a pattern
is supplied, only those keys that match it (according to the rules of
-\fBstring match\fR) will be returned. The returned keys will be in an
-arbitrary implementation-specific order, though where no pattern is
-supplied the i'th key returned by \fBdict keys\fR will be the key for
-the i'th value returned by \fBdict values\fR applied to the same
-dictionary value.
+\fBstring match\fR) will be returned. The returned keys will be in the
+order that they were inserted into the dictionary.
.TP
\fBdict lappend \fIdictionaryVariable key \fR?\fIvalue ...\fR?
+.
This appends the given items to the list value that the given key maps
to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
@@ -134,7 +147,33 @@ 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
\fIdictionaryValue\fR arguments. Where two (or more) dictionaries
contain a mapping for the same key, the resulting dictionary maps that
@@ -142,6 +181,7 @@ key to the value according to the last dictionary on the command line
containing a mapping for that key.
.TP
\fBdict remove \fIdictionaryValue \fR?\fIkey ...\fR?
+.
Return a new dictionary that is a copy of an old one passed in as
first argument except without mappings for each of the keys listed.
It is legal for there to be no keys to remove, and it also legal for
@@ -149,6 +189,7 @@ any of the keys to be removed to not be present in the input
dictionary in the first place.
.TP
\fBdict replace \fIdictionaryValue \fR?\fIkey value ...\fR?
+.
Return a new dictionary that is a copy of an old one passed in as
first argument except with some values different or some extra
key/value pairs added. It is legal for this command to be called with
@@ -156,6 +197,7 @@ no key/value pairs, but illegal for this command to be called with a
key but no value.
.TP
\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
+.
This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
@@ -163,9 +205,11 @@ multiple keys are present, this operation creates or updates a chain
of nested dictionaries.
.TP
\fBdict size \fIdictionaryValue\fR
+.
Return the number of key/value mappings in the given dictionary value.
.TP
\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
+.
This operation (the companion to \fBdict set\fR) takes the name of a
variable containing a dictionary value and places an updated
dictionary value in that variable that does not contain a mapping for
@@ -175,6 +219,7 @@ must be specified, but the last key on the key-path need not exist.
All other components on the path must exist.
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
+.
Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
(as found by reading the dictionary value in \fIdictionaryVariable\fR)
mapped to the variable \fIvarName\fR. There may be multiple
@@ -186,20 +231,29 @@ to the dictionary within \fIdictionaryVariable\fR (unless
are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
-evaluation of \fIbody\fR. Note that the mapping of values to variables
+evaluation of \fIbody\fR.
+.RS
+.PP
+Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
+it is recommended that this command only be used in a local scope
+(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
+this, the variables set by \fBdict update\fR will continue to
+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.
+.RE
.TP
\fBdict values \fIdictionaryValue \fR?\fIglobPattern\fR?
+.
Return a list of all values in the given dictionary value. If a
pattern is supplied, only those values that match it (according to the
rules of \fBstring match\fR) will be returned. The returned values
-will be in an arbitrary implementation-specific order, though where no
-pattern is supplied the i'th key returned by \fBdict keys\fR will be
-the key for the i'th value returned by \fBdict values\fR applied to
-the same dictionary value.
+will be in the order of that the keys associated with those values
+were inserted into the dictionary.
.TP
\fBdict with \fIdictionaryVariable \fR?\fIkey ...\fR? \fIbody\fR
+.
Execute the Tcl script in \fIbody\fR with the value for each key in
\fIdictionaryVariable\fR mapped (in a manner similarly to \fBdict
update\fR) to a variable with the same name. Where one or more
@@ -211,21 +265,82 @@ dictionary be discarded, and this also happens if the contents of
\fIdictionaryVariable\fR are adjusted so that the chain of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
-\fIbody\fR. Note that the mapping of values to variables does not use
+\fIbody\fR.
+.RS
+.PP
+The variables are mapped in the scope enclosing the \fBdict with\fR;
+it is recommended that this command only be used in a local scope
+(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
+this, the variables set by \fBdict with\fR will continue to
+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"
-Dictionaries are values that contain an efficient (but \fInot\fR
-order-preserving) mapping from arbitrary keys to arbitrary values.
+.PP
+Dictionaries are values that contain an efficient, order-preserving
+mapping from arbitrary keys to arbitrary values.
+Each key in the dictionary maps to a single value.
They have a textual format that is exactly that of any list with an
even number of elements, with each mapping in the dictionary being
-represented as two items in the list. When a command takes a
+represented as two items in the list. When a command takes a
dictionary and produces a new dictionary based on it (either returning
it or writing it back into the variable that the starting dictionary
-was read from) there is \fIno\fR guarantee that the new dictionary
-will have the same ordering of keys.
+was read from) the new dictionary will have the same order of keys,
+modulo any deleted keys and with new keys added on to the end.
+When a string is interpreted as a dictionary and it would otherwise
+have duplicate keys, only the last value for a particular key is used;
+the others are ignored, meaning that,
+.QW "apple banana"
+and
+.QW "apple carrot apple banana"
+are equivalent dictionaries (with different string representations).
+.PP
+Operations that derive a new dictionary from an old one (e.g., updates
+like \fBdict set\fR and \fBdict unset\fR) preserve the order of keys
+in the dictionary. The exceptions to this are for any new keys they
+add, which are appended to the sequence, and any keys that are
+removed, which are excised from the order.
.SH EXAMPLES
+.PP
+Basic dictionary usage:
+.PP
+.CS
+# Make a dictionary to map extensions to descriptions
+set filetypes [\fBdict create\fR .txt "Text File" .tcl "Tcl File"]
+
+# Add/update the dictionary
+\fBdict set\fR filetypes .tcl "Tcl Script"
+\fBdict set\fR filetypes .tm "Tcl Module"
+\fBdict set\fR filetypes .gif "GIF Image"
+\fBdict set\fR filetypes .png "PNG Image"
+
+# Simple read from the dictionary
+set ext ".tcl"
+set desc [\fBdict get\fR $filetypes $ext]
+puts "$ext is for a $desc"
+
+# Somewhat more complex, with existence test
+foreach filename [glob *] {
+ set ext [file extension $filename]
+ if {[\fBdict exists\fR $filetypes $ext]} {
+ puts "$filename is a [\fBdict get\fR $filetypes $ext]"
+ }
+}
+.CE
+.PP
Constructing and using nested dictionaries:
+.PP
.CS
# Data for one employee
\fBdict set\fR employeeInfo 12345-A forenames "Joe"
@@ -245,25 +360,26 @@ Constructing and using nested dictionaries:
set i 0
puts "There are [\fBdict size\fR $employeeInfo] employees"
\fBdict for\fR {id info} $employeeInfo {
- puts "Employee #[incr i]: $id"
- \fBdict with\fR info {
- puts " Name: $forenames $surname"
- puts " Address: $street, $city"
- puts " Telephone: $phone"
- }
+ puts "Employee #[incr i]: $id"
+ \fBdict with\fR info {
+ puts " Name: $forenames $surname"
+ puts " Address: $street, $city"
+ puts " Telephone: $phone"
+ }
}
# Another way to iterate and pick out names...
foreach id [\fBdict keys\fR $employeeInfo] {
- puts "Hello, [\fBdict get\fR $employeeInfo $id forenames]!"
+ puts "Hello, [\fBdict get\fR $employeeInfo $id forenames]!"
}
.CE
-
+.PP
A localizable version of \fBstring toupper\fR:
+.PP
.CS
# Set up the basic C locale
set capital [\fBdict create\fR C [\fBdict create\fR]]
-foreach c {abcdefghijklmnopqrstuvwxyz} {
- \fBdict set\fR capital C $c [string toupper $c]
+foreach c [split {abcdefghijklmnopqrstuvwxyz} ""] {
+ \fBdict set\fR capital C $c [string toupper $c]
}
# English locales can luckily share the "C" locale
@@ -277,9 +393,49 @@ foreach c {abcdefghijklmnopqrstuvwxyz} {
set upperCaseMap [\fBdict get\fR $capital $env(LANG)]
set upperCase [string map $upperCaseMap $string]
.CE
+.PP
+Showing the detail of \fBdict with\fR:
+.PP
+.CS
+proc sumDictionary {varName} {
+ upvar 1 $varName vbl
+ foreach key [\fBdict keys\fR $vbl] {
+ # Manufacture an entry in the subdictionary
+ \fBdict set\fR vbl $key total 0
+ # Add the values and remove the old
+ \fBdict with\fR vbl $key {
+ set total [expr {$x + $y + $z}]
+ unset x y z
+ }
+ }
+ puts "last total was $total, for key $key"
+}
-.SH "SEE ALSO"
-append(n), array(n), foreach(n), incr(n), list(n), lappend(n), set(n)
+set myDict {
+ a {x 1 y 2 z 3}
+ b {x 6 y 5 z 4}
+}
+
+sumDictionary myDict
+# prints: \fIlast total was 15, for key b\fR
+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), 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 36db314..5782199 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -4,29 +4,38 @@
'\" 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.6 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
.SH NAME
encoding \- Manipulate encodings
.SH SYNOPSIS
\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
.BE
-
.SH INTRODUCTION
.PP
-Strings in Tcl are encoded using 16-bit Unicode characters. Different
-operating system interfaces or applications may generate strings in
-other encodings such as Shift-JIS. The \fBencoding\fR command helps
-to bridge the gap between Unicode and these other formats.
+Strings in Tcl are logically a sequence of 16-bit Unicode characters.
+These strings are represented in memory as a sequence of bytes that
+may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
+bytes per character), 16-bit
+.QW Unicode
+(which uses 2 bytes per character, with an endianness that is
+dependent on the host architecture), and binary (which uses a single
+byte per character but only handles a restricted range of characters).
+Tcl does not guarantee to always use the same encoding for the same
+string.
+.PP
+Different operating system interfaces or applications may generate
+strings in other encodings such as Shift\-JIS. The \fBencoding\fR
+command helps to bridge the gap between Unicode and these other
+formats.
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
\fIoption\fR. The legal \fIoption\fRs are:
.TP
\fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR
+.
Convert \fIdata\fR to Unicode from the specified \fIencoding\fR. The
characters in \fIdata\fR are treated as binary data where the lower
8-bits of each character is taken as a single byte. The resulting
@@ -35,17 +44,38 @@ sequence of bytes is treated as a string in the specified
system encoding is used.
.TP
\fBencoding convertto\fR ?\fIencoding\fR? \fIstring\fR
+.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string. Each byte is stored in the lower 8-bits of a Unicode
-character. If \fIencoding\fR is not specified, the current
-system encoding is used.
+character (indeed, the resulting string is a binary string as far as
+Tcl is concerned, at least initially). If \fIencoding\fR is not
+specified, the current system encoding is used.
+.TP
+\fBencoding dirs\fR ?\fIdirectoryList\fR?
+.
+Tcl can load encoding data files from the file system that describe
+additional encodings for it to work with. This command sets the search
+path for \fB*.enc\fR encoding data files to the list of directories
+\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the
+command returns the current list of directories that make up the
+search path. It is an error for \fIdirectoryList\fR to not be a valid
+list. If, when a search for an encoding data file is happening, an
+element in \fIdirectoryList\fR does not refer to a readable,
+searchable directory, that element is ignored.
.TP
\fBencoding names\fR
+.
Returns a list containing the names of all of the encodings that are
currently available.
+The encodings
+.QW utf-8
+and
+.QW iso8859-1
+are guaranteed to be present in the list.
.TP
\fBencoding system\fR ?\fIencoding\fR?
+.
Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
omitted then the command returns the current system encoding. The
system encoding is used whenever Tcl passes strings to system calls.
@@ -60,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
current system encoding, Tcl will only source such files correctly
when the encoding used to write the file is the same. This tends not
to be true in an internationalized setting. For example, if such a
-file was sourced in North America (where the ISO8859-1 is normally
+file was sourced in North America (where the ISO8859\-1 is normally
used), each byte in the file would be treated as a separate character
that maps to the 00 page in Unicode. The resulting Tcl strings will
not contain the expected Japanese characters. Instead, they will
@@ -68,14 +98,18 @@ contain a sequence of Latin-1 characters that correspond to the bytes
of the original string. The \fBencoding\fR command can be used to
convert this string to the expected Japanese Unicode characters. For
example,
+.PP
.CS
-set s [\fBencoding convertfrom\fR euc-jp "\\xA4\\xCF"]
+set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]
.CE
-would return the Unicode string "\\u306F", which is the Hiragana
-letter HA.
-
+.PP
+would return the Unicode string
+.QW "\eu306F" ,
+which is the Hiragana letter HA.
.SH "SEE ALSO"
Tcl_GetEncoding(3)
-
.SH KEYWORDS
-encoding
+encoding, unicode
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/eof.n b/doc/eof.n
index eed48cb..75f3c48 100644
--- a/doc/eof.n
+++ b/doc/eof.n
@@ -5,10 +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: eof.n,v 1.6 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH eof n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ eof \- Check for end of file condition on channel
.SH SYNOPSIS
\fBeof \fIchannelId\fR
.BE
-
.SH DESCRIPTION
.PP
Returns 1 if an end of file condition occurred during the most
@@ -28,7 +25,9 @@ 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.
.SH EXAMPLES
+.PP
Read and print out the contents of a file line-by-line:
+.PP
.CS
set f [open somefile.txt]
while {1} {
@@ -42,6 +41,7 @@ while {1} {
.CE
.PP
Read and print out the contents of a file by fixed-size records:
+.PP
.CS
set f [open somefile.dat]
fconfigure $f -translation binary
@@ -55,9 +55,7 @@ while {1} {
puts "Read record: $record"
}
.CE
-
.SH "SEE ALSO"
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
channel, end of file
diff --git a/doc/error.n b/doc/error.n
index 20bdbfe..a95c691 100644
--- a/doc/error.n
+++ b/doc/error.n
@@ -5,10 +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: error.n,v 1.9 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH error n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -23,12 +21,12 @@ Returns a \fBTCL_ERROR\fR code, which causes command interpretation to be
unwound. \fIMessage\fR is a string that is returned to the application
to indicate what went wrong.
.PP
-The \fB-errorinfo\fR return option of an interpreter is used
+The \fB\-errorinfo\fR return option of an interpreter is used
to accumulate a stack trace of what was in progress when an
error occurred; as nested commands unwind,
-the Tcl interpreter adds information to the \fB-errorinfo\fR
+the Tcl interpreter adds information to the \fB\-errorinfo\fR
return option. If the \fIinfo\fR argument is present, it is
-used to initialize the \fB-errorinfo\fR return options and
+used to initialize the \fB\-errorinfo\fR return options and
the first increment of unwind information
will not be added by the Tcl interpreter.
In other
@@ -39,36 +37,42 @@ with the \fBcatch\fR command:
if a caught error cannot be handled successfully, \fIinfo\fR can be used
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
-in the \fB-errorcode\fR return option. The \fB-errorcode\fR
+in the \fB\-errorcode\fR return option. The \fB\-errorcode\fR
return option is intended to hold a machine-readable description
of the error in cases where such information is available; see
the \fBreturn\fR manual page for information on the proper format
for this option's value.
.SH EXAMPLE
+.PP
Generate an error if a basic mathematical operation fails:
+.PP
.CS
if {1+2 != 3} {
\fBerror\fR "something is very wrong with addition"
}
.CE
-
.SH "SEE ALSO"
catch(n), return(n)
-
.SH KEYWORDS
-error
+error, exception
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/eval.n b/doc/eval.n
index ed46f0c..3ef5023 100644
--- a/doc/eval.n
+++ b/doc/eval.n
@@ -5,10 +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: eval.n,v 1.6 2004/10/27 09:36:58 dkf Exp $
-'\"
-.so man.macros
.TH eval n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ eval \- Evaluate a Tcl script
.SH SYNOPSIS
\fBeval \fIarg \fR?\fIarg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
\fBEval\fR takes one or more arguments, which together comprise a Tcl
@@ -28,11 +25,13 @@ evaluation (or any error generated by it).
Note that the \fBlist\fR command quotes sequences of words in such a
way that they are not further expanded by the \fBeval\fR command.
.SH EXAMPLES
+.PP
Often, it is useful to store a fragment of a script in a variable and
execute it later on with extra values appended. This technique is used
in a number of places throughout the Tcl core (e.g. in \fBfcopy\fR,
\fBlsort\fR and \fBtrace\fR command callbacks). This example shows how
to do this using core Tcl commands:
+.PP
.CS
set script {
puts "logging now"
@@ -50,35 +49,36 @@ for {set i 0} {$i<10} {incr i} {
}
.CE
.PP
-.VS 8.5
Note that in the most common case (where the script fragment is
actually just a list of words forming a command prefix), it is better
-to use \fB{expand}$script\fR when doing this sort of invokation
+to use \fB{*}$script\fR when doing this sort of invocation
pattern. It is less general than the \fBeval\fR command, and hence
easier to make robust in practice.
-.VE 8.5
The following procedure acts in a way that is analogous to the
\fBlappend\fR command, except it inserts the argument values at the
start of the list in the variable:
+.PP
.CS
proc lprepend {varName args} {
- upvar 1 $varName var
- # Ensure that the variable exists and contains a list
- lappend var
- # Now we insert all the arguments in one go
- set var [\fBeval\fR [list linsert $var 0] $args]
+ upvar 1 $varName var
+ # Ensure that the variable exists and contains a list
+ lappend var
+ # Now we insert all the arguments in one go
+ set var [\fBeval\fR [list linsert $var 0] $args]
}
.CE
-.VS 8.5
+.PP
However, the last line would now normally be written without
\fBeval\fR, like this:
+.PP
.CS
-set var [linsert $var 0 {expand}$args]
+set var [linsert $var 0 {*}$args]
.CE
-.VE 8.5
-
+.SH "SEE ALSO"
+catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n),
+namespace(n), subst(n), uplevel(n)
.SH KEYWORDS
concatenate, evaluate, script
-
-.SH "SEE ALSO"
-catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n)
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/exec.n b/doc/exec.n
index 2e094fa..c3f316b 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -1,22 +1,20 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2006 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: exec.n,v 1.13 2004/11/20 00:17:32 dgp Exp $
-'\"
-.so man.macros
.TH exec n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
exec \- Invoke subprocesses
.SH SYNOPSIS
-\fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR?
+\fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR? ?\fB&\fR?
.BE
-
.SH DESCRIPTION
.PP
This command treats its arguments as the specification
@@ -30,11 +28,18 @@ they are treated as command-line switches and are not part
of the pipeline specification. The following switches are
currently supported:
.TP 13
+\fB\-ignorestderr\fR
+.
+Stops the \fBexec\fR command from treating the output of messages to the
+pipeline's standard error channel as an error case.
+.TP 13
\fB\-keepnewline\fR
+.
Retains a trailing newline in the pipeline's output.
Normally a trailing newline will be deleted.
.TP 13
\fB\-\|\-\fR
+.
Marks the end of switches. The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.PP
@@ -42,81 +47,99 @@ If an \fIarg\fR (or pair of \fIarg\fRs) has one of the forms
described below then it is used by \fBexec\fR to control the
flow of input and output among the subprocess(es).
Such arguments will not be passed to the subprocess(es). In forms
-such as ``< \fIfileName\fR'' \fIfileName\fR may either be in a
-separate argument from ``<'' or in the same argument with no
-intervening space (i.e. ``<\fIfileName\fR'').
+such as
+.QW "\fB<\fR \fIfileName\fR" ,
+\fIfileName\fR may either be in a separate argument from
+.QW \fB<\fR
+or in the same argument with no intervening space (i.e.
+.QW \fB<\fIfileName\fR ).
.TP 15
-|
+\fB|\fR
+.
Separates distinct commands in the pipeline. The standard output
of the preceding command will be piped into the standard input
of the next command.
.TP 15
-|&
+\fB|&\fR
+.
Separates distinct commands in the pipeline. Both standard output
and standard error of the preceding command will be piped into
the standard input of the next command.
This form of redirection overrides forms such as 2> and >&.
.TP 15
-<\0\fIfileName\fR
+\fB<\0\fIfileName\fR
+.
The file named by \fIfileName\fR is opened and used as the standard
input for the first command in the pipeline.
.TP 15
-<@\0\fIfileId\fR
+\fB<@\0\fIfileId\fR
+.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
It is used as the standard input for the first command in the pipeline.
\fIFileId\fR must have been opened for reading.
.TP 15
-<<\0\fIvalue\fR
+\fB<<\0\fIvalue\fR
+.
\fIValue\fR is passed to the first command as its standard input.
.TP 15
->\0\fIfileName\fR
+\fB>\0\fIfileName\fR
+.
Standard output from the last command is redirected to the file named
\fIfileName\fR, overwriting its previous contents.
.TP 15
-2>\0\fIfileName\fR
+\fB2>\0\fIfileName\fR
+.
Standard error from all commands in the pipeline is redirected to the
file named \fIfileName\fR, overwriting its previous contents.
.TP 15
->&\0\fIfileName\fR
+\fB>&\0\fIfileName\fR
+.
Both standard output from the last command and standard error from all
commands are redirected to the file named \fIfileName\fR, overwriting
its previous contents.
.TP 15
->>\0\fIfileName\fR
+\fB>>\0\fIfileName\fR
+.
Standard output from the last command is
redirected to the file named \fIfileName\fR, appending to it rather
than overwriting it.
.TP 15
-2>>\0\fIfileName\fR
+\fB2>>\0\fIfileName\fR
+.
Standard error from all commands in the pipeline is
redirected to the file named \fIfileName\fR, appending to it rather
than overwriting it.
.TP 15
->>&\0\fIfileName\fR
+\fB>>&\0\fIfileName\fR
+.
Both standard output from the last command and standard error from
all commands are redirected to the file named \fIfileName\fR,
appending to it rather than overwriting it.
.TP 15
->@\0\fIfileId\fR
+\fB>@\0\fIfileId\fR
+.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Standard output from the last command is redirected to \fIfileId\fR's
file, which must have been opened for writing.
.TP 15
-2>@\0\fIfileId\fR
+\fB2>@\0\fIfileId\fR
+.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Standard error from all commands in the pipeline is
redirected to \fIfileId\fR's file.
The file must have been opened for writing.
.TP 15
-2>@1\0
+\fB2>@1\0\fR
+.
Standard error from all commands in the pipeline is redirected to the
command result. This operator is only valid at the end of the command
pipeline.
.TP 15
->&@\0\fIfileId\fR
+\fB>&@\0\fIfileId\fR
+.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Both standard output from the last command and standard error from
@@ -125,19 +148,18 @@ The file must have been opened for writing.
.PP
If standard output has not been redirected then the \fBexec\fR
command returns the standard output from the last command
-in the pipeline,
-.VS 8.5
-unless ``2>@1'' was specified, in which case
-standard error is included as well.
-.VE 8.5
+in the pipeline, unless
+.QW 2>@1
+was specified, in which case standard error is included as well.
If any of the commands in the pipeline exit abnormally or
are killed or suspended, then \fBexec\fR will return an error
and the error message will include the pipeline's output followed by
error messages describing the abnormal terminations; the
-\fB-errorcode\fR return option will contain additional information
+\fB\-errorcode\fR return option will contain additional information
about the last abnormal termination encountered.
If any of the commands writes to its standard error file and that
-standard error isn't redirected,
+standard error is not redirected
+and \fB\-ignorestderr\fR is not specified,
then \fBexec\fR will return an error; the error message
will include the pipeline's standard output, followed by messages
about abnormal terminations (if any), followed by the standard error
@@ -146,22 +168,27 @@ output.
If the last character of the result or error message
is a newline then that character is normally deleted
from the result or error message.
-This is consistent with other Tcl return values, which don't
+This is consistent with other Tcl return values, which do not
normally end with newlines.
However, if \fB\-keepnewline\fR is specified then the trailing
newline is retained.
.PP
-If standard input isn't redirected with ``<'' or ``<<''
-or ``<@'' then the standard input for the first command in the
+If standard input is not redirected with
+.QW < ,
+.QW <<
+or
+.QW <@
+then the standard input for the first command in the
pipeline is taken from the application's current standard input.
.PP
-If the last \fIarg\fR is ``&'' then the pipeline will be
-executed in background.
+If the last \fIarg\fR is
+.QW &
+then the pipeline will be executed in background.
In this case the \fBexec\fR command will return a list whose
elements are the process identifiers for all of the subprocesses
in the pipeline.
The standard output from the last command in the pipeline will
-go to the application's standard output if it hasn't been
+go to the application's standard output if it has not been
redirected, and error output from all of
the commands in the pipeline will go to the application's
standard error file unless redirected.
@@ -173,25 +200,28 @@ in the PATH environment variable are searched for
an executable by the given name.
If the name contains a slash then it must refer to an executable
reachable from the current directory.
-No ``glob'' expansion or other shell-like substitutions
+No
+.QW glob
+expansion or other shell-like substitutions
are performed on the arguments to commands.
-
.SH "PORTABILITY ISSUES"
.TP
\fBWindows\fR (all versions)
.
-Reading from or writing to a socket, using the ``\fB@\0\fIfileId\fR''
+Reading from or writing to a socket, using the
+.QW \fB@\0\fIfileId\fR
notation, does not work. When reading from a socket, a 16-bit DOS
application will hang and a 32-bit application will return immediately with
end-of-file. When either type of application writes to a socket, the
information is instead sent to the console, if one is present, or is
discarded.
-.sp
+.RS
+.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
error will be discarded.
-.sp
+.PP
Either forward or backward slashes are accepted as path separators for
arguments to Tcl commands. When executing an application, the path name
specified for the application may also contain forward or backward slashes
@@ -202,12 +232,16 @@ path name with forward slashes will not automatically be converted to use
the backslash character. If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
the program.
-.sp
+.PP
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
-names must use the short, cryptic, path format (e.g., using ``applba~1.def''
-instead of ``applbakery.default''), which can be obtained with the
-\fBfile attributes $fileName -shortname\fR command.
-.sp
+names must use the short, cryptic, path format (e.g., using
+.QW applba~1.def
+instead of
+.QW applbakery.default ),
+which can be obtained with the
+.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
network path. For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
@@ -216,25 +250,25 @@ point called \fBsystem\fR on the machine called \fBwindows\fR (and the
\fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR,
which describes a directory on the current computer. The \fBfile join\fR
command should be used to concatenate path components.
-.sp
-.RS
+.PP
Note that there are two general types of Win32 console applications:
.RS
-1) CLI -- CommandLine Interface, simple stdio exchange. \fBnetstat.exe\fR for
+.IP [1]
+CLI \(em CommandLine Interface, simple stdio exchange. \fBnetstat.exe\fR for
example.
-.br
-2) TUI -- Textmode User Interface, any application that accesses the console
+.IP [2]
+TUI \(em Textmode User Interface, any application that accesses the console
API for doing such things as cursor movement, setting text color, detecting
key presses and mouse movement, etc. An example would be \fBtelnet.exe\fR
from Windows 2000. These types of applications are not common in a windows
environment, but do exist.
.RE
+.PP
\fBexec\fR will not work well with TUI applications when a console is not
present, as is done when launching applications under wish. It is desirable
to have console applications hidden and detached. This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes. The Expect
extension addresses this issue when communicating with a TUI application.
-.sp
.RE
.TP
\fBWindows NT\fR
@@ -245,26 +279,24 @@ the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
-.sp
-.RS
.RS
+.IP \(bu 3
The directory from which the Tcl executable was loaded.
-.br
+.IP \(bu 3
The current directory.
-.br
+.IP \(bu 3
The Windows NT 32-bit system directory.
-.br
+.IP \(bu 3
The Windows NT 16-bit system directory.
-.br
+.IP \(bu 3
The Windows NT home directory.
-.br
+.IP \(bu 3
The directories listed in the path.
-.RE
-.sp
+.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
-the caller must prepend the desired command with ``\fBcmd.exe /c\0\fR''
+the caller must prepend the desired command with
+.QW "\fBcmd.exe /c\0\fR"
because built-in commands are not implemented using executables.
-.sp
.RE
.TP
\fBWindows 9x\fR
@@ -275,39 +307,42 @@ the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
-.sp
-.RS
.RS
+.IP \(bu 3
The directory from which the Tcl executable was loaded.
-.br
+.IP \(bu 3
The current directory.
-.br
+.IP \(bu 3
The Windows 9x system directory.
-.br
+.IP \(bu 3
The Windows 9x home directory.
-.br
+.IP \(bu 3
The directories listed in the path.
.RE
-.sp
+.RS
+.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
-the caller must prepend the desired command with ``\fBcommand.com /c\0\fR''
+the caller must prepend the desired command with
+.QW "\fBcommand.com /c\0\fR"
because built-in commands are not implemented using executables.
-.sp
+.PP
Once a 16-bit DOS application has read standard input from a console and
then quit, all subsequently run 16-bit DOS applications will see the
standard input as already closed. 32-bit applications do not have this
problem and will run correctly, even after a 16-bit DOS application thinks
that standard input is closed. There is no known workaround for this bug
at this time.
-.sp
+.PP
Redirection between the \fBNUL:\fR device and a 16-bit application does not
always work. When redirecting from \fBNUL:\fR, some applications may hang,
-others will get an infinite stream of ``0x01'' bytes, and some will actually
+others will get an infinite stream of
+.QW 0x01
+bytes, and some will actually
correctly get an immediate end-of-file; the behavior seems to depend upon
something compiled into the application itself. When redirecting greater than
4K or so to \fBNUL:\fR, some applications will hang. The above problems do not
happen with 32-bit applications.
-.sp
+.PP
All DOS 16-bit applications are run synchronously. All standard input from
a pipe to a 16-bit DOS application is collected into a temporary file; the
other end of the pipe must be closed before the 16-bit DOS application
@@ -317,7 +352,7 @@ must terminate before the temporary files are redirected to the next stage
of the pipeline. This is due to a workaround for a Windows 95 bug in the
implementation of pipes, and is how the standard Windows 95 DOS shell
handles pipes itself.
-.sp
+.PP
Certain applications, such as \fBcommand.com\fR, should not be executed
interactively. Applications which directly access the console window,
rather than reading from their standard input and writing to their standard
@@ -325,75 +360,122 @@ output may fail, hang Tcl, or even hang the system if their own private
console window is not available to them.
.RE
.TP
-\fBUnix\fR\0\0\0\0\0\0\0
+\fBUnix\fR (including Mac OS X)
+.
The \fBexec\fR command is fully functional and works as described.
-
.SH "UNIX EXAMPLES"
-Here are some examples of the use of the \fBexec\fR command on Unix.
.PP
+Here are some examples of the use of the \fBexec\fR command on Unix.
To execute a simple program and get its result:
+.PP
.CS
\fBexec\fR uname -a
.CE
+.SS "WORKING WITH NON-ZERO RESULTS"
.PP
To execute a program that can return a non-zero result, you should
wrap the call to \fBexec\fR in \fBcatch\fR and check the contents
-of the \fB-errorcode\fR return option if you have an error:
+of the \fB\-errorcode\fR return option if you have an error:
+.PP
.CS
set status 0
if {[catch {\fBexec\fR grep foo bar.txt} results options]} {
- set details [dict get $options -errorcode]
- if {[lindex $details 0] eq "CHILDSTATUS"} {
- set status [lindex $details 2]
- } else {
- # Some kind of unexpected failure
- }
+ set details [dict get $options -errorcode]
+ if {[lindex $details 0] eq "CHILDSTATUS"} {
+ set status [lindex $details 2]
+ } else {
+ # Some other error; regenerate it to let caller handle
+ return -options $options -level 0 $results
+ }
}
.CE
+.VS 8.6
+.PP
+This is more easily written using the \fBtry\fR command, as that makes
+it simpler to trap specific types of errors. This is
+done using code like this:
+.PP
+.CS
+try {
+ set results [\fBexec\fR grep foo bar.txt]
+ set status 0
+} trap CHILDSTATUS {results options} {
+ set status [lindex [dict get $options -errorcode] 2]
+}
+.CE
+.VE 8.6
+.SS "WORKING WITH QUOTED ARGUMENTS"
.PP
When translating a command from a Unix shell invocation, care should
be taken over the fact that single quote characters have no special
significance to Tcl. Thus:
+.PP
.CS
awk '{sum += $1} END {print sum}' numbers.list
.CE
+.PP
would be translated into something like:
+.PP
.CS
\fBexec\fR awk {{sum += $1} END {print sum}} numbers.list
.CE
+.SS "WORKING WITH GLOBBING"
.PP
If you are converting invocations involving shell globbing, you should
remember that Tcl does not handle globbing or expand things into
multiple arguments by default. Instead you should write things like
this:
+.PP
.CS
-\fBexec\fR ls -l {expand}[glob *.tcl]
+\fBexec\fR ls -l {*}[glob *.tcl]
.CE
+.SS "WORKING WITH USER-SUPPLIED SHELL SCRIPT FRAGMENTS"
.PP
+One useful technique can be to expose to users of a script the ability
+to specify a fragment of shell script to execute that will have some
+data passed in on standard input that was produced by the Tcl program.
+This is a common technique for using the \fIlpr\fR program for
+printing. By far the simplest way of doing this is to pass the user's
+script to the user's shell for processing, as this avoids a lot of
+complexity with parsing other languages.
+.PP
+.CS
+set lprScript [\fIget from user...\fR]
+set postscriptData [\fIgenerate somehow...\fR]
+
+\fBexec\fR $env(SHELL) -c $lprScript << $postscriptData
+.CE
.SH "WINDOWS EXAMPLES"
-Here are some examples of the use of the \fBexec\fR command on Windows.
.PP
+Here are some examples of the use of the \fBexec\fR command on Windows.
To start an instance of \fInotepad\fR editing a file without waiting
for the user to finish editing the file:
+.PP
.CS
\fBexec\fR notepad myfile.txt &
.CE
.PP
To print a text file using \fInotepad\fR:
+.PP
.CS
\fBexec\fR notepad /p myfile.txt
.CE
+.SS "WORKING WITH CONSOLE PROGRAMS"
.PP
If a program calls other programs, such as is common with compilers,
then you may need to resort to batch files to hide the console windows
that sometimes pop up:
+.PP
.CS
\fBexec\fR cmp.bat somefile.c -o somefile
.CE
+.PP
With the file \fIcmp.bat\fR looking something like:
+.PP
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
+.SS "WORKING WITH COMMAND BUILT-INS"
.PP
Sometimes you need to be careful, as different programs may have the
same name and be in the path. It can then happen that typing a command
@@ -403,15 +485,32 @@ differences in behaviour between \fBexec\fR and DOS batch files.
.PP
When in doubt, use the command \fBauto_execok\fR: it will return the
complete path to the program as seen by the \fBexec\fR command. This
-applies especially when you want to run "internal" commands like
+applies especially when you want to run
+.QW internal
+commands like
\fIdir\fR from a Tcl script (if you just want to list filenames, use
the \fBglob\fR command.) To do that, use this:
+.PP
.CS
-\fBexec\fR {expand}[auto_execok dir] *.tcl
+\fBexec\fR {*}[auto_execok dir] *.tcl
+.CE
+.SS "WORKING WITH NATIVE FILENAMES"
+.PP
+Many programs on Windows require filename arguments to be passed in with
+backslashes as pathname separators. This is done with the help of the
+\fBfile nativename\fR command. For example, to make a directory (on NTFS)
+encrypted so that only the current user can access it requires use of
+the \fICIPHER\fR command, like this:
+.PP
+.CS
+set secureDir "~/Desktop/Secure Directory"
+file mkdir $secureDir
+\fBexec\fR CIPHER /e /s:[file nativename $secureDir]
.CE
-
.SH "SEE ALSO"
-error(n), open(n)
-
+error(n), file(n), open(n)
.SH KEYWORDS
execute, pipeline, redirection, subprocess
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/exit.n b/doc/exit.n
index 42dcb23..ab5c87d 100644
--- a/doc/exit.n
+++ b/doc/exit.n
@@ -5,10 +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: exit.n,v 1.6 2004/11/20 00:17:32 dgp Exp $
-'\"
-.so man.macros
.TH exit n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -21,13 +19,15 @@ exit \- End the application
.PP
Terminate the process, returning \fIreturnCode\fR to the
system as the exit status.
-If \fIreturnCode\fR isn't specified then it defaults
+If \fIreturnCode\fR is not specified then it defaults
to 0.
.SH EXAMPLE
+.PP
Since non-zero exit codes are usually interpreted as error cases by
the calling process, the \fBexit\fR command is an important part of
-signalling that something fatal has gone wrong. This code fragment is
+signaling that something fatal has gone wrong. This code fragment is
useful in scripts to act as a general problem trap:
+.PP
.CS
proc main {} {
# ... put the real main code in here ...
@@ -45,9 +45,7 @@ if {[catch {main} msg options]} {
\fBexit\fR 2
}
.CE
-
.SH "SEE ALSO"
exec(n)
-
.SH KEYWORDS
-exit, process
+abort, exit, process
diff --git a/doc/expr.n b/doc/expr.n
index 2fb328c..a595207 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -6,10 +6,8 @@
'\" 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.21 2005/06/09 14:24:06 dkf Exp $
-'\"
-.so man.macros
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,56 +15,61 @@ expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs (adding separator spaces between them),
evaluates the result as a Tcl expression, and returns the value.
-The operators permitted in Tcl expressions are a subset of
-the operators permitted in C expressions, and they have the
-same meaning and precedence as the corresponding C operators.
+The operators permitted in Tcl expressions include a subset of
+the operators permitted in C expressions. For those operators
+common to both Tcl and C, Tcl applies the same meaning and precedence
+as the corresponding C operators.
Expressions almost always yield numeric results
(integer or floating-point values).
For example, the expression
+.PP
.CS
-\fBexpr 8.2 + 6\fR
+\fBexpr\fR 8.2 + 6
.CE
+.PP
evaluates to 14.2.
Tcl expressions differ from C expressions in the way that
operands are specified. Also, Tcl expressions support
-non-numeric operands and string comparisons.
+non-numeric operands and string comparisons, as well as some
+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 octal (if the
-first character of the operand is \fB0\fR), or in hexadecimal (if the first
-two characters of the operand are \fB0x\fR).
+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
+(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
+(if the first two characters of the operand are \fB0x\fR). For
+compatibility with older Tcl releases, an octal integer value is also
+indicated simply when the first character of the operand is \fB0\fR,
+whether or not the second character is also \fBo\fR.
If an operand does not have one of the integer formats given
above, then it is treated as a floating-point number if that is
-possible. Floating-point numbers may be specified in any of the
-ways accepted by an ANSI-compliant C compiler (except that the
-\fBf\fR, \fBF\fR, \fBl\fR, and \fBL\fR suffixes will not be permitted in
-most installations). For example, all of the
+possible. Floating-point numbers may be specified in any of several
+common formats making use of the decimal digits, the decimal point \fB.\fR,
+the characters \fBe\fR or \fBE\fR indicating scientific notation, and
+the sign characters \fB+\fR or \fB\-\fR. For example, all of the
following are valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
+Also recognized as floating point values are the strings \fBInf\fR
+and \fBNaN\fR making use of any case for each character.
If no numeric interpretation is possible (note that all literal
operands that are not numeric or boolean must be quoted with either
braces or with double quotes), then an operand is left as a string
(and only a limited set of operators may be applied to it).
.PP
-On 32-bit systems, integer values MAX_INT (0x7FFFFFFF) and MIN_INT
-(-0x80000000) will be represented as 32-bit values, and integer values
-outside that range will be represented as 64-bit values (if that is
-possible at all.)
-.PP
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.
@@ -85,9 +88,9 @@ The command will be executed and its result will be used as
the operand.
.IP [7]
As a mathematical function whose arguments have any of the above
-forms for operands, such as \fBsin($x)\fR. See MATH FUNCTIONS below for
+forms for operands, such as \fBsin($x)\fR. See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
-.LP
+.PP
Where the above substitutions occur (e.g. inside quoted strings), they
are performed by the expression's instructions.
However, the command parser may already have performed one round of
@@ -101,150 +104,216 @@ For some examples of simple expressions, suppose the variable
the variable \fBb\fR has the value 6.
Then the command on the left side of each of the lines below
will produce the value on the right side of the line:
+.PP
.CS
.ta 6c
-\fBexpr 3.1 + $a 6.1
-expr 2 + "$a.$b" 5.6
-expr 4*[llength "6 2"] 8
-expr {{word one} < "word $a"} 0\fR
+\fBexpr\fR 3.1 + $a \fI6.1\fR
+\fBexpr\fR 2 + "$a.$b" \fI5.6\fR
+\fBexpr\fR 4*[llength "6 2"] \fI8\fR
+\fBexpr\fR {{word one} < "word $a"} \fI0\fR
.CE
.SS OPERATORS
.PP
-The valid operators are listed below, grouped in decreasing order
-of precedence:
+The valid operators (most of which are also available as commands in
+the \fBtcl::mathop\fR namespace; see the \fBmathop\fR(n) manual page
+for details) are listed below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
+.
Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operators
may be applied to string operands, and bit-wise NOT may be
applied only to integers.
.TP 20
\fB**\fR
-.VS 8.5
+.
Exponentiation. Valid for any numeric operands.
-.VE 8.5
.TP 20
\fB*\0\0/\0\0%\fR
+.
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
+.
Add and subtract. Valid for any numeric operands.
.TP 20
\fB<<\0\0>>\fR
+.
Left and right shift. Valid for integer operands only.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
+.
Boolean less, greater, less than or equal, and greater than or equal.
Each operator produces 1 if the condition is true, 0 otherwise.
These operators may be applied to strings as well as numeric operands,
in which case string comparison is used.
.TP 20
\fB==\0\0!=\fR
+.
Boolean equal and not equal. Each operator produces a zero/one result.
Valid for all operand types.
.TP 20
\fBeq\0\0ne\fR
+.
Boolean string equal and string not equal. Each operator produces a
zero/one result. The operand types are interpreted only as strings.
.TP 20
\fBin\0\0ni\fR
-.VS 8.5
+.
List containment and negated list containment. Each operator produces
a zero/one result and treats its first argument as a string and its
second argument as a Tcl list. The \fBin\fR operator indicates
whether the first argument is a member of the second argument list;
the \fBni\fR operator inverts the sense of the result.
-.VE 8.5
.TP 20
\fB&\fR
+.
Bit-wise AND. Valid for integer operands only.
.TP 20
\fB^\fR
+.
Bit-wise exclusive OR. Valid for integer operands only.
.TP 20
\fB|\fR
+.
Bit-wise OR. Valid for integer operands only.
.TP 20
\fB&&\fR
+.
Logical AND. Produces a 1 result if both operands are non-zero,
0 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
.TP 20
\fB||\fR
+.
Logical OR. Produces a 0 result if both operands are zero, 1 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
.TP 20
\fIx\fB?\fIy\fB:\fIz\fR
+.
If-then-else, as in C. If \fIx\fR
evaluates to non-zero, then the result is the value of \fIy\fR.
Otherwise the result is the value of \fIz\fR.
The \fIx\fR operand must have a boolean or numeric value.
-.LP
+.PP
See the C manual for more details on the results
produced by each operator.
-.VS 8.5
The exponentiation operator promotes types like the multiply and
divide operators, and produces a result that is the same as the output
of the \fBpow\fR function (after any type conversions.)
-.VE 8.5
-All of the binary operators group left-to-right within the same
-precedence level. For example, the command
+All of the binary operators but exponentiation group left-to-right
+within the same precedence level; exponentiation groups right-to-left. For example, the command
+.PP
.CS
-\fBexpr 4*2 < 7\fR
+\fBexpr\fR {4*2 < 7}
.CE
-returns 0.
.PP
-The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have ``lazy
-evaluation'', just as in C,
-which means that operands are not evaluated if they are
+returns 0, while
+.PP
+.CS
+\fBexpr\fR {2**3**2}
+.CE
+.PP
+returns 512.
+.PP
+The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
+.QW "lazy evaluation" ,
+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
-only one of \fB[a]\fR or \fB[b]\fR will actually be evaluated,
+.PP
+only one of
+.QW \fB[a]\fR
+or
+.QW \fB[b]\fR
+will actually be evaluated,
depending on the value of \fB$v\fR. Note, however, that this is
only true if the entire expression is enclosed in braces; otherwise
-the Tcl parser will evaluate both \fB[a]\fR and \fB[b]\fR before
-invoking the \fBexpr\fR command.
+the Tcl parser will evaluate both
+.QW \fB[a]\fR
+and
+.QW \fB[b]\fR
+before invoking the \fBexpr\fR command.
.SS "MATH FUNCTIONS"
.PP
-.VS 8.5
When the expression parser encounters a mathematical function
such as \fBsin($x)\fR, it replaces it with a call to an ordinary
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
+tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
+.CE
+.PP
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
rules for resolving functions in namespaces. Either
\fB::tcl::mathfunc::sin\fR or \fB[namespace
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.
-.VE 8.5
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
-All internal computations involving integers are done with the C type
-\fIlong\fR, and all internal computations involving floating-point are
+All internal computations involving integers are done calling on the
+LibTomMath multiple precision integer library as required so that all
+integer calculations are performed exactly. Note that in Tcl releases
+prior to 8.5, integer calculations were performed with one of the C types
+\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
+in those calculations where values overflowed the range of those types.
+Any code that relied on these implicit truncations will need to explicitly
+add \fBint()\fR or \fBwide()\fR function calls to expressions at the points
+where such truncation is required to take place.
+.PP
+All internal computations involving floating-point are
done with the C type \fIdouble\fR.
When converting a string to floating-point, exponent overflow is
-detected and results in a Tcl error.
-For conversion to integer from string, detection of overflow depends
-on the behavior of some routines in the local C library, so it should
-be regarded as unreliable.
-In any case, integer overflow and underflow are generally not detected
-reliably for intermediate results. Floating-point overflow and underflow
+detected and results in the \fIdouble\fR value of \fBInf\fR or
+\fB\-Inf\fR as appropriate. Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
pretty reliable.
.PP
@@ -253,44 +322,56 @@ and string operands is done automatically as needed.
For arithmetic computations, integers are used until some
floating-point number is introduced, after which floating-point is used.
For example,
+.PP
.CS
-\fBexpr 5 / 4\fR
+\fBexpr\fR {5 / 4}
.CE
+.PP
returns 1, while
+.PP
.CS
-\fBexpr 5 / 4.0\fR
-\fBexpr 5 / ( [string length "abcd"] + 0.0 )\fR
+\fBexpr\fR {5 / 4.0}
+\fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )}
.CE
+.PP
both return 1.25.
-Floating-point values are always returned with a ``\fB.\fR''
-or an \fBe\fR so that they will not look like integer values. For
-example,
+Floating-point values are always returned with a
+.QW \fB.\fR
+or an
+.QW \fBe\fR
+so that they will not look like integer values. For example,
+.PP
.CS
-\fBexpr 20.0/5.0\fR
+\fBexpr\fR {20.0/5.0}
.CE
+.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
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, the numeric operand is converted back to
-a string using the C \fIsprintf\fR format specifier
-\fB%d\fR for integers and \fB%g\fR for floating-point values.
-For example, the commands
+has a numeric value, a canonical string representation of the numeric
+operand value is generated to compare with the string operand.
+Canonical string representation for integer values is a decimal string
+format. Canonical string representation for floating-point values
+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 isn't generally a good idea to use operators like \fB==\fR
+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
-operands could be arbitrary; it's better in these cases to use
+operands could be arbitrary; it is better in these cases to use
the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
@@ -301,11 +382,13 @@ This allows the Tcl bytecode compiler to generate the best code.
As mentioned above, expressions are substituted twice:
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.
This is because the Tcl parser will first substitute \fB$a + 2\fR for
the variable \fBb\fR,
@@ -314,7 +397,7 @@ then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
their variable and command substitutions yield numbers or strings
-that don't themselves require substitutions.
+that do not themselves require substitutions.
However, because a few unbraced expressions
need two rounds of substitutions,
the bytecode compiler must emit
@@ -323,9 +406,15 @@ The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
+When the expression is unbraced to allow the substitution of a function or
+operator, consider using the commands documented in the \fBmathfunc\fR(n) or
+\fBmathop\fR(n) manual pages directly instead.
.SH EXAMPLES
-Define a procedure that computes an "interesting" mathematical
-function:
+.PP
+Define a procedure that computes an
+.QW interesting
+mathematical function:
+.PP
.CS
proc tcl::mathfunc::calc {x y} {
\fBexpr\fR { ($x**2 - $y**2) / exp($x**2 + $y**2) }
@@ -333,6 +422,7 @@ proc tcl::mathfunc::calc {x y} {
.CE
.PP
Convert polar coordinates into cartesian coordinates:
+.PP
.CS
# convert from ($radius,$angle)
set x [\fBexpr\fR { $radius * cos($angle) }]
@@ -340,6 +430,7 @@ set y [\fBexpr\fR { $radius * sin($angle) }]
.CE
.PP
Convert cartesian coordinates into polar coordinates:
+.PP
.CS
# convert from ($x,$y)
set radius [\fBexpr\fR { hypot($y, $x) }]
@@ -348,12 +439,14 @@ set angle [\fBexpr\fR { atan2($y, $x) }]
.PP
Print a message describing the relationship of two string values to
each other:
+.PP
.CS
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable to whether an environment variable is both defined at
all and also set to a true boolean value:
+.PP
.CS
set isTrue [\fBexpr\fR {
[info exists ::env(SOME_ENV_VAR)] &&
@@ -362,19 +455,21 @@ set isTrue [\fBexpr\fR {
.CE
.PP
Generate a random integer in the range 0..99 inclusive:
+.PP
.CS
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
-
.SH "SEE ALSO"
-array(n), for(n), if(n), mathfunc(n), namespace(n), proc(n), string(n), Tcl(n), while(n)
-
+array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
+string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison
-
.SH COPYRIGHT
+.nf
Copyright (c) 1993 The Regents of the University of California.
-.br
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
-.br
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 5b5efac..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.8 2005/05/10 18:33:59 kennykb 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!
@@ -63,9 +61,7 @@ proc echoLine {chan clientName} {
socket -server connect 12345
vwait forever
.CE
-
.SH "SEE ALSO"
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
blocking, nonblocking
diff --git a/doc/fconfigure.n b/doc/fconfigure.n
index 10e5fb1..ca23314 100644
--- a/doc/fconfigure.n
+++ b/doc/fconfigure.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.
'\"
-'\" RCS: @(#) $Id: fconfigure.n,v 1.13 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH fconfigure n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -41,7 +39,8 @@ 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 example, see the manual
-entry for the \fBsocket\fR command for its additional options.
+entry for the \fBsocket\fR command for additional options for sockets, and
+the \fBopen\fR command for additional options for serial devices.
.TP
\fB\-blocking\fR \fIboolean\fR
The \fB\-blocking\fR option determines whether I/O operations on the
@@ -49,7 +48,8 @@ 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 affect the operation of the \fBgets\fR,
-\fBread\fR, \fBputs\fR, \fBflush\fR, and \fBclose\fR commands;
+\fBread\fR, \fBputs\fR, \fBflush\fR, and \fBclose\fR commands by
+allowing them to operate asynchronously;
see the documentation for those commands for details.
For nonblocking mode to work correctly, the application must be
using the Tcl event loop (e.g. by calling \fBTcl_DoOneEvent\fR or
@@ -72,8 +72,8 @@ initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
.
\fINewvalue\fR must be an integer; its value is used to set the size of
buffers, in bytes, subsequently allocated for this channel to store input
-or output. \fINewvalue\fR must be between ten and one million, allowing
-buffers of ten to one million bytes in size.
+or output. \fINewvalue\fR must be between one and one million, allowing
+buffers of one to one million bytes in size.
.TP
\fB\-encoding\fR \fIname\fR
.
@@ -119,6 +119,9 @@ channel, a two-element list will always be returned. The default value
for \fB\-eofchar\fR is the empty string in all cases except for files
under Windows. In that case the \fB\-eofchar\fR is Control-z (\ex1a) for
reading and the empty string for writing.
+The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
+attempting to set \fB\-eofchar\fR to a value outside of this range will
+generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
@@ -129,11 +132,11 @@ newline character (\en). However, in actual files and devices the end of
a line may be represented differently on different platforms, or even for
different devices on the same platform. For example, under UNIX newlines
are used in files, whereas carriage-return-linefeed sequences are
-normally used in network connections. On input (i.e., with \fBgets\fP
-and \fBread\fP) the Tcl I/O system automatically translates the external
+normally used in network connections. On input (i.e., with \fBgets\fR
+and \fBread\fR) the Tcl I/O system automatically translates the external
end-of-line representation into newline characters. Upon output (i.e.,
-with \fBputs\fP), the I/O system translates newlines to the external
-end-of-line representation. The default translation mode, \fBauto\fP,
+with \fBputs\fR), the I/O system translates newlines to the external
+end-of-line representation. The default translation mode, \fBauto\fR,
handles all the common cases automatically, but the \fB\-translation\fR
option provides explicit control over the end of line translations.
.RS
@@ -151,8 +154,8 @@ currently supported:
\fBauto\fR
.
As the input translation mode, \fBauto\fR treats any of newline
-(\fBlf\fP), carriage return (\fBcr\fP), or carriage return followed by a
-newline (\fBcrlf\fP) as the end of line representation. The end of line
+(\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by a
+newline (\fBcrlf\fR) as the end of line representation. The end of line
representation can even change from line-to-line, and all cases are
translated to a newline. As the output translation mode, \fBauto\fR
chooses a platform specific representation; for sockets on all platforms
@@ -163,26 +166,33 @@ setting for \fB\-translation\fR is \fBauto\fR for both input and output.
\fBbinary\fR
.
No end-of-line translations are performed. This is nearly identical to
-\fBlf\fP mode, except that in addition \fBbinary\fP mode also sets the
+\fBlf\fR mode, except that in addition \fBbinary\fR mode also sets the
end-of-file character to the empty string (which disables it) and sets the
encoding to \fBbinary\fR (which disables encoding filtering). See the
description of \fB\-eofchar\fR and \fB\-encoding\fR for more information.
+.RS
+.PP
+Internally, i.e. when it comes to the actual behaviour of the
+translator this value \fBis\fR identical to \fBlf\fR and is therefore
+reported as such when queried. Even if \fBbinary\fR was used to set
+the translation.
+.RE
.TP
\fBcr\fR
.
The end of a line in the underlying file or device is represented by a
single carriage return character. As the input translation mode,
-\fBcr\fP mode converts carriage returns to newline characters. As the
-output translation mode, \fBcr\fP mode translates newline characters to
+\fBcr\fR mode converts carriage returns to newline characters. As the
+output translation mode, \fBcr\fR mode translates newline characters to
carriage returns.
.TP
\fBcrlf\fR
.
The end of a line in the underlying file or device is represented by a
carriage return character followed by a linefeed character. As the input
-translation mode, \fBcrlf\fP mode converts carriage-return-linefeed
+translation mode, \fBcrlf\fR mode converts carriage-return-linefeed
sequences to newline characters. As the output translation mode,
-\fBcrlf\fP mode translates newline characters to carriage-return-linefeed
+\fBcrlf\fR mode translates newline characters to carriage-return-linefeed
sequences. This mode is typically used on Windows platforms and for
network connections.
.TP
@@ -204,34 +214,38 @@ If, for example, a Tcl application is started by the \fBinet\fR
super-server common on Unix system its Tcl standard channels will be
sockets and thus support the socket options.
.SH EXAMPLES
+.PP
Instruct Tcl to always send output to \fBstdout\fR immediately,
whether or not it is to a terminal:
+.PP
.CS
\fBfconfigure\fR stdout -buffering none
.CE
.PP
Open a socket and read lines from it without ever blocking the
processing of other events:
+.PP
.CS
set s [socket some.where.com 12345]
\fBfconfigure\fR $s -blocking 0
fileevent $s readable "readMe $s"
proc readMe chan {
- if {[gets $chan line] < 0} {
- if {[eof $chan]} {
- close $chan
- return
- }
- # Could not read a complete line this time; Tcl's
- # internal buffering will hold the partial line for us
- # until some more data is available over the socket.
- } else {
- puts stdout $line
- }
+ if {[gets $chan line] < 0} {
+ if {[eof $chan]} {
+ close $chan
+ return
+ }
+ # Could not read a complete line this time; Tcl's
+ # internal buffering will hold the partial line for us
+ # until some more data is available over the socket.
+ } else {
+ puts stdout $line
+ }
}
.CE
.PP
Read a PPM-format image from a file:
+.PP
.CS
# Open the file and put it into Unix ASCII mode
set f [open teapot.ppm]
@@ -239,16 +253,16 @@ set f [open teapot.ppm]
# Get the header
if {[gets $f] ne "P6"} {
- error "not a raw\-bits PPM"
+ error "not a raw\-bits PPM"
}
# Read lines until we have got non-comment lines
# that supply us with three decimal values.
set words {}
while {[llength $words] < 3} {
- gets $f line
- if {[string match "#*" $line]} continue
- lappend words {expand}[join [scan $line %d%d%d]]
+ gets $f line
+ if {[string match "#*" $line]} continue
+ lappend words {*}[join [scan $line %d%d%d]]
}
# Those words supply the size of the image and its
@@ -263,12 +277,13 @@ set data [read $f $numDataBytes]
close $f
.CE
-
.SH "SEE ALSO"
close(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n),
Tcl_StandardChannels(3)
-
.SH KEYWORDS
blocking, buffering, carriage return, end of line, flushing, linemode,
newline, nonblocking, platform, translation, encoding, filter, byte array,
binary
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/fcopy.n b/doc/fcopy.n
index de74d3c..071896c 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -5,10 +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: fcopy.n,v 1.6 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,47 +17,52 @@ fcopy \- Copy data from one channel to another
.SH DESCRIPTION
.PP
-The \fBfcopy\fP command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.
-The \fBfcopy\fP command leverages the buffering in the Tcl I/O system to
+The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.
+The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
-The \fBfcopy\fP
+The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
-or \fIsize\fP bytes have been
-transferred. If no \fB\-size\fP argument is given,
+or \fIsize\fR bytes have been
+transferred. If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
-Without the \fB\-command\fP option, \fBfcopy\fP blocks until the copy is complete
+Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
and returns the number of bytes written to \fIoutchan\fR.
.PP
-The \fB\-command\fP argument makes \fBfcopy\fP work in the background.
-In this case it returns immediately and the \fIcallback\fP is invoked
+The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
+In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
-The \fIcallback\fP is called with
+The \fIcallback\fR is called with
one or two additional
arguments that indicates how many bytes were written to \fIoutchan\fR.
If an error occurred during the background copy, the second argument is the
error string associated with the error.
With a background copy,
it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
-non-blocking mode; the \fBfcopy\fP command takes care of that automatically.
+non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
-the \fBvwait\fP command or by using Tk.
+the \fBvwait\fR command or by using Tk.
+.PP
+You are not allowed to do other input operations with \fIinchan\fR, or
+output operations with \fIoutchan\fR, during a background
+\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
+bidirectional fcopy example below.
.PP
-You are not allowed to do other I/O operations with
-\fIinchan\fR or \fIoutchan\fR during a background fcopy.
If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
-and the command callback is \fInot\fP made.
+and the command callback is \fInot\fR made.
If \fIinchan\fR is closed,
then all data already queued for \fIoutchan\fR is written out.
.PP
Note that \fIinchan\fR can become readable during a background copy.
-You should turn off any \fBfileevent\fP handlers during a background
+You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.
-Any I/O attempted by a \fBfileevent\fP handler will get a "channel busy" error.
+Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
+.QW "channel busy"
+error.
.PP
\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
according to the \fB\-translation\fR option
@@ -69,8 +72,8 @@ See the manual entry for \fBfconfigure\fR for details on the
The translations mean that the number of bytes read from \fIinchan\fR
can be different than the number of bytes written to \fIoutchan\fR.
Only the number of bytes written to \fIoutchan\fR is reported,
-either as the return value of a synchronous \fBfcopy\fP or
-as the argument to the callback for an asynchronous \fBfcopy\fP.
+either as the return value of a synchronous \fBfcopy\fR or
+as the argument to the callback for an asynchronous \fBfcopy\fR.
.PP
\fBFcopy\fR obeys the encodings and character translations configured
for the channels. This
@@ -79,73 +82,95 @@ UTF-8 and then into the encoding of the channel \fBfcopy\fR writes
to. See the manual entry for \fBfconfigure\fR for details on the
\fB\-encoding\fR and \fB\-translation\fR options. No conversion is
done if both channels are
-set to encoding "binary" and have matching translations. If only the
-output channel is set to
-encoding "binary" the system will write the internal UTF-8
-representation of the incoming characters. If only the input channel
-is set to encoding "binary" the system will assume that the incoming
+set to encoding
+.QW binary
+and have matching translations. If only the output channel is set to encoding
+.QW binary
+the system will write the internal UTF-8 representation of the incoming
+characters. If only the input channel is set to encoding
+.QW binary
+the system will assume that the incoming
bytes are valid UTF-8 characters and convert them according to the
output encoding. The behaviour of the system for bytes which are not
valid UTF-8 characters is undefined in this case.
-
.SH EXAMPLES
.PP
The first example transfers the contents of one channel exactly to
another. Note that when copying one file to another, it is better to
use \fBfile copy\fR which also copies file metadata (e.g. the file
access permissions) where possible.
-.DS
+.PP
+.CS
fconfigure $in -translation binary
fconfigure $out -translation binary
\fBfcopy\fR $in $out
-.DE
+.CE
.PP
This second example shows how the callback gets
passed the number of bytes transferred.
It also uses vwait to put the application into the event loop.
Of course, this simplified example could be done without the command
callback.
-.DS
+.PP
+.CS
proc Cleanup {in out bytes {error {}}} {
global total
set total $bytes
close $in
close $out
if {[string length $error] != 0} {
- # error occurred during the copy
+ # error occurred during the copy
}
}
set in [open $file1]
set out [socket $server $port]
\fBfcopy\fR $in $out -command [list Cleanup $in $out]
vwait total
-.DE
+.CE
.PP
The third example copies in chunks and tests for end of file
-in the command callback
-.DS
+in the command callback.
+.PP
+.CS
proc CopyMore {in out chunk bytes {error {}}} {
global total done
incr total $bytes
- if {([string length $error] != 0) || [eof $in] {
- set done $total
- close $in
- close $out
+ if {([string length $error] != 0) || [eof $in]} {
+ set done $total
+ close $in
+ close $out
} else {
- \fBfcopy\fR $in $out -command [list CopyMore $in $out $chunk] \\
- -size $chunk
+ \fBfcopy\fR $in $out -size $chunk \e
+ -command [list CopyMore $in $out $chunk]
}
}
set in [open $file1]
set out [socket $server $port]
set chunk 1024
set total 0
-\fBfcopy\fR $in $out -command [list CopyMore $in $out $chunk] -size $chunk
+\fBfcopy\fR $in $out -size $chunk \e
+ -command [list CopyMore $in $out $chunk]
vwait done
-.DE
-
+.CE
+.PP
+The fourth example starts an asynchronous, bidirectional fcopy between
+two sockets. Those could also be pipes from two [open "|hal 9000" r+]
+(though their conversation would remain secret to the script, since
+all four fileevent slots are busy).
+.PP
+.CS
+set flows 2
+proc Done {dir args} {
+ global flows done
+ puts "$dir is over."
+ incr flows -1
+ if {$flows<=0} {set done 1}
+}
+\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
+\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
+vwait done
+.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
-
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation
diff --git a/doc/file.n b/doc/file.n
index c3c975a..5ff45fd 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -5,10 +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: file.n,v 1.40 2005/05/10 18:33:59 kennykb Exp $
-'\"
-.so man.macros
.TH file n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ file \- Manipulate file names and attributes
.SH SYNOPSIS
\fBfile \fIoption\fR \fIname\fR ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command provides several operations on a file's name or attributes.
@@ -32,7 +29,7 @@ Returns a decimal string giving the time at which file \fIname\fR was last
accessed. If \fItime\fR is specified, it is an access time to set
for the file. The time is measured in the standard POSIX fashion as
seconds from a fixed starting time (often January 1, 1970). If the file
-doesn't exist or its access time cannot be queried or set then an error is
+does not exist or its access time cannot be queried or set then an error is
generated. On Windows, FAT file systems do not support access time.
.TP
\fBfile attributes \fIname\fR
@@ -40,18 +37,19 @@ generated. On Windows, FAT file systems do not support access time.
\fBfile attributes \fIname\fR ?\fBoption\fR?
.TP
\fBfile attributes \fIname\fR ?\fBoption value option value...\fR?
-.RS
+.
This subcommand returns or sets platform specific values associated
with a file. The first form returns a list of the platform specific
flags and their values. The second form returns the value for the
specific option. The third form sets one or more of the values. The
values are as follows:
+.RS
.PP
-On Unix, \fB-group\fR gets or sets the group name for the file. A group id
-can be given to the command, but it returns a group name. \fB-owner\fR gets
+On Unix, \fB\-group\fR gets or sets the group name for the file. A group id
+can be given to the command, but it returns a group name. \fB\-owner\fR gets
or sets the user name of the owner of the file. The command returns the
owner name, but the numerical id can be passed when setting the
-owner. \fB-permissions\fR sets or retrieves the octal code that chmod(1)
+owner. \fB\-permissions\fR sets or retrieves the octal code that chmod(1)
uses. This command does also has limited support for setting using the
symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],
where multiple symbolic attributes can be separated by commas (example:
@@ -59,24 +57,24 @@ where multiple symbolic attributes can be separated by commas (example:
permissions for group and other). A simplified \fBls\fR style string,
of the form rwxrwxrwx (must be 9 characters), is also supported
(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
-On versions of Unix supporting file flags, \fB-readonly\fR gives the
+On versions of Unix supporting file flags, \fB\-readonly\fR gives the
value or sets or clears the readonly attribute of the file,
i.e. the user immutable flag \fBuchg\fR to chflags(1).
.PP
-On Windows, \fB-archive\fR gives the value or sets or clears the
-archive attribute of the file. \fB-hidden\fR gives the value or sets
-or clears the hidden attribute of the file. \fB-longname\fR will
+On Windows, \fB\-archive\fR gives the value or sets or clears the
+archive attribute of the file. \fB\-hidden\fR gives the value or sets
+or clears the hidden attribute of the file. \fB\-longname\fR will
expand each path element to its long version. This attribute cannot be
-set. \fB-readonly\fR gives the value or sets or clears the readonly
-attribute of the file. \fB-shortname\fR gives a string where every
+set. \fB\-readonly\fR gives the value or sets or clears the readonly
+attribute of the file. \fB\-shortname\fR gives a string where every
path element is replaced with its short (8.3) version of the
-name. This attribute cannot be set. \fB-system\fR gives or sets or
+name. This attribute cannot be set. \fB\-system\fR gives or sets or
clears the value of the system attribute of the file.
.PP
-On Mac OS X and Darwin, \fB-creator\fR gives or sets the
-Finder creator type of the file. \fB-hidden\fR gives or sets or clears
-the hidden attribute of the file. \fB-readonly\fR gives or sets or
-clears the readonly attribute of the file. \fB-rsrclength\fR gives
+On Mac OS X and Darwin, \fB\-creator\fR gives or sets the
+Finder creator type of the file. \fB\-hidden\fR gives or sets or clears
+the hidden attribute of the file. \fB\-readonly\fR gives or sets or
+clears the readonly attribute of the file. \fB\-rsrclength\fR gives
the length of the resource fork of the file, this attribute can only be
set to the value 0, which results in the resource fork being stripped
off the file.
@@ -84,7 +82,7 @@ off the file.
.TP
\fBfile channels ?\fIpattern\fR?
.
-If \fIpattern\fR isn't specified, returns a list of names of all
+If \fIpattern\fR is not specified, returns a list of names of all
registered open channels in this interpreter. If \fIpattern\fR is
specified, only those names matching \fIpattern\fR are returned. Matching
is determined using the same rules as for \fBstring match\fR.
@@ -92,7 +90,7 @@ is determined using the same rules as for \fBstring match\fR.
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
.TP
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR
-.RS
+.
The first form makes a copy of the file or directory \fIsource\fR under
the pathname \fItarget\fR. If \fItarget\fR is an existing directory,
then the second form is used. The second form makes a copy inside
@@ -106,13 +104,12 @@ 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.
-.RE
.TP
-\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?
+\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? ?\fIpathname\fR ... ?
.
Removes the file or directory specified by each \fIpathname\fR
argument. Non-empty directories will be removed only if the
@@ -122,9 +119,11 @@ Trying to delete a non-existent file is not considered an error.
Trying to delete a read-only file will cause the file to be deleted,
even if the \fB\-force\fR flags is not specified. If the \fB\-force\fR
option is specified on a directory, Tcl will attempt both to change
-permissions and move the current directory 'pwd' out of the given path
-if that is necessary to allow the deletion to proceed. Arguments are
-processed in the order specified, halting at the first error, if any.
+permissions and move the current directory
+.QW pwd
+out of the given path if that is necessary to allow the deletion to
+proceed. 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 \fIpathname\fR even if it starts with
a \fB\-\fR.
@@ -132,24 +131,31 @@ a \fB\-\fR.
\fBfile dirname \fIname\fR
Returns a name comprised of all of the path components in \fIname\fR
excluding the last element. If \fIname\fR is a relative file name and
-only contains one path element, then returns ``\fB.\fR''. If \fIname\fR
-refers to a root directory, then the root directory is returned. For
-example,
+only contains one path element, then returns
+.QW \fB.\fR .
+If \fIname\fR refers to a root directory, then the root directory is
+returned. For example,
.RS
+.PP
.CS
-\fBfile dirname c:/\fR
+\fBfile dirname\fR c:/
.CE
+.PP
returns \fBc:/\fR.
.PP
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).
.RE
.TP
@@ -185,9 +191,11 @@ relative, then it will be joined to the previous file name argument.
Otherwise, any earlier arguments will be discarded, and joining will
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.
.PP
Note that any of the names can contain separators, and that the result
@@ -195,36 +203,42 @@ is always canonical for the current platform: \fB/\fR for Unix and
Windows.
.RE
.TP
-\fBfile link ?\fI-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
+\fBfile link ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
.
If only one argument is given, that argument is assumed to be
\fIlinkName\fR, and this command returns the value of the link given by
\fIlinkName\fR (i.e. the name of the file it points to). If
-\fIlinkName\fR isn't a link or its value cannot be read (as, for example,
+\fIlinkName\fR is not a link or its value cannot be read (as, for example,
seems to be the case with hard links, which look just like ordinary
files), then an error is returned.
-.
+.RS
+.PP
If 2 arguments are given, then these are assumed to be \fIlinkName\fR
and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR
-doesn't exist, an error will be returned. Otherwise, Tcl creates a new
+does not exist, an error will be returned. Otherwise, Tcl creates a new
link called \fIlinkName\fR which points to the existing filesystem
object at \fItarget\fR (which is also the returned value), where the
type of the link is platform-specific (on Unix a symbolic link will be
the default). This is useful for the case where the user wishes to
-create a link in a cross-platform way, and doesn't care what type of
+create a link in a cross-platform way, and does not care what type of
link is created.
-.
+.PP
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 "-symbolic" and "-hard".
-.
+\fI\-linktype\fR argument should be given. Accepted values for
+\fI\-linktype\fR are
+.QW \fB\-symbolic\fR
+and
+.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
cwd), but on all other platforms where relative links are not supported,
target paths will always be converted to absolute, normalized form
before the link is created (and therefore relative paths are interpreted
-as relative to the cwd). Furthermore, "~user" paths are always expanded
+as relative to the cwd). Furthermore,
+.QW ~user
+paths are always expanded
to absolute form. When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned. In particular Windows 95, 98 and ME do
@@ -232,6 +246,7 @@ not support any links at present, but most Unix platforms support both
symbolic and hard links (the latter for files only) and Windows
NT/2000/XP (on NTFS drives) support symbolic
directory links and hard file links.
+.RE
.TP
\fBfile lstat \fIname varName\fR
.
@@ -239,10 +254,10 @@ Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
kernel call instead of \fIstat\fR. This means that if \fIname\fR
refers to a symbolic link the information returned in \fIvarName\fR
is for the link rather than the file it refers to. On systems that
-don't support symbolic links this option behaves exactly the same
+do not support symbolic links this option behaves exactly the same
as the \fBstat\fR option.
.TP
-\fBfile mkdir \fIdir\fR ?\fIdir\fR ...?
+\fBfile mkdir ?\fIdir\fR ...?
.
Creates each directory specified. For each pathname \fIdir\fR specified,
this command will create all non-existing parent directories as
@@ -257,32 +272,35 @@ Returns a decimal string giving the time at which file \fIname\fR was last
modified. If \fItime\fR is specified, it is a modification time to set for
the file (equivalent to Unix \fBtouch\fR). The time is measured in the
standard POSIX fashion as seconds from a fixed starting time (often January
-1, 1970). If the file doesn't exist or its modified time cannot be queried
+1, 1970). If the file does not exist or its modified time cannot be queried
or set then an error is generated.
.TP
\fBfile nativename \fIname\fR
.
Returns the platform-specific name of the file. This is useful if the
-filename is needed to pass to a platform-specific call, such as exec
-under Windows.
+filename is needed to pass to a platform-specific call, such as to a
+subprocess via \fBexec\fR under Windows (see \fBEXAMPLES\fR below).
.TP
\fBfile normalize \fIname\fR
.
-.RS
Returns a unique normalized path representation for the file-system
object (file, directory, link, etc), whose string value can be used as a
unique identifier for it. A normalized path is an absolute path which has
-all '../', './' removed. Also it is one which is in the ``standard''
+all
+.QW ../
+and
+.QW ./
+removed. Also it is one which is in the
+.QW standard
format for the native platform. On Unix, this means the segments
leading up to the path must be free of symbolic links/aliases (but the
very last path component may be a symbolic link), and on Windows it also
means we want the long form with that form's case-dependence (which
gives us a unique, case-dependent path). The one exception concerning the
last link in the path is necessary, because Tcl or the user may wish to
-operate on the actual symbolic link itself (for example 'file delete', 'file
-rename', 'file copy' are defined to operate on symbolic links, not on the
-things that they point to).
-.RE
+operate on the actual symbolic link itself (for example \fBfile delete\fR,
+\fBfile rename\fR, \fBfile copy\fR are defined to operate on symbolic
+links, not on the things that they point to).
.TP
\fBfile owned \fIname\fR
.
@@ -291,13 +309,13 @@ otherwise.
.TP
\fBfile pathtype \fIname\fR
.
-Returns one of \fBabsolute\fR, \fBrelative\fR, \fBvolumerelative\fR. If
-\fIname\fR refers to a specific file on a specific volume, the path type
-will be \fBabsolute\fR. If \fIname\fR refers to a file relative to the
-current working directory, then the path type will be \fBrelative\fR. If
-\fIname\fR refers to a file relative to the current working directory on
-a specified volume, or to a specific file on the current working volume, then
-the file type is \fBvolumerelative\fR.
+Returns one of \fBabsolute\fR, \fBrelative\fR, \fBvolumerelative\fR. If
+\fIname\fR refers to a specific file on a specific volume, the path type will
+be \fBabsolute\fR. If \fIname\fR refers to a file relative to the current
+working directory, then the path type will be \fBrelative\fR. If \fIname\fR
+refers to a file relative to the current working directory on a specified
+volume, or to a specific file on the current working volume, then the path
+type is \fBvolumerelative\fR.
.TP
\fBfile readable \fIname\fR
.
@@ -307,14 +325,14 @@ Returns \fB1\fR if file \fIname\fR is readable by the current user,
\fBfile readlink \fIname\fR
.
Returns the value of the symbolic link given by \fIname\fR (i.e. the name
-of the file it points to). If \fIname\fR isn't a symbolic link or its
-value cannot be read, then an error is returned. On systems that don't
+of the file it points to). If \fIname\fR is not a symbolic link or its
+value cannot be read, then an error is returned. On systems that do not
support symbolic links this option is undefined.
.TP
\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
.TP
\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR
-.RS
+.
The first form takes the file or directory specified by pathname
\fIsource\fR and renames it to \fItarget\fR, moving the file if the
pathname \fItarget\fR specifies a name in a different directory. If
@@ -329,13 +347,14 @@ result in errors. 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.
-.RE
.TP
\fBfile rootname \fIname\fR
.
Returns all of the characters in \fIname\fR up to but not including the
-last ``.'' character in the last component of name. If the last
-component of \fIname\fR doesn't contain a dot, then returns \fIname\fR.
+last
+.QW .
+character in the last component of name. If the last
+component of \fIname\fR does not contain a dot, then returns \fIname\fR.
.TP
\fBfile separator\fR ?\fIname\fR?
.
@@ -348,7 +367,7 @@ is generated.
\fBfile size \fIname\fR
.
Returns a decimal string giving the size of file \fIname\fR in bytes. If
-the file doesn't exist or its size cannot be queried then an error is
+the file does not exist or its size cannot be queried then an error is
generated.
.TP
\fBfile split \fIname\fR
@@ -356,13 +375,17 @@ 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
-returns \fB/\0\0foo\0\0./~bar\0\0baz\fR to ensure that later commands
+.PP
+returns
+.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
+to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
@@ -388,12 +411,19 @@ the filesystem to use for the file, and the second, if given, an
arbitrary string representing the filesystem-specific nature or type of
the location within that filesystem. If a filesystem only supports one
type of file, the second element may not be supplied. For example the
-native files have a first element 'native', and a second element which
-when given is a platform-specific type name for the file's system
-(e.g. 'NTFS', 'FAT', on Windows). A generic virtual file system might return
-the list 'vfs ftp' to represent a file on a remote ftp site mounted as a
-virtual filesystem through an extension called 'vfs'. If the file does
-not belong to any filesystem, an error is generated.
+native files have a first element
+.QW native ,
+and a second element which when given is a platform-specific type name
+for the file's system (e.g.
+.QW NTFS ,
+.QW FAT ,
+on Windows). A generic virtual file system might return
+the list
+.QW "vfs ftp"
+to represent a file on a remote ftp site mounted as a
+virtual filesystem through an extension called
+.QW vfs .
+If the file does not belong to any filesystem, an error is generated.
.TP
\fBfile tail \fIname\fR
.
@@ -403,6 +433,25 @@ If \fIname\fR contains no separators then returns \fIname\fR. So,
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.
.TP
+\fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR?
+'\" TIP #210
+.VS 8.6
+Creates a temporary file and returns a read-write channel opened on that file.
+If the \fInameVar\fR is given, it specifies a variable that the name of the
+temporary file will be written into; if absent, Tcl will attempt to arrange
+for the temporary file to be deleted once it is no longer required. If the
+\fItemplate\fR is present, it specifies parts of the template of the filename
+to use when creating it (such as the directory, base-name or extension) though
+some platforms may ignore some or all of these parts and use a built-in
+default instead.
+.RS
+.PP
+Note that temporary files are \fIonly\fR ever created on the native
+filesystem. As such, they can be relied upon to be used with operating-system
+native APIs and external programs that require a filename.
+.RE
+.VE 8.6
+.TP
\fBfile type \fIname\fR
.
Returns a string giving the type of file \fIname\fR, which will be one of
@@ -413,10 +462,13 @@ Returns a string giving the type of file \fIname\fR, which will be one of
.
Returns the absolute paths to the volumes mounted on the system, as a
proper Tcl list. Without any virtual filesystems mounted as root
-volumes, on UNIX, the command will always return "/", since all
-filesystems are locally mounted.
+volumes, on UNIX, the command will always return
+.QW / ,
+since all filesystems are locally mounted.
On Windows, it will return a list of the available local drives
-(e.g. {a:/ c:/}). If any virtual filesystem has mounted additional
+(e.g.
+.QW "a:/ c:/" ).
+If any virtual filesystem has mounted additional
volumes, they will be in the returned list.
.TP
\fBfile writable \fIname\fR
@@ -429,47 +481,70 @@ Returns \fB1\fR if file \fIname\fR is writable by the current user,
.
These commands always operate using the real user and group identifiers,
not the effective ones.
+.TP
+\fBWindows\fR\0\0\0\0
+.
+The \fBfile owned\fR subcommand currently always reports that the current user
+is the owner of the file, without regard for what the operating system
+believes to be true, making an ownership test useless. This issue (#3613671)
+may be fixed in a future release of Tcl.
.SH EXAMPLES
+.PP
This procedure shows how to search for C files in a given directory
that have a correspondingly-named object file in the current
directory:
+.PP
.CS
proc findMatchingCFiles {dir} {
- set files {}
- switch $::tcl_platform(platform) {
- windows {
- set ext .obj
- }
- unix {
- set ext .o
- }
- }
- foreach file [glob -nocomplain -directory $dir *.c] {
- set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext
- if {[\fBfile exists\fR $objectFile]} {
- lappend files $file
- }
- }
- return $files
+ set files {}
+ switch $::tcl_platform(platform) {
+ windows {
+ set ext .obj
+ }
+ unix {
+ set ext .o
+ }
+ }
+ foreach file [glob \-nocomplain \-directory $dir *.c] {
+ set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext
+ if {[\fBfile exists\fR $objectFile]} {
+ lappend files $file
+ }
+ }
+ return $files
}
.CE
.PP
Rename a file and leave a symbolic link pointing from the old location
to the new place:
+.PP
.CS
set oldName foobar.txt
set newName foo/bar.txt
# Make sure that where we're going to move to exists...
if {![\fBfile isdirectory\fR [\fBfile dirname\fR $newName]]} {
- \fBfile mkdir\fR [\fBfile dirname\fR $newName]
+ \fBfile mkdir\fR [\fBfile dirname\fR $newName]
}
\fBfile rename\fR $oldName $newName
-\fBfile link\fR -symbolic $oldName $newName
+\fBfile link\fR \-symbolic $oldName $newName
+.CE
+.PP
+On Windows, a file can be
+.QW started
+easily enough (equivalent to double-clicking on it in the Explorer
+interface) but the name passed to the operating system must be in
+native format:
+.PP
+.CS
+exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt]
.CE
-
.SH "SEE ALSO"
filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n),
fblocked(n), flush(n)
-
.SH KEYWORDS
-attributes, copy files, delete files, directory, file, move files, name, rename files, stat
+attributes, copy files, delete files, directory, file, move files, name,
+rename files, stat, user
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/fileevent.n b/doc/fileevent.n
index 62ce6b4..8f6b880 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -1,14 +1,13 @@
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2008 Pat Thoyts
'\"
'\" 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.9 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -30,9 +29,11 @@ interact with the user while waiting for the data to arrive. If an
application invokes \fBgets\fR or \fBread\fR on a blocking channel when
there is no input data available, the process will block; until the input
data arrives, it will not be able to service other events, so it will
-appear to the user to ``freeze up''. With \fBfileevent\fR, the process can
+appear to the user to
+.QW "freeze up" .
+With \fBfileevent\fR, the process can
tell when data is present and only invoke \fBgets\fR or \fBread\fR when
-they won't block.
+they will not block.
.PP
The \fIchannelId\fR argument to \fBfileevent\fR refers to an open
channel such as a Tcl standard channel (\fBstdin\fR, \fBstdout\fR,
@@ -79,17 +80,25 @@ A channel is considered to be writable if at least one byte of data
can be written to the underlying file or device without blocking,
or if an error condition is present on the underlying file or device.
.PP
-Event-driven I/O works best for channels that have been
-placed into nonblocking mode with the \fBfconfigure\fR command.
-In blocking mode, a \fBputs\fR command may block if you give it
-more data than the underlying file or device can accept, and a
-\fBgets\fR or \fBread\fR command will block if you attempt to read
-more data than is ready; no events will be processed while the
-commands block.
+Event-driven I/O works best for channels that have been placed into
+nonblocking mode with the \fBfconfigure\fR command. In blocking mode,
+a \fBputs\fR command may block if you give it more data than the
+underlying file or device can accept, and a \fBgets\fR or \fBread\fR
+command will block if you attempt to read more data than is ready; a
+readable underlying file or device may not even guarantee that a
+blocking [read 1] will succeed (counter-examples being multi-byte
+encodings, compression or encryption transforms ). In all such cases,
+no events will be processed while the commands block.
+.PP
In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block.
See the documentation for the individual commands for information
on how they handle blocking and nonblocking channels.
.PP
+Testing for the end of file condition should be done after any attempts
+read the channel data. The eof flag is set once an attempt to read the
+end of data has occurred and testing before this read will require an
+additional event to be fired.
+.PP
The script for a file event is executed at global level (outside the
context of any Tcl procedure) in the interpreter in which the
\fBfileevent\fR command was invoked.
@@ -99,26 +108,49 @@ In addition, the file event handler is deleted if it ever returns
an error; this is done in order to prevent infinite loops due to
buggy handlers.
.SH EXAMPLE
+.PP
In this setup \fBGetData\fR will be called with the channel as an
-argument whenever $chan becomes readable.
+argument whenever $chan becomes readable. The \fBread\fR call will
+read whatever binary data is currently available without blocking.
+Here the channel has the fileevent removed when an end of file
+occurs to avoid being continually called (see above). Alternatively
+the channel may be closed on this condition.
+.PP
.CS
proc GetData {chan} {
- if {![eof $chan]} {
- puts [gets $chan]
+ set data [read $chan]
+ puts "[string length $data] $data"
+ if {[eof $chan]} {
+ fileevent $chan readable {}
}
}
+fconfigure $chan -blocking 0 -encoding binary
\fBfileevent\fR $chan readable [list GetData $chan]
.CE
+.PP
+The next example demonstrates use of \fBgets\fR to read line-oriented
+data.
+.PP
+.CS
+proc GetData {chan} {
+ if {[gets $chan line] >= 0} {
+ puts $line
+ }
+ if {[eof $chan]} {
+ close $chan
+ }
+}
+fconfigure $chan -blocking 0 -buffering line -translation crlf
+\fBfileevent\fR $chan readable [list GetData $chan]
+.CE
.SH CREDITS
.PP
\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.
-
.SH "SEE ALSO"
fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
diff --git a/doc/filename.n b/doc/filename.n
index c2787ec..8b8b00b 100644
--- a/doc/filename.n
+++ b/doc/filename.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.
'\"
-'\" RCS: @(#) $Id: filename.n,v 1.13 2004/06/30 14:46:10 vincentdarley Exp $
-'\"
-.so man.macros
.TH filename n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -25,7 +23,6 @@ to be portable should not assume a particular form for file names.
Instead, portable scripts must use the \fBfile split\fR and \fBfile
join\fR commands to manipulate file names (see the \fBfile\fR manual
entry for more details).
-
.SH "PATH TYPES"
.PP
File names are grouped into three general types based on the starting point
@@ -38,13 +35,12 @@ qualified, either giving the path relative to the root directory on the
current volume, or relative to the current directory of the specified
volume. The \fBfile pathtype\fR command can be used to determine the
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
+\fBUnix\fR
On Unix and Apple MacOS X platforms, Tcl uses path names where the
components are separated by slashes. Path names may be relative or
absolute, and file names may contain any character other than slash.
@@ -55,10 +51,10 @@ separator. Any number of trailing slash characters at the end of a
path are simply ignored, so the paths \fBfoo\fR, \fBfoo/\fR and
\fBfoo//\fR are all identical, and in particular \fBfoo/\fR does not
necessarily mean a directory is being referred.
+.RS
.PP
The following examples illustrate various forms of path
names:
-.RS
.TP 15
\fB/\fR
Absolute path to the root directory.
@@ -82,7 +78,7 @@ Relative path to the file \fBfoo\fR in the directory above the current
directory.
.RE
.TP
-\fBwindows\fR
+\fBWindows\fR
On Microsoft Windows platforms, Tcl supports both drive-relative and UNC
style names. Both \fB/\fR and \fB\e\fR may be used as directory separators
in either type of name. Drive-relative names consist of an optional drive
@@ -99,7 +95,7 @@ following examples illustrate various forms of path names:
Absolute UNC path to a file called \fBfile\fR in the root directory of
the export point \fBshare\fR on the host \fBHost\fR. Note that
repeated use of \fBfile dirname\fR on this path will give
-\fB//Host/share\fR, and will never give just /fB//Host/fR.
+\fB//Host/share\fR, and will never give just \fB//Host\fR.
.TP 15
\fBc:foo\fR
Volume-relative path to a file \fBfoo\fR in the current directory on drive
@@ -122,7 +118,6 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
volume. This is not a valid UNC path, so the assumption is that the
extra backslashes are superfluous.
.RE
-
.SH "TILDE SUBSTITUTION"
.PP
In addition to the file name rules described above, Tcl also supports
@@ -143,14 +138,15 @@ file. The behaviour of these paths when not trying to interpret them is
the same as on Unix. File names that have a tilde without a user name
will be correctly substituted using the \fB$HOME\fR environment
variable, just like for Unix.
-
.SH "PORTABILITY ISSUES"
.PP
Not all file systems are case sensitive, so scripts should avoid code
that depends on the case of characters in a file name. In addition,
the character sets allowed on different devices may differ, so scripts
should choose file names that do not contain special characters like:
-\fB<>:?"/\e|\fR. The safest approach is to use names consisting of
+\fB<>:?"/\e|\fR.
+'\""\" reset emacs highlighting
+The safest approach is to use names consisting of
alphanumeric characters only. Care should be taken with filenames
which contain spaces (common on Windows systems) and
filenames where the backslash is the directory separator (Windows
@@ -162,16 +158,21 @@ On Windows platforms there are file and path length restrictions.
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
-Another Windows peculiarity is that any number of trailing dots '.' in
-filenames are totally ignored, so, for example, attempts to create a
-file or directory with a name "foo." will result in the creation of a
-file/directory with name "foo". This fact is reflected in the
-results of 'file normalize'. Furthermore, a file name consisting only
-of dots '.........' or dots with trailing characters '.....abc' is
-illegal.
+Another Windows peculiarity is that any number of trailing dots
+.QW .
+in filenames are totally ignored, so, for example, attempts to create a
+file or directory with a name
+.QW foo.
+will result in the creation of a file/directory with name
+.QW foo .
+This fact is reflected in the results of \fBfile normalize\fR.
+Furthermore, a file name consisting only of dots
+.QW .........
+or dots with trailing characters
+.QW .....abc
+is illegal.
+.SH "SEE ALSO"
+file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
-
-.SH "SEE ALSO"
-file(n), glob(n)
diff --git a/doc/flush.n b/doc/flush.n
index 8ee4870..d266d91 100644
--- a/doc/flush.n
+++ b/doc/flush.n
@@ -5,10 +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: flush.n,v 1.8 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH flush n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ flush \- Flush buffered output for a channel
.SH SYNOPSIS
\fBflush \fIchannelId\fR
.BE
-
.SH DESCRIPTION
.PP
Flushes any output that has been buffered for \fIchannelId\fR.
@@ -33,16 +30,16 @@ nonblocking 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.
.SH EXAMPLE
+.PP
Prompt for the user to type some information in on the console:
+.PP
.CS
puts -nonewline "Please type your name: "
\fBflush\fR stdout
gets stdin name
puts "Hello there, $name!"
.CE
-
.SH "SEE ALSO"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
diff --git a/doc/for.n b/doc/for.n
index a7e0fa6..40c7cab 100644
--- a/doc/for.n
+++ b/doc/for.n
@@ -5,14 +5,12 @@
'\" 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.5 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH for n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-for \- ``For'' loop
+for \- 'For' loop
.SH SYNOPSIS
\fBfor \fIstart test next body\fR
.BE
@@ -50,10 +48,12 @@ expression is evaluated (before
each loop iteration), so changes in the variables will be visible.
See below for an example:
.SH EXAMPLES
+.PP
Print a line for each of the integers from 0 to 10:
+.PP
.CS
-for {set x 0} {$x<10} {incr x} {
- puts "x is $x"
+\fBfor\fR {set x 0} {$x<10} {incr x} {
+ puts "x is $x"
}
.CE
.PP
@@ -64,21 +64,24 @@ before the \fBfor\fR command is run and whether its value is a value
that is less than or greater than/equal to ten, and this is because
the expression will be substituted before the \fBfor\fR command is
executed.
+.PP
.CS
-for {set x 0} $x<10 {incr x} {
- puts "x is $x"
+\fBfor\fR {set x 0} $x<10 {incr x} {
+ puts "x is $x"
}
.CE
.PP
Print out the powers of two from 1 to 1024:
+.PP
.CS
-for {set x 1} {$x<=1024} {set x [expr {$x * 2}]} {
- puts "x is $x"
+\fBfor\fR {set x 1} {$x<=1024} {set x [expr {$x * 2}]} {
+ puts "x is $x"
}
.CE
-
.SH "SEE ALSO"
-break, continue, foreach, while
-
+break(n), continue(n), foreach(n), while(n)
.SH KEYWORDS
-for, iteration, looping
+boolean, for, iteration, loop
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/foreach.n b/doc/foreach.n
index 3398b17..89a11f6 100644
--- a/doc/foreach.n
+++ b/doc/foreach.n
@@ -5,10 +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: foreach.n,v 1.7 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH foreach n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -37,9 +35,9 @@ In the general case there can be more than one value list
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\fP are assigned
-consecutive values from the corresponding \fIlist\fP.
-Values in each \fIlist\fP are used in order from first to last,
+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.
@@ -51,20 +49,23 @@ The \fBbreak\fR and \fBcontinue\fR statements may be
invoked inside \fIbody\fR, with the same effect as in the \fBfor\fR
command. \fBForeach\fR returns an empty string.
.SH EXAMPLES
+.PP
This loop prints every value in a list together with the square and
cube of the value:
+.PP
.CS
'\" Maintainers: notice the tab hacking below!
.ta 3i
set values {1 3 5 7 2 4 6 8} ;# Odd numbers first, for fun!
-puts "Value\\tSquare\\tCube" ;# Neat-looking header
+puts "Value\etSquare\etCube" ;# Neat-looking header
\fBforeach\fR x $values { ;# Now loop and print...
- puts " $x\\t [expr {$x**2}]\\t [expr {$x**3}]"
+ puts " $x\et [expr {$x**2}]\et [expr {$x**3}]"
}
.CE
.PP
The following loop uses i and j as loop variables to iterate over
pairs of elements of a single list.
+.PP
.CS
set x {}
\fBforeach\fR {i j} {a b c d e f} {
@@ -75,6 +76,7 @@ set x {}
.CE
.PP
The next loop uses i and j to iterate over two lists in parallel.
+.PP
.CS
set x {}
\fBforeach\fR i {a b c} j {d e f g} {
@@ -85,6 +87,7 @@ set x {}
.CE
.PP
The two forms are combined in the following example.
+.PP
.CS
set x {}
\fBforeach\fR i {a b c} {j k} {d e f g} {
@@ -98,4 +101,4 @@ set x {}
for(n), while(n), break(n), continue(n)
.SH KEYWORDS
-foreach, iteration, list, looping
+foreach, iteration, list, loop
diff --git a/doc/format.n b/doc/format.n
index 846e832..076a820 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -5,10 +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: format.n,v 1.12 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH format n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,9 +17,8 @@ format \- Format a string in the style of sprintf
.SH INTRODUCTION
.PP
-This command generates a formatted string in the same way as the
-ANSI C \fBsprintf\fR procedure (it uses \fBsprintf\fR in its
-implementation).
+This command generates a formatted string in a fashion similar to the
+ANSI C \fBsprintf\fR procedure.
\fIFormatString\fR indicates how to format the result, using
\fB%\fR conversion specifiers as in \fBsprintf\fR, and the additional
arguments, if any, provide values to be substituted into the result.
@@ -44,15 +41,16 @@ of all of the conversion specifiers in \fIformatString\fR.
.PP
Each conversion specifier may contain up to six different parts:
an XPG3 position specifier,
-a set of flags, a minimum field width, a precision, a length modifier,
+a set of flags, a minimum field width, a precision, a size modifier,
and a conversion character.
Any of these fields may be omitted except for the conversion character.
The fields that are present must appear in the order given above.
The paragraphs below discuss each of these fields in turn.
+.SS "OPTIONAL POSITIONAL SPECIFIER"
.PP
If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
-``\fB%2$d\fR'', then the value to convert is not taken from the
-next sequential argument.
+.QW \fB%2$d\fR ,
+then the value to convert is not taken from the next sequential argument.
Instead, it is taken from the argument indicated by the number,
where 1 corresponds to the first \fIarg\fR.
If the conversion specifier requires multiple arguments because
@@ -62,6 +60,7 @@ given by the number.
This follows the XPG3 conventions for positional specifiers.
If there are any positional specifiers in \fIformatString\fR
then all of the specifiers must be positional.
+.SS "OPTIONAL FLAGS"
.PP
The second portion of a conversion specifier may contain any of the
following flag characters, in any order:
@@ -76,8 +75,8 @@ Specifies that a number should always be printed with a sign,
even if positive.
.TP 10
\fIspace\fR
-Specifies that a space should be added to the beginning of the
-number if the first character isn't a sign.
+Specifies that a space should be added to the beginning of the
+number if the first character is not a sign.
.TP 10
\fB0\fR
Specifies that the number should be padded on the left with
@@ -88,13 +87,16 @@ Requests an alternate output form. For \fBo\fR and \fBO\fR
conversions it guarantees that the first digit is always \fB0\fR.
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
will be added to the beginning of the result unless it is zero.
+For \fBb\fR conversions, \fB0b\fR
+will be added to the beginning of the result unless it is zero.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
For \fBg\fR and \fBG\fR conversions it specifies that
trailing zeroes should not be removed.
+.SS "OPTIONAL FIELD WIDTH"
.PP
-The third portion of a conversion specifier is a number giving a
+The third portion of a conversion specifier is a decimal number giving a
minimum field width for this conversion.
It is typically used to make columns line up in tabular printouts.
If the converted argument contains fewer characters than the
@@ -106,7 +108,8 @@ may be used to specify padding with zeroes on the left or with
spaces on the right, respectively.
If the minimum field width is specified as \fB*\fR rather than
a number, then the next argument to the \fBformat\fR command
-determines the minimum field width; it must be a numeric string.
+determines the minimum field width; it must be an integer value.
+.SS "OPTIONAL PRECISION/BOUND"
.PP
The fourth portion of a conversion specifier is a precision,
which consists of a period followed by a number.
@@ -124,16 +127,23 @@ printed; if the string is longer than this then the trailing characters will be
If the precision is specified with \fB*\fR rather than a number
then the next argument to the \fBformat\fR command determines the precision;
it must be a numeric string.
+.SS "OPTIONAL SIZE MODIFIER"
.PP
-The fifth part of a conversion specifier is a length modifier,
-which must be \fBh\fR or \fBl\fR.
-If it is \fBh\fR it specifies that the numeric value should be
-truncated to a 16-bit value before converting.
-This option is rarely useful.
-If it is \fBl\fR it specifies that the numeric value should be (at
-least) a 64-bit value. If neither \fBh\fR nor \fBl\fR are present,
-numeric values are interpreted as being values of the width of the
-native machine word, as described by \fBtcl_platform(wordSize)\fR.
+The fifth part of a conversion specifier is a size modifier,
+which must be \fBll\fR, \fBh\fR, or \fBl\fR.
+If it is \fBll\fR it specifies that an integer value is taken
+without truncation for conversion to a formatted substring.
+If it is \fBh\fR it specifies that an integer value is
+truncated to a 16-bit range before converting. This option is rarely useful.
+If it is \fBl\fR it specifies that the integer value is
+truncated to the same range as that produced by the \fBwide()\fR
+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 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
that determines what kind of conversion to perform.
@@ -146,16 +156,20 @@ Convert integer to signed decimal string.
Convert integer to unsigned decimal string.
.TP 10
\fBi\fR
-Convert integer to signed decimal string; the integer may either be
-in decimal, in octal (with a leading \fB0\fR) or in hexadecimal
-(with a leading \fB0x\fR).
+Convert integer to signed decimal string (equivalent to \fBd\fR).
.TP 10
\fBo\fR
Convert integer to unsigned octal string.
.TP 10
\fBx\fR or \fBX\fR
Convert integer to unsigned hexadecimal string, using digits
-``0123456789abcdef'' for \fBx\fR and ``0123456789ABCDEF'' for \fBX\fR).
+.QW 0123456789abcdef
+for \fBx\fR and
+.QW 0123456789ABCDEF
+for \fBX\fR).
+.TP 10
+\fBb\fR
+Convert integer to binary string, using digits 0 and 1.
.TP 10
\fBc\fR
Convert integer to the Unicode character it represents.
@@ -164,13 +178,13 @@ Convert integer to the Unicode character it represents.
No conversion; just insert string.
.TP 10
\fBf\fR
-Convert floating-point number to signed decimal string of
+Convert number to signed decimal string of
the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by
the precision (default: 6).
If the precision is 0 then no decimal point is output.
.TP 10
-\fBe\fR or \fBe\fR
-Convert floating-point number to scientific notation in the
+\fBe\fR or \fBE\fR
+Convert number to scientific notation in the
form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined
by the precision (default: 6).
If the precision is 0 then no decimal point is output.
@@ -179,46 +193,49 @@ printed instead of \fBe\fR.
.TP 10
\fBg\fR or \fBG\fR
If the exponent is less than \-4 or greater than or equal to the
-precision, then convert floating-point number as for \fB%e\fR or
+precision, then convert number as for \fB%e\fR or
\fB%E\fR.
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
-.LP
-For the numerical conversions the argument being converted must
-be an integer or floating-point string; format converts the argument
-to binary and then converts it back to a string according to
-the conversion specifier.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
ANSI C \fBsprintf\fR procedure except for the following
differences:
.IP [1]
-\fB%p\fR and \fB%n\fR specifiers are not currently supported.
+Tcl guarantees that it will be working with UNICODE characters.
.IP [2]
-For \fB%c\fR conversions the argument must be a decimal string,
-which will then be converted to the corresponding character value.
+\fB%p\fR and \fB%n\fR specifiers are not supported.
.IP [3]
-The \fBl\fR modifier
-is ignored for real values and on 64-bit platforms, which are always
-converted as if the \fBl\fR modifier were present (i.e. the types
-\fBdouble\fR and \fBlong\fR are used for the internal representation
-of real and integer values, respectively).
-If the \fBh\fR modifier is specified then integer values are truncated
-to \fBshort\fR before conversion. Both \fBh\fR and \fBl\fR modifiers
-are ignored on all other conversions.
+For \fB%c\fR conversions the argument must be an integer value,
+which will then be converted to the corresponding character value.
+.IP [4]
+The size modifiers are ignored when formatting floating-point values.
+The \fBll\fR modifier has no \fBsprintf\fR counterpart.
+The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
+.PP
+Convert the numeric value of a UNICODE character to the character
+itself:
+.PP
+.CS
+set value 120
+set char [\fBformat\fR %c $value]
+.CE
+.PP
Convert the output of \fBtime\fR into seconds to an accuracy of
hundredths of a second:
+.PP
.CS
set us [lindex [time $someTclCode] 0]
puts [\fBformat\fR "%.2f seconds to execute" [expr {$us / 1e6}]]
.CE
.PP
Create a packed X11 literal color specification:
+.PP
.CS
# Each color-component should be in range (0..255)
set color [\fBformat\fR "#%02x%02x%02x" $r $g $b]
@@ -227,15 +244,17 @@ set color [\fBformat\fR "#%02x%02x%02x" $r $g $b]
Use XPG3 format codes to allow reordering of fields (a technique that
is often used in localized message catalogs; see \fBmsgcat\fR) without
reordering the data values passed to \fBformat\fR:
+.PP
.CS
set fmt1 "Today, %d shares in %s were bought at $%.2f each"
puts [\fBformat\fR $fmt1 123 "Global BigCorp" 19.37]
-set fmt2 "Bought %2\\$s equity ($%3$.2f x %1\\$d) today"
+set fmt2 "Bought %2\e$s equity ($%3$.2f x %1\e$d) today"
puts [\fBformat\fR $fmt2 123 "Global BigCorp" 19.37]
.CE
.PP
Print a small table of powers of three:
+.PP
.CS
# Set up the column widths
set w1 5
@@ -250,16 +269,17 @@ puts $sep
# Print the contents of the table
set p 1
for {set i 0} {$i<=20} {incr i} {
- puts [\fBformat\fR "| %*d | %*ld |" $w1 $i $w2 $p]
- set p [expr {wide($p) * 3}]
+ puts [\fBformat\fR "| %*d | %*ld |" $w1 $i $w2 $p]
+ set p [expr {wide($p) * 3}]
}
# Finish off by printing the separator again
puts $sep
.CE
-
.SH "SEE ALSO"
scan(n), sprintf(3), string(n)
-
.SH KEYWORDS
conversion specifier, format, sprintf, string, substitution
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/gets.n b/doc/gets.n
index 5c3a908..0150f29 100644
--- a/doc/gets.n
+++ b/doc/gets.n
@@ -5,10 +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: 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"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -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 3ddd18b..86e450b 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -4,70 +4,81 @@
'\"
'\" 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.18 2005/06/09 16:24:47 vincentdarley Exp $
-'\"
-.so man.macros
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
glob \- Return names of files that match patterns
.SH SYNOPSIS
-\fBglob \fR?\fIswitches\fR? \fIpattern \fR?\fIpattern ...\fR?
+\fBglob \fR?\fIswitches\fR? ?\fIpattern ...\fR?
.BE
-
.SH DESCRIPTION
.PP
-This command performs file name ``globbing'' in a fashion similar to
-the csh shell. It returns a list of the files whose names match any
-of the \fIpattern\fR arguments. No particular order is guaranteed
-in the list, so if a sorted list is required the caller should use
+This command performs file name
+.QW globbing
+in a fashion similar to
+the csh shell or bash shell.
+It returns a list of the files whose names match any
+of the \fIpattern\fR arguments. No particular order is guaranteed
+in the list, so if a sorted list is required the caller should use
\fBlsort\fR.
-.LP
+.SS OPTIONS
+.PP
If the initial arguments to \fBglob\fR start with \fB\-\fR then
-they are treated as switches. The following switches are
+they are treated as switches. The following switches are
currently supported:
.TP
\fB\-directory\fR \fIdirectory\fR
+.
Search for files which match the given patterns starting in the given
-\fIdirectory\fR. This allows searching of directories whose name
+\fIdirectory\fR. This allows searching of directories whose name
contains glob-sensitive characters without the need to quote such
-characters explicitly. This option may not be used in conjunction with
+characters explicitly. This option may not be used in conjunction with
\fB\-path\fR, which is used to allow searching for complete file paths
whose names may contain glob-sensitive characters.
.TP
\fB\-join\fR
-The remaining pattern arguments are treated as a single pattern
-obtained by joining the arguments with directory separators.
+.
+The remaining pattern arguments, after option processing, are treated
+as a single pattern obtained by joining the arguments with directory
+separators.
.TP
\fB\-nocomplain\fR
-Allows an empty list to be returned without error; without this
+.
+Allows an empty list to be returned without error; without this
switch an error is returned if the result list would be empty.
.TP
\fB\-path\fR \fIpathPrefix\fR
+.
Search for files with the given \fIpathPrefix\fR where the rest of the name
-matches the given patterns. This allows searching for files with names
-similar to a given file (as opposed to a directory) even when the names
-contain glob-sensitive
-characters. This option may not be used in conjunction with
-\fB\-directory\fR. For example, to find all files with the same root name
-as $path, but differing extensions, you should use \fBglob
--path [file rootname $path] .*\fR which will work even if $path contains
+matches the given patterns. This allows searching for files with names
+similar to a given file (as opposed to a directory) even when the names
+contain glob-sensitive
+characters. This option may not be used in conjunction with
+\fB\-directory\fR. For example, to find all files with the same root name
+as $path, but differing extensions, you should use
+.QW "\fBglob \-path [file rootname $path] .*\fR"
+which will work even if \fB$path\fR contains
numerous glob-sensitive characters.
.TP
\fB\-tails\fR
+.
Only return the part of each file found which follows the last directory
-named in any \fB\-directory\fR or \fB\-path\fR path specification.
-Thus \fBglob -tails -directory $dir *\fR is equivalent to
-\fBset pwd [pwd] ; cd $dir ; glob *; cd $pwd\fR. For
-\fB\-path\fR specifications, the returned names will include the last
-path segment, so \fBglob -tails -path [file rootname ~/foo.tex] .*\fR
+named in any \fB\-directory\fR or \fB\-path\fR path specification.
+Thus
+.QW "\fBglob \-tails \-directory $dir *\fR"
+is equivalent to
+.QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" .
+For \fB\-path\fR specifications, the returned names will include the last
+path segment, so
+.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR"
will return paths like \fBfoo.aux foo.bib foo.tex\fR etc.
.TP
\fB\-types\fR \fItypeList\fR
+.
Only list files or directories which match \fItypeList\fR, where the items
-in the list have two forms. The first form is like the \-type option of
+in the list have two forms. The first form is like the \-type option of
the Unix find command:
\fIb\fR (block special file),
\fIc\fR (character special file),
@@ -77,132 +88,186 @@ the Unix find command:
\fIp\fR (named pipe),
or \fIs\fR (socket), where multiple types may be specified in the list.
\fBGlob\fR will return all files which match at least one of the types given.
-Note that symbolic links will be returned both if \fB\-types l\fR is given,
-or if the target of a link matches the requested type. So, a link to
+Note that symbolic links will be returned both if \fB\-types l\fR is given,
+or if the target of a link matches the requested type. So, a link to
a directory will be returned if \fB\-types d\fR was specified.
.RS
.PP
The second form specifies types where all the types given must match.
These are \fIr\fR, \fIw\fR, \fIx\fR as file permissions, and
-\fIreadonly\fR, \fIhidden\fR as special permission cases. On the
+\fIreadonly\fR, \fIhidden\fR as special permission cases. On the
Macintosh, MacOS types and creators are also supported, where any item
which is four characters long is assumed to be a MacOS type
-(e.g. \fBTEXT\fR). Items which are of the form \fI{macintosh type XXXX}\fR
+(e.g. \fBTEXT\fR). Items which are of the form \fI{macintosh type XXXX}\fR
or \fI{macintosh creator XXXX}\fR will match types or creators
-respectively. Unrecognized types, or specifications of multiple MacOS
+respectively. Unrecognized types, or specifications of multiple MacOS
types/creators will signal an error.
.PP
The two forms may be mixed, so \fB\-types {d f r w}\fR will find all
regular files OR directories that have both read AND write permissions.
The following are equivalent:
-.RS
+.PP
.CS
\fBglob \-type d *\fR
\fBglob */\fR
.CE
-.RE
-except that the first case doesn't return the trailing ``/'' and
-is more platform independent.
+.PP
+except that the first case doesn't return the trailing
+.QW /
+and is more platform independent.
.RE
.TP
\fB\-\|\-\fR
-Marks the end of switches. The argument following this one will
+.
+Marks the end of switches. The argument following this one will
be treated as a \fIpattern\fR even if it starts with a \fB\-\fR.
+.SS "GLOBBING PATTERNS"
.PP
The \fIpattern\fR arguments may contain any of the following
-special characters:
+special characters, which are a superset of those supported by
+\fBstring match\fR:
.TP 10
\fB?\fR
+.
Matches any single character.
.TP 10
\fB*\fR
+.
Matches any sequence of zero or more characters.
.TP 10
\fB[\fIchars\fB]\fR
-Matches any single character in \fIchars\fR. If \fIchars\fR
+.
+Matches any single character in \fIchars\fR. If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will match.
.TP 10
\fB\e\fIx\fR
+.
Matches the character \fIx\fR.
.TP 10
\fB{\fIa\fB,\fIb\fB,\fI...\fR}
-Matches any of the strings \fIa\fR, \fIb\fR, etc.
-.LP
-On Unix, as with csh, a ``.'' at the beginning of a file's name or just
-after a ``/'' must be matched explicitly or with a {} construct,
-unless the ``-types hidden'' flag is given (since ``.'' at the beginning
-of a file's name indicates that it is hidden). On other platforms,
-files beginning with a ``.'' are handled no differently to any others,
-except the special directories ``.'' and ``..'' which must be matched
-explicitly (this is to avoid a recursive pattern like ``glob -join * *
-* *'' from recursing up the directory hierarchy as well as down).
-In addition, all ``/'' characters must be matched explicitly.
-.LP
-If the first character in a \fIpattern\fR is ``~'' then it refers
-to the home directory for the user whose name follows the ``~''.
-If the ``~'' is followed immediately by ``/'' then the value of
-the HOME environment variable is used.
+.
+Matches any of the sub-patterns \fIa\fR, \fIb\fR, etc.
+.PP
+On Unix, as with csh, a
+.QW . \|
+at the beginning of a file's name or just after a
+.QW /
+must be matched explicitly or with a {} construct, unless the
+\fB\-types hidden\fR flag is given (since
+.QW . \|
+at the beginning of a file's name indicates that it is hidden). On
+other platforms, files beginning with a
+.QW . \|
+are handled no differently to any others, except the special directories
+.QW . \|
+and
+.QW .. \|
+which must be matched explicitly (this is to avoid a recursive pattern like
+.QW "glob \-join * * * *"
+from recursing up the directory hierarchy as well as down). In addition, all
+.QW /
+characters must be matched explicitly.
.LP
+If the first character in a \fIpattern\fR is
+.QW ~
+then it refers to the home directory for the user whose name follows the
+.QW ~ .
+If the
+.QW ~
+is followed immediately by
+.QW /
+then the value of the HOME environment variable is used.
+.PP
The \fBglob\fR command differs from csh globbing in two ways.
First, it does not sort its result list (use the \fBlsort\fR
command if you want the list sorted).
Second, \fBglob\fR only returns the names of files that actually
-exist; in csh no check for existence is made unless a pattern
+exist; in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
.LP
When the \fBglob\fR command returns relative paths whose filenames
-start with a tilde ``~'' (for example through \fBglob *\fR or
-\fBglob -tails\fR, the returned list will not quote the tilde with
-``./''. This means care must be taken if those names are later to
+start with a tilde
+.QW ~
+(for example through \fBglob *\fR or \fBglob \-tails\fR, the returned
+list will not quote the tilde with
+.QW ./ .
+This means care must be taken if those names are later to
be used with \fBfile join\fR, to avoid them being interpreted as
absolute paths pointing to a given user's home directory.
-.SH "PORTABILITY ISSUES"
+.SH "WINDOWS PORTABILITY ISSUES"
.PP
-\fBWindows\fR
-.
For Windows UNC names, the servername and sharename components of the path
-may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is
-of the form ``\fB~\fIusername\fB@\fIdomain\fR'' it refers to the home
+may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is
+of the form
+.QW \fB~\fIusername\fB@\fIdomain\fR ,
+it refers to the home
directory of the user whose account information resides on the specified NT
-domain server. Otherwise, user account information is obtained from
-the local computer. On Windows 95 and 98, \fBglob\fR accepts patterns
-like ``.../'' and ``..../'' for successively higher up parent directories.
-
-.
-Since the backslash character has a special meaning to the glob
-command, glob patterns containing Windows style path separators need
-special care. The pattern \fIC:\e\efoo\e\e*\fR is interpreted as
-\fIC:\efoo\e*\fR where \fI\ef\fR will match the single character \fIf\fR
-and \fI\e*\fR will match the single character \fI*\fR 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 \fBfile
-join $path\fR (or \fBfile normalize $path\fR in Tcl 8.4).
+domain server. Otherwise, user account information is obtained from
+the local computer. On Windows 95 and 98, \fBglob\fR accepted patterns
+like
+.QW .../
+and
+.QW ..../
+for successively higher up parent directories, but later versions of
+Windows do not accept these forms.
+.PP
+Since the backslash character has a special meaning to the glob
+command, glob patterns containing Windows style path separators need
+special care. The pattern
+.QW \fIC:\e\efoo\e\e*\fR
+is interpreted as
+.QW \fIC:\efoo\e*\fR
+where
+.QW \fI\ef\fR
+will match the single character
+.QW \fIf\fR
+and
+.QW \fI\e*\fR
+will match the single character
+.QW \fI*\fR
+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\fR \fB$path\fR"
+or
+.QW "\fBfile normalize\fR \fB$path\fR" .
.SH EXAMPLES
+.PP
Find all the Tcl files in the current directory:
+.PP
.CS
\fBglob\fR *.tcl
.CE
.PP
Find all the Tcl files in the user's home directory, irrespective of
what the current directory is:
+.PP
.CS
\fBglob\fR \-directory ~ *.tcl
.CE
.PP
Find all subdirectories of the current directory:
+.PP
.CS
\fBglob\fR \-type d *
.CE
.PP
-Find all files whose name contains an "a", a "b" or the sequence "cde":
+Find all files whose name contains an
+.QW a ,
+a
+.QW b
+or the sequence
+.QW cde :
+.PP
.CS
\fBglob\fR \-type f *{a,b,cde}*
.CE
-
.SH "SEE ALSO"
file(n)
-
.SH KEYWORDS
exist, file, glob, pattern
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/global.n b/doc/global.n
index a11e88b..aa8f2e4 100644
--- a/doc/global.n
+++ b/doc/global.n
@@ -5,24 +5,22 @@
'\" 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.9 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH global n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
global \- Access global variables
.SH SYNOPSIS
-\fBglobal \fIvarname \fR?\fIvarname ...\fR?
+\fBglobal \fR?\fIvarname ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command has no effect unless executed in the context of a proc body.
If the \fBglobal\fR command is executed in the context of a proc body, it
-creates local variables linked to the corresponding global variables (and
-therefore these variables are listed by info locals).
+creates local variables linked to the corresponding global variables (though
+these linked variables, like those created by \fBupvar\fR, are not included
+in the list returned by \fBinfo locals\fR).
.PP
If \fIvarname\fR contains namespace qualifiers, the local variable's name is
the unqualified name of the global variable, as determined by the
@@ -32,7 +30,9 @@ the unqualified name of the global variable, as determined by the
array element. An error is returned if the name looks like an array element,
such as \fBa(b)\fR.
.SH EXAMPLES
+.PP
This procedure sets the namespace variable \fI::a::x\fR
+.PP
.CS
proc reset {} {
\fBglobal\fR a::x
@@ -45,15 +45,14 @@ buffer, separated by newlines. It is useful for situations when you
want to build a message piece-by-piece (as if with \fBputs\fR) but
send that full message in a single piece (e.g. over a connection
opened with \fBsocket\fR or as part of a counted HTTP response).
+.PP
.CS
proc accum {string} {
\fBglobal\fR accumulator
- append accumulator $string \\n
+ append accumulator $string \en
}
.CE
-
.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)
-
.SH KEYWORDS
global, namespace, procedure, variable
diff --git a/doc/history.n b/doc/history.n
index a49fd7e..e1f9781 100644
--- a/doc/history.n
+++ b/doc/history.n
@@ -5,10 +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: history.n,v 1.3 2004/08/31 15:19:36 dkf Exp $
-'\"
-.so man.macros
.TH history n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,20 +14,20 @@ history \- Manipulate the history list
.SH SYNOPSIS
\fBhistory \fR?\fIoption\fR? ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBhistory\fR command performs one of several operations related to
recently-executed commands recorded in a history list. Each of
-these recorded commands is referred to as an ``event''. When
-specifying an event to the \fBhistory\fR command, the following
+these recorded commands is referred to as an
+.QW event .
+When specifying an event to the \fBhistory\fR command, the following
forms may be used:
.IP [1]
A number: if positive, it refers to the event with
that number (all events are numbered starting at 1). If the number
is negative, it selects an event relative to the current event
(\fB\-1\fR refers to the previous event, \fB\-2\fR to the one before that, and
-so on). Event \fB0\fP refers to the current event.
+so on). Event \fB0\fR refers to the current event.
.IP [2]
A string: selects the most recent event that matches the string.
An event is considered to match the string either if the string is
@@ -45,7 +43,7 @@ as \fBhistory info\fR, described below.
\fBhistory add\fI command \fR?\fBexec\fR?
Adds the \fIcommand\fR argument to the history list as a new event. If
\fBexec\fR is specified (or abbreviated) then the command is also
-executed and its result is returned. If \fBexec\fR isn't specified
+executed and its result is returned. If \fBexec\fR is not specified
then an empty string is returned as result.
.TP
\fBhistory change\fI newValue\fR ?\fIevent\fR?
@@ -89,16 +87,16 @@ revision: see below for details.
.PP
Pre-8.0 Tcl had a complex history revision mechanism.
The current mechanism is more limited, and the old
-history operations \fBsubstitute\fP and \fBwords\fP have been removed.
-(As a consolation, the \fBclear\fP operation was added.)
+history operations \fBsubstitute\fR and \fBwords\fR have been removed.
+(As a consolation, the \fBclear\fR operation was added.)
.PP
-The history option \fBredo\fR results in much simpler ``history revision''.
+The history option \fBredo\fR results in much simpler
+.QW "history revision" .
When this option is invoked then the most recent event
is modified to eliminate the history command and replace it with
the result of the history command.
If you want to redo an event without modifying history, then use
-the \fBevent\fP operation to retrieve some event,
-and the \fBadd\fP operation to add it to history and execute it.
-
+the \fBevent\fR operation to retrieve some event,
+and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
diff --git a/doc/http.n b/doc/http.n
index 9a97dec..26054cd 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -6,24 +6,23 @@
'\" 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.23 2004/10/27 12:53:22 dkf Exp $
-'\"
+.TH "http" n 2.7 http "Tcl Bundled Packages"
.so man.macros
-.TH "http" n 2.5 http "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-http \- Client-side implementation of the HTTP/1.0 protocol
+http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
-\fBpackage require http ?2.5?\fR
+\fBpackage require http ?2.7?\fR
+.\" See Also -useragent option documentation in body!
.sp
-\fB::http::config \fI?options?\fR
+\fB::http::config ?\fI\-option value\fR ...?
.sp
-\fB::http::geturl \fIurl ?options?\fR
+\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
-\fB::http::formatQuery\fP \fIkey value\fP ?\fIkey value\fP ...?
+\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
-\fB::http::reset\fP \fItoken\fP ?\fIwhy\fP?
+\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
.sp
@@ -35,6 +34,8 @@ http \- Client-side implementation of the HTTP/1.0 protocol
.sp
\fB::http::ncode \fItoken\fR
.sp
+\fB::http::meta \fItoken\fR
+.sp
\fB::http::data \fItoken\fR
.sp
\fB::http::error \fItoken\fR
@@ -45,12 +46,12 @@ http \- Client-side implementation of the HTTP/1.0 protocol
.sp
\fB::http::unregister \fIproto\fR
.BE
-
.SH DESCRIPTION
.PP
-The \fBhttp\fR package provides the client side of the HTTP/1.0
-protocol. The package implements the GET, POST, and HEAD operations
-of HTTP/1.0. It allows configuration of a proxy host to get through
+The \fBhttp\fR package provides the client side of the HTTP/1.1
+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
a restricted set of hosts. This package can be extended to support
@@ -63,9 +64,9 @@ is performed.
The return value of \fB::http::geturl\fR is a token for the transaction.
The value is also the name of an array in the ::http namespace
that contains state information about the transaction. The elements
-of this array are described in the STATE ARRAY section.
+of this array are described in the \fBSTATE ARRAY\fR section.
.PP
-If the \fB-command\fP option is specified, then
+If the \fB\-command\fR option is specified, then
the HTTP operation is done in the background.
\fB::http::geturl\fR returns immediately after generating the
HTTP request and the callback is invoked
@@ -75,7 +76,8 @@ applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.
.SH COMMANDS
.TP
-\fB::http::config\fP ?\fIoptions\fR?
+\fB::http::config\fR ?\fIoptions\fR?
+.
The \fB::http::config\fR command is used to set and query the name of the
proxy server and port, and the User-Agent name used in the HTTP
requests. If no options are specified, then the current configuration
@@ -85,20 +87,25 @@ that setting is returned. Otherwise, the options should be a set of
flags and values that define the configuration:
.RS
.TP
-\fB\-accept\fP \fImimetypes\fP
+\fB\-accept\fR \fImimetypes\fR
+.
The Accept header of the request. The default is */*, which means that
all types of documents are accepted. Otherwise you can supply a
comma-separated list of mime type patterns that you are
-willing to receive. For example, "image/gif, image/jpeg, text/*".
+willing to receive. For example,
+.QW "image/gif, image/jpeg, text/*" .
.TP
-\fB\-proxyhost\fP \fIhostname\fP
+\fB\-proxyhost\fR \fIhostname\fR
+.
The name of the proxy host, if any. If this value is the
empty string, the URL host is contacted directly.
.TP
-\fB\-proxyport\fP \fInumber\fP
+\fB\-proxyport\fR \fInumber\fR
+.
The proxy port number.
.TP
-\fB\-proxyfilter\fP \fIcommand\fP
+\fB\-proxyfilter\fR \fIcommand\fR
+.
The command is a callback that is made during
\fB::http::geturl\fR
to determine if a proxy is required for a given host. One argument, a
@@ -109,7 +116,8 @@ an empty list. The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
-\fB\-urlencoding\fP \fIencoding\fP
+\fB\-urlencoding\fR \fIencoding\fR
+.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
2718. Prior to http 2.5 this was unspecified, and that behavior can be
@@ -118,47 +126,55 @@ returned by specifying the empty string (\fB{}\fR), although
\fB::http::formatQuery\fR throwing an error processing non-latin-1
characters.
.TP
-\fB\-useragent\fP \fIstring\fP
-The value of the User-Agent header in the HTTP request. The default
-is \fB"Tcl http client package 2.4."\fR
+\fB\-useragent\fR \fIstring\fR
+.
+The value of the User-Agent header in the HTTP request. The default is
+.QW "\fBTcl http client package 2.7\fR" .
.RE
.TP
-\fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP?
+\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
+.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;
otherwise, a GET operation is performed. The \fB::http::geturl\fR command
returns a \fItoken\fR value that can be used to get
-information about the transaction. See the STATE ARRAY and ERRORS section for
+information about the transaction. See the \fBSTATE ARRAY\fR and
+\fBERRORS\fR section for
details. The \fB::http::geturl\fR command blocks until the operation
completes, unless the \fB\-command\fR option specifies a callback
that is invoked when the HTTP transaction completes.
\fB::http::geturl\fR takes several options:
.RS
.TP
-\fB\-binary\fP \fIboolean\fP
+\fB\-binary\fR \fIboolean\fR
+.
Specifies whether to force interpreting the URL data as binary. Normally
this is auto-detected (anything not beginning with a \fBtext\fR content
type or whose content encoding is \fBgzip\fR or \fBcompress\fR is
considered binary data).
.TP
-\fB\-blocksize\fP \fIsize\fP
+\fB\-blocksize\fR \fIsize\fR
+.
The block size used when reading the URL.
At most \fIsize\fR bytes are read at once. After each block, a call to the
\fB\-progress\fR callback is made (if that option is specified).
.TP
-\fB\-channel\fP \fIname\fP
+\fB\-channel\fR \fIname\fR
+.
Copy the URL contents to channel \fIname\fR instead of saving it in
\fBstate(body)\fR.
.TP
-\fB\-command\fP \fIcallback\fP
-Invoke \fIcallback\fP after the HTTP transaction completes.
-This option causes \fB::http::geturl\fP to return immediately.
-The \fIcallback\fP gets an additional argument that is the \fItoken\fR returned
+\fB\-command\fR \fIcallback\fR
+.
+Invoke \fIcallback\fR after the HTTP transaction completes.
+This option causes \fB::http::geturl\fR to return immediately.
+The \fIcallback\fR gets an additional argument that is the \fItoken\fR returned
from \fB::http::geturl\fR. This token is the name of an array that is
-described in the STATE ARRAY section. Here is a template for the
+described in the \fBSTATE ARRAY\fR section. Here is a template for the
callback:
.RS
+.PP
.CS
proc httpCallback {token} {
upvar #0 $token state
@@ -167,27 +183,33 @@ proc httpCallback {token} {
.CE
.RE
.TP
-\fB\-handler\fP \fIcallback\fP
-Invoke \fIcallback\fP whenever HTTP data is available; if present, nothing
+\fB\-handler\fR \fIcallback\fR
+.
+Invoke \fIcallback\fR whenever HTTP data is available; if present, nothing
else will be done with the HTTP data. This procedure gets two additional
arguments: the socket for the HTTP data and the \fItoken\fR returned from
-\fB::http::geturl\fR. The token is the name of a global array that is described
-in the STATE ARRAY section. The procedure is expected to return the number
-of bytes read from the socket. Here is a template for the callback:
+\fB::http::geturl\fR. The token is the name of a global array that is
+described in the \fBSTATE ARRAY\fR section. The procedure is expected
+to return the number of bytes read from the socket. Here is a
+template for the callback:
.RS
+.PP
.CS
proc httpHandlerCallback {socket token} {
upvar #0 $token state
# Access socket, and state as a Tcl array
+ # For example...
...
- (example: set data [read $socket 1000];set nbytes [string length $data])
+ set data [read $socket 1000]
+ set nbytes [string length $data]
...
- return nbytes
+ return $nbytes
}
.CE
.RE
.TP
-\fB\-headers\fP \fIkeyvaluelist\fP
+\fB\-headers\fR \fIkeyvaluelist\fR
+.
This option is used to add extra headers to the HTTP request. The
\fIkeyvaluelist\fR argument must be a list with an even number of
elements that alternate between keys and values. The keys become
@@ -195,11 +217,31 @@ header field names. Newlines are stripped from the values so the
header cannot be corrupted. For example, if \fIkeyvaluelist\fR is
\fBPragma no-cache\fR then the following header is included in the
HTTP request:
+.RS
+.PP
.CS
Pragma: no-cache
.CE
+.RE
.TP
-\fB\-progress\fP \fIcallback\fP
+\fB\-keepalive\fR \fIboolean\fR
+.
+If true, attempt to keep the connection open for servicing
+multiple requests. Default is 0.
+.TP
+\fB\-method\fR \fItype\fR
+.
+Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
+auto-select GET, POST or HEAD based on other options, but this option
+enables choices like PUT and DELETE for webdav support.
+.TP
+\fB\-myaddr\fR \fIaddress\fR
+.
+Pass an specific local address to the underlying \fBsocket\fR call in case
+multiple interfaces are available.
+.TP
+\fB\-progress\fR \fIcallback\fR
+.
The \fIcallback\fR is made after each transfer of data from the URL.
The callback gets three additional arguments: the \fItoken\fR from
\fB::http::geturl\fR, the expected total size of the contents from the
@@ -208,6 +250,7 @@ transferred so far. The expected total size may be unknown, in which
case zero is passed to the callback. Here is a template for the
progress callback:
.RS
+.PP
.CS
proc httpProgress {token total current} {
upvar #0 $token state
@@ -215,13 +258,21 @@ proc httpProgress {token total current} {
.CE
.RE
.TP
-\fB\-query\fP \fIquery\fP
+\fB\-protocol\fR \fIversion\fR
+.
+Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the
+default). Should only be necessary for servers that do not understand or
+otherwise complain about HTTP/1.1.
+.TP
+\fB\-query\fR \fIquery\fR
+.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
\fIquery\fR to the server. The \fIquery\fR must be an x-url-encoding
formatted query. The \fB::http::formatQuery\fR procedure can be used to
do the formatting.
.TP
-\fB\-queryblocksize\fP \fIsize\fP
+\fB\-queryblocksize\fR \fIsize\fR
+.
The block size used when posting query data to the URL.
At most
\fIsize\fR
@@ -229,102 +280,130 @@ bytes are written at once. After each block, a call to the
\fB\-queryprogress\fR
callback is made (if that option is specified).
.TP
-\fB\-querychannel\fP \fIchannelID\fP
+\fB\-querychannel\fR \fIchannelID\fR
+.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
data contained in \fIchannelID\fR to the server. The data contained in
\fIchannelID\fR must be an x-url-encoding
-formatted query unless the \fB\-type\fP option below is used.
+formatted query unless the \fB\-type\fR option below is used.
If a Content-Length header is not specified via the \fB\-headers\fR options,
\fB::http::geturl\fR attempts to determine the size of the post data
in order to create that header. If it is
unable to determine the size, it returns an error.
.TP
-\fB\-queryprogress\fP \fIcallback\fP
+\fB\-queryprogress\fR \fIcallback\fR
+.
The \fIcallback\fR is made after each transfer of data to the URL
(i.e. POST) and acts exactly like the \fB\-progress\fR option (the
callback format is the same).
.TP
-\fB\-timeout\fP \fImilliseconds\fP
+\fB\-strict\fR \fIboolean\fR
+.
+Whether to enforce RFC 3986 URL validation on the request. Default is 1.
+.TP
+\fB\-timeout\fR \fImilliseconds\fR
+.
If \fImilliseconds\fR is non-zero, then \fB::http::geturl\fR sets up a timeout
to occur after the specified number of milliseconds.
-A timeout results in a call to \fB::http::reset\fP and to
-the \fB-command\fP callback, if specified.
-The return value of \fB::http::status\fP is \fBtimeout\fP
+A timeout results in a call to \fB::http::reset\fR and to
+the \fB\-command\fR callback, if specified.
+The return value of \fB::http::status\fR is \fBtimeout\fR
after a timeout has occurred.
.TP
-\fB\-type\fP \fImime-type\fP
+\fB\-type\fR \fImime-type\fR
+.
Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the
default value (\fBapplication/x-www-form-urlencoded\fR) during a
POST operation.
.TP
-\fB\-validate\fP \fIboolean\fP
+\fB\-validate\fR \fIboolean\fR
+.
If \fIboolean\fR is non-zero, then \fB::http::geturl\fR does an HTTP HEAD
request. This request returns meta information about the URL, but the
contents are not returned. The meta information is available in the
-\fBstate(meta) \fR variable after the transaction. See the STATE
-ARRAY section for details.
+\fBstate(meta) \fR variable after the transaction. See the
+\fBSTATE ARRAY\fR section for details.
.RE
.TP
-\fB::http::formatQuery\fP \fIkey value\fP ?\fIkey value\fP ...?
+\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
+.
This procedure does x-url-encoding of query data. It takes an even
number of arguments that are the keys and values of the query. It
encodes the keys and values, and generates one string that has the
proper & and = separators. The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.
.TP
-\fB::http::reset\fP \fItoken\fP ?\fIwhy\fP?
-This command resets the HTTP transaction identified by \fItoken\fR, if
-any. This sets the \fBstate(status)\fP value to \fIwhy\fP, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback.
+\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
+.
+This command resets the HTTP transaction identified by \fItoken\fR, if any.
+This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to
+\fBreset\fR, and then calls the registered \fB\-command\fR callback.
.TP
-\fB::http::wait\fP \fItoken\fP
+\fB::http::wait\fR \fItoken\fR
+.
This is a convenience procedure that blocks and waits for the
transaction to complete. This only works in trusted code because it
-uses \fBvwait\fR. Also, it's not useful for the case where
-\fB::http::geturl\fP is called \fIwithout\fP the \fB-command\fP option
-because in this case the \fB::http::geturl\fP call doesn't return
-until the HTTP transaction is complete, and thus there's nothing to
+uses \fBvwait\fR. Also, it is not useful for the case where
+\fB::http::geturl\fR is called \fIwithout\fR the \fB\-command\fR option
+because in this case the \fB::http::geturl\fR call does not return
+until the HTTP transaction is complete, and thus there is nothing to
wait for.
.TP
-\fB::http::data\fP \fItoken\fP
-This is a convenience procedure that returns the \fBbody\fP element
+\fB::http::data\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBbody\fR element
(i.e., the URL data) of the state array.
.TP
-\fB::http::error\fP \fItoken\fP
-This is a convenience procedure that returns the \fBerror\fP element
+\fB::http::error\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBerror\fR element
of the state array.
.TP
-\fB::http::status\fP \fItoken\fP
-This is a convenience procedure that returns the \fBstatus\fP element of
+\fB::http::status\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBstatus\fR element of
the state array.
.TP
-\fB::http::code\fP \fItoken\fP
-This is a convenience procedure that returns the \fBhttp\fP element of the
+\fB::http::code\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBhttp\fR element of the
state array.
.TP
-\fB::http::ncode\fP \fItoken\fP
+\fB::http::ncode\fR \fItoken\fR
+.
This is a convenience procedure that returns just the numeric return
-code (200, 404, etc.) from the \fBhttp\fP element of the state array.
+code (200, 404, etc.) from the \fBhttp\fR element of the state array.
.TP
-\fB::http::size\fP \fItoken\fP
-This is a convenience procedure that returns the \fBcurrentsize\fP
+\fB::http::size\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBcurrentsize\fR
element of the state array, which represents the number of bytes
-received from the URL in the \fB::http::geturl\fP call.
+received from the URL in the \fB::http::geturl\fR call.
.TP
-\fB::http::cleanup\fP \fItoken\fP
+\fB::http::meta\fR \fItoken\fR
+.
+This is a convenience procedure that returns the \fBmeta\fR
+element of the state array which contains the HTTP response
+headers. See below for an explanation of this element.
+.TP
+\fB::http::cleanup\fR \fItoken\fR
+.
This procedure cleans up the state associated with the connection
-identified by \fItoken\fP. After this call, the procedures
-like \fB::http::data\fP cannot be used to get information
-about the operation. It is \fIstrongly\fP recommended that you call
-this function after you're done with a given HTTP request. Not doing
+identified by \fItoken\fR. After this call, the procedures
+like \fB::http::data\fR cannot be used to get information
+about the operation. It is \fIstrongly\fR recommended that you call
+this function after you are done with a given HTTP request. Not doing
so will result in memory not being freed, and if your app calls
-\fB::http::geturl\fP enough times, the memory leak could cause a
+\fB::http::geturl\fR enough times, the memory leak could cause a
performance hit...or worse.
.TP
-\fB::http::register\fP \fIproto port command\fP
+\fB::http::register\fR \fIproto port command\fR
+.
This procedure allows one to provide custom HTTP transport types
such as HTTPS, by registering a prefix, the default port, and the
command to execute to create the Tcl \fBchannel\fR. E.g.:
.RS
+.PP
.CS
package require http
package require tls
@@ -335,12 +414,12 @@ set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
-\fB::http::unregister\fP \fIproto\fP
+\fB::http::unregister\fR \fIproto\fR
+.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR.
-
-.SH "ERRORS"
-The \fB::http::geturl\fP procedure will raise errors in the following cases:
+.SH ERRORS
+The \fB::http::geturl\fR procedure will raise errors in the following cases:
invalid command line options,
an invalid URL,
a URL on a non-existent host,
@@ -349,102 +428,114 @@ These errors mean that it
cannot even start the network transaction.
It will also raise an error if it gets an I/O error while
writing out the HTTP request header.
-For synchronous \fB::http::geturl\fP calls (where \fB-command\fP is
+For synchronous \fB::http::geturl\fR calls (where \fB\-command\fR is
not specified), it will raise an error if it gets an I/O error while
-reading the HTTP reply headers or data. Because \fB::http::geturl\fP
-doesn't return a token in these cases, it does all the required
-cleanup and there's no issue of your app having to call
-\fB::http::cleanup\fP.
+reading the HTTP reply headers or data. Because \fB::http::geturl\fR
+does not return a token in these cases, it does all the required
+cleanup and there is no issue of your app having to call
+\fB::http::cleanup\fR.
.PP
-For asynchronous \fB::http::geturl\fP calls, all of the above error
-situations apply, except that if there's any error while
-reading the
+For asynchronous \fB::http::geturl\fR calls, all of the above error
+situations apply, except that if there is any error while reading the
HTTP reply headers or data, no exception is thrown. This is because
-after writing the HTTP headers, \fB::http::geturl\fP returns, and the
+after writing the HTTP headers, \fB::http::geturl\fR returns, and the
rest of the HTTP transaction occurs in the background. The command
callback can check if any error occurred during the read by calling
-\fB::http::status\fP to check the status and if its \fIerror\fP,
-calling \fB::http::error\fP to get the error message.
+\fB::http::status\fR to check the status and if its \fIerror\fR,
+calling \fB::http::error\fR to get the error message.
.PP
Alternatively, if the main program flow reaches a point where it needs
to know the result of the asynchronous HTTP request, it can call
-\fB::http::wait\fP and then check status and error, just as the
+\fB::http::wait\fR and then check status and error, just as the
callback does.
.PP
In any case, you must still call
-\fB::http::cleanup\fP to delete the state array when you're done.
+\fB::http::cleanup\fR to delete the state array when you are done.
.PP
There are other possible results of the HTTP transaction
-determined by examining the status from \fB::http::status\fP.
+determined by examining the status from \fB::http::status\fR.
These are described below.
.TP
-ok
-If the HTTP transaction completes entirely, then status will be \fBok\fP.
-However, you should still check the \fB::http::code\fP value to get
-the HTTP status. The \fB::http::ncode\fP procedure provides just
-the numeric error (e.g., 200, 404 or 500) while the \fB::http::code\fP
-procedure returns a value like "HTTP 404 File not found".
-.TP
-eof
+\fBok\fR
+.
+If the HTTP transaction completes entirely, then status will be \fBok\fR.
+However, you should still check the \fB::http::code\fR value to get
+the HTTP status. The \fB::http::ncode\fR procedure provides just
+the numeric error (e.g., 200, 404 or 500) while the \fB::http::code\fR
+procedure returns a value like
+.QW "HTTP 404 File not found" .
+.TP
+\fBeof\fR
+.
If the server closes the socket without replying, then no error
-is raised, but the status of the transaction will be \fBeof\fP.
+is raised, but the status of the transaction will be \fBeof\fR.
.TP
-error
-The error message will also be stored in the \fBerror\fP status
-array element, accessible via \fB::http::error\fP.
+\fBerror\fR
+.
+The error message will also be stored in the \fBerror\fR status
+array element, accessible via \fB::http::error\fR.
.PP
-Another error possibility is that \fB::http::geturl\fP is unable to
+Another error possibility is that \fB::http::geturl\fR is unable to
write all the post query data to the server before the server
responds and closes the socket.
-The error message is saved in the \fBposterror\fP status array
-element and then \fB::http::geturl\fP attempts to complete the
+The error message is saved in the \fBposterror\fR status array
+element and then \fB::http::geturl\fR attempts to complete the
transaction.
If it can read the server's response
-it will end up with an \fBok\fP status, otherwise it will have
-an \fBeof\fP status.
-
+it will end up with an \fBok\fR status, otherwise it will have
+an \fBeof\fR status.
.SH "STATE ARRAY"
The \fB::http::geturl\fR procedure returns a \fItoken\fR that can be used to
get to the state of the HTTP transaction in the form of a Tcl array.
Use this construct to create an easy-to-use array variable:
+.PP
.CS
upvar #0 $token state
.CE
+.PP
Once the data associated with the URL is no longer needed, the state
array should be unset to free up storage.
-The \fB::http::cleanup\fP procedure is provided for that purpose.
+The \fB::http::cleanup\fR procedure is provided for that purpose.
The following elements of
the array are supported:
.RS
.TP
\fBbody\fR
+.
The contents of the URL. This will be empty if the \fB\-channel\fR
-option has been specified. This value is returned by the \fB::http::data\fP command.
+option has been specified. This value is returned by the \fB::http::data\fR command.
.TP
\fBcharset\fR
+.
The value of the charset attribute from the \fBContent-Type\fR meta-data
value. If none was specified, this defaults to the RFC standard
\fBiso8859-1\fR, or the value of \fB$::http::defaultCharset\fR. Incoming
text data will be automatically converted from this charset to utf-8.
.TP
\fBcoding\fR
+.
A copy of the \fBContent-Encoding\fR meta-data value.
.TP
\fBcurrentsize\fR
+.
The current number of bytes fetched from the URL.
-This value is returned by the \fB::http::size\fP command.
+This value is returned by the \fB::http::size\fR command.
.TP
\fBerror\fR
+.
If defined, this is the error string seen when the HTTP transaction
was aborted.
.TP
\fBhttp\fR
+.
The HTTP status reply from the server. This value
-is returned by the \fB::http::code\fP command. The format of this value is:
+is returned by the \fB::http::code\fR command. The format of this value is:
.RS
+.PP
.CS
-\fIHTTP/1.0 code string\fP
+\fIHTTP/1.1 code string\fR
.CE
+.PP
The \fIcode\fR is a three-digit number defined in the HTTP standard.
A code of 200 is OK. Codes beginning with 4 or 5 indicate errors.
Codes beginning with 3 are redirection errors. In this case the
@@ -453,88 +544,103 @@ requested information.
.RE
.TP
\fBmeta\fR
+.
The HTTP protocol returns meta-data that describes the URL contents.
The \fBmeta\fR element of the state array is a list of the keys and
values of the meta-data. This is in a format useful for initializing
an array that just contains the meta-data:
.RS
+.PP
.CS
array set meta $state(meta)
.CE
+.PP
Some of the meta-data keys are listed below, but the HTTP standard defines
more, and servers are free to add their own.
.TP
\fBContent-Type\fR
+.
The type of the URL contents. Examples include \fBtext/html\fR,
\fBimage/gif,\fR \fBapplication/postscript\fR and
\fBapplication/x-tcl\fR.
.TP
\fBContent-Length\fR
+.
The advertised size of the contents. The actual size obtained by
-\fB::http::geturl\fR is available as \fBstate(size)\fR.
+\fB::http::geturl\fR is available as \fBstate(currentsize)\fR.
.TP
\fBLocation\fR
+.
An alternate URL that contains the requested data.
.RE
.TP
\fBposterror\fR
+.
The error, if any, that occurred while writing
the post query data to the server.
.TP
\fBstatus\fR
+.
Either \fBok\fR, for successful completion, \fBreset\fR for
-user-reset, \fBtimeout\fP if a timeout occurred before the transaction
+user-reset, \fBtimeout\fR if a timeout occurred before the transaction
could complete, or \fBerror\fR for an error condition. During the
transaction this value is the empty string.
.TP
\fBtotalsize\fR
+.
A copy of the \fBContent-Length\fR meta-data value.
.TP
\fBtype\fR
+.
A copy of the \fBContent-Type\fR meta-data value.
.TP
\fBurl\fR
+.
The requested URL.
.RE
.SH EXAMPLE
+.PP
+This example creates a procedure to copy a URL to a file while printing a
+progress meter, and prints the meta-data associated with the URL.
+.PP
.CS
-# Copy a URL to a file and print meta-data
proc httpcopy { url file {chunk 4096} } {
- set out [open $file w]
- set token [\fB::http::geturl\fR $url -channel $out \\
- -progress httpCopyProgress -blocksize $chunk]
- close $out
+ set out [open $file w]
+ set token [\fB::http::geturl\fR $url -channel $out \e
+ -progress httpCopyProgress -blocksize $chunk]
+ close $out
- # This ends the line started by httpCopyProgress
- puts stderr ""
+ # This ends the line started by httpCopyProgress
+ puts stderr ""
- upvar #0 $token state
- set max 0
- foreach {name value} $state(meta) {
- if {[string length $name] > $max} {
- set max [string length $name]
- }
- if {[regexp -nocase ^location$ $name]} {
- # Handle URL redirects
- puts stderr "Location:$value"
- return [httpcopy [string trim $value] $file $chunk]
- }
- }
- incr max
- foreach {name value} $state(meta) {
- puts [format "%-*s %s" $max $name: $value]
- }
+ upvar #0 $token state
+ set max 0
+ foreach {name value} $state(meta) {
+ if {[string length $name] > $max} {
+ set max [string length $name]
+ }
+ if {[regexp -nocase ^location$ $name]} {
+ # Handle URL redirects
+ puts stderr "Location:$value"
+ return [httpcopy [string trim $value] $file $chunk]
+ }
+ }
+ incr max
+ foreach {name value} $state(meta) {
+ puts [format "%-*s %s" $max $name: $value]
+ }
- return $token
+ return $token
}
proc httpCopyProgress {args} {
- puts -nonewline stderr .
- flush stderr
+ puts -nonewline stderr .
+ flush stderr
}
.CE
-
.SH "SEE ALSO"
safe(n), socket(n), safesock(n)
-
.SH KEYWORDS
-security policy, socket
+internet, security policy, socket, www
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/if.n b/doc/if.n
index cdbb130..776f811 100644
--- a/doc/if.n
+++ b/doc/if.n
@@ -5,10 +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: if.n,v 1.5 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH if n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -32,50 +30,59 @@ then \fBbody2\fR is executed, and so on.
If none of the expressions evaluates to true then \fIbodyN\fR is
executed.
The \fBthen\fR and \fBelse\fR arguments are optional
-``noise words'' to make the command easier to read.
+.QW "noise words"
+to make the command easier to read.
There may be any number of \fBelseif\fR clauses, including zero.
\fIBodyN\fR may also be omitted as long as \fBelse\fR is omitted too.
The return value from the command is the result of the body script
that was executed, or an empty string
if none of the expressions was non-zero and there was no \fIbodyN\fR.
.SH EXAMPLES
+.PP
A simple conditional:
+.PP
.CS
\fBif\fR {$vbl == 1} { puts "vbl is one" }
.CE
.PP
With an \fBelse\fR-clause:
+.PP
.CS
\fBif\fR {$vbl == 1} {
- puts "vbl is one"
+ puts "vbl is one"
} \fBelse\fR {
- puts "vbl is not one"
+ puts "vbl is not one"
}
.CE
.PP
With an \fBelseif\fR-clause too:
+.PP
.CS
\fBif\fR {$vbl == 1} {
- puts "vbl is one"
+ puts "vbl is one"
} \fBelseif\fR {$vbl == 2} {
- puts "vbl is two"
+ puts "vbl is two"
} \fBelse\fR {
- puts "vbl is not one or two"
+ puts "vbl is not one or two"
}
.CE
.PP
Remember, expressions can be multi-line, but in that case it can be a
good idea to use the optional \fBthen\fR keyword for clarity:
+.PP
.CS
\fBif\fR {
- $vbl == 1 || $vbl == 2 || $vbl == 3
+ $vbl == 1
+ || $vbl == 2
+ || $vbl == 3
} \fBthen\fR {
- puts "vbl is one, two or three"
+ puts "vbl is one, two or three"
}
.CE
-
.SH "SEE ALSO"
expr(n), for(n), foreach(n)
-
.SH KEYWORDS
boolean, conditional, else, false, if, true
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/incr.n b/doc/incr.n
index 1af0e85..9052c5a 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -5,10 +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: incr.n,v 1.5 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH incr n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ incr \- Increment the value of a variable
.SH SYNOPSIS
\fBincr \fIvarName \fR?\fIincrement\fR?
.BE
-
.SH DESCRIPTION
.PP
Increments the value stored in the variable whose name is \fIvarName\fR.
@@ -26,32 +23,39 @@ integer) is added to the value of variable \fIvarName\fR; otherwise
1 is added to \fIvarName\fR.
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
+.PP
+Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
+to \fBincr\fR may be unset, and in that case, it will be set to
+the value \fIincrement\fR or to the default increment value of \fB1\fR.
.SH EXAMPLES
+.PP
Add one to the contents of the variable \fIx\fR:
+.PP
.CS
\fBincr\fR x
.CE
.PP
Add 42 to the contents of the variable \fIx\fR:
+.PP
.CS
\fBincr\fR x 42
.CE
.PP
Add the contents of the variable \fIy\fR to the contents of the
variable \fIx\fR:
+.PP
.CS
\fBincr\fR x $y
.CE
.PP
Add nothing at all to the variable \fIx\fR (often useful for checking
-whether an argument to a procedure is actually numeric and generating
+whether an argument to a procedure is actually integral and generating
an error if it is not):
+.PP
.CS
\fBincr\fR x 0
.CE
-
.SH "SEE ALSO"
-expr(n)
-
+expr(n), set(n)
.SH KEYWORDS
add, increment, variable, value
diff --git a/doc/info.n b/doc/info.n
index 8bfee19..1ad908d 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -3,14 +3,13 @@
'\" 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-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.17 2005/05/30 00:04:45 dkf Exp $
-'\"
-.so man.macros
.TH info n 8.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,30 +17,37 @@ info \- Return information about the state of the Tcl interpreter
.SH SYNOPSIS
\fBinfo \fIoption \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command provides information about various internals of the Tcl
interpreter.
-The legal \fIoption\fR's (which may be abbreviated) are:
+The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBinfo args \fIprocname\fR
+.
Returns a list containing the names of the arguments to procedure
\fIprocname\fR, in order. \fIProcname\fR must be the name of a
Tcl command procedure.
.TP
\fBinfo body \fIprocname\fR
+.
Returns the body of procedure \fIprocname\fR. \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
+\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
+.VS 8.6
+Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
+described in \fBCLASS INTROSPECTION\fR below.
+.VE 8.6
+.TP
\fBinfo cmdcount\fR
+.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
\fBinfo commands \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified,
-'\" Do not move this .VS above the .TP
-.VS 8.5
+.
+If \fIpattern\fR is not specified,
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and
@@ -58,40 +64,202 @@ If \fIpattern\fR is a qualified name,
the resulting list of command names has each one qualified with the name
of the specified namespace, and only the commands defined in the named
namespace are returned.
-'\" Technically, most of this hasn't changed; that's mostly just the
-'\" way it always worked. Hardly anyone knew that though.
-.VE 8.5
+.\" Technically, most of this hasn't changed; that's mostly just the
+.\" way it always worked. Hardly anyone knew that though.
.TP
\fBinfo complete \fIcommand\fR
+.
Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of
having no unclosed quotes, braces, brackets or array element names.
-If the command doesn't appear to be complete then 0 is returned.
+If the command does not appear to be complete then 0 is returned.
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines; if the
-command isn't complete, the script can delay evaluating it until additional
+command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
+\fBinfo coroutine\fR
+.VS 8.6
+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
+.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure. If \fIarg\fR
-doesn't have a default value then the command returns \fB0\fR.
+does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
+\fBinfo errorstack \fR?\fIinterp\fR?
+.VS 8.6
+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
+.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
.TP
+\fBinfo frame\fR ?\fInumber\fR?
+.
+This command provides access to all frames on the stack, even those
+hidden from \fBinfo level\fR. If \fInumber\fR is not specified, this
+command returns a number giving the frame level of the command. This
+is 1 if the command is invoked at top-level. If \fInumber\fR is
+specified, then the result is a dictionary containing the location
+information for the command at the \fInumber\fRed level on the stack.
+.RS
+.PP
+If \fInumber\fR is positive (> 0) then it selects a particular stack
+level (1 refers to the outer-most active command, 2 to the command it
+called, and so on, up to the current frame level which refers to
+\fBinfo frame\fR itself); otherwise it gives a level relative to the
+current command (0 refers to the current command, i.e., \fBinfo
+frame\fR itself, -1 to its caller, and so on).
+.PP
+This is similar to how \fBinfo level\fR works, except that this
+subcommand reports all frames, like \fBsource\fRd scripts,
+\fBeval\fRs, \fBuplevel\fRs, etc.
+.PP
+Note that for nested commands, like
+.QW "foo [bar [x]]" ,
+only
+.QW x
+will be seen by an \fBinfo frame\fR invoked within
+.QW x .
+This is the same as for \fBinfo level\fR and error stack traces.
+.PP
+The result dictionary may contain the keys listed below, with the
+specified meanings for their values:
+.TP
+\fBtype\fR
+.
+This entry is always present and describes the nature of the location
+for the command. The recognized values are \fBsource\fR, \fBproc\fR,
+\fBeval\fR, and \fBprecompiled\fR.
+.RS
+.TP
+\fBsource\fR\0\0\0\0\0\0\0\0
+.
+means that the command is found in a script loaded by the \fBsource\fR
+command.
+.TP
+\fBproc\fR\0\0\0\0\0\0\0\0
+.
+means that the command is found in dynamically created procedure body.
+.TP
+\fBeval\fR\0\0\0\0\0\0\0\0
+.
+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 pre-compiled script (loadable by
+the package \fBtbcload\fR), and no further information will be
+available.
+.RE
+.TP
+\fBline\fR
+.
+This entry provides the number of the line the command is at inside of
+the script it is a part of. This information is not present for type
+\fBprecompiled\fR. For type \fBsource\fR this information is counted
+relative to the beginning of the file, whereas for the last two types
+the line is counted relative to the start of the script.
+.TP
+\fBfile\fR
+.
+This entry is present only for type \fBsource\fR. It provides the
+normalized path of the file the command is in.
+.TP
+\fBcmd\fR
+.
+This entry provides the string representation of the command. This is
+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
+.
+This entry is present only if the command is found in the body of a
+regular Tcl procedure. It then provides the name of that procedure.
+.TP
+\fBlambda\fR
+.
+This entry is present only if the command is found in the body of an
+anonymous Tcl procedure, i.e. a lambda. It then provides the entire
+definition of the lambda in question.
+.TP
+\fBlevel\fR
+.
+This entry is present only if the queried frame has a corresponding
+frame returned by \fBinfo level\fR. It provides the index of this
+frame, relative to the current level (0 and negative numbers).
+.PP
+A thing of note is that for procedures statically defined in files the
+locations of commands in their bodies will be reported with type
+\fBsource\fR and absolute line numbers, and not as type
+\fBproc\fR. The same is true for procedures nested in statically
+defined procedures, and literal eval scripts in files or statically
+defined procedures.
+.PP
+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.
+.PP
+A different way of describing this behaviour is that file based
+locations are tracked as deeply as possible, and where this is not
+possible the lines are counted based on the smallest possible
+\fBeval\fR or procedure body, as that scope is usually easier to find
+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 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
\fBinfo functions \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified, returns a list of all the math
+.
+If \fIpattern\fR is not specified, returns a list of all the math
functions currently defined.
If \fIpattern\fR is specified, only those functions whose name matches
\fIpattern\fR are returned. Matching is determined using the same
rules as for \fBstring match\fR.
.TP
\fBinfo globals \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified, returns a list of all the names
+.
+If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined global variables.
Global variables are variables in the global namespace.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
@@ -99,6 +267,7 @@ are returned. Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo hostname\fR
+.
Returns the name of the computer on which this invocation is being
executed.
Note that this name is not guaranteed to be the fully qualified domain
@@ -108,6 +277,7 @@ installed,) it is the name that is suitable for TCP/IP networking that
is returned.
.TP
\fBinfo level\fR ?\fInumber\fR?
+.
If \fInumber\fR is not specified, this command returns a number
giving the stack level of the invoking procedure, or 0 if the
command is invoked at top-level. If \fInumber\fR is specified,
@@ -121,13 +291,14 @@ See the \fBuplevel\fR command for more information on what stack
levels mean.
.TP
\fBinfo library\fR
+.
Returns the name of the library directory in which standard Tcl
scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
-See the \fBtclvars\fR manual entry for more information.
.TP
\fBinfo loaded \fR?\fIinterp\fR?
+.
Returns a list describing all of the packages that have been loaded into
\fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the
@@ -140,7 +311,8 @@ To get a list of just the packages in the current interpreter, specify
an empty string for the \fIinterp\fR argument.
.TP
\fBinfo locals \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified, returns a list of all the names
+.
+If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined local variables, including arguments to the
current procedure, if any.
Variables defined with the \fBglobal\fR, \fBupvar\fR and
@@ -150,16 +322,25 @@ are returned. Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo nameofexecutable\fR
+.
Returns the full path name of the binary file from which the application
was invoked. If Tcl was unable to identify the file, then an empty
string is returned.
.TP
+\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
+.VS 8.6
+Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
+described in \fBOBJECT INTROSPECTION\fR below.
+.VE 8.6
+.TP
\fBinfo patchlevel\fR
-Returns the value of the global variable \fBtcl_patchLevel\fR; see
-the \fBtclvars\fR manual entry for more information.
+.
+Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
+the exact version of the Tcl library by default.
.TP
\fBinfo procs \fR?\fIpattern\fR?
-If \fIpattern\fR isn't specified, returns a list of all the
+.
+If \fIpattern\fR is not specified, returns a list of all the
names of Tcl command procedures in the current namespace.
If \fIpattern\fR is specified,
only those procedure names in the current namespace
@@ -173,6 +354,7 @@ within; the matching pattern is taken to be the part after the last
namespace separator.
.TP
\fBinfo script\fR ?\fIfilename\fR?
+.
If a Tcl script file is currently being evaluated (i.e. there is a
call to \fBTcl_EvalFile\fR active or there is an active invocation
of the \fBsource\fR command), then this command returns the name
@@ -183,17 +365,20 @@ useful in virtual file system applications.
Otherwise the command returns an empty string.
.TP
\fBinfo sharedlibextension\fR
+.
Returns the extension used on this platform for the names of files
containing shared libraries (for example, \fB.so\fR under Solaris).
-If shared libraries aren't supported on this platform then an empty
+If shared libraries are not supported on this platform then an empty
string is returned.
.TP
\fBinfo tclversion\fR
-Returns the value of the global variable \fBtcl_version\fR; see
-the \fBtclvars\fR manual entry for more information.
+.
+Returns the value of the global variable \fBtcl_version\fR, which holds the
+major and minor version of the Tcl library by default.
.TP
\fBinfo vars\fR ?\fIpattern\fR?
-If \fIpattern\fR isn't specified,
+.
+If \fIpattern\fR is not specified,
returns a list of all the names of currently-visible variables.
This includes locals and currently-visible globals.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
@@ -208,11 +393,298 @@ If \fIpattern\fR is a qualified name,
the resulting list of variable names
has each matching namespace variable qualified with the name
of its namespace.
-Note that a currently-visible variable may not yet "exist" if it has not
+Note that a currently-visible variable may not yet
+.QW exist
+if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).
-.SH EXAMPLE
+.SS "CLASS INTROSPECTION"
+.VS 8.6
+.PP
+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 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 definition, and the second
+element is the body of the constructor. If no constructor is present, this
+returns the empty list.
+.VE 8.6
+.TP
+\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 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 definition, and
+the second element is the body of the method.
+.VE 8.6
+.TP
+\fBinfo class destructor\fI class\fR
+.VS 8.6
+This subcommand returns the body of the destructor of class \fIclass\fR. If no
+destructor is present, this returns the empty string.
+.VE 8.6
+.TP
+\fBinfo class filters\fI class\fR
+.VS 8.6
+This subcommand returns the list of filter methods set on the class.
+.VE 8.6
+.TP
+\fBinfo class forward\fI class method\fR
+.VS 8.6
+This subcommand returns the argument list for the method forwarding called
+\fImethod\fR that is set on the class called \fIclass\fR.
+.VE 8.6
+.TP
+\fBinfo class instances\fI class\fR ?\fIpattern\fR?
+.VS 8.6
+This subcommand returns a list of instances of class \fIclass\fR. If the
+optional \fIpattern\fR argument is present, it constrains the list of returned
+instances to those that match it according to the rules of \fBstring match\fR.
+.VE 8.6
+.TP
+\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
+.VS 8.6
+This subcommand returns a list of all public (i.e. exported) methods of the
+class called \fIclass\fR. Any of the following \fIoption\fRs may be
+specified, controlling exactly which method names are returned:
+.RS
+.VE 8.6
+.TP
+\fB\-all\fR
+.VS 8.6
+If the \fB\-all\fR flag is given, the list of methods will include those
+methods defined not just by the class, but also by the class's superclasses
+and mixins.
+.VE 8.6
+.TP
+\fB\-private\fR
+.VS 8.6
+If the \fB\-private\fR flag is given, the list of methods will also include
+the private (i.e. non-exported) methods of the class (and superclasses and
+mixins, if \fB\-all\fR is also given).
+.RE
+.VE 8.6
+.TP
+\fBinfo class methodtype\fI class method\fR
+.VS 8.6
+This subcommand returns a description of the type of implementation used for
+the method named \fImethod\fR of class \fIclass\fR. When the result is
+\fBmethod\fR, further information can be discovered with \fBinfo class
+definition\fR, and when the result is \fBforward\fR, further information can
+be discovered with \fBinfo class forward\fR.
+.VE 8.6
+.TP
+\fBinfo class mixins\fI class\fR
+.VS 8.6
+This subcommand returns a list of all classes that have been mixed into the
+class named \fIclass\fR.
+.VE 8.6
+.TP
+\fBinfo class subclasses\fI class\fR ?\fIpattern\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.
+.VE 8.6
+.TP
+\fBinfo class superclasses\fI class\fR
+.VS 8.6
+This subcommand returns a list of direct superclasses of class \fIclass\fR in
+inheritance precedence order.
+.VE 8.6
+.TP
+\fBinfo class variables\fI class\fR
+.VS 8.6
+This subcommand returns a list of all variables that have been declared for
+the class named \fIclass\fR (i.e. that are automatically present in the
+class's methods, constructor and destructor).
+.SS "OBJECT INTROSPECTION"
+.PP
+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
+\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
+boolean value indicating whether the \fIobject\fR is of that class.
+.VE 8.6
+.TP
+\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 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 definition,
+and the second element is the body of the method.
+.VE 8.6
+.TP
+\fBinfo object filters\fI object\fR
+.VS 8.6
+This subcommand returns the list of filter methods set on the object.
+.VE 8.6
+.TP
+\fBinfo object forward\fI object method\fR
+.VS 8.6
+This subcommand returns the argument list for the method forwarding called
+\fImethod\fR that is set on the object called \fIobject\fR.
+.VE 8.6
+.TP
+\fBinfo object isa\fI category object\fR ?\fIarg\fR?
+.VS 8.6
+This subcommand tests whether an object belongs to a particular category,
+returning a boolean value that indicates whether the \fIobject\fR argument
+meets the criteria for the category. The supported categories are:
+.VE 8.6
+.RS
+.TP
+\fBinfo object isa class\fI object\fR
+.VS 8.6
+This returns whether \fIobject\fR is a class (i.e. an instance of
+\fBoo::class\fR or one of its subclasses).
+.VE 8.6
+.TP
+\fBinfo object isa metaclass\fI object\fR
+.VS 8.6
+This returns whether \fIobject\fR is a class that can manufacture classes
+(i.e. is \fBoo::class\fR or a subclass of it).
+.VE 8.6
+.TP
+\fBinfo object isa mixin\fI object class\fR
+.VS 8.6
+This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
+.VE 8.6
+.TP
+\fBinfo object isa object\fI object\fR
+.VS 8.6
+This returns whether \fIobject\fR really is an object.
+.VE 8.6
+.TP
+\fBinfo object isa typeof\fI object class\fR
+.VS 8.6
+This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
+\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
+direct or indirect).
+.RE
+.VE 8.6
+.TP
+\fBinfo object methods\fI object\fR ?\fIoption...\fR?
+.VS 8.6
+This subcommand returns a list of all public (i.e. exported) methods of the
+object called \fIobject\fR. Any of the following \fIoption\fRs may be
+specified, controlling exactly which method names are returned:
+.RS
+.VE 8.6
+.TP
+\fB\-all\fR
+.VS 8.6
+If the \fB\-all\fR flag is given, the list of methods will include those
+methods defined not just by the object, but also by the object's class and
+mixins, plus the superclasses of those classes.
+.VE 8.6
+.TP
+\fB\-private\fR
+.VS 8.6
+If the \fB\-private\fR flag is given, the list of methods will also include
+the private (i.e. non-exported) methods of the object (and classes, if
+\fB\-all\fR is also given).
+.RE
+.VE 8.6
+.TP
+\fBinfo object methodtype\fI object method\fR
+.VS 8.6
+This subcommand returns a description of the type of implementation used for
+the method named \fImethod\fR of object \fIobject\fR. When the result is
+\fBmethod\fR, further information can be discovered with \fBinfo object
+definition\fR, and when the result is \fBforward\fR, further information can
+be discovered with \fBinfo object forward\fR.
+.VE 8.6
+.TP
+\fBinfo object mixins\fI object\fR
+.VS 8.6
+This subcommand returns a list of all classes that have been mixed into the
+object named \fIobject\fR.
+.VE 8.6
+.TP
+\fBinfo object namespace\fI object\fR
+.VS 8.6
+This subcommand returns the name of the internal namespace of the object named
+\fIobject\fR.
+.VE 8.6
+.TP
+\fBinfo object variables\fI object\fR
+.VS 8.6
+This subcommand returns a list of all variables that have been declared for
+the object named \fIobject\fR (i.e. that are automatically present in the
+object's methods).
+.VE 8.6
+.TP
+\fBinfo object vars\fI object\fR ?\fIpattern\fR?
+.VS 8.6
+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 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).
+.VE 8.6
+.SH EXAMPLES
+.PP
This command prints out a procedure suitable for saving in a Tcl
script:
+.PP
.CS
proc printProc {procName} {
set result [list proc $procName]
@@ -229,13 +701,77 @@ proc printProc {procName} {
puts [lappend result $formals [\fBinfo body\fR $procName]]
}
.CE
-
+.SS "EXAMPLES WITH OBJECTS"
+.VS 8.6
+.PP
+Every object necessarily knows what its class is; this information is
+trivially extractable through introspection:
+.PP
+.CS
+oo::class create c
+c create o
+puts [\fBinfo object class\fR o]
+ \fI\(-> prints "::c"\fR
+puts [\fBinfo object class\fR c]
+ \fI\(-> prints "::oo::class"\fR
+.CE
+.PP
+The introspection capabilities can be used to discover what class implements a
+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]
+ }
+ set cls [\fBinfo object class\fR $obj]
+ while {$method ni [\fBinfo class methods\fR $cls]} {
+ # Assume the simple case
+ set cls [lindex [\fBinfo class superclass\fR $cls] 0]
+ if {$cls eq ""} {
+ error "no definition for $method"
+ }
+ }
+ # Assume no forwards
+ return [\fBinfo class definition\fR $cls $method]
+}
+.CE
+.VE 8.6
.SH "SEE ALSO"
-global(n), proc(n)
-
+.VS 8.6
+global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
+.VE 8.6
+tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
-command, information, interpreter, level, namespace, procedure, variable
-
+command, information, interpreter, introspection, level, namespace,
+.VS 8.6
+object,
+.VE 8.6
+procedure, variable
'\" Local Variables:
'\" mode: nroff
+'\" fill-column: 78
'\" End:
diff --git a/doc/interp.n b/doc/interp.n
index c426bfc..92113a6 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -1,28 +1,26 @@
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2004 Donal K. Fellows
+'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" 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.24 2005/05/10 18:34:00 kennykb Exp $
-'\"
+.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
-.TH interp n 7.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
interp \- Create and manipulate Tcl interpreters
.SH SYNOPSIS
-\fBinterp \fIoption \fR?\fIarg arg ...\fR?
+\fBinterp \fIsubcommand \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
-This command makes it possible to create one or more new Tcl
+This command makes it possible to create one or more new Tcl
interpreters that co-exist with the creating interpreter in the
same application. The creating interpreter is called the \fImaster\fR
-and the new interpreter is called a \fIslave\fR.
+and the new interpreter is called a \fIslave\fR.
A master can create any number of slaves, and each slave can
itself create additional slaves for which it is master, resulting
in a hierarchy of interpreters.
@@ -36,10 +34,7 @@ command to be invoked in its master interpreter or in another slave
interpreter. The only other connections between interpreters are
through environment variables (the \fBenv\fR variable), which are
normally shared among all interpreters in the application,
-.VS 8.5
-and by resource limit exceeded callbacks.
-.VE 8.5
-Note that the
+and by resource limit exceeded callbacks. Note that the
name space for files (such as the names returned by the \fBopen\fR command)
is no longer shared between interpreters. Explicit commands are provided to
share files and to transfer references to open files from one interpreter
@@ -59,17 +54,25 @@ instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
-kernel call) between a slave interpreter and its master.
-See \fBALIAS INVOCATION\fR, below, for more details
+kernel call) between a slave interpreter and its master.
+See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl lists containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate master. Interpreter names are relative to the
-interpreter in 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
@@ -83,9 +86,10 @@ Both restrictions are motivated by safety concerns.
The \fBinterp\fR command is used to create, delete, and manipulate
slave interpreters, and to share or transfer
channels between interpreters. It can have any of several forms, depending
-on the \fIoption\fR argument:
+on the \fIsubcommand\fR argument:
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR
+.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
@@ -93,6 +97,7 @@ created; it is possible that the name of the source command in the
slave is different from \fIsrcToken\fR).
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
+.
Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
\fIsrcPath\fR.
\fIsrcToken\fR refers to the value returned when the alias
@@ -100,6 +105,7 @@ was created; if the source command has been renamed, the renamed
command will be deleted.
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
+.
This command creates an alias between one slave and another (see the
\fBalias\fR slave command below for creating aliases between a slave
and its master). In this command, either of the slave interpreters
@@ -107,11 +113,15 @@ may be anywhere in the hierarchy of interpreters under the interpreter
invoking the command.
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
\fISrcPath\fR is a Tcl list whose elements select a particular
-interpreter. For example, ``\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.
+interpreter. For example,
+.QW "\fBa b\fR"
+identifies an 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
@@ -121,29 +131,46 @@ already exist; it is not created by this command.
The alias arranges for the given target command to be invoked
in the target interpreter whenever the given source command is
invoked in the source interpreter. See \fBALIAS INVOCATION\fR below for
-more details.
+more details.
The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fBinterp\fR \fBaliases \fR?\fIpath\fR?
+.
This command returns a Tcl list of the tokens of all the source commands for
aliases defined in the interpreter identified by \fIpath\fR. The tokens
-correspond to the values returned when
-the aliases were created (which may not be the same
+correspond to the values returned when
+the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fBinterp bgerror \fIpath\fR ?\fIcmdPrefix\fR?
-.VS 8.5
-This command either gets or sets the current background error handler
+.
+This command either gets or sets the current background exception handler
for the interpreter identified by \fIpath\fR. If \fIcmdPrefix\fR is
-absent, the current background error handler is returned, and if it is
+absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
-what to set the interpreter's background error to. See the
-\fBBACKGROUND ERROR HANDLING\fR section for more details.
-.VE 8.5
+what to set the interpreter's background exception handler to. See the
+\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
+.TP
+\fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR?
+.VS 8.6
+Cancels the script being evaluated in the interpreter identified by
+\fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for
+the interpreter is unwound until an enclosing catch command is found or
+there are no further invocations of the interpreter left on the call
+stack. With the \fB\-unwind\fR switch the evaluation stack for the
+interpreter is unwound without regard to any intervening catch command
+until there are no further invocations of the interpreter left on the
+call stack. The \fB\-\|\-\fR switch can be used to mark the end of
+switches; it may be needed if \fIpath\fR is an unusual value such
+as \fB\-safe\fR. If \fIresult\fR is present, it will be used as the
+error message string; otherwise, a default error message string will be
+used.
+.VE 8.6
.TP
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
+.
Creates a slave interpreter identified by \fIpath\fR and a new command,
called a \fIslave command\fR. The name of the slave command is the last
component of \fIpath\fR. The new slave interpreter and the slave command
@@ -167,7 +194,50 @@ 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
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
@@ -175,12 +245,13 @@ For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
\fBinterp\fR \fBeval\fR \fIpath arg \fR?\fIarg ...\fR?
+.
This command concatenates all of the \fIarg\fR arguments in the same
fashion as the \fBconcat\fR command, then evaluates the resulting string as
a Tcl script in the slave interpreter identified by \fIpath\fR. The result
of this evaluation (including all \fBreturn\fR options,
-such as \fB-errorinfo\fR and \fB-errorcode\fR information, if an error occurs)
-is returned to the invoking interpreter.
+such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
+error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame of the
\fIpath\fR interpreter; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
@@ -188,11 +259,13 @@ the slave that find out information about the slave's current state
and stack frame.
.TP
\fBinterp exists \fIpath\fR
-Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
+.
+Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
invoking interpreter is used.
.TP
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
+.
Makes the hidden command \fIhiddenName\fR exposed, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
@@ -203,13 +276,14 @@ fails.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
\fBinterp\fR \fBhide\fR \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
+.
Makes the exposed command \fIexposedCmdName\fR hidden, renaming
it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if
-\fIhiddenCmdName\fR is not given, in the interpreter denoted
+\fIhiddenCmdName\fR is not given, in the interpreter denoted
by \fIpath\fR.
If a hidden command with the targeted name already exists, this command
fails.
-Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
+Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
@@ -218,41 +292,49 @@ command, by making the current namespace be different from the global one.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
\fBinterp\fR \fBhidden\fR \fIpath\fR
+.
Returns a list of the names of all hidden commands in the interpreter
identified by \fIpath\fR.
.TP
-\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fB-namespace\fR \fInamespace\fR? ?\fB-global\fR? ?\fB\-\|\-\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR?
+\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fI\-option ...\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR?
+.
Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied
in the interpreter denoted by \fIpath\fR. No substitutions or evaluation
-are applied to the arguments.
-If the \fB-namespace\fR flag is present, the hidden command is invoked in
-the specified namespace in the target interpreter.
-If the \fB-global\fR flag is present, the hidden command is invoked at the
+are applied to the arguments. Three \fI\-option\fRs are supported, all
+of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
+argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
+If the \fB\-namespace\fR flag is present, the hidden command is invoked in
+the namespace called \fInsName\fR in the target interpreter.
+If the \fB\-global\fR flag is present, the hidden command is invoked at the
global level in the target interpreter; otherwise it is invoked at the
current call frame and can access local variables in that and outer call
frames.
-If both the \fB-namespace\fR and \fB-global\fR flags are present, the
-\fB-namespace\fR flag is ignored.
+The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
+.QW \-
+character, and is otherwise unnecessary.
+If both the \fB\-namespace\fR and \fB\-global\fR flags are present, the
+\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of the \fIpath\fR interpreter.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
-\fBinterp\fR \fBlimit\fR \fIpath\fR \fIlimitType\fR ?\fIoption\fR? ?\fIvalue\fR \fI...\fR?
-.VS 8.5
+\fBinterp issafe\fR ?\fIpath\fR?
+.
+Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
+is safe, \fB0\fR otherwise.
+.TP
+\fBinterp\fR \fBlimit\fR \fIpath\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
+.
Sets up, manipulates and queries the configuration of the resource
limit \fIlimitType\fR for the interpreter denoted by \fIpath\fR. If
-no \fIoption\fR is specified, return the current configuration of the
-limit. If \fIoption\fR is the sole argument, return the value of that
-option. Otherwise, a list of \fIoption\fR/\fIvalue\fR argument pairs
+no \fI\-option\fR is specified, return the current configuration of the
+limit. If \fI\-option\fR is the sole argument, return the value of that
+option. Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs
must supplied. See \fBRESOURCE LIMITS\fR below for a more detailed
explanation of what limits and options are supported.
-.VE 8.5
-.TP
-\fBinterp issafe\fR ?\fIpath\fR?
-Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
-is safe, \fB0\fR otherwise.
.TP
\fBinterp marktrusted\fR \fIpath\fR
+.
Marks the interpreter identified by \fIpath\fR as trusted. Does
not expose the hidden commands. This command can only be invoked from a
trusted interpreter.
@@ -260,23 +342,27 @@ The command has no effect if the interpreter identified by \fIpath\fR is
already trusted.
.TP
\fBinterp\fR \fBrecursionlimit\fR \fIpath\fR ?\fInewlimit\fR?
+.
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
-maximum value of a non-long integer on the platform.
-.sp
+maximum value of a non-long integer on the platform.
+.RS
+.PP
The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
application. If your machine has a limit on the size of the C stack, you
may get stack overflows before reaching the limit set by the command. If
this happens, see if there is a mechanism in your system for increasing
-the maximum size of the C stack.
+the maximum size of the C stack.
+.RE
.TP
\fBinterp\fR \fBshare\fR \fIsrcPath channelId destPath\fR
+.
Causes the IO channel identified by \fIchannelId\fR to become shared
between the interpreter identified by \fIsrcPath\fR and the interpreter
identified by \fIdestPath\fR. Both interpreters have the same permissions
@@ -286,11 +372,13 @@ channels accessible in an interpreter are automatically closed when an
interpreter is destroyed.
.TP
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
+.
Returns a Tcl list of the names of all the slave interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
+.
Returns a Tcl list describing the target interpreter for an alias. The
alias is specified with an interpreter path and source command name, just
as in \fBinterp alias\fR above. The name of the target interpreter is
@@ -301,6 +389,7 @@ invoking interpreter or one of its descendants then an error is generated.
The target command does not have to be defined at the time of this invocation.
.TP
\fBinterp\fR \fBtransfer\fR \fIsrcPath channelId destPath\fR
+.
Causes the IO channel identified by \fIchannelId\fR to become available in
the interpreter identified by \fIdestPath\fR and unavailable in the
interpreter identified by \fIsrcPath\fR.
@@ -311,20 +400,24 @@ new Tcl command is created in the master interpreter with the same
name as the new interpreter. This command may be used to invoke
various operations on the interpreter. It has the following
general form:
+.PP
.CS
\fIslave command \fR?\fIarg arg ...\fR?
.CE
+.PP
\fISlave\fR is the name of the interpreter, and \fIcommand\fR
and the \fIarg\fRs determine the exact behavior of the command.
The valid forms of this command are:
.TP
\fIslave \fBaliases\fR
+.
Returns a Tcl list whose elements are the tokens of all the
aliases in \fIslave\fR. The tokens correspond to the values returned when
-the aliases were created (which may not be the same
+the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fIslave \fBalias \fIsrcToken\fR
+.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
@@ -332,12 +425,14 @@ created; it is possible that the actual source command in the
slave is different from \fIsrcToken\fR).
.TP
\fIslave \fBalias \fIsrcToken \fB{}\fR
+.
Deletes the alias for \fIsrcToken\fR in the slave interpreter.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
command will be deleted.
.TP
\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
+.
Creates an alias such that whenever \fIsrcCmd\fR is invoked
in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
@@ -349,22 +444,22 @@ The command returns a token that uniquely identifies the command created
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
-.VS 8.5
-This command either gets or sets the current background error handler
+.
+This command either gets or sets the current background exception handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
-absent, the current background error handler is returned, and if it is
+absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
-what to set the interpreter's background error to. See the
-\fBBACKGROUND ERROR HANDLING\fR section for more details.
-.VE 8.5
+what to set the interpreter's background exception handler to. See the
+\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
+.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIslave\fR.
The result of this evaluation (including all \fBreturn\fR options,
-such as \fB-errorinfo\fR and \fB-errorcode\fR information, if an error occurs)
-is returned to the invoking interpreter.
+such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
+error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame
of \fIslave\fR; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
@@ -372,6 +467,7 @@ the slave that find out information about the slave's current state
and stack frame.
.TP
\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
+.
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
@@ -381,12 +477,13 @@ fails.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
-This command hides the exposed command \fIexposedCmdName\fR, renaming it to
+.
+This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
argument is not given, in the \fIslave\fR interpreter.
If a hidden command with the targeted name already exists, this command
fails.
-Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
+Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden are looked up in the global
namespace even if the current namespace is not the global one. This
@@ -395,59 +492,70 @@ command, by making the current namespace be different from the global one.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhidden\fR
+.
Returns a list of the names of all hidden commands in \fIslave\fR.
.TP
-\fIslave \fBinvokehidden\fR ?\fB-namespace\fR \fInamespace\fR? ?\fB-global\fR ?\fB\-\|\-\fR? \fIhiddenName \fR?\fIarg ..\fR?
+\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
+.
This command invokes the hidden command \fIhiddenName\fR with the
supplied arguments, in \fIslave\fR. No substitutions or evaluations are
-applied to the arguments.
-If the \fB-namespace\fR flag is given, the hidden command is invoked in
+applied to the arguments. Three \fI\-option\fRs are supported, all
+of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
+argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
+If the \fB\-namespace\fR flag is given, the hidden command is invoked in
the specified namespace in the slave.
-If the \fB-global\fR flag is given, the command is invoked at the global
+If the \fB\-global\fR flag is given, the command is invoked at the global
level in the slave; otherwise it is invoked at the current call frame and
can access local variables in that or outer call frames.
-If both the \fB-namespace\fR and \fB-global\fR flags are given, the
-\fB-namespace\fR flag is ignored.
+The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
+.QW \-
+character, and is otherwise unnecessary.
+If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
+\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of \fIslave\fR.
-For more details on hidden commands,
+For more details on hidden commands,
see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBissafe\fR
+.
Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
.TP
-\fIslave \fBlimit\fR \fIlimitType\fR ?\fIoption\fR? ?\fIvalue\fR \fI...\fR?
-.VS 8.5
+\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
+.
Sets up, manipulates and queries the configuration of the resource
-limit \fIlimitType\fR for the slave interpreter. If no \fIoption\fR
+limit \fIlimitType\fR for the slave interpreter. If no \fI\-option\fR
is specified, return the current configuration of the limit. If
-\fIoption\fR is the sole argument, return the value of that option.
-Otherwise, a list of \fIoption\fR/\fIvalue\fR argument pairs must
+\fI\-option\fR is the sole argument, return the value of that option.
+Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
what limits and options are supported.
-.VE 8.5
.TP
\fIslave \fBmarktrusted\fR
+.
Marks the slave interpreter as trusted. Can only be invoked by a
trusted interpreter. This command does not expose any hidden
commands in the slave interpreter. The command has no effect if the slave
is already trusted.
.TP
\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
+.
Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
and related procedures in \fIslave\fR will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
-maximum value of a non-long integer on the platform.
-.sp
+maximum value of a non-long integer on the platform.
+.RS
+.PP
The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
application. If your machine has a limit on the size of the C stack, you
may get stack overflows before reaching the limit set by the command. If
this happens, see if there is a mechanism in your system for increasing
-the maximum size of the C stack.
+the maximum size of the C stack.
+.RE
.SH "SAFE INTERPRETERS"
.PP
A safe interpreter is one with restricted functionality, so that
@@ -473,31 +581,33 @@ A safe interpreter is created with exactly the following set of
built-in commands:
.DS
.ta 1.2i 2.4i 3.6i
-\fBafter append array binary
-break case catch clock
-close concat continue eof
-error eval expr fblocked
-fcopy fileevent flush for
-foreach format gets global
-if incr info interp
-join lappend lindex linsert
-list llength lrange lreplace
-lsearch lsort namespace package
-pid proc puts read
-regexp regsub rename return
-scan seek set split
-string subst switch tell
-time trace unset update
-uplevel upvar variable vwait
-while\fR
+\fBafter\fR \fBappend\fR \fBapply\fR \fBarray\fR
+\fBbinary\fR \fBbreak\fR \fBcatch\fR \fBchan\fR
+\fBclock\fR \fBclose\fR \fBconcat\fR \fBcontinue\fR
+\fBdict\fR \fBeof\fR \fBerror\fR \fBeval\fR
+\fBexpr\fR \fBfblocked\fR \fBfcopy\fR \fBfileevent\fR
+\fBflush\fR \fBfor\fR \fBforeach\fR \fBformat\fR
+\fBgets\fR \fBglobal\fR \fBif\fR \fBincr\fR
+\fBinfo\fR \fBinterp\fR \fBjoin\fR \fBlappend\fR
+\fBlassign\fR \fBlindex\fR \fBlinsert\fR \fBlist\fR
+\fBllength\fR \fBlrange\fR \fBlrepeat\fR \fBlreplace\fR
+\fBlsearch\fR \fBlset\fR \fBlsort\fR \fBnamespace\fR
+\fBpackage\fR \fBpid\fR \fBproc\fR \fBputs\fR
+\fBread\fR \fBregexp\fR \fBregsub\fR \fBrename\fR
+\fBreturn\fR \fBscan\fR \fBseek\fR \fBset\fR
+\fBsplit\fR \fBstring\fR \fBsubst\fR \fBswitch\fR
+\fBtell\fR \fBtime\fR \fBtrace\fR \fBunset\fR
+\fBupdate\fR \fBuplevel\fR \fBupvar\fR \fBvariable\fR
+\fBvwait\fR \fBwhile\fR
.DE
The following commands are hidden by \fBinterp create\fR when it
creates a safe interpreter:
.DS
.ta 1.2i 2.4i 3.6i
-\fBcd encoding exec exit
-fconfigure file glob load
-open pwd socket source\fR
+\fBcd\fR \fBencoding\fR \fBexec\fR \fBexit\fR
+\fBfconfigure\fR \fBfile\fR \fBglob\fR \fBload\fR
+\fBopen\fR \fBpwd\fR \fBsocket\fR \fBsource\fR
+\fBunload\fR
.DE
These commands can be recreated later as Tcl procedures or aliases, or
re-exposed by \fBinterp expose\fR.
@@ -506,25 +616,24 @@ The following commands from Tcl's library of support procedures are
not present in a safe interpreter:
.DS
.ta 1.6i 3.2i
-\fBauto_exec_ok auto_import auto_load
-auto_load_index auto_qualify unknown\fR
+\fBauto_exec_ok\fR \fBauto_import\fR \fBauto_load\fR
+\fBauto_load_index\fR \fBauto_qualify\fR \fBunknown\fR
.DE
Note in particular that safe interpreters have no default \fBunknown\fR
-command, so Tcl's default autoloading facilities are not available.
+command, so Tcl's default autoloading facilities are not available.
Autoload access to Tcl's commands that are normally autoloaded:
.DS
.ta 2.1i
-\fB
-auto_mkindex auto_mkindex_old
-auto_reset history
-parray pkg_mkIndex
-::pkg::create ::safe::interpAddToAccessPath
-::safe::interpCreate ::safe::interpConfigure
-::safe::interpDelete ::safe::interpFindInAccessPath
-::safe::interpInit ::safe::setLogCmd
-tcl_endOfWord tcl_findLibrary
-tcl_startOfNextWord tcl_startOfPreviousWord
-tcl_wordBreakAfter tcl_wordBreakBefore\fR
+\fBauto_mkindex\fR \fBauto_mkindex_old\fR
+\fBauto_reset\fR \fBhistory\fR
+\fBparray\fR \fBpkg_mkIndex\fR
+\fB::pkg::create\fR \fB::safe::interpAddToAccessPath\fR
+\fB::safe::interpCreate\fR \fB::safe::interpConfigure\fR
+\fB::safe::interpDelete\fR \fB::safe::interpFindInAccessPath\fR
+\fB::safe::interpInit\fR \fB::safe::setLogCmd\fR
+\fBtcl_endOfWord\fR \fBtcl_findLibrary\fR
+\fBtcl_startOfNextWord\fR \fBtcl_startOfPreviousWord\fR
+\fBtcl_wordBreakAfter\fR \fBtcl_wordBreakBefore\fR
.DE
can only be provided by explicit definition of an \fBunknown\fR command
in the safe interpreter. This will involve exposing the \fBsource\fR
@@ -567,9 +676,10 @@ as they would be for any other command invoked in that interpreter.
The command procedure for the source command takes its arguments
and merges them with the \fItargetCmd\fR and \fIarg\fRs for the
alias to create a new array of arguments. If the words
-of \fIsrcCmd\fR were ``\fIsrcCmd arg1 arg2 ... argN\fR'',
+of \fIsrcCmd\fR were
+.QW "\fIsrcCmd arg1 arg2 ... argN\fR" ,
the new set of words will be
-``\fItargetCmd arg arg ... arg arg1 arg2 ... argN\fR'',
+.QW "\fItargetCmd arg arg ... arg arg1 arg2 ... argN\fR" ,
where \fItargetCmd\fR and \fIarg\fRs are the values supplied when the
alias was created. \fITargetCmd\fR is then used to locate a command
procedure in the target interpreter, and that command procedure
@@ -657,139 +767,144 @@ namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
.SH "RESOURCE LIMITS"
-.VS 8.5
-.PP
-Every interpreter has two kinds of resource limits that may be imposed
-by any master interpreter upon its slaves. Command limits (of type
-\fBcommand\fR) restrict the total number of Tcl commands that may be
-executed by an interpreter (as can be inspected via the \fBinfo
-cmdcount\fR command), and time limits (of type \fBtime\fR) place a
-limit by which execution within the interpreter must complete.
-.PP
-When a limit is exceeded for an interpreter, first any handler
-callbacks defined by master interpreters are called. If those
-callbacks increase or remove the limit, execution within the
-(previously) limited interpreter continues. If the limit is still in
-force, an error is generated at that point and normal processing of
-errors within the interpreter (by the \fBcatch\fR command) is
-disabled, so the error propagates outwards (building a stack-trace as
-it goes) to the point where the limited interpreter was invoked
-(e.g. by \fBinterp eval\fR) where it becomes the responsibility of the
-calling code to catch and handle.
-.PP
-Every limit has a number of options associated with it, some of which
-are common across all kinds of limits, and others of which are
-particular to the kind of limit.
+.PP
+Every interpreter has two kinds of resource limits that may be imposed by any
+master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
+restrict the total number of Tcl commands that may be executed by an
+interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
+time limits (of type \fBtime\fR) place a limit by which execution within the
+interpreter must complete. Note that time limits are expressed as
+\fIabsolute\fR times (as in \fBclock seconds\fR) and not relative times (as in
+\fBafter\fR) because they may be modified after creation.
+.PP
+When a limit is exceeded for an interpreter, first any handler callbacks
+defined by master interpreters are called. If those callbacks increase or
+remove the limit, execution within the (previously) limited interpreter
+continues. If the limit is still in force, an error is generated at that point
+and normal processing of errors within the interpreter (by the \fBcatch\fR
+command) is disabled, so the error propagates outwards (building a stack-trace
+as it goes) to the point where the limited interpreter was invoked (e.g. by
+\fBinterp eval\fR) where it becomes the responsibility of the calling code to
+catch and handle.
+.SS "LIMIT OPTIONS"
+.PP
+Every limit has a number of options associated with it, some of which are
+common across all kinds of limits, and others of which are particular to the
+kind of limit.
.TP
\fB\-command\fR
-This option (common for all limit types) specifies (if non-empty) a
-Tcl script to be executed in the global namespace of the interpreter
-reading and writing the option when the particular limit in the
-limited interpreter is exceeded. The callback may modify the limit on
-the interpreter if it wishes the limited interpreter to continue
-executing. If the callback generates an error, it is reported through
-the background error mechansism (see \fBBACKGROUND ERROR HANDLING\fR).
-Note that the
-callbacks defined by one interpreter are completely isolated from the
-callbacks defined by another, and that the order in which those
-callbacks are called is undefined.
+.
+This option (common for all limit types) specifies (if non-empty) a Tcl script
+to be executed in the global namespace of the interpreter reading and writing
+the option when the particular limit in the limited interpreter is exceeded.
+The callback may modify the limit on the interpreter if it wishes the limited
+interpreter to continue executing. If the callback generates an exception, it
+is reported through the background exception mechanism (see
+\fBBACKGROUND EXCEPTION HANDLING\fR).
+Note that the callbacks defined by one interpreter are
+completely isolated from the callbacks defined by another, and that the order
+in which those callbacks are called is undefined.
.TP
\fB\-granularity\fR
-This option (common for all limit types) specifies how frequently (out
-of the points when the Tcl interpreter is in a consistent state where
-limit checking is possible) that the limit is actually checked. This
-allows the tuning of how frequently a limit is checked, and hence how
-often the limit-checking overhead (which may be substantial in the
-case of time limits) is incurred.
+.
+This option (common for all limit types) specifies how frequently (out of the
+points when the Tcl interpreter is in a consistent state where limit checking
+is possible) that the limit is actually checked. This allows the tuning of how
+frequently a limit is checked, and hence how often the limit-checking overhead
+(which may be substantial in the case of time limits) is incurred.
.TP
\fB\-milliseconds\fR
-This option specifies the number of milliseconds after the moment
-defined in the \fB\-seconds\fR option that the time limit will fire.
-It should only ever be specified in conjunction with the
-\fB\-seconds\fR option (whether it was set previously or is being set
-this invokation.)
+.
+This option specifies the number of milliseconds after the moment defined in
+the \fB\-seconds\fR option that the time limit will fire. It should only ever
+be specified in conjunction with the \fB\-seconds\fR option (whether it was
+set previously or is being set this invocation.)
.TP
\fB\-seconds\fR
-This option specifies the number of seconds after the epoch (see
-\fBclock seconds\fR) that the time limit for the interpreter will be
-triggered. The limit will be triggered at the start of the second
-unless specified at a sub-second level using the \fB\-milliseconds\fR
-option. This option may be the empty string, which indicates that a
-time limit is not set for the interpreter.
+.
+This option specifies the number of seconds after the epoch (see \fBclock
+seconds\fR) that the time limit for the interpreter will be triggered. The
+limit will be triggered at the start of the second unless specified at a
+sub-second level using the \fB\-milliseconds\fR option. This option may be the
+empty string, which indicates that a time limit is not set for the
+interpreter.
.TP
\fB\-value\fR
-This option specifies the number of commands that the interpreter may
-execute before triggering the command limit. This option may be the
-empty string, which indicates that a command limit is not set for the
-interpreter.
+.
+This option specifies the number of commands that the interpreter may execute
+before triggering the command limit. This option may be the empty string,
+which indicates that a command limit is not set for the interpreter.
.PP
Where an interpreter with a resource limit set on it creates a slave
-interpreter, that slave interpreter will have resource limits imposed
-on it that are at least as restrictive as the limits on the creating
-master interpreter. If the master interpreter of the limited master
-wishes to relax these conditions, it should hide the \fBinterp\fR
-command in the child and then use aliases and the \fBinterp
-invokehidden\fR subcommand to provide such access as it chooses to the
-\fBinterp\fR command to the limited master as necessary.
-.VE 8.5
-.SH "BACKGROUND ERROR HANDLING"
-.VS 8.5
-When an error happens in a situation where it cannot be reported
-directly up the stack (e.g. when processing events in an \fBupdate\fR
-or \fBvwait\fR call) the error is instead reported through the
-background error handling mechanism. Every interpreter has a
-background error handler registered; the default error handler
-arranges for the \fBbgerror\fR command in the interpreter's global
-namespace to be called, but other error handlers may be installed and
-process background errors in substantially different ways.
-.PP
-A background error handler consists of a non-empty list of words to
-which will, at invokation time, be appended two further words. The
-first word will be the error message string, and the second will a
-dictionary of return options (this is also the sort of information
-that can be obtained by trapping a normal error using \fBcatch\fR of
-course.) The resulting list will then be executed in the interpreter's
-global namespace without further substitutions being performed.
-.VE 8.5
+interpreter, that slave interpreter will have resource limits imposed on it
+that are at least as restrictive as the limits on the creating master
+interpreter. If the master interpreter of the limited master wishes to relax
+these conditions, it should hide the \fBinterp\fR command in the child and
+then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
+access as it chooses to the \fBinterp\fR command to the limited master as
+necessary.
+.SH "BACKGROUND EXCEPTION HANDLING"
+.PP
+When an exception happens in a situation where it cannot be reported directly up
+the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call)
+the exception is instead reported through the background exception handling mechanism.
+Every interpreter has a background exception handler registered; the default exception
+handler arranges for the \fBbgerror\fR command in the interpreter's global
+namespace to be called, but other exception handlers may be installed and process
+background exceptions in substantially different ways.
+.PP
+A background exception handler consists of a non-empty list of words to which will
+be appended two further words at invocation time. The first word will be the
+interpreter result at time of the exception, typically an error message,
+and the second will be the dictionary of return options at the time of
+the exception. These are the same values that \fBcatch\fR can capture
+when it controls script evaluation in a non-background situation.
+The resulting list will then be executed
+in the interpreter's global namespace without further substitutions being
+performed.
.SH CREDITS
-This mechanism is based on the Safe-Tcl prototype implemented
+The safe interpreter mechanism is based on the Safe-Tcl prototype implemented
by Nathaniel Borenstein and Marshall Rose.
.SH EXAMPLES
+.PP
Creating and using an alias for a command in the current interpreter:
+.PP
.CS
\fBinterp alias\fR {} getIndex {} lsearch {alpha beta gamma delta}
set idx [getIndex delta]
.CE
.PP
Executing an arbitrary command in a safe interpreter where every
-invokation of \fBlappend\fR is logged:
+invocation of \fBlappend\fR is logged:
+.PP
.CS
set i [\fBinterp create\fR -safe]
\fBinterp hide\fR $i lappend
\fBinterp alias\fR $i lappend {} loggedLappend $i
proc loggedLappend {i args} {
- puts "logged invokation of lappend $args"
- \fBinterp invokehidden\fR $i lappend {expand}$args
+ puts "logged invocation of lappend $args"
+ \fBinterp invokehidden\fR $i lappend {*}$args
}
\fBinterp eval\fR $i $someUntrustedScript
.CE
.PP
-.VS 8.5
Setting a resource limit on an interpreter so that an infinite loop
terminates.
+.PP
.CS
set i [\fBinterp create\fR]
\fBinterp limit\fR $i command -value 1000
\fBinterp eval\fR $i {
- set x 0
- while {1} {
- puts "Counting up... [incr x]"
- }
+ set x 0
+ while {1} {
+ puts "Counting up... [incr x]"
+ }
}
.CE
-.VE 8.5
-
.SH "SEE ALSO"
-bgerror(n), load(n), safe(n), Tcl_CreateSlave(3)
+bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
.SH KEYWORDS
alias, master interpreter, safe interpreter, slave interpreter
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/join.n b/doc/join.n
index bf26c44..c8179bb 100644
--- a/doc/join.n
+++ b/doc/join.n
@@ -5,10 +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: join.n,v 1.5 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH join n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ join \- Create a string by joining together list elements
.SH SYNOPSIS
\fBjoin \fIlist \fR?\fIjoinString\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fIlist\fR argument must be a valid Tcl list.
@@ -25,22 +22,23 @@ formed by joining all of the elements of \fIlist\fR together with
\fIjoinString\fR separating each adjacent pair of elements.
The \fIjoinString\fR argument defaults to a space character.
.SH EXAMPLES
+.PP
Making a comma-separated list:
+.PP
.CS
set data {1 2 3 4 5}
\fBjoin\fR $data ", "
- \fB=> 1, 2, 3, 4, 5\fR
+ \fB\(-> 1, 2, 3, 4, 5\fR
.CE
.PP
Using \fBjoin\fR to flatten a list by a single level:
+.PP
.CS
set data {1 {2 3} 4 {5 {6 7} 8}}
\fBjoin\fR $data
- \fB=> 1 2 3 4 5 {6 7} 8\fR
+ \fB\(-> 1 2 3 4 5 {6 7} 8\fR
.CE
-
.SH "SEE ALSO"
list(n), lappend(n), split(n)
-
.SH KEYWORDS
element, join, list, separator
diff --git a/doc/lappend.n b/doc/lappend.n
index 38c52e5..a324ca3 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: lappend.n,v 1.11 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH lappend n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,22 +15,25 @@ lappend \- Append list elements onto a variable
.SH SYNOPSIS
\fBlappend \fIvarName \fR?\fIvalue value value ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command treats the variable given by \fIvarName\fR as a list
and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
-If \fIvarName\fR doesn't exist, it is created as a list with elements
+If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
-large lists. For example, ``\fBlappend a $b\fR'' is much
-more efficient than ``\fBset a [concat $a [list $b]]\fR'' when
-\fB$a\fR is long.
+large lists. For example,
+.QW "\fBlappend a $b\fR"
+is much more efficient than
+.QW "\fBset a [concat $a [list $b]]\fR"
+when \fB$a\fR is long.
.SH EXAMPLE
+.PP
Using \fBlappend\fR to build up a list of numbers.
+.PP
.CS
% set var 1
1
@@ -41,10 +42,8 @@ Using \fBlappend\fR to build up a list of numbers.
% \fBlappend\fR var 3 4 5
1 2 3 4 5
.CE
-
.SH "SEE ALSO"
list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)
-
.SH KEYWORDS
append, element, list, variable
diff --git a/doc/lassign.n b/doc/lassign.n
index f27422d..e250729 100644
--- a/doc/lassign.n
+++ b/doc/lassign.n
@@ -5,18 +5,15 @@
'\" 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.1 2004/01/17 00:28:08 dkf Exp $
-'\"
-.so man.macros
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lassign \- Assign list elements to variables
.SH SYNOPSIS
-\fBlassign \fIlist varName \fR?\fIvarName ...\fR?
+\fBlassign \fIlist \fR?\fIvarName ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command treats the value \fIlist\fR as a list and assigns
@@ -26,30 +23,38 @@ than list elements, the remaining variables are set to the empty
string. If there are more list elements than variables, a list of
unassigned elements is returned.
.SH EXAMPLES
+.PP
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
+.PP
The \fBlassign\fR command has other uses. It can be used to create
-the analogue of the "shift" command in many shell languages like this:
+the analogue of the
+.QW shift
+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:
+'\"mode: nroff
+'\"End:
diff --git a/doc/library.n b/doc/library.n
index 8845ef8..775b7d9 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -5,19 +5,17 @@
'\" 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.17 2004/06/16 21:20:42 dgp Exp $
-.so man.macros
.TH library n "8.0" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
.SH NAME
-auto_execok, auto_import, auto_load, auto_mkindex, auto_mkindex_old, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
+auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
.SH SYNOPSIS
.nf
\fBauto_execok \fIcmd\fR
\fBauto_import \fIpattern\fR
\fBauto_load \fIcmd\fR
\fBauto_mkindex \fIdir pattern pattern ...\fR
-\fBauto_mkindex_old \fIdir pattern pattern ...\fR
\fBauto_qualify \fIcommand namespace\fR
\fBauto_reset\fR
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
@@ -28,7 +26,6 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_mkindex_old, auto_qualif
\fBtcl_wordBreakAfter \fIstr start\fR
\fBtcl_wordBreakBefore \fIstr start\fR
.BE
-
.SH INTRODUCTION
.PP
Tcl includes a library of Tcl procedures for commonly-needed functions.
@@ -41,20 +38,21 @@ its own library of support procedures as well; the location of this
library is normally given by the value of the \fB$\fIapp\fB_library\fR
global variable, where \fIapp\fR is the name of the application.
For example, the location of the Tk library is kept in the variable
-\fB$tk_library\fR.
+\fBtk_library\fR.
.PP
To access the procedures in the Tcl library, an application should
source the file \fBinit.tcl\fR in the library, for example with
the Tcl command
+.PP
.CS
\fBsource [file join [info library] init.tcl]\fR
.CE
+.PP
If the library procedure \fBTcl_Init\fR is invoked from an application's
\fBTcl_AppInit\fR procedure, this happens automatically.
The code in \fBinit.tcl\fR will define the \fBunknown\fR procedure
and arrange for the other procedures to be loaded on-demand using
the auto-load mechanism defined below.
-
.SH "COMMAND PROCEDURES"
.PP
The following procedures are provided in the Tcl library:
@@ -67,7 +65,7 @@ named by \fIcmd\fR. If not, it returns an empty string. This command
examines the directories in the current search path (given by the PATH
environment variable) in its search for an executable file named
\fIcmd\fR. On Windows platforms, the search is expanded with the same
-directories and file extensions as used by \fBexec\fR. \fBAuto_exec\fR
+directories and file extensions as used by \fBexec\fR. \fBAuto_execok\fR
remembers information about previous searches in an array named
\fBauto_execs\fR; this avoids the path search in future calls for the
same \fIcmd\fR. The command \fBauto_reset\fR may be used to force
@@ -86,8 +84,8 @@ matching rules of \fBnamespace import\fR.
This command attempts to load the definition for a Tcl command named
\fIcmd\fR. To do this, it searches an \fIauto-load path\fR, which is
a list of one or more directories. The auto-load path is given by the
-global variable \fB$auto_path\fR if it exists. If there is no
-\fB$auto_path\fR variable, then the TCLLIBPATH environment variable is
+global variable \fBauto_path\fR if it exists. If there is no
+\fBauto_path\fR variable, then the TCLLIBPATH environment variable is
used, if it exists. Otherwise the auto-load path consists of just the
Tcl library directory. Within each directory in the auto-load path
there must be a file \fBtclIndex\fR that describes one or more
@@ -97,7 +95,7 @@ with the \fBauto_mkindex\fR command. If \fIcmd\fR is found in an
index file, then the appropriate script is evaluated to create the
command. The \fBauto_load\fR command returns 1 if \fIcmd\fR was
successfully created. The command returns 0 if there was no index
-entry for \fIcmd\fR or if the script didn't actually define \fIcmd\fR
+entry for \fIcmd\fR or if the script did not actually define \fIcmd\fR
(e.g. because index information is out of date). If an error occurs
while processing the script, then that error is returned.
\fBAuto_load\fR only reads the index information once and saves it in
@@ -108,6 +106,7 @@ cached index information may be deleted with the command
reload the index database from disk.
.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
+.
Generates an index suitable for use by \fBauto_load\fR. The command
searches \fIdir\fR for all files whose names match any of the
\fIpattern\fR arguments (matching is done with the \fBglob\fR
@@ -116,10 +115,11 @@ in all the matching files, and stores the index information in a file
named \fBtclIndex\fR in \fIdir\fR. If no pattern is given a pattern of
\fB*.tcl\fR will be assumed. For example, the command
.RS
+.PP
.CS
\fBauto_mkindex foo *.tcl\fR
.CE
-.LP
+.PP
will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
generate a new index file \fBfoo/tclIndex\fR.
.PP
@@ -130,24 +130,30 @@ auto_mkindex_parser package to register other commands that can
contribute to the auto_load index. You will have to read through
auto.tcl to see how this works.
.PP
-\fBAuto_mkindex_old\fR parses the Tcl scripts in a relatively
-unsophisticated way: if any line contains the word \fBproc\fR
+\fBAuto_mkindex_old\fR
+(which has the same syntax as \fBauto_mkindex\fR)
+parses the Tcl scripts in a relatively
+unsophisticated way: if any line contains the word
+.QW \fBproc\fR
as its first characters then it is assumed to be a procedure
definition and the next word of the line is taken as the
procedure's name.
-Procedure definitions that don't appear in this way (e.g. they
+Procedure definitions that do not appear in this way (e.g.\ they
have spaces before the \fBproc\fR) will not be indexed. If your
-script contains "dangerous" code, such as global initialization
+script contains
+.QW dangerous
+code, such as global initialization
code or procedure names with special characters like \fB$\fR,
-\fB*\fR, \fB[\fR or \fB]\fR, you are safer using auto_mkindex_old.
+\fB*\fR, \fB[\fR or \fB]\fR, you are safer using \fBauto_mkindex_old\fR.
.RE
.TP
\fBauto_reset\fR
+.
Destroys all the information cached by \fBauto_execok\fR and
\fBauto_load\fR. This information will be re-read from disk the next
time it is needed. \fBAuto_reset\fR also deletes any procedures
listed in the auto-load index, so that fresh copies of them will be
-loaded the next time that they're used.
+loaded the next time that they are used.
.TP
\fBauto_qualify \fIcommand namespace\fR
Computes a list of fully qualified names for \fIcommand\fR. This list
@@ -173,25 +179,27 @@ This is a standard search procedure for use by extensions during
their initialization. They call this procedure to look for their
script library in several standard directories.
The last component of the name of the library directory is
-normally \fIbasenameversion\fP
-(e.g., tk8.0), but it might be "library" when in the build hierarchies.
+normally \fIbasenameversion\fR
+(e.g., tk8.0), but it might be
+.QW library
+when in the build hierarchies.
The \fIinitScript\fR file will be sourced into the interpreter
once it is found. The directory in which this file is found is
-stored into the global variable \fIvarName\fP.
+stored into the global variable \fIvarName\fR.
If this variable is already defined (e.g., by C code during
application initialization) then no searching is done.
Otherwise the search looks in these directories:
-the directory named by the environment variable \fIenVarName\fP;
+the directory named by the environment variable \fIenVarName\fR;
relative to the Tcl library directory;
relative to the executable file in the standard installation
-bin or bin/\fIarch\fP directory;
+bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR
Prints on standard output the names and values of all the elements
in the array \fIarrayName\fR.
-\fBArrayName\fR must be an array accessible to the caller of \fBparray\fR.
+\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
.TP
\fBtcl_endOfWord \fIstr start\fR
@@ -230,11 +238,12 @@ Returns the index of the first word boundary before the starting index
boundaries before the starting point in the given string. The index
returned refers to the second character of the pair that comprises a
boundary.
-
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
-the Tcl library:
+the Tcl library. They fall into two broad classes, handling unknown
+commands and packages, and determining what are words.
+.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP
\fBauto_execs\fR
Used by \fBauto_execok\fR to record information about whether
@@ -253,26 +262,36 @@ If set to any value, then \fBunknown\fR will not attempt to auto-load
any commands.
.TP
\fBauto_path\fR
+.
If set, then it must contain a valid Tcl list giving directories to
-search during auto-load operations.
+search during auto-load operations (including for package index
+files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
-the directories listed in the TCLLIBPATH environment variable,
-the directory named by the $tcl_library variable,
-the parent directory of $tcl_library,
-the directories listed in the $tcl_pkgPath variable.
+the directories listed in the \fBTCLLIBPATH\fR environment variable,
+the directory named by the \fBtcl_library\fR global variable,
+the parent directory of \fBtcl_library\fR,
+the directories listed in the \fBtcl_pkgPath\fR variable.
+Additional locations to look for files and package indices should
+normally be added to this variable using \fBlappend\fR.
.TP
\fBenv(TCL_LIBRARY)\fR
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
-the command \fBinfo library\fR). If this variable isn't set then
+the command \fBinfo library\fR). If this variable is not set then
a default value is used.
.TP
\fBenv(TCLLIBPATH)\fR
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations. Directories must be specified in
-Tcl format, using "/" as the path separator, regardless of platform.
+Tcl format, using
+.QW /
+as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
+.SS "WORD BOUNDARY DETERMINATION VARIABLES"
+These variables are only used in the \fBtcl_endOfWord\fR,
+\fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR,
+\fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands.
.TP
\fBtcl_nonwordchars\fR
This variable contains a regular expression that is used by routines
@@ -290,9 +309,10 @@ word or not. If the pattern matches a character, the character is
considered to be a word character. On Windows platforms, words are
comprised of any character that is not a space, tab, or newline. Under
Unix, words are comprised of numbers, letters or underscores.
-
.SH "SEE ALSO"
-info(n), re_syntax(n)
-
+env(n), info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/lindex.n b/doc/lindex.n
index 10981c1..b42904b 100644
--- a/doc/lindex.n
+++ b/doc/lindex.n
@@ -1,38 +1,40 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>. 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: lindex.n,v 1.11 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
-\fBlindex \fIlist ?index...?\fR
+\fBlindex \fIlist ?index ...?\fR
.BE
.SH DESCRIPTION
.PP
-The \fBlindex\fP command accepts a parameter, \fIlist\fP, which
-it treats as a Tcl list. It also accepts zero or more \fIindices\fP into
+The \fBlindex\fR command accepts a parameter, \fIlist\fR, which
+it treats as a Tcl list. It also accepts zero or more \fIindices\fR into
the list. The indices may be presented either consecutively on the
command line, or grouped in a
Tcl list and presented as a single argument.
.PP
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
\fIlist\fR parameter.
.PP
@@ -46,45 +48,78 @@ substitution and command substitution do not occur.
If \fIindex\fR is negative or greater than or equal to the number
of elements in \fIvalue\fR, then an empty
string is returned.
-.VS 8.5
The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
-.VE 8.5
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
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
+Lists can be indexed into from either end:
+.PP
+.CS
+\fBlindex\fR {a b c} 0
+ \fI\(-> a\fR
+\fBlindex\fR {a b c} 2
+ \fI\(-> c\fR
+\fBlindex\fR {a b c} end
+ \fI\(-> c\fR
+\fBlindex\fR {a b c} end-1
+ \fI\(-> b\fR
+.CE
+.PP
+Lists or sequences of indices allow selection into lists of lists:
+.PP
+.CS
+\fBlindex\fR {a b c}
+ \fI\(-> a b c\fR
+\fBlindex\fR {a b c} {}
+ \fI\(-> a b c\fR
+\fBlindex\fR {{a b c} {d e f} {g h i}} 2 1
+ \fI\(-> h\fR
+\fBlindex\fR {{a b c} {d e f} {g h i}} {2 1}
+ \fI\(-> h\fR
+\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} 1 1 0
+ \fI\(-> g\fR
+\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} {1 1 0}
+ \fI\(-> g\fR
+.CE
+.PP
+List indices may also perform limited computation, adding or subtracting fixed
+amounts from other indices:
+.PP
.CS
-\fBlindex\fR {a b c} \fI=> a b c\fR
-\fBlindex\fR {a b c} {} \fI=> a b c\fR
-\fBlindex\fR {a b c} 0 \fI=> a\fR
-\fBlindex\fR {a b c} 2 \fI=> c\fR
-\fBlindex\fR {a b c} end \fI=> c\fR
-\fBlindex\fR {a b c} end-1 \fI=> b\fR
-\fBlindex\fR {{a b c} {d e f} {g h i}} 2 1 \fI=> h\fR
-\fBlindex\fR {{a b c} {d e f} {g h i}} {2 1} \fI=> h\fR
-\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} 1 1 0 \fI=> g\fR
-\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} {1 1 0} \fI=> g\fR
+set idx 1
+\fBlindex\fR {a b c d e f} $idx+2
+ \fI\(-> d\fR
+set idx 3
+\fBlindex\fR {a b c d e f} $idx+2
+ \fI\(-> f\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n),
-.VS 8.5
string(n)
-.VE
-
.SH KEYWORDS
element, index, list
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/linsert.n b/doc/linsert.n
index d6384d2..51b64cf 100644
--- a/doc/linsert.n
+++ b/doc/linsert.n
@@ -1,38 +1,42 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: linsert.n,v 1.13 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH linsert n 8.2 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
linsert \- Insert elements into a list
.SH SYNOPSIS
-\fBlinsert \fIlist index element \fR?\fIelement element ...\fR?
+\fBlinsert \fIlist index \fR?\fIelement element ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command produces a new list from \fIlist\fR by inserting all of the
\fIelement\fR arguments just before the \fIindex\fR'th element of
\fIlist\fR. Each \fIelement\fR argument will become a separate element of
the new list. If \fIindex\fR is less than or equal to zero, then the new
-elements are inserted at the beginning of the list.
-.VS 8.5
-The interpretation of the \fIindex\fR value is the same as
-for the command \fBstring index\fR, supporting simple index
-arithmetic and indices relative to the end of the list.
-.VE
+elements are inserted at the beginning of the list, and if \fIindex\fR is
+greater or equal to the length of \fIlist\fR, it is as if it was \fBend\fR.
+As with \fBstring index\fR, the \fIindex\fR value supports both simple index
+arithmetic and end-relative indexing.
+.PP
+Subject to the restrictions that indices must refer to locations inside the
+list and that the \fIelement\fRs will always be inserted in order, insertions
+are done so that when \fIindex\fR is start-relative, the first \fIelement\fR
+will be at that index in the resulting list, and when \fIindex\fR is
+end-relative, the last \fIelement\fR will be at that index in the resulting
+list.
.SH EXAMPLE
+.PP
Putting some values into a list, first indexing from the start and
then indexing from the end, and then chaining them together:
+.PP
.CS
set oldList {the fox jumps over the dog}
set midList [\fBlinsert\fR $oldList 1 quick]
@@ -40,13 +44,12 @@ set newList [\fBlinsert\fR $midList end-1 lazy]
# The old lists still exist though...
set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy]
.CE
-
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), llength(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n),
-.VS 8.5
string(n)
-.VE
-
.SH KEYWORDS
element, insert, list
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/list.n b/doc/list.n
index d444033..c2797f3 100644
--- a/doc/list.n
+++ b/doc/list.n
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: list.n,v 1.10 2004/10/27 12:53:22 dkf Exp $
-'\"
-.so man.macros
.TH list n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,7 +15,6 @@ list \- Create a list
.SH SYNOPSIS
\fBlist \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command returns a list comprised of all the \fIarg\fRs,
@@ -30,25 +27,30 @@ its arguments. \fBList\fR produces slightly different results than
\fBconcat\fR: \fBconcat\fR removes one level of grouping before forming
the list, while \fBlist\fR works directly from the original arguments.
.SH EXAMPLE
+.PP
The command
+.PP
.CS
\fBlist\fR a b "c d e " " f {g h}"
.CE
+.PP
will return
+.PP
.CS
\fBa b {c d e } { f {g h}}\fR
.CE
+.PP
while \fBconcat\fR with the same arguments will return
+.PP
.CS
\fBa b c d e f {g h}\fR
.CE
-
.SH "SEE ALSO"
lappend(n), lindex(n), linsert(n), llength(n), lrange(n),
-.VS 8.5
lrepeat(n),
-.VE 8.5
lreplace(n), lsearch(n), lset(n), lsort(n)
-
.SH KEYWORDS
-element, list
+element, list, quoting
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/llength.n b/doc/llength.n
index 201d50e..d3f9610 100644
--- a/doc/llength.n
+++ b/doc/llength.n
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: llength.n,v 1.10 2005/05/10 18:34:00 kennykb Exp $
-'\"
-.so man.macros
.TH llength n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,14 +15,14 @@ llength \- Count the number of elements in a list
.SH SYNOPSIS
\fBllength \fIlist\fR
.BE
-
.SH DESCRIPTION
.PP
Treats \fIlist\fR as a list and returns a decimal string giving
the number of elements in it.
-
.SH EXAMPLES
+.PP
The result is the number of elements:
+.PP
.CS
% \fBllength\fR {a b c d e}
5
@@ -36,6 +34,7 @@ The result is the number of elements:
.PP
Elements are not guaranteed to be exactly words in a dictionary sense
of course, especially when quoting is used:
+.PP
.CS
% \fBllength\fR {a b {c d} e}
4
@@ -44,14 +43,13 @@ of course, especially when quoting is used:
.CE
.PP
An empty list is not necessarily an empty string:
+.PP
.CS
% set var { }; puts "[string length $var],[\fBllength\fR $var]"
1,0
.CE
-
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
-
.SH KEYWORDS
element, list, length
diff --git a/doc/lmap.n b/doc/lmap.n
new file mode 100644
index 0000000..2038fc2
--- /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.
+'\"
+.TH lmap n "" Tcl "Tcl Built-In Commands"
+.so man.macros
+.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 6cf0d42..2ab8f2e 100644
--- a/doc/load.n
+++ b/doc/load.n
@@ -4,22 +4,19 @@
'\" 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.16 2005/05/16 08:41:09 dkf Exp $
-'\"
-.so man.macros
.TH load n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.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
This command loads binary code from a file into the
@@ -58,9 +55,12 @@ by the package that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
+.PP
.CS
-typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
+typedef int \fBTcl_PackageInitProc\fR(
+ Tcl_Interp *\fIinterp\fR);
.CE
+.PP
The \fIinterp\fR argument identifies the interpreter in which the
package is to be loaded. The initialization procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
@@ -73,12 +73,10 @@ in an application. If a given \fIfileName\fR is loaded into multiple
interpreters, then the first \fBload\fR will load the code and
call the initialization procedure; subsequent \fBload\fRs will
call the initialization procedure without loading the code again.
-.VS 8.5
For Tcl versions lower than 8.5, it is not possible to unload or reload a
package. From version 8.5 however, the \fBunload\fR command allows the unloading
of libraries loaded with \fBload\fR, for libraries that are aware of the
Tcl's unloading mechanism.
-.VE 8.5
.PP
The \fBload\fR command also supports packages that are statically
linked with the application, if those packages have been registered
@@ -106,20 +104,43 @@ 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
.
-When a load fails with "library not found" error, it is also possible
+When a load fails with
+.QW "library not found"
+error, it is also possible
that a dependent library was not found. To see the dependent libraries,
-type ``dumpbin -imports <dllname>'' in a DOS console to see what the
-library must import.
-When loading a DLL in the current directory, Windows will ignore ``./'' as
-a path specifier and use a search heuristic to find the DLL instead.
+type
+.QW "dumpbin -imports <dllname>"
+in a DOS console to see what the library must import.
+When loading a DLL in the current directory, Windows will ignore
+.QW ./
+as a path specifier and use a search heuristic to find the DLL instead.
To avoid this, load the DLL with:
+.RS
+.PP
.CS
\fBload\fR [file join [pwd] mylib.DLL]
.CE
+.RE
.SH BUGS
.PP
If the same file is \fBload\fRed by different \fIfileName\fRs, it will
@@ -127,6 +148,7 @@ be loaded into the process's address space multiple times. The
behavior of this varies from system to system (some systems may
detect the redundant loads, others may not).
.SH EXAMPLE
+.PP
The following is a minimal extension:
.PP
.CS
@@ -134,7 +156,7 @@ The following is a minimal extension:
#include <stdio.h>
static int fooCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
- printf("called with %d arguments\\n", objc);
+ printf("called with %d arguments\en", objc);
return TCL_OK;
}
int Foo_Init(Tcl_Interp *interp) {
@@ -154,20 +176,21 @@ it can then be loaded into Tcl with the following:
.CS
# Load the extension
switch $tcl_platform(platform) {
- windows {
- \fBload\fR [file join [pwd] foo.dll]
- }
- unix {
- \fBload\fR ./libfoo[info sharedlibextension]
- }
+ windows {
+ \fBload\fR [file join [pwd] foo.dll]
+ }
+ unix {
+ \fBload\fR [file join [pwd] libfoo[info sharedlibextension]]
+ }
}
# Now execute the command defined by the extension
foo
.CE
-
.SH "SEE ALSO"
-info sharedlibextension, Tcl_StaticPackage(3), safe(n)
-
+info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n)
.SH KEYWORDS
-binary code, loading, safe interpreter, shared library
+binary code, dynamic library, load, safe interpreter, shared library
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/lrange.n b/doc/lrange.n
index cb01071..4e26a0f 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: lrange.n,v 1.12 2005/05/10 18:34:01 kennykb Exp $
-'\"
-.so man.macros
.TH lrange n 7.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,41 +15,45 @@ lrange \- Return one or more adjacent elements from a list
.SH SYNOPSIS
\fBlrange \fIlist first last\fR
.BE
-
.SH DESCRIPTION
.PP
\fIList\fR must be a valid Tcl list. This command will
return a new list consisting of elements
\fIfirst\fR through \fIlast\fR, inclusive.
-.VS 8.5
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
-.VE
If \fIfirst\fR is less than zero, it is treated as if it were zero.
If \fIlast\fR is greater than or equal to the number of elements
in the list, then it is treated as if it were \fBend\fR.
If \fIfirst\fR is greater than \fIlast\fR then an empty string
is returned.
-Note: ``\fBlrange \fIlist first first\fR'' does not always produce the
-same result as ``\fBlindex \fIlist first\fR'' (although it often does
-for simple fields that aren't enclosed in braces); it does, however,
-produce exactly the same results as ``\fBlist [lindex \fIlist first\fB]\fR''
+Note:
+.QW "\fBlrange \fIlist first first\fR"
+does not always produce the same result as
+.QW "\fBlindex \fIlist first\fR"
+(although it often does for simple fields that are not enclosed in
+braces); it does, however, produce exactly the same results as
+.QW "\fBlist [lindex \fIlist first\fB]\fR"
.SH EXAMPLES
+.PP
Selecting the first two elements:
+.PP
.CS
% \fBlrange\fR {a b c d e} 0 1
a b
.CE
.PP
Selecting the last three elements:
+.PP
.CS
% \fBlrange\fR {a b c d e} end-2 end
c d e
.CE
.PP
Selecting everything except the first and last element:
+.PP
.CS
% \fBlrange\fR {a b c d e} 1 end-1
b c d
@@ -59,6 +61,7 @@ b c d
.PP
Selecting a single element with \fBlrange\fR is not the same as doing
so with \fBlindex\fR:
+.PP
.CS
% set var {some {elements to} select}
some {elements to} select
@@ -67,13 +70,9 @@ elements to
% \fBlrange\fR $var 1 1
{elements to}
.CE
-
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
-.VS 8.5
string(n)
-.VE
-
.SH KEYWORDS
element, list, range, sublist
diff --git a/doc/lrepeat.n b/doc/lrepeat.n
index d5c6d9a..466339d 100644
--- a/doc/lrepeat.n
+++ b/doc/lrepeat.n
@@ -4,31 +4,32 @@
'\" 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.1 2003/08/11 13:26:13 dkf Exp $
-'\"
-.so man.macros
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lrepeat \- Build a list by repeating elements
.SH SYNOPSIS
-\fBlrepeat \fInumber element1 \fR?\fIelement2 element3 ...\fR?
+\fBlrepeat \fIcount \fR?\fIelement ...\fR?
.BE
.SH DESCRIPTION
.PP
-The \fBlrepeat\fP command creates a list of size \fInumber * number of
-elements\fP by repeating \fInumber\fR times the sequence of elements
-\fIelement1 element2 ...\fR. \fInumber\fP must be a positive integer,
-\fIelementn\fP can be any Tcl value. Note that \fBlrepeat 1 arg ...\fR
-is identical to \fBlist arg ...\fR, though the \fIarg\fR is required
-with \fBlrepeat\fR.
+The \fBlrepeat\fR command creates a list of size \fIcount * number of
+elements\fR by repeating \fIcount\fR times the sequence of elements
+\fIelement ...\fR. \fIcount\fR must be a non-negative integer,
+\fIelement\fR can be any Tcl value. Note that \fBlrepeat 1 element ...\fR
+is identical to \fBlist element ...\fR.
.SH EXAMPLES
.CS
-lrepeat 3 a => a a a
-lrepeat 3 [lrepeat 3 0] => {0 0 0} {0 0 0} {0 0 0}
-lrepeat 3 a b c => a b c a b c a b c
-lrepeat 3 [lrepeat 2 a] b c => {a a} b c {a a} b c {a a} b c
+\fBlrepeat\fR 3 a
+ \fI\(-> a a a\fR
+\fBlrepeat\fR 3 [\fBlrepeat\fR 3 0]
+ \fI\(-> {0 0 0} {0 0 0} {0 0 0}\fR
+\fBlrepeat\fR 3 a b c
+ \fI\(-> a b c a b c a b c\fR
+\fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c
+ \fI\(-> {a a} b c {a a} b c {a a} b c\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)
diff --git a/doc/lreplace.n b/doc/lreplace.n
index 4c9f8c9..7bba543 100644
--- a/doc/lreplace.n
+++ b/doc/lreplace.n
@@ -1,15 +1,13 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: lreplace.n,v 1.13 2005/05/10 18:34:01 kennykb Exp $
-'\"
-.so man.macros
+'\"
.TH lreplace n 7.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,14 +15,12 @@ lreplace \- Replace elements in a list with new elements
.SH SYNOPSIS
\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
.BE
-
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fIlist\fR with the \fIelement\fR arguments.
-.VS 8.5
\fIfirst\fR and \fIlast\fR are index values specifying the first and
-last elements of the range to replace.
+last elements of the range to replace.
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
@@ -32,17 +28,16 @@ end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
-.VE
-
-If \fIfirst\fR is less than zero, it is considered to refer to the
+.PP
+If \fIfirst\fR is less than zero, it is considered to refer to before the
first element of the list. For non-empty lists, the element indicated
-by \fIfirst\fR must exist.
-
-If \fIlast\fR is less than zero but greater than \fIfirst\fR, then any
-specified elements will be prepended to the list. If \fIlast\fR is
-less than \fIfirst\fR then no elements are deleted; the new elements
-are simply inserted before \fIfirst\fR.
-
+by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
+start of the list.
+.PP
+If \fIlast\fR is less than \fIfirst\fR, then any specified elements
+will be inserted into the list at the point specified by \fIfirst\fR
+with no elements being deleted.
+.PP
The \fIelement\fR arguments specify zero or more new arguments to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
@@ -50,33 +45,42 @@ the list. If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR
is empty, any \fIelement\fR arguments are added to the end of the list.
.SH EXAMPLES
+.PP
Replacing an element of a list with another:
+.PP
.CS
% \fBlreplace\fR {a b c d e} 1 1 foo
a foo c d e
.CE
.PP
Replacing two elements of a list with three:
+.PP
.CS
% \fBlreplace\fR {a b c d e} 1 2 three more elements
a three more elements d e
.CE
.PP
Deleting the last element from a list in a variable:
+.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var end end]
a b c d
.CE
-
+.PP
+A procedure to delete a given element from a list:
+.PP
+.CS
+proc lremove {listVariable value} {
+ upvar 1 $listVariable var
+ set idx [lsearch -exact $var $value]
+ set var [\fBlreplace\fR $var $idx $idx]
+}
+.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
-.VS 8.5
string(n)
-.VE
-
-
.SH KEYWORDS
element, list, replace
diff --git a/doc/lreverse.n b/doc/lreverse.n
new file mode 100644
index 0000000..51a9e57
--- /dev/null
+++ b/doc/lreverse.n
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 2006 by Donal K. Fellows. All rights reserved.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lreverse \- Reverse the order of a list
+.SH SYNOPSIS
+\fBlreverse \fIlist\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlreverse\fR command returns a list that has the same elements as its
+input list, \fIlist\fR, except with the elements in the reverse order.
+.SH EXAMPLES
+.CS
+\fBlreverse\fR {a a b c}
+ \fI\(-> c b a a\fR
+\fBlreverse\fR {a b {c d} e f}
+ \fI\(-> f e {c d} b a\fR
+.CE
+.SH "SEE ALSO"
+list(n), lsearch(n), lsort(n)
+
+.SH KEYWORDS
+element, list, reverse
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 726f060..44ebce4 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -1,16 +1,14 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\" Copyright (c) 2003-2004 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: lsearch.n,v 1.26 2005/07/12 09:39:53 dkf Exp $
-'\"
+.TH lsearch n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
-.TH lsearch n 8.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,7 +16,6 @@ lsearch \- See if a list contains a particular element
.SH SYNOPSIS
\fBlsearch \fR?\fIoptions\fR? \fIlist pattern\fR
.BE
-
.SH DESCRIPTION
.PP
This command searches the elements of \fIlist\fR to see if one
@@ -29,65 +26,78 @@ If not, the command returns \fB\-1\fR. The \fIoption\fR arguments
indicates how the elements of the list are to be matched against
\fIpattern\fR and must have one of the values below:
.SS "MATCHING STYLE OPTIONS"
+.PP
If all matching style options are omitted, the default matching style
is \fB\-glob\fR. If more than one matching style is specified, the
last matching style given takes precedence.
.TP
\fB\-exact\fR
+.
\fIPattern\fR is a literal string that is compared for exact equality
against each list element.
.TP
\fB\-glob\fR
+.
\fIPattern\fR is a glob-style pattern which is matched against each list
element using the same rules as the \fBstring match\fR command.
.TP
\fB\-regexp\fR
+.
\fIPattern\fR is treated as a regular expression and matched against
each list element using the rules described in the \fBre_syntax\fR
reference page.
.TP
\fB\-sorted\fR
+.
The list elements are in sorted order. If this option is specified,
\fBlsearch\fR will use a more efficient searching algorithm to search
\fIlist\fR. If no other options are specified, \fIlist\fR is assumed
to be sorted in increasing order, and to contain ASCII strings. This
option is mutually exclusive with \fB\-glob\fR and \fB\-regexp\fR, and
-is treated exactly like \fB-exact\fR when either \fB\-all\fR or
+is treated exactly like \fB\-exact\fR when either \fB\-all\fR or
\fB\-not\fR are specified.
.SS "GENERAL MODIFIER OPTIONS"
+.PP
These options may be given with all matching styles.
.TP
\fB\-all\fR
-Changes the result to be the list of all matching indices (or all
-matching values if \fB\-inline\fR is specified as well.)
+.
+Changes the result to be the list of all matching indices (or all matching
+values if \fB\-inline\fR is specified as well.) If indices are returned, the
+indices will be in numeric order. If values are returned, the order of the
+values will be the order of those values within the input \fIlist\fR.
.TP
\fB\-inline\fR
+.
The matching value is returned instead of its index (or an empty
string if no value matches.) If \fB\-all\fR is also specified, then
the result of the command is the list of all values that matched.
.TP
\fB\-not\fR
+.
This negates the sense of the match, returning the index of the first
non-matching value in the list.
.TP
\fB\-start\fR\0\fIindex\fR
-The list is searched starting at position \fIindex\fR.
-.VS 8.5
+.
+The list is searched starting at position \fIindex\fR.
The interpretation of the \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
-.VE 8.5
.SS "CONTENTS DESCRIPTION OPTIONS"
+.PP
These options describe how to interpret the items in the list being
searched. They are only meaningful when used with the \fB\-exact\fR
and \fB\-sorted\fR options. If more than one is specified, the last
one takes precedence. The default is \fB\-ascii\fR.
.TP
\fB\-ascii\fR
+.
The list elements are to be examined as Unicode strings (the name is
for backward-compatibility reasons.)
.TP
\fB\-dictionary\fR
+.
The list elements are to be compared using dictionary-style
comparisons (see \fBlsort\fR for a fuller description). Note that this
only makes a meaningful difference from the \fB\-ascii\fR option when
@@ -95,96 +105,116 @@ the \fB\-sorted\fR option is given, because values are only
dictionary-equal when exactly equal.
.TP
\fB\-integer\fR
+.
The list elements are to be compared as integers.
-.VS 8.5
.TP
\fB\-nocase\fR
+.
Causes comparisons to be handled in a case-insensitive manner. Has no
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
\fB\-real\fR options.
-.VE 8.5
.TP
\fB\-real\fR
+.
The list elements are to be compared as floating-point values.
.SS "SORTED LIST OPTIONS"
+.PP
These options (only meaningful with the \fB\-sorted\fR option) specify
how the list is sorted. If more than one is given, the last one takes
precedence. The default option is \fB\-increasing\fR.
.TP
\fB\-decreasing\fR
+.
The list elements are sorted in decreasing order. This option is only
meaningful when used with \fB\-sorted\fR.
.TP
\fB\-increasing\fR
+.
The list elements are sorted in increasing order. This option is only
meaningful when used with \fB\-sorted\fR.
+.TP
+\fB\-bisect\fR
+.VS 8.6
+Inexact search when the list elements are in sorted order. For an increasing
+list the last index where the element is less than or equal to the pattern
+is returned. For a decreasing list the last index where the element is greater
+than or equal to the pattern is returned. If the pattern is before the first
+element or the list is empty, -1 is returned.
+This option implies \fB\-sorted\fR and cannot be used with either \fB\-all\fR
+or \fB\-not\fR.
+.VE 8.6
.SS "NESTED LIST OPTIONS"
-.VS 8.5
+.PP
These options are used to search lists of lists. They may be used
with any other options.
.TP
\fB\-index\fR\0\fIindexList\fR
+.
This option is designed for use when searching within nested lists.
The \fIindexList\fR argument gives a path of indices (much as might be
used with the \fBlindex\fR or \fBlset\fR commands) within each element
to allow the location of the term being matched against.
.TP
\fB\-subindices\fR
+.
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.
-.VE 8.5
+\fB\-index\fR is also specified, and is just a convenience short-cut.
.SH EXAMPLES
+.PP
Basic searching:
+.PP
.CS
\fBlsearch\fR {a b c d e} c
- => 2
+ \fI\(-> 2\fR
\fBlsearch\fR -all {a b c a b c} c
- => 2 5
+ \fI\(-> 2 5\fR
.CE
-
+.PP
Using \fBlsearch\fR to filter lists:
+.PP
.CS
\fBlsearch\fR -inline {a20 b35 c47} b*
- => b35
+ \fI\(-> b35\fR
\fBlsearch\fR -inline -not {a20 b35 c47} b*
- => a20
+ \fI\(-> a20\fR
\fBlsearch\fR -all -inline -not {a20 b35 c47} b*
- => a20 c47
+ \fI\(-> a20 c47\fR
\fBlsearch\fR -all -not {a20 b35 c47} b*
- => 0 2
+ \fI\(-> 0 2\fR
.CE
-This can even do a "set-like" removal operation:
+.PP
+This can even do a
+.QW set-like
+removal operation:
+.PP
.CS
\fBlsearch\fR -all -inline -not -exact {a b c a d e a f g a} a
- => b c d e f g
+ \fI\(-> b c d e f g\fR
.CE
-
+.PP
Searching may start part-way through the list:
+.PP
.CS
\fBlsearch\fR -start 3 {a b c a b c} c
- => 5
+ \fI\(-> 5\fR
.CE
-
+.PP
It is also possible to search inside elements:
+.PP
.CS
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
- => {a abc} {b bcd}
+ \fI\(-> {a abc} {b bcd}\fR
.CE
-
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
lset(n), lsort(n), lrange(n), lreplace(n),
-.VS 8.5
string(n)
-.VE
-
-
.SH KEYWORDS
+binary search, linear search,
list, match, pattern, regular expression, search, string
-
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/doc/lset.n b/doc/lset.n
index 969aba9..954bd30 100755..100644
--- a/doc/lset.n
+++ b/doc/lset.n
@@ -1,19 +1,17 @@
'\"
-'\" Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>. 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: lset.n,v 1.9 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lset \- Change an element in a list
.SH SYNOPSIS
-\fBlset \fIvarName ?index...? newValue\fR
+\fBlset \fIvarName ?index ...? newValue\fR
.BE
.SH DESCRIPTION
.PP
@@ -26,13 +24,17 @@ Tcl list and presented as a single argument.
Finally, it accepts a new value for an element of \fIvarName\fR.
.PP
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
\fIvarName\fR.
.PP
@@ -49,71 +51,96 @@ replaced with \fInewValue\fR. This new list is stored in the
variable \fIvarName\fR, and is also the return value from the \fBlset\fR
command.
.PP
-If \fIindex\fR is negative or greater than or equal to the number
+If \fIindex\fR is negative or greater than the number
of elements in \fI$varName\fR, then an error occurs.
.PP
-.VS 8.5
+If \fIindex\fR is equal to the number of elements in \fI$varName\fR,
+then the given element is appended to the list.
+.PP
The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
-.VE 8.5
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
used in turn to address an element within a sublist designated
by the previous indexing operation,
-allowing the script to alter elements in sublists. The command,
+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.
.PP
The integer appearing in each \fIindex\fR argument must be greater
than or equal to zero. The integer appearing in each \fIindex\fR
-argument must be strictly less than the length of the corresponding
-list. In other words, the \fBlset\fR command cannot change the size
-of a list. If an index is outside the permitted range, an error is reported.
+argument must be less than or equal to the length of the corresponding
+list. In other words, the \fBlset\fR command can change the size
+of a list only by appending an element (setting the one after the current
+end). If an index is outside the permitted range, an error is reported.
.SH EXAMPLES
+.PP
In each of these examples, the initial value of \fIx\fR is:
+.PP
.CS
set x [list [list a b c] [list d e f] [list g h i]]
- => {a b c} {d e f} {g h i}
+ \fI\(-> {a b c} {d e f} {g h i}\fR
.CE
+.PP
The indicated return value also becomes the new value of \fIx\fR
(except in the last case, which is an error which leaves the value of
\fIx\fR unchanged.)
+.PP
.CS
-lset x {j k l} => j k l
-lset x {} {j k l} => j k l
-lset x 0 j => j {d e f} {g h i}
-lset x 2 j => {a b c} {d e f} j
-lset x end j => {a b c} {d e f} j
-lset x end-1 j => {a b c} j {g h i}
-lset x 2 1 j => {a b c} {d e f} {g j i}
-lset x {2 1} j => {a b c} {d e f} {g j i}
-lset x {2 3} j => \fIlist index out of range\fR
+\fBlset\fR x {j k l}
+ \fI\(-> j k l\fR
+\fBlset\fR x {} {j k l}
+ \fI\(-> j k l\fR
+\fBlset\fR x 0 j
+ \fI\(-> j {d e f} {g h i}\fR
+\fBlset\fR x 2 j
+ \fI\(-> {a b c} {d e f} j\fR
+\fBlset\fR x end j
+ \fI\(-> {a b c} {d e f} j\fR
+\fBlset\fR x end-1 j
+ \fI\(-> {a b c} j {g h i}\fR
+\fBlset\fR x 2 1 j
+ \fI\(-> {a b c} {d e f} {g j i}\fR
+\fBlset\fR x {2 1} j
+ \fI\(-> {a b c} {d e f} {g j i}\fR
+\fBlset\fR x {2 3} j
+ \fI\(-> list index out of range\fR
.CE
+.PP
In the following examples, the initial value of \fIx\fR is:
+.PP
.CS
set x [list [list [list a b] [list c d]] \e
[list [list e f] [list g h]]]
- => {{a b} {c d}} {{e f} {g h}}
+ \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
.CE
+.PP
The indicated return value also becomes the new value of \fIx\fR.
+.PP
.CS
-lset x 1 1 0 j => {{a b} {c d}} {{e f} {j h}}
-lset x {1 1 0} j => {{a b} {c d}} {{e f} {j h}}
+\fBlset\fR x 1 1 0 j
+ \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR
+\fBlset\fR x {1 1 0} j
+ \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lsort(n), lrange(n), lreplace(n),
-.VS 8.5
string(n)
-.VE
-
-
.SH KEYWORDS
element, index, list, replace, set
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/lsort.n b/doc/lsort.n
index 09962d2..48c62f0 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -2,15 +2,13 @@
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1999 Scriptics Corporation
-'\" Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
+'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. 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: lsort.n,v 1.21 2005/06/01 11:00:33 dkf Exp $
-'\"
-.so man.macros
.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,7 +16,6 @@ lsort \- Sort the elements of a list
.SH SYNOPSIS
\fBlsort \fR?\fIoptions\fR? \fIlist\fR
.BE
-
.SH DESCRIPTION
.PP
This command sorts the elements of \fIlist\fR, returning a new
@@ -30,26 +27,31 @@ By default ASCII sorting is used with the result returned in
increasing order. However, any of the following options may be
specified before \fIlist\fR to control the sorting process (unique
abbreviations are accepted):
-.TP 20
+.TP
\fB\-ascii\fR
+.
Use string comparison with Unicode code-point collation order (the
name is for backward-compatibility reasons.) This is the default.
-.TP 20
+.TP
\fB\-dictionary\fR
+.
Use dictionary-style comparison. This is the same as \fB\-ascii\fR
except (a) case is ignored except as a tie-breaker and (b) if two
strings contain embedded numbers, the numbers compare as integers,
not characters. For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR
sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR
sorts between \fBx9y\fR and \fBx11y\fR.
-.TP 20
+.TP
\fB\-integer\fR
+.
Convert list elements to integers and use integer comparison.
-.TP 20
+.TP
\fB\-real\fR
+.
Convert list elements to floating-point values and use floating comparison.
-.TP 20
+.TP
\fB\-command\0\fIcommand\fR
+.
Use \fIcommand\fR as a comparison command.
To compare two elements, evaluate a Tcl script consisting of
\fIcommand\fR with the two elements appended as additional
@@ -57,66 +59,109 @@ arguments. The script should return an integer less than,
equal to, or greater than zero if the first element is to
be considered less than, equal to, or greater than the second,
respectively.
-.TP 20
+.TP
\fB\-increasing\fR
-Sort the list in increasing order (``smallest'' items first).
+.
+Sort the list in increasing order
+.PQ smallest "items first" .
This is the default.
-.TP 20
+.TP
\fB\-decreasing\fR
-Sort the list in decreasing order (``largest'' items first).
-.TP 20
+.
+Sort the list in decreasing order
+.PQ largest "items first" .
+.TP
\fB\-indices\fR
-.VS "8.5 (TIP#217)"
+.
Return a list of indices into \fIlist\fR in sorted order instead of
the values themselves.
-.VE "8.5 (TIP#217)"
-.TP 20
+.TP
\fB\-index\0\fIindexList\fR
+.
If this option is specified, each of the elements of \fIlist\fR must
-itself be a proper Tcl sublist. Instead of sorting based on whole
-sublists, \fBlsort\fR will extract the \fIindexList\fR'th element from
-each sublist
-.VS 8.5
-(as if the overall element and the \fIindexList\fR were passed to
-\fBlindex\fR) and sort based on the given element.
-.VE 8.5
+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
+based on the given element.
For example,
.RS
+.PP
.CS
-lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
+\fBlsort\fR -integer -index 1 \e
+ {{First 24} {Second 18} {Third 30}}
.CE
-returns \fB{Second 18} {First 24} {Third 30}\fR, and
+.PP
+returns \fB{Second 18} {First 24} {Third 30}\fR,
+.PP
'\"
'\" This example is from the test suite!
'\"
.CS
-lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
+\fBlsort\fR -index end-1 \e
+ {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
.CE
+.PP
returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR,
-.VS 8.5
and
+.PP
.CS
-lsort -index {0 1} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321}}
+\fBlsort\fR -index {0 1} {
+ {{b i g} 12345}
+ {{d e m o} 34512}
+ {{c o d e} 54321}
+}
.CE
+.PP
returns \fB{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}\fR
(because \fBe\fR sorts before \fBi\fR which sorts before \fBo\fR.)
-.VE 8.5
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
-.VS 8.5
-.TP 20
+.TP
+\fB\-stride\0\fIstrideLength\fR
+.
+If this option is specified, the list is treated as consisting of
+groups of \fIstrideLength\fR elements and the groups are sorted by
+either their first element or, if the \fB\-index\fR option is used,
+by the element within each group given by the first index passed to
+\fB\-index\fR (which is then ignored by \fB\-index\fR). Elements
+always remain in the same position within their group.
+.RS
+.PP
+The list length must be an integer multiple of \fIstrideLength\fR, which
+in turn must be at least 2.
+.PP
+For example,
+.PP
+.CS
+\fBlsort\fR \-stride 2 {carrot 10 apple 50 banana 25}
+.CE
+.PP
+returns
+.QW "apple 50 banana 25 carrot 10" ,
+and
+.PP
+.CS
+\fBlsort\fR \-stride 2 \-index 1 \-integer {carrot 10 apple 50 banana 25}
+.CE
+.PP
+returns
+.QW "carrot 10 banana 25 apple 50" .
+.RE
+.TP
\fB\-nocase\fR
+.
Causes comparisons to be handled in a case-insensitive manner. Has no
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
\fB\-real\fR options.
-.VE 8.5
-.TP 20
+.TP
\fB\-unique\fR
+.
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"
@@ -132,53 +177,80 @@ option.
.SH "EXAMPLES"
.PP
Sorting a list using ASCII sorting:
+.PP
.CS
-% \fBlsort\fR {a10 B2 b1 a1 a2}
+\fI%\fR \fBlsort\fR {a10 B2 b1 a1 a2}
B2 a1 a10 a2 b1
.CE
.PP
Sorting a list using Dictionary sorting:
+.PP
.CS
-% \fBlsort\fR -dictionary {a10 B2 b1 a1 a2}
+\fI%\fR \fBlsort\fR -dictionary {a10 B2 b1 a1 a2}
a1 a2 a10 b1 B2
.CE
.PP
Sorting lists of integers:
+.PP
.CS
-% \fBlsort\fR -integer {5 3 1 2 11 4}
+\fI%\fR \fBlsort\fR -integer {5 3 1 2 11 4}
1 2 3 4 5 11
-% \fBlsort\fR -integer {1 2 0x5 7 0 4 -1}
+\fI%\fR \fBlsort\fR -integer {1 2 0x5 7 0 4 -1}
-1 0 1 2 4 0x5 7
.CE
.PP
Sorting lists of floating-point numbers:
+.PP
.CS
-% \fBlsort\fR -real {5 3 1 2 11 4}
+\fI%\fR \fBlsort\fR -real {5 3 1 2 11 4}
1 2 3 4 5 11
-% \fBlsort\fR -real {.5 0.07e1 0.4 6e-1}
+\fI%\fR \fBlsort\fR -real {.5 0.07e1 0.4 6e-1}
0.4 .5 6e-1 0.07e1
.CE
.PP
Sorting using indices:
+.PP
.CS
-% # Note the space character before the c
-% \fBlsort\fR {{a 5} { c 3} {b 4} {e 1} {d 2}}
+\fI%\fR # Note the space character before the c
+\fI%\fR \fBlsort\fR {{a 5} { c 3} {b 4} {e 1} {d 2}}
{ c 3} {a 5} {b 4} {d 2} {e 1}
-% \fBlsort\fR -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}}
+\fI%\fR \fBlsort\fR -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}}
{a 5} {b 4} { c 3} {d 2} {e 1}
-% \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}}
+\fI%\fR \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}}
{e 1} {d 2} { c 3} {b 4} {a 5}
.CE
.PP
+.VS 8.6
+Sorting a dictionary:
+.PP
+.CS
+\fI%\fR set d [dict create c d a b h i f g c e]
+c e a b h i f g
+\fI%\fR \fBlsort\fR -stride 2 $d
+a b c e f g h i
+.CE
+.PP
+Sorting using striding and multiple indices:
+.PP
+.CS
+\fI%\fR # Note the first index value is relative to the group
+\fI%\fR \fBlsort\fR \-stride 3 \-index {0 1} \e
+ {{Bob Smith} 25 Audi {Jane Doe} 40 Ford}
+{{Jane Doe} 40 Ford {Bob Smith} 25 Audi}
+.CE
+.VE 8.6
+.PP
Stripping duplicate values using sorting:
+.PP
.CS
-% \fBlsort\fR -unique {a b c a b c a b c}
+\fI%\fR \fBlsort\fR -unique {a b c a b c a b c}
a b c
.CE
.PP
More complex sorting using a comparison function:
+.PP
.CS
-% proc compare {a b} {
+\fI%\fR proc compare {a b} {
set a0 [lindex $a 0]
set b0 [lindex $b 0]
if {$a0 < $b0} {
@@ -188,14 +260,15 @@ More complex sorting using a comparison function:
}
return [string compare [lindex $a 1] [lindex $b 1]]
}
-% \fBlsort\fR -command compare \\
+\fI%\fR \fBlsort\fR -command compare \e
{{3 apple} {0x2 carrot} {1 dingo} {2 banana}}
{1 dingo} {2 banana} {0x2 carrot} {3 apple}
.CE
-
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lreplace(n)
-
.SH KEYWORDS
element, list, order, sort
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/man.macros b/doc/man.macros
index 29b8a51..ddd073d 100644
--- a/doc/man.macros
+++ b/doc/man.macros
@@ -1,72 +1,77 @@
-'\" The definitions below are for supplemental macros used in Tcl/Tk
-'\" manual entries.
-'\"
-'\" .AP type name in/out ?indent?
-'\" Start paragraph describing an argument to a library procedure.
-'\" type is type of argument (int, etc.), in/out is either "in", "out",
-'\" or "in/out" to describe whether procedure reads or modifies arg,
-'\" and indent is equivalent to second arg of .IP (shouldn't ever be
-'\" needed; use .AS below instead)
-'\"
-'\" .AS ?type? ?name? ?in|out|in/out?
-'\" Give maximum sizes of arguments for setting tab stops. Type and
-'\" name are examples of largest possible arguments that will be passed
-'\" to .AP later. If args are omitted, default tab stops are used. If
-'\" the third arg is not supplied, "in" is assumed.
-'\"
-'\" .BS
-'\" Start box enclosure. From here until next .BE, everything will be
-'\" enclosed in one large box.
-'\"
-'\" .BE
-'\" End of box enclosure.
-'\"
-'\" .CS
-'\" Begin code excerpt.
-'\"
-'\" .CE
-'\" End code excerpt.
-'\"
-'\" .VS ?version? ?br?
-'\" Begin vertical sidebar, for use in marking newly-changed parts
-'\" of man pages. The first argument is ignored and used for recording
-'\" the version when the .VS was added, so that the sidebars can be
-'\" found and removed when they reach a certain age. If another argument
-'\" is present, then a line break is forced before starting the sidebar.
-'\"
-'\" .VE
-'\" End of vertical sidebar.
-'\"
-'\" .DS
-'\" Begin an indented unfilled display.
-'\"
-'\" .DE
-'\" End of indented unfilled display.
-'\"
-'\" .SO
-'\" Start of list of standard options for a Tk widget. The
-'\" options follow on successive lines, in four columns separated
-'\" by tabs.
-'\"
-'\" .SE
-'\" End of list of standard options for a Tk widget.
-'\"
-'\" .OP cmdName dbName dbClass
-'\" Start of description of a specific option. cmdName gives the
-'\" option's name as specified in the class command, dbName gives
-'\" the option's name in the option database, and dbClass gives
-'\" the option's class in the option database.
-'\"
-'\" .UL arg1 arg2
-'\" Print arg1 underlined, then print arg2 normally.
-'\"
-'\" RCS: @(#) $Id: man.macros,v 1.5 2004/10/07 14:44:35 dkf Exp $
-'\"
-'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.\" The -*- nroff -*- definitions below are for supplemental macros used
+.\" in Tcl/Tk manual entries.
+.\"
+.\" .AP type name in/out ?indent?
+.\" Start paragraph describing an argument to a library procedure.
+.\" type is type of argument (int, etc.), in/out is either "in", "out",
+.\" or "in/out" to describe whether procedure reads or modifies arg,
+.\" and indent is equivalent to second arg of .IP (shouldn't ever be
+.\" needed; use .AS below instead)
+.\"
+.\" .AS ?type? ?name?
+.\" Give maximum sizes of arguments for setting tab stops. Type and
+.\" name are examples of largest possible arguments that will be passed
+.\" to .AP later. If args are omitted, default tab stops are used.
+.\"
+.\" .BS
+.\" Start box enclosure. From here until next .BE, everything will be
+.\" enclosed in one large box.
+.\"
+.\" .BE
+.\" End of box enclosure.
+.\"
+.\" .CS
+.\" Begin code excerpt.
+.\"
+.\" .CE
+.\" End code excerpt.
+.\"
+.\" .VS ?version? ?br?
+.\" Begin vertical sidebar, for use in marking newly-changed parts
+.\" of man pages. The first argument is ignored and used for recording
+.\" the version when the .VS was added, so that the sidebars can be
+.\" found and removed when they reach a certain age. If another argument
+.\" is present, then a line break is forced before starting the sidebar.
+.\"
+.\" .VE
+.\" End of vertical sidebar.
+.\"
+.\" .DS
+.\" Begin an indented unfilled display.
+.\"
+.\" .DE
+.\" End of indented unfilled display.
+.\"
+.\" .SO ?manpage?
+.\" Start of list of standard options for a Tk widget. The manpage
+.\" argument defines where to look up the standard options; if
+.\" omitted, defaults to "options". The options follow on successive
+.\" lines, in three columns separated by tabs.
+.\"
+.\" .SE
+.\" End of list of standard options for a Tk widget.
+.\"
+.\" .OP cmdName dbName dbClass
+.\" Start of description of a specific option. cmdName gives the
+.\" option's name as specified in the class command, dbName gives
+.\" the option's name in the option database, and dbClass gives
+.\" the option's class in the option database.
+.\"
+.\" .UL arg1 arg2
+.\" Print arg1 underlined, then print arg2 normally.
+.\"
+.\" .QW arg1 ?arg2?
+.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation).
+.\"
+.\" .PQ arg1 ?arg2?
+.\" Print an open parenthesis, arg1 in quotes, then arg2 normally
+.\" (for trailing punctuation) and then a closing parenthesis.
+.\"
+.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
-'\" # Start an argument description
+.\" # Start an argument description
.de AP
.ie !"\\$4"" .TP \\$4
.el \{\
@@ -75,7 +80,7 @@
.\}
.ta \\n()Au \\n()Bu
.ie !"\\$3"" \{\
-\&\\$1 \\fI\\$2\\fP (\\$3)
+\&\\$1 \\fI\\$2\\fP (\\$3)
.\".b
.\}
.el \{\
@@ -88,20 +93,19 @@
.\}
.\}
..
-'\" # define tabbing values for .AP
+.\" # define tabbing values for .AP
.de AS
.nr )A 10n
-.if !"\\$1"" .nr )A \\w'\\$1'u+1n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
.nr )B \\n()Au+15n
.\"
-.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+2n
-.ie !"\\$3"" .nr )C \\n()Bu+\\w'(\\$3)'u+2n
-.el .nr )C \\n()Bu+\\w'(in)'u+2n
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
..
.AS Tcl_Interp Tcl_CreateInterp in/out
-'\" # BS - start boxed text
-'\" # ^y = starting y location
-'\" # ^b = 1
+.\" # BS - start boxed text
+.\" # ^y = starting y location
+.\" # ^b = 1
.de BS
.br
.mk ^y
@@ -111,7 +115,7 @@
.if n \l'\\n(.lu\(ul'
.if n .fi
..
-'\" # BE - end boxed text (draw box now)
+.\" # BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
@@ -131,16 +135,16 @@
.br
.nr ^b 0
..
-'\" # VS - start vertical sidebar
-'\" # ^Y = starting y location
-'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.\" # VS - start vertical sidebar
+.\" # ^Y = starting y location
+.\" # ^v = 1 (for troff; for nroff this doesn't matter)
.de VS
.if !"\\$2"" .br
.mk ^Y
.ie n 'mc \s12\(br\s0
.el .nr ^v 1u
..
-'\" # VE - end of vertical sidebar
+.\" # VE - end of vertical sidebar
.de VE
.ie n 'mc
.el \{\
@@ -155,9 +159,9 @@
.\}
.nr ^v 0
..
-'\" # Special macro to handle page bottom: finish off current
-'\" # box/sidebar if in box/sidebar mode, then invoked standard
-'\" # page bottom macro.
+.\" # Special macro to handle page bottom: finish off current
+.\" # box/sidebar if in box/sidebar mode, then invoked standard
+.\" # page bottom macro.
.de ^B
.ev 2
'ti 0
@@ -184,34 +188,36 @@
.mk ^Y
.\}
..
-'\" # DS - begin display
+.\" # DS - begin display
.de DS
.RS
.nf
.sp
..
-'\" # DE - end display
+.\" # DE - end display
.de DE
.fi
.RE
.sp
..
-'\" # SO - start of list of standard options
+.\" # SO - start of list of standard options
.de SO
+'ie '\\$1'' .ds So \\fBoptions\\fR
+'el .ds So \\fB\\$1\\fR
.SH "STANDARD OPTIONS"
.LP
.nf
.ta 5.5c 11c
.ft B
..
-'\" # SE - end of list of standard options
+.\" # SE - end of list of standard options
.de SE
.fi
.ft R
.LP
-See the \\fBoptions\\fR manual entry for details on the standard options.
+See the \\*(So manual entry for details on the standard options.
..
-'\" # OP - start of full description for a single option
+.\" # OP - start of full description for a single option
.de OP
.LP
.nf
@@ -222,17 +228,40 @@ Database Class: \\fB\\$3\\fR
.fi
.IP
..
-'\" # CS - begin code excerpt
+.\" # CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
-'\" # CE - end code excerpt
+.\" # CE - end code excerpt
.de CE
.fi
.RE
..
+.\" # UL - underline word
.de UL
\\$1\l'|0\(ul'\\$2
..
+.\" # QW - apply quotation marks to word
+.de QW
+.ie '\\*(lq'"' ``\\$1''\\$2
+.\"" fix emacs highlighting
+.el \\*(lq\\$1\\*(rq\\$2
+..
+.\" # PQ - apply parens and quotation marks to word
+.de PQ
+.ie '\\*(lq'"' (``\\$1''\\$2)\\$3
+.\"" fix emacs highlighting
+.el (\\*(lq\\$1\\*(rq\\$2)\\$3
+..
+.\" # QR - quoted range
+.de QR
+.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3
+.\"" fix emacs highlighting
+.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3
+..
+.\" # MT - "empty" string
+.de MT
+.QW ""
+..
diff --git a/doc/mathfunc.n b/doc/mathfunc.n
index 5ea56bc..84853d8 100644
--- a/doc/mathfunc.n
+++ b/doc/mathfunc.n
@@ -6,10 +6,8 @@
'\" 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.6 2005/06/09 14:24:06 dkf Exp $
-'\"
-.so man.macros
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -37,6 +35,8 @@ package require \fBTcl 8.5\fR
.br
\fB::tcl::mathfunc::double\fR \fIarg\fR
.br
+\fB::tcl::mathfunc::entier\fR \fIarg\fR
+.br
\fB::tcl::mathfunc::exp\fR \fIarg\fR
.br
\fB::tcl::mathfunc::floor\fR \fIarg\fR
@@ -47,10 +47,16 @@ package require \fBTcl 8.5\fR
.br
\fB::tcl::mathfunc::int\fR \fIarg\fR
.br
+\fB::tcl::mathfunc::isqrt\fR \fIarg\fR
+.br
\fB::tcl::mathfunc::log\fR \fIarg\fR
.br
\fB::tcl::mathfunc::log10\fR \fIarg\fR
.br
+\fB::tcl::mathfunc::max\fR \fIarg\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathfunc::min\fR \fIarg\fR ?\fIarg\fR ...?
+.br
\fB::tcl::mathfunc::pow\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::rand\fR
@@ -76,8 +82,8 @@ package require \fBTcl 8.5\fR
.PP
The \fBexpr\fR command handles mathematical functions of the form
\fBsin($x)\fR or \fBatan2($y,$x)\fR by converting them to calls of the
-form \fB[tcl::math::sin [expr {$x}]]\fR or
-\fB[tcl::math::atan2 [expr {$y}] [expr {$x}]]\fR.
+form \fB[tcl::mathfunc::sin [expr {$x}]]\fR or
+\fB[tcl::mathfunc::atan2 [expr {$y}] [expr {$x}]]\fR.
A number of math functions are available by default within the
namespace \fB::tcl::mathfunc\fR; these functions are also available
for code apart from \fBexpr\fR, by invoking the given commands
@@ -87,95 +93,156 @@ Tcl supports the following mathematical functions in expressions, all
of which work solely with floating-point numbers unless otherwise noted:
.DS
.ta 3c 6c 9c
-\fBabs\fR \fBcos\fR \fBint\fR \fBsinh\fR
-\fBacos\fR \fBcosh\fR \fBlog\fR \fBsqrt\fR
-\fBasin\fR \fBdouble\fR \fBlog10\fR \fBsrand\fR
-\fBatan\fR \fBexp\fR \fBpow\fR \fBtan\fR
-\fBatan2\fR \fBfloor\fR \fBrand\fR \fBtanh\fR
-\fBbool\fR \fBfmod\fR \fBround\fR \fBwide\fR
-\fBceil\fR \fBhypot\fR \fBsin\fR
+\fBabs\fR \fBacos\fR \fBasin\fR \fBatan\fR
+\fBatan2\fR \fBbool\fR \fBceil\fR \fBcos\fR
+\fBcosh\fR \fBdouble\fR \fBentier\fR \fBexp\fR
+\fBfloor\fR \fBfmod\fR \fBhypot\fR \fBint\fR
+\fBisqrt\fR \fBlog\fR \fBlog10\fR \fBmax\fR
+\fBmin\fR \fBpow\fR \fBrand\fR \fBround\fR
+\fBsin\fR \fBsinh\fR \fBsqrt\fR \fBsrand\fR
+\fBtan\fR \fBtanh\fR \fBwide\fR
.DE
.PP
+In addition to these predefined functions, applications may
+define additional functions by using \fBproc\fR (or any other method,
+such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
+new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
+obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
+extensions that are written in C. The latter interface is not recommended
+for new implementations.
+.SS "DETAILED DEFINITIONS"
.TP
-\fBabs(\fIarg\fB)\fR
+\fBabs \fIarg\fR
+.
Returns the absolute value of \fIarg\fR. \fIArg\fR may be either
integer or floating-point, and the result is returned in the same form.
.TP
-\fBacos(\fIarg\fB)\fR
+\fBacos \fIarg\fR
+.
Returns the arc cosine of \fIarg\fR, in the range [\fI0\fR,\fIpi\fR]
-radians. \fIArg\fR should be in the range [\fI-1\fR,\fI1\fR].
+radians. \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR].
.TP
-\fBasin(\fIarg\fB)\fR
-Returns the arc sine of \fIarg\fR, in the range [\fI-pi/2\fR,\fIpi/2\fR]
-radians. \fIArg\fR should be in the range [\fI-1\fR,\fI1\fR].
+\fBasin \fIarg\fR
+.
+Returns the arc sine of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR]
+radians. \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR].
.TP
-\fBatan(\fIarg\fB)\fR
-Returns the arc tangent of \fIarg\fR, in the range [\fI-pi/2\fR,\fIpi/2\fR]
+\fBatan \fIarg\fR
+.
+Returns the arc tangent of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR]
radians.
.TP
-\fBatan2(\fIy, x\fB)\fR
-Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI-pi\fR,\fIpi\fR]
+\fBatan2 \fIy x\fR
+.
+Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI\-pi\fR,\fIpi\fR]
radians. \fIx\fR and \fIy\fR cannot both be 0. If \fIx\fR is greater
-than \fI0\fR, this is equivalent to \fBatan(\fIy/x\fB)\fR.
+than \fI0\fR, this is equivalent to
+.QW "\fBatan \fR[\fBexpr\fR {\fIy\fB/\fIx\fR}]" .
.TP
-\fBbool(\fIarg\fB)\fR
-Accepts any numerical value, or any string acceptable to
+\fBbool \fIarg\fR
+.
+Accepts any numeric value, or any string acceptable to
\fBstring is boolean\fR, and returns the corresponding
boolean value \fB0\fR or \fB1\fR. Non-zero numbers are true.
Other numbers are false. Non-numeric strings produce boolean value in
agreement with \fBstring is true\fR and \fBstring is false\fR.
.TP
-\fBceil(\fIarg\fB)\fR
+\fBceil \fIarg\fR
+.
Returns the smallest integral floating-point value (i.e. with a zero
-fractional part) not less than \fIarg\fR.
+fractional part) not less than \fIarg\fR. The argument may be any
+numeric value.
.TP
-\fBcos(\fIarg\fB)\fR
+\fBcos \fIarg\fR
+.
Returns the cosine of \fIarg\fR, measured in radians.
.TP
-\fBcosh(\fIarg\fB)\fR
+\fBcosh \fIarg\fR
+.
Returns the hyperbolic cosine of \fIarg\fR. If the result would cause
an overflow, an error is returned.
.TP
-\fBdouble(\fIarg\fB)\fR
+\fBdouble \fIarg\fR
+.
+The argument may be any numeric value,
If \fIarg\fR is a floating-point value, returns \fIarg\fR, otherwise converts
-\fIarg\fR to floating-point and returns the converted value.
+\fIarg\fR to floating-point and returns the converted value. May return
+\fBInf\fR or \fB\-Inf\fR when the argument is a numeric value that exceeds
+the floating-point range.
.TP
-\fBexp(\fIarg\fB)\fR
+\fBentier \fIarg\fR
+.
+The argument may be any numeric value. The integer part of \fIarg\fR
+is determined and returned. The integer range returned by this function
+is unlimited, unlike \fBint\fR and \fBwide\fR which
+truncate their range to fit in particular storage widths.
+.TP
+\fBexp \fIarg\fR
+.
Returns the exponential of \fIarg\fR, defined as \fIe\fR**\fIarg\fR.
If the result would cause an overflow, an error is returned.
.TP
-\fBfloor(\fIarg\fB)\fR
+\fBfloor \fIarg\fR
+.
Returns the largest integral floating-point value (i.e. with a zero
-fractional part) not greater than \fIarg\fR.
+fractional part) not greater than \fIarg\fR. The argument may be
+any numeric value.
.TP
-\fBfmod(\fIx, y\fB)\fR
+\fBfmod \fIx y\fR
+.
Returns the floating-point remainder of the division of \fIx\fR by
\fIy\fR. If \fIy\fR is 0, an error is returned.
.TP
-\fBhypot(\fIx, y\fB)\fR
-Computes the length of the hypotenuse of a right-angled triangle
-\fBsqrt(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fB)\fR.
+\fBhypot \fIx y\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 the \fBwordSize\fR
+element of the \fBtcl_platform\fR array.
.TP
-\fBint(\fIarg\fB)\fR
-If \fIarg\fR is an integer value of the same width as the machine
-word, returns \fIarg\fR, otherwise
-converts \fIarg\fR to an integer (of the same size as a machine word,
-i.e. 32-bits on 32-bit systems, and 64-bits on 64-bit systems) by
-truncation and returns the converted value.
+\fBisqrt \fIarg\fR
+.
+Computes the integer part of the square root of \fIarg\fR. \fIArg\fR must be
+a positive value, either an integer or a floating point number.
+Unlike \fBsqrt\fR, which is limited to the precision of a floating point
+number, \fIisqrt\fR will return a result of arbitrary precision.
.TP
-\fBlog(\fIarg\fB)\fR
+\fBlog \fIarg\fR
+.
Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a
positive value.
.TP
-\fBlog10(\fIarg\fB)\fR
+\fBlog10 \fIarg\fR
+.
Returns the base 10 logarithm of \fIarg\fR. \fIArg\fR must be a
positive value.
.TP
-\fBpow(\fIx, y\fB)\fR
+\fBmax \fIarg\fB \fI...\fR
+.
+Accepts one or more numeric arguments. Returns the one argument
+with the greatest value.
+.TP
+\fBmin \fIarg\fB \fI...\fR
+.
+Accepts one or more numeric arguments. Returns the one argument
+with the least value.
+.TP
+\fBpow \fIx y\fR
+.
Computes the value of \fIx\fR raised to the power \fIy\fR. If \fIx\fR
is negative, \fIy\fR must be an integer value.
.TP
-\fBrand()\fR
+\fBrand\fR
+.
Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).
The generator algorithm is a simple linear congruential generator that
is not cryptographically secure. Each result from \fBrand\fR completely
@@ -184,47 +251,55 @@ determines all future results from subsequent calls to \fBrand\fR, so
one-time passwords. The seed of the generator is initialized from the
internal clock of the machine or may be set with the \fBsrand\fR function.
.TP
-\fBround(\fIarg\fB)\fR
+\fBround \fIarg\fR
+.
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
\fIarg\fR to integer by rounding and returns the converted value.
.TP
-\fBsin(\fIarg\fB)\fR
+\fBsin \fIarg\fR
+.
Returns the sine of \fIarg\fR, measured in radians.
.TP
-\fBsinh(\fIarg\fB)\fR
+\fBsinh \fIarg\fR
+.
Returns the hyperbolic sine of \fIarg\fR. If the result would cause
an overflow, an error is returned.
.TP
-\fBsqrt(\fIarg\fB)\fR
-Returns the square root of \fIarg\fR. \fIArg\fR must be non-negative.
+\fBsqrt \fIarg\fR
+.
+The argument may be any non-negative numeric value. Returns a floating-point
+value that is the square root of \fIarg\fR. May return \fBInf\fR when the
+argument is a numeric value that exceeds the square of the maximum value of
+the floating-point range.
.TP
-\fBsrand(\fIarg\fB)\fR
+\fBsrand \fIarg\fR
+.
The \fIarg\fR, which must be an integer, is used to reset the seed for
the random number generator of \fBrand\fR. Returns the first random
-number (see \fBrand()\fR) from that seed. Each interpreter has its own seed.
+number (see \fBrand\fR) from that seed. Each interpreter has its own seed.
.TP
-\fBtan(\fIarg\fB)\fR
+\fBtan \fIarg\fR
+.
Returns the tangent of \fIarg\fR, measured in radians.
.TP
-\fBtanh(\fIarg\fB)\fR
+\fBtanh \fIarg\fR
+.
Returns the hyperbolic tangent of \fIarg\fR.
.TP
-\fBwide(\fIarg\fB)\fR
-Converts \fIarg\fR to an integer value at least 64-bits wide (by sign-extension
-if \fIarg\fR is a 32-bit number) if it is not one already.
-.PP
-In addition to these predefined functions, applications may
-define additional functions by using \fBproc\fR (or any other method,
-such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
-new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
-obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
-extensions that are written in C. The latter interface is not recommended
-for new implementations..
+\fBwide \fIarg\fR
+.
+The argument may be any numeric value. The integer part of \fIarg\fR
+is determined, and then the low order 64 bits of that integer value
+are returned as an integer value.
.SH "SEE ALSO"
-expr(n), namespace(n)
+expr(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
+.nf
Copyright (c) 1993 The Regents of the University of California.
-.br
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
-.br
-Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
+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
new file mode 100644
index 0000000..4c16d76
--- /dev/null
+++ b/doc/mathop.n
@@ -0,0 +1,310 @@
+.\"
+.\" Copyright (c) 2006-2007 Donal K. Fellows.
+.\"
+.\" See the file "license.terms" for information on usage and redistribution
+.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+.\"
+.TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands"
+.so man.macros
+.BS
+.\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+mathop \- Mathematical operators as Tcl commands
+.SH SYNOPSIS
+package require \fBTcl 8.5\fR
+.sp
+\fB::tcl::mathop::!\fR \fInumber\fR
+.br
+\fB::tcl::mathop::~\fR \fInumber\fR
+.br
+\fB::tcl::mathop::+\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::\-\fR \fInumber\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::*\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::/\fR \fInumber\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::%\fR \fInumber number\fR
+.br
+\fB::tcl::mathop::**\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::&\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::|\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::^\fR ?\fInumber\fR ...?
+.br
+\fB::tcl::mathop::<<\fR \fInumber number\fR
+.br
+\fB::tcl::mathop::>>\fR \fInumber number\fR
+.br
+\fB::tcl::mathop::==\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::!=\fR \fIarg arg\fR
+.br
+\fB::tcl::mathop::<\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::<=\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::>=\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::>\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::eq\fR ?\fIarg\fR ...?
+.br
+\fB::tcl::mathop::ne\fR \fIarg arg\fR
+.br
+\fB::tcl::mathop::in\fR \fIarg list\fR
+.br
+\fB::tcl::mathop::ni\fR \fIarg list\fR
+.sp
+.BE
+.SH DESCRIPTION
+.PP
+The commands in the \fB::tcl::mathop\fR namespace implement the same set of
+operations as supported by the \fBexpr\fR command. All are exported from the
+namespace, but are not imported into any other namespace by default. Note that
+renaming, reimplementing or deleting any of the commands in the namespace does
+\fInot\fR alter the way that the \fBexpr\fR command behaves, and nor does
+defining any new commands in the \fB::tcl::mathop\fR namespace.
+.PP
+The following operator commands are supported:
+.DS
+.ta 2c 4c 6c 8c
+\fB~\fR \fB!\fR \fB+\fR \fB\-\fR \fB*\fR
+\fB/\fR \fB%\fR \fB**\fR \fB&\fR \fB|\fR
+\fB^\fR \fB>>\fR \fB<<\fR \fB==\fR \fBeq\fR
+\fB!=\fR \fBne\fR \fB<\fR \fB<=\fR \fB>\fR
+\fB>=\fR \fBin\fR \fBni\fR
+.DE
+.SS "MATHEMATICAL OPERATORS"
+.PP
+The behaviors of the mathematical operator commands are as follows:
+.TP
+\fB!\fR \fIboolean\fR
+.
+Returns the boolean negation of \fIboolean\fR, where \fIboolean\fR may be any
+numeric value or any other form of boolean value (i.e. it returns truth if the
+argument is falsity or zero, and falsity if the argument is truth or
+non-zero).
+.TP
+\fB+\fR ?\fInumber\fR ...?
+.
+Returns the sum of arbitrarily many arguments. Each \fInumber\fR argument may
+be any numeric value. If no arguments are given, the result will be zero (the
+summation identity).
+.TP
+\fB\-\fR \fInumber\fR ?\fInumber\fR ...?
+.
+If only a single \fInumber\fR argument is given, returns the negation of that
+numeric value. Otherwise returns the number that results when all subsequent
+numeric values are subtracted from the first one. All \fInumber\fR arguments
+must be numeric values. At least one argument must be given.
+.TP
+\fB*\fR ?\fInumber\fR ...?
+.
+Returns the product of arbitrarily many arguments. Each \fInumber\fR may be
+any numeric value. If no arguments are given, the result will be one (the
+multiplicative identity).
+.TP
+\fB/\fR \fInumber\fR ?\fInumber\fR ...?
+.
+If only a single \fInumber\fR argument is given, returns the reciprocal of that
+numeric value (i.e. the value obtained by dividing 1.0 by that value).
+Otherwise returns the number that results when the first numeric argument is
+divided by all subsequent numeric arguments. All \fInumber\fR arguments must
+be numeric values. At least one argument must be given.
+.RS
+.PP
+Note that when the leading values in the list of arguments are integers,
+integer division will be used for those initial steps (i.e. the intermediate
+results will be as if the functions \fIfloor\fR and \fIint\fR are applied to
+them, in that order). If all values in the operation are integers, the result
+will be an integer.
+.RE
+.TP
+\fB%\fR \fInumber number\fR
+.
+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
+\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB\-\fI x\fR [\fB%\fI x y\fR]]
+.CE
+.RE
+.TP
+\fB**\fR ?\fInumber\fR ...?
+.
+Returns the result of raising each value to the power of the result of
+recursively operating on the result of processing the following arguments, so
+.QW "\fB** 2 3 4\fR"
+is the same as
+.QW "\fB** 2 [** 3 4]\fR" .
+Each \fInumber\fR may be
+any numeric value, though the second number must not be fractional if the
+first is negative. If no arguments are given, the result will be one, and if
+only one argument is given, the result will be that argument. The
+result will have an integral value only when all arguments are
+integral values.
+.SS "COMPARISON OPERATORS"
+.PP
+The behaviors of the comparison operator commands (most of which operate
+preferentially on numeric arguments) are as follows:
+.TP
+\fB==\fR ?\fIarg\fR ...?
+.
+Returns whether each argument is equal to the arguments on each side of it in
+the sense of the \fBexpr\fR == operator (\fIi.e.\fR, numeric comparison if
+possible, exact string comparison otherwise). If fewer than two arguments
+are given, this operation always returns a true value.
+.TP
+\fBeq\fR ?\fIarg\fR ...?
+.
+Returns whether each argument is equal to the arguments on each side of it
+using exact string comparison. If fewer than two arguments are given, this
+operation always returns a true value.
+.TP
+\fB!=\fR \fIarg arg\fR
+.
+Returns whether the two arguments are not equal to each other, in the sense of
+the \fBexpr\fR != operator (\fIi.e.\fR, numeric comparison if possible, exact
+string comparison otherwise).
+.TP
+\fBne\fR \fIarg arg\fR
+.
+Returns whether the two arguments are not equal to each other using exact
+string comparison.
+.TP
+\fB<\fR ?\fIarg\fR ...?
+.
+Returns whether the arbitrarily-many arguments are ordered, with each argument
+after the first having to be strictly more than the one preceding it.
+Comparisons are performed preferentially on the numeric values, and are
+otherwise performed using UNICODE string comparison. If fewer than two
+arguments are present, this operation always returns a true value. When the
+arguments are numeric but should be compared as strings, the \fBstring
+compare\fR command should be used instead.
+.TP
+\fB<=\fR ?\fIarg\fR ...?
+.
+Returns whether the arbitrarily-many arguments are ordered, with each argument
+after the first having to be equal to or more than the one preceding it.
+Comparisons are performed preferentially on the numeric values, and are
+otherwise performed using UNICODE string comparison. If fewer than two
+arguments are present, this operation always returns a true value. When the
+arguments are numeric but should be compared as strings, the \fBstring
+compare\fR command should be used instead.
+.TP
+\fB>\fR ?\fIarg\fR ...?
+.
+Returns whether the arbitrarily-many arguments are ordered, with each argument
+after the first having to be strictly less than the one preceding it.
+Comparisons are performed preferentially on the numeric values, and are
+otherwise performed using UNICODE string comparison. If fewer than two
+arguments are present, this operation always returns a true value. When the
+arguments are numeric but should be compared as strings, the \fBstring
+compare\fR command should be used instead.
+.TP
+\fB>=\fR ?\fIarg\fR ...?
+.
+Returns whether the arbitrarily-many arguments are ordered, with each argument
+after the first having to be equal to or less than the one preceding it.
+Comparisons are performed preferentially on the numeric values, and are
+otherwise performed using UNICODE string comparison. If fewer than two
+arguments are present, this operation always returns a true value. When the
+arguments are numeric but should be compared as strings, the \fBstring
+compare\fR command should be used instead.
+.SS "BIT-WISE OPERATORS"
+.PP
+The behaviors of the bit-wise operator commands (all of which only operate on
+integral arguments) are as follows:
+.TP
+\fB~\fR \fInumber\fR
+.
+Returns the bit-wise negation of \fInumber\fR. \fINumber\fR may be an integer
+of any size. Note that the result of this operation will always have the
+opposite sign to the input \fInumber\fR.
+.TP
+\fB&\fR ?\fInumber\fR ...?
+.
+Returns the bit-wise AND of each of the arbitrarily many arguments. Each
+\fInumber\fR must have an integral value. If no arguments are given, the
+result will be minus one.
+.TP
+\fB|\fR ?\fInumber\fR ...?
+.
+Returns the bit-wise OR of each of the arbitrarily many arguments. Each
+\fInumber\fR must have an integral value. If no arguments are given, the
+result will be zero.
+.TP
+\fB^\fR ?\fInumber\fR ...?
+.
+Returns the bit-wise XOR of each of the arbitrarily many arguments. Each
+\fInumber\fR must have an integral value. If no arguments are given, the
+result will be zero.
+.TP
+\fB<<\fR \fInumber number\fR
+.
+Returns the result of bit-wise shifting the first argument left by the
+number of bits specified in the second argument. Each \fInumber\fR
+must have an integral value.
+.TP
+\fB>>\fR \fInumber number\fR
+.
+Returns the result of bit-wise shifting the first argument right by
+the number of bits specified in the second argument. Each \fInumber\fR
+must have an integral value.
+.SS "LIST OPERATORS"
+.PP
+The behaviors of the list-oriented operator commands are as follows:
+.TP
+\fBin\fR \fIarg list\fR
+.
+Returns whether the value \fIarg\fR is present in the list \fIlist\fR
+(according to exact string comparison of elements).
+.TP
+\fBni\fR \fIarg list\fR
+.
+Returns whether the value \fIarg\fR is not present in the list \fIlist\fR
+(according to exact string comparison of elements).
+.SH EXAMPLES
+.PP
+The simplest way to use the operators is often by using \fBnamespace path\fR
+to make the commands available. This has the advantage of not affecting the
+set of commands defined by the current namespace.
+.PP
+.CS
+namespace path {\fB::tcl::mathop\fR ::tcl::mathfunc}
+
+\fI# Compute the sum of some numbers\fR
+set sum [\fB+\fR 1 2 3]
+
+\fI# Compute the average of a list\fR
+set list {1 2 3 4 5 6}
+set mean [\fB/\fR [\fB+\fR {*}$list] [double [llength $list]]]
+
+\fI# Test for list membership\fR
+set gotIt [\fBin\fR 3 $list]
+
+\fI# Test to see if a value is within some defined range\fR
+set inRange [\fB<=\fR 1 $x 5]
+
+\fI# Test to see if a list is sorted\fR
+set sorted [\fB<=\fR {*}$list]
+.CE
+.SH "SEE ALSO"
+expr(n), mathfunc(n), namespace(n)
+.SH KEYWORDS
+command, expression, operator
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/memory.n b/doc/memory.n
index 034c41e..5a1524b 100644
--- a/doc/memory.n
+++ b/doc/memory.n
@@ -3,17 +3,14 @@
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: memory.n,v 1.6 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
.SH NAME
memory \- Control Tcl memory debugging capabilities
.SH SYNOPSIS
\fBmemory \fIoption \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBmemory\fR command gives the Tcl developer control of Tcl's memory
@@ -23,9 +20,11 @@ memory debugging enabled (when \fBTCL_MEM_DEBUG\fR is defined at
compile time), and after \fBTcl_InitMemory\fR has been called.
.TP
\fBmemory active\fR \fIfile\fR
+.
Write a list of all currently allocated memory to the specified \fIfile\fR.
.TP
\fBmemory break_on_malloc\fR \fIcount\fR
+.
After the \fIcount\fR allocations have been performed, \fBckalloc\fR
outputs a message to this effect and that it is now attempting to enter
the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself.
@@ -33,22 +32,33 @@ If you are running Tcl under a C debugger, it should then enter the debugger
command mode.
.TP
\fBmemory info\fR
+.
Returns a report containing the total allocations and frees since
Tcl began, the current packets allocated (the current
number of calls to \fBckalloc\fR not met by a corresponding call
to \fBckfree\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
-\fB memory init [on|off]\fR
+\fBmemory init \fR[\fBon\fR|\fBoff\fR]
+.
Turn on or off the pre-initialization of all allocated memory
-with bogus bytes. Useful for detecting the use of uninitialized values.
+with bogus bytes. Useful for detecting the use of uninitialized
+values.
+.TP
+\fBmemory objs \fIfile\fR
+.
+Causes a list of all allocated Tcl_Obj values to be written to the specified
+\fIfile\fR immediately, together with where they were allocated. Useful for
+checking for leaks of values.
.TP
\fBmemory onexit\fR \fIfile\fR
+.
Causes a list of all allocated memory to be written to the specified \fIfile\fR
during the finalization of Tcl's memory subsystem. Useful for checking
that memory is properly cleaned up during process exit.
.TP
\fBmemory tag\fR \fIstring\fR
+.
Each packet of memory allocated by \fBckalloc\fR can have associated
with it a string-valued tag. In the lists of allocated memory generated
by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet
@@ -56,22 +66,25 @@ is printed along with other information about the packet. The
\fBmemory tag\fR command sets the tag value for subsequent calls
to \fBckalloc\fR to be \fIstring\fR.
.TP
-\fBmemory trace [on|off]\fR
-.br
+\fBmemory trace \fR[\fBon\fR|\fBoff\fR]
+.
Turns memory tracing on or off. When memory tracing is on, every call
to \fBckalloc\fR causes a line of trace information to be written to
\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the
address returned, the amount of memory allocated, and the C filename
and line number of the code performing the allocation. For example:
.RS
+.PP
.CS
ckalloc 40e478 98 tclProc.c 1406
.CE
+.PP
Calls to \fBckfree\fR are traced in the same manner.
.RE
.TP
\fBmemory trace_on_at_malloc\fR \fIcount\fR
-Enable memory tracing after \fIcount\fR \fBckalloc\fR's have been performed.
+.
+Enable memory tracing after \fIcount\fR \fBckalloc\fRs have been performed.
For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
after the 100th call to \fBckalloc\fR, memory trace information will begin
being displayed for all allocations and frees. Since there can be a lot
@@ -81,7 +94,8 @@ produced), if you can identify a number of allocations that occur before
the problem sets in. The current number of memory allocations that have
occurred since Tcl started is printed on a guard zone failure.
.TP
-\fBmemory validate [on|off]\fR
+\fBmemory validate \fR[\fBon\fR|\fBoff\fR]
+.
Turns memory validation on or off. When memory validation is enabled,
on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are
checked for every piece of memory currently in existence that was
@@ -92,9 +106,10 @@ overwrite can be detected on the first call to \fBckalloc\fR or
\fBckfree\fR after the overwrite occurred, rather than when the
specific memory with the overwritten guard zone(s) is freed, which may
occur long after the overwrite occurred.
-
.SH "SEE ALSO"
ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
-
.SH KEYWORDS
memory, debug
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 924dc1e..bae6dbe 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
-'\"
+.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
-.TH "msgcat" n 1.4 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.1\fR
+\fBpackage require msgcat 1.5\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
@@ -31,15 +29,21 @@ msgcat \- Tcl message catalog
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp
-\fB::msgcat::mcunknown \fIlocale src-string\fR
+.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 ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
-Text strings are defined in a ``message catalog'' which
-is independent from the application, and
+Text strings are defined in a
+.QW "message catalog"
+which is independent from the application, and
which can be edited or localized without modifying
the application source code. New languages
or locales are provided by adding a new file to
@@ -51,10 +55,12 @@ wishes to be enabled for multi-lingual applications.
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
+.
Returns a translation of \fIsrc-string\fR according to the
user's current locale. If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
additional arguments in the translation of \fIsrc-string\fR.
+.RS
.PP
\fB::msgcat::mc\fR will search the messages defined
in the current namespace for a translation of \fIsrc-string\fR; if
@@ -69,14 +75,17 @@ application can pass the English string through \fB::msgcat::mc\fR and
use the result. If an application is written for a single language in
this fashion, then it is easy to add support for additional languages
later simply by defining new message catalog entries.
+.RE
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
+.
Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string. This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.TP
-\fB::msgcat::mclocale \fR?\fInewLocale\fR?
+\fB::msgcat::mclocale \fR?\fInewLocale\fR?
+.
This function sets the locale to \fInewLocale\fR. If \fInewLocale\fR
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR. msgcat stores and compares the locale in a
@@ -86,6 +95,7 @@ the user's environment. See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
.TP
\fB::msgcat::mcpreferences\fR
+.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
@@ -93,15 +103,15 @@ preference. The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently. For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
-.VS 1.4
returns \fB{en_US_funky en_US en {}}\fR.
-.VE 1.4
.TP
\fB::msgcat::mcload \fIdirname\fR
+.
Searches the specified directory for files that match
the language specifications returned by \fB::msgcat::mcpreferences\fR
-(note that these are all lowercase), extended by the file
-extension ``.msg''. Each matching file is
+(note that these are all lowercase), extended by the file extension
+.QW .msg .
+Each matching file is
read in order, assuming a UTF-8 encoding. The file contents are
then evaluated as a Tcl script. This means that Unicode characters
may be present in the message file either directly in their UTF-8
@@ -110,12 +120,14 @@ evaluation. The number of message files which matched the specification
and were loaded is returned.
.TP
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
+.
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR
in the specified \fIlocale\fR and the current namespace. If
\fItranslate-string\fR is not specified, \fIsrc-string\fR is used
for both. The function returns \fItranslate-string\fR.
.TP
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
+.
Sets the translation for multiple source strings in
\fIsrc-trans-list\fR in the specified \fIlocale\fR and the current
namespace.
@@ -125,11 +137,33 @@ 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::mcunknown \fIlocale src-string\fR
+\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 ?\fIarg arg ...\fR?
+.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale. The default action is to return
-\fIsrc-string\fR. This procedure can be redefined by the
+\fIsrc-string\fR passed by format if there are any arguments. This
+procedure can be redefined by the
application, for example to log error messages for each unknown
string. The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR. The return value
@@ -141,39 +175,57 @@ The locale is specified to \fBmsgcat\fR by a locale string
passed to \fB::msgcat::mclocale\fR.
The locale string consists of
a language code, an optional country code, and an optional
-system-specific code, each separated by ``_''. The country and language
+system-specific code, each separated by
+.QW _ .
+The country and language
codes are specified in standards ISO-639 and ISO-3166.
-For example, the locale ``en'' specifies English and ``en_US'' specifies
-U.S. English.
+For example, the locale
+.QW en
+specifies English and
+.QW en_US
+specifies U.S. English.
.PP
When the msgcat package is first loaded, the locale is initialized
according to the user's environment. The variables \fBenv(LC_ALL)\fR,
\fBenv(LC_MESSAGES)\fR, and \fBenv(LANG)\fR are examined in order.
The first of them to have a non-empty value is used to determine the
initial locale. The value is parsed according to the XPG4 pattern
+.PP
.CS
language[_country][.codeset][@modifier]
.CE
+.PP
to extract its parts. The initial locale is then set by calling
\fB::msgcat::mclocale\fR with the argument
+.PP
.CS
language[_country][_modifier]
.CE
-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 ``C''.
-.PP
-When a locale is specified by the user, a ``best match'' search is
-performed during string translation. For example, if a user specifies
-.VS 1.4
-en_GB_Funky, the locales ``en_GB_Funky'', ``en_GB'', ``en'' and ``''
+.PP
+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
+.QW "best match"
+search is performed during string translation. For example, if a user
+specifies
+en_GB_Funky, the locales
+.QW en_GB_Funky ,
+.QW en_GB ,
+.QW en
+and
+.MT
(the empty string)
-.VE 1.4
are searched in order until a matching translation
string is found. If no translation string is available, then
-\fB::msgcat::unknown\fR is called.
+\fB::msgcat::mcunknown\fR is called.
.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
@@ -184,15 +236,18 @@ source string to be shorter and less prone to typographical
error.
.PP
For example, executing the code
+.PP
.CS
\fB::msgcat::mcset\fR en hello "hello from ::"
namespace eval foo {
- \fB::msgcat::mcset\fR en hello "hello from ::foo"
+ \fB::msgcat::mcset\fR en hello "hello from ::foo"
}
puts [\fB::msgcat::mc\fR hello]
namespace eval foo {puts [\fB::msgcat::mc\fR hello]}
.CE
+.PP
will print
+.PP
.CS
hello from ::
hello from ::foo
@@ -201,27 +256,33 @@ hello from ::foo
When searching for a translation of a message, the
message catalog will search first the current namespace,
then the parent of the current namespace, and so on until
-the global namespace is reached. This allows child namespaces
-to "inherit" messages from their parent namespace.
+the global namespace is reached. This allows child namespaces to
+.QW inherit
+messages from their parent namespace.
+.PP
+For example, executing (in the
+.QW en
+locale) the code
.PP
-For example, executing (in the ``en'' locale) the code
.CS
\fB::msgcat::mcset\fR en m1 ":: message1"
\fB::msgcat::mcset\fR en m2 ":: message2"
\fB::msgcat::mcset\fR en m3 ":: message3"
namespace eval ::foo {
- \fB::msgcat::mcset\fR en m2 "::foo message2"
- \fB::msgcat::mcset\fR en m3 "::foo message3"
+ \fB::msgcat::mcset\fR en m2 "::foo message2"
+ \fB::msgcat::mcset\fR en m3 "::foo message3"
}
namespace eval ::foo::bar {
- \fB::msgcat::mcset\fR en m3 "::foo::bar message3"
+ \fB::msgcat::mcset\fR en m3 "::foo::bar message3"
}
namespace import \fB::msgcat::mc\fR
puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]"
namespace eval ::foo {puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]"}
namespace eval ::foo::bar {puts "[\fBmc\fR m1]; [\fBmc\fR m2]; [\fBmc\fR m3]"}
.CE
+.PP
will print
+.PP
.CS
:: message1; :: message2; :: message3
:: message1; ::foo message2; ::foo message3
@@ -234,27 +295,33 @@ to the following conditions:
.IP [1]
All message files for a package are in the same directory.
.IP [2]
-The message file name is a msgcat locale specifier (all lowercase)
-followed by ``.msg''. For example:
+The message file name is a msgcat locale specifier (all lowercase) followed by
+.QW .msg .
+For example:
+.PP
.CS
-es.msg -- spanish
-en_gb.msg -- United Kingdom English
+es.msg \(em spanish
+en_gb.msg \(em United Kingdom English
.CE
-.VS 1.4
-\fIException:\fR The message file for the root locale ``'' is
-called \fBROOT.msg\fR. This exception is made so as not to
+.PP
+\fIException:\fR The message file for the root locale
+.MT
+is called
+.QW \fBROOT.msg\fR .
+This exception is made so as not to
cause peculiar behavior, such as marking the message file as
-``hidden'' on Unix file systems.
-.VE 1.4
+.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"
@@ -268,8 +335,8 @@ During package installation, create a subdirectory
.IP [2]
Copy your *.msg files into that directory.
.IP [3]
- Add the following command to your package
-initialization script:
+Add the following command to your package initialization script:
+.PP
.CS
# load language files, stored in msgs subdirectory
\fB::msgcat::mcload\fR [file join [file dirname [info script]] msgs]
@@ -281,6 +348,7 @@ to \fBformat\fR might have positionally dependent parameters that
might need to be repositioned. For example, it might be
syntactically desirable to rearrange the sentence structure
while translating.
+.PP
.CS
format "We produced %d units in location %s" $num $city
format "In location %s we produced %d units" $city $num
@@ -288,19 +356,30 @@ format "In location %s we produced %d units" $city $num
.PP
This can be handled by using the positional
parameters:
+.PP
.CS
-format "We produced %1\\$d units in location %2\\$s" $num $city
-format "In location %2\\$s we produced %1\\$d units" $num $city
+format "We produced %1\e$d units in location %2\e$s" $num $city
+format "In location %2\e$s we produced %1\e$d units" $num $city
.CE
.PP
Similarly, positional parameters can be used with \fBscan\fR to
-extract values from internationalized strings.
+extract values from internationalized strings. Note that it is not
+necessary to pass the output of \fB::msgcat::mc\fR to \fBformat\fR
+directly; by passing the values to substitute in as arguments, the
+formatting substitution is done directly.
+.PP
+.CS
+\fBmsgcat::mc\fR {Produced %1$d at %2$s} $num $city
+# ... where that key is mapped to one of the
+# human-oriented versions by \fBmsgcat::mcset\fR
+.CE
.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
-
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n)
-
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/my.n b/doc/my.n
new file mode 100644
index 0000000..b91bc9a0
--- /dev/null
+++ b/doc/my.n
@@ -0,0 +1,56 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH my n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+my \- invoke any method of current object
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBmy\fI methodName\fR ?\fIarg ...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBmy\fR command is used to allow methods of objects to invoke any method
+of the object (or its class). In particular, the set of valid values for
+\fImethodName\fR is the set of all methods supported by an object and its
+superclasses, including those that are not exported. The object upon which the
+method is invoked is always the one that is the current context of the method
+(i.e. the object that is returned by \fBself object\fR) from which the
+\fBmy\fR command is invoked.
+.PP
+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 publicly visible by default:
+.PP
+.CS
+oo::class create c {
+ method count {} {
+ \fBmy\fR variable counter
+ print [incr counter]
+ }
+}
+c create o
+o count \fI\(-> prints "1"\fR
+o count \fI\(-> prints "2"\fR
+o count \fI\(-> prints "3"\fR
+.CE
+.SH "SEE ALSO"
+next(n), oo::object(n), self(n)
+.SH KEYWORDS
+method, method visibility, object, private method, public method
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/namespace.n b/doc/namespace.n
index 60bd8e8..1f4e85f 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -6,29 +6,27 @@
'\"
'\" 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.18 2005/05/30 00:04:45 dkf Exp $
-'\"
-.so man.macros
+'\"
.TH namespace n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
namespace \- create and manipulate contexts for commands and variables
.SH SYNOPSIS
-\fBnamespace \fR?\fIoption\fR? ?\fIarg ...\fR?
+\fBnamespace \fR?\fIsubcommand\fR? ?\fIarg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBnamespace\fR command lets you create, access, and destroy
separate contexts for commands and variables.
See the section \fBWHAT IS A NAMESPACE?\fR below
for a brief overview of namespaces.
-The legal values of \fIoption\fR are listed below.
-Note that you can abbreviate the \fIoption\fRs.
+The legal values of \fIsubcommand\fR are listed below.
+Note that you can abbreviate the \fIsubcommand\fRs.
.TP
\fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR?
+.
Returns a list of all child namespaces that belong to the
namespace \fInamespace\fR.
If \fInamespace\fR is not specified,
@@ -44,6 +42,7 @@ otherwise the namespace \fInamespace\fR
is prepended onto the pattern.
.TP
\fBnamespace code \fIscript\fR
+.
Captures the current namespace context for later execution
of the script \fIscript\fR.
It returns a new script in which \fIscript\fR has been wrapped
@@ -57,7 +56,7 @@ and they will be passed to \fIscript\fR as additional arguments.
For example, suppose the command
\fBset script [namespace code {foo bar}]\fR
is invoked in namespace \fB::a::b\fR.
-Then \fBeval "$script x y"\fR
+Then \fBeval $script [list x y]\fR
can be executed in any namespace (assuming the value of
\fBscript\fR has been passed in properly)
and will have the same effect as the command
@@ -71,13 +70,16 @@ See the section \fBSCOPED SCRIPTS\fR for some examples
of how this is used to create callback scripts.
.TP
\fBnamespace current\fR
+.
Returns the fully-qualified name for the current namespace.
-The actual name of the global namespace is ``''
+The actual name of the global namespace is
+.MT
(i.e., an empty string),
but this command returns \fB::\fR for the global namespace
as a convenience to programmers.
.TP
\fBnamespace delete \fR?\fInamespace namespace ...\fR?
+.
Each namespace \fInamespace\fR is deleted
and all variables, procedures, and child namespaces
contained in the namespace are deleted.
@@ -85,17 +87,17 @@ If a procedure is currently executing inside the namespace,
the namespace will be kept alive until the procedure returns;
however, the namespace is marked to prevent other code from
looking it up by name.
-If a namespace doesn't exist, this command returns an error.
+If a namespace does not exist, this command returns an error.
If no namespace names are given, this command does nothing.
.TP
-\fBnamespace ensemble\fR \fIoption\fR ?\fIarg ...\fR?
-.VS 8.5
+\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR?
+.
Creates and manipulates a command that is formed out of an ensemble of
subcommands. See the section \fBENSEMBLES\fR below for further
details.
-.VE 8.5
.TP
\fBnamespace eval\fR \fInamespace arg\fR ?\fIarg ...\fR?
+.
Activates a namespace called \fInamespace\fR and evaluates some code
in that context.
If the namespace does not already exist, it is created.
@@ -103,17 +105,20 @@ If more than one \fIarg\fR argument is specified,
the arguments are concatenated together with a space between each one
in the same fashion as the \fBeval\fR command,
and the result is evaluated.
-.br
-.sp
+.RS
+.PP
If \fInamespace\fR has leading namespace qualifiers
and any leading namespaces do not exist,
they are automatically created.
+.RE
.TP
\fBnamespace exists\fR \fInamespace\fR
+.
Returns \fB1\fR if \fInamespace\fR is a valid namespace in the current
context, returns \fB0\fR otherwise.
.TP
-\fBnamespace export \fR?\-\fBclear\fR? ?\fIpattern pattern ...\fR?
+\fBnamespace export \fR?\fB\-clear\fR? ?\fIpattern pattern ...\fR?
+.
Specifies which commands are exported from a namespace.
The exported commands are those that can be later imported
into another namespace using a \fBnamespace import\fR command.
@@ -127,41 +132,61 @@ but it may not include any namespace qualifiers.
That is, the pattern can only specify commands
in the current (exporting) namespace.
Each \fIpattern\fR is appended onto the namespace's list of export patterns.
-If the \-\fBclear\fR flag is given,
+If the \fB\-clear\fR flag is given,
the namespace's export pattern list is reset to empty before any
\fIpattern\fR arguments are appended.
-If no \fIpattern\fRs are given and the \-\fBclear\fR flag isn't given,
+If no \fIpattern\fRs are given and the \fB\-clear\fR flag is not given,
this command returns the namespace's current export list.
.TP
\fBnamespace forget \fR?\fIpattern pattern ...\fR?
+.
Removes previously imported commands from a namespace.
Each \fIpattern\fR is a simple or qualified name such as
\fBx\fR, \fBfoo::x\fR or \fBa::b::p*\fR.
Qualified names contain double colons (\fB::\fR) and qualify a name
with the name of one or more namespaces.
-Each \fIqualified pattern\fR is qualified with the name of an
-exporting namespace
+Each
+.QW "qualified pattern"
+is qualified with the name of an exporting namespace
and may have glob-style special characters in the command name
at the end of the qualified name.
Glob characters may not appear in a namespace name.
-For each \fIsimple pattern\fR this command deletes the matching
-commands of the
+For each
+.QW "simple pattern"
+this command deletes the matching commands of the
current namespace that were imported from a different namespace.
-For \fIqualified patterns\fR, this command first finds the matching
-exported commands.
+For
+.QW "qualified patterns" ,
+this command first finds the matching exported commands.
It then checks whether any of those commands
were previously imported by the current namespace.
-If so, this command deletes the corresponding imported commands.
+If so, this command deletes the corresponding imported commands.
In effect, this un-does the action of a \fBnamespace import\fR command.
.TP
\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR?
-Imports commands into a namespace.
-Each \fIpattern\fR is a qualified name like
+.
+Imports commands into a namespace, or queries the set of imported
+commands in a namespace. When no arguments are present,
+\fBnamespace import\fR returns the list of commands in
+the current namespace that have been imported from other
+namespaces. The commands in the returned list are in
+the format of simple names, with no namespace qualifiers at all.
+This format is suitable for composition with \fBnamespace forget\fR
+(see \fBEXAMPLES\fR below).
+.RS
+.PP
+When \fIpattern\fR arguments are present,
+each \fIpattern\fR is a qualified name like
\fBfoo::x\fR or \fBa::p*\fR.
That is, it includes the name of an exporting namespace
and may have glob-style special characters in the command name
at the end of the qualified name.
Glob characters may not appear in a namespace name.
+When the namespace name is not fully qualified (i.e., does not start
+with a namespace separator) it is resolved as a namespace name in the
+way described in the \fBNAME RESOLUTION\fR section; it is an error if
+no namespace with that name can be found.
+.PP
All the commands that match a \fIpattern\fR string
and which are currently exported from their namespace
are added to the current namespace.
@@ -170,7 +195,7 @@ that points to the exported command in its original namespace;
when the new imported command is called, it invokes the exported command.
This command normally returns an error
if an imported command conflicts with an existing command.
-However, if the \-\fBforce\fR option is given,
+However, if the \fB\-force\fR option is given,
imported commands will silently replace existing commands.
The \fBnamespace import\fR command has snapshot semantics:
that is, only requested commands that are currently defined
@@ -179,8 +204,10 @@ In other words, you can import only the commands that are in a namespace
at the time when the \fBnamespace import\fR command is executed.
If another command is defined and exported in this namespace later on,
it will not be imported.
+.RE
.TP
\fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR?
+.
Executes a script in the context of the specified \fInamespace\fR.
This command is not expected to be used directly by programmers;
calls to it are generated implicitly when applications
@@ -190,14 +217,24 @@ The \fBnamespace inscope\fR command is much like the \fBnamespace eval\fR
command except that the \fInamespace\fR must already exist,
and \fBnamespace inscope\fR appends additional \fIarg\fRs
as proper list elements.
-.br
+.RS
+.PP
+.CS
\fBnamespace inscope ::foo $script $x $y $z\fR
+.CE
+.PP
is equivalent to
+.PP
+.CS
\fBnamespace eval ::foo [concat $script [list $x $y $z]]\fR
+.CE
+.PP
thus additional arguments will not undergo a second round of substitution,
as is the case with \fBnamespace eval\fR.
+.RE
.TP
\fBnamespace origin \fIcommand\fR
+.
Returns the fully-qualified name of the original command
to which the imported command \fIcommand\fR refers.
When a command is imported into a namespace,
@@ -212,23 +249,23 @@ If \fIcommand\fR does not refer to an imported command,
the command's own fully-qualified name is returned.
.TP
\fBnamespace parent\fR ?\fInamespace\fR?
+.
Returns the fully-qualified name of the parent namespace
for namespace \fInamespace\fR.
If \fInamespace\fR is not specified,
the fully-qualified name of the current namespace's parent is returned.
.TP
\fBnamespace path\fR ?\fInamespaceList\fR?
-'\" Should really have the .TP inside the .VS, but that triggers a groff bug
-.VS 8.5
+.
Returns the command resolution path of the current namespace. If
\fInamespaceList\fR is specified as a list of named namespaces, the
current namespace's command resolution path is set to those namespaces
and returns the empty list. The default command resolution path is
always empty. See the section \fBNAME RESOLUTION\fR below for an
explanation of the rules regarding name resolution.
-.VE 8.5
.TP
\fBnamespace qualifiers\fR \fIstring\fR
+.
Returns any leading namespace qualifiers for \fIstring\fR.
Qualifiers are namespace names separated by double colons (\fB::\fR).
For the \fIstring\fR \fB::foo::bar::x\fR,
@@ -240,6 +277,7 @@ namespace names are, in fact,
the names of currently defined namespaces.
.TP
\fBnamespace tail\fR \fIstring\fR
+.
Returns the simple name at the end of a qualified string.
Qualifiers are namespace names separated by double colons (\fB::\fR).
For the \fIstring\fR \fB::foo::bar::x\fR,
@@ -249,7 +287,32 @@ This command is the complement of the \fBnamespace qualifiers\fR command.
It does not check whether the namespace names are, in fact,
the names of currently defined namespaces.
.TP
-\fBnamespace which\fR ?\-\fBcommand\fR? ?\-\fBvariable\fR? \fIname\fR
+\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...?
+.
+This command arranges for zero or more local variables in the current
+procedure to refer to variables in \fInamespace\fR. The namespace name is
+resolved as described in section \fBNAME RESOLUTION\fR.
+The command
+\fBnamespace upvar $ns a b\fR has the same behaviour as
+\fBupvar 0 ${ns}::a b\fR, with the sole exception of the resolution rules
+used for qualified namespace or variable names.
+\fBnamespace upvar\fR returns an empty string.
+.TP
+\fBnamespace unknown\fR ?\fIscript\fR?
+.
+Sets or returns the unknown command handler for the current namespace.
+The handler is invoked when a command called from within the namespace
+cannot be found in the current namespace, the namespace's path nor in
+the global namespace.
+The \fIscript\fR argument, if given, should be a well
+formed list representing a command name and optional arguments. When
+the handler is invoked, the full invocation line will be appended to the
+script and the result evaluated in the context of the namespace. The
+default handler for all namespaces is \fB::unknown\fR. If no argument
+is given, it returns the handler for the current namespace.
+.TP
+\fBnamespace which\fR ?\fB\-command\fR? ?\fB\-variable\fR? \fIname\fR
+.
Looks up \fIname\fR as either a command or variable
and returns its fully-qualified name.
For example, if \fIname\fR does not exist in the current namespace
@@ -258,7 +321,7 @@ this command returns a fully-qualified name in the global namespace.
If the command or variable does not exist,
this command returns an empty string. If the variable has been
created but not defined, such as with the \fBvariable\fR command
-or through a \fBtrace\fR on the variable, this command will return the
+or through a \fBtrace\fR on the variable, this command will return the
fully-qualified name of the variable.
If no flag is given, \fIname\fR is treated as a command name.
See the section \fBNAME RESOLUTION\fR below for an explanation of
@@ -267,23 +330,25 @@ the rules regarding name resolution.
.PP
A namespace is a collection of commands and variables.
It encapsulates the commands and variables to ensure that they
-won't interfere with the commands and variables of other namespaces.
+will not interfere with the commands and variables of other namespaces.
Tcl has always had one such collection,
which we refer to as the \fIglobal namespace\fR.
The global namespace holds all global variables and commands.
The \fBnamespace eval\fR command lets you create new namespaces.
For example,
+.PP
.CS
\fBnamespace eval\fR Counter {
- \fBnamespace export\fR bump
- variable num 0
+ \fBnamespace export\fR bump
+ variable num 0
- proc bump {} {
- variable num
- incr num
- }
+ proc bump {} {
+ variable num
+ incr num
+ }
}
.CE
+.PP
creates a new namespace containing the variable \fBnum\fR and
the procedure \fBbump\fR.
The commands and variables in this namespace are separate from
@@ -303,23 +368,25 @@ so you can build up the contents of a
namespace over time using a series of \fBnamespace eval\fR commands.
For example, the following series of commands has the same effect
as the namespace definition shown above:
+.PP
.CS
\fBnamespace eval\fR Counter {
- variable num 0
- proc bump {} {
- variable num
- return [incr num]
- }
+ variable num 0
+ proc bump {} {
+ variable num
+ return [incr num]
+ }
}
\fBnamespace eval\fR Counter {
- proc test {args} {
- return $args
- }
+ proc test {args} {
+ return $args
+ }
}
\fBnamespace eval\fR Counter {
- rename test ""
+ rename test ""
}
.CE
+.PP
Note that the \fBtest\fR procedure is added to the \fBCounter\fR namespace,
and later removed via the \fBrename\fR command.
.PP
@@ -338,8 +405,9 @@ Qualified names are similar to the hierarchical path names for
Unix files or Tk widgets,
except that \fB::\fR is used as the separator
instead of \fB/\fR or \fB.\fR.
-The topmost or global namespace has the name ``'' (i.e., an empty string),
-although \fB::\fR is a synonym.
+The topmost or global namespace has the name
+.MT
+(i.e., an empty string), although \fB::\fR is a synonym.
As an example, the name \fB::safe::interp::create\fR
refers to the command \fBcreate\fR in the namespace \fBinterp\fR
that is a child of namespace \fB::safe\fR,
@@ -350,19 +418,24 @@ you must use some extra syntax.
Names must be qualified by the namespace that contains them.
From the global namespace,
we might access the \fBCounter\fR procedures like this:
+.PP
.CS
Counter::bump 5
Counter::Reset
.CE
+.PP
We could access the current count like this:
+.PP
.CS
puts "count = $Counter::num"
.CE
+.PP
When one namespace contains another, you may need more than one
qualifier to reach its elements.
If we had a namespace \fBFoo\fR that contained the namespace \fBCounter\fR,
you could invoke its \fBbump\fR procedure
from the global namespace like this:
+.PP
.CS
Foo::Counter::bump 3
.CE
@@ -370,10 +443,13 @@ Foo::Counter::bump 3
You can also use qualified names when you create and rename commands.
For example, you could add a procedure to the \fBFoo\fR
namespace like this:
+.PP
.CS
proc Foo::Test {args} {return $args}
.CE
+.PP
And you could move the same procedure to another namespace like this:
+.PP
.CS
rename Foo::Test Bar::Test
.CE
@@ -398,47 +474,50 @@ If you provide a fully-qualified name that starts with a \fB::\fR,
there is no question about what command, variable, or namespace
you mean.
However, if the name does not start with a \fB::\fR
-(i.e., is \fIrelative\fR),
+(i.e., is \fIrelative\fR),
Tcl follows basic rules for looking it up:
-Variable names are always resolved
-by looking first in the current namespace,
-and then in the global namespace.
-.VS 8.5
-Command names are also always resolved by looking in the current
-namespace first. If not found there, they are searched for in every
-namespace on the current namespace's command path (which is empty by
-default). If not found there, command names are looked up in the
-global namespace (or, failing that, are processed by the \fBunknown\fR
-command.)
-.VE 8.5
-Namespace names, on the other hand, are always resolved
-by looking in only the current namespace.
+.IP \(bu
+\fBVariable names\fR are always resolved by looking first in the current
+namespace, and then in the global namespace.
+.IP \(bu
+\fBCommand names\fR are always resolved by looking in the current namespace
+first. If not found there, they are searched for in every namespace on the
+current namespace's command path (which is empty by default). If not found
+there, command names are looked up in the global namespace (or, failing that,
+are processed by the appropriate \fBnamespace unknown\fR handler.)
+.IP \(bu
+\fBNamespace names\fR are always resolved by looking in only the current
+namespace.
.PP
In the following example,
+.PP
.CS
set traceLevel 0
\fBnamespace eval\fR Debug {
- printTrace $traceLevel
+ printTrace $traceLevel
}
.CE
+.PP
Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR
and then in the global namespace.
It looks up the command \fBprintTrace\fR in the same way.
If a variable or command name is not found in either context,
the name is undefined.
To make this point absolutely clear, consider the following example:
+.PP
.CS
set traceLevel 0
\fBnamespace eval\fR Foo {
- variable traceLevel 3
+ variable traceLevel 3
- \fBnamespace eval\fR Debug {
- printTrace $traceLevel
- }
+ \fBnamespace eval\fR Debug {
+ printTrace $traceLevel
+ }
}
.CE
+.PP
Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR.
-Since it is not found there, Tcl then looks for it
+Since it is not found there, Tcl then looks for it
in the global namespace.
The variable \fBFoo::traceLevel\fR is completely ignored
during the name resolution process.
@@ -446,14 +525,18 @@ during the name resolution process.
You can use the \fBnamespace which\fR command to clear up any question
about name resolution.
For example, the command:
+.PP
.CS
\fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR \-variable traceLevel}
.CE
+.PP
returns \fB::traceLevel\fR.
On the other hand, the command,
+.PP
.CS
\fBnamespace eval\fR Foo {\fBnamespace which\fR \-variable traceLevel}
.CE
+.PP
returns \fB::Foo::traceLevel\fR.
.PP
As mentioned above,
@@ -491,34 +574,42 @@ that it is a nuisance to type their qualified names.
For example, suppose that all of the commands in a package
like BLT are contained in a namespace called \fBBlt\fR.
Then you might access these commands like this:
+.PP
.CS
Blt::graph .g \-background red
Blt::table . .g 0,0
.CE
+.PP
If you use the \fBgraph\fR and \fBtable\fR commands frequently,
you may want to access them without the \fBBlt::\fR prefix.
You can do this by importing the commands into the current namespace,
like this:
+.PP
.CS
\fBnamespace import\fR Blt::*
.CE
+.PP
This adds all exported commands from the \fBBlt\fR namespace
into the current namespace context, so you can write code like this:
+.PP
.CS
graph .g \-background red
table . .g 0,0
.CE
+.PP
The \fBnamespace import\fR command only imports commands
from a namespace that that namespace exported
with a \fBnamespace export\fR command.
.PP
Importing \fIevery\fR command from a namespace is generally
-a bad idea since you don't know what you will get.
+a bad idea since you do not know what you will get.
It is better to import just the specific commands you need.
For example, the command
+.PP
.CS
\fBnamespace import\fR Blt::graph Blt::table
.CE
+.PP
imports only the \fBgraph\fR and \fBtable\fR commands into the
current context.
.PP
@@ -529,57 +620,67 @@ you may want to get around this restriction. You may want to
reissue the \fBnamespace import\fR command to pick up new commands
that have appeared in a namespace. In that case, you can use the
\fB\-force\fR option, and existing commands will be silently overwritten:
+.PP
.CS
\fBnamespace import\fR \-force Blt::graph Blt::table
.CE
+.PP
If for some reason, you want to stop using the imported commands,
you can remove them with a \fBnamespace forget\fR command, like this:
+.PP
.CS
\fBnamespace forget\fR Blt::*
.CE
+.PP
This searches the current namespace for any commands imported from \fBBlt\fR.
If it finds any, it removes them. Otherwise, it does nothing.
After this, the \fBBlt\fR commands must be accessed with the \fBBlt::\fR
prefix.
.PP
When you delete a command from the exporting namespace like this:
+.PP
.CS
rename Blt::graph ""
.CE
+.PP
the command is automatically removed from all namespaces that import it.
.SH "EXPORTING COMMANDS"
You can export commands from a namespace like this:
+.PP
.CS
\fBnamespace eval\fR Counter {
- \fBnamespace export\fR bump reset
- variable Num 0
- variable Max 100
+ \fBnamespace export\fR bump reset
+ variable Num 0
+ variable Max 100
- proc bump {{by 1}} {
- variable Num
- incr Num $by
- Check
- return $Num
- }
- proc reset {} {
- variable Num
- set Num 0
- }
- proc Check {} {
- variable Num
- variable Max
- if {$Num > $Max} {
- error "too high!"
- }
- }
+ proc bump {{by 1}} {
+ variable Num
+ incr Num $by
+ Check
+ return $Num
+ }
+ proc reset {} {
+ variable Num
+ set Num 0
+ }
+ proc Check {} {
+ variable Num
+ variable Max
+ if {$Num > $Max} {
+ error "too high!"
+ }
+ }
}
.CE
+.PP
The procedures \fBbump\fR and \fBreset\fR are exported,
so they are included when you import from the \fBCounter\fR namespace,
like this:
+.PP
.CS
\fBnamespace import\fR Counter::*
.CE
+.PP
However, the \fBCheck\fR procedure is not exported,
so it is ignored by the import operation.
.PP
@@ -590,31 +691,34 @@ may be imported by other namespaces.
If a \fBnamespace import\fR command specifies a command
that is not exported, the command is not imported.
.SH "SCOPED SCRIPTS"
+.PP
The \fBnamespace code\fR command is the means by which a script may be
packaged for evaluation in a namespace other than the one in which it
was created. It is used most often to create event handlers, Tk bindings,
and traces for evaluation in the global context. For instance, the following
-code indicates how to direct a variable trace callback into the current
+code indicates how to direct a variable \fBtrace\fR callback into the current
namespace:
+.PP
.CS
\fBnamespace eval\fR a {
- variable b
- proc theTraceCallback { n1 n2 op } {
- upvar 1 $n1 var
- puts "the value of $n1 has changed to $var"
- return
- }
- trace variable b w [\fBnamespace code\fR theTraceCallback]
+ variable b
+ proc theTraceCallback { n1 n2 op } {
+ upvar 1 $n1 var
+ puts "the value of $n1 has changed to $var"
+ return
+ }
+ trace add variable b write [\fBnamespace code\fR theTraceCallback]
}
set a::b c
.CE
+.PP
When executed, it prints the message:
+.PP
.CS
the value of a::b has changed to c
.CE
.SH ENSEMBLES
.PP
-.VS 8.5
The \fBnamespace ensemble\fR is used to create and manipulate ensemble
commands, which are commands formed by grouping subcommands together.
The commands typically come from the current namespace when the
@@ -628,6 +732,7 @@ namespace is maintained however the ensemble is renamed.
Three subcommands of the \fBnamespace ensemble\fR command are defined:
.TP
\fBnamespace ensemble create\fR ?\fIoption value ...\fR?
+.
Creates a new ensemble command linked to the current namespace,
returning the fully qualified name of the command created. The
arguments to \fBnamespace ensemble create\fR allow the configuration
@@ -638,12 +743,14 @@ namespace. See the section \fBENSEMBLE OPTIONS\fR below for a full
list of options supported and their effects.
.TP
\fBnamespace ensemble configure \fIcommand\fR ?\fIoption\fR? ?\fIvalue ...\fR?
+.
Retrieves the value of an option associated with the ensemble command
named \fIcommand\fR, or updates some options associated with that
ensemble command. See the section \fBENSEMBLE OPTIONS\fR below for a
full list of options supported and their effects.
.TP
\fBnamespace ensemble exists\fR \fIcommand\fR
+.
Returns a boolean value that describes whether the command
\fIcommand\fR exists and is an ensemble command. This command only
ever returns an error if the number of arguments to the command is
@@ -666,25 +773,39 @@ create\fR and \fBnamespace ensemble configure\fR commands, control how
an ensemble command behaves:
.TP
\fB\-map\fR
+.
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
will be exactly those words that have mappings in the dictionary.
.TP
+\fB\-parameters\fR
+.VS 8.6
+This option gives a list of named arguments (the names being used during
+generation of error messages) that are passed by the caller of the ensemble
+between the name of the ensemble and the subcommand argument. By default, it
+is the empty list.
+.VE 8.6
+.TP
\fB\-prefixes\fR
+.
This option (which is enabled by default) controls whether the
ensemble command recognizes unambiguous prefixes of its subcommands.
When turned off, the ensemble command requires exact matching of
subcommand names.
.TP
\fB\-subcommands\fR
+.
When non-empty, this option lists exactly what subcommands are in the
-ensemble. The mapping for each of those commands will either whatever
+ensemble. The mapping for each of those commands will be either whatever
is defined in the \fB\-map\fR option, or to the command with the same
name in the namespace linked to the ensemble. If this option is
empty, the subcommands of the namespace will either be the keys of the
@@ -693,6 +814,7 @@ of the linked namespace at the time of the invocation of the ensemble
command.
.TP
\fB\-unknown\fR
+.
When non-empty, this option provides a partial command (to which all
the words that are arguments to the ensemble command, including the
fully-qualified name of the ensemble, are appended) to handle the case
@@ -706,6 +828,7 @@ The following extra option is allowed by \fBnamespace ensemble
create\fR:
.TP
\fB\-command\fR
+.
This write-only option allows the name of the ensemble created by
\fBnamespace ensemble create\fR to be anything in any existing
namespace. The default value for this option is the fully-qualified
@@ -716,6 +839,7 @@ The following extra option is allowed by \fBnamespace ensemble
configure\fR:
.TP
\fB\-namespace\fR
+.
This read-only option allows the retrieval of the fully-qualified name
of the namespace which the ensemble was created within.
.SS "UNKNOWN HANDLER BEHAVIOUR"
@@ -755,7 +879,7 @@ supply all namespace qualifiers if the implementing subcommand is not
in the namespace of the caller of the ensemble command. Also note that
when ensemble commands are chained (e.g. if you make one of the
commands that implement an ensemble subcommand into an ensemble, in a
-manner similar to the text widget's tag and mark subcommands) then the
+manner similar to the \fBtext\fR widget's tag and mark subcommands) then the
rewrite happens in the context of the caller of the outermost
ensemble. That is to say that ensembles do not in themselves place any
namespace contexts on the Tcl call stack.
@@ -767,29 +891,30 @@ error message from \fBTcl_GetIndexFromObj\fR). This is the error that
will be thrown when the subcommand is still not recognized during
reparsing. It is also an error for an \fB\-unknown\fR handler to
delete its namespace.
-.VE 8.5
.SH EXAMPLES
Create a namespace containing a variable and an exported command:
+.PP
.CS
\fBnamespace eval\fR foo {
- variable bar 0
- proc grill {} {
- variable bar
- puts "called [incr bar] times"
- }
- \fBnamespace export\fR grill
+ variable bar 0
+ proc grill {} {
+ variable bar
+ puts "called [incr bar] times"
+ }
+ \fBnamespace export\fR grill
}
.CE
.PP
Call the command defined in the previous example in various ways.
+.PP
.CS
# Direct call
::foo::grill
# Use the command resolution path to find the name
\fBnamespace eval\fR boo {
- \fBnamespace path\fR ::foo
- grill
+ \fBnamespace path\fR ::foo
+ grill
}
# Import into current namespace, then call local alias
@@ -799,20 +924,46 @@ grill
# Create two ensembles, one with the default name and one with a
# specified name. Then call through the ensembles.
\fBnamespace eval\fR foo {
- \fBnamespace ensemble\fR create
- \fBnamespace ensemble\fR create -command ::foobar
+ \fBnamespace ensemble\fR create
+ \fBnamespace ensemble\fR create -command ::foobar
}
foo grill
foobar grill
.CE
.PP
Look up where the command imported in the previous example came from:
+.PP
.CS
puts "grill came from [\fBnamespace origin\fR grill]"
.CE
+.PP
+Remove all imported commands from the current namespace:
+.PP
+.CS
+namespace forget {*}[namespace import]
+.CE
+.PP
+.VS 8.6
+Create an ensemble for simple working with numbers, using the
+\fB\-parameters\fR option to allow the operator to be put between the first
+and second arguments.
+.PP
+.CS
+\fBnamespace eval\fR do {
+ \fBnamespace export\fR *
+ \fBnamespace ensemble\fR create -parameters x
+ proc plus {x y} {expr { $x + $y }}
+ proc minus {x y} {expr { $x - $y }}
+}
+# In use, the ensemble works like this:
+puts [do 1 plus [do 9 minus 7]]
+.CE
+.VE 8.6
.SH "SEE ALSO"
-interp(n), variable(n)
-
+interp(n), upvar(n), variable(n)
.SH KEYWORDS
command, ensemble, exported, internal, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/next.n b/doc/next.n
new file mode 100644
index 0000000..7dacac2
--- /dev/null
+++ b/doc/next.n
@@ -0,0 +1,206 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH next n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+next, nextto \- invoke superclass method implementations
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBnext\fR ?\fIarg ...\fR?
+\fBnextto\fI class\fR ?\fIarg ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBnext\fR command is used to call implementations of a method by a class,
+superclass or mixin that are overridden by the current method. It can only be
+used from within a method. It is also used within filters to indicate the
+point where a filter calls the actual implementation (the filter may decide to
+not go along the chain, and may process the results of going along the chain
+of methods as it chooses). The result of the \fBnext\fR command is the result
+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:
+.IP [1]
+The structure of the object, its class, superclasses, filters, and mixins, are
+examined to build a \fImethod chain\fR, which contains a list of method
+implementations to invoke.
+.IP [2]
+The first method implementation on the chain is invoked.
+.IP [3]
+If that method implementation invokes the \fBnext\fR command, the next method
+implementation is invoked (with its arguments being those that were passed to
+\fBnext\fR).
+.IP [4]
+The result from the overall method call is the result from the outermost
+method implementation; inner method implementations return their results
+through \fBnext\fR.
+.IP [5]
+The method chain is cached for future use.
+.SS "METHOD SEARCH ORDER"
+.PP
+When constructing the method chain, method implementations are searched for in
+the following order:
+.IP [1]
+In the classes mixed into the object, in class traversal order. The list of
+mixins is checked in natural order.
+.IP [2]
+In the classes mixed into the classes of the object, with sources of mixing in
+being searched in class traversal order. Within each class, the list of mixins
+is processed in natural order.
+.IP [3]
+In the object itself.
+.IP [4]
+In the object's class.
+.IP [5]
+In the superclasses of the class, following each superclass in a depth-first
+fashion in the natural order of the superclass list.
+.PP
+Any particular method implementation always comes as \fIlate\fR in the
+resulting list of implementations as possible; this means that if some class,
+A, is both mixed into a class, B, and is also a superclass of B, the instances
+of B will always treat A as a superclass from the perspective of inheritance.
+This is true even when the multiple inheritance is processed indirectly.
+.SS FILTERS
+.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 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
+a filter and once as a normal method.
+.PP
+Each filter should decide for itself whether to permit the execution to go
+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 invocation of the \fBunknown\fR
+method because of a failure to locate a method implementation, or when
+invoking either constructors or destructors.
+.SH EXAMPLES
+.PP
+This example demonstrates how to use the \fBnext\fR command to call the
+(super)class's implementation of a method. The script:
+.PP
+.CS
+oo::class create theSuperclass {
+ method example {args} {
+ puts "in the superclass, args = $args"
+ }
+}
+oo::class create theSubclass {
+ superclass theSuperclass
+ method example {args} {
+ puts "before chaining from subclass, args = $args"
+ \fBnext\fR a {*}$args b
+ \fBnext\fR pureSynthesis
+ puts "after chaining from subclass"
+ }
+}
+theSubclass create obj
+oo::define obj method example args {
+ puts "per-object method, args = $args"
+ \fBnext\fR x {*}$args y
+ \fBnext\fR
+}
+obj example 1 2 3
+.CE
+.PP
+prints the following:
+.PP
+.CS
+per-object method, args = 1 2 3
+before chaining from subclass, args = x 1 2 3 y
+in the superclass, args = a x 1 2 3 y b
+in the superclass, args = pureSynthesis
+after chaining from subclass
+before chaining from subclass, args =
+in the superclass, args = a b
+in the superclass, args = pureSynthesis
+after chaining from subclass
+.CE
+.PP
+This example demonstrates how to build a simple cache class that applies
+memoization to all the method calls of the objects it is mixed into, and shows
+how it can make a difference to computation times:
+.PP
+.CS
+oo::class create cache {
+ filter Memoize
+ method Memoize args {
+ \fI# Do not filter the core method implementations\fR
+ if {[lindex [self target] 0] eq "::oo::object"} {
+ return [\fBnext\fR {*}$args]
+ }
+
+ \fI# Check if the value is already in the cache\fR
+ my variable ValueCache
+ set key [self target],$args
+ if {[info exist ValueCache($key)]} {
+ return $ValueCache($key)
+ }
+
+ \fI# Compute value, insert into cache, and return it\fR
+ return [set ValueCache($key) [\fBnext\fR {*}$args]]
+ }
+ method flushCache {} {
+ my variable ValueCache
+ unset ValueCache
+ \fI# Skip the caching\fR
+ return -level 2 ""
+ }
+}
+
+oo::object create demo
+oo::define demo {
+ mixin cache
+ method compute {a b c} {
+ after 3000 \fI;# Simulate deep thought\fR
+ return [expr {$a + $b * $c}]
+ }
+ method compute2 {a b c} {
+ after 3000 \fI;# Simulate deep thought\fR
+ return [expr {$a * $b + $c}]
+ }
+}
+
+puts [demo compute 1 2 3] \fI\(-> prints "7" after delay\fR
+puts [demo compute2 4 5 6] \fI\(-> prints "26" after delay\fR
+puts [demo compute 1 2 3] \fI\(-> prints "7" instantly\fR
+puts [demo compute2 4 5 6] \fI\(-> prints "26" instantly\fR
+puts [demo compute 4 5 6] \fI\(-> prints "34" after delay\fR
+puts [demo compute 4 5 6] \fI\(-> prints "34" instantly\fR
+puts [demo compute 1 2 3] \fI\(-> prints "7" instantly\fR
+demo flushCache
+puts [demo compute 1 2 3] \fI\(-> prints "7" after delay\fR
+.CE
+.SH "SEE ALSO"
+oo::class(n), oo::define(n), oo::object(n), self(n)
+.SH KEYWORDS
+call, method, method chain
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/object.n b/doc/object.n
new file mode 100644
index 0000000..df657a9
--- /dev/null
+++ b/doc/object.n
@@ -0,0 +1,128 @@
+'\"
+'\" Copyright (c) 2007-2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH object n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::object \- root class of the class hierarchy
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::object\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBoo::object\fR class is the root class of the object hierarchy; every
+object is an instance of this class. Since classes are themselves objects,
+they are instances of this class too. Objects are always referred to by their
+name, and may be \fBrename\fRd while maintaining their identity.
+.PP
+Instances of objects may be made with either the \fBcreate\fR or \fBnew\fR
+methods of the \fBoo::object\fR object itself, or by invoking those methods on
+any of the subclass objects; see \fBoo::class\fR for more details. The
+configuration of individual objects (i.e., instance-specific methods, mixed-in
+classes, etc.) may be controlled with the \fBoo::objdefine\fR command.
+.PP
+Each object has a unique namespace associated with it, the instance namespace.
+This namespace holds all the instance variables of the object, and will be the
+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 invocation which persists
+across renamings of the object.
+.SS CONSTRUCTOR
+The \fBoo::object\fR class does not define an explicit constructor.
+.SS DESTRUCTOR
+The \fBoo::object\fR class does not define an explicit destructor.
+.SS "EXPORTED METHODS"
+The \fBoo::object\fR class supports the following exported methods:
+.TP
+\fIobj \fBdestroy\fR
+.
+This method destroys the object, \fIobj\fR, that it is invoked upon, invoking
+any destructors on the object's class in the process. It is equivalent to
+using \fBrename\fR to delete the object command. The result of this method is
+always the empty string.
+.SS "NON-EXPORTED METHODS"
+.PP
+The \fBoo::object\fR class supports the following non-exported methods:
+.TP
+\fIobj \fBeval\fR ?\fIarg ...\fR?
+.
+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?
+.
+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 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?
+.
+This method arranges for each variable called \fIvarName\fR to be linked from
+the object \fIobj\fR's unique namespace into the caller's context. Thus, if it
+is invoked from inside a procedure then the namespace variable in the object
+is linked to the local variable in the procedure. Each \fIvarName\fR argument
+must not have any namespace separators in it. The result is the empty string.
+.TP
+\fIobj \fBvarname \fIvarName\fR
+.
+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.
+.PP
+.CS
+set obj [\fBoo::object\fR new]
+$obj foo \fI\(-> error "unknown method foo"\fR
+oo::objdefine $obj method foo {} {
+ my \fBvariable\fR count
+ puts "bar[incr count]"
+}
+$obj foo \fI\(-> prints "bar1"\fR
+$obj foo \fI\(-> prints "bar2"\fR
+$obj variable count \fI\(-> error "unknown method variable"\fR
+$obj \fBdestroy\fR
+$obj foo \fI\(-> error "unknown command obj"\fR
+.CE
+.SH "SEE ALSO"
+my(n), oo::class(n)
+.SH KEYWORDS
+base class, class, object, root class
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/open.n b/doc/open.n
index 87f0dd6..0b1b83f 100644
--- a/doc/open.n
+++ b/doc/open.n
@@ -5,10 +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: open.n,v 1.25 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH open n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -21,7 +19,6 @@ open \- Open a file-based or command pipeline channel
.br
\fBopen \fIfileName access permissions\fR
.BE
-
.SH DESCRIPTION
.PP
This command opens a file, serial port, or command pipeline and returns a
@@ -37,73 +34,84 @@ The \fIaccess\fR argument, if present, indicates the way in which the file
In the first form \fIaccess\fR may have any of the following values:
.TP 15
\fBr\fR
+.
Open the file for reading only; the file must already exist. This is the
default value if \fIaccess\fR is not specified.
.TP 15
\fBr+\fR
+.
Open the file for both reading and writing; the file must
already exist.
.TP 15
\fBw\fR
-Open the file for writing only. Truncate it if it exists. If it doesn't
+.
+Open the file for writing only. Truncate it if it exists. If it does not
exist, create a new file.
.TP 15
\fBw+\fR
+.
Open the file for reading and writing. Truncate it if it exists.
-If it doesn't exist, create a new file.
+If it does not exist, create a new file.
.TP 15
\fBa\fR
-Open the file for writing only. If the file doesn't exist,
+.
+Open the file for writing only. If the file does not exist,
create a new empty file.
-Set the initial access position to the end of the file.
+Set the file pointer to the end of the file prior to each write.
.TP 15
\fBa+\fR
-Open the file for reading and writing. If the file doesn't exist,
+.
+Open the file for reading and writing. If the file does not exist,
create a new empty file.
Set the initial access position to the end of the file.
-.VS 8.5
.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.
-.VE 8.5
.PP
In the second form, \fIaccess\fR consists of a list of any of the
following flags, all of which have the standard POSIX meanings.
One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
.TP 15
\fBRDONLY\fR
+.
Open the file for reading only.
.TP 15
\fBWRONLY\fR
+.
Open the file for writing only.
.TP 15
\fBRDWR\fR
+.
Open the file for both reading and writing.
.TP 15
\fBAPPEND\fR
+.
Set the file pointer to the end of the file prior to each write.
.TP 15
-.VS 8.5
\fBBINARY\fR
-Configure the opened channed with the \fB-translation binary\fR option.
-.VE 8.5
+.
+Configure the opened channel with the \fB\-translation binary\fR option.
.TP 15
\fBCREAT\fR
-Create the file if it doesn't already exist (without this flag it
+.
+Create the file if it does not already exist (without this flag it
is an error for the file not to exist).
.TP 15
\fBEXCL\fR
+.
If \fBCREAT\fR is also specified, an error is returned if the
file already exists.
.TP 15
\fBNOCTTY\fR
+.
If the file is a terminal device, this flag prevents the file from
becoming the controlling terminal of the process.
.TP 15
\fBNONBLOCK\fR
+.
Prevents the process from blocking while opening the file, and
possibly in subsequent I/O operations. The exact behavior of
this flag is system- and device-dependent; its use is discouraged
@@ -113,26 +121,30 @@ For details refer to your system documentation on the \fBopen\fR system
call's \fBO_NONBLOCK\fR flag.
.TP 15
\fBTRUNC\fR
+.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
-
.SH "COMMAND PIPELINES"
.PP
-If the first character of \fIfileName\fR is ``|'' then the
+If the first character of \fIfileName\fR is
+.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
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
@@ -158,58 +170,72 @@ The \fBfconfigure\fR command can be used to query and set additional
configuration options specific to serial ports (where supported):
.TP
\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
+.
This option is a set of 4 comma-separated values: the baud rate, parity,
number of data bits, and number of stop bits for this serial port. The
\fIbaud\fR rate is a simple integer that specifies the connection speed.
\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,
-\fBm\fR, \fBs\fR; respectively signifying the parity options of ``none'',
-``odd'', ``even'', ``mark'', or ``space''. \fIData\fR is the number of
+\fBm\fR, \fBs\fR; respectively signifying the parity options of
+.QW none ,
+.QW odd ,
+.QW even ,
+.QW mark ,
+or
+.QW space .
+\fIData\fR is the number of
data bits and should be an integer from 5 to 8, while \fIstop\fR is the
number of stop bits and should be the integer 1 or 2.
.TP
\fB\-handshake\fR \fItype\fR
+.
(Windows and Unix). This option is used to setup automatic handshake
control. Note that not all handshake types maybe supported by your operating
system. The \fItype\fR parameter is case-independent.
-.sp
+.RS
+.PP
If \fItype\fR is \fBnone\fR then any handshake is switched off.
\fBrtscts\fR activates hardware handshake. Hardware handshake signals
are described below.
For software handshake \fBxonxoff\fR the handshake characters can be redefined
-with \fB-xchar\fR.
+with \fB\-xchar\fR.
An additional hardware handshake \fBdtrdsr\fR is available only under Windows.
There is no default handshake configuration, the initial value depends
on your operating system settings.
-The \fB-handshake\fR option cannot be queried.
+The \fB\-handshake\fR option cannot be queried.
+.RE
.TP
\fB\-queue\fR
-(Windows and Unix). The \fB-queue\fR option can only be queried.
+.
+(Windows and Unix). The \fB\-queue\fR option can only be queried.
It returns a list of two integers representing the current number
of bytes in the input and output queue respectively.
.TP
\fB\-timeout\fR \fImsec\fR
+.
(Windows and Unix). This option is used to set the timeout for blocking
read operations. It specifies the maximum interval between the
reception of two bytes in milliseconds.
For Unix systems the granularity is 100 milliseconds.
-The \fB-timeout\fR option does not affect write operations or
+The \fB\-timeout\fR option does not affect write operations or
nonblocking reads.
This option cannot be queried.
.TP
\fB\-ttycontrol\fR \fI{signal boolean signal boolean ...}\fR
+.
(Windows and Unix). This option is used to setup the handshake
output lines (see below) permanently or to send a BREAK over the serial line.
The \fIsignal\fR names are case-independent.
\fB{RTS 1 DTR 0}\fR sets the RTS output to high and the DTR output to low.
The BREAK condition (see below) is enabled and disabled with \fB{BREAK 1}\fR and
\fB{BREAK 0}\fR respectively.
-It's not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal
+It is not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal
with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR).
The result is unpredictable.
-The \fB-ttycontrol\fR option cannot be queried.
+The \fB\-ttycontrol\fR option cannot be queried.
.TP
\fB\-ttystatus\fR
-(Windows and Unix). The \fB-ttystatus\fR option can only be
+.
+(Windows and Unix). The \fB\-ttystatus\fR option can only be
queried. It returns the current modem status and handshake input signals
(see below).
The result is a list of signal,value pairs with a fixed order,
@@ -217,12 +243,14 @@ e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR.
The \fIsignal\fR names are returned upper case.
.TP
\fB\-xchar\fR \fI{xonChar xoffChar}\fR
+.
(Windows and Unix). This option is used to query or change the software
handshake characters. Normally the operating system default should be
DC1 (0x11) and DC3 (0x13) representing the ASCII standard
XON and XOFF characters.
.TP
\fB\-pollinterval\fR \fImsec\fR
+.
(Windows only). This option is used to set the maximum time between
polling for fileevents.
This affects the time interval between checking for events throughout the Tcl
@@ -233,6 +261,7 @@ you want to poll the serial port more or less often than 10 msec
\fB\-sysbuffer\fR \fIinSize\fR
.TP
\fB\-sysbuffer\fR \fI{inSize outSize}\fR
+.
(Windows only). This option is used to change the size of Windows
system buffers for a serial channel. Especially at higher communication
rates the default input buffer size of 4096 bytes can overrun
@@ -240,12 +269,12 @@ for latent systems. The first form specifies the input buffer size,
in the second form both input and output buffers are defined.
.TP
\fB\-lasterror\fR
+.
(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
RS-232 is the most commonly used standard electrical interface for serial
@@ -256,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
-\fBData Carrier Detect:\fR This line becomes active when a modem detects
-a "Carrier" signal.
-.IP \fBRI(input)\fR
+.IP \fBDCD\fR(input)
+\fBData Carrier Detect:\fR This line becomes active when a modem detects a
+.QW Carrier
+signal.
+.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
@@ -287,49 +316,53 @@ milliseconds. Normally a receive or transmit data signal stays at the mark
(on=1) voltage until the next character is transferred. A BREAK is sometimes
used to reset the communications line or change the operating mode of
communications hardware.
-
.SH "ERROR CODES (Windows only)"
.PP
A lot of different errors may occur during serial read operations or during
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's why a reliable software should always
+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
+.
Windows output buffer overrun. Complement to RXOVER. This error should
practically not happen, because Tcl cares about the output buffer status.
.TP 10
\fBOVERRUN\fR
+.
UART buffer overrun (hardware) with data lost.
The data comes faster than the system driver receives it.
Check your advanced serial port settings to enable the FIFO (16550) buffer
and/or setup a lower(1) interrupt threshold value.
.TP 10
\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
+.
A BREAK condition has been detected by your UART (see above).
-
.SH "PORTABILITY ISSUES"
.TP
\fBWindows \fR(all versions)
+.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4.
This notation only works for serial ports from 1 to 9, if the system
@@ -340,6 +373,7 @@ where X is any number that corresponds to a serial port; please note
that this method is considerably slower on Windows 95 and Windows 98.
.TP
\fBWindows NT\fR
+.
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading, some
@@ -355,13 +389,15 @@ standard input or output, but is redirected from or to a file, then the
above problems do not occur.
.TP
\fBWindows 95\fR
+.
A command pipeline that executes a 16-bit DOS application cannot be opened
for both reading and writing, since 16-bit DOS applications that receive
standard input from a pipe and send standard output to a pipe run
synchronously. Command pipelines that do not execute 16-bit DOS
applications run asynchronously and can be opened for both reading and
writing.
-.sp
+.RS
+.PP
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading from
@@ -374,7 +410,7 @@ console at the same time. If the command pipeline is started from a script,
so that Tcl is not accessing the console, or if the command pipeline does
not use standard input or output, but is redirected from or to a file, then
the above problems do not occur.
-.sp
+.PP
Whether or not Tcl is running interactively, if a command pipeline is opened
for reading from a 16-bit DOS application, the call to \fBopen\fR will not
return until end-of-file has been received from the command pipeline's
@@ -382,14 +418,17 @@ standard output. If a command pipeline is opened for writing to a 16-bit DOS
application, no data will be sent to the command pipeline's standard output
until the pipe is actually closed. This problem occurs because 16-bit DOS
applications are run synchronously, as described above.
+.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
+.
Valid values for \fIfileName\fR to open a serial port are generally of the
form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name
of any pseudo-file that maps to a serial port may be used.
Advanced configuration options are only supported for serial ports
when Tcl is built to use the POSIX serial interface.
-.sp
+.RS
+.PP
When running Tcl interactively, there may be some strange interactions
between the console, if one is present, and a command pipeline that uses
standard input. If a command pipeline is opened for reading, some
@@ -399,12 +438,15 @@ both Tcl and the child application are competing for the console at the
same time. If the command pipeline is started from a script, so that Tcl is
not accessing the console, or if the command pipeline does not use standard
input, but is redirected from a file, then the above problem does not occur.
-.LP
-See the PORTABILITY ISSUES section of the \fBexec\fR command for additional
-information not specific to command pipelines about executing
+.RE
+.PP
+See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
+additional information not specific to command pipelines about executing
applications on the various platforms
.SH "EXAMPLE"
+.PP
Open a command pipeline and catch any errors:
+.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
@@ -412,11 +454,12 @@ if {[catch {close $fl} err]} {
puts "ls command failed: $err"
}
.CE
-
.SH "SEE ALSO"
file(n), close(n), filename(n), fconfigure(n), gets(n), read(n),
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 1ce0b79..07a3d47 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -4,29 +4,29 @@
'\" 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.9 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH package n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
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 \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage present \fIpackage \fR?\fIrequirement...\fR?
+\fBpackage present \-exact \fIpackage version\fR
\fBpackage provide \fIpackage \fR?\fIversion\fR?
-\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage require \fIpackage \fR?\fIrequirement...\fR?
+\fBpackage require \-exact \fIpackage version\fR
\fBpackage unknown \fR?\fIcommand\fR?
\fBpackage vcompare \fIversion1 version2\fR
\fBpackage versions \fIpackage\fR
-\fBpackage vsatisfies \fIversion1 version2\fR
+\fBpackage vsatisfies \fIversion requirement...\fR
+\fBpackage prefer \fR?\fBlatest\fR|\fBstable\fR?
.fi
.BE
-
.SH DESCRIPTION
.PP
This command keeps a simple database of the packages available for
@@ -43,12 +43,14 @@ 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
\fBpackage provide\fR.
.TP
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
+.
This command typically appears only in system configuration
scripts to set up the package database.
It indicates that a particular version of
@@ -70,17 +72,20 @@ or an empty string if no \fBpackage ifneeded\fR command has
been invoked for this \fIpackage\fR and \fIversion\fR.
.TP
\fBpackage names\fR
+.
Returns a list of the names of all packages in the
interpreter for which a version has been provided (via
\fBpackage provide\fR) or for which a \fBpackage ifneeded\fR
script is available.
The order of elements in the list is arbitrary.
.TP
-\fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage present\fR ?\fB\-exact\fR? \fIpackage\fR ?\fIrequirement...\fR?
+.
This command is equivalent to \fBpackage require\fR except that it
does not try and load the package if it is not already loaded.
.TP
\fBpackage provide \fIpackage \fR?\fIversion\fR?
+.
This command is invoked to indicate that version \fIversion\fR
of package \fIpackage\fR is now present in the interpreter.
It is typically invoked once as part of an \fBifneeded\fR script,
@@ -92,25 +97,35 @@ returns the version number that is currently provided, or an
empty string if no \fBpackage provide\fR command has been
invoked for \fIpackage\fR in this interpreter.
.TP
-\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage require \fR\fIpackage \fR?\fIrequirement...\fR?
+.
This command is typically invoked by Tcl code that wishes to use
a particular version of a particular package. The arguments
indicate which package is wanted, and the command ensures that
a suitable version of the package is loaded into the interpreter.
If the command succeeds, it returns the version number that is
loaded; otherwise it generates an error.
-If both the \fB\-exact\fR
-switch and the \fIversion\fR argument are specified then only the
-given version is acceptable. If \fB\-exact\fR is omitted but
-\fIversion\fR is specified, then versions later than \fIversion\fR
-are also acceptable as long as they have the same major version
-number as \fIversion\fR.
-If both \fB\-exact\fR and \fIversion\fR are omitted then any
-version whatsoever is acceptable.
+.RS
+.PP
+A suitable version of the package is any version which satisfies at
+least one of the requirements, per the rules of \fBpackage
+vsatisfies\fR. If multiple versions are suitable the implementation
+with the highest version is chosen. This last part is additionally
+influenced by the selection mode set with \fBpackage prefer\fR.
+.PP
+In the
+.QW stable
+selection mode the command will select the highest
+stable version satisfying the requirements, if any. If no stable
+version satisfies the requirements, the highest unstable version
+satisfying the requirements will be selected. In the
+.QW latest
+selection mode the command will accept the highest version satisfying
+all the requirements, regardless of its stableness.
+.PP
If a version of \fIpackage\fR has already been provided (by invoking
the \fBpackage provide\fR command), then its version number must
-satisfy the criteria given by \fB\-exact\fR and \fIversion\fR and
-the command returns immediately.
+satisfy the \fIrequirement\fRs and the command returns immediately.
Otherwise, the command searches the database of information provided by
previous \fBpackage ifneeded\fR commands to see if an acceptable
version of the package is available.
@@ -126,20 +141,30 @@ it completes, Tcl checks again to see if the package is now provided
or if there is a \fBpackage ifneeded\fR script for it.
If all of these steps fail to provide an acceptable version of the
package, then the command returns an error.
+.RE
+.TP
+\fBpackage require \-exact \fIpackage version\fR
+.
+This form of the command is used when only the given \fIversion\fR
+of \fIpackage\fR is acceptable to the caller. This command is
+equivalent to \fBpackage require \fIpackage version\fR-\fIversion\fR.
.TP
\fBpackage unknown \fR?\fIcommand\fR?
-This command supplies a ``last resort'' command to invoke during
+.
+This command supplies a
+.QW "last resort"
+command to invoke during
\fBpackage require\fR if no suitable version of a package can be found
in the \fBpackage ifneeded\fR database.
If the \fIcommand\fR argument is supplied, it contains the first part
of a command; when the command is invoked during a \fBpackage require\fR
-command, Tcl appends two additional arguments giving the desired package
-name and version.
+command, Tcl appends one or more additional arguments giving the desired
+package name and requirements.
For example, if \fIcommand\fR is \fBfoo bar\fR and later the command
\fBpackage require test 2.4\fR is invoked, then Tcl will execute
the command \fBfoo bar test 2.4\fR to load the package.
-If no version number is supplied to the \fBpackage require\fR command,
-then the version argument for the invoked command will be an empty string.
+If no requirements are supplied to the \fBpackage require\fR command,
+then only the name will be added to invoked command.
If the \fBpackage unknown\fR command is invoked without a \fIcommand\fR
argument, then the current \fBpackage unknown\fR script is returned,
or an empty string if there is none.
@@ -147,20 +172,122 @@ If \fIcommand\fR is specified as an empty string, then the current
\fBpackage unknown\fR script is removed, if there is one.
.TP
\fBpackage vcompare \fIversion1 version2\fR
+.
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
+.
Returns a list of all the version numbers of \fIpackage\fR
for which information has been provided by \fBpackage ifneeded\fR
commands.
.TP
-\fBpackage vsatisfies \fIversion1 version2\fR
-Returns 1 if scripts written for \fIversion2\fR will work unchanged
-with \fIversion1\fR (i.e. \fIversion1\fR is equal to or greater
-than \fIversion2\fR and they both have the same major version
-number), 0 otherwise.
+\fBpackage vsatisfies \fIversion requirement...\fR
+.
+Returns 1 if the \fIversion\fR satisfies at least one of the given
+requirements, and 0 otherwise. Each \fIrequirement\fR is allowed to
+have any of the forms:
+.RS
+.TP
+min
+.
+This form is called
+.QW min-bounded .
+.TP
+min-
+.
+This form is called
+.QW min-unbound .
+.TP
+min-max
+.
+This form is called
+.QW bounded .
+.RE
+.RS
+.PP
+where
+.QW min
+and
+.QW max
+are valid version numbers. The legacy syntax is
+a special case of the extended syntax, keeping backward
+compatibility. Regarding satisfaction the rules are:
+.RE
+.RS
+.IP [1]
+The \fIversion\fR has to pass at least one of the listed
+\fIrequirement\fRs to be satisfactory.
+.IP [2]
+A version satisfies a
+.QW bounded
+requirement when
+.RS
+.IP [a]
+For \fImin\fR equal to the \fImax\fR if, and only if the \fIversion\fR
+is equal to the \fImin\fR.
+.IP [b]
+Otherwise if, and only if the \fIversion\fR is greater than or equal
+to the \fImin\fR, and less than the \fImax\fR, where both \fImin\fR
+and \fImax\fR have been padded internally with
+.QW a0 .
+Note that while the comparison to \fImin\fR is inclusive, the
+comparison to \fImax\fR is exclusive.
+.RE
+.IP [3]
+A
+.QW min-bounded
+requirement is a
+.QW bounded
+requirement in disguise,
+with the \fImax\fR part implicitly specified as the next higher major
+version number of the \fImin\fR part. A version satisfies it per the
+rules above.
+.IP [4]
+A \fIversion\fR satisfies a
+.QW min-unbound
+requirement if, and only if it is greater than or equal to the
+\fImin\fR, where the \fImin\fR has been padded internally with
+.QW a0 .
+There is no constraint to a maximum.
+.RE
+.TP
+\fBpackage prefer \fR?\fBlatest\fR|\fBstable\fR?
+With no arguments, the commands returns either
+.QW latest
+or
+.QW stable ,
+whichever describes the current mode of selection logic used by
+\fBpackage require\fR.
+.RS
+.PP
+When passed the argument
+.QW latest ,
+it sets the selection logic mode to
+.QW latest .
+.PP
+When passed the argument
+.QW stable ,
+if the mode is already
+.QW stable ,
+that value is kept. If the mode is already
+.QW latest ,
+then the attempt to set it back to
+.QW stable
+is ineffective and the mode value remains
+.QW latest .
+.PP
+When passed any other value as an argument, raise an invalid argument
+error.
+.PP
+When an interpreter is created, its initial selection mode value is set to
+.QW stable
+unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
+is set. If that environment variable is defined (with any value) then
+the initial (and permanent) selection mode value is set to
+.QW latest .
+.RE
.SH "VERSION NUMBERS"
.PP
Version numbers consist of one or more decimal numbers separated
@@ -172,6 +299,30 @@ For example, version 2.1 is later than 1.3 and version
3.4.6 is later than 3.3.5.
Missing fields are equivalent to zeroes: version 1.3 is the
same as version 1.3.0 and 1.3.0.0, so it is earlier than 1.3.1 or 1.3.0.2.
+In addition, the letters
+.QW a
+(alpha) and/or
+.QW b
+(beta) may appear
+exactly once to replace a dot for separation. These letters
+semantically add a negative specifier into the version, where
+.QW a
+is \-2, and
+.QW b
+is \-1. Each may be specified only once, and
+.QW a
+or
+.QW b
+are mutually exclusive in a specifier. Thus 1.3a1 becomes (semantically)
+1.3.\-2.1, 1.3b1 is 1.3.\-1.1. Negative numbers are not directly allowed
+in version specifiers.
+A version number not containing the letters
+.QW a
+or
+.QW b
+as specified
+above is called a \fBstable\fR version, whereas presence of the letters
+causes the version to be called is \fBunstable\fR.
A later version number is assumed to be upwards compatible with
an earlier version number as long as both versions have the same
major version number.
@@ -185,12 +336,14 @@ to work unmodified with either version 1.7.3 or version 3.1.
The recommended way to use packages in Tcl is to invoke \fBpackage require\fR
and \fBpackage provide\fR commands in scripts, and use the procedure
\fBpkg_mkIndex\fR to create package index files.
-Once you've done this, packages will be loaded automatically
+Once you have done this, packages will be loaded automatically
in response to \fBpackage require\fR commands.
See the documentation for \fBpkg_mkIndex\fR for details.
.SH EXAMPLES
+.PP
To state that a Tcl script requires the Tk and http packages, put this
at the top of the script:
+.PP
.CS
\fBpackage require\fR Tk
\fBpackage require\fR http
@@ -199,23 +352,19 @@ at the top of the script:
To test to see if the Snack package is available and load if it is
(often useful for optional enhancements to programs where the loss of
the functionality is not critical) do this:
+.PP
.CS
if {[catch {\fBpackage require\fR Snack}]} {
- # We have the package, configure the app to use it
+ # Error thrown - package not found.
+ # Set up a dummy interface to work around the absence
} else {
- # Set up a dummy interface to work around the absence
+ # We have the package, configure the app to use it
}
.CE
-.PP
-When writing a package implementation, you should put the following at
-the \fIbottom\fR of your library script so it is only called once the
-package has been successfully set up:
-.CS
-\fBpackage provide\fR foobar 1.0
-.CE
-
.SH "SEE ALSO"
msgcat(n), packagens(n), pkgMkIndex(n)
-
.SH KEYWORDS
package, version
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/packagens.n b/doc/packagens.n
index 685ff48..61e7eca 100644
--- a/doc/packagens.n
+++ b/doc/packagens.n
@@ -2,16 +2,14 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: packagens.n,v 1.5 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-pkg::create \- Construct an appropriate `package ifneeded' command for a given package specification
+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,16 +37,14 @@ 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
specified.
.PP
At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
-
.SH "SEE ALSO"
package(n)
-
.SH KEYWORDS
auto-load, index, package, version
diff --git a/doc/pid.n b/doc/pid.n
index e53c6f0..a4df2f3 100644
--- a/doc/pid.n
+++ b/doc/pid.n
@@ -5,10 +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: pid.n,v 1.6 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH pid n 7.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -25,7 +23,7 @@ In this case the \fBpid\fR command will return a list whose elements
are the process identifiers of all the processes in the pipeline,
in order.
The list will be empty if \fIfileId\fR refers to an open file
-that isn't a process pipeline.
+that is not a process pipeline.
If no \fIfileId\fR argument is given then \fBpid\fR returns the process
identifier of the current process.
All process identifiers are returned as decimal strings.
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index 28b3a2f..c2f23ed 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -4,20 +4,17 @@
'\" 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.17 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
-\fBpkg_mkIndex ?\fI\-direct\fR? ?\fI\-lazy\fR? ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+\fBpkg_mkIndex\fR ?\fIoptions...\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.fi
.BE
-
.SH DESCRIPTION
.PP
\fBPkg_mkIndex\fR is a utility procedure that is part of the standard
@@ -40,7 +37,8 @@ The \fIdir\fR argument gives the name of a directory and each
\fIpattern\fR argument is a \fBglob\fR-style pattern that selects
script or binary files in \fIdir\fR.
The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
-.br
+.RS
+.PP
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
@@ -51,10 +49,10 @@ and new commands appear (this is why it is essential to have
in the files, as described above).
If you have a package split among scripts and binary files,
or if you have dependencies among files,
-you may have to use the \fB\-load\fP option
+you may have to use the \fB\-load\fR option
or adjust the order in which \fBpkg_mkIndex\fR processes
-the files. See COMPLEX CASES below.
-
+the files. See \fBCOMPLEX CASES\fR below.
+.RE
.IP [3]
Install the package as a subdirectory of one of the directories given by
the \fBtcl_pkgPath\fR variable. If \fB$tcl_pkgPath\fR contains more
@@ -68,7 +66,8 @@ the package's script and/or binary files as well as the \fBpkgIndex.tcl\fR
file. As long as the package is installed as a subdirectory of a
directory in \fB$tcl_pkgPath\fR it will automatically be found during
\fBpackage require\fR commands.
-.br
+.RS
+.PP
If you install the package anywhere else, then you must ensure that
the directory containing the package is in the \fBauto_path\fR global variable
or an immediate subdirectory of one of the directories in \fBauto_path\fR.
@@ -81,6 +80,7 @@ You can add a directory to \fBauto_path\fR explicitly in your
application, or you can add the directory to your \fBTCLLIBPATH\fR
environment variable: if this environment variable is present,
Tcl initializes \fBauto_path\fR from it during application startup.
+.RE
.IP [4]
Once the above steps have been taken, all you need to do to use a
package is to invoke \fBpackage require\fR.
@@ -94,7 +94,6 @@ in \fBauto_path\fR, but only one will actually be loaded in a given
interpreter, based on the first call to \fBpackage require\fR.
Different versions of a package may be loaded in different
interpreters.
-
.SH OPTIONS
The optional switches are:
.TP 15
@@ -110,18 +109,17 @@ the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
-current interpreter and match \fIpkgPat\fP into the slave interpreter used to
+current interpreter and match \fIpkgPat\fR into the slave interpreter used to
generate the index. The pattern match uses string match rules, but without
making case distinctions.
-See COMPLEX CASES below.
+See \fBCOMPLEX CASES\fR below.
.TP 15
\fB\-verbose\fR
Generate output during the indexing process. Output is via
-the \fBtclLog\fP procedure, which by default prints to stderr.
+the \fBtclLog\fR procedure, which by default prints to stderr.
.TP 15
\fB\-\-\fR
-End of the flags, in case \fIdir\fP begins with a dash.
-
+End of the flags, in case \fIdir\fR begins with a dash.
.SH "PACKAGES AND THE AUTO-LOADER"
.PP
The package management facilities overlap somewhat with the auto-loader,
@@ -141,7 +139,6 @@ If you use \fBpkg_mkIndex\fR to index a package, its commands cannot
be invoked until \fBpackage require\fR has been used to select a
version; in contrast, packages indexed with \fBauto_mkindex\fR
can be used immediately since there is no version control.
-
.SH "HOW IT WORKS"
.PP
\fBPkg_mkIndex\fR depends on the \fBpackage unknown\fR command,
@@ -156,15 +153,14 @@ 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 isn't
+a given file of a given version of a given package is not
actually loaded until the first time one of its commands
is invoked.
Thus, after invoking \fBpackage require\fR you may
not see the package's commands in the interpreter, but you will be able
to invoke the commands and they will be auto-loaded.
-
.SH "DIRECT LOADING"
.PP
Some packages, for instance packages which use namespaces and export
@@ -172,8 +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
@@ -188,28 +183,28 @@ with some glob patterns.
.PP
In general, it is OK for scripts to have dependencies on other
packages.
-If scripts contain \fBpackage require\fP commands, these are
+If scripts contain \fBpackage require\fR commands, these are
stubbed out in the interpreter used to process the scripts,
so these do not cause problems.
If scripts call into other packages in global code,
-these calls are handled by a stub \fBunknown\fP command.
+these calls are handled by a stub \fBunknown\fR command.
However, if scripts make variable references to other package's
variables in global code, these will cause errors. That is
also bad coding style.
.PP
If binary files have dependencies on other packages, things
can become tricky because it is not possible to stub out
-C-level APIs such as \fBTcl_PkgRequire\fP API
+C-level APIs such as \fBTcl_PkgRequire\fR API
when loading a binary file.
For example, suppose the BLT package requires Tk, and expresses
-this with a call to \fBTcl_PkgRequire\fP in its \fBBlt_Init\fP routine.
+this with a call to \fBTcl_PkgRequire\fR in its \fBBlt_Init\fR routine.
To support this, you must run \fBpkg_mkIndex\fR in an interpreter that
has Tk loaded. You can achieve this with the
\fB\-load \fIpkgPat\fR option. If you specify this option,
\fBpkg_mkIndex\fR will load any packages listed by
-\fBinfo loaded\fP and that match \fIpkgPat\fP
+\fBinfo loaded\fR and that match \fIpkgPat\fR
into the interpreter used to process files.
-In most cases this will satisfy the \fBTcl_PkgRequire\fP calls
+In most cases this will satisfy the \fBTcl_PkgRequire\fR calls
made by binary files.
.PP
If you are indexing two binary files and one depends on the other,
@@ -219,19 +214,20 @@ and then the package it provides
will be available when the second file is processed.
You may also need to load the first package into the
temporary interpreter used to create the index by using
-the \fB\-load\fP flag;
-it won't hurt to specify package patterns that are not yet loaded.
+the \fB\-load\fR flag;
+it will not hurt to specify package patterns that are not yet loaded.
.PP
If you have a package that is split across scripts and a binary file,
-then you should avoid the \fB\-load\fP flag. The problem is that
+then you should avoid the \fB\-load\fR flag. The problem is that
if you load a package before computing the index it masks any
other files that provide part of the same package.
-If you must use \fB\-load\fP,
+If you must use \fB\-load\fR,
then you must specify the scripts first; otherwise the package loaded from
the binary file may mask the package defined by the scripts.
-
.SH "SEE ALSO"
package(n)
-
.SH KEYWORDS
auto-load, index, package, version
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/platform.n b/doc/platform.n
new file mode 100644
index 0000000..6abc289
--- /dev/null
+++ b/doc/platform.n
@@ -0,0 +1,86 @@
+'\"
+'\" Copyright (c) 2006 ActiveState Software Inc
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+platform \- System identification support code and utilities
+.SH SYNOPSIS
+.nf
+\fBpackage require platform ?1.0.10?\fR
+.sp
+\fBplatform::generic\fR
+\fBplatform::identify\fR
+\fBplatform::patterns \fIidentifier\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBplatform\fR package provides several utility commands useful
+for the identification of the architecture of a machine running Tcl.
+.PP
+Whilst Tcl provides the \fBtcl_platform\fR array for identifying the
+current architecture (in particular, the platform and machine
+elements) this is not always sufficient. This is because (on Unix
+machines) \fBtcl_platform\fR reflects the values returned by the
+\fBuname\fR command and these are not standardized across platforms and
+architectures. In addition, on at least one platform (AIX) the
+\fBtcl_platform(machine)\fR contains the CPU serial number.
+.PP
+Consequently, individual applications need to manipulate the values in
+\fBtcl_platform\fR (along with the output of system specific
+utilities) - which is both inconvenient for developers, and introduces
+the potential for inconsistencies in identifying architectures and in
+naming conventions.
+.PP
+The \fBplatform\fR package prevents such fragmentation - i.e., it
+establishes a standard naming convention for architectures running Tcl
+and makes it more convenient for developers to identify the current
+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
+details like kernel version, libc version, etc., and this information
+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
+.
+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
new file mode 100644
index 0000000..64a2e46
--- /dev/null
+++ b/doc/platform_shell.n
@@ -0,0 +1,57 @@
+'\"
+'\" Copyright (c) 2006-2008 ActiveState Software Inc
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+platform::shell \- System identification support code and utilities
+.SH SYNOPSIS
+.nf
+\fBpackage require platform::shell ?1.1.4?\fR
+.sp
+\fBplatform::shell::generic \fIshell\fR
+\fBplatform::shell::identify \fIshell\fR
+\fBplatform::shell::platform \fIshell\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBplatform::shell\fR package provides several utility commands useful
+for the identification of the architecture of a specific Tcl shell.
+.PP
+This package allows the identification of the architecture of a
+specific Tcl shell different from the shell running the package. The
+only requirement is that the other shell (identified by its path), is
+actually executable on the current machine.
+.PP
+While for most platform this means that the architecture of the
+interrogated shell is identical to the architecture of the running
+shell this is not generally true. A counter example are all platforms
+which have 32 and 64 bit variants and where a 64bit system is able to
+run 32bit code. For these running and interrogated shell may have
+different 32/64 bit settings and thus different identifiers.
+.PP
+For applications like a code repository it is important to identify
+the architecture of the shell which will actually run the installed
+packages, versus the architecture of the shell running the repository
+software.
+.SH COMMANDS
+.TP
+\fBplatform::shell::identify \fIshell\fR
+This command does the same identification as \fBplatform::identify\fR,
+for the specified Tcl shell, in contrast to the running shell.
+.TP
+\fBplatform::shell::generic \fIshell\fR
+This command does the same identification as \fBplatform::generic\fR,
+for the specified Tcl shell, in contrast to the running shell.
+.TP
+\fBplatform::shell::platform \fIshell\fR
+This command returns the contents of \fBtcl_platform(platform)\fR for
+the specified Tcl shell.
+.SH KEYWORDS
+operating system, cpu architecture, platform, architecture
diff --git a/doc/prefix.n b/doc/prefix.n
new file mode 100644
index 0000000..344ade7
--- /dev/null
+++ b/doc/prefix.n
@@ -0,0 +1,116 @@
+'\"
+'\" Copyright (c) 2008 Peter Spjuth <pspjuth@users.sourceforge.net>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH prefix n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tcl::prefix \- facilities for prefix matching
+.SH SYNOPSIS
+.nf
+\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+This document describes commands looking up a prefix in a list of strings.
+The following commands are supported:
+.TP
+\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
+.
+Returns a list of all elements in \fItable\fR that begin with the prefix
+\fIstring\fR.
+.TP
+\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
+.
+Returns the longest common prefix of all elements in \fItable\fR that
+begin with the prefix \fIstring\fR.
+.TP
+\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
+.
+If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
+one element, the matched element is returned. If not, the result depends
+on the \fB\-error\fR option. (It is recommended that the \fItable\fR be sorted
+before use with this subcommand, so that the list of matches presented in the
+error message also becomes sorted, though this is not strictly necessary for
+the operation of this subcommand itself.)
+.RS
+.TP
+\fB\-exact\fR\0
+.
+Accept only exact matches.
+.TP
+\fB\-message\0\fIstring\fR
+.
+Use \fIstring\fR in the error message at a mismatch. Default is
+.QW option .
+.TP
+\fB\-error\0\fIoptions\fR
+.
+The \fIoptions\fR are used when no match is found. If \fIoptions\fR is empty,
+no error is generated and an empty string is returned. Otherwise the
+\fIoptions\fR are used as \fBreturn\fR options when generating the error
+message. The default corresponds to setting
+.QW "\-level 0" .
+Example: If
+.QW "\fB\-error\fR {\-errorcode MyError \-level 1}"
+is used, an error would be generated as:
+.RS
+.PP
+.CS
+return \-errorcode MyError \-level 1 \-code error \e
+ "ambiguous option ..."
+.CE
+.RE
+.RE
+.SH "EXAMPLES"
+.PP
+Basic use:
+.PP
+.CS
+namespace import ::tcl::prefix
+\fBprefix match\fR {apa bepa cepa} apa
+ \fI\(-> apa\fR
+\fBprefix match\fR {apa bepa cepa} a
+ \fI\(-> apa\fR
+\fBprefix match\fR \-exact {apa bepa cepa} a
+ \fI\(-> bad option "a": must be apa, bepa, or cepa\fR
+\fBprefix match\fR \-message "switch" {apa ada bepa cepa} a
+ \fI\(-> ambiguous switch "a": must be apa, ada, bepa, or cepa\fR
+\fBprefix longest\fR {fblocked fconfigure fcopy file fileevent flush} fc
+ \fI\(-> fco\fR
+\fBprefix all\fR {fblocked fconfigure fcopy file fileevent flush} fc
+ \fI\(-> fconfigure fcopy\fR
+.CE
+.PP
+Simplifying option matching:
+.PP
+.CS
+array set opts {\-apa 1 \-bepa "" \-cepa 0}
+foreach {arg val} $args {
+ set opts([\fBprefix match\fR {\-apa \-bepa \-cepa} $arg]) $val
+}
+.CE
+.PP
+Creating a \fBswitch\fR that supports prefixes:
+.PP
+.CS
+switch [\fBprefix match\fR {apa bepa cepa} $arg] {
+ apa { }
+ bepa { }
+ cepa { }
+}
+.CE
+.SH "SEE ALSO"
+lsearch(n), namespace(n), string(n), Tcl_GetIndexFromObj(3)
+.SH "KEYWORDS"
+prefix, table lookup
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/proc.n b/doc/proc.n
index cfaeca7..632485e 100644
--- a/doc/proc.n
+++ b/doc/proc.n
@@ -5,10 +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: proc.n,v 1.5 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH proc n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ proc \- Create a Tcl procedure
.SH SYNOPSIS
\fBproc \fIname args body\fR
.BE
-
.SH DESCRIPTION
.PP
The \fBproc\fR command creates a new Tcl procedure named
@@ -35,20 +32,28 @@ elements specifies
one argument. Each argument specifier is also a list with either
one or two fields. If there is only a single field in the specifier
then it is the name of the argument; if there are two fields, then
-the first is the argument name and the second is its default value.
+the first is the argument name and the second is its default value.
+Arguments with default values that are followed by non-defaulted
+arguments become required arguments. In 8.6 this will be considered an
+error.
.PP
When \fIname\fR is invoked a local variable
will be created for each of the formal arguments to the procedure; its
value will be the value of corresponding argument in the invoking command
or the argument's default value.
+Actual arguments are assigned to formal arguments strictly in order.
Arguments with default values need not be
specified in a procedure invocation. However, there must be enough
actual arguments for all the
-formal arguments that don't have defaults, and there must not be any extra
-actual arguments. There is one special case to permit procedures with
+formal arguments that do not have defaults, and there must not be any extra
+actual arguments.
+Arguments with default values that are followed by non-defaulted
+arguments become required arguments (in 8.6 it will be considered an
+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.
@@ -57,41 +62,49 @@ When \fIbody\fR is being executed, variable names normally refer to
local variables, which are created automatically when referenced and
deleted when the procedure returns. One local variable is automatically
created for each of the procedure's arguments.
-Global variables can only be accessed by invoking
-the \fBglobal\fR command or the \fBupvar\fR command.
-Namespace variables can only be accessed by invoking
-the \fBvariable\fR command or the \fBupvar\fR command.
+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 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.
.PP
The \fBproc\fR command returns an empty string. When a procedure is
invoked, the procedure's return value is the value specified in a
-\fBreturn\fR command. If the procedure doesn't execute an explicit
+\fBreturn\fR command. If the procedure does not execute an explicit
\fBreturn\fR, then its return value is the value of the last command
executed in the procedure's body.
If an error occurs while executing the procedure
body, then the procedure-as-a-whole will return that same error.
.SH EXAMPLES
+.PP
This is a procedure that accepts arbitrarily many arguments and prints
them out, one by one.
+.PP
.CS
\fBproc\fR printArguments args {
- foreach arg $args {
- puts $arg
- }
+ foreach arg $args {
+ puts $arg
+ }
}
.CE
.PP
This procedure is a bit like the \fBincr\fR command, except it
multiplies the contents of the named variable by the value, which
defaults to \fB2\fR:
+.PP
.CS
\fBproc\fR mult {varName {multiplier 2}} {
- upvar 1 $varName var
- set var [expr {$var * $multiplier}]
+ upvar 1 $varName var
+ set var [expr {$var * $multiplier}]
}
.CE
-
.SH "SEE ALSO"
info(n), unknown(n)
-
.SH KEYWORDS
argument, procedure
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/puts.n b/doc/puts.n
index 007fcc2..01ca122 100644
--- a/doc/puts.n
+++ b/doc/puts.n
@@ -5,10 +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: puts.n,v 1.10 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ puts \- Write to a channel
.SH SYNOPSIS
\fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
.BE
-
.SH DESCRIPTION
.PP
Writes the characters given by \fIstring\fR to the channel given
@@ -63,36 +60,39 @@ 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 used in an event-driven fashion with the \fBfileevent\fR command
-(don't invoke \fBputs\fR unless you have recently been notified
+(do not invoke \fBputs\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
.SH EXAMPLES
+.PP
Write a short message to the console (or wherever \fBstdout\fR is
directed):
+.PP
.CS
\fBputs\fR "Hello, World!"
.CE
.PP
Print a message in several parts:
+.PP
.CS
\fBputs\fR -nonewline "Hello, "
\fBputs\fR "World!"
.CE
.PP
Print a message to the standard error channel:
+.PP
.CS
\fBputs\fR stderr "Hello, World!"
.CE
.PP
Append a log message to a file:
+.PP
.CS
set chan [open my.log a]
set timestamp [clock format [clock seconds]]
\fBputs\fR $chan "$timestamp - Hello, World!"
close $chan
.CE
-
.SH "SEE ALSO"
file(n), fileevent(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
channel, newline, output, write
diff --git a/doc/pwd.n b/doc/pwd.n
index d8b6a4e..31d378f 100644
--- a/doc/pwd.n
+++ b/doc/pwd.n
@@ -5,10 +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: pwd.n,v 1.6 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH pwd n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,17 +14,18 @@ pwd \- Return the absolute path of the current working directory
.SH SYNOPSIS
\fBpwd\fR
.BE
-
.SH DESCRIPTION
.PP
Returns the absolute path name of the current working directory.
.SH EXAMPLE
+.PP
Sometimes it is useful to change to a known directory when running
some external command using \fBexec\fR, but it is important to keep
the application usually running in the directory that it was started
-in (unless the user specifies otherwise) since that minimises user
+in (unless the user specifies otherwise) since that minimizes user
confusion. The way to do this is to save the current directory while
the external command is being run:
+.PP
.CS
set tarFile [file normalize somefile.tar]
set savedDir [\fBpwd\fR]
@@ -36,6 +35,5 @@ cd $savedDir
.CE
.SH "SEE ALSO"
file(n), cd(n), glob(n), filename(n)
-
.SH KEYWORDS
working directory
diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index c3a06cc..46a180d 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -4,48 +4,53 @@
'\"
'\" 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.8 2005/05/10 18:34:02 kennykb 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
re_syntax \- Syntax of Tcl regular expressions
.BE
-
.SH DESCRIPTION
.PP
A \fIregular expression\fR describes strings of characters.
-It's a pattern that matches certain strings and doesn't match others.
+It's a pattern that matches certain strings and does not match others.
.SH "DIFFERENT FLAVORS OF REs"
-Regular expressions (``RE''s), as defined by POSIX, come in two
-flavors: \fIextended\fR REs (``EREs'') and \fIbasic\fR REs (``BREs'').
+Regular expressions
+.PQ RE s ,
+as defined by POSIX, come in two flavors: \fIextended\fR REs
+.PQ ERE s
+and \fIbasic\fR REs
+.PQ BRE s .
EREs are roughly those of the traditional \fIegrep\fR, while BREs are
-roughly those of the traditional \fIed\fR. This implementation adds
-a third flavor, \fIadvanced\fR REs (``AREs''), basically EREs with
-some significant extensions.
+roughly those of the traditional \fIed\fR. This implementation adds
+a third flavor, \fIadvanced\fR REs
+.PQ ARE s ,
+basically EREs with some significant extensions.
.PP
-This manual page primarily describes AREs. BREs mostly exist for
+This manual page primarily describes AREs. BREs mostly exist for
backward compatibility in some old programs; they will be discussed at
-the end. POSIX EREs are almost an exact subset of AREs. Features of
+the end. POSIX EREs are almost an exact subset of AREs. Features of
AREs that are not present in EREs will be indicated.
.SH "REGULAR EXPRESSION SYNTAX"
.PP
Tcl regular expressions are implemented using the package written by
Henry Spencer, based on the 1003.2 spec and some (not quite all) of
-the Perl5 extensions (thanks, Henry!). Much of the description of
+the Perl5 extensions (thanks, Henry!). Much of the description of
regular expressions below is copied verbatim from his manual entry.
.PP
An ARE is one or more \fIbranches\fR,
-separated by `\fB|\fR',
+separated by
+.QW \fB|\fR ,
matching anything that matches any of the branches.
.PP
A branch is zero or more \fIconstraints\fR or \fIquantified atoms\fR,
concatenated.
It matches a match for the first, followed by a match for the second, etc;
an empty branch matches the empty string.
-.PP
+.SS QUANTIFIERS
A quantified atom is an \fIatom\fR possibly followed
by a single \fIquantifier\fR.
Without a quantifier, it matches a single match for the atom.
@@ -54,43 +59,50 @@ and what a so-quantified atom matches, are:
.RS 2
.TP 6
\fB*\fR
+.
a sequence of 0 or more matches of the atom
.TP
\fB+\fR
+.
a sequence of 1 or more matches of the atom
.TP
\fB?\fR
+.
a sequence of 0 or 1 matches of the atom
.TP
\fB{\fIm\fB}\fR
+.
a sequence of exactly \fIm\fR matches of the atom
.TP
\fB{\fIm\fB,}\fR
+.
a sequence of \fIm\fR or more matches of the atom
.TP
\fB{\fIm\fB,\fIn\fB}\fR
+.
a sequence of \fIm\fR through \fIn\fR (inclusive) matches of the atom;
\fIm\fR may not exceed \fIn\fR
.TP
\fB*? +? ?? {\fIm\fB}? {\fIm\fB,}? {\fIm\fB,\fIn\fB}?\fR
-\fInon-greedy\fR quantifiers,
-which match the same possibilities,
+.
+\fInon-greedy\fR quantifiers, which match the same possibilities,
but prefer the smallest number rather than the largest number
of matches (see \fBMATCHING\fR)
.RE
.PP
-The forms using \fB{\fR and \fB}\fR are known as \fIbound\fRs. The
+The forms using \fB{\fR and \fB}\fR are known as \fIbound\fRs. The
numbers \fIm\fR and \fIn\fR are unsigned decimal integers with
permissible values from 0 to 255 inclusive.
-.PP
+.SS ATOMS
An atom is one of:
.RS 2
.IP \fB(\fIre\fB)\fR 6
matches a match for \fIre\fR (\fIre\fR is any regular expression) with
the match noted for possible reporting
.IP \fB(?:\fIre\fB)\fR
-as previous, but does no reporting (a ``non-capturing'' set of
-parentheses)
+as previous, but does no reporting (a
+.QW non-capturing
+set of parentheses)
.IP \fB()\fR
matches an empty string, noted for possible reporting
.IP \fB(?:)\fR
@@ -109,30 +121,35 @@ where \fIc\fR is alphanumeric (possibly followed by other characters),
an \fIescape\fR (AREs only), see \fBESCAPES\fR below
.IP \fB{\fR
when followed by a character other than a digit, matches the
-left-brace character `\fB{\fR'; when followed by a digit, it is the
-beginning of a \fIbound\fR (see above)
+left-brace character
+.QW \fB{\fR ;
+when followed by a digit, it is the beginning of a \fIbound\fR (see above)
.IP \fIx\fR
where \fIx\fR is a single character with no other significance,
matches that character.
.RE
-.PP
+.SS CONSTRAINTS
A \fIconstraint\fR matches an empty string when specific conditions
-are met. A constraint may not be followed by a quantifier. The
+are met. A constraint may not be followed by a quantifier. The
simple constraints are as follows; some more constraints are described
later, under \fBESCAPES\fR.
.RS 2
.TP 8
\fB^\fR
+.
matches at the beginning of a line
.TP
\fB$\fR
+.
matches at the end of a line
.TP
\fB(?=\fIre\fB)\fR
+.
\fIpositive lookahead\fR (AREs only), matches at any point where a
substring matching \fIre\fR begins
.TP
\fB(?!\fIre\fB)\fR
+.
\fInegative lookahead\fR (AREs only), matches at any point where no
substring matching \fIre\fR begins
.RE
@@ -140,67 +157,50 @@ substring matching \fIre\fR begins
The lookahead constraints may not contain back references (see later),
and all parentheses within them are considered non-capturing.
.PP
-An RE may not end with `\fB\e\fR'.
+An RE may not end with
+.QW \fB\e\fR .
.SH "BRACKET EXPRESSIONS"
A \fIbracket expression\fR is a list of characters enclosed in
-`\fB[\|]\fR'. It normally matches any single character from the list
-(but see below). If the list begins with `\fB^\fR', it matches any
-single character (but see below) \fInot\fR from the rest of the list.
-.PP
-If two characters in the list are separated by `\fB\-\fR', this is
-shorthand for the full \fIrange\fR of characters between those two
-(inclusive) in the collating sequence, e.g. \fB[0\-9]\fR in Unicode
-matches any conventional decimal digit. Two ranges may not share an
-endpoint, so e.g. \fBa\-c\-e\fR is illegal. Ranges are very
-collating-sequence-dependent, and portable programs should avoid
-relying on them.
+.QW \fB[\|]\fR .
+It normally matches any single character from the list
+(but see below). If the list begins with
+.QW \fB^\fR ,
+it matches any single character (but see below) \fInot\fR from the
+rest of the list.
+.PP
+If two characters in the list are separated by
+.QW \fB\-\fR ,
+this is shorthand for the full \fIrange\fR of characters between those two
+(inclusive) in the collating sequence, e.g.
+.QW \fB[0\-9]\fR
+in Unicode matches any conventional decimal digit. Two ranges may not share an
+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 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
-collating element (see below). Alternatively, make it the first
-character (following a possible `\fB^\fR'), or (AREs only) precede it
-with `\fB\e\fR'. Alternatively, for `\fB\-\fR', make it the last
-character, or the second endpoint of a range. To use a literal
-\fB\-\fR as the first endpoint of a range, make it a collating element
-or (AREs only) precede it with `\fB\e\fR'. With the exception of
+collating element (see below). Alternatively, make it the first
+character (following a possible
+.QW \fB^\fR ),
+or (AREs only) precede it with
+.QW \fB\e\fR .
+Alternatively, for
+.QW \fB\-\fR ,
+make it the last character, or the second endpoint of a range. To use
+a literal \fB\-\fR as the first endpoint of a range, make it a
+collating element or (AREs only) precede it with
+.QW \fB\e\fR .
+With the exception of
these, some combinations using \fB[\fR (see next paragraphs), and
escapes, all other special characters lose their special significance
within a bracket expression.
-.PP
-Within a bracket expression, a collating element (a character, a
-multi-character sequence that collates as if it were a single
-character, or a collating-sequence name for either) enclosed in
-\fB[.\fR and \fB.]\fR stands for the sequence of characters of that
-collating element. The sequence is a single element of the bracket
-expression's list. A bracket expression in a locale that has
-multi-character collating elements can thus match more than one
-character. So (insidiously), a bracket expression that starts with
-\fB^\fR can match multi-character collating elements even if none of
-them appear in the bracket expression! (\fINote:\fR Tcl currently has
-no multi-character collating elements. This information is only for
-illustration.)
-.PP
-For example, assume the collating sequence includes a \fBch\fR
-multi-character collating element. Then the RE \fB[[.ch.]]*c\fR (zero
-or more \fBch\fP's followed by \fBc\fP) matches the first five
-characters of `\fBchchcc\fR'. Also, the RE \fB[^c]b\fR matches all of
-`\fBchb\fR' (because \fB[^c]\fR matches the multi-character \fBch\fR).
-.PP
-Within a bracket expression, a collating element enclosed in \fB[=\fR
-and \fB=]\fR is an equivalence class, standing for the sequences of
-characters of all collating elements equivalent to that one, including
-itself. (If there are no other equivalent collating elements, the
-treatment is as if the enclosing delimiters were `\fB[.\fR'\& and
-`\fB.]\fR'.) For example, if \fBo\fR and \fB\o'o^'\fR are the members
-of an equivalence class, then `\fB[[=o=]]\fR', `\fB[[=\o'o^'=]]\fR',
-and `\fB[o\o'o^']\fR'\& are all synonymous. An equivalence class may
-not be an endpoint of a range. (\fINote:\fR Tcl currently implements
-only the Unicode locale. It doesn't define any equivalence classes.
-The examples above are just illustrations.)
-.PP
+.SS "CHARACTER CLASSES"
Within a bracket expression, the name of a \fIcharacter class\fR
enclosed in \fB[:\fR and \fB:]\fR stands for the list of all
-characters (not all collating elements!) belonging to that class.
+characters (not all collating elements!) belonging to that class.
Standard character classes are:
.IP \fBalpha\fR 8
A letter.
@@ -215,7 +215,7 @@ A hexadecimal digit.
.IP \fBalnum\fR 8
An alphanumeric (letter or digit).
.IP \fBprint\fR 8
-An alphanumeric (same as alnum).
+A "printable" (same as graph, except also including space).
.IP \fBblank\fR 8
A space or tab character.
.IP \fBspace\fR 8
@@ -223,188 +223,317 @@ 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.
+A character with a visible representation (includes both \fBalnum\fR
+and \fBpunct\fR).
.IP \fBcntrl\fR 8
A control character.
.PP
-A locale may provide others. (Note that the current Tcl
-implementation has only one locale: the Unicode locale.) A character
-class may not be used as an endpoint of a range.
+A locale may provide others. A character class may not be used as an endpoint
+of a range.
+.RS
.PP
+(\fINote:\fR the current Tcl implementation has only one locale, the Unicode
+locale, which supports exactly the above classes.)
+.RE
+.SS "BRACKETED CONSTRAINTS"
There are two special cases of bracket expressions: the bracket
-expressions \fB[[:<:]]\fR and \fB[[:>:]]\fR are constraints, matching
-empty strings at the beginning and end of a word respectively.
-'\" note, discussion of escapes below references this definition of word
-A word is defined as a sequence of word characters that is neither
-preceded nor followed by word characters. A word character is an
-\fIalnum\fR character or an underscore (\fB_\fR). These special
-bracket expressions are deprecated; users of AREs should use
+expressions
+.QW \fB[[:<:]]\fR
+and
+.QW \fB[[:>:]]\fR
+are constraints, matching empty strings at the beginning and end of a word
+respectively.
+.\" note, discussion of escapes below references this definition of word
+A word is defined as a sequence of word characters that is neither preceded
+nor followed by word characters. A word character is an \fIalnum\fR character
+or an underscore
+.PQ \fB_\fR "" .
+These special bracket expressions are deprecated; users of AREs should use
constraint escapes instead (see below).
+.SS "COLLATING ELEMENTS"
+Within a bracket expression, a collating element (a character, a
+multi-character sequence that collates as if it were a single
+character, or a collating-sequence name for either) enclosed in
+\fB[.\fR and \fB.]\fR stands for the sequence of characters of that
+collating element. The sequence is a single element of the bracket
+expression's list. A bracket expression in a locale that has
+multi-character collating elements can thus match more than one
+character. So (insidiously), a bracket expression that starts with
+\fB^\fR can match multi-character collating elements even if none of
+them appear in the bracket expression!
+.RS
+.PP
+(\fINote:\fR Tcl has no multi-character collating elements. This information
+is only for illustration.)
+.RE
+.PP
+For example, assume the collating sequence includes a \fBch\fR multi-character
+collating element. Then the RE
+.QW \fB[[.ch.]]*c\fR
+(zero or more
+.QW \fBch\fRs
+followed by
+.QW \fBc\fR )
+matches the first five characters of
+.QW \fBchchcc\fR .
+Also, the RE
+.QW \fB[^c]b\fR
+matches all of
+.QW \fBchb\fR
+(because
+.QW \fB[^c]\fR
+matches the multi-character
+.QW \fBch\fR ).
+.SS "EQUIVALENCE CLASSES"
+Within a bracket expression, a collating element enclosed in \fB[=\fR
+and \fB=]\fR is an equivalence class, standing for the sequences of
+characters of all collating elements equivalent to that one, including
+itself. (If there are no other equivalent collating elements, the
+treatment is as if the enclosing delimiters were
+.QW \fB[.\fR \&
+and
+.QW \fB.]\fR .)
+For example, if \fBo\fR and \fB\*(qo\fR are the members of an
+equivalence class, then
+.QW \fB[[=o=]]\fR ,
+.QW \fB[[=\*(qo=]]\fR ,
+and
+.QW \fB[o\*(qo]\fR \&
+are all synonymous. An equivalence class may not be an endpoint of a range.
+.RS
+.PP
+(\fINote:\fR Tcl implements only the Unicode locale. It does not define any
+equivalence classes. The examples above are just illustrations.)
+.RE
.SH ESCAPES
Escapes (AREs only), which begin with a \fB\e\fR followed by an
alphanumeric character, come in several varieties: character entry,
-class shorthands, constraint escapes, and back references. A \fB\e\fR
+class shorthands, constraint escapes, and back references. A \fB\e\fR
followed by an alphanumeric character but not constituting a valid
-escape is illegal in AREs. In EREs, there are no escapes: outside a
+escape is illegal in AREs. In EREs, there are no escapes: outside a
bracket expression, a \fB\e\fR followed by an alphanumeric character
merely stands for that character as an ordinary character, and inside
-a bracket expression, \fB\e\fR is an ordinary character. (The latter
+a bracket expression, \fB\e\fR is an ordinary character. (The latter
is the one actual incompatibility between EREs and AREs.)
-.PP
+.SS "CHARACTER-ENTRY ESCAPES"
Character-entry escapes (AREs only) exist to make it easier to specify
non-printing and otherwise inconvenient characters in REs:
.RS 2
.TP 5
\fB\ea\fR
+.
alert (bell) character, as in C
.TP
\fB\eb\fR
+.
backspace, as in C
.TP
\fB\eB\fR
+.
synonym for \fB\e\fR to help reduce backslash doubling in some
applications where there are multiple levels of backslash processing
.TP
\fB\ec\fIX\fR
+.
(where \fIX\fR is any character) the character whose low-order 5 bits
are the same as those of \fIX\fR, and whose other bits are all zero
.TP
\fB\ee\fR
-the character whose collating-sequence name is `\fBESC\fR', or failing
-that, the character with octal value 033
+.
+the character whose collating-sequence name is
+.QW \fBESC\fR ,
+or failing that, the character with octal value 033
.TP
\fB\ef\fR
+.
formfeed, as in C
.TP
\fB\en\fR
+.
newline, as in C
.TP
\fB\er\fR
+.
carriage return, as in C
.TP
\fB\et\fR
+.
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
-(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).
+\fB\ex\fIhh\fR
+.
+(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 `\fB0\fR'-`\fB9\fR', `\fBa\fR'-`\fBf\fR', and
-`\fBA\fR'-`\fBF\fR'. Octal digits are `\fB0\fR'-`\fB7\fR'.
+Hexadecimal digits are
+.QR \fB0\fR \fB9\fR ,
+.QR \fBa\fR \fBf\fR ,
+and
+.QR \fBA\fR \fBF\fR .
+Octal digits are
+.QR \fB0\fR \fB7\fR .
.PP
The character-entry escapes are always taken as ordinary characters.
For example, \fB\e135\fR is \fB]\fR in Unicode, but \fB\e135\fR does
-not terminate a bracket expression. Beware, however, that some
+not terminate a bracket expression. Beware, however, that some
applications (e.g., C compilers and the Tcl interpreter if the regular
expression is not quoted with braces) interpret such sequences
themselves before the regular-expression package gets to see them,
-which may require doubling (quadrupling, etc.) the `\fB\e\fR'.
-.PP
+which may require doubling (quadrupling, etc.) the
+.QW \fB\e\fR .
+.SS "CLASS-SHORTHAND ESCAPES"
Class-shorthand escapes (AREs only) provide shorthands for certain
commonly-used character classes:
.RS 2
.TP 10
\fB\ed\fR
+.
\fB[[:digit:]]\fR
.TP
\fB\es\fR
+.
\fB[[:space:]]\fR
.TP
\fB\ew\fR
+.
\fB[[:alnum:]_]\fR (note underscore)
.TP
\fB\eD\fR
+.
\fB[^[:digit:]]\fR
.TP
\fB\eS\fR
+.
\fB[^[:space:]]\fR
.TP
\fB\eW\fR
+.
\fB[^[:alnum:]_]\fR (note underscore)
.RE
.PP
-Within bracket expressions, `\fB\ed\fR', `\fB\es\fR', and
-`\fB\ew\fR'\& lose their outer brackets, and `\fB\eD\fR', `\fB\eS\fR',
-and `\fB\eW\fR'\& are illegal. (So, for example, \fB[a-c\ed]\fR is
-equivalent to \fB[a-c[:digit:]]\fR. Also, \fB[a-c\eD]\fR, which is
-equivalent to \fB[a-c^[:digit:]]\fR, is illegal.)
-.PP
+Within bracket expressions,
+.QW \fB\ed\fR ,
+.QW \fB\es\fR ,
+and
+.QW \fB\ew\fR \&
+lose their outer brackets, and
+.QW \fB\eD\fR ,
+.QW \fB\eS\fR ,
+and
+.QW \fB\eW\fR \&
+are illegal. (So, for example,
+.QW \fB[a-c\ed]\fR
+is equivalent to
+.QW \fB[a-c[:digit:]]\fR .
+Also,
+.QW \fB[a-c\eD]\fR ,
+which is equivalent to
+.QW \fB[a-c^[:digit:]]\fR ,
+is illegal.)
+.SS "CONSTRAINT ESCAPES"
A constraint escape (AREs only) is a constraint, matching the empty
string if specific conditions are met, written as an escape:
.RS 2
.TP 6
\fB\eA\fR
+.
matches only at the beginning of the string (see \fBMATCHING\fR,
-below, for how this differs from `\fB^\fR')
+below, for how this differs from
+.QW \fB^\fR )
.TP
\fB\em\fR
+.
matches only at the beginning of a word
.TP
\fB\eM\fR
+.
matches only at the end of a word
.TP
\fB\ey\fR
+.
matches only at the beginning or end of a word
.TP
\fB\eY\fR
+.
matches only at a point that is not the beginning or end of a word
.TP
\fB\eZ\fR
+.
matches only at the end of the string (see \fBMATCHING\fR, below, for
-how this differs from `\fB$\fR')
+how this differs from
+.QW \fB$\fR )
.TP
\fB\e\fIm\fR
+.
(where \fIm\fR is a nonzero digit) a \fIback reference\fR, see below
.TP
\fB\e\fImnn\fR
+.
(where \fIm\fR is a nonzero digit, and \fInn\fR is some more digits,
and the decimal value \fImnn\fR is not greater than the number of
closing capturing parentheses seen so far) a \fIback reference\fR, see
below
.RE
.PP
-A word is defined as in the specification of \fB[[:<:]]\fR and
-\fB[[:>:]]\fR above. Constraint escapes are illegal within bracket
-expressions.
-.PP
+A word is defined as in the specification of
+.QW \fB[[:<:]]\fR
+and
+.QW \fB[[:>:]]\fR
+above. Constraint escapes are illegal within bracket expressions.
+.SS "BACK REFERENCES"
A back reference (AREs only) matches the same string matched by the
parenthesized subexpression specified by the number, so that (e.g.)
-\fB([bc])\e1\fR matches \fBbb\fR or \fBcc\fR but not `\fBbc\fR'. The
-subexpression must entirely precede the back reference in the RE.
+.QW \fB([bc])\e1\fR
+matches
+.QW \fBbb\fR
+or
+.QW \fBcc\fR
+but not
+.QW \fBbc\fR .
+The subexpression must entirely precede the back reference in the RE.
Subexpressions are numbered in the order of their leading parentheses.
Non-capturing parentheses do not define subexpressions.
.PP
There is an inherent historical ambiguity between octal
character-entry escapes and back references, which is resolved by
-heuristics, as hinted at above. A leading zero always indicates an
-octal escape. A single non-zero digit, not followed by another digit,
-is always taken as a back reference. A multi-digit sequence not
+heuristics, as hinted at above. A leading zero always indicates an
+octal escape. A single non-zero digit, not followed by another digit,
+is always taken as a back reference. A multi-digit sequence not
starting with a zero is taken as a back reference if it comes after a
suitable subexpression (i.e. the number is in the legal range for a
back reference), and otherwise is taken as octal.
@@ -413,54 +542,71 @@ In addition to the main syntax described above, there are some special
forms and miscellaneous syntactic facilities available.
.PP
Normally the flavor of RE being used is specified by
-application-dependent means. However, this can be overridden by a
-\fIdirector\fR. If an RE of any flavor begins with `\fB***:\fR', the
-rest of the RE is an ARE. If an RE of any flavor begins with
-`\fB***=\fR', the rest of the RE is taken to be a literal string, with
+application-dependent means. However, this can be overridden by a
+\fIdirector\fR. If an RE of any flavor begins with
+.QW \fB***:\fR ,
+the rest of the RE is an ARE. If an RE of any flavor begins with
+.QW \fB***=\fR ,
+the rest of the RE is taken to be a literal string, with
all characters considered ordinary characters.
.PP
An ARE may begin with \fIembedded options\fR: a sequence
\fB(?\fIxyz\fB)\fR (where \fIxyz\fR is one or more alphabetic
-characters) specifies options affecting the rest of the RE. These
+characters) specifies options affecting the rest of the RE. These
supplement, and can override, any options specified by the
-application. The available option letters are:
+application. The available option letters are:
.RS 2
.TP 3
\fBb\fR
+.
rest of RE is a BRE
.TP 3
\fBc\fR
+.
case-sensitive matching (usual default)
.TP 3
\fBe\fR
+.
rest of RE is an ERE
.TP 3
\fBi\fR
+.
case-insensitive matching (see \fBMATCHING\fR, below)
.TP 3
\fBm\fR
+.
historical synonym for \fBn\fR
.TP 3
\fBn\fR
+.
newline-sensitive matching (see \fBMATCHING\fR, below)
.TP 3
\fBp\fR
+.
partial newline-sensitive matching (see \fBMATCHING\fR, below)
.TP 3
\fBq\fR
-rest of RE is a literal (``quoted'') string, all ordinary characters
+.
+rest of RE is a literal
+.PQ quoted
+string, all ordinary characters
.TP 3
\fBs\fR
+.
non-newline-sensitive matching (usual default)
.TP 3
\fBt\fR
+.
tight syntax (usual default; see below)
.TP 3
\fBw\fR
-inverse partial newline-sensitive (``weird'') matching (see
-\fBMATCHING\fR, below)
+.
+inverse partial newline-sensitive
+.PQ weird
+matching (see \fBMATCHING\fR, below)
.TP 3
\fBx\fR
+.
expanded syntax (see below)
.RE
.PP
@@ -470,58 +616,70 @@ later within it.
.PP
In addition to the usual (\fItight\fR) RE syntax, in which all
characters are significant, there is an \fIexpanded\fR syntax,
-available in all flavors of RE with the \fB-expanded\fR switch, or in
-AREs with the embedded x option. In the expanded syntax, white-space
+available in all flavors of RE with the \fB\-expanded\fR switch, or in
+AREs with the embedded x option. In the expanded syntax, white-space
characters are ignored and all characters between a \fB#\fR and the
following newline (or the end of the RE) are ignored, permitting
-paragraphing and commenting a complex RE. There are three exceptions
+paragraphing and commenting a complex RE. There are three exceptions
to that basic rule:
.IP \(bu 3
-a white-space character or `\fB#\fR' preceded by `\fB\e\fR' is
-retained
+a white-space character or
+.QW \fB#\fR
+preceded by
+.QW \fB\e\fR
+is retained
.IP \(bu 3
-white space or `\fB#\fR' within a bracket expression is retained
+white space or
+.QW \fB#\fR
+within a bracket expression is retained
.IP \(bu 3
white space and comments are illegal within multi-character symbols
-like the ARE `\fB(?:\fR' or the BRE `\fB\e(\fR'
+like the ARE
+.QW \fB(?:\fR
+or the BRE
+.QW \fB\e(\fR
.PP
Expanded-syntax white-space characters are blank, tab, newline, and
any character that belongs to the \fIspace\fR character class.
.PP
Finally, in an ARE, outside bracket expressions, the sequence
-`\fB(?#\fIttt\fB)\fR' (where \fIttt\fR is any text not containing a
-`\fB)\fR') is a comment, completely ignored. Again, this is not
+.QW \fB(?#\fIttt\fB)\fR
+(where \fIttt\fR is any text not containing a
+.QW \fB)\fR )
+is a comment, completely ignored. Again, this is not
allowed between the characters of multi-character symbols like
-`\fB(?:\fR'. Such comments are more a historical artifact than a
-useful facility, and their use is deprecated; use the expanded syntax
-instead.
+.QW \fB(?:\fR .
+Such comments are more a historical artifact than a useful facility,
+and their use is deprecated; use the expanded syntax instead.
.PP
\fINone\fR of these metasyntax extensions is available if the
-application (or an initial \fB***=\fR director) has specified that the
+application (or an initial
+.QW \fB***=\fR
+director) has specified that the
user's input be treated as a literal string rather than as an RE.
.SH MATCHING
In the event that an RE could match more than one substring of a given
-string, the RE matches the one starting earliest in the string. If
+string, the RE matches the one starting earliest in the string. If
the RE could match more than one substring starting at that point, its
choice is determined by its \fIpreference\fR: either the longest
substring, or the shortest.
.PP
-Most atoms, and all constraints, have no preference. A parenthesized
-RE has the same preference (possibly none) as the RE. A quantified
+Most atoms, and all constraints, have no preference. A parenthesized
+RE has the same preference (possibly none) as the RE. A quantified
atom with quantifier \fB{\fIm\fB}\fR or \fB{\fIm\fB}?\fR has the same
-preference (possibly none) as the atom itself. A quantified atom with
+preference (possibly none) as the atom itself. A quantified atom with
other normal quantifiers (including \fB{\fIm\fB,\fIn\fB}\fR with
-\fIm\fR equal to \fIn\fR) prefers longest match. A quantified atom
+\fIm\fR equal to \fIn\fR) prefers longest match. A quantified atom
with other non-greedy quantifiers (including \fB{\fIm\fB,\fIn\fB}?\fR
-with \fIm\fR equal to \fIn\fR) prefers shortest match. A branch has
+with \fIm\fR equal to \fIn\fR) prefers shortest match. A branch has
the same preference as the first quantified atom in it which has a
-preference. An RE consisting of two or more branches connected by the
+preference. An RE consisting of two or more branches connected by the
\fB|\fR operator prefers longest match.
.PP
Subject to the constraints imposed by the rules for matching the whole
RE, subexpressions also match the longest or shortest possible
substrings, based on their preferences, with subexpressions starting
-earlier in the RE taking priority over ones starting later. Note that
+earlier in the RE taking priority over ones starting later. Note that
outer subexpressions thus take priority over their component
subexpressions.
.PP
@@ -529,58 +687,77 @@ Note that the quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
force longest and shortest preference, respectively, on a
subexpression or a whole RE.
.PP
-Match lengths are measured in characters, not collating elements. An
-empty string is considered longer than no match at all. For example,
-\fBbb*\fR matches the three middle characters of `\fBabbbc\fR',
-\fB(week|wee)(night|knights)\fR matches all ten characters of
-`\fBweeknights\fR', when \fB(.*).*\fR is matched against \fBabc\fR the
-parenthesized subexpression matches all three characters, and when
-\fB(a*)*\fR is matched against \fBbc\fR both the whole RE and the
-parenthesized subexpression match an empty string.
+Match lengths are measured in characters, not collating elements. An
+empty string is considered longer than no match at all. For example,
+.QW \fBbb*\fR
+matches the three middle characters of
+.QW \fBabbbc\fR ,
+.QW \fB(week|wee)(night|knights)\fR
+matches all ten characters of
+.QW \fBweeknights\fR ,
+when
+.QW \fB(.*).*\fR
+is matched against
+.QW \fBabc\fR
+the parenthesized subexpression matches all three characters, and when
+.QW \fB(a*)*\fR
+is matched against
+.QW \fBbc\fR
+both the whole RE and the parenthesized subexpression match an empty string.
.PP
If case-independent matching is specified, the effect is much as if
-all case distinctions had vanished from the alphabet. When an
+all case distinctions had vanished from the alphabet. When an
alphabetic that exists in multiple cases appears as an ordinary
character outside a bracket expression, it is effectively transformed
into a bracket expression containing both cases, so that \fBx\fR
-becomes `\fB[xX]\fR'. When it appears inside a bracket expression,
+becomes
+.QW \fB[xX]\fR .
+When it appears inside a bracket expression,
all case counterparts of it are added to the bracket expression, so
-that \fB[x]\fR becomes \fB[xX]\fR and \fB[^x]\fR becomes
-`\fB[^xX]\fR'.
+that
+.QW \fB[x]\fR
+becomes
+.QW \fB[xX]\fR
+and
+.QW \fB[^x]\fR
+becomes
+.QW \fB[^xX]\fR .
.PP
If newline-sensitive matching is specified, \fB.\fR and bracket
expressions using \fB^\fR will never match the newline character (so
that matches will never cross newlines unless the RE explicitly
arranges it) and \fB^\fR and \fB$\fR will match the empty string after
and before a newline respectively, in addition to matching at
-beginning and end of string respectively. ARE \fB\eA\fR and \fB\eZ\fR
+beginning and end of string respectively. ARE \fB\eA\fR and \fB\eZ\fR
continue to match beginning or end of string \fIonly\fR.
.PP
If partial newline-sensitive matching is specified, this affects
\fB.\fR and bracket expressions as with newline-sensitive matching,
-but not \fB^\fR and `\fB$\fR'.
+but not \fB^\fR and \fB$\fR.
.PP
If inverse partial newline-sensitive matching is specified, this
affects \fB^\fR and \fB$\fR as with newline-sensitive matching, but
-not \fB.\fR and bracket expressions. This isn't very useful but is
+not \fB.\fR and bracket expressions. This is not very useful but is
provided for symmetry.
.SH "LIMITS AND COMPATIBILITY"
-No particular limit is imposed on the length of REs. Programs
+No particular limit is imposed on the length of REs. Programs
intended to be highly portable should not employ REs longer than 256
bytes, as a POSIX-compliant implementation can refuse to accept such
REs.
.PP
The only feature of AREs that is actually incompatible with POSIX EREs
is that \fB\e\fR does not lose its special significance inside bracket
-expressions. All other ARE features use syntax which is illegal or
+expressions. All other ARE features use syntax which is illegal or
has undefined or unspecified effects in POSIX EREs; the \fB***\fR
syntax of directors likewise is outside the POSIX syntax for both BREs
and EREs.
.PP
Many of the ARE extensions are borrowed from Perl, but some have been
changed to clean them up, and a few Perl extensions are not present.
-Incompatibilities of note include `\fB\eb\fR', `\fB\eB\fR', the lack
-of special treatment for a trailing newline, the addition of
+Incompatibilities of note include
+.QW \fB\eb\fR ,
+.QW \fB\eB\fR ,
+the lack of special treatment for a trailing newline, the addition of
complemented bracket expressions to the things affected by
newline-sensitive matching, the restrictions on parentheses and back
references in lookahead constraints, and the longest/shortest-match
@@ -588,62 +765,70 @@ references in lookahead constraints, and the longest/shortest-match
.PP
The matching rules for REs containing both normal and non-greedy
quantifiers have changed since early beta-test versions of this
-package. (The new rules are much simpler and cleaner, but don't work
+package. (The new rules are much simpler and cleaner, but do not work
as hard at guessing the user's real intentions.)
.PP
Henry Spencer's original 1986 \fIregexp\fR package, still in
widespread use (e.g., in pre-8.1 releases of Tcl), implemented an
-early version of today's EREs. There are four incompatibilities
-between \fIregexp\fR's near-EREs (`RREs' for short) and AREs. In
-roughly increasing order of significance:
+early version of today's EREs. There are four incompatibilities
+between \fIregexp\fR's near-EREs
+.PQ RREs " for short"
+and AREs. In roughly increasing order of significance:
.IP \(bu 3
In AREs, \fB\e\fR followed by an alphanumeric character is either an
escape or an error, while in RREs, it was just another way of writing
-the alphanumeric. This should not be a problem because there was no
+the alphanumeric. This should not be a problem because there was no
reason to write such a sequence in RREs.
.IP \(bu 3
\fB{\fR followed by a digit in an ARE is the beginning of a bound,
-while in RREs, \fB{\fR was always an ordinary character. Such
+while in RREs, \fB{\fR was always an ordinary character. Such
sequences should be rare, and will often result in an error because
following characters will not look like a valid bound.
.IP \(bu 3
-In AREs, \fB\e\fR remains a special character within `\fB[\|]\fR', so
-a literal \fB\e\fR within \fB[\|]\fR must be written `\fB\e\e\fR'.
+In AREs, \fB\e\fR remains a special character within
+.QW \fB[\|]\fR ,
+so a literal \fB\e\fR within \fB[\|]\fR must be written
+.QW \fB\e\e\fR .
\fB\e\e\fR also gives a literal \fB\e\fR within \fB[\|]\fR in RREs,
but only truly paranoid programmers routinely doubled the backslash.
.IP \(bu 3
AREs report the longest/shortest match for the RE, rather than the
-first found in a specified search order. This may affect some RREs
+first found in a specified search order. This may affect some RREs
which were written in the expectation that the first match would be
-reported. (The careful crafting of RREs to optimize the search order
+reported. (The careful crafting of RREs to optimize the search order
for fast matching is obsolete (AREs examine all possible matches in
parallel, and their performance is largely insensitive to their
complexity) but cases where the search order was exploited to
deliberately find a match which was \fInot\fR the longest/shortest
will need rewriting.)
.SH "BASIC REGULAR EXPRESSIONS"
-BREs differ from EREs in several respects. `\fB|\fR', `\fB+\fR', and
-\fB?\fR are ordinary characters and there is no equivalent for their
-functionality. The delimiters for bounds are \fB\e{\fR and
-`\fB\e}\fR', with \fB{\fR and \fB}\fR by themselves ordinary
-characters. The parentheses for nested subexpressions are \fB\e(\fR
-and `\fB\e)\fR', with \fB(\fR and \fB)\fR by themselves ordinary
-characters. \fB^\fR is an ordinary character except at the beginning
+BREs differ from EREs in several respects.
+.QW \fB|\fR ,
+.QW \fB+\fR ,
+and \fB?\fR are ordinary characters and there is no equivalent for their
+functionality. The delimiters for bounds are \fB\e{\fR and
+.QW \fB\e}\fR ,
+with \fB{\fR and \fB}\fR by themselves ordinary characters. The
+parentheses for nested subexpressions are \fB\e(\fR and
+.QW \fB\e)\fR ,
+with \fB(\fR and \fB)\fR by themselves ordinary
+characters. \fB^\fR is an ordinary character except at the beginning
of the RE or the beginning of a parenthesized subexpression, \fB$\fR
is an ordinary character except at the end of the RE or the end of a
parenthesized subexpression, and \fB*\fR is an ordinary character if
it appears at the beginning of the RE or the beginning of a
-parenthesized subexpression (after a possible leading `\fB^\fR').
+parenthesized subexpression (after a possible leading
+.QW \fB^\fR ).
Finally, single-digit back references are available, and \fB\e<\fR and
-\fB\e>\fR are synonyms for \fB[[:<:]]\fR and \fB[[:>:]]\fR
+\fB\e>\fR are synonyms for
+.QW \fB[[:<:]]\fR
+and
+.QW \fB[[:>:]]\fR
respectively; no other escapes are available.
-
.SH "SEE ALSO"
RegExp(3), regexp(n), regsub(n), lsearch(n), switch(n), text(n)
-
.SH KEYWORDS
match, regular expression, string
-
-'\" Local Variables:
-'\" mode: nroff
-'\" End:
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/read.n b/doc/read.n
index 59cf4c5..87aa897 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -5,10 +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: read.n,v 1.11 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH read n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,7 +16,6 @@ read \- Read from a channel
.sp
\fBread \fIchannelId numChars\fR
.BE
-
.SH DESCRIPTION
.PP
In the first form, the \fBread\fR command reads all of the data from
@@ -53,36 +50,40 @@ newline characters according to the \fB\-translation\fR option
for the channel.
See the \fBfconfigure\fR manual entry for a discussion on ways in
which \fBfconfigure\fR will alter input.
-
.SH "USE WITH SERIAL PORTS"
'\" 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
\fBread \fIchannelId numChars\fR
+.
In this form \fBread\fR blocks until \fInumChars\fR have been received
from the serial port.
.TP
\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"
+.PP
This example code reads a file all at once, and splits it into a list,
with each line in the file corresponding to an element in the list:
+.PP
.CS
set fl [open /proc/meminfo]
set data [\fBread\fR $fl]
close $fl
-set lines [split $data \\n]
+set lines [split $data \en]
.CE
-
.SH "SEE ALSO"
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
new file mode 100644
index 0000000..2232d50
--- /dev/null
+++ b/doc/refchan.n
@@ -0,0 +1,411 @@
+'\"
+'\" Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+.\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+refchan \- command handler API of reflected channels
+.SH SYNOPSIS
+\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+.SH DESCRIPTION
+.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\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 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.
+.PP
+Of all the possible subcommands, the handler \fImust\fR support
+\fBinitialize\fR, \fBfinalize\fR, and \fBwatch\fR. Support for the
+other subcommands is optional.
+.SS "MANDATORY SUBCOMMANDS"
+.TP
+\fIcmdPrefix \fBinitialize \fIchannelId mode\fR
+.
+An invocation of this subcommand will be the first call the
+\fIcmdPrefix\fR will receive for the specified new \fIchannelId\fR. It
+is the responsibility of this subcommand to set up any internal data
+structures required to keep track of the channel and its state.
+.RS
+.PP
+The return value of the method has to be a list containing the names
+of all subcommands supported by the \fIcmdPrefix\fR. This also tells
+the Tcl core which version of the API for reflected channels is used by
+this command handler.
+.PP
+Any error thrown by the method will abort the creation of the channel
+and no channel will be created. The thrown error will appear as error
+thrown by \fBchan create\fR. Any exception other than an \fBerror\fR
+(e.g.,\ \fBbreak\fR, etc.) is treated as (and converted to) an error.
+.PP
+\fBNote:\fR If the creation of the channel was aborted due to failures
+here, then the \fBfinalize\fR subcommand will not be called.
+.PP
+The \fImode\fR argument tells the handler whether the channel was
+opened for reading, writing, or both. It is a list containing any of
+the strings \fBread\fR or \fBwrite\fR. The list will always
+contain at least one element.
+.PP
+The subcommand must throw an error if the chosen mode is not
+supported by the \fIcmdPrefix\fR.
+.RE
+.TP
+\fIcmdPrefix \fBfinalize \fIchannelId\fR
+.
+An invocation of this subcommand will be the last call the
+\fIcmdPrefix\fR will receive for the specified \fIchannelId\fR. It will
+be generated just before the destruction of the data structures of the
+channel held by the Tcl core. The command handler \fImust not\fR
+access the \fIchannelId\fR anymore in no way. Upon this subcommand being
+called, any internal resources allocated to this channel must be
+cleaned up.
+.RS
+.PP
+The return value of this subcommand is ignored.
+.PP
+If the subcommand throws an error the command which caused its
+invocation (usually \fBchan close\fR) will appear to have thrown this
+error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is
+treated as (and converted to) an error.
+.PP
+This subcommand is not invoked if the creation of the channel was
+aborted during \fBinitialize\fR (See above).
+.RE
+.TP
+\fIcmdPrefix \fBwatch \fIchannelId eventspec\fR
+.
+This subcommand notifies the \fIcmdPrefix\fR that the specified
+\fIchannelId\fR is interested in the events listed in the
+\fIeventspec\fR. This argument is a list containing any of \fBread\fR
+and \fBwrite\fR. The list may be empty, which signals that the
+channel does not wish to be notified of any events. In that situation,
+the handler should disable event generation completely.
+.RS
+.PP
+\fBWarning:\fR Any return value of the subcommand is ignored. This
+includes all errors thrown by the subcommand, \fBbreak\fR, \fBcontinue\fR, and
+custom return codes.
+.PP
+This subcommand interacts with \fBchan postevent\fR. Trying to post an
+event which was not listed in the last call to \fBwatch\fR will cause
+\fBchan postevent\fR to throw an error.
+.RE
+.SS "OPTIONAL SUBCOMMANDS"
+.TP
+\fIcmdPrefix \fBread \fIchannelId count\fR
+.
+This \fIoptional\fR subcommand is called when the user requests data from the
+channel \fIchannelId\fR. \fIcount\fR specifies how many \fIbytes\fR have been
+requested. If the subcommand is not supported then it is not possible to read
+from the channel handled by the command.
+.RS
+.PP
+The return value of this subcommand is taken as the requested data
+\fIbytes\fR. If the returned data contains more bytes than requested,
+an error will be signaled and later thrown by the command which
+performed the read (usually \fBgets\fR or \fBread\fR). However,
+returning fewer bytes than requested is acceptable.
+.PP
+Note that returning nothing (0 bytes) is a signal to the higher layers
+that \fBEOF\fR has been reached on the channel. To signal that the
+channel is out of data right now, but has not yet reached \fBEOF\fR,
+it is necessary to throw the error "EAGAIN", i.e. to either
+.PP
+.CS
+return -code error EAGAIN
+.CE
+or
+.CS
+error EAGAIN
+.CE
+.PP
+For extensibility any error whose value is a negative integer number
+will cause the higher layers to set the C-level variable "\fBerrno\fR"
+to the absolute value of this number, signaling a system error.
+However, note that the exact mapping between these error numbers and
+their meanings is operating system dependent.
+.PP
+For example, while on Linux both
+.PP
+.CS
+return -code error -11
+.CE
+and
+.CS
+error -11
+.CE
+.PP
+are equivalent to the examples above, using the more readable string "EAGAIN",
+this is not true for BSD, where the equivalent number is -35.
+.PP
+The symbolic string however is the same across systems, and internally
+translated to the correct number. No other error value has such a mapping
+to a symbolic string.
+.PP
+If the subcommand throws any other error, the command which caused its
+invocation (usually \fBgets\fR, or \fBread\fR) will appear to have
+thrown this error. Any exception beyond \fBerror\fR, (e.g.,\ \fBbreak\fR,
+etc.) is treated as and converted to an error.
+.RE
+.TP
+\fIcmdPrefix \fBwrite \fIchannelId data\fR
+.
+This \fIoptional\fR subcommand is called when the user writes data to
+the channel \fIchannelId\fR. The \fIdata\fR argument contains \fIbytes\fR, not
+characters. Any type of transformation (EOL, encoding) configured for
+the channel has already been applied at this point. If this subcommand
+is not supported then it is not possible to write to the channel
+handled by the command.
+.RS
+.PP
+The return value of the subcommand is taken as the number of bytes
+written by the channel. Anything non-numeric will cause an error to be
+signaled and later thrown by the command which performed the write. A
+negative value implies that the write failed. Returning a value
+greater than the number of bytes given to the handler, or zero, is
+forbidden and will cause the Tcl core to throw an error.
+.PP
+To signal that the channel is not able to accept data for writing
+right now, it is necessary to throw the error "EAGAIN", i.e. to either
+.PP
+.CS
+return -code error EAGAIN
+.CE
+or
+.CS
+error EAGAIN
+.CE
+.PP
+For extensibility any error whose value is a negative integer number
+will cause the higher layers to set the C-level variable "\fBerrno\fR"
+to the absolute value of this number, signaling a system error.
+However, note that the exact mapping between these error numbers and
+their meanings is operating system dependent.
+.PP
+For example, while on Linux both
+.PP
+.CS
+return -code error -11
+.CE
+and
+.CS
+error -11
+.CE
+.PP
+are equivalent to the examples above, using the more readable string "EAGAIN",
+this is not true for BSD, where the equivalent number is -35.
+.PP
+The symbolic string however is the same across systems, and internally
+translated to the correct number. No other error value has such a mapping
+to a symbolic string.
+.PP
+If the subcommand throws any other error the command which caused its
+invocation (usually \fBputs\fR) will appear to have thrown this error.
+Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated
+as and converted to an error.
+.RE
+.TP
+\fIcmdPrefix \fBseek \fIchannelId offset base\fR
+.
+This \fIoptional\fR subcommand is responsible for the handling of
+\fBchan seek\fR and \fBchan tell\fR requests on the channel
+\fIchannelId\fR. If it is not supported then seeking will not be possible for
+the channel.
+.RS
+.PP
+The \fIbase\fR argument is the same as the equivalent argument of the
+builtin \fBchan seek\fR, namely:
+.TP 10
+\fBstart\fR
+.
+Seeking is relative to the beginning of the channel.
+.TP 10
+\fBcurrent\fR
+.
+Seeking is relative to the current seek position.
+.TP 10
+\fBend\fR
+.
+Seeking is relative to the end of the channel.
+.PP
+The \fIoffset\fR is an integer number specifying the amount of
+\fBbytes\fR to seek forward or backward. A positive number should seek
+forward, and a negative number should seek backward.
+A channel may provide only limited seeking. For example sockets can
+seek forward, but not backward.
+.PP
+The return value of the subcommand is taken as the (new) location of
+the channel, counted from the start. This has to be an integer number
+greater than or equal to zero.
+If the subcommand throws an error the command which caused its
+invocation (usually \fBchan seek\fR, or \fBchan tell\fR) will appear to have
+thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
+etc.) is treated as and converted to an error.
+.PP
+The offset/base combination of 0/\fBcurrent\fR signals a \fBchan tell\fR
+request, i.e.,\ seek nothing relative to the current location, making
+the new location identical to the current one, which is then returned.
+.RE
+.TP
+\fIcmdPrefix \fBconfigure \fIchannelId option value\fR
+.
+This \fIoptional\fR subcommand is for setting the type-specific options of
+channel \fIchannelId\fR. The \fIoption\fR argument indicates the option to be
+written, and the \fIvalue\fR argument indicates the value to set the option to.
+.RS
+.PP
+This subcommand will never try to update more than one option at a
+time; that is behavior implemented in the Tcl channel core.
+.PP
+The return value of the subcommand is ignored.
+.PP
+If the subcommand throws an error the command which performed the
+(re)configuration or query (usually \fBfconfigure\fR or
+\fBchan configure\fR) will appear to have thrown this error. Any exception
+beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and
+converted to an error.
+.RE
+.TP
+\fIcmdPrefix \fBcget \fIchannelId option\fR
+.
+This \fIoptional\fR subcommand is used when reading a single type-specific
+option of channel \fIchannelId\fR. If this subcommand is supported then the
+subcommand \fBcgetall\fR must be supported as well.
+.RS
+.PP
+The subcommand should return the value of the specified \fIoption\fR.
+.PP
+If the subcommand throws an error, the command which performed the
+(re)configuration or query (usually \fBfconfigure\fR or \fBchan configure\fR)
+will appear to have thrown this error. Any exception beyond \fIerror\fR
+(e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error.
+.RE
+.TP
+\fIcmdPrefix \fBcgetall \fIchannelId\fR
+.
+This \fIoptional\fR subcommand is used for reading all type-specific options
+of channel \fIchannelId\fR. If this subcommand is supported then the
+subcommand \fBcget\fR has to be supported as well.
+.RS
+.PP
+The subcommand should return a list of all options and their values.
+This list must have an even number of elements.
+.PP
+If the subcommand throws an error the command which performed the
+(re)configuration or query (usually \fBfconfigure\fR or \fBchan configure\fR)
+will appear to have thrown this error. Any exception beyond \fBerror\fR
+(e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error.
+.RE
+.TP
+\fIcmdPrefix \fBblocking \fIchannelId mode\fR
+.
+This \fIoptional\fR subcommand handles changes to the blocking mode of the
+channel \fIchannelId\fR. The \fImode\fR is a boolean flag. A true value means
+that the channel has to be set to blocking, and a false value means that the
+channel should be non-blocking.
+.RS
+.PP
+The return value of the subcommand is ignored.
+.PP
+If the subcommand throws an error the command which caused its
+invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to
+have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
+etc.) is treated as and converted to an error.
+.RE
+.SH NOTES
+Some of the functions supported in channels defined in Tcl's C
+interface are not available to channels reflected to the Tcl level.
+.PP
+The function \fBTcl_DriverGetHandleProc\fR is not supported;
+i.e.,\ reflected channels do not have OS specific handles.
+.PP
+The function \fBTcl_DriverHandlerProc\fR is not supported. This driver
+function is relevant only for stacked channels, i.e.,\ transformations.
+Reflected channels are always base channels, not transformations.
+.PP
+The function \fBTcl_DriverFlushProc\fR is not supported. This is
+because the current generic I/O layer of Tcl does not use this
+function anywhere at all. Therefore support at the Tcl level makes no
+sense either. This may be altered in the future (through extending the
+API defined here and changing its version number) should the function
+be used at some time in the future.
+.SH EXAMPLE
+.PP
+This demonstrates how to make a channel that reads from a string.
+.PP
+.CS
+oo::class create stringchan {
+ variable data pos
+ constructor {string {encoding {}}} {
+ if {$encoding eq ""} {set encoding [encoding system]}
+ set data [encoding convertto $encoding $string]
+ set pos 0
+ }
+
+ method \fBinitialize\fR {ch mode} {
+ return "initialize finalize watch read seek"
+ }
+ method \fBfinalize\fR {ch} {
+ my destroy
+ }
+ method \fBwatch\fR {ch events} {
+ # Must be present but we ignore it because we do not
+ # post any events
+ }
+
+ # Must be present on a readable channel
+ method \fBread\fR {ch count} {
+ set d [string range $data $pos [expr {$pos+$count-1}]]
+ incr pos [string length $d]
+ return $d
+ }
+
+ # This method is optional, but useful for the example below
+ method \fBseek\fR {ch offset base} {
+ switch $base {
+ start {
+ set pos $offset
+ }
+ current {
+ incr pos $offset
+ }
+ end {
+ set pos [string length $data]
+ incr pos $offset
+ }
+ }
+ if {$pos < 0} {
+ set pos 0
+ } elseif {$pos > [string length $data]} {
+ set pos [string length $data]
+ }
+ return $pos
+ }
+}
+
+# Now we create an instance...
+set string "The quick brown fox jumps over the lazy dog.\\n"
+set ch [\fBchan create\fR read [stringchan new $string]]
+
+puts [gets $ch]; # Prints the whole string
+
+seek $ch -5 end;
+puts [read $ch]; # Prints just the last word
+.CE
+.SH "SEE ALSO"
+chan(n), transchan(n)
+.SH KEYWORDS
+API, channel, ensemble, prefix, reflection
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/regexp.n b/doc/regexp.n
index 3e4ecce..17bf564 100644
--- a/doc/regexp.n
+++ b/doc/regexp.n
@@ -4,27 +4,23 @@
'\" 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.19 2005/05/10 18:34:02 kennykb Exp $
-'\"
-.so man.macros
.TH regexp n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
regexp \- Match a regular expression against a string
-
.SH SYNOPSIS
\fBregexp \fR?\fIswitches\fR? \fIexp string \fR?\fImatchVar\fR? ?\fIsubMatchVar subMatchVar ...\fR?
.BE
-
.SH DESCRIPTION
.PP
Determines whether the regular expression \fIexp\fR matches part or
-all of \fIstring\fR and returns 1 if it does, 0 if it doesn't, unless
-\fB-inline\fR is specified (see below).
+all of \fIstring\fR and returns 1 if it does, 0 if it does not, unless
+\fB\-inline\fR is specified (see below).
(Regular expression matching is described in the \fBre_syntax\fR
reference page.)
-.LP
+.PP
If additional arguments are specified after \fIstring\fR then they
are treated as the names of variables in which to return
information about which part(s) of \fIstring\fR matched \fIexp\fR.
@@ -40,6 +36,7 @@ they are treated as switches. The following switches are
currently supported:
.TP 15
\fB\-about\fR
+.
Instead of attempting to match the regular expression, returns a list
containing information about the regular expression. The first
element of the list is a subexpression count. The second element is a
@@ -47,11 +44,13 @@ list of property names that describe various attributes of the regular
expression. This switch is primarily intended for debugging purposes.
.TP 15
\fB\-expanded\fR
+.
Enables use of the expanded regular expression syntax where
whitespace and comments are ignored. This is the same as specifying
the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-indices\fR
+.
Changes what is stored in the \fIsubMatchVar\fRs.
Instead of storing the matching characters from \fIstring\fR,
each variable
@@ -60,109 +59,150 @@ in \fIstring\fR of the first and last characters in the matching
range of characters.
.TP 15
\fB\-line\fR
+.
Enables newline-sensitive matching. By default, newline is a
completely ordinary character with no special meaning. With this
-flag, `[^' bracket expressions and `.' never match newline, `^'
+flag,
+.QW [^
+bracket expressions and
+.QW .
+never match newline,
+.QW ^
matches an empty string after any newline in addition to its normal
-function, and `$' matches an empty string before any newline in
+function, and
+.QW $
+matches an empty string before any newline in
addition to its normal function. This flag is equivalent to
specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
\fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-linestop\fR
-Changes the behavior of `[^' bracket expressions and `.' so that they
+.
+Changes the behavior of
+.QW [^
+bracket expressions and
+.QW .
+so that they
stop at newlines. This is the same as specifying the \fB(?p)\fR
embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-lineanchor\fR
-Changes the behavior of `^' and `$' (the ``anchors'') so they match the
+.
+Changes the behavior of
+.QW ^
+and
+.QW $
+(the
+.QW anchors )
+so they match the
beginning and end of a line respectively. This is the same as
specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR
manual page).
.TP 15
\fB\-nocase\fR
+.
Causes upper-case characters in \fIstring\fR to be treated as
lower case during the matching process.
.TP 15
\fB\-all\fR
+.
Causes the regular expression to be matched as many times as possible
in the string, returning the total number of matches found. If this
is specified with match variables, they will contain information for
the last match only.
.TP 15
\fB\-inline\fR
+.
Causes the command to return, as a list, the data that would otherwise
-be placed in match variables. When using \fB-inline\fR,
-match variables may not be specified. If used with \fB-all\fR, the
+be placed in match variables. When using \fB\-inline\fR,
+match variables may not be specified. If used with \fB\-all\fR, the
list will be concatenated at each iteration, such that a flat list is
always returned. For each match iteration, the command will append the
overall match data, plus one element for each subexpression in the
regular expression. Examples are:
+.RS
+.PP
.CS
- regexp -inline -- {\\w(\\w)} " inlined "
- => {in n}
- regexp -all -inline -- {\\w(\\w)} " inlined "
- => {in n li i ne e}
+\fBregexp\fR -inline -- {\ew(\ew)} " inlined "
+ \fI\(-> in n\fR
+\fBregexp\fR -all -inline -- {\ew(\ew)} " inlined "
+ \fI\(-> in n li i ne e\fR
.CE
+.RE
.TP 15
\fB\-start\fR \fIindex\fR
+.
Specifies a character index offset into the string to start
matching the regular expression at.
-.VS 8.5
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
-.VE 8.5
-When using this switch, `^'
-will not match the beginning of the line, and \\A will still
+When using this switch,
+.QW ^
+will not match the beginning of the line, and \eA will still
match the start of the string at \fIindex\fR. If \fB\-indices\fR
is specified, the indices will be indexed starting from the
absolute beginning of the input string.
\fIindex\fR will be constrained to the bounds of the input string.
.TP 15
\fB\-\|\-\fR
+.
Marks the end of switches. The argument following this one will
be treated as \fIexp\fR even if it starts with a \fB\-\fR.
.PP
-If there are more \fIsubMatchVar\fR's than parenthesized
+If there are more \fIsubMatchVar\fRs than parenthesized
subexpressions within \fIexp\fR, or if a particular subexpression
-in \fIexp\fR doesn't match the string (e.g. because it was in a
-portion of the expression that wasn't matched), then the corresponding
-\fIsubMatchVar\fR will be set to ``\fB\-1 \-1\fR'' if \fB\-indices\fR
-has been specified or to an empty string otherwise.
+in \fIexp\fR does not match the string (e.g. because it was in a
+portion of the expression that was not matched), then the corresponding
+\fIsubMatchVar\fR will be set to
+.QW "\fB\-1 \-1\fR"
+if \fB\-indices\fR has been specified or to an empty string otherwise.
.SH EXAMPLES
+.PP
Find the first occurrence of a word starting with \fBfoo\fR in a
string that is not actually an instance of \fBfoobar\fR, and get the
letters following it up to the end of the word into a variable:
+.PP
.CS
-\fBregexp\fR {\\<foo(?!bar\\>)(\\w*)} $string \-> restOfWord
+\fBregexp\fR {\emfoo(?!bar\eM)(\ew*)} $string \-> restOfWord
.CE
+.PP
Note that the whole matched substring has been placed in the variable
-\fB\->\fR which is a name chosen to look nice given that we are not
+.QW \fB\->\fR ,
+which is a name chosen to look nice given that we are not
actually interested in its contents.
.PP
Find the index of the word \fBbadger\fR (in any case) within a string
and store that in the variable \fBlocation\fR:
+.PP
.CS
-\fBregexp\fR \-indices {(?i)\\<badger\\>} $string location
+\fBregexp\fR \-indices {(?i)\embadger\eM} $string location
.CE
.PP
-Count the number of octal digits in a string:
+This could also be written as a \fIbasic\fR regular expression (as opposed
+to using the default syntax of \fIadvanced\fR regular expressions) match by
+prefixing the expression with a suitable flag:
+.PP
+.CS
+\fBregexp\fR \-indices {(?ib)\e<badger\e>} $string location
+.CE
+.PP
+This counts the number of octal digits in a string:
+.PP
.CS
\fBregexp\fR \-all {[0\-7]} $string
.CE
.PP
-List all words (consisting of all sequences of non-whitespace
-characters) in a string:
+This lists all words (consisting of all sequences of non-whitespace
+characters) in a string, and is useful as a more powerful version of the
+\fBsplit\fR command:
+.PP
.CS
-\fBregexp\fR \-all \-inline {\\S+} $string
+\fBregexp\fR \-all \-inline {\eS+} $string
.CE
-
.SH "SEE ALSO"
-re_syntax(n), regsub(n),
-.VS 8.5
-string(n)
-.VE
-
-
+re_syntax(n), regsub(n), string(n)
.SH KEYWORDS
-match, regular expression, string
+match, parsing, pattern, regular expression, splitting, string
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/registry.n b/doc/registry.n
index d1cb370..001def9 100644
--- a/doc/registry.n
+++ b/doc/registry.n
@@ -5,21 +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: registry.n,v 1.14 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH registry n 1.1 registry "Tcl Bundled Packages"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
registry \- Manipulate the Windows registry
.SH SYNOPSIS
.sp
-\fBpackage require registry 1.1\fR
+\fBpackage require registry 1.3\fR
.sp
-\fBregistry \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR?
+\fBregistry \fR?\fI\-mode\fR? \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
The \fBregistry\fR package provides a general set of operations for
@@ -30,12 +27,14 @@ as a corrupted registry can leave your system in an unusable state.
.PP
\fIKeyName\fR is the name of a registry key. Registry keys must be
one of the following forms:
-.IP
+.RS
+.PP
\fB\e\e\fIhostname\fB\e\fIrootname\fB\e\fIkeypath\fR
-.IP
+.PP
\fIrootname\fB\e\fIkeypath\fR
-.IP
+.PP
\fIrootname\fR
+.RE
.PP
\fIHostname\fR specifies the name of any valid Windows
host that exports its registry. The \fIrootname\fR component must be
@@ -45,11 +44,19 @@ one of \fBHKEY_LOCAL_MACHINE\fR, \fBHKEY_USERS\fR,
\fBHKEY_DYN_DATA\fR. The \fIkeypath\fR can be one or more
registry key names separated by backslash (\fB\e\fR) characters.
.PP
+.VS 8.6
+The optional \fI\-mode\fR argument indicates which registry to work
+with; when it is \fB\-32bit\fR the 32-bit registry will be used, and
+when it is \fB\-64bit\fR the 64-bit registry will be used. If this
+argument is omitted, the system's default registry will be the subject
+of the requested operation.
+.VE 8.6
+.PP
\fIOption\fR indicates what to do with the registry key name. Any
unique abbreviation for \fIoption\fR is acceptable. The valid options
are:
.TP
-\fBregistry broadcast \fIkeyName\fR ?\fI-timeout milliseconds\fR?
+\fBregistry broadcast \fIkeyName\fR ?\fB\-timeout \fImilliseconds\fR?
.
Sends a broadcast message to the system and running programs to notify them
of certain updates. This is necessary to propagate changes to key registry
@@ -58,12 +65,22 @@ milliseconds, to wait for applications to respond to the broadcast message.
It defaults to 3000. The following example demonstrates how to add a path
to the global Environment and notify applications of the change without
requiring a logoff/logon step (assumes admin privileges):
+.RS
+.PP
.CS
-set regPath {HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment}
-set curPath [registry get $regPath "Path"]
-registry set $regPath "Path" "$curPath;$addPath"
-registry broadcast "Environment"
+set regPath [join {
+ HKEY_LOCAL_MACHINE
+ SYSTEM
+ CurrentControlSet
+ Control
+ {Session Manager}
+ Environment
+} "\e\e"]
+set curPath [\fBregistry get\fR $regPath "Path"]
+\fBregistry set\fR $regPath "Path" "$curPath;$addPath"
+\fBregistry broadcast\fR "Environment"
.CE
+.RE
.TP
\fBregistry delete \fIkeyName\fR ?\fIvalueName\fR?
.
@@ -79,39 +96,38 @@ did not exist, the command has no effect.
Returns the data associated with the value \fIvalueName\fR under the key
\fIkeyName\fR. If either the key or the value does not exist, then an
error is generated. For more details on the format of the returned
-data, see SUPPORTED TYPES, below.
+data, see \fBSUPPORTED TYPES\fR, below.
.TP
\fBregistry keys \fIkeyName\fR ?\fIpattern\fR?
.
-If \fIpattern\fR isn't specified, returns a list of names of all the
+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??
.
-If \fIvalueName\fR isn't specified, creates the key \fIkeyName\fR if
-it doesn't already exist. If \fIvalueName\fR is specified, creates
+If \fIvalueName\fR is not specified, creates the key \fIkeyName\fR if
+it does not already exist. If \fIvalueName\fR is specified, creates
the key \fIkeyName\fR and value \fIvalueName\fR if necessary. The
contents of \fIvalueName\fR are set to \fIdata\fR with the type
-indicated by \fItype\fR. If \fItype\fR isn't specified, the type
+indicated by \fItype\fR. If \fItype\fR is not specified, the type
\fBsz\fR is assumed. For more details on the data and type arguments,
-see SUPPORTED TYPES below.
+see \fBSUPPORTED TYPES\fR below.
.TP
\fBregistry type \fIkeyName valueName\fR
.
Returns the type of the value \fIvalueName\fR in the key
\fIkeyName\fR. For more information on the possible types, see
-SUPPORTED TYPES, below.
+\fBSUPPORTED TYPES\fR, below.
.TP
\fBregistry values \fIkeyName\fR ?\fIpattern\fR?
.
-If \fIpattern\fR isn't specified, returns a list of names of all the
+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
@@ -143,8 +159,9 @@ represented in Tcl as a string.
.
The registry value contains a null-terminated string that contains
unexpanded references to environment variables in the normal Windows
-style (for example, "%PATH%"). The data is represented in Tcl as a
-string.
+style (for example,
+.QW %PATH% ).
+The data is represented in Tcl as a string.
.TP
\fBdword\fR
.
@@ -180,6 +197,7 @@ The registry command is only available on Windows.
.SH EXAMPLE
Print out how double-clicking on a Tcl script file will invoke a Tcl
interpreter:
+.PP
.CS
package require registry
set ext .tcl
@@ -193,6 +211,8 @@ set command [\fBregistry get\fR $path {}]
puts "$ext opens with $command"
.CE
-
.SH KEYWORDS
registry
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/regsub.n b/doc/regsub.n
index 53b8dd4..ef4c289 100644
--- a/doc/regsub.n
+++ b/doc/regsub.n
@@ -6,10 +6,8 @@
'\" 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.15 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH regsub n 8.3 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,7 +15,6 @@ regsub \- Perform substitutions based on regular expression pattern matching
.SH SYNOPSIS
\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec \fR?\fIvarName\fR?
.BE
-
.SH DESCRIPTION
.PP
This command matches the regular expression \fIexp\fR against
@@ -31,78 +28,112 @@ If there is a match, then while copying \fIstring\fR to \fIvarName\fR
(or to the result of this command if \fIvarName\fR is not present)
the portion of \fIstring\fR that
matched \fIexp\fR is replaced with \fIsubSpec\fR.
-If \fIsubSpec\fR contains a ``&'' or ``\e0'', then it is replaced
-in the substitution with the portion of \fIstring\fR that
-matched \fIexp\fR.
-If \fIsubSpec\fR contains a ``\e\fIn\fR'', where \fIn\fR is a digit
+If \fIsubSpec\fR contains a
+.QW &
+or
+.QW \e0 ,
+then it is replaced in the substitution with the portion of
+\fIstring\fR that matched \fIexp\fR.
+If \fIsubSpec\fR contains a
+.QW \e\fIn\fR ,
+where \fIn\fR is a digit
between 1 and 9, then it is replaced in the substitution with
-the portion of \fIstring\fR that matched the \fIn\fR-th
+the portion of \fIstring\fR that matched the \fIn\fR'th
parenthesized subexpression of \fIexp\fR.
Additional backslashes may be used in \fIsubSpec\fR to prevent special
-interpretation of ``&'' or ``\e0'' or ``\e\fIn\fR'' or
-backslash.
+interpretation of
+.QW & ,
+.QW \e0 ,
+.QW \e\fIn\fR
+and backslashes.
The use of backslashes in \fIsubSpec\fR tends to interact badly
-with the Tcl parser's use of backslashes, so it's generally
+with the Tcl parser's use of backslashes, so it is generally
safest to enclose \fIsubSpec\fR in braces if it includes
backslashes.
.LP
If the initial arguments to \fBregsub\fR start with \fB\-\fR then
they are treated as switches. The following switches are
currently supported:
-.TP 10
+.TP
\fB\-all\fR
+.
All ranges in \fIstring\fR that match \fIexp\fR are found and
substitution is performed for each of these ranges.
Without this switch only the first
matching range is found and substituted.
-If \fB\-all\fR is specified, then ``&'' and ``\e\fIn\fR''
+If \fB\-all\fR is specified, then
+.QW &
+and
+.QW \e\fIn\fR
sequences are handled for each substitution using the information
from the corresponding match.
-.TP 15
+.TP
\fB\-expanded\fR
+.
Enables use of the expanded regular expression syntax where
whitespace and comments are ignored. This is the same as specifying
the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
-.TP 15
+.TP
\fB\-line\fR
+.
Enables newline-sensitive matching. By default, newline is a
-completely ordinary character with no special meaning. With this
-flag, `[^' bracket expressions and `.' never match newline, `^'
+completely ordinary character with no special meaning. With this flag,
+.QW [^
+bracket expressions and
+.QW .
+never match newline,
+.QW ^
matches an empty string after any newline in addition to its normal
-function, and `$' matches an empty string before any newline in
+function, and
+.QW $
+matches an empty string before any newline in
addition to its normal function. This flag is equivalent to
specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
\fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page).
-.TP 15
+.TP
\fB\-linestop\fR
-Changes the behavior of `[^' bracket expressions and `.' so that they
+.
+Changes the behavior of
+.QW [^
+bracket expressions and
+.QW .
+so that they
stop at newlines. This is the same as specifying the \fB(?p)\fR
embedded option (see the \fBre_syntax\fR manual page).
-.TP 15
+.TP
\fB\-lineanchor\fR
-Changes the behavior of `^' and `$' (the ``anchors'') so they match the
+.
+Changes the behavior of
+.QW ^
+and
+.QW $
+(the
+.QW anchors )
+so they match the
beginning and end of a line respectively. This is the same as
specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR
manual page).
-.TP 10
+.TP
\fB\-nocase\fR
+.
Upper-case characters in \fIstring\fR will be converted to lower-case
before matching against \fIexp\fR; however, substitutions specified
by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
-.TP 10
+.TP
\fB\-start\fR \fIindex\fR
+.
Specifies a character index offset into the string to start
matching the regular expression at.
-.VS 8.5
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
-.VE 8.5
-When using this switch, `^'
-will not match the beginning of the line, and \\A will still
+When using this switch,
+.QW ^
+will not match the beginning of the line, and \eA will still
match the start of the string at \fIindex\fR.
\fIindex\fR will be constrained to the bounds of the input string.
-.TP 10
+.TP
\fB\-\|\-\fR
+.
Marks the end of switches. The argument following this one will
be treated as \fIexp\fR even if it starts with a \fB\-\fR.
.PP
@@ -112,38 +143,50 @@ string after replacement is returned.
See the manual entry for \fBregexp\fR for details on the interpretation
of regular expressions.
.SH EXAMPLES
+.PP
Replace (in the string in variable \fIstring\fR) every instance of
\fBfoo\fR which is a word by itself with \fBbar\fR:
+.PP
.CS
-\fBregsub\fR -all {\e<foo\e>} $string bar string
+\fBregsub\fR -all {\emfoo\eM} $string bar string
+.CE
+.PP
+or (using the
+.QW "basic regular expression"
+syntax):
+.PP
+.CS
+\fBregsub\fR -all {(?b)\e<foo\e>} $string bar string
.CE
.PP
Insert double-quotes around the first instance of the word
-\fBinteresting\fR, however it is capitalised.
+\fBinteresting\fR, however it is capitalized.
+.PP
.CS
-\fBregsub\fR -nocase {\e<interesting\e>} $string {"&"} string
+\fBregsub\fR -nocase {\eyinteresting\ey} $string {"&"} string
.CE
.PP
Convert all non-ASCII and Tcl-significant characters into \eu escape
sequences by using \fBregsub\fR and \fBsubst\fR in combination:
+.PP
.CS
-# This RE is just a character class for everything "bad"
-set RE {[][{}\e$\es\eu0100-\euffff]}
+# This RE is just a character class for almost everything "bad"
+set RE {[][{};#\e\e\e$ \er\et\eu0080-\euffff]}
# We will substitute with a fragment of Tcl script in brackets
set substitution {[format \e\e\e\eu%04x [scan "\e\e&" %c]]}
# Now we apply the substitution to get a subst-string that
-# will perform the computational parts of the conversion.
-set quoted [subst [\fBregsub\fR -all $RE $string $substitution]]
+# will perform the computational parts of the conversion. Note
+# that newline is handled specially through \fBstring map\fR since
+# backslash-newline is a special sequence.
+set quoted [subst [string map {\en {\e\eu000a}} \e
+ [\fBregsub\fR -all $RE $string $substitution]]]
.CE
-
.SH "SEE ALSO"
-regexp(n), re_syntax(n), subst(n),
-.VS 8.5
-string(n)
-.VE
-
-
+regexp(n), re_syntax(n), subst(n), string(n)
.SH KEYWORDS
-match, pattern, regular expression, substitute
+match, pattern, quoting, regular expression, substitution
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/rename.n b/doc/rename.n
index fde6d1c..744bf5a 100644
--- a/doc/rename.n
+++ b/doc/rename.n
@@ -5,10 +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: rename.n,v 1.5 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH rename n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ rename \- Rename or delete a command
.SH SYNOPSIS
\fBrename \fIoldName newName\fR
.BE
-
.SH DESCRIPTION
.PP
Rename the command that used to be called \fIoldName\fR so that it
@@ -28,9 +25,11 @@ If a command is renamed into a different namespace,
future invocations of it will execute in the new namespace.
The \fBrename\fR command returns an empty string as result.
.SH EXAMPLE
+.PP
The \fBrename\fR command can be used to wrap the standard Tcl commands
with your own monitoring machinery. For example, you might wish to
count how often the \fBsource\fR command is called:
+.PP
.CS
\fBrename\fR ::source ::theRealSource
set sourceCount 0
@@ -40,9 +39,7 @@ proc ::source args {
uplevel 1 ::theRealSource $args
}
.CE
-
.SH "SEE ALSO"
namespace(n), proc(n)
-
.SH KEYWORDS
command, delete, namespace, rename
diff --git a/doc/return.n b/doc/return.n
index 1f884e9..383ed8c 100644
--- a/doc/return.n
+++ b/doc/return.n
@@ -6,10 +6,8 @@
'\" 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.12 2004/11/20 00:17:32 dgp Exp $
-'\"
-.so man.macros
.TH return n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,11 +15,10 @@ return \- Return from a procedure, or set return code of a script
.SH SYNOPSIS
\fBreturn \fR?\fIresult\fR?
.sp
-\fBreturn \fR?\fB-code \fIcode\fR? ?\fIresult\fR?
+\fBreturn \fR?\fB\-code \fIcode\fR? ?\fIresult\fR?
.sp
\fBreturn \fR?\fIoption value \fR...? ?\fIresult\fR?
.BE
-
.SH DESCRIPTION
.PP
In its simplest usage, the \fBreturn\fR command is used without options
@@ -41,39 +38,45 @@ will be returned as the result of the \fBsource\fR command.
.PP
In addition to the result of a procedure, the return
code of a procedure may also be set by \fBreturn\fR
-through use of the \fB-code\fR option.
-In the usual case where the \fB\-code\fR option isn't
+through use of the \fB\-code\fR option.
+In the usual case where the \fB\-code\fR option is not
specified the procedure will return normally.
However, the \fB\-code\fR option may be used to generate an
exceptional return from the procedure.
\fICode\fR may have any of the following values:
.TP 13
-\fBok (or 0)\fR
+\fBok\fR (or \fB0\fR)
+.
Normal return: same as if the option is omitted. The return code
of the procedure is 0 (\fBTCL_OK\fR).
.TP 13
-\fBerror (1)\fR
+\fBerror\fR (or \fB1\fR)
+.
Error return: the return code of the procedure is 1 (\fBTCL_ERROR\fR).
The procedure command behaves in its calling context as if it
-were the command \fBerror \fIresult\fR. See below for additional
+were the command \fBerror\fR \fIresult\fR. See below for additional
options.
.TP 13
-\fBreturn (2)\fR
+\fBreturn\fR (or \fB2\fR)
+.
The return code of the procedure is 2 (\fBTCL_RETURN\fR). The
procedure command behaves in its calling context as if it
were the command \fBreturn\fR (with no arguments).
.TP 13
-\fBbreak (3)\fR
+\fBbreak\fR (or \fB3\fR)
+.
The return code of the procedure is 3 (\fBTCL_BREAK\fR). The
procedure command behaves in its calling context as if it
were the command \fBbreak\fR.
.TP 13
-\fBcontinue (4)\fR
+\fBcontinue\fR (or \fB4\fR)
+.
The return code of the procedure is 4 (\fBTCL_CONTINUE\fR). The
procedure command behaves in its calling context as if it
were the command \fBcontinue\fR.
.TP 13
\fIvalue\fR
+.
\fIValue\fR must be an integer; it will be returned as the
return code for the current procedure.
.LP
@@ -83,74 +86,91 @@ with \fIresult\fR set to a suitable error message. Otherwise
usage of the \fBreturn -code\fR option is mostly limited to
procedures that implement a new control structure.
.PP
-The \fBreturn -code\fR command acts similarly within script
+The \fBreturn \-code\fR command acts similarly within script
files that are evaluated by the \fBsource\fR command. During the
evaluation of the contents of a file as a script by \fBsource\fR,
-an invocation of the \fBreturn -code \fIcode\fR command will cause
+an invocation of the \fBreturn \-code \fIcode\fR command will cause
the return code of \fBsource\fR to be \fIcode\fR.
.SH "RETURN OPTIONS"
.PP
-.VS 8.5
In addition to a result and a return code, evaluation of a command
in Tcl also produces a dictionary of return options. In general
usage, all \fIoption value\fR pairs given as arguments to \fBreturn\fR
become entries in the return options dictionary, and any values at all
are acceptable except as noted below. The \fBcatch\fR command may be
-used to capture all of this information -- the return code, the result,
-and the return options dictionary -- that arise from evaluation of a script.
-.VE 8.5
+used to capture all of this information \(em the return code, the result,
+and the return options dictionary \(em that arise from evaluation of a
+script.
.PP
-As documented above, the \fB-code\fR entry in the return options dictionary
+As documented above, the \fB\-code\fR entry in the return options dictionary
receives special treatment by Tcl. There are other return options also
recognized and treated specially by Tcl. They are:
.TP
-\fB-errorcode \fIlist\fR
-The \fB-errorcode\fR option receives special treatment only when the value
-of the \fB-code\fR option is \fBTCL_ERROR\fR. Then the \fIlist\fR value
+\fB\-errorcode \fIlist\fR
+.
+The \fB\-errorcode\fR option receives special treatment only when the value
+of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then the \fIlist\fR value
is meant to be additional information about the error,
presented as a Tcl list for further processing by programs.
-If no \fB-errorcode\fR option is provided to \fBreturn\fR when
-the \fB-code error\fR option is provided, Tcl will set the value
-of the \fB-errorcode\fR entry in the return options dictionary
-to the default value of \fBNONE\fR. The \fB-errorcode\fR return
+If no \fB\-errorcode\fR option is provided to \fBreturn\fR when
+the \fB\-code error\fR option is provided, Tcl will set the value
+of the \fB\-errorcode\fR entry in the return options dictionary
+to the default value of \fBNONE\fR. The \fB\-errorcode\fR return
option will also be stored in the global variable \fBerrorCode\fR.
.TP
-\fB-errorinfo \fIinfo\fR
-The \fB-errorinfo\fR option receives special treatment only when the value
-of the \fB-code\fR option is \fBTCL_ERROR\fR. Then \fIinfo\fR is the initial
+\fB\-errorinfo \fIinfo\fR
+.
+The \fB\-errorinfo\fR option receives special treatment only when the value
+of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then \fIinfo\fR is the initial
stack trace, meant to provide to a human reader additional information
about the context in which the error occurred. The stack trace will
also be stored in the global variable \fBerrorInfo\fR.
-If no \fB-errorinfo\fR option is provided to \fBreturn\fR when
-the \fB-code error\fR option is provided, Tcl will provide its own
-initial stack trace value in the entry for \fB-errorinfo\fR. Tcl's
+If no \fB\-errorinfo\fR option is provided to \fBreturn\fR when
+the \fB\-code error\fR option is provided, Tcl will provide its own
+initial stack trace value in the entry for \fB\-errorinfo\fR. Tcl's
initial stack trace will include only the call to the procedure, and
stack unwinding will append information about higher stack levels, but
there will be no information about the context of the error within
the procedure. Typically the \fIinfo\fR value is supplied from
-the value of \fB-errorinfo\fR in a return options dictionary captured
+the value of \fB\-errorinfo\fR in a return options dictionary captured
by the \fBcatch\fR command (or from the copy of that information
stored in the global variable \fBerrorInfo\fR).
.TP
-\fB-level \fIlevel\fR
-.VS 8.5
-The \fB-level\fR and \fB-code\fR options work together to set the return
+\fB\-errorstack \fIlist\fR
+.VS 8.6
+The \fB\-errorstack\fR option receives special treatment only when the value
+of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then \fIlist\fR is the initial
+error stack, recording actual argument values passed to each proc level. The error stack will
+also be reachable through \fBinfo errorstack\fR.
+If no \fB\-errorstack\fR option is provided to \fBreturn\fR when
+the \fB\-code error\fR option is provided, Tcl will provide its own
+initial error stack in the entry for \fB\-errorstack\fR. Tcl's
+initial error stack will include only the call to the procedure, and
+stack unwinding will append information about higher stack levels, but
+there will be no information about the context of the error within
+the procedure. Typically the \fIlist\fR value is supplied from
+the value of \fB\-errorstack\fR in a return options dictionary captured
+by the \fBcatch\fR command (or from the copy of that information from
+\fBinfo errorstack\fR).
+.VE 8.6
+.TP
+\fB\-level \fIlevel\fR
+.
+The \fB\-level\fR and \fB\-code\fR options work together to set the return
code to be returned by one of the commands currently being evaluated.
The \fIlevel\fR value must be a non-negative integer representing a number
of levels on the call stack. It defines the number of levels up the stack
at which the return code of a command currently being evaluated should
-be \fIcode\fR. If no \fB-level\fR option is provided, the default value
+be \fIcode\fR. If no \fB\-level\fR option is provided, the default value
of \fIlevel\fR is 1, so that \fBreturn\fR sets the return code that the
current procedure returns to its caller, 1 level up the call stack. The
mechanism by which these options work is described in more detail below.
-.VE 8.5
.TP
-\fB-options \fIoptions\fR
-.VS 8.5
+\fB\-options \fIoptions\fR
+.
The value \fIoptions\fR must be a valid dictionary. The entries of that
dictionary are treated as additional \fIoption value\fR pairs for the
\fBreturn\fR command.
-.VE 8.5
.SH "RETURN CODE HANDLING MECHANISMS"
.PP
Return codes are used in Tcl to control program flow. A Tcl script
@@ -169,27 +189,26 @@ evaluation to terminate without evaluating all commands in sequence.
Some of Tcl's built-in commands evaluate scripts as part of their
functioning. These commands can make use of exceptional return
codes to enable special features. For example, the built-in
-Tcl commands that provide loops -- such as \fBwhile\fR, \fBfor\fR,
-and \fBforeach\fR -- evaluate a script that is the body of the
+Tcl commands that provide loops \(em such as \fBwhile\fR, \fBfor\fR,
+and \fBforeach\fR \(em evaluate a script that is the body of the
loop. If evaluation of the loop body returns the return code
of \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR, the loop command can react in such
a way as to give the \fBbreak\fR and \fBcontinue\fR commands
their documented interpretation in loops.
.PP
-.VS 8.5
Procedure invocation also involves evaluation of a script, the body
of the procedure. Procedure invocation provides special treatment
when evaluation of the procedure body returns the return code
-\fBTCL_RETURN\fR. In that circumstance, the \fB-level\fR entry in the
+\fBTCL_RETURN\fR. In that circumstance, the \fB\-level\fR entry in the
return options dictionary is decremented. If after decrementing,
-the value of the \fB-level\fR entry is 0, then the value of
-the \fB-code\fR entry becomes the return code of the procedure.
-If after decrementing, the value of the \fB-level\fR entry is
+the value of the \fB\-level\fR entry is 0, then the value of
+the \fB\-code\fR entry becomes the return code of the procedure.
+If after decrementing, the value of the \fB\-level\fR entry is
greater than zero, then the return code of the procedure is
\fBTCL_RETURN\fR. If the procedure invocation occurred during the
evaluation of the body of another procedure, the process will
repeat itself up the call stack, decrementing the value of the
-\fB-level\fR entry at each level, so that the \fIcode\fR will
+\fB\-level\fR entry at each level, so that the \fIcode\fR will
be the return code of the current command \fIlevel\fR levels
up the call stack. The \fBsource\fR command performs the
same handling of the \fBTCL_RETURN\fR return code, which explains
@@ -198,26 +217,28 @@ to \fBreturn\fR invocation within a procedure.
.PP
The return code of the \fBreturn\fR command itself triggers this
special handling by procedure invocation. If \fBreturn\fR
-is provided the option \fB-level 0\fR, then the return code
+is provided the option \fB\-level 0\fR, then the return code
of the \fBreturn\fR command itself will be the value \fIcode\fR
-of the \fB-code\fR option (or \fBTCL_OK\fR by default). Any other value
-for the \fB-level\fR option (including the default value of 1)
+of the \fB\-code\fR option (or \fBTCL_OK\fR by default). Any other value
+for the \fB\-level\fR option (including the default value of 1)
will cause the return code of the \fBreturn\fR command itself
to be \fBTCL_RETURN\fR, triggering a return from the enclosing procedure.
-.VE 8.5
.SH EXAMPLES
+.PP
First, a simple example of using \fBreturn\fR to return from a
procedure, interrupting the procedure body.
+.PP
.CS
proc printOneLine {} {
- puts "line 1" ;# This line will be printed.
- \fBreturn\fR
- puts "line 2" ;# This line will not be printed.
+ puts "line 1" ;# This line will be printed.
+ \fBreturn\fR
+ puts "line 2" ;# This line will not be printed.
}
.CE
.PP
Next, an example of using \fBreturn\fR to set the value
returned by the procedure.
+.PP
.CS
proc returnX {} {\fBreturn\fR X}
puts [returnX] ;# prints "X"
@@ -225,76 +246,81 @@ puts [returnX] ;# prints "X"
.PP
Next, a more complete example, using \fBreturn -code error\fR
to report invalid arguments.
+.PP
.CS
proc factorial {n} {
- if {![string is integer $n] || ($n < 0)} {
- \fBreturn\fR -code error \\
- "expected non-negative integer,\\
- but got \\"$n\\""
- }
- if {$n < 2} {
- \fBreturn\fR 1
- }
- set m [expr {$n - 1}]
- set code [catch {factorial $m} factor]
- if {$code != 0} {
- \fBreturn\fR -code $code $factor
- }
- set product [expr {$n * $factor}]
- if {$product < 0} {
- \fBreturn\fR -code error \\
- "overflow computing factorial of $n"
- }
- \fBreturn\fR $product
+ if {![string is integer $n] || ($n < 0)} {
+ \fBreturn\fR -code error \e
+ "expected non-negative integer,\e
+ but got \e"$n\e""
+ }
+ if {$n < 2} {
+ \fBreturn\fR 1
+ }
+ set m [expr {$n - 1}]
+ set code [catch {factorial $m} factor]
+ if {$code != 0} {
+ \fBreturn\fR -code $code $factor
+ }
+ set product [expr {$n * $factor}]
+ if {$product < 0} {
+ \fBreturn\fR -code error \e
+ "overflow computing factorial of $n"
+ }
+ \fBreturn\fR $product
}
.CE
.PP
Next, a procedure replacement for \fBbreak\fR.
+.PP
.CS
proc myBreak {} {
- \fBreturn\fR -code break
+ \fBreturn\fR -code break
}
.CE
.PP
-.VS 8.5
-With the \fB-level 0\fR option, \fBreturn\fR itself can serve
-as a replacement for \fBbreak\fR.
+With the \fB\-level 0\fR option, \fBreturn\fR itself can serve
+as a replacement for \fBbreak\fR, with the help of \fBinterp alias\fR.
+.PP
.CS
interp alias {} Break {} \fBreturn\fR -level 0 -code break
.CE
.PP
An example of using \fBcatch\fR and \fBreturn -options\fR to
re-raise a caught error:
+.PP
.CS
proc doSomething {} {
- set resource [allocate]
- catch {
- # Long script of operations
- # that might raise an error
- } result options
- deallocate $resource
- \fBreturn\fR -options $options $result
+ set resource [allocate]
+ catch {
+ # Long script of operations
+ # that might raise an error
+ } result options
+ deallocate $resource
+ \fBreturn\fR -options $options $result
}
.CE
.PP
Finally an example of advanced use of the \fBreturn\fR options
to create a procedure replacement for \fBreturn\fR itself:
+.PP
.CS
proc myReturn {args} {
- set result ""
- if {[llength $args] % 2} {
- set result [lindex $args end]
- set args [lrange $args 0 end-1]
- }
- set options [dict merge {-level 1} $args]
- dict incr options -level
- \fBreturn\fR -options $options $result
+ set result ""
+ if {[llength $args] % 2} {
+ set result [lindex $args end]
+ set args [lrange $args 0 end-1]
+ }
+ set options [dict merge {-level 1} $args]
+ dict incr options -level
+ \fBreturn\fR -options $options $result
}
.CE
-.VE 8.5
-
.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), errorCode(n),
+errorInfo(n), proc(n), source(n), throw(n), try(n)
.SH KEYWORDS
-break, catch, continue, error, procedure, return
+break, catch, continue, error, exception, procedure, result, return
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/safe.n b/doc/safe.n
index acfb80d..76184a5 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -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: safe.n,v 1.7 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Safe\ Base \- A mechanism for creating and manipulating safe interpreters
+safe \- Creating and manipulating safe interpreters
.SH SYNOPSIS
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
.sp
@@ -26,28 +24,27 @@ Safe\ Base \- A mechanism for creating and manipulating safe interpreters
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
.sp
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
-.SH OPTIONS
+.SS OPTIONS
.PP
?\fB\-accessPath\fR \fIpathList\fR?
?\fB\-statics\fR \fIboolean\fR? ?\fB\-noStatics\fR?
?\fB\-nested\fR \fIboolean\fR? ?\fB\-nestedLoadOk\fR?
?\fB\-deleteHook\fR \fIscript\fR?
.BE
-
.SH DESCRIPTION
Safe Tcl is a mechanism for executing untrusted Tcl scripts
safely and for providing mediated access by such scripts to
potentially dangerous functionality.
.PP
-The Safe Base ensures that untrusted Tcl scripts cannot harm the
+Safe Tcl ensures that untrusted Tcl scripts cannot harm the
hosting application.
-The Safe Base prevents integrity and privacy attacks. Untrusted Tcl
+It prevents integrity and privacy attacks. Untrusted Tcl
scripts are prevented from corrupting the state of the hosting
application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
hosting application to any party.
.PP
-The Safe Base allows a master interpreter to create safe, restricted
+Safe Tcl allows a master interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
@@ -62,16 +59,15 @@ requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
.PP
-All commands provided in the master interpreter by the Safe Base reside in
-the \fBsafe\fR namespace:
-
+All commands provided in the master interpreter by Safe Tcl reside in
+the \fBsafe\fR namespace.
.SH COMMANDS
The following commands are provided in the master interpreter:
.TP
\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.
@@ -80,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
@@ -95,14 +91,17 @@ safe interpreter and change each and only the provided options.
See the section on \fBOPTIONS\fR below for options description.
Example of use:
.RS
+.PP
.CS
-# Create a new interp with the same configuration as "$i0" :
-set i1 [eval safe::interpCreate [safe::interpConfigure $i0]]
+# Create new interp with the same configuration as "$i0":
+set i1 [safe::interpCreate {*}[safe::interpConfigure $i0]]
+
# Get the current deleteHook
set dh [safe::interpConfigure $i0 \-del]
-# Change (only) the statics loading ok attribute of an interp
-# and its deleteHook (leaving the rest unchanged) :
-safe::interpConfigure $i0 \-delete {foo bar} \-statics 0 ;
+
+# Change (only) the statics loading ok attribute of an
+# interp and its deleteHook (leaving the rest unchanged):
+safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
.CE
.RE
.TP
@@ -119,8 +118,10 @@ This command finds and returns the token for the real directory
It generates an error if the directory is not found.
Example of use:
.RS
+.PP
.CS
-$slave eval [list set tk_library [::safe::interpFindInAccessPath $name $tk_library]]
+$slave eval [list set tk_library \e
+ [::safe::interpFindInAccessPath $name $tk_library]]
.CE
.RE
.TP
@@ -132,8 +133,10 @@ If the directory is already in the virtual path, it only returns the token
without adding the directory to the virtual path again.
Example of use:
.RS
+.PP
.CS
-$slave eval [list set tk_library [::safe::interpAddToAccessPath $name $tk_library]]
+$slave eval [list set tk_library \e
+ [::safe::interpAddToAccessPath $name $tk_library]]
.CE
.RE
.TP
@@ -152,14 +155,18 @@ This prevents a safe interpreter from seeing messages about failures
and other events that might contain sensitive information such as real
directory names.
.RS
+.PP
Example of use:
+.PP
.CS
::safe::setLogCmd puts stderr
.CE
+.PP
Below is the output of a sample session in which a safe interpreter
attempted to source a file not found in its virtual access path.
Note that the safe interpreter only received an error message saying that
the file was not found:
+.PP
.CS
NOTICE for slave interp10 : Created
NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
@@ -167,8 +174,7 @@ NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
-
-.SH OPTIONS
+.SS OPTIONS
The following options are common to
\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR,
and \fB::safe::interpConfigure\fR.
@@ -192,7 +198,7 @@ The default value is \fBtrue\fR :
safe interpreters are allowed to load statically linked packages.
.TP
\fB\-noStatics\fR
-This option is a convenience shortcut for \fB-statics false\fR and
+This option is a convenience shortcut for \fB\-statics false\fR and
thus specifies that the safe interpreter will not be allowed
to load statically linked packages.
.TP
@@ -204,7 +210,7 @@ safe interpreters are not allowed to load packages into
their own sub-interpreters.
.TP
\fB\-nestedLoadOk\fR
-This option is a convenience shortcut for \fB-nested true\fR and
+This option is a convenience shortcut for \fB\-nested true\fR and
thus specifies the safe interpreter will be allowed
to load packages into its own sub-interpreters.
.TP
@@ -254,15 +260,14 @@ the system encoding, but allows all other subcommands including
\fBexit\fR
The calling interpreter is deleted and its computation is stopped, but the
Tcl process in which this interpreter exists is not terminated.
-
.SH SECURITY
-The Safe Base does not attempt to completely prevent annoyance and
+Safe Tcl does not attempt to completely prevent annoyance and
denial of service attacks. These forms of attack prevent the
application or user from temporarily using the computer to perform
useful work, for example by consuming all available CPU time or
all available screen real estate.
These attacks, while aggravating, are deemed to be of lesser importance
-in general than integrity and privacy attacks that the Safe Base
+in general than integrity and privacy attacks that Safe Tcl
is to prevent.
.PP
The commands available in a safe interpreter, in addition to
@@ -288,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\\\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).
@@ -306,8 +311,12 @@ To further prevent potential information leakage from sensitive files that
are accidentally included in the set of files that can be sourced by a safe
interpreter, the \fBsource\fR alias restricts access to files
meeting the following constraints: the file name must
-fourteen characters or shorter, must not contain more than one dot ("\fB.\fR"),
-must end up with the extension \fB.tcl\fR or be called \fBtclIndex\fR.
+fourteen characters or shorter, must not contain more than one dot
+.PQ \fB.\fR "" ,
+must end up with the extension
+.PQ \fB.tcl\fR
+or be called
+.PQ \fBtclIndex\fR .
.PP
Each element of the initial access path
list will be assigned a token that will be set in
@@ -317,9 +326,9 @@ the \fBtcl_library\fR for that slave.
If the access path argument is not given or is the empty list,
the default behavior is to let the slave access the same packages
as the master has access to (Or to be more precise:
-only packages written in Tcl (which by definition can't be dangerous
+only packages written in Tcl (which by definition cannot be dangerous
as they run in the slave interpreter) and C extensions that
-provides a Safe_Init entry point). For that purpose, the master's
+provides a _SafeInit entry point). For that purpose, the master's
\fBauto_path\fR will be used to construct the slave access path.
In order that the slave successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
@@ -340,10 +349,11 @@ When the \fIaccessPath\fR is changed after the first creation or
initialization (i.e. through \fBinterpConfigure -accessPath \fR\fIlist\fR),
an \fBauto_reset\fR is automatically evaluated in the safe interpreter
to synchronize its \fBauto_index\fR with the new token list.
-
.SH "SEE ALSO"
interp(n), library(n), load(n), package(n), source(n), unknown(n)
-
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/scan.n b/doc/scan.n
index 59a9662..5b91449 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -6,10 +6,8 @@
'\" 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.14 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH scan n 8.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,17 +15,17 @@ scan \- Parse string using conversion specifiers in the style of sscanf
.SH SYNOPSIS
\fBscan \fIstring format \fR?\fIvarName varName ...\fR?
.BE
-
.SH INTRODUCTION
.PP
-This command parses fields from an input string in the same fashion as the
-ANSI C \fBsscanf\fR procedure and returns a count of the number of
+This command parses substrings from an input string in a fashion similar
+to the ANSI C \fBsscanf\fR procedure and returns a count of the number of
conversions performed, or -1 if the end of the input string is reached
before any conversions have been performed. \fIString\fR gives the input
to be parsed and \fIformat\fR indicates how to parse it, using \fB%\fR
conversion specifiers as in \fBsscanf\fR. Each \fIvarName\fR gives the
-name of a variable; when a field is scanned from \fIstring\fR the result is
-converted back into a string and assigned to the corresponding variable.
+name of a variable; when a substring is scanned from \fIstring\fR that
+matches a conversion specifier, the substring is assigned to the
+corresponding variable.
If no \fIvarName\fR variables are specified, then \fBscan\fR works in an
inline manner, returning the data that would otherwise be stored in the
variables as a list. In the inline case, an empty string is returned when
@@ -39,27 +37,29 @@ performed.
If the next character in \fIformat\fR is a blank or tab then it
matches any number of white space characters in \fIstring\fR (including
zero).
-Otherwise, if it isn't a \fB%\fR character then it
+Otherwise, if it is not a \fB%\fR character then it
must match the next character of \fIstring\fR.
When a \fB%\fR is encountered in \fIformat\fR, it indicates
the start of a conversion specifier.
A conversion specifier contains up to four fields after the \fB%\fR:
-a \fB*\fR, which indicates that the converted value is to be discarded
-instead of assigned to a variable; a XPG3 position specifier; a number
-indicating a maximum field width; a field size modifier; and a
+a XPG3 position specifier (or a \fB*\fR to indicate the converted
+value is to be discarded instead of assigned to any variable); a number
+indicating a maximum substring width; a size modifier; and a
conversion character.
All of these fields are optional except for the conversion character.
The fields that are present must appear in the order given above.
.PP
When \fBscan\fR finds a conversion specifier in \fIformat\fR, it
first skips any white-space characters in \fIstring\fR (unless the
-specifier is \fB[\fR or \fBc\fR).
+conversion character is \fB[\fR or \fBc\fR).
Then it converts the next input characters according to the
conversion specifier and stores the result in the variable given
by the next argument to \fBscan\fR.
+.SS "OPTIONAL POSITIONAL SPECIFIER"
.PP
If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
-``\fB%2$d\fR'', then the variable to use is not taken from the next
+.QW \fB%2$d\fR ,
+then the variable to use is not taken from the next
sequential argument. Instead, it is taken from the argument indicated
by the number, where 1 corresponds to the first \fIvarName\fR. If
there are any positional specifiers in \fIformat\fR then all of the
@@ -67,77 +67,91 @@ specifiers must be positional. Every \fIvarName\fR on the argument
list must correspond to exactly one conversion specifier or an error
is generated, or in the inline case, any position can be specified
at most once and the empty positions will be filled in with empty strings.
+.SS "OPTIONAL SIZE MODIFIER"
+.PP
+The size modifier field is used only when scanning a substring into
+one of Tcl's integer values. The size modifier field dictates the
+integer range acceptable to be stored in a variable, or, for the inline
+case, in a position in the result list.
+The syntactically valid values for the size modifier are \fBh\fR, \fBL\fR,
+\fBl\fR, and \fBll\fR. The \fBh\fR size modifier value is equivalent
+to the absence of a size modifier in the the conversion specifier.
+Either one indicates the integer range to be stored is limited to
+the same range produced by the \fBint()\fR function of the \fBexpr\fR
+command. The \fBL\fR size modifier is equivalent to the \fBl\fR size
+modifier. Either one indicates the integer range to be stored is
+limited to the same range produced by the \fBwide()\fR function of
+the \fBexpr\fR command. The \fBll\fR size modifier indicates that
+the integer range to be stored is unlimited.
+.SS "MANDATORY CONVERSION CHARACTER"
.PP
The following conversion characters are supported:
-.TP 10
+.TP
\fBd\fR
-The input field must be a decimal integer.
-It is read in and the value is stored in the variable as a decimal string.
-If the \fBl\fR or \fBL\fR field size modifier is given, the scanned
-value will have an internal representation that is at least 64-bits in
-size.
-.TP 10
+.
+The input substring must be a decimal integer.
+It is read in and the integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP
\fBo\fR
-The input field must be an octal integer. It is read in and the
-value is stored in the variable as a decimal string.
-If the \fBl\fR or \fBL\fR field size modifier is given, the scanned
-value will have an internal representation that is at least 64-bits in
-size.
-If the value exceeds MAX_INT (017777777777 on platforms using 32-bit
-integers when the \fBl\fR and \fBL\fR modifiers are not given), it
-will be truncated to a signed integer. Hence, 037777777777 will
-appear as -1 on a 32-bit machine by default.
-.TP 10
-\fBx\fR
-The input field must be a hexadecimal integer. It is read in
-and the value is stored in the variable as a decimal string.
-If the \fBl\fR or \fBL\fR field size modifier is given, the scanned
-value will have an internal representation that is at least 64-bits in
-size.
-If the value exceeds MAX_INT (0x7FFFFFFF on platforms using 32-bit
-integers when the \fBl\fR and \fBL\fR modifiers are not given), it
-will be truncated to a signed integer. Hence, 0xFFFFFFFF will appear
-as -1 on a 32-bit machine.
-.TP 10
+.
+The input substring must be an octal integer. It is read in and the
+integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP
+\fBx\fR or \fBX\fR
+.
+The input substring must be a hexadecimal integer.
+It is read in and the integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP
+\fBb\fR
+.
+The input substring must be a binary integer.
+It is read in and the integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP
\fBu\fR
-The input field must be a decimal integer. The value is stored in the
-variable as an unsigned decimal integer string.
-If the \fBl\fR or \fBL\fR field size modifier is given, the scanned
-value will have an internal representation that is at least 64-bits in
-size.
-.TP 10
-\fBi\fR
-The input field must be an integer. The base (i.e. decimal, octal, or
-hexadecimal) is determined in the same fashion as described in
-\fBexpr\fR. The value is stored in the variable as a decimal string.
-If the \fBl\fR or \fBL\fR field size modifier is given, the scanned
-value will have an internal representation that is at least 64-bits in
-size.
-.TP 10
+.
+The input substring must be a decimal integer.
+The integer value is truncated as required by the size modifier
+value, and the corresponding unsigned value for that truncated
+range is computed and stored in the variable as a decimal string.
+The conversion makes no sense without reference to a truncation range,
+so the size modifier \fBll\fR is not permitted in combination
+with conversion character \fBu\fR.
+.TP
+\fBi\fR
+.
+The input substring must be an integer. The base (i.e. decimal, binary,
+octal, or hexadecimal) is determined in the same fashion as described in
+\fBexpr\fR. The integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP
\fBc\fR
-A single character is read in and its binary value is stored in
-the variable as a decimal string.
+.
+A single character is read in and its Unicode value is stored in
+the variable as an integer value.
Initial white space is not skipped in this case, so the input
-field may be a white-space character.
-This conversion is different from the ANSI standard in that the
-input field always consists of a single character and no field
-width may be specified.
-.TP 10
+substring may be a white-space character.
+.TP
\fBs\fR
-The input field consists of all the characters up to the next
+.
+The input substring consists of all the characters up to the next
white-space character; the characters are copied to the variable.
-.TP 10
-\fBe\fR or \fBf\fR or \fBg\fR
-The input field must be a floating-point number consisting
+.TP
+\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR
+.
+The input substring must be a floating-point number consisting
of an optional sign, a string of decimal digits possibly
containing a decimal point, and an optional exponent consisting
of an \fBe\fR or \fBE\fR followed by an optional sign and a string of
decimal digits.
-It is read in and stored in the variable as a floating-point string.
-.TP 10
+It is read in and stored in the variable as a floating-point value.
+.TP
\fB[\fIchars\fB]\fR
-The input field consists of any number of characters in
-\fIchars\fR.
+.
+The input substring consists of one or more characters in \fIchars\fR.
The matching string is stored in the variable.
If the first character between the brackets is a \fB]\fR then
it is treated as part of \fIchars\fR rather than the closing
@@ -147,10 +161,10 @@ contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will match.
If the first or last character between the brackets is a \fB\-\fR, then
it is treated as part of \fIchars\fR rather than indicating a range.
-.TP 10
+.TP
\fB[^\fIchars\fB]\fR
-The input field consists of any number of characters not in
-\fIchars\fR.
+.
+The input substring consists of one or more characters not in \fIchars\fR.
The matching string is stored in the variable.
If the character immediately following the \fB^\fR is a \fB]\fR then it is
treated as part of the set rather than the closing bracket for
@@ -160,18 +174,19 @@ contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will be excluded
from the set.
If the first or last character between the brackets is a \fB\-\fR, then
-it is treated as part of \fIchars\fR rather than indicating a range.
-.TP 10
+it is treated as part of \fIchars\fR rather than indicating a range value.
+.TP
\fBn\fR
+.
No input is consumed from the input string. Instead, the total number
of characters scanned from the input string so far is stored in the variable.
-.LP
+.PP
The number of characters read from the input for a conversion is the
largest number that makes sense for that particular conversion (e.g.
as many decimal digits as possible for \fB%d\fR, as
many octal digits as possible for \fB%o\fR, and so on).
-The input field for a given conversion terminates either when a
-white-space character is encountered or when the maximum field
+The input substring for a given conversion terminates either when a
+white-space character is encountered or when the maximum substring
width has been reached, whichever comes first.
If a \fB*\fR is present in the conversion specifier
then no variable is assigned and the next scan argument is not consumed.
@@ -180,22 +195,32 @@ then no variable is assigned and the next scan argument is not consumed.
The behavior of the \fBscan\fR command is the same as the behavior of
the ANSI C \fBsscanf\fR procedure except for the following differences:
.IP [1]
-\fB%p\fR conversion specifier is not currently supported.
+\fB%p\fR conversion specifier is not supported.
.IP [2]
For \fB%c\fR conversions a single character value is
converted to a decimal string, which is then assigned to the
corresponding \fIvarName\fR;
-no field width may be specified for this conversion.
+no substring width may be specified for this conversion.
.IP [3]
The \fBh\fR modifier is always ignored and the \fBl\fR and \fBL\fR
modifiers are ignored when converting real values (i.e. type
-\fBdouble\fR is used for the internal representation).
+\fBdouble\fR is used for the internal representation). The \fBll\fR
+modifier has no \fBsscanf\fR counterpart.
.IP [4]
If the end of the input string is reached before any conversions have been
performed and no variables are given, an empty string is returned.
.SH EXAMPLES
+.PP
+Convert a UNICODE character to its numeric value:
+.PP
+.CS
+set char "x"
+set value [\fBscan\fR $char %c]
+.CE
+.PP
Parse a simple color specification of the form \fI#RRGGBB\fR using
-hexadecimal conversions with field sizes:
+hexadecimal conversions with substring sizes:
+.PP
.CS
set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
@@ -204,47 +229,65 @@ set string "#08D03F"
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
octal numbers by forcing interpretation as decimals (if we did not
care, we would use the \fB%i\fR conversion instead):
+.PP
.CS
set string "08:08" ;# *Not* octal!
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
- error "not a valid time string"
+ error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
- error "invalid number of minutes"
+ error "invalid number of minutes"
}
.CE
.PP
Break a string up into sequences of non-whitespace characters (note
the use of the \fB%n\fR conversion so that we get skipping over
leading whitespace correct):
+.PP
.CS
set string " a string {with braced words} + leading space "
set words {}
while {[\fBscan\fR $string %s%n word length] == 2} {
- lappend words $word
- set string [string range $string $length end]
+ lappend words $word
+ set string [string range $string $length end]
}
.CE
.PP
Parse a simple coordinate string, checking that it is complete by
looking for the terminating character explicitly:
+.PP
.CS
set string "(5.2,-4e-2)"
# Note that the spaces before the literal parts of
# the scan pattern are significant, and that ")" is
-# the Unicode character \\u0029
+# the Unicode character \eu0029
if {
- [\fBscan\fR $string " (%f ,%f %c" x y last] != 3
- || $last != 0x0029
+ [\fBscan\fR $string " (%f ,%f %c" x y last] != 3
+ || $last != 0x0029
} then {
- error "invalid coordinate string"
+ error "invalid coordinate string"
}
puts "X=$x, Y=$y"
.CE
-
+.PP
+An interactive session demonstrating the truncation of integer
+values determined by size modifiers:
+.PP
+.CS
+\fI%\fR set tcl_platform(wordSize)
+4
+\fI%\fR scan 20000000000000000000 %d
+2147483647
+\fI%\fR scan 20000000000000000000 %ld
+9223372036854775807
+\fI%\fR scan 20000000000000000000 %lld
+20000000000000000000
+.CE
.SH "SEE ALSO"
format(n), sscanf(3)
-
.SH KEYWORDS
conversion specifier, parse, scan
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/seek.n b/doc/seek.n
index 6883b98..02c5341 100644
--- a/doc/seek.n
+++ b/doc/seek.n
@@ -5,10 +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: seek.n,v 1.9 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH seek n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ seek \- Change the access position for an open channel
.SH SYNOPSIS
\fBseek \fIchannelId offset \fR?\fIorigin\fR?
.BE
-
.SH DESCRIPTION
.PP
Changes the current access position for \fIchannelId\fR.
@@ -32,24 +29,27 @@ for \fIchannelId\fR. \fIOffset\fR must be an integer (which may be
negative) and \fIorigin\fR must be one of the following:
.TP 10
\fBstart\fR
+.
The new access position will be \fIoffset\fR bytes from the start
of the underlying file or device.
.TP 10
\fBcurrent\fR
+.
The new access position will be \fIoffset\fR bytes from the current
access position; a negative \fIoffset\fR moves the access position
backwards in the underlying file or device.
.TP 10
\fBend\fR
+.
The new access position will be \fIoffset\fR bytes from the end of
the file or device. A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
-.LP
+.PP
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
@@ -59,17 +59,20 @@ Note that \fIoffset\fR values are byte offsets, not character
offsets. Both \fBseek\fR and \fBtell\fR operate in terms of bytes,
not characters, unlike \fBread\fR.
.SH EXAMPLES
+.PP
Read a file twice:
+.PP
.CS
set f [open file.txt]
set data1 [read $f]
\fBseek\fR $f 0
set data2 [read $f]
close $f
-# $data1 == $data2 if the file wasn't updated
+# $data1 eq $data2 if the file wasn't updated
.CE
.PP
Read the last 10 bytes from a file:
+.PP
.CS
set f [open file.data]
# This is guaranteed to work with binary data but
@@ -79,9 +82,11 @@ fconfigure $f -translation binary
set data [read $f 10]
close $f
.CE
-
.SH "SEE ALSO"
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
new file mode 100644
index 0000000..0ad5428
--- /dev/null
+++ b/doc/self.n
@@ -0,0 +1,152 @@
+'\"
+'\" Copyright (c) 2007 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH self n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+self \- method call internal introspection
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBself\fR ?\fIsubcommand\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBself\fR command, which should only be used from within the context of a
+call to a method (i.e. inside a method, constructor or destructor body) is
+used to allow the method to discover information about how it was called. It
+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
+returns a three element list describing the containing object and method. The
+first element describes the declaring object or class of the method, the
+second element is the name of the object on which the containing method was
+invoked, and the third element is the name of the method (with the strings
+\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
+destructors respectively).
+.TP
+\fBself class\fR
+.
+This returns the name of the class that the current method was defined within.
+Note that this will change as the chain of method implementations is traversed
+with \fBnext\fR, and that if the method was defined on an object then this
+will fail.
+.RS
+.PP
+If you want the class of the current object, you need to use this other
+construct:
+.PP
+.CS
+info object class [\fBself object\fR]
+.CE
+.RE
+.TP
+\fBself filter\fR
+.
+When invoked inside a filter, this subcommand returns a three element list
+describing the filter. The first element gives the name of the object or class
+that declared the filter (note that this may be different from the object or
+class that provided the implementation of the filter), the second element is
+either \fBobject\fR or \fBclass\fR depending on whether the declaring entity
+was an object or class, and the third element is the name of the filter.
+.TP
+\fBself method\fR
+.
+This returns the name of the current method (with the strings
+\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
+destructors respectively).
+.TP
+\fBself namespace\fR
+.
+This returns the name of the unique namespace of the object that the method
+was invoked upon.
+.TP
+\fBself next\fR
+.
+When invoked from a method that is not at the end of a call chain (i.e. where
+the \fBnext\fR command will invoke an actual method implementation), this
+subcommand returns a two element list describing the next element in the
+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 empty
+string.
+.TP
+\fBself object\fR
+.
+This returns the name of the object that the method was invoked upon.
+.TP
+\fBself target\fR
+.
+When invoked inside a filter implementation, this subcommand returns a two
+element list describing the method being filtered. The first element will be
+the name of the declarer of the method, and the second element will be the
+actual name of the method.
+.SH EXAMPLES
+.PP
+This example shows basic use of \fBself\fR to provide information about the
+current object:
+.PP
+.CS
+oo::class create c {
+ method foo {} {
+ puts "this is the [\fBself\fR] object"
+ }
+}
+c create a
+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
+call, introspection, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/set.n b/doc/set.n
index 0c947ad..545b15f 100644
--- a/doc/set.n
+++ b/doc/set.n
@@ -5,10 +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: set.n,v 1.6 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH set n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,13 +14,12 @@ set \- Read and write variables
.SH SYNOPSIS
\fBset \fIvarName \fR?\fIvalue\fR?
.BE
-
.SH DESCRIPTION
.PP
Returns the value of variable \fIvarName\fR.
If \fIvalue\fR is specified, then set
the value of \fIvarName\fR to \fIvalue\fR, creating a new variable
-if one doesn't already exist, and return its value.
+if one does not already exist, and return its value.
If \fIvarName\fR contains an open parenthesis and ends with a
close parenthesis, then it refers to an array element: the characters
before the first open parenthesis are the name of the array,
@@ -42,17 +39,21 @@ If a procedure is active and \fIvarName\fR is unqualified, then
unless \fIvarName\fR was declared to resolve differently through one of the
\fBglobal\fR, \fBvariable\fR or \fBupvar\fR commands.
.SH EXAMPLES
+.PP
Store a random number in the variable \fIr\fR:
+.PP
.CS
-\fBset\fR r [expr rand()]
+\fBset\fR r [expr {rand()}]
.CE
.PP
Store a short message in an array element:
+.PP
.CS
\fBset\fR anAry(msg) "Hello, World!"
.CE
.PP
Store a short message in an array element specified by a variable:
+.PP
.CS
\fBset\fR elemName "msg"
\fBset\fR anAry($elemName) "Hello, World!"
@@ -61,15 +62,14 @@ Store a short message in an array element specified by a variable:
Copy a value into the variable \fIout\fR from a variable whose name is
stored in the \fIvbl\fR (note that it is often easier to use arrays in
practice instead of doing double-dereferencing):
+.PP
.CS
\fBset\fR in0 "small random"
\fBset\fR in1 "large random"
\fBset\fR vbl in[expr {rand() >= 0.5}]
\fBset\fR out [\fBset\fR $vbl]
.CE
-
.SH "SEE ALSO"
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
-
.SH KEYWORDS
read, write, variable
diff --git a/doc/socket.n b/doc/socket.n
index 201fff0..b7a4a45 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.12 2004/10/27 14:24:37 dkf Exp $
+.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
-.TH socket n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,21 +17,19 @@ socket \- Open a TCP network connection
.sp
\fBsocket\fR \fB\-server \fIcommand\fR ?\fIoptions\fR? \fIport\fR
.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).
@@ -47,13 +44,14 @@ 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
to specify additional information about the connection:
.TP
\fB\-myaddr\fI addr\fR
+.
\fIAddr\fR gives the domain-style name or numerical IP address of
the client-side network interface to use for the connection.
This option may be useful if the client machine has multiple network
@@ -61,6 +59,7 @@ interfaces. If the option is omitted then the client-side interface
will be chosen by the system software.
.TP
\fB\-myport\fI port\fR
+.
\fIPort\fR specifies an integer port number (or service name, where
supported and understood by the host operating system) to use for the
client's
@@ -68,39 +67,66 @@ side of the connection. If this option is omitted, the client's
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.
+.
+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
+\fBchan configure \fIchan \fB\-blocking 0\fR
+.CE
+.PP
+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
-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 \fIhost\fR:
+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
@@ -109,7 +135,7 @@ channel shuts down the server so that no new connections will be
accepted; however, existing connections will be unaffected.
.PP
Server sockets depend on the Tcl event mechanism to find out when
-new connections are opened. If the application doesn't enter the
+new connections are opened. If the application does not enter the
event loop, for example by invoking the \fBvwait\fR command or
calling the C procedure \fBTcl_DoOneEvent\fR, then no connections
will be accepted.
@@ -117,25 +143,44 @@ 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"
-The \fBfconfigure\fR command can be used to query several readonly
+.PP
+The \fBchan configure\fR command can be used to query several readonly
configuration options for socket channels:
.TP
\fB\-error\fR
+.
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
+.
This option is not supported by server sockets. For client and accepted
sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
@@ -143,29 +188,40 @@ or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
.PP
.SH "EXAMPLES"
+.PP
Here is a very simple time server:
+.PP
.CS
-proc Server {channel clientaddr clientport} {
- puts "Connection from $clientaddr registered"
- puts $channel [clock format [clock seconds]]
- close $channel
+proc Server {startTime channel clientaddr clientport} {
+ puts "Connection from $clientaddr registered"
+ set now [clock seconds]
+ puts $channel [clock format $now]
+ puts $channel "[expr {$now - $startTime}] since start"
+ close $channel
}
-\fBsocket\fR -server Server 9900
+\fBsocket -server\fR [list Server [clock seconds]] 9900
vwait forever
.CE
.PP
-And here is the corresponding client to talk to the server:
+And here is the corresponding client to talk to the server and extract
+some information:
+.PP
.CS
set server localhost
set sockChan [\fBsocket\fR $server 9900]
-gets $sockChan line
+gets $sockChan line1
+gets $sockChan line2
close $sockChan
-puts "The time on $server is $line"
+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
-bind, channel, connection, domain name, host, network address, socket, tcp
+asynchronous I/O, bind, channel, connection, domain name, host, network address, socket, tcp
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/source.n b/doc/source.n
index 6469286..9f488c5 100644
--- a/doc/source.n
+++ b/doc/source.n
@@ -6,10 +6,8 @@
'\" 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.10 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH source n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,11 +15,8 @@ source \- Evaluate a file or resource as a Tcl script
.SH SYNOPSIS
\fBsource \fIfileName\fR
.sp
-.VS 8.5
\fBsource\fR \fB\-encoding \fIencodingName fileName\fR
-.VE 8.5
.BE
-
.SH DESCRIPTION
.PP
This command takes the contents of the specified file or resource
@@ -33,35 +28,42 @@ If a \fBreturn\fR command is invoked from within the script then the
remainder of the file will be skipped and the \fBsource\fR command
will return normally with the result from the \fBreturn\fR command.
.PP
-The end-of-file character for files is '\\32' (^Z) for all platforms.
+The end-of-file character for files is
+.QW \e32
+(^Z) for all platforms.
The source command will read files up to this character. This
restriction does not exist for the \fBread\fR or \fBgets\fR commands,
allowing for files containing code and data segments (scripted documents).
-If you require a ``^Z'' in code for string comparison, you can use
-``\\032'' or ``\\u001a'', which will be safely substituted by the Tcl
-interpreter into ``^Z''.
+If you require a
+.QW ^Z
+in code for string comparison, you can use
+.QW \e032
+or
+.QW \eu001a ,
+which will be safely substituted by the Tcl interpreter into
+.QW ^Z .
.PP
-.VS 8.5
-The \fB-encoding\fR option is used to specify the encoding of
-the data stored in \fIfileName\fR. When the \fB-encoding\fR option
+The \fB\-encoding\fR option is used to specify the encoding of
+the data stored in \fIfileName\fR. When the \fB\-encoding\fR option
is omitted, the system encoding is assumed.
-.VE 8.5
.SH EXAMPLE
+.PP
Run the script in the file \fBfoo.tcl\fR and then the script in the
file \fBbar.tcl\fR:
+.PP
.CS
\fBsource\fR foo.tcl
\fBsource\fR bar.tcl
.CE
+.PP
Alternatively:
+.PP
.CS
foreach scriptFile {foo.tcl bar.tcl} {
- \fBsource\fR $scriptFile
+ \fBsource\fR $scriptFile
}
.CE
-
.SH "SEE ALSO"
file(n), cd(n), encoding(n), info(n)
-
.SH KEYWORDS
file, script
diff --git a/doc/split.n b/doc/split.n
index 1333716..f1c66d0 100644
--- a/doc/split.n
+++ b/doc/split.n
@@ -5,10 +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: split.n,v 1.5 2004/10/27 14:24:37 dkf Exp $
-'\"
-.so man.macros
.TH split n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ split \- Split a string into a proper Tcl list
.SH SYNOPSIS
\fBsplit \fIstring \fR?\fIsplitChars\fR?
.BE
-
.SH DESCRIPTION
.PP
Returns a list created by splitting \fIstring\fR at each character
@@ -31,34 +28,41 @@ If \fIsplitChars\fR is an empty string then each character of
\fIstring\fR becomes a separate element of the result list.
\fISplitChars\fR defaults to the standard white-space characters.
.SH EXAMPLES
+.PP
Divide up a USENET group name into its hierarchical components:
+.PP
.CS
-\fBsplit\fR "comp.lang.tcl.announce" .
- \fI=> comp lang tcl announce\fR
+\fBsplit\fR "comp.lang.tcl" .
+ \fI\(-> comp lang tcl\fR
.CE
.PP
See how the \fBsplit\fR command splits on \fIevery\fR character in
\fIsplitChars\fR, which can result in information loss if you are not
careful:
+.PP
.CS
\fBsplit\fR "alpha beta gamma" "temp"
- \fI=> al {ha b} {} {a ga} {} a\fR
+ \fI\(-> al {ha b} {} {a ga} {} a\fR
.CE
.PP
Extract the list words from a string that is not a well-formed list:
+.PP
.CS
\fBsplit\fR "Example with {unbalanced brace character"
- \fI=> Example with \\{unbalanced brace character\fR
+ \fI\(-> Example with \e{unbalanced brace character\fR
.CE
.PP
Split a string into its constituent characters
+.PP
.CS
\fBsplit\fR "Hello world" {}
- \fI=> H e l l o { } w o r l d\fR
+ \fI\(-> H e l l o { } w o r l d\fR
.CE
.SS "PARSING RECORD-ORIENTED FILES"
+.PP
Parse a Unix /etc/passwd file, which consists of one entry per line,
with each line consisting of a colon-separated list of fields:
+.PP
.CS
## Read the file
set fid [open /etc/passwd]
@@ -66,23 +70,24 @@ set content [read $fid]
close $fid
## Split into records on newlines
-set records [\fBsplit\fR $content "\\n"]
+set records [\fBsplit\fR $content "\en"]
## Iterate over the records
foreach rec $records {
- ## Split into fields on colons
- set fields [\fBsplit\fR $rec ":"]
+ ## Split into fields on colons
+ set fields [\fBsplit\fR $rec ":"]
- ## Assign fields to variables and print some out...
- lassign $fields \\
- userName password uid grp longName homeDir shell
- puts "$longName uses [file tail $shell] for a login shell"
+ ## Assign fields to variables and print some out...
+ lassign $fields \e
+ userName password uid grp longName homeDir shell
+ puts "$longName uses [file tail $shell] for a login shell"
}
.CE
-
.SH "SEE ALSO"
join(n), list(n), string(n)
-
.SH KEYWORDS
list, split, string
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/string.n b/doc/string.n
index 1a1c187..163abdd 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -1,38 +1,26 @@
-'\"
-'\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 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: string.n,v 1.29 2005/05/23 17:41:00 das Exp $
-'\"
-.so man.macros
+.\"
+.\" Copyright (c) 1993 The Regents of the University of California.
+.\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+.\"
+.\" See the file "license.terms" for information on usage and redistribution
+.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+.\"
.TH string n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
-'\" Note: do not modify the .SH NAME line immediately below!
+.\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...?\fR
.BE
-
.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
-\fBstring bytelength \fIstring\fR
-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
-\fBstring length\fR operation (including determining the length of a
-Tcl ByteArray object). Refer to the \fBTcl_NumUtfChars\fR manual
-entry for more details on the UTF\-8 representation.
-.TP
-\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
+\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
+.
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR. Returns \-1, 0, or 1, depending on whether
\fIstring1\fR is lexicographically less than, equal to, or greater
@@ -41,7 +29,8 @@ first \fIlength\fR characters are used in the comparison. If
\fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is
specified, then the strings are compared in a case-insensitive manner.
.TP
-\fBstring equal\fR ?\fB\-nocase\fR? ?\fB-length int\fR? \fIstring1 string2\fR
+\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
+.
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR. Returns 1 if \fIstring1\fR and \fIstring2\fR are
identical, or 0 when not. If \fB\-length\fR is specified, then only
@@ -49,70 +38,51 @@ the first \fIlength\fR characters are used in the comparison. If
\fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is
specified, then the strings are compared in a case-insensitive manner.
.TP
-\fBstring first \fIstring1 string2\fR ?\fIstartIndex\fR?
-Search \fIstring2\fR for a sequence of characters that exactly match
-the characters in \fIstring1\fR. If found, return the index of the
-first character in the first such match within \fIstring2\fR. If not
+\fBstring first \fIneedleString haystackString\fR ?\fIstartIndex\fR?
+.
+Search \fIhaystackString\fR for a sequence of characters that exactly match
+the characters in \fIneedleString\fR. If found, return the index of the
+first character in the first such match within \fIhaystackString\fR. If not
found, return \-1. If \fIstartIndex\fR is specified (in any of the
-forms accepted by the \fBindex\fR method), then the search is
-constrained to start with the character in \fIstring2\fR specified by
+forms described in \fBSTRING INDICES\fR), then the search is
+constrained to start with the character in \fIhaystackString\fR specified by
the index. For example,
.RS
+.PP
.CS
\fBstring first a 0a23456789abcdef 5\fR
.CE
+.PP
will return \fB10\fR, but
+.PP
.CS
\fBstring first a 0123456789abcdef 11\fR
.CE
+.PP
will return \fB\-1\fR.
.RE
.TP
\fBstring index \fIstring charIndex\fR
+.
Returns the \fIcharIndex\fR'th character of the \fIstring\fR argument.
A \fIcharIndex\fR of 0 corresponds to the first character of the
-string. \fIcharIndex\fR may be specified as follows:
-.VS 8.5
+string. \fIcharIndex\fR may be specified as described in the
+\fBSTRING INDICES\fR section.
.RS
-.IP \fIinteger\fR 10
-For any index value that passes \fBstring is integer -strict\fR,
-the char specified at this integral index
-(e.g. \fB2\fR would refer to the "c" in "abcd").
-.IP \fBend\fR 10
-The last char of the string
-(e.g. \fBend\fR would refer to the "d" in "abcd").
-.IP \fBend\fR\-\fIN\fR 10
-The last char of the string minus the specified integer offset \fIN\fR
-(e.g. \fBend\fR\-1 would refer to the "c" in "abcd").
-.IP \fBend\fR+\fIN\fR 10
-The last char of the string plus the specified integer offset \fIN\fR
-(e.g. \fBend\fR+\-1 would refer to the "c" in "abcd").
-.IP \fIM\fR+\fIN\fR 10
-The char specified at the integral index that is the sum of
-integer values \fIM\fR and \fIN\fR
-(e.g. \fB1+1\fR would refer to the "c" in "abcd").
-.IP \fIM\fR\-\fIN\fR 10
-The char specified at the integral index that is the difference of
-integer values \fIM\fR and \fIN\fR
-(e.g. \fB2\-1\fR would refer to the "b" in "abcd").
-.PP
-In the specifications above, the integer value \fIM\fR contains no
-trailing whitespace and the integer value \fIN\fR contains no
-leading whitespace.
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
-.VE
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
+.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0. If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class. If \fB\-failindex\fR is specified, then if the function
returns 0, the index in the string where the class was no longer valid
will be stored in the variable named \fIvarname\fR. The \fIvarname\fR
-will not be set if the function returns 1. The following character
+will not be set if \fBstring is\fR returns 1. The following character
classes are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 12
@@ -120,7 +90,7 @@ Any Unicode alphabet or digit character.
.IP \fBalpha\fR 12
Any Unicode alphabet character.
.IP \fBascii\fR 12
-Any character with a value less than \\u0080 (those that are in the
+Any character with a value less than \eu0080 (those that are in the
7\-bit ascii range).
.IP \fBboolean\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR.
@@ -133,15 +103,27 @@ 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.
.IP \fBgraph\fR 12
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
-Any of the valid forms for an ordinary integer in Tcl, with optional
-surrounding whitespace. In case of under/overflow in the value, 0 is
-returned and the \fIvarname\fR will contain \-1.
+Any of the valid string formats for a 32-bit integer value 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 \fBlist\fR 12
+Any proper list structure, with optional surrounding whitespace. In
+case of improper list structure, 0 is returned and the \fIvarname\fR
+will contain the index of the
+.QW element
+where the list parsing fails, or \-1 if this cannot be determined.
.IP \fBlower\fR 12
Any Unicode lower case alphabet character.
.IP \fBprint\fR 12
@@ -149,18 +131,17 @@ 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.
.IP \fBupper\fR 12
Any upper case alphabet character in the Unicode character set.
-.VS 8.5
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
surrounding whitespace. In case of under/overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
-.VE 8.5
.IP \fBwordchar\fR 12
Any Unicode word character. That is any alphanumeric character, and
any Unicode connector punctuation characters (e.g. underscore).
@@ -172,33 +153,40 @@ function will return 0, then the \fIvarname\fR will always be set to
0, due to the varied nature of a valid boolean value.
.RE
.TP
-\fBstring last \fIstring1 string2\fR ?\fIlastIndex\fR?
-Search \fIstring2\fR for a sequence of characters that exactly match
-the characters in \fIstring1\fR. If found, return the index of the
-first character in the last such match within \fIstring2\fR. If there
+\fBstring last \fIneedleString haystackString\fR ?\fIlastIndex\fR?
+.
+Search \fIhaystackString\fR for a sequence of characters that exactly match
+the characters in \fIneedleString\fR. If found, return the index of the
+first character in the last such match within \fIhaystackString\fR. If there
is no match, then return \-1. If \fIlastIndex\fR is specified (in any
-of the forms accepted by the \fBindex\fR method), then only the
-characters in \fIstring2\fR at or before the specified \fIlastIndex\fR
+of the forms described in \fBSTRING INDICES\fR), then only the
+characters in \fIhaystackString\fR at or before the specified \fIlastIndex\fR
will be considered by the search. For example,
.RS
+.PP
.CS
\fBstring last a 0a23456789abcdef 15\fR
.CE
+.PP
will return \fB10\fR, but
+.PP
.CS
\fBstring last a 0a23456789abcdef 9\fR
.CE
+.PP
will return \fB1\fR.
.RE
.TP
\fBstring length \fIstring\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
+.
Replaces substrings in \fIstring\fR based on the key-value pairs in
\fImapping\fR. \fImapping\fR is a list of \fIkey value key value ...\fR
as in the form returned by \fBarray get\fR. Each instance of a
@@ -210,23 +198,28 @@ appearing first in the list will be checked first, and so on.
\fIstring\fR is only iterated over once, so earlier key replacements
will have no affect for later key matches. For example,
.RS
+.PP
.CS
\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR
.CE
+.PP
will return the string \fB01321221\fR.
.PP
Note that if an earlier \fIkey\fR is a prefix of a later one, it will
completely mask the later one. So if the previous example is
reordered like this,
+.PP
.CS
\fBstring map {1 0 ab 2 a 3 abc 1} 1abcaababcabababc\fR
.CE
+.PP
it will return the string \fB02c322c222c\fR.
.RE
.TP
\fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR
+.
See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0 if
-it doesn't. If \fB\-nocase\fR is specified, then the pattern attempts
+it does not. If \fB\-nocase\fR is specified, then the pattern attempts
to match against the string in a case insensitive manner. For the two
strings to match, their contents must be identical except that the
following special sequences may appear in \fIpattern\fR:
@@ -241,10 +234,16 @@ Matches any character in the set given by \fIchars\fR. If a sequence
of the form \fIx\fB\-\fIy\fR appears in \fIchars\fR, then any
character between \fIx\fR and \fIy\fR, inclusive, will match. When
used with \fB\-nocase\fR, the end points of the range are converted to
-lower case first. Whereas {[A\-z]} matches '_' when matching
-case-sensitively ('_' falls between the 'Z' and 'a'), with
-\fB\-nocase\fR this is considered like {[A\-Za\-z]} (and probably what
-was meant in the first place).
+lower case first. Whereas {[A\-z]} matches
+.QW _
+when matching case-sensitively (since
+.QW _
+falls between the
+.QW Z
+and
+.QW a ),
+with \fB\-nocase\fR this is considered like {[A\-Za\-z]} (and
+probably what was meant in the first place).
.IP \fB\e\fIx\fR 10
Matches the single character \fIx\fR. This provides a way of avoiding
the special interpretation of the characters \fB*?[]\e\fR in
@@ -252,6 +251,7 @@ the special interpretation of the characters \fB*?[]\e\fR in
.RE
.TP
\fBstring range \fIstring first last\fR
+.
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR. An index of 0 refers to the first
@@ -263,9 +263,11 @@ equal to the length of the string then it is treated as if it were
string is returned.
.TP
\fBstring repeat \fIstring count\fR
+.
Returns \fIstring\fR repeated \fIcount\fR number of times.
.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
+.
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR. An index of 0 refers to the
@@ -278,83 +280,190 @@ then it is treated as if it were \fBend\fR. If \fIfirst\fR is greater
than \fIlast\fR or the length of the initial string, or \fIlast\fR is
less than 0, then the initial string is returned untouched.
.TP
+\fBstring reverse \fIstring\fR
+.
+Returns a string that is the same length as \fIstring\fR but with its
+characters in the reverse order.
+.TP
\fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+.
Returns a value equal to \fIstring\fR except that all upper (or title)
case letters have been converted to lower case. If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying. If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
-specified as for the \fBindex\fR method.
+specified using the forms described in \fBSTRING INDICES\fR.
.TP
\fBstring totitle \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+.
Returns a value equal to \fIstring\fR except that the first character
in \fIstring\fR is converted to its Unicode title case variant (or
upper case if there is no title case variant) and the rest of the
string is converted to lower case. If \fIfirst\fR is specified, it
refers to the first char index in the string to start modifying. If
\fIlast\fR is specified, it refers to the char index in the string to
-stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified as
-for the \fBindex\fR method.
+stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified
+using the forms described in \fBSTRING INDICES\fR.
.TP
\fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+.
Returns a value equal to \fIstring\fR except that all lower (or title)
case letters have been converted to upper case. If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying. If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
-specified as for the \fBindex\fR method.
+specified using the forms described in \fBSTRING INDICES\fR.
.TP
\fBstring trim \fIstring\fR ?\fIchars\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").
+.SS "OBSOLETE SUBCOMMANDS"
+.PP
+These subcommands are currently supported, but are likely to go away in a
+future release as their functionality is either virtually never used or highly
+misleading.
+.TP
+\fBstring bytelength \fIstring\fR
+.
+Returns a decimal string giving the number of bytes used to represent
+\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
+Tcl may use other encodings for \fIstring\fR as well, and does not
+guarantee to only use a single encoding for a particular \fIstring\fR.
+Because UTF\-8 uses a variable number of 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.
+.RS
+.PP
+In almost all cases, you should use the
+\fBstring length\fR operation (including determining the length of a
+Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual
+entry for more details on the UTF\-8 representation.
+.PP
+Formally, the \fBstring bytelength\fR operation returns the content of
+the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
+\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
+This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
+encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
+denormalized NUL (identical to that used in a number of places by
+Java's serialization mechanism) to enable basic processing with
+non-Unicode-aware C functions. As this representation should only
+ever be used by Tcl's implementation, the number of bytes used to
+store the representation is of very low value (except to C extension
+code, which has direct access for the purpose of memory management,
+etc.)
+.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
+\fBencoding convertto\fR command to convert a string to a known
+encoding and then apply \fBstring length\fR to that.
+.PP
+.CS
+\fBstring length\fR [encoding convertto utf-8 $theString]
+.CE
+.RE
.TP
\fBstring wordend \fIstring charIndex\fR
+.
Returns the index of the character just after the last one in the word
containing character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR
-may be specified as for the \fBindex\fR method. A word is
+may be specified using the forms in \fBSTRING INDICES\fR. A word is
considered to be any contiguous range of alphanumeric (Unicode letters
or decimal digits) or underscore (Unicode connector punctuation)
characters, or any single character other than these.
.TP
\fBstring wordstart \fIstring charIndex\fR
-Returns the index of the first character in the word containing
-character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR may be
-specified as for the \fBindex\fR method. A word is considered to be any
-contiguous range of alphanumeric (Unicode letters or decimal digits)
-or underscore (Unicode connector punctuation) characters, or any
-single character other than these.
+.
+Returns the index of the first character in the word containing character
+\fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR may be specified using the
+forms in \fBSTRING INDICES\fR. A word is considered to be any contiguous
+range of alphanumeric (Unicode letters or decimal digits) or underscore
+(Unicode connector punctuation) characters, or any single character other than
+these.
+.SH "STRING INDICES"
+.PP
+When referring to indices into a string (e.g., for \fBstring index\fR
+or \fBstring range\fR) the following formats are supported:
+.IP \fIinteger\fR 10
+For any index value that passes \fBstring is integer \-strict\fR,
+the char specified at this integral index (e.g., \fB2\fR would refer to the
+.QW c
+in
+.QW abcd ).
+.IP \fBend\fR 10
+The last char of the string (e.g., \fBend\fR would refer to the
+.QW d
+in
+.QW abcd ).
+.IP \fBend\-\fIN\fR 10
+The last char of the string minus the specified integer offset \fIN\fR (e.g.,
+.QW \fBend\-1\fR
+would refer to the
+.QW c
+in
+.QW abcd ).
+.IP \fBend+\fIN\fR 10
+The last char of the string plus the specified integer offset \fIN\fR (e.g.,
+.QW \fBend+\-1\fR
+would refer to the
+.QW c
+in
+.QW abcd ).
+.IP \fIM\fB+\fIN\fR 10
+The char specified at the integral index that is the sum of
+integer values \fIM\fR and \fIN\fR (e.g.,
+.QW \fB1+1\fR
+would refer to the
+.QW c
+in
+.QW abcd ).
+.IP \fIM\fB\-\fIN\fR 10
+The char specified at the integral index that is the difference of
+integer values \fIM\fR and \fIN\fR (e.g.,
+.QW \fB2\-1\fR
+would refer to the
+.QW b
+in
+.QW abcd ).
+.PP
+In the specifications above, the integer value \fIM\fR contains no
+trailing whitespace and the integer value \fIN\fR contains no
+leading whitespace.
.SH EXAMPLE
+.PP
Test if the string in the variable \fIstring\fR is a proper non-empty
prefix of the string \fBfoobar\fR.
+.PP
.CS
set length [\fBstring length\fR $string]
if {$length == 0} {
- set isPrefix 0
+ set isPrefix 0
} else {
- set isPrefix [\fBstring equal\fR -length $string $string "foobar"]
+ set isPrefix [\fBstring equal\fR \-length $length $string "foobar"]
}
.CE
-
.SH "SEE ALSO"
expr(n), list(n)
-
.SH KEYWORDS
-case conversion, compare, index, match, pattern, string, word, equal, ctype
-
-'\" Local Variables:
-'\" mode: nroff
-'\" End:
+case conversion, compare, index, match, pattern, string, word, equal,
+ctype, character, reverse
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/subst.n b/doc/subst.n
index 46572a8..990b9d3 100644
--- a/doc/subst.n
+++ b/doc/subst.n
@@ -6,10 +6,8 @@
'\" 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.8 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH subst n 7.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,7 +15,6 @@ subst \- Perform backslash, command, and variable substitutions
.SH SYNOPSIS
\fBsubst \fR?\fB\-nobackslashes\fR? ?\fB\-nocommands\fR? ?\fB\-novariables\fR? \fIstring\fR
.BE
-
.SH DESCRIPTION
.PP
This command performs variable substitutions, command substitutions,
@@ -37,13 +34,13 @@ is not performed: open and close brackets are treated as ordinary characters
with no special interpretation.
.PP
Note that the substitution of one kind can include substitution of
-other kinds. For example, even when the \fB-novariables\fR option
+other kinds. For example, even when the \fB\-novariables\fR option
is specified, command substitution is performed without restriction.
This means that any variable substitution necessary to complete the
command substitution will still take place. Likewise, any command
substitution necessary to complete a variable substitution will
-take place, even when \fB-nocommands\fR is specified. See the
-EXAMPLES below.
+take place, even when \fB\-nocommands\fR is specified. See the
+\fBEXAMPLES\fR below.
.PP
If an error occurs during substitution, then \fBsubst\fR will return
that error. If a break exception occurs during command or variable
@@ -55,67 +52,113 @@ will be substituted for that entire command or variable substitution
(as long as it is well-formed Tcl.) If a return exception occurs,
or any other return code is returned during command or variable
substitution, then the returned value is substituted for that
-substitution. See the EXAMPLES below. In this way, all exceptional
-return codes are ``caught'' by \fBsubst\fR. The \fBsubst\fR command
+substitution. See the \fBEXAMPLES\fR below. In this way, all exceptional
+return codes are
+.QW caught
+by \fBsubst\fR. The \fBsubst\fR command
itself will either return an error, or will complete successfully.
.SH EXAMPLES
.PP
When it performs its substitutions, \fIsubst\fR does not give any
special treatment to double quotes or curly braces (except within
command substitutions) so the script
+.PP
.CS
set a 44
\fBsubst\fR {xyz {$a}}
.CE
-returns ``\fBxyz {44}\fR'', not ``\fBxyz {$a}\fR''
+.PP
+returns
+.QW "\fBxyz {44}\fR" ,
+not
+.QW "\fBxyz {$a}\fR"
and the script
+.PP
.CS
-set a "p\\} q \\{r"
+set a "p\e} q \e{r"
\fBsubst\fR {xyz {$a}}
.CE
-return ``\fBxyz {p} q {r}\fR'', not ``\fBxyz {p\\} q \\{r}\fR''.
+.PP
+returns
+.QW "\fBxyz {p} q {r}\fR" ,
+not
+.QW "\fBxyz {p\e} q \e{r}\fR".
.PP
When command substitution is performed, it includes any variable
-substitution necessary to evaluate the script.
+substitution necessary to evaluate the script.
+.PP
.CS
set a 44
\fBsubst\fR -novariables {$a [format $a]}
.CE
-returns ``\fB$a 44\fR'', not ``\fB$a $a\fR''. Similarly, when
+.PP
+returns
+.QW "\fB$a 44\fR" ,
+not
+.QW "\fB$a $a\fR" .
+Similarly, when
variable substitution is performed, it includes any command
substitution necessary to retrieve the value of the variable.
+.PP
.CS
proc b {} {return c}
array set a {c c [b] tricky}
\fBsubst\fR -nocommands {[b] $a([b])}
.CE
-returns ``\fB[b] c\fR'', not ``\fB[b] tricky\fR''.
+.PP
+returns
+.QW "\fB[b] c\fR" ,
+not
+.QW "\fB[b] tricky\fR" .
.PP
The continue and break exceptions allow command substitutions to
prevent substitution of the rest of the command substitution and the
rest of \fIstring\fR respectively, giving script authors more options
when processing text using \fIsubst\fR. For example, the script
+.PP
.CS
\fBsubst\fR {abc,[break],def}
.CE
-returns ``\fBabc,\fR'', not ``\fBabc,,def\fR'' and the script
+.PP
+returns
+.QW \fBabc,\fR ,
+not
+.QW \fBabc,,def\fR
+and the script
+.PP
.CS
-\fBsubst\fR {abc,[continue;expr 1+2],def}
+\fBsubst\fR {abc,[continue;expr {1+2}],def}
.CE
-returns ``\fBabc,,def\fR'', not ``\fBabc,3,def\fR''.
+.PP
+returns
+.QW \fBabc,,def\fR ,
+not
+.QW \fBabc,3,def\fR .
.PP
Other exceptional return codes substitute the returned value
+.PP
.CS
-\fBsubst\fR {abc,[return foo;expr 1+2],def}
+\fBsubst\fR {abc,[return foo;expr {1+2}],def}
.CE
-returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR'' and
+.PP
+returns
+.QW \fBabc,foo,def\fR ,
+not
+.QW \fBabc,3,def\fR
+and
+.PP
.CS
-\fBsubst\fR {abc,[return -code 10 foo;expr 1+2],def}
+\fBsubst\fR {abc,[return -code 10 foo;expr {1+2}],def}
.CE
-also returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR''.
-
+.PP
+also returns
+.QW \fBabc,foo,def\fR ,
+not
+.QW \fBabc,3,def\fR .
.SH "SEE ALSO"
Tcl(n), eval(n), break(n), continue(n)
-
.SH KEYWORDS
-backslash substitution, command substitution, variable substitution
+backslash substitution, command substitution, quoting, substitution, variable substitution
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/switch.n b/doc/switch.n
index 83103cb..6e27f56 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -5,10 +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: switch.n,v 1.9 2005/06/01 11:00:33 dkf Exp $
-'\"
-.so man.macros
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -18,7 +16,6 @@ switch \- Evaluate one of several scripts, depending on a given value
.sp
\fBswitch \fR?\fIoptions\fR?\fI string \fR{\fIpattern body \fR?\fIpattern body \fR...?}
.BE
-
.SH DESCRIPTION
.PP
The \fBswitch\fR command matches its \fIstring\fR argument against each of
@@ -33,28 +30,34 @@ matches \fIstring\fR and no default is given, then the \fBswitch\fR
command returns an empty string.
.PP
If the initial arguments to \fBswitch\fR start with \fB\-\fR then
-they are treated as options. The following options are
-currently supported:
+they are treated as options
+unless there are exactly two arguments to \fBswitch\fR (in which case the
+first must the \fIstring\fR and the second must be the
+\fIpattern\fR/\fIbody\fR list).
+The following options are currently supported:
.TP 10
\fB\-exact\fR
+.
Use exact matching when comparing \fIstring\fR to a pattern. This
is the default.
.TP 10
\fB\-glob\fR
+.
When matching \fIstring\fR to the patterns, use glob-style matching
(i.e. the same as implemented by the \fBstring match\fR command).
.TP 10
\fB\-regexp\fR
+.
When matching \fIstring\fR to the patterns, use regular
expression matching
(as described in the \fBre_syntax\fR reference page).
-'\" Options defined by TIP#75
-.VS 8.5
.TP 10
\fB\-nocase\fR
+.
Causes comparisons to be handled in a case-insensitive manner.
.TP 10
\fB\-matchvar\fR \fIvarName\fR
+.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of matches
found by the regular expression engine will be written. The first
@@ -67,6 +70,7 @@ empty list written to it. This option may be specified at the same
time as the \fB\-indexvar\fR option.
.TP 10
\fB\-indexvar\fR \fIvarName\fR
+.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of indices
referring to matching substrings
@@ -81,11 +85,13 @@ capturing parenthesis in the regular expression that matched, and so
on. When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it. This option may be specified at the same
time as the \fB\-matchvar\fR option.
-.VE 8.5
.TP 10
\fB\-\|\-\fR
+.
Marks the end of options. The argument following this one will
be treated as \fIstring\fR even if it starts with a \fB\-\fR.
+This is not required when the matching patterns and bodies are grouped
+together in a single argument.
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
@@ -102,9 +108,12 @@ no command or variable substitutions are performed on them; this makes
the behavior of the second form different than the first form in some
cases.
.PP
-If a \fIbody\fR is specified as ``\fB\-\fR'' it means that the \fIbody\fR
+If a \fIbody\fR is specified as
+.QW \fB\-\fR
+it means that the \fIbody\fR
for the next pattern should also be used as the body for this
-pattern (if the next pattern also has a body of ``\fB\-\fR''
+pattern (if the next pattern also has a body of
+.QW \fB\-\fR
then the body after that is used, and so on).
This feature makes it possible to share a single \fIbody\fR among
several patterns.
@@ -113,61 +122,65 @@ Beware of how you place comments in \fBswitch\fR commands. Comments
should only be placed \fBinside\fR the execution body of one of the
patterns, and not intermingled with the patterns.
.SH "EXAMPLES"
+.PP
The \fBswitch\fR command can match against variables and not just
literals, as shown here (the result is \fI2\fR):
+.PP
.CS
set foo "abc"
-\fBswitch\fR abc a \- b {expr 1} $foo {expr 2} default {expr 3}
+\fBswitch\fR abc a \- b {expr {1}} $foo {expr {2}} default {expr {3}}
.CE
.PP
Using glob matching and the fall-through body is an alternative to
writing regular expressions with alternations, as can be seen here
(this returns \fI1\fR):
+.PP
.CS
\fBswitch\fR \-glob aaab {
- a*b \-
- b {expr 1}
- a* {expr 2}
- default {expr 3}
+ a*b \-
+ b {expr {1}}
+ a* {expr {2}}
+ default {expr {3}}
}
.CE
.PP
Whenever nothing matches, the \fBdefault\fR clause (which must be
last) is taken. This example has a result of \fI3\fR:
+.PP
.CS
\fBswitch\fR xyz {
- a \-
- b {
- # Correct Comment Placement
- expr 1
- }
- c {
- expr 2
- }
- default {
- expr 3
- }
+ a \-
+ b {
+ # Correct Comment Placement
+ expr {1}
+ }
+ c {
+ expr {2}
+ }
+ default {
+ expr {3}
+ }
}
.CE
.PP
-.VS 8.5
When matching against regular expressions, information about what
exactly matched is easily obtained using the \fB\-matchvar\fR option:
+.PP
.CS
-\fBswitch\fR -regexp -matchvar foo -- $bar {
- a(b*)c {
- puts "Found [string length [lindex $foo 1]] 'b's"
- }
- d(e*)f(g*)h {
- puts "Found [string length [lindex $foo 1]] 'e's and\\
- [string length [lindex $foo 2]] 'g's"
- }
+\fBswitch\fR \-regexp \-matchvar foo \-\- $bar {
+ a(b*)c {
+ puts "Found [string length [lindex $foo 1]] 'b's"
+ }
+ d(e*)f(g*)h {
+ puts "Found [string length [lindex $foo 1]] 'e's and\e
+ [string length [lindex $foo 2]] 'g's"
+ }
}
.CE
-.VE 8.5
-
.SH "SEE ALSO"
for(n), if(n), regexp(n)
-
.SH KEYWORDS
switch, match, regular expression
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/tailcall.n b/doc/tailcall.n
new file mode 100644
index 0000000..926c608
--- /dev/null
+++ b/doc/tailcall.n
@@ -0,0 +1,69 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH tailcall n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tailcall \- Replace the current procedure with another command
+.SH SYNOPSIS
+\fBtailcall \fIcommand\fR ?\fIarg ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The \fBtailcall\fR command replaces the currently executing procedure, lambda
+application, or method with another command. The \fIcommand\fR, which will
+have \fIarg ...\fR passed as arguments if they are supplied, will be looked up
+in the current namespace context, not in the caller's. Apart from that
+difference in resolution, it is equivalent to:
+.PP
+.CS
+return [uplevel 1 [list \fIcommand\fR ?\fIarg ...\fR?]]
+.CE
+.PP
+This command may not be invoked from within an \fBuplevel\fR into a procedure
+or inside a \fBcatch\fR inside a procedure or lambda.
+'\" TODO: sort out the mess with the [try] command!
+.SH EXAMPLE
+.PP
+Compute the factorial of a number.
+.PP
+.CS
+proc factorial {n {accum 1}} {
+ if {$n < 2} {
+ return $accum
+ }
+ \fBtailcall\fR factorial [expr {$n - 1}] [expr {$accum * $n}]
+}
+.CE
+.PP
+Print the elements of a list with alternating lines having different
+indentations.
+.PP
+.CS
+proc printList {theList} {
+ if {[llength $theList]} {
+ puts "> [lindex $theList 0]"
+ \fBtailcall\fR printList2 [lrange $theList 1 end]
+ }
+}
+proc printList2 {theList} {
+ if {[llength $theList]} {
+ puts "< [lindex $theList 0]"
+ \fBtailcall\fR printList [lrange $theList 1 end]
+ }
+}
+.CE
+.SH "SEE ALSO"
+apply(n), proc(n), uplevel(n)
+.SH KEYWORDS
+call, recursion, tail recursion
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index b8a73d8..6ed5eb6 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -5,18 +5,15 @@
'\" 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.10 2004/09/06 09:44:57 dkf Exp $
-'\"
-.so man.macros
.TH tclsh 1 "" Tcl "Tcl Applications"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.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
\fBTclsh\fR is a shell-like application that reads Tcl commands
@@ -30,52 +27,57 @@ If there exists a file \fB.tclshrc\fR (or \fBtclshrc.tcl\fR on
the Windows platforms) in the home directory of
the user, interactive \fBtclsh\fR evaluates the file as a Tcl script
just before reading the first command from standard input.
-
.SH "SCRIPT FILES"
.PP
-.VS 8.5
If \fBtclsh\fR is invoked with arguments then the first few arguments
specify the name of a script file, and, optionally, the encoding of
-the text data stored in that script file.
-.VE 8.5
-Any additional arguments
+the text data stored in that script file. Any additional arguments
are made available to the script as variables (see below).
Instead of reading commands from standard input \fBtclsh\fR will
read Tcl commands from the named file; \fBtclsh\fR will exit
when it reaches the end of the file.
The end of the file may be marked either by the physical end of
-the medium, or by the character, '\\032' ('\\u001a', control-Z).
+the medium, or by the character,
+.QW \e032
+.PQ \eu001a ", control-Z" .
If this character is present in the file, the \fBtclsh\fR application
will read text up to but not including the character. An application
that requires this character in the file may safely encode it as
-``\\032'', ``\\x1a'', or ``\\u001a''; or may generate it by use of commands
-such as \fBformat\fR or \fBbinary\fR.
+.QW \e032 ,
+.QW \ex1a ,
+or
+.QW \eu001a ;
+or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
line, but the script file can always \fBsource\fR it if desired.
.PP
If you create a Tcl script in a file whose first line is
+.PP
.CS
\fB#!/usr/local/bin/tclsh\fR
.CE
+.PP
then you can invoke the script file directly from your shell if
you mark the file as executable.
This assumes that \fBtclsh\fR has been installed in the default
-location in /usr/local/bin; if it's installed somewhere else
-then you'll have to modify the above line to match.
+location in /usr/local/bin; if it is installed somewhere else
+then you will have to modify the above line to match.
Many UNIX systems do not allow the \fB#!\fR line to exceed about
30 characters in length, so be sure that the \fBtclsh\fR
executable can be accessed with a short file name.
.PP
An even better approach is to start your script files with the
following three lines:
+.PP
.CS
\fB#!/bin/sh
# the next line restarts using tclsh \e
-exec tclsh "$0" "$@"\fR
+exec tclsh "$0" ${1+"$@"}\fR
.CE
+.PP
This approach has three advantages over the approach in the previous
-paragraph. First, the location of the \fBtclsh\fR binary doesn't have
+paragraph. First, the location of the \fBtclsh\fR binary does not have
to be hard-wired into the script: it can be anywhere in your shell
search path. Second, it gets around the 30-character file name limit
in the previous approach.
@@ -98,47 +100,50 @@ its version number as part of the name. This has the advantage of
allowing multiple versions of Tcl to exist on the same system at once,
but also the disadvantage of making it harder to write scripts that
start up uniformly across different versions of Tcl.
-
.SH "VARIABLES"
.PP
-\fBTclsh\fR sets the following Tcl variables:
+\fBTclsh\fR sets the following global Tcl variables in addition to those
+created by the Tcl library itself (such as \fBenv\fR, which maps
+environment variables such as \fBPATH\fR into Tcl):
.TP 15
\fBargc\fR
+.
Contains a count of the number of \fIarg\fR arguments (0 if none),
not including the name of the script file.
.TP 15
\fBargv\fR
+.
Contains a Tcl list whose elements are the \fIarg\fR arguments,
in order, or an empty string if there are no \fIarg\fR arguments.
.TP 15
\fBargv0\fR
+.
Contains \fIfileName\fR if it was specified.
Otherwise, contains the name by which \fBtclsh\fR was invoked.
.TP 15
\fBtcl_interactive\fR
+.
Contains 1 if \fBtclsh\fR is running interactively (no
\fIfileName\fR was specified and standard input is a terminal-like
device), 0 otherwise.
-
.SH PROMPTS
.PP
When \fBtclsh\fR is invoked interactively it normally prompts for each
-command with ``\fB% \fR''. You can change the prompt by setting the
+command with
+.QW "\fB% \fR" .
+You can change the prompt by setting the global
variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable
\fBtcl_prompt1\fR exists then it must consist of a Tcl script
to output a prompt; instead of outputting a prompt \fBtclsh\fR
will evaluate the script in \fBtcl_prompt1\fR.
The variable \fBtcl_prompt2\fR is used in a similar way when
-a newline is typed but the current command isn't yet complete;
-if \fBtcl_prompt2\fR isn't set then no prompt is output for
+a newline is typed but the current command is not yet complete;
+if \fBtcl_prompt2\fR is not set then no prompt is output for
incomplete commands.
-
.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.
-
.SH "SEE ALSO"
-encoding(n), fconfigure(n), tclvars(n)
-
+auto_path(n), encoding(n), env(n), fconfigure(n)
.SH KEYWORDS
-argument, interpreter, prompt, script file, shell
+application, argument, interpreter, prompt, script file, shell
diff --git a/doc/tcltest.n b/doc/tcltest.n
index b673db7..8d2398b 100644
--- a/doc/tcltest.n
+++ b/doc/tcltest.n
@@ -8,62 +8,60 @@
'\" 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.44 2004/10/27 14:43:54 dkf Exp $
-'\"
+.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
.so man.macros
-.TH "tcltest" n 2.2 tcltest "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
tcltest \- Test harness support code and utilities
.SH SYNOPSIS
.nf
-\fBpackage require tcltest ?2.2.5?\fR
-.sp
-\fBtcltest::test \fIname description ?option value ...?\fR
-\fBtcltest::test \fIname description ?constraints? body result\fR
-.sp
+\fBpackage require tcltest\fR ?\fB2.3\fR?
+
+\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
+\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
+
\fBtcltest::loadTestedCommands\fR
-\fBtcltest::makeDirectory \fIname ?directory?\fR
-\fBtcltest::removeDirectory \fIname ?directory?\fR
-\fBtcltest::makeFile \fIcontents name ?directory?\fR
-\fBtcltest::removeFile \fIname ?directory?\fR
-\fBtcltest::viewFile \fIname ?directory?\fR
-\fBtcltest::cleanupTests \fI?runningMultipleTests?\fR
+\fBtcltest::makeDirectory \fIname\fR ?\fIdirectory\fR?
+\fBtcltest::removeDirectory \fIname\fR ?\fIdirectory\fR?
+\fBtcltest::makeFile \fIcontents name\fR ?\fIdirectory\fR?
+\fBtcltest::removeFile \fIname\fR ?\fIdirectory\fR?
+\fBtcltest::viewFile \fIname\fR ?\fIdirectory\fR?
+\fBtcltest::cleanupTests \fR?\fIrunningMultipleTests\fR?
\fBtcltest::runAllTests\fR
-.sp
+
\fBtcltest::configure\fR
-\fBtcltest::configure \fIoption\fR
-\fBtcltest::configure \fIoption value ?option value ...?\fR
+\fBtcltest::configure \fI\-option\fR
+\fBtcltest::configure \fI\-option value\fR ?\fI\-option value ...\fR?
\fBtcltest::customMatch \fImode command\fR
-\fBtcltest::testConstraint \fIconstraint ?value?\fR
-\fBtcltest::outputChannel \fI?channelID?\fR
-\fBtcltest::errorChannel \fI?channelID?\fR
-\fBtcltest::interpreter \fI?interp?\fR
-.sp
-\fBtcltest::debug \fI?level?\fR
-\fBtcltest::errorFile \fI?filename?\fR
-\fBtcltest::limitConstraints \fI?boolean?\fR
-\fBtcltest::loadFile \fI?filename?\fR
-\fBtcltest::loadScript \fI?script?\fR
-\fBtcltest::match \fI?patternList?\fR
-\fBtcltest::matchDirectories \fI?patternList?\fR
-\fBtcltest::matchFiles \fI?patternList?\fR
-\fBtcltest::outputFile \fI?filename?\fR
-\fBtcltest::preserveCore \fI?level?\fR
-\fBtcltest::singleProcess \fI?boolean?\fR
-\fBtcltest::skip \fI?patternList?\fR
-\fBtcltest::skipDirectories \fI?patternList?\fR
-\fBtcltest::skipFiles \fI?patternList?\fR
-\fBtcltest::temporaryDirectory \fI?directory?\fR
-\fBtcltest::testsDirectory \fI?directory?\fR
-\fBtcltest::verbose \fI?level?\fR
-.sp
+\fBtcltest::testConstraint \fIconstraint\fR ?\fIvalue\fR?
+\fBtcltest::outputChannel \fR?\fIchannelID\fR?
+\fBtcltest::errorChannel \fR?\fIchannelID\fR?
+\fBtcltest::interpreter \fR?\fIinterp\fR?
+
+\fBtcltest::debug \fR?\fIlevel\fR?
+\fBtcltest::errorFile \fR?\fIfilename\fR?
+\fBtcltest::limitConstraints \fR?\fIboolean\fR?
+\fBtcltest::loadFile \fR?\fIfilename\fR?
+\fBtcltest::loadScript \fR?\fIscript\fR?
+\fBtcltest::match \fR?\fIpatternList\fR?
+\fBtcltest::matchDirectories \fR?\fIpatternList\fR?
+\fBtcltest::matchFiles \fR?\fIpatternList\fR?
+\fBtcltest::outputFile \fR?\fIfilename\fR?
+\fBtcltest::preserveCore \fR?\fIlevel\fR?
+\fBtcltest::singleProcess \fR?\fIboolean\fR?
+\fBtcltest::skip \fR?\fIpatternList\fR?
+\fBtcltest::skipDirectories \fR?\fIpatternList\fR?
+\fBtcltest::skipFiles \fR?\fIpatternList\fR?
+\fBtcltest::temporaryDirectory \fR?\fIdirectory\fR?
+\fBtcltest::testsDirectory \fR?\fIdirectory\fR?
+\fBtcltest::verbose \fR?\fIlevel\fR?
+
\fBtcltest::test \fIname description optionList\fR
\fBtcltest::bytestring \fIstring\fR
\fBtcltest::normalizeMsg \fImsg\fR
\fBtcltest::normalizePath \fIpathVar\fR
-\fBtcltest::workingDirectory \fI?dir?\fR
+\fBtcltest::workingDirectory \fR?\fIdir\fR?
.fi
.BE
.SH DESCRIPTION
@@ -79,12 +77,12 @@ in and exported from the \fB::tcltest\fR namespace, as indicated in
the \fBSYNOPSIS\fR above. In the following sections, all commands
will be described by their simple names, in the interest of brevity.
.PP
-The central command of \fBtcltest\fR is [\fBtest\fR] that defines
-and runs a test. Testing with [\fBtest\fR] involves evaluation
+The central command of \fBtcltest\fR is \fBtest\fR that defines
+and runs a test. Testing with \fBtest\fR involves evaluation
of a Tcl script and comparing the result to an expected result, as
configured and controlled by a number of options. Several other
commands provided by \fBtcltest\fR govern the configuration of
-[\fBtest\fR] and the collection of many [\fBtest\fR] commands into
+\fBtest\fR and the collection of many \fBtest\fR commands into
test suites.
.PP
See \fBCREATING TEST SUITES WITH TCLTEST\fR below for an extended example
@@ -92,82 +90,91 @@ 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 ?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
-are used in messages reported by [\fBtest\fR] during the
+are used in messages reported by \fBtest\fR during the
test, as configured by the options of \fBtcltest\fR. The
-remaining \fIoption value\fR arguments to [\fBtest\fR]
+remaining \fIoption value\fR arguments to \fBtest\fR
define the test, including the scripts to run, the conditions
under which to run them, the expected result, and the means
by which the expected and actual results should be compared.
See \fBTESTS\fR below for a complete description of the valid
-options and how they define a test. The [\fBtest\fR] command
-returns an empty string.
+options and how they define a test. The \fBtest\fR command
+returns an empty string.
.TP
-\fBtest\fR \fIname description ?constraints? body result\fR
-This form of [\fBtest\fR] is provided to support test suites written
+\fBtest\fR \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
+.
+This form of \fBtest\fR is provided to support test suites written
for version 1 of the \fBtcltest\fR package, and also a simpler
interface for a common usage. It is the same as
-[\fBtest\fR \fIname description\fB -constraints \fIconstraints\fB -body
-\fIbody\fB -result \fIresult\fR]. All other options to [\fBtest\fR]
+.QW "\fBtest\fR \fIname description\fB \-constraints \fIconstraints\fB \-body \fIbody\fB \-result \fIresult\fR" .
+All other options to \fBtest\fR
take their default values. When \fIconstraints\fR is omitted, this
-form of [\fBtest\fR] can be distinguished from the first because
-all \fIoption\fRs begin with ``-''.
+form of \fBtest\fR can be distinguished from the first because
+all \fIoption\fRs begin with
+.QW \- .
.TP
\fBloadTestedCommands\fR
+.
Evaluates in the caller's context the script specified by
-[\fBconfigure -load\fR] or [\fBconfigure -loadfile\fR].
+\fBconfigure \-load\fR or \fBconfigure \-loadfile\fR.
Returns the result of that script evaluation, including any error
raised by the script. Use this command and the related
configuration options to provide the commands to be tested to
the interpreter running the test suite.
.TP
-\fBmakeFile\fR \fIcontents name ?directory?\fR
+\fBmakeFile\fR \fIcontents name\fR ?\fIdirectory\fR?
+.
Creates a file named \fIname\fR relative to
directory \fIdirectory\fR and write \fIcontents\fR
-to that file using the encoding [\fBencoding system\fR].
+to that file using the encoding \fBencoding system\fR.
If \fIcontents\fR does not end with a newline, a newline
will be appended so that the file named \fIname\fR
does end with a newline. Because the system encoding is used,
this command is only suitable for making text files.
The file will be removed by the next evaluation
-of [\fBcleanupTests\fR], unless it is removed by
-[\fBremoveFile\fR] first. The default value of
-\fIdirectory\fR is the directory [\fBconfigure -tmpdir\fR].
+of \fBcleanupTests\fR, unless it is removed by
+\fBremoveFile\fR first. The default value of
+\fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR.
Returns the full path of the file created. Use this command
to create any text file required by a test with contents as needed.
.TP
-\fBremoveFile\fR \fIname ?directory?\fR
+\fBremoveFile\fR \fIname\fR ?\fIdirectory\fR?
+.
Forces the file referenced by \fIname\fR to be removed. This file name
should be relative to \fIdirectory\fR. The default value of
-\fIdirectory\fR is the directory [\fBconfigure -tmpdir\fR].
+\fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR.
Returns an empty string. Use this command to delete files
-created by [\fBmakeFile\fR].
+created by \fBmakeFile\fR.
.TP
-\fBmakeDirectory\fR \fIname ?directory?\fR
+\fBmakeDirectory\fR \fIname\fR ?\fIdirectory\fR?
+.
Creates a directory named \fIname\fR relative to directory \fIdirectory\fR.
-The directory will be removed by the next evaluation of [\fBcleanupTests\fR],
-unless it is removed by [\fBremoveDirectory\fR] first.
+The directory will be removed by the next evaluation of \fBcleanupTests\fR,
+unless it is removed by \fBremoveDirectory\fR first.
The default value of \fIdirectory\fR is the directory
-[\fBconfigure -tmpdir\fR].
+\fBconfigure \-tmpdir\fR.
Returns the full path of the directory created. Use this command
to create any directories that are required to exist by a test.
.TP
-\fBremoveDirectory\fR \fIname ?directory?\fR
+\fBremoveDirectory\fR \fIname\fR ?\fIdirectory\fR?
+.
Forces the directory referenced by \fIname\fR to be removed. This
directory should be relative to \fIdirectory\fR.
The default value of \fIdirectory\fR is the directory
-[\fBconfigure -tmpdir\fR].
+\fBconfigure \-tmpdir\fR.
Returns an empty string. Use this command to delete any directories
-created by [\fBmakeDirectory\fR].
+created by \fBmakeDirectory\fR.
.TP
-\fBviewFile\fR \fIfile ?directory?\fR
+\fBviewFile\fR \fIfile\fR ?\fIdirectory\fR?
+.
Returns the contents of \fIfile\fR, except for any
-final newline, just as [\fBread -nonewline\fR] would return.
-This file name should be relative to \fIdirectory\fR.
+final newline, just as \fBread \-nonewline\fR would return.
+This file name should be relative to \fIdirectory\fR.
The default value of \fIdirectory\fR is the directory
-[\fBconfigure -tmpdir\fR]. Use this command
+\fBconfigure \-tmpdir\fR. Use this command
as a convenient way to turn the contents of a file generated
by a test into the result of that test for matching against
an expected result. The contents of the file are read using
@@ -175,58 +182,68 @@ the system encoding, so its usefulness is limited to text
files.
.TP
\fBcleanupTests\fR
+.
Intended to clean up and summarize after several tests have been
run. Typically called once per test file, at the end of the file
after all tests have been completed. For best effectiveness, be
-sure that the [\fBcleanupTests\fR] is evaluated even if an error
-occurs earlier in the test file evaluation.
-.sp
+sure that the \fBcleanupTests\fR is evaluated even if an error
+occurs earlier in the test file evaluation.
+.RS
+.PP
Prints statistics about the tests run and removes files that were
-created by [\fBmakeDirectory\fR] and [\fBmakeFile\fR] since the
-last [\fBcleanupTests\fR]. Names of files and directories
-in the directory [\fBconfigure -tmpdir\fR] created since
-the last [\fBcleanupTests\fR], but not created by
-[\fBmakeFile\fR] or [\fBmakeDirectory\fR] are printed
-to [\fBoutputChannel\fR]. This command also restores the original
-shell environment, as described by the ::env
+created by \fBmakeDirectory\fR and \fBmakeFile\fR since the
+last \fBcleanupTests\fR. Names of files and directories
+in the directory \fBconfigure \-tmpdir\fR created since
+the last \fBcleanupTests\fR, but not created by
+\fBmakeFile\fR or \fBmakeDirectory\fR are printed
+to \fBoutputChannel\fR. This command also restores the original
+shell environment, as described by the global \fBenv\fR
array. Returns an empty string.
+.RE
.TP
\fBrunAllTests\fR
+.
This is a master command meant to run an entire suite of tests,
spanning multiple files and/or directories, as governed by
the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR
below for a complete description of the many variations possible
-with [\fBrunAllTests\fR].
-.SH "CONFIGURATION COMMANDS"
+with \fBrunAllTests\fR.
+.SS "CONFIGURATION COMMANDS"
.TP
\fBconfigure\fR
+.
Returns the list of configurable options supported by \fBtcltest\fR.
See \fBCONFIGURABLE OPTIONS\fR below for the full list of options,
their valid values, and their effect on \fBtcltest\fR operations.
.TP
\fBconfigure \fIoption\fR
+.
Returns the current value of the supported configurable option \fIoption\fR.
Raises an error if \fIoption\fR is not a supported configurable option.
.TP
-\fBconfigure \fIoption value ?option value ...?\fR
+\fBconfigure \fIoption value\fR ?\fI\-option value ...\fR?
+.
Sets the value of each configurable option \fIoption\fR to the
corresponding value \fIvalue\fR, in order. Raises an error if
an \fIoption\fR is not a supported configurable option, or if
\fIvalue\fR is not a valid value for the corresponding \fIoption\fR,
or if a \fIvalue\fR is not provided. When an error is raised, the
-operation of [\fBconfigure\fR] is halted, and subsequent \fIoption value\fR
+operation of \fBconfigure\fR is halted, and subsequent \fIoption value\fR
arguments are not processed.
-.sp
+.RS
+.PP
If the environment variable \fB::env(TCLTEST_OPTIONS)\fR exists when
-the \fBtcltest\fR package is loaded (by [\fBpackage require tcltest\fR])
-then its value is taken as a list of arguments to pass to [\fBconfigure\fR].
+the \fBtcltest\fR package is loaded (by \fBpackage require\fR \fBtcltest\fR)
+then its value is taken as a list of arguments to pass to \fBconfigure\fR.
This allows the default values of the configuration options to be
set by the environment.
+.RE
.TP
\fBcustomMatch \fImode script\fR
-Registers \fImode\fR as a new legal value of the \fB-match\fR option
-to [\fBtest\fR]. When the \fB-match \fImode\fR option is
-passed to [\fBtest\fR], the script \fIscript\fR will be evaluated
+.
+Registers \fImode\fR as a new legal value of the \fB\-match\fR option
+to \fBtest\fR. When the \fB\-match \fImode\fR option is
+passed to \fBtest\fR, the script \fIscript\fR will be evaluated
to compare the actual result of evaluating the body of the test
to the expected result.
To perform the match, the \fIscript\fR is completed with two additional
@@ -234,83 +251,121 @@ words, the expected result, and the actual result, and the completed script
is evaluated in the global namespace.
The completed script is expected to return a boolean value indicating
whether or not the results match. The built-in matching modes of
-[\fBtest\fR] are \fBexact\fR, \fBglob\fR, and \fBregexp\fR.
+\fBtest\fR are \fBexact\fR, \fBglob\fR, and \fBregexp\fR.
.TP
-\fBtestConstraint \fIconstraint ?boolean?\fR
+\fBtestConstraint \fIconstraint\fR ?\fIboolean\fR?
+.
Sets or returns the boolean value associated with the named \fIconstraint\fR.
See \fBTEST CONSTRAINTS\fR below for more information.
.TP
-\fBinterpreter\fR \fI?executableName?\fR
-Sets or returns the name of the executable to be [\fBexec\fR]ed by
-[\fBrunAllTests\fR] to run each test file when
-[\fBconfigure -singleproc\fR] is false.
-The default value for [\fBinterpreter\fR] is the name of the
-currently running program as returned by [\fBinfo nameofexecutable\fR].
-.TP
-\fBoutputChannel\fR \fI?channelID?\fR
-Sets or returns the output channel ID. This defaults to stdout.
+\fBinterpreter\fR ?\fIexecutableName\fR?
+.
+Sets or returns the name of the executable to be \fBexec\fRed by
+\fBrunAllTests\fR to run each test file when
+\fBconfigure \-singleproc\fR is false.
+The default value for \fBinterpreter\fR is the name of the
+currently running program as returned by \fBinfo nameofexecutable\fR.
+.TP
+\fBoutputChannel\fR ?\fIchannelID\fR?
+.
+Sets or returns the output channel ID. This defaults to \fBstdout\fR.
Any test that prints test related output should send
-that output to [\fBoutputChannel\fR] rather than letting
-that output default to stdout.
+that output to \fBoutputChannel\fR rather than letting
+that output default to \fBstdout\fR.
.TP
-\fBerrorChannel\fR \fI?channelID?\fR
-Sets or returns the error channel ID. This defaults to stderr.
+\fBerrorChannel\fR ?\fIchannelID\fR?
+.
+Sets or returns the error channel ID. This defaults to \fBstderr\fR.
Any test that prints error messages should send
-that output to [\fBerrorChannel\fR] rather than printing
-directly to stderr.
-.SH "SHORTCUT COMMANDS"
-.TP
-\fBdebug \fI?level?\fR
-Same as [\fBconfigure -debug \fI?level?\fR].
-.TP
-\fBerrorFile \fI?filename?\fR
-Same as [\fBconfigure -errfile \fI?filename?\fR].
-.TP
-\fBlimitConstraints \fI?boolean?\fR
-Same as [\fBconfigure -limitconstraints \fI?boolean?\fR].
-.TP
-\fBloadFile \fI?filename?\fR
-Same as [\fBconfigure -loadfile \fI?filename?\fR].
-.TP
-\fBloadScript \fI?script?\fR
-Same as [\fBconfigure -load \fI?script?\fR].
-.TP
-\fBmatch \fI?patternList?\fR
-Same as [\fBconfigure -match \fI?patternList?\fR].
-.TP
-\fBmatchDirectories \fI?patternList?\fR
-Same as [\fBconfigure -relateddir \fI?patternList?\fR].
-.TP
-\fBmatchFiles \fI?patternList?\fR
-Same as [\fBconfigure -file \fI?patternList?\fR].
-.TP
-\fBoutputFile \fI?filename?\fR
-Same as [\fBconfigure -outfile \fI?filename?\fR].
-.TP
-\fBpreserveCore \fI?level?\fR
-Same as [\fBconfigure -preservecore \fI?level?\fR].
-.TP
-\fBsingleProcess \fI?boolean?\fR
-Same as [\fBconfigure -singleproc \fI?boolean?\fR].
-.TP
-\fBskip \fI?patternList?\fR
-Same as [\fBconfigure -skip \fI?patternList?\fR].
-.TP
-\fBskipDirectories \fI?patternList?\fR
-Same as [\fBconfigure -asidefromdir \fI?patternList?\fR].
-.TP
-\fBskipFiles \fI?patternList?\fR
-Same as [\fBconfigure -notfile \fI?patternList?\fR].
-.TP
-\fBtemporaryDirectory \fI?directory?\fR
-Same as [\fBconfigure -tmpdir \fI?directory?\fR].
-.TP
-\fBtestsDirectory \fI?directory?\fR
-Same as [\fBconfigure -testdir \fI?directory?\fR].
-.TP
-\fBverbose \fI?level?\fR
-Same as [\fBconfigure -verbose \fI?level?\fR].
-.SH "OTHER COMMANDS"
+that output to \fBerrorChannel\fR rather than printing
+directly to \fBstderr\fR.
+.SS "SHORTCUT CONFIGURATION COMMANDS"
+.TP
+\fBdebug\fR ?\fIlevel\fR?
+.
+Same as
+.QW "\fBconfigure \-debug\fR ?\fIlevel\fR?" .
+.TP
+\fBerrorFile\fR ?\fIfilename\fR?
+.
+Same as
+.QW "\fBconfigure \-errfile\fR ?\fIfilename\fR?" .
+.TP
+\fBlimitConstraints\fR ?\fIboolean\fR?
+.
+Same as
+.QW "\fBconfigure \-limitconstraints\fR ?\fIboolean\fR?" .
+.TP
+\fBloadFile\fR ?\fIfilename\fR?
+.
+Same as
+.QW "\fBconfigure \-loadfile\fR ?\fIfilename\fR?" .
+.TP
+\fBloadScript\fR ?\fIscript\fR?
+.
+Same as
+.QW "\fBconfigure \-load\fR ?\fIscript\fR?" .
+.TP
+\fBmatch\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-match\fR ?\fIpatternList\fR?" .
+.TP
+\fBmatchDirectories\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-relateddir\fR ?\fIpatternList\fR?" .
+.TP
+\fBmatchFiles\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-file\fR ?\fIpatternList\fR?" .
+.TP
+\fBoutputFile\fR ?\fIfilename\fR?
+.
+Same as
+.QW "\fBconfigure \-outfile\fR ?\fIfilename\fR?" .
+.TP
+\fBpreserveCore\fR ?\fIlevel\fR?
+.
+Same as
+.QW "\fBconfigure \-preservecore\fR ?\fIlevel\fR?" .
+.TP
+\fBsingleProcess\fR ?\fIboolean\fR?
+.
+Same as
+.QW "\fBconfigure \-singleproc\fR ?\fIboolean\fR?" .
+.TP
+\fBskip\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-skip\fR ?\fIpatternList\fR?" .
+.TP
+\fBskipDirectories\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-asidefromdir\fR ?\fIpatternList\fR?" .
+.TP
+\fBskipFiles\fR ?\fIpatternList\fR?
+.
+Same as
+.QW "\fBconfigure \-notfile\fR ?\fIpatternList\fR?" .
+.TP
+\fBtemporaryDirectory\fR ?\fIdirectory\fR?
+.
+Same as
+.QW "\fBconfigure \-tmpdir\fR ?\fIdirectory\fR?" .
+.TP
+\fBtestsDirectory\fR ?\fIdirectory\fR?
+.
+Same as
+.QW "\fBconfigure \-testdir\fR ?\fIdirectory\fR?" .
+.TP
+\fBverbose\fR ?\fIlevel\fR?
+.
+Same as
+.QW "\fBconfigure \-verbose\fR ?\fIlevel\fR?" .
+.SS "OTHER COMMANDS"
.PP
The remaining commands provided by \fBtcltest\fR have better
alternatives provided by \fBtcltest\fR or \fBTcl\fR itself. They
@@ -318,98 +373,112 @@ are retained to support existing test suites, but should be avoided
in new code.
.TP
\fBtest\fR \fIname description optionList\fR
-This form of [\fBtest\fR] was provided to enable passing many
-options spanning several lines to [\fBtest\fR] as a single
+.
+This form of \fBtest\fR was provided to enable passing many
+options spanning several lines to \fBtest\fR as a single
argument quoted by braces, rather than needing to backslash quote
-the newlines between arguments to [\fBtest\fR]. The \fIoptionList\fR
+the newlines between arguments to \fBtest\fR. The \fIoptionList\fR
argument is expected to be a list with an even number of elements
representing \fIoption\fR and \fIvalue\fR arguments to pass
-to [\fBtest\fR]. However, these values are not passed directly, as
-in the alternate forms of [\fBswitch\fR]. Instead, this form makes
+to \fBtest\fR. However, these values are not passed directly, as
+in the alternate forms of \fBswitch\fR. Instead, this form makes
an unfortunate attempt to overthrow Tcl's substitution rules by
performing substitutions on some of the list elements as an attempt to
-implement a ``do what I mean'' interpretation of a brace-enclosed
-``block''. The result is nearly impossible to document clearly, and
+implement a
+.QW "do what I mean"
+interpretation of a brace-enclosed
+.QW block .
+The result is nearly impossible to document clearly, and
for that reason this form is not recommended. See the examples in
\fBCREATING TEST SUITES WITH TCLTEST\fR below to see that this
form is really not necessary to avoid backslash-quoted newlines.
If you insist on using this form, examine
the source code of \fBtcltest\fR if you want to know the substitution
details, or just enclose the third through last argument
-to [\fBtest\fR] in braces and hope for the best.
+to \fBtest\fR in braces and hope for the best.
.TP
-\fBworkingDirectory\fR \fI?directoryName?\fR
+\fBworkingDirectory\fR ?\fIdirectoryName\fR?
+.
Sets or returns the current working directory when the test suite is
running. The default value for workingDirectory is the directory in
-which the test suite was launched. The Tcl commands [\fBcd\fR] and
-[\fBpwd\fR] are sufficient replacements.
-.TP
-\fBnormalizeMsg\fR \fImsg\fR
-Returns the result of removing the ``extra'' newlines from \fImsg\fR,
-where ``extra'' is rather imprecise. Tcl offers plenty of string
+which the test suite was launched. The Tcl commands \fBcd\fR and
+\fBpwd\fR are sufficient replacements.
+.TP
+\fBnormalizeMsg \fImsg\fR
+.
+Returns the result of removing the
+.QW extra
+newlines from \fImsg\fR, where
+.QW extra
+is rather imprecise. Tcl offers plenty of string
processing commands to modify strings as you wish, and
-[\fBcustomMatch\fR] allows flexible matching of actual and expected
+\fBcustomMatch\fR allows flexible matching of actual and expected
results.
.TP
-\fBnormalizePath\fR \fIpathVar\fR
+\fBnormalizePath \fIpathVar\fR
+.
Resolves symlinks in a path, thus creating a path without internal
redirection. It is assumed that \fIpathVar\fR is absolute.
-\fIpathVar\fR is modified in place. The Tcl command [\fBfile normalize\fR]
+\fIpathVar\fR is modified in place. The Tcl command \fBfile normalize\fR
is a sufficient replacement.
.TP
-\fBbytestring\fR \fIstring\fR
+\fBbytestring \fIstring\fR
+.
Construct a string that consists of the requested sequence of bytes,
as opposed to a string of properly formed UTF-8 characters using the
value supplied in \fIstring\fR. This allows the tester to create
denormalized or improperly formed strings to pass to C procedures that
are supposed to accept strings with embedded NULL types and confirm
that a string result has a certain pattern of bytes. This is
-exactly equivalent to the Tcl command [\fBencoding convertfrom identity\fR].
+exactly equivalent to the Tcl command \fBencoding convertfrom\fR
+\fBidentity\fR.
.SH TESTS
.PP
-The [\fBtest\fR] command is the heart of the \fBtcltest\fR package.
+The \fBtest\fR command is the heart of the \fBtcltest\fR package.
Its essential function is to evaluate a Tcl script and compare
-the result with an expected result. The options of [\fBtest\fR]
+the result with an expected result. The options of \fBtest\fR
define the test script, the environment in which to evaluate it,
the expected result, and how the compare the actual result to
the expected result. Some configuration options of \fBtcltest\fR
-also influence how [\fBtest\fR] operates.
+also influence how \fBtest\fR operates.
+.PP
+The valid options for \fBtest\fR are summarized:
.PP
-The valid options for [\fBtest\fR] are summarized:
.CS
-.ta 0.8i
\fBtest\fR \fIname\fR \fIdescription\fR
- ?-constraints \fIkeywordList|expression\fR?
- ?-setup \fIsetupScript\fR?
- ?-body \fItestScript\fR?
- ?-cleanup \fIcleanupScript\fR?
- ?-result \fIexpectedAnswer\fR?
- ?-output \fIexpectedOutput\fR?
- ?-errorOutput \fIexpectedError\fR?
- ?-returnCodes \fIcodeList\fR?
- ?-match \fImode\fR?
+ ?\fB\-constraints \fIkeywordList|expression\fR?
+ ?\fB\-setup \fIsetupScript\fR?
+ ?\fB\-body \fItestScript\fR?
+ ?\fB\-cleanup \fIcleanupScript\fR?
+ ?\fB\-result \fIexpectedAnswer\fR?
+ ?\fB\-output \fIexpectedOutput\fR?
+ ?\fB\-errorOutput \fIexpectedError\fR?
+ ?\fB\-returnCodes \fIcodeList\fR?
+ ?\fB\-match \fImode\fR?
.CE
+.PP
The \fIname\fR may be any string. It is conventional to choose
a \fIname\fR according to the pattern:
+.PP
.CS
\fItarget\fR-\fImajorNum\fR.\fIminorNum\fR
.CE
+.PP
For white-box (regression) tests, the target should be the name of the
C function or Tcl procedure being tested. For black-box tests, the
target should be the name of the feature being tested. Some conventions
call for the names of black-box tests to have the suffix \fB_bb\fR.
Related tests should share a major number. As a test suite evolves,
it is best to have the same test name continue to correspond to the
-same test, so that it remains meaningful to say things like ``Test
-foo-1.3 passed in all releases up to 3.4, but began failing in
-release 3.5.''
+same test, so that it remains meaningful to say things like
+.QW "Test foo-1.3 passed in all releases up to 3.4, but began failing in release 3.5."
.PP
-During evaluation of [\fBtest\fR], the \fIname\fR will be compared
+During evaluation of \fBtest\fR, the \fIname\fR will be compared
to the lists of string matching patterns returned by
-[\fBconfigure -match\fR], and [\fBconfigure -skip\fR]. The test
+\fBconfigure \-match\fR, and \fBconfigure \-skip\fR. The test
will be run only if \fIname\fR matches any of the patterns from
-[\fBconfigure -match\fR] and matches none of the patterns
-from [\fBconfigure -skip\fR].
+\fBconfigure \-match\fR and matches none of the patterns
+from \fBconfigure \-skip\fR.
.PP
The \fIdescription\fR should be a short textual description of the
test. The \fIdescription\fR is included in output produced by the
@@ -421,270 +490,315 @@ a bug, include the bug ID in the description.
.PP
Valid attributes and associated values are:
.TP
-\fB-constraints \fIkeywordList|expression\fR
-The optional \fB-constraints\fR attribute can be list of one or more
-keywords or an expression. If the \fB-constraints\fR value is a list of
+\fB\-constraints \fIkeywordList\fR|\fIexpression\fR
+.
+The optional \fB\-constraints\fR attribute can be list of one or more
+keywords or an expression. If the \fB\-constraints\fR value is a list of
keywords, each of these keywords should be the name of a constraint
-defined by a call to [\fBtestConstraint\fR]. If any of the listed
+defined by a call to \fBtestConstraint\fR. If any of the listed
constraints is false or does not exist, the test is skipped. If the
-\fB-constraints\fR value is an expression, that expression
+\fB\-constraints\fR value is an expression, that expression
is evaluated. If the expression evaluates to true, then the test is run.
-Note that the expression form of \fB-constraints\fR may interfere with the
-operation of [\fBconfigure -constraints\fR] and
-[\fBconfigure -limitconstraints\fR], and is not recommended.
+Note that the expression form of \fB\-constraints\fR may interfere with the
+operation of \fBconfigure \-constraints\fR and
+\fBconfigure \-limitconstraints\fR, and is not recommended.
Appropriate constraints should be added to any tests that should
not always be run. That is, conditional evaluation of a test
-should be accomplished by the \fB-constraints\fR option, not by
-conditional evaluation of [\fBtest\fR]. In that way, the same
+should be accomplished by the \fB\-constraints\fR option, not by
+conditional evaluation of \fBtest\fR. In that way, the same
number of tests are always reported by the test suite, though
the number skipped may change based on the testing environment.
The default value is an empty list.
See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints
and information on how to add your own constraints.
.TP
-\fB-setup \fIscript\fR
-The optional \fB-setup\fR attribute indicates a \fIscript\fR that will be run
-before the script indicated by the \fB-body\fR attribute. If evaluation
+\fB\-setup \fIscript\fR
+.
+The optional \fB\-setup\fR attribute indicates a \fIscript\fR that will be run
+before the script indicated by the \fB\-body\fR attribute. If evaluation
of \fIscript\fR raises an error, the test will fail. The default value
is an empty script.
.TP
-\fB-body \fIscript\fR
-The \fB-body\fR attribute indicates the \fIscript\fR to run to carry out the
-test. It must return a result that can be checked for correctness.
-If evaluation of \fIscript\fR raises an error, the test will fail.
+\fB\-body \fIscript\fR
+.
+The \fB\-body\fR attribute indicates the \fIscript\fR to run to carry out the
+test, which must return a result that can be checked for correctness.
+If evaluation of \fIscript\fR raises an error, the test will fail
+(unless the \fB\-returnCodes\fR option is used to state that an error
+is expected).
The default value is an empty script.
.TP
-\fB-cleanup \fIscript\fR
-The optional \fB-cleanup\fR attribute indicates a \fIscript\fR that will be
-run after the script indicated by the \fB-body\fR attribute.
+\fB\-cleanup \fIscript\fR
+.
+The optional \fB\-cleanup\fR attribute indicates a \fIscript\fR that will be
+run after the script indicated by the \fB\-body\fR attribute.
If evaluation of \fIscript\fR raises an error, the test will fail.
The default value is an empty script.
.TP
-\fB-match \fImode\fR
-The \fB-match\fR attribute determines how expected answers supplied by
-\fB-result\fR, \fB-output\fR, and \fB-errorOutput\fR are compared. Valid
+\fB\-match \fImode\fR
+.
+The \fB\-match\fR attribute determines how expected answers supplied by
+\fB\-result\fR, \fB\-output\fR, and \fB\-errorOutput\fR are compared. Valid
values for \fImode\fR are \fBregexp\fR, \fBglob\fR, \fBexact\fR, and
-any value registered by a prior call to [\fBcustomMatch\fR]. The default
+any value registered by a prior call to \fBcustomMatch\fR. The default
value is \fBexact\fR.
.TP
-\fB-result \fIexpectedValue\fR
-The \fB-result\fR attribute supplies the \fIexpectedValue\fR against which
+\fB\-result \fIexpectedValue\fR
+.
+The \fB\-result\fR attribute supplies the \fIexpectedValue\fR against which
the return value from script will be compared. The default value is
an empty string.
.TP
-\fB-output \fIexpectedValue\fR
-The \fB-output\fR attribute supplies the \fIexpectedValue\fR against which
-any output sent to \fBstdout\fR or [\fBoutputChannel\fR] during evaluation
+\fB\-output \fIexpectedValue\fR
+.
+The \fB\-output\fR attribute supplies the \fIexpectedValue\fR against which
+any output sent to \fBstdout\fR or \fBoutputChannel\fR during evaluation
of the script(s) will be compared. Note that only output printed using
-[\fB::puts\fR] is used for comparison. If \fB-output\fR is not specified,
-output sent to \fBstdout\fR and [\fBoutputChannel\fR] is not processed for
-comparison.
-.TP
-\fB-errorOutput \fIexpectedValue\fR
-The \fB-errorOutput\fR attribute supplies the \fIexpectedValue\fR against
-which any output sent to \fBstderr\fR or [\fBerrorChannel\fR] during
+the global \fBputs\fR command is used for comparison. If \fB\-output\fR is
+not specified, output sent to \fBstdout\fR and \fBoutputChannel\fR is not
+processed for comparison.
+.TP
+\fB\-errorOutput \fIexpectedValue\fR
+.
+The \fB\-errorOutput\fR attribute supplies the \fIexpectedValue\fR against
+which any output sent to \fBstderr\fR or \fBerrorChannel\fR during
evaluation of the script(s) will be compared. Note that only output
-printed using [\fB::puts\fR] is used for comparison. If \fB-errorOutput\fR
-is not specified, output sent to \fBstderr\fR and [\fBerrorChannel\fR] is
-not processed for comparison.
+printed using the global \fBputs\fR command is used for comparison. If
+\fB\-errorOutput\fR is not specified, output sent to \fBstderr\fR and
+\fBerrorChannel\fR is not processed for comparison.
.TP
-\fB-returnCodes \fIexpectedCodeList\fR
-The optional \fB-returnCodes\fR attribute supplies \fIexpectedCodeList\fR,
+\fB\-returnCodes \fIexpectedCodeList\fR
+.
+The optional \fB\-returnCodes\fR attribute supplies \fIexpectedCodeList\fR,
a list of return codes that may be accepted from evaluation of the
-\fB-body\fR script. If evaluation of the \fB-body\fR script returns
+\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns
a code not in the \fIexpectedCodeList\fR, the test fails. All
-return codes known to [\fBreturn\fR], in both numeric and symbolic
+return codes known to \fBreturn\fR, in both numeric and symbolic
form, including extended return codes, are acceptable elements in
-the \fIexpectedCodeList\fR. Default value is \fB{ok return}\fR.
+the \fIexpectedCodeList\fR. Default value is
+.QW "\fBok return\fR" .
.PP
-To pass, a test must successfully evaluate its \fB-setup\fR, \fB-body\fR,
-and \fB-cleanup\fR scripts. The return code of the \fB-body\fR script and
+To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
+and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and
its result must match expected values, and if specified, output and error
-data from the test must match expected \fB-output\fR and \fB-errorOutput\fR
+data from the test must match expected \fB\-output\fR and \fB\-errorOutput\fR
values. If any of these conditions are not met, then the test fails.
Note that all scripts are evaluated in the context of the caller
-of [\fBtest\fR].
+of \fBtest\fR.
.PP
-As long as [\fBtest\fR] is called with valid syntax and legal
+As long as \fBtest\fR is called with valid syntax and legal
values for all attributes, it will not raise an error. Test
-failures are instead reported as output written to [\fBoutputChannel\fR].
+failures are instead reported as output written to \fBoutputChannel\fR.
In default operation, a successful test produces no output. The output
-messages produced by [\fBtest\fR] are controlled by the
-[\fBconfigure -verbose\fR] option as described in \fBCONFIGURABLE OPTIONS\fR
+messages produced by \fBtest\fR are controlled by the
+\fBconfigure \-verbose\fR option as described in \fBCONFIGURABLE OPTIONS\fR
below. Any output produced by the test scripts themselves should be
-produced using [\fB::puts\fR] to [\fBoutputChannel\fR] or
-[\fBerrorChannel\fR], so that users of the test suite may
-easily capture output with the [\fBconfigure -outfile\fR] and
-[\fBconfigure -errfile\fR] options, and so that the \fB-output\fR
-and \fB-errorOutput\fR attributes work properly.
-.SH "TEST CONSTRAINTS"
+produced using \fBputs\fR to \fBoutputChannel\fR or
+\fBerrorChannel\fR, so that users of the test suite may
+easily capture output with the \fBconfigure \-outfile\fR and
+\fBconfigure \-errfile\fR options, and so that the \fB\-output\fR
+and \fB\-errorOutput\fR attributes work properly.
+.SS "TEST CONSTRAINTS"
.PP
Constraints are used to determine whether or not a test should be skipped.
Each constraint has a name, which may be any string, and a boolean
-value. Each [\fBtest\fR] has a \fB-constraints\fR value which is a
+value. Each \fBtest\fR has a \fB\-constraints\fR value which is a
list of constraint names. There are two modes of constraint control.
Most frequently, the default mode is used, indicated by a setting
-of [\fBconfigure -limitconstraints\fR] to false. The test will run
+of \fBconfigure \-limitconstraints\fR to false. The test will run
only if all constraints in the list are true-valued. Thus,
-the \fB-constraints\fR option of [\fBtest\fR] is a convenient, symbolic
+the \fB\-constraints\fR option of \fBtest\fR is a convenient, symbolic
way to define any conditions required for the test to be possible or
-meaningful. For example, a [\fBtest\fR] with \fB-constraints unix\fR
+meaningful. For example, a \fBtest\fR with \fB\-constraints unix\fR
will only be run if the constraint \fBunix\fR is true, which indicates
the test suite is being run on a Unix platform.
.PP
-Each [\fBtest\fR] should include whatever \fB-constraints\fR are
+Each \fBtest\fR should include whatever \fB\-constraints\fR are
required to constrain it to run only where appropriate. Several
constraints are pre-defined in the \fBtcltest\fR package, listed
below. The registration of user-defined constraints is performed
-by the [\fBtestConstraint\fR] command. User-defined constraints
+by the \fBtestConstraint\fR command. User-defined constraints
may appear within a test file, or within the script specified
-by the [\fBconfigure -load\fR] or [\fBconfigure -loadfile\fR]
+by the \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR
options.
.PP
The following is a list of constraints pre-defined by the
\fBtcltest\fR package itself:
.TP
\fIsingleTestInterp\fR
-test can only be run if all test files are sourced into a single interpreter
+.
+This test can only be run if all test files are sourced into a single
+interpreter.
.TP
\fIunix\fR
-test can only be run on any Unix platform
+.
+This test can only be run on any Unix platform.
.TP
\fIwin\fR
-test can only be run on any Windows platform
+.
+This test can only be run on any Windows platform.
.TP
\fInt\fR
-test can only be run on any Windows NT platform
+.
+This test can only be run on any Windows NT platform.
.TP
\fI95\fR
-test can only be run on any Windows 95 platform
+.
+This test can only be run on any Windows 95 platform.
.TP
\fI98\fR
-test can only be run on any Windows 98 platform
+.
+This test can only be run on any Windows 98 platform.
.TP
\fImac\fR
-test can only be run on any Mac platform
+.
+This test can only be run on any Mac platform.
.TP
\fIunixOrWin\fR
-test can only be run on a Unix or Windows platform
+.
+This test can only be run on a Unix or Windows platform.
.TP
\fImacOrWin\fR
-test can only be run on a Mac or Windows platform
+.
+This test can only be run on a Mac or Windows platform.
.TP
\fImacOrUnix\fR
-test can only be run on a Mac or Unix platform
+.
+This test can only be run on a Mac or Unix platform.
.TP
\fItempNotWin\fR
-test can not be run on Windows. This flag is used to temporarily
+.
+This test can not be run on Windows. This flag is used to temporarily
disable a test.
.TP
\fItempNotMac\fR
-test can not be run on a Mac. This flag is used
+.
+This test can not be run on a Mac. This flag is used
to temporarily disable a test.
.TP
\fIunixCrash\fR
-test crashes if it's run on Unix. This flag is used to temporarily
+.
+This test crashes if it is run on Unix. This flag is used to temporarily
disable a test.
.TP
\fIwinCrash\fR
-test crashes if it's run on Windows. This flag is used to temporarily
+.
+This test crashes if it is run on Windows. This flag is used to temporarily
disable a test.
.TP
\fImacCrash\fR
-test crashes if it's run on a Mac. This flag is used to temporarily
+.
+This test crashes if it is run on a Mac. This flag is used to temporarily
disable a test.
.TP
\fIemptyTest\fR
-test is empty, and so not worth running, but it remains as a
+.
+This test is empty, and so not worth running, but it remains as a
place-holder for a test to be written in the future. This constraint
has value false to cause tests to be skipped unless the user specifies
otherwise.
.TP
\fIknownBug\fR
-test is known to fail and the bug is not yet fixed. This constraint
+.
+This test is known to fail and the bug is not yet fixed. This constraint
has value false to cause tests to be skipped unless the user specifies
otherwise.
.TP
\fInonPortable\fR
-test can only be run in some known development environment.
+.
+This test can only be run in some known development environment.
Some tests are inherently non-portable because they depend on things
like word length, file system configuration, window manager, etc.
This constraint has value false to cause tests to be skipped unless
the user specifies otherwise.
.TP
\fIuserInteraction\fR
-test requires interaction from the user. This constraint has
+.
+This test requires interaction from the user. This constraint has
value false to causes tests to be skipped unless the user specifies
otherwise.
.TP
\fIinteractive\fR
-test can only be run in if the interpreter is in interactive mode
+.
+This test can only be run in if the interpreter is in interactive mode
(when the global tcl_interactive variable is set to 1).
.TP
\fInonBlockFiles\fR
-test can only be run if platform supports setting files into
-nonblocking mode
+.
+This test can only be run if platform supports setting files into
+nonblocking mode.
.TP
\fIasyncPipeClose\fR
-test can only be run if platform supports async flush and async close
-on a pipe
+.
+This test can only be run if platform supports async flush and async close
+on a pipe.
.TP
\fIunixExecs\fR
-test can only be run if this machine has Unix-style commands
+.
+This test can only be run if this machine has Unix-style commands
\fBcat\fR, \fBecho\fR, \fBsh\fR, \fBwc\fR, \fBrm\fR, \fBsleep\fR,
-\fBfgrep\fR, \fBps\fR, \fBchmod\fR, and \fBmkdir\fR available
+\fBfgrep\fR, \fBps\fR, \fBchmod\fR, and \fBmkdir\fR available.
.TP
\fIhasIsoLocale\fR
-test can only be run if can switch to an ISO locale
+.
+This test can only be run if can switch to an ISO locale.
.TP
\fIroot\fR
-test can only run if Unix user is root
+.
+This test can only run if Unix user is root.
.TP
\fInotRoot\fR
-test can only run if Unix user is not root
+.
+This test can only run if Unix user is not root.
.TP
\fIeformat\fR
-test can only run if app has a working version of sprintf with respect
-to the "e" format of floating-point numbers.
+.
+This test can only run if app has a working version of sprintf with respect
+to the
+.QW e
+format of floating-point numbers.
.TP
\fIstdio\fR
-test can only be run if [\fBinterpreter\fR] can be [\fBopen\fR]ed
+.
+This test can only be run if \fBinterpreter\fR can be \fBopen\fRed
as a pipe.
.PP
The alternative mode of constraint control is enabled by setting
-[\fBconfigure -limitconstraints\fR] to true. With that configuration
+\fBconfigure \-limitconstraints\fR to true. With that configuration
setting, all existing constraints other than those in the constraint
-list returned by [\fBconfigure -constraints\fR] are set to false.
-When the value of [\fBconfigure -constraints\fR]
+list returned by \fBconfigure \-constraints\fR are set to false.
+When the value of \fBconfigure \-constraints\fR
is set, all those constraints are set to true. The effect is that
-when both options [\fBconfigure -constraints\fR] and
-[\fBconfigure -limitconstraints\fR] are in use, only those tests including
-only constraints from the [\fBconfigure -constraints\fR] list
+when both options \fBconfigure \-constraints\fR and
+\fBconfigure \-limitconstraints\fR are in use, only those tests including
+only constraints from the \fBconfigure \-constraints\fR list
are run; all others are skipped. For example, one might set
up a configuration with
+.PP
.CS
\fBconfigure\fR -constraints knownBug \e
-limitconstraints true \e
-verbose pass
.CE
+.PP
to run exactly those tests that exercise known bugs, and discover
-whether any of them pass, indicating the bug had been fixed.
-.SH "RUNNING ALL TESTS"
+whether any of them pass, indicating the bug had been fixed.
+.SS "RUNNING ALL TESTS"
.PP
-The single command [\fBrunAllTests\fR] is evaluated to run an entire
+The single command \fBrunAllTests\fR is evaluated to run an entire
test suite, spanning many files and directories. The configuration
options of \fBtcltest\fR control the precise operations. The
-[\fBrunAllTests\fR] command begins by printing a summary of its
-configuration to [\fBoutputChannel\fR].
+\fBrunAllTests\fR command begins by printing a summary of its
+configuration to \fBoutputChannel\fR.
.PP
Test files to be evaluated are sought in the directory
-[\fBconfigure -testdir\fR]. The list of files in that directory
-that match any of the patterns in [\fBconfigure -file\fR] and
-match none of the patterns in [\fBconfigure -notfile\fR] is generated
+\fBconfigure \-testdir\fR. The list of files in that directory
+that match any of the patterns in \fBconfigure \-file\fR and
+match none of the patterns in \fBconfigure \-notfile\fR is generated
and sorted. Then each file will be evaluated in turn. If
-[\fBconfigure -singleproc\fR] is true, then each file will
-be [\fBsource\fR]d in the caller's context. If it is false,
-then a copy of [\fBinterpreter\fR] will be [\fBexec\fR]d to
+\fBconfigure \-singleproc\fR is true, then each file will
+be \fBsource\fRd in the caller's context. If it is false,
+then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file. The multi-process operation is useful
when testing can cause errors so severe that a process
terminates. Although such an error may terminate a child
@@ -692,17 +806,17 @@ process evaluating one file, the master process can continue
with the rest of the test suite. In multi-process operation,
the configuration of \fBtcltest\fR in the master process is
passed to the child processes as command line arguments,
-with the exception of [\fBconfigure -outfile\fR]. The
-[\fBrunAllTests\fR] command in the
+with the exception of \fBconfigure \-outfile\fR. The
+\fBrunAllTests\fR command in the
master process collects all output from the child processes
and collates their results into one master report. Any
reports of individual test failures, or messages requested
-by a [\fBconfigure -verbose\fR] setting are passed directly
-on to [\fBoutputChannel\fR] by the master process.
+by a \fBconfigure \-verbose\fR setting are passed directly
+on to \fBoutputChannel\fR by the master process.
.PP
After evaluating all selected test files, a summary of the
-results is printed to [\fBoutputChannel\fR]. The summary
-includes the total number of [\fBtest\fR]s evaluated, broken
+results is printed to \fBoutputChannel\fR. The summary
+includes the total number of \fBtest\fRs evaluated, broken
down into those skipped, those passed, and those failed.
The summary also notes the number of files evaluated, and the names
of any files with failing tests or errors. A list of
@@ -710,176 +824,209 @@ the constraints that caused tests to be skipped, and the
number of tests skipped for each is also printed. Also,
messages are printed if it appears that evaluation of
a test file has caused any temporary files to be left
-behind in [\fBconfigure -tmpdir\fR].
+behind in \fBconfigure \-tmpdir\fR.
.PP
Having completed and summarized all selected test files,
-[\fBrunAllTests\fR] then recursively acts on subdirectories
-of [\fBconfigure -testdir\fR]. All subdirectories that
-match any of the patterns in [\fBconfigure -relateddir\fR]
+\fBrunAllTests\fR then recursively acts on subdirectories
+of \fBconfigure \-testdir\fR. All subdirectories that
+match any of the patterns in \fBconfigure \-relateddir\fR
and do not match any of the patterns in
-[\fBconfigure -asidefromdir\fR] are examined. If
+\fBconfigure \-asidefromdir\fR are examined. If
a file named \fBall.tcl\fR is found in such a directory,
-it will be [\fBsource\fR]d in the caller's context.
+it will be \fBsource\fRd in the caller's context.
Whether or not an examined directory contains an
\fBall.tcl\fR file, its subdirectories are also scanned
-against the [\fBconfigure -relateddir\fR] and
-[\fBconfigure -asidefromdir\fR] patterns. In this way,
+against the \fBconfigure \-relateddir\fR and
+\fBconfigure \-asidefromdir\fR patterns. In this way,
many directories in a directory tree can have all their
-test files evaluated by a single [\fBrunAllTests\fR]
+test files evaluated by a single \fBrunAllTests\fR
command.
.SH "CONFIGURABLE OPTIONS"
-The [\fBconfigure\fR] command is used to set and query the configurable
+The \fBconfigure\fR command is used to set and query the configurable
options of \fBtcltest\fR. The valid options are:
.TP
-\fB-singleproc \fIboolean\fR
-Controls whether or not [\fBrunAllTests\fR] spawns a child process for
+\fB\-singleproc \fIboolean\fR
+.
+Controls whether or not \fBrunAllTests\fR spawns a child process for
each test file. No spawning when \fIboolean\fR is true. Default
value is false.
.TP
-\fB-debug \fIlevel\fR
+\fB\-debug \fIlevel\fR
+.
Sets the debug level to \fIlevel\fR, an integer value indicating how
-much debugging information should be printed to stdout. Note that
-debug messages always go to stdout, independent of the value of
-[\fBconfigure -outfile\fR]. Default value is 0. Levels are defined as:
+much debugging information should be printed to \fBstdout\fR. Note that
+debug messages always go to \fBstdout\fR, independent of the value of
+\fBconfigure \-outfile\fR. Default value is 0. Levels are defined as:
.RS
-.IP 0
+.IP 0 4
Do not display any debug information.
.IP 1
Display information regarding whether a test is skipped because it
-doesn't match any of the tests that were specified using by
-[\fBconfigure -match\fR] (userSpecifiedNonMatch) or matches any of
-the tests specified by [\fBconfigure -skip\fR] (userSpecifiedSkip). Also
+does not match any of the tests that were specified using by
+\fBconfigure \-match\fR (userSpecifiedNonMatch) or matches any of
+the tests specified by \fBconfigure \-skip\fR (userSpecifiedSkip). Also
print warnings about possible lack of cleanup or balance in test files.
Also print warnings about any re-use of test names.
.IP 2
Display the flag array parsed by the command line processor, the
-contents of the ::env array, and all user-defined variables that exist
-in the current namespace as they are used.
+contents of the global \fBenv\fR array, and all user-defined variables
+that exist in the current namespace as they are used.
.IP 3
Display information regarding what individual procs in the test
harness are doing.
.RE
.TP
-\fB-verbose \fIlevel\fR
+\fB\-verbose \fIlevel\fR
+.
Sets the type of output verbosity desired to \fIlevel\fR,
a list of zero or more of the elements \fBbody\fR, \fBpass\fR,
-\fBskip\fR, \fBstart\fR, and \fBerror\fR. Default value
-is \fB{body error}\fR.
+\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR. Default value
+is
+.QW "\fBbody error\fR" .
Levels are defined as:
.RS
-.IP "body (b)"
+.IP "body (\fBb\fR)"
Display the body of failed tests
-.IP "pass (p)"
+.IP "pass (\fBp\fR)"
Print output when a test passes
-.IP "skip (s)"
+.IP "skip (\fBs\fR)"
Print output when a test is skipped
-.IP "start (t)"
+.IP "start (\fBt\fR)"
Print output whenever a test starts
-.IP "error (e)"
+.IP "error (\fBe\fR)"
Print errorInfo and errorCode, if they exist, when a test return code
does not match its expected return code
-.RE
+.IP "line (\fBl\fR)"
+Print source file line information of failed tests
+.PP
The single letter abbreviations noted above are also recognized
-so that [\fBconfigure -verbose pt\fR] is the same as
-[\fBconfigure -verbose {pass start}\fR].
+so that
+.QW "\fBconfigure \-verbose pt\fR"
+is the same as
+.QW "\fBconfigure \-verbose {pass start}\fR" .
+.RE
.TP
-\fB-preservecore \fIlevel\fR
+\fB\-preservecore \fIlevel\fR
+.
Sets the core preservation level to \fIlevel\fR. This level
determines how stringent checks for core files are. Default
value is 0. Levels are defined as:
.RS
.IP 0
-No checking - do not check for core files at the end of each test
-command, but do check for them in [\fBrunAllTests\fR] after all
+No checking \(em do not check for core files at the end of each test
+command, but do check for them in \fBrunAllTests\fR after all
test files have been evaluated.
.IP 1
-Also check for core files at the end of each [\fBtest\fR] command.
+Also check for core files at the end of each \fBtest\fR command.
.IP 2
Check for core files at all times described above, and save a
-copy of each core file produced in [\fBconfigure -tmpdir\fR].
+copy of each core file produced in \fBconfigure \-tmpdir\fR.
.RE
.TP
-\fB-limitconstraints \fIboolean\fR
-Sets the mode by which [\fBtest\fR] honors constraints as described
+\fB\-limitconstraints \fIboolean\fR
+.
+Sets the mode by which \fBtest\fR honors constraints as described
in \fBTESTS\fR above. Default value is false.
.TP
-\fB-constraints \fIlist\fR
+\fB\-constraints \fIlist\fR
+.
Sets all the constraints in \fIlist\fR to true. Also used in
-combination with [\fBconfigure -limitconstraints true\fR] to control an
+combination with \fBconfigure \-limitconstraints true\fR to control an
alternative constraint mode as described in \fBTESTS\fR above.
Default value is an empty list.
.TP
-\fB-tmpdir \fIdirectory\fR
-Sets the temporary directory to be used by [\fBmakeFile\fR],
-[\fBmakeDirectory\fR], [\fBviewFile\fR], [\fBremoveFile\fR],
-and [\fBremoveDirectory\fR] as the default directory where
+\fB\-tmpdir \fIdirectory\fR
+.
+Sets the temporary directory to be used by \fBmakeFile\fR,
+\fBmakeDirectory\fR, \fBviewFile\fR, \fBremoveFile\fR,
+and \fBremoveDirectory\fR as the default directory where
temporary files and directories created by test files should
-be created. Default value is [\fBworkingDirectory\fR].
-.TP
-\fB-testdir \fIdirectory\fR
-Sets the directory searched by [\fBrunAllTests\fR] for test files
-and subdirectories. Default value is [\fBworkingDirectory\fR].
-.TP
-\fB-file \fIpatternList\fR
-Sets the list of patterns used by [\fBrunAllTests\fR] to determine
-what test files to evaluate. Default value is \fB*.test\fR.
-.TP
-\fB-notfile \fIpatternList\fR
-Sets the list of patterns used by [\fBrunAllTests\fR] to determine
-what test files to skip. Default value is \fBl.*.test\fR, so
-that any SCCS lock files are skipped.
-.TP
-\fB-relateddir \fIpatternList\fR
-Sets the list of patterns used by [\fBrunAllTests\fR] to determine
+be created. Default value is \fBworkingDirectory\fR.
+.TP
+\fB\-testdir \fIdirectory\fR
+.
+Sets the directory searched by \fBrunAllTests\fR for test files
+and subdirectories. Default value is \fBworkingDirectory\fR.
+.TP
+\fB\-file \fIpatternList\fR
+.
+Sets the list of patterns used by \fBrunAllTests\fR to determine
+what test files to evaluate. Default value is
+.QW \fB*.test\fR .
+.TP
+\fB\-notfile \fIpatternList\fR
+.
+Sets the list of patterns used by \fBrunAllTests\fR to determine
+what test files to skip. Default value is
+.QW \fBl.*.test\fR ,
+so that any SCCS lock files are skipped.
+.TP
+\fB\-relateddir \fIpatternList\fR
+.
+Sets the list of patterns used by \fBrunAllTests\fR to determine
what subdirectories to search for an \fBall.tcl\fR file. Default
-value is \fB*\fR.
+value is
+.QW \fB*\fR .
.TP
-\fB-asidefromdir \fIpatternList\fR
-Sets the list of patterns used by [\fBrunAllTests\fR] to determine
+\fB\-asidefromdir \fIpatternList\fR
+.
+Sets the list of patterns used by \fBrunAllTests\fR to determine
what subdirectories to skip when searching for an \fBall.tcl\fR file.
Default value is an empty list.
.TP
-\fB-match \fIpatternList\fR
-Set the list of patterns used by [\fBtest\fR] to determine whether
-a test should be run. Default value is \fB*\fR.
+\fB\-match \fIpatternList\fR
+.
+Set the list of patterns used by \fBtest\fR to determine whether
+a test should be run. Default value is
+.QW \fB*\fR .
.TP
-\fB-skip \fIpatternList\fR
-Set the list of patterns used by [\fBtest\fR] to determine whether
+\fB\-skip \fIpatternList\fR
+.
+Set the list of patterns used by \fBtest\fR to determine whether
a test should be skipped. Default value is an empty list.
.TP
-\fB-load \fIscript\fR
-Sets a script to be evaluated by [\fBloadTestedCommands\fR].
+\fB\-load \fIscript\fR
+.
+Sets a script to be evaluated by \fBloadTestedCommands\fR.
Default value is an empty script.
.TP
-\fB-loadfile \fIfilename\fR
+\fB\-loadfile \fIfilename\fR
+.
Sets the filename from which to read a script to be evaluated
-by [\fBloadTestedCommands\fR]. This is an alternative to
-\fB-load\fR. They cannot be used together.
+by \fBloadTestedCommands\fR. This is an alternative to
+\fB\-load\fR. They cannot be used together.
.TP
-\fB-outfile \fIfilename\fR
+\fB\-outfile \fIfilename\fR
+.
Sets the file to which all output produced by tcltest should be
-written. A file named \fIfilename\fR will be [\fBopen\fR]ed for writing,
-and the resulting channel will be set as the value of [\fBoutputChannel\fR].
+written. A file named \fIfilename\fR will be \fBopen\fRed for writing,
+and the resulting channel will be set as the value of \fBoutputChannel\fR.
.TP
-\fB-errfile \fIfilename\fR
+\fB\-errfile \fIfilename\fR
+.
Sets the file to which all error output produced by tcltest
-should be written. A file named \fIfilename\fR will be [\fBopen\fR]ed
+should be written. A file named \fIfilename\fR will be \fBopen\fRed
for writing, and the resulting channel will be set as the value
-of [\fBerrorChannel\fR].
+of \fBerrorChannel\fR.
.SH "CREATING TEST SUITES WITH TCLTEST"
.PP
-The fundamental element of a test suite is the individual [\fBtest\fR]
+The fundamental element of a test suite is the individual \fBtest\fR
command. We begin with several examples.
.IP [1]
Test of a script that returns normally.
+.RS
+.PP
.CS
\fBtest\fR example-1.0 {normal return} {
format %s value
} value
.CE
+.RE
.IP [2]
Test of a script that requires context setup and cleanup. Note the
bracing and indenting style that avoids any need for line continuation.
+.RS
+.PP
.CS
\fBtest\fR example-1.1 {test file existence} -setup {
set file [makeFile {} test]
@@ -889,15 +1036,21 @@ bracing and indenting style that avoids any need for line continuation.
removeFile test
} -result 1
.CE
+.RE
.IP [3]
Test of a script that raises an error.
+.RS
+.PP
.CS
\fBtest\fR example-1.2 {error return} -body {
error message
} -returnCodes error -result message
.CE
+.RE
.IP [4]
Test with a constraint.
+.RS
+.PP
.CS
\fBtest\fR example-1.3 {user owns created files} -constraints {
unix
@@ -909,47 +1062,59 @@ Test with a constraint.
removeFile test
} -result $::tcl_platform(user)
.CE
+.RE
.PP
-At the next higher layer of organization, several [\fBtest\fR] commands
+At the next higher layer of organization, several \fBtest\fR commands
are gathered together into a single test file. Test files should have
-names with the \fB.test\fR extension, because that is the default pattern
-used by [\fBrunAllTests\fR] to find test files. It is a good rule of
+names with the
+.QW \fB.test\fR
+extension, because that is the default pattern
+used by \fBrunAllTests\fR to find test files. It is a good rule of
thumb to have one test file for each source code file of your project.
It is good practice to edit the test file and the source code file
together, keeping tests synchronized with code changes.
.PP
-Most of the code in the test file should be the [\fBtest\fR] commands.
+Most of the code in the test file should be the \fBtest\fR commands.
Use constraints to skip tests, rather than conditional evaluation
-of [\fBtest\fR]. That is, do this:
+of \fBtest\fR.
.IP [5]
+Recommended system for writing conditional tests, using constraints to
+guard:
+.RS
+.PP
.CS
\fBtestConstraint\fR X [expr $myRequirement]
\fBtest\fR goodConditionalTest {} X {
# body
} result
.CE
-and do not do this:
+.RE
.IP [6]
+Discouraged system for writing conditional tests, using \fBif\fR to
+guard:
+.RS
+.PP
.CS
if $myRequirement {
- test badConditionalTest {} {
- #body
+ \fBtest\fR badConditionalTest {} {
+ #body
} result
}
.CE
+.RE
.PP
-Use the \fB-setup\fR and \fB-cleanup\fR options to establish and release
+Use the \fB\-setup\fR and \fB\-cleanup\fR options to establish and release
all context requirements of the test body. Do not make tests depend on
prior tests in the file. Those prior tests might be skipped. If several
consecutive tests require the same context, the appropriate setup
and cleanup scripts may be stored in variable for passing to each tests
-\fB-setup\fR and \fB-cleanup\fR options. This is a better solution than
-performing setup outside of [\fBtest\fR] commands, because the setup will
+\fB\-setup\fR and \fB\-cleanup\fR options. This is a better solution than
+performing setup outside of \fBtest\fR commands, because the setup will
only be done if necessary, and any errors during setup will be reported,
and not cause the test file to abort.
.PP
A test file should be able to be combined with other test files and not
-interfere with them, even when [\fBconfigure -singleproc 1\fR] causes
+interfere with them, even when \fBconfigure \-singleproc 1\fR causes
all files to be evaluated in a common interpreter. A simple way to
achieve this is to have your tests define all their commands and variables
in a namespace that is deleted when the test file evaluation is complete.
@@ -957,14 +1122,16 @@ A good namespace to use is a child namespace \fBtest\fR of the namespace
of the module you are testing.
.PP
A test file should also be able to be evaluated directly as a script,
-not depending on being called by a master [\fBrunAllTests\fR]. This
+not depending on being called by a master \fBrunAllTests\fR. This
means that each test file should process command line arguments to give
the tester all the configuration control that \fBtcltest\fR provides.
.PP
-After all [\fBtest\fR]s in a test file, the command [\fBcleanupTests\fR]
+After all \fBtest\fRs in a test file, the command \fBcleanupTests\fR
should be called.
.IP [7]
Here is a sketch of a sample test file illustrating those points:
+.RS
+.PP
.CS
package require tcltest 2.2
eval \fB::tcltest::configure\fR $argv
@@ -975,36 +1142,40 @@ namespace eval ::example::test {
variable SETUP {#common setup code}
variable CLEANUP {#common cleanup code}
\fBtest\fR example-1 {} -setup $SETUP -body {
- # First test
+ # First test
} -cleanup $CLEANUP -result {...}
\fBtest\fR example-2 {} -constraints X -setup $SETUP -body {
- # Second test; constrained
+ # Second test; constrained
} -cleanup $CLEANUP -result {...}
\fBtest\fR example-3 {} {
- # Third test; no context required
+ # Third test; no context required
} {...}
\fBcleanupTests\fR
}
namespace delete ::example::test
.CE
+.RE
.PP
The next level of organization is a full test suite, made up of several
test files. One script is used to control the entire suite. The
-basic function of this script is to call [\fBrunAllTests\fR] after
+basic function of this script is to call \fBrunAllTests\fR after
doing any necessary setup. This script is usually named \fBall.tcl\fR
-because that's the default name used by [\fBrunAllTests\fR] when combining
+because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite master script:
+.RS
+.PP
.CS
package require Tcl 8.4
package require tcltest 2.2
package require example
-\fB::tcltest::configure\fR -testdir \
+\fB::tcltest::configure\fR -testdir \e
[file dirname [file normalize [info script]]]
eval \fB::tcltest::configure\fR $argv
\fB::tcltest::runAllTests\fR
.CE
+.RE
.SH COMPATIBILITY
.PP
A number of commands and variables in the \fB::tcltest\fR namespace
@@ -1014,21 +1185,30 @@ here. They are no longer part of the supported public interface of
to continue to support existing test suites written to the older
interface specifications, many of those deprecated commands and
variables still work as before. For example, in many circumstances,
-[\fBconfigure\fR] will be automatically called shortly after
-[\fBpackage require tcltest 2.1\fR] succeeds with arguments
+\fBconfigure\fR will be automatically called shortly after
+\fBpackage require\fR \fBtcltest 2.1\fR succeeds with arguments
from the variable \fB::argv\fR. This is to support test suites
that depend on the old behavior that \fBtcltest\fR was automatically
configured from command line arguments. New test files should not
depend on this, but should explicitly include
+.PP
.CS
eval \fB::tcltest::configure\fR $::argv
.CE
+.PP
+or
+.PP
+.CS
+\fB::tcltest::configure\fR {*}$::argv
+.CE
+.PP
to establish a configuration from command line arguments.
.SH "KNOWN ISSUES"
-There are two known issues related to nested evaluations of [\fBtest\fR].
+There are two known issues related to nested evaluations of \fBtest\fR.
The first issue relates to the stack level in which test scripts are
executed. Tests nested within other tests may be executed at the same
stack level as the outermost test. For example, in the following code:
+.PP
.CS
\fBtest\fR level-1.1 {level 1} {
-body {
@@ -1037,27 +1217,41 @@ stack level as the outermost test. For example, in the following code:
}
}
.CE
+.PP
any script executed in level-2.1 may be executed at the same stack
level as the script defined for level-1.1.
.PP
-In addition, while two [\fBtest\fR]s have been run, results will only
-be reported by [\fBcleanupTests\fR] for tests at the same level as
+In addition, while two \fBtest\fRs have been run, results will only
+be reported by \fBcleanupTests\fR for tests at the same level as
test level-1.1. However, test results for all tests run prior to
level-1.1 will be available when test level-2.1 runs. What this
means is that if you try to access the test results for test level-2.1,
-it will may say that 'm' tests have run, 'n' tests have
-been skipped, 'o' tests have passed and 'p' tests have failed,
-where 'm', 'n', 'o', and 'p' refer to tests that were run at the
-same test level as test level-1.1.
+it will may say that
+.QW m
+tests have run,
+.QW n
+tests have been skipped,
+.QW o
+tests have passed and
+.QW p
+tests have failed, where
+.QW m ,
+.QW n ,
+.QW o ,
+and
+.QW p
+refer to tests that were run at the same test level as test level-1.1.
.PP
Implementation of output and error comparison in the test command
-depends on usage of ::puts in your application code. Output is
-intercepted by redefining the ::puts command while the defined test
+depends on usage of \fBputs\fR in your application code. Output is
+intercepted by redefining the global \fBputs\fR command while the defined test
script is being run. Errors thrown by C procedures or printed
-directly from C applications will not be caught by the test command.
-Therefore, usage of the \fB-output\fR and \fB-errorOuput\fR
-options to [\fBtest\fR] is useful only for pure Tcl applications
-that use [\fB::puts\fR] to produce output.
-
+directly from C applications will not be caught by the \fBtest\fR command.
+Therefore, usage of the \fB\-output\fR and \fB\-errorOutput\fR
+options to \fBtest\fR is useful only for pure Tcl applications
+that use \fBputs\fR to produce output.
.SH KEYWORDS
test, test harness, test suite
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/tclvars.n b/doc/tclvars.n
index 627fb6f..9d7a4ce 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -5,29 +5,46 @@
'\" 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.22 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-tclvars \- Variables used by Tcl
+argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
.BE
-
.SH DESCRIPTION
.PP
The following global variables are created and managed automatically
by the Tcl library. Except where noted below, these variables should
normally be treated as read-only by application-specific code and by users.
.TP
+\fBauto_path\fR
+.
+If set, then it must contain a valid Tcl list giving directories to
+search during auto-load operations (including for package index
+files when using the default \fBpackage unknown\fR handler).
+This variable is initialized during startup to contain, in order:
+the directories listed in the \fBTCLLIBPATH\fR environment variable,
+the directory named by the \fBtcl_library\fR global variable,
+the parent directory of \fBtcl_library\fR,
+the directories listed in the \fBtcl_pkgPath\fR variable.
+Additional locations to look for files and package indices should
+normally be added to this variable using \fBlappend\fR.
+.RS
+.PP
+Additional variables relating to package management exist. More
+details are listed in the \fBVARIABLES\fR section of the \fBlibrary\fR
+manual page.
+.RE
+.TP
\fBenv\fR
+.
This variable is maintained by Tcl as an array
whose elements are the environment variables for the process.
Reading an element will return the value of the corresponding
environment variable.
Setting an element of the array will modify the corresponding
-environment variable or create a new one if it doesn't already
+environment variable or create a new one if it does not already
exist.
Unsetting an element of \fBenv\fR will remove the corresponding
environment variable.
@@ -37,32 +54,87 @@ If the entire \fBenv\fR array is unset then Tcl will stop
monitoring \fBenv\fR accesses and will not update environment
variables.
.RS
+.PP
Under Windows, the environment variables PATH and COMSPEC in any
capitalization are converted automatically to upper case. For instance, the
-PATH variable could be exported by the operating system as ``path'',
-``Path'', ``PaTh'', etc., causing otherwise simple Tcl code to have to
+PATH variable could be exported by the operating system as
+.QW path ,
+.QW Path ,
+.QW PaTh ,
+etc., causing otherwise simple Tcl code to have to
support many special cases. All other environment variables inherited by
Tcl are left unmodified. Setting an env array variable to blank is the
same as unsetting it as this is the behavior of the underlying Windows OS.
It should be noted that relying on an existing and empty environment variable
-won't work on windows and is discouraged for cross-platform usage.
+will not work on Windows and is discouraged for cross-platform usage.
+.PP
+The following elements of \fBenv\fR are special to Tcl:
+.TP
+\fBenv(HOME)\fR
+.
+This environment variable, if set, gives the location of the directory
+considered to be the current user's home directory, and to which a
+call of \fBcd\fR without arguments or with just
+.QW ~
+as an argument will change into. Most platforms set this correctly by
+default; it does not normally need to be set by user code.
+.TP
+\fBenv(TCL_LIBRARY)\fR
+.
+If set, then it specifies the location of the directory containing
+library scripts (the value of this variable will be
+assigned to the \fBtcl_library\fR variable and therefore returned by
+the command \fBinfo library\fR). If this variable is not set then
+a default value is used.
+.RS
+.PP
+Note that this environment variable should \fInot\fR normally be set.
+.RE
+.TP
+\fBenv(TCLLIBPATH)\fR
+.
+If set, then it must contain a valid Tcl list giving directories to
+search during auto-load operations. Directories must be specified in
+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
-This variable holds the value of the \fB-errorcode\fR return option
+.
+This variable holds the value of the \fB\-errorcode\fR return option
set by the most recent error that occurred in this interpreter.
This list value represents additional information about the error
in a form that is easy to process with programs.
The first element of the list identifies a general class of
errors, and determines the format of the rest of the list.
-The following formats for \fB-errorcode\fR return options
+The following formats for \fB\-errorcode\fR return options
are used by the Tcl core; individual applications may define
additional formats.
.RS
.TP
\fBARITH\fI code msg\fR
+.
This format is used when an arithmetic error occurs (e.g. an attempt
-to divide by zero in the \fBexpr\fR command).
+to divide zero by zero in the \fBexpr\fR command).
\fICode\fR identifies the precise error and \fImsg\fR provides a
human-readable description of the error. \fICode\fR will be either
DIVZERO (for an attempt to divide by zero),
@@ -70,24 +142,33 @@ DOMAIN (if an argument is outside the domain of a function, such as acos(\-3)),
IOVERFLOW (for integer overflow),
OVERFLOW (for a floating-point overflow),
or UNKNOWN (if the cause of the error cannot be determined).
+.RS
+.PP
+Detection of these errors depends in part on the underlying hardware
+and system libraries.
+.RE
.TP
\fBCHILDKILLED\fI pid sigName msg\fR
+.
This format is used when a child process has been killed because of
a signal. The \fIpid\fR element will be the process's identifier (in decimal).
The \fIsigName\fR element will be the symbolic name of the signal that caused
the process to terminate; it will be one of the names from the
include file signal.h, such as \fBSIGPIPE\fR.
The \fImsg\fR element will be a short human-readable message
-describing the signal, such as ``write on pipe with no readers''
+describing the signal, such as
+.QW "write on pipe with no readers"
for \fBSIGPIPE\fR.
.TP
\fBCHILDSTATUS\fI pid code\fR
+.
This format is used when a child process has exited with a non-zero
exit status. The \fIpid\fR element will be the
process's identifier (in decimal) and the \fIcode\fR element will be the exit
code returned by the process (also in decimal).
.TP
\fBCHILDSUSP\fI pid sigName msg\fR
+.
This format is used when a child process has been suspended because
of a signal.
The \fIpid\fR element will be the process's identifier, in decimal.
@@ -95,17 +176,20 @@ The \fIsigName\fR element will be the symbolic name of the signal that caused
the process to suspend; this will be one of the names from the
include file signal.h, such as \fBSIGTTIN\fR.
The \fImsg\fR element will be a short human-readable message
-describing the signal, such as ``background tty read''
+describing the signal, such as
+.QW "background tty read"
for \fBSIGTTIN\fR.
.TP
\fBNONE\fR
+.
This format is used for errors where no additional information is
available for an error besides the message returned with the
-error. In these cases the \fB-errorcode\fR return option
+error. In these cases the \fB\-errorcode\fR return option
will consist of a list containing a single element whose
contents are \fBNONE\fR.
.TP
\fBPOSIX \fIerrName msg\fR
+.
If the first element is \fBPOSIX\fR, then
the error occurred during a POSIX kernel call.
The \fIerrName\fR element will contain the symbolic name
@@ -113,19 +197,26 @@ of the error that occurred, such as \fBENOENT\fR; this will
be one of the values defined in the include file errno.h.
The \fImsg\fR element will be a human-readable
message corresponding to \fIerrName\fR, such as
-``no such file or directory'' for the \fBENOENT\fR case.
+.QW "no such file or directory"
+for the \fBENOENT\fR case.
+.TP
+\fBTCL\fR ...
+.
+Indicates some sort of problem generated in relation to Tcl itself, e.g. a
+failure to look up a channel or variable.
.PP
-To set the \fB-errorcode\fR return option, applications should use library
+To set the \fB\-errorcode\fR return option, applications should use library
procedures such as \fBTcl_SetObjErrorCode\fR, \fBTcl_SetReturnOptions\fR,
-and \fBTcl_PosixError\fR, or they may invoke the \fB-errorcode\fR
+and \fBTcl_PosixError\fR, or they may invoke the \fB\-errorcode\fR
option of the \fBreturn\fR command.
-If one of these methods hasn't been used, then the Tcl
-interpreter will reset the variable to \fBNONE\fR after
+If none of these methods for setting the error code has been used,
+the Tcl interpreter will reset the variable to \fBNONE\fR after
the next error.
.RE
.TP
\fBerrorInfo\fR
-This variable holds the value of the \fB-errorinfo\fR return option
+.
+This variable holds the value of the \fB\-errorinfo\fR return option
set by the most recent error that occurred in this interpreter.
This string value will contain one or more lines
identifying the Tcl commands and procedures that were being executed
@@ -134,6 +225,7 @@ Its contents take the form of a stack trace showing the various
nested Tcl commands that had been invoked at the time of the error.
.TP
\fBtcl_library\fR
+.
This variable holds the name of a directory containing the
system library of Tcl scripts, such as those used for auto-loading.
The value of this variable is returned by the \fBinfo library\fR command.
@@ -149,52 +241,58 @@ is created by searching several different directories until one is
found that contains an appropriate Tcl startup script.
If the \fBTCL_LIBRARY\fR environment variable exists, then
the directory it names is checked first.
-If \fBTCL_LIBRARY\fR isn't set or doesn't refer to an appropriate
+If \fBTCL_LIBRARY\fR is not set or doesn't refer to an appropriate
directory, then Tcl checks several other directories based on a
compiled-in default location, the location of the binary containing
the application, and the current working directory.
.TP
\fBtcl_patchLevel\fR
+.
When an interpreter is created Tcl initializes this variable to
hold a string giving the current patch level for Tcl, such as
-\fB7.3p2\fR for Tcl 7.3 with the first two official patches, or
-\fB7.4b4\fR for the fourth beta release of Tcl 7.4.
+\fB8.4.16\fR for Tcl 8.4 with the first sixteen official patches, or
+\fB8.5b3\fR for the third beta release of Tcl 8.5.
The value of this variable is returned by the \fBinfo patchlevel\fR
command.
.TP
\fBtcl_pkgPath\fR
+.
This variable holds a list of directories indicating where packages are
normally installed. It is not used on Windows. It typically contains
either one or two entries; if it contains two entries, the first is
normally a directory for platform-dependent packages (e.g., shared library
binaries) and the second is normally a directory for platform-independent
packages (e.g., script files). Typically a package is installed as a
-subdirectory of one of the entries in \fB$tcl_pkgPath\fR. The directories
-in \fB$tcl_pkgPath\fR are included by default in the \fBauto_path\fR
+subdirectory of one of the entries in the \fBtcl_pkgPath\fR
+variable. The directories in the \fBtcl_pkgPath\fR variable are
+included by default in the \fBauto_path\fR
variable, so they and their immediate subdirectories are automatically
searched for packages during \fBpackage require\fR commands. Note:
-\fBtcl_pkgPath\fR it not intended to be modified by the application. Its
+\fBtcl_pkgPath\fR is not intended to be modified by the application. Its
value is added to \fBauto_path\fR at startup; changes to \fBtcl_pkgPath\fR
are not reflected in \fBauto_path\fR. If you want Tcl to search additional
directories for packages you should add the names of those directories to
\fBauto_path\fR, not \fBtcl_pkgPath\fR.
.TP
\fBtcl_platform\fR
+.
This is an associative array whose elements contain information about
the platform on which the application is running, such as the name of
the operating system, its current release number, and the machine's
instruction set. The elements listed below will always
-be defined, but they may have empty strings as values if Tcl couldn't
+be defined, but they may have empty strings as values if Tcl could not
retrieve any relevant information. In addition, extensions
and applications may add additional values to the array. The
predefined elements are:
.RS
.TP
\fBbyteOrder\fR
+.
The native byte order of this machine: either \fBlittleEndian\fR or
\fBbigEndian\fR.
.TP
\fBdebug\fR
+.
If this variable exists, then the interpreter was compiled with and linked
to a debug-enabled C run-time. This variable will only exist on Windows,
so extension writers can specify which package to load depending on the
@@ -202,11 +300,13 @@ C run-time library that is in use. This is not an indication that this core
contains symbols.
.TP
\fBmachine\fR
+.
The instruction set executed by this machine, such as
\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR. On UNIX machines, this
is the value returned by \fBuname -m\fR.
.TP
-\fBos\fR
+\fBos\fR
+.
The name of the operating system running on this machine,
such as \fBWindows 95\fR, \fBWindows NT\fR, or \fBSunOS\fR.
On UNIX machines, this is the value returned by \fBuname -s\fR.
@@ -215,37 +315,55 @@ On Windows 95 and Windows 98, the value returned will be \fBWindows
distinguish between the two, check the \fBosVersion\fR.
.TP
\fBosVersion\fR
+.
The version number for the operating system running on this machine.
On UNIX machines, this is the value returned by \fBuname -r\fR. On
Windows 95, the version will be 4.0; on Windows 98, the version will
be 4.10.
.TP
+\fBpathSeparator\fR
+.VS 8.6
+'\" Defined by TIP #315
+The character that should be used to \fBsplit\fR PATH-like environment
+variables into their corresponding list of directory names.
+.VE 8.6
+.TP
\fBplatform\fR
+.
Either \fBwindows\fR, or \fBunix\fR. This identifies the
general operating environment of the machine.
.TP
+\fBpointerSize\fR
+.
+This gives the size of the native-machine pointer in bytes (strictly, it
+is same as the result of evaluating \fIsizeof(void*)\fR in C.)
+.TP
\fBthreaded\fR
+.
If this variable exists, then the interpreter
was compiled with threads enabled.
.TP
\fBuser\fR
+.
This identifies the
current user based on the login information available on the platform.
This comes from the USER or LOGNAME environment variable on Unix,
and the value from GetUserName on Windows.
.TP
\fBwordSize\fR
+.
This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP
\fBtcl_precision\fR
+.
This variable controls the number of digits to generate
when converting floating-point values to strings. It defaults
-.VS 8.5
to 0. \fIApplications should not change this value;\fR it is
provided for compatibility with legacy code.
.PP
+.RS
The default value of 0 is special, meaning that Tcl should
convert numbers using as few digits as possible while still
distinguishing any floating point number from its nearest
@@ -254,22 +372,47 @@ for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
even though the latter is nearer to the exact value of the
binary number.
-.VE 8.5
+.RE
+.PP
+.RS
+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
-17 digits is ``perfect'' for IEEE floating-point in that it allows
+.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 process share a single \fBtcl_precision\fR value:
+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
+.
This variable is used during initialization to indicate the name of a
user-specific startup file. If it is set by application-specific
initialization, then the Tcl startup code will check for the existence
@@ -278,64 +421,73 @@ the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
for Windows.
.TP
\fBtcl_traceCompile\fR
+.
The value of this variable can be set to control
how much tracing information
is displayed during bytecode compilation.
-By default, tcl_traceCompile is zero and no information is displayed.
-Setting tcl_traceCompile to 1 generates a one-line summary in stdout
+By default, \fBtcl_traceCompile\fR is zero and no information is displayed.
+Setting \fBtcl_traceCompile\fR to 1 generates a one-line summary in \fBstdout\fR
whenever a procedure or top-level command is compiled.
-Setting it to 2 generates a detailed listing in stdout of the
+Setting it to 2 generates a detailed listing in \fBstdout\fR of the
bytecode instructions emitted during every compilation.
This variable is useful in
tracking down suspected problems with the Tcl compiler.
-It is also occasionally useful when converting
-existing code to use Tcl8.0.
.PP
+.RS
This variable and functionality only exist if
\fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation.
+.RE
.TP
\fBtcl_traceExec\fR
+.
The value of this variable can be set to control
how much tracing information
is displayed during bytecode execution.
-By default, tcl_traceExec is zero and no information is displayed.
-Setting tcl_traceExec to 1 generates a one-line trace in stdout
+By default, \fBtcl_traceExec\fR is zero and no information is displayed.
+Setting \fBtcl_traceExec\fR to 1 generates a one-line trace in \fBstdout\fR
on each call to a Tcl procedure.
Setting it to 2 generates a line of output
whenever any Tcl command is invoked
that contains the name of the command and its arguments.
Setting it to 3 produces a detailed trace showing the result of
executing each bytecode instruction.
-Note that when tcl_traceExec is 2 or 3,
+Note that when \fBtcl_traceExec\fR is 2 or 3,
commands such as \fBset\fR and \fBincr\fR
that have been entirely replaced by a sequence
of bytecode instructions are not shown.
Setting this variable is useful in
tracking down suspected problems with the bytecode compiler
and interpreter.
-It is also occasionally useful when converting
-code to use Tcl8.0.
.PP
+.RS
This variable and functionality only exist if
\fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation.
+.RE
.TP
\fBtcl_wordchars\fR
+.
The value of this variable is a regular expression that can be set to
-control what are considered ``word'' characters, for instances like
+control what are considered
+.QW word
+characters, for instances like
selecting a word by double-clicking in text in Tk. It is platform
-dependent. On Windows, it defaults to \fB\\S\fR, meaning anything
-but a Unicode space character. Otherwise it defaults to \fB\\w\fR,
+dependent. On Windows, it defaults to \fB\eS\fR, meaning anything
+but a Unicode space character. Otherwise it defaults to \fB\ew\fR,
which is any Unicode word character (number, letter, or underscore).
.TP
\fBtcl_nonwordchars\fR
+.
The value of this variable is a regular expression that can be set to
-control what are considered ``non-word'' characters, for instances like
+control what are considered
+.QW non-word
+characters, for instances like
selecting a word by double-clicking in text in Tk. It is platform
-dependent. On Windows, it defaults to \fB\\s\fR, meaning any Unicode space
-character. Otherwise it defaults to \fB\\W\fR, which is anything but a
+dependent. On Windows, it defaults to \fB\es\fR, meaning any Unicode space
+character. Otherwise it defaults to \fB\eW\fR, which is anything but a
Unicode word character (number, letter, or underscore).
.TP
\fBtcl_version\fR
+.
When an interpreter is created Tcl initializes this variable to
hold the version number for this version of Tcl in the form \fIx.y\fR.
Changes to \fIx\fR represent major changes with probable
@@ -344,35 +496,71 @@ 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.
.TP 6
\fBargc\fR
+.
The number of arguments to \fBtclsh\fR or \fBwish\fR.
.TP 6
\fBargv\fR
+.
Tcl list of arguments to \fBtclsh\fR or \fBwish\fR.
.TP 6
\fBargv0\fR
+.
The script that \fBtclsh\fR or \fBwish\fR started executing (if it was
specified) or otherwise the name by which \fBtclsh\fR or \fBwish\fR
was invoked.
.TP 6
\fBtcl_interactive\fR
+.
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
-The \fBwish\fR executably additionally specifies the following global
-variable:
-.TP 6
-\fBgeometry\fR
-If set, contains the user-supplied geometry specification to use for
-the main Tk window.
-
+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), tclsh(1), wish(1)
-
+eval(n), library(n), tclsh(1), tkvars(n), wish(1)
.SH KEYWORDS
-arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables
+arithmetic, bytecode, compiler, error, environment, POSIX, precision,
+subprocess, user, variables
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/tell.n b/doc/tell.n
index a25b111..e8bf3af 100644
--- a/doc/tell.n
+++ b/doc/tell.n
@@ -5,10 +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: tell.n,v 1.9 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH tell n 8.1 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ tell \- Return current access position for an open channel
.SH SYNOPSIS
\fBtell \fIchannelId\fR
.BE
-
.SH DESCRIPTION
.PP
Returns an integer string giving the current access position in
@@ -31,7 +28,9 @@ 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.
.SH EXAMPLE
+.PP
Read a line from a file channel only if it starts with \fBfoobar\fR:
+.PP
.CS
# Save the offset in case we need to undo the read...
set offset [\fBtell\fR $chan]
@@ -43,9 +42,7 @@ if {[read $chan 6] eq "foobar"} {
seek $chan $offset
}
.CE
-
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
-
.SH KEYWORDS
access position, channel, seeking
diff --git a/doc/throw.n b/doc/throw.n
new file mode 100644
index 0000000..0d1df78
--- /dev/null
+++ b/doc/throw.n
@@ -0,0 +1,48 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH throw n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+throw \- Generate a machine-readable error
+.SH SYNOPSIS
+\fBthrow\fI type message\fR
+.BE
+.SH DESCRIPTION
+.PP
+This command causes the current evaluation to be unwound with an error. The
+error created is described by the \fItype\fR and \fImessage\fR arguments:
+\fItype\fR must contain a list of words describing the error in a form that is
+machine-readable (and which will form the error-code part of the result
+dictionary), and \fImessage\fR should contain text that is intended for
+display to a human being.
+.PP
+The stack will be unwound until the error is trapped by a suitable \fBcatch\fR
+or \fBtry\fR command. If it reaches the event loop without being trapped, it
+will be reported through the \fBbgerror\fR mechanism. If it reaches the top
+level of script evaluation in \fBtclsh\fR, it will be printed on the console
+before, in the non-interactive case, causing an exit (the behavior in other
+programs will depend on the details of how Tcl is embedded and used).
+.PP
+By convention, the words in the \fItype\fR argument should go from most
+general to most specific.
+.SH EXAMPLES
+.PP
+The following produces an error that is identical to that produced by
+\fBexpr\fR when trying to divide a value by zero.
+.PP
+.CS
+\fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero}
+.CE
+.SH "SEE ALSO"
+catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n)
+.SH "KEYWORDS"
+error, exception
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/time.n b/doc/time.n
index 47f967f..35b41c4 100644
--- a/doc/time.n
+++ b/doc/time.n
@@ -5,10 +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: time.n,v 1.5 2004/10/27 14:43:54 dkf Exp $
-'\"
-.so man.macros
.TH time n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,21 +14,23 @@ time \- Time the execution of a script
.SH SYNOPSIS
\fBtime \fIscript\fR ?\fIcount\fR?
.BE
-
.SH DESCRIPTION
.PP
This command will call the Tcl interpreter \fIcount\fR
-times to evaluate \fIscript\fR (or once if \fIcount\fR isn't
+times to evaluate \fIscript\fR (or once if \fIcount\fR is not
specified). It will then return a string of the form
+.PP
.CS
-\fB503 microseconds per iteration\fR
+\fB503.2 microseconds per iteration\fR
.CE
+.PP
which indicates the average amount of time required per iteration,
in microseconds.
Time is measured in elapsed time, not CPU time.
.SH EXAMPLE
Estimate how long it takes for a simple Tcl \fBfor\fR loop to count to
a thousand:
+.PP
.CS
time {
for {set i 0} {$i<1000} {incr i} {
@@ -38,9 +38,10 @@ time {
}
}
.CE
-
.SH "SEE ALSO"
clock(n)
-
.SH KEYWORDS
script, time
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/tm.n b/doc/tm.n
index aa33fc4..5602686 100644
--- a/doc/tm.n
+++ b/doc/tm.n
@@ -1,31 +1,31 @@
'\"
-'\" Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+'\" Copyright (c) 2004-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" 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.5 2004/11/12 09:01:25 das Exp $
-'\"
-.so man.macros
.TH tm n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
tm \- Facilities for locating and loading of Tcl Modules
.SH SYNOPSIS
.nf
-\fB::tcl::tm::path\fR \fBadd\fR \fIpath\fR...
-\fB::tcl::tm::path\fR \fBremove\fR \fIpath\fR...
-\fB::tcl::tm::path\fR \fBlist\fR
-\fB::tcl::tm::roots\fR \fIpath\fR...
+\fB::tcl::tm::path add \fR?\fIpath\fR...?
+\fB::tcl::tm::path remove \fR?\fIpath\fR...?
+\fB::tcl::tm::path list\fR
+\fB::tcl::tm::roots \fR?\fIpath\fR...?
.fi
.BE
-
.SH DESCRIPTION
+.PP
This document describes the facilities for locating and loading Tcl
-Modules. The following commands are supported:
+Modules (see \fBMODULE DEFINITION\fR for the definition of a Tcl Module).
+The following commands are supported:
.TP
-\fB::tcl::tm::path\fR \fBadd\fR \fIpath\fR...
+\fB::tcl::tm::path add \fR?\fIpath\fR...?
+.
The paths are added at the head to the list of module paths, in order
of appearance. This means that the last argument ends up as the new
head of the list.
@@ -46,18 +46,24 @@ reverse order of addition. In other words, the paths added last are
looked at first.
.RE
.TP
-\fB::tcl::tm::path\fR \fBremove\fR \fIpath\fR...
+\fB::tcl::tm::path remove \fR?\fIpath\fR...?
+.
Removes the paths from the list of module paths. The command silently
ignores all paths which are not on the list.
.TP
-\fB::tcl::tm::path\fR \fBlist\fR
+\fB::tcl::tm::path list\fR
+.
Returns a list containing all registered module paths, in the order
that they are searched for modules.
.TP
-\fB::tcl::tm::roots\fR \fIpath\fR...
+\fB::tcl::tm::roots \fR?\fIpath\fR...?
+.
Similar to \fBpath add\fR, and layered on top of it. This command
-takes a list of paths, extends each with "\fBtcl\fIX\fB/site-tcl\fR",
-and "\fBtcl\fIX\fB/\fIX\fB.\fIy\fR", for major version \fIX\fR of the
+takes a list of paths, extends each with
+.QW "\fBtcl\fIX\fB/site-tcl\fR" ,
+and
+.QW "\fBtcl\fIX\fB/\fIX\fB.\fIy\fR" ,
+for major version \fIX\fR of the
Tcl interpreter and minor version \fIy\fR less than or equal to the
minor version of the interpreter, and adds the resulting set of paths
to the list of paths to search.
@@ -66,13 +72,15 @@ to the list of paths to search.
This command is used internally by the system to set up the
system-specific default paths.
.PP
-The command has been exposed to allow a buildsystem to define
+The command has been exposed to allow a build system to define
additional root paths beyond those described by this document.
.RE
.SH "MODULE DEFINITION"
+.PP
A Tcl Module is a Tcl Package contained in a single file, and no other
files required by it. This file has to be \fBsource\fRable. In other
words, a Tcl Module is always imported via:
+.PP
.CS
source module_file
.CE
@@ -86,19 +94,21 @@ attached data in any it chooses to fully import and activate the
package.
.PP
The name of a module file has to match the regular expression:
+.PP
.CS
-([[:alpha:]][:[:alnum:]]*)-([[:digit:]].*)\\.tm
+([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)\e.tm
.CE
.PP
The first capturing parentheses provides the name of the package, the
second clause its version. In addition to matching the pattern, the
extracted version number must not raise an error when used in the
command:
+.PP
.CS
package vcompare $version 0
.CE
-.PP
.SH "FINDING MODULES"
+.PP
The directory tree for storing Tcl modules is separate from other
parts of the filesystem and independent of \fBauto_path\fR.
.PP
@@ -107,27 +117,41 @@ of the command \fB::tcl::tm::path list\fR.
This is called the \fIModule path\fR. Neither the \fBauto_path\fR nor
the \fBtcl_pkgPath\fR variables are used.
All directories on the module path have to obey one restriction:
-.IP
+.RS
+.PP
For any two directories, neither is an ancestor directory of the
other.
+.RE
.PP
This is required to avoid ambiguities in package naming. If for
-example the two directories "\fIfoo/\fR" and "\fIfoo/cool\fR" were on
+example the two directories
+.QW "\fIfoo/\fR"
+and
+.QW "\fIfoo/cool\fR"
+were on
the path a package named \fBcool::ice\fR could be found via the
names \fBcool::ice\fR or \fBice\fR, the latter potentially
obscuring a package named \fBice\fR, unqualified.
.PP
Before the search is started, the name of the requested package is
translated into a partial path, using the following algorithm:
-.IP
-All occurrences of "\fB::\fR" in the package name are replaced by
+.RS
+.PP
+All occurrences of
+.QW "\fB::\fR"
+in the package name are replaced by
the appropriate directory separator character for the platform we are
-on. On Unix, for example, this is "\fB/\fR".
+on. On Unix, for example, this is
+.QW "\fB/\fR" .
+.RE
.PP
Example:
-.IP
+.RS
+.PP
The requested package is \fBencoding::base64\fR. The generated
-partial path is "\fIencoding/base64\fR"
+partial path is
+.QW "\fIencoding/base64\fR" .
+.RE
.PP
After this translation the package is looked for in all module paths,
by combining them one-by-one, first to last with the partial path to
@@ -145,10 +169,13 @@ Note that packages in module form have \fIno\fR control over the
\fIindex\fR and \fIprovide script\fRs entered into the package
database for them.
For a module file \fBMF\fR the \fIindex script\fR is always:
+.PP
.CS
package ifneeded \fBPNAME PVERSION\fR [list source \fBMF\fR]
.CE
+.PP
and the \fIprovide script\fR embedded in the above is:
+.PP
.CS
source \fBMF\fR
.CE
@@ -156,13 +183,15 @@ source \fBMF\fR
Both package name \fBPNAME\fR and package version \fBPVERSION\fR are
extracted from the filename \fBMF\fR according to the definition
below:
+.PP
.CS
-\fBMF\fR = /module_path/\fBPNAME'\fR-\fBPVERSION\fR.tm
+\fBMF\fR = /module_path/\fBPNAME\(fm\fR-\fBPVERSION\fR.tm
.CE
.PP
-Where \fBPNAME'\fR is the partial path of the module as defined in
-section \fBFINDING MODULES\fR, and translated into \fB\fRPNAME by
-changing all directory separators to "\fB::\fR",
+Where \fBPNAME\(fm\fR is the partial path of the module as defined in
+section \fBFINDING MODULES\fR, and translated into \fBPNAME\fR by
+changing all directory separators to
+.QW "\fB::\fR" ,
and \fBmodule_path\fR is the path (from the list of paths to search)
that we found the module file under.
.PP
@@ -179,6 +208,7 @@ package \fBFoo\fR is deployed in the form of a Tcl Module,
packages like \fBfoo\fR, \fBfOo\fR, etc. are not allowed
anymore.
.SH "DEFAULT PATHS"
+.PP
The default list of paths on the module path is computed by a
\fBtclsh\fR as follows, where \fIX\fR is the major version of the Tcl
interpreter and \fIy\fR is less than or equal to the minor version of
@@ -196,12 +226,14 @@ are found in the variable.
.SS "SYSTEM SPECIFIC PATHS"
.TP
\fBfile normalize [info library]/../tcl\fIX\fB/\fIX\fB.\fIy\fR
+.
In other words, the interpreter will look into a directory specified
by its major version and whose minor versions are less than or equal
to the minor version of the interpreter.
.RS
.PP
For example for Tcl 8.4 the paths searched are:
+.PP
.CS
\fB[info library]/../tcl8/8.4\fR
\fB[info library]/../tcl8/8.3\fR
@@ -216,6 +248,7 @@ can also be used by all interpreters which have the same major number
.RE
.TP
\fBfile normalize EXEC/tcl\fIX\fB/\fIX\fB.\fIy\fR
+.
Where \fBEXEC\fR is \fBfile normalize [info nameofexecutable]/../lib\fR
or \fBfile normalize [::tcl::pkgconfig get libdir,runtime]\fR
.RS
@@ -228,38 +261,48 @@ identical.
.SS "SITE SPECIFIC PATHS"
.TP
\fBfile normalize [info library]/../tcl\fIX\fB/site-tcl\fR
+.
Note that this is always a single entry because \fIX\fR is always a
specific value (the current major version of Tcl).
.SS "USER SPECIFIC PATHS"
.TP
-\fB$::env(TCL\fIX\fB.\fIy\fB_TM_PATH)\fR
+\fB$::env(TCL\fIX\fB_\fIy\fB_TM_PATH)\fR
+.
A list of paths, separated by either \fB:\fR (Unix) or \fB;\fR
(Windows). This is user and site specific as this environment variable
can be set not only by the user's profile, but by system configuration
scripts as well.
-.RS
+.TP
+\fB$::env(TCL\fIX\fB.\fIy\fB_TM_PATH)\fR
+.
+Same meaning and content as the previous variable. However the use of
+dot '.' to separate major and minor version number makes this name
+less to non-portable and its use is discouraged. Support of this
+variable has been kept only for backward compatibility with the
+original specification, i.e. TIP 189.
.PP
These paths are seen and therefore shared by all Tcl shells in the
\fB$::env(PATH)\fR of the user.
.PP
Note that \fIX\fR and \fIy\fR follow the general rules set out
-above. In other words, Tcl 8.4, for example, will look at these 5
+above. In other words, Tcl 8.4, for example, will look at these 10
environment variables:
+.PP
.CS
-\fB$::env(TCL8.4_TM_PATH)\fR
-\fB$::env(TCL8.3_TM_PATH)\fR
-\fB$::env(TCL8.2_TM_PATH)\fR
-\fB$::env(TCL8.1_TM_PATH)\fR
-\fB$::env(TCL8.0_TM_PATH)\fR
+\fB$::env(TCL8.4_TM_PATH)\fR \fB$::env(TCL8_4_TM_PATH)\fR
+\fB$::env(TCL8.3_TM_PATH)\fR \fB$::env(TCL8_3_TM_PATH)\fR
+\fB$::env(TCL8.2_TM_PATH)\fR \fB$::env(TCL8_2_TM_PATH)\fR
+\fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR
+\fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR
.CE
-.RE
-
.SH "SEE ALSO"
-package(n), Tcl Improvement Proposal #189 "\fITcl Modules\fR" (online
-at http://tip.tcl.tk/189.html), Tcl Improvement Proposal #190
-"\fIImplementation Choices for Tcl Modules\fR" (online at
-http://tip.tcl.tk/190.html)
-
-
+package(n), Tcl Improvement Proposal #189
+.QW "\fITcl Modules\fR"
+(online at http://tip.tcl.tk/189.html), Tcl Improvement Proposal #190
+.QW "\fIImplementation Choices for Tcl Modules\fR"
+(online at http://tip.tcl.tk/190.html)
.SH "KEYWORDS"
modules, package
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/trace.n b/doc/trace.n
index c8d7914..4ae7e19 100644
--- a/doc/trace.n
+++ b/doc/trace.n
@@ -6,10 +6,8 @@
'\" 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.18 2004/10/27 14:43:54 dkf Exp $
-'\"
-.so man.macros
.TH trace n "8.4" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -17,52 +15,59 @@ trace \- Monitor variable accesses, command usages and command executions
.SH SYNOPSIS
\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
-invoked. The legal \fIoption\fR's (which may be abbreviated) are:
+invoked. The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops ?args?\fR
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
-\fBtrace add command\fR \fIname ops command\fR
-Arrange for \fIcommand\fR to be executed whenever command \fIname\fR
-is modified in one of the ways given by the list \fIops\fR. \fIName\fR will be
-resolved using the usual namespace resolution rules used by
-procedures. If the command does not exist, an error will be thrown.
+\fBtrace add command\fR \fIname ops commandPrefix\fR
+.
+Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
+whenever command \fIname\fR is modified in one of the ways given by the list
+\fIops\fR. \fIName\fR will be resolved using the usual namespace resolution
+rules used by commands. If the command does not exist, an error will be
+thrown.
.RS
.PP
\fIOps\fR indicates which operations are of interest, and is a list of
one or more of the following items:
.TP
\fBrename\fR
-Invoke \fIcommand\fR whenever the command is renamed. Note that
-renaming to the empty string is considered deletion, and will not
-be traced with '\fBrename\fR'.
+.
+Invoke \fIcommandPrefix\fR whenever the traced command is renamed. Note that
+renaming to the empty string is considered deletion, and will not be traced
+with
+.QW \fBrename\fR .
.TP
\fBdelete\fR
-Invoke \fIcommand\fR when the command is deleted. Commands can be
-deleted explicitly by using the \fBrename\fR command to rename the
-command to an empty string. Commands are also deleted when the
-interpreter is deleted, but traces will not be invoked because there is no
-interpreter in which to execute them.
+.
+Invoke \fIcommandPrefix\fR when the traced command is deleted. Commands can be
+deleted explicitly by using the \fBrename\fR command to rename the command to
+an empty string. Commands are also deleted when the interpreter is deleted,
+but traces will not be invoked because there is no interpreter in which to
+execute them.
+.PP
+When the trace triggers, depending on the operations being traced, a number of
+arguments are appended to \fIcommandPrefix\fR so that the actual command is as
+follows:
.PP
-When the trace triggers, depending on the operations being traced, a
-number of arguments are appended to \fIcommand\fR so that the actual
-command is as follows:
.CS
-\fIcommand oldName newName op\fR
+\fIcommandPrefix oldName newName op\fR
.CE
-\fIOldName\fR and \fInewName\fR give the traced command's current
-(old) name, and the name to which it is being renamed (the empty
-string if this is a 'delete' operation).
+.PP
+\fIOldName\fR and \fInewName\fR give the traced command's current (old) name,
+and the name to which it is being renamed (the empty string if this is a
+.QW delete
+operation).
\fIOp\fR indicates what operation is being performed on the
command, and is one of \fBrename\fR or \fBdelete\fR as
defined above. The trace operation cannot be used to stop a command
from being deleted. Tcl will always remove the command once the trace
-is complete. Recursive renaming or deleting will not cause further traces
+is complete. Recursive renaming or deleting will not cause further traces
of the same type to be evaluated, so a delete trace which itself
deletes the command, or a rename trace which itself renames the
command will not cause further trace evaluations to occur.
@@ -70,90 +75,104 @@ Both \fIoldName\fR and \fInewName\fR are fully qualified with any namespace(s)
in which they appear.
.RE
.TP
-\fBtrace add execution\fR \fIname ops command\fR
-Arrange for \fIcommand\fR to be executed whenever command \fIname\fR
-is executed, with traces occurring at the points indicated by the list
-\fIops\fR. \fIName\fR will be
-resolved using the usual namespace resolution rules used by
-procedures. If the command does not exist, an error will be thrown.
+\fBtrace add execution\fR \fIname ops commandPrefix\fR
+.
+Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
+whenever command \fIname\fR is executed, with traces occurring at the points
+indicated by the list \fIops\fR. \fIName\fR will be resolved using the usual
+namespace resolution rules used by commands. If the command does not exist,
+an error will be thrown.
.RS
.PP
\fIOps\fR indicates which operations are of interest, and is a list of
one or more of the following items:
.TP
\fBenter\fR
-Invoke \fIcommand\fR whenever the command \fIname\fR is executed,
+Invoke \fIcommandPrefix\fR whenever the command \fIname\fR is executed,
just before the actual execution takes place.
.TP
\fBleave\fR
-Invoke \fIcommand\fR whenever the command \fIname\fR is executed,
+Invoke \fIcommandPrefix\fR whenever the command \fIname\fR is executed,
just after the actual execution takes place.
.TP
\fBenterstep\fR
-Invoke \fIcommand\fR for every Tcl command which is executed
-inside the procedure \fIname\fR, just before the actual execution
-takes place. For example if we have 'proc foo {} { puts "hello" }',
-then an \fIenterstep\fR trace would be
-invoked just before \fIputs "hello"\fR is executed.
-Setting an \fIenterstep\fR trace on a \fIcommand\fR
-will not result in an error and is simply ignored.
+.
+Invoke \fIcommandPrefix\fR for every Tcl command which is executed from the
+start of the execution of the procedure \fIname\fR until that
+procedure finishes. \fICommandPrefix\fR is invoked just before the actual
+execution of the Tcl command being reported takes place. For example
+if we have
+.QW "proc foo {} { puts \N'34'hello\N'34' }" ,
+then an \fIenterstep\fR trace would be invoked just before
+.QW "\fIputs \N'34'hello\N'34'\fR"
+is executed.
+Setting an \fIenterstep\fR trace on a command \fIname\fR that does not refer
+to a procedure will not result in an error and is simply ignored.
.TP
\fBleavestep\fR
-Invoke \fIcommand\fR for every Tcl command which is executed
-inside the procedure \fIname\fR, just after the actual execution
-takes place.
-Setting a \fIleavestep\fR trace on a \fIcommand\fR
-will not result in an error and is simply ignored.
-.PP
-When the trace triggers, depending on the operations being traced, a
-number of arguments are appended to \fIcommand\fR so that the actual
+.
+Invoke \fIcommandPrefix\fR for every Tcl command which is executed from the
+start of the execution of the procedure \fIname\fR until that
+procedure finishes. \fICommandPrefix\fR is invoked just after the actual
+execution of the Tcl command being reported takes place.
+Setting a \fIleavestep\fR trace on a command \fIname\fR that does not refer to
+a procedure will not result in an error and is simply ignored.
+.PP
+When the trace triggers, depending on the operations being traced, a
+number of arguments are appended to \fIcommandPrefix\fR so that the actual
command is as follows:
.PP
For \fBenter\fR and \fBenterstep\fR operations:
+.PP
.CS
-\fIcommand command-string op\fR
+\fIcommandPrefix command-string op\fR
.CE
-\fICommand-string\fR gives the complete current command being
-executed (the traced command for a \fBenter\fR operation, an
+.PP
+\fICommand-string\fR gives the complete current command being
+executed (the traced command for a \fBenter\fR operation, an
arbitrary command for a \fBenterstep\fR operation), including
all arguments in their fully expanded form.
\fIOp\fR indicates what operation is being performed on the
command execution, and is one of \fBenter\fR or \fBenterstep\fR as
defined above. The trace operation can be used to stop the
command from executing, by deleting the command in question. Of
-course when the command is subsequently executed, an 'invalid command'
+course when the command is subsequently executed, an
+.QW "invalid command"
error will occur.
.PP
For \fBleave\fR and \fBleavestep\fR operations:
+.PP
.CS
-\fIcommand command-string code result op\fR
+\fIcommandPrefix command-string code result op\fR
.CE
-\fICommand-string\fR gives the complete current command being
-executed (the traced command for a \fBenter\fR operation, an
+.PP
+\fICommand-string\fR gives the complete current command being
+executed (the traced command for a \fBenter\fR operation, an
arbitrary command for a \fBenterstep\fR operation), including
all arguments in their fully expanded form.
\fICode\fR gives the result code of that execution, and \fIresult\fR
the result string.
\fIOp\fR indicates what operation is being performed on the
command execution, and is one of \fBleave\fR or \fBleavestep\fR as
-defined above.
+defined above.
Note that the creation of many \fBenterstep\fR or
\fBleavestep\fR traces can lead to unintuitive results, since the
invoked commands from one trace can themselves lead to further
command invocations for other traces.
.PP
-\fICommand\fR executes in the same context as the code that invoked
-the traced operation: thus the \fIcommand\fR, if invoked from a procedure,
-will have access to the same local variables as code in the procedure.
-This context may be different than the context in which the trace was
-created. If \fIcommand\fR invokes a procedure (which it normally does)
-then the procedure will have to use upvar or uplevel commands if it wishes
-to access the local variables of the code which invoked the trace operation.
+\fICommandPrefix\fR executes in the same context as the code that invoked
+the traced operation: thus the \fIcommandPrefix\fR, if invoked from a
+procedure, will have access to the same local variables as code in the
+procedure. This context may be different than the context in which the trace
+was created. If \fIcommandPrefix\fR invokes a procedure (which it normally
+does) then the procedure will have to use \fBupvar\fR or \fBuplevel\fR
+commands if it wishes to access the local variables of the code which invoked
+the trace operation.
.PP
-While \fIcommand\fR is executing during an execution trace, traces
-on \fIname\fR are temporarily disabled. This allows the \fIcommand\fR
+While \fIcommandPrefix\fR is executing during an execution trace, traces
+on \fIname\fR are temporarily disabled. This allows the \fIcommandPrefix\fR
to execute \fIname\fR in its body without invoking any other traces again.
-If an error occurs while executing the \fIcommand\fR body, then the
+If an error occurs while executing the \fIcommandPrefix\fR, then the
command \fIname\fR as a whole will return that same error.
.PP
When multiple traces are set on \fIname\fR, then for \fIenter\fR
@@ -162,17 +181,17 @@ in the reverse order of how the traces were originally created;
and for \fIleave\fR and \fIleavestep\fR operations, the traced
commands are invoked in the original order of creation.
.PP
-The behavior of execution traces is currently undefined for a command
+The behavior of execution traces is currently undefined for a command
\fIname\fR imported into another namespace.
.RE
.TP
-\fBtrace add variable\fI name ops command\fR
-Arrange for \fIcommand\fR to be executed whenever variable \fIname\fR
+\fBtrace add variable\fI name ops commandPrefix\fR
+Arrange for \fIcommandPrefix\fR to be executed whenever variable \fIname\fR
is accessed in one of the ways given by the list \fIops\fR. \fIName\fR may
refer to a normal variable, an element of an array, or to an array
as a whole (i.e. \fIname\fR may be just the name of an array, with no
parenthesized index). If \fIname\fR refers to a whole array, then
-\fIcommand\fR is invoked whenever any element of the array is
+\fIcommandPrefix\fR is invoked whenever any element of the array is
manipulated. If the variable does not exist, it will be created but
will not be given a value, so it will be visible to \fBnamespace which\fR
queries, but not to \fBinfo exists\fR queries.
@@ -182,20 +201,20 @@ queries, but not to \fBinfo exists\fR queries.
one or more of the following items:
.TP
\fBarray\fR
-Invoke \fIcommand\fR whenever the variable is accessed or modified via
+Invoke \fIcommandPrefix\fR whenever the variable is accessed or modified via
the \fBarray\fR command, provided that \fIname\fR is not a scalar
variable at the time that the \fBarray\fR command is invoked. If
\fIname\fR is a scalar variable, the access via the \fBarray\fR
command will not trigger the trace.
.TP
\fBread\fR
-Invoke \fIcommand\fR whenever the variable is read.
+Invoke \fIcommandPrefix\fR whenever the variable is read.
.TP
\fBwrite\fR
-Invoke \fIcommand\fR whenever the variable is written.
+Invoke \fIcommandPrefix\fR whenever the variable is written.
.TP
\fBunset\fR
-Invoke \fIcommand\fR whenever the variable is unset. Variables
+Invoke \fIcommandPrefix\fR whenever the variable is unset. Variables
can be unset explicitly with the \fBunset\fR command, or
implicitly when procedures return (all of their local variables
are unset). Variables are also unset when interpreters are
@@ -203,10 +222,12 @@ deleted, but traces will not be invoked because there is no
interpreter in which to execute them.
.PP
When the trace triggers, three arguments are appended to
-\fIcommand\fR so that the actual command is as follows:
+\fIcommandPrefix\fR so that the actual command is as follows:
+.PP
.CS
-\fIcommand name1 name2 op\fR
+\fIcommandPrefix name1 name2 op\fR
.CE
+.PP
\fIName1\fR and \fIname2\fR give the name(s) for the variable
being accessed: if the variable is a scalar then \fIname1\fR
gives the variable's name and \fIname2\fR is an empty string;
@@ -223,11 +244,11 @@ different name.
variable, and is one of \fBread\fR, \fBwrite\fR, or \fBunset\fR as
defined above.
.PP
-\fICommand\fR executes in the same context as the code that invoked
+\fICommandPrefix\fR executes in the same context as the code that invoked
the traced operation: if the variable was accessed as part of a Tcl
-procedure, then \fIcommand\fR will have access to the same local
+procedure, then \fIcommandPrefix\fR will have access to the same local
variables as code in the procedure. This context may be different
-than the context in which the trace was created. If \fIcommand\fR
+than the context in which the trace was created. If \fIcommandPrefix\fR
invokes a procedure (which it normally does) then the procedure will
have to use \fBupvar\fR or \fBuplevel\fR if it wishes to access the
traced variable. Note also that \fIname1\fR may not necessarily be
@@ -235,25 +256,25 @@ the same as the name used to set the trace on the variable;
differences can occur if the access is made through a variable defined
with the \fBupvar\fR command.
.PP
-For read and write traces, \fIcommand\fR can modify the variable to
-affect the result of the traced operation. If \fIcommand\fR modifies
+For read and write traces, \fIcommandPrefix\fR can modify the variable to
+affect the result of the traced operation. If \fIcommandPrefix\fR modifies
the value of a variable during a read or write trace, then the new
value will be returned as the result of the traced operation. The
-return value from \fIcommand\fR is ignored except that if it returns
+return value from \fIcommandPrefix\fR is ignored except that if it returns
an error of any sort then the traced operation also returns an error
with the same error message returned by the trace command (this
mechanism can be used to implement read-only variables, for example).
-For write traces, \fIcommand\fR is invoked after the variable's value
+For write traces, \fIcommandPrefix\fR is invoked after the variable's value
has been changed; it can write a new value into the variable to
override the original value specified in the write operation. To
-implement read-only variables, \fIcommand\fR will have to restore the
+implement read-only variables, \fIcommandPrefix\fR will have to restore the
old value of the variable.
.PP
-While \fIcommand\fR is executing during a read or write trace, traces
+While \fIcommandPrefix\fR is executing during a read or write trace, traces
on the variable are temporarily disabled. This means that reads and
-writes invoked by \fIcommand\fR will occur directly, without invoking
-\fIcommand\fR (or any other traces) again. However, if \fIcommand\fR
-unsets the variable then unset traces will be invoked.
+writes invoked by \fIcommandPrefix\fR will occur directly, without invoking
+\fIcommandPrefix\fR (or any other traces) again. However, if
+\fIcommandPrefix\fR unsets the variable then unset traces will be invoked.
.PP
When an unset trace is invoked, the variable has already been deleted:
it will appear to be undefined with no traces. If an unset occurs
@@ -281,28 +302,28 @@ This command returns an empty string.
.RE
.RE
.TP
-\fBtrace remove \fItype name opList command\fR
+\fBtrace remove \fItype name opList commandPrefix\fR
Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR.
.RS
.TP
-\fBtrace remove command\fI name opList command\fR
+\fBtrace remove command\fI name opList commandPrefix\fR
If there is a trace set on command \fIname\fR with the operations and
-command given by \fIopList\fR and \fIcommand\fR, then the trace is
-removed, so that \fIcommand\fR will never again be invoked. Returns
-an empty string. If \fIname\fR doesn't exist, the command will throw
+command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is
+removed, so that \fIcommandPrefix\fR will never again be invoked. Returns
+an empty string. If \fIname\fR does not exist, the command will throw
an error.
.TP
-\fBtrace remove execution\fI name opList command\fR
+\fBtrace remove execution\fI name opList commandPrefix\fR
If there is a trace set on command \fIname\fR with the operations and
-command given by \fIopList\fR and \fIcommand\fR, then the trace is
-removed, so that \fIcommand\fR will never again be invoked. Returns
-an empty string. If \fIname\fR doesn't exist, the command will throw
+command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is
+removed, so that \fIcommandPrefix\fR will never again be invoked. Returns
+an empty string. If \fIname\fR does not exist, the command will throw
an error.
.TP
-\fBtrace remove variable\fI name opList command\fR
+\fBtrace remove variable\fI name opList commandPrefix\fR
If there is a trace set on variable \fIname\fR with the operations and
-command given by \fIopList\fR and \fIcommand\fR, then the trace is
-removed, so that \fIcommand\fR will never again be invoked. Returns
+command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is
+removed, so that \fIcommandPrefix\fR will never again be invoked. Returns
an empty string.
.RE
.TP
@@ -313,24 +334,24 @@ Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR.
\fBtrace info command\fI name\fR
Returns a list containing one element for each trace currently set on
command \fIname\fR. Each element of the list is itself a list
-containing two elements, which are the \fIopList\fR and \fIcommand\fR
-associated with the trace. If \fIname\fR doesn't have any traces set,
+containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR
+associated with the trace. If \fIname\fR does not have any traces set,
then the result of the command will be an empty string. If \fIname\fR
-doesn't exist, the command will throw an error.
+does not exist, the command will throw an error.
.TP
\fBtrace info execution\fI name\fR
Returns a list containing one element for each trace currently set on
command \fIname\fR. Each element of the list is itself a list
-containing two elements, which are the \fIopList\fR and \fIcommand\fR
-associated with the trace. If \fIname\fR doesn't have any traces set,
+containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR
+associated with the trace. If \fIname\fR does not have any traces set,
then the result of the command will be an empty string. If \fIname\fR
-doesn't exist, the command will throw an error.
+does not exist, the command will throw an error.
.TP
\fBtrace info variable\fI name\fR
Returns a list containing one element for each trace currently set on
variable \fIname\fR. Each element of the list is itself a list
-containing two elements, which are the \fIopList\fR and \fIcommand\fR
-associated with the trace. If \fIname\fR doesn't exist or doesn't
+containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR
+associated with the trace. If \fIname\fR does not exist or does not
have any traces set, then the result of the command will be an empty
string.
.RE
@@ -343,8 +364,8 @@ This is equivalent to \fBtrace add variable \fIname ops command\fR.
.TP
\fBtrace vdelete \fIname ops command\fR
This is equivalent to \fBtrace remove variable \fIname ops command\fR
-.TP
-\fBtrace vinfo \fIname\fR
+.TP
+\fBtrace vinfo \fIname\fR
This is equivalent to \fBtrace info variable \fIname\fR
.RE
.PP
@@ -355,9 +376,11 @@ future version of Tcl. They use an older syntax in which \fBarray\fR,
list, but simply a string concatenation of the operations, such as
\fBrwua\fR.
.SH EXAMPLES
+.PP
Print a message whenever either of the global variables \fBfoo\fR and
\fBbar\fR are updated, even if they have a different local name at the
time (which can be done with the \fBupvar\fR command):
+.PP
.CS
proc tracer {varname args} {
upvar #0 $varname var
@@ -369,6 +392,7 @@ proc tracer {varname args} {
.PP
Ensure that the global variable \fBfoobar\fR always contains the
product of the global variables \fBfoo\fR and \fBbar\fR:
+.PP
.CS
proc doMult args {
global foo bar foobar
@@ -377,9 +401,26 @@ proc doMult args {
\fBtrace add\fR variable foo write doMult
\fBtrace add\fR variable bar write doMult
.CE
-
+.PP
+Print a trace of what commands are executed during the processing of a Tcl
+procedure:
+.PP
+.CS
+proc x {} { y }
+proc y {} { z }
+proc z {} { puts hello }
+proc report args {puts [info level 0]}
+\fBtrace add\fR execution x enterstep report
+x
+ \(-> \fIreport y enterstep\fR
+ \fIreport z enterstep\fR
+ \fIreport {puts hello} enterstep\fR
+ \fIhello\fR
+.CE
.SH "SEE ALSO"
set(n), unset(n)
-
.SH KEYWORDS
read, command, rename, variable, write, trace, unset
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/transchan.n b/doc/transchan.n
new file mode 100644
index 0000000..e00aa84
--- /dev/null
+++ b/doc/transchan.n
@@ -0,0 +1,160 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+transchan \- command handler API of channel transforms
+.SH SYNOPSIS
+\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The Tcl-level handler for a channel transformation has to be a command with
+subcommands (termed an \fIensemble\fR despite not implying that it must be
+created with \fBnamespace ensemble create\fR; this mechanism is not tied to
+\fBnamespace ensemble\fR in any way). Note that \fIcmdPrefix\fR is whatever
+was specified in the call to \fBchan push\fR, and may consist of multiple
+arguments; this will be expanded to multiple words in place of the prefix.
+.PP
+Of all the possible subcommands, the handler \fImust\fR support
+\fBinitialize\fR and \fBfinalize\fR. Transformations for writable channels
+must also support \fBwrite\fR, and transformations for readable channels must
+also support \fBread\fR.
+.PP
+Note that in the descriptions below \fIcmdPrefix\fR may be more than one word,
+and \fIhandle\fR is the value returned by the \fBchan push\fR call used to
+create the transformation.
+.SS "GENERIC SUBCOMMANDS"
+.PP
+The following subcommands are relevant to all types of channel.
+.TP
+\fIcmdPrefix \fBclear \fIhandle\fR
+.
+This optional subcommand is called to signify to the transformation that any
+data stored in internal buffers (either incoming or outgoing) must be
+cleared. It is called when a \fBchan seek\fR is performed on the channel being
+transformed.
+.TP
+\fIcmdPrefix \fBfinalize \fIhandle\fR
+.
+This mandatory subcommand is called last for the given \fIhandle\fR, and then
+never again, and it exists to allow for cleaning up any Tcl-level data
+structures associated with the transformation. \fIWarning!\fR Any errors
+thrown by this subcommand will be ignored. It is not guaranteed to be called
+if the interpreter is deleted.
+.TP
+\fIcmdPrefix \fBinitialize \fIhandle mode\fR
+.
+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 \fRand \fBwrite\fR.
+.RS
+.TP
+\fBwrite\fR
+.
+implies that the channel is writable.
+.TP
+\fBread\fR
+.
+implies that the channel is readable.
+.PP
+The return value of the subcommand should be a list containing the names of
+all subcommands supported by this handler. Any error thrown by the subcommand
+will prevent the creation of the transformation. The thrown error will appear
+as error thrown by \fBchan push\fR.
+.RE
+.SS "READ-RELATED SUBCOMMANDS"
+.PP
+These subcommands are used for handling transformations applied to readable
+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
+.
+This optional subcommand is called whenever data in the transformation input
+(i.e. read) buffer has to be forced upward, i.e. towards the user or script.
+The result returned by the method is taken as the \fIbinary\fR data to push
+upward to the level above this transformation (the reader or a higher-level
+transformation).
+.RS
+.PP
+In other words, when this method is called the transformation cannot defer the
+actual transformation operation anymore and has to transform all data waiting
+in its internal read buffers and return the result of that action.
+.RE
+.TP
+\fIcmdPrefix \fBlimit? \fIhandle\fR
+.
+This optional subcommand is called to allow the Tcl I/O engine to determine
+how far ahead it should read. If present, it should return an integer number
+greater than zero which indicates how many bytes ahead should be read, or an
+integer less than zero to indicate that the I/O engine may read as far ahead
+as it likes.
+.TP
+\fIcmdPrefix \fBread \fIhandle buffer\fR
+.
+This subcommand, which must be present if the transformation is to work with
+readable channels, is called whenever the base channel, or a transformation
+below this transformation, pushes data upward. The \fIbuffer\fR contains the
+binary data which has been given to us from below. It is the responsibility of
+this subcommand to actually transform the data. The result returned by the
+subcommand is taken as the binary data to push further upward to the
+transformation above this transformation. This can also be the user or script
+that originally read from the channel.
+.RS
+.PP
+Note that the result is allowed to be empty, or even less than the data we
+received; the transformation is not required to transform everything given to
+it right now. It is allowed to store incoming data in internal buffers and to
+defer the actual transformation until it has more data.
+.RE
+.SS "WRITE-RELATED SUBCOMMANDS"
+.PP
+These subcommands are used for handling transformations applied to writable
+channels; though strictly \fBwrite\fR is optional, it must be supported if any
+of the others is or the channel will be made non-writable.
+.TP
+\fIcmdPrefix \fBflush \fIhandle\fR
+.
+This optional subcommand is called whenever data in the transformation 'write'
+buffer has to be forced downward, i.e. towards the base channel. The result
+returned by the subcommand is taken as the binary data to write to the
+transformation below the current transformation. This can be the base channel
+as well.
+.RS
+.PP
+In other words, when this subcommand is called the transformation cannot defer
+the actual transformation operation anymore and has to transform all data
+waiting in its internal write buffers and return the result of that action.
+.RE
+.TP
+\fIcmdPrefix \fBwrite \fIhandle buffer\fR
+.
+This subcommand, which must be present if the transformation is to work with
+writable channels, is called whenever the user, or a transformation above this
+transformation, writes data downward. The \fIbuffer\fR contains the binary
+data which has been written to us. It is the responsibility of this subcommand
+to actually transform the data.
+.RS
+.PP
+The result returned by the subcommand is taken as the binary data to write to
+the transformation below this transformation. This can be the base channel as
+well. Note that the result is allowed to be empty, or less than the data we
+got; the transformation is not required to transform everything which was
+written to it right now. It is allowed to store this data in internal buffers
+and to defer the actual transformation until it has more data.
+.RE
+.SH "SEE ALSO"
+chan(n), refchan(n)
+.SH KEYWORDS
+API, channel, ensemble, prefix, transformation
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/try.n b/doc/try.n
new file mode 100644
index 0000000..834ccc1
--- /dev/null
+++ b/doc/try.n
@@ -0,0 +1,103 @@
+'\"
+'\" Copyright (c) 2008 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH try n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+try \- Trap and process errors and exceptions
+.SH SYNOPSIS
+\fBtry\fI body\fR ?\fIhandler...\fR? ?\fBfinally\fI script\fR?
+.BE
+.SH DESCRIPTION
+.PP
+This command executes the script \fIbody\fR and, depending on what the outcome
+of that script is (normal exit, error, or some other exceptional result), runs
+a handler script to deal with the case. Once that has all happened, if the
+\fBfinally\fR clause is present, the \fIscript\fR it includes will be run and
+the result of the handler (or the \fIbody\fR if no handler matched) is allowed
+to continue to propagate. Note that the \fBfinally\fR clause is processed even
+if an error occurs and irrespective of which, if any, \fIhandler\fR is used.
+.PP
+The \fIhandler\fR clauses are each expressed as several words, and must have
+one of the following forms:
+.TP
+\fBon \fIcode variableList script\fR
+.
+This clause matches if the evaluation of \fIbody\fR completed with the
+exception code \fIcode\fR. The \fIcode\fR may be expressed as an integer or
+one of the following literal words: \fBok\fR, \fBerror\fR, \fBreturn\fR,
+\fBbreak\fR, or \fBcontinue\fR. Those literals correspond to the integers 0
+through 4 respectively.
+.TP
+\fBtrap \fIpattern variableList script\fR
+.
+This clause matches if the evaluation of \fIbody\fR resulted in an error and
+the prefix of the \fB\-errorcode\fR from the interpreter's status dictionary
+is equal to the \fIpattern\fR. The number of prefix words taken from the
+\fB\-errorcode\fR is equal to the list-length of \fIpattern\fR, and inter-word
+spaces are normalized in both the \fB\-errorcode\fR and \fIpattern\fR before
+comparison.
+.PP
+The \fIvariableList\fR word in each \fIhandler\fR is always interpreted as a
+list of variable names. If the first word of the list is present and
+non-empty, it names a variable into which the result of the evaluation of
+\fIbody\fR (from the main \fBtry\fR) will be placed; this will contain the
+human-readable form of any errors. If the second word of the list is present
+and non-empty, it names a variable into which the options dictionary of the
+interpreter at the moment of completion of execution of \fIbody\fR
+will be placed.
+.PP
+The \fIscript\fR word of each \fIhandler\fR is also always interpreted the
+same: as a Tcl script to evaluate if the clause is matched. If \fIscript\fR is
+a literal
+.QW \-
+and the \fIhandler\fR is not the last one, the \fIscript\fR of the following
+\fIhandler\fR is invoked instead (just like with the \fBswitch\fR command).
+.PP
+Note that \fIhandler\fR clauses are matched against in order, and that the
+first matching one is always selected. At most one \fIhandler\fR clause will
+selected. As a consequence, an \fBon error\fR will mask any subsequent
+\fBtrap\fR in the \fBtry\fR. Also note that \fBon error\fR is equivalent to
+\fBtrap {}\fR.
+.PP
+If an exception (i.e. any non-\fBok\fR result) occurs during the evaluation of
+either the \fIhandler\fR or the \fBfinally\fR clause, the original exception's
+status dictionary will be added to the new exception's status dictionary under
+the \fB\-during\fR key.
+.SH EXAMPLES
+.PP
+Ensure that a file is closed no matter what:
+.PP
+.CS
+set f [open /some/file/name a]
+\fBtry\fR {
+ puts $f "some message"
+ # ...
+} \fBfinally\fR {
+ close $f
+}
+.CE
+.PP
+Handle different reasons for a file to not be openable for reading:
+.PP
+.CS
+\fBtry\fR {
+ set f [open /some/file/name w]
+} \fBtrap\fR {POSIX EISDIR} {} {
+ puts "failed to open /some/file/name: it's a directory"
+} \fBtrap\fR {POSIX ENOENT} {} {
+ puts "failed to open /some/file/name: it doesn't exist"
+}
+.CE
+.SH "SEE ALSO"
+catch(n), error(n), return(n), throw(n)
+.SH "KEYWORDS"
+cleanup, error, exception, final, resource management
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/unknown.n b/doc/unknown.n
index 95bb066..cdfbe43 100644
--- a/doc/unknown.n
+++ b/doc/unknown.n
@@ -5,10 +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: unknown.n,v 1.5 2004/05/30 14:13:52 dkf Exp $
-'\"
-.so man.macros
.TH unknown n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,22 +14,24 @@ unknown \- Handle attempts to use non-existent commands
.SH SYNOPSIS
\fBunknown \fIcmdName \fR?\fIarg arg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command is invoked by the Tcl interpreter whenever a script
-tries to invoke a command that doesn't exist. The default implementation
+tries to invoke a command that does not exist. The default implementation
of \fBunknown\fR is a library procedure defined when Tcl initializes an
interpreter. You can override the default \fBunknown\fR to change its
-functionality. Note that there is no default implementation of
-\fBunknown\fR in a safe interpreter.
+functionality, or you can register a new handler for individual namespaces
+using the \fBnamespace unknown\fR command. Note that there is no default
+implementation of \fBunknown\fR in a safe interpreter.
.PP
If the Tcl interpreter encounters a command name for which there
-is not a defined command, then Tcl checks for the existence of
-a command named \fBunknown\fR.
-If there is no such command, then the interpreter returns an
-error.
-If the \fBunknown\fR command exists, then it is invoked with
+is not a defined command (in either the current namespace, or the
+global namespace), then Tcl checks for the existence of
+an unknown handler for the current namespace. By default, this
+handler is a command named \fB::unknown\fR. If there is no such
+command, then the interpreter returns an error.
+If the \fBunknown\fR command exists (or a new handler has been
+registered for the current namespace), then it is invoked with
arguments consisting of the fully-substituted name and arguments
for the original non-existent command.
The \fBunknown\fR command typically does things like searching
@@ -51,7 +51,7 @@ If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR
to see if there is an executable file by the name \fIcmd\fR.
If so, it invokes the Tcl \fBexec\fR command
with \fIcmd\fR and all the \fIargs\fR as arguments.
-If \fIcmd\fR can't be auto-executed, \fBunknown\fR checks to
+If \fIcmd\fR cannot be auto-executed, \fBunknown\fR checks to
see if the command was invoked at top-level and outside of any
script. If so, then \fBunknown\fR takes two additional steps.
First, it sees if \fIcmd\fR has one of the following three forms:
@@ -82,12 +82,10 @@ rename \fBunknown\fR _original_unknown
# Provide our own implementation
proc \fBunknown\fR args {
puts stderr "WARNING: unknown command: $args"
- uplevel 1 [list _original_unknown {expand}$args]
+ uplevel 1 [list _original_unknown {*}$args]
}
.CE
-
.SH "SEE ALSO"
-info(n), proc(n), interp(n), library(n)
-
+info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
-error, non-existent command
+error, non-existent command, unknown
diff --git a/doc/unload.n b/doc/unload.n
index 8a2e51c..febd694 100644
--- a/doc/unload.n
+++ b/doc/unload.n
@@ -1,13 +1,11 @@
'\"
-'\" Copyright (c) 2003 George Petasis, petasis@iit.demokritos.gr.
+'\" Copyright (c) 2003 George Petasis <petasis@iit.demokritos.gr>.
'\"
'\" 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.8 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH unload n 8.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,7 +17,6 @@ unload \- Unload machine code
.br
\fBunload \fR?\fIswitches\fR? \fIfileName packageName interp\fR
.BE
-
.SH DESCRIPTION
.PP
This command tries to unload shared libraries previously loaded
@@ -35,22 +32,26 @@ The \fIinterp\fR argument is the path name of the interpreter from
which to unload the package (see the \fBinterp\fR manual entry for
details); if \fIinterp\fR is omitted, it defaults to the
interpreter in which the \fBunload\fR command was invoked.
-.LP
+.PP
If the initial arguments to \fBunload\fR start with \fB\-\fR then
they are treated as switches. The following switches are
currently supported:
.TP
\fB\-nocomplain\fR
-Supresses all error messages. If this switch is given \fBunload\fR will
+.
+Suppresses all error messages. If this switch is given, \fBunload\fR will
never report an error.
.TP
\fB\-keeplibrary\fR
+.
This switch will prevent \fBunload\fR from issuing the operating system call
that will unload the library from the process.
.TP
\fB\-\|\-\fR
+.
Marks the end of switches. The argument following this one will
be treated as a \fIfileName\fR even if it starts with a \fB\-\fR.
+.SS "UNLOAD OPERATION"
.PP
When a file containing a shared library is loaded through the
\fBload\fR command, Tcl associates two reference counts to the library
@@ -59,7 +60,7 @@ loaded into normal (trusted) interpreters while the second describes how many
times the library has been loaded into safe interpreters. As a file containing
a shared library can be loaded only once by Tcl (with the first \fBload\fR
call on the file), these counters track how many interpreters use the library.
-Each subsequent call to \fBload\fR after the first, simply increaments the
+Each subsequent call to \fBload\fR after the first simply increments the
proper reference count.
.PP
\fBunload\fR works in the opposite direction. As a first step, \fBunload\fR
@@ -84,11 +85,16 @@ procedure. If the unload procedure returns \fBTCL_OK\fR, \fBunload\fR will proce
and decrease the proper reference count (depending on the target interpreter
type). When both reference counts have reached 0, the library will be
detached from the process.
+.SS "UNLOAD HOOK PROTOTYPE"
.PP
The unload procedure must match the following prototype:
+.PP
.CS
-typedef int Tcl_PackageUnloadProc(Tcl_Interp *\fIinterp\fR, int \fIflags\fR);
+typedef int \fBTcl_PackageUnloadProc\fR(
+ Tcl_Interp *\fIinterp\fR,
+ int \fIflags\fR);
.CE
+.PP
The \fIinterp\fR argument identifies the interpreter from which the
library is to be unloaded. The unload procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
@@ -104,10 +110,11 @@ the library is used by other interpreters),
library is used only by the target interpreter and the library will be
detached from the application as soon as the unload procedure returns,
the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
+.SS NOTES
.PP
The \fBunload\fR command cannot unload libraries that are statically
linked with the application.
-If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+If \fIfileName\fR is an empty string, then the \fIpackageName\fR argument must
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
@@ -125,8 +132,8 @@ module name \fBlast\fR.
\fBUnix\fR\0\0\0\0\0
.
Not all unix operating systems support library unloading. Under such
-an operating system \fBunload\fR returns an error (unless -nocomplain has
-been specified).
+an operating system \fBunload\fR returns an error (unless \fB\-nocomplain\fR
+has been specified).
.SH BUGS
.PP
If the same file is \fBload\fRed by different \fIfileName\fRs, it will
@@ -138,12 +145,16 @@ library is still loaded), it may be dangerous to use
\fBunload\fR on such a library (as the library will be completely detached
from the application while some interpreters will continue to use it).
.SH EXAMPLE
+.PP
If an unloadable module in the file \fBfoobar.dll\fR had been loaded
using the \fBload\fR command like this (on Windows):
+.PP
.CS
load c:/some/dir/foobar.dll
.CE
+.PP
then it would be unloaded like this:
+.PP
.CS
\fBunload\fR c:/some/dir/foobar.dll
.CE
@@ -152,9 +163,10 @@ This allows a C code module to be installed temporarily into a
long-running Tcl program and then removed again (either because it is
no longer needed or because it is being updated with a new version)
without having to shut down the overall Tcl process.
-
.SH "SEE ALSO"
info sharedlibextension, load(n), safe(n)
-
.SH KEYWORDS
binary code, unloading, safe interpreter, shared library
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/unset.n b/doc/unset.n
index 036429f..8b63959 100644
--- a/doc/unset.n
+++ b/doc/unset.n
@@ -6,18 +6,15 @@
'\" 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.10 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH unset n 8.4 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.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
This command removes one or more variables.
@@ -28,18 +25,21 @@ 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, any variables after the named one causing the error not
-deleted. An error can occur when the named variable doesn't exist, or the
+If an error occurs during variable deletion, any variables after the named one
+causing the error are not
+deleted. An error can occur when the named variable does not exist, or the
name refers to an array element but the variable is a scalar, or the name
refers to a variable in a non-existent namespace.
.SH EXAMPLE
+.PP
Create an array containing a mapping from some numbers to their
squares and remove the array elements for non-prime numbers:
+.PP
.CS
array set squares {
1 1 6 36
@@ -58,9 +58,11 @@ parray squares
puts "The prime squares are:"
parray squares
.CE
-
.SH "SEE ALSO"
set(n), trace(n), upvar(n)
-
.SH KEYWORDS
remove, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/update.n b/doc/update.n
index ebe89d4..875172a 100644
--- a/doc/update.n
+++ b/doc/update.n
@@ -5,10 +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: update.n,v 1.6 2004/11/20 00:17:32 dgp Exp $
-'\"
-.so man.macros
.TH update n 7.5 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,10 +14,10 @@ update \- Process pending events and idle callbacks
.SH SYNOPSIS
\fBupdate\fR ?\fBidletasks\fR?
.BE
-
.SH DESCRIPTION
.PP
-This command is used to bring the application ``up to date''
+This command is used to bring the application
+.QW "up to date"
by entering the event loop repeatedly until all pending events
(including idle callbacks) have been processed.
.PP
@@ -44,7 +42,9 @@ the application to respond to events such as user interactions; if
you occasionally call \fBupdate\fR then user input will be processed
during the next call to \fBupdate\fR.
.SH EXAMPLE
+.PP
Run computations for about a second and then finish:
+.PP
.CS
set x 1000
set done 0
@@ -59,9 +59,7 @@ while {!$done} {
\fBupdate\fR
}
.CE
-
.SH "SEE ALSO"
after(n), interp(n)
-
.SH KEYWORDS
-event, flush, handler, idle, update
+asynchronous I/O, event, flush, handler, idle, update
diff --git a/doc/uplevel.n b/doc/uplevel.n
index ee4f6c7..a96f729 100644
--- a/doc/uplevel.n
+++ b/doc/uplevel.n
@@ -5,10 +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: uplevel.n,v 1.5 2004/10/27 14:43:54 dkf Exp $
-'\"
-.so man.macros
.TH uplevel n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ uplevel \- Execute a script in a different stack frame
.SH SYNOPSIS
\fBuplevel \fR?\fIlevel\fR?\fI arg \fR?\fIarg ...\fR?
.BE
-
.SH DESCRIPTION
.PP
All of the \fIarg\fR arguments are concatenated as if they had
@@ -43,28 +40,32 @@ at top-level (only global variables will be visible).
The \fBuplevel\fR command causes the invoking procedure to disappear
from the procedure calling stack while the command is being executed.
In the above example, suppose \fBc\fR invokes the command
+.PP
.CS
\fBuplevel\fR 1 {set x 43; d}
.CE
+.PP
where \fBd\fR is another Tcl procedure. The \fBset\fR command will
modify the variable \fBx\fR in \fBb\fR's context, and \fBd\fR will execute
at level 3, as if called from \fBb\fR. If it in turn executes
the command
+.PP
.CS
\fBuplevel\fR {set x 42}
.CE
+.PP
then the \fBset\fR command will modify the same variable \fBx\fR in \fBb\fR's
context: the procedure \fBc\fR does not appear to be on the call stack
-when \fBd\fR is executing. The command ``\fBinfo level\fR'' may
+when \fBd\fR is executing. The \fBinfo level\fR command may
be used to obtain the level of the current procedure.
.PP
\fBUplevel\fR makes it possible to implement new control
constructs as Tcl procedures (for example, \fBuplevel\fR could
be used to implement the \fBwhile\fR construct as a Tcl procedure).
.PP
-\fBnamespace eval\fR is another way (besides procedure calls)
-that the Tcl naming context can change.
-It adds a call frame to the stack to represent the namespace context.
+The \fBnamespace eval\fR and \fBapply\fR commands offer other ways
+(besides procedure calls) that the Tcl naming context can change.
+They add a call frame to the stack to represent the namespace context.
This means each \fBnamespace eval\fR command
counts as another call level for \fBuplevel\fR and \fBupvar\fR commands.
For example, \fBinfo level 1\fR will return a list
@@ -78,6 +79,7 @@ control constructs. This example shows how (without error handling)
it can be used to create a \fBdo\fR command that is the counterpart of
\fBwhile\fR except for always performing the test after running the
loop body:
+.PP
.CS
proc do {body while condition} {
if {$while ne "while"} {
@@ -92,9 +94,10 @@ proc do {body while condition} {
}
}
.CE
-
.SH "SEE ALSO"
-namespace(n), upvar(n)
-
+apply(n), namespace(n), upvar(n)
.SH KEYWORDS
-context, level, namespace, stack frame, variables
+context, level, namespace, stack frame, variable
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/upvar.n b/doc/upvar.n
index acce716..380a390 100644
--- a/doc/upvar.n
+++ b/doc/upvar.n
@@ -5,10 +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: upvar.n,v 1.12 2005/05/10 18:34:03 kennykb Exp $
-'\"
-.so man.macros
.TH upvar n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -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
-isn't \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
@@ -45,16 +42,18 @@ The \fBupvar\fR command simplifies the implementation of call-by-name
procedure calling and also makes it easier to build new control constructs
as Tcl procedures.
For example, consider the following procedure:
+.PP
.CS
proc \fIadd2\fR name {
- \fBupvar\fR $name x
- set x [expr {$x + 2}]
+ \fBupvar\fR $name x
+ set x [expr {$x + 2}]
}
.CE
+.PP
If \fIadd2\fR is invoked with an argument giving the name of a variable,
it adds two to the value of that variable.
Although \fIadd2\fR could have been implemented using \fBuplevel\fR
-instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fBadd2\fR
+instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fIadd2\fR
to access the variable in the caller's procedure frame.
.PP
\fBnamespace eval\fR is another way (besides procedure calls)
@@ -62,7 +61,7 @@ that the Tcl naming context can change.
It adds a call frame to the stack to represent the namespace context.
This means each \fBnamespace eval\fR command
counts as another call level for \fBuplevel\fR and \fBupvar\fR commands.
-For example, \fBinfo level 1\fR will return a list
+For example, \fBinfo level\fR \fB1\fR will return a list
describing a command that is either
the outermost procedure call or the outermost \fBnamespace eval\fR command.
Also, \fBuplevel #0\fR evaluates a script
@@ -81,14 +80,18 @@ unexpected manner. If a variable trace is defined on \fIotherVar\fR, that
trace will be triggered by actions involving \fImyVar\fR. However,
the trace procedure will be passed the name of \fImyVar\fR, rather
than the name of \fIotherVar\fR. Thus, the output of the following code
-will be "\fIlocalVar\fR" rather than "\fIoriginalVar\fR":
+will be
+.QW "\fIlocalVar\fR"
+rather than
+.QW "\fIoriginalVar\fR" :
+.PP
.CS
proc \fItraceproc\fR { name index op } {
- puts $name
+ puts $name
}
proc \fIsetByUpvar\fR { name value } {
- \fBupvar\fR $name localVar
- set localVar $value
+ \fBupvar\fR $name localVar
+ set localVar $value
}
set originalVar 1
trace variable originalVar w \fItraceproc\fR
@@ -103,15 +106,17 @@ made to \fImyVar\fR will not be passed to subprocesses correctly.
.SH EXAMPLE
A \fBdecr\fR command that works like \fBincr\fR except it subtracts
the value from the variable instead of adding it:
+.PP
.CS
proc decr {varName {decrement 1}} {
\fBupvar\fR 1 $varName var
incr var [expr {-$decrement}]
}
.CE
-
.SH "SEE ALSO"
global(n), namespace(n), uplevel(n), variable(n)
-
.SH KEYWORDS
-context, frame, global, level, namespace, procedure, variable
+context, frame, global, level, namespace, procedure, upvar, variable
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/variable.n b/doc/variable.n
index fa99930..7d58a02 100644
--- a/doc/variable.n
+++ b/doc/variable.n
@@ -5,18 +5,17 @@
'\" 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.8 2005/05/10 18:34:04 kennykb Exp $
-'\"
-.so man.macros
.TH variable n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
variable \- create and initialize a namespace variable
.SH SYNOPSIS
-\fBvariable \fR?\fIname value...\fR? \fIname \fR?\fIvalue\fR?
+\fBvariable \fR\fIname\fR
+.sp
+\fBvariable \fR?\fIname value...\fR?
.BE
-
.SH DESCRIPTION
.PP
This command is normally used within a
@@ -59,7 +58,9 @@ After the variable has been declared,
elements within the array can be set using ordinary
\fBset\fR or \fBarray\fR commands.
.SH EXAMPLES
+.PP
Create a variable in a namespace:
+.PP
.CS
namespace eval foo {
\fBvariable\fR bar 12345
@@ -67,6 +68,7 @@ namespace eval foo {
.CE
.PP
Create an array in a namespace:
+.PP
.CS
namespace eval someNS {
\fBvariable\fR someAry
@@ -78,6 +80,7 @@ namespace eval someNS {
.CE
.PP
Access variables in namespaces from a procedure:
+.PP
.CS
namespace eval foo {
proc spong {} {
@@ -91,9 +94,7 @@ namespace eval foo {
}
}
.CE
-
.SH "SEE ALSO"
global(n), namespace(n), upvar(n)
-
.SH KEYWORDS
global, namespace, procedure, variable
diff --git a/doc/vwait.n b/doc/vwait.n
index 568f23a..c9b51ab 100644
--- a/doc/vwait.n
+++ b/doc/vwait.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.
'\"
-'\" RCS: @(#) $Id: vwait.n,v 1.6 2004/10/27 14:43:54 dkf Exp $
-'\"
-.so man.macros
.TH vwait n 8.0 Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -15,44 +13,57 @@ vwait \- Process events until a variable is written
.SH SYNOPSIS
\fBvwait\fR \fIvarName\fR
.BE
-
.SH DESCRIPTION
.PP
This command enters the Tcl event loop to process events, blocking
the application if no events are ready. It continues processing
-events until some event handler sets the value of variable
+events until some event handler sets the value of the global variable
\fIvarName\fR. Once \fIvarName\fR has been set, the \fBvwait\fR
command will return as soon as the event handler that modified
-\fIvarName\fR completes. \fIvarName\fR must globally scoped
-(either with a call to \fBglobal\fR for the \fIvarName\fR, or with
-the full namespace path specification).
+\fIvarName\fR completes. The \fIvarName\fR argument is always interpreted as
+a variable name with respect to the global namespace, but can refer to any
+namespace's variables if the fully-qualified name is given.
.PP
In some cases the \fBvwait\fR command may not return immediately
-after \fIvarName\fR is set. This can happen if the event handler
+after \fIvarName\fR is set. This happens if the event handler
that sets \fIvarName\fR does not complete immediately. For example,
if an event handler sets \fIvarName\fR and then itself calls
\fBvwait\fR to wait for a different variable, then it may not return
for a long time. During this time the top-level \fBvwait\fR is
blocked waiting for the event handler to complete, so it cannot
-return either.
+return either. (See the \fBNESTED VWAITS BY EXAMPLE\fR below.)
+.PP
+To be clear, \fImultiple \fBvwait\fI calls will nest and will not happen in
+parallel\fR. The outermost call to \fBvwait\fR will not return until all the
+inner ones do. It is recommended that code should never nest \fBvwait\fR
+calls (by avoiding putting them in event callbacks) but when that is not
+possible, care should be taken to add interlock variables to the code to
+prevent all reentrant calls to \fBvwait\fR that are not \fIstrictly\fR
+necessary. Be aware that the synchronous modes of operation of some Tcl
+packages (e.g.,\ \fBhttp\fR) use \fBvwait\fR internally; if using the event
+loop, it is best to use the asynchronous callback-based modes of operation of
+those packages where available.
.SH EXAMPLES
+.PP
Run the event-loop continually until some event calls \fBexit\fR.
(You can use any variable not mentioned elsewhere, but the name
\fIforever\fR reminds you at a glance of the intent.)
+.PP
.CS
\fBvwait\fR forever
.CE
.PP
Wait five seconds for a connection to a server socket, otherwise
close the socket and continue running the script:
+.PP
.CS
# Initialise the state
after 5000 set state timeout
set server [socket -server accept 12345]
proc accept {args} {
- global state connectionInfo
- set state accepted
- set connectionInfo $args
+ global state connectionInfo
+ set state accepted
+ set connectionInfo $args
}
# Wait for something to happen
@@ -64,18 +75,172 @@ after cancel set state timeout
# Do something based on how the vwait finished...
switch $state {
- timeout {
- puts "no connection on port 12345"
- }
- accepted {
- puts "connection: $connectionInfo"
- puts [lindex $connectionInfo 0] "Hello there!"
- }
+ timeout {
+ puts "no connection on port 12345"
+ }
+ accepted {
+ puts "connection: $connectionInfo"
+ puts [lindex $connectionInfo 0] "Hello there!"
+ }
}
.CE
+.PP
+A command that will wait for some time delay by waiting for a namespace
+variable to be set. Includes an interlock to prevent nested waits.
+.PP
+.CS
+namespace eval example {
+ variable v done
+ proc wait {delay} {
+ variable v
+ if {$v ne "waiting"} {
+ set v waiting
+ after $delay [namespace code {set v done}]
+ \fBvwait\fR [namespace which -variable v]
+ }
+ return $v
+ }
+}
+.CE
+.PP
+When running inside a \fBcoroutine\fR, an alternative to using \fBvwait\fR is
+to \fByield\fR to an outer event loop and to get recommenced when the variable
+is set, or at an idle moment after that.
+.PP
+.CS
+coroutine task apply {{} {
+ # simulate [after 1000]
+ after 1000 [info coroutine]
+ yield
+
+ # schedule the setting of a global variable, as normal
+ after 2000 {set var 1}
+ # simulate [\fBvwait\fR var]
+ proc updatedVar {task args} {
+ after idle $task
+ trace remove variable ::var write "updatedVar $task"
+ }
+ trace add variable ::var write "updatedVar [info coroutine]"
+ yield
+}}
+.CE
+.SS "NESTED VWAITS BY EXAMPLE"
+.PP
+This example demonstrates what can happen when the \fBvwait\fR command is
+nested. The script will never finish because the waiting for the \fIa\fR
+variable never finishes; that \fBvwait\fR command is still waiting for a
+script scheduled with \fBafter\fR to complete, which just happens to be
+running an inner \fBvwait\fR (for \fIb\fR) even though the event that the
+outer \fBvwait\fR was waiting for (the setting of \fIa\fR) has occurred.
+.PP
+.CS
+after 500 {
+ puts "waiting for b"
+ \fBvwait\fR b
+ puts "b was set"
+}
+after 1000 {
+ puts "setting a"
+ set a 10
+}
+puts "waiting for a"
+\fBvwait\fR a
+puts "a was set"
+puts "setting b"
+set b 42
+.CE
+.PP
+If you run the above code, you get this output:
+.PP
+.CS
+waiting for a
+waiting for b
+setting a
+.CE
+.PP
+The script will never print
+.QW "a was set"
+until after it has printed
+.QW "b was set"
+because of the nesting of \fBvwait\fR commands, and yet \fIb\fR will not be
+set until after the outer \fBvwait\fR returns, so the script has deadlocked.
+The only ways to avoid this are to either structure the overall program in
+continuation-passing style or to use \fBcoroutine\fR to make the continuations
+implicit. The first of these options would be written as:
+.PP
+.CS
+after 500 {
+ puts "waiting for b"
+ trace add variable b write {apply {args {
+ global a b
+ trace remove variable ::b write \e
+ [lrange [info level 0] 0 1]
+ puts "b was set"
+ set ::done ok
+ }}}
+}
+after 1000 {
+ puts "setting a"
+ set a 10
+}
+puts "waiting for a"
+trace add variable a write {apply {args {
+ global a b
+ trace remove variable a write [lrange [info level 0] 0 1]
+ puts "a was set"
+ puts "setting b"
+ set b 42
+}}}
+\fBvwait\fR done
+.CE
+.PP
+The second option, with \fBcoroutine\fR and some helper procedures, is done
+like this:
+.PP
+.CS
+# A coroutine-based wait-for-variable command
+proc waitvar globalVar {
+ trace add variable ::$globalVar write \e
+ [list apply {{v c args} {
+ trace remove variable $v write \e
+ [lrange [info level 0] 0 3]
+ after 0 $c
+ }} ::$globalVar [info coroutine]]
+ yield
+}
+# A coroutine-based wait-for-some-time command
+proc waittime ms {
+ after $ms [info coroutine]
+ yield
+}
+
+coroutine task-1 eval {
+ puts "waiting for a"
+ waitvar a
+ puts "a was set"
+ puts "setting b"
+ set b 42
+}
+coroutine task-2 eval {
+ waittime 500
+ puts "waiting for b"
+ waitvar b
+ puts "b was set"
+ set done ok
+}
+coroutine task-3 eval {
+ waittime 1000
+ puts "setting a"
+ set a 10
+}
+\fBvwait\fR done
+.CE
.SH "SEE ALSO"
global(n), update(n)
-
.SH KEYWORDS
-event, variable, wait
+asynchronous I/O, event, variable, wait
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/while.n b/doc/while.n
index bd74f45..60275e8 100644
--- a/doc/while.n
+++ b/doc/while.n
@@ -5,10 +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: while.n,v 1.5 2004/10/27 14:43:54 dkf Exp $
-'\"
-.so man.macros
.TH while n "" Tcl "Tcl Built-In Commands"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +14,6 @@ while \- Execute script repeatedly as long as a condition is met
.SH SYNOPSIS
\fBwhile \fItest body\fR
.BE
-
.SH DESCRIPTION
.PP
The \fBwhile\fR command evaluates \fItest\fR as an expression
@@ -43,6 +40,7 @@ expression is evaluated (before
each loop iteration), so changes in the variables will be visible.
For an example, try the following script with and without the braces
around \fB$x<10\fR:
+.PP
.CS
set x 0
\fBwhile\fR {$x<10} {
@@ -51,17 +49,17 @@ set x 0
}
.CE
.SH EXAMPLE
+.PP
Read lines from a channel until we get to the end of the stream, and
print them out with a line-number prepended:
+.PP
.CS
set lineCount 0
\fBwhile\fR {[gets $chan line] >= 0} {
puts "[incr lineCount]: $line"
}
.CE
-
.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n)
-
.SH KEYWORDS
-boolean value, loop, test, while
+boolean, loop, test, while
diff --git a/doc/zlib.n b/doc/zlib.n
new file mode 100644
index 0000000..b8d0ee5
--- /dev/null
+++ b/doc/zlib.n
@@ -0,0 +1,460 @@
+'\"
+'\" 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.
+'\"
+.TH zlib n 8.6 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+zlib \- compression and decompression operations
+.SH SYNOPSIS
+.nf
+\fBzlib \fIsubcommand arg ...\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzlib\fR command provides access to the compression and check-summing
+facilities of the Zlib library by Jean-loup Gailly and Mark Adler. It has the
+following subcommands.
+.SS "COMPRESSION SUBCOMMANDS"
+.TP
+\fBzlib compress\fI string\fR ?\fIlevel\fR?
+.
+Returns the zlib-format compressed binary data of the binary string in
+\fIstring\fR. If present, \fIlevel\fR gives the compression level to use (from
+0, which is uncompressed, to 9, maximally compressed).
+.TP
+\fBzlib decompress\fI string\fR ?\fIbufferSize\fR?
+.
+Returns the uncompressed version of the raw compressed binary data in
+\fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer
+is to be used to receive the data.
+.TP
+\fBzlib deflate\fI string\fR ?\fIlevel\fR?
+.
+Returns the raw compressed binary data of the binary string in \fIstring\fR.
+If present, \fIlevel\fR gives the compression level to use (from 0, which is
+uncompressed, to 9, maximally compressed).
+.TP
+\fBzlib gunzip\fI string\fR ?\fB\-headerVar \fIvarName\fR?
+.
+Return the uncompressed contents of binary string \fIstring\fR, which must
+have been in gzip format. If \fB\-headerVar\fR is given, store a dictionary
+describing the contents of the gzip header in the variable called
+\fIvarName\fR. The keys of the dictionary that may be present are:
+.RS
+.TP
+\fBcomment\fR
+.
+The comment field from the header, if present.
+.TP
+\fBcrc\fR
+.
+A boolean value describing whether a CRC of the header is computed.
+.TP
+\fBfilename\fR
+.
+The filename field from the header, if present.
+.TP
+\fBos\fR
+.
+The operating system type code field from the header (if not the
+QW unknown
+value). See RFC 1952 for the meaning of these codes.
+.TP
+\fBsize\fR
+.
+The size of the uncompressed data.
+.TP
+\fBtime\fR
+.
+The time field from the header if non-zero, expected to be time that the file
+named by the \fBfilename\fR field was modified. Suitable for use with
+\fBclock format\fR.
+.TP
+\fBtype\fR
+.
+The type of the uncompressed data (\fBbinary\fR or \fBtext\fR) if known.
+.RE
+.TP
+\fBzlib gzip\fI string\fR ?\fB\-level \fIlevel\fR? ?\fB\-header \fIdict\fR?
+.
+Return the compressed contents of binary string \fIstring\fR in gzip format.
+If \fB\-level\fR is given, \fIlevel\fR gives the compression level to use
+(from 0, which is uncompressed, to 9, maximally compressed). If \fB\-header\fR
+is given, \fIdict\fR is a dictionary containing values used for the gzip
+header. The following keys may be defined:
+.RS
+.TP
+\fBcomment\fR
+.
+Add the given comment to the header of the gzip-format data.
+.TP
+\fBcrc\fR
+.
+A boolean saying whether to compute a CRC of the header. Note that if the data
+is to be interchanged with the \fBgzip\fR program, a header CRC should
+\fInot\fR be computed.
+.TP
+\fBfilename\fR
+.
+The name of the file that the data to be compressed came from.
+.TP
+\fBos\fR
+.
+The operating system type code, which should be one of the values described in
+RFC 1952.
+.TP
+\fBtime\fR
+.
+The time that the file named in the \fBfilename\fR key was last modified. This
+will be in the same as is returned by \fBclock seconds\fR or \fBfile mtime\fR.
+.TP
+\fBtype\fR
+.
+The type of the data being compressed, being \fBbinary\fR or \fBtext\fR.
+.RE
+.TP
+\fBzlib inflate\fI string\fR ?\fIbufferSize\fR?
+.
+Returns the uncompressed version of the raw compressed binary data in
+\fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer
+is to be used to receive the data.
+.SS "CHANNEL SUBCOMMAND"
+.TP
+\fBzlib push\fI mode channel\fR ?\fIoptions ...\fR?
+.
+Pushes a compressing or decompressing transformation onto the channel
+\fIchannel\fR.
+The transformation can be removed again with \fBchan pop\fR.
+The \fImode\fR argument determines what type of transformation
+is pushed; the following are supported:
+.RS
+.TP
+\fBcompress\fR
+.
+The transformation will be a compressing transformation that produces
+zlib-format data on \fIchannel\fR, which must be writable.
+.TP
+\fBdecompress\fR
+.
+The transformation will be a decompressing transformation that reads
+zlib-format data from \fIchannel\fR, which must be readable.
+.TP
+\fBdeflate\fR
+.
+The transformation will be a compressing transformation that produces raw
+compressed data on \fIchannel\fR, which must be writable.
+.TP
+\fBgunzip\fR
+.
+The transformation will be a decompressing transformation that reads
+gzip-format data from \fIchannel\fR, which must be readable.
+.TP
+\fBgzip\fR
+.
+The transformation will be a compressing transformation that produces
+gzip-format data on \fIchannel\fR, which must be writable.
+.TP
+\fBinflate\fR
+.
+The transformation will be a decompressing transformation that reads raw
+compressed data from \fIchannel\fR, which must be readable.
+.PP
+The following options may be set when creating a transformation via
+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
+\fBzlib gzip\fR understands.
+.TP
+\fB\-level\fI compressionLevel\fR
+.
+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 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. 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
+.
+This write-only operation flushes the current state of the compressor to the
+underlying channel. It is only valid for compressing transformations. The
+\fItype\fR must be either \fBsync\fR or \fBfull\fR for a normal flush or an
+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\-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 ?\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
+and \fIoptions\fR are supported:
+.RS
+.TP
+\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,
+.VS "TIP 400"
+and the compression dictionary \fIbindata\fR (if specified).
+.VE
+.TP
+\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 ?\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,
+.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 ?\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, and the header descriptor dictionary \fIheader\fR (if specified;
+for keys see \fBzlib gzip\fR).
+.TP
+\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
+\fBzlib adler32\fI string\fR ?\fIinitValue\fR?
+.
+Compute a checksum of binary string \fIstring\fR using the Adler-32 algorithm.
+If given, \fIinitValue\fR is used to initialize the checksum engine.
+.TP
+\fBzlib crc32\fI string\fR ?\fIinitValue\fR?
+.
+Compute a checksum of binary string \fIstring\fR using the CRC-32 algorithm.
+If given, \fIinitValue\fR is used to initialize the checksum engine.
+.SH "STREAMING INSTANCE COMMAND"
+.PP
+Streaming compression instance commands are produced by the \fBzlib stream\fR
+command. They are used by calling their \fBput\fR subcommand one or more times
+to load data in, and their \fBget\fR subcommand one or more times to extract
+the transformed data.
+.PP
+The full set of subcommands supported by a streaming instance command,
+\fIstream\fR, is as follows:
+.TP
+\fIstream \fBadd\fR ?\fIoption...\fR? \fIdata\fR
+.
+A short-cut for
+.QW "\fIstream \fBput \fR?\fIoption...\fR? \fIdata\fR"
+followed by
+.QW "\fIstream \fBget\fR" .
+.TP
+\fIstream \fBchecksum\fR
+.
+Returns the checksum of the uncompressed data seen so far by this stream.
+.TP
+\fIstream \fBclose\fR
+.
+Deletes this stream and frees up all resources associated with it.
+.TP
+\fIstream \fBeof\fR
+.
+Returns a boolean indicating whether the end of the stream (as determined by
+the compressed data itself) has been reached. Not all formats support
+detection of the end of the stream.
+.TP
+\fIstream \fBfinalize\fR
+.
+A short-cut for
+.QW "\fIstream \fBput \-finalize {}\fR" .
+.TP
+\fIstream \fBflush\fR
+.
+A short-cut for
+.QW "\fIstream \fBput \-flush {}\fR" .
+.TP
+\fIstream \fBfullflush\fR
+.
+A short-cut for
+.QW "\fIstream \fBput \-fullflush {}\fR" .
+.TP
+\fIstream \fBget \fR?\fIcount\fR?
+.
+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
+.
+Append the contents of the binary string \fIdata\fR to \fIstream\fR's internal
+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
+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
+.
+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
+.
+Puts any stream, including those that have been finalized or that have reached
+eof, back into a state where it can process more data. Throws away all
+internally buffered data.
+.SH EXAMPLES
+.PP
+To compress a Tcl string, it should be first converted to a particular charset
+encoding since the \fBzlib\fR command always operates on binary strings.
+.PP
+.CS
+set binData [encoding convertto utf-8 $string]
+set compData [\fBzlib compress\fR $binData]
+.CE
+.PP
+When converting back, it is also important to reverse the charset encoding:
+.PP
+.CS
+set binData [\fBzlib decompress\fR $compData]
+set string [encoding convertfrom utf-8 $binData]
+.CE
+.PP
+The compression operation from above can also be done with streams, which is
+especially helpful when you want to accumulate the data by stages:
+.PP
+.CS
+set strm [\fBzlib stream\fR compress]
+$\fIstrm \fBput\fR [encoding convertto utf-8 $string]
+# ...
+$\fIstrm \fBfinalize\fR
+set compData [$\fIstrm \fBget\fR]
+$\fIstrm \fBclose\fR
+.CE
+.SH "SEE ALSO"
+binary(n), chan(n), encoding(n), Tcl_ZlibDeflate(3), RFC1950 \- RFC1952
+.SH "KEYWORDS"
+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_color.c b/generic/regc_color.c
index 5aed21c..f5d6dfd 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -2,24 +2,24 @@
* colorings of characters
* This file is #included by regcomp.c.
*
- * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
* HENRY SPENCER 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;
@@ -28,661 +28,719 @@
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
- *
- *
- * Note that there are some incestuous relationships between this code and
- * NFA arc maintenance, which perhaps ought to be cleaned up sometime.
+ * Note that there are some incestuous relationships between this code and NFA
+ * arc maintenance, which perhaps ought to be cleaned up sometime.
*/
-
-
#define CISERR() VISERR(cm->v)
#define CERR(e) VERR(cm->v, (e))
-
-
-
+
/*
- initcm - set up new colormap
- ^ static VOID initcm(struct vars *, struct colormap *);
+ ^ static void initcm(struct vars *, struct colormap *);
*/
-static VOID
-initcm(v, cm)
-struct vars *v;
-struct colormap *cm;
+static void
+initcm(
+ struct vars *v,
+ struct colormap *cm)
{
- int i;
- int j;
- union tree *t;
- union tree *nextt;
- struct colordesc *cd;
-
- cm->magic = CMMAGIC;
- cm->v = v;
-
- cm->ncds = NINLINECDS;
- cm->cd = cm->cdspace;
- cm->max = 0;
- cm->free = 0;
-
- cd = cm->cd; /* cm->cd[WHITE] */
- cd->sub = NOSUB;
- cd->arcs = NULL;
- cd->flags = 0;
- cd->nchrs = CHR_MAX - CHR_MIN + 1;
-
- /* upper levels of tree */
- for (t = &cm->tree[0], j = NBYTS-1; j > 0; t = nextt, j--) {
- nextt = t + 1;
- for (i = BYTTAB-1; i >= 0; i--)
- t->tptr[i] = nextt;
+ int i;
+ int j;
+ union tree *t;
+ union tree *nextt;
+ struct colordesc *cd;
+
+ cm->magic = CMMAGIC;
+ cm->v = v;
+
+ cm->ncds = NINLINECDS;
+ cm->cd = cm->cdspace;
+ cm->max = 0;
+ cm->free = 0;
+
+ cd = cm->cd; /* cm->cd[WHITE] */
+ cd->sub = NOSUB;
+ cd->arcs = NULL;
+ cd->flags = 0;
+ cd->nchrs = CHR_MAX - CHR_MIN + 1;
+
+ /*
+ * Upper levels of tree.
+ */
+
+ for (t=&cm->tree[0], j=NBYTS-1 ; j>0 ; t=nextt, j--) {
+ nextt = t + 1;
+ for (i=BYTTAB-1 ; i>=0 ; i--) {
+ t->tptr[i] = nextt;
}
- /* bottom level is solid white */
- t = &cm->tree[NBYTS-1];
- for (i = BYTTAB-1; i >= 0; i--)
- t->tcolor[i] = WHITE;
- cd->block = t;
-}
+ }
+ /*
+ * Bottom level is solid white.
+ */
+
+ t = &cm->tree[NBYTS-1];
+ for (i=BYTTAB-1 ; i>=0 ; i--) {
+ t->tcolor[i] = WHITE;
+ }
+ cd->block = t;
+}
+
/*
- freecm - free dynamically-allocated things in a colormap
- ^ static VOID freecm(struct colormap *);
+ ^ static void freecm(struct colormap *);
*/
-static VOID
-freecm(cm)
-struct colormap *cm;
+static void
+freecm(
+ struct colormap *cm)
{
- size_t i;
- union tree *cb;
-
- cm->magic = 0;
- if (NBYTS > 1)
- cmtreefree(cm, cm->tree, 0);
- for (i = 1; i <= cm->max; i++) /* skip WHITE */
- if (!UNUSEDCOLOR(&cm->cd[i])) {
- cb = cm->cd[i].block;
- if (cb != NULL)
- FREE(cb);
- }
- if (cm->cd != cm->cdspace)
- FREE(cm->cd);
+ size_t i;
+ union tree *cb;
+
+ cm->magic = 0;
+ if (NBYTS > 1) {
+ cmtreefree(cm, cm->tree, 0);
+ }
+ for (i=1 ; i<=cm->max ; i++) { /* skip WHITE */
+ if (!UNUSEDCOLOR(&cm->cd[i])) {
+ cb = cm->cd[i].block;
+ if (cb != NULL) {
+ FREE(cb);
+ }
+ }
+ }
+ if (cm->cd != cm->cdspace) {
+ FREE(cm->cd);
+ }
}
-
+
/*
- cmtreefree - free a non-terminal part of a colormap tree
- ^ static VOID cmtreefree(struct colormap *, union tree *, int);
+ ^ static void cmtreefree(struct colormap *, union tree *, int);
*/
-static VOID
-cmtreefree(cm, tree, level)
-struct colormap *cm;
-union tree *tree;
-int level; /* level number (top == 0) of this block */
+static void
+cmtreefree(
+ struct colormap *cm,
+ union tree *tree,
+ int level) /* level number (top == 0) of this block */
{
- int i;
- union tree *t;
- union tree *fillt = &cm->tree[level+1];
- union tree *cb;
-
- assert(level < NBYTS-1); /* this level has pointers */
- for (i = BYTTAB-1; i >= 0; i--) {
- t = tree->tptr[i];
- assert(t != NULL);
- if (t != fillt) {
- if (level < NBYTS-2) { /* more pointer blocks below */
- cmtreefree(cm, t, level+1);
- FREE(t);
- } else { /* color block below */
- cb = cm->cd[t->tcolor[0]].block;
- if (t != cb) /* not a solid block */
- FREE(t);
- }
+ int i;
+ union tree *t;
+ union tree *fillt = &cm->tree[level+1];
+ union tree *cb;
+
+ assert(level < NBYTS-1); /* this level has pointers */
+ for (i=BYTTAB-1 ; i>=0 ; i--) {
+ t = tree->tptr[i];
+ assert(t != NULL);
+ if (t != fillt) {
+ if (level < NBYTS-2) { /* more pointer blocks below */
+ cmtreefree(cm, t, level+1);
+ FREE(t);
+ } else { /* color block below */
+ cb = cm->cd[t->tcolor[0]].block;
+ if (t != cb) { /* not a solid block */
+ FREE(t);
}
+ }
}
+ }
}
-
+
/*
- setcolor - set the color of a character in a colormap
^ static color setcolor(struct colormap *, pchr, pcolor);
*/
static color /* previous color */
-setcolor(cm, c, co)
-struct colormap *cm;
-pchr c;
-pcolor co;
+setcolor(
+ struct colormap *cm,
+ pchr c,
+ pcolor co)
{
- uchr uc = c;
- int shift;
- int level;
- int b;
- int bottom;
- union tree *t;
- union tree *newt;
- union tree *fillt;
- union tree *lastt;
- union tree *cb;
- color prev;
-
- assert(cm->magic == CMMAGIC);
- if (CISERR() || co == COLORLESS)
+ uchr uc = c;
+ int shift;
+ int level;
+ int b;
+ int bottom;
+ union tree *t;
+ union tree *newt;
+ union tree *fillt;
+ union tree *lastt;
+ union tree *cb;
+ color prev;
+
+ assert(cm->magic == CMMAGIC);
+ if (CISERR() || co == COLORLESS) {
+ return COLORLESS;
+ }
+
+ t = cm->tree;
+ for (level=0, shift=BYTBITS*(NBYTS-1) ; shift>0; level++, shift-=BYTBITS){
+ b = (uc >> shift) & BYTMASK;
+ lastt = t;
+ t = lastt->tptr[b];
+ assert(t != NULL);
+ fillt = &cm->tree[level+1];
+ bottom = (shift <= BYTBITS) ? 1 : 0;
+ cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
+ if (t == fillt || t == cb) { /* must allocate a new block */
+ newt = (union tree *) MALLOC((bottom) ?
+ sizeof(struct colors) : sizeof(struct ptrs));
+ if (newt == NULL) {
+ CERR(REG_ESPACE);
return COLORLESS;
-
- t = cm->tree;
- for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
- level++, shift -= BYTBITS) {
- b = (uc >> shift) & BYTMASK;
- lastt = t;
- t = lastt->tptr[b];
- assert(t != NULL);
- fillt = &cm->tree[level+1];
- bottom = (shift <= BYTBITS) ? 1 : 0;
- cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
- if (t == fillt || t == cb) { /* must allocate a new block */
- newt = (union tree *)MALLOC((bottom) ?
- sizeof(struct colors) : sizeof(struct ptrs));
- if (newt == NULL) {
- CERR(REG_ESPACE);
- return COLORLESS;
- }
- if (bottom)
- memcpy(VS(newt->tcolor), VS(t->tcolor),
- BYTTAB*sizeof(color));
- else
- memcpy(VS(newt->tptr), VS(t->tptr),
- BYTTAB*sizeof(union tree *));
- t = newt;
- lastt->tptr[b] = t;
- }
+ }
+ if (bottom) {
+ memcpy(newt->tcolor, t->tcolor, BYTTAB*sizeof(color));
+ } else {
+ memcpy(newt->tptr, t->tptr, BYTTAB*sizeof(union tree *));
+ }
+ t = newt;
+ lastt->tptr[b] = t;
}
+ }
- b = uc & BYTMASK;
- prev = t->tcolor[b];
- t->tcolor[b] = (color)co;
- return prev;
+ b = uc & BYTMASK;
+ prev = t->tcolor[b];
+ t->tcolor[b] = (color) co;
+ return prev;
}
-
+
/*
- maxcolor - report largest color number in use
^ static color maxcolor(struct colormap *);
*/
static color
-maxcolor(cm)
-struct colormap *cm;
+maxcolor(
+ struct colormap *cm)
{
- if (CISERR())
- return COLORLESS;
+ if (CISERR()) {
+ return COLORLESS;
+ }
- return (color)cm->max;
+ return (color) cm->max;
}
-
+
/*
- newcolor - find a new color (must be subject of setcolor at once)
- * Beware: may relocate the colordescs.
+ * Beware: may relocate the colordescs.
^ static color newcolor(struct colormap *);
*/
static color /* COLORLESS for error */
-newcolor(cm)
-struct colormap *cm;
+newcolor(
+ struct colormap *cm)
{
- struct colordesc *cd;
- struct colordesc *new;
- size_t n;
-
- if (CISERR())
- return COLORLESS;
-
- if (cm->free != 0) {
- assert(cm->free > 0);
- assert((size_t)cm->free < cm->ncds);
- cd = &cm->cd[cm->free];
- assert(UNUSEDCOLOR(cd));
- assert(cd->arcs == NULL);
- cm->free = cd->sub;
- } else if (cm->max < cm->ncds - 1) {
- cm->max++;
- cd = &cm->cd[cm->max];
+ struct colordesc *cd;
+ size_t n;
+
+ if (CISERR()) {
+ return COLORLESS;
+ }
+
+ if (cm->free != 0) {
+ assert(cm->free > 0);
+ assert((size_t) cm->free < cm->ncds);
+ cd = &cm->cd[cm->free];
+ assert(UNUSEDCOLOR(cd));
+ assert(cd->arcs == NULL);
+ cm->free = cd->sub;
+ } else if (cm->max < cm->ncds - 1) {
+ cm->max++;
+ cd = &cm->cd[cm->max];
+ } else {
+ struct colordesc *newCd;
+
+ /*
+ * Oops, must allocate more.
+ */
+
+ if (cm->max == MAX_COLOR) {
+ CERR(REG_ECOLORS);
+ return COLORLESS; /* too many colors */
+ }
+ n = cm->ncds * 2;
+ if (n < MAX_COLOR + 1) {
+ n = MAX_COLOR + 1;
+ }
+ if (cm->cd == cm->cdspace) {
+ newCd = (struct colordesc *) MALLOC(n * sizeof(struct colordesc));
+ if (newCd != NULL) {
+ memcpy(newCd, cm->cdspace,
+ cm->ncds * sizeof(struct colordesc));
+ }
} else {
- /* oops, must allocate more */
- n = cm->ncds * 2;
- if (cm->cd == cm->cdspace) {
- new = (struct colordesc *)MALLOC(n *
- sizeof(struct colordesc));
- if (new != NULL)
- memcpy(VS(new), VS(cm->cdspace), cm->ncds *
- sizeof(struct colordesc));
- } else
- new = (struct colordesc *)REALLOC(cm->cd,
- n * sizeof(struct colordesc));
- if (new == NULL) {
- CERR(REG_ESPACE);
- return COLORLESS;
- }
- cm->cd = new;
- cm->ncds = n;
- assert(cm->max < cm->ncds - 1);
- cm->max++;
- cd = &cm->cd[cm->max];
+ newCd = (struct colordesc *)
+ REALLOC(cm->cd, n * sizeof(struct colordesc));
}
-
- cd->nchrs = 0;
- cd->sub = NOSUB;
- cd->arcs = NULL;
- cd->flags = 0;
- cd->block = NULL;
-
- return (color)(cd - cm->cd);
+ if (newCd == NULL) {
+ CERR(REG_ESPACE);
+ return COLORLESS;
+ }
+ cm->cd = newCd;
+ cm->ncds = n;
+ assert(cm->max < cm->ncds - 1);
+ cm->max++;
+ cd = &cm->cd[cm->max];
+ }
+
+ cd->nchrs = 0;
+ cd->sub = NOSUB;
+ cd->arcs = NULL;
+ cd->flags = 0;
+ cd->block = NULL;
+
+ return (color) (cd - cm->cd);
}
-
+
/*
- freecolor - free a color (must have no arcs or subcolor)
- ^ static VOID freecolor(struct colormap *, pcolor);
+ ^ static void freecolor(struct colormap *, pcolor);
*/
-static VOID
-freecolor(cm, co)
-struct colormap *cm;
-pcolor co;
+static void
+freecolor(
+ struct colormap *cm,
+ pcolor co)
{
- struct colordesc *cd = &cm->cd[co];
- color pco, nco; /* for freelist scan */
-
- assert(co >= 0);
- if (co == WHITE)
- return;
-
- assert(cd->arcs == NULL);
- assert(cd->sub == NOSUB);
- assert(cd->nchrs == 0);
- cd->flags = FREECOL;
- if (cd->block != NULL) {
- FREE(cd->block);
- cd->block = NULL; /* just paranoia */
+ struct colordesc *cd = &cm->cd[co];
+ color pco, nco; /* for freelist scan */
+
+ assert(co >= 0);
+ if (co == WHITE) {
+ return;
+ }
+
+ assert(cd->arcs == NULL);
+ assert(cd->sub == NOSUB);
+ assert(cd->nchrs == 0);
+ cd->flags = FREECOL;
+ if (cd->block != NULL) {
+ FREE(cd->block);
+ cd->block = NULL; /* just paranoia */
+ }
+
+ if ((size_t) co == cm->max) {
+ while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max])) {
+ cm->max--;
}
-
- if ((size_t)co == cm->max) {
- while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max]))
- cm->max--;
- assert(cm->free >= 0);
- while ((size_t)cm->free > cm->max)
- cm->free = cm->cd[cm->free].sub;
- if (cm->free > 0) {
- assert(cm->free < cm->max);
- pco = cm->free;
- nco = cm->cd[pco].sub;
- while (nco > 0)
- if ((size_t)nco > cm->max) {
- /* take this one out of freelist */
- nco = cm->cd[nco].sub;
- cm->cd[pco].sub = nco;
- } else {
- assert(nco < cm->max);
- pco = nco;
- nco = cm->cd[pco].sub;
- }
+ assert(cm->free >= 0);
+ while ((size_t) cm->free > cm->max) {
+ cm->free = cm->cd[cm->free].sub;
+ }
+ if (cm->free > 0) {
+ assert((size_t)cm->free < cm->max);
+ pco = cm->free;
+ nco = cm->cd[pco].sub;
+ while (nco > 0) {
+ if ((size_t) nco > cm->max) {
+ /*
+ * Take this one out of freelist.
+ */
+
+ nco = cm->cd[nco].sub;
+ cm->cd[pco].sub = nco;
+ } else {
+ assert((size_t)nco < cm->max);
+ pco = nco;
+ nco = cm->cd[pco].sub;
}
- } else {
- cd->sub = cm->free;
- cm->free = (color)(cd - cm->cd);
+ }
}
+ } else {
+ cd->sub = cm->free;
+ cm->free = (color) (cd - cm->cd);
+ }
}
-
+
/*
- pseudocolor - allocate a false color, to be managed by other means
^ static color pseudocolor(struct colormap *);
*/
static color
-pseudocolor(cm)
-struct colormap *cm;
+pseudocolor(
+ struct colormap *cm)
{
- color co;
-
- co = newcolor(cm);
- if (CISERR())
- return COLORLESS;
- cm->cd[co].nchrs = 1;
- cm->cd[co].flags = PSEUDO;
- return co;
+ color co;
+
+ co = newcolor(cm);
+ if (CISERR()) {
+ return COLORLESS;
+ }
+ cm->cd[co].nchrs = 1;
+ cm->cd[co].flags = PSEUDO;
+ return co;
}
-
+
/*
- subcolor - allocate a new subcolor (if necessary) to this chr
^ static color subcolor(struct colormap *, pchr c);
*/
static color
-subcolor(cm, c)
-struct colormap *cm;
-pchr c;
+subcolor(
+ struct colormap *cm,
+ pchr c)
{
- color co; /* current color of c */
- color sco; /* new subcolor */
-
- co = GETCOLOR(cm, c);
- sco = newsub(cm, co);
- if (CISERR())
- return COLORLESS;
- assert(sco != COLORLESS);
-
- if (co == sco) /* already in an open subcolor */
- return co; /* rest is redundant */
- cm->cd[co].nchrs--;
- cm->cd[sco].nchrs++;
- setcolor(cm, c, sco);
- return sco;
+ color co; /* current color of c */
+ color sco; /* new subcolor */
+
+ co = GETCOLOR(cm, c);
+ sco = newsub(cm, co);
+ if (CISERR()) {
+ return COLORLESS;
+ }
+ assert(sco != COLORLESS);
+
+ if (co == sco) { /* already in an open subcolor */
+ return co; /* rest is redundant */
+ }
+ cm->cd[co].nchrs--;
+ cm->cd[sco].nchrs++;
+ setcolor(cm, c, sco);
+ return sco;
}
-
+
/*
- newsub - allocate a new subcolor (if necessary) for a color
^ static color newsub(struct colormap *, pcolor);
*/
static color
-newsub(cm, co)
-struct colormap *cm;
-pcolor co;
+newsub(
+ struct colormap *cm,
+ pcolor co)
{
- color sco; /* new subcolor */
-
- sco = cm->cd[co].sub;
- if (sco == NOSUB) { /* color has no open subcolor */
- if (cm->cd[co].nchrs == 1) /* optimization */
- return co;
- sco = newcolor(cm); /* must create subcolor */
- if (sco == COLORLESS) {
- assert(CISERR());
- return COLORLESS;
- }
- cm->cd[co].sub = sco;
- cm->cd[sco].sub = sco; /* open subcolor points to self */
+ color sco; /* new subcolor */
+
+ sco = cm->cd[co].sub;
+ if (sco == NOSUB) { /* color has no open subcolor */
+ if (cm->cd[co].nchrs == 1) { /* optimization */
+ return co;
+ }
+ sco = newcolor(cm); /* must create subcolor */
+ if (sco == COLORLESS) {
+ assert(CISERR());
+ return COLORLESS;
}
- assert(sco != NOSUB);
+ cm->cd[co].sub = sco;
+ cm->cd[sco].sub = sco; /* open subcolor points to self */
+ }
+ assert(sco != NOSUB);
- return sco;
+ return sco;
}
-
+
/*
- subrange - allocate new subcolors to this range of chrs, fill in arcs
- ^ static VOID subrange(struct vars *, pchr, pchr, struct state *,
+ ^ static void subrange(struct vars *, pchr, pchr, struct state *,
^ struct state *);
*/
-static VOID
-subrange(v, from, to, lp, rp)
-struct vars *v;
-pchr from;
-pchr to;
-struct state *lp;
-struct state *rp;
+static void
+subrange(
+ struct vars *v,
+ pchr from,
+ pchr to,
+ struct state *lp,
+ struct state *rp)
{
- uchr uf;
- int i;
-
- assert(from <= to);
-
- /* first, align "from" on a tree-block boundary */
- uf = (uchr)from;
- i = (int)( ((uf + BYTTAB-1) & (uchr)~BYTMASK) - uf );
- for (; from <= to && i > 0; i--, from++)
- newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
- if (from > to) /* didn't reach a boundary */
- return;
-
- /* deal with whole blocks */
- for (; to - from >= BYTTAB; from += BYTTAB)
- subblock(v, from, lp, rp);
-
- /* clean up any remaining partial table */
- for (; from <= to; from++)
- newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+ uchr uf;
+ int i;
+
+ assert(from <= to);
+
+ /*
+ * First, align "from" on a tree-block boundary
+ */
+
+ uf = (uchr) from;
+ i = (int) (((uf + BYTTAB - 1) & (uchr) ~BYTMASK) - uf);
+ for (; from<=to && i>0; i--, from++) {
+ newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+ }
+ if (from > to) { /* didn't reach a boundary */
+ return;
+ }
+
+ /*
+ * Deal with whole blocks.
+ */
+
+ for (; to-from>=BYTTAB ; from+=BYTTAB) {
+ subblock(v, from, lp, rp);
+ }
+
+ /*
+ * Clean up any remaining partial table.
+ */
+
+ for (; from<=to ; from++) {
+ newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+ }
}
-
+
/*
- subblock - allocate new subcolors for one tree block of chrs, fill in arcs
- ^ static VOID subblock(struct vars *, pchr, struct state *, struct state *);
+ ^ static void subblock(struct vars *, pchr, struct state *, struct state *);
*/
-static VOID
-subblock(v, start, lp, rp)
-struct vars *v;
-pchr start; /* first of BYTTAB chrs */
-struct state *lp;
-struct state *rp;
+static void
+subblock(
+ struct vars *v,
+ pchr start, /* first of BYTTAB chrs */
+ struct state *lp,
+ struct state *rp)
{
- uchr uc = start;
- struct colormap *cm = v->cm;
- int shift;
- int level;
- int i;
- int b;
- union tree *t;
- union tree *cb;
- union tree *fillt;
- union tree *lastt;
- int previ;
- int ndone;
- color co;
- color sco;
-
- assert((uc % BYTTAB) == 0);
-
- /* find its color block, making new pointer blocks as needed */
- t = cm->tree;
- fillt = NULL;
- for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
- level++, shift -= BYTBITS) {
- b = (uc >> shift) & BYTMASK;
- lastt = t;
- t = lastt->tptr[b];
- assert(t != NULL);
- fillt = &cm->tree[level+1];
- if (t == fillt && shift > BYTBITS) { /* need new ptr block */
- t = (union tree *)MALLOC(sizeof(struct ptrs));
- if (t == NULL) {
- CERR(REG_ESPACE);
- return;
- }
- memcpy(VS(t->tptr), VS(fillt->tptr),
- BYTTAB*sizeof(union tree *));
- lastt->tptr[b] = t;
- }
+ uchr uc = start;
+ struct colormap *cm = v->cm;
+ int shift;
+ int level;
+ int i;
+ int b;
+ union tree *t;
+ union tree *cb;
+ union tree *fillt;
+ union tree *lastt;
+ int previ;
+ int ndone;
+ color co;
+ color sco;
+
+ assert((uc % BYTTAB) == 0);
+
+ /*
+ * Find its color block, making new pointer blocks as needed.
+ */
+
+ t = cm->tree;
+ fillt = NULL;
+ for (level=0, shift=BYTBITS*(NBYTS-1); shift>0; level++, shift-=BYTBITS) {
+ b = (uc >> shift) & BYTMASK;
+ lastt = t;
+ t = lastt->tptr[b];
+ assert(t != NULL);
+ fillt = &cm->tree[level+1];
+ if (t == fillt && shift > BYTBITS) { /* need new ptr block */
+ t = (union tree *) MALLOC(sizeof(struct ptrs));
+ if (t == NULL) {
+ CERR(REG_ESPACE);
+ return;
+ }
+ memcpy(t->tptr, fillt->tptr, BYTTAB*sizeof(union tree *));
+ lastt->tptr[b] = t;
}
+ }
+
+ /*
+ * Special cases: fill block or solid block.
+ */
+ co = t->tcolor[0];
+ cb = cm->cd[co].block;
+ if (t == fillt || t == cb) {
+ /*
+ * Either way, we want a subcolor solid block.
+ */
- /* special cases: fill block or solid block */
- co = t->tcolor[0];
- cb = cm->cd[co].block;
- if (t == fillt || t == cb) {
- /* either way, we want a subcolor solid block */
- sco = newsub(cm, co);
- t = cm->cd[sco].block;
- if (t == NULL) { /* must set it up */
- t = (union tree *)MALLOC(sizeof(struct colors));
- if (t == NULL) {
- CERR(REG_ESPACE);
- return;
- }
- for (i = 0; i < BYTTAB; i++)
- t->tcolor[i] = sco;
- cm->cd[sco].block = t;
- }
- /* find loop must have run at least once */
- lastt->tptr[b] = t;
- newarc(v->nfa, PLAIN, sco, lp, rp);
- cm->cd[co].nchrs -= BYTTAB;
- cm->cd[sco].nchrs += BYTTAB;
+ sco = newsub(cm, co);
+ t = cm->cd[sco].block;
+ if (t == NULL) { /* must set it up */
+ t = (union tree *) MALLOC(sizeof(struct colors));
+ if (t == NULL) {
+ CERR(REG_ESPACE);
return;
+ }
+ for (i=0 ; i<BYTTAB ; i++) {
+ t->tcolor[i] = sco;
+ }
+ cm->cd[sco].block = t;
}
- /* general case, a mixed block to be altered */
- i = 0;
- while (i < BYTTAB) {
- co = t->tcolor[i];
- sco = newsub(cm, co);
- newarc(v->nfa, PLAIN, sco, lp, rp);
- previ = i;
- do {
- t->tcolor[i++] = sco;
- } while (i < BYTTAB && t->tcolor[i] == co);
- ndone = i - previ;
- cm->cd[co].nchrs -= ndone;
- cm->cd[sco].nchrs += ndone;
- }
-}
+ /*
+ * Find loop must have run at least once.
+ */
+ lastt->tptr[b] = t;
+ newarc(v->nfa, PLAIN, sco, lp, rp);
+ cm->cd[co].nchrs -= BYTTAB;
+ cm->cd[sco].nchrs += BYTTAB;
+ return;
+ }
+
+ /*
+ * General case, a mixed block to be altered.
+ */
+
+ i = 0;
+ while (i < BYTTAB) {
+ co = t->tcolor[i];
+ sco = newsub(cm, co);
+ newarc(v->nfa, PLAIN, sco, lp, rp);
+ previ = i;
+ do {
+ t->tcolor[i++] = sco;
+ } while (i < BYTTAB && t->tcolor[i] == co);
+ ndone = i - previ;
+ cm->cd[co].nchrs -= ndone;
+ cm->cd[sco].nchrs += ndone;
+ }
+}
+
/*
- okcolors - promote subcolors to full colors
- ^ static VOID okcolors(struct nfa *, struct colormap *);
+ ^ static void okcolors(struct nfa *, struct colormap *);
*/
-static VOID
-okcolors(nfa, cm)
-struct nfa *nfa;
-struct colormap *cm;
+static void
+okcolors(
+ struct nfa *nfa,
+ struct colormap *cm)
{
- struct colordesc *cd;
- struct colordesc *end = CDEND(cm);
- struct colordesc *scd;
- struct arc *a;
- color co;
- color sco;
-
- for (cd = cm->cd, co = 0; cd < end; cd++, co++) {
- sco = cd->sub;
- if (UNUSEDCOLOR(cd) || sco == NOSUB) {
- /* has no subcolor, no further action */
- } else if (sco == co) {
- /* is subcolor, let parent deal with it */
- } else if (cd->nchrs == 0) {
- /* parent empty, its arcs change color to subcolor */
- cd->sub = NOSUB;
- scd = &cm->cd[sco];
- assert(scd->nchrs > 0);
- assert(scd->sub == sco);
- scd->sub = NOSUB;
- while ((a = cd->arcs) != NULL) {
- assert(a->co == co);
- /* uncolorchain(cm, a); */
- cd->arcs = a->colorchain;
- a->co = sco;
- /* colorchain(cm, a); */
- a->colorchain = scd->arcs;
- scd->arcs = a;
- }
- freecolor(cm, co);
- } else {
- /* parent's arcs must gain parallel subcolor arcs */
- cd->sub = NOSUB;
- scd = &cm->cd[sco];
- assert(scd->nchrs > 0);
- assert(scd->sub == sco);
- scd->sub = NOSUB;
- for (a = cd->arcs; a != NULL; a = a->colorchain) {
- assert(a->co == co);
- newarc(nfa, a->type, sco, a->from, a->to);
- }
- }
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ struct colordesc *scd;
+ struct arc *a;
+ color co;
+ color sco;
+
+ for (cd=cm->cd, co=0 ; cd<end ; cd++, co++) {
+ sco = cd->sub;
+ if (UNUSEDCOLOR(cd) || sco == NOSUB) {
+ /*
+ * Has no subcolor, no further action.
+ */
+ } else if (sco == co) {
+ /*
+ * Is subcolor, let parent deal with it.
+ */
+ } else if (cd->nchrs == 0) {
+ /*
+ * Parent empty, its arcs change color to subcolor.
+ */
+
+ cd->sub = NOSUB;
+ scd = &cm->cd[sco];
+ assert(scd->nchrs > 0);
+ assert(scd->sub == sco);
+ scd->sub = NOSUB;
+ while ((a = cd->arcs) != NULL) {
+ assert(a->co == co);
+ uncolorchain(cm, a);
+ a->co = sco;
+ colorchain(cm, a);
+ }
+ freecolor(cm, co);
+ } else {
+ /*
+ * Parent's arcs must gain parallel subcolor arcs.
+ */
+
+ cd->sub = NOSUB;
+ scd = &cm->cd[sco];
+ assert(scd->nchrs > 0);
+ assert(scd->sub == sco);
+ scd->sub = NOSUB;
+ for (a=cd->arcs ; a!=NULL ; a=a->colorchain) {
+ assert(a->co == co);
+ newarc(nfa, a->type, sco, a->from, a->to);
+ }
}
+ }
}
-
+
/*
- colorchain - add this arc to the color chain of its color
- ^ static VOID colorchain(struct colormap *, struct arc *);
+ ^ static void colorchain(struct colormap *, struct arc *);
*/
-static VOID
-colorchain(cm, a)
-struct colormap *cm;
-struct arc *a;
+static void
+colorchain(
+ struct colormap *cm,
+ struct arc *a)
{
- struct colordesc *cd = &cm->cd[a->co];
-
- a->colorchain = cd->arcs;
- cd->arcs = a;
+ struct colordesc *cd = &cm->cd[a->co];
+
+ if (cd->arcs != NULL) {
+ cd->arcs->colorchainRev = a;
+ }
+ a->colorchain = cd->arcs;
+ a->colorchainRev = NULL;
+ cd->arcs = a;
}
-
+
/*
- uncolorchain - delete this arc from the color chain of its color
- ^ static VOID uncolorchain(struct colormap *, struct arc *);
- */
-static VOID
-uncolorchain(cm, a)
-struct colormap *cm;
-struct arc *a;
-{
- struct colordesc *cd = &cm->cd[a->co];
- struct arc *aa;
-
- aa = cd->arcs;
- if (aa == a) /* easy case */
- cd->arcs = a->colorchain;
- else {
- for (; aa != NULL && aa->colorchain != a; aa = aa->colorchain)
- continue;
- assert(aa != NULL);
- aa->colorchain = a->colorchain;
- }
- a->colorchain = NULL; /* paranoia */
-}
-
-/*
- - singleton - is this character in its own color?
- ^ static int singleton(struct colormap *, pchr c);
+ ^ static void uncolorchain(struct colormap *, struct arc *);
*/
-static int /* predicate */
-singleton(cm, c)
-struct colormap *cm;
-pchr c;
+static void
+uncolorchain(
+ struct colormap *cm,
+ struct arc *a)
{
- color co; /* color of c */
-
- co = GETCOLOR(cm, c);
- if (cm->cd[co].nchrs == 1 && cm->cd[co].sub == NOSUB)
- return 1;
- return 0;
+ struct colordesc *cd = &cm->cd[a->co];
+ struct arc *aa = a->colorchainRev;
+
+ if (aa == NULL) {
+ assert(cd->arcs == a);
+ cd->arcs = a->colorchain;
+ } else {
+ assert(aa->colorchain == a);
+ aa->colorchain = a->colorchain;
+ }
+ if (a->colorchain != NULL) {
+ a->colorchain->colorchainRev = aa;
+ }
+ a->colorchain = NULL; /* paranoia */
+ a->colorchainRev = NULL;
}
-
+
/*
- rainbow - add arcs of all full colors (but one) between specified states
- ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
+ ^ static void rainbow(struct nfa *, struct colormap *, int, pcolor,
^ struct state *, struct state *);
*/
-static VOID
-rainbow(nfa, cm, type, but, from, to)
-struct nfa *nfa;
-struct colormap *cm;
-int type;
-pcolor but; /* COLORLESS if no exceptions */
-struct state *from;
-struct state *to;
+static void
+rainbow(
+ struct nfa *nfa,
+ struct colormap *cm,
+ int type,
+ pcolor but, /* COLORLESS if no exceptions */
+ struct state *from,
+ struct state *to)
{
- struct colordesc *cd;
- struct colordesc *end = CDEND(cm);
- color co;
-
- for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
- if (!UNUSEDCOLOR(cd) && cd->sub != co && co != but &&
- !(cd->flags&PSEUDO))
- newarc(nfa, type, co, from, to);
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ color co;
+
+ for (cd=cm->cd, co=0 ; cd<end && !CISERR(); cd++, co++) {
+ if (!UNUSEDCOLOR(cd) && (cd->sub != co) && (co != but)
+ && !(cd->flags&PSEUDO)) {
+ newarc(nfa, type, co, from, to);
+ }
+ }
}
-
+
/*
- colorcomplement - add arcs of complementary colors
* The calling sequence ought to be reconciled with cloneouts().
- ^ static VOID colorcomplement(struct nfa *, struct colormap *, int,
+ ^ static void colorcomplement(struct nfa *, struct colormap *, int,
^ struct state *, struct state *, struct state *);
*/
-static VOID
-colorcomplement(nfa, cm, type, of, from, to)
-struct nfa *nfa;
-struct colormap *cm;
-int type;
-struct state *of; /* complements of this guy's PLAIN outarcs */
-struct state *from;
-struct state *to;
+static void
+colorcomplement(
+ struct nfa *nfa,
+ struct colormap *cm,
+ int type,
+ struct state *of, /* complements of this guy's PLAIN outarcs */
+ struct state *from,
+ struct state *to)
{
- struct colordesc *cd;
- struct colordesc *end = CDEND(cm);
- color co;
-
- assert(of != from);
- for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
- if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO))
- if (findarc(of, PLAIN, co) == NULL)
- newarc(nfa, type, co, from, to);
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ color co;
+
+ assert(of != from);
+ for (cd=cm->cd, co=0 ; cd<end && !CISERR() ; cd++, co++) {
+ if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO)) {
+ if (findarc(of, PLAIN, co) == NULL) {
+ newarc(nfa, type, co, from, to);
+ }
+ }
+ }
}
-
-
-
+
#ifdef REG_DEBUG
/*
^ #ifdef REG_DEBUG
@@ -690,89 +748,108 @@ struct state *to;
/*
- dumpcolors - debugging output
- ^ static VOID dumpcolors(struct colormap *, FILE *);
+ ^ static void dumpcolors(struct colormap *, FILE *);
*/
-static VOID
-dumpcolors(cm, f)
-struct colormap *cm;
-FILE *f;
+static void
+dumpcolors(
+ struct colormap *cm,
+ FILE *f)
{
- struct colordesc *cd;
- struct colordesc *end;
- color co;
- chr c;
- char *has;
-
- fprintf(f, "max %ld\n", (long)cm->max);
- if (NBYTS > 1)
- fillcheck(cm, cm->tree, 0, f);
- end = CDEND(cm);
- for (cd = cm->cd + 1, co = 1; cd < end; cd++, co++) /* skip 0 */
- if (!UNUSEDCOLOR(cd)) {
- assert(cd->nchrs > 0);
- has = (cd->block != NULL) ? "#" : "";
- if (cd->flags&PSEUDO)
- fprintf(f, "#%2ld%s(ps): ", (long)co, has);
- else
- fprintf(f, "#%2ld%s(%2d): ", (long)co,
- has, cd->nchrs);
- /* it's hard to do this more efficiently */
- for (c = CHR_MIN; c < CHR_MAX; c++)
- if (GETCOLOR(cm, c) == co)
- dumpchr(c, f);
- assert(c == CHR_MAX);
- if (GETCOLOR(cm, c) == co)
- dumpchr(c, f);
- fprintf(f, "\n");
+ struct colordesc *cd;
+ struct colordesc *end;
+ color co;
+ chr c;
+ char *has;
+
+ fprintf(f, "max %ld\n", (long) cm->max);
+ if (NBYTS > 1) {
+ fillcheck(cm, cm->tree, 0, f);
+ }
+ end = CDEND(cm);
+ for (cd=cm->cd+1, co=1 ; cd<end ; cd++, co++) { /* skip 0 */
+ if (!UNUSEDCOLOR(cd)) {
+ assert(cd->nchrs > 0);
+ has = (cd->block != NULL) ? "#" : "";
+ if (cd->flags&PSEUDO) {
+ fprintf(f, "#%2ld%s(ps): ", (long) co, has);
+ } else {
+ fprintf(f, "#%2ld%s(%2d): ", (long) co, has, cd->nchrs);
+ }
+
+ /*
+ * It's hard to do this more efficiently.
+ */
+
+ for (c=CHR_MIN ; c<CHR_MAX ; c++) {
+ if (GETCOLOR(cm, c) == co) {
+ dumpchr(c, f);
}
+ }
+ assert(c == CHR_MAX);
+ if (GETCOLOR(cm, c) == co) {
+ dumpchr(c, f);
+ }
+ fprintf(f, "\n");
+ }
+ }
}
-
+
/*
- fillcheck - check proper filling of a tree
- ^ static VOID fillcheck(struct colormap *, union tree *, int, FILE *);
+ ^ static void fillcheck(struct colormap *, union tree *, int, FILE *);
*/
-static VOID
-fillcheck(cm, tree, level, f)
-struct colormap *cm;
-union tree *tree;
-int level; /* level number (top == 0) of this block */
-FILE *f;
+static void
+fillcheck(
+ struct colormap *cm,
+ union tree *tree,
+ int level, /* level number (top == 0) of this block */
+ FILE *f)
{
- int i;
- union tree *t;
- union tree *fillt = &cm->tree[level+1];
-
- assert(level < NBYTS-1); /* this level has pointers */
- for (i = BYTTAB-1; i >= 0; i--) {
- t = tree->tptr[i];
- if (t == NULL)
- fprintf(f, "NULL found in filled tree!\n");
- else if (t == fillt)
- {}
- else if (level < NBYTS-2) /* more pointer blocks below */
- fillcheck(cm, t, level+1, f);
+ int i;
+ union tree *t;
+ union tree *fillt = &cm->tree[level+1];
+
+ assert(level < NBYTS-1); /* this level has pointers */
+ for (i=BYTTAB-1 ; i>=0 ; i--) {
+ t = tree->tptr[i];
+ if (t == NULL) {
+ fprintf(f, "NULL found in filled tree!\n");
+ } else if (t == fillt) {
+ /* empty body */
+ } else if (level < NBYTS-2) { /* more pointer blocks below */
+ fillcheck(cm, t, level+1, f);
}
+ }
}
-
+
/*
- dumpchr - print a chr
* Kind of char-centric but works well enough for debug use.
- ^ static VOID dumpchr(pchr, FILE *);
+ ^ static void dumpchr(pchr, FILE *);
*/
-static VOID
-dumpchr(c, f)
-pchr c;
-FILE *f;
+static void
+dumpchr(
+ pchr c,
+ FILE *f)
{
- if (c == '\\')
- fprintf(f, "\\\\");
- else if (c > ' ' && c <= '~')
- putc((char)c, f);
- else
- fprintf(f, "\\u%04lx", (long)c);
+ if (c == '\\') {
+ fprintf(f, "\\\\");
+ } else if (c > ' ' && c <= '~') {
+ putc((char) c, f);
+ } else {
+ fprintf(f, "\\u%04lx", (long) c);
+ }
}
/*
^ #endif
*/
#endif /* ifdef REG_DEBUG */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
index d2d56fc..0247521 100644
--- a/generic/regc_cvec.c
+++ b/generic/regc_cvec.c
@@ -3,20 +3,20 @@
* This file is #included by regcomp.c.
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -27,182 +27,120 @@
* 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.
- *
*/
/*
+ * Notes:
+ * Only (selected) functions in _this_ file should treat chr* as non-constant.
+ */
+
+/*
- newcvec - allocate a new cvec
- ^ static struct cvec *newcvec(int, int, int);
+ ^ static struct cvec *newcvec(int, int);
*/
static struct cvec *
-newcvec(nchrs, nranges, nmcces)
- int nchrs; /* to hold this many chrs... */
- int nranges; /* ... and this many ranges... */
- int nmcces; /* ... and this many MCCEs */
+newcvec(
+ int nchrs, /* to hold this many chrs... */
+ int nranges) /* ... and this many ranges... */
{
- size_t n;
- size_t nc;
- struct cvec *cv;
+ size_t nc = (size_t)nchrs + (size_t)nranges*2;
+ size_t n = sizeof(struct cvec) + nc*sizeof(chr);
+ struct cvec *cv = (struct cvec *) MALLOC(n);
- nc = (size_t)nchrs + (size_t)nmcces*(MAXMCCE+1) + (size_t)nranges*2;
- n = sizeof(struct cvec) + (size_t)(nmcces-1)*sizeof(chr *)
- + nc*sizeof(chr);
- cv = (struct cvec *)MALLOC(n);
if (cv == NULL) {
return NULL;
}
cv->chrspace = nchrs;
- cv->chrs = (chr *)&cv->mcces[nmcces]; /* chrs just after MCCE ptrs */
- cv->mccespace = nmcces;
- cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
+ cv->chrs = (chr *)(((char *)cv)+sizeof(struct cvec));
+ cv->ranges = cv->chrs + nchrs;
cv->rangespace = nranges;
return clearcvec(cv);
}
-
+
/*
- clearcvec - clear a possibly-new cvec
* Returns pointer as convenience.
^ static struct cvec *clearcvec(struct cvec *);
*/
static struct cvec *
-clearcvec(cv)
- struct cvec *cv; /* character vector */
+clearcvec(
+ struct cvec *cv) /* character vector */
{
- int i;
-
assert(cv != NULL);
cv->nchrs = 0;
- assert(cv->chrs == (chr *)&cv->mcces[cv->mccespace]);
- cv->nmcces = 0;
- cv->nmccechrs = 0;
cv->nranges = 0;
- for (i = 0; i < cv->mccespace; i++) {
- cv->mcces[i] = NULL;
- }
-
return cv;
}
-
+
/*
- addchr - add a chr to a cvec
- ^ static VOID addchr(struct cvec *, pchr);
+ ^ static void addchr(struct cvec *, pchr);
*/
-static VOID
-addchr(cv, c)
- struct cvec *cv; /* character vector */
- pchr c; /* character to add */
+static void
+addchr(
+ struct cvec *cv, /* character vector */
+ pchr c) /* character to add */
{
- assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
cv->chrs[cv->nchrs++] = (chr)c;
}
-
+
/*
- addrange - add a range to a cvec
- ^ static VOID addrange(struct cvec *, pchr, pchr);
+ ^ static void addrange(struct cvec *, pchr, pchr);
*/
-static VOID
-addrange(cv, from, to)
- struct cvec *cv; /* character vector */
- pchr from; /* first character of range */
- pchr to; /* last character of range */
+static void
+addrange(
+ struct cvec *cv, /* character vector */
+ pchr from, /* first character of range */
+ pchr to) /* last character of range */
{
assert(cv->nranges < cv->rangespace);
cv->ranges[cv->nranges*2] = (chr)from;
cv->ranges[cv->nranges*2 + 1] = (chr)to;
cv->nranges++;
}
-
-/*
- - addmcce - add an MCCE to a cvec
- ^ static VOID addmcce(struct cvec *, chr *, chr *);
- */
-static VOID
-addmcce(cv, startp, endp)
- struct cvec *cv; /* character vector */
- chr *startp; /* beginning of text */
- chr *endp; /* just past end of text */
-{
- int len;
- int i;
- chr *s;
- chr *d;
-
- if (startp == NULL && endp == NULL) {
- return;
- }
- len = endp - startp;
- assert(len > 0);
- assert(cv->nchrs + len < cv->chrspace - cv->nmccechrs);
- assert(cv->nmcces < cv->mccespace);
- d = &cv->chrs[cv->chrspace - cv->nmccechrs - len - 1];
- cv->mcces[cv->nmcces++] = d;
- for (s = startp, i = len; i > 0; s++, i--) {
- *d++ = *s;
- }
- *d++ = 0; /* endmarker */
- assert(d == &cv->chrs[cv->chrspace - cv->nmccechrs]);
- cv->nmccechrs += len + 1;
-}
-
-/*
- - haschr - does a cvec contain this chr?
- ^ static int haschr(struct cvec *, pchr);
- */
-static int /* predicate */
-haschr(cv, c)
- struct cvec *cv; /* character vector */
- pchr c; /* character to test for */
-{
- int i;
- chr *p;
-
- for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
- if (*p == c) {
- return 1;
- }
- }
- for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
- if ((*p <= c) && (c <= *(p+1))) {
- return 1;
- }
- }
- return 0;
-}
-
+
/*
- getcvec - get a cvec, remembering it as v->cv
- ^ static struct cvec *getcvec(struct vars *, int, int, int);
+ ^ static struct cvec *getcvec(struct vars *, int, int);
*/
static struct cvec *
-getcvec(v, nchrs, nranges, nmcces)
- struct vars *v; /* context */
- int nchrs; /* to hold this many chrs... */
- int nranges; /* ... and this many ranges... */
- int nmcces; /* ... and this many MCCEs */
+getcvec(
+ struct vars *v, /* context */
+ int nchrs, /* to hold this many chrs... */
+ int nranges) /* ... and this many ranges... */
{
- if (v->cv != NULL && nchrs <= v->cv->chrspace &&
- nranges <= v->cv->rangespace && nmcces <= v->cv->mccespace) {
+ if ((v->cv != NULL) && (nchrs <= v->cv->chrspace) &&
+ (nranges <= v->cv->rangespace)) {
return clearcvec(v->cv);
}
if (v->cv != NULL) {
freecvec(v->cv);
}
- v->cv = newcvec(nchrs, nranges, nmcces);
+ v->cv = newcvec(nchrs, nranges);
if (v->cv == NULL) {
ERR(REG_ESPACE);
}
return v->cv;
}
-
+
/*
- freecvec - free a cvec
- ^ static VOID freecvec(struct cvec *);
+ ^ static void freecvec(struct cvec *);
*/
-static VOID
-freecvec(cv)
- struct cvec *cv; /* character vector */
+static void
+freecvec(
+ struct cvec *cv) /* character vector */
{
FREE(cv);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 1acc3f4..132e757 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -3,20 +3,20 @@
* This file is #included by regcomp.c.
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -27,7 +27,6 @@
* 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.
- *
*/
/* scanning macros (know about v) */
@@ -35,9 +34,10 @@
#define HAVE(n) (v->stop - v->now >= (n))
#define NEXT1(c) (!ATEOS() && *v->now == CHR(c))
#define NEXT2(a,b) (HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))
-#define NEXT3(a,b,c) (HAVE(3) && *v->now == CHR(a) && \
- *(v->now+1) == CHR(b) && \
- *(v->now+2) == CHR(c))
+#define NEXT3(a,b,c) \
+ (HAVE(3) && *v->now == CHR(a) && \
+ *(v->now+1) == CHR(b) && \
+ *(v->now+2) == CHR(c))
#define SET(c) (v->nexttype = (c))
#define SETV(c, n) (v->nexttype = (c), v->nextvalue = (n))
#define RET(c) return (SET(c), 1)
@@ -60,804 +60,922 @@
/* construct pointer past end of chr array */
#define ENDOF(array) ((array) + sizeof(array)/sizeof(chr))
-
+
/*
- lexstart - set up lexical stuff, scan leading options
- ^ static VOID lexstart(struct vars *);
+ ^ static void lexstart(struct vars *);
*/
-static VOID
-lexstart(v)
-struct vars *v;
+static void
+lexstart(
+ struct vars *v)
{
- prefixes(v); /* may turn on new type bits etc. */
- NOERR();
+ prefixes(v); /* may turn on new type bits etc. */
+ NOERR();
- if (v->cflags&REG_QUOTE) {
- assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
- INTOCON(L_Q);
- } else if (v->cflags&REG_EXTENDED) {
- assert(!(v->cflags&REG_QUOTE));
- INTOCON(L_ERE);
- } else {
- assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
- INTOCON(L_BRE);
- }
+ if (v->cflags&REG_QUOTE) {
+ assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
+ INTOCON(L_Q);
+ } else if (v->cflags&REG_EXTENDED) {
+ assert(!(v->cflags&REG_QUOTE));
+ INTOCON(L_ERE);
+ } else {
+ assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
+ INTOCON(L_BRE);
+ }
- v->nexttype = EMPTY; /* remember we were at the start */
- next(v); /* set up the first token */
+ v->nexttype = EMPTY; /* remember we were at the start */
+ next(v); /* set up the first token */
}
-
+
/*
- prefixes - implement various special prefixes
- ^ static VOID prefixes(struct vars *);
+ ^ static void prefixes(struct vars *);
*/
-static VOID
-prefixes(v)
-struct vars *v;
+static void
+prefixes(
+ struct vars *v)
{
- /* literal string doesn't get any of this stuff */
- if (v->cflags&REG_QUOTE)
- return;
+ /*
+ * Literal string doesn't get any of this stuff.
+ */
- /* initial "***" gets special things */
- if (HAVE(4) && NEXT3('*', '*', '*'))
- switch (*(v->now + 3)) {
- case CHR('?'): /* "***?" error, msg shows version */
- ERR(REG_BADPAT);
- return; /* proceed no further */
- break;
- case CHR('='): /* "***=" shifts to literal string */
- NOTE(REG_UNONPOSIX);
- v->cflags |= REG_QUOTE;
- v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
- v->now += 4;
- return; /* and there can be no more prefixes */
- break;
- case CHR(':'): /* "***:" shifts to AREs */
- NOTE(REG_UNONPOSIX);
- v->cflags |= REG_ADVANCED;
- v->now += 4;
- break;
- default: /* otherwise *** is just an error */
- ERR(REG_BADRPT);
- return;
- break;
- }
+ if (v->cflags&REG_QUOTE) {
+ return;
+ }
- /* BREs and EREs don't get embedded options */
- if ((v->cflags&REG_ADVANCED) != REG_ADVANCED)
- return;
+ /*
+ * Initial "***" gets special things.
+ */
- /* embedded options (AREs only) */
- if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
- NOTE(REG_UNONPOSIX);
- v->now += 2;
- for (; !ATEOS() && iscalpha(*v->now); v->now++)
- switch (*v->now) {
- case CHR('b'): /* BREs (but why???) */
- v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
- break;
- case CHR('c'): /* case sensitive */
- v->cflags &= ~REG_ICASE;
- break;
- case CHR('e'): /* plain EREs */
- v->cflags |= REG_EXTENDED;
- v->cflags &= ~(REG_ADVF|REG_QUOTE);
- break;
- case CHR('i'): /* case insensitive */
- v->cflags |= REG_ICASE;
- break;
- case CHR('m'): /* Perloid synonym for n */
- case CHR('n'): /* \n affects ^ $ . [^ */
- v->cflags |= REG_NEWLINE;
- break;
- case CHR('p'): /* ~Perl, \n affects . [^ */
- v->cflags |= REG_NLSTOP;
- v->cflags &= ~REG_NLANCH;
- break;
- case CHR('q'): /* literal string */
- v->cflags |= REG_QUOTE;
- v->cflags &= ~REG_ADVANCED;
- break;
- case CHR('s'): /* single line, \n ordinary */
- v->cflags &= ~REG_NEWLINE;
- break;
- case CHR('t'): /* tight syntax */
- v->cflags &= ~REG_EXPANDED;
- break;
- case CHR('w'): /* weird, \n affects ^ $ only */
- v->cflags &= ~REG_NLSTOP;
- v->cflags |= REG_NLANCH;
- break;
- case CHR('x'): /* expanded syntax */
- v->cflags |= REG_EXPANDED;
- break;
- default:
- ERR(REG_BADOPT);
- return;
- }
- if (!NEXT1(')')) {
- ERR(REG_BADOPT);
- return;
- }
- v->now++;
- if (v->cflags&REG_QUOTE)
- v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+ if (HAVE(4) && NEXT3('*', '*', '*')) {
+ switch (*(v->now + 3)) {
+ case CHR('?'): /* "***?" error, msg shows version */
+ ERR(REG_BADPAT);
+ return; /* proceed no further */
+ break;
+ case CHR('='): /* "***=" shifts to literal string */
+ NOTE(REG_UNONPOSIX);
+ v->cflags |= REG_QUOTE;
+ v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
+ v->now += 4;
+ return; /* and there can be no more prefixes */
+ break;
+ case CHR(':'): /* "***:" shifts to AREs */
+ NOTE(REG_UNONPOSIX);
+ v->cflags |= REG_ADVANCED;
+ v->now += 4;
+ break;
+ default: /* otherwise *** is just an error */
+ ERR(REG_BADRPT);
+ return;
+ break;
}
-}
+ }
+ /*
+ * BREs and EREs don't get embedded options.
+ */
+
+ if ((v->cflags&REG_ADVANCED) != REG_ADVANCED) {
+ return;
+ }
+
+ /*
+ * Embedded options (AREs only).
+ */
+
+ if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
+ NOTE(REG_UNONPOSIX);
+ v->now += 2;
+ for (; !ATEOS() && iscalpha(*v->now); v->now++) {
+ switch (*v->now) {
+ case CHR('b'): /* BREs (but why???) */
+ v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
+ break;
+ case CHR('c'): /* case sensitive */
+ v->cflags &= ~REG_ICASE;
+ break;
+ case CHR('e'): /* plain EREs */
+ v->cflags |= REG_EXTENDED;
+ v->cflags &= ~(REG_ADVF|REG_QUOTE);
+ break;
+ case CHR('i'): /* case insensitive */
+ v->cflags |= REG_ICASE;
+ break;
+ case CHR('m'): /* Perloid synonym for n */
+ case CHR('n'): /* \n affects ^ $ . [^ */
+ v->cflags |= REG_NEWLINE;
+ break;
+ case CHR('p'): /* ~Perl, \n affects . [^ */
+ v->cflags |= REG_NLSTOP;
+ v->cflags &= ~REG_NLANCH;
+ break;
+ case CHR('q'): /* literal string */
+ v->cflags |= REG_QUOTE;
+ v->cflags &= ~REG_ADVANCED;
+ break;
+ case CHR('s'): /* single line, \n ordinary */
+ v->cflags &= ~REG_NEWLINE;
+ break;
+ case CHR('t'): /* tight syntax */
+ v->cflags &= ~REG_EXPANDED;
+ break;
+ case CHR('w'): /* weird, \n affects ^ $ only */
+ v->cflags &= ~REG_NLSTOP;
+ v->cflags |= REG_NLANCH;
+ break;
+ case CHR('x'): /* expanded syntax */
+ v->cflags |= REG_EXPANDED;
+ break;
+ default:
+ ERR(REG_BADOPT);
+ return;
+ }
+ }
+ if (!NEXT1(')')) {
+ ERR(REG_BADOPT);
+ return;
+ }
+ v->now++;
+ if (v->cflags&REG_QUOTE) {
+ v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+ }
+ }
+}
+
/*
- lexnest - "call a subroutine", interpolating string at the lexical level
* Note, this is not a very general facility. There are a number of
* implicit assumptions about what sorts of strings can be subroutines.
- ^ static VOID lexnest(struct vars *, chr *, chr *);
+ ^ static void lexnest(struct vars *, const chr *, const chr *);
*/
-static VOID
-lexnest(v, beginp, endp)
-struct vars *v;
-chr *beginp; /* start of interpolation */
-chr *endp; /* one past end of interpolation */
+static void
+lexnest(
+ struct vars *v,
+ const chr *beginp, /* start of interpolation */
+ const chr *endp) /* one past end of interpolation */
{
- assert(v->savenow == NULL); /* only one level of nesting */
- v->savenow = v->now;
- v->savestop = v->stop;
- v->now = beginp;
- v->stop = endp;
+ assert(v->savenow == NULL); /* only one level of nesting */
+ v->savenow = v->now;
+ v->savestop = v->stop;
+ v->now = beginp;
+ v->stop = endp;
}
-
+
/*
* string constants to interpolate as expansions of things like \d
*/
-static chr backd[] = { /* \d */
- CHR('['), CHR('['), CHR(':'),
- CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
- CHR(':'), CHR(']'), CHR(']')
+
+static const chr backd[] = { /* \d */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']'), CHR(']')
};
-static chr backD[] = { /* \D */
- CHR('['), CHR('^'), CHR('['), CHR(':'),
- CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
- CHR(':'), CHR(']'), CHR(']')
+static const chr backD[] = { /* \D */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']'), CHR(']')
};
-static chr brbackd[] = { /* \d within brackets */
- CHR('['), CHR(':'),
- CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
- CHR(':'), CHR(']')
+static const chr brbackd[] = { /* \d within brackets */
+ CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']')
};
-static chr backs[] = { /* \s */
- CHR('['), CHR('['), CHR(':'),
- CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
- CHR(':'), CHR(']'), CHR(']')
+static const chr backs[] = { /* \s */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']'), CHR(']')
};
-static chr backS[] = { /* \S */
- CHR('['), CHR('^'), CHR('['), CHR(':'),
- CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
- CHR(':'), CHR(']'), CHR(']')
+static const chr backS[] = { /* \S */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']'), CHR(']')
};
-static chr brbacks[] = { /* \s within brackets */
- CHR('['), CHR(':'),
- CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
- CHR(':'), CHR(']')
+static const chr brbacks[] = { /* \s within brackets */
+ CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']')
};
-static chr backw[] = { /* \w */
- CHR('['), CHR('['), CHR(':'),
- CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+static const chr backw[] = { /* \w */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
-static chr backW[] = { /* \W */
- CHR('['), CHR('^'), CHR('['), CHR(':'),
- CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+static const chr backW[] = { /* \W */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
-static chr brbackw[] = { /* \w within brackets */
- CHR('['), CHR(':'),
- CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_')
+static const chr brbackw[] = { /* \w within brackets */
+ CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_')
};
-
+
/*
- lexword - interpolate a bracket expression for word characters
* Possibly ought to inquire whether there is a "word" character class.
- ^ static VOID lexword(struct vars *);
+ ^ static void lexword(struct vars *);
*/
-static VOID
-lexword(v)
-struct vars *v;
+static void
+lexword(
+ struct vars *v)
{
- lexnest(v, backw, ENDOF(backw));
+ lexnest(v, backw, ENDOF(backw));
}
-
+
/*
- next - get next token
^ static int next(struct vars *);
*/
static int /* 1 normal, 0 failure */
-next(v)
-struct vars *v;
+next(
+ struct vars *v)
{
- chr c;
+ chr c;
- /* errors yield an infinite sequence of failures */
- if (ISERR())
- return 0; /* the error has set nexttype to EOS */
+ /*
+ * Errors yield an infinite sequence of failures.
+ */
- /* remember flavor of last token */
- v->lasttype = v->nexttype;
+ if (ISERR()) {
+ return 0; /* the error has set nexttype to EOS */
+ }
- /* REG_BOSONLY */
- if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
- /* at start of a REG_BOSONLY RE */
- RETV(SBEGIN, 0); /* same as \A */
- }
+ /*
+ * Remember flavor of last token.
+ */
- /* if we're nested and we've hit end, return to outer level */
- if (v->savenow != NULL && ATEOS()) {
- v->now = v->savenow;
- v->stop = v->savestop;
- v->savenow = v->savestop = NULL;
- }
+ v->lasttype = v->nexttype;
- /* skip white space etc. if appropriate (not in literal or []) */
- if (v->cflags&REG_EXPANDED)
- switch (v->lexcon) {
- case L_ERE:
- case L_BRE:
- case L_EBND:
- case L_BBND:
- skip(v);
- break;
- }
+ /*
+ * REG_BOSONLY
+ */
- /* handle EOS, depending on context */
- if (ATEOS()) {
- switch (v->lexcon) {
- case L_ERE:
- case L_BRE:
- case L_Q:
- RET(EOS);
- break;
- case L_EBND:
- case L_BBND:
- FAILW(REG_EBRACE);
- break;
- case L_BRACK:
- case L_CEL:
- case L_ECL:
- case L_CCL:
- FAILW(REG_EBRACK);
- break;
- }
- assert(NOTREACHED);
+ if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
+ /* at start of a REG_BOSONLY RE */
+ RETV(SBEGIN, 0); /* same as \A */
+ }
+
+ /*
+ * If we're nested and we've hit end, return to outer level.
+ */
+
+ if (v->savenow != NULL && ATEOS()) {
+ v->now = v->savenow;
+ v->stop = v->savestop;
+ v->savenow = v->savestop = NULL;
+ }
+
+ /*
+ * Skip white space etc. if appropriate (not in literal or [])
+ */
+
+ if (v->cflags&REG_EXPANDED) {
+ switch (v->lexcon) {
+ case L_ERE:
+ case L_BRE:
+ case L_EBND:
+ case L_BBND:
+ skip(v);
+ break;
}
+ }
- /* okay, time to actually get a character */
- c = *v->now++;
+ /*
+ * Handle EOS, depending on context.
+ */
- /* deal with the easy contexts, punt EREs to code below */
+ if (ATEOS()) {
switch (v->lexcon) {
- case L_BRE: /* punt BREs to separate function */
- return brenext(v, c);
- break;
- case L_ERE: /* see below */
- break;
- case L_Q: /* literal strings are easy */
- RETV(PLAIN, c);
- break;
- case L_BBND: /* bounds are fairly simple */
+ case L_ERE:
+ case L_BRE:
+ case L_Q:
+ RET(EOS);
+ break;
case L_EBND:
- switch (c) {
- case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
- case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
- case CHR('8'): case CHR('9'):
- RETV(DIGIT, (chr)DIGITVAL(c));
- break;
- case CHR(','):
- RET(',');
- break;
- case CHR('}'): /* ERE bound ends with } */
- if (INCON(L_EBND)) {
- INTOCON(L_ERE);
- if ((v->cflags&REG_ADVF) && NEXT1('?')) {
- v->now++;
- NOTE(REG_UNONPOSIX);
- RETV('}', 0);
- }
- RETV('}', 1);
- } else
- FAILW(REG_BADBR);
- break;
- case CHR('\\'): /* BRE bound ends with \} */
- if (INCON(L_BBND) && NEXT1('}')) {
- v->now++;
- INTOCON(L_BRE);
- RET('}');
- } else
- FAILW(REG_BADBR);
- break;
- default:
- FAILW(REG_BADBR);
- break;
- }
- assert(NOTREACHED);
- break;
- case L_BRACK: /* brackets are not too hard */
- switch (c) {
- case CHR(']'):
- if (LASTTYPE('['))
- RETV(PLAIN, c);
- else {
- INTOCON((v->cflags&REG_EXTENDED) ?
- L_ERE : L_BRE);
- RET(']');
- }
- break;
- case CHR('\\'):
- NOTE(REG_UBBS);
- if (!(v->cflags&REG_ADVF))
- RETV(PLAIN, c);
- NOTE(REG_UNONPOSIX);
- if (ATEOS())
- FAILW(REG_EESCAPE);
- (DISCARD)lexescape(v);
- switch (v->nexttype) { /* not all escapes okay here */
- case PLAIN:
- return 1;
- break;
- case CCLASS:
- switch (v->nextvalue) {
- case 'd':
- lexnest(v, brbackd, ENDOF(brbackd));
- break;
- case 's':
- lexnest(v, brbacks, ENDOF(brbacks));
- break;
- case 'w':
- lexnest(v, brbackw, ENDOF(brbackw));
- break;
- default:
- FAILW(REG_EESCAPE);
- break;
- }
- /* lexnest done, back up and try again */
- v->nexttype = v->lasttype;
- return next(v);
- break;
- }
- /* not one of the acceptable escapes */
- FAILW(REG_EESCAPE);
- break;
- case CHR('-'):
- if (LASTTYPE('[') || NEXT1(']'))
- RETV(PLAIN, c);
- else
- RETV(RANGE, c);
- break;
- case CHR('['):
- if (ATEOS())
- FAILW(REG_EBRACK);
- switch (*v->now++) {
- case CHR('.'):
- INTOCON(L_CEL);
- /* might or might not be locale-specific */
- RET(COLLEL);
- break;
- case CHR('='):
- INTOCON(L_ECL);
- NOTE(REG_ULOCALE);
- RET(ECLASS);
- break;
- case CHR(':'):
- INTOCON(L_CCL);
- NOTE(REG_ULOCALE);
- RET(CCLASS);
- break;
- default: /* oops */
- v->now--;
- RETV(PLAIN, c);
- break;
- }
- assert(NOTREACHED);
- break;
- default:
- RETV(PLAIN, c);
- break;
- }
- assert(NOTREACHED);
- break;
- case L_CEL: /* collating elements are easy */
- if (c == CHR('.') && NEXT1(']')) {
- v->now++;
- INTOCON(L_BRACK);
- RETV(END, '.');
- } else
- RETV(PLAIN, c);
- break;
- case L_ECL: /* ditto equivalence classes */
- if (c == CHR('=') && NEXT1(']')) {
- v->now++;
- INTOCON(L_BRACK);
- RETV(END, '=');
- } else
- RETV(PLAIN, c);
- break;
- case L_CCL: /* ditto character classes */
- if (c == CHR(':') && NEXT1(']')) {
- v->now++;
- INTOCON(L_BRACK);
- RETV(END, ':');
- } else
- RETV(PLAIN, c);
- break;
- default:
- assert(NOTREACHED);
- break;
+ case L_BBND:
+ FAILW(REG_EBRACE);
+ break;
+ case L_BRACK:
+ case L_CEL:
+ case L_ECL:
+ case L_CCL:
+ FAILW(REG_EBRACK);
+ break;
}
+ assert(NOTREACHED);
+ }
- /* that got rid of everything except EREs and AREs */
- assert(INCON(L_ERE));
+ /*
+ * Okay, time to actually get a character.
+ */
- /* deal with EREs and AREs, except for backslashes */
+ c = *v->now++;
+
+ /*
+ * Deal with the easy contexts, punt EREs to code below.
+ */
+
+ switch (v->lexcon) {
+ case L_BRE: /* punt BREs to separate function */
+ return brenext(v, c);
+ break;
+ case L_ERE: /* see below */
+ break;
+ case L_Q: /* literal strings are easy */
+ RETV(PLAIN, c);
+ break;
+ case L_BBND: /* bounds are fairly simple */
+ case L_EBND:
switch (c) {
- case CHR('|'):
- RET('|');
- break;
- case CHR('*'):
+ case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
+ case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+ case CHR('8'): case CHR('9'):
+ RETV(DIGIT, (chr)DIGITVAL(c));
+ break;
+ case CHR(','):
+ RET(',');
+ break;
+ case CHR('}'): /* ERE bound ends with } */
+ if (INCON(L_EBND)) {
+ INTOCON(L_ERE);
if ((v->cflags&REG_ADVF) && NEXT1('?')) {
- v->now++;
- NOTE(REG_UNONPOSIX);
- RETV('*', 0);
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('}', 0);
}
- RETV('*', 1);
+ RETV('}', 1);
+ } else {
+ FAILW(REG_BADBR);
+ }
+ break;
+ case CHR('\\'): /* BRE bound ends with \} */
+ if (INCON(L_BBND) && NEXT1('}')) {
+ v->now++;
+ INTOCON(L_BRE);
+ RET('}');
+ } else {
+ FAILW(REG_BADBR);
+ }
+ break;
+ default:
+ FAILW(REG_BADBR);
+ break;
+ }
+ assert(NOTREACHED);
+ break;
+ case L_BRACK: /* brackets are not too hard */
+ switch (c) {
+ case CHR(']'):
+ if (LASTTYPE('[')) {
+ RETV(PLAIN, c);
+ } else {
+ INTOCON((v->cflags&REG_EXTENDED) ? L_ERE : L_BRE);
+ RET(']');
+ }
+ break;
+ case CHR('\\'):
+ NOTE(REG_UBBS);
+ if (!(v->cflags&REG_ADVF)) {
+ RETV(PLAIN, c);
+ }
+ NOTE(REG_UNONPOSIX);
+ if (ATEOS()) {
+ FAILW(REG_EESCAPE);
+ }
+ (DISCARD)lexescape(v);
+ switch (v->nexttype) { /* not all escapes okay here */
+ case PLAIN:
+ return 1;
break;
- case CHR('+'):
- if ((v->cflags&REG_ADVF) && NEXT1('?')) {
- v->now++;
- NOTE(REG_UNONPOSIX);
- RETV('+', 0);
+ case CCLASS:
+ switch (v->nextvalue) {
+ case 'd':
+ lexnest(v, brbackd, ENDOF(brbackd));
+ break;
+ case 's':
+ lexnest(v, brbacks, ENDOF(brbacks));
+ break;
+ case 'w':
+ lexnest(v, brbackw, ENDOF(brbackw));
+ break;
+ default:
+ FAILW(REG_EESCAPE);
+ break;
}
- RETV('+', 1);
+
+ /*
+ * lexnest() done, back up and try again.
+ */
+
+ v->nexttype = v->lasttype;
+ return next(v);
break;
- case CHR('?'):
- if ((v->cflags&REG_ADVF) && NEXT1('?')) {
- v->now++;
- NOTE(REG_UNONPOSIX);
- RETV('?', 0);
- }
- RETV('?', 1);
+ }
+
+ /*
+ * Not one of the acceptable escapes.
+ */
+
+ FAILW(REG_EESCAPE);
+ break;
+ case CHR('-'):
+ if (LASTTYPE('[') || NEXT1(']')) {
+ RETV(PLAIN, c);
+ } else {
+ RETV(RANGE, c);
+ }
+ break;
+ case CHR('['):
+ if (ATEOS()) {
+ FAILW(REG_EBRACK);
+ }
+ switch (*v->now++) {
+ case CHR('.'):
+ INTOCON(L_CEL);
+
+ /*
+ * Might or might not be locale-specific.
+ */
+
+ RET(COLLEL);
break;
- case CHR('{'): /* bounds start or plain character */
- if (v->cflags&REG_EXPANDED)
- skip(v);
- if (ATEOS() || !iscdigit(*v->now)) {
- NOTE(REG_UBRACES);
- NOTE(REG_UUNSPEC);
- RETV(PLAIN, c);
- } else {
- NOTE(REG_UBOUNDS);
- INTOCON(L_EBND);
- RET('{');
- }
- assert(NOTREACHED);
+ case CHR('='):
+ INTOCON(L_ECL);
+ NOTE(REG_ULOCALE);
+ RET(ECLASS);
break;
- case CHR('('): /* parenthesis, or advanced extension */
- if ((v->cflags&REG_ADVF) && NEXT1('?')) {
- NOTE(REG_UNONPOSIX);
- v->now++;
- switch (*v->now++) {
- case CHR(':'): /* non-capturing paren */
- RETV('(', 0);
- break;
- case CHR('#'): /* comment */
- while (!ATEOS() && *v->now != CHR(')'))
- v->now++;
- if (!ATEOS())
- v->now++;
- assert(v->nexttype == v->lasttype);
- return next(v);
- break;
- case CHR('='): /* positive lookahead */
- NOTE(REG_ULOOKAHEAD);
- RETV(LACON, 1);
- break;
- case CHR('!'): /* negative lookahead */
- NOTE(REG_ULOOKAHEAD);
- RETV(LACON, 0);
- break;
- default:
- FAILW(REG_BADRPT);
- break;
- }
- assert(NOTREACHED);
- }
- if (v->cflags&REG_NOSUB)
- RETV('(', 0); /* all parens non-capturing */
- else
- RETV('(', 1);
+ case CHR(':'):
+ INTOCON(L_CCL);
+ NOTE(REG_ULOCALE);
+ RET(CCLASS);
break;
- case CHR(')'):
- if (LASTTYPE('(')) {
- NOTE(REG_UUNSPEC);
- }
- RETV(')', c);
+ default: /* oops */
+ v->now--;
+ RETV(PLAIN, c);
break;
- case CHR('['): /* easy except for [[:<:]] and [[:>:]] */
- if (HAVE(6) && *(v->now+0) == CHR('[') &&
- *(v->now+1) == CHR(':') &&
- (*(v->now+2) == CHR('<') ||
- *(v->now+2) == CHR('>')) &&
- *(v->now+3) == CHR(':') &&
- *(v->now+4) == CHR(']') &&
- *(v->now+5) == CHR(']')) {
- c = *(v->now+2);
- v->now += 6;
- NOTE(REG_UNONPOSIX);
- RET((c == CHR('<')) ? '<' : '>');
+ }
+ assert(NOTREACHED);
+ break;
+ default:
+ RETV(PLAIN, c);
+ break;
+ }
+ assert(NOTREACHED);
+ break;
+ case L_CEL: /* collating elements are easy */
+ if (c == CHR('.') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, '.');
+ } else {
+ RETV(PLAIN, c);
+ }
+ break;
+ case L_ECL: /* ditto equivalence classes */
+ if (c == CHR('=') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, '=');
+ } else {
+ RETV(PLAIN, c);
+ }
+ break;
+ case L_CCL: /* ditto character classes */
+ if (c == CHR(':') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, ':');
+ } else {
+ RETV(PLAIN, c);
+ }
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+
+ /*
+ * That got rid of everything except EREs and AREs.
+ */
+
+ assert(INCON(L_ERE));
+
+ /*
+ * Deal with EREs and AREs, except for backslashes.
+ */
+
+ switch (c) {
+ case CHR('|'):
+ RET('|');
+ break;
+ case CHR('*'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('*', 0);
+ }
+ RETV('*', 1);
+ break;
+ case CHR('+'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('+', 0);
+ }
+ RETV('+', 1);
+ break;
+ case CHR('?'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('?', 0);
+ }
+ RETV('?', 1);
+ break;
+ case CHR('{'): /* bounds start or plain character */
+ if (v->cflags&REG_EXPANDED) {
+ skip(v);
+ }
+ if (ATEOS() || !iscdigit(*v->now)) {
+ NOTE(REG_UBRACES);
+ NOTE(REG_UUNSPEC);
+ RETV(PLAIN, c);
+ } else {
+ NOTE(REG_UBOUNDS);
+ INTOCON(L_EBND);
+ RET('{');
+ }
+ assert(NOTREACHED);
+ break;
+ case CHR('('): /* parenthesis, or advanced extension */
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ NOTE(REG_UNONPOSIX);
+ v->now++;
+ switch (*v->now++) {
+ case CHR(':'): /* non-capturing paren */
+ RETV('(', 0);
+ break;
+ case CHR('#'): /* comment */
+ while (!ATEOS() && *v->now != CHR(')')) {
+ v->now++;
}
- INTOCON(L_BRACK);
- if (NEXT1('^')) {
- v->now++;
- RETV('[', 0);
+ if (!ATEOS()) {
+ v->now++;
}
- RETV('[', 1);
- break;
- case CHR('.'):
- RET('.');
- break;
- case CHR('^'):
- RET('^');
+ assert(v->nexttype == v->lasttype);
+ return next(v);
break;
- case CHR('$'):
- RET('$');
+ case CHR('='): /* positive lookahead */
+ NOTE(REG_ULOOKAHEAD);
+ RETV(LACON, 1);
break;
- case CHR('\\'): /* mostly punt backslashes to code below */
- if (ATEOS())
- FAILW(REG_EESCAPE);
+ case CHR('!'): /* negative lookahead */
+ NOTE(REG_ULOOKAHEAD);
+ RETV(LACON, 0);
break;
- default: /* ordinary character */
- RETV(PLAIN, c);
+ default:
+ FAILW(REG_BADRPT);
break;
+ }
+ assert(NOTREACHED);
}
+ if (v->cflags&REG_NOSUB) {
+ RETV('(', 0); /* all parens non-capturing */
+ } else {
+ RETV('(', 1);
+ }
+ break;
+ case CHR(')'):
+ if (LASTTYPE('(')) {
+ NOTE(REG_UUNSPEC);
+ }
+ RETV(')', c);
+ break;
+ case CHR('['): /* easy except for [[:<:]] and [[:>:]] */
+ if (HAVE(6) && *(v->now+0) == CHR('[') &&
+ *(v->now+1) == CHR(':') &&
+ (*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
+ *(v->now+3) == CHR(':') &&
+ *(v->now+4) == CHR(']') &&
+ *(v->now+5) == CHR(']')) {
+ c = *(v->now+2);
+ v->now += 6;
+ NOTE(REG_UNONPOSIX);
+ RET((c == CHR('<')) ? '<' : '>');
+ }
+ INTOCON(L_BRACK);
+ if (NEXT1('^')) {
+ v->now++;
+ RETV('[', 0);
+ }
+ RETV('[', 1);
+ break;
+ case CHR('.'):
+ RET('.');
+ break;
+ case CHR('^'):
+ RET('^');
+ break;
+ case CHR('$'):
+ RET('$');
+ break;
+ case CHR('\\'): /* mostly punt backslashes to code below */
+ if (ATEOS()) {
+ FAILW(REG_EESCAPE);
+ }
+ break;
+ default: /* ordinary character */
+ RETV(PLAIN, c);
+ break;
+ }
- /* ERE/ARE backslash handling; backslash already eaten */
- assert(!ATEOS());
- if (!(v->cflags&REG_ADVF)) { /* only AREs have non-trivial escapes */
- if (iscalnum(*v->now)) {
- NOTE(REG_UBSALNUM);
- NOTE(REG_UUNSPEC);
- }
- RETV(PLAIN, *v->now++);
+ /*
+ * ERE/ARE backslash handling; backslash already eaten.
+ */
+
+ assert(!ATEOS());
+ if (!(v->cflags&REG_ADVF)) {/* only AREs have non-trivial escapes */
+ if (iscalnum(*v->now)) {
+ NOTE(REG_UBSALNUM);
+ NOTE(REG_UUNSPEC);
}
- (DISCARD)lexescape(v);
- if (ISERR())
- FAILW(REG_EESCAPE);
- if (v->nexttype == CCLASS) { /* fudge at lexical level */
- switch (v->nextvalue) {
- case 'd': lexnest(v, backd, ENDOF(backd)); break;
- case 'D': lexnest(v, backD, ENDOF(backD)); break;
- case 's': lexnest(v, backs, ENDOF(backs)); break;
- case 'S': lexnest(v, backS, ENDOF(backS)); break;
- case 'w': lexnest(v, backw, ENDOF(backw)); break;
- case 'W': lexnest(v, backW, ENDOF(backW)); break;
- default:
- assert(NOTREACHED);
- FAILW(REG_ASSERT);
- break;
- }
- /* lexnest done, back up and try again */
- v->nexttype = v->lasttype;
- return next(v);
+ RETV(PLAIN, *v->now++);
+ }
+ (DISCARD)lexescape(v);
+ if (ISERR()) {
+ FAILW(REG_EESCAPE);
+ }
+ if (v->nexttype == CCLASS) {/* fudge at lexical level */
+ switch (v->nextvalue) {
+ case 'd': lexnest(v, backd, ENDOF(backd)); break;
+ case 'D': lexnest(v, backD, ENDOF(backD)); break;
+ case 's': lexnest(v, backs, ENDOF(backs)); break;
+ case 'S': lexnest(v, backS, ENDOF(backS)); break;
+ case 'w': lexnest(v, backw, ENDOF(backw)); break;
+ case 'W': lexnest(v, backW, ENDOF(backW)); break;
+ default:
+ assert(NOTREACHED);
+ FAILW(REG_ASSERT);
+ break;
}
- /* otherwise, lexescape has already done the work */
- return !ISERR();
-}
+ /* lexnest done, back up and try again */
+ v->nexttype = v->lasttype;
+ return next(v);
+ }
+
+ /*
+ * Otherwise, lexescape has already done the work.
+ */
+ return !ISERR();
+}
+
/*
- lexescape - parse an ARE backslash escape (backslash already eaten)
* Note slightly nonstandard use of the CCLASS type code.
^ static int lexescape(struct vars *);
*/
static int /* not actually used, but convenient for RETV */
-lexescape(v)
-struct vars *v;
+lexescape(
+ struct vars *v)
{
- chr c;
- static chr alert[] = {
- CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
- };
- static chr esc[] = {
- CHR('E'), CHR('S'), CHR('C')
- };
- chr *save;
-
- assert(v->cflags&REG_ADVF);
-
- assert(!ATEOS());
- c = *v->now++;
- if (!iscalnum(c))
- RETV(PLAIN, c);
+ chr c;
+ int i;
+ static const chr alert[] = {
+ CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
+ };
+ static const chr esc[] = {
+ CHR('E'), CHR('S'), CHR('C')
+ };
+ const chr *save;
- NOTE(REG_UNONPOSIX);
- switch (c) {
- case CHR('a'):
- RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
- break;
- case CHR('A'):
- RETV(SBEGIN, 0);
- break;
- case CHR('b'):
- RETV(PLAIN, CHR('\b'));
- break;
- case CHR('B'):
- RETV(PLAIN, CHR('\\'));
- break;
- case CHR('c'):
- NOTE(REG_UUNPORT);
- if (ATEOS())
- FAILW(REG_EESCAPE);
- RETV(PLAIN, (chr)(*v->now++ & 037));
- break;
- case CHR('d'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 'd');
- break;
- case CHR('D'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 'D');
- break;
- case CHR('e'):
- NOTE(REG_UUNPORT);
- RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
- break;
- case CHR('f'):
- RETV(PLAIN, CHR('\f'));
- break;
- case CHR('m'):
- RET('<');
- break;
- case CHR('M'):
- RET('>');
- break;
- case CHR('n'):
- RETV(PLAIN, CHR('\n'));
- break;
- case CHR('r'):
- RETV(PLAIN, CHR('\r'));
- break;
- case CHR('s'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 's');
- break;
- case CHR('S'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 'S');
- break;
- case CHR('t'):
- RETV(PLAIN, CHR('\t'));
- break;
- case CHR('u'):
- c = lexdigits(v, 16, 4, 4);
- if (ISERR())
- FAILW(REG_EESCAPE);
- RETV(PLAIN, c);
- break;
- case CHR('U'):
- c = lexdigits(v, 16, 8, 8);
- if (ISERR())
- FAILW(REG_EESCAPE);
- RETV(PLAIN, c);
- break;
- case CHR('v'):
- RETV(PLAIN, CHR('\v'));
- break;
- case CHR('w'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 'w');
- break;
- case CHR('W'):
- NOTE(REG_ULOCALE);
- RETV(CCLASS, 'W');
- break;
- case CHR('x'):
- NOTE(REG_UUNPORT);
- c = lexdigits(v, 16, 1, 255); /* REs >255 long outside spec */
- if (ISERR())
- FAILW(REG_EESCAPE);
- RETV(PLAIN, c);
- break;
- case CHR('y'):
- NOTE(REG_ULOCALE);
- RETV(WBDRY, 0);
- break;
- case CHR('Y'):
- NOTE(REG_ULOCALE);
- RETV(NWBDRY, 0);
- break;
- case CHR('Z'):
- RETV(SEND, 0);
- break;
- case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
- case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
- case CHR('9'):
- save = v->now;
- v->now--; /* put first digit back */
- c = lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
- if (ISERR())
- FAILW(REG_EESCAPE);
- /* ugly heuristic (first test is "exactly 1 digit?") */
- if (v->now - save == 0 || (int)c <= v->nsubexp) {
- NOTE(REG_UBACKREF);
- RETV(BACKREF, (chr)c);
- }
- /* oops, doesn't look like it's a backref after all... */
- v->now = save;
- /* and fall through into octal number */
- case CHR('0'):
- NOTE(REG_UUNPORT);
- v->now--; /* put first digit back */
- c = lexdigits(v, 8, 1, 3);
- if (ISERR())
- FAILW(REG_EESCAPE);
- RETV(PLAIN, c);
- break;
- default:
- assert(iscalpha(c));
- FAILW(REG_EESCAPE); /* unknown alphabetic escape */
- break;
+ assert(v->cflags&REG_ADVF);
+
+ assert(!ATEOS());
+ c = *v->now++;
+ if (!iscalnum(c)) {
+ RETV(PLAIN, c);
+ }
+
+ NOTE(REG_UNONPOSIX);
+ switch (c) {
+ case CHR('a'):
+ RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
+ break;
+ case CHR('A'):
+ RETV(SBEGIN, 0);
+ break;
+ case CHR('b'):
+ RETV(PLAIN, CHR('\b'));
+ break;
+ case CHR('B'):
+ RETV(PLAIN, CHR('\\'));
+ break;
+ case CHR('c'):
+ NOTE(REG_UUNPORT);
+ if (ATEOS()) {
+ FAILW(REG_EESCAPE);
}
- assert(NOTREACHED);
-}
+ RETV(PLAIN, (chr)(*v->now++ & 037));
+ break;
+ case CHR('d'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'd');
+ break;
+ case CHR('D'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'D');
+ break;
+ case CHR('e'):
+ NOTE(REG_UUNPORT);
+ RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
+ break;
+ case CHR('f'):
+ RETV(PLAIN, CHR('\f'));
+ break;
+ case CHR('m'):
+ RET('<');
+ break;
+ case CHR('M'):
+ RET('>');
+ break;
+ case CHR('n'):
+ RETV(PLAIN, CHR('\n'));
+ break;
+ case CHR('r'):
+ RETV(PLAIN, CHR('\r'));
+ break;
+ case CHR('s'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 's');
+ break;
+ case CHR('S'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'S');
+ break;
+ case CHR('t'):
+ RETV(PLAIN, CHR('\t'));
+ break;
+ case CHR('u'):
+ c = (uchr) lexdigits(v, 16, 1, 4);
+ if (ISERR()) {
+ FAILW(REG_EESCAPE);
+ }
+ RETV(PLAIN, c);
+ break;
+ case CHR('U'):
+ i = lexdigits(v, 16, 1, 8);
+ if (ISERR()) {
+ FAILW(REG_EESCAPE);
+ }
+ if (i > 0xFFFF) {
+ /* TODO: output a Surrogate pair
+ */
+ i = 0xFFFD;
+ }
+ RETV(PLAIN, (uchr) i);
+ break;
+ case CHR('v'):
+ RETV(PLAIN, CHR('\v'));
+ break;
+ case CHR('w'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'w');
+ break;
+ case CHR('W'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'W');
+ break;
+ case CHR('x'):
+ NOTE(REG_UUNPORT);
+ c = (uchr) lexdigits(v, 16, 1, 2);
+ if (ISERR()) {
+ FAILW(REG_EESCAPE);
+ }
+ RETV(PLAIN, c);
+ break;
+ case CHR('y'):
+ NOTE(REG_ULOCALE);
+ RETV(WBDRY, 0);
+ break;
+ case CHR('Y'):
+ NOTE(REG_ULOCALE);
+ RETV(NWBDRY, 0);
+ break;
+ case CHR('Z'):
+ RETV(SEND, 0);
+ break;
+ case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+ case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+ case CHR('9'):
+ save = v->now;
+ v->now--; /* put first digit back */
+ c = (uchr) lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
+ if (ISERR()) {
+ FAILW(REG_EESCAPE);
+ }
+
+ /*
+ * Ugly heuristic (first test is "exactly 1 digit?")
+ */
+
+ if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) {
+ NOTE(REG_UBACKREF);
+ RETV(BACKREF, (chr)c);
+ }
+
+ /*
+ * Oops, doesn't look like it's a backref after all...
+ */
+
+ v->now = save;
+
+ /*
+ * And fall through into octal number.
+ */
+ case CHR('0'):
+ NOTE(REG_UUNPORT);
+ v->now--; /* put first digit back */
+ 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:
+ assert(iscalpha(c));
+ FAILW(REG_EESCAPE); /* unknown alphabetic escape */
+ break;
+ }
+ assert(NOTREACHED);
+}
+
/*
- 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 */
-lexdigits(v, base, minlen, maxlen)
-struct vars *v;
-int base;
-int minlen;
-int maxlen;
+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 len;
- chr c;
- int d;
- CONST uchr ub = (uchr) base;
-
- n = 0;
- for (len = 0; len < maxlen && !ATEOS(); len++) {
- c = *v->now++;
- switch (c) {
- case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
- case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
- case CHR('8'): case CHR('9'):
- d = DIGITVAL(c);
- break;
- case CHR('a'): case CHR('A'): d = 10; break;
- case CHR('b'): case CHR('B'): d = 11; break;
- case CHR('c'): case CHR('C'): d = 12; break;
- case CHR('d'): case CHR('D'): d = 13; break;
- case CHR('e'): case CHR('E'): d = 14; break;
- case CHR('f'): case CHR('F'): d = 15; break;
- default:
- v->now--; /* oops, not a digit at all */
- d = -1;
- break;
- }
+ int n;
+ int len;
+ chr c;
+ int d;
+ const uchr ub = (uchr) base;
- if (d >= base) { /* not a plausible digit */
- v->now--;
- d = -1;
- }
- if (d < 0)
- break; /* NOTE BREAK OUT */
- n = n*ub + (uchr)d;
+ 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'):
+ case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+ case CHR('8'): case CHR('9'):
+ d = DIGITVAL(c);
+ break;
+ case CHR('a'): case CHR('A'): d = 10; break;
+ case CHR('b'): case CHR('B'): d = 11; break;
+ case CHR('c'): case CHR('C'): d = 12; break;
+ case CHR('d'): case CHR('D'): d = 13; break;
+ case CHR('e'): case CHR('E'): d = 14; break;
+ case CHR('f'): case CHR('F'): d = 15; break;
+ default:
+ v->now--; /* oops, not a digit at all */
+ d = -1;
+ break;
}
- if (len < minlen)
- ERR(REG_EESCAPE);
- return (chr)n;
-}
+ if (d >= base) { /* not a plausible digit */
+ v->now--;
+ d = -1;
+ }
+ if (d < 0) {
+ break; /* NOTE BREAK OUT */
+ }
+ n = n*ub + (uchr)d;
+ }
+ if (len < minlen) {
+ ERR(REG_EESCAPE);
+ }
+ return n;
+}
+
/*
- brenext - get next BRE token
* This is much like EREs except for all the stupid backslashes and the
@@ -865,197 +983,218 @@ int maxlen;
^ static int brenext(struct vars *, pchr);
*/
static int /* 1 normal, 0 failure */
-brenext(v, pc)
-struct vars *v;
-pchr pc;
+brenext(
+ struct vars *v,
+ pchr pc)
{
- chr c = (chr)pc;
+ chr c = (chr)pc;
- switch (c) {
- case CHR('*'):
- if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^'))
- RETV(PLAIN, c);
- RET('*');
- break;
- case CHR('['):
- if (HAVE(6) && *(v->now+0) == CHR('[') &&
- *(v->now+1) == CHR(':') &&
- (*(v->now+2) == CHR('<') ||
- *(v->now+2) == CHR('>')) &&
- *(v->now+3) == CHR(':') &&
- *(v->now+4) == CHR(']') &&
- *(v->now+5) == CHR(']')) {
- c = *(v->now+2);
- v->now += 6;
- NOTE(REG_UNONPOSIX);
- RET((c == CHR('<')) ? '<' : '>');
- }
- INTOCON(L_BRACK);
- if (NEXT1('^')) {
- v->now++;
- RETV('[', 0);
- }
- RETV('[', 1);
- break;
- case CHR('.'):
- RET('.');
- break;
- case CHR('^'):
- if (LASTTYPE(EMPTY))
- RET('^');
- if (LASTTYPE('(')) {
- NOTE(REG_UUNSPEC);
- RET('^');
- }
- RETV(PLAIN, c);
- break;
- case CHR('$'):
- if (v->cflags&REG_EXPANDED)
- skip(v);
- if (ATEOS())
- RET('$');
- if (NEXT2('\\', ')')) {
- NOTE(REG_UUNSPEC);
- RET('$');
- }
- RETV(PLAIN, c);
- break;
- case CHR('\\'):
- break; /* see below */
- default:
- RETV(PLAIN, c);
- break;
+ switch (c) {
+ case CHR('*'):
+ if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
+ RETV(PLAIN, c);
+ }
+ RET('*');
+ break;
+ case CHR('['):
+ if (HAVE(6) && *(v->now+0) == CHR('[') &&
+ *(v->now+1) == CHR(':') &&
+ (*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
+ *(v->now+3) == CHR(':') &&
+ *(v->now+4) == CHR(']') &&
+ *(v->now+5) == CHR(']')) {
+ c = *(v->now+2);
+ v->now += 6;
+ NOTE(REG_UNONPOSIX);
+ RET((c == CHR('<')) ? '<' : '>');
+ }
+ INTOCON(L_BRACK);
+ if (NEXT1('^')) {
+ v->now++;
+ RETV('[', 0);
+ }
+ RETV('[', 1);
+ break;
+ case CHR('.'):
+ RET('.');
+ break;
+ case CHR('^'):
+ if (LASTTYPE(EMPTY)) {
+ RET('^');
+ }
+ if (LASTTYPE('(')) {
+ NOTE(REG_UUNSPEC);
+ RET('^');
}
+ RETV(PLAIN, c);
+ break;
+ case CHR('$'):
+ if (v->cflags&REG_EXPANDED) {
+ skip(v);
+ }
+ if (ATEOS()) {
+ RET('$');
+ }
+ if (NEXT2('\\', ')')) {
+ NOTE(REG_UUNSPEC);
+ RET('$');
+ }
+ RETV(PLAIN, c);
+ break;
+ case CHR('\\'):
+ break; /* see below */
+ default:
+ RETV(PLAIN, c);
+ break;
+ }
- assert(c == CHR('\\'));
+ assert(c == CHR('\\'));
- if (ATEOS())
- FAILW(REG_EESCAPE);
+ if (ATEOS()) {
+ FAILW(REG_EESCAPE);
+ }
- c = *v->now++;
- switch (c) {
- case CHR('{'):
- INTOCON(L_BBND);
- NOTE(REG_UBOUNDS);
- RET('{');
- break;
- case CHR('('):
- RETV('(', 1);
- break;
- case CHR(')'):
- RETV(')', c);
- break;
- case CHR('<'):
- NOTE(REG_UNONPOSIX);
- RET('<');
- break;
- case CHR('>'):
- NOTE(REG_UNONPOSIX);
- RET('>');
- break;
- case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
- case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
- case CHR('9'):
- NOTE(REG_UBACKREF);
- RETV(BACKREF, (chr)DIGITVAL(c));
- break;
- default:
- if (iscalnum(c)) {
- NOTE(REG_UBSALNUM);
- NOTE(REG_UUNSPEC);
- }
- RETV(PLAIN, c);
- break;
+ c = *v->now++;
+ switch (c) {
+ case CHR('{'):
+ INTOCON(L_BBND);
+ NOTE(REG_UBOUNDS);
+ RET('{');
+ break;
+ case CHR('('):
+ RETV('(', 1);
+ break;
+ case CHR(')'):
+ RETV(')', c);
+ break;
+ case CHR('<'):
+ NOTE(REG_UNONPOSIX);
+ RET('<');
+ break;
+ case CHR('>'):
+ NOTE(REG_UNONPOSIX);
+ RET('>');
+ break;
+ case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+ case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+ case CHR('9'):
+ NOTE(REG_UBACKREF);
+ RETV(BACKREF, (chr)DIGITVAL(c));
+ break;
+ default:
+ if (iscalnum(c)) {
+ NOTE(REG_UBSALNUM);
+ NOTE(REG_UUNSPEC);
}
+ RETV(PLAIN, c);
+ break;
+ }
- assert(NOTREACHED);
+ assert(NOTREACHED);
}
-
+
/*
- skip - skip white space and comments in expanded form
- ^ static VOID skip(struct vars *);
+ ^ static void skip(struct vars *);
*/
-static VOID
-skip(v)
-struct vars *v;
+static void
+skip(
+ struct vars *v)
{
- chr *start = v->now;
-
- assert(v->cflags&REG_EXPANDED);
-
- for (;;) {
- while (!ATEOS() && iscspace(*v->now))
- v->now++;
- if (ATEOS() || *v->now != CHR('#'))
- break; /* NOTE BREAK OUT */
- assert(NEXT1('#'));
- while (!ATEOS() && *v->now != CHR('\n'))
- v->now++;
- /* leave the newline to be picked up by the iscspace loop */
+ const chr *start = v->now;
+
+ assert(v->cflags&REG_EXPANDED);
+
+ for (;;) {
+ while (!ATEOS() && iscspace(*v->now)) {
+ v->now++;
+ }
+ if (ATEOS() || *v->now != CHR('#')) {
+ break; /* NOTE BREAK OUT */
+ }
+ assert(NEXT1('#'));
+ while (!ATEOS() && *v->now != CHR('\n')) {
+ v->now++;
}
- if (v->now != start)
- NOTE(REG_UNONPOSIX);
-}
+ /*
+ * Leave the newline to be picked up by the iscspace loop.
+ */
+ }
+ if (v->now != start) {
+ NOTE(REG_UNONPOSIX);
+ }
+}
+
/*
- newline - return the chr for a newline
* This helps confine use of CHR to this source file.
^ static chr newline(NOPARMS);
*/
static chr
-newline()
+newline(void)
{
- return CHR('\n');
+ return CHR('\n');
}
-
+
/*
- ch - return the chr sequence for regc_locale.c's fake collating element ch
* This helps confine use of CHR to this source file. Beware that the caller
* knows how long the sequence is.
^ #ifdef REG_DEBUG
- ^ static chr *ch(NOPARMS);
+ ^ static const chr *ch(NOPARMS);
^ #endif
*/
#ifdef REG_DEBUG
-static chr *
-ch()
+static const chr *
+ch(void)
{
- static chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
+ static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
- return chstr;
+ return chstr;
}
#endif
-
+
/*
- chrnamed - return the chr known by a given (chr string) name
* The code is a bit clumsy, but this routine gets only such specialized
* use that it hardly matters.
- ^ static chr chrnamed(struct vars *, chr *, chr *, pchr);
+ ^ static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
*/
static chr
-chrnamed(v, startp, endp, lastresort)
-struct vars *v;
-chr *startp; /* start of name */
-chr *endp; /* just past end of name */
-pchr lastresort; /* what to return if name lookup fails */
+chrnamed(
+ struct vars *v,
+ const chr *startp, /* start of name */
+ const chr *endp, /* just past end of name */
+ pchr lastresort) /* what to return if name lookup fails */
{
- celt c;
- int errsave;
- int e;
- struct cvec *cv;
-
- errsave = v->err;
- v->err = 0;
- c = element(v, startp, endp);
- e = v->err;
- v->err = errsave;
-
- if (e != 0)
- return (chr)lastresort;
-
- cv = range(v, c, c, 0);
- if (cv->nchrs == 0)
- return (chr)lastresort;
- return cv->chrs[0];
+ celt c;
+ int errsave;
+ int e;
+ struct cvec *cv;
+
+ errsave = v->err;
+ v->err = 0;
+ c = element(v, startp, endp);
+ e = v->err;
+ v->err = errsave;
+
+ if (e != 0) {
+ return (chr)lastresort;
+ }
+
+ cv = range(v, c, c, 0);
+ if (cv->nchrs == 0) {
+ return (chr)lastresort;
+ }
+ return cv->chrs[0];
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 50f4792..0f8d1b2 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -1,4 +1,4 @@
-/*
+/*
* regc_locale.c --
*
* This file contains the Unicode locale specific regexp routines.
@@ -6,17 +6,15 @@
*
* 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: regc_locale.c,v 1.11 2004/02/23 10:43:23 dkf Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-
+
/* ASCII character-name table */
-static struct cname {
- char *name;
- char code;
+static const struct cname {
+ const char *name;
+ const char code;
} cnames[] = {
{"NUL", '\0'},
{"SOH", '\001'},
@@ -115,10 +113,12 @@ static struct cname {
{"DEL", '\177'},
{NULL, 0}
};
+
+/*
+ * Unicode character-class tables.
+ */
-/* Unicode character-class tables */
-
-typedef struct crange {
+typedef struct {
chr start;
chr end;
} crange;
@@ -129,387 +129,583 @@ typedef struct crange {
* and used in generic/regc_locale.c. Do not modify by hand.
*/
-/* Unicode: alphabetic characters */
-
-static 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}
+/*
+ * Unicode: alphabetic characters.
+ */
+
+static const crange alphaRangeTable[] = {
+ {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 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
+static const chr alphaCharTable[] = {
+ 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[] = {
+ {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f},
+ {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 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, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff
+#if TCL_UTF_MAX > 4
+ ,0x110bd, 0xe0001
+#endif
+};
+
+#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))
+
+/*
+ * Unicode: decimal digit characters.
+ */
-static 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}
+static const crange digitRangeTable[] = {
+ {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))
-/* no singletons of digit characters */
+/*
+ * no singletons of digit characters.
+ */
-/* Unicode: punctuation characters */
+/*
+ * Unicode: punctuation characters.
+ */
-static 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}
+static const crange punctRangeTable[] = {
+ {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},
+ {0x2308, 0x230b}, {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 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
+static const chr punctCharTable[] = {
+ 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))
-/* Unicode: white space characters */
+/*
+ * Unicode: white space characters.
+ */
-static crange spaceRangeTable[] = {
- {0x0009, 0x000d}, {0x2000, 0x200b}
+static const crange spaceRangeTable[] = {
+ {0x9, 0xd}, {0x2000, 0x200b}
};
#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
-static chr spaceCharTable[] = {
- 0x0020, 0x00a0, 0x1680, 0x2028, 0x2029, 0x202f, 0x3000
+static const chr spaceCharTable[] = {
+ 0x20, 0x85, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
+ 0x2060, 0x3000, 0xfeff
};
#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
-/* Unicode: lowercase characters */
-
-static 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}
+/*
+ * Unicode: lowercase characters.
+ */
+
+static const crange lowerRangeTable[] = {
+ {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 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
+static const chr lowerCharTable[] = {
+ 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))
-/* Unicode: uppercase characters */
-
-static 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}
+/*
+ * Unicode: uppercase characters.
+ */
+
+static const crange upperRangeTable[] = {
+ {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 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
+static const chr upperCharTable[] = {
+ 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))
-/* Unicode: unicode print characters excluding space */
-
-static 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}
+/*
+ * Unicode: unicode print characters excluding space.
+ */
+
+static const crange graphRangeTable[] = {
+ {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 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
+static const chr graphCharTable[] = {
+ 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))
@@ -519,60 +715,26 @@ static chr graphCharTable[] = {
*/
#define CH NOCELT
-
-/*
- - nmcces - how many distinct MCCEs are there?
- ^ static int nmcces(struct vars *);
- */
-static int
-nmcces(v)
- struct vars *v; /* context */
-{
- /*
- * No multi-character collating elements defined at the moment.
- */
- return 0;
-}
-
-/*
- - nleaders - how many chrs can be first chrs of MCCEs?
- ^ static int nleaders(struct vars *);
- */
-static int
-nleaders(v)
- struct vars *v; /* context */
-{
- return 0;
-}
-
-/*
- - allmcces - return a cvec with all the MCCEs of the locale
- ^ static struct cvec *allmcces(struct vars *, struct cvec *);
- */
-static struct cvec *
-allmcces(v, cv)
- struct vars *v; /* context */
- struct cvec *cv; /* this is supposed to have enough room */
-{
- return clearcvec(cv);
-}
-
+
/*
- element - map collating-element name to celt
- ^ static celt element(struct vars *, chr *, chr *);
+ ^ static celt element(struct vars *, const chr *, const chr *);
*/
static celt
-element(v, startp, endp)
- struct vars *v; /* context */
- chr *startp; /* points to start of name */
- chr *endp; /* points just past end of name */
+element(
+ struct vars *v, /* context */
+ const chr *startp, /* points to start of name */
+ const chr *endp) /* points just past end of name */
{
- struct cname *cn;
+ const struct cname *cn;
size_t len;
Tcl_DString ds;
- CONST char *np;
+ const char *np;
+
+ /*
+ * Generic: one-chr names stand for themselves.
+ */
- /* generic: one-chr names stand for themselves */
assert(startp < endp);
len = endp - startp;
if (len == 1) {
@@ -581,7 +743,10 @@ element(v, startp, endp)
NOTE(REG_ULOCALE);
- /* search table */
+ /*
+ * Search table.
+ */
+
Tcl_DStringInit(&ds);
np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
for (cn=cnames; cn->name!=NULL; cn++) {
@@ -594,21 +759,24 @@ element(v, startp, endp)
return CHR(cn->code);
}
- /* couldn't find it */
+ /*
+ * Couldn't find it.
+ */
+
ERR(REG_ECOLLATE);
return 0;
}
-
+
/*
- range - supply cvec for a range, including legality check
^ static struct cvec *range(struct vars *, celt, celt, int);
*/
static struct cvec *
-range(v, a, b, cases)
- struct vars *v; /* context */
- celt a; /* range start */
- celt b; /* range end, might equal a */
- int cases; /* case-independent? */
+range(
+ struct vars *v, /* context */
+ celt a, /* range start */
+ celt b, /* range end, might equal a */
+ int cases) /* case-independent? */
{
int nchrs;
struct cvec *cv;
@@ -619,23 +787,22 @@ range(v, a, b, cases)
return NULL;
}
- if (!cases) { /* easy version */
- cv = getcvec(v, 0, 1, 0);
+ if (!cases) { /* easy version */
+ cv = getcvec(v, 0, 1);
NOERRN();
addrange(cv, a, b);
return cv;
}
/*
- * When case-independent, it's hard to decide when cvec ranges are
- * usable, so for now at least, we won't try. We allocate enough
- * space for two case variants plus a little extra for the two
- * title case variants.
+ * When case-independent, it's hard to decide when cvec ranges are usable,
+ * so for now at least, we won't try. We allocate enough space for two
+ * case variants plus a little extra for the two title case variants.
*/
nchrs = (b - a + 1)*2 + 4;
- cv = getcvec(v, nchrs, 0, 0);
+ cv = getcvec(v, nchrs, 0);
NOERRN();
for (c=a; c<=b; c++) {
@@ -656,39 +823,41 @@ range(v, a, b, cases)
return cv;
}
-
+
/*
- before - is celt x before celt y, for purposes of range legality?
^ static int before(celt, celt);
*/
-static int /* predicate */
-before(x, y)
- celt x, y; /* collating elements */
+static int /* predicate */
+before(
+ celt x, celt y) /* collating elements */
{
- /* trivial because no MCCEs */
if (x < y) {
return 1;
}
return 0;
}
-
+
/*
- eclass - supply cvec for an equivalence class
* Must include case counterparts on request.
^ static struct cvec *eclass(struct vars *, celt, int);
*/
static struct cvec *
-eclass(v, c, cases)
- struct vars *v; /* context */
- celt c; /* Collating element representing
- * the equivalence class. */
- int cases; /* all cases? */
+eclass(
+ struct vars *v, /* context */
+ celt c, /* Collating element representing the
+ * equivalence class. */
+ int cases) /* all cases? */
{
struct cvec *cv;
- /* crude fake equivalence class for testing */
+ /*
+ * Crude fake equivalence class for testing.
+ */
+
if ((v->cflags&REG_FAKE) && c == 'x') {
- cv = getcvec(v, 4, 0, 0);
+ cv = getcvec(v, 4, 0);
addchr(cv, (chr)'x');
addchr(cv, (chr)'y');
if (cases) {
@@ -698,40 +867,43 @@ eclass(v, c, cases)
return cv;
}
- /* otherwise, none */
+ /*
+ * Otherwise, none.
+ */
+
if (cases) {
return allcases(v, c);
}
- cv = getcvec(v, 1, 0, 0);
+ cv = getcvec(v, 1, 0);
assert(cv != NULL);
addchr(cv, (chr)c);
return cv;
}
-
+
/*
- cclass - supply cvec for a character class
* Must include case counterparts on request.
- ^ static struct cvec *cclass(struct vars *, chr *, chr *, int);
+ ^ static struct cvec *cclass(struct vars *, const chr *, const chr *, int);
*/
static struct cvec *
-cclass(v, startp, endp, cases)
- struct vars *v; /* context */
- chr *startp; /* where the name starts */
- chr *endp; /* just past the end of the name */
- int cases; /* case-independent? */
+cclass(
+ struct vars *v, /* context */
+ const chr *startp, /* where the name starts */
+ const chr *endp, /* just past the end of the name */
+ int cases) /* case-independent? */
{
size_t len;
struct cvec *cv = NULL;
Tcl_DString ds;
- CONST char *np;
- char **namePtr;
+ const char *np;
+ const char *const *namePtr;
int i, index;
/*
* The following arrays define the valid character class names.
*/
- static char *classNames[] = {
+ static const char *const classNames[] = {
"alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",
"lower", "print", "punct", "space", "upper", "xdigit", NULL
};
@@ -740,7 +912,7 @@ cclass(v, startp, endp, cases)
CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH,
CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT
};
-
+
/*
* Extract the class name
@@ -751,15 +923,6 @@ cclass(v, startp, endp, cases)
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.
*/
@@ -775,139 +938,172 @@ cclass(v, startp, endp, cases)
ERR(REG_ECTYPE);
return NULL;
}
-
+
+ /*
+ * 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:
case CC_ALNUM:
- cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE, 0);
+ cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE);
if (cv) {
- for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) {
addchr(cv, alphaCharTable[i]);
}
- for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
addrange(cv, alphaRangeTable[i].start,
alphaRangeTable[i].end);
}
- for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) {
addrange(cv, digitRangeTable[i].start,
digitRangeTable[i].end);
}
}
break;
case CC_ALPHA:
- cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE, 0);
+ cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE);
if (cv) {
- for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
addrange(cv, alphaRangeTable[i].start,
alphaRangeTable[i].end);
}
- for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) {
addchr(cv, alphaCharTable[i]);
}
}
break;
case CC_ASCII:
- cv = getcvec(v, 0, 1, 0);
+ cv = getcvec(v, 0, 1);
if (cv) {
addrange(cv, 0, 0x7f);
}
break;
case CC_BLANK:
- cv = getcvec(v, 2, 0, 0);
+ cv = getcvec(v, 2, 0);
addchr(cv, '\t');
addchr(cv, ' ');
break;
case CC_CNTRL:
- cv = getcvec(v, 0, 2, 0);
- 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, 0);
- if (cv) {
- for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
+ cv = getcvec(v, 0, NUM_DIGIT_RANGE);
+ if (cv) {
+ for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) {
addrange(cv, digitRangeTable[i].start,
digitRangeTable[i].end);
}
}
break;
case CC_PUNCT:
- cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, 0);
+ cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE);
if (cv) {
- for (i=0 ; i<NUM_PUNCT_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_PUNCT_RANGE ; i++) {
addrange(cv, punctRangeTable[i].start,
punctRangeTable[i].end);
}
- for (i=0 ; i<NUM_PUNCT_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_PUNCT_CHAR ; i++) {
addchr(cv, punctCharTable[i]);
}
}
break;
case CC_XDIGIT:
/*
- * This is a 3 instead of (NUM_DIGIT_RANGE+2) because I've no
- * idea how to define the digits 'a' through 'f' in
- * non-western locales. The concept is quite possibly non
- * portable, or only used in contextx where the characters
- * used would be the western ones anyway! Whatever is
- * actually the case, the number of ranges is fixed (until
+ * This is a 3 instead of (NUM_DIGIT_RANGE+2) because I've no idea how
+ * to define the digits 'a' through 'f' in non-western locales. The
+ * concept is quite possibly non portable, or only used in contextx
+ * where the characters used would be the western ones anyway!
+ * Whatever is actually the case, the number of ranges is fixed (until
* someone comes up with a better arrangement!)
*/
- cv = getcvec(v, 0, 3, 0);
- if (cv) {
+
+ cv = getcvec(v, 0, 3);
+ if (cv) {
addrange(cv, '0', '9');
addrange(cv, 'a', 'f');
addrange(cv, 'A', 'F');
}
break;
case CC_SPACE:
- cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE, 0);
+ cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE);
if (cv) {
- for (i=0 ; i<NUM_SPACE_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
addrange(cv, spaceRangeTable[i].start,
spaceRangeTable[i].end);
}
- for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) {
addchr(cv, spaceCharTable[i]);
}
}
break;
case CC_LOWER:
- cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE, 0);
+ cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE);
if (cv) {
- for (i=0 ; i<NUM_LOWER_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_LOWER_RANGE ; i++) {
addrange(cv, lowerRangeTable[i].start,
lowerRangeTable[i].end);
}
- for (i=0 ; i<NUM_LOWER_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_LOWER_CHAR ; i++) {
addchr(cv, lowerCharTable[i]);
}
}
break;
case CC_UPPER:
- cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE, 0);
+ cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE);
if (cv) {
- for (i=0 ; i<NUM_UPPER_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_UPPER_RANGE ; i++) {
addrange(cv, upperRangeTable[i].start,
upperRangeTable[i].end);
}
- for (i=0 ; i<NUM_UPPER_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_UPPER_CHAR ; i++) {
addchr(cv, upperCharTable[i]);
}
}
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, 0);
+ cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE);
if (cv) {
- for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
+ for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
addrange(cv, graphRangeTable[i].start,
graphRangeTable[i].end);
}
- for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
+ for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) {
addchr(cv, graphCharTable[i]);
}
}
@@ -918,7 +1114,7 @@ cclass(v, startp, endp, cases)
}
return cv;
}
-
+
/*
- allcases - supply cvec for all case counterparts of a chr (including itself)
* This is a shortcut, preferably an efficient one, for simple characters;
@@ -926,9 +1122,9 @@ cclass(v, startp, endp, cases)
^ static struct cvec *allcases(struct vars *, pchr);
*/
static struct cvec *
-allcases(v, pc)
- struct vars *v; /* context */
- pchr pc; /* character to get case equivs of */
+allcases(
+ struct vars *v, /* context */
+ pchr pc) /* character to get case equivs of */
{
struct cvec *cv;
chr c = (chr)pc;
@@ -939,10 +1135,10 @@ allcases(v, pc)
tc = Tcl_UniCharToTitle((chr)c);
if (tc != uc) {
- cv = getcvec(v, 3, 0, 0);
+ cv = getcvec(v, 3, 0);
addchr(cv, tc);
} else {
- cv = getcvec(v, 2, 0, 0);
+ cv = getcvec(v, 2, 0);
}
addchr(cv, lc);
if (lc != uc) {
@@ -950,35 +1146,35 @@ allcases(v, pc)
}
return cv;
}
-
+
/*
- cmp - chr-substring compare
* Backrefs need this. It should preferably be efficient.
* Note that it does not need to report anything except equal/unequal.
* Note also that the length is exact, and the comparison should not
* stop at embedded NULs!
- ^ static int cmp(CONST chr *, CONST chr *, size_t);
+ ^ static int cmp(const chr *, const chr *, size_t);
*/
-static int /* 0 for equal, nonzero for unequal */
-cmp(x, y, len)
- CONST chr *x, *y; /* strings to compare */
- size_t len; /* exact length of comparison */
+static int /* 0 for equal, nonzero for unequal */
+cmp(
+ const chr *x, const chr *y, /* strings to compare */
+ size_t len) /* exact length of comparison */
{
return memcmp(VS(x), VS(y), len*sizeof(chr));
}
-
+
/*
- casecmp - case-independent chr-substring compare
* REG_ICASE backrefs need this. It should preferably be efficient.
* Note that it does not need to report anything except equal/unequal.
* Note also that the length is exact, and the comparison should not
* stop at embedded NULs!
- ^ static int casecmp(CONST chr *, CONST chr *, size_t);
+ ^ static int casecmp(const chr *, const chr *, size_t);
*/
-static int /* 0 for equal, nonzero for unequal */
-casecmp(x, y, len)
- CONST chr *x, *y; /* strings to compare */
- size_t len; /* exact length of comparison */
+static int /* 0 for equal, nonzero for unequal */
+casecmp(
+ const chr *x, const chr *y, /* strings to compare */
+ size_t len) /* exact length of comparison */
{
for (; len > 0; len--, x++, y++) {
if ((*x!=*y) && (Tcl_UniCharToLower(*x) != Tcl_UniCharToLower(*y))) {
@@ -987,3 +1183,11 @@ casecmp(x, y, len)
}
return 0;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 9881cd4..42489dd 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -2,24 +2,24 @@
* NFA utilities.
* This file is #included by regcomp.c.
*
- * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
* HENRY SPENCER 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;
@@ -28,752 +28,954 @@
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
- *
- *
- * One or two things that technically ought to be in here
- * are actually in color.c, thanks to some incestuous relationships in
- * the color chains.
+ * One or two things that technically ought to be in here are actually in
+ * color.c, thanks to some incestuous relationships in the color chains.
*/
#define NISERR() VISERR(nfa->v)
#define NERR(e) VERR(nfa->v, (e))
-
-
+
/*
- newnfa - set up an NFA
^ static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *);
*/
static struct nfa * /* the NFA, or NULL */
-newnfa(v, cm, parent)
-struct vars *v;
-struct colormap *cm;
-struct nfa *parent; /* NULL if primary NFA */
+newnfa(
+ struct vars *v,
+ struct colormap *cm,
+ struct nfa *parent) /* NULL if primary NFA */
{
- struct nfa *nfa;
-
- nfa = (struct nfa *)MALLOC(sizeof(struct nfa));
- if (nfa == NULL)
- return NULL;
-
- nfa->states = NULL;
- nfa->slast = NULL;
- nfa->free = NULL;
- nfa->nstates = 0;
- nfa->cm = cm;
- nfa->v = v;
- nfa->bos[0] = nfa->bos[1] = COLORLESS;
- nfa->eos[0] = nfa->eos[1] = COLORLESS;
- nfa->post = newfstate(nfa, '@'); /* number 0 */
- nfa->pre = newfstate(nfa, '>'); /* number 1 */
- nfa->parent = parent;
-
- nfa->init = newstate(nfa); /* may become invalid later */
- nfa->final = newstate(nfa);
- if (ISERR()) {
- freenfa(nfa);
- return NULL;
- }
- rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
- newarc(nfa, '^', 1, nfa->pre, nfa->init);
- newarc(nfa, '^', 0, nfa->pre, nfa->init);
- rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
- newarc(nfa, '$', 1, nfa->final, nfa->post);
- newarc(nfa, '$', 0, nfa->final, nfa->post);
-
- if (ISERR()) {
- freenfa(nfa);
- return NULL;
- }
- return nfa;
-}
+ struct nfa *nfa;
+ nfa = (struct nfa *) MALLOC(sizeof(struct nfa));
+ if (nfa == NULL) {
+ return NULL;
+ }
+
+ nfa->states = NULL;
+ nfa->slast = NULL;
+ nfa->free = NULL;
+ nfa->nstates = 0;
+ nfa->cm = cm;
+ nfa->v = v;
+ nfa->size = 0;
+ nfa->bos[0] = nfa->bos[1] = COLORLESS;
+ nfa->eos[0] = nfa->eos[1] = COLORLESS;
+ nfa->parent = parent; /* Precedes newfstate so parent is valid. */
+ nfa->post = newfstate(nfa, '@'); /* number 0 */
+ nfa->pre = newfstate(nfa, '>'); /* number 1 */
+
+ nfa->init = newstate(nfa); /* May become invalid later. */
+ nfa->final = newstate(nfa);
+ if (ISERR()) {
+ freenfa(nfa);
+ return NULL;
+ }
+ rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
+ newarc(nfa, '^', 1, nfa->pre, nfa->init);
+ newarc(nfa, '^', 0, nfa->pre, nfa->init);
+ rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
+ newarc(nfa, '$', 1, nfa->final, nfa->post);
+ newarc(nfa, '$', 0, nfa->final, nfa->post);
+
+ if (ISERR()) {
+ freenfa(nfa);
+ return NULL;
+ }
+ return nfa;
+}
+
/*
- - freenfa - free an entire NFA
- ^ static VOID freenfa(struct nfa *);
+ - TooManyStates - checks if the max states exceeds the compile-time value
+ ^ static int TooManyStates(struct nfa *);
+ */
+static int
+TooManyStates(
+ struct nfa *nfa)
+{
+ struct nfa *parent = nfa->parent;
+ size_t sz = nfa->size;
+
+ while (parent != NULL) {
+ sz = parent->size;
+ parent = parent->parent;
+ }
+ if (sz > REG_MAX_STATES) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ - IncrementSize - increases the tracked size of the NFA and its parents.
+ ^ static void IncrementSize(struct nfa *);
*/
-static VOID
-freenfa(nfa)
-struct nfa *nfa;
+static void
+IncrementSize(
+ struct nfa *nfa)
{
- struct state *s;
+ struct nfa *parent = nfa->parent;
- while ((s = nfa->states) != NULL) {
- s->nins = s->nouts = 0; /* don't worry about arcs */
- freestate(nfa, s);
- }
- while ((s = nfa->free) != NULL) {
- nfa->free = s->next;
- destroystate(nfa, s);
- }
+ nfa->size++;
+ while (parent != NULL) {
+ parent->size++;
+ parent = parent->parent;
+ }
+}
+
+/*
+ - DecrementSize - increases the tracked size of the NFA and its parents.
+ ^ static void DecrementSize(struct nfa *);
+ */
+static void
+DecrementSize(
+ struct nfa *nfa)
+{
+ struct nfa *parent = nfa->parent;
- nfa->slast = NULL;
- nfa->nstates = -1;
- nfa->pre = NULL;
- nfa->post = NULL;
- FREE(nfa);
+ nfa->size--;
+ while (parent != NULL) {
+ parent->size--;
+ parent = parent->parent;
+ }
}
+
+/*
+ - freenfa - free an entire NFA
+ ^ static void freenfa(struct nfa *);
+ */
+static void
+freenfa(
+ struct nfa *nfa)
+{
+ struct state *s;
+ while ((s = nfa->states) != NULL) {
+ s->nins = s->nouts = 0; /* don't worry about arcs */
+ freestate(nfa, s);
+ }
+ while ((s = nfa->free) != NULL) {
+ nfa->free = s->next;
+ destroystate(nfa, s);
+ }
+
+ nfa->slast = NULL;
+ nfa->nstates = -1;
+ nfa->pre = NULL;
+ nfa->post = NULL;
+ FREE(nfa);
+}
+
/*
- newstate - allocate an NFA state, with zero flag value
^ static struct state *newstate(struct nfa *);
*/
static struct state * /* NULL on error */
-newstate(nfa)
-struct nfa *nfa;
+newstate(
+ struct nfa *nfa)
{
- struct state *s;
-
- if (nfa->free != NULL) {
- s = nfa->free;
- nfa->free = s->next;
- } else {
- s = (struct state *)MALLOC(sizeof(struct state));
- if (s == NULL) {
- NERR(REG_ESPACE);
- return NULL;
- }
- s->oas.next = NULL;
- s->free = NULL;
- s->noas = 0;
- }
+ struct state *s;
- assert(nfa->nstates >= 0);
- s->no = nfa->nstates++;
- s->flag = 0;
- if (nfa->states == NULL)
- nfa->states = s;
- s->nins = 0;
- s->ins = NULL;
- s->nouts = 0;
- s->outs = NULL;
- s->tmp = NULL;
- s->next = NULL;
- if (nfa->slast != NULL) {
- assert(nfa->slast->next == NULL);
- nfa->slast->next = s;
+ if (TooManyStates(nfa)) {
+ /* XXX: add specific error for this */
+ NERR(REG_ETOOBIG);
+ return NULL;
+ }
+ if (nfa->free != NULL) {
+ s = nfa->free;
+ nfa->free = s->next;
+ } else {
+ s = (struct state *) MALLOC(sizeof(struct state));
+ if (s == NULL) {
+ NERR(REG_ESPACE);
+ return NULL;
}
- s->prev = nfa->slast;
- nfa->slast = s;
- return s;
+ s->oas.next = NULL;
+ s->free = NULL;
+ s->noas = 0;
+ }
+
+ assert(nfa->nstates >= 0);
+ s->no = nfa->nstates++;
+ s->flag = 0;
+ if (nfa->states == NULL) {
+ nfa->states = s;
+ }
+ s->nins = 0;
+ s->ins = NULL;
+ s->nouts = 0;
+ s->outs = NULL;
+ s->tmp = NULL;
+ s->next = NULL;
+ if (nfa->slast != NULL) {
+ assert(nfa->slast->next == NULL);
+ nfa->slast->next = s;
+ }
+ s->prev = nfa->slast;
+ nfa->slast = s;
+
+ /*
+ * Track the current size and the parent size.
+ */
+
+ IncrementSize(nfa);
+ return s;
}
-
+
/*
- newfstate - allocate an NFA state with a specified flag value
^ static struct state *newfstate(struct nfa *, int flag);
*/
static struct state * /* NULL on error */
-newfstate(nfa, flag)
-struct nfa *nfa;
-int flag;
+newfstate(
+ struct nfa *nfa,
+ int flag)
{
- struct state *s;
+ struct state *s;
- s = newstate(nfa);
- if (s != NULL)
- s->flag = (char)flag;
- return s;
+ s = newstate(nfa);
+ if (s != NULL) {
+ s->flag = (char) flag;
+ }
+ return s;
}
-
+
/*
- dropstate - delete a state's inarcs and outarcs and free it
- ^ static VOID dropstate(struct nfa *, struct state *);
+ ^ static void dropstate(struct nfa *, struct state *);
*/
-static VOID
-dropstate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+dropstate(
+ struct nfa *nfa,
+ struct state *s)
{
- struct arc *a;
+ struct arc *a;
- while ((a = s->ins) != NULL)
- freearc(nfa, a);
- while ((a = s->outs) != NULL)
- freearc(nfa, a);
- freestate(nfa, s);
+ while ((a = s->ins) != NULL) {
+ freearc(nfa, a);
+ }
+ while ((a = s->outs) != NULL) {
+ freearc(nfa, a);
+ }
+ freestate(nfa, s);
}
-
+
/*
- freestate - free a state, which has no in-arcs or out-arcs
- ^ static VOID freestate(struct nfa *, struct state *);
+ ^ static void freestate(struct nfa *, struct state *);
*/
-static VOID
-freestate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+freestate(
+ struct nfa *nfa,
+ struct state *s)
{
- assert(s != NULL);
- assert(s->nins == 0 && s->nouts == 0);
-
- s->no = FREESTATE;
- s->flag = 0;
- if (s->next != NULL)
- s->next->prev = s->prev;
- else {
- assert(s == nfa->slast);
- nfa->slast = s->prev;
- }
- if (s->prev != NULL)
- s->prev->next = s->next;
- else {
- assert(s == nfa->states);
- nfa->states = s->next;
- }
- s->prev = NULL;
- s->next = nfa->free; /* don't delete it, put it on the free list */
- nfa->free = s;
+ assert(s != NULL);
+ assert(s->nins == 0 && s->nouts == 0);
+
+ s->no = FREESTATE;
+ s->flag = 0;
+ if (s->next != NULL) {
+ s->next->prev = s->prev;
+ } else {
+ assert(s == nfa->slast);
+ nfa->slast = s->prev;
+ }
+ if (s->prev != NULL) {
+ s->prev->next = s->next;
+ } else {
+ assert(s == nfa->states);
+ nfa->states = s->next;
+ }
+ s->prev = NULL;
+ s->next = nfa->free; /* don't delete it, put it on the free list */
+ nfa->free = s;
+ DecrementSize(nfa);
}
-
+
/*
- destroystate - really get rid of an already-freed state
- ^ static VOID destroystate(struct nfa *, struct state *);
+ ^ static void destroystate(struct nfa *, struct state *);
*/
-static VOID
-destroystate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+destroystate(
+ struct nfa *nfa,
+ struct state *s)
{
- struct arcbatch *ab;
- struct arcbatch *abnext;
-
- assert(s->no == FREESTATE);
- for (ab = s->oas.next; ab != NULL; ab = abnext) {
- abnext = ab->next;
- FREE(ab);
- }
- s->ins = NULL;
- s->outs = NULL;
- s->next = NULL;
- FREE(s);
+ struct arcbatch *ab;
+ struct arcbatch *abnext;
+
+ assert(s->no == FREESTATE);
+ for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
+ abnext = ab->next;
+ FREE(ab);
+ }
+ s->ins = NULL;
+ s->outs = NULL;
+ s->next = NULL;
+ FREE(s);
}
-
+
/*
- newarc - set up a new arc within an NFA
- ^ static VOID newarc(struct nfa *, int, pcolor, struct state *,
+ ^ static void newarc(struct nfa *, int, pcolor, struct state *,
^ struct state *);
*/
-static VOID
-newarc(nfa, t, co, from, to)
-struct nfa *nfa;
-int t;
-pcolor co;
-struct state *from;
-struct state *to;
+static void
+newarc(
+ struct nfa *nfa,
+ int t,
+ pcolor co,
+ struct state *from,
+ struct state *to)
{
- struct arc *a;
-
- assert(from != NULL && to != NULL);
-
- /* check for duplicates */
- for (a = from->outs; a != NULL; a = a->outchain)
- if (a->to == to && a->co == co && a->type == t)
- return;
-
- a = allocarc(nfa, from);
- if (NISERR())
- return;
- assert(a != NULL);
+ struct arc *a;
- a->type = t;
- a->co = (color)co;
- a->to = to;
- a->from = from;
+ assert(from != NULL && to != NULL);
- /*
- * Put the new arc on the beginning, not the end, of the chains.
- * Not only is this easier, it has the very useful side effect that
- * deleting the most-recently-added arc is the cheapest case rather
- * than the most expensive one.
- */
- a->inchain = to->ins;
- to->ins = a;
- a->outchain = from->outs;
- from->outs = a;
+ /*
+ * Check for duplicates.
+ */
- from->nouts++;
- to->nins++;
-
- if (COLORED(a) && nfa->parent == NULL)
- colorchain(nfa->cm, a);
+ for (a=from->outs ; a!=NULL ; a=a->outchain) {
+ if (a->to == to && a->co == co && a->type == t) {
+ return;
+ }
+ }
+ a = allocarc(nfa, from);
+ if (NISERR()) {
return;
+ }
+ assert(a != NULL);
+
+ a->type = t;
+ a->co = (color) co;
+ a->to = to;
+ a->from = from;
+
+ /*
+ * Put the new arc on the beginning, not the end, of the chains. Not only
+ * is this easier, it has the very useful side effect that deleting the
+ * most-recently-added arc is the cheapest case rather than the most
+ * expensive one.
+ */
+
+ a->inchain = to->ins;
+ to->ins = a;
+ a->outchain = from->outs;
+ from->outs = a;
+
+ from->nouts++;
+ to->nins++;
+
+ if (COLORED(a) && nfa->parent == NULL) {
+ colorchain(nfa->cm, a);
+ }
}
-
+
/*
- allocarc - allocate a new out-arc within a state
^ static struct arc *allocarc(struct nfa *, struct state *);
*/
static struct arc * /* NULL for failure */
-allocarc(nfa, s)
-struct nfa *nfa;
-struct state *s;
+allocarc(
+ struct nfa *nfa,
+ struct state *s)
{
- struct arc *a;
- struct arcbatch *new;
- int i;
+ struct arc *a;
- /* shortcut */
- if (s->free == NULL && s->noas < ABSIZE) {
- a = &s->oas.a[s->noas];
- s->noas++;
- return a;
- }
+ /*
+ * Shortcut
+ */
- /* if none at hand, get more */
- if (s->free == NULL) {
- new = (struct arcbatch *)MALLOC(sizeof(struct arcbatch));
- if (new == NULL) {
- NERR(REG_ESPACE);
- return NULL;
- }
- new->next = s->oas.next;
- s->oas.next = new;
+ if (s->free == NULL && s->noas < ABSIZE) {
+ a = &s->oas.a[s->noas];
+ s->noas++;
+ return a;
+ }
- for (i = 0; i < ABSIZE; i++) {
- new->a[i].type = 0;
- new->a[i].freechain = &new->a[i+1];
- }
- new->a[ABSIZE-1].freechain = NULL;
- s->free = &new->a[0];
+ /*
+ * if none at hand, get more
+ */
+
+ if (s->free == NULL) {
+ struct arcbatch *newAb = (struct arcbatch *)
+ MALLOC(sizeof(struct arcbatch));
+ int i;
+
+ if (newAb == NULL) {
+ NERR(REG_ESPACE);
+ return NULL;
}
- assert(s->free != NULL);
+ newAb->next = s->oas.next;
+ s->oas.next = newAb;
- a = s->free;
- s->free = a->freechain;
- return a;
+ for (i=0 ; i<ABSIZE ; i++) {
+ newAb->a[i].type = 0;
+ newAb->a[i].freechain = &newAb->a[i+1];
+ }
+ newAb->a[ABSIZE-1].freechain = NULL;
+ s->free = &newAb->a[0];
+ }
+ assert(s->free != NULL);
+
+ a = s->free;
+ s->free = a->freechain;
+ return a;
}
-
+
/*
- freearc - free an arc
- ^ static VOID freearc(struct nfa *, struct arc *);
+ ^ static void freearc(struct nfa *, struct arc *);
*/
-static VOID
-freearc(nfa, victim)
-struct nfa *nfa;
-struct arc *victim;
+static void
+freearc(
+ struct nfa *nfa,
+ struct arc *victim)
+{
+ struct state *from = victim->from;
+ struct state *to = victim->to;
+ struct arc *a;
+
+ assert(victim->type != 0);
+
+ /*
+ * Take it off color chain if necessary.
+ */
+
+ if (COLORED(victim) && nfa->parent == NULL) {
+ uncolorchain(nfa->cm, victim);
+ }
+
+ /*
+ * Take it off source's out-chain.
+ */
+
+ assert(from != NULL);
+ assert(from->outs != NULL);
+ a = from->outs;
+ if (a == victim) { /* simple case: first in chain */
+ from->outs = victim->outchain;
+ } else {
+ for (; a!=NULL && a->outchain!=victim ; a=a->outchain) {
+ continue;
+ }
+ assert(a != NULL);
+ a->outchain = victim->outchain;
+ }
+ from->nouts--;
+
+ /*
+ * Take it off target's in-chain.
+ */
+
+ assert(to != NULL);
+ assert(to->ins != NULL);
+ a = to->ins;
+ if (a == victim) { /* simple case: first in chain */
+ to->ins = victim->inchain;
+ } else {
+ for (; a->inchain!=victim ; a=a->inchain) {
+ assert(a->inchain != NULL);
+ continue;
+ }
+ a->inchain = victim->inchain;
+ }
+ to->nins--;
+
+ /*
+ * Clean up and place on free list.
+ */
+
+ victim->type = 0;
+ victim->from = NULL; /* precautions... */
+ victim->to = NULL;
+ victim->inchain = NULL;
+ victim->outchain = NULL;
+ victim->freechain = from->free;
+ from->free = victim;
+}
+
+/*
+ - hasnonemptyout - Does state have a non-EMPTY out arc?
+ ^ static int hasnonemptyout(struct state *);
+ */
+static int
+hasnonemptyout(
+ struct state *s)
{
- struct state *from = victim->from;
- struct state *to = victim->to;
- struct arc *a;
-
- assert(victim->type != 0);
-
- /* take it off color chain if necessary */
- if (COLORED(victim) && nfa->parent == NULL)
- uncolorchain(nfa->cm, victim);
-
- /* take it off source's out-chain */
- assert(from != NULL);
- assert(from->outs != NULL);
- a = from->outs;
- if (a == victim) /* simple case: first in chain */
- from->outs = victim->outchain;
- else {
- for (; a != NULL && a->outchain != victim; a = a->outchain)
- continue;
- assert(a != NULL);
- a->outchain = victim->outchain;
+ struct arc *a;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (a->type != EMPTY) {
+ return 1;
}
- from->nouts--;
-
- /* take it off target's in-chain */
- assert(to != NULL);
- assert(to->ins != NULL);
- a = to->ins;
- if (a == victim) /* simple case: first in chain */
- to->ins = victim->inchain;
- else {
- for (; a != NULL && a->inchain != victim; a = a->inchain)
- continue;
- assert(a != NULL);
- a->inchain = victim->inchain;
+ }
+ return 0;
+}
+
+/*
+ - nonemptyouts - count non-EMPTY out arcs of a state
+ ^ static int nonemptyouts(struct state *);
+ */
+static int
+nonemptyouts(
+ struct state *s)
+{
+ int n = 0;
+ struct arc *a;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (a->type != EMPTY) {
+ n++;
}
- to->nins--;
-
- /* clean up and place on free list */
- victim->type = 0;
- victim->from = NULL; /* precautions... */
- victim->to = NULL;
- victim->inchain = NULL;
- victim->outchain = NULL;
- victim->freechain = from->free;
- from->free = victim;
+ }
+ return n;
}
+
+/*
+ - nonemptyins - count non-EMPTY in arcs of a state
+ ^ static int nonemptyins(struct state *);
+ */
+static int
+nonemptyins(
+ struct state *s)
+{
+ int n = 0;
+ struct arc *a;
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ if (a->type != EMPTY) {
+ n++;
+ }
+ }
+ return n;
+}
+
/*
- findarc - find arc, if any, from given source with given type and color
* If there is more than one such arc, the result is random.
^ static struct arc *findarc(struct state *, int, pcolor);
*/
static struct arc *
-findarc(s, type, co)
-struct state *s;
-int type;
-pcolor co;
+findarc(
+ struct state *s,
+ int type,
+ pcolor co)
{
- struct arc *a;
+ struct arc *a;
- for (a = s->outs; a != NULL; a = a->outchain)
- if (a->type == type && a->co == co)
- return a;
- return NULL;
+ for (a=s->outs ; a!=NULL ; a=a->outchain) {
+ if (a->type == type && a->co == co) {
+ return a;
+ }
+ }
+ return NULL;
}
-
+
/*
- cparc - allocate a new arc within an NFA, copying details from old one
- ^ static VOID cparc(struct nfa *, struct arc *, struct state *,
+ ^ static void cparc(struct nfa *, struct arc *, struct state *,
^ struct state *);
*/
-static VOID
-cparc(nfa, oa, from, to)
-struct nfa *nfa;
-struct arc *oa;
-struct state *from;
-struct state *to;
+static void
+cparc(
+ struct nfa *nfa,
+ struct arc *oa,
+ struct state *from,
+ struct state *to)
{
- newarc(nfa, oa->type, oa->co, from, to);
+ newarc(nfa, oa->type, oa->co, from, to);
}
-
+
/*
- moveins - move all in arcs of a state to another state
* You might think this could be done better by just updating the
* existing arcs, and you would be right if it weren't for the desire
* for duplicate suppression, which makes it easier to just make new
* ones to exploit the suppression built into newarc.
- ^ static VOID moveins(struct nfa *, struct state *, struct state *);
+ ^ static void moveins(struct nfa *, struct state *, struct state *);
*/
-static VOID
-moveins(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+moveins(
+ struct nfa *nfa,
+ struct state *oldState,
+ struct state *newState)
{
- struct arc *a;
+ struct arc *a;
- assert(old != new);
+ assert(oldState != newState);
- while ((a = old->ins) != NULL) {
- cparc(nfa, a, a->from, new);
- freearc(nfa, a);
- }
- assert(old->nins == 0);
- assert(old->ins == NULL);
+ while ((a = oldState->ins) != NULL) {
+ cparc(nfa, a, a->from, newState);
+ freearc(nfa, a);
+ }
+ assert(oldState->nins == 0);
+ assert(oldState->ins == NULL);
}
-
+
/*
- - copyins - copy all in arcs of a state to another state
- ^ static VOID copyins(struct nfa *, struct state *, struct state *);
+ - copyins - copy in arcs of a state to another state
+ * Either all arcs, or only non-empty ones as determined by all value.
+ ^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
*/
-static VOID
-copyins(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+copyins(
+ struct nfa *nfa,
+ struct state *oldState,
+ struct state *newState,
+ int all)
{
- struct arc *a;
+ struct arc *a;
- assert(old != new);
+ assert(oldState != newState);
- for (a = old->ins; a != NULL; a = a->inchain)
- cparc(nfa, a, a->from, new);
+ for (a=oldState->ins ; a!=NULL ; a=a->inchain) {
+ if (all || a->type != EMPTY) {
+ cparc(nfa, a, a->from, newState);
+ }
+ }
}
-
+
/*
- moveouts - move all out arcs of a state to another state
- ^ static VOID moveouts(struct nfa *, struct state *, struct state *);
+ ^ static void moveouts(struct nfa *, struct state *, struct state *);
*/
-static VOID
-moveouts(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+moveouts(
+ struct nfa *nfa,
+ struct state *oldState,
+ struct state *newState)
{
- struct arc *a;
+ struct arc *a;
- assert(old != new);
+ assert(oldState != newState);
- while ((a = old->outs) != NULL) {
- cparc(nfa, a, new, a->to);
- freearc(nfa, a);
- }
+ while ((a = oldState->outs) != NULL) {
+ cparc(nfa, a, newState, a->to);
+ freearc(nfa, a);
+ }
}
-
+
/*
- - copyouts - copy all out arcs of a state to another state
- ^ static VOID copyouts(struct nfa *, struct state *, struct state *);
+ - copyouts - copy out arcs of a state to another state
+ * Either all arcs, or only non-empty ones as determined by all value.
+ ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
*/
-static VOID
-copyouts(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+copyouts(
+ struct nfa *nfa,
+ struct state *oldState,
+ struct state *newState,
+ int all)
{
- struct arc *a;
+ struct arc *a;
- assert(old != new);
+ assert(oldState != newState);
- for (a = old->outs; a != NULL; a = a->outchain)
- cparc(nfa, a, new, a->to);
+ for (a=oldState->outs ; a!=NULL ; a=a->outchain) {
+ if (all || a->type != EMPTY) {
+ cparc(nfa, a, newState, a->to);
+ }
+ }
}
-
+
/*
- cloneouts - copy out arcs of a state to another state pair, modifying type
- ^ static VOID cloneouts(struct nfa *, struct state *, struct state *,
+ ^ static void cloneouts(struct nfa *, struct state *, struct state *,
^ struct state *, int);
*/
-static VOID
-cloneouts(nfa, old, from, to, type)
-struct nfa *nfa;
-struct state *old;
-struct state *from;
-struct state *to;
-int type;
+static void
+cloneouts(
+ struct nfa *nfa,
+ struct state *old,
+ struct state *from,
+ struct state *to,
+ int type)
{
- struct arc *a;
+ struct arc *a;
- assert(old != from);
+ assert(old != from);
- for (a = old->outs; a != NULL; a = a->outchain)
- newarc(nfa, type, a->co, from, to);
+ for (a=old->outs ; a!=NULL ; a=a->outchain) {
+ newarc(nfa, type, a->co, from, to);
+ }
}
-
+
/*
- delsub - delete a sub-NFA, updating subre pointers if necessary
* This uses a recursive traversal of the sub-NFA, marking already-seen
* states using their tmp pointer.
- ^ static VOID delsub(struct nfa *, struct state *, struct state *);
+ ^ static void delsub(struct nfa *, struct state *, struct state *);
*/
-static VOID
-delsub(nfa, lp, rp)
-struct nfa *nfa;
-struct state *lp; /* the sub-NFA goes from here... */
-struct state *rp; /* ...to here, *not* inclusive */
+static void
+delsub(
+ struct nfa *nfa,
+ struct state *lp, /* the sub-NFA goes from here... */
+ struct state *rp) /* ...to here, *not* inclusive */
{
- assert(lp != rp);
+ assert(lp != rp);
- rp->tmp = rp; /* mark end */
+ rp->tmp = rp; /* mark end */
- deltraverse(nfa, lp, lp);
- assert(lp->nouts == 0 && rp->nins == 0); /* did the job */
- assert(lp->no != FREESTATE && rp->no != FREESTATE); /* no more */
+ deltraverse(nfa, lp, lp);
+ assert(lp->nouts == 0 && rp->nins == 0); /* did the job */
+ assert(lp->no != FREESTATE && rp->no != FREESTATE); /* no more */
- rp->tmp = NULL; /* unmark end */
- lp->tmp = NULL; /* and begin, marked by deltraverse */
+ rp->tmp = NULL; /* unmark end */
+ lp->tmp = NULL; /* and begin, marked by deltraverse */
}
-
+
/*
- deltraverse - the recursive heart of delsub
* This routine's basic job is to destroy all out-arcs of the state.
- ^ static VOID deltraverse(struct nfa *, struct state *, struct state *);
+ ^ static void deltraverse(struct nfa *, struct state *, struct state *);
*/
-static VOID
-deltraverse(nfa, leftend, s)
-struct nfa *nfa;
-struct state *leftend;
-struct state *s;
+static void
+deltraverse(
+ struct nfa *nfa,
+ struct state *leftend,
+ struct state *s)
{
- struct arc *a;
- struct state *to;
-
- if (s->nouts == 0)
- return; /* nothing to do */
- if (s->tmp != NULL)
- return; /* already in progress */
-
- s->tmp = s; /* mark as in progress */
-
- while ((a = s->outs) != NULL) {
- to = a->to;
- deltraverse(nfa, leftend, to);
- assert(to->nouts == 0 || to->tmp != NULL);
- freearc(nfa, a);
- if (to->nins == 0 && to->tmp == NULL) {
- assert(to->nouts == 0);
- freestate(nfa, to);
- }
+ struct arc *a;
+ struct state *to;
+
+ if (s->nouts == 0) {
+ return; /* nothing to do */
+ }
+ if (s->tmp != NULL) {
+ return; /* already in progress */
+ }
+
+ s->tmp = s; /* mark as in progress */
+
+ while ((a = s->outs) != NULL) {
+ to = a->to;
+ deltraverse(nfa, leftend, to);
+ assert(to->nouts == 0 || to->tmp != NULL);
+ freearc(nfa, a);
+ if (to->nins == 0 && to->tmp == NULL) {
+ assert(to->nouts == 0);
+ freestate(nfa, to);
}
+ }
- assert(s->no != FREESTATE); /* we're still here */
- assert(s == leftend || s->nins != 0); /* and still reachable */
- assert(s->nouts == 0); /* but have no outarcs */
+ assert(s->no != FREESTATE); /* we're still here */
+ assert(s == leftend || s->nins != 0); /* and still reachable */
+ assert(s->nouts == 0); /* but have no outarcs */
- s->tmp = NULL; /* we're done here */
+ s->tmp = NULL; /* we're done here */
}
-
+
/*
- dupnfa - duplicate sub-NFA
- * Another recursive traversal, this time using tmp to point to duplicates
- * as well as mark already-seen states. (You knew there was a reason why
- * it's a state pointer, didn't you? :-))
- ^ static VOID dupnfa(struct nfa *, struct state *, struct state *,
+ * Another recursive traversal, this time using tmp to point to duplicates as
+ * well as mark already-seen states. (You knew there was a reason why it's a
+ * state pointer, didn't you? :-))
+ ^ static void dupnfa(struct nfa *, struct state *, struct state *,
^ struct state *, struct state *);
*/
-static VOID
-dupnfa(nfa, start, stop, from, to)
-struct nfa *nfa;
-struct state *start; /* duplicate of subNFA starting here */
-struct state *stop; /* and stopping here */
-struct state *from; /* stringing duplicate from here */
-struct state *to; /* to here */
+static void
+dupnfa(
+ struct nfa *nfa,
+ struct state *start, /* duplicate of subNFA starting here */
+ struct state *stop, /* and stopping here */
+ struct state *from, /* stringing duplicate from here */
+ struct state *to) /* to here */
{
- if (start == stop) {
- newarc(nfa, EMPTY, 0, from, to);
- return;
- }
+ if (start == stop) {
+ newarc(nfa, EMPTY, 0, from, to);
+ return;
+ }
- stop->tmp = to;
- duptraverse(nfa, start, from);
- /* done, except for clearing out the tmp pointers */
+ stop->tmp = to;
+ duptraverse(nfa, start, from, 0);
+ /* done, except for clearing out the tmp pointers */
- stop->tmp = NULL;
- cleartraverse(nfa, start);
+ stop->tmp = NULL;
+ cleartraverse(nfa, start);
}
-
+
/*
- duptraverse - recursive heart of dupnfa
- ^ static VOID duptraverse(struct nfa *, struct state *, struct state *);
+ ^ static void duptraverse(struct nfa *, struct state *, struct state *);
*/
-static VOID
-duptraverse(nfa, s, stmp)
-struct nfa *nfa;
-struct state *s;
-struct state *stmp; /* s's duplicate, or NULL */
+static void
+duptraverse(
+ struct nfa *nfa,
+ struct state *s,
+ struct state *stmp, /* s's duplicate, or NULL */
+ int depth)
{
- struct arc *a;
+ struct arc *a;
- if (s->tmp != NULL)
- return; /* already done */
+ if (s->tmp != NULL) {
+ return; /* already done */
+ }
- s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
- if (s->tmp == NULL) {
- assert(NISERR());
- return;
- }
+ s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
+ if (s->tmp == NULL) {
+ assert(NISERR());
+ return;
+ }
+
+ /*
+ * Arbitrary depth limit. Needs tuning, but this value is sufficient to
+ * make all normal tests (not reg-33.14) pass.
+ */
+#ifndef DUPTRAVERSE_MAX_DEPTH
+#define DUPTRAVERSE_MAX_DEPTH 15000
+#endif
+
+ if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
+ NERR(REG_ESPACE);
+ }
- for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
- duptraverse(nfa, a->to, (struct state *)NULL);
- assert(a->to->tmp != NULL);
- cparc(nfa, a, s->tmp, a->to->tmp);
+ for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {
+ duptraverse(nfa, a->to, NULL, depth);
+ if (NISERR()) {
+ break;
}
+ assert(a->to->tmp != NULL);
+ cparc(nfa, a, s->tmp, a->to->tmp);
+ }
}
-
+
/*
- cleartraverse - recursive cleanup for algorithms that leave tmp ptrs set
- ^ static VOID cleartraverse(struct nfa *, struct state *);
+ ^ static void cleartraverse(struct nfa *, struct state *);
*/
-static VOID
-cleartraverse(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+cleartraverse(
+ struct nfa *nfa,
+ struct state *s)
{
- struct arc *a;
+ struct arc *a;
- if (s->tmp == NULL)
- return;
- s->tmp = NULL;
+ if (s->tmp == NULL) {
+ return;
+ }
+ s->tmp = NULL;
- for (a = s->outs; a != NULL; a = a->outchain)
- cleartraverse(nfa, a->to);
+ for (a=s->outs ; a!=NULL ; a=a->outchain) {
+ cleartraverse(nfa, a->to);
+ }
}
-
+
/*
- specialcolors - fill in special colors for an NFA
- ^ static VOID specialcolors(struct nfa *);
+ ^ static void specialcolors(struct nfa *);
*/
-static VOID
-specialcolors(nfa)
-struct nfa *nfa;
+static void
+specialcolors(
+ struct nfa *nfa)
{
- /* false colors for BOS, BOL, EOS, EOL */
- if (nfa->parent == NULL) {
- nfa->bos[0] = pseudocolor(nfa->cm);
- nfa->bos[1] = pseudocolor(nfa->cm);
- nfa->eos[0] = pseudocolor(nfa->cm);
- nfa->eos[1] = pseudocolor(nfa->cm);
- } else {
- assert(nfa->parent->bos[0] != COLORLESS);
- nfa->bos[0] = nfa->parent->bos[0];
- assert(nfa->parent->bos[1] != COLORLESS);
- nfa->bos[1] = nfa->parent->bos[1];
- assert(nfa->parent->eos[0] != COLORLESS);
- nfa->eos[0] = nfa->parent->eos[0];
- assert(nfa->parent->eos[1] != COLORLESS);
- nfa->eos[1] = nfa->parent->eos[1];
- }
+ /*
+ * False colors for BOS, BOL, EOS, EOL
+ */
+
+ if (nfa->parent == NULL) {
+ nfa->bos[0] = pseudocolor(nfa->cm);
+ nfa->bos[1] = pseudocolor(nfa->cm);
+ nfa->eos[0] = pseudocolor(nfa->cm);
+ nfa->eos[1] = pseudocolor(nfa->cm);
+ } else {
+ assert(nfa->parent->bos[0] != COLORLESS);
+ nfa->bos[0] = nfa->parent->bos[0];
+ assert(nfa->parent->bos[1] != COLORLESS);
+ nfa->bos[1] = nfa->parent->bos[1];
+ assert(nfa->parent->eos[0] != COLORLESS);
+ nfa->eos[0] = nfa->parent->eos[0];
+ assert(nfa->parent->eos[1] != COLORLESS);
+ nfa->eos[1] = nfa->parent->eos[1];
+ }
}
-
+
/*
- optimize - optimize an NFA
^ static long optimize(struct nfa *, FILE *);
*/
static long /* re_info bits */
-optimize(nfa, f)
-struct nfa *nfa;
-FILE *f; /* for debug output; NULL none */
+optimize(
+ struct nfa *nfa,
+ FILE *f) /* for debug output; NULL none */
{
- int verbose = (f != NULL) ? 1 : 0;
-
- if (verbose)
- fprintf(f, "\ninitial cleanup:\n");
- cleanup(nfa); /* may simplify situation */
- if (verbose)
- dumpnfa(nfa, f);
- if (verbose)
- fprintf(f, "\nempties:\n");
- fixempties(nfa, f); /* get rid of EMPTY arcs */
- if (verbose)
- fprintf(f, "\nconstraints:\n");
- pullback(nfa, f); /* pull back constraints backward */
- pushfwd(nfa, f); /* push fwd constraints forward */
- if (verbose)
- fprintf(f, "\nfinal cleanup:\n");
- cleanup(nfa); /* final tidying */
- return analyze(nfa); /* and analysis */
+ int verbose = (f != NULL) ? 1 : 0;
+
+ if (verbose) {
+ fprintf(f, "\ninitial cleanup:\n");
+ }
+ cleanup(nfa); /* may simplify situation */
+ if (verbose) {
+ dumpnfa(nfa, f);
+ }
+ if (verbose) {
+ fprintf(f, "\nempties:\n");
+ }
+ fixempties(nfa, f); /* get rid of EMPTY arcs */
+ if (verbose) {
+ fprintf(f, "\nconstraints:\n");
+ }
+ pullback(nfa, f); /* pull back constraints backward */
+ pushfwd(nfa, f); /* push fwd constraints forward */
+ if (verbose) {
+ fprintf(f, "\nfinal cleanup:\n");
+ }
+ cleanup(nfa); /* final tidying */
+ return analyze(nfa); /* and analysis */
}
-
+
/*
- pullback - pull back constraints backward to (with luck) eliminate them
- ^ static VOID pullback(struct nfa *, FILE *);
+ ^ static void pullback(struct nfa *, FILE *);
*/
-static VOID
-pullback(nfa, f)
-struct nfa *nfa;
-FILE *f; /* for debug output; NULL none */
+static void
+pullback(
+ struct nfa *nfa,
+ FILE *f) /* for debug output; NULL none */
{
- struct state *s;
- struct state *nexts;
- struct arc *a;
- struct arc *nexta;
- int progress;
-
- /* find and pull until there are no more */
- do {
- progress = 0;
- for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
- nexts = s->next;
- for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
- nexta = a->outchain;
- if (a->type == '^' || a->type == BEHIND)
- if (pull(nfa, a))
- progress = 1;
- assert(nexta == NULL || s->no != FREESTATE);
- }
- }
- if (progress && f != NULL)
- dumpnfa(nfa, f);
- } while (progress && !NISERR());
- if (NISERR())
- return;
-
- for (a = nfa->pre->outs; a != NULL; a = nexta) {
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int progress;
+
+ /*
+ * Find and pull until there are no more.
+ */
+
+ do {
+ progress = 0;
+ for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
+ nexts = s->next;
+ for (a=s->outs ; a!=NULL && !NISERR() ; a=nexta) {
nexta = a->outchain;
- if (a->type == '^') {
- assert(a->co == 0 || a->co == 1);
- newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
- freearc(nfa, a);
+ if (a->type == '^' || a->type == BEHIND) {
+ if (pull(nfa, a)) {
+ progress = 1;
+ }
}
+ assert(nexta == NULL || s->no != FREESTATE);
+ }
+ }
+ if (progress && f != NULL) {
+ dumpnfa(nfa, f);
}
+ } while (progress && !NISERR());
+ if (NISERR()) {
+ return;
+ }
+
+ for (a=nfa->pre->outs ; a!=NULL ; a=nexta) {
+ nexta = a->outchain;
+ if (a->type == '^') {
+ assert(a->co == 0 || a->co == 1);
+ newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
+ freearc(nfa, a);
+ }
+ }
}
-
+
/*
- pull - pull a back constraint backward past its source state
* A significant property of this function is that it deletes at most
@@ -782,116 +984,155 @@ FILE *f; /* for debug output; NULL none */
^ static int pull(struct nfa *, struct arc *);
*/
static int /* 0 couldn't, 1 could */
-pull(nfa, con)
-struct nfa *nfa;
-struct arc *con;
+pull(
+ struct nfa *nfa,
+ struct arc *con)
{
- struct state *from = con->from;
- struct state *to = con->to;
- struct arc *a;
- struct arc *nexta;
- struct state *s;
-
- if (from == to) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
- if (from->flag) /* can't pull back beyond start */
- return 0;
- if (from->nins == 0) { /* unreachable */
- freearc(nfa, con);
- return 1;
- }
+ struct state *from = con->from;
+ struct state *to = con->to;
+ struct arc *a;
+ struct arc *nexta;
+ struct state *s;
+
+ if (from == to) { /* circular constraint is pointless */
+ freearc(nfa, con);
+ return 1;
+ }
+ if (from->flag) { /* can't pull back beyond start */
+ return 0;
+ }
+ if (from->nins == 0) { /* unreachable */
+ freearc(nfa, con);
+ return 1;
+ }
+
+ /*
+ * DGP 2007-11-15: Cloning a state with a circular constraint on its list
+ * of outs can lead to trouble [Bug 1810038], so get rid of them first.
+ */
- /* first, clone from state if necessary to avoid other outarcs */
- if (from->nouts > 1) {
- s = newstate(nfa);
- if (NISERR())
- return 0;
- assert(to != from); /* con is not an inarc */
- copyins(nfa, from, s); /* duplicate inarcs */
- cparc(nfa, con, s, to); /* move constraint arc */
- freearc(nfa, con);
- from = s;
- con = from->outs;
+ for (a = from->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ switch (a->type) {
+ case '^':
+ case '$':
+ case BEHIND:
+ case AHEAD:
+ if (from == a->to) {
+ freearc(nfa, a);
+ }
+ break;
}
- assert(from->nouts == 1);
+ }
- /* propagate the constraint into the from state's inarcs */
- for (a = from->ins; a != NULL; a = nexta) {
- nexta = a->inchain;
- switch (combine(con, a)) {
- case INCOMPATIBLE: /* destroy the arc */
- freearc(nfa, a);
- break;
- case SATISFIED: /* no action needed */
- break;
- case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR())
- return 0;
- cparc(nfa, a, s, to); /* anticipate move */
- cparc(nfa, con, a->from, s);
- if (NISERR())
- return 0;
- freearc(nfa, a);
- break;
- default:
- assert(NOTREACHED);
- break;
- }
+ /*
+ * First, clone from state if necessary to avoid other outarcs.
+ */
+
+ if (from->nouts > 1) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
}
+ assert(to != from); /* con is not an inarc */
+ copyins(nfa, from, s, 1); /* duplicate inarcs */
+ cparc(nfa, con, s, to); /* move constraint arc */
+ freearc(nfa, con);
+ from = s;
+ con = from->outs;
+ }
+ assert(from->nouts == 1);
+
+ /*
+ * Propagate the constraint into the from state's inarcs.
+ */
+
+ for (a=from->ins ; a!=NULL ; a=nexta) {
+ nexta = a->inchain;
+ switch (combine(con, a)) {
+ case INCOMPATIBLE: /* destroy the arc */
+ freearc(nfa, a);
+ break;
+ case SATISFIED: /* no action needed */
+ break;
+ case COMPATIBLE: /* swap the two arcs, more or less */
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ cparc(nfa, a, s, to); /* anticipate move */
+ cparc(nfa, con, a->from, s);
+ if (NISERR()) {
+ return 0;
+ }
+ freearc(nfa, a);
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+ }
- /* remaining inarcs, if any, incorporate the constraint */
- moveins(nfa, from, to);
- dropstate(nfa, from); /* will free the constraint */
- return 1;
-}
+ /*
+ * Remaining inarcs, if any, incorporate the constraint.
+ */
+ moveins(nfa, from, to);
+ dropstate(nfa, from); /* will free the constraint */
+ return 1;
+}
+
/*
- pushfwd - push forward constraints forward to (with luck) eliminate them
- ^ static VOID pushfwd(struct nfa *, FILE *);
+ ^ static void pushfwd(struct nfa *, FILE *);
*/
-static VOID
-pushfwd(nfa, f)
-struct nfa *nfa;
-FILE *f; /* for debug output; NULL none */
+static void
+pushfwd(
+ struct nfa *nfa,
+ FILE *f) /* for debug output; NULL none */
{
- struct state *s;
- struct state *nexts;
- struct arc *a;
- struct arc *nexta;
- int progress;
-
- /* find and push until there are no more */
- do {
- progress = 0;
- for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
- nexts = s->next;
- for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
- nexta = a->inchain;
- if (a->type == '$' || a->type == AHEAD)
- if (push(nfa, a))
- progress = 1;
- assert(nexta == NULL || s->no != FREESTATE);
- }
- }
- if (progress && f != NULL)
- dumpnfa(nfa, f);
- } while (progress && !NISERR());
- if (NISERR())
- return;
-
- for (a = nfa->post->ins; a != NULL; a = nexta) {
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int progress;
+
+ /*
+ * Find and push until there are no more.
+ */
+
+ do {
+ progress = 0;
+ for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
+ nexts = s->next;
+ for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
nexta = a->inchain;
- if (a->type == '$') {
- assert(a->co == 0 || a->co == 1);
- newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
- freearc(nfa, a);
+ if (a->type == '$' || a->type == AHEAD) {
+ if (push(nfa, a)) {
+ progress = 1;
+ }
}
+ assert(nexta == NULL || s->no != FREESTATE);
+ }
+ }
+ if (progress && f != NULL) {
+ dumpnfa(nfa, f);
}
+ } while (progress && !NISERR());
+ if (NISERR()) {
+ return;
+ }
+
+ for (a = nfa->post->ins; a != NULL; a = nexta) {
+ nexta = a->inchain;
+ if (a->type == '$') {
+ assert(a->co == 0 || a->co == 1);
+ newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
+ freearc(nfa, a);
+ }
+ }
}
-
+
/*
- push - push a forward constraint forward past its destination state
* A significant property of this function is that it deletes at most
@@ -900,71 +1141,106 @@ FILE *f; /* for debug output; NULL none */
^ static int push(struct nfa *, struct arc *);
*/
static int /* 0 couldn't, 1 could */
-push(nfa, con)
-struct nfa *nfa;
-struct arc *con;
+push(
+ struct nfa *nfa,
+ struct arc *con)
{
- struct state *from = con->from;
- struct state *to = con->to;
- struct arc *a;
- struct arc *nexta;
- struct state *s;
-
- if (to == from) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
- if (to->flag) /* can't push forward beyond end */
- return 0;
- if (to->nouts == 0) { /* dead end */
- freearc(nfa, con);
- return 1;
+ struct state *from = con->from;
+ struct state *to = con->to;
+ struct arc *a;
+ struct arc *nexta;
+ struct state *s;
+
+ if (to == from) { /* circular constraint is pointless */
+ freearc(nfa, con);
+ return 1;
+ }
+ if (to->flag) { /* can't push forward beyond end */
+ return 0;
+ }
+ if (to->nouts == 0) { /* dead end */
+ freearc(nfa, con);
+ return 1;
+ }
+
+ /*
+ * DGP 2007-11-15: Here we duplicate the same protections as appear
+ * in pull() above to avoid troubles with cloning a state with a
+ * circular constraint on its list of ins. It is not clear whether
+ * this is necessary, or is protecting against a "can't happen".
+ * Any test case that actually leads to a freearc() call here would
+ * be a welcome addition to the test suite.
+ */
+
+ for (a = to->ins; a != NULL; a = nexta) {
+ nexta = a->inchain;
+ switch (a->type) {
+ case '^':
+ case '$':
+ case BEHIND:
+ case AHEAD:
+ if (a->from == to) {
+ freearc(nfa, a);
+ }
+ break;
}
+ }
+ /*
+ * First, clone to state if necessary to avoid other inarcs.
+ */
- /* first, clone to state if necessary to avoid other inarcs */
- if (to->nins > 1) {
- s = newstate(nfa);
- if (NISERR())
- return 0;
- copyouts(nfa, to, s); /* duplicate outarcs */
- cparc(nfa, con, from, s); /* move constraint */
- freearc(nfa, con);
- to = s;
- con = to->ins;
+ if (to->nins > 1) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
}
- assert(to->nins == 1);
-
- /* propagate the constraint into the to state's outarcs */
- for (a = to->outs; a != NULL; a = nexta) {
- nexta = a->outchain;
- switch (combine(con, a)) {
- case INCOMPATIBLE: /* destroy the arc */
- freearc(nfa, a);
- break;
- case SATISFIED: /* no action needed */
- break;
- case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR())
- return 0;
- cparc(nfa, con, s, a->to); /* anticipate move */
- cparc(nfa, a, from, s);
- if (NISERR())
- return 0;
- freearc(nfa, a);
- break;
- default:
- assert(NOTREACHED);
- break;
- }
+ copyouts(nfa, to, s, 1); /* duplicate outarcs */
+ cparc(nfa, con, from, s); /* move constraint */
+ freearc(nfa, con);
+ to = s;
+ con = to->ins;
+ }
+ assert(to->nins == 1);
+
+ /*
+ * Propagate the constraint into the to state's outarcs.
+ */
+
+ for (a = to->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ switch (combine(con, a)) {
+ case INCOMPATIBLE: /* destroy the arc */
+ freearc(nfa, a);
+ break;
+ case SATISFIED: /* no action needed */
+ break;
+ case COMPATIBLE: /* swap the two arcs, more or less */
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ cparc(nfa, con, s, a->to); /* anticipate move */
+ cparc(nfa, a, from, s);
+ if (NISERR()) {
+ return 0;
+ }
+ freearc(nfa, a);
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
}
+ }
- /* remaining outarcs, if any, incorporate the constraint */
- moveouts(nfa, to, from);
- dropstate(nfa, to); /* will free the constraint */
- return 1;
-}
+ /*
+ * Remaining outarcs, if any, incorporate the constraint.
+ */
+ moveouts(nfa, to, from);
+ dropstate(nfa, to); /* will free the constraint */
+ return 1;
+}
+
/*
- combine - constraint lands on an arc, what happens?
^ #def INCOMPATIBLE 1 // destroys arc
@@ -973,396 +1249,559 @@ struct arc *con;
^ static int combine(struct arc *, struct arc *);
*/
static int
-combine(con, a)
-struct arc *con;
-struct arc *a;
+combine(
+ struct arc *con,
+ struct arc *a)
{
-# define CA(ct,at) (((ct)<<CHAR_BIT) | (at))
-
- switch (CA(con->type, a->type)) {
- case CA('^', PLAIN): /* newlines are handled separately */
- case CA('$', PLAIN):
- return INCOMPATIBLE;
- break;
- case CA(AHEAD, PLAIN): /* color constraints meet colors */
- case CA(BEHIND, PLAIN):
- if (con->co == a->co)
- return SATISFIED;
- return INCOMPATIBLE;
- break;
- case CA('^', '^'): /* collision, similar constraints */
- case CA('$', '$'):
- case CA(AHEAD, AHEAD):
- case CA(BEHIND, BEHIND):
- if (con->co == a->co) /* true duplication */
- return SATISFIED;
- return INCOMPATIBLE;
- break;
- case CA('^', BEHIND): /* collision, dissimilar constraints */
- case CA(BEHIND, '^'):
- case CA('$', AHEAD):
- case CA(AHEAD, '$'):
- return INCOMPATIBLE;
- break;
- case CA('^', '$'): /* constraints passing each other */
- case CA('^', AHEAD):
- case CA(BEHIND, '$'):
- case CA(BEHIND, AHEAD):
- case CA('$', '^'):
- case CA('$', BEHIND):
- case CA(AHEAD, '^'):
- case CA(AHEAD, BEHIND):
- case CA('^', LACON):
- case CA(BEHIND, LACON):
- case CA('$', LACON):
- case CA(AHEAD, LACON):
- return COMPATIBLE;
- break;
+#define CA(ct,at) (((ct)<<CHAR_BIT) | (at))
+
+ switch (CA(con->type, a->type)) {
+ case CA('^', PLAIN): /* newlines are handled separately */
+ case CA('$', PLAIN):
+ return INCOMPATIBLE;
+ break;
+ case CA(AHEAD, PLAIN): /* color constraints meet colors */
+ case CA(BEHIND, PLAIN):
+ if (con->co == a->co) {
+ return SATISFIED;
+ }
+ return INCOMPATIBLE;
+ break;
+ case CA('^', '^'): /* collision, similar constraints */
+ case CA('$', '$'):
+ case CA(AHEAD, AHEAD):
+ case CA(BEHIND, BEHIND):
+ if (con->co == a->co) { /* true duplication */
+ return SATISFIED;
}
- assert(NOTREACHED);
- return INCOMPATIBLE; /* for benefit of blind compilers */
+ return INCOMPATIBLE;
+ break;
+ case CA('^', BEHIND): /* collision, dissimilar constraints */
+ case CA(BEHIND, '^'):
+ case CA('$', AHEAD):
+ case CA(AHEAD, '$'):
+ return INCOMPATIBLE;
+ break;
+ case CA('^', '$'): /* constraints passing each other */
+ case CA('^', AHEAD):
+ case CA(BEHIND, '$'):
+ case CA(BEHIND, AHEAD):
+ case CA('$', '^'):
+ case CA('$', BEHIND):
+ case CA(AHEAD, '^'):
+ case CA(AHEAD, BEHIND):
+ case CA('^', LACON):
+ case CA(BEHIND, LACON):
+ case CA('$', LACON):
+ case CA(AHEAD, LACON):
+ return COMPATIBLE;
+ break;
+ }
+ assert(NOTREACHED);
+ return INCOMPATIBLE; /* for benefit of blind compilers */
}
-
+
/*
- fixempties - get rid of EMPTY arcs
- ^ static VOID fixempties(struct nfa *, FILE *);
+ ^ static void fixempties(struct nfa *, FILE *);
*/
-static VOID
-fixempties(nfa, f)
-struct nfa *nfa;
-FILE *f; /* for debug output; NULL none */
+static void
+fixempties(
+ struct nfa *nfa,
+ FILE *f) /* for debug output; NULL none */
{
- struct state *s;
- struct state *nexts;
- struct arc *a;
- struct arc *nexta;
- int progress;
-
- /* find and eliminate empties until there are no more */
- do {
- progress = 0;
- for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
- nexts = s->next;
- for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
- nexta = a->outchain;
- if (a->type == EMPTY && unempty(nfa, a))
- progress = 1;
- assert(nexta == NULL || s->no != FREESTATE);
- }
- }
- if (progress && f != NULL)
- dumpnfa(nfa, f);
- } while (progress && !NISERR());
-}
+ struct state *s;
+ struct state *s2;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+
+ /*
+ * First, get rid of any states whose sole out-arc is an EMPTY,
+ * since they're basically just aliases for their successor. The
+ * parsing algorithm creates enough of these that it's worth
+ * special-casing this.
+ */
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ if (s->flag || s->nouts != 1) {
+ continue;
+ }
+ a = s->outs;
+ assert(a != NULL && a->outchain == NULL);
+ if (a->type != EMPTY) {
+ continue;
+ }
+ if (s != a->to) {
+ moveins(nfa, s, a->to);
+ }
+ dropstate(nfa, s);
+ }
+
+ /*
+ * Similarly, get rid of any state with a single EMPTY in-arc, by
+ * folding it into its predecessor.
+ */
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ /* Ensure tmp fields are clear for next step */
+ assert(s->tmp = NULL);
+ if (s->flag || s->nins != 1) {
+ continue;
+ }
+ a = s->ins;
+ assert(a != NULL && a->inchain == NULL);
+ if (a->type != EMPTY) {
+ continue;
+ }
+ if (s != a->from) {
+ moveouts(nfa, s, a->from);
+ }
+ dropstate(nfa, s);
+ }
+
+ /*
+ * For each remaining NFA state, find all other states that are
+ * reachable from it by a chain of one or more EMPTY arcs. Then
+ * generate new arcs that eliminate the need for each such chain.
+ *
+ * If we just do this straightforwardly, the algorithm gets slow in
+ * complex graphs, because the same arcs get copied to all
+ * intermediate states of an EMPTY chain, and then uselessly pushed
+ * repeatedly to the chain's final state; we waste a lot of time in
+ * newarc's duplicate checking. To improve matters, we decree that
+ * any state with only EMPTY out-arcs is "doomed" and will not be
+ * part of the final NFA. That can be ensured by not adding any new
+ * out-arcs to such a state. Having ensured that, we need not update
+ * the state's in-arcs list either; all arcs that might have gotten
+ * pushed forward to it will just get pushed directly to successor
+ * states. This eliminates most of the useless duplicate arcs.
+ */
+ for (s = nfa->states; s != NULL && !NISERR(); s = s->next) {
+ for (s2 = emptyreachable(s, s); s2 != s && !NISERR();
+ s2 = nexts) {
+ /*
+ * If s2 is doomed, we decide that (1) we will always push
+ * arcs forward to it, not pull them back to s; and (2) we
+ * can optimize away the push-forward, per comment above.
+ * So do nothing.
+ */
+ if (s2->flag || hasnonemptyout(s2)) {
+ replaceempty(nfa, s, s2);
+ }
+
+ /* Reset the tmp fields as we walk back */
+ nexts = s2->tmp;
+ s2->tmp = NULL;
+ }
+ s->tmp = NULL;
+ }
+ if (NISERR()) {
+ return;
+ }
+
+ /*
+ * Remove all the EMPTY arcs, since we don't need them anymore.
+ */
+ for (s = nfa->states; s != NULL; s = s->next) {
+ for (a = s->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ if (a->type == EMPTY) {
+ freearc(nfa, a);
+ }
+ }
+ }
+
+ /*
+ * And remove any states that have become useless. (This cleanup is
+ * not very thorough, and would be even less so if we tried to
+ * combine it with the previous step; but cleanup() will take care
+ * of anything we miss.)
+ */
+ for (s = nfa->states; s != NULL; s = nexts) {
+ nexts = s->next;
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
+ }
+ }
+ if (f != NULL) {
+ dumpnfa(nfa, f);
+ }
+}
+
/*
- - unempty - optimize out an EMPTY arc, if possible
- * Actually, as it stands this function always succeeds, but the return
- * value is kept with an eye on possible future changes.
- ^ static int unempty(struct nfa *, struct arc *);
+ - emptyreachable - recursively find all states reachable from s by EMPTY arcs
+ * The return value is the last such state found. Its tmp field links back
+ * to the next-to-last such state, and so on back to s, so that all these
+ * states can be located without searching the whole NFA.
+ * The maximum recursion depth here is equal to the length of the longest
+ * loop-free chain of EMPTY arcs, which is surely no more than the size of
+ * the NFA, and in practice will be a lot less than that.
+ ^ static struct state *emptyreachable(struct state *, struct state *);
*/
-static int /* 0 couldn't, 1 could */
-unempty(nfa, a)
-struct nfa *nfa;
-struct arc *a;
+static struct state *
+emptyreachable(
+ struct state *s,
+ struct state *lastfound)
{
- struct state *from = a->from;
- struct state *to = a->to;
- int usefrom; /* work on from, as opposed to to? */
-
- assert(a->type == EMPTY);
- assert(from != nfa->pre && to != nfa->post);
+ struct arc *a;
- if (from == to) { /* vacuous loop */
- freearc(nfa, a);
- return 1;
- }
-
- /* decide which end to work on */
- usefrom = 1; /* default: attack from */
- if (from->nouts > to->nins)
- usefrom = 0;
- else if (from->nouts == to->nins) {
- /* decide on secondary issue: move/copy fewest arcs */
- if (from->nins > to->nouts)
- usefrom = 0;
+ s->tmp = lastfound;
+ lastfound = s;
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (a->type == EMPTY && a->to->tmp == NULL) {
+ lastfound = emptyreachable(a->to, lastfound);
}
-
- freearc(nfa, a);
- if (usefrom) {
- if (from->nouts == 0) {
- /* was the state's only outarc */
- moveins(nfa, from, to);
- freestate(nfa, from);
- } else
- copyins(nfa, from, to);
- } else {
- if (to->nins == 0) {
- /* was the state's only inarc */
- moveouts(nfa, to, from);
- freestate(nfa, to);
- } else
- copyouts(nfa, to, from);
- }
-
- return 1;
+ }
+ return lastfound;
}
+
+/*
+ - replaceempty - replace an EMPTY arc chain with some non-empty arcs
+ * The EMPTY arc(s) should be deleted later, but we can't do it here because
+ * they may still be needed to identify other arc chains during fixempties().
+ ^ static void replaceempty(struct nfa *, struct state *, struct state *);
+ */
+static void
+replaceempty(
+ struct nfa *nfa,
+ struct state *from,
+ struct state *to)
+{
+ int fromouts;
+ int toins;
+
+ assert(from != to);
+
+ /*
+ * Create replacement arcs that bypass the need for the EMPTY chain. We
+ * can do this either by pushing arcs forward (linking directly from
+ * "from"'s predecessors to "to") or by pulling them back (linking
+ * directly from "from" to "to"'s successors). In general, we choose
+ * whichever way creates greater fan-out or fan-in, so as to improve the
+ * odds of reducing the other state to zero in-arcs or out-arcs and
+ * thereby being able to delete it. However, if "from" is doomed (has no
+ * non-EMPTY out-arcs), we must keep it so, so always push forward in that
+ * case.
+ *
+ * The fan-out/fan-in comparison should count only non-EMPTY arcs. If
+ * "from" is doomed, we can skip counting "to"'s arcs, since we want to
+ * force taking the copynonemptyins path in that case.
+ */
+ fromouts = nonemptyouts(from);
+ toins = (fromouts == 0) ? 1 : nonemptyins(to);
+
+ if (fromouts > toins) {
+ copyouts(nfa, to, from, 0);
+ return;
+ }
+ if (fromouts < toins) {
+ copyins(nfa, from, to, 0);
+ return;
+ }
+
+ /*
+ * fromouts == toins. Decide on secondary issue: copy fewest arcs.
+ *
+ * Doesn't seem to be worth the trouble to exclude empties from these
+ * comparisons; that takes extra time and doesn't seem to improve the
+ * resulting graph much.
+ */
+ if (from->nins > to->nouts) {
+ copyouts(nfa, to, from, 0);
+ return;
+ }
+ copyins(nfa, from, to, 0);
+}
+
/*
- cleanup - clean up NFA after optimizations
- ^ static VOID cleanup(struct nfa *);
+ ^ static void cleanup(struct nfa *);
*/
-static VOID
-cleanup(nfa)
-struct nfa *nfa;
+static void
+cleanup(
+ struct nfa *nfa)
{
- struct state *s;
- struct state *nexts;
- int n;
-
- /* clear out unreachable or dead-end states */
- /* use pre to mark reachable, then post to mark can-reach-post */
- markreachable(nfa, nfa->pre, (struct state *)NULL, nfa->pre);
- markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
- for (s = nfa->states; s != NULL; s = nexts) {
- nexts = s->next;
- if (s->tmp != nfa->post && !s->flag)
- dropstate(nfa, s);
+ struct state *s;
+ struct state *nexts;
+ int n;
+
+ /*
+ * Clear out unreachable or dead-end states. Use pre to mark reachable,
+ * then post to mark can-reach-post.
+ */
+
+ markreachable(nfa, nfa->pre, NULL, nfa->pre);
+ markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
+ for (s = nfa->states; s != NULL; s = nexts) {
+ nexts = s->next;
+ if (s->tmp != nfa->post && !s->flag) {
+ dropstate(nfa, s);
}
- assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
- cleartraverse(nfa, nfa->pre);
- assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
- /* the nins==0 (final unreachable) case will be caught later */
-
- /* renumber surviving states */
- n = 0;
- for (s = nfa->states; s != NULL; s = s->next)
- s->no = n++;
- nfa->nstates = n;
+ }
+ assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
+ cleartraverse(nfa, nfa->pre);
+ assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
+ /* the nins==0 (final unreachable) case will be caught later */
+
+ /*
+ * Renumber surviving states.
+ */
+
+ n = 0;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ s->no = n++;
+ }
+ nfa->nstates = n;
}
-
+
/*
- markreachable - recursive marking of reachable states
- ^ static VOID markreachable(struct nfa *, struct state *, struct state *,
+ ^ static void markreachable(struct nfa *, struct state *, struct state *,
^ struct state *);
*/
-static VOID
-markreachable(nfa, s, okay, mark)
-struct nfa *nfa;
-struct state *s;
-struct state *okay; /* consider only states with this mark */
-struct state *mark; /* the value to mark with */
+static void
+markreachable(
+ struct nfa *nfa,
+ struct state *s,
+ struct state *okay, /* consider only states with this mark */
+ struct state *mark) /* the value to mark with */
{
- struct arc *a;
+ struct arc *a;
- if (s->tmp != okay)
- return;
- s->tmp = mark;
+ if (s->tmp != okay) {
+ return;
+ }
+ s->tmp = mark;
- for (a = s->outs; a != NULL; a = a->outchain)
- markreachable(nfa, a->to, okay, mark);
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ markreachable(nfa, a->to, okay, mark);
+ }
}
-
+
/*
- markcanreach - recursive marking of states which can reach here
- ^ static VOID markcanreach(struct nfa *, struct state *, struct state *,
+ ^ static void markcanreach(struct nfa *, struct state *, struct state *,
^ struct state *);
*/
-static VOID
-markcanreach(nfa, s, okay, mark)
-struct nfa *nfa;
-struct state *s;
-struct state *okay; /* consider only states with this mark */
-struct state *mark; /* the value to mark with */
+static void
+markcanreach(
+ struct nfa *nfa,
+ struct state *s,
+ struct state *okay, /* consider only states with this mark */
+ struct state *mark) /* the value to mark with */
{
- struct arc *a;
+ struct arc *a;
- if (s->tmp != okay)
- return;
- s->tmp = mark;
+ if (s->tmp != okay) {
+ return;
+ }
+ s->tmp = mark;
- for (a = s->ins; a != NULL; a = a->inchain)
- markcanreach(nfa, a->from, okay, mark);
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ markcanreach(nfa, a->from, okay, mark);
+ }
}
-
+
/*
- analyze - ascertain potentially-useful facts about an optimized NFA
^ static long analyze(struct nfa *);
*/
static long /* re_info bits to be ORed in */
-analyze(nfa)
-struct nfa *nfa;
+analyze(
+ struct nfa *nfa)
{
- struct arc *a;
- struct arc *aa;
-
- if (nfa->pre->outs == NULL)
- return REG_UIMPOSSIBLE;
- for (a = nfa->pre->outs; a != NULL; a = a->outchain)
- for (aa = a->to->outs; aa != NULL; aa = aa->outchain)
- if (aa->to == nfa->post)
- return REG_UEMPTYMATCH;
- return 0;
+ struct arc *a;
+ struct arc *aa;
+
+ if (nfa->pre->outs == NULL) {
+ return REG_UIMPOSSIBLE;
+ }
+ for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
+ for (aa = a->to->outs; aa != NULL; aa = aa->outchain) {
+ if (aa->to == nfa->post) {
+ return REG_UEMPTYMATCH;
+ }
+ }
+ }
+ return 0;
}
-
+
/*
- compact - compact an NFA
- ^ static VOID compact(struct nfa *, struct cnfa *);
+ ^ static void compact(struct nfa *, struct cnfa *);
*/
-static VOID
-compact(nfa, cnfa)
-struct nfa *nfa;
-struct cnfa *cnfa;
+static void
+compact(
+ struct nfa *nfa,
+ struct cnfa *cnfa)
{
- struct state *s;
- struct arc *a;
- size_t nstates;
- size_t narcs;
- struct carc *ca;
- struct carc *first;
-
- assert (!NISERR());
-
- nstates = 0;
- narcs = 0;
- for (s = nfa->states; s != NULL; s = s->next) {
- nstates++;
- narcs += 1 + s->nouts + 1;
- /* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+ struct state *s;
+ struct arc *a;
+ size_t nstates;
+ size_t narcs;
+ struct carc *ca;
+ struct carc *first;
+
+ assert(!NISERR());
+
+ nstates = 0;
+ narcs = 0;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ nstates++;
+ narcs += 1 + s->nouts + 1;
+ /* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+ }
+
+ cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *));
+ cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc));
+ if (cnfa->states == NULL || cnfa->arcs == NULL) {
+ if (cnfa->states != NULL) {
+ FREE(cnfa->states);
}
-
- cnfa->states = (struct carc **)MALLOC(nstates * sizeof(struct carc *));
- cnfa->arcs = (struct carc *)MALLOC(narcs * sizeof(struct carc));
- if (cnfa->states == NULL || cnfa->arcs == NULL) {
- if (cnfa->states != NULL)
- FREE(cnfa->states);
- if (cnfa->arcs != NULL)
- FREE(cnfa->arcs);
- NERR(REG_ESPACE);
- return;
+ if (cnfa->arcs != NULL) {
+ FREE(cnfa->arcs);
}
- cnfa->nstates = nstates;
- cnfa->pre = nfa->pre->no;
- cnfa->post = nfa->post->no;
- cnfa->bos[0] = nfa->bos[0];
- cnfa->bos[1] = nfa->bos[1];
- cnfa->eos[0] = nfa->eos[0];
- cnfa->eos[1] = nfa->eos[1];
- cnfa->ncolors = maxcolor(nfa->cm) + 1;
- cnfa->flags = 0;
-
- ca = cnfa->arcs;
- for (s = nfa->states; s != NULL; s = s->next) {
- assert((size_t)s->no < nstates);
- cnfa->states[s->no] = ca;
- ca->co = 0; /* clear and skip flags "arc" */
+ NERR(REG_ESPACE);
+ return;
+ }
+ cnfa->nstates = nstates;
+ cnfa->pre = nfa->pre->no;
+ cnfa->post = nfa->post->no;
+ cnfa->bos[0] = nfa->bos[0];
+ cnfa->bos[1] = nfa->bos[1];
+ cnfa->eos[0] = nfa->eos[0];
+ cnfa->eos[1] = nfa->eos[1];
+ cnfa->ncolors = maxcolor(nfa->cm) + 1;
+ cnfa->flags = 0;
+
+ ca = cnfa->arcs;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ assert((size_t) s->no < nstates);
+ cnfa->states[s->no] = ca;
+ ca->co = 0; /* clear and skip flags "arc" */
+ ca++;
+ first = ca;
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ switch (a->type) {
+ case PLAIN:
+ ca->co = a->co;
+ ca->to = a->to->no;
ca++;
- first = ca;
- for (a = s->outs; a != NULL; a = a->outchain)
- switch (a->type) {
- case PLAIN:
- ca->co = a->co;
- ca->to = a->to->no;
- ca++;
- break;
- case LACON:
- assert(s->no != cnfa->pre);
- ca->co = (color)(cnfa->ncolors + a->co);
- ca->to = a->to->no;
- ca++;
- cnfa->flags |= HASLACONS;
- break;
- default:
- assert(NOTREACHED);
- break;
- }
- carcsort(first, ca-1);
- ca->co = COLORLESS;
- ca->to = 0;
+ break;
+ case LACON:
+ assert(s->no != cnfa->pre);
+ ca->co = (color) (cnfa->ncolors + a->co);
+ ca->to = a->to->no;
ca++;
+ cnfa->flags |= HASLACONS;
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
}
- assert(ca == &cnfa->arcs[narcs]);
- assert(cnfa->nstates != 0);
-
- /* mark no-progress states */
- for (a = nfa->pre->outs; a != NULL; a = a->outchain)
- cnfa->states[a->to->no]->co = 1;
- cnfa->states[nfa->pre->no]->co = 1;
+ carcsort(first, ca-1);
+ ca->co = COLORLESS;
+ ca->to = 0;
+ ca++;
+ }
+ assert(ca == &cnfa->arcs[narcs]);
+ assert(cnfa->nstates != 0);
+
+ /*
+ * Mark no-progress states.
+ */
+
+ for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
+ cnfa->states[a->to->no]->co = 1;
+ }
+ cnfa->states[nfa->pre->no]->co = 1;
}
-
+
/*
- carcsort - sort compacted-NFA arcs by color
* Really dumb algorithm, but if the list is long enough for that to matter,
* you're in real trouble anyway.
- ^ static VOID carcsort(struct carc *, struct carc *);
+ ^ static void carcsort(struct carc *, struct carc *);
*/
-static VOID
-carcsort(first, last)
-struct carc *first;
-struct carc *last;
+static void
+carcsort(
+ struct carc *first,
+ struct carc *last)
{
- struct carc *p;
- struct carc *q;
- struct carc tmp;
-
- if (last - first <= 1)
- return;
-
- for (p = first; p <= last; p++)
- for (q = p; q <= last; q++)
- if (p->co > q->co ||
- (p->co == q->co && p->to > q->to)) {
- assert(p != q);
- tmp = *p;
- *p = *q;
- *q = tmp;
- }
-}
+ struct carc *p;
+ struct carc *q;
+ struct carc tmp;
+ if (last - first <= 1) {
+ return;
+ }
+
+ for (p = first; p <= last; p++) {
+ for (q = p; q <= last; q++) {
+ if (p->co > q->co || (p->co == q->co && p->to > q->to)) {
+ assert(p != q);
+ tmp = *p;
+ *p = *q;
+ *q = tmp;
+ }
+ }
+ }
+}
+
/*
- freecnfa - free a compacted NFA
- ^ static VOID freecnfa(struct cnfa *);
+ ^ static void freecnfa(struct cnfa *);
*/
-static VOID
-freecnfa(cnfa)
-struct cnfa *cnfa;
+static void
+freecnfa(
+ struct cnfa *cnfa)
{
- assert(cnfa->nstates != 0); /* not empty already */
- cnfa->nstates = 0;
- FREE(cnfa->states);
- FREE(cnfa->arcs);
+ assert(cnfa->nstates != 0); /* not empty already */
+ cnfa->nstates = 0;
+ FREE(cnfa->states);
+ FREE(cnfa->arcs);
}
-
+
/*
- dumpnfa - dump an NFA in human-readable form
- ^ static VOID dumpnfa(struct nfa *, FILE *);
+ ^ static void dumpnfa(struct nfa *, FILE *);
*/
-static VOID
-dumpnfa(nfa, f)
-struct nfa *nfa;
-FILE *f;
+static void
+dumpnfa(
+ struct nfa *nfa,
+ FILE *f)
{
#ifdef REG_DEBUG
- struct state *s;
-
- fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
- if (nfa->bos[0] != COLORLESS)
- fprintf(f, ", bos [%ld]", (long)nfa->bos[0]);
- if (nfa->bos[1] != COLORLESS)
- fprintf(f, ", bol [%ld]", (long)nfa->bos[1]);
- if (nfa->eos[0] != COLORLESS)
- fprintf(f, ", eos [%ld]", (long)nfa->eos[0]);
- if (nfa->eos[1] != COLORLESS)
- fprintf(f, ", eol [%ld]", (long)nfa->eos[1]);
- fprintf(f, "\n");
- for (s = nfa->states; s != NULL; s = s->next)
- dumpstate(s, f);
- if (nfa->parent == NULL)
- dumpcolors(nfa->cm, f);
- fflush(f);
+ struct state *s;
+
+ fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
+ if (nfa->bos[0] != COLORLESS) {
+ fprintf(f, ", bos [%ld]", (long) nfa->bos[0]);
+ }
+ if (nfa->bos[1] != COLORLESS) {
+ fprintf(f, ", bol [%ld]", (long) nfa->bos[1]);
+ }
+ if (nfa->eos[0] != COLORLESS) {
+ fprintf(f, ", eos [%ld]", (long) nfa->eos[0]);
+ }
+ if (nfa->eos[1] != COLORLESS) {
+ fprintf(f, ", eol [%ld]", (long) nfa->eos[1]);
+ }
+ fprintf(f, "\n");
+ for (s = nfa->states; s != NULL; s = s->next) {
+ dumpstate(s, f);
+ }
+ if (nfa->parent == NULL) {
+ dumpcolors(nfa->cm, f);
+ }
+ fflush(f);
#endif
}
-
+
#ifdef REG_DEBUG /* subordinates of dumpnfa */
/*
^ #ifdef REG_DEBUG
@@ -1370,167 +1809,187 @@ FILE *f;
/*
- dumpstate - dump an NFA state in human-readable form
- ^ static VOID dumpstate(struct state *, FILE *);
+ ^ static void dumpstate(struct state *, FILE *);
*/
-static VOID
-dumpstate(s, f)
-struct state *s;
-FILE *f;
+static void
+dumpstate(
+ struct state *s,
+ FILE *f)
{
- struct arc *a;
-
- fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "",
- (s->flag) ? s->flag : '.');
- if (s->prev != NULL && s->prev->next != s)
- fprintf(f, "\tstate chain bad\n");
- if (s->nouts == 0)
- fprintf(f, "\tno out arcs\n");
- else
- dumparcs(s, f);
- fflush(f);
- for (a = s->ins; a != NULL; a = a->inchain) {
- if (a->to != s)
- fprintf(f, "\tlink from %d to %d on %d's in-chain\n",
- a->from->no, a->to->no, s->no);
+ struct arc *a;
+
+ fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "",
+ (s->flag) ? s->flag : '.');
+ if (s->prev != NULL && s->prev->next != s) {
+ fprintf(f, "\tstate chain bad\n");
+ }
+ if (s->nouts == 0) {
+ fprintf(f, "\tno out arcs\n");
+ } else {
+ dumparcs(s, f);
+ }
+ fflush(f);
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ if (a->to != s) {
+ fprintf(f, "\tlink from %d to %d on %d's in-chain\n",
+ a->from->no, a->to->no, s->no);
}
+ }
}
-
+
/*
- dumparcs - dump out-arcs in human-readable form
- ^ static VOID dumparcs(struct state *, FILE *);
+ ^ static void dumparcs(struct state *, FILE *);
*/
-static VOID
-dumparcs(s, f)
-struct state *s;
-FILE *f;
+static void
+dumparcs(
+ struct state *s,
+ FILE *f)
{
- int pos;
+ int pos;
- assert(s->nouts > 0);
- /* printing arcs in reverse order is usually clearer */
- pos = dumprarcs(s->outs, s, f, 1);
- if (pos != 1)
- fprintf(f, "\n");
+ assert(s->nouts > 0);
+ /* printing arcs in reverse order is usually clearer */
+ pos = dumprarcs(s->outs, s, f, 1);
+ if (pos != 1) {
+ fprintf(f, "\n");
+ }
}
-
+
/*
- dumprarcs - dump remaining outarcs, recursively, in reverse order
^ static int dumprarcs(struct arc *, struct state *, FILE *, int);
*/
static int /* resulting print position */
-dumprarcs(a, s, f, pos)
-struct arc *a;
-struct state *s;
-FILE *f;
-int pos; /* initial print position */
+dumprarcs(
+ struct arc *a,
+ struct state *s,
+ FILE *f,
+ int pos) /* initial print position */
{
- if (a->outchain != NULL)
- pos = dumprarcs(a->outchain, s, f, pos);
- dumparc(a, s, f);
- if (pos == 5) {
- fprintf(f, "\n");
- pos = 1;
- } else
- pos++;
- return pos;
+ if (a->outchain != NULL) {
+ pos = dumprarcs(a->outchain, s, f, pos);
+ }
+ dumparc(a, s, f);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else {
+ pos++;
+ }
+ return pos;
}
-
+
/*
- dumparc - dump one outarc in readable form, including prefixing tab
- ^ static VOID dumparc(struct arc *, struct state *, FILE *);
+ ^ static void dumparc(struct arc *, struct state *, FILE *);
*/
-static VOID
-dumparc(a, s, f)
-struct arc *a;
-struct state *s;
-FILE *f;
+static void
+dumparc(
+ struct arc *a,
+ struct state *s,
+ FILE *f)
{
- struct arc *aa;
- struct arcbatch *ab;
-
- fprintf(f, "\t");
- switch (a->type) {
- case PLAIN:
- fprintf(f, "[%ld]", (long)a->co);
- break;
- case AHEAD:
- fprintf(f, ">%ld>", (long)a->co);
- break;
- case BEHIND:
- fprintf(f, "<%ld<", (long)a->co);
- break;
- case LACON:
- fprintf(f, ":%ld:", (long)a->co);
- break;
- case '^':
- case '$':
- fprintf(f, "%c%d", a->type, (int)a->co);
- break;
- case EMPTY:
- break;
- default:
- fprintf(f, "0x%x/0%lo", a->type, (long)a->co);
- break;
+ struct arc *aa;
+ struct arcbatch *ab;
+
+ fprintf(f, "\t");
+ switch (a->type) {
+ case PLAIN:
+ fprintf(f, "[%ld]", (long) a->co);
+ break;
+ case AHEAD:
+ fprintf(f, ">%ld>", (long) a->co);
+ break;
+ case BEHIND:
+ fprintf(f, "<%ld<", (long) a->co);
+ break;
+ case LACON:
+ fprintf(f, ":%ld:", (long) a->co);
+ break;
+ case '^':
+ case '$':
+ fprintf(f, "%c%d", a->type, (int) a->co);
+ break;
+ case EMPTY:
+ break;
+ default:
+ fprintf(f, "0x%x/0%lo", a->type, (long) a->co);
+ break;
+ }
+ if (a->from != s) {
+ fprintf(f, "?%d?", a->from->no);
+ }
+ for (ab = &a->from->oas; ab != NULL; ab = ab->next) {
+ for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++) {
+ if (aa == a) {
+ break; /* NOTE BREAK OUT */
+ }
}
- if (a->from != s)
- fprintf(f, "?%d?", a->from->no);
- for (ab = &a->from->oas; ab != NULL; ab = ab->next) {
- for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++)
- if (aa == a)
- break; /* NOTE BREAK OUT */
- if (aa < &ab->a[ABSIZE]) /* propagate break */
- break; /* NOTE BREAK OUT */
+ if (aa < &ab->a[ABSIZE]) { /* propagate break */
+ break; /* NOTE BREAK OUT */
}
- if (ab == NULL)
- fprintf(f, "?!?"); /* not in allocated space */
- fprintf(f, "->");
- if (a->to == NULL) {
- fprintf(f, "NULL");
- return;
+ }
+ if (ab == NULL) {
+ fprintf(f, "?!?"); /* not in allocated space */
+ }
+ fprintf(f, "->");
+ if (a->to == NULL) {
+ fprintf(f, "NULL");
+ return;
+ }
+ fprintf(f, "%d", a->to->no);
+ for (aa = a->to->ins; aa != NULL; aa = aa->inchain) {
+ if (aa == a) {
+ break; /* NOTE BREAK OUT */
}
- fprintf(f, "%d", a->to->no);
- for (aa = a->to->ins; aa != NULL; aa = aa->inchain)
- if (aa == a)
- break; /* NOTE BREAK OUT */
- if (aa == NULL)
- fprintf(f, "?!?"); /* missing from in-chain */
+ }
+ if (aa == NULL) {
+ fprintf(f, "?!?"); /* missing from in-chain */
+ }
}
/*
^ #endif
*/
#endif /* ifdef REG_DEBUG */
-
+
/*
- dumpcnfa - dump a compacted NFA in human-readable form
- ^ static VOID dumpcnfa(struct cnfa *, FILE *);
+ ^ static void dumpcnfa(struct cnfa *, FILE *);
*/
-static VOID
-dumpcnfa(cnfa, f)
-struct cnfa *cnfa;
-FILE *f;
+static void
+dumpcnfa(
+ struct cnfa *cnfa,
+ FILE *f)
{
#ifdef REG_DEBUG
- int st;
-
- fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
- if (cnfa->bos[0] != COLORLESS)
- fprintf(f, ", bos [%ld]", (long)cnfa->bos[0]);
- if (cnfa->bos[1] != COLORLESS)
- fprintf(f, ", bol [%ld]", (long)cnfa->bos[1]);
- if (cnfa->eos[0] != COLORLESS)
- fprintf(f, ", eos [%ld]", (long)cnfa->eos[0]);
- if (cnfa->eos[1] != COLORLESS)
- fprintf(f, ", eol [%ld]", (long)cnfa->eos[1]);
- if (cnfa->flags&HASLACONS)
- fprintf(f, ", haslacons");
- fprintf(f, "\n");
- for (st = 0; st < cnfa->nstates; st++)
- dumpcstate(st, cnfa->states[st], cnfa, f);
- fflush(f);
+ int st;
+
+ fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
+ if (cnfa->bos[0] != COLORLESS) {
+ fprintf(f, ", bos [%ld]", (long) cnfa->bos[0]);
+ }
+ if (cnfa->bos[1] != COLORLESS) {
+ fprintf(f, ", bol [%ld]", (long) cnfa->bos[1]);
+ }
+ if (cnfa->eos[0] != COLORLESS) {
+ fprintf(f, ", eos [%ld]", (long) cnfa->eos[0]);
+ }
+ if (cnfa->eos[1] != COLORLESS) {
+ fprintf(f, ", eol [%ld]", (long) cnfa->eos[1]);
+ }
+ if (cnfa->flags&HASLACONS) {
+ fprintf(f, ", haslacons");
+ }
+ fprintf(f, "\n");
+ for (st = 0; st < cnfa->nstates; st++) {
+ dumpcstate(st, cnfa->states[st], cnfa, f);
+ }
+ fflush(f);
#endif
}
-
+
#ifdef REG_DEBUG /* subordinates of dumpcnfa */
/*
^ #ifdef REG_DEBUG
@@ -1538,38 +1997,48 @@ FILE *f;
/*
- dumpcstate - dump a compacted-NFA state in human-readable form
- ^ static VOID dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+ ^ static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
*/
-static VOID
-dumpcstate(st, ca, cnfa, f)
-int st;
-struct carc *ca;
-struct cnfa *cnfa;
-FILE *f;
+static void
+dumpcstate(
+ int st,
+ struct carc *ca,
+ struct cnfa *cnfa,
+ FILE *f)
{
- int i;
- int pos;
-
- fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
- pos = 1;
- for (i = 1; ca[i].co != COLORLESS; i++) {
- if (ca[i].co < cnfa->ncolors)
- fprintf(f, "\t[%ld]->%d", (long)ca[i].co, ca[i].to);
- else
- fprintf(f, "\t:%ld:->%d", (long)ca[i].co-cnfa->ncolors,
- ca[i].to);
- if (pos == 5) {
- fprintf(f, "\n");
- pos = 1;
- } else
- pos++;
+ int i;
+ int pos;
+
+ fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+ pos = 1;
+ for (i = 1; ca[i].co != COLORLESS; i++) {
+ if (ca[i].co < cnfa->ncolors) {
+ fprintf(f, "\t[%ld]->%d", (long) ca[i].co, ca[i].to);
+ } else {
+ fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
}
- if (i == 1 || pos != 1)
- fprintf(f, "\n");
- fflush(f);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else {
+ pos++;
+ }
+ }
+ if (i == 1 || pos != 1) {
+ fprintf(f, "\n");
+ }
+ fflush(f);
}
/*
^ #endif
*/
#endif /* ifdef REG_DEBUG */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 29be00f..c93eb24 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -2,24 +2,24 @@
* re_*comp and friends - compile REs
* This file #includes several others (see the bottom).
*
- * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
* HENRY SPENCER 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;
@@ -38,203 +38,193 @@
/* =====^!^===== begin forwards =====^!^===== */
/* automatically gathered by fwd; do not hand-edit */
/* === regcomp.c === */
-int compile _ANSI_ARGS_((regex_t *, CONST chr *, size_t, int));
-static VOID moresubs _ANSI_ARGS_((struct vars *, int));
-static int freev _ANSI_ARGS_((struct vars *, int));
-static VOID makesearch _ANSI_ARGS_((struct vars *, struct nfa *));
-static struct subre *parse _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
-static struct subre *parsebranch _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, int));
-static VOID parseqatom _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, struct subre *));
-static VOID nonword _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
-static VOID word _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
-static int scannum _ANSI_ARGS_((struct vars *));
-static VOID repeat _ANSI_ARGS_((struct vars *, struct state *, struct state *, int, int));
-static VOID bracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static VOID cbracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static VOID brackpart _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static chr *scanplain _ANSI_ARGS_((struct vars *));
-static VOID leaders _ANSI_ARGS_((struct vars *, struct cvec *));
-static VOID onechr _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
-static VOID dovec _ANSI_ARGS_((struct vars *, struct cvec *, struct state *, struct state *));
-static celt nextleader _ANSI_ARGS_((struct vars *, pchr, pchr));
-static VOID wordchrs _ANSI_ARGS_((struct vars *));
-static struct subre *subre _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
-static VOID freesubre _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID freesrnode _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID optst _ANSI_ARGS_((struct vars *, struct subre *));
-static int numst _ANSI_ARGS_((struct subre *, int));
-static VOID markst _ANSI_ARGS_((struct subre *));
-static VOID cleanst _ANSI_ARGS_((struct vars *));
-static long nfatree _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
-static long nfanode _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
-static int newlacon _ANSI_ARGS_((struct vars *, struct state *, struct state *, int));
-static VOID freelacons _ANSI_ARGS_((struct subre *, int));
-static VOID rfree _ANSI_ARGS_((regex_t *));
-static VOID dump _ANSI_ARGS_((regex_t *, FILE *));
-static VOID dumpst _ANSI_ARGS_((struct subre *, FILE *, int));
-static VOID stdump _ANSI_ARGS_((struct subre *, FILE *, int));
-static char *stid _ANSI_ARGS_((struct subre *, char *, size_t));
+int compile(regex_t *, const chr *, size_t, int);
+static void moresubs(struct vars *, int);
+static int freev(struct vars *, int);
+static void makesearch(struct vars *, struct nfa *);
+static struct subre *parse(struct vars *, int, int, struct state *, struct state *);
+static struct subre *parsebranch(struct vars *, int, int, struct state *, struct state *, int);
+static void parseqatom(struct vars *, int, int, struct state *, struct state *, struct subre *);
+static void nonword(struct vars *, int, struct state *, struct state *);
+static void word(struct vars *, int, struct state *, struct state *);
+static int scannum(struct vars *);
+static void repeat(struct vars *, struct state *, struct state *, int, int);
+static void bracket(struct vars *, struct state *, struct state *);
+static void cbracket(struct vars *, struct state *, struct state *);
+static void brackpart(struct vars *, struct state *, struct state *);
+static const chr *scanplain(struct vars *);
+static void onechr(struct vars *, pchr, struct state *, struct state *);
+static void dovec(struct vars *, struct cvec *, struct state *, struct state *);
+static void wordchrs(struct vars *);
+static struct subre *subre(struct vars *, int, int, struct state *, struct state *);
+static void freesubre(struct vars *, struct subre *);
+static void freesrnode(struct vars *, struct subre *);
+static void optst(struct vars *, struct subre *);
+static int numst(struct subre *, int);
+static void markst(struct subre *);
+static void cleanst(struct vars *);
+static long nfatree(struct vars *, struct subre *, FILE *);
+static long nfanode(struct vars *, struct subre *, FILE *);
+static int newlacon(struct vars *, struct state *, struct state *, int);
+static void freelacons(struct subre *, int);
+static void rfree(regex_t *);
+static void dump(regex_t *, FILE *);
+static void dumpst(struct subre *, FILE *, int);
+static void stdump(struct subre *, FILE *, int);
+static const char *stid(struct subre *, char *, size_t);
/* === regc_lex.c === */
-static VOID lexstart _ANSI_ARGS_((struct vars *));
-static VOID prefixes _ANSI_ARGS_((struct vars *));
-static VOID lexnest _ANSI_ARGS_((struct vars *, chr *, chr *));
-static VOID lexword _ANSI_ARGS_((struct vars *));
-static int next _ANSI_ARGS_((struct vars *));
-static int lexescape _ANSI_ARGS_((struct vars *));
-static chr lexdigits _ANSI_ARGS_((struct vars *, int, int, int));
-static int brenext _ANSI_ARGS_((struct vars *, pchr));
-static VOID skip _ANSI_ARGS_((struct vars *));
-static chr newline _ANSI_ARGS_((NOPARMS));
+static void lexstart(struct vars *);
+static void prefixes(struct vars *);
+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 int lexdigits(struct vars *, int, int, int);
+static int brenext(struct vars *, pchr);
+static void skip(struct vars *);
+static chr newline(NOPARMS);
#ifdef REG_DEBUG
-static chr *ch _ANSI_ARGS_((NOPARMS));
+static const chr *ch(NOPARMS);
#endif
-static chr chrnamed _ANSI_ARGS_((struct vars *, chr *, chr *, pchr));
+static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
-static VOID initcm _ANSI_ARGS_((struct vars *, struct colormap *));
-static VOID freecm _ANSI_ARGS_((struct colormap *));
-static VOID cmtreefree _ANSI_ARGS_((struct colormap *, union tree *, int));
-static color setcolor _ANSI_ARGS_((struct colormap *, pchr, pcolor));
-static color maxcolor _ANSI_ARGS_((struct colormap *));
-static color newcolor _ANSI_ARGS_((struct colormap *));
-static VOID freecolor _ANSI_ARGS_((struct colormap *, pcolor));
-static color pseudocolor _ANSI_ARGS_((struct colormap *));
-static color subcolor _ANSI_ARGS_((struct colormap *, pchr c));
-static color newsub _ANSI_ARGS_((struct colormap *, pcolor));
-static VOID subrange _ANSI_ARGS_((struct vars *, pchr, pchr, struct state *, struct state *));
-static VOID subblock _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
-static VOID okcolors _ANSI_ARGS_((struct nfa *, struct colormap *));
-static VOID colorchain _ANSI_ARGS_((struct colormap *, struct arc *));
-static VOID uncolorchain _ANSI_ARGS_((struct colormap *, struct arc *));
-static int singleton _ANSI_ARGS_((struct colormap *, pchr c));
-static VOID rainbow _ANSI_ARGS_((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *));
-static VOID colorcomplement _ANSI_ARGS_((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *));
+static void initcm(struct vars *, struct colormap *);
+static void freecm(struct colormap *);
+static void cmtreefree(struct colormap *, union tree *, int);
+static color setcolor(struct colormap *, pchr, pcolor);
+static color maxcolor(struct colormap *);
+static color newcolor(struct colormap *);
+static void freecolor(struct colormap *, pcolor);
+static color pseudocolor(struct colormap *);
+static color subcolor(struct colormap *, pchr c);
+static color newsub(struct colormap *, pcolor);
+static void subrange(struct vars *, pchr, pchr, struct state *, struct state *);
+static void subblock(struct vars *, pchr, struct state *, struct state *);
+static void okcolors(struct nfa *, struct colormap *);
+static void colorchain(struct colormap *, struct arc *);
+static void uncolorchain(struct colormap *, struct arc *);
+static void rainbow(struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *);
+static void colorcomplement(struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *);
#ifdef REG_DEBUG
-static VOID dumpcolors _ANSI_ARGS_((struct colormap *, FILE *));
-static VOID fillcheck _ANSI_ARGS_((struct colormap *, union tree *, int, FILE *));
-static VOID dumpchr _ANSI_ARGS_((pchr, FILE *));
+static void dumpcolors(struct colormap *, FILE *);
+static void fillcheck(struct colormap *, union tree *, int, FILE *);
+static void dumpchr(pchr, FILE *);
#endif
/* === regc_nfa.c === */
-static struct nfa *newnfa _ANSI_ARGS_((struct vars *, struct colormap *, struct nfa *));
-static VOID freenfa _ANSI_ARGS_((struct nfa *));
-static struct state *newstate _ANSI_ARGS_((struct nfa *));
-static struct state *newfstate _ANSI_ARGS_((struct nfa *, int flag));
-static VOID dropstate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID freestate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID destroystate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID newarc _ANSI_ARGS_((struct nfa *, int, pcolor, struct state *, struct state *));
-static struct arc *allocarc _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID freearc _ANSI_ARGS_((struct nfa *, struct arc *));
-static struct arc *findarc _ANSI_ARGS_((struct state *, int, pcolor));
-static VOID cparc _ANSI_ARGS_((struct nfa *, struct arc *, struct state *, struct state *));
-static VOID moveins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID copyins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID moveouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID copyouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID cloneouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, int));
-static VOID delsub _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID deltraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID dupnfa _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, struct state *));
-static VOID duptraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID cleartraverse _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID specialcolors _ANSI_ARGS_((struct nfa *));
-static long optimize _ANSI_ARGS_((struct nfa *, FILE *));
-static VOID pullback _ANSI_ARGS_((struct nfa *, FILE *));
-static int pull _ANSI_ARGS_((struct nfa *, struct arc *));
-static VOID pushfwd _ANSI_ARGS_((struct nfa *, FILE *));
-static int push _ANSI_ARGS_((struct nfa *, struct arc *));
+static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *);
+static void freenfa(struct nfa *);
+static struct state *newstate(struct nfa *);
+static struct state *newfstate(struct nfa *, int flag);
+static void dropstate(struct nfa *, struct state *);
+static void freestate(struct nfa *, struct state *);
+static void destroystate(struct nfa *, struct state *);
+static void newarc(struct nfa *, int, pcolor, struct state *, struct state *);
+static struct arc *allocarc(struct nfa *, struct state *);
+static void freearc(struct nfa *, struct arc *);
+static int hasnonemptyout(struct state *);
+static int nonemptyouts(struct state *);
+static int nonemptyins(struct state *);
+static struct arc *findarc(struct state *, int, pcolor);
+static void cparc(struct nfa *, struct arc *, struct state *, struct state *);
+static void moveins(struct nfa *, struct state *, struct state *);
+static void copyins(struct nfa *, struct state *, struct state *, int);
+static void moveouts(struct nfa *, struct state *, struct state *);
+static void copyouts(struct nfa *, struct state *, struct state *, int);
+static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int);
+static void delsub(struct nfa *, struct state *, struct state *);
+static void deltraverse(struct nfa *, struct state *, struct state *);
+static void dupnfa(struct nfa *, struct state *, struct state *, struct state *, struct state *);
+static void duptraverse(struct nfa *, struct state *, struct state *, int);
+static void cleartraverse(struct nfa *, struct state *);
+static void specialcolors(struct nfa *);
+static long optimize(struct nfa *, FILE *);
+static void pullback(struct nfa *, FILE *);
+static int pull(struct nfa *, struct arc *);
+static void pushfwd(struct nfa *, FILE *);
+static int push(struct nfa *, struct arc *);
#define INCOMPATIBLE 1 /* destroys arc */
#define SATISFIED 2 /* constraint satisfied */
#define COMPATIBLE 3 /* compatible but not satisfied yet */
-static int combine _ANSI_ARGS_((struct arc *, struct arc *));
-static VOID fixempties _ANSI_ARGS_((struct nfa *, FILE *));
-static int unempty _ANSI_ARGS_((struct nfa *, struct arc *));
-static VOID cleanup _ANSI_ARGS_((struct nfa *));
-static VOID markreachable _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
-static VOID markcanreach _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
-static long analyze _ANSI_ARGS_((struct nfa *));
-static VOID compact _ANSI_ARGS_((struct nfa *, struct cnfa *));
-static VOID carcsort _ANSI_ARGS_((struct carc *, struct carc *));
-static VOID freecnfa _ANSI_ARGS_((struct cnfa *));
-static VOID dumpnfa _ANSI_ARGS_((struct nfa *, FILE *));
+static int combine(struct arc *, struct arc *);
+static void fixempties(struct nfa *, FILE *);
+static struct state *emptyreachable(struct state *, struct state *);
+static void replaceempty(struct nfa *, struct state *, struct state *);
+static void cleanup(struct nfa *);
+static void markreachable(struct nfa *, struct state *, struct state *, struct state *);
+static void markcanreach(struct nfa *, struct state *, struct state *, struct state *);
+static long analyze(struct nfa *);
+static void compact(struct nfa *, struct cnfa *);
+static void carcsort(struct carc *, struct carc *);
+static void freecnfa(struct cnfa *);
+static void dumpnfa(struct nfa *, FILE *);
#ifdef REG_DEBUG
-static VOID dumpstate _ANSI_ARGS_((struct state *, FILE *));
-static VOID dumparcs _ANSI_ARGS_((struct state *, FILE *));
-static int dumprarcs _ANSI_ARGS_((struct arc *, struct state *, FILE *, int));
-static VOID dumparc _ANSI_ARGS_((struct arc *, struct state *, FILE *));
+static void dumpstate(struct state *, FILE *);
+static void dumparcs(struct state *, FILE *);
+static int dumprarcs(struct arc *, struct state *, FILE *, int);
+static void dumparc(struct arc *, struct state *, FILE *);
#endif
-static VOID dumpcnfa _ANSI_ARGS_((struct cnfa *, FILE *));
+static void dumpcnfa(struct cnfa *, FILE *);
#ifdef REG_DEBUG
-static VOID dumpcstate _ANSI_ARGS_((int, struct carc *, struct cnfa *, FILE *));
+static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
#endif
/* === regc_cvec.c === */
-static struct cvec *newcvec _ANSI_ARGS_((int, int, int));
-static struct cvec *clearcvec _ANSI_ARGS_((struct cvec *));
-static VOID addchr _ANSI_ARGS_((struct cvec *, pchr));
-static VOID addrange _ANSI_ARGS_((struct cvec *, pchr, pchr));
-static VOID addmcce _ANSI_ARGS_((struct cvec *, chr *, chr *));
-static int haschr _ANSI_ARGS_((struct cvec *, pchr));
-static struct cvec *getcvec _ANSI_ARGS_((struct vars *, int, int, int));
-static VOID freecvec _ANSI_ARGS_((struct cvec *));
+static struct cvec *clearcvec(struct cvec *);
+static void addchr(struct cvec *, pchr);
+static void addrange(struct cvec *, pchr, pchr);
+static struct cvec *newcvec(int, int);
+static struct cvec *getcvec(struct vars *, int, int);
+static void freecvec(struct cvec *);
/* === regc_locale.c === */
-static int nmcces _ANSI_ARGS_((struct vars *));
-static int nleaders _ANSI_ARGS_((struct vars *));
-static struct cvec *allmcces _ANSI_ARGS_((struct vars *, struct cvec *));
-static celt element _ANSI_ARGS_((struct vars *, chr *, chr *));
-static struct cvec *range _ANSI_ARGS_((struct vars *, celt, celt, int));
-static int before _ANSI_ARGS_((celt, celt));
-static struct cvec *eclass _ANSI_ARGS_((struct vars *, celt, int));
-static struct cvec *cclass _ANSI_ARGS_((struct vars *, chr *, chr *, int));
-static struct cvec *allcases _ANSI_ARGS_((struct vars *, pchr));
-static int cmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
-static int casecmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
+static celt element(struct vars *, const chr *, const chr *);
+static struct cvec *range(struct vars *, celt, celt, int);
+static int before(celt, celt);
+static struct cvec *eclass(struct vars *, celt, int);
+static struct cvec *cclass(struct vars *, const chr *, const chr *, int);
+static struct cvec *allcases(struct vars *, pchr);
+static int cmp(const chr *, const chr *, size_t);
+static int casecmp(const chr *, const chr *, size_t);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */
-
-
-
+
/* internal variables, bundled for easy passing around */
struct vars {
- regex_t *re;
- chr *now; /* scan pointer into string */
- chr *stop; /* end of string */
- chr *savenow; /* saved now and stop for "subroutine call" */
- chr *savestop;
- int err; /* error code (0 if none) */
- int cflags; /* copy of compile flags */
- int lasttype; /* type of previous token */
- int nexttype; /* type of next token */
- chr nextvalue; /* value (if any) of next token */
- int lexcon; /* lexical context type (see lex.c) */
- int nsubexp; /* subexpression count */
- struct subre **subs; /* subRE pointer vector */
- size_t nsubs; /* length of vector */
- struct subre *sub10[10]; /* initial vector, enough for most */
- struct nfa *nfa; /* the NFA */
- struct colormap *cm; /* character color map */
- color nlcolor; /* color of newline */
- struct state *wordchrs; /* state in nfa holding word-char outarcs */
- struct subre *tree; /* subexpression tree */
- struct subre *treechain; /* all tree nodes allocated */
- struct subre *treefree; /* any free tree nodes */
- int ntree; /* number of tree nodes */
- struct cvec *cv; /* interface cvec */
- struct cvec *cv2; /* utility cvec */
- struct cvec *mcces; /* collating-element information */
-# define ISCELEADER(v,c) (v->mcces != NULL && haschr(v->mcces, (c)))
- struct state *mccepbegin; /* in nfa, start of MCCE prototypes */
- struct state *mccepend; /* in nfa, end of MCCE prototypes */
- struct subre *lacons; /* lookahead-constraint vector */
- int nlacons; /* size of lacons */
+ regex_t *re;
+ const chr *now; /* scan pointer into string */
+ const chr *stop; /* end of string */
+ const chr *savenow; /* saved now and stop for "subroutine call" */
+ const chr *savestop;
+ int err; /* error code (0 if none) */
+ int cflags; /* copy of compile flags */
+ int lasttype; /* type of previous token */
+ int nexttype; /* type of next token */
+ chr nextvalue; /* value (if any) of next token */
+ int lexcon; /* lexical context type (see lex.c) */
+ int nsubexp; /* subexpression count */
+ struct subre **subs; /* subRE pointer vector */
+ size_t nsubs; /* length of vector */
+ struct subre *sub10[10]; /* initial vector, enough for most */
+ struct nfa *nfa; /* the NFA */
+ struct colormap *cm; /* character color map */
+ color nlcolor; /* color of newline */
+ struct state *wordchrs; /* state in nfa holding word-char outarcs */
+ struct subre *tree; /* subexpression tree */
+ struct subre *treechain; /* all tree nodes allocated */
+ struct subre *treefree; /* any free tree nodes */
+ int ntree; /* number of tree nodes */
+ struct cvec *cv; /* interface cvec */
+ struct cvec *cv2; /* utility cvec */
+ struct subre *lacons; /* lookahead-constraint vector */
+ int nlacons; /* size of lacons */
};
/* parsing macros; most know that `v' is the struct vars pointer */
#define NEXT() (next(v)) /* advance by one token */
#define SEE(t) (v->nexttype == (t)) /* is next token this? */
#define EAT(t) (SEE(t) && next(v)) /* if next is this, swallow it */
-#define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */
+#define VISERR(vv) ((vv)->err != 0)/* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) ((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err :\
- ((vv)->err = (e)))
+#define VERR(vv,e) \
+ ((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err : ((vv)->err = (e)))
#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return;} /* if error seen, return */
#define NOERRN() {if (ISERR()) return NULL;} /* NOERR with retval */
@@ -264,395 +254,459 @@ struct vars {
#define PREFER 'P' /* length preference */
/* is an arc colored, and hence on a color chain? */
-#define COLORED(a) ((a)->type == PLAIN || (a)->type == AHEAD || \
- (a)->type == BEHIND)
-
-
+#define COLORED(a) \
+ ((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)
/* static function list */
static struct fns functions = {
- rfree, /* regfree insides */
+ rfree, /* regfree insides */
};
-
-
-
+
/*
- compile - compile regular expression
- ^ int compile(regex_t *, CONST chr *, size_t, int);
+ ^ int compile(regex_t *, const chr *, size_t, int);
*/
int
-compile(re, string, len, flags)
-regex_t *re;
-CONST chr *string;
-size_t len;
-int flags;
+compile(
+ regex_t *re,
+ const chr *string,
+ size_t len,
+ int flags)
{
- struct vars var;
- struct vars *v = &var;
- struct guts *g;
- int i;
- size_t j;
- FILE *debug = (flags&REG_PROGRESS) ? stdout : (FILE *)NULL;
-# define CNOERR() { if (ISERR()) return freev(v, v->err); }
-
- /* sanity checks */
-
- if (re == NULL || string == NULL)
- return REG_INVARG;
- if ((flags&REG_QUOTE) &&
- (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)))
- return REG_INVARG;
- if (!(flags&REG_EXTENDED) && (flags&REG_ADVF))
- return REG_INVARG;
-
- /* initial setup (after which freev() is callable) */
- v->re = re;
- v->now = (chr *)string;
- v->stop = v->now + len;
- v->savenow = v->savestop = NULL;
- v->err = 0;
- v->cflags = flags;
- v->nsubexp = 0;
- v->subs = v->sub10;
- v->nsubs = 10;
- for (j = 0; j < v->nsubs; j++)
- v->subs[j] = NULL;
- v->nfa = NULL;
- v->cm = NULL;
- v->nlcolor = COLORLESS;
- v->wordchrs = NULL;
- v->tree = NULL;
- v->treechain = NULL;
- v->treefree = NULL;
- v->cv = NULL;
- v->cv2 = NULL;
- v->mcces = NULL;
- v->lacons = NULL;
- v->nlacons = 0;
- re->re_magic = REMAGIC;
- re->re_info = 0; /* bits get set during parse */
- re->re_csize = sizeof(chr);
- re->re_guts = NULL;
- re->re_fns = VS(&functions);
-
- /* more complex setup, malloced things */
- re->re_guts = VS(MALLOC(sizeof(struct guts)));
- if (re->re_guts == NULL)
- return freev(v, REG_ESPACE);
- g = (struct guts *)re->re_guts;
- g->tree = NULL;
- initcm(v, &g->cmap);
- v->cm = &g->cmap;
- g->lacons = NULL;
- g->nlacons = 0;
- ZAPCNFA(g->search);
- v->nfa = newnfa(v, v->cm, (struct nfa *)NULL);
- CNOERR();
- v->cv = newcvec(100, 20, 10);
- if (v->cv == NULL)
- return freev(v, REG_ESPACE);
- i = nmcces(v);
- if (i > 0) {
- v->mcces = newcvec(nleaders(v), 0, i);
- CNOERR();
- v->mcces = allmcces(v, v->mcces);
- leaders(v, v->mcces);
- addmcce(v->mcces, (chr *)NULL, (chr *)NULL); /* dummy */
- }
- CNOERR();
-
- /* parsing */
- lexstart(v); /* also handles prefixes */
- if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
- /* assign newline a unique color */
- v->nlcolor = subcolor(v->cm, newline());
- okcolors(v->nfa, v->cm);
- }
- CNOERR();
- v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
- assert(SEE(EOS)); /* even if error; ISERR() => SEE(EOS) */
- CNOERR();
- assert(v->tree != NULL);
-
- /* finish setup of nfa and its subre tree */
- specialcolors(v->nfa);
- CNOERR();
- if (debug != NULL) {
- fprintf(debug, "\n\n\n========= RAW ==========\n");
- dumpnfa(v->nfa, debug);
- dumpst(v->tree, debug, 1);
- }
- optst(v, v->tree);
- v->ntree = numst(v->tree, 1);
- markst(v->tree);
- cleanst(v);
- if (debug != NULL) {
- fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
- dumpst(v->tree, debug, 1);
- }
+ AllocVars(v);
+ struct guts *g;
+ int i;
+ size_t j;
+ FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
+#define CNOERR() { if (ISERR()) return freev(v, v->err); }
+
+ /*
+ * Sanity checks.
+ */
+
+ if (re == NULL || string == NULL) {
+ FreeVars(v);
+ return REG_INVARG;
+ }
+ if ((flags&REG_QUOTE) && (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE))) {
+ FreeVars(v);
+ return REG_INVARG;
+ }
+ if (!(flags&REG_EXTENDED) && (flags&REG_ADVF)) {
+ FreeVars(v);
+ return REG_INVARG;
+ }
+
+ /*
+ * Initial setup (after which freev() is callable).
+ */
+
+ v->re = re;
+ v->now = string;
+ v->stop = v->now + len;
+ v->savenow = v->savestop = NULL;
+ v->err = 0;
+ v->cflags = flags;
+ v->nsubexp = 0;
+ v->subs = v->sub10;
+ v->nsubs = 10;
+ for (j = 0; j < v->nsubs; j++) {
+ v->subs[j] = NULL;
+ }
+ v->nfa = NULL;
+ v->cm = NULL;
+ v->nlcolor = COLORLESS;
+ v->wordchrs = NULL;
+ v->tree = NULL;
+ v->treechain = NULL;
+ v->treefree = NULL;
+ v->cv = NULL;
+ v->cv2 = NULL;
+ v->lacons = NULL;
+ v->nlacons = 0;
+ re->re_magic = REMAGIC;
+ re->re_info = 0; /* bits get set during parse */
+ re->re_csize = sizeof(chr);
+ re->re_guts = NULL;
+ re->re_fns = VS(&functions);
+
+ /*
+ * More complex setup, malloced things.
+ */
+
+ re->re_guts = VS(MALLOC(sizeof(struct guts)));
+ if (re->re_guts == NULL) {
+ return freev(v, REG_ESPACE);
+ }
+ g = (struct guts *) re->re_guts;
+ g->tree = NULL;
+ initcm(v, &g->cmap);
+ v->cm = &g->cmap;
+ g->lacons = NULL;
+ g->nlacons = 0;
+ ZAPCNFA(g->search);
+ v->nfa = newnfa(v, v->cm, NULL);
+ CNOERR();
+ v->cv = newcvec(100, 20);
+ if (v->cv == NULL) {
+ return freev(v, REG_ESPACE);
+ }
+
+ /*
+ * Parsing.
+ */
+
+ lexstart(v); /* also handles prefixes */
+ if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
+ /*
+ * Assign newline a unique color.
+ */
- /* build compacted NFAs for tree and lacons */
- re->re_info |= nfatree(v, v->tree, debug);
- CNOERR();
- assert(v->nlacons == 0 || v->lacons != NULL);
- for (i = 1; i < v->nlacons; i++) {
- if (debug != NULL)
- fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
- nfanode(v, &v->lacons[i], debug);
+ v->nlcolor = subcolor(v->cm, newline());
+ okcolors(v->nfa, v->cm);
+ }
+ CNOERR();
+ v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
+ assert(SEE(EOS)); /* even if error; ISERR() => SEE(EOS) */
+ CNOERR();
+ assert(v->tree != NULL);
+
+ /*
+ * Finish setup of nfa and its subre tree.
+ */
+
+ specialcolors(v->nfa);
+ CNOERR();
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= RAW ==========\n");
+ dumpnfa(v->nfa, debug);
+ dumpst(v->tree, debug, 1);
+ }
+ optst(v, v->tree);
+ v->ntree = numst(v->tree, 1);
+ markst(v->tree);
+ cleanst(v);
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
+ dumpst(v->tree, debug, 1);
+ }
+
+ /*
+ * Build compacted NFAs for tree and lacons.
+ */
+
+ re->re_info |= nfatree(v, v->tree, debug);
+ CNOERR();
+ assert(v->nlacons == 0 || v->lacons != NULL);
+ for (i = 1; i < v->nlacons; i++) {
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
}
- CNOERR();
- if (v->tree->flags&SHORTER)
- NOTE(REG_USHORTEST);
-
- /* build compacted NFAs for tree, lacons, fast search */
- if (debug != NULL)
- fprintf(debug, "\n\n\n========= SEARCH ==========\n");
- /* can sacrifice main NFA now, so use it as work area */
- (DISCARD)optimize(v->nfa, debug);
- CNOERR();
- makesearch(v, v->nfa);
- CNOERR();
- compact(v->nfa, &g->search);
- CNOERR();
-
- /* looks okay, package it up */
- re->re_nsub = v->nsubexp;
- v->re = NULL; /* freev no longer frees re */
- g->magic = GUTSMAGIC;
- g->cflags = v->cflags;
- g->info = re->re_info;
- g->nsub = re->re_nsub;
- g->tree = v->tree;
- v->tree = NULL;
- g->ntree = v->ntree;
- g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
- g->lacons = v->lacons;
- v->lacons = NULL;
- g->nlacons = v->nlacons;
-
- if (flags&REG_DUMP)
- dump(re, stdout);
-
- assert(v->err == 0);
- return freev(v, 0);
+ nfanode(v, &v->lacons[i], debug);
+ }
+ CNOERR();
+ if (v->tree->flags&SHORTER) {
+ NOTE(REG_USHORTEST);
+ }
+
+ /*
+ * Build compacted NFAs for tree, lacons, fast search.
+ */
+
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= SEARCH ==========\n");
+ }
+
+ /*
+ * Can sacrifice main NFA now, so use it as work area.
+ */
+
+ (DISCARD) optimize(v->nfa, debug);
+ CNOERR();
+ makesearch(v, v->nfa);
+ CNOERR();
+ compact(v->nfa, &g->search);
+ CNOERR();
+
+ /*
+ * Looks okay, package it up.
+ */
+
+ re->re_nsub = v->nsubexp;
+ v->re = NULL; /* freev no longer frees re */
+ g->magic = GUTSMAGIC;
+ g->cflags = v->cflags;
+ g->info = re->re_info;
+ g->nsub = re->re_nsub;
+ g->tree = v->tree;
+ v->tree = NULL;
+ g->ntree = v->ntree;
+ g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
+ g->lacons = v->lacons;
+ v->lacons = NULL;
+ g->nlacons = v->nlacons;
+
+ if (flags&REG_DUMP) {
+ dump(re, stdout);
+ }
+
+ assert(v->err == 0);
+ return freev(v, 0);
}
-
+
/*
- moresubs - enlarge subRE vector
- ^ static VOID moresubs(struct vars *, int);
+ ^ static void moresubs(struct vars *, int);
*/
-static VOID
-moresubs(v, wanted)
-struct vars *v;
-int wanted; /* want enough room for this one */
+static void
+moresubs(
+ struct vars *v,
+ int wanted) /* want enough room for this one */
{
- struct subre **p;
- size_t n;
-
- assert(wanted > 0 && (size_t)wanted >= v->nsubs);
- n = (size_t)wanted * 3 / 2 + 1;
- if (v->subs == v->sub10) {
- p = (struct subre **)MALLOC(n * sizeof(struct subre *));
- if (p != NULL)
- memcpy(VS(p), VS(v->subs),
- v->nsubs * sizeof(struct subre *));
- } else
- p = (struct subre **)REALLOC(v->subs, n*sizeof(struct subre *));
- if (p == NULL) {
- ERR(REG_ESPACE);
- return;
+ struct subre **p;
+ size_t n;
+
+ assert(wanted > 0 && (size_t)wanted >= v->nsubs);
+ n = (size_t)wanted * 3 / 2 + 1;
+ if (v->subs == v->sub10) {
+ p = (struct subre **) MALLOC(n * sizeof(struct subre *));
+ if (p != NULL) {
+ memcpy(p, v->subs, v->nsubs * sizeof(struct subre *));
}
- v->subs = p;
- for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++)
- *p = NULL;
- assert(v->nsubs == n);
- assert((size_t)wanted < v->nsubs);
+ } else {
+ p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *));
+ }
+ if (p == NULL) {
+ ERR(REG_ESPACE);
+ return;
+ }
+
+ v->subs = p;
+ for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) {
+ *p = NULL;
+ }
+ assert(v->nsubs == n);
+ assert((size_t)wanted < v->nsubs);
}
-
+
/*
- freev - free vars struct's substructures where necessary
- * Optionally does error-number setting, and always returns error code
- * (if any), to make error-handling code terser.
+ * Optionally does error-number setting, and always returns error code (if
+ * any), to make error-handling code terser.
^ static int freev(struct vars *, int);
*/
static int
-freev(v, err)
-struct vars *v;
-int err;
+freev(
+ struct vars *v,
+ int err)
{
- if (v->re != NULL)
- rfree(v->re);
- if (v->subs != v->sub10)
- FREE(v->subs);
- if (v->nfa != NULL)
- freenfa(v->nfa);
- if (v->tree != NULL)
- freesubre(v, v->tree);
- if (v->treechain != NULL)
- cleanst(v);
- if (v->cv != NULL)
- freecvec(v->cv);
- if (v->cv2 != NULL)
- freecvec(v->cv2);
- if (v->mcces != NULL)
- freecvec(v->mcces);
- if (v->lacons != NULL)
- freelacons(v->lacons, v->nlacons);
- ERR(err); /* nop if err==0 */
-
- return v->err;
+ register int ret;
+
+ if (v->re != NULL) {
+ rfree(v->re);
+ }
+ if (v->subs != v->sub10) {
+ FREE(v->subs);
+ }
+ if (v->nfa != NULL) {
+ freenfa(v->nfa);
+ }
+ if (v->tree != NULL) {
+ freesubre(v, v->tree);
+ }
+ if (v->treechain != NULL) {
+ cleanst(v);
+ }
+ if (v->cv != NULL) {
+ freecvec(v->cv);
+ }
+ if (v->cv2 != NULL) {
+ freecvec(v->cv2);
+ }
+ if (v->lacons != NULL) {
+ freelacons(v->lacons, v->nlacons);
+ }
+ ERR(err); /* nop if err==0 */
+
+ ret = v->err;
+ FreeVars(v);
+ return ret;
}
-
+
/*
- makesearch - turn an NFA into a search NFA (implicit prepend of .*?)
* NFA must have been optimize()d already.
- ^ static VOID makesearch(struct vars *, struct nfa *);
+ ^ static void makesearch(struct vars *, struct nfa *);
*/
-static VOID
-makesearch(v, nfa)
-struct vars *v;
-struct nfa *nfa;
+static void
+makesearch(
+ struct vars *v,
+ struct nfa *nfa)
{
- struct arc *a;
- struct arc *b;
- struct state *pre = nfa->pre;
- struct state *s;
- struct state *s2;
- struct state *slist;
-
- /* no loops are needed if it's anchored */
- for (a = pre->outs; a != NULL; a = a->outchain) {
- assert(a->type == PLAIN);
- if (a->co != nfa->bos[0] && a->co != nfa->bos[1])
- break;
+ struct arc *a, *b;
+ struct state *pre = nfa->pre;
+ struct state *s, *s2, *slist;
+
+ /*
+ * No loops are needed if it's anchored.
+ */
+
+ for (a = pre->outs; a != NULL; a = a->outchain) {
+ assert(a->type == PLAIN);
+ if (a->co != nfa->bos[0] && a->co != nfa->bos[1]) {
+ break;
}
- if (a != NULL) {
- /* add implicit .* in front */
- rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
+ }
+ if (a != NULL) {
+ /*
+ * Add implicit .* in front.
+ */
- /* and ^* and \A* too -- not always necessary, but harmless */
- newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
- newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
- }
+ rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
/*
- * Now here's the subtle part. Because many REs have no lookback
- * constraints, often knowing when you were in the pre state tells
- * you little; it's the next state(s) that are informative. But
- * some of them may have other inarcs, i.e. it may be possible to
- * make actual progress and then return to one of them. We must
- * de-optimize such cases, splitting each such state into progress
- * and no-progress states.
+ * And ^* and \A* too -- not always necessary, but harmless.
*/
- /* first, make a list of the states */
- slist = NULL;
- for (a = pre->outs; a != NULL; a = a->outchain) {
- s = a->to;
- for (b = s->ins; b != NULL; b = b->inchain)
- if (b->from != pre)
- break;
- if (b != NULL) { /* must be split */
- if (s->tmp == NULL) { /* if not already in the list */
- /* (fixes bugs 505048, 230589, */
- /* 840258, 504785) */
- s->tmp = slist;
- slist = s;
- }
- }
+ newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
+ newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
+ }
+
+ /*
+ * Now here's the subtle part. Because many REs have no lookback
+ * constraints, often knowing when you were in the pre state tells you
+ * little; it's the next state(s) that are informative. But some of them
+ * may have other inarcs, i.e. it may be possible to make actual progress
+ * and then return to one of them. We must de-optimize such cases,
+ * splitting each such state into progress and no-progress states.
+ */
+
+ /*
+ * First, make a list of the states.
+ */
+
+ slist = NULL;
+ for (a=pre->outs ; a!=NULL ; a=a->outchain) {
+ s = a->to;
+ for (b=s->ins ; b!=NULL ; b=b->inchain) {
+ if (b->from != pre) {
+ break;
+ }
}
+ if (b != NULL && s->tmp == NULL) {
+ /*
+ * Must be split if not already in the list (fixes bugs 505048,
+ * 230589, 840258, 504785).
+ */
+
+ s->tmp = slist;
+ slist = s;
+ }
+ }
+
+ /*
+ * Do the splits.
+ */
+
+ for (s=slist ; s!=NULL ; s=s2) {
+ s2 = newstate(nfa);
- /* do the splits */
- for (s = slist; s != NULL; s = s2) {
- s2 = newstate(nfa);
- copyouts(nfa, s, s2);
- for (a = s->ins; a != NULL; a = b) {
- b = a->inchain;
- if (a->from != pre) {
- cparc(nfa, a, a->from, s2);
- freearc(nfa, a);
- }
- }
- s2 = s->tmp;
- s->tmp = NULL; /* clean up while we're at it */
+ copyouts(nfa, s, s2, 1);
+ for (a=s->ins ; a!=NULL ; a=b) {
+ b = a->inchain;
+
+ if (a->from != pre) {
+ cparc(nfa, a, a->from, s2);
+ freearc(nfa, a);
+ }
}
+ s2 = s->tmp;
+ s->tmp = NULL; /* clean up while we're at it */
+ }
}
-
+
/*
- parse - parse an RE
- * This is actually just the top level, which parses a bunch of branches
- * tied together with '|'. They appear in the tree as the left children
- * of a chain of '|' subres.
+ * This is actually just the top level, which parses a bunch of branches tied
+ * together with '|'. They appear in the tree as the left children of a chain
+ * of '|' subres.
^ static struct subre *parse(struct vars *, int, int, struct state *,
^ struct state *);
*/
static struct subre *
-parse(v, stopper, type, init, final)
-struct vars *v;
-int stopper; /* EOS or ')' */
-int type; /* LACON (lookahead subRE) or PLAIN */
-struct state *init; /* initial state */
-struct state *final; /* final state */
+parse(
+ struct vars *v,
+ int stopper, /* EOS or ')' */
+ int type, /* LACON (lookahead subRE) or PLAIN */
+ struct state *init, /* initial state */
+ struct state *final) /* final state */
{
- struct state *left; /* scaffolding for branch */
- struct state *right;
- struct subre *branches; /* top level */
- struct subre *branch; /* current branch */
- struct subre *t; /* temporary */
- int firstbranch; /* is this the first branch? */
-
- assert(stopper == ')' || stopper == EOS);
-
- branches = subre(v, '|', LONGER, init, final);
- NOERRN();
- branch = branches;
- firstbranch = 1;
- do { /* a branch */
- if (!firstbranch) {
- /* need a place to hang it */
- branch->right = subre(v, '|', LONGER, init, final);
- NOERRN();
- branch = branch->right;
- }
- firstbranch = 0;
- left = newstate(v->nfa);
- right = newstate(v->nfa);
- NOERRN();
- EMPTYARC(init, left);
- EMPTYARC(right, final);
- NOERRN();
- branch->left = parsebranch(v, stopper, type, left, right, 0);
- NOERRN();
- branch->flags |= UP(branch->flags | branch->left->flags);
- if ((branch->flags &~ branches->flags) != 0) /* new flags */
- for (t = branches; t != branch; t = t->right)
- t->flags |= branch->flags;
- } while (EAT('|'));
- assert(SEE(stopper) || SEE(EOS));
-
- if (!SEE(stopper)) {
- assert(stopper == ')' && SEE(EOS));
- ERR(REG_EPAREN);
+ struct state *left, *right; /* scaffolding for branch */
+ struct subre *branches; /* top level */
+ struct subre *branch; /* current branch */
+ struct subre *t; /* temporary */
+ int firstbranch; /* is this the first branch? */
+
+ assert(stopper == ')' || stopper == EOS);
+
+ branches = subre(v, '|', LONGER, init, final);
+ NOERRN();
+ branch = branches;
+ firstbranch = 1;
+ do { /* a branch */
+ if (!firstbranch) {
+ /*
+ * Need a place to hang the branch.
+ */
+
+ branch->right = subre(v, '|', LONGER, init, final);
+ NOERRN();
+ branch = branch->right;
}
-
- /* optimize out simple cases */
- if (branch == branches) { /* only one branch */
- assert(branch->right == NULL);
- t = branch->left;
- branch->left = NULL;
- freesubre(v, branches);
- branches = t;
- } else if (!MESSY(branches->flags)) { /* no interesting innards */
- freesubre(v, branches->left);
- branches->left = NULL;
- freesubre(v, branches->right);
- branches->right = NULL;
- branches->op = '=';
+ firstbranch = 0;
+ left = newstate(v->nfa);
+ right = newstate(v->nfa);
+ NOERRN();
+ EMPTYARC(init, left);
+ EMPTYARC(right, final);
+ NOERRN();
+ branch->left = parsebranch(v, stopper, type, left, right, 0);
+ NOERRN();
+ branch->flags |= UP(branch->flags | branch->left->flags);
+ if ((branch->flags &~ branches->flags) != 0) { /* new flags */
+ for (t = branches; t != branch; t = t->right) {
+ t->flags |= branch->flags;
+ }
}
-
- return branches;
+ } while (EAT('|'));
+ assert(SEE(stopper) || SEE(EOS));
+
+ if (!SEE(stopper)) {
+ assert(stopper == ')' && SEE(EOS));
+ ERR(REG_EPAREN);
+ }
+
+ /*
+ * Optimize out simple cases.
+ */
+
+ if (branch == branches) { /* only one branch */
+ assert(branch->right == NULL);
+ t = branch->left;
+ branch->left = NULL;
+ freesubre(v, branches);
+ branches = t;
+ } else if (!MESSY(branches->flags)) { /* no interesting innards */
+ freesubre(v, branches->left);
+ branches->left = NULL;
+ freesubre(v, branches->right);
+ branches->right = NULL;
+ branches->op = '=';
+ }
+
+ return branches;
}
-
+
/*
- parsebranch - parse one branch of an RE
* This mostly manages concatenation, working closely with parseqatom().
@@ -662,1514 +716,1448 @@ struct state *final; /* final state */
^ struct state *, int);
*/
static struct subre *
-parsebranch(v, stopper, type, left, right, partial)
-struct vars *v;
-int stopper; /* EOS or ')' */
-int type; /* LACON (lookahead subRE) or PLAIN */
-struct state *left; /* leftmost state */
-struct state *right; /* rightmost state */
-int partial; /* is this only part of a branch? */
+parsebranch(
+ struct vars *v,
+ int stopper, /* EOS or ')' */
+ int type, /* LACON (lookahead subRE) or PLAIN */
+ struct state *left, /* leftmost state */
+ struct state *right, /* rightmost state */
+ int partial) /* is this only part of a branch? */
{
- struct state *lp; /* left end of current construct */
- int seencontent; /* is there anything in this branch yet? */
- struct subre *t;
+ struct state *lp; /* left end of current construct */
+ int seencontent; /* is there anything in this branch yet? */
+ struct subre *t;
+
+ lp = left;
+ seencontent = 0;
+ t = subre(v, '=', 0, left, right); /* op '=' is tentative */
+ NOERRN();
+ while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
+ if (seencontent) { /* implicit concat operator */
+ lp = newstate(v->nfa);
+ NOERRN();
+ moveins(v->nfa, right, lp);
+ }
+ seencontent = 1;
- lp = left;
- seencontent = 0;
- t = subre(v, '=', 0, left, right); /* op '=' is tentative */
+ /* NB, recursion in parseqatom() may swallow rest of branch */
+ parseqatom(v, stopper, type, lp, right, t);
NOERRN();
- while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
- if (seencontent) { /* implicit concat operator */
- lp = newstate(v->nfa);
- NOERRN();
- moveins(v->nfa, right, lp);
- }
- seencontent = 1;
-
- /* NB, recursion in parseqatom() may swallow rest of branch */
- parseqatom(v, stopper, type, lp, right, t);
- }
+ }
- if (!seencontent) { /* empty branch */
- if (!partial)
- NOTE(REG_UUNSPEC);
- assert(lp == left);
- EMPTYARC(left, right);
+ if (!seencontent) { /* empty branch */
+ if (!partial) {
+ NOTE(REG_UUNSPEC);
}
+ assert(lp == left);
+ EMPTYARC(left, right);
+ }
- return t;
+ return t;
}
-
+
/*
- parseqatom - parse one quantified atom or constraint of an RE
- * The bookkeeping near the end cooperates very closely with parsebranch();
- * in particular, it contains a recursion that can involve parsing the rest
- * of the branch, making this function's name somewhat inaccurate.
- ^ static VOID parseqatom(struct vars *, int, int, struct state *,
+ * The bookkeeping near the end cooperates very closely with parsebranch(); in
+ * particular, it contains a recursion that can involve parsing the rest of
+ * the branch, making this function's name somewhat inaccurate.
+ ^ static void parseqatom(struct vars *, int, int, struct state *,
^ struct state *, struct subre *);
*/
-static VOID
-parseqatom(v, stopper, type, lp, rp, top)
-struct vars *v;
-int stopper; /* EOS or ')' */
-int type; /* LACON (lookahead subRE) or PLAIN */
-struct state *lp; /* left state to hang it on */
-struct state *rp; /* right state to hang it on */
-struct subre *top; /* subtree top */
+static void
+parseqatom(
+ struct vars *v,
+ int stopper, /* EOS or ')' */
+ int type, /* LACON (lookahead subRE) or PLAIN */
+ struct state *lp, /* left state to hang it on */
+ struct state *rp, /* right state to hang it on */
+ struct subre *top) /* subtree top */
{
- struct state *s; /* temporaries for new states */
- struct state *s2;
-# define ARCV(t, val) newarc(v->nfa, t, val, lp, rp)
- int m, n;
- struct subre *atom; /* atom's subtree */
- struct subre *t;
- int cap; /* capturing parens? */
- int pos; /* positive lookahead? */
- int subno; /* capturing-parens or backref number */
- int atomtype;
- int qprefer; /* quantifier short/long preference */
- int f;
- struct subre **atomp; /* where the pointer to atom is */
-
- /* initial bookkeeping */
- atom = NULL;
- assert(lp->nouts == 0); /* must string new code */
- assert(rp->nins == 0); /* between lp and rp */
- subno = 0; /* just to shut lint up */
-
- /* an atom or constraint... */
- atomtype = v->nexttype;
- switch (atomtype) {
+ struct state *s; /* temporaries for new states */
+ struct state *s2;
+#define ARCV(t, val) newarc(v->nfa, t, val, lp, rp)
+ int m, n;
+ struct subre *atom; /* atom's subtree */
+ struct subre *t;
+ int cap; /* capturing parens? */
+ int pos; /* positive lookahead? */
+ int subno; /* capturing-parens or backref number */
+ int atomtype;
+ int qprefer; /* quantifier short/long preference */
+ int f;
+ struct subre **atomp; /* where the pointer to atom is */
+
+ /*
+ * Initial bookkeeping.
+ */
+
+ atom = NULL;
+ assert(lp->nouts == 0); /* must string new code */
+ assert(rp->nins == 0); /* between lp and rp */
+ subno = 0; /* just to shut lint up */
+
+ /*
+ * An atom or constraint...
+ */
+
+ atomtype = v->nexttype;
+ switch (atomtype) {
/* first, constraints, which end by returning */
- case '^':
- ARCV('^', 1);
- if (v->cflags&REG_NLANCH)
- ARCV(BEHIND, v->nlcolor);
- NEXT();
- return;
- break;
- case '$':
- ARCV('$', 1);
- if (v->cflags&REG_NLANCH)
- ARCV(AHEAD, v->nlcolor);
- NEXT();
- return;
- break;
- case SBEGIN:
- ARCV('^', 1); /* BOL */
- ARCV('^', 0); /* or BOS */
- NEXT();
- return;
- break;
- case SEND:
- ARCV('$', 1); /* EOL */
- ARCV('$', 0); /* or EOS */
- NEXT();
- return;
- break;
- case '<':
- wordchrs(v); /* does NEXT() */
- s = newstate(v->nfa);
- NOERR();
- nonword(v, BEHIND, lp, s);
- word(v, AHEAD, s, rp);
- return;
- break;
- case '>':
- wordchrs(v); /* does NEXT() */
- s = newstate(v->nfa);
- NOERR();
- word(v, BEHIND, lp, s);
- nonword(v, AHEAD, s, rp);
- return;
- break;
- case WBDRY:
- wordchrs(v); /* does NEXT() */
- s = newstate(v->nfa);
- NOERR();
- nonword(v, BEHIND, lp, s);
- word(v, AHEAD, s, rp);
- s = newstate(v->nfa);
- NOERR();
- word(v, BEHIND, lp, s);
- nonword(v, AHEAD, s, rp);
- return;
- break;
- case NWBDRY:
- wordchrs(v); /* does NEXT() */
- s = newstate(v->nfa);
- NOERR();
- word(v, BEHIND, lp, s);
- word(v, AHEAD, s, rp);
- s = newstate(v->nfa);
- NOERR();
- nonword(v, BEHIND, lp, s);
- nonword(v, AHEAD, s, rp);
- return;
- break;
- case LACON: /* lookahead constraint */
- pos = v->nextvalue;
- NEXT();
- s = newstate(v->nfa);
- s2 = newstate(v->nfa);
- NOERR();
- t = parse(v, ')', LACON, s, s2);
- freesubre(v, t); /* internal structure irrelevant */
- assert(SEE(')') || ISERR());
- NEXT();
- n = newlacon(v, s, s2, pos);
- NOERR();
- ARCV(LACON, n);
- return;
- break;
- /* then errors, to get them out of the way */
- case '*':
- case '+':
- case '?':
- case '{':
- ERR(REG_BADRPT);
- return;
- break;
- default:
- ERR(REG_ASSERT);
- return;
- break;
- /* then plain characters, and minor variants on that theme */
- case ')': /* unbalanced paren */
- if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
- ERR(REG_EPAREN);
- return;
- }
- /* legal in EREs due to specification botch */
- NOTE(REG_UPBOTCH);
- /* fallthrough into case PLAIN */
- case PLAIN:
- onechr(v, v->nextvalue, lp, rp);
- okcolors(v->nfa, v->cm);
- NOERR();
- NEXT();
- break;
- case '[':
- if (v->nextvalue == 1)
- bracket(v, lp, rp);
- else
- cbracket(v, lp, rp);
- assert(SEE(']') || ISERR());
- NEXT();
- break;
- case '.':
- rainbow(v->nfa, v->cm, PLAIN,
- (v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS,
- lp, rp);
- NEXT();
- break;
- /* and finally the ugly stuff */
- case '(': /* value flags as capturing or non */
- cap = (type == LACON) ? 0 : v->nextvalue;
- if (cap) {
- v->nsubexp++;
- subno = v->nsubexp;
- if ((size_t)subno >= v->nsubs)
- moresubs(v, subno);
- assert((size_t)subno < v->nsubs);
- } else
- atomtype = PLAIN; /* something that's not '(' */
- NEXT();
- /* need new endpoints because tree will contain pointers */
- s = newstate(v->nfa);
- s2 = newstate(v->nfa);
- NOERR();
- EMPTYARC(lp, s);
- EMPTYARC(s2, rp);
- NOERR();
- atom = parse(v, ')', PLAIN, s, s2);
- assert(SEE(')') || ISERR());
- NEXT();
- NOERR();
- if (cap) {
- v->subs[subno] = atom;
- t = subre(v, '(', atom->flags|CAP, lp, rp);
- NOERR();
- t->subno = subno;
- t->left = atom;
- atom = t;
- }
- /* postpone everything else pending possible {0} */
- break;
- case BACKREF: /* the Feature From The Black Lagoon */
- INSIST(type != LACON, REG_ESUBREG);
- INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
- INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
- NOERR();
- assert(v->nextvalue > 0);
- atom = subre(v, 'b', BACKR, lp, rp);
- subno = v->nextvalue;
- atom->subno = subno;
- EMPTYARC(lp, rp); /* temporarily, so there's something */
- NEXT();
- break;
+ case '^':
+ ARCV('^', 1);
+ if (v->cflags&REG_NLANCH) {
+ ARCV(BEHIND, v->nlcolor);
}
-
- /* ...and an atom may be followed by a quantifier */
- switch (v->nexttype) {
- case '*':
- m = 0;
- n = INFINITY;
- qprefer = (v->nextvalue) ? LONGER : SHORTER;
- NEXT();
- break;
- case '+':
- m = 1;
- n = INFINITY;
- qprefer = (v->nextvalue) ? LONGER : SHORTER;
- NEXT();
- break;
- case '?':
- m = 0;
- n = 1;
- qprefer = (v->nextvalue) ? LONGER : SHORTER;
- NEXT();
- break;
- case '{':
- NEXT();
- m = scannum(v);
- if (EAT(',')) {
- if (SEE(DIGIT))
- n = scannum(v);
- else
- n = INFINITY;
- if (m > n) {
- ERR(REG_BADBR);
- return;
- }
- /* {m,n} exercises preference, even if it's {m,m} */
- qprefer = (v->nextvalue) ? LONGER : SHORTER;
- } else {
- n = m;
- /* {m} passes operand's preference through */
- qprefer = 0;
- }
- if (!SEE('}')) { /* catches errors too */
- ERR(REG_BADBR);
- return;
- }
- NEXT();
- break;
- default: /* no quantifier */
- m = n = 1;
- qprefer = 0;
- break;
+ NEXT();
+ return;
+ case '$':
+ ARCV('$', 1);
+ if (v->cflags&REG_NLANCH) {
+ ARCV(AHEAD, v->nlcolor);
}
+ NEXT();
+ return;
+ case SBEGIN:
+ ARCV('^', 1); /* BOL */
+ ARCV('^', 0); /* or BOS */
+ NEXT();
+ return;
+ case SEND:
+ ARCV('$', 1); /* EOL */
+ ARCV('$', 0); /* or EOS */
+ NEXT();
+ return;
+ case '<':
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ return;
+ case '>':
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ case WBDRY:
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ case NWBDRY:
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ case LACON: /* lookahead constraint */
+ pos = v->nextvalue;
+ NEXT();
+ s = newstate(v->nfa);
+ s2 = newstate(v->nfa);
+ NOERR();
+ t = parse(v, ')', LACON, s, s2);
+ freesubre(v, t); /* internal structure irrelevant */
+ assert(SEE(')') || ISERR());
+ NEXT();
+ n = newlacon(v, s, s2, pos);
+ NOERR();
+ ARCV(LACON, n);
+ return;
- /* annoying special case: {0} or {0,0} cancels everything */
- if (m == 0 && n == 0) {
- if (atom != NULL)
- freesubre(v, atom);
- if (atomtype == '(')
- v->subs[subno] = NULL;
- delsub(v->nfa, lp, rp);
- EMPTYARC(lp, rp);
- return;
+ /*
+ * Then errors, to get them out of the way.
+ */
+
+ case '*':
+ case '+':
+ case '?':
+ case '{':
+ ERR(REG_BADRPT);
+ return;
+ default:
+ ERR(REG_ASSERT);
+ return;
+
+ /*
+ * Then plain characters, and minor variants on that theme.
+ */
+
+ case ')': /* unbalanced paren */
+ if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
+ ERR(REG_EPAREN);
+ return;
}
- /* if not a messy case, avoid hard part */
- assert(!MESSY(top->flags));
- f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
- if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
- if (!(m == 1 && n == 1))
- repeat(v, lp, rp, m, n);
- if (atom != NULL)
- freesubre(v, atom);
- top->flags = f;
- return;
+ /*
+ * Legal in EREs due to specification botch.
+ */
+
+ NOTE(REG_UPBOTCH);
+ /* fallthrough into case PLAIN */
+ case PLAIN:
+ onechr(v, v->nextvalue, lp, rp);
+ okcolors(v->nfa, v->cm);
+ NOERR();
+ NEXT();
+ break;
+ case '[':
+ if (v->nextvalue == 1) {
+ bracket(v, lp, rp);
+ } else {
+ cbracket(v, lp, rp);
}
+ assert(SEE(']') || ISERR());
+ NEXT();
+ break;
+ case '.':
+ rainbow(v->nfa, v->cm, PLAIN,
+ (v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS, lp, rp);
+ NEXT();
+ break;
/*
- * hard part: something messy
- * That is, capturing parens, back reference, short/long clash, or
- * an atom with substructure containing one of those.
+ * And finally the ugly stuff.
*/
- /* now we'll need a subre for the contents even if they're boring */
- if (atom == NULL) {
- atom = subre(v, '=', 0, lp, rp);
- NOERR();
+ case '(': /* value flags as capturing or non */
+ cap = (type == LACON) ? 0 : v->nextvalue;
+ if (cap) {
+ v->nsubexp++;
+ subno = v->nsubexp;
+ if ((size_t)subno >= v->nsubs) {
+ moresubs(v, subno);
+ }
+ assert((size_t)subno < v->nsubs);
+ } else {
+ atomtype = PLAIN; /* something that's not '(' */
}
+ NEXT();
/*
- * prepare a general-purpose state skeleton
- *
- * ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
- * / /
- * [lp] ----> [s2] ----bypass---------------------
- *
- * where bypass is an empty, and prefix is some repetitions of atom
+ * Need new endpoints because tree will contain pointers.
*/
- s = newstate(v->nfa); /* first, new endpoints for the atom */
+
+ s = newstate(v->nfa);
s2 = newstate(v->nfa);
NOERR();
- moveouts(v->nfa, lp, s);
- moveins(v->nfa, rp, s2);
+ EMPTYARC(lp, s);
+ EMPTYARC(s2, rp);
NOERR();
- atom->begin = s;
- atom->end = s2;
- s = newstate(v->nfa); /* and spots for prefix and bypass */
- s2 = newstate(v->nfa);
+ atom = parse(v, ')', PLAIN, s, s2);
+ assert(SEE(')') || ISERR());
+ NEXT();
NOERR();
- EMPTYARC(lp, s);
- EMPTYARC(lp, s2);
+ if (cap) {
+ v->subs[subno] = atom;
+ t = subre(v, '(', atom->flags|CAP, lp, rp);
+ NOERR();
+ t->subno = subno;
+ t->left = atom;
+ atom = t;
+ }
+
+ /*
+ * Postpone everything else pending possible {0}.
+ */
+
+ break;
+ case BACKREF: /* the Feature From The Black Lagoon */
+ INSIST(type != LACON, REG_ESUBREG);
+ INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
+ INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
NOERR();
+ assert(v->nextvalue > 0);
+ atom = subre(v, 'b', BACKR, lp, rp);
+ subno = v->nextvalue;
+ atom->subno = subno;
+ EMPTYARC(lp, rp); /* temporarily, so there's something */
+ NEXT();
+ break;
+ }
+
+ /*
+ * ...and an atom may be followed by a quantifier.
+ */
+
+ switch (v->nexttype) {
+ case '*':
+ m = 0;
+ n = INFINITY;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '+':
+ m = 1;
+ n = INFINITY;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '?':
+ m = 0;
+ n = 1;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '{':
+ NEXT();
+ m = scannum(v);
+ if (EAT(',')) {
+ if (SEE(DIGIT)) {
+ n = scannum(v);
+ } else {
+ n = INFINITY;
+ }
+ if (m > n) {
+ ERR(REG_BADBR);
+ return;
+ }
+
+ /*
+ * {m,n} exercises preference, even if it's {m,m}
+ */
+
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ } else {
+ n = m;
+ /*
+ * {m} passes operand's preference through.
+ */
+
+ qprefer = 0;
+ }
+ if (!SEE('}')) { /* catches errors too */
+ ERR(REG_BADBR);
+ return;
+ }
+ NEXT();
+ break;
+ default: /* no quantifier */
+ m = n = 1;
+ qprefer = 0;
+ break;
+ }
+
+ /*
+ * Annoying special case: {0} or {0,0} cancels everything.
+ */
+
+ if (m == 0 && n == 0) {
+ if (atom != NULL) {
+ freesubre(v, atom);
+ }
+ if (atomtype == '(') {
+ v->subs[subno] = NULL;
+ }
+ delsub(v->nfa, lp, rp);
+ EMPTYARC(lp, rp);
+ return;
+ }
+
+ /*
+ * If not a messy case, avoid hard part.
+ */
+
+ assert(!MESSY(top->flags));
+ f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
+ if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
+ if (!(m == 1 && n == 1)) {
+ repeat(v, lp, rp, m, n);
+ }
+ if (atom != NULL) {
+ freesubre(v, atom);
+ }
+ top->flags = f;
+ return;
+ }
+
+ /*
+ * hard part: something messy
+ * That is, capturing parens, back reference, short/long clash, or an atom
+ * with substructure containing one of those.
+ */
+
+ /*
+ * Now we'll need a subre for the contents even if they're boring.
+ */
+
+ if (atom == NULL) {
+ atom = subre(v, '=', 0, lp, rp);
+ NOERR();
+ }
+
+ /*
+ * Prepare a general-purpose state skeleton.
+ *
+ * ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
+ * / /
+ * [lp] ----> [s2] ----bypass---------------------
+ *
+ * where bypass is an empty, and prefix is some repetitions of atom
+ */
+
+ s = newstate(v->nfa); /* first, new endpoints for the atom */
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s2);
+ NOERR();
+ atom->begin = s;
+ atom->end = s2;
+ s = newstate(v->nfa); /* and spots for prefix and bypass */
+ s2 = newstate(v->nfa);
+ NOERR();
+ EMPTYARC(lp, s);
+ EMPTYARC(lp, s2);
+ NOERR();
+
+ /*
+ * Break remaining subRE into x{...} and what follows.
+ */
+
+ t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+ t->left = atom;
+ atomp = &t->left;
+
+ /*
+ * Here we should recurse... but we must postpone that to the end.
+ */
+
+ /*
+ * Split top into prefix and remaining.
+ */
+
+ assert(top->op == '=' && top->left == NULL && top->right == NULL);
+ top->left = subre(v, '=', top->flags, top->begin, lp);
+ top->op = '.';
+ top->right = t;
+
+ /*
+ * If it's a backref, now is the time to replicate the subNFA.
+ */
+
+ if (atomtype == BACKREF) {
+ assert(atom->begin->nouts == 1); /* just the EMPTY */
+ delsub(v->nfa, atom->begin, atom->end);
+ assert(v->subs[subno] != NULL);
+
+ /*
+ * And here's why the recursion got postponed: it must wait until the
+ * skeleton is filled in, because it may hit a backref that wants to
+ * copy the filled-in skeleton.
+ */
- /* break remaining subRE into x{...} and what follows */
- t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+ dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
+ atom->begin, atom->end);
+ NOERR();
+ }
+
+ /*
+ * It's quantifier time; first, turn x{0,...} into x{1,...}|empty
+ */
+
+ if (m == 0) {
+ EMPTYARC(s2, atom->end);/* the bypass */
+ assert(PREF(qprefer) != 0);
+ f = COMBINE(qprefer, atom->flags);
+ t = subre(v, '|', f, lp, atom->end);
+ NOERR();
t->left = atom;
+ t->right = subre(v, '|', PREF(f), s2, atom->end);
+ NOERR();
+ t->right->left = subre(v, '=', 0, s2, atom->end);
+ NOERR();
+ *atomp = t;
atomp = &t->left;
- /* here we should recurse... but we must postpone that to the end */
-
- /* split top into prefix and remaining */
- assert(top->op == '=' && top->left == NULL && top->right == NULL);
- top->left = subre(v, '=', top->flags, top->begin, lp);
- top->op = '.';
- top->right = t;
-
- /* if it's a backref, now is the time to replicate the subNFA */
- if (atomtype == BACKREF) {
- assert(atom->begin->nouts == 1); /* just the EMPTY */
- delsub(v->nfa, atom->begin, atom->end);
- assert(v->subs[subno] != NULL);
- /* and here's why the recursion got postponed: it must */
- /* wait until the skeleton is filled in, because it may */
- /* hit a backref that wants to copy the filled-in skeleton */
- dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
- atom->begin, atom->end);
- NOERR();
- }
+ m = 1;
+ }
- /* it's quantifier time; first, turn x{0,...} into x{1,...}|empty */
- if (m == 0) {
- EMPTYARC(s2, atom->end); /* the bypass */
- assert(PREF(qprefer) != 0);
- f = COMBINE(qprefer, atom->flags);
- t = subre(v, '|', f, lp, atom->end);
- NOERR();
- t->left = atom;
- t->right = subre(v, '|', PREF(f), s2, atom->end);
- NOERR();
- t->right->left = subre(v, '=', 0, s2, atom->end);
- NOERR();
- *atomp = t;
- atomp = &t->left;
- m = 1;
- }
+ /*
+ * Deal with the rest of the quantifier.
+ */
- /* deal with the rest of the quantifier */
- if (atomtype == BACKREF) {
- /* special case: backrefs have internal quantifiers */
- EMPTYARC(s, atom->begin); /* empty prefix */
- /* just stuff everything into atom */
- repeat(v, atom->begin, atom->end, m, n);
- atom->min = (short)m;
- atom->max = (short)n;
- atom->flags |= COMBINE(qprefer, atom->flags);
- } else if (m == 1 && n == 1) {
- /* no/vacuous quantifier: done */
- EMPTYARC(s, atom->begin); /* empty prefix */
- } else {
- /* turn x{m,n} into x{m-1,n-1}x, with capturing */
- /* parens in only second x */
- dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
- assert(m >= 1 && m != INFINITY && n >= 1);
- repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
- f = COMBINE(qprefer, atom->flags);
- t = subre(v, '.', f, s, atom->end); /* prefix and atom */
- NOERR();
- t->left = subre(v, '=', PREF(f), s, atom->begin);
- NOERR();
- t->right = atom;
- *atomp = t;
- }
+ if (atomtype == BACKREF) {
+ /*
+ * Special case: backrefs have internal quantifiers.
+ */
- /* and finally, look after that postponed recursion */
- t = top->right;
- if (!(SEE('|') || SEE(stopper) || SEE(EOS)))
- t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
- else {
- EMPTYARC(atom->end, rp);
- t->right = subre(v, '=', 0, atom->end, rp);
- }
- assert(SEE('|') || SEE(stopper) || SEE(EOS));
- t->flags |= COMBINE(t->flags, t->right->flags);
- top->flags |= COMBINE(top->flags, t->flags);
-}
+ EMPTYARC(s, atom->begin); /* empty prefix */
+
+ /*
+ * Just stuff everything into atom.
+ */
+
+ repeat(v, atom->begin, atom->end, m, n);
+ atom->min = (short) m;
+ atom->max = (short) n;
+ atom->flags |= COMBINE(qprefer, atom->flags);
+ } else if (m == 1 && n == 1) {
+ /*
+ * No/vacuous quantifier: done.
+ */
+
+ EMPTYARC(s, atom->begin); /* empty prefix */
+ } else {
+ /*
+ * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
+ * x
+ */
+ dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
+ assert(m >= 1 && m != INFINITY && n >= 1);
+ repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
+ f = COMBINE(qprefer, atom->flags);
+ t = subre(v, '.', f, s, atom->end); /* prefix and atom */
+ NOERR();
+ t->left = subre(v, '=', PREF(f), s, atom->begin);
+ NOERR();
+ t->right = atom;
+ *atomp = t;
+ }
+
+ /*
+ * And finally, look after that postponed recursion.
+ */
+
+ t = top->right;
+ if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
+ t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+ } else {
+ EMPTYARC(atom->end, rp);
+ t->right = subre(v, '=', 0, atom->end, rp);
+ }
+ NOERR();
+ assert(SEE('|') || SEE(stopper) || SEE(EOS));
+ t->flags |= COMBINE(t->flags, t->right->flags);
+ top->flags |= COMBINE(top->flags, t->flags);
+}
+
/*
- nonword - generate arcs for non-word-character ahead or behind
- ^ static VOID nonword(struct vars *, int, struct state *, struct state *);
+ ^ static void nonword(struct vars *, int, struct state *, struct state *);
*/
-static VOID
-nonword(v, dir, lp, rp)
-struct vars *v;
-int dir; /* AHEAD or BEHIND */
-struct state *lp;
-struct state *rp;
+static void
+nonword(
+ struct vars *v,
+ int dir, /* AHEAD or BEHIND */
+ struct state *lp,
+ struct state *rp)
{
- int anchor = (dir == AHEAD) ? '$' : '^';
+ int anchor = (dir == AHEAD) ? '$' : '^';
- assert(dir == AHEAD || dir == BEHIND);
- newarc(v->nfa, anchor, 1, lp, rp);
- newarc(v->nfa, anchor, 0, lp, rp);
- colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
- /* (no need for special attention to \n) */
+ assert(dir == AHEAD || dir == BEHIND);
+ newarc(v->nfa, anchor, 1, lp, rp);
+ newarc(v->nfa, anchor, 0, lp, rp);
+ colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
+ /* (no need for special attention to \n) */
}
-
+
/*
- word - generate arcs for word character ahead or behind
- ^ static VOID word(struct vars *, int, struct state *, struct state *);
+ ^ static void word(struct vars *, int, struct state *, struct state *);
*/
-static VOID
-word(v, dir, lp, rp)
-struct vars *v;
-int dir; /* AHEAD or BEHIND */
-struct state *lp;
-struct state *rp;
+static void
+word(
+ struct vars *v,
+ int dir, /* AHEAD or BEHIND */
+ struct state *lp,
+ struct state *rp)
{
- assert(dir == AHEAD || dir == BEHIND);
- cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
- /* (no need for special attention to \n) */
+ assert(dir == AHEAD || dir == BEHIND);
+ cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
+ /* (no need for special attention to \n) */
}
-
+
/*
- scannum - scan a number
^ static int scannum(struct vars *);
*/
static int /* value, <= DUPMAX */
-scannum(v)
-struct vars *v;
+scannum(
+ struct vars *v)
{
- int n = 0;
+ int n = 0;
- while (SEE(DIGIT) && n < DUPMAX) {
- n = n*10 + v->nextvalue;
- NEXT();
- }
- if (SEE(DIGIT) || n > DUPMAX) {
- ERR(REG_BADBR);
- return 0;
- }
- return n;
+ while (SEE(DIGIT) && n < DUPMAX) {
+ n = n*10 + v->nextvalue;
+ NEXT();
+ }
+ if (SEE(DIGIT) || n > DUPMAX) {
+ ERR(REG_BADBR);
+ return 0;
+ }
+ return n;
}
-
+
/*
- repeat - replicate subNFA for quantifiers
* The duplication sequences used here are chosen carefully so that any
* pointers starting out pointing into the subexpression end up pointing into
- * the last occurrence. (Note that it may not be strung between the same
- * left and right end states, however!) This used to be important for the
- * subRE tree, although the important bits are now handled by the in-line
- * code in parse(), and when this is called, it doesn't matter any more.
- ^ static VOID repeat(struct vars *, struct state *, struct state *, int, int);
+ * the last occurrence. (Note that it may not be strung between the same left
+ * and right end states, however!) This used to be important for the subRE
+ * tree, although the important bits are now handled by the in-line code in
+ * parse(), and when this is called, it doesn't matter any more.
+ ^ static void repeat(struct vars *, struct state *, struct state *, int, int);
*/
-static VOID
-repeat(v, lp, rp, m, n)
-struct vars *v;
-struct state *lp;
-struct state *rp;
-int m;
-int n;
+static void
+repeat(
+ struct vars *v,
+ struct state *lp,
+ struct state *rp,
+ int m,
+ int n)
{
-# define SOME 2
-# define INF 3
-# define PAIR(x, y) ((x)*4 + (y))
-# define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
- CONST int rm = REDUCE(m);
- CONST int rn = REDUCE(n);
- struct state *s;
- struct state *s2;
-
- switch (PAIR(rm, rn)) {
- case PAIR(0, 0): /* empty string */
- delsub(v->nfa, lp, rp);
- EMPTYARC(lp, rp);
- break;
- case PAIR(0, 1): /* do as x| */
- EMPTYARC(lp, rp);
- break;
- case PAIR(0, SOME): /* do as x{1,n}| */
- repeat(v, lp, rp, 1, n);
- NOERR();
- EMPTYARC(lp, rp);
- break;
- case PAIR(0, INF): /* loop x around */
- s = newstate(v->nfa);
- NOERR();
- moveouts(v->nfa, lp, s);
- moveins(v->nfa, rp, s);
- EMPTYARC(lp, s);
- EMPTYARC(s, rp);
- break;
- case PAIR(1, 1): /* no action required */
- break;
- case PAIR(1, SOME): /* do as x{0,n-1}x = (x{1,n-1}|)x */
- s = newstate(v->nfa);
- NOERR();
- moveouts(v->nfa, lp, s);
- dupnfa(v->nfa, s, rp, lp, s);
- NOERR();
- repeat(v, lp, s, 1, n-1);
- NOERR();
- EMPTYARC(lp, s);
- break;
- case PAIR(1, INF): /* add loopback arc */
- s = newstate(v->nfa);
- s2 = newstate(v->nfa);
- NOERR();
- moveouts(v->nfa, lp, s);
- moveins(v->nfa, rp, s2);
- EMPTYARC(lp, s);
- EMPTYARC(s2, rp);
- EMPTYARC(s2, s);
- break;
- case PAIR(SOME, SOME): /* do as x{m-1,n-1}x */
- s = newstate(v->nfa);
- NOERR();
- moveouts(v->nfa, lp, s);
- dupnfa(v->nfa, s, rp, lp, s);
- NOERR();
- repeat(v, lp, s, m-1, n-1);
- break;
- case PAIR(SOME, INF): /* do as x{m-1,}x */
- s = newstate(v->nfa);
- NOERR();
- moveouts(v->nfa, lp, s);
- dupnfa(v->nfa, s, rp, lp, s);
- NOERR();
- repeat(v, lp, s, m-1, n);
- break;
- default:
- ERR(REG_ASSERT);
- break;
- }
+#define SOME 2
+#define INF 3
+#define PAIR(x, y) ((x)*4 + (y))
+#define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
+ const int rm = REDUCE(m);
+ const int rn = REDUCE(n);
+ struct state *s, *s2;
+
+ switch (PAIR(rm, rn)) {
+ case PAIR(0, 0): /* empty string */
+ delsub(v->nfa, lp, rp);
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, 1): /* do as x| */
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, SOME): /* do as x{1,n}| */
+ repeat(v, lp, rp, 1, n);
+ NOERR();
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, INF): /* loop x around */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s);
+ EMPTYARC(lp, s);
+ EMPTYARC(s, rp);
+ break;
+ case PAIR(1, 1): /* no action required */
+ break;
+ case PAIR(1, SOME): /* do as x{0,n-1}x = (x{1,n-1}|)x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, 1, n-1);
+ NOERR();
+ EMPTYARC(lp, s);
+ break;
+ case PAIR(1, INF): /* add loopback arc */
+ s = newstate(v->nfa);
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s2);
+ EMPTYARC(lp, s);
+ EMPTYARC(s2, rp);
+ EMPTYARC(s2, s);
+ break;
+ case PAIR(SOME, SOME): /* do as x{m-1,n-1}x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, m-1, n-1);
+ break;
+ case PAIR(SOME, INF): /* do as x{m-1,}x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, m-1, n);
+ break;
+ default:
+ ERR(REG_ASSERT);
+ break;
+ }
}
-
+
/*
- bracket - handle non-complemented bracket expression
* Also called from cbracket for complemented bracket expressions.
- ^ static VOID bracket(struct vars *, struct state *, struct state *);
+ ^ static void bracket(struct vars *, struct state *, struct state *);
*/
-static VOID
-bracket(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+bracket(
+ struct vars *v,
+ struct state *lp,
+ struct state *rp)
{
- assert(SEE('['));
- NEXT();
- while (!SEE(']') && !SEE(EOS))
- brackpart(v, lp, rp);
- assert(SEE(']') || ISERR());
- okcolors(v->nfa, v->cm);
+ assert(SEE('['));
+ NEXT();
+ while (!SEE(']') && !SEE(EOS)) {
+ brackpart(v, lp, rp);
+ }
+ assert(SEE(']') || ISERR());
+ okcolors(v->nfa, v->cm);
}
-
+
/*
- cbracket - handle complemented bracket expression
* We do it by calling bracket() with dummy endpoints, and then complementing
- * the result. The alternative would be to invoke rainbow(), and then delete
+ * the result. The alternative would be to invoke rainbow(), and then delete
* arcs as the b.e. is seen... but that gets messy.
- ^ static VOID cbracket(struct vars *, struct state *, struct state *);
+ ^ static void cbracket(struct vars *, struct state *, struct state *);
*/
-static VOID
-cbracket(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+cbracket(
+ struct vars *v,
+ struct state *lp,
+ struct state *rp)
{
- struct state *left = newstate(v->nfa);
- struct state *right = newstate(v->nfa);
- struct state *s;
- struct arc *a; /* arc from lp */
- struct arc *ba; /* arc from left, from bracket() */
- struct arc *pa; /* MCCE-prototype arc */
- color co;
- chr *p;
- int i;
-
- NOERR();
- bracket(v, left, right);
- if (v->cflags&REG_NLSTOP)
- newarc(v->nfa, PLAIN, v->nlcolor, left, right);
- NOERR();
-
- assert(lp->nouts == 0); /* all outarcs will be ours */
-
- /* easy part of complementing */
- colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
- NOERR();
- if (v->mcces == NULL) { /* no MCCEs -- we're done */
- dropstate(v->nfa, left);
- assert(right->nins == 0);
- freestate(v->nfa, right);
- return;
- }
-
- /* but complementing gets messy in the presence of MCCEs... */
- NOTE(REG_ULOCALE);
- for (p = v->mcces->chrs, i = v->mcces->nchrs; i > 0; p++, i--) {
- co = GETCOLOR(v->cm, *p);
- a = findarc(lp, PLAIN, co);
- ba = findarc(left, PLAIN, co);
- if (ba == NULL) {
- assert(a != NULL);
- freearc(v->nfa, a);
- } else {
- assert(a == NULL);
- }
- s = newstate(v->nfa);
- NOERR();
- newarc(v->nfa, PLAIN, co, lp, s);
- NOERR();
- pa = findarc(v->mccepbegin, PLAIN, co);
- assert(pa != NULL);
- if (ba == NULL) { /* easy case, need all of them */
- cloneouts(v->nfa, pa->to, s, rp, PLAIN);
- newarc(v->nfa, '$', 1, s, rp);
- newarc(v->nfa, '$', 0, s, rp);
- colorcomplement(v->nfa, v->cm, AHEAD, pa->to, s, rp);
- } else { /* must be selective */
- if (findarc(ba->to, '$', 1) == NULL) {
- newarc(v->nfa, '$', 1, s, rp);
- newarc(v->nfa, '$', 0, s, rp);
- colorcomplement(v->nfa, v->cm, AHEAD, pa->to,
- s, rp);
- }
- for (pa = pa->to->outs; pa != NULL; pa = pa->outchain)
- if (findarc(ba->to, PLAIN, pa->co) == NULL)
- newarc(v->nfa, PLAIN, pa->co, s, rp);
- if (s->nouts == 0) /* limit of selectivity: none */
- dropstate(v->nfa, s); /* frees arc too */
- }
- NOERR();
- }
-
- delsub(v->nfa, left, right);
- assert(left->nouts == 0);
- freestate(v->nfa, left);
- assert(right->nins == 0);
- freestate(v->nfa, right);
+ struct state *left = newstate(v->nfa);
+ struct state *right = newstate(v->nfa);
+
+ NOERR();
+ bracket(v, left, right);
+ if (v->cflags&REG_NLSTOP) {
+ newarc(v->nfa, PLAIN, v->nlcolor, left, right);
+ }
+ NOERR();
+
+ assert(lp->nouts == 0); /* all outarcs will be ours */
+
+ /*
+ * Easy part of complementing, and all there is to do since the MCCE code
+ * was removed.
+ */
+
+ colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
+ NOERR();
+ dropstate(v->nfa, left);
+ assert(right->nins == 0);
+ freestate(v->nfa, right);
+ return;
}
-
+
/*
- brackpart - handle one item (or range) within a bracket expression
- ^ static VOID brackpart(struct vars *, struct state *, struct state *);
+ ^ static void brackpart(struct vars *, struct state *, struct state *);
*/
-static VOID
-brackpart(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+brackpart(
+ struct vars *v,
+ struct state *lp,
+ struct state *rp)
{
- celt startc;
- celt endc;
- struct cvec *cv;
- chr *startp;
- chr *endp;
- chr c[1];
-
- /* parse something, get rid of special cases, take shortcuts */
- switch (v->nexttype) {
- case RANGE: /* a-b-c or other botch */
- ERR(REG_ERANGE);
- return;
- break;
- case PLAIN:
- c[0] = v->nextvalue;
- NEXT();
- /* shortcut for ordinary chr (not range, not MCCE leader) */
- if (!SEE(RANGE) && !ISCELEADER(v, c[0])) {
- onechr(v, c[0], lp, rp);
- return;
- }
- startc = element(v, c, c+1);
- NOERR();
- break;
- case COLLEL:
- startp = v->now;
- endp = scanplain(v);
- INSIST(startp < endp, REG_ECOLLATE);
- NOERR();
- startc = element(v, startp, endp);
- NOERR();
- break;
- case ECLASS:
- startp = v->now;
- endp = scanplain(v);
- INSIST(startp < endp, REG_ECOLLATE);
- NOERR();
- startc = element(v, startp, endp);
- NOERR();
- cv = eclass(v, startc, (v->cflags&REG_ICASE));
- NOERR();
- dovec(v, cv, lp, rp);
- return;
- break;
- case CCLASS:
- startp = v->now;
- endp = scanplain(v);
- INSIST(startp < endp, REG_ECTYPE);
- NOERR();
- cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
- NOERR();
- dovec(v, cv, lp, rp);
- return;
- break;
- default:
- ERR(REG_ASSERT);
- return;
- break;
- }
-
- if (SEE(RANGE)) {
- NEXT();
- switch (v->nexttype) {
- case PLAIN:
- case RANGE:
- c[0] = v->nextvalue;
- NEXT();
- endc = element(v, c, c+1);
- NOERR();
- break;
- case COLLEL:
- startp = v->now;
- endp = scanplain(v);
- INSIST(startp < endp, REG_ECOLLATE);
- NOERR();
- endc = element(v, startp, endp);
- NOERR();
- break;
- default:
- ERR(REG_ERANGE);
- return;
- break;
- }
- } else
- endc = startc;
+ celt startc, endc;
+ struct cvec *cv;
+ const chr *startp, *endp;
+ chr c;
+
+ /*
+ * Parse something, get rid of special cases, take shortcuts.
+ */
+
+ switch (v->nexttype) {
+ case RANGE: /* a-b-c or other botch */
+ ERR(REG_ERANGE);
+ return;
+ break;
+ case PLAIN:
+ c = v->nextvalue;
+ NEXT();
/*
- * Ranges are unportable. Actually, standard C does
- * guarantee that digits are contiguous, but making
- * that an exception is just too complicated.
+ * Shortcut for ordinary chr (not range).
*/
- if (startc != endc)
- NOTE(REG_UUNPORT);
- cv = range(v, startc, endc, (v->cflags&REG_ICASE));
+
+ if (!SEE(RANGE)) {
+ onechr(v, c, lp, rp);
+ return;
+ }
+ startc = element(v, &c, &c+1);
+ NOERR();
+ break;
+ case COLLEL:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ startc = element(v, startp, endp);
+ NOERR();
+ break;
+ case ECLASS:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ startc = element(v, startp, endp);
+ NOERR();
+ cv = eclass(v, startc, (v->cflags&REG_ICASE));
+ NOERR();
+ dovec(v, cv, lp, rp);
+ return;
+ break;
+ case CCLASS:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECTYPE);
+ NOERR();
+ cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
NOERR();
dovec(v, cv, lp, rp);
+ return;
+ break;
+ default:
+ ERR(REG_ASSERT);
+ return;
+ break;
+ }
+
+ if (SEE(RANGE)) {
+ NEXT();
+ switch (v->nexttype) {
+ case PLAIN:
+ case RANGE:
+ c = v->nextvalue;
+ NEXT();
+ endc = element(v, &c, &c+1);
+ NOERR();
+ break;
+ case COLLEL:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ endc = element(v, startp, endp);
+ NOERR();
+ break;
+ default:
+ ERR(REG_ERANGE);
+ return;
+ break;
+ }
+ } else {
+ endc = startc;
+ }
+
+ /*
+ * Ranges are unportable. Actually, standard C does guarantee that digits
+ * are contiguous, but making that an exception is just too complicated.
+ */
+
+ if (startc != endc) {
+ NOTE(REG_UUNPORT);
+ }
+ cv = range(v, startc, endc, (v->cflags&REG_ICASE));
+ NOERR();
+ dovec(v, cv, lp, rp);
}
-
+
/*
- scanplain - scan PLAIN contents of [. etc.
- * Certain bits of trickery in lex.c know that this code does not try
- * to look past the final bracket of the [. etc.
- ^ static chr *scanplain(struct vars *);
+ * Certain bits of trickery in lex.c know that this code does not try to look
+ * past the final bracket of the [. etc.
+ ^ static const chr *scanplain(struct vars *);
*/
-static chr * /* just after end of sequence */
-scanplain(v)
-struct vars *v;
+static const chr * /* just after end of sequence */
+scanplain(
+ struct vars *v)
{
- chr *endp;
+ const chr *endp;
- assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
- NEXT();
+ assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
+ NEXT();
+ endp = v->now;
+ while (SEE(PLAIN)) {
endp = v->now;
- while (SEE(PLAIN)) {
- endp = v->now;
- NEXT();
- }
-
- assert(SEE(END) || ISERR());
NEXT();
+ }
- return endp;
-}
-
-/*
- - leaders - process a cvec of collating elements to also include leaders
- * Also gives all characters involved their own colors, which is almost
- * certainly necessary, and sets up little disconnected subNFA.
- ^ static VOID leaders(struct vars *, struct cvec *);
- */
-static VOID
-leaders(v, cv)
-struct vars *v;
-struct cvec *cv;
-{
- int mcce;
- chr *p;
- chr leader;
- struct state *s;
- struct arc *a;
-
- v->mccepbegin = newstate(v->nfa);
- v->mccepend = newstate(v->nfa);
- NOERR();
+ assert(SEE(END) || ISERR());
+ NEXT();
- for (mcce = 0; mcce < cv->nmcces; mcce++) {
- p = cv->mcces[mcce];
- leader = *p;
- if (!haschr(cv, leader)) {
- addchr(cv, leader);
- s = newstate(v->nfa);
- newarc(v->nfa, PLAIN, subcolor(v->cm, leader),
- v->mccepbegin, s);
- okcolors(v->nfa, v->cm);
- } else {
- a = findarc(v->mccepbegin, PLAIN,
- GETCOLOR(v->cm, leader));
- assert(a != NULL);
- s = a->to;
- assert(s != v->mccepend);
- }
- p++;
- assert(*p != 0 && *(p+1) == 0); /* only 2-char MCCEs for now */
- newarc(v->nfa, PLAIN, subcolor(v->cm, *p), s, v->mccepend);
- okcolors(v->nfa, v->cm);
- }
+ return endp;
}
-
+
/*
- onechr - fill in arcs for a plain character, and possible case complements
* This is mostly a shortcut for efficient handling of the common case.
- ^ static VOID onechr(struct vars *, pchr, struct state *, struct state *);
+ ^ static void onechr(struct vars *, pchr, struct state *, struct state *);
*/
-static VOID
-onechr(v, c, lp, rp)
-struct vars *v;
-pchr c;
-struct state *lp;
-struct state *rp;
+static void
+onechr(
+ struct vars *v,
+ pchr c,
+ struct state *lp,
+ struct state *rp)
{
- if (!(v->cflags&REG_ICASE)) {
- newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
- return;
- }
+ if (!(v->cflags&REG_ICASE)) {
+ newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
+ return;
+ }
- /* rats, need general case anyway... */
- dovec(v, allcases(v, c), lp, rp);
-}
+ /*
+ * Rats, need general case anyway...
+ */
+ dovec(v, allcases(v, c), lp, rp);
+}
+
/*
- dovec - fill in arcs for each element of a cvec
- * This one has to handle the messy cases, like MCCEs and MCCE leaders.
- ^ static VOID dovec(struct vars *, struct cvec *, struct state *,
+ ^ static void dovec(struct vars *, struct cvec *, struct state *,
^ struct state *);
*/
-static VOID
-dovec(v, cv, lp, rp)
-struct vars *v;
-struct cvec *cv;
-struct state *lp;
-struct state *rp;
+static void
+dovec(
+ struct vars *v,
+ struct cvec *cv,
+ struct state *lp,
+ struct state *rp)
{
- chr ch, from, to;
- celt ce;
- chr *p;
- int i;
- color co;
- struct cvec *leads;
- struct arc *a;
- struct arc *pa; /* arc in prototype */
- struct state *s;
- struct state *ps; /* state in prototype */
-
- /* need a place to store leaders, if any */
- if (nmcces(v) > 0) {
- assert(v->mcces != NULL);
- if (v->cv2 == NULL || v->cv2->nchrs < v->mcces->nchrs) {
- if (v->cv2 != NULL)
- free(v->cv2);
- v->cv2 = newcvec(v->mcces->nchrs, 0, v->mcces->nmcces);
- NOERR();
- leads = v->cv2;
- } else
- leads = clearcvec(v->cv2);
- } else
- leads = NULL;
-
- /* first, get the ordinary characters out of the way */
- for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
- ch = *p;
- if (!ISCELEADER(v, ch))
- newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
- else {
- assert(singleton(v->cm, ch));
- assert(leads != NULL);
- if (!haschr(leads, ch))
- addchr(leads, ch);
- }
- }
-
- /* and the ranges */
- for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
- from = *p;
- to = *(p+1);
- while (from <= to && (ce = nextleader(v, from, to)) != NOCELT) {
- if (from < ce)
- subrange(v, from, ce - 1, lp, rp);
- assert(singleton(v->cm, ce));
- assert(leads != NULL);
- if (!haschr(leads, ce))
- addchr(leads, ce);
- from = ce + 1;
- }
- if (from <= to)
- subrange(v, from, to, lp, rp);
- }
-
- if ((leads == NULL || leads->nchrs == 0) && cv->nmcces == 0)
- return;
-
- /* deal with the MCCE leaders */
- NOTE(REG_ULOCALE);
- for (p = leads->chrs, i = leads->nchrs; i > 0; p++, i--) {
- co = GETCOLOR(v->cm, *p);
- a = findarc(lp, PLAIN, co);
- if (a != NULL)
- s = a->to;
- else {
- s = newstate(v->nfa);
- NOERR();
- newarc(v->nfa, PLAIN, co, lp, s);
- NOERR();
- }
- pa = findarc(v->mccepbegin, PLAIN, co);
- assert(pa != NULL);
- ps = pa->to;
- newarc(v->nfa, '$', 1, s, rp);
- newarc(v->nfa, '$', 0, s, rp);
- colorcomplement(v->nfa, v->cm, AHEAD, ps, s, rp);
- NOERR();
+ chr ch, from, to;
+ const chr *p;
+ int i;
+
+ for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
+ ch = *p;
+ newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
+ }
+
+ for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
+ from = *p;
+ to = *(p+1);
+ if (from <= to) {
+ subrange(v, from, to, lp, rp);
}
+ }
- /* and the MCCEs */
- for (i = 0; i < cv->nmcces; i++) {
- p = cv->mcces[i];
- assert(singleton(v->cm, *p));
- if (!singleton(v->cm, *p)) {
- ERR(REG_ASSERT);
- return;
- }
- ch = *p++;
- co = GETCOLOR(v->cm, ch);
- a = findarc(lp, PLAIN, co);
- if (a != NULL)
- s = a->to;
- else {
- s = newstate(v->nfa);
- NOERR();
- newarc(v->nfa, PLAIN, co, lp, s);
- NOERR();
- }
- assert(*p != 0); /* at least two chars */
- assert(singleton(v->cm, *p));
- ch = *p++;
- co = GETCOLOR(v->cm, ch);
- assert(*p == 0); /* and only two, for now */
- newarc(v->nfa, PLAIN, co, s, rp);
- NOERR();
- }
-}
-
-/*
- - nextleader - find next MCCE leader within range
- ^ static celt nextleader(struct vars *, pchr, pchr);
- */
-static celt /* NOCELT means none */
-nextleader(v, from, to)
-struct vars *v;
-pchr from;
-pchr to;
-{
- int i;
- chr *p;
- chr ch;
- celt it = NOCELT;
-
- if (v->mcces == NULL)
- return it;
-
- for (i = v->mcces->nchrs, p = v->mcces->chrs; i > 0; i--, p++) {
- ch = *p;
- if (from <= ch && ch <= to)
- if (it == NOCELT || ch < it)
- it = ch;
- }
- return it;
}
-
+
/*
- wordchrs - set up word-chr list for word-boundary stuff, if needed
- * The list is kept as a bunch of arcs between two dummy states; it's
- * disposed of by the unreachable-states sweep in NFA optimization.
- * Does NEXT(). Must not be called from any unusual lexical context.
- * This should be reconciled with the \w etc. handling in lex.c, and
- * should be cleaned up to reduce dependencies on input scanning.
- ^ static VOID wordchrs(struct vars *);
+ * The list is kept as a bunch of arcs between two dummy states; it's disposed
+ * of by the unreachable-states sweep in NFA optimization. Does NEXT(). Must
+ * not be called from any unusual lexical context. This should be reconciled
+ * with the \w etc. handling in lex.c, and should be cleaned up to reduce
+ * dependencies on input scanning.
+ ^ static void wordchrs(struct vars *);
*/
-static VOID
-wordchrs(v)
-struct vars *v;
+static void
+wordchrs(
+ struct vars *v)
{
- struct state *left;
- struct state *right;
-
- if (v->wordchrs != NULL) {
- NEXT(); /* for consistency */
- return;
- }
-
- left = newstate(v->nfa);
- right = newstate(v->nfa);
- NOERR();
- /* fine point: implemented with [::], and lexer will set REG_ULOCALE */
- lexword(v);
- NEXT();
- assert(v->savenow != NULL && SEE('['));
- bracket(v, left, right);
- assert((v->savenow != NULL && SEE(']')) || ISERR());
- NEXT();
- NOERR();
- v->wordchrs = left;
+ struct state *left, *right;
+
+ if (v->wordchrs != NULL) {
+ NEXT(); /* for consistency */
+ return;
+ }
+
+ left = newstate(v->nfa);
+ right = newstate(v->nfa);
+ NOERR();
+
+ /*
+ * Fine point: implemented with [::], and lexer will set REG_ULOCALE.
+ */
+
+ lexword(v);
+ NEXT();
+ assert(v->savenow != NULL && SEE('['));
+ bracket(v, left, right);
+ assert((v->savenow != NULL && SEE(']')) || ISERR());
+ NEXT();
+ NOERR();
+ v->wordchrs = left;
}
-
+
/*
- subre - allocate a subre
^ static struct subre *subre(struct vars *, int, int, struct state *,
^ struct state *);
*/
static struct subre *
-subre(v, op, flags, begin, end)
-struct vars *v;
-int op;
-int flags;
-struct state *begin;
-struct state *end;
+subre(
+ struct vars *v,
+ int op,
+ int flags,
+ struct state *begin,
+ struct state *end)
{
- struct subre *ret;
-
- ret = v->treefree;
- if (ret != NULL)
- v->treefree = ret->left;
- else {
- ret = (struct subre *)MALLOC(sizeof(struct subre));
- if (ret == NULL) {
- ERR(REG_ESPACE);
- return NULL;
- }
- ret->chain = v->treechain;
- v->treechain = ret;
+ struct subre *ret = v->treefree;
+
+ if (ret != NULL) {
+ v->treefree = ret->left;
+ } else {
+ ret = (struct subre *) MALLOC(sizeof(struct subre));
+ if (ret == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
}
-
- assert(strchr("|.b(=", op) != NULL);
-
- ret->op = op;
- ret->flags = flags;
- ret->retry = 0;
- ret->subno = 0;
- ret->min = ret->max = 1;
- ret->left = NULL;
- ret->right = NULL;
- ret->begin = begin;
- ret->end = end;
- ZAPCNFA(ret->cnfa);
-
- return ret;
+ ret->chain = v->treechain;
+ v->treechain = ret;
+ }
+
+ assert(strchr("|.b(=", op) != NULL);
+
+ ret->op = op;
+ ret->flags = flags;
+ ret->retry = 0;
+ ret->subno = 0;
+ ret->min = ret->max = 1;
+ ret->left = NULL;
+ ret->right = NULL;
+ ret->begin = begin;
+ ret->end = end;
+ ZAPCNFA(ret->cnfa);
+
+ return ret;
}
-
+
/*
- freesubre - free a subRE subtree
- ^ static VOID freesubre(struct vars *, struct subre *);
+ ^ static void freesubre(struct vars *, struct subre *);
*/
-static VOID
-freesubre(v, sr)
-struct vars *v; /* might be NULL */
-struct subre *sr;
+static void
+freesubre(
+ struct vars *v, /* might be NULL */
+ struct subre *sr)
{
- if (sr == NULL)
- return;
-
- if (sr->left != NULL)
- freesubre(v, sr->left);
- if (sr->right != NULL)
- freesubre(v, sr->right);
-
- freesrnode(v, sr);
+ if (sr == NULL) {
+ return;
+ }
+
+ if (sr->left != NULL) {
+ freesubre(v, sr->left);
+ }
+ if (sr->right != NULL) {
+ freesubre(v, sr->right);
+ }
+
+ freesrnode(v, sr);
}
-
+
/*
- freesrnode - free one node in a subRE subtree
- ^ static VOID freesrnode(struct vars *, struct subre *);
+ ^ static void freesrnode(struct vars *, struct subre *);
*/
-static VOID
-freesrnode(v, sr)
-struct vars *v; /* might be NULL */
-struct subre *sr;
+static void
+freesrnode(
+ struct vars *v, /* might be NULL */
+ struct subre *sr)
{
- if (sr == NULL)
- return;
-
- if (!NULLCNFA(sr->cnfa))
- freecnfa(&sr->cnfa);
- sr->flags = 0;
-
- if (v != NULL) {
- sr->left = v->treefree;
- v->treefree = sr;
- } else
- FREE(sr);
+ if (sr == NULL) {
+ return;
+ }
+
+ if (!NULLCNFA(sr->cnfa)) {
+ freecnfa(&sr->cnfa);
+ }
+ sr->flags = 0;
+
+ if (v != NULL) {
+ sr->left = v->treefree;
+ v->treefree = sr;
+ } else {
+ FREE(sr);
+ }
}
-
+
/*
- optst - optimize a subRE subtree
- ^ static VOID optst(struct vars *, struct subre *);
+ ^ static void optst(struct vars *, struct subre *);
*/
-static VOID
-optst(v, t)
-struct vars *v;
-struct subre *t;
+static void
+optst(
+ struct vars *v,
+ struct subre *t)
{
- if (t == NULL)
- return;
-
- /* recurse through children */
- if (t->left != NULL)
- optst(v, t->left);
- if (t->right != NULL)
- optst(v, t->right);
+ /*
+ * DGP (2007-11-13): I assume it was the programmer's intent to eventually
+ * come back and add code to optimize subRE trees, but the routine coded
+ * just spends effort traversing the tree and doing nothing. We can do
+ * nothing with less effort.
+ */
+
+ return;
}
-
+
/*
- numst - number tree nodes (assigning retry indexes)
^ static int numst(struct subre *, int);
*/
static int /* next number */
-numst(t, start)
-struct subre *t;
-int start; /* starting point for subtree numbers */
+numst(
+ struct subre *t,
+ int start) /* starting point for subtree numbers */
{
- int i;
-
- assert(t != NULL);
-
- i = start;
- t->retry = (short)i++;
- if (t->left != NULL)
- i = numst(t->left, i);
- if (t->right != NULL)
- i = numst(t->right, i);
- return i;
+ int i;
+
+ assert(t != NULL);
+
+ i = start;
+ t->retry = (short) i++;
+ if (t->left != NULL) {
+ i = numst(t->left, i);
+ }
+ if (t->right != NULL) {
+ i = numst(t->right, i);
+ }
+ return i;
}
-
+
/*
- markst - mark tree nodes as INUSE
- ^ static VOID markst(struct subre *);
+ ^ static void markst(struct subre *);
*/
-static VOID
-markst(t)
-struct subre *t;
+static void
+markst(
+ struct subre *t)
{
- assert(t != NULL);
-
- t->flags |= INUSE;
- if (t->left != NULL)
- markst(t->left);
- if (t->right != NULL)
- markst(t->right);
+ assert(t != NULL);
+
+ t->flags |= INUSE;
+ if (t->left != NULL) {
+ markst(t->left);
+ }
+ if (t->right != NULL) {
+ markst(t->right);
+ }
}
-
+
/*
- cleanst - free any tree nodes not marked INUSE
- ^ static VOID cleanst(struct vars *);
+ ^ static void cleanst(struct vars *);
*/
-static VOID
-cleanst(v)
-struct vars *v;
+static void
+cleanst(
+ struct vars *v)
{
- struct subre *t;
- struct subre *next;
+ struct subre *t;
+ struct subre *next;
- for (t = v->treechain; t != NULL; t = next) {
- next = t->chain;
- if (!(t->flags&INUSE))
- FREE(t);
+ for (t = v->treechain; t != NULL; t = next) {
+ next = t->chain;
+ if (!(t->flags&INUSE)) {
+ FREE(t);
}
- v->treechain = NULL;
- v->treefree = NULL; /* just on general principles */
+ }
+ v->treechain = NULL;
+ v->treefree = NULL; /* just on general principles */
}
-
+
/*
- nfatree - turn a subRE subtree into a tree of compacted NFAs
^ static long nfatree(struct vars *, struct subre *, FILE *);
*/
static long /* optimize results from top node */
-nfatree(v, t, f)
-struct vars *v;
-struct subre *t;
-FILE *f; /* for debug output */
+nfatree(
+ struct vars *v,
+ struct subre *t,
+ FILE *f) /* for debug output */
{
- assert(t != NULL && t->begin != NULL);
+ assert(t != NULL && t->begin != NULL);
- if (t->left != NULL)
- (DISCARD)nfatree(v, t->left, f);
- if (t->right != NULL)
- (DISCARD)nfatree(v, t->right, f);
+ if (t->left != NULL) {
+ (DISCARD) nfatree(v, t->left, f);
+ }
+ if (t->right != NULL) {
+ (DISCARD) nfatree(v, t->right, f);
+ }
- return nfanode(v, t, f);
+ return nfanode(v, t, f);
}
-
+
/*
- nfanode - do one NFA for nfatree
^ static long nfanode(struct vars *, struct subre *, FILE *);
*/
static long /* optimize results */
-nfanode(v, t, f)
-struct vars *v;
-struct subre *t;
-FILE *f; /* for debug output */
+nfanode(
+ struct vars *v,
+ struct subre *t,
+ FILE *f) /* for debug output */
{
- struct nfa *nfa;
- long ret = 0;
- char idbuf[50];
-
- assert(t->begin != NULL);
-
- if (f != NULL)
- fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
- stid(t, idbuf, sizeof(idbuf)));
- nfa = newnfa(v, v->cm, v->nfa);
- NOERRZ();
- dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
- if (!ISERR()) {
- specialcolors(nfa);
- ret = optimize(nfa, f);
- }
- if (!ISERR())
- compact(nfa, &t->cnfa);
-
- freenfa(nfa);
- return ret;
+ struct nfa *nfa;
+ long ret = 0;
+ char idbuf[50];
+
+ assert(t->begin != NULL);
+
+ if (f != NULL) {
+ fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
+ stid(t, idbuf, sizeof(idbuf)));
+ }
+ nfa = newnfa(v, v->cm, v->nfa);
+ NOERRZ();
+ dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
+ if (!ISERR()) {
+ specialcolors(nfa);
+ ret = optimize(nfa, f);
+ }
+ if (!ISERR()) {
+ compact(nfa, &t->cnfa);
+ }
+
+ freenfa(nfa);
+ return ret;
}
-
+
/*
- newlacon - allocate a lookahead-constraint subRE
^ static int newlacon(struct vars *, struct state *, struct state *, int);
*/
static int /* lacon number */
-newlacon(v, begin, end, pos)
-struct vars *v;
-struct state *begin;
-struct state *end;
-int pos;
+newlacon(
+ struct vars *v,
+ struct state *begin,
+ struct state *end,
+ int pos)
{
- int n;
- struct subre *sub;
-
- if (v->nlacons == 0) {
- v->lacons = (struct subre *)MALLOC(2 * sizeof(struct subre));
- n = 1; /* skip 0th */
- v->nlacons = 2;
- } else {
- v->lacons = (struct subre *)REALLOC(v->lacons,
- (v->nlacons+1)*sizeof(struct subre));
- n = v->nlacons++;
- }
- if (v->lacons == NULL) {
- ERR(REG_ESPACE);
- return 0;
- }
- sub = &v->lacons[n];
- sub->begin = begin;
- sub->end = end;
- sub->subno = pos;
- ZAPCNFA(sub->cnfa);
- return n;
+ struct subre *sub;
+ int n;
+
+ if (v->nlacons == 0) {
+ v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
+ n = 1; /* skip 0th */
+ v->nlacons = 2;
+ } else {
+ v->lacons = (struct subre *) REALLOC(v->lacons,
+ (v->nlacons+1)*sizeof(struct subre));
+ n = v->nlacons++;
+ }
+
+ if (v->lacons == NULL) {
+ ERR(REG_ESPACE);
+ return 0;
+ }
+
+ sub = &v->lacons[n];
+ sub->begin = begin;
+ sub->end = end;
+ sub->subno = pos;
+ ZAPCNFA(sub->cnfa);
+ return n;
}
-
+
/*
- freelacons - free lookahead-constraint subRE vector
- ^ static VOID freelacons(struct subre *, int);
+ ^ static void freelacons(struct subre *, int);
*/
-static VOID
-freelacons(subs, n)
-struct subre *subs;
-int n;
+static void
+freelacons(
+ struct subre *subs,
+ int n)
{
- struct subre *sub;
- int i;
-
- assert(n > 0);
- for (sub = subs + 1, i = n - 1; i > 0; sub++, i--) /* no 0th */
- if (!NULLCNFA(sub->cnfa))
- freecnfa(&sub->cnfa);
- FREE(subs);
-}
+ struct subre *sub;
+ int i;
+ assert(n > 0);
+ for (sub=subs+1, i=n-1; i>0; sub++, i--) { /* no 0th */
+ if (!NULLCNFA(sub->cnfa)) {
+ freecnfa(&sub->cnfa);
+ }
+ }
+ FREE(subs);
+}
+
/*
- rfree - free a whole RE (insides of regfree)
- ^ static VOID rfree(regex_t *);
+ ^ static void rfree(regex_t *);
*/
-static VOID
-rfree(re)
-regex_t *re;
+static void
+rfree(
+ regex_t *re)
{
- struct guts *g;
-
- if (re == NULL || re->re_magic != REMAGIC)
- return;
-
- re->re_magic = 0; /* invalidate RE */
- g = (struct guts *)re->re_guts;
- re->re_guts = NULL;
- re->re_fns = NULL;
- g->magic = 0;
- freecm(&g->cmap);
- if (g->tree != NULL)
- freesubre((struct vars *)NULL, g->tree);
- if (g->lacons != NULL)
- freelacons(g->lacons, g->nlacons);
- if (!NULLCNFA(g->search))
- freecnfa(&g->search);
- FREE(g);
+ struct guts *g;
+
+ if (re == NULL || re->re_magic != REMAGIC) {
+ return;
+ }
+
+ re->re_magic = 0; /* invalidate RE */
+ g = (struct guts *) re->re_guts;
+ re->re_guts = NULL;
+ re->re_fns = NULL;
+ g->magic = 0;
+ freecm(&g->cmap);
+ if (g->tree != NULL) {
+ freesubre(NULL, g->tree);
+ }
+ if (g->lacons != NULL) {
+ freelacons(g->lacons, g->nlacons);
+ }
+ if (!NULLCNFA(g->search)) {
+ freecnfa(&g->search);
+ }
+ FREE(g);
}
-
+
/*
- dump - dump an RE in human-readable form
- ^ static VOID dump(regex_t *, FILE *);
+ ^ static void dump(regex_t *, FILE *);
*/
-static VOID
-dump(re, f)
-regex_t *re;
-FILE *f;
+static void
+dump(
+ regex_t *re,
+ FILE *f)
{
#ifdef REG_DEBUG
- struct guts *g;
- int i;
-
- if (re->re_magic != REMAGIC)
- fprintf(f, "bad magic number (0x%x not 0x%x)\n", re->re_magic,
- REMAGIC);
- if (re->re_guts == NULL) {
- fprintf(f, "NULL guts!!!\n");
- return;
- }
- g = (struct guts *)re->re_guts;
- if (g->magic != GUTSMAGIC)
- fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic,
- GUTSMAGIC);
-
- fprintf(f, "\n\n\n========= DUMP ==========\n");
- fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
- re->re_nsub, re->re_info, re->re_csize, g->ntree);
-
- dumpcolors(&g->cmap, f);
- if (!NULLCNFA(g->search)) {
- printf("\nsearch:\n");
- dumpcnfa(&g->search, f);
- }
- for (i = 1; i < g->nlacons; i++) {
- fprintf(f, "\nla%d (%s):\n", i,
- (g->lacons[i].subno) ? "positive" : "negative");
- dumpcnfa(&g->lacons[i].cnfa, f);
- }
- fprintf(f, "\n");
- dumpst(g->tree, f, 0);
+ struct guts *g;
+ int i;
+
+ if (re->re_magic != REMAGIC) {
+ fprintf(f, "bad magic number (0x%x not 0x%x)\n",
+ re->re_magic, REMAGIC);
+ }
+ if (re->re_guts == NULL) {
+ fprintf(f, "NULL guts!!!\n");
+ return;
+ }
+ g = (struct guts *) re->re_guts;
+ if (g->magic != GUTSMAGIC) {
+ fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
+ g->magic, GUTSMAGIC);
+ }
+
+ fprintf(f, "\n\n\n========= DUMP ==========\n");
+ fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
+ re->re_nsub, re->re_info, re->re_csize, g->ntree);
+
+ dumpcolors(&g->cmap, f);
+ if (!NULLCNFA(g->search)) {
+ printf("\nsearch:\n");
+ dumpcnfa(&g->search, f);
+ }
+ for (i = 1; i < g->nlacons; i++) {
+ fprintf(f, "\nla%d (%s):\n", i,
+ (g->lacons[i].subno) ? "positive" : "negative");
+ dumpcnfa(&g->lacons[i].cnfa, f);
+ }
+ fprintf(f, "\n");
+ dumpst(g->tree, f, 0);
#endif
}
-
+
/*
- dumpst - dump a subRE tree
- ^ static VOID dumpst(struct subre *, FILE *, int);
+ ^ static void dumpst(struct subre *, FILE *, int);
*/
-static VOID
-dumpst(t, f, nfapresent)
-struct subre *t;
-FILE *f;
-int nfapresent; /* is the original NFA still around? */
+static void
+dumpst(
+ struct subre *t,
+ FILE *f,
+ int nfapresent) /* is the original NFA still around? */
{
- if (t == NULL)
- fprintf(f, "null tree\n");
- else
- stdump(t, f, nfapresent);
- fflush(f);
+ if (t == NULL) {
+ fprintf(f, "null tree\n");
+ } else {
+ stdump(t, f, nfapresent);
+ }
+ fflush(f);
}
-
+
/*
- stdump - recursive guts of dumpst
- ^ static VOID stdump(struct subre *, FILE *, int);
+ ^ static void stdump(struct subre *, FILE *, int);
*/
-static VOID
-stdump(t, f, nfapresent)
-struct subre *t;
-FILE *f;
-int nfapresent; /* is the original NFA still around? */
+static void
+stdump(
+ struct subre *t,
+ FILE *f,
+ int nfapresent) /* is the original NFA still around? */
{
- char idbuf[50];
-
- fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
- if (t->flags&LONGER)
- fprintf(f, " longest");
- if (t->flags&SHORTER)
- fprintf(f, " shortest");
- if (t->flags&MIXED)
- fprintf(f, " hasmixed");
- if (t->flags&CAP)
- fprintf(f, " hascapture");
- if (t->flags&BACKR)
- fprintf(f, " hasbackref");
- if (!(t->flags&INUSE))
- fprintf(f, " UNUSED");
- if (t->subno != 0)
- fprintf(f, " (#%d)", t->subno);
- if (t->min != 1 || t->max != 1) {
- fprintf(f, " {%d,", t->min);
- if (t->max != INFINITY)
- fprintf(f, "%d", t->max);
- fprintf(f, "}");
+ char idbuf[50];
+
+ fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
+ if (t->flags&LONGER) {
+ fprintf(f, " longest");
+ }
+ if (t->flags&SHORTER) {
+ fprintf(f, " shortest");
+ }
+ if (t->flags&MIXED) {
+ fprintf(f, " hasmixed");
+ }
+ if (t->flags&CAP) {
+ fprintf(f, " hascapture");
+ }
+ if (t->flags&BACKR) {
+ fprintf(f, " hasbackref");
+ }
+ if (!(t->flags&INUSE)) {
+ fprintf(f, " UNUSED");
+ }
+ if (t->subno != 0) {
+ fprintf(f, " (#%d)", t->subno);
+ }
+ if (t->min != 1 || t->max != 1) {
+ fprintf(f, " {%d,", t->min);
+ if (t->max != INFINITY) {
+ fprintf(f, "%d", t->max);
}
- if (nfapresent)
- fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
- if (t->left != NULL)
- fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
- if (t->right != NULL)
- fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
- if (!NULLCNFA(t->cnfa)) {
- fprintf(f, "\n");
- dumpcnfa(&t->cnfa, f);
- fprintf(f, "\n");
- }
- if (t->left != NULL)
- stdump(t->left, f, nfapresent);
- if (t->right != NULL)
- stdump(t->right, f, nfapresent);
+ fprintf(f, "}");
+ }
+ if (nfapresent) {
+ fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
+ }
+ if (t->left != NULL) {
+ fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
+ }
+ if (t->right != NULL) {
+ fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
+ }
+ if (!NULLCNFA(t->cnfa)) {
+ fprintf(f, "\n");
+ dumpcnfa(&t->cnfa, f);
+ }
+ fprintf(f, "\n");
+ if (t->left != NULL) {
+ stdump(t->left, f, nfapresent);
+ }
+ if (t->right != NULL) {
+ stdump(t->right, f, nfapresent);
+ }
}
-
+
/*
- 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 char * /* points to buf or constant string */
-stid(t, buf, bufsize)
-struct subre *t;
-char *buf;
-size_t bufsize;
+static const char * /* points to buf or constant string */
+stid(
+ struct subre *t,
+ char *buf,
+ size_t bufsize)
{
- /* big enough for hex int or decimal t->retry? */
- if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1)
- return "unable";
- if (t->retry != 0)
- sprintf(buf, "%d", t->retry);
- else
- sprintf(buf, "%p", t);
- return buf;
+ /*
+ * Big enough for hex int or decimal t->retry?
+ */
+
+ if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
+ return "unable";
+ }
+ if (t->retry != 0) {
+ sprintf(buf, "%d", t->retry);
+ } else {
+ sprintf(buf, "%p", t);
+ }
+ return buf;
}
#include "regc_lex.c"
@@ -2177,3 +2165,11 @@ size_t bufsize;
#include "regc_nfa.c"
#include "regc_cvec.c"
#include "regc_locale.c"
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regcustom.h b/generic/regcustom.h
index e258acd..1c970ea 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -1,22 +1,22 @@
/*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
- * Redistribution and use in source and binary forms -- with or without
- * modification -- are permitted for any purpose, provided that
- * redistributions in source form retain this entire copyright notice and
- * indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms - with or without
+ * modification - are permitted for any purpose, provided that redistributions
+ * in source form retain this entire copyright notice and indicate the origin
+ * and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
* HENRY SPENCER 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;
@@ -26,23 +26,28 @@
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-/* headers if any */
-#include "tclInt.h"
+/*
+ * Headers if any.
+ */
-/* overrides for regguts.h definitions, if any */
-#define FUNCPTR(name, args) (*name) _ANSI_ARGS_(args)
-#define MALLOC(n) ckalloc(n)
-#define FREE(p) ckfree(VS(p))
-#define REALLOC(p,n) ckrealloc(VS(p),n)
+#include "regex.h"
+/*
+ * Overrides for regguts.h definitions, if any.
+ */
+#define FUNCPTR(name, args) (*name)args
+#define MALLOC(n) VS(attemptckalloc(n))
+#define FREE(p) ckfree(VS(p))
+#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n))
/*
- * Do not insert extras between the "begin" and "end" lines -- this
- * chunk is automatically extracted to be fitted into regex.h.
+ * Do not insert extras between the "begin" and "end" lines - this chunk is
+ * automatically extracted to be fitted into regex.h.
*/
+
/* --- begin --- */
-/* ensure certain things don't sneak in from system headers */
+/* Ensure certain things don't sneak in from system headers. */
#ifdef __REG_WIDE_T
#undef __REG_WIDE_T
#endif
@@ -67,54 +72,92 @@
#ifdef __REG_NOCHAR
#undef __REG_NOCHAR
#endif
-/* interface types */
+/* Interface types */
#define __REG_WIDE_T Tcl_UniChar
-#define __REG_REGOFF_T long /* not really right, but good enough... */
-#define __REG_VOID_T VOID
-#define __REG_CONST CONST
-/* names and declarations */
+#define __REG_REGOFF_T long /* Not really right, but good enough... */
+#define __REG_VOID_T void
+#define __REG_CONST const
+/* Names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
-#define __REG_NOFRONT /* don't want regcomp() and regexec() */
-#define __REG_NOCHAR /* or the char versions */
+#define __REG_NOFRONT /* Don't want regcomp() and regexec() */
+#define __REG_NOCHAR /* Or the char versions */
#define regfree TclReFree
#define regerror TclReError
/* --- end --- */
+/*
+ * Internal character type and related.
+ */
-
-/* internal character type and related */
-typedef Tcl_UniChar chr; /* the type itself */
-typedef int pchr; /* what it promotes to */
-typedef unsigned uchr; /* unsigned type that will hold a chr */
-typedef int celt; /* type to hold chr, MCCE number, or NOCELT */
-#define NOCELT (-1) /* celt value which is not valid chr or MCCE */
-#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
-#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 */
+typedef Tcl_UniChar chr; /* The type itself. */
+typedef int pchr; /* What it promotes to. */
+typedef unsigned uchr; /* Unsigned type that will hold a chr. */
+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 > 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 */
#else
-#define CHRBITS 16 /* bits in a chr; must not use sizeof */
-#define CHR_MIN 0x0000 /* smallest and largest chr; the value */
-#define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
+#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
+#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
+#define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#endif
-/* functions operating on chr */
+/*
+ * Functions operating on chr.
+ */
+
#define iscalnum(x) Tcl_UniCharIsAlnum(x)
#define iscalpha(x) Tcl_UniCharIsAlpha(x)
#define iscdigit(x) Tcl_UniCharIsDigit(x)
#define iscspace(x) Tcl_UniCharIsSpace(x)
-/* name the external functions */
+/*
+ * Name the external functions.
+ */
+
#define compile TclReComp
#define exec TclReExec
-/* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
-#if 0 /* no debug unless requested by makefile */
+/*
+& Enable/disable debugging code (by whether REG_DEBUG is defined or not).
+*/
+
+#if 0 /* No debug unless requested by makefile. */
#define REG_DEBUG /* */
#endif
-/* and pick up the standard header */
-#include "regex.h"
+/*
+ * Method of allocating a local workspace. We used a thread-specific data
+ * space to store this because the regular expression engine is never
+ * reentered from the same thread; it doesn't make any callbacks.
+ */
+
+#if 1
+#define AllocVars(vPtr) \
+ static Tcl_ThreadDataKey varsKey; \
+ register struct vars *vPtr = (struct vars *) \
+ Tcl_GetThreadData(&varsKey, sizeof(struct vars))
+#else
+/*
+ * This strategy for allocating workspace is "more proper" in some sense, but
+ * quite a bit slower. Using TSD (as above) leads to code that is quite a bit
+ * faster in practice (measured!)
+ */
+#define AllocVars(vPtr) \
+ register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars))
+#define FreeVars(vPtr) \
+ FREE(vPtr)
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index 313892c..920ea6c 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -3,20 +3,20 @@
* This file is #included by regexec.c.
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
+ *
* I'd appreciate being given credit for this package in the documentation
* of software which uses it, but that is not a requirement.
- *
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -29,649 +29,776 @@
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
*/
-
+
/*
- longest - longest-preferred matching engine
^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
*/
static chr * /* endpoint, or NULL */
-longest(v, d, start, stop, hitstopp)
-struct vars *v; /* used only for debug and exec flags */
-struct dfa *d;
-chr *start; /* where the match should start */
-chr *stop; /* match must end at or before here */
-int *hitstopp; /* record whether hit v->stop, if non-NULL */
+longest(
+ struct vars *const v, /* used only for debug and exec flags */
+ struct dfa *const d,
+ chr *const start, /* where the match should start */
+ chr *const stop, /* match must end at or before here */
+ int *const hitstopp) /* record whether hit v->stop, if non-NULL */
{
- chr *cp;
- chr *realstop = (stop == v->stop) ? stop : stop + 1;
- color co;
- struct sset *css;
- struct sset *ss;
- chr *post;
- int i;
- struct colormap *cm = d->cm;
-
- /* initialize */
- css = initialize(v, d, start);
- cp = start;
- if (hitstopp != NULL)
- *hitstopp = 0;
-
- /* startup */
- FDEBUG(("+++ startup +++\n"));
- if (cp == v->start) {
- co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
- FDEBUG(("color %ld\n", (long)co));
- } else {
- co = GETCOLOR(cm, *(cp - 1));
- FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
- }
- css = miss(v, d, css, co, cp, start);
- if (css == NULL)
- return NULL;
- css->lastseen = cp;
-
- /* main loop */
- if (v->eflags&REG_FTRACE)
- while (cp < realstop) {
- FDEBUG(("+++ at c%d +++\n", css - d->ssets));
- co = GETCOLOR(cm, *cp);
- FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
- ss = css->outs[co];
- if (ss == NULL) {
- ss = miss(v, d, css, co, cp+1, start);
- if (ss == NULL)
- break; /* NOTE BREAK OUT */
- }
- cp++;
- ss->lastseen = cp;
- css = ss;
+ chr *cp;
+ chr *realstop = (stop == v->stop) ? stop : stop + 1;
+ color co;
+ struct sset *css, *ss;
+ chr *post;
+ int i;
+ struct colormap *cm = d->cm;
+
+ /*
+ * Initialize.
+ */
+
+ css = initialize(v, d, start);
+ cp = start;
+ if (hitstopp != NULL) {
+ *hitstopp = 0;
+ }
+
+ /*
+ * Startup.
+ */
+
+ FDEBUG(("+++ startup +++\n"));
+ if (cp == v->start) {
+ co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ } else {
+ co = GETCOLOR(cm, *(cp - 1));
+ FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+ }
+ css = miss(v, d, css, co, cp, start);
+ if (css == NULL) {
+ return NULL;
+ }
+ css->lastseen = cp;
+
+ /*
+ * Main loop.
+ */
+
+ if (v->eflags&REG_FTRACE) {
+ while (cp < realstop) {
+ FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+ co = GETCOLOR(cm, *cp);
+ FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL) {
+ break; /* NOTE BREAK OUT */
}
- else
- while (cp < realstop) {
- co = GETCOLOR(cm, *cp);
- ss = css->outs[co];
- if (ss == NULL) {
- ss = miss(v, d, css, co, cp+1, start);
- if (ss == NULL)
- break; /* NOTE BREAK OUT */
- }
- cp++;
- ss->lastseen = cp;
- css = ss;
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ }
+ } else {
+ while (cp < realstop) {
+ co = GETCOLOR(cm, *cp);
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL) {
+ break; /* NOTE BREAK OUT */
}
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ }
+ }
- /* shutdown */
- FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
- if (cp == v->stop && stop == v->stop) {
- if (hitstopp != NULL)
- *hitstopp = 1;
- co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
- FDEBUG(("color %ld\n", (long)co));
- ss = miss(v, d, css, co, cp, start);
- /* special case: match ended at eol? */
- if (ss != NULL && (ss->flags&POSTSTATE))
- return cp;
- else if (ss != NULL)
- ss->lastseen = cp; /* to be tidy */
+ /*
+ * Shutdown.
+ */
+
+ FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+ if (cp == v->stop && stop == v->stop) {
+ if (hitstopp != NULL) {
+ *hitstopp = 1;
+ }
+ co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ ss = miss(v, d, css, co, cp, start);
+
+ /*
+ * Special case: match ended at eol?
+ */
+
+ if (ss != NULL && (ss->flags&POSTSTATE)) {
+ return cp;
+ } else if (ss != NULL) {
+ ss->lastseen = cp; /* to be tidy */
}
+ }
- /* find last match, if any */
- post = d->lastpost;
- for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
- if ((ss->flags&POSTSTATE) && post != ss->lastseen &&
- (post == NULL || post < ss->lastseen))
- post = ss->lastseen;
- if (post != NULL) /* found one */
- return post - 1;
+ /*
+ * Find last match, if any.
+ */
- return NULL;
-}
+ post = d->lastpost;
+ for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) {
+ if ((ss->flags&POSTSTATE) && (post != ss->lastseen) &&
+ (post == NULL || post < ss->lastseen)) {
+ post = ss->lastseen;
+ }
+ }
+ if (post != NULL) { /* found one */
+ return post - 1;
+ }
+ return NULL;
+}
+
/*
- shortest - shortest-preferred matching engine
^ static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *,
^ chr **, int *);
*/
static chr * /* endpoint, or NULL */
-shortest(v, d, start, min, max, coldp, hitstopp)
-struct vars *v;
-struct dfa *d;
-chr *start; /* where the match should start */
-chr *min; /* match must end at or after here */
-chr *max; /* match must end at or before here */
-chr **coldp; /* store coldstart pointer here, if nonNULL */
-int *hitstopp; /* record whether hit v->stop, if non-NULL */
+shortest(
+ struct vars *const v,
+ struct dfa *const d,
+ chr *const start, /* where the match should start */
+ chr *const min, /* match must end at or after here */
+ chr *const max, /* match must end at or before here */
+ chr **const coldp, /* store coldstart pointer here, if nonNULL */
+ int *const hitstopp) /* record whether hit v->stop, if non-NULL */
{
- chr *cp;
- chr *realmin = (min == v->stop) ? min : min + 1;
- chr *realmax = (max == v->stop) ? max : max + 1;
- color co;
- struct sset *css;
- struct sset *ss;
- struct colormap *cm = d->cm;
-
- /* initialize */
- css = initialize(v, d, start);
- cp = start;
- if (hitstopp != NULL)
- *hitstopp = 0;
-
- /* startup */
- FDEBUG(("--- startup ---\n"));
- if (cp == v->start) {
- co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
- FDEBUG(("color %ld\n", (long)co));
- } else {
- co = GETCOLOR(cm, *(cp - 1));
- FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
- }
- css = miss(v, d, css, co, cp, start);
- if (css == NULL)
- return NULL;
- css->lastseen = cp;
- ss = css;
-
- /* main loop */
- if (v->eflags&REG_FTRACE)
- while (cp < realmax) {
- FDEBUG(("--- at c%d ---\n", css - d->ssets));
- co = GETCOLOR(cm, *cp);
- FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
- ss = css->outs[co];
- if (ss == NULL) {
- ss = miss(v, d, css, co, cp+1, start);
- if (ss == NULL)
- break; /* NOTE BREAK OUT */
- }
- cp++;
- ss->lastseen = cp;
- css = ss;
- if ((ss->flags&POSTSTATE) && cp >= realmin)
- break; /* NOTE BREAK OUT */
+ chr *cp;
+ chr *realmin = (min == v->stop) ? min : min + 1;
+ chr *realmax = (max == v->stop) ? max : max + 1;
+ color co;
+ struct sset *css, *ss;
+ struct colormap *cm = d->cm;
+
+ /*
+ * Initialize.
+ */
+
+ css = initialize(v, d, start);
+ cp = start;
+ if (hitstopp != NULL) {
+ *hitstopp = 0;
+ }
+
+ /*
+ * Startup.
+ */
+
+ FDEBUG(("--- startup ---\n"));
+ if (cp == v->start) {
+ co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ } else {
+ co = GETCOLOR(cm, *(cp - 1));
+ FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+ }
+ css = miss(v, d, css, co, cp, start);
+ if (css == NULL) {
+ return NULL;
+ }
+ css->lastseen = cp;
+ ss = css;
+
+ /*
+ * Main loop.
+ */
+
+ if (v->eflags&REG_FTRACE) {
+ while (cp < realmax) {
+ FDEBUG(("--- at c%d ---\n", css - d->ssets));
+ co = GETCOLOR(cm, *cp);
+ FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL) {
+ break; /* NOTE BREAK OUT */
}
- else
- while (cp < realmax) {
- co = GETCOLOR(cm, *cp);
- ss = css->outs[co];
- if (ss == NULL) {
- ss = miss(v, d, css, co, cp+1, start);
- if (ss == NULL)
- break; /* NOTE BREAK OUT */
- }
- cp++;
- ss->lastseen = cp;
- css = ss;
- if ((ss->flags&POSTSTATE) && cp >= realmin)
- break; /* NOTE BREAK OUT */
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ if ((ss->flags&POSTSTATE) && cp >= realmin) {
+ break; /* NOTE BREAK OUT */
+ }
+ }
+ } else {
+ while (cp < realmax) {
+ co = GETCOLOR(cm, *cp);
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL) {
+ break; /* NOTE BREAK OUT */
}
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ if ((ss->flags&POSTSTATE) && cp >= realmin) {
+ break; /* NOTE BREAK OUT */
+ }
+ }
+ }
- if (ss == NULL)
- return NULL;
-
- if (coldp != NULL) /* report last no-progress state set, if any */
- *coldp = lastcold(v, d);
-
- if ((ss->flags&POSTSTATE) && cp > min) {
- assert(cp >= realmin);
- cp--;
- } else if (cp == v->stop && max == v->stop) {
- co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
- FDEBUG(("color %ld\n", (long)co));
- ss = miss(v, d, css, co, cp, start);
- /* match might have ended at eol */
- if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL)
- *hitstopp = 1;
+ if (ss == NULL) {
+ return NULL;
+ }
+
+ if (coldp != NULL) { /* report last no-progress state set, if any */
+ *coldp = lastCold(v, d);
+ }
+
+ if ((ss->flags&POSTSTATE) && cp > min) {
+ assert(cp >= realmin);
+ cp--;
+ } else if (cp == v->stop && max == v->stop) {
+ co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ ss = miss(v, d, css, co, cp, start);
+
+ /*
+ * Match might have ended at eol.
+ */
+
+ if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL) {
+ *hitstopp = 1;
}
+ }
- if (ss == NULL || !(ss->flags&POSTSTATE))
- return NULL;
+ if (ss == NULL || !(ss->flags&POSTSTATE)) {
+ return NULL;
+ }
- return cp;
+ return cp;
}
-
+
/*
- - lastcold - determine last point at which no progress had been made
- ^ static chr *lastcold(struct vars *, struct dfa *);
+ - lastCold - determine last point at which no progress had been made
+ ^ static chr *lastCold(struct vars *, struct dfa *);
*/
static chr * /* endpoint, or NULL */
-lastcold(v, d)
-struct vars *v;
-struct dfa *d;
+lastCold(
+ struct vars *const v,
+ struct dfa *const d)
{
- struct sset *ss;
- chr *nopr;
- int i;
-
- nopr = d->lastnopr;
- if (nopr == NULL)
- nopr = v->start;
- for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
- if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen)
- nopr = ss->lastseen;
- return nopr;
+ struct sset *ss;
+ chr *nopr = d->lastnopr;
+ int i;
+
+ if (nopr == NULL) {
+ nopr = v->start;
+ }
+ for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) {
+ if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen) {
+ nopr = ss->lastseen;
+ }
+ }
+ return nopr;
}
-
+
/*
- - newdfa - set up a fresh DFA
- ^ static struct dfa *newdfa(struct vars *, struct cnfa *,
+ - newDFA - set up a fresh DFA
+ ^ static struct dfa *newDFA(struct vars *, struct cnfa *,
^ struct colormap *, struct smalldfa *);
*/
static struct dfa *
-newdfa(v, cnfa, cm, small)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
-struct smalldfa *small; /* preallocated space, may be NULL */
+newDFA(
+ struct vars *const v,
+ struct cnfa *const cnfa,
+ struct colormap *const cm,
+ struct smalldfa *sml) /* preallocated space, may be NULL */
{
- struct dfa *d;
- size_t nss = cnfa->nstates * 2;
- int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
- struct smalldfa *smallwas = small;
-
- assert(cnfa != NULL && cnfa->nstates != 0);
-
- if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
- assert(wordsper == 1);
- if (small == NULL) {
- small = (struct smalldfa *)MALLOC(
- sizeof(struct smalldfa));
- if (small == NULL) {
- ERR(REG_ESPACE);
- return NULL;
- }
- }
- d = &small->dfa;
- d->ssets = small->ssets;
- d->statesarea = small->statesarea;
- d->work = &d->statesarea[nss];
- d->outsarea = small->outsarea;
- d->incarea = small->incarea;
- d->cptsmalloced = 0;
- d->mallocarea = (smallwas == NULL) ? (char *)small : NULL;
- } else {
- d = (struct dfa *)MALLOC(sizeof(struct dfa));
- if (d == NULL) {
- ERR(REG_ESPACE);
- return NULL;
- }
- d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
- d->statesarea = (unsigned *)MALLOC((nss+WORK) * wordsper *
- sizeof(unsigned));
- d->work = &d->statesarea[nss * wordsper];
- d->outsarea = (struct sset **)MALLOC(nss * cnfa->ncolors *
- sizeof(struct sset *));
- d->incarea = (struct arcp *)MALLOC(nss * cnfa->ncolors *
- sizeof(struct arcp));
- d->cptsmalloced = 1;
- d->mallocarea = (char *)d;
- if (d->ssets == NULL || d->statesarea == NULL ||
- d->outsarea == NULL || d->incarea == NULL) {
- freedfa(d);
- ERR(REG_ESPACE);
- return NULL;
- }
+ struct dfa *d;
+ size_t nss = cnfa->nstates * 2;
+ int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
+ struct smalldfa *smallwas = sml;
+
+ assert(cnfa != NULL && cnfa->nstates != 0);
+
+ if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
+ assert(wordsper == 1);
+ if (sml == NULL) {
+ sml = (struct smalldfa *) MALLOC(sizeof(struct smalldfa));
+ if (sml == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
+ }
}
-
- d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
- d->nssused = 0;
- d->nstates = cnfa->nstates;
- d->ncolors = cnfa->ncolors;
- d->wordsper = wordsper;
- d->cnfa = cnfa;
- d->cm = cm;
- d->lastpost = NULL;
- d->lastnopr = NULL;
- d->search = d->ssets;
-
- /* initialization of sset fields is done as needed */
-
- return d;
+ d = &sml->dfa;
+ d->ssets = sml->ssets;
+ d->statesarea = sml->statesarea;
+ d->work = &d->statesarea[nss];
+ d->outsarea = sml->outsarea;
+ d->incarea = sml->incarea;
+ d->cptsmalloced = 0;
+ d->mallocarea = (smallwas == NULL) ? (char *)sml : NULL;
+ } else {
+ d = (struct dfa *) MALLOC(sizeof(struct dfa));
+ if (d == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ d->ssets = (struct sset *) MALLOC(nss * sizeof(struct sset));
+ d->statesarea = (unsigned *)
+ MALLOC((nss+WORK) * wordsper * sizeof(unsigned));
+ d->work = &d->statesarea[nss * wordsper];
+ d->outsarea = (struct sset **)
+ MALLOC(nss * cnfa->ncolors * sizeof(struct sset *));
+ d->incarea = (struct arcp *)
+ MALLOC(nss * cnfa->ncolors * sizeof(struct arcp));
+ d->cptsmalloced = 1;
+ d->mallocarea = (char *)d;
+ if (d->ssets == NULL || d->statesarea == NULL ||
+ d->outsarea == NULL || d->incarea == NULL) {
+ freeDFA(d);
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ }
+
+ d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
+ d->nssused = 0;
+ d->nstates = cnfa->nstates;
+ d->ncolors = cnfa->ncolors;
+ d->wordsper = wordsper;
+ d->cnfa = cnfa;
+ d->cm = cm;
+ d->lastpost = NULL;
+ d->lastnopr = NULL;
+ d->search = d->ssets;
+
+ /*
+ * Initialization of sset fields is done as needed.
+ */
+
+ return d;
}
-
+
/*
- - freedfa - free a DFA
- ^ static VOID freedfa(struct dfa *);
+ - freeDFA - free a DFA
+ ^ static void freeDFA(struct dfa *);
*/
-static VOID
-freedfa(d)
-struct dfa *d;
+static void
+freeDFA(
+ struct dfa *const d)
{
- if (d->cptsmalloced) {
- if (d->ssets != NULL)
- FREE(d->ssets);
- if (d->statesarea != NULL)
- FREE(d->statesarea);
- if (d->outsarea != NULL)
- FREE(d->outsarea);
- if (d->incarea != NULL)
- FREE(d->incarea);
+ if (d->cptsmalloced) {
+ if (d->ssets != NULL) {
+ FREE(d->ssets);
+ }
+ if (d->statesarea != NULL) {
+ FREE(d->statesarea);
+ }
+ if (d->outsarea != NULL) {
+ FREE(d->outsarea);
}
+ if (d->incarea != NULL) {
+ FREE(d->incarea);
+ }
+ }
- if (d->mallocarea != NULL)
- FREE(d->mallocarea);
+ if (d->mallocarea != NULL) {
+ FREE(d->mallocarea);
+ }
}
-
+
/*
- hash - construct a hash code for a bitvector
* There are probably better ways, but they're more expensive.
^ static unsigned hash(unsigned *, int);
*/
static unsigned
-hash(uv, n)
-unsigned *uv;
-int n;
+hash(
+ unsigned *const uv,
+ const int n)
{
- int i;
- unsigned h;
-
- h = 0;
- for (i = 0; i < n; i++)
- h ^= uv[i];
- return h;
+ int i;
+ unsigned h;
+
+ h = 0;
+ for (i = 0; i < n; i++) {
+ h ^= uv[i];
+ }
+ return h;
}
-
+
/*
- initialize - hand-craft a cache entry for startup, otherwise get ready
^ static struct sset *initialize(struct vars *, struct dfa *, chr *);
*/
static struct sset *
-initialize(v, d, start)
-struct vars *v; /* used only for debug flags */
-struct dfa *d;
-chr *start;
+initialize(
+ struct vars *const v, /* used only for debug flags */
+ struct dfa *const d,
+ chr *const start)
{
- struct sset *ss;
- int i;
-
- /* is previous one still there? */
- if (d->nssused > 0 && (d->ssets[0].flags&STARTER))
- ss = &d->ssets[0];
- else { /* no, must (re)build it */
- ss = getvacant(v, d, start, start);
- for (i = 0; i < d->wordsper; i++)
- ss->states[i] = 0;
- BSET(ss->states, d->cnfa->pre);
- ss->hash = HASH(ss->states, d->wordsper);
- assert(d->cnfa->pre != d->cnfa->post);
- ss->flags = STARTER|LOCKED|NOPROGRESS;
- /* lastseen dealt with below */
+ struct sset *ss;
+ int i;
+
+ /*
+ * Is previous one still there?
+ */
+
+ if (d->nssused > 0 && (d->ssets[0].flags&STARTER)) {
+ ss = &d->ssets[0];
+ } else { /* no, must (re)build it */
+ ss = getVacantSS(v, d, start, start);
+ for (i = 0; i < d->wordsper; i++) {
+ ss->states[i] = 0;
}
-
- for (i = 0; i < d->nssused; i++)
- d->ssets[i].lastseen = NULL;
- ss->lastseen = start; /* maybe untrue, but harmless */
- d->lastpost = NULL;
- d->lastnopr = NULL;
- return ss;
+ BSET(ss->states, d->cnfa->pre);
+ ss->hash = HASH(ss->states, d->wordsper);
+ assert(d->cnfa->pre != d->cnfa->post);
+ ss->flags = STARTER|LOCKED|NOPROGRESS;
+
+ /*
+ * lastseen dealt with below
+ */
+ }
+
+ for (i = 0; i < d->nssused; i++) {
+ d->ssets[i].lastseen = NULL;
+ }
+ ss->lastseen = start; /* maybe untrue, but harmless */
+ d->lastpost = NULL;
+ d->lastnopr = NULL;
+ return ss;
}
-
+
/*
- miss - handle a cache miss
^ static struct sset *miss(struct vars *, struct dfa *, struct sset *,
^ pcolor, chr *, chr *);
*/
static struct sset * /* NULL if goes to empty set */
-miss(v, d, css, co, cp, start)
-struct vars *v; /* used only for debug flags */
-struct dfa *d;
-struct sset *css;
-pcolor co;
-chr *cp; /* next chr */
-chr *start; /* where the attempt got started */
+miss(
+ struct vars *const v, /* used only for debug flags */
+ struct dfa *const d,
+ struct sset *const css,
+ const pcolor co,
+ chr *const cp, /* next chr */
+ chr *const start) /* where the attempt got started */
{
- struct cnfa *cnfa = d->cnfa;
- int i;
- unsigned h;
- struct carc *ca;
- struct sset *p;
- int ispost;
- int noprogress;
- int gotstate;
- int dolacons;
- int sawlacons;
-
- /* for convenience, we can be called even if it might not be a miss */
- if (css->outs[co] != NULL) {
- FDEBUG(("hit\n"));
- return css->outs[co];
- }
- FDEBUG(("miss\n"));
-
- /* first, what set of states would we end up in? */
- for (i = 0; i < d->wordsper; i++)
- d->work[i] = 0;
- ispost = 0;
- noprogress = 1;
- gotstate = 0;
- for (i = 0; i < d->nstates; i++)
- if (ISBSET(css->states, i))
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++)
- if (ca->co == co) {
- BSET(d->work, ca->to);
- gotstate = 1;
- if (ca->to == cnfa->post)
- ispost = 1;
- if (!cnfa->states[ca->to]->co)
- noprogress = 0;
- FDEBUG(("%d -> %d\n", i, ca->to));
- }
- dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
- sawlacons = 0;
- while (dolacons) { /* transitive closure */
- dolacons = 0;
- for (i = 0; i < d->nstates; i++)
- if (ISBSET(d->work, i))
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS;
- ca++) {
- if (ca->co <= cnfa->ncolors)
- continue; /* NOTE CONTINUE */
- sawlacons = 1;
- if (ISBSET(d->work, ca->to))
- continue; /* NOTE CONTINUE */
- if (!lacon(v, cnfa, cp, ca->co))
- continue; /* NOTE CONTINUE */
- BSET(d->work, ca->to);
- dolacons = 1;
- if (ca->to == cnfa->post)
- ispost = 1;
- if (!cnfa->states[ca->to]->co)
- noprogress = 0;
- FDEBUG(("%d :> %d\n", i, ca->to));
- }
+ struct cnfa *cnfa = d->cnfa;
+ unsigned h;
+ struct carc *ca;
+ struct sset *p;
+ int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints;
+
+ /*
+ * For convenience, we can be called even if it might not be a miss.
+ */
+
+ if (css->outs[co] != NULL) {
+ FDEBUG(("hit\n"));
+ return css->outs[co];
+ }
+ FDEBUG(("miss\n"));
+
+ /*
+ * First, what set of states would we end up in?
+ */
+
+ for (i = 0; i < d->wordsper; i++) {
+ d->work[i] = 0;
+ }
+ isPost = 0;
+ noProgress = 1;
+ gotState = 0;
+ for (i = 0; i < d->nstates; i++) {
+ if (ISBSET(css->states, i)) {
+ for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+ if (ca->co == co) {
+ BSET(d->work, ca->to);
+ gotState = 1;
+ if (ca->to == cnfa->post) {
+ isPost = 1;
+ }
+ if (!cnfa->states[ca->to]->co) {
+ noProgress = 0;
+ }
+ FDEBUG(("%d -> %d\n", i, ca->to));
+ }
+ }
}
- if (!gotstate)
- return NULL;
- h = HASH(d->work, d->wordsper);
-
- /* next, is that in the cache? */
- for (p = d->ssets, i = d->nssused; i > 0; p++, i--)
- if (HIT(h, d->work, p, d->wordsper)) {
- FDEBUG(("cached c%d\n", p - d->ssets));
- break; /* NOTE BREAK OUT */
+ }
+ doLAConstraints = (gotState ? (cnfa->flags&HASLACONS) : 0);
+ sawLAConstraints = 0;
+ while (doLAConstraints) { /* transitive closure */
+ doLAConstraints = 0;
+ for (i = 0; i < d->nstates; i++) {
+ if (ISBSET(d->work, i)) {
+ for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+ if (ca->co <= cnfa->ncolors) {
+ continue; /* NOTE CONTINUE */
+ }
+ sawLAConstraints = 1;
+ if (ISBSET(d->work, ca->to)) {
+ continue; /* NOTE CONTINUE */
+ }
+ if (!checkLAConstraint(v, cnfa, cp, ca->co)) {
+ continue; /* NOTE CONTINUE */
+ }
+ BSET(d->work, ca->to);
+ doLAConstraints = 1;
+ if (ca->to == cnfa->post) {
+ isPost = 1;
+ }
+ if (!cnfa->states[ca->to]->co) {
+ noProgress = 0;
+ }
+ FDEBUG(("%d :> %d\n", i, ca->to));
}
- if (i == 0) { /* nope, need a new cache entry */
- p = getvacant(v, d, cp, start);
- assert(p != css);
- for (i = 0; i < d->wordsper; i++)
- p->states[i] = d->work[i];
- p->hash = h;
- p->flags = (ispost) ? POSTSTATE : 0;
- if (noprogress)
- p->flags |= NOPROGRESS;
- /* lastseen to be dealt with by caller */
+ }
}
-
- if (!sawlacons) { /* lookahead conds. always cache miss */
- FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
- css->outs[co] = p;
- css->inchain[co] = p->ins;
- p->ins.ss = css;
- p->ins.co = (color)co;
+ }
+ if (!gotState) {
+ return NULL;
+ }
+ h = HASH(d->work, d->wordsper);
+
+ /*
+ * Next, is that in the cache?
+ */
+
+ for (p = d->ssets, i = d->nssused; i > 0; p++, i--) {
+ if (HIT(h, d->work, p, d->wordsper)) {
+ FDEBUG(("cached c%d\n", p - d->ssets));
+ break; /* NOTE BREAK OUT */
+ }
+ }
+ if (i == 0) { /* nope, need a new cache entry */
+ p = getVacantSS(v, d, cp, start);
+ assert(p != css);
+ for (i = 0; i < d->wordsper; i++) {
+ p->states[i] = d->work[i];
+ }
+ p->hash = h;
+ p->flags = (isPost ? POSTSTATE : 0);
+ if (noProgress) {
+ p->flags |= NOPROGRESS;
}
- return p;
-}
+ /*
+ * lastseen to be dealt with by caller
+ */
+ }
+
+ if (!sawLAConstraints) { /* lookahead conds. always cache miss */
+ FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+ css->outs[co] = p;
+ css->inchain[co] = p->ins;
+ p->ins.ss = css;
+ p->ins.co = (color) co;
+ }
+ return p;
+}
+
/*
- - lacon - lookahead-constraint checker for miss()
- ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
+ - checkLAConstraint - lookahead-constraint checker for miss()
+ ^ static int checkLAConstraint(struct vars *, struct cnfa *, chr *, pcolor);
*/
static int /* predicate: constraint satisfied? */
-lacon(v, pcnfa, cp, co)
-struct vars *v;
-struct cnfa *pcnfa; /* parent cnfa */
-chr *cp;
-pcolor co; /* "color" of the lookahead constraint */
+checkLAConstraint(
+ struct vars *const v,
+ struct cnfa *const pcnfa, /* parent cnfa */
+ chr *const cp,
+ const pcolor co) /* "color" of the lookahead constraint */
{
- int n;
- struct subre *sub;
- struct dfa *d;
- struct smalldfa sd;
- chr *end;
-
- n = co - pcnfa->ncolors;
- assert(n < v->g->nlacons && v->g->lacons != NULL);
- FDEBUG(("=== testing lacon %d\n", n));
- sub = &v->g->lacons[n];
- d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
- if (d == NULL) {
- ERR(REG_ESPACE);
- return 0;
- }
- end = longest(v, d, cp, v->stop, (int *)NULL);
- freedfa(d);
- FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
- return (sub->subno) ? (end != NULL) : (end == NULL);
+ int n;
+ struct subre *sub;
+ struct dfa *d;
+ struct smalldfa sd;
+ chr *end;
+
+ n = co - pcnfa->ncolors;
+ assert(n < v->g->nlacons && v->g->lacons != NULL);
+ FDEBUG(("=== testing lacon %d\n", n));
+ sub = &v->g->lacons[n];
+ d = newDFA(v, &sub->cnfa, &v->g->cmap, &sd);
+ if (d == NULL) {
+ ERR(REG_ESPACE);
+ return 0;
+ }
+ end = longest(v, d, cp, v->stop, NULL);
+ freeDFA(d);
+ FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
+ return (sub->subno) ? (end != NULL) : (end == NULL);
}
-
+
/*
- - getvacant - get a vacant state set
+ - getVacantSS - get a vacant state set
* This routine clears out the inarcs and outarcs, but does not otherwise
* clear the innards of the state set -- that's up to the caller.
- ^ static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
+ ^ static struct sset *getVacantSS(struct vars *, struct dfa *, chr *, chr *);
*/
static struct sset *
-getvacant(v, d, cp, start)
-struct vars *v; /* used only for debug flags */
-struct dfa *d;
-chr *cp;
-chr *start;
+getVacantSS(
+ struct vars *const v, /* used only for debug flags */
+ struct dfa *const d,
+ chr *const cp,
+ chr *const start)
{
- int i;
- struct sset *ss;
- struct sset *p;
- struct arcp ap;
- struct arcp lastap;
- color co;
-
- ss = pickss(v, d, cp, start);
- assert(!(ss->flags&LOCKED));
-
- /* clear out its inarcs, including self-referential ones */
- ap = ss->ins;
- while ((p = ap.ss) != NULL) {
- co = ap.co;
- FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
- p->outs[co] = NULL;
- ap = p->inchain[co];
- p->inchain[co].ss = NULL; /* paranoia */
+ int i;
+ struct sset *ss, *p;
+ struct arcp ap, lastap = {NULL, 0}; /* silence gcc 4 warning */
+ color co;
+
+ ss = pickNextSS(v, d, cp, start);
+ assert(!(ss->flags&LOCKED));
+
+ /*
+ * Clear out its inarcs, including self-referential ones.
+ */
+
+ ap = ss->ins;
+ while ((p = ap.ss) != NULL) {
+ co = ap.co;
+ FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+ p->outs[co] = NULL;
+ ap = p->inchain[co];
+ p->inchain[co].ss = NULL; /* paranoia */
+ }
+ ss->ins.ss = NULL;
+
+ /*
+ * Take it off the inarc chains of the ssets reached by its outarcs.
+ */
+
+ for (i = 0; i < d->ncolors; i++) {
+ p = ss->outs[i];
+ assert(p != ss); /* not self-referential */
+ if (p == NULL) {
+ continue; /* NOTE CONTINUE */
}
- ss->ins.ss = NULL;
-
- /* take it off the inarc chains of the ssets reached by its outarcs */
- for (i = 0; i < d->ncolors; i++) {
- p = ss->outs[i];
- assert(p != ss); /* not self-referential */
- if (p == NULL)
- continue; /* NOTE CONTINUE */
- FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
- if (p->ins.ss == ss && p->ins.co == i)
- p->ins = ss->inchain[i];
- else {
- assert(p->ins.ss != NULL);
- for (ap = p->ins; ap.ss != NULL &&
- !(ap.ss == ss && ap.co == i);
- ap = ap.ss->inchain[ap.co])
- lastap = ap;
- assert(ap.ss != NULL);
- lastap.ss->inchain[lastap.co] = ss->inchain[i];
- }
- ss->outs[i] = NULL;
- ss->inchain[i].ss = NULL;
+ FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+ if (p->ins.ss == ss && p->ins.co == i) {
+ p->ins = ss->inchain[i];
+ } else {
+ assert(p->ins.ss != NULL);
+ for (ap = p->ins; ap.ss != NULL && !(ap.ss == ss && ap.co == i);
+ ap = ap.ss->inchain[ap.co]) {
+ lastap = ap;
+ }
+ assert(ap.ss != NULL);
+ lastap.ss->inchain[lastap.co] = ss->inchain[i];
}
+ ss->outs[i] = NULL;
+ ss->inchain[i].ss = NULL;
+ }
- /* if ss was a success state, may need to remember location */
- if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
- (d->lastpost == NULL || d->lastpost < ss->lastseen))
- d->lastpost = ss->lastseen;
+ /*
+ * If ss was a success state, may need to remember location.
+ */
- /* likewise for a no-progress state */
- if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
- (d->lastnopr == NULL || d->lastnopr < ss->lastseen))
- d->lastnopr = ss->lastseen;
+ if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
+ (d->lastpost == NULL || d->lastpost < ss->lastseen)) {
+ d->lastpost = ss->lastseen;
+ }
- return ss;
-}
+ /*
+ * Likewise for a no-progress state.
+ */
+ if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
+ (d->lastnopr == NULL || d->lastnopr < ss->lastseen)) {
+ d->lastnopr = ss->lastseen;
+ }
+
+ return ss;
+}
+
/*
- - pickss - pick the next stateset to be used
- ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
+ - pickNextSS - pick the next stateset to be used
+ ^ static struct sset *pickNextSS(struct vars *, struct dfa *, chr *, chr *);
*/
static struct sset *
-pickss(v, d, cp, start)
-struct vars *v; /* used only for debug flags */
-struct dfa *d;
-chr *cp;
-chr *start;
+pickNextSS(
+ struct vars *const v, /* used only for debug flags */
+ struct dfa *const d,
+ chr *const cp,
+ chr *const start)
{
- int i;
- struct sset *ss;
- struct sset *end;
- chr *ancient;
-
- /* shortcut for cases where cache isn't full */
- if (d->nssused < d->nssets) {
- i = d->nssused;
- d->nssused++;
- ss = &d->ssets[i];
- FDEBUG(("new c%d\n", i));
- /* set up innards */
- ss->states = &d->statesarea[i * d->wordsper];
- ss->flags = 0;
- ss->ins.ss = NULL;
- ss->ins.co = WHITE; /* give it some value */
- ss->outs = &d->outsarea[i * d->ncolors];
- ss->inchain = &d->incarea[i * d->ncolors];
- for (i = 0; i < d->ncolors; i++) {
- ss->outs[i] = NULL;
- ss->inchain[i].ss = NULL;
- }
- return ss;
+ int i;
+ struct sset *ss, *end;
+ chr *ancient;
+
+ /*
+ * Shortcut for cases where cache isn't full.
+ */
+
+ if (d->nssused < d->nssets) {
+ i = d->nssused;
+ d->nssused++;
+ ss = &d->ssets[i];
+ FDEBUG(("new c%d\n", i));
+
+ /*
+ * Set up innards.
+ */
+
+ ss->states = &d->statesarea[i * d->wordsper];
+ ss->flags = 0;
+ ss->ins.ss = NULL;
+ ss->ins.co = WHITE; /* give it some value */
+ ss->outs = &d->outsarea[i * d->ncolors];
+ ss->inchain = &d->incarea[i * d->ncolors];
+ for (i = 0; i < d->ncolors; i++) {
+ ss->outs[i] = NULL;
+ ss->inchain[i].ss = NULL;
+ }
+ return ss;
+ }
+
+ /*
+ * Look for oldest, or old enough anyway.
+ */
+
+ if (cp - start > d->nssets*2/3) { /* oldest 33% are expendable */
+ ancient = cp - d->nssets*2/3;
+ } else {
+ ancient = start;
+ }
+ for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++) {
+ if ((ss->lastseen == NULL || ss->lastseen < ancient)
+ && !(ss->flags&LOCKED)) {
+ d->search = ss + 1;
+ FDEBUG(("replacing c%d\n", ss - d->ssets));
+ return ss;
}
+ }
+ for (ss = d->ssets, end = d->search; ss < end; ss++) {
+ if ((ss->lastseen == NULL || ss->lastseen < ancient)
+ && !(ss->flags&LOCKED)) {
+ d->search = ss + 1;
+ FDEBUG(("replacing c%d\n", ss - d->ssets));
+ return ss;
+ }
+ }
- /* look for oldest, or old enough anyway */
- if (cp - start > d->nssets*2/3) /* oldest 33% are expendable */
- ancient = cp - d->nssets*2/3;
- else
- ancient = start;
- for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++)
- if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
- !(ss->flags&LOCKED)) {
- d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
- return ss;
- }
- for (ss = d->ssets, end = d->search; ss < end; ss++)
- if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
- !(ss->flags&LOCKED)) {
- d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
- return ss;
- }
+ /*
+ * Nobody's old enough?!? -- something's really wrong.
+ */
- /* nobody's old enough?!? -- something's really wrong */
- FDEBUG(("can't find victim to replace!\n"));
- assert(NOTREACHED);
- ERR(REG_ASSERT);
- return d->ssets;
+ FDEBUG(("can't find victim to replace!\n"));
+ assert(NOTREACHED);
+ ERR(REG_ASSERT);
+ return d->ssets;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regerror.c b/generic/regerror.c
index aca13aa..a1a0163 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -2,20 +2,20 @@
* regerror - error-code expansion
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -31,79 +31,99 @@
#include "regguts.h"
-/* unknown-error explanation */
-static char unk[] = "*** unknown regex error code 0x%x ***";
+/*
+ * Unknown-error explanation.
+ */
+
+static const char unk[] = "*** unknown regex error code 0x%x ***";
+
+/*
+ * Struct to map among codes, code names, and explanations.
+ */
-/* struct to map among codes, code names, and explanations */
static struct rerr {
- int code;
- char *name;
- char *explain;
+ int code;
+ const char *name;
+ const char *explain;
} rerrs[] = {
- /* the actual table is built from regex.h */
-# include "regerrs.h"
- { -1, "", "oops" }, /* explanation special-cased in code */
+ /* The actual table is built from regex.h */
+#include "regerrs.h"
+ { -1, "", "oops" }, /* explanation special-cased in code */
};
-
+
/*
- regerror - the interface to error numbers
*/
/* ARGSUSED */
-size_t /* actual space needed (including NUL) */
-regerror(errcode, preg, errbuf, errbuf_size)
-int errcode; /* error code, or REG_ATOI or REG_ITOA */
-CONST regex_t *preg; /* associated regex_t (unused at present) */
-char *errbuf; /* result buffer (unless errbuf_size==0) */
-size_t errbuf_size; /* available space in errbuf, can be 0 */
+size_t /* Actual space needed (including NUL) */
+regerror(
+ int code, /* Error code, or REG_ATOI or REG_ITOA */
+ const regex_t *preg, /* Associated regex_t (unused at present) */
+ char *errbuf, /* Result buffer (unless errbuf_size==0) */
+ size_t errbuf_size) /* Available space in errbuf, can be 0 */
{
- struct rerr *r;
- char *msg;
- char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
- size_t len;
- int icode;
+ struct rerr *r;
+ const char *msg;
+ char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
+ size_t len;
+ int icode;
- switch (errcode) {
- case REG_ATOI: /* convert name to number */
- for (r = rerrs; r->code >= 0; r++)
- if (strcmp(r->name, errbuf) == 0)
- break;
- sprintf(convbuf, "%d", r->code); /* -1 for unknown */
- msg = convbuf;
+ switch (code) {
+ case REG_ATOI: /* Convert name to number */
+ for (r = rerrs; r->code >= 0; r++) {
+ if (strcmp(r->name, errbuf) == 0) {
break;
- case REG_ITOA: /* convert number to name */
- icode = atoi(errbuf); /* not our problem if this fails */
- for (r = rerrs; r->code >= 0; r++)
- if (r->code == icode)
- break;
- if (r->code >= 0)
- msg = r->name;
- else { /* unknown; tell him the number */
- sprintf(convbuf, "REG_%u", (unsigned)icode);
- msg = convbuf;
- }
+ }
+ }
+ sprintf(convbuf, "%d", r->code); /* -1 for unknown */
+ msg = convbuf;
+ break;
+ case REG_ITOA: /* Convert number to name */
+ icode = atoi(errbuf); /* Not our problem if this fails */
+ for (r = rerrs; r->code >= 0; r++) {
+ if (r->code == icode) {
break;
- default: /* a real, normal error code */
- for (r = rerrs; r->code >= 0; r++)
- if (r->code == errcode)
- break;
- if (r->code >= 0)
- msg = r->explain;
- else { /* unknown; say so */
- sprintf(convbuf, unk, errcode);
- msg = convbuf;
- }
+ }
+ }
+ if (r->code >= 0) {
+ msg = r->name;
+ } else { /* Unknown; tell him the number */
+ sprintf(convbuf, "REG_%u", (unsigned)icode);
+ msg = convbuf;
+ }
+ break;
+ default: /* A real, normal error code */
+ for (r = rerrs; r->code >= 0; r++) {
+ if (r->code == code) {
break;
+ }
+ }
+ if (r->code >= 0) {
+ msg = r->explain;
+ } else { /* Unknown; say so */
+ sprintf(convbuf, unk, code);
+ msg = convbuf;
}
+ break;
+ }
- len = strlen(msg) + 1; /* space needed, including NUL */
- if (errbuf_size > 0) {
- if (errbuf_size > len)
- strcpy(errbuf, msg);
- else { /* truncate to fit */
- strncpy(errbuf, msg, errbuf_size-1);
- errbuf[errbuf_size-1] = '\0';
- }
+ len = strlen(msg) + 1; /* Space needed, including NUL */
+ if (errbuf_size > 0) {
+ if (errbuf_size > len) {
+ strcpy(errbuf, msg);
+ } else { /* Truncate to fit */
+ strncpy(errbuf, msg, errbuf_size-1);
+ errbuf[errbuf_size-1] = '\0';
}
+ }
- return len;
+ return len;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regerrs.h b/generic/regerrs.h
index a3d98b6..72548ff 100644
--- a/generic/regerrs.h
+++ b/generic/regerrs.h
@@ -16,3 +16,5 @@
{ REG_INVARG, "REG_INVARG", "invalid argument to regex function" },
{ REG_MIXED, "REG_MIXED", "character widths of regex and string differ" },
{ REG_BADOPT, "REG_BADOPT", "invalid embedded option" },
+{ REG_ETOOBIG, "REG_ETOOBIG", "nfa has too many states" },
+{ REG_ECOLORS, "REG_ECOLORS", "too many colors" },
diff --git a/generic/regex.h b/generic/regex.h
index 8289a50..9466fbb 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -1,23 +1,26 @@
#ifndef _REGEX_H_
#define _REGEX_H_ /* never again */
+
+#include "tclInt.h"
+
/*
* regular expressions
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
*
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -30,38 +33,35 @@
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
*
- *
* Prototypes etc. marked with "^" within comments get gathered up (and
- * possibly edited) by the regfwd program and inserted near the bottom of
- * this file.
+ * possibly edited) by the regfwd program and inserted near the bottom of this
+ * file.
*
- * We offer the option of declaring one wide-character version of the
- * RE functions as well as the char versions. To do that, define
- * __REG_WIDE_T to the type of wide characters (unfortunately, there
- * is no consensus that wchar_t is suitable) and __REG_WIDE_COMPILE and
- * __REG_WIDE_EXEC to the names to be used for the compile and execute
- * functions (suggestion: re_Xcomp and re_Xexec, where X is a letter
- * suggestive of the wide type, e.g. re_ucomp and re_uexec for Unicode).
- * For cranky old compilers, it may be necessary to do something like:
+ * We offer the option of declaring one wide-character version of the RE
+ * functions as well as the char versions. To do that, define __REG_WIDE_T to
+ * the type of wide characters (unfortunately, there is no consensus that
+ * wchar_t is suitable) and __REG_WIDE_COMPILE and __REG_WIDE_EXEC to the
+ * names to be used for the compile and execute functions (suggestion:
+ * re_Xcomp and re_Xexec, where X is a letter suggestive of the wide type,
+ * e.g. re_ucomp and re_uexec for Unicode). For cranky old compilers, it may
+ * be necessary to do something like:
* #define __REG_WIDE_COMPILE(a,b,c,d) re_Xcomp(a,b,c,d)
* #define __REG_WIDE_EXEC(a,b,c,d,e,f,g) re_Xexec(a,b,c,d,e,f,g)
* rather than just #defining the names as parameterless macros.
*
* For some specialized purposes, it may be desirable to suppress the
- * declarations of the "front end" functions, regcomp() and regexec(),
- * or of the char versions of the compile and execute functions. To
- * suppress the front-end functions, define __REG_NOFRONT. To suppress
- * the char versions, define __REG_NOCHAR.
+ * declarations of the "front end" functions, regcomp() and regexec(), or of
+ * the char versions of the compile and execute functions. To suppress the
+ * front-end functions, define __REG_NOFRONT. To suppress the char versions,
+ * define __REG_NOCHAR.
*
* The right place to do those defines (and some others you may want, see
- * below) would be <sys/types.h>. If you don't have control of that file,
- * the right place to add your own defines to this file is marked below.
- * This is normally done automatically, by the makefile and regmkhdr, based
- * on the contents of regcustom.h.
+ * below) would be <sys/types.h>. If you don't have control of that file, the
+ * right place to add your own defines to this file is marked below. This is
+ * normally done automatically, by the makefile and regmkhdr, based on the
+ * contents of regcustom.h.
*/
-
-
/*
* voodoo for C++
*/
@@ -69,18 +69,15 @@
extern "C" {
#endif
-
-
/*
* Add your own defines, if needed, here.
*/
-
-
/*
- * Location where a chunk of regcustom.h is automatically spliced into
- * this file (working from its prototype, regproto.h).
+ * Location where a chunk of regcustom.h is automatically spliced into this
+ * file (working from its prototype, regproto.h).
*/
+
/* --- begin --- */
/* ensure certain things don't sneak in from system headers */
#ifdef __REG_WIDE_T
@@ -110,8 +107,8 @@ extern "C" {
/* interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* not really right, but good enough... */
-#define __REG_VOID_T VOID
-#define __REG_CONST CONST
+#define __REG_VOID_T void
+#define __REG_CONST const
/* names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
@@ -121,15 +118,14 @@ extern "C" {
#define regerror TclReError
/* --- end --- */
-
/*
* interface types etc.
*/
/*
- * regoff_t has to be large enough to hold either off_t or ssize_t,
- * and must be signed; it's only a guess that long is suitable, so we
- * offer <sys/types.h> an override.
+ * regoff_t has to be large enough to hold either off_t or ssize_t, and must
+ * be signed; it's only a guess that long is suitable, so we offer
+ * <sys/types.h> an override.
*/
#ifdef __REG_REGOFF_T
typedef __REG_REGOFF_T regoff_t;
@@ -148,8 +144,8 @@ typedef void re_void;
#endif
/*
- * Also for benefit of old compilers, <sys/types.h> can supply a macro
- * which expands to a substitute for `const'.
+ * Also for benefit of old compilers, <sys/types.h> can supply a macro which
+ * expands to a substitute for `const'.
*/
#ifndef __REG_CONST
#define __REG_CONST const
@@ -163,43 +159,41 @@ typedef void re_void;
/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
- int re_magic; /* magic number */
- size_t re_nsub; /* number of subexpressions */
- long re_info; /* information about RE */
-# define REG_UBACKREF 000001
-# define REG_ULOOKAHEAD 000002
-# define REG_UBOUNDS 000004
-# define REG_UBRACES 000010
-# define REG_UBSALNUM 000020
-# define REG_UPBOTCH 000040
-# define REG_UBBS 000100
-# define REG_UNONPOSIX 000200
-# define REG_UUNSPEC 000400
-# define REG_UUNPORT 001000
-# define REG_ULOCALE 002000
-# define REG_UEMPTYMATCH 004000
-# define REG_UIMPOSSIBLE 010000
-# define REG_USHORTEST 020000
- int re_csize; /* sizeof(character) */
- char *re_endp; /* backward compatibility kludge */
- /* the rest is opaque pointers to hidden innards */
- char *re_guts; /* `char *' is more portable than `void *' */
- char *re_fns;
+ int re_magic; /* magic number */
+ size_t re_nsub; /* number of subexpressions */
+ long re_info; /* information about RE */
+#define REG_UBACKREF 000001
+#define REG_ULOOKAHEAD 000002
+#define REG_UBOUNDS 000004
+#define REG_UBRACES 000010
+#define REG_UBSALNUM 000020
+#define REG_UPBOTCH 000040
+#define REG_UBBS 000100
+#define REG_UNONPOSIX 000200
+#define REG_UUNSPEC 000400
+#define REG_UUNPORT 001000
+#define REG_ULOCALE 002000
+#define REG_UEMPTYMATCH 004000
+#define REG_UIMPOSSIBLE 010000
+#define REG_USHORTEST 020000
+ int re_csize; /* sizeof(character) */
+ char *re_endp; /* backward compatibility kludge */
+ /* the rest is opaque pointers to hidden innards */
+ char *re_guts; /* `char *' is more portable than `void *' */
+ char *re_fns;
} regex_t;
/* result reporting (may acquire more fields later) */
typedef struct {
- regoff_t rm_so; /* start of substring */
- regoff_t rm_eo; /* end of substring */
+ regoff_t rm_so; /* start of substring */
+ regoff_t rm_eo; /* end of substring */
} regmatch_t;
/* supplementary control and reporting */
typedef struct {
- regmatch_t rm_extend; /* see REG_EXPECT */
+ regmatch_t rm_extend; /* see REG_EXPECT */
} rm_detail_t;
-
-
/*
* compilation
^ #ifndef __REG_NOCHAR
@@ -231,8 +225,6 @@ typedef struct {
#define REG_FAKE 010000 /* none of your business :-) */
#define REG_PROGRESS 020000 /* none of your business :-) */
-
-
/*
* execution
^ #ifndef __REG_NOCHAR
@@ -254,23 +246,19 @@ typedef struct {
#define REG_MTRACE 0020 /* none of your business */
#define REG_SMALL 0040 /* none of your business */
-
-
/*
* misc generics (may be more functions here eventually)
^ re_void regfree(regex_t *);
*/
-
-
/*
* error reporting
* Be careful if modifying the list of error codes -- the table used by
* regerror() is generated automatically from this file!
*
- * Note that there is no wide-char variant of regerror at this time; what
- * kind of character is used for error reports is independent of what kind
- * is used in matching.
+ * Note that there is no wide-char variant of regerror at this time; what kind
+ * of character is used for error reports is independent of what kind is used
+ * in matching.
*
^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
*/
@@ -292,12 +280,12 @@ typedef struct {
#define REG_INVARG 16 /* invalid argument to regex function */
#define REG_MIXED 17 /* character widths of regex and string differ */
#define REG_BADOPT 18 /* invalid embedded option */
+#define REG_ETOOBIG 19 /* nfa has too many states */
+#define REG_ECOLORS 20 /* too many colors */
/* two specials for debugging and testing */
#define REG_ATOI 101 /* convert error-code name to number */
#define REG_ITOA 102 /* convert error-code number to name */
-
-
/*
* the prototypes, as possibly munched by regfwd
*/
@@ -305,30 +293,28 @@ typedef struct {
/* automatically gathered by fwd; do not hand-edit */
/* === regproto.h === */
#ifndef __REG_NOCHAR
-int re_comp _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, int));
+int re_comp(regex_t *, __REG_CONST char *, size_t, int);
#endif
#ifndef __REG_NOFRONT
-int regcomp _ANSI_ARGS_((regex_t *, __REG_CONST char *, int));
+int regcomp(regex_t *, __REG_CONST char *, int);
#endif
#ifdef __REG_WIDE_T
-int __REG_WIDE_COMPILE _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int));
+MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
#endif
#ifndef __REG_NOCHAR
-int re_exec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
#ifndef __REG_NOFRONT
-int regexec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, regmatch_t [], int));
+int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
#endif
#ifdef __REG_WIDE_T
-int __REG_WIDE_EXEC _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
-re_void regfree _ANSI_ARGS_((regex_t *));
-extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t));
+MODULE_SCOPE re_void regfree(regex_t *);
+MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */
-
-
/*
* more C++ voodoo
*/
@@ -336,6 +322,12 @@ extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t))
}
#endif
-
-
#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regexec.c b/generic/regexec.c
index 41d49bd..ad4b6e6 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -2,20 +2,20 @@
* re_*exec and friends - match REs
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -26,1013 +26,1193 @@
* 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.
- *
*/
#include "regguts.h"
+/*
+ * Lazy-DFA representation.
+ */
-
-/* lazy-DFA representation */
struct arcp { /* "pointer" to an outarc */
- struct sset *ss;
- color co;
+ struct sset *ss;
+ color co;
};
struct sset { /* state set */
- unsigned *states; /* pointer to bitvector */
- unsigned hash; /* hash of bitvector */
-# define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
-# define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
- memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
- int flags;
-# define STARTER 01 /* the initial state set */
-# define POSTSTATE 02 /* includes the goal state */
-# define LOCKED 04 /* locked in cache */
-# define NOPROGRESS 010 /* zero-progress state set */
- struct arcp ins; /* chain of inarcs pointing here */
- chr *lastseen; /* last entered on arrival here */
- struct sset **outs; /* outarc vector indexed by color */
- struct arcp *inchain; /* chain-pointer vector for outarcs */
+ unsigned *states; /* pointer to bitvector */
+ unsigned hash; /* hash of bitvector */
+#define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
+#define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
+ memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
+ int flags;
+#define STARTER 01 /* the initial state set */
+#define POSTSTATE 02 /* includes the goal state */
+#define LOCKED 04 /* locked in cache */
+#define NOPROGRESS 010 /* zero-progress state set */
+ struct arcp ins; /* chain of inarcs pointing here */
+ chr *lastseen; /* last entered on arrival here */
+ struct sset **outs; /* outarc vector indexed by color */
+ struct arcp *inchain; /* chain-pointer vector for outarcs */
};
struct dfa {
- int nssets; /* size of cache */
- int nssused; /* how many entries occupied yet */
- int nstates; /* number of states */
- int ncolors; /* length of outarc and inchain vectors */
- int wordsper; /* length of state-set bitvectors */
- struct sset *ssets; /* state-set cache */
- unsigned *statesarea; /* bitvector storage */
- unsigned *work; /* pointer to work area within statesarea */
- struct sset **outsarea; /* outarc-vector storage */
- struct arcp *incarea; /* inchain storage */
- struct cnfa *cnfa;
- struct colormap *cm;
- chr *lastpost; /* location of last cache-flushed success */
- chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
- struct sset *search; /* replacement-search-pointer memory */
- int cptsmalloced; /* were the areas individually malloced? */
- char *mallocarea; /* self, or master malloced area, or NULL */
+ int nssets; /* size of cache */
+ int nssused; /* how many entries occupied yet */
+ int nstates; /* number of states */
+ int ncolors; /* length of outarc and inchain vectors */
+ int wordsper; /* length of state-set bitvectors */
+ struct sset *ssets; /* state-set cache */
+ unsigned *statesarea; /* bitvector storage */
+ unsigned *work; /* pointer to work area within statesarea */
+ struct sset **outsarea; /* outarc-vector storage */
+ struct arcp *incarea; /* inchain storage */
+ struct cnfa *cnfa;
+ struct colormap *cm;
+ chr *lastpost; /* location of last cache-flushed success */
+ chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
+ struct sset *search; /* replacement-search-pointer memory */
+ int cptsmalloced; /* were the areas individually malloced? */
+ char *mallocarea; /* self, or master malloced area, or NULL */
};
#define WORK 1 /* number of work bitvectors needed */
-/* setup for non-malloc allocation for small cases */
+/*
+ * Setup for non-malloc allocation for small cases.
+ */
+
#define FEWSTATES 20 /* must be less than UBITS */
#define FEWCOLORS 15
struct smalldfa {
- struct dfa dfa;
- struct sset ssets[FEWSTATES*2];
- unsigned statesarea[FEWSTATES*2 + WORK];
- struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
- struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
+ struct dfa dfa;
+ struct sset ssets[FEWSTATES*2];
+ unsigned statesarea[FEWSTATES*2 + WORK];
+ struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
+ struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
};
#define DOMALLOC ((struct smalldfa *)NULL) /* force malloc */
+/*
+ * Internal variables, bundled for easy passing around.
+ */
-
-/* internal variables, bundled for easy passing around */
struct vars {
- regex_t *re;
- struct guts *g;
- int eflags; /* copies of arguments */
- size_t nmatch;
- regmatch_t *pmatch;
- rm_detail_t *details;
- chr *start; /* start of string */
- chr *stop; /* just past end of string */
- int err; /* error code if any (0 none) */
- regoff_t *mem; /* memory vector for backtracking */
- struct smalldfa dfa1;
- struct smalldfa dfa2;
+ regex_t *re;
+ struct guts *g;
+ int eflags; /* copies of arguments */
+ size_t nmatch;
+ regmatch_t *pmatch;
+ rm_detail_t *details;
+ chr *start; /* start of string */
+ chr *stop; /* just past end of string */
+ int err; /* error code if any (0 none) */
+ regoff_t *mem; /* memory vector for backtracking */
+ struct smalldfa dfa1;
+ struct smalldfa dfa2;
};
-#define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */
+#define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
-#define ERR(e) VERR(v, e) /* record an error */
+#define VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return v->err;} /* if error seen, return it */
#define OFF(p) ((p) - v->start)
#define LOFF(p) ((long)OFF(p))
-
-
-
+
/*
* forward declarations
*/
/* =====^!^===== begin forwards =====^!^===== */
/* automatically gathered by fwd; do not hand-edit */
/* === regexec.c === */
-int exec _ANSI_ARGS_((regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
-static int find _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
-static int cfind _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
-static int cfindloop _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **));
-static VOID zapsubs _ANSI_ARGS_((regmatch_t *, size_t));
-static VOID zapmem _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID subset _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int dissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int condissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int altdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int cdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int ccondissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int crevdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int cbrdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int caltdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const);
+static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const);
+static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const);
+static void zapSubexpressions(regmatch_t *const, const size_t);
+static void zapSubtree(struct vars *const, struct subre *const);
+static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
+static int dissect(struct vars *const, struct subre *, chr *const, chr *const);
+static int concatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int alternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
+static inline int complicatedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int complicatedCapturingDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int complicatedConcatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int complicatedReversedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int complicatedBackrefDissect(struct vars *const, struct subre *const, chr *const, chr *const);
+static int complicatedAlternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
/* === rege_dfa.c === */
-static chr *longest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, int *));
-static chr *shortest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *));
-static chr *lastcold _ANSI_ARGS_((struct vars *, struct dfa *));
-static struct dfa *newdfa _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct smalldfa *));
-static VOID freedfa _ANSI_ARGS_((struct dfa *));
-static unsigned hash _ANSI_ARGS_((unsigned *, int));
-static struct sset *initialize _ANSI_ARGS_((struct vars *, struct dfa *, chr *));
-static struct sset *miss _ANSI_ARGS_((struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *));
-static int lacon _ANSI_ARGS_((struct vars *, struct cnfa *, chr *, pcolor));
-static struct sset *getvacant _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
-static struct sset *pickss _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
+static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const);
+static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const);
+static chr *lastCold(struct vars *const, struct dfa *const);
+static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *);
+static void freeDFA(struct dfa *const);
+static unsigned hash(unsigned *const, const int);
+static struct sset *initialize(struct vars *const, struct dfa *const, chr *const);
+static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const);
+static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor);
+static struct sset *getVacantSS(struct vars *const, struct dfa *const, chr *const, chr *const);
+static struct sset *pickNextSS(struct vars *const, struct dfa *const, chr *const, chr *const);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */
-
-
-
+
/*
- exec - match regular expression
- ^ int exec(regex_t *, CONST chr *, size_t, rm_detail_t *,
+ ^ int exec(regex_t *, const chr *, size_t, rm_detail_t *,
^ size_t, regmatch_t [], int);
*/
int
-exec(re, string, len, details, nmatch, pmatch, flags)
-regex_t *re;
-CONST chr *string;
-size_t len;
-rm_detail_t *details;
-size_t nmatch;
-regmatch_t pmatch[];
-int flags;
+exec(
+ regex_t *re,
+ const chr *string,
+ size_t len,
+ rm_detail_t *details,
+ size_t nmatch,
+ regmatch_t pmatch[],
+ int flags)
{
- struct vars var;
- register struct vars *v = &var;
- int st;
- size_t n;
- int backref;
-# define LOCALMAT 20
- regmatch_t mat[LOCALMAT];
-# define LOCALMEM 40
- regoff_t mem[LOCALMEM];
-
- /* sanity checks */
- if (re == NULL || string == NULL || re->re_magic != REMAGIC)
- return REG_INVARG;
- if (re->re_csize != sizeof(chr))
- return REG_MIXED;
-
- /* setup */
- v->re = re;
- v->g = (struct guts *)re->re_guts;
- if ((v->g->cflags&REG_EXPECT) && details == NULL)
- return REG_INVARG;
- if (v->g->info&REG_UIMPOSSIBLE)
- return REG_NOMATCH;
- backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
- v->eflags = flags;
- if (v->g->cflags&REG_NOSUB)
- nmatch = 0; /* override client */
- v->nmatch = nmatch;
- if (backref) {
- /* need work area */
- if (v->g->nsub + 1 <= LOCALMAT)
- v->pmatch = mat;
- else
- v->pmatch = (regmatch_t *)MALLOC((v->g->nsub + 1) *
- sizeof(regmatch_t));
- if (v->pmatch == NULL)
- return REG_ESPACE;
- v->nmatch = v->g->nsub + 1;
- } else
- v->pmatch = pmatch;
- v->details = details;
- v->start = (chr *)string;
- v->stop = (chr *)string + len;
- v->err = 0;
- if (backref) {
- /* need retry memory */
- assert(v->g->ntree >= 0);
- n = (size_t)v->g->ntree;
- if (n <= LOCALMEM)
- v->mem = mem;
- else
- v->mem = (regoff_t *)MALLOC(n*sizeof(regoff_t));
- if (v->mem == NULL) {
- if (v->pmatch != pmatch && v->pmatch != mat)
- FREE(v->pmatch);
- return REG_ESPACE;
- }
- } else
- v->mem = NULL;
-
- /* do it */
- assert(v->g->tree != NULL);
- if (backref)
- st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
- else
- st = find(v, &v->g->tree->cnfa, &v->g->cmap);
-
- /* copy (portion of) match vector over if necessary */
- if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
- zapsubs(pmatch, nmatch);
- n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
- memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+ AllocVars(v);
+ int st, backref;
+ size_t n;
+#define LOCALMAT 20
+ regmatch_t mat[LOCALMAT];
+#define LOCALMEM 40
+ regoff_t mem[LOCALMEM];
+
+ /*
+ * Sanity checks.
+ */
+
+ if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
+ FreeVars(v);
+ return REG_INVARG;
+ }
+ if (re->re_csize != sizeof(chr)) {
+ FreeVars(v);
+ return REG_MIXED;
+ }
+
+ /*
+ * Setup.
+ */
+
+ v->re = re;
+ v->g = (struct guts *)re->re_guts;
+ if ((v->g->cflags&REG_EXPECT) && details == NULL) {
+ FreeVars(v);
+ return REG_INVARG;
+ }
+ if (v->g->info&REG_UIMPOSSIBLE) {
+ FreeVars(v);
+ return REG_NOMATCH;
+ }
+ backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
+ v->eflags = flags;
+ if (v->g->cflags&REG_NOSUB) {
+ nmatch = 0; /* override client */
+ }
+ v->nmatch = nmatch;
+ if (backref) {
+ /*
+ * Need work area.
+ */
+
+ if (v->g->nsub + 1 <= LOCALMAT) {
+ v->pmatch = mat;
+ } else {
+ v->pmatch = (regmatch_t *)
+ MALLOC((v->g->nsub + 1) * sizeof(regmatch_t));
}
-
- /* clean up */
- if (v->pmatch != pmatch && v->pmatch != mat)
+ if (v->pmatch == NULL) {
+ FreeVars(v);
+ return REG_ESPACE;
+ }
+ v->nmatch = v->g->nsub + 1;
+ } else {
+ v->pmatch = pmatch;
+ }
+ v->details = details;
+ v->start = (chr *)string;
+ v->stop = (chr *)string + len;
+ v->err = 0;
+ if (backref) {
+ /*
+ * Need retry memory.
+ */
+
+ assert(v->g->ntree >= 0);
+ n = (size_t)v->g->ntree;
+ if (n <= LOCALMEM) {
+ v->mem = mem;
+ } else {
+ v->mem = (regoff_t *) MALLOC(n*sizeof(regoff_t));
+ }
+ if (v->mem == NULL) {
+ if (v->pmatch != pmatch && v->pmatch != mat) {
FREE(v->pmatch);
- if (v->mem != NULL && v->mem != mem)
- FREE(v->mem);
- return st;
+ }
+ FreeVars(v);
+ return REG_ESPACE;
+ }
+ } else {
+ v->mem = NULL;
+ }
+
+ /*
+ * Do it.
+ */
+
+ assert(v->g->tree != NULL);
+ if (backref) {
+ st = complicatedFind(v, &v->g->tree->cnfa, &v->g->cmap);
+ } else {
+ st = simpleFind(v, &v->g->tree->cnfa, &v->g->cmap);
+ }
+
+ /*
+ * Copy (portion of) match vector over if necessary.
+ */
+
+ if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
+ zapSubexpressions(pmatch, nmatch);
+ n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
+ memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+ }
+
+ /*
+ * Clean up.
+ */
+
+ if (v->pmatch != pmatch && v->pmatch != mat) {
+ FREE(v->pmatch);
+ }
+ if (v->mem != NULL && v->mem != mem) {
+ FREE(v->mem);
+ }
+ FreeVars(v);
+ return st;
}
-
+
/*
- - find - find a match for the main NFA (no-complications case)
- ^ static int find(struct vars *, struct cnfa *, struct colormap *);
+ - simpleFind - find a match for the main NFA (no-complications case)
+ ^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
*/
static int
-find(v, cnfa, cm)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
+simpleFind(
+ struct vars *const v,
+ struct cnfa *const cnfa,
+ struct colormap *const cm)
{
- struct dfa *s;
- struct dfa *d;
- chr *begin;
- chr *end = NULL;
- chr *cold;
- chr *open; /* open and close of range of possible starts */
- chr *close;
- int hitend;
- int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
-
- /* first, a shot with the search RE */
- s = newdfa(v, &v->g->search, cm, &v->dfa1);
- assert(!(ISERR() && s != NULL));
- NOERR();
- MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
- cold = NULL;
- close = shortest(v, s, v->start, v->start, v->stop, &cold, (int *)NULL);
- freedfa(s);
- NOERR();
- if (v->g->cflags&REG_EXPECT) {
- assert(v->details != NULL);
- if (cold != NULL)
- v->details->rm_extend.rm_so = OFF(cold);
- else
- v->details->rm_extend.rm_so = OFF(v->stop);
- v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ struct dfa *s, *d;
+ chr *begin, *end = NULL;
+ chr *cold;
+ chr *open, *close; /* Open and close of range of possible
+ * starts */
+ int hitend;
+ int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
+
+ /*
+ * First, a shot with the search RE.
+ */
+
+ s = newDFA(v, &v->g->search, cm, &v->dfa1);
+ assert(!(ISERR() && s != NULL));
+ NOERR();
+ MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
+ cold = NULL;
+ close = shortest(v, s, v->start, v->start, v->stop, &cold, NULL);
+ freeDFA(s);
+ NOERR();
+ if (v->g->cflags&REG_EXPECT) {
+ assert(v->details != NULL);
+ if (cold != NULL) {
+ v->details->rm_extend.rm_so = OFF(cold);
+ } else {
+ v->details->rm_extend.rm_so = OFF(v->stop);
+ }
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ if (close == NULL) { /* not found */
+ return REG_NOMATCH;
+ }
+ if (v->nmatch == 0) { /* found, don't need exact location */
+ return REG_OKAY;
+ }
+
+ /*
+ * Find starting point and match.
+ */
+
+ assert(cold != NULL);
+ open = cold;
+ cold = NULL;
+ MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
+ d = newDFA(v, cnfa, cm, &v->dfa1);
+ assert(!(ISERR() && d != NULL));
+ NOERR();
+ for (begin = open; begin <= close; begin++) {
+ MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
+ if (shorter) {
+ end = shortest(v, d, begin, begin, v->stop, NULL, &hitend);
+ } else {
+ end = longest(v, d, begin, v->stop, &hitend);
}
- if (close == NULL) /* not found */
- return REG_NOMATCH;
- if (v->nmatch == 0) /* found, don't need exact location */
- return REG_OKAY;
-
- /* find starting point and match */
- assert(cold != NULL);
- open = cold;
- cold = NULL;
- MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
- d = newdfa(v, cnfa, cm, &v->dfa1);
- assert(!(ISERR() && d != NULL));
NOERR();
- for (begin = open; begin <= close; begin++) {
- MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
- if (shorter)
- end = shortest(v, d, begin, begin, v->stop,
- (chr **)NULL, &hitend);
- else
- end = longest(v, d, begin, v->stop, &hitend);
- NOERR();
- if (hitend && cold == NULL)
- cold = begin;
- if (end != NULL)
- break; /* NOTE BREAK OUT */
+ if (hitend && cold == NULL) {
+ cold = begin;
}
- assert(end != NULL); /* search RE succeeded so loop should */
- freedfa(d);
-
- /* and pin down details */
- assert(v->nmatch > 0);
- v->pmatch[0].rm_so = OFF(begin);
- v->pmatch[0].rm_eo = OFF(end);
- if (v->g->cflags&REG_EXPECT) {
- if (cold != NULL)
- v->details->rm_extend.rm_so = OFF(cold);
- else
- v->details->rm_extend.rm_so = OFF(v->stop);
- v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ if (end != NULL) {
+ break; /* NOTE BREAK OUT */
}
- if (v->nmatch == 1) /* no need for submatches */
- return REG_OKAY;
+ }
+ assert(end != NULL); /* search RE succeeded so loop should */
+ freeDFA(d);
+
+ /*
+ * And pin down details.
+ */
+
+ assert(v->nmatch > 0);
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ if (v->g->cflags&REG_EXPECT) {
+ if (cold != NULL) {
+ v->details->rm_extend.rm_so = OFF(cold);
+ } else {
+ v->details->rm_extend.rm_so = OFF(v->stop);
+ }
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ if (v->nmatch == 1) { /* no need for submatches */
+ return REG_OKAY;
+ }
- /* submatches */
- zapsubs(v->pmatch, v->nmatch);
- return dissect(v, v->g->tree, begin, end);
-}
+ /*
+ * Submatches.
+ */
+ zapSubexpressions(v->pmatch, v->nmatch);
+ return dissect(v, v->g->tree, begin, end);
+}
+
/*
- - cfind - find a match for the main NFA (with complications)
- ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
+ - complicatedFind - find a match for the main NFA (with complications)
+ ^ static int complicatedFind(struct vars *, struct cnfa *, struct colormap *);
*/
static int
-cfind(v, cnfa, cm)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
+complicatedFind(
+ struct vars *const v,
+ struct cnfa *const cnfa,
+ struct colormap *const cm)
{
- struct dfa *s;
- struct dfa *d;
- chr *cold;
- int ret;
-
- s = newdfa(v, &v->g->search, cm, &v->dfa1);
- NOERR();
- d = newdfa(v, cnfa, cm, &v->dfa2);
- if (ISERR()) {
- assert(d == NULL);
- freedfa(s);
- return v->err;
- }
-
- ret = cfindloop(v, cnfa, cm, d, s, &cold);
-
- freedfa(d);
- freedfa(s);
- NOERR();
- if (v->g->cflags&REG_EXPECT) {
- assert(v->details != NULL);
- if (cold != NULL)
- v->details->rm_extend.rm_so = OFF(cold);
- else
- v->details->rm_extend.rm_so = OFF(v->stop);
- v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ struct dfa *s, *d;
+ chr *cold = NULL; /* silence gcc 4 warning */
+ int ret;
+
+ s = newDFA(v, &v->g->search, cm, &v->dfa1);
+ NOERR();
+ d = newDFA(v, cnfa, cm, &v->dfa2);
+ if (ISERR()) {
+ assert(d == NULL);
+ freeDFA(s);
+ return v->err;
+ }
+
+ ret = complicatedFindLoop(v, cnfa, cm, d, s, &cold);
+
+ freeDFA(d);
+ freeDFA(s);
+ NOERR();
+ if (v->g->cflags&REG_EXPECT) {
+ assert(v->details != NULL);
+ if (cold != NULL) {
+ v->details->rm_extend.rm_so = OFF(cold);
+ } else {
+ v->details->rm_extend.rm_so = OFF(v->stop);
}
- return ret;
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ return ret;
}
-
+
/*
- - cfindloop - the heart of cfind
- ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
+ - complicatedFindLoop - the heart of complicatedFind
+ ^ static int complicatedFindLoop(struct vars *, struct cnfa *, struct colormap *,
^ struct dfa *, struct dfa *, chr **);
*/
static int
-cfindloop(v, cnfa, cm, d, s, coldp)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
-struct dfa *d;
-struct dfa *s;
-chr **coldp; /* where to put coldstart pointer */
+complicatedFindLoop(
+ struct vars *const v,
+ struct cnfa *const cnfa,
+ struct colormap *const cm,
+ struct dfa *const d,
+ struct dfa *const s,
+ chr **const coldp) /* where to put coldstart pointer */
{
- chr *begin;
- chr *end;
- chr *cold;
- chr *open; /* open and close of range of possible starts */
- chr *close;
- chr *estart;
- chr *estop;
- int er;
- int shorter = v->g->tree->flags&SHORTER;
- int hitend;
-
- assert(d != NULL && s != NULL);
+ chr *begin, *end;
+ chr *cold;
+ chr *open, *close; /* Open and close of range of possible
+ * starts */
+ chr *estart, *estop;
+ int er, hitend;
+ int shorter = v->g->tree->flags&SHORTER;
+
+ assert(d != NULL && s != NULL);
+ cold = NULL;
+ close = v->start;
+ do {
+ MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
+ close = shortest(v, s, close, close, v->stop, &cold, NULL);
+ if (close == NULL) {
+ break; /* NOTE BREAK */
+ }
+ assert(cold != NULL);
+ open = cold;
cold = NULL;
- close = v->start;
- do {
- MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
- close = shortest(v, s, close, close, v->stop, &cold, (int *)NULL);
- if (close == NULL)
- break; /* NOTE BREAK */
- assert(cold != NULL);
- open = cold;
- cold = NULL;
- MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
- for (begin = open; begin <= close; begin++) {
- MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
- estart = begin;
- estop = v->stop;
- for (;;) {
- if (shorter)
- end = shortest(v, d, begin, estart,
- estop, (chr **)NULL, &hitend);
- else
- end = longest(v, d, begin, estop,
- &hitend);
- if (hitend && cold == NULL)
- cold = begin;
- if (end == NULL)
- break; /* NOTE BREAK OUT */
- MDEBUG(("tentative end %ld\n", LOFF(end)));
- zapsubs(v->pmatch, v->nmatch);
- zapmem(v, v->g->tree);
- er = cdissect(v, v->g->tree, begin, end);
- if (er == REG_OKAY) {
- if (v->nmatch > 0) {
- v->pmatch[0].rm_so = OFF(begin);
- v->pmatch[0].rm_eo = OFF(end);
- }
- *coldp = cold;
- return REG_OKAY;
- }
- if (er != REG_NOMATCH) {
- ERR(er);
- return er;
- }
- if ((shorter) ? end == estop : end == begin) {
- /* no point in trying again */
- *coldp = cold;
- return REG_NOMATCH;
- }
- /* go around and try again */
- if (shorter)
- estart = end + 1;
- else
- estop = end - 1;
- }
+ MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
+ for (begin = open; begin <= close; begin++) {
+ MDEBUG(("\ncomplicatedFind trying at %ld\n", LOFF(begin)));
+ estart = begin;
+ estop = v->stop;
+ for (;;) {
+ if (shorter) {
+ end = shortest(v, d, begin, estart, estop, NULL, &hitend);
+ } else {
+ end = longest(v, d, begin, estop, &hitend);
+ }
+ if (hitend && cold == NULL) {
+ cold = begin;
+ }
+ if (end == NULL) {
+ break; /* NOTE BREAK OUT */
}
- } while (close < v->stop);
- *coldp = cold;
- return REG_NOMATCH;
-}
+ MDEBUG(("tentative end %ld\n", LOFF(end)));
+ zapSubexpressions(v->pmatch, v->nmatch);
+ zapSubtree(v, v->g->tree);
+ er = complicatedDissect(v, v->g->tree, begin, end);
+ if (er == REG_OKAY) {
+ if (v->nmatch > 0) {
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ }
+ *coldp = cold;
+ return REG_OKAY;
+ }
+ if (er != REG_NOMATCH) {
+ ERR(er);
+ return er;
+ }
+ if ((shorter) ? end == estop : end == begin) {
+ break;
+ }
+ /*
+ * Go around and try again
+ */
+
+ if (shorter) {
+ estart = end + 1;
+ } else {
+ estop = end - 1;
+ }
+ }
+ }
+ } while (close < v->stop);
+
+ *coldp = cold;
+ return REG_NOMATCH;
+}
+
/*
- - zapsubs - initialize the subexpression matches to "no match"
- ^ static VOID zapsubs(regmatch_t *, size_t);
+ - zapSubexpressions - initialize the subexpression matches to "no match"
+ ^ static void zapSubexpressions(regmatch_t *, size_t);
*/
-static VOID
-zapsubs(p, n)
-regmatch_t *p;
-size_t n;
+static void
+zapSubexpressions(
+ regmatch_t *const p,
+ const size_t n)
{
- size_t i;
+ size_t i;
- for (i = n-1; i > 0; i--) {
- p[i].rm_so = -1;
- p[i].rm_eo = -1;
- }
+ for (i = n-1; i > 0; i--) {
+ p[i].rm_so = -1;
+ p[i].rm_eo = -1;
+ }
}
-
+
/*
- - zapmem - initialize the retry memory of a subtree to zeros
- ^ static VOID zapmem(struct vars *, struct subre *);
+ - zapSubtree - initialize the retry memory of a subtree to zeros
+ ^ static void zapSubtree(struct vars *, struct subre *);
*/
-static VOID
-zapmem(v, t)
-struct vars *v;
-struct subre *t;
+static void
+zapSubtree(
+ struct vars *const v,
+ struct subre *const t)
{
- if (t == NULL)
- return;
-
- assert(v->mem != NULL);
- v->mem[t->retry] = 0;
- if (t->op == '(') {
- assert(t->subno > 0);
- v->pmatch[t->subno].rm_so = -1;
- v->pmatch[t->subno].rm_eo = -1;
- }
-
- if (t->left != NULL)
- zapmem(v, t->left);
- if (t->right != NULL)
- zapmem(v, t->right);
+ if (t == NULL) {
+ return;
+ }
+
+ assert(v->mem != NULL);
+ v->mem[t->retry] = 0;
+ if (t->op == '(') {
+ assert(t->subno > 0);
+ v->pmatch[t->subno].rm_so = -1;
+ v->pmatch[t->subno].rm_eo = -1;
+ }
+
+ if (t->left != NULL) {
+ zapSubtree(v, t->left);
+ }
+ if (t->right != NULL) {
+ zapSubtree(v, t->right);
+ }
}
-
+
/*
- subset - set any subexpression relevant to a successful subre
- ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
+ ^ static void subset(struct vars *, struct subre *, chr *, chr *);
*/
-static VOID
-subset(v, sub, begin, end)
-struct vars *v;
-struct subre *sub;
-chr *begin;
-chr *end;
+static void
+subset(
+ struct vars *const v,
+ struct subre *const sub,
+ chr *const begin,
+ chr *const end)
{
- int n = sub->subno;
+ int n = sub->subno;
- assert(n > 0);
- if ((size_t)n >= v->nmatch)
- return;
+ assert(n > 0);
+ if ((size_t)n >= v->nmatch) {
+ return;
+ }
- MDEBUG(("setting %d\n", n));
- v->pmatch[n].rm_so = OFF(begin);
- v->pmatch[n].rm_eo = OFF(end);
+ MDEBUG(("setting %d\n", n));
+ v->pmatch[n].rm_so = OFF(begin);
+ v->pmatch[n].rm_eo = OFF(end);
}
-
+
/*
- dissect - determine subexpression matches (uncomplicated case)
^ static int dissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-dissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+dissect(
+ struct vars *const v,
+ struct subre *t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- assert(t != NULL);
- MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
-
- switch (t->op) {
- case '=': /* terminal node */
- assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- break;
- case '|': /* alternation */
- assert(t->left != NULL);
- return altdissect(v, t, begin, end);
- break;
- case 'b': /* back ref -- shouldn't be calling us! */
- return REG_ASSERT;
- break;
- case '.': /* concatenation */
- assert(t->left != NULL && t->right != NULL);
- return condissect(v, t, begin, end);
- break;
- case '(': /* capturing */
- assert(t->left != NULL && t->right == NULL);
- assert(t->subno > 0);
- subset(v, t, begin, end);
- return dissect(v, t->left, begin, end);
- break;
- default:
- return REG_ASSERT;
- break;
- }
+#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
+ restart:
+#endif
+ assert(t != NULL);
+ MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
+
+ switch (t->op) {
+ case '=': /* terminal node */
+ assert(t->left == NULL && t->right == NULL);
+ return REG_OKAY; /* no action, parent did the work */
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ return alternationDissect(v, t, begin, end);
+ case 'b': /* back ref -- shouldn't be calling us! */
+ return REG_ASSERT;
+ case '.': /* concatenation */
+ assert(t->left != NULL && t->right != NULL);
+ return concatenationDissect(v, t, begin, end);
+ case '(': /* capturing */
+ assert(t->left != NULL && t->right == NULL);
+ assert(t->subno > 0);
+ subset(v, t, begin, end);
+#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
+ t = t->left;
+ goto restart;
+#else
+ return dissect(v, t->left, begin, end);
+#endif
+ default:
+ return REG_ASSERT;
+ }
}
-
+
/*
- - condissect - determine concatenation subexpression matches (uncomplicated)
- ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
+ - concatenationDissect - determine concatenation subexpression matches
+ - (uncomplicated)
+ ^ static int concatenationDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-condissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+concatenationDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- struct dfa *d;
- struct dfa *d2;
- chr *mid;
- int i;
- int shorter = (t->left->flags&SHORTER) ? 1 : 0;
- chr *stop = (shorter) ? end : begin;
-
- assert(t->op == '.');
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
- d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- NOERR();
- d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
- if (ISERR()) {
- assert(d2 == NULL);
- freedfa(d);
- return v->err;
+ struct dfa *d, *d2;
+ chr *mid;
+ int i;
+ int shorter = (t->left->flags&SHORTER) ? 1 : 0;
+ chr *stop = (shorter) ? end : begin;
+
+ assert(t->op == '.');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->right != NULL && t->right->cnfa.nstates > 0);
+
+ d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+ NOERR();
+ d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
+ if (ISERR()) {
+ assert(d2 == NULL);
+ freeDFA(d);
+ return v->err;
+ }
+
+ /*
+ * Pick a tentative midpoint.
+ */
+
+ if (shorter) {
+ mid = shortest(v, d, begin, begin, end, NULL, NULL);
+ } else {
+ mid = longest(v, d, begin, end, NULL);
+ }
+ if (mid == NULL) {
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_ASSERT;
+ }
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+
+ /*
+ * Iterate until satisfaction or failure.
+ */
+
+ while (longest(v, d2, mid, end, NULL) != end) {
+ /*
+ * That midpoint didn't work, find a new one.
+ */
+
+ if (mid == stop) {
+ /*
+ * All possibilities exhausted!
+ */
+
+ MDEBUG(("no midpoint!\n"));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_ASSERT;
}
-
- /* pick a tentative midpoint */
- if (shorter)
- mid = shortest(v, d, begin, begin, end, (chr **)NULL,
- (int *)NULL);
- else
- mid = longest(v, d, begin, end, (int *)NULL);
- if (mid == NULL) {
- freedfa(d);
- freedfa(d2);
- return REG_ASSERT;
+ if (shorter) {
+ mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
+ } else {
+ mid = longest(v, d, begin, mid-1, NULL);
}
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-
- /* iterate until satisfaction or failure */
- while (longest(v, d2, mid, end, (int *)NULL) != end) {
- /* that midpoint didn't work, find a new one */
- if (mid == stop) {
- /* all possibilities exhausted! */
- MDEBUG(("no midpoint!\n"));
- freedfa(d);
- freedfa(d2);
- return REG_ASSERT;
- }
- if (shorter)
- mid = shortest(v, d, begin, mid+1, end, (chr **)NULL,
- (int *)NULL);
- else
- mid = longest(v, d, begin, mid-1, (int *)NULL);
- if (mid == NULL) {
- /* failed to find a new one! */
- MDEBUG(("failed midpoint!\n"));
- freedfa(d);
- freedfa(d2);
- return REG_ASSERT;
- }
- MDEBUG(("new midpoint %ld\n", LOFF(mid)));
+ if (mid == NULL) {
+ /*
+ * Failed to find a new one!
+ */
+
+ MDEBUG(("failed midpoint!\n"));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_ASSERT;
}
-
- /* satisfaction */
- MDEBUG(("successful\n"));
- freedfa(d);
- freedfa(d2);
- i = dissect(v, t->left, begin, mid);
- if (i != REG_OKAY)
- return i;
- return dissect(v, t->right, mid, end);
+ MDEBUG(("new midpoint %ld\n", LOFF(mid)));
+ }
+
+ /*
+ * Satisfaction.
+ */
+
+ MDEBUG(("successful\n"));
+ freeDFA(d);
+ freeDFA(d2);
+ i = dissect(v, t->left, begin, mid);
+ if (i != REG_OKAY) {
+ return i;
+ }
+ return dissect(v, t->right, mid, end);
}
-
+
/*
- - altdissect - determine alternative subexpression matches (uncomplicated)
- ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
+ - alternationDissect - determine alternative subexpression matches (uncomplicated)
+ ^ static int alternationDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-altdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+alternationDissect(
+ struct vars *const v,
+ struct subre *t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
+ int i;
+
+ assert(t != NULL);
+ assert(t->op == '|');
+
+ for (i = 0; t != NULL; t = t->right, i++) {
struct dfa *d;
- int i;
-
- assert(t != NULL);
- assert(t->op == '|');
-
- for (i = 0; t != NULL; t = t->right, i++) {
- MDEBUG(("trying %dth\n", i));
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- if (ISERR())
- return v->err;
- if (longest(v, d, begin, end, (int *)NULL) == end) {
- MDEBUG(("success\n"));
- freedfa(d);
- return dissect(v, t->left, begin, end);
- }
- freedfa(d);
+
+ MDEBUG(("trying %dth\n", i));
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+ if (ISERR()) {
+ return v->err;
+ }
+ if (longest(v, d, begin, end, NULL) == end) {
+ MDEBUG(("success\n"));
+ freeDFA(d);
+ return dissect(v, t->left, begin, end);
}
- return REG_ASSERT; /* none of them matched?!? */
+ freeDFA(d);
+ }
+ return REG_ASSERT; /* none of them matched?!? */
}
-
+
/*
- - cdissect - determine subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin,
- * plus 1 so that 0 uniquely means "clean slate".
- ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
+ - complicatedDissect - determine subexpression matches (with complications)
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
+ ^ static int complicatedDissect(struct vars *, struct subre *, chr *, chr *);
*/
-static int /* regexec return code */
-cdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+static inline int /* regexec return code */
+complicatedDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- int er;
-
- assert(t != NULL);
- MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
-
- switch (t->op) {
- case '=': /* terminal node */
- assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- break;
- case '|': /* alternation */
- assert(t->left != NULL);
- return caltdissect(v, t, begin, end);
- break;
- case 'b': /* back ref -- shouldn't be calling us! */
- assert(t->left == NULL && t->right == NULL);
- return cbrdissect(v, t, begin, end);
- break;
- case '.': /* concatenation */
- assert(t->left != NULL && t->right != NULL);
- return ccondissect(v, t, begin, end);
- break;
- case '(': /* capturing */
- assert(t->left != NULL && t->right == NULL);
- assert(t->subno > 0);
- er = cdissect(v, t->left, begin, end);
- if (er == REG_OKAY)
- subset(v, t, begin, end);
- return er;
- break;
- default:
- return REG_ASSERT;
- break;
- }
+ assert(t != NULL);
+ MDEBUG(("complicatedDissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
+
+ switch (t->op) {
+ case '=': /* terminal node */
+ assert(t->left == NULL && t->right == NULL);
+ return REG_OKAY; /* no action, parent did the work */
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ return complicatedAlternationDissect(v, t, begin, end);
+ case 'b': /* back ref -- shouldn't be calling us! */
+ assert(t->left == NULL && t->right == NULL);
+ return complicatedBackrefDissect(v, t, begin, end);
+ case '.': /* concatenation */
+ assert(t->left != NULL && t->right != NULL);
+ return complicatedConcatenationDissect(v, t, begin, end);
+ case '(': /* capturing */
+ assert(t->left != NULL && t->right == NULL);
+ assert(t->subno > 0);
+ return complicatedCapturingDissect(v, t, begin, end);
+ default:
+ return REG_ASSERT;
+ }
}
+static int /* regexec return code */
+complicatedCapturingDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
+{
+ int er = complicatedDissect(v, t->left, begin, end);
+
+ if (er == REG_OKAY) {
+ subset(v, t, begin, end);
+ }
+ return er;
+}
+
/*
- - ccondissect - concatenation subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin,
- * plus 1 so that 0 uniquely means "clean slate".
- ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
+ - complicatedConcatenationDissect - concatenation subexpression matches (with complications)
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
+ ^ static int complicatedConcatenationDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-ccondissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+complicatedConcatenationDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- struct dfa *d;
- struct dfa *d2;
- chr *mid;
- int er;
-
- assert(t->op == '.');
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
- if (t->left->flags&SHORTER) /* reverse scan */
- return crevdissect(v, t, begin, end);
-
- d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR())
- return v->err;
- d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freedfa(d);
- return v->err;
+ struct dfa *d, *d2;
+ chr *mid;
+
+ assert(t->op == '.');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->right != NULL && t->right->cnfa.nstates > 0);
+
+ if (t->left->flags&SHORTER) { /* reverse scan */
+ return complicatedReversedDissect(v, t, begin, end);
+ }
+
+ d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR()) {
+ return v->err;
+ }
+ d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR()) {
+ freeDFA(d);
+ return v->err;
+ }
+ MDEBUG(("cConcat %d\n", t->retry));
+
+ /*
+ * Pick a tentative midpoint.
+ */
+
+ if (v->mem[t->retry] == 0) {
+ mid = longest(v, d, begin, end, NULL);
+ if (mid == NULL) {
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
}
- MDEBUG(("cconcat %d\n", t->retry));
-
- /* pick a tentative midpoint */
- if (v->mem[t->retry] == 0) {
- mid = longest(v, d, begin, end, (int *)NULL);
- if (mid == NULL) {
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ } else {
+ mid = begin + (v->mem[t->retry] - 1);
+ MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ }
+
+ /*
+ * Iterate until satisfaction or failure.
+ */
+
+ for (;;) {
+ /*
+ * Try this midpoint on for size.
+ */
+
+ if (longest(v, d2, mid, end, NULL) == end) {
+ int er = complicatedDissect(v, t->left, begin, mid);
+
+ if (er == REG_OKAY) {
+ er = complicatedDissect(v, t->right, mid, end);
+ if (er == REG_OKAY) {
+ /*
+ * Satisfaction.
+ */
+
+ MDEBUG(("successful\n"));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_OKAY;
}
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ }
+ if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
+ freeDFA(d);
+ freeDFA(d2);
+ return er;
+ }
}
- /* iterate until satisfaction or failure */
- for (;;) {
- /* try this midpoint on for size */
- er = cdissect(v, t->left, begin, mid);
- if (er == REG_OKAY &&
- longest(v, d2, mid, end, (int *)NULL) == end &&
- (er = cdissect(v, t->right, mid, end)) ==
- REG_OKAY)
- break; /* NOTE BREAK OUT */
- if (er != REG_OKAY && er != REG_NOMATCH) {
- freedfa(d);
- freedfa(d2);
- return er;
- }
+ /*
+ * That midpoint didn't work, find a new one.
+ */
- /* that midpoint didn't work, find a new one */
- if (mid == begin) {
- /* all possibilities exhausted */
- MDEBUG(("%d no midpoint\n", t->retry));
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
- }
- mid = longest(v, d, begin, mid-1, (int *)NULL);
- if (mid == NULL) {
- /* failed to find a new one */
- MDEBUG(("%d failed midpoint\n", t->retry));
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapmem(v, t->left);
- zapmem(v, t->right);
- }
+ if (mid == begin) {
+ /*
+ * All possibilities exhausted.
+ */
- /* satisfaction */
- MDEBUG(("successful\n"));
- freedfa(d);
- freedfa(d2);
- return REG_OKAY;
+ MDEBUG(("%d no midpoint\n", t->retry));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
+ }
+ mid = longest(v, d, begin, mid-1, NULL);
+ if (mid == NULL) {
+ /*
+ * Failed to find a new one.
+ */
+
+ MDEBUG(("%d failed midpoint\n", t->retry));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
+ }
+ MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ zapSubtree(v, t->left);
+ zapSubtree(v, t->right);
+ }
}
-
+
/*
- - crevdissect - determine backref shortest-first subexpression matches
- * The retry memory stores the offset of the trial midpoint from begin,
- * plus 1 so that 0 uniquely means "clean slate".
- ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
+ - complicatedReversedDissect - determine backref shortest-first subexpression
+ - matches
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
+ ^ static int complicatedReversedDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-crevdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+complicatedReversedDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- struct dfa *d;
- struct dfa *d2;
- chr *mid;
- int er;
-
- assert(t->op == '.');
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- assert(t->right != NULL && t->right->cnfa.nstates > 0);
- assert(t->left->flags&SHORTER);
-
- /* concatenation -- need to split the substring between parts */
- d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR())
- return v->err;
- d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freedfa(d);
- return v->err;
+ struct dfa *d, *d2;
+ chr *mid;
+
+ assert(t->op == '.');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->right != NULL && t->right->cnfa.nstates > 0);
+ assert(t->left->flags&SHORTER);
+
+ /*
+ * Concatenation -- need to split the substring between parts.
+ */
+
+ d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR()) {
+ return v->err;
+ }
+ d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR()) {
+ freeDFA(d);
+ return v->err;
+ }
+ MDEBUG(("cRev %d\n", t->retry));
+
+ /*
+ * Pick a tentative midpoint.
+ */
+
+ if (v->mem[t->retry] == 0) {
+ mid = shortest(v, d, begin, begin, end, NULL, NULL);
+ if (mid == NULL) {
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
}
- MDEBUG(("crev %d\n", t->retry));
-
- /* pick a tentative midpoint */
- if (v->mem[t->retry] == 0) {
- mid = shortest(v, d, begin, begin, end, (chr **)NULL, (int *)NULL);
- if (mid == NULL) {
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ } else {
+ mid = begin + (v->mem[t->retry] - 1);
+ MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ }
+
+ /*
+ * Iterate until satisfaction or failure.
+ */
+
+ for (;;) {
+ /*
+ * Try this midpoint on for size.
+ */
+
+ if (longest(v, d2, mid, end, NULL) == end) {
+ int er = complicatedDissect(v, t->left, begin, mid);
+
+ if (er == REG_OKAY) {
+ er = complicatedDissect(v, t->right, mid, end);
+ if (er == REG_OKAY) {
+ /*
+ * Satisfaction.
+ */
+
+ MDEBUG(("successful\n"));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_OKAY;
}
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ }
+ if (er != REG_OKAY && er != REG_NOMATCH) {
+ freeDFA(d);
+ freeDFA(d2);
+ return er;
+ }
}
- /* iterate until satisfaction or failure */
- for (;;) {
- /* try this midpoint on for size */
- er = cdissect(v, t->left, begin, mid);
- if (er == REG_OKAY &&
- longest(v, d2, mid, end, (int *)NULL) == end &&
- (er = cdissect(v, t->right, mid, end)) ==
- REG_OKAY)
- break; /* NOTE BREAK OUT */
- if (er != REG_OKAY && er != REG_NOMATCH) {
- freedfa(d);
- freedfa(d2);
- return er;
- }
+ /*
+ * That midpoint didn't work, find a new one.
+ */
- /* that midpoint didn't work, find a new one */
- if (mid == end) {
- /* all possibilities exhausted */
- MDEBUG(("%d no midpoint\n", t->retry));
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
- }
- mid = shortest(v, d, begin, mid+1, end, (chr **)NULL, (int *)NULL);
- if (mid == NULL) {
- /* failed to find a new one */
- MDEBUG(("%d failed midpoint\n", t->retry));
- freedfa(d);
- freedfa(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapmem(v, t->left);
- zapmem(v, t->right);
- }
+ if (mid == end) {
+ /*
+ * All possibilities exhausted.
+ */
- /* satisfaction */
- MDEBUG(("successful\n"));
- freedfa(d);
- freedfa(d2);
- return REG_OKAY;
+ MDEBUG(("%d no midpoint\n", t->retry));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
+ }
+ mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
+ if (mid == NULL) {
+ /*
+ * Failed to find a new one.
+ */
+
+ MDEBUG(("%d failed midpoint\n", t->retry));
+ freeDFA(d);
+ freeDFA(d2);
+ return REG_NOMATCH;
+ }
+ MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ zapSubtree(v, t->left);
+ zapSubtree(v, t->right);
+ }
}
-
+
/*
- - cbrdissect - determine backref subexpression matches
- ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
+ - complicatedBackrefDissect - determine backref subexpression matches
+ ^ static int complicatedBackrefDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-cbrdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+complicatedBackrefDissect(
+ struct vars *const v,
+ struct subre *const t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- int i;
- int n = t->subno;
- size_t len;
- chr *paren;
- chr *p;
- chr *stop;
- int min = t->min;
- int max = t->max;
-
- assert(t != NULL);
- assert(t->op == 'b');
- assert(n >= 0);
- assert((size_t)n < v->nmatch);
-
- MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
-
- if (v->pmatch[n].rm_so == -1)
- return REG_NOMATCH;
- paren = v->start + v->pmatch[n].rm_so;
- len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
-
- /* no room to maneuver -- retries are pointless */
- if (v->mem[t->retry])
- return REG_NOMATCH;
- v->mem[t->retry] = 1;
-
- /* special-case zero-length string */
- if (len == 0) {
- if (begin == end)
- return REG_OKAY;
- return REG_NOMATCH;
+ int i, n = t->subno, min = t->min, max = t->max;
+ chr *paren, *p, *stop;
+ size_t len;
+
+ assert(t != NULL);
+ assert(t->op == 'b');
+ assert(n >= 0);
+ assert((size_t)n < v->nmatch);
+
+ MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
+
+ if (v->pmatch[n].rm_so == -1) {
+ return REG_NOMATCH;
+ }
+ paren = v->start + v->pmatch[n].rm_so;
+ len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
+
+ /*
+ * No room to maneuver -- retries are pointless.
+ */
+
+ if (v->mem[t->retry]) {
+ return REG_NOMATCH;
+ }
+ v->mem[t->retry] = 1;
+
+ /*
+ * Special-case zero-length string.
+ */
+
+ if (len == 0) {
+ if (begin == end) {
+ return REG_OKAY;
}
+ return REG_NOMATCH;
+ }
- /* and too-short string */
- assert(end >= begin);
- if ((size_t)(end - begin) < len)
- return REG_NOMATCH;
- stop = end - len;
-
- /* count occurrences */
- i = 0;
- for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
- if ((*v->g->compare)(paren, p, len) != 0)
- break;
- i++;
+ /*
+ * And too-short string.
+ */
+
+ assert(end >= begin);
+ if ((size_t)(end - begin) < len) {
+ return REG_NOMATCH;
+ }
+ stop = end - len;
+
+ /*
+ * Count occurrences.
+ */
+
+ i = 0;
+ for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
+ if (v->g->compare(paren, p, len) != 0) {
+ break;
}
- MDEBUG(("cbackref found %d\n", i));
-
- /* and sort it out */
- if (p != end) /* didn't consume all of it */
- return REG_NOMATCH;
- if (min <= i && (i <= max || max == INFINITY))
- return REG_OKAY;
- return REG_NOMATCH; /* out of range */
-}
+ i++;
+ }
+ MDEBUG(("cbackref found %d\n", i));
+
+ /*
+ * And sort it out.
+ */
+ if (p != end) { /* didn't consume all of it */
+ return REG_NOMATCH;
+ }
+ if (min <= i && (i <= max || max == INFINITY)) {
+ return REG_OKAY;
+ }
+ return REG_NOMATCH; /* out of range */
+}
+
/*
- - caltdissect - determine alternative subexpression matches (w. complications)
- ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ - complicatedAlternationDissect - determine alternative subexpression matches (w.
+ - complications)
+ ^ static int complicatedAlternationDissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-caltdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin; /* beginning of relevant substring */
-chr *end; /* end of same */
+complicatedAlternationDissect(
+ struct vars *const v,
+ struct subre *t,
+ chr *const begin, /* beginning of relevant substring */
+ chr *const end) /* end of same */
{
- struct dfa *d;
- int er;
-# define UNTRIED 0 /* not yet tried at all */
-# define TRYING 1 /* top matched, trying submatches */
-# define TRIED 2 /* top didn't match or submatches exhausted */
-
- if (t == NULL)
- return REG_NOMATCH;
- assert(t->op == '|');
- if (v->mem[t->retry] == TRIED)
- return caltdissect(v, t->right, begin, end);
-
- MDEBUG(("calt n%d\n", t->retry));
- assert(t->left != NULL);
+ int er;
+#define UNTRIED 0 /* not yet tried at all */
+#define TRYING 1 /* top matched, trying submatches */
+#define TRIED 2 /* top didn't match or submatches exhausted */
+
+#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
+ if (0) {
+ doRight:
+ t = t->right;
+ }
+#endif
+ if (t == NULL) {
+ return REG_NOMATCH;
+ }
+ assert(t->op == '|');
+ if (v->mem[t->retry] == TRIED) {
+ goto doRight;
+ }
- if (v->mem[t->retry] == UNTRIED) {
- d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR())
- return v->err;
- if (longest(v, d, begin, end, (int *)NULL) != end) {
- freedfa(d);
- v->mem[t->retry] = TRIED;
- return caltdissect(v, t->right, begin, end);
- }
- freedfa(d);
- MDEBUG(("calt matched\n"));
- v->mem[t->retry] = TRYING;
- }
+ MDEBUG(("cAlt n%d\n", t->retry));
+ assert(t->left != NULL);
- er = cdissect(v, t->left, begin, end);
- if (er != REG_NOMATCH)
- return er;
+ if (v->mem[t->retry] == UNTRIED) {
+ struct dfa *d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- v->mem[t->retry] = TRIED;
- return caltdissect(v, t->right, begin, end);
+ if (ISERR()) {
+ return v->err;
+ }
+ if (longest(v, d, begin, end, NULL) != end) {
+ freeDFA(d);
+ v->mem[t->retry] = TRIED;
+ goto doRight;
+ }
+ freeDFA(d);
+ MDEBUG(("cAlt matched\n"));
+ v->mem[t->retry] = TRYING;
+ }
+
+ er = complicatedDissect(v, t->left, begin, end);
+ if (er != REG_NOMATCH) {
+ return er;
+ }
+
+ v->mem[t->retry] = TRIED;
+#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
+ goto doRight;
+#else
+ doRight:
+ return complicatedAlternationDissect(v, t->right, begin, end);
+#endif
}
-
-
#include "rege_dfa.c"
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regfree.c b/generic/regfree.c
index 17a7389..b0aaa70 100644
--- a/generic/regfree.c
+++ b/generic/regfree.c
@@ -2,20 +2,20 @@
* regfree - free an RE
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -27,13 +27,11 @@
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
- *
- *
- * You might think that this could be incorporated into regcomp.c, and
- * that would be a reasonable idea... except that this is a generic
- * function (with a generic name), applicable to all compiled REs
- * regardless of the size of their characters, whereas the stuff in
- * regcomp.c gets compiled once per character size.
+ * You might think that this could be incorporated into regcomp.c, and that
+ * would be a reasonable idea... except that this is a generic function (with
+ * a generic name), applicable to all compiled REs regardless of the size of
+ * their characters, whereas the stuff in regcomp.c gets compiled once per
+ * character size.
*/
#include "regguts.h"
@@ -43,11 +41,20 @@
*
* Ignoring invocation with NULL is a convenience.
*/
-VOID
-regfree(re)
-regex_t *re;
+void
+regfree(
+ regex_t *re)
{
- if (re == NULL)
- return;
- (*((struct fns *)re->re_fns)->free)(re);
+ if (re == NULL) {
+ return;
+ }
+ (*((struct fns *)re->re_fns)->free)(re);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regfronts.c b/generic/regfronts.c
index 82f48e2..088a640 100644
--- a/generic/regfronts.c
+++ b/generic/regfronts.c
@@ -1,24 +1,24 @@
/*
* regcomp and regexec - front ends to re_ routines
*
- * Mostly for implementation of backward-compatibility kludges. Note
- * that these routines exist ONLY in char versions.
+ * Mostly for implementation of backward-compatibility kludges. Note that
+ * these routines exist ONLY in char versions.
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -29,55 +29,63 @@
* 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.
- *
*/
#include "regguts.h"
-
+
/*
- regcomp - compile regular expression
*/
int
-regcomp(re, str, flags)
-regex_t *re;
-CONST char *str;
-int flags;
+regcomp(
+ regex_t *re,
+ const char *str,
+ int flags)
{
- size_t len;
- int f = flags;
+ size_t len;
+ int f = flags;
- if (f&REG_PEND) {
- len = re->re_endp - str;
- f &= ~REG_PEND;
- } else
- len = strlen(str);
+ if (f&REG_PEND) {
+ len = re->re_endp - str;
+ f &= ~REG_PEND;
+ } else {
+ len = strlen(str);
+ }
- return re_comp(re, str, len, f);
+ return re_comp(re, str, len, f);
}
-
+
/*
- regexec - execute regular expression
*/
int
-regexec(re, str, nmatch, pmatch, flags)
-regex_t *re;
-CONST char *str;
-size_t nmatch;
-regmatch_t pmatch[];
-int flags;
+regexec(
+ regex_t *re,
+ const char *str,
+ size_t nmatch,
+ regmatch_t pmatch[],
+ int flags)
{
- CONST char *start;
- size_t len;
- int f = flags;
+ const char *start;
+ size_t len;
+ int f = flags;
- if (f&REG_STARTEND) {
- start = str + pmatch[0].rm_so;
- len = pmatch[0].rm_eo - pmatch[0].rm_so;
- f &= ~REG_STARTEND;
- } else {
- start = str;
- len = strlen(str);
- }
+ if (f & REG_STARTEND) {
+ start = str + pmatch[0].rm_so;
+ len = pmatch[0].rm_eo - pmatch[0].rm_so;
+ f &= ~REG_STARTEND;
+ } else {
+ start = str;
+ len = strlen(str);
+ }
- return re_exec(re, start, len, nmatch, pmatch, f);
+ return re_exec(re, start, len, nmatch, pmatch, f);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regguts.h b/generic/regguts.h
index 36e5092..b478e4c 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -2,20 +2,20 @@
* Internal interface definitions, etc., for the reg package
*
* Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
- *
+ *
* Development of this software was funded, in part, by Cray Research Inc.,
* UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
* Corporation, none of whom are responsible for the results. The author
- * thanks all of them.
- *
+ * thanks all of them.
+ *
* Redistribution and use in source and binary forms -- with or without
* modification -- are permitted for any purpose, provided that
* redistributions in source form retain this entire copyright notice and
* indicate the origin and nature of any modifications.
- *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- *
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
* THIS SOFTWARE IS PROVIDED ``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
@@ -28,58 +28,42 @@
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-
-
/*
- * Environmental customization. It should not (I hope) be necessary to
- * alter the file you are now reading -- regcustom.h should handle it all,
- * given care here and elsewhere.
+ * Environmental customization. It should not (I hope) be necessary to alter
+ * the file you are now reading -- regcustom.h should handle it all, given
+ * care here and elsewhere.
*/
#include "regcustom.h"
-
-
/*
* Things that regcustom.h might override.
*/
-/* standard header files (NULL is a reasonable indicator for them) */
-#ifndef NULL
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <limits.h>
-#include <string.h>
-#endif
-
/* assertions */
#ifndef assert
-# ifndef REG_DEBUG
-# define NDEBUG /* no assertions */
-# endif
+#ifndef REG_DEBUG
+#ifndef NDEBUG
+#define NDEBUG /* no assertions */
+#endif
+#endif /* !REG_DEBUG */
#include <assert.h>
#endif
/* voids */
#ifndef VOID
-#define VOID void /* for function return values */
+#define VOID void /* for function return values */
#endif
#ifndef DISCARD
-#define DISCARD VOID /* for throwing values away */
+#define DISCARD void /* for throwing values away */
#endif
#ifndef PVOID
-#define PVOID VOID * /* generic pointer */
+#define PVOID void * /* generic pointer */
#endif
#ifndef VS
-#define VS(x) ((PVOID)(x)) /* cast something to generic ptr */
+#define VS(x) ((void*)(x)) /* cast something to generic ptr */
#endif
#ifndef NOPARMS
-#define NOPARMS VOID /* for empty parm lists */
-#endif
-
-/* const */
-#ifndef CONST
-#define CONST const /* for old compilers, might be empty */
+#define NOPARMS void /* for empty parm lists */
#endif
/* function-pointer declarator */
@@ -103,15 +87,10 @@
#endif
/* want size of a char in bits, and max value in bounded quantifiers */
-#ifndef CHAR_BIT
-#include <limits.h>
-#endif
#ifndef _POSIX2_RE_DUP_MAX
-#define _POSIX2_RE_DUP_MAX 255 /* normally from <limits.h> */
+#define _POSIX2_RE_DUP_MAX 255 /* normally from <limits.h> */
#endif
-
-
/*
* misc
*/
@@ -124,8 +103,6 @@
#define REMAGIC 0xfed7 /* magic number for main struct */
-
-
/*
* debugging facilities
*/
@@ -139,8 +116,6 @@
#define MDEBUG(arglist) {}
#endif
-
-
/*
* bitmap manipulation
*/
@@ -148,14 +123,13 @@
#define BSET(uv, sn) ((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS))
#define ISBSET(uv, sn) ((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS)))
-
-
/*
- * We dissect a chr into byts for colormap table indexing. Here we define
- * a byt, which will be the same as a byte on most machines... The exact
- * size of a byt is not critical, but about 8 bits is good, and extraction
- * of 8-bit chunks is sometimes especially fast.
+ * We dissect a chr into byts for colormap table indexing. Here we define a
+ * byt, which will be the same as a byte on most machines... The exact size of
+ * a byt is not critical, but about 8 bits is good, and extraction of 8-bit
+ * chunks is sometimes especially fast.
*/
+
#ifndef BYTBITS
#define BYTBITS 8 /* bits in a byt */
#endif
@@ -164,69 +138,67 @@
#define NBYTS ((CHRBITS+BYTBITS-1)/BYTBITS)
/* the definition of GETCOLOR(), below, assumes NBYTS <= 4 */
-
-
/*
* As soon as possible, we map chrs into equivalence classes -- "colors" --
* which are of much more manageable number.
*/
+
typedef short color; /* colors of characters */
typedef int pcolor; /* what color promotes to */
+#define MAX_COLOR SHRT_MAX /* max color value */
#define COLORLESS (-1) /* impossible color */
#define WHITE 0 /* default color, parent of all others */
-
-
/*
- * A colormap is a tree -- more precisely, a DAG -- indexed at each level
- * by a byt of the chr, to map the chr to a color efficiently. Because
- * lower sections of the tree can be shared, it can exploit the usual
- * sparseness of such a mapping table. The tree is always NBYTS levels
- * deep (in the past it was shallower during construction but was "filled"
- * to full depth at the end of that); areas that are unaltered as yet point
- * to "fill blocks" which are entirely WHITE in color.
+ * A colormap is a tree -- more precisely, a DAG -- indexed at each level by a
+ * byt of the chr, to map the chr to a color efficiently. Because lower
+ * sections of the tree can be shared, it can exploit the usual sparseness of
+ * such a mapping table. The tree is always NBYTS levels deep (in the past it
+ * was shallower during construction but was "filled" to full depth at the end
+ * of that); areas that are unaltered as yet point to "fill blocks" which are
+ * entirely WHITE in color.
*/
/* the tree itself */
struct colors {
- color ccolor[BYTTAB];
+ color ccolor[BYTTAB];
};
struct ptrs {
- union tree *pptr[BYTTAB];
+ union tree *pptr[BYTTAB];
};
union tree {
- struct colors colors;
- struct ptrs ptrs;
+ struct colors colors;
+ struct ptrs ptrs;
};
#define tcolor colors.ccolor
#define tptr ptrs.pptr
-/* internal per-color structure for the color machinery */
+/* Internal per-color descriptor structure for the color machinery */
struct colordesc {
- uchr nchrs; /* number of chars of this color */
- color sub; /* open subcolor (if any); free chain ptr */
-# define NOSUB COLORLESS
- struct arc *arcs; /* color chain */
- int flags;
-# define FREECOL 01 /* currently free */
-# define PSEUDO 02 /* pseudocolor, no real chars */
-# define UNUSEDCOLOR(cd) ((cd)->flags&FREECOL)
- union tree *block; /* block of solid color, if any */
+ uchr nchrs; /* number of chars of this color */
+ color sub; /* open subcolor (if any); free chain ptr */
+#define NOSUB COLORLESS
+ struct arc *arcs; /* color chain */
+ int flags;
+#define FREECOL 01 /* currently free */
+#define PSEUDO 02 /* pseudocolor, no real chars */
+#define UNUSEDCOLOR(cd) ((cd)->flags&FREECOL)
+ union tree *block; /* block of solid color, if any */
};
/* the color map itself */
struct colormap {
- int magic;
-# define CMMAGIC 0x876
- struct vars *v; /* for compile error reporting */
- size_t ncds; /* number of colordescs */
- size_t max; /* highest in use */
- color free; /* beginning of free chain (if non-0) */
- struct colordesc *cd;
-# define CDEND(cm) (&(cm)->cd[(cm)->max + 1])
-# define NINLINECDS ((size_t)10)
- struct colordesc cdspace[NINLINECDS];
- union tree tree[NBYTS]; /* tree top, plus fill blocks */
+ int magic;
+#define CMMAGIC 0x876
+ struct vars *v; /* for compile error reporting */
+ size_t ncds; /* number of colordescs */
+ size_t max; /* highest in use */
+ color free; /* beginning of free chain (if non-0) */
+ struct colordesc *cd;
+#define CDEND(cm) (&(cm)->cd[(cm)->max + 1])
+#define NINLINECDS ((size_t)10)
+ struct colordesc cdspace[NINLINECDS];
+ union tree tree[NBYTS]; /* tree top, plus fill blocks */
};
/* optimization magic to do fast chr->color mapping */
@@ -245,174 +217,196 @@ struct colormap {
#define GETCOLOR(cm, c) ((cm)->tree->tptr[B3(c)]->tptr[B2(c)]->tptr[B1(c)]->tcolor[B0(c)])
#endif
-
-
/*
* Interface definitions for locale-interface functions in locale.c.
- * Multi-character collating elements (MCCEs) cause most of the trouble.
*/
+
+/* Representation of a set of characters. */
struct cvec {
- int nchrs; /* number of chrs */
- int chrspace; /* number of chrs possible */
- chr *chrs; /* pointer to vector of chrs */
- int nranges; /* number of ranges (chr pairs) */
- int rangespace; /* number of chrs possible */
- chr *ranges; /* pointer to vector of chr pairs */
- int nmcces; /* number of MCCEs */
- int mccespace; /* number of MCCEs possible */
- int nmccechrs; /* number of chrs used for MCCEs */
- chr *mcces[1]; /* pointers to 0-terminated MCCEs */
- /* and both batches of chrs are on the end */
+ int nchrs; /* number of chrs */
+ int chrspace; /* number of chrs possible */
+ chr *chrs; /* pointer to vector of chrs */
+ int nranges; /* number of ranges (chr pairs) */
+ int rangespace; /* number of chrs possible */
+ chr *ranges; /* pointer to vector of chr pairs */
};
-/* caution: this value cannot be changed easily */
-#define MAXMCCE 2 /* length of longest MCCE */
-
-
-
/*
- * definitions for NFA internal representation
+ * definitions for non-deterministic finite autmaton (NFA) internal
+ * representation
*
- * Having a "from" pointer within each arc may seem redundant, but it
- * saves a lot of hassle.
+ * Having a "from" pointer within each arc may seem redundant, but it saves a
+ * lot of hassle.
*/
+
struct state;
struct arc {
- int type;
-# define ARCFREE '\0'
- color co;
- struct state *from; /* where it's from (and contained within) */
- struct state *to; /* where it's to */
- struct arc *outchain; /* *from's outs chain or free chain */
-# define freechain outchain
- struct arc *inchain; /* *to's ins chain */
- struct arc *colorchain; /* color's arc chain */
+ int type;
+#define ARCFREE '\0'
+ color co;
+ struct state *from; /* where it's from (and contained within) */
+ struct state *to; /* where it's to */
+ struct arc *outchain; /* *from's outs chain or free chain */
+#define freechain outchain
+ struct arc *inchain; /* *to's ins chain */
+ struct arc *colorchain; /* color's arc chain */
+ struct arc *colorchainRev; /* back-link in color's arc chain */
};
struct arcbatch { /* for bulk allocation of arcs */
- struct arcbatch *next;
-# define ABSIZE 10
- struct arc a[ABSIZE];
+ struct arcbatch *next;
+#define ABSIZE 10
+ struct arc a[ABSIZE];
};
struct state {
- int no;
-# define FREESTATE (-1)
- char flag; /* marks special states */
- int nins; /* number of inarcs */
- struct arc *ins; /* chain of inarcs */
- int nouts; /* number of outarcs */
- struct arc *outs; /* chain of outarcs */
- struct arc *free; /* chain of free arcs */
- struct state *tmp; /* temporary for traversal algorithms */
- struct state *next; /* chain for traversing all */
- struct state *prev; /* back chain */
- struct arcbatch oas; /* first arcbatch, avoid malloc in easy case */
- int noas; /* number of arcs used in first arcbatch */
+ int no;
+#define FREESTATE (-1)
+ char flag; /* marks special states */
+ int nins; /* number of inarcs */
+ struct arc *ins; /* chain of inarcs */
+ int nouts; /* number of outarcs */
+ struct arc *outs; /* chain of outarcs */
+ struct arc *free; /* chain of free arcs */
+ struct state *tmp; /* temporary for traversal algorithms */
+ struct state *next; /* chain for traversing all */
+ struct state *prev; /* back chain */
+ struct arcbatch oas; /* first arcbatch, avoid malloc in easy case */
+ int noas; /* number of arcs used in first arcbatch */
};
struct nfa {
- struct state *pre; /* pre-initial state */
- struct state *init; /* initial state */
- struct state *final; /* final state */
- struct state *post; /* post-final state */
- int nstates; /* for numbering states */
- struct state *states; /* state-chain header */
- struct state *slast; /* tail of the chain */
- struct state *free; /* free list */
- struct colormap *cm; /* the color map */
- color bos[2]; /* colors, if any, assigned to BOS and BOL */
- color eos[2]; /* colors, if any, assigned to EOS and EOL */
- struct vars *v; /* simplifies compile error reporting */
- struct nfa *parent; /* parent NFA, if any */
+ struct state *pre; /* pre-initial state */
+ struct state *init; /* initial state */
+ struct state *final; /* final state */
+ struct state *post; /* post-final state */
+ int nstates; /* for numbering states */
+ struct state *states; /* state-chain header */
+ struct state *slast; /* tail of the chain */
+ struct state *free; /* free list */
+ struct colormap *cm; /* the color map */
+ color bos[2]; /* colors, if any, assigned to BOS and BOL */
+ color eos[2]; /* colors, if any, assigned to EOS and EOL */
+ size_t size; /* Current NFA size; differs from nstates as
+ * it also counts the number of states created
+ * by children of this state. */
+ struct vars *v; /* simplifies compile error reporting */
+ struct nfa *parent; /* parent NFA, if any */
};
-
-
/*
* definitions for compacted NFA
*/
+
struct carc {
- color co; /* COLORLESS is list terminator */
- int to; /* state number */
+ color co; /* COLORLESS is list terminator */
+ int to; /* state number */
};
struct cnfa {
- int nstates; /* number of states */
- int ncolors; /* number of colors */
- int flags;
-# define HASLACONS 01 /* uses lookahead constraints */
- int pre; /* setup state number */
- int post; /* teardown state number */
- color bos[2]; /* colors, if any, assigned to BOS and BOL */
- color eos[2]; /* colors, if any, assigned to EOS and EOL */
- struct carc **states; /* vector of pointers to outarc lists */
- struct carc *arcs; /* the area for the lists */
+ int nstates; /* number of states */
+ int ncolors; /* number of colors */
+ int flags;
+#define HASLACONS 01 /* uses lookahead constraints */
+ int pre; /* setup state number */
+ int post; /* teardown state number */
+ color bos[2]; /* colors, if any, assigned to BOS and BOL */
+ color eos[2]; /* colors, if any, assigned to EOS and EOL */
+ struct carc **states; /* vector of pointers to outarc lists */
+ struct carc *arcs; /* the area for the lists */
};
#define ZAPCNFA(cnfa) ((cnfa).nstates = 0)
#define NULLCNFA(cnfa) ((cnfa).nstates == 0)
+/*
+ * Used to limit the maximum NFA size to something sane. [Bug 1810264]
+ */
+#ifndef REG_MAX_STATES
+# define REG_MAX_STATES 100000
+#endif
/*
* subexpression tree
*/
+
struct subre {
- char op; /* '|', '.' (concat), 'b' (backref), '(', '=' */
- char flags;
-# define LONGER 01 /* prefers longer match */
-# define SHORTER 02 /* prefers shorter match */
-# define MIXED 04 /* mixed preference below */
-# define CAP 010 /* capturing parens below */
-# define BACKR 020 /* back reference below */
-# define INUSE 0100 /* in use in final tree */
-# define LOCAL 03 /* bits which may not propagate up */
-# define LMIX(f) ((f)<<2) /* LONGER -> MIXED */
-# define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */
-# define UP(f) (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
-# define MESSY(f) ((f)&(MIXED|CAP|BACKR))
-# define PREF(f) ((f)&LOCAL)
-# define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
-# define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2))
- short retry; /* index into retry memory */
- int subno; /* subexpression number (for 'b' and '(') */
- short min; /* min repetitions, for backref only */
- short max; /* max repetitions, for backref only */
- struct subre *left; /* left child, if any (also freelist chain) */
- struct subre *right; /* right child, if any */
- struct state *begin; /* outarcs from here... */
- struct state *end; /* ...ending in inarcs here */
- struct cnfa cnfa; /* compacted NFA, if any */
- struct subre *chain; /* for bookkeeping and error cleanup */
+ char op; /* '|', '.' (concat), 'b' (backref), '(',
+ * '=' */
+ char flags;
+#define LONGER 01 /* prefers longer match */
+#define SHORTER 02 /* prefers shorter match */
+#define MIXED 04 /* mixed preference below */
+#define CAP 010 /* capturing parens below */
+#define BACKR 020 /* back reference below */
+#define INUSE 0100 /* in use in final tree */
+#define NOPROP 03 /* bits which may not propagate up */
+#define LMIX(f) ((f)<<2) /* LONGER -> MIXED */
+#define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */
+#define UP(f) (((f)&~NOPROP) | (LMIX(f) & SMIX(f) & MIXED))
+#define MESSY(f) ((f)&(MIXED|CAP|BACKR))
+#define PREF(f) ((f)&NOPROP)
+#define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
+#define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2))
+ short retry; /* index into retry memory */
+ int subno; /* subexpression number (for 'b' and '(') */
+ short min; /* min repetitions, for backref only */
+ short max; /* max repetitions, for backref only */
+ struct subre *left; /* left child, if any (also freelist chain) */
+ struct subre *right; /* right child, if any */
+ struct state *begin; /* outarcs from here... */
+ struct state *end; /* ...ending in inarcs here */
+ struct cnfa cnfa; /* compacted NFA, if any */
+ struct subre *chain; /* for bookkeeping and error cleanup */
};
-
-
/*
- * table of function pointers for generic manipulation functions
- * A regex_t's re_fns points to one of these.
+ * table of function pointers for generic manipulation functions. A regex_t's
+ * re_fns points to one of these.
*/
+
struct fns {
- VOID FUNCPTR(free, (regex_t *));
+ void FUNCPTR(free, (regex_t *));
};
-
-
/*
* the insides of a regex_t, hidden behind a void *
*/
+
struct guts {
- int magic;
-# define GUTSMAGIC 0xfed9
- int cflags; /* copy of compile flags */
- long info; /* copy of re_info */
- size_t nsub; /* copy of re_nsub */
- struct subre *tree;
- struct cnfa search; /* for fast preliminary search */
- int ntree;
- struct colormap cmap;
- int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
- struct subre *lacons; /* lookahead-constraint vector */
- int nlacons; /* size of lacons */
+ int magic;
+#define GUTSMAGIC 0xfed9
+ int cflags; /* copy of compile flags */
+ long info; /* copy of re_info */
+ size_t nsub; /* copy of re_nsub */
+ struct subre *tree;
+ struct cnfa search; /* for fast preliminary search */
+ int ntree;
+ struct colormap cmap;
+ int FUNCPTR(compare, (const chr *, const chr *, size_t));
+ struct subre *lacons; /* lookahead-constraint vector */
+ int nlacons; /* size of lacons */
};
+
+/*
+ * Magic for allocating a variable workspace. This default version is
+ * stack-hungry.
+ */
+
+#ifndef AllocVars
+#define AllocVars(vPtr) \
+ struct vars var; \
+ register struct vars *vPtr = &var
+#endif
+#ifndef FreeVars
+#define FreeVars(vPtr) ((void) 0)
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index b6417ff..1829249 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -4,14 +4,13 @@
# functions that are exported by the Tcl library via the stubs table.
# This file is used to generate the tclDecls.h, tclPlatDecls.h,
# tclStub.c, and tclPlatStub.c files.
-#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
# 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.113 2005/08/24 17:56:23 andreas_kupries Exp $
library tcl
@@ -22,40 +21,42 @@ library tcl
interface tcl
hooks {tclPlat tclInt tclIntPlat}
+scspec EXTERN
# Declare each of the functions in the public Tcl interface. Note that
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.
-declare 0 generic {
- int Tcl_PkgProvideEx(Tcl_Interp* interp, CONST char* name,
- CONST char* version, ClientData clientData)
+declare 0 {
+ int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
+ const char *version, const void *clientData)
}
-declare 1 generic {
- CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name,
- CONST char *version, int exact, ClientData *clientDataPtr)
+declare 1 {
+ CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
+ const char *name, const char *version, int exact,
+ void *clientDataPtr)
}
-declare 2 generic {
- void Tcl_Panic(CONST char *format, ...)
+declare 2 {
+ void Tcl_Panic(const char *format, ...)
}
-declare 3 generic {
- char * Tcl_Alloc(unsigned int size)
+declare 3 {
+ char *Tcl_Alloc(unsigned int size)
}
-declare 4 generic {
+declare 4 {
void Tcl_Free(char *ptr)
}
-declare 5 generic {
- char * Tcl_Realloc(char *ptr, unsigned int size)
+declare 5 {
+ char *Tcl_Realloc(char *ptr, unsigned int size)
}
-declare 6 generic {
- char * Tcl_DbCkalloc(unsigned int size, CONST char *file, int line)
+declare 6 {
+ char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
}
-declare 7 generic {
- int Tcl_DbCkfree(char *ptr, CONST char *file, int line)
+declare 7 {
+ void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
-declare 8 generic {
- char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
- CONST char *file, int line)
+declare 8 {
+ char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
+ const char *file, int line)
}
# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
@@ -69,928 +70,928 @@ declare 9 unix {
declare 10 unix {
void Tcl_DeleteFileHandler(int fd)
}
-
-declare 11 generic {
- void Tcl_SetTimer(Tcl_Time *timePtr)
+declare 11 {
+ void Tcl_SetTimer(const Tcl_Time *timePtr)
}
-declare 12 generic {
+declare 12 {
void Tcl_Sleep(int ms)
}
-declare 13 generic {
- int Tcl_WaitForEvent(Tcl_Time *timePtr)
+declare 13 {
+ int Tcl_WaitForEvent(const Tcl_Time *timePtr)
}
-declare 14 generic {
+declare 14 {
int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 15 generic {
+declare 15 {
void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
}
-declare 16 generic {
- void Tcl_AppendToObj(Tcl_Obj* objPtr, CONST char* bytes, int length)
+declare 16 {
+ void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
-declare 17 generic {
- Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[])
+declare 17 {
+ Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[])
}
-declare 18 generic {
+declare 18 {
int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
- Tcl_ObjType *typePtr)
+ const Tcl_ObjType *typePtr)
}
-declare 19 generic {
- void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file, int line)
+declare 19 {
+ void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 20 generic {
- void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, CONST char *file, int line)
+declare 20 {
+ void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 21 generic {
- int Tcl_DbIsShared(Tcl_Obj *objPtr, CONST char *file, int line)
+declare 21 {
+ int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 22 generic {
- Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, CONST char *file, int line)
+declare 22 {
+ Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
-declare 23 generic {
- Tcl_Obj * Tcl_DbNewByteArrayObj(CONST unsigned char *bytes, int length,
- CONST char *file, int line)
+declare 23 {
+ Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
+ const char *file, int line)
}
-declare 24 generic {
- Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
- CONST char *file, int line)
+declare 24 {
+ Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
+ int line)
}
-declare 25 generic {
- Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv,
- CONST char *file, int line)
+declare 25 {
+ Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
+ const char *file, int line)
}
-declare 26 generic {
- Tcl_Obj * Tcl_DbNewLongObj(long longValue, CONST char *file, int line)
+declare 26 {
+ Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
}
-declare 27 generic {
- Tcl_Obj * Tcl_DbNewObj(CONST char *file, int line)
+declare 27 {
+ Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
-declare 28 generic {
- Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length,
- CONST char *file, int line)
+declare 28 {
+ Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length,
+ const char *file, int line)
}
-declare 29 generic {
- Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr)
+declare 29 {
+ Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
-declare 30 generic {
+declare 30 {
void TclFreeObj(Tcl_Obj *objPtr)
}
-declare 31 generic {
- int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src, int *boolPtr)
+declare 31 {
+ int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
}
-declare 32 generic {
+declare 32 {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *boolPtr)
}
-declare 33 generic {
- unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+declare 33 {
+ unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
-declare 34 generic {
- int Tcl_GetDouble(Tcl_Interp *interp, CONST char *src, double *doublePtr)
+declare 34 {
+ int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
-declare 35 generic {
+declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
-declare 36 generic {
+declare 36 {
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr)
+ CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
}
-declare 37 generic {
- int Tcl_GetInt(Tcl_Interp *interp, CONST char *src, int *intPtr)
+declare 37 {
+ int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
-declare 38 generic {
+declare 38 {
int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
}
-declare 39 generic {
+declare 39 {
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
-declare 40 generic {
- Tcl_ObjType * Tcl_GetObjType(CONST char *typeName)
+declare 40 {
+ CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
-declare 41 generic {
- char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+declare 41 {
+ char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
-declare 42 generic {
+declare 42 {
void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
-declare 43 generic {
+declare 43 {
int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *elemListPtr)
}
-declare 44 generic {
+declare 44 {
int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *objPtr)
}
-declare 45 generic {
+declare 45 {
int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
int *objcPtr, Tcl_Obj ***objvPtr)
}
-declare 46 generic {
+declare 46 {
int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index,
Tcl_Obj **objPtrPtr)
}
-declare 47 generic {
+declare 47 {
int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
int *lengthPtr)
}
-declare 48 generic {
+declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
- int count, int objc, Tcl_Obj *CONST objv[])
+ int count, int objc, Tcl_Obj *const objv[])
}
-declare 49 generic {
+declare 49 {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
-declare 50 generic {
- Tcl_Obj *Tcl_NewByteArrayObj(CONST unsigned char* bytes, int length)
+declare 50 {
+ Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
-declare 51 generic {
- Tcl_Obj * Tcl_NewDoubleObj(double doubleValue)
+declare 51 {
+ Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
-declare 52 generic {
- Tcl_Obj * Tcl_NewIntObj(int intValue)
+declare 52 {
+ Tcl_Obj *Tcl_NewIntObj(int intValue)
}
-declare 53 generic {
- Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *CONST objv[])
+declare 53 {
+ Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
-declare 54 generic {
- Tcl_Obj * Tcl_NewLongObj(long longValue)
+declare 54 {
+ Tcl_Obj *Tcl_NewLongObj(long longValue)
}
-declare 55 generic {
- Tcl_Obj * Tcl_NewObj(void)
+declare 55 {
+ Tcl_Obj *Tcl_NewObj(void)
}
-declare 56 generic {
- Tcl_Obj *Tcl_NewStringObj(CONST char *bytes, int length)
+declare 56 {
+ Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
-declare 57 generic {
+declare 57 {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
-declare 58 generic {
- unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
+declare 58 {
+ unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
-declare 59 generic {
- void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, CONST unsigned char *bytes,
+declare 59 {
+ void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
int length)
}
-declare 60 generic {
+declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
-declare 61 generic {
+declare 61 {
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
-declare 62 generic {
- void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[])
+declare 62 {
+ void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
-declare 63 generic {
+declare 63 {
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
}
-declare 64 generic {
+declare 64 {
void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
-declare 65 generic {
- void Tcl_SetStringObj(Tcl_Obj* objPtr, CONST char* bytes, int length)
+declare 65 {
+ void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
-declare 66 generic {
- void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message)
+declare 66 {
+ void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
}
-declare 67 generic {
- void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message,
+declare 67 {
+ void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
int length)
}
-declare 68 generic {
+declare 68 {
void Tcl_AllowExceptions(Tcl_Interp *interp)
}
-declare 69 generic {
- void Tcl_AppendElement(Tcl_Interp *interp, CONST char *element)
+declare 69 {
+ void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
-declare 70 generic {
+declare 70 {
void Tcl_AppendResult(Tcl_Interp *interp, ...)
}
-declare 71 generic {
+declare 71 {
Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
ClientData clientData)
}
-declare 72 generic {
+declare 72 {
void Tcl_AsyncDelete(Tcl_AsyncHandler async)
}
-declare 73 generic {
+declare 73 {
int Tcl_AsyncInvoke(Tcl_Interp *interp, int code)
}
-declare 74 generic {
+declare 74 {
void Tcl_AsyncMark(Tcl_AsyncHandler async)
}
-declare 75 generic {
+declare 75 {
int Tcl_AsyncReady(void)
}
-declare 76 generic {
+declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
-declare 77 generic {
- char Tcl_Backslash(CONST char *src, int *readPtr)
+declare 77 {
+ char Tcl_Backslash(const char *src, int *readPtr)
}
-declare 78 generic {
- int Tcl_BadChannelOption(Tcl_Interp *interp, CONST char *optionName,
- CONST char *optionList)
+declare 78 {
+ int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
+ const char *optionList)
}
-declare 79 generic {
+declare 79 {
void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
ClientData clientData)
}
-declare 80 generic {
+declare 80 {
void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
-declare 81 generic {
+declare 81 {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 82 generic {
- int Tcl_CommandComplete(CONST char *cmd)
+declare 82 {
+ int Tcl_CommandComplete(const char *cmd)
}
-declare 83 generic {
- char * Tcl_Concat(int argc, CONST84 char * CONST *argv)
+declare 83 {
+ char *Tcl_Concat(int argc, CONST84 char *const *argv)
}
-declare 84 generic {
- int Tcl_ConvertElement(CONST char *src, char *dst, int flags)
+declare 84 {
+ int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
-declare 85 generic {
- int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst,
+declare 85 {
+ int Tcl_ConvertCountedElement(const char *src, int length, char *dst,
int flags)
}
-declare 86 generic {
- int Tcl_CreateAlias(Tcl_Interp *slave, CONST char *slaveCmd,
- Tcl_Interp *target, CONST char *targetCmd, int argc,
- CONST84 char * CONST *argv)
+declare 86 {
+ int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
+ Tcl_Interp *target, const char *targetCmd, int argc,
+ CONST84 char *const *argv)
}
-declare 87 generic {
- int Tcl_CreateAliasObj(Tcl_Interp *slave, CONST char *slaveCmd,
- Tcl_Interp *target, CONST char *targetCmd, int objc,
- Tcl_Obj *CONST objv[])
+declare 87 {
+ int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
+ Tcl_Interp *target, const char *targetCmd, int objc,
+ Tcl_Obj *const objv[])
}
-declare 88 generic {
- Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr,
- CONST char *chanName, ClientData instanceData, int mask)
+declare 88 {
+ Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
+ const char *chanName, ClientData instanceData, int mask)
}
-declare 89 generic {
+declare 89 {
void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
Tcl_ChannelProc *proc, ClientData clientData)
}
-declare 90 generic {
+declare 90 {
void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
ClientData clientData)
}
-declare 91 generic {
- Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, CONST char *cmdName,
+declare 91 {
+ Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
Tcl_CmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
}
-declare 92 generic {
+declare 92 {
void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc, ClientData clientData)
}
-declare 93 generic {
+declare 93 {
void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
-declare 94 generic {
- Tcl_Interp * Tcl_CreateInterp(void)
+declare 94 {
+ Tcl_Interp *Tcl_CreateInterp(void)
}
-declare 95 generic {
- void Tcl_CreateMathFunc(Tcl_Interp *interp, CONST char *name,
- int numArgs, Tcl_ValueType *argTypes,
+declare 95 {
+ void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
+ int numArgs, Tcl_ValueType *argTypes,
Tcl_MathProc *proc, ClientData clientData)
}
-declare 96 generic {
+declare 96 {
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
- CONST char *cmdName,
+ const char *cmdName,
Tcl_ObjCmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
}
-declare 97 generic {
- Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, CONST char *slaveName,
+declare 97 {
+ Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
int isSafe)
}
-declare 98 generic {
+declare 98 {
Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData)
}
-declare 99 generic {
+declare 99 {
Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
Tcl_CmdTraceProc *proc, ClientData clientData)
}
-declare 100 generic {
- void Tcl_DeleteAssocData(Tcl_Interp *interp, CONST char *name)
+declare 100 {
+ void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
-declare 101 generic {
+declare 101 {
void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
ClientData clientData)
}
-declare 102 generic {
+declare 102 {
void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
ClientData clientData)
}
-declare 103 generic {
- int Tcl_DeleteCommand(Tcl_Interp *interp, CONST char *cmdName)
+declare 103 {
+ int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName)
}
-declare 104 generic {
+declare 104 {
int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
}
-declare 105 generic {
+declare 105 {
void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData)
}
-declare 106 generic {
+declare 106 {
void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc, ClientData clientData)
}
-declare 107 generic {
+declare 107 {
void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
-declare 108 generic {
+declare 108 {
void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
}
-declare 109 generic {
+declare 109 {
void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}
-declare 110 generic {
+declare 110 {
void Tcl_DeleteInterp(Tcl_Interp *interp)
}
-declare 111 {unix win} {
+declare 111 {
void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr)
}
-declare 112 generic {
+declare 112 {
void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
}
-declare 113 generic {
+declare 113 {
void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
}
-declare 114 generic {
+declare 114 {
void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
Tcl_InterpDeleteProc *proc, ClientData clientData)
}
-declare 115 generic {
+declare 115 {
int Tcl_DoOneEvent(int flags)
}
-declare 116 generic {
+declare 116 {
void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
}
-declare 117 generic {
- char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *bytes, int length)
+declare 117 {
+ char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length)
}
-declare 118 generic {
- char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *element)
+declare 118 {
+ char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element)
}
-declare 119 generic {
+declare 119 {
void Tcl_DStringEndSublist(Tcl_DString *dsPtr)
}
-declare 120 generic {
+declare 120 {
void Tcl_DStringFree(Tcl_DString *dsPtr)
}
-declare 121 generic {
+declare 121 {
void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
-declare 122 generic {
+declare 122 {
void Tcl_DStringInit(Tcl_DString *dsPtr)
}
-declare 123 generic {
+declare 123 {
void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
-declare 124 generic {
+declare 124 {
void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length)
}
-declare 125 generic {
+declare 125 {
void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
-declare 126 generic {
+declare 126 {
int Tcl_Eof(Tcl_Channel chan)
}
-declare 127 generic {
- CONST84_RETURN char * Tcl_ErrnoId(void)
+declare 127 {
+ CONST84_RETURN char *Tcl_ErrnoId(void)
}
-declare 128 generic {
- CONST84_RETURN char * Tcl_ErrnoMsg(int err)
+declare 128 {
+ CONST84_RETURN char *Tcl_ErrnoMsg(int err)
}
-declare 129 generic {
- int Tcl_Eval(Tcl_Interp *interp, CONST char *script)
+declare 129 {
+ int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
-declare 130 generic {
- int Tcl_EvalFile(Tcl_Interp *interp, CONST char *fileName)
+declare 130 {
+ int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
-declare 131 generic {
+declare 131 {
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 132 generic {
+declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
-declare 133 generic {
+declare 133 {
void Tcl_Exit(int status)
}
-declare 134 generic {
- int Tcl_ExposeCommand(Tcl_Interp *interp, CONST char *hiddenCmdToken,
- CONST char *cmdName)
+declare 134 {
+ int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
+ const char *cmdName)
}
-declare 135 generic {
- int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr, int *ptr)
+declare 135 {
+ int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr)
}
-declare 136 generic {
+declare 136 {
int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr)
}
-declare 137 generic {
- int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr, double *ptr)
+declare 137 {
+ int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, double *ptr)
}
-declare 138 generic {
+declare 138 {
int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr)
}
-declare 139 generic {
- int Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr, long *ptr)
+declare 139 {
+ int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, long *ptr)
}
-declare 140 generic {
+declare 140 {
int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)
}
-declare 141 generic {
+declare 141 {
int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj **resultPtrPtr)
}
-declare 142 generic {
- int Tcl_ExprString(Tcl_Interp *interp, CONST char *expr)
+declare 142 {
+ int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
-declare 143 generic {
+declare 143 {
void Tcl_Finalize(void)
}
-declare 144 generic {
- void Tcl_FindExecutable(CONST char *argv0)
+declare 144 {
+ void Tcl_FindExecutable(const char *argv0)
}
-declare 145 generic {
- Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
+declare 145 {
+ Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr)
}
-declare 146 generic {
+declare 146 {
int Tcl_Flush(Tcl_Channel chan)
}
-declare 147 generic {
+declare 147 {
void Tcl_FreeResult(Tcl_Interp *interp)
}
-declare 148 generic {
- int Tcl_GetAlias(Tcl_Interp *interp, CONST char *slaveCmd,
+declare 148 {
+ int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *argcPtr, CONST84 char ***argvPtr)
}
-declare 149 generic {
- int Tcl_GetAliasObj(Tcl_Interp *interp, CONST char *slaveCmd,
+declare 149 {
+ int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
-declare 150 generic {
- ClientData Tcl_GetAssocData(Tcl_Interp *interp, CONST char *name,
+declare 150 {
+ ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
Tcl_InterpDeleteProc **procPtr)
}
-declare 151 generic {
- Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, CONST char *chanName,
+declare 151 {
+ Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName,
int *modePtr)
}
-declare 152 generic {
+declare 152 {
int Tcl_GetChannelBufferSize(Tcl_Channel chan)
}
-declare 153 generic {
+declare 153 {
int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
ClientData *handlePtr)
}
-declare 154 generic {
+declare 154 {
ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
-declare 155 generic {
+declare 155 {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
-declare 156 generic {
- CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan)
+declare 156 {
+ CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
}
-declare 157 generic {
+declare 157 {
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
- CONST char *optionName, Tcl_DString *dsPtr)
+ const char *optionName, Tcl_DString *dsPtr)
}
-declare 158 generic {
- Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan)
+declare 158 {
+ CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
-declare 159 generic {
- int Tcl_GetCommandInfo(Tcl_Interp *interp, CONST char *cmdName,
+declare 159 {
+ int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
Tcl_CmdInfo *infoPtr)
}
-declare 160 generic {
- CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+declare 160 {
+ CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command)
}
-declare 161 generic {
+declare 161 {
int Tcl_GetErrno(void)
}
-declare 162 generic {
- CONST84_RETURN char * Tcl_GetHostName(void)
+declare 162 {
+ CONST84_RETURN char *Tcl_GetHostName(void)
}
-declare 163 generic {
+declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
}
-declare 164 generic {
- Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp)
+declare 164 {
+ Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
}
-declare 165 generic {
- CONST char * Tcl_GetNameOfExecutable(void)
+declare 165 {
+ const char *Tcl_GetNameOfExecutable(void)
}
-declare 166 generic {
- Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp)
+declare 166 {
+ Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp)
}
# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we inlcude it here for compatibility reasons.
declare 167 unix {
- int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *chanID, int forWriting,
+ int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
int checkUsage, ClientData *filePtr)
}
# Obsolete. Should now use Tcl_FSGetPathType which is objectified
# and therefore usually faster.
-declare 168 generic {
- Tcl_PathType Tcl_GetPathType(CONST char *path)
+declare 168 {
+ Tcl_PathType Tcl_GetPathType(const char *path)
}
-declare 169 generic {
+declare 169 {
int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
-declare 170 generic {
+declare 170 {
int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
-declare 171 generic {
+declare 171 {
int Tcl_GetServiceMode(void)
}
-declare 172 generic {
- Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, CONST char *slaveName)
+declare 172 {
+ Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
-declare 173 generic {
+declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
}
-declare 174 generic {
- CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp)
+declare 174 {
+ CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
}
-declare 175 generic {
- CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, CONST char *varName,
+declare 175 {
+ CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
int flags)
}
-declare 176 generic {
- CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, int flags)
+declare 176 {
+ CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags)
}
-declare 177 generic {
- int Tcl_GlobalEval(Tcl_Interp *interp, CONST char *command)
+declare 177 {
+ int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
}
-declare 178 generic {
+declare 178 {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 179 generic {
- int Tcl_HideCommand(Tcl_Interp *interp, CONST char *cmdName,
- CONST char *hiddenCmdToken)
+declare 179 {
+ int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
+ const char *hiddenCmdToken)
}
-declare 180 generic {
+declare 180 {
int Tcl_Init(Tcl_Interp *interp)
}
-declare 181 generic {
+declare 181 {
void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType)
}
-declare 182 generic {
+declare 182 {
int Tcl_InputBlocked(Tcl_Channel chan)
}
-declare 183 generic {
+declare 183 {
int Tcl_InputBuffered(Tcl_Channel chan)
}
-declare 184 generic {
+declare 184 {
int Tcl_InterpDeleted(Tcl_Interp *interp)
}
-declare 185 generic {
+declare 185 {
int Tcl_IsSafe(Tcl_Interp *interp)
}
# Obsolete, use Tcl_FSJoinPath
-declare 186 generic {
- char * Tcl_JoinPath(int argc, CONST84 char * CONST *argv,
+declare 186 {
+ char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
Tcl_DString *resultPtr)
}
-declare 187 generic {
- int Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName, char *addr,
+declare 187 {
+ int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
int type)
}
# This slot is reserved for use by the plus patch:
-# declare 188 generic {
-# Tcl_MainLoop
+# declare 188 {
+# Tcl_MainLoop
# }
-declare 189 generic {
+declare 189 {
Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
}
-declare 190 generic {
+declare 190 {
int Tcl_MakeSafe(Tcl_Interp *interp)
}
-declare 191 generic {
+declare 191 {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
-declare 192 generic {
- char * Tcl_Merge(int argc, CONST84 char * CONST *argv)
+declare 192 {
+ char *Tcl_Merge(int argc, CONST84 char *const *argv)
}
-declare 193 generic {
- Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
+declare 193 {
+ Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
-declare 194 generic {
+declare 194 {
void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
-declare 195 generic {
- Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+declare 195 {
+ Tcl_Obj *Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags)
}
-declare 196 generic {
- Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+declare 196 {
+ Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
-declare 197 {unix win} {
+declare 197 {
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
CONST84 char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
-declare 198 generic {
- Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, CONST char *fileName,
- CONST char *modeString, int permissions)
+declare 198 {
+ Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName,
+ const char *modeString, int permissions)
}
-declare 199 generic {
+declare 199 {
Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
- CONST char *address, CONST char *myaddr, int myport, int async)
+ const char *address, const char *myaddr, int myport, int async)
}
-declare 200 generic {
+declare 200 {
Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
- CONST char *host, Tcl_TcpAcceptProc *acceptProc,
+ const char *host, Tcl_TcpAcceptProc *acceptProc,
ClientData callbackData)
}
-declare 201 generic {
+declare 201 {
void Tcl_Preserve(ClientData data)
}
-declare 202 generic {
+declare 202 {
void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
-declare 203 generic {
- int Tcl_PutEnv(CONST char *assignment)
+declare 203 {
+ int Tcl_PutEnv(const char *assignment)
}
-declare 204 generic {
- CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp)
+declare 204 {
+ CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
}
-declare 205 generic {
+declare 205 {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
-declare 206 generic {
+declare 206 {
int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
-declare 207 {unix win} {
+declare 207 {
void Tcl_ReapDetachedProcs(void)
}
-declare 208 generic {
- int Tcl_RecordAndEval(Tcl_Interp *interp, CONST char *cmd, int flags)
+declare 208 {
+ int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags)
}
-declare 209 generic {
+declare 209 {
int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)
}
-declare 210 generic {
+declare 210 {
void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 211 generic {
- void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
+declare 211 {
+ void Tcl_RegisterObjType(const Tcl_ObjType *typePtr)
}
-declare 212 generic {
- Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *pattern)
+declare 212 {
+ Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern)
}
-declare 213 generic {
+declare 213 {
int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
- CONST char *text, CONST char *start)
+ const char *text, const char *start)
}
-declare 214 generic {
- int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text,
- CONST char *pattern)
+declare 214 {
+ int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
+ const char *pattern)
}
-declare 215 generic {
+declare 215 {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
CONST84 char **startPtr, CONST84 char **endPtr)
}
-declare 216 generic {
+declare 216 {
void Tcl_Release(ClientData clientData)
}
-declare 217 generic {
+declare 217 {
void Tcl_ResetResult(Tcl_Interp *interp)
}
-declare 218 generic {
- int Tcl_ScanElement(CONST char *str, int *flagPtr)
+declare 218 {
+ int Tcl_ScanElement(const char *src, int *flagPtr)
}
-declare 219 generic {
- int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
+declare 219 {
+ int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
-declare 220 generic {
+declare 220 {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
-declare 221 generic {
+declare 221 {
int Tcl_ServiceAll(void)
}
-declare 222 generic {
+declare 222 {
int Tcl_ServiceEvent(int flags)
}
-declare 223 generic {
- void Tcl_SetAssocData(Tcl_Interp *interp, CONST char *name,
+declare 223 {
+ void Tcl_SetAssocData(Tcl_Interp *interp, const char *name,
Tcl_InterpDeleteProc *proc, ClientData clientData)
}
-declare 224 generic {
+declare 224 {
void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
}
-declare 225 generic {
+declare 225 {
int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
- CONST char *optionName, CONST char *newValue)
+ const char *optionName, const char *newValue)
}
-declare 226 generic {
- int Tcl_SetCommandInfo(Tcl_Interp *interp, CONST char *cmdName,
- CONST Tcl_CmdInfo *infoPtr)
+declare 226 {
+ int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName,
+ const Tcl_CmdInfo *infoPtr)
}
-declare 227 generic {
+declare 227 {
void Tcl_SetErrno(int err)
}
-declare 228 generic {
+declare 228 {
void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
-declare 229 generic {
- void Tcl_SetMaxBlockTime(Tcl_Time *timePtr)
+declare 229 {
+ void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
-declare 230 generic {
+declare 230 {
void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
}
-declare 231 generic {
+declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
-declare 232 generic {
+declare 232 {
void Tcl_SetResult(Tcl_Interp *interp, char *result,
Tcl_FreeProc *freeProc)
}
-declare 233 generic {
+declare 233 {
int Tcl_SetServiceMode(int mode)
}
-declare 234 generic {
+declare 234 {
void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
}
-declare 235 generic {
+declare 235 {
void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
}
-declare 236 generic {
+declare 236 {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
-declare 237 generic {
- CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, CONST char *varName,
- CONST char *newValue, int flags)
+declare 237 {
+ CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
+ const char *newValue, int flags)
}
-declare 238 generic {
- CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, CONST char *newValue, int flags)
+declare 238 {
+ CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, const char *newValue, int flags)
}
-declare 239 generic {
- CONST84_RETURN char * Tcl_SignalId(int sig)
+declare 239 {
+ CONST84_RETURN char *Tcl_SignalId(int sig)
}
-declare 240 generic {
- CONST84_RETURN char * Tcl_SignalMsg(int sig)
+declare 240 {
+ CONST84_RETURN char *Tcl_SignalMsg(int sig)
}
-declare 241 generic {
+declare 241 {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
-declare 242 generic {
- int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr,
+declare 242 {
+ int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
CONST84 char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
-declare 243 generic {
- void Tcl_SplitPath(CONST char *path, int *argcPtr, CONST84 char ***argvPtr)
+declare 243 {
+ void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
}
-declare 244 generic {
- void Tcl_StaticPackage(Tcl_Interp *interp, CONST char *pkgName,
+declare 244 {
+ void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
-declare 245 generic {
- int Tcl_StringMatch(CONST char *str, CONST char *pattern)
+declare 245 {
+ int Tcl_StringMatch(const char *str, const char *pattern)
}
# Obsolete
-declare 246 generic {
+declare 246 {
int Tcl_TellOld(Tcl_Channel chan)
}
-declare 247 generic {
- int Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName, int flags,
+declare 247 {
+ int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
-declare 248 generic {
- int Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
+declare 248 {
+ int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
-declare 249 generic {
- char * Tcl_TranslateFileName(Tcl_Interp *interp, CONST char *name,
+declare 249 {
+ char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
Tcl_DString *bufferPtr)
}
-declare 250 generic {
- int Tcl_Ungets(Tcl_Channel chan, CONST char *str, int len, int atHead)
+declare 250 {
+ int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead)
}
-declare 251 generic {
- void Tcl_UnlinkVar(Tcl_Interp *interp, CONST char *varName)
+declare 251 {
+ void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
-declare 252 generic {
+declare 252 {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 253 generic {
- int Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName, int flags)
+declare 253 {
+ int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
}
-declare 254 generic {
- int Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
+declare 254 {
+ int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags)
}
-declare 255 generic {
- void Tcl_UntraceVar(Tcl_Interp *interp, CONST char *varName, int flags,
+declare 255 {
+ void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
-declare 256 generic {
- void Tcl_UntraceVar2(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, int flags, Tcl_VarTraceProc *proc,
+declare 256 {
+ void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags, Tcl_VarTraceProc *proc,
ClientData clientData)
}
-declare 257 generic {
- void Tcl_UpdateLinkedVar(Tcl_Interp *interp, CONST char *varName)
+declare 257 {
+ void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
-declare 258 generic {
- int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName,
- CONST char *varName, CONST char *localName, int flags)
+declare 258 {
+ int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+ const char *varName, const char *localName, int flags)
}
-declare 259 generic {
- int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, CONST char *part1,
- CONST char *part2, CONST char *localName, int flags)
+declare 259 {
+ int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
+ const char *part2, const char *localName, int flags)
}
-declare 260 generic {
+declare 260 {
int Tcl_VarEval(Tcl_Interp *interp, ...)
}
-declare 261 generic {
- ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, CONST char *varName,
+declare 261 {
+ ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
}
-declare 262 generic {
- ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, int flags, Tcl_VarTraceProc *procPtr,
+declare 262 {
+ ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags, Tcl_VarTraceProc *procPtr,
ClientData prevClientData)
}
-declare 263 generic {
- int Tcl_Write(Tcl_Channel chan, CONST char *s, int slen)
+declare 263 {
+ int Tcl_Write(Tcl_Channel chan, const char *s, int slen)
}
-declare 264 generic {
+declare 264 {
void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[], CONST char *message)
+ Tcl_Obj *const objv[], const char *message)
}
-declare 265 generic {
- int Tcl_DumpActiveMemory(CONST char *fileName)
+declare 265 {
+ int Tcl_DumpActiveMemory(const char *fileName)
}
-declare 266 generic {
- void Tcl_ValidateAllMemory(CONST char *file, int line)
+declare 266 {
+ void Tcl_ValidateAllMemory(const char *file, int line)
}
-
-declare 267 generic {
+declare 267 {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
-declare 268 generic {
+declare 268 {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
-declare 269 generic {
- CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr)
+declare 269 {
+ char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
-declare 270 generic {
- CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *start,
+declare 270 {
+ CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
CONST84 char **termPtr)
}
-declare 271 generic {
- CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name,
- CONST char *version, int exact)
+declare 271 {
+ CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+ const char *version, int exact)
}
-declare 272 generic {
- CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name,
- CONST char *version, int exact, ClientData *clientDataPtr)
+declare 272 {
+ CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
+ const char *name, const char *version, int exact,
+ void *clientDataPtr)
}
-declare 273 generic {
- int Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name,
- CONST char *version)
+declare 273 {
+ int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+ const char *version)
}
-declare 274 generic {
- CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name,
- CONST char *version, int exact)
+# TIP #268: The internally used new Require function is in slot 573.
+declare 274 {
+ CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+ const char *version, int exact)
}
-declare 275 generic {
+declare 275 {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
-declare 276 generic {
+declare 276 {
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
-declare 277 generic {
+declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-declare 278 generic {
- void Tcl_PanicVA(CONST char *format, va_list argList)
+declare 278 {
+ void Tcl_PanicVA(const char *format, va_list argList)
}
-declare 279 generic {
+declare 279 {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
-declare 280 generic {
+declare 280 {
void Tcl_InitMemory(Tcl_Interp *interp)
}
@@ -1008,1061 +1009,1383 @@ declare 280 generic {
# (patch usually has no problems to integrate the patch file for the last
# version into the new one).
-declare 281 generic {
- Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, Tcl_ChannelType *typePtr,
- ClientData instanceData, int mask, Tcl_Channel prevChan)
+declare 281 {
+ Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
+ const Tcl_ChannelType *typePtr, ClientData instanceData,
+ int mask, Tcl_Channel prevChan)
}
-declare 282 generic {
+declare 282 {
int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 283 generic {
+declare 283 {
Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
}
# 284 was reserved, but added in 8.4a2
-declare 284 generic {
+declare 284 {
void Tcl_SetMainLoop(Tcl_MainLoopProc *proc)
}
# Reserved for future use (8.0.x vs. 8.1)
-# declare 285 generic {
+# declare 285 {
# }
-
# Added in 8.1:
-declare 286 generic {
+declare 286 {
void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
}
-declare 287 generic {
- Tcl_Encoding Tcl_CreateEncoding(Tcl_EncodingType *typePtr)
+declare 287 {
+ Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
}
-declare 288 generic {
+declare 288 {
void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
-declare 289 generic {
+declare 289 {
void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
-declare 290 generic {
+declare 290 {
void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
}
-declare 291 generic {
- int Tcl_EvalEx(Tcl_Interp *interp, CONST char *script, int numBytes,
+declare 291 {
+ int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes,
int flags)
}
-declare 292 generic {
- int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
+declare 292 {
+ int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
}
-declare 293 generic {
+declare 293 {
int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
-declare 294 generic {
+declare 294 {
void Tcl_ExitThread(int status)
}
-declare 295 generic {
+declare 295 {
int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
- CONST char *src, int srcLen, int flags,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
-declare 296 generic {
- char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
- CONST char *src, int srcLen, Tcl_DString *dsPtr)
+declare 296 {
+ char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
+ const char *src, int srcLen, Tcl_DString *dsPtr)
}
-declare 297 generic {
+declare 297 {
void Tcl_FinalizeThread(void)
}
-declare 298 generic {
+declare 298 {
void Tcl_FinalizeNotifier(ClientData clientData)
}
-declare 299 generic {
+declare 299 {
void Tcl_FreeEncoding(Tcl_Encoding encoding)
}
-declare 300 generic {
+declare 300 {
Tcl_ThreadId Tcl_GetCurrentThread(void)
}
-declare 301 generic {
- Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name)
+declare 301 {
+ Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
-declare 302 generic {
- CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding)
+declare 302 {
+ CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
-declare 303 generic {
+declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
-declare 304 generic {
+declare 304 {
int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST VOID *tablePtr, int offset, CONST char *msg, int flags,
+ const void *tablePtr, int offset, const char *msg, int flags,
int *indexPtr)
}
-declare 305 generic {
- VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
+declare 305 {
+ void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
-declare 306 generic {
- Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, int flags)
+declare 306 {
+ Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags)
}
-declare 307 generic {
+declare 307 {
ClientData Tcl_InitNotifier(void)
}
-declare 308 generic {
+declare 308 {
void Tcl_MutexLock(Tcl_Mutex *mutexPtr)
}
-declare 309 generic {
+declare 309 {
void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr)
}
-declare 310 generic {
+declare 310 {
void Tcl_ConditionNotify(Tcl_Condition *condPtr)
}
-declare 311 generic {
+declare 311 {
void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
- Tcl_Time *timePtr)
+ const Tcl_Time *timePtr)
}
-declare 312 generic {
- int Tcl_NumUtfChars(CONST char *src, int length)
+declare 312 {
+ int Tcl_NumUtfChars(const char *src, int length)
}
-declare 313 generic {
+declare 313 {
int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
int appendFlag)
}
-declare 314 generic {
+declare 314 {
void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
}
-declare 315 generic {
+declare 315 {
void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
}
-declare 316 generic {
- int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name)
+declare 316 {
+ int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name)
}
-declare 317 generic {
- Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
- CONST char *part2, Tcl_Obj *newValuePtr, int flags)
+declare 317 {
+ Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
+ const char *part2, Tcl_Obj *newValuePtr, int flags)
}
-declare 318 generic {
+declare 318 {
void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
-declare 319 generic {
- void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr,
+declare 319 {
+ void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
Tcl_QueuePosition position)
}
-declare 320 generic {
- Tcl_UniChar Tcl_UniCharAtIndex(CONST char *src, int index)
+declare 320 {
+ Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
}
-declare 321 generic {
+declare 321 {
Tcl_UniChar Tcl_UniCharToLower(int ch)
}
-declare 322 generic {
+declare 322 {
Tcl_UniChar Tcl_UniCharToTitle(int ch)
}
-declare 323 generic {
+declare 323 {
Tcl_UniChar Tcl_UniCharToUpper(int ch)
}
-declare 324 generic {
+declare 324 {
int Tcl_UniCharToUtf(int ch, char *buf)
}
-declare 325 generic {
- CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index)
+declare 325 {
+ CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
}
-declare 326 generic {
- int Tcl_UtfCharComplete(CONST char *src, int length)
+declare 326 {
+ int Tcl_UtfCharComplete(const char *src, int length)
}
-declare 327 generic {
- int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst)
+declare 327 {
+ int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
-declare 328 generic {
- CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch)
+declare 328 {
+ CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
}
-declare 329 generic {
- CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch)
+declare 329 {
+ CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
}
-declare 330 generic {
- CONST84_RETURN char * Tcl_UtfNext(CONST char *src)
+declare 330 {
+ CONST84_RETURN char *Tcl_UtfNext(const char *src)
}
-declare 331 generic {
- CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start)
+declare 331 {
+ CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
}
-declare 332 generic {
+declare 332 {
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
- CONST char *src, int srcLen, int flags,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
-declare 333 generic {
- char * Tcl_UtfToExternalDString(Tcl_Encoding encoding,
- CONST char *src, int srcLen, Tcl_DString *dsPtr)
+declare 333 {
+ char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
+ const char *src, int srcLen, Tcl_DString *dsPtr)
}
-declare 334 generic {
+declare 334 {
int Tcl_UtfToLower(char *src)
}
-declare 335 generic {
+declare 335 {
int Tcl_UtfToTitle(char *src)
}
-declare 336 generic {
- int Tcl_UtfToUniChar(CONST char *src, Tcl_UniChar *chPtr)
+declare 336 {
+ int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr)
}
-declare 337 generic {
+declare 337 {
int Tcl_UtfToUpper(char *src)
}
-declare 338 generic {
- int Tcl_WriteChars(Tcl_Channel chan, CONST char *src, int srcLen)
+declare 338 {
+ int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen)
}
-declare 339 generic {
+declare 339 {
int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
-declare 340 generic {
- char * Tcl_GetString(Tcl_Obj *objPtr)
+declare 340 {
+ char *Tcl_GetString(Tcl_Obj *objPtr)
}
-declare 341 generic {
- CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void)
+declare 341 {
+ CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
}
-declare 342 generic {
- void Tcl_SetDefaultEncodingDir(CONST char *path)
+declare 342 {
+ void Tcl_SetDefaultEncodingDir(const char *path)
}
-declare 343 generic {
+declare 343 {
void Tcl_AlertNotifier(ClientData clientData)
}
-declare 344 generic {
+declare 344 {
void Tcl_ServiceModeHook(int mode)
}
-declare 345 generic {
+declare 345 {
int Tcl_UniCharIsAlnum(int ch)
}
-declare 346 generic {
+declare 346 {
int Tcl_UniCharIsAlpha(int ch)
}
-declare 347 generic {
+declare 347 {
int Tcl_UniCharIsDigit(int ch)
}
-declare 348 generic {
+declare 348 {
int Tcl_UniCharIsLower(int ch)
}
-declare 349 generic {
+declare 349 {
int Tcl_UniCharIsSpace(int ch)
}
-declare 350 generic {
+declare 350 {
int Tcl_UniCharIsUpper(int ch)
}
-declare 351 generic {
+declare 351 {
int Tcl_UniCharIsWordChar(int ch)
}
-declare 352 generic {
- int Tcl_UniCharLen(CONST Tcl_UniChar *uniStr)
+declare 352 {
+ int Tcl_UniCharLen(const Tcl_UniChar *uniStr)
}
-declare 353 generic {
- int Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct,
+declare 353 {
+ int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
unsigned long numChars)
}
-declare 354 generic {
- char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr,
+declare 354 {
+ char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
int uniLength, Tcl_DString *dsPtr)
}
-declare 355 generic {
- Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *src,
+declare 355 {
+ Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
int length, Tcl_DString *dsPtr)
}
-declare 356 generic {
+declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
-
-declare 357 generic {
+declare 357 {
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
-declare 358 generic {
+declare 358 {
void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
-declare 359 generic {
- void Tcl_LogCommandInfo(Tcl_Interp *interp, CONST char *script,
- CONST char *command, int length)
+declare 359 {
+ void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
+ const char *command, int length)
}
-declare 360 generic {
- int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *start, int numBytes,
+declare 360 {
+ int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
}
-declare 361 generic {
- int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *start, int numBytes,
+declare 361 {
+ int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
int nested, Tcl_Parse *parsePtr)
}
-declare 362 generic {
- int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start, int numBytes,
- Tcl_Parse *parsePtr)
+declare 362 {
+ int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes,
+ Tcl_Parse *parsePtr)
}
-declare 363 generic {
- int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *start,
+declare 363 {
+ int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
int numBytes, Tcl_Parse *parsePtr, int append,
CONST84 char **termPtr)
}
-declare 364 generic {
- int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *start, int numBytes,
+declare 364 {
+ int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
-declare 365 generic {
+declare 365 {
char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
-declare 366 generic {
- int Tcl_Chdir(CONST char *dirName)
+declare 366 {
+ int Tcl_Chdir(const char *dirName)
}
-declare 367 generic {
- int Tcl_Access(CONST char *path, int mode)
+declare 367 {
+ int Tcl_Access(const char *path, int mode)
}
-declare 368 generic {
- int Tcl_Stat(CONST char *path, struct stat *bufPtr)
+declare 368 {
+ int Tcl_Stat(const char *path, struct stat *bufPtr)
}
-declare 369 generic {
- int Tcl_UtfNcmp(CONST char *s1, CONST char *s2, unsigned long n)
+declare 369 {
+ int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n)
}
-declare 370 generic {
- int Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2, unsigned long n)
+declare 370 {
+ int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n)
}
-declare 371 generic {
- int Tcl_StringCaseMatch(CONST char *str, CONST char *pattern, int nocase)
+declare 371 {
+ int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase)
}
-declare 372 generic {
+declare 372 {
int Tcl_UniCharIsControl(int ch)
}
-declare 373 generic {
+declare 373 {
int Tcl_UniCharIsGraph(int ch)
}
-declare 374 generic {
+declare 374 {
int Tcl_UniCharIsPrint(int ch)
}
-declare 375 generic {
+declare 375 {
int Tcl_UniCharIsPunct(int ch)
}
-declare 376 generic {
+declare 376 {
int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
Tcl_Obj *textObj, int offset, int nmatches, int flags)
}
-declare 377 generic {
+declare 377 {
void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
-declare 378 generic {
- Tcl_Obj * Tcl_NewUnicodeObj(CONST Tcl_UniChar *unicode, int numChars)
+declare 378 {
+ Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars)
}
-declare 379 generic {
- void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
+declare 379 {
+ void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
int numChars)
}
-declare 380 generic {
+declare 380 {
int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
-declare 381 generic {
+declare 381 {
Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
-declare 382 generic {
- Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr)
+declare 382 {
+ Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
-declare 383 generic {
- Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
+declare 383 {
+ Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
-declare 384 generic {
- void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
+declare 384 {
+ void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
int length)
}
-declare 385 generic {
+declare 385 {
int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
Tcl_Obj *patternObj)
}
-declare 386 generic {
+declare 386 {
void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
}
-declare 387 generic {
- Tcl_Mutex * Tcl_GetAllocMutex(void)
+declare 387 {
+ Tcl_Mutex *Tcl_GetAllocMutex(void)
}
-declare 388 generic {
+declare 388 {
int Tcl_GetChannelNames(Tcl_Interp *interp)
}
-declare 389 generic {
- int Tcl_GetChannelNamesEx(Tcl_Interp *interp, CONST char *pattern)
+declare 389 {
+ int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern)
}
-declare 390 generic {
+declare 390 {
int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
+ int objc, Tcl_Obj *const objv[])
}
-declare 391 generic {
+declare 391 {
void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
-declare 392 generic {
+declare 392 {
void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
-declare 393 generic {
- int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc,
+declare 393 {
+ int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
ClientData clientData, int stackSize, int flags)
}
# Introduced in 8.3.2
-declare 394 generic {
+declare 394 {
int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead)
}
-declare 395 generic {
- int Tcl_WriteRaw(Tcl_Channel chan, CONST char *src, int srcLen)
+declare 395 {
+ int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen)
}
-declare 396 generic {
+declare 396 {
Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
-declare 397 generic {
+declare 397 {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
-declare 398 generic {
- CONST84_RETURN char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+declare 398 {
+ CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
-declare 399 generic {
- Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr)
+declare 399 {
+ Tcl_ChannelTypeVersion Tcl_ChannelVersion(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 400 generic {
- Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType
- *chanTypePtr)
+declare 400 {
+ Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 401 generic {
- Tcl_DriverCloseProc * Tcl_ChannelCloseProc(Tcl_ChannelType *chanTypePtr)
+declare 401 {
+ Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 402 generic {
- Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(Tcl_ChannelType *chanTypePtr)
+declare 402 {
+ Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 403 generic {
- Tcl_DriverInputProc * Tcl_ChannelInputProc(Tcl_ChannelType *chanTypePtr)
+declare 403 {
+ Tcl_DriverInputProc *Tcl_ChannelInputProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 404 generic {
- Tcl_DriverOutputProc * Tcl_ChannelOutputProc(Tcl_ChannelType *chanTypePtr)
+declare 404 {
+ Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 405 generic {
- Tcl_DriverSeekProc * Tcl_ChannelSeekProc(Tcl_ChannelType *chanTypePtr)
+declare 405 {
+ Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 406 generic {
- Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType
- *chanTypePtr)
+declare 406 {
+ Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 407 generic {
- Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType
- *chanTypePtr)
+declare 407 {
+ Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 408 generic {
- Tcl_DriverWatchProc * Tcl_ChannelWatchProc(Tcl_ChannelType *chanTypePtr)
+declare 408 {
+ Tcl_DriverWatchProc *Tcl_ChannelWatchProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 409 generic {
- Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType
- *chanTypePtr)
+declare 409 {
+ Tcl_DriverGetHandleProc *Tcl_ChannelGetHandleProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 410 generic {
- Tcl_DriverFlushProc * Tcl_ChannelFlushProc(Tcl_ChannelType *chanTypePtr)
+declare 410 {
+ Tcl_DriverFlushProc *Tcl_ChannelFlushProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-declare 411 generic {
- Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType
- *chanTypePtr)
+declare 411 {
+ Tcl_DriverHandlerProc *Tcl_ChannelHandlerProc(
+ const Tcl_ChannelType *chanTypePtr)
}
# Introduced in 8.4a2
-declare 412 generic {
- int Tcl_JoinThread(Tcl_ThreadId threadId, int* result)
+declare 412 {
+ int Tcl_JoinThread(Tcl_ThreadId threadId, int *result)
}
-declare 413 generic {
+declare 413 {
int Tcl_IsChannelShared(Tcl_Channel channel)
}
-declare 414 generic {
- int Tcl_IsChannelRegistered(Tcl_Interp* interp, Tcl_Channel channel)
+declare 414 {
+ int Tcl_IsChannelRegistered(Tcl_Interp *interp, Tcl_Channel channel)
}
-declare 415 generic {
+declare 415 {
void Tcl_CutChannel(Tcl_Channel channel)
}
-declare 416 generic {
+declare 416 {
void Tcl_SpliceChannel(Tcl_Channel channel)
}
-declare 417 generic {
+declare 417 {
void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
-declare 418 generic {
- int Tcl_IsChannelExisting(CONST char* channelName)
+declare 418 {
+ int Tcl_IsChannelExisting(const char *channelName)
}
-
-declare 419 generic {
- int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct,
+declare 419 {
+ int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
unsigned long numChars)
}
-declare 420 generic {
- int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr,
- CONST Tcl_UniChar *uniPattern, int nocase)
+declare 420 {
+ int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
+ const Tcl_UniChar *uniPattern, int nocase)
}
-
-declare 421 generic {
- Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, CONST char *key)
+declare 421 {
+ Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
}
-
-declare 422 generic {
+declare 422 {
Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr)
+ const void *key, int *newPtr)
}
-
-declare 423 generic {
+declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
- Tcl_HashKeyType *typePtr)
+ const Tcl_HashKeyType *typePtr)
}
-
-declare 424 generic {
+declare 424 {
void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
-declare 425 generic {
- ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, CONST char *varName,
+declare 425 {
+ ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
int flags, Tcl_CommandTraceProc *procPtr,
ClientData prevClientData)
}
-declare 426 generic {
- int Tcl_TraceCommand(Tcl_Interp *interp, CONST char *varName, int flags,
+declare 426 {
+ int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
Tcl_CommandTraceProc *proc, ClientData clientData)
}
-declare 427 generic {
- void Tcl_UntraceCommand(Tcl_Interp *interp, CONST char *varName,
+declare 427 {
+ void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
}
-declare 428 generic {
- char * Tcl_AttemptAlloc(unsigned int size)
+declare 428 {
+ char *Tcl_AttemptAlloc(unsigned int size)
}
-declare 429 generic {
- char * Tcl_AttemptDbCkalloc(unsigned int size, CONST char *file, int line)
+declare 429 {
+ char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line)
}
-declare 430 generic {
- char * Tcl_AttemptRealloc(char *ptr, unsigned int size)
+declare 430 {
+ char *Tcl_AttemptRealloc(char *ptr, unsigned int size)
}
-declare 431 generic {
- char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
- CONST char *file, int line)
+declare 431 {
+ char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
+ const char *file, int line)
}
-declare 432 generic {
+declare 432 {
int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length)
}
-declare 433 generic {
+
+# TIP#10 (thread-aware channels) akupries
+declare 433 {
Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}
+
# introduced in 8.4a3
-declare 434 generic {
- Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+declare 434 {
+ Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
-declare 435 generic {
- int Tcl_GetMathFuncInfo(Tcl_Interp *interp, CONST char *name,
+
+# TIP#15 (math function introspection) dkf
+declare 435 {
+ int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
-declare 436 generic {
- Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, CONST char *pattern)
+declare 436 {
+ Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
-declare 437 generic {
- Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+
+# TIP#36 (better access to 'subst') dkf
+declare 437 {
+ Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
-declare 438 generic {
- int Tcl_DetachChannel(Tcl_Interp* interp, Tcl_Channel channel)
+
+# TIP#17 (virtual filesystem layer) vdarley
+declare 438 {
+ int Tcl_DetachChannel(Tcl_Interp *interp, Tcl_Channel channel)
}
-declare 439 generic {
+declare 439 {
int Tcl_IsStandardChannel(Tcl_Channel channel)
}
-# New functions due to TIP#17
-declare 440 generic {
+declare 440 {
int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
-declare 441 generic {
+declare 441 {
int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
}
-declare 442 generic {
+declare 442 {
int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr)
}
-declare 443 generic {
+declare 443 {
int Tcl_FSDeleteFile(Tcl_Obj *pathPtr)
}
-declare 444 generic {
- int Tcl_FSLoadFile(Tcl_Interp * interp,
- Tcl_Obj *pathPtr, CONST char * sym1, CONST char * sym2,
- Tcl_PackageInitProc ** proc1Ptr,
- Tcl_PackageInitProc ** proc2Ptr,
- Tcl_LoadHandle * handlePtr,
+declare 444 {
+ int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1,
+ const char *sym2, Tcl_PackageInitProc **proc1Ptr,
+ Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
Tcl_FSUnloadFileProc **unloadProcPtr)
}
-declare 445 generic {
+declare 445 {
int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result,
- Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
+ Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types)
}
-declare 446 generic {
- Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction)
+declare 446 {
+ Tcl_Obj *Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction)
}
-declare 447 generic {
+declare 447 {
int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
int recursive, Tcl_Obj **errorPtr)
}
-declare 448 generic {
+declare 448 {
int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
-declare 449 generic {
+declare 449 {
int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
-declare 450 generic {
+declare 450 {
int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval)
}
-declare 451 generic {
+declare 451 {
int Tcl_FSFileAttrsGet(Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
}
-declare 452 generic {
+declare 452 {
int Tcl_FSFileAttrsSet(Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
-declare 453 generic {
- CONST char ** Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
+declare 453 {
+ const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
}
-declare 454 generic {
+declare 454 {
int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
-declare 455 generic {
+declare 455 {
int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)
}
-declare 456 generic {
+declare 456 {
Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr,
- CONST char *modeString, int permissions)
+ const char *modeString, int permissions)
}
-declare 457 generic {
- Tcl_Obj* Tcl_FSGetCwd(Tcl_Interp *interp)
+declare 457 {
+ Tcl_Obj *Tcl_FSGetCwd(Tcl_Interp *interp)
}
-declare 458 generic {
+declare 458 {
int Tcl_FSChdir(Tcl_Obj *pathPtr)
}
-declare 459 generic {
+declare 459 {
int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
-declare 460 generic {
- Tcl_Obj* Tcl_FSJoinPath(Tcl_Obj *listObj, int elements)
+declare 460 {
+ Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, int elements)
}
-declare 461 generic {
- Tcl_Obj* Tcl_FSSplitPath(Tcl_Obj* pathPtr, int *lenPtr)
+declare 461 {
+ Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr)
}
-declare 462 generic {
- int Tcl_FSEqualPaths(Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)
+declare 462 {
+ int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
}
-declare 463 generic {
- Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
+declare 463 {
+ Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
-declare 464 generic {
- Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
- Tcl_Obj *CONST objv[])
+declare 464 {
+ Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
+ Tcl_Obj *const objv[])
}
-declare 465 generic {
- ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathPtr,
- Tcl_Filesystem *fsPtr)
+declare 465 {
+ ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem *fsPtr)
}
-declare 466 generic {
- Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
+declare 466 {
+ Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
-declare 467 generic {
+declare 467 {
int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
-declare 468 generic {
- Tcl_Obj* Tcl_FSNewNativePath(Tcl_Filesystem* fromFilesystem,
+declare 468 {
+ Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
ClientData clientData)
}
-declare 469 generic {
- CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathPtr)
+declare 469 {
+ const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
}
-declare 470 generic {
- Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathPtr)
+declare 470 {
+ Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
}
-declare 471 generic {
- Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathPtr)
+declare 471 {
+ Tcl_Obj *Tcl_FSPathSeparator(Tcl_Obj *pathPtr)
}
-declare 472 generic {
- Tcl_Obj* Tcl_FSListVolumes(void)
+declare 472 {
+ Tcl_Obj *Tcl_FSListVolumes(void)
}
-declare 473 generic {
- int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
+declare 473 {
+ int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr)
}
-declare 474 generic {
- int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
+declare 474 {
+ int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
}
-declare 475 generic {
- ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
+declare 475 {
+ ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
-declare 476 generic {
- CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
- Tcl_Obj* pathPtr)
+declare 476 {
+ const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr)
}
-declare 477 generic {
- Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathPtr)
+declare 477 {
+ CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
}
-declare 478 generic {
+declare 478 {
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}
-# New function due to TIP#49
-declare 479 generic {
+
+# TIP#49 (detection of output buffering) akupries
+declare 479 {
int Tcl_OutputBuffered(Tcl_Channel chan)
}
-declare 480 generic {
- void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
-}
-# New function due to TIP#56
-declare 481 generic {
+declare 480 {
+ void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
+}
+
+# TIP#56 (evaluate a parsed script) msofer
+declare 481 {
int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
-# New export due to TIP#73
-declare 482 generic {
- void Tcl_GetTime(Tcl_Time* timeBuf)
+# TIP#73 (access to current time) kbk
+declare 482 {
+ void Tcl_GetTime(Tcl_Time *timeBuf)
}
-# New exports due to TIP#32
-
-declare 483 generic {
- Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp* interp, int level, int flags,
- Tcl_CmdObjTraceProc* objProc, ClientData clientData,
- Tcl_CmdObjTraceDeleteProc* delProc)
+# TIP#32 (object-enabled traces) kbk
+declare 483 {
+ Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags,
+ Tcl_CmdObjTraceProc *objProc, ClientData clientData,
+ Tcl_CmdObjTraceDeleteProc *delProc)
}
-declare 484 generic {
- int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo* infoPtr)
+declare 484 {
+ int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
-declare 485 generic {
+declare 485 {
int Tcl_SetCommandInfoFromToken(Tcl_Command token,
- CONST Tcl_CmdInfo* infoPtr)
+ const Tcl_CmdInfo *infoPtr)
}
### New functions on 64-bit dev branch ###
-declare 486 generic {
- Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
- CONST char *file, int line)
+# TIP#72 (64-bit values) dkf
+declare 486 {
+ Tcl_Obj *Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
+ const char *file, int line)
}
-declare 487 generic {
+declare 487 {
int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_WideInt *widePtr)
}
-declare 488 generic {
- Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue)
+declare 488 {
+ Tcl_Obj *Tcl_NewWideIntObj(Tcl_WideInt wideValue)
}
-declare 489 generic {
+declare 489 {
void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue)
}
-declare 490 generic {
- Tcl_StatBuf * Tcl_AllocStatBuf(void)
+declare 490 {
+ Tcl_StatBuf *Tcl_AllocStatBuf(void)
}
-declare 491 generic {
+declare 491 {
Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode)
}
-declare 492 generic {
+declare 492 {
Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
}
-# New export due to TIP#91
-declare 493 generic {
- Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
- Tcl_ChannelType *chanTypePtr)
+# TIP#91 (back-compat enhancements for channels) dkf
+declare 493 {
+ Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
+ const Tcl_ChannelType *chanTypePtr)
}
-# DICTIONARIES - TIP#111
-declare 494 generic {
+# ----- BASELINE -- FOR -- 8.4.0 ----- #
+
+# TIP#111 (dictionaries) dkf
+declare 494 {
int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_Obj *keyPtr, Tcl_Obj *valuePtr)
}
-declare 495 generic {
+declare 495 {
int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr,
Tcl_Obj **valuePtrPtr)
}
-declare 496 generic {
+declare 496 {
int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_Obj *keyPtr)
}
-declare 497 generic {
+declare 497 {
int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr)
}
-declare 498 generic {
+declare 498 {
int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_DictSearch *searchPtr,
Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
}
-declare 499 generic {
+declare 499 {
void Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
}
-declare 500 generic {
+declare 500 {
void Tcl_DictObjDone(Tcl_DictSearch *searchPtr)
}
-declare 501 generic {
+declare 501 {
int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,
- int keyc, Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr)
+ int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr)
}
-declare 502 generic {
+declare 502 {
int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,
- int keyc, Tcl_Obj *CONST *keyv)
+ int keyc, Tcl_Obj *const *keyv)
}
-declare 503 generic {
+declare 503 {
Tcl_Obj *Tcl_NewDictObj(void)
}
-declare 504 generic {
- Tcl_Obj *Tcl_DbNewDictObj(CONST char *file, int line)
+declare 504 {
+ Tcl_Obj *Tcl_DbNewDictObj(const char *file, int line)
}
-# New export due to TIP#59
-declare 505 generic {
- void Tcl_RegisterConfig(Tcl_Interp* interp, CONST char* pkgName,
- Tcl_Config* configuration, CONST char* valEncoding)
+# TIP#59 (configuration reporting) akupries
+declare 505 {
+ void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName,
+ const Tcl_Config *configuration, const char *valEncoding)
}
-# Transferred from tclInt.decls due to TIP #139
-declare 506 generic {
- Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, CONST char *name,
+# TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
+# dkf, API by Brent Welch?
+declare 506 {
+ Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
-declare 507 generic {
+declare 507 {
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
-declare 508 generic {
+declare 508 {
int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
-declare 509 generic {
+declare 509 {
int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern, int resetListFirst)
+ const char *pattern, int resetListFirst)
}
-declare 510 generic {
+declare 510 {
int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern, int allowOverwrite)
+ const char *pattern, int allowOverwrite)
}
-declare 511 generic {
+declare 511 {
int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern)
+ const char *pattern)
}
-declare 512 generic {
+declare 512 {
Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
}
-declare 513 generic {
+declare 513 {
Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
}
-declare 514 generic {
- Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, CONST char *name,
+declare 514 {
+ Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 515 generic {
- Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+declare 515 {
+ Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 516 generic {
+declare 516 {
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 517 generic {
+declare 517 {
void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
-# New export due to TIP#137
-declare 518 generic {
+# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
+declare 518 {
int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
- CONST char *encodingName)
+ const char *encodingName)
}
-# New export due to TIP#121
-declare 519 generic {
+# TIP#121 (exit handler) dkf for Joe Mistachkin
+declare 519 {
Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
}
-# TIP#143 API
-declare 520 generic {
+# TIP#143 (resource limits) dkf
+declare 520 {
void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc, ClientData clientData,
Tcl_LimitHandlerDeleteProc *deleteProc)
}
-declare 521 generic {
+declare 521 {
void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc, ClientData clientData)
}
-declare 522 generic {
+declare 522 {
int Tcl_LimitReady(Tcl_Interp *interp)
}
-declare 523 generic {
+declare 523 {
int Tcl_LimitCheck(Tcl_Interp *interp)
}
-declare 524 generic {
+declare 524 {
int Tcl_LimitExceeded(Tcl_Interp *interp)
}
-declare 525 generic {
+declare 525 {
void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit)
}
-declare 526 generic {
+declare 526 {
void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
}
-declare 527 generic {
+declare 527 {
void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity)
}
-declare 528 generic {
+declare 528 {
int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type)
}
-declare 529 generic {
+declare 529 {
int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type)
}
-declare 530 generic {
+declare 530 {
void Tcl_LimitTypeSet(Tcl_Interp *interp, int type)
}
-declare 531 generic {
+declare 531 {
void Tcl_LimitTypeReset(Tcl_Interp *interp, int type)
}
-declare 532 generic {
+declare 532 {
int Tcl_LimitGetCommands(Tcl_Interp *interp)
}
-declare 533 generic {
+declare 533 {
void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
}
-declare 534 generic {
+declare 534 {
int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type)
}
-# TIP#226 API
-declare 535 generic {
+
+# TIP#226 (interpreter result state management) dgp
+declare 535 {
Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status)
}
-declare 536 generic {
+declare 536 {
int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state)
}
-declare 537 generic {
+declare 537 {
void Tcl_DiscardInterpState(Tcl_InterpState state)
}
-# TIP#227 API
-declare 538 generic {
+
+# TIP#227 (return options interface) dgp
+declare 538 {
int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options)
}
-declare 539 generic {
+declare 539 {
Tcl_Obj *Tcl_GetReturnOptions(Tcl_Interp *interp, int result)
}
-# TIP#235
-declare 540 generic {
+
+# TIP#235 (ensembles) dkf
+declare 540 {
int Tcl_IsEnsemble(Tcl_Command token)
}
-declare 541 generic {
- Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, CONST char *name,
+declare 541 {
+ Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name,
Tcl_Namespace *namespacePtr, int flags)
}
-declare 542 generic {
+declare 542 {
Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj,
int flags)
}
-declare 543 generic {
+declare 543 {
int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj *subcmdList)
}
-declare 544 generic {
+declare 544 {
int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj *mapDict)
}
-declare 545 generic {
+declare 545 {
int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj *unknownList)
}
-declare 546 generic {
+declare 546 {
int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags)
}
-declare 547 generic {
+declare 547 {
int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj **subcmdListPtr)
}
-declare 548 generic {
+declare 548 {
int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj **mapDictPtr)
}
-declare 549 generic {
+declare 549 {
int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token,
Tcl_Obj **unknownListPtr)
}
-declare 550 generic {
+declare 550 {
int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token,
int *flagsPtr)
}
-declare 551 generic {
+declare 551 {
int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token,
Tcl_Namespace **namespacePtrPtr)
}
-# TIP#233 (Virtualized Time)
-declare 552 generic {
- void Tcl_SetTimeProc (Tcl_GetTimeProc* getProc,
- Tcl_ScaleTimeProc* scaleProc,
+
+# TIP#233 (virtualized time) akupries
+declare 552 {
+ void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
+ Tcl_ScaleTimeProc *scaleProc,
ClientData clientData)
}
-declare 553 generic {
- void Tcl_QueryTimeProc (Tcl_GetTimeProc** getProc,
- Tcl_ScaleTimeProc** scaleProc,
- ClientData* clientData)
-}
-# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
-declare 554 generic {
- Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
+declare 553 {
+ void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
+ Tcl_ScaleTimeProc **scaleProc,
+ ClientData *clientData)
}
-# TIP #237:
+# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
+declare 554 {
+ Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
+ const Tcl_ChannelType *chanTypePtr)
+}
-declare 555 generic {
- Tcl_Obj* Tcl_NewBignumObj( mp_int* value )
+# TIP#237 (arbitrary-precision integers) kbk
+declare 555 {
+ Tcl_Obj *Tcl_NewBignumObj(mp_int *value)
+}
+declare 556 {
+ Tcl_Obj *Tcl_DbNewBignumObj(mp_int *value, const char *file, int line)
}
-declare 556 generic {
- Tcl_Obj* Tcl_DbNewBignumObj( mp_int* value, CONST char* file, int line )
+declare 557 {
+ void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value)
}
-declare 557 generic {
- void Tcl_SetBignumObj( Tcl_Obj* obj, mp_int* value )
+declare 558 {
+ int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
}
-declare 558 generic {
- int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
+declare 559 {
+ int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
}
-# TIP #208:
-declare 559 generic {
+# TIP #208 ('chan' command) jeffh
+declare 560 {
int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
}
-declare 560 generic {
+declare 561 {
Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
- Tcl_ChannelType *chanTypePtr)
+ const Tcl_ChannelType *chanTypePtr)
}
-# TIP#219 (Tcl Channel Reflection API) akupries
+# TIP#219 (channel reflection api) akupries
+declare 562 {
+ void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg)
+}
+declare 563 {
+ void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg)
+}
+declare 564 {
+ void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg)
+}
+declare 565 {
+ void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg)
+}
-declare 561 generic {
- void Tcl_SetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj* msg)
+# TIP #237 (additional conversion functions for bignum support) kbk/dgp
+declare 566 {
+ int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval,
+ mp_int *toInit)
}
-declare 562 generic {
- void Tcl_GetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj** msg)
+
+# TIP#181 (namespace unknown command) dgp for Neil Madden
+declare 567 {
+ Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr)
}
-declare 563 generic {
- void Tcl_SetChannelError (Tcl_Channel chan, Tcl_Obj* msg)
+declare 568 {
+ int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr)
}
-declare 564 generic {
- void Tcl_GetChannelError (Tcl_Channel chan, Tcl_Obj** msg)
+
+# TIP#258 (enhanced interface for encodings) dgp
+declare 569 {
+ int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tcl_Encoding *encodingPtr)
+}
+declare 570 {
+ Tcl_Obj *Tcl_GetEncodingSearchPath(void)
+}
+declare 571 {
+ int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath)
+}
+declare 572 {
+ const char *Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
+}
+
+# TIP#268 (extended version numbers and requirements) akupries
+declare 573 {
+ int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name,
+ int objc, Tcl_Obj *const objv[], void *clientDataPtr)
+}
+
+# TIP#270 (utility C routines for string formatting) dgp
+declare 574 {
+ void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 575 {
+ void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length,
+ int limit, const char *ellipsis)
+}
+declare 576 {
+ Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
+ Tcl_Obj *const objv[])
+}
+declare 577 {
+ int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ const char *format, int objc, Tcl_Obj *const objv[])
+}
+declare 578 {
+ Tcl_Obj *Tcl_ObjPrintf(const char *format, ...)
+}
+declare 579 {
+ void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
+}
+
+# ----- BASELINE -- FOR -- 8.5.0 ----- #
+
+# TIP #285 (script cancellation support) jmistachkin
+declare 580 {
+ int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
+ ClientData clientData, int flags)
+}
+declare 581 {
+ int Tcl_Canceled(Tcl_Interp *interp, int flags)
}
+# TIP#304 (chan pipe) aferrieux
+declare 582 {
+ int Tcl_CreatePipe(Tcl_Interp *interp, Tcl_Channel *rchan,
+ Tcl_Channel *wchan, int flags)
+}
+
+# TIP #322 (NRE public interface) msofer
+declare 583 {
+ Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc *proc,
+ Tcl_ObjCmdProc *nreProc, ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc)
+}
+declare 584 {
+ int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+}
+declare 585 {
+ int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
+ int flags)
+}
+declare 586 {
+ int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
+ Tcl_Obj *const objv[], int flags)
+}
+declare 587 {
+ void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
+ ClientData data0, ClientData data1, ClientData data2,
+ ClientData data3)
+}
+# For use by NR extenders, to have a simple way to also provide a (required!)
+# classic objProc
+declare 588 {
+ int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
+ ClientData clientData, int objc, Tcl_Obj *const objv[])
+}
+
+# TIP#316 (Tcl_StatBuf reader functions) dkf
+declare 589 {
+ unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 590 {
+ unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 591 {
+ unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 592 {
+ int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 593 {
+ int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 594 {
+ int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 595 {
+ int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 596 {
+ Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 597 {
+ Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 598 {
+ Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 599 {
+ Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 600 {
+ Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
+}
+declare 601 {
+ unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
+}
+
+# TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om
+declare 602 {
+ int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
+ Tcl_Obj *paramList)
+}
+declare 603 {
+ int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
+ Tcl_Obj **paramListPtr)
+}
+
+# TIP#265 (option parser) dkf for Sam Bromley
+declare 604 {
+ int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
+ int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
+}
+
+# TIP#336 (manipulate the error line) dgp
+declare 605 {
+ int Tcl_GetErrorLine(Tcl_Interp *interp)
+}
+declare 606 {
+ void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum)
+}
+
+# TIP#307 (move results between interpreters) dkf
+declare 607 {
+ void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result,
+ Tcl_Interp *targetInterp)
+}
+
+# TIP#335 (detect if interpreter in use) jmistachkin
+declare 608 {
+ int Tcl_InterpActive(Tcl_Interp *interp)
+}
+
+# TIP#337 (log exception for background processing) dgp
+declare 609 {
+ void Tcl_BackgroundException(Tcl_Interp *interp, int code)
+}
+
+# TIP#234 (zlib interface) dkf/Pascal Scheffers
+declare 610 {
+ int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
+ int level, Tcl_Obj *gzipHeaderDictObj)
+}
+declare 611 {
+ int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
+ int buffersize, Tcl_Obj *gzipHeaderDictObj)
+}
+declare 612 {
+ unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
+ int len)
+}
+declare 613 {
+ unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
+ int len)
+}
+declare 614 {
+ int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
+ int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
+}
+declare 615 {
+ Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle)
+}
+declare 616 {
+ int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle)
+}
+declare 617 {
+ int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
+}
+declare 618 {
+ int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
+}
+declare 619 {
+ int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count)
+}
+declare 620 {
+ int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
+}
+declare 621 {
+ int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
+}
+
+# TIP 338 (control over startup script) dgp
+declare 622 {
+ void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding)
+}
+declare 623 {
+ Tcl_Obj *Tcl_GetStartupScript(const char **encodingPtr)
+}
+
+# TIP#332 (half-close made public) aferrieux
+declare 624 {
+ int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
+}
+
+# TIP #353 (NR-enabled expressions) dgp
+declare 625 {
+ int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr)
+}
+
+# TIP #356 (NR-enabled substitution) dgp
+declare 626 {
+ int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+}
+
+# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
+declare 627 {
+ int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ const char *const symv[], int flags, void *procPtrs,
+ Tcl_LoadHandle *handlePtr)
+}
+declare 628 {
+ 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 ----- #
+
##############################################################################
-# Define the platform specific public Tcl interface. These functions are
-# only available on the designated platform.
+# Define the platform specific public Tcl interface. These functions are only
+# available on the designated platform.
interface tclPlat
-######################
-# Windows declarations
+################################
+# Unix specific functions
+# (none)
+
+################################
+# Windows specific functions
# Added in Tcl 8.1
declare 0 win {
- TCHAR * Tcl_WinUtfToTChar(CONST char *str, int len, Tcl_DString *dsPtr)
+ TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
}
declare 1 win {
- char * Tcl_WinTCharToUtf(CONST TCHAR *str, int len, Tcl_DString *dsPtr)
+ char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}
-##################
-# Mac OS X declarations
-#
+################################
+# Mac OS X specific functions
declare 0 macosx {
int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
- CONST char *bundleName,
- int hasResourceFile,
- int maxPathLen,
- char *libraryPath)
+ const char *bundleName, int hasResourceFile,
+ int maxPathLen, char *libraryPath)
}
declare 1 macosx {
int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
- CONST char *bundleName,
- CONST char *bundleVersion,
- int hasResourceFile,
- int maxPathLen,
- char *libraryPath)
+ const char *bundleName, const char *bundleVersion,
+ int hasResourceFile, int maxPathLen, char *libraryPath)
+}
+
+##############################################################################
+
+# Public functions that are not accessible via the stubs table.
+
+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)
+}
+export {
+ void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tcl.h b/generic/tcl.h
index f75ae6f..e557290 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.203 2005/09/13 21:23:51 dgp Exp $
*/
#ifndef _TCL
@@ -39,44 +37,42 @@ extern "C" {
* When version numbers change here, must also go into the following files and
* update the version numbers:
*
- * library/init.tcl (only if Major.minor changes, not patchlevel) 1 LOC
+ * library/init.tcl (1 LOC patch)
* unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
* win/configure.in (as above)
* win/tcl.m4 (not patchlevel)
* win/makefile.bc (not patchlevel) 2 LOC
* README (sections 0 and 2, with and without separator)
- * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 2 LOC
- * win/README.binary (sections 0-4, with and without separator)
+ * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
+ * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
+ * macosx/Tcl.xcode/project.pbxproj (not patchlevel) 2 LOC
+ * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC
+ * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
* win/README (not patchlevel) (sections 0 and 2)
- * unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch)
- * tests/basic.test (1 LOC M/M, not patchlevel)
+ * 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 5
-#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
-#define TCL_RELEASE_SERIAL 4
-
-#define TCL_VERSION "8.5"
-#define TCL_PATCH_LEVEL "8.5a4"
+#define TCL_MINOR_VERSION 6
+#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TCL_RELEASE_SERIAL 1
+#define TCL_VERSION "8.6"
+#define TCL_PATCH_LEVEL "8.6.1"
+
/*
+ *----------------------------------------------------------------------------
* The following definitions set up the proper options for Windows compilers.
* We use this method because there is no autoconf equivalent.
*/
-#ifndef __WIN32__
-# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+# ifndef __WIN32__
# define __WIN32__
-# ifndef WIN32
-# define WIN32
-# endif
-# ifndef _WIN32
-# define _WIN32
-# endif
+# endif
+# ifndef WIN32
+# define WIN32
# endif
#endif
@@ -84,11 +80,11 @@ extern "C" {
* STRICT: See MSDN Article Q83456
*/
-#ifdef __WIN32__
+#ifdef _WIN32
# ifndef STRICT
# define STRICT
# endif
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -127,20 +123,6 @@ extern "C" {
#endif
/*
- * Macros that eliminate the overhead of the thread synchronization functions
- * when compiling without thread support.
- */
-
-#ifndef TCL_THREADS
-#define Tcl_MutexLock(mutexPtr)
-#define Tcl_MutexUnlock(mutexPtr)
-#define Tcl_MutexFinalize(mutexPtr)
-#define Tcl_ConditionNotify(condPtr)
-#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
-#define Tcl_ConditionFinalize(condPtr)
-#endif /* TCL_THREADS */
-
-/*
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
* SEEK_END, all #define'd by stdio.h .
*
@@ -153,11 +135,12 @@ extern "C" {
#include <stdio.h>
/*
+ *----------------------------------------------------------------------------
* Support for functions with a variable number of arguments.
*
* The following TCL_VARARGS* macros are to support old extensions
* written for older versions of Tcl where the macros permitted
- * support for the varargs.h system as well as stdarg.h .
+ * support for the varargs.h system as well as stdarg.h .
*
* New code should just directly be written to use stdarg.h conventions.
*/
@@ -168,26 +151,66 @@ 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
/*
+ *----------------------------------------------------------------------------
* Macros used to declare a function to be exported by a DLL. Used by Windows,
* maps to no-op declarations on non-Windows systems. The default build on
* windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be
* nonempty. To build a static library, the macro STATIC_BUILD should be
* defined.
- */
-
-#ifdef STATIC_BUILD
-# define DLLIMPORT
-# define DLLEXPORT
+ *
+ * Note: when building static but linking dynamically to MSVCRT we must still
+ * correctly decorate the C library imported function. Use CRTIMPORT
+ * for this purpose. _DLL is defined by the compiler when linking to
+ * MSVCRT.
+ */
+
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+# define HAVE_DECLSPEC 1
+# ifdef STATIC_BUILD
+# define DLLIMPORT
+# define DLLEXPORT
+# ifdef _DLL
+# define CRTIMPORT __declspec(dllimport)
+# else
+# define CRTIMPORT
+# endif
+# else
+# define DLLIMPORT __declspec(dllimport)
+# define DLLEXPORT __declspec(dllexport)
+# define CRTIMPORT __declspec(dllimport)
+# endif
#else
-# if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
-# define DLLIMPORT __declspec(dllimport)
-# define DLLEXPORT __declspec(dllexport)
+# define DLLIMPORT
+# if defined(__GNUC__) && __GNUC__ > 3
+# define DLLEXPORT __attribute__ ((visibility("default")))
# else
-# define DLLIMPORT
-# define DLLEXPORT
+# define DLLEXPORT
# endif
+# define CRTIMPORT
#endif
/*
@@ -218,26 +241,34 @@ extern "C" {
#endif
/*
+ * The following _ANSI_ARGS_ macro is to support old extensions
+ * written for older versions of Tcl where it permitted support
+ * for compilers written in the pre-prototype era of C.
+ *
+ * New code should use prototypes.
+ */
+
+#ifndef TCL_NO_DEPRECATED
+# undef _ANSI_ARGS_
+# define _ANSI_ARGS_(x) x
+#endif
+
+/*
* Definitions that allow this header file to be used either with or without
- * ANSI C features like function prototypes.
+ * ANSI C features.
*/
-#undef _ANSI_ARGS_
-#undef CONST
#ifndef INLINE
# define INLINE
#endif
-#ifndef NO_CONST
-# define CONST const
-#else
-# define CONST
+#ifdef NO_CONST
+# ifndef const
+# define const
+# endif
#endif
-
-#ifndef NO_PROTOTYPES
-# define _ANSI_ARGS_(x) x
-#else
-# define _ANSI_ARGS_(x) ()
+#ifndef CONST
+# define CONST const
#endif
#ifdef USE_NON_CONST
@@ -249,15 +280,19 @@ extern "C" {
#else
# ifdef USE_COMPAT_CONST
# define CONST84
-# define CONST84_RETURN CONST
+# define CONST84_RETURN const
# else
-# define CONST84 CONST
-# define CONST84_RETURN CONST
+# define CONST84 const
+# define CONST84_RETURN const
# endif
#endif
+#ifndef CONST86
+# define CONST86 CONST84
+#endif
+
/*
- * Make sure EXTERN isn't defined elsewhere
+ * Make sure EXTERN isn't defined elsewhere.
*/
#ifdef EXTERN
@@ -271,39 +306,38 @@ extern "C" {
#endif
/*
+ *----------------------------------------------------------------------------
* The following code is copied from winnt.h. If we don't replicate it here,
* then <windows.h> can't be included after tcl.h, since tcl.h also defines
* VOID. This block is skipped under Cygwin and Mingw.
*/
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
* in ANSI C; maps them to type "char *" in non-ANSI systems.
*/
-#ifndef NO_VOID
-#define VOID void
-#else
-#define VOID char
+#ifndef __VXWORKS__
+# ifndef NO_VOID
+# define VOID void
+# else
+# define VOID char
+# endif
#endif
/*
* Miscellaneous declarations.
*/
-#ifndef NULL
-# define NULL 0
-#endif
-
#ifndef _CLIENTDATA
# ifndef NO_VOID
typedef void *ClientData;
@@ -314,6 +348,24 @@ typedef long LONG;
#endif
/*
+ * Darwin specific configure overrides (to support fat compiles, where
+ * configure runs only once for multiple architectures):
+ */
+
+#ifdef __APPLE__
+# ifdef __LP64__
+# undef TCL_WIDE_INT_TYPE
+# define TCL_WIDE_INT_IS_LONG 1
+# define TCL_CFG_DO64BIT 1
+# else /* !__LP64__ */
+# define TCL_WIDE_INT_TYPE long long
+# undef TCL_WIDE_INT_IS_LONG
+# undef TCL_CFG_DO64BIT
+# endif /* __LP64__ */
+# undef HAVE_STRUCT_STAT64
+#endif /* __APPLE__ */
+
+/*
* Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
* Tcl_WideUInt to be the unsigned variant of that type (assuming that where
* we have one, we can have the other.)
@@ -330,36 +382,22 @@ typedef long LONG;
* longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
*
* Note on converting between Tcl_WideInt and strings. This implementation (in
- * tclObj.c) depends on the functions strtoull() and sprintf(...,"%"
- * TCL_LL_MODIFIER "d",...). TCL_LL_MODIFIER_SIZE is the length of the
- * modifier string, which is "ll" on most 32-bit Unix systems. It has to be
- * split up like this to allow for the more complex formats sometimes needed
- * (e.g. in the format(n) command.)
+ * tclObj.c) depends on the function
+ * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
*/
#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"
-# define TCL_LL_MODIFIER_SIZE 3
-# else
-# define TCL_LL_MODIFIER "L"
-# define TCL_LL_MODIFIER_SIZE 1
-# 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"
-# define TCL_LL_MODIFIER_SIZE 1
# else /* __BORLANDC__ */
-typedef struct _stati64 Tcl_StatBuf;
# define TCL_LL_MODIFIER "I64"
-# define TCL_LL_MODIFIER_SIZE 3
# 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...
@@ -374,7 +412,7 @@ typedef struct _stati64 Tcl_StatBuf;
# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* NO_LIMITS_H */
-# endif /* __WIN32__ */
+# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
@@ -385,14 +423,12 @@ 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)))
# define Tcl_DoubleAsWide(val) ((long)((double)(val)))
# ifndef TCL_LL_MODIFIER
# define TCL_LL_MODIFIER "l"
-# define TCL_LL_MODIFIER_SIZE 1
# endif /* !TCL_LL_MODIFIER */
#else /* TCL_WIDE_INT_IS_LONG */
/*
@@ -400,13 +436,7 @@ 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"
-# define TCL_LL_MODIFIER_SIZE 2
# endif /* !TCL_LL_MODIFIER */
# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
@@ -414,17 +444,41 @@ typedef struct stat Tcl_StatBuf;
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */
-/*
- * This flag controls whether binary compatability is maintained with
- * extensions built against a previous version of Tcl. This is true by
- * default.
- */
-
-#ifndef TCL_PRESERVE_BINARY_COMPATABILITY
-# define TCL_PRESERVE_BINARY_COMPATABILITY 1
+#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 {
+ 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) && !defined(__APPLE__)
+ typedef struct stat64 Tcl_StatBuf;
+#else
+ typedef struct stat Tcl_StatBuf;
#endif
-
+
/*
+ *----------------------------------------------------------------------------
* Data structures defined opaquely in this module. The definitions below just
* provide dummy types. A few fields are made visible in Tcl_Interp
* structures, namely those used for returning a string result from commands.
@@ -443,10 +497,17 @@ typedef struct stat Tcl_StatBuf;
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
-typedef struct Tcl_Interp {
- char *result; /* If the last command returned a string
+typedef struct Tcl_Interp
+#ifndef TCL_NO_DEPRECATED
+{
+ /* TIP #330: Strongly discourage extensions from using the string
+ * result. */
+#ifdef USE_INTERP_RESULT
+ char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
+ /* If the last command returned a string
* result, this points to it. */
- void (*freeProc) _ANSI_ARGS_((char *blockPtr));
+ void (*freeProc) (char *blockPtr)
+ TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
/* Zero means the string result is statically
* allocated. TCL_DYNAMIC means it was
* allocated with ckalloc and should be freed
@@ -454,10 +515,21 @@ typedef struct Tcl_Interp {
* of function to invoke to free the result.
* Tcl_Eval must free it before executing next
* command. */
- int errorLine; /* When TCL_ERROR is returned, this gives the
+#else
+ char *resultDontUse; /* Don't use in extensions! */
+ void (*freeProcDontUse) (char *); /* Don't use in extensions! */
+#endif
+#ifdef USE_INTERP_ERRORLINE
+ 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). */
-} Tcl_Interp;
+#else
+ int errorLineDontUse; /* Don't use in extensions! */
+#endif
+}
+#endif /* TCL_NO_DEPRECATED */
+Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -478,17 +550,19 @@ typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
+typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
/*
+ *----------------------------------------------------------------------------
* Definition of the interface to functions implementing threads. A function
* following this definition is given to each call of 'Tcl_CreateThread' and
* will be called as the main fuction of the new thread created by that call.
*/
-#if defined __WIN32__
-typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#if defined _WIN32
+typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
#else
-typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
#endif
/*
@@ -497,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
* in generic/tclThreadTest.c for it's usage.
*/
-#if defined __WIN32__
+#if defined _WIN32
# define Tcl_ThreadCreateType unsigned __stdcall
# define TCL_THREAD_CREATE_RETURN return 0
#else
@@ -510,37 +584,35 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
* given to Tcl_CreateThread.
*/
-#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack */
-#define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default behaviour */
-#define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable */
+#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack. */
+#define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default
+ * behaviour. */
+#define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable. */
/*
- * Flag values passed to Tcl_GetRegExpFromObj.
+ * Flag values passed to Tcl_StringCaseMatch.
*/
-#define TCL_REG_BASIC 000000 /* BREs (convenience) */
-#define TCL_REG_EXTENDED 000001 /* EREs */
-#define TCL_REG_ADVF 000002 /* advanced features in EREs */
-#define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs) */
-#define TCL_REG_QUOTE 000004 /* no special characters, none */
-#define TCL_REG_NOCASE 000010 /* ignore case */
-#define TCL_REG_NOSUB 000020 /* don't care about subexpressions */
-#define TCL_REG_EXPANDED 000040 /* expanded format, white space &
- * comments */
-#define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
-#define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before */
-#define TCL_REG_NEWLINE 000300 /* newlines are line terminators */
-#define TCL_REG_CANMATCH 001000 /* report details on partial/limited
- * matches */
+#define TCL_MATCH_NOCASE (1<<0)
/*
- * The following flag is experimental and only intended for use by Expect. It
- * will probably go away in a later release.
+ * Flag values passed to Tcl_GetRegExpFromObj.
*/
-#define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only
- * matches at the beginning of the
- * string. */
+#define TCL_REG_BASIC 000000 /* BREs (convenience). */
+#define TCL_REG_EXTENDED 000001 /* EREs. */
+#define TCL_REG_ADVF 000002 /* Advanced features in EREs. */
+#define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs). */
+#define TCL_REG_QUOTE 000004 /* No special characters, none. */
+#define TCL_REG_NOCASE 000010 /* Ignore case. */
+#define TCL_REG_NOSUB 000020 /* Don't care about subexpressions. */
+#define TCL_REG_EXPANDED 000040 /* Expanded format, white space &
+ * comments. */
+#define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
+#define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before. */
+#define TCL_REG_NEWLINE 000300 /* Newlines are line terminators. */
+#define TCL_REG_CANMATCH 001000 /* Report details on partial/limited
+ * matches. */
/*
* Flags values passed to Tcl_RegExpExecObj.
@@ -580,6 +652,7 @@ typedef Tcl_StatBuf *Tcl_Stat_;
typedef struct stat *Tcl_OldStat_;
/*
+ *----------------------------------------------------------------------------
* When a TCL command returns, the interpreter contains a result from the
* command. Programmers are strongly encouraged to use one of the functions
* Tcl_GetObjResult() or Tcl_GetStringResult() to read the interpreter's
@@ -599,15 +672,16 @@ typedef struct stat *Tcl_OldStat_;
* interpreter's result is meaningless.
*/
-#define TCL_OK 0
-#define TCL_ERROR 1
-#define TCL_RETURN 2
-#define TCL_BREAK 3
-#define TCL_CONTINUE 4
+#define TCL_OK 0
+#define TCL_ERROR 1
+#define TCL_RETURN 2
+#define TCL_BREAK 3
+#define TCL_CONTINUE 4
-#define TCL_RESULT_SIZE 200
+#define TCL_RESULT_SIZE 200
/*
+ *----------------------------------------------------------------------------
* Flags to control what substitutions are performed by Tcl_SubstObj():
*/
@@ -640,84 +714,78 @@ typedef struct Tcl_Value {
struct Tcl_Obj;
/*
+ *----------------------------------------------------------------------------
* Function types defined by Tcl:
*/
-typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int code));
-typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
-typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
-typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
-typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST84 char *argv[]));
-typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
- ClientData cmdClientData, int argc, CONST84 char *argv[]));
-typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int level, CONST char *command,
- Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv));
-typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr,
- struct Tcl_Obj *dupPtr));
-typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr,
- char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData));
-typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
-typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
- int flags));
-typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
- ClientData clientData));
-typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
- int flags));
-typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
-typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
-typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
-typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
-typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
-typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
-typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int flags));
-typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...));
-typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
- Tcl_Channel chan, char *address, int port));
-typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
-typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
- struct Tcl_Obj *objPtr));
-typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
-typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2,
- int flags));
-typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *oldName, CONST char *newName,
- int flags));
-typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
- Tcl_FileProc *proc, ClientData clientData));
-typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
-typedef void (Tcl_AlertNotifierProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_ServiceModeHookProc) _ANSI_ARGS_((int mode));
-typedef ClientData (Tcl_InitNotifierProc) _ANSI_ARGS_((VOID));
-typedef void (Tcl_FinalizeNotifierProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void));
-
+typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
+typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp,
+ int code);
+typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
+typedef void (Tcl_CloseProc) (ClientData data);
+typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
+typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST84 char *argv[]);
+typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
+ int level, char *command, Tcl_CmdProc *proc,
+ ClientData cmdClientData, int argc, CONST84 char *argv[]);
+typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
+ int level, const char *command, Tcl_Command commandInfo, int objc,
+ struct Tcl_Obj *const *objv);
+typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
+typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
+ struct Tcl_Obj *dupPtr);
+typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src,
+ int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
+typedef void (Tcl_EncodingFreeProc) (ClientData clientData);
+typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
+typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags);
+typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData);
+typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags);
+typedef void (Tcl_ExitProc) (ClientData clientData);
+typedef void (Tcl_FileProc) (ClientData clientData, int mask);
+typedef void (Tcl_FileFreeProc) (ClientData clientData);
+typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
+typedef void (Tcl_FreeProc) (char *blockPtr);
+typedef void (Tcl_IdleProc) (ClientData clientData);
+typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
+ Tcl_Interp *interp);
+typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
+ Tcl_Value *args, Tcl_Value *resultPtr);
+typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
+typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
+ int objc, struct Tcl_Obj *const *objv);
+typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
+typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
+typedef void (Tcl_PanicProc) (const char *format, ...);
+typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
+ char *address, int port);
+typedef void (Tcl_TimerProc) (ClientData clientData);
+typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
+typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
+typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
+ CONST84 char *part1, CONST84 char *part2, int flags);
+typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
+ const char *oldName, const char *newName, int flags);
+typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
+ ClientData clientData);
+typedef void (Tcl_DeleteFileHandlerProc) (int fd);
+typedef void (Tcl_AlertNotifierProc) (ClientData clientData);
+typedef void (Tcl_ServiceModeHookProc) (int mode);
+typedef ClientData (Tcl_InitNotifierProc) (void);
+typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
+typedef void (Tcl_MainLoopProc) (void);
+
/*
+ *----------------------------------------------------------------------------
* The following structure represents a type of object, which is a particular
* internal representation for an object plus a set of functions that provide
* standard operations on objects of that type.
*/
typedef struct Tcl_ObjType {
- char *name; /* Name of the type, e.g. "int". */
+ const char *name; /* Name of the type, e.g. "int". */
Tcl_FreeInternalRepProc *freeIntRepProc;
/* Called to free any storage for the type's
* internal rep. NULL if the internal rep does
@@ -755,25 +823,28 @@ typedef struct Tcl_Obj {
* array as a readonly value. */
int length; /* The number of bytes at *bytes, not
* including the terminating null. */
- Tcl_ObjType *typePtr; /* Denotes the object's type. Always
+ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always
* corresponds to the type of the object's
* internal rep. NULL indicates the object has
* no internal rep (has no type). */
union { /* The internal representation: */
- long longValue; /* - an long integer value */
- double doubleValue; /* - a double-precision floating value */
- VOID *otherValuePtr; /* - another, type-specific value */
- Tcl_WideInt wideValue; /* - a long long value */
- struct { /* - internal rep as two pointers */
- VOID *ptr1;
- VOID *ptr2;
+ long longValue; /* - an long integer value. */
+ double doubleValue; /* - a double-precision floating value. */
+ void *otherValuePtr; /* - another, type-specific value. */
+ Tcl_WideInt wideValue; /* - a long long value. */
+ struct { /* - internal rep as two pointers. */
+ void *ptr1;
+ void *ptr2;
} twoPtrValue;
- struct { /* - internal rep as a wide int, tightly
- * packed fields */
- VOID *digits; /* Pointer to digits */
- unsigned long misc; /* Alloc, used, and signum packed into a
- * single word */
- } bignumValue;
+ 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;
@@ -782,62 +853,15 @@ 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 _ANSI_ARGS_((Tcl_Obj *objPtr));
-void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
-int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
-
-#ifdef TCL_MEM_DEBUG
-# define Tcl_IncrRefCount(objPtr) \
- Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
-# define Tcl_DecrRefCount(objPtr) \
- Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
-# define Tcl_IsShared(objPtr) \
- Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
-#else
-# define Tcl_IncrRefCount(objPtr) \
- ++(objPtr)->refCount
-# define Tcl_DecrRefCount(objPtr) \
- if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr)
-# define Tcl_IsShared(objPtr) \
- ((objPtr)->refCount > 1)
-#endif
-
-/*
- * Macros and definitions that help to debug the use of Tcl objects. When
- * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
- * debugging versions of the object creation functions.
- */
-
-#ifdef TCL_MEM_DEBUG
-# define Tcl_NewBignumObj(val) \
- Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
-# define Tcl_NewBooleanObj(val) \
- Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
-# define Tcl_NewByteArrayObj(bytes, len) \
- Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
-# define Tcl_NewDoubleObj(val) \
- Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
-# define Tcl_NewIntObj(val) \
- Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-# define Tcl_NewListObj(objc, objv) \
- Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
-# define Tcl_NewLongObj(val) \
- Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-# define Tcl_NewObj() \
- Tcl_DbNewObj(__FILE__, __LINE__)
-# define Tcl_NewStringObj(bytes, len) \
- Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
-# define Tcl_NewWideIntObj(val) \
- Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
-#endif /* TCL_MEM_DEBUG */
-
+void Tcl_IncrRefCount(Tcl_Obj *objPtr);
+void Tcl_DecrRefCount(Tcl_Obj *objPtr);
+int Tcl_IsShared(Tcl_Obj *objPtr);
+
/*
+ *----------------------------------------------------------------------------
* The following structure contains the state needed by Tcl_SaveResult. No-one
* outside of Tcl should access any of these fields. This structure is
* typically allocated on the stack.
@@ -854,6 +878,7 @@ typedef struct Tcl_SavedResult {
} Tcl_SavedResult;
/*
+ *----------------------------------------------------------------------------
* The following definitions support Tcl's namespace facility. Note: the first
* five fields must match exactly the fields in a Namespace structure (see
* tclInt.h).
@@ -868,16 +893,17 @@ typedef struct Tcl_Namespace {
* starts with ::. */
ClientData clientData; /* Arbitrary value associated with this
* namespace. */
- Tcl_NamespaceDeleteProc* deleteProc;
+ Tcl_NamespaceDeleteProc *deleteProc;
/* Function invoked when deleting the
* namespace to, e.g., free clientData. */
- struct Tcl_Namespace* parentPtr;
+ struct Tcl_Namespace *parentPtr;
/* Points to the namespace that contains this
* one. NULL if this is the global
* namespace. */
} Tcl_Namespace;
/*
+ *----------------------------------------------------------------------------
* The following structure represents a call frame, or activation record. A
* call frame defines a naming context for a procedure call: its local scope
* (for local variables) and its namespace scope (used for non-local
@@ -903,17 +929,21 @@ typedef struct Tcl_CallFrame {
Tcl_Namespace *nsPtr;
int dummy1;
int dummy2;
- char *dummy3;
- char *dummy4;
- char *dummy5;
+ void *dummy3;
+ void *dummy4;
+ void *dummy5;
int dummy6;
- char *dummy7;
- char *dummy8;
+ void *dummy7;
+ void *dummy8;
int dummy9;
- char* dummy10;
+ void *dummy10;
+ void *dummy11;
+ void *dummy12;
+ void *dummy13;
} Tcl_CallFrame;
/*
+ *----------------------------------------------------------------------------
* Information about commands that is returned by Tcl_GetCommandInfo and
* passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command
* function while proc is a traditional Tcl argc/argv string-based function.
@@ -949,6 +979,7 @@ typedef struct Tcl_CmdInfo {
} Tcl_CmdInfo;
/*
+ *----------------------------------------------------------------------------
* The structure defined below is used to hold dynamic strings. The only
* fields that clients should use are string and length, accessible via the
* macros Tcl_DStringValue and Tcl_DStringLength.
@@ -977,8 +1008,8 @@ typedef struct Tcl_DString {
* buffer space required by Tcl_PrintDouble.
*/
-#define TCL_MAX_PREC 17
-#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
+#define TCL_MAX_PREC 17
+#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
/*
* Definition for a number of bytes of buffer space sufficient to hold the
@@ -996,8 +1027,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
@@ -1011,6 +1040,7 @@ typedef struct Tcl_DString {
#define TCL_EXACT 1
/*
+ *----------------------------------------------------------------------------
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
* WARNING: these bit choices must not conflict with the bit choices for
* evalFlag bits in tclInt.h!
@@ -1020,27 +1050,37 @@ typedef struct Tcl_DString {
* TCL_EVAL_GLOBAL: Execute script in global namespace
* TCL_EVAL_DIRECT: Do not compile this script
* TCL_EVAL_INVOKE: Magical Tcl_EvalObjv mode for aliases/ensembles
- * o Run in global namespace
+ * o Run in iPtr->lookupNsPtr or global namespace
* o Cut out of error traces
* o Don't reset the flags controlling ensemble
* error message rewriting.
+ * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the
+ * stack for the script in progress to be
+ * completely unwound.
+ * TCL_EVAL_NOERR: Do no exception reporting at all, just return
+ * as the caller will report.
*/
-#define TCL_NO_EVAL 0x10000
-#define TCL_EVAL_GLOBAL 0x20000
-#define TCL_EVAL_DIRECT 0x40000
-#define TCL_EVAL_INVOKE 0x80000
+
+#define TCL_NO_EVAL 0x010000
+#define TCL_EVAL_GLOBAL 0x020000
+#define TCL_EVAL_DIRECT 0x040000
+#define TCL_EVAL_INVOKE 0x080000
+#define TCL_CANCEL_UNWIND 0x100000
+#define TCL_EVAL_NOERR 0x200000
/*
* Special freeProc values that may be passed to Tcl_SetResult (see the man
* page for details):
*/
-#define TCL_VOLATILE ((Tcl_FreeProc *) 1)
-#define TCL_STATIC ((Tcl_FreeProc *) 0)
-#define TCL_DYNAMIC ((Tcl_FreeProc *) 3)
+#define TCL_VOLATILE ((Tcl_FreeProc *) 1)
+#define TCL_STATIC ((Tcl_FreeProc *) 0)
+#define TCL_DYNAMIC ((Tcl_FreeProc *) 3)
/*
* Flag values passed to variable-related functions.
+ * WARNING: these bit choices must not conflict with the bit choice for
+ * TCL_CANCEL_UNWIND, above.
*/
#define TCL_GLOBAL_ONLY 1
@@ -1055,10 +1095,10 @@ typedef struct Tcl_DString {
#define TCL_LEAVE_ERR_MSG 0x200
#define TCL_TRACE_ARRAY 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
-/* Required to support old variable/vdelete/vinfo traces */
+/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE 0x1000
#endif
-/* Indicate the semantics of the result of a trace */
+/* Indicate the semantics of the result of a trace. */
#define TCL_TRACE_RESULT_DYNAMIC 0x8000
#define TCL_TRACE_RESULT_OBJECT 0x10000
@@ -1074,8 +1114,8 @@ typedef struct Tcl_DString {
* Flag values passed to command-related functions.
*/
-#define TCL_TRACE_RENAME 0x2000
-#define TCL_TRACE_DELETE 0x4000
+#define TCL_TRACE_RENAME 0x2000
+#define TCL_TRACE_DELETE 0x4000
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
@@ -1109,8 +1149,9 @@ typedef struct Tcl_DString {
#define TCL_LINK_FLOAT 13
#define TCL_LINK_WIDE_UINT 14
#define TCL_LINK_READ_ONLY 0x80
-
+
/*
+ *----------------------------------------------------------------------------
* Forward declarations of Tcl_HashTable and related types.
*/
@@ -1118,13 +1159,11 @@ typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;
-typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- VOID *keyPtr));
-typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr,
- Tcl_HashEntry *hPtr));
-typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr));
+typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
+typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
+typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
+ void *keyPtr);
+typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
/*
* This flag controls whether the hash table stores the hash of a key, or
@@ -1148,13 +1187,9 @@ struct Tcl_HashEntry {
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
#if TCL_HASH_KEY_STORE_HASH
-# if TCL_PRESERVE_BINARY_COMPATABILITY
- VOID *hash; /* Hash value, stored as pointer to ensure
+ void *hash; /* Hash value, stored as pointer to ensure
* that the offsets of the fields in this
* structure are not changed. */
-# else
- unsigned int hash; /* Hash value. */
-# endif
#else
Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to first
* entry in this entry's chain: used for
@@ -1168,7 +1203,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!! */
};
@@ -1263,13 +1298,11 @@ struct Tcl_HashTable {
* TCL_ONE_WORD_KEYS, or an integer giving the
* number of ints that is the size of the
* key. */
-#if TCL_PRESERVE_BINARY_COMPATABILITY
- Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key));
- Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr));
-#endif
- Tcl_HashKeyType *typePtr; /* Type of the keys used in the
+ Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
+ Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
+ int *newPtr);
+ const Tcl_HashKeyType *typePtr;
+ /* Type of the keys used in the
* Tcl_HashTable. */
};
@@ -1307,53 +1340,10 @@ typedef struct Tcl_HashSearch {
* accessed from the entry and not the behaviour.
*/
-#define TCL_STRING_KEYS 0
-#define TCL_ONE_WORD_KEYS 1
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-# define TCL_CUSTOM_TYPE_KEYS -2
-# define TCL_CUSTOM_PTR_KEYS -1
-#else
-# define TCL_CUSTOM_TYPE_KEYS TCL_STRING_KEYS
-# define TCL_CUSTOM_PTR_KEYS TCL_ONE_WORD_KEYS
-#endif
-
-/*
- * Macros for clients to use to access fields of hash entries:
- */
-
-#define Tcl_GetHashValue(h) ((h)->clientData)
-#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-# define Tcl_GetHashKey(tablePtr, h) \
- ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
- (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
- ? (h)->key.oneWordValue \
- : (h)->key.string))
-#else
-# define Tcl_GetHashKey(tablePtr, h) \
- ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) \
- ? (h)->key.oneWordValue \
- : (h)->key.string))
-#endif
-
-/*
- * Macros to use for clients to use to invoke find and create functions for
- * hash tables:
- */
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-# define Tcl_FindHashEntry(tablePtr, key) \
- (*((tablePtr)->findProc))(tablePtr, key)
-# define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
- (*((tablePtr)->createProc))(tablePtr, key, newPtr)
-#else /* !TCL_PRESERVE_BINARY_COMPATABILITY */
-/*
- * Macro to use new extended version of Tcl_InitHashTable.
- */
-# define Tcl_InitHashTable(tablePtr, keyType) \
- Tcl_InitHashTableEx(tablePtr, keyType, NULL)
-#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */
+#define TCL_STRING_KEYS (0)
+#define TCL_ONE_WORD_KEYS (1)
+#define TCL_CUSTOM_TYPE_KEYS (-2)
+#define TCL_CUSTOM_PTR_KEYS (-1)
/*
* Structure definition for information used to keep track of searches through
@@ -1362,13 +1352,15 @@ typedef struct Tcl_HashSearch {
*/
typedef struct {
- Tcl_HashSearch search; /* Search struct for underlying hash table. */
+ void *next; /* Search position for underlying hash
+ * table. */
int epoch; /* Epoch marker for dictionary being searched,
* or -1 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
} Tcl_DictSearch;
-
+
/*
+ *----------------------------------------------------------------------------
* Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
* events:
*/
@@ -1421,24 +1413,25 @@ typedef struct Tcl_Time {
long usec; /* Microseconds. */
} Tcl_Time;
-typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
-typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
+typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
+typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
/*
* TIP #233 (Virtualized Time)
*/
-typedef void (Tcl_GetTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
-typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
+typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData);
+typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
/*
+ *----------------------------------------------------------------------------
* Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
* indicate what sorts of events are of interest:
*/
-#define TCL_READABLE (1<<1)
-#define TCL_WRITABLE (1<<2)
-#define TCL_EXCEPTION (1<<3)
+#define TCL_READABLE (1<<1)
+#define TCL_WRITABLE (1<<2)
+#define TCL_EXCEPTION (1<<3)
/*
* Flag values to pass to Tcl_OpenCommandChannel to indicate the disposition
@@ -1456,15 +1449,15 @@ typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData cli
* should be closed.
*/
-#define TCL_CLOSE_READ (1<<1)
-#define TCL_CLOSE_WRITE (1<<2)
+#define TCL_CLOSE_READ (1<<1)
+#define TCL_CLOSE_WRITE (1<<2)
/*
* Value to use as the closeProc for a channel that supports the close2Proc
* interface.
*/
-#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1)
+#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *) 1)
/*
* Channel version tag. This was introduced in 8.3.2/8.4.
@@ -1474,9 +1467,10 @@ typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData cli
#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3)
#define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4)
+#define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5)
/*
- * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
+ * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc.
*/
#define TCL_CHANNEL_THREAD_INSERT (0)
@@ -1486,78 +1480,41 @@ typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData cli
* Typedefs for the various operations in a channel type:
*/
-typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_((
- ClientData instanceData, int mode));
-typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp));
-typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, int flags));
-typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCodePtr));
-typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
- CONST84 char *buf, int toWrite, int *errorCodePtr));
-typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
- long offset, int mode, int *errorCodePtr));
-typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST char *optionName, CONST char *value));
-typedef int (Tcl_DriverGetOptionProc) _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST84 char *optionName, Tcl_DString *dsPtr));
-typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((
- ClientData instanceData, int mask));
-typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
- ClientData instanceData, int direction,
- ClientData *handlePtr));
-typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_((ClientData instanceData));
-typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
- ClientData instanceData, int interestMask));
-typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
- ClientData instanceData, Tcl_WideInt offset,
- int mode, int *errorCodePtr));
+typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode);
+typedef int (Tcl_DriverCloseProc) (ClientData instanceData,
+ Tcl_Interp *interp);
+typedef int (Tcl_DriverClose2Proc) (ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf,
+ int toRead, int *errorCodePtr);
+typedef int (Tcl_DriverOutputProc) (ClientData instanceData,
+ CONST84 char *buf, int toWrite, int *errorCodePtr);
+typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset,
+ int mode, int *errorCodePtr);
+typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
+typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData,
+ Tcl_Interp *interp, CONST84 char *optionName,
+ Tcl_DString *dsPtr);
+typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask);
+typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData,
+ int direction, ClientData *handlePtr);
+typedef int (Tcl_DriverFlushProc) (ClientData instanceData);
+typedef int (Tcl_DriverHandlerProc) (ClientData instanceData,
+ int interestMask);
+typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
* TIP #218, Channel Thread Actions
*/
-typedef void (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
- ClientData instanceData, int action));
+typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData,
+ int action);
/*
* TIP #208, File Truncation (etc.)
*/
-typedef int (Tcl_DriverTruncateProc) _ANSI_ARGS_((
- ClientData instanceData, Tcl_WideInt length));
-
-/*
- * The following declarations either map ckalloc and ckfree to malloc and
- * free, or they map them to functions with all sorts of debugging hooks
- * defined in tclCkalloc.c.
- */
-
-#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__)
-
-#else /* !TCL_MEM_DEBUG */
-
-/*
- * If we are not using the debugging allocator, we should call the Tcl_Alloc,
- * et al. routines in order to guarantee that every module is using the same
- * 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 Tcl_InitMemory(x)
-# define Tcl_DumpActiveMemory(x)
-# define Tcl_ValidateAllMemory(x,y)
-
-#endif /* !TCL_MEM_DEBUG */
+typedef int (Tcl_DriverTruncateProc) (ClientData instanceData,
+ Tcl_WideInt length);
/*
* struct Tcl_ChannelType:
@@ -1571,7 +1528,7 @@ typedef int (Tcl_DriverTruncateProc) _ANSI_ARGS_((
*/
typedef struct Tcl_ChannelType {
- char *typeName; /* The name of the channel type in Tcl
+ const char *typeName; /* The name of the channel type in Tcl
* commands. This storage is owned by channel
* type. */
Tcl_ChannelTypeVersion version;
@@ -1605,7 +1562,7 @@ typedef struct Tcl_ChannelType {
/* Set blocking mode for the raw channel. May
* be NULL. */
/*
- * Only valid in TCL_CHANNEL_VERSION_2 channels or later
+ * Only valid in TCL_CHANNEL_VERSION_2 channels or later.
*/
Tcl_DriverFlushProc *flushProc;
/* Function to call to flush a channel. May be
@@ -1615,7 +1572,7 @@ typedef struct Tcl_ChannelType {
* This will be passed up the stacked channel
* chain. */
/*
- * Only valid in TCL_CHANNEL_VERSION_3 channels or later
+ * Only valid in TCL_CHANNEL_VERSION_3 channels or later.
*/
Tcl_DriverWideSeekProc *wideSeekProc;
/* Function to call to seek on the channel
@@ -1623,14 +1580,17 @@ typedef struct Tcl_ChannelType {
* NULL, and must be NULL if seekProc is
* NULL. */
/*
- * Only valid in TCL_CHANNEL_VERSION_4 channels or later
- * TIP #218, Channel Thread Actions
- * TIP #208 (part relating to truncation)
+ * Only valid in TCL_CHANNEL_VERSION_4 channels or later.
+ * TIP #218, Channel Thread Actions.
*/
Tcl_DriverThreadActionProc *threadActionProc;
/* Function to call to notify the driver of
* thread specific activity for a channel. May
* be NULL. */
+ /*
+ * Only valid in TCL_CHANNEL_VERSION_5 channels or later.
+ * TIP #208, File Truncation.
+ */
Tcl_DriverTruncateProc *truncateProc;
/* Function to call to truncate the underlying
* file to a particular length. May be NULL if
@@ -1648,6 +1608,7 @@ typedef struct Tcl_ChannelType {
* mode. */
/*
+ *----------------------------------------------------------------------------
* Enum for different types of file paths.
*/
@@ -1663,14 +1624,14 @@ typedef enum Tcl_PathType {
*/
typedef struct Tcl_GlobTypeData {
- int type; /* Corresponds to bcdpfls as in 'find -t' */
- int perm; /* Corresponds to file permissions */
- Tcl_Obj *macType; /* Acceptable mac type */
- Tcl_Obj *macCreator; /* Acceptable mac creator */
+ int type; /* Corresponds to bcdpfls as in 'find -t'. */
+ int perm; /* Corresponds to file permissions. */
+ Tcl_Obj *macType; /* Acceptable Mac type. */
+ Tcl_Obj *macCreator; /* Acceptable Mac creator. */
} Tcl_GlobTypeData;
/*
- * Type and permission definitions for glob command
+ * Type and permission definitions for glob command.
*/
#define TCL_GLOB_TYPE_BLOCK (1<<0)
@@ -1689,7 +1650,7 @@ typedef struct Tcl_GlobTypeData {
#define TCL_GLOB_PERM_X (1<<4)
/*
- * Flags for the unload callback function
+ * Flags for the unload callback function.
*/
#define TCL_UNLOAD_DETACH_FROM_INTERPRETER (1<<0)
@@ -1699,71 +1660,60 @@ typedef struct Tcl_GlobTypeData {
* Typedefs for the various filesystem operations:
*/
-typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
-typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
-typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions));
-typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
- Tcl_GlobTypeData * types));
-typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
-typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
- Tcl_StatBuf *buf));
-typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
-typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
-typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
-typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr));
-typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
- int recursive, Tcl_Obj **errorPtr));
-typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
- Tcl_Obj *destPathPtr));
-typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
-typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
+typedef int (Tcl_FSStatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+typedef int (Tcl_FSAccessProc) (Tcl_Obj *pathPtr, int mode);
+typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) (Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int mode, int permissions);
+typedef int (Tcl_FSMatchInDirectoryProc) (Tcl_Interp *interp, Tcl_Obj *result,
+ Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types);
+typedef Tcl_Obj * (Tcl_FSGetCwdProc) (Tcl_Interp *interp);
+typedef int (Tcl_FSChdirProc) (Tcl_Obj *pathPtr);
+typedef int (Tcl_FSLstatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+typedef int (Tcl_FSCreateDirectoryProc) (Tcl_Obj *pathPtr);
+typedef int (Tcl_FSDeleteFileProc) (Tcl_Obj *pathPtr);
+typedef int (Tcl_FSCopyDirectoryProc) (Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
+typedef int (Tcl_FSCopyFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
+typedef int (Tcl_FSRemoveDirectoryProc) (Tcl_Obj *pathPtr, int recursive,
+ Tcl_Obj **errorPtr);
+typedef int (Tcl_FSRenameFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
+typedef void (Tcl_FSUnloadFileProc) (Tcl_LoadHandle loadHandle);
+typedef Tcl_Obj * (Tcl_FSListVolumesProc) (void);
/* We have to declare the utime structure here. */
struct utimbuf;
-typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
- struct utimbuf *tval));
-typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int nextCheckpoint));
-typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
-typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((
- Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef));
-typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
-typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
- Tcl_Obj *toPtr, int linkType));
-typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr,
- Tcl_FSUnloadFileProc **unloadProcPtr));
-typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
- ClientData *clientDataPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((
- Tcl_Obj *pathPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((
- Tcl_Obj *pathPtr));
-typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
-typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((
- ClientData clientData));
-typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((
- ClientData clientData));
-typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((
- Tcl_Obj *pathPtr));
+typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval);
+typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ int nextCheckpoint);
+typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef);
+typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
+typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+ int linkType);
+typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
+typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr,
+ ClientData *clientDataPtr);
+typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
+typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
+typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData);
+typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData);
+typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData);
+typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);
typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
/*
- *----------------------------------------------------------------
+ *----------------------------------------------------------------------------
* Data structures related to hooking into the filesystem
- *----------------------------------------------------------------
*/
/*
* Filesystem version tag. This was introduced in 8.4.
*/
+
#define TCL_FILESYSTEM_VERSION_1 ((Tcl_FSVersion) 0x1)
/*
@@ -1780,7 +1730,7 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
*/
typedef struct Tcl_Filesystem {
- CONST char *typeName; /* The name of the filesystem. */
+ const char *typeName; /* The name of the filesystem. */
int structureLength; /* Length of this structure, so future binary
* compatibility can be assured. */
Tcl_FSVersion version; /* Version of the filesystem type. */
@@ -1942,6 +1892,7 @@ typedef struct Tcl_Filesystem {
#define TCL_CREATE_HARD_LINK 0x02
/*
+ *----------------------------------------------------------------------------
* The following structure represents the Notifier functions that you can
* override with the Tcl_SetNotifier call.
*/
@@ -1956,73 +1907,11 @@ typedef struct Tcl_NotifierProcs {
Tcl_AlertNotifierProc *alertNotifierProc;
Tcl_ServiceModeHookProc *serviceModeHookProc;
} Tcl_NotifierProcs;
-
-/*
- * The following structure represents a user-defined encoding. It collects
- * together all the functions that are used by the specific encoding.
- */
-
-typedef struct Tcl_EncodingType {
- CONST char *encodingName; /* The name of the encoding, e.g. "euc-jp".
- * This name is the unique key for this
- * encoding type. */
- Tcl_EncodingConvertProc *toUtfProc;
- /* Function to convert from external encoding
- * into UTF-8. */
- Tcl_EncodingConvertProc *fromUtfProc;
- /* Function to convert from UTF-8 into
- * external encoding. */
- Tcl_EncodingFreeProc *freeProc;
- /* If non-NULL, function to call when this
- * encoding is deleted. */
- ClientData clientData; /* Arbitrary value associated with encoding
- * type. Passed to conversion functions. */
- int nullSize; /* Number of zero bytes that signify
- * end-of-string in this encoding. This number
- * is used to determine the source string
- * length when the srcLen argument is
- * negative. Must be 1 or 2. */
-} Tcl_EncodingType;
-
-/*
- * The following definitions are used as values for the conversion control
- * flags argument when converting text from one character set to another:
- *
- * TCL_ENCODING_START - Signifies that the source buffer is the first
- * block in a (potentially multi-block) input
- * stream. Tells the conversion function to reset
- * to an initial state and perform any
- * initialization that needs to occur before the
- * first byte is converted. If the source buffer
- * contains the entire input stream to be
- * converted, this flag should be set.
- * TCL_ENCODING_END - Signifies that the source buffer is the last
- * block in a (potentially multi-block) input
- * stream. Tells the conversion routine to
- * perform any finalization that needs to occur
- * after the last byte is converted and then to
- * reset to an initial state. If the source
- * buffer contains the entire input stream to be
- * converted, this flag should be set.
- * TCL_ENCODING_STOPONERROR - If set, then the converter will return
- * immediately upon encountering an invalid byte
- * sequence or a source character that has no
- * mapping in the target encoding. If clear, then
- * the converter will skip the problem,
- * substituting one or more "close" characters in
- * the destination buffer and then continue to
- * convert the source.
- */
-
-#define TCL_ENCODING_START 0x01
-#define TCL_ENCODING_END 0x02
-#define TCL_ENCODING_STOPONERROR 0x04
-
+
/*
+ *----------------------------------------------------------------------------
* The following data structures and declarations are for the new Tcl parser.
- */
-
-/*
+ *
* For each word of a command, and for each piece of a word such as a variable
* reference, one of the following structures is created to describe the
* token.
@@ -2031,7 +1920,7 @@ typedef struct Tcl_EncodingType {
typedef struct Tcl_Token {
int type; /* Type of token, such as TCL_TOKEN_WORD; see
* below for valid types. */
- CONST char *start; /* First character in token. */
+ const char *start; /* First character in token. */
int size; /* Number of bytes in token. */
int numComponents; /* If this token is composed of other tokens,
* this field tells how many of them there are
@@ -2106,9 +1995,9 @@ typedef struct Tcl_Token {
* operands. NumComponents is always 0.
* TCL_TOKEN_EXPAND_WORD - This token is just like TCL_TOKEN_WORD except
* that it marks a word that began with the
- * literal character prefix "{expand}". This word
- * is marked to be expanded - that is, broken
- * into words after substitution is complete.
+ * literal character prefix "{*}". This word is
+ * marked to be expanded - that is, broken into
+ * words after substitution is complete.
*/
#define TCL_TOKEN_WORD 1
@@ -2145,13 +2034,13 @@ typedef struct Tcl_Token {
#define NUM_STATIC_TOKENS 20
typedef struct Tcl_Parse {
- CONST char *commentStart; /* Pointer to # that begins the first of one
+ const char *commentStart; /* Pointer to # that begins the first of one
* or more comments preceding the command. */
int commentSize; /* Number of bytes in comments (up through
* newline character that terminates the last
* comment). If there were no comments, this
* field is 0. */
- CONST char *commandStart; /* First character in first word of
+ const char *commandStart; /* First character in first word of
* command. */
int commandSize; /* Number of bytes in command, including first
* character of first word, up through the
@@ -2175,13 +2064,13 @@ typedef struct Tcl_Parse {
* They should not be used by functions that invoke Tcl_ParseCommand.
*/
- CONST char *string; /* The original command string passed to
+ const char *string; /* The original command string passed to
* Tcl_ParseCommand. */
- CONST char *end; /* Points to the character just after the last
+ const char *end; /* Points to the character just after the last
* one in the command string. */
Tcl_Interp *interp; /* Interpreter to use for error reporting, or
* NULL. */
- CONST char *term; /* Points to character in string that
+ const char *term; /* Points to character in string that
* terminated most recent token. Filled in by
* ParseTokens. If an error occurs, points to
* beginning of region where the error
@@ -2198,6 +2087,68 @@ typedef struct Tcl_Parse {
* for very large commands that don't fit
* here. */
} Tcl_Parse;
+
+/*
+ *----------------------------------------------------------------------------
+ * The following structure represents a user-defined encoding. It collects
+ * together all the functions that are used by the specific encoding.
+ */
+
+typedef struct Tcl_EncodingType {
+ const char *encodingName; /* The name of the encoding, e.g. "euc-jp".
+ * This name is the unique key for this
+ * encoding type. */
+ Tcl_EncodingConvertProc *toUtfProc;
+ /* Function to convert from external encoding
+ * into UTF-8. */
+ Tcl_EncodingConvertProc *fromUtfProc;
+ /* Function to convert from UTF-8 into
+ * external encoding. */
+ Tcl_EncodingFreeProc *freeProc;
+ /* If non-NULL, function to call when this
+ * encoding is deleted. */
+ ClientData clientData; /* Arbitrary value associated with encoding
+ * type. Passed to conversion functions. */
+ int nullSize; /* Number of zero bytes that signify
+ * end-of-string in this encoding. This number
+ * is used to determine the source string
+ * length when the srcLen argument is
+ * negative. Must be 1 or 2. */
+} Tcl_EncodingType;
+
+/*
+ * The following definitions are used as values for the conversion control
+ * flags argument when converting text from one character set to another:
+ *
+ * TCL_ENCODING_START - Signifies that the source buffer is the first
+ * block in a (potentially multi-block) input
+ * stream. Tells the conversion function to reset
+ * to an initial state and perform any
+ * initialization that needs to occur before the
+ * first byte is converted. If the source buffer
+ * contains the entire input stream to be
+ * converted, this flag should be set.
+ * TCL_ENCODING_END - Signifies that the source buffer is the last
+ * block in a (potentially multi-block) input
+ * stream. Tells the conversion routine to
+ * perform any finalization that needs to occur
+ * after the last byte is converted and then to
+ * reset to an initial state. If the source
+ * buffer contains the entire input stream to be
+ * converted, this flag should be set.
+ * TCL_ENCODING_STOPONERROR - If set, then the converter will return
+ * immediately upon encountering an invalid byte
+ * sequence or a source character that has no
+ * mapping in the target encoding. If clear, then
+ * the converter will skip the problem,
+ * substituting one or more "close" characters in
+ * the destination buffer and then continue to
+ * convert the source.
+ */
+
+#define TCL_ENCODING_START 0x01
+#define TCL_ENCODING_END 0x02
+#define TCL_ENCODING_STOPONERROR 0x04
/*
* The following definitions are the error codes returned by the conversion
@@ -2227,19 +2178,19 @@ typedef struct Tcl_Parse {
* TCL_ENCODING_STOPONERROR was specified.
*/
-#define TCL_CONVERT_MULTIBYTE -1
-#define TCL_CONVERT_SYNTAX -2
-#define TCL_CONVERT_UNKNOWN -3
-#define TCL_CONVERT_NOSPACE -4
+#define TCL_CONVERT_MULTIBYTE (-1)
+#define TCL_CONVERT_SYNTAX (-2)
+#define TCL_CONVERT_UNKNOWN (-3)
+#define TCL_CONVERT_NOSPACE (-4)
/*
* 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
@@ -2251,30 +2202,36 @@ typedef struct Tcl_Parse {
* 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
- * value must be reflected correctly in regcustom.h.
+ * value must be reflected correctly in regcustom.h and
+ * in tclEncoding.c.
+ * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode
+ * XXX: string rep that Tcl_UniChar represents. Changing the size
+ * XXX: of Tcl_UniChar is /not/ supported.
*/
typedef unsigned int Tcl_UniChar;
#else
typedef unsigned short Tcl_UniChar;
#endif
-
+
/*
+ *----------------------------------------------------------------------------
* TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to
* provide the system with the embedded configuration data.
*/
typedef struct Tcl_Config {
- CONST char *key; /* Configuration key to register. ASCII
- * encoded, thus UTF-8 */
- CONST char *value; /* The value associated with the key. System
- * encoding */
+ const char *key; /* Configuration key to register. ASCII
+ * encoded, thus UTF-8. */
+ const char *value; /* The value associated with the key. System
+ * encoding. */
} Tcl_Config;
/*
+ *----------------------------------------------------------------------------
* Flags for TIP#143 limits, detailing which limits are active in an
* interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument.
*/
@@ -2287,44 +2244,136 @@ typedef struct Tcl_Config {
* command- or time-limit is exceeded by an interpreter.
*/
-typedef void (Tcl_LimitHandlerProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-typedef void (Tcl_LimitHandlerDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp);
+typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData);
+
+/*
+ *----------------------------------------------------------------------------
+ * Override definitions for libtommath.
+ */
-#ifndef MP_INT_DECLARED
typedef struct mp_int mp_int;
#define MP_INT_DECLARED
-#endif
-#ifndef MP_DIGIT_DECLARED
-typedef unsigned long mp_digit;
+typedef unsigned int mp_digit;
#define MP_DIGIT_DECLARED
-#endif
-#ifndef TCL_NO_DEPRECATED
- /*
- * Deprecated Tcl functions:
- */
+/*
+ *----------------------------------------------------------------------------
+ * Definitions needed for Tcl_ParseArgvObj routines.
+ * Based on tkArgv.c.
+ * Modifications from the original are copyright (c) Sam Bromley 2006
+ */
-# define Tcl_EvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),0)
-# define Tcl_GlobalEvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+typedef struct {
+ int type; /* Indicates the option type; see below. */
+ const char *keyStr; /* The key string that flags the option in the
+ * argv array. */
+ void *srcPtr; /* Value to be used in setting dst; usage
+ * depends on type.*/
+ void *dstPtr; /* Address of value to be modified; usage
+ * depends on type.*/
+ const char *helpStr; /* Documentation message describing this
+ * option. */
+ ClientData clientData; /* Word to pass to function callbacks. */
+} Tcl_ArgvInfo;
- /*
- * These function have been renamed. The old names are deprecated, but we
- * define these macros for backwards compatibilty.
- */
+/*
+ * Legal values for the type field of a Tcl_ArgInfo: see the user
+ * documentation for details.
+ */
-# define Tcl_Ckalloc Tcl_Alloc
-# define Tcl_Ckfree Tcl_Free
-# define Tcl_Ckrealloc Tcl_Realloc
-# define Tcl_Return Tcl_SetResult
-# define Tcl_TildeSubst Tcl_TranslateFileName
-# define panic Tcl_Panic
-# define panicVA Tcl_PanicVA
-#endif
+#define TCL_ARGV_CONSTANT 15
+#define TCL_ARGV_INT 16
+#define TCL_ARGV_STRING 17
+#define TCL_ARGV_REST 18
+#define TCL_ARGV_FLOAT 19
+#define TCL_ARGV_FUNC 20
+#define TCL_ARGV_GENFUNC 21
+#define TCL_ARGV_HELP 22
+#define TCL_ARGV_END 23
+
+/*
+ * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
+ * argument types:
+ */
+
+typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr,
+ void *dstPtr);
+typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv, void *dstPtr);
/*
+ * Shorthand for commonly used argTable entries.
+ */
+
+#define TCL_ARGV_AUTO_HELP \
+ {TCL_ARGV_HELP, "-help", NULL, NULL, \
+ "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", NULL}
+#define TCL_ARGV_TABLE_END \
+ {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL}
+
+/*
+ *----------------------------------------------------------------------------
+ * Definitions needed for Tcl_Zlib routines. [TIP #234]
+ *
+ * Constants for the format flags describing what sort of data format is
+ * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and
+ * Tcl_ZlibStreamInit functions.
+ */
+
+#define TCL_ZLIB_FORMAT_RAW 1
+#define TCL_ZLIB_FORMAT_ZLIB 2
+#define TCL_ZLIB_FORMAT_GZIP 4
+#define TCL_ZLIB_FORMAT_AUTO 8
+
+/*
+ * Constants that describe whether the stream is to operate in compressing or
+ * decompressing mode.
+ */
+
+#define TCL_ZLIB_STREAM_DEFLATE 16
+#define TCL_ZLIB_STREAM_INFLATE 32
+
+/*
+ * Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is
+ * recommended.
+ */
+
+#define TCL_ZLIB_COMPRESS_NONE 0
+#define TCL_ZLIB_COMPRESS_FAST 1
+#define TCL_ZLIB_COMPRESS_BEST 9
+#define TCL_ZLIB_COMPRESS_DEFAULT (-1)
+
+/*
+ * Constants for types of flushing, used with Tcl_ZlibFlush.
+ */
+
+#define TCL_ZLIB_NO_FLUSH 0
+#define TCL_ZLIB_FLUSH 2
+#define TCL_ZLIB_FULLFLUSH 3
+#define TCL_ZLIB_FINALIZE 4
+
+/*
+ *----------------------------------------------------------------------------
+ * Definitions needed for the Tcl_LoadFile function. [TIP #416]
+ */
+
+#define TCL_LOAD_GLOBAL 1
+#define TCL_LOAD_LAZY 2
+
+/*
+ *----------------------------------------------------------------------------
+ * Single public declaration for NRE.
+ */
+
+typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
+ int result);
+
+/*
+ *----------------------------------------------------------------------------
* The following constant is used to test for older versions of Tcl in the
* stubs tables.
*
@@ -2332,7 +2381,7 @@ typedef unsigned long mp_digit;
* value since the stubs tables don't match.
*/
-#define TCL_STUB_MAGIC ((int)0xFCA3BACF)
+#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
/*
* The following function is required to be defined in all stubs aware
@@ -2341,28 +2390,41 @@ typedef unsigned long mp_digit;
* main library in case an extension is statically linked into an application.
*/
-EXTERN CONST char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *version, int exact));
-
-#ifndef USE_TCL_STUBS
+const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
+ int exact);
+const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
+ const char *version, int epoch, int revision);
/*
* When not using stubs, make it a macro.
*/
+#ifndef USE_TCL_STUBS
#define Tcl_InitStubs(interp, version, exact) \
- Tcl_PkgRequire(interp, "Tcl", version, exact)
-
+ Tcl_PkgInitStubsCheck(interp, version, exact)
#endif
/*
- * Public functions that are not accessible via the stubs table.
+ * TODO - tommath stubs export goes here!
*/
-EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
- Tcl_AppInitProc *appInitProc));
+/*
+ * Public functions that are not accessible via the stubs table.
+ * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
+ */
+#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
+ ((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)
+EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
+#endif
+
/*
+ *----------------------------------------------------------------------------
* Include the public function declarations that are accessible via the stubs
* table.
*/
@@ -2371,24 +2433,202 @@ EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
/*
* Include platform specific public function declarations that are accessible
- * via the stubs table.
+ * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
+ * has effect on building it as a shared library). See ticket [3010352].
*/
+#if defined(BUILD_tcl)
+# undef TCLAPI
+# define TCLAPI MODULE_SCOPE
+#endif
+
#include "tclPlatDecls.h"
/*
+ *----------------------------------------------------------------------------
+ * The following declarations either map ckalloc and ckfree to malloc and
+ * free, or they map them to functions with all sorts of debugging hooks
+ * defined in tclCkalloc.c.
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+# 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 */
+
+/*
+ * If we are not using the debugging allocator, we should call the Tcl_Alloc,
+ * et al. routines in order to guarantee that every module is using the same
+ * memory allocator both inside and outside of the Tcl library.
+ */
+
+# 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
+# define Tcl_DumpActiveMemory(x)
+# undef Tcl_ValidateAllMemory
+# define Tcl_ValidateAllMemory(x,y)
+
+#endif /* !TCL_MEM_DEBUG */
+
+#ifdef TCL_MEM_DEBUG
+# define Tcl_IncrRefCount(objPtr) \
+ Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
+# define Tcl_DecrRefCount(objPtr) \
+ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+# define Tcl_IsShared(objPtr) \
+ Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
+#else
+# define Tcl_IncrRefCount(objPtr) \
+ ++(objPtr)->refCount
+ /*
+ * Use do/while0 idiom for optimum correctness without compiler warnings.
+ * http://c2.com/cgi/wiki?TrivialDoWhileLoop
+ */
+# define Tcl_DecrRefCount(objPtr) \
+ do { \
+ Tcl_Obj *_objPtr = (objPtr); \
+ if (--(_objPtr)->refCount <= 0) { \
+ TclFreeObj(_objPtr); \
+ } \
+ } while(0)
+# define Tcl_IsShared(objPtr) \
+ ((objPtr)->refCount > 1)
+#endif
+
+/*
+ * Macros and definitions that help to debug the use of Tcl objects. When
+ * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
+ * debugging versions of the object creation functions.
+ */
+
+#ifdef TCL_MEM_DEBUG
+# undef Tcl_NewBignumObj
+# define Tcl_NewBignumObj(val) \
+ Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
+# undef Tcl_NewBooleanObj
+# define Tcl_NewBooleanObj(val) \
+ Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+# undef Tcl_NewByteArrayObj
+# define Tcl_NewByteArrayObj(bytes, len) \
+ Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
+# undef Tcl_NewDoubleObj
+# define Tcl_NewDoubleObj(val) \
+ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
+# undef Tcl_NewIntObj
+# define Tcl_NewIntObj(val) \
+ Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+# undef Tcl_NewListObj
+# define Tcl_NewListObj(objc, objv) \
+ Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
+# undef Tcl_NewLongObj
+# define Tcl_NewLongObj(val) \
+ Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+# undef Tcl_NewObj
+# define Tcl_NewObj() \
+ Tcl_DbNewObj(__FILE__, __LINE__)
+# undef Tcl_NewStringObj
+# define Tcl_NewStringObj(bytes, len) \
+ Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
+# undef Tcl_NewWideIntObj
+# define Tcl_NewWideIntObj(val) \
+ Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------------
+ * Macros for clients to use to access fields of hash entries:
+ */
+
+#define Tcl_GetHashValue(h) ((h)->clientData)
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_GetHashKey(tablePtr, h) \
+ ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
+ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
+ ? (h)->key.oneWordValue \
+ : (h)->key.string))
+
+/*
+ * Macros to use for clients to use to invoke find and create functions for
+ * hash tables:
+ */
+
+#undef Tcl_FindHashEntry
+#define Tcl_FindHashEntry(tablePtr, key) \
+ (*((tablePtr)->findProc))(tablePtr, (const char *)(key))
+#undef Tcl_CreateHashEntry
+#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
+
+/*
+ *----------------------------------------------------------------------------
+ * Macros that eliminate the overhead of the thread synchronization functions
+ * when compiling without thread support.
+ */
+
+#ifndef TCL_THREADS
+#undef Tcl_MutexLock
+#define Tcl_MutexLock(mutexPtr)
+#undef Tcl_MutexUnlock
+#define Tcl_MutexUnlock(mutexPtr)
+#undef Tcl_MutexFinalize
+#define Tcl_MutexFinalize(mutexPtr)
+#undef Tcl_ConditionNotify
+#define Tcl_ConditionNotify(condPtr)
+#undef Tcl_ConditionWait
+#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+#undef Tcl_ConditionFinalize
+#define Tcl_ConditionFinalize(condPtr)
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------------
+ * Deprecated Tcl functions:
+ */
+
+#ifndef TCL_NO_DEPRECATED
+/*
+ * These function have been renamed. The old names are deprecated, but we
+ * define these macros for backwards compatibilty.
+ */
+
+# define Tcl_Ckalloc Tcl_Alloc
+# define Tcl_Ckfree Tcl_Free
+# define Tcl_Ckrealloc Tcl_Realloc
+# define Tcl_Return Tcl_SetResult
+# define Tcl_TildeSubst Tcl_TranslateFileName
+# define panic Tcl_Panic
+# define panicVA Tcl_PanicVA
+#endif /* !TCL_NO_DEPRECATED */
+
+/*
+ *----------------------------------------------------------------------------
* Convenience declaration of Tcl_AppInit for backwards compatibility. This
* function is not *implemented* by the tcl library, so the storage class is
* neither DLLEXPORT nor DLLIMPORT.
*/
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS
-
-EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
+extern Tcl_AppInitProc Tcl_AppInit;
#endif /* RC_INVOKED */
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index fcdd75d..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.22 2005/07/19 22:45:18 dkf 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.
@@ -55,19 +47,19 @@ typedef unsigned long caddr_t;
*/
union overhead {
- union overhead *next; /* when free */
- unsigned char padding[8]; /* Ensure the structure is 8-byte aligned. */
+ union overhead *next; /* when free */
+ unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */
struct {
- unsigned char magic0; /* magic number */
- unsigned char index; /* bucket # */
- unsigned char unused; /* unused */
- unsigned char magic1; /* other magic number */
-#ifdef RCHECK
- unsigned short rmagic; /* range magic number */
- unsigned long size; /* actual block size */
- unsigned short unused2; /* padding to 8-byte align */
+ unsigned char magic0; /* magic number */
+ unsigned char index; /* bucket # */
+ unsigned char unused; /* unused */
+ unsigned char magic1; /* other magic number */
+#ifndef NDEBUG
+ unsigned short rmagic; /* range magic number */
+ unsigned long size; /* actual block size */
+ unsigned short unused2; /* padding to 8-byte align */
#endif
- } ovu;
+ } ovu;
#define overMagic0 ovu.magic0
#define overMagic1 ovu.magic1
#define bucketIndex ovu.index
@@ -79,8 +71,8 @@ union overhead {
#define MAGIC 0xef /* magic # on accounting info */
#define RMAGIC 0x5555 /* magic # on range info */
-#ifdef RCHECK
-#define RSLOP sizeof (unsigned short)
+#ifndef NDEBUG
+#define RSLOP sizeof(unsigned short)
#else
#define RSLOP 0
#endif
@@ -96,11 +88,12 @@ union overhead {
/*
* nextf[i] is the pointer to the next free block of size 2^(i+3). The
- * smallest allocatable block is 8 bytes. The overhead information precedes
- * the data area returned to the user.
+ * smallest allocatable block is MINBLOCK bytes. The overhead information
+ * precedes the data area returned to the user.
*/
-#define NBUCKETS 13
+#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
+#define NBUCKETS (13 - (MINBLOCK >> 4))
#define MAXMALLOC (1<<(NBUCKETS+2))
static union overhead *nextf[NBUCKETS];
@@ -141,10 +134,9 @@ static int allocInit = 0;
*/
static unsigned int numMallocs[NBUCKETS+1];
-#include <stdio.h>
#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
@@ -156,7 +148,7 @@ static unsigned int numMallocs[NBUCKETS+1];
* Prototypes for functions used only in this file.
*/
-static void MoreCore _ANSI_ARGS_((int bucket));
+static void MoreCore(int bucket);
/*
*-------------------------------------------------------------------------
@@ -175,7 +167,7 @@ static void MoreCore _ANSI_ARGS_((int bucket));
*/
void
-TclInitAlloc()
+TclInitAlloc(void)
{
if (!allocInit) {
allocInit = 1;
@@ -209,9 +201,9 @@ TclInitAlloc()
*/
void
-TclFinalizeAllocSubsystem()
+TclFinalizeAllocSubsystem(void)
{
- int i;
+ unsigned int i;
struct block *blockPtr, *nextPtr;
Tcl_MutexLock(allocMutexPtr);
@@ -258,18 +250,18 @@ TclFinalizeAllocSubsystem()
*/
char *
-TclpAlloc(numBytes)
- unsigned int numBytes; /* Number of bytes to allocate. */
+TclpAlloc(
+ unsigned int numBytes) /* Number of bytes to allocate. */
{
register union overhead *overPtr;
register long bucket;
register unsigned amount;
- struct block *bigBlockPtr;
+ struct block *bigBlockPtr = NULL;
if (!allocInit) {
/*
* We have to make the "self initializing" because Tcl_Alloc may be
- * used before any other part of Tcl. E.g., see main() for tclsh!
+ * used before any other part of Tcl. E.g., see main() for tclsh!
*/
TclInitAlloc();
@@ -280,9 +272,11 @@ TclpAlloc(numBytes)
* First the simple case: we simple allocate big blocks directly.
*/
- if (numBytes + OVERHEAD >= MAXMALLOC) {
- bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
- (sizeof(struct block) + OVERHEAD + numBytes), 0);
+ if (numBytes >= MAXMALLOC - OVERHEAD) {
+ if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
+ bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
+ (sizeof(struct block) + OVERHEAD + numBytes), 0);
+ }
if (bigBlockPtr == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
return NULL;
@@ -299,7 +293,7 @@ TclpAlloc(numBytes)
numMallocs[NBUCKETS]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and bound space with magic numbers.
*/
@@ -319,13 +313,8 @@ TclpAlloc(numBytes)
* for accounting.
*/
-#ifndef RCHECK
- amount = 8; /* size of first bucket */
- bucket = 0;
-#else
- amount = 16; /* size of first bucket */
- bucket = 1;
-#endif
+ amount = MINBLOCK; /* size of first bucket */
+ bucket = MINBLOCK >> 4;
while (numBytes + OVERHEAD > amount) {
amount <<= 1;
@@ -362,7 +351,7 @@ TclpAlloc(numBytes)
numMallocs[bucket]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and bound space with magic numbers.
*/
@@ -395,8 +384,8 @@ TclpAlloc(numBytes)
*/
static void
-MoreCore(bucket)
- int bucket; /* What bucket to allocat to. */
+MoreCore(
+ int bucket) /* What bucket to allocat to. */
{
register union overhead *overPtr;
register long size; /* size of desired block */
@@ -436,7 +425,7 @@ MoreCore(bucket)
overPtr->next = (union overhead *)((caddr_t)overPtr + size);
overPtr = (union overhead *)((caddr_t)overPtr + size);
}
- overPtr->next = (union overhead *)NULL;
+ overPtr->next = NULL;
}
/*
@@ -456,8 +445,8 @@ MoreCore(bucket)
*/
void
-TclpFree(oldPtr)
- char *oldPtr; /* Pointer to memory to free. */
+TclpFree(
+ char *oldPtr) /* Pointer to memory to free. */
{
register long size;
register union overhead *overPtr;
@@ -468,7 +457,7 @@ TclpFree(oldPtr)
}
Tcl_MutexLock(allocMutexPtr);
- overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
+ overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */
ASSERT(overPtr->overMagic1 == MAGIC);
@@ -521,9 +510,9 @@ TclpFree(oldPtr)
*/
char *
-TclpRealloc(oldPtr, numBytes)
- char *oldPtr; /* Pointer to alloced block. */
- unsigned int numBytes; /* New size of memory. */
+TclpRealloc(
+ char *oldPtr, /* Pointer to alloced block. */
+ unsigned int numBytes) /* New size of memory. */
{
int i;
union overhead *overPtr;
@@ -537,7 +526,7 @@ TclpRealloc(oldPtr, numBytes)
Tcl_MutexLock(allocMutexPtr);
- overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
+ overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */
ASSERT(overPtr->overMagic1 == MAGIC);
@@ -582,7 +571,7 @@ TclpRealloc(oldPtr, numBytes)
numMallocs[NBUCKETS]++;
#endif
-#ifdef RCHECK
+#ifndef NDEBUG
/*
* Record allocated size of block and update magic number bounds.
*/
@@ -615,7 +604,7 @@ TclpRealloc(oldPtr, numBytes)
if (maxSize < numBytes) {
numBytes = maxSize;
}
- memcpy((VOID *) newPtr, (VOID *) oldPtr, (size_t) numBytes);
+ memcpy(newPtr, oldPtr, (size_t) numBytes);
TclpFree(oldPtr);
return newPtr;
}
@@ -624,7 +613,7 @@ TclpRealloc(oldPtr, numBytes)
* 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
@@ -653,8 +642,8 @@ TclpRealloc(oldPtr, numBytes)
#ifdef MSTATS
void
-mstats(s)
- char *s; /* Where to write info. */
+mstats(
+ char *s) /* Where to write info. */
{
register int i, j;
register union overhead *overPtr;
@@ -685,7 +674,7 @@ mstats(s)
}
#endif
-#else /* !USE_TCLALLOC */
+#else /* !USE_TCLALLOC */
/*
*----------------------------------------------------------------------
@@ -704,10 +693,10 @@ mstats(s)
*/
char *
-TclpAlloc(numBytes)
- unsigned int numBytes; /* Number of bytes to allocate. */
+TclpAlloc(
+ unsigned int numBytes) /* Number of bytes to allocate. */
{
- return (char*) malloc(numBytes);
+ return (char *) malloc(numBytes);
}
/*
@@ -727,8 +716,8 @@ TclpAlloc(numBytes)
*/
void
-TclpFree(oldPtr)
- char *oldPtr; /* Pointer to memory to free. */
+TclpFree(
+ char *oldPtr) /* Pointer to memory to free. */
{
free(oldPtr);
return;
@@ -751,11 +740,11 @@ TclpFree(oldPtr)
*/
char *
-TclpRealloc(oldPtr, numBytes)
- char *oldPtr; /* Pointer to alloced block. */
- unsigned int numBytes; /* New size of memory. */
+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..d1866c8
--- /dev/null
+++ b/generic/tclAssembly.c
@@ -0,0 +1,4325 @@
+/*
+ * 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, expandDrop
+ *- dictFirst, dictNext, dictDone
+ *- dictUpdateStart, dictUpdateEnd
+ *- jumpTable testing
+ *- syntax (?)
+ *- returnCodeBranch
+ *- tclooNext, tclooNextClass
+ */
+
+#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 */
+};
+
+/*
+ * 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_STR_CONCAT1, INT_MIN,1},
+ {"concatStk", ASSEM_LIST, INST_CONCAT_STK, 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_STK, 2, 1},
+ {"incrStkImm", ASSEM_SINT1, INST_INCR_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},
+ {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 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_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},
+ {"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1},
+ {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 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_STK, 2, 1},
+ {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
+ {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
+ {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
+ {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,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},
+ {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
+ {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
+ {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
+ {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
+ {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 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},
+ {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
+ {"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_LIST, /* 79 */
+ 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 */
+ INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
+ INST_CONCAT_STK, /* 169 */
+ INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
+ INST_NUM_TYPE /* 180 */
+};
+
+/*
+ * 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);
+ TclUpdateAtCmdStart(op, envPtr);
+ 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);
+ }
+ TclUpdateAtCmdStart(op, envPtr);
+ 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_AppendObjToErrorInfo(interp, objv[0]);
+ Tcl_AddErrorInfo(interp, "\" body, line ");
+ backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
+ Tcl_AppendObjToErrorInfo(interp, 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 */
+ 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 */
+
+
+ /*
+ * 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.twoPtrValue.ptr1;
+ 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.
+ */
+ 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.twoPtrValue.ptr1;
+ 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 */
+
+ int numCommands = envPtr->numCommands;
+ int offset = envPtr->codeNext - envPtr->codeStart;
+ int depth = envPtr->currStackDepth;
+
+ /*
+ * 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 convert any error from the compilation into
+ * bytecode reporting the error;
+ */
+
+ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+ tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.*s\" body, line %d)",
+ parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+ Tcl_GetErrorLine(interp)));
+ envPtr->numCommands = numCommands;
+ envPtr->codeNext = envPtr->codeStart + offset;
+ envPtr->currStackDepth = depth;
+ TclCompileSyntaxError(interp, envPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 */
+ 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);
+
+ /*
+ * Report errors in the parse.
+ */
+
+ if (status != TCL_OK) {
+ if (flags & TCL_EVAL_DIRECT) {
+ Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
+ parsePtr->term + 1 - parsePtr->commandStart);
+ }
+ 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) {
+ int instLen = parsePtr->commandSize;
+ /* Length in bytes of the current command */
+
+ if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+ --instLen;
+ }
+
+ /*
+ * 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 = 1;
+ 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->catchDepth = 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 = TclFetchAuxData(envPtr, auxDataIndex);
+ 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_AppendObjToErrorInfo(interp, lineNo);
+ Tcl_AddErrorInfo(interp, " and ");
+ if (bbPtr->successor1 != NULL) {
+ Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+ Tcl_AppendObjToErrorInfo(interp, 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.twoPtrValue.ptr1;
+
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ objPtr->typePtr = NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index ce29235..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.8 2005/07/19 22:45:19 dkf Exp $
*/
#include "tclInt.h"
@@ -52,12 +50,12 @@ typedef struct ThreadSpecificData {
AsyncHandler *lastHandler; /* Last handler or NULL. */
int asyncReady; /* This is set to 1 whenever a handler becomes
* ready and it is cleared to zero whenever
- * Tcl_AsyncInvoke is called. It can be
+ * Tcl_AsyncInvoke is called. It can be
* checked elsewhere in the application by
* calling Tcl_AsyncReady to see if
* Tcl_AsyncInvoke should be invoked. */
int asyncActive; /* Indicates whether Tcl_AsyncInvoke is
- * currently working. If so then we won't set
+ * currently working. If so then we won't set
* asyncReady again until Tcl_AsyncInvoke
* returns. */
Tcl_Mutex asyncMutex; /* Thread-specific AsyncHandler linked-list
@@ -83,7 +81,7 @@ static Tcl_ThreadDataKey dataKey;
*/
void
-TclFinalizeAsync()
+TclFinalizeAsync(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -112,15 +110,15 @@ TclFinalizeAsync()
*/
Tcl_AsyncHandler
-Tcl_AsyncCreate(proc, clientData)
- Tcl_AsyncProc *proc; /* Procedure to call when handler is
+Tcl_AsyncCreate(
+ Tcl_AsyncProc *proc, /* Procedure to call when handler is
* invoked. */
- ClientData clientData; /* Argument to pass to handler. */
+ ClientData clientData) /* Argument to pass to handler. */
{
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;
@@ -145,7 +143,7 @@ Tcl_AsyncCreate(proc, clientData)
* Tcl_AsyncMark --
*
* This procedure is called to request that an asynchronous handler be
- * invoked as soon as possible. It's typically called from an interrupt
+ * invoked as soon as possible. It's typically called from an interrupt
* handler, where it isn't safe to do anything that depends on or
* modifies application state.
*
@@ -159,8 +157,8 @@ Tcl_AsyncCreate(proc, clientData)
*/
void
-Tcl_AsyncMark(async)
- Tcl_AsyncHandler async; /* Token for handler. */
+Tcl_AsyncMark(
+ Tcl_AsyncHandler async) /* Token for handler. */
{
AsyncHandler *token = (AsyncHandler *) async;
@@ -192,11 +190,11 @@ Tcl_AsyncMark(async)
*/
int
-Tcl_AsyncInvoke(interp, code)
- Tcl_Interp *interp; /* If invoked from Tcl_Eval just after
+Tcl_AsyncInvoke(
+ Tcl_Interp *interp, /* If invoked from Tcl_Eval just after
* completing a command, points to
- * interpreter. Otherwise it is NULL. */
- int code; /* If interp is non-NULL, this gives
+ * interpreter. Otherwise it is NULL. */
+ int code) /* If interp is non-NULL, this gives
* completion code from command that just
* completed. */
{
@@ -237,7 +235,7 @@ Tcl_AsyncInvoke(interp, code)
}
asyncPtr->ready = 0;
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
- code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
+ code = asyncPtr->proc(asyncPtr->clientData, interp, code);
Tcl_MutexLock(&tsdPtr->asyncMutex);
}
tsdPtr->asyncActive = 0;
@@ -259,35 +257,60 @@ Tcl_AsyncInvoke(interp, code)
* Side effects:
* The state associated with the handler is deleted.
*
+ * Failure to locate the handler in current thread private list
+ * of async handlers will result in panic; exception: the list
+ * is already empty (potential trouble?).
+ * Consequently, threads should create and delete handlers
+ * themselves. I.e. a handler created by one should not be
+ * deleted by some other thread.
+ *
*----------------------------------------------------------------------
*/
void
-Tcl_AsyncDelete(async)
- Tcl_AsyncHandler async; /* Token for handler to delete. */
+Tcl_AsyncDelete(
+ Tcl_AsyncHandler async) /* Token for handler to delete. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
AsyncHandler *asyncPtr = (AsyncHandler *) async;
- AsyncHandler *prevPtr;
+ AsyncHandler *prevPtr, *thisPtr;
+
+ /*
+ * Assure early handling of the constraint
+ */
+
+ if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) {
+ Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
+ }
+
+ /*
+ * If we come to this point when TSD's for the current
+ * thread have already been garbage-collected, we are
+ * in the _serious_ trouble. OTOH, we tolerate calling
+ * with already cleaned-up handler list (should we?).
+ */
Tcl_MutexLock(&tsdPtr->asyncMutex);
- if (tsdPtr->firstHandler == asyncPtr) {
- tsdPtr->firstHandler = asyncPtr->nextPtr;
- if (tsdPtr->firstHandler == NULL) {
- tsdPtr->lastHandler = NULL;
+ if (tsdPtr->firstHandler != NULL) {
+ prevPtr = thisPtr = tsdPtr->firstHandler;
+ while (thisPtr != NULL && thisPtr != asyncPtr) {
+ prevPtr = thisPtr;
+ thisPtr = thisPtr->nextPtr;
}
- } else {
- prevPtr = tsdPtr->firstHandler;
- while (prevPtr->nextPtr != asyncPtr) {
- prevPtr = prevPtr->nextPtr;
+ if (thisPtr == NULL) {
+ Tcl_Panic("Tcl_AsyncDelete: cannot find async handler");
+ }
+ if (asyncPtr == tsdPtr->firstHandler) {
+ tsdPtr->firstHandler = asyncPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = asyncPtr->nextPtr;
}
- prevPtr->nextPtr = asyncPtr->nextPtr;
- if (tsdPtr->lastHandler == asyncPtr) {
+ if (asyncPtr == tsdPtr->lastHandler) {
tsdPtr->lastHandler = prevPtr;
}
}
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
- ckfree((char *) asyncPtr);
+ ckfree(asyncPtr);
}
/*
@@ -296,7 +319,7 @@ Tcl_AsyncDelete(async)
* Tcl_AsyncReady --
*
* This procedure can be used to tell whether Tcl_AsyncInvoke needs to be
- * called. This procedure is the external interface for checking the
+ * called. This procedure is the external interface for checking the
* thread-specific asyncReady variable.
*
* Results:
@@ -310,11 +333,18 @@ Tcl_AsyncDelete(async)
*/
int
-Tcl_AsyncReady()
+Tcl_AsyncReady(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return tsdPtr->asyncReady;
}
+
+int *
+TclGetAsyncReadyPtr(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return &(tsdPtr->asyncReady);
+}
/*
* Local Variables:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0198a4e..2a334c4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclBasic.c --
*
* Contains the basic facilities for TCL command interpretation,
@@ -9,272 +9,428 @@
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
+ * Copyright (c) 2008 Miguel Sofer <msofer@users.sourceforge.net>
*
* 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.174 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
+#include "tclOOInt.h"
#include "tclCompile.h"
-#include <float.h>
+#include "tommath.h"
#include <math.h>
+#if NRE_ENABLE_ASSERTS
+#include <assert.h>
+#endif
+
+#define INTERP_STACK_INITIAL_SIZE 2000
+#define CORO_STACK_INITIAL_SIZE 200
+
+/*
+ * Determine whether we're using IEEE floating point
+ */
+
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+# define IEEE_FLOATING_POINT
+/* Largest odd integer that can be represented exactly in a double */
+# define MAX_EXACT 9007199254740991.0
+#endif
+
/*
* The following structure defines the client data for a math function
* registered with Tcl_CreateMathFunc
*/
typedef struct OldMathFuncData {
- Tcl_MathProc* proc; /* Handler procedure */
+ Tcl_MathProc *proc; /* Handler function */
int numArgs; /* Number of args expected */
- Tcl_ValueType* argTypes; /* Types of the args */
+ Tcl_ValueType *argTypes; /* Types of the args */
ClientData clientData; /* Client data for the handler function */
} OldMathFuncData;
/*
- * Static procedures in this file:
+ * This is the script cancellation struct and hash table. The hash table is
+ * used to keep track of the information necessary to process script
+ * cancellation requests, including the original interp, asynchronous handler
+ * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments
+ * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is
+ * used for protecting calls to Tcl_CancelEval as well as protecting access to
+ * the hash table below.
*/
-static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
- CONST char *oldName, CONST char* newName, int flags);
-static void DeleteInterpProc(Tcl_Interp *interp);
-static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
-
-static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-
-static void OldMathFuncDeleteProc(ClientData clientData);
-
-static int ExprAbsFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprBoolFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprIntFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprRandFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprRoundFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprSrandFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST *objv);
-static int VerifyExprObjType(Tcl_Interp *interp, Tcl_Obj *objPtr);
-
-static void MathFuncWrongNumArgs(Tcl_Interp* interp, int expected,
- int actual, Tcl_Obj *CONST *objv);
+typedef struct {
+ Tcl_Interp *interp; /* Interp this struct belongs to. */
+ Tcl_AsyncHandler async; /* Async handler token for script
+ * cancellation. */
+ char *result; /* The script cancellation result or NULL for
+ * a default result. */
+ int length; /* Length of the above error message. */
+ ClientData clientData; /* Ignored */
+ int flags; /* Additional flags */
+} CancelInfo;
+static Tcl_HashTable cancelTable;
+static int cancelTableInitialized = 0; /* 0 means not yet initialized. */
+TCL_DECLARE_MUTEX(cancelLock)
-#ifndef TCL_WIDE_INT_IS_LONG
/*
- * Extract a double value from a general numeric object.
+ * Declarations for managing contexts for non-recursive coroutines. Contexts
+ * are used to save the evaluation state between NR calls to each coro.
*/
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \
- if ((typePtr) == &tclIntType) { \
- (doubleVar) = (double) (objPtr)->internalRep.longValue; \
- } else if ((typePtr) == &tclWideIntType) { \
- (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
- } else { \
- (doubleVar) = (objPtr)->internalRep.doubleValue; \
- }
-#else /* TCL_WIDE_INT_IS_LONG */
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \
- if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \
- (doubleVar) = (double) (objPtr)->internalRep.longValue; \
- } else { \
- (doubleVar) = (objPtr)->internalRep.doubleValue; \
- }
-#endif /* TCL_WIDE_INT_IS_LONG */
-#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \
- (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr), \
- &(wideVar)); \
- if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \
- && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \
- (objPtr)->typePtr = &tclIntType; \
- (objPtr)->internalRep.longValue = (longVar) \
- = Tcl_WideAsLong(wideVar); \
- }
-#define IS_INTEGER_TYPE(typePtr) \
- ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
-#define IS_NUMERIC_TYPE(typePtr) \
- (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
-
+#define SAVE_CONTEXT(context) \
+ (context).framePtr = iPtr->framePtr; \
+ (context).varFramePtr = iPtr->varFramePtr; \
+ (context).cmdFramePtr = iPtr->cmdFramePtr; \
+ (context).lineLABCPtr = iPtr->lineLABCPtr
+
+#define RESTORE_CONTEXT(context) \
+ iPtr->framePtr = (context).framePtr; \
+ iPtr->varFramePtr = (context).varFramePtr; \
+ iPtr->cmdFramePtr = (context).cmdFramePtr; \
+ iPtr->lineLABCPtr = (context).lineLABCPtr
+
/*
- * Macros for testing floating-point values for certain special cases. Test
- * for not-a-number by comparing a value against itself; test for infinity by
- * comparing against the largest floating-point value.
+ * Static functions in this file:
*/
-#ifdef _MSC_VER
-#define IS_NAN(f) (_isnan((f)))
-#define IS_INF(f) (!(_finite((f))))
+static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
+ const char *oldName, const char *newName,
+ int flags);
+static int CancelEvalProc(ClientData clientData,
+ Tcl_Interp *interp, int code);
+static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
+static void DeleteCoroutine(ClientData clientData);
+static void DeleteInterpProc(Tcl_Interp *interp);
+static void DeleteOpCmdClientData(ClientData clientData);
+#ifdef USE_DTRACE
+static Tcl_ObjCmdProc DTraceObjCmd;
+static Tcl_NRPostProc DTraceCmdReturn;
#else
-#define IS_NAN(f) ((f) != (f))
-#define IS_INF(f) (((f) > DBL_MAX) || ((f) < -DBL_MAX))
-#endif
+# define DTraceCmdReturn NULL
+#endif /* USE_DTRACE */
+static Tcl_ObjCmdProc ExprAbsFunc;
+static Tcl_ObjCmdProc ExprBinaryFunc;
+static Tcl_ObjCmdProc ExprBoolFunc;
+static Tcl_ObjCmdProc ExprCeilFunc;
+static Tcl_ObjCmdProc ExprDoubleFunc;
+static Tcl_ObjCmdProc ExprEntierFunc;
+static Tcl_ObjCmdProc ExprFloorFunc;
+static Tcl_ObjCmdProc ExprIntFunc;
+static Tcl_ObjCmdProc ExprIsqrtFunc;
+static Tcl_ObjCmdProc ExprRandFunc;
+static Tcl_ObjCmdProc ExprRoundFunc;
+static Tcl_ObjCmdProc ExprSqrtFunc;
+static Tcl_ObjCmdProc ExprSrandFunc;
+static Tcl_ObjCmdProc ExprUnaryFunc;
+static Tcl_ObjCmdProc ExprWideFunc;
+static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
+ int actual, Tcl_Obj *const *objv);
+static Tcl_NRPostProc NRCoroutineCallerCallback;
+static Tcl_NRPostProc NRCoroutineExitCallback;
+static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+
+static Tcl_ObjCmdProc OldMathFuncProc;
+static void OldMathFuncDeleteProc(ClientData clientData);
+static void ProcessUnexpectedResult(Tcl_Interp *interp,
+ int returnCode);
+static int RewindCoroutine(CoroutineData *corPtr, int result);
+static void TEOV_SwitchVarFrame(Tcl_Interp *interp);
+static void TEOV_PushExceptionHandlers(Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[], int flags);
+static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp,
+ Tcl_Obj *namePtr, Namespace *lookupNsPtr);
+static int TEOV_NotFound(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], Namespace *lookupNsPtr);
+static int TEOV_RunEnterTraces(Tcl_Interp *interp,
+ Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
+ Tcl_Obj *const objv[]);
+static Tcl_NRPostProc RewindCoroutineCallback;
+static Tcl_NRPostProc TailcallCleanup;
+static Tcl_NRPostProc TEOEx_ByteCodeCallback;
+static Tcl_NRPostProc TEOEx_ListCallback;
+static Tcl_NRPostProc TEOV_Error;
+static Tcl_NRPostProc TEOV_Exception;
+static Tcl_NRPostProc TEOV_NotFoundCallback;
+static Tcl_NRPostProc TEOV_RestoreVarFrame;
+static Tcl_NRPostProc TEOV_RunLeaveTraces;
+static Tcl_NRPostProc EvalObjvCore;
+static Tcl_NRPostProc Dispatch;
+
+static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
+
+MODULE_SCOPE const TclStubs tclStubs;
+
+/*
+ * Magical counts for the number of arguments accepted by a coroutine command
+ * after particular kinds of [yield].
+ */
-extern TclStubs tclStubs;
+#define CORO_ACTIVATE_YIELD PTR2INT(NULL)
+#define CORO_ACTIVATE_YIELDM PTR2INT(NULL)+1
+#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1)
+#define COROUTINE_ARGUMENTS_ARBITRARY (-2)
+
/*
- * The following structure defines the commands in the Tcl core.
+ * The following structure define the commands in the Tcl core.
*/
typedef struct {
- char *name; /* Name of object-based command. */
- Tcl_ObjCmdProc *objProc; /* Object-based procedure for command. */
- CompileProc *compileProc; /* Procedure called to compile command. */
- int isSafe; /* If non-zero, command will be present in
- * safe interpreter. Otherwise it will be
- * hidden. */
+ const char *name; /* Name of object-based command. */
+ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
+ CompileProc *compileProc; /* Function called to compile command. */
+ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */
+ int flags; /* Various flag bits, as defined below. */
} CmdInfo;
+#define CMD_IS_SAFE 1 /* Whether this command is part of the set of
+ * commands present by default in a safe
+ * interpreter. */
+/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
+ * expansion for itself rather than needing the generic layer to take care of
+ * it for it. Defined in tclInt.h. */
+
/*
- * The built-in commands, and the procedures that implement them:
+ * The built-in commands, and the functions that implement them:
*/
-static CmdInfo builtInCmds[] = {
+static const CmdInfo builtInCmds[] = {
/*
* Commands in the generic core.
*/
- {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, 1},
- {"array", Tcl_ArrayObjCmd, (CompileProc *) NULL, 1},
- {"binary", Tcl_BinaryObjCmd, (CompileProc *) NULL, 1},
- {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, 1},
- {"case", Tcl_CaseObjCmd, (CompileProc *) NULL, 1},
- {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, 1},
- {"concat", Tcl_ConcatObjCmd, (CompileProc *) NULL, 1},
- {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, 1},
- {"dict", Tcl_DictObjCmd, TclCompileDictCmd, 1},
- {"encoding", Tcl_EncodingObjCmd, (CompileProc *) NULL, 0},
- {"error", Tcl_ErrorObjCmd, (CompileProc *) NULL, 1},
- {"eval", Tcl_EvalObjCmd, (CompileProc *) NULL, 1},
- {"exit", Tcl_ExitObjCmd, (CompileProc *) NULL, 0},
- {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, 1},
- {"fcopy", Tcl_FcopyObjCmd, (CompileProc *) NULL, 1},
- {"fileevent", Tcl_FileEventObjCmd, (CompileProc *) NULL, 1},
- {"for", Tcl_ForObjCmd, TclCompileForCmd, 1},
- {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, 1},
- {"format", Tcl_FormatObjCmd, (CompileProc *) NULL, 1},
- {"global", Tcl_GlobalObjCmd, (CompileProc *) NULL, 1},
- {"if", Tcl_IfObjCmd, TclCompileIfCmd, 1},
- {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, 1},
- {"info", Tcl_InfoObjCmd, (CompileProc *) NULL, 1},
- {"join", Tcl_JoinObjCmd, (CompileProc *) NULL, 1},
- {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, 1},
- {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, 1},
- {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, 1},
- {"linsert", Tcl_LinsertObjCmd, (CompileProc *) NULL, 1},
- {"list", Tcl_ListObjCmd, TclCompileListCmd, 1},
- {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, 1},
- {"load", Tcl_LoadObjCmd, (CompileProc *) NULL, 0},
- {"lrange", Tcl_LrangeObjCmd, (CompileProc *) NULL, 1},
- {"lrepeat", Tcl_LrepeatObjCmd, (CompileProc *) NULL, 1},
- {"lreplace", Tcl_LreplaceObjCmd, (CompileProc *) NULL, 1},
- {"lsearch", Tcl_LsearchObjCmd, (CompileProc *) NULL, 1},
- {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, 1},
- {"lsort", Tcl_LsortObjCmd, (CompileProc *) NULL, 1},
- {"namespace", Tcl_NamespaceObjCmd, (CompileProc *) NULL, 1},
- {"package", Tcl_PackageObjCmd, (CompileProc *) NULL, 1},
- {"proc", Tcl_ProcObjCmd, (CompileProc *) NULL, 1},
- {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, 1},
- {"regsub", Tcl_RegsubObjCmd, (CompileProc *) NULL, 1},
- {"rename", Tcl_RenameObjCmd, (CompileProc *) NULL, 1},
- {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, 1},
- {"scan", Tcl_ScanObjCmd, (CompileProc *) NULL, 1},
- {"set", Tcl_SetObjCmd, TclCompileSetCmd, 1},
- {"split", Tcl_SplitObjCmd, (CompileProc *) NULL, 1},
- {"string", Tcl_StringObjCmd, TclCompileStringCmd, 1},
- {"subst", Tcl_SubstObjCmd, (CompileProc *) NULL, 1},
- {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, 1},
- {"trace", Tcl_TraceObjCmd, (CompileProc *) NULL, 1},
- {"unload", Tcl_UnloadObjCmd, (CompileProc *) NULL, 1},
- {"unset", Tcl_UnsetObjCmd, (CompileProc *) NULL, 1},
- {"uplevel", Tcl_UplevelObjCmd, (CompileProc *) NULL, 1},
- {"upvar", Tcl_UpvarObjCmd, (CompileProc *) NULL, 1},
- {"variable", Tcl_VariableObjCmd, (CompileProc *) NULL, 1},
- {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, 1},
-
- /*
- * Commands in the UNIX core:
- */
-
-#ifndef TCL_GENERIC_ONLY
- {"after", Tcl_AfterObjCmd, (CompileProc *) NULL, 1},
- {"cd", Tcl_CdObjCmd, (CompileProc *) NULL, 0},
- {"close", Tcl_CloseObjCmd, (CompileProc *) NULL, 1},
- {"eof", Tcl_EofObjCmd, (CompileProc *) NULL, 1},
- {"fblocked", Tcl_FblockedObjCmd, (CompileProc *) NULL, 1},
- {"fconfigure", Tcl_FconfigureObjCmd, (CompileProc *) NULL, 0},
- {"file", Tcl_FileObjCmd, (CompileProc *) NULL, 0},
- {"flush", Tcl_FlushObjCmd, (CompileProc *) NULL, 1},
- {"gets", Tcl_GetsObjCmd, (CompileProc *) NULL, 1},
- {"glob", Tcl_GlobObjCmd, (CompileProc *) NULL, 0},
- {"open", Tcl_OpenObjCmd, (CompileProc *) NULL, 0},
- {"pid", Tcl_PidObjCmd, (CompileProc *) NULL, 1},
- {"puts", Tcl_PutsObjCmd, (CompileProc *) NULL, 1},
- {"pwd", Tcl_PwdObjCmd, (CompileProc *) NULL, 0},
- {"read", Tcl_ReadObjCmd, (CompileProc *) NULL, 1},
- {"seek", Tcl_SeekObjCmd, (CompileProc *) NULL, 1},
- {"socket", Tcl_SocketObjCmd, (CompileProc *) NULL, 0},
- {"tell", Tcl_TellObjCmd, (CompileProc *) NULL, 1},
- {"time", Tcl_TimeObjCmd, (CompileProc *) NULL, 1},
- {"update", Tcl_UpdateObjCmd, (CompileProc *) NULL, 1},
- {"vwait", Tcl_VwaitObjCmd, (CompileProc *) NULL, 1},
- {"exec", Tcl_ExecObjCmd, (CompileProc *) NULL, 0},
- {"source", Tcl_SourceObjCmd, (CompileProc *) NULL, 0},
-#endif /* TCL_GENERIC_ONLY */
- {NULL, (Tcl_ObjCmdProc *) NULL, (CompileProc *) NULL, 0}
+ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
+ {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
+ {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
+#ifndef EXCLUDE_OBSOLETE_COMMANDS
+ {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
+#endif
+ {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
+ {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
+ {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
+ {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE},
+ {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE},
+ {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE},
+ {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE},
+ {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE},
+ {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE},
+ {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE},
+ {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE},
+ {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE},
+ {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE},
+ {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE},
+ {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE},
+ {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE},
+ {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE},
+ {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
+ {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
+ {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
+ {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE},
+ {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
+ {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
+ {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE},
+ {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE},
+ {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE},
+ {"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE},
+ {"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, CMD_IS_SAFE},
+ {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, CMD_IS_SAFE},
+ {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE},
+ {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, CMD_IS_SAFE},
+ {"trace", Tcl_TraceObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, CMD_IS_SAFE},
+ {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, CMD_IS_SAFE},
+ {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, CMD_IS_SAFE},
+ {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, CMD_IS_SAFE},
+ {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
+ {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
+ {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
+ {"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
+
+ /*
+ * Commands in the OS-interface. Note that many of these are unsafe.
+ */
+
+ {"after", Tcl_AfterObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"cd", Tcl_CdObjCmd, NULL, NULL, 0},
+ {"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0},
+ {"exec", Tcl_ExecObjCmd, NULL, NULL, 0},
+ {"exit", Tcl_ExitObjCmd, NULL, NULL, 0},
+ {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"fconfigure", Tcl_FconfigureObjCmd, NULL, NULL, 0},
+ {"fcopy", Tcl_FcopyObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"fileevent", Tcl_FileEventObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"flush", Tcl_FlushObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"gets", Tcl_GetsObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"glob", Tcl_GlobObjCmd, NULL, NULL, 0},
+ {"load", Tcl_LoadObjCmd, NULL, NULL, 0},
+ {"open", Tcl_OpenObjCmd, NULL, NULL, 0},
+ {"pid", Tcl_PidObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"puts", Tcl_PutsObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0},
+ {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"socket", Tcl_SocketObjCmd, NULL, NULL, 0},
+ {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0},
+ {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0},
+ {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE},
+ {NULL, NULL, NULL, NULL, 0}
};
/*
- * Math functions
+ * Math functions. All are safe.
*/
typedef struct {
- CONST char* name; /* Name of the function */
- Tcl_ObjCmdProc* objCmdProc; /* Procedure that evaluates the function */
- ClientData clientData; /* Client data for the procedure */
+ const char *name; /* Name of the function. The full name is
+ * "::tcl::mathfunc::<name>". */
+ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */
+ ClientData clientData; /* Client data for the function */
} BuiltinFuncDef;
-static BuiltinFuncDef BuiltinFuncTable[] = {
- { "::tcl::mathfunc::abs", ExprAbsFunc, NULL },
- { "::tcl::mathfunc::acos", ExprUnaryFunc, (ClientData) acos },
- { "::tcl::mathfunc::asin", ExprUnaryFunc, (ClientData) asin },
- { "::tcl::mathfunc::atan", ExprUnaryFunc, (ClientData) atan },
- { "::tcl::mathfunc::atan2", ExprBinaryFunc, (ClientData) atan2 },
- { "::tcl::mathfunc::bool", ExprBoolFunc, NULL },
- { "::tcl::mathfunc::ceil", ExprUnaryFunc, (ClientData) ceil },
- { "::tcl::mathfunc::cos", ExprUnaryFunc, (ClientData) cos },
- { "::tcl::mathfunc::cosh", ExprUnaryFunc, (ClientData) cosh },
- { "::tcl::mathfunc::double",ExprDoubleFunc, NULL },
- { "::tcl::mathfunc::exp", ExprUnaryFunc, (ClientData) exp },
- { "::tcl::mathfunc::floor", ExprUnaryFunc, (ClientData) floor },
- { "::tcl::mathfunc::fmod", ExprBinaryFunc, (ClientData) fmod },
- { "::tcl::mathfunc::hypot", ExprBinaryFunc, (ClientData) hypot },
- { "::tcl::mathfunc::int", ExprIntFunc, NULL },
- { "::tcl::mathfunc::log", ExprUnaryFunc, (ClientData) log },
- { "::tcl::mathfunc::log10", ExprUnaryFunc, (ClientData) log10 },
- { "::tcl::mathfunc::pow", ExprBinaryFunc, (ClientData) pow },
- { "::tcl::mathfunc::rand", ExprRandFunc, NULL },
- { "::tcl::mathfunc::round", ExprRoundFunc, NULL },
- { "::tcl::mathfunc::sin", ExprUnaryFunc, (ClientData) sin },
- { "::tcl::mathfunc::sinh", ExprUnaryFunc, (ClientData) sinh },
- { "::tcl::mathfunc::sqrt", ExprUnaryFunc, (ClientData) sqrt },
- { "::tcl::mathfunc::srand", ExprSrandFunc, NULL },
- { "::tcl::mathfunc::tan", ExprUnaryFunc, (ClientData) tan },
- { "::tcl::mathfunc::tanh", ExprUnaryFunc, (ClientData) tanh },
- { "::tcl::mathfunc::wide", ExprWideFunc, NULL },
+static const BuiltinFuncDef BuiltinFuncTable[] = {
+ { "abs", ExprAbsFunc, NULL },
+ { "acos", ExprUnaryFunc, (ClientData) acos },
+ { "asin", ExprUnaryFunc, (ClientData) asin },
+ { "atan", ExprUnaryFunc, (ClientData) atan },
+ { "atan2", ExprBinaryFunc, (ClientData) atan2 },
+ { "bool", ExprBoolFunc, NULL },
+ { "ceil", ExprCeilFunc, NULL },
+ { "cos", ExprUnaryFunc, (ClientData) cos },
+ { "cosh", ExprUnaryFunc, (ClientData) cosh },
+ { "double", ExprDoubleFunc, NULL },
+ { "entier", ExprEntierFunc, NULL },
+ { "exp", ExprUnaryFunc, (ClientData) exp },
+ { "floor", ExprFloorFunc, NULL },
+ { "fmod", ExprBinaryFunc, (ClientData) fmod },
+ { "hypot", ExprBinaryFunc, (ClientData) hypot },
+ { "int", ExprIntFunc, NULL },
+ { "isqrt", ExprIsqrtFunc, NULL },
+ { "log", ExprUnaryFunc, (ClientData) log },
+ { "log10", ExprUnaryFunc, (ClientData) log10 },
+ { "pow", ExprBinaryFunc, (ClientData) pow },
+ { "rand", ExprRandFunc, NULL },
+ { "round", ExprRoundFunc, NULL },
+ { "sin", ExprUnaryFunc, (ClientData) sin },
+ { "sinh", ExprUnaryFunc, (ClientData) sinh },
+ { "sqrt", ExprSqrtFunc, NULL },
+ { "srand", ExprSrandFunc, NULL },
+ { "tan", ExprUnaryFunc, (ClientData) tan },
+ { "tanh", ExprUnaryFunc, (ClientData) tanh },
+ { "wide", ExprWideFunc, NULL },
{ NULL, NULL, NULL }
};
+/*
+ * TIP#174's math operators. All are safe.
+ */
+
+typedef struct {
+ const char *name; /* Name of object-based command. */
+ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
+ CompileProc *compileProc; /* Function called to compile command. */
+ union {
+ int numArgs;
+ int identity;
+ } i;
+ const char *expected; /* For error message, what argument(s)
+ * were expected. */
+} OpCmdInfo;
+static const OpCmdInfo mathOpCmds[] = {
+ { "~", TclSingleOpCmd, TclCompileInvertOpCmd,
+ /* numArgs */ {1}, "integer"},
+ { "!", TclSingleOpCmd, TclCompileNotOpCmd,
+ /* numArgs */ {1}, "boolean"},
+ { "+", TclVariadicOpCmd, TclCompileAddOpCmd,
+ /* identity */ {0}, NULL},
+ { "*", TclVariadicOpCmd, TclCompileMulOpCmd,
+ /* identity */ {1}, NULL},
+ { "&", TclVariadicOpCmd, TclCompileAndOpCmd,
+ /* identity */ {-1}, NULL},
+ { "|", TclVariadicOpCmd, TclCompileOrOpCmd,
+ /* identity */ {0}, NULL},
+ { "^", TclVariadicOpCmd, TclCompileXorOpCmd,
+ /* identity */ {0}, NULL},
+ { "**", TclVariadicOpCmd, TclCompilePowOpCmd,
+ /* identity */ {1}, NULL},
+ { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd,
+ /* numArgs */ {2}, "integer shift"},
+ { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd,
+ /* numArgs */ {2}, "integer shift"},
+ { "%", TclSingleOpCmd, TclCompileModOpCmd,
+ /* numArgs */ {2}, "integer integer"},
+ { "!=", TclSingleOpCmd, TclCompileNeqOpCmd,
+ /* numArgs */ {2}, "value value"},
+ { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd,
+ /* numArgs */ {2}, "value value"},
+ { "in", TclSingleOpCmd, TclCompileInOpCmd,
+ /* numArgs */ {2}, "value list"},
+ { "ni", TclSingleOpCmd, TclCompileNiOpCmd,
+ /* numArgs */ {2}, "value list"},
+ { "-", TclNoIdentOpCmd, TclCompileMinusOpCmd,
+ /* unused */ {0}, "value ?value ...?"},
+ { "/", TclNoIdentOpCmd, TclCompileDivOpCmd,
+ /* unused */ {0}, "value ?value ...?"},
+ { "<", TclSortingOpCmd, TclCompileLessOpCmd,
+ /* unused */ {0}, NULL},
+ { "<=", TclSortingOpCmd, TclCompileLeqOpCmd,
+ /* unused */ {0}, NULL},
+ { ">", TclSortingOpCmd, TclCompileGreaterOpCmd,
+ /* unused */ {0}, NULL},
+ { ">=", TclSortingOpCmd, TclCompileGeqOpCmd,
+ /* unused */ {0}, NULL},
+ { "==", TclSortingOpCmd, TclCompileEqOpCmd,
+ /* unused */ {0}, NULL},
+ { "eq", TclSortingOpCmd, TclCompileStreqOpCmd,
+ /* unused */ {0}, NULL},
+ { NULL, NULL, NULL,
+ {0}, NULL}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeEvaluation --
+ *
+ * Finalizes the script cancellation hash table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeEvaluation(void)
+{
+ Tcl_MutexLock(&cancelLock);
+ if (cancelTableInitialized == 1) {
+ Tcl_DeleteHashTable(&cancelTable);
+ cancelTableInitialized = 0;
+ }
+ Tcl_MutexUnlock(&cancelLock);
+}
/*
*----------------------------------------------------------------------
@@ -285,7 +441,7 @@ static BuiltinFuncDef BuiltinFuncTable[] = {
*
* Results:
* The return value is a token for the interpreter, which may be used in
- * calls to procedures like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
+ * calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
*
* Side effects:
* The command interpreter is initialized with the built-in commands and
@@ -295,15 +451,18 @@ static BuiltinFuncDef BuiltinFuncTable[] = {
*/
Tcl_Interp *
-Tcl_CreateInterp()
+Tcl_CreateInterp(void)
{
Interp *iPtr;
Tcl_Interp *interp;
Command *cmdPtr;
- BuiltinFuncDef *builtinFuncPtr;
+ const BuiltinFuncDef *builtinFuncPtr;
+ const OpCmdInfo *opcmdInfoPtr;
const CmdInfo *cmdInfoPtr;
- Tcl_Namespace* mathfuncNSPtr;
- int i;
+ Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+ CancelInfo *cancelInfo;
union {
char c[sizeof(short)];
short s;
@@ -311,6 +470,9 @@ Tcl_CreateInterp()
#ifdef TCL_COMPILE_STATS
ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
+ char mathFuncName[32];
+ CallFrame *framePtr;
+ int result;
TclInitSubsystems();
@@ -319,9 +481,30 @@ Tcl_CreateInterp()
* the Tcl_CallFrame structure (or vice versa).
*/
- if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
+ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
/*NOTREACHED*/
- Tcl_Panic("Tcl_CallFrame and CallFrame are not the same size");
+ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
+ }
+
+#if defined(_WIN32) && !defined(_WIN64)
+ if (sizeof(time_t) != 4) {
+ /*NOTREACHED*/
+ Tcl_Panic("<time.h> is not compatible with MSVC");
+ }
+ if ((TclOffset(Tcl_StatBuf,st_atime) != 32)
+ || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) {
+ /*NOTREACHED*/
+ Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
+ }
+#endif
+
+ if (cancelTableInitialized == 0) {
+ Tcl_MutexLock(&cancelLock);
+ if (cancelTableInitialized == 0) {
+ Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
+ cancelTableInitialized = 1;
+ }
+ Tcl_MutexUnlock(&cancelLock);
}
/*
@@ -330,43 +513,85 @@ Tcl_CreateInterp()
* 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;
- iPtr->freeProc = NULL;
- iPtr->errorLine = 0;
- iPtr->objResultPtr = Tcl_NewObj();
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = NULL;
+ iPtr->errorLine = 0;
+ iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
- iPtr->handle = TclHandleCreate(iPtr);
- iPtr->globalNsPtr = NULL;
- iPtr->hiddenCmdTablePtr = NULL;
- iPtr->interpInfo = NULL;
+ iPtr->handle = TclHandleCreate(iPtr);
+ iPtr->globalNsPtr = NULL;
+ iPtr->hiddenCmdTablePtr = NULL;
+ iPtr->interpInfo = NULL;
+
+ TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+ iPtr->extra.optimizer = TclOptimizeBytecode;
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
- iPtr->framePtr = NULL;
- iPtr->varFramePtr = NULL;
+ iPtr->framePtr = NULL; /* Initialise as soon as :: is available */
+ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */
+
+ /*
+ * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
+ * structures.
+ */
+
+ iPtr->cmdFramePtr = NULL;
+ 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);
+ Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
+ iPtr->scriptCLLocPtr = NULL;
+
iPtr->activeVarTracePtr = NULL;
iPtr->returnOpts = NULL;
iPtr->errorInfo = NULL;
- iPtr->eiVar = Tcl_NewStringObj("errorInfo", -1);
+ TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
Tcl_IncrRefCount(iPtr->eiVar);
+ iPtr->errorStack = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(iPtr->errorStack);
+ iPtr->resetErrorStack = 1;
+ TclNewLiteralStringObj(iPtr->upLiteral,"UP");
+ 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;
- iPtr->ecVar = Tcl_NewStringObj("errorCode", -1);
+ TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
Tcl_IncrRefCount(iPtr->ecVar);
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
+ iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
+ iPtr->lookupNsPtr = NULL;
+
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
+
+ /* TIP #268 */
+ if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
+ iPtr->packagePrefer = PKG_PREFER_STABLE;
+ } else {
+ iPtr->packagePrefer = PKG_PREFER_LATEST;
+ }
+
iPtr->cmdCount = 0;
- TclInitLiteralTable(&(iPtr->literalTable));
+ TclInitLiteralTable(&iPtr->literalTable);
iPtr->compileEpoch = 0;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
@@ -377,33 +602,90 @@ Tcl_CreateInterp()
iPtr->tracesForbiddingInline = 0;
iPtr->activeCmdTracePtr = NULL;
iPtr->activeInterpTracePtr = NULL;
- iPtr->assocData = (Tcl_HashTable *) NULL;
- iPtr->execEnvPtr = NULL; /* set after namespaces initialized */
- iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
+ iPtr->assocData = NULL;
+ iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */
+ iPtr->emptyObjPtr = Tcl_NewObj();
+ /* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
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
- iPtr->globalNsPtr = NULL; /* force creation of global ns below */
+ /*
+ * Initialise the tables for variable traces and searches *before*
+ * creating the global ns - so that the trace on errorInfo can be
+ * recorded.
+ */
+
+ Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);
+
+ iPtr->globalNsPtr = NULL; /* Force creation of global ns below. */
iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
- (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+ NULL, NULL);
if (iPtr->globalNsPtr == NULL) {
Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
}
/*
+ * Initialise the rootCallframe. It cannot be allocated on the stack, as
+ * it has to be in place before TclCreateExecEnv tries to use a variable.
+ */
+
+ /* This is needed to satisfy GCC 3.3's strict aliasing rules */
+ framePtr = ckalloc(sizeof(CallFrame));
+ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+ (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
+ if (result != TCL_OK) {
+ Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
+ }
+ framePtr->objc = 0;
+
+ iPtr->framePtr = framePtr;
+ iPtr->varFramePtr = framePtr;
+ iPtr->rootFramePtr = framePtr;
+
+ /*
* Initialize support for code compilation and execution. We call
* TclCreateExecEnv after initializing namespaces since it tries to
* reference a Tcl variable (it links to the Tcl "tcl_traceExec"
* variable).
*/
- iPtr->execEnvPtr = TclCreateExecEnv(interp);
+ iPtr->execEnvPtr = TclCreateExecEnv(interp, INTERP_STACK_INITIAL_SIZE);
/*
* TIP #219, Tcl Channel Reflection API support.
*/
- iPtr->chanMsg = NULL;
+ iPtr->chanMsg = NULL;
+
+ /*
+ * TIP #285, Script cancellation support.
+ */
+
+ iPtr->asyncCancelMsg = Tcl_NewObj();
+
+ cancelInfo = ckalloc(sizeof(CancelInfo));
+ cancelInfo->interp = interp;
+
+ iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
+ cancelInfo->async = iPtr->asyncCancel;
+ cancelInfo->result = NULL;
+ cancelInfo->length = 0;
+
+ Tcl_MutexLock(&cancelLock);
+ hPtr = Tcl_CreateHashEntry(&cancelTable, iPtr, &isNew);
+ Tcl_SetHashValue(hPtr, cancelInfo);
+ Tcl_MutexUnlock(&cancelLock);
/*
* Initialize the compilation and execution statistics kept for this
@@ -411,33 +693,31 @@ Tcl_CreateInterp()
*/
#ifdef TCL_COMPILE_STATS
- statsPtr = &(iPtr->stats);
+ statsPtr = &iPtr->stats;
statsPtr->numExecutions = 0;
statsPtr->numCompilations = 0;
statsPtr->numByteCodesFreed = 0;
- (VOID *) memset(statsPtr->instructionCount, 0,
+ memset(statsPtr->instructionCount, 0,
sizeof(statsPtr->instructionCount));
statsPtr->totalSrcBytes = 0.0;
statsPtr->totalByteCodeBytes = 0.0;
statsPtr->currentSrcBytes = 0.0;
statsPtr->currentByteCodeBytes = 0.0;
- (VOID *) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
- (VOID *) memset(statsPtr->byteCodeCount, 0,
- sizeof(statsPtr->byteCodeCount));
- (VOID *) memset(statsPtr->lifetimeCount, 0,
- sizeof(statsPtr->lifetimeCount));
-
- statsPtr->currentInstBytes = 0.0;
- statsPtr->currentLitBytes = 0.0;
+ memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
+ memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
+ memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));
+
+ statsPtr->currentInstBytes = 0.0;
+ statsPtr->currentLitBytes = 0.0;
statsPtr->currentExceptBytes = 0.0;
- statsPtr->currentAuxBytes = 0.0;
+ statsPtr->currentAuxBytes = 0.0;
statsPtr->currentCmdMapBytes = 0.0;
- statsPtr->numLiteralsCreated = 0;
- statsPtr->totalLitStringBytes = 0.0;
+ statsPtr->numLiteralsCreated = 0;
+ statsPtr->totalLitStringBytes = 0.0;
statsPtr->currentLitStringBytes = 0.0;
- (VOID *) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
+ memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */
/*
@@ -461,130 +741,170 @@ Tcl_CreateInterp()
TclInitLimitSupport(interp);
/*
+ * Initialise the thread-specific data ekeko. Note that the thread's alloc
+ * cache was already initialised by the call to alloc the interp struct.
+ */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ iPtr->allocCache = TclpGetAllocCache();
+#else
+ iPtr->allocCache = NULL;
+#endif
+ iPtr->pendingObjDataPtr = NULL;
+ iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
+ iPtr->deferredCallbacks = NULL;
+
+ /*
* Create the core commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to check for a
* pre-existing command by the same name). If a command has a Tcl_CmdProc
* but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
- * TclInvokeStringCommand. This is an object-based wrapper procedure that
- * extracts strings, calls the string procedure, and creates an object for
+ * TclInvokeStringCommand. This is an object-based wrapper function that
+ * extracts strings, calls the string function, and creates an object for
* the result. Similarly, if a command has a Tcl_ObjCmdProc but no
* Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
*/
- for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
- int new;
- Tcl_HashEntry *hPtr;
-
- if ((cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
- && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
- Tcl_Panic("Tcl_CreateInterp: builtin command with NULL object command proc and a NULL compile proc\n");
+ for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
+ if ((cmdInfoPtr->objProc == NULL)
+ && (cmdInfoPtr->compileProc == NULL)
+ && (cmdInfoPtr->nreProc == NULL)) {
+ Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
}
hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
- cmdInfoPtr->name, &new);
- if (new) {
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdInfoPtr->name, &isNew);
+ if (isNew) {
+ cmdPtr = ckalloc(sizeof(Command));
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = iPtr->globalNsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = cmdInfoPtr->compileProc;
cmdPtr->proc = TclInvokeObjectCommand;
- cmdPtr->clientData = (ClientData) cmdPtr;
+ cmdPtr->clientData = cmdPtr;
cmdPtr->objProc = cmdInfoPtr->objProc;
- cmdPtr->objClientData = (ClientData) NULL;
+ cmdPtr->objClientData = NULL;
cmdPtr->deleteProc = NULL;
- cmdPtr->deleteData = (ClientData) NULL;
+ cmdPtr->deleteData = NULL;
cmdPtr->flags = 0;
+ if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
+ cmdPtr->flags |= CMD_COMPILES_EXPANDED;
+ }
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
+ cmdPtr->nreProc = cmdInfoPtr->nreProc;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
/*
- * Register clock and chan subcommands. These *do* go through
- * Tcl_CreateObjCommand, since they aren't in the global namespace.
+ * 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".
*/
- Tcl_CreateObjCommand(interp, "::tcl::clock::clicks",
- TclClockClicksObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::getenv",
- TclClockGetenvObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::microseconds",
- TclClockMicrosecondsObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::milliseconds",
- TclClockMillisecondsObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::seconds",
- TclClockSecondsObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::Localtime",
- TclClockLocaltimeObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::Mktime",
- TclClockMktimeObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- Tcl_CreateObjCommand(interp, "::tcl::clock::Oldscan",
- TclClockOldscanObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- /* TIP #208 */
- Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
- TclChanTruncateObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- /* TIP #219 */
- Tcl_CreateObjCommand(interp, "::tcl::chan::rCreate",
- TclChanCreateObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
-
- Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
- TclChanPostEventObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
+ TclInitArrayCmd(interp);
+ TclInitBinaryCmd(interp);
+ TclInitChanCmd(interp);
+ TclInitDictCmd(interp);
+ TclInitFileCmd(interp);
+ TclInitInfoCmd(interp);
+ TclInitNamespaceCmd(interp);
+ TclInitStringCmd(interp);
+ TclInitPrefixCmd(interp);
/*
- * Register the built-in functions
+ * Register "clock" subcommands. These *do* go through
+ * Tcl_CreateObjCommand, since they aren't in the global namespace and
+ * involve ensembles.
*/
+ TclClockInit(interp);
+
+ /*
+ * Register the built-in functions. This is empty now that they are
+ * implemented as commands in the ::tcl::mathfunc namespace.
+ */
/*
* Register the default [interp bgerror] handler.
*/
- Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
- TclDefaultBgErrorHandlerObjCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
+ TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
/*
- * Register the unsupported encoding search path command.
+ * Create unsupported commands for debugging bytecode and objects.
*/
- Tcl_CreateObjCommand(interp, "::tcl::unsupported::EncodingDirs",
- TclEncodingDirsObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
+ Tcl_DisassembleObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
+ Tcl_RepresentationCmd, NULL, 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
+ /*
+ * Register the tcl::dtrace command.
+ */
+
+ Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
+#endif /* USE_DTRACE */
/*
* Register the builtin math functions.
*/
- mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc",
- (ClientData) NULL, (Tcl_NamespaceDeleteProc*) NULL);
+ mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
if (mathfuncNSPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
- i = 0;
- for (;;) {
- CONST char* tail;
- builtinFuncPtr = &(BuiltinFuncTable[i++]);
- if (builtinFuncPtr->name == NULL) {
- break;
+#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);
+ Tcl_CreateObjCommand(interp, mathFuncName,
+ builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
+ Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
+ }
+
+ /*
+ * Register the mathematical "operator" commands. [TIP #174]
+ */
+
+ mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
+ if (mathopNSPtr == NULL) {
+ Tcl_Panic("can't create math operator namespace");
+ }
+ Tcl_Export(interp, mathopNSPtr, "*", 1);
+#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 = ckalloc(sizeof(TclOpCmdClientData));
+
+ occdPtr->op = opcmdInfoPtr->name;
+ occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
+ occdPtr->expected = opcmdInfoPtr->expected;
+ strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
+ cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
+ opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
+ if (cmdPtr == NULL) {
+ Tcl_Panic("failed to create math operator %s",
+ opcmdInfoPtr->name);
+ } else if (opcmdInfoPtr->compileProc != NULL) {
+ cmdPtr->compileProc = opcmdInfoPtr->compileProc;
}
- Tcl_CreateObjCommand(interp, builtinFuncPtr->name,
- builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData,
- (Tcl_CmdDeleteProc*) NULL);
- tail = builtinFuncPtr->name + strlen("::tcl::mathfunc::");
- Tcl_Export(interp, mathfuncNSPtr, tail, 0);
}
/*
@@ -592,14 +912,10 @@ Tcl_CreateInterp()
*/
TclInterpInit(interp);
-
-#ifndef TCL_GENERIC_ONLY
TclSetupEnv(interp);
-#endif
/*
- * TIP #59: Make embedded configuration information
- * available.
+ * TIP #59: Make embedded configuration information available.
*/
TclInitEmbeddedConfigurationInformation(interp);
@@ -616,15 +932,19 @@ Tcl_CreateInterp()
Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
+ /* TIP #291 */
+ Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
+ Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
+
/*
* Set up other variables such as tcl_version and tcl_library
*/
Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
- Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
+ Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- TclPrecTraceProc, (ClientData) NULL);
+ TclPrecTraceProc, NULL);
TclpSetVariables(interp);
#ifdef TCL_THREADS
@@ -635,23 +955,47 @@ Tcl_CreateInterp()
* introspect on the interpreter level of thread safety.
*/
-
Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY);
#endif
/*
* Register Tcl's version number.
+ * TIP #268: Full patchlevel instead of just major.minor
*/
- Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
+ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
+
+ if (TclTommath_Init(interp) != TCL_OK) {
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+
+ if (TclOOInit(interp) != TCL_OK) {
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
-#ifdef Tcl_InitStubs
-#undef Tcl_InitStubs
+ /*
+ * Only build in zlib support if we've successfully detected a library to
+ * compile and link against.
+ */
+
+#ifdef HAVE_ZLIB
+ if (TclZlibInit(interp) != TCL_OK) {
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
#endif
- Tcl_InitStubs(interp, TCL_VERSION, 1);
+ TOP_CB(iPtr) = NULL;
return interp;
}
+
+static void
+DeleteOpCmdClientData(
+ ClientData clientData)
+{
+ TclOpCmdClientData *occdPtr = clientData;
+
+ ckfree(occdPtr);
+}
/*
*----------------------------------------------------------------------
@@ -670,19 +1014,20 @@ Tcl_CreateInterp()
*/
int
-TclHideUnsafeCommands(interp)
- Tcl_Interp *interp; /* Hide commands in this interpreter. */
+TclHideUnsafeCommands(
+ Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
- if (interp == (Tcl_Interp *) NULL) {
+ if (interp == NULL) {
return TCL_ERROR;
}
for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
- if (!cmdInfoPtr->isSafe) {
+ if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
+ TclMakeFileCommandSafe(interp); /* Ugh! */
return TCL_OK;
}
@@ -691,11 +1036,11 @@ TclHideUnsafeCommands(interp)
*
* Tcl_CallWhenDeleted --
*
- * Arrange for a procedure to be called before a given interpreter is
- * deleted. The procedure is called as soon as Tcl_DeleteInterp is
- * called; if Tcl_CallWhenDeleted is called on an interpreter that has
- * already been deleted, the procedure will be called when the last
- * Tcl_Release is done on the interpreter.
+ * Arrange for a function to be called before a given interpreter is
+ * deleted. The function is called as soon as Tcl_DeleteInterp is called;
+ * if Tcl_CallWhenDeleted is called on an interpreter that has already
+ * been deleted, the function will be called when the last Tcl_Release is
+ * done on the interpreter.
*
* Results:
* None.
@@ -708,29 +1053,29 @@ TclHideUnsafeCommands(interp)
*/
void
-Tcl_CallWhenDeleted(interp, proc, clientData)
- Tcl_Interp *interp; /* Interpreter to watch. */
- Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter is about
+Tcl_CallWhenDeleted(
+ Tcl_Interp *interp, /* Interpreter to watch. */
+ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
* to be deleted. */
- ClientData clientData; /* One-word value to pass to proc. */
+ ClientData clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
static Tcl_ThreadDataKey assocDataCounterKey;
int *assocDataCounterPtr =
Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
- int new;
+ 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 == (Tcl_HashTable *) NULL) {
- iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ if (iPtr->assocData == NULL) {
+ iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
}
- hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
+ hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
dPtr->proc = proc;
dPtr->clientData = clientData;
Tcl_SetHashValue(hPtr, dPtr);
@@ -741,7 +1086,7 @@ Tcl_CallWhenDeleted(interp, proc, clientData)
*
* Tcl_DontCallWhenDeleted --
*
- * Cancel the arrangement for a procedure to be called when a given
+ * Cancel the arrangement for a function to be called when a given
* interpreter is deleted.
*
* Results:
@@ -756,11 +1101,11 @@ Tcl_CallWhenDeleted(interp, proc, clientData)
*/
void
-Tcl_DontCallWhenDeleted(interp, proc, clientData)
- Tcl_Interp *interp; /* Interpreter to watch. */
- Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter is about
+Tcl_DontCallWhenDeleted(
+ Tcl_Interp *interp, /* Interpreter to watch. */
+ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
* to be deleted. */
- ClientData clientData; /* One-word value to pass to proc. */
+ ClientData clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTablePtr;
@@ -769,14 +1114,14 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
AssocData *dPtr;
hTablePtr = iPtr->assocData;
- if (hTablePtr == (Tcl_HashTable *) NULL) {
+ if (hTablePtr == NULL) {
return;
}
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
- ckfree((char *) dPtr);
+ ckfree(dPtr);
Tcl_DeleteHashEntry(hPtr);
return;
}
@@ -803,27 +1148,27 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
*/
void
-Tcl_SetAssocData(interp, name, proc, clientData)
- Tcl_Interp *interp; /* Interpreter to associate with. */
- CONST char *name; /* Name for association. */
- Tcl_InterpDeleteProc *proc; /* Proc to call when interpreter is about to
+Tcl_SetAssocData(
+ Tcl_Interp *interp, /* Interpreter to associate with. */
+ const char *name, /* Name for association. */
+ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to
* be deleted. */
- ClientData clientData; /* One-word value to pass to proc. */
+ ClientData clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
AssocData *dPtr;
Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
- if (iPtr->assocData == (Tcl_HashTable *) NULL) {
- iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ if (iPtr->assocData == NULL) {
+ iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
}
- hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
- if (new == 0) {
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ 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;
@@ -849,26 +1194,26 @@ Tcl_SetAssocData(interp, name, proc, clientData)
*/
void
-Tcl_DeleteAssocData(interp, name)
- Tcl_Interp *interp; /* Interpreter to associate with. */
- CONST char *name; /* Name of association. */
+Tcl_DeleteAssocData(
+ Tcl_Interp *interp, /* Interpreter to associate with. */
+ const char *name) /* Name of association. */
{
Interp *iPtr = (Interp *) interp;
AssocData *dPtr;
Tcl_HashEntry *hPtr;
- if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+ if (iPtr->assocData == NULL) {
return;
}
hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
- if (hPtr == (Tcl_HashEntry *) NULL) {
+ if (hPtr == NULL) {
return;
}
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
if (dPtr->proc != NULL) {
- (dPtr->proc) (dPtr->clientData, interp);
+ dPtr->proc(dPtr->clientData, interp);
}
- ckfree((char *) dPtr);
+ ckfree(dPtr);
Tcl_DeleteHashEntry(hPtr);
}
@@ -891,10 +1236,10 @@ Tcl_DeleteAssocData(interp, name)
*/
ClientData
-Tcl_GetAssocData(interp, name, procPtr)
- Tcl_Interp *interp; /* Interpreter associated with. */
- CONST char *name; /* Name of association. */
- Tcl_InterpDeleteProc **procPtr;
+Tcl_GetAssocData(
+ Tcl_Interp *interp, /* Interpreter associated with. */
+ const char *name, /* Name of association. */
+ Tcl_InterpDeleteProc **procPtr)
/* Pointer to place to store address of
* current deletion callback. */
{
@@ -902,15 +1247,15 @@ Tcl_GetAssocData(interp, name, procPtr)
AssocData *dPtr;
Tcl_HashEntry *hPtr;
- if (iPtr->assocData == (Tcl_HashTable *) NULL) {
- return (ClientData) NULL;
+ if (iPtr->assocData == NULL) {
+ return NULL;
}
hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return (ClientData) NULL;
+ if (hPtr == NULL) {
+ return NULL;
}
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
- if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
+ dPtr = Tcl_GetHashValue(hPtr);
+ if (procPtr != NULL) {
*procPtr = dPtr->proc;
}
return dPtr->clientData;
@@ -934,8 +1279,8 @@ Tcl_GetAssocData(interp, name, procPtr)
*/
int
-Tcl_InterpDeleted(interp)
- Tcl_Interp *interp;
+Tcl_InterpDeleted(
+ Tcl_Interp *interp)
{
return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
}
@@ -949,7 +1294,7 @@ Tcl_InterpDeleted(interp)
* no Tcl_Preserve calls in effect for this interpreter, it is deleted
* immediately, otherwise the interpreter is deleted when the last
* Tcl_Preserve is matched by a call to Tcl_Release. In either case, the
- * procedure runs the currently registered deletion callbacks.
+ * function runs the currently registered deletion callbacks.
*
* Results:
* None.
@@ -964,8 +1309,8 @@ Tcl_InterpDeleted(interp)
*/
void
-Tcl_DeleteInterp(interp)
- Tcl_Interp *interp; /* Token for command interpreter (returned by
+Tcl_DeleteInterp(
+ Tcl_Interp *interp) /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
{
Interp *iPtr = (Interp *) interp;
@@ -987,19 +1332,10 @@ Tcl_DeleteInterp(interp)
iPtr->compileEpoch++;
/*
- * TIP #219, Tcl Channel Reflection API. Discard a leftover state.
- */
-
- if (iPtr->chanMsg != NULL) {
- Tcl_DecrRefCount (iPtr->chanMsg);
- iPtr->chanMsg = NULL;
- }
-
- /*
* Ensure that the interpreter is eventually deleted.
*/
- Tcl_EventuallyFree((ClientData) interp, (Tcl_FreeProc *) DeleteInterpProc);
+ Tcl_EventuallyFree(interp, (Tcl_FreeProc *) DeleteInterpProc);
}
/*
@@ -1007,9 +1343,9 @@ Tcl_DeleteInterp(interp)
*
* DeleteInterpProc --
*
- * Helper procedure to delete an interpreter. This procedure is called
- * when the last call to Tcl_Preserve on this interpreter is matched by a
- * call to Tcl_Release. The procedure cleans up all resources used in the
+ * Helper function to delete an interpreter. This function is called when
+ * the last call to Tcl_Preserve on this interpreter is matched by a call
+ * to Tcl_Release. The function cleans up all resources used in the
* interpreter and calls all currently registered interpreter deletion
* callbacks.
*
@@ -1024,20 +1360,22 @@ Tcl_DeleteInterp(interp)
*/
static void
-DeleteInterpProc(interp)
- Tcl_Interp *interp; /* Interpreter to delete. */
+DeleteInterpProc(
+ Tcl_Interp *interp) /* Interpreter to delete. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *hTablePtr;
ResolverScheme *resPtr, *nextResPtr;
+ 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");
}
@@ -1051,6 +1389,46 @@ DeleteInterpProc(interp)
}
/*
+ * TIP #219, Tcl Channel Reflection API. Discard a leftover state.
+ */
+
+ if (iPtr->chanMsg != NULL) {
+ Tcl_DecrRefCount(iPtr->chanMsg);
+ iPtr->chanMsg = NULL;
+ }
+
+ /*
+ * TIP #285, Script cancellation support. Delete this interp from the
+ * global hash table of CancelInfo structs.
+ */
+
+ Tcl_MutexLock(&cancelLock);
+ hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
+ if (hPtr != NULL) {
+ CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr);
+
+ if (cancelInfo != NULL) {
+ if (cancelInfo->result != NULL) {
+ ckfree(cancelInfo->result);
+ }
+ ckfree(cancelInfo);
+ }
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ if (iPtr->asyncCancel != NULL) {
+ Tcl_AsyncDelete(iPtr->asyncCancel);
+ iPtr->asyncCancel = NULL;
+ }
+
+ if (iPtr->asyncCancelMsg != NULL) {
+ Tcl_DecrRefCount(iPtr->asyncCancelMsg);
+ iPtr->asyncCancelMsg = NULL;
+ }
+ Tcl_MutexUnlock(&cancelLock);
+
+ /*
* Shut down all limit handler callback scripts that call back into this
* interpreter. Then eliminate all limit handlers for this interpreter.
*/
@@ -1067,7 +1445,6 @@ DeleteInterpProc(interp)
* table, as it will be freed later in this function without further use.
*/
- TclCleanupLiteralTable(interp, &(iPtr->literalTable));
TclHandleFree(iPtr->handle);
TclTeardownNamespace(iPtr->globalNsPtr);
@@ -1080,17 +1457,16 @@ DeleteInterpProc(interp)
/*
* Non-pernicious deletion. The deletion callbacks will not be allowed
* to create any new hidden or non-hidden commands.
- * Tcl_DeleteCommandFromToken() will remove the entry from the
+ * Tcl_DeleteCommandFromToken will remove the entry from the
* hiddenCmdTablePtr.
*/
hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_DeleteCommandFromToken(interp,
- (Tcl_Command) Tcl_GetHashValue(hPtr));
+ Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
}
Tcl_DeleteHashTable(hTablePtr);
- ckfree((char *) hTablePtr);
+ ckfree(hTablePtr);
}
/*
@@ -1098,29 +1474,36 @@ DeleteInterpProc(interp)
* callbacks, so we iterate.
*/
- while (iPtr->assocData != (Tcl_HashTable *) NULL) {
+ while (iPtr->assocData != NULL) {
AssocData *dPtr;
hTablePtr = iPtr->assocData;
- iPtr->assocData = (Tcl_HashTable *) NULL;
+ iPtr->assocData = NULL;
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
- dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+ dPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (dPtr->proc != NULL) {
- (*dPtr->proc)(dPtr->clientData, interp);
+ dPtr->proc(dPtr->clientData, interp);
}
- ckfree((char *) dPtr);
+ ckfree(dPtr);
}
Tcl_DeleteHashTable(hTablePtr);
- ckfree((char *) hTablePtr);
+ ckfree(hTablePtr);
}
/*
- * Finish deleting the global namespace.
+ * Pop the root frame pointer and finish deleting the global
+ * namespace. The order is important [Bug 1658572].
*/
+ if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
+ Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
+ }
+ Tcl_PopCallFrame(interp);
+ ckfree(iPtr->rootFramePtr);
+ iPtr->rootFramePtr = NULL;
Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
/*
@@ -1129,7 +1512,7 @@ DeleteInterpProc(interp)
*/
Tcl_FreeResult(interp);
- interp->result = NULL;
+ iPtr->result = NULL;
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
@@ -1142,6 +1525,12 @@ DeleteInterpProc(interp)
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
+ Tcl_DecrRefCount(iPtr->errorStack);
+ 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);
}
@@ -1151,11 +1540,15 @@ DeleteInterpProc(interp)
}
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
- Tcl_DeleteTrace((Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr);
+ Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
}
if (iPtr->execEnvPtr != NULL) {
TclDeleteExecEnv(iPtr->execEnvPtr);
}
+ if (iPtr->scriptFile) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ iPtr->scriptFile = NULL;
+ }
Tcl_DecrRefCount(iPtr->emptyObjPtr);
iPtr->emptyObjPtr = NULL;
@@ -1163,7 +1556,7 @@ DeleteInterpProc(interp)
while (resPtr) {
nextResPtr = resPtr->nextPtr;
ckfree(resPtr->name);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
resPtr = nextResPtr;
}
@@ -1172,8 +1565,101 @@ DeleteInterpProc(interp)
* interpreter.
*/
- TclDeleteLiteralTable(interp, &(iPtr->literalTable));
- ckfree((char *) iPtr);
+ TclDeleteLiteralTable(interp, &iPtr->literalTable);
+
+ /*
+ * TIP #280 - Release the arrays for ByteCode/Proc extension, and
+ * contents.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
+ Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
+
+ procPtr->iPtr = NULL;
+ if (cfPtr) {
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(cfPtr->data.eval.path);
+ }
+ ckfree(cfPtr->line);
+ ckfree(cfPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(iPtr->linePBodyPtr);
+ ckfree(iPtr->linePBodyPtr);
+ iPtr->linePBodyPtr = NULL;
+
+ /*
+ * See also tclCompile.c, TclCleanupByteCode
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(eclPtr->path);
+ }
+ for (i=0; i< eclPtr->nuloc; i++) {
+ ckfree(eclPtr->loc[i].line);
+ }
+
+ if (eclPtr->loc != NULL) {
+ ckfree(eclPtr->loc);
+ }
+
+ ckfree(eclPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(iPtr->lineBCPtr);
+ ckfree(iPtr->lineBCPtr);
+ iPtr->lineBCPtr = NULL;
+
+ /*
+ * Location stack for uplevel/eval/... scripts which were passed through
+ * proc arguments. Actually we track all arguments as we do not and cannot
+ * know which arguments will be used as scripts and which will not.
+ */
+
+ 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.
+ */
+
+ Tcl_Panic("Argument location tracking table not empty");
+ }
+
+ Tcl_DeleteHashTable(iPtr->lineLAPtr);
+ ckfree((char *) iPtr->lineLAPtr);
+ iPtr->lineLAPtr = NULL;
+
+ 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.
+ */
+
+ Tcl_Panic("Argument location tracking table not empty");
+ }
+
+ Tcl_DeleteHashTable(iPtr->lineLABCPtr);
+ ckfree(iPtr->lineLABCPtr);
+ iPtr->lineLABCPtr = NULL;
+
+ /*
+ * Squelch the tables of traces on variables and searches over arrays in
+ * the in the interpreter.
+ */
+
+ Tcl_DeleteHashTable(&iPtr->varTraces);
+ Tcl_DeleteHashTable(&iPtr->varSearches);
+
+ ckfree(iPtr);
}
/*
@@ -1196,20 +1682,19 @@ DeleteInterpProc(interp)
*/
int
-Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
- Tcl_Interp *interp; /* Interpreter in which to hide command. */
- CONST char *cmdName; /* Name of command to hide. */
- CONST char *hiddenCmdToken; /* Token name of the to-be-hidden command. */
+Tcl_HideCommand(
+ Tcl_Interp *interp, /* Interpreter in which to hide command. */
+ const char *cmdName, /* Name of command to hide. */
+ const char *hiddenCmdToken) /* Token name of the to-be-hidden command. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
Command *cmdPtr;
Tcl_HashTable *hiddenCmdTablePtr;
Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
if (iPtr->flags & DELETED) {
-
/*
* The interpreter is being deleted. Do not create any new structures,
* because it is not safe to modify the interpreter.
@@ -1227,8 +1712,8 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
* We don't need to check for "::" in cmdName because the real check is on
* the nsPtr below.
*
- * hiddenCmdToken is just a string which is not interpreted in any way.
- * It may contain :: but the string is not interpreted as a namespace
+ * hiddenCmdToken is just a string which is not interpreted in any way. It
+ * may contain :: but the string is not interpreted as a namespace
* qualifier command name. Thus, hiding foo::bar to foo::bar and then
* trying to expose or invoke ::foo::bar will NOT work; but if the
* application always uses the same strings it will get consistent
@@ -1240,9 +1725,10 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
*/
if (strstr(hiddenCmdToken, "::") != NULL) {
- Tcl_AppendResult(interp,
- "cannot use namespace qualifiers in hidden command",
- " token (rename)", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use namespace qualifiers in hidden command"
+ " token (rename)", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
return TCL_ERROR;
}
@@ -1252,7 +1738,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
* the command must be given if using namespaces.
*/
- cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+ cmd = Tcl_FindCommand(interp, cmdName, NULL,
/*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
if (cmd == (Tcl_Command) NULL) {
return TCL_ERROR;
@@ -1264,8 +1750,10 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
*/
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
- Tcl_AppendResult(interp, "can only hide global namespace commands",
- " (use rename then hide)", (char *) 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;
}
@@ -1275,8 +1763,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
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;
}
@@ -1287,17 +1774,19 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
* exists.
*/
- hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new);
- if (!new) {
- Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
- "\" already exists", (char *) NULL);
+ hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
+ if (!isNew) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "hidden command named \"%s\" already exists",
+ hiddenCmdToken));
+ Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
return TCL_ERROR;
}
/*
- * Nb : This code is currently 'like' a rename to a specialy set apart
- * name table. Changes here and in TclRenameCommand must be kept in synch
- * untill the common parts are actually factorized out.
+ * NB: This code is currently 'like' a rename to a specialy set apart name
+ * table. Changes here and in TclRenameCommand must be kept in synch until
+ * the common parts are actually factorized out.
*/
/*
@@ -1308,7 +1797,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
- cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
+ cmdPtr->hPtr = NULL;
cmdPtr->cmdEpoch++;
}
@@ -1326,10 +1815,10 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
*/
cmdPtr->hPtr = hPtr;
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ Tcl_SetHashValue(hPtr, cmdPtr);
/*
- * If the command being hidden has a compile procedure, increment the
+ * If the command being hidden has a compile function, increment the
* interpreter's compileEpoch to invalidate its compiled code. This makes
* sure that we don't later try to execute old code compiled with
* command-specific (i.e., inline) bytecodes for the now-hidden command.
@@ -1362,18 +1851,18 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
*/
int
-Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
- Tcl_Interp *interp; /* Interpreter in which to make command
+Tcl_ExposeCommand(
+ Tcl_Interp *interp, /* Interpreter in which to make command
* callable. */
- CONST char *hiddenCmdToken; /* Name of hidden command. */
- CONST char *cmdName; /* Name of to-be-exposed command. */
+ const char *hiddenCmdToken, /* Name of hidden command. */
+ const char *cmdName) /* Name of to-be-exposed command. */
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr;
Namespace *nsPtr;
Tcl_HashEntry *hPtr;
Tcl_HashTable *hiddenCmdTablePtr;
- int new;
+ int isNew;
if (iPtr->flags & DELETED) {
/*
@@ -1391,8 +1880,10 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
*/
if (strstr(cmdName, "::") != NULL) {
- Tcl_AppendResult(interp, "can not expose to a namespace ",
- "(use expose to toplevel, then rename)", (char *) 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;
}
@@ -1405,32 +1896,37 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
if (hiddenCmdTablePtr != NULL) {
hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
}
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
- "\"", (char *) NULL);
+ if (hPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown hidden command \"%s\"", hiddenCmdToken));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
+ hiddenCmdToken, NULL);
return TCL_ERROR;
}
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
/*
* Check that we have a true global namespace command (enforced by
- * Tcl_HideCommand() but let's double check. (If it was not, we would not
+ * Tcl_HideCommand but let's double check. (If it was not, we would not
* really know how to handle it).
*/
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
/*
- * This case is theoritically impossible, we might rather Tcl_Panic()
+ * This case is theoritically impossible, we might rather Tcl_Panic
* than 'nicely' erroring out ?
*/
- Tcl_AppendResult(interp,
- "trying to expose a non global command name space command",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "trying to expose a non-global command namespace command",
+ -1));
return TCL_ERROR;
}
- /* This is the global table */
+ /*
+ * This is the global table.
+ */
+
nsPtr = cmdPtr->nsPtr;
/*
@@ -1438,14 +1934,26 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
* exposing a previously hidden command.
*/
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new);
- if (!new) {
- Tcl_AppendResult(interp, "exposed command \"", cmdName,
- "\" already exists", (char *) NULL);
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
+ if (!isNew) {
+ 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.
@@ -1471,7 +1979,7 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
cmdPtr->hPtr = hPtr;
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ Tcl_SetHashValue(hPtr, cmdPtr);
/*
* Not needed as we are only in the global namespace (but would be needed
@@ -1481,7 +1989,7 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
*/
/*
- * If the command being exposed has a compile procedure, increment
+ * If the command being exposed has a compile function, increment
* interpreter's compileEpoch to invalidate its compiled code. This makes
* sure that we don't later try to execute old code compiled assuming the
* command is hidden. This field is checked in Tcl_EvalObj and
@@ -1512,24 +2020,24 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
* Tcl_Eval, proc will be called. To support the bytecode interpreter,
* the command is created with a wrapper Tcl_ObjCmdProc
* (TclInvokeStringCommand) that eventially calls proc. When the command
- * is deleted from the table, deleteProc will be called. See the manual
+ * is deleted from the table, deleteProc will be called. See the manual
* entry for details on the calling sequence.
*
*----------------------------------------------------------------------
*/
Tcl_Command
-Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
- Tcl_Interp *interp; /* Token for command interpreter returned by a
+Tcl_CreateCommand(
+ Tcl_Interp *interp, /* Token for command interpreter returned by a
* previous call to Tcl_CreateInterp. */
- CONST char *cmdName; /* Name of command. If it contains namespace
+ const char *cmdName, /* Name of command. If it contains namespace
* qualifiers, the new command is put in the
* specified namespace; otherwise it is put in
* the global namespace. */
- Tcl_CmdProc *proc; /* Procedure to associate with cmdName. */
- ClientData clientData; /* Arbitrary value passed to string proc. */
- Tcl_CmdDeleteProc *deleteProc;
- /* If not NULL, gives a procedure to call when
+ Tcl_CmdProc *proc, /* Function to associate with cmdName. */
+ ClientData clientData, /* Arbitrary value passed to string proc. */
+ Tcl_CmdDeleteProc *deleteProc)
+ /* If not NULL, gives a function to call when
* this command is deleted. */
{
Interp *iPtr = (Interp *) interp;
@@ -1537,8 +2045,8 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
- CONST char *tail;
- int new;
+ const char *tail;
+ int isNew;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1557,7 +2065,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
*/
if (strstr(cmdName, "::") != NULL) {
- TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+ TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
@@ -1567,8 +2075,8 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
tail = cmdName;
}
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
- if (!new) {
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+ if (!isNew) {
/*
* Command already exists. Delete the old one. Be careful to preserve
* any existing import links so we can restore them down below. That
@@ -1576,23 +2084,44 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
* intact.
*/
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr = Tcl_GetHashValue(hPtr);
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
- if (!new) {
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+ if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
- ckfree((char*) Tcl_GetHashValue(hPtr));
+ ckfree(Tcl_GetHashValue(hPtr));
}
} 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.
@@ -1601,15 +2130,15 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
TclInvalidateNsCmdLookup(nsPtr);
TclInvalidateNsPath(nsPtr);
}
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
- cmdPtr->compileProc = (CompileProc *) NULL;
+ cmdPtr->compileProc = NULL;
cmdPtr->objProc = TclInvokeStringCommand;
- cmdPtr->objClientData = (ClientData) cmdPtr;
+ cmdPtr->objClientData = cmdPtr;
cmdPtr->proc = proc;
cmdPtr->clientData = clientData;
cmdPtr->deleteProc = deleteProc;
@@ -1617,6 +2146,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
+ cmdPtr->nreProc = NULL;
/*
* Plug in any existing import references found above. Be sure to update
@@ -1627,7 +2157,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
- dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+ dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -1656,12 +2186,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
* future calls to Tcl_GetCommandName.
*
* Side effects:
- * If no command named "cmdName" already exists for interp, one is
- * created. Otherwise, if a command does exist, then if the object-based
- * Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
- * was called previously for the same command and just set its
- * Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
- * command.
+ * If a command named "cmdName" already exists for interp, it is
+ * first deleted. Then the new command is created from the arguments.
+ * [***] (See below for exception).
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
@@ -1673,19 +2200,19 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
*/
Tcl_Command
-Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
- Tcl_Interp *interp; /* Token for command interpreter (returned by
+Tcl_CreateObjCommand(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
* previous call to Tcl_CreateInterp). */
- CONST char *cmdName; /* Name of command. If it contains namespace
+ const char *cmdName, /* Name of command. If it contains namespace
* qualifiers, the new command is put in the
* specified namespace; otherwise it is put in
* the global namespace. */
- Tcl_ObjCmdProc *proc; /* Object-based procedure to associate with
+ Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
- ClientData clientData; /* Arbitrary value to pass to object
- * procedure. */
- Tcl_CmdDeleteProc *deleteProc;
- /* If not NULL, gives a procedure to call when
+ ClientData clientData, /* Arbitrary value to pass to object
+ * function. */
+ Tcl_CmdDeleteProc *deleteProc)
+ /* If not NULL, gives a function to call when
* this command is deleted. */
{
Interp *iPtr = (Interp *) interp;
@@ -1693,8 +2220,8 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
- CONST char *tail;
- int new;
+ const char *tail;
+ int isNew;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1713,7 +2240,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
*/
if (strstr(cmdName, "::") != NULL) {
- TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+ TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
@@ -1723,22 +2250,27 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
tail = cmdName;
}
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
- if (!new) {
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ if (!isNew) {
+ cmdPtr = Tcl_GetHashValue(hPtr);
+
+ /* Command already exists. */
/*
- * Command already exists. If its object-based Tcl_ObjCmdProc is
- * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
- * argument "proc". Otherwise, we delete the old command.
+ * [***] This is wrong. See Tcl Bug a16752c252.
+ * However, this buggy behavior is kept under particular
+ * circumstances to accommodate deployed binaries of the
+ * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
+ * that crash if the bug is fixed.
*/
- if (cmdPtr->objProc == TclInvokeStringCommand) {
+ if (cmdPtr->objProc == TclInvokeStringCommand
+ && cmdPtr->clientData == clientData
+ && cmdPtr->deleteData == clientData
+ && cmdPtr->deleteProc == deleteProc) {
cmdPtr->objProc = proc;
cmdPtr->objClientData = clientData;
- cmdPtr->deleteProc = deleteProc;
- cmdPtr->deleteData = clientData;
return (Tcl_Command) cmdPtr;
}
@@ -1749,46 +2281,67 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
* intact.
*/
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
- if (!new) {
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+ if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
- ckfree((char *) Tcl_GetHashValue(hPtr));
+ ckfree(Tcl_GetHashValue(hPtr));
}
} 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.
*/
TclInvalidateNsCmdLookup(nsPtr);
- TclInvalidateNsPath(nsPtr);
}
- cmdPtr = (Command *) ckalloc(sizeof(Command));
+ cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
- cmdPtr->compileProc = (CompileProc *) NULL;
+ cmdPtr->compileProc = NULL;
cmdPtr->objProc = proc;
cmdPtr->objClientData = clientData;
cmdPtr->proc = TclInvokeObjectCommand;
- cmdPtr->clientData = (ClientData) cmdPtr;
+ cmdPtr->clientData = cmdPtr;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
+ cmdPtr->nreProc = NULL;
/*
* Plug in any existing import references found above. Be sure to update
@@ -1799,7 +2352,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
- dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+ dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
@@ -1822,8 +2375,8 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
* TclInvokeStringCommand --
*
* "Wrapper" Tcl_ObjCmdProc used to call an existing string-based
- * Tcl_CmdProc if no object-based procedure exists for a command. A
- * pointer to this procedure is stored as the Tcl_ObjCmdProc in a Command
+ * Tcl_CmdProc if no object-based function exists for a command. A
+ * pointer to this function is stored as the Tcl_ObjCmdProc in a Command
* structure. It simply turns around and calls the string Tcl_CmdProc in
* the Command structure.
*
@@ -1838,36 +2391,18 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
*/
int
-TclInvokeStringCommand(clientData, interp, objc, objv)
- ClientData clientData; /* Points to command's Command structure. */
- Tcl_Interp *interp; /* Current interpreter. */
- register int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- register Command *cmdPtr = (Command *) clientData;
- register int i;
- int result;
-
- /*
- * This procedure generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
-#define NUM_ARGS 20
- CONST char *(argStorage[NUM_ARGS]);
- CONST char **argv = argStorage;
-
- /*
- * Create the string argument array "argv". Make sure argv is large enough
- * to hold the objc arguments plus 1 extra for the zero end-of-argv word.
- */
-
- if ((objc + 1) > NUM_ARGS) {
- argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
- }
+TclInvokeStringCommand(
+ ClientData clientData, /* Points to command's Command structure. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ register int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Command *cmdPtr = clientData;
+ int i, result;
+ const char **argv =
+ TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
- for (i = 0; i < objc; i++) {
+ for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
}
argv[objc] = 0;
@@ -1876,17 +2411,10 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
* Invoke the command's string-based Tcl_CmdProc.
*/
- result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
+ result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv);
- /*
- * Free the argv array if malloc'ed storage was used.
- */
-
- if (argv != argStorage) {
- ckfree((char *) argv);
- }
+ TclStackFree(interp, (void *) argv);
return result;
-#undef NUM_ARGS
}
/*
@@ -1895,8 +2423,8 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
* TclInvokeObjectCommand --
*
* "Wrapper" Tcl_CmdProc used to call an existing object-based
- * Tcl_ObjCmdProc if no string-based procedure exists for a command. A
- * pointer to this procedure is stored as the Tcl_CmdProc in a Command
+ * Tcl_ObjCmdProc if no string-based function exists for a command. A
+ * pointer to this function is stored as the Tcl_CmdProc in a Command
* structure. It simply turns around and calls the object Tcl_ObjCmdProc
* in the Command structure.
*
@@ -1904,44 +2432,26 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
* A standard Tcl string result value.
*
* Side effects:
- * Besides those side effects of the called Tcl_CmdProc,
- * TclInvokeStringCommand allocates and frees storage.
+ * Besides those side effects of the called Tcl_ObjCmdProc,
+ * TclInvokeObjectCommand allocates and frees storage.
*
*----------------------------------------------------------------------
*/
int
-TclInvokeObjectCommand(clientData, interp, argc, argv)
- ClientData clientData; /* Points to command's Command structure. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- register CONST char **argv; /* Argument strings. */
+TclInvokeObjectCommand(
+ ClientData clientData, /* Points to command's Command structure. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ register const char **argv) /* Argument strings. */
{
- Command *cmdPtr = (Command *) clientData;
- register Tcl_Obj *objPtr;
- register int i;
- int length, result;
-
- /*
- * This procedure generates an objv array for object arguments that hold
- * the argv strings. It starts out with stack-allocated space but uses
- * dynamically-allocated storage if needed.
- */
-
-#define NUM_ARGS 20
- Tcl_Obj *(argStorage[NUM_ARGS]);
- register Tcl_Obj **objv = argStorage;
+ Command *cmdPtr = clientData;
+ Tcl_Obj *objPtr;
+ int i, length, result;
+ Tcl_Obj **objv =
+ TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
- /*
- * Create the object argument array "objv". Make sure objv is large enough
- * to hold the objc arguments plus 1 extra for the zero end-of-objv word.
- */
-
- if (argc > NUM_ARGS) {
- objv = (Tcl_Obj **) ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
- }
-
- for (i = 0; i < argc; i++) {
+ for (i = 0; i < argc; i++) {
length = strlen(argv[i]);
TclNewStringObj(objPtr, argv[i], length);
Tcl_IncrRefCount(objPtr);
@@ -1952,7 +2462,12 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
* Invoke the command's object-based Tcl_ObjCmdProc.
*/
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+ if (cmdPtr->objProc != NULL) {
+ result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
+ } else {
+ result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
+ cmdPtr->objClientData, argc, objv);
+ }
/*
* Move the interpreter's object result to the string result, then reset
@@ -1966,15 +2481,12 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
* free the objv array if malloc'ed storage was used.
*/
- for (i = 0; i < argc; i++) {
+ for (i = 0; i < argc; i++) {
objPtr = objv[i];
Tcl_DecrRefCount(objPtr);
}
- if (objv != argStorage) {
- ckfree((char *) objv);
- }
+ TclStackFree(interp, objv);
return result;
-#undef NUM_ARGS
}
/*
@@ -2002,19 +2514,19 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
*/
int
-TclRenameCommand(interp, oldName, newName)
- Tcl_Interp *interp; /* Current interpreter. */
- char *oldName; /* Existing command name. */
- char *newName; /* New command name. */
+TclRenameCommand(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *oldName, /* Existing command name. */
+ const char *newName) /* New command name. */
{
Interp *iPtr = (Interp *) interp;
- CONST char *newTail;
+ const char *newTail;
Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
Tcl_Command cmd;
Command *cmdPtr;
Tcl_HashEntry *hPtr, *oldHPtr;
- int new, result;
- Tcl_Obj* oldFullName;
+ int isNew, result;
+ Tcl_Obj *oldFullName;
Tcl_DString newFullName;
/*
@@ -2022,13 +2534,14 @@ TclRenameCommand(interp, oldName, newName)
* found.
*/
- cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
+ 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", (char *) NULL);
+ oldName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
return TCL_ERROR;
}
cmdNsPtr = cmdPtr->nsPtr;
@@ -2053,25 +2566,28 @@ TclRenameCommand(interp, oldName, newName)
* create the containing namespaces just like Tcl_CreateCommand would.
*/
- TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
+ TclGetNamespaceForQualName(interp, newName, NULL,
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", (char *) 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", (char *) 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;
}
/*
* Warning: any changes done in the code here are likely to be needed in
- * Tcl_HideCommand() code too (until the common parts are extracted out).
+ * Tcl_HideCommand code too (until the common parts are extracted out).
* - dl
*/
@@ -2082,8 +2598,8 @@ TclRenameCommand(interp, oldName, newName)
*/
oldHPtr = cmdPtr->hPtr;
- hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
- Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+ hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &isNew);
+ Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = newNsPtr;
TclResetShadowedCmdRefs(interp, cmdPtr);
@@ -2112,21 +2628,32 @@ TclRenameCommand(interp, oldName, newName)
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
* TclCleanupCommand.
*
- * The trace procedure needs to get a fully qualified name for old and new
+ * The trace function needs to get a fully qualified name for old and new
* commands [Tcl bug #651271], or else there's no way for the trace
- * procedure to get the namespace from which the old command is being
+ * function to get the namespace from which the old command is being
* renamed!
*/
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++;
@@ -2144,7 +2671,7 @@ TclRenameCommand(interp, oldName, newName)
cmdPtr->cmdEpoch++;
/*
- * If the command being renamed has a compile procedure, increment the
+ * If the command being renamed has a compile function, increment the
* interpreter's compileEpoch to invalidate its compiled code. This makes
* sure that we don't later try to execute old code compiled for the
* now-renamed command.
@@ -2159,7 +2686,7 @@ TclRenameCommand(interp, oldName, newName)
* deleted by invocation of rename traces.
*/
- TclCleanupCommand(cmdPtr);
+ TclCleanupCommandMacro(cmdPtr);
result = TCL_OK;
done:
@@ -2173,7 +2700,7 @@ TclRenameCommand(interp, oldName, newName)
* Tcl_SetCommandInfo --
*
* Modifies various information about a Tcl command. Note that this
- * procedure will not change a command's namespace; use TclRenameCommand
+ * function will not change a command's namespace; use TclRenameCommand
* to do that. Also, the isNativeObjectProc member of *infoPtr is
* ignored.
*
@@ -2189,20 +2716,17 @@ TclRenameCommand(interp, oldName, newName)
*/
int
-Tcl_SetCommandInfo(interp, cmdName, infoPtr)
- Tcl_Interp *interp; /* Interpreter in which to look for
+Tcl_SetCommandInfo(
+ Tcl_Interp *interp, /* Interpreter in which to look for
* command. */
- CONST char *cmdName; /* Name of desired command. */
- CONST Tcl_CmdInfo *infoPtr; /* Where to find information to store in the
+ const char *cmdName, /* Name of desired command. */
+ const Tcl_CmdInfo *infoPtr) /* Where to find information to store in the
* command. */
{
Tcl_Command cmd;
- cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
-
+ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
return Tcl_SetCommandInfoFromToken(cmd, infoPtr);
-
}
/*
@@ -2211,7 +2735,7 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
* Tcl_SetCommandInfoFromToken --
*
* Modifies various information about a Tcl command. Note that this
- * procedure will not change a command's namespace; use TclRenameCommand
+ * function will not change a command's namespace; use TclRenameCommand
* to do that. Also, the isNativeObjectProc member of *infoPtr is
* ignored.
*
@@ -2227,13 +2751,13 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
*/
int
-Tcl_SetCommandInfoFromToken(cmd, infoPtr)
- Tcl_Command cmd;
- CONST Tcl_CmdInfo* infoPtr;
+Tcl_SetCommandInfoFromToken(
+ Tcl_Command cmd,
+ const Tcl_CmdInfo *infoPtr)
{
- Command* cmdPtr; /* Internal representation of the command */
+ Command *cmdPtr; /* Internal representation of the command */
- if (cmd == (Tcl_Command) NULL) {
+ if (cmd == NULL) {
return 0;
}
@@ -2244,11 +2768,15 @@ Tcl_SetCommandInfoFromToken(cmd, infoPtr)
cmdPtr = (Command *) cmd;
cmdPtr->proc = infoPtr->proc;
cmdPtr->clientData = infoPtr->clientData;
- if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+ if (infoPtr->objProc == NULL) {
cmdPtr->objProc = TclInvokeStringCommand;
- cmdPtr->objClientData = (ClientData) cmdPtr;
+ cmdPtr->objClientData = cmdPtr;
+ cmdPtr->nreProc = NULL;
} else {
- cmdPtr->objProc = infoPtr->objProc;
+ if (infoPtr->objProc != cmdPtr->objProc) {
+ cmdPtr->nreProc = NULL;
+ cmdPtr->objProc = infoPtr->objProc;
+ }
cmdPtr->objClientData = infoPtr->objClientData;
}
cmdPtr->deleteProc = infoPtr->deleteProc;
@@ -2275,20 +2803,17 @@ Tcl_SetCommandInfoFromToken(cmd, infoPtr)
*/
int
-Tcl_GetCommandInfo(interp, cmdName, infoPtr)
- Tcl_Interp *interp; /* Interpreter in which to look for
+Tcl_GetCommandInfo(
+ Tcl_Interp *interp, /* Interpreter in which to look for
* command. */
- CONST char *cmdName; /* Name of desired command. */
- Tcl_CmdInfo *infoPtr; /* Where to store information about
+ const char *cmdName, /* Name of desired command. */
+ Tcl_CmdInfo *infoPtr) /* Where to store information about
* command. */
{
Tcl_Command cmd;
- cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
-
+ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
return Tcl_GetCommandInfoFromToken(cmd, infoPtr);
-
}
/*
@@ -2310,13 +2835,13 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
*/
int
-Tcl_GetCommandInfoFromToken(cmd, infoPtr)
- Tcl_Command cmd;
- Tcl_CmdInfo* infoPtr;
+Tcl_GetCommandInfoFromToken(
+ Tcl_Command cmd,
+ Tcl_CmdInfo *infoPtr)
{
- Command* cmdPtr; /* Internal representation of the command */
+ Command *cmdPtr; /* Internal representation of the command */
- if (cmd == (Tcl_Command) NULL) {
+ if (cmd == NULL) {
return 0;
}
@@ -2337,7 +2862,6 @@ Tcl_GetCommandInfoFromToken(cmd, infoPtr)
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
return 1;
-
}
/*
@@ -2345,9 +2869,8 @@ Tcl_GetCommandInfoFromToken(cmd, infoPtr)
*
* Tcl_GetCommandName --
*
- * Given a token returned by Tcl_CreateCommand, this procedure returns
- * the current name of the command (which may have changed due to
- * renaming).
+ * Given a token returned by Tcl_CreateCommand, this function returns the
+ * current name of the command (which may have changed due to renaming).
*
* Results:
* The return value is the name of the given command.
@@ -2358,10 +2881,10 @@ Tcl_GetCommandInfoFromToken(cmd, infoPtr)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetCommandName(interp, command)
- Tcl_Interp *interp; /* Interpreter containing the command. */
- Tcl_Command command; /* Token for command returned by a previous
+const char *
+Tcl_GetCommandName(
+ Tcl_Interp *interp, /* Interpreter containing the command. */
+ Tcl_Command command) /* Token for command returned by a previous
* call to Tcl_CreateCommand. The command must
* not have been deleted. */
{
@@ -2386,7 +2909,7 @@ Tcl_GetCommandName(interp, command)
* Tcl_GetCommandFullName --
*
* Given a token returned by, e.g., Tcl_CreateCommand or Tcl_FindCommand,
- * this procedure appends to an object the command's full name, qualified
+ * this function appends to an object the command's full name, qualified
* by a sequence of parent namespace names. The command's fully-qualified
* name may have changed due to renaming.
*
@@ -2401,12 +2924,12 @@ Tcl_GetCommandName(interp, command)
*/
void
-Tcl_GetCommandFullName(interp, command, objPtr)
- Tcl_Interp *interp; /* Interpreter containing the command. */
- Tcl_Command command; /* Token for command returned by a previous
+Tcl_GetCommandFullName(
+ Tcl_Interp *interp, /* Interpreter containing the command. */
+ Tcl_Command command, /* Token for command returned by a previous
* call to Tcl_CreateCommand. The command must
* not have been deleted. */
- Tcl_Obj *objPtr; /* Points to the object onto which the
+ Tcl_Obj *objPtr) /* Points to the object onto which the
* command's full name is appended. */
{
@@ -2429,7 +2952,7 @@ Tcl_GetCommandFullName(interp, command, objPtr)
if (cmdPtr->hPtr != NULL) {
name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
Tcl_AppendToObj(objPtr, name, -1);
- }
+ }
}
}
@@ -2451,20 +2974,19 @@ Tcl_GetCommandFullName(interp, command, objPtr)
*/
int
-Tcl_DeleteCommand(interp, cmdName)
- Tcl_Interp *interp; /* Token for command interpreter (returned by
+Tcl_DeleteCommand(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous Tcl_CreateInterp call). */
- CONST char *cmdName; /* Name of command to remove. */
+ const char *cmdName) /* Name of command to remove. */
{
Tcl_Command cmd;
/*
- * Find the desired command and delete it.
+ * Find the desired command and delete it.
*/
- cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
- if (cmd == (Tcl_Command) NULL) {
+ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
+ if (cmd == NULL) {
return -1;
}
return Tcl_DeleteCommandFromToken(interp, cmd);
@@ -2475,7 +2997,7 @@ Tcl_DeleteCommand(interp, cmdName)
*
* Tcl_DeleteCommandFromToken --
*
- * Removes the given command from the given interpreter. This procedure
+ * Removes the given command from the given interpreter. This function
* resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead of
* a command name for efficiency.
*
@@ -2491,10 +3013,10 @@ Tcl_DeleteCommand(interp, cmdName)
*/
int
-Tcl_DeleteCommandFromToken(interp, cmd)
- Tcl_Interp *interp; /* Token for command interpreter returned by a
+Tcl_DeleteCommandFromToken(
+ Tcl_Interp *interp, /* Token for command interpreter returned by a
* previous call to Tcl_CreateInterp. */
- Tcl_Command cmd; /* Token for command to delete. */
+ Tcl_Command cmd) /* Token for command to delete. */
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = (Command *) cmd;
@@ -2502,6 +3024,13 @@ Tcl_DeleteCommandFromToken(interp, cmd)
Tcl_Command importCmd;
/*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
+
+ /*
* The code here is tricky. We can't delete the hash table entry before
* invoking the deletion callback because there are cases where the
* deletion callback needs to invoke the command (e.g. object systems such
@@ -2537,7 +3066,7 @@ Tcl_DeleteCommandFromToken(interp, cmd)
cmdPtr->flags |= CMD_IS_DELETED;
/*
- * Call trace procedures for the command being deleted. Then delete its
+ * Call trace functions for the command being deleted. Then delete its
* traces.
*/
@@ -2552,8 +3081,9 @@ Tcl_DeleteCommandFromToken(interp, cmd)
tracePtr = cmdPtr->tracePtr;
while (tracePtr != NULL) {
CommandTrace *nextPtr = tracePtr->nextPtr;
+
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree(tracePtr);
}
tracePtr = nextPtr;
}
@@ -2569,7 +3099,7 @@ Tcl_DeleteCommandFromToken(interp, cmd)
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
/*
- * If the command being deleted has a compile procedure, increment the
+ * If the command being deleted has a compile function, increment the
* interpreter's compileEpoch to invalidate its compiled code. This makes
* sure that we don't later try to execute old code compiled with
* command-specific (i.e., inline) bytecodes for the now-deleted command.
@@ -2587,39 +3117,31 @@ Tcl_DeleteCommandFromToken(interp, cmd)
* created when a command was imported into a namespace, this client
* data will be a pointer to a ImportedCmdData structure describing
* the "real" command that this imported command refers to.
- */
-
- /*
+ *
* If you are getting a crash during the call to deleteProc and
* cmdPtr->deleteProc is a pointer to the function free(), the most
* likely cause is that your extension allocated memory for the
- * clientData argument to Tcl_CreateObjCommand() with the ckalloc()
+ * clientData argument to Tcl_CreateObjCommand with the ckalloc()
* macro and you are now trying to deallocate this memory with free()
* instead of ckfree(). You should pass a pointer to your own method
* that calls ckfree().
*/
- (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+ cmdPtr->deleteProc(cmdPtr->deleteData);
}
/*
- * Bump the command epoch counter. This will invalidate all cached
- * references that point to this command.
- */
-
- cmdPtr->cmdEpoch++;
-
- /*
* If this command was imported into other namespaces, then imported
* commands were created that refer back to this command. Delete these
* imported commands now.
*/
-
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
+ if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
+ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = nextRefPtr) {
+ nextRefPtr = refPtr->nextPtr;
+ importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+ Tcl_DeleteCommandFromToken(interp, importCmd);
+ }
}
/*
@@ -2631,14 +3153,14 @@ Tcl_DeleteCommandFromToken(interp, cmd)
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
+ cmdPtr->hPtr = NULL;
}
/*
- * Mark the Command structure as no longer valid. This allows
- * TclExecuteByteCode to recognize when a Command has logically been
- * deleted and a pointer to this Command structure cached in a CmdName
- * object is invalid. TclExecuteByteCode will look up the command again in
- * the interpreter's command hashtable.
+ * A number of tests for particular kinds of commands are done by checking
+ * whether the objProc field holds a known value. Set the field to NULL so
+ * that such tests won't have false positives when applied to deleted
+ * commands.
*/
cmdPtr->objProc = NULL;
@@ -2648,23 +3170,40 @@ Tcl_DeleteCommandFromToken(interp, cmd)
* 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 TclExecuteByteCode
- * 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).
*/
- TclCleanupCommand(cmdPtr);
+ TclCleanupCommandMacro(cmdPtr);
return 0;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallCommandTraces --
+ *
+ * Abstraction of the code to call traces on a command.
+ *
+ * Results:
+ * Currently always NULL.
+ *
+ * Side effects:
+ * Anything; this may recursively evaluate scripts and code exists to do
+ * just that.
+ *
+ *----------------------------------------------------------------------
+ */
+
static char *
-CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
- Interp *iPtr; /* Interpreter containing command. */
- Command *cmdPtr; /* Command whose traces are to be invoked. */
- CONST char *oldName; /* Command's old name, or NULL if we must get
+CallCommandTraces(
+ Interp *iPtr, /* Interpreter containing command. */
+ Command *cmdPtr, /* Command whose traces are to be invoked. */
+ const char *oldName, /* Command's old name, or NULL if we must get
* the name from cmdPtr */
- CONST char *newName; /* Command's new name, or NULL if the command
+ const char *newName, /* Command's new name, or NULL if the command
* is not being renamed */
- int flags; /* Flags indicating the type of traces to
+ int flags) /* Flags indicating the type of traces to
* trigger, either TCL_TRACE_DELETE or
* TCL_TRACE_RENAME. */
{
@@ -2672,6 +3211,7 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
ActiveCommandTrace active;
char *result;
Tcl_Obj *oldNamePtr = NULL;
+ Tcl_InterpState state = NULL;
if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
/*
@@ -2705,7 +3245,7 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
}
active.cmdPtr = cmdPtr;
- Tcl_Preserve((ClientData) iPtr);
+ Tcl_Preserve(iPtr);
for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
tracePtr = active.nextTracePtr) {
@@ -2722,14 +3262,21 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
oldName = TclGetString(oldNamePtr);
}
tracePtr->refCount++;
- (*tracePtr->traceProc)(tracePtr->clientData,
- (Tcl_Interp *) iPtr, oldName, newName, flags);
+ if (state == NULL) {
+ state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
+ }
+ tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
+ oldName, newName, flags);
cmdPtr->flags &= ~tracePtr->flags;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree(tracePtr);
}
}
+ if (state) {
+ Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
+ }
+
/*
* If a new object was created to hold the full oldName, free it now.
*/
@@ -2746,16 +3293,93 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
cmdPtr->refCount--;
iPtr->activeCmdTracePtr = active.nextPtr;
- Tcl_Release((ClientData) iPtr);
+ Tcl_Release(iPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
+ * CancelEvalProc --
+ *
+ * Marks this interpreter as being canceled. This causes current
+ * executions to be unwound as the interpreter enters a state where it
+ * refuses to execute more commands or handle [catch] or [try], yet the
+ * interpreter is still able to execute further commands after the
+ * cancelation is cleared (unlike if it is deleted).
+ *
+ * Results:
+ * The value given for the code argument.
+ *
+ * Side effects:
+ * Transfers a message from the cancelation message to the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CancelEvalProc(
+ ClientData clientData, /* Interp to cancel the script in progress. */
+ Tcl_Interp *interp, /* Ignored */
+ int code) /* Current return code from command. */
+{
+ CancelInfo *cancelInfo = clientData;
+ Interp *iPtr;
+
+ if (cancelInfo != NULL) {
+ Tcl_MutexLock(&cancelLock);
+ iPtr = (Interp *) cancelInfo->interp;
+
+ if (iPtr != NULL) {
+ /*
+ * 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. 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.
+ */
+
+ TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
+
+ /*
+ * Now, we must set the script cancellation flags on all the slave
+ * interpreters belonging to this one.
+ */
+
+ TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
+ cancelInfo->flags | CANCELED, 0);
+
+ /*
+ * Create the result object now so that Tcl_Canceled can avoid
+ * locking the cancelLock mutex.
+ */
+
+ if (cancelInfo->result != NULL) {
+ Tcl_SetStringObj(iPtr->asyncCancelMsg, cancelInfo->result,
+ cancelInfo->length);
+ } else {
+ Tcl_SetObjLength(iPtr->asyncCancelMsg, 0);
+ }
+ }
+ Tcl_MutexUnlock(&cancelLock);
+ }
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCleanupCommand --
*
- * This procedure frees up a Command structure unless it is still
+ * This function frees up a Command structure unless it is still
* referenced from an interpreter's command hashtable or from a CmdName
* Tcl object representing the name of a command in a ByteCode
* instruction sequence.
@@ -2772,13 +3396,13 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
*/
void
-TclCleanupCommand(cmdPtr)
- register Command *cmdPtr; /* Points to the Command structure to
+TclCleanupCommand(
+ register Command *cmdPtr) /* Points to the Command structure to
* be freed. */
{
cmdPtr->refCount--;
if (cmdPtr->refCount <= 0) {
- ckfree((char *) cmdPtr);
+ ckfree(cmdPtr);
}
}
@@ -2793,7 +3417,7 @@ TclCleanupCommand(cmdPtr)
* None.
*
* Side effects:
- * The function defined by "name" is created or redefined. If the
+ * The Tcl function defined by "name" is created or redefined. If the
* function already exists then its definition is replaced; this includes
* the builtin functions. Redefining a builtin function forces all
* existing code to be invalidated since that code may be compiled using
@@ -2805,42 +3429,34 @@ TclCleanupCommand(cmdPtr)
*/
void
-Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which function is to be
+Tcl_CreateMathFunc(
+ Tcl_Interp *interp, /* Interpreter in which function is to be
* available. */
- CONST char *name; /* Name of function (e.g. "sin"). */
- int numArgs; /* Nnumber of arguments required by
+ const char *name, /* Name of function (e.g. "sin"). */
+ int numArgs, /* Nnumber of arguments required by
* function. */
- Tcl_ValueType *argTypes; /* Array of types acceptable for each
+ Tcl_ValueType *argTypes, /* Array of types acceptable for each
* argument. */
- Tcl_MathProc *proc; /* Procedure that implements the math
+ Tcl_MathProc *proc, /* C function that implements the math
* function. */
- ClientData clientData; /* Additional value to pass to the
+ ClientData clientData) /* Additional value to pass to the
* function. */
{
-
Tcl_DString bigName;
-
- OldMathFuncData *data = (OldMathFuncData *)
- ckalloc(sizeof(OldMathFuncData));
-
- if (numArgs > MAX_MATH_ARGS) {
- Tcl_Panic("attempt to create a math function with too many args");
- }
+ OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
- data->argTypes = (Tcl_ValueType*)
- Tcl_Alloc(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),
- OldMathFuncProc, (ClientData) data, OldMathFuncDeleteProc);
+ OldMathFuncProc, data, OldMathFuncDeleteProc);
Tcl_DStringFree(&bigName);
}
@@ -2861,19 +3477,18 @@ Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
*/
static int
-OldMathFuncProc(clientData, interp, objc, objv)
- ClientData clientData; /* Ponter to OldMathFuncData describing the
+OldMathFuncProc(
+ ClientData clientData, /* Ponter to OldMathFuncData describing the
* function being called */
- Tcl_Interp *interp; /* Tcl interpreter */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Parameter vector */
-{
- Tcl_Obj* valuePtr;
- OldMathFuncData* dataPtr = (OldMathFuncData*) clientData;
- Tcl_Value args[MAX_MATH_ARGS];
- Tcl_Value funcResult;
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Actual parameter count */
+ Tcl_Obj *const *objv) /* Parameter vector */
+{
+ Tcl_Obj *valuePtr;
+ OldMathFuncData *dataPtr = clientData;
+ Tcl_Value funcResult, *args;
int result;
- int i, j, k;
+ int j, k;
double d;
/*
@@ -2889,54 +3504,74 @@ OldMathFuncProc(clientData, interp, objc, objv)
* Convert arguments from Tcl_Obj's to Tcl_Value's.
*/
+ args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
+ /* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
- if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
+#ifdef ACCEPT_NAN
+ if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
+ d = valuePtr->internalRep.doubleValue;
+ result = TCL_OK;
+ }
+#endif
+ if (result != TCL_OK) {
+ /*
+ * We have a non-numeric argument.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "argument to math function didn't have numeric value",
+ -1));
+ TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
+ ckfree(args);
return TCL_ERROR;
}
/*
* Copy the object's numeric value to the argument record, converting
* it if necessary.
+ *
+ * NOTE: no bignum support; use the new mathfunc interface for that.
*/
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- if (dataPtr->argTypes[k] == TCL_DOUBLE) {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = i;
- } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
- args[k].type = TCL_WIDE_INT;
- args[k].wideValue = Tcl_LongAsWide(i);
- } else {
+ args[k].type = dataPtr->argTypes[k];
+ switch (args[k].type) {
+ case TCL_EITHER:
+ if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
+ == TCL_OK) {
args[k].type = TCL_INT;
- args[k].intValue = i;
+ break;
}
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w;
- TclGetWide(w,valuePtr);
- if (dataPtr->argTypes[k] == TCL_DOUBLE) {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = Tcl_WideAsDouble(w);
- } else if (dataPtr->argTypes[k] == TCL_INT) {
- args[k].type = TCL_INT;
- args[k].intValue = Tcl_WideAsLong(w);
- } else {
+ if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
+ == TCL_OK) {
args[k].type = TCL_WIDE_INT;
- args[k].wideValue = w;
+ break;
}
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (dataPtr->argTypes[k] == TCL_INT) {
- args[k].type = TCL_INT;
- args[k].intValue = (long) d;
- } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
- args[k].type = TCL_WIDE_INT;
- args[k].wideValue = Tcl_DoubleAsWide(d);
- } else {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = d;
+ args[k].type = TCL_DOUBLE;
+ /* FALLTHROUGH */
+
+ case TCL_DOUBLE:
+ args[k].doubleValue = d;
+ break;
+ case TCL_INT:
+ if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
+ ckfree(args);
+ return TCL_ERROR;
+ }
+ valuePtr = Tcl_GetObjResult(interp);
+ Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
+ Tcl_ResetResult(interp);
+ break;
+ case TCL_WIDE_INT:
+ if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
+ ckfree(args);
+ return TCL_ERROR;
}
+ valuePtr = Tcl_GetObjResult(interp);
+ Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
+ Tcl_ResetResult(interp);
+ break;
}
}
@@ -2944,7 +3579,9 @@ OldMathFuncProc(clientData, interp, objc, objv)
* Call the function.
*/
- result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
+ errno = 0;
+ result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
+ ckfree(args);
if (result != TCL_OK) {
return result;
}
@@ -2956,18 +3593,12 @@ OldMathFuncProc(clientData, interp, objc, objv)
if (funcResult.type == TCL_INT) {
TclNewLongObj(valuePtr, funcResult.intValue);
} else if (funcResult.type == TCL_WIDE_INT) {
- TclNewWideIntObj(valuePtr, funcResult.wideValue);
+ valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
} else {
- d = funcResult.doubleValue;
- if (IS_NAN(d) || IS_INF(d)) {
- TclExprFloatError(interp, d);
- return TCL_ERROR;
- }
- TclNewDoubleObj(valuePtr, d);
+ return CheckDoubleResult(interp, funcResult.doubleValue);
}
Tcl_SetObjResult(interp, valuePtr);
return TCL_OK;
-
}
/*
@@ -2988,12 +3619,13 @@ OldMathFuncProc(clientData, interp, objc, objv)
*/
static void
-OldMathFuncDeleteProc(clientData)
- ClientData clientData;
+OldMathFuncDeleteProc(
+ ClientData clientData)
{
- OldMathFuncData* dataPtr = (OldMathFuncData*) clientData;
- Tcl_Free((VOID*) dataPtr->argTypes);
- Tcl_Free((VOID*) dataPtr);
+ OldMathFuncData *dataPtr = clientData;
+
+ ckfree(dataPtr->argTypes);
+ ckfree(dataPtr);
}
/*
@@ -3021,26 +3653,25 @@ OldMathFuncDeleteProc(clientData)
*/
int
-Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
- clientDataPtr)
- Tcl_Interp *interp;
- CONST char *name;
- int *numArgsPtr;
- Tcl_ValueType **argTypesPtr;
- Tcl_MathProc **procPtr;
- ClientData *clientDataPtr;
+Tcl_GetMathFuncInfo(
+ Tcl_Interp *interp,
+ const char *name,
+ int *numArgsPtr,
+ Tcl_ValueType **argTypesPtr,
+ Tcl_MathProc **procPtr,
+ ClientData *clientDataPtr)
{
- Tcl_Obj* cmdNameObj;
- Command* cmdPtr;
+ Tcl_Obj *cmdNameObj;
+ Command *cmdPtr;
/*
* Get the command that implements the math function.
*/
- cmdNameObj = Tcl_NewStringObj("tcl::mathfunc::", -1);
+ TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
Tcl_AppendToObj(cmdNameObj, name, -1);
Tcl_IncrRefCount(cmdNameObj);
- cmdPtr = (Command*) Tcl_GetCommandFromObj(interp, cmdNameObj);
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
Tcl_DecrRefCount(cmdNameObj);
/*
@@ -3048,11 +3679,11 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
*/
if (cmdPtr == NULL) {
- Tcl_Obj* message;
- message = Tcl_NewStringObj("unknown math function \"", -1);
- Tcl_AppendToObj(message, name, -1);
- Tcl_AppendToObj(message, "\"", 1);
- *numArgsPtr = -1; *argTypesPtr = NULL;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown math function \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
+ *numArgsPtr = -1;
+ *argTypesPtr = NULL;
*procPtr = NULL;
*clientDataPtr = NULL;
return TCL_ERROR;
@@ -3064,7 +3695,8 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
*/
if (cmdPtr->objProc == &OldMathFuncProc) {
- OldMathFuncData* dataPtr = (OldMathFuncData*) cmdPtr->clientData;
+ OldMathFuncData *dataPtr = cmdPtr->clientData;
+
*procPtr = dataPtr->proc;
*numArgsPtr = dataPtr->numArgs;
*argTypesPtr = dataPtr->argTypes;
@@ -3077,7 +3709,6 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
*clientDataPtr = NULL;
}
return TCL_OK;
-
}
/*
@@ -3100,42 +3731,32 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
*/
Tcl_Obj *
-Tcl_ListMathFuncs(interp, pattern)
- 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();
- Tcl_HashEntry* cmdHashEntry;
- Tcl_HashSearch cmdHashSearch;
- CONST char* cmdNamePtr;
-
- TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
- globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
-
- if (nsPtr != NULL) {
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(pattern, -1));
- }
- } else {
- cmdHashEntry = Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
- for (; cmdHashEntry != NULL;
- cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
- cmdNamePtr = Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
- if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(cmdNamePtr, -1));
- }
- }
- }
+Tcl_ListMathFuncs(
+ Tcl_Interp *interp,
+ const char *pattern)
+{
+ 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 */
+ }
+
+ state = Tcl_SaveInterpState(interp, TCL_OK);
+ Tcl_IncrRefCount(script);
+ if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
+ result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
+ } else {
+ result = Tcl_NewObj();
}
+ Tcl_DecrRefCount(script);
+ Tcl_RestoreInterpState(interp, state);
+
return result;
}
@@ -3158,8 +3779,8 @@ Tcl_ListMathFuncs(interp, pattern)
*/
int
-TclInterpReady(interp)
- Tcl_Interp *interp;
+TclInterpReady(
+ Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
@@ -3175,11 +3796,23 @@ TclInterpReady(interp)
*/
if (iPtr->flags & DELETED) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "attempt to call eval in deleted interpreter", (char *) NULL);
- Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter", (char *) 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) {
+ 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;
}
@@ -3188,229 +3821,275 @@ TclInterpReady(interp)
* probably because of an infinite loop somewhere.
*/
- if (((iPtr->numLevels) > iPtr->maxNestingDepth)
- || (TclpCheckStackSpace() == 0)) {
- Tcl_AppendResult(interp,
- "too many nested evaluations (infinite loop?)", (char *) NULL);
- return TCL_ERROR;
+ if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
+ return TCL_OK;
}
- return TCL_OK;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "too many nested evaluations (infinite loop?)", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * TclEvalObjvInternal --
+ * TclResetCancellation --
*
- * This procedure evaluates a Tcl command that has already been parsed
- * into words, with one Tcl_Obj holding each word. The caller is
- * responsible for managing the iPtr->numLevels.
+ * Reset the script cancellation flags if the nesting level
+ * (iPtr->numLevels) for the interp is zero or argument force is
+ * non-zero.
*
* Results:
- * The return value is a standard Tcl completion code such as TCL_OK or
- * TCL_ERROR. A result or error message is left in interp's result. If an
- * error occurs, this procedure does NOT add any information to the
- * errorInfo variable.
+ * A standard Tcl result.
*
* Side effects:
- * Depends on the command.
+ * The script cancellation flags for the interp may be reset.
*
*----------------------------------------------------------------------
*/
int
-TclEvalObjvInternal(interp, objc, objv, command, length, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
- * command. Also used for error reporting. */
- int objc; /* Number of words in command. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
- * the words that make up the command. */
- CONST char *command; /* Points to the beginning of the string
- * representation of the command; this is used
- * for traces. If the string representation of
- * the command is unknown, an empty string
- * should be supplied. If it is NULL, no
- * traces will be called. */
- int length; /* Number of bytes in command; if -1, all
- * characters up to the first null byte are
- * used. */
- int flags; /* Collection of OR-ed bits that control the
- * evaluation of the script. Only
- * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
- * currently supported. */
-
+TclResetCancellation(
+ Tcl_Interp *interp,
+ int force)
{
- Command *cmdPtr;
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
- int i;
- CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
- * TCL_EVAL_GLOBAL was set. */
- int code = TCL_OK;
- int traceCode = TCL_OK;
- int checkTraces = 1;
+ register Interp *iPtr = (Interp *) interp;
- if (TclInterpReady(interp) == TCL_ERROR) {
+ if (iPtr == NULL) {
return TCL_ERROR;
}
- if (objc == 0) {
- return TCL_OK;
+ if (force || (iPtr->numLevels == 0)) {
+ TclUnsetCancelFlags(iPtr);
}
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Canceled --
+ *
+ * Check if the script in progress has been canceled, i.e.,
+ * Tcl_CancelEval was called for this interpreter or any of its master
+ * interpreters.
+ *
+ * Results:
+ * The return value is TCL_OK if the script evaluation has not been
+ * canceled, TCL_ERROR otherwise.
+ *
+ * If "flags" contains TCL_LEAVE_ERR_MSG, an error message is returned in
+ * the interpreter's result object. Otherwise, the interpreter's result
+ * object is left unchanged. If "flags" contains TCL_CANCEL_UNWIND,
+ * TCL_ERROR will only be returned if the script evaluation is being
+ * completely unwound.
+ *
+ * Side effects:
+ * The CANCELED flag for the interp will be reset if it is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Canceled(
+ Tcl_Interp *interp,
+ int flags)
+{
+ register Interp *iPtr = (Interp *) interp;
/*
- * Find the procedure to execute this command. If there isn't one, then
- * see if there is a command "unknown". If so, create a new word array
- * with "unknown" as the first word and the original command words as
- * arguments. Then call ourselves recursively to execute it.
- *
- * If caller requests, or if we're resolving the target end of an
- * interpeter alias (TCL_EVAL_INVOKE), be sure to do command name
- * resolution in the global namespace.
- *
- * If any execution traces rename or delete the current command, we may
- * need (at most) two passes here.
+ * Has the current script in progress for this interpreter been canceled
+ * or is the stack being unwound due to the previous script cancellation?
*/
- reparseBecauseOfTraces:
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & (TCL_EVAL_INVOKE | TCL_EVAL_GLOBAL)) {
- iPtr->varFramePtr = NULL;
- }
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- iPtr->varFramePtr = savedVarFramePtr;
-
- if (cmdPtr == NULL) {
- newObjv = (Tcl_Obj **)
- ckalloc((unsigned) ((objc + 1) * sizeof(Tcl_Obj *)));
- for (i = objc-1; i >= 0; i--) {
- newObjv[i+1] = objv[i];
- }
- newObjv[0] = Tcl_NewStringObj("::unknown", -1);
- Tcl_IncrRefCount(newObjv[0]);
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
- if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", (char *) NULL);
- code = TCL_ERROR;
- } else {
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objc+1, newObjv,
- command, length, 0);
- iPtr->numLevels--;
- }
- Tcl_DecrRefCount(newObjv[0]);
- ckfree((char *) newObjv);
- goto done;
+ if (!TclCanceled(iPtr)) {
+ return TCL_OK;
}
/*
- * Call trace procedures if needed.
+ * 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 ((checkTraces) && (command != NULL)) {
- int cmdEpoch = cmdPtr->cmdEpoch;
- cmdPtr->refCount++;
-
- /*
- * If the first set of traces modifies/deletes the command or any
- * existing traces, then the set checkTraces to 0 and go through this
- * while loop one more time.
- */
+ iPtr->flags &= ~CANCELED;
- if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
- traceCode = TclCheckInterpTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
- }
- if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
- traceCode = TclCheckExecutionTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
- }
- cmdPtr->refCount--;
- if (cmdEpoch != cmdPtr->cmdEpoch) {
- /*
- * The command has been modified in some way.
- */
+ /*
+ * 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.
+ */
- checkTraces = 0;
- goto reparseBecauseOfTraces;
- }
+ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
+ return TCL_OK;
}
/*
- * Finally, invoke the command's Tcl_ObjCmdProc.
+ * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
+ * interp's result; otherwise, we leave it alone.
*/
- cmdPtr->refCount++;
- iPtr->cmdCount++;
- if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
- if (!(flags & TCL_EVAL_INVOKE) &&
- (iPtr->ensembleRewrite.sourceObjs != NULL) &&
- !Tcl_IsEnsemble((Tcl_Command) cmdPtr)) {
- iPtr->ensembleRewrite.sourceObjs = NULL;
- }
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
- iPtr->varFramePtr = savedVarFramePtr;
- }
- if (Tcl_AsyncReady()) {
- code = Tcl_AsyncInvoke(interp, code);
- }
- if (code == TCL_OK && Tcl_LimitReady(interp)) {
- code = Tcl_LimitCheck(interp);
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ const char *id, *message = NULL;
+ int length;
+
+ /*
+ * Setup errorCode variables so that we can differentiate between
+ * being canceled and unwound.
+ */
+
+ if (iPtr->asyncCancelMsg != NULL) {
+ message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
+ } else {
+ length = 0;
+ }
+
+ if (iPtr->flags & TCL_CANCEL_UNWIND) {
+ id = "IUNWIND";
+ if (length == 0) {
+ message = "eval unwound";
+ }
+ } else {
+ id = "ICANCEL";
+ if (length == 0) {
+ message = "eval canceled";
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
+ Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
}
/*
- * Call 'leave' command traces
+ * 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 (!(cmdPtr->flags & CMD_IS_DELETED)) {
- if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
- traceCode = TclCheckExecutionTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
- }
- if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
- traceCode = TclCheckInterpTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
- }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CancelEval --
+ *
+ * This function schedules the cancellation of the current script in the
+ * given interpreter.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR. Since the interp may belong to a different thread, no error
+ * message can be left in the interp's result.
+ *
+ * Side effects:
+ * The script in progress in the specified interpreter will be canceled
+ * with TCL_ERROR after asynchronous handlers are invoked at the next
+ * Tcl_Canceled check.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CancelEval(
+ Tcl_Interp *interp, /* Interpreter in which to cancel the
+ * script. */
+ Tcl_Obj *resultObjPtr, /* The script cancellation error message or
+ * NULL for a default error message. */
+ ClientData clientData, /* Passed to CancelEvalProc. */
+ int flags) /* Collection of OR-ed bits that control
+ * the cancellation of the script. Only
+ * TCL_CANCEL_UNWIND is currently
+ * supported. */
+{
+ Tcl_HashEntry *hPtr;
+ CancelInfo *cancelInfo;
+ int code = TCL_ERROR;
+ const char *result;
+
+ if (interp == NULL) {
+ return TCL_ERROR;
}
- TclCleanupCommand(cmdPtr);
- /*
- * If one of the trace invocation resulted in error, then change the
- * result code accordingly. Note, that the interp->result should already
- * be set correctly by the call to TraceExecutionProc.
- */
+ Tcl_MutexLock(&cancelLock);
+ if (cancelTableInitialized != 1) {
+ /*
+ * No CancelInfo hash table (Tcl_CreateInterp has never been called?)
+ */
- if (traceCode != TCL_OK) {
- code = traceCode;
+ goto done;
+ }
+ hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp);
+ if (hPtr == NULL) {
+ /*
+ * No CancelInfo record for this interpreter.
+ */
+
+ goto done;
}
+ cancelInfo = Tcl_GetHashValue(hPtr);
/*
- * If the interpreter has a non-empty string result, the result object is
- * either empty or stale because some procedure set interp->result
- * directly. If so, move the string result to the result object, then
- * reset the string result.
+ * Populate information needed by the interpreter thread to fulfill the
+ * cancellation request. Currently, clientData is ignored. If the
+ * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
+ * allowed to catch the script cancellation because the evaluation stack
+ * for the interp is completely unwound.
*/
- if (*(iPtr->result) != 0) {
- (void) Tcl_GetObjResult(interp);
+ if (resultObjPtr != NULL) {
+ result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
+ cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
+ memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
+ TclDecrRefCount(resultObjPtr); /* Discard their result object. */
+ } else {
+ cancelInfo->result = NULL;
+ cancelInfo->length = 0;
}
+ cancelInfo->clientData = clientData;
+ cancelInfo->flags = flags;
+ Tcl_AsyncMark(cancelInfo->async);
+ code = TCL_OK;
done:
+ Tcl_MutexUnlock(&cancelLock);
return code;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_InterpActive --
+ *
+ * Returns non-zero if the specified interpreter is in use, i.e. if there
+ * is an evaluation currently active in the interpreter.
+ *
+ * Results:
+ * See above.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InterpActive(
+ Tcl_Interp *interp)
+{
+ return ((Interp *) interp)->numLevels > 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_EvalObjv --
*
- * This procedure evaluates a Tcl command that has already been parsed
+ * This function evaluates a Tcl command that has already been parsed
* into words, with one Tcl_Obj holding each word.
*
* Results:
@@ -3418,155 +4097,713 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
* TCL_ERROR. A result or error message is left in interp's result.
*
* Side effects:
- * Depends on the command.
+ * Always pushes a callback. Other side effects depend on the command.
*
*----------------------------------------------------------------------
*/
int
-Tcl_EvalObjv(interp, objc, objv, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
+Tcl_EvalObjv(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
- int objc; /* Number of words in command. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ int objc, /* Number of words in command. */
+ Tcl_Obj *const objv[], /* An array of pointers to objects that are
* the words that make up the command. */
- int flags; /* Collection of OR-ed bits that control the
+ int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Only
- * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
- * currently supported. */
+ * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+ * TCL_EVAL_NOERR are currently supported. */
{
- Interp *iPtr = (Interp *)interp;
- Trace *tracePtr;
- Tcl_DString cmdBuf;
- char *cmdString = ""; /* A command string is only necessary for
- * command traces or error logs; it will be
- * generated to replace this default value if
- * necessary. */
- int cmdLen = 0; /* a non-zero value indicates that a command
- * string was generated. */
- int code = TCL_OK;
- int i;
- int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+ int result;
+ NRE_callback *rootPtr = TOP_CB(interp);
- for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
- if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) {
- /*
- * The command may be needed for an execution trace. Generate a
- * command string.
- */
+ result = TclNREvalObjv(interp, objc, objv, flags, NULL);
+ return TclNRRunCallbacks(interp, result, rootPtr);
+}
- Tcl_DStringInit(&cmdBuf);
- for (i = 0; i < objc; i++) {
- Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
- }
- cmdString = Tcl_DStringValue(&cmdBuf);
- cmdLen = Tcl_DStringLength(&cmdBuf);
- break;
- }
+int
+TclNREvalObjv(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * command. Also used for error reporting. */
+ int objc, /* Number of words in command. */
+ Tcl_Obj *const objv[], /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags, /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+ * TCL_EVAL_NOERR are currently supported. */
+ Command *cmdPtr) /* NULL if the Command is to be looked up
+ * here, otherwise the pointer to the
+ * requested Command struct to be invoked. */
+{
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * data[1] stores a marker for use by tailcalls; it will be set to 1 by
+ * command redirectors (imports, alias, ensembles) so that tailcalls
+ * finishes the source command and not just the target.
+ */
+
+ if (iPtr->deferredCallbacks) {
+ iPtr->deferredCallbacks = NULL;
+ } else {
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
}
iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
- iPtr->numLevels--;
+ TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
+ INT2PTR(objc), objv);
+ return TCL_OK;
+}
+static int
+EvalObjvCore(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Command *cmdPtr = NULL, *preCmdPtr = data[0];
+ int flags = PTR2INT(data[1]);
+ int objc = PTR2INT(data[2]);
+ Tcl_Obj **objv = data[3];
+ Interp *iPtr = (Interp *) interp;
+ Namespace *lookupNsPtr = NULL;
+ int enterTracesDone = 0;
+
/*
- * If we are again at the top level, process any unusual return code
- * returned by the evaluated code.
+ * Push records for task to be done on return, in INVERSE order. First, if
+ * needed, the exception handlers (as they should happen last).
*/
- if (iPtr->numLevels == 0) {
- if (code == TCL_RETURN) {
- code = TclUpdateReturnInfo(iPtr);
- }
- if ((code != TCL_OK) && (code != TCL_ERROR)
- && !allowExceptions) {
- ProcessUnexpectedResult(interp, code);
- code = TCL_ERROR;
- }
+ if (!(flags & TCL_EVAL_NOERR)) {
+ TEOV_PushExceptionHandlers(interp, objc, objv, flags);
+ }
+
+ if (TCL_OK != TclInterpReady(interp)) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ if (TclLimitExceeded(iPtr->limit)) {
+ return TCL_ERROR;
}
- if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+ /*
+ * Configure evaluation context to match the requested flags.
+ */
+
+ if (iPtr->lookupNsPtr) {
/*
- * If there was an error, a command string will be needed for the
- * error log: generate it now if it was not done previously.
+ * Capture the namespace we should do command name resolution in, as
+ * instructed by our caller sneaking it in to us in a private interp
+ * field. Clear that field right away so we cannot possibly have its
+ * use leak where it should not. The sneaky message pass is done.
+ *
+ * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
+ * TODO: Is that a bug?
+ */
+
+ lookupNsPtr = iPtr->lookupNsPtr;
+ iPtr->lookupNsPtr = NULL;
+ } else if (flags & TCL_EVAL_INVOKE) {
+ lookupNsPtr = iPtr->globalNsPtr;
+ } else {
+
+ /*
+ * TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
- if (cmdLen == 0) {
- Tcl_DStringInit(&cmdBuf);
- for (i = 0; i < objc; i++) {
- Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+
+ if (flags & TCL_EVAL_GLOBAL) {
+ TEOV_SwitchVarFrame(interp);
+ lookupNsPtr = iPtr->globalNsPtr;
+ }
+ }
+
+ /*
+ * Lookup the Command to dispatch.
+ */
+
+ reresolve:
+ assert(cmdPtr == NULL);
+ if (preCmdPtr) {
+ /* Caller gave it to us */
+ if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+ /* So long as it exists, use it. */
+ cmdPtr = preCmdPtr;
+ } else if (flags & TCL_EVAL_NORESOLVE) {
+ /*
+ * When it's been deleted, and we're told not to attempt
+ * resolving it ourselves, all we can do is raise an error.
+ */
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to invoke a deleted command"));
+ Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (cmdPtr == NULL) {
+ cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+ if (!cmdPtr) {
+ return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+ }
+ }
+
+ if (enterTracesDone || iPtr->tracePtr
+ || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+
+ Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+ flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
+ objc, objv);
+ Tcl_IncrRefCount(commandPtr);
+
+ if (!enterTracesDone) {
+
+ int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
+ objc, objv);
+
+ /*
+ * Send any exception from enter traces back as an exception
+ * raised by the traced command.
+ * TODO: Is this a bug? Letting an execution trace BREAK or
+ * CONTINUE or RETURN in the place of the traced command?
+ * Would either converting all exceptions to TCL_ERROR, or
+ * just swallowing them be better? (Swallowing them has the
+ * problem of permanently hiding program errors.)
+ */
+
+ if (code != TCL_OK) {
+ Tcl_DecrRefCount(commandPtr);
+ return code;
+ }
+
+ /*
+ * If the enter traces made the resolved cmdPtr unusable, go
+ * back and resolve again, but next time don't run enter
+ * traces again.
+ */
+
+ if (cmdPtr == NULL) {
+ enterTracesDone = 1;
+ Tcl_DecrRefCount(commandPtr);
+ goto reresolve;
}
- cmdString = Tcl_DStringValue(&cmdBuf);
- cmdLen = Tcl_DStringLength(&cmdBuf);
}
- Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+
+ /*
+ * Schedule leave traces. Raise the refCount on the resolved
+ * cmdPtr, so that when it passes to the leave traces we know
+ * it's still valid.
+ */
+
+ cmdPtr->refCount++;
+ TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+ commandPtr, cmdPtr, objv);
}
- if (cmdLen != 0) {
- Tcl_DStringFree(&cmdBuf);
+ TclNRAddCallback(interp, Dispatch,
+ cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
+ cmdPtr->objClientData, INT2PTR(objc), objv);
+ return TCL_OK;
+}
+
+static int
+Dispatch(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_ObjCmdProc *objProc = data[0];
+ ClientData clientData = data[1];
+ int objc = PTR2INT(data[2]);
+ Tcl_Obj **objv = data[3];
+ Interp *iPtr = (Interp *) interp;
+
+#ifdef USE_DTRACE
+ if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
+ const char *a[10];
+ int i = 0;
+
+ while (i < 10) {
+ a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
+ }
+ TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
}
- return code;
+ if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
+ Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+ const char *a[6]; int i[2];
+
+ TclDTraceInfo(info, a, i);
+ TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
+ TclDecrRefCount(info);
+ }
+ if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
+ && objc) {
+ TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
+ }
+ if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
+ TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
+ (Tcl_Obj **)(objv + 1));
+ }
+#endif /* USE_DTRACE */
+
+ iPtr->cmdCount++;
+ return objProc(clientData, interp, objc, objv);
+}
+
+int
+TclNRRunCallbacks(
+ Tcl_Interp *interp,
+ int result,
+ struct NRE_callback *rootPtr)
+ /* All callbacks down to rootPtr not inclusive
+ * are to be run. */
+{
+ Interp *iPtr = (Interp *) interp;
+ NRE_callback *callbackPtr;
+ Tcl_NRPostProc *procPtr;
+
+ /*
+ * If the interpreter has a non-empty string result, the result object is
+ * either empty or stale because some function set interp->result
+ * directly. If so, move the string result to the result object, then
+ * reset the string result.
+ *
+ * This only needs to be done for the first item in the list: all other
+ * are for NR function calls, and those are Tcl_Obj based.
+ */
+
+ if (*(iPtr->result) != 0) {
+ (void) Tcl_GetObjResult(interp);
+ }
+
+ while (TOP_CB(interp) != rootPtr) {
+ callbackPtr = TOP_CB(interp);
+ procPtr = callbackPtr->procPtr;
+ TOP_CB(interp) = callbackPtr->nextPtr;
+ result = procPtr(callbackPtr->data, interp, result);
+ TCLNR_FREE(interp, callbackPtr);
+ }
+ return result;
+}
+
+static int
+NRCommand(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ iPtr->numLevels--;
+
+ /*
+ * If there is a tailcall, schedule it
+ */
+
+ if (data[1] && (data[1] != INT2PTR(1))) {
+ TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+ }
+
+ /* OPT ??
+ * Do not interrupt a series of cleanups with async or limit checks:
+ * just check at the end?
+ */
+
+ if (TclAsyncReady(iPtr)) {
+ result = Tcl_AsyncInvoke(interp, result);
+ }
+ if ((result == TCL_OK) && TclCanceled(iPtr)) {
+ result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
+ }
+ if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
+ result = Tcl_LimitCheck(interp);
+ }
+
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_LogCommandInfo --
- *
- * This procedure 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.
- *
- * Results:
- * None.
+ * TEOV_Exception -
+ * TEOV_LookupCmdFromObj -
+ * TEOV_RunEnterTraces -
+ * TEOV_RunLeaveTraces -
+ * TEOV_NotFound -
*
- * Side effects:
- * Information about the command is added to errorInfo and the line
- * number stored internally in the interpreter is set.
+ * These are helper functions for Tcl_EvalObjv.
*
*----------------------------------------------------------------------
*/
-void
-Tcl_LogCommandInfo(interp, script, command, length)
- 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). */
-{
- register CONST char *p;
+static void
+TEOV_PushExceptionHandlers(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[],
+ int flags)
+{
Interp *iPtr = (Interp *) interp;
- int overflow, limit = 150;
- if (iPtr->flags & ERR_ALREADY_LOGGED) {
+ /*
+ * If any error processing is necessary, push the appropriate records.
+ * Note that we have to push them in the inverse order: first the one that
+ * has to run last.
+ */
+
+ if (!(flags & TCL_EVAL_INVOKE)) {
/*
- * Someone else has already logged error information for this command;
- * we shouldn't add anything more.
+ * Error messages
*/
- return;
+ TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
+ (ClientData) objv, NULL, NULL);
+ }
+
+ if (iPtr->numLevels == 1) {
+ /*
+ * No CONTINUE or BREAK at level 0, manage RETURN
+ */
+
+ TclNRAddCallback(interp, TEOV_Exception, INT2PTR(iPtr->evalFlags),
+ NULL, NULL, NULL);
}
+}
+
+static void
+TEOV_SwitchVarFrame(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
/*
- * Compute the line number where the error occurred.
+ * Change the varFrame to be the rootVarFrame, and push a record to
+ * restore things at the end.
*/
- iPtr->errorLine = 1;
- for (p = script; p != command; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
+ TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL,
+ NULL, NULL);
+ iPtr->varFramePtr = iPtr->rootFramePtr;
+}
+
+static int
+TEOV_RestoreVarFrame(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ ((Interp *) interp)->varFramePtr = data[0];
+ return result;
+}
+
+static int
+TEOV_Exception(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS);
+
+ if (result != TCL_OK) {
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo(iPtr);
+ }
+ if ((result != TCL_ERROR) && !allowExceptions) {
+ ProcessUnexpectedResult(interp, result);
+ result = TCL_ERROR;
}
}
- overflow = (length > limit);
- TclFormatToErrorInfo(interp, "\n %s\n\"%.*s%s\"",
- ((iPtr->errorInfo == NULL)
- ? "while executing" : "invoked from within"),
- (overflow ? limit : length), command, (overflow ? "..." : ""));
+ /*
+ * We are returning to level 0, so should process TclResetCancellation. As
+ * numLevels has not *yet* been decreased, do not call it: do the thing
+ * here directly.
+ */
+
+ TclUnsetCancelFlags(iPtr);
+ return result;
+}
+
+static int
+TEOV_Error(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *listPtr;
+ const char *cmdString;
+ int cmdLen;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj **objv = data[1];
+
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)){
+ /*
+ * If there was an error, a command string will be needed for the
+ * error log: get it out of the itemPtr. The details depend on the
+ * type.
+ */
+
+ listPtr = Tcl_NewListObj(objc, objv);
+ cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ Tcl_DecrRefCount(listPtr);
+ }
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ return result;
+}
+
+static int
+TEOV_NotFound(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[],
+ Namespace *lookupNsPtr)
+{
+ Command * cmdPtr;
+ Interp *iPtr = (Interp *) interp;
+ int i, newObjc, handlerObjc;
+ Tcl_Obj **newObjv, **handlerObjv;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered
+ * unknown command handler for the current
+ * namespace (TIP 181). */
+ Namespace *savedNsPtr = NULL;
+
+ currNsPtr = varFramePtr->nsPtr;
+ if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+ currNsPtr = iPtr->globalNsPtr;
+ if (currNsPtr == NULL) {
+ Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer");
+ }
+ }
+
+ /*
+ * Check to see if the resolution namespace has lost its unknown handler.
+ * If so, reset it to "::unknown".
+ */
+
+ if (currNsPtr->unknownHandlerPtr == NULL) {
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+ Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+ }
+
+ /*
+ * Get the list of words for the unknown handler and allocate enough space
+ * to hold both the handler prefix and all words of the command invokation
+ * itself.
+ */
+
+ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ &handlerObjc, &handlerObjv);
+ newObjc = objc + handlerObjc;
+ newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
+
+ /*
+ * Copy command prefix from unknown handler and add on the real command's
+ * full argument list. Note that we only use memcpy() once because we have
+ * to increment the reference count of all the handler arguments anyway.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ newObjv[i] = handlerObjv[i];
+ Tcl_IncrRefCount(newObjv[i]);
+ }
+ memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+
+ /*
+ * Look up and invoke the handler (by recursive call to this function). If
+ * there is no handler at all, instead of doing the recursive call we just
+ * generate a generic error message; it would be an infinite-recursion
+ * nightmare otherwise.
+ *
+ * In this case we worry a bit less about recursion for now, and call the
+ * "blocking" interface.
+ */
+
+ cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
+ if (cmdPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(objv[0]), NULL);
+
+ /*
+ * Release any resources we locked and allocated during the handler
+ * call.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ Tcl_DecrRefCount(newObjv[i]);
+ }
+ TclStackFree(interp, newObjv);
+ return TCL_ERROR;
+ }
+
+ if (lookupNsPtr) {
+ savedNsPtr = varFramePtr->nsPtr;
+ varFramePtr->nsPtr = lookupNsPtr;
+ }
+ TclSkipTailcall(interp);
+ TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
+ newObjv, savedNsPtr, NULL);
+ return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+TEOV_NotFoundCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj **objv = data[1];
+ Namespace *savedNsPtr = data[2];
+
+ int i;
+
+ if (savedNsPtr) {
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ }
+
+ /*
+ * Release any resources we locked and allocated during the handler call.
+ */
+
+ for (i = 0; i < objc; ++i) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ TclStackFree(interp, objv);
+
+ return result;
+}
+
+static int
+TEOV_RunEnterTraces(
+ Tcl_Interp *interp,
+ Command **cmdPtrPtr,
+ Tcl_Obj *commandPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Command *cmdPtr = *cmdPtrPtr;
+ int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ int length, traceCode = TCL_OK;
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+
+ /*
+ * Call trace functions.
+ * Execute any command or execution traces. Note that we bump up the
+ * command's reference count for the duration of the calling of the
+ * traces so that the structure doesn't go away underneath our feet.
+ */
+
+ cmdPtr->refCount++;
+ if (iPtr->tracePtr) {
+ traceCode = TclCheckInterpTraces(interp, command, length,
+ cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+ }
+ if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+ traceCode = TclCheckExecutionTraces(interp, command, length,
+ cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+ }
+ newEpoch = cmdPtr->cmdEpoch;
+ TclCleanupCommandMacro(cmdPtr);
+
+ if (traceCode != TCL_OK) {
+ if (traceCode == TCL_ERROR) {
+ Tcl_Obj *info;
+
+ TclNewLiteralStringObj(info, "\n (enter trace on \"");
+ Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+ Tcl_AppendToObj(info, "\")", 2);
+ Tcl_AppendObjToErrorInfo(interp, info);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ return traceCode;
+ }
+ if (cmdEpoch != newEpoch) {
+ *cmdPtrPtr = NULL;
+ }
+ return TCL_OK;
+}
+
+static int
+TEOV_RunLeaveTraces(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ int traceCode = TCL_OK;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj *commandPtr = data[1];
+ Command *cmdPtr = data[2];
+ Tcl_Obj **objv = data[3];
+ int length;
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+
+ if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+ if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
+ traceCode = TclCheckExecutionTraces(interp, command, length,
+ cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
+ }
+ if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+ traceCode = TclCheckInterpTraces(interp, command, length,
+ cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
+ }
+ }
+
+ /*
+ * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
+ * Prevent that by resetting the cmdPtr field and dealing right here with
+ * cmdPtr->refCount.
+ */
+
+ TclCleanupCommandMacro(cmdPtr);
+
+ if (traceCode != TCL_OK) {
+ if (traceCode == TCL_ERROR) {
+ Tcl_Obj *info;
+
+ TclNewLiteralStringObj(info, "\n (leave trace on \"");
+ Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+ Tcl_AppendToObj(info, "\")", 2);
+ Tcl_AppendObjToErrorInfo(interp, info);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ result = traceCode;
+ }
+ Tcl_DecrRefCount(commandPtr);
+ return result;
+}
+
+static inline Command *
+TEOV_LookupCmdFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *namePtr,
+ Namespace *lookupNsPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Command *cmdPtr;
+ Namespace *savedNsPtr = iPtr->varFramePtr->nsPtr;
+
+ if (lookupNsPtr) {
+ iPtr->varFramePtr->nsPtr = lookupNsPtr;
+ }
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ return cmdPtr;
}
/*
@@ -3575,7 +4812,7 @@ Tcl_LogCommandInfo(interp, script, command, length)
* Tcl_EvalTokensStandard --
*
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
- * that make up a word or the index for an array variable) this procedure
+ * that make up a word or the index for an array variable) this function
* evaluates the tokens and concatenates their values to form a single
* result value.
*
@@ -3585,31 +4822,31 @@ Tcl_LogCommandInfo(interp, script, command, length)
*
* Side effects:
* Depends on the array of tokens being evaled.
- *
+ *
*----------------------------------------------------------------------
*/
int
-Tcl_EvalTokensStandard(interp, tokenPtr, count)
- Tcl_Interp *interp; /* Interpreter in which to lookup variables,
+Tcl_EvalTokensStandard(
+ Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens to
+ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
+ int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
- return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL);
+ return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
+ NULL, NULL);
}
-
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_EvalTokens --
*
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
- * that make up a word or the index for an array variable) this procedure
+ * that make up a word or the index for an array variable) this function
* evaluates the tokens and concatenates their values to form a single
* result value.
*
@@ -3631,36 +4868,32 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
*/
Tcl_Obj *
-Tcl_EvalTokens(interp, tokenPtr, count)
- Tcl_Interp *interp; /* Interpreter in which to lookup variables,
+Tcl_EvalTokens(
+ Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens to
+ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
+ int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
- int code;
Tcl_Obj *resPtr;
- code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
- if (code == TCL_OK) {
- resPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(resPtr);
- Tcl_ResetResult(interp);
- return resPtr;
- } else {
+ if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
return NULL;
}
+ resPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resPtr);
+ Tcl_ResetResult(interp);
+ return resPtr;
}
-
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalEx --
+ * Tcl_EvalEx, TclEvalEx --
*
- * This procedure evaluates a Tcl script without using the compiler or
+ * This function evaluates a Tcl script without using the compiler or
* byte-code interpreter. It just parses the script, creates values for
* each word of each command, then calls EvalObjv to execute each
* command.
@@ -3672,40 +4905,94 @@ Tcl_EvalTokens(interp, tokenPtr, count)
* Side effects:
* Depends on the script.
*
+ * TIP #280 : Keep public API, internally extended API.
*----------------------------------------------------------------------
*/
int
-Tcl_EvalEx(interp, script, numBytes, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
+Tcl_EvalEx(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
- CONST char *script; /* First character of script to evaluate. */
- int numBytes; /* Number of bytes in script. If < 0, the
+ const char *script, /* First character of script to evaluate. */
+ int numBytes, /* Number of bytes in script. If < 0, the
* script consists of all bytes up to the
* first null character. */
- int flags; /* Collection of OR-ed bits that control the
+ int flags) /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently supported. */
+{
+ return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
+}
+
+int
+TclEvalEx(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * script. Also used for error reporting. */
+ const char *script, /* First character of script to evaluate. */
+ int numBytes, /* Number of bytes in script. If < 0, the
+ * script consists of all bytes up to the
+ * first NUL character. */
+ int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
+ 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
+ * TclSubstTokens(), to properly handle
+ * [...]-nested commands. The 'outerScript'
+ * refers to the most-outer script containing
+ * the embedded command, which is refered to
+ * by 'script'. The 'clNextOuter' refers to
+ * the current entry in the table of
+ * continuation lines in this "master script",
+ * and the character offsets are relative to
+ * the 'outerScript' as well.
+ *
+ * If outerScript == script, then this call is
+ * for the outer-most script/command. See
+ * Tcl_EvalEx() and TclEvalObjEx() for places
+ * generating arguments for which this is
+ * true. */
{
Interp *iPtr = (Interp *) interp;
- CONST char *p, *next;
- Tcl_Parse parse;
-#define NUM_STATIC_OBJS 20
- Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv, **objvSpace;
- int expandStatic[NUM_STATIC_OBJS], *expand;
+ const char *p, *next;
+ const unsigned int minObjs = 20;
+ Tcl_Obj **objv, **objvSpace;
+ int *expand, *lines, *lineSpace;
Tcl_Token *tokenPtr;
- int i, code, commandLength, bytesLeft, expandRequested;
+ int commandLength, bytesLeft, expandRequested, code = TCL_OK;
CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
* TCL_EVAL_GLOBAL was set. */
int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-
- /*
- * The variables below keep track of how much state has been allocated
- * while evaluating the script, so that it can be freed properly if an
- * error occurs.
- */
-
- int gotParse = 0, objectsUsed = 0;
+ int gotParse = 0;
+ unsigned int i, objectsUsed = 0;
+ /* These variables keep track of how much
+ * state has been allocated while evaluating
+ * the script, so that it can be freed
+ * properly if an error occurs. */
+ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ Tcl_Obj **stackObjArray =
+ TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
+ int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
+ int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
+ /* TIP #280 Structures for tracking of command
+ * locations. */
+ int *clNext = NULL; /* Pointer for the tracking of invisible
+ * continuation lines. Initialized only if the
+ * caller gave us a table of locations to
+ * track, via scriptCLLocPtr. It always refers
+ * to the table entry holding the location of
+ * the next invisible continuation line to
+ * look for, while parsing the script. */
+
+ if (iPtr->scriptCLLocPtr) {
+ if (clNextOuter) {
+ clNext = clNextOuter;
+ } else {
+ clNext = &iPtr->scriptCLLocPtr->loc[0];
+ }
+ }
if (numBytes < 0) {
numBytes = strlen(script);
@@ -3714,7 +5001,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
/*
@@ -3722,61 +5009,183 @@ Tcl_EvalEx(interp, script, numBytes, flags)
* the script and then executes it.
*/
- objv = objvSpace = staticObjArray;
- expand = expandStatic;
+ objv = objvSpace = stackObjArray;
+ lines = lineSpace = linesStack;
+ expand = expandStack;
p = script;
bytesLeft = numBytes;
+
+ /*
+ * TIP #280 Initialize tracking. Do not push on the frame stack yet.
+ *
+ * We open a new context, either for a sourced script, or 'eval'.
+ * For sourced files we always have a path object, even if nothing was
+ * specified in the interp itself. That makes code using it simpler as
+ * NULL checks can be left out. Sourced file without path in the
+ * 'scriptFile' is possible during Tcl initialization.
+ */
+
+ eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
+ eeFramePtr->framePtr = iPtr->framePtr;
+ eeFramePtr->nextPtr = iPtr->cmdFramePtr;
+ eeFramePtr->nline = 0;
+ eeFramePtr->line = NULL;
+ eeFramePtr->cmdObj = NULL;
+
+ iPtr->cmdFramePtr = eeFramePtr;
+ if (iPtr->evalFlags & TCL_EVAL_FILE) {
+ /*
+ * Set up for a sourced file.
+ */
+
+ eeFramePtr->type = TCL_LOCATION_SOURCE;
+
+ if (iPtr->scriptFile) {
+ /*
+ * Normalization here, to have the correct pwd. Should have
+ * negligible impact on performance, as the norm should have been
+ * done already by the 'source' invoking us, and it caches the
+ * result.
+ */
+
+ Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
+
+ if (norm == NULL) {
+ /*
+ * Error message in the interp result.
+ */
+
+ code = TCL_ERROR;
+ goto error;
+ }
+ eeFramePtr->data.eval.path = norm;
+ } else {
+ TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
+ }
+ Tcl_IncrRefCount(eeFramePtr->data.eval.path);
+ } else {
+ /*
+ * Set up for plain eval.
+ */
+
+ eeFramePtr->type = TCL_LOCATION_EVAL;
+ eeFramePtr->data.eval.path = NULL;
+ }
+
iPtr->evalFlags = 0;
do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
code = TCL_ERROR;
- goto error;
+ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+ parsePtr->term + 1 - parsePtr->commandStart);
+ goto posterror;
}
+
+ /*
+ * TIP #280 Track lines. The parser may have skipped text till it
+ * found the command we are now at. We have to count the lines in this
+ * block, and do not forget invisible continuation lines.
+ */
+
+ TclAdvanceLines(&line, p, parsePtr->commandStart);
+ TclAdvanceContinuations(&line, &clNext,
+ parsePtr->commandStart - outerScript);
+
gotParse = 1;
- if (parse.numWords > 0) {
+ if (parsePtr->numWords > 0) {
/*
- * Generate an array of objects for the words of the command.
+ * TIP #280. Track lines within the words of the current
+ * command. We use a separate pointer into the table of
+ * continuation line locations to not lose our position for the
+ * per-command parsing.
*/
- int objectsNeeded = 0;
+ int wordLine = line;
+ const char *wordStart = parsePtr->commandStart;
+ int *wordCLNext = clNext;
+ unsigned int objectsNeeded = 0;
+ unsigned int numWords = parsePtr->numWords;
+
+ /*
+ * Generate an array of objects for the words of the command.
+ */
- if (parse.numWords > NUM_STATIC_OBJS) {
- expand = (int *)
- ckalloc((unsigned) (parse.numWords * sizeof(int)));
- objvSpace = (Tcl_Obj **)
- ckalloc((unsigned) (parse.numWords*sizeof(Tcl_Obj *)));
+ if (numWords > minObjs) {
+ expand = ckalloc(numWords * sizeof(int));
+ objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
+ lineSpace = ckalloc(numWords * sizeof(int));
}
expandRequested = 0;
objv = objvSpace;
- for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
- objectsUsed < parse.numWords;
- objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ lines = lineSpace;
+
+ iPtr->cmdFramePtr = eeFramePtr->nextPtr;
+ for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
+ objectsUsed < numWords;
+ objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
+ /*
+ * TIP #280. Track lines to current word. Save the information
+ * on a per-word basis, signaling dynamic words as needed.
+ * Make the information available to the recursively called
+ * evaluator as well, including the type of context (source
+ * vs. eval).
+ */
+
+ TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
+ TclAdvanceContinuations(&wordLine, &wordCLNext,
+ tokenPtr->start - outerScript);
+ wordStart = tokenPtr->start;
+
+ lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
+ ? wordLine : -1;
+
+ if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
+ iPtr->evalFlags |= TCL_EVAL_FILE;
+ }
+
code = TclSubstTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, NULL);
+ tokenPtr->numComponents, NULL, wordLine,
+ wordCLNext, outerScript);
+
+ iPtr->evalFlags = 0;
+
if (code != TCL_OK) {
- goto error;
+ break;
}
objv[objectsUsed] = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(objv[objectsUsed]);
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
int numElements;
- code = Tcl_ListObjLength(interp,
- objv[objectsUsed], &numElements);
+ code = TclListObjLength(interp, objv[objectsUsed],
+ &numElements);
if (code == TCL_ERROR) {
- /* Attempt to expand a non-list. */
- TclFormatToErrorInfo(interp,
- "\n (expanding word %d)", objectsUsed);
+ /*
+ * Attempt to expand a non-list.
+ */
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (expanding word %d)", objectsUsed));
Tcl_DecrRefCount(objv[objectsUsed]);
- goto error;
+ break;
}
expandRequested = 1;
expand[objectsUsed] = 1;
+
objectsNeeded += (numElements ? numElements : 1);
} else {
expand[objectsUsed] = 0;
objectsNeeded++;
}
+
+ if (wordCLNext) {
+ TclContinuationsEnterDerived(objv[objectsUsed],
+ wordStart - outerScript, wordCLNext);
+ }
+ } /* for loop */
+ iPtr->cmdFramePtr = eeFramePtr;
+ if (code != TCL_OK) {
+ goto error;
}
if (expandRequested) {
/*
@@ -3784,13 +5193,14 @@ Tcl_EvalEx(interp, script, numBytes, flags)
*/
Tcl_Obj **copy = objvSpace;
- int wordIdx = parse.numWords;
+ int *lcopy = lineSpace;
+ int wordIdx = numWords;
int objIdx = objectsNeeded - 1;
- if ((parse.numWords > NUM_STATIC_OBJS)
- || (objectsNeeded > NUM_STATIC_OBJS)) {
- objv = objvSpace = (Tcl_Obj **) ckalloc((unsigned)
- (objectsNeeded * sizeof(Tcl_Obj *)));
+ if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
+ objv = objvSpace =
+ ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
+ lines = lineSpace = ckalloc(objectsNeeded * sizeof(int));
}
objectsUsed = 0;
@@ -3799,34 +5209,64 @@ Tcl_EvalEx(interp, script, numBytes, flags)
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
- Tcl_ListObjGetElements(NULL, temp,
- &numElements, &elements);
+ Tcl_ListObjGetElements(NULL, temp, &numElements,
+ &elements);
objectsUsed += numElements;
while (numElements--) {
+ lines[objIdx] = -1;
objv[objIdx--] = elements[numElements];
Tcl_IncrRefCount(elements[numElements]);
}
Tcl_DecrRefCount(temp);
} else {
+ lines[objIdx] = lcopy[wordIdx];
objv[objIdx--] = copy[wordIdx];
objectsUsed++;
}
}
objv += objIdx+1;
- if (copy != staticObjArray) {
- ckfree((char *) copy);
+ if (copy != stackObjArray) {
+ ckfree(copy);
+ }
+ if (lcopy != linesStack) {
+ ckfree(lcopy);
}
}
/*
* Execute the command and free the objects for its words.
+ *
+ * TIP #280: Remember the command itself for 'info frame'. We
+ * shorten the visible command by one char to exclude the
+ * termination character, if necessary. Here is where we put our
+ * frame on the stack of frames too. _After_ the nested commands
+ * have been executed.
*/
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objectsUsed, objv,
- parse.commandStart, parse.commandSize, 0);
- iPtr->numLevels--;
+ eeFramePtr->cmd = parsePtr->commandStart;
+ eeFramePtr->len = parsePtr->commandSize;
+
+ if (parsePtr->term ==
+ parsePtr->commandStart + parsePtr->commandSize - 1) {
+ eeFramePtr->len--;
+ }
+
+ eeFramePtr->nline = objectsUsed;
+ eeFramePtr->line = lines;
+
+ TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
+ code = Tcl_EvalObjv(interp, objectsUsed, objv,
+ TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME);
+ TclArgumentRelease(interp, objv, objectsUsed);
+
+ eeFramePtr->line = NULL;
+ eeFramePtr->nline = 0;
+ if (eeFramePtr->cmdObj) {
+ Tcl_DecrRefCount(eeFramePtr->cmdObj);
+ eeFramePtr->cmdObj = NULL;
+ }
+
if (code != TCL_OK) {
goto error;
}
@@ -3834,9 +5274,11 @@ Tcl_EvalEx(interp, script, numBytes, flags)
Tcl_DecrRefCount(objv[i]);
}
objectsUsed = 0;
- if (objvSpace != staticObjArray) {
- ckfree((char *) objvSpace);
- objvSpace = staticObjArray;
+ if (objvSpace != stackObjArray) {
+ ckfree(objvSpace);
+ objvSpace = stackObjArray;
+ ckfree(lineSpace);
+ lineSpace = linesStack;
}
/*
@@ -3844,29 +5286,35 @@ Tcl_EvalEx(interp, script, numBytes, flags)
* reallocated above.
*/
- if (expand != expandStatic) {
- ckfree((char *) expand);
- expand = expandStatic;
+ if (expand != expandStack) {
+ ckfree(expand);
+ expand = expandStack;
}
}
/*
* Advance to the next command in the script.
+ *
+ * TIP #280 Track Lines. Now we track how many lines were in the
+ * executed command.
*/
- next = parse.commandStart + parse.commandSize;
+ next = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= next - p;
p = next;
- Tcl_FreeParse(&parse);
+ TclAdvanceLines(&line, parsePtr->commandStart, p);
+ Tcl_FreeParse(parsePtr);
gotParse = 0;
} while (bytesLeft > 0);
iPtr->varFramePtr = savedVarFramePtr;
- return TCL_OK;
+ code = TCL_OK;
+ goto cleanup_return;
error:
/*
* Generate and log various pieces of error information.
*/
+
if (iPtr->numLevels == 0) {
if (code == TCL_RETURN) {
code = TclUpdateReturnInfo(iPtr);
@@ -3877,8 +5325,8 @@ Tcl_EvalEx(interp, script, numBytes, flags)
}
}
if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- commandLength = parse.commandSize;
- if (parse.term == parse.commandStart + commandLength - 1) {
+ commandLength = parsePtr->commandSize;
+ if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
/*
* The terminator character (such as ; or ]) of the command where
* the error occurred is the last character in the parsed command.
@@ -3888,8 +5336,10 @@ Tcl_EvalEx(interp, script, numBytes, flags)
commandLength -= 1;
}
- Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+ commandLength);
}
+ posterror:
iPtr->flags &= ~ERR_ALREADY_LOGGED;
/*
@@ -3900,26 +5350,485 @@ Tcl_EvalEx(interp, script, numBytes, flags)
Tcl_DecrRefCount(objv[i]);
}
if (gotParse) {
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
}
- if (objvSpace != staticObjArray) {
- ckfree((char *) objvSpace);
+ if (objvSpace != stackObjArray) {
+ ckfree(objvSpace);
+ ckfree(lineSpace);
}
- if (expand != expandStatic) {
- ckfree((char *) expand);
+ if (expand != expandStack) {
+ ckfree(expand);
}
iPtr->varFramePtr = savedVarFramePtr;
+
+ cleanup_return:
+ /*
+ * TIP #280. Release the local CmdFrame, and its contents.
+ */
+
+ iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+ if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(eeFramePtr->data.eval.path);
+ }
+ TclStackFree(interp, linesStack);
+ TclStackFree(interp, expandStack);
+ TclStackFree(interp, stackObjArray);
+ TclStackFree(interp, eeFramePtr);
+ TclStackFree(interp, parsePtr);
+
return code;
}
/*
*----------------------------------------------------------------------
*
+ * TclAdvanceLines --
+ *
+ * This function is a helper which counts the number of lines in a block
+ * of text and advances an external counter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified counter is advanced per the number of lines found.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAdvanceLines(
+ int *line,
+ const char *start,
+ const char *end)
+{
+ register const char *p;
+
+ for (p = start; p < end; p++) {
+ if (*p == '\n') {
+ (*line)++;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAdvanceContinuations --
+ *
+ * This procedure is a helper which counts the number of continuation
+ * lines (CL) in a block of text using a table of CL locations and
+ * advances an external counter, and the pointer into the table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified counter is advanced per the number of continuation lines
+ * found.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAdvanceContinuations(
+ int *line,
+ int **clNextPtrPtr,
+ int loc)
+{
+ /*
+ * Track the invisible continuation lines embedded in a script, if any.
+ * Here they are just spaces (already). They were removed by
+ * TclSubstTokens via TclParseBackslash.
+ *
+ * *clNextPtrPtr <=> We have continuation lines to track.
+ * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location.
+ * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
+ */
+
+ while (*clNextPtrPtr && (**clNextPtrPtr >= 0)
+ && (loc >= **clNextPtrPtr)) {
+ /*
+ * We just stepped over an invisible continuation line. Adjust the
+ * line counter and step to the table entry holding the location of
+ * the next continuation line to track.
+ */
+
+ (*line)++;
+ (*clNextPtrPtr)++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Note: The whole data structure access for argument location tracking is
+ * hidden behind these three functions. The only parts open are the lineLAPtr
+ * field in the Interp structure. The CFWord definition is internal to here.
+ * Should make it easier to redo the data structures if we find something more
+ * space/time efficient.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentEnter --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension. It
+ * enters location references for the arguments of a command to be
+ * invoked. Only the first entry has the actual data, further entries
+ * simply count the usage up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May allocate memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentEnter(
+ Tcl_Interp *interp,
+ Tcl_Obj **objv,
+ int objc,
+ CmdFrame *cfPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ int new, i;
+ Tcl_HashEntry *hPtr;
+ CFWord *cfwPtr;
+
+ for (i = 1; i < objc; i++) {
+ /*
+ * Ignore argument words without line information (= dynamic). If they
+ * are variables they may have location information associated with
+ * that, either through globally recorded 'set' invokations, or
+ * literals in bytecode. Eitehr way there is no need to record
+ * something here.
+ */
+
+ if (cfPtr->line[i] < 0) {
+ continue;
+ }
+ hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new);
+ if (new) {
+ /*
+ * The word is not on the stack yet, remember the current location
+ * and initialize references.
+ */
+
+ cfwPtr = ckalloc(sizeof(CFWord));
+ cfwPtr->framePtr = cfPtr;
+ cfwPtr->word = i;
+ cfwPtr->refCount = 1;
+ Tcl_SetHashValue(hPtr, cfwPtr);
+ } else {
+ /*
+ * The word is already on the stack, its current location is not
+ * relevant. Just remember the reference to prevent early removal.
+ */
+
+ cfwPtr = Tcl_GetHashValue(hPtr);
+ cfwPtr->refCount++;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentRelease --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension. It
+ * removes the location references for the arguments of a command just
+ * done. Usage is counted down, the data is removed only when no user is
+ * left over.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentRelease(
+ Tcl_Interp *interp,
+ Tcl_Obj **objv,
+ int objc)
+{
+ Interp *iPtr = (Interp *) interp;
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ CFWord *cfwPtr;
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);
+
+ if (!hPtr) {
+ continue;
+ }
+ cfwPtr = Tcl_GetHashValue(hPtr);
+
+ cfwPtr->refCount--;
+ if (cfwPtr->refCount > 0) {
+ continue;
+ }
+
+ ckfree(cfwPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentBCEnter --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension. It
+ * enters location references for the literal arguments of commands in
+ * bytecode about to be invoked. Only the first entry has the actual
+ * data, further entries simply count the usage up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May allocate memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentBCEnter(
+ Tcl_Interp *interp,
+ Tcl_Obj *objv[],
+ int objc,
+ void *codePtr,
+ CmdFrame *cfPtr,
+ int cmd,
+ int pc)
+{
+ ExtCmdLoc *eclPtr;
+ int word;
+ ECL *ePtr;
+ CFWordBC *lastPtr = NULL;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hePtr =
+ Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+
+ if (!hePtr) {
+ return;
+ }
+ eclPtr = Tcl_GetHashValue(hePtr);
+ ePtr = &eclPtr->loc[cmd];
+
+ /*
+ * ePtr->nline is the number of words originally parsed.
+ *
+ * objc is the number of elements getting invoked.
+ *
+ * If they are not the same, we arrived here by compiling an
+ * ensemble dispatch. Ensemble subcommands that lead to script
+ * evaluation are not supposed to get compiled, because a command
+ * such as [info level] in the script can expose some of the dispatch
+ * shenanigans. This means that we don't have to tend to the
+ * housekeeping, and can escape now.
+ */
+
+ if (ePtr->nline != objc) {
+ return;
+ }
+
+ /*
+ * Having disposed of the ensemble cases, we can state...
+ * A few truths ...
+ * (1) ePtr->nline == objc
+ * (2) (ePtr->line[word] < 0) => !literal, for all words
+ * (3) (word == 0) => !literal
+ *
+ * Item (2) is why we can use objv to get the literals, and do not
+ * have to save them at compile time.
+ */
+
+ 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 = ckalloc(sizeof(CFWordBC));
+
+ cfwPtr->framePtr = cfPtr;
+ cfwPtr->obj = objv[word];
+ cfwPtr->pc = pc;
+ cfwPtr->word = word;
+ cfwPtr->nextPtr = lastPtr;
+ lastPtr = cfwPtr;
+
+ if (isnew) {
+ /*
+ * The word is not on the stack yet, remember the current
+ * location and initialize references.
+ */
+
+ cfwPtr->prevPtr = NULL;
+ } else {
+ /*
+ * The object is already on the stack, however it may have
+ * a different location now (literal sharing may map
+ * multiple location to a single Tcl_Obj*. Save the old
+ * information in the new structure.
+ */
+
+ cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
+ }
+
+ Tcl_SetHashValue(hPtr, cfwPtr);
+ }
+ } /* for */
+
+ cfPtr->litarg = lastPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentBCRelease --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension. It
+ * removes the location references for the literal arguments of commands
+ * in bytecode just done. Usage is counted down, the data is removed only
+ * when no user is left over.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentBCRelease(
+ Tcl_Interp *interp,
+ CmdFrame *cfPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;
+
+ while (cfwPtr) {
+ CFWordBC *nextPtr = cfwPtr->nextPtr;
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
+ CFWordBC *xPtr = Tcl_GetHashValue(hPtr);
+
+ if (xPtr != cfwPtr) {
+ Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
+ }
+
+ if (cfwPtr->prevPtr) {
+ Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
+ } else {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ ckfree(cfwPtr);
+ cfwPtr = nextPtr;
+ }
+
+ cfPtr->litarg = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentGet --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension. It
+ * finds the location references for a Tcl_Obj, if any.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Writes found location information into the result arguments.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentGet(
+ Tcl_Interp *interp,
+ Tcl_Obj *obj,
+ CmdFrame **cfPtrPtr,
+ int *wordPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ CmdFrame *framePtr;
+
+ /*
+ * An object which either has no string rep or else is a canonical list is
+ * guaranteed to have been generated dynamically: bail out, this cannot
+ * have a usable absolute location. _Do not touch_ the information the set
+ * up by the caller. It knows better than us.
+ */
+
+ if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+ return;
+ }
+
+ /*
+ * First look for location information recorded in the argument
+ * stack. That is nearest.
+ */
+
+ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
+ if (hPtr) {
+ CFWord *cfwPtr = Tcl_GetHashValue(hPtr);
+
+ *wordPtr = cfwPtr->word;
+ *cfPtrPtr = cfwPtr->framePtr;
+ return;
+ }
+
+ /*
+ * Check if the Tcl_Obj has location information as a bytecode literal, in
+ * that stack.
+ */
+
+ hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
+ if (hPtr) {
+ CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr);
+
+ framePtr = cfwPtr->framePtr;
+ framePtr->data.tebc.pc = (char *) (((ByteCode *)
+ framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
+ *cfPtrPtr = cfwPtr->framePtr;
+ *wordPtr = cfwPtr->word;
+ return;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Eval --
*
- * Execute a Tcl command in a string. This procedure executes the script
+ * Execute a Tcl command in a string. This function executes the script
* directly, rather than compiling it to bytecodes. Before the arrival of
- * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main procedure used
+ * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used
* for executing Tcl commands, but nowadays it isn't used much.
*
* Results:
@@ -3934,11 +5843,12 @@ Tcl_EvalEx(interp, script, numBytes, flags)
*----------------------------------------------------------------------
*/
+#undef Tcl_Eval
int
-Tcl_Eval(interp, script)
- Tcl_Interp *interp; /* Token for command interpreter (returned by
+Tcl_Eval(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
* previous call to Tcl_CreateInterp). */
- CONST char *script; /* Pointer to TCL command to execute. */
+ const char *script) /* Pointer to TCL command to execute. */
{
int code = Tcl_EvalEx(interp, script, -1, 0);
@@ -3971,18 +5881,17 @@ Tcl_Eval(interp, script)
#undef Tcl_EvalObj
int
-Tcl_EvalObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
+Tcl_EvalObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
-
#undef Tcl_GlobalEvalObj
int
-Tcl_GlobalEvalObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
+Tcl_GlobalEvalObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}
@@ -3990,12 +5899,17 @@ Tcl_GlobalEvalObj(interp, objPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalObjEx --
+ * Tcl_EvalObjEx, TclEvalObjEx --
*
* Execute Tcl commands stored in a Tcl object. These commands are
* compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
* specified.
*
+ * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
+ * must be NULL. Support for non-NULL invokers in that mode has
+ * been removed since it was unused and untested. Failure to
+ * follow this limitation will lead to an assertion panic.
+ *
* Results:
* The return value is one of the return codes defined in tcl.h (such as
* TCL_OK), and the interpreter's result contains a value to supplement
@@ -4006,128 +5920,289 @@ Tcl_GlobalEvalObj(interp, objPtr)
* the bytecode instructions for the commands. Executing the commands
* will almost certainly have side effects that depend on those commands.
*
+ * TIP #280 : Keep public API, internally extended API.
*----------------------------------------------------------------------
*/
int
-Tcl_EvalObjEx(interp, objPtr, flags)
- Tcl_Interp *interp; /* Token for command interpreter (returned by
+Tcl_EvalObjEx(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
- register Tcl_Obj *objPtr; /* Pointer to object containing commands to
+ register Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
- int flags; /* Collection of OR-ed bits that control the
+ int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
* are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
{
- register Interp *iPtr = (Interp *) interp;
- char *script;
- int numSrcBytes;
+ return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
+}
+
+int
+TclEvalObjEx(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
+ * a previous call to Tcl_CreateInterp). */
+ register Tcl_Obj *objPtr, /* Pointer to object containing commands to
+ * execute. */
+ int flags, /* Collection of OR-ed bits that control the
+ * evaluation of the script. Supported values
+ * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
+ const CmdFrame *invoker, /* Frame of the command doing the eval. */
+ int word) /* Index of the word which is in objPtr. */
+{
+ int result = TCL_OK;
+ NRE_callback *rootPtr = TOP_CB(interp);
+
+ result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
+ return TclNRRunCallbacks(interp, result, rootPtr);
+}
+
+int
+TclNREvalObjEx(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
+ * a previous call to Tcl_CreateInterp). */
+ register Tcl_Obj *objPtr, /* Pointer to object containing commands to
+ * execute. */
+ int flags, /* Collection of OR-ed bits that control the
+ * evaluation of the script. Supported values
+ * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
+ const CmdFrame *invoker, /* Frame of the command doing the eval. */
+ int word) /* Index of the word which is in objPtr. */
+{
+ Interp *iPtr = (Interp *) interp;
int result;
- CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
- * TCL_EVAL_GLOBAL was set. */
- int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
- Tcl_IncrRefCount(objPtr);
+ /*
+ * This function consists of three independent blocks for: direct
+ * evaluation of canonical lists, compilation and bytecode execution and
+ * finally direct evaluation. Precisely one of these blocks will be run.
+ */
+
+ if (TclListObjIsCanonical(objPtr)) {
+ CmdFrame *eoFramePtr = NULL;
+ int objc;
+ Tcl_Obj *listPtr, **objv;
- if (flags & TCL_EVAL_DIRECT) {
/*
- * We're not supposed to use the compiler or byte-code interpreter.
- * Let Tcl_EvalEx evaluate the command directly (and probably more
- * slowly).
- *
- * Pure List Optimization (no string representation). In this case, we
+ * Canonical List Optimization: In this case, we
* can safely use Tcl_EvalObjv instead and get an appreciable
* improvement in execution speed. This is because it allows us to
* avoid a setFromAny step that would just pack everything into a
* string and back out again.
*
- * This restriction has been relaxed a bit by storing in lists whether
- * they are "canonical" or not (a canonical list being one that is
- * either pure or that has its string rep derived by
- * UpdateStringOfList from the internal rep).
+ * This also preserves any associations between list elements and
+ * location information for such elements.
*/
- if (objPtr->typePtr == &tclListType) { /* is a list... */
- List *listRepPtr;
+ /*
+ * Shimmer protection! Always pass an unshared obj. The caller could
+ * incr the refCount of objPtr AFTER calling us! To be completely safe
+ * we always make a copy. The callback takes care od the refCounts for
+ * both listPtr and objPtr.
+ *
+ * TODO: Create a test to demo this need, or eliminate it.
+ * FIXME OPT: preserve just the internal rep?
+ */
- listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_IncrRefCount(objPtr);
+ listPtr = TclListObjCopy(interp, objPtr);
+ Tcl_IncrRefCount(listPtr);
- if (objPtr->bytes == NULL || /* ...without a string rep */
- listRepPtr->canonicalFlag) {/* ...or that is canonical */
+ if (word != INT_MIN) {
+ /*
+ * TIP #280 Structures for tracking lines. As we know that this is
+ * dynamic execution we ignore the invoker, even if known.
+ *
+ * TIP #280. We do _not_ compute all the line numbers for the
+ * words in the command. For the eval of a pure list the most
+ * sensible choice is to put all words on line 1. Given that we
+ * neither need memory for them nor compute anything. 'line' is
+ * left NULL. The two places using this information (TclInfoFrame,
+ * and TclInitCompileEnv), are special-cased to use the proper
+ * line number directly instead of accessing the 'line' array.
+ *
+ * Note that we use (word==INTMIN) to signal that no command frame
+ * should be pushed, as needed by alias and ensemble redirections.
+ */
- /*
- * Increase the reference count of the List structure, to
- * avoid a segfault if objPtr loses its List internal rep [Bug
- * 1119369]
- */
+ eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ eoFramePtr->nline = 0;
+ eoFramePtr->line = NULL;
- listRepPtr->refCount++;
+ eoFramePtr->type = TCL_LOCATION_EVAL;
+ eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
+ 1 : iPtr->cmdFramePtr->level + 1);
+ eoFramePtr->framePtr = iPtr->framePtr;
+ eoFramePtr->nextPtr = iPtr->cmdFramePtr;
- result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
- &listRepPtr->elements, flags);
+ eoFramePtr->cmdObj = objPtr;
+ eoFramePtr->cmd = NULL;
+ eoFramePtr->len = 0;
+ eoFramePtr->data.eval.path = NULL;
- /*
- * If we are the last users of listRepPtr, free it.
- */
+ iPtr->cmdFramePtr = eoFramePtr;
- if (--listRepPtr->refCount <= 0) {
- int i, elemCount = listRepPtr->elemCount;
- Tcl_Obj **elements = &listRepPtr->elements;
-
- for (i=0; i<elemCount; i++) {
- Tcl_DecrRefCount(elements[i]);
- }
- ckfree((char *) listRepPtr);
- }
- goto done;
- }
+ flags |= TCL_EVAL_SOURCE_IN_FRAME;
}
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
- } else {
+
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+ objPtr, NULL);
+
+ ListObjGetElements(listPtr, objc, objv);
+ return TclNREvalObjv(interp, objc, objv, flags, NULL);
+ }
+
+ if (!(flags & TCL_EVAL_DIRECT)) {
/*
* Let the compiler/engine subsystem do the evaluation.
+ *
+ * TIP #280 The invoker provides us with the context for the script.
+ * We transfer this to the byte code compiler.
*/
- savedVarFramePtr = iPtr->varFramePtr;
+ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+ ByteCode *codePtr;
+ CallFrame *savedVarFramePtr = NULL; /* Saves old copy of
+ * iPtr->varFramePtr in case
+ * TCL_EVAL_GLOBAL was set. */
+
+ if (TclInterpReady(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
+ savedVarFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
+ Tcl_IncrRefCount(objPtr);
+ codePtr = TclCompileObj(interp, objPtr, invoker, word);
- result = TclCompEvalObj(interp, objPtr);
+ TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
+ objPtr, INT2PTR(allowExceptions), NULL);
+ return TclNRExecuteByteCode(interp, codePtr);
+ }
+ {
/*
- * If we are again at the top level, process any unusual return code
- * returned by the evaluated code.
+ * We're not supposed to use the compiler or byte-code
+ * interpreter. Let Tcl_EvalEx evaluate the command directly (and
+ * probably more slowly).
*/
- if (iPtr->numLevels == 0) {
- if (result == TCL_RETURN) {
- result = TclUpdateReturnInfo(iPtr);
- }
- if ((result != TCL_OK) && (result != TCL_ERROR)
- && !allowExceptions) {
- ProcessUnexpectedResult(interp, result);
- result = TCL_ERROR;
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
- }
+ const char *script;
+ int numSrcBytes;
+
+ /*
+ * Now we check if we have data about invisible continuation lines for
+ * the script, and make it available to the direct script parser and
+ * evaluator we are about to call, if so.
+ *
+ * It may be possible that the script Tcl_Obj* can be free'd while the
+ * evaluator is using it, leading to the release of the associated
+ * ContLineLoc structure as well. To ensure that the latter doesn't
+ * happen we set a lock on it. We release this lock later in this
+ * function, after the evaluator is done. The relevant "lineCLPtr"
+ * hashtable is managed in the file "tclObj.c".
+ *
+ * Another important action is to save (and later restore) the
+ * continuation line information of the caller, in case we are
+ * executing nested commands in the eval/direct path.
+ */
+
+ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
+
+ assert(invoker == NULL);
+
+ iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);
+
+ Tcl_IncrRefCount(objPtr);
+
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+
+ TclDecrRefCount(objPtr);
+
+ iPtr->scriptCLLocPtr = saveCLLocPtr;
+ return result;
+ }
+}
+
+static int
+TEOEx_ByteCodeCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *savedVarFramePtr = data[0];
+ Tcl_Obj *objPtr = data[1];
+ int allowExceptions = PTR2INT(data[2]);
+
+ if (iPtr->numLevels == 0) {
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo(iPtr);
+ }
+ if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
+ const char *script;
+ int numSrcBytes;
+
+ ProcessUnexpectedResult(interp, result);
+ result = TCL_ERROR;
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
}
- iPtr->evalFlags = 0;
+
+ /*
+ * We are returning to level 0, so should call TclResetCancellation.
+ * Let us just unset the flags inline.
+ */
+
+ TclUnsetCancelFlags(iPtr);
+ }
+ iPtr->evalFlags = 0;
+
+ /*
+ * Restore the callFrame if this was a TCL_EVAL_GLOBAL.
+ */
+
+ if (savedVarFramePtr) {
iPtr->varFramePtr = savedVarFramePtr;
}
- done:
TclDecrRefCount(objPtr);
return result;
}
+
+static int
+TEOEx_ListCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *listPtr = data[0];
+ CmdFrame *eoFramePtr = data[1];
+ Tcl_Obj *objPtr = data[2];
+
+ /*
+ * Remove the cmdFrame
+ */
+
+ if (eoFramePtr) {
+ iPtr->cmdFramePtr = eoFramePtr->nextPtr;
+ TclStackFree(interp, eoFramePtr);
+ }
+ TclDecrRefCount(objPtr);
+ TclDecrRefCount(listPtr);
+
+ return result;
+}
/*
*----------------------------------------------------------------------
*
* ProcessUnexpectedResult --
*
- * Procedure called by Tcl_EvalObj to set the interpreter's result value
+ * Function called by Tcl_EvalObj to set the interpreter's result value
* to an appropriate error message when the code it evaluates returns an
* unexpected result code (not TCL_OK and not TCL_ERROR) to the topmost
* evaluation level.
@@ -4143,23 +6218,26 @@ Tcl_EvalObjEx(interp, objPtr, flags)
*/
static void
-ProcessUnexpectedResult(interp, returnCode)
- Tcl_Interp *interp; /* The interpreter in which the unexpected
+ProcessUnexpectedResult(
+ Tcl_Interp *interp, /* The interpreter in which the unexpected
* result code was returned. */
- int returnCode; /* The unexpected result code. */
+ int returnCode) /* The unexpected result code. */
{
+ char buf[TCL_INTEGER_SPACE];
+
Tcl_ResetResult(interp);
if (returnCode == TCL_BREAK) {
- Tcl_AppendResult(interp,
- "invoked \"break\" outside of a loop", (char *) 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", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"continue\" outside of a loop", -1));
} else {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "command returned bad code: %d", returnCode);
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "command returned bad code: %d", returnCode));
}
+ sprintf(buf, "%d", returnCode);
+ Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}
/*
@@ -4167,15 +6245,15 @@ ProcessUnexpectedResult(interp, returnCode)
*
* Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
*
- * Procedures to evaluate an expression and return its value in a
+ * Functions to evaluate an expression and return its value in a
* particular form.
*
* Results:
- * Each of the procedures below returns a standard Tcl result. If an
- * error occurs then an error message is left in the interp's result.
- * Otherwise the value of the expression, in the appropriate form, is
- * stored at *ptr. If the expression had a result that was incompatible
- * with the desired form then an error is returned.
+ * Each of the functions below returns a standard Tcl result. If an error
+ * occurs then an error message is left in the interp's result. Otherwise
+ * the value of the expression, in the appropriate form, is stored at
+ * *ptr. If the expression had a result that was incompatible with the
+ * desired form then an error is returned.
*
* Side effects:
* None.
@@ -4184,151 +6262,67 @@ ProcessUnexpectedResult(interp, returnCode)
*/
int
-Tcl_ExprLong(interp, exprstring, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprLong(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- CONST char *exprstring; /* Expression to evaluate. */
- long *ptr; /* Where to store result. */
+ const char *exprstring, /* Expression to evaluate. */
+ long *ptr) /* Where to store result. */
{
register Tcl_Obj *exprPtr;
- Tcl_Obj *resultPtr;
- int length = strlen(exprstring);
int result = TCL_OK;
-
- if (length > 0) {
- exprPtr = Tcl_NewStringObj(exprstring, length);
- Tcl_IncrRefCount(exprPtr);
- result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
- if (result == TCL_OK) {
- /*
- * Store an integer based on the expression result.
- */
-
- if (resultPtr->typePtr == &tclIntType) {
- *ptr = resultPtr->internalRep.longValue;
- } else if (resultPtr->typePtr == &tclDoubleType) {
- *ptr = (long) resultPtr->internalRep.doubleValue;
- } else if (resultPtr->typePtr == &tclWideIntType) {
-#ifndef TCL_WIDE_INT_IS_LONG
- /*
- * See Tcl_GetIntFromObj for conversion comments.
- */
-
- Tcl_WideInt w = resultPtr->internalRep.wideValue;
-
- if ((w >= -(Tcl_WideInt)(ULONG_MAX))
- && (w <= (Tcl_WideInt)(ULONG_MAX))) {
- *ptr = Tcl_WideAsLong(w);
- } else {
- Tcl_SetResult(interp,
- "integer value too large to represent as non-long integer",
- TCL_STATIC);
- result = TCL_ERROR;
- }
-#else
- *ptr = resultPtr->internalRep.longValue;
-#endif
- } else {
- Tcl_SetResult(interp,
- "expression didn't have numeric value", TCL_STATIC);
- result = TCL_ERROR;
- }
- Tcl_DecrRefCount(resultPtr);/* discard the result object */
- } else {
- /*
- * Move the interpreter's object result to the string result, then
- * reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
- }
- Tcl_DecrRefCount(exprPtr); /* discard the expression object */
- } else {
+ if (*exprstring == '\0') {
/*
- * An empty string. Just set the result integer to 0.
+ * Legacy compatibility - return 0 for the zero-length string.
*/
*ptr = 0;
+ } else {
+ exprPtr = Tcl_NewStringObj(exprstring, -1);
+ Tcl_IncrRefCount(exprPtr);
+ result = Tcl_ExprLongObj(interp, exprPtr, ptr);
+ Tcl_DecrRefCount(exprPtr);
+ if (result != TCL_OK) {
+ (void) Tcl_GetStringResult(interp);
+ }
}
return result;
}
int
-Tcl_ExprDouble(interp, exprstring, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprDouble(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- CONST char *exprstring; /* Expression to evaluate. */
- double *ptr; /* Where to store result. */
+ const char *exprstring, /* Expression to evaluate. */
+ double *ptr) /* Where to store result. */
{
register Tcl_Obj *exprPtr;
- Tcl_Obj *resultPtr;
- int length = strlen(exprstring);
int result = TCL_OK;
- if (length > 0) {
- exprPtr = Tcl_NewStringObj(exprstring, length);
- Tcl_IncrRefCount(exprPtr);
- result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
- if (result == TCL_OK) {
- /*
- * Store a double based on the expression result.
- */
-
- if (resultPtr->typePtr == &tclIntType) {
- *ptr = (double) resultPtr->internalRep.longValue;
- } else if (resultPtr->typePtr == &tclDoubleType) {
- *ptr = resultPtr->internalRep.doubleValue;
- } else if (resultPtr->typePtr == &tclWideIntType) {
-#ifndef TCL_WIDE_INT_IS_LONG
- /*
- * See Tcl_GetIntFromObj for conversion comments.
- */
-
- Tcl_WideInt w = resultPtr->internalRep.wideValue;
-
- if ((w >= -(Tcl_WideInt)(ULONG_MAX))
- && (w <= (Tcl_WideInt)(ULONG_MAX))) {
- *ptr = (double) Tcl_WideAsLong(w);
- } else {
- Tcl_SetResult(interp,
- "integer value too large to represent as non-long integer",
- TCL_STATIC);
- result = TCL_ERROR;
- }
-#else
- *ptr = (double) resultPtr->internalRep.longValue;
-#endif
- } else {
- Tcl_SetResult(interp,
- "expression didn't have numeric value", TCL_STATIC);
- result = TCL_ERROR;
- }
- Tcl_DecrRefCount(resultPtr);/* discard the result object */
- } else {
- /*
- * Move the interpreter's object result to the string result, then
- * reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
- }
- Tcl_DecrRefCount(exprPtr); /* discard the expression object */
- } else {
+ if (*exprstring == '\0') {
/*
- * An empty string. Just set the result double to 0.0.
+ * Legacy compatibility - return 0 for the zero-length string.
*/
*ptr = 0.0;
+ } else {
+ exprPtr = Tcl_NewStringObj(exprstring, -1);
+ Tcl_IncrRefCount(exprPtr);
+ result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
+ Tcl_DecrRefCount(exprPtr);
+ /* Discard the expression object. */
+ if (result != TCL_OK) {
+ (void) Tcl_GetStringResult(interp);
+ }
}
return result;
}
int
-Tcl_ExprBoolean(interp, exprstring, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprBoolean(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- CONST char *exprstring; /* Expression to evaluate. */
- int *ptr; /* Where to store 0/1 result. */
+ const char *exprstring, /* Expression to evaluate. */
+ int *ptr) /* Where to store 0/1 result. */
{
if (*exprstring == '\0') {
/*
@@ -4361,11 +6355,11 @@ Tcl_ExprBoolean(interp, exprstring, ptr)
*
* Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
*
- * Procedures to evaluate an expression in an object and return its value
+ * Functions to evaluate an expression in an object and return its value
* in a particular form.
*
* Results:
- * Each of the procedures below returns a standard Tcl result object. If
+ * Each of the functions below returns a standard Tcl result object. If
* an error occurs then an error message is left in the interpreter's
* result. Otherwise the value of the expression, in the appropriate
* form, is stored at *ptr. If the expression had a result that was
@@ -4378,65 +6372,95 @@ Tcl_ExprBoolean(interp, exprstring, ptr)
*/
int
-Tcl_ExprLongObj(interp, objPtr, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprLongObj(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- register Tcl_Obj *objPtr; /* Expression to evaluate. */
- long *ptr; /* Where to store long result. */
+ register Tcl_Obj *objPtr, /* Expression to evaluate. */
+ long *ptr) /* Where to store long result. */
{
Tcl_Obj *resultPtr;
- int result;
+ int result, type;
+ double d;
+ ClientData internalPtr;
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
- if (result == TCL_OK) {
- if (resultPtr->typePtr == &tclIntType) {
- *ptr = resultPtr->internalRep.longValue;
- } else if (resultPtr->typePtr == &tclDoubleType) {
- *ptr = (long) resultPtr->internalRep.doubleValue;
- } else {
- result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
- if (result != TCL_OK) {
- return result;
- }
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (type) {
+ case TCL_NUMBER_DOUBLE: {
+ mp_int big;
+
+ d = *((const double *) internalPtr);
+ Tcl_DecrRefCount(resultPtr);
+ if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+ return TCL_ERROR;
}
- Tcl_DecrRefCount(resultPtr); /* discard the result object */
+ resultPtr = Tcl_NewBignumObj(&big);
+ /* FALLTHROUGH */
}
+ case TCL_NUMBER_LONG:
+ case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_BIG:
+ result = TclGetLongFromObj(interp, resultPtr, ptr);
+ break;
+
+ case TCL_NUMBER_NAN:
+ Tcl_GetDoubleFromObj(interp, resultPtr, &d);
+ result = TCL_ERROR;
+ }
+
+ Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
return result;
}
int
-Tcl_ExprDoubleObj(interp, objPtr, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprDoubleObj(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- register Tcl_Obj *objPtr; /* Expression to evaluate. */
- double *ptr; /* Where to store double result. */
+ register Tcl_Obj *objPtr, /* Expression to evaluate. */
+ double *ptr) /* Where to store double result. */
{
Tcl_Obj *resultPtr;
- int result;
+ int result, type;
+ ClientData internalPtr;
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
if (result == TCL_OK) {
- if (resultPtr->typePtr == &tclIntType) {
- *ptr = (double) resultPtr->internalRep.longValue;
- } else if (resultPtr->typePtr == &tclDoubleType) {
- *ptr = resultPtr->internalRep.doubleValue;
- } else {
+ switch (type) {
+ case TCL_NUMBER_NAN:
+#ifndef ACCEPT_NAN
+ result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
+ break;
+#endif
+ case TCL_NUMBER_DOUBLE:
+ *ptr = *((const double *) internalPtr);
+ result = TCL_OK;
+ break;
+ default:
result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
- if (result != TCL_OK) {
- return result;
- }
}
- Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
+ Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
return result;
}
int
-Tcl_ExprBooleanObj(interp, objPtr, ptr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprBooleanObj(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- register Tcl_Obj *objPtr; /* Expression to evaluate. */
- int *ptr; /* Where to store 0/1 result. */
+ register Tcl_Obj *objPtr, /* Expression to evaluate. */
+ int *ptr) /* Where to store 0/1 result. */
{
Tcl_Obj *resultPtr;
int result;
@@ -4444,7 +6468,8 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result == TCL_OK) {
result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
- Tcl_DecrRefCount(resultPtr); /* discard the result object */
+ Tcl_DecrRefCount(resultPtr);
+ /* Discard the result object. */
}
return result;
}
@@ -4456,6 +6481,7 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
*
* Object version: Invokes a Tcl command, given an objv/objc, from either
* the exposed or hidden set of commands in the given interpreter.
+ *
* NOTE: The command is invoked in the global stack frame of the
* interpreter or namespace, thus it cannot see any current state on the
* stack of that interpreter.
@@ -4470,14 +6496,14 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
*/
int
-TclObjInvokeNamespace(interp, objc, objv, nsPtr, flags)
- Tcl_Interp *interp; /* Interpreter in which command is to be
+TclObjInvokeNamespace(
+ Tcl_Interp *interp, /* Interpreter in which command is to be
* invoked. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the
+ int objc, /* Count of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the
* name of the command to invoke. */
- Tcl_Namespace *nsPtr; /* The namespace to use. */
- int flags; /* Combination of flags controlling the call:
+ Tcl_Namespace *nsPtr, /* The namespace to use. */
+ int flags) /* Combination of flags controlling the call:
* TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
* or TCL_INVOKE_NO_TRACEBACK. */
{
@@ -4489,7 +6515,7 @@ TclObjInvokeNamespace(interp, objc, objv, nsPtr, flags)
* command.
*/
- result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcCallFrame*/ 0);
+ result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -4518,77 +6544,78 @@ TclObjInvokeNamespace(interp, objc, objv, nsPtr, flags)
*/
int
-TclObjInvoke(interp, objc, objv, flags)
- Tcl_Interp *interp; /* Interpreter in which command is to be
+TclObjInvoke(
+ Tcl_Interp *interp, /* Interpreter in which command is to be
* invoked. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the
+ int objc, /* Count of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the
* name of the command to invoke. */
- int flags; /* Combination of flags controlling the call:
+ int flags) /* Combination of flags controlling the call:
* TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
* or TCL_INVOKE_NO_TRACEBACK. */
{
- register Interp *iPtr = (Interp *) interp;
- Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
- char *cmdName; /* Name of the command from objv[0]. */
- Tcl_HashEntry *hPtr = NULL;
- Command *cmdPtr;
- int result;
-
- if (interp == (Tcl_Interp *) NULL) {
+ if (interp == NULL) {
return TCL_ERROR;
}
-
- if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
- Tcl_AppendResult(interp, "illegal argument vector", (char *) NULL);
+ if ((objc < 1) || (objv == NULL)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal argument vector", -1));
return TCL_ERROR;
}
-
if ((flags & TCL_INVOKE_HIDDEN) == 0) {
Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
}
+ return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
+}
- if (TclInterpReady(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
+int
+TclNRInvoke(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ register Interp *iPtr = (Interp *) interp;
+ Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
+ const char *cmdName; /* Name of the command from objv[0]. */
+ Tcl_HashEntry *hPtr = NULL;
+ Command *cmdPtr;
- cmdName = Tcl_GetString(objv[0]);
+ cmdName = TclGetString(objv[0]);
hTblPtr = iPtr->hiddenCmdTablePtr;
if (hTblPtr != NULL) {
hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "invalid hidden command name \"",
- cmdName, "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid hidden command name \"%s\"", cmdName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
+ NULL);
return TCL_ERROR;
}
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
- /*
- * Invoke the command procedure.
- */
-
- iPtr->cmdCount++;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ /* Avoid the exception-handling brain damage when numLevels == 0 . */
+ iPtr->numLevels++;
+ Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
/*
- * If an error occurred, record information about what was being executed
- * when the error occurred.
+ * Normal command resolution of objv[0] isn't going to find cmdPtr.
+ * That's the whole point of **hidden** commands. So tell the
+ * Eval core machinery not to even try (and risk finding something wrong).
*/
- if ((result == TCL_ERROR)
- && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
- && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
- int length;
- Tcl_Obj *command = Tcl_NewListObj(objc, objv);
- CONST char* cmdString;
+ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
+}
- Tcl_IncrRefCount(command);
- cmdString = Tcl_GetStringFromObj(command, &length);
- Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
- Tcl_DecrRefCount(command);
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
- }
+static int
+NRPostInvoke(
+ ClientData clientData[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *)interp;
+ iPtr->numLevels--;
return result;
}
@@ -4613,10 +6640,10 @@ TclObjInvoke(interp, objc, objv, flags)
*/
int
-Tcl_ExprString(interp, expr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprString(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- CONST char *expr; /* Expression to evaluate. */
+ const char *expr) /* Expression to evaluate. */
{
int code = TCL_OK;
@@ -4625,7 +6652,7 @@ Tcl_ExprString(interp, expr)
* An empty string. Just set the interpreter's result to 0.
*/
- Tcl_SetResult(interp, "0", TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
} else {
Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);
@@ -4636,20 +6663,20 @@ Tcl_ExprString(interp, expr)
Tcl_SetObjResult(interp, resultPtr);
Tcl_DecrRefCount(resultPtr);
}
+ }
- /*
- * Force the string rep of the interp result.
- */
+ /*
+ * Force the string rep of the interp result.
+ */
- (void) Tcl_GetStringResult(interp);
- }
+ (void) Tcl_GetStringResult(interp);
return code;
}
/*
*----------------------------------------------------------------------
*
- * TclAppendObjToErrorInfo --
+ * Tcl_AppendObjToErrorInfo --
*
* Add a Tcl_Obj value to the errorInfo field that describes the current
* error.
@@ -4665,16 +6692,19 @@ Tcl_ExprString(interp, expr)
*----------------------------------------------------------------------
*/
+#undef Tcl_AddObjErrorInfo
void
-TclAppendObjToErrorInfo(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter to which error information
+Tcl_AppendObjToErrorInfo(
+ Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
- Tcl_Obj *objPtr; /* Message to record. */
+ Tcl_Obj *objPtr) /* Message to record. */
{
int length;
- CONST char *message = Tcl_GetStringFromObj(objPtr, &length);
+ const char *message = TclGetStringFromObj(objPtr, &length);
+ Tcl_IncrRefCount(objPtr);
Tcl_AddObjErrorInfo(interp, message, length);
+ Tcl_DecrRefCount(objPtr);
}
/*
@@ -4696,11 +6726,12 @@ TclAppendObjToErrorInfo(interp, objPtr)
*----------------------------------------------------------------------
*/
+#undef Tcl_AddErrorInfo
void
-Tcl_AddErrorInfo(interp, message)
- Tcl_Interp *interp; /* Interpreter to which error information
+Tcl_AddErrorInfo(
+ Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
- CONST char *message; /* Message to record. */
+ const char *message) /* Message to record. */
{
Tcl_AddObjErrorInfo(interp, message, -1);
}
@@ -4727,12 +6758,12 @@ Tcl_AddErrorInfo(interp, message)
*/
void
-Tcl_AddObjErrorInfo(interp, message, length)
- Tcl_Interp *interp; /* Interpreter to which error information
+Tcl_AddObjErrorInfo(
+ Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
- CONST char *message; /* Points to the first byte of an array of
+ const char *message, /* Points to the first byte of an array of
* bytes of the message. */
- int length; /* The number of bytes in the message. If < 0,
+ int length) /* The number of bytes in the message. If < 0,
* then append all bytes up to a NULL byte. */
{
register Interp *iPtr = (Interp *) interp;
@@ -4742,7 +6773,8 @@ Tcl_AddObjErrorInfo(interp, message, length)
* the error message in the interpreter's result.
*/
- if (iPtr->errorInfo == NULL) { /* just starting to log error */
+ iPtr->flags |= ERR_LEGACY_COPY;
+ if (iPtr->errorInfo == NULL) {
if (iPtr->result[0] != 0) {
/*
* The interp's string result is set, apparently by some extension
@@ -4752,7 +6784,7 @@ Tcl_AddObjErrorInfo(interp, message, length)
* interp->result completely.
*/
- iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
+ iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
} else {
iPtr->errorInfo = iPtr->objResultPtr;
}
@@ -4795,9 +6827,9 @@ Tcl_AddObjErrorInfo(interp, message, length)
*/
int
-Tcl_VarEvalVA(interp, argList)
- Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
- va_list argList; /* Variable argument list. */
+Tcl_VarEvalVA(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate command */
+ va_list argList) /* Variable argument list. */
{
Tcl_DString buf;
char *string;
@@ -4842,7 +6874,9 @@ Tcl_VarEvalVA(interp, argList)
*/
/* ARGSUSED */
int
-Tcl_VarEval(Tcl_Interp *interp, ...)
+Tcl_VarEval(
+ Tcl_Interp *interp,
+ ...)
{
va_list argList;
int result;
@@ -4855,7 +6889,7 @@ Tcl_VarEval(Tcl_Interp *interp, ...)
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_GlobalEval --
*
@@ -4867,23 +6901,25 @@ Tcl_VarEval(Tcl_Interp *interp, ...)
*
* Side effects:
* The command string is executed in interp, and the execution is carried
- * out in the variable context of global level (no procedures active),
+ * out in the variable context of global level (no functions active),
* just as if an "uplevel #0" command were being executed.
*
- ---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
+#undef Tcl_GlobalEval
int
-Tcl_GlobalEval(interp, command)
- Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
- CONST char *command; /* Command to evaluate. */
+Tcl_GlobalEval(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate
+ * command. */
+ const char *command) /* Command to evaluate. */
{
register Interp *iPtr = (Interp *) interp;
int result;
CallFrame *savedVarFramePtr;
savedVarFramePtr = iPtr->varFramePtr;
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
result = Tcl_Eval(interp, command);
iPtr->varFramePtr = savedVarFramePtr;
return result;
@@ -4907,10 +6943,10 @@ Tcl_GlobalEval(interp, command)
*/
int
-Tcl_SetRecursionLimit(interp, depth)
- Tcl_Interp *interp; /* Interpreter whose nesting limit is to be
+Tcl_SetRecursionLimit(
+ Tcl_Interp *interp, /* Interpreter whose nesting limit is to be
* set. */
- int depth; /* New value for maximimum depth. */
+ int depth) /* New value for maximimum depth. */
{
Interp *iPtr = (Interp *) interp;
int old;
@@ -4941,8 +6977,8 @@ Tcl_SetRecursionLimit(interp, depth)
*/
void
-Tcl_AllowExceptions(interp)
- Tcl_Interp *interp; /* Interpreter in which to set flag. */
+Tcl_AllowExceptions(
+ Tcl_Interp *interp) /* Interpreter in which to set flag. */
{
Interp *iPtr = (Interp *) interp;
@@ -4968,11 +7004,11 @@ Tcl_AllowExceptions(interp)
*/
void
-Tcl_GetVersion(majorV, minorV, patchLevelV, type)
- int *majorV;
- int *minorV;
- int *patchLevelV;
- int *type;
+Tcl_GetVersion(
+ int *majorV,
+ int *minorV,
+ int *patchLevelV,
+ int *type)
{
if (majorV != NULL) {
*majorV = TCL_MAJOR_VERSION;
@@ -4993,11 +7029,11 @@ Tcl_GetVersion(majorV, minorV, patchLevelV, type)
*
* Math Functions --
*
- * This page contains the procedures that implement all of the built-in
+ * This page contains the functions that implement all of the built-in
* math functions for expressions.
*
* Results:
- * Each procedure returns TCL_OK if it succeeds and pushes an Tcl object
+ * Each function returns TCL_OK if it succeeds and pushes an Tcl object
* holding the result. If it fails it returns TCL_ERROR and leaves an
* error message in the interpreter's result.
*
@@ -5008,186 +7044,438 @@ Tcl_GetVersion(majorV, minorV, patchLevelV, type)
*/
static int
-ExprUnaryFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Contains the address of a procedure that
- * takes one double argument and returns a
- * double result. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprCeilFunc(
+ ClientData clientData, /* Ignored */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter list */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
- double d, dResult;
- Tcl_Obj* oResult;
+ int code;
+ double d;
+ mp_int big;
- double (*func)(double) = (double (*)(double)) clientData;
+ if (objc != 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclCeil(&big)));
+ mp_clear(&big);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d)));
+ }
+ return TCL_OK;
+}
+
+static int
+ExprFloorFunc(
+ ClientData clientData, /* Ignored */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
+{
+ int code;
+ double d;
+ mp_int big;
+
+ if (objc != 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclFloor(&big)));
+ mp_clear(&big);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d)));
+ }
+ return TCL_OK;
+}
+
+static int
+ExprIsqrtFunc(
+ ClientData clientData, /* Ignored */
+ Tcl_Interp *interp, /* The interpreter in which to execute. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
+{
+ ClientData ptr;
+ int type;
+ double d;
+ Tcl_WideInt w;
+ mp_int big;
+ int exact = 0; /* Flag ==1 if the argument can be represented
+ * in a double as an exact integer. */
/*
- * Convert the function's argument to a double if necessary.
+ * Check syntax.
*/
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) == TCL_OK) {
+ return TCL_ERROR;
+ }
- /*
- * Evaluate the function.
- */
+ /*
+ * Make sure that the arg is a number.
+ */
+
+ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
- dResult = (*func)(d);
- if ((errno != 0) || IS_NAN(dResult)) {
- if (errno != ERANGE || (dResult != 0.0 && !IS_INF(dResult))) {
- TclExprFloatError(interp, dResult);
+ switch (type) {
+ case TCL_NUMBER_NAN:
+ Tcl_GetDoubleFromObj(interp, objv[1], &d);
+ return TCL_ERROR;
+ case TCL_NUMBER_DOUBLE:
+ d = *((const double *) ptr);
+ if (d < 0) {
+ goto negarg;
+ }
+#ifdef IEEE_FLOATING_POINT
+ if (d <= MAX_EXACT) {
+ exact = 1;
+ }
+#endif
+ if (!exact) {
+ if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
return TCL_ERROR;
}
}
- TclNewDoubleObj(oResult, dResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
+ break;
+ case TCL_NUMBER_BIG:
+ if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (SIGN(&big) == MP_NEG) {
+ mp_clear(&big);
+ goto negarg;
+ }
+ break;
+ default:
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (w < 0) {
+ goto negarg;
+ }
+ d = (double) w;
+#ifdef IEEE_FLOATING_POINT
+ if (d < MAX_EXACT) {
+ exact = 1;
+ }
+#endif
+ if (!exact) {
+ Tcl_GetBignumFromObj(interp, objv[1], &big);
+ }
+ break;
+ }
+
+ if (exact) {
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
+ } else {
+ mp_int root;
+
+ mp_init(&root);
+ mp_sqrt(&big, &root);
+ mp_clear(&big);
+ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
}
+ return TCL_OK;
+ negarg:
+ 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;
}
static int
-ExprBinaryFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Contains the address of a procedure that
- * takes two double arguments and returns a
- * double result. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprSqrtFunc(
+ ClientData clientData, /* Ignored */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter list. */
{
- double d1, d2, dResult;
- Tcl_Obj* oResult;
+ int code;
+ double d;
+ mp_int big;
- double (*func)(double, double) = (double (*)(double, double)) clientData;
+ if (objc != 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((d >= 0.0) && TclIsInfinite(d)
+ && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) {
+ mp_int root;
- /*
- * Convert the function's two arguments to doubles if necessary.
- */
+ mp_init(&root);
+ mp_sqrt(&big, &root);
+ mp_clear(&big);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root)));
+ mp_clear(&root);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
+ }
+ return TCL_OK;
+}
- if (objc != 3) {
- MathFuncWrongNumArgs(interp, 3, objc, objv);
- } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d1) == TCL_OK
- && Tcl_GetDoubleFromObj(interp, objv[2], &d2) == TCL_OK) {
+static int
+ExprUnaryFunc(
+ ClientData clientData, /* Contains the address of a function that
+ * takes one double argument and returns a
+ * double result. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count */
+ Tcl_Obj *const *objv) /* Actual parameter list */
+{
+ int code;
+ double d;
+ double (*func)(double) = (double (*)(double)) clientData;
+
+ if (objc != 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+ d = objv[1]->internalRep.doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+ errno = 0;
+ return CheckDoubleResult(interp, func(d));
+}
+
+static int
+CheckDoubleResult(
+ Tcl_Interp *interp,
+ double dResult)
+{
+#ifndef ACCEPT_NAN
+ if (TclIsNaN(dResult)) {
+ TclExprFloatError(interp, dResult);
+ return TCL_ERROR;
+ }
+#endif
+ if ((errno == ERANGE) && ((dResult == 0.0) || TclIsInfinite(dResult))) {
+ /*
+ * When ERANGE signals under/overflow, just accept 0.0 or +/-Inf
+ */
+ } else if (errno != 0) {
/*
- * Evaluate the function.
+ * Report other errno values as errors.
*/
- errno = 0;
- dResult = (*func)(d1, d2);
- if ((errno != 0) || IS_NAN(dResult)) {
- if (errno != ERANGE || (dResult != 0.0 && !IS_INF(dResult))) {
- TclExprFloatError(interp, dResult);
- return TCL_ERROR;
- }
- }
- TclNewDoubleObj(oResult, dResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
+ TclExprFloatError(interp, dResult);
+ return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
+ return TCL_OK;
+}
- return TCL_ERROR;
+static int
+ExprBinaryFunc(
+ ClientData clientData, /* Contains the address of a function that
+ * takes two double arguments and returns a
+ * double result. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
+{
+ int code;
+ double d1, d2;
+ double (*func)(double, double) = (double (*)(double, double)) clientData;
+ if (objc != 3) {
+ MathFuncWrongNumArgs(interp, 3, objc, objv);
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+ d1 = objv[1]->internalRep.doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+ code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
+#ifdef ACCEPT_NAN
+ if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
+ d2 = objv[2]->internalRep.doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
+#endif
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
+ errno = 0;
+ return CheckDoubleResult(interp, func(d1, d2));
}
static int
-ExprAbsFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprAbsFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
- register Tcl_Obj *valuePtr;
- long i, iResult;
- double d, dResult;
- Tcl_Obj* oResult;
+ ClientData ptr;
+ int type;
+ mp_int big;
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
- /*
- * Derive the absolute value according to the arg type.
- */
+ if (type == TCL_NUMBER_LONG) {
+ long l = *((const long *) ptr);
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- if (i < 0) {
- iResult = -i;
- if (iResult < 0) {
-#ifdef TCL_WIDE_INT_IS_LONG
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", (char *) NULL);
- return TCL_ERROR;
-#else
- /*
- * Special case: abs(MIN_INT) must promote to wide.
- */
- TclNewWideIntObj(oResult, -(Tcl_WideInt) i);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
-#endif
+ if (l > (long)0) {
+ goto unChanged;
+ } else if (l == (long)0) {
+ const char *string = objv[1]->bytes;
+ if (string) {
+ while (*string != '0') {
+ if (*string == '-') {
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+ return TCL_OK;
+ }
+ string++;
+ }
}
- } else {
- iResult = i;
+ goto unChanged;
+ } else if (l == LONG_MIN) {
+ TclBNInitBignumFromLong(&big, l);
+ goto tooLarge;
}
- TclNewLongObj(oResult, iResult);
- Tcl_SetObjResult(interp, oResult);
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt wResult, w;
-
- TclGetWide(w, valuePtr);
- if (w < (Tcl_WideInt)0) {
- wResult = -w;
- if (wResult < 0) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", (char *) NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
+ return TCL_OK;
+ }
+
+ if (type == TCL_NUMBER_DOUBLE) {
+ double d = *((const double *) ptr);
+ static const double poszero = 0.0;
+
+ /*
+ * We need to distinguish here between positive 0.0 and negative -0.0.
+ * [Bug 2954959]
+ */
+
+ if (d == -0.0) {
+ if (!memcmp(&d, &poszero, sizeof(double))) {
+ goto unChanged;
}
- } else {
- wResult = w;
+ } else if (d > -0.0) {
+ goto unChanged;
}
- TclNewWideIntObj(oResult, wResult);
- Tcl_SetObjResult(interp, oResult);
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (d < 0.0) {
- dResult = -d;
- } else {
- dResult = d;
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
+ return TCL_OK;
+ }
+
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (type == TCL_NUMBER_WIDE) {
+ Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
+
+ if (w >= (Tcl_WideInt)0) {
+ goto unChanged;
}
- if (IS_NAN(dResult)) {
- TclExprFloatError(interp, dResult);
- return TCL_ERROR;
+ if (w == LLONG_MIN) {
+ TclBNInitBignumFromWideInt(&big, w);
+ goto tooLarge;
}
- TclNewDoubleObj(oResult, dResult);
- Tcl_SetObjResult(interp, oResult);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
+ return TCL_OK;
+ }
+#endif
+
+ if (type == TCL_NUMBER_BIG) {
+ if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
+ Tcl_GetBignumFromObj(NULL, objv[1], &big);
+ tooLarge:
+ mp_neg(&big, &big);
+ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+ } else {
+ unChanged:
+ Tcl_SetObjResult(interp, objv[1]);
+ }
+ return TCL_OK;
}
+ if (type == TCL_NUMBER_NAN) {
+#ifdef ACCEPT_NAN
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+#else
+ double d;
+
+ Tcl_GetDoubleFromObj(interp, objv[1], &d);
+ return TCL_ERROR;
+#endif
+ }
return TCL_OK;
}
static int
-ExprBoolFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprBoolFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
int value;
@@ -5203,152 +7491,166 @@ ExprBoolFunc(clientData, interp, objc, objv)
}
static int
-ExprDoubleFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprDoubleFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- Tcl_Obj* valuePtr;
double dResult;
- Tcl_Obj* oResult;
-
- /*
- * Check parameter type
- */
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr);
- TclNewDoubleObj(oResult, dResult);
- Tcl_SetObjResult(interp, oResult);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
+#ifdef ACCEPT_NAN
+ if (objv[1]->typePtr == &tclDoubleType) {
+ Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
+#endif
+ return TCL_ERROR;
}
-
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
+ return TCL_OK;
}
static int
-ExprIntFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprEntierFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- register Tcl_Obj *valuePtr;
- long iResult;
double d;
- Tcl_Obj* oResult;
+ int type;
+ ClientData ptr;
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- if (valuePtr->typePtr == &tclIntType) {
- iResult = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- TclGetLongFromWide(iResult,valuePtr);
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (d < 0.0) {
- if (d < (double) (long) LONG_MIN) {
- tooLarge:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent",
- (char *) NULL);
- return TCL_ERROR;
- }
- } else if (d > (double) LONG_MAX) {
- goto tooLarge;
- }
- if (IS_NAN(d) || IS_INF(d)) {
- TclExprFloatError(interp, d);
- return TCL_ERROR;
- }
- iResult = (long) d;
+ return TCL_ERROR;
+ }
+ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (type == TCL_NUMBER_DOUBLE) {
+ d = *((const double *) ptr);
+ if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
+ mp_int big;
+
+ if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+ /* Infinity */
+ return TCL_ERROR;
}
- TclNewIntObj(oResult, iResult);
- Tcl_SetObjResult(interp, oResult);
+ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+ return TCL_OK;
+ } else {
+ long result = (long) d;
+
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
return TCL_OK;
}
}
+
+ if (type != TCL_NUMBER_NAN) {
+ /*
+ * All integers are already of integer type.
+ */
+
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+
+ /*
+ * Get the error message for NaN.
+ */
+
+ Tcl_GetDoubleFromObj(interp, objv[1], &d);
return TCL_ERROR;
}
static int
-ExprWideFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprIntFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
+ long iResult;
+ Tcl_Obj *objPtr;
+ if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ objPtr = Tcl_GetObjResult(interp);
+ if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
+ /*
+ * Truncate the bignum; keep only bits in long range.
+ */
+
+ mp_int big;
+
+ Tcl_GetBignumFromObj(NULL, objPtr, &big);
+ mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+ objPtr = Tcl_NewBignumObj(&big);
+ Tcl_IncrRefCount(objPtr);
+ TclGetLongFromObj(NULL, objPtr, &iResult);
+ Tcl_DecrRefCount(objPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
+ return TCL_OK;
+}
- register Tcl_Obj *valuePtr;
+static int
+ExprWideFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
Tcl_WideInt wResult;
- double d;
- Tcl_Obj* oResult;
+ Tcl_Obj *objPtr;
- if (objc != 2) {
- MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- if (valuePtr->typePtr == &tclIntType) {
- wResult = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- wResult = valuePtr->internalRep.wideValue;
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (d < 0.0) {
- if (d < Tcl_WideAsDouble(LLONG_MIN)) {
- tooLarge:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent",
- (char *) NULL);
- return TCL_ERROR;
- }
- } else if (d > Tcl_WideAsDouble(LLONG_MAX)) {
- goto tooLarge;
- }
- if (IS_NAN(d) || IS_INF(d)) {
- TclExprFloatError(interp, d);
- return TCL_ERROR;
- }
- wResult = (Tcl_WideInt) d;
- }
- TclNewWideIntObj(oResult, wResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
- }
+ if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
}
- return TCL_ERROR;
+ objPtr = Tcl_GetObjResult(interp);
+ if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
+ /*
+ * Truncate the bignum; keep only bits in wide int range.
+ */
+
+ mp_int big;
+
+ Tcl_GetBignumFromObj(NULL, objPtr, &big);
+ mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
+ objPtr = Tcl_NewBignumObj(&big);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
+ Tcl_DecrRefCount(objPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
+ return TCL_OK;
}
static int
-ExprRandFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprRandFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Interp *iPtr = (Interp *) interp;
double dResult;
- long tmp; /* Algorithm assumes at least 32 bits.
- * Only long guarantees that. See below. */
- Tcl_Obj* oResult;
+ long tmp; /* Algorithm assumes at least 32 bits. Only
+ * long guarantees that. See below. */
+ Tcl_Obj *oResult;
if (objc != 1) {
MathFuncWrongNumArgs(interp, 1, objc, objv);
@@ -5363,7 +7665,7 @@ ExprRandFunc(clientData, interp, objc, objv)
* 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.
@@ -5430,97 +7732,89 @@ ExprRandFunc(clientData, interp, objc, objv)
}
static int
-ExprRoundFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprRoundFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
- Tcl_Obj *valuePtr, *resPtr;
- double d, i, f;
-
- /*
- * Check the argument count.
- */
+ double d;
+ ClientData ptr;
+ int type;
if (objc != 2) {
- MathFuncWrongNumArgs(interp, 1, objc, objv);
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
- valuePtr = objv[1];
-
- /*
- * Coerce the argument to a number. Integers are already rounded.
- */
- if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
- if ((valuePtr->typePtr == &tclIntType) ||
- (valuePtr->typePtr == &tclWideIntType)) {
- Tcl_SetObjResult(interp, valuePtr);
- return TCL_OK;
- }
- GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);
- /*
- * Round the number to the nearest integer. I'd like to use round(), but
- * it's C99 (or BSD), and not yet universal.
- */
+ if (type == TCL_NUMBER_DOUBLE) {
+ double fractPart, intPart;
+ long max = LONG_MAX, min = LONG_MIN;
- d = valuePtr->internalRep.doubleValue;
- f = modf(d, &i);
- if (d < 0.0) {
- if (f <= -0.5) {
- i += -1.0;
- }
- if (i <= Tcl_WideAsDouble(LLONG_MIN)) {
- goto tooLarge;
- } else if (d <= (double) LONG_MIN) {
- resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
- } else {
- resPtr = Tcl_NewLongObj((long) i);
+ fractPart = modf(*((const double *) ptr), &intPart);
+ if (fractPart <= -0.5) {
+ min++;
+ } else if (fractPart >= 0.5) {
+ max--;
}
- } else {
- if (f >= 0.5) {
- i += 1.0;
- }
- if (i >= Tcl_WideAsDouble(LLONG_MAX)) {
- goto tooLarge;
- } else if (i >= (double) LONG_MAX) {
- resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
+ if ((intPart >= (double)max) || (intPart <= (double)min)) {
+ mp_int big;
+
+ if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) {
+ /* Infinity */
+ return TCL_ERROR;
+ }
+ if (fractPart <= -0.5) {
+ mp_sub_d(&big, 1, &big);
+ } else if (fractPart >= 0.5) {
+ mp_add_d(&big, 1, &big);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+ return TCL_OK;
} else {
- resPtr = Tcl_NewLongObj((long) i);
+ long result = (long)intPart;
+
+ if (fractPart <= -0.5) {
+ result--;
+ } else if (fractPart >= 0.5) {
+ result++;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
+ return TCL_OK;
}
}
- Tcl_SetObjResult(interp, resPtr);
- return TCL_OK;
+
+ if (type != TCL_NUMBER_NAN) {
+ /*
+ * All integers are already rounded
+ */
+
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
/*
- * Error return: result cannot be represented as an integer.
+ * Get the error message for NaN.
*/
- tooLarge:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", (char *) NULL);
-
+ Tcl_GetDoubleFromObj(interp, objv[1], &d);
return TCL_ERROR;
-
}
static int
-ExprSrandFunc(clientData, interp, objc, objv)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* The interpreter in which to execute the
+ExprSrandFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
- int objc; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Parameter vector */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Parameter vector. */
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *valuePtr;
long i = 0; /* Initialized to avoid compiler warning. */
/*
@@ -5531,24 +7825,26 @@ ExprSrandFunc(clientData, interp, objc, objv)
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
+ Tcl_Obj *objPtr;
+ mp_int big;
- if (Tcl_GetLongFromObj(NULL, valuePtr, &i) != TCL_OK) {
- /*
- * At this point, the only other possible type is double
- */
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't use floating-point value as argument to srand", -1));
- return TCL_ERROR;
+ if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
+ /* TODO: more ::errorInfo here? or in caller? */
+ return TCL_ERROR;
+ }
+
+ mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+ objPtr = Tcl_NewBignumObj(&big);
+ Tcl_IncrRefCount(objPtr);
+ TclGetLongFromObj(NULL, objPtr, &i);
+ Tcl_DecrRefCount(objPtr);
}
/*
* Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
- * ExprRandFunc() for more details.
+ * ExprRandFunc for more details.
*/
iPtr->flags |= RAND_SEED_INITIALIZED;
@@ -5565,115 +7861,1148 @@ ExprSrandFunc(clientData, interp, objc, objv)
*/
return ExprRandFunc(clientData, interp, 1, objv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MathFuncWrongNumArgs --
+ *
+ * Generate an error message when a math function presents the wrong
+ * number of arguments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An error message is stored in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+MathFuncWrongNumArgs(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int expected, /* Formal parameter count. */
+ int found, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
+ const char *name = Tcl_GetString(objv[0]);
+ const char *tail = name + strlen(name);
+
+ while (tail > name+1) {
+ tail--;
+ if (*tail == ':' && tail[-1] == ':') {
+ name = tail+1;
+ break;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "too %s arguments for math function \"%s\"",
+ (found < expected ? "few" : "many"), name));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
}
+#ifdef USE_DTRACE
/*
*----------------------------------------------------------------------
*
- * VerifyExprObjType --
+ * DTraceObjCmd --
*
- * This procedure is called by the math functions to verify that the
- * object is either an int or double, coercing it if necessary. If an
- * error occurs during conversion, an error message is left in the
- * interpreter's result unless "interp" is NULL.
+ * This function is invoked to process the "::tcl::dtrace" Tcl command.
*
* Results:
- * TCL_OK if it was int or double, TCL_ERROR otherwise
+ * A standard Tcl object result.
*
* Side effects:
- * objPtr is ensured to be of tclIntType, tclWideIntType or
- * tclDoubleType.
+ * The 'tcl-probe' DTrace probe is triggered (if it is enabled).
*
*----------------------------------------------------------------------
*/
static int
-VerifyExprObjType(interp, objPtr)
- Tcl_Interp *interp; /* The interpreter in which to execute the
- * function. */
- Tcl_Obj *objPtr; /* Points to the object to type check. */
+DTraceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
- return TCL_OK;
- } else {
- int length, result = TCL_OK;
- char *s = Tcl_GetStringFromObj(objPtr, &length);
+ if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
+ char *a[10];
+ int i = 0;
- if (TclLooksLikeInt(s, length)) {
- long i; /* Set but never used, needed in GET_WIDE_OR_INT */
- Tcl_WideInt w;
- GET_WIDE_OR_INT(result, objPtr, i, w);
- } else {
- double d;
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
+ while (i++ < 10) {
+ a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
}
- if ((result != TCL_OK) && (interp != NULL)) {
- if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "argument to math function was an invalid octal number",
- -1));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "argument to math function didn't have numeric value",
- -1));
- }
+ TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDTraceInfo --
+ *
+ * Extract information from a TIP280 dict for use by DTrace probes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDTraceInfo(
+ Tcl_Obj *info,
+ const char **args,
+ int *argsi)
+{
+ static Tcl_Obj *keys[10] = { NULL };
+ Tcl_Obj **k = keys, *val;
+ int i = 0;
+
+ if (!*k) {
+#define kini(s) TclNewLiteralStringObj(keys[i], s); i++
+ kini("cmd"); kini("type"); kini("proc"); kini("file");
+ kini("method"); kini("class"); kini("lambda"); kini("object");
+ kini("line"); kini("level");
+#undef kini
+ }
+ for (i = 0; i < 6; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ args[i] = val ? TclGetString(val) : NULL;
+ }
+ /* no "proc" -> use "lambda" */
+ if (!args[2]) {
+ Tcl_DictObjGet(NULL, info, *k, &val);
+ args[2] = val ? TclGetString(val) : NULL;
+ }
+ k++;
+ /* no "class" -> use "object" */
+ if (!args[5]) {
+ Tcl_DictObjGet(NULL, info, *k, &val);
+ args[5] = val ? TclGetString(val) : NULL;
+ }
+ k++;
+ for (i = 0; i < 2; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ if (val) {
+ TclGetIntFromObj(NULL, val, &argsi[i]);
+ } else {
+ argsi[i] = 0;
}
- return result;
}
}
/*
*----------------------------------------------------------------------
*
- * MathFuncWrongNumArgs --
+ * DTraceCmdReturn --
*
- * Generate an error message when a math function presents the wrong
- * number of arguments.
+ * NR callback for DTrace command return probes.
*
* Results:
* None.
*
* Side effects:
- * An error message is stored in the interpreter result.
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DTraceCmdReturn(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ char *cmdName = TclGetString((Tcl_Obj *) data[0]);
+
+ if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
+ TCL_DTRACE_CMD_RETURN(cmdName, result);
+ }
+ if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
+ Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+ TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r);
+ }
+ return result;
+}
+
+TCL_DTRACE_DEBUG_LOG()
+
+#endif /* USE_DTRACE */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NRCallObjProc --
+ *
+ * This function calls an objProc directly while managing things properly
+ * if it happens to be an NR objProc. It is meant to be used by extenders
+ * that provide an NR implementation of a command, as this function
+ * permits a trivial coding of the non-NR objProc.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR. A result or error message is left in interp's result.
+ *
+ * Side effects:
+ * Depends on the objProc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NRCallObjProc(
+ Tcl_Interp *interp,
+ Tcl_ObjCmdProc *objProc,
+ ClientData clientData,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ NRE_callback *rootPtr = TOP_CB(interp);
+
+ TclNRAddCallback(interp, Dispatch, objProc, clientData,
+ INT2PTR(objc), objv);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NRCreateCommand --
+ *
+ * Define a new NRE-enabled object-based command in a command table.
+ *
+ * Results:
+ * The return value is a token for the command, which can be used in
+ * future calls to Tcl_GetCommandName.
+ *
+ * Side effects:
+ * If no command named "cmdName" already exists for interp, one is
+ * created. Otherwise, if a command does exist, then if the object-based
+ * Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
+ * was called previously for the same command and just set its
+ * Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
+ * command.
+ *
+ * In the future, during bytecode evaluation when "cmdName" is seen as
+ * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
+ * Tcl_ObjCmdProc proc will be called. When the command is deleted from
+ * the table, deleteProc will be called. See the manual entry for details
+ * on the calling sequence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_NRCreateCommand(
+ Tcl_Interp *interp, /* Token for command interpreter (returned by
+ * previous call to Tcl_CreateInterp). */
+ const char *cmdName, /* Name of command. If it contains namespace
+ * qualifiers, the new command is put in the
+ * specified namespace; otherwise it is put in
+ * the global namespace. */
+ Tcl_ObjCmdProc *proc, /* Object-based function to associate with
+ * name, provides direct access for direct
+ * calls. */
+ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with
+ * name, provides NR implementation */
+ ClientData clientData, /* Arbitrary value to pass to object
+ * function. */
+ Tcl_CmdDeleteProc *deleteProc)
+ /* If not NULL, gives a function to call when
+ * this command is deleted. */
+{
+ Command *cmdPtr = (Command *)
+ Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
+
+ cmdPtr->nreProc = nreProc;
+ return (Tcl_Command) cmdPtr;
+}
+
+/****************************************************************************
+ * Stuff for the public api
+ ****************************************************************************/
+
+int
+Tcl_NREvalObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int flags)
+{
+ return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
+}
+
+int
+Tcl_NREvalObjv(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * command. Also used for error reporting. */
+ int objc, /* Number of words in command. */
+ Tcl_Obj *const objv[], /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags) /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+ * TCL_EVAL_NOERR are currently supported. */
+{
+ return TclNREvalObjv(interp, objc, objv, flags, NULL);
+}
+
+int
+Tcl_NRCmdSwap(
+ Tcl_Interp *interp,
+ Tcl_Command cmd,
+ int objc,
+ Tcl_Obj *const objv[],
+ int flags)
+{
+ return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
+ (Command *) cmd);
+}
+
+/*****************************************************************************
+ * Stuff for tailcalls
+ *****************************************************************************
+ *
+ * Just to show that IT CAN BE DONE! The precise semantics are not simple,
+ * require more thought. Possibly need a new Tcl return code to do it right?
+ * Questions include:
+ * (1) How is the objc/objv tailcall to be run? My current thinking is that
+ * it should essentially be
+ * [tailcall a b c] <=> [uplevel 1 [list a b c]]
+ * with two caveats
+ * (a) the current frame is dropped first, after running all pending
+ * cleanup tasks and saving its namespace
+ * (b) 'a' is looked up in the returning frame's namespace, but the
+ * command is run in the context to which we are returning
+ * Current implementation does this if [tailcall] is called from within
+ * a proc, errors otherwise.
+ * (2) Should a tailcall bypass [catch] in the returning frame? Current
+ * implementation does not (or does it? Changed, test!) - it causes an
+ * error.
+ *
+ * FIXME NRE!
+ */
+
+void
+TclMarkTailcall(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->deferredCallbacks == NULL) {
+ TclNRAddCallback(interp, NRCommand, NULL, NULL,
+ NULL, NULL);
+ iPtr->deferredCallbacks = TOP_CB(interp);
+ }
+}
+
+void
+TclSkipTailcall(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ TclMarkTailcall(interp);
+ iPtr->deferredCallbacks->data[1] = INT2PTR(1);
+}
+
+void
+TclPushTailcallPoint(
+ Tcl_Interp *interp)
+{
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+ ((Interp *) interp)->numLevels++;
+}
+
+void
+TclSetTailcall(
+ Tcl_Interp *interp,
+ Tcl_Obj *listPtr)
+{
+ /*
+ * Find the splicing spot: right before the NRCommand of the thing
+ * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
+ * (used by command redirectors).
+ */
+
+ NRE_callback *runPtr;
+
+ for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+ if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+ break;
+ }
+ }
+ if (!runPtr) {
+ Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
+ }
+ runPtr->data[1] = listPtr;
+}
+
+int
+TclNRTailcallObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ 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;
+ }
+
+ /*
+ * Invocation without args just clears a scheduled tailcall; invocation
+ * with an argument replaces any previously scheduled tailcall.
+ */
+
+ if (iPtr->varFramePtr->tailcallPtr) {
+ Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+ iPtr->varFramePtr->tailcallPtr = NULL;
+ }
+
+ /*
+ * Create the callback to actually evaluate the tailcalled
+ * command, then set it in the varFrame so that PopCallFrame can use it
+ * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
+ * build the callback.
+ */
+
+ if (objc > 1) {
+ Tcl_Obj *listPtr, *nsObjPtr;
+ Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+ Tcl_Namespace *ns1Ptr;
+
+ /* The tailcall data is in a Tcl list: the first element is the
+ * namespace, the rest the command to be tailcalled. */
+
+ listPtr = Tcl_NewListObj(objc, objv);
+
+ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+ if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
+ || (nsPtr != ns1Ptr)) {
+ Tcl_Panic("Tailcall failed to find the proper namespace");
+ }
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
+ iPtr->varFramePtr->tailcallPtr = listPtr;
+ }
+ return TCL_RETURN;
+}
+
+int
+TclNRTailcallEval(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *listPtr = data[0], *nsObjPtr;
+ Tcl_Namespace *nsPtr;
+ int objc;
+ Tcl_Obj **objv;
+
+ Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
+ nsObjPtr = objv[0];
+
+ if (result == TCL_OK) {
+ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+ }
+
+ if (result != TCL_OK) {
+ /*
+ * Tailcall execution was preempted, eg by an intervening catch or by
+ * a now-gone namespace: cleanup and return.
+ */
+
+ TailcallCleanup(data, interp, result);
+ return result;
+ }
+
+ /*
+ * Perform the tailcall
+ */
+
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
+ iPtr->lookupNsPtr = (Namespace *) nsPtr;
+ return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
+}
+
+static int
+TailcallCleanup(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_DecrRefCount((Tcl_Obj *) data[0]);
+ return result;
+}
+
+
+void
+Tcl_NRAddCallback(
+ Tcl_Interp *interp,
+ Tcl_NRPostProc *postProcPtr,
+ ClientData data0,
+ ClientData data1,
+ ClientData data2,
+ ClientData data3)
+{
+ if (!(postProcPtr)) {
+ Tcl_Panic("Adding a callback without an objProc?!");
+ }
+ TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineObjCmd -- (and friends)
+ *
+ * This object-based function is invoked to process the "coroutine" Tcl
+ * command. It is heavily based on "apply".
+ *
+ * Results:
+ * A standard Tcl object result value.
+ *
+ * Side effects:
+ * A new procedure gets created.
*
+ * ** FIRST EXPERIMENTAL IMPLEMENTATION **
+ *
+ * It is fairly amateurish and not up to our standards - mainly in terms of
+ * error messages and [info] interaction. Just to test the infrastructure in
+ * teov and tebc.
*----------------------------------------------------------------------
*/
+#define iPtr ((Interp *) interp)
+
+int
+TclNRYieldObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
+ return TCL_ERROR;
+ }
+
+ if (!corPtr) {
+ 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;
+ }
+
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, objv[1]);
+ }
+
+ NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+ clientData, NULL, NULL);
+ return TCL_OK;
+}
+
+int
+TclNRYieldToObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ Tcl_Obj *listPtr, *nsObjPtr;
+ Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (!corPtr) {
+ 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;
+ }
+
+ if (((Namespace *) nsPtr)->flags & NS_DYING) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add the tailcall in the caller env, then just yield.
+ *
+ * This is essentially code from TclNRTailcallObjCmd
+ */
+
+ listPtr = Tcl_NewListObj(objc, objv);
+ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
+ /*
+ * Add the callback in the caller's env, then instruct TEBC to yield.
+ */
+
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ TclSetTailcall(interp, listPtr);
+ iPtr->execEnvPtr = corPtr->eePtr;
+
+ return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
+}
+
+static int
+RewindCoroutineCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ return Tcl_RestoreInterpState(interp, data[0]);
+}
+
+static int
+RewindCoroutine(
+ CoroutineData *corPtr,
+ int result)
+{
+ Tcl_Interp *interp = corPtr->eePtr->interp;
+ Tcl_InterpState state = Tcl_SaveInterpState(interp, result);
+
+ NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
+ NRE_ASSERT(corPtr->eePtr != NULL);
+ NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);
+
+ corPtr->eePtr->rewind = 1;
+ TclNRAddCallback(interp, RewindCoroutineCallback, state,
+ NULL, NULL, NULL);
+ return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
+}
+
static void
-MathFuncWrongNumArgs(interp, expected, found, objv)
- Tcl_Interp* interp; /* Tcl interpreter */
- int expected; /* Formal parameter count */
- int found; /* Actual parameter count */
- Tcl_Obj *CONST *objv; /* Actual parameter vector */
+DeleteCoroutine(
+ ClientData clientData)
{
- Tcl_Obj* errorMessage;
- CONST char* name = Tcl_GetString(objv[0]);
- CONST char* tail = name + strlen(name);
+ CoroutineData *corPtr = clientData;
+ Tcl_Interp *interp = corPtr->eePtr->interp;
+ NRE_callback *rootPtr = TOP_CB(interp);
- while (tail > name+1) {
- --tail;
- if (*tail == ':' && tail[-1] == ':') {
- name = tail+1;
- break;
- }
+ if (COR_IS_SUSPENDED(corPtr)) {
+ TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
}
- errorMessage = Tcl_NewStringObj("too ", -1);
- if (found < expected) {
- Tcl_AppendToObj(errorMessage, "few", -1);
+}
+
+static int
+NRCoroutineCallerCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ Command *cmdPtr = corPtr->cmdPtr;
+
+ /*
+ * This is the last callback in the caller execEnv, right before switching
+ * to the coroutine's
+ */
+
+ NRE_ASSERT(iPtr->execEnvPtr == corPtr->callerEEPtr);
+
+ if (!corPtr->eePtr) {
+ /*
+ * The execEnv was wound down but not deleted for our sake. We finish
+ * the job here. The caller context has already been restored.
+ */
+
+ NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
+ NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
+ NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
+ 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
+ * execEnv, this will do the complete cleanup. RewindCoroutine will
+ * restore both the caller's context and interp state.
+ */
+
+ return RewindCoroutine(corPtr, result);
+ }
+
+ return result;
+}
+
+static int
+NRCoroutineExitCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ Command *cmdPtr = corPtr->cmdPtr;
+
+ /*
+ * This runs at the bottom of the Coroutine's execEnv: it will be executed
+ * when the coroutine returns or is wound down, but not when it yields. It
+ * deletes the coroutine and restores the caller's environment.
+ */
+
+ NRE_ASSERT(interp == corPtr->eePtr->interp);
+ NRE_ASSERT(TOP_CB(interp) == NULL);
+ NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
+ NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
+ NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback));
+
+ cmdPtr->deleteProc = NULL;
+ Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+ TclCleanupCommandMacro(cmdPtr);
+
+ corPtr->eePtr->corPtr = NULL;
+ TclDeleteExecEnv(corPtr->eePtr);
+ corPtr->eePtr = NULL;
+
+ corPtr->stackLevel = NULL;
+
+ /*
+ * #280.
+ * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
+ * command arguments in bytecode.
+ */
+
+ Tcl_DeleteHashTable(corPtr->lineLABCPtr);
+ ckfree(corPtr->lineLABCPtr);
+ corPtr->lineLABCPtr = NULL;
+
+ RESTORE_CONTEXT(corPtr->caller);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ iPtr->numLevels++;
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineActivateCallback --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNRCoroutineActivateCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ int type = PTR2INT(data[1]);
+ int numLevels, unused;
+ int *stackLevel = &unused;
+
+ if (!corPtr->stackLevel) {
+ /*
+ * -- Coroutine is suspended --
+ * Push the callback to restore the caller's context on yield or
+ * return.
+ */
+
+ 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.
+ */
+
+ corPtr->stackLevel = stackLevel;
+ numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = iPtr->numLevels;
+
+ SAVE_CONTEXT(corPtr->caller);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ RESTORE_CONTEXT(corPtr->running);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ iPtr->numLevels += numLevels;
} else {
- Tcl_AppendToObj(errorMessage, "many", -1);
+ /*
+ * Coroutine is active: yield
+ */
+
+ if (corPtr->stackLevel != stackLevel) {
+ 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) {
+ 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;
+ iPtr->numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
+
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ }
+
+ 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;
}
- Tcl_AppendToObj(errorMessage, " arguments for math function \"", -1);
- Tcl_AppendToObj(errorMessage, name, -1);
- Tcl_AppendToObj(errorMessage, "\"", -1);
- Tcl_SetObjResult(interp, errorMessage);
+
+ /*
+ * 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
+TclNRInterpCoroutine(
+ ClientData clientData,
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ CoroutineData *corPtr = clientData;
+
+ if (!COR_IS_SUSPENDED(corPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "coroutine \"%s\" is already running",
+ Tcl_GetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse all the arguments to work out what to feed as the result of the
+ * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine
+ * is deleted!
+ */
+
+ switch (corPtr->nargs) {
+ case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, objv[1]);
+ } else if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
+ return TCL_ERROR;
+ }
+ break;
+ default:
+ if (corPtr->nargs != objc-1) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("wrong coro nargs; how did we get here? "
+ "not implemented!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+ /* fallthrough */
+ case COROUTINE_ARGUMENTS_ARBITRARY:
+ if (objc > 1) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
+ }
+ break;
+ }
+
+ 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. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Command *cmdPtr;
+ CoroutineData *corPtr;
+ 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;
+ }
+
+ /*
+ * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
+ * something in tclUtil.c to find the FQ name.
+ */
+
+ fullName = TclGetString(objv[1]);
+ TclGetNamespaceForQualName(interp, fullName, NULL, 0,
+ &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+
+ if (nsPtr == 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_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_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;
+ }
+
+ /*
+ * We ARE creating the coroutine command: allocate the corresponding
+ * struct and create the corresponding command.
+ */
+
+ corPtr = ckalloc(sizeof(CoroutineData));
+
+ Tcl_DStringInit(&ds);
+ if (nsPtr != iPtr->globalNsPtr) {
+ Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+ TclDStringAppendLiteral(&ds, "::");
+ }
+ Tcl_DStringAppend(&ds, procName, -1);
+
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
+ /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
+ Tcl_DStringFree(&ds);
+
+ corPtr->cmdPtr = cmdPtr;
+ cmdPtr->refCount++;
+
+ /*
+ * #280.
+ * Provide the new coroutine with its own copy of the lineLABCPtr
+ * hashtable for literal command arguments in bytecode. Note that that
+ * CFWordBC chains are not duplicated, only the entrypoints to them. This
+ * means that in the presence of coroutines each chain is potentially a
+ * tree. Like the chain -> tree conversion of the CmdFrame stack.
+ */
+
+ {
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hePtr;
+
+ corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
+
+ for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
+ hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
+ int isNew;
+ Tcl_HashEntry *newPtr =
+ Tcl_CreateHashEntry(corPtr->lineLABCPtr,
+ Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
+ &isNew);
+
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
+ }
+ }
+
+ /*
+ * Create the base context.
+ */
+
+ corPtr->running.framePtr = iPtr->rootFramePtr;
+ corPtr->running.varFramePtr = iPtr->rootFramePtr;
+ corPtr->running.cmdFramePtr = NULL;
+ corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
+ corPtr->stackLevel = NULL;
+ corPtr->auxNumLevels = 0;
+
+ /*
+ * Create the coro's execEnv, switch to it to push the exit and coro
+ * 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);
+
+ /* 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.
+ */
+
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+ NULL, NULL, NULL);
+ return TCL_OK;
+}
+
+/*
+ * This is used in the [info] ensemble
+ */
+
+int
+TclInfoCoroutineCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+ Tcl_Obj *namePtr;
+
+ TclNewObj(namePtr);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, namePtr);
+ Tcl_SetObjResult(interp, namePtr);
+ }
+ return TCL_OK;
+}
+
+#undef iPtr
+
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index c6231f0..981f174 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -7,13 +7,12 @@
* 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: tclBinary.c,v 1.25 2005/07/17 21:17:30 dkf 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"
+#include "tommath.h"
#include <math.h>
@@ -26,16 +25,23 @@
#define BINARY_NOCOUNT -2 /* No count was specified in format. */
/*
+ * The following flags may be ORed together and returned by GetFormatSpec
+ */
+
+#define BINARY_SIGNED 0 /* Field to be read as signed data */
+#define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */
+
+/*
* The following defines the maximum number of different (integer) numbers
* placed in the object cache by 'binary scan' before it bails out and
* switches back to Plan A (creating a new object for each value.)
* Theoretically, it would be possible to keep the cache about for the values
* that are already in it, but that makes the code slower in practise when
* overflow happens, and makes little odds the rest of the time (as measured
- * on my machine.) It is also slower (on the sample I tried at least) to grow
+ * on my machine.) It is also slower (on the sample I tried at least) to grow
* the cache to hold all items we might want to put in it; presumably the
* extra cost of managing the memory for the enlarged table outweighs the
- * benefit from allocating fewer objects. This is probably because as the
+ * benefit from allocating fewer objects. This is probably because as the
* number of objects increases, the likelihood of reuse of any particular one
* drops, and there is very little gain from larger maximum cache sizes (the
* value below is chosen to allow caching to work in full with conversion of
@@ -48,39 +54,121 @@
* Prototypes for local procedures defined in this file:
*/
-static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
- Tcl_Obj *src, unsigned char **cursorPtr));
-static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
- char *cmdPtr, int *countPtr));
-static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer,
- int type, Tcl_HashTable **numberCachePtr));
-static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
-static void DeleteScanNumberCache _ANSI_ARGS_((
- Tcl_HashTable *numberCachePtr));
-static int NeedReversing _ANSI_ARGS_((int format));
-static void CopyNumber _ANSI_ARGS_((CONST void *from, void *to,
- unsigned int length, int type));
+static void DupByteArrayInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static int FormatNumber(Tcl_Interp *interp, int type,
+ Tcl_Obj *src, unsigned char **cursorPtr);
+static void FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static int GetFormatSpec(const char **formatPtr, char *cmdPtr,
+ int *countPtr, int *flagsPtr);
+static Tcl_Obj * ScanNumber(unsigned char *buffer, int type,
+ int flags, Tcl_HashTable **numberCachePtr);
+static int SetByteArrayFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void UpdateStringOfByteArray(Tcl_Obj *listPtr);
+static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
+static int NeedReversing(int format);
+static void CopyNumber(const void *from, void *to,
+ unsigned length, int type);
+/* Binary ensemble commands */
+static int BinaryFormatCmd(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int BinaryScanCmd(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+/* Binary encoding sub-ensemble commands */
+static int BinaryEncodeHex(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int BinaryDecodeHex(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int BinaryEncode64(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int BinaryDecode64(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int BinaryEncodeUu(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int BinaryDecodeUu(ClientData clientData,
+ Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+
+/*
+ * The following tables are used by the binary encoders
+ */
+
+static const char HexDigits[16] = {
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'
+};
+
+static const char UueDigits[65] = {
+ '`', '!', '"', '#', '$', '%', '&', '\'',
+ '(', ')', '*', '+', ',', '-', '.', '/',
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', ':', ';', '<', '=', '>', '?',
+ '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', '[', '\\',']', '^', '_',
+ '`'
+};
+
+static const char B64Digits[65] = {
+ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
+ 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
+ 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
+ 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
+ 'w', 'x', 'y', 'z', '0', '1', '2', '3',
+ '4', '5', '6', '7', '8', '9', '+', '/',
+ '='
+};
/*
- * The following object type represents an array of bytes. An array of bytes
- * is not equivalent to an internationalized string. Conceptually, a string
- * is an array of 16-bit quantities organized as a sequence of properly formed
+ * How to construct the ensembles.
+ */
+
+static const EnsembleImplMap binaryMap[] = {
+ { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
+ { "scan", BinaryScanCmd, TclCompileBasicMin2ArgCmd, 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, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ { "uuencode", BinaryEncodeUu, NULL, NULL, NULL, 0 },
+ { "base64", BinaryEncode64, NULL, NULL, NULL, 0 },
+ { NULL, NULL, NULL, NULL, NULL, 0 }
+};
+static const EnsembleImplMap decodeMap[] = {
+ { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ { NULL, NULL, NULL, NULL, NULL, 0 }
+};
+
+/*
+ * The following object type represents an array of bytes. An array of bytes
+ * is not equivalent to an internationalized string. Conceptually, a string is
+ * an array of 16-bit quantities organized as a sequence of properly formed
* UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
* Accessor functions are provided to convert a ByteArray to a String or a
- * String to a ByteArray. Two or more consecutive bytes in an array of bytes
+ * String to a ByteArray. Two or more consecutive bytes in an array of bytes
* may look like a single UTF-8 character if the array is casually treated as
- * a string. But obtaining the String from a ByteArray is guaranteed to
+ * a string. But obtaining the String from a ByteArray is guaranteed to
* produced properly formed UTF-8 sequences so that there is a one-to-one map
* between bytes and characters.
*
* Converting a ByteArray to a String proceeds by casting each byte in the
* array to a 16-bit quantity, treating that number as a Unicode character,
- * and storing the UTF-8 version of that Unicode character in the String. For
+ * and storing the UTF-8 version of that Unicode character in the String. For
* ByteArrays consisting entirely of values 1..127, the corresponding String
* representation is the same as the ByteArray representation.
*
@@ -91,7 +179,7 @@ static void CopyNumber _ANSI_ARGS_((CONST void *from, void *to,
* converting an arbitrary String to a ByteArray may be.
*/
-Tcl_ObjType tclByteArrayType = {
+const Tcl_ObjType tclByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
@@ -100,7 +188,7 @@ Tcl_ObjType tclByteArrayType = {
};
/*
- * The following structure is the internal rep for a ByteArray object. Keeps
+ * The following structure is the internal rep for a ByteArray object. Keeps
* track of how much memory has been used and how much has been allocated for
* the byte array to enable growing and shrinking of the ByteArray object with
* fewer mallocs.
@@ -111,17 +199,17 @@ 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 field depends on the 'allocated' field
+ 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)))
+#define BYTEARRAY_SIZE(len) \
+ ((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
- ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
+ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
/*
@@ -133,8 +221,8 @@ typedef struct ByteArray {
* from the given array of bytes.
*
* Results:
- * The newly create object is returned. This object will have no initial
- * string representation. The returned object has a ref count of 0.
+ * The newly create object is returned. This object will have no initial
+ * string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of byte array argument.
@@ -142,35 +230,25 @@ typedef struct ByteArray {
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
#undef Tcl_NewByteArrayObj
Tcl_Obj *
-Tcl_NewByteArrayObj(bytes, length)
- CONST unsigned char *bytes; /* The array of bytes used to initialize the
+Tcl_NewByteArrayObj(
+ const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
- int length; /* Length of the array of bytes, which must be
+ int length) /* Length of the array of bytes, which must be
* >= 0. */
{
+#ifdef TCL_MEM_DEBUG
return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
-}
-
#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewByteArrayObj(bytes, length)
- CONST unsigned char *bytes; /* The array of bytes used to initialize the
- * new object. */
- int length; /* Length of the array of bytes, which must be
- * >= 0. */
-{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetByteArrayObj(objPtr, bytes, length);
return objPtr;
-}
#endif /* TCL_MEM_DEBUG */
+}
/*
*----------------------------------------------------------------------
@@ -188,8 +266,8 @@ Tcl_NewByteArrayObj(bytes, length)
* result of calling Tcl_NewByteArrayObj.
*
* Results:
- * The newly create object is returned. This object will have no initial
- * string representation. The returned object has a ref count of 0.
+ * The newly create object is returned. This object will have no initial
+ * string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of byte array argument.
@@ -197,43 +275,28 @@ Tcl_NewByteArrayObj(bytes, length)
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
-
Tcl_Obj *
-Tcl_DbNewByteArrayObj(bytes, length, file, line)
- CONST unsigned char *bytes; /* The array of bytes used to initialize the
+Tcl_DbNewByteArrayObj(
+ const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
- int length; /* Length of the array of bytes, which must be
+ int length, /* Length of the array of bytes, which must be
* >= 0. */
- CONST char *file; /* The name of the source file calling this
+ const char *file, /* The name of the source file calling this
* procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ int line) /* Line number in the source file; used for
* debugging. */
{
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetByteArrayObj(objPtr, bytes, length);
return objPtr;
-}
-
#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewByteArrayObj(bytes, length, file, line)
- CONST unsigned char *bytes; /* The array of bytes used to initialize the
- * new object. */
- int length; /* Length of the array of bytes, which must be
- * >= 0. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
- * debugging. */
-{
return Tcl_NewByteArrayObj(bytes, length);
-}
#endif /* TCL_MEM_DEBUG */
-
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -246,33 +309,38 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
* None.
*
* Side effects:
- * The object's old string rep and internal rep is freed. Memory
+ * The object's old string rep and internal rep is freed. Memory
* allocated for copy of byte array argument.
*
*----------------------------------------------------------------------
*/
void
-Tcl_SetByteArrayObj(objPtr, bytes, length)
- Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */
- CONST unsigned char *bytes; /* The array of bytes to use as the new
- * value. */
- int length; /* Length of the array of bytes, which must be
- * >= 0. */
+Tcl_SetByteArrayObj(
+ Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
+ const unsigned char *bytes, /* The array of bytes to use as the new
+ value. May be NULL even if length > 0. */
+ int length) /* Length of the array of bytes, which must
+ be >= 0. */
{
ByteArray *byteArrayPtr;
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetByteArrayObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
TclFreeIntRep(objPtr);
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
- byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ if (length < 0) {
+ length = 0;
+ }
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr->used = length;
byteArrayPtr->allocated = length;
- memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
+ if ((bytes != NULL) && (length > 0)) {
+ memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
+ }
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
@@ -282,7 +350,7 @@ Tcl_SetByteArrayObj(objPtr, bytes, length)
*
* Tcl_GetByteArrayFromObj --
*
- * Attempt to get the array of bytes from the Tcl object. If the object
+ * Attempt to get the array of bytes from the Tcl object. If the object
* is not already a ByteArray object, an attempt will be made to convert
* it to one.
*
@@ -290,20 +358,22 @@ Tcl_SetByteArrayObj(objPtr, bytes, length)
* Pointer to array of bytes representing the ByteArray object.
*
* Side effects:
- * Frees old internal rep. Allocates memory for new internal rep.
+ * Frees old internal rep. Allocates memory for new internal rep.
*
*----------------------------------------------------------------------
*/
unsigned char *
-Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
- Tcl_Obj *objPtr; /* The ByteArray object. */
- int *lengthPtr; /* If non-NULL, filled with length of the
+Tcl_GetByteArrayFromObj(
+ Tcl_Obj *objPtr, /* The ByteArray object. */
+ int *lengthPtr) /* If non-NULL, filled with length of the
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
- SetByteArrayFromAny(NULL, objPtr);
+ if (objPtr->typePtr != &tclByteArrayType) {
+ SetByteArrayFromAny(NULL, objPtr);
+ }
baPtr = GET_BYTEARRAY(objPtr);
if (lengthPtr != NULL) {
@@ -335,14 +405,14 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
*/
unsigned char *
-Tcl_SetByteArrayLength(objPtr, length)
- Tcl_Obj *objPtr; /* The ByteArray object. */
- int length; /* New length for internal byte array. */
+Tcl_SetByteArrayLength(
+ Tcl_Obj *objPtr, /* The ByteArray object. */
+ int length) /* New length for internal byte array. */
{
- ByteArray *byteArrayPtr, *newByteArrayPtr;
+ ByteArray *byteArrayPtr;
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetObjLength called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
@@ -350,16 +420,11 @@ Tcl_SetByteArrayLength(objPtr, length)
byteArrayPtr = GET_BYTEARRAY(objPtr);
if (length > byteArrayPtr->allocated) {
- newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
- newByteArrayPtr->used = length;
- newByteArrayPtr->allocated = length;
- memcpy((VOID *) newByteArrayPtr->bytes,
- (VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
- ckfree((char *) byteArrayPtr);
- byteArrayPtr = newByteArrayPtr;
+ byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
+ byteArrayPtr->allocated = length;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
byteArrayPtr->used = length;
return byteArrayPtr->bytes;
}
@@ -381,24 +446,24 @@ Tcl_SetByteArrayLength(objPtr, length)
*/
static int
-SetByteArrayFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Not used. */
- Tcl_Obj *objPtr; /* The object to convert to type ByteArray. */
+SetByteArrayFromAny(
+ Tcl_Interp *interp, /* Not used. */
+ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
int length;
- char *src, *srcEnd;
+ const char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
if (objPtr->typePtr != &tclByteArrayType) {
- src = Tcl_GetStringFromObj(objPtr, &length);
+ 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++ = (unsigned char) ch;
+ *dst++ = UCHAR(ch);
}
byteArrayPtr->used = dst - byteArrayPtr->bytes;
@@ -429,10 +494,11 @@ SetByteArrayFromAny(interp, objPtr)
*/
static void
-FreeByteArrayInternalRep(objPtr)
- Tcl_Obj *objPtr; /* Object with internal rep to free. */
+FreeByteArrayInternalRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree((char *) GET_BYTEARRAY(objPtr));
+ ckfree(GET_BYTEARRAY(objPtr));
+ objPtr->typePtr = NULL;
}
/*
@@ -453,9 +519,9 @@ FreeByteArrayInternalRep(objPtr)
*/
static void
-DupByteArrayInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupByteArrayInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
@@ -463,11 +529,10 @@ DupByteArrayInternalRep(srcPtr, copyPtr)
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((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
- (size_t) length);
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
copyPtr->typePtr = &tclByteArrayType;
@@ -496,8 +561,8 @@ DupByteArrayInternalRep(srcPtr, copyPtr)
*/
static void
-UpdateStringOfByteArray(objPtr)
- Tcl_Obj *objPtr; /* ByteArray object whose string rep to
+UpdateStringOfByteArray(
+ Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
int i, length, size;
@@ -514,18 +579,21 @@ UpdateStringOfByteArray(objPtr)
*/
size = length;
- for (i = 0; i < length; i++) {
+ for (i = 0; i < length && size >= 0; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size++;
}
}
+ if (size < 0) {
+ 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;
if (size == length) {
- memcpy((VOID *) dst, (VOID *) src, (size_t) size);
+ memcpy(dst, src, (size_t) size);
dst[size] = '\0';
} else {
for (i = 0; i < length; i++) {
@@ -538,9 +606,126 @@ UpdateStringOfByteArray(objPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_BinaryObjCmd --
+ * TclAppendBytesToByteArray --
*
- * This procedure implements the "binary" Tcl command.
+ * This function appends an array of bytes to a byte array object. Note
+ * that the object *must* be unshared, and the array of bytes *must not*
+ * refer to the object being appended to.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates enough memory for an array of bytes of the requested total
+ * size, or possibly larger. [Bug 2992970]
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAppendBytesToByteArray(
+ Tcl_Obj *objPtr,
+ const unsigned char *bytes,
+ int len)
+{
+ ByteArray *byteArrayPtr;
+ int needed;
+
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
+ }
+ if (len < 0) {
+ Tcl_Panic("%s must be called with definite number of bytes to append",
+ "TclAppendBytesToByteArray");
+ }
+ if (len == 0) {
+ /* Append zero bytes is a no-op. */
+ return;
+ }
+ if (objPtr->typePtr != &tclByteArrayType) {
+ SetByteArrayFromAny(NULL, objPtr);
+ }
+ byteArrayPtr = GET_BYTEARRAY(objPtr);
+
+ if (len > INT_MAX - byteArrayPtr->used) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ needed = byteArrayPtr->used + len;
+ /*
+ * If we need to, resize the allocated space in the byte array.
+ */
+
+ if (needed > byteArrayPtr->allocated) {
+ ByteArray *ptr = NULL;
+ int attempt;
+
+ if (needed <= INT_MAX/2) {
+ /* Try to allocate double the total space that is needed. */
+ attempt = 2 * needed;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
+ }
+ if (ptr == NULL) {
+ /* Try to allocate double the increment that is needed (plus). */
+ unsigned int limit = INT_MAX - needed;
+ unsigned int extra = len + TCL_MIN_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ attempt = needed + growth;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
+ }
+ if (ptr == NULL) {
+ /* Last chance: Try to allocate exactly what is needed. */
+ attempt = needed;
+ ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
+ }
+ byteArrayPtr = ptr;
+ byteArrayPtr->allocated = attempt;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+
+ if (bytes) {
+ memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+ }
+ byteArrayPtr->used += len;
+ TclInvalidateStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitBinaryCmd --
+ *
+ * This function is called to create the "binary" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A command token for the new command.
+ *
+ * Side effects:
+ * Creates a new binary command as a mapped ensemble.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitBinaryCmd(
+ Tcl_Interp *interp)
+{
+ Tcl_Command binaryEnsemble;
+
+ binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
+ TclMakeEnsemble(interp, "binary encode", encodeMap);
+ TclMakeEnsemble(interp, "binary decode", decodeMap);
+ return binaryEnsemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryFormatCmd --
+ *
+ * This procedure implements the "binary format" Tcl command.
*
* Results:
* A standard Tcl result.
@@ -551,12 +736,12 @@ UpdateStringOfByteArray(objPtr)
*----------------------------------------------------------------------
*/
-int
-Tcl_BinaryObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+BinaryFormatCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int arg; /* Index of next argument to consume. */
int value = 0; /* Current integer value to be packed.
@@ -564,792 +749,849 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
char cmd; /* Current format character. */
int count; /* Count associated with current format
* character. */
- char *format; /* Pointer to current position in format
+ int flags; /* Format field flags */
+ const char *format; /* Pointer to current position in format
* string. */
Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */
unsigned char *buffer; /* Start of result buffer. */
unsigned char *cursor; /* Current position within result buffer. */
unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
- char *errorString, *errorValue, *str;
- int offset, size, length, index;
- static CONST char *options[] = {
- "format", "scan", NULL
- };
- enum options {
- BINARY_FORMAT, BINARY_SCAN
- };
+ const char *errorString;
+ const char *errorValue, *str;
+ int offset, size, length;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
+ /*
+ * To avoid copying the data, we format the string in two passes. The
+ * first pass computes the size of the output buffer. The second pass
+ * places the formatted data into the buffer.
+ */
- switch ((enum options) index) {
- case BINARY_FORMAT:
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
- return TCL_ERROR;
+ format = TclGetString(objv[1]);
+ arg = 2;
+ offset = 0;
+ length = 0;
+ while (*format != '\0') {
+ str = format;
+ flags = 0;
+ if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+ break;
}
-
- /*
- * To avoid copying the data, we format the string in two passes. The
- * first pass computes the size of the output buffer. The second pass
- * places the formatted data into the buffer.
- */
-
- format = Tcl_GetString(objv[2]);
- arg = 3;
- offset = 0;
- length = 0;
- while (*format != '\0') {
- str = format;
- if (!GetFormatSpec(&format, &cmd, &count)) {
- break;
+ switch (cmd) {
+ case 'a':
+ case 'A':
+ case 'b':
+ case 'B':
+ case 'h':
+ case 'H':
+ /*
+ * For string-type specifiers, the count corresponds to the number
+ * of bytes in a single argument.
+ */
+
+ if (arg >= objc) {
+ goto badIndex;
+ }
+ if (count == BINARY_ALL) {
+ Tcl_GetByteArrayFromObj(objv[arg], &count);
+ } else if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ arg++;
+ if (cmd == 'a' || cmd == 'A') {
+ offset += count;
+ } else if (cmd == 'b' || cmd == 'B') {
+ offset += (count + 7) / 8;
+ } else {
+ offset += (count + 1) / 2;
+ }
+ break;
+ case 'c':
+ size = 1;
+ goto doNumbers;
+ case 't':
+ case 's':
+ case 'S':
+ size = 2;
+ goto doNumbers;
+ case 'n':
+ case 'i':
+ case 'I':
+ size = 4;
+ goto doNumbers;
+ case 'm':
+ case 'w':
+ case 'W':
+ size = 8;
+ goto doNumbers;
+ case 'r':
+ case 'R':
+ case 'f':
+ size = sizeof(float);
+ goto doNumbers;
+ case 'q':
+ case 'Q':
+ case 'd':
+ size = sizeof(double);
+
+ doNumbers:
+ if (arg >= objc) {
+ goto badIndex;
}
- switch (cmd) {
- case 'a':
- case 'A':
- case 'b':
- case 'B':
- case 'h':
- case 'H':
- /*
- * For string-type specifiers, the count corresponds to the
- * number of bytes in a single argument.
- */
- if (arg >= objc) {
- goto badIndex;
- }
- if (count == BINARY_ALL) {
- Tcl_GetByteArrayFromObj(objv[arg], &count);
- } else if (count == BINARY_NOCOUNT) {
- count = 1;
- }
+ /*
+ * For number-type specifiers, the count corresponds to the number
+ * of elements in the list stored in a single argument. If no
+ * count is specified, then the argument is taken as a single
+ * non-list value.
+ */
+
+ if (count == BINARY_NOCOUNT) {
arg++;
- if (cmd == 'a' || cmd == 'A') {
- offset += count;
- } else if (cmd == 'b' || cmd == 'B') {
- offset += (count + 7) / 8;
- } else {
- offset += (count + 1) / 2;
- }
- break;
- case 'c':
- size = 1;
- goto doNumbers;
- case 't':
- case 's':
- case 'S':
- size = 2;
- goto doNumbers;
- case 'n':
- case 'i':
- case 'I':
- size = 4;
- goto doNumbers;
- case 'm':
- case 'w':
- case 'W':
- size = 8;
- goto doNumbers;
- case 'r':
- case 'R':
- case 'f':
- size = sizeof(float);
- goto doNumbers;
- case 'q':
- case 'Q':
- case 'd':
- size = sizeof(double);
-
- doNumbers:
- if (arg >= objc) {
- goto badIndex;
- }
+ count = 1;
+ } else {
+ int listc;
+ Tcl_Obj **listv;
/*
- * For number-type specifiers, the count corresponds to the
- * number of elements in the list stored in a single argument.
- * If no count is specified, then the argument is taken as a
- * single non-list value.
+ * The macro evals its args more than once: avoid arg++
*/
- if (count == BINARY_NOCOUNT) {
- arg++;
- count = 1;
- } else {
- int listc;
- Tcl_Obj **listv;
-
- if (Tcl_ListObjGetElements(interp, objv[arg++], &listc,
- &listv) != TCL_OK) {
- return TCL_ERROR;
- }
- if (count == BINARY_ALL) {
- count = listc;
- } else if (count > listc) {
- Tcl_AppendResult(interp,
- "number of elements in list does not match count",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (TclListObjGetElements(interp, objv[arg], &listc,
+ &listv) != TCL_OK) {
+ return TCL_ERROR;
}
- offset += count*size;
- break;
+ arg++;
- case 'x':
if (count == BINARY_ALL) {
- Tcl_AppendResult(interp,
- "cannot use \"*\" in format string with \"x\"",
- (char *) NULL);
+ count = listc;
+ } else if (count > listc) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "number of elements in list does not match count",
+ -1));
return TCL_ERROR;
- } else if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- offset += count;
- break;
- case 'X':
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if ((count > offset) || (count == BINARY_ALL)) {
- count = offset;
- }
- if (offset > length) {
- length = offset;
- }
- offset -= count;
- break;
- case '@':
- if (offset > length) {
- length = offset;
}
- if (count == BINARY_ALL) {
- offset = length;
- } else if (count == BINARY_NOCOUNT) {
- goto badCount;
- } else {
- offset = count;
- }
- break;
- default:
- errorString = str;
- goto badField;
}
+ offset += count*size;
+ break;
+
+ case 'x':
+ if (count == BINARY_ALL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use \"*\" in format string with \"x\"", -1));
+ return TCL_ERROR;
+ } else if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ offset += count;
+ break;
+ case 'X':
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ if ((count > offset) || (count == BINARY_ALL)) {
+ count = offset;
+ }
+ if (offset > length) {
+ length = offset;
+ }
+ offset -= count;
+ break;
+ case '@':
+ if (offset > length) {
+ length = offset;
+ }
+ if (count == BINARY_ALL) {
+ offset = length;
+ } else if (count == BINARY_NOCOUNT) {
+ goto badCount;
+ } else {
+ offset = count;
+ }
+ break;
+ default:
+ errorString = str;
+ goto badField;
}
- if (offset > length) {
- length = offset;
- }
- if (length == 0) {
- return TCL_OK;
- }
+ }
+ if (offset > length) {
+ length = offset;
+ }
+ if (length == 0) {
+ return TCL_OK;
+ }
- /*
- * Prepare the result object by preallocating the caclulated number of
- * bytes and filling with nulls.
- */
+ /*
+ * Prepare the result object by preallocating the caclulated number of
+ * bytes and filling with nulls.
+ */
- resultPtr = Tcl_NewObj();
- buffer = Tcl_SetByteArrayLength(resultPtr, length);
- memset((VOID *) buffer, 0, (size_t) length);
+ resultPtr = Tcl_NewObj();
+ buffer = Tcl_SetByteArrayLength(resultPtr, length);
+ memset(buffer, 0, (size_t) length);
- /*
- * Pack the data into the result object. Note that we can skip the
- * error checking during this pass, since we have already parsed the
- * string once.
- */
+ /*
+ * Pack the data into the result object. Note that we can skip the
+ * error checking during this pass, since we have already parsed the
+ * string once.
+ */
- arg = 3;
- format = Tcl_GetString(objv[2]);
- cursor = buffer;
- maxPos = cursor;
- while (*format != 0) {
- if (!GetFormatSpec(&format, &cmd, &count)) {
- break;
- }
- if ((count == 0) && (cmd != '@')) {
+ arg = 2;
+ format = TclGetString(objv[1]);
+ cursor = buffer;
+ maxPos = cursor;
+ while (*format != 0) {
+ flags = 0;
+ if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+ break;
+ }
+ if ((count == 0) && (cmd != '@')) {
+ if (cmd != 'x') {
arg++;
- continue;
}
- switch (cmd) {
- case 'a':
- case 'A': {
- char pad = (char) (cmd == 'a' ? '\0' : ' ');
- unsigned char *bytes;
-
- bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
-
- if (count == BINARY_ALL) {
- count = length;
- } else if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if (length >= count) {
- memcpy((VOID *) cursor, (VOID *) bytes, (size_t) count);
- } else {
- memcpy((VOID *) cursor, (VOID *) bytes, (size_t) length);
- memset((VOID *) (cursor + length), pad,
- (size_t) (count - length));
- }
- cursor += count;
- break;
+ continue;
+ }
+ switch (cmd) {
+ case 'a':
+ case 'A': {
+ char pad = (char) (cmd == 'a' ? '\0' : ' ');
+ unsigned char *bytes;
+
+ bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
+
+ if (count == BINARY_ALL) {
+ count = length;
+ } else if (count == BINARY_NOCOUNT) {
+ count = 1;
}
- case 'b':
- case 'B': {
- unsigned char *last;
-
- str = Tcl_GetStringFromObj(objv[arg++], &length);
- if (count == BINARY_ALL) {
- count = length;
- } else if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- last = cursor + ((count + 7) / 8);
- if (count > length) {
- count = length;
- }
- value = 0;
- errorString = "binary";
- if (cmd == 'B') {
- for (offset = 0; offset < count; offset++) {
- value <<= 1;
- if (str[offset] == '1') {
- value |= 1;
- } else if (str[offset] != '0') {
- errorValue = str;
- goto badValue;
- }
- if (((offset + 1) % 8) == 0) {
- *cursor++ = (unsigned char) value;
- value = 0;
- }
+ if (length >= count) {
+ memcpy(cursor, bytes, (size_t) count);
+ } else {
+ memcpy(cursor, bytes, (size_t) length);
+ memset(cursor + length, pad, (size_t) (count - length));
+ }
+ cursor += count;
+ break;
+ }
+ case 'b':
+ case 'B': {
+ unsigned char *last;
+
+ str = TclGetStringFromObj(objv[arg], &length);
+ arg++;
+ if (count == BINARY_ALL) {
+ count = length;
+ } else if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ last = cursor + ((count + 7) / 8);
+ if (count > length) {
+ count = length;
+ }
+ value = 0;
+ errorString = "binary";
+ if (cmd == 'B') {
+ for (offset = 0; offset < count; offset++) {
+ value <<= 1;
+ if (str[offset] == '1') {
+ value |= 1;
+ } else if (str[offset] != '0') {
+ errorValue = str;
+ Tcl_DecrRefCount(resultPtr);
+ goto badValue;
}
- } else {
- for (offset = 0; offset < count; offset++) {
- value >>= 1;
- if (str[offset] == '1') {
- value |= 128;
- } else if (str[offset] != '0') {
- errorValue = str;
- goto badValue;
- }
- if (!((offset + 1) % 8)) {
- *cursor++ = (unsigned char) value;
- value = 0;
- }
+ if (((offset + 1) % 8) == 0) {
+ *cursor++ = UCHAR(value);
+ value = 0;
}
}
- if ((offset % 8) != 0) {
- if (cmd == 'B') {
- value <<= 8 - (offset % 8);
- } else {
- value >>= 8 - (offset % 8);
+ } else {
+ for (offset = 0; offset < count; offset++) {
+ value >>= 1;
+ if (str[offset] == '1') {
+ value |= 128;
+ } else if (str[offset] != '0') {
+ errorValue = str;
+ Tcl_DecrRefCount(resultPtr);
+ goto badValue;
+ }
+ if (!((offset + 1) % 8)) {
+ *cursor++ = UCHAR(value);
+ value = 0;
}
- *cursor++ = (unsigned char) value;
- }
- while (cursor < last) {
- *cursor++ = '\0';
}
- break;
}
- case 'h':
- case 'H': {
- unsigned char *last;
- int c;
-
- str = Tcl_GetStringFromObj(objv[arg++], &length);
- if (count == BINARY_ALL) {
- count = length;
- } else if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- last = cursor + ((count + 1) / 2);
- if (count > length) {
- count = length;
+ if ((offset % 8) != 0) {
+ if (cmd == 'B') {
+ value <<= 8 - (offset % 8);
+ } else {
+ value >>= 8 - (offset % 8);
}
- value = 0;
- errorString = "hexadecimal";
- if (cmd == 'H') {
- for (offset = 0; offset < count; offset++) {
- value <<= 4;
- if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
- errorValue = str;
- goto badValue;
- }
- c = str[offset] - '0';
- if (c > 9) {
- c += ('0' - 'A') + 10;
- }
- if (c > 16) {
- c += ('A' - 'a');
- }
- value |= (c & 0xf);
- if (offset % 2) {
- *cursor++ = (char) value;
- value = 0;
- }
+ *cursor++ = UCHAR(value);
+ }
+ while (cursor < last) {
+ *cursor++ = '\0';
+ }
+ break;
+ }
+ case 'h':
+ case 'H': {
+ unsigned char *last;
+ int c;
+
+ str = TclGetStringFromObj(objv[arg], &length);
+ arg++;
+ if (count == BINARY_ALL) {
+ count = length;
+ } else if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ last = cursor + ((count + 1) / 2);
+ if (count > length) {
+ count = length;
+ }
+ value = 0;
+ errorString = "hexadecimal";
+ if (cmd == 'H') {
+ for (offset = 0; offset < count; offset++) {
+ value <<= 4;
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
+ errorValue = str;
+ Tcl_DecrRefCount(resultPtr);
+ goto badValue;
}
- } else {
- for (offset = 0; offset < count; offset++) {
- value >>= 4;
-
- if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
- errorValue = str;
- goto badValue;
- }
- c = str[offset] - '0';
- if (c > 9) {
- c += ('0' - 'A') + 10;
- }
- if (c > 16) {
- c += ('A' - 'a');
- }
- value |= ((c << 4) & 0xf0);
- if (offset % 2) {
- *cursor++ = (unsigned char)(value & 0xff);
- value = 0;
- }
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
}
- }
- if (offset % 2) {
- if (cmd == 'H') {
- value <<= 4;
- } else {
- value >>= 4;
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= (c & 0xf);
+ if (offset % 2) {
+ *cursor++ = (char) value;
+ value = 0;
}
- *cursor++ = (unsigned char) value;
- }
-
- while (cursor < last) {
- *cursor++ = '\0';
}
- break;
- }
- case 'c':
- case 't':
- case 's':
- case 'S':
- case 'n':
- case 'i':
- case 'I':
- case 'm':
- case 'w':
- case 'W':
- case 'r':
- case 'R':
- case 'd':
- case 'q':
- case 'Q':
- case 'f': {
- int listc, i;
- Tcl_Obj **listv;
+ } else {
+ for (offset = 0; offset < count; offset++) {
+ value >>= 4;
- if (count == BINARY_NOCOUNT) {
- /*
- * Note that we are casting away the const-ness of objv,
- * but this is safe since we aren't going to modify the
- * array.
- */
-
- listv = (Tcl_Obj**)(objv + arg);
- listc = 1;
- count = 1;
- } else {
- Tcl_ListObjGetElements(interp, objv[arg], &listc, &listv);
- if (count == BINARY_ALL) {
- count = listc;
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
+ errorValue = str;
+ Tcl_DecrRefCount(resultPtr);
+ goto badValue;
}
- }
- arg++;
- for (i = 0; i < count; i++) {
- if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
- return TCL_ERROR;
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= ((c << 4) & 0xf0);
+ if (offset % 2) {
+ *cursor++ = UCHAR(value & 0xff);
+ value = 0;
}
}
- break;
}
- case 'x':
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- memset(cursor, 0, (size_t) count);
- cursor += count;
- break;
- case 'X':
- if (cursor > maxPos) {
- maxPos = cursor;
- }
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if ((count == BINARY_ALL) || (count > (cursor - buffer))) {
- cursor = buffer;
+ if (offset % 2) {
+ if (cmd == 'H') {
+ value <<= 4;
} else {
- cursor -= count;
- }
- break;
- case '@':
- if (cursor > maxPos) {
- maxPos = cursor;
+ value >>= 4;
}
+ *cursor++ = UCHAR(value);
+ }
+
+ while (cursor < last) {
+ *cursor++ = '\0';
+ }
+ break;
+ }
+ case 'c':
+ case 't':
+ case 's':
+ case 'S':
+ case 'n':
+ case 'i':
+ case 'I':
+ case 'm':
+ case 'w':
+ case 'W':
+ case 'r':
+ case 'R':
+ case 'd':
+ case 'q':
+ case 'Q':
+ case 'f': {
+ int listc, i;
+ Tcl_Obj **listv;
+
+ if (count == BINARY_NOCOUNT) {
+ /*
+ * Note that we are casting away the const-ness of objv, but
+ * this is safe since we aren't going to modify the array.
+ */
+
+ listv = (Tcl_Obj **) (objv + arg);
+ listc = 1;
+ count = 1;
+ } else {
+ TclListObjGetElements(interp, objv[arg], &listc, &listv);
if (count == BINARY_ALL) {
- cursor = maxPos;
- } else {
- cursor = buffer + count;
+ count = listc;
+ }
+ }
+ arg++;
+ for (i = 0; i < count; i++) {
+ if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ return TCL_ERROR;
}
- break;
}
+ break;
}
- Tcl_SetObjResult(interp, resultPtr);
- break;
- case BINARY_SCAN: {
- int i;
- Tcl_Obj *valuePtr, *elementPtr;
- Tcl_HashTable numberCacheHash;
- Tcl_HashTable *numberCachePtr;
-
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "value formatString ?varName varName ...?");
- return TCL_ERROR;
+ case 'x':
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ memset(cursor, 0, (size_t) count);
+ cursor += count;
+ break;
+ case 'X':
+ if (cursor > maxPos) {
+ maxPos = cursor;
+ }
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ if ((count == BINARY_ALL) || (count > (cursor - buffer))) {
+ cursor = buffer;
+ } else {
+ cursor -= count;
+ }
+ break;
+ case '@':
+ if (cursor > maxPos) {
+ maxPos = cursor;
+ }
+ if (count == BINARY_ALL) {
+ cursor = maxPos;
+ } else {
+ cursor = buffer + count;
+ }
+ break;
+ }
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+
+ badValue:
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected %s string but got \"%s\" instead",
+ errorString, errorValue));
+ return TCL_ERROR;
+
+ badCount:
+ errorString = "missing count for \"@\" field specifier";
+ goto error;
+
+ badIndex:
+ errorString = "not enough arguments for all format specifiers";
+ goto error;
+
+ badField:
+ {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX + 1];
+
+ Tcl_UtfToUniChar(errorString, &ch);
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad field specifier \"%s\"", buf));
+ return TCL_ERROR;
+ }
+
+ error:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryScanCmd --
+ *
+ * This procedure implements the "binary scan" Tcl command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+BinaryScanCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int arg; /* Index of next argument to consume. */
+ int value = 0; /* Current integer value to be packed.
+ * Initialized to avoid compiler warning. */
+ char cmd; /* Current format character. */
+ int count; /* Count associated with current format
+ * character. */
+ int flags; /* Format field flags */
+ const char *format; /* Pointer to current position in format
+ * string. */
+ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */
+ unsigned char *buffer; /* Start of result buffer. */
+ const char *errorString;
+ const char *str;
+ int offset, size, length;
+
+ int i;
+ Tcl_Obj *valuePtr, *elementPtr;
+ Tcl_HashTable numberCacheHash;
+ Tcl_HashTable *numberCachePtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "value formatString ?varName ...?");
+ return TCL_ERROR;
+ }
+ numberCachePtr = &numberCacheHash;
+ Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
+ buffer = Tcl_GetByteArrayFromObj(objv[1], &length);
+ format = TclGetString(objv[2]);
+ arg = 3;
+ offset = 0;
+ while (*format != '\0') {
+ str = format;
+ flags = 0;
+ if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+ goto done;
}
- numberCachePtr = &numberCacheHash;
- Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
- buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
- format = Tcl_GetString(objv[3]);
- cursor = buffer;
- arg = 4;
- offset = 0;
- while (*format != '\0') {
- str = format;
- if (!GetFormatSpec(&format, &cmd, &count)) {
- goto done;
- }
- switch (cmd) {
- case 'a':
- case 'A': {
- unsigned char *src;
-
- if (arg >= objc) {
- DeleteScanNumberCache(numberCachePtr);
- goto badIndex;
+ switch (cmd) {
+ case 'a':
+ case 'A': {
+ unsigned char *src;
+
+ if (arg >= objc) {
+ DeleteScanNumberCache(numberCachePtr);
+ goto badIndex;
+ }
+ if (count == BINARY_ALL) {
+ count = length - offset;
+ } else {
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
}
- if (count == BINARY_ALL) {
- count = length - offset;
- } else {
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if (count > (length - offset)) {
- goto done;
- }
+ if (count > (length - offset)) {
+ goto done;
}
+ }
- src = buffer + offset;
- size = count;
+ src = buffer + offset;
+ size = count;
- /*
- * Trim trailing nulls and spaces, if necessary.
- */
+ /*
+ * Trim trailing nulls and spaces, if necessary.
+ */
- if (cmd == 'A') {
- while (size > 0) {
- if (src[size-1] != '\0' && src[size-1] != ' ') {
- break;
- }
- size--;
+ if (cmd == 'A') {
+ while (size > 0) {
+ if (src[size-1] != '\0' && src[size-1] != ' ') {
+ break;
}
+ size--;
}
+ }
- /*
- * Have to do this #ifdef-fery because (as part of defining
- * Tcl_NewByteArrayObj) we removed the #def that hides this
- * stuff normally. If this code ever gets copied to another
- * file, it should be changed back to the simpler version.
- */
+ /*
+ * Have to do this #ifdef-fery because (as part of defining
+ * Tcl_NewByteArrayObj) we removed the #def that hides this stuff
+ * normally. If this code ever gets copied to another file, it
+ * should be changed back to the simpler version.
+ */
#ifdef TCL_MEM_DEBUG
- valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__);
+ valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__, __LINE__);
#else
- valuePtr = Tcl_NewByteArrayObj(src, size);
+ valuePtr = Tcl_NewByteArrayObj(src, size);
#endif /* TCL_MEM_DEBUG */
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- arg++;
- if (resultPtr == NULL) {
- DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
- return TCL_ERROR;
- }
- offset += count;
- break;
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
+ if (resultPtr == NULL) {
+ DeleteScanNumberCache(numberCachePtr);
+ return TCL_ERROR;
}
- case 'b':
- case 'B': {
- unsigned char *src;
- char *dest;
+ offset += count;
+ break;
+ }
+ case 'b':
+ case 'B': {
+ unsigned char *src;
+ char *dest;
- if (arg >= objc) {
- DeleteScanNumberCache(numberCachePtr);
- goto badIndex;
- }
- if (count == BINARY_ALL) {
- count = (length - offset) * 8;
- } else {
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if (count > (length - offset) * 8) {
- goto done;
- }
- }
- src = buffer + offset;
- valuePtr = Tcl_NewObj();
- Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetString(valuePtr);
-
- if (cmd == 'b') {
- for (i = 0; i < count; i++) {
- if (i % 8) {
- value >>= 1;
- } else {
- value = *src++;
- }
- *dest++ = (char) ((value & 1) ? '1' : '0');
- }
- } else {
- for (i = 0; i < count; i++) {
- if (i % 8) {
- value <<= 1;
- } else {
- value = *src++;
- }
- *dest++ = (char) ((value & 0x80) ? '1' : '0');
- }
+ if (arg >= objc) {
+ DeleteScanNumberCache(numberCachePtr);
+ goto badIndex;
+ }
+ if (count == BINARY_ALL) {
+ count = (length - offset) * 8;
+ } else {
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
}
-
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- arg++;
- if (resultPtr == NULL) {
- DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
- return TCL_ERROR;
+ if (count > (length - offset) * 8) {
+ goto done;
}
- offset += (count + 7 ) / 8;
- break;
}
- case 'h':
- case 'H': {
- char *dest;
- unsigned char *src;
- int i;
- static char hexdigit[] = "0123456789abcdef";
+ src = buffer + offset;
+ valuePtr = Tcl_NewObj();
+ Tcl_SetObjLength(valuePtr, count);
+ dest = TclGetString(valuePtr);
- if (arg >= objc) {
- DeleteScanNumberCache(numberCachePtr);
- goto badIndex;
- }
- if (count == BINARY_ALL) {
- count = (length - offset)*2;
- } else {
- if (count == BINARY_NOCOUNT) {
- count = 1;
- }
- if (count > (length - offset)*2) {
- goto done;
+ if (cmd == 'b') {
+ for (i = 0; i < count; i++) {
+ if (i % 8) {
+ value >>= 1;
+ } else {
+ value = *src++;
}
+ *dest++ = (char) ((value & 1) ? '1' : '0');
}
- src = buffer + offset;
- valuePtr = Tcl_NewObj();
- Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetString(valuePtr);
-
- if (cmd == 'h') {
- for (i = 0; i < count; i++) {
- if (i % 2) {
- value >>= 4;
- } else {
- value = *src++;
- }
- *dest++ = hexdigit[value & 0xf];
- }
- } else {
- for (i = 0; i < count; i++) {
- if (i % 2) {
- value <<= 4;
- } else {
- value = *src++;
- }
- *dest++ = hexdigit[(value >> 4) & 0xf];
+ } else {
+ for (i = 0; i < count; i++) {
+ if (i % 8) {
+ value <<= 1;
+ } else {
+ value = *src++;
}
+ *dest++ = (char) ((value & 0x80) ? '1' : '0');
}
+ }
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- arg++;
- if (resultPtr == NULL) {
- DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
- return TCL_ERROR;
- }
- offset += (count + 1) / 2;
- break;
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
+ if (resultPtr == NULL) {
+ DeleteScanNumberCache(numberCachePtr);
+ return TCL_ERROR;
}
- case 'c':
- size = 1;
- goto scanNumber;
- case 't':
- case 's':
- case 'S':
- size = 2;
- goto scanNumber;
- case 'n':
- case 'i':
- case 'I':
- size = 4;
- goto scanNumber;
- case 'm':
- case 'w':
- case 'W':
- size = 8;
- goto scanNumber;
- case 'r':
- case 'R':
- case 'f':
- size = sizeof(float);
- goto scanNumber;
- case 'q':
- case 'Q':
- case 'd': {
- unsigned char *src;
-
- size = sizeof(double);
- /* fall through */
-
- scanNumber:
- if (arg >= objc) {
- DeleteScanNumberCache(numberCachePtr);
- goto badIndex;
- }
- if (count == BINARY_NOCOUNT) {
- if ((length - offset) < size) {
- goto done;
- }
- valuePtr = ScanNumber(buffer+offset, cmd, &numberCachePtr);
- offset += size;
- } else {
- if (count == BINARY_ALL) {
- count = (length - offset) / size;
- }
- if ((length - offset) < (count * size)) {
- goto done;
- }
- valuePtr = Tcl_NewObj();
- src = buffer+offset;
- for (i = 0; i < count; i++) {
- elementPtr = ScanNumber(src, cmd, &numberCachePtr);
- src += size;
- Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
- }
- offset += count*size;
- }
+ offset += (count + 7) / 8;
+ break;
+ }
+ case 'h':
+ case 'H': {
+ char *dest;
+ unsigned char *src;
+ static const char hexdigit[] = "0123456789abcdef";
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- arg++;
- if (resultPtr == NULL) {
- DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
- return TCL_ERROR;
- }
- break;
+ if (arg >= objc) {
+ DeleteScanNumberCache(numberCachePtr);
+ goto badIndex;
}
- case 'x':
+ if (count == BINARY_ALL) {
+ count = (length - offset)*2;
+ } else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
- if ((count == BINARY_ALL) || (count > (length - offset))) {
- offset = length;
- } else {
- offset += count;
+ if (count > (length - offset)*2) {
+ goto done;
}
- break;
- case 'X':
- if (count == BINARY_NOCOUNT) {
- count = 1;
+ }
+ src = buffer + offset;
+ valuePtr = Tcl_NewObj();
+ Tcl_SetObjLength(valuePtr, count);
+ dest = TclGetString(valuePtr);
+
+ if (cmd == 'h') {
+ for (i = 0; i < count; i++) {
+ if (i % 2) {
+ value >>= 4;
+ } else {
+ value = *src++;
+ }
+ *dest++ = hexdigit[value & 0xf];
}
- if ((count == BINARY_ALL) || (count > offset)) {
- offset = 0;
- } else {
- offset -= count;
+ } else {
+ for (i = 0; i < count; i++) {
+ if (i % 2) {
+ value <<= 4;
+ } else {
+ value = *src++;
+ }
+ *dest++ = hexdigit[(value >> 4) & 0xf];
}
- break;
- case '@':
- if (count == BINARY_NOCOUNT) {
- DeleteScanNumberCache(numberCachePtr);
- goto badCount;
+ }
+
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
+ if (resultPtr == NULL) {
+ DeleteScanNumberCache(numberCachePtr);
+ return TCL_ERROR;
+ }
+ offset += (count + 1) / 2;
+ break;
+ }
+ case 'c':
+ size = 1;
+ goto scanNumber;
+ case 't':
+ case 's':
+ case 'S':
+ size = 2;
+ goto scanNumber;
+ case 'n':
+ case 'i':
+ case 'I':
+ size = 4;
+ goto scanNumber;
+ case 'm':
+ case 'w':
+ case 'W':
+ size = 8;
+ goto scanNumber;
+ case 'r':
+ case 'R':
+ case 'f':
+ size = sizeof(float);
+ goto scanNumber;
+ case 'q':
+ case 'Q':
+ case 'd': {
+ unsigned char *src;
+
+ size = sizeof(double);
+ /* fall through */
+
+ scanNumber:
+ if (arg >= objc) {
+ DeleteScanNumberCache(numberCachePtr);
+ goto badIndex;
+ }
+ if (count == BINARY_NOCOUNT) {
+ if ((length - offset) < size) {
+ goto done;
}
- if ((count == BINARY_ALL) || (count > length)) {
- offset = length;
- } else {
- offset = count;
+ valuePtr = ScanNumber(buffer+offset, cmd, flags,
+ &numberCachePtr);
+ offset += size;
+ } else {
+ if (count == BINARY_ALL) {
+ count = (length - offset) / size;
}
- break;
- default:
+ if ((length - offset) < (count * size)) {
+ goto done;
+ }
+ valuePtr = Tcl_NewObj();
+ src = buffer + offset;
+ for (i = 0; i < count; i++) {
+ elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr);
+ src += size;
+ Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
+ }
+ offset += count * size;
+ }
+
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
+ if (resultPtr == NULL) {
DeleteScanNumberCache(numberCachePtr);
- errorString = str;
- goto badField;
+ return TCL_ERROR;
}
+ break;
}
+ case 'x':
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ if ((count == BINARY_ALL) || (count > (length - offset))) {
+ offset = length;
+ } else {
+ offset += count;
+ }
+ break;
+ case 'X':
+ if (count == BINARY_NOCOUNT) {
+ count = 1;
+ }
+ if ((count == BINARY_ALL) || (count > offset)) {
+ offset = 0;
+ } else {
+ offset -= count;
+ }
+ break;
+ case '@':
+ if (count == BINARY_NOCOUNT) {
+ DeleteScanNumberCache(numberCachePtr);
+ goto badCount;
+ }
+ if ((count == BINARY_ALL) || (count > length)) {
+ offset = length;
+ } else {
+ offset = count;
+ }
+ break;
+ default:
+ DeleteScanNumberCache(numberCachePtr);
+ errorString = str;
+ goto badField;
+ }
+ }
- /*
- * Set the result to the last position of the cursor.
- */
+ /*
+ * Set the result to the last position of the cursor.
+ */
- done:
- Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
- DeleteScanNumberCache(numberCachePtr);
- break;
- }
- }
- return TCL_OK;
+ done:
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3));
+ DeleteScanNumberCache(numberCachePtr);
- badValue:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected ", errorString,
- " string but got \"", errorValue, "\" instead", NULL);
- return TCL_ERROR;
+ return TCL_OK;
- badCount:
+ badCount:
errorString = "missing count for \"@\" field specifier";
goto error;
- badIndex:
+ badIndex:
errorString = "not enough arguments for all format specifiers";
goto error;
- badField:
+ badField:
{
Tcl_UniChar ch;
char buf[TCL_UTF_MAX + 1];
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);
+ error:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -1363,9 +1605,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*
* Results:
* Moves the formatPtr to the start of the next command. Returns the
- * current command character and count in cmdPtr and countPtr. The count
+ * current command character and count in cmdPtr and countPtr. The count
* is set to BINARY_ALL if the count character was '*' or BINARY_NOCOUNT
- * if no count was specified. Returns 1 on success, or 0 if the string
+ * if no count was specified. Returns 1 on success, or 0 if the string
* did not have a format specifier.
*
* Side effects:
@@ -1375,10 +1617,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*/
static int
-GetFormatSpec(formatPtr, cmdPtr, countPtr)
- char **formatPtr; /* Pointer to format string. */
- char *cmdPtr; /* Pointer to location of command char. */
- int *countPtr; /* Pointer to repeat count value. */
+GetFormatSpec(
+ const char **formatPtr, /* Pointer to format string. */
+ char *cmdPtr, /* Pointer to location of command char. */
+ int *countPtr, /* Pointer to repeat count value. */
+ int *flagsPtr) /* Pointer to field flags */
{
/*
* Skip any leading blanks.
@@ -1402,13 +1645,17 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
*cmdPtr = **formatPtr;
(*formatPtr)++;
+ if (**formatPtr == 'u') {
+ (*formatPtr)++;
+ *flagsPtr |= BINARY_UNSIGNED;
+ }
if (**formatPtr == '*') {
(*formatPtr)++;
- (*countPtr) = BINARY_ALL;
+ *countPtr = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
- (*countPtr) = strtoul(*formatPtr, formatPtr, 10);
+ *countPtr = strtoul(*formatPtr, (char **) formatPtr, 10);
} else {
- (*countPtr) = BINARY_NOCOUNT;
+ *countPtr = BINARY_NOCOUNT;
}
return 1;
}
@@ -1418,17 +1665,21 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
*
* NeedReversing --
*
- * This routine determines, if bytes of a number need to be reversed.
+ * This routine determines, if bytes of a number need to be re-ordered,
+ * and returns a numeric code indicating the re-ordering to be done.
* This depends on the endiannes of the machine and the desired format.
* It is in effect a table (whose contents depend on the endianness of
- * the system) describing whether a value needs reversing or not. Anyone
+ * the system) describing whether a value needs reversing or not. Anyone
* porting the code to a big-endian platform should take care to make
* sure that they define WORDS_BIGENDIAN though this is already done by
* configure for the Unix build; little-endian platforms (including
* Windows) don't need to do anything.
*
* Results:
- * 1 if reversion is required, 0 if not.
+ * 0 No re-ordering needed.
+ * 1 Reverse the bytes: 01234567 <-> 76543210 (little to big)
+ * 2 Apply this re-ordering: 01234567 <-> 45670123 (Nokia to little)
+ * 3 Apply this re-ordering: 01234567 <-> 32107654 (Nokia to big)
*
* Side effects:
* None
@@ -1437,8 +1688,8 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
*/
static int
-NeedReversing(format)
- int format;
+NeedReversing(
+ int format)
{
switch (format) {
/* native floats and doubles: never reverse */
@@ -1453,12 +1704,11 @@ NeedReversing(format)
case 'n':
case 't':
case 'm':
- /* f+d: reverse if we're little-endian */
+ /* f: reverse if we're little-endian */
case 'Q':
case 'R':
#else /* !WORDS_BIGENDIAN */
/* small endian floats: reverse if we're big-endian */
- case 'q':
case 'r':
#endif /* WORDS_BIGENDIAN */
return 0;
@@ -1472,8 +1722,7 @@ NeedReversing(format)
case 'n':
case 't':
case 'm':
- /* f+d: reverse if we're little-endian */
- case 'Q':
+ /* f: reverse if we're little-endian */
case 'R':
#endif /* WORDS_BIGENDIAN */
/* small endian ints: always reverse */
@@ -1481,9 +1730,28 @@ NeedReversing(format)
case 's':
case 'w':
return 1;
+
+#ifndef WORDS_BIGENDIAN
+ /*
+ * The Q and q formats need special handling to account for the unusual
+ * byte ordering of 8-byte floats on Nokia 770 systems, which claim to be
+ * little-endian, but also reverse word order.
+ */
+
+ case 'Q':
+ if (TclNokia770Doubles()) {
+ return 3;
+ }
+ return 1;
+ case 'q':
+ if (TclNokia770Doubles()) {
+ return 2;
+ }
+ return 0;
+#endif
}
- Tcl_Panic("unexpected fall-through");
+ Tcl_Panic("unexpected fallthrough");
return 0;
}
@@ -1493,7 +1761,7 @@ NeedReversing(format)
* CopyNumber --
*
* This routine is called by FormatNumber and ScanNumber to copy a
- * floating-point number. If required, bytes are reversed while copying.
+ * floating-point number. If required, bytes are reversed while copying.
* The behaviour is only fully defined when used with IEEE float and
* double values (guaranteed to be 4 and 8 bytes long, respectively.)
*
@@ -1507,15 +1775,19 @@ NeedReversing(format)
*/
static void
-CopyNumber(from, to, length, type)
- CONST void *from; /* source */
- void *to; /* destination */
- unsigned int length; /* Number of bytes to copy */
- int type; /* What type of thing are we copying? */
+CopyNumber(
+ const void *from, /* source */
+ void *to, /* destination */
+ unsigned length, /* Number of bytes to copy */
+ int type) /* What type of thing are we copying? */
{
- if (NeedReversing(type)) {
- CONST unsigned char *fromPtr = (CONST unsigned char *) from;
- unsigned char *toPtr = (unsigned char *) to;
+ switch (NeedReversing(type)) {
+ case 0:
+ memcpy(to, from, length);
+ break;
+ case 1: {
+ const unsigned char *fromPtr = from;
+ unsigned char *toPtr = to;
switch (length) {
case 4:
@@ -1535,8 +1807,36 @@ CopyNumber(from, to, length, type)
toPtr[7] = fromPtr[0];
break;
}
- } else {
- memcpy(to, from, length);
+ break;
+ }
+ case 2: {
+ const unsigned char *fromPtr = from;
+ unsigned char *toPtr = to;
+
+ toPtr[0] = fromPtr[4];
+ toPtr[1] = fromPtr[5];
+ toPtr[2] = fromPtr[6];
+ toPtr[3] = fromPtr[7];
+ toPtr[4] = fromPtr[0];
+ toPtr[5] = fromPtr[1];
+ toPtr[6] = fromPtr[2];
+ toPtr[7] = fromPtr[3];
+ break;
+ }
+ case 3: {
+ const unsigned char *fromPtr = from;
+ unsigned char *toPtr = to;
+
+ toPtr[0] = fromPtr[3];
+ toPtr[1] = fromPtr[2];
+ toPtr[2] = fromPtr[1];
+ toPtr[3] = fromPtr[0];
+ toPtr[4] = fromPtr[7];
+ toPtr[5] = fromPtr[6];
+ toPtr[6] = fromPtr[5];
+ toPtr[7] = fromPtr[4];
+ break;
+ }
}
}
@@ -1558,12 +1858,12 @@ CopyNumber(from, to, length, type)
*/
static int
-FormatNumber(interp, type, src, cursorPtr)
- Tcl_Interp *interp; /* Current interpreter, used to report
+FormatNumber(
+ Tcl_Interp *interp, /* Current interpreter, used to report
* errors. */
- int type; /* Type of number to format. */
- Tcl_Obj *src; /* Number to format. */
- unsigned char **cursorPtr; /* Pointer to index into destination buffer. */
+ int type, /* Type of number to format. */
+ Tcl_Obj *src, /* Number to format. */
+ unsigned char **cursorPtr) /* Pointer to index into destination buffer. */
{
long value;
double dvalue;
@@ -1575,13 +1875,13 @@ FormatNumber(interp, type, src, cursorPtr)
case 'q':
case 'Q':
/*
- * Double-precision floating point values. Tcl_GetDoubleFromObj
+ * Double-precision floating point values. Tcl_GetDoubleFromObj
* returns TCL_ERROR for NaN, but we can check by comparing the
* object's type pointer.
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if ( src->typePtr != &tclDoubleType ) {
+ if (src->typePtr != &tclDoubleType) {
return TCL_ERROR;
}
dvalue = src->internalRep.doubleValue;
@@ -1594,13 +1894,13 @@ FormatNumber(interp, type, src, cursorPtr)
case 'r':
case 'R':
/*
- * Single-precision floating point values. Tcl_GetDoubleFromObj
+ * Single-precision floating point values. Tcl_GetDoubleFromObj
* returns TCL_ERROR for NaN, but we can check by comparing the
* object's type pointer.
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if ( src->typePtr != &tclDoubleType ) {
+ if (src->typePtr != &tclDoubleType) {
return TCL_ERROR;
}
dvalue = src->internalRep.doubleValue;
@@ -1631,23 +1931,23 @@ FormatNumber(interp, type, src, cursorPtr)
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = (unsigned char) wvalue;
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
+ *(*cursorPtr)++ = UCHAR(wvalue);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 32);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 40);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 48);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 56);
} else {
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
- *(*cursorPtr)++ = (unsigned char) wvalue;
+ *(*cursorPtr)++ = UCHAR(wvalue >> 56);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 48);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 40);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 32);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
}
return TCL_OK;
@@ -1657,19 +1957,19 @@ FormatNumber(interp, type, src, cursorPtr)
case 'i':
case 'I':
case 'n':
- if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = (unsigned char) value;
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) (value >> 16);
- *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(value >> 8);
+ *(*cursorPtr)++ = UCHAR(value >> 16);
+ *(*cursorPtr)++ = UCHAR(value >> 24);
} else {
- *(*cursorPtr)++ = (unsigned char) (value >> 24);
- *(*cursorPtr)++ = (unsigned char) (value >> 16);
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = UCHAR(value >> 24);
+ *(*cursorPtr)++ = UCHAR(value >> 16);
+ *(*cursorPtr)++ = UCHAR(value >> 8);
+ *(*cursorPtr)++ = UCHAR(value);
}
return TCL_OK;
@@ -1679,15 +1979,15 @@ FormatNumber(interp, type, src, cursorPtr)
case 's':
case 'S':
case 't':
- if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = (unsigned char) value;
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(value >> 8);
} else {
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = UCHAR(value >> 8);
+ *(*cursorPtr)++ = UCHAR(value);
}
return TCL_OK;
@@ -1695,10 +1995,10 @@ FormatNumber(interp, type, src, cursorPtr)
* 8-bit integer values.
*/
case 'c':
- if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
- *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = UCHAR(value);
return TCL_OK;
default:
@@ -1712,26 +2012,27 @@ FormatNumber(interp, type, src, cursorPtr)
*
* ScanNumber --
*
- * This routine is called by Tcl_BinaryObjCmd to scan a number
- * out of a buffer.
+ * This routine is called by Tcl_BinaryObjCmd to scan a number out of a
+ * buffer.
*
* Results:
- * Returns a newly created object containing the scanned number.
- * This object has a ref count of zero.
+ * Returns a newly created object containing the scanned number. This
+ * object has a ref count of zero.
*
* Side effects:
- * Might reuse an object in the number cache, place a new object
- * in the cache, or delete the cache and set the reference to
- * it (itself passed in by reference) to NULL.
+ * Might reuse an object in the number cache, place a new object in the
+ * cache, or delete the cache and set the reference to it (itself passed
+ * in by reference) to NULL.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
-ScanNumber(buffer, type, numberCachePtrPtr)
- unsigned char *buffer; /* Buffer to scan number from. */
- int type; /* Format character from "binary scan" */
- Tcl_HashTable **numberCachePtrPtr;
+ScanNumber(
+ unsigned char *buffer, /* Buffer to scan number from. */
+ int type, /* Format character from "binary scan" */
+ int flags, /* Format field flags */
+ Tcl_HashTable **numberCachePtrPtr)
/* Place to look for cache of scanned
* value objects, or NULL if too many
* different numbers have been scanned. */
@@ -1744,29 +2045,31 @@ ScanNumber(buffer, type, numberCachePtrPtr)
/*
* We cannot rely on the compiler to properly sign extend integer values
* when we cast from smaller values to larger values because we don't know
- * the exact size of the integer types. So, we have to handle sign
+ * the exact size of the integer types. So, we have to handle sign
* extension explicitly by checking the high bit and padding with 1's as
- * needed.
+ * needed. This practice is disabled if the BINARY_UNSIGNED flag is set.
*/
switch (type) {
case 'c':
/*
- * Characters need special handling. We want to produce a signed
+ * Characters need special handling. We want to produce a signed
* result, but on some platforms (such as AIX) chars are unsigned. To
* deal with this, check for a value that should be negative but
* isn't.
*/
value = buffer[0];
- if (value & 0x80) {
- value |= -0x100;
+ if (!(flags & BINARY_UNSIGNED)) {
+ if (value & 0x80) {
+ value |= -0x100;
+ }
}
goto returnNumericObject;
/*
- * 16-bit numeric values. We need the sign extension trick (see
- * above) here as well.
+ * 16-bit numeric values. We need the sign extension trick (see above)
+ * here as well.
*/
case 's':
@@ -1777,8 +2080,10 @@ ScanNumber(buffer, type, numberCachePtrPtr)
} else {
value = (long) (buffer[1] + (buffer[0] << 8));
}
- if (value & 0x8000) {
- value |= -0x10000;
+ if (!(flags & BINARY_UNSIGNED)) {
+ if (value & 0x8000) {
+ value |= -0x10000;
+ }
}
goto returnNumericObject;
@@ -1793,26 +2098,30 @@ ScanNumber(buffer, type, numberCachePtrPtr)
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
- + (buffer[3] << 24));
+ + (((long)buffer[3]) << 24));
} else {
value = (long) (buffer[3]
+ (buffer[2] << 8)
+ (buffer[1] << 16)
- + (buffer[0] << 24));
+ + (((long) buffer[0]) << 24));
}
/*
* Check to see if the value was sign extended properly on systems
* where an int is more than 32-bits.
+ * We avoid caching unsigned integers as we cannot distinguish between
+ * 32bit signed and unsigned in the hash (short and char are ok).
*/
- if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
- value -= (((unsigned int)1)<<31);
- value -= (((unsigned int)1)<<31);
+ if (flags & BINARY_UNSIGNED) {
+ return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
+ }
+ if ((value & (((unsigned) 1)<<31)) && (value > 0)) {
+ value -= (((unsigned) 1)<<31);
+ value -= (((unsigned) 1)<<31);
}
returnNumericObject:
-
if (*numberCachePtrPtr == NULL) {
return Tcl_NewLongObj(value);
} else {
@@ -1820,31 +2129,30 @@ ScanNumber(buffer, type, numberCachePtrPtr)
register Tcl_HashEntry *hPtr;
int isNew;
- hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
+ hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
if (!isNew) {
- return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
- if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
-
- /*
- * We've overflowed the cache! Someone's parsing a LOT of
- * varied binary data in a single call! Bail out by switching
- * back to the old behaviour for the rest of the scan.
- *
- * Note that anyone just using the 'c' conversion (for bytes)
- * cannot trigger this.
- */
-
- DeleteScanNumberCache(tablePtr);
- *numberCachePtrPtr = NULL;
- return Tcl_NewLongObj(value);
- } else {
+ if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
Tcl_IncrRefCount(objPtr);
- Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+ Tcl_SetHashValue(hPtr, objPtr);
return objPtr;
}
+
+ /*
+ * We've overflowed the cache! Someone's parsing a LOT of varied
+ * binary data in a single call! Bail out by switching back to the
+ * old behaviour for the rest of the scan.
+ *
+ * Note that anyone just using the 'c' conversion (for bytes)
+ * cannot trigger this.
+ */
+
+ DeleteScanNumberCache(tablePtr);
+ *numberCachePtrPtr = NULL;
+ return Tcl_NewLongObj(value);
}
/*
@@ -1874,6 +2182,14 @@ ScanNumber(buffer, type, numberCachePtrPtr)
| (((Tcl_WideUInt) buffer[1]) << 48)
| (((Tcl_WideUInt) buffer[0]) << 56);
}
+ if (flags & BINARY_UNSIGNED) {
+ Tcl_Obj *bigObj = NULL;
+ mp_int big;
+
+ TclBNInitBignumFromWideUInt(&big, uwvalue);
+ bigObj = Tcl_NewBignumObj(&big);
+ return bigObj;
+ }
return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
/*
@@ -1922,10 +2238,11 @@ ScanNumber(buffer, type, numberCachePtrPtr)
*/
static void
-DeleteScanNumberCache(numberCachePtr)
- Tcl_HashTable *numberCachePtr; /* Pointer to the hash table, or NULL
- * (when the cache has already been
- * deleted due to overflow.) */
+DeleteScanNumberCache(
+ Tcl_HashTable *numberCachePtr)
+ /* Pointer to the hash table, or NULL (when
+ * the cache has already been deleted due to
+ * overflow.) */
{
Tcl_HashEntry *hEntry;
Tcl_HashSearch search;
@@ -1936,7 +2253,7 @@ DeleteScanNumberCache(numberCachePtr)
hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
while (hEntry != NULL) {
- register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry);
+ register Tcl_Obj *value = Tcl_GetHashValue(hEntry);
if (value != NULL) {
Tcl_DecrRefCount(value);
@@ -1947,9 +2264,725 @@ DeleteScanNumberCache(numberCachePtr)
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * NOTES --
+ *
+ * Some measurements show that it is faster to use a table to to perform
+ * uuencode and base64 value encoding than to calculate the output (at
+ * least on intel P4 arch).
+ *
+ * Conversely using a lookup table for the decoding is slower than just
+ * calculating the values. We therefore use the fastest of each method.
+ *
+ * Presumably this has to do with the size of the tables. The base64
+ * decode table is 255 bytes while the encode table is only 65 bytes. The
+ * choice likely depends on CPU memory cache sizes.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryEncodeHex --
+ *
+ * Implement the [binary encode hex] binary encoding. clientData must be
+ * a table to convert values to hexadecimal digits.
+ *
+ * Results:
+ * Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryEncodeHex(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj = NULL;
+ unsigned char *data = NULL;
+ unsigned char *cursor = NULL;
+ int offset = 0, count = 0;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+
+ TclNewObj(resultObj);
+ data = Tcl_GetByteArrayFromObj(objv[1], &count);
+ cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
+ for (offset = 0; offset < count; ++offset) {
+ *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
+ *cursor++ = HexDigits[(data[offset] & 0x0f)];
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryDecodeHex --
+ *
+ * Implement the [binary decode hex] binary encoding.
+ *
+ * Results:
+ * Interp result set to an decoded byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryDecodeHex(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj = NULL;
+ unsigned char *data, *datastart, *dataend;
+ unsigned char *begin, *cursor, c;
+ int i, index, value, size, count = 0, cut = 0, strict = 0;
+ enum {OPT_STRICT };
+ static const char *const optStrings[] = { "-strict", NULL };
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; ++i) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_STRICT:
+ strict = 1;
+ break;
+ }
+ }
+
+ TclNewObj(resultObj);
+ datastart = data = (unsigned char *)
+ TclGetStringFromObj(objv[objc-1], &count);
+ dataend = data + count;
+ size = (count + 1) / 2;
+ begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
+ while (data < dataend) {
+ value = 0;
+ for (i=0 ; i<2 ; i++) {
+ if (data >= dataend) {
+ value <<= 4;
+ break;
+ }
+
+ c = *data++;
+ if (!isxdigit((int) c)) {
+ if (strict || !isspace(c)) {
+ goto badChar;
+ }
+ i--;
+ continue;
+ }
+
+ value <<= 4;
+ c -= '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= (c & 0xf);
+ }
+ if (i < 2) {
+ cut++;
+ }
+ *cursor++ = UCHAR(value);
+ value = 0;
+ }
+ if (cut > size) {
+ cut = size;
+ }
+ Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+
+ badChar:
+ TclDecrRefCount(resultObj);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid hexadecimal digit \"%c\" at position %d",
+ c, (int) (data - datastart - 1)));
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryEncode64 --
+ *
+ * This implements a generic 6 bit binary encoding. Input is broken into
+ * 6 bit chunks and a lookup table passed in via clientData is used to
+ * turn these values into output characters. This is used to implement
+ * base64 binary encodings.
+ *
+ * Results:
+ * Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define OUTPUT(c) \
+ do { \
+ *cursor++ = (c); \
+ outindex++; \
+ if (maxlen > 0 && cursor != limit) { \
+ if (outindex == maxlen) { \
+ memcpy(cursor, wrapchar, wrapcharlen); \
+ cursor += wrapcharlen; \
+ outindex = 0; \
+ } \
+ } \
+ if (cursor > limit) { \
+ Tcl_Panic("limit hit"); \
+ } \
+ } while (0)
+
+static int
+BinaryEncode64(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj;
+ unsigned char *data, *cursor, *limit;
+ int maxlen = 0;
+ const char *wrapchar = "\n";
+ int wrapcharlen = 1;
+ int offset, i, index, size, outindex = 0, count = 0;
+ enum {OPT_MAXLEN, OPT_WRAPCHAR };
+ static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
+
+ if (objc < 2 || objc%2 != 0) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-maxlen len? ?-wrapchar char? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_MAXLEN:
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (maxlen < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "line length out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+ "LINE_LENGTH", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ case OPT_WRAPCHAR:
+ wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
+ if (wrapcharlen == 0) {
+ maxlen = 0;
+ }
+ break;
+ }
+ }
+
+ resultObj = Tcl_NewObj();
+ data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+ if (count > 0) {
+ size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
+ if (maxlen > 0 && size > maxlen) {
+ int adjusted = size + (wrapcharlen * (size / maxlen));
+
+ if (size % maxlen == 0) {
+ adjusted -= wrapcharlen;
+ }
+ size = adjusted;
+ }
+ cursor = Tcl_SetByteArrayLength(resultObj, size);
+ limit = cursor + size;
+ for (offset = 0; offset < count; offset+=3) {
+ unsigned char d[3] = {0, 0, 0};
+
+ for (i = 0; i < 3 && offset+i < count; ++i) {
+ d[i] = data[offset + i];
+ }
+ OUTPUT(B64Digits[d[0] >> 2]);
+ OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
+ if (offset+1 < count) {
+ OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
+ } else {
+ OUTPUT(B64Digits[64]);
+ }
+ if (offset+2 < count) {
+ OUTPUT(B64Digits[d[2] & 0x3f]);
+ } else {
+ OUTPUT(B64Digits[64]);
+ }
+ }
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+#undef OUTPUT
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryEncodeUu --
+ *
+ * This implements the uuencode binary encoding. Input is broken into 6
+ * bit chunks and a lookup table is used to turn these values into output
+ * characters. This differs from the generic code above in that line
+ * lengths are also encoded.
+ *
+ * Results:
+ * Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryEncodeUu(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj;
+ unsigned char *data, *start, *cursor;
+ int offset, count, rawLength, n, i, j, bits, index;
+ int lineLength = 61;
+ const unsigned char SingleNewline[] = { (unsigned char) '\n' };
+ const unsigned char *wrapchar = SingleNewline;
+ int wrapcharlen = sizeof(SingleNewline);
+ enum { OPT_MAXLEN, OPT_WRAPCHAR };
+ static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
+
+ if (objc < 2 || objc%2 != 0) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-maxlen len? ?-wrapchar char? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_MAXLEN:
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (lineLength < 3 || lineLength > 85) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "line length out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+ "LINE_LENGTH", NULL);
+ return TCL_ERROR;
+ }
+ break;
+ case OPT_WRAPCHAR:
+ wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
+ break;
+ }
+ }
+
+ /*
+ * Allocate the buffer. This is a little bit too long, but is "good
+ * enough".
+ */
+
+ resultObj = Tcl_NewObj();
+ offset = 0;
+ data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+ rawLength = (lineLength - 1) * 3 / 4;
+ start = cursor = Tcl_SetByteArrayLength(resultObj,
+ (lineLength + wrapcharlen) *
+ ((count + (rawLength - 1)) / rawLength));
+ n = bits = 0;
+
+ /*
+ * Encode the data. Each output line first has the length of raw data
+ * encoded by the output line described in it by one encoded byte, then
+ * the encoded data follows (encoding each 6 bits as one character).
+ * Encoded lines are always terminated by a newline.
+ */
+
+ while (offset < count) {
+ int lineLen = count - offset;
+
+ if (lineLen > rawLength) {
+ lineLen = rawLength;
+ }
+ *cursor++ = UueDigits[lineLen];
+ for (i=0 ; i<lineLen ; i++) {
+ n <<= 8;
+ n |= data[offset++];
+ for (bits += 8; bits > 6 ; bits -= 6) {
+ *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
+ }
+ }
+ if (bits > 0) {
+ n <<= 8;
+ *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
+ bits = 0;
+ }
+ for (j=0 ; j<wrapcharlen ; ++j) {
+ *cursor++ = wrapchar[j];
+ }
+ }
+
+ /*
+ * Fix the length of the output bytearray.
+ */
+
+ Tcl_SetByteArrayLength(resultObj, cursor-start);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryDecodeUu --
+ *
+ * Decode a uuencoded string.
+ *
+ * Results:
+ * Interp result set to an byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryDecodeUu(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj = NULL;
+ unsigned char *data, *datastart, *dataend;
+ unsigned char *begin, *cursor;
+ int i, index, size, count = 0, strict = 0, lineLen;
+ unsigned char c;
+ enum {OPT_STRICT };
+ static const char *const optStrings[] = { "-strict", NULL };
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; ++i) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_STRICT:
+ strict = 1;
+ break;
+ }
+ }
+
+ TclNewObj(resultObj);
+ datastart = data = (unsigned char *)
+ TclGetStringFromObj(objv[objc-1], &count);
+ dataend = data + count;
+ size = ((count + 3) & ~3) * 3 / 4;
+ begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
+ lineLen = -1;
+
+ /*
+ * The decoding loop. First, we get the length of line (strictly, the
+ * number of data bytes we expect to generate from the line) we're
+ * processing this time round if it is not already known (i.e., when the
+ * lineLen variable is set to the magic value, -1).
+ */
+
+ while (data < dataend) {
+ char d[4] = {0, 0, 0, 0};
+
+ if (lineLen < 0) {
+ c = *data++;
+ if (c < 32 || c > 96) {
+ if (strict || !isspace(c)) {
+ goto badUu;
+ }
+ i--;
+ continue;
+ }
+ lineLen = (c - 32) & 0x3f;
+ }
+
+ /*
+ * Now we read a four-character grouping.
+ */
+
+ for (i=0 ; i<4 ; i++) {
+ if (data < dataend) {
+ d[i] = c = *data++;
+ if (c < 32 || c > 96) {
+ if (strict) {
+ if (!isspace(c)) {
+ goto badUu;
+ } else if (c == '\n') {
+ goto shortUu;
+ }
+ }
+ i--;
+ continue;
+ }
+ }
+ }
+
+ /*
+ * Translate that grouping into (up to) three binary bytes output.
+ */
+
+ if (lineLen > 0) {
+ *cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
+ | (((d[1] - 0x20) & 0x3f) >> 4);
+ if (--lineLen > 0) {
+ *cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
+ | (((d[2] - 0x20) & 0x3f) >> 2);
+ if (--lineLen > 0) {
+ *cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
+ | (((d[3] - 0x20) & 0x3f));
+ lineLen--;
+ }
+ }
+ }
+
+ /*
+ * If we've reached the end of the line, skip until we process a
+ * newline.
+ */
+
+ if (lineLen == 0 && data < dataend) {
+ lineLen = -1;
+ do {
+ c = *data++;
+ if (c == '\n') {
+ break;
+ } else if (c >= 32 && c <= 96) {
+ data--;
+ break;
+ } else if (strict || !isspace(c)) {
+ goto badUu;
+ }
+ } while (data < dataend);
+ }
+ }
+
+ /*
+ * Sanity check, clean up and finish.
+ */
+
+ if (lineLen > 0 && strict) {
+ goto shortUu;
+ }
+ Tcl_SetByteArrayLength(resultObj, cursor - begin);
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+
+ shortUu:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
+ TclDecrRefCount(resultObj);
+ return TCL_ERROR;
+
+ badUu:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid uuencode character \"%c\" at position %d",
+ c, (int) (data - datastart - 1)));
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
+ TclDecrRefCount(resultObj);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryDecode64 --
+ *
+ * Decode a base64 encoded string.
+ *
+ * Results:
+ * Interp result set to an byte array object
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryDecode64(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *resultObj = NULL;
+ 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 };
+ static const char *const optStrings[] = { "-strict", NULL };
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
+ return TCL_ERROR;
+ }
+ for (i = 1; i < objc-1; ++i) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case OPT_STRICT:
+ strict = 1;
+ break;
+ }
+ }
+
+ TclNewObj(resultObj);
+ datastart = data = (unsigned char *)
+ TclGetStringFromObj(objv[objc-1], &count);
+ dataend = data + count;
+ size = ((count + 3) & ~3) * 3 / 4;
+ begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
+ while (data < dataend) {
+ unsigned long value = 0;
+
+ /*
+ * 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;
+ }
+
+ /*
+ * 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 {
+ goto bad64;
+ }
+ } 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);
+
+ /*
+ * 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);
+ return TCL_OK;
+
+ bad64:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid base64 character \"%c\" at position %d",
+ (char) c, (int) (data - datastart - 1)));
+ TclDecrRefCount(resultObj);
+ return TCL_ERROR;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index e3eea4e..70e64f0 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.25 2005/09/15 16:40:02 dgp 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
- * needed for actual tag. This must be the
+ 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). */
@@ -54,7 +58,7 @@ struct mem_header {
struct mem_header *blink;
MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
- CONST char *file;
+ const char *file;
long length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
@@ -78,32 +82,32 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
/*
* The following macro computes the offset of the "body" field within
- * mem_header. It is used to get back to the header pointer from the body
+ * mem_header. It is used to get back to the header pointer from the body
* pointer that's used by clients.
*/
#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;
-static int current_bytes_malloced = 0;
-static int maximum_bytes_malloced = 0;
+static size_t current_bytes_malloced = 0;
+static size_t maximum_bytes_malloced = 0;
static int current_malloc_packets = 0;
static int maximum_malloc_packets = 0;
static int break_on_malloc = 0;
static int trace_on_at_malloc = 0;
-static int alloc_tracing = FALSE;
-static int init_malloced_bodies = TRUE;
+static int alloc_tracing = FALSE;
+static int init_malloced_bodies = TRUE;
#ifdef MEM_VALIDATE
- static int validate_memory = TRUE;
+static int validate_memory = TRUE;
#else
- static int validate_memory = FALSE;
+static int validate_memory = FALSE;
#endif
/*
* The following variable indicates to TclFinalizeMemorySubsystem() that it
- * should dump out the state of memory before exiting. If the value is
+ * should dump out the state of memory before exiting. If the value is
* non-NULL, it gives the name of the file in which to dump memory usage
* information.
*/
@@ -115,8 +119,8 @@ static char dumpFile[100]; /* Records where to dump memory allocation
* information. */
/*
- * Mutex to serialize allocations. This is a low-level mutex that must be
- * explicitly initialized. This is necessary because the self initializing
+ * Mutex to serialize allocations. This is a low-level mutex that must be
+ * explicitly initialized. This is necessary because the self initializing
* mutexes use ckalloc...
*/
@@ -127,20 +131,19 @@ static int ckallocInit = 0;
* Prototypes for procedures defined in this file:
*/
-static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char *argv[]));
-static int MemoryCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static void ValidateMemory _ANSI_ARGS_((
- struct mem_header *memHeaderP, CONST char *file,
- int line, int nukeGuards));
+static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, const char *argv[]);
+static int MemoryCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, const char *argv[]);
+static void ValidateMemory(struct mem_header *memHeaderP,
+ const char *file, int line, int nukeGuards);
/*
*----------------------------------------------------------------------
*
* TclInitDbCkalloc --
*
- * Initialize the locks used by the allocator. This is only appropriate
+ * Initialize the locks used by the allocator. This is only appropriate
* to call in a single threaded environment, such as during
* TclInitSubsystems.
*
@@ -148,11 +151,15 @@ static void ValidateMemory _ANSI_ARGS_((
*/
void
-TclInitDbCkalloc()
+TclInitDbCkalloc(void)
{
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
+#ifndef TCL_THREADS
+ /* Silence compiler warning */
+ (void)ckallocMutexPtr;
+#endif
}
}
@@ -166,22 +173,36 @@ TclInitDbCkalloc()
*----------------------------------------------------------------------
*/
-void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+int
+TclDumpMemoryInfo(
+ 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 %10d\n",
- current_bytes_malloced);
- fprintf(outFile,"maximum packets allocated %10d\n",
- maximum_malloc_packets);
- fprintf(outFile,"maximum bytes allocated %10d\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;
}
/*
@@ -202,18 +223,19 @@ TclDumpMemoryInfo(outFile)
*/
static void
-ValidateMemory(memHeaderP, file, line, nukeGuards)
- struct mem_header *memHeaderP; /* Memory chunk to validate */
- CONST char *file; /* File containing the call to
- * Tcl_ValidateAllMemory */
- int line; /* Line number of call to
- * Tcl_ValidateAllMemory */
- int nukeGuards; /* If non-zero, indicates that the
- * memory guards are to be reset to 0
- * after they have been printed */
+ValidateMemory(
+ struct mem_header *memHeaderP,
+ /* Memory chunk to validate */
+ const char *file, /* File containing the call to
+ * Tcl_ValidateAllMemory */
+ int line, /* Line number of call to
+ * Tcl_ValidateAllMemory */
+ int nukeGuards) /* If non-zero, indicates that the memory
+ * guards are to be reset to 0 after they have
+ * been printed */
{
unsigned char *hiPtr;
- int idx;
+ size_t idx;
int guard_failed = FALSE;
int byte;
@@ -223,15 +245,15 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
guard_failed = TRUE;
fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte,
+ fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
if (guard_failed) {
- TclDumpMemoryInfo (stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "low guard failed at %lx, %s %d\n",
- (long unsigned int) memHeaderP->body, file, line);
- fflush(stderr); /* In case name pointer is bad. */
+ (long unsigned) memHeaderP->body, file, line);
+ fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
@@ -244,16 +266,16 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
guard_failed = TRUE;
fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte,
+ fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
if (guard_failed) {
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "high guard failed at %lx, %s %d\n",
- (long unsigned int) memHeaderP->body, file, line);
- fflush(stderr); /* In case name pointer is bad. */
+ (long unsigned) memHeaderP->body, file, line);
+ fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
@@ -261,8 +283,8 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
}
if (nukeGuards) {
- memset((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
- memset((char *) hiPtr, 0, HIGH_GUARD_SIZE);
+ memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+ memset(hiPtr, 0, HIGH_GUARD_SIZE);
}
}
@@ -284,10 +306,10 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
*/
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file; /* File from which Tcl_ValidateAllMemory was
+Tcl_ValidateAllMemory(
+ const char *file, /* File from which Tcl_ValidateAllMemory was
* called. */
- int line; /* Line number of call to
+ int line) /* Line number of call to
* Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
@@ -318,8 +340,8 @@ Tcl_ValidateAllMemory(file, line)
*/
int
-Tcl_DumpActiveMemory (fileName)
- CONST char *fileName; /* Name of the file to write info to */
+Tcl_DumpActiveMemory(
+ const char *fileName) /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
@@ -336,10 +358,10 @@ Tcl_DumpActiveMemory (fileName)
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
- address = &memScanP->body [0];
+ address = &memScanP->body[0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
- (long unsigned int) address,
- (long unsigned int) address + memScanP->length - 1,
+ (long unsigned) address,
+ (long unsigned) address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
@@ -371,22 +393,25 @@ Tcl_DumpActiveMemory (fileName)
*/
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ unsigned int size,
+ const char *file,
+ int line)
{
- struct mem_header *result;
+ struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ /* Don't let size argument to TclpAlloc overflow */
+ if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
+ sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ }
if (result == NULL) {
fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
@@ -397,10 +422,10 @@ Tcl_DbCkalloc(size, file, line)
*/
if (init_malloced_bodies) {
- memset((VOID *) result, GUARD_VALUE,
+ memset(result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
- memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+ memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
@@ -440,11 +465,7 @@ Tcl_DbCkalloc(size, file, line)
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++;
@@ -460,24 +481,27 @@ Tcl_DbCkalloc(size, file, line)
return result->body;
}
-
+
char *
-Tcl_AttemptDbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ unsigned int size,
+ const char *file,
+ int line)
{
- struct mem_header *result;
+ struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ /* Don't let size argument to TclpAlloc overflow */
+ if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
+ sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ }
if (result == NULL) {
fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
return NULL;
}
@@ -487,10 +511,10 @@ Tcl_AttemptDbCkalloc(size, file, line)
* allocated list.
*/
if (init_malloced_bodies) {
- memset((VOID *) result, GUARD_VALUE,
+ memset(result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
- memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+ memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
@@ -530,11 +554,7 @@ Tcl_AttemptDbCkalloc(size, file, line)
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++;
@@ -569,16 +589,16 @@ Tcl_AttemptDbCkalloc(size, file, line)
*----------------------------------------------------------------------
*/
-int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+void
+Tcl_DbCkfree(
+ char *ptr,
+ const char *file,
+ int line)
{
struct mem_header *memp;
if (ptr == NULL) {
- return 0;
+ return;
}
/*
@@ -589,7 +609,7 @@ Tcl_DbCkfree(ptr, file, line)
* 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",
@@ -603,7 +623,7 @@ Tcl_DbCkfree(ptr, file, line)
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
- memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
+ memset(ptr, GUARD_VALUE, (size_t) memp->length);
}
total_frees++;
@@ -632,8 +652,6 @@ Tcl_DbCkfree(ptr, file, line)
}
TclpFree((char *) memp);
Tcl_MutexUnlock(ckallocMutexPtr);
-
- return 0;
}
/*
@@ -650,13 +668,13 @@ Tcl_DbCkfree(ptr, file, line)
*/
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ const char *file,
+ int line)
{
- char *new;
+ char *newPtr;
unsigned int copySize;
struct mem_header *memp;
@@ -668,26 +686,26 @@ Tcl_DbCkrealloc(ptr, size, file, line)
* 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) {
copySize = memp->length;
}
- new = Tcl_DbCkalloc(size, file, line);
- memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+ newPtr = Tcl_DbCkalloc(size, file, line);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return new;
+ return newPtr;
}
-
+
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ const char *file,
+ int line)
{
- char *new;
+ char *newPtr;
unsigned int copySize;
struct mem_header *memp;
@@ -699,19 +717,19 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
* 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) {
copySize = memp->length;
}
- new = Tcl_AttemptDbCkalloc(size, file, line);
- if (new == NULL) {
+ newPtr = Tcl_AttemptDbCkalloc(size, file, line);
+ if (newPtr == NULL) {
return NULL;
}
- memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return new;
+ return newPtr;
}
@@ -732,44 +750,38 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*----------------------------------------------------------------------
*/
-#undef Tcl_Alloc
-#undef Tcl_Free
-#undef Tcl_Realloc
-#undef Tcl_AttemptAlloc
-#undef Tcl_AttemptRealloc
-
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
return Tcl_DbCkalloc(size, "unknown", 0);
}
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}
void
-Tcl_Free(ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
Tcl_DbCkfree(ptr, "unknown", 0);
}
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}
@@ -798,37 +810,40 @@ Tcl_AttemptRealloc(ptr, size)
*/
/* ARGSUSED */
static int
-MemoryCmd(clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- CONST char **argv;
+MemoryCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int argc,
+ const char *argv[])
{
- CONST char *fileName;
+ const char *fileName;
+ FILE *fileP;
Tcl_DString buffer;
int result;
+ size_t len;
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option [args..]\"", (char *) 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\"", (char *) 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);
if (fileName == NULL) {
return TCL_ERROR;
}
- result = Tcl_DumpActiveMemory (fileName);
+ result = Tcl_DumpActiveMemory(fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
+ argv[2], Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
@@ -843,27 +858,48 @@ MemoryCmd(clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%-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);
- Tcl_SetObjResult(interp, objPtr);
+ "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 (argc != 3) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s objs file\"", argv[0]));
+ return TCL_ERROR;
+ }
+ fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ fileP = fopen(fileName, "w");
+ if (fileP == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot open output file: %s",
+ Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ TclDbDumpActiveObjects(fileP);
+ fclose(fileP);
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+ }
if (strcmp(argv[1],"onexit") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " onexit file\"", (char *) 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);
@@ -877,16 +913,17 @@ MemoryCmd(clientData, interp, argc, argv)
}
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " tag string\"", (char *) 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) {
@@ -914,19 +951,20 @@ MemoryCmd(clientData, interp, argc, argv)
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", (char *) 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\"", (char *) 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\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
return TCL_ERROR;
}
@@ -949,15 +987,15 @@ MemoryCmd(clientData, interp, argc, argv)
*/
static int
-CheckmemCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for evaluation. */
- int argc; /* Number of arguments. */
- CONST char *argv[]; /* String values of arguments. */
+CheckmemCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter for evaluation. */
+ int argc, /* Number of arguments. */
+ const char *argv[]) /* String values of arguments. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s fileName\"", argv[0]));
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
@@ -982,14 +1020,13 @@ CheckmemCmd(clientData, interp, argc, argv)
*/
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp; /* Interpreter in which commands should be added */
+Tcl_InitMemory(
+ Tcl_Interp *interp) /* Interpreter in which commands should be
+ * added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
}
@@ -1014,8 +1051,8 @@ Tcl_InitMemory(interp)
*/
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
char *result;
@@ -1023,7 +1060,7 @@ Tcl_Alloc(size)
/*
* Most systems will not alloc(0), instead bumping it to one so that NULL
- * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
+ * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
* NULL, so we have to check that the NULL we get is not in response to
* alloc(0).
*
@@ -1038,10 +1075,10 @@ Tcl_Alloc(size)
}
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ unsigned int size,
+ const char *file,
+ int line)
{
char *result;
@@ -1066,8 +1103,8 @@ Tcl_DbCkalloc(size, file, line)
*/
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
char *result;
@@ -1076,10 +1113,10 @@ Tcl_AttemptAlloc(size)
}
char *
-Tcl_AttemptDbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ unsigned int size,
+ const char *file,
+ int line)
{
char *result;
@@ -1099,9 +1136,9 @@ Tcl_AttemptDbCkalloc(size, file, line)
*/
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1114,11 +1151,11 @@ Tcl_Realloc(ptr, size)
}
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ const char *file,
+ int line)
{
char *result;
@@ -1143,9 +1180,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)
*/
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1154,11 +1191,11 @@ Tcl_AttemptRealloc(ptr, size)
}
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ const char *file,
+ int line)
{
char *result;
@@ -1179,20 +1216,19 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*/
void
-Tcl_Free(ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
TclpFree(ptr);
}
-int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+void
+Tcl_DbCkfree(
+ char *ptr,
+ const char *file,
+ int line)
{
TclpFree(ptr);
- return 0;
}
/*
@@ -1207,29 +1243,31 @@ Tcl_DbCkfree(ptr, file, line)
*/
/* ARGSUSED */
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp;
+Tcl_InitMemory(
+ Tcl_Interp *interp)
{
}
int
-Tcl_DumpActiveMemory(fileName)
- CONST char *fileName;
+Tcl_DumpActiveMemory(
+ const char *fileName)
{
return TCL_OK;
}
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file;
- int line;
+Tcl_ValidateAllMemory(
+ const char *file,
+ int line)
{
}
-void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+int
+TclDumpMemoryInfo(
+ ClientData clientData,
+ int flags)
{
+ return 1;
}
#endif /* TCL_MEM_DEBUG */
@@ -1254,7 +1292,7 @@ TclDumpMemoryInfo(outFile)
*/
void
-TclFinalizeMemorySubsystem()
+TclFinalizeMemorySubsystem(void)
{
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
@@ -1284,5 +1322,7 @@ TclFinalizeMemorySubsystem()
* 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 9134ab4..15f29e5 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1,40 +1,136 @@
-/*
+/*
* tclClock.c --
*
- * Contains the time and date related commands. This code
- * is derived from the time and date facilities of TclX,
- * by Mark Diekhans and Karl Lehenbauer.
+ * Contains the time and date related commands. This code is derived from
+ * the time and date facilities of TclX, by Mark Diekhans and Karl
+ * Lehenbauer.
*
* Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995 Sun Microsystems, Inc.
- * 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.
+ * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
*
- * RCS: @(#) $Id: tclClock.c,v 1.40 2005/08/12 23:55:28 kennykb 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"
/*
- * Windows has mktime. The configurators do not check.
+ * Windows has mktime. The configurators do not check.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
/*
- * Thread specific data block holding a 'struct tm' for the 'gmtime'
- * and 'localtime' library calls.
+ * Constants
+ */
+
+#define JULIAN_DAY_POSIX_EPOCH 2440588
+#define SECONDS_PER_DAY 86400
+#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
+ * SECONDS_PER_DAY)
+#define FOUR_CENTURIES 146097 /* days */
+#define JDAY_1_JAN_1_CE_JULIAN 1721424
+#define JDAY_1_JAN_1_CE_GREGORIAN 1721426
+#define ONE_CENTURY_GREGORIAN 36524 /* days */
+#define FOUR_YEARS 1461 /* days */
+#define ONE_YEAR 365 /* days */
+
+/*
+ * Table of the days in each month, leap and common years
+ */
+
+static const int hath[2][12] = {
+ {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
+ {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
+};
+static const int daysInPriorMonths[2][13] = {
+ {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365},
+ {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}
+};
+
+/*
+ * Enumeration of the string literals used in [clock]
+ */
+
+typedef enum ClockLiteral {
+ LIT__NIL,
+ LIT__DEFAULT_FORMAT,
+ LIT_BCE, LIT_C,
+ LIT_CANNOT_USE_GMT_AND_TIMEZONE,
+ LIT_CE,
+ LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR,
+ LIT_ERA, LIT_GMT, LIT_GREGORIAN,
+ LIT_INTEGER_VALUE_TOO_LARGE,
+ LIT_ISO8601WEEK, LIT_ISO8601YEAR,
+ LIT_JULIANDAY, LIT_LOCALSECONDS,
+ LIT_MONTH,
+ LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET,
+ LIT_YEAR,
+ LIT__END
+} ClockLiteral;
+static const char *const literals[] = {
+ "",
+ "%a %b %d %H:%M:%S %Z %Y",
+ "BCE", "C",
+ "cannot use -gmt and -timezone in same call",
+ "CE",
+ "dayOfMonth", "dayOfWeek", "dayOfYear",
+ "era", ":GMT", "gregorian",
+ "integer value too large to represent",
+ "iso8601Week", "iso8601Year",
+ "julianDay", "localSeconds",
+ "month",
+ "seconds", "tzName", "tzOffset",
+ "year"
+};
+
+/*
+ * Structure containing the client data for [clock]
+ */
+
+typedef struct ClockClientData {
+ int refCount; /* Number of live references. */
+ Tcl_Obj **literals; /* Pool of object literals. */
+} ClockClientData;
+
+/*
+ * Structure containing the fields used in [clock format] and [clock scan]
+ */
+
+typedef struct TclDateFields {
+ Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
+ * epoch */
+ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
+ * from the Posix epoch */
+ int tzOffset; /* Time zone offset in seconds east of
+ * Greenwich */
+ Tcl_Obj *tzName; /* Time zone name */
+ int julianDay; /* Julian Day Number in local time zone */
+ enum {BCE=1, CE=0} era; /* Era */
+ int gregorian; /* Flag == 1 if the date is Gregorian */
+ int year; /* Year of the era */
+ int dayOfYear; /* Day of the year (1 January == 1) */
+ int month; /* Month number */
+ int dayOfMonth; /* Day of the month */
+ int iso8601Year; /* ISO8601 week-based year */
+ int iso8601Week; /* ISO8601 week number */
+ int dayOfWeek; /* Day of the week */
+} TclDateFields;
+static const char *const eras[] = { "CE", "BCE", NULL };
+
+/*
+ * Thread specific data block holding a 'struct tm' for the 'gmtime' and
+ * 'localtime' library calls.
*/
static Tcl_ThreadDataKey tmKey;
/*
- * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls
- * and the statics in the date parsing code.
+ * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
+ * in the date parsing code.
*/
TCL_DECLARE_MUTEX(clockMutex)
@@ -43,318 +139,1534 @@ TCL_DECLARE_MUTEX(clockMutex)
* Function prototypes for local procedures in this file:
*/
-static struct tm* ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* ));
-static void TzsetIfNecessary _ANSI_ARGS_(( void ));
+static int ConvertUTCToLocal(Tcl_Interp *,
+ TclDateFields *, Tcl_Obj *, int);
+static int ConvertUTCToLocalUsingTable(Tcl_Interp *,
+ TclDateFields *, int, Tcl_Obj *const[]);
+static int ConvertUTCToLocalUsingC(Tcl_Interp *,
+ TclDateFields *, int);
+static int ConvertLocalToUTC(Tcl_Interp *,
+ TclDateFields *, Tcl_Obj *, int);
+static int ConvertLocalToUTCUsingTable(Tcl_Interp *,
+ TclDateFields *, int, Tcl_Obj *const[]);
+static int ConvertLocalToUTCUsingC(Tcl_Interp *,
+ TclDateFields *, int);
+static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
+ int, Tcl_Obj *const *);
+static void GetYearWeekDay(TclDateFields *, int);
+static void GetGregorianEraYearDay(TclDateFields *, int);
+static void GetMonthDay(TclDateFields *);
+static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
+static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
+static int IsGregorianLeapYear(TclDateFields *);
+static int WeekdayOnOrBefore(int, int);
+static int ClockClicksObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockConvertlocaltoutcObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockGetdatefieldsObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockGetjuliandayfromerayearmonthdayObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockGetjuliandayfromerayearweekdayObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockGetenvObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockMicrosecondsObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockMillisecondsObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockParseformatargsObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockSecondsObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static struct tm * ThreadSafeLocalTime(const time_t *);
+static void TzsetIfNecessary(void);
+static void ClockDeleteCmdProc(ClientData);
+
+/*
+ * Structure containing description of "native" clock commands to create.
+ */
+
+struct ClockCommand {
+ const char *name; /* The tail of the command name. The full name
+ * is "::tcl::clock::<name>". When NULL marks
+ * the end of the table. */
+ Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This
+ * will always have the ClockClientData sent
+ * to it, but may well ignore this data. */
+};
+
+static const struct ClockCommand clockCommands[] = {
+ { "clicks", ClockClicksObjCmd },
+ { "getenv", ClockGetenvObjCmd },
+ { "microseconds", ClockMicrosecondsObjCmd },
+ { "milliseconds", ClockMillisecondsObjCmd },
+ { "seconds", ClockSecondsObjCmd },
+ { "Oldscan", TclClockOldscanObjCmd },
+ { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
+ { "GetDateFields", ClockGetdatefieldsObjCmd },
+ { "GetJulianDayFromEraYearMonthDay",
+ ClockGetjuliandayfromerayearmonthdayObjCmd },
+ { "GetJulianDayFromEraYearWeekDay",
+ ClockGetjuliandayfromerayearweekdayObjCmd },
+ { "ParseFormatArgs", ClockParseformatargsObjCmd },
+ { NULL, NULL }
+};
/*
*----------------------------------------------------------------------
*
- * TclClockGetenvObjCmd --
+ * TclClockInit --
*
- * Tcl command that reads an environment variable from the system
+ * Registers the 'clock' subcommands with the Tcl interpreter and
+ * initializes its client data (which consists mostly of constant
+ * Tcl_Obj's that it is too much trouble to keep recreating).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Installs the commands and creates the client data
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclClockInit(
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ const struct ClockCommand *clockCmdPtr;
+ char cmdName[50]; /* Buffer large enough to hold the string
+ *::tcl::clock::GetJulianDayFromEraYearMonthDay
+ * plus a terminating NUL. */
+ ClockClientData *data;
+ int i;
+
+ /*
+ * Safe interps get [::clock] as alias to a master, so do not need their
+ * own copies of the support routines.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ return;
+ }
+
+ /*
+ * Create the client data, which is a refcounted literal pool.
+ */
+
+ data = ckalloc(sizeof(ClockClientData));
+ data->refCount = 0;
+ 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]);
+ }
+
+ /*
+ * Install the commands.
+ */
+
+#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++;
+ Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
+ ClockDeleteCmdProc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockConvertlocaltoutcObjCmd --
+ *
+ * Tcl command that converts a UTC time to a local time by whatever means
+ * is available.
*
* Usage:
- * ::tcl::clock::getEnv NAME
+ * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover
*
* Parameters:
- * NAME - Name of the environment variable desired
+ * dict - Dictionary containing a 'localSeconds' entry.
+ * tzdata - Time zone data
+ * changeover - Julian Day of the adoption of the Gregorian calendar.
*
* Results:
- * Returns a standard Tcl result. Returns an error if the
- * variable does not exist, with a message left in the interpreter.
- * Returns TCL_OK and the value of the variable if the variable
- * does exist,
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * On success, sets the interpreter result to the given dictionary
+ * augmented with a 'seconds' field giving the UTC time. On failure,
+ * leaves an error message in the interpreter result.
*
*----------------------------------------------------------------------
*/
-int
-TclClockGetenvObjCmd( ClientData clientData,
- Tcl_Interp* interp,
- int objc,
- Tcl_Obj *CONST objv[] )
+static int
+ClockConvertlocaltoutcObjCmd(
+ ClientData clientData, /* Client data */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter vector */
{
+ ClockClientData *data = clientData;
+ Tcl_Obj *const *literals = data->literals;
+ Tcl_Obj *secondsObj;
+ Tcl_Obj *dict;
+ int changeover;
+ TclDateFields fields;
+ int created = 0;
+ int status;
- CONST char* varName;
- CONST char* varValue;
- if ( objc != 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "name" );
+ /*
+ * Check params and convert time.
+ */
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover");
return TCL_ERROR;
}
- varName = Tcl_GetStringFromObj( objv[1], NULL );
- varValue = getenv( varName );
- if ( varValue == NULL ) {
- Tcl_SetObjResult( interp,
- Tcl_NewStringObj( "variable not found", -1 ) );
+ dict = objv[1];
+ if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
+ &secondsObj)!= TCL_OK) {
return TCL_ERROR;
- } else {
- Tcl_SetObjResult( interp, Tcl_NewStringObj( varValue, -1 ) );
- return TCL_OK;
}
+ if (secondsObj == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
+ "found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetWideIntFromObj(interp, secondsObj,
+ &fields.localSeconds) != TCL_OK)
+ || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
+ || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Copy-on-write; set the 'seconds' field in the dictionary and place the
+ * modified dictionary in the interpreter result.
+ */
+
+ if (Tcl_IsShared(dict)) {
+ dict = Tcl_DuplicateObj(dict);
+ created = 1;
+ Tcl_IncrRefCount(dict);
+ }
+ status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS],
+ Tcl_NewWideIntObj(fields.seconds));
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, dict);
+ }
+ if (created) {
+ Tcl_DecrRefCount(dict);
+ }
+ return status;
}
/*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclClockLocaltimeObjCmd --
+ * ClockGetdatefieldsObjCmd --
*
- * Tcl command that extracts local time using the C library to do
- * it.
+ * Tcl command that determines the values that [clock format] will use in
+ * formatting a date, and populates a dictionary with them.
*
* Usage:
- * ::tcl::clock::Localtime <tick>
+ * ::tcl::clock::GetDateFields seconds tzdata changeover
*
* Parameters:
- * <tick> -- A count of seconds from the Posix epoch.
+ * seconds - Time expressed in seconds from the Posix epoch.
+ * tzdata - Time zone data of the time zone in which time is to be
+ * expressed.
+ * changeover - Julian Day Number at which the current locale adopted
+ * the Gregorian calendar
*
* Results:
- * Returns a standard Tcl result. The object result is a Tcl
- * list containing the year, month, day, hour, minute, and second
- * fields of the local time. It may return an error if the
- * argument exceeds the arithmetic range representable by
- * 'time_t'.
- *
- * Side effects:
- * None.
+ * Returns a dictonary populated with the fields:
+ * seconds - Seconds from the Posix epoch
+ * localSeconds - Nominal seconds from the Posix epoch in the
+ * local time zone.
+ * tzOffset - Time zone offset in seconds east of Greenwich
+ * tzName - Time zone name
+ * julianDay - Julian Day Number in the local time zone
*
- * This function is used as a call of last resort if the current time
- * zone cannot be determined from environment variables TZ or TCL_TZ.
- * It attempts to use the 'localtime' library function to extract the
- * time and return it that way. This method suffers from Y2038 problems
- * on most platforms. It also provides no portable way to get the
- * name of the time zone.
- *
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
-TclClockLocaltimeObjCmd( ClientData clientData,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Parameter count */
- Tcl_Obj* CONST* objv )
- /* Parameter vector */
+ClockGetdatefieldsObjCmd(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter vector */
{
- Tcl_WideInt tick; /* Time to convert */
- time_t tock;
- struct tm* timeVal; /* Time after conversion */
+ TclDateFields fields;
+ Tcl_Obj *dict;
+ ClockClientData *data = clientData;
+ Tcl_Obj *const *literals = data->literals;
+ int changeover;
- Tcl_Obj* returnVec[ 6 ];
-
- /* Check args */
+ /*
+ * Check params.
+ */
- if ( objc != 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "seconds" );
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
return TCL_ERROR;
}
- if ( Tcl_GetWideIntFromObj( interp, objv[1], &tick ) != TCL_OK ) {
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
+ || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
return TCL_ERROR;
}
- /* Convert the time, checking for overflow */
+ /*
+ * fields.seconds could be an unsigned number that overflowed. Make sure
+ * that it isn't.
+ */
- tock = (time_t) tick;
- if ( (Tcl_WideInt) tock != tick ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj("number too large to represent as a Posix time",
- -1) );
- Tcl_SetErrorCode( interp, "CLOCK", "argTooLarge", (char*) NULL );
+ if (objv[1]->typePtr == &tclBignumType) {
+ Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
- TzsetIfNecessary();
- timeVal = ThreadSafeLocalTime( &tock );
- if ( timeVal == NULL ) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("localtime failed (clock "
- "value may be too large/"
- "small to represent)", -1));
- Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char*) NULL);
+
+ /*
+ * Convert UTC time to local.
+ */
+
+ if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
return TCL_ERROR;
}
- /* Package the results */
+ /*
+ * Extract Julian day.
+ */
+
+ fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH)
+ / SECONDS_PER_DAY);
+
+ /*
+ * Convert to Julian or Gregorian calendar.
+ */
+
+ GetGregorianEraYearDay(&fields, changeover);
+ GetMonthDay(&fields);
+ GetYearWeekDay(&fields, changeover);
+
+ dict = Tcl_NewDictObj();
+ Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
+ Tcl_NewWideIntObj(fields.localSeconds));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
+ Tcl_NewWideIntObj(fields.seconds));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
+ Tcl_DecrRefCount(fields.tzName);
+ Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
+ Tcl_NewIntObj(fields.tzOffset));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
+ Tcl_NewIntObj(fields.julianDay));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
+ Tcl_NewIntObj(fields.gregorian));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
+ literals[fields.era ? LIT_BCE : LIT_CE]);
+ Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
+ Tcl_NewIntObj(fields.year));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
+ Tcl_NewIntObj(fields.dayOfYear));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
+ Tcl_NewIntObj(fields.month));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
+ Tcl_NewIntObj(fields.dayOfMonth));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR],
+ Tcl_NewIntObj(fields.iso8601Year));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
+ Tcl_NewIntObj(fields.iso8601Week));
+ Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
+ Tcl_NewIntObj(fields.dayOfWeek));
+ Tcl_SetObjResult(interp, dict);
- returnVec[0] = Tcl_NewIntObj( timeVal->tm_year + 1900 );
- returnVec[1] = Tcl_NewIntObj( timeVal->tm_mon + 1);
- returnVec[2] = Tcl_NewIntObj( timeVal->tm_mday );
- returnVec[3] = Tcl_NewIntObj( timeVal->tm_hour );
- returnVec[4] = Tcl_NewIntObj( timeVal->tm_min );
- returnVec[5] = Tcl_NewIntObj( timeVal->tm_sec );
- Tcl_SetObjResult( interp, Tcl_NewListObj( 6, returnVec ) );
return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetjuliandayfromerayearmonthdayObjCmd --
+ *
+ * Tcl command that converts a time from era-year-month-day to a Julian
+ * Day Number.
+ *
+ * Parameters:
+ * dict - Dictionary that contains 'era', 'year', 'month' and
+ * 'dayOfMonth' keys.
+ * changeover - Julian Day of changeover to the Gregorian calendar
+ *
+ * Results:
+ * Result is either TCL_OK, with the interpreter result being the
+ * dictionary augmented with a 'julianDay' key, or TCL_ERROR,
+ * with the result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearmonthdayObjCmd(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter vector */
+{
+ TclDateFields fields;
+ Tcl_Obj *dict;
+ ClockClientData *data = clientData;
+ Tcl_Obj *const *literals = data->literals;
+ Tcl_Obj *fieldPtr;
+ int changeover;
+ int copied = 0;
+ int status;
+ int era = 0;
+
+ /*
+ * Check params.
+ */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+ return TCL_ERROR;
+ }
+ dict = objv[1];
+ if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+ &era) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
+ || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ fields.era = era;
+
+ /*
+ * Get Julian day.
+ */
+
+ GetJulianDayFromEraYearMonthDay(&fields, changeover);
+
+ /*
+ * Store Julian day in the dictionary - copy on write.
+ */
+
+ if (Tcl_IsShared(dict)) {
+ dict = Tcl_DuplicateObj(dict);
+ Tcl_IncrRefCount(dict);
+ copied = 1;
+ }
+ status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+ Tcl_NewIntObj(fields.julianDay));
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, dict);
+ }
+ if (copied) {
+ Tcl_DecrRefCount(dict);
+ }
+ return status;
}
/*
*----------------------------------------------------------------------
*
- * ThreadSafeLocalTime --
+ * ClockGetjuliandayfromerayearweekdayObjCmd --
*
- * Wrapper around the 'localtime' library function to make it thread
- * safe.
+ * Tcl command that converts a time from the ISO calendar to a Julian Day
+ * Number.
+ *
+ * Parameters:
+ * dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week'
+ * and 'dayOfWeek' keys.
+ * changeover - Julian Day of changeover to the Gregorian calendar
*
* Results:
- * Returns a pointer to a 'struct tm' in thread-specific data.
+ * Result is either TCL_OK, with the interpreter result being the
+ * dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the
+ * result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearweekdayObjCmd(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter vector */
+{
+ TclDateFields fields;
+ Tcl_Obj *dict;
+ ClockClientData *data = clientData;
+ Tcl_Obj *const *literals = data->literals;
+ Tcl_Obj *fieldPtr;
+ int changeover;
+ int copied = 0;
+ int status;
+ int era = 0;
+
+ /*
+ * Check params.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+ return TCL_ERROR;
+ }
+ dict = objv[1];
+ if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+ &era) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
+ || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ fields.era = era;
+
+ /*
+ * Get Julian day.
+ */
+
+ GetJulianDayFromEraYearWeekDay(&fields, changeover);
+
+ /*
+ * Store Julian day in the dictionary - copy on write.
+ */
+
+ if (Tcl_IsShared(dict)) {
+ dict = Tcl_DuplicateObj(dict);
+ Tcl_IncrRefCount(dict);
+ copied = 1;
+ }
+ status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+ Tcl_NewIntObj(fields.julianDay));
+ if (status == TCL_OK) {
+ Tcl_SetObjResult(interp, dict);
+ }
+ if (copied) {
+ Tcl_DecrRefCount(dict);
+ }
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertLocalToUTC --
+ *
+ * Converts a time (in a TclDateFields structure) from the local wall
+ * clock to UTC.
+ *
+ * Results:
+ * Returns a standard Tcl result.
*
* Side effects:
- * Invokes localtime or localtime_r as appropriate.
+ * Populates the 'seconds' field if successful; stores an error message
+ * in the interpreter result on failure.
*
*----------------------------------------------------------------------
*/
-static struct tm *
-ThreadSafeLocalTime(timePtr)
- CONST time_t *timePtr; /* Pointer to the number of seconds since the
- * local system's epoch */
+static int
+ConvertLocalToUTC(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Fields of the time */
+ Tcl_Obj *tzdata, /* Time zone data */
+ int changeover) /* Julian Day of the Gregorian transition */
{
+ int rowc; /* Number of rows in tzdata */
+ Tcl_Obj **rowv; /* Pointers to the rows */
+
/*
- * Get a thread-local buffer to hold the returned time.
+ * Unpack the tz data.
*/
- struct tm *tmPtr = (struct tm *)
- Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
-#ifdef HAVE_LOCALTIME_R
- localtime_r(timePtr, tmPtr);
-#else
- struct tm *sysTmPtr;
+ if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
+ return TCL_ERROR;
+ }
- Tcl_MutexLock(&clockMutex);
- sysTmPtr = localtime(timePtr);
- if (sysTmPtr == NULL) {
- Tcl_MutexUnlock(&clockMutex);
- return NULL;
+ /*
+ * Special case: If the time zone is :localtime, the tzdata will be empty.
+ * Use 'mktime' to convert the time to local
+ */
+
+ if (rowc == 0) {
+ return ConvertLocalToUTCUsingC(interp, fields, changeover);
} else {
- memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm));
- Tcl_MutexUnlock(&clockMutex);
+ return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv);
}
-#endif
- return tmPtr;
}
/*
*----------------------------------------------------------------------
*
- * TclClockMktimeObjCmd --
+ * ConvertLocalToUTCUsingTable --
*
- * Determine seconds from the epoch, given the fields of a local
- * time.
+ * Converts a time (in a TclDateFields structure) from local time in a
+ * given time zone to UTC.
*
- * Usage:
- * mktime <year> <month> <day> <hour> <minute> <second>
+ * Results:
+ * Returns a standard Tcl result.
*
- * Parameters:
- * year -- Calendar year
- * month -- Calendar month
- * day -- Calendar day
- * hour -- Hour of day (00-23)
- * minute -- Minute of hour
- * second -- Second of minute
+ * Side effects:
+ * Stores an error message in the interpreter if an error occurs; if
+ * successful, stores the 'seconds' field in 'fields.
*
- * Results:
- * Returns the given local time.
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertLocalToUTCUsingTable(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
+ int rowc, /* Number of points at which time changes */
+ Tcl_Obj *const rowv[]) /* Points at which time changes */
+{
+ Tcl_Obj *row;
+ int cellc;
+ Tcl_Obj **cellv;
+ int have[8];
+ int nHave = 0;
+ int i;
+ int found;
+
+ /*
+ * Perform an initial lookup assuming that local == UTC, and locate the
+ * last time conversion prior to that time. Get the offset from that row,
+ * and look up again. Continue until we find an offset that we found
+ * before. This definition, rather than "the same offset" ensures that we
+ * don't enter an endless loop, as would otherwise happen when trying to
+ * convert a non-existent time such as 02:30 during the US Spring Daylight
+ * Saving Time transition.
+ */
+
+ found = 0;
+ fields->tzOffset = 0;
+ fields->seconds = fields->localSeconds;
+ while (!found) {
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ if ((row == NULL)
+ || TclListObjGetElements(interp, row, &cellc,
+ &cellv) != TCL_OK
+ || TclGetIntFromObj(interp, cellv[1],
+ &fields->tzOffset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ found = 0;
+ for (i = 0; !found && i < nHave; ++i) {
+ if (have[i] == fields->tzOffset) {
+ found = 1;
+ break;
+ }
+ }
+ if (!found) {
+ if (nHave == 8) {
+ Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
+ }
+ have[nHave++] = fields->tzOffset;
+ }
+ fields->seconds = fields->localSeconds - fields->tzOffset;
+ }
+ fields->tzOffset = have[i];
+ fields->seconds = fields->localSeconds - fields->tzOffset;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertLocalToUTCUsingC --
+ *
+ * Converts a time from local wall clock to UTC when the local time zone
+ * cannot be determined. Uses 'mktime' to do the job.
*
- * Errors:
- * Returns an error if the 'mktime' function does not exist in the
- * C library, or if the given time cannot be converted.
+ * Results:
+ * Returns a standard Tcl result.
*
* Side effects:
- * None.
+ * Stores an error message in the interpreter if an error occurs; if
+ * successful, stores the 'seconds' field in 'fields.
*
*----------------------------------------------------------------------
*/
-int
-TclClockMktimeObjCmd( ClientData clientData,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Parameter count */
- Tcl_Obj* CONST* objv )
- /* Parameter vector */
+static int
+ConvertLocalToUTCUsingC(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
+ int changeover) /* Julian Day of the Gregorian transition */
{
-#ifndef HAVE_MKTIME
- Tcl_SetObjResult( interp,
- Tcl_NewStringObj( "cannot determine local time", -1 ) );
- return TCL_ERROR;
-#else
-
- int i;
- struct tm toConvert; /* Time to be converted */
- time_t convertedTime; /* Time converted from mktime */
+ struct tm timeVal;
int localErrno;
+ int secondOfDay;
+ Tcl_WideInt jsec;
- /* Convert parameters */
+ /*
+ * Convert the given time to a date.
+ */
- if ( objc != 7 ) {
- Tcl_WrongNumArgs( interp, 1, objv,
- "year month day hour minute second" );
- return TCL_ERROR;
+ jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH;
+ fields->julianDay = (int) (jsec / SECONDS_PER_DAY);
+ secondOfDay = (int)(jsec % SECONDS_PER_DAY);
+ if (secondOfDay < 0) {
+ secondOfDay += SECONDS_PER_DAY;
+ fields->julianDay--;
}
- if ( Tcl_GetIntFromObj( interp, objv[1], &i ) != TCL_OK ) {
+ GetGregorianEraYearDay(fields, changeover);
+ GetMonthDay(fields);
+
+ /*
+ * Convert the date/time to a 'struct tm'.
+ */
+
+ timeVal.tm_year = fields->year - 1900;
+ timeVal.tm_mon = fields->month - 1;
+ timeVal.tm_mday = fields->dayOfMonth;
+ timeVal.tm_hour = (secondOfDay / 3600) % 24;
+ timeVal.tm_min = (secondOfDay / 60) % 60;
+ timeVal.tm_sec = secondOfDay % 60;
+ timeVal.tm_isdst = -1;
+ timeVal.tm_wday = -1;
+ timeVal.tm_yday = -1;
+
+ /*
+ * Get local time. It is rumored that mktime is not thread safe on some
+ * platforms, so seize a mutex before attempting this.
+ */
+
+ TzsetIfNecessary();
+ Tcl_MutexLock(&clockMutex);
+ errno = 0;
+ fields->seconds = (Tcl_WideInt) mktime(&timeVal);
+ localErrno = errno;
+ Tcl_MutexUnlock(&clockMutex);
+
+ /*
+ * If conversion fails, report an error.
+ */
+
+ if (localErrno != 0
+ || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "time value too large/small to represent", -1));
return TCL_ERROR;
}
- toConvert.tm_year = i - 1900;
- if ( Tcl_GetIntFromObj( interp, objv[2], &i ) != TCL_OK ) {
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertUTCToLocal --
+ *
+ * Converts a time (in a TclDateFields structure) from UTC to local time.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Populates the 'tzName' and 'tzOffset' fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertUTCToLocal(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Fields of the time */
+ Tcl_Obj *tzdata, /* Time zone data */
+ int changeover) /* Julian Day of the Gregorian transition */
+{
+ int rowc; /* Number of rows in tzdata */
+ Tcl_Obj **rowv; /* Pointers to the rows */
+
+ /*
+ * Unpack the tz data.
+ */
+
+ if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
- toConvert.tm_mon = i - 1;
- if ( Tcl_GetIntFromObj( interp, objv[3], &i ) != TCL_OK ) {
- return TCL_ERROR;
+
+ /*
+ * Special case: If the time zone is :localtime, the tzdata will be empty.
+ * Use 'localtime' to convert the time to local
+ */
+
+ if (rowc == 0) {
+ return ConvertUTCToLocalUsingC(interp, fields, changeover);
+ } else {
+ return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv);
}
- toConvert.tm_mday = i;
- if ( Tcl_GetIntFromObj( interp, objv[4], &i ) != TCL_OK ) {
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertUTCToLocalUsingTable --
+ *
+ * Converts UTC to local time, given a table of transition points
+ *
+ * Results:
+ * Returns a standard Tcl result
+ *
+ * Side effects:
+ * On success, fills fields->tzName, fields->tzOffset and
+ * fields->localSeconds. On failure, places an error message in the
+ * interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertUTCToLocalUsingTable(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Fields of the date */
+ int rowc, /* Number of rows in the conversion table
+ * (>= 1) */
+ Tcl_Obj *const rowv[]) /* Rows of the conversion table */
+{
+ Tcl_Obj *row; /* Row containing the current information */
+ int cellc; /* Count of cells in the row (must be 4) */
+ Tcl_Obj **cellv; /* Pointers to the cells */
+
+ /*
+ * Look up the nearest transition time.
+ */
+
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ if (row == NULL ||
+ TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
+ TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
return TCL_ERROR;
}
- toConvert.tm_hour = i;
- if ( Tcl_GetIntFromObj( interp, objv[5], &i ) != TCL_OK ) {
+
+ /*
+ * Convert the time.
+ */
+
+ fields->tzName = cellv[3];
+ Tcl_IncrRefCount(fields->tzName);
+ fields->localSeconds = fields->seconds + fields->tzOffset;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertUTCToLocalUsingC --
+ *
+ * Converts UTC to localtime in cases where the local time zone is not
+ * determinable, using the C 'localtime' function to do it.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * On success, fills fields->tzName, fields->tzOffset and
+ * fields->localSeconds. On failure, places an error message in the
+ * interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertUTCToLocalUsingC(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
+ int changeover) /* Julian Day of the Gregorian transition */
+{
+ time_t tock;
+ struct tm *timeVal; /* Time after conversion */
+ int diff; /* Time zone diff local-Greenwich */
+ char buffer[8]; /* Buffer for time zone name */
+
+ /*
+ * Use 'localtime' to determine local year, month, day, time of day.
+ */
+
+ tock = (time_t) fields->seconds;
+ if ((Tcl_WideInt) tock != fields->seconds) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "number too large to represent as a Posix time", -1));
+ Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
return TCL_ERROR;
}
- toConvert.tm_min = i;
- if ( Tcl_GetIntFromObj( interp, objv[6], &i ) != TCL_OK ) {
+ TzsetIfNecessary();
+ timeVal = ThreadSafeLocalTime(&tock);
+ if (timeVal == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "localtime failed (clock value may be too "
+ "large/small to represent)", -1));
+ Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
return TCL_ERROR;
}
- toConvert.tm_sec = i;
- toConvert.tm_isdst = -1;
- toConvert.tm_wday = -1;
- toConvert.tm_yday = -1;
- /* Convert the time. It is rumored that mktime is not thread
- * safe on some platforms. */
+ /*
+ * Fill in the date in 'fields' and use it to derive Julian Day.
+ */
- TzsetIfNecessary();
- Tcl_MutexLock( &clockMutex );
- errno = 0;
- convertedTime = mktime( &toConvert );
- localErrno = errno;
- Tcl_MutexUnlock( &clockMutex );
+ fields->era = CE;
+ fields->year = timeVal->tm_year + 1900;
+ fields->month = timeVal->tm_mon + 1;
+ fields->dayOfMonth = timeVal->tm_mday;
+ GetJulianDayFromEraYearMonthDay(fields, changeover);
- /* Return the converted time, or an error if conversion fails */
+ /*
+ * Convert that value to seconds.
+ */
- if ( localErrno != 0
- || ( convertedTime == -1
- && toConvert.tm_yday == -1 ) ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj( "time value too large/small to represent",
- -1 ) );
- return TCL_ERROR;
+ fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24
+ + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60
+ + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH;
+
+ /*
+ * Determine a time zone offset and name; just use +hhmm for the name.
+ */
+
+ diff = (int) (fields->localSeconds - fields->seconds);
+ fields->tzOffset = diff;
+ if (diff < 0) {
+ *buffer = '-';
+ diff = -diff;
} else {
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( (Tcl_WideInt) convertedTime ) );
- return TCL_OK;
+ *buffer = '+';
}
+ sprintf(buffer+1, "%02d", diff / 3600);
+ diff %= 3600;
+ sprintf(buffer+3, "%02d", diff / 60);
+ diff %= 60;
+ if (diff > 0) {
+ sprintf(buffer+5, "%02d", diff);
+ }
+ fields->tzName = Tcl_NewStringObj(buffer, -1);
+ Tcl_IncrRefCount(fields->tzName);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LookupLastTransition --
+ *
+ * Given a UTC time and a tzdata array, looks up the last transition on
+ * or before the given time.
+ *
+ * Results:
+ * Returns a pointer to the row, or NULL if an error occurs.
+ *
+ *----------------------------------------------------------------------
+ */
-#endif
+static Tcl_Obj *
+LookupLastTransition(
+ Tcl_Interp *interp, /* Interpreter for error messages */
+ Tcl_WideInt tick, /* Time from the epoch */
+ int rowc, /* Number of rows of tzdata */
+ Tcl_Obj *const *rowv) /* Rows in tzdata */
+{
+ int l;
+ int u;
+ Tcl_Obj *compObj;
+ Tcl_WideInt compVal;
+ /*
+ * Examine the first row to make sure we're in bounds.
+ */
+
+ if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
+ || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+ return NULL;
+ }
+
+ /*
+ * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
+ * anyway.
+ */
+
+ if (tick < compVal) {
+ return rowv[0];
+ }
+
+ /*
+ * Binary-search to find the transition.
+ */
+
+ l = 0;
+ u = rowc-1;
+ while (l < u) {
+ int m = (l + u + 1) / 2;
+
+ if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
+ Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+ return NULL;
+ }
+ if (tick >= compVal) {
+ l = m;
+ } else {
+ u = m-1;
+ }
+ }
+ return rowv[l];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetYearWeekDay --
+ *
+ * Given a date with Julian Calendar Day, compute the year, week, and day
+ * in the ISO8601 calendar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in the date
+ * fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetYearWeekDay(
+ TclDateFields *fields, /* Date to convert, must have 'julianDay' */
+ int changeover) /* Julian Day Number of the Gregorian
+ * transition */
+{
+ TclDateFields temp;
+ int dayOfFiscalYear;
+
+ /*
+ * Find the given date, minus three days, plus one year. That date's
+ * iso8601 year is an upper bound on the ISO8601 year of the given date.
+ */
+
+ temp.julianDay = fields->julianDay - 3;
+ GetGregorianEraYearDay(&temp, changeover);
+ if (temp.era == BCE) {
+ temp.iso8601Year = temp.year - 1;
+ } else {
+ temp.iso8601Year = temp.year + 1;
+ }
+ temp.iso8601Week = 1;
+ temp.dayOfWeek = 1;
+ GetJulianDayFromEraYearWeekDay(&temp, changeover);
+
+ /*
+ * temp.julianDay is now the start of an ISO8601 year, either the one
+ * corresponding to the given date, or the one after. If we guessed high,
+ * move one year earlier
+ */
+
+ if (fields->julianDay < temp.julianDay) {
+ if (temp.era == BCE) {
+ temp.iso8601Year += 1;
+ } else {
+ temp.iso8601Year -= 1;
+ }
+ GetJulianDayFromEraYearWeekDay(&temp, changeover);
+ }
+
+ fields->iso8601Year = temp.iso8601Year;
+ dayOfFiscalYear = fields->julianDay - temp.julianDay;
+ fields->iso8601Week = (dayOfFiscalYear / 7) + 1;
+ fields->dayOfWeek = (dayOfFiscalYear + 1) % 7;
+ if (fields->dayOfWeek < 1) {
+ fields->dayOfWeek += 7;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetGregorianEraYearDay --
+ *
+ * Given a Julian Day Number, extracts the year and day of the year and
+ * puts them into TclDateFields, along with the era (BCE or CE) and a
+ * flag indicating whether the date is Gregorian or Julian.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores 'era', 'gregorian', 'year', and 'dayOfYear'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetGregorianEraYearDay(
+ TclDateFields *fields, /* Date fields containing 'julianDay' */
+ int changeover) /* Gregorian transition date */
+{
+ int jday = fields->julianDay;
+ int day;
+ int year;
+ int n;
+
+ if (jday >= changeover) {
+ /*
+ * Gregorian calendar.
+ */
+
+ fields->gregorian = 1;
+ year = 1;
+
+ /*
+ * n = Number of 400-year cycles since 1 January, 1 CE in the
+ * proleptic Gregorian calendar. day = remaining days.
+ */
+
+ day = jday - JDAY_1_JAN_1_CE_GREGORIAN;
+ n = day / FOUR_CENTURIES;
+ day %= FOUR_CENTURIES;
+ if (day < 0) {
+ day += FOUR_CENTURIES;
+ n--;
+ }
+ year += 400 * n;
+
+ /*
+ * n = number of centuries since the start of (year);
+ * day = remaining days
+ */
+
+ n = day / ONE_CENTURY_GREGORIAN;
+ day %= ONE_CENTURY_GREGORIAN;
+ if (n > 3) {
+ /*
+ * 31 December in the last year of a 400-year cycle.
+ */
+
+ n = 3;
+ day += ONE_CENTURY_GREGORIAN;
+ }
+ year += 100 * n;
+ } else {
+ /*
+ * Julian calendar.
+ */
+
+ fields->gregorian = 0;
+ year = 1;
+ day = jday - JDAY_1_JAN_1_CE_JULIAN;
+ }
+
+ /*
+ * n = number of 4-year cycles; days = remaining days.
+ */
+
+ n = day / FOUR_YEARS;
+ day %= FOUR_YEARS;
+ if (day < 0) {
+ day += FOUR_YEARS;
+ n--;
+ }
+ year += 4 * n;
+
+ /*
+ * n = number of years; days = remaining days.
+ */
+
+ n = day / ONE_YEAR;
+ day %= ONE_YEAR;
+ if (n > 3) {
+ /*
+ * 31 December of a leap year.
+ */
+
+ n = 3;
+ day += 365;
+ }
+ year += n;
+
+ /*
+ * store era/year/day back into fields.
+ */
+
+ if (year <= 0) {
+ fields->era = BCE;
+ fields->year = 1 - year;
+ } else {
+ fields->era = CE;
+ fields->year = year;
+ }
+ fields->dayOfYear = day + 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMonthDay --
+ *
+ * Given a date as year and day-of-year, find month and day.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores 'month' and 'dayOfMonth' in the 'fields' structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMonthDay(
+ TclDateFields *fields) /* Date to convert */
+{
+ int day = fields->dayOfYear;
+ int month;
+ const int *h = hath[IsGregorianLeapYear(fields)];
+
+ for (month = 0; month < 12 && day > h[month]; ++month) {
+ day -= h[month];
+ }
+ fields->month = month+1;
+ fields->dayOfMonth = day;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetJulianDayFromEraYearWeekDay --
+ *
+ * Given a TclDateFields structure containing era, ISO8601 year, ISO8601
+ * week, and day of week, computes the Julian Day Number.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores 'julianDay' in the fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetJulianDayFromEraYearWeekDay(
+ TclDateFields *fields, /* Date to convert */
+ int changeover) /* Julian Day Number of the Gregorian
+ * transition */
+{
+ int firstMonday; /* Julian day number of week 1, day 1 in the
+ * given year */
+ TclDateFields firstWeek;
+
+ /*
+ * Find January 4 in the ISO8601 year, which will always be in week 1.
+ */
+
+ firstWeek.era = fields->era;
+ firstWeek.year = fields->iso8601Year;
+ firstWeek.month = 1;
+ firstWeek.dayOfMonth = 4;
+ GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);
+
+ /*
+ * Find Monday of week 1.
+ */
+
+ firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay);
+
+ /*
+ * Advance to the given week and day.
+ */
+
+ fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1)
+ + fields->dayOfWeek - 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetJulianDayFromEraYearMonthDay --
+ *
+ * Given era, year, month, and dayOfMonth (in TclDateFields), and the
+ * Gregorian transition date, computes the Julian Day Number.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores day number in 'julianDay'
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetJulianDayFromEraYearMonthDay(
+ TclDateFields *fields, /* Date to convert */
+ int changeover) /* Gregorian transition date as a Julian Day */
+{
+ int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;
+
+ if (fields->era == BCE) {
+ year = 1 - fields->year;
+ } else {
+ year = fields->year;
+ }
+
+ /*
+ * Reduce month modulo 12.
+ */
+
+ month = fields->month;
+ mm1 = month - 1;
+ q = mm1 / 12;
+ r = (mm1 % 12);
+ if (r < 0) {
+ r += 12;
+ q -= 1;
+ }
+ year += q;
+ month = r + 1;
+ ym1 = year - 1;
+
+ /*
+ * Adjust the year after reducing the month.
+ */
+
+ fields->gregorian = 1;
+ if (year < 1) {
+ fields->era = BCE;
+ fields->year = 1-year;
+ } else {
+ fields->era = CE;
+ fields->year = year;
+ }
+
+ /*
+ * Try an initial conversion in the Gregorian calendar.
+ */
+
+ ym1o4 = ym1 / 4;
+ if (ym1 % 4 < 0) {
+ ym1o4--;
+ }
+ ym1o100 = ym1 / 100;
+ if (ym1 % 100 < 0) {
+ ym1o100--;
+ }
+ ym1o400 = ym1 / 400;
+ if (ym1 % 400 < 0) {
+ ym1o400--;
+ }
+ fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
+ + fields->dayOfMonth
+ + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1]
+ + (ONE_YEAR * ym1)
+ + ym1o4
+ - ym1o100
+ + ym1o400;
+
+ /*
+ * If the resulting date is before the Gregorian changeover, convert in
+ * the Julian calendar instead.
+ */
+
+ if (fields->julianDay < changeover) {
+ fields->gregorian = 0;
+ fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
+ + fields->dayOfMonth
+ + daysInPriorMonths[year%4 == 0][month - 1]
+ + (365 * ym1)
+ + ym1o4;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsGregorianLeapYear --
+ *
+ * Tests whether a given year is a leap year, in either Julian or
+ * Gregorian calendar.
+ *
+ * Results:
+ * Returns 1 for a leap year, 0 otherwise.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsGregorianLeapYear(
+ TclDateFields *fields) /* Date to test */
+{
+ int year;
+
+ if (fields->era == BCE) {
+ year = 1 - fields->year;
+ } else {
+ year = fields->year;
+ }
+ if (year%4 != 0) {
+ return 0;
+ } else if (!(fields->gregorian)) {
+ return 1;
+ } else if (year%400 == 0) {
+ return 1;
+ } else if (year%100 == 0) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WeekdayOnOrBefore --
+ *
+ * Finds the Julian Day Number of a given day of the week that falls on
+ * or before a given date, expressed as Julian Day Number.
+ *
+ * Results:
+ * Returns the Julian Day Number
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WeekdayOnOrBefore(
+ int dayOfWeek, /* Day of week; Sunday == 0 or 7 */
+ int julianDay) /* Reference date */
+{
+ int k = (dayOfWeek + 6) % 7;
+ if (k < 0) {
+ k += 7;
+ }
+ return julianDay - ((julianDay - k) % 7);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetenvObjCmd --
+ *
+ * Tcl command that reads an environment variable from the system
+ *
+ * Usage:
+ * ::tcl::clock::getEnv NAME
+ *
+ * Parameters:
+ * NAME - Name of the environment variable desired
+ *
+ * Results:
+ * Returns a standard Tcl result. Returns an error if the variable does
+ * not exist, with a message left in the interpreter. Returns TCL_OK and
+ * the value of the variable if the variable does exist,
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockGetenvObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ const char *varName;
+ const char *varValue;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ varName = TclGetString(objv[1]);
+ varValue = getenv(varName);
+ if (varValue == NULL) {
+ varValue = "";
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ThreadSafeLocalTime --
+ *
+ * Wrapper around the 'localtime' library function to make it thread
+ * safe.
+ *
+ * Results:
+ * Returns a pointer to a 'struct tm' in thread-specific data.
+ *
+ * Side effects:
+ * Invokes localtime or localtime_r as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static struct tm *
+ThreadSafeLocalTime(
+ const time_t *timePtr) /* Pointer to the number of seconds since the
+ * local system's epoch */
+{
+ /*
+ * Get a thread-local buffer to hold the returned time.
+ */
+
+ struct tm *tmPtr = Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
+#ifdef HAVE_LOCALTIME_R
+ localtime_r(timePtr, tmPtr);
+#else
+ struct tm *sysTmPtr;
+
+ Tcl_MutexLock(&clockMutex);
+ sysTmPtr = localtime(timePtr);
+ if (sysTmPtr == NULL) {
+ Tcl_MutexUnlock(&clockMutex);
+ return NULL;
+ }
+ memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
+ Tcl_MutexUnlock(&clockMutex);
+#endif
+ return tmPtr;
}
/*----------------------------------------------------------------------
*
- * TclClockClicksObjCmd --
+ * ClockClicksObjCmd --
*
* Returns a high-resolution counter.
*
@@ -364,73 +1676,68 @@ TclClockMktimeObjCmd( ClientData clientData,
* Side effects:
* None.
*
- * This function implements the 'clock clicks' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock clicks' Tcl command. Refer to the user
+ * documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockClicksObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+ClockClicksObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter values */
{
- static CONST char *clicksSwitches[] = {
- "-milliseconds", "-microseconds", (char*) NULL
+ static const char *const clicksSwitches[] = {
+ "-milliseconds", "-microseconds", NULL
};
enum ClicksSwitch {
- CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
+ CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
};
int index = CLICKS_NATIVE;
Tcl_Time now;
+ Tcl_WideInt clicks = 0;
switch (objc) {
case 1:
break;
case 2:
- if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
- Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
return TCL_ERROR;
}
switch (index) {
case CLICKS_MILLIS:
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
- now.sec * 1000 + now.usec / 1000 ) );
+ clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
break;
case CLICKS_NATIVE:
-#if 0
- /*
- * The following code will be used once this is incorporated
- * into Tcl. But TEA bugs prevent it for right now. :(
- * So we fall through this case and return the microseconds
- * instead.
- */
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
- TclpGetClicks()));
- break;
+#ifdef TCL_WIDE_CLICKS
+ clicks = TclpGetWideClicks();
+#else
+ clicks = (Tcl_WideInt) TclpGetClicks();
#endif
+ break;
case CLICKS_MICROS:
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+ clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
break;
}
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
return TCL_OK;
}
/*----------------------------------------------------------------------
*
- * TclClockMillisecondsObjCmd -
+ * ClockMillisecondsObjCmd -
*
* Returns a count of milliseconds since the epoch.
*
@@ -440,33 +1747,34 @@ TclClockClicksObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock milliseconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock milliseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockMillisecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+ClockMillisecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
now.sec * 1000 + now.usec / 1000));
return TCL_OK;
}
/*----------------------------------------------------------------------
*
- * TclClockMicrosecondsObjCmd -
+ * ClockMicrosecondsObjCmd -
*
* Returns a count of microseconds since the epoch.
*
@@ -476,20 +1784,21 @@ TclClockMillisecondsObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock microseconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock microseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+ClockMicrosecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -500,9 +1809,127 @@ TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
return TCL_OK;
}
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ClockParseformatargsObjCmd --
+ *
+ * Parses the arguments for [clock format].
+ *
+ * Results:
+ * Returns a standard Tcl result, whose value is a four-element list
+ * comprising the time format, the locale, and the timezone.
+ *
+ * This function exists because the loop that parses the [clock format]
+ * options is a known performance "hot spot", and is implemented in an effort
+ * to speed that particular code up.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ClockParseformatargsObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter vector */
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj **litPtr = dataPtr->literals;
+ Tcl_Obj *results[3]; /* Format, locale and timezone */
+#define formatObj results[0]
+#define localeObj results[1]
+#define timezoneObj results[2]
+ int gmtFlag = 0;
+ static const char *const options[] = { /* Command line options expected */
+ "-format", "-gmt", "-locale",
+ "-timezone", NULL };
+ enum optionInd {
+ CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE,
+ CLOCK_FORMAT_TIMEZONE
+ };
+ int optionIndex; /* Index of an option. */
+ int saw = 0; /* Flag == 1 if option was seen already. */
+ Tcl_WideInt clockVal; /* Clock value - just used to parse. */
+ int i;
+
+ /*
+ * Args consist of a time followed by keyword-value pairs.
+ */
+
+ if (objc < 2 || (objc % 2) != 0) {
+ Tcl_WrongNumArgs(interp, 0, objv,
+ "clock format clockval ?-format string? "
+ "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract values for the keywords.
+ */
+
+ formatObj = litPtr[LIT__DEFAULT_FORMAT];
+ localeObj = litPtr[LIT_C];
+ timezoneObj = litPtr[LIT__NIL];
+ for (i = 2; i < objc; i+=2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
+ &optionIndex) != TCL_OK) {
+ Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+ Tcl_GetString(objv[i]), NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case CLOCK_FORMAT_FORMAT:
+ formatObj = objv[i+1];
+ break;
+ case CLOCK_FORMAT_GMT:
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
+ return TCL_ERROR;
+ }
+ break;
+ case CLOCK_FORMAT_LOCALE:
+ localeObj = objv[i+1];
+ break;
+ case CLOCK_FORMAT_TIMEZONE:
+ timezoneObj = objv[i+1];
+ break;
+ }
+ saw |= 1 << optionIndex;
+ }
+
+ /*
+ * Check options.
+ */
+
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((saw & (1 << CLOCK_FORMAT_GMT))
+ && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
+ Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
+ Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
+ return TCL_ERROR;
+ }
+ if (gmtFlag) {
+ timezoneObj = litPtr[LIT_GMT];
+ }
+
+ /*
+ * Return options as a list.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
+ return TCL_OK;
+
+#undef timezoneObj
+#undef localeObj
+#undef formatObj
+}
+
/*----------------------------------------------------------------------
*
- * TclClockSecondsObjCmd -
+ * ClockSecondsObjCmd -
*
* Returns a count of microseconds since the epoch.
*
@@ -512,20 +1939,21 @@ TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock seconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock seconds' Tcl command. Refer to the user
+ * documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockSecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+ClockSecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -553,27 +1981,64 @@ TclClockSecondsObjCmd(clientData, interp, objc, objv)
*/
static void
-TzsetIfNecessary()
+TzsetIfNecessary(void)
{
- static char* tzWas = NULL; /* Previous value of TZ, protected by
+ static char *tzWas = NULL; /* Previous value of TZ, protected by
* clockMutex. */
- CONST char* tzIsNow; /* Current value of TZ */
+ const char *tzIsNow; /* Current value of TZ */
- Tcl_MutexLock( &clockMutex );
- tzIsNow = getenv( "TZ" );
- if ( tzIsNow != NULL
- && ( tzWas == NULL || strcmp( tzIsNow, tzWas ) != 0 ) ) {
+ Tcl_MutexLock(&clockMutex);
+ tzIsNow = getenv("TZ");
+ if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
tzset();
- if ( tzWas != NULL ) {
- ckfree( tzWas );
+ if (tzWas != NULL) {
+ ckfree(tzWas);
}
- tzWas = ckalloc( strlen( tzIsNow ) + 1 );
- strcpy( tzWas, tzIsNow );
- } else if ( tzIsNow == NULL && tzWas != NULL ) {
+ tzWas = ckalloc(strlen(tzIsNow) + 1);
+ strcpy(tzWas, tzIsNow);
+ } else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
- ckfree( tzWas );
+ ckfree(tzWas);
tzWas = NULL;
}
- Tcl_MutexUnlock( &clockMutex );
+ Tcl_MutexUnlock(&clockMutex);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockDeleteCmdProc --
+ *
+ * Remove a reference to the clock client data, and clean up memory
+ * when it's all gone.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockDeleteCmdProc(
+ ClientData clientData) /* Opaque pointer to the client data */
+{
+ ClockClientData *data = clientData;
+ int i;
+ data->refCount--;
+ if (data->refCount == 0) {
+ for (i = 0; i < LIT__END; ++i) {
+ Tcl_DecrRefCount(data->literals[i]);
+ }
+ ckfree(data->literals);
+ ckfree(data);
+ }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index a5124c2..d90a747 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -9,24 +9,89 @@
*
* 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.68 2005/09/14 21:32:17 dgp Exp $
*/
#include "tclInt.h"
#include <locale.h>
/*
+ * The state structure used by [foreach]. Note that the actual structure has
+ * all its working arrays appended afterwards so they can be allocated and
+ * freed in a single step.
+ */
+
+struct ForeachState {
+ Tcl_Obj *bodyPtr; /* The script body of the command. */
+ int bodyIdx; /* The argument index of the body. */
+ int j, maxj; /* Number of loop iterations. */
+ int numLists; /* Count of value lists. */
+ int *index; /* Array of value list indices. */
+ int *varcList; /* # loop variables per list. */
+ Tcl_Obj ***varvList; /* Array of var name lists. */
+ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */
+ 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]). */
+};
+
+/*
* Prototypes for local procedures defined in this file:
*/
static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int mode);
+static int EncodingDirsObjCmd(ClientData dummy,
+ 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,
+ struct ForeachState *statePtr);
static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
-static char * GetTypeFromMode(int mode);
+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;
+static Tcl_NRPostProc ForCondCallback;
+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;
/*
*----------------------------------------------------------------------
@@ -51,11 +116,11 @@ static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
/* ARGSUSED */
int
-Tcl_BreakObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_BreakObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -70,7 +135,8 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv)
* Tcl_CaseObjCmd --
*
* This procedure is invoked to process the "case" Tcl command. See the
- * user documentation for details on what it does.
+ * user documentation for details on what it does. THIS COMMAND IS
+ * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
*
* Results:
* A standard Tcl object result.
@@ -83,21 +149,21 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_CaseObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_CaseObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register int i;
int body, result, caseObjc;
- char *stringPtr, *arg;
- Tcl_Obj *CONST *caseObjv;
+ const char *stringPtr, *arg;
+ Tcl_Obj *const *caseObjv;
Tcl_Obj *armPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
- "string ?in? patList body ... ?default body?");
+ "string ?in? ?pattern body ...? ?default body?");
return TCL_ERROR;
}
@@ -121,19 +187,19 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
if (caseObjc == 1) {
Tcl_Obj **newObjv;
- Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+ TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
caseObjv = newObjv;
}
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
- CONST char **patObjv;
- char *pat;
- unsigned char *p;
+ const char **patObjv;
+ const char *pat, *p;
- if (i == (caseObjc - 1)) {
+ 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;
}
@@ -143,8 +209,8 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
*/
pat = TclGetString(caseObjv[i]);
- for (p = (unsigned char *) pat; *p != '\0'; p++) {
- if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */
+ for (p = pat; *p != '\0'; p++) {
+ if (TclIsSpaceProc(*p) || (*p == '\\')) {
break;
}
}
@@ -174,7 +240,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
break;
}
}
- ckfree((char *) patObjv);
+ ckfree(patObjv);
if (j < patObjc) {
break;
}
@@ -185,8 +251,9 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"%.50s\" arm line %d)",
- TclGetString(armPtr), interp->errorLine);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.50s\" arm line %d)",
+ TclGetString(armPtr), Tcl_GetErrorLine(interp)));
}
return result;
}
@@ -217,15 +284,25 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_CatchObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_CatchObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRCatchObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varNamePtr = NULL;
Tcl_Obj *optionVarNamePtr = NULL;
- int result;
+ Interp *iPtr = (Interp *) interp;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -240,35 +317,51 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
optionVarNamePtr = objv[3];
}
- result = Tcl_EvalObjEx(interp, objv[1], 0);
+ TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
+ varNamePtr, optionVarNamePtr, NULL);
+
+ /*
+ * TIP #280. Make invoking context available to caught script.
+ */
+
+ return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+}
+
+static int
+CatchObjCmdCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj *varNamePtr = data[1];
+ Tcl_Obj *optionVarNamePtr = data[2];
+ int rewind = iPtr->execEnvPtr->rewind;
/*
* We disable catch in interpreters where the limit has been exceeded.
*/
- if (Tcl_LimitExceeded(interp)) {
- TclFormatToErrorInfo(interp, "\n (\"catch\" body line %d)",
- interp->errorLine);
+ if (rewind || Tcl_LimitExceeded(interp)) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
return TCL_ERROR;
}
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;
}
}
if (objc == 4) {
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;
}
}
@@ -297,11 +390,11 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_CdObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_CdObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *dir;
int result;
@@ -314,7 +407,7 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
if (objc == 2) {
dir = objv[1];
} else {
- dir = Tcl_NewStringObj("~",1);
+ TclNewLiteralStringObj(dir, "~");
Tcl_IncrRefCount(dir);
}
if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
@@ -322,8 +415,9 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
} 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;
}
}
@@ -352,11 +446,11 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ConcatObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ConcatObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc >= 2) {
Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
@@ -387,11 +481,11 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ContinueObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ContinueObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -417,20 +511,20 @@ Tcl_ContinueObjCmd(dummy, interp, objc, objv)
*/
int
-Tcl_EncodingObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_EncodingObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int index;
- static CONST char *optionStrings[] = {
- "convertfrom", "convertto", "names", "system",
+ static const char *const optionStrings[] = {
+ "convertfrom", "convertto", "dirs", "names", "system",
NULL
};
enum options {
- ENC_CONVERTFROM, ENC_CONVERTTO, ENC_NAMES, ENC_SYSTEM
+ ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
};
if (objc < 2) {
@@ -449,13 +543,13 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
Tcl_DString ds;
Tcl_Encoding encoding;
int length;
- char *stringPtr;
+ const char *stringPtr;
if (objc == 3) {
encoding = Tcl_GetEncoding(interp, NULL);
data = objv[2];
} else if (objc == 4) {
- if (TclGetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
+ if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
return TCL_ERROR;
}
data = objv[3];
@@ -477,15 +571,13 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
* 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.
*/
- stringPtr = Tcl_GetStringFromObj(data, &length);
+ stringPtr = TclGetStringFromObj(data, &length);
Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
(unsigned char *) Tcl_DStringValue(&ds),
@@ -496,6 +588,8 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
Tcl_FreeEncoding(encoding);
break;
}
+ case ENC_DIRS:
+ return EncodingDirsObjCmd(dummy, interp, objc, objv);
case ENC_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -522,7 +616,7 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclEncodingDirsObjCmd --
+ * EncodingDirsObjCmd --
*
* This command manipulates the encoding search path.
*
@@ -536,26 +630,33 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
*/
int
-TclEncodingDirsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+EncodingDirsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ 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) {
- Tcl_SetObjResult(interp, TclGetEncodingSearchPath());
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
}
- if (TclSetEncodingSearchPath(objv[1]) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected directory list but got \"",
- Tcl_GetString(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;
}
@@ -578,30 +679,30 @@ TclEncodingDirsObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ErrorObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ErrorObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *options;
+ Tcl_Obj *options, *optName;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
return TCL_ERROR;
}
- options = Tcl_NewStringObj("-code error -level 0", -1);
+ TclNewLiteralStringObj(options, "-code error -level 0");
- if (objc >= 3) { /* process the optional info argument */
- Tcl_ListObjAppendElement(NULL, options,
- Tcl_NewStringObj("-errorinfo", -1));
+ if (objc >= 3) { /* Process the optional info argument */
+ TclNewLiteralStringObj(optName, "-errorinfo");
+ Tcl_ListObjAppendElement(NULL, options, optName);
Tcl_ListObjAppendElement(NULL, options, objv[2]);
}
- if (objc == 4) { /* process the optional code argument */
- Tcl_ListObjAppendElement(NULL, options,
- Tcl_NewStringObj("-errorcode", -1));
+ if (objc >= 4) { /* Process the optional code argument */
+ TclNewLiteralStringObj(optName, "-errorcode");
+ Tcl_ListObjAppendElement(NULL, options, optName);
Tcl_ListObjAppendElement(NULL, options, objv[3]);
}
@@ -627,15 +728,40 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
*/
/* ARGSUSED */
+static int
+EvalCmdErrMsg(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
+ }
+ return result;
+}
+
int
-Tcl_EvalObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_EvalObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ 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. */
{
- int result;
register Tcl_Obj *objPtr;
+ Interp *iPtr = (Interp *) interp;
+ CmdFrame *invoker = NULL;
+ int word = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -643,22 +769,28 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
}
if (objc == 2) {
- result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
+ /*
+ * TIP #280. Make argument location available to eval'd script.
+ */
+
+ invoker = iPtr->cmdFramePtr;
+ word = 1;
+ objPtr = objv[1];
+ TclArgumentGet(interp, objPtr, &invoker, &word);
} else {
/*
* More than one argument: concatenate them together with spaces
* between, then evaluate the result. Tcl_EvalObjEx will delete the
* object when it decrements its refcount after eval'ing it.
+ *
+ * TIP #280. Make invoking context available to eval'd script, done
+ * with the default values.
*/
objPtr = Tcl_ConcatObj(objc-1, objv+1);
- result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
- }
- if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,"\n (\"eval\" body line %d)",
- interp->errorLine);
}
- return result;
+ TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
+ return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}
/*
@@ -680,11 +812,11 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ExitObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ExitObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int value;
@@ -700,7 +832,7 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
}
Tcl_Exit(value);
/*NOTREACHED*/
- return TCL_OK; /* Better not ever reach this! */
+ return TCL_OK; /* Better not ever reach this! */
}
/*
@@ -729,44 +861,73 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ExprObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ExprObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- register Tcl_Obj *objPtr;
- Tcl_Obj *resultPtr;
- int result;
+ return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRExprObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *resultPtr, *objPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
}
- objPtr = Tcl_ConcatObj(objc-1, objv+1);
- Tcl_IncrRefCount(objPtr);
- result = Tcl_ExprObj(interp, objPtr, &resultPtr);
- Tcl_DecrRefCount(objPtr);
+ TclNewObj(resultPtr);
+ Tcl_IncrRefCount(resultPtr);
+ if (objc == 2) {
+ objPtr = objv[1];
+ TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
+ } else {
+ objPtr = Tcl_ConcatObj(objc-1, objv+1);
+ TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+ }
+
+ return Tcl_NRExprObj(interp, objPtr, resultPtr);
+}
+
+static int
+ExprCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *resultPtr = data[0];
+ Tcl_Obj *objPtr = data[1];
+
+ if (objPtr != NULL) {
+ Tcl_DecrRefCount(objPtr);
+ }
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
- Tcl_DecrRefCount(resultPtr); /* done with the result object */
}
-
+ Tcl_DecrRefCount(resultPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_FileObjCmd --
+ * TclInitFileCmd --
+ *
+ * This function builds the "file" Tcl command ensemble. See the user
+ * documentation for details on what that ensemble does.
*
- * 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.
+ * 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.
@@ -777,581 +938,1210 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-int
-Tcl_FileObjCmd(dummy, interp, objc, objv)
- 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;
-
/*
- * 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 *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", "type", "volumes", "writable",
- (char *) NULL
+ static const EnsembleImplMap initMap[] = {
+ {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
+ {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
+ {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
+ {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
+ {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, 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_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) {
- {
- Tcl_StatBuf buf;
- struct utimbuf tval;
-
- case FCMD_ATIME:
- case FCMD_MTIME:
- if ((objc < 3) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+ long newTime;
+
+ 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 (Tcl_GetLongFromObj(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), (char *) 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;
- } else {
- 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) {
- Tcl_SetObjResult(interp, ext);
- Tcl_DecrRefCount(ext);
- return TCL_OK;
- } else {
+ /*
+ * 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;
}
}
- {
- int value;
- Tcl_StatBuf buf;
- 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.
- */
+ 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 defined(__WIN32__)
- value = 1;
-#else
- value = (geteuid() == buf.st_uid);
-#endif
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
- 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;
}
- case FCMD_JOIN: {
- Tcl_Obj *resObj;
+ if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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) {
- 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
+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;
}
- case FCMD_LINK: {
- Tcl_Obj *contents;
- int index;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc < 3 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?");
- return TCL_ERROR;
- }
+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 *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", (char *) 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",
- (char *) NULL);
- } else {
- Tcl_AppendResult(interp,
- "could not create new link \"",
- TclGetString(objv[index]), "\": target \"",
- TclGetString(objv[index+1]),
- "\" doesn't exist", (char *) NULL);
- }
- } else {
- Tcl_AppendResult(interp,
- "could not create new link \"",
- TclGetString(objv[index]), "\" pointing to \"",
- TclGetString(objv[index+1]), "\": ",
- Tcl_PosixError(interp), (char *) 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), (char *) 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;
+ }
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
}
- {
- Tcl_StatBuf buf;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- 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;
+static int
+PathRootNameCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_MKDIR:
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
- return TCL_ERROR;
- }
- return TclFileMakeDirsCmd(interp, objc, objv);
- case FCMD_NATIVENAME: {
- CONST char *fileName;
- Tcl_DString ds;
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
+ }
+ 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;
- }
- 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;
+static int
+PathTailCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *dirPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
}
- case FCMD_NORMALIZE: {
- Tcl_Obj *fileName;
+ 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) {
- Tcl_WrongNumArgs(interp, 2, objv, "filename");
- return TCL_ERROR;
- }
+static int
+PathFilesystemCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *fsInfo;
- 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;
}
- case FCMD_PATHTYPE:
- if (objc != 3) {
- goto only3Args;
- }
- switch (Tcl_FSGetPathType(objv[2])) {
- case TCL_PATH_ABSOLUTE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("absolute", -1));
- break;
- case TCL_PATH_RELATIVE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("relative", -1));
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("volumerelative", -1));
- break;
- }
- return TCL_OK;
- case FCMD_READABLE:
- if (objc != 3) {
- goto only3Args;
- }
- return CheckAccess(interp, objv[2], R_OK);
- case FCMD_READLINK: {
- Tcl_Obj *contents;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
+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 (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
- return TCL_ERROR;
- }
+static int
+PathNativeNameCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_DString ds;
- contents = Tcl_FSLink(objv[2], NULL, 0);
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ 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 (contents == NULL) {
- Tcl_AppendResult(interp, "could not readlink \"",
- TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, contents);
- Tcl_DecrRefCount(contents);
- 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;
+ }
+ fileName = Tcl_FSGetNormalizedPath(interp, objv[1]);
+ if (fileName == NULL) {
+ return TCL_ERROR;
}
- case FCMD_RENAME:
- return TclFileRenameCmd(interp, objc, objv);
- case FCMD_ROOTNAME: {
- Tcl_Obj *root;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc != 3) {
- goto only3Args;
- }
- root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);
- if (root != NULL) {
- Tcl_SetObjResult(interp, root);
- Tcl_DecrRefCount(root);
- return TCL_OK;
- } else {
- return TCL_ERROR;
- }
+static int
+PathSplitCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *res;
+
+ 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) {
- char *separator = NULL; /* lint */
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- 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]);
- if (separatorObj != NULL) {
- Tcl_SetObjResult(interp, separatorObj);
- } else {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("Unrecognised path",-1));
- return TCL_ERROR;
- }
- }
- return TCL_OK;
- case FCMD_SPLIT: {
- Tcl_Obj *res;
+static int
+PathTypeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *typeName;
- if (objc != 3) {
- goto only3Args;
- }
- res = Tcl_FSSplitPath(objv[2], NULL);
- if (res == NULL) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(objv[2]),
- "\": no such file or directory", (char *) NULL);
- }
- return TCL_ERROR;
- } else {
- Tcl_SetObjResult(interp, res);
- return TCL_OK;
- }
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
}
- case FCMD_SYSTEM: {
- Tcl_Obj* fsInfo;
+ 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;
+ }
+ 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_SetObjResult(interp, fsInfo);
- return TCL_OK;
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("Unrecognised path",-1));
- return TCL_ERROR;
- }
+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;
- } else {
- Tcl_SetObjResult(interp, dirPtr);
- Tcl_DecrRefCount(dirPtr);
- return TCL_OK;
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separator = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separator = "\\";
+ break;
}
- }
- 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;
}
/*
@@ -1373,11 +2163,11 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
*/
static int
-CheckAccess(interp, pathPtr, mode)
- Tcl_Interp *interp; /* Interp for status return. Must not be
+CheckAccess(
+ Tcl_Interp *interp, /* Interp for status return. Must not be
* NULL. */
- Tcl_Obj *pathPtr; /* Name of file to check. */
- int mode; /* Attribute to check; passed as argument to
+ Tcl_Obj *pathPtr, /* Name of file to check. */
+ int mode) /* Attribute to check; passed as argument to
* access(). */
{
int value;
@@ -1413,12 +2203,12 @@ CheckAccess(interp, pathPtr, mode)
*/
static int
-GetStatBuf(interp, pathPtr, statProc, statPtr)
- Tcl_Interp *interp; /* Interp for error return. May be NULL. */
- Tcl_Obj *pathPtr; /* Path name to examine. */
- Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on
+GetStatBuf(
+ Tcl_Interp *interp, /* Interp for error return. May be NULL. */
+ Tcl_Obj *pathPtr, /* Path name to examine. */
+ Tcl_FSStatProc *statProc, /* Either stat() or lstat() depending on
* desired behavior. */
- Tcl_StatBuf *statPtr; /* Filled with info about file obtained by
+ Tcl_StatBuf *statPtr) /* Filled with info about file obtained by
* calling (*statProc)(). */
{
int status;
@@ -1427,13 +2217,13 @@ GetStatBuf(interp, pathPtr, statProc, statPtr)
return TCL_ERROR;
}
- status = (*statProc)(pathPtr, statPtr);
+ status = statProc(pathPtr, statPtr);
if (status < 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1460,38 +2250,37 @@ GetStatBuf(interp, pathPtr, statProc, statPtr)
*/
static int
-StoreStatData(interp, varName, statPtr)
- Tcl_Interp *interp; /* Interpreter for error reports. */
- Tcl_Obj *varName; /* Name of associative array variable in which
+StoreStatData(
+ Tcl_Interp *interp, /* Interpreter for error reports. */
+ Tcl_Obj *varName, /* Name of associative array variable in which
* to store stat results. */
- Tcl_StatBuf *statPtr; /* Pointer to buffer containing stat data to
+ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to
* store in varName. */
{
- Tcl_Obj *field = Tcl_NewObj();
- Tcl_Obj *value;
+ Tcl_Obj *field, *value;
register unsigned short mode;
/*
* Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
*
- * Might be a better idea to call Tcl_SetVar2Ex() instead so we don't have
- * to make assumptions that might go wrong later.
+ * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
+ * to have an object (i.e. possibly cached) array variable name but a
+ * string element name, so no API exists. Messy.
*/
#define STORE_ARY(fieldName, object) \
- Tcl_SetStringObj(field, (fieldName), -1); \
- value = (object); \
+ TclNewLiteralStringObj(field, fieldName); \
+ Tcl_IncrRefCount(field); \
+ value = (object); \
if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
- Tcl_DecrRefCount(field); \
- Tcl_DecrRefCount(value); \
- return TCL_ERROR; \
- }
-
- Tcl_IncrRefCount(field);
+ TclDecrRefCount(field); \
+ return TCL_ERROR; \
+ } \
+ TclDecrRefCount(field);
/*
* Watch out porters; the inode is meant to be an *unsigned* value, so the
- * cast might fail when there isn't a real arithmentic 'long long' type...
+ * cast might fail when there isn't a real arithmetic 'long long' type...
*/
STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev));
@@ -1500,9 +2289,12 @@ StoreStatData(interp, varName, statPtr)
STORE_ARY("uid", Tcl_NewLongObj((long)statPtr->st_uid));
STORE_ARY("gid", Tcl_NewLongObj((long)statPtr->st_gid));
STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+ STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
+#endif
STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
@@ -1511,7 +2303,6 @@ StoreStatData(interp, varName, statPtr)
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY
- Tcl_DecrRefCount(field);
return TCL_OK;
}
@@ -1531,9 +2322,9 @@ StoreStatData(interp, varName, statPtr)
*----------------------------------------------------------------------
*/
-static char *
-GetTypeFromMode(mode)
- int mode;
+static const char *
+GetTypeFromMode(
+ int mode)
{
if (S_ISREG(mode)) {
return "file";
@@ -1576,77 +2367,210 @@ GetTypeFromMode(mode)
* Side effects:
* See the user documentation.
*
+ * Notes:
+ * This command is split into a lot of pieces so that it can avoid doing
+ * reentrant TEBC calls. This makes things rather hard to follow, but
+ * here's the plan:
+ *
+ * NR: ---------------_\
+ * Direct: Tcl_ForObjCmd -> TclNRForObjCmd
+ * |
+ * ForSetupCallback
+ * |
+ * [while] ------------> TclNRForIterCallback <---------.
+ * | |
+ * ForCondCallback |
+ * | |
+ * ForNextCallback ------------|
+ * | |
+ * ForPostNextCallback |
+ * |____________________|
+ *
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
-Tcl_ForObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ForObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int result, value;
+ return Tcl_NRCallObjProc(interp, TclNRForObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRForObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ ForIterData *iterPtr;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
return TCL_ERROR;
}
- result = Tcl_EvalObjEx(interp, objv[1], 0);
+ TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
+ iterPtr->cond = objv[2];
+ iterPtr->body = objv[4];
+ iterPtr->next = objv[3];
+ iterPtr->msg = "\n (\"for\" body line %d)";
+ iterPtr->word = 4;
+
+ TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
+
+ /*
+ * TIP #280. Make invoking context available to initial script.
+ */
+
+ return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+}
+
+static int
+ForSetupCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ ForIterData *iterPtr = data[0];
+
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)");
}
+ TclSmallFreeEx(interp, iterPtr);
return result;
}
- while (1) {
+ TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
+ return TCL_OK;
+}
+
+int
+TclNRForIterCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ ForIterData *iterPtr = data[0];
+ Tcl_Obj *boolObj;
+
+ switch (result) {
+ case TCL_OK:
+ case TCL_CONTINUE:
/*
- * We need to reset the result before passing it off to
- * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
- * to the result of the last evaluation.
+ * We need to reset the result before evaluating the expression.
+ * Otherwise, any error message will be appended to the result of the
+ * last evaluation.
*/
Tcl_ResetResult(interp);
- result = Tcl_ExprBooleanObj(interp, objv[2], &value);
- if (result != TCL_OK) {
- return result;
- }
- if (!value) {
- break;
- }
- result = Tcl_EvalObjEx(interp, objv[4], 0);
- if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
- if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"for\" body line %d)",
- interp->errorLine);
- }
- break;
- }
- result = Tcl_EvalObjEx(interp, objv[3], 0);
- if (result == TCL_BREAK) {
- break;
- } else if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)");
- }
- return result;
+ TclNewObj(boolObj);
+ TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
+ NULL);
+ return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
+ case TCL_BREAK:
+ result = TCL_OK;
+ Tcl_ResetResult(interp);
+ break;
+ case TCL_ERROR:
+ Tcl_AppendObjToErrorInfo(interp,
+ Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
+ }
+ TclSmallFreeEx(interp, iterPtr);
+ return result;
+}
+
+static int
+ForCondCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ ForIterData *iterPtr = data[0];
+ Tcl_Obj *boolObj = data[1];
+ int value;
+
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(boolObj);
+ TclSmallFreeEx(interp, iterPtr);
+ return result;
+ } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
+ Tcl_DecrRefCount(boolObj);
+ TclSmallFreeEx(interp, iterPtr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(boolObj);
+
+ if (value) {
+ /* TIP #280. */
+ if (iterPtr->next) {
+ TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
+ NULL);
+ } else {
+ TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+ NULL, NULL);
}
+ return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
+ iterPtr->word);
}
- if (result == TCL_BREAK) {
- result = TCL_OK;
+ TclSmallFreeEx(interp, iterPtr);
+ return result;
+}
+
+static int
+ForNextCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ ForIterData *iterPtr = data[0];
+ Tcl_Obj *next = iterPtr->next;
+
+ if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
+ TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
+ NULL);
+
+ /*
+ * TIP #280. Make invoking context available to next script.
+ */
+
+ return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
}
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
+
+ TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
+ return result;
+}
+
+static int
+ForPostNextCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ ForIterData *iterPtr = data[0];
+
+ if ((result != TCL_BREAK) && (result != TCL_OK)) {
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)");
+ TclSmallFreeEx(interp, iterPtr);
+ }
+ return result;
}
+ TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
return result;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ForeachObjCmd --
+ * 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.
@@ -1662,42 +2586,57 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ForeachObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- int result = TCL_OK;
- int i; /* i selects a value list */
- int j, maxj; /* Number of loop iterations */
- int v; /* v selects a loop variable */
- int numLists; /* Count of value lists */
- Tcl_Obj *bodyPtr;
+Tcl_ForeachObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRForeachCmd, dummy, objc, objv);
+}
- /*
- * We copy the argument object pointers into a local array to avoid the
- * problem that "objv" might become invalid. It is a pointer into the
- * evaluation stack and that stack might be grown and reallocated if the
- * loop body requires a large amount of stack space.
- */
+int
+TclNRForeachCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
+}
-#define NUM_ARGS 9
- Tcl_Obj *(argObjStorage[NUM_ARGS]);
- Tcl_Obj **argObjv = argObjStorage;
+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);
+}
-#define STATIC_LIST_SIZE 4
- int indexArray[STATIC_LIST_SIZE];
- int varcListArray[STATIC_LIST_SIZE];
- Tcl_Obj **varvListArray[STATIC_LIST_SIZE];
- int argcListArray[STATIC_LIST_SIZE];
- Tcl_Obj **argvListArray[STATIC_LIST_SIZE];
+int
+TclNRLmapCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
+}
- int *index = indexArray; /* Array of value list indices */
- int *varcList = varcListArray; /* # loop variables per list */
- Tcl_Obj ***varvList = varvListArray;/* Array of var name lists */
- int *argcList = argcListArray; /* Array of value list sizes */
- Tcl_Obj ***argvList = argvListArray;/* Array of value lists */
+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;
if (objc < 4 || (objc%2 != 0)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1706,685 +2645,284 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
}
/*
- * Create the object argument array "argObjv". Make sure argObjv is large
- * enough to hold the objc arguments.
- */
-
- if (objc > NUM_ARGS) {
- argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
- }
- for (i=0 ; i<objc ; i++) {
- argObjv[i] = objv[i];
- }
-
- /*
* Manage numList parallel value lists.
- * argvList[i] is a value list counted by argcList[i]l;
- * varvList[i] is the list of variables associated with the value list;
- * varcList[i] is the number of variables associated with the value list;
- * index[i] is the current pointer into the value list argvList[i].
+ * statePtr->argvList[i] is a value list counted by statePtr->argcList[i];
+ * statePtr->varvList[i] is the list of variables associated with the
+ * value list;
+ * statePtr->varcList[i] is the number of variables associated with the
+ * value list;
+ * statePtr->index[i] is the current pointer into the value list
+ * statePtr->argvList[i].
+ *
+ * The setting up of all of these pointers is moderately messy, but allows
+ * the rest of this code to be simple and for us to use a single memory
+ * allocation for better performance.
*/
- numLists = (objc-2)/2;
- if (numLists > STATIC_LIST_SIZE) {
- index = (int *) ckalloc(numLists * sizeof(int));
- varcList = (int *) ckalloc(numLists * sizeof(int));
- varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
- argcList = (int *) ckalloc(numLists * sizeof(int));
- argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
- }
- for (i = 0; i < numLists; i++) {
- index[i] = 0;
- varcList[i] = 0;
- varvList[i] = (Tcl_Obj **) NULL;
- argcList[i] = 0;
- argvList[i] = (Tcl_Obj **) NULL;
+ statePtr = TclStackAlloc(interp,
+ sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
+ + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
+ memset(statePtr, 0,
+ sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
+ + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
+ statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
+ statePtr->argvList = statePtr->varvList + numLists;
+ statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists);
+ statePtr->aCopyList = statePtr->vCopyList + numLists;
+ statePtr->index = (int *) (statePtr->aCopyList + numLists);
+ statePtr->varcList = statePtr->index + numLists;
+ statePtr->argcList = statePtr->varcList + numLists;
+
+ statePtr->numLists = numLists;
+ 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.
*/
- maxj = 0;
for (i=0 ; i<numLists ; i++) {
- result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
- &varcList[i], &varvList[i]);
- if (result != TCL_OK) {
+ statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
+ if (statePtr->vCopyList[i] == NULL) {
+ result = TCL_ERROR;
goto done;
}
- if (varcList[i] < 1) {
- Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
+ TclListObjGetElements(NULL, statePtr->vCopyList[i],
+ &statePtr->varcList[i], &statePtr->varvList[i]);
+ if (statePtr->varcList[i] < 1) {
+ 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;
}
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
- if (result != TCL_OK) {
+ statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
+ if (statePtr->aCopyList[i] == NULL) {
+ result = TCL_ERROR;
goto done;
}
+ TclListObjGetElements(NULL, statePtr->aCopyList[i],
+ &statePtr->argcList[i], &statePtr->argvList[i]);
- j = argcList[i] / varcList[i];
- if ((argcList[i] % varcList[i]) != 0) {
+ j = statePtr->argcList[i] / statePtr->varcList[i];
+ if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
j++;
}
- if (j > maxj) {
- maxj = j;
+ if (j > statePtr->maxj) {
+ statePtr->maxj = j;
}
}
/*
- * Iterate maxj times through the lists in parallel. If some value lists
- * run out of values, set loop vars to ""
+ * If there is any work to do, assign the variables and set things going
+ * non-recursively.
*/
- bodyPtr = argObjv[objc-1];
- for (j=0 ; j<maxj ; j++) {
- for (i=0 ; i<numLists ; i++) {
- /*
- * Refetch the list members; we assume that the sizes are the
- * same, but the array of elements might be different if the
- * internal rep of the objects has been lost and recreated (it is
- * too difficult to accurately tell when this happens, which can
- * lead to some wierd crashes, like Bug #494348...)
- */
-
- result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
- &varcList[i], &varvList[i]);
- if (result != TCL_OK) {
- Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
- }
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
- if (result != TCL_OK) {
- Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
- }
-
- for (v=0 ; v<varcList[i] ; v++) {
- int k = index[i]++;
- Tcl_Obj *valuePtr, *varValuePtr;
- int isEmptyObj = 0;
-
- if (k < argcList[i]) {
- valuePtr = argvList[i][k];
- } else {
- valuePtr = Tcl_NewObj(); /* empty string */
- isEmptyObj = 1;
- }
- varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
- NULL, valuePtr, 0);
- if (varValuePtr == NULL) {
- if (isEmptyObj) {
- Tcl_DecrRefCount(valuePtr);
- }
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set loop variable: \"",
- TclGetString(varvList[i][v]), "\"", (char *) NULL);
- result = TCL_ERROR;
- goto done;
- }
- }
+ if (statePtr->maxj > 0) {
+ result = ForeachAssignments(interp, statePtr);
+ if (result == TCL_ERROR) {
+ goto done;
}
- result = Tcl_EvalObjEx(interp, bodyPtr, 0);
- if (result != TCL_OK) {
- if (result == TCL_CONTINUE) {
- result = TCL_OK;
- } else if (result == TCL_BREAK) {
- result = TCL_OK;
- break;
- } else if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,
- "\n (\"foreach\" body line %d)", interp->errorLine);
- break;
- } else {
- break;
- }
- }
- }
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+ return TclNREvalObjEx(interp, objv[objc-1], 0,
+ ((Interp *) interp)->cmdFramePtr, objc-1);
}
+ /*
+ * This cleanup stage is only used when an error occurs during setup or if
+ * there is no work to do.
+ */
+
+ result = TCL_OK;
done:
- if (numLists > STATIC_LIST_SIZE) {
- ckfree((char *) index);
- ckfree((char *) varcList);
- ckfree((char *) argcList);
- ckfree((char *) varvList);
- ckfree((char *) argvList);
- }
- if (argObjv != argObjStorage) {
- ckfree((char *) argObjv);
- }
+ ForeachCleanup(interp, statePtr);
return result;
-#undef STATIC_LIST_SIZE
-#undef NUM_ARGS
}
-
+
/*
- *----------------------------------------------------------------------
- *
- * Tcl_FormatObjCmd --
- *
- * This procedure is invoked to process the "format" Tcl command. See
- * the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
+ * Post-body processing handler.
*/
- /* ARGSUSED */
-int
-Tcl_FormatObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
-#ifndef NEW_FORMAT
- char *format; /* Used to read characters from the format
- * string. */
- int formatLen; /* The length of the format string */
- char *endPtr; /* Points to the last char in format array */
- char newFormat[43]; /* A new format specifier is generated here. */
- int width; /* Field width from field specifier, or 0 if
- * no width given. */
- int precision; /* Field precision from field specifier, or 0
- * if no precision given. */
- int size; /* Number of bytes needed for result of
- * conversion, based on type of conversion
- * ("e", "s", etc.), width, and precision. */
- long intValue; /* Used to hold value to pass to sprintf, if
- * it's a one-word integer or char value */
- char *ptrValue = NULL; /* Used to hold value to pass to sprintf, if
- * it's a one-word value. */
- double doubleValue; /* Used to hold value to pass to sprintf if
- * it's a double value. */
- Tcl_WideInt wideValue; /* Used to hold value to pass to sprintf if
- * it's a 'long long' value. */
- int whichValue; /* Indicates which of intValue, ptrValue, or
- * doubleValue has the value to pass to
- * sprintf, according to the following
- * definitions: */
-#define INT_VALUE 0
-#define CHAR_VALUE 1
-#define PTR_VALUE 2
-#define DOUBLE_VALUE 3
-#define STRING_VALUE 4
-#define WIDE_VALUE 5
-#define MAX_FLOAT_SIZE 320
-
-#endif
- Tcl_Obj *resultPtr; /* Where result is stored finally. */
-#ifndef NEW_FORMAT
- char staticBuf[MAX_FLOAT_SIZE + 1];
- /* A static buffer to copy the format results
- * into */
- char *dst = staticBuf; /* The buffer that sprintf writes into each
- * time the format processes a specifier */
- int dstSize = MAX_FLOAT_SIZE;
- /* The size of the dst buffer */
- int noPercent; /* Special case for speed: indicates there's
- * no field specifier, just a string to
- * copy. */
- int objIndex; /* Index of argument to substitute next. */
- int gotXpg = 0; /* Non-zero means that an XPG3 %n$-style
- * specifier has been seen. */
- int gotSequential = 0; /* Non-zero means that a regular sequential
- * (non-XPG3) conversion specifier has been
- * seen. */
- int useShort; /* Value to be printed is short (half word). */
- char *end; /* Used to locate end of numerical fields. */
- int stringLen = 0; /* Length of string in characters rather than
- * bytes. Used for %s substitution. */
- int gotMinus; /* Non-zero indicates that a minus flag has
- * been seen in the current field. */
- int gotPrecision; /* Non-zero indicates that a precision has
- * been set for the current field. */
- int gotZero; /* Non-zero indicates that a zero flag has
- * been seen in the current field. */
- int useWide; /* Value to be printed is Tcl_WideInt. */
+static int
+ForeachLoopStep(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ register struct ForeachState *statePtr = data[0];
/*
- * This procedure is a bit nasty. The goal is to use sprintf to do most of
- * the dirty work. There are several problems:
- * 1. this procedure can't trust its arguments.
- * 2. we must be able to provide a large enough result area to hold
- * whatever's generated. This is hard to estimate.
- * 3. there's no way to move the arguments from objv to the call to
- * sprintf in a reasonable way. This is particularly nasty because
- * some of the arguments may be two-word values (doubles and
- * wide-ints).
- * So, what happens here is to scan the format string one % group at a
- * time, making many individual calls to sprintf.
+ * Process the result code from this run of the [foreach] body. Note that
+ * this switch uses fallthroughs in several places. Maintainer aware!
*/
-#endif
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
- return TCL_ERROR;
- }
-
-#ifdef NEW_FORMAT
- resultPtr = Tcl_NewObj();
- Tcl_IncrRefCount(resultPtr);
- if (TclAppendFormattedObjs(interp, resultPtr, Tcl_GetString(objv[1]),
- objc-2, objv+2) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- return TCL_ERROR;
+ 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 finish;
+ case TCL_ERROR:
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%s\" body line %d)",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ Tcl_GetErrorLine(interp)));
+ default:
+ goto done;
}
- Tcl_SetObjResult(interp, resultPtr);
- Tcl_DecrRefCount(resultPtr);
- return TCL_OK;
-#else
- format = Tcl_GetStringFromObj(objv[1], &formatLen);
- endPtr = format + formatLen;
- resultPtr = Tcl_NewObj();
- objIndex = 2;
- while (format < endPtr) {
- register char *newPtr = newFormat;
-
- width = precision = noPercent = useShort = 0;
- gotZero = gotMinus = gotPrecision = 0;
- useWide = 0;
- whichValue = PTR_VALUE;
-
- /*
- * Get rid of any characters before the next field specifier.
- */
-
- if (*format != '%') {
- ptrValue = format;
- while ((*format != '%') && (format < endPtr)) {
- format++;
- }
- size = format - ptrValue;
- noPercent = 1;
- goto doField;
- }
+ /*
+ * Test if there is work still to be done. If so, do the next round of
+ * variable assignments, reschedule ourselves and run the body again.
+ */
- if (format[1] == '%') {
- ptrValue = format;
- size = 1;
- noPercent = 1;
- format += 2;
- goto doField;
+ if (statePtr->maxj > ++statePtr->j) {
+ result = ForeachAssignments(interp, statePtr);
+ if (result == TCL_ERROR) {
+ goto done;
}
- /*
- * Parse off a field specifier, compute how many characters will be
- * needed to store the result, and substitute for "*" size specifiers.
- */
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+ return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
+ ((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
+ }
- *newPtr = '%';
- newPtr++;
- format++;
- if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
- int tmp;
+ /*
+ * We're done. Tidy up our work space and finish off.
+ */
- /*
- * Check for an XPG3-style %n$ specification. Note: there must not
- * be a mixture of XPG3 specs and non-XPG3 specs in the same
- * format string.
- */
+ finish:
+ if (statePtr->resultList == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, statePtr->resultList);
+ statePtr->resultList = NULL; /* Don't clean it up */
+ }
- tmp = strtoul(format, &end, 10); /* INTL: "C" locale. */
- if (*end != '$') {
- goto notXpg;
- }
- format = end+1;
- gotXpg = 1;
- if (gotSequential) {
- goto mixedXPG;
- }
- objIndex = tmp+1;
- if ((objIndex < 2) || (objIndex >= objc)) {
- goto badIndex;
- }
- goto xpgCheckDone;
- }
+ done:
+ ForeachCleanup(interp, statePtr);
+ return result;
+}
- notXpg:
- gotSequential = 1;
- if (gotXpg) {
- goto mixedXPG;
- }
+/*
+ * Factored out code to do the assignments in [foreach].
+ */
- xpgCheckDone:
- while ((*format == '-') || (*format == '#') || (*format == '0')
- || (*format == ' ') || (*format == '+')) {
- if (*format == '-') {
- gotMinus = 1;
- }
- if (*format == '0') {
- /*
- * This will be handled by sprintf for numbers, but we need to
- * do the char/string ones ourselves.
- */
+static inline int
+ForeachAssignments(
+ Tcl_Interp *interp,
+ struct ForeachState *statePtr)
+{
+ int i, v, k;
+ Tcl_Obj *valuePtr, *varValuePtr;
- gotZero = 1;
- }
- *newPtr = *format;
- newPtr++;
- format++;
- }
- if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
- width = strtoul(format, &end, 10); /* INTL: Tcl source. */
- format = end;
- } else if (*format == '*') {
- if (objIndex >= objc) {
- goto badIndex;
- }
- if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &width) != TCL_OK) {
- goto fmtError;
- }
- if (width < 0) {
- width = -width;
- *newPtr = '-';
- gotMinus = 1;
- newPtr++;
- }
- objIndex++;
- format++;
- }
- if (width > 100000) {
- /*
- * Don't allow arbitrarily large widths: could cause core dump
- * when we try to allocate a zillion bytes of memory below.
- */
+ for (i=0 ; i<statePtr->numLists ; i++) {
+ for (v=0 ; v<statePtr->varcList[i] ; v++) {
+ k = statePtr->index[i]++;
- width = 100000;
- } else if (width < 0) {
- width = 0;
- }
- if (width != 0) {
- TclFormatInt(newPtr, width); /* INTL: printf format. */
- while (*newPtr != 0) {
- newPtr++;
- }
- }
- if (*format == '.') {
- *newPtr = '.';
- newPtr++;
- format++;
- gotPrecision = 1;
- }
- if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
- precision = strtoul(format, &end, 10); /* INTL: "C" locale. */
- format = end;
- } else if (*format == '*') {
- if (objIndex >= objc) {
- goto badIndex;
- }
- if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &precision) != TCL_OK) {
- goto fmtError;
- }
- objIndex++;
- format++;
- }
- if (gotPrecision) {
- TclFormatInt(newPtr, precision); /* INTL: printf format. */
- while (*newPtr != 0) {
- newPtr++;
+ if (k < statePtr->argcList[i]) {
+ valuePtr = statePtr->argvList[i][k];
+ } else {
+ TclNewObj(valuePtr); /* Empty string */
}
- }
- if (*format == 'l') {
- useWide = 1;
- /*
- * Only add a 'll' modifier for integer values as it makes some
- * libc's go into spasm otherwise. [Bug #702622]
- */
+ varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v],
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
- switch (format[1]) {
- case 'i':
- case 'd':
- case 'o':
- case 'u':
- case 'x':
- case 'X':
- strcpy(newPtr, TCL_LL_MODIFIER);
- newPtr += TCL_LL_MODIFIER_SIZE;
+ if (varValuePtr == NULL) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (setting %s loop variable \"%s\")",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ TclGetString(statePtr->varvList[i][v])));
+ return TCL_ERROR;
}
- format++;
- } else if (*format == 'h') {
- useShort = 1;
- *newPtr = 'h';
- newPtr++;
- format++;
- }
- *newPtr = *format;
- newPtr++;
- *newPtr = 0;
- if (objIndex >= objc) {
- goto badIndex;
}
- switch (*format) {
- case 'i':
- newPtr[-1] = 'd';
- case 'd':
- case 'o':
- case 'u':
- case 'x':
- case 'X':
- if (useWide) {
- if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &wideValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = WIDE_VALUE;
- size = 40 + precision;
- break;
- }
- if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &intValue) != TCL_OK) {
- goto fmtError;
- }
-#if (LONG_MAX > INT_MAX)
- if (!useShort) {
- /*
- * Add the 'l' for long format type because we are on an LP64
- * archtecture and we are really going to pass a long argument
- * to sprintf.
- *
- * Do not add this if we're going to pass in a short (i.e. if
- * we've got an 'h' modifier already in the string); some libc
- * implementations of sprintf() do not like it at all. [Bug
- * 1154163]
- */
-
- newPtr++;
- *newPtr = 0;
- newPtr[-1] = newPtr[-2];
- newPtr[-2] = 'l';
- }
-#endif /* LONG_MAX > INT_MAX */
- whichValue = INT_VALUE;
- size = 40 + precision;
- break;
- case 's':
- /*
- * Compute the length of the string in characters and add any
- * additional space required by the field width. All of the extra
- * characters will be spaces, so one byte per character is
- * adequate.
- */
+ }
- whichValue = STRING_VALUE;
- ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
- stringLen = Tcl_NumUtfChars(ptrValue, size);
- if (gotPrecision && (precision < stringLen)) {
- stringLen = precision;
- }
- size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
- if (width > stringLen) {
- size += (width - stringLen);
- }
- break;
- case 'c':
- if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &intValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = CHAR_VALUE;
- size = width + TCL_UTF_MAX;
- break;
- case 'e':
- case 'E':
- case 'f':
- case 'g':
- case 'G':
- if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &doubleValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = DOUBLE_VALUE;
- size = MAX_FLOAT_SIZE;
- if (precision > 10) {
- size += precision;
- }
- break;
- case 0:
- Tcl_SetResult(interp,
- "format string ended in middle of field specifier",
- TCL_STATIC);
- goto fmtError;
- default:
- {
- char buf[40];
-
- sprintf(buf, "bad field specifier \"%c\"", *format);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- goto fmtError;
- }
- }
- objIndex++;
- format++;
+ return TCL_OK;
+}
- /*
- * Make sure that there's enough space to hold the formatted result,
- * then format it.
- */
+/*
+ * Factored out code for cleaning up the state of the foreach.
+ */
+
+static inline void
+ForeachCleanup(
+ Tcl_Interp *interp,
+ struct ForeachState *statePtr)
+{
+ int i;
- doField:
- if (width > size) {
- size = width;
+ for (i=0 ; i<statePtr->numLists ; i++) {
+ if (statePtr->vCopyList[i]) {
+ TclDecrRefCount(statePtr->vCopyList[i]);
}
- if (noPercent) {
- Tcl_AppendToObj(resultPtr, ptrValue, size);
- } else {
- if (size > dstSize) {
- if (dst != staticBuf) {
- ckfree(dst);
- }
- dst = (char *) ckalloc((unsigned) (size + 1));
- dstSize = size;
- }
- switch (whichValue) {
- case DOUBLE_VALUE:
- sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
- break;
- case WIDE_VALUE:
- sprintf(dst, newFormat, wideValue);
- break;
- case INT_VALUE:
- if (useShort) {
- sprintf(dst, newFormat, (short) intValue);
- } else {
- sprintf(dst, newFormat, intValue);
- }
- break;
- case CHAR_VALUE: {
- char *ptr;
- char padChar = (gotZero ? '0' : ' ');
- ptr = dst;
- if (!gotMinus) {
- for ( ; --width > 0; ptr++) {
- *ptr = padChar;
- }
- }
- ptr += Tcl_UniCharToUtf(intValue, ptr);
- for ( ; --width > 0; ptr++) {
- *ptr = padChar;
- }
- *ptr = '\0';
- break;
- }
- case STRING_VALUE: {
- char *ptr;
- char padChar = (gotZero ? '0' : ' ');
- int pad;
-
- ptr = dst;
- if (width > stringLen) {
- pad = width - stringLen;
- } else {
- pad = 0;
- }
-
- if (!gotMinus) {
- while (pad > 0) {
- *ptr++ = padChar;
- pad--;
- }
- }
-
- size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
- if (size) {
- memcpy(ptr, ptrValue, (size_t) size);
- ptr += size;
- }
- while (pad > 0) {
- *ptr++ = padChar;
- pad--;
- }
- *ptr = '\0';
- break;
- }
- default:
- sprintf(dst, newFormat, ptrValue);
- break;
- }
- Tcl_AppendToObj(resultPtr, dst, -1);
+ if (statePtr->aCopyList[i]) {
+ TclDecrRefCount(statePtr->aCopyList[i]);
}
}
-
- Tcl_SetObjResult(interp, resultPtr);
- if (dst != staticBuf) {
- ckfree(dst);
+ if (statePtr->resultList != NULL) {
+ TclDecrRefCount(statePtr->resultList);
}
- return TCL_OK;
+ TclStackFree(interp, statePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FormatObjCmd --
+ *
+ * This procedure is invoked to process the "format" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- mixedXPG:
- Tcl_SetResult(interp,
- "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
- goto fmtError;
+ /* ARGSUSED */
+int
+Tcl_FormatObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *resultPtr; /* Where result is stored finally. */
- badIndex:
- if (gotXpg) {
- Tcl_SetResult(interp,
- "\"%n$\" argument index out of range", TCL_STATIC);
- } else {
- Tcl_SetResult(interp,
- "not enough arguments for all format specifiers", TCL_STATIC);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
+ return TCL_ERROR;
}
- fmtError:
- if (dst != staticBuf) {
- ckfree(dst);
+ resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2);
+ if (resultPtr == NULL) {
+ return TCL_ERROR;
}
- Tcl_DecrRefCount(resultPtr);
- return TCL_ERROR;
-#endif
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
}
/*
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b98cf56..41c1eb6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -3,20 +3,18 @@
*
* This file contains the top-level command routines for most of the Tcl
* built-in commands whose names begin with the letters I through L. It
- * contains only commands in the generic core (i.e. those that don't
+ * contains only commands in the generic core (i.e., those that don't
* depend much upon UNIX facilities).
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2005 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: tclCmdIL.c,v 1.81 2005/09/14 21:32:17 dgp Exp $
*/
#include "tclInt.h"
@@ -29,8 +27,16 @@
*/
typedef struct SortElement {
- Tcl_Obj *objPtr; /* Object being sorted. */
- int count; /* number of same elements in list */
+ union { /* The value that we sorting by. */
+ const char *strValuePtr;
+ long intValue;
+ double doubleValue;
+ Tcl_Obj *objValuePtr;
+ } 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;
@@ -53,12 +59,10 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
- * defined below */
- SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
- * ASCII mode). */
+ * defined below. */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
* SORTMODE_COMMAND. Pre-initialized to hold
- * base of command.*/
+ * base of command. */
int *indexv; /* If the -index option was specified, this
* holds the indexes contained in the list
* supplied as an argument to that option.
@@ -67,6 +71,8 @@ typedef struct SortInfo {
* supplied. */
int indexc; /* Number of indexes in indexv array. */
int singleIndex; /* Static space for common index case. */
+ int unique;
+ int numElements;
Tcl_Interp *interp; /* The interpreter in which the sort is being
* done. */
int resultCode; /* Completion code for the lsort command. If
@@ -84,6 +90,7 @@ typedef struct SortInfo {
#define SORTMODE_REAL 2
#define SORTMODE_COMMAND 3
#define SORTMODE_DICTIONARY 4
+#define SORTMODE_ASCII_NC 8
/*
* Magic values for the index field of the SortInfo structure. Note that the
@@ -97,59 +104,89 @@ typedef struct SortInfo {
* Forward declarations for procedures defined in this file:
*/
-static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
- CONST char *pattern, int includeLinks);
-static int DictionaryCompare(char *left, char *right);
+static int DictionaryCompare(const char *left, const char *right);
+static int IfConditionCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static int InfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
+/* TIP #348 - New 'info' subcommand 'errorstack' */
+static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+/* TIP #280 - New 'info' subcommand 'frame' */
+static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static int InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static int InfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoNameOfExecutableCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static int InfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static SortElement * MergeSort(SortElement *headPt, SortInfo *infoPtr);
-static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
+ int objc, Tcl_Obj *const objv[]);
+static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
SortInfo *infoPtr);
-static int SortCompare(Tcl_Obj *firstPtr, Tcl_Obj *second,
+static int SortCompare(SortElement *firstPtr, SortElement *second,
SortInfo *infoPtr);
static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
SortInfo *infoPtr);
+
+/*
+ * Array of values describing how to implement each standard subcommand of the
+ * "info" command.
+ */
+
+static const EnsembleImplMap defaultInfoMap[] = {
+ {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0},
+ {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
+ {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0},
+ {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0},
+ {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0},
+ {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
/*
*----------------------------------------------------------------------
@@ -172,46 +209,73 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_IfObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_IfObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int thenScriptIndex = 0; /* "then" script to be evaled after
- * syntax check */
- int i, result, value;
- char *clause;
- i = 1;
- while (1) {
- /*
- * At this point in the loop, objv and objc refer to an expression to
- * test, either for the main expression or an expression following an
- * "elseif". The arguments after the expression must be "then"
- * (optional) and a script to execute if the expression is true.
- */
+ return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv);
+}
- if (i >= objc) {
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: no expression after \"",
- clause, "\" argument", (char *) NULL);
- return TCL_ERROR;
- }
- if (!thenScriptIndex) {
- result = Tcl_ExprBooleanObj(interp, objv[i], &value);
- if (result != TCL_OK) {
- return result;
- }
- }
+int
+TclNRIfObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *boolObj;
+
+ if (objc <= 1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point, objv[1] refers to the main expression to test. The
+ * arguments after the expression must be "then" (optional) and a script
+ * to execute if the expression is true.
+ */
+
+ TclNewObj(boolObj);
+ Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
+ (ClientData) objv, INT2PTR(1), boolObj);
+ return Tcl_NRExprObj(interp, objv[1], boolObj);
+}
+
+static int
+IfConditionCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ int objc = PTR2INT(data[0]);
+ Tcl_Obj *const *objv = data[1];
+ int i = PTR2INT(data[2]);
+ Tcl_Obj *boolObj = data[3];
+ int value, thenScriptIndex = 0;
+ const char *clause;
+
+ if (result != TCL_OK) {
+ TclDecrRefCount(boolObj);
+ return result;
+ }
+ if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
+ TclDecrRefCount(boolObj);
+ return TCL_ERROR;
+ }
+ TclDecrRefCount(boolObj);
+
+ while (1) {
i++;
if (i >= objc) {
- missingScript:
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: no script following \"",
- clause, "\" argument", (char *) NULL);
- return TCL_ERROR;
+ goto missingScript;
}
clause = TclGetString(objv[i]);
if ((i < objc) && (strcmp(clause, "then") == 0)) {
@@ -233,16 +297,41 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
i++;
if (i >= objc) {
if (thenScriptIndex) {
- return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+ /*
+ * TIP #280. Make invoking context available to branch.
+ */
+
+ return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
+ iPtr->cmdFramePtr, thenScriptIndex);
}
return TCL_OK;
}
clause = TclGetString(objv[i]);
- if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
- i++;
- continue;
+ if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) {
+ break;
+ }
+ i++;
+
+ /*
+ * At this point in the loop, objv and objc refer to an expression to
+ * test, either for the main expression or an expression following an
+ * "elseif". The arguments after the expression must be "then"
+ * (optional) and a script to execute if the expression is true.
+ */
+
+ if (i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ clause));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+ return TCL_ERROR;
+ }
+ if (!thenScriptIndex) {
+ TclNewObj(boolObj);
+ Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
+ INT2PTR(i), boolObj);
+ return Tcl_NRExprObj(interp, objv[i], boolObj);
}
- break;
}
/*
@@ -254,22 +343,32 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
if (strcmp(clause, "else") == 0) {
i++;
if (i >= objc) {
- Tcl_AppendResult(interp,
- "wrong # args: no script following \"else\" argument",
- (char *) NULL);
- return TCL_ERROR;
+ goto missingScript;
}
}
if (i < objc - 1) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong # args: extra words after \"else\" clause in \"if\" command",
- (char *) NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
if (thenScriptIndex) {
- return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+ /*
+ * TIP #280. Make invoking context available to branch/else.
+ */
+
+ return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
+ iPtr->cmdFramePtr, thenScriptIndex);
}
- return Tcl_EvalObjEx(interp, objv[i], 0);
+ return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
+
+ missingScript:
+ 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;
}
/*
@@ -293,70 +392,30 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_IncrObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_IncrObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- long incrAmount = 1;
- Tcl_WideInt wideIncrAmount;
- Tcl_Obj *newValuePtr;
- int isWide = 0;
+ Tcl_Obj *newValuePtr, *incrPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
return TCL_ERROR;
}
- /*
- * Calculate the amount to increment by.
- */
-
if (objc == 3) {
- /*
- * Need to be a bit cautious to ensure that [expr]-like rules are
- * enforced for interpretation of wide integers, despite the fact that
- * the underlying API itself is a 'long' only one.
- */
-
- if (objv[2]->typePtr == &tclIntType) {
- incrAmount = objv[2]->internalRep.longValue;
- isWide = 0;
- } else if (objv[2]->typePtr == &tclWideIntType) {
- wideIncrAmount = objv[2]->internalRep.wideValue;
- isWide = 1;
- } else {
- if (Tcl_GetWideIntFromObj(interp, objv[2],
- &wideIncrAmount) != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (reading increment)");
- return TCL_ERROR;
- }
- if ((wideIncrAmount <= Tcl_LongAsWide(LONG_MAX))
- && (wideIncrAmount >= Tcl_LongAsWide(LONG_MIN))) {
- incrAmount = Tcl_WideAsLong(wideIncrAmount);
- objv[2]->typePtr = &tclIntType;
- objv[2]->internalRep.longValue = incrAmount;
- isWide = 0;
- } else {
- isWide = 1;
- }
- }
- }
-
- /*
- * Increment the variable's value.
- */
-
- if (isWide) {
- newValuePtr = TclIncrWideVar2(interp, objv[1], (Tcl_Obj *) NULL,
- wideIncrAmount, TCL_LEAVE_ERR_MSG);
+ incrPtr = objv[2];
} else {
- newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL,
- incrAmount, TCL_LEAVE_ERR_MSG);
+ incrPtr = Tcl_NewIntObj(1);
}
+ Tcl_IncrRefCount(incrPtr);
+ newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
+ incrPtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(incrPtr);
+
if (newValuePtr == NULL) {
return TCL_ERROR;
}
@@ -373,121 +432,25 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_InfoObjCmd --
+ * TclInitInfoCmd --
*
- * This procedure is invoked to process the "info" Tcl command. See the
- * user documentation for details on what it does.
+ * This function is called to create the "info" Tcl command. See the user
+ * documentation for details on what it does.
*
* Results:
- * A standard Tcl result.
+ * Handle for the info command, or NULL on failure.
*
* Side effects:
- * See the user documentation.
+ * none
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-int
-Tcl_InfoObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Arbitrary value passed to the command. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_Command
+TclInitInfoCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
{
- static CONST char *subCmds[] = {
- "args", "body", "cmdcount", "commands",
- "complete", "default", "exists", "functions", "globals",
- "hostname", "level", "library", "loaded",
- "locals", "nameofexecutable", "patchlevel", "procs",
- "script", "sharedlibextension", "tclversion", "vars",
- (char *) NULL};
- enum ISubCmdIdx {
- IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
- ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
- IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
- ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
- IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
- };
- int index, result;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
- return TCL_ERROR;
- }
-
- result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
- (int *) &index);
- if (result != TCL_OK) {
- return result;
- }
-
- switch (index) {
- case IArgsIdx:
- result = InfoArgsCmd(clientData, interp, objc, objv);
- break;
- case IBodyIdx:
- result = InfoBodyCmd(clientData, interp, objc, objv);
- break;
- case ICmdCountIdx:
- result = InfoCmdCountCmd(clientData, interp, objc, objv);
- break;
- case ICommandsIdx:
- result = InfoCommandsCmd(clientData, interp, objc, objv);
- break;
- case ICompleteIdx:
- result = InfoCompleteCmd(clientData, interp, objc, objv);
- break;
- case IDefaultIdx:
- result = InfoDefaultCmd(clientData, interp, objc, objv);
- break;
- case IExistsIdx:
- result = InfoExistsCmd(clientData, interp, objc, objv);
- break;
- case IFunctionsIdx:
- result = InfoFunctionsCmd(clientData, interp, objc, objv);
- break;
- case IGlobalsIdx:
- result = InfoGlobalsCmd(clientData, interp, objc, objv);
- break;
- case IHostnameIdx:
- result = InfoHostnameCmd(clientData, interp, objc, objv);
- break;
- case ILevelIdx:
- result = InfoLevelCmd(clientData, interp, objc, objv);
- break;
- case ILibraryIdx:
- result = InfoLibraryCmd(clientData, interp, objc, objv);
- break;
- case ILoadedIdx:
- result = InfoLoadedCmd(clientData, interp, objc, objv);
- break;
- case ILocalsIdx:
- result = InfoLocalsCmd(clientData, interp, objc, objv);
- break;
- case INameOfExecutableIdx:
- result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
- break;
- case IPatchLevelIdx:
- result = InfoPatchLevelCmd(clientData, interp, objc, objv);
- break;
- case IProcsIdx:
- result = InfoProcsCmd(clientData, interp, objc, objv);
- break;
- case IScriptIdx:
- result = InfoScriptCmd(clientData, interp, objc, objv);
- break;
- case ISharedLibExtensionIdx:
- result = InfoSharedlibCmd(clientData, interp, objc, objv);
- break;
- case ITclVersionIdx:
- result = InfoTclVersionCmd(clientData, interp, objc, objv);
- break;
- case IVarsIdx:
- result = InfoVarsCmd(clientData, interp, objc, objv);
- break;
- }
- return result;
+ return TclMakeEnsemble(interp, "info", defaultInfoMap);
}
/*
@@ -511,28 +474,29 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
*/
static int
-InfoArgsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoArgsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
- char *name;
+ const char *name;
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *listObjPtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "procname");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "procname");
return TCL_ERROR;
}
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name,
- "\" isn't a procedure", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -540,7 +504,7 @@ InfoArgsCmd(dummy, interp, objc, objv)
* Build a return list containing the arguments.
*/
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ listObjPtr = Tcl_NewListObj(0, NULL);
for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
localPtr = localPtr->nextPtr) {
if (TclIsVarArgument(localPtr)) {
@@ -573,27 +537,28 @@ InfoArgsCmd(dummy, interp, objc, objv)
*/
static int
-InfoBodyCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoBodyCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
- char *name;
+ const char *name;
Proc *procPtr;
Tcl_Obj *bodyPtr, *resultPtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "procname");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "procname");
return TCL_ERROR;
}
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name,
- "\" isn't a procedure", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -613,7 +578,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
* run before. [Bug #545644]
*/
- (void) Tcl_GetString(bodyPtr);
+ TclGetString(bodyPtr);
}
resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
@@ -643,16 +608,16 @@ InfoBodyCmd(dummy, interp, objc, objv)
*/
static int
-InfoCmdCountCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoCmdCountCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -685,14 +650,14 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
*/
static int
-InfoCommandsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoCommandsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *cmdName, *pattern;
- CONST char *simplePattern;
+ const char *cmdName, *pattern;
+ const char *simplePattern;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Namespace *nsPtr;
@@ -708,11 +673,11 @@ InfoCommandsCmd(dummy, interp, objc, objv)
* commands.
*/
- if (objc == 2) {
+ if (objc == 1) {
simplePattern = NULL;
nsPtr = currNsPtr;
specificNsInPattern = 0;
- } else if (objc == 3) {
+ } else if (objc == 2) {
/*
* From the pattern, get the effective namespace and the simple
* pattern (no namespace qualifiers or ::'s) at the end. If an error
@@ -723,15 +688,15 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = TclGetString(objv[2]);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+ pattern = TclGetString(objv[1]);
+ TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
+ &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
- if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
return TCL_ERROR;
}
@@ -750,7 +715,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
* name.
*/
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ listPtr = Tcl_NewListObj(0, NULL);
if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
/*
@@ -761,7 +726,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
if (entryPtr != NULL) {
if (specificNsInPattern) {
- cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+ cmd = Tcl_GetHashValue(entryPtr);
elemObjPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
} else {
@@ -773,7 +738,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
return TCL_OK;
}
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- Tcl_HashTable *tablePtr = NULL; /* Quell warning */
+ Tcl_HashTable *tablePtr = NULL; /* Quell warning. */
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
@@ -812,7 +777,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
if ((simplePattern == NULL)
|| Tcl_StringMatch(cmdName, simplePattern)) {
if (specificNsInPattern) {
- cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+ cmd = Tcl_GetHashValue(entryPtr);
elemObjPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
} else {
@@ -837,7 +802,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
if ((simplePattern == NULL)
|| Tcl_StringMatch(cmdName, simplePattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+ if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(cmdName, -1));
}
@@ -871,7 +836,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
(void) Tcl_CreateHashEntry(&addedCommandsTable,
- (char *)elemObjPtr, &isNew);
+ elemObjPtr, &isNew);
}
entryPtr = Tcl_NextHashEntry(&search);
}
@@ -896,7 +861,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
|| Tcl_StringMatch(cmdName, simplePattern)) {
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
(void) Tcl_CreateHashEntry(&addedCommandsTable,
- (char *) elemObjPtr, &isNew);
+ elemObjPtr, &isNew);
if (isNew) {
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
} else {
@@ -962,23 +927,19 @@ InfoCommandsCmd(dummy, interp, objc, objv)
*/
static int
-InfoCompleteCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoCompleteCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "command");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command");
return TCL_ERROR;
}
- if (TclObjCommandComplete(objv[2])) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- }
-
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ TclObjCommandComplete(objv[1])));
return TCL_OK;
}
@@ -1003,30 +964,32 @@ InfoCompleteCmd(dummy, interp, objc, objv)
*/
static int
-InfoDefaultCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoDefaultCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- char *procName, *argName, *varName;
+ const char *procName, *argName;
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *valueObjPtr;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
return TCL_ERROR;
}
- procName = TclGetString(objv[2]);
- argName = TclGetString(objv[3]);
+ procName = TclGetString(objv[1]);
+ argName = TclGetString(objv[2]);
procPtr = TclFindProc(iPtr, procName);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", procName,
- "\" isn't a procedure", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", procName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
+ NULL);
return TCL_ERROR;
}
@@ -1035,24 +998,19 @@ InfoDefaultCmd(dummy, interp, objc, objv)
if (TclIsVarArgument(localPtr)
&& (strcmp(argName, localPtr->name) == 0)) {
if (localPtr->defValuePtr != NULL) {
- valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
- localPtr->defValuePtr, 0);
+ valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
+ localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
if (valueObjPtr == NULL) {
- defStoreError:
- varName = TclGetString(objv[4]);
- Tcl_AppendResult(interp,
- "couldn't store default value in variable \"",
- varName, "\"", (char *) NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
- valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
- nullObjPtr, 0);
+
+ valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
+ nullObjPtr, TCL_LEAVE_ERR_MSG);
if (valueObjPtr == NULL) {
- Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
- goto defStoreError;
+ return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
}
@@ -1060,20 +1018,22 @@ InfoDefaultCmd(dummy, interp, objc, objv)
}
}
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\" doesn't have an argument \"", argName, "\"", (char *) 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;
}
/*
*----------------------------------------------------------------------
*
- * InfoExistsCmd --
+ * InfoErrorStackCmd --
*
- * Called to implement the "info exists" command that determines whether
- * a variable exists. Handles the following syntax:
+ * Called to implement the "info errorstack" command that returns information
+ * about the last error's call stack. Handles the following syntax:
*
- * info exists varName
+ * info errorstack ?interp?
*
* Results:
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1086,40 +1046,43 @@ InfoDefaultCmd(dummy, interp, objc, objv)
*/
static int
-InfoExistsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoErrorStackCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *varName;
- Var *varPtr;
+ Tcl_Interp *target;
+ Interp *iPtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName");
+ if ((objc != 1) && (objc != 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
return TCL_ERROR;
}
- varName = TclGetString(objv[2]);
- varPtr = TclVarTraceExists(interp, varName);
- if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ target = interp;
+ if (objc == 2) {
+ 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;
}
/*
*----------------------------------------------------------------------
*
- * InfoFunctionsCmd --
+ * TclInfoExistsCmd --
*
- * Called to implement the "info functions" command that returns the list
- * of math functions matching an optional pattern. Handles the following
- * syntax:
+ * Called to implement the "info exists" command that determines whether
+ * a variable exists. Handles the following syntax:
*
- * info functions ?pattern?
+ * info exists varName
*
* Results:
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1131,43 +1094,40 @@ InfoExistsCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-static int
-InfoFunctionsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+int
+TclInfoExistsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *pattern;
- Tcl_Obj *listPtr;
+ const char *varName;
+ Var *varPtr;
- if (objc == 2) {
- pattern = NULL;
- } else if (objc == 3) {
- pattern = TclGetString(objv[2]);
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName");
return TCL_ERROR;
}
- listPtr = Tcl_ListMathFuncs(interp, pattern);
- if (listPtr == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, listPtr);
+ varName = TclGetString(objv[1]);
+ varPtr = TclVarTraceExists(interp, varName);
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * InfoGlobalsCmd --
+ * InfoFrameCmd --
+ * TIP #280
*
- * Called to implement the "info globals" command that returns the list
- * of global variables matching an optional pattern. Handles the
+ * Called to implement the "info frame" command that returns the location
+ * of either the currently executing command, or its caller. Handles the
* following syntax:
*
- * info globals ?pattern?
+ * info frame ?number?
*
* Results:
* Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1180,69 +1140,380 @@ InfoFunctionsCmd(dummy, interp, objc, objv)
*/
static int
-InfoGlobalsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoFrameCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *varName, *pattern;
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- register Tcl_HashEntry *entryPtr;
- Tcl_HashSearch search;
- Var *varPtr;
- Tcl_Obj *listPtr;
+ Interp *iPtr = (Interp *) interp;
+ int level, code = TCL_OK;
+ CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ int topLevel = 0;
- if (objc == 2) {
- pattern = NULL;
- } else if (objc == 3) {
- pattern = TclGetString(objv[2]);
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+ return TCL_ERROR;
+ }
+
+ while (corPtr) {
+ while (*cmdFramePtrPtr) {
+ topLevel++;
+ cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+ }
+ if (corPtr->caller.cmdFramePtr) {
+ *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+ }
+ corPtr = corPtr->callerEEPtr->corPtr;
+ }
+ topLevel += (*cmdFramePtrPtr)->level;
+
+ if (topLevel != iPtr->cmdFramePtr->level) {
+ framePtr = iPtr->cmdFramePtr;
+ while (framePtr) {
+ framePtr->level = topLevel--;
+ framePtr = framePtr->nextPtr;
+ }
+ if (topLevel) {
+ Tcl_Panic("Broken frame level calculation");
+ }
+ topLevel = iPtr->cmdFramePtr->level;
+ }
+
+ if (objc == 1) {
/*
- * Strip leading global-namespace qualifiers. [Bug 1057461]
+ * Just "info frame".
*/
- if (pattern[0] == ':' && pattern[1] == ':') {
- while (*pattern == ':') {
- pattern++;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
+ goto done;
+ }
+
+ /*
+ * We've got "info frame level" and must parse the level first.
+ */
+
+ if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if ((level > topLevel) || (level <= - topLevel)) {
+ levelError:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
+ TclGetString(objv[1]), NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Let us convert to relative so that we know how many levels to go back
+ */
+
+ if (level > 0) {
+ level -= topLevel;
+ }
+
+ framePtr = iPtr->cmdFramePtr;
+ while (++level <= 0) {
+ framePtr = framePtr->nextPtr;
+ if (!framePtr) {
+ goto levelError;
+ }
+ }
+
+ Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
+
+ done:
+ cmdFramePtrPtr = &iPtr->cmdFramePtr;
+ corPtr = iPtr->execEnvPtr->corPtr;
+ while (corPtr) {
+ CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+ if (endPtr) {
+ if (*cmdFramePtrPtr == endPtr) {
+ *cmdFramePtrPtr = NULL;
+ } else {
+ CmdFrame *runPtr = *cmdFramePtrPtr;
+
+ while (runPtr->nextPtr != endPtr) {
+ runPtr->level -= endPtr->level;
+ runPtr = runPtr->nextPtr;
+ }
+ runPtr->level = 1;
+ runPtr->nextPtr = NULL;
}
+ cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
}
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
- return TCL_ERROR;
+ corPtr = corPtr->callerEEPtr->corPtr;
}
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoFrame --
+ *
+ * Core of InfoFrameCmd, returns TIP280 dict for a given frame.
+ *
+ * Results:
+ * Returns TIP280 dict.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TclInfoFrame(
+ Tcl_Interp *interp, /* Current interpreter. */
+ CmdFrame *framePtr) /* Frame to get info for. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *tmpObj;
+ Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
+ * the dict. */
+ int lc = 0;
/*
- * Scan through the global :: namespace's variable table and create a list
- * of all global variables that match the pattern.
+ * This array is indexed by the TCL_LOCATION_... values, except
+ * for _LAST.
*/
+ static const char *const typeString[TCL_LOCATION_LAST] = {
+ "eval", "eval", "eval", "precompiled", "source", "proc"
+ };
+ Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- if (pattern != NULL && TclMatchIsTrivial(pattern)) {
- entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
- if (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(pattern, -1));
- }
+ /*
+ * Pull the information and construct the dictionary to return, as list.
+ * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
+ */
+
+#define ADD_PAIR(name, value) \
+ TclNewLiteralStringObj(tmpObj, name); \
+ lv[lc++] = tmpObj; \
+ lv[lc++] = (value)
+
+ switch (framePtr->type) {
+ case TCL_LOCATION_EVAL:
+ /*
+ * Evaluation, dynamic script. Type, line, cmd, the latter through
+ * str.
+ */
+
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ if (framePtr->line) {
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ } else {
+ ADD_PAIR("line", Tcl_NewIntObj(1));
}
- } else {
- for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (TclIsVarUndefined(varPtr)) {
- continue;
+ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
+ break;
+
+ case TCL_LOCATION_PREBC:
+ /*
+ * Precompiled. Result contains the type as signal, nothing else.
+ */
+
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ break;
+
+ case TCL_LOCATION_BC: {
+ /*
+ * Execution of bytecode. Talk to the BC engine to fill out the frame.
+ */
+
+ CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+
+ *fPtr = *framePtr;
+
+ /*
+ * Note:
+ * Type BC => f.data.eval.path is not used.
+ * f.data.tebc.codePtr is used instead.
+ */
+
+ TclGetSrcInfoForPc(fPtr);
+
+ /*
+ * Now filled: cmd.str.(cmd,len), line
+ * Possibly modified: type, path!
+ */
+
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
+ if (fPtr->line) {
+ ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
+ }
+
+ if (fPtr->type == TCL_LOCATION_SOURCE) {
+ ADD_PAIR("file", fPtr->data.eval.path);
+
+ /*
+ * Death of reference by TclGetSrcInfoForPc.
+ */
+
+ Tcl_DecrRefCount(fPtr->data.eval.path);
+ }
+
+ ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
+ TclStackFree(interp, fPtr);
+ break;
+ }
+
+ case TCL_LOCATION_SOURCE:
+ /*
+ * Evaluation of a script file.
+ */
+
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ ADD_PAIR("file", framePtr->data.eval.path);
+
+ /*
+ * Refcount framePtr->data.eval.path goes up when lv is converted into
+ * the result list object.
+ */
+
+ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
+ break;
+
+ case TCL_LOCATION_PROC:
+ Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
+ break;
+ }
+
+ /*
+ * 'proc'. Common to all frame types. Conditional on having an associated
+ * Procedure CallFrame.
+ */
+
+ if (procPtr != NULL) {
+ Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
+
+ if (namePtr) {
+ Tcl_Obj *procNameObj;
+
+ /*
+ * This is a regular command.
+ */
+
+ TclNewObj(procNameObj);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
+ procNameObj);
+ ADD_PAIR("proc", procNameObj);
+ } else if (procPtr->cmdPtr->clientData) {
+ ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
+ int i;
+
+ /*
+ * This is a non-standard command. Luckily, it's told us how to
+ * render extra information about its frame.
+ */
+
+ for (i=0 ; i<efiPtr->length ; i++) {
+ lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
+ if (efiPtr->fields[i].proc) {
+ lv[lc++] =
+ efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
+ } else {
+ lv[lc++] = efiPtr->fields[i].clientData;
+ }
}
- varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
- if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(varName, -1));
+ }
+ }
+
+ /*
+ * 'level'. Common to all frame types. Conditional on having an associated
+ * _visible_ CallFrame.
+ */
+
+ if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
+ CallFrame *current = framePtr->framePtr;
+ CallFrame *top = iPtr->varFramePtr;
+ CallFrame *idx;
+
+ for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
+ if (idx == current) {
+ int c = framePtr->framePtr->level;
+ int t = iPtr->varFramePtr->level;
+
+ ADD_PAIR("level", Tcl_NewIntObj(t - c));
+ break;
}
}
}
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
+
+ return Tcl_NewListObj(lc, lv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoFunctionsCmd --
+ *
+ * Called to implement the "info functions" command that returns the list
+ * of math functions matching an optional pattern. Handles the following
+ * syntax:
+ *
+ * info functions ?pattern?
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If there is an
+ * error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoFunctionsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *script;
+ int code;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ 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;
}
/*
@@ -1266,15 +1537,16 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
*/
static int
-InfoHostnameCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoHostnameCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- CONST char *name;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ const char *name;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -1282,11 +1554,12 @@ InfoHostnameCmd(dummy, interp, objc, objv)
if (name) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
return TCL_OK;
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unable to determine name of host", -1));
- return TCL_ERROR;
}
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to determine name of host", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
+ return TCL_ERROR;
}
/*
@@ -1310,53 +1583,55 @@ InfoHostnameCmd(dummy, interp, objc, objv)
*/
static int
-InfoLevelCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoLevelCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level;
- CallFrame *framePtr;
- Tcl_Obj *listPtr;
- if (objc == 2) { /* just "info level" */
- if (iPtr->varFramePtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
- }
+ if (objc == 1) { /* Just "info level" */
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
return TCL_OK;
- } else if (objc == 3) {
- if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+ }
+
+ if (objc == 2) {
+ int level;
+ CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
+
+ if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
return TCL_ERROR;
}
if (level <= 0) {
- if (iPtr->varFramePtr == NULL) {
- levelError:
- Tcl_AppendResult(interp, "bad level \"",
- TclGetString(objv[2]), "\"", (char *) NULL);
- return TCL_ERROR;
+ if (iPtr->varFramePtr == rootFramePtr) {
+ goto levelError;
}
level += iPtr->varFramePtr->level;
}
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
+ for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
+ framePtr=framePtr->callerVarPtr) {
if (framePtr->level == level) {
break;
}
}
- if (framePtr == NULL) {
+ if (framePtr == rootFramePtr) {
goto levelError;
}
- listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
- Tcl_SetObjResult(interp, listPtr);
+ Tcl_SetObjResult(interp,
+ Tcl_NewListObj(framePtr->objc, framePtr->objv));
return TCL_OK;
}
- Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+ return TCL_ERROR;
+
+ levelError:
+ 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;
}
@@ -1382,16 +1657,16 @@ InfoLevelCmd(dummy, interp, objc, objv)
*/
static int
-InfoLibraryCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoLibraryCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- CONST char *libDirName;
+ const char *libDirName;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -1400,8 +1675,10 @@ InfoLibraryCmd(dummy, interp, objc, objv)
Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
return TCL_OK;
}
+
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;
}
@@ -1427,184 +1704,25 @@ InfoLibraryCmd(dummy, interp, objc, objv)
*/
static int
-InfoLoadedCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoLoadedCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *interpName;
- int result;
+ const char *interpName;
- if ((objc != 2) && (objc != 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?interp?");
+ if ((objc != 1) && (objc != 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
return TCL_ERROR;
}
- if (objc == 2) { /* get loaded pkgs in all interpreters */
+ if (objc == 1) { /* Get loaded pkgs in all interpreters. */
interpName = NULL;
- } else { /* get pkgs just in specified interp */
- interpName = TclGetString(objv[2]);
- }
- result = TclGetLoadedPackages(interp, interpName);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoLocalsCmd --
- *
- * Called to implement the "info locals" command to return a list of
- * local variables that match an optional pattern. Handles the following
- * syntax:
- *
- * info locals ?pattern?
- *
- * Results:
- * Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If there is an
- * error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLocalsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Interp *iPtr = (Interp *) interp;
- char *pattern;
- Tcl_Obj *listPtr;
-
- if (objc == 2) {
- pattern = NULL;
- } else if (objc == 3) {
- pattern = TclGetString(objv[2]);
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
- return TCL_ERROR;
- }
-
- if (iPtr->varFramePtr == NULL ||
- !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
- return TCL_OK;
- }
-
- /*
- * Return a list containing names of first the compiled locals (i.e. the
- * ones stored in the call frame), then the variables in the local hash
- * table (if one exists).
- */
-
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- AppendLocals(interp, listPtr, pattern, 0);
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AppendLocals --
- *
- * Append the local variables for the current frame to the specified list
- * object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AppendLocals(interp, listPtr, pattern, includeLinks)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Obj *listPtr; /* List object to append names to. */
- CONST char *pattern; /* Pattern to match against. */
- int includeLinks; /* 1 if upvars should be included, else 0. */
-{
- Interp *iPtr = (Interp *) interp;
- CompiledLocal *localPtr;
- Var *varPtr;
- int i, localVarCt;
- char *varName;
- Tcl_HashTable *localVarTablePtr;
- register Tcl_HashEntry *entryPtr;
- Tcl_HashSearch search;
-
- localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
- localVarCt = iPtr->varFramePtr->numCompiledLocals;
- varPtr = iPtr->varFramePtr->compiledLocals;
- localVarTablePtr = iPtr->varFramePtr->varTablePtr;
-
- for (i = 0; i < localVarCt; i++) {
- /*
- * Skip nameless (temporary) variables and undefined variables
- */
-
- if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
- && (includeLinks || !TclIsVarLink(varPtr))) {
- varName = varPtr->name;
- if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(varName, -1));
- }
- }
- varPtr++;
- localPtr = localPtr->nextPtr;
- }
-
- /*
- * Do nothing if no local variables.
- */
-
- if (localVarTablePtr == NULL) {
- return;
- }
-
- /*
- * Check for the simple and fast case.
- */
-
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- entryPtr = Tcl_FindHashEntry(localVarTablePtr, pattern);
- if (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- && (includeLinks || !TclIsVarLink(varPtr))) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(pattern,-1));
- }
- }
- return;
- }
-
- /*
- * Scan over and process all local variables.
- */
-
- for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
- entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- && (includeLinks || !TclIsVarLink(varPtr))) {
- varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
- if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(varName, -1));
- }
- }
+ } else { /* Get pkgs just in specified interp. */
+ interpName = TclGetString(objv[1]);
}
+ return TclGetLoadedPackages(interp, interpName);
}
/*
@@ -1629,14 +1747,14 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
*/
static int
-InfoNameOfExecutableCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoNameOfExecutableCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
@@ -1665,16 +1783,16 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
*/
static int
-InfoPatchLevelCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoPatchLevelCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- CONST char *patchlevel;
+ const char *patchlevel;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -1712,14 +1830,14 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
*/
static int
-InfoProcsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoProcsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *cmdName, *pattern;
- CONST char *simplePattern;
+ const char *cmdName, *pattern;
+ const char *simplePattern;
Namespace *nsPtr;
#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
@@ -1736,11 +1854,11 @@ InfoProcsCmd(dummy, interp, objc, objv)
* procs.
*/
- if (objc == 2) {
+ if (objc == 1) {
simplePattern = NULL;
nsPtr = currNsPtr;
specificNsInPattern = 0;
- } else if (objc == 3) {
+ } else if (objc == 2) {
/*
* From the pattern, get the effective namespace and the simple
* pattern (no namespace qualifiers or ::'s) at the end. If an error
@@ -1751,16 +1869,15 @@ InfoProcsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = TclGetString(objv[2]);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
- /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
- &simplePattern);
+ pattern = TclGetString(objv[1]);
+ TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
+ &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
- if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
return TCL_ERROR;
}
@@ -1775,12 +1892,12 @@ InfoProcsCmd(dummy, interp, objc, objv)
* name.
*/
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ listPtr = Tcl_NewListObj(0, NULL);
#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ cmdPtr = Tcl_GetHashValue(entryPtr);
if (!TclIsProc(cmdPtr)) {
realCmdPtr = (Command *)
@@ -1808,7 +1925,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
if ((simplePattern == NULL)
|| Tcl_StringMatch(cmdName, simplePattern)) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ cmdPtr = Tcl_GetHashValue(entryPtr);
if (!TclIsProc(cmdPtr)) {
realCmdPtr = (Command *)
@@ -1854,8 +1971,8 @@ InfoProcsCmd(dummy, interp, objc, objv)
cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
if ((simplePattern == NULL)
|| Tcl_StringMatch(cmdName, simplePattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
+ cmdPtr = Tcl_GetHashValue(entryPtr);
realCmdPtr = (Command *) TclGetOriginalCommand(
(Tcl_Command) cmdPtr);
@@ -1900,23 +2017,23 @@ InfoProcsCmd(dummy, interp, objc, objv)
*/
static int
-InfoScriptCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoScriptCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- if ((objc != 2) && (objc != 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
+ if ((objc != 1) && (objc != 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
return TCL_ERROR;
}
- if (objc == 3) {
+ if (objc == 2) {
if (iPtr->scriptFile != NULL) {
Tcl_DecrRefCount(iPtr->scriptFile);
}
- iPtr->scriptFile = objv[2];
+ iPtr->scriptFile = objv[1];
Tcl_IncrRefCount(iPtr->scriptFile);
}
if (iPtr->scriptFile != NULL) {
@@ -1947,14 +2064,14 @@ InfoScriptCmd(dummy, interp, objc, objv)
*/
static int
-InfoSharedlibCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoSharedlibCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -1985,16 +2102,16 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
*/
static int
-InfoTclVersionCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+InfoTclVersionCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *version;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -2010,198 +2127,6 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * InfoVarsCmd --
- *
- * Called to implement the "info vars" command that returns the list of
- * variables in the interpreter that match an optional pattern. The
- * pattern, if any, consists of an optional sequence of namespace names
- * separated by "::" qualifiers, which is followed by a glob-style
- * pattern that restricts which variables are returned. Handles the
- * following syntax:
- *
- * info vars ?pattern?
- *
- * Results:
- * Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If there is an
- * error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoVarsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Interp *iPtr = (Interp *) interp;
- char *varName, *pattern;
- CONST char *simplePattern;
- register Tcl_HashEntry *entryPtr;
- Tcl_HashSearch search;
- Var *varPtr;
- Namespace *nsPtr;
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- Tcl_Obj *listPtr, *elemObjPtr;
- int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-
- /*
- * Get the pattern and find the "effective namespace" in which to list
- * variables. We only use this effective namespace if there's no active
- * Tcl procedure frame.
- */
-
- if (objc == 2) {
- simplePattern = NULL;
- nsPtr = currNsPtr;
- specificNsInPattern = 0;
- } else if (objc == 3) {
- /*
- * From the pattern, get the effective namespace and the simple
- * pattern (no namespace qualifiers or ::'s) at the end. If an error
- * was found while parsing the pattern, return it. Otherwise, if the
- * namespace wasn't found, just leave nsPtr NULL: we will return an
- * empty list since no variables there can be found.
- */
-
- Namespace *dummy1NsPtr, *dummy2NsPtr;
-
- pattern = TclGetString(objv[2]);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
- /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
- &simplePattern);
-
- if (nsPtr != NULL) { /* We successfully found the pattern's ns */
- specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
- }
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
- return TCL_ERROR;
- }
-
- /*
- * If the namespace specified in the pattern wasn't found, just return.
- */
-
- if (nsPtr == NULL) {
- return TCL_OK;
- }
-
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-
- if ((iPtr->varFramePtr == NULL)
- || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
- || specificNsInPattern) {
- /*
- * There is no frame pointer, the frame pointer was pushed only to
- * activate a namespace, or we are in a procedure call frame but a
- * specific namespace was specified. Create a list containing only the
- * variables in the effective namespace's variable table.
- */
-
- if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
- /*
- * If we can just do hash lookups, that simplifies things a lot.
- */
-
- entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
- if (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- || TclIsVarNamespaceVar(varPtr)) {
- if (specificNsInPattern) {
- elemObjPtr = Tcl_NewObj();
- Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
- elemObjPtr);
- } else {
- elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
- }
- Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
- }
- } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,
- simplePattern);
- if (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- || TclIsVarNamespaceVar(varPtr)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(simplePattern, -1));
- }
- }
- }
- } else {
- /*
- * Have to scan the tables of variables.
- */
-
- entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
- while (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- || TclIsVarNamespaceVar(varPtr)) {
- varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
- if ((simplePattern == NULL)
- || Tcl_StringMatch(varName, simplePattern)) {
- if (specificNsInPattern) {
- elemObjPtr = Tcl_NewObj();
- Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
- elemObjPtr);
- } else {
- elemObjPtr = Tcl_NewStringObj(varName, -1);
- }
- Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
- }
- }
- entryPtr = Tcl_NextHashEntry(&search);
- }
-
- /*
- * If the effective namespace isn't the global :: namespace, and a
- * specific namespace wasn't requested in the pattern (i.e., the
- * pattern only specifies variable names), then add in all global
- * :: variables that match the simple pattern. Of course, add in
- * only those variables that aren't hidden by a variable in the
- * effective namespace.
- */
-
- if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
- while (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- if (!TclIsVarUndefined(varPtr)
- || TclIsVarNamespaceVar(varPtr)) {
- varName = Tcl_GetHashKey(&globalNsPtr->varTable,
- entryPtr);
- if ((simplePattern == NULL)
- || Tcl_StringMatch(varName, simplePattern)) {
- if (Tcl_FindHashEntry(&nsPtr->varTable,
- varName) == NULL) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(varName, -1));
- }
- }
- }
- entryPtr = Tcl_NextHashEntry(&search);
- }
- }
- }
- } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
- AppendLocals(interp, listPtr, simplePattern, 1);
- }
-
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_JoinObjCmd --
*
* This procedure is invoked to process the "join" Tcl command. See the
@@ -2216,25 +2141,17 @@ InfoVarsCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_JoinObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+Tcl_JoinObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- char *joinString, *bytes;
- int joinLength, listLen, length, i, result;
- Tcl_Obj **elemPtrs;
- Tcl_Obj *resObjPtr;
+ int listLen, i;
+ Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
- if (objc == 2) {
- joinString = " ";
- joinLength = 1;
- } else if (objc == 3) {
- joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
- } else {
+ if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
return TCL_ERROR;
}
@@ -2244,23 +2161,22 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
* pointer to its array of element pointers.
*/
- result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
- if (result != TCL_OK) {
- return result;
+ if (TclListObjGetElements(interp, objv[1], &listLen,
+ &elemPtrs) != TCL_OK) {
+ return TCL_ERROR;
}
- /*
- * Now concatenate strings to form the "joined" result.
- */
+ joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
+ Tcl_IncrRefCount(joinObjPtr);
resObjPtr = Tcl_NewObj();
for (i = 0; i < listLen; i++) {
- bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
if (i > 0) {
- Tcl_AppendToObj(resObjPtr, joinString, joinLength);
+ Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
- Tcl_AppendToObj(resObjPtr, bytes, length);
+ Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
+ Tcl_DecrRefCount(joinObjPtr);
Tcl_SetObjResult(interp, resObjPtr);
return TCL_OK;
}
@@ -2282,94 +2198,61 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LassignObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LassignObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *valueObj; /* Value to assign to variable, as read from
- * the list object or created in the emptyObj
- * variable. */
- Tcl_Obj *emptyObj = NULL; /* If non-NULL, an empty object created for
- * being assigned to variables once we have
- * run out of values from the list object. */
+ Tcl_Obj *listCopyPtr;
Tcl_Obj **listObjv; /* The contents of the list. */
int listObjc; /* The length of the list. */
- int i;
+ int code = TCL_OK;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "list varname ?varname ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
return TCL_ERROR;
}
- /*
- * First assign values out of the list to variables.
- */
+ listCopyPtr = TclListObjCopy(interp, objv[1]);
+ if (listCopyPtr == NULL) {
+ return TCL_ERROR;
+ }
- for (i=0 ; i+2<objc ; i++) {
- /*
- * We do this each time round the loop because that is robust against
- * shimmering nasties.
- */
+ TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
- if (Tcl_ListObjIndex(interp, objv[1], i, &valueObj) != TCL_OK) {
- return TCL_ERROR;
- }
- if (valueObj == NULL) {
- if (emptyObj == NULL) {
- TclNewObj(emptyObj);
- Tcl_IncrRefCount(emptyObj);
- }
- valueObj = emptyObj;
+ objc -= 2;
+ objv += 2;
+ while (code == TCL_OK && objc > 0 && listObjc > 0) {
+ if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ code = TCL_ERROR;
}
+ objc--;
+ listObjc--;
+ }
- /*
- * Make sure the reference count for the value being assigned is
- * greater than one (other reference minimally in the list) so we
- * can't get hammered by shimmering.
- */
+ if (code == TCL_OK && objc > 0) {
+ Tcl_Obj *emptyObj;
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(valueObj);
- if (emptyObj != NULL) {
- Tcl_DecrRefCount(emptyObj);
+ TclNewObj(emptyObj);
+ Tcl_IncrRefCount(emptyObj);
+ while (code == TCL_OK && objc-- > 0) {
+ if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ code = TCL_ERROR;
}
- return TCL_ERROR;
}
- Tcl_DecrRefCount(valueObj);
- }
- if (emptyObj != NULL) {
Tcl_DecrRefCount(emptyObj);
}
- /*
- * Now place a list of any values left over into the interpreter result.
- *
- * First, figure out how many values were not assigned by getting the
- * length of the list. Note that I do not expect this operation to fail.
- */
-
- if (Tcl_ListObjGetElements(interp, objv[1],
- &listObjc, &listObjv) != TCL_OK) {
- return TCL_ERROR;
+ if (code == TCL_OK && listObjc > 0) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
}
- if (listObjc > objc-2) {
- /*
- * OK, there were left-overs. Make a list of them and slap that back
- * in the interpreter result.
- */
-
- Tcl_SetObjResult(interp,
- Tcl_NewListObj(listObjc - objc + 2, listObjv + objc - 2));
- }
-
- return TCL_OK;
+ Tcl_DecrRefCount(listCopyPtr);
+ return code;
}
/*
@@ -2389,19 +2272,18 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LindexObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LindexObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *elemPtr; /* Pointer to the element being extracted */
+ Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
return TCL_ERROR;
}
@@ -2424,290 +2306,11 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
if (elemPtr == NULL) {
return TCL_ERROR;
- } else {
- Tcl_SetObjResult(interp, elemPtr);
- Tcl_DecrRefCount(elemPtr);
- return TCL_OK;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclLindexList --
- *
- * This procedure handles the 'lindex' command when objc==3.
- *
- * Results:
- * Returns a pointer to the object extracted, or NULL if an error
- * occurred.
- *
- * Side effects:
- * None.
- *
- * Notes:
- * If objv[1] can be parsed as a list, TclLindexList handles extraction
- * of the desired element locally. Otherwise, it invokes TclLindexFlat to
- * treat objv[1] as a scalar.
- *
- * The reference count of the returned object includes one reference
- * corresponding to the pointer returned. Thus, the calling code will
- * usually do something like:
- * Tcl_SetObjResult(interp, result);
- * Tcl_DecrRefCount(result);
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclLindexList(interp, listPtr, argPtr)
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* listPtr; /* List being unpacked */
- Tcl_Obj* argPtr; /* Index or index list */
-{
-
- Tcl_Obj **elemPtrs; /* Elements of the list being manipulated. */
- int listLen; /* Length of the list being manipulated. */
- int index; /* Index into the list. */
- int result; /* Result returned from a Tcl library call. */
- int i; /* Current index number. */
- Tcl_Obj **indices; /* Array of list indices. */
- int indexCount; /* Size of the array of list indices. */
- Tcl_Obj *oldListPtr; /* Temp location to preserve the list pointer
- * when replacing it with a sublist. */
-
- /*
- * Determine whether argPtr designates a list or a single index. We have
- * to be careful about the order of the checks to avoid repeated
- * shimmering; see TIP#22 and TIP#33 for the details.
- */
-
- if (argPtr->typePtr != &tclListType
- && TclGetIntForIndex(NULL , argPtr, 0, &index) == TCL_OK) {
- /*
- * argPtr designates a single index.
- */
-
- return TclLindexFlat(interp, listPtr, 1, &argPtr);
- }
-
- if (Tcl_ListObjGetElements(NULL, argPtr, &indexCount, &indices) != TCL_OK){
- /*
- * argPtr designates something that is neither an index nor a
- * well-formed list. Report the error via TclLindexFlat.
- */
-
- return TclLindexFlat(interp, listPtr, 1, &argPtr);
- }
-
- /*
- * Record the reference to the list that we are maintaining in the
- * activation record.
- */
-
- Tcl_IncrRefCount(listPtr);
-
- /*
- * argPtr designates a list, and the 'else if' above has parsed it into
- * indexCount and indices.
- */
-
- for (i=0 ; i<indexCount ; i++) {
- /*
- * Convert the current listPtr to a list if necessary.
- */
-
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(listPtr);
- return NULL;
- }
-
- /*
- * Get the index from indices[i]
- */
-
- result = TclGetIntForIndex(interp, indices[i], /*endValue*/ listLen-1,
- &index);
- if (result != TCL_OK) {
- /*
- * Index could not be parsed
- */
-
- Tcl_DecrRefCount(listPtr);
- return NULL;
-
- } else if (index<0 || index>=listLen) {
- /*
- * Index is out of range
- */
-
- Tcl_DecrRefCount(listPtr);
- listPtr = Tcl_NewObj();
- Tcl_IncrRefCount(listPtr);
- return listPtr;
- }
-
- /*
- * Make sure listPtr still refers to a list object. If it shared a
- * Tcl_Obj structure with the arguments, then it might have just been
- * converted to something else.
- */
-
- if (listPtr->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(listPtr);
- return NULL;
- }
- }
-
- /*
- * Extract the pointer to the appropriate element
- */
-
- oldListPtr = listPtr;
- listPtr = elemPtrs[index];
- Tcl_IncrRefCount(listPtr);
- Tcl_DecrRefCount(oldListPtr);
-
- /*
- * The work we did above may have caused the internal rep of *argPtr
- * to change to something else. Get it back.
- */
-
- result = Tcl_ListObjGetElements(interp, argPtr, &indexCount, &indices);
- if (result != TCL_OK) {
- /*
- * This can't happen unless some extension corrupted a Tcl_Obj.
- */
-
- Tcl_DecrRefCount(listPtr);
- return NULL;
- }
- }
-
- /*
- * Return the last object extracted. Its reference count will include the
- * reference being returned.
- */
-
- return listPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclLindexFlat --
- *
- * This procedure handles the 'lindex' command, given that the arguments
- * to the command are known to be a flat list.
- *
- * Results:
- * Returns a standard Tcl result.
- *
- * Side effects:
- * None.
- *
- * Notes:
- * This procedure is called from either tclExecute.c or Tcl_LindexObjCmd
- * whenever either is presented with objc==2 or objc>=4. It is also
- * called from TclLindexList for the objc==3 case once it is determined
- * that objv[2] cannot be parsed as a list.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclLindexFlat(interp, listPtr, indexCount, indexArray)
- Tcl_Interp *interp; /* Tcl interpreter */
- Tcl_Obj *listPtr; /* Tcl object representing the list */
- int indexCount; /* Count of indices */
- Tcl_Obj *CONST indexArray[];
- /* Array of pointers to Tcl objects
- * representing the indices in the list. */
-{
- int i; /* Current list index. */
- int result; /* Result of Tcl library calls. */
- int listLen; /* Length of the current list being
- * processed. */
- Tcl_Obj** elemPtrs; /* Array of pointers to the elements of the
- * current list. */
- int index; /* Parsed version of the current element of
- * indexArray. */
- Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that its ref
- * count can be decremented. */
-
- /*
- * Record the reference to the 'listPtr' object that we are maintaining in
- * the C activation record.
- */
-
- Tcl_IncrRefCount(listPtr);
-
- for (i=0 ; i<indexCount ; i++) {
- /*
- * Convert the current listPtr to a list if necessary.
- */
-
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(listPtr);
- return NULL;
- }
-
- /*
- * Get the index from objv[i].
- */
-
- result = TclGetIntForIndex(interp, indexArray[i],
- /*endValue*/ listLen-1, &index);
- if (result != TCL_OK) {
- /*
- * Index could not be parsed.
- */
-
- Tcl_DecrRefCount(listPtr);
- return NULL;
-
- } else if (index<0 || index>=listLen) {
- /*
- * Index is out of range.
- */
-
- Tcl_DecrRefCount(listPtr);
- listPtr = Tcl_NewObj();
- Tcl_IncrRefCount(listPtr);
- return listPtr;
- }
-
- /*
- * Make sure listPtr still refers to a list object. It might have been
- * converted to something else above if objv[1] overlaps with one of
- * the other parameters.
- */
-
- if (listPtr->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(listPtr);
- return NULL;
- }
- }
-
- /*
- * Extract the pointer to the appropriate element.
- */
-
- oldListPtr = listPtr;
- listPtr = elemPtrs[index];
- Tcl_IncrRefCount(listPtr);
- Tcl_DecrRefCount(oldListPtr);
}
- return listPtr;
+ Tcl_SetObjResult(interp, elemPtr);
+ Tcl_DecrRefCount(elemPtr);
+ return TCL_OK;
}
/*
@@ -2728,23 +2331,22 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LinsertObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- register int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LinsertObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ register int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
- int index, isDuplicate, len, result;
+ int index, len, result;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
return TCL_ERROR;
}
- result = Tcl_ListObjLength(interp, objv[1], &len);
+ result = TclListObjLength(interp, objv[1], &len);
if (result != TCL_OK) {
return result;
}
@@ -2755,7 +2357,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
* appended to the list.
*/
- result = TclGetIntForIndex(interp, objv[2], /*end*/ len, &index);
+ result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
if (result != TCL_OK) {
return result;
}
@@ -2769,10 +2371,8 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
*/
listPtr = objv[1];
- isDuplicate = 0;
if (Tcl_IsShared(listPtr)) {
- listPtr = Tcl_DuplicateObj(listPtr);
- isDuplicate = 1;
+ listPtr = TclListObjCopy(NULL, listPtr);
}
if ((objc == 4) && (index == len)) {
@@ -2780,16 +2380,9 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
* Special case: insert one element at the end of the list.
*/
- result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
- } else if (objc > 3) {
- result = Tcl_ListObjReplace(interp, listPtr, index, 0,
- (objc-3), &(objv[3]));
- }
- if (result != TCL_OK) {
- if (isDuplicate) {
- Tcl_DecrRefCount(listPtr); /* free unneeded obj */
- }
- return result;
+ Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
+ } else {
+ Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
}
/*
@@ -2817,13 +2410,13 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_ListObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- register int objc; /* Number of arguments. */
- register Tcl_Obj *CONST objv[]; /* The argument objects. */
+Tcl_ListObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ register int objc, /* Number of arguments. */
+ register Tcl_Obj *const objv[])
+ /* The argument objects. */
{
/*
* If there are no list elements, the result is an empty object.
@@ -2831,7 +2424,7 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
*/
if (objc > 1) {
- Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
}
return TCL_OK;
}
@@ -2853,13 +2446,13 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LlengthObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- register Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LlengthObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ register Tcl_Obj *const objv[])
+ /* Argument objects. */
{
int listLen, result;
@@ -2868,7 +2461,7 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- result = Tcl_ListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2899,39 +2492,28 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
- ClientData notUsed; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- register Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LrangeObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ register Tcl_Obj *const objv[])
+ /* Argument objects. */
{
- Tcl_Obj *listPtr;
Tcl_Obj **elemPtrs;
- int listLen, first, last, numElems, result;
+ int listLen, first, last, result;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list first last");
return TCL_ERROR;
}
- /*
- * Make sure the list argument is a list object and get its length and a
- * pointer to its array of element pointers.
- */
-
- listPtr = objv[1];
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+ result = TclListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
- /*
- * Get the first and last indexes.
- */
-
- result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+ result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
&first);
if (result != TCL_OK) {
return result;
@@ -2940,39 +2522,51 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
first = 0;
}
- result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
+ result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
&last);
if (result != TCL_OK) {
return result;
}
if (last >= listLen) {
- last = (listLen - 1);
+ last = listLen - 1;
}
if (first > last) {
- return TCL_OK; /* the result is an empty object */
+ /*
+ * Returning an empty list is easy.
+ */
+
+ return TCL_OK;
}
- /*
- * Make sure listPtr still refers to a list object. It might have been
- * converted to an int above if the argument objects were shared.
- */
+ result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
- if (listPtr->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- return result;
+ if (Tcl_IsShared(objv[1]) ||
+ ((ListRepPtr(objv[1])->refCount > 1))) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
+ &elemPtrs[first]));
+ } else {
+ /*
+ * In-place is possible.
+ */
+
+ if (last < (listLen - 1)) {
+ Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
+ 0, NULL);
}
- }
- /*
- * Extract a range of fields. We modify the interpreter's result object to
- * be a list object containing the specified elements.
- */
+ /*
+ * This one is not conditioned on (first > 0) in order to preserve the
+ * string-canonizing effect of [lrange 0 end].
+ */
+
+ Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
+ Tcl_SetObjResult(interp, objv[1]);
+ }
- numElems = (last - first + 1);
- Tcl_SetObjResult(interp, Tcl_NewListObj(numElems, &(elemPtrs[first])));
return TCL_OK;
}
@@ -2993,35 +2587,34 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- register int objc; /* Number of arguments. */
- register Tcl_Obj *CONST objv[];
+Tcl_LrepeatObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ register int objc, /* Number of arguments. */
+ register Tcl_Obj *const objv[])
/* The argument objects. */
{
- int elementCount, i, result;
- Tcl_Obj *listPtr, **dataArray;
- List *listRepPtr;
+ int elementCount, i, totalElems;
+ Tcl_Obj *listPtr, **dataArray = NULL;
/*
* Check arguments for legality:
- * lrepeat posInt value ?value ...?
+ * lrepeat count ?value ...?
*/
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
return TCL_ERROR;
}
- elementCount = 0;
- result = Tcl_GetIntFromObj(interp, objv[1], &elementCount);
- if (result == TCL_ERROR) {
+ if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
return TCL_ERROR;
}
- if (elementCount < 1) {
- Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
+ if (elementCount < 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad count \"%d\": must be integer >= 0", elementCount));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
+ NULL);
return TCL_ERROR;
}
@@ -3032,15 +2625,28 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
objc -= 2;
objv += 2;
+ /* Final sanity check. Do not exceed limits on max list length. */
+
+ 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
* init value elementCount times.
*/
- listPtr = Tcl_NewListObj(elementCount*objc, NULL);
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- listRepPtr->elemCount = elementCount*objc;
- dataArray = &listRepPtr->elements;
+ listPtr = Tcl_NewListObj(totalElems, NULL);
+ if (totalElems) {
+ List *listRepPtr = ListRepPtr(listPtr);
+
+ listRepPtr->elemCount = elementCount*objc;
+ dataArray = &listRepPtr->elements;
+ }
/*
* Set the elements. Note that we handle the common degenerate case of a
@@ -3049,6 +2655,7 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
* number of times.
*/
+ CLANG_ASSERT(dataArray);
if (objc == 1) {
register Tcl_Obj *tmpPtr = objv[0];
@@ -3089,24 +2696,23 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LreplaceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Tcl_Obj *listPtr;
- int isDuplicate, first, last, listLen, numToDelete, result;
+ int first, last, listLen, numToDelete, result;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "list first last ?element element ...?");
+ "list first last ?element ...?");
return TCL_ERROR;
}
- result = Tcl_ListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -3117,37 +2723,39 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
* included for deletion.
*/
- result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
+ result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first);
if (result != TCL_OK) {
return result;
}
- result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last);
+ result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
if (result != TCL_OK) {
return result;
}
if (first < 0) {
- first = 0;
+ first = 0;
}
/*
* Complain if the user asked for a start element that is greater than the
- * list length. This won't ever trigger for the "end*" case as that will
+ * list length. This won't ever trigger for the "end-*" case as that will
* be properly constrained by TclGetIntForIndex because we use listLen-1
* (to allow for replacing the last elem).
*/
if ((first >= listLen) && (listLen > 0)) {
- Tcl_AppendResult(interp, "list doesn't contain element ",
- TclGetString(objv[2]), (int *) 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) {
- last = (listLen - 1);
+ last = listLen - 1;
}
if (first <= last) {
- numToDelete = (last - first + 1);
+ numToDelete = last - first + 1;
} else {
numToDelete = 0;
}
@@ -3158,26 +2766,21 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
*/
listPtr = objv[1];
- isDuplicate = 0;
if (Tcl_IsShared(listPtr)) {
- listPtr = Tcl_DuplicateObj(listPtr);
- isDuplicate = 1;
- }
- if (objc > 4) {
- result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
- (objc-4), &(objv[4]));
- } else {
- result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
- 0, NULL);
- }
- if (result != TCL_OK) {
- if (isDuplicate) {
- Tcl_DecrRefCount(listPtr); /* free unneeded obj */
- }
- return result;
+ listPtr = TclListObjCopy(NULL, listPtr);
}
/*
+ * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
+ * objc == 4. In this case, the list value of listPtr is not changed (no
+ * elements are removed or added), but by making the call we are assured
+ * we end up with a list in canonical form. Resist any temptation to
+ * optimize this case away.
+ */
+
+ Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, objv+4);
+
+ /*
* Set the interpreter's object result.
*/
@@ -3188,6 +2791,85 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * Tcl_LreverseObjCmd --
+ *
+ * This procedure is invoked to process the "lreverse" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LreverseObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
+{
+ Tcl_Obj **elemv;
+ int elemc, i, j;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "list");
+ return TCL_ERROR;
+ }
+ if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the list is empty, just return it. [Bug 1876793]
+ */
+
+ if (!elemc) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+
+ if (Tcl_IsShared(objv[1])
+ || (ListRepPtr(objv[1])->refCount > 1)) { /* Bug 1675044 */
+ Tcl_Obj *resultObj, **dataArray;
+ List *listRepPtr;
+
+ resultObj = Tcl_NewListObj(elemc, NULL);
+ listRepPtr = ListRepPtr(resultObj);
+ listRepPtr->elemCount = elemc;
+ dataArray = &listRepPtr->elements;
+
+ for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
+ dataArray[j] = elemv[i];
+ Tcl_IncrRefCount(elemv[i]);
+ }
+
+ Tcl_SetObjResult(interp, resultObj);
+ } else {
+
+ /*
+ * Not shared, so swap "in place". This relies on Tcl_LOGE above
+ * returning a pointer to the live array of Tcl_Obj values.
+ */
+
+ for (i=0,j=elemc-1 ; i<j ; i++,j--) {
+ Tcl_Obj *tmp = elemv[i];
+
+ elemv[i] = elemv[j];
+ elemv[j] = tmp;
+ }
+ TclInvalidateStringRep(objv[1]);
+ Tcl_SetObjResult(interp, objv[1]);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LsearchObjCmd --
*
* This procedure is invoked to process the "lsearch" Tcl command. See
@@ -3203,34 +2885,34 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
*/
int
-Tcl_LsearchObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument values. */
+Tcl_LsearchObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- char *bytes, *patternBytes;
- int i, match, mode, index, result, listc, length, elemLen;
+ const char *bytes, *patternBytes;
+ int i, match, index, result, listc, length, elemLen, bisect;
int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
+ SortStrCmpFn_t strCmpFn = strcmp;
Tcl_RegExp regexp = NULL;
- static CONST char *options[] = {
- "-all", "-ascii", "-decreasing", "-dictionary",
+ static const char *const options[] = {
+ "-all", "-ascii", "-bisect", "-decreasing", "-dictionary",
"-exact", "-glob", "-increasing", "-index",
"-inline", "-integer", "-nocase", "-not",
"-real", "-regexp", "-sorted", "-start",
- "-subindices",
- NULL
+ "-subindices", NULL
};
enum options {
- LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
- LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
- LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
- LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
- LSEARCH_SUBINDICES
+ LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING,
+ LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
+ LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
+ LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
+ LSEARCH_START, LSEARCH_SUBINDICES
};
enum datatypes {
ASCII, DICTIONARY, INTEGER, REAL
@@ -3238,7 +2920,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
enum modes {
EXACT, GLOB, REGEXP, SORTED
};
- SortStrCmpFn_t strCmpFn = strcmp;
+ enum modes mode;
mode = GLOB;
dataType = ASCII;
@@ -3247,12 +2929,13 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
inlineReturn = 0;
returnSubindices = 0;
negatedMatch = 0;
+ bisect = 0;
listPtr = NULL;
startPtr = NULL;
offset = 0;
noCase = 0;
sortInfo.compareCmdPtr = NULL;
- sortInfo.isIncreasing = 0;
+ sortInfo.isIncreasing = 1;
sortInfo.sortMode = 0;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
@@ -3260,7 +2943,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
sortInfo.indexc = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
return TCL_ERROR;
}
@@ -3270,10 +2953,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
switch ((enum options) index) {
case LSEARCH_ALL: /* -all */
@@ -3282,8 +2963,13 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
case LSEARCH_ASCII: /* -ascii */
dataType = ASCII;
break;
+ case LSEARCH_BISECT: /* -bisect */
+ mode = SORTED;
+ bisect = 1;
+ break;
case LSEARCH_DECREASING: /* -decreasing */
isIncreasing = 0;
+ sortInfo.isIncreasing = 0;
break;
case LSEARCH_DICTIONARY: /* -dictionary */
dataType = DICTIONARY;
@@ -3296,6 +2982,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
break;
case LSEARCH_INCREASING: /* -increasing */
isIncreasing = 1;
+ sortInfo.isIncreasing = 1;
break;
case LSEARCH_INLINE: /* -inline */
inlineReturn = 1;
@@ -3304,7 +2991,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
dataType = INTEGER;
break;
case LSEARCH_NOCASE: /* -nocase */
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
break;
case LSEARCH_NOT: /* -not */
@@ -3332,19 +3019,19 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
Tcl_DecrRefCount(startPtr);
}
if (i > objc-4) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- Tcl_AppendResult(interp, "missing starting index", NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing starting index", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ result = TCL_ERROR;
+ goto done;
}
i++;
if (objv[i] == objv[objc - 2]) {
/*
- * Take copy to prevent shimmering problems. Note that it
- * does not matter if the index obj is also a component of the
- * list being searched. We only need to copy where the list
- * and the index are one-and-the-same.
+ * Take copy to prevent shimmering problems. Note that it does
+ * not matter if the index obj is also a component of the list
+ * being searched. We only need to copy where the list and the
+ * index are one-and-the-same.
*/
startPtr = Tcl_DuplicateObj(objv[i]);
@@ -3356,16 +3043,18 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
case LSEARCH_INDEX: { /* -index */
Tcl_Obj **indices;
int j;
+
if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ TclStackFree(interp, sortInfo.indexv);
}
if (i > objc-4) {
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;
}
@@ -3376,7 +3065,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
i++;
- if (Tcl_ListObjGetElements(interp, objv[i],
+ if (TclListObjGetElements(interp, objv[i],
&sortInfo.indexc, &indices) != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
@@ -3391,8 +3080,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
sortInfo.indexv = &sortInfo.singleIndex;
break;
default:
- sortInfo.indexv = (int *)
- ckalloc(sizeof(int) * sortInfo.indexc);
+ sortInfo.indexv =
+ TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
}
/*
@@ -3402,14 +3091,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
for (j=0 ; j<sortInfo.indexc ; j++) {
- if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
+ if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- TclFormatToErrorInfo(interp,
- "\n (-index option item number %d)", j);
- return TCL_ERROR;
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (-index option item number %d)", j));
+ result = TCL_ERROR;
+ goto done;
}
}
break;
@@ -3425,28 +3112,49 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
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_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;
}
- if ((enum modes) mode == REGEXP) {
+ if (mode == REGEXP) {
/*
* We can shimmer regexp/list if listv[i] == pattern, so get the
- * regexp rep before the list rep.
+ * regexp rep before the list rep. First time round, omit the interp
+ * and hope that the compilation will succeed. If it fails, we'll
+ * recompile in "expensive" mode with a place to put error messages.
*/
- regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
+ regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1],
TCL_REG_ADVANCED | TCL_REG_NOSUB |
(noCase ? TCL_REG_NOCASE : 0));
if (regexp == NULL) {
+ /*
+ * Failed to compile the RE. Try again without the TCL_REG_NOSUB
+ * flag in case the RE had sub-expressions in it [Bug 1366683]. If
+ * this fails, an error message will be left in the interpreter.
+ */
+
+ regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
+ TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
+ }
+
+ if (regexp == NULL) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
}
@@ -3455,15 +3163,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* pointer to its array of element pointers.
*/
- result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
+ result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
/*
@@ -3471,51 +3176,70 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
if (startPtr) {
- result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
+ result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
Tcl_DecrRefCount(startPtr);
if (result != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
- }
- if (offset > listc-1) {
- offset = listc-1;
+ goto done;
}
if (offset < 0) {
offset = 0;
}
+
+ /*
+ * If the search started past the end of the list, we just return a
+ * "did not match anything at all" result straight away. [Bug 1374778]
+ */
+
+ if (offset > listc-1) {
+ if (sortInfo.indexc > 1) {
+ TclStackFree(interp, sortInfo.indexv);
+ }
+ if (allMatches || inlineReturn) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ }
+ return TCL_OK;
+ }
}
patObj = objv[objc - 1];
patternBytes = NULL;
- if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
+ if (mode == EXACT || mode == SORTED) {
switch ((enum datatypes) dataType) {
case ASCII:
case DICTIONARY:
- patternBytes = Tcl_GetStringFromObj(patObj, &length);
+ patternBytes = TclGetStringFromObj(patObj, &length);
break;
case INTEGER:
- result = Tcl_GetIntFromObj(interp, patObj, &patInt);
+ result = TclGetIntFromObj(interp, patObj, &patInt);
if (result != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
+
+ /*
+ * List representation might have been shimmered; restore it. [Bug
+ * 1844789]
+ */
+
+ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
break;
case REAL:
result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
if (result != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
+
+ /*
+ * List representation might have been shimmered; restore it. [Bug
+ * 1844789]
+ */
+
+ TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
break;
}
} else {
- patternBytes = Tcl_GetStringFromObj(patObj, &length);
+ patternBytes = TclGetStringFromObj(patObj, &length);
}
/*
@@ -3526,7 +3250,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
index = -1;
match = 0;
- if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
+ if (mode == SORTED && !allMatches && !negatedMatch) {
/*
* If the data is sorted, we can do a more intelligent search. Note
* that there is no point in being smart when -all was specified; in
@@ -3538,12 +3262,14 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
upper = listc;
while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
i = (lower + upper)/2;
- itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
- if (sortInfo.resultCode != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ if (sortInfo.indexc != 0) {
+ itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+ if (sortInfo.resultCode != TCL_OK) {
+ result = sortInfo.resultCode;
+ goto done;
}
- return sortInfo.resultCode;
+ } else {
+ itemPtr = listv[i];
}
switch ((enum datatypes) dataType) {
case ASCII:
@@ -3555,12 +3281,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
match = DictionaryCompare(patternBytes, bytes);
break;
case INTEGER:
- result = Tcl_GetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetIntFromObj(interp, itemPtr, &objInt);
if (result != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
if (patInt == objInt) {
match = 0;
@@ -3573,10 +3296,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
case REAL:
result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
if (result != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
if (patDouble == objDouble) {
match = 0;
@@ -3600,10 +3320,16 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* variation means that a search always makes log n
* comparisons (normal binary search might "get lucky" with an
* early comparison).
+ *
+ * In bisect mode though, we want the last of equals.
*/
index = i;
- upper = i;
+ if (bisect) {
+ lower = i;
+ } else {
+ upper = i;
+ }
} else if (match > 0) {
if (isIncreasing) {
lower = i;
@@ -3618,7 +3344,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
}
}
-
+ if (bisect && index < 0) {
+ index = lower;
+ }
} else {
/*
* We need to do a linear search, because (at least one) of:
@@ -3628,69 +3356,67 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
if (allMatches) {
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ listPtr = Tcl_NewListObj(0, NULL);
}
for (i = offset; i < listc; i++) {
match = 0;
- itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
- if (sortInfo.resultCode != TCL_OK) {
- if (listPtr != NULL) {
- Tcl_DecrRefCount(listPtr);
- }
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ if (sortInfo.indexc != 0) {
+ itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+ if (sortInfo.resultCode != TCL_OK) {
+ if (listPtr != NULL) {
+ Tcl_DecrRefCount(listPtr);
+ }
+ result = sortInfo.resultCode;
+ goto done;
}
- return sortInfo.resultCode;
+ } else {
+ itemPtr = listv[i];
}
- switch ((enum modes) mode) {
+
+ switch (mode) {
case SORTED:
case EXACT:
switch ((enum datatypes) dataType) {
case ASCII:
- bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
+ bytes = TclGetStringFromObj(itemPtr, &elemLen);
if (length == elemLen) {
/*
* This split allows for more optimal compilation of
- * memcmp/
+ * memcmp/strcasecmp.
*/
if (noCase) {
- match = (strcasecmp(bytes, patternBytes) == 0);
+ match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
}
}
break;
+
case DICTIONARY:
bytes = TclGetString(itemPtr);
match = (DictionaryCompare(bytes, patternBytes) == 0);
break;
case INTEGER:
- result = Tcl_GetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetIntFromObj(interp, itemPtr, &objInt);
if (result != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
match = (objInt == patInt);
break;
case REAL:
- result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
+ result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
if (result != TCL_OK) {
if (listPtr) {
Tcl_DecrRefCount(listPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return result;
+ goto done;
}
match = (objDouble == patDouble);
break;
@@ -3701,6 +3427,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
match = Tcl_StringCaseMatch(TclGetString(itemPtr),
patternBytes, noCase);
break;
+
case REGEXP:
match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
if (match < 0) {
@@ -3708,16 +3435,14 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
break;
}
/*
- * Invert match condition for -not
+ * Invert match condition for -not.
*/
if (negatedMatch) {
@@ -3734,7 +3459,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* Note that these appends are not expected to fail.
*/
- if (returnSubindices) {
+ if (returnSubindices && (sortInfo.indexc != 0)) {
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
} else {
itemPtr = listv[i];
@@ -3742,6 +3467,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (returnSubindices) {
int j;
+
itemPtr = Tcl_NewIntObj(i);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
@@ -3763,6 +3489,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
} else if (!inlineReturn) {
if (returnSubindices) {
int j;
+
itemPtr = Tcl_NewIntObj(index);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
@@ -3782,15 +3509,17 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
} else {
Tcl_SetObjResult(interp, listv[index]);
}
+ result = TCL_OK;
/*
* Cleanup the index list array.
*/
+ done:
if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ TclStackFree(interp, sortInfo.indexv);
}
- return TCL_OK;
+ return result;
}
/*
@@ -3811,21 +3540,22 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
int
-Tcl_LsetObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument values. */
+Tcl_LsetObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- Tcl_Obj* listPtr; /* Pointer to the list being altered. */
- Tcl_Obj* finalValuePtr; /* Value finally assigned to the variable. */
+ Tcl_Obj *listPtr; /* Pointer to the list being altered. */
+ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
/*
* Check parameter count.
*/
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "listVar index ?index...? value");
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "listVar ?index? ?index ...? value");
return TCL_ERROR;
}
@@ -3833,8 +3563,7 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv)
* Look up the list variable's value.
*/
- listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- TCL_LEAVE_ERR_MSG);
+ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
@@ -3896,33 +3625,38 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv)
*/
int
-Tcl_LsortObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument values. */
+Tcl_LsortObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- int i, index, unique, indices;
- Tcl_Obj *resultPtr;
- int length;
- Tcl_Obj *cmdPtr, **listObjPtrs;
- SortElement *elementArray;
- SortElement *elementPtr;
+ int i, j, index, indices, length, nocase = 0, indexc;
+ int sortMode = SORTMODE_ASCII;
+ int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
+ Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
+ SortElement *elementArray, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
- static CONST char *switches[] = {
+# define NUM_LISTS 30
+ SortElement *subList[NUM_LISTS+1];
+ /* This array holds pointers to temporary
+ * lists built during the merge sort. Element
+ * i of the array holds a list of length
+ * 2**i. */
+ static const char *const switches[] = {
"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
- "-index", "-indices", "-integer", "-nocase", "-real", "-unique",
- (char *) NULL
+ "-index", "-indices", "-integer", "-nocase", "-real", "-stride",
+ "-unique", NULL
};
enum Lsort_Switches {
LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
- LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE
+ LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
return TCL_ERROR;
}
@@ -3932,32 +3666,35 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.isIncreasing = 1;
sortInfo.sortMode = SORTMODE_ASCII;
- sortInfo.strCmpFn = strcmp;
sortInfo.indexv = NULL;
sortInfo.indexc = 0;
+ sortInfo.unique = 0;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
cmdPtr = NULL;
- unique = 0;
indices = 0;
+ 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) {
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
switch ((enum Lsort_Switches) index) {
case LSORT_ASCII:
sortInfo.sortMode = SORTMODE_ASCII;
break;
case LSORT_COMMAND:
- if (i == (objc-2)) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- Tcl_AppendResult(interp,
- "\"-command\" option must be followed ",
- "by comparison command", NULL);
- return TCL_ERROR;
+ if (i == objc-2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-command\" option must be followed "
+ "by comparison command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
sortInfo.sortMode = SORTMODE_COMMAND;
cmdPtr = objv[i+1];
@@ -3973,55 +3710,41 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
- int j;
- Tcl_Obj **indices;
+ int indexc, dummy;
+ Tcl_Obj **indexv;
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ if (i == objc-2) {
+ 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;
}
- if (i == (objc-2)) {
- Tcl_AppendResult(interp, "\"-index\" option must be ",
- "followed by list index", NULL);
- return TCL_ERROR;
+ if (TclListObjGetElements(interp, objv[i+1], &indexc,
+ &indexv) != TCL_OK) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
/*
- * Take copy to prevent shimmering problems.
+ * 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.
*/
- if (Tcl_ListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
- &indices) != TCL_OK) {
- return TCL_ERROR;
- }
- switch (sortInfo.indexc) {
- case 0:
- sortInfo.indexv = NULL;
- break;
- case 1:
- sortInfo.indexv = &sortInfo.singleIndex;
- break;
- default:
- sortInfo.indexv = (int *)
- ckalloc(sizeof(int) * sortInfo.indexc);
- }
-
- /*
- * 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.
- */
-
- for (j=0 ; j<sortInfo.indexc ; j++) {
- if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
- &sortInfo.indexv[j]) != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- TclFormatToErrorInfo(interp,
- "\n (-index option item number %d)", j);
- return TCL_ERROR;
+ for (j=0 ; j<indexc ; j++) {
+ if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
+ &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;
}
@@ -4029,157 +3752,339 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.sortMode = SORTMODE_INTEGER;
break;
case LSORT_NOCASE:
- sortInfo.strCmpFn = strcasecmp;
+ nocase = 1;
break;
case LSORT_REAL:
sortInfo.sortMode = SORTMODE_REAL;
break;
case LSORT_UNIQUE:
- unique = 1;
+ sortInfo.unique = 1;
break;
case LSORT_INDICES:
indices = 1;
break;
+ case LSORT_STRIDE:
+ if (i == objc-2) {
+ 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;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
+ }
+ if (groupSize < 2) {
+ 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;
+ }
+ group = 1;
+ i++;
+ break;
+ }
+ }
+ if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
+ 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) {
+ Tcl_Obj *newCommandPtr, *newObjPtr;
+
+ /*
+ * When sorting using a command, we are reentrant and therefore might
+ * have the representation of the list being sorted shimmered out from
+ * underneath our feet. Take a copy (cheap) to prevent this. [Bug
+ * 1675116]
+ */
+
+ listObj = TclListObjCopy(interp, listObj);
+ if (listObj == NULL) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
+ }
+
/*
* The existing command is a list. We want to flatten it, append two
* dummy arguments on the end, and replace these arguments later.
*/
- Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
- Tcl_Obj *newObjPtr = Tcl_NewObj();
-
+ newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+ TclNewObj(newObjPtr);
Tcl_IncrRefCount(newCommandPtr);
if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
!= TCL_OK) {
- Tcl_DecrRefCount(newCommandPtr);
+ TclDecrRefCount(newCommandPtr);
+ TclDecrRefCount(listObj);
Tcl_IncrRefCount(newObjPtr);
- Tcl_DecrRefCount(newObjPtr);
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ TclDecrRefCount(newObjPtr);
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
sortInfo.compareCmdPtr = newCommandPtr;
}
- sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
+ sortInfo.resultCode = TclListObjGetElements(interp, listObj,
&length, &listObjPtrs);
if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
}
- elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
- for (i=0; i < length; i++){
- elementArray[i].objPtr = listObjPtrs[i];
- elementArray[i].count = 0;
- elementArray[i].nextPtr = &elementArray[i+1];
- }
- elementArray[length-1].nextPtr = NULL;
- elementPtr = MergeSort(elementArray, &sortInfo);
- if (sortInfo.resultCode == TCL_OK) {
- resultPtr = Tcl_NewObj();
- if (unique) {
- if (indices) {
- for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- if (elementPtr->count == 0) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewIntObj(elementPtr - &elementArray[0]));
- }
- }
- } else {
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) {
- if (elementPtr->count == 0) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- elementPtr->objPtr);
- }
- }
+
+ /*
+ * Check for sanity when grouping elements of the overall list together
+ * because of the -stride option. [TIP #326]
+ */
+
+ if (group) {
+ if (length % groupSize) {
+ 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;
+ }
+ length = length / groupSize;
+ if (sortInfo.indexc > 0) {
+ /*
+ * Use the first value in the list supplied to -index as the
+ * offset of the element within each group by which to sort.
+ */
+
+ groupOffset = sortInfo.indexv[0];
+ if (groupOffset <= SORTIDX_END) {
+ groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
}
- } else {
- if (indices) {
- for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewIntObj(elementPtr - &elementArray[0]));
- }
+ if (groupOffset < 0 || groupOffset >= groupSize) {
+ 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;
+ }
+ if (sortInfo.indexc == 1) {
+ sortInfo.indexc = 0;
+ sortInfo.indexv = NULL;
} else {
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
- Tcl_ListObjAppendElement(interp, resultPtr,
- elementPtr->objPtr);
+ sortInfo.indexc--;
+
+ /*
+ * Do not shrink the actual memory block used; that doesn't
+ * work with TclStackAlloc-allocated memory. [Bug 2918962]
+ */
+
+ for (i = 0; i < sortInfo.indexc; i++) {
+ sortInfo.indexv[i] = sortInfo.indexv[i+1];
}
}
}
- Tcl_SetObjResult(interp, resultPtr);
}
- ckfree((char*) elementArray);
- done:
- if (sortInfo.sortMode == SORTMODE_COMMAND) {
- Tcl_DecrRefCount(sortInfo.compareCmdPtr);
- sortInfo.compareCmdPtr = NULL;
+ sortInfo.numElements = length;
+
+ indexc = sortInfo.indexc;
+ sortMode = sortInfo.sortMode;
+ if ((sortMode == SORTMODE_ASCII_NC)
+ || (sortMode == SORTMODE_DICTIONARY)) {
+ /*
+ * For this function's purpose all string-based modes are equivalent
+ */
+
+ sortMode = SORTMODE_ASCII;
}
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+
+ /*
+ * Initialize the sublists. After the following loop, subList[i] will
+ * contain a sorted sublist of length 2**i. Use one extra subList at the
+ * end, always at NULL, to indicate the end of the lists.
+ */
+
+ for (j=0 ; j<=NUM_LISTS ; j++) {
+ subList[j] = NULL;
}
- return sortInfo.resultCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MergeSort -
- *
- * This procedure sorts a linked list of SortElement structures use the
- * merge-sort algorithm.
- *
- * Results:
- * A pointer to the head of the list after sorting is returned.
- *
- * Side effects:
- * None, unless a user-defined comparison command does something weird.
- *
- *----------------------------------------------------------------------
- */
-static SortElement *
-MergeSort(headPtr, infoPtr)
- SortElement *headPtr; /* First element on the list. */
- SortInfo *infoPtr; /* Information needed by the comparison
- * operator. */
-{
/*
- * The subList array below holds pointers to temporary lists built during
- * the merge sort. Element i of the array holds a list of length 2**i.
+ * The following loop creates a SortElement for each list element and
+ * begins sorting it into the sublists as it appears.
*/
-# define NUM_LISTS 30
- SortElement *subList[NUM_LISTS];
- SortElement *elementPtr;
- int i;
+ elementArray = TclStackAlloc(interp, length * sizeof(SortElement));
- for (i=0 ; i<NUM_LISTS ; i++) {
- subList[i] = NULL;
- }
- while (headPtr != NULL) {
- elementPtr = headPtr;
- headPtr = headPtr->nextPtr;
- elementPtr->nextPtr = 0;
- for (i=0 ; i<NUM_LISTS && subList[i]!=NULL ; i++) {
- elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
- subList[i] = NULL;
+ for (i=0; i < length; i++){
+ idx = groupSize * i + groupOffset;
+ if (indexc) {
+ /*
+ * If this is an indexed sort, retrieve the corresponding element
+ */
+ indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
+ if (sortInfo.resultCode != TCL_OK) {
+ goto done1;
+ }
+ } else {
+ indexPtr = listObjPtrs[idx];
}
- if (i >= NUM_LISTS) {
- i = NUM_LISTS-1;
+
+ /*
+ * Determine the "value" of this object for sorting purposes
+ */
+
+ if (sortMode == SORTMODE_ASCII) {
+ elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
+ } else if (sortMode == SORTMODE_INTEGER) {
+ long a;
+
+ if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto done1;
+ }
+ elementArray[i].collationKey.intValue = a;
+ } else if (sortMode == SORTMODE_REAL) {
+ double a;
+
+ if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
+ &a) != TCL_OK) {
+ sortInfo.resultCode = TCL_ERROR;
+ goto done1;
+ }
+ elementArray[i].collationKey.doubleValue = a;
+ } else {
+ elementArray[i].collationKey.objValuePtr = indexPtr;
}
- subList[i] = elementPtr;
+
+ /*
+ * Determine the representation of this element in the result: either
+ * the objPtr itself, or its index in the original list.
+ */
+
+ if (indices || group) {
+ elementArray[i].payload.index = idx;
+ } else {
+ elementArray[i].payload.objPtr = listObjPtrs[idx];
+ }
+
+ /*
+ * Merge this element in the pre-existing sublists (and merge together
+ * sublists when we have two of the same size).
+ */
+
+ elementArray[i].nextPtr = NULL;
+ elementPtr = &elementArray[i];
+ for (j=0 ; subList[j] ; j++) {
+ elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
+ subList[j] = NULL;
+ }
+ if (j >= NUM_LISTS) {
+ j = NUM_LISTS-1;
+ }
+ subList[j] = elementPtr;
+ }
+
+ /*
+ * Merge all sublists
+ */
+
+ elementPtr = subList[0];
+ for (j=1 ; j<NUM_LISTS ; j++) {
+ elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
+ }
+
+ /*
+ * Now store the sorted elements in the result list.
+ */
+
+ if (sortInfo.resultCode == TCL_OK) {
+ List *listRepPtr;
+ Tcl_Obj **newArray, *objPtr;
+
+ resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
+ listRepPtr = ListRepPtr(resultPtr);
+ newArray = &listRepPtr->elements;
+ if (group) {
+ for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
+ idx = elementPtr->payload.index;
+ for (j = 0; j < groupSize; j++) {
+ if (indices) {
+ objPtr = Tcl_NewIntObj(idx + j - groupOffset);
+ newArray[i++] = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ } else {
+ objPtr = listObjPtrs[idx + j - groupOffset];
+ newArray[i++] = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ }
+ }
+ }
+ } else if (indices) {
+ for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
+ objPtr = Tcl_NewIntObj(elementPtr->payload.index);
+ newArray[i++] = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ }
+ } else {
+ for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
+ objPtr = elementPtr->payload.objPtr;
+ newArray[i++] = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ }
+ }
+ listRepPtr->elemCount = i;
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+
+ done1:
+ TclStackFree(interp, elementArray);
+
+ done:
+ if (sortMode == SORTMODE_COMMAND) {
+ TclDecrRefCount(sortInfo.compareCmdPtr);
+ TclDecrRefCount(listObj);
+ sortInfo.compareCmdPtr = NULL;
}
- elementPtr = NULL;
- for (i=0 ; i<NUM_LISTS ; i++) {
- elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+ done2:
+ if (allocatedIndexVector) {
+ TclStackFree(interp, sortInfo.indexv);
}
- return elementPtr;
+ return sortInfo.resultCode;
}
/*
@@ -4194,20 +4099,34 @@ MergeSort(headPtr, infoPtr)
* The unified list of SortElement structures.
*
* Side effects:
- * None, unless a user-defined comparison command does something weird.
+ * If infoPtr->unique is set then infoPtr->numElements may be updated.
+ * Possibly others, if a user-defined comparison command does something
+ * weird.
+ *
+ * Note:
+ * If infoPtr->unique is set, the merge assumes that there are no
+ * "repeated" elements in each of the left and right lists. In that case,
+ * if any element of the left list is equivalent to one in the right list
+ * it is omitted from the merged list.
+ *
+ * This simplified mechanism works because of the special way our
+ * MergeSort creates the sublists to be merged and will fail to eliminate
+ * all repeats in the general case where they are already present in
+ * either the left or right list. A general code would need to skip
+ * adjacent initial repeats in the left and right lists before comparing
+ * their initial elements, at each step.
*
*----------------------------------------------------------------------
*/
static SortElement *
-MergeLists(leftPtr, rightPtr, infoPtr)
- SortElement *leftPtr; /* First list to be merged; may be NULL. */
- SortElement *rightPtr; /* Second list to be merged; may be NULL. */
- SortInfo *infoPtr; /* Information needed by the comparison
+MergeLists(
+ SortElement *leftPtr, /* First list to be merged; may be NULL. */
+ SortElement *rightPtr, /* Second list to be merged; may be NULL. */
+ SortInfo *infoPtr) /* Information needed by the comparison
* operator. */
{
- SortElement *headPtr;
- SortElement *tailPtr;
+ SortElement *headPtr, *tailPtr;
int cmp;
if (leftPtr == NULL) {
@@ -4216,31 +4135,48 @@ MergeLists(leftPtr, rightPtr, infoPtr)
if (rightPtr == NULL) {
return leftPtr;
}
- cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
- if (cmp > 0) {
+ cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+ if (cmp > 0 || (cmp == 0 && infoPtr->unique)) {
+ if (cmp == 0) {
+ infoPtr->numElements--;
+ leftPtr = leftPtr->nextPtr;
+ }
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
- if (cmp == 0) {
- leftPtr->count++;
- }
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
}
headPtr = tailPtr;
- while ((leftPtr != NULL) && (rightPtr != NULL)) {
- cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
- if (cmp > 0) {
- tailPtr->nextPtr = rightPtr;
- tailPtr = rightPtr;
- rightPtr = rightPtr->nextPtr;
- } else {
- if (cmp == 0) {
- leftPtr->count++;
+ if (!infoPtr->unique) {
+ while ((leftPtr != NULL) && (rightPtr != NULL)) {
+ cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+ if (cmp > 0) {
+ tailPtr->nextPtr = rightPtr;
+ tailPtr = rightPtr;
+ rightPtr = rightPtr->nextPtr;
+ } else {
+ tailPtr->nextPtr = leftPtr;
+ tailPtr = leftPtr;
+ leftPtr = leftPtr->nextPtr;
+ }
+ }
+ } else {
+ while ((leftPtr != NULL) && (rightPtr != NULL)) {
+ cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+ if (cmp >= 0) {
+ if (cmp == 0) {
+ infoPtr->numElements--;
+ leftPtr = leftPtr->nextPtr;
+ }
+ tailPtr->nextPtr = rightPtr;
+ tailPtr = rightPtr;
+ rightPtr = rightPtr->nextPtr;
+ } else {
+ tailPtr->nextPtr = leftPtr;
+ tailPtr = leftPtr;
+ leftPtr = leftPtr->nextPtr;
}
- tailPtr->nextPtr = leftPtr;
- tailPtr = leftPtr;
- leftPtr = leftPtr->nextPtr;
}
}
if (leftPtr != NULL) {
@@ -4272,67 +4208,52 @@ MergeLists(leftPtr, rightPtr, infoPtr)
*/
static int
-SortCompare(objPtr1, objPtr2, infoPtr)
- Tcl_Obj *objPtr1, *objPtr2; /* Values to be compared. */
- SortInfo *infoPtr; /* Information passed from the top-level
+SortCompare(
+ SortElement *elemPtr1, SortElement *elemPtr2,
+ /* Values to be compared. */
+ SortInfo *infoPtr) /* Information passed from the top-level
* "lsort" command. */
{
- int order;
-
- order = 0;
- if (infoPtr->resultCode != TCL_OK) {
- /*
- * Once an error has occurred, skip any future comparisons so as to
- * preserve the error message in sortInterp->result.
- */
-
- return order;
- }
-
- objPtr1 = SelectObjFromSublist(objPtr1, infoPtr);
- if (infoPtr->resultCode != TCL_OK) {
- return order;
- }
- objPtr2 = SelectObjFromSublist(objPtr2, infoPtr);
- if (infoPtr->resultCode != TCL_OK) {
- return order;
- }
+ int order = 0;
if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = infoPtr->strCmpFn(TclGetString(objPtr1), TclGetString(objPtr2));
+ order = strcmp(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
+ } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
+ order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
- order = DictionaryCompare(
- TclGetString(objPtr1), TclGetString(objPtr2));
+ order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
+ elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
long a, b;
- if ((Tcl_GetLongFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
- || (Tcl_GetLongFromObj(infoPtr->interp, objPtr2, &b)
- != TCL_OK)) {
- infoPtr->resultCode = TCL_ERROR;
- return order;
- }
- if (a > b) {
- order = 1;
- } else if (b > a) {
- order = -1;
- }
+ a = elemPtr1->collationKey.intValue;
+ b = elemPtr2->collationKey.intValue;
+ order = ((a >= b) - (a <= b));
} else if (infoPtr->sortMode == SORTMODE_REAL) {
double a, b;
- if (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK
- || Tcl_GetDoubleFromObj(infoPtr->interp,objPtr2,&b) != TCL_OK){
- infoPtr->resultCode = TCL_ERROR;
- return order;
- }
- if (a > b) {
- order = 1;
- } else if (b > a) {
- order = -1;
- }
+ a = elemPtr1->collationKey.doubleValue;
+ b = elemPtr2->collationKey.doubleValue;
+ order = ((a >= b) - (a <= b));
} else {
Tcl_Obj **objv, *paramObjv[2];
int objc;
+ Tcl_Obj *objPtr1, *objPtr2;
+
+ if (infoPtr->resultCode != TCL_OK) {
+ /*
+ * Once an error has occurred, skip any future comparisons so as
+ * to preserve the error message in sortInterp->result.
+ */
+
+ return 0;
+ }
+
+
+ objPtr1 = elemPtr1->collationKey.objValuePtr;
+ objPtr2 = elemPtr2->collationKey.objValuePtr;
paramObjv[0] = objPtr1;
paramObjv[1] = objPtr2;
@@ -4342,31 +4263,31 @@ SortCompare(objPtr1, objPtr2, infoPtr)
* Replace them and evaluate the result.
*/
- Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+ TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
2, 2, paramObjv);
- Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+ TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
&objc, &objv);
infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
if (infoPtr->resultCode != TCL_OK) {
- Tcl_AddErrorInfo(infoPtr->interp,
- "\n (-compare command)");
- return order;
+ Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)");
+ return 0;
}
/*
* Parse the result of the command.
*/
- if (Tcl_GetIntFromObj(infoPtr->interp,
+ 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 order;
+ return 0;
}
}
if (!infoPtr->isIncreasing) {
@@ -4400,8 +4321,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
*/
static int
-DictionaryCompare(left, right)
- char *left, *right; /* The strings to compare. */
+DictionaryCompare(
+ const char *left, const char *right) /* The strings to compare. */
{
Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
int diff, zeros;
@@ -4418,11 +4339,11 @@ DictionaryCompare(left, right)
*/
zeros = 0;
- while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
+ while ((*right == '0') && isdigit(UCHAR(right[1]))) {
right++;
zeros--;
}
- while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
+ while ((*left == '0') && isdigit(UCHAR(left[1]))) {
left++;
zeros++;
}
@@ -4479,7 +4400,7 @@ DictionaryCompare(left, right)
* Convert both chars to lower for the comparison, because
* dictionary sorts are case insensitve. Covert to lower, not
* upper, so chars between Z and a will sort before A (where most
- * other interesting punctuations occur)
+ * other interesting punctuations occur).
*/
uniLeftLower = Tcl_UniCharToLower(uniLeft);
@@ -4492,7 +4413,8 @@ DictionaryCompare(left, right)
diff = uniLeftLower - uniRightLower;
if (diff) {
return diff;
- } else if (secondaryDiff == 0) {
+ }
+ if (secondaryDiff == 0) {
if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
secondaryDiff = -1;
} else if (Tcl_UniCharIsUpper(uniRight)
@@ -4512,9 +4434,8 @@ DictionaryCompare(left, right)
*
* SelectObjFromSublist --
*
- * This procedure is invoked from lsearch and SortCompare. It is used
- * for implementing the -index option, for the lsort and lsearch
- * commands.
+ * This procedure is invoked from lsearch and SortCompare. It is used for
+ * implementing the -index option, for the lsort and lsearch commands.
*
* Results:
* Returns NULL if a failure occurs, and sets the result in the infoPtr.
@@ -4530,10 +4451,10 @@ DictionaryCompare(left, right)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-SelectObjFromSublist(objPtr, infoPtr)
- Tcl_Obj *objPtr; /* Obj to select sublist from. */
- SortInfo *infoPtr; /* Information passed from the top-level
+static Tcl_Obj *
+SelectObjFromSublist(
+ Tcl_Obj *objPtr, /* Obj to select sublist from. */
+ SortInfo *infoPtr) /* Information passed from the top-level
* "lsearch" or "lsort" command. */
{
int i;
@@ -4555,8 +4476,7 @@ SelectObjFromSublist(objPtr, infoPtr)
int listLen, index;
Tcl_Obj *currentObj;
- if (Tcl_ListObjLength(infoPtr->interp, objPtr,
- &listLen) != TCL_OK) {
+ if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
@@ -4576,11 +4496,11 @@ SelectObjFromSublist(objPtr, infoPtr)
return NULL;
}
if (currentObj == NULL) {
- char buffer[TCL_INTEGER_SPACE];
- TclFormatInt(buffer, index);
- Tcl_AppendResult(infoPtr->interp,
- "element ", buffer, " missing from sublist \"",
- TclGetString(objPtr), "\"", (char *) 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;
}
@@ -4594,5 +4514,6 @@ SelectObjFromSublist(objPtr, infoPtr)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
* End:
*/
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index b4a7d5a..00c9f2f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -10,16 +10,61 @@
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Scriptics Corporation.
* Copyright (c) 2002 ActiveState Corporation.
- * Copyright (c) 2003 Donal K. Fellows.
+ * 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: tclCmdMZ.c,v 1.131 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclStringTrim.h"
+
+static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
+ Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
+static int SwitchPostProc(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int TryPostBody(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int TryPostFinal(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int TryPostHandler(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int UniCharIsAscii(int character);
+static int UniCharIsHexDigit(int character);
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters [TIP #413]
+ */
+
+const char tclDefaultTrimSet[] =
+ "\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) */
+;
/*
*----------------------------------------------------------------------
@@ -38,13 +83,12 @@
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_PwdObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_PwdObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *retVal;
@@ -79,23 +123,22 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_RegexpObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_RegexpObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int i, indices, match, about, offset, all, doinline, numMatchesSaved;
- int cflags, eflags, stringLength;
+ int cflags, eflags, stringLength, matchLength;
Tcl_RegExp regExpr;
Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
Tcl_RegExpInfo info;
- static CONST char *options[] = {
+ static const char *const options[] = {
"-all", "-about", "-indices", "-inline",
"-expanded", "-line", "-linestop", "-lineanchor",
- "-nocase", "-start", "--", (char *) NULL
+ "-nocase", "-start", "--", NULL
};
enum options {
REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE,
@@ -106,13 +149,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
indices = 0;
about = 0;
cflags = TCL_REG_ADVANCED;
- eflags = 0;
offset = 0;
all = 0;
doinline = 0;
for (i = 1; i < objc; i++) {
- char *name;
+ const char *name;
int index;
name = TclGetString(objv[i]);
@@ -156,7 +198,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
if (++i >= objc) {
goto endOfForLoop;
}
- if (TclGetIntForIndex(interp, objv[i], 0, &temp) != TCL_OK) {
+ if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) {
goto optionError;
}
if (startIndex) {
@@ -175,7 +217,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
endOfForLoop:
if ((objc - i) < (2 - about)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+ "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
goto optionError;
}
objc -= i;
@@ -187,8 +229,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
*/
if (doinline && ((objc - 2) != 0)) {
- Tcl_AppendResult(interp, "regexp match variables not allowed",
- " when using -inline", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "regexp match variables not allowed when using -inline", -1));
goto optionError;
}
@@ -218,7 +260,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
- TclGetIntForIndex(NULL, startIndex, stringLength, &offset);
+ TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
@@ -230,15 +272,6 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- if (offset > 0) {
- /*
- * Add flag if using offset (string is part of a larger string), so
- * that "^" won't match.
- */
-
- eflags |= TCL_REG_NOTBOL;
- }
-
objc -= 2;
objv += 2;
@@ -266,12 +299,26 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
*/
while (1) {
- match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
- offset /* offset */, numMatchesSaved, eflags
- | ((offset > 0 &&
- (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
- ? TCL_REG_NOTBOL : 0));
+ /*
+ * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing
+ * TCL_REG_NOTBOL indicates that the character at offset should not be
+ * considered the start of the line. If for example the pattern {^} is
+ * passed and -start is positive, then the pattern will not match the
+ * start of the string unless the previous character is a newline.
+ */
+ 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;
+ }
+
+ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
+ numMatchesSaved, eflags);
if (match < 0) {
return TCL_ERROR;
}
@@ -364,12 +411,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
} else {
- Tcl_Obj *valuePtr;
- valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
- if (valuePtr == NULL) {
- Tcl_DecrRefCount(newPtr);
- Tcl_AppendResult(interp, "couldn't set variable \"",
- TclGetString(objv[i]), "\"", (char *) NULL);
+ if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
}
@@ -389,12 +432,19 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
* offset never changes).
*/
- if (info.matches[0].end == 0) {
+ matchLength = (info.matches[0].end - info.matches[0].start);
+
+ offset += info.matches[0].end;
+
+ /*
+ * A match of length zero could happen for {^} {$} or {.*} and in
+ * these cases we always want to bump the index up one.
+ */
+
+ if (matchLength == 0) {
offset++;
}
- offset += info.matches[0].end;
all++;
- eflags |= TCL_REG_NOTBOL;
if (offset >= stringLength) {
break;
}
@@ -431,13 +481,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_RegsubObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_RegsubObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
int start, end, subStart, subEnd, match;
@@ -446,7 +495,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
- static CONST char *options[] = {
+ static const char *const options[] = {
"-all", "-nocase", "-expanded",
"-line", "-linestop", "-lineanchor", "-start",
"--", NULL
@@ -463,7 +512,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
resultPtr = NULL;
for (idx = 1; idx < objc; idx++) {
- char *name;
+ const char *name;
int index;
name = TclGetString(objv[idx]);
@@ -498,7 +547,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
if (++idx >= objc) {
goto endOfForLoop;
}
- if (TclGetIntForIndex(interp, objv[idx], 0, &temp) != TCL_OK) {
+ if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) {
goto optionError;
}
if (startIndex) {
@@ -517,7 +566,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
endOfForLoop:
if (objc-idx < 3 || objc-idx > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? exp string subSpec ?varName?");
+ "?-switch ...? exp string subSpec ?varName?");
optionError:
if (startIndex) {
Tcl_DecrRefCount(startIndex);
@@ -531,7 +580,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
if (startIndex) {
int stringLength = Tcl_GetCharLength(objv[1]);
- TclGetIntForIndex(NULL, startIndex, stringLength, &offset);
+ TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
@@ -547,7 +596,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
*/
int slen, nocase;
- int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long);
+ int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
Tcl_UniChar *p, wsrclc;
numMatches = 0;
@@ -791,9 +840,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
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]), "\"", (char *) NULL);
+ if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
} else {
/*
@@ -841,15 +889,14 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_RenameObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Arbitrary value passed to the command. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_RenameObjCmd(
+ ClientData dummy, /* Arbitrary value passed to the command. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *oldName, *newName;
+ const char *oldName, *newName;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
@@ -878,13 +925,12 @@ Tcl_RenameObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_ReturnObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ReturnObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int code, level;
Tcl_Obj *returnOpts;
@@ -926,15 +972,24 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_SourceObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SourceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- CONST char *encodingName = NULL;
+ return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRSourceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *encodingName = NULL;
Tcl_Obj *fileName;
if (objc != 2 && objc !=4) {
@@ -945,19 +1000,19 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
fileName = objv[objc-1];
if (objc == 4) {
- static CONST char *options[] = {
- "-encoding", (char *) NULL
+ static const char *const options[] = {
+ "-encoding", NULL
};
int index;
- if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1],
- options, "option", TCL_EXACT, &index)) {
+ if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options,
+ "option", TCL_EXACT, &index)) {
return TCL_ERROR;
}
encodingName = TclGetString(objv[2]);
}
- return Tcl_FSEvalFileEx(interp, fileName, encodingName);
+ return TclNREvalFile(interp, fileName, encodingName);
}
/*
@@ -977,17 +1032,18 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_SplitObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SplitObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar ch;
int len;
- char *splitChars, *stringPtr, *end;
+ const char *splitChars;
+ const char *stringPtr;
+ const char *end;
int splitCharLen, stringLen;
Tcl_Obj *listPtr, *objPtr;
@@ -995,13 +1051,13 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
splitChars = " \n\t\r";
splitCharLen = 4;
} else if (objc == 3) {
- splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
+ splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
return TCL_ERROR;
}
- stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
+ stringPtr = TclGetStringFromObj(objv[1], &stringLen);
end = stringPtr + stringLen;
listPtr = Tcl_NewObj();
@@ -1032,17 +1088,18 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
* Assume Tcl_UniChar is an integral type...
*/
- hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew);
+ hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
+ &isNew);
if (isNew) {
- objPtr = Tcl_NewStringObj(stringPtr, len);
+ TclNewStringObj(objPtr, stringPtr, len);
/*
* Don't need to fiddle with refcount...
*/
- Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+ Tcl_SetHashValue(hPtr, objPtr);
} else {
- objPtr = (Tcl_Obj*) Tcl_GetHashValue(hPtr);
+ objPtr = Tcl_GetHashValue(hPtr);
}
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
@@ -1062,10 +1119,10 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
stringPtr = p + 1;
}
- objPtr = Tcl_NewStringObj(stringPtr, end - stringPtr);
+ TclNewStringObj(objPtr, stringPtr, end - stringPtr);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
} else {
- char *element, *p, *splitEnd;
+ const char *element, *p, *splitEnd;
int splitLen;
Tcl_UniChar splitChar;
@@ -1081,7 +1138,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
for (p = splitChars; p < splitEnd; p += splitLen) {
splitLen = TclUtfToUniChar(p, &splitChar);
if (ch == splitChar) {
- objPtr = Tcl_NewStringObj(element, stringPtr - element);
+ TclNewStringObj(objPtr, element, stringPtr - element);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
element = stringPtr + len;
break;
@@ -1089,7 +1146,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
}
}
- objPtr = Tcl_NewStringObj(element, stringPtr - element);
+ TclNewStringObj(objPtr, element, stringPtr - element);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
Tcl_SetObjResult(interp, listPtr);
@@ -1099,16 +1156,11 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_StringObjCmd --
- *
- * This procedure is invoked to process the "string" Tcl command. See the
- * user documentation for details on what it does. Note that this command
- * only functions correctly on properly formed Tcl UTF strings.
+ * StringFirstCmd --
*
- * Note that the primary methods here (equal, compare, match, ...) have
- * bytecode equivalents. You will find the code for those in
- * tclExecute.c. The code here will only be used in the non-bc case (like
- * in an 'eval').
+ * This procedure is invoked to process the "string first" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
*
* Results:
* A standard Tcl result.
@@ -1119,363 +1171,409 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-int
-Tcl_StringObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+StringFirstCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index, left, right;
- char *string1, *string2;
- int length1, length2;
- static CONST char *options[] = {
- "bytelength", "compare", "equal", "first",
- "index", "is", "last", "length",
- "map", "match", "range", "repeat",
- "replace", "tolower", "toupper", "totitle",
- "trim", "trimleft", "trimright",
- "wordend", "wordstart", (char *) NULL
- };
- enum options {
- STR_BYTELENGTH, STR_COMPARE, STR_EQUAL, STR_FIRST,
- STR_INDEX, STR_IS, STR_LAST, STR_LENGTH,
- STR_MAP, STR_MATCH, STR_RANGE, STR_REPEAT,
- STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE,
- STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
- STR_WORDEND, STR_WORDSTART
- };
+ Tcl_UniChar *needleStr, *haystackStr;
+ int match, start, needleLen, haystackLen;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "needleString haystackString ?startIndex?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
+ /*
+ * We are searching haystackStr for the sequence needleStr.
+ */
+
+ match = -1;
+ start = 0;
+ haystackLen = -1;
+
+ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+ haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
- switch ((enum options) index) {
- case STR_EQUAL:
- case STR_COMPARE: {
+ if (objc == 4) {
/*
- * Remember to keep code here in some sync with the byte-compiled
- * versions in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and
- * INST_STR_CMP as well as the expr string comparison in
- * INST_EQ/INST_NEQ/INST_LT/...).
+ * If a startIndex is specified, we will need to fast forward to that
+ * point in the string before we think about a match.
*/
- int i, match, length, nocase = 0, reqlength = -1;
- typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
- strCmpFn_t strCmpFn;
-
- if (objc < 4 || objc > 7) {
- str_cmp_args:
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-nocase? ?-length int? string1 string2");
+ if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+ &start) != TCL_OK){
return TCL_ERROR;
}
- for (i = 2; i < objc-2; i++) {
- string2 = Tcl_GetStringFromObj(objv[i], &length2);
- if ((length2 > 1)
- && strncmp(string2, "-nocase", (size_t)length2) == 0) {
- nocase = 1;
- } else if ((length2 > 1)
- && strncmp(string2, "-length", (size_t)length2) == 0) {
- if (i+1 >= objc-2) {
- goto str_cmp_args;
- }
- if (Tcl_GetIntFromObj(interp, objv[++i],
- &reqlength) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", (char *) NULL);
- return TCL_ERROR;
- }
- }
-
/*
- * From now on, we only access the two objects at the end of the
- * argument array.
+ * Reread to prevent shimmering problems.
*/
- objv += objc-2;
+ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+ haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
- if ((reqlength == 0) || (objv[0] == objv[1])) {
+ if (start >= haystackLen) {
+ goto str_first_done;
+ } else if (start > 0) {
+ haystackStr += start;
+ haystackLen -= start;
+ } else if (start < 0) {
/*
- * Always match at 0 chars of if it is the same obj.
+ * Invalid start index mapped to string start; Bug #423581
*/
- Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj((enum options) index == STR_EQUAL));
- break;
- } else if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
- objv[1]->typePtr == &tclByteArrayType) {
- /*
- * Use binary versions of comparisons since that won't cause undue
- * type conversions and it is much faster. Only do this if we're
- * case-sensitive (which is all that really makes sense with byte
- * arrays anyway, and we have no memcasecmp() for some
- * reason... :^)
- */
+ start = 0;
+ }
+ }
- string1 = (char*) Tcl_GetByteArrayFromObj(objv[0], &length1);
- string2 = (char*) Tcl_GetByteArrayFromObj(objv[1], &length2);
- strCmpFn = (strCmpFn_t) memcmp;
- } else if ((objv[0]->typePtr == &tclStringType)
- && (objv[1]->typePtr == &tclStringType)) {
- /*
- * Do a unicode-specific comparison if both of the args are of
- * String type. In benchmark testing this proved the most
- * efficient check between the unicode and string comparison
- * operations.
- */
+ /*
+ * If the length of the needle is more than the length of the haystack, it
+ * cannot be contained in there so we can avoid searching. [Bug 2960021]
+ */
- string1 = (char*) Tcl_GetUnicodeFromObj(objv[0], &length1);
- string2 = (char*) Tcl_GetUnicodeFromObj(objv[1], &length2);
- strCmpFn = (strCmpFn_t)
- (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
- } else {
+ if (needleLen > 0 && needleLen <= haystackLen) {
+ register Tcl_UniChar *p, *end;
+
+ end = haystackStr + haystackLen - needleLen + 1;
+ for (p = haystackStr; p < end; p++) {
/*
- * As a catch-all we will work with UTF-8. We cannot use memcmp()
- * as that is unsafe with any string containing NULL (\xC0\x80 in
- * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
- * we are case-sensitive and no specific length was requested.
+ * Scan forward to find the first character.
*/
- string1 = (char*) Tcl_GetStringFromObj(objv[0], &length1);
- string2 = (char*) Tcl_GetStringFromObj(objv[1], &length2);
- if ((reqlength < 0) && !nocase) {
- strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
- } else {
- length1 = Tcl_NumUtfChars(string1, length1);
- length2 = Tcl_NumUtfChars(string2, length2);
- strCmpFn = (strCmpFn_t)
- (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+ if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
+ (unsigned long) needleLen) == 0)) {
+ match = p - haystackStr;
+ break;
}
}
+ }
- if (((enum options) index == STR_EQUAL)
- && (reqlength < 0) && (length1 != length2)) {
- match = 1; /* this will be reversed below */
- } else {
- length = (length1 < length2) ? length1 : length2;
- if (reqlength > 0 && reqlength < length) {
- length = reqlength;
- } else if (reqlength < 0) {
- /*
- * The requested length is negative, so we ignore it by
- * setting it to length + 1 so we correct the match var.
- */
+ /*
+ * Compute the character index of the matching string by counting the
+ * number of characters before the match.
+ */
- reqlength = length + 1;
- }
+ if ((match != -1) && (objc == 4)) {
+ match += start;
+ }
- match = strCmpFn(string1, string2, (unsigned) length);
- if ((match == 0) && (reqlength > length)) {
- match = length1 - length2;
- }
- }
+ str_first_done:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringLastCmd --
+ *
+ * This procedure is invoked to process the "string last" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- if ((enum options) index == STR_EQUAL) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- (match > 0) ? 1 : (match < 0) ? -1 : 0));
- }
- break;
+static int
+StringLastCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_UniChar *needleStr, *haystackStr, *p;
+ int match, start, needleLen, haystackLen;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "needleString haystackString ?startIndex?");
+ return TCL_ERROR;
}
- case STR_FIRST: {
- Tcl_UniChar *ustring1, *ustring2;
- int match, start;
- if (objc < 4 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "subString string ?startIndex?");
+ /*
+ * We are searching haystackString for the sequence needleString.
+ */
+
+ match = -1;
+ start = 0;
+ haystackLen = -1;
+
+ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+ haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+
+ if (objc == 4) {
+ /*
+ * If a startIndex is specified, we will need to restrict the string
+ * range to that char index in the string
+ */
+
+ if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+ &start) != TCL_OK){
return TCL_ERROR;
}
/*
- * We are searching string2 for the sequence string1.
+ * Reread to prevent shimmering problems.
*/
- match = -1;
- start = 0;
- length2 = -1;
+ needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+ haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
- ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
- ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
+ if (start < 0) {
+ goto str_last_done;
+ } else if (start < haystackLen) {
+ p = haystackStr + start + 1 - needleLen;
+ } else {
+ p = haystackStr + haystackLen - needleLen;
+ }
+ } else {
+ p = haystackStr + haystackLen - needleLen;
+ }
- if (objc == 5) {
+ /*
+ * If the length of the needle is more than the length of the haystack, it
+ * cannot be contained in there so we can avoid searching. [Bug 2960021]
+ */
+
+ if (needleLen > 0 && needleLen <= haystackLen) {
+ for (; p >= haystackStr; p--) {
/*
- * If a startIndex is specified, we will need to fast forward to
- * that point in the string before we think about a match.
+ * Scan backwards to find the first character.
*/
- if (TclGetIntForIndex(interp, objv[4], length2 - 1,
- &start) != TCL_OK) {
- return TCL_ERROR;
- }
- if (start >= length2) {
- goto str_first_done;
- } else if (start > 0) {
- ustring2 += start;
- length2 -= start;
- } else if (start < 0) {
- /*
- * Invalid start index mapped to string start; Bug #423581
- */
-
- start = 0;
+ if ((*p == *needleStr) && !memcmp(needleStr, p,
+ sizeof(Tcl_UniChar) * (size_t)needleLen)) {
+ match = p - haystackStr;
+ break;
}
}
+ }
- if (length1 > 0) {
- register Tcl_UniChar *p, *end;
+ str_last_done:
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringIndexCmd --
+ *
+ * This procedure is invoked to process the "string index" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- end = ustring2 + length2 - length1 + 1;
- for (p = ustring2; p < end; p++) {
- /*
- * Scan forward to find the first character.
- */
- if ((*p == *ustring1) && (TclUniCharNcmp(ustring1, p,
- (unsigned long) length1) == 0)) {
- match = p - ustring2;
- break;
- }
- }
- }
+static int
+StringIndexCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length, index;
- /*
- * Compute the character index of the matching string by counting the
- * number of characters before the match.
- */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
+ return TCL_ERROR;
+ }
- if ((match != -1) && (objc == 5)) {
- match += start;
- }
+ /*
+ * Get the char length to calulate what 'end' means.
+ */
- str_first_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
- break;
+ length = Tcl_GetCharLength(objv[1]);
+ if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
+ return TCL_ERROR;
}
- case STR_INDEX: {
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
- return TCL_ERROR;
- }
+
+ if ((index >= 0) && (index < length)) {
+ Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
/*
- * If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
- * use the Unicode string rep to get the index'th char.
+ * If we have a ByteArray object, we're careful to generate a new
+ * bytearray for a result.
*/
- if (objv[2]->typePtr == &tclByteArrayType) {
- string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
+ if (TclIsPureByteArray(objv[1])) {
+ unsigned char uch = (unsigned char) ch;
- if (TclGetIntForIndex(interp, objv[3], length1 - 1,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
- if ((index >= 0) && (index < length1)) {
- Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
- (unsigned char *)(&string1[index]), 1));
- }
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
- /*
- * Get Unicode char length to calulate what 'end' means.
- */
+ char buf[TCL_UTF_MAX];
- length1 = Tcl_GetCharLength(objv[2]);
-
- if (TclGetIntForIndex(interp, objv[3], length1 - 1,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
- if ((index >= 0) && (index < length1)) {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar ch;
-
- ch = Tcl_GetUniChar(objv[2], index);
- length1 = Tcl_UniCharToUtf(ch, buf);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length1));
- }
+ length = Tcl_UniCharToUtf(ch, buf);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
}
- break;
}
- case STR_IS: {
- char *end;
- Tcl_UniChar ch;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringIsCmd --
+ *
+ * This procedure is invoked to process the "string is" Tcl command. See
+ * the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * The UniChar comparison function
- */
+static int
+StringIsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *string1, *end, *stop;
+ Tcl_UniChar ch;
+ int (*chcomp)(int) = NULL; /* The UniChar comparison function. */
+ int i, failat = 0, result = 1, strict = 0, index, length1, length2;
+ Tcl_Obj *objPtr, *failVarObj = NULL;
+ Tcl_WideInt w;
+
+ static const char *const isClasses[] = {
+ "alnum", "alpha", "ascii", "control",
+ "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_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
+ };
+ enum isOptions {
+ OPT_STRICT, OPT_FAILIDX
+ };
- int (*chcomp)(int) = NULL;
- int i, failat = 0, result = 1, strict = 0;
- Tcl_Obj *objPtr, *failVarObj = NULL;
- Tcl_WideInt w;
-
- static CONST char *isOptions[] = {
- "alnum", "alpha", "ascii", "control",
- "boolean", "digit", "double", "false",
- "graph", "integer", "lower", "print",
- "punct", "space", "true", "upper",
- "wideinteger", "wordchar", "xdigit", (char *) NULL
- };
- enum isOptions {
- 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_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
- };
+ if (objc < 3 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "class ?-strict? ?-failindex var? str");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
- if (objc < 4 || objc > 7) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "class ?-strict? ?-failindex var? str");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[2], isOptions, "class", 0,
- &index) != TCL_OK) {
- return TCL_ERROR;
- }
- if (objc != 4) {
- for (i = 3; i < objc-1; i++) {
- string2 = Tcl_GetStringFromObj(objv[i], &length2);
- if ((length2 > 1) &&
- strncmp(string2, "-strict", (size_t) length2) == 0) {
- strict = 1;
- } else if ((length2 > 1) &&
- strncmp(string2, "-failindex", (size_t) length2) == 0){
- if (i+1 >= objc-1) {
- Tcl_WrongNumArgs(interp, 3, objv,
- "?-strict? ?-failindex var? str");
- return TCL_ERROR;
- }
- failVarObj = objv[++i];
- } else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -strict or -failindex", (char *)NULL);
+ if (objc != 3) {
+ for (i = 2; i < objc-1; i++) {
+ int idx2;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0,
+ &idx2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum isOptions) idx2) {
+ case OPT_STRICT:
+ strict = 1;
+ break;
+ case OPT_FAILIDX:
+ if (i+1 >= objc-1) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-strict? ?-failindex var? str");
return TCL_ERROR;
}
+ failVarObj = objv[++i];
+ break;
}
}
+ }
- /*
- * We get the objPtr so that we can short-cut for some classes by
- * checking the object type (int and double), but we need the string
- * otherwise, because we don't want any conversion of type occuring
- * (as, for example, Tcl_Get*FromObj would do
- */
+ /*
+ * We get the objPtr so that we can short-cut for some classes by checking
+ * the object type (int and double), but we need the string otherwise,
+ * because we don't want any conversion of type occuring (as, for example,
+ * Tcl_Get*FromObj would do).
+ */
- objPtr = objv[objc-1];
- string1 = Tcl_GetStringFromObj(objPtr, &length1);
+ objPtr = objv[objc-1];
+
+ /*
+ * When entering here, result == 1 and failat == 0.
+ */
+
+ switch ((enum isClasses) index) {
+ case STR_IS_ALNUM:
+ chcomp = Tcl_UniCharIsAlnum;
+ break;
+ case STR_IS_ALPHA:
+ chcomp = Tcl_UniCharIsAlpha;
+ break;
+ case STR_IS_ASCII:
+ chcomp = UniCharIsAscii;
+ break;
+ case STR_IS_BOOL:
+ case STR_IS_TRUE:
+ case STR_IS_FALSE:
+ if ((objPtr->typePtr != &tclBooleanType)
+ && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
+ if (strict) {
+ result = 0;
+ } else {
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ result = length1 == 0;
+ }
+ } else if (((index == STR_IS_TRUE) &&
+ objPtr->internalRep.longValue == 0)
+ || ((index == STR_IS_FALSE) &&
+ objPtr->internalRep.longValue != 0)) {
+ result = 0;
+ }
+ break;
+ case STR_IS_CONTROL:
+ chcomp = Tcl_UniCharIsControl;
+ break;
+ case STR_IS_DIGIT:
+ chcomp = Tcl_UniCharIsDigit;
+ break;
+ case STR_IS_DOUBLE: {
+ /* TODO */
+ if ((objPtr->typePtr == &tclDoubleType) ||
+ (objPtr->typePtr == &tclIntType) ||
+#ifndef TCL_WIDE_INT_IS_LONG
+ (objPtr->typePtr == &tclWideIntType) ||
+#endif
+ (objPtr->typePtr == &tclBignumType)) {
+ break;
+ }
+ string1 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
@@ -1483,987 +1581,1783 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
goto str_is_done;
}
end = string1 + length1;
-
- /*
- * When entering here, result == 1 and failat == 0
- */
-
- switch ((enum isOptions) index) {
- case STR_IS_ALNUM:
- chcomp = Tcl_UniCharIsAlnum;
- break;
- case STR_IS_ALPHA:
- chcomp = Tcl_UniCharIsAlpha;
- break;
- case STR_IS_ASCII:
- for (; string1 < end; string1++, failat++) {
- /*
- * This is a valid check in unicode, because all bytes less
- * than 0xC0 are single byte chars (but isascii limits that
- * def'n to 0x80).
- */
-
- if (*((unsigned char *)string1) >= 0x80) {
- result = 0;
- break;
- }
- }
- break;
- case STR_IS_BOOL:
- case STR_IS_TRUE:
- case STR_IS_FALSE:
- if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) {
- result = 0;
- } else if ((((enum isOptions) index == STR_IS_TRUE) &&
- objPtr->internalRep.longValue == 0) ||
- (((enum isOptions) index == STR_IS_FALSE) &&
- objPtr->internalRep.longValue != 0)) {
+ if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+ (const char **) &stop, 0) != TCL_OK) {
+ result = 0;
+ failat = 0;
+ } else {
+ failat = stop - string1;
+ if (stop < end) {
result = 0;
+ TclFreeIntRep(objPtr);
}
+ }
+ break;
+ }
+ case STR_IS_GRAPH:
+ chcomp = Tcl_UniCharIsGraph;
+ break;
+ case STR_IS_INT:
+ if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
break;
- case STR_IS_CONTROL:
- chcomp = Tcl_UniCharIsControl;
- break;
- case STR_IS_DIGIT:
- chcomp = Tcl_UniCharIsDigit;
- break;
- case STR_IS_DOUBLE: {
- char *stop;
-
- if ((objPtr->typePtr == &tclDoubleType) ||
- (objPtr->typePtr == &tclIntType)) {
- break;
- }
-
- /*
- * This is adapted from Tcl_GetDouble
- *
- * The danger in this function is that "12345678901234567890" is
- * an acceptable 'double', but will later be interp'd as an int by
- * something like [expr]. Therefore, we check to see if it looks
- * like an int, and if so we do a range check on it. If strtoul
- * gets to the end, we know we either received an acceptable int,
- * or over/underflow.
- */
-
- if (TclLooksLikeInt(string1, length1)) {
- errno = 0;
-#ifdef TCL_WIDE_INT_IS_LONG
- strtoul(string1, &stop, 0); /* INTL: Tcl source. */
-#else
- strtoull(string1, &stop, 0); /* INTL: Tcl source. */
+ }
+ goto failedIntParse;
+ case STR_IS_ENTIER:
+ if ((objPtr->typePtr == &tclIntType) ||
+#ifndef TCL_WIDE_INT_IS_LONG
+ (objPtr->typePtr == &tclWideIntType) ||
#endif
- if (stop == end) {
- if (errno == ERANGE) {
- result = 0;
- failat = -1;
- }
- break;
- }
+ (objPtr->typePtr == &tclBignumType)) {
+ break;
+ }
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ if (length1 == 0) {
+ if (strict) {
+ result = 0;
}
- errno = 0;
- TclStrToD(string1, (CONST char **) &stop); /* INTL: Tcl source. */
- if (stop == string1) {
+ 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) {
/*
- * In this case, nothing like a number was found.
+ * Entire string parses as an integer.
*/
- result = 0;
- failat = 0;
+ break;
} else {
/*
- * Assume we sucked up one char per byte and then we go onto
- * SPACE, since we are allowed trailing whitespace.
+ * 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;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
+ TclFreeIntRep(objPtr);
}
- break;
+ } else {
+ /*
+ * No prefix is a valid integer. Fail at beginning.
+ */
+
+ result = 0;
+ failat = 0;
}
- case STR_IS_GRAPH:
- chcomp = Tcl_UniCharIsGraph;
+ break;
+ case STR_IS_WIDE:
+ if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
break;
- case STR_IS_INT: {
- char *stop;
- long int l = 0;
+ }
- if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) {
- break;
+ failedIntParse:
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ if (length1 == 0) {
+ if (strict) {
+ result = 0;
}
-
+ goto str_is_done;
+ }
+ result = 0;
+ if (failVarObj == NULL) {
/*
- * Like STR_IS_DOUBLE, but we use strtoul. Since Tcl_GetIntFromObj
- * already failed, we set result to 0.
+ * Don't bother computing the failure point if we're not going to
+ * return it.
*/
- result = 0;
- errno = 0;
- l = strtol(string1, &stop, 0); /* INTL: Tcl source. */
- if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
+ break;
+ }
+ end = string1 + length1;
+ if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+ (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+ if (stop == end) {
/*
- * if (errno == ERANGE) or the long value won't fit in an int,
- * then it was an over/underflow problem, but in this method,
- * we only want to know yes or no, so bad flow returns 0
- * (false) and sets the failVarObj to the string length.
+ * Entire string parses as an integer, but rejected by
+ * Tcl_Get(Wide)IntFromObj() so we must have overflowed the
+ * target type, and our convention is to return failure at
+ * index -1 in that situation.
*/
failat = -1;
- } else if (stop == string1) {
- /*
- * In this case, nothing like a number was found
- */
-
- failat = 0;
} else {
/*
- * Assume we sucked up one char per byte and then we go onto
- * SPACE, since we are allowed trailing whitespace.
+ * 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.
*/
failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
+ TclFreeIntRep(objPtr);
}
- break;
+ } else {
+ /*
+ * No prefix is a valid integer. Fail at beginning.
+ */
+
+ failat = 0;
}
- case STR_IS_LOWER:
- chcomp = Tcl_UniCharIsLower;
- break;
- case STR_IS_PRINT:
- chcomp = Tcl_UniCharIsPrint;
- break;
- case STR_IS_PUNCT:
- chcomp = Tcl_UniCharIsPunct;
- break;
- case STR_IS_SPACE:
- chcomp = Tcl_UniCharIsSpace;
- break;
- case STR_IS_UPPER:
- chcomp = Tcl_UniCharIsUpper;
- break;
- case STR_IS_WIDE: {
- char *stop;
+ break;
+ case STR_IS_LIST:
+ /*
+ * We ignore the strictness here, since empty strings are always
+ * well-formed lists.
+ */
- if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
- break;
- }
+ if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) {
+ break;
+ }
+ if (failVarObj != NULL) {
/*
- * Like STR_IS_DOUBLE, but we use strtoll. Since
- * Tcl_GetWideIntFromObj already failed, we set result to 0.
+ * Need to figure out where the list parsing failed, which is
+ * fairly expensive. This is adapted from the core of
+ * SetListFromAny().
*/
- result = 0;
- errno = 0;
- w = strtoll(string1, &stop, 0); /* INTL: Tcl source. */
- if (errno == ERANGE) {
- /*
- * if (errno == ERANGE), then it was an over/underflow
- * problem, but in this method, we only want to know yes or
- * no, so bad flow returns 0 (false) and sets the failVarObj
- * to the string length.
- */
+ const char *elemStart, *nextElem;
+ int lenRemain, elemSize;
+ register const char *p;
- failat = -1;
- } else if (stop == string1) {
- /*
- * In this case, nothing like a number was found
- */
- failat = 0;
- } else {
- /*
- * Assume we sucked up one char per byte and then we go onto
- * SPACE, since we are allowed trailing whitespace.
- */
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ end = string1 + length1;
+ failat = -1;
+ for (p=string1, lenRemain=length1; lenRemain > 0;
+ p=nextElem, lenRemain=end-nextElem) {
+ if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
+ &elemStart, &nextElem, &elemSize, NULL)) {
+ Tcl_Obj *tmpStr;
- failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
- }
- break;
- }
- case STR_IS_WORD:
- chcomp = Tcl_UniCharIsWordChar;
- break;
- case STR_IS_XDIGIT:
- for (; string1 < end; string1++, failat++) {
- /* INTL: We assume unicode is bad for this class */
- if ((*((unsigned char *)string1) >= 0xC0) ||
- !isxdigit(*(unsigned char *)string1)) {
- result = 0;
+ /*
+ * This is the simplest way of getting the number of
+ * characters parsed. Note that this is not the same as
+ * the number of bytes when parsing strings with non-ASCII
+ * characters in them.
+ *
+ * Skip leading spaces first. This is only really an issue
+ * if it is the first "element" that has the failure.
+ */
+
+ while (TclIsSpaceProc(*p)) {
+ p++;
+ }
+ TclNewStringObj(tmpStr, string1, p-string1);
+ failat = Tcl_GetCharLength(tmpStr);
+ TclDecrRefCount(tmpStr);
break;
}
}
- break;
}
- if (chcomp != NULL) {
- for (; string1 < end; string1 += length2, failat++) {
- length2 = TclUtfToUniChar(string1, &ch);
- if (!chcomp(ch)) {
- result = 0;
- break;
- }
+ result = 0;
+ break;
+ case STR_IS_LOWER:
+ chcomp = Tcl_UniCharIsLower;
+ break;
+ case STR_IS_PRINT:
+ chcomp = Tcl_UniCharIsPrint;
+ break;
+ case STR_IS_PUNCT:
+ chcomp = Tcl_UniCharIsPunct;
+ break;
+ case STR_IS_SPACE:
+ chcomp = Tcl_UniCharIsSpace;
+ break;
+ case STR_IS_UPPER:
+ chcomp = Tcl_UniCharIsUpper;
+ break;
+ case STR_IS_WORD:
+ chcomp = Tcl_UniCharIsWordChar;
+ break;
+ case STR_IS_XDIGIT:
+ chcomp = UniCharIsHexDigit;
+ break;
+ }
+
+ if (chcomp != NULL) {
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ if (length1 == 0) {
+ if (strict) {
+ result = 0;
+ }
+ goto str_is_done;
+ }
+ end = string1 + length1;
+ for (; string1 < end; string1 += length2, failat++) {
+ length2 = TclUtfToUniChar(string1, &ch);
+ if (!chcomp(ch)) {
+ result = 0;
+ break;
}
}
+ }
- /*
- * Only set the failVarObj when we will return 0 and we have indicated
- * a valid fail index (>= 0).
- */
+ /*
+ * Only set the failVarObj when we will return 0 and we have indicated a
+ * valid fail index (>= 0).
+ */
- str_is_done:
- if ((result == 0) && (failVarObj != NULL) &&
- Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
- TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
- break;
+ str_is_done:
+ if ((result == 0) && (failVarObj != NULL) &&
+ Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ return TCL_OK;
+}
+
+static int
+UniCharIsAscii(
+ int character)
+{
+ return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+ int character)
+{
+ return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMapCmd --
+ *
+ * This procedure is invoked to process the "string map" Tcl command. See
+ * the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMapCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length1, length2, mapElemc, index;
+ int nocase = 0, mapWithDict = 0, copySource = 0;
+ Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
+ Tcl_UniChar *ustring1, *ustring2, *p, *end;
+ int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long);
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
+ return TCL_ERROR;
}
- case STR_LAST: {
- Tcl_UniChar *ustring1, *ustring2, *p;
- int match, start;
- if (objc < 4 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "subString string ?startIndex?");
+ if (objc == 4) {
+ const char *string = TclGetStringFromObj(objv[1], &length2);
+
+ if ((length2 > 1) &&
+ strncmp(string, "-nocase", (size_t) length2) == 0) {
+ nocase = 1;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
return TCL_ERROR;
}
+ }
- /*
- * We are searching string2 for the sequence string1.
- */
+ /*
+ * This test is tricky, but has to be that way or you get other strange
+ * inconsistencies (see test string-10.20 for illustration why!)
+ */
- match = -1;
- start = 0;
- length2 = -1;
+ if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
+ int i, done;
+ Tcl_DictSearch search;
- ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
- ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
+ /*
+ * We know the type exactly, so all dict operations will succeed for
+ * sure. This shortens this code quite a bit.
+ */
- if (objc == 5) {
+ Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
+ if (mapElemc == 0) {
/*
- * If a startIndex is specified, we will need to restrict the
- * string range to that char index in the string
+ * Empty charMap, just return whatever string was given.
*/
- if (TclGetIntForIndex(interp, objv[4], length2 - 1,
- &start) != TCL_OK) {
- return TCL_ERROR;
- }
- if (start < 0) {
- goto str_last_done;
- } else if (start < length2) {
- p = ustring2 + start + 1 - length1;
- } else {
- p = ustring2 + length2 - length1;
- }
- } else {
- p = ustring2 + length2 - length1;
+ Tcl_SetObjResult(interp, objv[objc-1]);
+ return TCL_OK;
}
- if (length1 > 0) {
- for (; p >= ustring2; p--) {
- /*
- * Scan backwards to find the first character.
- */
+ mapElemc *= 2;
+ mapWithDict = 1;
- if ((*p == *ustring1) &&
- (memcmp((char *) ustring1, (char *) p, (size_t)
- (length1 * sizeof(Tcl_UniChar))) == 0)) {
- match = p - ustring2;
- break;
- }
- }
- }
+ /*
+ * Copy the dictionary out into an array; that's the easiest way to
+ * adapt this code...
+ */
- str_last_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
- break;
- }
- case STR_BYTELENGTH:
- case STR_LENGTH:
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
+ Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
+ mapElemv+1, &done);
+ for (i=2 ; i<mapElemc ; i+=2) {
+ Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
+ }
+ Tcl_DictObjDone(&search);
+ } else {
+ if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
+ &mapElemv) != TCL_OK) {
return TCL_ERROR;
}
+ if (mapElemc == 0) {
+ /*
+ * empty charMap, just return whatever string was given.
+ */
- if ((enum options) index == STR_BYTELENGTH) {
- (void) Tcl_GetStringFromObj(objv[2], &length1);
- } else {
+ Tcl_SetObjResult(interp, objv[objc-1]);
+ return TCL_OK;
+ } else if (mapElemc & 1) {
/*
- * If we have a ByteArray object, avoid recomputing the string
- * since the byte array contains one byte per character.
- * Otherwise, use the Unicode string rep to calculate the length.
+ * The charMap must be an even number of key/value items.
*/
- if (objv[2]->typePtr == &tclByteArrayType) {
- (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
- } else {
- length1 = Tcl_GetCharLength(objv[2]);
- }
- }
- Tcl_SetObjResult(interp, Tcl_NewIntObj(length1));
- break;
- case STR_MAP: {
- int mapElemc, nocase = 0, mapWithDict = 0, copySource = 0;
- Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
- Tcl_UniChar *ustring1, *ustring2, *p, *end;
- int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long);
-
- if (objc < 4 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("char map list unbalanced", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
+ "UNBALANCED", NULL);
return TCL_ERROR;
}
+ }
- if (objc == 5) {
- string2 = Tcl_GetStringFromObj(objv[2], &length2);
- if ((length2 > 1) &&
- strncmp(string2, "-nocase", (size_t) length2) == 0) {
- nocase = 1;
- } else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase", (char *) NULL);
- return TCL_ERROR;
- }
- }
+ /*
+ * Take a copy of the source string object if it is the same as the map
+ * string to cut out nasty sharing crashes. [Bug 1018562]
+ */
+ if (objv[objc-2] == objv[objc-1]) {
+ sourceObj = Tcl_DuplicateObj(objv[objc-1]);
+ copySource = 1;
+ } else {
+ sourceObj = objv[objc-1];
+ }
+ ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
+ if (length1 == 0) {
/*
- * This test is tricky, but has to be that way or you get other
- * strange inconsistencies (see test string-10.20 for illustration
- * why!)
+ * Empty input string, just stop now.
*/
- if (objv[objc-2]->typePtr == &tclDictType &&
- objv[objc-2]->bytes == NULL) {
- int i, done;
- Tcl_DictSearch search;
+ goto done;
+ }
+ end = ustring1 + length1;
- /*
- * We know the type exactly, so all dict operations will succeed
- * for sure. This shortens this code quite a bit.
- */
+ strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
- Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
- if (mapElemc == 0) {
- /*
- * empty charMap, just return whatever string was given
- */
+ /*
+ * Force result to be Unicode
+ */
- Tcl_SetObjResult(interp, objv[objc-1]);
- return TCL_OK;
- }
+ resultPtr = Tcl_NewUnicodeObj(ustring1, 0);
- mapElemc *= 2;
- mapWithDict = 1;
+ if (mapElemc == 2) {
+ /*
+ * Special case for one map pair which avoids the extra for loop and
+ * extra calls to get Unicode data. The algorithm is otherwise
+ * identical to the multi-pair case. This will be >30% faster on
+ * larger strings.
+ */
+
+ int mapLen;
+ Tcl_UniChar *mapString, u2lc;
+ ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
+ p = ustring1;
+ if ((length2 > length1) || (length2 == 0)) {
/*
- * Copy the dictionary out into an array; that's the easiest way
- * to adapt this code...
+ * Match string is either longer than input or empty.
*/
- mapElemv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * mapElemc);
- Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
- mapElemv+1, &done);
- for (i=2 ; i<mapElemc ; i+=2) {
- Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
- }
+ ustring1 = end;
} else {
- if (Tcl_ListObjGetElements(interp, objv[objc-2],
- &mapElemc, &mapElemv) != TCL_OK) {
- return TCL_ERROR;
- }
- if (mapElemc == 0) {
- /*
- * empty charMap, just return whatever string was given.
- */
-
- Tcl_SetObjResult(interp, objv[objc-1]);
- return TCL_OK;
- } else if (mapElemc & 1) {
- /*
- * The charMap must be an even number of key/value items.
- */
+ mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
+ u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
+ for (; ustring1 < end; ustring1++) {
+ if (((*ustring1 == *ustring2) ||
+ (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
+ (length2==1 || strCmpFn(ustring1, ustring2,
+ (unsigned long) length2) == 0)) {
+ if (p != ustring1) {
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ ustring1 = p - 1;
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "char map list unbalanced", -1));
- return TCL_ERROR;
+ Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
+ }
}
}
+ } else {
+ Tcl_UniChar **mapStrings, *u2lc = NULL;
+ int *mapLens;
/*
- * Take a copy of the source string object if it is the same as the
- * map string to cut out nasty sharing crashes. [Bug 1018562]
+ * Precompute pointers to the unicode string and length. This saves us
+ * repeated function calls later, significantly speeding up the
+ * algorithm. We only need the lowercase first char in the nocase
+ * case.
*/
- if (objv[objc-2] == objv[objc-1]) {
- sourceObj = Tcl_DuplicateObj(objv[objc-1]);
- copySource = 1;
- } else {
- sourceObj = objv[objc-1];
+ mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
+ mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
+ if (nocase) {
+ u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
}
- ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
- if (length1 == 0) {
- /*
- * Empty input string, just stop now.
- */
-
- if (mapWithDict) {
- ckfree((char *) mapElemv);
- }
- if (copySource) {
- Tcl_DecrRefCount(sourceObj);
+ for (index = 0; index < mapElemc; index++) {
+ mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
+ mapLens+index);
+ if (nocase && ((index % 2) == 0)) {
+ u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
}
- break;
}
- end = ustring1 + length1;
+ for (p = ustring1; ustring1 < end; ustring1++) {
+ for (index = 0; index < mapElemc; index += 2) {
+ /*
+ * Get the key string to match on.
+ */
- strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+ ustring2 = mapStrings[index];
+ length2 = mapLens[index];
+ if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
+ (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
+ /* Restrict max compare length. */
+ (end-ustring1 >= length2) && ((length2 == 1) ||
+ !strCmpFn(ustring2, ustring1, (unsigned) length2))) {
+ if (p != ustring1) {
+ /*
+ * Put the skipped chars onto the result first.
+ */
+
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ /*
+ * Adjust len to be full length of matched string.
+ */
+
+ ustring1 = p - 1;
+
+ /*
+ * Append the map value to the unicode string.
+ */
+
+ Tcl_AppendUnicodeToObj(resultPtr,
+ mapStrings[index+1], mapLens[index+1]);
+ break;
+ }
+ }
+ }
+ if (nocase) {
+ TclStackFree(interp, u2lc);
+ }
+ TclStackFree(interp, mapLens);
+ TclStackFree(interp, mapStrings);
+ }
+ if (p != ustring1) {
/*
- * Force result to be Unicode
+ * Put the rest of the unmapped chars onto result.
*/
- resultPtr = Tcl_NewUnicodeObj(ustring1, 0);
- if (mapElemc == 2) {
- /*
- * Special case for one map pair which avoids the extra for loop
- * and extra calls to get Unicode data. The algorithm is otherwise
- * identical to the multi-pair case. This will be >30% faster on
- * larger strings.
- */
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ done:
+ if (mapWithDict) {
+ TclStackFree(interp, mapElemv);
+ }
+ if (copySource) {
+ Tcl_DecrRefCount(sourceObj);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchCmd --
+ *
+ * This procedure is invoked to process the "string match" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- int mapLen;
- Tcl_UniChar *mapString, u2lc;
+static int
+StringMatchCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int nocase = 0;
- ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
- p = ustring1;
- if ((length2 > length1) || (length2 == 0)) {
- /*
- * Match string is either longer than input or empty.
- */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
+ return TCL_ERROR;
+ }
- ustring1 = end;
- } else {
- mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
- u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
- for (; ustring1 < end; ustring1++) {
- if (((*ustring1 == *ustring2) ||
- (nocase && Tcl_UniCharToLower(*ustring1)==u2lc)) &&
- (length2==1 || strCmpFn(ustring1, ustring2,
- (unsigned long) length2) == 0)) {
- if (p != ustring1) {
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
- p = ustring1 + length2;
- } else {
- p += length2;
- }
- ustring1 = p - 1;
+ if (objc == 4) {
+ int length;
+ const char *string = TclGetStringFromObj(objv[1], &length);
- Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
- }
- }
- }
+ if ((length > 1) &&
+ strncmp(string, "-nocase", (size_t) length) == 0) {
+ nocase = TCL_MATCH_NOCASE;
} else {
- Tcl_UniChar **mapStrings, *u2lc = NULL;
- int *mapLens;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringRangeCmd --
+ *
+ * This procedure is invoked to process the "string range" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Precompute pointers to the unicode string and length. This
- * saves us repeated function calls later, significantly speeding
- * up the algorithm. We only need the lowercase first char in the
- * nocase case.
- */
+static int
+StringRangeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length, first, last;
- mapStrings = (Tcl_UniChar **) ckalloc((mapElemc * 2)
- * sizeof(Tcl_UniChar *));
- mapLens = (int *) ckalloc((mapElemc * 2) * sizeof(int));
- if (nocase) {
- u2lc = (Tcl_UniChar *)
- ckalloc((mapElemc) * sizeof(Tcl_UniChar));
- }
- for (index = 0; index < mapElemc; index++) {
- mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
- &(mapLens[index]));
- if (nocase && ((index % 2) == 0)) {
- u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
- }
- }
- for (p = ustring1; ustring1 < end; ustring1++) {
- for (index = 0; index < mapElemc; index += 2) {
- /*
- * Get the key string to match on.
- */
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string first last");
+ return TCL_ERROR;
+ }
- ustring2 = mapStrings[index];
- length2 = mapLens[index];
- if ((length2 > 0) && ((*ustring1 == *ustring2) ||
- (nocase && (Tcl_UniCharToLower(*ustring1) ==
- u2lc[index/2]))) &&
- /* restrict max compare length */
- ((end - ustring1) >= length2) &&
- ((length2 == 1) || strCmpFn(ustring2, ustring1,
- (unsigned long) length2) == 0)) {
- if (p != ustring1) {
- /*
- * Put the skipped chars onto the result first.
- */
+ /*
+ * Get the length in actual characters; Then reduce it by one because
+ * 'end' refers to the last character, not one past it.
+ */
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
- p = ustring1 + length2;
- } else {
- p += length2;
- }
+ length = Tcl_GetCharLength(objv[1]) - 1;
- /*
- * Adjust len to be full length of matched string.
- */
+ if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
+ TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
- ustring1 = p - 1;
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length) {
+ last = length;
+ }
+ if (last >= first) {
+ Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReptCmd --
+ *
+ * This procedure is invoked to process the "string repeat" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Append the map value to the unicode string.
- */
+static int
+StringReptCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *string1;
+ char *string2;
+ int count, index, length1, length2;
+ Tcl_Obj *resultPtr;
- Tcl_AppendUnicodeToObj(resultPtr,
- mapStrings[index+1], mapLens[index+1]);
- break;
- }
- }
- }
- ckfree((char *) mapStrings);
- ckfree((char *) mapLens);
- if (nocase) {
- ckfree((char *) u2lc);
- }
- }
- if (p != ustring1) {
- /*
- * Put the rest of the unmapped chars onto result.
- */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string count");
+ return TCL_ERROR;
+ }
+
+ if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check for cases that allow us to skip copying stuff.
+ */
+
+ if (count == 1) {
+ Tcl_SetObjResult(interp, objv[1]);
+ goto done;
+ } else if (count < 1) {
+ goto done;
+ }
+ string1 = TclGetStringFromObj(objv[1], &length1);
+ if (length1 <= 0) {
+ goto done;
+ }
+
+ /*
+ * Only build up a string that has data. Instead of building it up with
+ * repeated appends, we just allocate the necessary space once and copy
+ * the string value in.
+ *
+ * We have to worry about overflow [Bugs 714106, 2561746].
+ * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
+ * We need to keep 2 <= length2 <= INT_MAX.
+ */
+
+ if (count > INT_MAX/length1) {
+ 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;
+
+ /*
+ * Include space for the NUL.
+ */
+
+ string2 = attemptckalloc((unsigned) length2 + 1);
+ if (string2 == NULL) {
+ /*
+ * Alloc failed. Note that in this case we try to do an error message
+ * since this is a case that's most likely when the alloc is large and
+ * that's easy to do with this API. Note that if we fail allocating a
+ * short string, this will likely keel over too (and fatally).
+ */
+
+ 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++) {
+ memcpy(string2 + (length1 * index), string1, (size_t) length1);
+ }
+ string2[length2] = '\0';
+
+ /*
+ * We have to directly assign this instead of using Tcl_SetStringObj (and
+ * indirectly TclInitStringRep) because that makes another copy of the
+ * data.
+ */
+
+ TclNewObj(resultPtr);
+ resultPtr->bytes = string2;
+ resultPtr->length = length2;
+ Tcl_SetObjResult(interp, resultPtr);
+
+ done:
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringRplcCmd --
+ *
+ * This procedure is invoked to process the "string replace" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringRplcCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_UniChar *ustring;
+ int first, last, length;
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
+ return TCL_ERROR;
+ }
+
+ ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
+ length--;
+
+ if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
+ TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ if ((last < first) || (last < 0) || (first > length)) {
+ Tcl_SetObjResult(interp, objv[1]);
+ } else {
+ Tcl_Obj *resultPtr;
+
+ ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
+ length--;
+
+ if (first < 0) {
+ first = 0;
}
- if (mapWithDict) {
- ckfree((char *) mapElemv);
+
+ resultPtr = Tcl_NewUnicodeObj(ustring, first);
+ if (objc == 5) {
+ Tcl_AppendObjToObj(resultPtr, objv[4]);
}
- if (copySource) {
- Tcl_DecrRefCount(sourceObj);
+ if (last < length) {
+ Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
+ length - last);
}
Tcl_SetObjResult(interp, resultPtr);
- break;
}
- case STR_MATCH: {
- Tcl_UniChar *ustring1, *ustring2;
- int nocase = 0;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringRevCmd --
+ *
+ * This procedure is invoked to process the "string reverse" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc < 4 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
- return TCL_ERROR;
+static int
+StringRevCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringStartCmd --
+ *
+ * This procedure is invoked to process the "string wordstart" Tcl
+ * command. See the user documentation for details on what it does. Note
+ * that this command only functions correctly on properly formed Tcl UTF
+ * strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringStartCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_UniChar ch;
+ const char *p, *string;
+ int cur, index, length, numChars;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string index");
+ return TCL_ERROR;
+ }
+
+ string = TclGetStringFromObj(objv[1], &length);
+ numChars = Tcl_NumUtfChars(string, length);
+ if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = TclGetStringFromObj(objv[1], &length);
+ if (index >= numChars) {
+ index = numChars - 1;
+ }
+ cur = 0;
+ if (index > 0) {
+ p = Tcl_UtfAtIndex(string, index);
+ for (cur = index; cur >= 0; cur--) {
+ TclUtfToUniChar(p, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
+ break;
+ }
+ p = Tcl_UtfPrev(p, string);
+ }
+ if (cur != index) {
+ cur += 1;
}
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringEndCmd --
+ *
+ * This procedure is invoked to process the "string wordend" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc == 5) {
- string2 = Tcl_GetStringFromObj(objv[2], &length2);
- if ((length2 > 1) &&
- strncmp(string2, "-nocase", (size_t) length2) == 0) {
- nocase = 1;
- } else {
- Tcl_AppendResult(interp, "bad option \"",
- string2, "\": must be -nocase", (char *) NULL);
- return TCL_ERROR;
+static int
+StringEndCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_UniChar ch;
+ const char *p, *end, *string;
+ int cur, index, length, numChars;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string index");
+ return TCL_ERROR;
+ }
+
+ string = TclGetStringFromObj(objv[1], &length);
+ numChars = Tcl_NumUtfChars(string, length);
+ if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = TclGetStringFromObj(objv[1], &length);
+ if (index < 0) {
+ index = 0;
+ }
+ if (index < numChars) {
+ p = Tcl_UtfAtIndex(string, index);
+ end = string+length;
+ for (cur = index; p < end; cur++) {
+ p += TclUtfToUniChar(p, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
+ break;
}
}
- ustring1 = Tcl_GetUnicodeFromObj(objv[objc-1], &length1);
- ustring2 = Tcl_GetUnicodeFromObj(objv[objc-2], &length2);
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(TclUniCharMatch(
- ustring1, length1, ustring2, length2, nocase)));
- break;
+ if (cur == index) {
+ cur++;
+ }
+ } else {
+ cur = numChars;
}
- case STR_RANGE: {
- int first, last;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringEqualCmd --
+ *
+ * This procedure is invoked to process the "string equal" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringEqualCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ /*
+ * Remember to keep code here in some sync with the byte-compiled versions
+ * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
+ * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
+ */
+
+ const char *string1, *string2;
+ int length1, length2, i, match, length, nocase = 0, reqlength = -1;
+ typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
+ strCmpFn_t strCmpFn;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "string first last");
+ if (objc < 3 || objc > 6) {
+ str_cmp_args:
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-nocase? ?-length int? string1 string2");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < objc-2; i++) {
+ string2 = TclGetStringFromObj(objv[i], &length2);
+ if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
+ nocase = 1;
+ } else if ((length2 > 1)
+ && !strncmp(string2, "-length", (size_t)length2)) {
+ if (i+1 >= objc-2) {
+ goto str_cmp_args;
+ }
+ i++;
+ if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ 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;
}
+ }
+
+ /*
+ * From now on, we only access the two objects at the end of the argument
+ * array.
+ */
+ objv += objc-2;
+
+ if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
- * If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
- * use the Unicode string rep to get the range.
+ * Always match at 0 chars of if it is the same obj.
*/
- if (objv[2]->typePtr == &tclByteArrayType) {
- string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
- length1--;
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ return TCL_OK;
+ }
+
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
+ /*
+ * Use binary versions of comparisons since that won't cause undue
+ * type conversions and it is much faster. Only do this if we're
+ * case-sensitive (which is all that really makes sense with byte
+ * arrays anyway, and we have no memcasecmp() for some reason... :^)
+ */
+
+ string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
+ string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
+ strCmpFn = (strCmpFn_t) memcmp;
+ } else if ((objv[0]->typePtr == &tclStringType)
+ && (objv[1]->typePtr == &tclStringType)) {
+ /*
+ * Do a unicode-specific comparison if both of the args are of String
+ * type. In benchmark testing this proved the most efficient check
+ * between the unicode and string comparison operations.
+ */
+
+ string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
+ string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
+ strCmpFn = (strCmpFn_t)
+ (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+ } else {
+ /*
+ * As a catch-all we will work with UTF-8. We cannot use memcmp() as
+ * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
+ * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
+ * case-sensitive and no specific length was requested.
+ */
+
+ string1 = (char *) TclGetStringFromObj(objv[0], &length1);
+ string2 = (char *) TclGetStringFromObj(objv[1], &length2);
+ if ((reqlength < 0) && !nocase) {
+ strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
} else {
+ length1 = Tcl_NumUtfChars(string1, length1);
+ length2 = Tcl_NumUtfChars(string2, length2);
+ strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+ }
+ }
+
+ if ((reqlength < 0) && (length1 != length2)) {
+ match = 1; /* This will be reversed below. */
+ } else {
+ length = (length1 < length2) ? length1 : length2;
+ if (reqlength > 0 && reqlength < length) {
+ length = reqlength;
+ } else if (reqlength < 0) {
/*
- * Get the length in actual characters.
+ * The requested length is negative, so we ignore it by setting it
+ * to length + 1 so we correct the match var.
*/
- string1 = NULL;
- length1 = Tcl_GetCharLength(objv[2]) - 1;
+ reqlength = length + 1;
}
- if (TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK ||
- TclGetIntForIndex(interp, objv[4], length1, &last) != TCL_OK) {
- return TCL_ERROR;
+ match = strCmpFn(string1, string2, (unsigned) length);
+ if ((match == 0) && (reqlength > length)) {
+ match = length1 - length2;
}
+ }
- if (first < 0) {
- first = 0;
- }
- if (last >= length1) {
- last = length1;
- }
- if (last >= first) {
- if (string1 != NULL) {
- int numBytes = last - first + 1;
- Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
- (unsigned char *) &string1[first], numBytes));
- } else {
- Tcl_SetObjResult(interp,
- Tcl_GetRange(objv[2], first, last));
- }
- }
- break;
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringCmpCmd --
+ *
+ * This procedure is invoked to process the "string compare" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringCmpCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ /*
+ * Remember to keep code here in some sync with the byte-compiled versions
+ * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
+ * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
+ */
+
+ const char *string1, *string2;
+ int length1, length2, i, match, length, nocase = 0, reqlength = -1;
+ typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
+ strCmpFn_t strCmpFn;
+
+ if (objc < 3 || objc > 6) {
+ str_cmp_args:
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-nocase? ?-length int? string1 string2");
+ return TCL_ERROR;
}
- case STR_REPEAT: {
- int count;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string count");
+ for (i = 1; i < objc-2; i++) {
+ string2 = TclGetStringFromObj(objv[i], &length2);
+ if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
+ nocase = 1;
+ } else if ((length2 > 1)
+ && !strncmp(string2, "-length", (size_t)length2)) {
+ if (i+1 >= objc-2) {
+ goto str_cmp_args;
+ }
+ i++;
+ if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ 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;
}
+ }
- if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
- return TCL_ERROR;
- }
+ /*
+ * From now on, we only access the two objects at the end of the argument
+ * array.
+ */
- if (count == 1) {
- Tcl_SetObjResult(interp, objv[2]);
- } else if (count > 1) {
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (length1 > 0) {
- /*
- * Only build up a string that has data. Instead of building
- * it up with repeated appends, we just allocate the necessary
- * space once and copy the string value in. Check for overflow
- * with back-division. [Bug #714106]
- */
+ objv += objc-2;
- Tcl_Obj *resultPtr;
+ if ((reqlength == 0) || (objv[0] == objv[1])) {
+ /*
+ * Always match at 0 chars of if it is the same obj.
+ */
- length2 = length1 * count;
- if ((length2 / count) != length1) {
- resultPtr = Tcl_NewObj();
- TclObjPrintf(NULL, resultPtr,
- "string size overflow, must be less than %d",
- INT_MAX);
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_ERROR;
- }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
+ }
- /*
- * Include space for the NULL.
- */
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
+ /*
+ * Use binary versions of comparisons since that won't cause undue
+ * type conversions and it is much faster. Only do this if we're
+ * case-sensitive (which is all that really makes sense with byte
+ * arrays anyway, and we have no memcasecmp() for some reason... :^)
+ */
- string2 = (char *) ckalloc((size_t) length2+1);
- for (index = 0; index < count; index++) {
- memcpy(string2 + (length1 * index), string1,
- (size_t) length1);
- }
- string2[length2] = '\0';
+ string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
+ string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
+ strCmpFn = (strCmpFn_t) memcmp;
+ } else if ((objv[0]->typePtr == &tclStringType)
+ && (objv[1]->typePtr == &tclStringType)) {
+ /*
+ * Do a unicode-specific comparison if both of the args are of String
+ * type. In benchmark testing this proved the most efficient check
+ * between the unicode and string comparison operations.
+ */
- /*
- * We have to directly assign this instead of using
- * Tcl_SetStringObj (and indirectly TclInitStringRep) because
- * that makes another copy of the data.
- */
+ string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
+ string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
+ strCmpFn = (strCmpFn_t)
+ (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+ } else {
+ /*
+ * As a catch-all we will work with UTF-8. We cannot use memcmp() as
+ * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
+ * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
+ * case-sensitive and no specific length was requested.
+ */
- TclNewObj(resultPtr);
- resultPtr->bytes = string2;
- resultPtr->length = length2;
- Tcl_SetObjResult(interp, resultPtr);
- }
+ string1 = (char *) TclGetStringFromObj(objv[0], &length1);
+ string2 = (char *) TclGetStringFromObj(objv[1], &length2);
+ if ((reqlength < 0) && !nocase) {
+ strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
+ } else {
+ length1 = Tcl_NumUtfChars(string1, length1);
+ length2 = Tcl_NumUtfChars(string2, length2);
+ strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
- break;
}
- case STR_REPLACE: {
- Tcl_UniChar *ustring1;
- int first, last;
- if (objc < 5 || objc > 6) {
- Tcl_WrongNumArgs(interp, 2, objv, "string first last ?string?");
- return TCL_ERROR;
- }
+ length = (length1 < length2) ? length1 : length2;
+ if (reqlength > 0 && reqlength < length) {
+ length = reqlength;
+ } else if (reqlength < 0) {
+ /*
+ * The requested length is negative, so we ignore it by setting it to
+ * length + 1 so we correct the match var.
+ */
- ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
- length1--;
+ reqlength = length + 1;
+ }
- if (TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK ||
- TclGetIntForIndex(interp, objv[4], length1, &last) != TCL_OK) {
- return TCL_ERROR;
- }
+ match = strCmpFn(string1, string2, (unsigned) length);
+ if ((match == 0) && (reqlength > length)) {
+ match = length1 - length2;
+ }
- if ((last < first) || (last < 0) || (first > length1)) {
- Tcl_SetObjResult(interp, objv[2]);
- } else {
- Tcl_Obj *resultPtr;
- if (first < 0) {
- first = 0;
- }
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringBytesCmd --
+ *
+ * This procedure is invoked to process the "string bytelength" Tcl
+ * command. See the user documentation for details on what it does. Note
+ * that this command only functions correctly on properly formed Tcl UTF
+ * strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- resultPtr = Tcl_NewUnicodeObj(ustring1, first);
- if (objc == 6) {
- Tcl_AppendObjToObj(resultPtr, objv[5]);
- }
- if (last < length1) {
- Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
- length1 - last);
- }
- Tcl_SetObjResult(interp, resultPtr);
- }
- break;
+static int
+StringBytesCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
}
- case STR_TOLOWER:
- case STR_TOUPPER:
- case STR_TOTITLE:
- if (objc < 3 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
- return TCL_ERROR;
- }
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ (void) TclGetStringFromObj(objv[1], &length);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringLenCmd --
+ *
+ * This procedure is invoked to process the "string length" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objc == 3) {
- Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
- if ((enum options) index == STR_TOLOWER) {
- length1 = Tcl_UtfToLower(TclGetString(resultPtr));
- } else if ((enum options) index == STR_TOUPPER) {
- length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
- } else {
- length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
- }
- Tcl_SetObjLength(resultPtr, length1);
- Tcl_SetObjResult(interp, resultPtr);
- } else {
- int first, last;
- CONST char *start, *end;
- Tcl_Obj *resultPtr;
+static int
+StringLenCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
+ }
- length1 = Tcl_NumUtfChars(string1, length1) - 1;
- if (TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK){
- return TCL_ERROR;
- }
- if (first < 0) {
- first = 0;
- }
- last = first;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringLowerCmd --
+ *
+ * This procedure is invoked to process the "string tolower" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1,
- &last) != TCL_OK)) {
- return TCL_ERROR;
- }
+static int
+StringLowerCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length1, length2;
+ const char *string1;
+ char *string2;
- if (last >= length1) {
- last = length1;
- }
- if (last < first) {
- Tcl_SetObjResult(interp, objv[2]);
- break;
- }
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
+ return TCL_ERROR;
+ }
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, last - first + 1);
- length2 = end-start;
- string2 = ckalloc((size_t) length2+1);
- memcpy(string2, start, (size_t) length2);
- string2[length2] = '\0';
+ string1 = TclGetStringFromObj(objv[1], &length1);
- if ((enum options) index == STR_TOLOWER) {
- length2 = Tcl_UtfToLower(string2);
- } else if ((enum options) index == STR_TOUPPER) {
- length2 = Tcl_UtfToUpper(string2);
- } else {
- length2 = Tcl_UtfToTitle(string2);
- }
+ if (objc == 2) {
+ Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
+
+ length1 = Tcl_UtfToLower(TclGetString(resultPtr));
+ Tcl_SetObjLength(resultPtr, length1);
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ int first, last;
+ const char *start, *end;
+ Tcl_Obj *resultPtr;
- resultPtr = Tcl_NewStringObj(string1, start - string1);
- Tcl_AppendToObj(resultPtr, string2, length2);
- Tcl_AppendToObj(resultPtr, end, -1);
- Tcl_SetObjResult(interp, resultPtr);
- ckfree(string2);
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
+ return TCL_ERROR;
}
- break;
+ if (first < 0) {
+ first = 0;
+ }
+ last = first;
- case STR_TRIMLEFT:
- left = 1;
- right = 0;
- goto dotrim;
- case STR_TRIMRIGHT:
- left = 0;
- right = 1;
- goto dotrim;
- case STR_TRIM: {
- Tcl_UniChar ch, trim;
- register CONST char *p, *end;
- char *check, *checkEnd;
- int offset;
-
- left = 1;
- right = 1;
-
- dotrim:
- if (objc == 4) {
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
- } else if (objc == 3) {
- string2 = " \t\n\r";
- length2 = strlen(string2);
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
+ if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+ &last) != TCL_OK)) {
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- checkEnd = string2 + length2;
- if (left) {
- end = string1 + length1;
- /*
- * 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.
- */
+ if (last >= length1) {
+ last = length1;
+ }
+ if (last < first) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
- for (p = string1; p < end; p += offset) {
- offset = TclUtfToUniChar(p, &ch);
+ string1 = TclGetStringFromObj(objv[1], &length1);
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ resultPtr = Tcl_NewStringObj(string1, end - string1);
+ string2 = TclGetString(resultPtr) + (start - string1);
- for (check = string2; ; ) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- string1 += offset;
- break;
- }
- }
- }
- }
- if (right) {
- end = string1;
+ length2 = Tcl_UtfToLower(string2);
+ Tcl_SetObjLength(resultPtr, length2 + (start - string1));
- /*
- * 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.
- */
+ Tcl_AppendToObj(resultPtr, end, -1);
+ Tcl_SetObjResult(interp, resultPtr);
+ }
- for (p = string1 + length1; p > end; ) {
- p = Tcl_UtfPrev(p, string1);
- offset = TclUtfToUniChar(p, &ch);
- for (check = string2; ; ) {
- if (check >= checkEnd) {
- p = end;
- break;
- }
- check += TclUtfToUniChar(check, &trim);
- if (ch == trim) {
- length1 -= offset;
- break;
- }
- }
- }
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1));
- break;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringUpperCmd --
+ *
+ * This procedure is invoked to process the "string toupper" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringUpperCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length1, length2;
+ const char *string1;
+ char *string2;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
+ return TCL_ERROR;
}
- case STR_WORDEND: {
- int cur;
- Tcl_UniChar ch;
- CONST char *p, *end;
- int numChars;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string index");
+ string1 = TclGetStringFromObj(objv[1], &length1);
+
+ if (objc == 2) {
+ Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
+
+ length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
+ Tcl_SetObjLength(resultPtr, length1);
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ int first, last;
+ const char *start, *end;
+ Tcl_Obj *resultPtr;
+
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
+ if (first < 0) {
+ first = 0;
+ }
+ last = first;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- numChars = Tcl_NumUtfChars(string1, length1);
- if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK) {
+ if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+ &last) != TCL_OK)) {
return TCL_ERROR;
}
- if (index < 0) {
- index = 0;
+
+ if (last >= length1) {
+ last = length1;
}
- if (index < numChars) {
- p = Tcl_UtfAtIndex(string1, index);
- end = string1+length1;
- for (cur = index; p < end; cur++) {
- p += TclUtfToUniChar(p, &ch);
- if (!Tcl_UniCharIsWordChar(ch)) {
- break;
- }
- }
- if (cur == index) {
- cur++;
- }
- } else {
- cur = numChars;
+ if (last < first) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
- break;
+
+ string1 = TclGetStringFromObj(objv[1], &length1);
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ resultPtr = Tcl_NewStringObj(string1, end - string1);
+ string2 = TclGetString(resultPtr) + (start - string1);
+
+ length2 = Tcl_UtfToUpper(string2);
+ Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+
+ Tcl_AppendToObj(resultPtr, end, -1);
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTitleCmd --
+ *
+ * This procedure is invoked to process the "string totitle" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTitleCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int length1, length2;
+ const char *string1;
+ char *string2;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
+ return TCL_ERROR;
}
- case STR_WORDSTART: {
- int cur;
- Tcl_UniChar ch;
- CONST char *p;
- int numChars;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string index");
+ string1 = TclGetStringFromObj(objv[1], &length1);
+
+ if (objc == 2) {
+ Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
+
+ length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
+ Tcl_SetObjLength(resultPtr, length1);
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ int first, last;
+ const char *start, *end;
+ Tcl_Obj *resultPtr;
+
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
+ if (first < 0) {
+ first = 0;
+ }
+ last = first;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- numChars = Tcl_NumUtfChars(string1, length1);
- if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK) {
+ if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+ &last) != TCL_OK)) {
return TCL_ERROR;
}
- if (index >= numChars) {
- index = numChars - 1;
+
+ if (last >= length1) {
+ last = length1;
}
- cur = 0;
- if (index > 0) {
- p = Tcl_UtfAtIndex(string1, index);
- for (cur = index; cur >= 0; cur--) {
- TclUtfToUniChar(p, &ch);
- if (!Tcl_UniCharIsWordChar(ch)) {
- break;
- }
- p = Tcl_UtfPrev(p, string1);
- }
- if (cur != index) {
- cur += 1;
- }
+ if (last < first) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
- break;
+
+ string1 = TclGetStringFromObj(objv[1], &length1);
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ resultPtr = Tcl_NewStringObj(string1, end - string1);
+ string2 = TclGetString(resultPtr) + (start - string1);
+
+ length2 = Tcl_UtfToTitle(string2);
+ Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+
+ Tcl_AppendToObj(resultPtr, end, -1);
+ Tcl_SetObjResult(interp, resultPtr);
}
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTrimCmd --
+ *
+ * This procedure is invoked to process the "string trim" Tcl command.
+ * See the user documentation for details on what it does. Note that this
+ * command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTrimCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *string1, *string2;
+ int triml, trimr, length1, length2;
+
+ if (objc == 3) {
+ string2 = TclGetStringFromObj(objv[2], &length2);
+ } else if (objc == 2) {
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+ return TCL_ERROR;
}
+ string1 = TclGetStringFromObj(objv[1], &length1);
+
+ triml = TclTrimLeft(string1, length1, string2, length2);
+ trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * StringTrimLCmd --
+ *
+ * This procedure is invoked to process the "string trimleft" Tcl
+ * command. See the user documentation for details on what it does. Note
+ * that this command only functions correctly on properly formed Tcl UTF
+ * strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTrimLCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *string1, *string2;
+ int trim, length1, length2;
+
+ if (objc == 3) {
+ string2 = TclGetStringFromObj(objv[2], &length2);
+ } else if (objc == 2) {
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+ return TCL_ERROR;
+ }
+ string1 = TclGetStringFromObj(objv[1], &length1);
+
+ trim = TclTrimLeft(string1, length1, string2, length2);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTrimRCmd --
+ *
+ * This procedure is invoked to process the "string trimright" Tcl
+ * command. See the user documentation for details on what it does. Note
+ * that this command only functions correctly on properly formed Tcl UTF
+ * strings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTrimRCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *string1, *string2;
+ int trim, length1, length2;
+
+ if (objc == 3) {
+ string2 = TclGetStringFromObj(objv[2], &length2);
+ } else if (objc == 2) {
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+ return TCL_ERROR;
+ }
+ string1 = TclGetStringFromObj(objv[1], &length1);
+
+ trim = TclTrimRight(string1, length1, string2, length2);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStringCmd --
+ *
+ * This procedure creates the "string" Tcl command. See the user
+ * documentation for details on what it does. Note that this command only
+ * functions correctly on properly formed Tcl UTF strings.
+ *
+ * Also note that the primary methods here (equal, compare, match, ...)
+ * have bytecode equivalents. You will find the code for those in
+ * tclExecute.c. The code here will only be used in the non-bc case (like
+ * in an 'eval').
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitStringCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+ static const EnsembleImplMap stringImplMap[] = {
+ {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, 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, TclCompileStringIsCmd, 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, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0},
+ {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0},
+ {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0},
+ {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0},
+ {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0},
+ {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0},
+ {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0},
+ {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+
+ return TclMakeEnsemble(interp, "string", stringImplMap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_SubstObjCmd --
*
* This procedure is invoked to process the "subst" Tcl command. See the
@@ -2479,30 +3373,25 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_SubstObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclSubstOptions(
+ Tcl_Interp *interp,
+ int numOpts,
+ Tcl_Obj *const opts[],
+ int *flagPtr)
{
- static CONST char *substOptions[] = {
- "-nobackslashes", "-nocommands", "-novariables", (char *) NULL
+ static const char *const substOptions[] = {
+ "-nobackslashes", "-nocommands", "-novariables", NULL
};
- enum substOptions {
+ enum {
SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
};
- Tcl_Obj *resultPtr;
- int optionIndex, flags, i;
+ int i, flags = TCL_SUBST_ALL;
- /*
- * Parse command-line options.
- */
+ for (i = 0; i < numOpts; i++) {
+ int optionIndex;
- flags = TCL_SUBST_ALL;
- for (i = 1; i < (objc-1); i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], substOptions, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
&optionIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -2520,23 +3409,39 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
}
}
- if (i != (objc-1)) {
+ *flagPtr = flags;
+ return TCL_OK;
+}
+
+int
+Tcl_SubstObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRSubstObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int flags;
+
+ if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-nobackslashes? ?-nocommands? ?-novariables? string");
return TCL_ERROR;
}
- /*
- * Perform the substitution.
- */
-
- resultPtr = Tcl_SubstObj(interp, objv[i], flags);
-
- if (resultPtr == NULL) {
+ if (TclSubstOptions(interp, objc-2, objv+1, &flags) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_OK;
+ return Tcl_NRSubstObj(interp, objv[objc-1], flags);
}
/*
@@ -2556,27 +3461,41 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_SwitchObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SwitchObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved, noCase;
- int patternLength;
- char *pattern;
+ return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, dummy, objc, objv);
+}
+int
+TclNRSwitchObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
+ int noCase, patternLength;
+ const char *pattern;
Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
- Tcl_Obj *CONST *savedObjv = objv;
+ Tcl_Obj *const *savedObjv = objv;
Tcl_RegExp regExpr = NULL;
+ Interp *iPtr = (Interp *) interp;
+ int pc = 0;
+ int bidx = 0; /* Index of body argument. */
+ Tcl_Obj *blist = NULL; /* List obj which is the body */
+ CmdFrame *ctxPtr; /* Copy of the topmost cmdframe, to allow us
+ * to mess with the line information */
/*
* If you add options that make -e and -g not unique prefixes of -exact or
* -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
*/
- static CONST char *options[] = {
+ static const char *const options[] = {
"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
"--", NULL
};
@@ -2593,7 +3512,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
matchVarObj = NULL;
numMatchesSaved = 0;
noCase = 0;
- for (i = 1; i < objc; i++) {
+ for (i = 1; i < objc-2; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
@@ -2601,85 +3520,115 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
&index) != TCL_OK) {
return TCL_ERROR;
}
- if (index == OPT_LAST) {
+ switch ((enum options) index) {
+ /*
+ * General options.
+ */
+
+ case OPT_LAST:
i++;
+ goto finishedOptions;
+ case OPT_NOCASE:
+ strCmpFn = TclUtfCasecmp;
+ noCase = 1;
break;
- }
- /*
- * Check for TIP#75 options specifying the variables to write regexp
- * information into.
- */
+ /*
+ * Handle the different switch mode options.
+ */
- if (index == OPT_INDEXV) {
+ default:
+ if (foundmode) {
+ /*
+ * Mode already set via -exact, -glob, or -regexp.
+ */
+
+ 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;
+ mode = index;
+ break;
+
+ /*
+ * Check for TIP#75 options specifying the variables to write
+ * regexp information into.
+ */
+
+ case OPT_INDEXV:
i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -indexvar option",
- (char *) NULL);
+ if (i >= objc-2) {
+ 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];
numMatchesSaved = -1;
- } else if (index == OPT_MATCHV) {
+ break;
+ case OPT_MATCHV:
i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -matchvar option",
- (char *) NULL);
+ if (i >= objc-2) {
+ 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];
numMatchesSaved = -1;
- } else if (index == OPT_NOCASE) {
- strCmpFn = strcasecmp;
- noCase = 1;
- } else {
- if (foundmode) {
- /*
- * Mode already set via -exact, -glob, or -regexp.
- */
-
- Tcl_AppendResult(interp, "bad option \"",
- TclGetString(objv[i]), "\": ", options[mode],
- " option already found", (char *) NULL);
- return TCL_ERROR;
- }
- foundmode = 1;
- mode = index;
+ break;
}
}
+ finishedOptions:
if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? string pattern body ... ?default body?");
+ "?-switch ...? string ?pattern body ...? ?default body?");
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-indexvar option requires -regexp option", (char *) 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", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-matchvar"));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+ "MODERESTRICTION", NULL);
return TCL_ERROR;
}
stringObj = objv[i];
objc -= i + 1;
objv += i + 1;
+ bidx = i + 1; /* First after the match string. */
/*
* If all of the pattern/command pairs are lumped into a single argument,
* split them out again.
+ *
+ * TIP #280: Determine the lines the words in the list start at, based on
+ * the same data for the list word itself. The cmdFramePtr line
+ * information is manipulated directly.
*/
splitObjs = 0;
if (objc == 1) {
Tcl_Obj **listv;
- if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
+ blist = objv[0];
+ if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
return TCL_ERROR;
}
@@ -2689,7 +3638,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, savedObjv,
- "?switches? string {pattern body ... ?default body?}");
+ "?-switch ...? string {?pattern body ...? ?default body?}");
return TCL_ERROR;
}
objv = listv;
@@ -2703,7 +3652,10 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
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
@@ -2716,10 +3668,12 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
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;
}
}
@@ -2734,9 +3688,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
*/
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;
}
@@ -2745,7 +3701,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* See if the pattern matches the string.
*/
- pattern = Tcl_GetStringFromObj(objv[i], &patternLength);
+ pattern = TclGetStringFromObj(objv[i], &patternLength);
if ((i == objc - 2) && (*pattern == 'd')
&& (strcmp(pattern, "default") == 0)) {
@@ -2762,7 +3718,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
TclNewObj(emptyObj);
if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(emptyObj);
return TCL_ERROR;
}
}
@@ -2772,42 +3727,39 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
}
if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- if (indexVarObj == NULL) {
- Tcl_DecrRefCount(emptyObj);
- }
return TCL_ERROR;
}
}
goto matchFound;
- } else {
- switch (mode) {
- case OPT_EXACT:
- if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
- goto matchFound;
- }
- break;
- case OPT_GLOB:
- if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern,
- noCase)) {
- goto matchFound;
- }
- break;
- case OPT_REGEXP:
- regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
- TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
- if (regExpr == NULL) {
+ }
+
+ switch (mode) {
+ case OPT_EXACT:
+ if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
+ goto matchFound;
+ }
+ break;
+ case OPT_GLOB:
+ if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) {
+ goto matchFound;
+ }
+ break;
+ case OPT_REGEXP:
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
+ TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
+ if (regExpr == NULL) {
+ return TCL_ERROR;
+ } else {
+ int matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
+ numMatchesSaved, 0);
+
+ if (matched < 0) {
return TCL_ERROR;
- } else {
- int matched = Tcl_RegExpExecObj(interp, regExpr,
- stringObj, 0, numMatchesSaved, 0);
- if (matched < 0) {
- return TCL_ERROR;
- } else if (matched) {
- goto matchFoundRegexp;
- }
+ } else if (matched) {
+ goto matchFoundRegexp;
}
- break;
}
+ break;
}
}
return TCL_OK;
@@ -2837,11 +3789,17 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
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.
*/
+
Tcl_ListObjAppendElement(NULL, indicesObj,
Tcl_NewListObj(2, rangeObjAry));
}
@@ -2851,9 +3809,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
substringObj = Tcl_GetRange(stringObj,
info.matches[j].start, info.matches[j].end-1);
+
/*
* Never fails; the object is always clean at this point.
*/
+
Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
}
}
@@ -2861,8 +3821,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (indexVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(indicesObj);
-
/*
* Careful! Check to see if we have allocated the list of
* matched strings; if so (but there was an error assigning
@@ -2880,8 +3838,6 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (matchVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(matchesObj);
-
/*
* Unlike above, if indicesObj is non-NULL at this point, it
* will have been written to a variable already and will hence
@@ -2899,6 +3855,58 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
*/
matchFound:
+ ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ *ctxPtr = *iPtr->cmdFramePtr;
+
+ if (splitObjs) {
+ /*
+ * We have to perform the GetSrc and other type dependent handling of
+ * the frame here because we are munging with the line numbers,
+ * something the other commands like if, etc. are not doing. Them are
+ * fine with simply passing the CmdFrame through and having the
+ * special handling done in 'info frame', or the bc compiler
+ */
+
+ if (ctxPtr->type == TCL_LOCATION_BC) {
+ /*
+ * Type BC => ctxPtr->data.eval.path is not used.
+ * ctxPtr->data.tebc.codePtr is used instead.
+ */
+
+ TclGetSrcInfoForPc(ctxPtr);
+ pc = 1;
+
+ /*
+ * The line information in the cmdFrame is now a copy we do not
+ * own.
+ */
+ }
+
+ if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
+ int bline = ctxPtr->line[bidx];
+
+ ctxPtr->line = ckalloc(objc * sizeof(int));
+ ctxPtr->nline = objc;
+ TclListLines(blist, bline, objc, ctxPtr->line, objv);
+ } else {
+ /*
+ * This is either a dynamic code word, when all elements are
+ * relative to themselves, or something else less expected and
+ * where we have no information. The result is the same in both
+ * cases; tell the code to come that it doesn't know where it is,
+ * which triggers reversion to the old behavior.
+ */
+
+ int k;
+
+ ctxPtr->line = ckalloc(objc * sizeof(int));
+ ctxPtr->nline = objc;
+ for (k=0; k < objc; k++) {
+ ctxPtr->line[k] = -1;
+ }
+ }
+ }
+
for (j = i + 1; ; j += 2) {
if (j >= objc) {
/*
@@ -2913,7 +3921,43 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
}
}
- result = Tcl_EvalObjEx(interp, objv[j], 0);
+ /*
+ * TIP #280: Make invoking context available to switch branch.
+ */
+
+ Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
+ 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 */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int result) /* Result to return*/
+{
+ /* Unpack the preserved data */
+
+ int splitObjs = PTR2INT(data[0]);
+ CmdFrame *ctxPtr = data[1];
+ int pc = PTR2INT(data[2]);
+ const char *pattern = data[3];
+ int patternLength = strlen(pattern);
+
+ /*
+ * Clean up TIP 280 context information
+ */
+
+ if (splitObjs) {
+ ckfree(ctxPtr->line);
+ if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
+ /*
+ * Death of SrcInfo reference.
+ */
+
+ Tcl_DecrRefCount(ctxPtr->data.eval.path);
+ }
+ }
/*
* Generate an error message if necessary.
@@ -2922,16 +3966,82 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (result == TCL_ERROR) {
int limit = 50;
int overflow = (patternLength > limit);
- TclFormatToErrorInfo(interp, "\n (\"%.*s%s\" arm line %d)",
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.*s%s\" arm line %d)",
(overflow ? limit : patternLength), pattern,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
+ TclStackFree(interp, ctxPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_ThrowObjCmd --
+ *
+ * This procedure is invoked to process the "throw" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_ThrowObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *options;
+ int len;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type message");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The type must be a list of at least length 1.
+ */
+
+ if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (len < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "type must be non-empty list", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now prepare the result options dictionary. We use the list API as it is
+ * slightly more convenient.
+ */
+
+ TclNewLiteralStringObj(options, "-code error -level 0 -errorcode");
+ Tcl_ListObjAppendElement(NULL, options, objv[1]);
+
+ /*
+ * We're ready to go. Fire things into the low-level result machinery.
+ */
+
+ Tcl_SetObjResult(interp, objv[2]);
+ return Tcl_SetReturnOptions(interp, options);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_TimeObjCmd --
*
* This object-based procedure is invoked to process the "time" Tcl
@@ -2946,25 +4056,28 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_TimeObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_TimeObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objs[4];
register int i, result;
int count;
double totalMicroSec;
+#ifndef TCL_WIDE_CLICKS
Tcl_Time start, stop;
+#else
+ Tcl_WideInt start, stop;
+#endif
if (objc == 2) {
count = 1;
} else if (objc == 3) {
- result = Tcl_GetIntFromObj(interp, objv[2], &count);
+ result = TclGetIntFromObj(interp, objv[2], &count);
if (result != TCL_OK) {
return result;
}
@@ -2975,17 +4088,25 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
objPtr = objv[1];
i = count;
+#ifndef TCL_WIDE_CLICKS
Tcl_GetTime(&start);
+#else
+ start = TclpGetWideClicks();
+#endif
while (i-- > 0) {
result = Tcl_EvalObjEx(interp, objPtr, 0);
if (result != TCL_OK) {
return result;
}
}
+#ifndef TCL_WIDE_CLICKS
Tcl_GetTime(&stop);
-
- totalMicroSec = (((double) (stop.sec - start.sec))*1.0e6
- + (stop.usec - start.usec));
+ totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
+ + (stop.usec - start.usec);
+#else
+ stop = TclpGetWideClicks();
+ totalMicroSec = ((double) TclpWideClicksToNanoseconds(stop - start))/1.0e3;
+#endif
if (count <= 1) {
/*
@@ -2999,12 +4120,12 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
/*
* Construct the result as a list because many programs have always parsed
- * at such (extracting the first element, typically).
+ * as such (extracting the first element, typically).
*/
- objs[1] = Tcl_NewStringObj("microseconds", -1);
- objs[2] = Tcl_NewStringObj("per", -1);
- objs[3] = Tcl_NewStringObj("iteration", -1);
+ TclNewLiteralStringObj(objs[1], "microseconds");
+ TclNewLiteralStringObj(objs[2], "per");
+ TclNewLiteralStringObj(objs[3], "iteration");
Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
return TCL_OK;
@@ -3013,6 +4134,578 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * Tcl_TryObjCmd, TclNRTryObjCmd --
+ *
+ * This procedure is invoked to process the "try" Tcl command. See the
+ * user documentation (or TIP #329) for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TryObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRTryObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
+ int i, bodyShared, haveHandlers, dummy, code;
+ static const char *const handlerNames[] = {
+ "finally", "on", "trap", NULL
+ };
+ enum Handlers {
+ TryFinally, TryOn, TryTrap
+ };
+
+ /*
+ * Parse the arguments. The handlers are passed to subsequent callbacks as
+ * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
+ * bindVariables, script), and the finally script is just passed as it is.
+ */
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "body ?handler ...? ?finally script?");
+ return TCL_ERROR;
+ }
+ bodyObj = objv[1];
+ handlersObj = Tcl_NewObj();
+ bodyShared = 0;
+ haveHandlers = 0;
+ for (i=2 ; i<objc ; i++) {
+ int type;
+ Tcl_Obj *info[5];
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
+ 0, &type) != TCL_OK) {
+ Tcl_DecrRefCount(handlersObj);
+ return TCL_ERROR;
+ }
+ switch ((enum Handlers) type) {
+ case TryFinally: /* finally script */
+ if (i < objc-2) {
+ 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_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];
+ break;
+
+ case TryOn: /* on code variableList script */
+ if (i > objc-4) {
+ 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 (TclGetCompletionCodeFromObj(interp, objv[i+1],
+ &code) != TCL_OK) {
+ Tcl_DecrRefCount(handlersObj);
+ return TCL_ERROR;
+ }
+ info[2] = NULL;
+ goto commonHandler;
+
+ case TryTrap: /* trap pattern variableList script */
+ if (i > objc-4) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to trap clause: "
+ "must be \"... trap pattern variableList script\"",
+ -1));
+ Tcl_DecrRefCount(handlersObj);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
+ "ARGUMENT", NULL);
+ return TCL_ERROR;
+ }
+ code = 1;
+ if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "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];
+
+ commonHandler:
+ if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
+ Tcl_DecrRefCount(handlersObj);
+ return TCL_ERROR;
+ }
+
+ info[0] = objv[i]; /* type */
+ TclNewIntObj(info[1], code); /* returnCode */
+ if (info[2] == NULL) { /* errorCodePrefix */
+ TclNewObj(info[2]);
+ }
+ info[3] = objv[i+2]; /* bindVariables */
+ info[4] = objv[i+3]; /* script */
+
+ bodyShared = !strcmp(TclGetString(objv[i+3]), "-");
+ Tcl_ListObjAppendElement(NULL, handlersObj,
+ Tcl_NewListObj(5, info));
+ haveHandlers = 1;
+ i += 3;
+ break;
+ }
+ }
+ if (bodyShared) {
+ 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) {
+ Tcl_DecrRefCount(handlersObj);
+ handlersObj = NULL;
+ }
+
+ /*
+ * Execute the body.
+ */
+
+ Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
+ (ClientData)objv, INT2PTR(objc));
+ return TclNREvalObjEx(interp, bodyObj, 0,
+ ((Interp *) interp)->cmdFramePtr, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * During --
+ *
+ * This helper function patches together the updates to the interpreter's
+ * return options that are needed when things fail during the processing
+ * of a handler or finally script for the [try] command.
+ *
+ * Returns:
+ * The new option dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline Tcl_Obj *
+During(
+ Tcl_Interp *interp,
+ int resultCode, /* The result code from the just-evaluated
+ * script. */
+ Tcl_Obj *oldOptions, /* The old option dictionary. */
+ Tcl_Obj *errorInfo) /* An object to append to the errorinfo and
+ * release, or NULL if nothing is to be added.
+ * Designed to be used with Tcl_ObjPrintf. */
+{
+ Tcl_Obj *during, *options;
+
+ if (errorInfo != NULL) {
+ Tcl_AppendObjToErrorInfo(interp, errorInfo);
+ }
+ options = Tcl_GetReturnOptions(interp, resultCode);
+ TclNewLiteralStringObj(during, "-during");
+ Tcl_IncrRefCount(during);
+ Tcl_DictObjPut(interp, options, during, oldOptions);
+ Tcl_DecrRefCount(during);
+ Tcl_IncrRefCount(options);
+ Tcl_DecrRefCount(oldOptions);
+ return options;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TryPostBody --
+ *
+ * Callback to handle the outcome of the execution of the body of a 'try'
+ * command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TryPostBody(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
+ int i, dummy, code, objc;
+ int numHandlers = 0;
+
+ handlersObj = data[0];
+ finallyObj = data[1];
+ objv = data[2];
+ objc = PTR2INT(data[3]);
+
+ cmdObj = objv[0];
+
+ /*
+ * Check for limits/rewinding, which override normal trapping behaviour.
+ */
+
+ if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%s\" body line %d)", TclGetString(cmdObj),
+ Tcl_GetErrorLine(interp)));
+ if (handlersObj != NULL) {
+ Tcl_DecrRefCount(handlersObj);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Basic processing of the outcome of the script, including adding of
+ * errorinfo trace.
+ */
+
+ if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%s\" body line %d)", TclGetString(cmdObj),
+ Tcl_GetErrorLine(interp)));
+ }
+ resultObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObj);
+ options = Tcl_GetReturnOptions(interp, result);
+ Tcl_IncrRefCount(options);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Handle the results.
+ */
+
+ if (handlersObj != NULL) {
+ int found = 0;
+ Tcl_Obj **handlers, **info;
+
+ Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
+ for (i=0 ; i<numHandlers ; i++) {
+ Tcl_Obj *handlerBodyObj;
+
+ Tcl_ListObjGetElements(NULL, handlers[i], &dummy, &info);
+ if (!found) {
+ Tcl_GetIntFromObj(NULL, info[1], &code);
+ if (code != result) {
+ continue;
+ }
+
+ /*
+ * When processing an error, we must also perform list-prefix
+ * matching of the errorcode list. However, if this was an
+ * 'on' handler, the list that we are matching against will be
+ * empty.
+ */
+
+ if (code == TCL_ERROR) {
+ Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
+ int len1, len2, j;
+
+ TclNewLiteralStringObj(errorCodeName, "-errorcode");
+ Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
+ Tcl_DecrRefCount(errorCodeName);
+ Tcl_ListObjGetElements(NULL, info[2], &len1, &bits1);
+ if (Tcl_ListObjGetElements(NULL, errcode, &len2,
+ &bits2) != TCL_OK) {
+ continue;
+ }
+ if (len2 < len1) {
+ continue;
+ }
+ for (j=0 ; j<len1 ; j++) {
+ if (strcmp(TclGetString(bits1[j]),
+ TclGetString(bits2[j])) != 0) {
+ /*
+ * Really want 'continue outerloop;', but C does
+ * not give us that.
+ */
+
+ goto didNotMatch;
+ }
+ }
+ }
+
+ found = 1;
+ }
+
+ /*
+ * Now we need to scan forward over "-" bodies. Note that we've
+ * already checked that the last body is not a "-", so this search
+ * will terminate successfully.
+ */
+
+ if (!strcmp(TclGetString(info[4]), "-")) {
+ continue;
+ }
+
+ /*
+ * Bind the variables. We already know this is a list of variable
+ * names, but it might be empty.
+ */
+
+ Tcl_ResetResult(interp);
+ result = TCL_ERROR;
+ Tcl_ListObjLength(NULL, info[3], &dummy);
+ if (dummy > 0) {
+ Tcl_Obj *varName;
+
+ Tcl_ListObjIndex(NULL, info[3], 0, &varName);
+ if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_DecrRefCount(resultObj);
+ goto handlerFailed;
+ }
+ Tcl_DecrRefCount(resultObj);
+ if (dummy > 1) {
+ Tcl_ListObjIndex(NULL, info[3], 1, &varName);
+ if (Tcl_ObjSetVar2(interp, varName, NULL, options,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ goto handlerFailed;
+ }
+ }
+ } else {
+ /*
+ * Dispose of the result to prevent a memleak. [Bug 2910044]
+ */
+
+ Tcl_DecrRefCount(resultObj);
+ }
+
+ /*
+ * Evaluate the handler body and process the outcome. Note that we
+ * need to keep the kind of handler for debugging purposes, and in
+ * any case anything we want from info[] must be extracted right
+ * now because the info[] array is about to become invalid. There
+ * is very little refcount handling here however, since we know
+ * that the objects that we still want to refer to now were input
+ * arguments to [try] and so are still on the Tcl value stack.
+ */
+
+ handlerBodyObj = info[4];
+ Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0],
+ INT2PTR((finallyObj == NULL) ? 0 : objc - 1));
+ Tcl_DecrRefCount(handlersObj);
+ return TclNREvalObjEx(interp, handlerBodyObj, 0,
+ ((Interp *) interp)->cmdFramePtr, 4*i + 5);
+
+ handlerFailed:
+ resultObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObj);
+ options = During(interp, result, options, NULL);
+ break;
+
+ didNotMatch:
+ continue;
+ }
+
+ /*
+ * No handler matched; get rid of the list of handlers.
+ */
+
+ Tcl_DecrRefCount(handlersObj);
+ }
+
+ /*
+ * Process the finally clause.
+ */
+
+ if (finallyObj != NULL) {
+ Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
+ NULL);
+ return TclNREvalObjEx(interp, finallyObj, 0,
+ ((Interp *) interp)->cmdFramePtr, objc - 1);
+ }
+
+ /*
+ * Install the correct result/options into the interpreter and clean up
+ * any temporary storage.
+ */
+
+ result = Tcl_SetReturnOptions(interp, options);
+ Tcl_DecrRefCount(options);
+ Tcl_SetObjResult(interp, resultObj);
+ Tcl_DecrRefCount(resultObj);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TryPostHandler --
+ *
+ * Callback to handle the outcome of the execution of a handler of a
+ * 'try' command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TryPostHandler(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
+ Tcl_Obj *finallyObj;
+ int finally;
+
+ objv = data[0];
+ options = data[1];
+ handlerKindObj = data[2];
+ finally = PTR2INT(data[3]);
+
+ cmdObj = objv[0];
+ finallyObj = finally ? objv[finally] : 0;
+
+ /*
+ * Check for limits/rewinding, which override normal trapping behaviour.
+ */
+
+ if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
+ options = During(interp, result, options, Tcl_ObjPrintf(
+ "\n (\"%s ... %s\" handler line %d)",
+ TclGetString(cmdObj), TclGetString(handlerKindObj),
+ Tcl_GetErrorLine(interp)));
+ Tcl_DecrRefCount(options);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The handler result completely substitutes for the result of the body.
+ */
+
+ resultObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObj);
+ if (result == TCL_ERROR) {
+ options = During(interp, result, options, Tcl_ObjPrintf(
+ "\n (\"%s ... %s\" handler line %d)",
+ TclGetString(cmdObj), TclGetString(handlerKindObj),
+ Tcl_GetErrorLine(interp)));
+ } else {
+ Tcl_DecrRefCount(options);
+ options = Tcl_GetReturnOptions(interp, result);
+ Tcl_IncrRefCount(options);
+ }
+
+ /*
+ * Process the finally clause if it is present.
+ */
+
+ if (finallyObj != NULL) {
+ Interp *iPtr = (Interp *) interp;
+
+ Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
+ NULL);
+
+ /* The 'finally' script is always the last argument word. */
+ return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
+ finally);
+ }
+
+ /*
+ * Install the correct result/options into the interpreter and clean up
+ * any temporary storage.
+ */
+
+ result = Tcl_SetReturnOptions(interp, options);
+ Tcl_DecrRefCount(options);
+ Tcl_SetObjResult(interp, resultObj);
+ Tcl_DecrRefCount(resultObj);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TryPostFinal --
+ *
+ * Callback to handle the outcome of the execution of the finally script
+ * of a 'try' command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TryPostFinal(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *resultObj, *options, *cmdObj;
+
+ resultObj = data[0];
+ options = data[1];
+ cmdObj = data[2];
+
+ /*
+ * If the result wasn't OK, we need to adjust the result options.
+ */
+
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(resultObj);
+ resultObj = NULL;
+ if (result == TCL_ERROR) {
+ options = During(interp, result, options, Tcl_ObjPrintf(
+ "\n (\"%s ... finally\" body line %d)",
+ TclGetString(cmdObj), Tcl_GetErrorLine(interp)));
+ } else {
+ Tcl_Obj *origOptions = options;
+
+ options = Tcl_GetReturnOptions(interp, result);
+ Tcl_IncrRefCount(options);
+ Tcl_DecrRefCount(origOptions);
+ }
+ }
+
+ /*
+ * Install the correct result/options into the interpreter and clean up
+ * any temporary storage.
+ */
+
+ result = Tcl_SetReturnOptions(interp, options);
+ Tcl_DecrRefCount(options);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ Tcl_DecrRefCount(resultObj);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_WhileObjCmd --
*
* This procedure is invoked to process the "while" Tcl command. See the
@@ -3031,45 +4724,100 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_WhileObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_WhileObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRWhileObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int result, value;
+ ForIterData *iterPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "test command");
return TCL_ERROR;
}
- while (1) {
- result = Tcl_ExprBooleanObj(interp, objv[1], &value);
- if (result != TCL_OK) {
- return result;
- }
- if (!value) {
- break;
+ /*
+ * We reuse [for]'s callback, passing a NULL for the 'next' script.
+ */
+
+ TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
+ iterPtr->cond = objv[1];
+ iterPtr->body = objv[2];
+ iterPtr->next = NULL;
+ iterPtr->msg = "\n (\"while\" body line %d)";
+ iterPtr->word = 2;
+
+ TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+ NULL, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclListLines --
+ *
+ * ???
+ *
+ * Results:
+ * Filled in array of line numbers?
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclListLines(
+ Tcl_Obj *listObj, /* Pointer to obj holding a string with list
+ * structure. Assumed to be valid. Assumed to
+ * contain n elements. */
+ int line, /* Line the list as a whole starts on. */
+ int n, /* #elements in lines */
+ int *lines, /* Array of line numbers, to fill. */
+ Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
+ * derived continuation data */
+{
+ const char *listStr = Tcl_GetString(listObj);
+ const char *listHead = listStr;
+ int i, length = strlen(listStr);
+ const char *element = NULL, *next = NULL;
+ ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
+ int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
+
+ for (i = 0; i < n; i++) {
+ TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
+
+ TclAdvanceLines(&line, listStr, element);
+ /* Leading whitespace */
+ TclAdvanceContinuations(&line, &clNext, element - listHead);
+ if (elems && clNext) {
+ TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
}
- result = Tcl_EvalObjEx(interp, objv[2], 0);
- if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
- if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"while\" body line %d)",
- interp->errorLine);
- }
+ lines[i] = line;
+ length -= (next - listStr);
+ TclAdvanceLines(&line, element, next);
+ /* Element */
+ listStr = next;
+
+ if (*element == 0) {
+ /* ASSERT i == n */
break;
}
}
- if (result == TCL_BREAK) {
- result = TCL_OK;
- }
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
- }
- return result;
}
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 4f962ca..d1d7a80 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1,128 +1,69 @@
/*
* tclCompCmds.c --
*
- * This file contains compilation procedures that compile various
- * Tcl commands into a sequence of instructions ("bytecodes").
+ * This file contains compilation procedures that compile various Tcl
+ * commands into a sequence of instructions ("bytecodes").
*
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2002 ActiveState Corporation.
- * Copyright (c) 2004-2005 by Donal K. Fellows.
+ * Copyright (c) 2004-2013 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: tclCompCmds.c,v 1.77 2005/07/21 21:49:00 dkf 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"
#include "tclCompile.h"
-
-/*
- * Macro that encapsulates an efficiency trick that avoids a function call for
- * the simplest of compiles. The ANSI C "prototype" for this macro is:
- *
- * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- * Tcl_Interp *interp);
- */
-
-#define CompileWord(envPtr, tokenPtr, interp) \
- if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
- TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
- (tokenPtr)[1].size), (envPtr)); \
- } else { \
- TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
- (envPtr)); \
- }
-
-/*
- * Convenience macro for use when compiling bodies of commands. The ANSI C
- * "prototype" for this macro is:
- *
- * static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- * Tcl_Interp *interp);
- */
-
-#define CompileBody(envPtr, tokenPtr, interp) \
- TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
- (envPtr))
-
-/*
- * Convenience macro for use when pushing literals. The ANSI C "prototype" for
- * this macro is:
- *
- * static void PushLiteral(CompileEnv *envPtr,
- * const char *string, int length);
- */
-
-#define PushLiteral(envPtr, string, length) \
- TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
-
-/*
- * Macro to advance to the next token; it is more mnemonic than the address
- * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
- *
- * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
- */
-
-#define TokenAfter(tokenPtr) \
- ((tokenPtr) + ((tokenPtr)->numComponents + 1))
-
-/*
- * Macro to get the offset to the next instruction to be issued. The ANSI C
- * "prototype" for this macro is:
- *
- * static int CurrentOffset(CompileEnv *envPtr);
- */
-
-#define CurrentOffset(envPtr) \
- ((envPtr)->codeNext - (envPtr)->codeStart)
-
-/*
- * static int DeclareExceptionRange(CompileEnv *envPtr, int type);
- * static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
- * static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
- * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
- */
-
-#define DeclareExceptionRange(envPtr, type) \
- (((envPtr)->exceptDepth++), \
- ((envPtr)->maxExceptDepth = \
- TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
- (TclCreateExceptRange((type), (envPtr))))
-#define ExceptionRangeStarts(envPtr, index) \
- ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr))
-#define ExceptionRangeEnds(envPtr, index) \
- ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
- CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset)
-#define ExceptionRangeTarget(envPtr, index, targetType) \
- ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+#include <assert.h>
/*
* Prototypes for procedures defined later in this file:
*/
-static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
-static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
-static int PushVarName _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
- int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
-
-/*
- * Flags bits used by PushVarName.
- */
-
-#define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */
-#define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */
+static ClientData DupDictUpdateInfo(ClientData clientData);
+static void FreeDictUpdateInfo(ClientData clientData);
+static void PrintDictUpdateInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static ClientData DupForeachInfo(ClientData clientData);
+static void FreeForeachInfo(ClientData clientData);
+static void PrintForeachInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void PrintNewForeachInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+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);
/*
* The structures below define the AuxData types defined in this file.
*/
-AuxDataType tclForeachInfoType = {
+const AuxDataType tclForeachInfoType = {
"ForeachInfo", /* name */
DupForeachInfo, /* dupProc */
- FreeForeachInfo /* freeProc */
+ FreeForeachInfo, /* freeProc */
+ PrintForeachInfo /* printProc */
+};
+
+const AuxDataType tclNewForeachInfoType = {
+ "NewForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo, /* freeProc */
+ PrintNewForeachInfo /* printProc */
+};
+
+const AuxDataType tclDictUpdateInfoType = {
+ "DictUpdateInfo", /* name */
+ DupDictUpdateInfo, /* dupProc */
+ FreeDictUpdateInfo, /* freeProc */
+ PrintDictUpdateInfo /* printProc */
};
/*
@@ -133,8 +74,8 @@ AuxDataType tclForeachInfoType = {
* Procedure called to compile the "append" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "append" command at
@@ -144,15 +85,19 @@ AuxDataType tclForeachInfoType = {
*/
int
-TclCompileAppendCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+TclCompileAppendCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
- int simpleVarName, isScalar, localIndex, numWords;
+ int isScalar, localIndex, numWords, i;
+ DefineLineInformation; /* TIP #280 */
+ /* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords == 1) {
return TCL_ERROR;
@@ -160,12 +105,15 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
/*
* append varName == set varName
*/
- return TclCompileSetCmd(interp, parsePtr, envPtr);
+
+ return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (numWords > 3) {
/*
- * APPEND instructions currently only handle one value
+ * APPEND instructions currently only handle one value, but we can
+ * handle some multi-value cases by stringing them together.
*/
- return TCL_ERROR;
+
+ goto appendMultiple;
}
/*
@@ -178,3807 +126,3038 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, 1);
/*
* We are doing an assignment, otherwise TclCompileSetCmd was called, so
- * push the new value. This will need to be extended to push a value for
+ * push the new value. This will need to be extended to push a value for
* each argument.
*/
- if (numWords > 2) {
valueTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, valueTokenPtr, interp);
- }
+ CompileWord(envPtr, valueTokenPtr, interp, 2);
/*
* Emit instructions to set/get the variable.
*/
- if (simpleVarName) {
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 {
- TclEmitOpcode(INST_APPEND_STK, envPtr);
- }
return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileBreakCmd --
- *
- * Procedure called to compile the "break" 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 "break" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
-int
-TclCompileBreakCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- if (parsePtr->numWords != 1) {
+ appendMultiple:
+ /*
+ * Can only handle the case where we are appending to a local scalar when
+ * there are multiple values to append. Fortunately, this is common.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &isScalar, 1);
+ if (!isScalar || localIndex < 0) {
return TCL_ERROR;
}
/*
- * Emit a break instruction.
+ * Definitely appending to a local scalar; generate the words and append
+ * them.
*/
- TclEmitOpcode(INST_BREAK, envPtr);
+ valueTokenPtr = TokenAfter(varTokenPtr);
+ for (i = 2 ; i < numWords ; i++) {
+ CompileWord(envPtr, valueTokenPtr, interp, i);
+ valueTokenPtr = TokenAfter(valueTokenPtr);
+ }
+ TclEmitInstInt4( INST_REVERSE, numWords-2, envPtr);
+ for (i = 2 ; i < numWords ;) {
+ Emit14Inst( INST_APPEND_SCALAR, localIndex, envPtr);
+ if (++i < numWords) {
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ }
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileCatchCmd --
+ * TclCompileArray*Cmd --
*
- * Procedure called to compile the "catch" command.
+ * Functions called to compile "array" sucommands.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "catch" command at
+ * Instructions are added to envPtr to execute the "array" subcommand at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileCatchCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+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. */
{
- JumpFixup jumpFixup;
- Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
- CONST char *name;
- int resultIndex, optsIndex, nameChars, range;
- int savedStackDepth = envPtr->currStackDepth;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ int isScalar, localIndex;
- /*
- * If syntax does not match what we expect for [catch], do not compile.
- * Let runtime checks determine if syntax has changed.
- */
- if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
+ if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
- /*
- * If variables were specified and the catch command is at global level
- * (not in a procedure), don't compile it inline: the payoff is too small.
- */
-
- if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &isScalar, 1);
+ if (!isScalar) {
return TCL_ERROR;
}
- /*
- * Make sure the variable names, if any, have no substitutions and just
- * refer to local scalars.
- */
+ if (localIndex >= 0) {
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ } else {
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ }
+ return TCL_OK;
+}
- resultIndex = optsIndex = -1;
- cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
- if (parsePtr->numWords >= 3) {
- resultNameTokenPtr = TokenAfter(cmdTokenPtr);
- /* DGP */
- if (resultNameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- name = resultNameTokenPtr[1].start;
- nameChars = resultNameTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
- resultNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
- envPtr->procPtr);
- } else {
- return TCL_ERROR;
- }
- /* DKF */
- if (parsePtr->numWords == 4) {
- optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
- if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = optsNameTokenPtr[1].start;
- nameChars = optsNameTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
- optsNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
- envPtr->procPtr);
- }
+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 *varTokenPtr, *dataTokenPtr;
+ int isScalar, localIndex, code = TCL_OK;
+ int isDataLiteral, isDataValid, isDataEven, len;
+ int keyVar, valVar, infoIndex;
+ int fwd, offsetBack, offsetFwd;
+ Tcl_Obj *literalObj;
+ ForeachInfo *infoPtr;
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
}
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dataTokenPtr = TokenAfter(varTokenPtr);
+ literalObj = Tcl_NewObj();
+ isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
+ isDataValid = (isDataLiteral
+ && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
+ isDataEven = (isDataValid && (len & 1) == 0);
+
/*
- * We will compile the catch command. Emit a beginCatch instruction at the
- * start of the catch body: the subcommand it controls.
+ * Special case: literal odd-length argument is always an error.
*/
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+ if (isDataValid && !isDataEven) {
+ PushStringLiteral(envPtr, "list must have an even number of elements");
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
+ goto done;
+ }
/*
- * 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 catched [Bug 219184]
+ * Except for the special "ensure array" case below, when we're not in
+ * a proc, we cannot do a better compile than generic.
*/
- if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, cmdTokenPtr, interp);
- ExceptionRangeEnds(envPtr, range);
- } else {
- TclCompileTokens(interp, cmdTokenPtr+1,
- cmdTokenPtr->numComponents, envPtr);
- ExceptionRangeStarts(envPtr, range);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
- ExceptionRangeEnds(envPtr, range);
+ if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
+ code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ goto done;
+ }
+
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &isScalar, 1);
+ if (!isScalar) {
+ code = TCL_ERROR;
+ goto done;
}
/*
- * 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).
+ * Special case: literal empty value argument is just an "ensure array"
+ * operation.
*/
- 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);
+ if (isDataEven && len == 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 {
- 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_DUP, envPtr);
+ TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr);
+ TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr);
+ TclEmitInstInt1(INST_JUMP1, 3, envPtr);
+ /* Each branch decrements stack depth, but we only take one. */
+ TclAdjustStackDepth(1, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
+ PushStringLiteral(envPtr, "");
+ goto done;
}
- TclEmitOpcode(INST_POP, envPtr);
- PushLiteral(envPtr, "0", 1);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+ if (localIndex < 0) {
+ /*
+ * a non-local variable: upvar from a local one! This consumes the
+ * variable name that was left at stacktop.
+ */
+
+ localIndex = AnonymousLocal(envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+
/*
- * 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.
+ * Prepare for the internal foreach.
*/
- 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);
+ keyVar = AnonymousLocal(envPtr);
+ valVar = AnonymousLocal(envPtr);
+
+ infoPtr = ckalloc(sizeof(ForeachInfo));
+ infoPtr->numLists = 1;
+ infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
+ infoPtr->varLists[0]->numVars = 2;
+ infoPtr->varLists[0]->varIndexes[0] = keyVar;
+ infoPtr->varLists[0]->varIndexes[1] = valVar;
+ infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
/*
- * Update the target of the jump after the "no errors" code, then emit an
- * endCatch instruction at the end of the catch command.
+ * Start issuing instructions to write to the array.
*/
- if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileCatchCmd: bad jump distance %d\n",
- CurrentOffset(envPtr) - jumpFixup.codeOffset);
+ CompileWord(envPtr, dataTokenPtr, interp, 2);
+ if (!isDataLiteral || !isDataValid) {
+ /*
+ * Only need this safety check if we're handling a non-literal or list
+ * containing an invalid literal; with valid list literals, we've
+ * already checked (worth it because literals are a very common
+ * use-case with [array set]).
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ PushStringLiteral(envPtr, "1");
+ TclEmitOpcode( INST_BITAND, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
+ PushStringLiteral(envPtr, "list must have an even number of elements");
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ }
+
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+ offsetBack = CurrentOffset(envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
+ TclEmitOpcode( INST_FOREACH_STEP, envPtr);
+ TclEmitOpcode( INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-3, envPtr);
+ PushStringLiteral(envPtr, "");
+
+ done:
+ Tcl_DecrRefCount(literalObj);
+ return code;
+}
+
+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 isScalar, localIndex;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &isScalar, 1);
+ if (!isScalar) {
+ return TCL_ERROR;
}
- TclEmitOpcode(INST_END_CATCH, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
- envPtr->exceptDepth--;
+ 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);
+ TclEmitInstInt1(INST_UNSET_STK, 1, envPtr);
+ TclEmitInstInt1(INST_JUMP1, 3, envPtr);
+ /* Each branch decrements stack depth, but we only take one. */
+ TclAdjustStackDepth(1, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ PushStringLiteral(envPtr, "");
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileContinueCmd --
+ * TclCompileBreakCmd --
*
- * Procedure called to compile the "continue" command.
+ * Procedure called to compile the "break" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "continue" command at
+ * Instructions are added to envPtr to execute the "break" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileContinueCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileBreakCmd(
+ 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. */
{
- /*
- * There should be no argument after the "continue".
- */
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxPtr;
if (parsePtr->numWords != 1) {
return TCL_ERROR;
}
/*
- * Emit a continue instruction.
+ * Find the innermost exception range that contains this command.
*/
- TclEmitOpcode(INST_CONTINUE, envPtr);
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr);
+ if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+ /*
+ * Found the target! No need for a nasty INST_BREAK here.
+ */
+
+ TclCleanupStackForBreakContinue(envPtr, auxPtr);
+ TclAddLoopBreakFixup(envPtr, auxPtr);
+ } else {
+ /*
+ * Emit a real break.
+ */
+
+ TclEmitOpcode(INST_BREAK, envPtr);
+ }
+ TclAdjustStackDepth(1, envPtr);
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileDictCmd --
+ * TclCompileCatchCmd --
*
- * Procedure called to compile the "dict" command.
+ * Procedure called to compile the "catch" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "dict" command at
+ * Instructions are added to envPtr to execute the "catch" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileDictCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileCatchCmd(
+ 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;
- int numWords, size, i;
- const char *cmd;
- Proc *procPtr = envPtr->procPtr;
-
+ JumpFixup jumpFixup;
+ Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
+ int resultIndex, optsIndex, range, dropScript = 0;
+ DefineLineInformation; /* TIP #280 */
+ int depth = TclGetStackDepth(envPtr);
+
/*
- * There must be at least one argument after the command.
+ * If syntax does not match what we expect for [catch], do not compile.
+ * Let runtime checks determine if syntax has changed.
*/
- if (parsePtr->numWords < 2) {
+ if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
return TCL_ERROR;
}
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- numWords = parsePtr->numWords-2;
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * If variables were specified and the catch command is at global level
+ * (not in a procedure), don't compile it inline: the payoff is too small.
+ */
+
+ if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) {
return TCL_ERROR;
}
/*
- * 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!)
- */
-
- size = tokenPtr[1].size;
- cmd = tokenPtr[1].start;
- if (size==3 && strncmp(cmd, "set", 3)==0) {
- Tcl_Token *varTokenPtr;
- int dictVarIndex, nameChars;
- const char *name;
-
- if (numWords < 3 || procPtr == NULL) {
- return TCL_ERROR;
- }
- varTokenPtr = TokenAfter(tokenPtr);
- tokenPtr = TokenAfter(varTokenPtr);
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
- procPtr);
- for (i=1 ; i<numWords ; i++) {
- CompileWord(envPtr, tokenPtr, interp);
- tokenPtr = TokenAfter(tokenPtr);
- }
- TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr);
- TclEmitInt4( dictVarIndex, envPtr);
- return TCL_OK;
- } else if (size==4 && strncmp(cmd, "incr", 4)==0) {
- Tcl_Token *varTokenPtr, *keyTokenPtr, *incrTokenPtr = NULL;
- int dictVarIndex, nameChars, incrAmount = 1;
- const char *name;
+ * Make sure the variable names, if any, have no substitutions and just
+ * refer to local scalars.
+ */
- if (numWords < 2 || numWords > 3 || procPtr == NULL) {
+ resultIndex = optsIndex = -1;
+ cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (parsePtr->numWords >= 3) {
+ resultNameTokenPtr = TokenAfter(cmdTokenPtr);
+ /* DGP */
+ resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
+ if (resultIndex < 0) {
return TCL_ERROR;
}
- varTokenPtr = TokenAfter(tokenPtr);
- keyTokenPtr = TokenAfter(varTokenPtr);
- if (numWords == 3) {
- const char *word;
- int numBytes, code;
- Tcl_Obj *intObj;
-
- incrTokenPtr = TokenAfter(keyTokenPtr);
- if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- word = incrTokenPtr[1].start;
- numBytes = incrTokenPtr[1].size;
- /*
- * Note there is a danger that modifying the string could have
- * undesirable side effects. In this case, TclLooksLikeInt has no
- * dependencies on shared strings so we should be safe.
- */
-
- if (!TclLooksLikeInt(word, numBytes)) {
- return TCL_ERROR;
- }
-
- /*
- * Now try to really parse the number.
- */
-
- intObj = Tcl_NewStringObj(word, numBytes);
- Tcl_IncrRefCount(intObj);
- code = Tcl_GetIntFromObj(NULL, intObj, &incrAmount);
- Tcl_DecrRefCount(intObj);
- if (code != TCL_OK) {
+ /* DKF */
+ if (parsePtr->numWords == 4) {
+ optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
+ optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
+ if (optsIndex < 0) {
return TCL_ERROR;
}
}
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
- procPtr);
- CompileWord(envPtr, keyTokenPtr, interp);
- TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr);
- TclEmitInt4( dictVarIndex, envPtr);
- return TCL_OK;
- } else if (size==3 && strncmp(cmd, "get", 3)==0) {
- /*
- * Only compile this because we need INST_DICT_GET anyway.
- */
- if (numWords < 2) {
- return TCL_ERROR;
- }
- for (i=0 ; i<numWords ; i++) {
- tokenPtr = TokenAfter(tokenPtr);
- CompileWord(envPtr, tokenPtr, interp);
- }
- TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
- return TCL_OK;
- } else if (size==3 && strncmp(cmd, "for", 3)==0) {
- Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
- int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
- int infoIndex, jumpDisplacement, bodyTargetOffset, doneTargetOffset;
- int endTargetOffset;
- const char **argv;
- Tcl_DString buffer;
- int savedStackDepth = envPtr->currStackDepth;
-
- if (numWords != 3 || procPtr == NULL) {
- return TCL_ERROR;
- }
-
- varsTokenPtr = TokenAfter(tokenPtr);
- dictTokenPtr = TokenAfter(varsTokenPtr);
- bodyTokenPtr = TokenAfter(dictTokenPtr);
- if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
- bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- 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);
- if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numWords,
- &argv) != TCL_OK) {
- Tcl_DStringFree(&buffer);
- return TCL_ERROR;
- }
- Tcl_DStringFree(&buffer);
- if (numWords != 2) {
- ckfree((char *) argv);
- return TCL_ERROR;
- }
- nameChars = strlen(argv[0]);
- if (!TclIsLocalScalar(argv[0], nameChars)) {
- ckfree((char *) argv);
- return TCL_ERROR;
- }
- keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, VAR_SCALAR,
- procPtr);
- nameChars = strlen(argv[1]);
- if (!TclIsLocalScalar(argv[1], nameChars)) {
- ckfree((char *) argv);
- return TCL_ERROR;
- }
- valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, VAR_SCALAR,
- procPtr);
- ckfree((char *) argv);
-
- /*
- * Allocate a temporary variable to store the iterator reference. The
- * variable will contain a Tcl_DictSearch reference which will be
- * allocated by INST_DICT_FIRST and disposed when the variable is
- * unset (at which point it should also have been finished with).
- */
-
- infoIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
-
- /*
- * 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.
- */
+ }
- CompileWord(envPtr, dictTokenPtr, interp);
- TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
- doneTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
+ /*
+ * We will compile the catch command. Declare the exception range that it
+ * uses.
+ *
+ * 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.
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
+ ExceptionRangeStarts(envPtr, range);
+ BODY(cmdTokenPtr, 1);
+ } else {
+ SetLineInformation(1);
+ CompileTokens(envPtr, cmdTokenPtr, interp);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
+ ExceptionRangeStarts(envPtr, range);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
+ /* drop the script */
+ dropScript = 1;
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ ExceptionRangeEnds(envPtr, range);
- /*
- * Now we catch errors from here on so that we can finalize the search
- * started by Tcl_DictObjFirst above.
- */
+
+ /*
+ * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
+ * and jump around the "error case" code.
+ */
- catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
- ExceptionRangeStarts(envPtr, catchRange);
+ TclCheckStackDepth(depth+1, envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- /*
- * Inside the iteration, write the loop variables.
- */
+ /*
+ * Emit the "error case" epilogue. Push the interpreter result and the
+ * return code.
+ */
- bodyTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclSetStackDepth(depth + dropScript, envPtr);
+
+ if (dropScript) {
+ TclEmitOpcode( INST_POP, envPtr);
+ }
- /*
- * Set up the loop exception targets.
- */
- loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
- ExceptionRangeStarts(envPtr, loopRange);
+ /* Stack at this point is empty */
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- /*
- * Compile the loop body itself. It should be stack-neutral.
- */
+ /* Stack at this point on both branches: result returnCode */
- CompileBody(envPtr, bodyTokenPtr, interp);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode( INST_POP, envPtr);
- envPtr->currStackDepth = savedStackDepth;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+ Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
+ (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
+ }
- /*
- * Both exception target ranges (error and loop) end here.
- */
+ /*
+ * Push the return options if the caller wants them. This needs to happen
+ * before INST_END_CATCH
+ */
- ExceptionRangeEnds(envPtr, loopRange);
- ExceptionRangeEnds(envPtr, catchRange);
+ if (optsIndex != -1) {
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ }
- /*
- * Continue (or just normally process) by getting the next pair of
- * items from the dictionary and jumping back to the code to write
- * them into variables if there is another pair.
- */
+ /*
+ * End the catch
+ */
- ExceptionRangeTarget(envPtr, loopRange, continueOffset);
- TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
- jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
- /*
- * Otherwise we're done (the jump after the DICT_FIRST points here)
- * and we need to pop the bogus key/value pair (pushed to keep stack
- * calculations easy!)
- */
+ /*
+ * Save the result and return options if the caller wants them. This needs
+ * to happen after INST_END_CATCH (compile-3.6/7).
+ */
- jumpDisplacement = CurrentOffset(envPtr) - doneTargetOffset;
- TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
- envPtr->codeStart + doneTargetOffset);
- TclEmitOpcode( INST_POP, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ if (optsIndex != -1) {
+ Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
- /*
- * Now do the final cleanup for the no-error case (this is where we
- * break out of the loop to) by force-terminating the iteration (if
- * not already terminated), ditching the exception info and jumping to
- * the last instruction for this command. In theory, this could be
- * done using the "finally" clause (next generated) but this is
- * faster.
- */
+ /*
+ * At this point, the top of the stack is inconveniently ordered:
+ * result returnCode
+ * Reverse the stack to store the result.
+ */
- ExceptionRangeTarget(envPtr, loopRange, breakOffset);
- TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr);
- TclEmitOpcode( INST_END_CATCH, envPtr);
- endTargetOffset = CurrentOffset(envPtr);
- TclEmitInstInt4( INST_JUMP4, 0, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ if (resultIndex != -1) {
+ Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
+ }
+ TclEmitOpcode( INST_POP, envPtr);
- /*
- * Error handler "finally" clause, which force-terminates the
- * iteration and rethrows the error.
- */
+ TclCheckStackDepth(depth+1, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileConcatCmd --
+ *
+ * Procedure called to compile the "concat" 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 "concat" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
- 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);
+int
+TclCompileConcatCmd(
+ 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_Obj *objPtr, *listObj;
+ Tcl_Token *tokenPtr;
+ int i;
+ /* TODO: Consider compiling expansion case. */
+ if (parsePtr->numWords == 1) {
/*
- * 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.
+ * [concat] without arguments just pushes an empty object.
*/
- jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
- TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
- envPtr->codeStart + endTargetOffset);
- PushLiteral(envPtr, "", 0);
- envPtr->exceptDepth -= 2;
+ PushStringLiteral(envPtr, "");
return TCL_OK;
- } else if (size==6 && strncmp(cmd, "update", 6)==0) {
- const char *name;
- int nameChars, dictIndex, keyTmpIndex, numVars, range;
- Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr;
- Tcl_DString localVarsLiteral;
-
- /*
- * Parse the command. Expect the following:
- * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
- */
-
- if (numWords < 4 || numWords & 1 || procPtr == NULL) {
- return TCL_ERROR;
- }
- numVars = numWords/2 - 1;
- dictVarTokenPtr = TokenAfter(tokenPtr);
- if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = dictVarTokenPtr[1].start;
- nameChars = dictVarTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- dictIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
- procPtr);
-
- Tcl_DStringInit(&localVarsLiteral);
- keyTokenPtrs = (Tcl_Token **) ckalloc(sizeof(Tcl_Token*) * numVars);
- tokenPtr = TokenAfter(dictVarTokenPtr);
- for (i=0 ; i<numVars ; i++) {
- keyTokenPtrs[i] = tokenPtr;
- tokenPtr = TokenAfter(tokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- Tcl_DStringFree(&localVarsLiteral);
- ckfree((char *) keyTokenPtrs);
- return TCL_ERROR;
- }
- name = tokenPtr[1].start;
- nameChars = tokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- Tcl_DStringFree(&localVarsLiteral);
- ckfree((char *) keyTokenPtrs);
- return TCL_ERROR;
- } else {
- int localVar = TclFindCompiledLocal(name, nameChars, 1,
- VAR_SCALAR, procPtr);
- char buf[12];
-
- sprintf(buf, "%d", localVar);
- Tcl_DStringAppendElement(&localVarsLiteral, buf);
- }
- tokenPtr = TokenAfter(tokenPtr);
- }
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- Tcl_DStringFree(&localVarsLiteral);
- ckfree((char *) keyTokenPtrs);
- return TCL_ERROR;
- }
- bodyTokenPtr = tokenPtr;
-
- keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
-
- for (i=0 ; i<numVars ; i++) {
- CompileWord(envPtr, keyTokenPtrs[i], interp);
- }
- TclEmitInstInt4( INST_LIST, numVars, envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr);
- PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral),
- Tcl_DStringLength(&localVarsLiteral));
- TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
-
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
- TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
-
- ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, bodyTokenPtr, interp);
- ExceptionRangeEnds(envPtr, range);
-
- ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitOpcode( INST_PUSH_RESULT, envPtr);
- TclEmitOpcode( INST_END_CATCH, envPtr);
- envPtr->exceptDepth--;
-
- TclEmitInstInt4( INST_LOAD_SCALAR4, keyTmpIndex, envPtr);
- PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral),
- Tcl_DStringLength(&localVarsLiteral));
- /*
- * Any literal would do, but this one is handy...
- */
- TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr);
- TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
-
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ }
- Tcl_DStringFree(&localVarsLiteral);
- ckfree((char *) keyTokenPtrs);
- return TCL_OK;
- } else if (size==6 && strncmp(cmd, "append", 6) == 0) {
- Tcl_Token *varTokenPtr;
- int dictVarIndex, nameChars;
- const char *name;
+ /*
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
+ */
- /*
- * Arbirary safe limit; anyone exceeding it should stop worrying about
- * speed quite so much. ;-)
- */
- if (numWords < 3 || numWords > 100 || procPtr == NULL) {
- return TCL_ERROR;
- }
- varTokenPtr = TokenAfter(tokenPtr);
- tokenPtr = TokenAfter(varTokenPtr);
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
- procPtr);
- for (i=1 ; i<numWords ; i++) {
- CompileWord(envPtr, tokenPtr, interp);
- tokenPtr = TokenAfter(tokenPtr);
- }
- if (numWords > 3) {
- TclEmitInstInt1( INST_CONCAT1, numWords-2, envPtr);
+ listObj = Tcl_NewObj();
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objPtr = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ break;
}
- TclEmitInstInt4( INST_DICT_APPEND, dictVarIndex, envPtr);
- return TCL_OK;
- } else if (size==7 && strncmp(cmd, "lappend", 7) == 0) {
- Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
- int dictVarIndex, nameChars;
- const char *name;
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+ }
+ if (listObj != NULL) {
+ Tcl_Obj **objs;
+ const char *bytes;
+ int len;
- if (numWords != 3 || procPtr == NULL) {
- return TCL_ERROR;
- }
- varTokenPtr = TokenAfter(tokenPtr);
- keyTokenPtr = TokenAfter(varTokenPtr);
- valueTokenPtr = TokenAfter(keyTokenPtr);
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- if (!TclIsLocalScalar(name, nameChars)) {
- return TCL_ERROR;
- }
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
- procPtr);
- CompileWord(envPtr, keyTokenPtr, interp);
- CompileWord(envPtr, valueTokenPtr, interp);
- TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
+ Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+ objPtr = Tcl_ConcatObj(len, objs);
+ Tcl_DecrRefCount(listObj);
+ bytes = Tcl_GetStringFromObj(objPtr, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(objPtr);
return TCL_OK;
}
/*
- * Something we do not know how to compile.
+ * General case: runtime concat.
*/
- return TCL_ERROR;
+
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileExprCmd --
+ * TclCompileContinueCmd --
*
- * Procedure called to compile the "expr" command.
+ * Procedure called to compile the "continue" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "expr" command at
+ * Instructions are added to envPtr to execute the "continue" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileExprCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileContinueCmd(
+ 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 *firstWordPtr;
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxPtr;
- if (parsePtr->numWords == 1) {
+ /*
+ * There should be no argument after the "continue".
+ */
+
+ if (parsePtr->numWords != 1) {
return TCL_ERROR;
}
- firstWordPtr = TokenAfter(parsePtr->tokenPtr);
- TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr);
+ /*
+ * See if we can find a valid continueOffset (i.e., not -1) in the
+ * innermost containing exception range.
+ */
+
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr);
+ if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+ /*
+ * Found the target! No need for a nasty INST_CONTINUE here.
+ */
+
+ TclCleanupStackForBreakContinue(envPtr, auxPtr);
+ TclAddLoopContinueFixup(envPtr, auxPtr);
+ } else {
+ /*
+ * Emit a real continue.
+ */
+
+ TclEmitOpcode(INST_CONTINUE, envPtr);
+ }
+ TclAdjustStackDepth(1, envPtr);
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileForCmd --
+ * TclCompileDict*Cmd --
*
- * Procedure called to compile the "for" command.
+ * Functions called to compile "dict" sucommands.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "for" command at
+ * Instructions are added to envPtr to execute the "dict" subcommand at
* runtime.
*
*----------------------------------------------------------------------
*/
+
int
-TclCompileForCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileDictSetCmd(
+ 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 *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
- JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
- int bodyRange, nextRange;
- int savedStackDepth = envPtr->currStackDepth;
-
- if (parsePtr->numWords != 5) {
- return TCL_ERROR;
- }
+ Tcl_Token *tokenPtr;
+ int i, dictVarIndex;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *varTokenPtr;
/*
- * If the test expression requires substitutions, don't compile the for
- * command inline. E.g., the expression might cause the loop to never
- * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
+ * There must be at least one argument after the command.
*/
- startTokenPtr = TokenAfter(parsePtr->tokenPtr);
- testTokenPtr = TokenAfter(startTokenPtr);
- if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
/*
- * Bail out also if the body or the next expression require substitutions
- * in order to insure correct behaviour [Bug 219166]
+ * 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.
*/
- nextTokenPtr = TokenAfter(testTokenPtr);
- bodyTokenPtr = TokenAfter(nextTokenPtr);
- if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
- || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (dictVarIndex < 0) {
return TCL_ERROR;
}
/*
- * Create ExceptionRange records for the body and the "next" command. The
- * "next" command's ExceptionRange supports break but not continue (and
- * has a -1 continueOffset).
+ * Remaining words (key path and value to set) can be handled normally.
*/
- bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
- nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ tokenPtr = TokenAfter(varTokenPtr);
+ for (i=2 ; i< parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
/*
- * Inline compile the initial command.
+ * Now emit the instruction to do the dict manipulation.
*/
- CompileBody(envPtr, startTokenPtr, interp);
- TclEmitOpcode(INST_POP, envPtr);
+ TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr);
+ TclEmitInt4( dictVarIndex, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileDictIncrCmd(
+ 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 *varTokenPtr, *keyTokenPtr;
+ int dictVarIndex, incrAmount;
/*
- * Jump to the evaluation of the condition. This code uses the "loop
- * rotation" optimisation (which eliminates one branch from the loop).
- * "for start cond next body" produces then:
- * start
- * goto A
- * B: body : bodyCodeOffset
- * next : nextCodeOffset, continueOffset
- * A: cond -> result : testCodeOffset
- * if (result) goto B
+ * There must be at least two arguments after the command.
*/
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
+ return TCL_ERROR;
+ }
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ keyTokenPtr = TokenAfter(varTokenPtr);
/*
- * Compile the loop body.
+ * Parse the increment amount, if present.
*/
- bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
- CompileBody(envPtr, bodyTokenPtr, interp);
- ExceptionRangeEnds(envPtr, bodyRange);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
-
+ if (parsePtr->numWords == 4) {
+ const char *word;
+ int numBytes, code;
+ Tcl_Token *incrTokenPtr;
+ Tcl_Obj *intObj;
+
+ incrTokenPtr = TokenAfter(keyTokenPtr);
+ if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
+ }
+ word = incrTokenPtr[1].start;
+ numBytes = incrTokenPtr[1].size;
+
+ intObj = Tcl_NewStringObj(word, numBytes);
+ Tcl_IncrRefCount(intObj);
+ code = TclGetIntFromObj(NULL, intObj, &incrAmount);
+ TclDecrRefCount(intObj);
+ if (code != TCL_OK) {
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
+ }
+ } else {
+ incrAmount = 1;
+ }
/*
- * Compile the "next" subcommand.
+ * 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.
*/
- envPtr->currStackDepth = savedStackDepth;
- nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
- CompileBody(envPtr, nextTokenPtr, interp);
- ExceptionRangeEnds(envPtr, nextRange);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
- envPtr->currStackDepth = savedStackDepth;
+ dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (dictVarIndex < 0) {
+ return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
/*
- * Compile the test expression then emit the conditional jump that
- * terminates the for.
+ * Emit the key and the code to actually do the increment.
*/
- testCodeOffset = CurrentOffset(envPtr);
-
- jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
- bodyCodeOffset += 3;
- nextCodeOffset += 3;
- testCodeOffset += 3;
- }
-
- envPtr->currStackDepth = savedStackDepth;
- TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
+ CompileWord(envPtr, keyTokenPtr, interp, 2);
+ TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr);
+ TclEmitInt4( dictVarIndex, envPtr);
+ return TCL_OK;
+}
- jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
- if (jumpDist > 127) {
- TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
- }
+int
+TclCompileDictGetCmd(
+ 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 i;
+ DefineLineInformation; /* TIP #280 */
/*
- * Fix the starting points of the exception ranges (may have moved due to
- * jump type modification) and set where the exceptions target.
+ * 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).
*/
- envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
- envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
-
- envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
-
- ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
- ExceptionRangeTarget(envPtr, nextRange, breakOffset);
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * The for command's result is an empty string.
+ * Only compile this because we need INST_DICT_GET anyway.
*/
- envPtr->currStackDepth = savedStackDepth;
- PushLiteral(envPtr, "", 0);
-
- envPtr->exceptDepth--;
+ for (i=1 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileForeachCmd --
- *
- * Procedure called to compile the "foreach" 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 "foreach" command at
- * runtime.
- *
-n*----------------------------------------------------------------------
- */
int
-TclCompileForeachCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+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. */
{
- Proc *procPtr = envPtr->procPtr;
- ForeachInfo *infoPtr; /* Points to the structure describing this
- * foreach command. Stored in a AuxData
- * record in the ByteCode. */
- int firstValueTemp; /* Index of the first temp var in the frame
- * used to point to a value list. */
- int loopCtTemp; /* Index of temp var holding the loop's
- * iteration count. */
- Tcl_Token *tokenPtr, *bodyTokenPtr;
- unsigned char *jumpPc;
- JumpFixup jumpFalseFixup;
- int jumpBackDist, jumpBackOffset, infoIndex, range;
- int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
- int savedStackDepth = envPtr->currStackDepth;
+ Tcl_Token *tokenPtr;
+ int i;
+ DefineLineInformation; /* TIP #280 */
/*
- * We parse the variable list argument words and create two arrays:
- * varcList[i] is number of variables in i-th var list
- * varvList[i] points to array of var names in i-th var list
+ * 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).
*/
-#define STATIC_VAR_LIST_SIZE 5
- int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
- CONST char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
- int *varcList = varcListStaticSpace;
- CONST char ***varvList = varvListStaticSpace;
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * If the foreach command isn't in a procedure, don't compile it inline:
- * the payoff is too small.
+ * Now we do the code generation.
*/
- if (procPtr == NULL) {
- return TCL_ERROR;
+ for (i=1 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
}
+ TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ return TCL_OK;
+}
- numWords = parsePtr->numWords;
- if ((numWords < 4) || (numWords%2 != 0)) {
- return TCL_ERROR;
- }
+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;
/*
- * Bail out if the body requires substitutions in order to insure correct
- * behaviour [Bug 219166]
+ * There must be at least one argument after the variable name for us to
+ * compile to bytecode.
*/
- for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) {
- tokenPtr = TokenAfter(tokenPtr);
- }
- bodyTokenPtr = tokenPtr;
- if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
/*
- * Allocate storage for the varcList and varvList arrays if necessary.
+ * 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.
*/
- numLists = (numWords - 2)/2;
- if (numLists > STATIC_VAR_LIST_SIZE) {
- varcList = (int *) ckalloc(numLists * sizeof(int));
- varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
- }
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- varcList[loopIndex] = 0;
- varvList[loopIndex] = NULL;
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
+ if (dictVarIndex < 0) {
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
- * Break up each var list and set the varcList and varvList arrays. Don't
- * compile the foreach inline if any var name needs substitutions or isn't
- * a scalar, or if any var list needs substitutions.
+ * Remaining words (the key path) can be handled normally.
*/
- loopIndex = 0;
- for (i = 0, tokenPtr = parsePtr->tokenPtr;
- i < numWords-1;
- i++, tokenPtr = TokenAfter(tokenPtr)) {
- Tcl_DString varList;
-
- if (i%2 != 1) {
- continue;
- }
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- code = TCL_ERROR;
- goto done;
- }
-
- /*
- * Lots of copying going on here. Need a ListObj wizard to show a
- * better way.
- */
-
- Tcl_DStringInit(&varList);
- Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
- code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
- &varcList[loopIndex], &varvList[loopIndex]);
- Tcl_DStringFree(&varList);
- if (code != TCL_OK) {
- code = TCL_ERROR;
- goto done;
- }
- numVars = varcList[loopIndex];
- for (j = 0; j < numVars; j++) {
- CONST char *varName = varvList[loopIndex][j];
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
- code = TCL_ERROR;
- goto done;
- }
- }
- loopIndex++;
+ for (i=2 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
}
/*
- * We will compile the foreach command. Reserve (numLists + 1) temporary
- * variables:
- * - numLists temps to hold each value list
- * - 1 temp for the loop counter (index of next element in each list)
- *
- * At this time we don't try to reuse temporaries; if there are two
- * nonoverlapping foreach loops, they don't share any temps.
+ * Now emit the instruction to do the dict manipulation.
*/
- code = TCL_OK;
- firstValueTemp = -1;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, VAR_SCALAR, procPtr);
- if (loopIndex == 0) {
- firstValueTemp = tempVar;
- }
+ 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;
}
- loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, VAR_SCALAR, procPtr);
/*
- * Create and initialize the ForeachInfo and ForeachVarList data
- * structures describing this command. Then create a AuxData record
- * pointing to the ForeachInfo structure.
+ * See if we can build the value at compile time...
*/
- infoPtr = (ForeachInfo *) ckalloc((unsigned)
- sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
- infoPtr->numLists = numLists;
- infoPtr->firstValueTemp = firstValueTemp;
- infoPtr->loopCtTemp = loopCtTemp;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- ForeachVarList *varListPtr;
- numVars = varcList[loopIndex];
- varListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
- varListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- CONST char *varName = varvList[loopIndex][j];
- int nameChars = strlen(varName);
- varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, VAR_SCALAR, procPtr);
+ 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;
}
- infoPtr->varLists[loopIndex] = varListPtr;
+ 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);
}
- infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
/*
- * Create an exception record to handle [break] and [continue].
+ * We did! Excellent. The "verifyDict" is to do type forcing.
*/
- range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+ bytes = Tcl_GetStringFromObj(dictObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_DICT_VERIFY, envPtr);
+ Tcl_DecrRefCount(dictObj);
+ return TCL_OK;
/*
- * Evaluate then store each value list in the associated temporary.
+ * 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.
*/
- loopIndex = 0;
- for (i = 0, tokenPtr = parsePtr->tokenPtr;
- i < numWords-1;
- i++, tokenPtr = TokenAfter(tokenPtr)) {
- if ((i%2 == 0) && (i > 0)) {
- TclCompileTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
-
- tempVar = (firstValueTemp + loopIndex);
- if (tempVar <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- loopIndex++;
- }
+ nonConstant:
+ worker = AnonymousLocal(envPtr);
+ if (worker < 0) {
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
- /*
- * Initialize the temporary var that holds the count of loop iterations.
- */
+ PushStringLiteral(envPtr, "");
+ 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;
+}
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+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;
/*
- * Top of loop code: assign each loop variable and check whether
- * to terminate the loop.
+ * 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.
*/
- ExceptionRangeTarget(envPtr, range, continueOffset);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+ /* TODO: Consider support for compiling expanded args. (less likely) */
+ if (parsePtr->numWords < 2) {
+ PushStringLiteral(envPtr, "");
+ 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;
+ }
/*
- * Inline compile the loop body.
+ * 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.
*/
- ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, bodyTokenPtr, interp);
- ExceptionRangeEnds(envPtr, range);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
+ workerIndex = AnonymousLocal(envPtr);
+ if (workerIndex < 0) {
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+ infoIndex = AnonymousLocal(envPtr);
/*
- * Jump back to the test at the top of the loop. Generate a 4 byte jump if
- * the distance to the test is > 120 bytes. This is conservative and
- * ensures that we won't have to replace this jump if we later need to
- * replace the ifFalse jump with a 4 byte jump.
+ * Get the first dictionary and verify that it is so.
*/
- jumpBackOffset = CurrentOffset(envPtr);
- jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
+ 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);
/*
- * Fix the target of the jump after the foreach_step test.
+ * For each of the remaining dictionaries...
*/
- if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->exceptArrayPtr[range].codeOffset += 3;
-
+ outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr);
+ ExceptionRangeStarts(envPtr, outLoop);
+ for (i=2 ; i<parsePtr->numWords ; i++) {
/*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
+ * Get the dictionary, and merge its pairs into the first dict (using
+ * a small loop).
*/
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
- }
+ 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);
/*
- * Set the loop's break target.
+ * Clean up any state left over.
*/
- ExceptionRangeTarget(envPtr, range, breakOffset);
+ Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( workerIndex, envPtr);
+ TclEmitInstInt1( INST_JUMP1, 18, envPtr);
/*
- * The foreach command's result is an empty string.
+ * If an exception happens when starting to iterate over the second (and
+ * subsequent) dicts. This is strictly not necessary, but it is nice.
*/
- envPtr->currStackDepth = savedStackDepth;
- PushLiteral(envPtr, "", 0);
- envPtr->currStackDepth = savedStackDepth + 1;
+ TclAdjustStackDepth(-1, envPtr);
+ 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);
- done:
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != (CONST char **) NULL) {
- ckfree((char *) varvList[loopIndex]);
- }
- }
- if (varcList != varcListStaticSpace) {
- ckfree((char *) varcList);
- ckfree((char *) varvList);
- }
- envPtr->exceptDepth--;
- return code;
+ return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupForeachInfo --
- *
- * This procedure duplicates a ForeachInfo structure created as auxiliary
- * data during the compilation of a foreach command.
- *
- * Results:
- * A pointer to a newly allocated copy of the existing ForeachInfo
- * structure is returned.
- *
- * Side effects:
- * Storage for the copied ForeachInfo record is allocated. If the
- * original ForeachInfo structure pointed to any ForeachVarList records,
- * these structures are also copied and pointers to them are stored in
- * the new ForeachInfo record.
- *
- *----------------------------------------------------------------------
- */
-static ClientData
-DupForeachInfo(clientData)
- ClientData clientData; /* The foreach command's compilation
- * auxiliary data to duplicate. */
+int
+TclCompileDictForCmd(
+ 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. */
{
- register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
- ForeachInfo *dupPtr;
- register ForeachVarList *srcListPtr, *dupListPtr;
- int numLists = srcPtr->numLists;
- int numVars, i, j;
-
- dupPtr = (ForeachInfo *) ckalloc((unsigned)
- sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
- dupPtr->numLists = numLists;
- dupPtr->firstValueTemp = srcPtr->firstValueTemp;
- dupPtr->loopCtTemp = srcPtr->loopCtTemp;
-
- for (i = 0; i < numLists; i++) {
- srcListPtr = srcPtr->varLists[i];
- numVars = srcListPtr->numVars;
- dupListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
- dupListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
- }
- dupPtr->varLists[i] = dupListPtr;
- }
- return (ClientData) dupPtr;
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeForeachInfo --
- *
- * Procedure to free a ForeachInfo structure created as auxiliary data
- * during the compilation of a foreach command.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Storage for the ForeachInfo structure pointed to by the ClientData
- * argument is freed as is any ForeachVarList record pointed to by the
- * ForeachInfo structure.
- *
- *----------------------------------------------------------------------
- */
-static void
-FreeForeachInfo(clientData)
- ClientData clientData; /* The foreach command's compilation
- * auxiliary data to free. */
+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. */
{
- register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
- register ForeachVarList *listPtr;
- int numLists = infoPtr->numLists;
- register int i;
-
- for (i = 0; i < numLists; i++) {
- listPtr = infoPtr->varLists[i];
- ckfree((char *) listPtr);
- }
- ckfree((char *) infoPtr);
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIfCmd --
- *
- * Procedure called to compile the "if" 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 "if" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
+
int
-TclCompileIfCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+CompileDictEachCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ 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. */
{
- JumpFixupArray jumpFalseFixupArray;
- /* Used to fix the ifFalse jump after each
- * test when its target PC is determined. */
- JumpFixupArray jumpEndFixupArray;
- /* Used to fix the jump after each "then" body
- * to the end of the "if" when that PC is
- * determined. */
- Tcl_Token *tokenPtr, *testTokenPtr;
- int jumpFalseDist;
- int jumpIndex = 0; /* avoid compiler warning. */
- int numWords, wordIdx, numBytes, j, code;
- CONST char *word;
- int savedStackDepth = envPtr->currStackDepth;
- /* Saved stack depth at the start of the first
- * test; the envPtr current depth is restored
- * to this value at the start of each test. */
- int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */
- int boolVal; /* value of static condition */
- int compileScripts = 1;
-
- /*
- * Only compile the "if" command if all arguments are simple words, in
- * order to insure correct substitution [Bug 219166]
- */
-
- tokenPtr = parsePtr->tokenPtr;
- wordIdx = 0;
- numWords = parsePtr->numWords;
+ 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. */
+ const char **argv;
+ Tcl_DString buffer;
- for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ /*
+ * There must be three arguments after the command.
+ */
+
+ if (parsePtr->numWords != 4) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictTokenPtr = TokenAfter(varsTokenPtr);
+ bodyTokenPtr = TokenAfter(dictTokenPtr);
+ if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+ bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ /*
+ * Create temporary variable to capture return values from loop body when
+ * we're collecting results.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ collectVar = AnonymousLocal(envPtr);
+ if (collectVar < 0) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
- tokenPtr = TokenAfter(tokenPtr);
}
+ /*
+ * Check we've got a pair of variables and that they are local variables.
+ * Then extract their indices in the LVT.
+ */
- TclInitJumpFixupArray(&jumpFalseFixupArray);
- TclInitJumpFixupArray(&jumpEndFixupArray);
- code = TCL_OK;
+ Tcl_DStringInit(&buffer);
+ TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
+ if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
+ &argv) != TCL_OK) {
+ Tcl_DStringFree(&buffer);
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+ Tcl_DStringFree(&buffer);
+ if (numVars != 2) {
+ ckfree(argv);
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ nameChars = strlen(argv[0]);
+ keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
+ nameChars = strlen(argv[1]);
+ valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
+ ckfree(argv);
+
+ if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
/*
- * Each iteration of this loop compiles one "if expr ?then? body" or
- * "elseif expr ?then? body" clause.
+ * Allocate a temporary variable to store the iterator reference. The
+ * variable will contain a Tcl_DictSearch reference which will be
+ * allocated by INST_DICT_FIRST and disposed when the variable is unset
+ * (at which point it should also have been finished with).
*/
- tokenPtr = parsePtr->tokenPtr;
- wordIdx = 0;
- while (wordIdx < numWords) {
- /*
- * Stop looping if the token isn't "if" or "elseif".
- */
+ infoIndex = AnonymousLocal(envPtr);
+ if (infoIndex < 0) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
- word = tokenPtr[1].start;
- numBytes = tokenPtr[1].size;
- if ((tokenPtr == parsePtr->tokenPtr)
- || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
- tokenPtr = TokenAfter(tokenPtr);
- wordIdx++;
- } else {
- break;
- }
- if (wordIdx >= numWords) {
- code = TCL_ERROR;
- goto done;
- }
+ /*
+ * Preparation complete; issue instructions. Note that this code issues
+ * fixed-sized jumps. That simplifies things a lot!
+ *
+ * First up, initialize the accumulator dictionary if needed.
+ */
- /*
- * Compile the test expression then emit the conditional jump around
- * the "then" part.
- */
+ if (collect == TCL_EACH_COLLECT) {
+ PushStringLiteral(envPtr, "");
+ Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
- envPtr->currStackDepth = savedStackDepth;
- testTokenPtr = tokenPtr;
+ /*
+ * Get the dictionary and start the iteration. No catching of errors at
+ * this point.
+ */
+ CompileWord(envPtr, dictTokenPtr, interp, 2);
- if (realCond) {
- /*
- * Find out if the condition is a constant.
- */
+ /*
+ * Now we catch errors from here on so that we can finalize the search
+ * started by Tcl_DictObjFirst above.
+ */
- Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
- testTokenPtr[1].size);
- Tcl_IncrRefCount(boolObj);
- code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
- Tcl_DecrRefCount(boolObj);
- if (code == TCL_OK) {
- /*
- * A static condition
- */
- realCond = 0;
- if (!boolVal) {
- compileScripts = 0;
- }
- } else {
- Tcl_ResetResult(interp);
- TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFalseFixupArray);
- }
- jumpIndex = jumpFalseFixupArray.next;
- jumpFalseFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- jumpFalseFixupArray.fixup+jumpIndex);
- }
- code = TCL_OK;
- }
+ catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
+ ExceptionRangeStarts(envPtr, catchRange);
+ TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
+ emptyTargetOffset = CurrentOffset(envPtr);
+ TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
- /*
- * Skip over the optional "then" before the then clause.
- */
+ /*
+ * Inside the iteration, write the loop variables.
+ */
- tokenPtr = TokenAfter(testTokenPtr);
- wordIdx++;
- if (wordIdx >= numWords) {
- code = TCL_ERROR;
- goto done;
- }
- if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- word = tokenPtr[1].start;
- numBytes = tokenPtr[1].size;
- if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
- tokenPtr = TokenAfter(tokenPtr);
- wordIdx++;
- if (wordIdx >= numWords) {
- code = TCL_ERROR;
- goto done;
- }
- }
- }
+ bodyTargetOffset = CurrentOffset(envPtr);
+ Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
- /*
- * Compile the "then" command body.
- */
+ /*
+ * Set up the loop exception targets.
+ */
- if (compileScripts) {
- envPtr->currStackDepth = savedStackDepth;
- CompileBody(envPtr, tokenPtr, interp);
- }
+ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ ExceptionRangeStarts(envPtr, loopRange);
- if (realCond) {
- /*
- * Jump to the end of the "if" command. Both jumpFalseFixupArray
- * and jumpEndFixupArray are indexed by "jumpIndex".
- */
+ /*
+ * Compile the loop body itself. It should be stack-neutral.
+ */
- if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
- TclExpandJumpFixupArray(&jumpEndFixupArray);
- }
- jumpEndFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- jumpEndFixupArray.fixup+jumpIndex);
+ BODY(bodyTokenPtr, 3);
+ 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);
- /*
- * Fix the target of the jumpFalse after the test. Generate a 4
- * byte jump if the distance is > 120 bytes. This is conservative,
- * and ensures that we won't have to replace this jump if we later
- * also need to replace the proceeding jump to the end of the "if"
- * with a 4 byte jump.
- */
+ /*
+ * Both exception target ranges (error and loop) end here.
+ */
- if (TclFixupForwardJumpToHere(envPtr,
- jumpFalseFixupArray.fixup+jumpIndex, 120)) {
- /*
- * Adjust the code offset for the proceeding jump to the end
- * of the "if" command.
- */
+ ExceptionRangeEnds(envPtr, loopRange);
+ ExceptionRangeEnds(envPtr, catchRange);
- jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
- }
- } else if (boolVal) {
- /*
- * We were processing an "if 1 {...}"; stop compiling scripts.
- */
+ /*
+ * Continue (or just normally process) by getting the next pair of items
+ * from the dictionary and jumping back to the code to write them into
+ * variables if there is another pair.
+ */
- compileScripts = 0;
- } else {
- /*
- * We were processing an "if 0 {...}"; reset so that the rest
- * (elseif, else) is compiled correctly.
- */
+ ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+ TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
+ jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
+ TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
+ endTargetOffset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP1, 0, envPtr);
- realCond = 1;
- compileScripts = 1;
- }
+ /*
+ * Error handler "finally" clause, which force-terminates the iteration
+ * and rethrows the error.
+ */
- tokenPtr = TokenAfter(tokenPtr);
- wordIdx++;
+ TclAdjustStackDepth(-1, envPtr);
+ ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( collectVar, envPtr);
}
+ TclEmitOpcode( INST_RETURN_STK, envPtr);
/*
- * Restore the current stack depth in the environment; the "else" clause
- * (or its default) will add 1 to this.
+ * Otherwise we're done (the jump after the DICT_FIRST points here) and we
+ * need to pop the bogus key/value pair (pushed to keep stack calculations
+ * easy!) Note that we skip the END_CATCH. [Bug 1382528]
*/
- envPtr->currStackDepth = savedStackDepth;
+ jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
+ TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
+ envPtr->codeStart + emptyTargetOffset);
+ jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
+ TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
+ envPtr->codeStart + endTargetOffset);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, loopRange);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
/*
- * Check for the optional else clause. Do not compile anything if this was
- * an "if 1 {...}" case.
+ * Final stage of the command (normal case) is that we push an empty
+ * object (or push the accumulator as the result object). This is done
+ * last to promote peephole optimization when it's dropped immediately.
*/
- if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
- /*
- * There is an else clause. Skip over the optional "else" word.
- */
+ TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ } else {
+ PushStringLiteral(envPtr, "");
+ }
+ return TCL_OK;
+}
- word = tokenPtr[1].start;
- numBytes = tokenPtr[1].size;
- if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
- tokenPtr = TokenAfter(tokenPtr);
- wordIdx++;
- if (wordIdx >= numWords) {
- code = TCL_ERROR;
- goto done;
- }
- }
+int
+TclCompileDictUpdateCmd(
+ 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, dictIndex, numVars, range, infoIndex;
+ Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
+ DictUpdateInfo *duiPtr;
+ JumpFixup jumpFixup;
- if (compileScripts) {
- /*
- * Compile the else command body.
- */
+ /*
+ * There must be at least one argument after the command.
+ */
- CompileBody(envPtr, tokenPtr, interp);
- }
+ if (parsePtr->numWords < 5) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the command. Expect the following:
+ * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
+ */
+
+ if ((parsePtr->numWords - 1) & 1) {
+ return TCL_ERROR;
+ }
+ numVars = (parsePtr->numWords - 3) / 2;
+
+ /*
+ * 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.
+ */
+
+ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
+ if (dictIndex < 0) {
+ goto issueFallback;
+ }
+
+ /*
+ * Assemble the instruction metadata. This is complex enough that it is
+ * represented as auxData; it holds an ordered list of variable indices
+ * that are to be used.
+ */
+ duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+ duiPtr->length = numVars;
+ keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
+ tokenPtr = TokenAfter(dictVarTokenPtr);
+
+ for (i=0 ; i<numVars ; i++) {
/*
- * Make sure there are no words after the else clause.
+ * Put keys to one side for later compilation to bytecode.
*/
- wordIdx++;
- if (wordIdx < numWords) {
- code = TCL_ERROR;
- goto done;
- }
- } else {
+ keyTokenPtrs[i] = tokenPtr;
+ tokenPtr = TokenAfter(tokenPtr);
+
/*
- * No else clause: the "if" command's result is an empty string.
+ * Stash the index in the auxiliary data (if it is indeed a local
+ * scalar that is resolvable at compile-time).
*/
- if (compileScripts) {
- PushLiteral(envPtr, "", 0);
+ duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr);
+ if (duiPtr->varIndices[i] < 0) {
+ goto failedUpdateInfoAssembly;
}
+ tokenPtr = TokenAfter(tokenPtr);
}
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ goto failedUpdateInfoAssembly;
+ }
+ bodyTokenPtr = tokenPtr;
/*
- * Fix the unconditional jumps to the end of the "if" command.
+ * The list of variables to bind is stored in auxiliary data so that it
+ * can't be snagged by literal sharing and forced to shimmer dangerously.
*/
- for (j = jumpEndFixupArray.next; j > 0; j--) {
- jumpIndex = (j - 1); /* i.e. process the closest jump first */
- if (TclFixupForwardJumpToHere(envPtr,
- jumpEndFixupArray.fixup+jumpIndex, 127)) {
- /*
- * Adjust the immediately preceeding "ifFalse" jump. We moved it's
- * target (just after this jump) down three bytes.
- */
+ infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
- unsigned char *ifFalsePc = envPtr->codeStart
- + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
- unsigned char opCode = *ifFalsePc;
- if (opCode == INST_JUMP_FALSE1) {
- jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
- jumpFalseDist += 3;
- TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
- } else if (opCode == INST_JUMP_FALSE4) {
- jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
- jumpFalseDist += 3;
- TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
- } else {
- Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
- }
- }
+ for (i=0 ; i<numVars ; i++) {
+ CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
}
+ TclEmitInstInt4( INST_LIST, numVars, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
- /*
- * Free the jumpFixupArray array if malloc'ed storage was used.
- */
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
- done:
- envPtr->currStackDepth = savedStackDepth + 1;
- TclFreeJumpFixupArray(&jumpFalseFixupArray);
- TclFreeJumpFixupArray(&jumpEndFixupArray);
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIncrCmd --
- *
- * Procedure called to compile the "incr" 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 "incr" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
+ ExceptionRangeStarts(envPtr, range);
+ BODY(bodyTokenPtr, parsePtr->numWords - 1);
+ ExceptionRangeEnds(envPtr, range);
-int
-TclCompileIncrCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Tcl_Token *varTokenPtr, *incrTokenPtr;
- int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
+ /*
+ * Normal termination code: the stack has the key list below the result of
+ * the body evaluation: swap them and finish the update code.
+ */
- if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
- return TCL_ERROR;
- }
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ /*
+ * Jump around the exceptional termination code.
+ */
- PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
/*
- * If an increment is given, push it, but see first if it's a small
- * integer.
+ * Termination code for non-ok returns: stash the result and return
+ * options in the stack, bring up the key list, finish the update code,
+ * and finally return with the catched return data
*/
- haveImmValue = 0;
- immValue = 1;
- if (parsePtr->numWords == 3) {
- incrTokenPtr = TokenAfter(varTokenPtr);
- if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- CONST char *word = incrTokenPtr[1].start;
- int numBytes = incrTokenPtr[1].size;
+ 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);
- /*
- * Note there is a danger that modifying the string could have
- * undesirable side effects. In this case, TclLooksLikeInt has
- * no dependencies on shared strings so we should be safe.
- */
+ TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
+ TclEmitInvoke(envPtr,INST_RETURN_STK);
- if (TclLooksLikeInt(word, numBytes)) {
- int code;
- Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
- Tcl_IncrRefCount(intObj);
- code = Tcl_GetIntFromObj(NULL, intObj, &immValue);
- Tcl_DecrRefCount(intObj);
- if ((code == TCL_OK)
- && (-127 <= immValue) && (immValue <= 127)) {
- haveImmValue = 1;
- }
- }
- if (!haveImmValue) {
- PushLiteral(envPtr, word, numBytes);
- }
- } else {
- TclCompileTokens(interp, incrTokenPtr+1,
- incrTokenPtr->numComponents, envPtr);
- }
- } else { /* no incr amount given so use 1 */
- haveImmValue = 1;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+ (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
+ TclStackFree(interp, keyTokenPtrs);
+ return TCL_OK;
/*
- * Emit the instruction to increment the variable.
+ * Clean up after a failure to create the DictUpdateInfo structure.
*/
- 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);
- }
- } else {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
- }
- }
- } else {
- if (localIndex >= 0) {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
- TclEmitInt1(immValue, envPtr);
- } else {
- TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
- }
- } else {
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
- }
- }
- }
- } else { /* non-simple variable name */
- if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_STK, envPtr);
- }
- }
-
- return TCL_OK;
+ failedUpdateInfoAssembly:
+ ckfree(duiPtr);
+ TclStackFree(interp, keyTokenPtrs);
+ issueFallback:
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLappendCmd --
- *
- * Procedure called to compile the "lappend" 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 "lappend" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
int
-TclCompileLappendCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileDictAppendCmd(
+ 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 *varTokenPtr;
- int simpleVarName, isScalar, localIndex, numWords;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr;
+ int i, dictVarIndex;
/*
- * If we're not in a procedure, don't compile.
+ * There must be at least two argument after the command. And we impose an
+ * (arbirary) safe limit; anyone exceeding it should stop worrying about
+ * speed quite so much. ;-)
*/
- if (envPtr->procPtr == NULL) {
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords<4 || parsePtr->numWords>100) {
return TCL_ERROR;
}
- numWords = parsePtr->numWords;
- if (numWords == 1) {
- return TCL_ERROR;
+ /*
+ * Get the index of the local variable that we will be working with.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
+ if (dictVarIndex < 0) {
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
}
- if (numWords != 3) {
- /*
- * LAPPEND instructions currently only handle one value appends
- */
- return TCL_ERROR;
+
+ /*
+ * Produce the string to concatenate onto the dictionary entry.
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ for (i=2 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ if (parsePtr->numWords > 4) {
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
- * Decide if we can use a frame slot for the var/array name or if we
- * need to emit code to compute and push the name at runtime. We use a
- * frame slot (entry in the array of local vars) if we are compiling a
- * procedure body and if the name is simple text that does not include
- * namespace qualifiers.
+ * Do the concatenation.
*/
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr);
+ return TCL_OK;
+}
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
+int
+TclCompileDictLappendCmd(
+ 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 *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
+ int dictVarIndex;
/*
- * If we are doing an assignment, push the new value. In the no values
- * case, create an empty object.
+ * There must be three arguments after the command.
*/
- if (numWords > 2) {
- Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, valueTokenPtr, interp);
+ /* TODO: Consider support for compiling expanded args. */
+ /* Probably not. Why is INST_DICT_LAPPEND limited to one value? */
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
}
/*
- * Emit instructions to set/get the variable.
+ * Parse the arguments.
*/
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ keyTokenPtr = TokenAfter(varTokenPtr);
+ valueTokenPtr = TokenAfter(keyTokenPtr);
+ dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (dictVarIndex < 0) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
/*
- * The *_STK opcodes should be refactored to make better use of existing
- * LOAD/STORE instructions.
+ * Issue the implementation.
*/
- 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);
- }
- } 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);
- }
- }
- } else {
- TclEmitOpcode(INST_LAPPEND_STK, envPtr);
- }
+ CompileWord(envPtr, keyTokenPtr, interp, 2);
+ CompileWord(envPtr, valueTokenPtr, interp, 3);
+ TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLassignCmd --
- *
- * Procedure called to compile the "lassign" 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 "lassign" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
int
-TclCompileLassignCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+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. */
{
- Tcl_Token *tokenPtr;
- int simpleVarName, isScalar, localIndex, numWords, idx;
+ DefineLineInformation; /* TIP #280 */
+ int i, range, varNameTmp = -1, pathTmp = -1, keysTmp, gotPath;
+ int dictVar, bodyIsEmpty = 1;
+ Tcl_Token *varTokenPtr, *tokenPtr;
+ JumpFixup jumpFixup;
+ const char *ptr, *end;
- numWords = parsePtr->numWords;
/*
- * Check for command syntax error, but we'll punt that to runtime
+ * There must be at least one argument after the command.
*/
- if (numWords < 3) {
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
/*
- * Generate code to push list being taken apart by [lassign].
+ * Parse the command (trivially). Expect the following:
+ * dict with <any (varName)> ?<any> ...? <literal>
*/
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- CompileWord(envPtr, tokenPtr, interp);
- /*
- * Generate code to assign values from the list to variables
- */
- for (idx=0 ; idx<numWords-2 ; idx++) {
+ 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 TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
- /*
- * Generate the next variable name
- */
- PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
+ /*
+ * 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).
+ */
- /*
- * Emit instructions to get the idx'th item out of the list value on
- * 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);
- }
- } 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);
- }
+ 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 TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr,
+ envPtr);
}
- } else {
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- TclEmitOpcode(INST_STORE_STK, envPtr);
+ bodyIsEmpty = 0;
+ break;
}
- TclEmitOpcode(INST_POP, envPtr);
}
/*
- * Generate code to leave the rest of the list on the stack.
+ * Determine if we're manipulating a dict in a simple local variable.
*/
- TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
- TclEmitInt4(-2, envPtr); /* -2 == "end" */
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLindexCmd --
- *
- * Procedure called to compile the "lindex" 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 "lindex" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
-int
-TclCompileLindexCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Tcl_Token *varTokenPtr;
- int i, numWords = parsePtr->numWords;
+ gotPath = (parsePtr->numWords > 3);
+ dictVar = LocalScalarFromToken(varTokenPtr, envPtr);
/*
- * Quit if too few args
+ * 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 (numWords <= 1) {
- return TCL_ERROR;
- }
-
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (bodyIsEmpty) {
+ if (dictVar >= 0) {
+ if (gotPath) {
+ /*
+ * Case: Path into dict in LVT with empty body.
+ */
- if ((numWords == 3) && (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
- TclLooksLikeInt(varTokenPtr[1].start, varTokenPtr[1].size)) {
- Tcl_Obj *tmpObj;
- int idx, result;
+ tokenPtr = TokenAfter(varTokenPtr);
+ for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ 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);
+ } else {
+ /*
+ * Case: Direct dict in LVT with empty body.
+ */
- tmpObj = Tcl_NewStringObj(varTokenPtr[1].start, varTokenPtr[1].size);
- result = Tcl_GetIntFromObj(NULL, tmpObj, &idx);
- TclDecrRefCount(tmpObj);
+ PushStringLiteral(envPtr, "");
+ Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr);
+ PushStringLiteral(envPtr, "");
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
+ } else {
+ if (gotPath) {
+ /*
+ * Case: Path into dict in non-simple var with empty body.
+ */
- if (result == TCL_OK && idx >= 0) {
- /*
- * All checks have been completed, and we have exactly this
- * construct:
- * lindex <posInt> <arbitraryValue>
- * This is best compiled as a push of the arbitrary value followed
- * by an "immediate lindex" which is the most efficient variety.
- */
+ tokenPtr = varTokenPtr;
+ for (i=1 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ 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);
+ } else {
+ /*
+ * Case: Direct dict in non-simple var with empty body.
+ */
- varTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, varTokenPtr, interp);
- TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
- return TCL_OK;
+ CompileWord(envPtr, varTokenPtr, interp, 1);
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ PushStringLiteral(envPtr, "");
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ PushStringLiteral(envPtr, "");
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ }
}
-
- /*
- * If the conversion failed or the value was negative, we just keep on
- * going with the more complex compilation.
- */
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
}
/*
- * Push the operands onto the stack.
+ * 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.
*/
- for (i=1 ; i<numWords ; i++) {
- CompileWord(envPtr, varTokenPtr, interp);
- varTokenPtr = TokenAfter(varTokenPtr);
+ if (dictVar == -1) {
+ varNameTmp = AnonymousLocal(envPtr);
}
+ if (gotPath) {
+ pathTmp = AnonymousLocal(envPtr);
+ }
+ keysTmp = AnonymousLocal(envPtr);
/*
- * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
- * multiple index args.
+ * Issue instructions. First, the part to expand the dictionary.
*/
- if (numWords == 3) {
- TclEmitOpcode(INST_LIST_INDEX, envPtr);
+ if (dictVar == -1) {
+ CompileWord(envPtr, varTokenPtr, interp, 1);
+ Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr);
+ }
+ tokenPtr = TokenAfter(varTokenPtr);
+ if (gotPath) {
+ for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ 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 {
- TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
+ PushStringLiteral(envPtr, "");
}
+ TclEmitOpcode( INST_DICT_EXPAND, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileListCmd --
- *
- * Procedure called to compile the "list" 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 "list" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Now the body of the [dict with].
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
+
+ ExceptionRangeStarts(envPtr, range);
+ BODY(tokenPtr, parsePtr->numWords - 1);
+ ExceptionRangeEnds(envPtr, range);
-int
-TclCompileListCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
/*
- * If we're not in a procedure, don't compile.
+ * Now fold the results back into the dictionary in the OK case.
*/
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
+
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ if (dictVar == -1) {
+ Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr);
}
+ if (gotPath) {
+ Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr);
+ } else {
+ PushStringLiteral(envPtr, "");
+ }
+ 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);
- if (parsePtr->numWords == 1) {
- /*
- * [list] without arguments just pushes an empty object.
- */
+ /*
+ * Now fold the results back into the dictionary in the exception case.
+ */
- PushLiteral(envPtr, "", 0);
+ TclAdjustStackDepth(-1, envPtr);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ if (dictVar == -1) {
+ Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr);
+ }
+ if (parsePtr->numWords > 3) {
+ Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr);
} else {
- /*
- * Push the all values onto the stack.
- */
- Tcl_Token *valueTokenPtr;
- int i, numWords;
+ PushStringLiteral(envPtr, "");
+ }
+ Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
- numWords = parsePtr->numWords;
+ /*
+ * Prepare for the start of the next command.
+ */
- valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i = 1; i < numWords; i++) {
- CompileWord(envPtr, valueTokenPtr, interp);
- valueTokenPtr = TokenAfter(valueTokenPtr);
- }
- TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
+ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+ (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
-
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileLlengthCmd --
+ * DupDictUpdateInfo, FreeDictUpdateInfo --
*
- * Procedure called to compile the "llength" command.
+ * Functions to duplicate, release and print the aux data created for use
+ * with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * DupDictUpdateInfo: a copy of the auxiliary data
+ * FreeDictUpdateInfo: none
+ * PrintDictUpdateInfo: none
*
* Side effects:
- * Instructions are added to envPtr to execute the "llength" command at
- * runtime.
+ * DupDictUpdateInfo: allocates memory
+ * FreeDictUpdateInfo: releases memory
+ * PrintDictUpdateInfo: none
*
*----------------------------------------------------------------------
*/
-int
-TclCompileLlengthCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+static ClientData
+DupDictUpdateInfo(
+ ClientData clientData)
{
- Tcl_Token *varTokenPtr;
+ DictUpdateInfo *dui1Ptr, *dui2Ptr;
+ unsigned len;
+
+ dui1Ptr = clientData;
+ len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
+ dui2Ptr = ckalloc(len);
+ memcpy(dui2Ptr, dui1Ptr, len);
+ return dui2Ptr;
+}
- if (parsePtr->numWords != 2) {
- return TCL_ERROR;
- }
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+static void
+FreeDictUpdateInfo(
+ ClientData clientData)
+{
+ ckfree(clientData);
+}
- CompileWord(envPtr, varTokenPtr, interp);
- TclEmitOpcode(INST_LIST_LENGTH, envPtr);
- return TCL_OK;
+static void
+PrintDictUpdateInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ DictUpdateInfo *duiPtr = clientData;
+ int i;
+
+ for (i=0 ; i<duiPtr->length ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ", ", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
+ }
}
/*
*----------------------------------------------------------------------
*
- * TclCompileLsetCmd --
+ * TclCompileErrorCmd --
*
- * Procedure called to compile the "lset" command.
+ * Procedure called to compile the "error" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "lset" command at
+ * Instructions are added to envPtr to execute the "error" command at
* runtime.
*
- * The general template for execution of the "lset" command is:
- * (1) Instructions to push the variable name, unless the variable is
- * local to the stack frame.
- * (2) If the variable is an array element, instructions to push the
- * array element name.
- * (3) Instructions to push each of zero or more "index" arguments to the
- * stack, followed with the "newValue" element.
- * (4) Instructions to duplicate the variable name and/or array element
- * name onto the top of the stack, if either was pushed at steps (1)
- * and (2).
- * (5) The appropriate INST_LOAD_* instruction to place the original
- * value of the list variable at top of stack.
- * (6) At this point, the stack contains:
- * varName? arrayElementName? index1 index2 ... newValue oldList
- * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
- * according as whether there is exactly one index element (LIST) or
- * either zero or else two or more (FLAT). This instruction removes
- * everything from the stack except for the two names and pushes the
- * new value of the variable.
- * (7) Finally, INST_STORE_* stores the new value in the variable and
- * cleans up the stack.
- *
*----------------------------------------------------------------------
*/
int
-TclCompileLsetCmd(interp, parsePtr, envPtr)
- Tcl_Interp* interp; /* Tcl interpreter for error reporting */
- Tcl_Parse* parsePtr; /* Points to a parse structure for the
- * command */
- CompileEnv* envPtr; /* Holds the resulting instructions */
+TclCompileErrorCmd(
+ Tcl_Interp *interp, /* Used for context. */
+ 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 tempDepth; /* Depth used for emitting one part of the
- * code burst. */
- Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing the
- * parse of the variable name */
- int localIndex; /* Index of var in local var table */
- int simpleVarName; /* Flag == 1 if var name is simple */
- int isScalar; /* Flag == 1 if scalar, 0 if array */
- int i;
-
- /* Check argument count */
-
- if (parsePtr->numWords < 3) {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
-
/*
- * Decide if we can use a frame slot for the var/array name or if we need
- * to emit code to compute and push the name at runtime. We use a frame
- * slot (entry in the array of local vars) if we are compiling a procedure
- * body and if the name is simple text that does not include namespace
- * qualifiers.
+ * General syntax: [error message ?errorInfo? ?errorCode?]
*/
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
-
- /*
- * Push the "index" args and the new element value.
- */
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
- for (i=2 ; i<parsePtr->numWords ; ++i) {
- varTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, varTokenPtr, interp);
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
+ return TCL_ERROR;
}
/*
- * Duplicate the variable name if it's been pushed.
+ * Handle the message.
*/
- if (!simpleVarName || localIndex < 0) {
- if (!simpleVarName || isScalar) {
- tempDepth = parsePtr->numWords - 2;
- } else {
- tempDepth = parsePtr->numWords - 1;
- }
- TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
- }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
/*
- * Duplicate an array index if one's been pushed
+ * Construct the options. Note that -code and -level are not here.
*/
- if (simpleVarName && !isScalar) {
- if (localIndex < 0) {
- tempDepth = parsePtr->numWords - 1;
+ if (parsePtr->numWords == 2) {
+ PushStringLiteral(envPtr, "");
+ } else {
+ PushStringLiteral(envPtr, "-errorinfo");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST, 2, envPtr);
} else {
- tempDepth = parsePtr->numWords - 2;
+ PushStringLiteral(envPtr, "-errorcode");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
}
- TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
}
/*
- * Emit code to load the variable's value.
+ * Issue the error via 'returnImm error 0'.
*/
- if (!simpleVarName) {
- 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);
- } else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
- }
- } else {
- if (localIndex < 0) {
- TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
- }
- }
+ TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExprCmd --
+ *
+ * Procedure called to compile the "expr" 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 "expr" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Emit the correct variety of 'lset' instruction
- */
+int
+TclCompileExprCmd(
+ 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 *firstWordPtr;
- if (parsePtr->numWords == 4) {
- TclEmitOpcode(INST_LSET_LIST, envPtr);
- } else {
- TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+ if (parsePtr->numWords == 1) {
+ return TCL_ERROR;
}
/*
- * Emit code to put the value back in the variable
+ * TIP #280: Use the per-word line information of the current command.
*/
- if (!simpleVarName) {
- 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);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
- }
- } else {
- if (localIndex < 0) {
- TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
- } else if (localIndex < 0x100) {
- TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
- }
- }
+ envPtr->line = envPtr->extCmdMapPtr->loc[
+ envPtr->extCmdMapPtr->nuloc-1].line[1];
+ firstWordPtr = TokenAfter(parsePtr->tokenPtr);
+ TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileRegexpCmd --
+ * TclCompileForCmd --
*
- * Procedure called to compile the "regexp" command.
+ * Procedure called to compile the "for" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "regexp" command at
+ * Instructions are added to envPtr to execute the "for" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileRegexpCmd(interp, parsePtr, envPtr)
- Tcl_Interp* interp; /* Tcl interpreter for error reporting */
- Tcl_Parse* parsePtr; /* Points to a parse structure for the
- * command */
- CompileEnv* envPtr; /* Holds the resulting instructions */
+TclCompileForCmd(
+ 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 *varTokenPtr; /* Pointer to the Tcl_Token representing the
- * parse of the RE or string */
- int i, len, nocase, anchorLeft, anchorRight, start;
- char *str;
+ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
+ JumpFixup jumpEvalCondFixup;
+ int bodyCodeOffset, nextCodeOffset, jumpDist;
+ int bodyRange, nextRange;
+ DefineLineInformation; /* TIP #280 */
- /*
- * We are only interested in compiling simple regexp cases. Currently
- * supported compile cases are:
- * regexp ?-nocase? ?--? staticString $var
- * regexp ?-nocase? ?--? {^staticString$} $var
- */
- if (parsePtr->numWords < 3) {
+ if (parsePtr->numWords != 5) {
return TCL_ERROR;
}
- nocase = 0;
- varTokenPtr = parsePtr->tokenPtr;
-
/*
- * We only look for -nocase and -- as options. Everything else gets
- * pushed to runtime execution. This is different than regexp's runtime
- * option handling, but satisfies our stricter needs.
+ * If the test expression requires substitutions, don't compile the for
+ * command inline. E.g., the expression might cause the loop to never
+ * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
*/
- for (i = 1; i < parsePtr->numWords - 2; i++) {
- varTokenPtr = TokenAfter(varTokenPtr);
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- /* Not a simple string - punt to runtime. */
- return TCL_ERROR;
- }
- str = (char *) varTokenPtr[1].start;
- len = varTokenPtr[1].size;
- if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
- i++;
- break;
- } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
- nocase = 1;
- } else {
- /* Not an option we recognize. */
- return TCL_ERROR;
- }
- }
- if ((parsePtr->numWords - i) != 2) {
- /* We don't support capturing to variables */
+ startTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ testTokenPtr = TokenAfter(startTokenPtr);
+ if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
/*
- * Get the regexp string. If it is not a simple string, punt to runtime.
- * If it has a '-', it could be an incorrectly formed regexp command.
+ * Bail out also if the body or the next expression require substitutions
+ * in order to insure correct behaviour [Bug 219166]
*/
- varTokenPtr = TokenAfter(varTokenPtr);
- str = (char *) varTokenPtr[1].start;
- len = varTokenPtr[1].size;
- if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
- return TCL_ERROR;
- }
- if (len == 0) {
- /*
- * The semantics of regexp are always match on re == "".
- */
- PushLiteral(envPtr, "1", 1);
- return TCL_OK;
+ nextTokenPtr = TokenAfter(testTokenPtr);
+ bodyTokenPtr = TokenAfter(nextTokenPtr);
+ if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+ || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+ return TCL_ERROR;
}
/*
- * Make a copy of the string that is null-terminated for checks which
- * require such.
- */
- str = (char *) ckalloc((unsigned) len + 1);
- strncpy(str, varTokenPtr[1].start, (size_t) len);
- str[len] = '\0';
- start = 0;
-
- /*
- * 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.
+ * Inline compile the initial command.
*/
- if (str[0] == '^') {
- start++;
- anchorLeft = 1;
- } else {
- anchorLeft = 0;
- }
- if ((str[len-1] == '$') && ((len == 1) || (str[len-2] != '\\'))) {
- anchorRight = 1;
- str[--len] = '\0';
- } else {
- anchorRight = 0;
- }
- /*
- * On the first (pattern) arg, check to see if any RE special characters
- * are in the word. If not, this is the same as 'string equal'.
- */
- if ((len > 1+start) && (str[start] == '.') && (str[start+1] == '*')) {
- start += 2;
- anchorLeft = 0;
- }
- if ((len > 2+start) && (str[len-3] != '\\')
- && (str[len-2] == '.') && (str[len-1] == '*')) {
- len -= 2;
- str[len] = '\0';
- anchorRight = 0;
- }
+ BODY(startTokenPtr, 1);
+ TclEmitOpcode(INST_POP, envPtr);
/*
- * Don't do anything with REs with other special chars. Also check if this
- * is a bad RE (do this at the end because it can be expensive). If so,
- * let it complain at runtime.
+ * Jump to the evaluation of the condition. This code uses the "loop
+ * rotation" optimisation (which eliminates one branch from the loop).
+ * "for start cond next body" produces then:
+ * start
+ * goto A
+ * B: body : bodyCodeOffset
+ * next : nextCodeOffset, continueOffset
+ * A: cond -> result : testCodeOffset
+ * if (result) goto B
*/
- if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL)
- || (Tcl_RegExpCompile(NULL, str) == NULL)) {
- ckfree((char *) str);
- return TCL_ERROR;
- }
-
- if (anchorLeft && anchorRight) {
- PushLiteral(envPtr, str+start, len-start);
- } else {
- /*
- * This needs to find the substring anywhere in the string, so use
- * [string match] and *foo*, with appropriate anchoring.
- */
- char *newStr = ckalloc((unsigned) len + 3);
- len -= start;
- if (anchorLeft) {
- strncpy(newStr, str + start, (size_t) len);
- } else {
- newStr[0] = '*';
- strncpy(newStr + 1, str + start, (size_t) len++);
- }
- if (!anchorRight) {
- newStr[len++] = '*';
- }
- newStr[len] = '\0';
- PushLiteral(envPtr, newStr, len);
- ckfree((char *) newStr);
- }
- ckfree((char *) str);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
/*
- * Push the string arg
+ * Compile the loop body.
*/
- varTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, varTokenPtr, interp);
-
- if (anchorLeft && anchorRight && !nocase) {
- TclEmitOpcode(INST_STR_EQ, envPtr);
- } else {
- TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
- }
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileReturnCmd --
- *
- * Procedure called to compile the "return" 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 "return" command at
- * runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileReturnCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the
- * command created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- /*
- * General syntax: [return ?-option value ...? ?result?]
- * An even number of words means an explicit result argument is present.
- */
- int level, code, status = TCL_OK;
- int numWords = parsePtr->numWords;
- int explicitResult = (0 == (numWords % 2));
- int numOptionWords = numWords - 1 - explicitResult;
- Tcl_Obj *returnOpts;
- Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
-#define NUM_STATIC_OBJS 20
- int objc;
- Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
-
- /*
- * Check for special case which can always be compiled:
- * return -options <opts> <msg>
- * Unlike the normal [return] compilation, this version does everything at
- * runtime so it can handle arbitrary words and not just literals. Note
- * that if INST_RETURN_STK wasn't already needed for something else
- * ('finally' clause processing) this piece of code would not be present.
- */
-
- if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
- && (wordTokenPtr[1].size == 8)
- && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
- Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
- Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);
-
- CompileWord(envPtr, optsTokenPtr, interp);
- CompileWord(envPtr, msgTokenPtr, interp);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
- return TCL_OK;
- }
+ bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
+ BODY(bodyTokenPtr, 4);
+ ExceptionRangeEnds(envPtr, bodyRange);
+ TclEmitOpcode(INST_POP, envPtr);
/*
- * Allocate some working space if needed
+ * Compile the "next" subcommand. Note that this exception range will not
+ * have a continueOffset (other than -1) connected to it; it won't trap
+ * TCL_CONTINUE but rather just TCL_BREAK.
*/
- if (numOptionWords > NUM_STATIC_OBJS) {
- objv = (Tcl_Obj **) ckalloc(numOptionWords * sizeof(Tcl_Obj *));
- } else {
- objv = staticObjArray;
- }
+ nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
+ nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
+ BODY(nextTokenPtr, 3);
+ ExceptionRangeEnds(envPtr, nextRange);
+ TclEmitOpcode(INST_POP, envPtr);
/*
- * Scan through the return options. If any are unknown at compile time,
- * there is no value in bytecompiling. Save the option values known in an
- * objv array for merging into a return options dictionary.
+ * Compile the test expression then emit the conditional jump that
+ * terminates the for.
*/
- for (objc = 0; objc < numOptionWords; objc++) {
- objv[objc] = Tcl_NewObj();
- Tcl_IncrRefCount(objv[objc]);
- if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
- objc++;
- status = TCL_ERROR;
- goto cleanup;
- }
- wordTokenPtr = TokenAfter(wordTokenPtr);
- }
- status = TclMergeReturnOptions(interp, objc, objv,
- &returnOpts, &code, &level);
- cleanup:
- while (--objc >= 0) {
- Tcl_DecrRefCount(objv[objc]);
- }
- if (numOptionWords > NUM_STATIC_OBJS) {
- ckfree((char *)objv);
- }
- if (TCL_ERROR == status) {
- /*
- * Something was bogus in the return options. Clear the error message,
- * and report back to the compiler that this must be interpreted at
- * runtime.
- */
- Tcl_ResetResult(interp);
- return TCL_ERROR;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
+ bodyCodeOffset += 3;
+ nextCodeOffset += 3;
}
- /*
- * All options are known at compile time, so we're going to bytecompile.
- * Emit instructions to push the result on the stack
- */
+ SetLineInformation(2);
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
- if (explicitResult) {
- CompileWord(envPtr, wordTokenPtr, interp);
+ jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
- /*
- * No explict result argument, so default result is empty string.
- */
- PushLiteral(envPtr, "", 0);
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
/*
- * Check for optimization: When [return] is in a proc, and there's no
- * enclosing [catch], and there are no return options, then the INST_DONE
- * instruction is equivalent, and may be more efficient.
+ * Fix the starting points of the exception ranges (may have moved due to
+ * jump type modification) and set where the exceptions target.
*/
- if (numOptionWords == 0 && envPtr->procPtr != NULL) {
- /*
- * We have default return options and we're in a proc ...
- */
- int index = envPtr->exceptArrayNext - 1;
- int enclosingCatch = 0;
- while (index >= 0) {
- ExceptionRange range = envPtr->exceptArrayPtr[index];
- if ((range.type == CATCH_EXCEPTION_RANGE)
- && (range.catchOffset == -1)) {
- enclosingCatch = 1;
- break;
- }
- index--;
- }
- if (!enclosingCatch) {
- /*
- * ... and there is no enclosing catch. Issue the maximally
- * efficient exit instruction.
- */
- Tcl_DecrRefCount(returnOpts);
- TclEmitOpcode(INST_DONE, envPtr);
- return TCL_OK;
- }
- }
+ envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
+ envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
+
+ envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
+
+ ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
+ ExceptionRangeTarget(envPtr, nextRange, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, bodyRange);
+ TclFinalizeLoopExceptionRange(envPtr, nextRange);
/*
- * Could not use the optimization, so we push the return options dict, and
- * emit the INST_RETURN_IMM instruction with code and level as operands.
+ * The for command's result is an empty string.
*/
- TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, code, envPtr);
- TclEmitInt4(level, envPtr);
+ PushStringLiteral(envPtr, "");
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileSetCmd --
+ * TclCompileForeachCmd --
*
- * Procedure called to compile the "set" command.
+ * Procedure called to compile the "foreach" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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 "set" command at
+ * Instructions are added to envPtr to execute the "foreach" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileSetCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+TclCompileForeachCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *varTokenPtr, *valueTokenPtr;
- int isAssignment, isScalar, simpleVarName, localIndex, numWords;
-
- numWords = parsePtr->numWords;
- if ((numWords != 2) && (numWords != 3)) {
- return TCL_ERROR;
- }
- isAssignment = (numWords == 3);
-
- /*
- * Decide if we can use a frame slot for the var/array name or if we need
- * to emit code to compute and push the name at runtime. We use a frame
- * slot (entry in the array of local vars) if we are compiling a procedure
- * body and if the name is simple text that does not include namespace
- * qualifiers.
- */
-
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar);
-
- /*
- * If we are doing an assignment, push the new value.
- */
-
- if (isAssignment) {
- valueTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, valueTokenPtr, interp);
- }
-
- /*
- * Emit instructions to set/get the variable.
- */
-
- if (simpleVarName) {
- if (isScalar) {
- if (localIndex < 0) {
- TclEmitOpcode((isAssignment?
- INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1((isAssignment?
- INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
- localIndex, envPtr);
- } else {
- TclEmitInstInt4((isAssignment?
- INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
- localIndex, envPtr);
- }
- } else {
- if (localIndex < 0) {
- TclEmitOpcode((isAssignment?
- INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
- } else if (localIndex <= 255) {
- TclEmitInstInt1((isAssignment?
- INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
- localIndex, envPtr);
- } else {
- TclEmitInstInt4((isAssignment?
- INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
- localIndex, envPtr);
- }
- }
- } else {
- TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
- }
-
- return TCL_OK;
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
}
/*
*----------------------------------------------------------------------
*
- * TclCompileStringCmd --
+ * TclCompileLmapCmd --
*
- * Procedure called to compile the "string" command. Generally speaking,
- * these are mostly various kinds of peephole optimizations; most string
- * operations are handled by executing the interpreted version of the
- * command.
+ * Procedure called to compile the "lmap" command.
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * 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" command at
+ * Instructions are added to envPtr to execute the "lmap" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileStringCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+TclCompileLmapCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *opTokenPtr, *varTokenPtr;
- Tcl_Obj *opObj;
- int i, index;
-
- static CONST char *options[] = {
- "bytelength", "compare", "equal", "first",
- "index", "is", "last", "length",
- "map", "match", "range", "repeat",
- "replace", "tolower", "toupper", "totitle",
- "trim", "trimleft", "trimright",
- "wordend", "wordstart", (char *) NULL
- };
- enum options {
- STR_BYTELENGTH, STR_COMPARE, STR_EQUAL, STR_FIRST,
- STR_INDEX, STR_IS, STR_LAST, STR_LENGTH,
- STR_MAP, STR_MATCH, STR_RANGE, STR_REPEAT,
- STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE,
- STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
- STR_WORDEND, STR_WORDSTART
- };
-
- if (parsePtr->numWords < 2) {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
- opTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
- opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
- if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
- &index) != TCL_OK) {
- Tcl_DecrRefCount(opObj);
- Tcl_ResetResult(interp);
- return TCL_ERROR;
- }
- Tcl_DecrRefCount(opObj);
-
- varTokenPtr = TokenAfter(opTokenPtr);
-
- switch ((enum options) index) {
- case STR_COMPARE:
- case STR_EQUAL:
- /*
- * If there are any flags to the command, we can't byte compile it
- * because the INST_STR_EQ bytecode doesn't support flags.
- */
-
- if (parsePtr->numWords != 4) {
- return TCL_ERROR;
- }
-
- /*
- * Push the two operands onto the stack.
- */
-
- for (i = 0; i < 2; i++) {
- CompileWord(envPtr, varTokenPtr, interp);
- varTokenPtr = TokenAfter(varTokenPtr);
- }
-
- TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
- INST_STR_CMP : INST_STR_EQ), envPtr);
- return TCL_OK;
-
- case STR_INDEX:
- if (parsePtr->numWords != 4) {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
-
- /*
- * Push the two operands onto the stack.
- */
-
- for (i = 0; i < 2; i++) {
- CompileWord(envPtr, varTokenPtr, interp);
- varTokenPtr = TokenAfter(varTokenPtr);
- }
-
- TclEmitOpcode(INST_STR_INDEX, envPtr);
- return TCL_OK;
- case STR_MATCH: {
- int length, exactMatch = 0, nocase = 0;
- CONST char *str;
-
- if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
-
- if (parsePtr->numWords == 5) {
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
- }
- str = varTokenPtr[1].start;
- length = varTokenPtr[1].size;
- if ((length > 1) &&
- strncmp(str, "-nocase", (size_t) length) == 0) {
- nocase = 1;
- } else {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
- varTokenPtr = TokenAfter(varTokenPtr);
- }
-
- for (i = 0; i < 2; i++) {
- if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- str = varTokenPtr[1].start;
- length = varTokenPtr[1].size;
- if (!nocase && (i == 0)) {
- /*
- * Trivial matches can be done by 'string equal'. If
- * -nocase was specified, we can't do this because
- * INST_STR_EQ has no support for nocase.
- */
- Tcl_Obj *copy = Tcl_NewStringObj(str, length);
- Tcl_IncrRefCount(copy);
- exactMatch = TclMatchIsTrivial(Tcl_GetString(copy));
- Tcl_DecrRefCount(copy);
- }
- PushLiteral(envPtr, str, length);
- } else {
- TclCompileTokens(interp, varTokenPtr+1,
- varTokenPtr->numComponents, envPtr);
- }
- varTokenPtr = TokenAfter(varTokenPtr);
- }
-
- if (exactMatch) {
- TclEmitOpcode(INST_STR_EQ, envPtr);
- } else {
- TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
- }
- return TCL_OK;
- }
- case STR_LENGTH:
- if (parsePtr->numWords != 3) {
- /* Fail at run time, not in compilation */
- return TCL_ERROR;
- }
-
- if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- /*
- * Here someone is asking for the length of a static string. Just
- * push the actual character (not byte) length.
- */
- char buf[TCL_INTEGER_SPACE];
- int len = Tcl_NumUtfChars(varTokenPtr[1].start,
- varTokenPtr[1].size);
- len = sprintf(buf, "%d", len);
- PushLiteral(envPtr, buf, len);
- return TCL_OK;
- } else {
- TclCompileTokens(interp, varTokenPtr+1,
- varTokenPtr->numComponents, envPtr);
- }
- TclEmitOpcode(INST_STR_LEN, envPtr);
- return TCL_OK;
-
- default:
- /*
- * All other cases: compile out of line.
- */
- return TCL_ERROR;
- }
-
- return TCL_OK;
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
}
/*
*----------------------------------------------------------------------
*
- * TclCompileSwitchCmd --
+ * CompileEachloopCmd --
*
- * Procedure called to compile the "switch" command.
+ * Procedure called to compile the "foreach" and "lmap" commands.
*
* Results:
- * Returns TCL_OK for successful compile, or TCL_ERROR to defer
- * evaluation to runtime (either when it is too complex to get the
- * semantics right, or when we know for sure that it is an error but need
- * the error to happen at the right time).
+ * 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 "switch" command at
+ * Instructions are added to envPtr to execute the "foreach" command at
* runtime.
*
- * FIXME:
- * Stack depths are probably not calculated correctly.
- *
*----------------------------------------------------------------------
*/
-int
-TclCompileSwitchCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+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. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int collect) /* Select collecting or accumulating mode
+ * (TCL_EACH_*) */
{
- 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} 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 foundDefault; /* Flag to indicate whether a "default" clause
- * is present. */
-
- JumpFixup *fixupArray; /* Array of forward-jump fixup records. */
- int *fixupTargetArray; /* Array of places for fixups to point at. */
- int fixupCount; /* Number of places to fix up. */
- int contFixIndex; /* Where the first of the jumps due to a group
- * of continuation bodies starts, or -1 if
- * there aren't any. */
- int contFixCount; /* Number of continuation bodies pointing to
- * the current (or next) real body. */
-
- int savedStackDepth = envPtr->currStackDepth;
- int noCase; /* Has the -nocase flag been given? */
- int foundMode = 0; /* Have we seen a mode flag yet? */
- int i;
+ Proc *procPtr = envPtr->procPtr;
+ ForeachInfo *infoPtr; /* Points to the structure describing this
+ * foreach command. Stored in a AuxData
+ * record in the ByteCode. */
+
+ Tcl_Token *tokenPtr, *bodyTokenPtr;
+ int jumpBackOffset, infoIndex, range;
+ int numWords, numLists, numVars, loopIndex, i, j, code;
+ DefineLineInformation; /* TIP #280 */
/*
- * Only handle the following versions:
- * switch -- word {pattern body ...}
- * switch -exact -- word {pattern body ...}
- * switch -glob -- word {pattern body ...}
- * switch -- word simpleWordPattern simpleWordBody ...
- * switch -exact -- word simpleWordPattern simpleWordBody ...
- * switch -glob -- word simpleWordPattern simpleWordBody ...
- * When the mode is -glob, can also handle a -nocase flag.
- *
- * First off, we don't care how the command's word was generated; we're
- * compiling it anyway! So skip it...
+ * We parse the variable list argument words and create two arrays:
+ * varcList[i] is number of variables in i-th var list.
+ * varvList[i] points to array of var names in i-th var list.
*/
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- numWords = parsePtr->numWords-1;
+ int *varcList;
+ const char ***varvList;
/*
- * Check for options. There must be at least one, --, because without that
- * there is no way to statically avoid the problems you get from strings-
- * -to-be-matched that start with a - (the interpreted code falls apart if
- * it encounters them, so we punt if we *might* encounter them as that is
- * the easiest way of emulating the behaviour).
+ * If the foreach command isn't in a procedure, don't compile it inline:
+ * the payoff is too small.
*/
- noCase = 0;
- mode = Switch_Exact;
- for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
- register unsigned size = tokenPtr[1].size;
- register CONST char *chrs = tokenPtr[1].start;
-
- /*
- * We only process literal options, and we assume that -e, -g and -n
- * are unique prefixes of -exact, -glob and -nocase respectively (true
- * at time of writing). Note that -exact and -glob may only be given
- * at most once or we bail out (error case).
- */
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
- return TCL_ERROR;
- }
-
- if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
- if (foundMode) {
- return TCL_ERROR;
- }
- mode = Switch_Exact;
- foundMode = 1;
- continue;
- } else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
- if (foundMode) {
- return TCL_ERROR;
- }
- mode = Switch_Glob;
- foundMode = 1;
- continue;
- } else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
- noCase = 1;
- continue;
- } else if ((size == 2) && !memcmp(chrs, "--", 2)) {
- break;
- }
-
- /*
- * The switch command has many flags we cannot compile at all (e.g.
- * all the RE-related ones) which we must have encountered. Either
- * that or we have run off the end. The action here is the same: punt
- * to interpreted version.
- */
-
+ if (procPtr == NULL) {
return TCL_ERROR;
}
- if (numWords < 3) {
+
+ numWords = parsePtr->numWords;
+ if ((numWords < 4) || (numWords%2 != 0)) {
return TCL_ERROR;
}
- tokenPtr = TokenAfter(tokenPtr);
- numWords--;
- if (noCase && (mode == Switch_Exact)) {
- /*
- * Can't compile this case; no opcode for case-insensitive equality!
- */
+
+ /*
+ * Bail out if the body requires substitutions in order to insure correct
+ * behaviour. [Bug 219166]
+ */
+
+ for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ bodyTokenPtr = tokenPtr;
+ if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
/*
- * The value to test against is going to always get pushed on the stack.
- * But not yet; we need to verify that the rest of the command is
- * compilable too.
+ * Allocate storage for the varcList and varvList arrays if necessary.
*/
- valueTokenPtr = tokenPtr;
- tokenPtr = TokenAfter(tokenPtr);
- numWords--;
+ numLists = (numWords - 2)/2;
+ varcList = TclStackAlloc(interp, numLists * sizeof(int));
+ memset(varcList, 0, numLists * sizeof(int));
+ varvList = (const char ***) TclStackAlloc(interp,
+ numLists * sizeof(const char **));
+ memset((char*) varvList, 0, numLists * sizeof(const char **));
/*
- * Build an array of tokens for the matcher terms and script bodies. Note
- * that in the case of the quoted bodies, this is tricky as we cannot use
- * copies of the string from the input token for the generated tokens (it
- * causes a crash during exception handling). When multiple tokens are
- * available at this point, this is pretty easy.
+ * Break up each var list and set the varcList and varvList arrays. Don't
+ * compile the foreach inline if any var name needs substitutions or isn't
+ * a scalar, or if any var list needs substitutions.
*/
- if (numWords == 1) {
- Tcl_DString bodyList;
- CONST char **argv = NULL;
- int isTokenBraced;
- CONST char *tokenStartPtr;
-
- /*
- * 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.
- */
+ loopIndex = 0;
+ for (i = 0, tokenPtr = parsePtr->tokenPtr;
+ i < numWords-1;
+ i++, tokenPtr = TokenAfter(tokenPtr)) {
+ Tcl_DString varList;
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ if (i%2 != 1) {
+ continue;
}
- 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);
- return TCL_ERROR;
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ code = TCL_ERROR;
+ goto done;
}
- 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.
+ * Lots of copying going on here. Need a ListObj wizard to show a
+ * better way.
*/
- if (numWords == 0 || numWords % 2) {
- ckfree((char *) argv);
- return TCL_ERROR;
+ Tcl_DStringInit(&varList);
+ TclDStringAppendToken(&varList, &tokenPtr[1]);
+ code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
+ &varcList[loopIndex], &varvList[loopIndex]);
+ Tcl_DStringFree(&varList);
+ if (code != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
}
-
- bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords);
- bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
+ numVars = varcList[loopIndex];
/*
- * Locate the start of the arms within the overall word.
+ * If the variable list is empty, we can enter an infinite loop when
+ * the interpreted version would not. Take care to ensure this does
+ * not happen. [Bug 1671138]
*/
- tokenStartPtr = tokenPtr[1].start;
- while (isspace(UCHAR(*tokenStartPtr))) {
- tokenStartPtr++;
- }
- if (*tokenStartPtr == '{') {
- tokenStartPtr++;
- isTokenBraced = 1;
- } else {
- isTokenBraced = 0;
+ if (numVars == 0) {
+ code = TCL_ERROR;
+ goto done;
}
- 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;
- /*
- * 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.
- */
+ for (j = 0; j < numVars; j++) {
+ const char *varName = varvList[loopIndex][j];
- if ((isTokenBraced && *(tokenStartPtr++) != '}') ||
- (tokenStartPtr < tokenPtr[1].start+tokenPtr[1].size
- && !isspace(UCHAR(*tokenStartPtr)))) {
- ckfree((char *) argv);
- ckfree((char *) bodyToken);
- ckfree((char *) bodyTokenArray);
- return TCL_ERROR;
- }
- while (isspace(UCHAR(*tokenStartPtr))) {
- tokenStartPtr++;
- if (tokenStartPtr >= tokenPtr[1].start+tokenPtr[1].size) {
- break;
- }
- }
- if (*tokenStartPtr == '{') {
- tokenStartPtr++;
- isTokenBraced = 1;
- } else {
- isTokenBraced = 0;
+ if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ code = TCL_ERROR;
+ goto done;
}
}
- ckfree((char *)argv);
+ loopIndex++;
+ }
- /*
- * 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.
- */
+ /*
+ * We will compile the foreach command.
+ */
- if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) {
- ckfree((char *) bodyToken);
- ckfree((char *) bodyTokenArray);
- return TCL_ERROR;
- }
+ code = TCL_OK;
- } else if (numWords % 2 || numWords == 0) {
- /*
- * Odd number of words (>1) available, or no words at all available.
- * Both are error cases, so punt and let the interpreted-version
- * generate the error message. Note that the second case probably
- * should get caught earlier, but it's easy to check here again anyway
- * because it'd cause a nasty crash otherwise.
- */
+ /*
+ * Create and initialize the ForeachInfo and ForeachVarList data
+ * structures describing this command. Then create a AuxData record
+ * pointing to the ForeachInfo structure.
+ */
- return TCL_ERROR;
+ infoPtr = ckalloc(sizeof(ForeachInfo)
+ + (numLists - 1) * sizeof(ForeachVarList *));
+ infoPtr->numLists = numLists;
+ for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
+ ForeachVarList *varListPtr;
- } else {
- bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
- bodyTokenArray = NULL;
- for (i=0 ; i<numWords ; i++) {
- /*
- * We only handle the very simplest case. Anything more complex is
- * a good reason to go to the interpreted case anyway due to
- * traces, etc.
- */
+ numVars = varcList[loopIndex];
+ varListPtr = ckalloc(sizeof(ForeachVarList)
+ + (numVars - 1) * sizeof(int));
+ varListPtr->numVars = numVars;
+ for (j = 0; j < numVars; j++) {
+ const char *varName = varvList[loopIndex][j];
+ int nameChars = strlen(varName);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
- tokenPtr->numComponents != 1) {
- ckfree((char *) bodyToken);
- return TCL_ERROR;
- }
- bodyToken[i] = tokenPtr+1;
- tokenPtr = TokenAfter(tokenPtr);
+ varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
+ nameChars, /*create*/ 1, envPtr);
}
+ infoPtr->varLists[loopIndex] = varListPtr;
}
+ infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
- * Fall back to interpreted if the last body is a continuation (it's
- * illegal, but this makes the error happen at the right time).
+ * Create the collecting object, unshared.
*/
-
- if (bodyToken[numWords-1]->size == 1 &&
- bodyToken[numWords-1]->start[0] == '-') {
- ckfree((char *) bodyToken);
- if (bodyTokenArray != NULL) {
- ckfree((char *) bodyTokenArray);
- }
- return TCL_ERROR;
+
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt4(INST_LIST, 0, envPtr);
}
-
+
/*
- * Now we commit to generating code; the parsing stage per se is done.
- * First, we push the value we're matching against on the stack.
+ * Evaluate each value list and leave it on stack.
*/
- TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents,
- envPtr);
+ for (i = 0, tokenPtr = parsePtr->tokenPtr;
+ i < numWords-1;
+ i++, tokenPtr = TokenAfter(tokenPtr)) {
+ if ((i%2 == 0) && (i > 0)) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ }
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+
/*
- * Generate a test for each arm.
+ * Inline compile the loop body.
*/
- contFixIndex = -1;
- contFixCount = 0;
- fixupArray = (JumpFixup *) ckalloc(sizeof(JumpFixup) * numWords);
- fixupTargetArray = (int *) ckalloc(sizeof(int) * numWords);
- memset(fixupTargetArray, 0, numWords * sizeof(int));
- fixupCount = 0;
- foundDefault = 0;
- for (i=0 ; i<numWords ; i+=2) {
- int nextArmFixupIndex = -1;
- envPtr->currStackDepth = savedStackDepth + 1;
- if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
- memcmp(bodyToken[numWords-2]->start, "default", 7)) {
- /*
- * Generate the test for the arm. This code is slightly
- * inefficient, but much simpler than the first version.
- */
-
- TclCompileTokens(interp, bodyToken[i], 1, envPtr);
- TclEmitInstInt4(INST_OVER, 1, envPtr);
- switch (mode) {
- case Switch_Exact:
- TclEmitOpcode(INST_STR_EQ, envPtr);
- break;
- case Switch_Glob:
- TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
- break;
- default:
- Tcl_Panic("unknown switch mode: %d", mode);
- }
-
- /*
- * In a fall-through case, we will jump on _true_ to the place
- * where the body starts (generated later, with guarantee of this
- * ensured earlier; the final body is never a fall-through).
- */
-
- if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
- if (contFixIndex == -1) {
- contFixIndex = fixupCount;
- contFixCount = 0;
- }
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
- fixupArray+contFixIndex+contFixCount);
- fixupCount++;
- contFixCount++;
- continue;
- }
-
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, fixupArray+fixupCount);
- nextArmFixupIndex = fixupCount;
- fixupCount++;
- } else {
- /*
- * Got a default clause; set a flag to inhibit the generation of
- * the jump after the body and the cleanup of the intermediate
- * value that we are switching against.
- *
- * Note that default clauses (which are always terminal clauses)
- * cannot be fall-through clauses as well, since the last clause
- * is never a fall-through clause (which we have already
- * verified).
- */
-
- foundDefault = 1;
- }
-
- /*
- * Generate the body for the arm. This is guaranteed not to be a
- * fall-through case, but it might have preceding fall-through cases,
- * so we must process those first.
- */
-
- if (contFixIndex != -1) {
- int j;
- for (j=0 ; j<contFixCount ; j++) {
- fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
- }
- contFixIndex = -1;
- }
-
- /*
- * Now do the actual compilation. Note that we do not use CompileBody
- * because we may have synthesized the tokens in a non-standard
- * pattern.
- */
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
- TclEmitOpcode(INST_POP, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
-
- if (!foundDefault) {
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- fixupArray+fixupCount);
- fixupCount++;
- fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
- }
- }
- ckfree((char *) bodyToken);
- if (bodyTokenArray != NULL) {
- ckfree((char *) bodyTokenArray);
+ ExceptionRangeStarts(envPtr, range);
+ BODY(bodyTokenPtr, numWords - 1);
+ ExceptionRangeEnds(envPtr, range);
+
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
+ } else {
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
- * Discard the value we are matching against unless we've had a default
- * clause (in which case it will already be gone due to the code at the
- * start of processing an arm, guaranteed) and make the result of the
- * command an empty string.
+ * Bottom of loop code: assign each loop variable and check whether
+ * to terminate the loop. Set the loop's break target.
*/
- if (!foundDefault) {
- TclEmitOpcode(INST_POP, envPtr);
- PushLiteral(envPtr, "", 0);
- }
+ ExceptionRangeTarget(envPtr, range, continueOffset);
+ TclEmitOpcode(INST_FOREACH_STEP, envPtr);
+ ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
+ TclEmitOpcode(INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-(numLists+2), envPtr);
/*
- * Do jump fixups for arms that were executed. First, fill in the jumps
- * of all jumps that don't point elsewhere to point to here.
+ * Set the jumpback distance from INST_FOREACH_STEP to the start of the
+ * body's code. Misuse loopCtTemp for storing the jump size.
*/
-
- for (i=0 ; i<fixupCount ; i++) {
- if (fixupTargetArray[i] == 0) {
- fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
- }
- }
+
+ jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
+ envPtr->exceptArrayPtr[range].codeOffset;
+ infoPtr->loopCtTemp = -jumpBackOffset;
/*
- * Now scan backwards over all the jumps (all of which are forward jumps)
- * doing each one. When we do one and there is a size changes, we must
- * scan back over all the previous ones and see if they need adjusting
- * before proceeding with further jump fixups (the interleaved nature of
- * all the jumps makes this impossible to do without nested loops).
+ * The command's result is an empty string if not collecting. If
+ * collecting, it is automatically left on stack after FOREACH_END.
*/
- for (i=fixupCount-1 ; i>=0 ; i--) {
- if (TclFixupForwardJump(envPtr, &fixupArray[i],
- fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
- int j;
- for (j=i-1 ; j>=0 ; j--) {
- if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
- fixupTargetArray[j] += 3;
- }
- }
+ if (collect != TCL_EACH_COLLECT) {
+ PushStringLiteral(envPtr, "");
+ }
+
+ done:
+ for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
+ if (varvList[loopIndex] != NULL) {
+ ckfree(varvList[loopIndex]);
}
}
- ckfree((char *) fixupArray);
- ckfree((char *) fixupTargetArray);
-
- envPtr->currStackDepth = savedStackDepth + 1;
- return TCL_OK;
+ TclStackFree(interp, (void *)varvList);
+ TclStackFree(interp, varcList);
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileVariableCmd --
+ * DupForeachInfo --
*
- * Procedure called to reserve the local variables for the "variable"
- * command. The command itself is *not* compiled.
+ * This procedure duplicates a ForeachInfo structure created as auxiliary
+ * data during the compilation of a foreach command.
*
* Results:
- * Always returns TCL_ERROR.
+ * A pointer to a newly allocated copy of the existing ForeachInfo
+ * structure is returned.
*
* Side effects:
- * Indexed local variables are added to the environment.
+ * Storage for the copied ForeachInfo record is allocated. If the
+ * original ForeachInfo structure pointed to any ForeachVarList records,
+ * these structures are also copied and pointers to them are stored in
+ * the new ForeachInfo record.
*
*----------------------------------------------------------------------
*/
-int
-TclCompileVariableCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+static ClientData
+DupForeachInfo(
+ ClientData clientData) /* The foreach command's compilation auxiliary
+ * data to duplicate. */
{
- Tcl_Token *varTokenPtr;
- int i, numWords;
- CONST char *varName, *tail;
-
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
- }
+ register ForeachInfo *srcPtr = clientData;
+ ForeachInfo *dupPtr;
+ register ForeachVarList *srcListPtr, *dupListPtr;
+ int numVars, i, j, numLists = srcPtr->numLists;
- numWords = parsePtr->numWords;
+ dupPtr = ckalloc(sizeof(ForeachInfo)
+ + numLists * sizeof(ForeachVarList *));
+ dupPtr->numLists = numLists;
+ dupPtr->firstValueTemp = srcPtr->firstValueTemp;
+ dupPtr->loopCtTemp = srcPtr->loopCtTemp;
- varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i = 1; i < numWords; i += 2) {
- /*
- * Skip non-literals.
- */
- if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- continue;
+ for (i = 0; i < numLists; i++) {
+ srcListPtr = srcPtr->varLists[i];
+ numVars = srcListPtr->numVars;
+ dupListPtr = ckalloc(sizeof(ForeachVarList)
+ + numVars * sizeof(int));
+ dupListPtr->numVars = numVars;
+ for (j = 0; j < numVars; j++) {
+ dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
}
+ dupPtr->varLists[i] = dupListPtr;
+ }
+ return dupPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeForeachInfo --
+ *
+ * Procedure to free a ForeachInfo structure created as auxiliary data
+ * during the compilation of a foreach command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage for the ForeachInfo structure pointed to by the ClientData
+ * argument is freed as is any ForeachVarList record pointed to by the
+ * ForeachInfo structure.
+ *
+ *----------------------------------------------------------------------
+ */
- varName = varTokenPtr[1].start;
- tail = varName + varTokenPtr[1].size - 1;
+static void
+FreeForeachInfo(
+ ClientData clientData) /* The foreach command's compilation auxiliary
+ * data to free. */
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *listPtr;
+ int numLists = infoPtr->numLists;
+ register int i;
- /*
- * Skip if it looks like it might be an array or an empty string.
- */
- if ((*tail == ')') || (tail < varName)) {
- continue;
- }
+ for (i = 0; i < numLists; i++) {
+ listPtr = infoPtr->varLists[i];
+ ckfree(listPtr);
+ }
+ ckfree(infoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintForeachInfo --
+ *
+ * Function to write a human-readable representation of a ForeachInfo
+ * structure to stdout for debugging.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
- tail--;
+static void
+PrintForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+
+ Tcl_AppendToObj(appendObj, "data=[", -1);
+
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ", ", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+ (unsigned) (infoPtr->firstValueTemp + i));
+ }
+ Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%u",
+ (unsigned) infoPtr->loopCtTemp);
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%u\t[",
+ (unsigned) (infoPtr->firstValueTemp + i));
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ if (j) {
+ Tcl_AppendToObj(appendObj, ", ", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+ (unsigned) varsPtr->varIndexes[j]);
}
- if ((*tail == ':') && (tail > varName)) {
- tail++;
+ Tcl_AppendToObj(appendObj, "]", -1);
+ }
+}
+
+static void
+PrintNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+
+ Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
+ infoPtr->loopCtTemp);
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendToObj(appendObj, "[", -1);
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ if (j) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+ (unsigned) varsPtr->varIndexes[j]);
}
- (void) TclFindCompiledLocal(tail, tail-varName+1,
- /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
- varTokenPtr = TokenAfter(varTokenPtr);
+ Tcl_AppendToObj(appendObj, "]", -1);
}
- return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileWhileCmd --
+ * TclCompileFormatCmd --
*
- * Procedure called to compile the "while" command.
+ * 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.
+ * 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 "while" command at
+ * Instructions are added to envPtr to execute the "format" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileWhileCmd(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+TclCompileFormatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *testTokenPtr, *bodyTokenPtr;
- JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, jumpDist;
- int range, code;
- int savedStackDepth = envPtr->currStackDepth;
- int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
- * infinite loop. */
- Tcl_Obj *boolObj;
- int boolVal;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ Tcl_Obj **objv, *formatObj, *tmpObj;
+ char *bytes, *start;
+ int i, j, len;
- if (parsePtr->numWords != 3) {
+ /*
+ * Don't handle any guaranteed-error cases.
+ */
+
+ if (parsePtr->numWords < 2) {
return TCL_ERROR;
}
/*
- * If the test expression requires substitutions, don't compile the while
- * command inline. E.g., the expression might cause the loop to never
- * execute or execute forever, as in "while "$x < 5" {}".
- *
- * Bail out also if the body expression requires substitutions in order to
- * insure correct behaviour [Bug 219166]
+ * Check if the argument words are all compile-time-known literals; that's
+ * a case we can handle by compiling to a constant.
*/
- testTokenPtr = TokenAfter(parsePtr->tokenPtr);
- bodyTokenPtr = TokenAfter(testTokenPtr);
-
- if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
- || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+ 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;
+ }
+ }
+
/*
- * Find out if the condition is a constant.
+ * Everything is a literal, so the result is constant too (or an error if
+ * the format is broken). Do the format now.
*/
- boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
- Tcl_IncrRefCount(boolObj);
- code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
- Tcl_DecrRefCount(boolObj);
- if (code == TCL_OK) {
- if (boolVal) {
- /*
- * It is an infinite loop; flag it so that we generate a more
- * efficient body.
- */
-
- loopMayEnd = 0;
- } else {
- /*
- * This is an empty loop: "while 0 {...}" or such. Compile no
- * bytecodes.
- */
-
- goto pushResult;
- }
+ 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) {
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
}
/*
- * Create a ExceptionRange record for the loop body. This is used to
- * implement break and continue.
+ * Not an error, always a constant result, so just push the result as a
+ * literal. Job done.
*/
- range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+ bytes = Tcl_GetStringFromObj(tmpObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_OK;
+ checkForStringConcatCase:
/*
- * Jump to the evaluation of the condition. This code uses the "loop
- * rotation" optimisation (which eliminates one branch from the loop).
- * "while cond body" produces then:
- * goto A
- * B: body : bodyCodeOffset
- * A: cond -> result : testCodeOffset, continueOffset
- * if (result) goto B
+ * 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.
*
- * The infinite loop "while 1 body" produces:
- * B: body : all three offsets here
- * goto B
+ * First, get the state of the system relatively sensible (cleaning up
+ * after our attempt to spot a literal).
*/
- if (loopMayEnd) {
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
- testCodeOffset = 0; /* avoid compiler warning */
- } else {
- testCodeOffset = CurrentOffset(envPtr);
+ for (; i>=0 ; i--) {
+ Tcl_DecrRefCount(objv[i]);
}
+ ckfree(objv);
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ tokenPtr = TokenAfter(tokenPtr);
+ i = 0;
/*
- * Compile the loop body.
+ * Now scan through and check for non-%s and non-%% substitutions.
*/
- bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, bodyTokenPtr, interp);
- ExceptionRangeEnds(envPtr, range);
- envPtr->currStackDepth = savedStackDepth + 1;
- TclEmitOpcode(INST_POP, envPtr);
+ 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;
+ }
+ }
/*
- * Compile the test expression then emit the conditional jump that
- * terminates the while. We already know it's a simple word.
+ * Check if the number of things to concatenate will fit in a byte.
*/
- if (loopMayEnd) {
- testCodeOffset = CurrentOffset(envPtr);
- jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
- bodyCodeOffset += 3;
- testCodeOffset += 3;
- }
- envPtr->currStackDepth = savedStackDepth;
- TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
-
- jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
- if (jumpDist > 127) {
- TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
- }
- } else {
- jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
- if (jumpDist > 127) {
- TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
- }
+ if (i+2 != parsePtr->numWords || i > 125) {
+ Tcl_DecrRefCount(formatObj);
+ return TCL_ERROR;
}
-
/*
- * Set the loop's body, continue and break offsets.
+ * 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.
*/
- envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
- envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
- ExceptionRangeTarget(envPtr, range, breakOffset);
+ 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;
+ }
+ }
/*
- * The while command's result is an empty string.
+ * Handle the case of a trailing literal.
*/
- pushResult:
- envPtr->currStackDepth = savedStackDepth;
- PushLiteral(envPtr, "", 0);
- envPtr->exceptDepth--;
+ 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_STR_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);
+ PushStringLiteral(envPtr, "");
+ TclEmitOpcode(INST_STR_EQ, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * PushVarName --
+ * TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
* necessary (append, lappend, set).
*
* Results:
- * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * evaluation to runtime.
+ * The values written to *localIndexPtr and *isScalarPtr signal to
+ * the caller what the instructions emitted by this routine will do:
+ *
+ * *isScalarPtr (*localIndexPtr < 0)
+ * 1 1 Push the varname on the stack. (Stack +1)
+ * 1 0 *localIndexPtr is the index of the compiled
+ * local for this varname. No instructions
+ * emitted. (Stack +0)
+ * 0 1 Push part1 and part2 names of array element
+ * on the stack. (Stack +2)
+ * 0 0 *localIndexPtr is the index of the compiled
+ * local for this array. Element name is pushed
+ * on the stack. (Stack +1)
*
* Side effects:
- * Instructions are added to envPtr to execute the "set" command at
- * runtime.
+ * Instructions are added to envPtr.
*
*----------------------------------------------------------------------
*/
-static int
-PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
- simpleVarNamePtr, isScalarPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Token *varTokenPtr; /* Points to a variable token. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
- int flags; /* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX */
- int *localIndexPtr; /* must not be NULL */
- int *simpleVarNamePtr; /* must not be NULL */
- int *isScalarPtr; /* must not be NULL */
+void
+TclPushVarName(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Token *varTokenPtr, /* Points to a variable token. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
+ int *localIndexPtr, /* Must not be NULL. */
+ int *isScalarPtr) /* Must not be NULL. */
{
- register CONST char *p;
- CONST char *name, *elName;
+ register const char *p;
+ const char *name, *elName;
register int i, n;
- int nameChars, elNameChars, simpleVarName, localIndex;
-
Tcl_Token *elemTokenPtr = NULL;
- int elemTokenCount = 0;
- int allocedTokens = 0;
- int removedParen = 0;
+ int nameChars, elNameChars, simpleVarName, localIndex;
+ int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;
/*
* Decide if we can use a frame slot for the var/array name or if we need
@@ -4007,6 +3186,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
*/
+
simpleVarName = 1;
name = varTokenPtr[1].start;
@@ -4031,7 +3211,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* assemble the corresponding token.
*/
- elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
+ elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
@@ -4044,9 +3224,8 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-
/*
- * Check for parentheses inside first token
+ * Check for parentheses inside first token.
*/
simpleVarName = 0;
@@ -4067,9 +3246,9 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
*/
if (varTokenPtr[n].size == 1) {
- --n;
+ n--;
} else {
- --varTokenPtr[n].size;
+ varTokenPtr[n].size--;
removedParen = n;
}
@@ -4077,7 +3256,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
- elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+ elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;
if (remainingChars) {
/*
@@ -4085,7 +3264,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* token.
*/
- elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
+ elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
@@ -4097,7 +3276,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* Copy the remaining tokens.
*/
- memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
+ memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
} else {
/*
@@ -4116,6 +3295,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
*/
int hasNsQualifiers = 0;
+
for (i = 0, p = name; i < nameChars; i++, p++) {
if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
hasNsQualifiers = 1;
@@ -4129,13 +3309,13 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* push its name and look it up at runtime.
*/
- if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
- localIndex = TclFindCompiledLocal(name, nameChars,
- /*create*/ flags & TCL_CREATE_VAR,
- /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
- envPtr->procPtr);
+ if (!hasNsQualifiers) {
+ localIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
- /* we'll push the name */
+ /*
+ * We'll push the name.
+ */
+
localIndex = -1;
}
}
@@ -4144,14 +3324,16 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
}
/*
- * Compile the element script, if any.
+ * Compile the element script, if any, and only if not inhibited. [Bug
+ * 3600328]
*/
- if (elName != NULL) {
+ if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
if (elNameChars) {
- TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
+ TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
+ envPtr);
} else {
- PushLiteral(envPtr, "", 0);
+ PushStringLiteral(envPtr, "");
}
}
} else {
@@ -4159,20 +3341,17 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
* The var name isn't simple: compile and push it.
*/
- TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents,
- envPtr);
+ CompileTokens(envPtr, varTokenPtr, interp);
}
if (removedParen) {
- ++varTokenPtr[removedParen].size;
+ varTokenPtr[removedParen].size++;
}
if (allocedTokens) {
- ckfree((char *) elemTokenPtr);
+ TclStackFree(interp, elemTokenPtr);
}
*localIndexPtr = localIndex;
- *simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
- return TCL_OK;
}
/*
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
new file mode 100644
index 0000000..b3e273f
--- /dev/null
+++ b/generic/tclCompCmdsGR.c
@@ -0,0 +1,3171 @@
+/*
+ * tclCompCmdsGR.c --
+ *
+ * This file contains compilation procedures that compile various Tcl
+ * commands (beginning with the letters 'g' through 'r') into a sequence
+ * of instructions ("bytecodes").
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2004-2013 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.
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include <assert.h>
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void CompileReturnInternal(CompileEnv *envPtr,
+ unsigned char op, int code, int level,
+ Tcl_Obj *returnOpts);
+static int IndexTailVarIfKnown(Tcl_Interp *interp,
+ Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileGlobalCmd --
+ *
+ * Procedure called to compile the "global" 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 "global" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileGlobalCmd(
+ 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 *varTokenPtr;
+ int localIndex, numWords, i;
+ DefineLineInformation; /* TIP #280 */
+
+ /* TODO: Consider support for compiling expanded args. */
+ numWords = parsePtr->numWords;
+ if (numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 'global' has no effect outside of proc bodies; handle that at runtime
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push the namespace
+ */
+
+ PushStringLiteral(envPtr, "::");
+
+ /*
+ * Loop over the variables.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+ localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+ if (localIndex < 0) {
+ return TCL_ERROR;
+ }
+
+ /* TODO: Consider what value can pass throug the
+ * IndexTailVarIfKnown() screen. Full CompileWord()
+ * likely does not apply here. Push known value instead. */
+ CompileWord(envPtr, varTokenPtr, interp, i);
+ TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
+ }
+
+ /*
+ * Pop the namespace, and set the result to empty
+ */
+
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIfCmd --
+ *
+ * Procedure called to compile the "if" 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 "if" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIfCmd(
+ 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. */
+{
+ JumpFixupArray jumpFalseFixupArray;
+ /* Used to fix the ifFalse jump after each
+ * test when its target PC is determined. */
+ JumpFixupArray jumpEndFixupArray;
+ /* Used to fix the jump after each "then" body
+ * to the end of the "if" when that PC is
+ * determined. */
+ Tcl_Token *tokenPtr, *testTokenPtr;
+ int jumpIndex = 0; /* Avoid compiler warning. */
+ int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
+ const char *word;
+ int realCond = 1; /* Set to 0 for static conditions:
+ * "if 0 {..}" */
+ int boolVal; /* Value of static condition. */
+ int compileScripts = 1;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * Only compile the "if" command if all arguments are simple words, in
+ * order to insure correct substitution [Bug 219166]
+ */
+
+ tokenPtr = parsePtr->tokenPtr;
+ wordIdx = 0;
+ numWords = parsePtr->numWords;
+
+ for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ TclInitJumpFixupArray(&jumpFalseFixupArray);
+ TclInitJumpFixupArray(&jumpEndFixupArray);
+ code = TCL_OK;
+
+ /*
+ * Each iteration of this loop compiles one "if expr ?then? body" or
+ * "elseif expr ?then? body" clause.
+ */
+
+ tokenPtr = parsePtr->tokenPtr;
+ wordIdx = 0;
+ while (wordIdx < numWords) {
+ /*
+ * Stop looping if the token isn't "if" or "elseif".
+ */
+
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((tokenPtr == parsePtr->tokenPtr)
+ || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+ tokenPtr = TokenAfter(tokenPtr);
+ wordIdx++;
+ } else {
+ break;
+ }
+ if (wordIdx >= numWords) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Compile the test expression then emit the conditional jump around
+ * the "then" part.
+ */
+
+ testTokenPtr = tokenPtr;
+
+ if (realCond) {
+ /*
+ * Find out if the condition is a constant.
+ */
+
+ Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
+ testTokenPtr[1].size);
+
+ Tcl_IncrRefCount(boolObj);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
+ TclDecrRefCount(boolObj);
+ if (code == TCL_OK) {
+ /*
+ * A static condition.
+ */
+
+ realCond = 0;
+ if (!boolVal) {
+ compileScripts = 0;
+ }
+ } else {
+ SetLineInformation(wordIdx);
+ Tcl_ResetResult(interp);
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
+ if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpFalseFixupArray);
+ }
+ jumpIndex = jumpFalseFixupArray.next;
+ jumpFalseFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+ jumpFalseFixupArray.fixup+jumpIndex);
+ }
+ code = TCL_OK;
+ }
+
+ /*
+ * Skip over the optional "then" before the then clause.
+ */
+
+ tokenPtr = TokenAfter(testTokenPtr);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
+ tokenPtr = TokenAfter(tokenPtr);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Compile the "then" command body.
+ */
+
+ if (compileScripts) {
+ BODY(tokenPtr, wordIdx);
+ }
+
+ if (realCond) {
+ /*
+ * Jump to the end of the "if" command. Both jumpFalseFixupArray
+ * and jumpEndFixupArray are indexed by "jumpIndex".
+ */
+
+ if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpEndFixupArray);
+ }
+ jumpEndFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ jumpEndFixupArray.fixup+jumpIndex);
+
+ /*
+ * Fix the target of the jumpFalse after the test. Generate a 4
+ * byte jump if the distance is > 120 bytes. This is conservative,
+ * and ensures that we won't have to replace this jump if we later
+ * also need to replace the proceeding jump to the end of the "if"
+ * with a 4 byte jump.
+ */
+
+ TclAdjustStackDepth(-1, envPtr);
+ if (TclFixupForwardJumpToHere(envPtr,
+ jumpFalseFixupArray.fixup+jumpIndex, 120)) {
+ /*
+ * Adjust the code offset for the proceeding jump to the end
+ * of the "if" command.
+ */
+
+ jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+ }
+ } else if (boolVal) {
+ /*
+ * We were processing an "if 1 {...}"; stop compiling scripts.
+ */
+
+ compileScripts = 0;
+ } else {
+ /*
+ * We were processing an "if 0 {...}"; reset so that the rest
+ * (elseif, else) is compiled correctly.
+ */
+
+ realCond = 1;
+ compileScripts = 1;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ wordIdx++;
+ }
+
+ /*
+ * Check for the optional else clause. Do not compile anything if this was
+ * an "if 1 {...}" case.
+ */
+
+ if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+ /*
+ * There is an else clause. Skip over the optional "else" word.
+ */
+
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
+ tokenPtr = TokenAfter(tokenPtr);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ if (compileScripts) {
+ /*
+ * Compile the else command body.
+ */
+
+ BODY(tokenPtr, wordIdx);
+ }
+
+ /*
+ * Make sure there are no words after the else clause.
+ */
+
+ wordIdx++;
+ if (wordIdx < numWords) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ /*
+ * No else clause: the "if" command's result is an empty string.
+ */
+
+ if (compileScripts) {
+ PushStringLiteral(envPtr, "");
+ }
+ }
+
+ /*
+ * Fix the unconditional jumps to the end of the "if" command.
+ */
+
+ for (j = jumpEndFixupArray.next; j > 0; j--) {
+ jumpIndex = (j - 1); /* i.e. process the closest jump first. */
+ if (TclFixupForwardJumpToHere(envPtr,
+ jumpEndFixupArray.fixup+jumpIndex, 127)) {
+ /*
+ * Adjust the immediately preceeding "ifFalse" jump. We moved it's
+ * target (just after this jump) down three bytes.
+ */
+
+ unsigned char *ifFalsePc = envPtr->codeStart
+ + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+ unsigned char opCode = *ifFalsePc;
+
+ if (opCode == INST_JUMP_FALSE1) {
+ jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
+ jumpFalseDist += 3;
+ TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+ } else if (opCode == INST_JUMP_FALSE4) {
+ jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+ jumpFalseDist += 3;
+ TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
+ } else {
+ Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
+ }
+ }
+ }
+
+ /*
+ * Free the jumpFixupArray array if malloc'ed storage was used.
+ */
+
+ done:
+ TclFreeJumpFixupArray(&jumpFalseFixupArray);
+ TclFreeJumpFixupArray(&jumpEndFixupArray);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIncrCmd --
+ *
+ * Procedure called to compile the "incr" 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 "incr" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIncrCmd(
+ 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 *varTokenPtr, *incrTokenPtr;
+ int isScalar, localIndex, haveImmValue, immValue;
+ DefineLineInformation; /* TIP #280 */
+
+ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+ return TCL_ERROR;
+ }
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+ &localIndex, &isScalar, 1);
+
+ /*
+ * If an increment is given, push it, but see first if it's a small
+ * integer.
+ */
+
+ haveImmValue = 0;
+ immValue = 1;
+ if (parsePtr->numWords == 3) {
+ incrTokenPtr = TokenAfter(varTokenPtr);
+ if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ const char *word = incrTokenPtr[1].start;
+ int numBytes = incrTokenPtr[1].size;
+ int code;
+ Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
+
+ Tcl_IncrRefCount(intObj);
+ code = TclGetIntFromObj(NULL, intObj, &immValue);
+ TclDecrRefCount(intObj);
+ if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {
+ haveImmValue = 1;
+ }
+ if (!haveImmValue) {
+ PushLiteral(envPtr, word, numBytes);
+ }
+ } else {
+ SetLineInformation(2);
+ CompileTokens(envPtr, incrTokenPtr, interp);
+ TclClearNumConversion(envPtr);
+ }
+ } else { /* No incr amount given so use 1. */
+ haveImmValue = 1;
+ }
+
+ /*
+ * Emit the instruction to increment the variable.
+ */
+
+ if (isScalar) { /* Simple scalar variable. */
+ if (localIndex >= 0) {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
+ TclEmitInt1(immValue, envPtr);
+ } else {
+ TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+ }
+ } else {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
+ } else {
+ TclEmitOpcode( INST_INCR_STK, 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 {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+ } else {
+ TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileInfo*Cmd --
+ *
+ * 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" 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 == 1) {
+ return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ } else 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.
+ */
+
+ /* TODO: Just push the known value */
+ 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 TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+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
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ int isScalar, localIndex;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we need
+ * to emit code to compute and push the name at runtime. We use a frame
+ * slot (entry in the array of local vars) if we are compiling a procedure
+ * body and if the name is simple text that does not include namespace
+ * qualifiers.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar, 1);
+
+ /*
+ * Emit instruction to check the variable for existence.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_EXIST_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
+ }
+ } else {
+ 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.
+ */
+
+ CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLappendCmd --
+ *
+ * Procedure called to compile the "lappend" 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 "lappend" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLappendCmd(
+ 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 *varTokenPtr, *valueTokenPtr;
+ int isScalar, localIndex, numWords, i, fwd, offsetFwd;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * If we're not in a procedure, don't compile.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* TODO: Consider support for compiling expanded args. */
+ numWords = parsePtr->numWords;
+ if (numWords == 1) {
+ return TCL_ERROR;
+ }
+ if (numWords != 3) {
+ /*
+ * LAPPEND instructions currently only handle one value, but we can
+ * handle some multi-value cases by stringing them together.
+ */
+
+ goto lappendMultiple;
+ }
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we
+ * need to emit code to compute and push the name at runtime. We use a
+ * frame slot (entry in the array of local vars) if we are compiling a
+ * procedure body and if the name is simple text that does not include
+ * namespace qualifiers.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, 1);
+
+ /*
+ * If we are doing an assignment, push the new value. In the no values
+ * case, create an empty object.
+ */
+
+ if (numWords > 2) {
+ Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
+
+ CompileWord(envPtr, valueTokenPtr, interp, 2);
+ }
+
+ /*
+ * Emit instructions to set/get the variable.
+ */
+
+ /*
+ * The *_STK opcodes should be refactored to make better use of existing
+ * LOAD/STORE instructions.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr);
+ }
+ }
+
+ return TCL_OK;
+
+ lappendMultiple:
+ /*
+ * Can only handle the case where we are appending to a local scalar when
+ * there are multiple values to append. Fortunately, this is common.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &isScalar, 1);
+ if (!isScalar || localIndex < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Definitely appending to a local scalar; generate the words and append
+ * them.
+ */
+
+ valueTokenPtr = TokenAfter(varTokenPtr);
+ for (i = 2 ; i < numWords ; i++) {
+ CompileWord(envPtr, valueTokenPtr, interp, i);
+ valueTokenPtr = TokenAfter(valueTokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
+ TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLassignCmd --
+ *
+ * Procedure called to compile the "lassign" 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 "lassign" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLassignCmd(
+ 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;
+ int isScalar, localIndex, numWords, idx;
+ DefineLineInformation; /* TIP #280 */
+
+ numWords = parsePtr->numWords;
+
+ /*
+ * Check for command syntax error, but we'll punt that to runtime.
+ */
+
+ if (numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Generate code to push list being taken apart by [lassign].
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+
+ /*
+ * Generate code to assign values from the list to variables.
+ */
+
+ for (idx=0 ; idx<numWords-2 ; idx++) {
+ tokenPtr = TokenAfter(tokenPtr);
+
+ /*
+ * Generate the next variable name.
+ */
+
+ PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
+ &isScalar, idx+2);
+
+ /*
+ * Emit instructions to get the idx'th item out of the list value on
+ * the stack and assign it to the variable.
+ */
+
+ 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 {
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+ TclEmitOpcode( INST_STORE_STK, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ } else {
+ 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);
+ }
+ }
+ }
+
+ /*
+ * Generate code to leave the rest of the list on the stack.
+ */
+
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLindexCmd --
+ *
+ * Procedure called to compile the "lindex" 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 "lindex" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLindexCmd(
+ 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 *idxTokenPtr, *valTokenPtr;
+ int i, idx, numWords = parsePtr->numWords;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * Quit if too few args.
+ */
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (numWords <= 1) {
+ return TCL_ERROR;
+ }
+
+ valTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (numWords != 3) {
+ goto emitComplexLindex;
+ }
+
+ idxTokenPtr = TokenAfter(valTokenPtr);
+ if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
+ /*
+ * 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);
+ return TCL_OK;
+ }
+
+ /*
+ * If the value was not known at compile time, the conversion failed or
+ * the value was negative, we just keep on going with the more complex
+ * compilation.
+ */
+
+ /*
+ * Push the operands onto the stack.
+ */
+
+ emitComplexLindex:
+ for (i=1 ; i<numWords ; i++) {
+ CompileWord(envPtr, valTokenPtr, interp, i);
+ valTokenPtr = TokenAfter(valTokenPtr);
+ }
+
+ /*
+ * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
+ * multiple index args.
+ */
+
+ if (numWords == 3) {
+ TclEmitOpcode( INST_LIST_INDEX, envPtr);
+ } else {
+ TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileListCmd --
+ *
+ * Procedure called to compile the "list" 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 "list" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileListCmd(
+ 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 *valueTokenPtr;
+ int i, numWords, concat, build;
+ Tcl_Obj *listObj, *objPtr;
+
+ if (parsePtr->numWords == 1) {
+ /*
+ * [list] without arguments just pushes an empty object.
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /*
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
+ */
+
+ numWords = parsePtr->numWords;
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ listObj = Tcl_NewObj();
+ for (i = 1; i < numWords && listObj != NULL; i++) {
+ objPtr = Tcl_NewObj();
+ if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+ } else {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ }
+ valueTokenPtr = TokenAfter(valueTokenPtr);
+ }
+ if (listObj != NULL) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(listObj, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(listObj);
+ if (len > 0) {
+ /*
+ * Force list interpretation!
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Push the all values onto the stack.
+ */
+
+ numWords = parsePtr->numWords;
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ concat = build = 0;
+ for (i = 1; i < numWords; i++) {
+ if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
+ TclEmitInstInt4( INST_LIST, build, envPtr);
+ if (concat) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ }
+ build = 0;
+ concat = 1;
+ }
+ CompileWord(envPtr, valueTokenPtr, interp, i);
+ if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ if (concat) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ } else {
+ concat = 1;
+ }
+ } else {
+ build++;
+ }
+ valueTokenPtr = TokenAfter(valueTokenPtr);
+ }
+ if (build > 0) {
+ TclEmitInstInt4( INST_LIST, build, envPtr);
+ if (concat) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ }
+ }
+
+ /*
+ * If there was just one expanded word, we must ensure that it is a list
+ * at this point. We use an [lrange ... 0 end] for this (instead of
+ * [llength], as with literals) as we must drop any string representation
+ * that might be hanging around.
+ */
+
+ if (concat && numWords == 2) {
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLlengthCmd --
+ *
+ * Procedure called to compile the "llength" 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 "llength" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLlengthCmd(
+ 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 *varTokenPtr;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, varTokenPtr, interp, 1);
+ 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 */
+ int idx1, idx2;
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Parse the indices. Will only compile if both are constants and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing) or an end-based index greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLinsertCmd --
+ *
+ * How to compile the "linsert" command. We only bother with the case
+ * where the index is constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLinsertCmd(
+ 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 */
+ int idx, i;
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Parse the 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) or an end-based index greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * There are four main cases. If there are no values to insert, this is
+ * just a confirm-listiness check. If the index is '0', this is a prepend.
+ * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
+ * this is a splice (== split, insert values as list, concat-3).
+ */
+
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ return TCL_OK;
+ }
+
+ for (i=3 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ TclEmitInstInt4( INST_LIST, i-3, envPtr);
+
+ if (idx == 0 /*start*/) {
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ } else if (idx == INDEX_END /*end*/) {
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ } else {
+ if (idx < 0) {
+ idx++;
+ }
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx-1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ * How to compile the "lreplace" command. We only bother with the case
+ * where the indices are constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, i, offset;
+
+ if (parsePtr->numWords < 4) {
+ return TCL_ERROR;
+ }
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Parse the indices. Will only compile if both are constants and not an
+ * _integer_ less than zero (since we reserve negative indices here for
+ * end-relative indexing) or an end-based index greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Work out what this [lreplace] is actually doing.
+ */
+
+ tmpObj = NULL;
+ CompileWord(envPtr, listTokenPtr, interp, 1);
+ if (parsePtr->numWords == 4) {
+ if (idx1 == 0) {
+ if (idx2 == INDEX_END) {
+ goto dropAll;
+ }
+ idx1 = idx2 + 1;
+ idx2 = INDEX_END;
+ goto dropEnd;
+ } else if (idx2 == INDEX_END) {
+ idx2 = idx1 - 1;
+ idx1 = 0;
+ goto dropEnd;
+ } else {
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto dropRange;
+ }
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ for (i=4 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, i - 4, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ if (idx1 == 0) {
+ if (idx2 == INDEX_END) {
+ goto replaceAll;
+ }
+ idx1 = idx2 + 1;
+ idx2 = INDEX_END;
+ goto replaceHead;
+ } else if (idx2 == INDEX_END) {
+ idx2 = idx1 - 1;
+ idx1 = 0;
+ goto replaceTail;
+ } else {
+ if (idx1 > 0 && idx2 > 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto replaceRange;
+ }
+
+ /*
+ * Issue instructions to perform the operations relating to configurations
+ * that just drop. The only argument pushed on the stack is the list to
+ * operate on.
+ */
+
+ dropAll:
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ goto done;
+
+ dropEnd:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ goto done;
+
+ dropRange:
+ if (tmpObj != NULL) {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GT, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Issue instructions to perform the operations relating to configurations
+ * that do real replacement. All arguments are pushed and assembled into a
+ * pair: the list of values to replace with, and the list to do the
+ * surgery on.
+ */
+
+ replaceAll:
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ goto done;
+
+ replaceHead:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceTail:
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
+ TclEmitInt4( idx2, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ replaceRange:
+ if (tmpObj != NULL) {
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GT, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+ "list doesn't contain element %d", idx1), NULL), envPtr);
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+ Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+ envPtr->codeStart + offset + 1);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
+ TclEmitInt4( idx1 - 1, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ goto done;
+
+ /*
+ * Clean up the allocated memory.
+ */
+
+ done:
+ if (tmpObj != NULL) {
+ Tcl_DecrRefCount(tmpObj);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLsetCmd --
+ *
+ * Procedure called to compile the "lset" 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 "lset" command at
+ * runtime.
+ *
+ * The general template for execution of the "lset" command is:
+ * (1) Instructions to push the variable name, unless the variable is
+ * local to the stack frame.
+ * (2) If the variable is an array element, instructions to push the
+ * array element name.
+ * (3) Instructions to push each of zero or more "index" arguments to the
+ * stack, followed with the "newValue" element.
+ * (4) Instructions to duplicate the variable name and/or array element
+ * name onto the top of the stack, if either was pushed at steps (1)
+ * and (2).
+ * (5) The appropriate INST_LOAD_* instruction to place the original
+ * value of the list variable at top of stack.
+ * (6) At this point, the stack contains:
+ * varName? arrayElementName? index1 index2 ... newValue oldList
+ * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
+ * according as whether there is exactly one index element (LIST) or
+ * either zero or else two or more (FLAT). This instruction removes
+ * everything from the stack except for the two names and pushes the
+ * new value of the variable.
+ * (7) Finally, INST_STORE_* stores the new value in the variable and
+ * cleans up the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLsetCmd(
+ 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. */
+{
+ int tempDepth; /* Depth used for emitting one part of the
+ * code burst. */
+ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
+ * parse of the variable name. */
+ int localIndex; /* Index of var in local var table. */
+ int isScalar; /* Flag == 1 if scalar, 0 if array. */
+ int i;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * Check argument count.
+ */
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
+ /*
+ * Fail at run time, not in compilation.
+ */
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we need
+ * to emit code to compute and push the name at runtime. We use a frame
+ * slot (entry in the array of local vars) if we are compiling a procedure
+ * body and if the name is simple text that does not include namespace
+ * qualifiers.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, 1);
+
+ /*
+ * Push the "index" args and the new element value.
+ */
+
+ for (i=2 ; i<parsePtr->numWords ; ++i) {
+ varTokenPtr = TokenAfter(varTokenPtr);
+ CompileWord(envPtr, varTokenPtr, interp, i);
+ }
+
+ /*
+ * Duplicate the variable name if it's been pushed.
+ */
+
+ if (localIndex < 0) {
+ if (isScalar) {
+ tempDepth = parsePtr->numWords - 2;
+ } else {
+ tempDepth = parsePtr->numWords - 1;
+ }
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
+ }
+
+ /*
+ * Duplicate an array index if one's been pushed.
+ */
+
+ if (!isScalar) {
+ if (localIndex < 0) {
+ tempDepth = parsePtr->numWords - 1;
+ } else {
+ tempDepth = parsePtr->numWords - 2;
+ }
+ TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
+ }
+
+ /*
+ * Emit code to load the variable's value.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr);
+ } else {
+ Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr);
+ }
+ }
+
+ /*
+ * Emit the correct variety of 'lset' instruction.
+ */
+
+ if (parsePtr->numWords == 4) {
+ TclEmitOpcode( INST_LSET_LIST, envPtr);
+ } else {
+ TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+ }
+
+ /*
+ * Emit code to put the value back in the variable.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_STORE_STK, envPtr);
+ } else {
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
+ } else {
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "namespace upvar"
+ * command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNamespaceCurrentCmd(
+ 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 [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 (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * 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.
+ */
+
+ 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;
+ }
+
+ /*
+ * 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.
+ */
+
+ PushStringLiteral(envPtr, "::namespace");
+ PushStringLiteral(envPtr, "inscope");
+ TclEmitOpcode( INST_NS_CURRENT, envPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceOriginCmd(
+ 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 (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode( INST_ORIGIN_COMMAND, 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);
+ PushStringLiteral(envPtr, "0");
+ PushStringLiteral(envPtr, "::");
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ off = CurrentOffset(envPtr);
+ PushStringLiteral(envPtr, "1");
+ TclEmitOpcode( INST_SUB, envPtr);
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_INDEX, envPtr);
+ PushStringLiteral(envPtr, ":");
+ 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);
+ PushStringLiteral(envPtr, "::");
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitOpcode( INST_GE, envPtr);
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
+ PushStringLiteral(envPtr, "2");
+ TclEmitOpcode( INST_ADD, envPtr);
+ TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+ PushStringLiteral(envPtr, "end");
+ 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 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;
+ }
+
+ /*
+ * Push the namespace
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+
+ /*
+ * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+ * local variable, return an error so that the non-compiled command will
+ * be called at runtime.
+ */
+
+ localTokenPtr = tokenPtr;
+ for (i=2; i<numWords; i+=2) {
+ otherTokenPtr = TokenAfter(localTokenPtr);
+ localTokenPtr = TokenAfter(otherTokenPtr);
+
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ PushVarNameWord(interp, localTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, i+1);
+
+ if ((localIndex < 0) || !isScalar) {
+ return TCL_ERROR;
+ }
+ TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
+ }
+
+ /*
+ * Pop the namespace, and set the result to empty
+ */
+
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileRegexpCmd --
+ *
+ * Procedure called to compile the "regexp" 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 "regexp" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileRegexpCmd(
+ 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. */
+{
+ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
+ * parse of the RE or string. */
+ int i, len, nocase, exact, sawLast, simple;
+ const char *str;
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * We are only interested in compiling simple regexp cases. Currently
+ * supported compile cases are:
+ * regexp ?-nocase? ?--? staticString $var
+ * regexp ?-nocase? ?--? {^staticString$} $var
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ simple = 0;
+ nocase = 0;
+ sawLast = 0;
+ varTokenPtr = parsePtr->tokenPtr;
+
+ /*
+ * We only look for -nocase and -- as options. Everything else gets pushed
+ * to runtime execution. This is different than regexp's runtime option
+ * handling, but satisfies our stricter needs.
+ */
+
+ for (i = 1; i < parsePtr->numWords - 2; i++) {
+ varTokenPtr = TokenAfter(varTokenPtr);
+ if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Not a simple string, so punt to runtime.
+ */
+
+ return TCL_ERROR;
+ }
+ str = varTokenPtr[1].start;
+ len = varTokenPtr[1].size;
+ if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
+ sawLast++;
+ i++;
+ break;
+ } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
+ nocase = 1;
+ } else {
+ /*
+ * Not an option we recognize.
+ */
+
+ return TCL_ERROR;
+ }
+ }
+
+ if ((parsePtr->numWords - i) != 2) {
+ /*
+ * We don't support capturing to variables.
+ */
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the regexp string. If it is not a simple string or can't be
+ * converted to a glob pattern, push the word for the INST_REGEXP.
+ * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
+ */
+
+ varTokenPtr = TokenAfter(varTokenPtr);
+
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ Tcl_DString ds;
+
+ str = varTokenPtr[1].start;
+ len = varTokenPtr[1].size;
+
+ /*
+ * If it has a '-', it could be an incorrectly formed regexp command.
+ */
+
+ if ((*str == '-') && !sawLast) {
+ return TCL_ERROR;
+ }
+
+ if (len == 0) {
+ /*
+ * The semantics of regexp are always match on re == "".
+ */
+
+ PushStringLiteral(envPtr, "1");
+ return TCL_OK;
+ }
+
+ /*
+ * Attempt to convert pattern to glob. If successful, push the
+ * converted pattern as a literal.
+ */
+
+ if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
+ == TCL_OK) {
+ simple = 1;
+ PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+
+ if (!simple) {
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+ }
+
+ /*
+ * Push the string arg.
+ */
+
+ varTokenPtr = TokenAfter(varTokenPtr);
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+
+ if (simple) {
+ if (exact && !nocase) {
+ TclEmitOpcode( INST_STR_EQ, envPtr);
+ } else {
+ TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr);
+ }
+ } else {
+ /*
+ * Pass correct RE compile flags. We use only Int1 (8-bit), but
+ * that handles all the flags we want to pass.
+ * Don't use TCL_REG_NOSUB as we may have backrefs.
+ */
+
+ int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
+
+ TclEmitInstInt1( INST_REGEXP, cflags, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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 "return" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileReturnCmd(
+ 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. */
+{
+ /*
+ * General syntax: [return ?-option value ...? ?result?]
+ * An even number of words means an explicit result argument is present.
+ */
+ int level, code, objc, size, status = TCL_OK;
+ int numWords = parsePtr->numWords;
+ int explicitResult = (0 == (numWords % 2));
+ int numOptionWords = numWords - 1 - explicitResult;
+ Tcl_Obj *returnOpts, **objv;
+ Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ DefineLineInformation; /* TIP #280 */
+
+ /*
+ * Check for special case which can always be compiled:
+ * return -options <opts> <msg>
+ * Unlike the normal [return] compilation, this version does everything at
+ * runtime so it can handle arbitrary words and not just literals. Note
+ * that if INST_RETURN_STK wasn't already needed for something else
+ * ('finally' clause processing) this piece of code would not be present.
+ */
+
+ if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
+ && (wordTokenPtr[1].size == 8)
+ && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
+ Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
+ Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);
+
+ CompileWord(envPtr, optsTokenPtr, interp, 2);
+ CompileWord(envPtr, msgTokenPtr, interp, 3);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
+ return TCL_OK;
+ }
+
+ /*
+ * Allocate some working space.
+ */
+
+ objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
+
+ /*
+ * Scan through the return options. If any are unknown at compile time,
+ * there is no value in bytecompiling. Save the option values known in an
+ * objv array for merging into a return options dictionary.
+ *
+ * TODO: There is potential for improvement if all option keys are known
+ * at compile time and all option values relating to '-code' and '-level'
+ * are known at compile time.
+ */
+
+ for (objc = 0; objc < numOptionWords; objc++) {
+ objv[objc] = Tcl_NewObj();
+ Tcl_IncrRefCount(objv[objc]);
+ if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
+ /*
+ * Non-literal, so punt to run-time assembly of the dictionary.
+ */
+
+ for (; objc>=0 ; objc--) {
+ TclDecrRefCount(objv[objc]);
+ }
+ TclStackFree(interp, objv);
+ goto issueRuntimeReturn;
+ }
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+ status = TclMergeReturnOptions(interp, objc, objv,
+ &returnOpts, &code, &level);
+ while (--objc >= 0) {
+ TclDecrRefCount(objv[objc]);
+ }
+ TclStackFree(interp, objv);
+ if (TCL_ERROR == status) {
+ /*
+ * Something was bogus in the return options. Clear the error message,
+ * and report back to the compiler that this must be interpreted at
+ * runtime.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * All options are known at compile time, so we're going to bytecompile.
+ * Emit instructions to push the result on the stack.
+ */
+
+ if (explicitResult) {
+ CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ } else {
+ /*
+ * No explict result argument, so default result is empty string.
+ */
+
+ PushStringLiteral(envPtr, "");
+ }
+
+ /*
+ * Check for optimization: When [return] is in a proc, and there's no
+ * enclosing [catch], and there are no return options, then the INST_DONE
+ * instruction is equivalent, and may be more efficient.
+ */
+
+ if (numOptionWords == 0 && envPtr->procPtr != NULL) {
+ /*
+ * We have default return options and we're in a proc ...
+ */
+
+ int index = envPtr->exceptArrayNext - 1;
+ int enclosingCatch = 0;
+
+ while (index >= 0) {
+ ExceptionRange range = envPtr->exceptArrayPtr[index];
+
+ if ((range.type == CATCH_EXCEPTION_RANGE)
+ && (range.catchOffset == -1)) {
+ enclosingCatch = 1;
+ break;
+ }
+ index--;
+ }
+ if (!enclosingCatch) {
+ /*
+ * ... and there is no enclosing catch. Issue the maximally
+ * efficient exit instruction.
+ */
+
+ Tcl_DecrRefCount(returnOpts);
+ TclEmitOpcode(INST_DONE, envPtr);
+ TclAdjustStackDepth(1, envPtr);
+ return TCL_OK;
+ }
+ }
+
+ /* Optimize [return -level 0 $x]. */
+ Tcl_DictObjSize(NULL, returnOpts, &size);
+ if (size == 0 && level == 0 && code == TCL_OK) {
+ Tcl_DecrRefCount(returnOpts);
+ return TCL_OK;
+ }
+
+ /*
+ * Could not use the optimization, so we push the return options dict, and
+ * emit the INST_RETURN_IMM instruction with code and level as operands.
+ */
+
+ CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
+ return TCL_OK;
+
+ issueRuntimeReturn:
+ /*
+ * Assemble the option dictionary (as a list as that's good enough).
+ */
+
+ wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (objc=1 ; objc<=numOptionWords ; objc++) {
+ CompileWord(envPtr, wordTokenPtr, interp, objc);
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+ TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
+
+ /*
+ * Push the result.
+ */
+
+ if (explicitResult) {
+ CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ } else {
+ PushStringLiteral(envPtr, "");
+ }
+
+ /*
+ * Issue the RETURN itself.
+ */
+
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
+ return TCL_OK;
+}
+
+static void
+CompileReturnInternal(
+ CompileEnv *envPtr,
+ unsigned char op,
+ int code,
+ int level,
+ Tcl_Obj *returnOpts)
+{
+ if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
+ ExceptionRange *rangePtr;
+ ExceptionAux *exceptAux;
+
+ rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
+ if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+ TclCleanupStackForBreakContinue(envPtr, exceptAux);
+ if (code == TCL_BREAK) {
+ TclAddLoopBreakFixup(envPtr, exceptAux);
+ } else {
+ TclAddLoopContinueFixup(envPtr, exceptAux);
+ }
+ Tcl_DecrRefCount(returnOpts);
+ return;
+ }
+ }
+
+ TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
+ TclEmitInstInt4(op, code, envPtr);
+ TclEmitInt4(level, envPtr);
+}
+
+void
+TclCompileSyntaxError(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr)
+{
+ Tcl_Obj *msg = Tcl_GetObjResult(interp);
+ 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,
+ TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
+ Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileUpvarCmd --
+ *
+ * Procedure called to compile the "upvar" 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 "upvar" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUpvarCmd(
+ 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 isScalar, localIndex, numWords, i;
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *objPtr;
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ numWords = parsePtr->numWords;
+ if (numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push the frame index if it is known at compile time
+ */
+
+ objPtr = Tcl_NewObj();
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ CallFrame *framePtr;
+ const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;
+
+ /*
+ * Attempt to convert to a level reference. Note that TclObjGetFrame
+ * only changes the obj type when a conversion was successful.
+ */
+
+ TclObjGetFrame(interp, objPtr, &framePtr);
+ newTypePtr = objPtr->typePtr;
+ Tcl_DecrRefCount(objPtr);
+
+ if (newTypePtr != typePtr) {
+ if (numWords%2) {
+ return TCL_ERROR;
+ }
+ /* TODO: Push the known value instead? */
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ otherTokenPtr = TokenAfter(tokenPtr);
+ i = 2;
+ } else {
+ if (!(numWords%2)) {
+ return TCL_ERROR;
+ }
+ PushStringLiteral(envPtr, "1");
+ otherTokenPtr = tokenPtr;
+ i = 1;
+ }
+ } else {
+ Tcl_DecrRefCount(objPtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+ * local variable, return an error so that the non-compiled command will
+ * be called at runtime.
+ */
+
+ for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
+ localTokenPtr = TokenAfter(otherTokenPtr);
+
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ PushVarNameWord(interp, localTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, i+1);
+
+ if ((localIndex < 0) || !isScalar) {
+ return TCL_ERROR;
+ }
+ TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
+ }
+
+ /*
+ * Pop the frame index, and set the result to empty
+ */
+
+ TclEmitOpcode( INST_POP, envPtr);
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ * Procedure called to compile the "variable" 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 "variable" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileVariableCmd(
+ 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 *varTokenPtr, *valueTokenPtr;
+ int localIndex, numWords, i;
+ DefineLineInformation; /* TIP #280 */
+
+ numWords = parsePtr->numWords;
+ if (numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Bail out if not compiling a proc body
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Loop over the (var, value) pairs.
+ */
+
+ valueTokenPtr = parsePtr->tokenPtr;
+ for (i=1; i<numWords; i+=2) {
+ varTokenPtr = TokenAfter(valueTokenPtr);
+ valueTokenPtr = TokenAfter(varTokenPtr);
+
+ localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+ if (localIndex < 0) {
+ return TCL_ERROR;
+ }
+
+ /* TODO: Consider what value can pass throug the
+ * IndexTailVarIfKnown() screen. Full CompileWord()
+ * likely does not apply here. Push known value instead. */
+ CompileWord(envPtr, varTokenPtr, interp, i);
+ TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
+
+ if (i+1 < numWords) {
+ /*
+ * A value has been given: set the variable, pop the value
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, i+1);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ }
+
+ /*
+ * Set the result to empty
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IndexTailVarIfKnown --
+ *
+ * Procedure used in compiling [global] and [variable] commands. It
+ * inspects the variable name described by varTokenPtr and, if the tail
+ * is known at compile time, defines a corresponding local variable.
+ *
+ * Results:
+ * Returns the variable's index in the table of compiled locals if the
+ * tail is known at compile time, or -1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IndexTailVarIfKnown(
+ Tcl_Interp *interp,
+ Tcl_Token *varTokenPtr, /* Token representing the variable name */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Obj *tailPtr;
+ const char *tailName, *p;
+ int len, n = varTokenPtr->numComponents;
+ Tcl_Token *lastTokenPtr;
+ int full, localIndex;
+
+ /*
+ * Determine if the tail is (a) known at compile time, and (b) not an
+ * array element. Should any of these fail, return an error so that the
+ * non-compiled command will be called at runtime.
+ *
+ * In order for the tail to be known at compile time, the last token in
+ * the word has to be constant and contain "::" if it is not the only one.
+ */
+
+ if (!EnvHasLVT(envPtr)) {
+ return -1;
+ }
+
+ TclNewObj(tailPtr);
+ if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
+ full = 1;
+ lastTokenPtr = varTokenPtr;
+ } else {
+ full = 0;
+ lastTokenPtr = varTokenPtr + n;
+ if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+ Tcl_DecrRefCount(tailPtr);
+ return -1;
+ }
+ }
+
+ tailName = TclGetStringFromObj(tailPtr, &len);
+
+ if (len) {
+ if (*(tailName+len-1) == ')') {
+ /*
+ * Possible array: bail out
+ */
+
+ Tcl_DecrRefCount(tailPtr);
+ return -1;
+ }
+
+ /*
+ * Get the tail: immediately after the last '::'
+ */
+
+ for (p = tailName + len -1; p > tailName; p--) {
+ if ((*p == ':') && (*(p-1) == ':')) {
+ p++;
+ break;
+ }
+ }
+ if (!full && (p == tailName)) {
+ /*
+ * No :: in the last component.
+ */
+
+ Tcl_DecrRefCount(tailPtr);
+ return -1;
+ }
+ len -= p - tailName;
+ tailName = p;
+ }
+
+ localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr);
+ Tcl_DecrRefCount(tailPtr);
+ return localIndex;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
+ *
+ * Compilations of the TclOO utility commands [next] and [self].
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclCompileObjectNextCmd(
+ 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 > 255) {
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileObjectNextToCmd(
+ 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 > 255) {
+ return TCL_ERROR;
+ }
+
+ for (i=0 ; i<parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr);
+ return TCL_OK;
+}
+
+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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
new file mode 100644
index 0000000..e6ec0a6
--- /dev/null
+++ b/generic/tclCompCmdsSZ.c
@@ -0,0 +1,4383 @@
+/*
+ * tclCompCmdsSZ.c --
+ *
+ * This file contains compilation procedures that compile various Tcl
+ * commands (beginning with the letters 's' through 'z', except for
+ * [upvar] and [variable]) into a sequence of instructions ("bytecodes").
+ * Also includes the operator command compilers.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2004-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.
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclStringTrim.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static ClientData DupJumptableInfo(ClientData clientData);
+static void FreeJumptableInfo(ClientData clientData);
+static void PrintJumptableInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, const char *identity,
+ int instruction, CompileEnv *envPtr);
+static int CompileComparisonOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int instruction,
+ CompileEnv *envPtr);
+static int CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int instruction,
+ CompileEnv *envPtr);
+static int CompileUnaryOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int instruction,
+ CompileEnv *envPtr);
+static void IssueSwitchChainedTests(Tcl_Interp *interp,
+ CompileEnv *envPtr, int mode, int noCase,
+ int valueIndex, int numWords,
+ Tcl_Token **bodyToken, int *bodyLines,
+ int **bodyNext);
+static void IssueSwitchJumpTable(Tcl_Interp *interp,
+ CompileEnv *envPtr, int valueIndex,
+ int numWords, Tcl_Token **bodyToken,
+ int *bodyLines, int **bodyContLines);
+static int IssueTryClausesInstructions(Tcl_Interp *interp,
+ CompileEnv *envPtr, Tcl_Token *bodyToken,
+ int numHandlers, int *matchCodes,
+ Tcl_Obj **matchClauses, int *resultVarIndices,
+ int *optionVarIndices, Tcl_Token **handlerTokens);
+static int IssueTryClausesFinallyInstructions(Tcl_Interp *interp,
+ CompileEnv *envPtr, Tcl_Token *bodyToken,
+ int numHandlers, int *matchCodes,
+ Tcl_Obj **matchClauses, int *resultVarIndices,
+ int *optionVarIndices, Tcl_Token **handlerTokens,
+ Tcl_Token *finallyToken);
+static int IssueTryFinallyInstructions(Tcl_Interp *interp,
+ CompileEnv *envPtr, Tcl_Token *bodyToken,
+ Tcl_Token *finallyToken);
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+const AuxDataType tclJumptableInfoType = {
+ "JumptableInfo", /* name */
+ DupJumptableInfo, /* dupProc */
+ FreeJumptableInfo, /* freeProc */
+ PrintJumptableInfo /* printProc */
+};
+
+/*
+ * Shorthand macros for instruction issuing.
+ */
+
+#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 PUSH(str) \
+ PushStringLiteral(envPtr, str)
+#define JUMP4(name,var) \
+ (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
+#define FIXJUMP4(var) \
+ TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define JUMP1(name,var) \
+ (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
+#define FIXJUMP1(var) \
+ TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define LOAD(idx) \
+ if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
+#define STORE(idx) \
+ if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
+#define INVOKE(name) \
+ TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END (-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ * Parse a token and get the encoded version of the index (as understood
+ * by TEBC), assuming it is at all knowable at compile time. Only handles
+ * indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ * TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ * Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+ Tcl_Token *tokenPtr,
+ int *index)
+{
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+ int result, idx;
+
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_ERROR;
+ }
+
+ result = TclGetIntFromObj(NULL, tmpObj, &idx);
+ if (result == TCL_OK) {
+ if (idx < 0) {
+ result = TCL_ERROR;
+ }
+ } else {
+ result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+ if (result == TCL_OK && idx > INDEX_END) {
+ result = TCL_ERROR;
+ }
+ }
+ Tcl_DecrRefCount(tmpObj);
+
+ if (result == TCL_OK) {
+ *index = idx;
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSetCmd --
+ *
+ * Procedure called to compile the "set" 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 "set" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSetCmd(
+ 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 *varTokenPtr, *valueTokenPtr;
+ int isAssignment, isScalar, localIndex, numWords;
+ DefineLineInformation; /* TIP #280 */
+
+ numWords = parsePtr->numWords;
+ if ((numWords != 2) && (numWords != 3)) {
+ return TCL_ERROR;
+ }
+ isAssignment = (numWords == 3);
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we need
+ * to emit code to compute and push the name at runtime. We use a frame
+ * slot (entry in the array of local vars) if we are compiling a procedure
+ * body and if the name is simple text that does not include namespace
+ * qualifiers.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, 1);
+
+ /*
+ * If we are doing an assignment, push the new value.
+ */
+
+ if (isAssignment) {
+ valueTokenPtr = TokenAfter(varTokenPtr);
+ CompileWord(envPtr, valueTokenPtr, interp, 2);
+ }
+
+ /*
+ * Emit instructions to set/get the variable.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode((isAssignment?
+ INST_STORE_STK : INST_LOAD_STK), envPtr);
+ } else if (localIndex <= 255) {
+ TclEmitInstInt1((isAssignment?
+ INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+ localIndex, envPtr);
+ } else {
+ TclEmitInstInt4((isAssignment?
+ INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+ localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode((isAssignment?
+ INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
+ } else if (localIndex <= 255) {
+ TclEmitInstInt1((isAssignment?
+ INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+ localIndex, envPtr);
+ } else {
+ TclEmitInstInt4((isAssignment?
+ INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+ localIndex, envPtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileString*Cmd --
+ *
+ * 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" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringCmpCmd(
+ 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);
+ TclEmitOpcode(INST_STR_CMP, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileStringEqualCmd(
+ 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);
+ TclEmitOpcode(INST_STR_EQ, envPtr);
+ return TCL_OK;
+}
+
+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(
+ 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;
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push the two operands onto the stack and then the index operation.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ TclEmitOpcode(INST_STR_INDEX, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileStringIsCmd(
+ 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 = TokenAfter(parsePtr->tokenPtr);
+ static const char *const isClasses[] = {
+ "alnum", "alpha", "ascii", "control",
+ "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_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
+ };
+ int t, range, allowEmpty = 0, end;
+ InstStringClassType strClassType;
+ Tcl_Obj *isClass;
+
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
+ return TCL_ERROR;
+ }
+ isClass = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
+ Tcl_DecrRefCount(isClass);
+ return TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
+ &t) != TCL_OK) {
+ Tcl_DecrRefCount(isClass);
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
+ }
+ Tcl_DecrRefCount(isClass);
+
+#define GotLiteral(tokenPtr, word) \
+ ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
+ (tokenPtr)[1].size > 1 && \
+ (tokenPtr)[1].start[0] == word[0] && \
+ strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+ /*
+ * Cannot handle the -failindex option at all, and that's the only legal
+ * way to have more than 4 arguments.
+ */
+
+ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords == 3) {
+ allowEmpty = 1;
+ } else {
+ if (!GotLiteral(tokenPtr, "-strict")) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+#undef GotLiteral
+
+ /*
+ * Compile the code. There are several main classes of check here.
+ * 1. Character classes
+ * 2. Booleans
+ * 3. Integers
+ * 4. Floats
+ * 5. Lists
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+
+ switch ((enum isClasses) t) {
+ case STR_IS_ALNUM:
+ strClassType = STR_CLASS_ALNUM;
+ goto compileStrClass;
+ case STR_IS_ALPHA:
+ strClassType = STR_CLASS_ALPHA;
+ goto compileStrClass;
+ case STR_IS_ASCII:
+ strClassType = STR_CLASS_ASCII;
+ goto compileStrClass;
+ case STR_IS_CONTROL:
+ strClassType = STR_CLASS_CONTROL;
+ goto compileStrClass;
+ case STR_IS_DIGIT:
+ strClassType = STR_CLASS_DIGIT;
+ goto compileStrClass;
+ case STR_IS_GRAPH:
+ strClassType = STR_CLASS_GRAPH;
+ goto compileStrClass;
+ case STR_IS_LOWER:
+ strClassType = STR_CLASS_LOWER;
+ goto compileStrClass;
+ case STR_IS_PRINT:
+ strClassType = STR_CLASS_PRINT;
+ goto compileStrClass;
+ case STR_IS_PUNCT:
+ strClassType = STR_CLASS_PUNCT;
+ goto compileStrClass;
+ case STR_IS_SPACE:
+ strClassType = STR_CLASS_SPACE;
+ goto compileStrClass;
+ case STR_IS_UPPER:
+ strClassType = STR_CLASS_UPPER;
+ goto compileStrClass;
+ case STR_IS_WORD:
+ strClassType = STR_CLASS_WORD;
+ goto compileStrClass;
+ case STR_IS_XDIGIT:
+ strClassType = STR_CLASS_XDIGIT;
+ compileStrClass:
+ if (allowEmpty) {
+ OP1( STR_CLASS, strClassType);
+ } else {
+ int over, over2;
+
+ OP( DUP);
+ OP1( STR_CLASS, strClassType);
+ JUMP1( JUMP_TRUE, over);
+ OP( POP);
+ PUSH( "0");
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ PUSH( "");
+ OP( STR_NEQ);
+ FIXJUMP1(over2);
+ }
+ return TCL_OK;
+
+ case STR_IS_BOOL:
+ case STR_IS_FALSE:
+ case STR_IS_TRUE:
+ OP( TRY_CVT_TO_BOOLEAN);
+ switch (t) {
+ int over, over2;
+
+ case STR_IS_BOOL:
+ if (allowEmpty) {
+ JUMP1( JUMP_TRUE, over);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ OP( POP);
+ PUSH( "1");
+ FIXJUMP1(over2);
+ } else {
+ OP4( REVERSE, 2);
+ OP( POP);
+ }
+ return TCL_OK;
+ case STR_IS_TRUE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_EQ);
+ } else {
+ OP( POP);
+ PUSH( "0");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ OP( LNOT);
+ return TCL_OK;
+ case STR_IS_FALSE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_NEQ);
+ } else {
+ OP( POP);
+ PUSH( "1");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ case STR_IS_DOUBLE: {
+ int satisfied, isEmpty;
+
+ if (allowEmpty) {
+ OP( DUP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_TRUE, isEmpty);
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ FIXJUMP1( isEmpty);
+ OP( POP);
+ FIXJUMP1( satisfied);
+ } else {
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(-1, envPtr);
+ FIXJUMP1( satisfied);
+ }
+ PUSH( "1");
+ FIXJUMP1( end);
+ return TCL_OK;
+ }
+
+ case STR_IS_INT:
+ case STR_IS_WIDE:
+ case STR_IS_ENTIER:
+ if (allowEmpty) {
+ int testNumType;
+
+ OP( DUP);
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_TRUE, testNumType);
+ OP( POP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(1, envPtr);
+ FIXJUMP1( testNumType);
+ OP4( REVERSE, 2);
+ OP( POP);
+ } else {
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_FALSE, end);
+ }
+
+ switch (t) {
+ case STR_IS_INT:
+ PUSH( "1");
+ OP( EQ);
+ break;
+ case STR_IS_WIDE:
+ PUSH( "2");
+ OP( LE);
+ break;
+ case STR_IS_ENTIER:
+ PUSH( "3");
+ OP( LE);
+ break;
+ }
+ FIXJUMP1( end);
+ return TCL_OK;
+
+ case STR_IS_LIST:
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ OP( DUP);
+ OP( LIST_LENGTH);
+ OP( POP);
+ ExceptionRangeEnds(envPtr, range);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( POP);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileStringMatchCmd(
+ 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;
+ int i, length, exactMatch = 0, nocase = 0;
+ const char *str;
+
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ /*
+ * Check if we have a -nocase flag.
+ */
+
+ if (parsePtr->numWords == 4) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+ str = tokenPtr[1].start;
+ length = tokenPtr[1].size;
+ if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
+ /*
+ * Fail at run time, not in compilation.
+ */
+
+ return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+ nocase = 1;
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Push the strings to match against each other.
+ */
+
+ for (i = 0; i < 2; i++) {
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ str = tokenPtr[1].start;
+ length = tokenPtr[1].size;
+ if (!nocase && (i == 0)) {
+ /*
+ * Trivial matches can be done by 'string equal'. If -nocase
+ * was specified, we can't do this because INST_STR_EQ has no
+ * support for nocase.
+ */
+
+ Tcl_Obj *copy = Tcl_NewStringObj(str, length);
+
+ Tcl_IncrRefCount(copy);
+ exactMatch = TclMatchIsTrivial(TclGetString(copy));
+ TclDecrRefCount(copy);
+ }
+ PushLiteral(envPtr, str, length);
+ } else {
+ SetLineInformation(i+1+nocase);
+ CompileTokens(envPtr, tokenPtr, interp);
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Push the matcher.
+ */
+
+ if (exactMatch) {
+ TclEmitOpcode(INST_STR_EQ, envPtr);
+ } else {
+ TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+ }
+ return TCL_OK;
+}
+
+int
+TclCompileStringLenCmd(
+ 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;
+ Tcl_Obj *objPtr;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ TclNewObj(objPtr);
+ if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ /*
+ * Here someone is asking for the length of a static string (or
+ * something with backslashes). Just push the actual character (not
+ * byte) length.
+ */
+
+ char buf[TCL_INTEGER_SPACE];
+ int len = Tcl_GetCharLength(objPtr);
+
+ len = sprintf(buf, "%d", len);
+ PushLiteral(envPtr, buf, len);
+ } else {
+ SetLineInformation(1);
+ CompileTokens(envPtr, tokenPtr, interp);
+ TclEmitOpcode(INST_STR_LEN, envPtr);
+ }
+ 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 TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
+ Tcl_DecrRefCount(mapObj);
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ } else if (len != 2) {
+ Tcl_DecrRefCount(mapObj);
+ return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ /*
+ * 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;
+ int idx1, idx2;
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+ stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ fromTokenPtr = TokenAfter(stringTokenPtr);
+ toTokenPtr = TokenAfter(fromTokenPtr);
+
+ /*
+ * Parse the two indices.
+ */
+
+ if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
+ goto nonConstantIndices;
+ }
+ if (GetIndexFromToken(toTokenPtr, &idx2) != 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;
+}
+
+int
+TclCompileStringReplaceCmd(
+ 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, *valueTokenPtr, *replacementTokenPtr = NULL;
+ DefineLineInformation; /* TIP #280 */
+ int idx1, idx2;
+
+ if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+ return TCL_ERROR;
+ }
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (parsePtr->numWords == 5) {
+ tokenPtr = TokenAfter(valueTokenPtr);
+ tokenPtr = TokenAfter(tokenPtr);
+ replacementTokenPtr = TokenAfter(tokenPtr);
+ }
+
+ /*
+ * Parse the indices. Will only compile special cases if both are
+ * constants and not an _integer_ less than zero (since we reserve
+ * negative indices here for end-relative indexing) or an end-based index
+ * greater than 'end' itself.
+ */
+
+ tokenPtr = TokenAfter(valueTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ goto genericReplace;
+ }
+
+ /*
+ * We handle these replacements specially: first character (where
+ * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
+ * else and the semantics get rather screwy.
+ */
+
+ if (idx1 == 0 && idx2 == 0) {
+ int notEq, end;
+
+ /*
+ * Just working with the first character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop first */
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ return TCL_OK;
+ }
+ /* Replace first */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 1, INDEX_END);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
+ int notEq, end;
+
+ /*
+ * Just working with the last character.
+ */
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ if (replacementTokenPtr == NULL) {
+ /* Drop last */
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ return TCL_OK;
+ }
+ /* Replace last */
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ OP4( OVER, 1);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_FALSE, notEq);
+ OP( POP);
+ JUMP1( JUMP, end);
+ FIXJUMP1(notEq);
+ TclAdjustStackDepth(1, envPtr);
+ OP4( REVERSE, 2);
+ OP44( STR_RANGE_IMM, 0, INDEX_END-1);
+ OP4( REVERSE, 2);
+ OP1( STR_CONCAT1, 2);
+ FIXJUMP1(end);
+ return TCL_OK;
+
+ } else {
+ /*
+ * Need to process indices at runtime. This could be because the
+ * indices are not constants, or because we need to resolve them to
+ * absolute indices to work out if a replacement is going to happen.
+ * In any case, to runtime it is.
+ */
+
+ genericReplace:
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ tokenPtr = TokenAfter(valueTokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ if (replacementTokenPtr != NULL) {
+ CompileWord(envPtr, replacementTokenPtr, interp, 4);
+ } else {
+ PUSH( "");
+ }
+ OP( STR_REPLACE);
+ return TCL_OK;
+ }
+}
+
+int
+TclCompileStringTrimLCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM_LEFT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimRCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM_RIGHT);
+ return TCL_OK;
+}
+
+int
+TclCompileStringTrimCmd(
+ 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;
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ } else {
+ PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ OP( STR_TRIM);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_UPPER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_LOWER);
+ return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+ 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;
+
+ if (parsePtr->numWords != 2) {
+ return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ OP( STR_TITLE);
+ return TCL_OK;
+}
+
+/*
+ * Support definitions for the [string is] compilation.
+ */
+
+static int
+UniCharIsAscii(
+ int character)
+{
+ return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+ int character)
+{
+ return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+StringClassDesc const tclStringClassTable[] = {
+ {"alnum", Tcl_UniCharIsAlnum},
+ {"alpha", Tcl_UniCharIsAlpha},
+ {"ascii", UniCharIsAscii},
+ {"control", Tcl_UniCharIsControl},
+ {"digit", Tcl_UniCharIsDigit},
+ {"graph", Tcl_UniCharIsGraph},
+ {"lower", Tcl_UniCharIsLower},
+ {"print", Tcl_UniCharIsPrint},
+ {"punct", Tcl_UniCharIsPunct},
+ {"space", Tcl_UniCharIsSpace},
+ {"upper", Tcl_UniCharIsUpper},
+ {"word", Tcl_UniCharIsWordChar},
+ {"xdigit", UniCharIsHexDigit},
+ {NULL, NULL}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSubstCmd --
+ *
+ * Procedure called to compile the "subst" command.
+ *
+ * Results:
+ * Returns TCL_OK for successful compile, or TCL_ERROR to defer
+ * evaluation to runtime (either when it is too complex to get the
+ * semantics right, or when we know for sure that it is an error but need
+ * the error to happen at the right time).
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "subst" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSubstCmd(
+ 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 numArgs = parsePtr->numWords - 1;
+ int numOpts = numArgs - 1;
+ int objc, flags = TCL_SUBST_ALL;
+ Tcl_Obj **objv/*, *toSubst = NULL*/;
+ Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ int code = TCL_ERROR;
+ DefineLineInformation; /* TIP #280 */
+
+ if (numArgs == 0) {
+ return TCL_ERROR;
+ }
+
+ objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));
+
+ for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
+ objv[objc] = Tcl_NewObj();
+ Tcl_IncrRefCount(objv[objc]);
+ if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
+ objc++;
+ goto cleanup;
+ }
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+
+/*
+ if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) {
+ toSubst = objv[numOpts];
+ Tcl_IncrRefCount(toSubst);
+ }
+*/
+
+ /* TODO: Figure out expansion to cover WordKnownAtCompileTime
+ * The difficulty is that WKACT makes a copy, and if TclSubstParse
+ * below parses the copy of the original source string, some deep
+ * parts of the compile machinery get upset. They want all pointers
+ * stored in Tcl_Tokens to point back to the same original string.
+ */
+ if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ code = TclSubstOptions(NULL, numOpts, objv, &flags);
+ }
+
+ cleanup:
+ while (--objc >= 0) {
+ TclDecrRefCount(objv[objc]);
+ }
+ TclStackFree(interp, objv);
+ if (/*toSubst == NULL*/ code != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ SetLineInformation(numArgs);
+ TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
+ flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
+
+/* TclDecrRefCount(toSubst);*/
+ return TCL_OK;
+}
+
+void
+TclSubstCompile(
+ Tcl_Interp *interp,
+ const char *bytes,
+ int numBytes,
+ int flags,
+ int line,
+ CompileEnv *envPtr)
+{
+ Tcl_Token *endTokenPtr, *tokenPtr;
+ int breakOffset = 0, count = 0, bline = line;
+ Tcl_Parse parse;
+ Tcl_InterpState state = NULL;
+
+ TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
+ if (state != NULL) {
+ Tcl_ResetResult(interp);
+ }
+
+ /*
+ * Tricky point! If the first token does not result in a *guaranteed* push
+ * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
+ * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
+ * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
+ * identifying a script that could trigger this case.
+ */
+
+ tokenPtr = parse.tokenPtr;
+ if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
+ PUSH("");
+ count++;
+ }
+
+ for (endTokenPtr = tokenPtr + parse.numTokens;
+ tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
+ int length, literal, catchRange, breakJump;
+ char buf[TCL_UTF_MAX];
+ JumpFixup startFixup, okFixup, returnFixup, breakFixup;
+ JumpFixup continueFixup, otherFixup, endFixup;
+
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ literal = TclRegisterNewLiteral(envPtr,
+ tokenPtr->start, tokenPtr->size);
+ TclEmitPush(literal, envPtr);
+ TclAdvanceLines(&bline, tokenPtr->start,
+ tokenPtr->start + tokenPtr->size);
+ count++;
+ continue;
+ case TCL_TOKEN_BS:
+ 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) {
+ OP1( STR_CONCAT1, 255);
+ count -= 254;
+ }
+ if (count > 1) {
+ OP1( STR_CONCAT1, count);
+ count = 1;
+ }
+
+ if (breakOffset == 0) {
+ /* Jump to the start (jump over the jump to end) */
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup);
+
+ /* Jump to the end (all BREAKs land here) */
+ breakOffset = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+
+ /* Start */
+ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
+ (int) (CurrentOffset(envPtr) - startFixup.codeOffset));
+ }
+ }
+
+ envPtr->line = bline;
+ catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, catchRange);
+ ExceptionRangeStarts(envPtr, catchRange);
+
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_COMMAND:
+ TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2,
+ envPtr);
+ count++;
+ break;
+ case TCL_TOKEN_VARIABLE:
+ TclCompileVarSubst(interp, tokenPtr, envPtr);
+ count++;
+ break;
+ default:
+ Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d",
+ tokenPtr->type);
+ }
+
+ ExceptionRangeEnds(envPtr, catchRange);
+
+ /* Substitution produced TCL_OK */
+ OP( END_CATCH);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
+ TclAdjustStackDepth(-1, envPtr);
+
+ /* Exceptional return codes processed here */
+ ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( RETURN_CODE_BRANCH);
+
+ /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
+ OP( RETURN_STK);
+ OP( NOP);
+
+ /* RETURN */
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
+
+ /* BREAK */
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup);
+
+ /* CONTINUE */
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup);
+
+ /* OTHER */
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);
+
+ TclAdjustStackDepth(1, envPtr);
+ /* BREAK destination */
+ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
+ (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
+ }
+ OP( POP);
+ OP( POP);
+
+ breakJump = CurrentOffset(envPtr) - breakOffset;
+ if (breakJump > 127) {
+ OP4(JUMP4, -breakJump);
+ } else {
+ OP1(JUMP1, -breakJump);
+ }
+
+ TclAdjustStackDepth(2, envPtr);
+ /* CONTINUE destination */
+ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
+ (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
+ }
+ OP( POP);
+ OP( POP);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
+
+ TclAdjustStackDepth(2, envPtr);
+ /* RETURN + other destination */
+ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
+ (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
+ }
+ if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
+ (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
+ }
+
+ /*
+ * Pull the result to top of stack, discard options dict.
+ */
+
+ OP4( REVERSE, 2);
+ OP( POP);
+
+ /* OK destination */
+ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
+ (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
+ }
+ if (count > 1) {
+ OP1(STR_CONCAT1, count);
+ count = 1;
+ }
+
+ /* CONTINUE jump to here */
+ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
+ Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
+ (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
+ }
+ bline = envPtr->line;
+ }
+
+ while (count > 255) {
+ OP1( STR_CONCAT1, 255);
+ count -= 254;
+ }
+ if (count > 1) {
+ OP1( STR_CONCAT1, count);
+ }
+
+ Tcl_FreeParse(&parse);
+
+ if (state != NULL) {
+ Tcl_RestoreInterpState(interp, state);
+ TclCompileSyntaxError(interp, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+
+ /* Final target of the multi-jump from all BREAKs */
+ if (breakOffset > 0) {
+ TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
+ envPtr->codeStart + breakOffset);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSwitchCmd --
+ *
+ * Procedure called to compile the "switch" command.
+ *
+ * Results:
+ * Returns TCL_OK for successful compile, or TCL_ERROR to defer
+ * evaluation to runtime (either when it is too complex to get the
+ * semantics right, or when we know for sure that it is an error but need
+ * the error to happen at the right time).
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "switch" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSwitchCmd(
+ 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; /* 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
+ * items. */
+ 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 i, valueIndex;
+ int result = TCL_ERROR;
+ DefineLineInformation; /* TIP #280 */
+ int *clNext = envPtr->clNext;
+
+ /*
+ * Only handle the following versions:
+ * switch ?--? word {pattern body ...}
+ * switch -exact ?--? word {pattern body ...}
+ * switch -glob ?--? word {pattern body ...}
+ * switch -regexp ?--? word {pattern body ...}
+ * switch -- word simpleWordPattern simpleWordBody ...
+ * switch -exact -- word simpleWordPattern simpleWordBody ...
+ * switch -glob -- word simpleWordPattern simpleWordBody ...
+ * switch -regexp -- word simpleWordPattern simpleWordBody ...
+ * When the mode is -glob, can also handle a -nocase flag.
+ *
+ * First off, we don't care how the command's word was generated; we're
+ * compiling it anyway! So skip it...
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ valueIndex = 1;
+ numWords = parsePtr->numWords-1;
+
+ /*
+ * Check for options.
+ */
+
+ noCase = 0;
+ mode = Switch_Exact;
+ if (numWords == 2) {
+ /*
+ * There's just the switch value and the bodies list. In that case, we
+ * can skip all option parsing and move on to consider switch values
+ * and the body list.
+ */
+
+ goto finishedOptionParse;
+ }
+
+ /*
+ * There must be at least one option, --, because without that there is no
+ * way to statically avoid the problems you get from strings-to-be-matched
+ * that start with a - (the interpreted code falls apart if it encounters
+ * them, so we punt if we *might* encounter them as that is the easiest
+ * way of emulating the behaviour).
+ */
+
+ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
+ register unsigned size = tokenPtr[1].size;
+ register const char *chrs = tokenPtr[1].start;
+
+ /*
+ * We only process literal options, and we assume that -e, -g and -n
+ * are unique prefixes of -exact, -glob and -nocase respectively (true
+ * at time of writing). Note that -exact and -glob may only be given
+ * at most once or we bail out (error case).
+ */
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
+ return TCL_ERROR;
+ }
+
+ if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
+ if (foundMode) {
+ return TCL_ERROR;
+ }
+ mode = Switch_Exact;
+ foundMode = 1;
+ valueIndex++;
+ continue;
+ } else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
+ if (foundMode) {
+ return TCL_ERROR;
+ }
+ mode = Switch_Glob;
+ foundMode = 1;
+ valueIndex++;
+ continue;
+ } else if ((size <= 7) && !memcmp(chrs, "-regexp", size)) {
+ if (foundMode) {
+ return TCL_ERROR;
+ }
+ mode = Switch_Regexp;
+ foundMode = 1;
+ valueIndex++;
+ continue;
+ } else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
+ noCase = 1;
+ valueIndex++;
+ continue;
+ } else if ((size == 2) && !memcmp(chrs, "--", 2)) {
+ valueIndex++;
+ break;
+ }
+
+ /*
+ * The switch command has many flags we cannot compile at all (e.g.
+ * all the RE-related ones) which we must have encountered. Either
+ * that or we have run off the end. The action here is the same: punt
+ * to interpreted version.
+ */
+
+ return TCL_ERROR;
+ }
+ if (numWords < 3) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ numWords--;
+ if (noCase && (mode == Switch_Exact)) {
+ /*
+ * Can't compile this case; no opcode for case-insensitive equality!
+ */
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * The value to test against is going to always get pushed on the stack.
+ * But not yet; we need to verify that the rest of the command is
+ * compilable too.
+ */
+
+ finishedOptionParse:
+ valueTokenPtr = tokenPtr;
+ /* For valueIndex, see previous loop. */
+ tokenPtr = TokenAfter(tokenPtr);
+ numWords--;
+
+ /*
+ * Build an array of tokens for the matcher terms and script bodies. Note
+ * that in the case of the quoted bodies, this is tricky as we cannot use
+ * copies of the string from the input token for the generated tokens (it
+ * causes a crash during exception handling). When multiple tokens are
+ * available at this point, this is pretty easy.
+ */
+
+ if (numWords == 1) {
+ 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. */
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ bytes = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+
+ /* Allocate enough space to work in. */
+ maxLen = TclMaxListLength(bytes, numBytes, NULL);
+ if (maxLen < 2) {
+ return TCL_ERROR;
+ }
+ 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];
+ numWords = 0;
+
+ while (numBytes > 0) {
+ const char *prevBytes = bytes;
+ int literal;
+
+ 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, prevBytes, bodyTokenArray[numWords].start);
+ TclAdvanceContinuations(&bline, &clNext,
+ 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.
+ * Both are error cases, so punt and let the interpreted-version
+ * generate the error message. Note that the second case probably
+ * should get caught earlier, but it's easy to check here again anyway
+ * because it'd cause a nasty crash otherwise.
+ */
+
+ return TCL_ERROR;
+ } else {
+ /*
+ * Multi-word definition of patterns & actions.
+ */
+
+ bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords);
+ bodyLines = ckalloc(sizeof(int) * numWords);
+ bodyContLines = ckalloc(sizeof(int*) * numWords);
+ bodyTokenArray = NULL;
+ for (i=0 ; i<numWords ; i++) {
+ /*
+ * We only handle the very simplest case. Anything more complex is
+ * a good reason to go to the interpreted case anyway due to
+ * traces, etc.
+ */
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ goto freeTemporaries;
+ }
+ bodyToken[i] = tokenPtr+1;
+
+ /*
+ * TIP #280: Copy line information from regular cmd info.
+ */
+
+ bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
+ bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ }
+
+ /*
+ * Fall back to interpreted if the last body is a continuation (it's
+ * illegal, but this makes the error happen at the right time).
+ */
+
+ if (bodyToken[numWords-1]->size == 1 &&
+ bodyToken[numWords-1]->start[0] == '-') {
+ goto freeTemporaries;
+ }
+
+ /*
+ * Now we commit to generating code; the parsing stage per se is done.
+ * Check if we can generate a jump table, since if so that's faster than
+ * doing an explicit compare with each body. Note that we're definitely
+ * over-conservative with determining whether we can do the jump table,
+ * but it handles the most common case well enough.
+ */
+
+ /* Both methods push the value to match against onto the stack. */
+ CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
+
+ if (mode == Switch_Exact) {
+ IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
+ bodyLines, bodyContLines);
+ } else {
+ IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex,
+ numWords, bodyToken, bodyLines, bodyContLines);
+ }
+ result = TCL_OK;
+
+ /*
+ * Clean up all our temporary space and return.
+ */
+
+ freeTemporaries:
+ ckfree(bodyToken);
+ ckfree(bodyLines);
+ ckfree(bodyContLines);
+ if (bodyTokenArray != NULL) {
+ ckfree(bodyTokenArray);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IssueSwitchChainedTests --
+ *
+ * Generate instructions for a [switch] command that is to be compiled
+ * into a sequence of tests. This is the generic handle-everything mode
+ * that inherently has performance that is (on average) linear in the
+ * number of tests. It is the only mode that can handle -glob and -regexp
+ * matches, or anything that is case-insensitive. It does not handle the
+ * wild-and-wooly end of regexp matching (i.e., capture of match results)
+ * so that's when we spill to the interpreted version.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IssueSwitchChainedTests(
+ Tcl_Interp *interp, /* Context for compiling script bodies. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int mode, /* Exact, Glob or Regexp */
+ int noCase, /* Case-insensitivity flag. */
+ int valueIndex, /* The value to match against. */
+ int numBodyTokens, /* Number of tokens describing things the
+ * switch can match against and bodies to
+ * execute when the match succeeds. */
+ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
+ int *bodyLines, /* Array of line numbers for body list
+ * items. */
+ int **bodyContLines) /* Array of continuation line info. */
+{
+ enum {Switch_Exact, Switch_Glob, Switch_Regexp};
+ int foundDefault; /* Flag to indicate whether a "default" clause
+ * is present. */
+ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */
+ int *fixupTargetArray; /* Array of places for fixups to point at. */
+ int fixupCount; /* Number of places to fix up. */
+ int contFixIndex; /* Where the first of the jumps due to a group
+ * of continuation bodies starts, or -1 if
+ * there aren't any. */
+ int contFixCount; /* Number of continuation bodies pointing to
+ * the current (or next) real body. */
+ int nextArmFixupIndex;
+ int simple, exact; /* For extracting the type of regexp. */
+ int i;
+
+ /*
+ * Generate a test for each arm.
+ */
+
+ contFixIndex = -1;
+ contFixCount = 0;
+ fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
+ fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens);
+ memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
+ fixupCount = 0;
+ foundDefault = 0;
+ for (i=0 ; i<numBodyTokens ; i+=2) {
+ nextArmFixupIndex = -1;
+ if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
+ memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
+ /*
+ * Generate the test for the arm.
+ */
+
+ switch (mode) {
+ case Switch_Exact:
+ OP( DUP);
+ TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+ OP( STR_EQ);
+ break;
+ case Switch_Glob:
+ TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+ OP4( OVER, 1);
+ OP1( STR_MATCH, noCase);
+ break;
+ case Switch_Regexp:
+ simple = exact = 0;
+
+ /*
+ * Keep in sync with TclCompileRegexpCmd.
+ */
+
+ if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
+ Tcl_DString ds;
+
+ if (bodyToken[i]->size == 0) {
+ /*
+ * The semantics of regexps are that they always match
+ * when the RE == "".
+ */
+
+ PUSH("1");
+ break;
+ }
+
+ /*
+ * Attempt to convert pattern to glob. If successful, push
+ * the converted pattern.
+ */
+
+ if (TclReToGlob(NULL, bodyToken[i]->start,
+ bodyToken[i]->size, &ds, &exact) == TCL_OK) {
+ simple = 1;
+ PushLiteral(envPtr, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+ if (!simple) {
+ TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+ }
+
+ OP4( OVER, 1);
+ if (!simple) {
+ /*
+ * Pass correct RE compile flags. We use only Int1
+ * (8-bit), but that handles all the flags we want to
+ * pass. Don't use TCL_REG_NOSUB as we may have backrefs
+ * or capture vars.
+ */
+
+ int cflags = TCL_REG_ADVANCED
+ | (noCase ? TCL_REG_NOCASE : 0);
+
+ OP1(REGEXP, cflags);
+ } else if (exact && !noCase) {
+ OP( STR_EQ);
+ } else {
+ OP1(STR_MATCH, noCase);
+ }
+ break;
+ default:
+ Tcl_Panic("unknown switch mode: %d", mode);
+ }
+
+ /*
+ * In a fall-through case, we will jump on _true_ to the place
+ * where the body starts (generated later, with guarantee of this
+ * ensured earlier; the final body is never a fall-through).
+ */
+
+ if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
+ if (contFixIndex == -1) {
+ contFixIndex = fixupCount;
+ contFixCount = 0;
+ }
+ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
+ &fixupArray[contFixIndex+contFixCount]);
+ fixupCount++;
+ contFixCount++;
+ continue;
+ }
+
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+ &fixupArray[fixupCount]);
+ nextArmFixupIndex = fixupCount;
+ fixupCount++;
+ } else {
+ /*
+ * Got a default clause; set a flag to inhibit the generation of
+ * the jump after the body and the cleanup of the intermediate
+ * value that we are switching against.
+ *
+ * Note that default clauses (which are always terminal clauses)
+ * cannot be fall-through clauses as well, since the last clause
+ * is never a fall-through clause (which we have already
+ * verified).
+ */
+
+ foundDefault = 1;
+ }
+
+ /*
+ * Generate the body for the arm. This is guaranteed not to be a
+ * fall-through case, but it might have preceding fall-through cases,
+ * so we must process those first.
+ */
+
+ if (contFixIndex != -1) {
+ int j;
+
+ for (j=0 ; j<contFixCount ; j++) {
+ fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
+ }
+ contFixIndex = -1;
+ }
+
+ /*
+ * Now do the actual compilation. Note that we do not use BODY()
+ * because we may have synthesized the tokens in a non-standard
+ * pattern.
+ */
+
+ OP( POP);
+ envPtr->line = bodyLines[i+1]; /* TIP #280 */
+ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
+ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
+
+ if (!foundDefault) {
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &fixupArray[fixupCount]);
+ fixupCount++;
+ fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
+ }
+ }
+
+ /*
+ * Discard the value we are matching against unless we've had a default
+ * clause (in which case it will already be gone due to the code at the
+ * start of processing an arm, guaranteed) and make the result of the
+ * command an empty string.
+ */
+
+ if (!foundDefault) {
+ OP( POP);
+ PUSH("");
+ }
+
+ /*
+ * Do jump fixups for arms that were executed. First, fill in the jumps of
+ * all jumps that don't point elsewhere to point to here.
+ */
+
+ for (i=0 ; i<fixupCount ; i++) {
+ if (fixupTargetArray[i] == 0) {
+ fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
+ }
+ }
+
+ /*
+ * Now scan backwards over all the jumps (all of which are forward jumps)
+ * doing each one. When we do one and there is a size changes, we must
+ * scan back over all the previous ones and see if they need adjusting
+ * before proceeding with further jump fixups (the interleaved nature of
+ * all the jumps makes this impossible to do without nested loops).
+ */
+
+ for (i=fixupCount-1 ; i>=0 ; i--) {
+ if (TclFixupForwardJump(envPtr, &fixupArray[i],
+ fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
+ int j;
+
+ for (j=i-1 ; j>=0 ; j--) {
+ if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
+ fixupTargetArray[j] += 3;
+ }
+ }
+ }
+ }
+ TclStackFree(interp, fixupTargetArray);
+ TclStackFree(interp, fixupArray);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IssueSwitchJumpTable --
+ *
+ * Generate instructions for a [switch] command that is to be compiled
+ * into a jump table. This only handles the case where case-sensitive,
+ * exact matching is used, but this is actually the most common case in
+ * real code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IssueSwitchJumpTable(
+ Tcl_Interp *interp, /* Context for compiling script bodies. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int valueIndex, /* The value to match against. */
+ int numBodyTokens, /* Number of tokens describing things the
+ * switch can match against and bodies to
+ * execute when the match succeeds. */
+ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
+ int *bodyLines, /* Array of line numbers for body list
+ * items. */
+ int **bodyContLines) /* Array of continuation line info. */
+{
+ JumptableInfo *jtPtr;
+ int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
+ int mustGenerate, foundDefault, jumpToDefault, i;
+ Tcl_DString buffer;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * Compile the switch by using a jump table, which is basically a
+ * hashtable that maps from literal values to match against to the offset
+ * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
+ * table itself is independent of any invokation of the bytecode, and as
+ * such is stored in an auxData block.
+ *
+ * Start by allocating the jump table itself, plus some workspace.
+ */
+
+ jtPtr = ckalloc(sizeof(JumptableInfo));
+ Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
+ infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
+ finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
+ foundDefault = 0;
+ mustGenerate = 1;
+
+ /*
+ * Next, issue the instruction to do the jump, together with what we want
+ * to do if things do not work out (jump to either the default clause or
+ * the "default" default, which just sets the result to empty). Note that
+ * we will come back and rewrite the jump's offset parameter when we know
+ * what it should be, and that all jumps we issue are of the wide kind
+ * because that makes the code much easier to debug!
+ */
+
+ jumpLocation = CurrentOffset(envPtr);
+ OP4( JUMP_TABLE, infoIndex);
+ jumpToDefault = CurrentOffset(envPtr);
+ OP4( JUMP4, 0);
+
+ for (i=0 ; i<numBodyTokens ; i+=2) {
+ /*
+ * For each arm, we must first work out what to do with the match
+ * term.
+ */
+
+ if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
+ memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
+ /*
+ * This is not a default clause, so insert the current location as
+ * a target in the jump table (assuming it isn't already there,
+ * which would indicate that this clause is probably masked by an
+ * earlier one). Note that we use a Tcl_DString here simply
+ * because the hash API does not let us specify the string length.
+ */
+
+ Tcl_DStringInit(&buffer);
+ TclDStringAppendToken(&buffer, bodyToken[i]);
+ hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
+ Tcl_DStringValue(&buffer), &isNew);
+ if (isNew) {
+ /*
+ * First time we've encountered this match clause, so it must
+ * point to here.
+ */
+
+ Tcl_SetHashValue(hPtr, CurrentOffset(envPtr) - jumpLocation);
+ }
+ Tcl_DStringFree(&buffer);
+ } else {
+ /*
+ * This is a default clause, so patch up the fallthrough from the
+ * INST_JUMP_TABLE instruction to here.
+ */
+
+ foundDefault = 1;
+ isNew = 1;
+ TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+ envPtr->codeStart+jumpToDefault+1);
+ }
+
+ /*
+ * Now, for each arm we must deal with the body of the clause.
+ *
+ * If this is a continuation body (never true of a final clause,
+ * whether default or not) we're done because the next jump target
+ * will also point here, so we advance to the next clause.
+ */
+
+ if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
+ mustGenerate = 1;
+ continue;
+ }
+
+ /*
+ * Also skip this arm if its only match clause is masked. (We could
+ * probably be more aggressive about this, but that would be much more
+ * difficult to get right.)
+ */
+
+ if (!isNew && !mustGenerate) {
+ continue;
+ }
+ mustGenerate = 0;
+
+ /*
+ * Compile the body of the arm.
+ */
+
+ envPtr->line = bodyLines[i+1]; /* TIP #280 */
+ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
+ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
+
+ /*
+ * Compile a jump in to the end of the command if this body is
+ * anything other than a user-supplied default arm (to either skip
+ * over the remaining bodies or the code that generates an empty
+ * result).
+ */
+
+ if (i+2 < numBodyTokens || !foundDefault) {
+ finalFixups[numRealBodies++] = CurrentOffset(envPtr);
+
+ /*
+ * Easier by far to issue this jump as a fixed-width jump, since
+ * otherwise we'd need to do a lot more (and more awkward)
+ * rewriting when we fixed this all up.
+ */
+
+ OP4( JUMP4, 0);
+ TclAdjustStackDepth(-1, envPtr);
+ }
+ }
+
+ /*
+ * We're at the end. If we've not already done so through the processing
+ * of a user-supplied default clause, add in a "default" default clause
+ * now.
+ */
+
+ if (!foundDefault) {
+ TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+ envPtr->codeStart+jumpToDefault+1);
+ PUSH("");
+ }
+
+ /*
+ * No more instructions to be issued; everything that needs to jump to the
+ * end of the command is fixed up at this point.
+ */
+
+ for (i=0 ; i<numRealBodies ; i++) {
+ TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
+ envPtr->codeStart+finalFixups[i]+1);
+ }
+
+ /*
+ * Clean up all our temporary space and return.
+ */
+
+ TclStackFree(interp, finalFixups);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupJumptableInfo, FreeJumptableInfo --
+ *
+ * Functions to duplicate, release and print a jump-table created for use
+ * with the INST_JUMP_TABLE instruction.
+ *
+ * Results:
+ * DupJumptableInfo: a copy of the jump-table
+ * FreeJumptableInfo: none
+ * PrintJumptableInfo: none
+ *
+ * Side effects:
+ * DupJumptableInfo: allocates memory
+ * FreeJumptableInfo: releases memory
+ * PrintJumptableInfo: none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupJumptableInfo(
+ ClientData clientData)
+{
+ JumptableInfo *jtPtr = clientData;
+ JumptableInfo *newJtPtr = ckalloc(sizeof(JumptableInfo));
+ Tcl_HashEntry *hPtr, *newHPtr;
+ Tcl_HashSearch search;
+ int isNew;
+
+ Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
+ hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+ while (hPtr != NULL) {
+ newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
+ Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
+ Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
+ }
+ return newJtPtr;
+}
+
+static void
+FreeJumptableInfo(
+ ClientData clientData)
+{
+ JumptableInfo *jtPtr = clientData;
+
+ Tcl_DeleteHashTable(&jtPtr->hashTable);
+ ckfree(jtPtr);
+}
+
+static void
+PrintJumptableInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register JumptableInfo *jtPtr = clientData;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ const char *keyPtr;
+ int offset, i = 0;
+
+ hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+ for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+ keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+ offset = PTR2INT(Tcl_GetHashValue(hPtr));
+
+ if (i++) {
+ Tcl_AppendToObj(appendObj, ", ", -1);
+ if (i%4==0) {
+ Tcl_AppendToObj(appendObj, "\n\t\t", -1);
+ }
+ }
+ Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
+ keyPtr, pcOffset + offset);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
+
+ /* make room for the nsObjPtr */
+ /* TODO: Doesn't this have to be a known value? */
+ CompileWord(envPtr, tokenPtr, interp, 0);
+ for (i=1 ; i<parsePtr->numWords ; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+ TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileThrowCmd --
+ *
+ * Procedure called to compile the "throw" 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 "throw" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileThrowCmd(
+ 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 */
+ int numWords = parsePtr->numWords;
+ Tcl_Token *codeToken, *msgToken;
+ Tcl_Obj *objPtr;
+ int codeKnown, codeIsList, codeIsValid, len;
+
+ if (numWords != 3) {
+ return TCL_ERROR;
+ }
+ codeToken = TokenAfter(parsePtr->tokenPtr);
+ msgToken = TokenAfter(codeToken);
+
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+
+ codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);
+
+ /*
+ * First we must emit the code to substitute the arguments. This
+ * must come first in case substitution raises errors.
+ */
+ if (!codeKnown) {
+ CompileWord(envPtr, codeToken, interp, 1);
+ PUSH( "-errorcode");
+ }
+ CompileWord(envPtr, msgToken, interp, 2);
+
+ codeIsList = codeKnown && (TCL_OK ==
+ Tcl_ListObjLength(interp, objPtr, &len));
+ codeIsValid = codeIsList && (len != 0);
+
+ if (codeIsValid) {
+ Tcl_Obj *errPtr, *dictPtr;
+
+ TclNewLiteralStringObj(errPtr, "-errorcode");
+ TclNewObj(dictPtr);
+ Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr);
+ }
+ TclDecrRefCount(objPtr);
+
+ /*
+ * Simpler bytecodes when we detect invalid arguments at compile time.
+ */
+ if (codeKnown && !codeIsValid) {
+ OP( POP);
+ if (codeIsList) {
+ /* Must be an empty list */
+ goto issueErrorForEmptyCode;
+ }
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
+ }
+
+ if (!codeKnown) {
+ /*
+ * Argument validity checking has to be done by bytecode at
+ * run time.
+ */
+ OP4( REVERSE, 3);
+ OP( DUP);
+ OP( LIST_LENGTH);
+ OP1( JUMP_FALSE1, 16);
+ OP4( LIST, 2);
+ OP44( RETURN_IMM, TCL_ERROR, 0);
+ TclAdjustStackDepth(2, envPtr);
+ OP( POP);
+ OP( POP);
+ OP( POP);
+ issueErrorForEmptyCode:
+ PUSH( "type must be non-empty list");
+ PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}");
+ }
+ OP44( RETURN_IMM, TCL_ERROR, 0);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileTryCmd --
+ *
+ * Procedure called to compile the "try" 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 "try" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileTryCmd(
+ 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 numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR;
+ Tcl_Token *bodyToken, *finallyToken, *tokenPtr;
+ Tcl_Token **handlerTokens = NULL;
+ Tcl_Obj **matchClauses = NULL;
+ int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL;
+ int i;
+
+ if (numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ bodyToken = TokenAfter(parsePtr->tokenPtr);
+
+ if (numWords == 2) {
+ /*
+ * No handlers or finally; do nothing beyond evaluating the body.
+ */
+
+ DefineLineInformation; /* TIP #280 */
+ BODY(bodyToken, 1);
+ return TCL_OK;
+ }
+
+ numWords -= 2;
+ tokenPtr = TokenAfter(bodyToken);
+
+ /*
+ * Extract information about what handlers there are.
+ */
+
+ numHandlers = numWords >> 2;
+ numWords -= numHandlers * 4;
+ if (numHandlers > 0) {
+ handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
+ matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
+ memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
+ matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
+ resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
+ optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
+
+ for (i=0 ; i<numHandlers ; i++) {
+ Tcl_Obj *tmpObj, **objv;
+ int objc;
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ goto failedToCompile;
+ }
+ if (tokenPtr[1].size == 4
+ && !strncmp(tokenPtr[1].start, "trap", 4)) {
+ /*
+ * Parse the list of errorCode words to match against.
+ */
+
+ matchCodes[i] = TCL_ERROR;
+ tokenPtr = TokenAfter(tokenPtr);
+ TclNewObj(tmpObj);
+ Tcl_IncrRefCount(tmpObj);
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
+ || Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK
+ || (objc == 0)) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
+ matchClauses[i] = tmpObj;
+ } else if (tokenPtr[1].size == 2
+ && !strncmp(tokenPtr[1].start, "on", 2)) {
+ int code;
+
+ /*
+ * Parse the result code to look for.
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ TclNewObj(tmpObj);
+ Tcl_IncrRefCount(tmpObj);
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ if (TCL_ERROR == TclGetCompletionCodeFromObj(NULL, tmpObj, &code)) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ matchCodes[i] = code;
+ TclDecrRefCount(tmpObj);
+ } else {
+ goto failedToCompile;
+ }
+
+ /*
+ * Parse the variable binding.
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ TclNewObj(tmpObj);
+ Tcl_IncrRefCount(tmpObj);
+ if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
+ || (objc > 2)) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ if (objc > 0) {
+ int len;
+ const char *varname = Tcl_GetStringFromObj(objv[0], &len);
+
+ resultVarIndices[i] = LocalScalar(varname, len, envPtr);
+ if (resultVarIndices[i] < 0) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ } else {
+ resultVarIndices[i] = -1;
+ }
+ if (objc == 2) {
+ int len;
+ const char *varname = Tcl_GetStringFromObj(objv[1], &len);
+
+ optionVarIndices[i] = LocalScalar(varname, len, envPtr);
+ if (optionVarIndices[i] < 0) {
+ TclDecrRefCount(tmpObj);
+ goto failedToCompile;
+ }
+ } else {
+ optionVarIndices[i] = -1;
+ }
+ TclDecrRefCount(tmpObj);
+
+ /*
+ * Extract the body for this handler.
+ */
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ goto failedToCompile;
+ }
+ if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
+ handlerTokens[i] = NULL;
+ } else {
+ handlerTokens[i] = tokenPtr;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ if (handlerTokens[numHandlers-1] == NULL) {
+ goto failedToCompile;
+ }
+ }
+
+ /*
+ * Parse the finally clause
+ */
+
+ if (numWords == 0) {
+ finallyToken = NULL;
+ } else if (numWords == 2) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
+ || strncmp(tokenPtr[1].start, "finally", 7)) {
+ goto failedToCompile;
+ }
+ finallyToken = TokenAfter(tokenPtr);
+ } else {
+ goto failedToCompile;
+ }
+
+ /*
+ * Issue the bytecode.
+ */
+
+ if (!finallyToken) {
+ result = IssueTryClausesInstructions(interp, envPtr, bodyToken,
+ numHandlers, matchCodes, matchClauses, resultVarIndices,
+ optionVarIndices, handlerTokens);
+ } else if (numHandlers == 0) {
+ result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
+ finallyToken);
+ } else {
+ result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken,
+ numHandlers, matchCodes, matchClauses, resultVarIndices,
+ optionVarIndices, handlerTokens, finallyToken);
+ }
+
+ /*
+ * Delete any temporary state and finish off.
+ */
+
+ failedToCompile:
+ if (numHandlers > 0) {
+ for (i=0 ; i<numHandlers ; i++) {
+ if (matchClauses[i]) {
+ TclDecrRefCount(matchClauses[i]);
+ }
+ }
+ TclStackFree(interp, optionVarIndices);
+ TclStackFree(interp, resultVarIndices);
+ TclStackFree(interp, matchCodes);
+ TclStackFree(interp, matchClauses);
+ TclStackFree(interp, handlerTokens);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IssueTryClausesInstructions, IssueTryClausesFinallyInstructions,
+ * IssueTryFinallyInstructions --
+ *
+ * The code generators for [try]. Split from the parsing engine for
+ * reasons of developer sanity, and also split between no-finally,
+ * just-finally and with-finally cases because so many of the details of
+ * generation vary between the three.
+ *
+ * The macros below make the instruction issuing easier to follow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IssueTryClausesInstructions(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr,
+ Tcl_Token *bodyToken,
+ int numHandlers,
+ int *matchCodes,
+ Tcl_Obj **matchClauses,
+ int *resultVars,
+ int *optionVars,
+ Tcl_Token **handlerTokens)
+{
+ DefineLineInformation; /* TIP #280 */
+ int range, resultVar, optionsVar;
+ int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
+ int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+ int *noError;
+ char buf[TCL_INTEGER_SPACE];
+
+ resultVar = AnonymousLocal(envPtr);
+ optionsVar = AnonymousLocal(envPtr);
+ if (resultVar < 0 || optionsVar < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check if we're supposed to trap a normal TCL_OK completion of the body.
+ * If not, we can handle that case much more efficiently.
+ */
+
+ for (i=0 ; i<numHandlers ; i++) {
+ if (matchCodes[i] == 0) {
+ trapZero = 1;
+ break;
+ }
+ }
+
+ /*
+ * Compile the body, trapping any error in it so that we can trap on it
+ * and/or run a finally clause. Note that there must be at least one
+ * on/trap clause; when none is present, this whole function is not called
+ * (and it's never called when there's a finally clause).
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( bodyToken, 1);
+ ExceptionRangeEnds(envPtr, range);
+ if (!trapZero) {
+ OP( END_CATCH);
+ JUMP4( JUMP, afterBody);
+ TclAdjustStackDepth(-1, envPtr);
+ } else {
+ PUSH( "0");
+ OP4( REVERSE, 2);
+ OP1( JUMP1, 4);
+ TclAdjustStackDepth(-2, envPtr);
+ }
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RETURN_CODE);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( END_CATCH);
+ STORE( optionsVar);
+ OP( POP);
+ STORE( resultVar);
+ OP( POP);
+
+ /*
+ * Now we handle all the registered 'on' and 'trap' handlers in order.
+ * For us to be here, there must be at least one handler.
+ *
+ * Slight overallocation, but reduces size of this function.
+ */
+
+ addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+ forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+ noError = TclStackAlloc(interp, sizeof(int)*numHandlers);
+
+ for (i=0 ; i<numHandlers ; i++) {
+ noError[i] = -1;
+ sprintf(buf, "%d", matchCodes[i]);
+ OP( DUP);
+ PushLiteral(envPtr, buf, strlen(buf));
+ OP( EQ);
+ JUMP4( JUMP_FALSE, notCodeJumpSource);
+ if (matchClauses[i]) {
+ const char *p;
+ Tcl_ListObjLength(NULL, matchClauses[i], &len);
+
+ /*
+ * Match the errorcode according to try/trap rules.
+ */
+
+ LOAD( optionsVar);
+ PUSH( "-errorcode");
+ OP4( DICT_GET, 1);
+ TclAdjustStackDepth(-1, envPtr);
+ OP44( LIST_RANGE_IMM, 0, len-1);
+ p = Tcl_GetStringFromObj(matchClauses[i], &len);
+ PushLiteral(envPtr, p, len);
+ OP( STR_EQ);
+ JUMP4( JUMP_FALSE, notECJumpSource);
+ } else {
+ notECJumpSource = -1; /* LINT */
+ }
+ OP( POP);
+
+ /*
+ * There is no finally clause, so we can avoid wrapping a catch
+ * context around the handler. That simplifies what instructions need
+ * to be issued a lot since we can let errors just fall through.
+ */
+
+ if (resultVars[i] >= 0) {
+ LOAD( resultVar);
+ STORE( resultVars[i]);
+ OP( POP);
+ if (optionVars[i] >= 0) {
+ LOAD( optionsVar);
+ STORE( optionVars[i]);
+ OP( POP);
+ }
+ }
+ if (!handlerTokens[i]) {
+ forwardsNeedFixing = 1;
+ JUMP4( JUMP, forwardsToFix[i]);
+ } else {
+ int dontChangeOptions;
+
+ forwardsToFix[i] = -1;
+ if (forwardsNeedFixing) {
+ forwardsNeedFixing = 0;
+ for (j=0 ; j<i ; j++) {
+ if (forwardsToFix[j] == -1) {
+ continue;
+ }
+ FIXJUMP4(forwardsToFix[j]);
+ forwardsToFix[j] = -1;
+ }
+ }
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( handlerTokens[i], 5+i*4);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ JUMP4( JUMP, noError[i]);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclAdjustStackDepth(-1, envPtr);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, dontChangeOptions);
+ LOAD( optionsVar);
+ OP4( REVERSE, 2);
+ STORE( optionsVar);
+ OP( POP);
+ PUSH( "-during");
+ OP4( REVERSE, 2);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ FIXJUMP1( dontChangeOptions);
+ OP4( REVERSE, 2);
+ INVOKE( RETURN_STK);
+ }
+
+ JUMP4( JUMP, addrsToFix[i]);
+ if (matchClauses[i]) {
+ FIXJUMP4( notECJumpSource);
+ }
+ FIXJUMP4( notCodeJumpSource);
+ }
+
+ /*
+ * Drop the result code since it didn't match any clause, and reissue the
+ * exception. Note also that INST_RETURN_STK can proceed to the next
+ * instruction.
+ */
+
+ OP( POP);
+ LOAD( optionsVar);
+ LOAD( resultVar);
+ INVOKE( RETURN_STK);
+
+ /*
+ * Fix all the jumps from taken clauses to here (which is the end of the
+ * [try]).
+ */
+
+ if (!trapZero) {
+ FIXJUMP4(afterBody);
+ }
+ for (i=0 ; i<numHandlers ; i++) {
+ FIXJUMP4(addrsToFix[i]);
+ if (noError[i] != -1) {
+ FIXJUMP4(noError[i]);
+ }
+ }
+ TclStackFree(interp, noError);
+ TclStackFree(interp, forwardsToFix);
+ TclStackFree(interp, addrsToFix);
+ return TCL_OK;
+}
+
+static int
+IssueTryClausesFinallyInstructions(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr,
+ Tcl_Token *bodyToken,
+ int numHandlers,
+ int *matchCodes,
+ Tcl_Obj **matchClauses,
+ int *resultVars,
+ int *optionVars,
+ Tcl_Token **handlerTokens,
+ Tcl_Token *finallyToken) /* Not NULL */
+{
+ DefineLineInformation; /* TIP #280 */
+ int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
+ int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
+ int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+ char buf[TCL_INTEGER_SPACE];
+
+ resultVar = AnonymousLocal(envPtr);
+ optionsVar = AnonymousLocal(envPtr);
+ if (resultVar < 0 || optionsVar < 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check if we're supposed to trap a normal TCL_OK completion of the body.
+ * If not, we can handle that case much more efficiently.
+ */
+
+ for (i=0 ; i<numHandlers ; i++) {
+ if (matchCodes[i] == 0) {
+ trapZero = 1;
+ break;
+ }
+ }
+
+ /*
+ * Compile the body, trapping any error in it so that we can trap on it
+ * (if any trap matches) and run a finally clause.
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( bodyToken, 1);
+ ExceptionRangeEnds(envPtr, range);
+ if (!trapZero) {
+ OP( END_CATCH);
+ STORE( resultVar);
+ OP( POP);
+ PUSH( "-level 0 -code 0");
+ STORE( optionsVar);
+ OP( POP);
+ JUMP4( JUMP, afterBody);
+ } else {
+ PUSH( "0");
+ OP4( REVERSE, 2);
+ OP1( JUMP1, 4);
+ TclAdjustStackDepth(-2, envPtr);
+ }
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RETURN_CODE);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( END_CATCH);
+ STORE( optionsVar);
+ OP( POP);
+ STORE( resultVar);
+ OP( POP);
+
+ /*
+ * Now we handle all the registered 'on' and 'trap' handlers in order.
+ *
+ * Slight overallocation, but reduces size of this function.
+ */
+
+ addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+ forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+
+ for (i=0 ; i<numHandlers ; i++) {
+ int noTrapError, trapError;
+ const char *p;
+
+ sprintf(buf, "%d", matchCodes[i]);
+ OP( DUP);
+ PushLiteral(envPtr, buf, strlen(buf));
+ OP( EQ);
+ JUMP4( JUMP_FALSE, notCodeJumpSource);
+ if (matchClauses[i]) {
+ Tcl_ListObjLength(NULL, matchClauses[i], &len);
+
+ /*
+ * Match the errorcode according to try/trap rules.
+ */
+
+ LOAD( optionsVar);
+ PUSH( "-errorcode");
+ OP4( DICT_GET, 1);
+ TclAdjustStackDepth(-1, envPtr);
+ OP44( LIST_RANGE_IMM, 0, len-1);
+ p = Tcl_GetStringFromObj(matchClauses[i], &len);
+ PushLiteral(envPtr, p, len);
+ OP( STR_EQ);
+ JUMP4( JUMP_FALSE, notECJumpSource);
+ } else {
+ notECJumpSource = -1; /* LINT */
+ }
+ OP( POP);
+
+ /*
+ * There is a finally clause, so we need a fairly complex sequence of
+ * instructions to deal with an on/trap handler because we must call
+ * the finally handler *and* we need to substitute the result from a
+ * failed trap for the result from the main script.
+ */
+
+ if (resultVars[i] >= 0 || handlerTokens[i]) {
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ }
+ if (resultVars[i] >= 0) {
+ LOAD( resultVar);
+ STORE( resultVars[i]);
+ OP( POP);
+ if (optionVars[i] >= 0) {
+ LOAD( optionsVar);
+ STORE( optionVars[i]);
+ OP( POP);
+ }
+
+ if (!handlerTokens[i]) {
+ /*
+ * No handler. Will not be the last handler (that is a
+ * condition that is checked by the caller). Chain to the next
+ * one.
+ */
+
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ forwardsNeedFixing = 1;
+ JUMP4( JUMP, forwardsToFix[i]);
+ goto finishTrapCatchHandling;
+ }
+ } else if (!handlerTokens[i]) {
+ /*
+ * No handler. Will not be the last handler (that condition is
+ * checked by the caller). Chain to the next one.
+ */
+
+ forwardsNeedFixing = 1;
+ JUMP4( JUMP, forwardsToFix[i]);
+ goto endOfThisArm;
+ }
+
+ /*
+ * Got a handler. Make sure that any pending patch-up actions from
+ * previous unprocessed handlers are dealt with now that we know where
+ * they are to jump to.
+ */
+
+ if (forwardsNeedFixing) {
+ forwardsNeedFixing = 0;
+ OP1( JUMP1, 7);
+ for (j=0 ; j<i ; j++) {
+ if (forwardsToFix[j] == -1) {
+ continue;
+ }
+ FIXJUMP4( forwardsToFix[j]);
+ forwardsToFix[j] = -1;
+ }
+ OP4( BEGIN_CATCH4, range);
+ }
+ BODY( handlerTokens[i], 5+i*4);
+ ExceptionRangeEnds(envPtr, range);
+ PUSH( "0");
+ OP( PUSH_RETURN_OPTIONS);
+ OP4( REVERSE, 3);
+ OP1( JUMP1, 5);
+ TclAdjustStackDepth(-3, envPtr);
+ forwardsToFix[i] = -1;
+
+ /*
+ * Error in handler or setting of variables; replace the stored
+ * exception with the new one. Note that we only push this if we have
+ * either a body or some variable setting here. Otherwise this code is
+ * unreachable.
+ */
+
+ finishTrapCatchHandling:
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( PUSH_RESULT);
+ OP( END_CATCH);
+ STORE( resultVar);
+ OP( POP);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, noTrapError);
+ LOAD( optionsVar);
+ PUSH( "-during");
+ OP4( REVERSE, 3);
+ STORE( optionsVar);
+ OP( POP);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ JUMP1( JUMP, trapError);
+ FIXJUMP1( noTrapError);
+ STORE( optionsVar);
+ FIXJUMP1( trapError);
+ /* Skip POP at end; can clean up with subsequent POP */
+ if (i+1 < numHandlers) {
+ OP( POP);
+ }
+
+ endOfThisArm:
+ if (i+1 < numHandlers) {
+ JUMP4( JUMP, addrsToFix[i]);
+ TclAdjustStackDepth(1, envPtr);
+ }
+ if (matchClauses[i]) {
+ FIXJUMP4( notECJumpSource);
+ }
+ FIXJUMP4( notCodeJumpSource);
+ }
+
+ /*
+ * Drop the result code, and fix all the jumps from taken clauses - which
+ * drop the result code as their first action - to point straight after
+ * (i.e., to the start of the finally clause).
+ */
+
+ OP( POP);
+ for (i=0 ; i<numHandlers-1 ; i++) {
+ FIXJUMP4( addrsToFix[i]);
+ }
+ TclStackFree(interp, forwardsToFix);
+ TclStackFree(interp, addrsToFix);
+
+ /*
+ * Process the finally clause (at last!) Note that we do not wrap this in
+ * error handlers because we would just rethrow immediately anyway. Then
+ * (on normal success) we reissue the exception. Note also that
+ * INST_RETURN_STK can proceed to the next instruction; that'll be the
+ * next command (or some inter-command manipulation).
+ */
+
+ if (!trapZero) {
+ FIXJUMP4( afterBody);
+ }
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( finallyToken, 3 + 4*numHandlers);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ OP( POP);
+ JUMP1( JUMP, finalOK);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, noFinalError);
+ LOAD( optionsVar);
+ PUSH( "-during");
+ OP4( REVERSE, 3);
+ STORE( optionsVar);
+ OP( POP);
+ OP44( DICT_SET, 1, optionsVar);
+ TclAdjustStackDepth(-1, envPtr);
+ OP( POP);
+ JUMP1( JUMP, finalError);
+ TclAdjustStackDepth(1, envPtr);
+ FIXJUMP1( noFinalError);
+ STORE( optionsVar);
+ OP( POP);
+ FIXJUMP1( finalError);
+ STORE( resultVar);
+ OP( POP);
+ FIXJUMP1( finalOK);
+ LOAD( optionsVar);
+ LOAD( resultVar);
+ INVOKE( RETURN_STK);
+
+ return TCL_OK;
+}
+
+static int
+IssueTryFinallyInstructions(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr,
+ Tcl_Token *bodyToken,
+ Tcl_Token *finallyToken)
+{
+ DefineLineInformation; /* TIP #280 */
+ int range, jumpOK, jumpSplice;
+
+ /*
+ * Note that this one is simple enough that we can issue it without
+ * needing a local variable table, making it a universal compilation.
+ */
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( bodyToken, 1);
+ ExceptionRangeEnds(envPtr, range);
+ OP1( JUMP1, 3);
+ TclAdjustStackDepth(-1, envPtr);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( END_CATCH);
+
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ BODY( finallyToken, 3);
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ OP( POP);
+ JUMP1( JUMP, jumpOK);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RESULT);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ PUSH( "1");
+ OP( EQ);
+ JUMP1( JUMP_FALSE, jumpSplice);
+ PUSH( "-during");
+ OP4( OVER, 3);
+ OP4( LIST, 2);
+ OP( LIST_CONCAT);
+ FIXJUMP1( jumpSplice);
+ OP4( REVERSE, 4);
+ OP( POP);
+ OP( POP);
+ OP1( JUMP1, 7);
+ FIXJUMP1( jumpOK);
+ OP4( REVERSE, 2);
+ INVOKE( RETURN_STK);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileUnsetCmd --
+ *
+ * Procedure called to compile the "unset" 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 "unset" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUnsetCmd(
+ 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 *varTokenPtr;
+ int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
+ DefineLineInformation; /* TIP #280 */
+
+ /* TODO: Consider support for compiling expanded args. */
+
+ /*
+ * Verify that all words - except the first non-option one - are known at
+ * compile time so that we can handle them without needing to do a nasty
+ * push/rotate. [Bug 3970f54c4e]
+ */
+
+ for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+ Tcl_Obj *leadingWord = Tcl_NewObj();
+
+ varTokenPtr = TokenAfter(varTokenPtr);
+ if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ TclDecrRefCount(leadingWord);
+
+ /*
+ * We can tolerate non-trivial substitutions in the first variable
+ * to be unset. If a '--' or '-nocomplain' was present, anything
+ * goes in that one place! (All subsequent variable names must be
+ * constants since we don't want to have to push them all first.)
+ */
+
+ if (varCount == 0) {
+ if (haveFlags) {
+ continue;
+ }
+
+ /*
+ * In fact, we're OK as long as we're the first argument *and*
+ * we provably don't start with a '-'. If that is true, then
+ * even if everything else is varying, we still can't be a
+ * flag. Otherwise we'll spill to runtime to place a limit on
+ * the trickiness.
+ */
+
+ if (varTokenPtr->type == TCL_TOKEN_WORD
+ && varTokenPtr[1].type == TCL_TOKEN_TEXT
+ && varTokenPtr[1].size > 0
+ && varTokenPtr[1].start[0] != '-') {
+ continue;
+ }
+ }
+ return TCL_ERROR;
+ }
+ if (i == 1) {
+ const char *bytes;
+ int len;
+
+ bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+ flags = 0;
+ haveFlags = 1;
+ } else if (len == 2 && !strncmp("--", bytes, 2)) {
+ haveFlags = 1;
+ } else {
+ varCount++;
+ }
+ } else {
+ varCount++;
+ }
+ TclDecrRefCount(leadingWord);
+ }
+
+ /*
+ * Issue instructions to unset each of the named variables.
+ */
+
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (haveFlags) {
+ varTokenPtr = TokenAfter(varTokenPtr);
+ }
+ for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we
+ * need to emit code to compute and push the name at runtime. We use a
+ * frame slot (entry in the array of local vars) if we are compiling a
+ * procedure body and if the name is simple text that does not include
+ * namespace qualifiers.
+ */
+
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &isScalar, i);
+
+ /*
+ * Emit instructions to unset the variable.
+ */
+
+ if (isScalar) {
+ if (localIndex < 0) {
+ OP1( UNSET_STK, flags);
+ } else {
+ OP14( UNSET_SCALAR, flags, localIndex);
+ }
+ } else {
+ if (localIndex < 0) {
+ OP1( UNSET_ARRAY_STK, flags);
+ } else {
+ OP14( UNSET_ARRAY, flags, localIndex);
+ }
+ }
+
+ varTokenPtr = TokenAfter(varTokenPtr);
+ }
+ PUSH("");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileWhileCmd --
+ *
+ * Procedure called to compile the "while" 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 "while" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileWhileCmd(
+ 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 *testTokenPtr, *bodyTokenPtr;
+ JumpFixup jumpEvalCondFixup;
+ int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
+ int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
+ * infinite loop. */
+ Tcl_Obj *boolObj;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the test expression requires substitutions, don't compile the while
+ * command inline. E.g., the expression might cause the loop to never
+ * execute or execute forever, as in "while "$x < 5" {}".
+ *
+ * Bail out also if the body expression requires substitutions in order to
+ * insure correct behaviour [Bug 219166]
+ */
+
+ testTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ bodyTokenPtr = TokenAfter(testTokenPtr);
+
+ if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+ || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find out if the condition is a constant.
+ */
+
+ boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
+ Tcl_IncrRefCount(boolObj);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
+ TclDecrRefCount(boolObj);
+ if (code == TCL_OK) {
+ if (boolVal) {
+ /*
+ * It is an infinite loop; flag it so that we generate a more
+ * efficient body.
+ */
+
+ loopMayEnd = 0;
+ } else {
+ /*
+ * This is an empty loop: "while 0 {...}" or such. Compile no
+ * bytecodes.
+ */
+
+ goto pushResult;
+ }
+ }
+
+ /*
+ * Create a ExceptionRange record for the loop body. This is used to
+ * implement break and continue.
+ */
+
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+ /*
+ * Jump to the evaluation of the condition. This code uses the "loop
+ * rotation" optimisation (which eliminates one branch from the loop).
+ * "while cond body" produces then:
+ * goto A
+ * B: body : bodyCodeOffset
+ * A: cond -> result : testCodeOffset, continueOffset
+ * if (result) goto B
+ *
+ * The infinite loop "while 1 body" produces:
+ * B: body : all three offsets here
+ * goto B
+ */
+
+ if (loopMayEnd) {
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &jumpEvalCondFixup);
+ testCodeOffset = 0; /* Avoid compiler warning. */
+ } else {
+ /*
+ * Make sure that the first command in the body is preceded by an
+ * INST_START_CMD, and hence counted properly. [Bug 1752146]
+ */
+
+ envPtr->atCmdStart &= ~1;
+ testCodeOffset = CurrentOffset(envPtr);
+ }
+
+ /*
+ * Compile the loop body.
+ */
+
+ bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
+ if (!loopMayEnd) {
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
+ }
+ BODY(bodyTokenPtr, 2);
+ ExceptionRangeEnds(envPtr, range);
+ OP( POP);
+
+ /*
+ * Compile the test expression then emit the conditional jump that
+ * terminates the while. We already know it's a simple word.
+ */
+
+ if (loopMayEnd) {
+ testCodeOffset = CurrentOffset(envPtr);
+ jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ bodyCodeOffset += 3;
+ testCodeOffset += 3;
+ }
+ SetLineInformation(1);
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
+
+ jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
+ }
+ } else {
+ jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
+ }
+ }
+
+ /*
+ * Set the loop's body, continue and break offsets.
+ */
+
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
+ ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
+
+ /*
+ * The while command's result is an empty string.
+ */
+
+ pushResult:
+ PUSH("");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) {
+ PUSH("");
+ } else {
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ }
+ OP( YIELD);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileYieldToCmd --
+ *
+ * Procedure called to compile the "yieldto" 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 "yieldto" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldToCmd(
+ 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 = TokenAfter(parsePtr->tokenPtr);
+ int i;
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ OP( NS_CURRENT);
+ for (i = 1 ; i < parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ OP4( LIST, i);
+ OP( YIELD_TO_INVOKE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileUnaryOpCmd --
+ *
+ * Utility routine to compile the unary operator 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 compiled command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileUnaryOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ int instruction,
+ CompileEnv *envPtr)
+{
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ TclEmitOpcode(instruction, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileAssociativeBinaryOpCmd --
+ *
+ * Utility routine to compile the binary operator commands that accept an
+ * arbitrary number of arguments, and that are associative operations.
+ * Because of the associativity, we may combine operations from right to
+ * left, saving us any effort of re-ordering the arguments on the stack
+ * after substitutions are completed.
+ *
+ * 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 compiled command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileAssociativeBinaryOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ const char *identity,
+ int instruction,
+ CompileEnv *envPtr)
+{
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int words;
+
+ /* TODO: Consider support for compiling expanded args. */
+ for (words=1 ; words<parsePtr->numWords ; words++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ }
+ if (parsePtr->numWords <= 2) {
+ PushLiteral(envPtr, identity, -1);
+ words++;
+ }
+ if (words > 3) {
+ /*
+ * Reverse order of arguments to get precise agreement with [expr] in
+ * calcuations, including roundoff errors.
+ */
+
+ OP4( REVERSE, words-1);
+ }
+ while (--words > 1) {
+ TclEmitOpcode(instruction, envPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileStrictlyBinaryOpCmd --
+ *
+ * Utility routine to compile the binary operator commands, that strictly
+ * accept exactly two arguments.
+ *
+ * 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 compiled command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileStrictlyBinaryOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ int instruction,
+ CompileEnv *envPtr)
+{
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+ NULL, instruction, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileComparisonOpCmd --
+ *
+ * Utility routine to compile the n-ary comparison operator 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 compiled command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileComparisonOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ int instruction,
+ CompileEnv *envPtr)
+{
+ Tcl_Token *tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords < 3) {
+ PUSH("1");
+ } else if (parsePtr->numWords == 3) {
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ TclEmitOpcode(instruction, envPtr);
+ } else if (envPtr->procPtr == NULL) {
+ /*
+ * No local variable space!
+ */
+
+ return TCL_ERROR;
+ } else {
+ int tmpIndex = AnonymousLocal(envPtr);
+ int words;
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ STORE(tmpIndex);
+ TclEmitOpcode(instruction, envPtr);
+ for (words=3 ; words<parsePtr->numWords ;) {
+ LOAD(tmpIndex);
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ if (++words < parsePtr->numWords) {
+ STORE(tmpIndex);
+ }
+ TclEmitOpcode(instruction, envPtr);
+ }
+ for (; words>3 ; words--) {
+ OP( BITAND);
+ }
+
+ /*
+ * Drop the value from the temp variable; retaining that reference
+ * might be expensive elsewhere.
+ */
+
+ OP14( UNSET_SCALAR, 0, tmpIndex);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompile*OpCmd --
+ *
+ * Procedures called to compile the corresponding "::tcl::mathop::*"
+ * commands. These are all wrappers around the utility operator command
+ * compiler functions, except for the compilers for subtraction and
+ * division, which are special.
+ *
+ * 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 compiled command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInvertOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
+}
+
+int
+TclCompileNotOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
+}
+
+int
+TclCompileAddOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
+ envPtr);
+}
+
+int
+TclCompileMulOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
+ envPtr);
+}
+
+int
+TclCompileAndOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
+ envPtr);
+}
+
+int
+TclCompileOrOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
+ envPtr);
+}
+
+int
+TclCompileXorOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
+ envPtr);
+}
+
+int
+TclCompilePowOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ /*
+ * This one has its own implementation because the ** operator is the only
+ * one with right associativity.
+ */
+
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int words;
+
+ for (words=1 ; words<parsePtr->numWords ; words++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ }
+ if (parsePtr->numWords <= 2) {
+ PUSH("1");
+ words++;
+ }
+ while (--words > 1) {
+ TclEmitOpcode(INST_EXPON, envPtr);
+ }
+ return TCL_OK;
+}
+
+int
+TclCompileLshiftOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
+}
+
+int
+TclCompileRshiftOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
+}
+
+int
+TclCompileModOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
+}
+
+int
+TclCompileNeqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
+}
+
+int
+TclCompileStrneqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
+}
+
+int
+TclCompileInOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
+}
+
+int
+TclCompileNiOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
+ envPtr);
+}
+
+int
+TclCompileLessOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
+}
+
+int
+TclCompileLeqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
+}
+
+int
+TclCompileGreaterOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
+}
+
+int
+TclCompileGeqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
+}
+
+int
+TclCompileEqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
+}
+
+int
+TclCompileStreqOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
+}
+
+int
+TclCompileMinusOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int words;
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * Fallback to direct eval to report syntax error.
+ */
+
+ return TCL_ERROR;
+ }
+ for (words=1 ; words<parsePtr->numWords ; words++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ }
+ if (words == 2) {
+ TclEmitOpcode(INST_UMINUS, envPtr);
+ return TCL_OK;
+ }
+ if (words == 3) {
+ TclEmitOpcode(INST_SUB, envPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Reverse order of arguments to get precise agreement with [expr] in
+ * calcuations, including roundoff errors.
+ */
+
+ TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+ while (--words > 1) {
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitOpcode(INST_SUB, envPtr);
+ }
+ return TCL_OK;
+}
+
+int
+TclCompileDivOpCmd(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr)
+{
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ DefineLineInformation; /* TIP #280 */
+ int words;
+
+ /* TODO: Consider support for compiling expanded args. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * Fallback to direct eval to report syntax error.
+ */
+
+ return TCL_ERROR;
+ }
+ if (parsePtr->numWords == 2) {
+ PUSH("1.0");
+ }
+ for (words=1 ; words<parsePtr->numWords ; words++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, words);
+ }
+ if (words <= 3) {
+ TclEmitOpcode(INST_DIV, envPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Reverse order of arguments to get precise agreement with [expr] in
+ * calcuations, including roundoff errors.
+ */
+
+ TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+ while (--words > 1) {
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitOpcode(INST_DIV, envPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index e102d28..94c1bd6 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1,902 +1,2803 @@
/*
* tclCompExpr.c --
*
- * This file contains the code to compile Tcl expressions.
+ * This file contains the code to parse and compile Tcl expressions and
+ * implementations of the Tcl commands corresponding to expression
+ * operators, such as the command ::tcl::mathop::+ .
*
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
*
* 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.28 2005/08/03 22:25:11 dgp Exp $
*/
#include "tclInt.h"
-#include "tclCompile.h"
+#include "tclCompile.h" /* CompileEnv */
/*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use the
- * errno from tclExecute.c here.
+ * Expression parsing takes place in the routine ParseExpr(). It takes a
+ * string as input, parses that string, and generates a representation of the
+ * expression in the form of a tree of operators, a list of literals, a list
+ * of function names, and an array of Tcl_Token's within a Tcl_Parse struct.
+ * The tree is composed of OpNodes.
*/
-#ifdef TCL_GENERIC_ONLY
-#define NO_ERRNO_H
-#endif
+typedef struct OpNode {
+ int left; /* "Pointer" to the left operand. */
+ int right; /* "Pointer" to the right operand. */
+ union {
+ int parent; /* "Pointer" to the parent operand. */
+ int prev; /* "Pointer" joining incomplete tree stack */
+ } p;
+ unsigned char lexeme; /* Code that identifies the operator. */
+ unsigned char precedence; /* Precedence of the operator */
+ unsigned char mark; /* Mark used to control traversal. */
+ unsigned char constant; /* Flag marking constant subexpressions. */
+} OpNode;
+
+/*
+ * The storage for the tree is dynamically allocated array of OpNodes. The
+ * array is grown as parsing needs dictate according to a scheme similar to
+ * Tcl's string growth algorithm, so that the resizing costs are O(N) and so
+ * that we use at least half the memory allocated as expressions get large.
+ *
+ * Each OpNode in the tree represents an operator in the expression, either
+ * unary or binary. When parsing is completed successfully, a binary operator
+ * OpNode will have its left and right fields filled with "pointers" to its
+ * left and right operands. A unary operator OpNode will have its right field
+ * filled with a pointer to its single operand. When an operand is a
+ * subexpression the "pointer" takes the form of the index -- a non-negative
+ * integer -- into the OpNode storage array where the root of that
+ * subexpression parse tree is found.
+ *
+ * Non-operator elements of the expression do not get stored in the OpNode
+ * tree. They are stored in the other structures according to their type.
+ * Literal values get appended to the literal list. Elements that denote forms
+ * of quoting or substitution known to the Tcl parser get stored as
+ * Tcl_Tokens. These non-operator elements of the expression are the leaves of
+ * the completed parse tree. When an operand of an OpNode is one of these leaf
+ * elements, the following negative integer codes are used to indicate which
+ * kind of elements it is.
+ */
-#ifdef NO_ERRNO_H
-extern int errno; /* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
+enum OperandTypes {
+ OT_LITERAL = -3, /* Operand is a literal in the literal list */
+ OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */
+ OT_EMPTY = -1 /* "Operand" is an empty string. This is a special
+ * case used only to represent the EMPTY lexeme. See
+ * below. */
+};
/*
- * Boolean variable that controls whether expression compilation tracing is
- * enabled.
+ * Readable macros to test whether a "pointer" value points to an operator.
+ * They operate on the "non-negative integer -> operator; negative integer ->
+ * a non-operator OperandType" distinction.
*/
-#ifdef TCL_COMPILE_DEBUG
-static int traceExprComp = 0;
-#endif /* TCL_COMPILE_DEBUG */
+#define IsOperator(l) ((l) >= 0)
+#define NotOperator(l) ((l) < 0)
/*
- * The ExprInfo structure describes the state of compiling an expression. A
- * pointer to an ExprInfo record is passed among the routines in this module.
+ * Note that it is sufficient to store in the tree just the type of leaf
+ * operand, without any explicit pointer to which leaf. This is true because
+ * the traversals of the completed tree we perform are known to visit the
+ * leaves in the same order as the original parse.
+ *
+ * In a completed parse tree, those OpNodes that are themselves (roots of
+ * subexpression trees that are) operands of some operator store in their
+ * p.parent field a "pointer" to the OpNode of that operator. The p.parent
+ * field permits a traversal of the tree within a non-recursive routine
+ * (ConvertTreeToTokens() and CompileExprTree()). This means that even
+ * expression trees of great depth pose no risk of blowing the C stack.
+ *
+ * While the parse tree is being constructed, the same memory space is used to
+ * hold the p.prev field which chains together a stack of incomplete trees
+ * awaiting their right operands.
+ *
+ * The lexeme field is filled in with the lexeme of the operator that is
+ * returned by the ParseLexeme() routine. Only lexemes for unary and binary
+ * operators get stored in an OpNode. Other lexmes get different treatement.
+ *
+ * The precedence field provides a place to store the precedence of the
+ * operator, so it need not be looked up again and again.
+ *
+ * The mark field is use to control the traversal of the tree, so that it can
+ * be done non-recursively. The mark values are:
*/
-typedef struct ExprInfo {
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Structure filled with information about the
- * parsed expression. */
- CONST char *expr; /* The expression that was originally passed
- * to TclCompileExpr. */
- CONST char *lastChar; /* Points just after last byte of expr. */
- int hasOperators; /* Set 1 if the expr has operators; 0 if expr
- * is only a primary. If 1 after compiling an
- * expr, a tryCvtToNumeric instruction is
- * emitted to convert the primary to a number
- * if possible. */
-} ExprInfo;
+enum Marks {
+ MARK_LEFT, /* Next step of traversal is to visit left subtree */
+ MARK_RIGHT, /* Next step of traversal is to visit right subtree */
+ MARK_PARENT /* Next step of traversal is to return to parent */
+};
/*
- * Definitions of numeric codes representing each expression operator. The
- * order of these must match the entries in the operatorTable below. Also the
- * codes for the relational operators (OP_LESS, OP_GREATER, OP_LE, OP_GE,
- * OP_EQ, and OP_NE) must be consecutive and in that order. Note that OP_PLUS
- * and OP_MINUS represent both unary and binary operators.
+ * The constant field is a boolean flag marking which subexpressions are
+ * completely known at compile time, and are eligible for computing then
+ * rather than waiting until run time.
*/
-#define OP_MULT 0
-#define OP_DIVIDE 1
-#define OP_MOD 2
-#define OP_PLUS 3
-#define OP_MINUS 4
-#define OP_LSHIFT 5
-#define OP_RSHIFT 6
-#define OP_LESS 7
-#define OP_GREATER 8
-#define OP_LE 9
-#define OP_GE 10
-#define OP_EQ 11
-#define OP_NEQ 12
-#define OP_BITAND 13
-#define OP_BITXOR 14
-#define OP_BITOR 15
-#define OP_LAND 16
-#define OP_LOR 17
-#define OP_QUESTY 18
-#define OP_LNOT 19
-#define OP_BITNOT 20
-#define OP_STREQ 21
-#define OP_STRNEQ 22
-#define OP_EXPON 23
-#define OP_IN_LIST 24
-#define OP_NOT_IN_LIST 25
+/*
+ * Each lexeme belongs to one of four categories, which determine its place in
+ * the parse tree. We use the two high bits of the (unsigned char) value to
+ * store a NODE_TYPE code.
+ */
+
+#define NODE_TYPE 0xC0
/*
- * Table describing the expression operators. Entries in this table must
- * correspond to the definitions of numeric codes for operators just above.
+ * The four category values are LEAF, UNARY, and BINARY, explained below, and
+ * "uncategorized", which is used either temporarily, until context determines
+ * which of the other three categories is correct, or for lexemes like
+ * INVALID, which aren't really lexemes at all, but indicators of a parsing
+ * error. Note that the codes must be distinct to distinguish categories, but
+ * need not take the form of a bit array.
*/
-static int opTableInitialized = 0; /* 0 means not yet initialized. */
-
-TCL_DECLARE_MUTEX(opMutex)
-
-typedef struct OperatorDesc {
- char *name; /* Name of the operator. */
- int numOperands; /* Number of operands. 0 if the operator
- * requires special handling. */
- int instruction; /* Instruction opcode for the operator.
- * Ignored if numOperands is 0. */
-} OperatorDesc;
-
-static OperatorDesc operatorTable[] = {
- {"*", 2, INST_MULT},
- {"/", 2, INST_DIV},
- {"%", 2, INST_MOD},
- {"+", 0},
- {"-", 0},
- {"<<", 2, INST_LSHIFT},
- {">>", 2, INST_RSHIFT},
- {"<", 2, INST_LT},
- {">", 2, INST_GT},
- {"<=", 2, INST_LE},
- {">=", 2, INST_GE},
- {"==", 2, INST_EQ},
- {"!=", 2, INST_NEQ},
- {"&", 2, INST_BITAND},
- {"^", 2, INST_BITXOR},
- {"|", 2, INST_BITOR},
- {"&&", 0},
- {"||", 0},
- {"?", 0},
- {"!", 1, INST_LNOT},
- {"~", 1, INST_BITNOT},
- {"eq", 2, INST_STR_EQ},
- {"ne", 2, INST_STR_NEQ},
- {"**", 2, INST_EXPON},
- {"in", 2, INST_LIST_IN},
- {"ni", 2, INST_LIST_NOT_IN},
- {NULL}
+#define BINARY 0x40 /* This lexeme is a binary operator. An OpNode
+ * representing it should go into the parse
+ * tree, and two operands should be parsed for
+ * it in the expression. */
+#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode
+ * representing it should go into the parse
+ * tree, and one operand should be parsed for
+ * it in the expression. */
+#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse
+ * tree. No OpNode will be placed in the tree
+ * for it. Either a literal value will be
+ * appended to the list of literals in this
+ * expression, or appropriate Tcl_Tokens will
+ * be appended in a Tcl_Parse struct to
+ * represent those leaves that require some
+ * form of substitution. */
+
+/* Uncategorized lexemes */
+
+#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or
+ * BINARY_PLUS according to context. */
+#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or
+ * BINARY_MINUS according to context. */
+#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to
+ * FUNCTION or a parse error according to
+ * context and value. */
+#define INCOMPLETE 4 /* A parse error. Used only when the single
+ * "=" is encountered. */
+#define INVALID 5 /* A parse error. Used when any punctuation
+ * appears that's not a supported operator. */
+
+/* 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() */
+
+/* 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)
+
+/* 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. */
+
+/*
+ * 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.
+ */
+
+enum Precedence {
+ PREC_END = 1, /* END */
+ PREC_START, /* START */
+ PREC_CLOSE_PAREN, /* ")" */
+ PREC_OPEN_PAREN, /* "(" */
+ PREC_COMMA, /* "," */
+ PREC_CONDITIONAL, /* "?", ":" */
+ PREC_OR, /* "||" */
+ PREC_AND, /* "&&" */
+ PREC_BIT_OR, /* "|" */
+ PREC_BIT_XOR, /* "^" */
+ PREC_BIT_AND, /* "&" */
+ PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */
+ PREC_COMPARE, /* "<", ">", "<=", ">=" */
+ PREC_SHIFT, /* "<<", ">>" */
+ PREC_ADD, /* "+", "-" */
+ PREC_MULT, /* "*", "/", "%" */
+ PREC_EXPON, /* "**" */
+ PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */
};
/*
- * Hashtable used to map the names of expression operators to the index of
- * their OperatorDesc description.
+ * 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 Tcl_HashTable opHashTable;
+static const unsigned char prec[] = {
+ /* Non-operator lexemes */
+ 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, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0,
+ /* Binary operator lexemes */
+ PREC_ADD, /* BINARY_PLUS */
+ PREC_ADD, /* BINARY_MINUS */
+ PREC_COMMA, /* COMMA */
+ PREC_MULT, /* MULT */
+ PREC_MULT, /* DIVIDE */
+ PREC_MULT, /* MOD */
+ PREC_COMPARE, /* LESS */
+ PREC_COMPARE, /* GREATER */
+ PREC_BIT_AND, /* BIT_AND */
+ PREC_BIT_XOR, /* BIT_XOR */
+ PREC_BIT_OR, /* BIT_OR */
+ PREC_CONDITIONAL, /* QUESTION */
+ PREC_CONDITIONAL, /* COLON */
+ PREC_SHIFT, /* LEFT_SHIFT */
+ PREC_SHIFT, /* RIGHT_SHIFT */
+ PREC_COMPARE, /* LEQ */
+ PREC_COMPARE, /* GEQ */
+ PREC_EQUAL, /* EQUAL */
+ PREC_EQUAL, /* NEQ */
+ PREC_AND, /* AND */
+ PREC_OR, /* OR */
+ PREC_EQUAL, /* STREQ */
+ PREC_EQUAL, /* STRNEQ */
+ PREC_EXPON, /* EXPON */
+ PREC_EQUAL, /* IN_LIST */
+ PREC_EQUAL, /* NOT_IN_LIST */
+ PREC_CLOSE_PAREN, /* CLOSE_PAREN */
+ PREC_END, /* END */
+ /* Expansion room for more binary operators */
+ 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,
+ /* Unary operator lexemes */
+ PREC_UNARY, /* UNARY_PLUS */
+ PREC_UNARY, /* UNARY_MINUS */
+ PREC_UNARY, /* FUNCTION */
+ PREC_START, /* START */
+ PREC_OPEN_PAREN, /* OPEN_PAREN */
+ PREC_UNARY, /* NOT*/
+ PREC_UNARY, /* BIT_NOT*/
+};
/*
- * Declarations for local procedures to this file:
+ * A table mapping lexemes to bytecode instructions, used by CompileExprTree().
*/
-static int CompileCondExpr _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
- CompileEnv *envPtr, Tcl_Token **endPtrPtr));
-static int CompileLandOrLorExpr _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, int opIndex,
- ExprInfo *infoPtr, CompileEnv *envPtr,
- Tcl_Token **endPtrPtr));
-static int CompileMathFuncCall _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, CONST char *funcName,
- ExprInfo *infoPtr, CompileEnv *envPtr,
- Tcl_Token **endPtrPtr));
-static int CompileSubExpr _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
- CompileEnv *envPtr));
-static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
+static const unsigned char instruction[] = {
+ /* Non-operator lexemes */
+ 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, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0,
+ /* Binary operator lexemes */
+ INST_ADD, /* BINARY_PLUS */
+ INST_SUB, /* BINARY_MINUS */
+ 0, /* COMMA */
+ INST_MULT, /* MULT */
+ INST_DIV, /* DIVIDE */
+ INST_MOD, /* MOD */
+ INST_LT, /* LESS */
+ INST_GT, /* GREATER */
+ INST_BITAND, /* BIT_AND */
+ INST_BITXOR, /* BIT_XOR */
+ INST_BITOR, /* BIT_OR */
+ 0, /* QUESTION */
+ 0, /* COLON */
+ INST_LSHIFT, /* LEFT_SHIFT */
+ INST_RSHIFT, /* RIGHT_SHIFT */
+ INST_LE, /* LEQ */
+ INST_GE, /* GEQ */
+ INST_EQ, /* EQUAL */
+ INST_NEQ, /* NEQ */
+ 0, /* AND */
+ 0, /* OR */
+ INST_STR_EQ, /* STREQ */
+ INST_STR_NEQ, /* STRNEQ */
+ INST_EXPON, /* EXPON */
+ INST_LIST_IN, /* IN_LIST */
+ INST_LIST_NOT_IN, /* NOT_IN_LIST */
+ 0, /* CLOSE_PAREN */
+ 0, /* END */
+ /* Expansion room for more binary operators */
+ 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,
+ /* Unary operator lexemes */
+ INST_UPLUS, /* UNARY_PLUS */
+ INST_UMINUS, /* UNARY_MINUS */
+ 0, /* FUNCTION */
+ 0, /* START */
+ 0, /* OPEN_PAREN */
+ INST_LNOT, /* NOT*/
+ INST_BITNOT, /* BIT_NOT*/
+};
/*
- * Macro used to debug the execution of the expression compiler.
+ * A table mapping a byte value to the corresponding lexeme for use by
+ * ParseLexeme().
*/
-#ifdef TCL_COMPILE_DEBUG
-#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
- if (traceExprComp) { \
- fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
- (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
- }
-#else
-#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
-#endif /* TCL_COMPILE_DEBUG */
+static const unsigned char Lexeme[] = {
+ INVALID /* NUL */, INVALID /* SOH */,
+ INVALID /* STX */, INVALID /* ETX */,
+ INVALID /* EOT */, INVALID /* ENQ */,
+ INVALID /* ACK */, INVALID /* BEL */,
+ INVALID /* BS */, INVALID /* HT */,
+ INVALID /* LF */, INVALID /* VT */,
+ INVALID /* FF */, INVALID /* CR */,
+ INVALID /* SO */, INVALID /* SI */,
+ INVALID /* DLE */, INVALID /* DC1 */,
+ INVALID /* DC2 */, INVALID /* DC3 */,
+ INVALID /* DC4 */, INVALID /* NAK */,
+ INVALID /* SYN */, INVALID /* ETB */,
+ INVALID /* CAN */, INVALID /* EM */,
+ INVALID /* SUB */, INVALID /* ESC */,
+ INVALID /* FS */, INVALID /* GS */,
+ INVALID /* RS */, INVALID /* US */,
+ INVALID /* SPACE */, 0 /* ! or != */,
+ QUOTED /* " */, INVALID /* # */,
+ VARIABLE /* $ */, MOD /* % */,
+ 0 /* & or && */, INVALID /* ' */,
+ OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */,
+ 0 /* * or ** */, PLUS /* + */,
+ COMMA /* , */, MINUS /* - */,
+ 0 /* . */, DIVIDE /* / */,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */
+ COLON /* : */, INVALID /* ; */,
+ 0 /* < or << or <= */,
+ 0 /* == or INVALID */,
+ 0 /* > or >> or >= */,
+ QUESTION /* ? */, INVALID /* @ */,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A-M */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */
+ SCRIPT /* [ */, INVALID /* \ */,
+ INVALID /* ] */, BIT_XOR /* ^ */,
+ INVALID /* _ */, INVALID /* ` */,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* a-m */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* n-z */
+ BRACED /* { */, 0 /* | or || */,
+ INVALID /* } */, BIT_NOT /* ~ */,
+ INVALID /* DEL */
+};
+
+/*
+ * The JumpList struct is used to create a stack of data needed for the
+ * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
+ * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
+ * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
+ */
+
+typedef struct JumpList {
+ JumpFixup jump; /* Pass this argument to matching calls of
+ * TclEmitForwardJump() and
+ * TclFixupForwardJump(). */
+ struct JumpList *next; /* Point to next item on the stack */
+} JumpList;
+
+/*
+ * Declarations for local functions to this file:
+ */
+
+static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
+ int index, Tcl_Obj *const **litObjvPtr,
+ Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
+ CompileEnv *envPtr, int optimize);
+static void ConvertTreeToTokens(const char *start, int numBytes,
+ OpNode *nodes, Tcl_Token *tokenPtr,
+ Tcl_Parse *parsePtr);
+static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
+ int index, Tcl_Obj * const **litObjvPtr);
+static int ParseExpr(Tcl_Interp *interp, const char *start,
+ int numBytes, OpNode **opTreePtr,
+ Tcl_Obj *litList, Tcl_Obj *funcList,
+ Tcl_Parse *parsePtr, int parseOnly);
+static int ParseLexeme(const char *start, int numBytes,
+ unsigned char *lexemePtr, Tcl_Obj **literalPtr);
/*
*----------------------------------------------------------------------
*
- * TclCompileExpr --
+ * ParseExpr --
*
- * This procedure compiles a string containing a Tcl expression into Tcl
- * bytecodes. This procedure is the top-level interface to the the
- * expression compilation module, and is used by such public procedures
- * as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong, Tcl_ExprDouble,
- * Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
+ * Given a string, the numBytes bytes starting at start, this function
+ * parses it as a Tcl expression and constructs a tree representing the
+ * structure of the expression. The caller must pass in empty lists as
+ * the funcList and litList arguments. The elements of the parsed
+ * expression are returned to the caller as that tree, a list of literal
+ * values, a list of function names, and in Tcl_Tokens added to a
+ * Tcl_Parse struct passed in by the caller.
*
* Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
+ * If the string is successfully parsed as a valid Tcl expression, TCL_OK
+ * is returned, and data about the expression structure is written to the
+ * last four arguments. If the string cannot be parsed as a valid Tcl
+ * expression, TCL_ERROR is returned, and if interp is non-NULL, an error
+ * message is written to interp.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
+ * Memory will be allocated. If TCL_OK is returned, the caller must clean
+ * up the returned data structures. The (OpNode *) value written to
+ * opTreePtr should be passed to ckfree() and the parsePtr argument
+ * should be passed to Tcl_FreeParse(). The elements appended to the
+ * litList and funcList will automatically be freed whenever the refcount
+ * on those lists indicates they can be freed.
*
*----------------------------------------------------------------------
*/
-int
-TclCompileExpr(interp, script, numBytes, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- CONST char *script; /* The source script to compile. */
- int numBytes; /* Number of bytes in script. If < 0, the
- * string consists of all bytes up to the
- * first null character. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+static int
+ParseExpr(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *start, /* Start of source string to parse. */
+ int numBytes, /* Number of bytes in string. */
+ OpNode **opTreePtr, /* Points to space where a pointer to the
+ * allocated OpNode tree should go. */
+ Tcl_Obj *litList, /* List to append literals to. */
+ Tcl_Obj *funcList, /* List to append function names to. */
+ Tcl_Parse *parsePtr, /* Structure to fill with tokens representing
+ * those operands that require run time
+ * substitutions. */
+ int parseOnly) /* A boolean indicating whether the caller's
+ * aim is just a parse, or whether it will go
+ * on to compile the expression. Different
+ * optimizations are appropriate for the two
+ * scenarios. */
{
- ExprInfo info;
- Tcl_Parse parse;
- Tcl_HashEntry *hPtr;
- int new, i, code;
+ OpNode *nodes = NULL; /* Pointer to the OpNode storage array where
+ * we build the parse tree. */
+ int nodesAvailable = 64; /* Initial size of the storage array. This
+ * value establishes a minimum tree memory
+ * cost of only about 1 kibyte, and is large
+ * enough for most expressions to parse with
+ * no need for array growth and
+ * reallocation. */
+ int nodesUsed = 0; /* Number of OpNodes filled. */
+ int scanned = 0; /* Capture number of byte scanned by parsing
+ * routines. */
+ int lastParsed; /* Stores info about what the lexeme parsed
+ * the previous pass through the parsing loop
+ * was. If it was an operator, lastParsed is
+ * the index of the OpNode for that operator.
+ * If it was not an operator, lastParsed holds
+ * an OperandTypes value encoding what we need
+ * to know about it. */
+ int incomplete; /* Index of the most recent incomplete tree in
+ * the OpNode array. Heads a stack of
+ * incomplete trees linked by p.prev. */
+ int complete = OT_EMPTY; /* "Index" of the complete tree (that is, a
+ * complete subexpression) determined at the
+ * moment. OT_EMPTY is a nonsense value used
+ * only to silence compiler warnings. During a
+ * parse, complete will always hold an index
+ * or an OperandTypes value pointing to an
+ * actual leaf at the time the complete tree
+ * is needed. */
/*
- * If this is the first time we've been called, initialize the table of
- * expression operators.
+ * These variables control generation of the error message.
*/
- if (numBytes < 0) {
- numBytes = (script? strlen(script) : 0);
- }
- if (!opTableInitialized) {
- Tcl_MutexLock(&opMutex);
- if (!opTableInitialized) {
- Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
- for (i = 0; operatorTable[i].name != NULL; i++) {
- hPtr = Tcl_CreateHashEntry(&opHashTable,
- operatorTable[i].name, &new);
- if (new) {
- Tcl_SetHashValue(hPtr, (ClientData) i);
- }
- }
- opTableInitialized = 1;
- }
- Tcl_MutexUnlock(&opMutex);
+ 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
+ * into the string being parsed to aid in
+ * pinpointing the location of the syntax
+ * error in the expression. */
+ int insertMark = 0; /* A boolean controlling whether the "mark"
+ * should be inserted. */
+ const int limit = 25; /* Portions of the error message are
+ * constructed out of substrings of the
+ * original expression. In order to keep the
+ * error message readable, we impose this
+ * limit on the substring size we extract. */
+
+ TclParseInit(interp, start, numBytes, parsePtr);
+
+ nodes = attemptckalloc(nodesAvailable * sizeof(OpNode));
+ if (nodes == NULL) {
+ TclNewLiteralStringObj(msg, "not enough memory to parse expression");
+ errCode = "NOMEM";
+ goto error;
}
/*
- * Initialize the structure containing information abvout this expression
- * compilation.
+ * Initialize the parse tree with the special "START" node.
+ */
+
+ nodes->lexeme = START;
+ nodes->precedence = prec[START];
+ nodes->mark = MARK_RIGHT;
+ nodes->constant = 1;
+ incomplete = lastParsed = nodesUsed;
+ nodesUsed++;
+
+ /*
+ * Main parsing loop parses one lexeme per iteration. We exit the loop
+ * only when there's a syntax error with a "goto error" which takes us to
+ * the error handling code following the loop, or when we've successfully
+ * completed the parse and we return to the caller.
*/
- info.interp = interp;
- info.parsePtr = &parse;
- info.expr = script;
- info.lastChar = (script + numBytes);
- info.hasOperators = 0;
+ while (1) {
+ OpNode *nodePtr; /* Points to the OpNode we may fill this pass
+ * through the loop. */
+ unsigned char lexeme; /* The lexeme we parse this iteration. */
+ Tcl_Obj *literal; /* Filled by the ParseLexeme() call when a
+ * literal is parsed that has a Tcl_Obj rep
+ * worth preserving. */
+
+ /*
+ * Each pass through this loop adds up to one more OpNode. Allocate
+ * space for one if required.
+ */
+
+ if (nodesUsed >= nodesAvailable) {
+ int size = nodesUsed * 2;
+ OpNode *newPtr;
+
+ do {
+ 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;
+ nodes = newPtr;
+ }
+ nodePtr = nodes + nodesUsed;
+
+ /*
+ * 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.
+ */
+
+ if ((NODE_TYPE & lexeme) == 0) {
+ int b;
+
+ switch (lexeme) {
+ case INVALID:
+ msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
+ scanned, start);
+ errCode = "BADCHAR";
+ goto error;
+ case INCOMPLETE:
+ msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
+ scanned, start);
+ errCode = "PARTOP";
+ goto error;
+ case BAREWORD:
+
+ /*
+ * Most barewords in an expression are a syntax error. The
+ * exceptions are that when a bareword is followed by an open
+ * paren, it might be a function call, and when the bareword
+ * is a legal literal boolean value, we accept that as well.
+ */
+
+ if (start[scanned+TclParseAllWhiteSpace(
+ start+scanned, numBytes-scanned)] == '(') {
+ lexeme = FUNCTION;
+
+ /*
+ * When we compile the expression we'll need the function
+ * name, and there's no place in the parse tree to store
+ * it, so we keep a separate list of all the function
+ * names we've parsed in the order we found them.
+ */
+
+ Tcl_ListObjAppendElement(NULL, funcList, literal);
+ } else 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) ? "" : "...");
+ 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);
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ errCode = "BADNUMBER";
+ subErrCode = "OCTAL";
+ }
+ break;
+ }
+ }
+ }
+ goto error;
+ }
+ break;
+ case PLUS:
+ case MINUS:
+ if (IsOperator(lastParsed)) {
+ /*
+ * A "+" or "-" coming just after another operator must be
+ * interpreted as a unary operator.
+ */
+
+ lexeme |= UNARY;
+ } else {
+ lexeme |= BINARY;
+ }
+ }
+ } /* Uncategorized lexemes */
+
+ /*
+ * 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;
+ int code = TCL_OK;
+
+ /*
+ * A leaf operand appearing just after something that's not an
+ * operator is a syntax error.
+ */
+
+ if (NotOperator(lastParsed)) {
+ msg = Tcl_ObjPrintf("missing operator at %s", mark);
+ errCode = "MISSING";
+ scanned = 0;
+ insertMark = 1;
+
+ /*
+ * Free any literal to avoid a memleak.
+ */
+
+ if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
+ Tcl_DecrRefCount(literal);
+ }
+ goto error;
+ }
+
+ switch (lexeme) {
+ case NUMBER:
+ case BOOLEAN:
+ /*
+ * TODO: Consider using a dict or hash to collapse all
+ * duplicate literals into a single representative value.
+ * (Like what is done with [split $s {}]).
+ * Pro: ~75% memory saving on expressions like
+ * {1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
+ * to "pointer" cost only)
+ * Con: Cost of the dict store/retrieve on every literal in
+ * every expression when expressions like the above tend
+ * to be uncommon.
+ * The memory savings is temporary; Compiling to bytecode
+ * will collapse things as literals are registered
+ * anyway, so the savings applies only to the time
+ * between parsing and compiling. Possibly important due
+ * to high-water mark nature of memory allocation.
+ */
+
+ Tcl_ListObjAppendElement(NULL, litList, literal);
+ complete = lastParsed = OT_LITERAL;
+ start += scanned;
+ numBytes -= scanned;
+ continue;
+
+ default:
+ break;
+ }
+
+ /*
+ * Remaining LEAF cases may involve filling Tcl_Tokens, so make
+ * room for at least 2 more tokens.
+ */
+
+ TclGrowParseTokenArray(parsePtr, 2);
+ wordIndex = parsePtr->numTokens;
+ tokenPtr = parsePtr->tokenPtr + wordIndex;
+ tokenPtr->type = TCL_TOKEN_WORD;
+ tokenPtr->start = start;
+ parsePtr->numTokens++;
+
+ switch (lexeme) {
+ case QUOTED:
+ code = Tcl_ParseQuotedString(NULL, start, numBytes,
+ parsePtr, 1, &end);
+ scanned = end - start;
+ break;
+
+ case BRACED:
+ code = Tcl_ParseBraces(NULL, start, numBytes,
+ parsePtr, 1, &end);
+ scanned = end - start;
+ break;
+
+ case VARIABLE:
+ code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1);
+
+ /*
+ * Handle the quirk that Tcl_ParseVarName reports a successful
+ * parse even when it gets only a "$" with no variable name.
+ */
+
+ 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;
+ break;
+
+ case SCRIPT: {
+ Tcl_Parse *nestedPtr =
+ TclStackAlloc(interp, sizeof(Tcl_Parse));
+
+ tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ tokenPtr->type = TCL_TOKEN_COMMAND;
+ tokenPtr->start = start;
+ tokenPtr->numComponents = 0;
+
+ end = start + numBytes;
+ start++;
+ while (1) {
+ code = Tcl_ParseCommand(interp, start, end - start, 1,
+ nestedPtr);
+ if (code != TCL_OK) {
+ parsePtr->term = nestedPtr->term;
+ parsePtr->errorType = nestedPtr->errorType;
+ parsePtr->incomplete = nestedPtr->incomplete;
+ break;
+ }
+ start = nestedPtr->commandStart + nestedPtr->commandSize;
+ Tcl_FreeParse(nestedPtr);
+ if ((nestedPtr->term < end) && (nestedPtr->term[0] == ']')
+ && !nestedPtr->incomplete) {
+ break;
+ }
+
+ if (start == end) {
+ TclNewLiteralStringObj(msg, "missing close-bracket");
+ parsePtr->term = tokenPtr->start;
+ parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
+ parsePtr->incomplete = 1;
+ code = TCL_ERROR;
+ errCode = "UNBALANCED";
+ break;
+ }
+ }
+ TclStackFree(interp, nestedPtr);
+ end = start;
+ start = tokenPtr->start;
+ scanned = end - start;
+ tokenPtr->size = scanned;
+ parsePtr->numTokens++;
+ break;
+ } /* SCRIPT case */
+ }
+ if (code != TCL_OK) {
+ /*
+ * Here we handle all the syntax errors generated by the
+ * Tcl_Token generating parsing routines called in the switch
+ * just above. If the value of parsePtr->incomplete is 1, then
+ * the error was an unbalanced '[', '(', '{', or '"' and
+ * parsePtr->term is pointing to that unbalanced character. If
+ * the value of parsePtr->incomplete is 0, then the error is
+ * one of lacking whitespace following a quoted word, for
+ * example: expr {[an error {foo}bar]}, and parsePtr->term
+ * points to where the whitespace is missing. We reset our
+ * values of start and scanned so that when our error message
+ * is constructed, the location of the syntax error is sure to
+ * appear in it, even if the quoted expression is truncated.
+ */
+
+ start = parsePtr->term;
+ scanned = parsePtr->incomplete;
+ if (parsePtr->incomplete) {
+ errCode = "UNBALANCED";
+ }
+ goto error;
+ }
+
+ tokenPtr = parsePtr->tokenPtr + wordIndex;
+ tokenPtr->size = scanned;
+ tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1;
+ if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) {
+ /*
+ * When this expression is destined to be compiled, and a
+ * braced or quoted word within an expression is known at
+ * compile time (no runtime substitutions in it), we can store
+ * it as a literal rather than in its tokenized form. This is
+ * an advantage since the compiled bytecode is going to need
+ * the argument in Tcl_Obj form eventually, so it's just as
+ * well to get there now. Another advantage is that with this
+ * conversion, larger constant expressions might be grown and
+ * optimized.
+ *
+ * On the contrary, if the end goal of this parse is to fill a
+ * Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
+ * wasteful to convert to a literal only to convert back again
+ * later.
+ */
+
+ literal = Tcl_NewObj();
+ if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
+ Tcl_ListObjAppendElement(NULL, litList, literal);
+ complete = lastParsed = OT_LITERAL;
+ parsePtr->numTokens = wordIndex;
+ break;
+ }
+ Tcl_DecrRefCount(literal);
+ }
+ complete = lastParsed = OT_TOKENS;
+ break;
+ } /* case LEAF */
+
+ case UNARY:
+
+ /*
+ * A unary operator appearing just after something that's not an
+ * operator is a syntax error -- something trying to be the left
+ * operand of an operator that doesn't take one.
+ */
+
+ if (NotOperator(lastParsed)) {
+ msg = Tcl_ObjPrintf("missing operator at %s", mark);
+ scanned = 0;
+ insertMark = 1;
+ errCode = "MISSING";
+ goto error;
+ }
+
+ /*
+ * Create an OpNode for the unary operator.
+ */
+
+ nodePtr->lexeme = lexeme;
+ nodePtr->precedence = prec[lexeme];
+ nodePtr->mark = MARK_RIGHT;
+
+ /*
+ * A FUNCTION cannot be a constant expression, because Tcl allows
+ * functions to return variable results with the same arguments;
+ * for example, rand(). Other unary operators can root a constant
+ * expression, so long as the argument is a constant expression.
+ */
+
+ nodePtr->constant = (lexeme != FUNCTION);
+
+ /*
+ * This unary operator is a new incomplete tree, so push it onto
+ * our stack of incomplete trees. Also remember it as the last
+ * lexeme we parsed.
+ */
+
+ nodePtr->p.prev = incomplete;
+ incomplete = lastParsed = nodesUsed;
+ nodesUsed++;
+ break;
+
+ case BINARY: {
+ OpNode *incompletePtr;
+ unsigned char precedence = prec[lexeme];
+
+ /*
+ * A binary operator appearing just after another operator is a
+ * syntax error -- one of the two operators is missing an operand.
+ */
+
+ if (IsOperator(lastParsed)) {
+ if ((lexeme == CLOSE_PAREN)
+ && (nodePtr[-1].lexeme == OPEN_PAREN)) {
+ if (nodePtr[-2].lexeme == FUNCTION) {
+ /*
+ * Normally, "()" is a syntax error, but as a special
+ * case accept it as an argument list for a function.
+ * Treat this as a special LEAF lexeme, and restart
+ * the parsing loop with zero characters scanned. We
+ * will parse the ")" again the next time through, but
+ * with the OT_EMPTY leaf as the subexpression between
+ * the parens.
+ */
+
+ scanned = 0;
+ complete = lastParsed = OT_EMPTY;
+ break;
+ }
+ msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
+ scanned = 0;
+ insertMark = 1;
+ errCode = "EMPTY";
+ goto error;
+ }
+
+ if (nodePtr[-1].precedence > precedence) {
+ 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");
+ 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;
+ }
+
+ /*
+ * Here is where the tree comes together. At this point, we have a
+ * stack of incomplete trees corresponding to substrings that are
+ * incomplete expressions, followed by a complete tree
+ * corresponding to a substring that is itself a complete
+ * expression, followed by the binary operator we have just
+ * parsed. The incomplete trees can each be completed by adding a
+ * right operand.
+ *
+ * To illustrate with an example, when we parse the expression
+ * "1+2*3-4" and we reach this point having just parsed the "-"
+ * operator, we have these incomplete trees: START, "1+", and
+ * "2*". Next we have the complete subexpression "3". Last is the
+ * "-" we've just parsed.
+ *
+ * The next step is to join our complete tree to an operator. The
+ * choice is governed by the precedence and associativity of the
+ * competing operators. If we connect it as the right operand of
+ * our most recent incomplete tree, we get a new complete tree,
+ * and we can repeat the process. The while loop following repeats
+ * this until precedence indicates it is time to join the complete
+ * tree as the left operand of the just parsed binary operator.
+ *
+ * Continuing the example, the first pass through the loop will
+ * join "3" to "2*"; the next pass will join "2*3" to "1+". Then
+ * we'll exit the loop and join "1+2*3" to "-". When we return to
+ * parse another lexeme, our stack of incomplete trees is START
+ * and "1+2*3-".
+ */
+
+ while (1) {
+ incompletePtr = nodes + incomplete;
+
+ if (incompletePtr->precedence < precedence) {
+ break;
+ }
+
+ if (incompletePtr->precedence == precedence) {
+ /*
+ * Right association rules for exponentiation.
+ */
+
+ if (lexeme == EXPON) {
+ break;
+ }
+
+ /*
+ * Special association rules for the conditional
+ * operators. The "?" and ":" operators have equal
+ * precedence, but must be linked up in sensible pairs.
+ */
+
+ if ((incompletePtr->lexeme == QUESTION)
+ && (NotOperator(complete)
+ || (nodes[complete].lexeme != COLON))) {
+ break;
+ }
+ if ((incompletePtr->lexeme == COLON)
+ && (lexeme == QUESTION)) {
+ break;
+ }
+ }
+
+ /*
+ * Some special syntax checks...
+ */
+
+ /* Parens must balance */
+ if ((incompletePtr->lexeme == OPEN_PAREN)
+ && (lexeme != CLOSE_PAREN)) {
+ TclNewLiteralStringObj(msg, "unbalanced open paren");
+ parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+ errCode = "UNBALANCED";
+ goto error;
+ }
+
+ /* Right operand of "?" must be ":" */
+ if ((incompletePtr->lexeme == QUESTION)
+ && (NotOperator(complete)
+ || (nodes[complete].lexeme != COLON))) {
+ msg = Tcl_ObjPrintf("missing operator \":\" at %s", mark);
+ scanned = 0;
+ insertMark = 1;
+ errCode = "MISSING";
+ goto error;
+ }
+
+ /* Operator ":" may only be right operand of "?" */
+ if (IsOperator(complete)
+ && (nodes[complete].lexeme == COLON)
+ && (incompletePtr->lexeme != QUESTION)) {
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" "
+ "without preceding \"?\"");
+ errCode = "SURPRISE";
+ goto error;
+ }
+
+ /*
+ * Attach complete tree as right operand of most recent
+ * incomplete tree.
+ */
+
+ incompletePtr->right = complete;
+ if (IsOperator(complete)) {
+ nodes[complete].p.parent = incomplete;
+ incompletePtr->constant = incompletePtr->constant
+ && nodes[complete].constant;
+ } else {
+ incompletePtr->constant = incompletePtr->constant
+ && (complete == OT_LITERAL);
+ }
+
+ /*
+ * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations
+ * each make up a single operator. Force them to agree whether
+ * they have a constant expression.
+ */
+
+ if ((incompletePtr->lexeme == QUESTION)
+ || (incompletePtr->lexeme == FUNCTION)) {
+ nodes[complete].constant = incompletePtr->constant;
+ }
+
+ if (incompletePtr->lexeme == START) {
+ /*
+ * Completing the START tree indicates we're done.
+ * Transfer the parse tree to the caller and return.
+ */
+
+ *opTreePtr = nodes;
+ return TCL_OK;
+ }
+
+ /*
+ * With a right operand attached, last incomplete tree has
+ * become the complete tree. Pop it from the incomplete tree
+ * stack.
+ */
+
+ complete = incomplete;
+ incomplete = incompletePtr->p.prev;
+
+ /* CLOSE_PAREN can only close one OPEN_PAREN. */
+ if (incompletePtr->lexeme == OPEN_PAREN) {
+ break;
+ }
+ }
+
+ /*
+ * More syntax checks...
+ */
+
+ /* Parens must balance. */
+ if (lexeme == CLOSE_PAREN) {
+ if (incompletePtr->lexeme != OPEN_PAREN) {
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
+ errCode = "UNBALANCED";
+ goto error;
+ }
+ }
+
+ /* Commas must appear only in function argument lists. */
+ if (lexeme == COMMA) {
+ if ((incompletePtr->lexeme != OPEN_PAREN)
+ || (incompletePtr[-1].lexeme != FUNCTION)) {
+ TclNewLiteralStringObj(msg,
+ "unexpected \",\" outside function argument list");
+ errCode = "SURPRISE";
+ goto error;
+ }
+ }
+
+ /* Operator ":" may only be right operand of "?" */
+ if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" without preceding \"?\"");
+ errCode = "SURPRISE";
+ goto error;
+ }
+
+ /*
+ * Create no node for a CLOSE_PAREN lexeme.
+ */
+
+ if (lexeme == CLOSE_PAREN) {
+ break;
+ }
+
+ /*
+ * Link complete tree as left operand of new node.
+ */
+
+ nodePtr->lexeme = lexeme;
+ nodePtr->precedence = precedence;
+ nodePtr->mark = MARK_LEFT;
+ nodePtr->left = complete;
+
+ /*
+ * The COMMA operator cannot be optimized, since the function
+ * needs all of its arguments, and optimization would reduce the
+ * number. Other binary operators root constant expressions when
+ * both arguments are constant expressions.
+ */
+
+ nodePtr->constant = (lexeme != COMMA);
+
+ if (IsOperator(complete)) {
+ nodes[complete].p.parent = nodesUsed;
+ nodePtr->constant = nodePtr->constant
+ && nodes[complete].constant;
+ } else {
+ nodePtr->constant = nodePtr->constant
+ && (complete == OT_LITERAL);
+ }
+
+ /*
+ * With a left operand attached and a right operand missing, the
+ * just-parsed binary operator is root of a new incomplete tree.
+ * Push it onto the stack of incomplete trees.
+ */
+
+ nodePtr->p.prev = incomplete;
+ incomplete = lastParsed = nodesUsed;
+ nodesUsed++;
+ break;
+ } /* case BINARY */
+ } /* lexeme handler */
+
+ /* Advance past the just-parsed lexeme */
+ start += scanned;
+ numBytes -= scanned;
+ } /* main parsing loop */
/*
- * Parse the expression then compile it.
+ * 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.
*/
- code = Tcl_ParseExpr(interp, script, numBytes, &parse);
- if (code != TCL_OK) {
- goto done;
+ error:
+ if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
+ parsePtr->errorType = TCL_PARSE_SYNTAX;
}
- code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
- if (code != TCL_OK) {
- Tcl_FreeParse(&parse);
- goto done;
+ /*
+ * Free any partial parse tree we've built.
+ */
+
+ if (nodes != NULL) {
+ ckfree(nodes);
}
- if (!info.hasOperators) {
+ if (interp == NULL) {
+ /*
+ * Nowhere to report an error message, so just free it.
+ */
+
+ if (msg) {
+ Tcl_DecrRefCount(msg);
+ }
+ } else {
+ /*
+ * Construct the complete error message. Start with the simple error
+ * message, pulled from the interp result if necessary...
+ */
+
+ if (msg == NULL) {
+ msg = Tcl_GetObjResult(interp);
+ }
+
+ /*
+ * Add a detailed quote from the bad expression, displaying and
+ * sometimes marking the precise location of the syntax error.
+ */
+
+ Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+ ((start - limit) < parsePtr->string) ? "" : "...",
+ ((start - limit) < parsePtr->string)
+ ? (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)
+ ? (int) (parsePtr->end - start) - scanned : limit-3,
+ start + scanned,
+ (start + scanned + limit > parsePtr->end) ? "" : "...");
+
/*
- * Attempt to convert the primary's object to an int or double. This
- * is done in order to support Tcl's policy of interpreting operands
- * if at all possible as first integers, else floating-point numbers.
+ * Next, append any postscript message.
*/
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+ if (post != NULL) {
+ Tcl_AppendToObj(msg, ";\n", -1);
+ Tcl_AppendObjToObj(msg, post);
+ Tcl_DecrRefCount(post);
+ }
+ Tcl_SetObjResult(interp, msg);
+
+ /*
+ * Finally, place context information in the errorInfo.
+ */
+
+ numBytes = parsePtr->end - parsePtr->string;
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\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);
+ }
}
- Tcl_FreeParse(&parse);
- done:
- return code;
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * TclFinalizeCompilation --
+ * ConvertTreeToTokens --
*
- * Clean up the compilation environment so it can later be properly
- * reinitialized. This procedure is called by Tcl_Finalize().
+ * Given a string, the numBytes bytes starting at start, and an OpNode
+ * tree and Tcl_Token array created by passing that same string to
+ * ParseExpr(), this function writes into *parsePtr the sequence of
+ * Tcl_Tokens needed so to satisfy the historical interface provided by
+ * Tcl_ParseExpr(). Note that this routine exists only for the sake of
+ * the public Tcl_ParseExpr() routine. It is not used by Tcl itself at
+ * all.
*
* Results:
* None.
*
* Side effects:
- * Cleans up the compilation environment. At the moment, just the table
- * of expression operators is freed.
+ * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
+ * parsed expression.
*
*----------------------------------------------------------------------
*/
-void
-TclFinalizeCompilation()
+static void
+ConvertTreeToTokens(
+ const char *start,
+ int numBytes,
+ OpNode *nodes,
+ Tcl_Token *tokenPtr,
+ Tcl_Parse *parsePtr)
{
- Tcl_MutexLock(&opMutex);
- if (opTableInitialized) {
- Tcl_DeleteHashTable(&opHashTable);
- opTableInitialized = 0;
- }
- Tcl_MutexUnlock(&opMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileSubExpr --
- *
- * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
- * subexpression, this procedure emits instructions to evaluate the
- * subexpression at runtime.
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the subexpression.
- *
- *----------------------------------------------------------------------
- */
+ int subExprTokenIdx = 0;
+ OpNode *nodePtr = nodes;
+ int next = nodePtr->right;
-static int
-CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
- Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token to
- * compile. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Tcl_Interp *interp = infoPtr->interp;
- Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
- OperatorDesc *opDescPtr;
- Tcl_HashEntry *hPtr;
- CONST char *operator;
- Tcl_DString opBuf;
- int objIndex, opIndex, length, code;
- char buffer[TCL_UTF_MAX];
-
- if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
- Tcl_Panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
- exprTokenPtr->type);
- }
- code = TCL_OK;
+ while (1) {
+ Tcl_Token *subExprTokenPtr;
+ int scanned, parentIdx;
+ unsigned char lexeme;
- /*
- * Switch on the type of the first token after the subexpression token.
- * After processing it, advance tokenPtr to point just after the
- * subexpression's last token.
- */
+ /*
+ * Advance the mark so the next exit from this node won't retrace
+ * steps over ground already covered.
+ */
- tokenPtr = exprTokenPtr+1;
- TRACE(exprTokenPtr->start, exprTokenPtr->size,
- tokenPtr->start, tokenPtr->size);
- switch (tokenPtr->type) {
- case TCL_TOKEN_WORD:
- TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr);
- tokenPtr += (tokenPtr->numComponents + 1);
- break;
+ nodePtr->mark++;
- case TCL_TOKEN_TEXT:
- if (tokenPtr->size > 0) {
- objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
- tokenPtr->size);
- } else {
- objIndex = TclRegisterNewLiteral(envPtr, "", 0);
- }
- TclEmitPush(objIndex, envPtr);
- tokenPtr += 1;
- break;
+ /*
+ * Handle next child node or leaf.
+ */
- case TCL_TOKEN_BS:
- length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer);
- if (length > 0) {
- objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
- } else {
- objIndex = TclRegisterNewLiteral(envPtr, "", 0);
- }
- TclEmitPush(objIndex, envPtr);
- tokenPtr += 1;
- break;
+ switch (next) {
+ case OT_EMPTY:
- case TCL_TOKEN_COMMAND:
- TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr);
- tokenPtr += 1;
- break;
+ /* No tokens and no characters for the OT_EMPTY leaf. */
+ break;
- case TCL_TOKEN_VARIABLE:
- TclCompileTokens(interp, tokenPtr, 1, envPtr);
- tokenPtr += (tokenPtr->numComponents + 1);
- break;
+ case OT_LITERAL:
- case TCL_TOKEN_SUB_EXPR:
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
- break;
+ /*
+ * Skip any white space that comes before the literal.
+ */
- case TCL_TOKEN_OPERATOR:
- /*
- * Look up the operator. If the operator isn't found, treat it as a
- * math function.
- */
- Tcl_DStringInit(&opBuf);
- operator = Tcl_DStringAppend(&opBuf, tokenPtr->start, tokenPtr->size);
- hPtr = Tcl_FindHashEntry(&opHashTable, operator);
- if (hPtr == NULL) {
- code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr,
- &endPtr);
- Tcl_DStringFree(&opBuf);
- if (code != TCL_OK) {
- goto done;
+ scanned = TclParseAllWhiteSpace(start, numBytes);
+ start += scanned;
+ numBytes -= scanned;
+
+ /*
+ * Reparse the literal to get pointers into source string.
+ */
+
+ scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
+
+ TclGrowParseTokenArray(parsePtr, 2);
+ subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ subExprTokenPtr->start = start;
+ subExprTokenPtr->size = scanned;
+ subExprTokenPtr->numComponents = 1;
+ subExprTokenPtr[1].type = TCL_TOKEN_TEXT;
+ subExprTokenPtr[1].start = start;
+ subExprTokenPtr[1].size = scanned;
+ subExprTokenPtr[1].numComponents = 0;
+
+ parsePtr->numTokens += 2;
+ start += scanned;
+ numBytes -= scanned;
+ break;
+
+ case OT_TOKENS: {
+ /*
+ * tokenPtr points to a token sequence that came from parsing a
+ * Tcl word. A Tcl word is made up of a sequence of one or more
+ * elements. When the word is only a single element, it's been the
+ * historical practice to replace the TCL_TOKEN_WORD token
+ * directly with a TCL_TOKEN_SUB_EXPR token. However, when the
+ * word has multiple elements, a TCL_TOKEN_WORD token is kept as a
+ * grouping device so that TCL_TOKEN_SUB_EXPR always has only one
+ * element. Wise or not, these are the rules the Tcl expr parser
+ * has followed, and for the sake of those few callers of
+ * Tcl_ParseExpr() we do not change them now. Internally, we can
+ * do better.
+ */
+
+ int toCopy = tokenPtr->numComponents + 1;
+
+ if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
+ /*
+ * Single element word. Copy tokens and convert the leading
+ * token to TCL_TOKEN_SUB_EXPR.
+ */
+
+ TclGrowParseTokenArray(parsePtr, toCopy);
+ subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ memcpy(subExprTokenPtr, tokenPtr,
+ (size_t) toCopy * sizeof(Tcl_Token));
+ subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ parsePtr->numTokens += toCopy;
+ } else {
+ /*
+ * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
+ * lead, with fields initialized from the leading token, then
+ * copy entire set of word tokens.
+ */
+
+ TclGrowParseTokenArray(parsePtr, toCopy+1);
+ subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ *subExprTokenPtr = *tokenPtr;
+ subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ subExprTokenPtr->numComponents++;
+ subExprTokenPtr++;
+ memcpy(subExprTokenPtr, tokenPtr,
+ (size_t) toCopy * sizeof(Tcl_Token));
+ parsePtr->numTokens += toCopy + 1;
}
- tokenPtr = endPtr;
+
+ scanned = tokenPtr->start + tokenPtr->size - start;
+ start += scanned;
+ numBytes -= scanned;
+ tokenPtr += toCopy;
break;
}
- Tcl_DStringFree(&opBuf);
- opIndex = (int) Tcl_GetHashValue(hPtr);
- opDescPtr = &(operatorTable[opIndex]);
- /*
- * If the operator is "normal", compile it using information from the
- * operator table.
- */
+ default:
- if (opDescPtr->numOperands > 0) {
- tokenPtr++;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
+ /*
+ * Advance to the child node, which is an operator.
+ */
- if (opDescPtr->numOperands == 2) {
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
+ nodePtr = nodes + next;
+
+ /*
+ * Skip any white space that comes before the subexpression.
+ */
+
+ scanned = TclParseAllWhiteSpace(start, numBytes);
+ start += scanned;
+ numBytes -= scanned;
+
+ /*
+ * Generate tokens for the operator / subexpression...
+ */
+
+ switch (nodePtr->lexeme) {
+ case OPEN_PAREN:
+ case COMMA:
+ case COLON:
+
+ /*
+ * Historical practice has been to have no Tcl_Tokens for
+ * these operators.
+ */
+
+ break;
+
+ default: {
+
+ /*
+ * Remember the index of the last subexpression we were
+ * working on -- that of our parent. We'll stack it later.
+ */
+
+ parentIdx = subExprTokenIdx;
+
+ /*
+ * Verify space for the two leading Tcl_Tokens representing
+ * the subexpression rooted by this operator. The first
+ * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second of
+ * type TCL_TOKEN_OPERATOR.
+ */
+
+ TclGrowParseTokenArray(parsePtr, 2);
+ subExprTokenIdx = parsePtr->numTokens;
+ subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+ parsePtr->numTokens += 2;
+ subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR;
+
+ /*
+ * Our current position scanning the string is the starting
+ * point for this subexpression.
+ */
+
+ subExprTokenPtr->start = start;
+
+ /*
+ * Eventually, we know that the numComponents field of the
+ * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means
+ * we can make other use of this field for now to track the
+ * stack of subexpressions we have pending.
+ */
+
+ subExprTokenPtr[1].numComponents = parentIdx;
+ break;
+ }
}
- TclEmitOpcode(opDescPtr->instruction, envPtr);
- infoPtr->hasOperators = 1;
break;
}
- /*
- * The operator requires special treatment, and is either "+" or "-",
- * or one of "&&", "||" or "?".
- */
+ /* Determine which way to exit the node on this pass. */
+ router:
+ switch (nodePtr->mark) {
+ case MARK_LEFT:
+ next = nodePtr->left;
+ break;
- switch (opIndex) {
- case OP_PLUS:
- case OP_MINUS:
- tokenPtr++;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
+ case MARK_RIGHT:
+ next = nodePtr->right;
/*
- * Check whether the "+" or "-" is unary.
+ * Skip any white space that comes before the operator.
*/
- afterSubexprPtr = exprTokenPtr + exprTokenPtr->numComponents+1;
- if (tokenPtr == afterSubexprPtr) {
- TclEmitOpcode(((opIndex==OP_PLUS)? INST_UPLUS : INST_UMINUS),
- envPtr);
- break;
- }
+ scanned = TclParseAllWhiteSpace(start, numBytes);
+ start += scanned;
+ numBytes -= scanned;
/*
- * The "+" or "-" is binary.
+ * Here we scan from the string the operator corresponding to
+ * nodePtr->lexeme.
*/
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
- TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), envPtr);
- break;
+ scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
- case OP_LAND:
- case OP_LOR:
- code = CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr,
- &endPtr);
- if (code != TCL_OK) {
- goto done;
+ switch(nodePtr->lexeme) {
+ case OPEN_PAREN:
+ case COMMA:
+ case COLON:
+
+ /*
+ * No tokens for these lexemes -> nothing to do.
+ */
+
+ break;
+
+ default:
+
+ /*
+ * Record in the TCL_TOKEN_OPERATOR token the pointers into
+ * the string marking where the operator is.
+ */
+
+ subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+ subExprTokenPtr[1].start = start;
+ subExprTokenPtr[1].size = scanned;
+ break;
}
- tokenPtr = endPtr;
+
+ start += scanned;
+ numBytes -= scanned;
break;
- case OP_QUESTY:
- code = CompileCondExpr(exprTokenPtr, infoPtr, envPtr, &endPtr);
- if (code != TCL_OK) {
- goto done;
+ case MARK_PARENT:
+ switch (nodePtr->lexeme) {
+ case START:
+
+ /* When we get back to the START node, we're done. */
+ return;
+
+ case COMMA:
+ case COLON:
+
+ /* No tokens for these lexemes -> nothing to do. */
+ break;
+
+ case OPEN_PAREN:
+
+ /*
+ * Skip past matching close paren.
+ */
+
+ scanned = TclParseAllWhiteSpace(start, numBytes);
+ start += scanned;
+ numBytes -= scanned;
+ scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
+ start += scanned;
+ numBytes -= scanned;
+ break;
+
+ default:
+
+ /*
+ * Before we leave this node/operator/subexpression for the
+ * last time, finish up its tokens....
+ *
+ * Our current position scanning the string is where the
+ * substring for the subexpression ends.
+ */
+
+ subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+ subExprTokenPtr->size = start - subExprTokenPtr->start;
+
+ /*
+ * All the Tcl_Tokens allocated and filled belong to
+ * this subexpresion. The first token is the leading
+ * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
+ * are its components.
+ */
+
+ subExprTokenPtr->numComponents =
+ (parsePtr->numTokens - subExprTokenIdx) - 1;
+
+ /*
+ * Finally, as we return up the tree to our parent, pop the
+ * parent subexpression off our subexpression stack, and
+ * fill in the zero numComponents for the operator Tcl_Token.
+ */
+
+ parentIdx = subExprTokenPtr[1].numComponents;
+ subExprTokenPtr[1].numComponents = 0;
+ subExprTokenIdx = parentIdx;
+ break;
}
- tokenPtr = endPtr;
- break;
- default:
- Tcl_Panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
- opIndex);
- } /* end switch on operator requiring special treatment */
- infoPtr->hasOperators = 1;
- break;
+ /*
+ * Since we're returning to parent, skip child handling code.
+ */
+
+ nodePtr = nodes + nodePtr->p.parent;
+ goto router;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseExpr --
+ *
+ * Given a string, the numBytes bytes starting at start, this function
+ * parses it as a Tcl expression and stores information about the
+ * structure of the expression in the Tcl_Parse struct indicated by the
+ * caller.
+ *
+ * Results:
+ * If the string is successfully parsed as a valid Tcl expression, TCL_OK
+ * is returned, and data about the expression structure is written to
+ * *parsePtr. If the string cannot be parsed as a valid Tcl expression,
+ * TCL_ERROR is returned, and if interp is non-NULL, an error message is
+ * written to interp.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the information
+ * about the expression, then additional space is malloc-ed. If the
+ * function returns TCL_OK then the caller must eventually invoke
+ * Tcl_FreeParse to release any additional space that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseExpr(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *start, /* Start of source string to parse. */
+ int numBytes, /* Number of bytes in string. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
+ Tcl_Parse *parsePtr) /* Structure to fill with information about
+ * the parsed expression; any previous
+ * information in the structure is ignored. */
+{
+ int code;
+ OpNode *opTree = NULL; /* Will point to the tree of operators. */
+ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */
+ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */
+ Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Holds the Tcl_Tokens of substitutions. */
- default:
- Tcl_Panic("CompileSubExpr: unexpected token type %d\n",
- tokenPtr->type);
+ if (numBytes < 0) {
+ numBytes = (start ? strlen(start) : 0);
}
- /*
- * Verify that the subexpression token had the required number of
- * subtokens: that we've advanced tokenPtr just beyond the subexpression's
- * last token. For example, a "*" subexpression must contain the tokens
- * for exactly two operands.
- */
+ code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
+ exprParsePtr, 1 /* parseOnly */);
+ Tcl_DecrRefCount(funcList);
+ Tcl_DecrRefCount(litList);
- if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
- LogSyntaxError(infoPtr);
- code = TCL_ERROR;
+ TclParseInit(interp, start, numBytes, parsePtr);
+ if (code == TCL_OK) {
+ ConvertTreeToTokens(start, numBytes,
+ opTree, exprParsePtr->tokenPtr, parsePtr);
+ } else {
+ parsePtr->term = exprParsePtr->term;
+ parsePtr->errorType = exprParsePtr->errorType;
}
- done:
+ Tcl_FreeParse(exprParsePtr);
+ TclStackFree(interp, exprParsePtr);
+ ckfree(opTree);
return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileLandOrLorExpr --
+ * ParseLexeme --
*
- * This procedure compiles a Tcl logical and ("&&") or logical or ("||")
- * subexpression.
+ * Parse a single lexeme from the start of a string, scanning no more
+ * than numBytes bytes.
*
* Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_OK is returned, a pointer to the token just after
- * the last one in the subexpression is stored at the address in
- * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
+ * Returns the number of bytes scanned to produce the lexeme.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
+ * Code identifying lexeme parsed is writen to *lexemePtr.
*
*----------------------------------------------------------------------
*/
static int
-CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
- Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
- * containing the "&&" or "||" operator. */
- int opIndex; /* A code describing the expression operator:
- * either OP_LAND or OP_LOR. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
- Tcl_Token **endPtrPtr; /* If successful, a pointer to the token just
- * after the last token in the subexpression
- * is stored here. */
+ParseLexeme(
+ const char *start, /* Start of lexeme to parse. */
+ int numBytes, /* Number of bytes in string. */
+ unsigned char *lexemePtr, /* Write code of parsed lexeme to this
+ * storage. */
+ Tcl_Obj **literalPtr) /* Write corresponding literal value to this
+ storage, if non-NULL. */
{
- JumpFixup shortCircuitFixup;/* Used to fix up the short circuit jump after
- * the first subexpression. */
- JumpFixup shortCircuitFixup2;
- /* Used to fix up the second jump to the
- * short-circuit target. */
- JumpFixup endFixup; /* Used to fix up jump to the end. */
- Tcl_Token *tokenPtr;
- int code;
- int savedStackDepth = envPtr->currStackDepth;
+ const char *end;
+ int scanned;
+ Tcl_UniChar ch;
+ Tcl_Obj *literal = NULL;
+ unsigned char byte;
+
+ if (numBytes == 0) {
+ *lexemePtr = END;
+ return 0;
+ }
+ byte = UCHAR(*start);
+ if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
+ *lexemePtr = Lexeme[byte];
+ return 1;
+ }
+ switch (byte) {
+ case '*':
+ if ((numBytes > 1) && (start[1] == '*')) {
+ *lexemePtr = EXPON;
+ return 2;
+ }
+ *lexemePtr = MULT;
+ return 1;
- /*
- * Emit code for the first operand.
- */
+ case '=':
+ if ((numBytes > 1) && (start[1] == '=')) {
+ *lexemePtr = EQUAL;
+ return 2;
+ }
+ *lexemePtr = INCOMPLETE;
+ return 1;
- tokenPtr = exprTokenPtr+2;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
+ case '!':
+ if ((numBytes > 1) && (start[1] == '=')) {
+ *lexemePtr = NEQ;
+ return 2;
+ }
+ *lexemePtr = NOT;
+ return 1;
- /*
- * Emit the short-circuit jump.
- */
+ case '&':
+ if ((numBytes > 1) && (start[1] == '&')) {
+ *lexemePtr = AND;
+ return 2;
+ }
+ *lexemePtr = BIT_AND;
+ return 1;
- TclEmitForwardJump(envPtr,
- ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
- &shortCircuitFixup);
+ case '|':
+ if ((numBytes > 1) && (start[1] == '|')) {
+ *lexemePtr = OR;
+ return 2;
+ }
+ *lexemePtr = BIT_OR;
+ return 1;
+
+ case '<':
+ if (numBytes > 1) {
+ switch (start[1]) {
+ case '<':
+ *lexemePtr = LEFT_SHIFT;
+ return 2;
+ case '=':
+ *lexemePtr = LEQ;
+ return 2;
+ }
+ }
+ *lexemePtr = LESS;
+ return 1;
+
+ case '>':
+ if (numBytes > 1) {
+ switch (start[1]) {
+ case '>':
+ *lexemePtr = RIGHT_SHIFT;
+ return 2;
+ case '=':
+ *lexemePtr = GEQ;
+ return 2;
+ }
+ }
+ *lexemePtr = GREATER;
+ return 1;
- /*
- * Emit code for the second operand.
- */
+ case 'i':
+ if ((numBytes > 1) && (start[1] == 'n')
+ && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ /*
+ * Must make this check so we can tell the difference between the
+ * "in" operator and the "int" function name and the "infinity"
+ * numeric value.
+ */
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
+ *lexemePtr = IN_LIST;
+ return 2;
+ }
+ break;
+
+ case 'e':
+ if ((numBytes > 1) && (start[1] == 'q')
+ && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ *lexemePtr = STREQ;
+ return 2;
+ }
+ break;
+
+ case 'n':
+ if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ switch (start[1]) {
+ case 'e':
+ *lexemePtr = STRNEQ;
+ return 2;
+ case 'i':
+ *lexemePtr = NOT_IN_LIST;
+ return 2;
+ }
+ }
}
- tokenPtr += (tokenPtr->numComponents + 1);
- /*
- * The result is the boolean value of the second operand. We code this in
- * a somewhat contorted manner to be able to reuse the shortCircuit value
- * and save one INST_JUMP.
- */
+ literal = Tcl_NewObj();
+ if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
+ TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
+ 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 {
+ unsigned char lexeme;
- TclEmitForwardJump(envPtr,
- ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
- &shortCircuitFixup2);
+ /*
+ * 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;
+ }
- if (opIndex == OP_LAND) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
+ /*
+ * Otherwise, fall through and parse the whole as a bareword.
+ */
+ }
+ }
+
+ if (Tcl_UtfCharComplete(start, numBytes)) {
+ scanned = Tcl_UtfToUniChar(start, &ch);
} else {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
+ char utfBytes[TCL_UTF_MAX];
+
+ memcpy(utfBytes, start, (size_t) numBytes);
+ utfBytes[numBytes] = '\0';
+ scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
+ if (!isalnum(UCHAR(ch))) {
+ *lexemePtr = INVALID;
+ Tcl_DecrRefCount(literal);
+ return scanned;
+ }
+ end = start;
+ while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
+ end += scanned;
+ numBytes -= scanned;
+ if (Tcl_UtfCharComplete(end, numBytes)) {
+ scanned = Tcl_UtfToUniChar(end, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
- /*
- * Fixup the short-circuit jumps and push the shortCircuit value. Note
- * that shortCircuitFixup2 is always a short jump.
- */
+ memcpy(utfBytes, end, (size_t) numBytes);
+ utfBytes[numBytes] = '\0';
+ scanned = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
+ }
+ *lexemePtr = BAREWORD;
+ if (literalPtr) {
+ Tcl_SetStringObj(literal, start, (int) (end-start));
+ *literalPtr = literal;
+ } else {
+ Tcl_DecrRefCount(literal);
+ }
+ return (end-start);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExpr --
+ *
+ * This procedure compiles a string containing a Tcl expression into Tcl
+ * bytecodes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds instructions to envPtr to evaluate the expression at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCompileExpr(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *script, /* The source script to compile. */
+ int numBytes, /* Number of bytes in script. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int optimize) /* 0 for one-off expressions. */
+{
+ OpNode *opTree = NULL; /* Will point to the tree of operators */
+ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */
+ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/
+ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Holds the Tcl_Tokens of substitutions */
+
+ int code = ParseExpr(interp, script, numBytes, &opTree, litList,
+ funcList, parsePtr, 0 /* parseOnly */);
- TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup2, 127);
- if (TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup, 127)) {
+ if (code == TCL_OK) {
/*
- * shortCircuit jump grown by 3 bytes: update endFixup.
+ * Valid parse; compile the tree.
*/
- endFixup.codeOffset += 3;
- }
+ int objc;
+ Tcl_Obj *const *litObjv;
+ Tcl_Obj **funcObjv;
+
+ /* TIP #280 : Track Lines within the expression */
+ TclAdvanceLines(&envPtr->line, script,
+ script + TclParseAllWhiteSpace(script, numBytes));
- if (opIndex == OP_LAND) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
+ TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
+ TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
+ CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
+ parsePtr->tokenPtr, envPtr, optimize);
} else {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
+ TclCompileSyntaxError(interp, envPtr);
}
- TclFixupForwardJumpToHere(envPtr, &endFixup, 127);
- *endPtrPtr = tokenPtr;
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
+ Tcl_DecrRefCount(funcList);
+ Tcl_DecrRefCount(litList);
+ ckfree(opTree);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExecConstantExprTree --
+ * Compiles and executes bytecode for the subexpression tree at index
+ * in the nodes array. This subexpression must be constant, made up
+ * of only constant operators (not functions) and literals.
+ *
+ * Results:
+ * A standard Tcl return code and result left in interp.
+ *
+ * Side effects:
+ * Consumes subtree of nodes rooted at index. Advances the pointer
+ * *litObjvPtr.
+ *
+ *----------------------------------------------------------------------
+ */
- done:
- envPtr->currStackDepth = savedStackDepth + 1;
+static int
+ExecConstantExprTree(
+ Tcl_Interp *interp,
+ OpNode *nodes,
+ int index,
+ Tcl_Obj *const **litObjvPtr)
+{
+ CompileEnv *envPtr;
+ ByteCode *byteCodePtr;
+ int code;
+ Tcl_Obj *byteCodeObj = Tcl_NewObj();
+ NRE_callback *rootPtr = TOP_CB(interp);
+
+ /*
+ * Note we are compiling an expression with literal arguments. This means
+ * there can be no [info frame] calls when we execute the resulting
+ * bytecode, so there's no need to tend to TIP 280 issues.
+ */
+
+ envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
+ TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
+ CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
+ 0 /* optimize */);
+ TclEmitOpcode(INST_DONE, envPtr);
+ Tcl_IncrRefCount(byteCodeObj);
+ TclInitByteCodeObj(byteCodeObj, envPtr);
+ TclFreeCompileEnv(envPtr);
+ TclStackFree(interp, envPtr);
+ byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
+ TclNRExecuteByteCode(interp, byteCodePtr);
+ code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+ Tcl_DecrRefCount(byteCodeObj);
return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileCondExpr --
+ * CompileExprTree --
*
- * This procedure compiles a Tcl conditional expression:
- * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
+ * Compiles and writes to envPtr instructions for the subexpression tree
+ * at index in the nodes array. (*litObjvPtr) must point to the proper
+ * location in a corresponding literals list. Likewise, when non-NULL,
+ * funcObjv and tokenPtr must point into matching arrays of function
+ * names and Tcl_Token's derived from earlier call to ParseExpr(). When
+ * optimize is true, any constant subexpressions will be precomputed.
*
* Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_OK is returned, a pointer to the token just after
- * the last one in the subexpression is stored at the address in
- * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
+ * None.
*
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
+ * Consumes subtree of nodes rooted at index. Advances the pointer
+ * *litObjvPtr.
*
*----------------------------------------------------------------------
*/
-static int
-CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
- Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
- * containing the "?" operator. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
- Tcl_Token **endPtrPtr; /* If successful, a pointer to the token just
- * after the last token in the subexpression
- * is stored here. */
+static void
+CompileExprTree(
+ Tcl_Interp *interp,
+ OpNode *nodes,
+ int index,
+ Tcl_Obj *const **litObjvPtr,
+ Tcl_Obj *const *funcObjv,
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr,
+ int optimize)
{
- JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
- /* Used to update or replace one-byte jumps
- * around the then and else expressions when
- * their target PCs are determined. */
- Tcl_Token *tokenPtr;
- int elseCodeOffset, dist, code;
- int savedStackDepth = envPtr->currStackDepth;
+ OpNode *nodePtr = nodes + index;
+ OpNode *rootPtr = nodePtr;
+ int numWords = 0;
+ JumpList *jumpPtr = NULL;
+ int convert = 1;
- /*
- * Emit code for the test.
- */
+ while (1) {
+ int next;
+ JumpList *freePtr, *newJump;
- tokenPtr = exprTokenPtr+2;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
+ if (nodePtr->mark == MARK_LEFT) {
+ next = nodePtr->left;
- /*
- * Emit the jump to the "else" expression if the test was false.
- */
+ if (nodePtr->lexeme == QUESTION) {
+ convert = 1;
+ }
+ } else if (nodePtr->mark == MARK_RIGHT) {
+ next = nodePtr->right;
+
+ switch (nodePtr->lexeme) {
+ case FUNCTION: {
+ Tcl_DString cmdName;
+ const char *p;
+ int length;
+
+ Tcl_DStringInit(&cmdName);
+ TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
+ p = TclGetStringFromObj(*funcObjv, &length);
+ funcObjv++;
+ Tcl_DStringAppend(&cmdName, p, length);
+ TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
+ Tcl_DStringValue(&cmdName),
+ Tcl_DStringLength(&cmdName)), envPtr);
+ Tcl_DStringFree(&cmdName);
+
+ /*
+ * Start a count of the number of words in this function
+ * command invocation. In case there's already a count in
+ * progress (nested functions), save it in our unused "left"
+ * field for restoring later.
+ */
+
+ nodePtr->left = numWords;
+ numWords = 2; /* Command plus one argument */
+ break;
+ }
+ case QUESTION:
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
+ break;
+ case COLON:
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &jumpPtr->jump);
+ TclAdjustStackDepth(-1, envPtr);
+ if (convert) {
+ jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
+ }
+ convert = 1;
+ break;
+ case AND:
+ case OR:
+ newJump = TclStackAlloc(interp, sizeof(JumpList));
+ newJump->next = jumpPtr;
+ jumpPtr = newJump;
+ TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
+ ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
+ break;
+ }
+ } else {
+ int pc1, pc2, target;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
+ switch (nodePtr->lexeme) {
+ case START:
+ case QUESTION:
+ if (convert && (nodePtr == rootPtr)) {
+ TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+ }
+ break;
+ case OPEN_PAREN:
- /*
- * Compile the "then" expression. Note that if a subexpression is only a
- * primary, we need to try to convert it to numeric. We do this to support
- * Tcl's policy of interpreting operands if at all possible as first
- * integers, else floating-point numbers.
- */
+ /* do nothing */
+ break;
+ case FUNCTION:
+ /*
+ * Use the numWords count we've kept to invoke the function
+ * command with the correct number of arguments.
+ */
+
+ if (numWords < 255) {
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
+ } else {
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
+ }
- infoPtr->hasOperators = 0;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- tokenPtr += (tokenPtr->numComponents + 1);
- if (!infoPtr->hasOperators) {
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
- }
+ /*
+ * Restore any saved numWords value.
+ */
- /*
- * Emit an unconditional jump around the "else" condExpr.
- */
+ numWords = nodePtr->left;
+ convert = 1;
+ break;
+ case COMMA:
+ /*
+ * Each comma implies another function argument.
+ */
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpAroundElseFixup);
+ numWords++;
+ break;
+ case COLON:
+ CLANG_ASSERT(jumpPtr);
+ if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
+ jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
+ convert = 1;
+ }
+ target = jumpPtr->jump.codeOffset + 2;
+ if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
+ target += 3;
+ }
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ TclFixupForwardJump(envPtr, &jumpPtr->jump,
+ target - jumpPtr->jump.codeOffset, 127);
+
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ break;
+ case AND:
+ case OR:
+ CLANG_ASSERT(jumpPtr);
+ pc1 = CurrentOffset(envPtr);
+ TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
+ : INST_JUMP_TRUE1, 0, envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
+ pc2 = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP1, 0, envPtr);
+ TclAdjustStackDepth(-1, envPtr);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
+ envPtr->codeStart + pc1 + 1);
+ if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
+ pc2 += 3;
+ }
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
+ envPtr->codeStart + pc2 + 1);
+ convert = 0;
+ freePtr = jumpPtr;
+ jumpPtr = jumpPtr->next;
+ TclStackFree(interp, freePtr);
+ break;
+ default:
+ TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
+ convert = 0;
+ break;
+ }
+ if (nodePtr == rootPtr) {
+ /* We're done */
- /*
- * Compile the "else" expression.
- */
+ return;
+ }
+ nodePtr = nodes + nodePtr->p.parent;
+ continue;
+ }
- envPtr->currStackDepth = savedStackDepth;
- elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- infoPtr->hasOperators = 0;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- goto done;
+ nodePtr->mark++;
+ switch (next) {
+ case OT_EMPTY:
+ numWords = 1; /* No arguments, so just the command */
+ break;
+ case OT_LITERAL: {
+ Tcl_Obj *const *litObjv = *litObjvPtr;
+ Tcl_Obj *literal = *litObjv;
+
+ if (optimize) {
+ int length;
+ const char *bytes = TclGetStringFromObj(literal, &length);
+ int index = TclRegisterNewLiteral(envPtr, bytes, length);
+ Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
+
+ if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
+ /*
+ * Would like to do this:
+ *
+ * lePtr->objPtr = literal;
+ * Tcl_IncrRefCount(literal);
+ * Tcl_DecrRefCount(objPtr);
+ *
+ * However, the design of the "global" and "local"
+ * LiteralTable does not permit the value of lePtr->objPtr
+ * to change. So rather than replace lePtr->objPtr, we do
+ * surgery to transfer our desired intrep into it.
+ */
+
+ objPtr->typePtr = literal->typePtr;
+ objPtr->internalRep = literal->internalRep;
+ literal->typePtr = NULL;
+ }
+ TclEmitPush(index, envPtr);
+ } else {
+ /*
+ * When optimize==0, we know the expression is a one-off and
+ * there's nothing to be gained from sharing literals when
+ * they won't live long, and the copies we have already have
+ * an appropriate intrep. In this case, skip literal
+ * registration that would enable sharing, and use the routine
+ * that preserves intreps.
+ */
+
+ TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+ }
+ (*litObjvPtr)++;
+ break;
+ }
+ case OT_TOKENS:
+ CompileTokens(envPtr, tokenPtr, interp);
+ tokenPtr += tokenPtr->numComponents + 1;
+ break;
+ default:
+ if (optimize && nodes[next].constant) {
+ Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);
+
+ if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
+ == TCL_OK) {
+ 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 = TclFetchLiteral(envPtr, index);
+ 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);
+ }
+ Tcl_RestoreInterpState(interp, save);
+ convert = 0;
+ } else {
+ nodePtr = nodes + next;
+ }
+ }
}
- tokenPtr += (tokenPtr->numComponents + 1);
- if (!infoPtr->hasOperators) {
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * or exactly two arguments as suitable for the operator.
+ *
+ * Results:
+ * A standard Tcl return code and result left in interp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSingleOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ TclOpCmdClientData *occdPtr = clientData;
+ unsigned char lexeme;
+ OpNode nodes[2];
+ Tcl_Obj *const *litObjv = objv + 1;
+
+ if (objc != 1 + occdPtr->i.numArgs) {
+ Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+ return TCL_ERROR;
}
- /*
- * Fix up the second jump around the "else" expression.
- */
+ ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+ nodes[0].lexeme = START;
+ nodes[0].mark = MARK_RIGHT;
+ nodes[0].right = 1;
+ nodes[1].lexeme = lexeme;
+ if (objc == 2) {
+ nodes[1].mark = MARK_RIGHT;
+ } else {
+ nodes[1].mark = MARK_LEFT;
+ nodes[1].left = OT_LITERAL;
+ }
+ nodes[1].right = OT_LITERAL;
+ nodes[1].p.parent = 0;
- dist = (envPtr->codeNext - envPtr->codeStart)
- - jumpAroundElseFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
- /*
- * Update the else expression's starting code offset since it moved
- * down 3 bytes too.
- */
+ return ExecConstantExprTree(interp, nodes, 0, &litObjv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSortingOpCmd --
+ * Implements the commands:
+ * <, <=, >, >=, ==, eq
+ * in the ::tcl::mathop namespace. These commands are defined for
+ * arbitrary number of arguments by computing the AND of the base
+ * operator applied to all neighbor argument pairs.
+ *
+ * Results:
+ * A standard Tcl return code and result left in interp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- elseCodeOffset += 3;
- }
+int
+TclSortingOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int code = TCL_OK;
- /*
- * Fix up the first jump to the "else" expression if the test was false.
- */
+ if (objc < 3) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ } else {
+ TclOpCmdClientData *occdPtr = clientData;
+ Tcl_Obj **litObjv = TclStackAlloc(interp,
+ 2 * (objc-2) * sizeof(Tcl_Obj *));
+ OpNode *nodes = TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
+ unsigned char lexeme;
+ int i, lastAnd = 1;
+ Tcl_Obj *const *litObjPtrPtr = litObjv;
+
+ ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+
+ litObjv[0] = objv[1];
+ nodes[0].lexeme = START;
+ nodes[0].mark = MARK_RIGHT;
+ for (i=2; i<objc-1; i++) {
+ litObjv[2*(i-1)-1] = objv[i];
+ nodes[2*(i-1)-1].lexeme = lexeme;
+ nodes[2*(i-1)-1].mark = MARK_LEFT;
+ nodes[2*(i-1)-1].left = OT_LITERAL;
+ nodes[2*(i-1)-1].right = OT_LITERAL;
+
+ litObjv[2*(i-1)] = objv[i];
+ nodes[2*(i-1)].lexeme = AND;
+ nodes[2*(i-1)].mark = MARK_LEFT;
+ nodes[2*(i-1)].left = lastAnd;
+ nodes[lastAnd].p.parent = 2*(i-1);
+
+ nodes[2*(i-1)].right = 2*(i-1)+1;
+ nodes[2*(i-1)+1].p.parent= 2*(i-1);
+
+ lastAnd = 2*(i-1);
+ }
+ litObjv[2*(objc-2)-1] = objv[objc-1];
+
+ nodes[2*(objc-2)-1].lexeme = lexeme;
+ nodes[2*(objc-2)-1].mark = MARK_LEFT;
+ nodes[2*(objc-2)-1].left = OT_LITERAL;
+ nodes[2*(objc-2)-1].right = OT_LITERAL;
- dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
- TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
- *endPtrPtr = tokenPtr;
+ nodes[0].right = lastAnd;
+ nodes[lastAnd].p.parent = 0;
- done:
- envPtr->currStackDepth = savedStackDepth + 1;
+ code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
+
+ TclStackFree(interp, nodes);
+ TclStackFree(interp, litObjv);
+ }
return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileMathFuncCall --
- *
- * This procedure compiles a call on a math function in an expression:
- * mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
+ * TclVariadicOpCmd --
+ * Implements the commands: +, *, &, |, ^, **
+ * in the ::tcl::mathop namespace. These commands are defined for
+ * arbitrary number of arguments by repeatedly applying the base
+ * operator with suitable associative rules. When fewer than two
+ * arguments are provided, suitable identity values are returned.
*
* Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_OK is returned, a pointer to the token just after
- * the last one in the subexpression is stored at the address in
- * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
+ * A standard Tcl return code and result left in interp.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the math function at
- * runtime.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int
-CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
- Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
- * containing the math function call. */
- CONST char *funcName; /* Name of the math function. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
- Tcl_Token **endPtrPtr; /* If successful, a pointer to the token just
- * after the last token in the subexpression
- * is stored here. */
+int
+TclVariadicOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
- Tcl_DString cmdName;
- int objIndex;
- Tcl_Token *tokenPtr, *afterSubexprPtr;
- int argCount;
- int code = TCL_OK;
+ TclOpCmdClientData *occdPtr = clientData;
+ unsigned char lexeme;
+ int code;
- /*
- * Prepend "tcl::mathfunc::" to the function name, to produce the name of
- * a command that evaluates the function. Push that command name on the
- * stack, in a literal registered to the namespace so that resolution can
- * be cached.
- */
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
+ return TCL_OK;
+ }
- Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
- Tcl_DStringAppend(&cmdName, funcName, -1);
- objIndex = TclRegisterNewNSLiteral(envPtr, Tcl_DStringValue(&cmdName),
- Tcl_DStringLength(&cmdName));
- TclEmitPush(objIndex, envPtr);
- Tcl_DStringFree(&cmdName);
+ ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+ lexeme |= BINARY;
+
+ if (objc == 2) {
+ Tcl_Obj *litObjv[2];
+ OpNode nodes[2];
+ int decrMe = 0;
+ Tcl_Obj *const *litObjPtrPtr = litObjv;
+
+ if (lexeme == EXPON) {
+ litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
+ Tcl_IncrRefCount(litObjv[1]);
+ decrMe = 1;
+ litObjv[0] = objv[1];
+ nodes[0].lexeme = START;
+ nodes[0].mark = MARK_RIGHT;
+ nodes[0].right = 1;
+ nodes[1].lexeme = lexeme;
+ nodes[1].mark = MARK_LEFT;
+ nodes[1].left = OT_LITERAL;
+ nodes[1].right = OT_LITERAL;
+ nodes[1].p.parent = 0;
+ } else {
+ if (lexeme == DIVIDE) {
+ litObjv[0] = Tcl_NewDoubleObj(1.0);
+ } else {
+ litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
+ }
+ Tcl_IncrRefCount(litObjv[0]);
+ litObjv[1] = objv[1];
+ nodes[0].lexeme = START;
+ nodes[0].mark = MARK_RIGHT;
+ nodes[0].right = 1;
+ nodes[1].lexeme = lexeme;
+ nodes[1].mark = MARK_LEFT;
+ nodes[1].left = OT_LITERAL;
+ nodes[1].right = OT_LITERAL;
+ nodes[1].p.parent = 0;
+ }
- /*
- * Compile any arguments for the function.
- */
+ code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
- argCount = 1;
- tokenPtr = exprTokenPtr+2;
- afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
- while (tokenPtr != afterSubexprPtr) {
- ++argCount;
- code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
- if (code != TCL_OK) {
- return code;
+ Tcl_DecrRefCount(litObjv[decrMe]);
+ return code;
+ } else {
+ Tcl_Obj *const *litObjv = objv + 1;
+ OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
+ int i, lastOp = OT_LITERAL;
+
+ nodes[0].lexeme = START;
+ nodes[0].mark = MARK_RIGHT;
+ if (lexeme == EXPON) {
+ for (i=objc-2; i>0; i--) {
+ nodes[i].lexeme = lexeme;
+ nodes[i].mark = MARK_LEFT;
+ nodes[i].left = OT_LITERAL;
+ nodes[i].right = lastOp;
+ if (lastOp >= 0) {
+ nodes[lastOp].p.parent = i;
+ }
+ lastOp = i;
+ }
+ } else {
+ for (i=1; i<objc-1; i++) {
+ nodes[i].lexeme = lexeme;
+ nodes[i].mark = MARK_LEFT;
+ nodes[i].left = lastOp;
+ if (lastOp >= 0) {
+ nodes[lastOp].p.parent = i;
+ }
+ nodes[i].right = OT_LITERAL;
+ lastOp = i;
+ }
}
- tokenPtr += (tokenPtr->numComponents + 1);
- }
+ nodes[0].right = lastOp;
+ nodes[lastOp].p.parent = 0;
- /* Invoke the function */
+ code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
- if (argCount < 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, argCount, envPtr);
- } else {
- TclEmitInstInt4(INST_INVOKE_STK4, argCount, envPtr);
+ TclStackFree(interp, nodes);
+ return code;
}
-
- *endPtrPtr = afterSubexprPtr;
- return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * LogSyntaxError --
- *
- * This procedure is invoked after an error occurs when compiling an
- * expression. It sets the interpreter result to an error message
- * describing the error.
+ * TclNoIdentOpCmd --
+ * Implements the commands: -, /
+ * in the ::tcl::mathop namespace. These commands are defined for
+ * arbitrary non-zero number of arguments by repeatedly applying the base
+ * operator with suitable associative rules. When no arguments are
+ * provided, an error is raised.
*
* Results:
- * None.
+ * A standard Tcl return code and result left in interp.
*
* Side effects:
- * Sets the interpreter result to an error message describing the
- * expression that was being compiled when the error occurred.
+ * None.
*
*----------------------------------------------------------------------
*/
-static void
-LogSyntaxError(infoPtr)
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
+int
+TclNoIdentOpCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
- Tcl_Obj *result =
- Tcl_NewStringObj("syntax error in expression \"", -1);
- TclAppendLimitedToObj(result, infoPtr->expr,
- (int)(infoPtr->lastChar - infoPtr->expr), 60, "");
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(infoPtr->interp, result);
+ TclOpCmdClientData *occdPtr = clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+ return TCL_ERROR;
+ }
+ return TclVariadicOpCmd(clientData, interp, objc, objv);
}
-
/*
* Local Variables:
* mode: c
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6cc8428..347e3f0 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -6,16 +6,15 @@
* of instructions ("bytecodes").
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 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: tclCompile.c,v 1.90 2005/07/21 21:49:02 dkf Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+#include <assert.h>
/*
* Table of all AuxData types.
@@ -39,10 +38,10 @@ 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
+ * must correspond to the instruction opcode definitions in tclCompile.h. The
* names "op1" and "op4" refer to an instruction's one or four byte first
* operand. Similarly, "stktop" and "stknext" refer to the topmost and next to
* topmost stack elements.
@@ -52,7 +51,7 @@ static int traceInitialized = 0;
* existence of a procedure call frame to distinguish these.
*/
-InstructionDesc tclInstructionTable[] = {
+InstructionDesc const tclInstructionTable[] = {
/* Name Bytes stackEffect #Opnds Operand types */
{"done", 1, -1, 0, {OPERAND_NONE}},
/* Finish ByteCode execution and return stktop (top stack item) */
@@ -64,7 +63,7 @@ InstructionDesc tclInstructionTable[] = {
/* Pop the topmost stack object */
{"dup", 1, +1, 0, {OPERAND_NONE}},
/* Duplicate the topmost stack object and push the result */
- {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Concatenate the top op1 items and push result */
{"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
@@ -156,11 +155,11 @@ InstructionDesc tclInstructionTable[] = {
{"lt", 1, -1, 0, {OPERAND_NONE}},
/* Less: push (stknext < stktop) */
{"gt", 1, -1, 0, {OPERAND_NONE}},
- /* Greater: push (stknext || stktop) */
+ /* Greater: push (stknext > stktop) */
{"le", 1, -1, 0, {OPERAND_NONE}},
- /* Logical or: push (stknext || stktop) */
+ /* Less or equal: push (stknext <= stktop) */
{"ge", 1, -1, 0, {OPERAND_NONE}},
- /* Logical or: push (stknext || stktop) */
+ /* Greater or equal: push (stknext >= stktop) */
{"lshift", 1, -1, 0, {OPERAND_NONE}},
/* Left shift: push (stknext << stktop) */
{"rshift", 1, -1, 0, {OPERAND_NONE}},
@@ -186,7 +185,7 @@ InstructionDesc tclInstructionTable[] = {
{"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
/* Call builtin math function with index op1; any args are on stk */
{"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
- /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
+ /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
{"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
/* Try converting stktop to first int then double if possible. */
@@ -196,15 +195,15 @@ InstructionDesc tclInstructionTable[] = {
/* Skip to next iteration of closest enclosing loop; if none, return
* TCL_CONTINUE code. */
- {"foreach_start4", 5, 0, 1, {OPERAND_UINT4}},
+ {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}},
/* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. */
- {"foreach_step4", 5, +1, 1, {OPERAND_UINT4}},
+ {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}},
/* "Step" or begin next iteration of foreach loop. Push 0 if to
- * terminate loop, else push 1. */
+ * terminate loop, else push 1. */
{"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
- /* Record start of catch with the operand's exception index. Push the
+ /* Record start of catch with the operand's exception index. Push the
* current stack depth onto a special catch stack. */
{"endCatch", 1, 0, 0, {OPERAND_NONE}},
/* End of last catch. Pop the bytecode interpreter's catch stack. */
@@ -289,8 +288,8 @@ InstructionDesc tclInstructionTable[] = {
* is emitted.
*/
{"expandStart", 1, 0, 0, {OPERAND_NONE}},
- /* Start of command with {expand}ed arguments */
- {"expandStkTop", 5, 0, 1, {OPERAND_INT4}},
+ /* Start of command with {*} (expanded) arguments */
+ {"expandStkTop", 5, 0, 1, {OPERAND_UINT4}},
/* Expand the list at stacktop: push its elements on the stack */
{"invokeExpanded", 1, 0, 0, {OPERAND_NONE}},
/* Invoke the command marked by the last 'expandStart' */
@@ -299,8 +298,9 @@ InstructionDesc tclInstructionTable[] = {
/* List Index: push (lindex stktop op4) */
{"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
/* List Range: push (lrange stktop op4 op4) */
- {"startCommand", 5, 0, 1, {OPERAND_UINT4}},
- /* Start of bytecoded command: op is the length of the cmd's code */
+ {"startCommand", 9, 0, 2, {OPERAND_INT4,OPERAND_UINT4}},
+ /* Start of bytecoded command: op is the length of the cmd's code, op2
+ * is number of commands here */
{"listIn", 1, -1, 0, {OPERAND_NONE}},
/* List containment: push [lsearch stktop stknext]>=0) */
@@ -310,7 +310,7 @@ InstructionDesc tclInstructionTable[] = {
{"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}},
/* Push the interpreter's return option dictionary as an object on the
* stack. */
- {"returnStk", 1, -2, 0, {OPERAND_NONE}},
+ {"returnStk", 1, -1, 0, {OPERAND_NONE}},
/* Compiled [return]; options and result are on the stack, code and
* level are in the options. */
@@ -319,15 +319,15 @@ InstructionDesc tclInstructionTable[] = {
* below the keys on the stack, and all those values are replaced by
* the value read out of that key-path (like [dict get]).
* Stack: ... dict key1 ... keyN => ... value */
- {"dictSet", 5, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}},
+ {"dictSet", 9, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}},
/* Update a dictionary value such that the keys are a path pointing to
* the value. op4#1 = numKeys, op4#2 = LVTindex
* Stack: ... key1 ... keyN value => ... newDict */
- {"dictUnset", 5, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}},
+ {"dictUnset", 9, INT_MIN, 2, {OPERAND_UINT4, OPERAND_LVT4}},
/* Update a dictionary value such that the keys are not a path pointing
* to any value. op4#1 = numKeys, op4#2 = LVTindex
* Stack: ... key1 ... keyN => ... newDict */
- {"dictIncrImm", 5, 0, 2, {OPERAND_INT4, OPERAND_LVT4}},
+ {"dictIncrImm", 9, 0, 2, {OPERAND_INT4, OPERAND_LVT4}},
/* Update a dictionary value such that the value pointed to by key is
* incremented by some value (or set to it if the key isn't in the
* dictionary at all). op4#1 = incrAmount, op4#2 = LVTindex
@@ -342,62 +342,404 @@ InstructionDesc 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. */
- {"dictUpdateStart", 5, -2, 1, {OPERAND_LVT4}},
- /* Create the variables to mirror the state of the dictionary in the
- * variable referred to by the immediate argument.
- * Stack: ... keyList LVTindexList => ...
- * Note that the list of LVT indices is assumed to be the same length
- * as the keyList, and the indices should be only ever generated by the
- * compiler. */
- {"dictUpdateEnd", 5, -2, 1, {OPERAND_LVT4}},
- /* Reflect the state of local variables back to the state of the
- * dictionary in the variable referred to by the immediate argument.
- * Stack: ... keyList LVTindexList => ...
- * Same notes as in "dictUpdateStart" apply here. */
- {0}
-};
+ /* 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
+ * the variable referred to by the first immediate argument. The list
+ * of keys (top of the stack, not poppsed) must be the same length as
+ * the list of variables.
+ * Stack: ... keyList => ... keyList */
+ {"dictUpdateEnd", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}},
+ /* Reflect the state of local variables (described in the aux data
+ * referred to by the second immediate argument) back to the state of
+ * the dictionary in the variable referred to by the first immediate
+ * argument. The list of keys (popped from the stack) must be the same
+ * length as the list of variables.
+ * Stack: ... keyList => ... */
+ {"jumpTable", 5, -1, 1, {OPERAND_AUX4}},
+ /* Jump according to the jump-table (in AuxData as indicated by the
+ * operand) and the argument popped from the list. Always executes the
+ * next instruction if no match against the table's entries was found.
+ * 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, -1, 1, {OPERAND_LVT4}},
+ /* finds level and otherName in stack, links to local variable at
+ * index op1. Leaves the level on stack. */
+ {"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, -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}},
+ /* Compiled bytecodes to signal syntax error. Equivalent to returnImm
+ * except for the ERR_ALREADY_LOGGED flag in the interpreter. */
+ {"reverse", 5, 0, 1, {OPERAND_UINT4}},
+ /* Reverse the order of the arg elements at the top of stack */
+
+ {"regexp", 2, -1, 1, {OPERAND_INT1}},
+ /* Regexp: push (regexp stknext stktop) opnd == nocase */
+
+ {"existScalar", 5, 1, 1, {OPERAND_LVT4}},
+ /* Test if scalar variable at index op1 in call frame exists */
+ {"existArray", 5, 0, 1, {OPERAND_LVT4}},
+ /* Test if array element exists; array at slot op1, element is
+ * stktop */
+ {"existArrayStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Test if array element exists; element is stktop, array name is
+ * stknext */
+ {"existStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Test if general variable exists; unparsed variable name is stktop*/
+
+ {"nop", 1, 0, 0, {OPERAND_NONE}},
+ /* Do nothing */
+ {"returnCodeBranch", 1, -1, 0, {OPERAND_NONE}},
+ /* Jump to next instruction based on the return code on top of stack
+ * ERROR: +1; RETURN: +3; BREAK: +5; CONTINUE: +7;
+ * Other non-OK: +9
+ */
+ {"unsetScalar", 6, 0, 2, {OPERAND_UINT1, OPERAND_LVT4}},
+ /* Make scalar variable at index op2 in call frame cease to exist;
+ * op1 is 1 for errors on problems, 0 otherwise */
+ {"unsetArray", 6, -1, 2, {OPERAND_UINT1, OPERAND_LVT4}},
+ /* Make array element cease to exist; array at slot op2, element is
+ * stktop; op1 is 1 for errors on problems, 0 otherwise */
+ {"unsetArrayStk", 2, -2, 1, {OPERAND_UINT1}},
+ /* Make array element cease to exist; element is stktop, array name is
+ * stknext; op1 is 1 for errors on problems, 0 otherwise */
+ {"unsetStk", 2, -1, 1, {OPERAND_UINT1}},
+ /* 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", 5, -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. */
+
+ {"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}},
+ /* Invoke command named objv[0], replacing the first two words with
+ * the word at the top of the stack;
+ * <objc,objv> = <op4,top op4 after popping 1> */
+
+ {"listConcat", 1, -1, 0, {OPERAND_NONE}},
+ /* Concatenates the two lists at the top of the stack into a single
+ * list and pushes that resulting list onto the stack.
+ * Stack: ... list1 list2 => ... [lconcat list1 list2] */
+
+ {"expandDrop", 1, 0, 0, {OPERAND_NONE}},
+ /* Drops an element from the auxiliary stack, popping stack elements
+ * until the matching stack depth is reached. */
+
+ /* New foreach implementation */
+ {"foreach_start", 5, +2, 1, {OPERAND_AUX4}},
+ /* Initialize execution of a foreach loop. Operand is aux data index
+ * of the ForeachInfo structure for the foreach command. It pushes 2
+ * elements which hold runtime params for foreach_step, they are later
+ * dropped by foreach_end together with the value lists. NOTE that the
+ * iterator-tracker and info reference must not be passed to bytecodes
+ * that handle normal Tcl values. NOTE that this instruction jumps to
+ * the foreach_step instruction paired with it; the stack info below
+ * is only nominal.
+ * Stack: ... listObjs... => ... listObjs... iterTracker info */
+ {"foreach_step", 1, 0, 0, {OPERAND_NONE}},
+ /* "Step" or begin next iteration of foreach loop. Assigns to foreach
+ * iteration variables. May jump to straight after the foreach_start
+ * that pushed the iterTracker and info values. MUST be followed
+ * immediately by a foreach_end.
+ * Stack: ... listObjs... iterTracker info =>
+ * ... listObjs... iterTracker info */
+ {"foreach_end", 1, 0, 0, {OPERAND_NONE}},
+ /* Clean up a foreach loop by dropping the info value, the tracker
+ * value and the lists that were being iterated over.
+ * Stack: ... listObjs... iterTracker info => ... */
+ {"lmap_collect", 1, -1, 0, {OPERAND_NONE}},
+ /* Appends the value at the top of the stack to the list located on
+ * the stack the "other side" of the foreach-related values.
+ * Stack: ... collector listObjs... iterTracker info value =>
+ * ... collector listObjs... iterTracker info */
+
+ {"strtrim", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trim] core: removes the characters (designated by the value
+ * at the top of the stack) from both ends of the string and pushes
+ * the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimleft] core: removes the characters (designated by the
+ * value at the top of the stack) from the left of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+ {"strtrimRight", 1, -1, 0, {OPERAND_NONE}},
+ /* [string trimright] core: removes the characters (designated by the
+ * value at the top of the stack) from the right of the string and
+ * pushes the resulting string.
+ * Stack: ... string charset => ... trimmedString */
+
+ {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+ * is number of values to concatenate.
+ * Operation: push concat(stk1 stk2 ... stktop) */
+
+ {"strcaseUpper", 1, 0, 0, {OPERAND_NONE}},
+ /* [string toupper] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strcaseLower", 1, 0, 0, {OPERAND_NONE}},
+ /* [string tolower] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strcaseTitle", 1, 0, 0, {OPERAND_NONE}},
+ /* [string totitle] core: converts whole string to upper case using
+ * the default (extended "C" locale) rules.
+ * Stack: ... string => ... newString */
+ {"strreplace", 1, -3, 0, {OPERAND_NONE}},
+ /* [string replace] core: replaces a non-empty range of one string
+ * with the contents of another.
+ * Stack: ... string fromIdx toIdx replacement => ... newString */
+
+ {"originCmd", 1, 0, 0, {OPERAND_NONE}},
+ /* Reports which command was the origin (via namespace import chain)
+ * of the command named on the top of the stack.
+ * Stack: ... cmdName => ... fullOriginalCmdName */
+
+ {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Call the next item on the TclOO call chain, passing opnd arguments
+ * (min 1, max 255, *includes* "next"). The result of the invoked
+ * method implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "next" arg2 arg3 -- argN => ... result */
+ {"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Call the following item on the TclOO call chain defined by class
+ * className, passing opnd arguments (min 2, max 255, *includes*
+ * "nextto" and the class name). The result of the invoked method
+ * implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "nextto" className arg3 arg4 -- argN => ... result */
+
+ {"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}},
+ /* Makes the current coroutine yield the value at the top of the
+ * stack, invoking the given command/args with resolution in the given
+ * namespace (all packed into a list), and places the list of values
+ * that are the response back on top of the stack when it resumes.
+ * Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */
+
+ {"numericType", 1, 0, 0, {OPERAND_NONE}},
+ /* Pushes the numeric type code of the word at the top of the stack.
+ * Stack: ... value => ... typeCode */
+ {"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
+ /* Try converting stktop to boolean if possible. No errors.
+ * Stack: ... value => ... value isStrictBool */
+ {"strclass", 2, 0, 1, {OPERAND_SCLS1}},
+ /* See if all the characters of the given string are a member of the
+ * specified (by opnd) character class. Note that an empty string will
+ * satisfy the class check (standard definition of "all").
+ * Stack: ... stringValue => ... boolean */
+
+ {NULL, 0, 0, 0, {OPERAND_NONE}}
+};
+
/*
* Prototypes for procedures defined later in this file:
*/
-static void DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static unsigned char * EncodeCmdLocMap _ANSI_ARGS_((CompileEnv *envPtr,
- ByteCode *codePtr, unsigned char *startPtr));
-static void EnterCmdExtentData _ANSI_ARGS_((CompileEnv *envPtr,
- int cmdNumber, int numSrcBytes, int numCodeBytes));
-static void EnterCmdStartData _ANSI_ARGS_((CompileEnv *envPtr,
- int cmdNumber, int srcOffset, int codeOffset));
-static void FreeByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int GetCmdLocEncodingSize _ANSI_ARGS_((
- CompileEnv *envPtr));
+static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
+static void DupByteCodeInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr,
+ ByteCode *codePtr, unsigned char *startPtr);
+static void EnterCmdExtentData(CompileEnv *envPtr,
+ int cmdNumber, int numSrcBytes, int numCodeBytes);
+static void EnterCmdStartData(CompileEnv *envPtr,
+ int cmdNumber, int srcOffset, int codeOffset);
+static void FreeByteCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
+static int GetCmdLocEncodingSize(CompileEnv *envPtr);
+static int IsCompactibleCompileEnv(Tcl_Interp *interp,
+ CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
-static void RecordByteCodeStats _ANSI_ARGS_((ByteCode *codePtr));
+static void RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
-static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+static void RegisterAuxDataType(const AuxDataType *typePtr);
+static int SetByteCodeFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void StartExpanding(CompileEnv *envPtr);
+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.
+ */
+static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
+ Tcl_Token *tokenPtr, const char *cmd, int len,
+ int numWords, int line, int *clNext, int **lines,
+ CompileEnv *envPtr);
+static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
/*
* The structure below defines the bytecode Tcl object type by means of
* procedures that can be invoked by generic object code.
*/
-Tcl_ObjType tclByteCodeType = {
- "bytecode", /* name */
- FreeByteCodeInternalRep, /* freeIntRepProc */
- DupByteCodeInternalRep, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
- SetByteCodeFromAny /* setFromAnyProc */
+const Tcl_ObjType tclByteCodeType = {
+ "bytecode", /* name */
+ FreeByteCodeInternalRep, /* freeIntRepProc */
+ DupByteCodeInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetByteCodeFromAny /* setFromAnyProc */
+};
+
+/*
+ * The structure below defines a bytecode Tcl object type to hold the
+ * compiled bytecode for the [subst]itution of Tcl values.
+ */
+
+static const Tcl_ObjType substCodeType = {
+ "substcode", /* name */
+ FreeSubstCodeInternalRep, /* freeIntRepProc */
+ DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */
+ 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 */
+};
+
+/*
+ * Helper macros.
+ */
+
+#define TclIncrUInt4AtPtr(ptr, delta) \
+ TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
/*
*----------------------------------------------------------------------
@@ -406,14 +748,15 @@ Tcl_ObjType tclByteCodeType = {
*
* Part of the bytecode Tcl object type implementation. Attempts to
* generate an byte code internal form for the Tcl object "objPtr" by
- * compiling its string representation. This function also takes a hook
+ * 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
@@ -425,24 +768,20 @@ Tcl_ObjType tclByteCodeType = {
*/
int
-TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
- Tcl_Interp *interp; /* The interpreter for which the code is being
- * compiled. Must not be NULL. */
- Tcl_Obj *objPtr; /* The object to make a ByteCode object. */
- CompileHookProc *hookProc; /* Procedure to invoke after compilation. */
- ClientData clientData; /* Hook procedure private data. */
+TclSetByteCodeFromAny(
+ Tcl_Interp *interp, /* The interpreter for which the code is being
+ * compiled. Must not be NULL. */
+ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */
+ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
+ ClientData clientData) /* Hook procedure private data. */
{
-#ifdef TCL_COMPILE_DEBUG
Interp *iPtr = (Interp *) interp;
-#endif /*TCL_COMPILE_DEBUG*/
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
- LiteralTable *localTablePtr = &(compEnv.localLitTable);
- register AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- register int i;
int length, result = TCL_OK;
- char *stringPtr;
+ const char *stringPtr;
+ Proc *procPtr = iPtr->compiledProcPtr;
+ ContLineLoc *clLocPtr;
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
@@ -454,8 +793,34 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
}
#endif
- stringPtr = Tcl_GetStringFromObj(objPtr, &length);
- TclInitCompileEnv(interp, &compEnv, stringPtr, length);
+ stringPtr = TclGetStringFromObj(objPtr, &length);
+
+ /*
+ * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
+ * use to initialize the tracking in the compiler. This information was
+ * stored by TclCompEvalObj and ProcCompileProc.
+ */
+
+ TclInitCompileEnv(interp, &compEnv, stringPtr, length,
+ iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+
+ /*
+ * Now we check if we have data about invisible continuation lines for the
+ * script, and make it available to the compile environment, if so.
+ *
+ * It is not clear if the script Tcl_Obj* can be free'd while the compiler
+ * is using it, leading to the release of the associated ContLineLoc
+ * structure as well. To ensure that the latter doesn't happen we set a
+ * lock on it. We release this lock in the function TclFreeCompileEnv(),
+ * found in this file. The "lineCLPtr" hashtable is managed in the file
+ * "tclObj.c".
+ */
+
+ clLocPtr = TclContinuationsGet(objPtr);
+ if (clLocPtr) {
+ compEnv.clNext = &clLocPtr->loc[0];
+ }
+
TclCompileScript(interp, stringPtr, length, &compEnv);
/*
@@ -465,11 +830,45 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclEmitOpcode(INST_DONE, &compEnv);
/*
+ * Check for optimizations!
+ *
+ * Test if the generated code is free of most hazards; if so, recompile
+ * but with generation of INST_START_CMD disabled. This produces somewhat
+ * faster code in some cases, and more compact code in more.
+ */
+
+ if (Tcl_GetMaster(interp) == NULL &&
+ !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
+ && IsCompactibleCompileEnv(interp, &compEnv)) {
+ TclFreeCompileEnv(&compEnv);
+ iPtr->compiledProcPtr = procPtr;
+ TclInitCompileEnv(interp, &compEnv, stringPtr, length,
+ iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+ if (clLocPtr) {
+ compEnv.clNext = &clLocPtr->loc[0];
+ }
+ compEnv.atCmdStart = 2; /* The disabling magic. */
+ TclCompileScript(interp, stringPtr, length, &compEnv);
+ assert (compEnv.atCmdStart > 1);
+ TclEmitOpcode(INST_DONE, &compEnv);
+ assert (compEnv.atCmdStart > 1);
+ }
+
+ /*
+ * Apply some peephole optimizations that can cross specific/generic
+ * instruction generator boundaries.
+ */
+
+ if (iPtr->extra.optimizer) {
+ (iPtr->extra.optimizer)(&compEnv);
+ }
+
+ /*
* Invoke the compilation hook procedure if one exists.
*/
if (hookProc) {
- result = (*hookProc)(interp, &compEnv, clientData);
+ result = hookProc(interp, &compEnv, clientData);
}
/*
@@ -481,43 +880,16 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- TclInitByteCodeObj(objPtr, &compEnv);
+ if (result == TCL_OK) {
+ TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- if (result != TCL_OK) {
- /*
- * Handle any error from the hookProc
- */
-
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
- }
- auxDataPtr++;
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
}
+#endif /* TCL_COMPILE_DEBUG */
}
- /*
- * Free storage allocated during compilation.
- */
-
- if (localTablePtr->buckets != localTablePtr->staticBuckets) {
- ckfree((char *) localTablePtr->buckets);
- }
TclFreeCompileEnv(&compEnv);
return result;
}
@@ -538,21 +910,23 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
*
* Side effects:
* Frees the old internal representation. If no error occurs, then the
- * compiled code is stored as "objPtr"s bytecode representation. Also,
- * if debugging, initializes the "tcl_traceCompile" Tcl variable used to
+ * compiled code is stored as "objPtr"s bytecode representation. Also, if
+ * debugging, initializes the "tcl_traceCompile" Tcl variable used to
* trace compilations.
*
*----------------------------------------------------------------------
*/
static int
-SetByteCodeFromAny(interp, objPtr)
- Tcl_Interp *interp; /* The interpreter for which the code is being
- * compiled. Must not be NULL. */
- Tcl_Obj *objPtr; /* The object to make a ByteCode object. */
+SetByteCodeFromAny(
+ Tcl_Interp *interp, /* The interpreter for which the code is being
+ * compiled. Must not be NULL. */
+ Tcl_Obj *objPtr) /* The object to make a ByteCode object. */
{
- return TclSetByteCodeFromAny(interp, objPtr,
- (CompileHookProc *) NULL, (ClientData) NULL);
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+ return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
}
/*
@@ -575,9 +949,9 @@ SetByteCodeFromAny(interp, objPtr)
*/
static void
-DupByteCodeInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupByteCodeInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
return;
}
@@ -596,25 +970,23 @@ DupByteCodeInternalRep(srcPtr, copyPtr)
*
* Side effects:
* The bytecode object's internal rep is marked invalid and its code gets
- * freed unless the code is actively being executed. In that case the
+ * freed unless the code is actively being executed. In that case the
* cleanup is delayed until the last execution of the code completes.
*
*----------------------------------------------------------------------
*/
static void
-FreeByteCodeInternalRep(objPtr)
- register Tcl_Obj *objPtr; /* Object whose internal rep to free. */
+FreeByteCodeInternalRep(
+ register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = (ByteCode *)
- objPtr->internalRep.otherValuePtr;
+ register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ objPtr->typePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
- objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -630,22 +1002,22 @@ FreeByteCodeInternalRep(objPtr)
* None.
*
* Side effects:
- * Frees objPtr's bytecode internal representation and sets its type and
- * objPtr->internalRep.otherValuePtr NULL. Also releases its literals and
- * frees its auxiliary data items.
+ * Frees objPtr's bytecode internal representation and sets its type NULL
+ * Also releases its literals and frees its auxiliary data items.
*
*----------------------------------------------------------------------
*/
void
-TclCleanupByteCode(codePtr)
- register ByteCode *codePtr; /* Points to the ByteCode to free. */
+TclCleanupByteCode(
+ register ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
+ Interp *iPtr = (Interp *) interp;
int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
register Tcl_Obj **objArrayPtr, *objPtr;
- register AuxData *auxDataPtr;
+ register const AuxData *auxDataPtr;
int i;
#ifdef TCL_COMPILE_STATS
@@ -654,7 +1026,7 @@ TclCleanupByteCode(codePtr)
Tcl_Time destroyTime;
int lifetimeSec, lifetimeMicroSec, log2;
- statsPtr = &((Interp *) interp)->stats;
+ statsPtr = &iPtr->stats;
statsPtr->numByteCodesFreed++;
statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
@@ -689,12 +1061,13 @@ TclCleanupByteCode(codePtr)
* A single heap object holds the ByteCode structure and its code, object,
* command location, and auxiliary data arrays. This means we only need to
* 1) decrement the ref counts of the LiteralEntry's in its literal array,
- * 2) call the free procs for the auxiliary data items, and 3) free the
- * ByteCode structure's heap object.
+ * 2) call the free procs for the auxiliary data items, 3) free the
+ * localCache if it is unused, and finally 4) free the ByteCode
+ * structure's heap object.
*
* The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like
* those generated from tbcload) is special, as they doesn't make use of
- * the global literal table. They instead maintain private references to
+ * the global literal table. They instead maintain private references to
* their literals which must be decremented.
*
* In order to insure a proper and efficient cleanup of the literal array
@@ -705,7 +1078,7 @@ TclCleanupByteCode(codePtr)
* released.
*/
- if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
objArrayPtr = codePtr->objArrayPtr;
for (i = 0; i < numLitObjects; i++) {
@@ -718,30 +1091,309 @@ TclCleanupByteCode(codePtr)
codePtr->numLitObjects = 0;
} else {
objArrayPtr = codePtr->objArrayPtr;
- for (i = 0; i < numLitObjects; i++) {
- /*
- * TclReleaseLiteral sets a ByteCode's object array entry NULL to
- * indicate that it has already freed the literal.
- */
-
- objPtr = *objArrayPtr;
- if (objPtr != NULL) {
- TclReleaseLiteral(interp, objPtr);
- }
- objArrayPtr++;
+ while (numLitObjects--) {
+ /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */
+ TclReleaseLiteral(interp, *objArrayPtr++);
}
}
auxDataPtr = codePtr->auxDataArrayPtr;
for (i = 0; i < numAuxDataItems; i++) {
if (auxDataPtr->type->freeProc != NULL) {
- (auxDataPtr->type->freeProc)(auxDataPtr->clientData);
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
}
auxDataPtr++;
}
+ /*
+ * TIP #280. Release the location data associated with this byte code
+ * structure, if any. NOTE: The interp we belong to may be gone already,
+ * and the data with it.
+ *
+ * See also tclBasic.c, DeleteInterpProc
+ */
+
+ if (iPtr) {
+ Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
+ (char *) codePtr);
+
+ if (hePtr) {
+ ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
+ Tcl_DeleteHashEntry(hePtr);
+ }
+ }
+
+ if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
+ TclFreeLocalCache(interp, codePtr->localCachePtr);
+ }
+
TclHandleRelease(codePtr->interpHandle);
- ckfree((char *) codePtr);
+ ckfree(codePtr);
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * IsCompactibleCompileEnv --
+ *
+ * Checks to see if we may apply some basic compaction optimizations to a
+ * piece of bytecode. Idempotent.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static int
+IsCompactibleCompileEnv(
+ Tcl_Interp *interp,
+ CompileEnv *envPtr)
+{
+ unsigned char *pc;
+ int size;
+
+ /*
+ * Special: procedures in the '::tcl' namespace (or its children) are
+ * considered to be well-behaved and so can have compaction applied even
+ * if it would otherwise be invalid.
+ */
+
+ if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
+ && envPtr->procPtr->cmdPtr->nsPtr != NULL) {
+ Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+
+ if (strcmp(nsPtr->fullName, "::tcl") == 0
+ || strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
+ return 1;
+ }
+ }
+
+ /*
+ * Go through and ensure that no operation involved can cause a desired
+ * change of bytecode sequence during running. This comes down to ensuring
+ * that there are no mapped variables (due to traces) or calls to external
+ * commands (traces, [uplevel] trickery). This is actually a very
+ * conservative check; it turns down a lot of code that is OK in practice.
+ */
+
+ for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
+ switch (*pc) {
+ /* Invokes */
+ case INST_INVOKE_STK1:
+ case INST_INVOKE_STK4:
+ case INST_INVOKE_EXPANDED:
+ case INST_INVOKE_REPLACE:
+ return 0;
+ /* Runtime evals */
+ case INST_EVAL_STK:
+ case INST_EXPR_STK:
+ case INST_YIELD:
+ return 0;
+ /* Upvars */
+ case INST_UPVAR:
+ case INST_NSUPVAR:
+ case INST_VARIABLE:
+ return 0;
+ default:
+ size = tclInstructionTable[*pc].numBytes;
+ assert (size > 0);
+ break;
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SubstObj --
+ *
+ * This function performs the substitutions specified on the given string
+ * as described in the user documentation for the "subst" Tcl command.
+ *
+ * Results:
+ * A Tcl_Obj* containing the substituted string, or NULL to indicate that
+ * an error occurred.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_SubstObj(
+ Tcl_Interp *interp, /* Interpreter in which substitution occurs */
+ Tcl_Obj *objPtr, /* The value to be substituted. */
+ int flags) /* What substitutions to do. */
+{
+ NRE_callback *rootPtr = TOP_CB(interp);
+
+ if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
+ rootPtr) != TCL_OK) {
+ return NULL;
+ }
+ return Tcl_GetObjResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NRSubstObj --
+ *
+ * Request substitution of a Tcl value by the NR stack.
+ *
+ * Results:
+ * Returns TCL_OK.
+ *
+ * Side effects:
+ * Compiles objPtr into bytecode that performs the substitutions as
+ * governed by flags and places callbacks on the NR stack to execute
+ * the bytecode and store the result in the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NRSubstObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int flags)
+{
+ ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags);
+
+ /* TODO: Confirm we do not need this. */
+ /* Tcl_ResetResult(interp); */
+ return TclNRExecuteByteCode(interp, codePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileSubstObj --
+ *
+ * Compile a Tcl value into ByteCode implementing its substitution, as
+ * governed by flags.
+ *
+ * Results:
+ * A (ByteCode *) is returned pointing to the resulting ByteCode.
+ * The caller must manage its refCount and arrange for a call to
+ * TclCleanupByteCode() when the last reference disappears.
+ *
+ * Side effects:
+ * The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
+ * ByteCode and governing flags value are kept in the internal rep for
+ * faster operations the next time CompileSubstObj is called on the same
+ * value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ByteCode *
+CompileSubstObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int flags)
+{
+ Interp *iPtr = (Interp *) interp;
+ ByteCode *codePtr = NULL;
+
+ if (objPtr->typePtr == &substCodeType) {
+ Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
+
+ codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+ if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
+ || ((Interp *) *codePtr->interpHandle != iPtr)
+ || (codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsPtr != nsPtr)
+ || (codePtr->nsEpoch != nsPtr->resolverEpoch)
+ || (codePtr->localCachePtr !=
+ iPtr->varFramePtr->localCachePtr)) {
+ FreeSubstCodeInternalRep(objPtr);
+ }
+ }
+ if (objPtr->typePtr != &substCodeType) {
+ CompileEnv compEnv;
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
+
+ /* TODO: Check for more TIP 280 */
+ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);
+
+ TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
+
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ objPtr->typePtr = &substCodeType;
+ TclFreeCompileEnv(&compEnv);
+
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
+ objPtr->internalRep.ptrAndLongRep.value = flags;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
+ }
+#endif /* TCL_COMPILE_DEBUG */
+ }
+ return codePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeSubstCodeInternalRep --
+ *
+ * Part of the substcode Tcl object type implementation. Frees the
+ * storage associated with a substcode object's internal representation
+ * unless its code is actively being executed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The substcode object's internal rep is marked invalid and its code
+ * gets freed unless the code is actively being executed. In that case
+ * the cleanup is delayed until the last execution of the code completes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeSubstCodeInternalRep(
+ register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
+{
+ register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+
+ objPtr->typePtr = NULL;
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+}
+
+static void
+ReleaseCmdWordData(
+ ExtCmdLoc *eclPtr)
+{
+ int i;
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(eclPtr->path);
+ }
+ for (i=0 ; i<eclPtr->nuloc ; i++) {
+ ckfree((char *) eclPtr->loc[i].line);
+ }
+
+ if (eclPtr->loc != NULL) {
+ ckfree((char *) eclPtr->loc);
+ }
+
+ ckfree((char *) eclPtr);
}
/*
@@ -762,30 +1414,36 @@ TclCleanupByteCode(codePtr)
*/
void
-TclInitCompileEnv(interp, envPtr, stringPtr, numBytes)
- Tcl_Interp *interp; /* The interpreter for which a CompileEnv
- * structure is initialized. */
- register CompileEnv *envPtr; /* Points to the CompileEnv structure to
- * initialize. */
- char *stringPtr; /* The source string to be compiled. */
- int numBytes; /* Number of bytes in source string. */
+TclInitCompileEnv(
+ Tcl_Interp *interp, /* The interpreter for which a CompileEnv
+ * structure is initialized. */
+ register CompileEnv *envPtr,/* Points to the CompileEnv structure to
+ * initialize. */
+ const char *stringPtr, /* The source string to be compiled. */
+ int numBytes, /* Number of bytes in source string. */
+ const CmdFrame *invoker, /* Location context invoking the bcc */
+ int word) /* Index of the word in that context getting
+ * compiled */
{
Interp *iPtr = (Interp *) interp;
+ assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
+
envPtr->iPtr = iPtr;
envPtr->source = stringPtr;
envPtr->numSrcBytes = numBytes;
envPtr->procPtr = iPtr->compiledProcPtr;
+ iPtr->compiledProcPtr = NULL;
envPtr->numCommands = 0;
envPtr->exceptDepth = 0;
envPtr->maxExceptDepth = 0;
envPtr->maxStackDepth = 0;
envPtr->currStackDepth = 0;
- TclInitLiteralTable(&(envPtr->localLitTable));
+ TclInitLiteralTable(&envPtr->localLitTable);
envPtr->codeStart = envPtr->staticCodeSpace;
envPtr->codeNext = envPtr->codeStart;
- envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
+ envPtr->codeEnd = envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES;
envPtr->mallocedCodeArray = 0;
envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
@@ -794,6 +1452,7 @@ TclInitCompileEnv(interp, envPtr, stringPtr, numBytes)
envPtr->mallocedLiteralArray = 0;
envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
+ envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace;
envPtr->exceptArrayNext = 0;
envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
envPtr->mallocedExceptArray = 0;
@@ -801,6 +1460,139 @@ TclInitCompileEnv(interp, envPtr, stringPtr, numBytes)
envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
envPtr->mallocedCmdMap = 0;
+ envPtr->atCmdStart = 1;
+ envPtr->expandCount = 0;
+
+ /*
+ * TIP #280: Set up the extended command location information, based on
+ * the context invoking the byte code compiler. This structure is used to
+ * keep the per-word line information for all compiled commands.
+ *
+ * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
+ * non-compiling evaluator
+ */
+
+ envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
+ envPtr->extCmdMapPtr->loc = NULL;
+ envPtr->extCmdMapPtr->nloc = 0;
+ envPtr->extCmdMapPtr->nuloc = 0;
+ envPtr->extCmdMapPtr->path = NULL;
+
+ if (invoker == NULL) {
+ /*
+ * Initialize the compiler for relative counting in case of a
+ * dynamic context.
+ */
+
+ envPtr->line = 1;
+ if (iPtr->evalFlags & TCL_EVAL_FILE) {
+ iPtr->evalFlags &= ~TCL_EVAL_FILE;
+ envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE;
+
+ if (iPtr->scriptFile) {
+ /*
+ * Normalization here, to have the correct pwd. Should have
+ * negligible impact on performance, as the norm should have
+ * been done already by the 'source' invoking us, and it
+ * caches the result.
+ */
+
+ Tcl_Obj *norm =
+ Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
+
+ if (norm == NULL) {
+ /*
+ * Error message in the interp result. No place to put it.
+ * And no place to serve the error itself to either. Fake
+ * a path, empty string.
+ */
+
+ TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
+ } else {
+ envPtr->extCmdMapPtr->path = norm;
+ }
+ } else {
+ TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
+ }
+
+ Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
+ } else {
+ envPtr->extCmdMapPtr->type =
+ (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
+ }
+ } else {
+ /*
+ * Initialize the compiler using the context, making counting absolute
+ * to that context. Note that the context can be byte code execution.
+ * In that case we have to fill out the missing pieces (line, path,
+ * ...) which may make change the type as well.
+ */
+
+ CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ int pc = 0;
+
+ *ctxPtr = *invoker;
+ if (invoker->type == TCL_LOCATION_BC) {
+ /*
+ * Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr is used instead.
+ */
+
+ TclGetSrcInfoForPc(ctxPtr);
+ pc = 1;
+ }
+
+ if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
+ /*
+ * Word is not a literal, relative counting.
+ */
+
+ envPtr->line = 1;
+ envPtr->extCmdMapPtr->type =
+ (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
+
+ if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
+ /*
+ * The reference made by 'TclGetSrcInfoForPc' is dead.
+ */
+
+ Tcl_DecrRefCount(ctxPtr->data.eval.path);
+ }
+ } else {
+ envPtr->line = ctxPtr->line[word];
+ envPtr->extCmdMapPtr->type = ctxPtr->type;
+
+ if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+ envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path;
+
+ if (pc) {
+ /*
+ * The reference 'TclGetSrcInfoForPc' made is transfered.
+ */
+
+ ctxPtr->data.eval.path = NULL;
+ } else {
+ /*
+ * We have a new reference here.
+ */
+
+ Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
+ }
+ }
+ }
+
+ TclStackFree(interp, ctxPtr);
+ }
+
+ envPtr->extCmdMapPtr->start = envPtr->line;
+
+ /*
+ * Initialize the data about invisible continuation lines as empty, i.e.
+ * not used. The caller (TclSetByteCodeFromAny) will set this up, if such
+ * data is available.
+ */
+
+ envPtr->clNext = NULL;
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
envPtr->auxDataArrayNext = 0;
@@ -831,23 +1623,58 @@ TclInitCompileEnv(interp, envPtr, stringPtr, numBytes)
*/
void
-TclFreeCompileEnv(envPtr)
- register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
+TclFreeCompileEnv(
+ register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
+ if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
+ ckfree(envPtr->localLitTable.buckets);
+ envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
+ }
+ if (envPtr->iPtr) {
+ /*
+ * We never converted to Bytecode, so free the things we would
+ * have transferred to it.
+ */
+
+ int i;
+ LiteralEntry *entryPtr = envPtr->literalArrayPtr;
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+
+ for (i = 0; i < envPtr->literalArrayNext; i++) {
+ TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
+ entryPtr++;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(envPtr->iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ for (i = 0; i < envPtr->auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ }
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);
+ ckfree(envPtr->exceptAuxArrayPtr);
}
if (envPtr->mallocedCmdMap) {
- ckfree((char *) envPtr->cmdMapPtr);
+ ckfree(envPtr->cmdMapPtr);
}
if (envPtr->mallocedAuxDataArray) {
- ckfree((char *) envPtr->auxDataArrayPtr);
+ ckfree(envPtr->auxDataArrayPtr);
+ }
+ if (envPtr->extCmdMapPtr) {
+ ReleaseCmdWordData(envPtr->extCmdMapPtr);
+ envPtr->extCmdMapPtr = NULL;
}
}
@@ -860,10 +1687,10 @@ TclFreeCompileEnv(envPtr)
*
* Results:
* Returns true if the tokenPtr argument points to a word value that is
- * completely known at compile time. Generally, values that are known at
+ * completely known at compile time. Generally, values that are known at
* compile time can be compiled to their values, while values that cannot
* be known until substitution at runtime must be compiled to bytecode
- * instructions that perform that substitution. For several commands,
+ * instructions that perform that substitution. For several commands,
* whether or not arguments are known at compile time determine whether
* it is worthwhile to compile at all.
*
@@ -875,9 +1702,9 @@ TclFreeCompileEnv(envPtr)
*/
int
-TclWordKnownAtCompileTime(tokenPtr, valuePtr)
- Tcl_Token *tokenPtr; /* Points to Tcl_Token we should check */
- Tcl_Obj *valuePtr; /* If not NULL, points to an unshared Tcl_Obj
+TclWordKnownAtCompileTime(
+ Tcl_Token *tokenPtr, /* Points to Tcl_Token we should check */
+ Tcl_Obj *valuePtr) /* If not NULL, points to an unshared Tcl_Obj
* to which we should append the known value
* of the word. */
{
@@ -909,7 +1736,9 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
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);
}
break;
@@ -947,360 +1776,467 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
*----------------------------------------------------------------------
*/
+static int
+ExpandRequested(
+ Tcl_Token *tokenPtr,
+ int numWords)
+{
+ /* Determine whether any words of the command require expansion */
+ while (numWords--) {
+ if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ return 1;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ return 0;
+}
+
+static void
+CompileCmdLiteral(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ CompileEnv *envPtr)
+{
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+ int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+
+ if (cmdPtr) {
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+ }
+ TclEmitPush(cmdLitIdx, envPtr);
+}
+
void
-TclCompileScript(interp, script, numBytes, envPtr)
- Tcl_Interp *interp; /* Used for error and status reporting. Also
- * serves as context for finding and compiling
- * commands. May not be NULL. */
- CONST char *script; /* The source script to compile. */
- int numBytes; /* Number of bytes in script. If < 0, the
- * script consists of all bytes up to the
- * first null character. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileInvocation(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ Tcl_Obj *cmdObj,
+ int numWords,
+ CompileEnv *envPtr)
{
- Interp *iPtr = (Interp *) interp;
- Tcl_Parse parse;
- int lastTopLevelCmdIndex = -1;
- /* Index of most recent toplevel command in
- * the command location table. Initialized *
- * to avoid compiler warning. */
- int startCodeOffset = -1; /* Offset of first byte of current command's
- * code. Init. to avoid compiler warning. */
- unsigned char *entryCodeNext = envPtr->codeNext;
- CONST char *p, *next;
- Namespace *cmdNsPtr;
- Command *cmdPtr;
- Tcl_Token *tokenPtr;
- int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
- int commandLength, objIndex, code;
- Tcl_DString ds;
+ int wordIdx = 0, depth = TclGetStackDepth(envPtr);
+ DefineLineInformation;
+
+ if (cmdObj) {
+ CompileCmdLiteral(interp, cmdObj, envPtr);
+ wordIdx = 1;
+ tokenPtr = TokenAfter(tokenPtr);
+ }
- Tcl_DStringInit(&ds);
+ for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
+ int objIdx;
- if (numBytes < 0) {
- numBytes = strlen(script);
+ SetLineInformation(wordIdx);
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ CompileTokens(envPtr, tokenPtr, interp);
+ continue;
+ }
+
+ objIdx = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+ tokenPtr[1].start - envPtr->source, envPtr->clNext);
+ }
+ TclEmitPush(objIdx, envPtr);
}
- Tcl_ResetResult(interp);
- isFirstCmd = 1;
- if (envPtr->procPtr != NULL) {
- cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+ if (wordIdx <= 255) {
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
} else {
- cmdNsPtr = NULL; /* use current NS */
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
+ }
+ TclCheckStackDepth(depth+1, envPtr);
+}
+
+static void
+CompileExpanded(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ Tcl_Obj *cmdObj,
+ int numWords,
+ CompileEnv *envPtr)
+{
+ int wordIdx = 0;
+ DefineLineInformation;
+ int depth = TclGetStackDepth(envPtr);
+
+ StartExpanding(envPtr);
+ if (cmdObj) {
+ CompileCmdLiteral(interp, cmdObj, envPtr);
+ wordIdx = 1;
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+
+ for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
+ int objIdx;
+
+ SetLineInformation(wordIdx);
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ CompileTokens(envPtr, tokenPtr, interp);
+ if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ TclEmitInstInt4(INST_EXPAND_STKTOP,
+ envPtr->currStackDepth, envPtr);
+ }
+ continue;
+ }
+
+ objIdx = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+ tokenPtr[1].start - envPtr->source, envPtr->clNext);
+ }
+ TclEmitPush(objIdx, envPtr);
}
/*
- * Each iteration through the following loop compiles the next command
- * from the script.
+ * The stack depth during argument expansion can only be managed at
+ * runtime, as the number of elements in the expanded lists is not known
+ * at compile time. We adjust here the stack depth estimate so that it is
+ * correct after the command with expanded arguments returns.
+ *
+ * The end effect of this command's invocation is that all the words of
+ * the command are popped from the stack, and the result is pushed: the
+ * stack top changes by (1-wordIdx).
+ *
+ * Note that the estimates are not correct while the command is being
+ * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
*/
- p = script;
- bytesLeft = numBytes;
- gotParse = 0;
- do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
- /* Compile bytecodes to report the parse error at runtime */
- Tcl_Obj *returnCmd = Tcl_NewStringObj(
- "return -code 1 -level 0 -errorinfo", -1);
- Tcl_Obj *errMsg = Tcl_GetObjResult(interp);
- Tcl_Obj *errInfo = Tcl_DuplicateObj(errMsg);
- char *cmdString;
- int cmdLength;
- Tcl_Parse subParse;
- int errorLine = 1;
-
- Tcl_IncrRefCount(returnCmd);
- Tcl_IncrRefCount(errInfo);
- Tcl_AppendToObj(errInfo, "\n while executing\n\"", -1);
- TclAppendLimitedToObj(errInfo, parse.commandStart,
- /* Drop the command terminator (";","]") if appropriate */
- (parse.term == parse.commandStart + parse.commandSize - 1)?
- parse.commandSize - 1 : parse.commandSize, 153, NULL);
- Tcl_AppendToObj(errInfo, "\"", -1);
-
- Tcl_ListObjAppendElement(NULL, returnCmd, errInfo);
-
- for (p = envPtr->source; p != parse.commandStart; p++) {
- if (*p == '\n') {
- errorLine++;
- }
- }
- Tcl_ListObjAppendElement(NULL, returnCmd,
- Tcl_NewStringObj("-errorline", -1));
- Tcl_ListObjAppendElement(NULL, returnCmd,
- Tcl_NewIntObj(errorLine));
-
- Tcl_ListObjAppendElement(NULL, returnCmd, errMsg);
- Tcl_DecrRefCount(errInfo);
-
- cmdString = Tcl_GetStringFromObj(returnCmd, &cmdLength);
- Tcl_ParseCommand(interp, cmdString, cmdLength, 0, &subParse);
- TclCompileReturnCmd(interp, &subParse, envPtr);
- Tcl_DecrRefCount(returnCmd);
- Tcl_FreeParse(&subParse);
- return;
+ TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+ TclCheckStackDepth(depth+1, envPtr);
+}
+
+static int
+CompileCmdCompileProc(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr,
+ CompileEnv *envPtr)
+{
+ int unwind = 0, incrOffset = -1;
+ DefineLineInformation;
+ int depth = TclGetStackDepth(envPtr);
+
+ /*
+ * Emit of the INST_START_CMD instruction is controlled by the value of
+ * envPtr->atCmdStart:
+ *
+ * atCmdStart == 2 : We are not using the INST_START_CMD instruction.
+ * atCmdStart == 1 : INST_START_CMD was the last instruction emitted.
+ * : We do not need to emit another. Instead we
+ * : increment the number of cmds started at it (except
+ * : for the special case at the start of a script.)
+ * atCmdStart == 0 : The last instruction was something else. We need
+ * : to emit INST_START_CMD here.
+ */
+
+ switch (envPtr->atCmdStart) {
+ case 0:
+ unwind = tclInstructionTable[INST_START_CMD].numBytes;
+ TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+ incrOffset = envPtr->codeNext - envPtr->codeStart;
+ TclEmitInt4(0, envPtr);
+ break;
+ case 1:
+ if (envPtr->codeNext > envPtr->codeStart) {
+ incrOffset = envPtr->codeNext - 4 - envPtr->codeStart;
}
- gotParse = 1;
- if (parse.numWords > 0) {
- int expand = 0;
+ break;
+ case 2:
+ /* Nothing to do */
+ ;
+ }
+ if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
+ if (incrOffset >= 0) {
/*
- * If not the first command, pop the previous command's result
- * and, if we're compiling a top level command, update the last
- * command's code size to account for the pop instruction.
+ * We successfully compiled a command. Increment the number of
+ * commands that start at the currently active INST_START_CMD.
*/
- if (!isFirstCmd) {
- TclEmitOpcode(INST_POP, envPtr);
- envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - startCodeOffset;
+ unsigned char *incrPtr = envPtr->codeStart + incrOffset;
+ unsigned char *startPtr = incrPtr - 5;
+
+ TclIncrUInt4AtPtr(incrPtr, 1);
+ if (unwind) {
+ /* We started the INST_START_CMD. Record the code length. */
+ TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
}
+ }
+ TclCheckStackDepth(depth+1, envPtr);
+ return TCL_OK;
+ }
- /*
- * Determine the actual length of the command.
- */
+ envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
- commandLength = parse.commandSize;
- if (parse.term == parse.commandStart + commandLength - 1) {
- /*
- * The command terminator character (such as ; or ]) is the
- * last character in the parsed command. Reduce the length by
- * one so that the trace message doesn't include the
- * terminator character.
- */
+ /*
+ * Throw out any line information generated by the failed compile attempt.
+ */
- commandLength -= 1;
- }
+ while (mapPtr->nuloc - 1 > eclIndex) {
+ mapPtr->nuloc--;
+ ckfree(mapPtr->loc[mapPtr->nuloc].line);
+ mapPtr->loc[mapPtr->nuloc].line = NULL;
+ }
-#ifdef TCL_COMPILE_DEBUG
- /*
- * If tracing, print a line for each top level command compiled.
- */
+ /*
+ * Reset the index of next command. Toss out any from failed nested
+ * partial compiles.
+ */
- if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
- fprintf(stdout, " Compiling: ");
- TclPrintSource(stdout, parse.commandStart,
- TclMin(commandLength, 55));
- fprintf(stdout, "\n");
- }
-#endif
+ envPtr->numCommands = mapPtr->nuloc;
+ return TCL_ERROR;
+}
- /*
- * Check whether expansion has been requested for any of the words
- */
+static int
+CompileCommandTokens(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ CompileEnv *envPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+ Tcl_Obj *cmdObj = Tcl_NewObj();
+ Command *cmdPtr = NULL;
+ int code = TCL_ERROR;
+ int cmdKnown, expand = -1;
+ int *wlines, wlineat;
+ int cmdLine = envPtr->line;
+ int *clNext = envPtr->clNext;
+ int cmdIdx = envPtr->numCommands;
+ int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+ int depth = TclGetStackDepth(envPtr);
+
+ assert (parsePtr->numWords > 0);
+
+ /* Pre-Compile */
+
+ envPtr->numCommands++;
+ EnterCmdStartData(envPtr, cmdIdx,
+ parsePtr->commandStart - envPtr->source, startCodeOffset);
- for (wordIdx = 0, tokenPtr = parse.tokenPtr;
- wordIdx < parse.numWords;
- wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
- if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
- expand = 1;
- TclEmitOpcode(INST_EXPAND_START, envPtr);
- break;
- }
- }
+ /*
+ * TIP #280. Scan the words and compute the extended location information.
+ * The map first contain full per-word line information for use by the
+ * compiler. This is later replaced by a reduced form which signals
+ * non-literal words, stored in 'wlines'.
+ */
+
+ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+ parsePtr->tokenPtr, parsePtr->commandStart,
+ parsePtr->commandSize, parsePtr->numWords, cmdLine,
+ clNext, &wlines, envPtr);
+ wlineat = eclPtr->nuloc - 1;
- envPtr->numCommands++;
- currCmdIndex = (envPtr->numCommands - 1);
- lastTopLevelCmdIndex = currCmdIndex;
- startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- EnterCmdStartData(envPtr, currCmdIndex,
- (parse.commandStart - envPtr->source), startCodeOffset);
+ envPtr->line = eclPtr->loc[wlineat].line[0];
+ envPtr->clNext = eclPtr->loc[wlineat].next[0];
+ /* Do we know the command word? */
+ Tcl_IncrRefCount(cmdObj);
+ tokenPtr = parsePtr->tokenPtr;
+ cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
+
+ /* Is this a command we should (try to) compile with a compileProc ? */
+ if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+ if (cmdPtr) {
/*
- * Each iteration of the following loop compiles one word from the
- * command.
+ * Found a command. Test the ways we can be told not to attempt
+ * to compile it.
*/
+ if ((cmdPtr->compileProc == NULL)
+ || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+ || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+ cmdPtr = NULL;
+ }
+ }
+ if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+ expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+ if (expand) {
+ /* We need to expand, but compileProc cannot. */
+ cmdPtr = NULL;
+ }
+ }
+ }
- for (wordIdx = 0, tokenPtr = parse.tokenPtr;
- wordIdx < parse.numWords; wordIdx++,
- tokenPtr += (tokenPtr->numComponents + 1)) {
+ /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
+ if (cmdPtr) {
+ code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr);
+ }
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- /*
- * The word is not a simple string of characters.
- */
+ if (code == TCL_ERROR) {
+ if (expand < 0) {
+ expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+ }
- TclCompileTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
- TclEmitInstInt4(INST_EXPAND_STKTOP,
- envPtr->currStackDepth, envPtr);
- }
- continue;
- }
+ if (expand) {
+ CompileExpanded(interp, parsePtr->tokenPtr,
+ cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
+ } else {
+ TclCompileInvocation(interp, parsePtr->tokenPtr,
+ cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
+ }
+ }
- /*
- * This is a simple string of literal characters (i.e. we know
- * it absolutely and can use it directly). If this is the
- * first word and the command has a compile procedure, let it
- * compile the command.
- */
+ Tcl_DecrRefCount(cmdObj);
- if ((wordIdx == 0) && !expand) {
- /*
- * We copy the string before trying to find the command by
- * name. We used to modify the string in place, but this
- * is not safe because the name resolution handlers could
- * have side effects that rely on the unmodified string.
- */
+ TclEmitOpcode(INST_POP, envPtr);
+ EnterCmdExtentData(envPtr, cmdIdx,
+ parsePtr->term - parsePtr->commandStart,
+ (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);
-
- cmdPtr = (Command *) Tcl_FindCommand(interp,
- Tcl_DStringValue(&ds),
- (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
-
- if ((cmdPtr != NULL)
- && (cmdPtr->compileProc != NULL)
- && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
- && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
- int savedNumCmds = envPtr->numCommands;
- unsigned int savedCodeNext =
- envPtr->codeNext - envPtr->codeStart;
-
- /*
- * Mark the start of the command; the proper bytecode
- * length will be updated later. There is no need to
- * do this for the first command in the compile env,
- * as the check is done before calling
- * TclExecuteByteCode(). Remark that we are compiling
- * the first cmd in the environment exactly when
- * (savedCodeNext == 0)
- */
-
- if (savedCodeNext != 0) {
- TclEmitInstInt4(INST_START_CMD, 0, envPtr);
- }
-
- code = (cmdPtr->compileProc)(interp, &parse, envPtr);
-
- if (code == TCL_OK) {
- if (savedCodeNext != 0) {
- /*
- * Fix the bytecode length.
- */
- unsigned char *fixPtr = envPtr->codeStart
- + savedCodeNext + 1;
- unsigned int fixLen = envPtr->codeNext
- - envPtr->codeStart - savedCodeNext;
-
- TclStoreInt4AtPtr(fixLen, fixPtr);
- }
- goto finishCommand;
- } else {
- /*
- * Restore numCommands and codeNext to their
- * correct values, removing any commands compiled
- * before the failure to produce bytecode got
- * reported. [Bugs 705406 and 735055]
- */
- envPtr->numCommands = savedNumCmds;
- envPtr->codeNext = envPtr->codeStart+savedCodeNext;
- }
- }
+ /*
+ * TIP #280: Free full form of per-word line data and insert the reduced
+ * form now
+ */
- /*
- * No compile procedure so push the word. If the command
- * was found, push a CmdName object to reduce runtime
- * lookups. Avoid sharing this literal among different
- * namespaces to reduce shimmering.
- */
+ envPtr->line = cmdLine;
+ envPtr->clNext = clNext;
+ ckfree(eclPtr->loc[wlineat].line);
+ ckfree(eclPtr->loc[wlineat].next);
+ eclPtr->loc[wlineat].line = wlines;
+ eclPtr->loc[wlineat].next = NULL;
- objIndex = TclRegisterNewNSLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
- if (cmdPtr != NULL) {
- TclSetCmdNameObj(interp,
- envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr);
- }
- if ((wordIdx == 0) && (parse.numWords == 1)) {
- /*
- * Single word script: unshare the command name to
- * avoid shimmering between bytecode and cmdName
- * representations [Bug 458361]
- */
-
- TclHideLiteral(interp, envPtr, objIndex);
- }
- } else {
- objIndex = TclRegisterNewLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
- }
- TclEmitPush(objIndex, envPtr);
- }
+ TclCheckStackDepth(depth, envPtr);
+ return cmdIdx;
+}
- /*
- * Emit an invoke instruction for the command. We skip this if a
- * compile procedure was found for the command.
- */
+void
+TclCompileScript(
+ Tcl_Interp *interp, /* Used for error and status reporting. Also
+ * serves as context for finding and compiling
+ * commands. May not be NULL. */
+ const char *script, /* The source script to compile. */
+ int numBytes, /* Number of bytes in script. If < 0, the
+ * script consists of all bytes up to the
+ * first null character. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last
+ * command this routine compiles into bytecode.
+ * Initial value of -1 indicates this routine
+ * has not yet generated any bytecode. */
+ const char *p = script; /* Where we are in our compile. */
+ int depth = TclGetStackDepth(envPtr);
+
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
- if (expand) {
- /*
- * The stack depth during argument expansion can only be
- * managed at runtime, as the number of elements in the
- * expanded lists is not known at compile time. We adjust
- * here the stack depth estimate so that it is correct after
- * the command with expanded arguments returns.
- *
- * The end effect of this command's invocation is that all the
- * words of the command are popped from the stack, and the
- * result is pushed: the stack top changes by (1-wordIdx).
- *
- * Note that the estimates are not correct while the command
- * is being prepared and run, INST_EXPAND_STKTOP is not
- * stack-neutral in general.
- */
+ /* Each iteration compiles one command from the script. */
- TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
- TclAdjustStackDepth((1-wordIdx), envPtr);
- } else if (wordIdx > 0) {
- if (wordIdx <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
- } else {
- TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
- }
- }
+ while (numBytes > 0) {
+ Tcl_Parse parse;
+ const char *next;
+ if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
/*
- * Update the compilation environment structure and record the
- * offsets of the source and code for the command.
+ * Compile bytecodes to report the parse error at runtime.
*/
- finishCommand:
- EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
- (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
- isFirstCmd = 0;
- } /* end if parse.numWords > 0 */
+ Tcl_LogCommandInfo(interp, script, parse.commandStart,
+ parse.term + 1 - parse.commandStart);
+ TclCompileSyntaxError(interp, envPtr);
+ return;
+ }
+#ifdef TCL_COMPILE_DEBUG
/*
- * Advance to the next command in the script.
+ * If tracing, print a line for each top level command compiled.
+ * TODO: Suppress when numWords == 0 ?
+ */
+
+ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+ int commandLength = parse.term - parse.commandStart;
+ fprintf(stdout, " Compiling: ");
+ TclPrintSource(stdout, parse.commandStart,
+ TclMin(commandLength, 55));
+ fprintf(stdout, "\n");
+ }
+#endif
+
+ /*
+ * TIP #280: Count newlines before the command start.
+ * (See test info-30.33).
+ */
+
+ TclAdvanceLines(&envPtr->line, p, parse.commandStart);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ parse.commandStart - envPtr->source);
+
+ /*
+ * Advance parser to the next command in the script.
*/
next = parse.commandStart + parse.commandSize;
- bytesLeft -= (next - p);
+ numBytes -= next - p;
p = next;
- Tcl_FreeParse(&parse);
- gotParse = 0;
- } while (bytesLeft > 0);
- /*
- * 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 (parse.numWords == 0) {
+ /*
+ * The "command" parsed has no words. In this case we can skip
+ * the rest of the loop body. With no words, clearly
+ * CompileCommandTokens() has nothing to do. Since the parser
+ * aggressively sucks up leading comment and white space,
+ * including newlines, parse.commandStart must be pointing at
+ * either the end of script, or a command-terminating semi-colon.
+ * In either case, the TclAdvance*() calls have nothing to do.
+ * Finally, when no words are parsed, no tokens have been
+ * allocated at parse.tokenPtr so there's also nothing for
+ * Tcl_FreeParse() to do.
+ *
+ * The advantage of this shortcut is that CompileCommandTokens()
+ * can be written with an assumption that parse.numWords > 0, with
+ * the implication the CCT() always generates bytecode.
+ */
+ continue;
+ }
- if (envPtr->codeNext == entryCodeNext) {
- TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr);
+ lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr);
+
+ /*
+ * TIP #280: Track lines in the just compiled command.
+ */
+
+ TclAdvanceLines(&envPtr->line, parse.commandStart, p);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ p - envPtr->source);
+ Tcl_FreeParse(&parse);
}
- envPtr->numSrcBytes = (p - script);
- Tcl_DStringFree(&ds);
+ if (lastCmdIdx == -1) {
+ /*
+ * Compiling the script yielded no bytecode. The script must be all
+ * whitespace, comments, and empty commands. Such scripts are defined
+ * to successfully produce the empty string result, so we emit the
+ * simple bytecode that makes that happen.
+ */
+
+ PushStringLiteral(envPtr, "");
+ } else {
+ /*
+ * We compiled at least one command to bytecode. The routine
+ * CompileCommandTokens() follows the bytecode of each compiled
+ * command with an INST_POP, so that stack balance is maintained when
+ * several commands are in sequence. (The result of each command is
+ * thrown away before moving on to the next command). For the last
+ * command compiled, we need to undo that INST_POP so that the result
+ * of the last command becomes the result of the script. The code
+ * here removes that trailing INST_POP.
+ */
+
+ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
+ envPtr->codeNext--;
+ envPtr->currStackDepth++;
+ }
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -1325,33 +2261,171 @@ TclCompileScript(interp, script, numBytes, envPtr)
*/
void
-TclCompileTokens(interp, tokenPtr, count, envPtr)
- Tcl_Interp *interp; /* Used for error and status reporting. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens to
+TclCompileVarSubst(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr)
+{
+ const char *p, *name = tokenPtr[1].start;
+ int nameBytes = tokenPtr[1].size;
+ int i, localVar, localVarName = 1;
+
+ /*
+ * Determine how the variable name should be handled: if it contains any
+ * namespace qualifiers it is not a local variable (localVarName=-1); if
+ * it looks like an array element and the token has a single component, it
+ * should not be created here [Bug 569438] (localVarName=0); otherwise,
+ * the local variable can safely be created (localVarName=1).
+ */
+
+ for (i = 0, p = name; i < nameBytes; i++, p++) {
+ if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
+ localVarName = -1;
+ break;
+ } else if ((*p == '(')
+ && (tokenPtr->numComponents == 1)
+ && (*(name + nameBytes - 1) == ')')) {
+ localVarName = 0;
+ break;
+ }
+ }
+
+ /*
+ * Either push the variable's name, or find its index in the array
+ * of local variables in a procedure frame.
+ */
+
+ localVar = -1;
+ if (localVarName != -1) {
+ localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
+ }
+ if (localVar < 0) {
+ PushLiteral(envPtr, name, nameBytes);
+ }
+
+ /*
+ * Emit instructions to load the variable.
+ */
+
+ TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
+ tokenPtr[1].start + tokenPtr[1].size);
+
+ if (tokenPtr->numComponents == 1) {
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
+ }
+ } else {
+ TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
+ }
+ }
+}
+
+void
+TclCompileTokens(
+ Tcl_Interp *interp, /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* compile. */
- int count; /* Number of tokens to consider at tokenPtr.
+ int count, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
- CONST char *name, *p;
- int numObjsToConcat, nameBytes, localVarName, localVar;
- int length, i;
+ int i, numObjsToConcat, length, adjust;
unsigned char *entryCodeNext = envPtr->codeNext;
+#define NUM_STATIC_POS 20
+ int isLiteral, maxNumCL, numCL;
+ int *clPosition = NULL;
+ int depth = TclGetStackDepth(envPtr);
+
+ /*
+ * For the handling of continuation lines in literals we first check if
+ * this is actually a literal. For if not we can forego the additional
+ * processing. Otherwise we pre-allocate a small table to store the
+ * locations of all continuation lines we find in this literal, if any.
+ * The table is extended if needed.
+ *
+ * Note: Different to the equivalent code in function 'TclSubstTokens()'
+ * (see file "tclParse.c") we do not seem to need the 'adjust' variable.
+ * We also do not seem to need code which merges continuation line
+ * information of multiple words which concat'd at runtime. Either that or
+ * I have not managed to find a test case for these two possibilities yet.
+ * It might be a difference between compile- versus run-time processing.
+ */
+
+ numCL = 0;
+ maxNumCL = 0;
+ isLiteral = 1;
+ for (i=0 ; i < count; i++) {
+ if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
+ && (tokenPtr[i].type != TCL_TOKEN_BS)) {
+ isLiteral = 0;
+ break;
+ }
+ }
+ if (isLiteral) {
+ maxNumCL = NUM_STATIC_POS;
+ clPosition = ckalloc(maxNumCL * sizeof(int));
+ }
+
+ adjust = 0;
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
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, (int *) NULL, buffer);
+ length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
+ NULL, buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
+
+ /*
+ * If the backslash sequence we found is in a literal, and
+ * represented a continuation line, we compute and store its
+ * location (as char offset to the beginning of the _result_
+ * script). We may have to extend the table of locations.
+ *
+ * Note that the continuation line information is relevant even if
+ * the word we are processing is not a literal, as it can affect
+ * nested commands. See the branch for TCL_TOKEN_COMMAND below,
+ * where the adjustment we are tracking here is taken into
+ * account. The good thing is that we do not need a table of
+ * everything, just the number of lines we have to add as
+ * correction.
+ */
+
+ if ((length == 1) && (buffer[0] == ' ') &&
+ (tokenPtr->start[1] == '\n')) {
+ if (isLiteral) {
+ int clPos = Tcl_DStringLength(&textBuffer);
+
+ if (numCL >= maxNumCL) {
+ maxNumCL *= 2;
+ clPosition = ckrealloc(clPosition,
+ maxNumCL * sizeof(int));
+ }
+ clPosition[numCL] = clPos;
+ numCL ++;
+ }
+ adjust++;
+ }
break;
case TCL_TOKEN_COMMAND:
@@ -1360,18 +2434,23 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
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++;
Tcl_DStringFree(&textBuffer);
+
+ if (numCL) {
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
+ numCL, clPosition);
+ }
+ numCL = 0;
}
+ envPtr->line += adjust;
TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, envPtr);
+ envPtr->line -= adjust;
numObjsToConcat++;
break;
@@ -1383,86 +2462,21 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
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);
}
- /*
- * Determine how the variable name should be handled: if it
- * contains any namespace qualifiers it is not a local variable
- * (localVarName=-1); if it looks like an array element and the
- * token has a single component, it should not be created here
- * [Bug 569438] (localVarName=0); otherwise, the local variable
- * can safely be created (localVarName=1).
- */
-
- name = tokenPtr[1].start;
- nameBytes = tokenPtr[1].size;
- localVarName = -1;
- if (envPtr->procPtr != NULL) {
- localVarName = 1;
- for (i = 0, p = name; i < nameBytes; i++, p++) {
- if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
- localVarName = -1;
- break;
- } else if ((*p == '(')
- && (tokenPtr->numComponents == 1)
- && (*(name + nameBytes - 1) == ')')) {
- localVarName = 0;
- break;
- }
- }
- }
-
- /*
- * Either push the variable's name, or find its index in the array
- * of local variables in a procedure frame.
- */
-
- localVar = -1;
- if (localVarName != -1) {
- localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
- /*flags*/ 0, envPtr->procPtr);
- }
- if (localVar < 0) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
- envPtr);
- }
-
- /*
- * Emit instructions to load the variable.
- */
-
- if (tokenPtr->numComponents == 1) {
- if (localVar < 0) {
- TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
- } else if (localVar <= 255) {
- TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
- }
- } else {
- TclCompileTokens(interp, tokenPtr+2,
- tokenPtr->numComponents-1, envPtr);
- if (localVar < 0) {
- TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
- } else if (localVar <= 255) {
- TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
- }
- }
+ TclCompileVarSubst(interp, tokenPtr, envPtr);
numObjsToConcat++;
count -= tokenPtr->numComponents;
tokenPtr += tokenPtr->numComponents;
break;
default:
- Tcl_Panic("Unexpected token type in TclCompileTokens");
+ Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
+ tokenPtr->type, tokenPtr->size, tokenPtr->start);
}
}
@@ -1471,12 +2485,15 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
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(TclFetchLiteral(envPtr, literal),
+ numCL, clPosition);
+ }
+ numCL = 0;
}
/*
@@ -1484,11 +2501,11 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
while (numObjsToConcat > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
}
if (numObjsToConcat > 1) {
- TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
}
/*
@@ -1496,9 +2513,19 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
if (envPtr->codeNext == entryCodeNext) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ PushStringLiteral(envPtr, "");
}
Tcl_DStringFree(&textBuffer);
+
+ /*
+ * Release the temp table we used to collect the locations of continuation
+ * lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree(clPosition);
+ }
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -1523,13 +2550,13 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
*/
void
-TclCompileCmdWord(interp, tokenPtr, count, envPtr)
- Tcl_Interp *interp; /* Used for error and status reporting. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens for
+TclCompileCmdWord(
+ Tcl_Interp *interp, /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for
* a command word to compile inline. */
- int count; /* Number of tokens to consider at tokenPtr.
+ int count, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
{
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
/*
@@ -1540,13 +2567,13 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
} else {
/*
- * Multiple tokens or the single token involves substitutions. Emit
+ * Multiple tokens or the single token involves substitutions. Emit
* instructions to invoke the eval command procedure at runtime on the
* result of evaluating the tokens.
*/
TclCompileTokens(interp, tokenPtr, count, envPtr);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
}
}
@@ -1572,15 +2599,15 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
*/
void
-TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
- Tcl_Interp *interp; /* Used for error and status reporting. */
- Tcl_Token *tokenPtr; /* Points to first in an array of word tokens
+TclCompileExprWords(
+ Tcl_Interp *interp, /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr, /* Points to first in an array of word tokens
* tokens for the expression to compile
* inline. */
- int numWords; /* Number of word tokens starting at tokenPtr.
+ int numWords, /* Number of word tokens starting at tokenPtr.
* Must be at least 1. Each word token
* contains one or more subtokens. */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
+ CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_Token *wordPtr;
int i, concatItems;
@@ -1591,16 +2618,8 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
*/
if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
- CONST char *script = tokenPtr[1].start;
- int numBytes = tokenPtr[1].size;
- int savedNumCmds = envPtr->numCommands;
- unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart;
-
- if (TclCompileExpr(interp, script, numBytes, envPtr) == TCL_OK) {
- return;
- }
- envPtr->numCommands = savedNumCmds;
- envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+ TclCompileExpr(interp, tokenPtr[1].start,tokenPtr[1].size, envPtr, 1);
+ return;
}
/*
@@ -1610,19 +2629,19 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
wordPtr = tokenPtr;
for (i = 0; i < numWords; i++) {
- TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
+ CompileTokens(envPtr, wordPtr, interp);
if (i < (numWords - 1)) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr);
+ PushStringLiteral(envPtr, " ");
}
- wordPtr += (wordPtr->numComponents + 1);
+ wordPtr += wordPtr->numComponents + 1;
}
concatItems = 2*numWords - 1;
while (concatItems > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
concatItems -= 254;
}
if (concatItems > 1) {
- TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
}
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
@@ -1630,12 +2649,55 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
/*
*----------------------------------------------------------------------
*
+ * TclCompileNoOp --
+ *
+ * Function called to compile no-op's
+ *
+ * Results:
+ * The return value is TCL_OK, indicating successful compilation.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute a no-op at runtime. No
+ * result is pushed onto the stack: the compiler has to take care of this
+ * itself if the last compiled command is a NoOp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNoOp(
+ 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;
+ int i;
+
+ tokenPtr = parsePtr->tokenPtr;
+ for (i = 1; i < parsePtr->numWords; i++) {
+ tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ CompileTokens(envPtr, tokenPtr, interp);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ }
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclInitByteCodeObj --
*
* Create a ByteCode structure and initialize it from a CompileEnv
* compilation environment structure. The ByteCode structure is smaller
* and contains just that information needed to execute the bytecode
- * instructions resulting from compiling a Tcl script. The resulting
+ * instructions resulting from compiling a Tcl script. The resulting
* structure is placed in the specified object.
*
* Results:
@@ -1653,12 +2715,12 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
*/
void
-TclInitByteCodeObj(objPtr, envPtr)
- Tcl_Obj *objPtr; /* Points object that should be initialized,
- * and whose string rep contains the source
- * code. */
- register CompileEnv *envPtr; /* Points to the CompileEnv structure from
- * which to create a ByteCode structure. */
+TclInitByteCodeObj(
+ Tcl_Obj *objPtr, /* Points object that should be initialized,
+ * and whose string rep contains the source
+ * code. */
+ register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+ * which to create a ByteCode structure. */
{
register ByteCode *codePtr;
size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
@@ -1669,15 +2731,19 @@ TclInitByteCodeObj(objPtr, envPtr)
#endif
int numLitObjects = envPtr->literalArrayNext;
Namespace *namespacePtr;
- int i;
+ int i, isNew;
Interp *iPtr;
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+ }
+
iPtr = envPtr->iPtr;
- codeBytes = (envPtr->codeNext - envPtr->codeStart);
- objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
- exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
- auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
+ codeBytes = envPtr->codeNext - envPtr->codeStart;
+ objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *);
+ exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
+ auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
cmdLocBytes = GetCmdLocEncodingSize(envPtr);
/*
@@ -1697,7 +2763,7 @@ TclInitByteCodeObj(objPtr, envPtr)
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;
@@ -1724,19 +2790,40 @@ TclInitByteCodeObj(objPtr, envPtr)
p += sizeof(ByteCode);
codePtr->codeStart = p;
- memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
+ memcpy(p, envPtr->codeStart, (size_t) codeBytes);
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;
+ Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
+
+ if (objPtr == fetched) {
+ /*
+ * 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]);
+ TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
+ } else {
+ codePtr->objArrayPtr[i] = fetched;
+ }
}
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
if (exceptArrayBytes > 0) {
codePtr->exceptArrayPtr = (ExceptionRange *) p;
- memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
- (size_t) exceptArrayBytes);
+ memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
} else {
codePtr->exceptArrayPtr = NULL;
}
@@ -1744,8 +2831,7 @@ TclInitByteCodeObj(objPtr, envPtr)
p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
if (auxDataArrayBytes > 0) {
codePtr->auxDataArrayPtr = (AuxData *) p;
- memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
- (size_t) auxDataArrayBytes);
+ memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
} else {
codePtr->auxDataArrayPtr = NULL;
}
@@ -1756,7 +2842,7 @@ TclInitByteCodeObj(objPtr, envPtr)
#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\n", (nextPtr - p), cmdLocBytes);
+ Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
}
#endif
@@ -1768,7 +2854,7 @@ TclInitByteCodeObj(objPtr, envPtr)
#ifdef TCL_COMPILE_STATS
codePtr->structureSize = structureSize
- (sizeof(size_t) + sizeof(Tcl_Time));
- Tcl_GetTime(&(codePtr->createTime));
+ Tcl_GetTime(&codePtr->createTime);
RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */
@@ -1779,8 +2865,22 @@ TclInitByteCodeObj(objPtr, envPtr)
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
objPtr->typePtr = &tclByteCodeType;
+
+ /*
+ * TIP #280. Associate the extended per-word line information with the
+ * byte code object (internal rep), for use with the bc compiler.
+ */
+
+ Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
+ &isNew), envPtr->extCmdMapPtr);
+ envPtr->extCmdMapPtr = NULL;
+
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->iPtr = NULL;
+
+ codePtr->localCachePtr = NULL;
}
/*
@@ -1809,34 +2909,62 @@ TclInitByteCodeObj(objPtr, envPtr)
*/
int
-TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
- register CONST char *name; /* Points to first character of the name of a
+TclFindCompiledLocal(
+ register const char *name, /* Points to first character of the name of a
* scalar or array variable. If NULL, a
* temporary var should be created. */
- int nameBytes; /* Number of bytes in the name. */
- int create; /* If 1, allocate a local frame entry for the
+ int nameBytes, /* Number of bytes in the name. */
+ int create, /* If 1, allocate a local frame entry for the
* variable if it is new. */
- int flags; /* Flag bits for the compiled local if
- * created. Only VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK make sense. */
- register Proc *procPtr; /* Points to structure describing procedure
- * containing the variable reference. */
+ CompileEnv *envPtr) /* Points to the current compile environment*/
{
register CompiledLocal *localPtr;
int localVar = -1;
register int i;
+ Proc *procPtr;
/*
* If not creating a temporary, does a local variable of the specified
* name already exist?
*/
+ procPtr = envPtr->procPtr;
+
+ if (procPtr == NULL) {
+ /*
+ * Compiling a non-body script: give it read access to the LVT in the
+ * current localCache
+ */
+
+ LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
+ const char *localName;
+ Tcl_Obj **varNamePtr;
+ int len;
+
+ if (!cachePtr || !name) {
+ return -1;
+ }
+
+ varNamePtr = &cachePtr->varName0;
+ for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
+ if (*varNamePtr) {
+ localName = Tcl_GetStringFromObj(*varNamePtr, &len);
+ if ((len == nameBytes) && !strncmp(name, localName, len)) {
+ return i;
+ }
+ }
+ }
+ return -1;
+ }
+
if (name != NULL) {
int localCt = procPtr->numCompiledLocals;
+
localPtr = procPtr->firstLocalPtr;
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
char *localName = localPtr->name;
+
if ((nameBytes == localPtr->nameLength) &&
(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
return i;
@@ -1852,9 +2980,7 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
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 {
@@ -1864,7 +2990,7 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
localPtr->nextPtr = NULL;
localPtr->nameLength = nameBytes;
localPtr->frameIndex = localVar;
- localPtr->flags = flags | VAR_UNDEFINED;
+ localPtr->flags = 0;
if (name == NULL) {
localPtr->flags |= VAR_TEMPORARY;
}
@@ -1872,14 +2998,14 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
localPtr->resolveInfo = NULL;
if (name != NULL) {
- memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameBytes);
+ memcpy(localPtr->name, name, (size_t) nameBytes);
}
localPtr->name[nameBytes] = '\0';
procPtr->numCompiledLocals++;
}
return localVar;
-
}
+
/*
*----------------------------------------------------------------------
*
@@ -1900,11 +3026,11 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
*/
void
-TclExpandCodeArray(envArgPtr)
- void *envArgPtr; /* Points to the CompileEnv whose code array
+TclExpandCodeArray(
+ void *envArgPtr) /* Points to the CompileEnv whose code array
* must be enlarged. */
{
- CompileEnv *envPtr = (CompileEnv*) envArgPtr;
+ CompileEnv *envPtr = envArgPtr;
/* The CompileEnv containing the code array to
* be doubled in size. */
@@ -1914,23 +3040,26 @@ TclExpandCodeArray(envArgPtr)
* [inclusive].
*/
- size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
- size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
- unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
-
- /*
- * Copy from old code array to new, free old code array if needed, and
- * mark new code array as malloced.
- */
+ size_t currBytes = envPtr->codeNext - envPtr->codeStart;
+ size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
- memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
if (envPtr->mallocedCodeArray) {
- ckfree((char *) envPtr->codeStart);
+ 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 = ckalloc(newBytes);
+
+ memcpy(newPtr, envPtr->codeStart, currBytes);
+ envPtr->codeStart = newPtr;
+ envPtr->mallocedCodeArray = 1;
}
- envPtr->codeStart = newPtr;
- envPtr->codeNext = (newPtr + currBytes);
- envPtr->codeEnd = (newPtr + newBytes);
- envPtr->mallocedCodeArray = 1;
+
+ envPtr->codeNext = envPtr->codeStart + currBytes;
+ envPtr->codeEnd = envPtr->codeStart + newBytes;
}
/*
@@ -1954,19 +3083,19 @@ TclExpandCodeArray(envArgPtr)
*/
static void
-EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
- CompileEnv *envPtr; /* Points to the compilation environment
+EnterCmdStartData(
+ CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
- int cmdIndex; /* Index of the command whose start data is
+ int cmdIndex, /* Index of the command whose start data is
* being set. */
- int srcOffset; /* Offset of first char of the command. */
- int codeOffset; /* Offset of first byte of command code. */
+ int srcOffset, /* Offset of first char of the command. */
+ int codeOffset) /* Offset of first byte of command code. */
{
CmdLocation *cmdLocPtr;
if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
- Tcl_Panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+ Tcl_Panic("EnterCmdStartData: bad command index %d", cmdIndex);
}
if (cmdIndex >= envPtr->cmdMapEnd) {
@@ -1977,23 +3106,25 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
*/
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);
- CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
-
- /*
- * Copy from old command location array to new, free old command
- * location array if needed, and mark new array as malloced.
- */
- memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
if (envPtr->mallocedCmdMap) {
- ckfree((char *) envPtr->cmdMapPtr);
+ 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 = ckalloc(newBytes);
+
+ memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
+ envPtr->cmdMapPtr = newPtr;
+ envPtr->mallocedCmdMap = 1;
}
- envPtr->cmdMapPtr = (CmdLocation *) newPtr;
envPtr->cmdMapEnd = newElems;
- envPtr->mallocedCmdMap = 1;
}
if (cmdIndex > 0) {
@@ -2002,7 +3133,7 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
}
}
- cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+ cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->srcOffset = srcOffset;
cmdLocPtr->numSrcBytes = -1;
@@ -2031,33 +3162,113 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
*/
static void
-EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
- CompileEnv *envPtr; /* Points to the compilation environment
+EnterCmdExtentData(
+ CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
- int cmdIndex; /* Index of the command whose source and code
+ int cmdIndex, /* Index of the command whose source and code
* length data is being set. */
- int numSrcBytes; /* Number of command source chars. */
- int numCodeBytes; /* Offset of last byte of command code. */
+ int numSrcBytes, /* Number of command source chars. */
+ int numCodeBytes) /* Offset of last byte of command code. */
{
CmdLocation *cmdLocPtr;
if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
- Tcl_Panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
+ Tcl_Panic("EnterCmdExtentData: bad command index %d", cmdIndex);
}
if (cmdIndex > envPtr->cmdMapEnd) {
- Tcl_Panic("EnterCmdExtentData: missing start data for command %d\n",
+ Tcl_Panic("EnterCmdExtentData: missing start data for command %d",
cmdIndex);
}
- cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+ cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
cmdLocPtr->numSrcBytes = numSrcBytes;
cmdLocPtr->numCodeBytes = numCodeBytes;
}
/*
*----------------------------------------------------------------------
+ * TIP #280
+ *
+ * EnterCmdWordData --
+ *
+ * Registers the lines for the words of a command. This information is
+ * used at runtime by 'info frame'.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Inserts word location information into the compilation environment
+ * envPtr for the command at index cmdIndex. The compilation
+ * environment's ExtCmdLoc.ECL array is grown if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EnterCmdWordData(
+ ExtCmdLoc *eclPtr, /* Points to the map environment structure in
+ * which to enter command location
+ * information. */
+ int srcOffset, /* Offset of first char of the command. */
+ Tcl_Token *tokenPtr,
+ const char *cmd,
+ int len,
+ int numWords,
+ int line,
+ int *clNext,
+ int **wlines,
+ CompileEnv *envPtr)
+{
+ ECL *ePtr;
+ const char *last;
+ int wordIdx, wordLine, *wwlines, *wordNext;
+
+ if (eclPtr->nuloc >= eclPtr->nloc) {
+ /*
+ * Expand the ECL array by allocating more storage from the heap. The
+ * currently allocated ECL entries are stored from eclPtr->loc[0] up
+ * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
+ */
+
+ size_t currElems = eclPtr->nloc;
+ size_t newElems = (currElems ? 2*currElems : 1);
+ size_t newBytes = newElems * sizeof(ECL);
+
+ eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
+ eclPtr->nloc = newElems;
+ }
+
+ ePtr = &eclPtr->loc[eclPtr->nuloc];
+ ePtr->srcOffset = srcOffset;
+ ePtr->line = ckalloc(numWords * sizeof(int));
+ ePtr->next = ckalloc(numWords * sizeof(int *));
+ ePtr->nline = numWords;
+ wwlines = ckalloc(numWords * sizeof(int));
+
+ last = cmd;
+ wordLine = line;
+ wordNext = clNext;
+ for (wordIdx=0 ; wordIdx<numWords;
+ wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+ TclAdvanceLines(&wordLine, last, tokenPtr->start);
+ TclAdvanceContinuations(&wordLine, &wordNext,
+ tokenPtr->start - envPtr->source);
+ wwlines[wordIdx] =
+ (TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
+ ePtr->line[wordIdx] = wordLine;
+ ePtr->next[wordIdx] = wordNext;
+ last = tokenPtr->start;
+ }
+
+ *wlines = wwlines;
+ eclPtr->nuloc ++;
+}
+
+/*
+ *----------------------------------------------------------------------
*
* TclCreateExceptRange --
*
@@ -2077,12 +3288,13 @@ EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
*/
int
-TclCreateExceptRange(type, envPtr)
- ExceptionRangeType type; /* The kind of ExceptionRange desired. */
- register CompileEnv *envPtr;/* Points to CompileEnv for which to create a
+TclCreateExceptRange(
+ ExceptionRangeType type, /* The kind of ExceptionRange desired. */
+ register CompileEnv *envPtr)/* Points to CompileEnv for which to create a
* new ExceptionRange structure. */
{
register ExceptionRange *rangePtr;
+ register ExceptionAux *auxPtr;
int index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
@@ -2094,27 +3306,36 @@ TclCreateExceptRange(type, envPtr)
size_t currBytes =
envPtr->exceptArrayNext * sizeof(ExceptionRange);
+ size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
int newElems = 2*envPtr->exceptArrayEnd;
size_t newBytes = newElems * sizeof(ExceptionRange);
- ExceptionRange *newPtr = (ExceptionRange *)
- ckalloc((unsigned) newBytes);
-
- /*
- * Copy from old ExceptionRange array to new, free old ExceptionRange
- * array if needed, and mark the new ExceptionRange array as malloced.
- */
+ size_t newBytes2 = newElems * sizeof(ExceptionAux);
- memcpy((VOID *) newPtr, (VOID *) envPtr->exceptArrayPtr, currBytes);
if (envPtr->mallocedExceptArray) {
- ckfree((char *) envPtr->exceptArrayPtr);
+ envPtr->exceptArrayPtr =
+ ckrealloc(envPtr->exceptArrayPtr, newBytes);
+ envPtr->exceptAuxArrayPtr =
+ ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
+ } else {
+ /*
+ * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
+ * code a ckrealloc equivalent for ourselves.
+ */
+
+ ExceptionRange *newPtr = ckalloc(newBytes);
+ ExceptionAux *newPtr2 = ckalloc(newBytes2);
+
+ memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
+ memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
+ envPtr->exceptArrayPtr = newPtr;
+ envPtr->exceptAuxArrayPtr = newPtr2;
+ envPtr->mallocedExceptArray = 1;
}
- envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
envPtr->exceptArrayEnd = newElems;
- envPtr->mallocedExceptArray = 1;
}
envPtr->exceptArrayNext++;
- rangePtr = &(envPtr->exceptArrayPtr[index]);
+ rangePtr = &envPtr->exceptArrayPtr[index];
rangePtr->type = type;
rangePtr->nestingLevel = envPtr->exceptDepth;
rangePtr->codeOffset = -1;
@@ -2122,10 +3343,294 @@ TclCreateExceptRange(type, envPtr)
rangePtr->breakOffset = -1;
rangePtr->continueOffset = -1;
rangePtr->catchOffset = -1;
+ auxPtr = &envPtr->exceptAuxArrayPtr[index];
+ auxPtr->supportsContinue = 1;
+ auxPtr->stackDepth = envPtr->currStackDepth;
+ auxPtr->expandTarget = envPtr->expandCount;
+ auxPtr->expandTargetDepth = -1;
+ auxPtr->numBreakTargets = 0;
+ auxPtr->breakTargets = NULL;
+ auxPtr->allocBreakTargets = 0;
+ auxPtr->numContinueTargets = 0;
+ auxPtr->continueTargets = NULL;
+ auxPtr->allocContinueTargets = 0;
return index;
}
/*
+ * ---------------------------------------------------------------------
+ *
+ * TclGetInnermostExceptionRange --
+ *
+ * Returns the innermost exception range that covers the current code
+ * creation point, and (optionally) the stack depth that is expected at
+ * that point. Relies on the fact that the range has a numCodeBytes = -1
+ * when it is being populated and that inner ranges come after outer
+ * ranges.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+ExceptionRange *
+TclGetInnermostExceptionRange(
+ CompileEnv *envPtr,
+ int returnCode,
+ ExceptionAux **auxPtrPtr)
+{
+ int exnIdx = -1, i;
+
+ for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+
+ if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
+ (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
+ rangePtr->codeOffset+rangePtr->numCodeBytes) &&
+ (returnCode != TCL_CONTINUE ||
+ envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
+ exnIdx = i;
+ }
+ }
+ if (exnIdx == -1) {
+ return NULL;
+ }
+ if (auxPtrPtr) {
+ *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
+ }
+ return &envPtr->exceptArrayPtr[exnIdx];
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
+ *
+ * Adds a place that wants to break/continue to the loop exception range
+ * tracking that will be fixed up once the loop can be finalized. These
+ * functions will generate an INST_JUMP4 that will be fixed up during the
+ * loop finalization.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclAddLoopBreakFixup(
+ CompileEnv *envPtr,
+ ExceptionAux *auxPtr)
+{
+ int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+ if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to add 'break' fixup to full exception range");
+ }
+
+ if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
+ auxPtr->allocBreakTargets *= 2;
+ auxPtr->allocBreakTargets += 2;
+ if (auxPtr->breakTargets) {
+ auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets,
+ sizeof(int) * auxPtr->allocBreakTargets);
+ } else {
+ auxPtr->breakTargets =
+ ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
+ }
+ }
+ auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+void
+TclAddLoopContinueFixup(
+ CompileEnv *envPtr,
+ ExceptionAux *auxPtr)
+{
+ int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+ if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to add 'continue' fixup to full exception range");
+ }
+
+ if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
+ auxPtr->allocContinueTargets *= 2;
+ auxPtr->allocContinueTargets += 2;
+ if (auxPtr->continueTargets) {
+ auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets,
+ sizeof(int) * auxPtr->allocContinueTargets);
+ } else {
+ auxPtr->continueTargets =
+ ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
+ }
+ }
+ auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
+ CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclCleanupStackForBreakContinue --
+ *
+ * Ditch the extra elements from the auxiliary stack and the main stack.
+ * How to do this exactly depends on whether there are any elements on
+ * the auxiliary stack to pop.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclCleanupStackForBreakContinue(
+ CompileEnv *envPtr,
+ ExceptionAux *auxPtr)
+{
+ int savedStackDepth = envPtr->currStackDepth;
+ int toPop = envPtr->expandCount - auxPtr->expandTarget;
+
+ if (toPop > 0) {
+ while (toPop --> 0) {
+ TclEmitOpcode(INST_EXPAND_DROP, envPtr);
+ }
+ TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
+ envPtr);
+ envPtr->currStackDepth = auxPtr->expandTargetDepth;
+ }
+ toPop = envPtr->currStackDepth - auxPtr->stackDepth;
+ while (toPop --> 0) {
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ envPtr->currStackDepth = savedStackDepth;
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * StartExpanding --
+ *
+ * Pushes an INST_EXPAND_START and does some additional housekeeping so
+ * that the [break] and [continue] compilers can use an exception-free
+ * issue to discard it.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static void
+StartExpanding(
+ CompileEnv *envPtr)
+{
+ int i;
+
+ TclEmitOpcode(INST_EXPAND_START, envPtr);
+
+ /*
+ * Update inner exception ranges with information about the environment
+ * where this expansion started.
+ */
+
+ for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+ ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i];
+
+ /*
+ * Ignore loops unless they're still being built.
+ */
+
+ if (rangePtr->codeOffset > CurrentOffset(envPtr)) {
+ continue;
+ }
+ if (rangePtr->numCodeBytes != -1) {
+ continue;
+ }
+
+ /*
+ * Adequate condition: further out loops and further in exceptions
+ * don't actually need this information.
+ */
+
+ if (auxPtr->expandTarget == envPtr->expandCount) {
+ auxPtr->expandTargetDepth = envPtr->currStackDepth;
+ }
+ }
+
+ /*
+ * There's now one more expansion being processed on the auxiliary stack.
+ */
+
+ envPtr->expandCount++;
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclFinalizeLoopExceptionRange --
+ *
+ * Finalizes a loop exception range, binding the registered [break] and
+ * [continue] implementations so that they jump to the correct place.
+ * Note that this must only be called after *all* the exception range
+ * target offsets have been set.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclFinalizeLoopExceptionRange(
+ CompileEnv *envPtr,
+ int range)
+{
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range];
+ ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range];
+ int i, offset;
+ unsigned char *site;
+
+ if (rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to finalize a loop exception range");
+ }
+
+ /*
+ * Do the jump fixups. Note that these are always issued as INST_JUMP4 so
+ * there is no need to fuss around with updating code offsets.
+ */
+
+ for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+ site = envPtr->codeStart + auxPtr->breakTargets[i];
+ offset = rangePtr->breakOffset - auxPtr->breakTargets[i];
+ TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+ }
+ for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+ site = envPtr->codeStart + auxPtr->continueTargets[i];
+ if (rangePtr->continueOffset == -1) {
+ int j;
+
+ /*
+ * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough
+ * space to do anything else.
+ */
+
+ *site = INST_CONTINUE;
+ for (j=0 ; j<4 ; j++) {
+ *++site = INST_NOP;
+ }
+ } else {
+ offset = rangePtr->continueOffset - auxPtr->continueTargets[i];
+ TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+ }
+ }
+
+ /*
+ * Drop the arrays we were holding the only reference to.
+ */
+
+ if (auxPtr->breakTargets) {
+ ckfree(auxPtr->breakTargets);
+ auxPtr->breakTargets = NULL;
+ auxPtr->numBreakTargets = 0;
+ }
+ if (auxPtr->continueTargets) {
+ ckfree(auxPtr->continueTargets);
+ auxPtr->continueTargets = NULL;
+ auxPtr->numContinueTargets = 0;
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* TclCreateAuxData --
@@ -2149,17 +3654,17 @@ TclCreateExceptRange(type, envPtr)
*/
int
-TclCreateAuxData(clientData, typePtr, envPtr)
- ClientData clientData; /* The compilation auxiliary data to store in
+TclCreateAuxData(
+ ClientData clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
- AuxDataType *typePtr; /* Pointer to the type to attach to this
+ const AuxDataType *typePtr, /* Pointer to the type to attach to this
* AuxData */
- register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+ register CompileEnv *envPtr)/* Points to the CompileEnv for which a new
* aux data structure is to be allocated. */
{
int index; /* Index for the new AuxData structure. */
register AuxData *auxDataPtr;
- /* Points to the new AuxData structure */
+ /* Points to the new AuxData structure */
index = envPtr->auxDataArrayNext;
if (index >= envPtr->auxDataArrayEnd) {
@@ -2172,24 +3677,27 @@ TclCreateAuxData(clientData, typePtr, envPtr)
size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
int newElems = 2*envPtr->auxDataArrayEnd;
size_t newBytes = newElems * sizeof(AuxData);
- AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
- /*
- * Copy from old AuxData array to new, free old AuxData array if
- * needed, and mark the new AuxData array as malloced.
- */
-
- memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr, currBytes);
if (envPtr->mallocedAuxDataArray) {
- ckfree((char *) envPtr->auxDataArrayPtr);
+ 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 = ckalloc(newBytes);
+
+ memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
+ envPtr->auxDataArrayPtr = newPtr;
+ envPtr->mallocedAuxDataArray = 1;
}
- envPtr->auxDataArrayPtr = newPtr;
envPtr->auxDataArrayEnd = newElems;
- envPtr->mallocedAuxDataArray = 1;
}
envPtr->auxDataArrayNext++;
- auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
+ auxDataPtr = &envPtr->auxDataArrayPtr[index];
auxDataPtr->clientData = clientData;
auxDataPtr->type = typePtr;
return index;
@@ -2213,14 +3721,14 @@ TclCreateAuxData(clientData, typePtr, envPtr)
*/
void
-TclInitJumpFixupArray(fixupArrayPtr)
- register JumpFixupArray *fixupArrayPtr;
+TclInitJumpFixupArray(
+ register JumpFixupArray *fixupArrayPtr)
/* Points to the JumpFixupArray structure to
* initialize. */
{
fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
fixupArrayPtr->next = 0;
- fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
+ fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1;
fixupArrayPtr->mallocedArray = 0;
}
@@ -2245,10 +3753,10 @@ TclInitJumpFixupArray(fixupArrayPtr)
*/
void
-TclExpandJumpFixupArray(fixupArrayPtr)
- register JumpFixupArray *fixupArrayPtr;
- /* Points to the JumpFixupArray structure
- * to enlarge. */
+TclExpandJumpFixupArray(
+ register JumpFixupArray *fixupArrayPtr)
+ /* Points to the JumpFixupArray structure to
+ * enlarge. */
{
/*
* The currently allocated jump fixup entries are stored from fixup[0] up
@@ -2259,20 +3767,22 @@ TclExpandJumpFixupArray(fixupArrayPtr)
size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
int newElems = 2*(fixupArrayPtr->end + 1);
size_t newBytes = newElems * sizeof(JumpFixup);
- JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
- /*
- * Copy from the old array to new, free the old array if needed, and mark
- * the new array as malloced.
- */
-
- memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
if (fixupArrayPtr->mallocedArray) {
- ckfree((char *) fixupArrayPtr->fixup);
+ 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 = ckalloc(newBytes);
+
+ memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
+ fixupArrayPtr->fixup = newPtr;
+ fixupArrayPtr->mallocedArray = 1;
}
- fixupArrayPtr->fixup = (JumpFixup *) newPtr;
fixupArrayPtr->end = newElems;
- fixupArrayPtr->mallocedArray = 1;
}
/*
@@ -2292,13 +3802,13 @@ TclExpandJumpFixupArray(fixupArrayPtr)
*/
void
-TclFreeJumpFixupArray(fixupArrayPtr)
- register JumpFixupArray *fixupArrayPtr;
+TclFreeJumpFixupArray(
+ register JumpFixupArray *fixupArrayPtr)
/* Points to the JumpFixupArray structure to
* free. */
{
if (fixupArrayPtr->mallocedArray) {
- ckfree((char *) fixupArrayPtr->fixup);
+ ckfree(fixupArrayPtr->fixup);
}
}
@@ -2325,12 +3835,12 @@ TclFreeJumpFixupArray(fixupArrayPtr)
*/
void
-TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
- CompileEnv *envPtr; /* Points to the CompileEnv structure that
+TclEmitForwardJump(
+ CompileEnv *envPtr, /* Points to the CompileEnv structure that
* holds the resulting instruction. */
- TclJumpType jumpType; /* Indicates the kind of jump: if true or
+ TclJumpType jumpType, /* Indicates the kind of jump: if true or
* false or unconditional. */
- JumpFixup *jumpFixupPtr; /* Points to the JumpFixup structure to
+ JumpFixup *jumpFixupPtr) /* Points to the JumpFixup structure to
* initialize with information about this
* forward jump. */
{
@@ -2343,7 +3853,7 @@ TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
*/
jumpFixupPtr->jumpType = jumpType;
- jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
+ jumpFixupPtr->codeOffset = envPtr->codeNext - envPtr->codeStart;
jumpFixupPtr->cmdIndex = envPtr->numCommands;
jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
@@ -2387,21 +3897,21 @@ TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
*/
int
-TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
- CompileEnv *envPtr; /* Points to the CompileEnv structure that
+TclFixupForwardJump(
+ CompileEnv *envPtr, /* Points to the CompileEnv structure that
* holds the resulting instruction. */
- JumpFixup *jumpFixupPtr; /* Points to the JumpFixup structure that
+ JumpFixup *jumpFixupPtr, /* Points to the JumpFixup structure that
* describes the forward jump. */
- int jumpDist; /* Jump distance to set in jump instr. */
- int distThreshold; /* Maximum distance before the two byte jump
+ int jumpDist, /* Jump distance to set in jump instr. */
+ int distThreshold) /* Maximum distance before the two byte jump
* is grown to five bytes. */
{
unsigned char *jumpPc, *p;
int firstCmd, lastCmd, firstRange, lastRange, k;
- unsigned int numBytes;
+ unsigned numBytes;
if (jumpDist <= distThreshold) {
- jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
+ jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
switch (jumpFixupPtr->jumpType) {
case TCL_UNCONDITIONAL_JUMP:
TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
@@ -2417,20 +3927,20 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
}
/*
- * We must grow the jump then move subsequent instructions down. Note
- * that if we expand the space for generated instructions, code addresses
- * might change; be careful about updating any of these addresses held in
+ * We must grow the jump then move subsequent instructions down. Note that
+ * if we expand the space for generated instructions, code addresses might
+ * change; be careful about updating any of these addresses held in
* variables.
*/
if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
TclExpandCodeArray(envPtr);
}
- jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
- for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
- numBytes > 0; numBytes--, p--) {
- p[3] = p[0];
- }
+ jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
+ numBytes = envPtr->codeNext-jumpPc-2;
+ p = jumpPc+2;
+ memmove(p+3, p, numBytes);
+
envPtr->codeNext += 3;
jumpDist += 3;
switch (jumpFixupPtr->jumpType) {
@@ -2451,19 +3961,19 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
*/
firstCmd = jumpFixupPtr->cmdIndex;
- lastCmd = (envPtr->numCommands - 1);
+ lastCmd = envPtr->numCommands - 1;
if (firstCmd < lastCmd) {
for (k = firstCmd; k <= lastCmd; k++) {
- (envPtr->cmdMapPtr[k]).codeOffset += 3;
+ envPtr->cmdMapPtr[k].codeOffset += 3;
}
}
firstRange = jumpFixupPtr->exceptIndex;
- lastRange = (envPtr->exceptArrayNext - 1);
+ lastRange = envPtr->exceptArrayNext - 1;
for (k = firstRange; k <= lastRange; k++) {
- ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
- rangePtr->codeOffset += 3;
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k];
+ rangePtr->codeOffset += 3;
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
rangePtr->breakOffset += 3;
@@ -2475,16 +3985,225 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
rangePtr->catchOffset += 3;
break;
default:
- Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
+ Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d",
rangePtr->type);
}
}
+
+ for (k = 0 ; k < envPtr->exceptArrayNext ; k++) {
+ ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k];
+ int i;
+
+ for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+ if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) {
+ auxPtr->breakTargets[i] += 3;
+ }
+ }
+ for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+ if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) {
+ auxPtr->continueTargets[i] += 3;
+ }
+ }
+ }
+
return 1; /* the jump was grown */
}
/*
*----------------------------------------------------------------------
*
+ * TclEmitInvoke --
+ *
+ * Emit one of the invoke-related instructions, wrapping it if necessary
+ * in code that ensures that any break or continue operation passing
+ * through it gets the stack unwinding correct, converting it into an
+ * internal jump if in an appropriate context.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Issues the jump with all correct stack management. May create another
+ * loop exception range; pointers to ExceptionRange and ExceptionAux
+ * structures should not be held across this call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclEmitInvoke(
+ CompileEnv *envPtr,
+ int opcode,
+ ...)
+{
+ va_list argList;
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxBreakPtr, *auxContinuePtr;
+ int arg1, arg2, wordCount = 0, expandCount = 0;
+ int loopRange = 0, breakRange = 0, continueRange = 0;
+ int cleanup, depth = TclGetStackDepth(envPtr);
+
+ /*
+ * Parse the arguments.
+ */
+
+ va_start(argList, opcode);
+ switch (opcode) {
+ case INST_INVOKE_STK1:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ break;
+ case INST_INVOKE_STK4:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ break;
+ case INST_INVOKE_REPLACE:
+ arg1 = va_arg(argList, int);
+ arg2 = va_arg(argList, int);
+ wordCount = arg1 + arg2 - 1;
+ cleanup = arg1 + 1;
+ break;
+ default:
+ Tcl_Panic("unexpected opcode");
+ case INST_EVAL_STK:
+ wordCount = cleanup = 1;
+ arg1 = arg2 = 0;
+ break;
+ case INST_RETURN_STK:
+ wordCount = cleanup = 2;
+ arg1 = arg2 = 0;
+ break;
+ case INST_INVOKE_EXPANDED:
+ wordCount = arg1 = cleanup = va_arg(argList, int);
+ arg2 = 0;
+ expandCount = 1;
+ break;
+ }
+ va_end(argList);
+
+ /*
+ * Determine if we need to handle break and continue exceptions with a
+ * special handling exception range (so that we can correctly unwind the
+ * stack).
+ *
+ * These must be done separately; they can be different (especially for
+ * calls from inside a [for] increment clause).
+ */
+
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
+ if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ auxBreakPtr = NULL;
+ } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
+ && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
+ auxBreakPtr = NULL;
+ } else {
+ breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
+ }
+
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
+ &auxContinuePtr);
+ if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ auxContinuePtr = NULL;
+ } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
+ && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
+ auxContinuePtr = NULL;
+ } else {
+ continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
+ }
+
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ ExceptionRangeStarts(envPtr, loopRange);
+ }
+
+ /*
+ * Issue the invoke itself.
+ */
+
+ switch (opcode) {
+ case INST_INVOKE_STK1:
+ TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
+ break;
+ case INST_INVOKE_STK4:
+ TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
+ break;
+ case INST_INVOKE_EXPANDED:
+ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+ envPtr->expandCount--;
+ TclAdjustStackDepth(1 - arg1, envPtr);
+ break;
+ case INST_EVAL_STK:
+ TclEmitOpcode(INST_EVAL_STK, envPtr);
+ break;
+ case INST_RETURN_STK:
+ TclEmitOpcode(INST_RETURN_STK, envPtr);
+ break;
+ case INST_INVOKE_REPLACE:
+ TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
+ TclEmitInt1(arg2, envPtr);
+ TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+ break;
+ }
+
+ /*
+ * If we're generating a special wrapper exception range, we need to
+ * finish that up now.
+ */
+
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ int savedStackDepth = envPtr->currStackDepth;
+ int savedExpandCount = envPtr->expandCount;
+ JumpFixup nonTrapFixup;
+
+ if (auxBreakPtr != NULL) {
+ auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+ }
+ if (auxContinuePtr != NULL) {
+ auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+ }
+
+ ExceptionRangeEnds(envPtr, loopRange);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
+
+ /*
+ * Careful! When generating these stack unwinding sequences, the depth
+ * of stack in the cases where they are taken is not the same as if
+ * the exception is not taken.
+ */
+
+ if (auxBreakPtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
+ TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ if (auxContinuePtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
+ TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ TclFinalizeLoopExceptionRange(envPtr, loopRange);
+ TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
+ }
+ TclCheckStackDepth(depth+1-cleanup, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGetInstructionTable --
*
* Returns a pointer to the table describing Tcl bytecode instructions.
@@ -2501,8 +4220,8 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
*----------------------------------------------------------------------
*/
-void * /* == InstructionDesc* == */
-TclGetInstructionTable()
+const void * /* == InstructionDesc* == */
+TclGetInstructionTable(void)
{
return &tclInstructionTable[0];
}
@@ -2510,7 +4229,7 @@ TclGetInstructionTable()
/*
*--------------------------------------------------------------
*
- * TclRegisterAuxDataType --
+ * RegisterAuxDataType --
*
* This procedure is called to register a new AuxData type in the table
* of all AuxData types supported by Tcl.
@@ -2526,14 +4245,14 @@ TclGetInstructionTable()
*--------------------------------------------------------------
*/
-void
-TclRegisterAuxDataType(typePtr)
- AuxDataType *typePtr; /* Information about object type; storage must
- * be statically allocated (must live
- * forever; will not be deallocated). */
+static void
+RegisterAuxDataType(
+ const AuxDataType *typePtr) /* Information about object type; storage must
+ * be statically allocated (must live forever;
+ * will not be deallocated). */
{
register Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
@@ -2545,7 +4264,7 @@ TclRegisterAuxDataType(typePtr)
*/
hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
- if (hPtr != (Tcl_HashEntry *) NULL) {
+ if (hPtr != NULL) {
Tcl_DeleteHashEntry(hPtr);
}
@@ -2553,8 +4272,8 @@ TclRegisterAuxDataType(typePtr)
* Now insert the new object type.
*/
- hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
- if (new) {
+ hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
+ if (isNew) {
Tcl_SetHashValue(hPtr, typePtr);
}
Tcl_MutexUnlock(&tableMutex);
@@ -2577,12 +4296,12 @@ TclRegisterAuxDataType(typePtr)
*----------------------------------------------------------------------
*/
-AuxDataType *
-TclGetAuxDataType(typeName)
- char *typeName; /* Name of AuxData type to look up. */
+const AuxDataType *
+TclGetAuxDataType(
+ const char *typeName) /* Name of AuxData type to look up. */
{
register Tcl_HashEntry *hPtr;
- AuxDataType *typePtr = NULL;
+ const AuxDataType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
@@ -2590,8 +4309,8 @@ TclGetAuxDataType(typeName)
}
hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
- if (hPtr != (Tcl_HashEntry *) NULL) {
- typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+ if (hPtr != NULL) {
+ typePtr = Tcl_GetHashValue(hPtr);
}
Tcl_MutexUnlock(&tableMutex);
@@ -2618,7 +4337,7 @@ TclGetAuxDataType(typeName)
*/
void
-TclInitAuxDataTypeTable()
+TclInitAuxDataTypeTable(void)
{
/*
* The table mutex must already be held before this routine is invoked.
@@ -2628,10 +4347,12 @@ TclInitAuxDataTypeTable()
Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
/*
- * There is only one AuxData type at this time, so register it here.
+ * There are only three AuxData types at this time, so register them here.
*/
- TclRegisterAuxDataType(&tclForeachInfoType);
+ RegisterAuxDataType(&tclForeachInfoType);
+ RegisterAuxDataType(&tclJumptableInfoType);
+ RegisterAuxDataType(&tclDictUpdateInfoType);
}
/*
@@ -2641,7 +4362,7 @@ TclInitAuxDataTypeTable()
*
* This procedure is called by Tcl_Finalize after all exit handlers have
* been run to free up storage associated with the table of AuxData
- * types. This procedure is called by TclFinalizeExecution() which is
+ * types. This procedure is called by TclFinalizeExecution() which is
* called by Tcl_Finalize().
*
* Results:
@@ -2654,7 +4375,7 @@ TclInitAuxDataTypeTable()
*/
void
-TclFinalizeAuxDataTypeTable()
+TclFinalizeAuxDataTypeTable(void)
{
Tcl_MutexLock(&tableMutex);
if (auxDataTypeTableInitialized) {
@@ -2682,8 +4403,8 @@ TclFinalizeAuxDataTypeTable()
*/
static int
-GetCmdLocEncodingSize(envPtr)
- CompileEnv *envPtr; /* Points to compilation environment structure
+GetCmdLocEncodingSize(
+ CompileEnv *envPtr) /* Points to compilation environment structure
* containing the CmdLocation structure to
* encode. */
{
@@ -2699,13 +4420,13 @@ GetCmdLocEncodingSize(envPtr)
codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
prevCodeOffset = prevSrcOffset = 0;
for (i = 0; i < numCmds; i++) {
- codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
+ codeDelta = mapPtr[i].codeOffset - prevCodeOffset;
if (codeDelta < 0) {
Tcl_Panic("GetCmdLocEncodingSize: bad code offset");
} else if (codeDelta <= 127) {
codeDeltaNext++;
} else {
- codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */
+ codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */
}
prevCodeOffset = mapPtr[i].codeOffset;
@@ -2715,14 +4436,14 @@ GetCmdLocEncodingSize(envPtr)
} else if (codeLen <= 127) {
codeLengthNext++;
} else {
- codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ codeLengthNext += 5;/* 1 byte for 0xFF, 4 for length */
}
- srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
- if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ srcDelta = mapPtr[i].srcOffset - prevSrcOffset;
+ if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
srcDeltaNext++;
} else {
- srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */
+ srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */
}
prevSrcOffset = mapPtr[i].srcOffset;
@@ -2732,7 +4453,7 @@ GetCmdLocEncodingSize(envPtr)
} else if (srcLen <= 127) {
srcLengthNext++;
} else {
- srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
}
}
@@ -2761,13 +4482,13 @@ GetCmdLocEncodingSize(envPtr)
*/
static unsigned char *
-EncodeCmdLocMap(envPtr, codePtr, startPtr)
- CompileEnv *envPtr; /* Points to compilation environment structure
+EncodeCmdLocMap(
+ CompileEnv *envPtr, /* Points to compilation environment structure
* containing the CmdLocation structure to
* encode. */
- ByteCode *codePtr; /* ByteCode in which to encode envPtr's
+ ByteCode *codePtr, /* ByteCode in which to encode envPtr's
* command location information. */
- unsigned char *startPtr; /* Points to the first byte in codePtr's
+ unsigned char *startPtr) /* Points to the first byte in codePtr's
* memory block where the location information
* is to be stored. */
{
@@ -2784,7 +4505,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
codePtr->codeDeltaStart = p;
prevOffset = 0;
for (i = 0; i < numCmds; i++) {
- codeDelta = (mapPtr[i].codeOffset - prevOffset);
+ codeDelta = mapPtr[i].codeOffset - prevOffset;
if (codeDelta < 0) {
Tcl_Panic("EncodeCmdLocMap: bad code offset");
} else if (codeDelta <= 127) {
@@ -2826,8 +4547,8 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
codePtr->srcDeltaStart = p;
prevOffset = 0;
for (i = 0; i < numCmds; i++) {
- srcDelta = (mapPtr[i].srcOffset - prevOffset);
- if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ srcDelta = mapPtr[i].srcOffset - prevOffset;
+ if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
TclStoreInt1AtPtr(srcDelta, p);
p++;
} else {
@@ -2881,37 +4602,161 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
*/
void
-TclPrintByteCodeObj(interp, objPtr)
- Tcl_Interp *interp; /* Used only for Tcl_GetStringFromObj. */
- Tcl_Obj *objPtr; /* The bytecode object to disassemble. */
+TclPrintByteCodeObj(
+ Tcl_Interp *interp, /* Used only for Tcl_GetStringFromObj. */
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
+{
+ Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
+
+ fprintf(stdout, "\n%s", TclGetString(bufPtr));
+ Tcl_DecrRefCount(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ * This procedure prints ("disassembles") one instruction from a bytecode
+ * object to stdout.
+ *
+ * Results:
+ * Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc) /* Points to first byte of instruction. */
+{
+ Tcl_Obj *bufferObj;
+ int numBytes;
+
+ TclNewObj(bufferObj);
+ numBytes = FormatInstruction(codePtr, pc, bufferObj);
+ fprintf(stdout, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintObject --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument Tcl object's string representation to a specified file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintObject(
+ FILE *outFile, /* The file to print the source to. */
+ Tcl_Obj *objPtr, /* Points to the Tcl object whose string
+ * representation should be printed. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ char *bytes;
+ int length;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument string to a specified file. It tries to produce legible
+ * output by adding backslashes as necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(
+ FILE *outFile, /* The file to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ Tcl_Obj *bufferObj;
+
+ TclNewObj(bufferObj);
+ PrintSourceToObj(bufferObj, stringPtr, maxChars);
+ fprintf(outFile, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDisassembleByteCodeObj --
+ *
+ * Given an object which is of bytecode type, return a disassembled
+ * version of the bytecode (in a new refcount 0 object). No guarantees
+ * are made about the details of the contents of the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDisassembleByteCodeObj(
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Tcl_Obj *bufferObj;
+ char ptrBuf1[20], ptrBuf2[20];
+ TclNewObj(bufferObj);
if (codePtr->refCount <= 0) {
- return; /* already freed */
+ return bufferObj; /* Already freed. */
}
codeStart = codePtr->codeStart;
- codeLimit = (codeStart + codePtr->numCodeBytes);
+ codeLimit = codeStart + codePtr->numCodeBytes;
numCmds = codePtr->numCommands;
/*
* Print header lines describing the ByteCode.
*/
- fprintf(stdout, "\nByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
- (unsigned int) codePtr, codePtr->refCount,
- codePtr->compileEpoch, (unsigned int) iPtr,
+ sprintf(ptrBuf1, "%p", codePtr);
+ sprintf(ptrBuf2, "%p", iPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+ ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
iPtr->compileEpoch);
- fprintf(stdout, " Source ");
- TclPrintSource(stdout, codePtr->source,
+ Tcl_AppendToObj(bufferObj, " Source ", -1);
+ PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
- fprintf(stdout, "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+ Tcl_AppendPrintfToObj(bufferObj,
+ "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
@@ -2922,14 +4767,14 @@ TclPrintByteCodeObj(interp, objPtr)
0.0);
#ifdef TCL_COMPILE_STATS
- fprintf(stdout,
- " Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
- codePtr->structureSize,
- (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+ (unsigned long) codePtr->structureSize,
+ (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
codePtr->numCodeBytes,
- (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
- (codePtr->numExceptRanges * sizeof(ExceptionRange)),
- (codePtr->numAuxDataItems * sizeof(AuxData)),
+ (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+ (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
@@ -2942,24 +4787,29 @@ TclPrintByteCodeObj(interp, objPtr)
if (codePtr->procPtr != NULL) {
Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
- fprintf(stdout,
- " Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
- (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
+
+ sprintf(ptrBuf1, "%p", procPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
+ ptrBuf1, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
+
for (i = 0; i < numCompiledLocals; i++) {
- fprintf(stdout, " slot %d%s%s%s%s%s%s", i,
- (localPtr->flags & VAR_SCALAR) ? ", scalar" : "",
+ Tcl_AppendPrintfToObj(bufferObj,
+ " slot %d%s%s%s%s%s%s", i,
+ (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
(localPtr->flags & VAR_ARRAY) ? ", array" : "",
(localPtr->flags & VAR_LINK) ? ", link" : "",
(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
if (TclIsVarTemporary(localPtr)) {
- fprintf(stdout, "\n");
+ Tcl_AppendToObj(bufferObj, "\n", -1);
} else {
- fprintf(stdout, ", \"%s\"\n", localPtr->name);
+ Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+ localPtr->name);
}
localPtr = localPtr->nextPtr;
}
@@ -2971,25 +4821,28 @@ TclPrintByteCodeObj(interp, objPtr)
*/
if (codePtr->numExceptRanges > 0) {
- fprintf(stdout, " Exception ranges %d, depth %d:\n",
+ Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < codePtr->numExceptRanges; i++) {
- ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
- fprintf(stdout, " %d: level %d, %s, pc %d-%d, ",
+ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+ Tcl_AppendPrintfToObj(bufferObj,
+ " %d: level %d, %s, pc %d-%d, ",
i, rangePtr->nestingLevel,
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
rangePtr->codeOffset,
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
- fprintf(stdout, "continue %d, break %d\n",
+ Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
rangePtr->continueOffset, rangePtr->breakOffset);
break;
case CATCH_EXCEPTION_RANGE:
- fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
+ Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+ rangePtr->catchOffset);
break;
default:
- Tcl_Panic("TclPrintByteCodeObj: bad ExceptionRange type %d\n",
+ Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
rangePtr->type);
}
}
@@ -3003,10 +4856,10 @@ TclPrintByteCodeObj(interp, objPtr)
if (numCmds == 0) {
pc = codeStart;
while (pc < codeLimit) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
}
- return;
+ return bufferObj;
}
/*
@@ -3014,14 +4867,14 @@ TclPrintByteCodeObj(interp, objPtr)
* for each command. These are encoded as a sequence of bytes.
*/
- fprintf(stdout, " Commands %d:", numCmds);
+ Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
codeDeltaNext = codePtr->codeDeltaStart;
codeLengthNext = codePtr->codeLengthStart;
srcDeltaNext = codePtr->srcDeltaStart;
srcLengthNext = codePtr->srcLengthStart;
codeOffset = srcOffset = 0;
for (i = 0; i < numCmds; i++) {
- if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
@@ -3031,7 +4884,7 @@ TclPrintByteCodeObj(interp, objPtr)
}
codeOffset += delta;
- if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
codeLengthNext++;
codeLen = TclGetInt4AtPtr(codeLengthNext);
codeLengthNext += 4;
@@ -3040,7 +4893,7 @@ TclPrintByteCodeObj(interp, objPtr)
codeLengthNext++;
}
- if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
srcDeltaNext++;
delta = TclGetInt4AtPtr(srcDeltaNext);
srcDeltaNext += 4;
@@ -3050,7 +4903,7 @@ TclPrintByteCodeObj(interp, objPtr)
}
srcOffset += delta;
- if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
srcLengthNext++;
srcLen = TclGetInt4AtPtr(srcLengthNext);
srcLengthNext += 4;
@@ -3059,13 +4912,13 @@ TclPrintByteCodeObj(interp, objPtr)
srcLengthNext++;
}
- fprintf(stdout, "%s%4d: pc %d-%d, src %d-%d",
- ((i % 2)? " " : "\n "),
+ Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+ ((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
}
if (numCmds > 0) {
- fprintf(stdout, "\n");
+ Tcl_AppendToObj(bufferObj, "\n", -1);
}
/*
@@ -3080,7 +4933,7 @@ TclPrintByteCodeObj(interp, objPtr)
codeOffset = srcOffset = 0;
pc = codeStart;
for (i = 0; i < numCmds; i++) {
- if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
@@ -3090,7 +4943,7 @@ TclPrintByteCodeObj(interp, objPtr)
}
codeOffset += delta;
- if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
srcDeltaNext++;
delta = TclGetInt4AtPtr(srcDeltaNext);
srcDeltaNext += 4;
@@ -3100,7 +4953,7 @@ TclPrintByteCodeObj(interp, objPtr)
}
srcOffset += delta;
- if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
srcLengthNext++;
srcLen = TclGetInt4AtPtr(srcLengthNext);
srcLengthNext += 4;
@@ -3114,14 +4967,14 @@ TclPrintByteCodeObj(interp, objPtr)
*/
while ((pc-codeStart) < codeOffset) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
}
- fprintf(stdout, " Command %d: ", (i+1));
- TclPrintSource(stdout, (codePtr->source + srcOffset),
+ Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
+ PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
TclMin(srcLen, 55));
- fprintf(stdout, "\n");
+ Tcl_AppendToObj(bufferObj, "\n", -1);
}
if (pc < codeLimit) {
/*
@@ -3129,50 +4982,45 @@ TclPrintByteCodeObj(interp, objPtr)
*/
while (pc < codeLimit) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
}
}
+ return bufferObj;
}
/*
*----------------------------------------------------------------------
*
- * TclPrintInstruction --
- *
- * This procedure prints ("disassembles") one instruction from a bytecode
- * object to stdout.
+ * FormatInstruction --
*
- * Results:
- * Returns the length in bytes of the current instruiction.
- *
- * Side effects:
- * None.
+ * Appends a representation of a bytecode instruction to a Tcl_Obj.
*
*----------------------------------------------------------------------
*/
-int
-TclPrintInstruction(codePtr, pc)
- ByteCode* codePtr; /* Bytecode containing the instruction. */
- unsigned char *pc; /* Points to first byte of instruction. */
+static int
+FormatInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc, /* Points to first byte of instruction. */
+ Tcl_Obj *bufferObj) /* Object to append instruction info to. */
{
Proc *procPtr = codePtr->procPtr;
unsigned char opCode = *pc;
- register InstructionDesc *instDesc = &tclInstructionTable[opCode];
+ register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
unsigned char *codeStart = codePtr->codeStart;
- unsigned int pcOffset = (pc - codeStart);
- int opnd, i, j, numBytes = 1;
+ unsigned pcOffset = pc - codeStart;
+ int opnd = 0, i, j, numBytes = 1;
int localCt = procPtr ? procPtr->numCompiledLocals : 0;
CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
-
- char suffixBuffer[64]; /* Additional info to print after main opcode
+ char suffixBuffer[128]; /* Additional info to print after main opcode
* and immediates. */
char *suffixSrc = NULL;
Tcl_Obj *suffixObj = NULL;
+ AuxData *auxPtr = NULL;
suffixBuffer[0] = '\0';
- fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
+ Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
@@ -3181,40 +5029,47 @@ TclPrintInstruction(codePtr, pc)
|| opCode == INST_JUMP_FALSE1) {
sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
}
- fprintf(stdout, "%+d ", opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_INT4:
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
|| opCode == INST_JUMP_FALSE4) {
sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ } else if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
}
- fprintf(stdout, "%+d ", opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_UINT1:
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
if (opCode == INST_PUSH1) {
suffixObj = codePtr->objArrayPtr[opnd];
}
- fprintf(stdout, "%u ", (unsigned int) opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
break;
+ case OPERAND_AUX4:
case OPERAND_UINT4:
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_PUSH4) {
suffixObj = codePtr->objArrayPtr[opnd];
- } else if (opCode == INST_START_CMD) {
- sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+ } else if (opCode == INST_START_CMD && opnd != 1) {
+ sprintf(suffixBuffer+strlen(suffixBuffer),
+ ", %u cmds start here", opnd);
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ if (instDesc->opTypes[i] == OPERAND_AUX4) {
+ auxPtr = &codePtr->auxDataArrayPtr[opnd];
}
- fprintf(stdout, "%u ", (unsigned int) opnd);
break;
case OPERAND_IDX4:
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opnd >= -1) {
- fprintf(stdout, "%d ", opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
} else if (opnd == -2) {
- fprintf(stdout, "end ");
+ Tcl_AppendPrintfToObj(bufferObj, "end ");
} else {
- fprintf(stdout, "end-%d ", -2-opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
}
break;
case OPERAND_LVT1:
@@ -3227,8 +5082,8 @@ TclPrintInstruction(codePtr, pc)
printLVTindex:
if (localPtr != NULL) {
if (opnd >= localCt) {
- Tcl_Panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
- (unsigned int) opnd, localCt);
+ Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+ (unsigned) opnd, localCt);
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
@@ -3240,7 +5095,12 @@ TclPrintInstruction(codePtr, pc)
suffixSrc = localPtr->name;
}
}
- fprintf(stdout, "%%v%u ", (unsigned) opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
+ break;
+ case OPERAND_SCLS1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%s ",
+ tclStringClassTable[opnd].name);
break;
case OPERAND_NONE:
default:
@@ -3248,111 +5108,270 @@ TclPrintInstruction(codePtr, pc)
}
}
if (suffixObj) {
- fprintf(stdout, "\t# ");
- TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
+ const char *bytes;
+ int length;
+
+ Tcl_AppendToObj(bufferObj, "\t# ", -1);
+ bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
} else if (suffixBuffer[0]) {
- fprintf(stdout, "\t# %s", suffixBuffer);
+ Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
if (suffixSrc) {
- TclPrintSource(stdout, suffixSrc, 40);
+ PrintSourceToObj(bufferObj, suffixSrc, 40);
}
}
- fprintf(stdout, "\n");
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ if (auxPtr && auxPtr->type->printProc) {
+ Tcl_AppendToObj(bufferObj, "\t\t[", -1);
+ auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
+ pcOffset);
+ Tcl_AppendToObj(bufferObj, "]\n", -1);
+ }
return numBytes;
}
/*
*----------------------------------------------------------------------
*
- * TclPrintObject --
+ * TclGetInnerContext --
*
- * This procedure prints up to a specified number of characters from the
- * argument Tcl object's string representation to a specified file.
+ * If possible, returns a list capturing the inner context. Otherwise
+ * return NULL.
*
- * Results:
- * None.
+ *----------------------------------------------------------------------
+ */
+
+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)
+#ifdef TCL_MEM_DEBUG
+ || (objPtr->refCount==0x61616161)
+#endif
+ ) {
+ Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+ objPtr);
+ }
+ Tcl_ListObjAppendElement(NULL, result, objPtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
*
- * Side effects:
- * Outputs characters to the specified file.
+ * TclNewInstNameObj --
+ *
+ * Creates a new InstName Tcl_Obj based on the given instruction
*
*----------------------------------------------------------------------
*/
-void
-TclPrintObject(outFile, objPtr, maxChars)
- FILE *outFile; /* The file to print the source to. */
- Tcl_Obj *objPtr; /* Points to the Tcl object whose string
- * representation should be printed. */
- int maxChars; /* Maximum number of chars to print. */
+Tcl_Obj *
+TclNewInstNameObj(
+ unsigned char inst)
{
- char *bytes;
- int length;
+ Tcl_Obj *objPtr = Tcl_NewObj();
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+ objPtr->typePtr = &tclInstNameType;
+ objPtr->internalRep.longValue = (long) inst;
+ objPtr->bytes = NULL;
+
+ return objPtr;
}
/*
*----------------------------------------------------------------------
*
- * TclPrintSource --
+ * UpdateStringOfInstName --
*
- * This procedure prints up to a specified number of characters from the
- * argument string to a specified file. It tries to produce legible
- * output by adding backslashes as necessary.
+ * Update the string representation for an instruction name object.
*
- * Results:
- * None.
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
*
- * Side effects:
- * Outputs characters to the specified file.
+ * PrintSourceToObj --
+ *
+ * Appends a quoted representation of a string to a Tcl_Obj.
*
*----------------------------------------------------------------------
*/
-void
-TclPrintSource(outFile, stringPtr, maxChars)
- FILE *outFile; /* The file to print the source to. */
- CONST char *stringPtr; /* The string to print. */
- int maxChars; /* Maximum number of chars to print. */
+static void
+PrintSourceToObj(
+ Tcl_Obj *appendObj, /* The object to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
{
- register CONST char *p;
- register int i = 0;
+ register const char *p;
+ register int i = 0, len;
if (stringPtr == NULL) {
- fprintf(outFile, "\"\"");
+ Tcl_AppendToObj(appendObj, "\"\"", -1);
return;
}
- fprintf(outFile, "\"");
+ Tcl_AppendToObj(appendObj, "\"", -1);
p = stringPtr;
- for (; (*p != '\0') && (i < maxChars); p++, i++) {
- switch (*p) {
+ for (; (*p != '\0') && (i < maxChars); p+=len) {
+ Tcl_UniChar ch;
+
+ len = TclUtfToUniChar(p, &ch);
+ switch (ch) {
case '"':
- fprintf(outFile, "\\\"");
+ Tcl_AppendToObj(appendObj, "\\\"", -1);
+ i += 2;
continue;
case '\f':
- fprintf(outFile, "\\f");
+ Tcl_AppendToObj(appendObj, "\\f", -1);
+ i += 2;
continue;
case '\n':
- fprintf(outFile, "\\n");
+ Tcl_AppendToObj(appendObj, "\\n", -1);
+ i += 2;
continue;
case '\r':
- fprintf(outFile, "\\r");
+ Tcl_AppendToObj(appendObj, "\\r", -1);
+ i += 2;
continue;
case '\t':
- fprintf(outFile, "\\t");
+ Tcl_AppendToObj(appendObj, "\\t", -1);
+ i += 2;
continue;
case '\v':
- fprintf(outFile, "\\v");
+ Tcl_AppendToObj(appendObj, "\\v", -1);
+ i += 2;
continue;
default:
- fprintf(outFile, "%c", *p);
+ if (ch < 0x20 || ch >= 0x7f) {
+ Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+ i += 6;
+ } else {
+ Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+ i++;
+ }
continue;
}
}
- fprintf(outFile, "\"");
+ Tcl_AppendToObj(appendObj, "\"", -1);
+ if (*p != '\0') {
+ Tcl_AppendToObj(appendObj, "...", -1);
+ }
}
-#endif /* TCL_COMPILE_DEBUG */
#ifdef TCL_COMPILE_STATS
/*
@@ -3376,12 +5395,18 @@ TclPrintSource(outFile, stringPtr, maxChars)
*/
void
-RecordByteCodeStats(codePtr)
- ByteCode *codePtr; /* Points to ByteCode structure with info
+RecordByteCodeStats(
+ ByteCode *codePtr) /* Points to ByteCode structure with info
* 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;
@@ -3390,7 +5415,7 @@ RecordByteCodeStats(codePtr)
statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
- statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
+ statsPtr->byteCodeCount[TclLog2((int) codePtr->structureSize)]++;
statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
statsPtr->currentLitBytes += (double)
@@ -3408,5 +5433,6 @@ RecordByteCodeStats(codePtr)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
* End:
*/
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index dcb122b..5665ca9 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -3,12 +3,11 @@
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
- * 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.59 2005/07/21 21:49:04 dkf Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLCOMPILATION
@@ -16,6 +15,8 @@
#include "tclInt.h"
+struct ByteCode; /* Forward declaration. */
+
/*
*------------------------------------------------------------------------
* Variables related to compilation. These are used in tclCompile.c,
@@ -71,7 +72,7 @@ MODULE_SCOPE int tclTraceExec;
*/
typedef enum {
- LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
+ LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
* and continue "exceptions" cause jumps to
* appropriate PC offsets. */
CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
@@ -99,6 +100,54 @@ typedef struct ExceptionRange {
} ExceptionRange;
/*
+ * Auxiliary data used when issuing (currently just loop) exception ranges,
+ * but which is not required during execution.
+ */
+
+typedef struct ExceptionAux {
+ int supportsContinue; /* Whether this exception range will have a
+ * continueOffset created for it; if it is a
+ * loop exception range that *doesn't* have
+ * one (see [for] next-clause) then we must
+ * not pick up the range when scanning for a
+ * target to continue to. */
+ int stackDepth; /* The stack depth at the point where the
+ * exception range was created. This is used
+ * to calculate the number of POPs required to
+ * restore the stack to its prior state. */
+ int expandTarget; /* The number of expansions expected on the
+ * auxData stack at the time the loop starts;
+ * we can't currently discard them except by
+ * doing INST_INVOKE_EXPANDED; this is a known
+ * problem. */
+ int expandTargetDepth; /* The stack depth expected at the outermost
+ * expansion within the loop. Not meaningful
+ * if there are no open expansions between the
+ * looping level and the point of jump
+ * issue. */
+ int numBreakTargets; /* The number of [break]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ int *breakTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [break]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numBreakTargets==0, this is NULL. */
+ int allocBreakTargets; /* The size of the breakTargets array. */
+ int numContinueTargets; /* The number of [continue]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [continue]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numContinueTargets==0, this is NULL. */
+ int allocContinueTargets; /* The size of the continueTargets array. */
+} ExceptionAux;
+
+/*
* Structure used to map between instruction pc and source locations. It
* defines for each compiled Tcl command its code's starting offset and its
* source's starting offset and length. Note that the code offset increases
@@ -114,6 +163,39 @@ typedef struct CmdLocation {
} CmdLocation;
/*
+ * TIP #280
+ * Structure to record additional location information for byte code. This
+ * information is internal and not saved. i.e. tbcload'ed code will not have
+ * this information. It records the lines for all words of all commands found
+ * in the byte code. The association with a ByteCode structure BC is done
+ * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
+ * Also recorded is information coming from the context, i.e. type of the
+ * frame and associated information, like the path of a sourced file.
+ */
+
+typedef struct ECL {
+ int srcOffset; /* Command location to find the entry. */
+ int nline; /* Number of words in the command */
+ int *line; /* Line information for all words in the
+ * command. */
+ int **next; /* Transient information used by the compiler
+ * for tracking of hidden continuation
+ * lines. */
+} ECL;
+
+typedef struct ExtCmdLoc {
+ int type; /* Context type. */
+ int start; /* Starting line for compiled script. Needed
+ * for the extended recompile check in
+ * tclCompileObj. */
+ Tcl_Obj *path; /* Path of the sourced file the command is
+ * in. */
+ ECL *loc; /* Command word locations (lines). */
+ int nloc; /* Number of allocated entries in 'loc'. */
+ int nuloc; /* Number of used entries in 'loc'. */
+} ExtCmdLoc;
+
+/*
* CompileProcs need the ability to record information during compilation that
* can be used by bytecode instructions during execution. The AuxData
* structure provides this "auxiliary data" mechanism. An arbitrary number of
@@ -128,8 +210,11 @@ typedef struct CmdLocation {
* the AuxData structure.
*/
-typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef ClientData (AuxDataDupProc) (ClientData clientData);
+typedef void (AuxDataFreeProc) (ClientData clientData);
+typedef void (AuxDataPrintProc)(ClientData clientData,
+ Tcl_Obj *appendObj, struct ByteCode *codePtr,
+ unsigned int pcOffset);
/*
* We define a separate AuxDataType struct to hold type-related information
@@ -139,7 +224,7 @@ typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
*/
typedef struct AuxDataType {
- char *name; /* the name of the type. Types can be
+ const char *name; /* The name of the type. Types can be
* registered and found by name */
AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux
* data is duplicated (e.g., when the ByteCode
@@ -150,6 +235,9 @@ typedef struct AuxDataType {
AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux
* data is freed. NULL means no proc need be
* called. */
+ AuxDataPrintProc *printProc;/* Callback function to invoke when printing
+ * the aux data as part of debugging. NULL
+ * means that the data can't be printed. */
} AuxDataType;
/*
@@ -159,7 +247,7 @@ typedef struct AuxDataType {
*/
typedef struct AuxData {
- AuxDataType *type; /* pointer to the AuxData type associated with
+ const AuxDataType *type; /* Pointer to the AuxData type associated with
* this ClientData. */
ClientData clientData; /* The compilation data itself. */
} AuxData;
@@ -181,14 +269,14 @@ typedef struct CompileEnv {
* compiled. Commands and their compile procs
* are specific to an interpreter so the code
* emitted will depend on the interpreter. */
- char *source; /* The source string being compiled by
+ const char *source; /* The source string being compiled by
* SetByteCodeFromAny. This pointer is not
* owned by the CompileEnv and must not be
* freed or changed by it. */
int numSrcBytes; /* Number of bytes in source. */
Proc *procPtr; /* If a procedure is being compiled, a pointer
* to its Proc structure; otherwise NULL. Used
- * to compile local variables. Set from
+ * to compile local variables. Set from
* information provided by ObjInterpProc in
* tclProc.c. */
int numCommands; /* Number of commands compiled. */
@@ -228,6 +316,11 @@ typedef struct CompileEnv {
* entry. */
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
* exceptArrayPtr points in heap, else 0. */
+ ExceptionAux *exceptAuxArrayPtr;
+ /* Array of information used to restore the
+ * state when processing BREAK/CONTINUE
+ * exceptions. Must be the same size as the
+ * exceptArrayPtr. */
CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
* numCommands is the index of the next entry
* to use; (numCommands-1) is the entry index
@@ -249,10 +342,32 @@ typedef struct CompileEnv {
/* Initial storage of LiteralEntry array. */
ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
/* Initial ExceptionRange array storage. */
+ ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+ /* Initial static except auxiliary info array
+ * storage. */
CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
/* Initial storage for cmd location map. */
AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
/* Initial storage for aux data array. */
+ /* TIP #280 */
+ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
+ * 'info frame'. */
+ int line; /* First line of the script, based on the
+ * invoking context, then the line of the
+ * command currently compiled. */
+ int atCmdStart; /* Flag to say whether an INST_START_CMD
+ * should be issued; they should never be
+ * issued repeatedly, as that is significantly
+ * inefficient. If set to 2, that instruction
+ * should not be issued at all (by the generic
+ * part of the command compiler). */
+ int expandCount; /* Number of INST_EXPAND_START instructions
+ * encountered that have not yet been paired
+ * with a corresponding
+ * INST_INVOKE_EXPANDED. */
+ int *clNext; /* If not NULL, it refers to the next slot in
+ * clLoc to check for an invisible
+ * continuation line. */
} CompileEnv;
/*
@@ -267,6 +382,7 @@ typedef struct CompileEnv {
* A PRECOMPILED bytecode struct is one that was generated from a compiled
* image rather than implicitly compiled from source
*/
+
#define TCL_BYTECODE_PRECOMPILED 0x0001
/*
@@ -276,9 +392,11 @@ typedef struct CompileEnv {
#define TCL_BYTECODE_RESOLVE_VARS 0x0002
+#define TCL_BYTECODE_RECOMPILE 0x0004
+
typedef struct ByteCode {
TclHandle interpHandle; /* Handle for interpreter containing the
- * compiled code. Commands and their compile
+ * compiled code. Commands and their compile
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
@@ -301,7 +419,7 @@ typedef struct ByteCode {
unsigned int flags; /* flags describing state for the codebyte.
* this variable holds ORed values from the
* TCL_BYTECODE_ masks defined above */
- char *source; /* The source string from which this ByteCode
+ const char *source; /* The source string from which this ByteCode
* was compiled. Note that this pointer is not
* owned by the ByteCode and must not be freed
* or modified by it. */
@@ -371,6 +489,9 @@ typedef struct ByteCode {
* code deltas. Source lengths are always
* positive. This sequence is just after the
* last byte in the source delta sequence. */
+ LocalCache *localCachePtr; /* Pointer to the start of the cached variable
+ * names and initialisation data for local
+ * variables. */
#ifdef TCL_COMPILE_STATS
Tcl_Time createTime; /* Absolute time when the ByteCode was
* created. */
@@ -391,7 +512,7 @@ typedef struct ByteCode {
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
-#define INST_CONCAT1 5
+#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
@@ -465,8 +586,8 @@ typedef struct ByteCode {
#define INST_CONTINUE 66
/* Opcodes 67 to 68 */
-#define INST_FOREACH_START4 67
-#define INST_FOREACH_STEP4 68
+#define INST_FOREACH_START4 67 /* DEPRECATED */
+#define INST_FOREACH_STEP4 68 /* DEPRECATED */
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4 69
@@ -508,7 +629,7 @@ typedef struct ByteCode {
#define INST_LIST_INDEX_MULTI 94
/*
- * TIP #33 - 'lset' command. Code gen also required a Forth-like
+ * TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
@@ -524,14 +645,14 @@ typedef struct ByteCode {
#define INST_EXPON 99
-/* TIP #157 - {expand}... language syntax support. */
+/* TIP #157 - {*}... (word expansion) language syntax support. */
#define INST_EXPAND_START 100
#define INST_EXPAND_STKTOP 101
#define INST_INVOKE_EXPANDED 102
/*
- * TIP #57 - 'lassign' command. Code generation requires immediate
+ * TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
@@ -562,8 +683,124 @@ typedef struct ByteCode {
#define INST_DICT_UPDATE_START 119
#define INST_DICT_UPDATE_END 120
+/*
+ * Instruction to support jumps defined by tables (instead of the classic
+ * [switch] technique of chained comparisons).
+ */
+
+#define INST_JUMP_TABLE 121
+
+/*
+ * Instructions to support compilation of global, variable, upvar and
+ * [namespace upvar].
+ */
+
+#define INST_UPVAR 122
+#define INST_NSUPVAR 123
+#define INST_VARIABLE 124
+
+/* Instruction to support compiling syntax error to bytecode */
+
+#define INST_SYNTAX 125
+
+/* Instruction to reverse N items on top of stack */
+
+#define INST_REVERSE 126
+
+/* regexp instruction */
+
+#define INST_REGEXP 127
+
+/* For [info exists] compilation */
+#define INST_EXIST_SCALAR 128
+#define INST_EXIST_ARRAY 129
+#define INST_EXIST_ARRAY_STK 130
+#define INST_EXIST_STK 131
+
+/* For [subst] compilation */
+#define INST_NOP 132
+#define INST_RETURN_CODE_BRANCH 133
+
+/* For [unset] compilation */
+#define INST_UNSET_SCALAR 134
+#define INST_UNSET_ARRAY 135
+#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
+
+/* For compilation relating to TclOO */
+#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
+
+#define INST_INVOKE_REPLACE 163
+
+#define INST_LIST_CONCAT 164
+
+#define INST_EXPAND_DROP 165
+
+/* New foreach implementation */
+#define INST_FOREACH_START 166
+#define INST_FOREACH_STEP 167
+#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+#define INST_STR_REPLACE 177
+
+#define INST_ORIGIN_COMMAND 178
+
+#define INST_TCLOO_NEXT 179
+#define INST_TCLOO_NEXT_CLASS 180
+
+#define INST_YIELD_TO_INVOKE 181
+
+#define INST_NUM_TYPE 182
+#define INST_TRY_CVT_TO_BOOLEAN 183
+#define INST_STR_CLASS 184
+
/* The last opcode */
-#define LAST_INST_OPCODE 120
+#define LAST_INST_OPCODE 184
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -586,25 +823,61 @@ typedef enum InstOperandType {
* integer, but displayed differently.) */
OPERAND_LVT1, /* One byte unsigned index into the local
* variable table. */
- OPERAND_LVT4 /* Four byte unsigned index into the local
+ OPERAND_LVT4, /* Four byte unsigned index into the local
* variable table. */
+ OPERAND_AUX4, /* Four byte unsigned index into the aux data
+ * table. */
+ OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
typedef struct InstructionDesc {
- char *name; /* Name of instruction. */
+ const char *name; /* Name of instruction. */
int numBytes; /* Total number of bytes for instruction. */
int stackEffect; /* The worst-case balance stack effect of the
* instruction, used for stack requirements
* computations. The value INT_MIN signals
* that the instruction's worst case effect is
- * (1-opnd1).
- */
+ * (1-opnd1). */
int numOperands; /* Number of operands. */
InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
/* The type of each operand. */
} InstructionDesc;
-MODULE_SCOPE InstructionDesc tclInstructionTable[];
+MODULE_SCOPE InstructionDesc const tclInstructionTable[];
+
+/*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+ STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
+ STR_CLASS_ALPHA, /* Unicode alphabet characters. */
+ STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
+ STR_CLASS_CONTROL, /* Unicode control characters. */
+ STR_CLASS_DIGIT, /* Unicode digit characters. */
+ STR_CLASS_GRAPH, /* Unicode printing characters, excluding
+ * space. */
+ STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
+ STR_CLASS_PRINT, /* Unicode printing characters, including
+ * spaces. */
+ STR_CLASS_PUNCT, /* Unicode punctuation characters. */
+ STR_CLASS_SPACE, /* Unicode space characters. */
+ STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
+ STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
+ * punctuation) characters. */
+ STR_CLASS_XDIGIT /* Characters that can be used as digits in
+ * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+ const char *name; /* Name of the class. */
+ int (*comparator)(int); /* Function to test if a single unicode
+ * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
/*
* Compilation of some Tcl constructs such as if commands and the logical or
@@ -694,7 +967,61 @@ typedef struct ForeachInfo {
* LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;
-MODULE_SCOPE AuxDataType tclForeachInfoType;
+MODULE_SCOPE const AuxDataType tclForeachInfoType;
+MODULE_SCOPE const AuxDataType tclNewForeachInfoType;
+
+#define FOREACHINFO(envPtr, index) \
+ ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
+/*
+ * Structure used to hold information about a switch command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct JumptableInfo {
+ Tcl_HashTable hashTable; /* Hash that maps strings to signed ints (PC
+ * offsets). */
+} JumptableInfo;
+
+MODULE_SCOPE const AuxDataType tclJumptableInfoType;
+
+#define JUMPTABLEINFO(envPtr, index) \
+ ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
+/*
+ * Structure used to hold information about a [dict update] command that is
+ * needed during program execution. These structures are stored in CompileEnv
+ * and ByteCode structures as auxiliary data.
+ */
+
+typedef struct {
+ int length; /* Size of array */
+ int varIndices[1]; /* Array of variable indices to manage when
+ * processing the start and end of a [dict
+ * update]. There is really more than one
+ * entry, and the structure is allocated to
+ * take account of this. MUST BE LAST FIELD IN
+ * STRUCTURE. */
+} DictUpdateInfo;
+
+MODULE_SCOPE const AuxDataType tclDictUpdateInfoType;
+
+#define DICTUPDATEINFO(envPtr, index) \
+ ((DictUpdateInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
+/*
+ * ClientData type used by the math operator commands.
+ */
+
+typedef struct {
+ const char *op; /* Do not call it 'operator': C++ reserved */
+ const char *expected;
+ union {
+ int numArgs;
+ int identity;
+ } i;
+} TclOpCmdClientData;
/*
*----------------------------------------------------------------
@@ -702,9 +1029,7 @@ MODULE_SCOPE AuxDataType tclForeachInfoType;
*----------------------------------------------------------------
*/
-MODULE_SCOPE int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[],
- CONST char *command, int length, int flags));
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
/*
*----------------------------------------------------------------
@@ -712,106 +1037,136 @@ MODULE_SCOPE int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp,
*----------------------------------------------------------------
*/
-/*
- * Declaration moved to the internal stubs table
- *
-MODULE_SCOPE int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
- */
+MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ const CmdFrame *invoker, int word);
/*
*----------------------------------------------------------------
- * Procedures shared among Tcl bytecode compilation and execution
- * modules but not used outside:
+ * Procedures shared among Tcl bytecode compilation and execution modules but
+ * not used outside:
*----------------------------------------------------------------
*/
-MODULE_SCOPE void TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
-MODULE_SCOPE void TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
+MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
+MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
- CompileEnv *envPtr));
-MODULE_SCOPE int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *script, int numBytes,
- CompileEnv *envPtr));
-MODULE_SCOPE void TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
+ int numBytes, CompileEnv *envPtr, int optimize);
+MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
- CompileEnv *envPtr));
-MODULE_SCOPE void TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *script, int numBytes,
- CompileEnv *envPtr));
-MODULE_SCOPE void TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
+ const char *script, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
- CompileEnv *envPtr));
-MODULE_SCOPE int TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
- AuxDataType *typePtr, CompileEnv *envPtr));
-MODULE_SCOPE int TclCreateExceptRange _ANSI_ARGS_((
- ExceptionRangeType type, CompileEnv *envPtr));
-MODULE_SCOPE ExecEnv * TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
-MODULE_SCOPE void TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
-MODULE_SCOPE void TclDeleteLiteralTable _ANSI_ARGS_((
- Tcl_Interp *interp, LiteralTable *tablePtr));
-MODULE_SCOPE void TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
- TclJumpType jumpType, JumpFixup *jumpFixupPtr));
-MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc _ANSI_ARGS_((
- unsigned char *pc, int catchOnly,
- ByteCode* codePtr));
-MODULE_SCOPE void TclExpandJumpFixupArray _ANSI_ARGS_((
- JumpFixupArray *fixupArrayPtr));
-MODULE_SCOPE void TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
-MODULE_SCOPE int TclFindCompiledLocal _ANSI_ARGS_((CONST char *name,
- int nameChars, int create, int flags,
- Proc *procPtr));
-MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr));
-MODULE_SCOPE int TclFixupForwardJump _ANSI_ARGS_((
- CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
- int jumpDist, int distThreshold));
-MODULE_SCOPE void TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr));
-MODULE_SCOPE void TclFreeJumpFixupArray _ANSI_ARGS_((
- JumpFixupArray *fixupArrayPtr));
-MODULE_SCOPE void TclInitAuxDataTypeTable _ANSI_ARGS_((void));
-MODULE_SCOPE void TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- CompileEnv *envPtr));
-MODULE_SCOPE void TclInitCompilation _ANSI_ARGS_((void));
-MODULE_SCOPE void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
- CompileEnv *envPtr, char *string, int numBytes));
-MODULE_SCOPE void TclInitJumpFixupArray _ANSI_ARGS_((
- JumpFixupArray *fixupArrayPtr));
-MODULE_SCOPE void TclInitLiteralTable _ANSI_ARGS_((
- LiteralTable *tablePtr));
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, CompileEnv *envPtr);
+MODULE_SCOPE int TclCreateAuxData(ClientData clientData,
+ const AuxDataType *typePtr, CompileEnv *envPtr);
+MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
+ CompileEnv *envPtr);
+MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
+MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes,
+ int length, unsigned int hash, int *newPtr,
+ Namespace *nsPtr, int flags,
+ LiteralEntry **globalPtrPtr);
+MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
+MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp,
+ LiteralTable *tablePtr);
+MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
+ TclJumpType jumpType, JumpFixup *jumpFixupPtr);
+MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
+MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
+ int catchOnly, ByteCode *codePtr);
+MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
+ ByteCode *codePtr);
+MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
+MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
+MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
+ int create, CompileEnv *envPtr);
+MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
+ JumpFixup *jumpFixupPtr, int jumpDist,
+ int distThreshold);
+MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
+MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void TclInitAuxDataTypeTable(void);
+MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
+ CompileEnv *envPtr, const char *string,
+ int numBytes, const CmdFrame *invoker, int word);
+MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
+MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
+ int returnCode, ExceptionAux **auxPtrPtr);
+MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
+ int range);
#ifdef TCL_COMPILE_STATS
-MODULE_SCOPE char * TclLiteralStats _ANSI_ARGS_((
- LiteralTable *tablePtr));
-MODULE_SCOPE int TclLog2 _ANSI_ARGS_((int value));
+MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
+MODULE_SCOPE int TclLog2(int value);
#endif
+MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
#endif
-MODULE_SCOPE int TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
- unsigned char *pc));
-MODULE_SCOPE void TclPrintObject _ANSI_ARGS_((FILE *outFile,
- Tcl_Obj *objPtr, int maxChars));
-MODULE_SCOPE void TclPrintSource _ANSI_ARGS_((FILE *outFile,
- CONST char *string, int maxChars));
-MODULE_SCOPE void TclRegisterAuxDataType _ANSI_ARGS_((
- AuxDataType *typePtr));
-MODULE_SCOPE int TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
- char *bytes, int length, int flags));
-MODULE_SCOPE void TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-MODULE_SCOPE void TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, Command *cmdPtr));
+MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
+ const unsigned char *pc);
+MODULE_SCOPE void TclPrintObject(FILE *outFile,
+ Tcl_Obj *objPtr, int maxChars);
+MODULE_SCOPE void TclPrintSource(FILE *outFile,
+ const char *string, int maxChars);
+MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
+ Tcl_Token *varTokenPtr, CompileEnv *envPtr,
+ int flags, int *localIndexPtr,
+ int *isScalarPtr);
+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[]);
+MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
#ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void TclVerifyGlobalLiteralTable _ANSI_ARGS_((
- Interp *iPtr));
-MODULE_SCOPE void TclVerifyLocalLiteralTable _ANSI_ARGS_((
- CompileEnv *envPtr));
+MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
+MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
-MODULE_SCOPE int TclCompileVariableCmd _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Parse *parsePtr, CompileEnv *envPtr));
-MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
- Tcl_Token *tokenPtr, Tcl_Obj *valuePtr));
+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);
+
/*
*----------------------------------------------------------------
@@ -820,31 +1175,40 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*----------------------------------------------------------------
*/
-#define LITERAL_ON_HEAP 0x01
-#define LITERAL_NS_SCOPE 0x02
+/*
+ * Simplified form to access AuxData.
+ *
+ * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
+ */
+
+#define TclFetchAuxData(envPtr, index) \
+ (envPtr)->auxDataArrayPtr[(index)].clientData
+
+#define LITERAL_ON_HEAP 0x01
+#define LITERAL_CMD_NAME 0x02
/*
- * Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
+ * cast away constness, and it is cleanest to do that here, all in one place.
*
* int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
* int length);
*/
#define TclRegisterNewLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
/*
- * Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
+ * is safe to cast away constness, and it is cleanest to do that here, all in
+ * one place.
*
* int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
* int length);
*/
-#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, \
- /*flags*/ LITERAL_NS_SCOPE)
+#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
/*
* Macro used to manually adjust the stack requirements; used in cases where
@@ -855,15 +1219,32 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclAdjustStackDepth(delta, envPtr) \
- if ((delta) < 0) {\
- if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
- (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
- }\
- }\
- (envPtr)->currStackDepth += (delta)
+ do { \
+ if ((delta) < 0) { \
+ if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \
+ (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \
+ } \
+ } \
+ (envPtr)->currStackDepth += (delta); \
+ } while (0)
+
+#define TclGetStackDepth(envPtr) \
+ ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr) \
+ (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr) \
+ do { \
+ int dd = (depth); \
+ if (dd != (envPtr)->currStackDepth) { \
+ Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+ (envPtr)->currStackDepth, dd); \
+ } \
+ } while (0)
/*
- * Macro used to update the stack requirements. It is called by the macros
+ * Macro used to update the stack requirements. It is called by the macros
* TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
* Remark that the very last instruction of a bytecode always reduces the
* stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
@@ -873,31 +1254,47 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclUpdateStackReqs(op, i, envPtr) \
- {\
- int delta = tclInstructionTable[(op)].stackEffect;\
- if (delta) {\
- if (delta == INT_MIN) {\
- delta = 1 - (i);\
- }\
- TclAdjustStackDepth(delta, envPtr);\
- }\
+ do { \
+ int delta = tclInstructionTable[(op)].stackEffect; \
+ if (delta) { \
+ if (delta == INT_MIN) { \
+ delta = 1 - (i); \
+ } \
+ TclAdjustStackDepth(delta, envPtr); \
+ } \
+ } while (0)
+
+/*
+ * Macros used to update the flag that indicates if we are at the start of a
+ * command, based on whether the opcode is INST_START_COMMAND.
+ *
+ * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
+ */
+
+#define TclUpdateAtCmdStart(op, envPtr) \
+ if ((envPtr)->atCmdStart < 2) { \
+ (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \
}
/*
- * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
+ * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
* "prototype" for this macro is:
*
* void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
*/
#define TclEmitOpcode(op, envPtr) \
- if ((envPtr)->codeNext == (envPtr)->codeEnd) \
- TclExpandCodeArray(envPtr); \
- *(envPtr)->codeNext++ = (unsigned char) (op);\
- TclUpdateStackReqs(op, 0, envPtr)
+ do { \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, 0, envPtr); \
+ } while (0)
/*
- * Macros to emit an integer operand. The ANSI C "prototype" for these macros
+ * Macros to emit an integer operand. The ANSI C "prototype" for these macros
* are:
*
* void TclEmitInt1(int i, CompileEnv *envPtr);
@@ -905,55 +1302,66 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclEmitInt1(i, envPtr) \
- if ((envPtr)->codeNext == (envPtr)->codeEnd) \
- TclExpandCodeArray(envPtr); \
- *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+ do { \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
+ } while (0)
#define TclEmitInt4(i, envPtr) \
- if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 24); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 16); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 8); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) )
+ do { \
+ if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 24); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 16); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 8); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) ); \
+ } while (0)
/*
* Macros to emit an instruction with signed or unsigned integer operands.
* Four byte integers are stored in "big-endian" order with the high order
- * byte stored at the lowest address. The ANSI C "prototypes" for these
- * macros are:
+ * byte stored at the lowest address. The ANSI C "prototypes" for these macros
+ * are:
*
* void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
* void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
*/
#define TclEmitInstInt1(op, i, envPtr) \
- if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) (op); \
- *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
- TclUpdateStackReqs(op, i, envPtr)
+ do { \
+ if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, i, envPtr); \
+ } while (0)
#define TclEmitInstInt4(op, i, envPtr) \
- if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) (op); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 24); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 16); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 8); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) );\
- TclUpdateStackReqs(op, i, envPtr)
+ do { \
+ if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 24); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 16); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 8); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) ); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, i, envPtr); \
+ } while (0)
/*
* Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
@@ -965,17 +1373,29 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclEmitPush(objIndex, envPtr) \
- {\
- register int objIndexCopy = (objIndex);\
- if (objIndexCopy <= 255) { \
+ do { \
+ register int objIndexCopy = (objIndex); \
+ if (objIndexCopy <= 255) { \
TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
- } else { \
+ } else { \
TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
- }\
- }
+ } \
+ } while (0)
/*
- * Macros to update a (signed or unsigned) integer starting at a pointer. The
+ * If the expr compiler finished with TRY_CONVERT, macro to remove it when the
+ * job is done by the following instruction.
+ */
+
+#define TclClearNumConversion(envPtr) \
+ do { \
+ if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) { \
+ envPtr->codeNext--; \
+ } \
+ } while (0)
+
+/*
+ * Macros to update a (signed or unsigned) integer starting at a pointer. The
* two variants depend on the number of bytes. The ANSI C "prototypes" for
* these macros are:
*
@@ -987,10 +1407,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*(p) = (unsigned char) ((unsigned int) (i))
#define TclStoreInt4AtPtr(i, p) \
- *(p) = (unsigned char) ((unsigned int) (i) >> 24); \
- *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
- *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \
- *(p+3) = (unsigned char) ((unsigned int) (i) )
+ do { \
+ *(p) = (unsigned char) ((unsigned int) (i) >> 24); \
+ *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+ *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \
+ *(p+3) = (unsigned char) ((unsigned int) (i) ); \
+ } while (0)
/*
* Macros to update instructions at a particular pc with a new op code and a
@@ -1002,12 +1424,16 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclUpdateInstInt1AtPc(op, i, pc) \
- *(pc) = (unsigned char) (op); \
- TclStoreInt1AtPtr((i), ((pc)+1))
+ do { \
+ *(pc) = (unsigned char) (op); \
+ TclStoreInt1AtPtr((i), ((pc)+1)); \
+ } while (0)
#define TclUpdateInstInt4AtPc(op, i, pc) \
- *(pc) = (unsigned char) (op); \
- TclStoreInt4AtPtr((i), ((pc)+1))
+ do { \
+ *(pc) = (unsigned char) (op); \
+ TclStoreInt4AtPtr((i), ((pc)+1)); \
+ } while (0)
/*
* Macro to fix up a forward jump to point to the current code-generation
@@ -1019,14 +1445,14 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*/
#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
- TclFixupForwardJump((envPtr), (fixupPtr), \
+ TclFixupForwardJump((envPtr), (fixupPtr), \
(envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
(threshold))
/*
* Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
* (GET_UINT{1,2}) from a pointer. There are two variants for each return type
- * that depend on the number of bytes fetched. The ANSI C "prototypes" for
+ * that depend on the number of bytes fetched. The ANSI C "prototypes" for
* these macros are:
*
* int TclGetInt1AtPtr(unsigned char *p);
@@ -1045,35 +1471,430 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
#ifndef __CHAR_UNSIGNED__
# define TclGetInt1AtPtr(p) ((int) *((char *) p))
+#elif defined(HAVE_SIGNED_CHAR)
+# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
-# ifdef HAVE_SIGNED_CHAR
-# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
-# else
-# define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
- | ((*(p) & 0200) ? (-256) : 0))
-# endif
+# define TclGetInt1AtPtr(p) \
+ (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
#endif
-#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
- (*((p)+1) << 16) | \
- (*((p)+2) << 8) | \
- (*((p)+3)))
+#define TclGetInt4AtPtr(p) \
+ (((int) TclGetInt1AtPtr(p) << 24) | \
+ (*((p)+1) << 16) | \
+ (*((p)+2) << 8) | \
+ (*((p)+3)))
-#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
-#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p) << 24) | \
- (*((p)+1) << 16) | \
- (*((p)+2) << 8) | \
- (*((p)+3)))
+#define TclGetUInt1AtPtr(p) \
+ ((unsigned int) *(p))
+#define TclGetUInt4AtPtr(p) \
+ ((unsigned int) (*(p) << 24) | \
+ (*((p)+1) << 16) | \
+ (*((p)+2) << 8) | \
+ (*((p)+3)))
/*
- * Macros used to compute the minimum and maximum of two integers. The ANSI C
+ * Macros used to compute the minimum and maximum of two integers. The ANSI C
* "prototypes" for these macros are:
*
* int TclMin(int i, int j);
* int TclMax(int i, int j);
*/
-#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
-#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
+#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
+
+/*
+ * Convenience macros for use when compiling bodies of commands. The ANSI C
+ * "prototype" for these macros are:
+ *
+ * static void BODY(Tcl_Token *tokenPtr, int word);
+ */
+
+#define BODY(tokenPtr, word) \
+ SetLineInformation((word)); \
+ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
+ envPtr)
+
+/*
+ * Convenience macro for use when compiling tokens to be pushed. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ * Tcl_Interp *interp);
+ */
+
+#define CompileTokens(envPtr, tokenPtr, interp) \
+ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
+ (envPtr));
+/*
+ * Convenience macros for use when pushing literals. The ANSI C "prototype" for
+ * these macros are:
+ *
+ * static void PushLiteral(CompileEnv *envPtr,
+ * const char *string, int length);
+ * static void PushStringLiteral(CompileEnv *envPtr,
+ * const char *string);
+ */
+
+#define PushLiteral(envPtr, string, length) \
+ TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+#define PushStringLiteral(envPtr, string) \
+ PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
+
+/*
+ * Macro to advance to the next token; it is more mnemonic than the address
+ * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
+ *
+ * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
+ */
+
+#define TokenAfter(tokenPtr) \
+ ((tokenPtr) + ((tokenPtr)->numComponents + 1))
+
+/*
+ * Macro to get the offset to the next instruction to be issued. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static int CurrentOffset(CompileEnv *envPtr);
+ */
+
+#define CurrentOffset(envPtr) \
+ ((envPtr)->codeNext - (envPtr)->codeStart)
+
+/*
+ * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
+ * maximal depth of nested CATCH ranges in order to alloc runtime
+ * memory. These macros should compute precisely that? OTOH, the nesting depth
+ * of LOOP ranges is an interesting datum for debugging purposes, and that is
+ * what we compute now.
+ *
+ * static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
+ * static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
+ * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
+ */
+
+#define ExceptionRangeStarts(envPtr, index) \
+ (((envPtr)->exceptDepth++), \
+ ((envPtr)->maxExceptDepth = \
+ TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
+ ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
+#define ExceptionRangeEnds(envPtr, index) \
+ (((envPtr)->exceptDepth--), \
+ ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
+ CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
+#define ExceptionRangeTarget(envPtr, index, targetType) \
+ ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+
+/*
+ * Check if there is an LVT for compiled locals
+ */
+
+#define EnvHasLVT(envPtr) \
+ (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)
+
+/*
+ * Macro that encapsulates an efficiency trick that avoids a function call for
+ * the simplest of compiles. The ANSI C "prototype" for this macro is:
+ *
+ * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ * Tcl_Interp *interp, int word);
+ */
+
+#define CompileWord(envPtr, tokenPtr, interp, word) \
+ if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
+ PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
+ } else { \
+ SetLineInformation((word)); \
+ CompileTokens((envPtr), (tokenPtr), (interp)); \
+ }
+
+/*
+ * 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)]
+
+#define PushVarNameWord(i,v,e,f,l,sc,word) \
+ SetLineInformation(word); \
+ TclPushVarName(i,v,e,f,l,sc)
+
+/*
+ * 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); \
+ }
+
+/*
+ * How to get an anonymous local variable (used for holding temporary values
+ * off the stack) or a local simple scalar.
+ */
+
+#define AnonymousLocal(envPtr) \
+ (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
+#define LocalScalar(chars,len,envPtr) \
+ (!TclIsLocalScalar((chars), (len)) ? -1 : \
+ TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr)))
+#define LocalScalarFromToken(tokenPtr,envPtr) \
+ ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
+ LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
+
+/*
+ * Flags bits used by TclPushVarName.
+ */
+
+#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
+
+/*
+ * DTrace probe macros (NOPs if DTrace support is not enabled).
+ */
+
+/*
+ * Define the following macros to enable debug logging of the DTrace proc,
+ * cmd, and inst probes. Note that this does _not_ require a platform with
+ * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log.
+ *
+ * If the second macro is defined, logging to file starts immediately,
+ * otherwise only after the first call to [tcl::dtrace]. Note that the debug
+ * probe data is always computed, even when it is not logged to file.
+ *
+ * Defining the third macro enables debug logging of inst probes (disabled
+ * by default due to the significant performance impact).
+ */
+
+/*
+#define TCL_DTRACE_DEBUG 1
+#define TCL_DTRACE_DEBUG_LOG_ENABLED 1
+#define TCL_DTRACE_DEBUG_INST_PROBES 1
+*/
+
+#if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__))
+
+#ifdef USE_DTRACE
+
+#if defined(__GNUC__) && __GNUC__ > 2
+/*
+ * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
+ */
+#define unlikely(x) (__builtin_expect((x), 0))
+#else
+#define unlikely(x) (x)
+#endif
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED())
+#define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED())
+#define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED())
+#define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED())
+#define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED())
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1)
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED())
+#define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED())
+#define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED())
+#define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED())
+#define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED())
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1)
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED())
+#define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED())
+#define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED())
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+
+#define TCL_DTRACE_DEBUG_LOG()
+
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args,
+ int *argsi);
+
+#else /* USE_DTRACE */
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() 0
+#define TCL_DTRACE_PROC_RETURN_ENABLED() 0
+#define TCL_DTRACE_PROC_RESULT_ENABLED() 0
+#define TCL_DTRACE_PROC_ARGS_ENABLED() 0
+#define TCL_DTRACE_PROC_INFO_ENABLED() 0
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}}
+#define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}}
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() 0
+#define TCL_DTRACE_CMD_RETURN_ENABLED() 0
+#define TCL_DTRACE_CMD_RESULT_ENABLED() 0
+#define TCL_DTRACE_CMD_ARGS_ENABLED() 0
+#define TCL_DTRACE_CMD_INFO_ENABLED() 0
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {}
+#define TCL_DTRACE_CMD_RETURN(a0, a1) {}
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
+
+#define TCL_DTRACE_INST_START_ENABLED() 0
+#define TCL_DTRACE_INST_DONE_ENABLED() 0
+#define TCL_DTRACE_INST_START(a0, a1, a2) {}
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) {}
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() 0
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+
+#define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;}
+
+#endif /* USE_DTRACE */
+
+#else /* TCL_DTRACE_DEBUG */
+
+#define USE_DTRACE 1
+
+#if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED)
+#undef TCL_DTRACE_DEBUG_LOG_ENABLED
+#define TCL_DTRACE_DEBUG_LOG_ENABLED 0
+#endif
+
+#if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES)
+#undef TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_DEBUG_INST_PROBES 0
+#endif
+
+MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
+MODULE_SCOPE FILE *tclDTraceDebugLog;
+MODULE_SCOPE void TclDTraceOpenDebugLog(void);
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
+
+#define TCL_DTRACE_DEBUG_LOG() \
+ int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
+ int tclDTraceDebugIndent = 0; \
+ FILE *tclDTraceDebugLog = NULL; \
+ void TclDTraceOpenDebugLog(void) { \
+ char n[35]; \
+ sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \
+ (unsigned long) getpid()); \
+ tclDTraceDebugLog = fopen(n, "a"); \
+ }
+
+#define TclDTraceDbgMsg(p, m, ...) \
+ do { \
+ if (tclDTraceDebugEnabled) { \
+ int _l, _t = 0; \
+ if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
+ fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \
+ strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, " %.*s():%n", \
+ (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, "%*s" p "%n", \
+ (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
+ "", &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, "%*s" m "\n", \
+ (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \
+ fflush(tclDTraceDebugLog); \
+ } \
+ } while (0)
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() 1
+#define TCL_DTRACE_PROC_RETURN_ENABLED() 1
+#define TCL_DTRACE_PROC_RESULT_ENABLED() 1
+#define TCL_DTRACE_PROC_ARGS_ENABLED() 1
+#define TCL_DTRACE_PROC_INFO_ENABLED() 1
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
+ tclDTraceDebugIndent++; \
+ TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1) \
+ TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
+ tclDTraceDebugIndent--
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
+ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
+ a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() 1
+#define TCL_DTRACE_CMD_RETURN_ENABLED() 1
+#define TCL_DTRACE_CMD_RESULT_ENABLED() 1
+#define TCL_DTRACE_CMD_ARGS_ENABLED() 1
+#define TCL_DTRACE_CMD_INFO_ENABLED() 1
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
+ tclDTraceDebugIndent++; \
+ TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1) \
+ TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
+ tclDTraceDebugIndent--
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
+ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
+ a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_INST_START(a0, a1, a2) \
+ TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) \
+ TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() 1
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ do { \
+ tclDTraceDebugEnabled = 1; \
+ TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9); \
+ } while (0)
+
+#endif /* TCL_DTRACE_DEBUG */
#endif /* _TCLCOMPILATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 49eb04b..2fb3e92 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -8,14 +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: tclConfig.c,v 1.9 2005/07/24 22:56:43 dkf Exp $
*/
#include "tclInt.h"
-
-
/*
* Internal structure to hold embedded configuration information.
*
@@ -27,19 +23,31 @@
* by the caller.
*/
-#define ASSOC_KEY "tclPackageAboutDict"
+#define ASSOC_KEY "tclPackageAboutDict"
+
+/*
+ * A ClientData struct for the QueryConfig command. Store the three bits
+ * of data we need; the package name for which we store a config dict,
+ * the (Tcl_Interp *) in which it is stored, and the encoding.
+ */
+
+typedef struct QCCD {
+ Tcl_Obj *pkg;
+ Tcl_Interp *interp;
+ char *encoding;
+} QCCD;
/*
* Static functions in this file:
*/
-static int QueryConfigObjCmd _ANSI_ARGS_((ClientData clientData,
+static int QueryConfigObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- struct Tcl_Obj * CONST * objv));
-static void QueryConfigDelete _ANSI_ARGS_((ClientData clientData));
-static Tcl_Obj * GetConfigDict _ANSI_ARGS_((Tcl_Interp* interp));
-static void ConfigDictDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
+ struct Tcl_Obj *const *objv);
+static void QueryConfigDelete(ClientData clientData);
+static Tcl_Obj * GetConfigDict(Tcl_Interp *interp);
+static void ConfigDictDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -58,74 +66,79 @@ static void ConfigDictDeleteProc _ANSI_ARGS_((
*/
void
-Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
- Tcl_Interp *interp; /* Interpreter the configuration command is
+Tcl_RegisterConfig(
+ Tcl_Interp *interp, /* Interpreter the configuration command is
* registered in. */
- CONST char *pkgName; /* Name of the package registering the
+ const char *pkgName, /* Name of the package registering the
* embedded configuration. ASCII, thus in
* UTF-8 too. */
- Tcl_Config *configuration; /* Embedded configuration. */
- CONST char *valEncoding; /* Name of the encoding used to store the
+ const Tcl_Config *configuration, /* Embedded configuration. */
+ const char *valEncoding) /* Name of the encoding used to store the
* configuration values, ASCII, thus UTF-8. */
{
- Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
- Tcl_Obj *pDB = GetConfigDict(interp);
- Tcl_Obj *pkg = Tcl_NewStringObj(pkgName, -1);
- Tcl_Obj *pkgDict;
+ Tcl_Obj *pDB, *pkgDict;
Tcl_DString cmdName;
- Tcl_Config *cfg;
- int res;
+ const Tcl_Config *cfg;
+ QCCD *cdPtr = ckalloc(sizeof(QCCD));
+
+ cdPtr->interp = interp;
+ if (valEncoding) {
+ cdPtr->encoding = ckalloc(strlen(valEncoding)+1);
+ strcpy(cdPtr->encoding, valEncoding);
+ } else {
+ cdPtr->encoding = NULL;
+ }
+ cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
/*
* Phase I: Adding the provided information to the internal database of
* package meta data.
*
* Phase II: Create a command for querying this database, specific to the
- * package registerting its configuration. This is the approved interface
+ * package registering its configuration. This is the approved interface
* in TIP 59. In the future a more general interface should be done, as
- * followup to TIP 59. Simply because our database is now general across
+ * follow-up to TIP 59. Simply because our database is now general across
* packages, and not a structure tied to one package.
*
* Note, the created command will have a reference through its clientdata.
*/
- Tcl_IncrRefCount(pkg);
+ Tcl_IncrRefCount(cdPtr->pkg);
+
+ /*
+ * For venc == NULL aka bogus encoding we skip the step setting up the
+ * dictionaries visible at Tcl level. I.e. they are not filled
+ */
+
+ pDB = GetConfigDict(interp);
/*
* Retrieve package specific configuration...
*/
- res = Tcl_DictObjGet(interp, pDB, pkg, &pkgDict);
- if ((TCL_OK != res) || (pkgDict == NULL)) {
- pkgDict = Tcl_NewDictObj();
+ if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
+ || (pkgDict == NULL)) {
+ pkgDict = Tcl_NewDictObj();
} else if (Tcl_IsShared(pkgDict)) {
- pkgDict = Tcl_DuplicateObj(pkgDict);
+ pkgDict = Tcl_DuplicateObj(pkgDict);
}
/*
* Extend the package configuration...
+ * We cannot assume that the encodings are initialized, therefore
+ * store the value as-is in a byte array. See Bug [9b2e636361].
*/
- for (cfg=configuration ; (cfg->key!=NULL) && (cfg->key[0]!='\0') ; cfg++) {
- Tcl_DString conv;
- CONST char *convValue =
- Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
-
- /*
- * We know that the keys are in ASCII/UTF-8, so for them is no
- * conversion required.
- */
-
+ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
- Tcl_NewStringObj(convValue, -1));
- Tcl_DStringFree(&conv);
+ Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value)));
}
/*
* Write the changes back into the overall database.
*/
- Tcl_DictObjPut(interp, pDB, pkg, pkgDict);
+ Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict);
/*
* Now create the interface command for retrieval of the package
@@ -133,7 +146,7 @@ Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
*/
Tcl_DStringInit(&cmdName);
- Tcl_DStringAppend(&cmdName, "::", -1);
+ TclDStringAppendLiteral(&cmdName, "::");
Tcl_DStringAppend(&cmdName, pkgName, -1);
/*
@@ -144,19 +157,19 @@ Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL,
TCL_GLOBAL_ONLY) == NULL) {
if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName),
- (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL) == NULL) {
- Tcl_Panic("%s.\n%s %s", Tcl_GetStringResult(interp),
- "Tcl_RegisterConfig: Unable to create namespace for",
- "package configuration.");
+ NULL, NULL) == NULL) {
+ Tcl_Panic("%s.\n%s: %s",
+ Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
+ "Unable to create namespace for package configuration.");
}
}
- Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+ TclDStringAppendLiteral(&cmdName, "::pkgconfig");
if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
- QueryConfigObjCmd, (ClientData) pkg, QueryConfigDelete) == NULL) {
- Tcl_Panic("%s %s", "Tcl_RegisterConfig: Unable to create query",
- "command for package configuration");
+ QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
+ Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
+ "Unable to create query command for package configuration");
}
Tcl_DStringFree(&cmdName);
@@ -167,8 +180,8 @@ Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
*
* QueryConfigObjCmd --
*
- * Implementation of "::<package>::pkgconfig", the command to
- * query configuration information embedded into a binary library.
+ * Implementation of "::<package>::pkgconfig", the command to query
+ * configuration information embedded into a binary library.
*
* Results:
* A standard tcl result.
@@ -180,25 +193,28 @@ Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
*/
static int
-QueryConfigObjCmd(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- struct Tcl_Obj * CONST *objv;
+QueryConfigObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ struct Tcl_Obj *const *objv)
{
- Tcl_Obj *pkgName = (Tcl_Obj *) clientData;
+ QCCD *cdPtr = clientData;
+ Tcl_Obj *pkgName = cdPtr->pkg;
Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
- int n, i, res, index;
-
- static CONST char *subcmdStrings[] = {
+ int n, index;
+ static const char *const subcmdStrings[] = {
"get", "list", NULL
};
enum subcmds {
CFG_GET, CFG_LIST
};
+ Tcl_DString conv;
+ Tcl_Encoding venc = NULL;
+ const char *value;
if ((objc < 2) || (objc > 3)) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
@@ -207,36 +223,54 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
}
pDB = GetConfigDict(interp);
- res = Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict);
- if (res!=TCL_OK || pkgDict==NULL) {
- /*
+ if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
+ || pkgDict == NULL) {
+ /*
* Maybe a Tcl_Panic is better, because the package data has to be
* present.
*/
- Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
+ Tcl_GetString(pkgName), NULL);
return TCL_ERROR;
}
switch ((enum subcmds) index) {
case CFG_GET:
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "get key");
+ Tcl_WrongNumArgs(interp, 2, objv, "key");
return TCL_ERROR;
}
- res = Tcl_DictObjGet(interp, pkgDict, objv [2], &val);
- if (res!=TCL_OK || val==NULL) {
+ if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
+ || val == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
+ Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, val);
+ if (cdPtr->encoding) {
+ venc = Tcl_GetEncoding(interp, cdPtr->encoding);
+ if (!venc) {
+ return TCL_ERROR;
+ }
+ }
+ /*
+ * Value is stored as-is in a byte array, see Bug [9b2e636361],
+ * so we have to decode it first.
+ */
+ value = (const char *) Tcl_GetByteArrayFromObj(val, &n);
+ value = Tcl_ExternalToUtfDString(venc, value, n, &conv);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value,
+ Tcl_DStringLength(&conv)));
+ Tcl_DStringFree(&conv);
return TCL_OK;
case CFG_LIST:
if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "list");
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
@@ -244,25 +278,20 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
listPtr = Tcl_NewListObj(n, NULL);
if (!listPtr) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("insufficient memory to create list",-1));
+ 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;
+ Tcl_Obj *key;
int done;
- listRepPtr->elemCount = n;
- vals = &listRepPtr->elements;
-
- for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
- !done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) {
- vals[i] = key;
- Tcl_IncrRefCount(key);
+ for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
+ !done; Tcl_DictObjNext(&s, &key, NULL, &done)) {
+ Tcl_ListObjAppendElement(NULL, listPtr, key);
}
}
@@ -294,11 +323,19 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
*/
static void
-QueryConfigDelete(clientData)
- ClientData clientData;
+QueryConfigDelete(
+ ClientData clientData)
{
- Tcl_Obj *pkgName = (Tcl_Obj *) clientData;
+ QCCD *cdPtr = clientData;
+ Tcl_Obj *pkgName = cdPtr->pkg;
+ Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
+
+ Tcl_DictObjRemove(NULL, pDB, pkgName);
Tcl_DecrRefCount(pkgName);
+ if (cdPtr->encoding) {
+ ckfree((char *)cdPtr->encoding);
+ }
+ ckfree((char *)cdPtr);
}
/*
@@ -319,12 +356,12 @@ QueryConfigDelete(clientData)
*/
static Tcl_Obj *
-GetConfigDict(interp)
- Tcl_Interp *interp;
+GetConfigDict(
+ Tcl_Interp *interp)
{
Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
- if (pDB == (Tcl_Obj *) NULL) {
+ if (pDB == NULL) {
pDB = Tcl_NewDictObj();
Tcl_IncrRefCount(pDB);
Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
@@ -340,7 +377,7 @@ GetConfigDict(interp)
*
* This function is associated with the "Package About dict" assoc data
* for an interpreter; it is invoked when the interpreter is deleted in
- * order to free the information assoicated with any pending error
+ * order to free the information associated with any pending error
* reports.
*
* Results:
@@ -353,11 +390,12 @@ GetConfigDict(interp)
*/
static void
-ConfigDictDeleteProc(clientData, interp)
- ClientData clientData; /* Pointer to Tcl_Obj. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+ConfigDictDeleteProc(
+ ClientData clientData, /* Pointer to Tcl_Obj. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
- Tcl_Obj *pDB = (Tcl_Obj *) clientData;
+ Tcl_Obj *pDB = clientData;
+
Tcl_DecrRefCount(pDB);
}
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
new file mode 100644
index 0000000..360bdff
--- /dev/null
+++ b/generic/tclDTrace.d
@@ -0,0 +1,225 @@
+/*
+ * tclDTrace.d --
+ *
+ * Tcl DTrace provider.
+ *
+ * Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+typedef struct Tcl_Obj Tcl_Obj;
+typedef const char* TclDTraceStr;
+
+/*
+ * Tcl DTrace probes
+ */
+
+provider tcl {
+ /***************************** proc probes *****************************/
+ /*
+ * tcl*:::proc-entry probe
+ * triggered immediately before proc bytecode execution
+ * arg0: proc name (string)
+ * arg1: number of arguments (int)
+ * arg2: array of proc argument objects (Tcl_Obj**)
+ */
+ probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+ /*
+ * tcl*:::proc-return probe
+ * triggered immediately after proc bytecode execution
+ * arg0: proc name (string)
+ * arg1: return code (int)
+ */
+ probe proc__return(TclDTraceStr name, int code);
+ /*
+ * tcl*:::proc-result probe
+ * triggered after proc-return probe and result processing
+ * arg0: proc name (string)
+ * arg1: return code (int)
+ * arg2: proc result (string)
+ * arg3: proc result object (Tcl_Obj*)
+ */
+ probe proc__result(TclDTraceStr name, int code, TclDTraceStr result,
+ struct Tcl_Obj *resultobj);
+ /*
+ * tcl*:::proc-args probe
+ * triggered before proc-entry probe, gives access to string
+ * representation of proc arguments
+ * arg0: proc name (string)
+ * arg1-arg9: proc arguments or NULL (strings)
+ */
+ probe proc__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
+ TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
+ TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
+ TclDTraceStr arg9);
+ /*
+ * tcl*:::proc-info probe
+ * triggered before proc-entry probe, gives access to TIP 280
+ * information for the proc invocation (i.e. [info frame 0])
+ * arg0: TIP 280 cmd (string)
+ * arg1: TIP 280 type (string)
+ * arg2: TIP 280 proc (string)
+ * arg3: TIP 280 file (string)
+ * arg4: TIP 280 line (int)
+ * arg5: TIP 280 level (int)
+ * arg6: TclOO method (string)
+ * arg7: TclOO class/object (string)
+ */
+ probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
+ TclDTraceStr file, int line, int level, TclDTraceStr method,
+ TclDTraceStr class);
+
+ /***************************** cmd probes ******************************/
+ /*
+ * tcl*:::cmd-entry probe
+ * triggered immediately before commmand execution
+ * arg0: command name (string)
+ * arg1: number of arguments (int)
+ * arg2: array of command argument objects (Tcl_Obj**)
+ */
+ probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+ /*
+ * tcl*:::cmd-return probe
+ * triggered immediately after commmand execution
+ * arg0: command name (string)
+ * arg1: return code (int)
+ */
+ probe cmd__return(TclDTraceStr name, int code);
+ /*
+ * tcl*:::cmd-result probe
+ * triggered after cmd-return probe and result processing
+ * arg0: command name (string)
+ * arg1: return code (int)
+ * arg2: command result (string)
+ * arg3: command result object (Tcl_Obj*)
+ */
+ probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result,
+ struct Tcl_Obj *resultobj);
+ /*
+ * tcl*:::cmd-args probe
+ * triggered before cmd-entry probe, gives access to string
+ * representation of command arguments
+ * arg0: command name (string)
+ * arg1-arg9: command arguments or NULL (strings)
+ */
+ probe cmd__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
+ TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
+ TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
+ TclDTraceStr arg9);
+ /*
+ * tcl*:::cmd-info probe
+ * triggered before cmd-entry probe, gives access to TIP 280
+ * information for the command invocation (i.e. [info frame 0])
+ * arg0: TIP 280 cmd (string)
+ * arg1: TIP 280 type (string)
+ * arg2: TIP 280 proc (string)
+ * arg3: TIP 280 file (string)
+ * arg4: TIP 280 line (int)
+ * arg5: TIP 280 level (int)
+ * arg6: TclOO method (string)
+ * arg7: TclOO class/object (string)
+ */
+ probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
+ TclDTraceStr file, int line, int level, TclDTraceStr method,
+ TclDTraceStr class);
+
+ /***************************** inst probes *****************************/
+ /*
+ * tcl*:::inst-start probe
+ * triggered immediately before execution of a bytecode
+ * arg0: bytecode name (string)
+ * arg1: depth of stack (int)
+ * arg2: top of stack (Tcl_Obj**)
+ */
+ probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+ /*
+ * tcl*:::inst-done probe
+ * triggered immediately after execution of a bytecode
+ * arg0: bytecode name (string)
+ * arg1: depth of stack (int)
+ * arg2: top of stack (Tcl_Obj**)
+ */
+ probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+
+ /***************************** obj probes ******************************/
+ /*
+ * tcl*:::obj-create probe
+ * triggered immediately after a new Tcl_Obj has been created
+ * arg0: object created (Tcl_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(struct Tcl_Obj* obj);
+
+ /***************************** tcl probes ******************************/
+ /*
+ * tcl*:::tcl-probe probe
+ * triggered when the ::tcl::dtrace command is called
+ * arg0-arg9: command arguments (strings)
+ */
+ probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2,
+ TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
+ TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
+ TclDTraceStr arg9);
+};
+
+/*
+ * Tcl types and constants for use in DTrace scripts
+ */
+
+typedef struct Tcl_ObjType {
+ char *name;
+ void *freeIntRepProc;
+ void *dupIntRepProc;
+ void *updateStringProc;
+ void *setFromAnyProc;
+} Tcl_ObjType;
+
+struct Tcl_Obj {
+ int refCount;
+ char *bytes;
+ int length;
+ Tcl_ObjType *typePtr;
+ union {
+ long longValue;
+ double doubleValue;
+ void *otherValuePtr;
+ int64_t wideValue;
+ struct {
+ void *ptr1;
+ void *ptr2;
+ } twoPtrValue;
+ struct {
+ void *ptr;
+ unsigned long value;
+ } ptrAndLongRep;
+ } internalRep;
+};
+
+enum return_codes {
+ TCL_OK = 0,
+ TCL_ERROR,
+ TCL_RETURN,
+ TCL_BREAK,
+ TCL_CONTINUE
+};
+
+#pragma D attributes Evolving/Evolving/Common provider tcl provider
+#pragma D attributes Private/Private/Common provider tcl module
+#pragma D attributes Private/Private/Common provider tcl function
+#pragma D attributes Evolving/Evolving/Common provider tcl name
+#pragma D attributes Evolving/Evolving/Common provider tcl args
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclDate.c b/generic/tclDate.c
index ee07443..6222a8a 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,7 +1,9 @@
-/* A Bison parser, made by GNU Bison 1.875b. */
+/* A Bison parser, made by GNU Bison 2.3. */
-/* Skeleton parser for Yacc-like parsing with Bison,
- Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+ Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -15,16 +17,24 @@
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
+ Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA. */
+
+/* As a special exception, you may create a larger work that contains
+ part or all of the Bison parser skeleton and distribute that work
+ under terms of your choice, so long as that work isn't itself a
+ parser generator using the skeleton or a modified version thereof
+ as a parser skeleton. Alternatively, if you modify or redistribute
+ the parser skeleton itself, you may (at your option) remove this
+ special exception, which will cause the skeleton and the resulting
+ Bison output files to be licensed under the GNU General Public
+ License without this special exception.
-/* As a special exception, when this file is copied by Bison into a
- Bison output file, you may use that output file without restriction.
- This special exception was added by the Free Software Foundation
- in version 1.24 of Bison. */
+ This special exception was added by the Free Software Foundation in
+ version 2.2 of Bison. */
-/* Written by Richard Stallman by simplifying the original so called
- ``semantic'' parser. */
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+ simplifying the original so-called "semantic" parser. */
/* All symbols defined below should begin with yy or YY, to avoid
infringing on user name space. This should be done even for local
@@ -36,17 +46,19 @@
/* Identify Bison output. */
#define YYBISON 1
+/* Bison version. */
+#define YYBISON_VERSION "2.3"
+
/* Skeleton name. */
#define YYSKELETON_NAME "yacc.c"
/* Pure parsers. */
-#define YYPURE 0
+#define YYPURE 1
/* Using locations. */
-#define YYLSP_NEEDED 0
+#define YYLSP_NEEDED 1
-/* If NAME_PREFIX is specified substitute the variables and functions
- names. */
+/* Substitute the variable and function names. */
#define yyparse TclDateparse
#define yylex TclDatelex
#define yyerror TclDateerror
@@ -54,7 +66,7 @@
#define yychar TclDatechar
#define yydebug TclDatedebug
#define yynerrs TclDatenerrs
-
+#define yylloc TclDatelloc
/* Tokens. */
#ifndef YYTOKENTYPE
@@ -67,39 +79,38 @@
tDAYZONE = 260,
tID = 261,
tMERIDIAN = 262,
- tMINUTE_UNIT = 263,
- tMONTH = 264,
- tMONTH_UNIT = 265,
- tSTARDATE = 266,
- tSEC_UNIT = 267,
- tSNUMBER = 268,
- tUNUMBER = 269,
- tZONE = 270,
- tEPOCH = 271,
- tDST = 272,
- tISOBASE = 273,
- tDAY_UNIT = 274,
- tNEXT = 275
+ tMONTH = 263,
+ tMONTH_UNIT = 264,
+ tSTARDATE = 265,
+ tSEC_UNIT = 266,
+ tSNUMBER = 267,
+ tUNUMBER = 268,
+ tZONE = 269,
+ tEPOCH = 270,
+ tDST = 271,
+ tISOBASE = 272,
+ tDAY_UNIT = 273,
+ tNEXT = 274
};
#endif
+/* Tokens. */
#define tAGO 258
#define tDAY 259
#define tDAYZONE 260
#define tID 261
#define tMERIDIAN 262
-#define tMINUTE_UNIT 263
-#define tMONTH 264
-#define tMONTH_UNIT 265
-#define tSTARDATE 266
-#define tSEC_UNIT 267
-#define tSNUMBER 268
-#define tUNUMBER 269
-#define tZONE 270
-#define tEPOCH 271
-#define tDST 272
-#define tISOBASE 273
-#define tDAY_UNIT 274
-#define tNEXT 275
+#define tMONTH 263
+#define tMONTH_UNIT 264
+#define tSTARDATE 265
+#define tSEC_UNIT 266
+#define tSNUMBER 267
+#define tUNUMBER 268
+#define tZONE 269
+#define tEPOCH 270
+#define tDST 271
+#define tISOBASE 272
+#define tDAY_UNIT 273
+#define tNEXT 274
@@ -107,25 +118,23 @@
/* Copy the first part of user declarations. */
-/*
+/*
* tclDate.c --
*
- * This file is generated from a yacc grammar defined in
- * the file tclGetDate.y. It should not be edited directly.
+ * This file is generated from a yacc grammar defined in the file
+ * tclGetDate.y. It should not be edited directly.
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-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.
- *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-
#include "tclInt.h"
/*
- * Bison generates several labels that happen to be unused. MS Visual
- * C++ doesn't like that, and complains. Tell it to shut up.
+ * Bison generates several labels that happen to be unused. MS Visual C++
+ * doesn't like that, and complains. Tell it to shut up.
*/
#ifdef _MSC_VER
@@ -133,124 +142,119 @@
#endif /* _MSC_VER */
/*
- * yyparse will accept a 'struct DateInfo' as its parameter;
- * that's where the parsed fields will be returned.
+ * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
+ * parsed fields will be returned.
*/
typedef struct DateInfo {
- time_t dateYear;
- time_t dateMonth;
- time_t dateDay;
- int dateHaveDate;
+ Tcl_Obj* messages; /* Error messages */
+ const char* separatrix; /* String separating messages */
- time_t dateHour;
- time_t dateMinutes;
- time_t dateSeconds;
- int dateMeridian;
- int dateHaveTime;
+ time_t dateYear;
+ time_t dateMonth;
+ time_t dateDay;
+ int dateHaveDate;
- time_t dateTimezone;
- int dateDSTmode;
- int dateHaveZone;
+ time_t dateHour;
+ time_t dateMinutes;
+ time_t dateSeconds;
+ int dateMeridian;
+ int dateHaveTime;
- time_t dateRelMonth;
- time_t dateRelDay;
- time_t dateRelSeconds;
- int dateHaveRel;
+ time_t dateTimezone;
+ int dateDSTmode;
+ int dateHaveZone;
- time_t dateMonthOrdinal;
- int dateHaveOrdinalMonth;
+ time_t dateRelMonth;
+ time_t dateRelDay;
+ time_t dateRelSeconds;
+ int dateHaveRel;
- time_t dateDayOrdinal;
- time_t dateDayNumber;
- int dateHaveDay;
+ time_t dateMonthOrdinal;
+ int dateHaveOrdinalMonth;
- char *dateInput;
- time_t *dateRelPointer;
+ time_t dateDayOrdinal;
+ time_t dateDayNumber;
+ int dateHaveDay;
- int dateDigitCount;
+ const char *dateStart;
+ const char *dateInput;
+ time_t *dateRelPointer;
+ int dateDigitCount;
} DateInfo;
-#define YYPARSE_PARAM info
-#define YYLEX_PARAM info
-
-#define yyDSTmode (((DateInfo*)info)->dateDSTmode)
-#define yyDayOrdinal (((DateInfo*)info)->dateDayOrdinal)
-#define yyDayNumber (((DateInfo*)info)->dateDayNumber)
-#define yyMonthOrdinal (((DateInfo*)info)->dateMonthOrdinal)
-#define yyHaveDate (((DateInfo*)info)->dateHaveDate)
-#define yyHaveDay (((DateInfo*)info)->dateHaveDay)
-#define yyHaveOrdinalMonth (((DateInfo*)info)->dateHaveOrdinalMonth)
-#define yyHaveRel (((DateInfo*)info)->dateHaveRel)
-#define yyHaveTime (((DateInfo*)info)->dateHaveTime)
-#define yyHaveZone (((DateInfo*)info)->dateHaveZone)
-#define yyTimezone (((DateInfo*)info)->dateTimezone)
-#define yyDay (((DateInfo*)info)->dateDay)
-#define yyMonth (((DateInfo*)info)->dateMonth)
-#define yyYear (((DateInfo*)info)->dateYear)
-#define yyHour (((DateInfo*)info)->dateHour)
-#define yyMinutes (((DateInfo*)info)->dateMinutes)
-#define yySeconds (((DateInfo*)info)->dateSeconds)
-#define yyMeridian (((DateInfo*)info)->dateMeridian)
-#define yyRelMonth (((DateInfo*)info)->dateRelMonth)
-#define yyRelDay (((DateInfo*)info)->dateRelDay)
-#define yyRelSeconds (((DateInfo*)info)->dateRelSeconds)
-#define yyRelPointer (((DateInfo*)info)->dateRelPointer)
-#define yyInput (((DateInfo*)info)->dateInput)
-#define yyDigitCount (((DateInfo*)info)->dateDigitCount)
-
-#define EPOCH 1970
-#define START_OF_TIME 1902
-#define END_OF_TIME 2037
+#define YYMALLOC ckalloc
+#define YYFREE(x) (ckfree((void*) (x)))
+
+#define yyDSTmode (info->dateDSTmode)
+#define yyDayOrdinal (info->dateDayOrdinal)
+#define yyDayNumber (info->dateDayNumber)
+#define yyMonthOrdinal (info->dateMonthOrdinal)
+#define yyHaveDate (info->dateHaveDate)
+#define yyHaveDay (info->dateHaveDay)
+#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
+#define yyHaveRel (info->dateHaveRel)
+#define yyHaveTime (info->dateHaveTime)
+#define yyHaveZone (info->dateHaveZone)
+#define yyTimezone (info->dateTimezone)
+#define yyDay (info->dateDay)
+#define yyMonth (info->dateMonth)
+#define yyYear (info->dateYear)
+#define yyHour (info->dateHour)
+#define yyMinutes (info->dateMinutes)
+#define yySeconds (info->dateSeconds)
+#define yyMeridian (info->dateMeridian)
+#define yyRelMonth (info->dateRelMonth)
+#define yyRelDay (info->dateRelDay)
+#define yyRelSeconds (info->dateRelSeconds)
+#define yyRelPointer (info->dateRelPointer)
+#define yyInput (info->dateInput)
+#define yyDigitCount (info->dateDigitCount)
+
+#define EPOCH 1970
+#define START_OF_TIME 1902
+#define END_OF_TIME 2037
/*
* The offset of tm_year of struct tm returned by localtime, gmtime, etc.
* Posix requires 1900.
*/
-#define TM_YEAR_BASE 1900
-#define HOUR(x) ((int) (60 * x))
-#define SECSPERDAY (24L * 60L * 60L)
-#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
+#define TM_YEAR_BASE 1900
+
+#define HOUR(x) ((int) (60 * x))
+#define SECSPERDAY (24L * 60L * 60L)
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
/*
- * An entry in the lexical lookup table.
+ * An entry in the lexical lookup table.
*/
+
typedef struct _TABLE {
- char *name;
- int type;
- time_t value;
+ const char *name;
+ int type;
+ time_t value;
} TABLE;
-
/*
- * Daylight-savings mode: on, off, or not yet known.
+ * Daylight-savings mode: on, off, or not yet known.
*/
+
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
/*
- * Meridian: am, pm, or 24-hour style.
+ * Meridian: am, pm, or 24-hour style.
*/
+
typedef enum _MERIDIAN {
MERam, MERpm, MER24
} MERIDIAN;
-/*
- * Prototypes of internal functions.
- */
-static void TclDateerror _ANSI_ARGS_((char *s));
-static time_t ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
- time_t Seconds, MERIDIAN Meridian));
-static int LookupWord _ANSI_ARGS_((char *buff));
-static int TclDatelex _ANSI_ARGS_((void* info));
-
-
-
/* Enabling traces. */
#ifndef YYDEBUG
@@ -265,69 +269,228 @@ static int TclDatelex _ANSI_ARGS_((void* info));
# define YYERROR_VERBOSE 0
#endif
-#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+/* Enabling the token table. */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
-typedef union YYSTYPE {
- time_t Number;
- enum _MERIDIAN Meridian;
-} YYSTYPE;
-/* Line 191 of yacc.c. */
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+{
+ time_t Number;
+ enum _MERIDIAN Meridian;
+}
+/* Line 187 of yacc.c. */
+
+ YYSTYPE;
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
#endif
+#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
+typedef struct YYLTYPE
+{
+ int first_line;
+ int first_column;
+ int last_line;
+ int last_column;
+} YYLTYPE;
+# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
+# define YYLTYPE_IS_DECLARED 1
+# define YYLTYPE_IS_TRIVIAL 1
+#endif
/* Copy the second part of user declarations. */
-/* Line 214 of yacc.c. */
+
+/*
+ * Prototypes of internal functions.
+ */
+
+static int LookupWord(YYSTYPE* yylvalPtr, char *buff);
+ static void TclDateerror(YYLTYPE* location,
+ DateInfo* info, const char *s);
+ static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
+ DateInfo* info);
+static time_t ToSeconds(time_t Hours, time_t Minutes,
+ time_t Seconds, MERIDIAN Meridian);
+MODULE_SCOPE int yyparse(DateInfo*);
+
-#if ! defined (yyoverflow) || YYERROR_VERBOSE
+/* Line 216 of yacc.c. */
-/* The parser invokes alloca or malloc; define the necessary symbols. */
-# if YYSTACK_USE_ALLOCA
-# define YYSTACK_ALLOC alloca
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+# define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+# define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
# else
-# ifndef YYSTACK_USE_ALLOCA
-# if defined (alloca) || defined (_ALLOCA_H)
-# define YYSTACK_ALLOC alloca
+# define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if YYENABLE_NLS
+# if ENABLE_NLS
+# include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+# define YY_(msgid) dgettext ("bison-runtime", msgid)
+# endif
+# endif
+# ifndef YY_
+# define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E. */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions. */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+ int i;
+#endif
+{
+ return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols. */
+
+# ifdef YYSTACK_USE_ALLOCA
+# if YYSTACK_USE_ALLOCA
+# ifdef __GNUC__
+# define YYSTACK_ALLOC __builtin_alloca
+# elif defined __BUILTIN_VA_ARG_INCR
+# include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+# elif defined _AIX
+# define YYSTACK_ALLOC __alloca
+# elif defined _MSC_VER
+# include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+# define alloca _alloca
# else
-# ifdef __GNUC__
-# define YYSTACK_ALLOC __builtin_alloca
+# define YYSTACK_ALLOC alloca
+# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+# ifndef _STDLIB_H
+# define _STDLIB_H 1
+# endif
# endif
# endif
# endif
# endif
# ifdef YYSTACK_ALLOC
- /* Pacify GCC's `empty if-body' warning. */
-# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
+ /* Pacify GCC's `empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+# ifndef YYSTACK_ALLOC_MAXIMUM
+ /* The OS might guarantee only one guard page at the bottom of the stack,
+ and a page size can be as small as 4096 bytes. So we cannot safely
+ invoke alloca (N) if N exceeds 4096. Use a slightly smaller number
+ to allow for a few compiler-allocated temporary stack slots. */
+# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+# endif
# else
-# if defined (__STDC__) || defined (__cplusplus)
+# define YYSTACK_ALLOC YYMALLOC
+# define YYSTACK_FREE YYFREE
+# ifndef YYSTACK_ALLOC_MAXIMUM
+# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+# endif
+# if (defined __cplusplus && ! defined _STDLIB_H \
+ && ! ((defined YYMALLOC || defined malloc) \
+ && (defined YYFREE || defined free)))
# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-# define YYSIZE_T size_t
+# ifndef _STDLIB_H
+# define _STDLIB_H 1
+# endif
+# endif
+# ifndef YYMALLOC
+# define YYMALLOC malloc
+# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+# endif
+# endif
+# ifndef YYFREE
+# define YYFREE free
+# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+# endif
# endif
-# define YYSTACK_ALLOC malloc
-# define YYSTACK_FREE free
# endif
-#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
-#if (! defined (yyoverflow) \
- && (! defined (__cplusplus) \
- || (YYSTYPE_IS_TRIVIAL)))
+#if (! defined yyoverflow \
+ && (! defined __cplusplus \
+ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
+ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
/* A type that is properly aligned for any stack member. */
union yyalloc
{
- short yyss;
+ yytype_int16 yyss;
YYSTYPE yyvs;
- };
+ YYLTYPE yyls;
+};
/* The size of the maximum gap between one aligned stack and the next. */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
@@ -335,24 +498,24 @@ union yyalloc
/* The size of an array large to enough to hold all stacks, each with
N elements. */
# define YYSTACK_BYTES(N) \
- ((N) * (sizeof (short) + sizeof (YYSTYPE)) \
- + YYSTACK_GAP_MAXIMUM)
+ ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
+ + 2 * YYSTACK_GAP_MAXIMUM)
/* Copy COUNT objects from FROM to TO. The source and destination do
not overlap. */
# ifndef YYCOPY
-# if 1 < __GNUC__
+# if defined __GNUC__ && 1 < __GNUC__
# define YYCOPY(To, From, Count) \
__builtin_memcpy (To, From, (Count) * sizeof (*(From)))
# else
# define YYCOPY(To, From, Count) \
do \
{ \
- register YYSIZE_T yyi; \
+ YYSIZE_T yyi; \
for (yyi = 0; yyi < (Count); yyi++) \
(To)[yyi] = (From)[yyi]; \
} \
- while (0)
+ while (YYID (0))
# endif
# endif
@@ -370,46 +533,40 @@ union yyalloc
yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
yyptr += yynewbytes / sizeof (*yyptr); \
} \
- while (0)
+ while (YYID (0))
#endif
-#if defined (__STDC__) || defined (__cplusplus)
- typedef signed char yysigned_char;
-#else
- typedef short yysigned_char;
-#endif
-
-/* YYFINAL -- State number of the termination state. */
+/* YYFINAL -- State number of the termination state. */
#define YYFINAL 2
/* YYLAST -- Last index in YYTABLE. */
#define YYLAST 79
-/* YYNTOKENS -- Number of terminals. */
-#define YYNTOKENS 27
-/* YYNNTS -- Number of nonterminals. */
+/* YYNTOKENS -- Number of terminals. */
+#define YYNTOKENS 26
+/* YYNNTS -- Number of nonterminals. */
#define YYNNTS 16
-/* YYNRULES -- Number of rules. */
+/* YYNRULES -- Number of rules. */
#define YYNRULES 56
-/* YYNRULES -- Number of states. */
+/* YYNRULES -- Number of states. */
#define YYNSTATES 83
/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
#define YYUNDEFTOK 2
-#define YYMAXUTOK 275
+#define YYMAXUTOK 274
-#define YYTRANSLATE(YYX) \
+#define YYTRANSLATE(YYX) \
((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
-static const unsigned char yytranslate[] =
+static const yytype_uint8 yytranslate[] =
{
0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 26, 23, 22, 25, 24, 2, 2,
- 2, 2, 2, 2, 2, 2, 2, 2, 21, 2,
+ 2, 2, 2, 25, 22, 21, 24, 23, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 20, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
@@ -431,13 +588,13 @@ static const unsigned char yytranslate[] =
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
- 15, 16, 17, 18, 19, 20
+ 15, 16, 17, 18, 19
};
#if YYDEBUG
/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
YYRHS. */
-static const unsigned char yyprhs[] =
+static const yytype_uint8 yyprhs[] =
{
0, 0, 3, 4, 7, 9, 11, 13, 15, 17,
19, 21, 23, 25, 28, 33, 39, 46, 54, 57,
@@ -447,80 +604,80 @@ static const unsigned char yyprhs[] =
167, 169, 171, 173, 175, 177, 178
};
-/* YYRHS -- A `-1'-separated list of the rules' RHS. */
-static const yysigned_char yyrhs[] =
+/* YYRHS -- A `-1'-separated list of the rules' RHS. */
+static const yytype_int8 yyrhs[] =
{
- 28, 0, -1, -1, 28, 29, -1, 30, -1, 31,
- -1, 33, -1, 34, -1, 32, -1, 37, -1, 35,
- -1, 36, -1, 41, -1, 14, 7, -1, 14, 21,
- 14, 42, -1, 14, 21, 14, 22, 14, -1, 14,
- 21, 14, 21, 14, 42, -1, 14, 21, 14, 21,
- 14, 22, 14, -1, 15, 17, -1, 15, -1, 5,
- -1, 4, -1, 4, 23, -1, 14, 4, -1, 39,
- 14, 4, -1, 20, 4, -1, 14, 24, 14, -1,
- 14, 24, 14, 24, 14, -1, 18, -1, 14, 22,
- 9, 22, 14, -1, 14, 22, 14, 22, 14, -1,
- 9, 14, -1, 9, 14, 23, 14, -1, 14, 9,
- -1, 16, -1, 14, 9, 14, -1, 20, 9, -1,
- 20, 14, 9, -1, 18, 15, 18, -1, 18, 15,
- 14, 21, 14, 21, 14, -1, 18, 18, -1, 11,
- 14, 25, 14, -1, 38, 3, -1, 38, -1, 39,
- 14, 40, -1, 14, 40, -1, 20, 40, -1, 20,
- 14, 40, -1, 40, -1, 22, -1, 26, -1, 12,
- -1, 19, -1, 10, -1, 14, -1, -1, 7, -1
+ 27, 0, -1, -1, 27, 28, -1, 29, -1, 30,
+ -1, 32, -1, 33, -1, 31, -1, 36, -1, 34,
+ -1, 35, -1, 40, -1, 13, 7, -1, 13, 20,
+ 13, 41, -1, 13, 20, 13, 21, 13, -1, 13,
+ 20, 13, 20, 13, 41, -1, 13, 20, 13, 20,
+ 13, 21, 13, -1, 14, 16, -1, 14, -1, 5,
+ -1, 4, -1, 4, 22, -1, 13, 4, -1, 38,
+ 13, 4, -1, 19, 4, -1, 13, 23, 13, -1,
+ 13, 23, 13, 23, 13, -1, 17, -1, 13, 21,
+ 8, 21, 13, -1, 13, 21, 13, 21, 13, -1,
+ 8, 13, -1, 8, 13, 22, 13, -1, 13, 8,
+ -1, 15, -1, 13, 8, 13, -1, 19, 8, -1,
+ 19, 13, 8, -1, 17, 14, 17, -1, 17, 14,
+ 13, 20, 13, 20, 13, -1, 17, 17, -1, 10,
+ 13, 24, 13, -1, 37, 3, -1, 37, -1, 38,
+ 13, 39, -1, 13, 39, -1, 19, 39, -1, 19,
+ 13, 39, -1, 39, -1, 21, -1, 25, -1, 11,
+ -1, 18, -1, 9, -1, 13, -1, -1, 7, -1
};
/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
-static const unsigned short yyrline[] =
+static const yytype_uint16 yyrline[] =
{
- 0, 179, 179, 180, 183, 186, 189, 192, 195, 198,
- 201, 205, 210, 213, 219, 225, 233, 239, 250, 254,
- 258, 264, 268, 272, 276, 280, 286, 290, 295, 300,
- 305, 310, 314, 319, 323, 328, 335, 339, 345, 354,
- 363, 373, 386, 391, 393, 394, 395, 396, 397, 399,
- 400, 402, 403, 404, 407, 426, 429
+ 0, 225, 225, 226, 229, 232, 235, 238, 241, 244,
+ 247, 251, 256, 259, 265, 271, 279, 285, 296, 300,
+ 304, 310, 314, 318, 322, 326, 332, 336, 341, 346,
+ 351, 356, 360, 365, 369, 374, 381, 385, 391, 400,
+ 409, 419, 433, 438, 441, 444, 447, 450, 453, 458,
+ 461, 466, 470, 474, 480, 498, 501
};
#endif
-#if YYDEBUG || YYERROR_VERBOSE
-/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
- First, the terminals, then, starting at YYNTOKENS, nonterminals. */
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */
static const char *const yytname[] =
{
- "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
- "tMERIDIAN", "tMINUTE_UNIT", "tMONTH", "tMONTH_UNIT", "tSTARDATE",
- "tSEC_UNIT", "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST",
- "tISOBASE", "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'",
- "'+'", "$accept", "spec", "item", "time", "zone", "day", "date",
- "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit",
- "number", "o_merid", 0
+ "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
+ "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
+ "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
+ "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
+ "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
+ "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
+ "o_merid", 0
};
#endif
# ifdef YYPRINT
/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
token YYLEX-NUM. */
-static const unsigned short yytoknum[] =
+static const yytype_uint16 yytoknum[] =
{
0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
- 275, 58, 45, 44, 47, 46, 43
+ 58, 45, 44, 47, 46, 43
};
# endif
/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
-static const unsigned char yyr1[] =
+static const yytype_uint8 yyr1[] =
{
- 0, 27, 28, 28, 29, 29, 29, 29, 29, 29,
- 29, 29, 29, 30, 30, 30, 30, 30, 31, 31,
- 31, 32, 32, 32, 32, 32, 33, 33, 33, 33,
- 33, 33, 33, 33, 33, 33, 34, 34, 35, 35,
- 35, 36, 37, 37, 38, 38, 38, 38, 38, 39,
- 39, 40, 40, 40, 41, 42, 42
+ 0, 26, 27, 27, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 29, 29, 29, 29, 29, 30, 30,
+ 30, 31, 31, 31, 31, 31, 32, 32, 32, 32,
+ 32, 32, 32, 32, 32, 32, 33, 33, 34, 34,
+ 34, 35, 36, 36, 37, 37, 37, 37, 37, 38,
+ 38, 39, 39, 39, 40, 41, 41
};
/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
-static const unsigned char yyr2[] =
+static const yytype_uint8 yyr2[] =
{
0, 2, 0, 2, 1, 1, 1, 1, 1, 1,
1, 1, 1, 2, 4, 5, 6, 7, 2, 1,
@@ -533,7 +690,7 @@ static const unsigned char yyr2[] =
/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
STATE-NUM when YYTABLE doesn't specify something else to do. Zero
means the default is an error. */
-static const unsigned char yydefact[] =
+static const yytype_uint8 yydefact[] =
{
2, 0, 1, 21, 20, 0, 53, 0, 51, 54,
19, 34, 28, 52, 0, 49, 50, 3, 4, 5,
@@ -546,8 +703,8 @@ static const unsigned char yydefact[] =
0, 17, 39
};
-/* YYDEFGOTO[NTERM-NUM]. */
-static const yysigned_char yydefgoto[] =
+/* YYDEFGOTO[NTERM-NUM]. */
+static const yytype_int8 yydefgoto[] =
{
-1, 1, 17, 18, 19, 20, 21, 22, 23, 24,
25, 26, 27, 28, 29, 67
@@ -555,25 +712,25 @@ static const yysigned_char yydefgoto[] =
/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
STATE-NUM. */
-#define YYPACT_NINF -23
-static const yysigned_char yypact[] =
+#define YYPACT_NINF -22
+static const yytype_int8 yypact[] =
{
- -23, 2, -23, -22, -23, -5, -23, -4, -23, 22,
- -2, -23, 12, -23, 38, -23, -23, -23, -23, -23,
- -23, -23, -23, -23, -23, -23, 30, 11, -23, -23,
- -23, 17, 10, -23, -23, 35, 40, -6, 47, -23,
- -23, 45, -23, -23, -23, 46, -23, -23, 41, 48,
- 50, -23, 16, 44, 49, 43, 51, -23, -23, -23,
- -23, -23, -23, -23, -23, 54, 55, -23, 56, 59,
- 60, 61, -3, -23, -23, -23, -23, 57, 62, -23,
- 63, -23, -23
+ -22, 2, -22, -21, -22, -4, -22, 1, -22, 22,
+ 18, -22, 8, -22, 40, -22, -22, -22, -22, -22,
+ -22, -22, -22, -22, -22, -22, 32, 28, -22, -22,
+ -22, 24, 26, -22, -22, 42, 47, -5, 49, -22,
+ -22, 15, -22, -22, -22, 48, -22, -22, 43, 50,
+ 51, -22, 17, 44, 46, 45, 52, -22, -22, -22,
+ -22, -22, -22, -22, -22, 56, 57, -22, 58, 60,
+ 61, 62, -3, -22, -22, -22, -22, 59, 63, -22,
+ 64, -22, -22
};
/* YYPGOTO[NTERM-NUM]. */
-static const yysigned_char yypgoto[] =
+static const yytype_int8 yypgoto[] =
{
- -23, -23, -23, -23, -23, -23, -23, -23, -23, -23,
- -23, -23, -23, -9, -23, 7
+ -22, -22, -22, -22, -22, -22, -22, -22, -22, -22,
+ -22, -22, -22, -9, -22, 6
};
/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
@@ -581,61 +738,45 @@ static const yysigned_char yypgoto[] =
number is the opposite. If zero, do what YYDEFACT says.
If YYTABLE_NINF, syntax error. */
#define YYTABLE_NINF -1
-static const unsigned char yytable[] =
+static const yytype_uint8 yytable[] =
{
39, 30, 2, 53, 64, 46, 3, 4, 54, 31,
- 32, 5, 6, 7, 8, 40, 9, 10, 11, 78,
- 12, 13, 14, 64, 15, 48, 33, 41, 16, 34,
- 42, 35, 6, 47, 8, 50, 59, 65, 66, 61,
- 49, 13, 43, 36, 37, 60, 38, 44, 6, 51,
- 8, 6, 45, 8, 52, 58, 6, 13, 8, 56,
- 13, 55, 62, 57, 63, 13, 68, 70, 72, 73,
- 74, 69, 71, 75, 76, 77, 81, 82, 80, 79
+ 5, 6, 7, 8, 32, 9, 10, 11, 78, 12,
+ 13, 14, 41, 15, 64, 42, 33, 16, 56, 34,
+ 35, 6, 57, 8, 40, 47, 59, 65, 66, 61,
+ 13, 48, 36, 37, 43, 38, 49, 60, 44, 6,
+ 50, 8, 6, 45, 8, 51, 58, 6, 13, 8,
+ 52, 13, 55, 62, 63, 68, 13, 69, 70, 72,
+ 73, 74, 71, 75, 76, 77, 81, 82, 79, 80
};
-static const unsigned char yycheck[] =
+static const yytype_uint8 yycheck[] =
{
- 9, 23, 0, 9, 7, 14, 4, 5, 14, 14,
- 14, 9, 10, 11, 12, 17, 14, 15, 16, 22,
- 18, 19, 20, 7, 22, 14, 4, 15, 26, 7,
- 18, 9, 10, 3, 12, 25, 45, 21, 22, 48,
- 23, 19, 4, 21, 22, 4, 24, 9, 10, 14,
- 12, 10, 14, 12, 14, 9, 10, 19, 12, 14,
- 19, 14, 14, 18, 14, 19, 22, 24, 14, 14,
- 14, 22, 21, 14, 14, 14, 14, 14, 21, 72
+ 9, 22, 0, 8, 7, 14, 4, 5, 13, 13,
+ 8, 9, 10, 11, 13, 13, 14, 15, 21, 17,
+ 18, 19, 14, 21, 7, 17, 4, 25, 13, 7,
+ 8, 9, 17, 11, 16, 3, 45, 20, 21, 48,
+ 18, 13, 20, 21, 4, 23, 22, 4, 8, 9,
+ 24, 11, 9, 13, 11, 13, 8, 9, 18, 11,
+ 13, 18, 13, 13, 13, 21, 18, 21, 23, 13,
+ 13, 13, 20, 13, 13, 13, 13, 13, 72, 20
};
/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
symbol of state STATE-NUM. */
-static const unsigned char yystos[] =
+static const yytype_uint8 yystos[] =
{
- 0, 28, 0, 4, 5, 9, 10, 11, 12, 14,
- 15, 16, 18, 19, 20, 22, 26, 29, 30, 31,
- 32, 33, 34, 35, 36, 37, 38, 39, 40, 41,
- 23, 14, 14, 4, 7, 9, 21, 22, 24, 40,
- 17, 15, 18, 4, 9, 14, 40, 3, 14, 23,
- 25, 14, 14, 9, 14, 14, 14, 18, 9, 40,
- 4, 40, 14, 14, 7, 21, 22, 42, 22, 22,
- 24, 21, 14, 14, 14, 14, 14, 14, 22, 42,
- 21, 14, 14
+ 0, 27, 0, 4, 5, 8, 9, 10, 11, 13,
+ 14, 15, 17, 18, 19, 21, 25, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
+ 22, 13, 13, 4, 7, 8, 20, 21, 23, 39,
+ 16, 14, 17, 4, 8, 13, 39, 3, 13, 22,
+ 24, 13, 13, 8, 13, 13, 13, 17, 8, 39,
+ 4, 39, 13, 13, 7, 20, 21, 41, 21, 21,
+ 23, 20, 13, 13, 13, 13, 13, 13, 21, 41,
+ 20, 13, 13
};
-#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__)
-# define YYSIZE_T __SIZE_TYPE__
-#endif
-#if ! defined (YYSIZE_T) && defined (size_t)
-# define YYSIZE_T size_t
-#endif
-#if ! defined (YYSIZE_T)
-# if defined (__STDC__) || defined (__cplusplus)
-# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
-# define YYSIZE_T size_t
-# endif
-#endif
-#if ! defined (YYSIZE_T)
-# define YYSIZE_T unsigned int
-#endif
-
#define yyerrok (yyerrstatus = 0)
#define yyclearin (yychar = YYEMPTY)
#define YYEMPTY (-2)
@@ -643,7 +784,7 @@ static const unsigned char yystos[] =
#define YYACCEPT goto yyacceptlab
#define YYABORT goto yyabortlab
-#define YYERROR goto yyerrlab1
+#define YYERROR goto yyerrorlab
/* Like YYERROR except do call yyerror. This remains here temporarily
@@ -661,36 +802,69 @@ do \
yychar = (Token); \
yylval = (Value); \
yytoken = YYTRANSLATE (yychar); \
- YYPOPSTACK; \
+ YYPOPSTACK (1); \
goto yybackup; \
} \
else \
- { \
- yyerror ("syntax error: cannot back up");\
+ { \
+ yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
YYERROR; \
} \
-while (0)
+while (YYID (0))
+
#define YYTERROR 1
#define YYERRCODE 256
-/* YYLLOC_DEFAULT -- Compute the default location (before the actions
- are run). */
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+ If N is 0, then set CURRENT to the empty location which ends
+ the previous symbol: RHS[0] (always defined). */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N) \
- Current.first_line = Rhs[1].first_line; \
- Current.first_column = Rhs[1].first_column; \
- Current.last_line = Rhs[N].last_line; \
- Current.last_column = Rhs[N].last_column;
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ do \
+ if (YYID (N)) \
+ { \
+ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
+ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
+ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
+ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
+ } \
+ else \
+ { \
+ (Current).first_line = (Current).last_line = \
+ YYRHSLOC (Rhs, 0).last_line; \
+ (Current).first_column = (Current).last_column = \
+ YYRHSLOC (Rhs, 0).last_column; \
+ } \
+ while (YYID (0))
#endif
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+ This macro was not mandated originally: define only if we know
+ we won't break user code: when these are the locations we know. */
+
+#ifndef YY_LOCATION_PRINT
+# if YYLTYPE_IS_TRIVIAL
+# define YY_LOCATION_PRINT(File, Loc) \
+ fprintf (File, "%d.%d-%d.%d", \
+ (Loc).first_line, (Loc).first_column, \
+ (Loc).last_line, (Loc).last_column)
+# else
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
/* YYLEX -- calling `yylex' with the right arguments. */
#ifdef YYLEX_PARAM
-# define YYLEX yylex (YYLEX_PARAM)
+# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
#else
-# define YYLEX yylex ()
+# define YYLEX yylex (&yylval, &yylloc, info)
#endif
/* Enable debugging if requested. */
@@ -705,42 +879,104 @@ while (0)
do { \
if (yydebug) \
YYFPRINTF Args; \
-} while (0)
+} while (YYID (0))
-# define YYDSYMPRINT(Args) \
-do { \
- if (yydebug) \
- yysymprint Args; \
-} while (0)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yy_symbol_print (stderr, \
+ Type, Value, Location, info); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE const * const yyvaluep;
+ YYLTYPE const * const yylocationp;
+ DateInfo* info;
+#endif
+{
+ if (!yyvaluep)
+ return;
+ YYUSE (yylocationp);
+ YYUSE (info);
+# ifdef YYPRINT
+ if (yytype < YYNTOKENS)
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+ YYUSE (yyoutput);
+# endif
+ switch (yytype)
+ {
+ default:
+ break;
+ }
+}
-# define YYDSYMPRINTF(Title, Token, Value, Location) \
-do { \
- if (yydebug) \
- { \
- YYFPRINTF (stderr, "%s ", Title); \
- yysymprint (stderr, \
- Token, Value); \
- YYFPRINTF (stderr, "\n"); \
- } \
-} while (0)
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE const * const yyvaluep;
+ YYLTYPE const * const yylocationp;
+ DateInfo* info;
+#endif
+{
+ if (yytype < YYNTOKENS)
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+ else
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+ YY_LOCATION_PRINT (yyoutput, *yylocationp);
+ YYFPRINTF (yyoutput, ": ");
+ yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
+ YYFPRINTF (yyoutput, ")");
+}
/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
-| TOP (cinluded). |
+| TOP (included). |
`------------------------------------------------------------------*/
-#if defined (__STDC__) || defined (__cplusplus)
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
static void
-yy_stack_print (short *bottom, short *top)
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
#else
static void
yy_stack_print (bottom, top)
- short *bottom;
- short *top;
+ yytype_int16 *bottom;
+ yytype_int16 *top;
#endif
{
YYFPRINTF (stderr, "Stack now");
- for (/* Nothing. */; bottom <= top; ++bottom)
+ for (; bottom <= top; ++bottom)
YYFPRINTF (stderr, " %d", *bottom);
YYFPRINTF (stderr, "\n");
}
@@ -749,45 +985,54 @@ yy_stack_print (bottom, top)
do { \
if (yydebug) \
yy_stack_print ((Bottom), (Top)); \
-} while (0)
+} while (YYID (0))
/*------------------------------------------------.
| Report that the YYRULE is going to be reduced. |
`------------------------------------------------*/
-#if defined (__STDC__) || defined (__cplusplus)
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
static void
-yy_reduce_print (int yyrule)
+yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
#else
static void
-yy_reduce_print (yyrule)
+yy_reduce_print (yyvsp, yylsp, yyrule, info)
+ YYSTYPE *yyvsp;
+ YYLTYPE *yylsp;
int yyrule;
+ DateInfo* info;
#endif
{
+ int yynrhs = yyr2[yyrule];
int yyi;
- unsigned int yylno = yyrline[yyrule];
- YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ",
- yyrule - 1, yylno);
- /* Print the symbols being reduced, and their result. */
- for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
- YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]);
- YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]);
+ unsigned long int yylno = yyrline[yyrule];
+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+ yyrule - 1, yylno);
+ /* The symbols being reduced. */
+ for (yyi = 0; yyi < yynrhs; yyi++)
+ {
+ fprintf (stderr, " $%d = ", yyi + 1);
+ yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+ &(yyvsp[(yyi + 1) - (yynrhs)])
+ , &(yylsp[(yyi + 1) - (yynrhs)]) , info);
+ fprintf (stderr, "\n");
+ }
}
# define YY_REDUCE_PRINT(Rule) \
do { \
if (yydebug) \
- yy_reduce_print (Rule); \
-} while (0)
+ yy_reduce_print (yyvsp, yylsp, Rule, info); \
+} while (YYID (0))
/* Nonzero means print parse trace. It is left uninitialized so that
multiple parsers can coexist. */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args)
-# define YYDSYMPRINT(Args)
-# define YYDSYMPRINTF(Title, Token, Value, Location)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */
@@ -802,13 +1047,9 @@ int yydebug;
if the built-in stack extension method is used).
Do not make this value too large; the results are undefined if
- SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
+ YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
evaluated with infinite-precision integer arithmetic. */
-#if YYMAXDEPTH == 0
-# undef YYMAXDEPTH
-#endif
-
#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif
@@ -818,45 +1059,47 @@ int yydebug;
#if YYERROR_VERBOSE
# ifndef yystrlen
-# if defined (__GLIBC__) && defined (_STRING_H)
+# if defined __GLIBC__ && defined _STRING_H
# define yystrlen strlen
# else
/* Return the length of YYSTR. */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
-# if defined (__STDC__) || defined (__cplusplus)
yystrlen (const char *yystr)
-# else
+#else
+static YYSIZE_T
yystrlen (yystr)
- const char *yystr;
-# endif
+ const char *yystr;
+#endif
{
- register const char *yys = yystr;
-
- while (*yys++ != '\0')
+ YYSIZE_T yylen;
+ for (yylen = 0; yystr[yylen]; yylen++)
continue;
-
- return yys - yystr - 1;
+ return yylen;
}
# endif
# endif
# ifndef yystpcpy
-# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
# define yystpcpy stpcpy
# else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
YYDEST. */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
static char *
-# if defined (__STDC__) || defined (__cplusplus)
yystpcpy (char *yydest, const char *yysrc)
-# else
+#else
+static char *
yystpcpy (yydest, yysrc)
- char *yydest;
- const char *yysrc;
-# endif
+ char *yydest;
+ const char *yysrc;
+#endif
{
- register char *yyd = yydest;
- register const char *yys = yysrc;
+ char *yyd = yydest;
+ const char *yys = yysrc;
while ((*yyd++ = *yys++) != '\0')
continue;
@@ -866,70 +1109,196 @@ yystpcpy (yydest, yysrc)
# endif
# endif
-#endif /* !YYERROR_VERBOSE */
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+ quotes and backslashes, so that it's suitable for yyerror. The
+ heuristic is that double-quoting is unnecessary unless the string
+ contains an apostrophe, a comma, or backslash (other than
+ backslash-backslash). YYSTR is taken from yytname. If YYRES is
+ null, do not copy; instead, return the length of what the result
+ would have been. */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+ if (*yystr == '"')
+ {
+ YYSIZE_T yyn = 0;
+ char const *yyp = yystr;
+
+ for (;;)
+ switch (*++yyp)
+ {
+ case '\'':
+ case ',':
+ goto do_not_strip_quotes;
+
+ case '\\':
+ if (*++yyp != '\\')
+ goto do_not_strip_quotes;
+ /* Fall through. */
+ default:
+ if (yyres)
+ yyres[yyn] = *yyp;
+ yyn++;
+ break;
+
+ case '"':
+ if (yyres)
+ yyres[yyn] = '\0';
+ return yyn;
+ }
+ do_not_strip_quotes: ;
+ }
-
+ if (! yyres)
+ return yystrlen (yystr);
-#if YYDEBUG
-/*--------------------------------.
-| Print this symbol on YYOUTPUT. |
-`--------------------------------*/
+ return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
-#if defined (__STDC__) || defined (__cplusplus)
-static void
-yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep)
-#else
-static void
-yysymprint (yyoutput, yytype, yyvaluep)
- FILE *yyoutput;
- int yytype;
- YYSTYPE *yyvaluep;
-#endif
+/* Copy into YYRESULT an error message about the unexpected token
+ YYCHAR while in state YYSTATE. Return the number of bytes copied,
+ including the terminating null byte. If YYRESULT is null, do not
+ copy anything; just return the number of bytes that would be
+ copied. As a special case, return 0 if an ordinary "syntax error"
+ message will do. Return YYSIZE_MAXIMUM if overflow occurs during
+ size calculation. */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
{
- /* Pacify ``unused variable'' warnings. */
- (void) yyvaluep;
+ int yyn = yypact[yystate];
- if (yytype < YYNTOKENS)
- {
- YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
-# ifdef YYPRINT
- YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
-# endif
- }
+ if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+ return 0;
else
- YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
-
- switch (yytype)
{
- default:
- break;
+ int yytype = YYTRANSLATE (yychar);
+ YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+ YYSIZE_T yysize = yysize0;
+ YYSIZE_T yysize1;
+ int yysize_overflow = 0;
+ enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+ int yyx;
+
+# if 0
+ /* This is so xgettext sees the translatable formats that are
+ constructed on the fly. */
+ YY_("syntax error, unexpected %s");
+ YY_("syntax error, unexpected %s, expecting %s");
+ YY_("syntax error, unexpected %s, expecting %s or %s");
+ YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+ YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+ char *yyfmt;
+ char const *yyf;
+ static char const yyunexpected[] = "syntax error, unexpected %s";
+ static char const yyexpecting[] = ", expecting %s";
+ static char const yyor[] = " or %s";
+ char yyformat[sizeof yyunexpected
+ + sizeof yyexpecting - 1
+ + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+ * (sizeof yyor - 1))];
+ char const *yyprefix = yyexpecting;
+
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ int yyxbegin = yyn < 0 ? -yyn : 0;
+
+ /* Stay within bounds of both yycheck and yytname. */
+ int yychecklim = YYLAST - yyn + 1;
+ int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+ int yycount = 1;
+
+ yyarg[0] = yytname[yytype];
+ yyfmt = yystpcpy (yyformat, yyunexpected);
+
+ for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+ {
+ yycount = 1;
+ yysize = yysize0;
+ yyformat[sizeof yyunexpected - 1] = '\0';
+ break;
+ }
+ yyarg[yycount++] = yytname[yyx];
+ yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+ yysize_overflow |= (yysize1 < yysize);
+ yysize = yysize1;
+ yyfmt = yystpcpy (yyfmt, yyprefix);
+ yyprefix = yyor;
+ }
+
+ yyf = YY_(yyformat);
+ yysize1 = yysize + yystrlen (yyf);
+ yysize_overflow |= (yysize1 < yysize);
+ yysize = yysize1;
+
+ if (yysize_overflow)
+ return YYSIZE_MAXIMUM;
+
+ if (yyresult)
+ {
+ /* Avoid sprintf, as that infringes on the user's name space.
+ Don't have undefined behavior even if the translation
+ produced a string with the wrong number of "%s"s. */
+ char *yyp = yyresult;
+ int yyi = 0;
+ while ((*yyp = *yyf) != '\0')
+ {
+ if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+ {
+ yyp += yytnamerr (yyp, yyarg[yyi++]);
+ yyf += 2;
+ }
+ else
+ {
+ yyp++;
+ yyf++;
+ }
+ }
+ }
+ return yysize;
}
- YYFPRINTF (yyoutput, ")");
}
+#endif /* YYERROR_VERBOSE */
+
-#endif /* ! YYDEBUG */
/*-----------------------------------------------.
| Release the memory associated to this symbol. |
`-----------------------------------------------*/
-#if defined (__STDC__) || defined (__cplusplus)
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
static void
-yydestruct (int yytype, YYSTYPE *yyvaluep)
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
#else
static void
-yydestruct (yytype, yyvaluep)
+yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
+ const char *yymsg;
int yytype;
YYSTYPE *yyvaluep;
+ YYLTYPE *yylocationp;
+ DateInfo* info;
#endif
{
- /* Pacify ``unused variable'' warnings. */
- (void) yyvaluep;
+ YYUSE (yyvaluep);
+ YYUSE (yylocationp);
+ YYUSE (info);
+
+ if (!yymsg)
+ yymsg = "Deleting";
+ YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
switch (yytype)
{
default:
- break;
+ break;
}
}
@@ -937,14 +1306,14 @@ yydestruct (yytype, yyvaluep)
/* Prevent warnings from -Wmissing-prototypes. */
#ifdef YYPARSE_PARAM
-# if defined (__STDC__) || defined (__cplusplus)
+#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
-# else
+#else
int yyparse ();
-# endif
+#endif
#else /* ! YYPARSE_PARAM */
-#if defined (__STDC__) || defined (__cplusplus)
-int yyparse (void);
+#if defined __STDC__ || defined __cplusplus
+int yyparse (DateInfo* info);
#else
int yyparse ();
#endif
@@ -952,14 +1321,6 @@ int yyparse ();
-/* The lookahead symbol. */
-int yychar;
-
-/* The semantic value of the lookahead symbol. */
-YYSTYPE yylval;
-
-/* Number of syntax errors so far. */
-int yynerrs;
@@ -968,31 +1329,51 @@ int yynerrs;
`----------*/
#ifdef YYPARSE_PARAM
-# if defined (__STDC__) || defined (__cplusplus)
-int yyparse (void *YYPARSE_PARAM)
-# else
-int yyparse (YYPARSE_PARAM)
- void *YYPARSE_PARAM;
-# endif
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+ void *YYPARSE_PARAM;
+#endif
#else /* ! YYPARSE_PARAM */
-#if defined (__STDC__) || defined (__cplusplus)
+#if (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
int
-yyparse (void)
+yyparse (DateInfo* info)
#else
int
-yyparse ()
-
+yyparse (info)
+ DateInfo* info;
#endif
#endif
{
-
- register int yystate;
- register int yyn;
+ /* The look-ahead symbol. */
+int yychar;
+
+/* The semantic value of the look-ahead symbol. */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far. */
+int yynerrs;
+/* Location data for the look-ahead symbol. */
+YYLTYPE yylloc;
+
+ int yystate;
+ int yyn;
int yyresult;
/* Number of tokens to shift before error messages enabled. */
int yyerrstatus;
- /* Lookahead token as an internal (translated) token number. */
+ /* Look-ahead token as an internal (translated) token number. */
int yytoken = 0;
+#if YYERROR_VERBOSE
+ /* Buffer for error messages, and its allocated size. */
+ char yymsgbuf[128];
+ char *yymsg = yymsgbuf;
+ YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
/* Three stacks and their tools:
`yyss': related to states,
@@ -1003,29 +1384,34 @@ yyparse ()
to reallocate them elsewhere. */
/* The state stack. */
- short yyssa[YYINITDEPTH];
- short *yyss = yyssa;
- register short *yyssp;
+ yytype_int16 yyssa[YYINITDEPTH];
+ yytype_int16 *yyss = yyssa;
+ yytype_int16 *yyssp;
/* The semantic value stack. */
YYSTYPE yyvsa[YYINITDEPTH];
YYSTYPE *yyvs = yyvsa;
- register YYSTYPE *yyvsp;
-
+ YYSTYPE *yyvsp;
+ /* The location stack. */
+ YYLTYPE yylsa[YYINITDEPTH];
+ YYLTYPE *yyls = yylsa;
+ YYLTYPE *yylsp;
+ /* The locations where the error started and ended. */
+ YYLTYPE yyerror_range[2];
-#define YYPOPSTACK (yyvsp--, yyssp--)
+#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
YYSIZE_T yystacksize = YYINITDEPTH;
/* The variables used to return semantic value and location from the
action routines. */
YYSTYPE yyval;
+ YYLTYPE yyloc;
-
- /* When reducing, the number of symbols on the RHS of the reduced
- rule. */
- int yylen;
+ /* The number of symbols on the RHS of the reduced rule.
+ Keep to zero when no symbol should be popped. */
+ int yylen = 0;
YYDPRINTF ((stderr, "Starting parse\n"));
@@ -1041,6 +1427,12 @@ yyparse ()
yyssp = yyss;
yyvsp = yyvs;
+ yylsp = yyls;
+#if YYLTYPE_IS_TRIVIAL
+ /* Initialize the default location before parsing starts. */
+ yylloc.first_line = yylloc.last_line = 1;
+ yylloc.first_column = yylloc.last_column = 0;
+#endif
goto yysetstate;
@@ -1049,8 +1441,7 @@ yyparse ()
`------------------------------------------------------------*/
yynewstate:
/* In all cases, when you get here, the value and location stacks
- have just been pushed. so pushing a state here evens the stacks.
- */
+ have just been pushed. So pushing a state here evens the stacks. */
yyssp++;
yysetstate:
@@ -1063,46 +1454,46 @@ yyparse ()
#ifdef yyoverflow
{
- /* Give user a chance to reallocate the stack. Use copies of
+ /* Give user a chance to reallocate the stack. Use copies of
these so that the &'s don't force the real ones into
memory. */
YYSTYPE *yyvs1 = yyvs;
- short *yyss1 = yyss;
-
+ yytype_int16 *yyss1 = yyss;
+ YYLTYPE *yyls1 = yyls;
/* Each stack pointer address is followed by the size of the
data in use in that stack, in bytes. This used to be a
conditional around just the two extra args, but that might
be undefined if yyoverflow is a macro. */
- yyoverflow ("parser stack overflow",
+ yyoverflow (YY_("memory exhausted"),
&yyss1, yysize * sizeof (*yyssp),
&yyvs1, yysize * sizeof (*yyvsp),
-
+ &yyls1, yysize * sizeof (*yylsp),
&yystacksize);
-
+ yyls = yyls1;
yyss = yyss1;
yyvs = yyvs1;
}
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
- goto yyoverflowlab;
+ goto yyexhaustedlab;
# else
/* Extend the stack our own way. */
if (YYMAXDEPTH <= yystacksize)
- goto yyoverflowlab;
+ goto yyexhaustedlab;
yystacksize *= 2;
if (YYMAXDEPTH < yystacksize)
yystacksize = YYMAXDEPTH;
{
- short *yyss1 = yyss;
+ yytype_int16 *yyss1 = yyss;
union yyalloc *yyptr =
(union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
if (! yyptr)
- goto yyoverflowlab;
+ goto yyexhaustedlab;
YYSTACK_RELOCATE (yyss);
YYSTACK_RELOCATE (yyvs);
-
+ YYSTACK_RELOCATE (yyls);
# undef YYSTACK_RELOCATE
if (yyss1 != yyssa)
YYSTACK_FREE (yyss1);
@@ -1112,7 +1503,7 @@ yyparse ()
yyssp = yyss + yysize - 1;
yyvsp = yyvs + yysize - 1;
-
+ yylsp = yyls + yysize - 1;
YYDPRINTF ((stderr, "Stack size increased to %lu\n",
(unsigned long int) yystacksize));
@@ -1130,19 +1521,17 @@ yyparse ()
`-----------*/
yybackup:
-/* Do appropriate processing given the current state. */
-/* Read a lookahead token if we need one and don't already have one. */
-/* yyresume: */
-
- /* First try to decide what to do without reference to lookahead token. */
+ /* Do appropriate processing given the current state. Read a
+ look-ahead token if we need one and don't already have one. */
+ /* First try to decide what to do without reference to look-ahead token. */
yyn = yypact[yystate];
if (yyn == YYPACT_NINF)
goto yydefault;
- /* Not known => get a lookahead token if don't already have one. */
+ /* Not known => get a look-ahead token if don't already have one. */
- /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */
if (yychar == YYEMPTY)
{
YYDPRINTF ((stderr, "Reading a token: "));
@@ -1157,7 +1546,7 @@ yybackup:
else
{
yytoken = YYTRANSLATE (yychar);
- YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
+ YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
}
/* If the proper action on seeing token YYTOKEN is to reduce or to
@@ -1177,22 +1566,21 @@ yybackup:
if (yyn == YYFINAL)
YYACCEPT;
- /* Shift the lookahead token. */
- YYDPRINTF ((stderr, "Shifting token %s, ", yytname[yytoken]));
-
- /* Discard the token being shifted unless it is eof. */
- if (yychar != YYEOF)
- yychar = YYEMPTY;
-
- *++yyvsp = yylval;
-
-
/* Count tokens shifted since error; after three, turn off error
status. */
if (yyerrstatus)
yyerrstatus--;
+ /* Shift the look-ahead token. */
+ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+ /* Discard the shifted token unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
yystate = yyn;
+ *++yyvsp = yylval;
+ *++yylsp = yylloc;
goto yynewstate;
@@ -1223,50 +1611,51 @@ yyreduce:
GCC warning that YYVAL may be used uninitialized. */
yyval = yyvsp[1-yylen];
-
+ /* Default location. */
+ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
YY_REDUCE_PRINT (yyn);
switch (yyn)
{
case 4:
{
- yyHaveTime++;
- ;}
+ yyHaveTime++;
+ ;}
break;
case 5:
{
- yyHaveZone++;
- ;}
+ yyHaveZone++;
+ ;}
break;
case 6:
{
- yyHaveDate++;
- ;}
+ yyHaveDate++;
+ ;}
break;
case 7:
{
- yyHaveOrdinalMonth++;
- ;}
+ yyHaveOrdinalMonth++;
+ ;}
break;
case 8:
{
- yyHaveDay++;
- ;}
+ yyHaveDay++;
+ ;}
break;
case 9:
{
- yyHaveRel++;
- ;}
+ yyHaveRel++;
+ ;}
break;
case 10:
@@ -1283,195 +1672,195 @@ yyreduce:
yyHaveTime++;
yyHaveDate++;
yyHaveRel++;
- ;}
+ ;}
break;
case 13:
{
- yyHour = yyvsp[-1].Number;
- yyMinutes = 0;
- yySeconds = 0;
- yyMeridian = yyvsp[0].Meridian;
- ;}
+ yyHour = (yyvsp[(1) - (2)].Number);
+ yyMinutes = 0;
+ yySeconds = 0;
+ yyMeridian = (yyvsp[(2) - (2)].Meridian);
+ ;}
break;
case 14:
{
- yyHour = yyvsp[-3].Number;
- yyMinutes = yyvsp[-1].Number;
- yySeconds = 0;
- yyMeridian = yyvsp[0].Meridian;
- ;}
+ yyHour = (yyvsp[(1) - (4)].Number);
+ yyMinutes = (yyvsp[(3) - (4)].Number);
+ yySeconds = 0;
+ yyMeridian = (yyvsp[(4) - (4)].Meridian);
+ ;}
break;
case 15:
{
- yyHour = yyvsp[-4].Number;
- yyMinutes = yyvsp[-2].Number;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60);
+ yyHour = (yyvsp[(1) - (5)].Number);
+ yyMinutes = (yyvsp[(3) - (5)].Number);
+ yyMeridian = MER24;
+ yyDSTmode = DSToff;
+ yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
++yyHaveZone;
- ;}
+ ;}
break;
case 16:
{
- yyHour = yyvsp[-5].Number;
- yyMinutes = yyvsp[-3].Number;
- yySeconds = yyvsp[-1].Number;
- yyMeridian = yyvsp[0].Meridian;
- ;}
+ yyHour = (yyvsp[(1) - (6)].Number);
+ yyMinutes = (yyvsp[(3) - (6)].Number);
+ yySeconds = (yyvsp[(5) - (6)].Number);
+ yyMeridian = (yyvsp[(6) - (6)].Meridian);
+ ;}
break;
case 17:
{
- yyHour = yyvsp[-6].Number;
- yyMinutes = yyvsp[-4].Number;
- yySeconds = yyvsp[-2].Number;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60);
+ yyHour = (yyvsp[(1) - (7)].Number);
+ yyMinutes = (yyvsp[(3) - (7)].Number);
+ yySeconds = (yyvsp[(5) - (7)].Number);
+ yyMeridian = MER24;
+ yyDSTmode = DSToff;
+ yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
++yyHaveZone;
- ;}
+ ;}
break;
case 18:
{
- yyTimezone = yyvsp[-1].Number;
- yyDSTmode = DSTon;
- ;}
+ yyTimezone = (yyvsp[(1) - (2)].Number);
+ yyDSTmode = DSTon;
+ ;}
break;
case 19:
{
- yyTimezone = yyvsp[0].Number;
- yyDSTmode = DSToff;
- ;}
+ yyTimezone = (yyvsp[(1) - (1)].Number);
+ yyDSTmode = DSToff;
+ ;}
break;
case 20:
{
- yyTimezone = yyvsp[0].Number;
- yyDSTmode = DSTon;
- ;}
+ yyTimezone = (yyvsp[(1) - (1)].Number);
+ yyDSTmode = DSTon;
+ ;}
break;
case 21:
{
- yyDayOrdinal = 1;
- yyDayNumber = yyvsp[0].Number;
- ;}
+ yyDayOrdinal = 1;
+ yyDayNumber = (yyvsp[(1) - (1)].Number);
+ ;}
break;
case 22:
{
- yyDayOrdinal = 1;
- yyDayNumber = yyvsp[-1].Number;
- ;}
+ yyDayOrdinal = 1;
+ yyDayNumber = (yyvsp[(1) - (2)].Number);
+ ;}
break;
case 23:
{
- yyDayOrdinal = yyvsp[-1].Number;
- yyDayNumber = yyvsp[0].Number;
- ;}
+ yyDayOrdinal = (yyvsp[(1) - (2)].Number);
+ yyDayNumber = (yyvsp[(2) - (2)].Number);
+ ;}
break;
case 24:
{
- yyDayOrdinal = yyvsp[-2].Number * yyvsp[-1].Number;
- yyDayNumber = yyvsp[0].Number;
- ;}
+ yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
+ yyDayNumber = (yyvsp[(3) - (3)].Number);
+ ;}
break;
case 25:
{
- yyDayOrdinal = 2;
- yyDayNumber = yyvsp[0].Number;
- ;}
+ yyDayOrdinal = 2;
+ yyDayNumber = (yyvsp[(2) - (2)].Number);
+ ;}
break;
case 26:
{
- yyMonth = yyvsp[-2].Number;
- yyDay = yyvsp[0].Number;
- ;}
+ yyMonth = (yyvsp[(1) - (3)].Number);
+ yyDay = (yyvsp[(3) - (3)].Number);
+ ;}
break;
case 27:
{
- yyMonth = yyvsp[-4].Number;
- yyDay = yyvsp[-2].Number;
- yyYear = yyvsp[0].Number;
- ;}
+ yyMonth = (yyvsp[(1) - (5)].Number);
+ yyDay = (yyvsp[(3) - (5)].Number);
+ yyYear = (yyvsp[(5) - (5)].Number);
+ ;}
break;
case 28:
{
- yyYear = yyvsp[0].Number / 10000;
- yyMonth = (yyvsp[0].Number % 10000)/100;
- yyDay = yyvsp[0].Number % 100;
+ yyYear = (yyvsp[(1) - (1)].Number) / 10000;
+ yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
+ yyDay = (yyvsp[(1) - (1)].Number) % 100;
;}
break;
case 29:
{
- yyDay = yyvsp[-4].Number;
- yyMonth = yyvsp[-2].Number;
- yyYear = yyvsp[0].Number;
+ yyDay = (yyvsp[(1) - (5)].Number);
+ yyMonth = (yyvsp[(3) - (5)].Number);
+ yyYear = (yyvsp[(5) - (5)].Number);
;}
break;
case 30:
{
- yyMonth = yyvsp[-2].Number;
- yyDay = yyvsp[0].Number;
- yyYear = yyvsp[-4].Number;
- ;}
+ yyMonth = (yyvsp[(3) - (5)].Number);
+ yyDay = (yyvsp[(5) - (5)].Number);
+ yyYear = (yyvsp[(1) - (5)].Number);
+ ;}
break;
case 31:
{
- yyMonth = yyvsp[-1].Number;
- yyDay = yyvsp[0].Number;
- ;}
+ yyMonth = (yyvsp[(1) - (2)].Number);
+ yyDay = (yyvsp[(2) - (2)].Number);
+ ;}
break;
case 32:
{
- yyMonth = yyvsp[-3].Number;
- yyDay = yyvsp[-2].Number;
- yyYear = yyvsp[0].Number;
- ;}
+ yyMonth = (yyvsp[(1) - (4)].Number);
+ yyDay = (yyvsp[(2) - (4)].Number);
+ yyYear = (yyvsp[(4) - (4)].Number);
+ ;}
break;
case 33:
{
- yyMonth = yyvsp[0].Number;
- yyDay = yyvsp[-1].Number;
- ;}
+ yyMonth = (yyvsp[(2) - (2)].Number);
+ yyDay = (yyvsp[(1) - (2)].Number);
+ ;}
break;
case 34:
@@ -1486,79 +1875,80 @@ yyreduce:
case 35:
{
- yyMonth = yyvsp[-1].Number;
- yyDay = yyvsp[-2].Number;
- yyYear = yyvsp[0].Number;
- ;}
+ yyMonth = (yyvsp[(2) - (3)].Number);
+ yyDay = (yyvsp[(1) - (3)].Number);
+ yyYear = (yyvsp[(3) - (3)].Number);
+ ;}
break;
case 36:
{
yyMonthOrdinal = 1;
- yyMonth = yyvsp[0].Number;
+ yyMonth = (yyvsp[(2) - (2)].Number);
;}
break;
case 37:
{
- yyMonthOrdinal = yyvsp[-1].Number;
- yyMonth = yyvsp[0].Number;
+ yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
+ yyMonth = (yyvsp[(3) - (3)].Number);
;}
break;
case 38:
{
- if (yyvsp[-1].Number != HOUR(- 7)) YYABORT;
- yyYear = yyvsp[-2].Number / 10000;
- yyMonth = (yyvsp[-2].Number % 10000)/100;
- yyDay = yyvsp[-2].Number % 100;
- yyHour = yyvsp[0].Number / 10000;
- yyMinutes = (yyvsp[0].Number % 10000)/100;
- yySeconds = yyvsp[0].Number % 100;
- ;}
+ if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
+ yyYear = (yyvsp[(1) - (3)].Number) / 10000;
+ yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
+ yyDay = (yyvsp[(1) - (3)].Number) % 100;
+ yyHour = (yyvsp[(3) - (3)].Number) / 10000;
+ yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
+ yySeconds = (yyvsp[(3) - (3)].Number) % 100;
+ ;}
break;
case 39:
{
- if (yyvsp[-5].Number != HOUR(- 7)) YYABORT;
- yyYear = yyvsp[-6].Number / 10000;
- yyMonth = (yyvsp[-6].Number % 10000)/100;
- yyDay = yyvsp[-6].Number % 100;
- yyHour = yyvsp[-4].Number;
- yyMinutes = yyvsp[-2].Number;
- yySeconds = yyvsp[0].Number;
- ;}
+ if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
+ yyYear = (yyvsp[(1) - (7)].Number) / 10000;
+ yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
+ yyDay = (yyvsp[(1) - (7)].Number) % 100;
+ yyHour = (yyvsp[(3) - (7)].Number);
+ yyMinutes = (yyvsp[(5) - (7)].Number);
+ yySeconds = (yyvsp[(7) - (7)].Number);
+ ;}
break;
case 40:
{
- yyYear = yyvsp[-1].Number / 10000;
- yyMonth = (yyvsp[-1].Number % 10000)/100;
- yyDay = yyvsp[-1].Number % 100;
- yyHour = yyvsp[0].Number / 10000;
- yyMinutes = (yyvsp[0].Number % 10000)/100;
- yySeconds = yyvsp[0].Number % 100;
- ;}
+ yyYear = (yyvsp[(1) - (2)].Number) / 10000;
+ yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
+ yyDay = (yyvsp[(1) - (2)].Number) % 100;
+ yyHour = (yyvsp[(2) - (2)].Number) / 10000;
+ yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
+ yySeconds = (yyvsp[(2) - (2)].Number) % 100;
+ ;}
break;
case 41:
{
- /*
- * Offset computed year by -377 so that the returned years will
- * be in a range accessible with a 32 bit clock seconds value
+ /*
+ * Offset computed year by -377 so that the returned years will be
+ * in a range accessible with a 32 bit clock seconds value.
*/
- yyYear = yyvsp[-2].Number/1000 + 2323 - 377;
- yyDay = 1;
+
+ yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
+ yyDay = 1;
yyMonth = 1;
- yyRelDay += ((yyvsp[-2].Number%1000)*(365 + IsLeapYear(yyYear)))/1000;
- yyRelSeconds += yyvsp[0].Number * 144 * 60;
- ;}
+ yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
+ yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
+ ;}
break;
case 42:
@@ -1572,102 +1962,124 @@ yyreduce:
case 44:
- { *yyRelPointer += yyvsp[-2].Number * yyvsp[-1].Number * yyvsp[0].Number; ;}
+ {
+ *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
+ ;}
break;
case 45:
- { *yyRelPointer += yyvsp[-1].Number * yyvsp[0].Number; ;}
+ {
+ *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
+ ;}
break;
case 46:
- { *yyRelPointer += yyvsp[0].Number; ;}
+ {
+ *yyRelPointer += (yyvsp[(2) - (2)].Number);
+ ;}
break;
case 47:
- { *yyRelPointer += yyvsp[-1].Number * yyvsp[0].Number; ;}
+ {
+ *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
+ ;}
break;
case 48:
- { *yyRelPointer += yyvsp[0].Number; ;}
+ {
+ *yyRelPointer += (yyvsp[(1) - (1)].Number);
+ ;}
break;
case 49:
- { yyval.Number = -1; ;}
+ {
+ (yyval.Number) = -1;
+ ;}
break;
case 50:
- { yyval.Number = 1; ;}
+ {
+ (yyval.Number) = 1;
+ ;}
break;
case 51:
- { yyval.Number = yyvsp[0].Number; yyRelPointer = &yyRelSeconds; ;}
+ {
+ (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ yyRelPointer = &yyRelSeconds;
+ ;}
break;
case 52:
- { yyval.Number = yyvsp[0].Number; yyRelPointer = &yyRelDay; ;}
+ {
+ (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ yyRelPointer = &yyRelDay;
+ ;}
break;
case 53:
- { yyval.Number = yyvsp[0].Number; yyRelPointer = &yyRelMonth; ;}
+ {
+ (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ yyRelPointer = &yyRelMonth;
+ ;}
break;
case 54:
{
- if (yyHaveTime && yyHaveDate && !yyHaveRel) {
- yyYear = yyvsp[0].Number;
- } else {
- yyHaveTime++;
- if (yyDigitCount <= 2) {
- yyHour = yyvsp[0].Number;
- yyMinutes = 0;
+ if (yyHaveTime && yyHaveDate && !yyHaveRel) {
+ yyYear = (yyvsp[(1) - (1)].Number);
} else {
- yyHour = yyvsp[0].Number / 100;
- yyMinutes = yyvsp[0].Number % 100;
+ yyHaveTime++;
+ if (yyDigitCount <= 2) {
+ yyHour = (yyvsp[(1) - (1)].Number);
+ yyMinutes = 0;
+ } else {
+ yyHour = (yyvsp[(1) - (1)].Number) / 100;
+ yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
+ }
+ yySeconds = 0;
+ yyMeridian = MER24;
}
- yySeconds = 0;
- yyMeridian = MER24;
- }
- ;}
+ ;}
break;
case 55:
{
- yyval.Meridian = MER24;
- ;}
+ (yyval.Meridian) = MER24;
+ ;}
break;
case 56:
{
- yyval.Meridian = yyvsp[0].Meridian;
- ;}
+ (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
+ ;}
break;
- }
-
-/* Line 999 of yacc.c. */
-
-
- yyvsp -= yylen;
- yyssp -= yylen;
+/* Line 1267 of yacc.c. */
+ default: break;
+ }
+ YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+ YYPOPSTACK (yylen);
+ yylen = 0;
YY_STACK_PRINT (yyss, yyssp);
*++yyvsp = yyval;
-
+ *++yylsp = yyloc;
/* Now `shift' the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
@@ -1692,104 +2104,93 @@ yyerrlab:
if (!yyerrstatus)
{
++yynerrs;
-#if YYERROR_VERBOSE
- yyn = yypact[yystate];
-
- if (YYPACT_NINF < yyn && yyn < YYLAST)
- {
- YYSIZE_T yysize = 0;
- int yytype = YYTRANSLATE (yychar);
- const char* yyprefix;
- char *yymsg;
- int yyx;
-
- /* Start YYX at -YYN if negative to avoid negative indexes in
- YYCHECK. */
- int yyxbegin = yyn < 0 ? -yyn : 0;
-
- /* Stay within bounds of both yycheck and yytname. */
- int yychecklim = YYLAST - yyn;
- int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
- int yycount = 0;
-
- yyprefix = ", expecting ";
- for (yyx = yyxbegin; yyx < yyxend; ++yyx)
- if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+#if ! YYERROR_VERBOSE
+ yyerror (&yylloc, info, YY_("syntax error"));
+#else
+ {
+ YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+ if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+ {
+ YYSIZE_T yyalloc = 2 * yysize;
+ if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+ yyalloc = YYSTACK_ALLOC_MAXIMUM;
+ if (yymsg != yymsgbuf)
+ YYSTACK_FREE (yymsg);
+ yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+ if (yymsg)
+ yymsg_alloc = yyalloc;
+ else
{
- yysize += yystrlen (yyprefix) + yystrlen (yytname [yyx]);
- yycount += 1;
- if (yycount == 5)
- {
- yysize = 0;
- break;
- }
+ yymsg = yymsgbuf;
+ yymsg_alloc = sizeof yymsgbuf;
}
- yysize += (sizeof ("syntax error, unexpected ")
- + yystrlen (yytname[yytype]));
- yymsg = (char *) YYSTACK_ALLOC (yysize);
- if (yymsg != 0)
- {
- char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
- yyp = yystpcpy (yyp, yytname[yytype]);
-
- if (yycount < 5)
- {
- yyprefix = ", expecting ";
- for (yyx = yyxbegin; yyx < yyxend; ++yyx)
- if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
- {
- yyp = yystpcpy (yyp, yyprefix);
- yyp = yystpcpy (yyp, yytname[yyx]);
- yyprefix = " or ";
- }
- }
- yyerror (yymsg);
- YYSTACK_FREE (yymsg);
- }
- else
- yyerror ("syntax error; also virtual memory exhausted");
- }
- else
-#endif /* YYERROR_VERBOSE */
- yyerror ("syntax error");
+ }
+
+ if (0 < yysize && yysize <= yymsg_alloc)
+ {
+ (void) yysyntax_error (yymsg, yystate, yychar);
+ yyerror (&yylloc, info, yymsg);
+ }
+ else
+ {
+ yyerror (&yylloc, info, YY_("syntax error"));
+ if (yysize != 0)
+ goto yyexhaustedlab;
+ }
+ }
+#endif
}
-
+ yyerror_range[0] = yylloc;
if (yyerrstatus == 3)
{
- /* If just tried and failed to reuse lookahead token after an
+ /* If just tried and failed to reuse look-ahead token after an
error, discard it. */
- /* Return failure if at end of input. */
- if (yychar == YYEOF)
- {
- /* Pop the error token. */
- YYPOPSTACK;
- /* Pop the rest of the stack. */
- while (yyss < yyssp)
- {
- YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
- yydestruct (yystos[*yyssp], yyvsp);
- YYPOPSTACK;
- }
- YYABORT;
- }
-
- YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
- yydestruct (yytoken, &yylval);
- yychar = YYEMPTY;
-
+ if (yychar <= YYEOF)
+ {
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ YYABORT;
+ }
+ else
+ {
+ yydestruct ("Error: discarding",
+ yytoken, &yylval, &yylloc, info);
+ yychar = YYEMPTY;
+ }
}
- /* Else will try to reuse lookahead token after shifting the error
+ /* Else will try to reuse look-ahead token after shifting the error
token. */
goto yyerrlab1;
-/*----------------------------------------------------.
-| yyerrlab1 -- error raised explicitly by an action. |
-`----------------------------------------------------*/
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR. |
+`---------------------------------------------------*/
+yyerrorlab:
+
+ /* Pacify compilers like GCC when the user code never invokes
+ YYERROR and the label yyerrorlab therefore never appears in user
+ code. */
+ if (/*CONSTCOND*/ 0)
+ goto yyerrorlab;
+
+ yyerror_range[0] = yylsp[1-yylen];
+ /* Do not reclaim the symbols of the rule which action triggered
+ this YYERROR. */
+ YYPOPSTACK (yylen);
+ yylen = 0;
+ YY_STACK_PRINT (yyss, yyssp);
+ yystate = *yyssp;
+ goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR. |
+`-------------------------------------------------------------*/
yyerrlab1:
yyerrstatus = 3; /* Each real token shifted decrements this. */
@@ -1811,21 +2212,27 @@ yyerrlab1:
if (yyssp == yyss)
YYABORT;
- YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
- yydestruct (yystos[yystate], yyvsp);
- yyvsp--;
- yystate = *--yyssp;
-
+ yyerror_range[0] = *yylsp;
+ yydestruct ("Error: popping",
+ yystos[yystate], yyvsp, yylsp, info);
+ YYPOPSTACK (1);
+ yystate = *yyssp;
YY_STACK_PRINT (yyss, yyssp);
}
if (yyn == YYFINAL)
YYACCEPT;
- YYDPRINTF ((stderr, "Shifting error token, "));
-
*++yyvsp = yylval;
+ yyerror_range[1] = yylloc;
+ /* Using YYLLOC is tempting, but would change the location of
+ the look-ahead. YYLOC is available though. */
+ YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
+ *++yylsp = yyloc;
+
+ /* Shift the error token. */
+ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
yystate = yyn;
goto yynewstate;
@@ -1846,266 +2253,311 @@ yyabortlab:
goto yyreturn;
#ifndef yyoverflow
-/*----------------------------------------------.
-| yyoverflowlab -- parser overflow comes here. |
-`----------------------------------------------*/
-yyoverflowlab:
- yyerror ("parser stack overflow");
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here. |
+`-------------------------------------------------*/
+yyexhaustedlab:
+ yyerror (&yylloc, info, YY_("memory exhausted"));
yyresult = 2;
/* Fall through. */
#endif
yyreturn:
+ if (yychar != YYEOF && yychar != YYEMPTY)
+ yydestruct ("Cleanup: discarding lookahead",
+ yytoken, &yylval, &yylloc, info);
+ /* Do not reclaim the symbols of the rule which action triggered
+ this YYABORT or YYACCEPT. */
+ YYPOPSTACK (yylen);
+ YY_STACK_PRINT (yyss, yyssp);
+ while (yyssp != yyss)
+ {
+ yydestruct ("Cleanup: popping",
+ yystos[*yyssp], yyvsp, yylsp, info);
+ YYPOPSTACK (1);
+ }
#ifndef yyoverflow
if (yyss != yyssa)
YYSTACK_FREE (yyss);
#endif
- return yyresult;
+#if YYERROR_VERBOSE
+ if (yymsg != yymsgbuf)
+ YYSTACK_FREE (yymsg);
+#endif
+ /* Make sure YYID is used. */
+ return YYID (yyresult);
}
-
/*
* Month and day table.
*/
-static TABLE MonthDayTable[] = {
- { "january", tMONTH, 1 },
- { "february", tMONTH, 2 },
- { "march", tMONTH, 3 },
- { "april", tMONTH, 4 },
- { "may", tMONTH, 5 },
- { "june", tMONTH, 6 },
- { "july", tMONTH, 7 },
- { "august", tMONTH, 8 },
- { "september", tMONTH, 9 },
- { "sept", tMONTH, 9 },
- { "october", tMONTH, 10 },
- { "november", tMONTH, 11 },
- { "december", tMONTH, 12 },
- { "sunday", tDAY, 0 },
- { "monday", tDAY, 1 },
- { "tuesday", tDAY, 2 },
- { "tues", tDAY, 2 },
- { "wednesday", tDAY, 3 },
- { "wednes", tDAY, 3 },
- { "thursday", tDAY, 4 },
- { "thur", tDAY, 4 },
- { "thurs", tDAY, 4 },
- { "friday", tDAY, 5 },
- { "saturday", tDAY, 6 },
- { NULL }
+
+static const TABLE MonthDayTable[] = {
+ { "january", tMONTH, 1 },
+ { "february", tMONTH, 2 },
+ { "march", tMONTH, 3 },
+ { "april", tMONTH, 4 },
+ { "may", tMONTH, 5 },
+ { "june", tMONTH, 6 },
+ { "july", tMONTH, 7 },
+ { "august", tMONTH, 8 },
+ { "september", tMONTH, 9 },
+ { "sept", tMONTH, 9 },
+ { "october", tMONTH, 10 },
+ { "november", tMONTH, 11 },
+ { "december", tMONTH, 12 },
+ { "sunday", tDAY, 0 },
+ { "monday", tDAY, 1 },
+ { "tuesday", tDAY, 2 },
+ { "tues", tDAY, 2 },
+ { "wednesday", tDAY, 3 },
+ { "wednes", tDAY, 3 },
+ { "thursday", tDAY, 4 },
+ { "thur", tDAY, 4 },
+ { "thurs", tDAY, 4 },
+ { "friday", tDAY, 5 },
+ { "saturday", tDAY, 6 },
+ { NULL, 0, 0 }
};
/*
* Time units table.
*/
-static TABLE UnitsTable[] = {
- { "year", tMONTH_UNIT, 12 },
- { "month", tMONTH_UNIT, 1 },
- { "fortnight", tDAY_UNIT, 14 },
- { "week", tDAY_UNIT, 7 },
- { "day", tDAY_UNIT, 1 },
- { "hour", tSEC_UNIT, 60 * 60 },
- { "minute", tSEC_UNIT, 60 },
- { "min", tSEC_UNIT, 60 },
- { "second", tSEC_UNIT, 1 },
- { "sec", tSEC_UNIT, 1 },
- { NULL }
+
+static const TABLE UnitsTable[] = {
+ { "year", tMONTH_UNIT, 12 },
+ { "month", tMONTH_UNIT, 1 },
+ { "fortnight", tDAY_UNIT, 14 },
+ { "week", tDAY_UNIT, 7 },
+ { "day", tDAY_UNIT, 1 },
+ { "hour", tSEC_UNIT, 60 * 60 },
+ { "minute", tSEC_UNIT, 60 },
+ { "min", tSEC_UNIT, 60 },
+ { "second", tSEC_UNIT, 1 },
+ { "sec", tSEC_UNIT, 1 },
+ { NULL, 0, 0 }
};
/*
* Assorted relative-time words.
*/
-static TABLE OtherTable[] = {
- { "tomorrow", tDAY_UNIT, 1 },
- { "yesterday", tDAY_UNIT, -1 },
- { "today", tDAY_UNIT, 0 },
- { "now", tSEC_UNIT, 0 },
- { "last", tUNUMBER, -1 },
- { "this", tSEC_UNIT, 0 },
- { "next", tNEXT, 1 },
+
+static const TABLE OtherTable[] = {
+ { "tomorrow", tDAY_UNIT, 1 },
+ { "yesterday", tDAY_UNIT, -1 },
+ { "today", tDAY_UNIT, 0 },
+ { "now", tSEC_UNIT, 0 },
+ { "last", tUNUMBER, -1 },
+ { "this", tSEC_UNIT, 0 },
+ { "next", tNEXT, 1 },
#if 0
- { "first", tUNUMBER, 1 },
- { "second", tUNUMBER, 2 },
- { "third", tUNUMBER, 3 },
- { "fourth", tUNUMBER, 4 },
- { "fifth", tUNUMBER, 5 },
- { "sixth", tUNUMBER, 6 },
- { "seventh", tUNUMBER, 7 },
- { "eighth", tUNUMBER, 8 },
- { "ninth", tUNUMBER, 9 },
- { "tenth", tUNUMBER, 10 },
- { "eleventh", tUNUMBER, 11 },
- { "twelfth", tUNUMBER, 12 },
+ { "first", tUNUMBER, 1 },
+ { "second", tUNUMBER, 2 },
+ { "third", tUNUMBER, 3 },
+ { "fourth", tUNUMBER, 4 },
+ { "fifth", tUNUMBER, 5 },
+ { "sixth", tUNUMBER, 6 },
+ { "seventh", tUNUMBER, 7 },
+ { "eighth", tUNUMBER, 8 },
+ { "ninth", tUNUMBER, 9 },
+ { "tenth", tUNUMBER, 10 },
+ { "eleventh", tUNUMBER, 11 },
+ { "twelfth", tUNUMBER, 12 },
#endif
- { "ago", tAGO, 1 },
- { "epoch", tEPOCH, 0 },
- { "stardate", tSTARDATE, 0},
- { NULL }
+ { "ago", tAGO, 1 },
+ { "epoch", tEPOCH, 0 },
+ { "stardate", tSTARDATE, 0 },
+ { NULL, 0, 0 }
};
/*
- * The timezone table. (Note: This table was modified to not use any floating
+ * The timezone table. (Note: This table was modified to not use any floating
* point constants to work around an SGI compiler bug).
*/
-static TABLE TimezoneTable[] = {
- { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
- { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
- { "utc", tZONE, HOUR( 0) },
- { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
- { "wet", tZONE, HOUR( 0) }, /* Western European */
- { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
- { "wat", tZONE, HOUR( 1) }, /* West Africa */
- { "at", tZONE, HOUR( 2) }, /* Azores */
-#if 0
+
+static const TABLE TimezoneTable[] = {
+ { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
+ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
+ { "utc", tZONE, HOUR( 0) },
+ { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
+ { "wet", tZONE, HOUR( 0) }, /* Western European */
+ { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
+ { "wat", tZONE, HOUR( 1) }, /* West Africa */
+ { "at", tZONE, HOUR( 2) }, /* Azores */
+#if 0
/* For completeness. BST is also British Summer, and GST is
* also Guam Standard. */
- { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */
- { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */
+ { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */
+ { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */
#endif
- { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */
- { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */
- { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */
- { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */
- { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */
- { "est", tZONE, HOUR( 5) }, /* Eastern Standard */
- { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */
- { "cst", tZONE, HOUR( 6) }, /* Central Standard */
- { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */
- { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */
- { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */
- { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */
- { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
- { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
- { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
- { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
- { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
- { "cat", tZONE, HOUR(10) }, /* Central Alaska */
- { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */
- { "nt", tZONE, HOUR(11) }, /* Nome */
- { "idlw", tZONE, HOUR(12) }, /* International Date Line West */
- { "cet", tZONE, -HOUR( 1) }, /* Central European */
- { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
- { "met", tZONE, -HOUR( 1) }, /* Middle European */
- { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
- { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
- { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */
- { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */
- { "fwt", tZONE, -HOUR( 1) }, /* French Winter */
- { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */
- { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */
- { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */
- { "it", tZONE, -HOUR( 7/2) }, /* Iran */
- { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */
- { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */
- { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */
- { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */
-#if 0
+ { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */
+ { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */
+ { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */
+ { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */
+ { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */
+ { "est", tZONE, HOUR( 5) }, /* Eastern Standard */
+ { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */
+ { "cst", tZONE, HOUR( 6) }, /* Central Standard */
+ { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */
+ { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */
+ { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */
+ { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */
+ { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
+ { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
+ { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
+ { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
+ { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
+ { "cat", tZONE, HOUR(10) }, /* Central Alaska */
+ { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */
+ { "nt", tZONE, HOUR(11) }, /* Nome */
+ { "idlw", tZONE, HOUR(12) }, /* International Date Line West */
+ { "cet", tZONE, -HOUR( 1) }, /* Central European */
+ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
+ { "met", tZONE, -HOUR( 1) }, /* Middle European */
+ { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
+ { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
+ { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */
+ { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */
+ { "fwt", tZONE, -HOUR( 1) }, /* French Winter */
+ { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */
+ { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */
+ { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */
+ { "it", tZONE, -HOUR( 7/2) }, /* Iran */
+ { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */
+ { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */
+ { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */
+ { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */
+#if 0
/* For completeness. NST is also Newfoundland Stanard, nad SST is
* also Swedish Summer. */
- { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */
- { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */
-#endif /* 0 */
- { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */
- { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */
- { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
- { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
- { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */
- { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */
- { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */
- { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */
- { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */
- { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */
- { "nzt", tZONE, -HOUR(12) }, /* New Zealand */
- { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
- { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */
- { "idle", tZONE, -HOUR(12) }, /* International Date Line East */
+ { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */
+ { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */
+#endif /* 0 */
+ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */
+ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */
+ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
+ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
+ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */
+ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */
+ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */
+ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */
+ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */
+ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */
+ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */
+ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */
+ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */
+ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */
+ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
+ { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */
+ { "idle", tZONE, -HOUR(12) }, /* International Date Line East */
/* ADDED BY Marco Nijdam */
- { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */
+ { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */
/* End ADDED */
- { NULL }
+ { NULL, 0, 0 }
};
/*
* Military timezone table.
*/
-static TABLE MilitaryTable[] = {
- { "a", tZONE, HOUR( 1) },
- { "b", tZONE, HOUR( 2) },
- { "c", tZONE, HOUR( 3) },
- { "d", tZONE, HOUR( 4) },
- { "e", tZONE, HOUR( 5) },
- { "f", tZONE, HOUR( 6) },
- { "g", tZONE, HOUR( 7) },
- { "h", tZONE, HOUR( 8) },
- { "i", tZONE, HOUR( 9) },
- { "k", tZONE, HOUR( 10) },
- { "l", tZONE, HOUR( 11) },
- { "m", tZONE, HOUR( 12) },
- { "n", tZONE, HOUR(- 1) },
- { "o", tZONE, HOUR(- 2) },
- { "p", tZONE, HOUR(- 3) },
- { "q", tZONE, HOUR(- 4) },
- { "r", tZONE, HOUR(- 5) },
- { "s", tZONE, HOUR(- 6) },
- { "t", tZONE, HOUR(- 7) },
- { "u", tZONE, HOUR(- 8) },
- { "v", tZONE, HOUR(- 9) },
- { "w", tZONE, HOUR(-10) },
- { "x", tZONE, HOUR(-11) },
- { "y", tZONE, HOUR(-12) },
- { "z", tZONE, HOUR( 0) },
- { NULL }
-};
+static const TABLE MilitaryTable[] = {
+ { "a", tZONE, -HOUR( 1) },
+ { "b", tZONE, -HOUR( 2) },
+ { "c", tZONE, -HOUR( 3) },
+ { "d", tZONE, -HOUR( 4) },
+ { "e", tZONE, -HOUR( 5) },
+ { "f", tZONE, -HOUR( 6) },
+ { "g", tZONE, -HOUR( 7) },
+ { "h", tZONE, -HOUR( 8) },
+ { "i", tZONE, -HOUR( 9) },
+ { "k", tZONE, -HOUR(10) },
+ { "l", tZONE, -HOUR(11) },
+ { "m", tZONE, -HOUR(12) },
+ { "n", tZONE, HOUR( 1) },
+ { "o", tZONE, HOUR( 2) },
+ { "p", tZONE, HOUR( 3) },
+ { "q", tZONE, HOUR( 4) },
+ { "r", tZONE, HOUR( 5) },
+ { "s", tZONE, HOUR( 6) },
+ { "t", tZONE, HOUR( 7) },
+ { "u", tZONE, HOUR( 8) },
+ { "v", tZONE, HOUR( 9) },
+ { "w", tZONE, HOUR( 10) },
+ { "x", tZONE, HOUR( 11) },
+ { "y", tZONE, HOUR( 12) },
+ { "z", tZONE, HOUR( 0) },
+ { NULL, 0, 0 }
+};
/*
* Dump error messages in the bit bucket.
*/
+
static void
-TclDateerror(s)
- char *s;
+TclDateerror(
+ YYLTYPE* location,
+ DateInfo* infoPtr,
+ const char *s)
{
+ Tcl_Obj* t;
+ Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
+ Tcl_AppendToObj(infoPtr->messages, s, -1);
+ Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
+ t = Tcl_NewIntObj(location->first_column);
+ Tcl_IncrRefCount(t);
+ Tcl_AppendObjToObj(infoPtr->messages, t);
+ Tcl_DecrRefCount(t);
+ Tcl_AppendToObj(infoPtr->messages, "-", -1);
+ t = Tcl_NewIntObj(location->last_column);
+ Tcl_IncrRefCount(t);
+ Tcl_AppendObjToObj(infoPtr->messages, t);
+ Tcl_DecrRefCount(t);
+ Tcl_AppendToObj(infoPtr->messages, ")", -1);
+ infoPtr->separatrix = "\n";
}
static time_t
-ToSeconds(Hours, Minutes, Seconds, Meridian)
- time_t Hours;
- time_t Minutes;
- time_t Seconds;
- MERIDIAN Meridian;
+ToSeconds(
+ time_t Hours,
+ time_t Minutes,
+ time_t Seconds,
+ MERIDIAN Meridian)
{
- if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
- return -1;
+ if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
+ return -1;
+ }
switch (Meridian) {
case MER24:
- if (Hours < 0 || Hours > 23)
- return -1;
- return (Hours * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 0 || Hours > 23) {
+ return -1;
+ }
+ return (Hours * 60L + Minutes) * 60L + Seconds;
case MERam:
- if (Hours < 1 || Hours > 12)
- return -1;
- return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 1 || Hours > 12) {
+ return -1;
+ }
+ return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
case MERpm:
- if (Hours < 1 || Hours > 12)
- return -1;
- return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 1 || Hours > 12) {
+ return -1;
+ }
+ return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
}
- return -1; /* Should never be reached */
+ return -1; /* Should never be reached */
}
-
static int
-LookupWord(buff)
- char *buff;
+LookupWord(
+ YYSTYPE* yylvalPtr,
+ char *buff)
{
register char *p;
register char *q;
- register TABLE *tp;
- int i;
- int abbrev;
+ register const TABLE *tp;
+ int i, abbrev;
/*
* Make it lowercase.
@@ -2114,192 +2566,213 @@ LookupWord(buff)
Tcl_UtfToLower(buff);
if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
- yylval.Meridian = MERam;
- return tMERIDIAN;
+ yylvalPtr->Meridian = MERam;
+ return tMERIDIAN;
}
if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
- yylval.Meridian = MERpm;
- return tMERIDIAN;
+ yylvalPtr->Meridian = MERpm;
+ return tMERIDIAN;
}
/*
* See if we have an abbreviation for a month.
*/
+
if (strlen(buff) == 3) {
- abbrev = 1;
+ abbrev = 1;
} else if (strlen(buff) == 4 && buff[3] == '.') {
- abbrev = 1;
- buff[3] = '\0';
+ abbrev = 1;
+ buff[3] = '\0';
} else {
- abbrev = 0;
+ abbrev = 0;
}
for (tp = MonthDayTable; tp->name; tp++) {
- if (abbrev) {
- if (strncmp(buff, tp->name, 3) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
- } else if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (abbrev) {
+ if (strncmp(buff, tp->name, 3) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
+ } else if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
for (tp = TimezoneTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
for (tp = UnitsTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
/*
* Strip off any plural and try the units table again.
*/
+
i = strlen(buff) - 1;
- if (buff[i] == 's') {
- buff[i] = '\0';
- for (tp = UnitsTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (i > 0 && buff[i] == 's') {
+ buff[i] = '\0';
+ for (tp = UnitsTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
for (tp = OtherTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
/*
* Military timezones.
*/
+
if (buff[1] == '\0' && !(*buff & 0x80)
- && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
- for (tp = MilitaryTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
+ for (tp = MilitaryTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
/*
* Drop out any periods and try the timezone table again.
*/
- for (i = 0, p = q = buff; *q; q++)
- if (*q != '.') {
- *p++ = *q;
- } else {
- i++;
+
+ for (i = 0, p = q = buff; *q; q++) {
+ if (*q != '.') {
+ *p++ = *q;
+ } else {
+ i++;
}
+ }
*p = '\0';
if (i) {
- for (tp = TimezoneTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ for (tp = TimezoneTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
-
+
return tID;
}
static int
-TclDatelex( void* info )
+TclDatelex(
+ YYSTYPE* yylvalPtr,
+ YYLTYPE* location,
+ DateInfo *info)
{
- register char c;
- register char *p;
- char buff[20];
- int Count;
+ register char c;
+ register char *p;
+ char buff[20];
+ int Count;
+ location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (isspace(UCHAR(*yyInput))) {
- yyInput++;
+ while (TclIsSpaceProc(*yyInput)) {
+ yyInput++;
}
- if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
- /* convert the string into a number; count the number of digits */
+ if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+ /*
+ * Convert the string into a number; count the number of digits.
+ */
+
Count = 0;
- for (yylval.Number = 0;
- isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
- yylval.Number = 10 * yylval.Number + c - '0';
+ for (yylvalPtr->Number = 0;
+ isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
+ yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
Count++;
}
- yyInput--;
+ yyInput--;
yyDigitCount = Count;
- /* A number with 6 or more digits is considered an ISO 8601 base */
+
+ /*
+ * A number with 6 or more digits is considered an ISO 8601 base.
+ */
+
if (Count >= 6) {
+ location->last_column = yyInput - info->dateStart - 1;
return tISOBASE;
} else {
+ location->last_column = yyInput - info->dateStart - 1;
return tUNUMBER;
}
- }
- if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
- for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
+ }
+ if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
|| c == '.'; ) {
- if (p < &buff[sizeof buff - 1]) {
- *p++ = c;
+ if (p < &buff[sizeof buff - 1]) {
+ *p++ = c;
}
}
- *p = '\0';
- yyInput--;
- return LookupWord(buff);
- }
- if (c != '(') {
- return *yyInput++;
+ *p = '\0';
+ yyInput--;
+ location->last_column = yyInput - info->dateStart - 1;
+ return LookupWord(yylvalPtr, buff);
}
- Count = 0;
- do {
- c = *yyInput++;
- if (c == '\0') {
- return c;
+ if (c != '(') {
+ location->last_column = yyInput - info->dateStart;
+ return *yyInput++;
+ }
+ Count = 0;
+ do {
+ c = *yyInput++;
+ if (c == '\0') {
+ location->last_column = yyInput - info->dateStart - 1;
+ return c;
} else if (c == '(') {
- Count++;
+ Count++;
} else if (c == ')') {
- Count--;
+ Count--;
}
- } while (Count > 0);
+ } while (Count > 0);
}
}
int
-TclClockOldscanObjCmd( clientData, interp, objc, objv )
- ClientData clientData; /* Unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Count of paraneters */
- Tcl_Obj *CONST *objv; /* Parameters */
+TclClockOldscanObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Count of paraneters */
+ Tcl_Obj *const *objv) /* Parameters */
{
-
- Tcl_Obj* result;
- Tcl_Obj* resultElement;
+ Tcl_Obj *result, *resultElement;
int yr, mo, da;
DateInfo dateInfo;
- void* info = (void*) &dateInfo;
+ DateInfo* info = &dateInfo;
+ int status;
- if ( objc != 5 ) {
- Tcl_WrongNumArgs( interp, 1, objv,
- "stringToParse baseYear baseMonth baseDay" );
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "stringToParse baseYear baseMonth baseDay" );
return TCL_ERROR;
}
yyInput = Tcl_GetString( objv[1] );
+ dateInfo.dateStart = yyInput;
yyHaveDate = 0;
- if ( Tcl_GetIntFromObj( interp, objv[2], &yr ) != TCL_OK
- || Tcl_GetIntFromObj( interp, objv[3], &mo ) != TCL_OK
- || Tcl_GetIntFromObj( interp, objv[4], &da ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
return TCL_ERROR;
}
yyYear = yr; yyMonth = mo; yyDay = da;
@@ -2319,104 +2792,129 @@ TclClockOldscanObjCmd( clientData, interp, objc, objv )
yyHaveRel = 0;
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
- if ( yyparse( info ) ) {
- Tcl_SetObjResult( interp, Tcl_NewStringObj( "syntax error", -1 ) );
+ dateInfo.messages = Tcl_NewObj();
+ dateInfo.separatrix = "";
+ Tcl_IncrRefCount(dateInfo.messages);
+
+ status = yyparse(&dateInfo);
+ 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 "
+ "from date parser. Please "
+ "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);
- if ( yyHaveDate > 1 ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj( "more than one date in string", -1 ) );
+ 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 ) );
+ 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 ) );
+ 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 ) );
+ 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 ) );
+ 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;
}
-
+
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
- if ( yyHaveDate ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyYear ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonth ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDay ) );
+ if (yyHaveDate) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyYear));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonth));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDay));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
-
- if ( yyHaveTime ) {
- Tcl_ListObjAppendElement( interp, result,
- Tcl_NewIntObj( ToSeconds( yyHour,
- yyMinutes,
- yySeconds,
- yyMeridian ) ) );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
+
+ if (yyHaveTime) {
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
+ ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
} else {
- Tcl_ListObjAppendElement( interp, result, Tcl_NewObj() );
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
}
resultElement = Tcl_NewObj();
- if ( yyHaveZone ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( -yyTimezone ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( 1-yyDSTmode ) );
+ if (yyHaveZone) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) -yyTimezone));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj(1 - yyDSTmode));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveRel ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelMonth ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelDay ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelSeconds ) );
+ if (yyHaveRel) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelMonth));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelDay));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelSeconds));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveDay && !yyHaveDate ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDayOrdinal ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDayNumber ) );
+ if (yyHaveDay && !yyHaveDate) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDayOrdinal));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDayNumber));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveOrdinalMonth ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonthOrdinal ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonth ) );
+ if (yyHaveOrdinalMonth) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonthOrdinal));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonth));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
-
- Tcl_SetObjResult( interp, result );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
+
+ Tcl_SetObjResult(interp, result);
return TCL_OK;
}
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4528521..91c0add 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.116 2005/09/13 21:23:51 dgp Exp $
*/
#ifndef _TCLDECLS
@@ -33,6406 +31,3887 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#ifndef Tcl_PkgProvideEx_TCL_DECLARED
-#define Tcl_PkgProvideEx_TCL_DECLARED
/* 0 */
-EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp,
- CONST char* name, CONST char* version,
- ClientData clientData));
-#endif
-#ifndef Tcl_PkgRequireEx_TCL_DECLARED
-#define Tcl_PkgRequireEx_TCL_DECLARED
+EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp,
+ const char *name, const char *version,
+ const void *clientData);
/* 1 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- CONST char * version, int exact,
- ClientData * clientDataPtr));
-#endif
-#ifndef Tcl_Panic_TCL_DECLARED
-#define Tcl_Panic_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
+ const char *name, const char *version,
+ int exact, void *clientDataPtr);
/* 2 */
-EXTERN void Tcl_Panic _ANSI_ARGS_((CONST char *format, ...));
-#endif
-#ifndef Tcl_Alloc_TCL_DECLARED
-#define Tcl_Alloc_TCL_DECLARED
+EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
-EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
-#endif
-#ifndef Tcl_Free_TCL_DECLARED
-#define Tcl_Free_TCL_DECLARED
+EXTERN char * Tcl_Alloc(unsigned int size);
/* 4 */
-EXTERN void Tcl_Free _ANSI_ARGS_((char * ptr));
-#endif
-#ifndef Tcl_Realloc_TCL_DECLARED
-#define Tcl_Realloc_TCL_DECLARED
+EXTERN void Tcl_Free(char *ptr);
/* 5 */
-EXTERN char * Tcl_Realloc _ANSI_ARGS_((char * ptr,
- unsigned int size));
-#endif
-#ifndef Tcl_DbCkalloc_TCL_DECLARED
-#define Tcl_DbCkalloc_TCL_DECLARED
+EXTERN char * Tcl_Realloc(char *ptr, unsigned int size);
/* 6 */
-EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbCkfree_TCL_DECLARED
-#define Tcl_DbCkfree_TCL_DECLARED
+EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file,
+ int line);
/* 7 */
-EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char * ptr,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbCkrealloc_TCL_DECLARED
-#define Tcl_DbCkrealloc_TCL_DECLARED
+EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
-EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char * ptr,
- unsigned int size, CONST char * file,
- int line));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_CreateFileHandler_TCL_DECLARED
-#define Tcl_CreateFileHandler_TCL_DECLARED
+EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
+ const char *file, int line);
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
-EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
- Tcl_FileProc * proc, ClientData clientData));
-#endif
+EXTERN void Tcl_CreateFileHandler(int fd, int mask,
+ Tcl_FileProc *proc, ClientData clientData);
#endif /* UNIX */
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
-#define Tcl_DeleteFileHandler_TCL_DECLARED
+#ifdef MAC_OSX_TCL /* MACOSX */
+/* 9 */
+EXTERN void Tcl_CreateFileHandler(int fd, int mask,
+ Tcl_FileProc *proc, ClientData clientData);
+#endif /* MACOSX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
-EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
-#endif
+EXTERN void Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
-#ifndef Tcl_SetTimer_TCL_DECLARED
-#define Tcl_SetTimer_TCL_DECLARED
+#ifdef MAC_OSX_TCL /* MACOSX */
+/* 10 */
+EXTERN void Tcl_DeleteFileHandler(int fd);
+#endif /* MACOSX */
/* 11 */
-EXTERN void Tcl_SetTimer _ANSI_ARGS_((Tcl_Time * timePtr));
-#endif
-#ifndef Tcl_Sleep_TCL_DECLARED
-#define Tcl_Sleep_TCL_DECLARED
+EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr);
/* 12 */
-EXTERN void Tcl_Sleep _ANSI_ARGS_((int ms));
-#endif
-#ifndef Tcl_WaitForEvent_TCL_DECLARED
-#define Tcl_WaitForEvent_TCL_DECLARED
+EXTERN void Tcl_Sleep(int ms);
/* 13 */
-EXTERN int Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr));
-#endif
-#ifndef Tcl_AppendAllObjTypes_TCL_DECLARED
-#define Tcl_AppendAllObjTypes_TCL_DECLARED
+EXTERN int Tcl_WaitForEvent(const Tcl_Time *timePtr);
/* 14 */
-EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_AppendStringsToObj_TCL_DECLARED
-#define Tcl_AppendStringsToObj_TCL_DECLARED
+EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
/* 15 */
-EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_((Tcl_Obj *objPtr, ...));
-#endif
-#ifndef Tcl_AppendToObj_TCL_DECLARED
-#define Tcl_AppendToObj_TCL_DECLARED
+EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
-EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj* objPtr,
- CONST char* bytes, int length));
-#endif
-#ifndef Tcl_ConcatObj_TCL_DECLARED
-#define Tcl_ConcatObj_TCL_DECLARED
+EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
+ int length);
/* 17 */
-EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_ConvertToType_TCL_DECLARED
-#define Tcl_ConvertToType_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
-EXTERN int Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, Tcl_ObjType * typePtr));
-#endif
-#ifndef Tcl_DbDecrRefCount_TCL_DECLARED
-#define Tcl_DbDecrRefCount_TCL_DECLARED
+EXTERN int Tcl_ConvertToType(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
-EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbIncrRefCount_TCL_DECLARED
-#define Tcl_DbIncrRefCount_TCL_DECLARED
+EXTERN void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
+ int line);
/* 20 */
-EXTERN void Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbIsShared_TCL_DECLARED
-#define Tcl_DbIsShared_TCL_DECLARED
+EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
+ int line);
/* 21 */
-EXTERN int Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbNewBooleanObj_TCL_DECLARED
-#define Tcl_DbNewBooleanObj_TCL_DECLARED
+EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
+ int line);
/* 22 */
-EXTERN Tcl_Obj * Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbNewByteArrayObj_TCL_DECLARED
-#define Tcl_DbNewByteArrayObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
+ int line);
/* 23 */
-EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj _ANSI_ARGS_((
- CONST unsigned char * bytes, int length,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbNewDoubleObj_TCL_DECLARED
-#define Tcl_DbNewDoubleObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
+ int length, const char *file, int line);
/* 24 */
-EXTERN Tcl_Obj * Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbNewListObj_TCL_DECLARED
-#define Tcl_DbNewListObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
+ const char *file, int line);
/* 25 */
-EXTERN Tcl_Obj * Tcl_DbNewListObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST * objv, CONST char * file,
- int line));
-#endif
-#ifndef Tcl_DbNewLongObj_TCL_DECLARED
-#define Tcl_DbNewLongObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
+ const char *file, int line);
/* 26 */
-EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_DbNewObj_TCL_DECLARED
-#define Tcl_DbNewObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
+ int line);
/* 27 */
-EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((CONST char * file,
- int line));
-#endif
-#ifndef Tcl_DbNewStringObj_TCL_DECLARED
-#define Tcl_DbNewStringObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
/* 28 */
-EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((CONST char * bytes,
- int length, CONST char * file, int line));
-#endif
-#ifndef Tcl_DuplicateObj_TCL_DECLARED
-#define Tcl_DuplicateObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length,
+ const char *file, int line);
/* 29 */
-EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj * objPtr));
-#endif
-#ifndef TclFreeObj_TCL_DECLARED
-#define TclFreeObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
-EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetBoolean_TCL_DECLARED
-#define Tcl_GetBoolean_TCL_DECLARED
+EXTERN void TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
-EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * src, int * boolPtr));
-#endif
-#ifndef Tcl_GetBooleanFromObj_TCL_DECLARED
-#define Tcl_GetBooleanFromObj_TCL_DECLARED
+EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
+ int *boolPtr);
/* 32 */
-EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr,
- int * boolPtr));
-#endif
-#ifndef Tcl_GetByteArrayFromObj_TCL_DECLARED
-#define Tcl_GetByteArrayFromObj_TCL_DECLARED
+EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *boolPtr);
/* 33 */
-EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_((
- Tcl_Obj * objPtr, int * lengthPtr));
-#endif
-#ifndef Tcl_GetDouble_TCL_DECLARED
-#define Tcl_GetDouble_TCL_DECLARED
+EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
+ int *lengthPtr);
/* 34 */
-EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * src, double * doublePtr));
-#endif
-#ifndef Tcl_GetDoubleFromObj_TCL_DECLARED
-#define Tcl_GetDoubleFromObj_TCL_DECLARED
+EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
+ double *doublePtr);
/* 35 */
-EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr,
- double * doublePtr));
-#endif
-#ifndef Tcl_GetIndexFromObj_TCL_DECLARED
-#define Tcl_GetIndexFromObj_TCL_DECLARED
+EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, double *doublePtr);
/* 36 */
-EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, CONST84 char ** tablePtr,
- CONST char * msg, int flags, int * indexPtr));
-#endif
-#ifndef Tcl_GetInt_TCL_DECLARED
-#define Tcl_GetInt_TCL_DECLARED
+EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ CONST84 char *const *tablePtr,
+ const char *msg, int flags, int *indexPtr);
/* 37 */
-EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * src, int * intPtr));
-#endif
-#ifndef Tcl_GetIntFromObj_TCL_DECLARED
-#define Tcl_GetIntFromObj_TCL_DECLARED
+EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src,
+ int *intPtr);
/* 38 */
-EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, int * intPtr));
-#endif
-#ifndef Tcl_GetLongFromObj_TCL_DECLARED
-#define Tcl_GetLongFromObj_TCL_DECLARED
+EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *intPtr);
/* 39 */
-EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, long * longPtr));
-#endif
-#ifndef Tcl_GetObjType_TCL_DECLARED
-#define Tcl_GetObjType_TCL_DECLARED
+EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, long *longPtr);
/* 40 */
-EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((CONST char * typeName));
-#endif
-#ifndef Tcl_GetStringFromObj_TCL_DECLARED
-#define Tcl_GetStringFromObj_TCL_DECLARED
+EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
-EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- int * lengthPtr));
-#endif
-#ifndef Tcl_InvalidateStringRep_TCL_DECLARED
-#define Tcl_InvalidateStringRep_TCL_DECLARED
+EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
-EXTERN void Tcl_InvalidateStringRep _ANSI_ARGS_((
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_ListObjAppendList_TCL_DECLARED
-#define Tcl_ListObjAppendList_TCL_DECLARED
+EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
-EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * listPtr,
- Tcl_Obj * elemListPtr));
-#endif
-#ifndef Tcl_ListObjAppendElement_TCL_DECLARED
-#define Tcl_ListObjAppendElement_TCL_DECLARED
+EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
/* 44 */
-EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * listPtr,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_ListObjGetElements_TCL_DECLARED
-#define Tcl_ListObjGetElements_TCL_DECLARED
+EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, Tcl_Obj *objPtr);
/* 45 */
-EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * listPtr,
- int * objcPtr, Tcl_Obj *** objvPtr));
-#endif
-#ifndef Tcl_ListObjIndex_TCL_DECLARED
-#define Tcl_ListObjIndex_TCL_DECLARED
+EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, int *objcPtr,
+ Tcl_Obj ***objvPtr);
/* 46 */
-EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * listPtr, int index,
- Tcl_Obj ** objPtrPtr));
-#endif
-#ifndef Tcl_ListObjLength_TCL_DECLARED
-#define Tcl_ListObjLength_TCL_DECLARED
+EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, int index,
+ Tcl_Obj **objPtrPtr);
/* 47 */
-EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * listPtr, int * lengthPtr));
-#endif
-#ifndef Tcl_ListObjReplace_TCL_DECLARED
-#define Tcl_ListObjReplace_TCL_DECLARED
+EXTERN int Tcl_ListObjLength(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, int *lengthPtr);
/* 48 */
-EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * listPtr, int first, int count,
- int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_NewBooleanObj_TCL_DECLARED
-#define Tcl_NewBooleanObj_TCL_DECLARED
+EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, int first, int count,
+ int objc, Tcl_Obj *const objv[]);
/* 49 */
-EXTERN Tcl_Obj * Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
-#endif
-#ifndef Tcl_NewByteArrayObj_TCL_DECLARED
-#define Tcl_NewByteArrayObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
-EXTERN Tcl_Obj * Tcl_NewByteArrayObj _ANSI_ARGS_((
- CONST unsigned char* bytes, int length));
-#endif
-#ifndef Tcl_NewDoubleObj_TCL_DECLARED
-#define Tcl_NewDoubleObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
+ int length);
/* 51 */
-EXTERN Tcl_Obj * Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
-#endif
-#ifndef Tcl_NewIntObj_TCL_DECLARED
-#define Tcl_NewIntObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
-EXTERN Tcl_Obj * Tcl_NewIntObj _ANSI_ARGS_((int intValue));
-#endif
-#ifndef Tcl_NewListObj_TCL_DECLARED
-#define Tcl_NewListObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
/* 53 */
-EXTERN Tcl_Obj * Tcl_NewListObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_NewLongObj_TCL_DECLARED
-#define Tcl_NewLongObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
-EXTERN Tcl_Obj * Tcl_NewLongObj _ANSI_ARGS_((long longValue));
-#endif
-#ifndef Tcl_NewObj_TCL_DECLARED
-#define Tcl_NewObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
/* 55 */
-EXTERN Tcl_Obj * Tcl_NewObj _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_NewStringObj_TCL_DECLARED
-#define Tcl_NewStringObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
-EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((CONST char * bytes,
- int length));
-#endif
-#ifndef Tcl_SetBooleanObj_TCL_DECLARED
-#define Tcl_SetBooleanObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
-EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- int boolValue));
-#endif
-#ifndef Tcl_SetByteArrayLength_TCL_DECLARED
-#define Tcl_SetByteArrayLength_TCL_DECLARED
+EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
-EXTERN unsigned char * Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj * objPtr,
- int length));
-#endif
-#ifndef Tcl_SetByteArrayObj_TCL_DECLARED
-#define Tcl_SetByteArrayObj_TCL_DECLARED
+EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
-EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST unsigned char * bytes, int length));
-#endif
-#ifndef Tcl_SetDoubleObj_TCL_DECLARED
-#define Tcl_SetDoubleObj_TCL_DECLARED
+EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
+ const unsigned char *bytes, int length);
/* 60 */
-EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- double doubleValue));
-#endif
-#ifndef Tcl_SetIntObj_TCL_DECLARED
-#define Tcl_SetIntObj_TCL_DECLARED
+EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
-EXTERN void Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- int intValue));
-#endif
-#ifndef Tcl_SetListObj_TCL_DECLARED
-#define Tcl_SetListObj_TCL_DECLARED
+EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
-EXTERN void Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_SetLongObj_TCL_DECLARED
-#define Tcl_SetLongObj_TCL_DECLARED
+EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
+ Tcl_Obj *const objv[]);
/* 63 */
-EXTERN void Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- long longValue));
-#endif
-#ifndef Tcl_SetObjLength_TCL_DECLARED
-#define Tcl_SetObjLength_TCL_DECLARED
+EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* 64 */
-EXTERN void Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj * objPtr,
- int length));
-#endif
-#ifndef Tcl_SetStringObj_TCL_DECLARED
-#define Tcl_SetStringObj_TCL_DECLARED
+EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
-EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj* objPtr,
- CONST char* bytes, int length));
-#endif
-#ifndef Tcl_AddErrorInfo_TCL_DECLARED
-#define Tcl_AddErrorInfo_TCL_DECLARED
+EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
+ int length);
/* 66 */
-EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * message));
-#endif
-#ifndef Tcl_AddObjErrorInfo_TCL_DECLARED
-#define Tcl_AddObjErrorInfo_TCL_DECLARED
+EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp,
+ const char *message);
/* 67 */
-EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * message, int length));
-#endif
-#ifndef Tcl_AllowExceptions_TCL_DECLARED
-#define Tcl_AllowExceptions_TCL_DECLARED
+EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
+ const char *message, int length);
/* 68 */
-EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_AppendElement_TCL_DECLARED
-#define Tcl_AppendElement_TCL_DECLARED
+EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
-EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * element));
-#endif
-#ifndef Tcl_AppendResult_TCL_DECLARED
-#define Tcl_AppendResult_TCL_DECLARED
+EXTERN void Tcl_AppendElement(Tcl_Interp *interp,
+ const char *element);
/* 70 */
-EXTERN void Tcl_AppendResult _ANSI_ARGS_((Tcl_Interp *interp, ...));
-#endif
-#ifndef Tcl_AsyncCreate_TCL_DECLARED
-#define Tcl_AsyncCreate_TCL_DECLARED
+EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
-EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_AsyncDelete_TCL_DECLARED
-#define Tcl_AsyncDelete_TCL_DECLARED
+EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
+ ClientData clientData);
/* 72 */
-EXTERN void Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
-#endif
-#ifndef Tcl_AsyncInvoke_TCL_DECLARED
-#define Tcl_AsyncInvoke_TCL_DECLARED
+EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
-EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp * interp,
- int code));
-#endif
-#ifndef Tcl_AsyncMark_TCL_DECLARED
-#define Tcl_AsyncMark_TCL_DECLARED
+EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
-EXTERN void Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
-#endif
-#ifndef Tcl_AsyncReady_TCL_DECLARED
-#define Tcl_AsyncReady_TCL_DECLARED
+EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
-EXTERN int Tcl_AsyncReady _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_BackgroundError_TCL_DECLARED
-#define Tcl_BackgroundError_TCL_DECLARED
+EXTERN int Tcl_AsyncReady(void);
/* 76 */
-EXTERN void Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_Backslash_TCL_DECLARED
-#define Tcl_Backslash_TCL_DECLARED
+EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
-EXTERN char Tcl_Backslash _ANSI_ARGS_((CONST char * src,
- int * readPtr));
-#endif
-#ifndef Tcl_BadChannelOption_TCL_DECLARED
-#define Tcl_BadChannelOption_TCL_DECLARED
+EXTERN char Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
-EXTERN int Tcl_BadChannelOption _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * optionName,
- CONST char * optionList));
-#endif
-#ifndef Tcl_CallWhenDeleted_TCL_DECLARED
-#define Tcl_CallWhenDeleted_TCL_DECLARED
+EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
+ const char *optionName,
+ const char *optionList);
/* 79 */
-EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_InterpDeleteProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_CancelIdleCall_TCL_DECLARED
-#define Tcl_CancelIdleCall_TCL_DECLARED
+EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp,
+ Tcl_InterpDeleteProc *proc,
+ ClientData clientData);
/* 80 */
-EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_((
- Tcl_IdleProc * idleProc,
- ClientData clientData));
-#endif
-#ifndef Tcl_Close_TCL_DECLARED
-#define Tcl_Close_TCL_DECLARED
+EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
+ ClientData clientData);
/* 81 */
-EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_CommandComplete_TCL_DECLARED
-#define Tcl_CommandComplete_TCL_DECLARED
+EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
-EXTERN int Tcl_CommandComplete _ANSI_ARGS_((CONST char * cmd));
-#endif
-#ifndef Tcl_Concat_TCL_DECLARED
-#define Tcl_Concat_TCL_DECLARED
+EXTERN int Tcl_CommandComplete(const char *cmd);
/* 83 */
-EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc,
- CONST84 char * CONST * argv));
-#endif
-#ifndef Tcl_ConvertElement_TCL_DECLARED
-#define Tcl_ConvertElement_TCL_DECLARED
+EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv);
/* 84 */
-EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src,
- char * dst, int flags));
-#endif
-#ifndef Tcl_ConvertCountedElement_TCL_DECLARED
-#define Tcl_ConvertCountedElement_TCL_DECLARED
+EXTERN int Tcl_ConvertElement(const char *src, char *dst,
+ int flags);
/* 85 */
-EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((
- CONST char * src, int length, char * dst,
- int flags));
-#endif
-#ifndef Tcl_CreateAlias_TCL_DECLARED
-#define Tcl_CreateAlias_TCL_DECLARED
+EXTERN int Tcl_ConvertCountedElement(const char *src,
+ int length, char *dst, int flags);
/* 86 */
-EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave,
- CONST char * slaveCmd, Tcl_Interp * target,
- CONST char * targetCmd, int argc,
- CONST84 char * CONST * argv));
-#endif
-#ifndef Tcl_CreateAliasObj_TCL_DECLARED
-#define Tcl_CreateAliasObj_TCL_DECLARED
+EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
+ const char *slaveCmd, Tcl_Interp *target,
+ const char *targetCmd, int argc,
+ CONST84 char *const *argv);
/* 87 */
-EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave,
- CONST char * slaveCmd, Tcl_Interp * target,
- CONST char * targetCmd, int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_CreateChannel_TCL_DECLARED
-#define Tcl_CreateChannel_TCL_DECLARED
+EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
+ const char *slaveCmd, Tcl_Interp *target,
+ const char *targetCmd, int objc,
+ Tcl_Obj *const objv[]);
/* 88 */
-EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_((
- Tcl_ChannelType * typePtr,
- CONST char * chanName,
- ClientData instanceData, int mask));
-#endif
-#ifndef Tcl_CreateChannelHandler_TCL_DECLARED
-#define Tcl_CreateChannelHandler_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
+ const char *chanName,
+ ClientData instanceData, int mask);
/* 89 */
-EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_((
- Tcl_Channel chan, int mask,
- Tcl_ChannelProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_CreateCloseHandler_TCL_DECLARED
-#define Tcl_CreateCloseHandler_TCL_DECLARED
+EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
+ Tcl_ChannelProc *proc, ClientData clientData);
/* 90 */
-EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_CloseProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_CreateCommand_TCL_DECLARED
-#define Tcl_CreateCommand_TCL_DECLARED
+EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan,
+ Tcl_CloseProc *proc, ClientData clientData);
/* 91 */
-EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmdName, Tcl_CmdProc * proc,
- ClientData clientData,
- Tcl_CmdDeleteProc * deleteProc));
-#endif
-#ifndef Tcl_CreateEventSource_TCL_DECLARED
-#define Tcl_CreateEventSource_TCL_DECLARED
+EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp,
+ const char *cmdName, Tcl_CmdProc *proc,
+ ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc);
/* 92 */
-EXTERN void Tcl_CreateEventSource _ANSI_ARGS_((
- Tcl_EventSetupProc * setupProc,
- Tcl_EventCheckProc * checkProc,
- ClientData clientData));
-#endif
-#ifndef Tcl_CreateExitHandler_TCL_DECLARED
-#define Tcl_CreateExitHandler_TCL_DECLARED
+EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
+ Tcl_EventCheckProc *checkProc,
+ ClientData clientData);
/* 93 */
-EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_((
- Tcl_ExitProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_CreateInterp_TCL_DECLARED
-#define Tcl_CreateInterp_TCL_DECLARED
+EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
/* 94 */
-EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_CreateMathFunc_TCL_DECLARED
-#define Tcl_CreateMathFunc_TCL_DECLARED
+EXTERN Tcl_Interp * Tcl_CreateInterp(void);
/* 95 */
-EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, int numArgs,
- Tcl_ValueType * argTypes,
- Tcl_MathProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_CreateObjCommand_TCL_DECLARED
-#define Tcl_CreateObjCommand_TCL_DECLARED
+EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp,
+ const char *name, int numArgs,
+ Tcl_ValueType *argTypes, Tcl_MathProc *proc,
+ ClientData clientData);
/* 96 */
-EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * cmdName,
- Tcl_ObjCmdProc * proc, ClientData clientData,
- Tcl_CmdDeleteProc * deleteProc));
-#endif
-#ifndef Tcl_CreateSlave_TCL_DECLARED
-#define Tcl_CreateSlave_TCL_DECLARED
+EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc *proc,
+ ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc);
/* 97 */
-EXTERN Tcl_Interp * Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * slaveName, int isSafe));
-#endif
-#ifndef Tcl_CreateTimerHandler_TCL_DECLARED
-#define Tcl_CreateTimerHandler_TCL_DECLARED
+EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
+ const char *slaveName, int isSafe);
/* 98 */
-EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
- Tcl_TimerProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_CreateTrace_TCL_DECLARED
-#define Tcl_CreateTrace_TCL_DECLARED
+EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
+ Tcl_TimerProc *proc, ClientData clientData);
/* 99 */
-EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp * interp,
- int level, Tcl_CmdTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DeleteAssocData_TCL_DECLARED
-#define Tcl_DeleteAssocData_TCL_DECLARED
+EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
+ Tcl_CmdTraceProc *proc,
+ ClientData clientData);
/* 100 */
-EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name));
-#endif
-#ifndef Tcl_DeleteChannelHandler_TCL_DECLARED
-#define Tcl_DeleteChannelHandler_TCL_DECLARED
+EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp,
+ const char *name);
/* 101 */
-EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_((
- Tcl_Channel chan, Tcl_ChannelProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DeleteCloseHandler_TCL_DECLARED
-#define Tcl_DeleteCloseHandler_TCL_DECLARED
+EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan,
+ Tcl_ChannelProc *proc, ClientData clientData);
/* 102 */
-EXTERN void Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_CloseProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_DeleteCommand_TCL_DECLARED
-#define Tcl_DeleteCommand_TCL_DECLARED
+EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan,
+ Tcl_CloseProc *proc, ClientData clientData);
/* 103 */
-EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmdName));
-#endif
-#ifndef Tcl_DeleteCommandFromToken_TCL_DECLARED
-#define Tcl_DeleteCommandFromToken_TCL_DECLARED
+EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp,
+ const char *cmdName);
/* 104 */
-EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command command));
-#endif
-#ifndef Tcl_DeleteEvents_TCL_DECLARED
-#define Tcl_DeleteEvents_TCL_DECLARED
+EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
+ Tcl_Command command);
/* 105 */
-EXTERN void Tcl_DeleteEvents _ANSI_ARGS_((
- Tcl_EventDeleteProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DeleteEventSource_TCL_DECLARED
-#define Tcl_DeleteEventSource_TCL_DECLARED
+EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
+ ClientData clientData);
/* 106 */
-EXTERN void Tcl_DeleteEventSource _ANSI_ARGS_((
- Tcl_EventSetupProc * setupProc,
- Tcl_EventCheckProc * checkProc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DeleteExitHandler_TCL_DECLARED
-#define Tcl_DeleteExitHandler_TCL_DECLARED
+EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
+ Tcl_EventCheckProc *checkProc,
+ ClientData clientData);
/* 107 */
-EXTERN void Tcl_DeleteExitHandler _ANSI_ARGS_((
- Tcl_ExitProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_DeleteHashEntry_TCL_DECLARED
-#define Tcl_DeleteHashEntry_TCL_DECLARED
+EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
/* 108 */
-EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_((
- Tcl_HashEntry * entryPtr));
-#endif
-#ifndef Tcl_DeleteHashTable_TCL_DECLARED
-#define Tcl_DeleteHashTable_TCL_DECLARED
+EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
-EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_((
- Tcl_HashTable * tablePtr));
-#endif
-#ifndef Tcl_DeleteInterp_TCL_DECLARED
-#define Tcl_DeleteInterp_TCL_DECLARED
+EXTERN void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
-EXTERN void Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_DetachPids_TCL_DECLARED
-#define Tcl_DetachPids_TCL_DECLARED
+EXTERN void Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
-EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids,
- Tcl_Pid * pidPtr));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_DetachPids_TCL_DECLARED
-#define Tcl_DetachPids_TCL_DECLARED
-/* 111 */
-EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids,
- Tcl_Pid * pidPtr));
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_DeleteTimerHandler_TCL_DECLARED
-#define Tcl_DeleteTimerHandler_TCL_DECLARED
+EXTERN void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
-EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_((
- Tcl_TimerToken token));
-#endif
-#ifndef Tcl_DeleteTrace_TCL_DECLARED
-#define Tcl_DeleteTrace_TCL_DECLARED
+EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
-EXTERN void Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Trace trace));
-#endif
-#ifndef Tcl_DontCallWhenDeleted_TCL_DECLARED
-#define Tcl_DontCallWhenDeleted_TCL_DECLARED
+EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
-EXTERN void Tcl_DontCallWhenDeleted _ANSI_ARGS_((
- Tcl_Interp * interp,
- Tcl_InterpDeleteProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DoOneEvent_TCL_DECLARED
-#define Tcl_DoOneEvent_TCL_DECLARED
+EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
+ Tcl_InterpDeleteProc *proc,
+ ClientData clientData);
/* 115 */
-EXTERN int Tcl_DoOneEvent _ANSI_ARGS_((int flags));
-#endif
-#ifndef Tcl_DoWhenIdle_TCL_DECLARED
-#define Tcl_DoWhenIdle_TCL_DECLARED
+EXTERN int Tcl_DoOneEvent(int flags);
/* 116 */
-EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_DStringAppend_TCL_DECLARED
-#define Tcl_DStringAppend_TCL_DECLARED
+EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc,
+ ClientData clientData);
/* 117 */
-EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr,
- CONST char * bytes, int length));
-#endif
-#ifndef Tcl_DStringAppendElement_TCL_DECLARED
-#define Tcl_DStringAppendElement_TCL_DECLARED
+EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr,
+ const char *bytes, int length);
/* 118 */
-EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_((
- Tcl_DString * dsPtr, CONST char * element));
-#endif
-#ifndef Tcl_DStringEndSublist_TCL_DECLARED
-#define Tcl_DStringEndSublist_TCL_DECLARED
+EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr,
+ const char *element);
/* 119 */
-EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_((
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_DStringFree_TCL_DECLARED
-#define Tcl_DStringFree_TCL_DECLARED
+EXTERN void Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
-EXTERN void Tcl_DStringFree _ANSI_ARGS_((Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_DStringGetResult_TCL_DECLARED
-#define Tcl_DStringGetResult_TCL_DECLARED
+EXTERN void Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
-EXTERN void Tcl_DStringGetResult _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_DStringInit_TCL_DECLARED
-#define Tcl_DStringInit_TCL_DECLARED
+EXTERN void Tcl_DStringGetResult(Tcl_Interp *interp,
+ Tcl_DString *dsPtr);
/* 122 */
-EXTERN void Tcl_DStringInit _ANSI_ARGS_((Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_DStringResult_TCL_DECLARED
-#define Tcl_DStringResult_TCL_DECLARED
+EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
-EXTERN void Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_DStringSetLength_TCL_DECLARED
-#define Tcl_DStringSetLength_TCL_DECLARED
+EXTERN void Tcl_DStringResult(Tcl_Interp *interp,
+ Tcl_DString *dsPtr);
/* 124 */
-EXTERN void Tcl_DStringSetLength _ANSI_ARGS_((
- Tcl_DString * dsPtr, int length));
-#endif
-#ifndef Tcl_DStringStartSublist_TCL_DECLARED
-#define Tcl_DStringStartSublist_TCL_DECLARED
+EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
/* 125 */
-EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_Eof_TCL_DECLARED
-#define Tcl_Eof_TCL_DECLARED
+EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
-EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_ErrnoId_TCL_DECLARED
-#define Tcl_ErrnoId_TCL_DECLARED
+EXTERN int Tcl_Eof(Tcl_Channel chan);
/* 127 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_ErrnoMsg_TCL_DECLARED
-#define Tcl_ErrnoMsg_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
/* 128 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
-#endif
-#ifndef Tcl_Eval_TCL_DECLARED
-#define Tcl_Eval_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
/* 129 */
-EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * script));
-#endif
-#ifndef Tcl_EvalFile_TCL_DECLARED
-#define Tcl_EvalFile_TCL_DECLARED
+EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
-EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * fileName));
-#endif
-#ifndef Tcl_EvalObj_TCL_DECLARED
-#define Tcl_EvalObj_TCL_DECLARED
+EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
+ const char *fileName);
/* 131 */
-EXTERN int Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_EventuallyFree_TCL_DECLARED
-#define Tcl_EventuallyFree_TCL_DECLARED
+EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
-EXTERN void Tcl_EventuallyFree _ANSI_ARGS_((
- ClientData clientData,
- Tcl_FreeProc * freeProc));
-#endif
-#ifndef Tcl_Exit_TCL_DECLARED
-#define Tcl_Exit_TCL_DECLARED
+EXTERN void Tcl_EventuallyFree(ClientData clientData,
+ Tcl_FreeProc *freeProc);
/* 133 */
-EXTERN void Tcl_Exit _ANSI_ARGS_((int status));
-#endif
-#ifndef Tcl_ExposeCommand_TCL_DECLARED
-#define Tcl_ExposeCommand_TCL_DECLARED
+EXTERN void Tcl_Exit(int status);
/* 134 */
-EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * hiddenCmdToken,
- CONST char * cmdName));
-#endif
-#ifndef Tcl_ExprBoolean_TCL_DECLARED
-#define Tcl_ExprBoolean_TCL_DECLARED
+EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp,
+ const char *hiddenCmdToken,
+ const char *cmdName);
/* 135 */
-EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * expr, int * ptr));
-#endif
-#ifndef Tcl_ExprBooleanObj_TCL_DECLARED
-#define Tcl_ExprBooleanObj_TCL_DECLARED
+EXTERN int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr,
+ int *ptr);
/* 136 */
-EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, int * ptr));
-#endif
-#ifndef Tcl_ExprDouble_TCL_DECLARED
-#define Tcl_ExprDouble_TCL_DECLARED
+EXTERN int Tcl_ExprBooleanObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *ptr);
/* 137 */
-EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * expr, double * ptr));
-#endif
-#ifndef Tcl_ExprDoubleObj_TCL_DECLARED
-#define Tcl_ExprDoubleObj_TCL_DECLARED
+EXTERN int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr,
+ double *ptr);
/* 138 */
-EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, double * ptr));
-#endif
-#ifndef Tcl_ExprLong_TCL_DECLARED
-#define Tcl_ExprLong_TCL_DECLARED
+EXTERN int Tcl_ExprDoubleObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, double *ptr);
/* 139 */
-EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * expr, long * ptr));
-#endif
-#ifndef Tcl_ExprLongObj_TCL_DECLARED
-#define Tcl_ExprLongObj_TCL_DECLARED
+EXTERN int Tcl_ExprLong(Tcl_Interp *interp, const char *expr,
+ long *ptr);
/* 140 */
-EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, long * ptr));
-#endif
-#ifndef Tcl_ExprObj_TCL_DECLARED
-#define Tcl_ExprObj_TCL_DECLARED
+EXTERN int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ long *ptr);
/* 141 */
-EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr));
-#endif
-#ifndef Tcl_ExprString_TCL_DECLARED
-#define Tcl_ExprString_TCL_DECLARED
+EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tcl_Obj **resultPtrPtr);
/* 142 */
-EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * expr));
-#endif
-#ifndef Tcl_Finalize_TCL_DECLARED
-#define Tcl_Finalize_TCL_DECLARED
+EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
-EXTERN void Tcl_Finalize _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_FindExecutable_TCL_DECLARED
-#define Tcl_FindExecutable_TCL_DECLARED
+EXTERN void Tcl_Finalize(void);
/* 144 */
-EXTERN void Tcl_FindExecutable _ANSI_ARGS_((CONST char * argv0));
-#endif
-#ifndef Tcl_FirstHashEntry_TCL_DECLARED
-#define Tcl_FirstHashEntry_TCL_DECLARED
+EXTERN void Tcl_FindExecutable(const char *argv0);
/* 145 */
-EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
- Tcl_HashTable * tablePtr,
- Tcl_HashSearch * searchPtr));
-#endif
-#ifndef Tcl_Flush_TCL_DECLARED
-#define Tcl_Flush_TCL_DECLARED
+EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
+ Tcl_HashSearch *searchPtr);
/* 146 */
-EXTERN int Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_FreeResult_TCL_DECLARED
-#define Tcl_FreeResult_TCL_DECLARED
+EXTERN int Tcl_Flush(Tcl_Channel chan);
/* 147 */
-EXTERN void Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetAlias_TCL_DECLARED
-#define Tcl_GetAlias_TCL_DECLARED
+EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
-EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * slaveCmd,
- Tcl_Interp ** targetInterpPtr,
- CONST84 char ** targetCmdPtr, int * argcPtr,
- CONST84 char *** argvPtr));
-#endif
-#ifndef Tcl_GetAliasObj_TCL_DECLARED
-#define Tcl_GetAliasObj_TCL_DECLARED
+EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
+ const char *slaveCmd,
+ Tcl_Interp **targetInterpPtr,
+ CONST84 char **targetCmdPtr, int *argcPtr,
+ CONST84 char ***argvPtr);
/* 149 */
-EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * slaveCmd,
- Tcl_Interp ** targetInterpPtr,
- CONST84 char ** targetCmdPtr, int * objcPtr,
- Tcl_Obj *** objv));
-#endif
-#ifndef Tcl_GetAssocData_TCL_DECLARED
-#define Tcl_GetAssocData_TCL_DECLARED
+EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
+ const char *slaveCmd,
+ Tcl_Interp **targetInterpPtr,
+ CONST84 char **targetCmdPtr, int *objcPtr,
+ Tcl_Obj ***objv);
/* 150 */
-EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_InterpDeleteProc ** procPtr));
-#endif
-#ifndef Tcl_GetChannel_TCL_DECLARED
-#define Tcl_GetChannel_TCL_DECLARED
+EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp,
+ const char *name,
+ Tcl_InterpDeleteProc **procPtr);
/* 151 */
-EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * chanName, int * modePtr));
-#endif
-#ifndef Tcl_GetChannelBufferSize_TCL_DECLARED
-#define Tcl_GetChannelBufferSize_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp,
+ const char *chanName, int *modePtr);
/* 152 */
-EXTERN int Tcl_GetChannelBufferSize _ANSI_ARGS_((
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetChannelHandle_TCL_DECLARED
-#define Tcl_GetChannelHandle_TCL_DECLARED
+EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
-EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
- int direction, ClientData * handlePtr));
-#endif
-#ifndef Tcl_GetChannelInstanceData_TCL_DECLARED
-#define Tcl_GetChannelInstanceData_TCL_DECLARED
+EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
+ ClientData *handlePtr);
/* 154 */
-EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_((
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetChannelMode_TCL_DECLARED
-#define Tcl_GetChannelMode_TCL_DECLARED
+EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
-EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetChannelName_TCL_DECLARED
-#define Tcl_GetChannelName_TCL_DECLARED
+EXTERN int Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
-EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_((
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetChannelOption_TCL_DECLARED
-#define Tcl_GetChannelOption_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
-EXTERN int Tcl_GetChannelOption _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Channel chan,
- CONST char * optionName, Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_GetChannelType_TCL_DECLARED
-#define Tcl_GetChannelType_TCL_DECLARED
+EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
+ Tcl_Channel chan, const char *optionName,
+ Tcl_DString *dsPtr);
/* 158 */
-EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetCommandInfo_TCL_DECLARED
-#define Tcl_GetCommandInfo_TCL_DECLARED
+EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
-EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmdName, Tcl_CmdInfo * infoPtr));
-#endif
-#ifndef Tcl_GetCommandName_TCL_DECLARED
-#define Tcl_GetCommandName_TCL_DECLARED
+EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
+ const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
-EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command command));
-#endif
-#ifndef Tcl_GetErrno_TCL_DECLARED
-#define Tcl_GetErrno_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+ Tcl_Command command);
/* 161 */
-EXTERN int Tcl_GetErrno _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetHostName_TCL_DECLARED
-#define Tcl_GetHostName_TCL_DECLARED
+EXTERN int Tcl_GetErrno(void);
/* 162 */
-EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetInterpPath_TCL_DECLARED
-#define Tcl_GetInterpPath_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
/* 163 */
-EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((
- Tcl_Interp * askInterp,
- Tcl_Interp * slaveInterp));
-#endif
-#ifndef Tcl_GetMaster_TCL_DECLARED
-#define Tcl_GetMaster_TCL_DECLARED
+EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
+ Tcl_Interp *slaveInterp);
/* 164 */
-EXTERN Tcl_Interp * Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetNameOfExecutable_TCL_DECLARED
-#define Tcl_GetNameOfExecutable_TCL_DECLARED
+EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
/* 165 */
-EXTERN CONST char * Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetObjResult_TCL_DECLARED
-#define Tcl_GetObjResult_TCL_DECLARED
+EXTERN const char * Tcl_GetNameOfExecutable(void);
/* 166 */
-EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_GetOpenFile_TCL_DECLARED
-#define Tcl_GetOpenFile_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
-EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * chanID, int forWriting,
- int checkUsage, ClientData * filePtr));
-#endif
+EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
+ const char *chanID, int forWriting,
+ int checkUsage, ClientData *filePtr);
#endif /* UNIX */
-#ifndef Tcl_GetPathType_TCL_DECLARED
-#define Tcl_GetPathType_TCL_DECLARED
+#ifdef MAC_OSX_TCL /* MACOSX */
+/* 167 */
+EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
+ const char *chanID, int forWriting,
+ int checkUsage, ClientData *filePtr);
+#endif /* MACOSX */
/* 168 */
-EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((CONST char * path));
-#endif
-#ifndef Tcl_Gets_TCL_DECLARED
-#define Tcl_Gets_TCL_DECLARED
+EXTERN Tcl_PathType Tcl_GetPathType(const char *path);
/* 169 */
-EXTERN int Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_GetsObj_TCL_DECLARED
-#define Tcl_GetsObj_TCL_DECLARED
+EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
-EXTERN int Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetServiceMode_TCL_DECLARED
-#define Tcl_GetServiceMode_TCL_DECLARED
+EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
-EXTERN int Tcl_GetServiceMode _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetSlave_TCL_DECLARED
-#define Tcl_GetSlave_TCL_DECLARED
+EXTERN int Tcl_GetServiceMode(void);
/* 172 */
-EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * slaveName));
-#endif
-#ifndef Tcl_GetStdChannel_TCL_DECLARED
-#define Tcl_GetStdChannel_TCL_DECLARED
+EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
+ const char *slaveName);
/* 173 */
-EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type));
-#endif
-#ifndef Tcl_GetStringResult_TCL_DECLARED
-#define Tcl_GetStringResult_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
-EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetVar_TCL_DECLARED
-#define Tcl_GetVar_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
/* 175 */
-EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags));
-#endif
-#ifndef Tcl_GetVar2_TCL_DECLARED
-#define Tcl_GetVar2_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
+ const char *varName, int flags);
/* 176 */
-EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags));
-#endif
-#ifndef Tcl_GlobalEval_TCL_DECLARED
-#define Tcl_GlobalEval_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
+ const char *part1, const char *part2,
+ int flags);
/* 177 */
-EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * command));
-#endif
-#ifndef Tcl_GlobalEvalObj_TCL_DECLARED
-#define Tcl_GlobalEvalObj_TCL_DECLARED
+EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
+ const char *command);
/* 178 */
-EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_HideCommand_TCL_DECLARED
-#define Tcl_HideCommand_TCL_DECLARED
+EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
/* 179 */
-EXTERN int Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmdName,
- CONST char * hiddenCmdToken));
-#endif
-#ifndef Tcl_Init_TCL_DECLARED
-#define Tcl_Init_TCL_DECLARED
+EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
+ const char *cmdName,
+ const char *hiddenCmdToken);
/* 180 */
-EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_InitHashTable_TCL_DECLARED
-#define Tcl_InitHashTable_TCL_DECLARED
+EXTERN int Tcl_Init(Tcl_Interp *interp);
/* 181 */
-EXTERN void Tcl_InitHashTable _ANSI_ARGS_((
- Tcl_HashTable * tablePtr, int keyType));
-#endif
-#ifndef Tcl_InputBlocked_TCL_DECLARED
-#define Tcl_InputBlocked_TCL_DECLARED
+EXTERN void Tcl_InitHashTable(Tcl_HashTable *tablePtr,
+ int keyType);
/* 182 */
-EXTERN int Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_InputBuffered_TCL_DECLARED
-#define Tcl_InputBuffered_TCL_DECLARED
+EXTERN int Tcl_InputBlocked(Tcl_Channel chan);
/* 183 */
-EXTERN int Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_InterpDeleted_TCL_DECLARED
-#define Tcl_InterpDeleted_TCL_DECLARED
+EXTERN int Tcl_InputBuffered(Tcl_Channel chan);
/* 184 */
-EXTERN int Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_IsSafe_TCL_DECLARED
-#define Tcl_IsSafe_TCL_DECLARED
+EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp);
/* 185 */
-EXTERN int Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_JoinPath_TCL_DECLARED
-#define Tcl_JoinPath_TCL_DECLARED
+EXTERN int Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
-EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc,
- CONST84 char * CONST * argv,
- Tcl_DString * resultPtr));
-#endif
-#ifndef Tcl_LinkVar_TCL_DECLARED
-#define Tcl_LinkVar_TCL_DECLARED
+EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv,
+ Tcl_DString *resultPtr);
/* 187 */
-EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, char * addr, int type));
-#endif
+EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
+ char *addr, int type);
/* Slot 188 is reserved */
-#ifndef Tcl_MakeFileChannel_TCL_DECLARED
-#define Tcl_MakeFileChannel_TCL_DECLARED
/* 189 */
-EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
- int mode));
-#endif
-#ifndef Tcl_MakeSafe_TCL_DECLARED
-#define Tcl_MakeSafe_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
-EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_MakeTcpClientChannel_TCL_DECLARED
-#define Tcl_MakeTcpClientChannel_TCL_DECLARED
+EXTERN int Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
-EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_((
- ClientData tcpSocket));
-#endif
-#ifndef Tcl_Merge_TCL_DECLARED
-#define Tcl_Merge_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
-EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc,
- CONST84 char * CONST * argv));
-#endif
-#ifndef Tcl_NextHashEntry_TCL_DECLARED
-#define Tcl_NextHashEntry_TCL_DECLARED
+EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv);
/* 193 */
-EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
- Tcl_HashSearch * searchPtr));
-#endif
-#ifndef Tcl_NotifyChannel_TCL_DECLARED
-#define Tcl_NotifyChannel_TCL_DECLARED
+EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
-EXTERN void Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
- int mask));
-#endif
-#ifndef Tcl_ObjGetVar2_TCL_DECLARED
-#define Tcl_ObjGetVar2_TCL_DECLARED
+EXTERN void Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */
-EXTERN Tcl_Obj * Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
- int flags));
-#endif
-#ifndef Tcl_ObjSetVar2_TCL_DECLARED
-#define Tcl_ObjSetVar2_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, int flags);
/* 196 */
-EXTERN Tcl_Obj * Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
- Tcl_Obj * newValuePtr, int flags));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_OpenCommandChannel_TCL_DECLARED
-#define Tcl_OpenCommandChannel_TCL_DECLARED
-/* 197 */
-EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
- Tcl_Interp * interp, int argc,
- CONST84 char ** argv, int flags));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_OpenCommandChannel_TCL_DECLARED
-#define Tcl_OpenCommandChannel_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
+ int flags);
/* 197 */
-EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
- Tcl_Interp * interp, int argc,
- CONST84 char ** argv, int flags));
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_OpenFileChannel_TCL_DECLARED
-#define Tcl_OpenFileChannel_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
+ CONST84 char **argv, int flags);
/* 198 */
-EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * fileName,
- CONST char * modeString, int permissions));
-#endif
-#ifndef Tcl_OpenTcpClient_TCL_DECLARED
-#define Tcl_OpenTcpClient_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
+ const char *fileName, const char *modeString,
+ int permissions);
/* 199 */
-EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp * interp,
- int port, CONST char * address,
- CONST char * myaddr, int myport, int async));
-#endif
-#ifndef Tcl_OpenTcpServer_TCL_DECLARED
-#define Tcl_OpenTcpServer_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
+ const char *address, const char *myaddr,
+ int myport, int async);
/* 200 */
-EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp * interp,
- int port, CONST char * host,
- Tcl_TcpAcceptProc * acceptProc,
- ClientData callbackData));
-#endif
-#ifndef Tcl_Preserve_TCL_DECLARED
-#define Tcl_Preserve_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
+ const char *host,
+ Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData);
/* 201 */
-EXTERN void Tcl_Preserve _ANSI_ARGS_((ClientData data));
-#endif
-#ifndef Tcl_PrintDouble_TCL_DECLARED
-#define Tcl_PrintDouble_TCL_DECLARED
+EXTERN void Tcl_Preserve(ClientData data);
/* 202 */
-EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp,
- double value, char * dst));
-#endif
-#ifndef Tcl_PutEnv_TCL_DECLARED
-#define Tcl_PutEnv_TCL_DECLARED
+EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value,
+ char *dst);
/* 203 */
-EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * assignment));
-#endif
-#ifndef Tcl_PosixError_TCL_DECLARED
-#define Tcl_PosixError_TCL_DECLARED
+EXTERN int Tcl_PutEnv(const char *assignment);
/* 204 */
-EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_QueueEvent_TCL_DECLARED
-#define Tcl_QueueEvent_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
-EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr,
- Tcl_QueuePosition position));
-#endif
-#ifndef Tcl_Read_TCL_DECLARED
-#define Tcl_Read_TCL_DECLARED
+EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
+ Tcl_QueuePosition position);
/* 206 */
-EXTERN int Tcl_Read _ANSI_ARGS_((Tcl_Channel chan,
- char * bufPtr, int toRead));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_ReapDetachedProcs_TCL_DECLARED
-#define Tcl_ReapDetachedProcs_TCL_DECLARED
-/* 207 */
-EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_ReapDetachedProcs_TCL_DECLARED
-#define Tcl_ReapDetachedProcs_TCL_DECLARED
+EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
/* 207 */
-EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_RecordAndEval_TCL_DECLARED
-#define Tcl_RecordAndEval_TCL_DECLARED
+EXTERN void Tcl_ReapDetachedProcs(void);
/* 208 */
-EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmd, int flags));
-#endif
-#ifndef Tcl_RecordAndEvalObj_TCL_DECLARED
-#define Tcl_RecordAndEvalObj_TCL_DECLARED
+EXTERN int Tcl_RecordAndEval(Tcl_Interp *interp,
+ const char *cmd, int flags);
/* 209 */
-EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * cmdPtr,
- int flags));
-#endif
-#ifndef Tcl_RegisterChannel_TCL_DECLARED
-#define Tcl_RegisterChannel_TCL_DECLARED
+EXTERN int Tcl_RecordAndEvalObj(Tcl_Interp *interp,
+ Tcl_Obj *cmdPtr, int flags);
/* 210 */
-EXTERN void Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_RegisterObjType_TCL_DECLARED
-#define Tcl_RegisterObjType_TCL_DECLARED
+EXTERN void Tcl_RegisterChannel(Tcl_Interp *interp,
+ Tcl_Channel chan);
/* 211 */
-EXTERN void Tcl_RegisterObjType _ANSI_ARGS_((
- Tcl_ObjType * typePtr));
-#endif
-#ifndef Tcl_RegExpCompile_TCL_DECLARED
-#define Tcl_RegExpCompile_TCL_DECLARED
+EXTERN void Tcl_RegisterObjType(const Tcl_ObjType *typePtr);
/* 212 */
-EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * pattern));
-#endif
-#ifndef Tcl_RegExpExec_TCL_DECLARED
-#define Tcl_RegExpExec_TCL_DECLARED
+EXTERN Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp,
+ const char *pattern);
/* 213 */
-EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_RegExp regexp, CONST char * text,
- CONST char * start));
-#endif
-#ifndef Tcl_RegExpMatch_TCL_DECLARED
-#define Tcl_RegExpMatch_TCL_DECLARED
+EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
+ const char *text, const char *start);
/* 214 */
-EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * text, CONST char * pattern));
-#endif
-#ifndef Tcl_RegExpRange_TCL_DECLARED
-#define Tcl_RegExpRange_TCL_DECLARED
+EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
+ const char *pattern);
/* 215 */
-EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
- int index, CONST84 char ** startPtr,
- CONST84 char ** endPtr));
-#endif
-#ifndef Tcl_Release_TCL_DECLARED
-#define Tcl_Release_TCL_DECLARED
+EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
+ CONST84 char **startPtr,
+ CONST84 char **endPtr);
/* 216 */
-EXTERN void Tcl_Release _ANSI_ARGS_((ClientData clientData));
-#endif
-#ifndef Tcl_ResetResult_TCL_DECLARED
-#define Tcl_ResetResult_TCL_DECLARED
+EXTERN void Tcl_Release(ClientData clientData);
/* 217 */
-EXTERN void Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_ScanElement_TCL_DECLARED
-#define Tcl_ScanElement_TCL_DECLARED
+EXTERN void Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
-EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str,
- int * flagPtr));
-#endif
-#ifndef Tcl_ScanCountedElement_TCL_DECLARED
-#define Tcl_ScanCountedElement_TCL_DECLARED
+EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
-EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char * str,
- int length, int * flagPtr));
-#endif
-#ifndef Tcl_SeekOld_TCL_DECLARED
-#define Tcl_SeekOld_TCL_DECLARED
+EXTERN int Tcl_ScanCountedElement(const char *src, int length,
+ int *flagPtr);
/* 220 */
-EXTERN int Tcl_SeekOld _ANSI_ARGS_((Tcl_Channel chan,
- int offset, int mode));
-#endif
-#ifndef Tcl_ServiceAll_TCL_DECLARED
-#define Tcl_ServiceAll_TCL_DECLARED
+EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
-EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_ServiceEvent_TCL_DECLARED
-#define Tcl_ServiceEvent_TCL_DECLARED
+EXTERN int Tcl_ServiceAll(void);
/* 222 */
-EXTERN int Tcl_ServiceEvent _ANSI_ARGS_((int flags));
-#endif
-#ifndef Tcl_SetAssocData_TCL_DECLARED
-#define Tcl_SetAssocData_TCL_DECLARED
+EXTERN int Tcl_ServiceEvent(int flags);
/* 223 */
-EXTERN void Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_InterpDeleteProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_SetChannelBufferSize_TCL_DECLARED
-#define Tcl_SetChannelBufferSize_TCL_DECLARED
+EXTERN void Tcl_SetAssocData(Tcl_Interp *interp,
+ const char *name, Tcl_InterpDeleteProc *proc,
+ ClientData clientData);
/* 224 */
-EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_((
- Tcl_Channel chan, int sz));
-#endif
-#ifndef Tcl_SetChannelOption_TCL_DECLARED
-#define Tcl_SetChannelOption_TCL_DECLARED
+EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
-EXTERN int Tcl_SetChannelOption _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Channel chan,
- CONST char * optionName,
- CONST char * newValue));
-#endif
-#ifndef Tcl_SetCommandInfo_TCL_DECLARED
-#define Tcl_SetCommandInfo_TCL_DECLARED
+EXTERN int Tcl_SetChannelOption(Tcl_Interp *interp,
+ Tcl_Channel chan, const char *optionName,
+ const char *newValue);
/* 226 */
-EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * cmdName,
- CONST Tcl_CmdInfo * infoPtr));
-#endif
-#ifndef Tcl_SetErrno_TCL_DECLARED
-#define Tcl_SetErrno_TCL_DECLARED
+EXTERN int Tcl_SetCommandInfo(Tcl_Interp *interp,
+ const char *cmdName,
+ const Tcl_CmdInfo *infoPtr);
/* 227 */
-EXTERN void Tcl_SetErrno _ANSI_ARGS_((int err));
-#endif
-#ifndef Tcl_SetErrorCode_TCL_DECLARED
-#define Tcl_SetErrorCode_TCL_DECLARED
+EXTERN void Tcl_SetErrno(int err);
/* 228 */
-EXTERN void Tcl_SetErrorCode _ANSI_ARGS_((Tcl_Interp *interp, ...));
-#endif
-#ifndef Tcl_SetMaxBlockTime_TCL_DECLARED
-#define Tcl_SetMaxBlockTime_TCL_DECLARED
+EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
-EXTERN void Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time * timePtr));
-#endif
-#ifndef Tcl_SetPanicProc_TCL_DECLARED
-#define Tcl_SetPanicProc_TCL_DECLARED
+EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
-EXTERN void Tcl_SetPanicProc _ANSI_ARGS_((
- Tcl_PanicProc * panicProc));
-#endif
-#ifndef Tcl_SetRecursionLimit_TCL_DECLARED
-#define Tcl_SetRecursionLimit_TCL_DECLARED
+EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
/* 231 */
-EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_((
- Tcl_Interp * interp, int depth));
-#endif
-#ifndef Tcl_SetResult_TCL_DECLARED
-#define Tcl_SetResult_TCL_DECLARED
+EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* 232 */
-EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp,
- char * result, Tcl_FreeProc * freeProc));
-#endif
-#ifndef Tcl_SetServiceMode_TCL_DECLARED
-#define Tcl_SetServiceMode_TCL_DECLARED
+EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result,
+ Tcl_FreeProc *freeProc);
/* 233 */
-EXTERN int Tcl_SetServiceMode _ANSI_ARGS_((int mode));
-#endif
-#ifndef Tcl_SetObjErrorCode_TCL_DECLARED
-#define Tcl_SetObjErrorCode_TCL_DECLARED
+EXTERN int Tcl_SetServiceMode(int mode);
/* 234 */
-EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * errorObjPtr));
-#endif
-#ifndef Tcl_SetObjResult_TCL_DECLARED
-#define Tcl_SetObjResult_TCL_DECLARED
+EXTERN void Tcl_SetObjErrorCode(Tcl_Interp *interp,
+ Tcl_Obj *errorObjPtr);
/* 235 */
-EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * resultObjPtr));
-#endif
-#ifndef Tcl_SetStdChannel_TCL_DECLARED
-#define Tcl_SetStdChannel_TCL_DECLARED
+EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
+ Tcl_Obj *resultObjPtr);
/* 236 */
-EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
- int type));
-#endif
-#ifndef Tcl_SetVar_TCL_DECLARED
-#define Tcl_SetVar_TCL_DECLARED
+EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* 237 */
-EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, CONST char * newValue,
- int flags));
-#endif
-#ifndef Tcl_SetVar2_TCL_DECLARED
-#define Tcl_SetVar2_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
+ const char *varName, const char *newValue,
+ int flags);
/* 238 */
-EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- CONST char * newValue, int flags));
-#endif
-#ifndef Tcl_SignalId_TCL_DECLARED
-#define Tcl_SignalId_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
+ const char *part1, const char *part2,
+ const char *newValue, int flags);
/* 239 */
-EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig));
-#endif
-#ifndef Tcl_SignalMsg_TCL_DECLARED
-#define Tcl_SignalMsg_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
/* 240 */
-EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
-#endif
-#ifndef Tcl_SourceRCFile_TCL_DECLARED
-#define Tcl_SourceRCFile_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
/* 241 */
-EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_SplitList_TCL_DECLARED
-#define Tcl_SplitList_TCL_DECLARED
+EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
-EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * listStr, int * argcPtr,
- CONST84 char *** argvPtr));
-#endif
-#ifndef Tcl_SplitPath_TCL_DECLARED
-#define Tcl_SplitPath_TCL_DECLARED
+EXTERN int Tcl_SplitList(Tcl_Interp *interp,
+ const char *listStr, int *argcPtr,
+ CONST84 char ***argvPtr);
/* 243 */
-EXTERN void Tcl_SplitPath _ANSI_ARGS_((CONST char * path,
- int * argcPtr, CONST84 char *** argvPtr));
-#endif
-#ifndef Tcl_StaticPackage_TCL_DECLARED
-#define Tcl_StaticPackage_TCL_DECLARED
+EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
+ CONST84 char ***argvPtr);
/* 244 */
-EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * pkgName,
- Tcl_PackageInitProc * initProc,
- Tcl_PackageInitProc * safeInitProc));
-#endif
-#ifndef Tcl_StringMatch_TCL_DECLARED
-#define Tcl_StringMatch_TCL_DECLARED
+EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
+ const char *pkgName,
+ Tcl_PackageInitProc *initProc,
+ Tcl_PackageInitProc *safeInitProc);
/* 245 */
-EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str,
- CONST char * pattern));
-#endif
-#ifndef Tcl_TellOld_TCL_DECLARED
-#define Tcl_TellOld_TCL_DECLARED
+EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
-EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_TraceVar_TCL_DECLARED
-#define Tcl_TraceVar_TCL_DECLARED
+EXTERN int Tcl_TellOld(Tcl_Channel chan);
/* 247 */
-EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags,
- Tcl_VarTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_TraceVar2_TCL_DECLARED
-#define Tcl_TraceVar2_TCL_DECLARED
+EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
+ int flags, Tcl_VarTraceProc *proc,
+ ClientData clientData);
/* 248 */
-EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags, Tcl_VarTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_TranslateFileName_TCL_DECLARED
-#define Tcl_TranslateFileName_TCL_DECLARED
+EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags,
+ Tcl_VarTraceProc *proc,
+ ClientData clientData);
/* 249 */
-EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- Tcl_DString * bufferPtr));
-#endif
-#ifndef Tcl_Ungets_TCL_DECLARED
-#define Tcl_Ungets_TCL_DECLARED
+EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp,
+ const char *name, Tcl_DString *bufferPtr);
/* 250 */
-EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan,
- CONST char * str, int len, int atHead));
-#endif
-#ifndef Tcl_UnlinkVar_TCL_DECLARED
-#define Tcl_UnlinkVar_TCL_DECLARED
+EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str,
+ int len, int atHead);
/* 251 */
-EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName));
-#endif
-#ifndef Tcl_UnregisterChannel_TCL_DECLARED
-#define Tcl_UnregisterChannel_TCL_DECLARED
+EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp,
+ const char *varName);
/* 252 */
-EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Channel chan));
-#endif
-#ifndef Tcl_UnsetVar_TCL_DECLARED
-#define Tcl_UnsetVar_TCL_DECLARED
+EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp,
+ Tcl_Channel chan);
/* 253 */
-EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags));
-#endif
-#ifndef Tcl_UnsetVar2_TCL_DECLARED
-#define Tcl_UnsetVar2_TCL_DECLARED
+EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
+ int flags);
/* 254 */
-EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags));
-#endif
-#ifndef Tcl_UntraceVar_TCL_DECLARED
-#define Tcl_UntraceVar_TCL_DECLARED
+EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags);
/* 255 */
-EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags,
- Tcl_VarTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_UntraceVar2_TCL_DECLARED
-#define Tcl_UntraceVar2_TCL_DECLARED
+EXTERN void Tcl_UntraceVar(Tcl_Interp *interp,
+ const char *varName, int flags,
+ Tcl_VarTraceProc *proc,
+ ClientData clientData);
/* 256 */
-EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags, Tcl_VarTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_UpdateLinkedVar_TCL_DECLARED
-#define Tcl_UpdateLinkedVar_TCL_DECLARED
+EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp,
+ const char *part1, const char *part2,
+ int flags, Tcl_VarTraceProc *proc,
+ ClientData clientData);
/* 257 */
-EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName));
-#endif
-#ifndef Tcl_UpVar_TCL_DECLARED
-#define Tcl_UpVar_TCL_DECLARED
+EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp,
+ const char *varName);
/* 258 */
-EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * frameName, CONST char * varName,
- CONST char * localName, int flags));
-#endif
-#ifndef Tcl_UpVar2_TCL_DECLARED
-#define Tcl_UpVar2_TCL_DECLARED
+EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+ const char *varName, const char *localName,
+ int flags);
/* 259 */
-EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * frameName, CONST char * part1,
- CONST char * part2, CONST char * localName,
- int flags));
-#endif
-#ifndef Tcl_VarEval_TCL_DECLARED
-#define Tcl_VarEval_TCL_DECLARED
+EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
+ const char *part1, const char *part2,
+ const char *localName, int flags);
/* 260 */
-EXTERN int Tcl_VarEval _ANSI_ARGS_((Tcl_Interp *interp, ...));
-#endif
-#ifndef Tcl_VarTraceInfo_TCL_DECLARED
-#define Tcl_VarTraceInfo_TCL_DECLARED
+EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...);
/* 261 */
-EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags,
- Tcl_VarTraceProc * procPtr,
- ClientData prevClientData));
-#endif
-#ifndef Tcl_VarTraceInfo2_TCL_DECLARED
-#define Tcl_VarTraceInfo2_TCL_DECLARED
+EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
+ const char *varName, int flags,
+ Tcl_VarTraceProc *procPtr,
+ ClientData prevClientData);
/* 262 */
-EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags, Tcl_VarTraceProc * procPtr,
- ClientData prevClientData));
-#endif
-#ifndef Tcl_Write_TCL_DECLARED
-#define Tcl_Write_TCL_DECLARED
+EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp,
+ const char *part1, const char *part2,
+ int flags, Tcl_VarTraceProc *procPtr,
+ ClientData prevClientData);
/* 263 */
-EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
- CONST char * s, int slen));
-#endif
-#ifndef Tcl_WrongNumArgs_TCL_DECLARED
-#define Tcl_WrongNumArgs_TCL_DECLARED
+EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen);
/* 264 */
-EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp * interp,
- int objc, Tcl_Obj *CONST objv[],
- CONST char * message));
-#endif
-#ifndef Tcl_DumpActiveMemory_TCL_DECLARED
-#define Tcl_DumpActiveMemory_TCL_DECLARED
+EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], const char *message);
/* 265 */
-EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((
- CONST char * fileName));
-#endif
-#ifndef Tcl_ValidateAllMemory_TCL_DECLARED
-#define Tcl_ValidateAllMemory_TCL_DECLARED
+EXTERN int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
-EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((CONST char * file,
- int line));
-#endif
-#ifndef Tcl_AppendResultVA_TCL_DECLARED
-#define Tcl_AppendResultVA_TCL_DECLARED
+EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
-EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp,
- va_list argList));
-#endif
-#ifndef Tcl_AppendStringsToObjVA_TCL_DECLARED
-#define Tcl_AppendStringsToObjVA_TCL_DECLARED
+EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp,
+ va_list argList);
/* 268 */
-EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_((
- Tcl_Obj * objPtr, va_list argList));
-#endif
-#ifndef Tcl_HashStats_TCL_DECLARED
-#define Tcl_HashStats_TCL_DECLARED
+EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
+ va_list argList);
/* 269 */
-EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_((
- Tcl_HashTable * tablePtr));
-#endif
-#ifndef Tcl_ParseVar_TCL_DECLARED
-#define Tcl_ParseVar_TCL_DECLARED
+EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
-EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * start, CONST84 char ** termPtr));
-#endif
-#ifndef Tcl_PkgPresent_TCL_DECLARED
-#define Tcl_PkgPresent_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
+ const char *start, CONST84 char **termPtr);
/* 271 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, CONST char * version,
- int exact));
-#endif
-#ifndef Tcl_PkgPresentEx_TCL_DECLARED
-#define Tcl_PkgPresentEx_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
+ const char *name, const char *version,
+ int exact);
/* 272 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- CONST char * version, int exact,
- ClientData * clientDataPtr));
-#endif
-#ifndef Tcl_PkgProvide_TCL_DECLARED
-#define Tcl_PkgProvide_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
+ const char *name, const char *version,
+ int exact, void *clientDataPtr);
/* 273 */
-EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, CONST char * version));
-#endif
-#ifndef Tcl_PkgRequire_TCL_DECLARED
-#define Tcl_PkgRequire_TCL_DECLARED
+EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+ const char *version);
/* 274 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, CONST char * version,
- int exact));
-#endif
-#ifndef Tcl_SetErrorCodeVA_TCL_DECLARED
-#define Tcl_SetErrorCodeVA_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
+ const char *name, const char *version,
+ int exact);
/* 275 */
-EXTERN void Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp * interp,
- va_list argList));
-#endif
-#ifndef Tcl_VarEvalVA_TCL_DECLARED
-#define Tcl_VarEvalVA_TCL_DECLARED
+EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
+ va_list argList);
/* 276 */
-EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp,
- va_list argList));
-#endif
-#ifndef Tcl_WaitPid_TCL_DECLARED
-#define Tcl_WaitPid_TCL_DECLARED
+EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
-EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr,
- int options));
-#endif
-#ifndef Tcl_PanicVA_TCL_DECLARED
-#define Tcl_PanicVA_TCL_DECLARED
+EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
-EXTERN void Tcl_PanicVA _ANSI_ARGS_((CONST char * format,
- va_list argList));
-#endif
-#ifndef Tcl_GetVersion_TCL_DECLARED
-#define Tcl_GetVersion_TCL_DECLARED
+EXTERN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
-EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor,
- int * patchLevel, int * type));
-#endif
-#ifndef Tcl_InitMemory_TCL_DECLARED
-#define Tcl_InitMemory_TCL_DECLARED
+EXTERN void Tcl_GetVersion(int *major, int *minor,
+ int *patchLevel, int *type);
/* 280 */
-EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_StackChannel_TCL_DECLARED
-#define Tcl_StackChannel_TCL_DECLARED
+EXTERN void Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
-EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_ChannelType * typePtr,
- ClientData instanceData, int mask,
- Tcl_Channel prevChan));
-#endif
-#ifndef Tcl_UnstackChannel_TCL_DECLARED
-#define Tcl_UnstackChannel_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
+ const Tcl_ChannelType *typePtr,
+ ClientData instanceData, int mask,
+ Tcl_Channel prevChan);
/* 282 */
-EXTERN int Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan));
-#endif
-#ifndef Tcl_GetStackedChannel_TCL_DECLARED
-#define Tcl_GetStackedChannel_TCL_DECLARED
+EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp,
+ Tcl_Channel chan);
/* 283 */
-EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_SetMainLoop_TCL_DECLARED
-#define Tcl_SetMainLoop_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
-EXTERN void Tcl_SetMainLoop _ANSI_ARGS_((Tcl_MainLoopProc * proc));
-#endif
+EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
-#ifndef Tcl_AppendObjToObj_TCL_DECLARED
-#define Tcl_AppendObjToObj_TCL_DECLARED
/* 286 */
-EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- Tcl_Obj * appendObjPtr));
-#endif
-#ifndef Tcl_CreateEncoding_TCL_DECLARED
-#define Tcl_CreateEncoding_TCL_DECLARED
+EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr,
+ Tcl_Obj *appendObjPtr);
/* 287 */
-EXTERN Tcl_Encoding Tcl_CreateEncoding _ANSI_ARGS_((
- Tcl_EncodingType * typePtr));
-#endif
-#ifndef Tcl_CreateThreadExitHandler_TCL_DECLARED
-#define Tcl_CreateThreadExitHandler_TCL_DECLARED
+EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
-EXTERN void Tcl_CreateThreadExitHandler _ANSI_ARGS_((
- Tcl_ExitProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_DeleteThreadExitHandler_TCL_DECLARED
-#define Tcl_DeleteThreadExitHandler_TCL_DECLARED
+EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
/* 289 */
-EXTERN void Tcl_DeleteThreadExitHandler _ANSI_ARGS_((
- Tcl_ExitProc * proc, ClientData clientData));
-#endif
-#ifndef Tcl_DiscardResult_TCL_DECLARED
-#define Tcl_DiscardResult_TCL_DECLARED
+EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
+ ClientData clientData);
/* 290 */
-EXTERN void Tcl_DiscardResult _ANSI_ARGS_((
- Tcl_SavedResult * statePtr));
-#endif
-#ifndef Tcl_EvalEx_TCL_DECLARED
-#define Tcl_EvalEx_TCL_DECLARED
+EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr);
/* 291 */
-EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * script, int numBytes, int flags));
-#endif
-#ifndef Tcl_EvalObjv_TCL_DECLARED
-#define Tcl_EvalObjv_TCL_DECLARED
+EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script,
+ int numBytes, int flags);
/* 292 */
-EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-#endif
-#ifndef Tcl_EvalObjEx_TCL_DECLARED
-#define Tcl_EvalObjEx_TCL_DECLARED
+EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags);
/* 293 */
-EXTERN int Tcl_EvalObjEx _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, int flags));
-#endif
-#ifndef Tcl_ExitThread_TCL_DECLARED
-#define Tcl_ExitThread_TCL_DECLARED
+EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
/* 294 */
-EXTERN void Tcl_ExitThread _ANSI_ARGS_((int status));
-#endif
-#ifndef Tcl_ExternalToUtf_TCL_DECLARED
-#define Tcl_ExternalToUtf_TCL_DECLARED
+EXTERN void Tcl_ExitThread(int status);
/* 295 */
-EXTERN int Tcl_ExternalToUtf _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Encoding encoding, CONST char * src,
- int srcLen, int flags,
- Tcl_EncodingState * statePtr, char * dst,
- int dstLen, int * srcReadPtr,
- int * dstWrotePtr, int * dstCharsPtr));
-#endif
-#ifndef Tcl_ExternalToUtfDString_TCL_DECLARED
-#define Tcl_ExternalToUtfDString_TCL_DECLARED
+EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp,
+ Tcl_Encoding encoding, const char *src,
+ int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr,
+ int *dstWrotePtr, int *dstCharsPtr);
/* 296 */
-EXTERN char * Tcl_ExternalToUtfDString _ANSI_ARGS_((
- Tcl_Encoding encoding, CONST char * src,
- int srcLen, Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_FinalizeThread_TCL_DECLARED
-#define Tcl_FinalizeThread_TCL_DECLARED
+EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
+ const char *src, int srcLen,
+ Tcl_DString *dsPtr);
/* 297 */
-EXTERN void Tcl_FinalizeThread _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_FinalizeNotifier_TCL_DECLARED
-#define Tcl_FinalizeNotifier_TCL_DECLARED
+EXTERN void Tcl_FinalizeThread(void);
/* 298 */
-EXTERN void Tcl_FinalizeNotifier _ANSI_ARGS_((
- ClientData clientData));
-#endif
-#ifndef Tcl_FreeEncoding_TCL_DECLARED
-#define Tcl_FreeEncoding_TCL_DECLARED
+EXTERN void Tcl_FinalizeNotifier(ClientData clientData);
/* 299 */
-EXTERN void Tcl_FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
-#endif
-#ifndef Tcl_GetCurrentThread_TCL_DECLARED
-#define Tcl_GetCurrentThread_TCL_DECLARED
+EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
-EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetEncoding_TCL_DECLARED
-#define Tcl_GetEncoding_TCL_DECLARED
+EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void);
/* 301 */
-EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name));
-#endif
-#ifndef Tcl_GetEncodingName_TCL_DECLARED
-#define Tcl_GetEncodingName_TCL_DECLARED
+EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
-EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_((
- Tcl_Encoding encoding));
-#endif
-#ifndef Tcl_GetEncodingNames_TCL_DECLARED
-#define Tcl_GetEncodingNames_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
-EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetIndexFromObjStruct_TCL_DECLARED
-#define Tcl_GetIndexFromObjStruct_TCL_DECLARED
+EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
-EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr,
- CONST VOID * tablePtr, int offset,
- CONST char * msg, int flags, int * indexPtr));
-#endif
-#ifndef Tcl_GetThreadData_TCL_DECLARED
-#define Tcl_GetThreadData_TCL_DECLARED
+EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, const void *tablePtr,
+ int offset, const char *msg, int flags,
+ int *indexPtr);
/* 305 */
-EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_((
- Tcl_ThreadDataKey * keyPtr, int size));
-#endif
-#ifndef Tcl_GetVar2Ex_TCL_DECLARED
-#define Tcl_GetVar2Ex_TCL_DECLARED
+EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
+ int size);
/* 306 */
-EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags));
-#endif
-#ifndef Tcl_InitNotifier_TCL_DECLARED
-#define Tcl_InitNotifier_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags);
/* 307 */
-EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_MutexLock_TCL_DECLARED
-#define Tcl_MutexLock_TCL_DECLARED
+EXTERN ClientData Tcl_InitNotifier(void);
/* 308 */
-EXTERN void Tcl_MutexLock _ANSI_ARGS_((Tcl_Mutex * mutexPtr));
-#endif
-#ifndef Tcl_MutexUnlock_TCL_DECLARED
-#define Tcl_MutexUnlock_TCL_DECLARED
+EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
-EXTERN void Tcl_MutexUnlock _ANSI_ARGS_((Tcl_Mutex * mutexPtr));
-#endif
-#ifndef Tcl_ConditionNotify_TCL_DECLARED
-#define Tcl_ConditionNotify_TCL_DECLARED
+EXTERN void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
-EXTERN void Tcl_ConditionNotify _ANSI_ARGS_((
- Tcl_Condition * condPtr));
-#endif
-#ifndef Tcl_ConditionWait_TCL_DECLARED
-#define Tcl_ConditionWait_TCL_DECLARED
+EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
-EXTERN void Tcl_ConditionWait _ANSI_ARGS_((
- Tcl_Condition * condPtr,
- Tcl_Mutex * mutexPtr, Tcl_Time * timePtr));
-#endif
-#ifndef Tcl_NumUtfChars_TCL_DECLARED
-#define Tcl_NumUtfChars_TCL_DECLARED
+EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr,
+ Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
-EXTERN int Tcl_NumUtfChars _ANSI_ARGS_((CONST char * src,
- int length));
-#endif
-#ifndef Tcl_ReadChars_TCL_DECLARED
-#define Tcl_ReadChars_TCL_DECLARED
+EXTERN int Tcl_NumUtfChars(const char *src, int length);
/* 313 */
-EXTERN int Tcl_ReadChars _ANSI_ARGS_((Tcl_Channel channel,
- Tcl_Obj * objPtr, int charsToRead,
- int appendFlag));
-#endif
-#ifndef Tcl_RestoreResult_TCL_DECLARED
-#define Tcl_RestoreResult_TCL_DECLARED
+EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
+ int charsToRead, int appendFlag);
/* 314 */
-EXTERN void Tcl_RestoreResult _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_SavedResult * statePtr));
-#endif
-#ifndef Tcl_SaveResult_TCL_DECLARED
-#define Tcl_SaveResult_TCL_DECLARED
+EXTERN void Tcl_RestoreResult(Tcl_Interp *interp,
+ Tcl_SavedResult *statePtr);
/* 315 */
-EXTERN void Tcl_SaveResult _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_SavedResult * statePtr));
-#endif
-#ifndef Tcl_SetSystemEncoding_TCL_DECLARED
-#define Tcl_SetSystemEncoding_TCL_DECLARED
+EXTERN void Tcl_SaveResult(Tcl_Interp *interp,
+ Tcl_SavedResult *statePtr);
/* 316 */
-EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name));
-#endif
-#ifndef Tcl_SetVar2Ex_TCL_DECLARED
-#define Tcl_SetVar2Ex_TCL_DECLARED
+EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp,
+ const char *name);
/* 317 */
-EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- Tcl_Obj * newValuePtr, int flags));
-#endif
-#ifndef Tcl_ThreadAlert_TCL_DECLARED
-#define Tcl_ThreadAlert_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
+ const char *part2, Tcl_Obj *newValuePtr,
+ int flags);
/* 318 */
-EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
-#endif
-#ifndef Tcl_ThreadQueueEvent_TCL_DECLARED
-#define Tcl_ThreadQueueEvent_TCL_DECLARED
+EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
-EXTERN void Tcl_ThreadQueueEvent _ANSI_ARGS_((
- Tcl_ThreadId threadId, Tcl_Event* evPtr,
- Tcl_QueuePosition position));
-#endif
-#ifndef Tcl_UniCharAtIndex_TCL_DECLARED
-#define Tcl_UniCharAtIndex_TCL_DECLARED
+EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
+ Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
-EXTERN Tcl_UniChar Tcl_UniCharAtIndex _ANSI_ARGS_((CONST char * src,
- int index));
-#endif
-#ifndef Tcl_UniCharToLower_TCL_DECLARED
-#define Tcl_UniCharToLower_TCL_DECLARED
+EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
-EXTERN Tcl_UniChar Tcl_UniCharToLower _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharToTitle_TCL_DECLARED
-#define Tcl_UniCharToTitle_TCL_DECLARED
+EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch);
/* 322 */
-EXTERN Tcl_UniChar Tcl_UniCharToTitle _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharToUpper_TCL_DECLARED
-#define Tcl_UniCharToUpper_TCL_DECLARED
+EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch);
/* 323 */
-EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharToUtf_TCL_DECLARED
-#define Tcl_UniCharToUtf_TCL_DECLARED
+EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
/* 324 */
-EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf));
-#endif
-#ifndef Tcl_UtfAtIndex_TCL_DECLARED
-#define Tcl_UtfAtIndex_TCL_DECLARED
+EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
-EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
- int index));
-#endif
-#ifndef Tcl_UtfCharComplete_TCL_DECLARED
-#define Tcl_UtfCharComplete_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
-EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
- int length));
-#endif
-#ifndef Tcl_UtfBackslash_TCL_DECLARED
-#define Tcl_UtfBackslash_TCL_DECLARED
+EXTERN int Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
-EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src,
- int * readPtr, char * dst));
-#endif
-#ifndef Tcl_UtfFindFirst_TCL_DECLARED
-#define Tcl_UtfFindFirst_TCL_DECLARED
+EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr,
+ char *dst);
/* 328 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
- int ch));
-#endif
-#ifndef Tcl_UtfFindLast_TCL_DECLARED
-#define Tcl_UtfFindLast_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
- int ch));
-#endif
-#ifndef Tcl_UtfNext_TCL_DECLARED
-#define Tcl_UtfNext_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
-EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
-#endif
-#ifndef Tcl_UtfPrev_TCL_DECLARED
-#define Tcl_UtfPrev_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
/* 331 */
-EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
- CONST char * start));
-#endif
-#ifndef Tcl_UtfToExternal_TCL_DECLARED
-#define Tcl_UtfToExternal_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
-EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Encoding encoding, CONST char * src,
- int srcLen, int flags,
- Tcl_EncodingState * statePtr, char * dst,
- int dstLen, int * srcReadPtr,
- int * dstWrotePtr, int * dstCharsPtr));
-#endif
-#ifndef Tcl_UtfToExternalDString_TCL_DECLARED
-#define Tcl_UtfToExternalDString_TCL_DECLARED
+EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp,
+ Tcl_Encoding encoding, const char *src,
+ int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr,
+ int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
-EXTERN char * Tcl_UtfToExternalDString _ANSI_ARGS_((
- Tcl_Encoding encoding, CONST char * src,
- int srcLen, Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_UtfToLower_TCL_DECLARED
-#define Tcl_UtfToLower_TCL_DECLARED
+EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding,
+ const char *src, int srcLen,
+ Tcl_DString *dsPtr);
/* 334 */
-EXTERN int Tcl_UtfToLower _ANSI_ARGS_((char * src));
-#endif
-#ifndef Tcl_UtfToTitle_TCL_DECLARED
-#define Tcl_UtfToTitle_TCL_DECLARED
+EXTERN int Tcl_UtfToLower(char *src);
/* 335 */
-EXTERN int Tcl_UtfToTitle _ANSI_ARGS_((char * src));
-#endif
-#ifndef Tcl_UtfToUniChar_TCL_DECLARED
-#define Tcl_UtfToUniChar_TCL_DECLARED
+EXTERN int Tcl_UtfToTitle(char *src);
/* 336 */
-EXTERN int Tcl_UtfToUniChar _ANSI_ARGS_((CONST char * src,
- Tcl_UniChar * chPtr));
-#endif
-#ifndef Tcl_UtfToUpper_TCL_DECLARED
-#define Tcl_UtfToUpper_TCL_DECLARED
+EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
/* 337 */
-EXTERN int Tcl_UtfToUpper _ANSI_ARGS_((char * src));
-#endif
-#ifndef Tcl_WriteChars_TCL_DECLARED
-#define Tcl_WriteChars_TCL_DECLARED
+EXTERN int Tcl_UtfToUpper(char *src);
/* 338 */
-EXTERN int Tcl_WriteChars _ANSI_ARGS_((Tcl_Channel chan,
- CONST char * src, int srcLen));
-#endif
-#ifndef Tcl_WriteObj_TCL_DECLARED
-#define Tcl_WriteObj_TCL_DECLARED
+EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src,
+ int srcLen);
/* 339 */
-EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetString_TCL_DECLARED
-#define Tcl_GetString_TCL_DECLARED
+EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
-EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetDefaultEncodingDir_TCL_DECLARED
-#define Tcl_GetDefaultEncodingDir_TCL_DECLARED
+EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
-EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_SetDefaultEncodingDir_TCL_DECLARED
-#define Tcl_SetDefaultEncodingDir_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
/* 342 */
-EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((
- CONST char * path));
-#endif
-#ifndef Tcl_AlertNotifier_TCL_DECLARED
-#define Tcl_AlertNotifier_TCL_DECLARED
+EXTERN void Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
-EXTERN void Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
-#endif
-#ifndef Tcl_ServiceModeHook_TCL_DECLARED
-#define Tcl_ServiceModeHook_TCL_DECLARED
+EXTERN void Tcl_AlertNotifier(ClientData clientData);
/* 344 */
-EXTERN void Tcl_ServiceModeHook _ANSI_ARGS_((int mode));
-#endif
-#ifndef Tcl_UniCharIsAlnum_TCL_DECLARED
-#define Tcl_UniCharIsAlnum_TCL_DECLARED
+EXTERN void Tcl_ServiceModeHook(int mode);
/* 345 */
-EXTERN int Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsAlpha_TCL_DECLARED
-#define Tcl_UniCharIsAlpha_TCL_DECLARED
+EXTERN int Tcl_UniCharIsAlnum(int ch);
/* 346 */
-EXTERN int Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsDigit_TCL_DECLARED
-#define Tcl_UniCharIsDigit_TCL_DECLARED
+EXTERN int Tcl_UniCharIsAlpha(int ch);
/* 347 */
-EXTERN int Tcl_UniCharIsDigit _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsLower_TCL_DECLARED
-#define Tcl_UniCharIsLower_TCL_DECLARED
+EXTERN int Tcl_UniCharIsDigit(int ch);
/* 348 */
-EXTERN int Tcl_UniCharIsLower _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsSpace_TCL_DECLARED
-#define Tcl_UniCharIsSpace_TCL_DECLARED
+EXTERN int Tcl_UniCharIsLower(int ch);
/* 349 */
-EXTERN int Tcl_UniCharIsSpace _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsUpper_TCL_DECLARED
-#define Tcl_UniCharIsUpper_TCL_DECLARED
+EXTERN int Tcl_UniCharIsSpace(int ch);
/* 350 */
-EXTERN int Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsWordChar_TCL_DECLARED
-#define Tcl_UniCharIsWordChar_TCL_DECLARED
+EXTERN int Tcl_UniCharIsUpper(int ch);
/* 351 */
-EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharLen_TCL_DECLARED
-#define Tcl_UniCharLen_TCL_DECLARED
+EXTERN int Tcl_UniCharIsWordChar(int ch);
/* 352 */
-EXTERN int Tcl_UniCharLen _ANSI_ARGS_((
- CONST Tcl_UniChar * uniStr));
-#endif
-#ifndef Tcl_UniCharNcmp_TCL_DECLARED
-#define Tcl_UniCharNcmp_TCL_DECLARED
+EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr);
/* 353 */
-EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * ucs,
- CONST Tcl_UniChar * uct,
- unsigned long numChars));
-#endif
-#ifndef Tcl_UniCharToUtfDString_TCL_DECLARED
-#define Tcl_UniCharToUtfDString_TCL_DECLARED
+EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
+ const Tcl_UniChar *uct,
+ unsigned long numChars);
/* 354 */
-EXTERN char * Tcl_UniCharToUtfDString _ANSI_ARGS_((
- CONST Tcl_UniChar * uniStr, int uniLength,
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_UtfToUniCharDString_TCL_DECLARED
-#define Tcl_UtfToUniCharDString_TCL_DECLARED
+EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
+ int uniLength, Tcl_DString *dsPtr);
/* 355 */
-EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString _ANSI_ARGS_((
- CONST char * src, int length,
- Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_GetRegExpFromObj_TCL_DECLARED
-#define Tcl_GetRegExpFromObj_TCL_DECLARED
+EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
+ Tcl_DString *dsPtr);
/* 356 */
-EXTERN Tcl_RegExp Tcl_GetRegExpFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * patObj,
- int flags));
-#endif
-#ifndef Tcl_EvalTokens_TCL_DECLARED
-#define Tcl_EvalTokens_TCL_DECLARED
+EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
+ Tcl_Obj *patObj, int flags);
/* 357 */
-EXTERN Tcl_Obj * Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Token * tokenPtr, int count));
-#endif
-#ifndef Tcl_FreeParse_TCL_DECLARED
-#define Tcl_FreeParse_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count);
/* 358 */
-EXTERN void Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse * parsePtr));
-#endif
-#ifndef Tcl_LogCommandInfo_TCL_DECLARED
-#define Tcl_LogCommandInfo_TCL_DECLARED
+EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
-EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * script, CONST char * command,
- int length));
-#endif
-#ifndef Tcl_ParseBraces_TCL_DECLARED
-#define Tcl_ParseBraces_TCL_DECLARED
+EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp,
+ const char *script, const char *command,
+ int length);
/* 360 */
-EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * start, int numBytes,
- Tcl_Parse * parsePtr, int append,
- CONST84 char ** termPtr));
-#endif
-#ifndef Tcl_ParseCommand_TCL_DECLARED
-#define Tcl_ParseCommand_TCL_DECLARED
+EXTERN int Tcl_ParseBraces(Tcl_Interp *interp,
+ const char *start, int numBytes,
+ Tcl_Parse *parsePtr, int append,
+ CONST84 char **termPtr);
/* 361 */
-EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * start, int numBytes, int nested,
- Tcl_Parse * parsePtr));
-#endif
-#ifndef Tcl_ParseExpr_TCL_DECLARED
-#define Tcl_ParseExpr_TCL_DECLARED
+EXTERN int Tcl_ParseCommand(Tcl_Interp *interp,
+ const char *start, int numBytes, int nested,
+ Tcl_Parse *parsePtr);
/* 362 */
-EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * start, int numBytes,
- Tcl_Parse * parsePtr));
-#endif
-#ifndef Tcl_ParseQuotedString_TCL_DECLARED
-#define Tcl_ParseQuotedString_TCL_DECLARED
+EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
+ int numBytes, Tcl_Parse *parsePtr);
/* 363 */
-EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * start,
- int numBytes, Tcl_Parse * parsePtr,
- int append, CONST84 char ** termPtr));
-#endif
-#ifndef Tcl_ParseVarName_TCL_DECLARED
-#define Tcl_ParseVarName_TCL_DECLARED
+EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp,
+ const char *start, int numBytes,
+ Tcl_Parse *parsePtr, int append,
+ CONST84 char **termPtr);
/* 364 */
-EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * start, int numBytes,
- Tcl_Parse * parsePtr, int append));
-#endif
-#ifndef Tcl_GetCwd_TCL_DECLARED
-#define Tcl_GetCwd_TCL_DECLARED
+EXTERN int Tcl_ParseVarName(Tcl_Interp *interp,
+ const char *start, int numBytes,
+ Tcl_Parse *parsePtr, int append);
/* 365 */
-EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_DString * cwdPtr));
-#endif
-#ifndef Tcl_Chdir_TCL_DECLARED
-#define Tcl_Chdir_TCL_DECLARED
+EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
-EXTERN int Tcl_Chdir _ANSI_ARGS_((CONST char * dirName));
-#endif
-#ifndef Tcl_Access_TCL_DECLARED
-#define Tcl_Access_TCL_DECLARED
+EXTERN int Tcl_Chdir(const char *dirName);
/* 367 */
-EXTERN int Tcl_Access _ANSI_ARGS_((CONST char * path, int mode));
-#endif
-#ifndef Tcl_Stat_TCL_DECLARED
-#define Tcl_Stat_TCL_DECLARED
+EXTERN int Tcl_Access(const char *path, int mode);
/* 368 */
-EXTERN int Tcl_Stat _ANSI_ARGS_((CONST char * path,
- struct stat * bufPtr));
-#endif
-#ifndef Tcl_UtfNcmp_TCL_DECLARED
-#define Tcl_UtfNcmp_TCL_DECLARED
+EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
-EXTERN int Tcl_UtfNcmp _ANSI_ARGS_((CONST char * s1,
- CONST char * s2, unsigned long n));
-#endif
-#ifndef Tcl_UtfNcasecmp_TCL_DECLARED
-#define Tcl_UtfNcasecmp_TCL_DECLARED
+EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2,
+ unsigned long n);
/* 370 */
-EXTERN int Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char * s1,
- CONST char * s2, unsigned long n));
-#endif
-#ifndef Tcl_StringCaseMatch_TCL_DECLARED
-#define Tcl_StringCaseMatch_TCL_DECLARED
+EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2,
+ unsigned long n);
/* 371 */
-EXTERN int Tcl_StringCaseMatch _ANSI_ARGS_((CONST char * str,
- CONST char * pattern, int nocase));
-#endif
-#ifndef Tcl_UniCharIsControl_TCL_DECLARED
-#define Tcl_UniCharIsControl_TCL_DECLARED
+EXTERN int Tcl_StringCaseMatch(const char *str,
+ const char *pattern, int nocase);
/* 372 */
-EXTERN int Tcl_UniCharIsControl _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsGraph_TCL_DECLARED
-#define Tcl_UniCharIsGraph_TCL_DECLARED
+EXTERN int Tcl_UniCharIsControl(int ch);
/* 373 */
-EXTERN int Tcl_UniCharIsGraph _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsPrint_TCL_DECLARED
-#define Tcl_UniCharIsPrint_TCL_DECLARED
+EXTERN int Tcl_UniCharIsGraph(int ch);
/* 374 */
-EXTERN int Tcl_UniCharIsPrint _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_UniCharIsPunct_TCL_DECLARED
-#define Tcl_UniCharIsPunct_TCL_DECLARED
+EXTERN int Tcl_UniCharIsPrint(int ch);
/* 375 */
-EXTERN int Tcl_UniCharIsPunct _ANSI_ARGS_((int ch));
-#endif
-#ifndef Tcl_RegExpExecObj_TCL_DECLARED
-#define Tcl_RegExpExecObj_TCL_DECLARED
+EXTERN int Tcl_UniCharIsPunct(int ch);
/* 376 */
-EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_RegExp regexp, Tcl_Obj * textObj,
- int offset, int nmatches, int flags));
-#endif
-#ifndef Tcl_RegExpGetInfo_TCL_DECLARED
-#define Tcl_RegExpGetInfo_TCL_DECLARED
+EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp,
+ Tcl_RegExp regexp, Tcl_Obj *textObj,
+ int offset, int nmatches, int flags);
/* 377 */
-EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp,
- Tcl_RegExpInfo * infoPtr));
-#endif
-#ifndef Tcl_NewUnicodeObj_TCL_DECLARED
-#define Tcl_NewUnicodeObj_TCL_DECLARED
+EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp,
+ Tcl_RegExpInfo *infoPtr);
/* 378 */
-EXTERN Tcl_Obj * Tcl_NewUnicodeObj _ANSI_ARGS_((
- CONST Tcl_UniChar * unicode, int numChars));
-#endif
-#ifndef Tcl_SetUnicodeObj_TCL_DECLARED
-#define Tcl_SetUnicodeObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
+ int numChars);
/* 379 */
-EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST Tcl_UniChar * unicode, int numChars));
-#endif
-#ifndef Tcl_GetCharLength_TCL_DECLARED
-#define Tcl_GetCharLength_TCL_DECLARED
+EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int numChars);
/* 380 */
-EXTERN int Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetUniChar_TCL_DECLARED
-#define Tcl_GetUniChar_TCL_DECLARED
+EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
-EXTERN Tcl_UniChar Tcl_GetUniChar _ANSI_ARGS_((Tcl_Obj * objPtr,
- int index));
-#endif
-#ifndef Tcl_GetUnicode_TCL_DECLARED
-#define Tcl_GetUnicode_TCL_DECLARED
+EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
-EXTERN Tcl_UniChar * Tcl_GetUnicode _ANSI_ARGS_((Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetRange_TCL_DECLARED
-#define Tcl_GetRange_TCL_DECLARED
+EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
-EXTERN Tcl_Obj * Tcl_GetRange _ANSI_ARGS_((Tcl_Obj * objPtr,
- int first, int last));
-#endif
-#ifndef Tcl_AppendUnicodeToObj_TCL_DECLARED
-#define Tcl_AppendUnicodeToObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
-EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- CONST Tcl_UniChar * unicode, int length));
-#endif
-#ifndef Tcl_RegExpMatchObj_TCL_DECLARED
-#define Tcl_RegExpMatchObj_TCL_DECLARED
+EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int length);
/* 385 */
-EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * textObj, Tcl_Obj * patternObj));
-#endif
-#ifndef Tcl_SetNotifier_TCL_DECLARED
-#define Tcl_SetNotifier_TCL_DECLARED
+EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
+ Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
-EXTERN void Tcl_SetNotifier _ANSI_ARGS_((
- Tcl_NotifierProcs * notifierProcPtr));
-#endif
-#ifndef Tcl_GetAllocMutex_TCL_DECLARED
-#define Tcl_GetAllocMutex_TCL_DECLARED
+EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
-EXTERN Tcl_Mutex * Tcl_GetAllocMutex _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_GetChannelNames_TCL_DECLARED
-#define Tcl_GetChannelNames_TCL_DECLARED
+EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void);
/* 388 */
-EXTERN int Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetChannelNamesEx_TCL_DECLARED
-#define Tcl_GetChannelNamesEx_TCL_DECLARED
+EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
-EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * pattern));
-#endif
-#ifndef Tcl_ProcObjCmd_TCL_DECLARED
-#define Tcl_ProcObjCmd_TCL_DECLARED
+EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp,
+ const char *pattern);
/* 390 */
-EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_ConditionFinalize_TCL_DECLARED
-#define Tcl_ConditionFinalize_TCL_DECLARED
+EXTERN int Tcl_ProcObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
/* 391 */
-EXTERN void Tcl_ConditionFinalize _ANSI_ARGS_((
- Tcl_Condition * condPtr));
-#endif
-#ifndef Tcl_MutexFinalize_TCL_DECLARED
-#define Tcl_MutexFinalize_TCL_DECLARED
+EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
-EXTERN void Tcl_MutexFinalize _ANSI_ARGS_((Tcl_Mutex * mutex));
-#endif
-#ifndef Tcl_CreateThread_TCL_DECLARED
-#define Tcl_CreateThread_TCL_DECLARED
+EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
-EXTERN int Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr,
- Tcl_ThreadCreateProc proc,
- ClientData clientData, int stackSize,
- int flags));
-#endif
-#ifndef Tcl_ReadRaw_TCL_DECLARED
-#define Tcl_ReadRaw_TCL_DECLARED
+EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr,
+ Tcl_ThreadCreateProc *proc,
+ ClientData clientData, int stackSize,
+ int flags);
/* 394 */
-EXTERN int Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan,
- char * dst, int bytesToRead));
-#endif
-#ifndef Tcl_WriteRaw_TCL_DECLARED
-#define Tcl_WriteRaw_TCL_DECLARED
+EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst,
+ int bytesToRead);
/* 395 */
-EXTERN int Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
- CONST char * src, int srcLen));
-#endif
-#ifndef Tcl_GetTopChannel_TCL_DECLARED
-#define Tcl_GetTopChannel_TCL_DECLARED
+EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src,
+ int srcLen);
/* 396 */
-EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_ChannelBuffered_TCL_DECLARED
-#define Tcl_ChannelBuffered_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
-EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_ChannelName_TCL_DECLARED
-#define Tcl_ChannelName_TCL_DECLARED
+EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
-EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelVersion_TCL_DECLARED
-#define Tcl_ChannelVersion_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_ChannelName(
+ const Tcl_ChannelType *chanTypePtr);
/* 399 */
-EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelBlockModeProc_TCL_DECLARED
-#define Tcl_ChannelBlockModeProc_TCL_DECLARED
+EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
+ const Tcl_ChannelType *chanTypePtr);
/* 400 */
-EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelCloseProc_TCL_DECLARED
-#define Tcl_ChannelCloseProc_TCL_DECLARED
+EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 401 */
-EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelClose2Proc_TCL_DECLARED
-#define Tcl_ChannelClose2Proc_TCL_DECLARED
+EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 402 */
-EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelInputProc_TCL_DECLARED
-#define Tcl_ChannelInputProc_TCL_DECLARED
+EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
+ const Tcl_ChannelType *chanTypePtr);
/* 403 */
-EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelOutputProc_TCL_DECLARED
-#define Tcl_ChannelOutputProc_TCL_DECLARED
+EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 404 */
-EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelSeekProc_TCL_DECLARED
-#define Tcl_ChannelSeekProc_TCL_DECLARED
+EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 405 */
-EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelSetOptionProc_TCL_DECLARED
-#define Tcl_ChannelSetOptionProc_TCL_DECLARED
+EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 406 */
-EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelGetOptionProc_TCL_DECLARED
-#define Tcl_ChannelGetOptionProc_TCL_DECLARED
+EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 407 */
-EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelWatchProc_TCL_DECLARED
-#define Tcl_ChannelWatchProc_TCL_DECLARED
+EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 408 */
-EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelGetHandleProc_TCL_DECLARED
-#define Tcl_ChannelGetHandleProc_TCL_DECLARED
+EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 409 */
-EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelFlushProc_TCL_DECLARED
-#define Tcl_ChannelFlushProc_TCL_DECLARED
+EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 410 */
-EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_ChannelHandlerProc_TCL_DECLARED
-#define Tcl_ChannelHandlerProc_TCL_DECLARED
+EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 411 */
-EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_JoinThread_TCL_DECLARED
-#define Tcl_JoinThread_TCL_DECLARED
+EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 412 */
-EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId threadId,
- int* result));
-#endif
-#ifndef Tcl_IsChannelShared_TCL_DECLARED
-#define Tcl_IsChannelShared_TCL_DECLARED
+EXTERN int Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
/* 413 */
-EXTERN int Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel));
-#endif
-#ifndef Tcl_IsChannelRegistered_TCL_DECLARED
-#define Tcl_IsChannelRegistered_TCL_DECLARED
+EXTERN int Tcl_IsChannelShared(Tcl_Channel channel);
/* 414 */
-EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_((
- Tcl_Interp* interp, Tcl_Channel channel));
-#endif
-#ifndef Tcl_CutChannel_TCL_DECLARED
-#define Tcl_CutChannel_TCL_DECLARED
+EXTERN int Tcl_IsChannelRegistered(Tcl_Interp *interp,
+ Tcl_Channel channel);
/* 415 */
-EXTERN void Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel));
-#endif
-#ifndef Tcl_SpliceChannel_TCL_DECLARED
-#define Tcl_SpliceChannel_TCL_DECLARED
+EXTERN void Tcl_CutChannel(Tcl_Channel channel);
/* 416 */
-EXTERN void Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel));
-#endif
-#ifndef Tcl_ClearChannelHandlers_TCL_DECLARED
-#define Tcl_ClearChannelHandlers_TCL_DECLARED
+EXTERN void Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
-EXTERN void Tcl_ClearChannelHandlers _ANSI_ARGS_((
- Tcl_Channel channel));
-#endif
-#ifndef Tcl_IsChannelExisting_TCL_DECLARED
-#define Tcl_IsChannelExisting_TCL_DECLARED
+EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
-EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_((
- CONST char* channelName));
-#endif
-#ifndef Tcl_UniCharNcasecmp_TCL_DECLARED
-#define Tcl_UniCharNcasecmp_TCL_DECLARED
+EXTERN int Tcl_IsChannelExisting(const char *channelName);
/* 419 */
-EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_((
- CONST Tcl_UniChar * ucs,
- CONST Tcl_UniChar * uct,
- unsigned long numChars));
-#endif
-#ifndef Tcl_UniCharCaseMatch_TCL_DECLARED
-#define Tcl_UniCharCaseMatch_TCL_DECLARED
+EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
+ const Tcl_UniChar *uct,
+ unsigned long numChars);
/* 420 */
-EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_((
- CONST Tcl_UniChar * uniStr,
- CONST Tcl_UniChar * uniPattern, int nocase));
-#endif
-#ifndef Tcl_FindHashEntry_TCL_DECLARED
-#define Tcl_FindHashEntry_TCL_DECLARED
+EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
+ const Tcl_UniChar *uniPattern, int nocase);
/* 421 */
-EXTERN Tcl_HashEntry * Tcl_FindHashEntry _ANSI_ARGS_((
- Tcl_HashTable * tablePtr, CONST char * key));
-#endif
-#ifndef Tcl_CreateHashEntry_TCL_DECLARED
-#define Tcl_CreateHashEntry_TCL_DECLARED
+EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
+ const void *key);
/* 422 */
-EXTERN Tcl_HashEntry * Tcl_CreateHashEntry _ANSI_ARGS_((
- Tcl_HashTable * tablePtr, CONST char * key,
- int * newPtr));
-#endif
-#ifndef Tcl_InitCustomHashTable_TCL_DECLARED
-#define Tcl_InitCustomHashTable_TCL_DECLARED
+EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
+ const void *key, int *newPtr);
/* 423 */
-EXTERN void Tcl_InitCustomHashTable _ANSI_ARGS_((
- Tcl_HashTable * tablePtr, int keyType,
- Tcl_HashKeyType * typePtr));
-#endif
-#ifndef Tcl_InitObjHashTable_TCL_DECLARED
-#define Tcl_InitObjHashTable_TCL_DECLARED
+EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
+ int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
-EXTERN void Tcl_InitObjHashTable _ANSI_ARGS_((
- Tcl_HashTable * tablePtr));
-#endif
-#ifndef Tcl_CommandTraceInfo_TCL_DECLARED
-#define Tcl_CommandTraceInfo_TCL_DECLARED
+EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
-EXTERN ClientData Tcl_CommandTraceInfo _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * varName,
- int flags, Tcl_CommandTraceProc * procPtr,
- ClientData prevClientData));
-#endif
-#ifndef Tcl_TraceCommand_TCL_DECLARED
-#define Tcl_TraceCommand_TCL_DECLARED
+EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp,
+ const char *varName, int flags,
+ Tcl_CommandTraceProc *procPtr,
+ ClientData prevClientData);
/* 426 */
-EXTERN int Tcl_TraceCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags,
- Tcl_CommandTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_UntraceCommand_TCL_DECLARED
-#define Tcl_UntraceCommand_TCL_DECLARED
+EXTERN int Tcl_TraceCommand(Tcl_Interp *interp,
+ const char *varName, int flags,
+ Tcl_CommandTraceProc *proc,
+ ClientData clientData);
/* 427 */
-EXTERN void Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName, int flags,
- Tcl_CommandTraceProc * proc,
- ClientData clientData));
-#endif
-#ifndef Tcl_AttemptAlloc_TCL_DECLARED
-#define Tcl_AttemptAlloc_TCL_DECLARED
+EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp,
+ const char *varName, int flags,
+ Tcl_CommandTraceProc *proc,
+ ClientData clientData);
/* 428 */
-EXTERN char * Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size));
-#endif
-#ifndef Tcl_AttemptDbCkalloc_TCL_DECLARED
-#define Tcl_AttemptDbCkalloc_TCL_DECLARED
+EXTERN char * Tcl_AttemptAlloc(unsigned int size);
/* 429 */
-EXTERN char * Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size,
- CONST char * file, int line));
-#endif
-#ifndef Tcl_AttemptRealloc_TCL_DECLARED
-#define Tcl_AttemptRealloc_TCL_DECLARED
+EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size,
+ const char *file, int line);
/* 430 */
-EXTERN char * Tcl_AttemptRealloc _ANSI_ARGS_((char * ptr,
- unsigned int size));
-#endif
-#ifndef Tcl_AttemptDbCkrealloc_TCL_DECLARED
-#define Tcl_AttemptDbCkrealloc_TCL_DECLARED
+EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size);
/* 431 */
-EXTERN char * Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char * ptr,
- unsigned int size, CONST char * file,
- int line));
-#endif
-#ifndef Tcl_AttemptSetObjLength_TCL_DECLARED
-#define Tcl_AttemptSetObjLength_TCL_DECLARED
+EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
+ const char *file, int line);
/* 432 */
-EXTERN int Tcl_AttemptSetObjLength _ANSI_ARGS_((
- Tcl_Obj * objPtr, int length));
-#endif
-#ifndef Tcl_GetChannelThread_TCL_DECLARED
-#define Tcl_GetChannelThread_TCL_DECLARED
+EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
-EXTERN Tcl_ThreadId Tcl_GetChannelThread _ANSI_ARGS_((
- Tcl_Channel channel));
-#endif
-#ifndef Tcl_GetUnicodeFromObj_TCL_DECLARED
-#define Tcl_GetUnicodeFromObj_TCL_DECLARED
+EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
-EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- int * lengthPtr));
-#endif
-#ifndef Tcl_GetMathFuncInfo_TCL_DECLARED
-#define Tcl_GetMathFuncInfo_TCL_DECLARED
+EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
+ int *lengthPtr);
/* 435 */
-EXTERN int Tcl_GetMathFuncInfo _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, int * numArgsPtr,
- Tcl_ValueType ** argTypesPtr,
- Tcl_MathProc ** procPtr,
- ClientData * clientDataPtr));
-#endif
-#ifndef Tcl_ListMathFuncs_TCL_DECLARED
-#define Tcl_ListMathFuncs_TCL_DECLARED
+EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
+ const char *name, int *numArgsPtr,
+ Tcl_ValueType **argTypesPtr,
+ Tcl_MathProc **procPtr,
+ ClientData *clientDataPtr);
/* 436 */
-EXTERN Tcl_Obj * Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * pattern));
-#endif
-#ifndef Tcl_SubstObj_TCL_DECLARED
-#define Tcl_SubstObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
+ const char *pattern);
/* 437 */
-EXTERN Tcl_Obj * Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, int flags));
-#endif
-#ifndef Tcl_DetachChannel_TCL_DECLARED
-#define Tcl_DetachChannel_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
/* 438 */
-EXTERN int Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Channel channel));
-#endif
-#ifndef Tcl_IsStandardChannel_TCL_DECLARED
-#define Tcl_IsStandardChannel_TCL_DECLARED
+EXTERN int Tcl_DetachChannel(Tcl_Interp *interp,
+ Tcl_Channel channel);
/* 439 */
-EXTERN int Tcl_IsStandardChannel _ANSI_ARGS_((
- Tcl_Channel channel));
-#endif
-#ifndef Tcl_FSCopyFile_TCL_DECLARED
-#define Tcl_FSCopyFile_TCL_DECLARED
+EXTERN int Tcl_IsStandardChannel(Tcl_Channel channel);
/* 440 */
-EXTERN int Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
- Tcl_Obj * destPathPtr));
-#endif
-#ifndef Tcl_FSCopyDirectory_TCL_DECLARED
-#define Tcl_FSCopyDirectory_TCL_DECLARED
+EXTERN int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr);
/* 441 */
-EXTERN int Tcl_FSCopyDirectory _ANSI_ARGS_((
- Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr,
- Tcl_Obj ** errorPtr));
-#endif
-#ifndef Tcl_FSCreateDirectory_TCL_DECLARED
-#define Tcl_FSCreateDirectory_TCL_DECLARED
+EXTERN int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
/* 442 */
-EXTERN int Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef Tcl_FSDeleteFile_TCL_DECLARED
-#define Tcl_FSDeleteFile_TCL_DECLARED
+EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
/* 443 */
-EXTERN int Tcl_FSDeleteFile _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef Tcl_FSLoadFile_TCL_DECLARED
-#define Tcl_FSLoadFile_TCL_DECLARED
+EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
/* 444 */
-EXTERN int Tcl_FSLoadFile _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * pathPtr, CONST char * sym1,
- CONST char * sym2,
- Tcl_PackageInitProc ** proc1Ptr,
- Tcl_PackageInitProc ** proc2Ptr,
- Tcl_LoadHandle * handlePtr,
- Tcl_FSUnloadFileProc ** unloadProcPtr));
-#endif
-#ifndef Tcl_FSMatchInDirectory_TCL_DECLARED
-#define Tcl_FSMatchInDirectory_TCL_DECLARED
+EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ const char *sym1, const char *sym2,
+ Tcl_PackageInitProc **proc1Ptr,
+ Tcl_PackageInitProc **proc2Ptr,
+ Tcl_LoadHandle *handlePtr,
+ Tcl_FSUnloadFileProc **unloadProcPtr);
/* 445 */
-EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * result,
- Tcl_Obj * pathPtr, CONST char * pattern,
- Tcl_GlobTypeData * types));
-#endif
-#ifndef Tcl_FSLink_TCL_DECLARED
-#define Tcl_FSLink_TCL_DECLARED
+EXTERN int Tcl_FSMatchInDirectory(Tcl_Interp *interp,
+ Tcl_Obj *result, Tcl_Obj *pathPtr,
+ const char *pattern, Tcl_GlobTypeData *types);
/* 446 */
-EXTERN Tcl_Obj * Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr,
- Tcl_Obj * toPtr, int linkAction));
-#endif
-#ifndef Tcl_FSRemoveDirectory_TCL_DECLARED
-#define Tcl_FSRemoveDirectory_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+ int linkAction);
/* 447 */
-EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr,
- int recursive, Tcl_Obj ** errorPtr));
-#endif
-#ifndef Tcl_FSRenameFile_TCL_DECLARED
-#define Tcl_FSRenameFile_TCL_DECLARED
+EXTERN int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
+ int recursive, Tcl_Obj **errorPtr);
/* 448 */
-EXTERN int Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
- Tcl_Obj * destPathPtr));
-#endif
-#ifndef Tcl_FSLstat_TCL_DECLARED
-#define Tcl_FSLstat_TCL_DECLARED
+EXTERN int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr);
/* 449 */
-EXTERN int Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj * pathPtr,
- Tcl_StatBuf * buf));
-#endif
-#ifndef Tcl_FSUtime_TCL_DECLARED
-#define Tcl_FSUtime_TCL_DECLARED
+EXTERN int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 450 */
-EXTERN int Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj * pathPtr,
- struct utimbuf * tval));
-#endif
-#ifndef Tcl_FSFileAttrsGet_TCL_DECLARED
-#define Tcl_FSFileAttrsGet_TCL_DECLARED
+EXTERN int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
/* 451 */
-EXTERN int Tcl_FSFileAttrsGet _ANSI_ARGS_((Tcl_Interp * interp,
- int index, Tcl_Obj * pathPtr,
- Tcl_Obj ** objPtrRef));
-#endif
-#ifndef Tcl_FSFileAttrsSet_TCL_DECLARED
-#define Tcl_FSFileAttrsSet_TCL_DECLARED
+EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
/* 452 */
-EXTERN int Tcl_FSFileAttrsSet _ANSI_ARGS_((Tcl_Interp * interp,
- int index, Tcl_Obj * pathPtr,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_FSFileAttrStrings_TCL_DECLARED
-#define Tcl_FSFileAttrStrings_TCL_DECLARED
+EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
/* 453 */
-EXTERN CONST char ** Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj * pathPtr,
- Tcl_Obj ** objPtrRef));
-#endif
-#ifndef Tcl_FSStat_TCL_DECLARED
-#define Tcl_FSStat_TCL_DECLARED
+EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef);
/* 454 */
-EXTERN int Tcl_FSStat _ANSI_ARGS_((Tcl_Obj * pathPtr,
- Tcl_StatBuf * buf));
-#endif
-#ifndef Tcl_FSAccess_TCL_DECLARED
-#define Tcl_FSAccess_TCL_DECLARED
+EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 455 */
-EXTERN int Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj * pathPtr,
- int mode));
-#endif
-#ifndef Tcl_FSOpenFileChannel_TCL_DECLARED
-#define Tcl_FSOpenFileChannel_TCL_DECLARED
+EXTERN int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
/* 456 */
-EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * pathPtr,
- CONST char * modeString, int permissions));
-#endif
-#ifndef Tcl_FSGetCwd_TCL_DECLARED
-#define Tcl_FSGetCwd_TCL_DECLARED
+EXTERN Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, const char *modeString,
+ int permissions);
/* 457 */
-EXTERN Tcl_Obj* Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_FSChdir_TCL_DECLARED
-#define Tcl_FSChdir_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp);
/* 458 */
-EXTERN int Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef Tcl_FSConvertToPathType_TCL_DECLARED
-#define Tcl_FSConvertToPathType_TCL_DECLARED
+EXTERN int Tcl_FSChdir(Tcl_Obj *pathPtr);
/* 459 */
-EXTERN int Tcl_FSConvertToPathType _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * pathPtr));
-#endif
-#ifndef Tcl_FSJoinPath_TCL_DECLARED
-#define Tcl_FSJoinPath_TCL_DECLARED
+EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/* 460 */
-EXTERN Tcl_Obj* Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj * listObj,
- int elements));
-#endif
-#ifndef Tcl_FSSplitPath_TCL_DECLARED
-#define Tcl_FSSplitPath_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
/* 461 */
-EXTERN Tcl_Obj* Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj* pathPtr,
- int * lenPtr));
-#endif
-#ifndef Tcl_FSEqualPaths_TCL_DECLARED
-#define Tcl_FSEqualPaths_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
/* 462 */
-EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr,
- Tcl_Obj* secondPtr));
-#endif
-#ifndef Tcl_FSGetNormalizedPath_TCL_DECLARED
-#define Tcl_FSGetNormalizedPath_TCL_DECLARED
+EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
+ Tcl_Obj *secondPtr);
/* 463 */
-EXTERN Tcl_Obj* Tcl_FSGetNormalizedPath _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSJoinToPath_TCL_DECLARED
-#define Tcl_FSJoinToPath_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/* 464 */
-EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * pathPtr,
- int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
-#define Tcl_FSGetInternalRep_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
+ Tcl_Obj *const objv[]);
/* 465 */
-EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_((Tcl_Obj* pathPtr,
- Tcl_Filesystem * fsPtr));
-#endif
-#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
-#define Tcl_FSGetTranslatedPath_TCL_DECLARED
+EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem *fsPtr);
/* 466 */
-EXTERN Tcl_Obj* Tcl_FSGetTranslatedPath _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSEvalFile_TCL_DECLARED
-#define Tcl_FSEvalFile_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/* 467 */
-EXTERN int Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * fileName));
-#endif
-#ifndef Tcl_FSNewNativePath_TCL_DECLARED
-#define Tcl_FSNewNativePath_TCL_DECLARED
+EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
-EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_((
- Tcl_Filesystem* fromFilesystem,
- ClientData clientData));
-#endif
-#ifndef Tcl_FSGetNativePath_TCL_DECLARED
-#define Tcl_FSGetNativePath_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSNewNativePath(
+ const Tcl_Filesystem *fromFilesystem,
+ ClientData clientData);
/* 469 */
-EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
-#define Tcl_FSFileSystemInfo_TCL_DECLARED
+EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
-EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_((Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSPathSeparator_TCL_DECLARED
-#define Tcl_FSPathSeparator_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
-EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSListVolumes_TCL_DECLARED
-#define Tcl_FSListVolumes_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
-EXTERN Tcl_Obj* Tcl_FSListVolumes _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_FSRegister_TCL_DECLARED
-#define Tcl_FSRegister_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_FSListVolumes(void);
/* 473 */
-EXTERN int Tcl_FSRegister _ANSI_ARGS_((ClientData clientData,
- Tcl_Filesystem * fsPtr));
-#endif
-#ifndef Tcl_FSUnregister_TCL_DECLARED
-#define Tcl_FSUnregister_TCL_DECLARED
+EXTERN int Tcl_FSRegister(ClientData clientData,
+ const Tcl_Filesystem *fsPtr);
/* 474 */
-EXTERN int Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem * fsPtr));
-#endif
-#ifndef Tcl_FSData_TCL_DECLARED
-#define Tcl_FSData_TCL_DECLARED
+EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
-EXTERN ClientData Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem * fsPtr));
-#endif
-#ifndef Tcl_FSGetTranslatedStringPath_TCL_DECLARED
-#define Tcl_FSGetTranslatedStringPath_TCL_DECLARED
+EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
-EXTERN CONST char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
-#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
+EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/* 477 */
-EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
- Tcl_Obj* pathPtr));
-#endif
-#ifndef Tcl_FSGetPathType_TCL_DECLARED
-#define Tcl_FSGetPathType_TCL_DECLARED
+EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
-EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef Tcl_OutputBuffered_TCL_DECLARED
-#define Tcl_OutputBuffered_TCL_DECLARED
+EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
-EXTERN int Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_FSMountsChanged_TCL_DECLARED
-#define Tcl_FSMountsChanged_TCL_DECLARED
+EXTERN int Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
-EXTERN void Tcl_FSMountsChanged _ANSI_ARGS_((
- Tcl_Filesystem * fsPtr));
-#endif
-#ifndef Tcl_EvalTokensStandard_TCL_DECLARED
-#define Tcl_EvalTokensStandard_TCL_DECLARED
+EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
-EXTERN int Tcl_EvalTokensStandard _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Token * tokenPtr,
- int count));
-#endif
-#ifndef Tcl_GetTime_TCL_DECLARED
-#define Tcl_GetTime_TCL_DECLARED
+EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count);
/* 482 */
-EXTERN void Tcl_GetTime _ANSI_ARGS_((Tcl_Time* timeBuf));
-#endif
-#ifndef Tcl_CreateObjTrace_TCL_DECLARED
-#define Tcl_CreateObjTrace_TCL_DECLARED
+EXTERN void Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
-EXTERN Tcl_Trace Tcl_CreateObjTrace _ANSI_ARGS_((Tcl_Interp* interp,
- int level, int flags,
- Tcl_CmdObjTraceProc* objProc,
- ClientData clientData,
- Tcl_CmdObjTraceDeleteProc* delProc));
-#endif
-#ifndef Tcl_GetCommandInfoFromToken_TCL_DECLARED
-#define Tcl_GetCommandInfoFromToken_TCL_DECLARED
+EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
+ int flags, Tcl_CmdObjTraceProc *objProc,
+ ClientData clientData,
+ Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
-EXTERN int Tcl_GetCommandInfoFromToken _ANSI_ARGS_((
- Tcl_Command token, Tcl_CmdInfo* infoPtr));
-#endif
-#ifndef Tcl_SetCommandInfoFromToken_TCL_DECLARED
-#define Tcl_SetCommandInfoFromToken_TCL_DECLARED
+EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token,
+ Tcl_CmdInfo *infoPtr);
/* 485 */
-EXTERN int Tcl_SetCommandInfoFromToken _ANSI_ARGS_((
- Tcl_Command token,
- CONST Tcl_CmdInfo* infoPtr));
-#endif
-#ifndef Tcl_DbNewWideIntObj_TCL_DECLARED
-#define Tcl_DbNewWideIntObj_TCL_DECLARED
+EXTERN int Tcl_SetCommandInfoFromToken(Tcl_Command token,
+ const Tcl_CmdInfo *infoPtr);
/* 486 */
-EXTERN Tcl_Obj * Tcl_DbNewWideIntObj _ANSI_ARGS_((
- Tcl_WideInt wideValue, CONST char * file,
- int line));
-#endif
-#ifndef Tcl_GetWideIntFromObj_TCL_DECLARED
-#define Tcl_GetWideIntFromObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
+ const char *file, int line);
/* 487 */
-EXTERN int Tcl_GetWideIntFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr,
- Tcl_WideInt * widePtr));
-#endif
-#ifndef Tcl_NewWideIntObj_TCL_DECLARED
-#define Tcl_NewWideIntObj_TCL_DECLARED
+EXTERN int Tcl_GetWideIntFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
/* 488 */
-EXTERN Tcl_Obj * Tcl_NewWideIntObj _ANSI_ARGS_((Tcl_WideInt wideValue));
-#endif
-#ifndef Tcl_SetWideIntObj_TCL_DECLARED
-#define Tcl_SetWideIntObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue);
/* 489 */
-EXTERN void Tcl_SetWideIntObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- Tcl_WideInt wideValue));
-#endif
-#ifndef Tcl_AllocStatBuf_TCL_DECLARED
-#define Tcl_AllocStatBuf_TCL_DECLARED
+EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr,
+ Tcl_WideInt wideValue);
/* 490 */
-EXTERN Tcl_StatBuf * Tcl_AllocStatBuf _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_Seek_TCL_DECLARED
-#define Tcl_Seek_TCL_DECLARED
+EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void);
/* 491 */
-EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_WideInt offset, int mode));
-#endif
-#ifndef Tcl_Tell_TCL_DECLARED
-#define Tcl_Tell_TCL_DECLARED
+EXTERN Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
+ int mode);
/* 492 */
-EXTERN Tcl_WideInt Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
-#endif
-#ifndef Tcl_ChannelWideSeekProc_TCL_DECLARED
-#define Tcl_ChannelWideSeekProc_TCL_DECLARED
+EXTERN Tcl_WideInt Tcl_Tell(Tcl_Channel chan);
/* 493 */
-EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_DictObjPut_TCL_DECLARED
-#define Tcl_DictObjPut_TCL_DECLARED
+EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 494 */
-EXTERN int Tcl_DictObjPut _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * dictPtr, Tcl_Obj * keyPtr,
- Tcl_Obj * valuePtr));
-#endif
-#ifndef Tcl_DictObjGet_TCL_DECLARED
-#define Tcl_DictObjGet_TCL_DECLARED
+EXTERN int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
/* 495 */
-EXTERN int Tcl_DictObjGet _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * dictPtr, Tcl_Obj * keyPtr,
- Tcl_Obj ** valuePtrPtr));
-#endif
-#ifndef Tcl_DictObjRemove_TCL_DECLARED
-#define Tcl_DictObjRemove_TCL_DECLARED
+EXTERN int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
/* 496 */
-EXTERN int Tcl_DictObjRemove _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * dictPtr, Tcl_Obj * keyPtr));
-#endif
-#ifndef Tcl_DictObjSize_TCL_DECLARED
-#define Tcl_DictObjSize_TCL_DECLARED
+EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp,
+ Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
/* 497 */
-EXTERN int Tcl_DictObjSize _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * dictPtr, int * sizePtr));
-#endif
-#ifndef Tcl_DictObjFirst_TCL_DECLARED
-#define Tcl_DictObjFirst_TCL_DECLARED
+EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ int *sizePtr);
/* 498 */
-EXTERN int Tcl_DictObjFirst _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * dictPtr,
- Tcl_DictSearch * searchPtr,
- Tcl_Obj ** keyPtrPtr, Tcl_Obj ** valuePtrPtr,
- int * donePtr));
-#endif
-#ifndef Tcl_DictObjNext_TCL_DECLARED
-#define Tcl_DictObjNext_TCL_DECLARED
+EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp,
+ Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
+ Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
+ int *donePtr);
/* 499 */
-EXTERN void Tcl_DictObjNext _ANSI_ARGS_((
- Tcl_DictSearch * searchPtr,
- Tcl_Obj ** keyPtrPtr, Tcl_Obj ** valuePtrPtr,
- int * donePtr));
-#endif
-#ifndef Tcl_DictObjDone_TCL_DECLARED
-#define Tcl_DictObjDone_TCL_DECLARED
+EXTERN void Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
+ Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
+ int *donePtr);
/* 500 */
-EXTERN void Tcl_DictObjDone _ANSI_ARGS_((
- Tcl_DictSearch * searchPtr));
-#endif
-#ifndef Tcl_DictObjPutKeyList_TCL_DECLARED
-#define Tcl_DictObjPutKeyList_TCL_DECLARED
+EXTERN void Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
/* 501 */
-EXTERN int Tcl_DictObjPutKeyList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * dictPtr,
- int keyc, Tcl_Obj *CONST * keyv,
- Tcl_Obj * valuePtr));
-#endif
-#ifndef Tcl_DictObjRemoveKeyList_TCL_DECLARED
-#define Tcl_DictObjRemoveKeyList_TCL_DECLARED
+EXTERN int Tcl_DictObjPutKeyList(Tcl_Interp *interp,
+ Tcl_Obj *dictPtr, int keyc,
+ Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
/* 502 */
-EXTERN int Tcl_DictObjRemoveKeyList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * dictPtr,
- int keyc, Tcl_Obj *CONST * keyv));
-#endif
-#ifndef Tcl_NewDictObj_TCL_DECLARED
-#define Tcl_NewDictObj_TCL_DECLARED
+EXTERN int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
+ Tcl_Obj *dictPtr, int keyc,
+ Tcl_Obj *const *keyv);
/* 503 */
-EXTERN Tcl_Obj * Tcl_NewDictObj _ANSI_ARGS_((void));
-#endif
-#ifndef Tcl_DbNewDictObj_TCL_DECLARED
-#define Tcl_DbNewDictObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewDictObj(void);
/* 504 */
-EXTERN Tcl_Obj * Tcl_DbNewDictObj _ANSI_ARGS_((CONST char * file,
- int line));
-#endif
-#ifndef Tcl_RegisterConfig_TCL_DECLARED
-#define Tcl_RegisterConfig_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line);
/* 505 */
-EXTERN void Tcl_RegisterConfig _ANSI_ARGS_((Tcl_Interp* interp,
- CONST char* pkgName,
- Tcl_Config* configuration,
- CONST char* valEncoding));
-#endif
-#ifndef Tcl_CreateNamespace_TCL_DECLARED
-#define Tcl_CreateNamespace_TCL_DECLARED
+EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp,
+ const char *pkgName,
+ const Tcl_Config *configuration,
+ const char *valEncoding);
/* 506 */
-EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, ClientData clientData,
- Tcl_NamespaceDeleteProc * deleteProc));
-#endif
-#ifndef Tcl_DeleteNamespace_TCL_DECLARED
-#define Tcl_DeleteNamespace_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
+ const char *name, ClientData clientData,
+ Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
-EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((
- Tcl_Namespace * nsPtr));
-#endif
-#ifndef Tcl_AppendExportList_TCL_DECLARED
-#define Tcl_AppendExportList_TCL_DECLARED
+EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
-EXTERN int Tcl_AppendExportList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Namespace * nsPtr,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_Export_TCL_DECLARED
-#define Tcl_Export_TCL_DECLARED
+EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */
-EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern,
- int resetListFirst));
-#endif
-#ifndef Tcl_Import_TCL_DECLARED
-#define Tcl_Import_TCL_DECLARED
+EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ const char *pattern, int resetListFirst);
/* 510 */
-EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern,
- int allowOverwrite));
-#endif
-#ifndef Tcl_ForgetImport_TCL_DECLARED
-#define Tcl_ForgetImport_TCL_DECLARED
+EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ const char *pattern, int allowOverwrite);
/* 511 */
-EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern));
-#endif
-#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
-#define Tcl_GetCurrentNamespace_TCL_DECLARED
+EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, const char *pattern);
/* 512 */
-EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
-#define Tcl_GetGlobalNamespace_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
/* 513 */
-EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_FindNamespace_TCL_DECLARED
-#define Tcl_FindNamespace_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
/* 514 */
-EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_Namespace * contextNsPtr, int flags));
-#endif
-#ifndef Tcl_FindCommand_TCL_DECLARED
-#define Tcl_FindCommand_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *contextNsPtr, int flags);
/* 515 */
-EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_Namespace * contextNsPtr, int flags));
-#endif
-#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
-#define Tcl_GetCommandFromObj_TCL_DECLARED
+EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+ Tcl_Namespace *contextNsPtr, int flags);
/* 516 */
-EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetCommandFullName_TCL_DECLARED
-#define Tcl_GetCommandFullName_TCL_DECLARED
+EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
/* 517 */
-EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command command,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_FSEvalFileEx_TCL_DECLARED
-#define Tcl_FSEvalFileEx_TCL_DECLARED
+EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
+ Tcl_Command command, Tcl_Obj *objPtr);
/* 518 */
-EXTERN int Tcl_FSEvalFileEx _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * fileName,
- CONST char * encodingName));
-#endif
-#ifndef Tcl_SetExitProc_TCL_DECLARED
-#define Tcl_SetExitProc_TCL_DECLARED
+EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp,
+ Tcl_Obj *fileName, const char *encodingName);
/* 519 */
-EXTERN Tcl_ExitProc * Tcl_SetExitProc _ANSI_ARGS_((Tcl_ExitProc * proc));
-#endif
-#ifndef Tcl_LimitAddHandler_TCL_DECLARED
-#define Tcl_LimitAddHandler_TCL_DECLARED
+EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc);
/* 520 */
-EXTERN void Tcl_LimitAddHandler _ANSI_ARGS_((Tcl_Interp * interp,
- int type, Tcl_LimitHandlerProc * handlerProc,
- ClientData clientData,
- Tcl_LimitHandlerDeleteProc * deleteProc));
-#endif
-#ifndef Tcl_LimitRemoveHandler_TCL_DECLARED
-#define Tcl_LimitRemoveHandler_TCL_DECLARED
+EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData,
+ Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
-EXTERN void Tcl_LimitRemoveHandler _ANSI_ARGS_((
- Tcl_Interp * interp, int type,
- Tcl_LimitHandlerProc * handlerProc,
- ClientData clientData));
-#endif
-#ifndef Tcl_LimitReady_TCL_DECLARED
-#define Tcl_LimitReady_TCL_DECLARED
+EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData);
/* 522 */
-EXTERN int Tcl_LimitReady _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_LimitCheck_TCL_DECLARED
-#define Tcl_LimitCheck_TCL_DECLARED
+EXTERN int Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
-EXTERN int Tcl_LimitCheck _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_LimitExceeded_TCL_DECLARED
-#define Tcl_LimitExceeded_TCL_DECLARED
+EXTERN int Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
-EXTERN int Tcl_LimitExceeded _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_LimitSetCommands_TCL_DECLARED
-#define Tcl_LimitSetCommands_TCL_DECLARED
+EXTERN int Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */
-EXTERN void Tcl_LimitSetCommands _ANSI_ARGS_((
- Tcl_Interp * interp, int commandLimit));
-#endif
-#ifndef Tcl_LimitSetTime_TCL_DECLARED
-#define Tcl_LimitSetTime_TCL_DECLARED
+EXTERN void Tcl_LimitSetCommands(Tcl_Interp *interp,
+ int commandLimit);
/* 526 */
-EXTERN void Tcl_LimitSetTime _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Time * timeLimitPtr));
-#endif
-#ifndef Tcl_LimitSetGranularity_TCL_DECLARED
-#define Tcl_LimitSetGranularity_TCL_DECLARED
+EXTERN void Tcl_LimitSetTime(Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr);
/* 527 */
-EXTERN void Tcl_LimitSetGranularity _ANSI_ARGS_((
- Tcl_Interp * interp, int type,
- int granularity));
-#endif
-#ifndef Tcl_LimitTypeEnabled_TCL_DECLARED
-#define Tcl_LimitTypeEnabled_TCL_DECLARED
+EXTERN void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
+ int granularity);
/* 528 */
-EXTERN int Tcl_LimitTypeEnabled _ANSI_ARGS_((
- Tcl_Interp * interp, int type));
-#endif
-#ifndef Tcl_LimitTypeExceeded_TCL_DECLARED
-#define Tcl_LimitTypeExceeded_TCL_DECLARED
+EXTERN int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
/* 529 */
-EXTERN int Tcl_LimitTypeExceeded _ANSI_ARGS_((
- Tcl_Interp * interp, int type));
-#endif
-#ifndef Tcl_LimitTypeSet_TCL_DECLARED
-#define Tcl_LimitTypeSet_TCL_DECLARED
+EXTERN int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
/* 530 */
-EXTERN void Tcl_LimitTypeSet _ANSI_ARGS_((Tcl_Interp * interp,
- int type));
-#endif
-#ifndef Tcl_LimitTypeReset_TCL_DECLARED
-#define Tcl_LimitTypeReset_TCL_DECLARED
+EXTERN void Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
/* 531 */
-EXTERN void Tcl_LimitTypeReset _ANSI_ARGS_((Tcl_Interp * interp,
- int type));
-#endif
-#ifndef Tcl_LimitGetCommands_TCL_DECLARED
-#define Tcl_LimitGetCommands_TCL_DECLARED
+EXTERN void Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
/* 532 */
-EXTERN int Tcl_LimitGetCommands _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_LimitGetTime_TCL_DECLARED
-#define Tcl_LimitGetTime_TCL_DECLARED
+EXTERN int Tcl_LimitGetCommands(Tcl_Interp *interp);
/* 533 */
-EXTERN void Tcl_LimitGetTime _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Time * timeLimitPtr));
-#endif
-#ifndef Tcl_LimitGetGranularity_TCL_DECLARED
-#define Tcl_LimitGetGranularity_TCL_DECLARED
+EXTERN void Tcl_LimitGetTime(Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr);
/* 534 */
-EXTERN int Tcl_LimitGetGranularity _ANSI_ARGS_((
- Tcl_Interp * interp, int type));
-#endif
-#ifndef Tcl_SaveInterpState_TCL_DECLARED
-#define Tcl_SaveInterpState_TCL_DECLARED
+EXTERN int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
/* 535 */
-EXTERN Tcl_InterpState Tcl_SaveInterpState _ANSI_ARGS_((Tcl_Interp * interp,
- int status));
-#endif
-#ifndef Tcl_RestoreInterpState_TCL_DECLARED
-#define Tcl_RestoreInterpState_TCL_DECLARED
+EXTERN Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status);
/* 536 */
-EXTERN int Tcl_RestoreInterpState _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_InterpState state));
-#endif
-#ifndef Tcl_DiscardInterpState_TCL_DECLARED
-#define Tcl_DiscardInterpState_TCL_DECLARED
+EXTERN int Tcl_RestoreInterpState(Tcl_Interp *interp,
+ Tcl_InterpState state);
/* 537 */
-EXTERN void Tcl_DiscardInterpState _ANSI_ARGS_((
- Tcl_InterpState state));
-#endif
-#ifndef Tcl_SetReturnOptions_TCL_DECLARED
-#define Tcl_SetReturnOptions_TCL_DECLARED
+EXTERN void Tcl_DiscardInterpState(Tcl_InterpState state);
/* 538 */
-EXTERN int Tcl_SetReturnOptions _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * options));
-#endif
-#ifndef Tcl_GetReturnOptions_TCL_DECLARED
-#define Tcl_GetReturnOptions_TCL_DECLARED
+EXTERN int Tcl_SetReturnOptions(Tcl_Interp *interp,
+ Tcl_Obj *options);
/* 539 */
-EXTERN Tcl_Obj * Tcl_GetReturnOptions _ANSI_ARGS_((
- Tcl_Interp * interp, int result));
-#endif
-#ifndef Tcl_IsEnsemble_TCL_DECLARED
-#define Tcl_IsEnsemble_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
/* 540 */
-EXTERN int Tcl_IsEnsemble _ANSI_ARGS_((Tcl_Command token));
-#endif
-#ifndef Tcl_CreateEnsemble_TCL_DECLARED
-#define Tcl_CreateEnsemble_TCL_DECLARED
+EXTERN int Tcl_IsEnsemble(Tcl_Command token);
/* 541 */
-EXTERN Tcl_Command Tcl_CreateEnsemble _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_Namespace * namespacePtr, int flags));
-#endif
-#ifndef Tcl_FindEnsemble_TCL_DECLARED
-#define Tcl_FindEnsemble_TCL_DECLARED
+EXTERN Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *namespacePtr, int flags);
/* 542 */
-EXTERN Tcl_Command Tcl_FindEnsemble _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * cmdNameObj, int flags));
-#endif
-#ifndef Tcl_SetEnsembleSubcommandList_TCL_DECLARED
-#define Tcl_SetEnsembleSubcommandList_TCL_DECLARED
+EXTERN Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp,
+ Tcl_Obj *cmdNameObj, int flags);
/* 543 */
-EXTERN int Tcl_SetEnsembleSubcommandList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj * subcmdList));
-#endif
-#ifndef Tcl_SetEnsembleMappingDict_TCL_DECLARED
-#define Tcl_SetEnsembleMappingDict_TCL_DECLARED
+EXTERN int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj *subcmdList);
/* 544 */
-EXTERN int Tcl_SetEnsembleMappingDict _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj * mapDict));
-#endif
-#ifndef Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
-#define Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
+EXTERN int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj *mapDict);
/* 545 */
-EXTERN int Tcl_SetEnsembleUnknownHandler _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj * unknownList));
-#endif
-#ifndef Tcl_SetEnsembleFlags_TCL_DECLARED
-#define Tcl_SetEnsembleFlags_TCL_DECLARED
+EXTERN int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj *unknownList);
/* 546 */
-EXTERN int Tcl_SetEnsembleFlags _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- int flags));
-#endif
-#ifndef Tcl_GetEnsembleSubcommandList_TCL_DECLARED
-#define Tcl_GetEnsembleSubcommandList_TCL_DECLARED
+EXTERN int Tcl_SetEnsembleFlags(Tcl_Interp *interp,
+ Tcl_Command token, int flags);
/* 547 */
-EXTERN int Tcl_GetEnsembleSubcommandList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj ** subcmdListPtr));
-#endif
-#ifndef Tcl_GetEnsembleMappingDict_TCL_DECLARED
-#define Tcl_GetEnsembleMappingDict_TCL_DECLARED
+EXTERN int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj **subcmdListPtr);
/* 548 */
-EXTERN int Tcl_GetEnsembleMappingDict _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj ** mapDictPtr));
-#endif
-#ifndef Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
-#define Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
+EXTERN int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj **mapDictPtr);
/* 549 */
-EXTERN int Tcl_GetEnsembleUnknownHandler _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Obj ** unknownListPtr));
-#endif
-#ifndef Tcl_GetEnsembleFlags_TCL_DECLARED
-#define Tcl_GetEnsembleFlags_TCL_DECLARED
+EXTERN int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj **unknownListPtr);
/* 550 */
-EXTERN int Tcl_GetEnsembleFlags _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- int * flagsPtr));
-#endif
-#ifndef Tcl_GetEnsembleNamespace_TCL_DECLARED
-#define Tcl_GetEnsembleNamespace_TCL_DECLARED
+EXTERN int Tcl_GetEnsembleFlags(Tcl_Interp *interp,
+ Tcl_Command token, int *flagsPtr);
/* 551 */
-EXTERN int Tcl_GetEnsembleNamespace _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command token,
- Tcl_Namespace ** namespacePtrPtr));
-#endif
-#ifndef Tcl_SetTimeProc_TCL_DECLARED
-#define Tcl_SetTimeProc_TCL_DECLARED
+EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Namespace **namespacePtrPtr);
/* 552 */
-EXTERN void Tcl_SetTimeProc _ANSI_ARGS_((
- Tcl_GetTimeProc* getProc,
- Tcl_ScaleTimeProc* scaleProc,
- ClientData clientData));
-#endif
-#ifndef Tcl_QueryTimeProc_TCL_DECLARED
-#define Tcl_QueryTimeProc_TCL_DECLARED
+EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
+ Tcl_ScaleTimeProc *scaleProc,
+ ClientData clientData);
/* 553 */
-EXTERN void Tcl_QueryTimeProc _ANSI_ARGS_((
- Tcl_GetTimeProc** getProc,
- Tcl_ScaleTimeProc** scaleProc,
- ClientData* clientData));
-#endif
-#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
-#define Tcl_ChannelThreadActionProc_TCL_DECLARED
+EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
+ Tcl_ScaleTimeProc **scaleProc,
+ ClientData *clientData);
/* 554 */
-EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_NewBignumObj_TCL_DECLARED
-#define Tcl_NewBignumObj_TCL_DECLARED
+EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 555 */
-EXTERN Tcl_Obj* Tcl_NewBignumObj _ANSI_ARGS_((mp_int* value));
-#endif
-#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
-#define Tcl_DbNewBignumObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_NewBignumObj(mp_int *value);
/* 556 */
-EXTERN Tcl_Obj* Tcl_DbNewBignumObj _ANSI_ARGS_((mp_int* value,
- CONST char* file, int line));
-#endif
-#ifndef Tcl_SetBignumObj_TCL_DECLARED
-#define Tcl_SetBignumObj_TCL_DECLARED
+EXTERN Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file,
+ int line);
/* 557 */
-EXTERN void Tcl_SetBignumObj _ANSI_ARGS_((Tcl_Obj* obj,
- mp_int* value));
-#endif
-#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
-#define Tcl_GetBignumFromObj_TCL_DECLARED
+EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
/* 558 */
-EXTERN int Tcl_GetBignumFromObj _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj* obj, mp_int* value));
-#endif
-#ifndef Tcl_TruncateChannel_TCL_DECLARED
-#define Tcl_TruncateChannel_TCL_DECLARED
+EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp,
+ Tcl_Obj *obj, mp_int *value);
/* 559 */
-EXTERN int Tcl_TruncateChannel _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_WideInt length));
-#endif
-#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
-#define Tcl_ChannelTruncateProc_TCL_DECLARED
+EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp,
+ Tcl_Obj *obj, mp_int *value);
/* 560 */
-EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc _ANSI_ARGS_((
- Tcl_ChannelType * chanTypePtr));
-#endif
-#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
-#define Tcl_SetChannelErrorInterp_TCL_DECLARED
+EXTERN int Tcl_TruncateChannel(Tcl_Channel chan,
+ Tcl_WideInt length);
/* 561 */
-EXTERN void Tcl_SetChannelErrorInterp _ANSI_ARGS_((
- Tcl_Interp* interp, Tcl_Obj* msg));
-#endif
-#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
-#define Tcl_GetChannelErrorInterp_TCL_DECLARED
+EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
+ const Tcl_ChannelType *chanTypePtr);
/* 562 */
-EXTERN void Tcl_GetChannelErrorInterp _ANSI_ARGS_((
- Tcl_Interp* interp, Tcl_Obj** msg));
-#endif
-#ifndef Tcl_SetChannelError_TCL_DECLARED
-#define Tcl_SetChannelError_TCL_DECLARED
+EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
+ Tcl_Obj *msg);
/* 563 */
-EXTERN void Tcl_SetChannelError _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_Obj* msg));
-#endif
-#ifndef Tcl_GetChannelError_TCL_DECLARED
-#define Tcl_GetChannelError_TCL_DECLARED
+EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
+ Tcl_Obj **msg);
/* 564 */
-EXTERN void Tcl_GetChannelError _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_Obj** msg));
-#endif
+EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
+/* 565 */
+EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
+/* 566 */
+EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp,
+ double initval, mp_int *toInit);
+/* 567 */
+EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr);
+/* 568 */
+EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
+/* 569 */
+EXTERN int Tcl_GetEncodingFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
+/* 570 */
+EXTERN Tcl_Obj * Tcl_GetEncodingSearchPath(void);
+/* 571 */
+EXTERN int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
+/* 572 */
+EXTERN const char * Tcl_GetEncodingNameFromEnvironment(
+ Tcl_DString *bufPtr);
+/* 573 */
+EXTERN int Tcl_PkgRequireProc(Tcl_Interp *interp,
+ const char *name, int objc,
+ Tcl_Obj *const objv[], void *clientDataPtr);
+/* 574 */
+EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+/* 575 */
+EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
+ const char *bytes, int length, int limit,
+ const char *ellipsis);
+/* 576 */
+EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format,
+ int objc, Tcl_Obj *const objv[]);
+/* 577 */
+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, ...) TCL_FORMAT_PRINTF(1, 2);
+/* 579 */
+EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
+ const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
+/* 580 */
+EXTERN int Tcl_CancelEval(Tcl_Interp *interp,
+ Tcl_Obj *resultObjPtr, ClientData clientData,
+ int flags);
+/* 581 */
+EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags);
+/* 582 */
+EXTERN int Tcl_CreatePipe(Tcl_Interp *interp,
+ Tcl_Channel *rchan, Tcl_Channel *wchan,
+ int flags);
+/* 583 */
+EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
+ const char *cmdName, Tcl_ObjCmdProc *proc,
+ Tcl_ObjCmdProc *nreProc,
+ ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc);
+/* 584 */
+EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
+/* 585 */
+EXTERN int Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags);
+/* 586 */
+EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
+ int objc, Tcl_Obj *const objv[], int flags);
+/* 587 */
+EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp,
+ Tcl_NRPostProc *postProcPtr,
+ ClientData data0, ClientData data1,
+ ClientData data2, ClientData data3);
+/* 588 */
+EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp,
+ Tcl_ObjCmdProc *objProc,
+ ClientData clientData, int objc,
+ Tcl_Obj *const objv[]);
+/* 589 */
+EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
+/* 590 */
+EXTERN unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
+/* 591 */
+EXTERN unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
+/* 592 */
+EXTERN int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr);
+/* 593 */
+EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
+/* 594 */
+EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
+/* 595 */
+EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
+/* 596 */
+EXTERN Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
+/* 597 */
+EXTERN Tcl_WideInt Tcl_GetModificationTimeFromStat(
+ const Tcl_StatBuf *statPtr);
+/* 598 */
+EXTERN Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
+/* 599 */
+EXTERN Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
+/* 600 */
+EXTERN Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
+/* 601 */
+EXTERN unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
+/* 602 */
+EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj *paramList);
+/* 603 */
+EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
+ Tcl_Command token, Tcl_Obj **paramListPtr);
+/* 604 */
+EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp,
+ const Tcl_ArgvInfo *argTable, int *objcPtr,
+ Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
+/* 605 */
+EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp);
+/* 606 */
+EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
+/* 607 */
+EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp,
+ int result, Tcl_Interp *targetInterp);
+/* 608 */
+EXTERN int Tcl_InterpActive(Tcl_Interp *interp);
+/* 609 */
+EXTERN void Tcl_BackgroundException(Tcl_Interp *interp, int code);
+/* 610 */
+EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
+ Tcl_Obj *data, int level,
+ Tcl_Obj *gzipHeaderDictObj);
+/* 611 */
+EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format,
+ Tcl_Obj *data, int buffersize,
+ Tcl_Obj *gzipHeaderDictObj);
+/* 612 */
+EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc,
+ const unsigned char *buf, int len);
+/* 613 */
+EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler,
+ const unsigned char *buf, int len);
+/* 614 */
+EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
+ int format, int level, Tcl_Obj *dictObj,
+ Tcl_ZlibStream *zshandle);
+/* 615 */
+EXTERN Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
+/* 616 */
+EXTERN int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
+/* 617 */
+EXTERN int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
+/* 618 */
+EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
+ Tcl_Obj *data, int flush);
+/* 619 */
+EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
+ Tcl_Obj *data, int count);
+/* 620 */
+EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
+/* 621 */
+EXTERN int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
+/* 622 */
+EXTERN void Tcl_SetStartupScript(Tcl_Obj *path,
+ const char *encoding);
+/* 623 */
+EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr);
+/* 624 */
+EXTERN int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan,
+ int flags);
+/* 625 */
+EXTERN int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tcl_Obj *resultPtr);
+/* 626 */
+EXTERN int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
+/* 627 */
+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,
+ 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 {
- struct TclPlatStubs *tclPlatStubs;
- struct TclIntStubs *tclIntStubs;
- struct TclIntPlatStubs *tclIntPlatStubs;
+typedef struct {
+ const struct TclPlatStubs *tclPlatStubs;
+ const struct TclIntStubs *tclIntStubs;
+ const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;
typedef struct TclStubs {
int magic;
- struct TclStubHooks *hooks;
+ const TclStubHooks *hooks;
- int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */
- CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */
- void (*tcl_Panic) _ANSI_ARGS_((CONST char *format, ...)); /* 2 */
- char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
- void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */
- char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */
- char * (*tcl_DbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char * file, int line)); /* 6 */
- int (*tcl_DbCkfree) _ANSI_ARGS_((char * ptr, CONST char * file, int line)); /* 7 */
- char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, CONST char * file, int line)); /* 8 */
-#if !defined(__WIN32__) /* UNIX */
- void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc * proc, ClientData clientData)); /* 9 */
+ 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, ...) 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 */
+ char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
+ void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
+ char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
+#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__
- void *reserved9;
-#endif /* __WIN32__ */
-#if !defined(__WIN32__) /* UNIX */
- void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved9)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
+#endif /* MACOSX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
+ void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
-#ifdef __WIN32__
- void *reserved10;
-#endif /* __WIN32__ */
- void (*tcl_SetTimer) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 11 */
- void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */
- int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 13 */
- int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 14 */
- void (*tcl_AppendStringsToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, ...)); /* 15 */
- void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 16 */
- Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */
- int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)); /* 18 */
- void (*tcl_DbDecrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 19 */
- void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 20 */
- int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 21 */
- Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, CONST char * file, int line)); /* 22 */
- Tcl_Obj * (*tcl_DbNewByteArrayObj) _ANSI_ARGS_((CONST unsigned char * bytes, int length, CONST char * file, int line)); /* 23 */
- Tcl_Obj * (*tcl_DbNewDoubleObj) _ANSI_ARGS_((double doubleValue, CONST char * file, int line)); /* 24 */
- Tcl_Obj * (*tcl_DbNewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST * objv, CONST char * file, int line)); /* 25 */
- Tcl_Obj * (*tcl_DbNewLongObj) _ANSI_ARGS_((long longValue, CONST char * file, int line)); /* 26 */
- Tcl_Obj * (*tcl_DbNewObj) _ANSI_ARGS_((CONST char * file, int line)); /* 27 */
- Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, CONST char * file, int line)); /* 28 */
- Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 29 */
- void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */
- int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * boolPtr)); /* 31 */
- int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 32 */
- unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 33 */
- int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, double * doublePtr)); /* 34 */
- int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 35 */
- int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST84 char ** tablePtr, CONST char * msg, int flags, int * indexPtr)); /* 36 */
- int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * intPtr)); /* 37 */
- int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */
- int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */
- Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((CONST char * typeName)); /* 40 */
- char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 41 */
- void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */
- int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */
- int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */
- int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */
- int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */
- int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * lengthPtr)); /* 47 */
- int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */
- Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */
- Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((CONST unsigned char* bytes, int length)); /* 50 */
- Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */
- Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */
- Tcl_Obj * (*tcl_NewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 53 */
- Tcl_Obj * (*tcl_NewLongObj) _ANSI_ARGS_((long longValue)); /* 54 */
- Tcl_Obj * (*tcl_NewObj) _ANSI_ARGS_((void)); /* 55 */
- Tcl_Obj * (*tcl_NewStringObj) _ANSI_ARGS_((CONST char * bytes, int length)); /* 56 */
- void (*tcl_SetBooleanObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int boolValue)); /* 57 */
- unsigned char * (*tcl_SetByteArrayLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 58 */
- void (*tcl_SetByteArrayObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST unsigned char * bytes, int length)); /* 59 */
- void (*tcl_SetDoubleObj) _ANSI_ARGS_((Tcl_Obj * objPtr, double doubleValue)); /* 60 */
- void (*tcl_SetIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int intValue)); /* 61 */
- void (*tcl_SetListObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int objc, Tcl_Obj *CONST objv[])); /* 62 */
- void (*tcl_SetLongObj) _ANSI_ARGS_((Tcl_Obj * objPtr, long longValue)); /* 63 */
- void (*tcl_SetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 64 */
- void (*tcl_SetStringObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 65 */
- void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */
- void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */
- void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */
- void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * element)); /* 69 */
- void (*tcl_AppendResult) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 70 */
- Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */
- void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */
- int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int code)); /* 73 */
- void (*tcl_AsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 74 */
- int (*tcl_AsyncReady) _ANSI_ARGS_((void)); /* 75 */
- void (*tcl_BackgroundError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 76 */
- char (*tcl_Backslash) _ANSI_ARGS_((CONST char * src, int * readPtr)); /* 77 */
- int (*tcl_BadChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * optionName, CONST char * optionList)); /* 78 */
- void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */
- void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */
- int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */
- int (*tcl_CommandComplete) _ANSI_ARGS_((CONST char * cmd)); /* 82 */
- char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */
- int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */
- int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */
- int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, CONST84 char * CONST * argv)); /* 86 */
- int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */
- Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, CONST char * chanName, ClientData instanceData, int mask)); /* 88 */
- void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */
- void (*tcl_CreateCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 90 */
- Tcl_Command (*tcl_CreateCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 91 */
- void (*tcl_CreateEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 92 */
- void (*tcl_CreateExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 93 */
- Tcl_Interp * (*tcl_CreateInterp) _ANSI_ARGS_((void)); /* 94 */
- void (*tcl_CreateMathFunc) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)); /* 95 */
- Tcl_Command (*tcl_CreateObjCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 96 */
- Tcl_Interp * (*tcl_CreateSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName, int isSafe)); /* 97 */
- Tcl_TimerToken (*tcl_CreateTimerHandler) _ANSI_ARGS_((int milliseconds, Tcl_TimerProc * proc, ClientData clientData)); /* 98 */
- Tcl_Trace (*tcl_CreateTrace) _ANSI_ARGS_((Tcl_Interp * interp, int level, Tcl_CmdTraceProc * proc, ClientData clientData)); /* 99 */
- void (*tcl_DeleteAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 100 */
- void (*tcl_DeleteChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_ChannelProc * proc, ClientData clientData)); /* 101 */
- void (*tcl_DeleteCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 102 */
- int (*tcl_DeleteCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName)); /* 103 */
- int (*tcl_DeleteCommandFromToken) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 104 */
- void (*tcl_DeleteEvents) _ANSI_ARGS_((Tcl_EventDeleteProc * proc, ClientData clientData)); /* 105 */
- void (*tcl_DeleteEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 106 */
- void (*tcl_DeleteExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 107 */
- void (*tcl_DeleteHashEntry) _ANSI_ARGS_((Tcl_HashEntry * entryPtr)); /* 108 */
- void (*tcl_DeleteHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 109 */
- void (*tcl_DeleteInterp) _ANSI_ARGS_((Tcl_Interp * interp)); /* 110 */
-#if !defined(__WIN32__) /* UNIX */
- void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved10)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ void (*tcl_DeleteFileHandler) (int fd); /* 10 */
+#endif /* MACOSX */
+ void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
+ void (*tcl_Sleep) (int ms); /* 12 */
+ int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */
+ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */
+ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
+ void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */
+ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
+ int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
+ void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
+ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
+ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
+ Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
+ Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
+ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
+ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
+ Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
+ Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
+ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
+ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
+ void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
+ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
+ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
+ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
+ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
+ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
+ int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
+ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
+ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
+ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
+ CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
+ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
+ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
+ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
+ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
+ int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
+ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
+ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
+ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
+ Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+ Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
+ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
+ Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+ Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
+ Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
+ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
+ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
+ void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+ unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
+ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
+ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
+ void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+ void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
+ void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
+ void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
+ void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
+ void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
+ void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
+ void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
+ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
+ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
+ Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
+ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
+ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
+ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
+ int (*tcl_AsyncReady) (void); /* 75 */
+ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
+ char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
+ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
+ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
+ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
+ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
+ int (*tcl_CommandComplete) (const char *cmd); /* 82 */
+ char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
+ int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
+ int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
+ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
+ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
+ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
+ void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
+ void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
+ Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
+ void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
+ void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
+ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
+ void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
+ Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
+ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
+ Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
+ Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
+ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
+ void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
+ void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
+ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
+ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
+ void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */
+ void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */
+ void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */
+ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */
+ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */
+ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */
+ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */
+ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */
+ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */
+ void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */
+ int (*tcl_DoOneEvent) (int flags); /* 115 */
+ void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */
+ char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */
+ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */
+ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */
+ void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
+ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
+ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
+ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
+ void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
+ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
+ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
+ CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
+ CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
+ int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
+ int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
+ int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
+ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
+ void (*tcl_Exit) (int status); /* 133 */
+ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
+ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
+ int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
+ int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
+ int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
+ int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
+ int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
+ int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
+ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
+ void (*tcl_Finalize) (void); /* 143 */
+ void (*tcl_FindExecutable) (const char *argv0); /* 144 */
+ Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
+ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
+ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
+ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
+ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+ ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
+ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
+ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
+ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
+ ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
+ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
+ CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
+ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
+ CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
+ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
+ CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
+ int (*tcl_GetErrno) (void); /* 161 */
+ CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
+ int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
+ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
+ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
+ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
+ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
-#ifdef __WIN32__
- void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */
-#endif /* __WIN32__ */
- void (*tcl_DeleteTimerHandler) _ANSI_ARGS_((Tcl_TimerToken token)); /* 112 */
- void (*tcl_DeleteTrace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Trace trace)); /* 113 */
- void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 114 */
- int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */
- void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 116 */
- char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * bytes, int length)); /* 117 */
- char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * element)); /* 118 */
- void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 119 */
- void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 120 */
- void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 121 */
- void (*tcl_DStringInit) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 122 */
- void (*tcl_DStringResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 123 */
- void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */
- void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */
- int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */
- CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
- CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
- int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script)); /* 129 */
- int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */
- int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */
- void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */
- void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */
- int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)); /* 134 */
- int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, int * ptr)); /* 135 */
- int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 136 */
- int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, double * ptr)); /* 137 */
- int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 138 */
- int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, long * ptr)); /* 139 */
- int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */
- int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */
- int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr)); /* 142 */
- void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */
- void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */
- Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */
- int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */
- void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */
- int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, CONST84 char *** argvPtr)); /* 148 */
- int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */
- ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */
- Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanName, int * modePtr)); /* 151 */
- int (*tcl_GetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan)); /* 152 */
- int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */
- ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */
- int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */
- CONST84_RETURN char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
- int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, Tcl_DString * dsPtr)); /* 157 */
- Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */
- int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */
- CONST84_RETURN char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */
- int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */
- CONST84_RETURN char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
- int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */
- Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */
- CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */
- Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 166 */
-#if !defined(__WIN32__) /* UNIX */
- int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanID, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */
-#endif /* UNIX */
-#ifdef __WIN32__
- void *reserved167;
-#endif /* __WIN32__ */
- Tcl_PathType (*tcl_GetPathType) _ANSI_ARGS_((CONST char * path)); /* 168 */
- int (*tcl_Gets) _ANSI_ARGS_((Tcl_Channel chan, Tcl_DString * dsPtr)); /* 169 */
- int (*tcl_GetsObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 170 */
- int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */
- Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName)); /* 172 */
- Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */
- CONST84_RETURN char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */
- CONST84_RETURN char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 175 */
- CONST84_RETURN char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 176 */
- int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command)); /* 177 */
- int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */
- int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 179 */
- int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */
- void (*tcl_InitHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType)); /* 181 */
- int (*tcl_InputBlocked) _ANSI_ARGS_((Tcl_Channel chan)); /* 182 */
- int (*tcl_InputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 183 */
- int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */
- int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */
- char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv, Tcl_DString * resultPtr)); /* 186 */
- int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, char * addr, int type)); /* 187 */
- void *reserved188;
- Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */
- int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */
- Tcl_Channel (*tcl_MakeTcpClientChannel) _ANSI_ARGS_((ClientData tcpSocket)); /* 191 */
- char * (*tcl_Merge) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 192 */
- Tcl_HashEntry * (*tcl_NextHashEntry) _ANSI_ARGS_((Tcl_HashSearch * searchPtr)); /* 193 */
- void (*tcl_NotifyChannel) _ANSI_ARGS_((Tcl_Channel channel, int mask)); /* 194 */
- Tcl_Obj * (*tcl_ObjGetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, int flags)); /* 195 */
- Tcl_Obj * (*tcl_ObjSetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_Obj * newValuePtr, int flags)); /* 196 */
-#if !defined(__WIN32__) /* UNIX */
- Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 197 */
-#endif /* UNIX */
-#ifdef __WIN32__
- Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 197 */
-#endif /* __WIN32__ */
- Tcl_Channel (*tcl_OpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName, CONST char * modeString, int permissions)); /* 198 */
- Tcl_Channel (*tcl_OpenTcpClient) _ANSI_ARGS_((Tcl_Interp * interp, int port, CONST char * address, CONST char * myaddr, int myport, int async)); /* 199 */
- Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, CONST char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */
- void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */
- void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */
- int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * assignment)); /* 203 */
- CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */
- void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */
- int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */
-#if !defined(__WIN32__) /* UNIX */
- void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
-#endif /* UNIX */
-#ifdef __WIN32__
- void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
-#endif /* __WIN32__ */
- int (*tcl_RecordAndEval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmd, int flags)); /* 208 */
- int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 209 */
- void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 210 */
- void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType * typePtr)); /* 211 */
- Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 212 */
- int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * text, CONST char * start)); /* 213 */
- int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * text, CONST char * pattern)); /* 214 */
- void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, CONST84 char ** startPtr, CONST84 char ** endPtr)); /* 215 */
- void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */
- void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */
- int (*tcl_ScanElement) _ANSI_ARGS_((CONST char * str, int * flagPtr)); /* 218 */
- int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 219 */
- int (*tcl_SeekOld) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */
- int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */
- int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */
- void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */
- void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */
- int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, CONST char * newValue)); /* 225 */
- int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST Tcl_CmdInfo * infoPtr)); /* 226 */
- void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */
- void (*tcl_SetErrorCode) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 228 */
- void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */
- void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */
- int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */
- void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * result, Tcl_FreeProc * freeProc)); /* 232 */
- int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */
- void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */
- void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */
- void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */
- CONST84_RETURN char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, CONST char * newValue, int flags)); /* 237 */
- CONST84_RETURN char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */
- CONST84_RETURN char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
- CONST84_RETURN char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
- void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */
- int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, CONST84 char *** argvPtr)); /* 242 */
- void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, CONST84 char *** argvPtr)); /* 243 */
- void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */
- int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */
- int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */
- int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */
- int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */
- char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)); /* 249 */
- int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 250 */
- void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 251 */
- int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */
- int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 253 */
- int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 254 */
- void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
- void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
- void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 257 */
- int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 258 */
- int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */
- int (*tcl_VarEval) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 260 */
- ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
- ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
- int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char * s, int slen)); /* 263 */
- void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], CONST char * message)); /* 264 */
- int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */
- void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */
- void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */
- void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */
- CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
- CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, CONST84 char ** termPtr)); /* 270 */
- CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */
- CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */
- int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */
- CONST84_RETURN char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */
- void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */
- int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */
- Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */
- void (*tcl_PanicVA) _ANSI_ARGS_((CONST char * format, va_list argList)); /* 278 */
- void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
- void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
- Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
- int (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */
- Tcl_Channel (*tcl_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 283 */
- void (*tcl_SetMainLoop) _ANSI_ARGS_((Tcl_MainLoopProc * proc)); /* 284 */
- void *reserved285;
- void (*tcl_AppendObjToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)); /* 286 */
- Tcl_Encoding (*tcl_CreateEncoding) _ANSI_ARGS_((Tcl_EncodingType * typePtr)); /* 287 */
- void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */
- void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */
- void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */
- int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, int numBytes, int flags)); /* 291 */
- int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */
- int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */
- void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */
- int (*tcl_ExternalToUtf) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 295 */
- char * (*tcl_ExternalToUtfDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 296 */
- void (*tcl_FinalizeThread) _ANSI_ARGS_((void)); /* 297 */
- void (*tcl_FinalizeNotifier) _ANSI_ARGS_((ClientData clientData)); /* 298 */
- void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */
- Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */
- Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */
- CONST84_RETURN char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
- void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */
- int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST VOID * tablePtr, int offset, CONST char * msg, int flags, int * indexPtr)); /* 304 */
- VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */
- Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 306 */
- ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */
- void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */
- void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */
- void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 310 */
- void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 311 */
- int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int length)); /* 312 */
- int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 313 */
- void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */
- void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */
- int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */
- Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */
- void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */
- void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */
- Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */
- Tcl_UniChar (*tcl_UniCharToLower) _ANSI_ARGS_((int ch)); /* 321 */
- Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */
- Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */
- int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */
- CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
- int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int length)); /* 326 */
- int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */
- CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */
- CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */
- CONST84_RETURN char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */
- CONST84_RETURN char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */
- int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */
- char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */
- int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */
- int (*tcl_UtfToTitle) _ANSI_ARGS_((char * src)); /* 335 */
- int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 336 */
- int (*tcl_UtfToUpper) _ANSI_ARGS_((char * src)); /* 337 */
- int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
- int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
- char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
- CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
- void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((CONST char * path)); /* 342 */
- void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
- void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
- int (*tcl_UniCharIsAlnum) _ANSI_ARGS_((int ch)); /* 345 */
- int (*tcl_UniCharIsAlpha) _ANSI_ARGS_((int ch)); /* 346 */
- int (*tcl_UniCharIsDigit) _ANSI_ARGS_((int ch)); /* 347 */
- int (*tcl_UniCharIsLower) _ANSI_ARGS_((int ch)); /* 348 */
- int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */
- int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */
- int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */
- int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr)); /* 352 */
- int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 353 */
- char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, int uniLength, Tcl_DString * dsPtr)); /* 354 */
- Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * src, int length, Tcl_DString * dsPtr)); /* 355 */
- Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */
- Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */
- void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */
- void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */
- int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */
- int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
- int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
- int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */
- int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
- char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */
- int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */
- int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */
- int (*tcl_Stat) _ANSI_ARGS_((CONST char * path, struct stat * bufPtr)); /* 368 */
- int (*tcl_UtfNcmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 369 */
- int (*tcl_UtfNcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 370 */
- int (*tcl_StringCaseMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern, int nocase)); /* 371 */
- int (*tcl_UniCharIsControl) _ANSI_ARGS_((int ch)); /* 372 */
- int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */
- int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */
- int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */
- int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * textObj, int offset, int nmatches, int flags)); /* 376 */
- void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 377 */
- Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((CONST Tcl_UniChar * unicode, int numChars)); /* 378 */
- void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)); /* 379 */
- int (*tcl_GetCharLength) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 380 */
- Tcl_UniChar (*tcl_GetUniChar) _ANSI_ARGS_((Tcl_Obj * objPtr, int index)); /* 381 */
- Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 382 */
- Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 383 */
- void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)); /* 384 */
- int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * textObj, Tcl_Obj * patternObj)); /* 385 */
- void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */
- Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */
- int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */
- int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 389 */
- int (*tcl_ProcObjCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 390 */
- void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */
- void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */
- int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */
- int (*tcl_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char * dst, int bytesToRead)); /* 394 */
- int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 395 */
- Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */
- int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */
- CONST84_RETURN char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
- Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */
- Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */
- Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */
- Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 402 */
- Tcl_DriverInputProc * (*tcl_ChannelInputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 403 */
- Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 404 */
- Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 405 */
- Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 406 */
- Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 407 */
- Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 408 */
- Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */
- Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */
- Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */
- int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId threadId, int* result)); /* 412 */
- int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 413 */
- int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 414 */
- void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 415 */
- void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */
- void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */
- int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 418 */
- int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 419 */
- int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, CONST Tcl_UniChar * uniPattern, int nocase)); /* 420 */
- Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key)); /* 421 */
- Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 422 */
- void (*tcl_InitCustomHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 423 */
- void (*tcl_InitObjHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 424 */
- ClientData (*tcl_CommandTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_CommandTraceProc * procPtr, ClientData prevClientData)); /* 425 */
- int (*tcl_TraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 426 */
- void (*tcl_UntraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 427 */
- char * (*tcl_AttemptAlloc) _ANSI_ARGS_((unsigned int size)); /* 428 */
- char * (*tcl_AttemptDbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char * file, int line)); /* 429 */
- char * (*tcl_AttemptRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 430 */
- char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, CONST char * file, int line)); /* 431 */
- int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 432 */
- Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */
- Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 434 */
- int (*tcl_GetMathFuncInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)); /* 435 */
- Tcl_Obj * (*tcl_ListMathFuncs) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 436 */
- Tcl_Obj * (*tcl_SubstObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 437 */
- int (*tcl_DetachChannel) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 438 */
- int (*tcl_IsStandardChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 439 */
- int (*tcl_FSCopyFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 440 */
- int (*tcl_FSCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 441 */
- int (*tcl_FSCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 442 */
- int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */
- int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, Tcl_LoadHandle * handlePtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */
- int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)); /* 445 */
- Tcl_Obj * (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr, int linkAction)); /* 446 */
- int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */
- int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */
- int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 449 */
- int (*tcl_FSUtime) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); /* 450 */
- int (*tcl_FSFileAttrsGet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 451 */
- int (*tcl_FSFileAttrsSet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)); /* 452 */
- CONST char ** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 453 */
- int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 454 */
- int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 455 */
- Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * modeString, int permissions)); /* 456 */
- Tcl_Obj* (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 457 */
- int (*tcl_FSChdir) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 458 */
- int (*tcl_FSConvertToPathType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr)); /* 459 */
- Tcl_Obj* (*tcl_FSJoinPath) _ANSI_ARGS_((Tcl_Obj * listObj, int elements)); /* 460 */
- Tcl_Obj* (*tcl_FSSplitPath) _ANSI_ARGS_((Tcl_Obj* pathPtr, int * lenPtr)); /* 461 */
- int (*tcl_FSEqualPaths) _ANSI_ARGS_((Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)); /* 462 */
- Tcl_Obj* (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 463 */
- Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * pathPtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */
- ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathPtr, Tcl_Filesystem * fsPtr)); /* 465 */
- Tcl_Obj* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */
- int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 467 */
- Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Filesystem* fromFilesystem, ClientData clientData)); /* 468 */
- CONST char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 469 */
- Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 470 */
- Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 471 */
- Tcl_Obj* (*tcl_FSListVolumes) _ANSI_ARGS_((void)); /* 472 */
- int (*tcl_FSRegister) _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); /* 473 */
- int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 474 */
- ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */
- CONST char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */
- Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 477 */
- Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 478 */
- int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */
- void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */
- int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */
- void (*tcl_GetTime) _ANSI_ARGS_((Tcl_Time* timeBuf)); /* 482 */
- Tcl_Trace (*tcl_CreateObjTrace) _ANSI_ARGS_((Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc)); /* 483 */
- int (*tcl_GetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, Tcl_CmdInfo* infoPtr)); /* 484 */
- int (*tcl_SetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, CONST Tcl_CmdInfo* infoPtr)); /* 485 */
- Tcl_Obj * (*tcl_DbNewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue, CONST char * file, int line)); /* 486 */
- int (*tcl_GetWideIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_WideInt * widePtr)); /* 487 */
- Tcl_Obj * (*tcl_NewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue)); /* 488 */
- void (*tcl_SetWideIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_WideInt wideValue)); /* 489 */
- Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */
- Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
- Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
- Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */
- int (*tcl_DictObjPut) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, Tcl_Obj * keyPtr, Tcl_Obj * valuePtr)); /* 494 */
- int (*tcl_DictObjGet) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, Tcl_Obj * keyPtr, Tcl_Obj ** valuePtrPtr)); /* 495 */
- int (*tcl_DictObjRemove) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, Tcl_Obj * keyPtr)); /* 496 */
- int (*tcl_DictObjSize) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, int * sizePtr)); /* 497 */
- int (*tcl_DictObjFirst) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, Tcl_DictSearch * searchPtr, Tcl_Obj ** keyPtrPtr, Tcl_Obj ** valuePtrPtr, int * donePtr)); /* 498 */
- void (*tcl_DictObjNext) _ANSI_ARGS_((Tcl_DictSearch * searchPtr, Tcl_Obj ** keyPtrPtr, Tcl_Obj ** valuePtrPtr, int * donePtr)); /* 499 */
- void (*tcl_DictObjDone) _ANSI_ARGS_((Tcl_DictSearch * searchPtr)); /* 500 */
- int (*tcl_DictObjPutKeyList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, int keyc, Tcl_Obj *CONST * keyv, Tcl_Obj * valuePtr)); /* 501 */
- int (*tcl_DictObjRemoveKeyList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * dictPtr, int keyc, Tcl_Obj *CONST * keyv)); /* 502 */
- Tcl_Obj * (*tcl_NewDictObj) _ANSI_ARGS_((void)); /* 503 */
- Tcl_Obj * (*tcl_DbNewDictObj) _ANSI_ARGS_((CONST char * file, int line)); /* 504 */
- void (*tcl_RegisterConfig) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* pkgName, Tcl_Config* configuration, CONST char* valEncoding)); /* 505 */
- Tcl_Namespace * (*tcl_CreateNamespace) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)); /* 506 */
- void (*tcl_DeleteNamespace) _ANSI_ARGS_((Tcl_Namespace * nsPtr)); /* 507 */
- int (*tcl_AppendExportList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, Tcl_Obj * objPtr)); /* 508 */
- int (*tcl_Export) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern, int resetListFirst)); /* 509 */
- int (*tcl_Import) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern, int allowOverwrite)); /* 510 */
- int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern)); /* 511 */
- Tcl_Namespace * (*tcl_GetCurrentNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 512 */
- Tcl_Namespace * (*tcl_GetGlobalNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 513 */
- Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 514 */
- Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 515 */
- Tcl_Command (*tcl_GetCommandFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 516 */
- void (*tcl_GetCommandFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command, Tcl_Obj * objPtr)); /* 517 */
- int (*tcl_FSEvalFileEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName, CONST char * encodingName)); /* 518 */
- Tcl_ExitProc * (*tcl_SetExitProc) _ANSI_ARGS_((Tcl_ExitProc * proc)); /* 519 */
- void (*tcl_LimitAddHandler) _ANSI_ARGS_((Tcl_Interp * interp, int type, Tcl_LimitHandlerProc * handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc * deleteProc)); /* 520 */
- void (*tcl_LimitRemoveHandler) _ANSI_ARGS_((Tcl_Interp * interp, int type, Tcl_LimitHandlerProc * handlerProc, ClientData clientData)); /* 521 */
- int (*tcl_LimitReady) _ANSI_ARGS_((Tcl_Interp * interp)); /* 522 */
- int (*tcl_LimitCheck) _ANSI_ARGS_((Tcl_Interp * interp)); /* 523 */
- int (*tcl_LimitExceeded) _ANSI_ARGS_((Tcl_Interp * interp)); /* 524 */
- void (*tcl_LimitSetCommands) _ANSI_ARGS_((Tcl_Interp * interp, int commandLimit)); /* 525 */
- void (*tcl_LimitSetTime) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Time * timeLimitPtr)); /* 526 */
- void (*tcl_LimitSetGranularity) _ANSI_ARGS_((Tcl_Interp * interp, int type, int granularity)); /* 527 */
- int (*tcl_LimitTypeEnabled) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 528 */
- int (*tcl_LimitTypeExceeded) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 529 */
- void (*tcl_LimitTypeSet) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 530 */
- void (*tcl_LimitTypeReset) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 531 */
- int (*tcl_LimitGetCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 532 */
- void (*tcl_LimitGetTime) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Time * timeLimitPtr)); /* 533 */
- int (*tcl_LimitGetGranularity) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 534 */
- Tcl_InterpState (*tcl_SaveInterpState) _ANSI_ARGS_((Tcl_Interp * interp, int status)); /* 535 */
- int (*tcl_RestoreInterpState) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpState state)); /* 536 */
- void (*tcl_DiscardInterpState) _ANSI_ARGS_((Tcl_InterpState state)); /* 537 */
- int (*tcl_SetReturnOptions) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * options)); /* 538 */
- Tcl_Obj * (*tcl_GetReturnOptions) _ANSI_ARGS_((Tcl_Interp * interp, int result)); /* 539 */
- int (*tcl_IsEnsemble) _ANSI_ARGS_((Tcl_Command token)); /* 540 */
- Tcl_Command (*tcl_CreateEnsemble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * namespacePtr, int flags)); /* 541 */
- Tcl_Command (*tcl_FindEnsemble) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdNameObj, int flags)); /* 542 */
- int (*tcl_SetEnsembleSubcommandList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * subcmdList)); /* 543 */
- int (*tcl_SetEnsembleMappingDict) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * mapDict)); /* 544 */
- int (*tcl_SetEnsembleUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * unknownList)); /* 545 */
- int (*tcl_SetEnsembleFlags) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, int flags)); /* 546 */
- int (*tcl_GetEnsembleSubcommandList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** subcmdListPtr)); /* 547 */
- int (*tcl_GetEnsembleMappingDict) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** mapDictPtr)); /* 548 */
- int (*tcl_GetEnsembleUnknownHandler) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** unknownListPtr)); /* 549 */
- int (*tcl_GetEnsembleFlags) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, int * flagsPtr)); /* 550 */
- int (*tcl_GetEnsembleNamespace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Namespace ** namespacePtrPtr)); /* 551 */
- void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
- void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
- Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
- Tcl_Obj* (*tcl_NewBignumObj) _ANSI_ARGS_((mp_int* value)); /* 555 */
- Tcl_Obj* (*tcl_DbNewBignumObj) _ANSI_ARGS_((mp_int* value, CONST char* file, int line)); /* 556 */
- void (*tcl_SetBignumObj) _ANSI_ARGS_((Tcl_Obj* obj, mp_int* value)); /* 557 */
- int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */
- int (*tcl_TruncateChannel) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt length)); /* 559 */
- Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 560 */
- void (*tcl_SetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* msg)); /* 561 */
- void (*tcl_GetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj** msg)); /* 562 */
- void (*tcl_SetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj* msg)); /* 563 */
- void (*tcl_GetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj** msg)); /* 564 */
+#if defined(_WIN32) /* WIN */
+ void (*reserved167)(void);
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
+#endif /* MACOSX */
+ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
+ int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
+ int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
+ int (*tcl_GetServiceMode) (void); /* 171 */
+ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
+ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
+ CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
+ CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
+ CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
+ int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
+ int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
+ int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
+ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
+ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
+ int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
+ int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
+ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
+ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
+ char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
+ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
+ void (*reserved188)(void);
+ Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
+ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
+ Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
+ char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
+ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
+ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
+ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
+ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
+ Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
+ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
+ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
+ Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
+ void (*tcl_Preserve) (ClientData data); /* 201 */
+ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
+ int (*tcl_PutEnv) (const char *assignment); /* 203 */
+ CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
+ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
+ int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
+ void (*tcl_ReapDetachedProcs) (void); /* 207 */
+ int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
+ int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
+ void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
+ void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
+ Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
+ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
+ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
+ 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 *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 */
+ void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
+ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
+ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
+ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
+ void (*tcl_SetErrno) (int err); /* 227 */
+ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
+ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
+ void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
+ int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
+ void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
+ int (*tcl_SetServiceMode) (int mode); /* 233 */
+ void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
+ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
+ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
+ CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
+ CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
+ CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
+ CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
+ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
+ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
+ void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
+ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
+ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
+ int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
+ int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
+ int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
+ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
+ int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
+ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
+ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
+ int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
+ int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
+ void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+ void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
+ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
+ int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
+ int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
+ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
+ ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+ ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
+ int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
+ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
+ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
+ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
+ void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
+ void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
+ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
+ CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
+ CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
+ CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
+ int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
+ CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
+ void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
+ int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
+ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
+ void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+ void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
+ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
+ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
+ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
+ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
+ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
+ void (*reserved285)(void);
+ void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
+ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
+ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
+ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
+ void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */
+ int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
+ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
+ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
+ void (*tcl_ExitThread) (int status); /* 294 */
+ int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
+ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
+ void (*tcl_FinalizeThread) (void); /* 297 */
+ void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
+ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
+ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
+ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
+ CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
+ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
+ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
+ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
+ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
+ ClientData (*tcl_InitNotifier) (void); /* 307 */
+ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
+ void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
+ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
+ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
+ int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */
+ int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
+ void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
+ void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
+ int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
+ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
+ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
+ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
+ Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
+ Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
+ Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
+ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
+ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
+ CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
+ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
+ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
+ CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
+ CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
+ CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
+ CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
+ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
+ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
+ int (*tcl_UtfToLower) (char *src); /* 334 */
+ int (*tcl_UtfToTitle) (char *src); /* 335 */
+ int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
+ int (*tcl_UtfToUpper) (char *src); /* 337 */
+ int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
+ int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
+ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
+ CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
+ void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
+ void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
+ void (*tcl_ServiceModeHook) (int mode); /* 344 */
+ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
+ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
+ int (*tcl_UniCharIsDigit) (int ch); /* 347 */
+ int (*tcl_UniCharIsLower) (int ch); /* 348 */
+ int (*tcl_UniCharIsSpace) (int ch); /* 349 */
+ int (*tcl_UniCharIsUpper) (int ch); /* 350 */
+ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
+ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
+ int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
+ char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
+ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
+ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
+ Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
+ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
+ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
+ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
+ int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
+ int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
+ int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
+ int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
+ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
+ int (*tcl_Chdir) (const char *dirName); /* 366 */
+ int (*tcl_Access) (const char *path, int mode); /* 367 */
+ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
+ int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */
+ int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */
+ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
+ int (*tcl_UniCharIsControl) (int ch); /* 372 */
+ int (*tcl_UniCharIsGraph) (int ch); /* 373 */
+ int (*tcl_UniCharIsPrint) (int ch); /* 374 */
+ int (*tcl_UniCharIsPunct) (int ch); /* 375 */
+ int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
+ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
+ Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
+ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
+ int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
+ Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
+ Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
+ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
+ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
+ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
+ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
+ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
+ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
+ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
+ int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
+ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
+ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
+ int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */
+ int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
+ int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
+ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
+ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
+ CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
+ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
+ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
+ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
+ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
+ Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
+ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
+ Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
+ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */
+ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */
+ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */
+ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */
+ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */
+ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr); /* 411 */
+ int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
+ int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
+ int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
+ void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
+ void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
+ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
+ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
+ int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
+ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
+ Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
+ Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
+ void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
+ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
+ ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
+ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
+ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
+ char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
+ char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
+ char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
+ char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
+ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
+ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
+ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
+ int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
+ Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
+ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
+ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
+ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
+ int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
+ int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
+ int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
+ int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
+ int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
+ int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
+ Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
+ int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
+ int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */
+ int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */
+ int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
+ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
+ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
+ const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
+ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
+ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
+ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
+ Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
+ int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
+ int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
+ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
+ Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
+ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
+ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
+ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */
+ ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
+ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
+ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
+ Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
+ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
+ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
+ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
+ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
+ int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */
+ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
+ ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
+ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
+ CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
+ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
+ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
+ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
+ int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */
+ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
+ Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
+ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
+ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
+ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
+ int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
+ Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
+ void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
+ Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
+ Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
+ Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
+ Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
+ int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
+ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
+ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
+ int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
+ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
+ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
+ void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
+ int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
+ int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */
+ Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
+ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */
+ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */
+ Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
+ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */
+ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */
+ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */
+ int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */
+ int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */
+ Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */
+ Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */
+ Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
+ Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
+ Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
+ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
+ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
+ Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc); /* 519 */
+ void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
+ void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
+ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
+ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
+ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
+ void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
+ void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
+ void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
+ int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */
+ int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */
+ void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */
+ void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */
+ int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
+ void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */
+ int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */
+ Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */
+ int (*tcl_RestoreInterpState) (Tcl_Interp *interp, Tcl_InterpState state); /* 536 */
+ void (*tcl_DiscardInterpState) (Tcl_InterpState state); /* 537 */
+ int (*tcl_SetReturnOptions) (Tcl_Interp *interp, Tcl_Obj *options); /* 538 */
+ Tcl_Obj * (*tcl_GetReturnOptions) (Tcl_Interp *interp, int result); /* 539 */
+ int (*tcl_IsEnsemble) (Tcl_Command token); /* 540 */
+ Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 541 */
+ Tcl_Command (*tcl_FindEnsemble) (Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 542 */
+ int (*tcl_SetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 543 */
+ int (*tcl_SetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 544 */
+ int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */
+ int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */
+ int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */
+ int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */
+ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */
+ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */
+ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */
+ void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */
+ void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */
+ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */
+ Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */
+ Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */
+ void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */
+ int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */
+ int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */
+ int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
+ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */
+ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
+ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
+ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */
+ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */
+ int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit); /* 566 */
+ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */
+ int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */
+ int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
+ Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
+ int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
+ const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
+ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */
+ void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
+ 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, ...) 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 */
+ Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */
+ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
+ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
+ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
+ void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
+ int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
+ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
+ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
+ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
+ int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
+ int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
+ int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
+ int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
+ Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
+ Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
+ Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
+ Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
+ Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
+ unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
+ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
+ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
+ int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
+ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
+ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
+ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */
+ int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
+ void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
+ int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
+ int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
+ unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */
+ unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */
+ int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */
+ Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */
+ int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */
+ int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */
+ int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */
+ int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */
+ int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */
+ int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
+ void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
+ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
+ int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
+ 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 */
+ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
+ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
} TclStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern TclStubs *tclStubsPtr;
+extern const TclStubs *tclStubsPtr;
+
#ifdef __cplusplus
}
#endif
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
-#ifndef Tcl_PkgProvideEx
#define Tcl_PkgProvideEx \
(tclStubsPtr->tcl_PkgProvideEx) /* 0 */
-#endif
-#ifndef Tcl_PkgRequireEx
#define Tcl_PkgRequireEx \
(tclStubsPtr->tcl_PkgRequireEx) /* 1 */
-#endif
-#ifndef Tcl_Panic
#define Tcl_Panic \
(tclStubsPtr->tcl_Panic) /* 2 */
-#endif
-#ifndef Tcl_Alloc
#define Tcl_Alloc \
(tclStubsPtr->tcl_Alloc) /* 3 */
-#endif
-#ifndef Tcl_Free
#define Tcl_Free \
(tclStubsPtr->tcl_Free) /* 4 */
-#endif
-#ifndef Tcl_Realloc
#define Tcl_Realloc \
(tclStubsPtr->tcl_Realloc) /* 5 */
-#endif
-#ifndef Tcl_DbCkalloc
#define Tcl_DbCkalloc \
(tclStubsPtr->tcl_DbCkalloc) /* 6 */
-#endif
-#ifndef Tcl_DbCkfree
#define Tcl_DbCkfree \
(tclStubsPtr->tcl_DbCkfree) /* 7 */
-#endif
-#ifndef Tcl_DbCkrealloc
#define Tcl_DbCkrealloc \
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_CreateFileHandler
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
-#endif
#endif /* UNIX */
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_DeleteFileHandler
+#ifdef MAC_OSX_TCL /* MACOSX */
+#define Tcl_CreateFileHandler \
+ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */
+#endif /* MACOSX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
-#endif
#endif /* UNIX */
-#ifndef Tcl_SetTimer
+#ifdef MAC_OSX_TCL /* MACOSX */
+#define Tcl_DeleteFileHandler \
+ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
+#endif /* MACOSX */
#define Tcl_SetTimer \
(tclStubsPtr->tcl_SetTimer) /* 11 */
-#endif
-#ifndef Tcl_Sleep
#define Tcl_Sleep \
(tclStubsPtr->tcl_Sleep) /* 12 */
-#endif
-#ifndef Tcl_WaitForEvent
#define Tcl_WaitForEvent \
(tclStubsPtr->tcl_WaitForEvent) /* 13 */
-#endif
-#ifndef Tcl_AppendAllObjTypes
#define Tcl_AppendAllObjTypes \
(tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */
-#endif
-#ifndef Tcl_AppendStringsToObj
#define Tcl_AppendStringsToObj \
(tclStubsPtr->tcl_AppendStringsToObj) /* 15 */
-#endif
-#ifndef Tcl_AppendToObj
#define Tcl_AppendToObj \
(tclStubsPtr->tcl_AppendToObj) /* 16 */
-#endif
-#ifndef Tcl_ConcatObj
#define Tcl_ConcatObj \
(tclStubsPtr->tcl_ConcatObj) /* 17 */
-#endif
-#ifndef Tcl_ConvertToType
#define Tcl_ConvertToType \
(tclStubsPtr->tcl_ConvertToType) /* 18 */
-#endif
-#ifndef Tcl_DbDecrRefCount
#define Tcl_DbDecrRefCount \
(tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
-#endif
-#ifndef Tcl_DbIncrRefCount
#define Tcl_DbIncrRefCount \
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
-#endif
-#ifndef Tcl_DbIsShared
#define Tcl_DbIsShared \
(tclStubsPtr->tcl_DbIsShared) /* 21 */
-#endif
-#ifndef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj \
(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
-#endif
-#ifndef Tcl_DbNewByteArrayObj
#define Tcl_DbNewByteArrayObj \
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
-#endif
-#ifndef Tcl_DbNewDoubleObj
#define Tcl_DbNewDoubleObj \
(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
-#endif
-#ifndef Tcl_DbNewListObj
#define Tcl_DbNewListObj \
(tclStubsPtr->tcl_DbNewListObj) /* 25 */
-#endif
-#ifndef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj \
(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
-#endif
-#ifndef Tcl_DbNewObj
#define Tcl_DbNewObj \
(tclStubsPtr->tcl_DbNewObj) /* 27 */
-#endif
-#ifndef Tcl_DbNewStringObj
#define Tcl_DbNewStringObj \
(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
-#endif
-#ifndef Tcl_DuplicateObj
#define Tcl_DuplicateObj \
(tclStubsPtr->tcl_DuplicateObj) /* 29 */
-#endif
-#ifndef TclFreeObj
#define TclFreeObj \
(tclStubsPtr->tclFreeObj) /* 30 */
-#endif
-#ifndef Tcl_GetBoolean
#define Tcl_GetBoolean \
(tclStubsPtr->tcl_GetBoolean) /* 31 */
-#endif
-#ifndef Tcl_GetBooleanFromObj
#define Tcl_GetBooleanFromObj \
(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
-#endif
-#ifndef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj \
(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
-#endif
-#ifndef Tcl_GetDouble
#define Tcl_GetDouble \
(tclStubsPtr->tcl_GetDouble) /* 34 */
-#endif
-#ifndef Tcl_GetDoubleFromObj
#define Tcl_GetDoubleFromObj \
(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
-#endif
-#ifndef Tcl_GetIndexFromObj
#define Tcl_GetIndexFromObj \
(tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
-#endif
-#ifndef Tcl_GetInt
#define Tcl_GetInt \
(tclStubsPtr->tcl_GetInt) /* 37 */
-#endif
-#ifndef Tcl_GetIntFromObj
#define Tcl_GetIntFromObj \
(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
-#endif
-#ifndef Tcl_GetLongFromObj
#define Tcl_GetLongFromObj \
(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
-#endif
-#ifndef Tcl_GetObjType
#define Tcl_GetObjType \
(tclStubsPtr->tcl_GetObjType) /* 40 */
-#endif
-#ifndef Tcl_GetStringFromObj
#define Tcl_GetStringFromObj \
(tclStubsPtr->tcl_GetStringFromObj) /* 41 */
-#endif
-#ifndef Tcl_InvalidateStringRep
#define Tcl_InvalidateStringRep \
(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
-#endif
-#ifndef Tcl_ListObjAppendList
#define Tcl_ListObjAppendList \
(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
-#endif
-#ifndef Tcl_ListObjAppendElement
#define Tcl_ListObjAppendElement \
(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
-#endif
-#ifndef Tcl_ListObjGetElements
#define Tcl_ListObjGetElements \
(tclStubsPtr->tcl_ListObjGetElements) /* 45 */
-#endif
-#ifndef Tcl_ListObjIndex
#define Tcl_ListObjIndex \
(tclStubsPtr->tcl_ListObjIndex) /* 46 */
-#endif
-#ifndef Tcl_ListObjLength
#define Tcl_ListObjLength \
(tclStubsPtr->tcl_ListObjLength) /* 47 */
-#endif
-#ifndef Tcl_ListObjReplace
#define Tcl_ListObjReplace \
(tclStubsPtr->tcl_ListObjReplace) /* 48 */
-#endif
-#ifndef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj \
(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
-#endif
-#ifndef Tcl_NewByteArrayObj
#define Tcl_NewByteArrayObj \
(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
-#endif
-#ifndef Tcl_NewDoubleObj
#define Tcl_NewDoubleObj \
(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
-#endif
-#ifndef Tcl_NewIntObj
#define Tcl_NewIntObj \
(tclStubsPtr->tcl_NewIntObj) /* 52 */
-#endif
-#ifndef Tcl_NewListObj
#define Tcl_NewListObj \
(tclStubsPtr->tcl_NewListObj) /* 53 */
-#endif
-#ifndef Tcl_NewLongObj
#define Tcl_NewLongObj \
(tclStubsPtr->tcl_NewLongObj) /* 54 */
-#endif
-#ifndef Tcl_NewObj
#define Tcl_NewObj \
(tclStubsPtr->tcl_NewObj) /* 55 */
-#endif
-#ifndef Tcl_NewStringObj
#define Tcl_NewStringObj \
(tclStubsPtr->tcl_NewStringObj) /* 56 */
-#endif
-#ifndef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj \
(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
-#endif
-#ifndef Tcl_SetByteArrayLength
#define Tcl_SetByteArrayLength \
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
-#endif
-#ifndef Tcl_SetByteArrayObj
#define Tcl_SetByteArrayObj \
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
-#endif
-#ifndef Tcl_SetDoubleObj
#define Tcl_SetDoubleObj \
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
-#endif
-#ifndef Tcl_SetIntObj
#define Tcl_SetIntObj \
(tclStubsPtr->tcl_SetIntObj) /* 61 */
-#endif
-#ifndef Tcl_SetListObj
#define Tcl_SetListObj \
(tclStubsPtr->tcl_SetListObj) /* 62 */
-#endif
-#ifndef Tcl_SetLongObj
#define Tcl_SetLongObj \
(tclStubsPtr->tcl_SetLongObj) /* 63 */
-#endif
-#ifndef Tcl_SetObjLength
#define Tcl_SetObjLength \
(tclStubsPtr->tcl_SetObjLength) /* 64 */
-#endif
-#ifndef Tcl_SetStringObj
#define Tcl_SetStringObj \
(tclStubsPtr->tcl_SetStringObj) /* 65 */
-#endif
-#ifndef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo \
(tclStubsPtr->tcl_AddErrorInfo) /* 66 */
-#endif
-#ifndef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo \
(tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
-#endif
-#ifndef Tcl_AllowExceptions
#define Tcl_AllowExceptions \
(tclStubsPtr->tcl_AllowExceptions) /* 68 */
-#endif
-#ifndef Tcl_AppendElement
#define Tcl_AppendElement \
(tclStubsPtr->tcl_AppendElement) /* 69 */
-#endif
-#ifndef Tcl_AppendResult
#define Tcl_AppendResult \
(tclStubsPtr->tcl_AppendResult) /* 70 */
-#endif
-#ifndef Tcl_AsyncCreate
#define Tcl_AsyncCreate \
(tclStubsPtr->tcl_AsyncCreate) /* 71 */
-#endif
-#ifndef Tcl_AsyncDelete
#define Tcl_AsyncDelete \
(tclStubsPtr->tcl_AsyncDelete) /* 72 */
-#endif
-#ifndef Tcl_AsyncInvoke
#define Tcl_AsyncInvoke \
(tclStubsPtr->tcl_AsyncInvoke) /* 73 */
-#endif
-#ifndef Tcl_AsyncMark
#define Tcl_AsyncMark \
(tclStubsPtr->tcl_AsyncMark) /* 74 */
-#endif
-#ifndef Tcl_AsyncReady
#define Tcl_AsyncReady \
(tclStubsPtr->tcl_AsyncReady) /* 75 */
-#endif
-#ifndef Tcl_BackgroundError
#define Tcl_BackgroundError \
(tclStubsPtr->tcl_BackgroundError) /* 76 */
-#endif
-#ifndef Tcl_Backslash
#define Tcl_Backslash \
(tclStubsPtr->tcl_Backslash) /* 77 */
-#endif
-#ifndef Tcl_BadChannelOption
#define Tcl_BadChannelOption \
(tclStubsPtr->tcl_BadChannelOption) /* 78 */
-#endif
-#ifndef Tcl_CallWhenDeleted
#define Tcl_CallWhenDeleted \
(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
-#endif
-#ifndef Tcl_CancelIdleCall
#define Tcl_CancelIdleCall \
(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
-#endif
-#ifndef Tcl_Close
#define Tcl_Close \
(tclStubsPtr->tcl_Close) /* 81 */
-#endif
-#ifndef Tcl_CommandComplete
#define Tcl_CommandComplete \
(tclStubsPtr->tcl_CommandComplete) /* 82 */
-#endif
-#ifndef Tcl_Concat
#define Tcl_Concat \
(tclStubsPtr->tcl_Concat) /* 83 */
-#endif
-#ifndef Tcl_ConvertElement
#define Tcl_ConvertElement \
(tclStubsPtr->tcl_ConvertElement) /* 84 */
-#endif
-#ifndef Tcl_ConvertCountedElement
#define Tcl_ConvertCountedElement \
(tclStubsPtr->tcl_ConvertCountedElement) /* 85 */
-#endif
-#ifndef Tcl_CreateAlias
#define Tcl_CreateAlias \
(tclStubsPtr->tcl_CreateAlias) /* 86 */
-#endif
-#ifndef Tcl_CreateAliasObj
#define Tcl_CreateAliasObj \
(tclStubsPtr->tcl_CreateAliasObj) /* 87 */
-#endif
-#ifndef Tcl_CreateChannel
#define Tcl_CreateChannel \
(tclStubsPtr->tcl_CreateChannel) /* 88 */
-#endif
-#ifndef Tcl_CreateChannelHandler
#define Tcl_CreateChannelHandler \
(tclStubsPtr->tcl_CreateChannelHandler) /* 89 */
-#endif
-#ifndef Tcl_CreateCloseHandler
#define Tcl_CreateCloseHandler \
(tclStubsPtr->tcl_CreateCloseHandler) /* 90 */
-#endif
-#ifndef Tcl_CreateCommand
#define Tcl_CreateCommand \
(tclStubsPtr->tcl_CreateCommand) /* 91 */
-#endif
-#ifndef Tcl_CreateEventSource
#define Tcl_CreateEventSource \
(tclStubsPtr->tcl_CreateEventSource) /* 92 */
-#endif
-#ifndef Tcl_CreateExitHandler
#define Tcl_CreateExitHandler \
(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
-#endif
-#ifndef Tcl_CreateInterp
#define Tcl_CreateInterp \
(tclStubsPtr->tcl_CreateInterp) /* 94 */
-#endif
-#ifndef Tcl_CreateMathFunc
#define Tcl_CreateMathFunc \
(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
-#endif
-#ifndef Tcl_CreateObjCommand
#define Tcl_CreateObjCommand \
(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
-#endif
-#ifndef Tcl_CreateSlave
#define Tcl_CreateSlave \
(tclStubsPtr->tcl_CreateSlave) /* 97 */
-#endif
-#ifndef Tcl_CreateTimerHandler
#define Tcl_CreateTimerHandler \
(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
-#endif
-#ifndef Tcl_CreateTrace
#define Tcl_CreateTrace \
(tclStubsPtr->tcl_CreateTrace) /* 99 */
-#endif
-#ifndef Tcl_DeleteAssocData
#define Tcl_DeleteAssocData \
(tclStubsPtr->tcl_DeleteAssocData) /* 100 */
-#endif
-#ifndef Tcl_DeleteChannelHandler
#define Tcl_DeleteChannelHandler \
(tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */
-#endif
-#ifndef Tcl_DeleteCloseHandler
#define Tcl_DeleteCloseHandler \
(tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */
-#endif
-#ifndef Tcl_DeleteCommand
#define Tcl_DeleteCommand \
(tclStubsPtr->tcl_DeleteCommand) /* 103 */
-#endif
-#ifndef Tcl_DeleteCommandFromToken
#define Tcl_DeleteCommandFromToken \
(tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */
-#endif
-#ifndef Tcl_DeleteEvents
#define Tcl_DeleteEvents \
(tclStubsPtr->tcl_DeleteEvents) /* 105 */
-#endif
-#ifndef Tcl_DeleteEventSource
#define Tcl_DeleteEventSource \
(tclStubsPtr->tcl_DeleteEventSource) /* 106 */
-#endif
-#ifndef Tcl_DeleteExitHandler
#define Tcl_DeleteExitHandler \
(tclStubsPtr->tcl_DeleteExitHandler) /* 107 */
-#endif
-#ifndef Tcl_DeleteHashEntry
#define Tcl_DeleteHashEntry \
(tclStubsPtr->tcl_DeleteHashEntry) /* 108 */
-#endif
-#ifndef Tcl_DeleteHashTable
#define Tcl_DeleteHashTable \
(tclStubsPtr->tcl_DeleteHashTable) /* 109 */
-#endif
-#ifndef Tcl_DeleteInterp
#define Tcl_DeleteInterp \
(tclStubsPtr->tcl_DeleteInterp) /* 110 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_DetachPids
-#define Tcl_DetachPids \
- (tclStubsPtr->tcl_DetachPids) /* 111 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_DetachPids
#define Tcl_DetachPids \
(tclStubsPtr->tcl_DetachPids) /* 111 */
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_DeleteTimerHandler
#define Tcl_DeleteTimerHandler \
(tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */
-#endif
-#ifndef Tcl_DeleteTrace
#define Tcl_DeleteTrace \
(tclStubsPtr->tcl_DeleteTrace) /* 113 */
-#endif
-#ifndef Tcl_DontCallWhenDeleted
#define Tcl_DontCallWhenDeleted \
(tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */
-#endif
-#ifndef Tcl_DoOneEvent
#define Tcl_DoOneEvent \
(tclStubsPtr->tcl_DoOneEvent) /* 115 */
-#endif
-#ifndef Tcl_DoWhenIdle
#define Tcl_DoWhenIdle \
(tclStubsPtr->tcl_DoWhenIdle) /* 116 */
-#endif
-#ifndef Tcl_DStringAppend
#define Tcl_DStringAppend \
(tclStubsPtr->tcl_DStringAppend) /* 117 */
-#endif
-#ifndef Tcl_DStringAppendElement
#define Tcl_DStringAppendElement \
(tclStubsPtr->tcl_DStringAppendElement) /* 118 */
-#endif
-#ifndef Tcl_DStringEndSublist
#define Tcl_DStringEndSublist \
(tclStubsPtr->tcl_DStringEndSublist) /* 119 */
-#endif
-#ifndef Tcl_DStringFree
#define Tcl_DStringFree \
(tclStubsPtr->tcl_DStringFree) /* 120 */
-#endif
-#ifndef Tcl_DStringGetResult
#define Tcl_DStringGetResult \
(tclStubsPtr->tcl_DStringGetResult) /* 121 */
-#endif
-#ifndef Tcl_DStringInit
#define Tcl_DStringInit \
(tclStubsPtr->tcl_DStringInit) /* 122 */
-#endif
-#ifndef Tcl_DStringResult
#define Tcl_DStringResult \
(tclStubsPtr->tcl_DStringResult) /* 123 */
-#endif
-#ifndef Tcl_DStringSetLength
#define Tcl_DStringSetLength \
(tclStubsPtr->tcl_DStringSetLength) /* 124 */
-#endif
-#ifndef Tcl_DStringStartSublist
#define Tcl_DStringStartSublist \
(tclStubsPtr->tcl_DStringStartSublist) /* 125 */
-#endif
-#ifndef Tcl_Eof
#define Tcl_Eof \
(tclStubsPtr->tcl_Eof) /* 126 */
-#endif
-#ifndef Tcl_ErrnoId
#define Tcl_ErrnoId \
(tclStubsPtr->tcl_ErrnoId) /* 127 */
-#endif
-#ifndef Tcl_ErrnoMsg
#define Tcl_ErrnoMsg \
(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
-#endif
-#ifndef Tcl_Eval
#define Tcl_Eval \
(tclStubsPtr->tcl_Eval) /* 129 */
-#endif
-#ifndef Tcl_EvalFile
#define Tcl_EvalFile \
(tclStubsPtr->tcl_EvalFile) /* 130 */
-#endif
-#ifndef Tcl_EvalObj
#define Tcl_EvalObj \
(tclStubsPtr->tcl_EvalObj) /* 131 */
-#endif
-#ifndef Tcl_EventuallyFree
#define Tcl_EventuallyFree \
(tclStubsPtr->tcl_EventuallyFree) /* 132 */
-#endif
-#ifndef Tcl_Exit
#define Tcl_Exit \
(tclStubsPtr->tcl_Exit) /* 133 */
-#endif
-#ifndef Tcl_ExposeCommand
#define Tcl_ExposeCommand \
(tclStubsPtr->tcl_ExposeCommand) /* 134 */
-#endif
-#ifndef Tcl_ExprBoolean
#define Tcl_ExprBoolean \
(tclStubsPtr->tcl_ExprBoolean) /* 135 */
-#endif
-#ifndef Tcl_ExprBooleanObj
#define Tcl_ExprBooleanObj \
(tclStubsPtr->tcl_ExprBooleanObj) /* 136 */
-#endif
-#ifndef Tcl_ExprDouble
#define Tcl_ExprDouble \
(tclStubsPtr->tcl_ExprDouble) /* 137 */
-#endif
-#ifndef Tcl_ExprDoubleObj
#define Tcl_ExprDoubleObj \
(tclStubsPtr->tcl_ExprDoubleObj) /* 138 */
-#endif
-#ifndef Tcl_ExprLong
#define Tcl_ExprLong \
(tclStubsPtr->tcl_ExprLong) /* 139 */
-#endif
-#ifndef Tcl_ExprLongObj
#define Tcl_ExprLongObj \
(tclStubsPtr->tcl_ExprLongObj) /* 140 */
-#endif
-#ifndef Tcl_ExprObj
#define Tcl_ExprObj \
(tclStubsPtr->tcl_ExprObj) /* 141 */
-#endif
-#ifndef Tcl_ExprString
#define Tcl_ExprString \
(tclStubsPtr->tcl_ExprString) /* 142 */
-#endif
-#ifndef Tcl_Finalize
#define Tcl_Finalize \
(tclStubsPtr->tcl_Finalize) /* 143 */
-#endif
-#ifndef Tcl_FindExecutable
#define Tcl_FindExecutable \
(tclStubsPtr->tcl_FindExecutable) /* 144 */
-#endif
-#ifndef Tcl_FirstHashEntry
#define Tcl_FirstHashEntry \
(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
-#endif
-#ifndef Tcl_Flush
#define Tcl_Flush \
(tclStubsPtr->tcl_Flush) /* 146 */
-#endif
-#ifndef Tcl_FreeResult
#define Tcl_FreeResult \
(tclStubsPtr->tcl_FreeResult) /* 147 */
-#endif
-#ifndef Tcl_GetAlias
#define Tcl_GetAlias \
(tclStubsPtr->tcl_GetAlias) /* 148 */
-#endif
-#ifndef Tcl_GetAliasObj
#define Tcl_GetAliasObj \
(tclStubsPtr->tcl_GetAliasObj) /* 149 */
-#endif
-#ifndef Tcl_GetAssocData
#define Tcl_GetAssocData \
(tclStubsPtr->tcl_GetAssocData) /* 150 */
-#endif
-#ifndef Tcl_GetChannel
#define Tcl_GetChannel \
(tclStubsPtr->tcl_GetChannel) /* 151 */
-#endif
-#ifndef Tcl_GetChannelBufferSize
#define Tcl_GetChannelBufferSize \
(tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */
-#endif
-#ifndef Tcl_GetChannelHandle
#define Tcl_GetChannelHandle \
(tclStubsPtr->tcl_GetChannelHandle) /* 153 */
-#endif
-#ifndef Tcl_GetChannelInstanceData
#define Tcl_GetChannelInstanceData \
(tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */
-#endif
-#ifndef Tcl_GetChannelMode
#define Tcl_GetChannelMode \
(tclStubsPtr->tcl_GetChannelMode) /* 155 */
-#endif
-#ifndef Tcl_GetChannelName
#define Tcl_GetChannelName \
(tclStubsPtr->tcl_GetChannelName) /* 156 */
-#endif
-#ifndef Tcl_GetChannelOption
#define Tcl_GetChannelOption \
(tclStubsPtr->tcl_GetChannelOption) /* 157 */
-#endif
-#ifndef Tcl_GetChannelType
#define Tcl_GetChannelType \
(tclStubsPtr->tcl_GetChannelType) /* 158 */
-#endif
-#ifndef Tcl_GetCommandInfo
#define Tcl_GetCommandInfo \
(tclStubsPtr->tcl_GetCommandInfo) /* 159 */
-#endif
-#ifndef Tcl_GetCommandName
#define Tcl_GetCommandName \
(tclStubsPtr->tcl_GetCommandName) /* 160 */
-#endif
-#ifndef Tcl_GetErrno
#define Tcl_GetErrno \
(tclStubsPtr->tcl_GetErrno) /* 161 */
-#endif
-#ifndef Tcl_GetHostName
#define Tcl_GetHostName \
(tclStubsPtr->tcl_GetHostName) /* 162 */
-#endif
-#ifndef Tcl_GetInterpPath
#define Tcl_GetInterpPath \
(tclStubsPtr->tcl_GetInterpPath) /* 163 */
-#endif
-#ifndef Tcl_GetMaster
#define Tcl_GetMaster \
(tclStubsPtr->tcl_GetMaster) /* 164 */
-#endif
-#ifndef Tcl_GetNameOfExecutable
#define Tcl_GetNameOfExecutable \
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
-#endif
-#ifndef Tcl_GetObjResult
#define Tcl_GetObjResult \
(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_GetOpenFile
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
-#endif
#endif /* UNIX */
-#ifndef Tcl_GetPathType
+#ifdef MAC_OSX_TCL /* MACOSX */
+#define Tcl_GetOpenFile \
+ (tclStubsPtr->tcl_GetOpenFile) /* 167 */
+#endif /* MACOSX */
#define Tcl_GetPathType \
(tclStubsPtr->tcl_GetPathType) /* 168 */
-#endif
-#ifndef Tcl_Gets
#define Tcl_Gets \
(tclStubsPtr->tcl_Gets) /* 169 */
-#endif
-#ifndef Tcl_GetsObj
#define Tcl_GetsObj \
(tclStubsPtr->tcl_GetsObj) /* 170 */
-#endif
-#ifndef Tcl_GetServiceMode
#define Tcl_GetServiceMode \
(tclStubsPtr->tcl_GetServiceMode) /* 171 */
-#endif
-#ifndef Tcl_GetSlave
#define Tcl_GetSlave \
(tclStubsPtr->tcl_GetSlave) /* 172 */
-#endif
-#ifndef Tcl_GetStdChannel
#define Tcl_GetStdChannel \
(tclStubsPtr->tcl_GetStdChannel) /* 173 */
-#endif
-#ifndef Tcl_GetStringResult
#define Tcl_GetStringResult \
(tclStubsPtr->tcl_GetStringResult) /* 174 */
-#endif
-#ifndef Tcl_GetVar
#define Tcl_GetVar \
(tclStubsPtr->tcl_GetVar) /* 175 */
-#endif
-#ifndef Tcl_GetVar2
#define Tcl_GetVar2 \
(tclStubsPtr->tcl_GetVar2) /* 176 */
-#endif
-#ifndef Tcl_GlobalEval
#define Tcl_GlobalEval \
(tclStubsPtr->tcl_GlobalEval) /* 177 */
-#endif
-#ifndef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj \
(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
-#endif
-#ifndef Tcl_HideCommand
#define Tcl_HideCommand \
(tclStubsPtr->tcl_HideCommand) /* 179 */
-#endif
-#ifndef Tcl_Init
#define Tcl_Init \
(tclStubsPtr->tcl_Init) /* 180 */
-#endif
-#ifndef Tcl_InitHashTable
#define Tcl_InitHashTable \
(tclStubsPtr->tcl_InitHashTable) /* 181 */
-#endif
-#ifndef Tcl_InputBlocked
#define Tcl_InputBlocked \
(tclStubsPtr->tcl_InputBlocked) /* 182 */
-#endif
-#ifndef Tcl_InputBuffered
#define Tcl_InputBuffered \
(tclStubsPtr->tcl_InputBuffered) /* 183 */
-#endif
-#ifndef Tcl_InterpDeleted
#define Tcl_InterpDeleted \
(tclStubsPtr->tcl_InterpDeleted) /* 184 */
-#endif
-#ifndef Tcl_IsSafe
#define Tcl_IsSafe \
(tclStubsPtr->tcl_IsSafe) /* 185 */
-#endif
-#ifndef Tcl_JoinPath
#define Tcl_JoinPath \
(tclStubsPtr->tcl_JoinPath) /* 186 */
-#endif
-#ifndef Tcl_LinkVar
#define Tcl_LinkVar \
(tclStubsPtr->tcl_LinkVar) /* 187 */
-#endif
/* Slot 188 is reserved */
-#ifndef Tcl_MakeFileChannel
#define Tcl_MakeFileChannel \
(tclStubsPtr->tcl_MakeFileChannel) /* 189 */
-#endif
-#ifndef Tcl_MakeSafe
#define Tcl_MakeSafe \
(tclStubsPtr->tcl_MakeSafe) /* 190 */
-#endif
-#ifndef Tcl_MakeTcpClientChannel
#define Tcl_MakeTcpClientChannel \
(tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */
-#endif
-#ifndef Tcl_Merge
#define Tcl_Merge \
(tclStubsPtr->tcl_Merge) /* 192 */
-#endif
-#ifndef Tcl_NextHashEntry
#define Tcl_NextHashEntry \
(tclStubsPtr->tcl_NextHashEntry) /* 193 */
-#endif
-#ifndef Tcl_NotifyChannel
#define Tcl_NotifyChannel \
(tclStubsPtr->tcl_NotifyChannel) /* 194 */
-#endif
-#ifndef Tcl_ObjGetVar2
#define Tcl_ObjGetVar2 \
(tclStubsPtr->tcl_ObjGetVar2) /* 195 */
-#endif
-#ifndef Tcl_ObjSetVar2
#define Tcl_ObjSetVar2 \
(tclStubsPtr->tcl_ObjSetVar2) /* 196 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_OpenCommandChannel
#define Tcl_OpenCommandChannel \
(tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_OpenCommandChannel
-#define Tcl_OpenCommandChannel \
- (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_OpenFileChannel
#define Tcl_OpenFileChannel \
(tclStubsPtr->tcl_OpenFileChannel) /* 198 */
-#endif
-#ifndef Tcl_OpenTcpClient
#define Tcl_OpenTcpClient \
(tclStubsPtr->tcl_OpenTcpClient) /* 199 */
-#endif
-#ifndef Tcl_OpenTcpServer
#define Tcl_OpenTcpServer \
(tclStubsPtr->tcl_OpenTcpServer) /* 200 */
-#endif
-#ifndef Tcl_Preserve
#define Tcl_Preserve \
(tclStubsPtr->tcl_Preserve) /* 201 */
-#endif
-#ifndef Tcl_PrintDouble
#define Tcl_PrintDouble \
(tclStubsPtr->tcl_PrintDouble) /* 202 */
-#endif
-#ifndef Tcl_PutEnv
#define Tcl_PutEnv \
(tclStubsPtr->tcl_PutEnv) /* 203 */
-#endif
-#ifndef Tcl_PosixError
#define Tcl_PosixError \
(tclStubsPtr->tcl_PosixError) /* 204 */
-#endif
-#ifndef Tcl_QueueEvent
#define Tcl_QueueEvent \
(tclStubsPtr->tcl_QueueEvent) /* 205 */
-#endif
-#ifndef Tcl_Read
#define Tcl_Read \
(tclStubsPtr->tcl_Read) /* 206 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef Tcl_ReapDetachedProcs
#define Tcl_ReapDetachedProcs \
(tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef Tcl_ReapDetachedProcs
-#define Tcl_ReapDetachedProcs \
- (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
-#endif
-#endif /* __WIN32__ */
-#ifndef Tcl_RecordAndEval
#define Tcl_RecordAndEval \
(tclStubsPtr->tcl_RecordAndEval) /* 208 */
-#endif
-#ifndef Tcl_RecordAndEvalObj
#define Tcl_RecordAndEvalObj \
(tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */
-#endif
-#ifndef Tcl_RegisterChannel
#define Tcl_RegisterChannel \
(tclStubsPtr->tcl_RegisterChannel) /* 210 */
-#endif
-#ifndef Tcl_RegisterObjType
#define Tcl_RegisterObjType \
(tclStubsPtr->tcl_RegisterObjType) /* 211 */
-#endif
-#ifndef Tcl_RegExpCompile
#define Tcl_RegExpCompile \
(tclStubsPtr->tcl_RegExpCompile) /* 212 */
-#endif
-#ifndef Tcl_RegExpExec
#define Tcl_RegExpExec \
(tclStubsPtr->tcl_RegExpExec) /* 213 */
-#endif
-#ifndef Tcl_RegExpMatch
#define Tcl_RegExpMatch \
(tclStubsPtr->tcl_RegExpMatch) /* 214 */
-#endif
-#ifndef Tcl_RegExpRange
#define Tcl_RegExpRange \
(tclStubsPtr->tcl_RegExpRange) /* 215 */
-#endif
-#ifndef Tcl_Release
#define Tcl_Release \
(tclStubsPtr->tcl_Release) /* 216 */
-#endif
-#ifndef Tcl_ResetResult
#define Tcl_ResetResult \
(tclStubsPtr->tcl_ResetResult) /* 217 */
-#endif
-#ifndef Tcl_ScanElement
#define Tcl_ScanElement \
(tclStubsPtr->tcl_ScanElement) /* 218 */
-#endif
-#ifndef Tcl_ScanCountedElement
#define Tcl_ScanCountedElement \
(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
-#endif
-#ifndef Tcl_SeekOld
#define Tcl_SeekOld \
(tclStubsPtr->tcl_SeekOld) /* 220 */
-#endif
-#ifndef Tcl_ServiceAll
#define Tcl_ServiceAll \
(tclStubsPtr->tcl_ServiceAll) /* 221 */
-#endif
-#ifndef Tcl_ServiceEvent
#define Tcl_ServiceEvent \
(tclStubsPtr->tcl_ServiceEvent) /* 222 */
-#endif
-#ifndef Tcl_SetAssocData
#define Tcl_SetAssocData \
(tclStubsPtr->tcl_SetAssocData) /* 223 */
-#endif
-#ifndef Tcl_SetChannelBufferSize
#define Tcl_SetChannelBufferSize \
(tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
-#endif
-#ifndef Tcl_SetChannelOption
#define Tcl_SetChannelOption \
(tclStubsPtr->tcl_SetChannelOption) /* 225 */
-#endif
-#ifndef Tcl_SetCommandInfo
#define Tcl_SetCommandInfo \
(tclStubsPtr->tcl_SetCommandInfo) /* 226 */
-#endif
-#ifndef Tcl_SetErrno
#define Tcl_SetErrno \
(tclStubsPtr->tcl_SetErrno) /* 227 */
-#endif
-#ifndef Tcl_SetErrorCode
#define Tcl_SetErrorCode \
(tclStubsPtr->tcl_SetErrorCode) /* 228 */
-#endif
-#ifndef Tcl_SetMaxBlockTime
#define Tcl_SetMaxBlockTime \
(tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
-#endif
-#ifndef Tcl_SetPanicProc
#define Tcl_SetPanicProc \
(tclStubsPtr->tcl_SetPanicProc) /* 230 */
-#endif
-#ifndef Tcl_SetRecursionLimit
#define Tcl_SetRecursionLimit \
(tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
-#endif
-#ifndef Tcl_SetResult
#define Tcl_SetResult \
(tclStubsPtr->tcl_SetResult) /* 232 */
-#endif
-#ifndef Tcl_SetServiceMode
#define Tcl_SetServiceMode \
(tclStubsPtr->tcl_SetServiceMode) /* 233 */
-#endif
-#ifndef Tcl_SetObjErrorCode
#define Tcl_SetObjErrorCode \
(tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
-#endif
-#ifndef Tcl_SetObjResult
#define Tcl_SetObjResult \
(tclStubsPtr->tcl_SetObjResult) /* 235 */
-#endif
-#ifndef Tcl_SetStdChannel
#define Tcl_SetStdChannel \
(tclStubsPtr->tcl_SetStdChannel) /* 236 */
-#endif
-#ifndef Tcl_SetVar
#define Tcl_SetVar \
(tclStubsPtr->tcl_SetVar) /* 237 */
-#endif
-#ifndef Tcl_SetVar2
#define Tcl_SetVar2 \
(tclStubsPtr->tcl_SetVar2) /* 238 */
-#endif
-#ifndef Tcl_SignalId
#define Tcl_SignalId \
(tclStubsPtr->tcl_SignalId) /* 239 */
-#endif
-#ifndef Tcl_SignalMsg
#define Tcl_SignalMsg \
(tclStubsPtr->tcl_SignalMsg) /* 240 */
-#endif
-#ifndef Tcl_SourceRCFile
#define Tcl_SourceRCFile \
(tclStubsPtr->tcl_SourceRCFile) /* 241 */
-#endif
-#ifndef Tcl_SplitList
#define Tcl_SplitList \
(tclStubsPtr->tcl_SplitList) /* 242 */
-#endif
-#ifndef Tcl_SplitPath
#define Tcl_SplitPath \
(tclStubsPtr->tcl_SplitPath) /* 243 */
-#endif
-#ifndef Tcl_StaticPackage
#define Tcl_StaticPackage \
(tclStubsPtr->tcl_StaticPackage) /* 244 */
-#endif
-#ifndef Tcl_StringMatch
#define Tcl_StringMatch \
(tclStubsPtr->tcl_StringMatch) /* 245 */
-#endif
-#ifndef Tcl_TellOld
#define Tcl_TellOld \
(tclStubsPtr->tcl_TellOld) /* 246 */
-#endif
-#ifndef Tcl_TraceVar
#define Tcl_TraceVar \
(tclStubsPtr->tcl_TraceVar) /* 247 */
-#endif
-#ifndef Tcl_TraceVar2
#define Tcl_TraceVar2 \
(tclStubsPtr->tcl_TraceVar2) /* 248 */
-#endif
-#ifndef Tcl_TranslateFileName
#define Tcl_TranslateFileName \
(tclStubsPtr->tcl_TranslateFileName) /* 249 */
-#endif
-#ifndef Tcl_Ungets
#define Tcl_Ungets \
(tclStubsPtr->tcl_Ungets) /* 250 */
-#endif
-#ifndef Tcl_UnlinkVar
#define Tcl_UnlinkVar \
(tclStubsPtr->tcl_UnlinkVar) /* 251 */
-#endif
-#ifndef Tcl_UnregisterChannel
#define Tcl_UnregisterChannel \
(tclStubsPtr->tcl_UnregisterChannel) /* 252 */
-#endif
-#ifndef Tcl_UnsetVar
#define Tcl_UnsetVar \
(tclStubsPtr->tcl_UnsetVar) /* 253 */
-#endif
-#ifndef Tcl_UnsetVar2
#define Tcl_UnsetVar2 \
(tclStubsPtr->tcl_UnsetVar2) /* 254 */
-#endif
-#ifndef Tcl_UntraceVar
#define Tcl_UntraceVar \
(tclStubsPtr->tcl_UntraceVar) /* 255 */
-#endif
-#ifndef Tcl_UntraceVar2
#define Tcl_UntraceVar2 \
(tclStubsPtr->tcl_UntraceVar2) /* 256 */
-#endif
-#ifndef Tcl_UpdateLinkedVar
#define Tcl_UpdateLinkedVar \
(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
-#endif
-#ifndef Tcl_UpVar
#define Tcl_UpVar \
(tclStubsPtr->tcl_UpVar) /* 258 */
-#endif
-#ifndef Tcl_UpVar2
#define Tcl_UpVar2 \
(tclStubsPtr->tcl_UpVar2) /* 259 */
-#endif
-#ifndef Tcl_VarEval
#define Tcl_VarEval \
(tclStubsPtr->tcl_VarEval) /* 260 */
-#endif
-#ifndef Tcl_VarTraceInfo
#define Tcl_VarTraceInfo \
(tclStubsPtr->tcl_VarTraceInfo) /* 261 */
-#endif
-#ifndef Tcl_VarTraceInfo2
#define Tcl_VarTraceInfo2 \
(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
-#endif
-#ifndef Tcl_Write
#define Tcl_Write \
(tclStubsPtr->tcl_Write) /* 263 */
-#endif
-#ifndef Tcl_WrongNumArgs
#define Tcl_WrongNumArgs \
(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
-#endif
-#ifndef Tcl_DumpActiveMemory
#define Tcl_DumpActiveMemory \
(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
-#endif
-#ifndef Tcl_ValidateAllMemory
#define Tcl_ValidateAllMemory \
(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
-#endif
-#ifndef Tcl_AppendResultVA
#define Tcl_AppendResultVA \
(tclStubsPtr->tcl_AppendResultVA) /* 267 */
-#endif
-#ifndef Tcl_AppendStringsToObjVA
#define Tcl_AppendStringsToObjVA \
(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
-#endif
-#ifndef Tcl_HashStats
#define Tcl_HashStats \
(tclStubsPtr->tcl_HashStats) /* 269 */
-#endif
-#ifndef Tcl_ParseVar
#define Tcl_ParseVar \
(tclStubsPtr->tcl_ParseVar) /* 270 */
-#endif
-#ifndef Tcl_PkgPresent
#define Tcl_PkgPresent \
(tclStubsPtr->tcl_PkgPresent) /* 271 */
-#endif
-#ifndef Tcl_PkgPresentEx
#define Tcl_PkgPresentEx \
(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
-#endif
-#ifndef Tcl_PkgProvide
#define Tcl_PkgProvide \
(tclStubsPtr->tcl_PkgProvide) /* 273 */
-#endif
-#ifndef Tcl_PkgRequire
#define Tcl_PkgRequire \
(tclStubsPtr->tcl_PkgRequire) /* 274 */
-#endif
-#ifndef Tcl_SetErrorCodeVA
#define Tcl_SetErrorCodeVA \
(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
-#endif
-#ifndef Tcl_VarEvalVA
#define Tcl_VarEvalVA \
(tclStubsPtr->tcl_VarEvalVA) /* 276 */
-#endif
-#ifndef Tcl_WaitPid
#define Tcl_WaitPid \
(tclStubsPtr->tcl_WaitPid) /* 277 */
-#endif
-#ifndef Tcl_PanicVA
#define Tcl_PanicVA \
(tclStubsPtr->tcl_PanicVA) /* 278 */
-#endif
-#ifndef Tcl_GetVersion
#define Tcl_GetVersion \
(tclStubsPtr->tcl_GetVersion) /* 279 */
-#endif
-#ifndef Tcl_InitMemory
#define Tcl_InitMemory \
(tclStubsPtr->tcl_InitMemory) /* 280 */
-#endif
-#ifndef Tcl_StackChannel
#define Tcl_StackChannel \
(tclStubsPtr->tcl_StackChannel) /* 281 */
-#endif
-#ifndef Tcl_UnstackChannel
#define Tcl_UnstackChannel \
(tclStubsPtr->tcl_UnstackChannel) /* 282 */
-#endif
-#ifndef Tcl_GetStackedChannel
#define Tcl_GetStackedChannel \
(tclStubsPtr->tcl_GetStackedChannel) /* 283 */
-#endif
-#ifndef Tcl_SetMainLoop
#define Tcl_SetMainLoop \
(tclStubsPtr->tcl_SetMainLoop) /* 284 */
-#endif
/* Slot 285 is reserved */
-#ifndef Tcl_AppendObjToObj
#define Tcl_AppendObjToObj \
(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
-#endif
-#ifndef Tcl_CreateEncoding
#define Tcl_CreateEncoding \
(tclStubsPtr->tcl_CreateEncoding) /* 287 */
-#endif
-#ifndef Tcl_CreateThreadExitHandler
#define Tcl_CreateThreadExitHandler \
(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
-#endif
-#ifndef Tcl_DeleteThreadExitHandler
#define Tcl_DeleteThreadExitHandler \
(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
-#endif
-#ifndef Tcl_DiscardResult
#define Tcl_DiscardResult \
(tclStubsPtr->tcl_DiscardResult) /* 290 */
-#endif
-#ifndef Tcl_EvalEx
#define Tcl_EvalEx \
(tclStubsPtr->tcl_EvalEx) /* 291 */
-#endif
-#ifndef Tcl_EvalObjv
#define Tcl_EvalObjv \
(tclStubsPtr->tcl_EvalObjv) /* 292 */
-#endif
-#ifndef Tcl_EvalObjEx
#define Tcl_EvalObjEx \
(tclStubsPtr->tcl_EvalObjEx) /* 293 */
-#endif
-#ifndef Tcl_ExitThread
#define Tcl_ExitThread \
(tclStubsPtr->tcl_ExitThread) /* 294 */
-#endif
-#ifndef Tcl_ExternalToUtf
#define Tcl_ExternalToUtf \
(tclStubsPtr->tcl_ExternalToUtf) /* 295 */
-#endif
-#ifndef Tcl_ExternalToUtfDString
#define Tcl_ExternalToUtfDString \
(tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */
-#endif
-#ifndef Tcl_FinalizeThread
#define Tcl_FinalizeThread \
(tclStubsPtr->tcl_FinalizeThread) /* 297 */
-#endif
-#ifndef Tcl_FinalizeNotifier
#define Tcl_FinalizeNotifier \
(tclStubsPtr->tcl_FinalizeNotifier) /* 298 */
-#endif
-#ifndef Tcl_FreeEncoding
#define Tcl_FreeEncoding \
(tclStubsPtr->tcl_FreeEncoding) /* 299 */
-#endif
-#ifndef Tcl_GetCurrentThread
#define Tcl_GetCurrentThread \
(tclStubsPtr->tcl_GetCurrentThread) /* 300 */
-#endif
-#ifndef Tcl_GetEncoding
#define Tcl_GetEncoding \
(tclStubsPtr->tcl_GetEncoding) /* 301 */
-#endif
-#ifndef Tcl_GetEncodingName
#define Tcl_GetEncodingName \
(tclStubsPtr->tcl_GetEncodingName) /* 302 */
-#endif
-#ifndef Tcl_GetEncodingNames
#define Tcl_GetEncodingNames \
(tclStubsPtr->tcl_GetEncodingNames) /* 303 */
-#endif
-#ifndef Tcl_GetIndexFromObjStruct
#define Tcl_GetIndexFromObjStruct \
(tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */
-#endif
-#ifndef Tcl_GetThreadData
#define Tcl_GetThreadData \
(tclStubsPtr->tcl_GetThreadData) /* 305 */
-#endif
-#ifndef Tcl_GetVar2Ex
#define Tcl_GetVar2Ex \
(tclStubsPtr->tcl_GetVar2Ex) /* 306 */
-#endif
-#ifndef Tcl_InitNotifier
#define Tcl_InitNotifier \
(tclStubsPtr->tcl_InitNotifier) /* 307 */
-#endif
-#ifndef Tcl_MutexLock
#define Tcl_MutexLock \
(tclStubsPtr->tcl_MutexLock) /* 308 */
-#endif
-#ifndef Tcl_MutexUnlock
#define Tcl_MutexUnlock \
(tclStubsPtr->tcl_MutexUnlock) /* 309 */
-#endif
-#ifndef Tcl_ConditionNotify
#define Tcl_ConditionNotify \
(tclStubsPtr->tcl_ConditionNotify) /* 310 */
-#endif
-#ifndef Tcl_ConditionWait
#define Tcl_ConditionWait \
(tclStubsPtr->tcl_ConditionWait) /* 311 */
-#endif
-#ifndef Tcl_NumUtfChars
#define Tcl_NumUtfChars \
(tclStubsPtr->tcl_NumUtfChars) /* 312 */
-#endif
-#ifndef Tcl_ReadChars
#define Tcl_ReadChars \
(tclStubsPtr->tcl_ReadChars) /* 313 */
-#endif
-#ifndef Tcl_RestoreResult
#define Tcl_RestoreResult \
(tclStubsPtr->tcl_RestoreResult) /* 314 */
-#endif
-#ifndef Tcl_SaveResult
#define Tcl_SaveResult \
(tclStubsPtr->tcl_SaveResult) /* 315 */
-#endif
-#ifndef Tcl_SetSystemEncoding
#define Tcl_SetSystemEncoding \
(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
-#endif
-#ifndef Tcl_SetVar2Ex
#define Tcl_SetVar2Ex \
(tclStubsPtr->tcl_SetVar2Ex) /* 317 */
-#endif
-#ifndef Tcl_ThreadAlert
#define Tcl_ThreadAlert \
(tclStubsPtr->tcl_ThreadAlert) /* 318 */
-#endif
-#ifndef Tcl_ThreadQueueEvent
#define Tcl_ThreadQueueEvent \
(tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */
-#endif
-#ifndef Tcl_UniCharAtIndex
#define Tcl_UniCharAtIndex \
(tclStubsPtr->tcl_UniCharAtIndex) /* 320 */
-#endif
-#ifndef Tcl_UniCharToLower
#define Tcl_UniCharToLower \
(tclStubsPtr->tcl_UniCharToLower) /* 321 */
-#endif
-#ifndef Tcl_UniCharToTitle
#define Tcl_UniCharToTitle \
(tclStubsPtr->tcl_UniCharToTitle) /* 322 */
-#endif
-#ifndef Tcl_UniCharToUpper
#define Tcl_UniCharToUpper \
(tclStubsPtr->tcl_UniCharToUpper) /* 323 */
-#endif
-#ifndef Tcl_UniCharToUtf
#define Tcl_UniCharToUtf \
(tclStubsPtr->tcl_UniCharToUtf) /* 324 */
-#endif
-#ifndef Tcl_UtfAtIndex
#define Tcl_UtfAtIndex \
(tclStubsPtr->tcl_UtfAtIndex) /* 325 */
-#endif
-#ifndef Tcl_UtfCharComplete
#define Tcl_UtfCharComplete \
(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
-#endif
-#ifndef Tcl_UtfBackslash
#define Tcl_UtfBackslash \
(tclStubsPtr->tcl_UtfBackslash) /* 327 */
-#endif
-#ifndef Tcl_UtfFindFirst
#define Tcl_UtfFindFirst \
(tclStubsPtr->tcl_UtfFindFirst) /* 328 */
-#endif
-#ifndef Tcl_UtfFindLast
#define Tcl_UtfFindLast \
(tclStubsPtr->tcl_UtfFindLast) /* 329 */
-#endif
-#ifndef Tcl_UtfNext
#define Tcl_UtfNext \
(tclStubsPtr->tcl_UtfNext) /* 330 */
-#endif
-#ifndef Tcl_UtfPrev
#define Tcl_UtfPrev \
(tclStubsPtr->tcl_UtfPrev) /* 331 */
-#endif
-#ifndef Tcl_UtfToExternal
#define Tcl_UtfToExternal \
(tclStubsPtr->tcl_UtfToExternal) /* 332 */
-#endif
-#ifndef Tcl_UtfToExternalDString
#define Tcl_UtfToExternalDString \
(tclStubsPtr->tcl_UtfToExternalDString) /* 333 */
-#endif
-#ifndef Tcl_UtfToLower
#define Tcl_UtfToLower \
(tclStubsPtr->tcl_UtfToLower) /* 334 */
-#endif
-#ifndef Tcl_UtfToTitle
#define Tcl_UtfToTitle \
(tclStubsPtr->tcl_UtfToTitle) /* 335 */
-#endif
-#ifndef Tcl_UtfToUniChar
#define Tcl_UtfToUniChar \
(tclStubsPtr->tcl_UtfToUniChar) /* 336 */
-#endif
-#ifndef Tcl_UtfToUpper
#define Tcl_UtfToUpper \
(tclStubsPtr->tcl_UtfToUpper) /* 337 */
-#endif
-#ifndef Tcl_WriteChars
#define Tcl_WriteChars \
(tclStubsPtr->tcl_WriteChars) /* 338 */
-#endif
-#ifndef Tcl_WriteObj
#define Tcl_WriteObj \
(tclStubsPtr->tcl_WriteObj) /* 339 */
-#endif
-#ifndef Tcl_GetString
#define Tcl_GetString \
(tclStubsPtr->tcl_GetString) /* 340 */
-#endif
-#ifndef Tcl_GetDefaultEncodingDir
#define Tcl_GetDefaultEncodingDir \
(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
-#endif
-#ifndef Tcl_SetDefaultEncodingDir
#define Tcl_SetDefaultEncodingDir \
(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
-#endif
-#ifndef Tcl_AlertNotifier
#define Tcl_AlertNotifier \
(tclStubsPtr->tcl_AlertNotifier) /* 343 */
-#endif
-#ifndef Tcl_ServiceModeHook
#define Tcl_ServiceModeHook \
(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
-#endif
-#ifndef Tcl_UniCharIsAlnum
#define Tcl_UniCharIsAlnum \
(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
-#endif
-#ifndef Tcl_UniCharIsAlpha
#define Tcl_UniCharIsAlpha \
(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
-#endif
-#ifndef Tcl_UniCharIsDigit
#define Tcl_UniCharIsDigit \
(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
-#endif
-#ifndef Tcl_UniCharIsLower
#define Tcl_UniCharIsLower \
(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
-#endif
-#ifndef Tcl_UniCharIsSpace
#define Tcl_UniCharIsSpace \
(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
-#endif
-#ifndef Tcl_UniCharIsUpper
#define Tcl_UniCharIsUpper \
(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
-#endif
-#ifndef Tcl_UniCharIsWordChar
#define Tcl_UniCharIsWordChar \
(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
-#endif
-#ifndef Tcl_UniCharLen
#define Tcl_UniCharLen \
(tclStubsPtr->tcl_UniCharLen) /* 352 */
-#endif
-#ifndef Tcl_UniCharNcmp
#define Tcl_UniCharNcmp \
(tclStubsPtr->tcl_UniCharNcmp) /* 353 */
-#endif
-#ifndef Tcl_UniCharToUtfDString
#define Tcl_UniCharToUtfDString \
(tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
-#endif
-#ifndef Tcl_UtfToUniCharDString
#define Tcl_UtfToUniCharDString \
(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
-#endif
-#ifndef Tcl_GetRegExpFromObj
#define Tcl_GetRegExpFromObj \
(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
-#endif
-#ifndef Tcl_EvalTokens
#define Tcl_EvalTokens \
(tclStubsPtr->tcl_EvalTokens) /* 357 */
-#endif
-#ifndef Tcl_FreeParse
#define Tcl_FreeParse \
(tclStubsPtr->tcl_FreeParse) /* 358 */
-#endif
-#ifndef Tcl_LogCommandInfo
#define Tcl_LogCommandInfo \
(tclStubsPtr->tcl_LogCommandInfo) /* 359 */
-#endif
-#ifndef Tcl_ParseBraces
#define Tcl_ParseBraces \
(tclStubsPtr->tcl_ParseBraces) /* 360 */
-#endif
-#ifndef Tcl_ParseCommand
#define Tcl_ParseCommand \
(tclStubsPtr->tcl_ParseCommand) /* 361 */
-#endif
-#ifndef Tcl_ParseExpr
#define Tcl_ParseExpr \
(tclStubsPtr->tcl_ParseExpr) /* 362 */
-#endif
-#ifndef Tcl_ParseQuotedString
#define Tcl_ParseQuotedString \
(tclStubsPtr->tcl_ParseQuotedString) /* 363 */
-#endif
-#ifndef Tcl_ParseVarName
#define Tcl_ParseVarName \
(tclStubsPtr->tcl_ParseVarName) /* 364 */
-#endif
-#ifndef Tcl_GetCwd
#define Tcl_GetCwd \
(tclStubsPtr->tcl_GetCwd) /* 365 */
-#endif
-#ifndef Tcl_Chdir
#define Tcl_Chdir \
(tclStubsPtr->tcl_Chdir) /* 366 */
-#endif
-#ifndef Tcl_Access
#define Tcl_Access \
(tclStubsPtr->tcl_Access) /* 367 */
-#endif
-#ifndef Tcl_Stat
#define Tcl_Stat \
(tclStubsPtr->tcl_Stat) /* 368 */
-#endif
-#ifndef Tcl_UtfNcmp
#define Tcl_UtfNcmp \
(tclStubsPtr->tcl_UtfNcmp) /* 369 */
-#endif
-#ifndef Tcl_UtfNcasecmp
#define Tcl_UtfNcasecmp \
(tclStubsPtr->tcl_UtfNcasecmp) /* 370 */
-#endif
-#ifndef Tcl_StringCaseMatch
#define Tcl_StringCaseMatch \
(tclStubsPtr->tcl_StringCaseMatch) /* 371 */
-#endif
-#ifndef Tcl_UniCharIsControl
#define Tcl_UniCharIsControl \
(tclStubsPtr->tcl_UniCharIsControl) /* 372 */
-#endif
-#ifndef Tcl_UniCharIsGraph
#define Tcl_UniCharIsGraph \
(tclStubsPtr->tcl_UniCharIsGraph) /* 373 */
-#endif
-#ifndef Tcl_UniCharIsPrint
#define Tcl_UniCharIsPrint \
(tclStubsPtr->tcl_UniCharIsPrint) /* 374 */
-#endif
-#ifndef Tcl_UniCharIsPunct
#define Tcl_UniCharIsPunct \
(tclStubsPtr->tcl_UniCharIsPunct) /* 375 */
-#endif
-#ifndef Tcl_RegExpExecObj
#define Tcl_RegExpExecObj \
(tclStubsPtr->tcl_RegExpExecObj) /* 376 */
-#endif
-#ifndef Tcl_RegExpGetInfo
#define Tcl_RegExpGetInfo \
(tclStubsPtr->tcl_RegExpGetInfo) /* 377 */
-#endif
-#ifndef Tcl_NewUnicodeObj
#define Tcl_NewUnicodeObj \
(tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
-#endif
-#ifndef Tcl_SetUnicodeObj
#define Tcl_SetUnicodeObj \
(tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
-#endif
-#ifndef Tcl_GetCharLength
#define Tcl_GetCharLength \
(tclStubsPtr->tcl_GetCharLength) /* 380 */
-#endif
-#ifndef Tcl_GetUniChar
#define Tcl_GetUniChar \
(tclStubsPtr->tcl_GetUniChar) /* 381 */
-#endif
-#ifndef Tcl_GetUnicode
#define Tcl_GetUnicode \
(tclStubsPtr->tcl_GetUnicode) /* 382 */
-#endif
-#ifndef Tcl_GetRange
#define Tcl_GetRange \
(tclStubsPtr->tcl_GetRange) /* 383 */
-#endif
-#ifndef Tcl_AppendUnicodeToObj
#define Tcl_AppendUnicodeToObj \
(tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
-#endif
-#ifndef Tcl_RegExpMatchObj
#define Tcl_RegExpMatchObj \
(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
-#endif
-#ifndef Tcl_SetNotifier
#define Tcl_SetNotifier \
(tclStubsPtr->tcl_SetNotifier) /* 386 */
-#endif
-#ifndef Tcl_GetAllocMutex
#define Tcl_GetAllocMutex \
(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
-#endif
-#ifndef Tcl_GetChannelNames
#define Tcl_GetChannelNames \
(tclStubsPtr->tcl_GetChannelNames) /* 388 */
-#endif
-#ifndef Tcl_GetChannelNamesEx
#define Tcl_GetChannelNamesEx \
(tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */
-#endif
-#ifndef Tcl_ProcObjCmd
#define Tcl_ProcObjCmd \
(tclStubsPtr->tcl_ProcObjCmd) /* 390 */
-#endif
-#ifndef Tcl_ConditionFinalize
#define Tcl_ConditionFinalize \
(tclStubsPtr->tcl_ConditionFinalize) /* 391 */
-#endif
-#ifndef Tcl_MutexFinalize
#define Tcl_MutexFinalize \
(tclStubsPtr->tcl_MutexFinalize) /* 392 */
-#endif
-#ifndef Tcl_CreateThread
#define Tcl_CreateThread \
(tclStubsPtr->tcl_CreateThread) /* 393 */
-#endif
-#ifndef Tcl_ReadRaw
#define Tcl_ReadRaw \
(tclStubsPtr->tcl_ReadRaw) /* 394 */
-#endif
-#ifndef Tcl_WriteRaw
#define Tcl_WriteRaw \
(tclStubsPtr->tcl_WriteRaw) /* 395 */
-#endif
-#ifndef Tcl_GetTopChannel
#define Tcl_GetTopChannel \
(tclStubsPtr->tcl_GetTopChannel) /* 396 */
-#endif
-#ifndef Tcl_ChannelBuffered
#define Tcl_ChannelBuffered \
(tclStubsPtr->tcl_ChannelBuffered) /* 397 */
-#endif
-#ifndef Tcl_ChannelName
#define Tcl_ChannelName \
(tclStubsPtr->tcl_ChannelName) /* 398 */
-#endif
-#ifndef Tcl_ChannelVersion
#define Tcl_ChannelVersion \
(tclStubsPtr->tcl_ChannelVersion) /* 399 */
-#endif
-#ifndef Tcl_ChannelBlockModeProc
#define Tcl_ChannelBlockModeProc \
(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
-#endif
-#ifndef Tcl_ChannelCloseProc
#define Tcl_ChannelCloseProc \
(tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
-#endif
-#ifndef Tcl_ChannelClose2Proc
#define Tcl_ChannelClose2Proc \
(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
-#endif
-#ifndef Tcl_ChannelInputProc
#define Tcl_ChannelInputProc \
(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
-#endif
-#ifndef Tcl_ChannelOutputProc
#define Tcl_ChannelOutputProc \
(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
-#endif
-#ifndef Tcl_ChannelSeekProc
#define Tcl_ChannelSeekProc \
(tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
-#endif
-#ifndef Tcl_ChannelSetOptionProc
#define Tcl_ChannelSetOptionProc \
(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
-#endif
-#ifndef Tcl_ChannelGetOptionProc
#define Tcl_ChannelGetOptionProc \
(tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
-#endif
-#ifndef Tcl_ChannelWatchProc
#define Tcl_ChannelWatchProc \
(tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
-#endif
-#ifndef Tcl_ChannelGetHandleProc
#define Tcl_ChannelGetHandleProc \
(tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */
-#endif
-#ifndef Tcl_ChannelFlushProc
#define Tcl_ChannelFlushProc \
(tclStubsPtr->tcl_ChannelFlushProc) /* 410 */
-#endif
-#ifndef Tcl_ChannelHandlerProc
#define Tcl_ChannelHandlerProc \
(tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
-#endif
-#ifndef Tcl_JoinThread
#define Tcl_JoinThread \
(tclStubsPtr->tcl_JoinThread) /* 412 */
-#endif
-#ifndef Tcl_IsChannelShared
#define Tcl_IsChannelShared \
(tclStubsPtr->tcl_IsChannelShared) /* 413 */
-#endif
-#ifndef Tcl_IsChannelRegistered
#define Tcl_IsChannelRegistered \
(tclStubsPtr->tcl_IsChannelRegistered) /* 414 */
-#endif
-#ifndef Tcl_CutChannel
#define Tcl_CutChannel \
(tclStubsPtr->tcl_CutChannel) /* 415 */
-#endif
-#ifndef Tcl_SpliceChannel
#define Tcl_SpliceChannel \
(tclStubsPtr->tcl_SpliceChannel) /* 416 */
-#endif
-#ifndef Tcl_ClearChannelHandlers
#define Tcl_ClearChannelHandlers \
(tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */
-#endif
-#ifndef Tcl_IsChannelExisting
#define Tcl_IsChannelExisting \
(tclStubsPtr->tcl_IsChannelExisting) /* 418 */
-#endif
-#ifndef Tcl_UniCharNcasecmp
#define Tcl_UniCharNcasecmp \
(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
-#endif
-#ifndef Tcl_UniCharCaseMatch
#define Tcl_UniCharCaseMatch \
(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
-#endif
-#ifndef Tcl_FindHashEntry
#define Tcl_FindHashEntry \
(tclStubsPtr->tcl_FindHashEntry) /* 421 */
-#endif
-#ifndef Tcl_CreateHashEntry
#define Tcl_CreateHashEntry \
(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
-#endif
-#ifndef Tcl_InitCustomHashTable
#define Tcl_InitCustomHashTable \
(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
-#endif
-#ifndef Tcl_InitObjHashTable
#define Tcl_InitObjHashTable \
(tclStubsPtr->tcl_InitObjHashTable) /* 424 */
-#endif
-#ifndef Tcl_CommandTraceInfo
#define Tcl_CommandTraceInfo \
(tclStubsPtr->tcl_CommandTraceInfo) /* 425 */
-#endif
-#ifndef Tcl_TraceCommand
#define Tcl_TraceCommand \
(tclStubsPtr->tcl_TraceCommand) /* 426 */
-#endif
-#ifndef Tcl_UntraceCommand
#define Tcl_UntraceCommand \
(tclStubsPtr->tcl_UntraceCommand) /* 427 */
-#endif
-#ifndef Tcl_AttemptAlloc
#define Tcl_AttemptAlloc \
(tclStubsPtr->tcl_AttemptAlloc) /* 428 */
-#endif
-#ifndef Tcl_AttemptDbCkalloc
#define Tcl_AttemptDbCkalloc \
(tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */
-#endif
-#ifndef Tcl_AttemptRealloc
#define Tcl_AttemptRealloc \
(tclStubsPtr->tcl_AttemptRealloc) /* 430 */
-#endif
-#ifndef Tcl_AttemptDbCkrealloc
#define Tcl_AttemptDbCkrealloc \
(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
-#endif
-#ifndef Tcl_AttemptSetObjLength
#define Tcl_AttemptSetObjLength \
(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
-#endif
-#ifndef Tcl_GetChannelThread
#define Tcl_GetChannelThread \
(tclStubsPtr->tcl_GetChannelThread) /* 433 */
-#endif
-#ifndef Tcl_GetUnicodeFromObj
#define Tcl_GetUnicodeFromObj \
(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
-#endif
-#ifndef Tcl_GetMathFuncInfo
#define Tcl_GetMathFuncInfo \
(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
-#endif
-#ifndef Tcl_ListMathFuncs
#define Tcl_ListMathFuncs \
(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
-#endif
-#ifndef Tcl_SubstObj
#define Tcl_SubstObj \
(tclStubsPtr->tcl_SubstObj) /* 437 */
-#endif
-#ifndef Tcl_DetachChannel
#define Tcl_DetachChannel \
(tclStubsPtr->tcl_DetachChannel) /* 438 */
-#endif
-#ifndef Tcl_IsStandardChannel
#define Tcl_IsStandardChannel \
(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
-#endif
-#ifndef Tcl_FSCopyFile
#define Tcl_FSCopyFile \
(tclStubsPtr->tcl_FSCopyFile) /* 440 */
-#endif
-#ifndef Tcl_FSCopyDirectory
#define Tcl_FSCopyDirectory \
(tclStubsPtr->tcl_FSCopyDirectory) /* 441 */
-#endif
-#ifndef Tcl_FSCreateDirectory
#define Tcl_FSCreateDirectory \
(tclStubsPtr->tcl_FSCreateDirectory) /* 442 */
-#endif
-#ifndef Tcl_FSDeleteFile
#define Tcl_FSDeleteFile \
(tclStubsPtr->tcl_FSDeleteFile) /* 443 */
-#endif
-#ifndef Tcl_FSLoadFile
#define Tcl_FSLoadFile \
(tclStubsPtr->tcl_FSLoadFile) /* 444 */
-#endif
-#ifndef Tcl_FSMatchInDirectory
#define Tcl_FSMatchInDirectory \
(tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */
-#endif
-#ifndef Tcl_FSLink
#define Tcl_FSLink \
(tclStubsPtr->tcl_FSLink) /* 446 */
-#endif
-#ifndef Tcl_FSRemoveDirectory
#define Tcl_FSRemoveDirectory \
(tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */
-#endif
-#ifndef Tcl_FSRenameFile
#define Tcl_FSRenameFile \
(tclStubsPtr->tcl_FSRenameFile) /* 448 */
-#endif
-#ifndef Tcl_FSLstat
#define Tcl_FSLstat \
(tclStubsPtr->tcl_FSLstat) /* 449 */
-#endif
-#ifndef Tcl_FSUtime
#define Tcl_FSUtime \
(tclStubsPtr->tcl_FSUtime) /* 450 */
-#endif
-#ifndef Tcl_FSFileAttrsGet
#define Tcl_FSFileAttrsGet \
(tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */
-#endif
-#ifndef Tcl_FSFileAttrsSet
#define Tcl_FSFileAttrsSet \
(tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */
-#endif
-#ifndef Tcl_FSFileAttrStrings
#define Tcl_FSFileAttrStrings \
(tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */
-#endif
-#ifndef Tcl_FSStat
#define Tcl_FSStat \
(tclStubsPtr->tcl_FSStat) /* 454 */
-#endif
-#ifndef Tcl_FSAccess
#define Tcl_FSAccess \
(tclStubsPtr->tcl_FSAccess) /* 455 */
-#endif
-#ifndef Tcl_FSOpenFileChannel
#define Tcl_FSOpenFileChannel \
(tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */
-#endif
-#ifndef Tcl_FSGetCwd
#define Tcl_FSGetCwd \
(tclStubsPtr->tcl_FSGetCwd) /* 457 */
-#endif
-#ifndef Tcl_FSChdir
#define Tcl_FSChdir \
(tclStubsPtr->tcl_FSChdir) /* 458 */
-#endif
-#ifndef Tcl_FSConvertToPathType
#define Tcl_FSConvertToPathType \
(tclStubsPtr->tcl_FSConvertToPathType) /* 459 */
-#endif
-#ifndef Tcl_FSJoinPath
#define Tcl_FSJoinPath \
(tclStubsPtr->tcl_FSJoinPath) /* 460 */
-#endif
-#ifndef Tcl_FSSplitPath
#define Tcl_FSSplitPath \
(tclStubsPtr->tcl_FSSplitPath) /* 461 */
-#endif
-#ifndef Tcl_FSEqualPaths
#define Tcl_FSEqualPaths \
(tclStubsPtr->tcl_FSEqualPaths) /* 462 */
-#endif
-#ifndef Tcl_FSGetNormalizedPath
#define Tcl_FSGetNormalizedPath \
(tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */
-#endif
-#ifndef Tcl_FSJoinToPath
#define Tcl_FSJoinToPath \
(tclStubsPtr->tcl_FSJoinToPath) /* 464 */
-#endif
-#ifndef Tcl_FSGetInternalRep
#define Tcl_FSGetInternalRep \
(tclStubsPtr->tcl_FSGetInternalRep) /* 465 */
-#endif
-#ifndef Tcl_FSGetTranslatedPath
#define Tcl_FSGetTranslatedPath \
(tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */
-#endif
-#ifndef Tcl_FSEvalFile
#define Tcl_FSEvalFile \
(tclStubsPtr->tcl_FSEvalFile) /* 467 */
-#endif
-#ifndef Tcl_FSNewNativePath
#define Tcl_FSNewNativePath \
(tclStubsPtr->tcl_FSNewNativePath) /* 468 */
-#endif
-#ifndef Tcl_FSGetNativePath
#define Tcl_FSGetNativePath \
(tclStubsPtr->tcl_FSGetNativePath) /* 469 */
-#endif
-#ifndef Tcl_FSFileSystemInfo
#define Tcl_FSFileSystemInfo \
(tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */
-#endif
-#ifndef Tcl_FSPathSeparator
#define Tcl_FSPathSeparator \
(tclStubsPtr->tcl_FSPathSeparator) /* 471 */
-#endif
-#ifndef Tcl_FSListVolumes
#define Tcl_FSListVolumes \
(tclStubsPtr->tcl_FSListVolumes) /* 472 */
-#endif
-#ifndef Tcl_FSRegister
#define Tcl_FSRegister \
(tclStubsPtr->tcl_FSRegister) /* 473 */
-#endif
-#ifndef Tcl_FSUnregister
#define Tcl_FSUnregister \
(tclStubsPtr->tcl_FSUnregister) /* 474 */
-#endif
-#ifndef Tcl_FSData
#define Tcl_FSData \
(tclStubsPtr->tcl_FSData) /* 475 */
-#endif
-#ifndef Tcl_FSGetTranslatedStringPath
#define Tcl_FSGetTranslatedStringPath \
(tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */
-#endif
-#ifndef Tcl_FSGetFileSystemForPath
#define Tcl_FSGetFileSystemForPath \
(tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */
-#endif
-#ifndef Tcl_FSGetPathType
#define Tcl_FSGetPathType \
(tclStubsPtr->tcl_FSGetPathType) /* 478 */
-#endif
-#ifndef Tcl_OutputBuffered
#define Tcl_OutputBuffered \
(tclStubsPtr->tcl_OutputBuffered) /* 479 */
-#endif
-#ifndef Tcl_FSMountsChanged
#define Tcl_FSMountsChanged \
(tclStubsPtr->tcl_FSMountsChanged) /* 480 */
-#endif
-#ifndef Tcl_EvalTokensStandard
#define Tcl_EvalTokensStandard \
(tclStubsPtr->tcl_EvalTokensStandard) /* 481 */
-#endif
-#ifndef Tcl_GetTime
#define Tcl_GetTime \
(tclStubsPtr->tcl_GetTime) /* 482 */
-#endif
-#ifndef Tcl_CreateObjTrace
#define Tcl_CreateObjTrace \
(tclStubsPtr->tcl_CreateObjTrace) /* 483 */
-#endif
-#ifndef Tcl_GetCommandInfoFromToken
#define Tcl_GetCommandInfoFromToken \
(tclStubsPtr->tcl_GetCommandInfoFromToken) /* 484 */
-#endif
-#ifndef Tcl_SetCommandInfoFromToken
#define Tcl_SetCommandInfoFromToken \
(tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */
-#endif
-#ifndef Tcl_DbNewWideIntObj
#define Tcl_DbNewWideIntObj \
(tclStubsPtr->tcl_DbNewWideIntObj) /* 486 */
-#endif
-#ifndef Tcl_GetWideIntFromObj
#define Tcl_GetWideIntFromObj \
(tclStubsPtr->tcl_GetWideIntFromObj) /* 487 */
-#endif
-#ifndef Tcl_NewWideIntObj
#define Tcl_NewWideIntObj \
(tclStubsPtr->tcl_NewWideIntObj) /* 488 */
-#endif
-#ifndef Tcl_SetWideIntObj
#define Tcl_SetWideIntObj \
(tclStubsPtr->tcl_SetWideIntObj) /* 489 */
-#endif
-#ifndef Tcl_AllocStatBuf
#define Tcl_AllocStatBuf \
(tclStubsPtr->tcl_AllocStatBuf) /* 490 */
-#endif
-#ifndef Tcl_Seek
#define Tcl_Seek \
(tclStubsPtr->tcl_Seek) /* 491 */
-#endif
-#ifndef Tcl_Tell
#define Tcl_Tell \
(tclStubsPtr->tcl_Tell) /* 492 */
-#endif
-#ifndef Tcl_ChannelWideSeekProc
#define Tcl_ChannelWideSeekProc \
(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
-#endif
-#ifndef Tcl_DictObjPut
#define Tcl_DictObjPut \
(tclStubsPtr->tcl_DictObjPut) /* 494 */
-#endif
-#ifndef Tcl_DictObjGet
#define Tcl_DictObjGet \
(tclStubsPtr->tcl_DictObjGet) /* 495 */
-#endif
-#ifndef Tcl_DictObjRemove
#define Tcl_DictObjRemove \
(tclStubsPtr->tcl_DictObjRemove) /* 496 */
-#endif
-#ifndef Tcl_DictObjSize
#define Tcl_DictObjSize \
(tclStubsPtr->tcl_DictObjSize) /* 497 */
-#endif
-#ifndef Tcl_DictObjFirst
#define Tcl_DictObjFirst \
(tclStubsPtr->tcl_DictObjFirst) /* 498 */
-#endif
-#ifndef Tcl_DictObjNext
#define Tcl_DictObjNext \
(tclStubsPtr->tcl_DictObjNext) /* 499 */
-#endif
-#ifndef Tcl_DictObjDone
#define Tcl_DictObjDone \
(tclStubsPtr->tcl_DictObjDone) /* 500 */
-#endif
-#ifndef Tcl_DictObjPutKeyList
#define Tcl_DictObjPutKeyList \
(tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */
-#endif
-#ifndef Tcl_DictObjRemoveKeyList
#define Tcl_DictObjRemoveKeyList \
(tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */
-#endif
-#ifndef Tcl_NewDictObj
#define Tcl_NewDictObj \
(tclStubsPtr->tcl_NewDictObj) /* 503 */
-#endif
-#ifndef Tcl_DbNewDictObj
#define Tcl_DbNewDictObj \
(tclStubsPtr->tcl_DbNewDictObj) /* 504 */
-#endif
-#ifndef Tcl_RegisterConfig
#define Tcl_RegisterConfig \
(tclStubsPtr->tcl_RegisterConfig) /* 505 */
-#endif
-#ifndef Tcl_CreateNamespace
#define Tcl_CreateNamespace \
(tclStubsPtr->tcl_CreateNamespace) /* 506 */
-#endif
-#ifndef Tcl_DeleteNamespace
#define Tcl_DeleteNamespace \
(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
-#endif
-#ifndef Tcl_AppendExportList
#define Tcl_AppendExportList \
(tclStubsPtr->tcl_AppendExportList) /* 508 */
-#endif
-#ifndef Tcl_Export
#define Tcl_Export \
(tclStubsPtr->tcl_Export) /* 509 */
-#endif
-#ifndef Tcl_Import
#define Tcl_Import \
(tclStubsPtr->tcl_Import) /* 510 */
-#endif
-#ifndef Tcl_ForgetImport
#define Tcl_ForgetImport \
(tclStubsPtr->tcl_ForgetImport) /* 511 */
-#endif
-#ifndef Tcl_GetCurrentNamespace
#define Tcl_GetCurrentNamespace \
(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
-#endif
-#ifndef Tcl_GetGlobalNamespace
#define Tcl_GetGlobalNamespace \
(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
-#endif
-#ifndef Tcl_FindNamespace
#define Tcl_FindNamespace \
(tclStubsPtr->tcl_FindNamespace) /* 514 */
-#endif
-#ifndef Tcl_FindCommand
#define Tcl_FindCommand \
(tclStubsPtr->tcl_FindCommand) /* 515 */
-#endif
-#ifndef Tcl_GetCommandFromObj
#define Tcl_GetCommandFromObj \
(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
-#endif
-#ifndef Tcl_GetCommandFullName
#define Tcl_GetCommandFullName \
(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
-#endif
-#ifndef Tcl_FSEvalFileEx
#define Tcl_FSEvalFileEx \
(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
-#endif
-#ifndef Tcl_SetExitProc
#define Tcl_SetExitProc \
(tclStubsPtr->tcl_SetExitProc) /* 519 */
-#endif
-#ifndef Tcl_LimitAddHandler
#define Tcl_LimitAddHandler \
(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
-#endif
-#ifndef Tcl_LimitRemoveHandler
#define Tcl_LimitRemoveHandler \
(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
-#endif
-#ifndef Tcl_LimitReady
#define Tcl_LimitReady \
(tclStubsPtr->tcl_LimitReady) /* 522 */
-#endif
-#ifndef Tcl_LimitCheck
#define Tcl_LimitCheck \
(tclStubsPtr->tcl_LimitCheck) /* 523 */
-#endif
-#ifndef Tcl_LimitExceeded
#define Tcl_LimitExceeded \
(tclStubsPtr->tcl_LimitExceeded) /* 524 */
-#endif
-#ifndef Tcl_LimitSetCommands
#define Tcl_LimitSetCommands \
(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
-#endif
-#ifndef Tcl_LimitSetTime
#define Tcl_LimitSetTime \
(tclStubsPtr->tcl_LimitSetTime) /* 526 */
-#endif
-#ifndef Tcl_LimitSetGranularity
#define Tcl_LimitSetGranularity \
(tclStubsPtr->tcl_LimitSetGranularity) /* 527 */
-#endif
-#ifndef Tcl_LimitTypeEnabled
#define Tcl_LimitTypeEnabled \
(tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */
-#endif
-#ifndef Tcl_LimitTypeExceeded
#define Tcl_LimitTypeExceeded \
(tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */
-#endif
-#ifndef Tcl_LimitTypeSet
#define Tcl_LimitTypeSet \
(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
-#endif
-#ifndef Tcl_LimitTypeReset
#define Tcl_LimitTypeReset \
(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
-#endif
-#ifndef Tcl_LimitGetCommands
#define Tcl_LimitGetCommands \
(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
-#endif
-#ifndef Tcl_LimitGetTime
#define Tcl_LimitGetTime \
(tclStubsPtr->tcl_LimitGetTime) /* 533 */
-#endif
-#ifndef Tcl_LimitGetGranularity
#define Tcl_LimitGetGranularity \
(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
-#endif
-#ifndef Tcl_SaveInterpState
#define Tcl_SaveInterpState \
(tclStubsPtr->tcl_SaveInterpState) /* 535 */
-#endif
-#ifndef Tcl_RestoreInterpState
#define Tcl_RestoreInterpState \
(tclStubsPtr->tcl_RestoreInterpState) /* 536 */
-#endif
-#ifndef Tcl_DiscardInterpState
#define Tcl_DiscardInterpState \
(tclStubsPtr->tcl_DiscardInterpState) /* 537 */
-#endif
-#ifndef Tcl_SetReturnOptions
#define Tcl_SetReturnOptions \
(tclStubsPtr->tcl_SetReturnOptions) /* 538 */
-#endif
-#ifndef Tcl_GetReturnOptions
#define Tcl_GetReturnOptions \
(tclStubsPtr->tcl_GetReturnOptions) /* 539 */
-#endif
-#ifndef Tcl_IsEnsemble
#define Tcl_IsEnsemble \
(tclStubsPtr->tcl_IsEnsemble) /* 540 */
-#endif
-#ifndef Tcl_CreateEnsemble
#define Tcl_CreateEnsemble \
(tclStubsPtr->tcl_CreateEnsemble) /* 541 */
-#endif
-#ifndef Tcl_FindEnsemble
#define Tcl_FindEnsemble \
(tclStubsPtr->tcl_FindEnsemble) /* 542 */
-#endif
-#ifndef Tcl_SetEnsembleSubcommandList
#define Tcl_SetEnsembleSubcommandList \
(tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */
-#endif
-#ifndef Tcl_SetEnsembleMappingDict
#define Tcl_SetEnsembleMappingDict \
(tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */
-#endif
-#ifndef Tcl_SetEnsembleUnknownHandler
#define Tcl_SetEnsembleUnknownHandler \
(tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */
-#endif
-#ifndef Tcl_SetEnsembleFlags
#define Tcl_SetEnsembleFlags \
(tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */
-#endif
-#ifndef Tcl_GetEnsembleSubcommandList
#define Tcl_GetEnsembleSubcommandList \
(tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */
-#endif
-#ifndef Tcl_GetEnsembleMappingDict
#define Tcl_GetEnsembleMappingDict \
(tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */
-#endif
-#ifndef Tcl_GetEnsembleUnknownHandler
#define Tcl_GetEnsembleUnknownHandler \
(tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */
-#endif
-#ifndef Tcl_GetEnsembleFlags
#define Tcl_GetEnsembleFlags \
(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
-#endif
-#ifndef Tcl_GetEnsembleNamespace
#define Tcl_GetEnsembleNamespace \
(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
-#endif
-#ifndef Tcl_SetTimeProc
#define Tcl_SetTimeProc \
(tclStubsPtr->tcl_SetTimeProc) /* 552 */
-#endif
-#ifndef Tcl_QueryTimeProc
#define Tcl_QueryTimeProc \
(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
-#endif
-#ifndef Tcl_ChannelThreadActionProc
#define Tcl_ChannelThreadActionProc \
(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
-#endif
-#ifndef Tcl_NewBignumObj
#define Tcl_NewBignumObj \
(tclStubsPtr->tcl_NewBignumObj) /* 555 */
-#endif
-#ifndef Tcl_DbNewBignumObj
#define Tcl_DbNewBignumObj \
(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
-#endif
-#ifndef Tcl_SetBignumObj
#define Tcl_SetBignumObj \
(tclStubsPtr->tcl_SetBignumObj) /* 557 */
-#endif
-#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
-#endif
-#ifndef Tcl_TruncateChannel
+#define Tcl_TakeBignumFromObj \
+ (tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
#define Tcl_TruncateChannel \
- (tclStubsPtr->tcl_TruncateChannel) /* 559 */
-#endif
-#ifndef Tcl_ChannelTruncateProc
+ (tclStubsPtr->tcl_TruncateChannel) /* 560 */
#define Tcl_ChannelTruncateProc \
- (tclStubsPtr->tcl_ChannelTruncateProc) /* 560 */
-#endif
-#ifndef Tcl_SetChannelErrorInterp
+ (tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
#define Tcl_SetChannelErrorInterp \
- (tclStubsPtr->tcl_SetChannelErrorInterp) /* 561 */
-#endif
-#ifndef Tcl_GetChannelErrorInterp
+ (tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
#define Tcl_GetChannelErrorInterp \
- (tclStubsPtr->tcl_GetChannelErrorInterp) /* 562 */
-#endif
-#ifndef Tcl_SetChannelError
+ (tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
#define Tcl_SetChannelError \
- (tclStubsPtr->tcl_SetChannelError) /* 563 */
-#endif
-#ifndef Tcl_GetChannelError
+ (tclStubsPtr->tcl_SetChannelError) /* 564 */
#define Tcl_GetChannelError \
- (tclStubsPtr->tcl_GetChannelError) /* 564 */
-#endif
+ (tclStubsPtr->tcl_GetChannelError) /* 565 */
+#define Tcl_InitBignumFromDouble \
+ (tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
+#define Tcl_GetNamespaceUnknownHandler \
+ (tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
+#define Tcl_SetNamespaceUnknownHandler \
+ (tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
+#define Tcl_GetEncodingFromObj \
+ (tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */
+#define Tcl_GetEncodingSearchPath \
+ (tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */
+#define Tcl_SetEncodingSearchPath \
+ (tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */
+#define Tcl_GetEncodingNameFromEnvironment \
+ (tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */
+#define Tcl_PkgRequireProc \
+ (tclStubsPtr->tcl_PkgRequireProc) /* 573 */
+#define Tcl_AppendObjToErrorInfo \
+ (tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */
+#define Tcl_AppendLimitedToObj \
+ (tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */
+#define Tcl_Format \
+ (tclStubsPtr->tcl_Format) /* 576 */
+#define Tcl_AppendFormatToObj \
+ (tclStubsPtr->tcl_AppendFormatToObj) /* 577 */
+#define Tcl_ObjPrintf \
+ (tclStubsPtr->tcl_ObjPrintf) /* 578 */
+#define Tcl_AppendPrintfToObj \
+ (tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
+#define Tcl_CancelEval \
+ (tclStubsPtr->tcl_CancelEval) /* 580 */
+#define Tcl_Canceled \
+ (tclStubsPtr->tcl_Canceled) /* 581 */
+#define Tcl_CreatePipe \
+ (tclStubsPtr->tcl_CreatePipe) /* 582 */
+#define Tcl_NRCreateCommand \
+ (tclStubsPtr->tcl_NRCreateCommand) /* 583 */
+#define Tcl_NREvalObj \
+ (tclStubsPtr->tcl_NREvalObj) /* 584 */
+#define Tcl_NREvalObjv \
+ (tclStubsPtr->tcl_NREvalObjv) /* 585 */
+#define Tcl_NRCmdSwap \
+ (tclStubsPtr->tcl_NRCmdSwap) /* 586 */
+#define Tcl_NRAddCallback \
+ (tclStubsPtr->tcl_NRAddCallback) /* 587 */
+#define Tcl_NRCallObjProc \
+ (tclStubsPtr->tcl_NRCallObjProc) /* 588 */
+#define Tcl_GetFSDeviceFromStat \
+ (tclStubsPtr->tcl_GetFSDeviceFromStat) /* 589 */
+#define Tcl_GetFSInodeFromStat \
+ (tclStubsPtr->tcl_GetFSInodeFromStat) /* 590 */
+#define Tcl_GetModeFromStat \
+ (tclStubsPtr->tcl_GetModeFromStat) /* 591 */
+#define Tcl_GetLinkCountFromStat \
+ (tclStubsPtr->tcl_GetLinkCountFromStat) /* 592 */
+#define Tcl_GetUserIdFromStat \
+ (tclStubsPtr->tcl_GetUserIdFromStat) /* 593 */
+#define Tcl_GetGroupIdFromStat \
+ (tclStubsPtr->tcl_GetGroupIdFromStat) /* 594 */
+#define Tcl_GetDeviceTypeFromStat \
+ (tclStubsPtr->tcl_GetDeviceTypeFromStat) /* 595 */
+#define Tcl_GetAccessTimeFromStat \
+ (tclStubsPtr->tcl_GetAccessTimeFromStat) /* 596 */
+#define Tcl_GetModificationTimeFromStat \
+ (tclStubsPtr->tcl_GetModificationTimeFromStat) /* 597 */
+#define Tcl_GetChangeTimeFromStat \
+ (tclStubsPtr->tcl_GetChangeTimeFromStat) /* 598 */
+#define Tcl_GetSizeFromStat \
+ (tclStubsPtr->tcl_GetSizeFromStat) /* 599 */
+#define Tcl_GetBlocksFromStat \
+ (tclStubsPtr->tcl_GetBlocksFromStat) /* 600 */
+#define Tcl_GetBlockSizeFromStat \
+ (tclStubsPtr->tcl_GetBlockSizeFromStat) /* 601 */
+#define Tcl_SetEnsembleParameterList \
+ (tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */
+#define Tcl_GetEnsembleParameterList \
+ (tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */
+#define Tcl_ParseArgsObjv \
+ (tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
+#define Tcl_GetErrorLine \
+ (tclStubsPtr->tcl_GetErrorLine) /* 605 */
+#define Tcl_SetErrorLine \
+ (tclStubsPtr->tcl_SetErrorLine) /* 606 */
+#define Tcl_TransferResult \
+ (tclStubsPtr->tcl_TransferResult) /* 607 */
+#define Tcl_InterpActive \
+ (tclStubsPtr->tcl_InterpActive) /* 608 */
+#define Tcl_BackgroundException \
+ (tclStubsPtr->tcl_BackgroundException) /* 609 */
+#define Tcl_ZlibDeflate \
+ (tclStubsPtr->tcl_ZlibDeflate) /* 610 */
+#define Tcl_ZlibInflate \
+ (tclStubsPtr->tcl_ZlibInflate) /* 611 */
+#define Tcl_ZlibCRC32 \
+ (tclStubsPtr->tcl_ZlibCRC32) /* 612 */
+#define Tcl_ZlibAdler32 \
+ (tclStubsPtr->tcl_ZlibAdler32) /* 613 */
+#define Tcl_ZlibStreamInit \
+ (tclStubsPtr->tcl_ZlibStreamInit) /* 614 */
+#define Tcl_ZlibStreamGetCommandName \
+ (tclStubsPtr->tcl_ZlibStreamGetCommandName) /* 615 */
+#define Tcl_ZlibStreamEof \
+ (tclStubsPtr->tcl_ZlibStreamEof) /* 616 */
+#define Tcl_ZlibStreamChecksum \
+ (tclStubsPtr->tcl_ZlibStreamChecksum) /* 617 */
+#define Tcl_ZlibStreamPut \
+ (tclStubsPtr->tcl_ZlibStreamPut) /* 618 */
+#define Tcl_ZlibStreamGet \
+ (tclStubsPtr->tcl_ZlibStreamGet) /* 619 */
+#define Tcl_ZlibStreamClose \
+ (tclStubsPtr->tcl_ZlibStreamClose) /* 620 */
+#define Tcl_ZlibStreamReset \
+ (tclStubsPtr->tcl_ZlibStreamReset) /* 621 */
+#define Tcl_SetStartupScript \
+ (tclStubsPtr->tcl_SetStartupScript) /* 622 */
+#define Tcl_GetStartupScript \
+ (tclStubsPtr->tcl_GetStartupScript) /* 623 */
+#define Tcl_CloseEx \
+ (tclStubsPtr->tcl_CloseEx) /* 624 */
+#define Tcl_NRExprObj \
+ (tclStubsPtr->tcl_NRExprObj) /* 625 */
+#define Tcl_NRSubstObj \
+ (tclStubsPtr->tcl_NRSubstObj) /* 626 */
+#define Tcl_LoadFile \
+ (tclStubsPtr->tcl_LoadFile) /* 627 */
+#define Tcl_FindSymbol \
+ (tclStubsPtr->tcl_FindSymbol) /* 628 */
+#define Tcl_FSUnloadFile \
+ (tclStubsPtr->tcl_FSUnloadFile) /* 629 */
+#define Tcl_ZlibStreamSetCompressionDictionary \
+ (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
+#if defined(USE_TCL_STUBS)
+# undef Tcl_CreateInterp
+# undef Tcl_FindExecutable
+# undef Tcl_GetStringResult
+# undef Tcl_Init
+# undef Tcl_SetPanicProc
+# undef Tcl_SetVar
+# undef Tcl_ObjSetVar2
+# undef Tcl_StaticPackage
+# undef TclFSGetNativePath
+# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
+# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
+# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
+# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
+# define Tcl_SetVar(interp, varName, newValue, flags) \
+ (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
+# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
+ (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, 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
#define TCL_STORAGE_CLASS DLLIMPORT
-#endif /* _TCLDECLS */
+#undef Tcl_SeekOld
+#undef Tcl_TellOld
+
+#undef Tcl_PkgPresent
+#define Tcl_PkgPresent(interp, name, version, exact) \
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL)
+#undef Tcl_PkgProvide
+#define Tcl_PkgProvide(interp, name, version) \
+ Tcl_PkgProvideEx(interp, name, version, NULL)
+#undef Tcl_PkgRequire
+#define Tcl_PkgRequire(interp, name, version, exact) \
+ Tcl_PkgRequireEx(interp, name, version, exact, NULL)
+#undef Tcl_GetIndexFromObj
+#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
+ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
+ sizeof(char *), msg, flags, indexPtr)
+#undef Tcl_NewBooleanObj
+#define Tcl_NewBooleanObj(boolValue) \
+ Tcl_NewIntObj((boolValue)!=0)
+#undef Tcl_DbNewBooleanObj
+#define Tcl_DbNewBooleanObj(boolValue, file, line) \
+ Tcl_DbNewLongObj((boolValue)!=0, file, line)
+#undef Tcl_SetBooleanObj
+#define Tcl_SetBooleanObj(objPtr, boolValue) \
+ Tcl_SetIntObj((objPtr), (boolValue)!=0)
+#undef Tcl_SetVar
+#define Tcl_SetVar(interp, varName, newValue, flags) \
+ Tcl_SetVar2(interp, varName, NULL, newValue, flags)
+#undef Tcl_UnsetVar
+#define Tcl_UnsetVar(interp, varName, flags) \
+ Tcl_UnsetVar2(interp, varName, NULL, flags)
+#undef Tcl_GetVar
+#define Tcl_GetVar(interp, varName, flags) \
+ Tcl_GetVar2(interp, varName, NULL, flags)
+#undef Tcl_TraceVar
+#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
+#undef Tcl_UntraceVar
+#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
+#undef Tcl_VarTraceInfo
+#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
+ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
+#undef Tcl_UpVar
+#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
+ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the
+ * Win64 signature. Cygwin64 stubbed extensions cannot use those stub
+ * entries any more, they should use the 64-bit alternatives where
+ * possible. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
+ */
+# undef Tcl_DbNewLongObj
+# undef Tcl_GetLongFromObj
+# undef Tcl_NewLongObj
+# undef Tcl_SetLongObj
+# undef Tcl_ExprLong
+# undef Tcl_ExprLongObj
+# undef Tcl_UniCharNcmp
+# undef Tcl_UtfNcmp
+# undef Tcl_UtfNcasecmp
+# undef Tcl_UniCharNcasecmp
+# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
+# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
+# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
+# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
+# define Tcl_ExprLong TclExprLong
+ static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_ExprLongObj TclExprLongObj
+ static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_UniCharNcmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n))
+# define Tcl_UtfNcmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UtfNcasecmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UniCharNcasecmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
+# endif
+#endif
+/*
+ * Deprecated Tcl procedures:
+ */
+
+#undef Tcl_EvalObj
+#define Tcl_EvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),0)
+#undef Tcl_GlobalEvalObj
+#define Tcl_GlobalEvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+
+#endif /* _TCLDECLS */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 196455e..e31d708 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1,18 +1,17 @@
-/*
+/*
* tclDictObj.c --
*
- * This file contains procedures that implement the Tcl dict object
- * type and its accessor command.
- *
- * Copyright (c) 2002 by Donal K. Fellows.
+ * This file contains functions that implement the Tcl dict object type
+ * and its accessor command.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * Copyright (c) 2002-2010 by Donal K. Fellows.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.35 2005/09/16 01:40:15 dgp 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"
+#include "tommath.h"
/*
* Forward declaration.
@@ -20,142 +19,375 @@
struct Dict;
/*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
+ */
+
+static void DeleteDict(struct Dict *dict);
+static int DictAppendCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictCreateCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictGetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictMergeCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictRemoveCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictSetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictWithCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeDictInternalRep(Tcl_Obj *dictPtr);
+static void InvalidateDictChain(Tcl_Obj *dictObj);
+static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfDict(Tcl_Obj *dictPtr);
+static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
+static inline void InitChainTable(struct Dict *dict);
+static inline void DeleteChainTable(struct Dict *dict);
+static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
+ Tcl_Obj *keyPtr, int *newPtr);
+static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+static int FinalizeDictUpdate(ClientData data[],
+ Tcl_Interp *interp, int result);
+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 void DeleteDict _ANSI_ARGS_((struct Dict *dict));
-static int DictAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictCreateCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictExistsCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictFilterCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictForCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictGetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictKeysCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictMergeCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictRemoveCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictReplaceCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictSizeCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictUnsetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictValuesCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictUpdateCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictWithCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static void DupDictInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FreeDictInternalRep _ANSI_ARGS_((Tcl_Obj *dictPtr));
-static void InvalidateDictChain _ANSI_ARGS_((Tcl_Obj *dictObj));
-static int SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr));
+static const EnsembleImplMap implementationMap[] = {
+ {"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, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ {"keys", DictKeysCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
+ {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
+ {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
+ {"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
+ {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
+ {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
+ {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
+ {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
+ {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+ {"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
+
+/*
+ * Internal representation of the entries in the hash table that backs a
+ * dictionary.
+ */
+
+typedef struct ChainEntry {
+ Tcl_HashEntry entry;
+ struct ChainEntry *prevPtr;
+ struct ChainEntry *nextPtr;
+} ChainEntry;
/*
* Internal representation of a dictionary.
*
- * The internal representation of a dictionary object is a hash table
- * (with Tcl_Objs for both keys and values), a reference count and
- * epoch number for detecting concurrent modifications of the
- * dictionary, and a pointer to the parent object (used when
- * invalidating string reps of pathed dictionary trees) which is NULL
- * in normal use. The fact that hash tables know (with appropriate
- * initialisation) already about objects makes key management /so/
+ * The internal representation of a dictionary object is a hash table (with
+ * Tcl_Objs for both keys and values), a reference count and epoch number for
+ * detecting concurrent modifications of the dictionary, and a pointer to the
+ * parent object (used when invalidating string reps of pathed dictionary
+ * trees) which is NULL in normal use. The fact that hash tables know (with
+ * appropriate initialisation) already about objects makes key management /so/
* much easier!
*
- * Reference counts are used to enable safe iteration across hashes
- * while allowing the type of the containing object to be modified.
+ * Reference counts are used to enable safe iteration across hashes while
+ * allowing the type of the containing object to be modified.
*/
typedef struct Dict {
- Tcl_HashTable table;
- int epoch;
- int refcount;
- Tcl_Obj *chain;
+ Tcl_HashTable table; /* Object hash table to store mapping in. */
+ ChainEntry *entryChainHead; /* Linked list of all entries in the
+ * dictionary. Used for doing traversal of the
+ * entries in the order that they are
+ * created. */
+ ChainEntry *entryChainTail; /* Other end of linked list of all entries in
+ * the dictionary. Used for doing traversal of
+ * the entries in the order that they are
+ * created. */
+ int epoch; /* Epoch counter */
+ int refcount; /* Reference counter (see above) */
+ Tcl_Obj *chain; /* Linked list used for invalidating the
+ * string representations of updated nested
+ * dictionaries. */
} Dict;
/*
* The structure below defines the dictionary object type by means of
- * procedures that can be invoked by generic object code.
+ * functions that can be invoked by generic object code.
*/
-Tcl_ObjType tclDictType = {
+const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
- DupDictInternalRep, /* dupIntRepProc */
+ DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
+
+/*
+ * The type of the specially adapted version of the Tcl_Obj*-containing hash
+ * table defined in the tclObj.c code. This version differs in that it
+ * allocates a bit more space in each hash entry in order to hold the pointers
+ * used to keep the hash entries in a linked list.
+ *
+ * Note that this type of hash table is *only* suitable for direct use in
+ * *this* file. Everything else should use the dict iterator API.
+ */
+
+static const Tcl_HashKeyType chainHashType = {
+ TCL_HASH_KEY_TYPE_VERSION,
+ 0,
+ TclHashObjKey,
+ TclCompareObjKeys,
+ 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 *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocChainEntry --
+ *
+ * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key, and
+ * which has a bit of extra space afterwards for storing pointers to the
+ * rest of the chain of entries (the extra pointers are left NULL).
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * Increments the reference count on the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocChainEntry(
+ Tcl_HashTable *tablePtr,
+ void *keyPtr)
+{
+ Tcl_Obj *objPtr = keyPtr;
+ ChainEntry *cPtr;
+
+ cPtr = ckalloc(sizeof(ChainEntry));
+ cPtr->entry.key.objPtr = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ cPtr->entry.clientData = NULL;
+ cPtr->prevPtr = cPtr->nextPtr = NULL;
+
+ return &cPtr->entry;
+}
+
+/*
+ * Helper functions that disguise most of the details relating to how the
+ * linked list of hash entries is managed. In particular, these manage the
+ * creation of the table and initializing of the chain, the deletion of the
+ * table and chain, the adding of an entry to the chain, and the removal of an
+ * entry from the chain.
+ */
+
+static inline void
+InitChainTable(
+ Dict *dict)
+{
+ Tcl_InitCustomHashTable(&dict->table, TCL_CUSTOM_PTR_KEYS,
+ &chainHashType);
+ dict->entryChainHead = dict->entryChainTail = NULL;
+}
+
+static inline void
+DeleteChainTable(
+ Dict *dict)
+{
+ ChainEntry *cPtr;
+
+ for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
+ TclDecrRefCount(valuePtr);
+ }
+ Tcl_DeleteHashTable(&dict->table);
+}
+
+static inline Tcl_HashEntry *
+CreateChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr,
+ int *newPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr);
+
+ /*
+ * If this is a new entry in the hash table, stitch it into the chain.
+ */
+
+ if (*newPtr) {
+ cPtr->nextPtr = NULL;
+ if (dict->entryChainHead == NULL) {
+ cPtr->prevPtr = NULL;
+ dict->entryChainHead = cPtr;
+ dict->entryChainTail = cPtr;
+ } else {
+ cPtr->prevPtr = dict->entryChainTail;
+ dict->entryChainTail->nextPtr = cPtr;
+ dict->entryChainTail = cPtr;
+ }
+ }
+
+ return &cPtr->entry;
+}
+
+static inline int
+DeleteChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_FindHashEntry(&dict->table, keyPtr);
+
+ if (cPtr == NULL) {
+ return 0;
+ } else {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ TclDecrRefCount(valuePtr);
+ }
+
+ /*
+ * Unstitch from the chain.
+ */
+
+ if (cPtr->nextPtr) {
+ cPtr->nextPtr->prevPtr = cPtr->prevPtr;
+ } else {
+ dict->entryChainTail = cPtr->prevPtr;
+ }
+ if (cPtr->prevPtr) {
+ cPtr->prevPtr->nextPtr = cPtr->nextPtr;
+ } else {
+ dict->entryChainHead = cPtr->nextPtr;
+ }
+
+ Tcl_DeleteHashEntry(&cPtr->entry);
+ return 1;
+}
/*
*----------------------------------------------------------------------
*
* DupDictInternalRep --
*
- * Initialize the internal representation of a dictionary Tcl_Obj
- * to a copy of the internal representation of an existing
- * dictionary object.
+ * Initialize the internal representation of a dictionary Tcl_Obj to a
+ * copy of the internal representation of an existing dictionary object.
*
* Results:
* None.
*
* Side effects:
- * "srcPtr"s dictionary internal rep pointer should not be NULL and
- * we assume it is not NULL. We set "copyPtr"s internal rep to a
- * pointer to a newly allocated dictionary rep that, in turn, points
- * to "srcPtr"s key and value objects. Those objects are not
- * actually copied but are shared between "srcPtr" and "copyPtr".
- * The ref count of each key and value object is incremented.
+ * "srcPtr"s dictionary internal rep pointer should not be NULL and we
+ * assume it is not NULL. We set "copyPtr"s internal rep to a pointer to
+ * a newly allocated dictionary rep that, in turn, points to "srcPtr"s
+ * key and value objects. Those objects are not actually copied but are
+ * shared between "srcPtr" and "copyPtr". The ref count of each key and
+ * value object is incremented.
*
*----------------------------------------------------------------------
*/
static void
-DupDictInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr, *copyPtr;
+DupDictInternalRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
{
- Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr;
- Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_HashEntry *hPtr, *newHPtr;
- Tcl_HashSearch search;
- Tcl_Obj *keyPtr, *valuePtr;
- int isNew;
+ Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+ Dict *newDict = ckalloc(sizeof(Dict));
+ ChainEntry *cPtr;
/*
* Copy values across from the old hash table.
*/
- Tcl_InitObjHashTable(&newDict->table);
- for (hPtr=Tcl_FirstHashEntry(&oldDict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&oldDict->table, hPtr);
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- newHPtr = Tcl_CreateHashEntry(&newDict->table, (char *)keyPtr, &isNew);
- Tcl_SetHashValue(newHPtr, (ClientData)valuePtr);
+
+ InitChainTable(newDict);
+ for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ int n;
+ Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
+
+ /*
+ * Fill in the contents.
+ */
+
+ Tcl_SetHashValue(hPtr, valuePtr);
Tcl_IncrRefCount(valuePtr);
}
/*
* Initialise other fields.
*/
+
newDict->epoch = 0;
newDict->chain = NULL;
newDict->refcount = 1;
@@ -163,7 +395,8 @@ DupDictInternalRep(srcPtr, copyPtr)
/*
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = (VOID *) newDict;
+
+ copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -172,32 +405,30 @@ DupDictInternalRep(srcPtr, copyPtr)
*
* FreeDictInternalRep --
*
- * Deallocate the storage associated with a dictionary object's
- * internal representation.
+ * Deallocate the storage associated with a dictionary object's internal
+ * representation.
*
* Results:
* None
*
* Side effects:
- * Frees the memory holding the dictionary's internal hash table
- * unless it is locked by an iteration going over it.
+ * Frees the memory holding the dictionary's internal hash table unless
+ * it is locked by an iteration going over it.
*
*----------------------------------------------------------------------
-
*/
static void
-FreeDictInternalRep(dictPtr)
- Tcl_Obj *dictPtr;
+FreeDictInternalRep(
+ Tcl_Obj *dictPtr)
{
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
- --dict->refcount;
+ dict->refcount--;
if (dict->refcount <= 0) {
DeleteDict(dict);
}
-
- dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */
+ dictPtr->typePtr = NULL;
}
/*
@@ -205,41 +436,27 @@ FreeDictInternalRep(dictPtr)
*
* DeleteDict --
*
- * Delete the structure that is used to implement a dictionary's
- * internal representation. Called when either the dictionary
- * object loses its internal representation or when the last
- * iteration over the dictionary completes.
+ * Delete the structure that is used to implement a dictionary's internal
+ * representation. Called when either the dictionary object loses its
+ * internal representation or when the last iteration over the dictionary
+ * completes.
*
* Results:
* None
*
* Side effects:
- * Decrements the reference count of all key and value objects in
- * the dictionary, which may free them.
+ * Decrements the reference count of all key and value objects in the
+ * dictionary, which may free them.
*
*----------------------------------------------------------------------
*/
static void
-DeleteDict(dict)
- Dict *dict;
+DeleteDict(
+ Dict *dict)
{
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
- Tcl_Obj *valuePtr;
-
- /*
- * Delete the values ourselves, because hashes know nothing about
- * their contents (but do know about the key type, so that doesn't
- * need explicit attention.)
- */
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
- }
- Tcl_DeleteHashTable(&dict->table);
- ckfree((char *) dict);
+ DeleteChainTable(dict);
+ ckfree(dict);
}
/*
@@ -247,41 +464,50 @@ DeleteDict(dict)
*
* UpdateStringOfDict --
*
- * Update the string representation for a dictionary object.
- * Note: This procedure does not invalidate an existing old string
- * rep so storage will be lost if this has not already been done.
- * This code is based on UpdateStringOfList in tclListObj.c
+ * Update the string representation for a dictionary object. Note: This
+ * function does not invalidate an existing old string rep so storage
+ * will be lost if this has not already been done. This code is based on
+ * UpdateStringOfList in tclListObj.c
*
* Results:
* None.
*
* Side effects:
- * The object's string is set to a valid string that results from
- * the dict-to-string conversion. This string will be empty if the
- * dictionary has no key/value pairs. The dictionary internal
- * representation should not be NULL and we assume it is not NULL.
+ * The object's string is set to a valid string that results from the
+ * dict-to-string conversion. This string will be empty if the dictionary
+ * has no key/value pairs. The dictionary internal representation should
+ * not be NULL and we assume it is not NULL.
*
*----------------------------------------------------------------------
*/
static void
-UpdateStringOfDict(dictPtr)
- Tcl_Obj *dictPtr;
+UpdateStringOfDict(
+ Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
- int numElems, i, length;
- char *elem, *dst;
+ 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...
+ * 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.
@@ -289,57 +515,63 @@ UpdateStringOfDict(dictPtr)
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,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
+ for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
- * Assume that hPtr is never NULL since we know the number of
- * array elements already.
+ * Assume that cPtr is never NULL since we know the number of array
+ * elements already.
*/
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
- elem = Tcl_GetStringFromObj(keyPtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i]) + 1;
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ elem = TclGetStringFromObj(keyPtr, &length);
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- elem = Tcl_GetStringFromObj(valuePtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i+1]) + 1;
+ flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ elem = TclGetStringFromObj(valuePtr, &length);
+ 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,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
- elem = Tcl_GetStringFromObj(keyPtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH) );
- *(dst++) = ' ';
-
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- elem = Tcl_GetStringFromObj(valuePtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i+1] | TCL_DONT_QUOTE_HASH);
- *(dst++) = ' ';
+ 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 += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
+
+ flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ elem = TclGetStringFromObj(valuePtr, &length);
+ 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;
}
/*
@@ -347,11 +579,10 @@ UpdateStringOfDict(dictPtr)
*
* SetDictFromAny --
*
- * Convert a non-dictionary object into a dictionary object. This
- * code is very closely related to SetListFromAny in tclListObj.c
- * but does not actually guarantee that a dictionary object will
- * have a string rep (as conversions from lists are handled with a
- * special case.)
+ * Convert a non-dictionary object into a dictionary object. This code is
+ * very closely related to SetListFromAny in tclListObj.c but does not
+ * actually guarantee that a dictionary object will have a string rep (as
+ * conversions from lists are handled with a special case.)
*
* Results:
* A standard Tcl result.
@@ -364,168 +595,117 @@ UpdateStringOfDict(dictPtr)
*/
static int
-SetDictFromAny(interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
+SetDictFromAny(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
- char *string, *s;
- CONST char *elemStart, *nextElem;
- int lenRemain, length, elemSize, hasBrace, result, isNew;
- char *limit; /* Points just after string's last byte. */
- register CONST char *p;
- register Tcl_Obj *keyPtr, *valuePtr;
- Dict *dict;
Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ int isNew, result;
+ Dict *dict = ckalloc(sizeof(Dict));
+
+ InitChainTable(dict);
/*
* Since lists and dictionaries have very closely-related string
- * representations (i.e. the same parsing code) we can safely
- * special-case the conversion from lists to dictionaries.
+ * representations (i.e. the same parsing code) we can safely special-case
+ * the conversion from lists to dictionaries.
*/
if (objPtr->typePtr == &tclListType) {
int objc, i;
Tcl_Obj **objv;
- if (Tcl_ListObjGetElements(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_SetObjResult(interp,
- Tcl_NewStringObj("missing value to go with key", -1));
- }
- return TCL_ERROR;
- }
-
- /*
- * If the list is shared its string rep must not be lost so it
- * still is the same list.
- */
-
- if (Tcl_IsShared(objPtr)) {
- (void) Tcl_GetString(objPtr);
+ goto missingValue;
}
- /*
- * Build the hash of key/value pairs.
- */
- dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
for (i=0 ; i<objc ; i+=2) {
- /*
- * Store key and value in the hash table we're building.
- */
-
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)objv[i], &isNew);
+
+ /* Store key and value in the hash table we're building. */
+ hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(discardedValue);
- }
- Tcl_SetHashValue(hPtr, (ClientData) objv[i+1]);
- Tcl_IncrRefCount(objv[i+1]); /* since hash now holds ref to it */
- }
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
- /*
- * Share type-setting code with the string-conversion case.
- */
- goto installHash;
- }
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = Tcl_GetStringFromObj(objPtr, &length);
- limit = (string + length);
+ /*
+ * Not really a well-formed dictionary as there are duplicate
+ * keys, so better get the string rep here so that we can
+ * convert back.
+ */
- /*
- * Allocate a new HashTable that has objects for keys and objects
- * for values.
- */
+ (void) Tcl_GetString(objPtr);
- dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
- 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) {
- goto errorExit;
- }
- if (elemStart >= limit) {
- break;
+ TclDecrRefCount(discardedValue);
+ }
+ Tcl_SetHashValue(hPtr, objv[i+1]);
+ Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
}
+ } else {
+ int length;
+ const char *nextElem = TclGetStringFromObj(objPtr, &length);
+ const char *limit = (nextElem + length);
- /*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
- */
+ while (nextElem < limit) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ const char *elemStart;
+ int elemSize, literal;
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy((VOID *) s, (VOID *) 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, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal);
+ if (result != TCL_OK) {
+ goto errorExit;
+ }
+ if (elemStart == limit) {
+ break;
+ }
+ if (nextElem == limit) {
+ goto missingValue;
+ }
- result = TclFindElement(interp, p, lenRemain,
- &elemStart, &nextElem, &elemSize, &hasBrace);
- if (result != TCL_OK) {
- TclDecrRefCount(keyPtr);
- goto errorExit;
- }
- if (elemStart >= limit) {
- goto missingKey;
- }
+ 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);
+ }
- /*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
- */
+ result = TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal);
+ if (result != TCL_OK) {
+ TclDecrRefCount(keyPtr);
+ goto errorExit;
+ }
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
- }
+ 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);
+ }
- TclNewObj(valuePtr);
- valuePtr->bytes = s;
- valuePtr->length = elemSize;
+ /* Store key and value in the hash table we're building. */
+ 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 = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
- if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) 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, (ClientData) 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
+ * 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.
*/
@@ -533,25 +713,24 @@ SetDictFromAny(interp, objPtr)
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = (VOID *) dict;
+ objPtr->internalRep.twoPtrValue.ptr1 = dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
- missingKey:
+ missingValue:
if (interp != NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("missing value to go with key", -1));
+ 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:
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
+
+ errorExit:
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
- Tcl_DeleteHashTable(&dict->table);
- ckfree((char *) dict);
+ DeleteChainTable(dict);
+ ckfree(dict);
return result;
}
@@ -560,29 +739,27 @@ SetDictFromAny(interp, objPtr)
*
* TclTraceDictPath --
*
- * Trace through a tree of dictionaries using the array of keys
- * given. If the flags argument has the DICT_PATH_UPDATE flag is
- * set, a backward-pointing chain of dictionaries is also built
- * (in the Dict's chain field) and the chained dictionaries are
- * made into unshared dictionaries (if they aren't already.)
+ * Trace through a tree of dictionaries using the array of keys given. If
+ * the flags argument has the DICT_PATH_UPDATE flag is set, a
+ * backward-pointing chain of dictionaries is also built (in the Dict's
+ * chain field) and the chained dictionaries are made into unshared
+ * dictionaries (if they aren't already.)
*
* Results:
- * The object at the end of the path, or NULL if there was an
- * error. Note that this it is an error for an intermediate
- * dictionary on the path to not exist. If the flags argument
- * has the DICT_PATH_EXISTS set, a non-existent path gives a
- * DICT_PATH_NON_EXISTENT result.
+ * The object at the end of the path, or NULL if there was an error. Note
+ * that this it is an error for an intermediate dictionary on the path to
+ * not exist. If the flags argument has the DICT_PATH_EXISTS set, a
+ * non-existent path gives a DICT_PATH_NON_EXISTENT result.
*
* Side effects:
- * If the flags argument is zero or DICT_PATH_EXISTS, there are
- * no side effects (other than potential conversion of objects to
- * dictionaries.) If the flags argument is DICT_PATH_UPDATE, the
- * following additional side effects occur. Shared dictionaries
- * along the path are converted into unshared objects, and a
- * backward-pointing chain is built using the chain fields of the
- * dictionaries (for easy invalidation of string representations
- * using InvalidateDictChain.) If the flags argument has the
- * DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
+ * If the flags argument is zero or DICT_PATH_EXISTS, there are no side
+ * effects (other than potential conversion of objects to dictionaries.)
+ * If the flags argument is DICT_PATH_UPDATE, the following additional
+ * side effects occur. Shared dictionaries along the path are converted
+ * into unshared objects, and a backward-pointing chain is built using
+ * the chain fields of the dictionaries (for easy invalidation of string
+ * representations using InvalidateDictChain). If the flags argument has
+ * the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
* non-existant keys will be inserted with a value of an empty
* dictionary, resulting in the path being built.
*
@@ -590,10 +767,12 @@ SetDictFromAny(interp, objPtr)
*/
Tcl_Obj *
-TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *CONST keyv[];
- int keyc, flags;
+TclTraceDictPath(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *const keyv[],
+ int flags)
{
Dict *dict, *newDict;
int i;
@@ -603,25 +782,28 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
return NULL;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
for (i=0 ; i<keyc ; i++) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
Tcl_Obj *tmpObj;
if (hPtr == NULL) {
int isNew; /* Dummy */
+
if (flags & DICT_PATH_EXISTS) {
return DICT_PATH_NON_EXISTENT;
}
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);
}
return NULL;
}
@@ -629,12 +811,13 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
/*
* The next line should always set isNew to 1.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[i], &isNew);
+
+ hPtr = CreateChainEntry(dict, keyv[i], &isNew);
tmpObj = Tcl_NewDictObj();
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+ Tcl_SetHashValue(hPtr, tmpObj);
} else {
- tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ tmpObj = Tcl_GetHashValue(hPtr);
if (tmpObj->typePtr != &tclDictType) {
if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
return NULL;
@@ -642,15 +825,15 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
}
}
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
tmpObj = Tcl_DuplicateObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+ Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
}
newDict->chain = dictPtr;
@@ -666,36 +849,36 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
*
* InvalidateDictChain --
*
- * Go through a dictionary chain (built by an updating invokation
- * of TclTraceDictPath) and invalidate the string representations
- * of all the dictionaries on the chain.
+ * Go through a dictionary chain (built by an updating invokation of
+ * TclTraceDictPath) and invalidate the string representations of all the
+ * dictionaries on the chain.
*
* Results:
* None
*
* Side effects:
- * String reps are invalidated and epoch counters (for detecting
- * illegal concurrent modifications) are updated through the
- * chain of updated dictionaries.
+ * String reps are invalidated and epoch counters (for detecting illegal
+ * concurrent modifications) are updated through the chain of updated
+ * dictionaries.
*
*----------------------------------------------------------------------
*/
static void
-InvalidateDictChain(dictObj)
- Tcl_Obj *dictObj;
+InvalidateDictChain(
+ Tcl_Obj *dictObj)
{
- Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
do {
- Tcl_InvalidateStringRep(dictObj);
+ TclInvalidateStringRep(dictObj);
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
- dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ dict = dictObj->internalRep.twoPtrValue.ptr1;
} while (dict != NULL);
}
@@ -704,48 +887,52 @@ InvalidateDictChain(dictObj)
*
* Tcl_DictObjPut --
*
- * Add a key,value pair to a dictionary, or update the value for a
- * key if that key already has a mapping in the dictionary.
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one, and any string representation that it has
- * is invalidated.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr, *valuePtr;
+Tcl_DictObjPut(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr,
+ Tcl_Obj *valuePtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
int isNew;
if (Tcl_IsShared(dictPtr)) {
- Tcl_Panic("Tcl_DictObjPut called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
}
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -758,25 +945,27 @@ Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr)
*
* Tcl_DictObjGet --
*
- * Given a key, get its value from the dictionary (or NULL if key
- * is not found in dictionary.)
+ * Given a key, get its value from the dictionary (or NULL if key is not
+ * found in dictionary.)
*
* Results:
- * A standard Tcl result. The variable pointed to by valuePtrPtr
- * is updated with the value for the key. Note that it is not an
- * error for the key to have no mapping in the dictionary.
+ * A standard Tcl result. The variable pointed to by valuePtrPtr is
+ * updated with the value for the key. Note that it is not an error for
+ * the key to have no mapping in the dictionary.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr, **valuePtrPtr;
+Tcl_DictObjGet(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr,
+ Tcl_Obj **valuePtrPtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -784,16 +973,17 @@ Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
if (result != TCL_OK) {
+ *valuePtrPtr = NULL;
return result;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
} else {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(hPtr);
}
return TCL_OK;
}
@@ -803,30 +993,30 @@ Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)
*
* Tcl_DictObjRemove --
*
- * Remove the key,value pair with the given key from the dictionary;
- * the key does not need to be present in the dictionary.
+ * Remove the key,value pair with the given key from the dictionary; the
+ * key does not need to be present in the dictionary.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one, and any string representation that it has
- * is invalidated.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjRemove(interp, dictPtr, keyPtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr;
+Tcl_DictObjRemove(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr)
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
- Tcl_Panic("Tcl_DictObjRemove called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
}
if (dictPtr->typePtr != &tclDictType) {
@@ -837,15 +1027,10 @@ Tcl_DictObjRemove(interp, dictPtr, keyPtr)
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
- if (hPtr != NULL) {
- Tcl_Obj *valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-
- TclDecrRefCount(valuePtr);
- Tcl_DeleteHashEntry(hPtr);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ if (DeleteChainEntry(dict, keyPtr)) {
dict->epoch++;
}
return TCL_OK;
@@ -859,21 +1044,21 @@ Tcl_DictObjRemove(interp, dictPtr, keyPtr)
* How many key,value pairs are there in the dictionary?
*
* Results:
- * A standard Tcl result. Updates the variable pointed to by
- * sizePtr with the number of key,value pairs in the dictionary.
+ * A standard Tcl result. Updates the variable pointed to by sizePtr with
+ * the number of key,value pairs in the dictionary.
*
* Side effects:
- * The dictPtr object is converted to a dictionary type if it is
- * not a dictionary already.
+ * The dictPtr object is converted to a dictionary type if it is not a
+ * dictionary already.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjSize(interp, dictPtr, sizePtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr;
- int *sizePtr;
+Tcl_DictObjSize(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int *sizePtr)
{
Dict *dict;
@@ -884,7 +1069,7 @@ Tcl_DictObjSize(interp, dictPtr, sizePtr)
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -894,67 +1079,67 @@ Tcl_DictObjSize(interp, dictPtr, sizePtr)
*
* Tcl_DictObjFirst --
*
- * Start a traversal of the dictionary. Caller must supply the
- * search context, pointers for returning key and value, and a
- * pointer to allow indication of whether the dictionary has been
- * traversed (i.e. the dictionary is empty.) The order of traversal
- * is undefined.
+ * Start a traversal of the dictionary. Caller must supply the search
+ * context, pointers for returning key and value, and a pointer to allow
+ * indication of whether the dictionary has been traversed (i.e. the
+ * dictionary is empty). The order of traversal is undefined.
*
* Results:
- * A standard Tcl result. Updates the variables pointed to by
- * keyPtrPtr, valuePtrPtr and donePtr. Either of keyPtrPtr and
- * valuePtrPtr may be NULL, in which case the key/value is not made
- * available to the caller.
+ * A standard Tcl result. Updates the variables pointed to by keyPtrPtr,
+ * valuePtrPtr and donePtr. Either of keyPtrPtr and valuePtrPtr may be
+ * NULL, in which case the key/value is not made available to the caller.
*
* Side effects:
- * The dictPtr object is converted to a dictionary type if it is
- * not a dictionary already. The search context is initialised if
- * the search has not finished. The dictionary's internal rep is
- * Tcl_Preserve()d if the dictionary has at least one element.
+ * The dictPtr object is converted to a dictionary type if it is not a
+ * dictionary already. The search context is initialised if the search
+ * has not finished. The dictionary's internal rep is Tcl_Preserve()d if
+ * the dictionary has at least one element.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
- Tcl_Interp *interp; /* For error messages, or NULL if no
- * error messages desired. */
- Tcl_Obj *dictPtr; /* Dictionary to traverse. */
- Tcl_DictSearch *searchPtr; /* Pointer to a dict search context. */
- Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the
- * first key written into, or NULL. */
- Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the
- * first value written into, or NULL.*/
- int *donePtr; /* Pointer to a variable which will
- * have a 1 written into when there
- * are no further values in the
- * dictionary, or a 0 otherwise. */
+Tcl_DictObjFirst(
+ Tcl_Interp *interp, /* For error messages, or NULL if no error
+ * messages desired. */
+ Tcl_Obj *dictPtr, /* Dictionary to traverse. */
+ Tcl_DictSearch *searchPtr, /* Pointer to a dict search context. */
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first
+ * value written into, or NULL.*/
+ int *donePtr) /* Pointer to a variable which will have a 1
+ * written into when there are no further
+ * values in the dictionary, or a 0
+ * otherwise. */
{
Dict *dict;
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FirstHashEntry(&dict->table, &searchPtr->search);
- if (hPtr == NULL) {
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ cPtr = dict->entryChainHead;
+ if (cPtr == NULL) {
searchPtr->epoch = -1;
*donePtr = 1;
} else {
*donePtr = 0;
searchPtr->dictionaryPtr = (Tcl_Dict) dict;
searchPtr->epoch = dict->epoch;
+ searchPtr->next = cPtr->nextPtr;
dict->refcount++;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
return TCL_OK;
@@ -966,69 +1151,72 @@ Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
* Tcl_DictObjNext --
*
* Continue a traversal of a dictionary previously started with
- * Tcl_DictObjFirst. This function is safe against concurrent
- * modification of the underlying object (including type
- * shimmering), treating such situations as if the search has
- * terminated, though it is up to the caller to ensure that the
- * object itself is not disposed until the search has finished.
- * It is _not_ safe against modifications from other threads.
+ * Tcl_DictObjFirst. This function is safe against concurrent
+ * modification of the underlying object (including type shimmering),
+ * treating such situations as if the search has terminated, though it is
+ * up to the caller to ensure that the object itself is not disposed
+ * until the search has finished. It is _not_ safe against modifications
+ * from other threads.
*
* Results:
* Updates the variables pointed to by keyPtrPtr, valuePtrPtr and
- * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in
- * which case the key/value is not made available to the caller.
+ * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in which
+ * case the key/value is not made available to the caller.
*
* Side effects:
- * Removes a reference to the dictionary's internal rep if the
- * search terminates.
+ * Removes a reference to the dictionary's internal rep if the search
+ * terminates.
*
*----------------------------------------------------------------------
*/
void
-Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
- Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */
- Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the
- * first key written into, or NULL. */
- Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the
- * first value written into, or NULL.*/
- int *donePtr; /* Pointer to a variable which will
- * have a 1 written into when there
- * are no further values in the
- * dictionary, or a 0 otherwise. */
+Tcl_DictObjNext(
+ Tcl_DictSearch *searchPtr, /* Pointer to a hash search context. */
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first
+ * value written into, or NULL.*/
+ int *donePtr) /* Pointer to a variable which will have a 1
+ * written into when there are no further
+ * values in the dictionary, or a 0
+ * otherwise. */
{
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
/*
* If the searh is done; we do no work.
*/
+
if (searchPtr->epoch == -1) {
*donePtr = 1;
return;
}
/*
- * Bail out if the dictionary has had any elements added, modified
- * or removed. This *shouldn't* happen, but...
+ * Bail out if the dictionary has had any elements added, modified or
+ * removed. This *shouldn't* happen, but...
*/
+
if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
Tcl_Panic("concurrent dictionary modification and search");
}
- hPtr = Tcl_NextHashEntry(&searchPtr->search);
- if (hPtr == NULL) {
+ cPtr = searchPtr->next;
+ if (cPtr == NULL) {
Tcl_DictObjDone(searchPtr);
*donePtr = 1;
return;
}
+ searchPtr->next = cPtr->nextPtr;
*donePtr = 0;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
- &((Dict *)searchPtr->dictionaryPtr)->table, hPtr);
+ *keyPtrPtr = Tcl_GetHashKey(
+ &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
@@ -1037,11 +1225,10 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
*
* Tcl_DictObjDone --
*
- * Call this if you want to stop a search before you reach the
- * end of the dictionary (e.g. because of abnormal termination of
- * the search.) It should not be used if the search reaches its
- * natural end (i.e. if either Tcl_DictObjFirst or Tcl_DictObjNext
- * sets its donePtr variable to 1.)
+ * Call this if you want to stop a search before you reach the end of the
+ * dictionary (e.g. because of abnormal termination of the search). It
+ * need not be used if the search reaches its natural end (i.e. if either
+ * Tcl_DictObjFirst or Tcl_DictObjNext sets its donePtr variable to 1).
*
* Results:
* None.
@@ -1053,8 +1240,8 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
*/
void
-Tcl_DictObjDone(searchPtr)
- Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */
+Tcl_DictObjDone(
+ Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */
{
Dict *dict;
@@ -1073,36 +1260,38 @@ Tcl_DictObjDone(searchPtr)
*
* Tcl_DictObjPutKeyList --
*
- * Add a key...key,value pair to a dictionary tree. The main
- * dictionary value must not be shared, though sub-dictionaries may
- * be. All intermediate dictionaries on the path must exist.
+ * Add a key...key,value pair to a dictionary tree. The main dictionary
+ * value must not be shared, though sub-dictionaries may be. All
+ * intermediate dictionaries on the path must exist.
*
* Results:
- * A standard Tcl result. Note that in the error case, a message
- * is left in interp unless that is NULL.
+ * A standard Tcl result. Note that in the error case, a message is left
+ * in interp unless that is NULL.
*
* Side effects:
- * If the dictionary and any of its sub-dictionaries on the
- * path have string representations, these are invalidated.
+ * If the dictionary and any of its sub-dictionaries on the path have
+ * string representations, these are invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
- Tcl_Interp *interp;
- int keyc;
- Tcl_Obj *dictPtr, *CONST keyv[], *valuePtr;
+Tcl_DictObjPutKeyList(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *const keyv[],
+ Tcl_Obj *valuePtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
int isNew;
if (Tcl_IsShared(dictPtr)) {
- Tcl_Panic("Tcl_DictObjPutKeyList called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList");
}
if (keyc < 1) {
- Tcl_Panic("Tcl_DictObjPutKeyList called with empty key list");
+ Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList");
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
@@ -1110,11 +1299,11 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[keyc-1], &isNew);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -1129,36 +1318,36 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
* Tcl_DictObjRemoveKeyList --
*
* Remove a key...key,value pair from a dictionary tree (the value
- * removed is implicit in the key path.) The main dictionary value
- * must not be shared, though sub-dictionaries may be. It is not
- * an error if there is no value associated with the given key list,
- * but all intermediate dictionaries on the key path must exist.
+ * removed is implicit in the key path). The main dictionary value must
+ * not be shared, though sub-dictionaries may be. It is not an error if
+ * there is no value associated with the given key list, but all
+ * intermediate dictionaries on the key path must exist.
*
* Results:
- * A standard Tcl result. Note that in the error case, a message
- * is left in interp unless that is NULL.
+ * A standard Tcl result. Note that in the error case, a message is left
+ * in interp unless that is NULL.
*
* Side effects:
- * If the dictionary and any of its sub-dictionaries on the key
- * path have string representations, these are invalidated.
+ * If the dictionary and any of its sub-dictionaries on the key path have
+ * string representations, these are invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
- Tcl_Interp *interp;
- int keyc;
- Tcl_Obj *dictPtr, *CONST keyv[];
+Tcl_DictObjRemoveKeyList(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *const keyv[])
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
- Tcl_Panic("Tcl_DictObjRemoveKeyList called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
}
if (keyc < 1) {
- Tcl_Panic("Tcl_DictObjRemoveKeyList called with empty key list");
+ Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList");
}
dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
@@ -1166,13 +1355,8 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[keyc-1]);
- if (hPtr != NULL) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(oldValuePtr);
- Tcl_DeleteHashEntry(hPtr);
- }
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
}
@@ -1182,17 +1366,17 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
*
* Tcl_NewDictObj --
*
- * This procedure is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new dict object
- * without any content.
+ * This function is normally called when not debugging: i.e., when
+ * TCL_MEM_DEBUG is not defined. It creates a new dict object without any
+ * content.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the
- * result of calling the debugging version Tcl_DbNewDictObj.
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
+ * of calling the debugging version Tcl_DbNewDictObj.
*
* Results:
- * A new dict object is returned; it has no keys defined in it.
- * The new object's string representation is left NULL, and the
- * ref count of the object is 0.
+ * A new dict object is returned; it has no keys defined in it. The new
+ * object's string representation is left NULL, and the ref count of the
+ * object is 0.
*
* Side Effects:
* None.
@@ -1201,22 +1385,23 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
*/
Tcl_Obj *
-Tcl_NewDictObj()
+Tcl_NewDictObj(void)
{
#ifdef TCL_MEM_DEBUG
return Tcl_DbNewDictObj("unknown", 0);
#else /* !TCL_MEM_DEBUG */
+
Tcl_Obj *dictPtr;
Dict *dict;
TclNewObj(dictPtr);
- Tcl_InvalidateStringRep(dictPtr);
- dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ TclInvalidateStringRep(dictPtr);
+ dict = ckalloc(sizeof(Dict));
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (VOID *) dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1227,21 +1412,21 @@ Tcl_NewDictObj()
*
* Tcl_DbNewDictObj --
*
- * This procedure is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the
- * same as the Tcl_NewDictObj procedure above except that it calls
+ * This function is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the same
+ * as the Tcl_NewDictObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
- * command will report the correct file name and line number when
+ * command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewDictObj.
*
* Results:
- * A new dict object is returned; it has no keys defined in it.
- * The new object's string representation is left NULL, and the
- * ref count of the object is 0.
+ * A new dict object is returned; it has no keys defined in it. The new
+ * object's string representation is left NULL, and the ref count of the
+ * object is 0.
*
* Side Effects:
* None.
@@ -1250,22 +1435,22 @@ Tcl_NewDictObj()
*/
Tcl_Obj *
-Tcl_DbNewDictObj(file, line)
- CONST char *file;
- int line;
+Tcl_DbNewDictObj(
+ const char *file,
+ int line)
{
#ifdef TCL_MEM_DEBUG
Tcl_Obj *dictPtr;
Dict *dict;
TclDbNewObj(dictPtr, file, line);
- Tcl_InvalidateStringRep(dictPtr);
- dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ TclInvalidateStringRep(dictPtr);
+ dict = ckalloc(sizeof(Dict));
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (VOID *) dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1280,9 +1465,9 @@ Tcl_DbNewDictObj(file, line)
*
* DictCreateCmd --
*
- * This function implements the "dict create" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict create" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1294,26 +1479,28 @@ Tcl_DbNewDictObj(file, line)
*/
static int
-DictCreateCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictCreateCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
int i;
/*
- * Must have an even number of arguments; note that number of
- * preceding arguments (i.e. "dict create" is also even, which
- * makes this much easier.)
+ * Must have an even number of arguments; note that number of preceding
+ * arguments (i.e. "dict create" is also even, which makes this much
+ * easier.)
*/
- if (objc & 1) {
- Tcl_WrongNumArgs(interp, 2, objv, "?key value ...?");
+
+ if ((objc & 1) == 0) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?key value ...?");
return TCL_ERROR;
}
dictObj = Tcl_NewDictObj();
- for (i=2 ; i<objc ; i+=2) {
+ for (i=1 ; i<objc ; i+=2) {
/*
* The next command is assumed to never fail...
*/
@@ -1328,9 +1515,9 @@ DictCreateCmd(interp, objc, objv)
*
* DictGetCmd --
*
- * This function implements the "dict get" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict get" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1342,31 +1529,32 @@ DictCreateCmd(interp, objc, objv)
*/
static int
-DictGetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictGetCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key key ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
return TCL_ERROR;
}
/*
- * Test for the special case of no keys, which returns a *list* of
- * all key,value pairs. We produce a copy here because that makes
- * subsequent list handling more efficient.
+ * Test for the special case of no keys, which returns a *list* of all
+ * key,value pairs. We produce a copy here because that makes subsequent
+ * list handling more efficient.
*/
- if (objc == 3) {
- Tcl_Obj *keyPtr, *listPtr;
+ if (objc == 2) {
+ Tcl_Obj *keyPtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
- result = Tcl_DictObjFirst(interp, objv[2], &search,
+ result = Tcl_DictObjFirst(interp, objv[1], &search,
&keyPtr, &valuePtr, &done);
if (result != TCL_OK) {
return result;
@@ -1374,8 +1562,8 @@ DictGetCmd(interp, objc, objv)
listPtr = Tcl_NewListObj(0, NULL);
while (!done) {
/*
- * Assume these won't fail as we have complete control
- * over the types of things here.
+ * Assume these won't fail as we have complete control over the
+ * types of things here.
*/
Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
@@ -1388,15 +1576,14 @@ DictGetCmd(interp, objc, objv)
}
/*
- * Loop through the list of keys, looking up the key at the
- * current index in the current dictionary each time. Once we've
- * done the lookup, we set the current dictionary to be the value
- * we looked up (in case the value was not the last one and we are
- * going through a chain of searches.) Note that this loop always
- * executes at least once.
+ * Loop through the list of keys, looking up the key at the current index
+ * in the current dictionary each time. Once we've done the lookup, we set
+ * the current dictionary to be the value we looked up (in case the value
+ * was not the last one and we are going through a chain of searches.)
+ * Note that this loop always executes at least once.
*/
- dictPtr = TclTraceDictPath(interp, objv[2], objc-4,objv+3, DICT_PATH_READ);
+ dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ);
if (dictPtr == NULL) {
return TCL_ERROR;
}
@@ -1405,9 +1592,11 @@ DictGetCmd(interp, objc, objv)
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;
}
Tcl_SetObjResult(interp, valuePtr);
@@ -1419,9 +1608,9 @@ DictGetCmd(interp, objc, objv)
*
* DictReplaceCmd --
*
- * This function implements the "dict replace" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict replace" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1433,26 +1622,27 @@ DictGetCmd(interp, objc, objv)
*/
static int
-DictReplaceCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictReplaceCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
int allocatedDict = 0;
- if ((objc < 3) || !(objc & 1)) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key value ...?");
+ if ((objc < 2) || (objc & 1)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
return TCL_ERROR;
}
- dictPtr = objv[2];
+ dictPtr = objv[1];
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
allocatedDict = 1;
}
- for (i=3 ; i<objc ; i+=2) {
+ for (i=2 ; i<objc ; i+=2) {
result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
if (result != TCL_OK) {
if (allocatedDict) {
@@ -1470,9 +1660,9 @@ DictReplaceCmd(interp, objc, objv)
*
* DictRemoveCmd --
*
- * This function implements the "dict remove" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict remove" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1484,26 +1674,27 @@ DictReplaceCmd(interp, objc, objv)
*/
static int
-DictRemoveCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictRemoveCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
int allocatedDict = 0;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
return TCL_ERROR;
}
- dictPtr = objv[2];
+ dictPtr = objv[1];
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
allocatedDict = 1;
}
- for (i=3 ; i<objc ; i++) {
+ for (i=2 ; i<objc ; i++) {
result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
if (result != TCL_OK) {
if (allocatedDict) {
@@ -1521,9 +1712,9 @@ DictRemoveCmd(interp, objc, objv)
*
* DictMergeCmd --
*
- * This function implements the "dict merge" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#163 for the formal specification.
+ * This function implements the "dict merge" Tcl command. See the user
+ * documentation for details on what it does, and TIP#163 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1535,34 +1726,42 @@ DictRemoveCmd(interp, objc, objv)
*/
static int
-DictMergeCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictMergeCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Tcl_Obj *targetObj, *keyObj, *valueObj;
+ Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
int allocatedDict = 0;
int i, done;
Tcl_DictSearch search;
- if (objc == 2) {
+ if (objc == 1) {
/*
* No dictionary arguments; return default (empty value).
*/
+
return TCL_OK;
}
- if (objc == 3) {
+ /*
+ * Make sure first argument is a dictionary.
+ */
+
+ targetObj = objv[1];
+ if (targetObj->typePtr != &tclDictType) {
+ if (SetDictFromAny(interp, targetObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (objc == 2) {
/*
- * Single argument, make sure it is a dictionary, but
- * otherwise return it.
+ * Single argument, return it.
*/
- if (objv[2]->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, objv[2]) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- Tcl_SetObjResult(interp, objv[2]);
+
+ Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
@@ -1570,12 +1769,11 @@ DictMergeCmd(interp, objc, objv)
* Normal behaviour: combining two (or more) dictionaries.
*/
- targetObj = objv[2];
if (Tcl_IsShared(targetObj)) {
targetObj = Tcl_DuplicateObj(targetObj);
allocatedDict = 1;
}
- for (i=3 ; i<objc ; i++) {
+ for (i=2 ; i<objc ; i++) {
if (Tcl_DictObjFirst(interp, objv[i], &search, &keyObj, &valueObj,
&done) != TCL_OK) {
if (allocatedDict) {
@@ -1584,16 +1782,15 @@ DictMergeCmd(interp, objc, objv)
return TCL_ERROR;
}
while (!done) {
- if (Tcl_DictObjPut(interp, targetObj,
- keyObj, valueObj) != TCL_OK) {
- Tcl_DictObjDone(&search);
- if (allocatedDict) {
- TclDecrRefCount(targetObj);
- }
- return TCL_ERROR;
- }
+ /*
+ * Next line can't fail; already know we have a dictionary in
+ * targetObj.
+ */
+
+ Tcl_DictObjPut(NULL, targetObj, keyObj, valueObj);
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
+ Tcl_DictObjDone(&search);
}
Tcl_SetObjResult(interp, targetObj);
return TCL_OK;
@@ -1604,9 +1801,9 @@ DictMergeCmd(interp, objc, objv)
*
* DictKeysCmd --
*
- * This function implements the "dict keys" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict keys" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1618,46 +1815,66 @@ DictMergeCmd(interp, objc, objv)
*/
static int
-DictKeysCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictKeysCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Tcl_Obj *keyPtr, *listPtr;
- Tcl_DictSearch search;
- int result, done;
- char *pattern = NULL;
+ Tcl_Obj *listPtr;
+ const char *pattern = NULL;
- if (objc!=3 && objc!=4) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?");
+ if (objc!=2 && objc!=3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
return TCL_ERROR;
}
- result = Tcl_DictObjFirst(interp, objv[2], &search, &keyPtr, NULL, &done);
- if (result != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * A direct check that we have a dictionary. We don't start the iteration
+ * yet because that might allocate memory or set locks that we do not
+ * need. [Bug 1705778, leak K04]
+ */
+
+ if (objv[1]->typePtr != &tclDictType) {
+ int result = SetDictFromAny(interp, objv[1]);
+
+ if (result != TCL_OK) {
+ return result;
+ }
}
- if (objc == 4) {
- pattern = TclGetString(objv[3]);
+
+ if (objc == 3) {
+ pattern = TclGetString(objv[2]);
}
listPtr = Tcl_NewListObj(0, NULL);
if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
Tcl_Obj *valuePtr = NULL;
- Tcl_DictObjGet(interp, objv[2], objv[3], &valuePtr);
+
+ Tcl_DictObjGet(interp, objv[1], objv[2], &valuePtr);
if (valuePtr != NULL) {
- Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
+ Tcl_ListObjAppendElement(NULL, listPtr, objv[2]);
}
- goto searchDone;
- }
- for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {
- if (pattern==NULL || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {
- /*
- * Assume this operation always succeeds.
- */
- Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
+ } else {
+ Tcl_DictSearch search;
+ Tcl_Obj *keyPtr = NULL;
+ int done = 0;
+
+ /*
+ * At this point, we know we have a dictionary (or at least something
+ * that can be represented; it could theoretically have shimmered away
+ * when the pattern was fetched, but that shouldn't be damaging) so we
+ * can start the iteration process without checking for failures.
+ */
+
+ Tcl_DictObjFirst(NULL, objv[1], &search, &keyPtr, NULL, &done);
+ for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {
+ if (!pattern || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {
+ Tcl_ListObjAppendElement(NULL, listPtr, keyPtr);
+ }
}
+ Tcl_DictObjDone(&search);
}
-searchDone:
+
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1667,9 +1884,9 @@ searchDone:
*
* DictValuesCmd --
*
- * This function implements the "dict values" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict values" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1681,27 +1898,30 @@ searchDone:
*/
static int
-DictValuesCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictValuesCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Tcl_Obj *valuePtr, *listPtr;
+ Tcl_Obj *valuePtr = NULL, *listPtr;
Tcl_DictSearch search;
- int result, done;
- char *pattern = NULL;
+ int done;
+ const char *pattern;
- if (objc!=3 && objc!=4) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?");
+ if (objc!=2 && objc!=3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
return TCL_ERROR;
}
- result= Tcl_DictObjFirst(interp, objv[2], &search, NULL, &valuePtr, &done);
- if (result != TCL_OK) {
+ if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr,
+ &done) != TCL_OK) {
return TCL_ERROR;
}
- if (objc == 4) {
- pattern = TclGetString(objv[3]);
+ if (objc == 3) {
+ pattern = TclGetString(objv[2]);
+ } else {
+ pattern = NULL;
}
listPtr = Tcl_NewListObj(0, NULL);
for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
@@ -1709,9 +1929,12 @@ DictValuesCmd(interp, objc, objv)
/*
* Assume this operation always succeeds.
*/
+
Tcl_ListObjAppendElement(interp, listPtr, valuePtr);
}
}
+ Tcl_DictObjDone(&search);
+
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1721,9 +1944,9 @@ DictValuesCmd(interp, objc, objv)
*
* DictSizeCmd --
*
- * This function implements the "dict size" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict size" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1735,18 +1958,19 @@ DictValuesCmd(interp, objc, objv)
*/
static int
-DictSizeCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictSizeCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
int result, size;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
return TCL_ERROR;
}
- result = Tcl_DictObjSize(interp, objv[2], &size);
+ result = Tcl_DictObjSize(interp, objv[1], &size);
if (result == TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
}
@@ -1758,9 +1982,9 @@ DictSizeCmd(interp, objc, objv)
*
* DictExistsCmd --
*
- * This function implements the "dict exists" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict exists" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1772,33 +1996,28 @@ DictSizeCmd(interp, objc, objv)
*/
static int
-DictExistsCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictExistsCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
- int result;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary key ?key ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
return TCL_ERROR;
}
- dictPtr = TclTraceDictPath(interp, objv[2], objc-4, objv+3,
+ 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;
}
@@ -1807,9 +2026,9 @@ DictExistsCmd(interp, objc, objv)
*
* DictInfoCmd --
*
- * This function implements the "dict info" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict info" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1821,31 +2040,33 @@ DictExistsCmd(interp, objc, objv)
*/
static int
-DictInfoCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictInfoCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Dict *dict;
+ char *statsStr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
return TCL_ERROR;
}
- dictPtr = objv[2];
+ dictPtr = objv[1];
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
if (result != TCL_OK) {
return result;
}
}
- dict = (Dict *)dictPtr->internalRep.otherValuePtr;
- /*
- * This next cast is actually OK.
- */
- Tcl_SetResult(interp, (char *)Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+
+ statsStr = Tcl_HashStats(&dict->table);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
+ ckfree(statsStr);
return TCL_OK;
}
@@ -1854,9 +2075,9 @@ DictInfoCmd(interp, objc, objv)
*
* DictIncrCmd --
*
- * This function implements the "dict incr" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict incr" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1868,178 +2089,106 @@ DictInfoCmd(interp, objc, objv)
*/
static int
-DictIncrCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictIncrCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
- int result, isWide = 0;
- long incrValue = 1;
- Tcl_WideInt wideIncrValue = 0;
- int allocatedDict = 0;
+ int code = TCL_OK;
+ Tcl_Obj *dictPtr, *valuePtr = NULL;
- if (objc < 4 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?");
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
return TCL_ERROR;
}
- if (objc == 5) {
- if (objv[4]->typePtr == &tclIntType) {
- incrValue = objv[4]->internalRep.longValue;
- } else if (objv[4]->typePtr == &tclWideIntType) {
- wideIncrValue = objv[4]->internalRep.wideValue;
- isWide = 1;
- } else {
- result = Tcl_GetWideIntFromObj(interp, objv[4], &wideIncrValue);
- if (result != TCL_OK) {
- return result;
- }
- if (wideIncrValue <= Tcl_LongAsWide(LONG_MAX)
- && wideIncrValue >= Tcl_LongAsWide(LONG_MIN)) {
- incrValue = Tcl_WideAsLong(wideIncrValue);
- objv[4]->typePtr = &tclIntType;
- } else {
- isWide = 1;
- }
- }
- }
-
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
- allocatedDict = 1;
+ /*
+ * Variable didn't yet exist. Create new dictionary value.
+ */
+
dictPtr = Tcl_NewDictObj();
- if (isWide) {
- valuePtr = Tcl_NewWideIntObj(wideIncrValue);
+ } else if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
+ /*
+ * Variable contents are not a dict, report error.
+ */
+
+ return TCL_ERROR;
+ }
+ if (Tcl_IsShared(dictPtr)) {
+ /*
+ * A little internals surgery to avoid copying a string rep that will
+ * soon be no good.
+ */
+
+ char *saved = dictPtr->bytes;
+ Tcl_Obj *oldPtr = dictPtr;
+
+ dictPtr->bytes = NULL;
+ dictPtr = Tcl_DuplicateObj(dictPtr);
+ oldPtr->bytes = saved;
+ }
+ if (valuePtr == NULL) {
+ /*
+ * Key not in dictionary. Create new key with increment as value.
+ */
+
+ if (objc == 4) {
+ /*
+ * Verify increment is an integer.
+ */
+
+ mp_int increment;
+
+ code = Tcl_GetBignumFromObj(interp, objv[3], &increment);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ } else {
+ /*
+ * Remember to dispose with the bignum as we're not actually
+ * using it directly. [Bug 2874678]
+ */
+
+ mp_clear(&increment);
+ Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+ }
} else {
- valuePtr = Tcl_NewLongObj(incrValue);
+ Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
}
- Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
} else {
- long lValue;
- Tcl_WideInt wValue;
+ /*
+ * Key in dictionary. Increment its value with minimum dup.
+ */
- if (Tcl_IsShared(dictPtr)) {
- allocatedDict = 1;
- dictPtr = Tcl_DuplicateObj(dictPtr);
+ if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
+ Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
}
+ if (objc == 4) {
+ code = TclIncrObj(interp, valuePtr, objv[3]);
+ } else {
+ Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
- if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
+ Tcl_IncrRefCount(incrPtr);
+ code = TclIncrObj(interp, valuePtr, incrPtr);
+ Tcl_DecrRefCount(incrPtr);
}
+ }
+ if (code == TCL_OK) {
+ TclInvalidateStringRep(dictPtr);
+ valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
+ dictPtr, TCL_LEAVE_ERR_MSG);
if (valuePtr == NULL) {
- if (isWide) {
- valuePtr = Tcl_NewWideIntObj(wideIncrValue);
- } else {
- valuePtr = Tcl_NewLongObj(incrValue);
- }
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_GetWideIntFromObj(NULL, valuePtr, &wValue);
- if (Tcl_IsShared(valuePtr)) {
- if (isWide) {
- valuePtr = Tcl_NewWideIntObj(wValue + wideIncrValue);
- } else {
- valuePtr = Tcl_NewWideIntObj(wValue + incrValue);
- }
- } else {
- if (isWide) {
- Tcl_SetWideIntObj(valuePtr, wValue + wideIncrValue);
- } else {
- Tcl_SetWideIntObj(valuePtr, wValue + incrValue);
- }
- if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
- }
- goto valueAlreadyInDictionary;
- }
- } else if (valuePtr->typePtr == &tclIntType) {
- Tcl_GetLongFromObj(NULL, valuePtr, &lValue);
- if (Tcl_IsShared(valuePtr)) {
- if (isWide) {
- valuePtr = Tcl_NewWideIntObj(lValue + wideIncrValue);
- } else {
- valuePtr = Tcl_NewLongObj(lValue + incrValue);
- }
- } else {
- if (isWide) {
- Tcl_SetWideIntObj(valuePtr, lValue + wideIncrValue);
- } else {
- Tcl_SetLongObj(valuePtr, lValue + incrValue);
- }
- if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
- }
- goto valueAlreadyInDictionary;
- }
+ code = TCL_ERROR;
} else {
- /*
- * Note that these operations on wide ints should work
- * fine where they are the same as normal longs, though
- * the compiler might complain about trivially satisifed
- * tests.
- */
- result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return result;
- }
- /*
- * Determine if we should have got a standard long instead.
- */
- if (Tcl_IsShared(valuePtr)) {
- if (isWide) {
- valuePtr = Tcl_NewWideIntObj(wValue + wideIncrValue);
- } else if (wValue >= LONG_MIN && wValue <= LONG_MAX) {
- /*
- * Convert the type...
- */
- Tcl_GetLongFromObj(NULL, valuePtr, &lValue);
- valuePtr = Tcl_NewLongObj(lValue + incrValue);
- } else {
- valuePtr = Tcl_NewWideIntObj(wValue + incrValue);
- }
- } else {
- if (isWide) {
- Tcl_SetWideIntObj(valuePtr, wValue + wideIncrValue);
- } else if (wValue >= LONG_MIN && wValue <= LONG_MAX) {
- Tcl_SetLongObj(valuePtr,
- Tcl_WideAsLong(wValue) + incrValue);
- } else {
- Tcl_SetWideIntObj(valuePtr, wValue + incrValue);
- }
- if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
- }
- goto valueAlreadyInDictionary;
- }
+ Tcl_SetObjResult(interp, valuePtr);
}
- if (Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr) != TCL_OK) {
- /*
- * This shouldn't happen since dictPtr is known
- * from above to be a valid dictionary.
- */
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- TclDecrRefCount(valuePtr);
- return TCL_ERROR;
- }
- }
- valueAlreadyInDictionary:
- Tcl_IncrRefCount(dictPtr);
- resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
- TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(dictPtr);
- if (resultPtr == NULL) {
- return TCL_ERROR;
+ } else if (dictPtr->refCount == 0) {
+ Tcl_DecrRefCount(dictPtr);
}
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_OK;
+ return code;
}
/*
@@ -2047,9 +2196,9 @@ DictIncrCmd(interp, objc, objv)
*
* DictLappendCmd --
*
- * This function implements the "dict lappend" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict lappend" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2061,20 +2210,21 @@ DictIncrCmd(interp, objc, objv)
*/
static int
-DictLappendCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictLappendCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0, allocatedValue = 0;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
return TCL_ERROR;
}
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
allocatedDict = 1;
dictPtr = Tcl_NewDictObj();
@@ -2083,7 +2233,7 @@ DictLappendCmd(interp, objc, objv)
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {
+ if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
if (allocatedDict) {
TclDecrRefCount(dictPtr);
}
@@ -2091,7 +2241,7 @@ DictLappendCmd(interp, objc, objv)
}
if (valuePtr == NULL) {
- valuePtr = Tcl_NewListObj(objc-4, objv+4);
+ valuePtr = Tcl_NewListObj(objc-3, objv+3);
allocatedValue = 1;
} else {
if (Tcl_IsShared(valuePtr)) {
@@ -2099,7 +2249,7 @@ DictLappendCmd(interp, objc, objv)
valuePtr = Tcl_DuplicateObj(valuePtr);
}
- for (i=4 ; i<objc ; i++) {
+ for (i=3 ; i<objc ; i++) {
if (Tcl_ListObjAppendElement(interp, valuePtr,
objv[i]) != TCL_OK) {
if (allocatedValue) {
@@ -2114,15 +2264,13 @@ DictLappendCmd(interp, objc, objv)
}
if (allocatedValue) {
- Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
+ Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
} else if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- Tcl_IncrRefCount(dictPtr);
- resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
+ resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(dictPtr);
if (resultPtr == NULL) {
return TCL_ERROR;
}
@@ -2135,9 +2283,9 @@ DictLappendCmd(interp, objc, objv)
*
* DictAppendCmd --
*
- * This function implements the "dict append" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict append" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2149,20 +2297,21 @@ DictLappendCmd(interp, objc, objv)
*/
static int
-DictAppendCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictAppendCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
return TCL_ERROR;
}
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
allocatedDict = 1;
dictPtr = Tcl_NewDictObj();
@@ -2171,7 +2320,7 @@ DictAppendCmd(interp, objc, objv)
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {
+ if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
if (allocatedDict) {
TclDecrRefCount(dictPtr);
}
@@ -2186,16 +2335,14 @@ DictAppendCmd(interp, objc, objv)
}
}
- for (i=4 ; i<objc ; i++) {
+ for (i=3 ; i<objc ; i++) {
Tcl_AppendObjToObj(valuePtr, objv[i]);
}
- Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
+ Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
- Tcl_IncrRefCount(dictPtr);
- resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
+ resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(dictPtr);
if (resultPtr == NULL) {
return TCL_ERROR;
}
@@ -2206,11 +2353,11 @@ DictAppendCmd(interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * DictForCmd --
+ * DictForNRCmd --
*
- * This function implements the "dict for" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * 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.
*
* Results:
* A standard Tcl result.
@@ -2222,23 +2369,29 @@ DictAppendCmd(interp, objc, objv)
*/
static int
-DictForCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictForNRCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
+ Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
- Tcl_DictSearch search;
- int varc, done, result;
+ Tcl_DictSearch *searchPtr;
+ int varc, done;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv,
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
"{keyVar valueVar} dictionary script");
return TCL_ERROR;
}
- if (Tcl_ListObjGetElements(interp, objv[2], &varc, &varv) != TCL_OK) {
+ /*
+ * Parse arguments.
+ */
+
+ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
@@ -2246,75 +2399,357 @@ DictForCmd(interp, objc, objv)
"must have exactly two variable names", -1));
return TCL_ERROR;
}
+ searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
+ if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
+ &done) != TCL_OK) {
+ TclStackFree(interp, searchPtr);
+ return TCL_ERROR;
+ }
+ if (done) {
+ TclStackFree(interp, searchPtr);
+ return TCL_OK;
+ }
+ TclListObjGetElements(NULL, objv[1], &varc, &varv);
keyVarObj = varv[0];
valueVarObj = varv[1];
- scriptObj = objv[4];
+ 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
+ * loop) don't vanish. Note that the dictionary internal rep is locked
* internally so that updates, shimmering, etc are not a problem.
*/
+
Tcl_IncrRefCount(keyVarObj);
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- result = Tcl_DictObjFirst(interp, objv[3],
- &search, &keyObj, &valueObj, &done);
- if (result != TCL_OK) {
- goto doneFor;
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
+
+ Tcl_IncrRefCount(valueObj);
+ 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, TCL_LEAVE_ERR_MSG) == NULL) {
+ goto error;
}
- while (!done) {
- /*
- * Stop the value from getting hit in any way by any traces on
- * the key variable.
- */
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything on error.
+ */
+
+ error:
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
+ return TCL_ERROR;
+}
+
+static int
+DictForLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_DictSearch *searchPtr = data[0];
+ Tcl_Obj *keyVarObj = data[1];
+ Tcl_Obj *valueVarObj = data[2];
+ Tcl_Obj *scriptObj = data[3];
+ 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);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", (char *) NULL);
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- goto doneFor;
+ result = TCL_OK;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"dict for\" body line %d)",
+ Tcl_GetErrorLine(interp)));
}
+ goto done;
+ }
+
+ /*
+ * Get the next mapping from the dictionary.
+ */
+
+ Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
+ if (done) {
+ Tcl_ResetResult(interp);
+ 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, keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ goto done;
+ }
+ TclDecrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ done:
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ 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);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", (char *) NULL);
+ 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 doneFor;
+ goto done;
}
+ Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj,
+ Tcl_GetObjResult(interp));
+ }
- result = Tcl_EvalObjEx(interp, scriptObj, 0);
- if (result == TCL_CONTINUE) {
- result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
- result = TCL_OK;
- } else if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,
- "\n (\"dict for\" body line %d)", interp->errorLine);
- }
- break;
- }
+ /*
+ * Get the next mapping from the dictionary.
+ */
- Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done);
+ if (done) {
+ Tcl_SetObjResult(interp, storagePtr->accumulatorObj);
+ goto done;
}
- doneFor:
/*
- * Stop holding a reference to these objects.
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
*/
- TclDecrRefCount(keyVarObj);
- TclDecrRefCount(valueVarObj);
- TclDecrRefCount(scriptObj);
- Tcl_DictObjDone(&search);
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
+ 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;
}
@@ -2323,9 +2758,9 @@ DictForCmd(interp, objc, objv)
*
* DictSetCmd --
*
- * This function implements the "dict set" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict set" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2337,20 +2772,21 @@ DictForCmd(interp, objc, objv)
*/
static int
-DictSetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictSetCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
- if (objc < 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...? value");
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
return TCL_ERROR;
}
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
allocatedDict = 1;
dictPtr = Tcl_NewDictObj();
@@ -2359,7 +2795,7 @@ DictSetCmd(interp, objc, objv)
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-4, objv+3,
+ result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-3, objv+2,
objv[objc-1]);
if (result != TCL_OK) {
if (allocatedDict) {
@@ -2368,10 +2804,8 @@ DictSetCmd(interp, objc, objv)
return TCL_ERROR;
}
- Tcl_IncrRefCount(dictPtr);
- resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
+ resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(dictPtr);
if (resultPtr == NULL) {
return TCL_ERROR;
}
@@ -2384,9 +2818,9 @@ DictSetCmd(interp, objc, objv)
*
* DictUnsetCmd --
*
- * This function implements the "dict unset" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict unset" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2398,20 +2832,21 @@ DictSetCmd(interp, objc, objv)
*/
static int
-DictUnsetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictUnsetCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
return TCL_ERROR;
}
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
allocatedDict = 1;
dictPtr = Tcl_NewDictObj();
@@ -2420,7 +2855,7 @@ DictUnsetCmd(interp, objc, objv)
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-3, objv+3);
+ result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-2, objv+2);
if (result != TCL_OK) {
if (allocatedDict) {
TclDecrRefCount(dictPtr);
@@ -2428,10 +2863,8 @@ DictUnsetCmd(interp, objc, objv)
return TCL_ERROR;
}
- Tcl_IncrRefCount(dictPtr);
- resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
+ resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
- TclDecrRefCount(dictPtr);
if (resultPtr == NULL) {
return TCL_ERROR;
}
@@ -2444,9 +2877,9 @@ DictUnsetCmd(interp, objc, objv)
*
* DictFilterCmd --
*
- * This function implements the "dict filter" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict filter" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2458,57 +2891,90 @@ DictUnsetCmd(interp, objc, objv)
*/
static int
-DictFilterCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictFilterCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- static CONST char *filters[] = {
+ Interp *iPtr = (Interp *) interp;
+ static const char *const filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
};
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
- Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
+ Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
Tcl_DictSearch search;
int index, varc, done, result, satisfied;
- char *pattern;
+ const char *pattern;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary filterType ...");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[3], filters, "filterType",
+ if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum FilterTypes) index) {
case FILTER_KEYS:
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary key globPattern");
- return TCL_ERROR;
- }
-
/*
* Create a dictionary whose keys all match a certain pattern.
*/
- if (Tcl_DictObjFirst(interp, objv[2], &search,
+
+ if (Tcl_DictObjFirst(interp, objv[1], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
- pattern = TclGetString(objv[4]);
- resultObj = Tcl_NewDictObj();
- if (TclMatchIsTrivial(pattern)) {
- Tcl_DictObjGet(interp, objv[2], objv[4], &valueObj);
- if (valueObj != NULL) {
- Tcl_DictObjPut(interp, resultObj, objv[4], valueObj);
+ if (objc == 3) {
+ /*
+ * Nothing to match, so return nothing (== empty dictionary).
+ */
+
+ Tcl_DictObjDone(&search);
+ return TCL_OK;
+ } else if (objc == 4) {
+ pattern = TclGetString(objv[3]);
+ resultObj = Tcl_NewDictObj();
+ if (TclMatchIsTrivial(pattern)) {
+ /*
+ * Must release the search lock here to prevent a memory leak
+ * since we are not exhausing the search. [Bug 1705778, leak
+ * K05]
+ */
+
+ Tcl_DictObjDone(&search);
+ Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
+ if (valueObj != NULL) {
+ Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+ }
+ } else {
+ while (!done) {
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ }
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ }
}
} else {
+ /*
+ * Can't optimize this match for trivial globbing: would disturb
+ * order.
+ */
+
+ resultObj = Tcl_NewDictObj();
while (!done) {
- if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ int i;
+
+ for (i=3 ; i<objc ; i++) {
+ pattern = TclGetString(objv[i]);
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ break; /* stop inner loop */
+ }
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2517,23 +2983,24 @@ DictFilterCmd(interp, objc, objv)
return TCL_OK;
case FILTER_VALUES:
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictionary value globPattern");
- return TCL_ERROR;
- }
-
/*
* Create a dictionary whose values all match a certain pattern.
*/
- if (Tcl_DictObjFirst(interp, objv[2], &search,
+
+ if (Tcl_DictObjFirst(interp, objv[1], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
- pattern = TclGetString(objv[4]);
resultObj = Tcl_NewDictObj();
while (!done) {
- if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ int i;
+
+ for (i=3 ; i<objc ; i++) {
+ pattern = TclGetString(objv[i]);
+ if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ break; /* stop inner loop */
+ }
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2541,20 +3008,19 @@ DictFilterCmd(interp, objc, objv)
return TCL_OK;
case FILTER_SCRIPT:
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 2, objv,
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
"dictionary script {keyVar valueVar} filterScript");
return TCL_ERROR;
}
/*
- * Create a dictionary whose key,value pairs all satisfy a
- * script (i.e. get a true boolean result from its
- * evaluation.) Massive copying from the "dict for"
- * implementation has occurred!
+ * Create a dictionary whose key,value pairs all satisfy a script
+ * (i.e. get a true boolean result from its evaluation). Massive
+ * copying from the "dict for" implementation has occurred!
*/
- if (Tcl_ListObjGetElements(interp, objv[4], &varc, &varv) != TCL_OK) {
+ if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
@@ -2564,18 +3030,20 @@ DictFilterCmd(interp, objc, objv)
}
keyVarObj = varv[0];
valueVarObj = varv[1];
- scriptObj = objv[5];
+ scriptObj = objv[4];
+
/*
* Make sure that these objects (which we need throughout the body of
- * the loop) don't vanish. Note that the dictionary internal rep is
+ * 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(keyVarObj);
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- result = Tcl_DictObjFirst(interp, objv[2],
+ result = Tcl_DictObjFirst(interp, objv[1],
&search, &keyObj, &valueObj, &done);
if (result != TCL_OK) {
TclDecrRefCount(keyVarObj);
@@ -2588,28 +3056,36 @@ DictFilterCmd(interp, objc, objv)
while (!done) {
/*
- * Stop the value from getting hit in any way by any
- * traces on the key variable.
+ * Stop the value from getting hit in any way by any traces on the
+ * key variable.
*/
+
Tcl_IncrRefCount(keyObj);
Tcl_IncrRefCount(valueObj);
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), "\"", (char *) 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), "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set value variable: \"%s\"",
+ TclGetString(valueVarObj)));
+ result = TCL_ERROR;
goto abnormalResult;
}
- result = Tcl_EvalObjEx(interp, scriptObj, 0);
+ /*
+ * TIP #280. Make invoking context available to loop body.
+ */
+
+ result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4);
switch (result) {
case TCL_OK:
boolObj = Tcl_GetObjResult(interp);
@@ -2632,15 +3108,16 @@ DictFilterCmd(interp, objc, objv)
* makes the next Tcl_DictObjNext say there is nothing more to
* do.
*/
+
Tcl_ResetResult(interp);
Tcl_DictObjDone(&search);
case TCL_CONTINUE:
result = TCL_OK;
break;
case TCL_ERROR:
- TclFormatToErrorInfo(interp,
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
- interp->errorLine);
+ Tcl_GetErrorLine(interp)));
default:
goto abnormalResult;
}
@@ -2654,6 +3131,7 @@ DictFilterCmd(interp, objc, objv)
/*
* Stop holding a reference to these objects.
*/
+
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
@@ -2665,6 +3143,7 @@ DictFilterCmd(interp, objc, objv)
TclDecrRefCount(resultObj);
}
return result;
+
abnormalResult:
Tcl_DictObjDone(&search);
TclDecrRefCount(keyObj);
@@ -2685,9 +3164,9 @@ DictFilterCmd(interp, objc, objv)
*
* DictUpdateCmd --
*
- * This function implements the "dict update" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#212 for the formal specification.
+ * This function implements the "dict update" Tcl command. See the user
+ * documentation for details on what it does, and TIP#212 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2699,22 +3178,23 @@ DictFilterCmd(interp, objc, objv)
*/
static int
-DictUpdateCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictUpdateCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
+ Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
- int i, result, dummy, allocdict = 0;
- Tcl_InterpState state;
+ int i, dummy;
- if (objc < 6 || objc & 1) {
- Tcl_WrongNumArgs(interp, 2, objv,
+ if (objc < 5 || !(objc & 1)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
"varName key varName ?key varName ...? script");
return TCL_ERROR;
}
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (dictPtr == NULL) {
return TCL_ERROR;
}
@@ -2722,7 +3202,7 @@ DictUpdateCmd(interp, objc, objv)
return TCL_ERROR;
}
Tcl_IncrRefCount(dictPtr);
- for (i=3 ; i+2<objc ; i+=2) {
+ for (i=2 ; i+2<objc ; i+=2) {
if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) {
TclDecrRefCount(dictPtr);
return TCL_ERROR;
@@ -2739,21 +3219,46 @@ DictUpdateCmd(interp, objc, objv)
TclDecrRefCount(dictPtr);
/*
- * Execute the body.
+ * Execute the body after setting up the NRE handler to process the
+ * results.
+ */
+
+ objPtr = Tcl_NewListObj(objc-3, objv+2);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_IncrRefCount(objv[1]);
+ TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+
+ return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+}
+
+static int
+FinalizeDictUpdate(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *dictPtr, *objPtr, **objv;
+ Tcl_InterpState state;
+ int i, objc;
+ Tcl_Obj *varName = data[0];
+ Tcl_Obj *argsObj = data[1];
+
+ /*
+ * ErrorInfo handling.
*/
- result = Tcl_EvalObj(interp, objv[objc-1]);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")");
}
/*
- * If the dictionary variable doesn't exist, drop everything
- * silently.
+ * If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
if (dictPtr == NULL) {
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return result;
}
@@ -2762,44 +3267,54 @@ DictUpdateCmd(interp, objc, objv)
*/
state = Tcl_SaveInterpState(interp, result);
- if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+ if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
Tcl_DiscardInterpState(state);
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- allocdict = 1;
}
/*
- * Write back the values from the variables, treating failure to
- * read as an instruction to remove the key.
+ * Write back the values from the variables, treating failure to read as
+ * an instruction to remove the key.
*/
- for (i=3 ; i+2<objc ; i+=2) {
+ Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
+ for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+ } else if (objPtr == dictPtr) {
+ /*
+ * Someone is messing us around, trying to build a recursive
+ * structure. [Bug 1786481]
+ */
+
+ Tcl_DictObjPut(interp, dictPtr, objv[i],
+ Tcl_DuplicateObj(objPtr));
} else {
/* Shouldn't fail */
Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
}
}
+ TclDecrRefCount(argsObj);
/*
* Write the dictionary back to its variable.
*/
- if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
- if (allocdict) {
- TclDecrRefCount(dictPtr);
- }
+ TclDecrRefCount(varName);
return TCL_ERROR;
}
+ TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}
@@ -2808,9 +3323,9 @@ DictUpdateCmd(interp, objc, objv)
*
* DictWithCmd --
*
- * This function implements the "dict with" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#212 for the formal specification.
+ * This function implements the "dict with" Tcl command. See the user
+ * documentation for details on what it does, and TIP#212 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2822,18 +3337,17 @@ DictUpdateCmd(interp, objc, objv)
*/
static int
-DictWithCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictWithCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
- Tcl_DictSearch s;
- Tcl_InterpState state;
- int done, result, keyc, i, allocdict=0;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "dictVar ?key ...? script");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
return TCL_ERROR;
}
@@ -2841,32 +3355,146 @@ DictWithCmd(interp, objc, objv)
* Get the dictionary to open out.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (dictPtr == NULL) {
return TCL_ERROR;
}
- if (objc > 4) {
- dictPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3,
+
+ keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
+ if (keysPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(keysPtr);
+
+ /*
+ * Execute the body, while making the invoking context available to the
+ * loop body (TIP#280) and postponing the cleanup until later (NRE).
+ */
+
+ pathPtr = NULL;
+ if (objc > 3) {
+ pathPtr = Tcl_NewListObj(objc-3, objv+2);
+ Tcl_IncrRefCount(pathPtr);
+ }
+ Tcl_IncrRefCount(objv[1]);
+ TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
+ NULL);
+
+ return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+}
+
+static int
+FinalizeDictWith(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ 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 TCL_ERROR;
+ 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.
+ * 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 TCL_ERROR;
+ return NULL;
}
TclNewObj(keysPtr);
- Tcl_IncrRefCount(keysPtr);
for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
@@ -2874,72 +3502,109 @@ DictWithCmd(interp, objc, objv)
TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(keysPtr);
Tcl_DictObjDone(&s);
- return TCL_ERROR;
+ return NULL;
}
}
- /*
- * Execute the body.
- */
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- result = Tcl_EvalObjEx(interp, objv[objc-1], 0);
- if (result == TCL_ERROR) {
- Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
- }
+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.
+ * If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, index);
if (dictPtr == NULL) {
- TclDecrRefCount(keysPtr);
- 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(keysPtr);
- Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
allocdict = 1;
+ } else {
+ allocdict = 0;
}
- if (objc > 4) {
+ 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 an error on a non-existant path (we'll treat
- * that the same as a non-existant variable. Luckily, the
- * de-sharing operation isn't deeply damaging if we don't go
- * on to update; it's just less than perfectly efficient (but
- * no memory should be leaked).
+ * Want to get to the dictionary which we will update; need to do
+ * prepare-for-update de-sharing along the path *but* avoid generating
+ * an error on a non-existant path (we'll treat that the same as a
+ * non-existant variable. Luckily, the de-sharing operation isn't
+ * deeply damaging if we don't go on to update; it's just less than
+ * perfectly efficient (but no memory should be leaked).
*/
- leafPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3,
+
+ leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
if (leafPtr == NULL) {
- TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
- TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- return Tcl_RestoreInterpState(interp, state);
+ return TCL_OK;
}
} else {
leafPtr = dictPtr;
@@ -2949,23 +3614,29 @@ DictWithCmd(interp, objc, objv)
* Now process our updates on the leaf dictionary.
*/
- Tcl_ListObjGetElements(NULL, keysPtr, &keyc, &keyv);
+ TclListObjGetElements(NULL, keysPtr, &keyc, &keyv);
for (i=0 ; i<keyc ; i++) {
valPtr = Tcl_ObjGetVar2(interp, keyv[i], NULL, 0);
if (valPtr == NULL) {
Tcl_DictObjRemove(NULL, leafPtr, keyv[i]);
+ } else if (leafPtr == valPtr) {
+ /*
+ * Someone is messing us around, trying to build a recursive
+ * structure. [Bug 1786481]
+ */
+
+ Tcl_DictObjPut(NULL, leafPtr, keyv[i], Tcl_DuplicateObj(valPtr));
} else {
Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
}
}
- TclDecrRefCount(keysPtr);
/*
- * Ensure that none of the dictionaries in the chain still have a
- * string rep.
+ * Ensure that none of the dictionaries in the chain still have a string
+ * rep.
*/
- if (objc > 4) {
+ if (pathc > 0) {
InvalidateDictChain(leafPtr);
}
@@ -2973,88 +3644,45 @@ DictWithCmd(interp, objc, objv)
* Write back the outermost dictionary to the variable.
*/
- if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
+ TCL_LEAVE_ERR_MSG, index) == NULL) {
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
- return Tcl_RestoreInterpState(interp, state);
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_DictObjCmd --
+ * TclInitDictCmd --
*
- * This function is invoked to process the "dict" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function is create the "dict" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
- * A standard Tcl result.
+ * A Tcl command handle.
*
* Side effects:
- * See the user documentation.
+ * May advance compilation epoch.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+Tcl_Command
+TclInitDictCmd(
+ Tcl_Interp *interp)
{
- static CONST char *subcommands[] = {
- "append", "create", "exists", "filter", "for",
- "get", "incr", "info", "keys", "lappend", "merge",
- "remove", "replace", "set", "size", "unset",
- "update", "values", "with", NULL
- };
- enum DictSubcommands {
- DICT_APPEND, DICT_CREATE, DICT_EXISTS, DICT_FILTER, DICT_FOR,
- DICT_GET, DICT_INCR, DICT_INFO, DICT_KEYS, DICT_LAPPEND, DICT_MERGE,
- DICT_REMOVE, DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET,
- DICT_UPDATE, DICT_VALUES, DICT_WITH
- };
- int index;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum DictSubcommands) index) {
- case DICT_APPEND: return DictAppendCmd(interp, objc, objv);
- case DICT_CREATE: return DictCreateCmd(interp, objc, objv);
- case DICT_EXISTS: return DictExistsCmd(interp, objc, objv);
- case DICT_FILTER: return DictFilterCmd(interp, objc, objv);
- case DICT_FOR: return DictForCmd(interp, objc, objv);
- case DICT_GET: return DictGetCmd(interp, objc, objv);
- case DICT_INCR: return DictIncrCmd(interp, objc, objv);
- case DICT_INFO: return DictInfoCmd(interp, objc, objv);
- case DICT_KEYS: return DictKeysCmd(interp, objc, objv);
- case DICT_LAPPEND: return DictLappendCmd(interp, objc, objv);
- case DICT_MERGE: return DictMergeCmd(interp, objc, objv);
- case DICT_REMOVE: return DictRemoveCmd(interp, objc, objv);
- case DICT_REPLACE: return DictReplaceCmd(interp, objc, objv);
- case DICT_SET: return DictSetCmd(interp, objc, objv);
- case DICT_SIZE: return DictSizeCmd(interp, objc, objv);
- case DICT_UNSET: return DictUnsetCmd(interp, objc, objv);
- case DICT_UPDATE: return DictUpdateCmd(interp, objc, objv);
- case DICT_VALUES: return DictValuesCmd(interp, objc, objv);
- case DICT_WITH: return DictWithCmd(interp, objc, objv);
- }
- Tcl_Panic("unexpected fallthrough!");
- /*
- * Next line is NOT REACHED - stops compliler complaint though...
- */
- return TCL_ERROR;
+ return TclMakeEnsemble(interp, "dict", implementationMap);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 8d2d1fd..d246cb2 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -5,15 +5,13 @@
*
* Copyright (c) 1996-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.
- *
- * RCS: @(#) $Id: tclEncoding.c,v 1.37 2005/09/02 19:23:46 andreas_kupries 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"
-typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
+typedef size_t (LengthProc)(const char *src);
/*
* The following data structure represents an encoding, which describes how to
@@ -21,28 +19,27 @@ typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
*/
typedef struct Encoding {
- char *name; /* Name of encoding. Malloced because (1)
- * hash table entry that owns this encoding
- * may be freed prior to this encoding being
- * freed, (2) string passed in the
- * Tcl_EncodingType structure may not be
- * persistent. */
+ char *name; /* Name of encoding. Malloced because (1) hash
+ * table entry that owns this encoding may be
+ * freed prior to this encoding being freed,
+ * (2) string passed in the Tcl_EncodingType
+ * structure may not be persistent. */
Tcl_EncodingConvertProc *toUtfProc;
- /* Procedure to convert from external encoding
+ /* Function to convert from external encoding
* into UTF-8. */
Tcl_EncodingConvertProc *fromUtfProc;
- /* Procedure to convert from UTF-8 into
+ /* Function to convert from UTF-8 into
* external encoding. */
Tcl_EncodingFreeProc *freeProc;
- /* If non-NULL, procedure to call when this
+ /* If non-NULL, function to call when this
* encoding is deleted. */
int nullSize; /* Number of 0x00 bytes that signify
- * end-of-string in this encoding. This
- * number is used to determine the source
- * string length when the srcLen argument is
- * negative. This number can be 1 or 2. */
+ * end-of-string in this encoding. This number
+ * is used to determine the source string
+ * length when the srcLen argument is
+ * negative. This number can be 1 or 2. */
ClientData clientData; /* Arbitrary value associated with encoding
- * type. Passed to conversion procedures. */
+ * type. Passed to conversion functions. */
LengthProc *lengthProc; /* Function to compute length of
* null-terminated strings in this encoding.
* If nullSize is 1, this is strlen; if
@@ -55,7 +52,7 @@ typedef struct Encoding {
/*
* The following structure is the clientData for a dynamically-loaded,
- * table-driven encoding created by LoadTableEncoding(). It maps between
+ * table-driven encoding created by LoadTableEncoding(). It maps between
* Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
* encoding.
*/
@@ -71,7 +68,7 @@ typedef struct TableEncodingData {
unsigned short **toUnicode; /* Two dimensional sparse matrix to map
* characters from the encoding to Unicode.
* Each element of the toUnicode array points
- * to an array of 256 shorts. If there is no
+ * to an array of 256 shorts. If there is no
* corresponding character in Unicode, the
* value in the matrix is 0x0000.
* malloc'd. */
@@ -79,7 +76,7 @@ typedef struct TableEncodingData {
/* Two dimensional sparse matrix to map
* characters from Unicode to the encoding.
* Each element of the fromUnicode array
- * points to an array of 256 shorts. If there
+ * points to an array of 256 shorts. If there
* is no corresponding character the encoding,
* the value in the matrix is 0x0000.
* malloc'd. */
@@ -89,13 +86,13 @@ typedef struct TableEncodingData {
* The following structures is the clientData for a dynamically-loaded,
* escape-driven encoding that is itself comprised of other simpler encodings.
* An example is "iso-2022-jp", which uses escape sequences to switch between
- * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
+ * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
* does not necessarily mean that the ESCAPE character is the character used
* for switching character sets.
*/
typedef struct EscapeSubTable {
- unsigned int sequenceLen; /* Length of following string. */
+ unsigned sequenceLen; /* Length of following string. */
char sequence[16]; /* Escape code that marks this encoding. */
char name[32]; /* Name for encoding. */
Encoding *encodingPtr; /* Encoding loaded using above name, or NULL
@@ -107,10 +104,10 @@ typedef struct EscapeEncodingData {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
- unsigned int initLen; /* Length of following string. */
+ unsigned initLen; /* Length of following string. */
char init[16]; /* String to emit or expect before first char
* in conversion. */
- unsigned int finalLen; /* Length of following string. */
+ unsigned finalLen; /* Length of following string. */
char final[16]; /* String to emit or expect after last char in
* conversion. */
char prefixBytes[256]; /* If a byte in the input stream is the first
@@ -120,8 +117,8 @@ typedef struct EscapeEncodingData {
* 0. */
int numSubTables; /* Length of following array. */
EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
- * by this encoding type. The actual size
- * will be as large as necessary to hold all
+ * by this encoding type. The actual size will
+ * be as large as necessary to hold all
* EscapeSubTables. */
} EscapeEncodingData;
@@ -136,8 +133,8 @@ typedef struct EscapeEncodingData {
#define ENCODING_ESCAPE 3
/*
- * A list of directories in which Tcl should look for *.enc files. This list
- * is shared by all threads. Access is governed by a mutex lock.
+ * A list of directories in which Tcl should look for *.enc files. This list
+ * is shared by all threads. Access is governed by a mutex lock.
*/
static TclInitProcessGlobalValueProc InitializeEncodingSearchPath;
@@ -147,8 +144,8 @@ static ProcessGlobalValue encodingSearchPath = {
/*
* A map from encoding names to the directories in which their data files have
- * been seen. The string value of the map is shared by all threads. Access
- * to the shared string is governed by a mutex lock.
+ * been seen. The string value of the map is shared by all threads. Access to
+ * the shared string is governed by a mutex lock.
*/
static ProcessGlobalValue encodingFileMap = {
@@ -156,9 +153,9 @@ static ProcessGlobalValue encodingFileMap = {
};
/*
- * A list of directories making up the "library path". Historically this
+ * A list of directories making up the "library path". Historically this
* search path has served many uses, but the only one remaining is a base for
- * the encodingSearchPath above. If the application does not explicitly set
+ * the encodingSearchPath above. If the application does not explicitly set
* the encodingSearchPath, then it will be initialized by appending /encoding
* to each directory in this "libraryPath".
*/
@@ -167,10 +164,10 @@ static ProcessGlobalValue libraryPath = {
0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL
};
-static int encodingsInitialized = 0;
+static int encodingsInitialized = 0;
/*
- * Hash table that keeps track of all loaded Encodings. Keys are the string
+ * Hash table that keeps track of all loaded Encodings. Keys are the string
* names that represent the encoding, values are (Encoding *).
*/
@@ -185,6 +182,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;
+Tcl_Encoding tclIdentityEncoding;
/*
* The following variable is used in the sparse matrix code for a
@@ -194,123 +192,130 @@ static Tcl_Encoding systemEncoding;
static unsigned short emptyPage[256];
/*
- * Procedures used only in this module.
+ * Functions used only in this module.
*/
-static int BinaryProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+static int BinaryProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *dupPtr));
-static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
-static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static void DupEncodingIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void EscapeFreeProc(ClientData clientData);
+static int EscapeFromUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int EscapeToUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static void FillEncodingFileMap ();
-static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
-static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static Encoding * GetTableEncoding _ANSI_ARGS_((
- EscapeEncodingData *dataPtr, int state));
-static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *name));
-static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((CONST char *name,
- int type, Tcl_Channel chan));
-static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
- Tcl_Channel chan));
-static Tcl_Channel OpenEncodingFileChannel _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *name));
-static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
-static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static void FillEncodingFileMap(void);
+static void FreeEncoding(Tcl_Encoding encoding);
+static void FreeEncodingIntRep(Tcl_Obj *objPtr);
+static Encoding * GetTableEncoding(EscapeEncodingData *dataPtr,
+ int state);
+static Tcl_Encoding LoadEncodingFile(Tcl_Interp *interp, const char *name);
+static Tcl_Encoding LoadTableEncoding(const char *name, int type,
+ Tcl_Channel chan);
+static Tcl_Encoding LoadEscapeEncoding(const char *name, Tcl_Channel chan);
+static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp,
+ const char *name);
+static void TableFreeProc(ClientData clientData);
+static int TableFromUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int TableToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int TableToUtfProc(ClientData clientData, const char *src,
+ int srcLen, int flags, Tcl_EncodingState *statePtr,
+ char *dst, int dstLen, int *srcReadPtr,
+ int *dstWrotePtr, int *dstCharsPtr);
+static size_t unilen(const char *src);
+static int UnicodeToUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static size_t unilen _ANSI_ARGS_((CONST char *src));
-static int UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int UtfToUnicodeProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int UtfToUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int UtfToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr, int pureNullMode);
+static int UtfIntToUtfExtProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr, int pureNullMode));
-static int UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int UtfExtToUtfIntProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int Iso88591FromUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
+ int *dstCharsPtr);
+static int Iso88591ToUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr);
/*
- * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep. This should
- * help the lifetime of encodings be more useful. See concerns raised in [Bug
- * 1077262].
+ * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
+ * of the intrep. This should help the lifetime of encodings be more useful.
+ * See concerns raised in [Bug 1077262].
*/
-static Tcl_ObjType EncodingType = {
+static const Tcl_ObjType encodingType = {
"encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
};
/*
*----------------------------------------------------------------------
*
- * TclGetEncodingFromObj --
+ * Tcl_GetEncodingFromObj --
*
* Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), if
- * possible, and returns TCL_OK. If no such encoding exists, TCL_ERROR
- * is returned, and if interp is non-NULL, an error message is written
+ * possible, and returns TCL_OK. If no such encoding exists, TCL_ERROR is
+ * returned, and if interp is non-NULL, an error message is written
* there.
*
* Results:
* Standard Tcl return code.
*
* Side effects:
- * Caches the Tcl_Encoding value as the internal rep of (*objPtr).
+ * Caches the Tcl_Encoding value as the internal rep of (*objPtr).
*
*----------------------------------------------------------------------
*/
int
-TclGetEncodingFromObj(interp, objPtr, encodingPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
- Tcl_Encoding *encodingPtr;
+Tcl_GetEncodingFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Encoding *encodingPtr)
{
- CONST char *name = Tcl_GetString(objPtr);
- if (objPtr->typePtr != &EncodingType) {
+ const char *name = Tcl_GetString(objPtr);
+
+ if (objPtr->typePtr != &encodingType) {
Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
return TCL_ERROR;
}
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = (VOID *) encoding;
- objPtr->typePtr = &EncodingType;
+ objPtr->internalRep.twoPtrValue.ptr1 = encoding;
+ objPtr->typePtr = &encodingType;
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
return TCL_OK;
@@ -327,10 +332,11 @@ TclGetEncodingFromObj(interp, objPtr, encodingPtr)
*/
static void
-FreeEncodingIntRep(objPtr)
- Tcl_Obj *objPtr;
+FreeEncodingIntRep(
+ Tcl_Obj *objPtr)
{
- Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
+ Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->typePtr = NULL;
}
/*
@@ -344,18 +350,17 @@ FreeEncodingIntRep(objPtr)
*/
static void
-DupEncodingIntRep(srcPtr, dupPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *dupPtr;
+DupEncodingIntRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
{
- dupPtr->internalRep.otherValuePtr = (VOID *)
- Tcl_GetEncoding(NULL, srcPtr->bytes);
+ dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
}
/*
*----------------------------------------------------------------------
*
- * TclGetEncodingSearchPath --
+ * Tcl_GetEncodingSearchPath --
*
* Keeps the per-thread copy of the encoding search path current with
* changes to the global copy.
@@ -367,14 +372,15 @@ DupEncodingIntRep(srcPtr, dupPtr)
*/
Tcl_Obj *
-TclGetEncodingSearchPath() {
+Tcl_GetEncodingSearchPath(void)
+{
return TclGetProcessGlobalValue(&encodingSearchPath);
}
/*
*----------------------------------------------------------------------
*
- * TclSetEncodingSearchPath --
+ * Tcl_SetEncodingSearchPath --
*
* Keeps the per-thread copy of the encoding search path current with
* changes to the global copy.
@@ -383,8 +389,8 @@ TclGetEncodingSearchPath() {
*/
int
-TclSetEncodingSearchPath(searchPath)
- Tcl_Obj *searchPath;
+Tcl_SetEncodingSearchPath(
+ Tcl_Obj *searchPath)
{
int dummy;
@@ -410,7 +416,8 @@ TclSetEncodingSearchPath(searchPath)
*/
Tcl_Obj *
-TclGetLibraryPath() {
+TclGetLibraryPath(void)
+{
return TclGetProcessGlobalValue(&libraryPath);
}
@@ -423,15 +430,15 @@ TclGetLibraryPath() {
* the global copy.
*
* NOTE: this routine returns void, so there's no way to report the error
- * that searchPath is not a valid list. In that case, this routine will
+ * that searchPath is not a valid list. In that case, this routine will
* silently do nothing.
*
*----------------------------------------------------------------------
*/
void
-TclSetLibraryPath(path)
- Tcl_Obj *path;
+TclSetLibraryPath(
+ Tcl_Obj *path)
{
int dummy;
@@ -446,8 +453,8 @@ TclSetLibraryPath(path)
*
* FillEncodingFileMap --
*
- * Called to bring the encoding file map in sync with the current value
- * of the encoding search path.
+ * Called to bring the encoding file map in sync with the current value
+ * of the encoding search path.
*
* Scan the directories on the encoding search path, find the *.enc
* files, and store the found pathnames in a map associated with the
@@ -468,12 +475,12 @@ TclSetLibraryPath(path)
*/
static void
-FillEncodingFileMap()
+FillEncodingFileMap(void)
{
int i, numDirs = 0;
Tcl_Obj *map, *searchPath;
- searchPath = TclGetEncodingSearchPath();
+ searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
Tcl_ListObjLength(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
@@ -500,12 +507,12 @@ FillEncodingFileMap()
Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev);
for (j=0; j<numFiles; j++) {
- Tcl_Obj *encodingName, *file;
+ Tcl_Obj *encodingName, *fileObj;
- file = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
- encodingName = TclPathPart(NULL, file, TCL_PATH_ROOT);
+ fileObj = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
+ encodingName = TclPathPart(NULL, fileObj, TCL_PATH_ROOT);
Tcl_DictObjPut(NULL, map, encodingName, directory);
- Tcl_DecrRefCount(file);
+ Tcl_DecrRefCount(fileObj);
Tcl_DecrRefCount(encodingName);
}
Tcl_DecrRefCount(matchFileList);
@@ -534,9 +541,12 @@ FillEncodingFileMap()
*/
void
-TclInitEncodingSubsystem()
+TclInitEncodingSubsystem(void)
{
Tcl_EncodingType type;
+ TableEncodingData *dataPtr;
+ unsigned size;
+ unsigned short i;
if (encodingsInitialized) {
return;
@@ -547,7 +557,7 @@ TclInitEncodingSubsystem()
Tcl_MutexUnlock(&encodingMutex);
/*
- * Create a few initial encodings. Note that the UTF-8 to UTF-8
+ * Create a few initial encodings. Note that the UTF-8 to UTF-8
* translation is not a no-op, because it will turn a stream of improperly
* formed UTF-8 into a properly formed stream.
*/
@@ -558,9 +568,7 @@ TclInitEncodingSubsystem()
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
-
- defaultEncoding = Tcl_CreateEncoding(&type);
- systemEncoding = Tcl_GetEncoding(NULL, type.encodingName);
+ tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfExtToUtfIntProc;
@@ -578,6 +586,44 @@ TclInitEncodingSubsystem()
type.clientData = NULL;
Tcl_CreateEncoding(&type);
+ /*
+ * Need the iso8859-1 encoding in order to process binary data, so force
+ * it to always be embedded. Note that this encoding *must* be a proper
+ * table encoding or some of the escape encodings crash! Hence the ugly
+ * code to duplicate the structure of a table encoding here.
+ */
+
+ dataPtr = ckalloc(sizeof(TableEncodingData));
+ memset(dataPtr, 0, sizeof(TableEncodingData));
+ dataPtr->fallback = '?';
+
+ size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
+ dataPtr->toUnicode = ckalloc(size);
+ memset(dataPtr->toUnicode, 0, size);
+ dataPtr->fromUnicode = ckalloc(size);
+ memset(dataPtr->fromUnicode, 0, size);
+
+ dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
+ dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
+ for (i=1 ; i<256 ; i++) {
+ dataPtr->toUnicode[i] = emptyPage;
+ dataPtr->fromUnicode[i] = emptyPage;
+ }
+
+ for (i=0 ; i<256 ; i++) {
+ dataPtr->toUnicode[0][i] = i;
+ dataPtr->fromUnicode[0][i] = i;
+ }
+
+ type.encodingName = "iso8859-1";
+ type.toUtfProc = Iso88591ToUtfProc;
+ type.fromUtfProc = Iso88591FromUtfProc;
+ type.freeProc = TableFreeProc;
+ type.nullSize = 1;
+ type.clientData = dataPtr;
+ defaultEncoding = Tcl_CreateEncoding(&type);
+ systemEncoding = Tcl_GetEncoding(NULL, type.encodingName);
+
encodingsInitialized = 1;
}
@@ -598,7 +644,7 @@ TclInitEncodingSubsystem()
*/
void
-TclFinalizeEncodingSubsystem()
+TclFinalizeEncodingSubsystem(void)
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
@@ -606,17 +652,18 @@ TclFinalizeEncodingSubsystem()
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
+ FreeEncoding(tclIdentityEncoding);
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
/*
* Call FreeEncoding instead of doing it directly to handle refcounts
- * like escape encodings use. [Bug #524674] Make sure to call
+ * like escape encodings use. [Bug 524674] Make sure to call
* Tcl_FirstHashEntry repeatedly so that all encodings are eventually
* cleaned up.
*/
- FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
+ FreeEncoding(Tcl_GetHashValue(hPtr));
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
}
@@ -629,24 +676,24 @@ TclFinalizeEncodingSubsystem()
*
* Tcl_GetDefaultEncodingDir --
*
- * Legacy public interface to retrieve first directory in the encoding
- * searchPath.
+ * Legacy public interface to retrieve first directory in the encoding
+ * searchPath.
*
* Results:
* The directory pathname, as a string, or NULL for an empty encoding
* search path.
*
* Side effects:
- * None.
+ * None.
*
*-------------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetDefaultEncodingDir()
+const char *
+Tcl_GetDefaultEncodingDir(void)
{
int numDirs;
- Tcl_Obj *first, *searchPath = TclGetEncodingSearchPath();
+ Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(NULL, searchPath, &numDirs);
if (numDirs == 0) {
@@ -662,28 +709,28 @@ Tcl_GetDefaultEncodingDir()
*
* Tcl_SetDefaultEncodingDir --
*
- * Legacy public interface to set the first directory in the encoding
- * search path.
+ * Legacy public interface to set the first directory in the encoding
+ * search path.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * Modifies the encoding search path.
+ * Modifies the encoding search path.
*
*-------------------------------------------------------------------------
*/
void
-Tcl_SetDefaultEncodingDir(path)
- CONST char *path;
+Tcl_SetDefaultEncodingDir(
+ const char *path)
{
- Tcl_Obj *searchPath = TclGetEncodingSearchPath();
+ Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
Tcl_Obj *directory = Tcl_NewStringObj(path, -1);
searchPath = Tcl_DuplicateObj(searchPath);
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
- TclSetEncodingSearchPath(searchPath);
+ Tcl_SetEncodingSearchPath(searchPath);
}
/*
@@ -692,19 +739,19 @@ Tcl_SetDefaultEncodingDir(path)
* Tcl_GetEncoding --
*
* Given the name of a encoding, find the corresponding Tcl_Encoding
- * token. If the encoding did not already exist, Tcl attempts to
+ * token. If the encoding did not already exist, Tcl attempts to
* dynamically load an encoding by that name.
*
* Results:
- * Returns a token that represents the encoding. If the name didn't
- * refer to any known or loadable encoding, NULL is returned. If NULL
- * was returned, an error message is left in interp's result object,
- * unless interp was NULL.
+ * Returns a token that represents the encoding. If the name didn't refer
+ * to any known or loadable encoding, NULL is returned. If NULL was
+ * returned, an error message is left in interp's result object, unless
+ * interp was NULL.
*
* Side effects:
* The new encoding type is entered into a table visible to all
- * interpreters, keyed off the encoding's name. For each call to this
- * procedure, there should eventually be a call to Tcl_FreeEncoding, so
+ * interpreters, keyed off the encoding's name. For each call to this
+ * function, there should eventually be a call to Tcl_FreeEncoding, so
* that the database can be cleaned up when encodings aren't needed
* anymore.
*
@@ -712,9 +759,9 @@ Tcl_SetDefaultEncodingDir(path)
*/
Tcl_Encoding
-Tcl_GetEncoding(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the desired encoding. */
+Tcl_GetEncoding(
+ Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */
+ const char *name) /* The name of the desired encoding. */
{
Tcl_HashEntry *hPtr;
Encoding *encodingPtr;
@@ -729,7 +776,7 @@ Tcl_GetEncoding(interp, name)
hPtr = Tcl_FindHashEntry(&encodingTable, name);
if (hPtr != NULL) {
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ encodingPtr = Tcl_GetHashValue(hPtr);
encodingPtr->refCount++;
Tcl_MutexUnlock(&encodingMutex);
return (Tcl_Encoding) encodingPtr;
@@ -744,7 +791,7 @@ Tcl_GetEncoding(interp, name)
*
* Tcl_FreeEncoding --
*
- * This procedure is called to release an encoding allocated by
+ * This function is called to release an encoding allocated by
* Tcl_CreateEncoding() or Tcl_GetEncoding().
*
* Results:
@@ -758,8 +805,8 @@ Tcl_GetEncoding(interp, name)
*/
void
-Tcl_FreeEncoding(encoding)
- Tcl_Encoding encoding;
+Tcl_FreeEncoding(
+ Tcl_Encoding encoding)
{
Tcl_MutexLock(&encodingMutex);
FreeEncoding(encoding);
@@ -771,7 +818,7 @@ Tcl_FreeEncoding(encoding)
*
* FreeEncoding --
*
- * This procedure is called to release an encoding by procedures that
+ * This function is called to release an encoding by functions that
* already have the encodingMutex.
*
* Results:
@@ -785,25 +832,27 @@ Tcl_FreeEncoding(encoding)
*/
static void
-FreeEncoding(encoding)
- Tcl_Encoding encoding;
+FreeEncoding(
+ Tcl_Encoding encoding)
{
- Encoding *encodingPtr;
+ Encoding *encodingPtr = (Encoding *) encoding;
- encodingPtr = (Encoding *) encoding;
if (encodingPtr == NULL) {
return;
}
+ if (encodingPtr->refCount<=0) {
+ Tcl_Panic("FreeEncoding: refcount problem !!!");
+ }
encodingPtr->refCount--;
if (encodingPtr->refCount == 0) {
if (encodingPtr->freeProc != NULL) {
- (*encodingPtr->freeProc)(encodingPtr->clientData);
+ encodingPtr->freeProc(encodingPtr->clientData);
}
if (encodingPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(encodingPtr->hPtr);
}
- ckfree((char *) encodingPtr->name);
- ckfree((char *) encodingPtr);
+ ckfree(encodingPtr->name);
+ ckfree(encodingPtr);
}
}
@@ -824,9 +873,9 @@ FreeEncoding(encoding)
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetEncodingName(encoding)
- Tcl_Encoding encoding; /* The encoding whose name to fetch. */
+const char *
+Tcl_GetEncodingName(
+ Tcl_Encoding encoding) /* The encoding whose name to fetch. */
{
if (encoding == NULL) {
encoding = systemEncoding;
@@ -854,8 +903,8 @@ Tcl_GetEncodingName(encoding)
*/
void
-Tcl_GetEncodingNames(interp)
- Tcl_Interp *interp; /* Interp to hold result. */
+Tcl_GetEncodingNames(
+ Tcl_Interp *interp) /* Interp to hold result. */
{
Tcl_HashTable table;
Tcl_HashSearch search;
@@ -873,9 +922,10 @@ Tcl_GetEncodingNames(interp)
Tcl_MutexLock(&encodingMutex);
for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
- Encoding *encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ Encoding *encodingPtr = Tcl_GetHashValue(hPtr);
+
Tcl_CreateHashEntry(&table,
- (char *) Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
+ Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
}
Tcl_MutexUnlock(&encodingMutex);
@@ -888,7 +938,7 @@ Tcl_GetEncodingNames(interp)
Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
- Tcl_CreateHashEntry(&table, (char *) name, &dummy);
+ Tcl_CreateHashEntry(&table, name, &dummy);
}
/*
@@ -910,18 +960,18 @@ Tcl_GetEncodingNames(interp)
* Tcl_SetSystemEncoding --
*
* Sets the default encoding that should be used whenever the user passes
- * a NULL value in to one of the conversion routines. If the supplied
+ * a NULL value in to one of the conversion routines. If the supplied
* name is NULL, the system encoding is reset to the default system
* encoding.
*
* Results:
* The return value is TCL_OK if the system encoding was successfully set
- * to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR
+ * to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR
* is returned, an error message is left in interp's result object,
* unless interp was NULL.
*
* Side effects:
- * The reference count of the new system encoding is incremented. The
+ * The reference count of the new system encoding is incremented. The
* reference count of the old system encoding is decremented and it may
* be freed.
*
@@ -929,15 +979,15 @@ Tcl_GetEncodingNames(interp)
*/
int
-Tcl_SetSystemEncoding(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the desired encoding, or NULL
+Tcl_SetSystemEncoding(
+ Tcl_Interp *interp, /* Interp for error reporting, if not 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;
@@ -963,21 +1013,21 @@ Tcl_SetSystemEncoding(interp, name)
*
* Tcl_CreateEncoding --
*
- * This procedure is called to define a new encoding and the procedures
+ * This function is called to define a new encoding and the functions
* that are used to convert between the specified encoding and Unicode.
*
* Results:
- * Returns a token that represents the encoding. If an encoding with the
+ * Returns a token that represents the encoding. If an encoding with the
* same name already existed, the old encoding token remains valid and
* continues to behave as it used to, and will eventually be garbage
- * collected when the last reference to it goes away. Any subsequent
+ * collected when the last reference to it goes away. Any subsequent
* calls to Tcl_GetEncoding with the specified name will retrieve the
* most recent encoding token.
*
* Side effects:
* The new encoding type is entered into a table visible to all
- * interpreters, keyed off the encoding's name. For each call to this
- * procedure, there should eventually be a call to Tcl_FreeEncoding, so
+ * interpreters, keyed off the encoding's name. For each call to this
+ * function, there should eventually be a call to Tcl_FreeEncoding, so
* that the database can be cleaned up when encodings aren't needed
* anymore.
*
@@ -985,29 +1035,30 @@ Tcl_SetSystemEncoding(interp, name)
*/
Tcl_Encoding
-Tcl_CreateEncoding(typePtr)
- Tcl_EncodingType *typePtr; /* The encoding type. */
+Tcl_CreateEncoding(
+ const Tcl_EncodingType *typePtr)
+ /* The encoding type. */
{
Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
Encoding *encodingPtr;
char *name;
Tcl_MutexLock(&encodingMutex);
- hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
- if (new == 0) {
+ hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
+ if (isNew == 0) {
/*
* Remove old encoding from hash table, but don't delete it until last
* reference goes away.
*/
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ encodingPtr = Tcl_GetHashValue(hPtr);
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;
@@ -1050,18 +1101,18 @@ Tcl_CreateEncoding(typePtr)
*/
char *
-Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
- Tcl_Encoding encoding; /* The encoding for the source string, or NULL
+Tcl_ExternalToUtfDString(
+ Tcl_Encoding encoding, /* The encoding for the source string, or NULL
* for the default system encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes, or < 0 for
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes, or < 0 for
* encoding-specific string length. */
- Tcl_DString *dstPtr; /* Uninitialized or free DString in which the
+ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
char *dst;
Tcl_EncodingState state;
- Encoding *encodingPtr;
+ const Encoding *encodingPtr;
int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
Tcl_DStringInit(dstPtr);
@@ -1076,15 +1127,14 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
if (src == NULL) {
srcLen = 0;
} else if (srcLen < 0) {
- srcLen = (*encodingPtr->lengthProc)(src);
+ srcLen = encodingPtr->lengthProc(src);
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
- result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
- srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
- &dstChars);
+ result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
+ flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
if (result != TCL_CONVERT_NOSPACE) {
@@ -1123,37 +1173,36 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
*/
int
-Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
- dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
- Tcl_Interp *interp; /* Interp for error return, if not NULL. */
- Tcl_Encoding encoding; /* The encoding for the source string, or NULL
+Tcl_ExternalToUtf(
+ Tcl_Interp *interp, /* Interp for error return, if not NULL. */
+ Tcl_Encoding encoding, /* The encoding for the source string, or NULL
* for the default system encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes, or < 0 for
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes, or < 0 for
* encoding-specific string length. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- Encoding *encodingPtr;
+ const Encoding *encodingPtr;
int result, srcRead, dstWrote, dstChars;
Tcl_EncodingState state;
@@ -1165,7 +1214,7 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
if (src == NULL) {
srcLen = 0;
} else if (srcLen < 0) {
- srcLen = (*encodingPtr->lengthProc)(src);
+ srcLen = encodingPtr->lengthProc(src);
}
if (statePtr == NULL) {
flags |= TCL_ENCODING_START | TCL_ENCODING_END;
@@ -1188,7 +1237,7 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
*/
dstLen--;
- result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
+ result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
dst[*dstWrotePtr] = '\0';
@@ -1201,14 +1250,14 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
*
* Tcl_UtfToExternalDString --
*
- * Convert a source buffer from UTF-8 into the specified encoding. If
- * any of the bytes in the source buffer are invalid or cannot be
- * represented in the target encoding, a default fallback character will
- * be substituted.
+ * Convert a source buffer from UTF-8 into the specified encoding. If any
+ * of the bytes in the source buffer are invalid or cannot be represented
+ * in the target encoding, a default fallback character will be
+ * substituted.
*
* Results:
* The converted bytes are stored in the DString, which is then NULL
- * terminated in an encoding-specific manner. The return value is a
+ * terminated in an encoding-specific manner. The return value is a
* pointer to the value stored in the DString.
*
* Side effects:
@@ -1218,18 +1267,18 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
*/
char *
-Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
- Tcl_Encoding encoding; /* The encoding for the converted string, or
+Tcl_UtfToExternalDString(
+ Tcl_Encoding encoding, /* The encoding for the converted string, or
* NULL for the default system encoding. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes, or < 0 for
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes, or < 0 for
* strlen(). */
- Tcl_DString *dstPtr; /* Uninitialized or free DString in which the
+ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
char *dst;
Tcl_EncodingState state;
- Encoding *encodingPtr;
+ const Encoding *encodingPtr;
int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
Tcl_DStringInit(dstPtr);
@@ -1248,7 +1297,7 @@ Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
- result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
+ result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
&dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
@@ -1292,37 +1341,36 @@ Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
*/
int
-Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
- dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
- Tcl_Interp *interp; /* Interp for error return, if not NULL. */
- Tcl_Encoding encoding; /* The encoding for the converted string, or
+Tcl_UtfToExternal(
+ Tcl_Interp *interp, /* Interp for error return, if not NULL. */
+ Tcl_Encoding encoding, /* The encoding for the converted string, or
* NULL for the default system encoding. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes, or < 0 for
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes, or < 0 for
* strlen(). */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string
+ char *dst, /* Output buffer in which converted string
* is stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- Encoding *encodingPtr;
+ const Encoding *encodingPtr;
int result, srcRead, dstWrote, dstChars;
Tcl_EncodingState state;
@@ -1351,7 +1399,7 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
}
dstLen -= encodingPtr->nullSize;
- result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
+ result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
if (encodingPtr->nullSize == 2) {
@@ -1367,7 +1415,7 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
*
* Tcl_FindExecutable --
*
- * This procedure computes the absolute path name of the current
+ * This function computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
@@ -1379,10 +1427,10 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
*
*---------------------------------------------------------------------------
*/
-
+#undef Tcl_FindExecutable
void
-Tcl_FindExecutable(argv0)
- CONST char *argv0; /* The value of the application's argv[0]
+Tcl_FindExecutable(
+ const char *argv0) /* The value of the application's argv[0]
* (native). */
{
TclInitSubsystems();
@@ -1398,27 +1446,26 @@ Tcl_FindExecutable(argv0)
* Open the file believed to hold data for the encoding, "name".
*
* Results:
- * Returns the readable Tcl_Channel from opening the file, or NULL if the
- * file could not be successfully opened. If NULL was * returned, an
- * error message is left in interp's result object, * unless interp was
- * NULL.
+ * Returns the readable Tcl_Channel from opening the file, or NULL if the
+ * file could not be successfully opened. If NULL was returned, an error
+ * message is left in interp's result object, unless interp was NULL.
*
* Side effects:
- * Channel may be opened. Information about the filesystem may be cached
+ * Channel may be opened. Information about the filesystem may be cached
* to speed later calls.
*
*---------------------------------------------------------------------------
*/
static Tcl_Channel
-OpenEncodingFileChannel(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the encoding file on disk and
+OpenEncodingFileChannel(
+ Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */
+ const char *name) /* The name of the encoding file on disk and
* also the name for new encoding. */
{
Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
- Tcl_Obj *searchPath = Tcl_DuplicateObj(TclGetEncodingSearchPath());
+ Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
Tcl_Obj **dir, *path, *directory = NULL;
Tcl_Channel chan = NULL;
@@ -1443,7 +1490,8 @@ OpenEncodingFileChannel(interp, name)
}
}
if (!verified) {
- CONST char *dirString = Tcl_GetString(directory);
+ const char *dirString = Tcl_GetString(directory);
+
for (i=0; i<numDirs && !verified; i++) {
if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
verified = 1;
@@ -1452,7 +1500,7 @@ OpenEncodingFileChannel(interp, name)
}
if (!verified) {
/*
- * Directory no longer on the search path. Remove from cache.
+ * Directory no longer on the search path. Remove from cache.
*/
map = Tcl_DuplicateObj(map);
@@ -1464,7 +1512,7 @@ OpenEncodingFileChannel(interp, name)
if (NULL != directory) {
/*
- * Got a directory from the cache. Try to use it first.
+ * Got a directory from the cache. Try to use it first.
*/
Tcl_IncrRefCount(directory);
@@ -1496,7 +1544,9 @@ OpenEncodingFileChannel(interp, name)
}
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);
Tcl_DecrRefCount(nameObj);
@@ -1515,7 +1565,7 @@ OpenEncodingFileChannel(interp, name)
*
* Results:
* The return value is the newly loaded Encoding, or NULL if the file
- * didn't exist of was in the incorrect format. If NULL was returned, an
+ * didn't exist of was in the incorrect format. If NULL was returned, an
* error message is left in interp's result object, unless interp was
* NULL.
*
@@ -1526,9 +1576,9 @@ OpenEncodingFileChannel(interp, name)
*/
static Tcl_Encoding
-LoadEncodingFile(interp, name)
- Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
- CONST char *name; /* The name of the encoding file on disk and
+LoadEncodingFile(
+ Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */
+ const char *name) /* The name of the encoding file on disk and
* also the name for new encoding. */
{
Tcl_Channel chan = NULL;
@@ -1569,7 +1619,9 @@ LoadEncodingFile(interp, name)
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);
@@ -1581,7 +1633,7 @@ LoadEncodingFile(interp, name)
*
* LoadTableEncoding --
*
- * Helper function for LoadEncodingTable(). Loads a table to that
+ * Helper function for LoadEncodingTable(). Loads a table to that
* converts between Unicode and some other encoding and creates an
* encoding (using a TableEncoding structure) from that information.
*
@@ -1600,19 +1652,19 @@ LoadEncodingFile(interp, name)
*/
static Tcl_Encoding
-LoadTableEncoding(name, type, chan)
- CONST char *name; /* Name for new encoding. */
- int type; /* Type of encoding (ENCODING_?????). */
- Tcl_Channel chan; /* File containing new encoding. */
+LoadTableEncoding(
+ const char *name, /* Name for new encoding. */
+ int type, /* Type of encoding (ENCODING_?????). */
+ Tcl_Channel chan) /* File containing new encoding. */
{
Tcl_DString lineString;
Tcl_Obj *objPtr;
char *line;
- int i, hi, lo, numPages, symbol, fallback;
+ int i, hi, lo, numPages, symbol, fallback, len;
unsigned char used[256];
- unsigned int size;
+ unsigned size;
TableEncodingData *dataPtr;
- unsigned short *pageMemPtr;
+ unsigned short *pageMemPtr, *page;
Tcl_EncodingType encType;
/*
@@ -1620,7 +1672,7 @@ LoadTableEncoding(name, type, chan)
* sequences in the encoding files.
*/
- static char staticHex[] = {
+ static const char staticHex[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 ... 15 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 ... 31 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 32 ... 47 */
@@ -1659,19 +1711,19 @@ LoadTableEncoding(name, type, chan)
#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;
/*
- * Read the table that maps characters to Unicode. Performs a single
+ * Read the table that maps characters to Unicode. Performs a single
* malloc to get the memory for the array and all the pages needed by the
* array.
*/
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);
@@ -1679,7 +1731,7 @@ LoadTableEncoding(name, type, chan)
Tcl_IncrRefCount(objPtr);
for (i = 0; i < numPages; i++) {
int ch;
- char *p;
+ const char *p;
Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
p = Tcl_GetString(objPtr);
@@ -1713,9 +1765,9 @@ LoadTableEncoding(name, type, chan)
}
/*
- * Invert toUnicode array to produce the fromUnicode array. Performs a
+ * Invert toUnicode array to produce the fromUnicode array. Performs a
* single malloc to get the memory for the array and all the pages needed
- * by the array. While reading in the toUnicode array, we remembered what
+ * by the array. While reading in the toUnicode array, we remembered what
* pages that would be needed for the fromUnicode array.
*/
@@ -1729,36 +1781,33 @@ LoadTableEncoding(name, type, chan)
}
}
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);
for (hi = 0; hi < 256; hi++) {
if (dataPtr->toUnicode[hi] == NULL) {
dataPtr->toUnicode[hi] = emptyPage;
- } else {
- for (lo = 0; lo < 256; lo++) {
- int ch;
-
- ch = dataPtr->toUnicode[hi][lo];
- if (ch != 0) {
- unsigned short *page;
-
- page = dataPtr->fromUnicode[ch >> 8];
- if (page == NULL) {
- page = pageMemPtr;
- pageMemPtr += 256;
- dataPtr->fromUnicode[ch >> 8] = page;
- }
- page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
+ continue;
+ }
+ for (lo = 0; lo < 256; lo++) {
+ int ch = dataPtr->toUnicode[hi][lo];
+
+ if (ch != 0) {
+ page = dataPtr->fromUnicode[ch >> 8];
+ if (page == NULL) {
+ page = pageMemPtr;
+ pageMemPtr += 256;
+ dataPtr->fromUnicode[ch >> 8] = page;
}
+ page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
}
}
}
if (type == ENCODING_MULTIBYTE) {
/*
* If multibyte encodings don't have a backslash character, define
- * one. Otherwise, on Windows, native file names won't work because
+ * one. Otherwise, on Windows, native file names won't work because
* the backslash in the file name will map to the unknown character
* (question mark) when converting from UTF-8 to external encoding.
*/
@@ -1770,8 +1819,6 @@ LoadTableEncoding(name, type, chan)
}
}
if (symbol) {
- unsigned short *page;
-
/*
* Make a special symbol encoding that not only maps the symbol
* characters from their Unicode code points down into page 0, but
@@ -1779,7 +1826,7 @@ LoadTableEncoding(name, type, chan)
* is so that a symbol font can be used to display a simple string
* like "abcd" and have alpha, beta, chi, delta show up, rather than
* have "unknown" chars show up because strictly speaking the symbol
- * font doesn't have glyphs for those low ascii chars.
+ * font doesn't have glyphs for those low ASCII chars.
*/
page = dataPtr->fromUnicode[0];
@@ -1800,60 +1847,81 @@ LoadTableEncoding(name, type, chan)
}
/*
- * For trailing 'R'everse encoding, see [Patch #689341]
+ * For trailing 'R'everse encoding, see [Patch 689341]
*/
Tcl_DStringInit(&lineString);
- do {
- int len;
+
+ /*
+ * Skip leading empty lines.
+ */
+
+ while ((len = Tcl_Gets(chan, &lineString)) == 0) {
+ /* empty body */
+ }
+ if (len < 0) {
+ goto doneParse;
+ }
+
+ /*
+ * Require that it starts with an 'R'.
+ */
+
+ line = Tcl_DStringValue(&lineString);
+ if (line[0] != 'R') {
+ goto doneParse;
+ }
+
+ /*
+ * Read lines from the encoding until EOF.
+ */
+
+ for (TclDStringClear(&lineString);
+ (len = Tcl_Gets(chan, &lineString)) >= 0;
+ TclDStringClear(&lineString)) {
+ const unsigned char *p;
+ int to, from;
/*
- * Skip leading empty lines.
+ * Skip short lines.
*/
- while ((len = Tcl_Gets(chan, &lineString)) == 0)
- ;
-
- if (len < 0) {
- break;
- }
- line = Tcl_DStringValue(&lineString);
- if (line[0] != 'R') {
- break;
+ if (len < 5) {
+ continue;
}
- for (Tcl_DStringSetLength(&lineString, 0);
- (len = Tcl_Gets(chan, &lineString)) >= 0;
- Tcl_DStringSetLength(&lineString, 0)) {
- unsigned char* p;
- int to, from;
- if (len < 5) {
- continue;
- }
- p = (unsigned char*) Tcl_DStringValue(&lineString);
- to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+ /*
+ * Parse the line as a sequence of hex digits.
+ */
+
+ p = (const unsigned char *) Tcl_DStringValue(&lineString);
+ to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+ + (staticHex[p[2]] << 4) + staticHex[p[3]];
+ if (to == 0) {
+ continue;
+ }
+ for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
+ from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+ (staticHex[p[2]] << 4) + staticHex[p[3]];
- if (to == 0) {
- continue;
- }
- for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
- from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
- + (staticHex[p[2]] << 4) + staticHex[p[3]];
- if (from == 0) {
- continue;
- }
- dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
+ if (from == 0) {
+ continue;
}
+ dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
}
- } while (0);
+ }
+ doneParse:
Tcl_DStringFree(&lineString);
+ /*
+ * Package everything into an encoding structure.
+ */
+
encType.encodingName = name;
encType.toUtfProc = TableToUtfProc;
encType.fromUtfProc = TableFromUtfProc;
encType.freeProc = TableFreeProc;
encType.nullSize = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
- encType.clientData = (ClientData) dataPtr;
+ encType.clientData = dataPtr;
return Tcl_CreateEncoding(&encType);
}
@@ -1863,7 +1931,7 @@ LoadTableEncoding(name, type, chan)
*
* LoadEscapeEncoding --
*
- * Helper function for LoadEncodingTable(). Loads a state machine that
+ * Helper function for LoadEncodingTable(). Loads a state machine that
* converts between Unicode and some other encoding.
*
* File contains text data that describes the escape sequences that are
@@ -1881,12 +1949,12 @@ LoadTableEncoding(name, type, chan)
*/
static Tcl_Encoding
-LoadEscapeEncoding(name, chan)
- CONST char *name; /* Name for new encoding. */
- Tcl_Channel chan; /* File containing new encoding. */
+LoadEscapeEncoding(
+ const char *name, /* Name for new encoding. */
+ Tcl_Channel chan) /* File containing new encoding. */
{
int i;
- unsigned int size;
+ unsigned size;
Tcl_DString escapeData;
char init[16], final[16];
EscapeEncodingData *dataPtr;
@@ -1898,7 +1966,7 @@ LoadEscapeEncoding(name, chan)
while (1) {
int argc;
- CONST char **argv;
+ const char **argv;
char *line;
Tcl_DString lineString;
@@ -1908,11 +1976,12 @@ LoadEscapeEncoding(name, chan)
}
line = Tcl_DStringValue(&lineString);
if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
+ Tcl_DStringFree(&lineString);
continue;
}
if (argc >= 2) {
if (strcmp(argv[0], "name") == 0) {
- ;
+ /* do nothing */
} else if (strcmp(argv[0], "init") == 0) {
strncpy(init, argv[1], sizeof(init));
init[sizeof(init) - 1] = '\0';
@@ -1921,6 +1990,7 @@ LoadEscapeEncoding(name, chan)
final[sizeof(final) - 1] = '\0';
} else {
EscapeSubTable est;
+ Encoding *e;
strncpy(est.sequence, argv[1], sizeof(est.sequence));
est.sequence[sizeof(est.sequence) - 1] = '\0';
@@ -1933,26 +2003,30 @@ LoadEscapeEncoding(name, chan)
* To avoid infinite recursion in [encoding system iso2022-*]
*/
- Tcl_GetEncoding(NULL, est.name);
-
- est.encodingPtr = NULL;
+ e = (Encoding *) Tcl_GetEncoding(NULL, est.name);
+ if ((e != NULL) && (e->toUtfProc != TableToUtfProc)
+ && (e->toUtfProc != Iso88591ToUtfProc)) {
+ Tcl_FreeEncoding((Tcl_Encoding) e);
+ e = NULL;
+ }
+ est.encodingPtr = e;
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((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
+ memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
(size_t) Tcl_DStringLength(&escapeData));
Tcl_DStringFree(&escapeData);
@@ -1967,12 +2041,16 @@ LoadEscapeEncoding(name, chan)
dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
}
+ /*
+ * Package everything into an encoding structure.
+ */
+
type.encodingName = name;
type.toUtfProc = EscapeToUtfProc;
type.fromUtfProc = EscapeFromUtfProc;
type.freeProc = EscapeFreeProc;
type.nullSize = 1;
- type.clientData = (ClientData) dataPtr;
+ type.clientData = dataPtr;
return Tcl_CreateEncoding(&type);
}
@@ -1982,7 +2060,7 @@ LoadEscapeEncoding(name, chan)
*
* BinaryProc --
*
- * The default conversion when no other conversion is specified. No
+ * The default conversion when no other conversion is specified. No
* translation is done; source bytes are copied directly to destination
* bytes.
*
@@ -1996,27 +2074,26 @@ LoadEscapeEncoding(name, chan)
*/
static int
-BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* Not used. */
- CONST char *src; /* Source string (unknown encoding). */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+BinaryProc(
+ ClientData clientData, /* Not used. */
+ const char *src, /* Source string (unknown encoding). */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
+ int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
@@ -2035,9 +2112,7 @@ BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*srcReadPtr = srcLen;
*dstWrotePtr = srcLen;
*dstCharsPtr = srcLen;
- for ( ; --srcLen >= 0; ) {
- *dst++ = *src++;
- }
+ memcpy(dst, src, (size_t) srcLen);
return result;
}
@@ -2060,30 +2135,29 @@ BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* Not used. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+UtfIntToUtfExtProc(
+ ClientData clientData, /* Not used. */
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string
+ char *dst, /* Output buffer in which converted string
* is stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
@@ -2096,9 +2170,9 @@ UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*
* UtfExtToUtfIntProc --
*
- * Convert from UTF-8 to UTF-8 while converting null-bytes from
- * the official representation (0x00) to Tcl's internal
- * representation (0xc0, 0x80). See UtfToUtfProc for details.
+ * Convert from UTF-8 to UTF-8 while converting null-bytes from the
+ * official representation (0x00) to Tcl's internal representation (0xc0,
+ * 0x80). See UtfToUtfProc for details.
*
* Results:
* Returns TCL_OK if conversion was successful.
@@ -2108,31 +2182,31 @@ UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*
*-------------------------------------------------------------------------
*/
+
static int
-UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* Not used. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+UtfExtToUtfIntProc(
+ ClientData clientData, /* Not used. */
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
@@ -2145,7 +2219,7 @@ UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*
* UtfToUtfProc --
*
- * Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
+ * Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
* is not a no-op, because it will turn a stream of improperly formed
* UTF-8 into a properly formed stream.
*
@@ -2159,38 +2233,37 @@ UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr, pureNullMode)
- ClientData clientData; /* Not used. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+UtfToUtfProc(
+ ClientData clientData, /* Not used. */
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
+ int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr, /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
- int pureNullMode; /* Convert embedded nulls from internal
+ int pureNullMode) /* Convert embedded nulls from internal
* representation to real null-bytes or vice
* versa. */
{
- CONST char *srcStart, *srcEnd, *srcClose;
- char *dstStart, *dstEnd;
+ const char *srcStart, *srcEnd, *srcClose;
+ const char *dstStart, *dstEnd;
int result, numChars;
Tcl_UniChar ch;
@@ -2235,6 +2308,16 @@ UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*dst++ = 0;
src += 2;
+ } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
+ /*
+ * Always check before using Tcl_UtfToUniChar. Not doing can so
+ * cause it run beyond the endof the buffer! If we happen such an
+ * incomplete char its byts are made to represent themselves.
+ */
+
+ ch = (unsigned char) *src;
+ src += 1;
+ dst += Tcl_UniCharToUtf(ch, dst);
} else {
src += Tcl_UtfToUniChar(src, &ch);
dst += Tcl_UniCharToUtf(ch, dst);
@@ -2264,36 +2347,36 @@ UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* Not used. */
- CONST char *src; /* Source string in Unicode. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+UnicodeToUtfProc(
+ ClientData clientData, /* Not used. */
+ const char *src, /* Source string in Unicode. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- CONST Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd;
- char *dstEnd, *dstStart;
+ const char *srcStart, *srcEnd;
+ const char *dstEnd, *dstStart;
int result, numChars;
+ Tcl_UniChar ch;
result = TCL_OK;
if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
@@ -2302,33 +2385,33 @@ UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
srcLen *= sizeof(Tcl_UniChar);
}
- wSrc = (Tcl_UniChar *) src;
-
- wSrcStart = (Tcl_UniChar *) src;
- wSrcEnd = (Tcl_UniChar *) (src + srcLen);
+ srcStart = src;
+ srcEnd = src + srcLen;
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- for (numChars = 0; wSrc < wSrcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
/*
- * Special case for 1-byte utf chars for speed.
+ * Special case for 1-byte utf chars for speed. Make sure we work with
+ * Tcl_UniChar-size data.
*/
- if (*wSrc && *wSrc < 0x80) {
- *dst++ = (char) *wSrc;
+ ch = *(Tcl_UniChar *)src;
+ if (ch && ch < 0x80) {
+ *dst++ = (ch & 0xFF);
} else {
- dst += Tcl_UniCharToUtf(*wSrc, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
}
- wSrc++;
+ src += sizeof(Tcl_UniChar);
}
- *srcReadPtr = (char *) wSrc - (char *) wSrcStart;
+ *srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
@@ -2351,37 +2434,36 @@ UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* TableEncodingData that specifies
+UtfToUnicodeProc(
+ ClientData clientData, /* TableEncodingData that specifies
* encoding. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- CONST char *srcStart, *srcEnd, *srcClose;
- Tcl_UniChar *wDst, *wDstStart, *wDstEnd;
+ const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
+ Tcl_UniChar ch;
srcStart = src;
srcEnd = src + srcLen;
@@ -2390,9 +2472,8 @@ UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
srcClose -= TCL_UTF_MAX;
}
- wDst = (Tcl_UniChar *) dst;
- wDstStart = (Tcl_UniChar *) dst;
- wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar));
+ dstStart = dst;
+ dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
@@ -2405,16 +2486,28 @@ UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
result = TCL_CONVERT_MULTIBYTE;
break;
}
- if (wDst > wDstEnd) {
+ if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
- }
- src += TclUtfToUniChar(src, wDst);
- wDst++;
- }
+ }
+ src += TclUtfToUniChar(src, &ch);
+
+ /*
+ * Need to handle this in a way that won't cause misalignment by
+ * casting dst to a Tcl_UniChar. [Bug 1122671]
+ * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
+ */
+#ifdef WORDS_BIGENDIAN
+ *dst++ = (ch >> 8);
+ *dst++ = (ch & 0xFF);
+#else
+ *dst++ = (ch & 0xFF);
+ *dst++ = (ch >> 8);
+#endif
+ }
*srcReadPtr = src - srcStart;
- *dstWrotePtr = (char *) wDst - (char *) wDstStart;
+ *dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
@@ -2437,41 +2530,40 @@ UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* TableEncodingData that specifies
+TableToUtfProc(
+ ClientData clientData, /* TableEncodingData that specifies
* encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- CONST char *srcStart, *srcEnd;
- char *dstEnd, *dstStart, *prefixBytes;
+ const char *srcStart, *srcEnd;
+ const char *dstEnd, *dstStart, *prefixBytes;
int result, byte, numChars;
Tcl_UniChar ch;
- unsigned short **toUnicode;
- unsigned short *pageZero;
- TableEncodingData *dataPtr;
+ const unsigned short *const *toUnicode;
+ const unsigned short *pageZero;
+ TableEncodingData *dataPtr = clientData;
srcStart = src;
srcEnd = src + srcLen;
@@ -2479,8 +2571,7 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- dataPtr = (TableEncodingData *) clientData;
- toUnicode = dataPtr->toUnicode;
+ toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
prefixBytes = dataPtr->prefixBytes;
pageZero = toUnicode[0];
@@ -2512,9 +2603,11 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
ch = (Tcl_UniChar) byte;
}
+
/*
* Special case for 1-byte utf chars for speed.
*/
+
if (ch && ch < 0x80) {
*dst++ = (char) ch;
} else {
@@ -2547,46 +2640,44 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* TableEncodingData that specifies
+TableFromUtfProc(
+ ClientData clientData, /* TableEncodingData that specifies
* encoding. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- CONST char *srcStart, *srcEnd, *srcClose;
- char *dstStart, *dstEnd, *prefixBytes;
+ const char *srcStart, *srcEnd, *srcClose;
+ const char *dstStart, *dstEnd, *prefixBytes;
Tcl_UniChar ch;
int result, len, word, numChars;
- TableEncodingData *dataPtr;
- unsigned short **fromUnicode;
+ TableEncodingData *dataPtr = clientData;
+ const unsigned short *const *fromUnicode;
result = TCL_OK;
- dataPtr = (TableEncodingData *) clientData;
prefixBytes = dataPtr->prefixBytes;
- fromUnicode = dataPtr->fromUnicode;
+ fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;
srcStart = src;
srcEnd = src + srcLen;
@@ -2612,7 +2703,7 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
#if TCL_UTF_MAX > 3
/*
- * This prevents a crash condition. More evaluation is required for
+ * This prevents a crash condition. More evaluation is required for
* full support of int Tcl_UniChar. [Bug 1004065]
*/
@@ -2655,11 +2746,197 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
/*
+ *-------------------------------------------------------------------------
+ *
+ * Iso88591ToUtfProc --
+ *
+ * Convert from the "iso8859-1" encoding into UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Iso88591ToUtfProc(
+ ClientData clientData, /* Ignored. */
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+ * information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst, /* Output buffer in which converted string is
+ * stored. */
+ int dstLen, /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr) /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ const char *srcStart, *srcEnd;
+ const char *dstEnd, *dstStart;
+ int result, numChars;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ result = TCL_OK;
+ for (numChars = 0; src < srcEnd; numChars++) {
+ Tcl_UniChar ch;
+
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ ch = (Tcl_UniChar) *((unsigned char *) src);
+
+ /*
+ * Special case for 1-byte utf chars for speed.
+ */
+
+ if (ch && ch < 0x80) {
+ *dst++ = (char) ch;
+ } else {
+ dst += Tcl_UniCharToUtf(ch, dst);
+ }
+ src++;
+ }
+
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Iso88591FromUtfProc --
+ *
+ * Convert from UTF-8 into the encoding "iso8859-1".
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Iso88591FromUtfProc(
+ ClientData clientData, /* Ignored. */
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+ * information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst, /* Output buffer in which converted string is
+ * stored. */
+ int dstLen, /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr) /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ const char *srcStart, *srcEnd, *srcClose;
+ const char *dstStart, *dstEnd;
+ int result, numChars;
+
+ result = TCL_OK;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - 1;
+
+ for (numChars = 0; src < srcEnd; numChars++) {
+ Tcl_UniChar ch;
+ int len;
+
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ len = TclUtfToUniChar(src, &ch);
+
+ /*
+ * Check for illegal characters.
+ */
+
+ if (ch > 0xff) {
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_UNKNOWN;
+ break;
+ }
+
+ /*
+ * Plunge on, using '?' as a fallback character.
+ */
+
+ ch = (Tcl_UniChar) '?';
+ }
+
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ *(dst++) = (char) ch;
+ src += len;
+ }
+
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
*---------------------------------------------------------------------------
*
* TableFreeProc --
*
- * This procedure is invoked when an encoding is deleted. It deletes the
+ * This function is invoked when an encoding is deleted. It deletes the
* memory used by the TableEncodingData.
*
* Results:
@@ -2672,20 +2949,19 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static void
-TableFreeProc(clientData)
- ClientData clientData; /* TableEncodingData that specifies
+TableFreeProc(
+ ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
- TableEncodingData *dataPtr;
+ TableEncodingData *dataPtr = clientData;
/*
- * Make sure we aren't freeing twice on shutdown. [Bug #219314]
+ * Make sure we aren't freeing twice on shutdown. [Bug 219314]
*/
- dataPtr = (TableEncodingData *) clientData;
- ckfree((char *) dataPtr->toUnicode);
- ckfree((char *) dataPtr->fromUnicode);
- ckfree((char *) dataPtr);
+ ckfree(dataPtr->toUnicode);
+ ckfree(dataPtr->fromUnicode);
+ ckfree(dataPtr);
}
/*
@@ -2706,48 +2982,43 @@ TableFreeProc(clientData)
*/
static int
-EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* EscapeEncodingData that specifies
+EscapeToUtfProc(
+ ClientData clientData, /* EscapeEncodingData that specifies
* encoding. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
- * source string that were converted. This
- * may be less than the original source length
- * if there was a problem converting some
- * source characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *srcReadPtr, /* Filled with the number of bytes from the
+ * source string that were converted. This may
+ * be less than the original source length if
+ * there was a problem converting some source
+ * characters. */
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- EscapeEncodingData *dataPtr;
- char *prefixBytes, *tablePrefixBytes;
- unsigned short **tableToUnicode;
- Encoding *encodingPtr;
+ EscapeEncodingData *dataPtr = clientData;
+ const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
+ const unsigned short *const *tableToUnicode;
+ const Encoding *encodingPtr;
int state, result, numChars;
- CONST char *srcStart, *srcEnd;
- char *dstStart, *dstEnd;
+ const char *dstStart, *dstEnd;
result = TCL_OK;
-
tablePrefixBytes = NULL; /* lint. */
tableToUnicode = NULL; /* lint. */
-
- dataPtr = (EscapeEncodingData *) clientData;
prefixBytes = dataPtr->prefixBytes;
encodingPtr = NULL;
@@ -2757,7 +3028,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- state = (int) *statePtr;
+ state = PTR2INT(*statePtr);
if (flags & TCL_ENCODING_START) {
state = 0;
}
@@ -2771,9 +3042,9 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
byte = *((unsigned char *) src);
if (prefixBytes[byte]) {
- unsigned int left, len, longest;
+ unsigned left, len, longest;
int checked, i;
- EscapeSubTable *subTablePtr;
+ const EscapeSubTable *subTablePtr;
/*
* Saw the beginning of an escape sequence.
@@ -2845,7 +3116,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
/*
- * We have a split-up or unrecognized escape sequence. If we
+ * We have a split-up or unrecognized escape sequence. If we
* checked all the sequences, then it's a syntax error, otherwise
* we need more bytes to determine a match.
*/
@@ -2871,9 +3142,10 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
TableEncodingData *tableDataPtr;
encodingPtr = GetTableEncoding(dataPtr, state);
- tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ tableDataPtr = encodingPtr->clientData;
tablePrefixBytes = tableDataPtr->prefixBytes;
- tableToUnicode = tableDataPtr->toUnicode;
+ tableToUnicode = (const unsigned short *const*)
+ tableDataPtr->toUnicode;
}
if (tablePrefixBytes[byte]) {
@@ -2896,7 +3168,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
numChars++;
}
- *statePtr = (Tcl_EncodingState) state;
+ *statePtr = (Tcl_EncodingState) INT2PTR(state);
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
@@ -2921,47 +3193,44 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static int
-EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* EscapeEncodingData that specifies
+EscapeFromUtfProc(
+ ClientData clientData, /* EscapeEncodingData that specifies
* encoding. */
- CONST char *src; /* Source string in UTF-8. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Place for conversion routine to store state
+ const char *src, /* Source string in UTF-8. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
- * conversion. Contents of statePtr are
+ * conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
- char *dst; /* Output buffer in which converted string is
+ char *dst, /* Output buffer in which converted string is
* stored. */
- int dstLen; /* The maximum length of output buffer in
+ int dstLen, /* The maximum length of output buffer in
* bytes. */
- int *srcReadPtr; /* Filled with the number of bytes from the
+ int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
- int *dstWrotePtr; /* Filled with the number of bytes that were
+ int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
- int *dstCharsPtr; /* Filled with the number of characters that
+ int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
- EscapeEncodingData *dataPtr;
- Encoding *encodingPtr;
- CONST char *srcStart, *srcEnd, *srcClose;
- char *dstStart, *dstEnd;
+ EscapeEncodingData *dataPtr = clientData;
+ const Encoding *encodingPtr;
+ const char *srcStart, *srcEnd, *srcClose;
+ const char *dstStart, *dstEnd;
int state, result, numChars;
- TableEncodingData *tableDataPtr;
- char *tablePrefixBytes;
- unsigned short **tableFromUnicode;
+ const TableEncodingData *tableDataPtr;
+ const char *tablePrefixBytes;
+ const unsigned short *const *tableFromUnicode;
result = TCL_OK;
- dataPtr = (EscapeEncodingData *) clientData;
-
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2973,30 +3242,31 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
dstEnd = dst + dstLen - 1;
/*
- * RFC1468 states that the text starts in ASCII, and switches to Japanese
- * characters, and that the text must end in ASCII. [Patch #474358]
+ * RFC 1468 states that the text starts in ASCII, and switches to Japanese
+ * characters, and that the text must end in ASCII. [Patch 474358]
*/
if (flags & TCL_ENCODING_START) {
state = 0;
- if (dst + dataPtr->initLen > dstEnd) {
+ if ((dst + dataPtr->initLen) > dstEnd) {
*srcReadPtr = 0;
*dstWrotePtr = 0;
return TCL_CONVERT_NOSPACE;
}
- memcpy((VOID *)dst, (VOID *)dataPtr->init, (size_t)dataPtr->initLen);
+ memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen);
dst += dataPtr->initLen;
} else {
- state = (int) *statePtr;
+ state = PTR2INT(*statePtr);
}
encodingPtr = GetTableEncoding(dataPtr, state);
- tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ tableDataPtr = encodingPtr->clientData;
tablePrefixBytes = tableDataPtr->prefixBytes;
- tableFromUnicode = tableDataPtr->fromUnicode;
+ tableFromUnicode = (const unsigned short *const *)
+ tableDataPtr->fromUnicode;
for (numChars = 0; src < srcEnd; numChars++) {
- unsigned int len;
+ unsigned len;
int word;
Tcl_UniChar ch;
@@ -3014,13 +3284,13 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
if ((word == 0) && (ch != 0)) {
int oldState;
- EscapeSubTable *subTablePtr;
+ const EscapeSubTable *subTablePtr;
oldState = state;
for (state = 0; state < dataPtr->numSubTables; state++) {
encodingPtr = GetTableEncoding(dataPtr, state);
- tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
- word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
+ tableDataPtr = encodingPtr->clientData;
+ word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
if (word != 0) {
break;
}
@@ -3033,12 +3303,13 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
break;
}
encodingPtr = GetTableEncoding(dataPtr, state);
- tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ tableDataPtr = encodingPtr->clientData;
word = tableDataPtr->fallback;
}
- tablePrefixBytes = tableDataPtr->prefixBytes;
- tableFromUnicode = tableDataPtr->fromUnicode;
+ tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
+ tableFromUnicode = (const unsigned short *const *)
+ tableDataPtr->fromUnicode;
/*
* The state variable has the value of oldState when word is 0.
@@ -3060,7 +3331,7 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
result = TCL_CONVERT_NOSPACE;
break;
}
- memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
+ memcpy(dst, subTablePtr->sequence,
(size_t) subTablePtr->sequenceLen);
dst += subTablePtr->sequenceLen;
}
@@ -3086,22 +3357,31 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
- unsigned int len = dataPtr->subTables[0].sequenceLen;
- if (dst + dataPtr->finalLen + (state?len:0) > dstEnd) {
+ unsigned len = dataPtr->subTables[0].sequenceLen;
+
+ /*
+ * Certain encodings like iso2022-jp need to write an escape sequence
+ * after all characters have been converted. This logic checks that
+ * enough room is available in the buffer for the escape bytes. The
+ * TCL_ENCODING_END flag is cleared after a final escape sequence has
+ * been added to the buffer so that another call to this method does
+ * not attempt to append escape bytes a second time.
+ */
+
+ if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
result = TCL_CONVERT_NOSPACE;
} else {
if (state) {
- memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
- (size_t) len);
+ memcpy(dst, dataPtr->subTables[0].sequence, len);
dst += len;
}
- memcpy((VOID *) dst, (VOID *) dataPtr->final,
- (size_t) dataPtr->finalLen);
+ memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
dst += dataPtr->finalLen;
+ state &= ~TCL_ENCODING_END;
}
}
- *statePtr = (Tcl_EncodingState) state;
+ *statePtr = (Tcl_EncodingState) INT2PTR(state);
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
@@ -3113,8 +3393,8 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*
* EscapeFreeProc --
*
- * This procedure is invoked when an EscapeEncodingData encoding is
- * deleted. It deletes the memory used by the encoding.
+ * This function is invoked when an EscapeEncodingData encoding is
+ * deleted. It deletes the memory used by the encoding.
*
* Results:
* None.
@@ -3126,23 +3406,37 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*/
static void
-EscapeFreeProc(clientData)
- ClientData clientData; /* EscapeEncodingData that specifies encoding. */
+EscapeFreeProc(
+ ClientData clientData) /* EscapeEncodingData that specifies
+ * encoding. */
{
- EscapeEncodingData *dataPtr;
+ EscapeEncodingData *dataPtr = clientData;
EscapeSubTable *subTablePtr;
int i;
- dataPtr = (EscapeEncodingData *) clientData;
if (dataPtr == NULL) {
return;
}
- subTablePtr = dataPtr->subTables;
- for (i = 0; i < dataPtr->numSubTables; i++) {
- FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
- subTablePtr++;
+
+ /*
+ * The subTables should be freed recursively in normal operation but not
+ * during TclFinalizeEncodingSubsystem because they are also present as a
+ * weak reference in the toplevel encodingTable (i.e., they don't have a
+ * +1 refcount for this), and unpredictable nuking order could remove them
+ * from under the following loop's feet. [Bug 2891556]
+ *
+ * The encodingsInitialized flag, being reset on entry to TFES, can serve
+ * as a "not in finalization" test.
+ */
+
+ if (encodingsInitialized) {
+ subTablePtr = dataPtr->subTables;
+ for (i = 0; i < dataPtr->numSubTables; i++) {
+ FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+ subTablePtr++;
+ }
}
- ckfree((char *) dataPtr);
+ ckfree(dataPtr);
}
/*
@@ -3150,7 +3444,7 @@ EscapeFreeProc(clientData)
*
* GetTableEncoding --
*
- * Helper function for the EscapeEncodingData conversions. Gets the
+ * Helper function for the EscapeEncodingData conversions. Gets the
* encoding (of type TextEncodingData) that represents the specified
* state.
*
@@ -3166,20 +3460,18 @@ EscapeFreeProc(clientData)
*/
static Encoding *
-GetTableEncoding(dataPtr, state)
- EscapeEncodingData *dataPtr;/* Contains names of encodings. */
- int state; /* Index in dataPtr of desired Encoding. */
+GetTableEncoding(
+ EscapeEncodingData *dataPtr,/* Contains names of encodings. */
+ int state) /* Index in dataPtr of desired Encoding. */
{
- EscapeSubTable *subTablePtr;
- Encoding *encodingPtr;
-
- subTablePtr = &dataPtr->subTables[state];
- encodingPtr = subTablePtr->encodingPtr;
+ EscapeSubTable *subTablePtr = &dataPtr->subTables[state];
+ Encoding *encodingPtr = subTablePtr->encodingPtr;
if (encodingPtr == NULL) {
encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
if ((encodingPtr == NULL)
- || (encodingPtr->toUtfProc != TableToUtfProc)) {
+ || (encodingPtr->toUtfProc != TableToUtfProc
+ && encodingPtr->toUtfProc != Iso88591ToUtfProc)) {
Tcl_Panic("EscapeToUtfProc: invalid sub table");
}
subTablePtr->encodingPtr = encodingPtr;
@@ -3193,7 +3485,7 @@ GetTableEncoding(dataPtr, state)
*
* unilen --
*
- * A helper function for the Tcl_ExternalToUtf functions. This function
+ * A helper function for the Tcl_ExternalToUtf functions. This function
* is similar to strlen for double-byte characters: it returns the number
* of bytes in a 0x0000 terminated string.
*
@@ -3207,8 +3499,8 @@ GetTableEncoding(dataPtr, state)
*/
static size_t
-unilen(src)
- CONST char *src;
+unilen(
+ const char *src)
{
unsigned short *p;
@@ -3226,7 +3518,7 @@ unilen(src)
*
* This is the fallback routine that sets the default value of the
* encoding search path if the application has not set one via a call to
- * TclSetEncodingSearchPath() by the first time the search path is needed
+ * Tcl_SetEncodingSearchPath() by the first time the search path is needed
* to load encoding data.
*
* The default encoding search path is produced by taking each directory
@@ -3243,47 +3535,48 @@ unilen(src)
*/
static void
-InitializeEncodingSearchPath(valuePtr, lengthPtr, encodingPtr)
- char **valuePtr;
- int *lengthPtr;
- Tcl_Encoding *encodingPtr;
+InitializeEncodingSearchPath(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
- char *bytes;
+ const char *bytes;
int i, numDirs, numBytes;
- Tcl_Obj *libPath, *encodingObj = Tcl_NewStringObj("encoding", -1);
- Tcl_Obj *searchPath = Tcl_NewObj();
+ Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
+ TclNewLiteralStringObj(encodingObj, "encoding");
+ TclNewObj(searchPathObj);
Tcl_IncrRefCount(encodingObj);
- Tcl_IncrRefCount(searchPath);
- libPath = TclGetLibraryPath();
- Tcl_IncrRefCount(libPath);
- Tcl_ListObjLength(NULL, libPath, &numDirs);
+ Tcl_IncrRefCount(searchPathObj);
+ libPathObj = TclGetLibraryPath();
+ Tcl_IncrRefCount(libPathObj);
+ Tcl_ListObjLength(NULL, libPathObj, &numDirs);
for (i = 0; i < numDirs; i++) {
- Tcl_Obj *directory, *path;
+ Tcl_Obj *directoryObj, *pathObj;
Tcl_StatBuf stat;
- Tcl_ListObjIndex(NULL, libPath, i, &directory);
- path = Tcl_FSJoinToPath(directory, 1, &encodingObj);
- Tcl_IncrRefCount(path);
- if ((0 == Tcl_FSStat(path, &stat)) && S_ISDIR(stat.st_mode)) {
- Tcl_ListObjAppendElement(NULL, searchPath, path);
+ Tcl_ListObjIndex(NULL, libPathObj, i, &directoryObj);
+ pathObj = Tcl_FSJoinToPath(directoryObj, 1, &encodingObj);
+ Tcl_IncrRefCount(pathObj);
+ if ((0 == Tcl_FSStat(pathObj, &stat)) && S_ISDIR(stat.st_mode)) {
+ Tcl_ListObjAppendElement(NULL, searchPathObj, pathObj);
}
- Tcl_DecrRefCount(path);
+ Tcl_DecrRefCount(pathObj);
}
- Tcl_DecrRefCount(libPath);
+ Tcl_DecrRefCount(libPathObj);
Tcl_DecrRefCount(encodingObj);
*encodingPtr = libraryPath.encoding;
if (*encodingPtr) {
((Encoding *)(*encodingPtr))->refCount++;
}
- bytes = Tcl_GetStringFromObj(searchPath, &numBytes);
+ bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
*lengthPtr = numBytes;
- *valuePtr = ckalloc((unsigned int) numBytes + 1);
- memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1);
- Tcl_DecrRefCount(searchPath);
+ *valuePtr = ckalloc(numBytes + 1);
+ memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
+ Tcl_DecrRefCount(searchPathObj);
}
/*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
new file mode 100644
index 0000000..9bb7a0c
--- /dev/null
+++ b/generic/tclEnsemble.c
@@ -0,0 +1,3486 @@
+/*
+ * tclEnsemble.c --
+ *
+ * Contains support for ensembles (see TIP#112), which provide simple
+ * mechanism for creating composite commands on top of namespaces.
+ *
+ * Copyright (c) 2005-2013 Donal K. Fellows.
+ *
+ * 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 "tclCompile.h"
+
+/*
+ * 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);
+static int NsEnsembleImplementationCmd(ClientData clientData,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int NsEnsembleImplementationCmdNR(ClientData clientData,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
+static int NsEnsembleStringOrder(const void *strPtr1,
+ const void *strPtr2);
+static void DeleteEnsembleConfig(ClientData clientData);
+static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
+ EnsembleConfig *ensemblePtr,
+ const char *subcmdName, Tcl_Obj *prefixObjPtr);
+static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
+static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
+static void CompileToInvokedCommand(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Tcl_Obj *replacements,
+ Command *cmdPtr, CompileEnv *envPtr);
+static int CompileBasicNArgCommand(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ CompileEnv *envPtr);
+
+/*
+ * The lists of subcommands and options for the [namespace ensemble] command.
+ */
+
+static const char *const ensembleSubcommands[] = {
+ "configure", "create", "exists", NULL
+};
+enum EnsSubcmds {
+ ENS_CONFIG, ENS_CREATE, ENS_EXISTS
+};
+
+static const char *const ensembleCreateOptions[] = {
+ "-command", "-map", "-parameters", "-prefixes", "-subcommands",
+ "-unknown", NULL
+};
+enum EnsCreateOpts {
+ CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
+};
+
+static const char *const ensembleConfigOptions[] = {
+ "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
+ "-unknown", NULL
+};
+enum EnsConfigOpts {
+ CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
+ CONF_UNKNOWN
+};
+
+/*
+ * This structure defines a Tcl object type that contains a reference to an
+ * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
+ * to cache the mapping between the subcommand itself and the real command
+ * that implements it.
+ */
+
+const Tcl_ObjType tclEnsembleCmdType = {
+ "ensembleCommand", /* the type's name */
+ FreeEnsembleCmdRep, /* freeIntRepProc */
+ DupEnsembleCmdRep, /* dupIntRepProc */
+ StringOfEnsembleCmdRep, /* updateStringProc */
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNamespaceEnsembleCmd --
+ *
+ * Invoked to implement the "namespace ensemble" command that creates and
+ * manipulates ensembles built on top of namespaces. Handles the
+ * following syntax:
+ *
+ * namespace ensemble name ?dictionary?
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ * Creates the ensemble for the namespace if one did not previously
+ * exist. Alternatively, alters the way that the ensemble's subcommand =>
+ * implementation prefix is configured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNamespaceEnsembleCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Namespace *namespacePtr;
+ Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ Tcl_Command token;
+ Tcl_DictSearch search;
+ Tcl_Obj *listObj;
+ int index, done;
+
+ if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tried to manipulate ensemble of deleted namespace",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands,
+ "subcommand", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum EnsSubcmds) index) {
+ case ENS_CREATE: {
+ const char *name;
+ int len, allocatedMapFlag = 0;
+ /*
+ * Defaults
+ */
+ Tcl_Obj *subcmdObj = NULL;
+ Tcl_Obj *mapObj = NULL;
+ int permitPrefix = 1;
+ Tcl_Obj *unknownObj = NULL;
+ Tcl_Obj *paramObj = NULL;
+
+ /*
+ * Check that we've got option-value pairs... [Bug 1558654]
+ */
+
+ if (objc & 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
+ return TCL_ERROR;
+ }
+ objv += 2;
+ objc -= 2;
+
+ /*
+ * Work out what name to use for the command to create. If supplied,
+ * it is either fully specified or relative to the current namespace.
+ * If not supplied, it is exactly the name of the current namespace.
+ */
+
+ name = nsPtr->fullName;
+
+ /*
+ * Parse the option list, applying type checks as we go. Note that we
+ * are not incrementing any reference counts in the objects at this
+ * stage, so the presence of an option multiple times won't cause any
+ * memory leaks.
+ */
+
+ for (; objc>1 ; objc-=2,objv+=2) {
+ if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions,
+ "option", 0, &index) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ switch ((enum EnsCreateOpts) index) {
+ case CRT_CMD:
+ name = TclGetString(objv[1]);
+ continue;
+ case CRT_SUBCMDS:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ subcmdObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ case CRT_PARAM:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ paramObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ case CRT_MAP: {
+ Tcl_Obj *patchedDict = NULL, *subcmdWordsObj;
+
+ /*
+ * Verify that the map is sensible.
+ */
+
+ if (Tcl_DictObjFirst(interp, objv[1], &search,
+ &subcmdWordsObj, &listObj, &done) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ if (done) {
+ mapObj = NULL;
+ continue;
+ }
+ do {
+ Tcl_Obj **listv;
+ const char *cmd;
+
+ if (TclListObjGetElements(interp, listObj, &len,
+ &listv) != TCL_OK) {
+ Tcl_DictObjDone(&search);
+ if (patchedDict) {
+ Tcl_DecrRefCount(patchedDict);
+ }
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ if (len < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble subcommand implementations "
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
+ Tcl_DictObjDone(&search);
+ if (patchedDict) {
+ Tcl_DecrRefCount(patchedDict);
+ }
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ cmd = TclGetString(listv[0]);
+ if (!(cmd[0] == ':' && cmd[1] == ':')) {
+ Tcl_Obj *newList = Tcl_NewListObj(len, listv);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr);
+
+ if (nsPtr->parentPtr) {
+ Tcl_AppendStringsToObj(newCmd, "::", NULL);
+ }
+ Tcl_AppendObjToObj(newCmd, listv[0]);
+ Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
+ if (patchedDict == NULL) {
+ patchedDict = Tcl_DuplicateObj(objv[1]);
+ }
+ Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
+ newList);
+ }
+ Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
+ } while (!done);
+
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ mapObj = (patchedDict ? patchedDict : objv[1]);
+ if (patchedDict) {
+ allocatedMapFlag = 1;
+ }
+ continue;
+ }
+ case CRT_PREFIX:
+ if (Tcl_GetBooleanFromObj(interp, objv[1],
+ &permitPrefix) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ continue;
+ case CRT_UNKNOWN:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ unknownObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ }
+ }
+
+ /*
+ * Create the ensemble. Note that this might delete another ensemble
+ * linked to the same namespace, so we must be careful. However, we
+ * should be OK because we only link the namespace into the list once
+ * we've created it (and after any deletions have occurred.)
+ */
+
+ token = Tcl_CreateEnsemble(interp, name, NULL,
+ (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+ Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
+ Tcl_SetEnsembleMappingDict(interp, token, mapObj);
+ Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
+ Tcl_SetEnsembleParameterList(interp, token, paramObj);
+
+ /*
+ * Tricky! Must ensure that the result is not shared (command delete
+ * traces could have corrupted the pristine object that we started
+ * with). [Snit test rename-1.5]
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
+ return TCL_OK;
+ }
+
+ case ENS_EXISTS:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "cmdname");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ Tcl_FindEnsemble(interp, objv[2], 0) != NULL));
+ return TCL_OK;
+
+ case ENS_CONFIG:
+ if (objc < 3 || (objc != 4 && !(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "cmdname ?-option value ...? ?arg ...?");
+ return TCL_ERROR;
+ }
+ token = Tcl_FindEnsemble(interp, objv[2], TCL_LEAVE_ERR_MSG);
+ if (token == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 4) {
+ Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions,
+ "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum EnsConfigOpts) index) {
+ case CONF_SUBCMDS:
+ Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ case CONF_PARAM:
+ Tcl_GetEnsembleParameterList(NULL, token, &resultObj);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ case CONF_MAP:
+ Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ case CONF_NAMESPACE:
+ namespacePtr = NULL; /* silence gcc 4 warning */
+ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
+ Tcl_SetObjResult(interp, NewNsObj(namespacePtr));
+ break;
+ case CONF_PREFIX: {
+ int flags = 0; /* silence gcc 4 warning */
+
+ Tcl_GetEnsembleFlags(NULL, token, &flags);
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
+ break;
+ }
+ case CONF_UNKNOWN:
+ Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
+ }
+ } else if (objc == 3) {
+ /*
+ * Produce list of all information.
+ */
+
+ Tcl_Obj *resultObj, *tmpObj = NULL; /* silence gcc 4 warning */
+ int flags = 0; /* silence gcc 4 warning */
+
+ TclNewObj(resultObj);
+
+ /* -map option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1));
+ Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+ /* -namespace option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE],
+ -1));
+ namespacePtr = NULL; /* silence gcc 4 warning */
+ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
+ Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));
+
+ /* -parameters option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1));
+ Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+ /* -prefix option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1));
+ Tcl_GetEnsembleFlags(NULL, token, &flags);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
+
+ /* -subcommands option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1));
+ Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+ /* -unknown option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
+ Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+ Tcl_SetObjResult(interp, resultObj);
+ } else {
+ int len, allocatedMapFlag = 0;
+ Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
+ *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
+ int permitPrefix, flags = 0; /* silence gcc 4 warning */
+
+ Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
+ Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
+ Tcl_GetEnsembleParameterList(NULL, token, &paramObj);
+ Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
+ Tcl_GetEnsembleFlags(NULL, token, &flags);
+ permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
+
+ objv += 3;
+ objc -= 3;
+
+ /*
+ * Parse the option list, applying type checks as we go. Note that
+ * we are not incrementing any reference counts in the objects at
+ * this stage, so the presence of an option multiple times won't
+ * cause any memory leaks.
+ */
+
+ for (; objc>0 ; objc-=2,objv+=2) {
+ if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions,
+ "option", 0, &index) != TCL_OK) {
+ freeMapAndError:
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ switch ((enum EnsConfigOpts) index) {
+ case CONF_SUBCMDS:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ goto freeMapAndError;
+ }
+ subcmdObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ case CONF_PARAM:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ goto freeMapAndError;
+ }
+ paramObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ case CONF_MAP: {
+ Tcl_Obj *patchedDict = NULL, *subcmdWordsObj, **listv;
+ const char *cmd;
+
+ /*
+ * Verify that the map is sensible.
+ */
+
+ if (Tcl_DictObjFirst(interp, objv[1], &search,
+ &subcmdWordsObj, &listObj, &done) != TCL_OK) {
+ goto freeMapAndError;
+ }
+ if (done) {
+ mapObj = NULL;
+ continue;
+ }
+ do {
+ if (TclListObjGetElements(interp, listObj, &len,
+ &listv) != TCL_OK) {
+ Tcl_DictObjDone(&search);
+ if (patchedDict) {
+ Tcl_DecrRefCount(patchedDict);
+ }
+ goto freeMapAndError;
+ }
+ if (len < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble subcommand implementations "
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
+ Tcl_DictObjDone(&search);
+ if (patchedDict) {
+ Tcl_DecrRefCount(patchedDict);
+ }
+ goto freeMapAndError;
+ }
+ cmd = TclGetString(listv[0]);
+ if (!(cmd[0] == ':' && cmd[1] == ':')) {
+ Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
+
+ if (nsPtr->parentPtr) {
+ Tcl_AppendStringsToObj(newCmd, "::", NULL);
+ }
+ Tcl_AppendObjToObj(newCmd, listv[0]);
+ Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
+ if (patchedDict == NULL) {
+ patchedDict = Tcl_DuplicateObj(objv[1]);
+ }
+ Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
+ newList);
+ }
+ Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
+ &done);
+ } while (!done);
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ mapObj = (patchedDict ? patchedDict : objv[1]);
+ if (patchedDict) {
+ allocatedMapFlag = 1;
+ }
+ continue;
+ }
+ case CONF_NAMESPACE:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option -namespace is read-only", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
+ NULL);
+ goto freeMapAndError;
+ case CONF_PREFIX:
+ if (Tcl_GetBooleanFromObj(interp, objv[1],
+ &permitPrefix) != TCL_OK) {
+ goto freeMapAndError;
+ }
+ continue;
+ case CONF_UNKNOWN:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ goto freeMapAndError;
+ }
+ unknownObj = (len > 0 ? objv[1] : NULL);
+ continue;
+ }
+ }
+
+ /*
+ * Update the namespace now that we've finished the parsing stage.
+ */
+
+ flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
+ : flags&~TCL_ENSEMBLE_PREFIX);
+ Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
+ Tcl_SetEnsembleMappingDict(interp, token, mapObj);
+ Tcl_SetEnsembleParameterList(interp, token, paramObj);
+ Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
+ Tcl_SetEnsembleFlags(interp, token, flags);
+ }
+ return TCL_OK;
+
+ default:
+ Tcl_Panic("unexpected ensemble command");
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEnsemble --
+ *
+ * Create a simple ensemble attached to the given namespace.
+ *
+ * Results:
+ * The token for the command created.
+ *
+ * Side effects:
+ * The ensemble is created and marked for compilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateEnsemble(
+ Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *namespacePtr,
+ int flags)
+{
+ Namespace *nsPtr = (Namespace *) namespacePtr;
+ EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
+ Tcl_Obj *nameObj = NULL;
+
+ if (nsPtr == NULL) {
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ }
+
+ /*
+ * Make the name of the ensemble into a fully qualified name. This might
+ * allocate a temporary object.
+ */
+
+ if (!(name[0] == ':' && name[1] == ':')) {
+ nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
+ if (nsPtr->parentPtr == NULL) {
+ Tcl_AppendStringsToObj(nameObj, name, NULL);
+ } else {
+ Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
+ }
+ Tcl_IncrRefCount(nameObj);
+ name = TclGetString(nameObj);
+ }
+
+ ensemblePtr->nsPtr = nsPtr;
+ ensemblePtr->epoch = 0;
+ Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
+ ensemblePtr->subcommandArrayPtr = NULL;
+ ensemblePtr->subcmdList = NULL;
+ ensemblePtr->subcommandDict = NULL;
+ ensemblePtr->flags = flags;
+ ensemblePtr->numParameters = 0;
+ ensemblePtr->parameterList = NULL;
+ ensemblePtr->unknownHandler = NULL;
+ ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
+ NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
+ ensemblePtr, DeleteEnsembleConfig);
+ ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
+ nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ nsPtr->exportLookupEpoch++;
+
+ if (flags & ENSEMBLE_COMPILE) {
+ ((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+ }
+
+ if (nameObj != NULL) {
+ TclDecrRefCount(nameObj);
+ }
+ return ensemblePtr->token;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleSubcommandList --
+ *
+ * Set the subcommand list for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an ensemble
+ * or the subcommand list - if non-NULL - is not a list).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleSubcommandList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj *subcmdList)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Obj *oldList;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ 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) {
+ int length;
+
+ if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length < 1) {
+ subcmdList = NULL;
+ }
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ oldList = ensemblePtr->subcmdList;
+ ensemblePtr->subcmdList = subcmdList;
+ if (subcmdList != NULL) {
+ Tcl_IncrRefCount(subcmdList);
+ }
+ if (oldList != NULL) {
+ TclDecrRefCount(oldList);
+ }
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ /*
+ * Special hack to make compiling of [info exists] work when the
+ * dictionary is modified.
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ ((Interp *) interp)->compileEpoch++;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleParameterList --
+ *
+ * Set the parameter list for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an ensemble
+ * or the parameter list - if non-NULL - is not a list).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleParameterList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj *paramList)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Obj *oldList;
+ int length;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ 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) {
+ length = 0;
+ } else {
+ if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length < 1) {
+ paramList = NULL;
+ }
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ oldList = ensemblePtr->parameterList;
+ ensemblePtr->parameterList = paramList;
+ if (paramList != NULL) {
+ Tcl_IncrRefCount(paramList);
+ }
+ if (oldList != NULL) {
+ TclDecrRefCount(oldList);
+ }
+ ensemblePtr->numParameters = length;
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ /*
+ * Special hack to make compiling of [info exists] work when the
+ * dictionary is modified.
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ ((Interp *) interp)->compileEpoch++;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleMappingDict --
+ *
+ * Set the mapping dictionary for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an ensemble
+ * or the mapping - if non-NULL - is not a dict).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleMappingDict(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj *mapDict)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Obj *oldDict;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ 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) {
+ int size, done;
+ Tcl_DictSearch search;
+ Tcl_Obj *valuePtr;
+
+ if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ for (Tcl_DictObjFirst(NULL, mapDict, &search, NULL, &valuePtr, &done);
+ !done; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
+ Tcl_Obj *cmdObjPtr;
+ const char *bytes;
+
+ if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdObjPtr) != TCL_OK) {
+ Tcl_DictObjDone(&search);
+ return TCL_ERROR;
+ }
+ bytes = TclGetString(cmdObjPtr);
+ if (bytes[0] != ':' || bytes[1] != ':') {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble target is not a fully-qualified command",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "UNQUALIFIED_TARGET", NULL);
+ Tcl_DictObjDone(&search);
+ return TCL_ERROR;
+ }
+ }
+
+ if (size < 1) {
+ mapDict = NULL;
+ }
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ oldDict = ensemblePtr->subcommandDict;
+ ensemblePtr->subcommandDict = mapDict;
+ if (mapDict != NULL) {
+ Tcl_IncrRefCount(mapDict);
+ }
+ if (oldDict != NULL) {
+ TclDecrRefCount(oldDict);
+ }
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ /*
+ * Special hack to make compiling of [info exists] work when the
+ * dictionary is modified.
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ ((Interp *) interp)->compileEpoch++;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleUnknownHandler --
+ *
+ * Set the unknown handler for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an ensemble
+ * or the unknown handler - if non-NULL - is not a list).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleUnknownHandler(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj *unknownList)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Obj *oldList;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ 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) {
+ int length;
+
+ if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length < 1) {
+ unknownList = NULL;
+ }
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ oldList = ensemblePtr->unknownHandler;
+ ensemblePtr->unknownHandler = unknownList;
+ if (unknownList != NULL) {
+ Tcl_IncrRefCount(unknownList);
+ }
+ if (oldList != NULL) {
+ TclDecrRefCount(oldList);
+ }
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleFlags --
+ *
+ * Set the flags for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleFlags(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ int flags)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ int wasCompiled;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;
+
+ /*
+ * This API refuses to set the ENSEMBLE_DEAD flag...
+ */
+
+ ensemblePtr->flags &= ENSEMBLE_DEAD;
+ ensemblePtr->flags |= flags & ~ENSEMBLE_DEAD;
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ /*
+ * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
+ * compiler function and bump the interpreter's compilation epoch so that
+ * bytecode gets regenerated.
+ */
+
+ if (flags & ENSEMBLE_COMPILE) {
+ if (!wasCompiled) {
+ ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+ ((Interp *) interp)->compileEpoch++;
+ }
+ } else {
+ if (wasCompiled) {
+ ((Command *) ensemblePtr->token)->compileProc = NULL;
+ ((Interp *) interp)->compileEpoch++;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleSubcommandList --
+ *
+ * Get the list of subcommands associated with a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The list of subcommands is returned by updating the
+ * variable pointed to by the last parameter (NULL if this is to be
+ * derived from the mapping dictionary or the associated namespace's
+ * exported commands).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleSubcommandList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj **subcmdListPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *subcmdListPtr = ensemblePtr->subcmdList;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleParameterList --
+ *
+ * Get the list of parameters associated with a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The list of parameters is returned by updating the
+ * variable pointed to by the last parameter (NULL if there are
+ * no parameters).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleParameterList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj **paramListPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *paramListPtr = ensemblePtr->parameterList;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleMappingDict --
+ *
+ * Get the command mapping dictionary associated with a particular
+ * ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The mapping dict is returned by updating the variable
+ * pointed to by the last parameter (NULL if none is installed).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleMappingDict(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj **mapDictPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *mapDictPtr = ensemblePtr->subcommandDict;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleUnknownHandler --
+ *
+ * Get the unknown handler associated with a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The unknown handler is returned by updating the variable
+ * pointed to by the last parameter (NULL if no handler is installed).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleUnknownHandler(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj **unknownListPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *unknownListPtr = ensemblePtr->unknownHandler;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleFlags --
+ *
+ * Get the flags for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The flags are returned by updating the variable pointed to
+ * by the last parameter.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleFlags(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ int *flagsPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *flagsPtr = ensemblePtr->flags;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleNamespace --
+ *
+ * Get the namespace associated with a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). Namespace is returned by updating the variable pointed to
+ * by the last parameter.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleNamespace(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Namespace **namespacePtrPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindEnsemble --
+ *
+ * Given a command name, get the ensemble token for it, allowing for
+ * [namespace import]s. [Bug 1017022]
+ *
+ * Results:
+ * The token for the ensemble command with the given name, or NULL if the
+ * command either does not exist or is not an ensemble (when an error
+ * message will be written into the interp if thats non-NULL).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_FindEnsemble(
+ Tcl_Interp *interp, /* Where to do the lookup, and where to write
+ * the errors if TCL_LEAVE_ERR_MSG is set in
+ * the flags. */
+ Tcl_Obj *cmdNameObj, /* Name of command to look up. */
+ int flags) /* Either 0 or TCL_LEAVE_ERR_MSG; other flags
+ * are probably not useful. */
+{
+ Command *cmdPtr;
+
+ cmdPtr = (Command *)
+ Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
+ if (cmdPtr == NULL) {
+ return NULL;
+ }
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ /*
+ * Reuse existing infrastructure for following import link chains
+ * rather than duplicating it.
+ */
+
+ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+
+ if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not an ensemble command",
+ TclGetString(cmdNameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
+ TclGetString(cmdNameObj), NULL);
+ }
+ return NULL;
+ }
+ }
+
+ return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsEnsemble --
+ *
+ * Simple test for ensemble-hood that takes into account imported
+ * ensemble commands as well.
+ *
+ * Results:
+ * Boolean value
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsEnsemble(
+ Tcl_Command token)
+{
+ Command *cmdPtr = (Command *) token;
+
+ if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
+ return 1;
+ }
+ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+ if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ return 0;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMakeEnsemble --
+ *
+ * Create an ensemble from a table of implementation commands. The
+ * ensemble will be subject to (limited) compilation if any of the
+ * implementation commands are compilable.
+ *
+ * The 'name' parameter may be a single command name or a list if
+ * creating an ensemble subcommand (see the binary implementation).
+ *
+ * Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on
+ * top-level ensemble commands.
+ *
+ * Results:
+ * Handle for the new ensemble, or NULL on failure.
+ *
+ * Side effects:
+ * May advance the bytecode compilation epoch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclMakeEnsemble(
+ Tcl_Interp *interp,
+ const char *name, /* The ensemble name (as explained above) */
+ const EnsembleImplMap map[]) /* The subcommands to create */
+{
+ Tcl_Command ensemble;
+ Tcl_Namespace *ns;
+ Tcl_DString buf, hiddenBuf;
+ const char **nameParts = NULL;
+ const char *cmdName = NULL;
+ 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.
+ */
+
+ cmdName = name;
+ Tcl_DStringAppend(&buf, name, -1);
+ ensembleFlags = TCL_ENSEMBLE_PREFIX;
+ } else {
+ /*
+ * Not an absolute name, so do munging of it. Note that this treats a
+ * multi-word list differently to a single word.
+ */
+
+ 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) {
+ TclDStringAppendLiteral(&buf, "::");
+ Tcl_DStringAppend(&buf, nameParts[i], -1);
+ }
+ }
+
+ ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
+ TCL_CREATE_NS_IF_UNKNOWN);
+ if (!ns) {
+ Tcl_Panic("unable to find or create %s namespace!",
+ Tcl_DStringValue(&buf));
+ }
+
+ /*
+ * Create the named ensemble in the correct namespace
+ */
+
+ if (cmdName == NULL) {
+ if (nameCount == 1) {
+ ensembleFlags = TCL_ENSEMBLE_PREFIX;
+ cmdName = Tcl_DStringValue(&buf) + 5;
+ } else {
+ ns = ns->parentPtr;
+ cmdName = nameParts[nameCount - 1];
+ }
+ }
+
+ /*
+ * Switch on compilation always for core ensembles now that we can do
+ * nice bytecode things with them. Do it now. Waiting until later will
+ * just cause pointless epoch bumps.
+ */
+
+ ensembleFlags |= ENSEMBLE_COMPILE;
+ ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
+
+ /*
+ * Create the ensemble mapping dictionary and the ensemble command procs.
+ */
+
+ if (ensemble != NULL) {
+ Tcl_Obj *mapDict, *fromObj, *toObj;
+ Command *cmdPtr;
+
+ TclDStringAppendLiteral(&buf, "::");
+ TclNewObj(mapDict);
+ for (i=0 ; map[i].name != NULL ; i++) {
+ fromObj = Tcl_NewStringObj(map[i].name, -1);
+ TclNewStringObj(toObj, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf));
+ Tcl_AppendToObj(toObj, map[i].name, -1);
+ Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+
+ if (map[i].proc || map[i].nreProc) {
+ /*
+ * 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;
+ }
+ }
+ Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
+ }
+
+ Tcl_DStringFree(&buf);
+ Tcl_DStringFree(&hiddenBuf);
+ if (nameParts != NULL) {
+ ckfree((char *) nameParts);
+ }
+ return ensemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleImplementationCmd --
+ *
+ * Implements an ensemble of commands (being those exported by a
+ * namespace other than the global namespace) as a command with the same
+ * (short) name as the namespace in the parent namespace.
+ *
+ * Results:
+ * A standard Tcl result code. Will be TCL_ERROR if the command is not an
+ * unambiguous prefix of any command exported by the ensemble's
+ * namespace.
+ *
+ * Side effects:
+ * Depends on the command within the namespace that gets executed. If the
+ * ensemble itself returns TCL_ERROR, a descriptive error message will be
+ * placed in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleImplementationCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
+ clientData, objc, objv);
+}
+
+static int
+NsEnsembleImplementationCmdNR(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ EnsembleConfig *ensemblePtr = clientData;
+ /* The ensemble itself. */
+ Tcl_Obj *prefixObj; /* An object containing the prefix words of
+ * the command that implements the
+ * subcommand. */
+ Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully
+ * 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
+ * namespace-53.9.
+ */
+
+ restartEnsembleParse:
+ if (objc < 2 + ensemblePtr->numParameters) {
+ /*
+ * We don't have a subcommand argument. Make error message.
+ */
+
+ Tcl_DString buf; /* Message being built */
+ Tcl_Obj **elemPtrs; /* Parameter names */
+ int len; /* Number of parameters to append */
+
+ Tcl_DStringInit(&buf);
+ if (ensemblePtr->parameterList == NULL) {
+ len = 0;
+ } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
+ &len, &elemPtrs) != TCL_OK) {
+ Tcl_Panic("List of ensemble parameters is not a list");
+ }
+ for (; len>0; len--,elemPtrs++) {
+ TclDStringAppendObj(&buf, *elemPtrs);
+ TclDStringAppendLiteral(&buf, " ");
+ }
+ TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
+ Tcl_DStringFree(&buf);
+
+ return TCL_ERROR;
+ }
+
+ if (ensemblePtr->nsPtr->flags & NS_DYING) {
+ /*
+ * Don't know how we got here, but make things give up quickly.
+ */
+
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble activated for deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Determine if the table of subcommands is right. If so, we can just look
+ * up in there and go straight to dispatch.
+ */
+
+ if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
+ /*
+ * Table of subcommands is still valid; therefore there might be a
+ * valid cache of discovered information which we can reuse. Do the
+ * check here, and if we're still valid, we can jump straight to the
+ * part where we do the invocation of the subcommand.
+ */
+
+ if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
+ EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
+ ->internalRep.twoPtrValue.ptr1;
+
+ if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
+ ensembleCmd->epoch == ensemblePtr->epoch &&
+ ensembleCmd->token == ensemblePtr->token) {
+ prefixObj = ensembleCmd->realPrefixObj;
+ Tcl_IncrRefCount(prefixObj);
+ goto runResultingSubcommand;
+ }
+ }
+ } else {
+ BuildEnsembleConfig(ensemblePtr);
+ ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
+ }
+
+ /*
+ * Look in the hashtable for the subcommand name; this is the fastest way
+ * of all if there is no cache in operation.
+ */
+
+ hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
+ TclGetString(objv[1 + ensemblePtr->numParameters]));
+ if (hPtr != NULL) {
+ char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
+
+ prefixObj = Tcl_GetHashValue(hPtr);
+
+ /*
+ * Cache for later in the subcommand object.
+ */
+
+ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
+ ensemblePtr, fullName, prefixObj);
+ } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
+ /*
+ * Could not map, no prefixing, go to unknown/error handling.
+ */
+
+ goto unknownOrAmbiguousSubcommand;
+ } else {
+ /*
+ * If we've not already confirmed the command with the hash as part of
+ * building our export table, we need to scan the sorted array for
+ * matches.
+ */
+
+ const char *subcmdName; /* Name of the subcommand, or unique prefix of
+ * it (will be an error for a non-unique
+ * prefix). */
+ char *fullName = NULL; /* Full name of the subcommand. */
+ int stringLength, i;
+ int tableLength = ensemblePtr->subcommandTable.numEntries;
+
+ subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]);
+ stringLength = objv[1 + ensemblePtr->numParameters]->length;
+ for (i=0 ; i<tableLength ; i++) {
+ register int cmp = strncmp(subcmdName,
+ ensemblePtr->subcommandArrayPtr[i],
+ (unsigned) stringLength);
+
+ if (cmp == 0) {
+ if (fullName != NULL) {
+ /*
+ * Since there's never the exact-match case to worry about
+ * (hash search filters this), getting here indicates that
+ * our subcommand is an ambiguous prefix of (at least) two
+ * exported subcommands, which is an error case.
+ */
+
+ goto unknownOrAmbiguousSubcommand;
+ }
+ fullName = ensemblePtr->subcommandArrayPtr[i];
+ } else if (cmp < 0) {
+ /*
+ * Because we are searching a sorted table, we can now stop
+ * searching because we have gone past anything that could
+ * possibly match.
+ */
+
+ break;
+ }
+ }
+ if (fullName == NULL) {
+ /*
+ * The subcommand is not a prefix of anything, so bail out!
+ */
+
+ goto unknownOrAmbiguousSubcommand;
+ }
+ hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
+ if (hPtr == NULL) {
+ Tcl_Panic("full name %s not found in supposedly synchronized hash",
+ fullName);
+ }
+ prefixObj = Tcl_GetHashValue(hPtr);
+
+ /*
+ * Cache for later in the subcommand object.
+ */
+
+ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
+ ensemblePtr, fullName, prefixObj);
+ }
+
+ Tcl_IncrRefCount(prefixObj);
+ runResultingSubcommand:
+
+ /*
+ * Do the real work of execution of the subcommand by building an array of
+ * objects (note that this is potentially not the same length as the
+ * number of arguments to this ensemble command), populating it and then
+ * feeding it back through the main command-lookup engine. In theory, we
+ * could look up the command in the namespace ourselves, as we already
+ * have the namespace in which it is guaranteed to exist,
+ *
+ * ((Q: That's not true if the -map option is used, is it?))
+ *
+ * but we don't do that (the cacheing of the command object used should
+ * help with that.)
+ */
+
+ {
+ Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
+ * target command prefix. */
+ Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
+ * Will be freed by the dispatch engine. */
+ int prefixObjc, copyObjc;
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * Get the prefix that we're rewriting to. To do this we need to
+ * ensure that the internal representation of the list does not change
+ * so that we can safely keep the internal representations of the
+ * elements in the list.
+ *
+ * TODO: Use conventional list operations to make this code sane!
+ */
+
+ TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
+
+ copyObjc = objc - 2 + prefixObjc;
+ copyPtr = Tcl_NewListObj(copyObjc, NULL);
+ if (copyObjc > 0) {
+ register Tcl_Obj **copyObjv;
+ /* Space used to construct the list of
+ * arguments to pass to the command that
+ * implements the ensemble subcommand. */
+ register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ register int i;
+
+ listRepPtr->elemCount = copyObjc;
+ copyObjv = &listRepPtr->elements;
+ memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
+ memcpy(copyObjv+prefixObjc, objv+1,
+ sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
+ memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
+ objv+ensemblePtr->numParameters+2,
+ sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
+
+ for (i=0; i < copyObjc; i++) {
+ Tcl_IncrRefCount(copyObjv[i]);
+ }
+ }
+ TclDecrRefCount(prefixObj);
+
+ /*
+ * Record what arguments the script sent in so that things like
+ * Tcl_WrongNumArgs can give the correct error message. Parameters
+ * count both as inserted and removed arguments.
+ */
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs =
+ 2 + ensemblePtr->numParameters;
+ iPtr->ensembleRewrite.numInsertedObjs =
+ prefixObjc + ensemblePtr->numParameters;
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+ NULL);
+ } else {
+ register int ni = 2 + ensemblePtr->numParameters
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ /* Position in objv of new front of insertion
+ * relative to old one. */
+ if (ni > 0) {
+ iPtr->ensembleRewrite.numRemovedObjs += ni;
+ iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
+ }
+ }
+
+ /*
+ * Hand off to the target command.
+ */
+
+ TclSkipTailcall(interp);
+ return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+ }
+
+ unknownOrAmbiguousSubcommand:
+ /*
+ * Have not been able to match the subcommand asked for with a real
+ * subcommand that we export. See whether a handler has been registered
+ * for dealing with this situation. Will only call (at most) once for any
+ * particular ensemble invocation.
+ */
+
+ if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
+ switch (EnsembleUnknownCallback(interp, ensemblePtr, objc, objv,
+ &prefixObj)) {
+ case TCL_OK:
+ goto runResultingSubcommand;
+ case TCL_ERROR:
+ return TCL_ERROR;
+ case TCL_CONTINUE:
+ goto restartEnsembleParse;
+ }
+ }
+
+ /*
+ * We cannot determine what subcommand to hand off to, so generate a
+ * (standard) failure message. Note the one odd case compared with
+ * standard ensemble-like command, which is where a namespace has no
+ * exported commands at all...
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
+ TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ if (ensemblePtr->subcommandTable.numEntries == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown subcommand \"%s\": namespace %s does not"
+ " export any commands",
+ TclGetString(objv[1+ensemblePtr->numParameters]),
+ ensemblePtr->nsPtr->fullName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
+ TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ return TCL_ERROR;
+ }
+ 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_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
+ } else {
+ int i;
+
+ for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
+ Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
+ Tcl_AppendToObj(errorObj, ", ", 2);
+ }
+ Tcl_AppendPrintfToObj(errorObj, "or %s",
+ ensemblePtr->subcommandArrayPtr[i]);
+ }
+ Tcl_SetObjResult(interp, errorObj);
+ return TCL_ERROR;
+}
+
+int
+TclClearRootEnsemble(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ TclResetRewriteEnsemble(interp, 1);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitRewriteEnsemble --
+ *
+ * Applies a rewrite of arguments so that an ensemble subcommand will
+ * report error messages correctly for the overall command.
+ *
+ * Results:
+ * Whether this is the first rewrite applied, a value which must be
+ * passed to TclResetRewriteEnsemble when undoing this command's
+ * behaviour.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInitRewriteEnsemble(
+ Tcl_Interp *interp,
+ int numRemoved,
+ int numInserted,
+ Tcl_Obj *const *objv)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
+ iPtr->ensembleRewrite.numInsertedObjs = numInserted;
+ } else {
+ int numIns = iPtr->ensembleRewrite.numInsertedObjs;
+
+ if (numIns < numRemoved) {
+ iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
+ iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
+ }
+ }
+ return isRootEnsemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclResetRewriteEnsemble --
+ *
+ * Removes any rewrites applied to support proper reporting of error
+ * messages used in ensembles. Should be paired with
+ * TclInitRewriteEnsemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclResetRewriteEnsemble(
+ Tcl_Interp *interp,
+ int isRootEnsemble)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * EnsmebleUnknownCallback --
+ *
+ * Helper for the ensemble engine that handles the procesing of unknown
+ * callbacks. See the user documentation of the ensemble unknown handler
+ * for details; this function is only ever called when such a function is
+ * defined, and is only ever called once per ensemble dispatch (i.e. if a
+ * reparse still fails, this isn't called again).
+ *
+ * Results:
+ * TCL_OK - *prefixObjPtr contains the command words to dispatch
+ * to.
+ * TCL_CONTINUE - Need to reparse (*prefixObjPtr is invalid).
+ * TCL_ERROR - Something went wrong! Error message in interpreter.
+ *
+ * Side effects:
+ * Calls the Tcl interpreter, so arbitrary.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+EnsembleUnknownCallback(
+ Tcl_Interp *interp,
+ EnsembleConfig *ensemblePtr,
+ int objc,
+ Tcl_Obj *const objv[],
+ Tcl_Obj **prefixObjPtr)
+{
+ int paramc, i, result, prefixObjc;
+ Tcl_Obj **paramv, *unknownCmd, *ensObj;
+
+ /*
+ * Create the unknown command callback to determine what to do.
+ */
+
+ unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
+ TclNewObj(ensObj);
+ Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
+ Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
+ for (i=1 ; i<objc ; i++) {
+ Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
+ }
+ TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
+ Tcl_IncrRefCount(unknownCmd);
+
+ /*
+ * Now call the unknown handler. (We don't bother NRE-enabling this; deep
+ * recursing through unknown handlers is horribly perverse.) Note that it
+ * is always an error for an unknown handler to delete its ensemble; don't
+ * do that!
+ */
+
+ Tcl_Preserve(ensemblePtr);
+ TclSkipTailcall(interp);
+ result = Tcl_EvalObjv(interp, paramc, paramv, 0);
+ if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
+ 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);
+
+ /*
+ * If we succeeded, we should either have a list of words that form the
+ * command to be executed, or an empty list. In the empty-list case, the
+ * ensemble is believed to be updated so we should ask the ensemble engine
+ * to reparse the original command.
+ */
+
+ if (result == TCL_OK) {
+ *prefixObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(*prefixObjPtr);
+ TclDecrRefCount(unknownCmd);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Namespace is still there. Check if the result is a valid list. If
+ * it is, and it is non-empty, that list is what we are using as our
+ * replacement.
+ */
+
+ if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) {
+ TclDecrRefCount(*prefixObjPtr);
+ Tcl_AddErrorInfo(interp, "\n while parsing result of "
+ "ensemble unknown subcommand handler");
+ return TCL_ERROR;
+ }
+ if (prefixObjc > 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Namespace alive & empty result => reparse.
+ */
+
+ TclDecrRefCount(*prefixObjPtr);
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Oh no! An exceptional result. Convert to an error.
+ */
+
+ if (!Tcl_InterpDeleted(interp)) {
+ if (result != TCL_ERROR) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown subcommand handler returned bad code: ", -1));
+ switch (result) {
+ case TCL_RETURN:
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
+ break;
+ case TCL_BREAK:
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
+ break;
+ case TCL_CONTINUE:
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
+ break;
+ default:
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
+ }
+ Tcl_AddErrorInfo(interp, "\n result of "
+ "ensemble unknown subcommand handler: ");
+ Tcl_AppendObjToErrorInfo(interp, unknownCmd);
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
+ NULL);
+ } else {
+ Tcl_AddErrorInfo(interp,
+ "\n (ensemble unknown subcommand handler)");
+ }
+ }
+ TclDecrRefCount(unknownCmd);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeCachedEnsembleCommand --
+ *
+ * Cache what we've computed so far; it's not nice to repeatedly copy
+ * strings about. Note that to do this, we start by deleting any old
+ * representation that there was (though if it was an out of date
+ * ensemble rep, we can skip some of the deallocation process.)
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Alters the internal representation of the first object parameter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MakeCachedEnsembleCommand(
+ Tcl_Obj *objPtr,
+ EnsembleConfig *ensemblePtr,
+ const char *subcommandName,
+ Tcl_Obj *prefixObjPtr)
+{
+ register EnsembleCmdRep *ensembleCmd;
+ int length;
+
+ if (objPtr->typePtr == &tclEnsembleCmdType) {
+ ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
+ TclNsDecrRefCount(ensembleCmd->nsPtr);
+ ckfree(ensembleCmd->fullSubcmdName);
+ } else {
+ /*
+ * Kill the old internal rep, and replace it with a brand new one of
+ * our own.
+ */
+
+ TclFreeIntRep(objPtr);
+ ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
+ objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
+ objPtr->typePtr = &tclEnsembleCmdType;
+ }
+
+ /*
+ * Populate the internal rep.
+ */
+
+ ensembleCmd->nsPtr = ensemblePtr->nsPtr;
+ ensembleCmd->epoch = ensemblePtr->epoch;
+ ensembleCmd->token = ensemblePtr->token;
+ ensemblePtr->nsPtr->refCount++;
+ ensembleCmd->realPrefixObj = prefixObjPtr;
+ length = strlen(subcommandName)+1;
+ ensembleCmd->fullSubcmdName = ckalloc(length);
+ memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
+ Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsembleConfig --
+ *
+ * Destroys the data structure used to represent an ensemble. This is
+ * called when the ensemble's command is deleted (which happens
+ * automatically if the ensemble's namespace is deleted.) Maintainers
+ * should note that ensembles should be deleted by deleting their
+ * commands.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is (eventually) deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteEnsembleConfig(
+ ClientData clientData)
+{
+ EnsembleConfig *ensemblePtr = clientData;
+ Namespace *nsPtr = ensemblePtr->nsPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hEnt;
+
+ /*
+ * Unlink from the ensemble chain if it has not been marked as having been
+ * done already.
+ */
+
+ if (ensemblePtr->next != ensemblePtr) {
+ EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;
+
+ if (ensPtr == ensemblePtr) {
+ nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
+ } else {
+ while (ensPtr != NULL) {
+ if (ensPtr->next == ensemblePtr) {
+ ensPtr->next = ensemblePtr->next;
+ break;
+ }
+ ensPtr = ensPtr->next;
+ }
+ }
+ }
+
+ /*
+ * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
+ * whether disaster happened anyway.
+ */
+
+ ensemblePtr->flags |= ENSEMBLE_DEAD;
+
+ /*
+ * Kill the pointer-containing fields.
+ */
+
+ if (ensemblePtr->subcommandTable.numEntries != 0) {
+ ckfree(ensemblePtr->subcommandArrayPtr);
+ }
+ hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
+ while (hEnt != NULL) {
+ Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
+
+ Tcl_DecrRefCount(prefixObj);
+ hEnt = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
+ if (ensemblePtr->subcmdList != NULL) {
+ Tcl_DecrRefCount(ensemblePtr->subcmdList);
+ }
+ if (ensemblePtr->parameterList != NULL) {
+ Tcl_DecrRefCount(ensemblePtr->parameterList);
+ }
+ if (ensemblePtr->subcommandDict != NULL) {
+ Tcl_DecrRefCount(ensemblePtr->subcommandDict);
+ }
+ if (ensemblePtr->unknownHandler != NULL) {
+ Tcl_DecrRefCount(ensemblePtr->unknownHandler);
+ }
+
+ /*
+ * Arrange for the structure to be reclaimed. Note that this is complex
+ * because we have to make sure that we can react sensibly when an
+ * ensemble is deleted during the process of initialising the ensemble
+ * (especially the unknown callback.)
+ */
+
+ Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildEnsembleConfig --
+ *
+ * Create the internal data structures that describe how an ensemble
+ * looks, being a hash mapping from the full command name to the Tcl list
+ * that describes the implementation prefix words, and a sorted array of
+ * all the full command names to allow for reasonably efficient
+ * unambiguous prefix handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Reallocates and rebuilds the hash table and array stored at the
+ * ensemblePtr argument. For large ensembles or large namespaces, this is
+ * a potentially expensive operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BuildEnsembleConfig(
+ EnsembleConfig *ensemblePtr)
+{
+ Tcl_HashSearch search; /* Used for scanning the set of commands in
+ * the namespace that backs up this
+ * ensemble. */
+ int i, j, isNew;
+ Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
+ Tcl_HashEntry *hPtr;
+
+ if (hash->numEntries != 0) {
+ /*
+ * Remove pre-existing table.
+ */
+
+ ckfree(ensemblePtr->subcommandArrayPtr);
+ hPtr = Tcl_FirstHashEntry(hash, &search);
+ while (hPtr != NULL) {
+ Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
+
+ Tcl_DecrRefCount(prefixObj);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(hash);
+ Tcl_InitHashTable(hash, TCL_STRING_KEYS);
+ }
+
+ /*
+ * See if we've got an export list. If so, we will only export exactly
+ * those commands, which may be either implemented by the prefix in the
+ * subcommandDict or mapped directly onto the namespace's commands.
+ */
+
+ if (ensemblePtr->subcmdList != NULL) {
+ Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
+ int subcmdc;
+
+ TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
+ &subcmdv);
+ for (i=0 ; i<subcmdc ; i++) {
+ const char *name = TclGetString(subcmdv[i]);
+
+ hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+
+ /*
+ * Skip non-unique cases.
+ */
+
+ if (!isNew) {
+ continue;
+ }
+
+ /*
+ * Look in our dictionary (if present) for the command.
+ */
+
+ if (ensemblePtr->subcommandDict != NULL) {
+ Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
+ &target);
+ if (target != NULL) {
+ Tcl_SetHashValue(hPtr, target);
+ Tcl_IncrRefCount(target);
+ continue;
+ }
+ }
+
+ /*
+ * Not there, so map onto the namespace. Note in this case that we
+ * do not guarantee that the command is actually there; that is
+ * the programmer's responsibility (or [::unknown] of course).
+ */
+
+ cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
+ if (ensemblePtr->nsPtr->parentPtr != NULL) {
+ Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+ } else {
+ Tcl_AppendStringsToObj(cmdObj, name, NULL);
+ }
+ cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+ Tcl_SetHashValue(hPtr, cmdPrefixObj);
+ Tcl_IncrRefCount(cmdPrefixObj);
+ }
+ } else if (ensemblePtr->subcommandDict != NULL) {
+ /*
+ * No subcmd list, but we do have a mapping dictionary so we should
+ * use the keys of that. Convert the dictionary's contents into the
+ * form required for the ensemble's internal hashtable.
+ */
+
+ Tcl_DictSearch dictSearch;
+ Tcl_Obj *keyObj, *valueObj;
+ int done;
+
+ Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
+ &keyObj, &valueObj, &done);
+ while (!done) {
+ const char *name = TclGetString(keyObj);
+
+ hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+ Tcl_SetHashValue(hPtr, valueObj);
+ Tcl_IncrRefCount(valueObj);
+ Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
+ }
+ } else {
+ /*
+ * Discover what commands are actually exported by the namespace.
+ * What we have is an array of patterns and a hash table whose keys
+ * are the command names exported by the namespace (the contents do
+ * not matter here.) We must find out what commands are actually
+ * exported by filtering each command in the namespace against each of
+ * the patterns in the export list. Note that we use an intermediate
+ * hash table to make memory management easier, and because that makes
+ * exact matching far easier too.
+ *
+ * Suggestion for future enhancement: compute the unique prefixes and
+ * place them in the hash too, which should make for even faster
+ * matching.
+ */
+
+ hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
+ for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
+ char *nsCmdName = /* Name of command in namespace. */
+ Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
+
+ for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
+ if (Tcl_StringMatch(nsCmdName,
+ ensemblePtr->nsPtr->exportArrayPtr[i])) {
+ hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
+
+ /*
+ * Remember, hash entries have a full reference to the
+ * substituted part of the command (as a list) as their
+ * content!
+ */
+
+ if (isNew) {
+ Tcl_Obj *cmdObj, *cmdPrefixObj;
+
+ TclNewObj(cmdObj);
+ Tcl_AppendStringsToObj(cmdObj,
+ ensemblePtr->nsPtr->fullName,
+ (ensemblePtr->nsPtr->parentPtr ? "::" : ""),
+ nsCmdName, NULL);
+ cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+ Tcl_SetHashValue(hPtr, cmdPrefixObj);
+ Tcl_IncrRefCount(cmdPrefixObj);
+ }
+ break;
+ }
+ }
+ }
+ }
+
+ if (hash->numEntries == 0) {
+ ensemblePtr->subcommandArrayPtr = NULL;
+ return;
+ }
+
+ /*
+ * Create a sorted array of all subcommands in the ensemble; hash tables
+ * are all very well for a quick look for an exact match, but they can't
+ * determine things like whether a string is a prefix of another (not
+ * without lots of preparation anyway) and they're no good for when we're
+ * generating the error message either.
+ *
+ * We do this by filling an array with the names (we use the hash keys
+ * directly to save a copy, since any time we change the array we change
+ * the hash too, and vice versa) and running quicksort over the array.
+ */
+
+ ensemblePtr->subcommandArrayPtr =
+ ckalloc(sizeof(char *) * hash->numEntries);
+
+ /*
+ * Fill array from both ends as this makes us less likely to end up with
+ * performance problems in qsort(), which is good. Note that doing this
+ * makes this code much more opaque, but the naive alternatve:
+ *
+ * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
+ * hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
+ * ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
+ * }
+ *
+ * can produce long runs of precisely ordered table entries when the
+ * commands in the namespace are declared in a sorted fashion (an ordering
+ * some people like) and the hashing functions (or the command names
+ * themselves) are fairly unfortunate. By filling from both ends, it
+ * requires active malice (and probably a debugger) to get qsort() to have
+ * awful runtime behaviour.
+ */
+
+ i = 0;
+ j = hash->numEntries;
+ hPtr = Tcl_FirstHashEntry(hash, &search);
+ while (hPtr != NULL) {
+ ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ if (hPtr == NULL) {
+ break;
+ }
+ ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ if (hash->numEntries > 1) {
+ qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries,
+ sizeof(char *), NsEnsembleStringOrder);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleStringOrder --
+ *
+ * Helper function to compare two pointers to two strings for use with
+ * qsort().
+ *
+ * Results:
+ * -1 if the first string is smaller, 1 if the second string is smaller,
+ * and 0 if they are equal.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleStringOrder(
+ const void *strPtr1,
+ const void *strPtr2)
+{
+ return strcmp(*(const char **)strPtr1, *(const char **)strPtr2);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEnsembleCmdRep --
+ *
+ * Destroys the internal representation of a Tcl_Obj that has been
+ * holding information about a command in an ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is deallocated. If this held the last reference to a
+ * namespace's main structure, that main structure will also be
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeEnsembleCmdRep(
+ Tcl_Obj *objPtr)
+{
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+
+ Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
+ ckfree(ensembleCmd->fullSubcmdName);
+ TclNsDecrRefCount(ensembleCmd->nsPtr);
+ ckfree(ensembleCmd);
+ objPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEnsembleCmdRep --
+ *
+ * Makes one Tcl_Obj into a copy of another that is a subcommand of an
+ * ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is allocated, and the namespace that the ensemble is built on
+ * top of gains another reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupEnsembleCmdRep(
+ Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr)
+{
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
+ int length = strlen(ensembleCmd->fullSubcmdName);
+
+ copyPtr->typePtr = &tclEnsembleCmdType;
+ copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+ ensembleCopy->nsPtr = ensembleCmd->nsPtr;
+ ensembleCopy->epoch = ensembleCmd->epoch;
+ ensembleCopy->token = ensembleCmd->token;
+ ensembleCopy->nsPtr->refCount++;
+ ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
+ Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
+ ensembleCopy->fullSubcmdName = ckalloc(length + 1);
+ memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
+ (unsigned) length+1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringOfEnsembleCmdRep --
+ *
+ * Creates a string representation of a Tcl_Obj that holds a subcommand
+ * of an ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object gains a string (UTF-8) representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StringOfEnsembleCmdRep(
+ Tcl_Obj *objPtr)
+{
+ EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ int length = strlen(ensembleCmd->fullSubcmdName);
+
+ objPtr->length = length;
+ objPtr->bytes = ckalloc(length + 1);
+ memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileEnsemble --
+ *
+ * Procedure called to compile an ensemble command. Note that most
+ * ensembles are not compiled, since modifying a compiled ensemble causes
+ * a invalidation of all existing bytecode (expensive!) which is not
+ * normally warranted.
+ *
+ * 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 subcommands of the
+ * ensemble at runtime if a compile-time mapping is possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileEnsemble(
+ 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);
+ Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+ Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
+ Tcl_Command ensemble = (Tcl_Command) cmdPtr;
+ Command *oldCmdPtr = cmdPtr, *newCmdPtr;
+ int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
+ int ourResult = TCL_ERROR;
+ unsigned numBytes;
+ const char *word;
+
+ Tcl_IncrRefCount(replaced);
+
+ /*
+ * This is where we return to if we are parsing multiple nested compiled
+ * ensembles. [info object] is such a beast.
+ */
+
+ checkNextWord:
+ if (parsePtr->numWords < depth + 1) {
+ goto failed;
+ }
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Too hard.
+ */
+
+ goto failed;
+ }
+
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+
+ /*
+ * There's a sporting chance we'll be able to compile this. But now we
+ * must check properly. To do that, check that we're compiling an ensemble
+ * that has a compilable command as its appropriate subcommand.
+ */
+
+ if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
+ || mapObj == NULL) {
+ /*
+ * Either not an ensemble or a mapping isn't installed. Crud. Too hard
+ * to proceed.
+ */
+
+ goto failed;
+ }
+
+ /*
+ * Also refuse to compile anything that uses a formal parameter list for
+ * now, on the grounds that it is too complex.
+ */
+
+ if (Tcl_GetEnsembleParameterList(NULL, ensemble, &listObj) != TCL_OK
+ || listObj != NULL) {
+ /*
+ * Figuring out how to compile this has become too much. Bail out.
+ */
+
+ goto failed;
+ }
+
+ /*
+ * Next, get the flags. We need them on several code paths so that we can
+ * know whether we're to do prefix matching.
+ */
+
+ (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);
+
+ /*
+ * Check to see if there's also a subcommand list; must check to see if
+ * the subcommand we are calling is in that list if it exists, since that
+ * list filters the entries in the map.
+ */
+
+ (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
+ if (listObj != NULL) {
+ int sclen;
+ const char *str;
+ Tcl_Obj *matchObj = NULL;
+
+ if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
+ goto failed;
+ }
+ for (i=0 ; i<len ; i++) {
+ str = Tcl_GetStringFromObj(elems[i], &sclen);
+ if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
+ /*
+ * Exact match! Excellent!
+ */
+
+ result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
+ if (result != TCL_OK || targetCmdObj == NULL) {
+ goto failed;
+ }
+ replacement = elems[i];
+ goto doneMapLookup;
+ }
+
+ /*
+ * Check to see if we've got a prefix match. A single prefix match
+ * is fine, and allows us to refine our dictionary lookup, but
+ * multiple prefix matches is a Bad Thing and will prevent us from
+ * making progress. Note that we cannot do the lookup immediately
+ * in the prefix case; might be another entry later in the list
+ * that causes things to fail.
+ */
+
+ if ((flags & TCL_ENSEMBLE_PREFIX)
+ && strncmp(word, str, numBytes) == 0) {
+ if (matchObj != NULL) {
+ goto failed;
+ }
+ matchObj = elems[i];
+ }
+ }
+ if (matchObj == NULL) {
+ goto failed;
+ }
+ result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
+ if (result != TCL_OK || targetCmdObj == NULL) {
+ goto failed;
+ }
+ replacement = matchObj;
+ } else {
+ Tcl_DictSearch s;
+ int done, matched;
+ Tcl_Obj *tmpObj;
+
+ /*
+ * No map, so check the dictionary directly.
+ */
+
+ TclNewStringObj(subcmdObj, word, (int) numBytes);
+ result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
+ if (result == TCL_OK && targetCmdObj != NULL) {
+ /*
+ * Got it. Skip the fiddling around with prefixes.
+ */
+
+ replacement = subcmdObj;
+ goto doneMapLookup;
+ }
+ TclDecrRefCount(subcmdObj);
+
+ /*
+ * We've not literally got a valid subcommand. But maybe we have a
+ * prefix. Check if prefix matches are allowed.
+ */
+
+ if (!(flags & TCL_ENSEMBLE_PREFIX)) {
+ goto failed;
+ }
+
+ /*
+ * Iterate over the keys in the dictionary, checking to see if we're a
+ * prefix.
+ */
+
+ Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done);
+ matched = 0;
+ replacement = NULL; /* Silence, fool compiler! */
+ while (!done) {
+ if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
+ if (matched++) {
+ /*
+ * Must have matched twice! Not unique, so no point
+ * looking further.
+ */
+
+ break;
+ }
+ replacement = subcmdObj;
+ targetCmdObj = tmpObj;
+ }
+ Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
+ }
+ Tcl_DictObjDone(&s);
+
+ /*
+ * If we have anything other than a single match, we've failed the
+ * unique prefix check.
+ */
+
+ if (matched != 1) {
+ invokeAnyway = 1;
+ goto failed;
+ }
+ }
+
+ /*
+ * OK, we definitely map to something. But what?
+ *
+ * The command we map to is the first word out of the map element. Note
+ * that we also reject dealing with multi-element rewrites if we are in a
+ * safe interpreter, as there is otherwise a (highly gnarly!) way to make
+ * Tcl crash open to exploit.
+ */
+
+ doneMapLookup:
+ Tcl_ListObjAppendElement(NULL, replaced, replacement);
+ if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
+ goto failed;
+ } else if (len != 1) {
+ /*
+ * Note that at this point we know we can't issue any special
+ * instruction sequence as the mapping isn't one that we support at
+ * the compiled level.
+ */
+
+ goto cleanup;
+ }
+ targetCmdObj = elems[0];
+
+ oldCmdPtr = cmdPtr;
+ Tcl_IncrRefCount(targetCmdObj);
+ newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+ TclDecrRefCount(targetCmdObj);
+ if (newCmdPtr == NULL || Tcl_IsSafe(interp)
+ || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
+ || newCmdPtr->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.
+ */
+
+ goto cleanup;
+ }
+ cmdPtr = newCmdPtr;
+ depth++;
+
+ /*
+ * See whether we have a nested ensemble. If we do, we can go round the
+ * mulberry bush again, consuming the next word.
+ */
+
+ if (cmdPtr->compileProc == TclCompileEnsemble) {
+ tokenPtr = TokenAfter(tokenPtr);
+ ensemble = (Tcl_Command) cmdPtr;
+ goto checkNextWord;
+ }
+
+ /*
+ * Now we've done the mapping process, can now actually try to compile.
+ * If there is a subcommand compiler and that successfully produces code,
+ * we'll use that. Otherwise, we fall back to generating opcodes to do the
+ * invoke at runtime.
+ */
+
+ invokeAnyway = 1;
+ if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
+ envPtr)) {
+ ourResult = TCL_OK;
+ goto cleanup;
+ }
+
+ /*
+ * Failed to do a full compile for some reason. Try to do a direct invoke
+ * instead of going through the ensemble lookup process again.
+ */
+
+ failed:
+ if (depth < 250) {
+ if (depth > 1) {
+ if (!invokeAnyway) {
+ cmdPtr = oldCmdPtr;
+ depth--;
+ }
+ (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
+ }
+ CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
+ ourResult = TCL_OK;
+ }
+
+ /*
+ * Release the memory we allocated. If we've got here, we've either done
+ * something useful or we're in a case that we can't compile at all and
+ * we're just giving up.
+ */
+
+ cleanup:
+ Tcl_DecrRefCount(replaced);
+ return ourResult;
+}
+
+int
+TclAttemptCompileProc(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ int depth,
+ Command *cmdPtr,
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ int result, i;
+ Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
+ int savedStackDepth = envPtr->currStackDepth;
+ unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+ DefineLineInformation;
+
+ if (cmdPtr->compileProc == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Advance parsePtr->tokenPtr so that it points at the last subcommand.
+ * This will be wrong, but it will not matter, and it will put the
+ * tokens for the arguments in the right place without the needed to
+ * allocate a synthetic Tcl_Parse struct, or copy tokens around.
+ */
+
+ for (i = 0; i < depth - 1; i++) {
+ parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ }
+ parsePtr->numWords -= (depth - 1);
+
+ /*
+ * Shift the line information arrays to account for different word
+ * index values.
+ */
+
+ mapPtr->loc[eclIndex].line += (depth - 1);
+ mapPtr->loc[eclIndex].next += (depth - 1);
+
+ /*
+ * Hand off compilation to the subcommand compiler. At last!
+ */
+
+ result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
+
+ /*
+ * Undo the shift.
+ */
+
+ mapPtr->loc[eclIndex].line -= (depth - 1);
+ mapPtr->loc[eclIndex].next -= (depth - 1);
+
+ parsePtr->numWords += (depth - 1);
+ parsePtr->tokenPtr = saveTokenPtr;
+
+ /*
+ * If our target failed to compile, revert any data from failed partial
+ * compiles. Note that envPtr->numCommands need not be checked because
+ * we avoid compiling subcommands that recursively call TclCompileScript().
+ */
+
+ if (result != TCL_OK) {
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+#ifdef TCL_COMPILE_DEBUG
+ } else {
+ /*
+ * 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.
+ */
+
+ int diff = envPtr->currStackDepth - savedStackDepth;
+
+ if (diff != 1) {
+ Tcl_Panic("bad stack adjustment when compiling"
+ " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+ parsePtr->tokenPtr->start, diff);
+ }
+#endif
+ }
+
+ return result;
+}
+
+/*
+ * How to compile a subcommand to a _replacing_ invoke of its implementation
+ * command.
+ */
+
+static void
+CompileToInvokedCommand(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Tcl_Obj *replacements,
+ Command *cmdPtr,
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokPtr;
+ Tcl_Obj *objPtr, **words;
+ char *bytes;
+ int length, i, numWords, cmdLit;
+ DefineLineInformation;
+
+ /*
+ * Push the words of the command. Take care; the command words may be
+ * scripts that have backslashes in them, and [info frame 0] can see the
+ * difference. Hence the call to TclContinuationsEnterDerived...
+ */
+
+ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
+ for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
+ i++, tokPtr = TokenAfter(tokPtr)) {
+ if (i > 0 && i < numWords+1) {
+ bytes = Tcl_GetStringFromObj(words[i-1], &length);
+ PushLiteral(envPtr, bytes, length);
+ continue;
+ }
+
+ SetLineInformation(i);
+ if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ int literal = TclRegisterNewLiteral(envPtr,
+ tokPtr[1].start, tokPtr[1].size);
+
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(
+ TclFetchLiteral(envPtr, literal),
+ tokPtr[1].start - envPtr->source,
+ envPtr->clNext);
+ }
+ TclEmitPush(literal, envPtr);
+ } else {
+ CompileTokens(envPtr, tokPtr, interp);
+ }
+ }
+
+ /*
+ * Push the name of the command we're actually dispatching to as part of
+ * the implementation.
+ */
+
+ objPtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
+ TclEmitPush(cmdLit, envPtr);
+ TclDecrRefCount(objPtr);
+
+ /*
+ * Do the replacing dispatch.
+ */
+
+ TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1);
+}
+
+/*
+ * Helpers that do issuing of instructions for commands that "don't have
+ * compilers" (well, they do; these). They all work by just generating base
+ * code to invoke the command; they're intended for ensemble subcommands so
+ * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out
+ * that they're not needed.
+ *
+ * Note that these are NOT suitable for commands where there's an argument
+ * that is a script, as an [info level] or [info frame] in the inner context
+ * can see the difference.
+ */
+
+static int
+CompileBasicNArgCommand(
+ 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_Obj *objPtr = Tcl_NewObj();
+
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
+ parsePtr->numWords, envPtr);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileBasic0ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 1) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0Or1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 1 && parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1Or2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2Or3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0To2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 1 || parsePtr->numWords > 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1To3ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin0ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 1) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin1ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin2ArgCmd(
+ 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. */
+{
+ /*
+ * Verify that the number of arguments is correct; that's the only case
+ * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+ * which is the only code that sees the shenanigans of ensemble dispatch.
+ */
+
+ if (parsePtr->numWords < 3) {
+ return TCL_ERROR;
+ }
+
+ return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 287a3a8..cd1a954 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -11,50 +11,42 @@
*
* 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.25 2005/07/21 14:38:31 dkf Exp $
*/
#include "tclInt.h"
-TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */
+TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
-static int cacheSize = 0; /* Number of env strings in environCache. */
-static char **environCache = NULL;
- /* Array containing all of the environment
+static struct {
+ int cacheSize; /* Number of env strings in cache. */
+ char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
-
#ifndef USE_PUTENV
-static int environSize = 0; /* Non-zero means that the environ array was
+ char **ourEnviron; /* Cache of the array that we allocate. We
+ * need to track this in case another
+ * subsystem swaps around the environ array
+ * like we do. */
+ int ourEnvironSize; /* Non-zero means that the environ array was
* malloced and has this many total entries
* allocated to it (not all may be in use at
- * once). Zero means that the environment
+ * once). Zero means that the environment
* array is in its original static state. */
#endif
-
-/*
- * For MacOS X
- */
-#if defined(__APPLE__) && defined(__DYNAMIC__)
-#include <crt_externs.h>
-char **environ = NULL;
-#endif
+} env;
/*
* Declarations for local functions defined in this file:
*/
-static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
-static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
- char *newStr));
-void TclSetEnv _ANSI_ARGS_((CONST char *name,
- CONST char *value));
-void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
-
-#if defined (__CYGWIN__) && defined(__WIN32__)
-static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
+static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
+ const char *name1, const char *name2, int flags);
+static void ReplaceString(const char *oldStr, char *newStr);
+MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
+MODULE_SCOPE void TclUnsetEnv(const char *name);
+
+#if defined(__CYGWIN__)
+ static void TclCygwinPutenv(char *string);
+# define putenv TclCygwinPutenv
#endif
/*
@@ -72,7 +64,7 @@ static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
* Side effects:
* The interpreter is added to a list of interpreters managed by us, so
* that its view of envariables can be kept consistent with the view in
- * other interpreters. If this is the first call to TclSetupEnv, then
+ * other interpreters. If this is the first call to TclSetupEnv, then
* additional initialization happens, such as copying the environment to
* dynamically-allocated space for ease of management.
*
@@ -80,70 +72,111 @@ static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
*/
void
-TclSetupEnv(interp)
- Tcl_Interp *interp; /* Interpreter whose "env" array is to be
+TclSetupEnv(
+ Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNamePtr;
Tcl_DString envString;
- char *p1, *p2;
- int i;
+ Tcl_HashTable namesHash;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
/*
- * For MacOS X
+ * Synchronize the values in the environ array with the contents of the
+ * Tcl "env" variable. To do this:
+ * 1) Remove the trace that fires when the "env" var is updated.
+ * 2) Find the existing contents of the "env", storing in a hash table.
+ * 3) Create/update elements for each environ variable, removing
+ * elements from the hash table as we go.
+ * 4) Remove the elements for each remaining entry in the hash table,
+ * which must have existed before yet have no analog in the environ
+ * variable.
+ * 5) Add a trace that synchronizes the "env" array.
*/
-#if defined(__APPLE__) && defined(__DYNAMIC__)
- environ = *_NSGetEnviron();
-#endif
+
+ Tcl_UntraceVar2(interp, "env", NULL,
+ TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
/*
- * Synchronize the values in the environ array with the contents of the
- * Tcl "env" variable. To do this:
- * 1) Remove the trace that fires when the "env" var is unset.
- * 2) Unset the "env" variable.
- * 3) If there are no environ variables, create an empty "env" array.
- * Otherwise populate the array with current values.
- * 4) Add a trace that synchronizes the "env" array.
+ * Find out what elements are currently in the global env array.
*/
- Tcl_UntraceVar2(interp, "env", (char *) NULL,
- TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
- (ClientData) NULL);
+ TclNewLiteralStringObj(varNamePtr, "env");
+ Tcl_IncrRefCount(varNamePtr);
+ Tcl_InitObjHashTable(&namesHash);
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ TclFindArrayPtrElements(varPtr, &namesHash);
- Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
+ /*
+ * Go through the environment array and transfer its values into Tcl. At
+ * the same time, remove those elements we add/update from the hash table
+ * of existing elements, so that after this part processes, that table
+ * will hold just the parts to remove.
+ */
- if (environ[0] == NULL) {
- Tcl_Obj *varNamePtr;
+ if (environ[0] != NULL) {
+ int i;
- varNamePtr = Tcl_NewStringObj("env", -1);
- Tcl_IncrRefCount(varNamePtr);
- TclArraySet(interp, varNamePtr, NULL);
- Tcl_DecrRefCount(varNamePtr);
- } else {
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
+ Tcl_Obj *obj1, *obj2;
+ char *p1, *p2;
+
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
if (p2 == NULL) {
/*
* This condition seem to happen occasionally under some
- * versions of Solaris; ignore the entry.
+ * versions of Solaris, or when encoding accidents swallow the
+ * '='; ignore the entry.
*/
continue;
}
p2++;
p2[-1] = '\0';
- Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+ obj1 = Tcl_NewStringObj(p1, -1);
+ obj2 = Tcl_NewStringObj(p2, -1);
Tcl_DStringFree(&envString);
+
+ Tcl_IncrRefCount(obj1);
+ Tcl_IncrRefCount(obj2);
+ Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
+ hPtr = Tcl_FindHashEntry(&namesHash, obj1);
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DecrRefCount(obj1);
+ Tcl_DecrRefCount(obj2);
}
Tcl_MutexUnlock(&envMutex);
}
- Tcl_TraceVar2(interp, "env", (char *) NULL,
+ /*
+ * Delete those elements that existed in the array but which had no
+ * counterparts in the environment array.
+ */
+
+ for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
+ hPtr=Tcl_NextHashEntry(&search)) {
+ Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
+
+ TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
+ }
+ Tcl_DeleteHashTable(&namesHash);
+ Tcl_DecrRefCount(varNamePtr);
+
+ /*
+ * Re-establish the trace.
+ */
+
+ Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
- (ClientData) NULL);
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
}
/*
@@ -152,11 +185,11 @@ TclSetupEnv(interp)
* TclSetEnv --
*
* Set an environment variable, replacing an existing value or creating a
- * new variable if there doesn't exist a variable by the given name.
- * This function is intended to be a stand-in for the UNIX "setenv"
- * function so that applications using that function will interface
- * properly to Tcl. To make it a stand-in, the Makefile must define
- * "TclSetEnv" to "setenv".
+ * new variable if there doesn't exist a variable by the given name. This
+ * function is intended to be a stand-in for the UNIX "setenv" function
+ * so that applications using that function will interface properly to
+ * Tcl. To make it a stand-in, the Makefile must define "TclSetEnv" to
+ * "setenv".
*
* Results:
* None.
@@ -168,15 +201,16 @@ TclSetupEnv(interp)
*/
void
-TclSetEnv(name, value)
- CONST char *name; /* Name of variable whose value is to be set
+TclSetEnv(
+ const char *name, /* Name of variable whose value is to be set
* (UTF-8). */
- CONST char *value; /* New value for variable (UTF-8). */
+ 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;
+ const char *p2;
/*
* Figure out where the entry is going to go. If the name doesn't already
@@ -189,24 +223,21 @@ TclSetEnv(name, value)
if (index == -1) {
#ifndef USE_PUTENV
- if ((length + 2) > environSize) {
- char **newEnviron;
-
- newEnviron = (char **) ckalloc((unsigned)
- ((length + 5) * sizeof(char *)));
- memcpy((VOID *) newEnviron, (VOID *) environ,
- length*sizeof(char *));
- if (environSize != 0) {
- ckfree((char *) environ);
- }
- environ = newEnviron;
- environSize = length + 5;
-#if defined(__APPLE__) && defined(__DYNAMIC__)
- {
- char ***e = _NSGetEnviron();
- *e = environ;
+ /*
+ * We need to handle the case where the environment may be changed
+ * outside our control. ourEnvironSize is only valid if the current
+ * environment is the one we allocated. [Bug 979640]
+ */
+
+ if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
+ char **newEnviron = ckalloc((length + 5) * sizeof(char *));
+
+ memcpy(newEnviron, environ, length * sizeof(char *));
+ if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
+ ckfree(env.ourEnviron);
}
-#endif /* __APPLE__ && __DYNAMIC__ */
+ environ = env.ourEnviron = newEnviron;
+ env.ourEnvironSize = length + 5;
}
index = length;
environ[index + 1] = NULL;
@@ -214,7 +245,7 @@ TclSetEnv(name, value)
oldValue = NULL;
nameLength = strlen(name);
} else {
- CONST char *env;
+ const char *env;
/*
* Compare the new value to the existing value. If they're the same
@@ -225,7 +256,7 @@ TclSetEnv(name, value)
*/
env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
- if (strcmp(value, (env + length + 1)) == 0) {
+ if (strcmp(value, env + (length + 1)) == 0) {
Tcl_DStringFree(&envString);
Tcl_MutexUnlock(&envMutex);
return;
@@ -233,7 +264,7 @@ TclSetEnv(name, value)
Tcl_DStringFree(&envString);
oldValue = environ[index];
- nameLength = length;
+ nameLength = (unsigned) length;
}
/*
@@ -242,18 +273,19 @@ TclSetEnv(name, value)
* and set the environ array value.
*/
- p = (char *) 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 = (char *) ckrealloc(p, (unsigned) (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
@@ -265,7 +297,7 @@ TclSetEnv(name, value)
index = TclpFindVariable(name, &length);
#else
environ[index] = p;
-#endif
+#endif /* USE_PUTENV */
/*
* Watch out for versions of putenv that copy the string (e.g. VC++). In
@@ -282,7 +314,7 @@ TclSetEnv(name, value)
*/
ckfree(p);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
}
Tcl_MutexUnlock(&envMutex);
@@ -320,12 +352,12 @@ TclSetEnv(name, value)
*/
int
-Tcl_PutEnv(assignment)
- CONST char *assignment; /* Info about environment variable in the form
+Tcl_PutEnv(
+ const char *assignment) /* Info about environment variable in the form
* NAME=value. (native) */
{
Tcl_DString nameString;
- CONST char *name;
+ const char *name;
char *value;
if (assignment == NULL) {
@@ -369,18 +401,18 @@ Tcl_PutEnv(assignment)
*/
void
-TclUnsetEnv(name)
- CONST char *name; /* Name of variable to remove (UTF-8). */
+TclUnsetEnv(
+ const char *name) /* Name of variable to remove (UTF-8). */
{
char *oldValue;
int length;
int index;
-#ifdef USE_PUTENV
+#ifdef USE_PUTENV_FOR_UNSET
Tcl_DString envString;
char *string;
#else
char **envPtr;
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
@@ -394,6 +426,7 @@ TclUnsetEnv(name)
Tcl_MutexUnlock(&envMutex);
return;
}
+
/*
* Remember the old value so we can free it if Tcl created the string.
*/
@@ -401,19 +434,31 @@ TclUnsetEnv(name)
oldValue = environ[index];
/*
- * Update the system environment. This must be done before we update the
+ * Update the system environment. This must be done before we update the
* interpreters or we will recurse.
*/
-#ifdef USE_PUTENV
- string = ckalloc((unsigned int) length+2);
- memcpy((VOID *) string, (VOID *) name, (size_t) length);
+#ifdef USE_PUTENV_FOR_UNSET
+ /*
+ * For those platforms that support putenv to unset, Linux indicates
+ * that no = should be included, and Windows requires it.
+ */
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+ string = ckalloc(length + 2);
+ memcpy(string, name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
+#else
+ 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);
@@ -433,9 +478,9 @@ TclUnsetEnv(name)
*/
ckfree(string);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
}
-#else
+#else /* !USE_PUTENV_FOR_UNSET */
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
@@ -443,7 +488,7 @@ TclUnsetEnv(name)
}
}
ReplaceString(oldValue, NULL);
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
Tcl_MutexUnlock(&envMutex);
}
@@ -468,16 +513,16 @@ TclUnsetEnv(name)
*----------------------------------------------------------------------
*/
-CONST char *
-TclGetEnv(name, valuePtr)
- CONST char *name; /* Name of environment variable to find
+const char *
+TclGetEnv(
+ const char *name, /* Name of environment variable to find
* (UTF-8). */
- Tcl_DString *valuePtr; /* Uninitialized or free DString in which the
+ Tcl_DString *valuePtr) /* Uninitialized or free DString in which the
* value of the environment variable is
* stored. */
{
int length, index;
- CONST char *result;
+ const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
@@ -523,14 +568,14 @@ TclGetEnv(name, valuePtr)
/* ARGSUSED */
static char *
-EnvTraceProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter whose "env" variable is being
+EnvTraceProc(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter whose "env" variable is being
* modified. */
- CONST char *name1; /* Better be "env". */
- CONST char *name2; /* Name of variable being modified, or NULL if
+ const char *name1, /* Better be "env". */
+ const char *name2, /* Name of variable being modified, or NULL if
* whole array is being deleted (UTF-8). */
- int flags; /* Indicates what's happening. */
+ int flags) /* Indicates what's happening. */
{
/*
* For array traces, let TclSetupEnv do all the work.
@@ -554,7 +599,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*/
if (flags & TCL_TRACE_WRITES) {
- CONST char *value;
+ const char *value;
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
@@ -566,11 +611,11 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_READS) {
Tcl_DString valueString;
- CONST char *value;
+ const char *value = TclGetEnv(name2, &valueString);
- value = TclGetEnv(name2, &valueString);
if (value == NULL) {
- return "no such variable";
+ Tcl_UnsetVar2(interp, name1, name2, 0);
+ return NULL;
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
@@ -591,8 +636,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*
* ReplaceString --
*
- * Replace one string with another in the environment variable cache.
- * The cache keeps track of all of the environment variables that Tcl has
+ * Replace one string with another in the environment variable cache. The
+ * cache keeps track of all of the environment variables that Tcl has
* modified so they can be freed later.
*
* Results:
@@ -605,12 +650,11 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*/
static void
-ReplaceString(oldStr, newStr)
- CONST char *oldStr; /* Old environment string. */
- char *newStr; /* New environment string. */
+ReplaceString(
+ const char *oldStr, /* Old environment string. */
+ char *newStr) /* New environment string. */
{
int i;
- char **newCache;
/*
* Check to see if the old value was allocated by Tcl. If so, it needs to
@@ -619,47 +663,41 @@ ReplaceString(oldStr, newStr)
* changes are being made.
*/
- for (i = 0; i < cacheSize; i++) {
- if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
+ for (i = 0; i < env.cacheSize; i++) {
+ if (env.cache[i]==oldStr || env.cache[i]==NULL) {
break;
}
}
- if (i < cacheSize) {
+ if (i < env.cacheSize) {
/*
* Replace or delete the old value.
*/
- if (environCache[i]) {
- ckfree(environCache[i]);
+ if (env.cache[i]) {
+ ckfree(env.cache[i]);
}
if (newStr) {
- environCache[i] = newStr;
+ env.cache[i] = newStr;
} else {
- for (; i < cacheSize-1; i++) {
- environCache[i] = environCache[i+1];
+ for (; i < env.cacheSize-1; i++) {
+ env.cache[i] = env.cache[i+1];
}
- environCache[cacheSize-1] = NULL;
+ env.cache[env.cacheSize-1] = NULL;
}
} else {
- int allocatedSize = (cacheSize + 5) * sizeof(char *);
-
/*
* We need to grow the cache in order to hold the new string.
*/
- newCache = (char **) ckalloc((unsigned) allocatedSize);
- (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
+ const int growth = 5;
- if (environCache) {
- memcpy((VOID *) newCache, (VOID *) environCache,
- (size_t) (cacheSize * sizeof(char*)));
- ckfree((char *) environCache);
- }
- environCache = newCache;
- environCache[cacheSize] = newStr;
- environCache[cacheSize+1] = NULL;
- cacheSize += 5;
+ env.cache = ckrealloc(env.cache,
+ (env.cacheSize + growth) * sizeof(char *));
+ env.cache[env.cacheSize] = newStr;
+ (void) memset(env.cache+env.cacheSize+1, 0,
+ (size_t) (growth-1) * sizeof(char *));
+ env.cacheSize += growth;
}
}
@@ -682,7 +720,7 @@ ReplaceString(oldStr, newStr)
*/
void
-TclFinalizeEnvironment()
+TclFinalizeEnvironment(void)
{
/*
* For now we just deallocate the cache array and none of the environment
@@ -692,19 +730,17 @@ TclFinalizeEnvironment()
* unlikely, so we don't bother.
*/
- if (environCache) {
- ckfree((char *) environCache);
- environCache = NULL;
- cacheSize = 0;
+ if (env.cache) {
+ ckfree(env.cache);
+ env.cache = NULL;
+ env.cacheSize = 0;
#ifndef USE_PUTENV
- environSize = 0;
+ env.ourEnvironSize = 0;
#endif
}
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
-
-#include <windows.h>
+#if defined(__CYGWIN__)
/*
* When using cygwin, when an environment variable changes, we need to synch
@@ -712,10 +748,11 @@ TclFinalizeEnvironment()
* 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(str)
- const char *str;
+TclCygwinPutenv(
+ char *str)
{
char *name, *value;
@@ -724,7 +761,7 @@ TclCygwinPutenv(str)
* for Windows.
*/
- name = (char *) alloca(strlen(str) + 1);
+ name = alloca(strlen(str) + 1);
strcpy(name, str);
for (value=name ; *value!='=' && *value!='\0' ; ++value) {
/* Empty body */
@@ -733,8 +770,7 @@ TclCygwinPutenv(str)
/* Can't happen. */
return;
}
- *value = '\0';
- ++value;
+ *(value++) = '\0';
if (*value == '\0') {
value = NULL;
}
@@ -766,11 +802,11 @@ TclCygwinPutenv(str)
*/
if (strcmp(name, "Path") == 0) {
- SetEnvironmentVariable("PATH", (char *) NULL);
+ SetEnvironmentVariableA("PATH", NULL);
unsetenv("PATH");
}
- SetEnvironmentVariable(name, value);
+ SetEnvironmentVariableA(name, value);
} else {
char *buf;
@@ -778,7 +814,7 @@ TclCygwinPutenv(str)
* Eliminate any Path variable, to prevent any confusion.
*/
- SetEnvironmentVariable("Path", (char *) NULL);
+ SetEnvironmentVariableA("Path", NULL);
unsetenv("Path");
if (value == NULL) {
@@ -786,16 +822,15 @@ TclCygwinPutenv(str)
} else {
int size;
- size = cygwin_posix_to_win32_path_list_buf_size(value);
- buf = (char *) alloca(size + 1);
- cygwin_posix_to_win32_path_list(value, buf);
+ size = cygwin_conv_path_list(0, value, NULL, 0);
+ buf = alloca(size + 1);
+ cygwin_conv_path_list(0, value, buf, size);
}
- SetEnvironmentVariable(name, buf);
+ SetEnvironmentVariableA(name, buf);
}
}
-
-#endif /* __CYGWIN__ && __WIN32__ */
+#endif /* __CYGWIN__ */
/*
* Local Variables:
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index cea3a15..941d566 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1,9 +1,9 @@
-/*
+/*
* tclEvent.c --
*
* This file implements some general event related interfaces including
* background errors, exit handlers, and the "vwait" and "update" command
- * procedures.
+ * functions.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -11,14 +11,12 @@
*
* 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.64 2005/08/17 21:27:41 kennykb Exp $
*/
#include "tclInt.h"
/*
- * The data structure below is used to report background errors. One such
+ * The data structure below is used to report background errors. One such
* structure is allocated for each error; it holds information about the
* interpreter and the error until an idle handler command can be invoked.
*/
@@ -35,7 +33,7 @@ typedef struct BgError {
/*
* One of the structures below is associated with the "tclBgError" assoc data
- * for each interpreter. It keeps track of the head and tail of the list of
+ * for each interpreter. It keeps track of the head and tail of the list of
* pending background errors for the interpreter.
*/
@@ -51,47 +49,50 @@ typedef struct ErrAssocData {
} ErrAssocData;
/*
- * For each exit handler created with a call to Tcl_CreateExitHandler
+ * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
* there is a structure of the following type:
*/
typedef struct ExitHandler {
- Tcl_ExitProc *proc; /* Procedure to call when process exits. */
+ Tcl_ExitProc *proc; /* Function to call when process exits. */
ClientData clientData; /* One word of information to pass to proc. */
struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
* application, or NULL for end of list. */
} ExitHandler;
/*
- * There is both per-process and per-thread exit handlers. The first list is
- * controlled by a mutex. The other is in thread local storage.
+ * There is both per-process and per-thread exit handlers. The first list is
+ * controlled by a mutex. The other is in thread local storage.
*/
static ExitHandler *firstExitPtr = NULL;
/* First in list of all exit handlers for
* application. */
+static ExitHandler *firstLateExitPtr = NULL;
+ /* First in list of all late exit handlers for
+ * application. */
TCL_DECLARE_MUTEX(exitMutex)
/*
- * This variable is set to 1 when Tcl_Finalize is called, and at the end of
- * its work, it is reset to 0. The variable is checked by TclInExit() to allow
- * different behavior for exit-time processing, e.g. in closing of files and
- * pipes.
+ * This variable is set to 1 when Tcl_Exit is called. The variable is checked
+ * by TclInExit() to allow different behavior for exit-time processing, e.g.,
+ * in closing of files and pipes.
*/
-static int inFinalize = 0;
+static int inExit = 0;
+
static int subsystemsInitialized = 0;
/*
- * This variable contains the application wide exit handler. It will be
- * called by Tcl_Exit instead of the C-runtime exit if this variable is set
- * to a non-NULL value.
+ * This variable contains the application wide exit handler. It will be called
+ * by Tcl_Exit instead of the C-runtime exit if this variable is set to a
+ * non-NULL value.
*/
static Tcl_ExitProc *appExitPtr = NULL;
typedef struct ThreadSpecificData {
- ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
+ ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
* thread. */
int inExit; /* True when this thread is exiting. This is
* used as a hack to decide to close the
@@ -100,32 +101,31 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
#ifdef TCL_THREADS
-
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
} ThreadClientData;
-static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
- ClientData clientData));
-#endif
+static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
+#endif /* TCL_THREADS */
/*
- * Prototypes for procedures referenced only in this file:
+ * Prototypes for functions referenced only in this file:
*/
-static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-static void HandleBgErrors _ANSI_ARGS_((ClientData clientData));
-static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
+static void BgErrorDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static void HandleBgErrors(ClientData clientData);
+static char * VwaitVarProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
+static void InvokeExitHandlers(void);
/*
*----------------------------------------------------------------------
*
* Tcl_BackgroundError --
*
- * This procedure is invoked to handle errors that occur in Tcl commands
+ * This function is invoked to handle errors that occur in Tcl commands
* that are invoked in "background" (e.g. from event or timer bindings).
*
* Results:
@@ -139,26 +139,38 @@ static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData,
*/
void
-Tcl_BackgroundError(interp)
- Tcl_Interp *interp; /* Interpreter in which an error has
+Tcl_BackgroundError(
+ Tcl_Interp *interp) /* Interpreter in which an error has
* occurred. */
{
+ Tcl_BackgroundException(interp, TCL_ERROR);
+}
+
+void
+Tcl_BackgroundException(
+ Tcl_Interp *interp, /* Interpreter in which an exception has
+ * occurred. */
+ int code) /* The exception code value */
+{
BgError *errPtr;
ErrAssocData *assocPtr;
- errPtr = (BgError *) ckalloc(sizeof(BgError));
+ if (code == TCL_OK) {
+ return;
+ }
+
+ errPtr = ckalloc(sizeof(BgError));
errPtr->errorMsg = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errPtr->errorMsg);
- errPtr->returnOpts = Tcl_GetReturnOptions(interp, TCL_ERROR);
+ errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
Tcl_IncrRefCount(errPtr->returnOpts);
errPtr->nextPtr = NULL;
(void) TclGetBgErrorHandler(interp);
- assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
- (Tcl_InterpDeleteProc **) NULL);
+ assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr->firstBgPtr == NULL) {
assocPtr->firstBgPtr = errPtr;
- Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
+ Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
} else {
assocPtr->lastBgPtr->nextPtr = errPtr;
}
@@ -171,7 +183,7 @@ Tcl_BackgroundError(interp)
*
* HandleBgErrors --
*
- * This procedure is invoked as an idle handler to process all of the
+ * This function is invoked as an idle handler to process all of the
* accumulated background errors.
*
* Results:
@@ -184,32 +196,37 @@ Tcl_BackgroundError(interp)
*/
static void
-HandleBgErrors(clientData)
- ClientData clientData; /* Pointer to ErrAssocData structure. */
+HandleBgErrors(
+ ClientData clientData) /* Pointer to ErrAssocData structure. */
{
- ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+ ErrAssocData *assocPtr = clientData;
Tcl_Interp *interp = assocPtr->interp;
BgError *errPtr;
/*
- * Not bothering to save/restore the interp state. Assume that any code
+ * Not bothering to save/restore the interp state. Assume that any code
* that has interp state it needs to keep will make its own
* Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent()
* that could lead us here.
*/
- Tcl_Preserve((ClientData) assocPtr);
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(assocPtr);
+ Tcl_Preserve(interp);
while (assocPtr->firstBgPtr != NULL) {
int code, prefixObjc;
Tcl_Obj **prefixObjv, **tempObjv;
+ /*
+ * Note we copy the handler command prefix each pass through, so we do
+ * support one handler setting another handler.
+ */
+
+ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
+
errPtr = assocPtr->firstBgPtr;
- Tcl_IncrRefCount(assocPtr->cmdPrefix);
- Tcl_ListObjGetElements(NULL, assocPtr->cmdPrefix, &prefixObjc,
- &prefixObjv);
- tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *));
+ Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+ tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
tempObjv[prefixObjc] = errPtr->errorMsg;
tempObjv[prefixObjc+1] = errPtr->returnOpts;
@@ -220,31 +237,34 @@ HandleBgErrors(clientData)
* Discard the command and the information about the error report.
*/
- Tcl_DecrRefCount(assocPtr->cmdPrefix);
+ Tcl_DecrRefCount(copyObj);
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
assocPtr->firstBgPtr = errPtr->nextPtr;
- ckfree((char *) errPtr);
+ ckfree(errPtr);
+ ckfree(tempObjv);
if (code == TCL_BREAK) {
/*
* Break means cancel any remaining error reports for this
* interpreter.
*/
+
while (assocPtr->firstBgPtr != NULL) {
errPtr = assocPtr->firstBgPtr;
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);
- if (errChannel != (Tcl_Channel) NULL) {
+
+ if (errChannel != NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr;
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
@@ -258,12 +278,13 @@ HandleBgErrors(clientData)
}
Tcl_WriteChars(errChannel, "\n", 1);
Tcl_Flush(errChannel);
+ Tcl_DecrRefCount(options);
}
}
}
assocPtr->lastBgPtr = NULL;
- Tcl_Release((ClientData) interp);
- Tcl_Release((ClientData) assocPtr);
+ Tcl_Release(interp);
+ Tcl_Release(assocPtr);
}
/*
@@ -271,7 +292,7 @@ HandleBgErrors(clientData)
*
* TclDefaultBgErrorHandlerObjCmd --
*
- * This procedure is invoked to process the "::tcl::Bgerror" Tcl command.
+ * This function is invoked to process the "::tcl::Bgerror" Tcl command.
* It is the default handler command registered with [interp bgerror] for
* the sake of compatibility with older Tcl releases.
*
@@ -285,15 +306,16 @@ HandleBgErrors(clientData)
*/
int
-TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclDefaultBgErrorHandlerObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *keyPtr, *valuePtr;
Tcl_Obj *tempObjv[2];
- int code;
+ int code, level;
+ Tcl_InterpState saved;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "msg options");
@@ -301,37 +323,118 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
}
/*
- * Restore important state variables to what they were at the time the
- * error occurred.
- *
- * Need to set the variables, not the interp fields, because Tcl_EvalObjv
- * calls Tcl_ResetResult which would destroy anything we write to the
- * interp fields.
+ * Check for a valid return options dictionary.
+ */
+
+ TclNewLiteralStringObj(keyPtr, "-level");
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ 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) {
+ return TCL_ERROR;
+ }
+ TclNewLiteralStringObj(keyPtr, "-code");
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ 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) {
+ return TCL_ERROR;
+ }
+
+ if (level != 0) {
+ /*
+ * We're handling a TCL_RETURN exception.
+ */
+
+ code = TCL_RETURN;
+ }
+ if (code == TCL_OK) {
+ /*
+ * Somehow we got to exception handling with no exception. (Pass
+ * TCL_OK to Tcl_BackgroundException()?) Just return without doing
+ * anything.
+ */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Construct the bgerror command.
*/
- keyPtr = Tcl_NewStringObj("-errorcode", -1);
+ TclNewLiteralStringObj(tempObjv[0], "bgerror");
+ Tcl_IncrRefCount(tempObjv[0]);
+
+ /*
+ * Determine error message argument. Check the return options in case
+ * a non-error exception brought us here.
+ */
+
+ switch (code) {
+ case TCL_ERROR:
+ tempObjv[1] = objv[1];
+ break;
+ case TCL_BREAK:
+ TclNewLiteralStringObj(tempObjv[1],
+ "invoked \"break\" outside of a loop");
+ break;
+ case TCL_CONTINUE:
+ TclNewLiteralStringObj(tempObjv[1],
+ "invoked \"continue\" outside of a loop");
+ break;
+ default:
+ tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code);
+ break;
+ }
+ Tcl_IncrRefCount(tempObjv[1]);
+
+ if (code != TCL_ERROR) {
+ Tcl_SetObjResult(interp, tempObjv[1]);
+ }
+
+ TclNewLiteralStringObj(keyPtr, "-errorcode");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
- Tcl_SetVar2Ex(interp, "errorCode", NULL, valuePtr, TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, valuePtr);
}
- keyPtr = Tcl_NewStringObj("-errorinfo", -1);
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
- Tcl_SetVar2Ex(interp, "errorInfo", NULL, valuePtr, TCL_GLOBAL_ONLY);
+ Tcl_AppendObjToErrorInfo(interp, valuePtr);
+ }
+
+ if (code == TCL_ERROR) {
+ Tcl_SetObjResult(interp, tempObjv[1]);
}
/*
- * Create and invoke the bgerror command.
+ * Save interpreter state so we can restore it if multiple handler
+ * attempts are needed.
+ */
+
+ saved = Tcl_SaveInterpState(interp, code);
+
+ /*
+ * Invoke the bgerror command.
*/
- tempObjv[0] = Tcl_NewStringObj("bgerror", -1);
- Tcl_IncrRefCount(tempObjv[0]);
- tempObjv[1] = objv[1];
Tcl_AllowExceptions(interp);
code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL);
if (code == TCL_ERROR) {
@@ -346,25 +449,27 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
*/
if (Tcl_IsSafe(interp)) {
- Tcl_ResetResult(interp);
+ Tcl_RestoreInterpState(interp, saved);
TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
} else {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != (Tcl_Channel) NULL) {
+
+ if (errChannel != NULL) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
if (Tcl_FindCommand(interp, "bgerror", NULL,
TCL_GLOBAL_ONLY) == NULL) {
- if (valuePtr) {
- Tcl_WriteObj(errChannel, valuePtr);
- Tcl_WriteChars(errChannel, "\n", -1);
- }
+ Tcl_RestoreInterpState(interp, saved);
+ Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
+ "errorInfo", NULL, TCL_GLOBAL_ONLY));
+ Tcl_WriteChars(errChannel, "\n", -1);
} else {
+ Tcl_DiscardInterpState(saved);
Tcl_WriteChars(errChannel,
- "bgerror failed to handle background error.\n", -1);
+ "bgerror failed to handle background error.\n",-1);
Tcl_WriteChars(errChannel, " Original error: ", -1);
- Tcl_WriteObj(errChannel, objv[1]);
+ Tcl_WriteObj(errChannel, tempObjv[1]);
Tcl_WriteChars(errChannel, "\n", -1);
Tcl_WriteChars(errChannel, " Error in bgerror: ", -1);
Tcl_WriteObj(errChannel, resultPtr);
@@ -372,11 +477,17 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
}
Tcl_DecrRefCount(resultPtr);
Tcl_Flush(errChannel);
+ } else {
+ Tcl_DiscardInterpState(saved);
}
}
code = TCL_OK;
+ } else {
+ Tcl_DiscardInterpState(saved);
}
+
Tcl_DecrRefCount(tempObjv[0]);
+ Tcl_DecrRefCount(tempObjv[1]);
Tcl_ResetResult(interp);
return code;
}
@@ -386,7 +497,7 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
*
* TclSetBgErrorHandler --
*
- * This procedure sets the command prefix to be used to handle background
+ * This function sets the command prefix to be used to handle background
* errors in interp.
*
* Results:
@@ -399,25 +510,26 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
*/
void
-TclSetBgErrorHandler(interp, cmdPrefix)
- Tcl_Interp *interp;
- Tcl_Obj *cmdPrefix;
+TclSetBgErrorHandler(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdPrefix)
{
- ErrAssocData *assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
if (cmdPrefix == NULL) {
Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
}
if (assocPtr == NULL) {
- /* First access: initialize */
- assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+ /*
+ * First access: initialize.
+ */
+
+ assocPtr = ckalloc(sizeof(ErrAssocData));
assocPtr->interp = interp;
assocPtr->cmdPrefix = NULL;
assocPtr->firstBgPtr = NULL;
assocPtr->lastBgPtr = NULL;
- Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
- (ClientData) assocPtr);
+ Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
}
if (assocPtr->cmdPrefix) {
Tcl_DecrRefCount(assocPtr->cmdPrefix);
@@ -431,7 +543,7 @@ TclSetBgErrorHandler(interp, cmdPrefix)
*
* TclGetBgErrorHandler --
*
- * This procedure retrieves the command prefix currently used to handle
+ * This function retrieves the command prefix currently used to handle
* background errors in interp.
*
* Results:
@@ -444,16 +556,17 @@ TclSetBgErrorHandler(interp, cmdPrefix)
*/
Tcl_Obj *
-TclGetBgErrorHandler(interp)
- Tcl_Interp *interp;
+TclGetBgErrorHandler(
+ Tcl_Interp *interp)
{
- ErrAssocData *assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr == NULL) {
- TclSetBgErrorHandler(interp, Tcl_NewStringObj("::tcl::Bgerror", -1));
- assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ Tcl_Obj *bgerrorObj;
+
+ TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
+ TclSetBgErrorHandler(interp, bgerrorObj);
+ assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
}
return assocPtr->cmdPrefix;
}
@@ -463,7 +576,7 @@ TclGetBgErrorHandler(interp)
*
* BgErrorDeleteProc --
*
- * This procedure is associated with the "tclBgError" assoc data for an
+ * This function is associated with the "tclBgError" assoc data for an
* interpreter; it is invoked when the interpreter is deleted in order to
* free the information assoicated with any pending error reports.
*
@@ -472,17 +585,17 @@ TclGetBgErrorHandler(interp)
*
* Side effects:
* Background error information is freed: if there were any pending error
- * reports, they are cancelled.
+ * reports, they are canceled.
*
*----------------------------------------------------------------------
*/
static void
-BgErrorDeleteProc(clientData, interp)
- ClientData clientData; /* Pointer to ErrAssocData structure. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+BgErrorDeleteProc(
+ ClientData clientData, /* Pointer to ErrAssocData structure. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
- ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+ ErrAssocData *assocPtr = clientData;
BgError *errPtr;
while (assocPtr->firstBgPtr != NULL) {
@@ -490,11 +603,11 @@ BgErrorDeleteProc(clientData, interp)
assocPtr->firstBgPtr = errPtr->nextPtr;
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
- ckfree((char *) errPtr);
+ ckfree(errPtr);
}
- Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+ Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
Tcl_DecrRefCount(assocPtr->cmdPrefix);
- Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
}
/*
@@ -502,8 +615,8 @@ BgErrorDeleteProc(clientData, interp)
*
* Tcl_CreateExitHandler --
*
- * Arrange for a given procedure to be invoked just before the
- * application exits.
+ * Arrange for a given function to be invoked just before the application
+ * exits.
*
* Results:
* None.
@@ -516,13 +629,12 @@ BgErrorDeleteProc(clientData, interp)
*/
void
-Tcl_CreateExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure to invoke. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_CreateExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
- ExitHandler *exitPtr;
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
- exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
Tcl_MutexLock(&exitMutex);
@@ -534,9 +646,42 @@ Tcl_CreateExitHandler(proc, clientData)
/*
*----------------------------------------------------------------------
*
+ * TclCreateLateExitHandler --
+ *
+ * Arrange for a given function to be invoked after all pre-thread
+ * cleanups.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc will be invoked with clientData as argument when the application
+ * exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCreateLateExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
+
+ exitPtr->proc = proc;
+ exitPtr->clientData = clientData;
+ Tcl_MutexLock(&exitMutex);
+ exitPtr->nextPtr = firstLateExitPtr;
+ firstLateExitPtr = exitPtr;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DeleteExitHandler --
*
- * This procedure cancels an existing exit handler matching proc and
+ * This function cancels an existing exit handler matching proc and
* clientData, if such a handler exits.
*
* Results:
@@ -544,15 +689,15 @@ Tcl_CreateExitHandler(proc, clientData)
*
* Side effects:
* If there is an exit handler corresponding to proc and clientData then
- * it is cancelled; if no such handler exists then nothing happens.
+ * it is canceled; if no such handler exists then nothing happens.
*
*----------------------------------------------------------------------
*/
void
-Tcl_DeleteExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure that was previously registered. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_DeleteExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
@@ -566,7 +711,50 @@ Tcl_DeleteExitHandler(proc, clientData)
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&exitMutex);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteLateExitHandler --
+ *
+ * This function cancels an existing late exit handler matching proc and
+ * clientData, if such a handler exits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is a late exit handler corresponding to proc and clientData
+ * then it is canceled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteLateExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr, *prevPtr;
+
+ Tcl_MutexLock(&exitMutex);
+ for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
+ prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+ if ((exitPtr->proc == proc)
+ && (exitPtr->clientData == clientData)) {
+ if (prevPtr == NULL) {
+ firstLateExitPtr = exitPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = exitPtr->nextPtr;
+ }
+ ckfree(exitPtr);
break;
}
}
@@ -579,7 +767,7 @@ Tcl_DeleteExitHandler(proc, clientData)
*
* Tcl_CreateThreadExitHandler --
*
- * Arrange for a given procedure to be invoked just before the current
+ * Arrange for a given function to be invoked just before the current
* thread exits.
*
* Results:
@@ -593,14 +781,14 @@ Tcl_DeleteExitHandler(proc, clientData)
*/
void
-Tcl_CreateThreadExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure to invoke. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_CreateThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
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;
@@ -612,7 +800,7 @@ Tcl_CreateThreadExitHandler(proc, clientData)
*
* Tcl_DeleteThreadExitHandler --
*
- * This procedure cancels an existing exit handler matching proc and
+ * This function cancels an existing exit handler matching proc and
* clientData, if such a handler exits.
*
* Results:
@@ -620,15 +808,15 @@ Tcl_CreateThreadExitHandler(proc, clientData)
*
* Side effects:
* If there is an exit handler corresponding to proc and clientData then
- * it is cancelled; if no such handler exists then nothing happens.
+ * it is canceled; if no such handler exists then nothing happens.
*
*----------------------------------------------------------------------
*/
void
-Tcl_DeleteThreadExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure that was previously registered. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_DeleteThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -642,7 +830,7 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
return;
}
}
@@ -653,8 +841,8 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
*
* Tcl_SetExitProc --
*
- * This procedure sets the application wide exit handler that will be
- * called by Tcl_Exit in place of the C-runtime exit. If the application
+ * This function sets the application wide exit handler that will be
+ * called by Tcl_Exit in place of the C-runtime exit. If the application
* wide exit handler is NULL, the C-runtime exit will be used instead.
*
* Results:
@@ -667,8 +855,8 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
*/
Tcl_ExitProc *
-Tcl_SetExitProc(proc)
- Tcl_ExitProc *proc; /* new exit handler for app or NULL */
+Tcl_SetExitProc(
+ Tcl_ExitProc *proc) /* New exit handler for app or NULL */
{
Tcl_ExitProc *prevExitProc;
@@ -684,13 +872,56 @@ Tcl_SetExitProc(proc)
return prevExitProc;
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeExitHandlers --
+ *
+ * Call the registered exit handlers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The exit handlers are invoked, and the ExitHandler struct is
+ * freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+InvokeExitHandlers(void)
+{
+ ExitHandler *exitPtr;
+
+ Tcl_MutexLock(&exitMutex);
+ inExit = 1;
+
+ for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
+ /*
+ * Be careful to remove the handler from the list before invoking its
+ * callback. This protects us against double-freeing if the callback
+ * should call Tcl_DeleteExitHandler on itself.
+ */
+
+ firstExitPtr = exitPtr->nextPtr;
+ Tcl_MutexUnlock(&exitMutex);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
+ Tcl_MutexLock(&exitMutex);
+ }
+ firstExitPtr = NULL;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
/*
*----------------------------------------------------------------------
*
* Tcl_Exit --
*
- * This procedure is called to terminate the application.
+ * This function is called to terminate the application.
*
* Results:
* None.
@@ -702,9 +933,9 @@ Tcl_SetExitProc(proc)
*/
void
-Tcl_Exit(status)
- int status; /* Exit status for application; typically
- * 0 for normal return, 1 for error return. */
+Tcl_Exit(
+ int status) /* Exit status for application; typically 0
+ * for normal return, 1 for error return. */
{
Tcl_ExitProc *currentAppExitPtr;
@@ -715,15 +946,45 @@ Tcl_Exit(status)
if (currentAppExitPtr) {
/*
* Warning: this code SHOULD NOT return, as there is code that depends
- * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
+ * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
* returns, so critical is this dependcy.
*/
- currentAppExitPtr((ClientData) status);
+ currentAppExitPtr(INT2PTR(status));
Tcl_Panic("AppExitProc returned unexpectedly");
} else {
- /* use default handling */
- Tcl_Finalize();
+
+ if (TclFullFinalizationRequested()) {
+
+ /*
+ * 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!");
}
@@ -734,7 +995,7 @@ Tcl_Exit(status)
*
* TclInitSubsystems --
*
- * Initialize various subsytems in Tcl. This should be called the first
+ * Initialize various subsytems in Tcl. This should be called the first
* time an interp is created, or before any of the subsystems are used.
* This function ensures an order for the initialization of subsystems:
*
@@ -755,28 +1016,22 @@ Tcl_Exit(status)
*/
void
-TclInitSubsystems()
+TclInitSubsystems(void)
{
- if (inFinalize != 0) {
- Tcl_Panic("TclInitSubsystems called while finalizing");
+ if (inExit != 0) {
+ Tcl_Panic("TclInitSubsystems called while exiting");
}
if (subsystemsInitialized == 0) {
- /*
- * Double check inside the mutex. There are definitly calls back into
- * this routine from some of the procedures below.
+ /*
+ * Double check inside the mutex. There are definitly calls back into
+ * this routine from some of the functions below.
*/
TclpInitLock();
if (subsystemsInitialized == 0) {
- /*
- * Have to set this bit here to avoid deadlock with the routines
- * below us that call into TclInitSubsystems.
- */
-
- subsystemsInitialized = 1;
- /*
+ /*
* Initialize locks used by the memory allocators before anything
* interesting happens so we can use the allocators in the
* implementation of self-initializing locks.
@@ -794,12 +1049,13 @@ TclInitSubsystems()
TclpInitPlatform(); /* Creates signal handler(s) */
TclInitDoubleConversion(); /* Initializes constants for
* converting to/from double. */
- TclInitObjSubsystem(); /* Register obj types, create
+ TclInitObjSubsystem(); /* Register obj types, create
* mutexes. */
TclInitIOSubsystem(); /* Inits a tsd key (noop). */
TclInitEncodingSubsystem(); /* Process wide encoding init. */
TclpSetInterfaces();
- TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
+ TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
+ subsystemsInitialized = 1;
}
TclpInitUnlock();
}
@@ -811,9 +1067,9 @@ TclInitSubsystems()
*
* Tcl_Finalize --
*
- * Shut down Tcl. First calls registered exit handlers, then carefully
- * shuts down various subsystems. Called by Tcl_Exit or when the Tcl
- * shared library is being unloaded.
+ * Shut down Tcl. First calls registered exit handlers, then carefully
+ * shuts down various subsystems. Should be invoked by user before the
+ * Tcl shared library is being unloaded in an embedded context.
*
* Results:
* None.
@@ -825,160 +1081,171 @@ TclInitSubsystems()
*/
void
-Tcl_Finalize()
+Tcl_Finalize(void)
{
ExitHandler *exitPtr;
-
+
/*
* Invoke exit handlers first.
*/
+ InvokeExitHandlers();
+
+ TclpInitLock();
+ if (subsystemsInitialized == 0) {
+ goto alreadyFinalized;
+ }
+ subsystemsInitialized = 0;
+
+ /*
+ * Ensure the thread-specific data is initialised as it is used in
+ * Tcl_FinalizeThread()
+ */
+
+ (void) TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Clean up after the current thread now, after exit handlers. In
+ * particular, the testexithandler command sets up something that writes
+ * to standard output, which gets closed. Note that there is no
+ * thread-local storage or IO subsystem after this call.
+ */
+
+ Tcl_FinalizeThread();
+
+ /*
+ * Now invoke late (process-wide) exit handlers.
+ */
+
Tcl_MutexLock(&exitMutex);
- inFinalize = 1;
- for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
+ for (exitPtr = firstLateExitPtr; exitPtr != NULL;
+ exitPtr = firstLateExitPtr) {
/*
* Be careful to remove the handler from the list before invoking its
- * callback. This protects us against double-freeing if the callback
- * should call Tcl_DeleteExitHandler on itself.
+ * callback. This protects us against double-freeing if the callback
+ * should call Tcl_DeleteLateExitHandler on itself.
*/
- firstExitPtr = exitPtr->nextPtr;
+ firstLateExitPtr = exitPtr->nextPtr;
Tcl_MutexUnlock(&exitMutex);
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
Tcl_MutexLock(&exitMutex);
- }
- firstExitPtr = NULL;
+ }
+ firstLateExitPtr = NULL;
Tcl_MutexUnlock(&exitMutex);
- TclpInitLock();
- if (subsystemsInitialized != 0) {
- subsystemsInitialized = 0;
-
- /*
- * Ensure the thread-specific data is initialised as it is used in
- * Tcl_FinalizeThread()
- */
-
- (void) TCL_TSD_INIT(&dataKey);
-
- /*
- * Clean up after the current thread now, after exit handlers. In
- * particular, the testexithandler command sets up something that
- * writes to standard output, which gets closed. Note that there is
- * no thread-local storage after this call.
- */
-
- Tcl_FinalizeThread();
+ /*
+ * Now finalize the Tcl execution environment. Note that this must be done
+ * after the exit handlers, because there are order dependencies.
+ */
- /*
- * Now finalize the Tcl execution environment. Note that this must be
- * done after the exit handlers, because there are order dependencies.
- */
+ TclFinalizeEvaluation();
+ TclFinalizeExecution();
+ TclFinalizeEnvironment();
- TclFinalizeCompilation();
- TclFinalizeExecution();
- TclFinalizeEnvironment();
+ /*
+ * Finalizing the filesystem must come after anything which might
+ * conceivably interact with the 'Tcl_FS' API.
+ */
- /*
- * Finalizing the filesystem must come after anything which might
- * conceivably interact with the 'Tcl_FS' API.
- */
+ TclFinalizeFilesystem();
- TclFinalizeFilesystem();
+ /*
+ * Undo all Tcl_ObjType registrations, and reset the master list of free
+ * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
+ * freed.
+ *
+ * Note in particular that TclFinalizeObjects() must follow
+ * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the
+ * Tcl_Obj that holds the path of the current working directory.
+ */
- /*
- * Undo all Tcl_ObjType registrations, and reset the master list
- * of free Tcl_Obj's. After this returns, no more Tcl_Obj's should
- * be allocated or freed.
- *
- * Note in particular that TclFinalizeObjects() must follow
- * TclFinalizeFilesystem() because TclFinalizeFilesystem free's
- * the Tcl_Obj that holds the path of the current working directory.
- */
+ TclFinalizeObjects();
- TclFinalizeObjects();
+ /*
+ * We must be sure the encoding finalization doesn't need to examine the
+ * filesystem in any way. Since it only needs to clean up internal data
+ * structures, this is fine.
+ */
- /*
- * We must be sure the encoding finalization doesn't need to examine
- * the filesystem in any way. Since it only needs to clean up
- * internal data structures, this is fine.
- */
+ TclFinalizeEncodingSubsystem();
- TclFinalizeEncodingSubsystem();
+ /*
+ * Repeat finalization of the thread local storage once more. Although
+ * this step is already done by the Tcl_FinalizeThread call above, series
+ * of events happening afterwards may re-initialize TSD slots. Those need
+ * to be finalized again, otherwise we're leaking memory chunks. Very
+ * important to note is that things happening afterwards should not
+ * reference anything which may re-initialize TSD's. This includes freeing
+ * Tcl_Objs's, among other things.
+ *
+ * This fixes the Tcl Bug #990552.
+ */
- Tcl_SetPanicProc(NULL);
+ TclFinalizeThreadData();
- /*
- * Repeat finalization of the thread local storage once more. Although
- * this step is already done by the Tcl_FinalizeThread call above,
- * series of events happening afterwards may re-initialize TSD slots.
- * Those need to be finalized again, otherwise we're leaking memory
- * chunks. Very important to note is that things happening afterwards
- * should not reference anything which may re-initialize TSD's. This
- * includes freeing Tcl_Objs's, among other things.
- *
- * This fixes the Tcl Bug #990552.
- */
+ /*
+ * Now we can free constants for conversions to/from double.
+ */
- TclFinalizeThreadData();
+ TclFinalizeDoubleConversion();
- /*
- * Now we can free constants for conversions to/from double.
- */
+ /*
+ * There have been several bugs in the past that cause exit handlers to be
+ * established during Tcl_Finalize processing. Such exit handlers leave
+ * malloc'ed memory, and Tcl_FinalizeMemorySubsystem or
+ * Tcl_FinalizeThreadAlloc will result in a corrupted heap. The result can
+ * be a mysterious crash on process exit. Check here that nobody's done
+ * this.
+ */
- TclFinalizeDoubleConversion();
-
- /*
- * There have been several bugs in the past that cause exit handlers
- * to be established during Tcl_Finalize processing. Such exit
- * handlers leave malloc'ed memory, and Tcl_FinalizeThreadAlloc or
- * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The
- * result can be a mysterious crash on process exit. Check here that
- * nobody's done this.
- */
+ if (firstExitPtr != NULL) {
+ Tcl_Panic("exit handlers were created during Tcl_Finalize");
+ }
- if (firstExitPtr != NULL) {
- Tcl_Panic("exit handlers were created during Tcl_Finalize");
- }
+ TclFinalizePreserve();
- TclFinalizePreserve();
+ /*
+ * Free synchronization objects. There really should only be one thread
+ * alive at this moment.
+ */
- /*
- * Free synchronization objects. There really should only be one
- * thread alive at this moment.
- */
+ TclFinalizeSynchronization();
- TclFinalizeSynchronization();
+ /*
+ * Close down the thread-specific object allocator.
+ */
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
- TclFinalizeThreadAlloc();
+ TclFinalizeThreadAlloc();
#endif
- /*
- * We defer unloading of packages until very late to avoid memory
- * access issues. Both exit callbacks and synchronization variables
- * may be stored in packages.
- *
- * Note that TclFinalizeLoad unloads packages in the reverse of the
- * order they were loaded in (i.e. last to be loaded is the first to
- * be unloaded). This can be important for correct unloading when
- * dependencies exist.
- *
- * Once load has been finalized, we will have deleted any temporary
- * copies of shared libraries and can therefore reset the filesystem
- * to its original state.
- */
- TclFinalizeLoad();
- TclResetFilesystem();
+ /*
+ * We defer unloading of packages until very late to avoid memory access
+ * issues. Both exit callbacks and synchronization variables may be stored
+ * in packages.
+ *
+ * Note that TclFinalizeLoad unloads packages in the reverse of the order
+ * they were loaded in (i.e. last to be loaded is the first to be
+ * unloaded). This can be important for correct unloading when
+ * dependencies exist.
+ *
+ * Once load has been finalized, we will have deleted any temporary copies
+ * of shared libraries and can therefore reset the filesystem to its
+ * original state.
+ */
- /*
- * At this point, there should no longer be any ckalloc'ed memory.
- */
+ TclFinalizeLoad();
+ TclResetFilesystem();
- TclFinalizeMemorySubsystem();
- inFinalize = 0;
- }
+ /*
+ * At this point, there should no longer be any ckalloc'ed memory.
+ */
+
+ TclFinalizeMemorySubsystem();
+
+ alreadyFinalized:
TclFinalizeLock();
}
@@ -1000,19 +1267,18 @@ Tcl_Finalize()
*/
void
-Tcl_FinalizeThread()
+Tcl_FinalizeThread(void)
{
ExitHandler *exitPtr;
+ ThreadSpecificData *tsdPtr;
- /*
- * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData,
- * because we don't want to initialize the data block if it hasn't
- * been initialized already.
+ /*
+ * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
+ * we don't want to initialize the data block if it hasn't been
+ * initialized already.
*/
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
-
+ tsdPtr = TclThreadDataKeyGet(&dataKey);
if (tsdPtr != NULL) {
tsdPtr->inExit = 1;
@@ -1020,17 +1286,18 @@ Tcl_FinalizeThread()
exitPtr = tsdPtr->firstExitPtr) {
/*
* Be careful to remove the handler from the list before invoking
- * its callback. This protects us against double-freeing if the
+ * its callback. This protects us against double-freeing if the
* callback should call Tcl_DeleteThreadExitHandler on itself.
*/
tsdPtr->firstExitPtr = exitPtr->nextPtr;
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
}
TclFinalizeIOSubsystem();
TclFinalizeNotifier();
TclFinalizeAsync();
+ TclFinalizeThreadObjects();
}
/*
@@ -1063,9 +1330,9 @@ Tcl_FinalizeThread()
*/
int
-TclInExit()
+TclInExit(void)
{
- return inFinalize;
+ return inExit;
}
/*
@@ -1085,15 +1352,14 @@ TclInExit()
*/
int
-TclInThreadExit()
+TclInThreadExit(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
if (tsdPtr == NULL) {
return 0;
- } else {
- return tsdPtr->inExit;
}
+ return tsdPtr->inExit;
}
/*
@@ -1101,7 +1367,7 @@ TclInThreadExit()
*
* Tcl_VwaitObjCmd --
*
- * This procedure is invoked to process the "vwait" Tcl command. See the
+ * This function is invoked to process the "vwait" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1115,38 +1381,58 @@ TclInThreadExit()
/* ARGSUSED */
int
-Tcl_VwaitObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_VwaitObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int done, foundEvent;
- char *nameString;
+ const char *nameString;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
nameString = Tcl_GetString(objv[1]);
- if (Tcl_TraceVar(interp, nameString,
+ if (Tcl_TraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- VwaitVarProc, (ClientData) &done) != TCL_OK) {
+ VwaitVarProc, &done) != TCL_OK) {
return TCL_ERROR;
};
done = 0;
foundEvent = 1;
while (!done && foundEvent) {
foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ break;
+ }
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
+ break;
}
}
- Tcl_UntraceVar(interp, nameString,
+ Tcl_UntraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- VwaitVarProc, (ClientData) &done);
+ VwaitVarProc, &done);
+
+ if (!foundEvent) {
+ Tcl_ResetResult(interp);
+ 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;
+ }
+ if (!done) {
+ /*
+ * The interpreter's result was already set to the right error message
+ * prior to exiting the loop above.
+ */
+
+ return TCL_ERROR;
+ }
/*
* Clear out the interpreter's result, since it may have been set by event
@@ -1154,27 +1440,22 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv)
*/
Tcl_ResetResult(interp);
- if (!foundEvent) {
- Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
- "\": would wait forever", (char *) NULL);
- return TCL_ERROR;
- }
return TCL_OK;
}
/* ARGSUSED */
static char *
-VwaitVarProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Pointer to integer to set to 1. */
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *name1; /* Name of variable. */
- CONST char *name2; /* Second part of variable name. */
- int flags; /* Information about what happened. */
+VwaitVarProc(
+ ClientData clientData, /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
{
- int *donePtr = (int *) clientData;
+ int *donePtr = clientData;
*donePtr = 1;
- return (char *) NULL;
+ return NULL;
}
/*
@@ -1182,8 +1463,8 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
*
* Tcl_UpdateObjCmd --
*
- * This procedure is invoked to process the "update" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "update" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1196,16 +1477,16 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
/* ARGSUSED */
int
-Tcl_UpdateObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UpdateObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
int flags = 0; /* Initialized to avoid compiler warning. */
- static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
- enum updateOptions {REGEXP_IDLETASKS};
+ static const char *const updateOptions[] = {"idletasks", NULL};
+ enum updateOptions {OPT_IDLETASKS};
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -1215,7 +1496,7 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
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:
@@ -1225,11 +1506,14 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
return TCL_ERROR;
}
-
+
while (Tcl_DoOneEvent(flags) != 0) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
return TCL_ERROR;
}
}
@@ -1245,11 +1529,11 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
#ifdef TCL_THREADS
/*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * NewThreadProc --
+ * NewThreadProc --
*
- * Bootstrap function of a new Tcl thread.
+ * Bootstrap function of a new Tcl thread.
*
* Results:
* None.
@@ -1257,22 +1541,22 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
* Side Effects:
* Initializes Tcl notifier for the current thread.
*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static Tcl_ThreadCreateType
-NewThreadProc(ClientData clientData)
+NewThreadProc(
+ ClientData clientData)
{
- ThreadClientData *cdPtr;
+ ThreadClientData *cdPtr = clientData;
ClientData threadClientData;
Tcl_ThreadCreateProc *threadProc;
- cdPtr = (ThreadClientData *)clientData;
threadProc = cdPtr->proc;
threadClientData = cdPtr->clientData;
- Tcl_Free((char*)clientData); /* Allocated in Tcl_CreateThread() */
+ ckfree(clientData); /* Allocated in Tcl_CreateThread() */
- (*threadProc)(threadClientData);
+ threadProc(threadClientData);
TCL_THREAD_CREATE_RETURN;
}
@@ -1283,12 +1567,12 @@ NewThreadProc(ClientData clientData)
*
* Tcl_CreateThread --
*
- * This procedure creates a new thread. This actually belongs to the
+ * This function creates a new thread. This actually belongs to the
* tclThread.c file but since we use some private data structures local
* to this file, it is placed here.
*
* Results:
- * TCL_OK if the thread could be created. The thread ID is returned in a
+ * TCL_OK if the thread could be created. The thread ID is returned in a
* parameter.
*
* Side effects:
@@ -1298,23 +1582,25 @@ NewThreadProc(ClientData clientData)
*/
int
-Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
- Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
- Tcl_ThreadCreateProc proc; /* Main() function of the thread */
- ClientData clientData; /* The one argument to Main() */
- int stackSize; /* Size of stack for the new thread */
- int flags; /* Flags controlling behaviour of the
- * new thread. */
+Tcl_CreateThread(
+ Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */
+ ClientData clientData, /* The one argument to Main() */
+ int stackSize, /* Size of stack for the new thread */
+ int flags) /* Flags controlling behaviour of the new
+ * thread. */
{
#ifdef TCL_THREADS
- ThreadClientData *cdPtr;
+ ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
+ int result;
- cdPtr = (ThreadClientData *) Tcl_Alloc(sizeof(ThreadClientData));
cdPtr->proc = proc;
cdPtr->clientData = clientData;
-
- return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
- stackSize, flags);
+ result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
+ if (result != TCL_OK) {
+ ckfree(cdPtr);
+ }
+ return result;
#else
return TCL_ERROR;
#endif /* TCL_THREADS */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c7502f0..4ecca5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5,71 +5,38 @@
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2002-2005 by Miguel Sofer.
- * Copyright (c) 2005 by Donal K. Fellows.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2002-2010 by Miguel Sofer.
+ * Copyright (c) 2005-2007 by Donal K. Fellows.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright (c) 2006-2008 by Joe Mistachkin. 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: tclExecute.c,v 1.201 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
-
+#include "tclOOInt.h"
+#include "tommath.h"
#include <math.h>
-#include <float.h>
+
+#if NRE_ENABLE_ASSERTS
+#include <assert.h>
+#endif
/*
- * Hack to determine whether we may expect IEEE floating point. The hack is
+ * Hack to determine whether we may expect IEEE floating point. The hack is
* formally incorrect in that non-IEEE platforms might have the same precision
* and range, but VAX, IBM, and Cray do not; are there any other floating
* point units that we might care about?
*/
-#if ( FLT_RADIX == 2 ) && ( DBL_MANT_DIG == 53 ) && ( DBL_MAX_EXP == 1024 )
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#define IEEE_FLOATING_POINT
#endif
/*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno. Just define errno here.
- */
-
-#ifdef TCL_GENERIC_ONLY
-# ifndef NO_FLOAT_H
-# include <float.h>
-# else /* NO_FLOAT_H */
-# ifndef NO_VALUES_H
-# include <values.h>
-# endif /* !NO_VALUES_H */
-# endif /* !NO_FLOAT_H */
-# define NO_ERRNO_H
-#endif /* !TCL_GENERIC_ONLY */
-
-#ifdef NO_ERRNO_H
-int errno;
-# define EDOM 33
-# define ERANGE 34
-#endif
-
-/*
- * Need DBL_MAX for IS_INF() macro...
- */
-#ifndef DBL_MAX
-# ifdef MAXDOUBLE
-# define DBL_MAX MAXDOUBLE
-# else /* !MAXDOUBLE */
-/*
- * This value is from the Solaris headers, but doubles seem to be the same
- * size everywhere. Long doubles aren't, but we don't use those.
- */
-# define DBL_MAX 1.79769313486231570e+308
-# endif /* MAXDOUBLE */
-#endif /* !DBL_MAX */
-
-/*
* A mask (should be 2**n-1) that is used to work out when the bytecode engine
* should call Tcl_AsyncReady() to see whether there is a signal that needs
* handling.
@@ -79,7 +46,6 @@ int errno;
# define ASYNC_CHECK_COUNT_MASK 63
#endif /* !ASYNC_CHECK_COUNT_MASK */
-
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
* initialized.
@@ -88,6 +54,8 @@ int errno;
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,
@@ -108,10 +76,10 @@ int tclTraceExec = 0;
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
*
* Does not include the string for INST_EXPON (and beyond), as that is
- * disjoint for backward-compatability reasons
+ * disjoint for backward-compatability reasons.
*/
-static CONST char *operatorStrings[] = {
+static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!",
"BUILTIN FUNCTION", "FUNCTION",
@@ -124,7 +92,7 @@ static CONST char *operatorStrings[] = {
*/
#ifdef TCL_COMPILE_DEBUG
-static char *resultStrings[] = {
+static const char *const resultStrings[] = {
"TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
};
#endif
@@ -135,25 +103,139 @@ static char *resultStrings[] = {
#ifdef TCL_COMPILE_STATS
long tclObjsAlloced = 0;
-long tclObjsFreed = 0;
-#define TCL_MAX_SHARED_OBJ_STATS 5
+long tclObjsFreed = 0;
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
/*
- * Macros for testing floating-point values for certain special cases. Test
- * for not-a-number by comparing a value against itself; test for infinity by
- * comparing against the largest floating-point value.
+ * Support pre-8.5 bytecodes unless specifically requested otherwise.
*/
-#ifdef _MSC_VER
-#define IS_NAN(f) (_isnan((f)))
-#define IS_INF(f) ( ! (_finite((f))))
-#else
-#define IS_NAN(f) ((f) != (f))
-#define IS_INF(f) ( (f) > DBL_MAX || (f) < -DBL_MAX )
+#ifndef TCL_SUPPORT_84_BYTECODE
+#define TCL_SUPPORT_84_BYTECODE 1
#endif
+#if TCL_SUPPORT_84_BYTECODE
+/*
+ * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
+ * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
+ */
+
+typedef struct {
+ const char *name; /* Name of function. */
+ int numArgs; /* Number of arguments for function. */
+} BuiltinFunc;
+
+/*
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+static BuiltinFunc const tclBuiltinFuncTable[] = {
+ {"acos", 1},
+ {"asin", 1},
+ {"atan", 1},
+ {"atan2", 2},
+ {"ceil", 1},
+ {"cos", 1},
+ {"cosh", 1},
+ {"exp", 1},
+ {"floor", 1},
+ {"fmod", 2},
+ {"hypot", 2},
+ {"log", 1},
+ {"log10", 1},
+ {"pow", 2},
+ {"sin", 1},
+ {"sinh", 1},
+ {"sqrt", 1},
+ {"tan", 1},
+ {"tanh", 1},
+ {"abs", 1},
+ {"double", 1},
+ {"int", 1},
+ {"rand", 0},
+ {"round", 1},
+ {"srand", 1},
+ {"wide", 1},
+ {NULL, 0},
+};
+
+#define LAST_BUILTIN_FUNC 25
+#endif
+
+/*
+ * NR_TEBC
+ * Helpers for NR - non-recursive calls to TEBC
+ * Minimal data required to fully reconstruct the execution state.
+ */
+
+typedef struct TEBCdata {
+ ByteCode *codePtr; /* Constant until the BC returns */
+ /* -----------------------------------------*/
+ ptrdiff_t *catchTop; /* These fields are used on return TO this */
+ Tcl_Obj *auxObjList; /* this level: they record the state when a */
+ CmdFrame cmdFrame; /* new codePtr was received for NR */
+ /* execution. */
+ 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; \
+ TclNRAddCallback(interp, TEBCresume, \
+ TD, pc, INT2PTR(cleanup), NULL); \
+ } while (0)
+
+#define TEBC_DATA_DIG() \
+ do { \
+ tosPtr = esPtr->tosPtr; \
+ } while (0)
+
+#define PUSH_TAUX_OBJ(objPtr) \
+ do { \
+ if (auxObjList) { \
+ objPtr->length += auxObjList->length; \
+ } \
+ objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \
+ auxObjList = objPtr; \
+ } while (0)
+
+#define POP_TAUX_OBJ() \
+ do { \
+ tmpPtr = auxObjList; \
+ auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr; \
+ Tcl_DecrRefCount(tmpPtr); \
+ } while (0)
+
+/*
+ * These variable-access macros have to coincide with those in tclVar.c
+ */
+
+#define VarHashGetValue(hPtr) \
+ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+static inline Var *
+VarHashCreateVar(
+ TclVarHashTable *tablePtr,
+ Tcl_Obj *key,
+ int *newPtr)
+{
+ Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
+ key, newPtr);
+
+ if (!hPtr) {
+ return NULL;
+ }
+ return VarHashGetValue(hPtr);
+}
+
+#define VarHashFindVar(tablePtr, key) \
+ VarHashCreateVar((tablePtr), (key), NULL)
+
/*
* The new macro for ending an instruction; note that a reasonable C-optimiser
* will resolve all branches at compile time. (result) is always a constant;
@@ -166,66 +248,150 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
* resultHandling: 0 indicates no object should be pushed on the stack;
* otherwise, push objResultPtr. If (result < 0), objResultPtr already
* has the correct reference count.
+ *
+ * We use the new compile-time assertions to check that nCleanup is constant
+ * and within range.
*/
-#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
- if (nCleanup == 0) {\
- if (resultHandling != 0) {\
- if ((resultHandling) > 0) {\
- PUSH_OBJECT(objResultPtr);\
- } else {\
- *(++tosPtr) = objResultPtr;\
- }\
- } \
- pc += (pcAdjustment);\
- goto cleanup0;\
- } else if (resultHandling != 0) {\
- if ((resultHandling) > 0) {\
- Tcl_IncrRefCount(objResultPtr);\
- }\
- pc += (pcAdjustment);\
- switch (nCleanup) {\
- case 1: goto cleanup1_pushObjResultPtr;\
- case 2: goto cleanup2_pushObjResultPtr;\
- default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
- }\
- } else {\
- pc += (pcAdjustment);\
- switch (nCleanup) {\
- case 1: goto cleanup1;\
- case 2: goto cleanup2;\
- default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
- }\
- }
-
-#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
- pc += (pcAdjustment);\
- cleanup = (nCleanup);\
- if (resultHandling) {\
- if ((resultHandling) > 0) {\
- Tcl_IncrRefCount(objResultPtr);\
- }\
- goto cleanupV_pushObjResultPtr;\
- } else {\
- goto cleanupV;\
- }
+/* Verify the stack depth, only when no expansion is in progress */
+
+#ifdef TCL_COMPILE_DEBUG
+#define CHECK_STACK() \
+ do { \
+ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \
+ /*checkStack*/ !(starting || auxObjList)); \
+ starting = 0; \
+ } while (0)
+#else
+#define CHECK_STACK()
+#endif
+
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
+ do { \
+ TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \
+ CHECK_STACK(); \
+ if (nCleanup == 0) { \
+ if (resultHandling != 0) { \
+ if ((resultHandling) > 0) { \
+ PUSH_OBJECT(objResultPtr); \
+ } else { \
+ *(++tosPtr) = objResultPtr; \
+ } \
+ } \
+ pc += (pcAdjustment); \
+ goto cleanup0; \
+ } else if (resultHandling != 0) { \
+ if ((resultHandling) > 0) { \
+ Tcl_IncrRefCount(objResultPtr); \
+ } \
+ pc += (pcAdjustment); \
+ switch (nCleanup) { \
+ case 1: goto cleanup1_pushObjResultPtr; \
+ case 2: goto cleanup2_pushObjResultPtr; \
+ case 0: break; \
+ } \
+ } else { \
+ pc += (pcAdjustment); \
+ switch (nCleanup) { \
+ case 1: goto cleanup1; \
+ case 2: goto cleanup2; \
+ case 0: break; \
+ } \
+ } \
+ } while (0)
+
+#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
+ CHECK_STACK(); \
+ do { \
+ pc += (pcAdjustment); \
+ cleanup = (nCleanup); \
+ if (resultHandling) { \
+ if ((resultHandling) > 0) { \
+ Tcl_IncrRefCount(objResultPtr); \
+ } \
+ goto cleanupV_pushObjResultPtr; \
+ } else { \
+ goto cleanupV; \
+ } \
+ } while (0)
+#ifndef TCL_COMPILE_DEBUG
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F(0, (cleanup), 1); \
+ } \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V(0, (cleanup), 1); \
+ } \
+ } while (0)
+#else /* TCL_COMPILE_DEBUG */
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#endif
/*
* Macros used to cache often-referenced Tcl evaluation stack information
* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
- * pair must surround any call inside TclExecuteByteCode (and a few other
+ * pair must surround any call inside TclNRExecuteByteCode (and a few other
* procedures that use this scheme) that could result in a recursive call
- * to TclExecuteByteCode.
+ * to TclNRExecuteByteCode.
*/
#define CACHE_STACK_INFO() \
- tosPtr = eePtr->tosPtr
-
-#define DECACHE_STACK_INFO() \
- eePtr->tosPtr = tosPtr;\
checkInterp = 1
+#define DECACHE_STACK_INFO() \
+ esPtr->tosPtr = tosPtr
/*
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
@@ -245,155 +411,461 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#define PUSH_OBJECT(objPtr) \
Tcl_IncrRefCount(*(++tosPtr) = (objPtr))
-#define POP_OBJECT() \
- *(tosPtr--)
+#define POP_OBJECT() *(tosPtr--)
+
+#define OBJ_AT_TOS *tosPtr
+
+#define OBJ_UNDER_TOS *(tosPtr-1)
+
+#define OBJ_AT_DEPTH(n) *(tosPtr-(n))
+
+#define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr))
+
+#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
/*
* Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
* only used in TRACE* calls to get a string from an object.
*/
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
- if (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
- (tosPtr - eePtr->stackPtr), \
- (unsigned int)(pc - codePtr->codeStart), \
- GetOpcodeName(pc)); \
- printf a; \
+ while (traceInstructions) { \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ (int) CURR_DEPTH, \
+ (unsigned) (pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
+ printf a; \
+ break; \
}
# define TRACE_APPEND(a) \
- if (traceInstructions) { \
- printf a; \
+ while (traceInstructions) { \
+ printf a; \
+ break; \
}
+# define TRACE_ERROR(interp) \
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
# define TRACE_WITH_OBJ(a, objPtr) \
- if (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
- (tosPtr - eePtr->stackPtr), \
- (unsigned int)(pc - codePtr->codeStart), \
- GetOpcodeName(pc)); \
- printf a; \
- TclPrintObject(stdout, objPtr, 30); \
- fprintf(stdout, "\n"); \
+ while (traceInstructions) { \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ (int) CURR_DEPTH, \
+ (unsigned) (pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
+ printf a; \
+ TclPrintObject(stdout, objPtr, 30); \
+ fprintf(stdout, "\n"); \
+ break; \
}
# define O2S(objPtr) \
(objPtr ? TclGetString(objPtr) : "")
#else /* !TCL_COMPILE_DEBUG */
# define TRACE(a)
# define TRACE_APPEND(a)
+# define TRACE_ERROR(interp)
# define TRACE_WITH_OBJ(a, objPtr)
# define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */
/*
- * Macro to read a string containing either a wide or an int and decide which
- * it is while decoding it at the same time. This enforces the policy that
- * integer constants between LONG_MIN and LONG_MAX (inclusive) are represented
- * by normal longs, and integer constants outside that range are represented
- * by wide ints.
- *
- * GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never
- * generates an error message.
+ * DTrace instruction probe macros.
*/
-#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \
- (resultVar) = Tcl_GetWideIntFromObj(interp, (objPtr), &(wideVar)); \
- if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \
- && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \
- (objPtr)->typePtr = &tclIntType; \
- (objPtr)->internalRep.longValue = (longVar) \
- = Tcl_WideAsLong(wideVar); \
- }
-#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \
- (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr), \
- &(wideVar)); \
- if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \
- && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \
- (objPtr)->typePtr = &tclIntType; \
- (objPtr)->internalRep.longValue = (longVar) \
- = Tcl_WideAsLong(wideVar); \
- }
+
+#define TCL_DTRACE_INST_NEXT() \
+ do { \
+ if (TCL_DTRACE_INST_DONE_ENABLED()) { \
+ 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, \
+ tosPtr); \
+ } \
+ } else if (TCL_DTRACE_INST_START_ENABLED()) { \
+ TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, \
+ (int) CURR_DEPTH, tosPtr); \
+ } \
+ } while (0)
+#define TCL_DTRACE_INST_LAST() \
+ do { \
+ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
+ } \
+ } while (0)
+
/*
- * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from an obj.
+ * Macro used in this file to save a function call for common uses of
+ * TclGetNumberFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ * ClientData *ptrPtr, int *tPtr);
*/
-#define FORCE_LONG(objPtr, longVar, wideVar) \
- if ((objPtr)->typePtr == &tclWideIntType) { \
- (longVar) = Tcl_WideAsLong(wideVar); \
- }
-#define IS_INTEGER_TYPE(typePtr) \
- ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
-#define IS_NUMERIC_TYPE(typePtr) \
- (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
-#define W0 Tcl_LongAsWide(0)
+#ifdef TCL_WIDE_INT_IS_LONG
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? (*(tPtr) = TCL_NUMBER_LONG, \
+ *(ptrPtr) = (ClientData) \
+ (&((objPtr)->internalRep.longValue)), TCL_OK) : \
+ ((objPtr)->typePtr == &tclDoubleType) \
+ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
+ ? (*(tPtr) = TCL_NUMBER_NAN) \
+ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \
+ *(ptrPtr) = (ClientData) \
+ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
+ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
+ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
+ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+#else /* !TCL_WIDE_INT_IS_LONG */
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? (*(tPtr) = TCL_NUMBER_LONG, \
+ *(ptrPtr) = (ClientData) \
+ (&((objPtr)->internalRep.longValue)), TCL_OK) : \
+ ((objPtr)->typePtr == &tclWideIntType) \
+ ? (*(tPtr) = TCL_NUMBER_WIDE, \
+ *(ptrPtr) = (ClientData) \
+ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \
+ ((objPtr)->typePtr == &tclDoubleType) \
+ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
+ ? (*(tPtr) = TCL_NUMBER_NAN) \
+ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \
+ *(ptrPtr) = (ClientData) \
+ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
+ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
+ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
+ ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+#endif /* TCL_WIDE_INT_IS_LONG */
+
/*
- * For tracing that uses wide values.
+ * Macro used in this file to save a function call for common uses of
+ * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ * int *boolPtr);
*/
-#define LLD "%" TCL_LL_MODIFIER "d"
-#ifndef TCL_WIDE_INT_IS_LONG
+#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
+ ((((objPtr)->typePtr == &tclIntType) \
+ || ((objPtr)->typePtr == &tclBooleanType)) \
+ ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
+ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
+
/*
- * Extract a double value from a general numeric object.
+ * Macro used in this file to save a function call for common uses of
+ * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ * Tcl_WideInt *wideIntPtr);
*/
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \
- if ((typePtr) == &tclIntType) { \
- (doubleVar) = (double) (objPtr)->internalRep.longValue; \
- } else if ((typePtr) == &tclWideIntType) { \
- (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
- } else { \
- (doubleVar) = (objPtr)->internalRep.doubleValue; \
- }
-#else /* TCL_WIDE_INT_IS_LONG */
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \
- if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \
- (doubleVar) = (double) (objPtr)->internalRep.longValue; \
- } else { \
- (doubleVar) = (objPtr)->internalRep.doubleValue; \
- }
+
+#ifdef TCL_WIDE_INT_IS_LONG
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? (*(wideIntPtr) = (Tcl_WideInt) \
+ ((objPtr)->internalRep.longValue), TCL_OK) : \
+ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#else /* !TCL_WIDE_INT_IS_LONG */
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+ (((objPtr)->typePtr == &tclWideIntType) \
+ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
+ ((objPtr)->typePtr == &tclIntType) \
+ ? (*(wideIntPtr) = (Tcl_WideInt) \
+ ((objPtr)->internalRep.longValue), TCL_OK) : \
+ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */
-static Tcl_ObjType dictIteratorType = {
- "dictIterator",
- NULL, NULL, NULL, NULL
+/*
+ * Macro used to make the check for type overflow more mnemonic. This works by
+ * comparing sign bits; the rest of the word is irrelevant. The ANSI C
+ * "prototype" (where inttype_t is any integer type) is:
+ *
+ * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum);
+ *
+ * Check first the condition most likely to fail in usual code (at least for
+ * usage in [incr]: do the first summand and the sum have != signs?
+ */
+
+#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0))
+
+/*
+ * Macro for checking whether the type is NaN, used when we're thinking about
+ * throwing an error for supplying a non-number number.
+ */
+
+#ifndef ACCEPT_NAN
+#define IsErroringNaNType(type) ((type) == TCL_NUMBER_NAN)
+#else
+#define IsErroringNaNType(type) 0
+#endif
+
+/*
+ * Auxiliary tables used to compute powers of small integers.
+ */
+
+#if (LONG_MAX == 0x7fffffff)
+
+/*
+ * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit
+ * signed integer.
+ */
+
+static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
+static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);
+
+/*
+ * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they
+ * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of
+ * powers of i+3; Exp32Value[i] gives the corresponding powers.
+ */
+
+static const unsigned short Exp32Index[] = {
+ 0, 11, 18, 23, 26, 29, 31, 32, 33
+};
+static const size_t Exp32IndexSize =
+ sizeof(Exp32Index) / sizeof(unsigned short);
+static const long Exp32Value[] = {
+ 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721,
+ 129140163, 387420489, 1162261467, 262144, 1048576, 4194304,
+ 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625,
+ 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056,
+ 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489,
+ 1000000000
+};
+static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long);
+#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */
+
+#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
+
+/*
+ * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
+ * Tcl_WideInt.
+ */
+
+static const Tcl_WideInt MaxBase64[] = {
+ (Tcl_WideInt)46340*65536+62259, /* 3037000499 == isqrt(2**63-1) */
+ (Tcl_WideInt)2097151, (Tcl_WideInt)55108, (Tcl_WideInt)6208,
+ (Tcl_WideInt)1448, (Tcl_WideInt)511, (Tcl_WideInt)234, (Tcl_WideInt)127,
+ (Tcl_WideInt)78, (Tcl_WideInt)52, (Tcl_WideInt)38, (Tcl_WideInt)28,
+ (Tcl_WideInt)22, (Tcl_WideInt)18, (Tcl_WideInt)15
+};
+static const size_t MaxBase64Size = sizeof(MaxBase64)/sizeof(Tcl_WideInt);
+
+/*
+ * Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
+ * results fit in a 64-bit signed integer.
+ */
+
+static const unsigned short Exp64Index[] = {
+ 0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76
+};
+static const size_t Exp64IndexSize =
+ sizeof(Exp64Index) / sizeof(unsigned short);
+static const Tcl_WideInt Exp64Value[] = {
+ (Tcl_WideInt)243*243*243*3*3,
+ (Tcl_WideInt)243*243*243*3*3*3,
+ (Tcl_WideInt)243*243*243*3*3*3*3,
+ (Tcl_WideInt)243*243*243*243,
+ (Tcl_WideInt)243*243*243*243*3,
+ (Tcl_WideInt)243*243*243*243*3*3,
+ (Tcl_WideInt)243*243*243*243*3*3*3,
+ (Tcl_WideInt)243*243*243*243*3*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243,
+ (Tcl_WideInt)243*243*243*243*243*3,
+ (Tcl_WideInt)243*243*243*243*243*3*3,
+ (Tcl_WideInt)243*243*243*243*243*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243*3*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243,
+ (Tcl_WideInt)243*243*243*243*243*243*3,
+ (Tcl_WideInt)243*243*243*243*243*243*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243*3*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243*243,
+ (Tcl_WideInt)243*243*243*243*243*243*243*3,
+ (Tcl_WideInt)243*243*243*243*243*243*243*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3,
+ (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3*3,
+ (Tcl_WideInt)1024*1024*1024*4*4,
+ (Tcl_WideInt)1024*1024*1024*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*4*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024,
+ (Tcl_WideInt)1024*1024*1024*1024*4,
+ (Tcl_WideInt)1024*1024*1024*1024*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*4*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*1024,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*4,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4*4,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*1024,
+ (Tcl_WideInt)1024*1024*1024*1024*1024*1024*4,
+ (Tcl_WideInt)3125*3125*3125*5*5,
+ (Tcl_WideInt)3125*3125*3125*5*5*5,
+ (Tcl_WideInt)3125*3125*3125*5*5*5*5,
+ (Tcl_WideInt)3125*3125*3125*3125,
+ (Tcl_WideInt)3125*3125*3125*3125*5,
+ (Tcl_WideInt)3125*3125*3125*3125*5*5,
+ (Tcl_WideInt)3125*3125*3125*3125*5*5*5,
+ (Tcl_WideInt)3125*3125*3125*3125*5*5*5*5,
+ (Tcl_WideInt)3125*3125*3125*3125*3125,
+ (Tcl_WideInt)3125*3125*3125*3125*3125*5,
+ (Tcl_WideInt)3125*3125*3125*3125*3125*5*5,
+ (Tcl_WideInt)7776*7776*7776*6*6,
+ (Tcl_WideInt)7776*7776*7776*6*6*6,
+ (Tcl_WideInt)7776*7776*7776*6*6*6*6,
+ (Tcl_WideInt)7776*7776*7776*7776,
+ (Tcl_WideInt)7776*7776*7776*7776*6,
+ (Tcl_WideInt)7776*7776*7776*7776*6*6,
+ (Tcl_WideInt)7776*7776*7776*7776*6*6*6,
+ (Tcl_WideInt)7776*7776*7776*7776*6*6*6*6,
+ (Tcl_WideInt)16807*16807*16807*7*7,
+ (Tcl_WideInt)16807*16807*16807*7*7*7,
+ (Tcl_WideInt)16807*16807*16807*7*7*7*7,
+ (Tcl_WideInt)16807*16807*16807*16807,
+ (Tcl_WideInt)16807*16807*16807*16807*7,
+ (Tcl_WideInt)16807*16807*16807*16807*7*7,
+ (Tcl_WideInt)32768*32768*32768*8*8,
+ (Tcl_WideInt)32768*32768*32768*8*8*8,
+ (Tcl_WideInt)32768*32768*32768*8*8*8*8,
+ (Tcl_WideInt)32768*32768*32768*32768,
+ (Tcl_WideInt)59049*59049*59049*9*9,
+ (Tcl_WideInt)59049*59049*59049*9*9*9,
+ (Tcl_WideInt)59049*59049*59049*9*9*9*9,
+ (Tcl_WideInt)100000*100000*100000*10*10,
+ (Tcl_WideInt)100000*100000*100000*10*10*10,
+ (Tcl_WideInt)161051*161051*161051*11*11,
+ (Tcl_WideInt)161051*161051*161051*11*11*11,
+ (Tcl_WideInt)248832*248832*248832*12*12,
+ (Tcl_WideInt)371293*371293*371293*13*13
};
+static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
+#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */
+
+/*
+ * Markers for ExecuteExtendedBinaryMathOp.
+ */
+#define DIVIDED_BY_ZERO ((Tcl_Obj *) -1)
+#define EXPONENT_OF_ZERO ((Tcl_Obj *) -2)
+#define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3)
+
/*
* Declarations for local procedures to this file:
*/
-static int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
- ByteCode *codePtr));
#ifdef TCL_COMPILE_STATS
-static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
+static int EvalStatsCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
+ Tcl_Obj *const objv[]);
#endif /* TCL_COMPILE_STATS */
#ifdef TCL_COMPILE_DEBUG
-static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
-#endif /* TCL_COMPILE_DEBUG */
-static ExceptionRange * GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
- int catchOnly, ByteCode* codePtr));
-static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
- ByteCode* codePtr, int *lengthPtr));
-static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
-static void IllegalExprOperandType _ANSI_ARGS_((
- Tcl_Interp *interp, unsigned char *pc,
- Tcl_Obj *opndPtr));
-static void InitByteCodeExecution _ANSI_ARGS_((
- Tcl_Interp *interp));
-#ifdef TCL_COMPILE_DEBUG
-static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
-static char * StringForResultCode _ANSI_ARGS_((int result));
-static void ValidatePcAndStackTop _ANSI_ARGS_((
- ByteCode *codePtr, unsigned char *pc,
- int stackTop, int stackLowerBound,
- int checkStack));
+static const char * GetOpcodeName(const unsigned char *pc);
+static void PrintByteCodeInfo(ByteCode *codePtr);
+static const char * StringForResultCode(int result);
+static void ValidatePcAndStackTop(ByteCode *codePtr,
+ const unsigned char *pc, int stackTop,
+ int checkStack);
#endif /* TCL_COMPILE_DEBUG */
-static Tcl_WideInt ExponWide _ANSI_ARGS_((Tcl_WideInt w, Tcl_WideInt w2,
- int *errExpon));
-static long ExponLong _ANSI_ARGS_((long i, long i2,
- int *errExpon));
+static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void DeleteExecStack(ExecStack *esPtr);
+static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
+ Tcl_Obj *value2Ptr);
+static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
+ int opcode, Tcl_Obj **constants,
+ Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
+static Tcl_Obj * ExecuteExtendedUnaryMathOp(int opcode,
+ Tcl_Obj *valuePtr);
+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,
+ const unsigned char **pcBeg, int *cmdIdxPtr);
+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 wordSkip(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);
+static Tcl_NRPostProc CopyCallback;
+static Tcl_NRPostProc ExprObjCallback;
+static Tcl_NRPostProc FinalizeOONext;
+static Tcl_NRPostProc FinalizeOONextFilter;
+static Tcl_NRPostProc TEBCresume;
+
+/*
+ * The structure below defines a bytecode Tcl object type to hold the
+ * compiled bytecode for Tcl expressions.
+ */
+
+static const Tcl_ObjType exprCodeType = {
+ "exprcode",
+ FreeExprCodeInternalRep, /* freeIntRepProc */
+ DupExprCodeInternalRep, /* dupIntRepProc */
+ 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;
+}
/*
*----------------------------------------------------------------------
@@ -417,8 +889,8 @@ static long ExponLong _ANSI_ARGS_((long i, long i2,
*/
static void
-InitByteCodeExecution(interp)
- Tcl_Interp *interp; /* Interpreter for which the Tcl variable
+InitByteCodeExecution(
+ Tcl_Interp *interp) /* Interpreter for which the Tcl variable
* "tcl_traceExec" is linked to control
* instruction tracing. */
{
@@ -429,8 +901,7 @@ InitByteCodeExecution(interp)
}
#endif
#ifdef TCL_COMPILE_STATS
- Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd,
- (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL);
#endif /* TCL_COMPILE_STATS */
}
@@ -442,7 +913,7 @@ InitByteCodeExecution(interp)
* This procedure creates a new execution environment for Tcl bytecode
* execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
* typically created once for each Tcl interpreter (Interp structure) and
- * recursively passed to TclExecuteByteCode to execute ByteCode sequences
+ * recursively passed to TclNRExecuteByteCode to execute ByteCode sequences
* for nested commands.
*
* Results:
@@ -451,40 +922,37 @@ InitByteCodeExecution(interp)
*
* Side effects:
* The bytecode interpreter is also initialized here, as this procedure
- * will be called before any call to TclExecuteByteCode.
+ * will be called before any call to TclNRExecuteByteCode.
*
*----------------------------------------------------------------------
*/
-#define TCL_STACK_INITIAL_SIZE 2000
-
ExecEnv *
-TclCreateExecEnv(interp)
- Tcl_Interp *interp; /* Interpreter for which the execution
+TclCreateExecEnv(
+ Tcl_Interp *interp, /* Interpreter for which the execution
* environment is being created. */
+ int size) /* The initial stack size, in number of words
+ * [sizeof(Tcl_Obj*)] */
{
- ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
- Tcl_Obj **stackPtr;
-
- stackPtr = (Tcl_Obj **)
- ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
-
- /*
- * Use the bottom pointer to keep a reference count; the execution
- * environment holds a reference.
- */
-
- stackPtr++;
- eePtr->stackPtr = stackPtr;
- stackPtr[-1] = (Tcl_Obj *) ((char *) 1);
-
- eePtr->tosPtr = stackPtr - 1;
- eePtr->endPtr = stackPtr + (TCL_STACK_INITIAL_SIZE - 2);
+ ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
+ ExecStack *esPtr = ckalloc(sizeof(ExecStack)
+ + (size_t) (size-1) * sizeof(Tcl_Obj *));
- TclNewIntObj(eePtr->constants[0], 0);
+ eePtr->execStackPtr = esPtr;
+ TclNewBooleanObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
- TclNewIntObj(eePtr->constants[1], 1);
+ TclNewBooleanObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
+ eePtr->interp = interp;
+ eePtr->callbackPtr = NULL;
+ eePtr->corPtr = NULL;
+ eePtr->rewind = 0;
+
+ esPtr->prevPtr = NULL;
+ esPtr->nextPtr = NULL;
+ esPtr->markerPtr = NULL;
+ esPtr->endPtr = &esPtr->stackWords[size-1];
+ esPtr->tosPtr = STACK_BASE(esPtr);
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
@@ -496,7 +964,6 @@ TclCreateExecEnv(interp)
return eePtr;
}
-#undef TCL_STACK_INITIAL_SIZE
/*
*----------------------------------------------------------------------
@@ -515,18 +982,53 @@ TclCreateExecEnv(interp)
*----------------------------------------------------------------------
*/
+static void
+DeleteExecStack(
+ ExecStack *esPtr)
+{
+ if (esPtr->markerPtr && !cachedInExit) {
+ Tcl_Panic("freeing an execStack which is still in use");
+ }
+
+ if (esPtr->prevPtr) {
+ esPtr->prevPtr->nextPtr = esPtr->nextPtr;
+ }
+ if (esPtr->nextPtr) {
+ esPtr->nextPtr->prevPtr = esPtr->prevPtr;
+ }
+ ckfree(esPtr);
+}
+
void
-TclDeleteExecEnv(eePtr)
- ExecEnv *eePtr; /* Execution environment to free. */
+TclDeleteExecEnv(
+ ExecEnv *eePtr) /* Execution environment to free. */
{
- if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) {
- ckfree((char *) (eePtr->stackPtr-1));
- } else {
- Tcl_Panic("ERROR: freeing an execEnv whose stack is still in use.\n");
+ ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
+
+ cachedInExit = TclInExit();
+
+ /*
+ * Delete all stacks in this exec env.
+ */
+
+ while (esPtr->nextPtr) {
+ esPtr = esPtr->nextPtr;
+ }
+ while (esPtr) {
+ tmpPtr = esPtr;
+ esPtr = tmpPtr->prevPtr;
+ DeleteExecStack(tmpPtr);
}
+
TclDecrRefCount(eePtr->constants[0]);
TclDecrRefCount(eePtr->constants[1]);
- ckfree((char *) eePtr);
+ if (eePtr->callbackPtr && !cachedInExit) {
+ Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
+ }
+ if (eePtr->corPtr && !cachedInExit) {
+ Tcl_Panic("Deleting execEnv with existing coroutine");
+ }
+ ckfree(eePtr);
}
/*
@@ -548,7 +1050,7 @@ TclDeleteExecEnv(eePtr)
*/
void
-TclFinalizeExecution()
+TclFinalizeExecution(void)
{
Tcl_MutexLock(&execMutex);
execInitialized = 0;
@@ -557,78 +1059,199 @@ TclFinalizeExecution()
}
/*
+ * Auxiliary code to insure that GrowEvaluationStack always returns correctly
+ * aligned memory.
+ *
+ * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
+ * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
+ * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
+ */
+
+#define WALLOCALIGN \
+ (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
+
+/*
+ * wordSkip computes how many words have to be skipped until the next aligned
+ * word. Note that we are only interested in the low order bits of ptr, so
+ * that any possible information loss in PTR2INT is of no consequence.
+ */
+
+static inline int
+wordSkip(
+ void *ptr)
+{
+ int mask = TCL_ALLOCALIGN-1;
+ int base = PTR2INT(ptr) & mask;
+ return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
+}
+
+/*
+ * Given a marker, compute where the following aligned memory starts.
+ */
+
+#define MEMSTART(markerPtr) \
+ ((markerPtr) + wordSkip(markerPtr))
+
+/*
*----------------------------------------------------------------------
*
* GrowEvaluationStack --
*
- * This procedure grows a Tcl evaluation stack stored in an ExecEnv.
+ * This procedure grows a Tcl evaluation stack stored in an ExecEnv,
+ * copying over the words since the last mark if so requested. A mark is
+ * set at the beginning of the new area when no copying is requested.
*
* Results:
- * None.
+ * Returns a pointer to the first usable word in the (possibly) grown
+ * stack.
*
* Side effects:
- * The size of the evaluation stack is doubled.
+ * The size of the evaluation stack may be grown, a marker is set
*
*----------------------------------------------------------------------
*/
-static void
-GrowEvaluationStack(eePtr)
- register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
+static Tcl_Obj **
+GrowEvaluationStack(
+ ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation
* stack to enlarge. */
+ int growth, /* How much larger than the current used
+ * size. */
+ int move) /* 1 if move words since last marker. */
{
+ ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
+ int newBytes, newElems, currElems;
+ int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
+ Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
+ int moveWords = 0;
+
+ if (move) {
+ if (!markerPtr) {
+ Tcl_Panic("STACK: Reallocating with no previous alloc");
+ }
+ if (needed <= 0) {
+ return MEMSTART(markerPtr);
+ }
+ } else {
+#ifndef PURIFY
+ Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
+ int offset = wordSkip(tmpMarkerPtr);
+
+ if (needed + offset < 0) {
+ /*
+ * Put a marker pointing to the previous marker in this stack, and
+ * store it in esPtr as the current marker. Return a pointer to
+ * the start of aligned memory.
+ */
+
+ esPtr->markerPtr = tmpMarkerPtr;
+ memStart = tmpMarkerPtr + offset;
+ esPtr->tosPtr = memStart - 1;
+ *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
+ return memStart;
+ }
+#endif
+ }
+
/*
- * The current Tcl stack elements are stored from *(eePtr->stackPtr) to
- * *(eePtr->endPtr) (inclusive).
+ * 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 one for
+ * the marker, (WALLOCALIGN-1) for the maximal possible offset.
*/
- int currElems = (eePtr->endPtr - eePtr->stackPtr + 1);
- int newElems = 2*currElems;
- int currBytes = currElems * sizeof(Tcl_Obj *);
- int newBytes = 2*currBytes;
- Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
- Tcl_Obj **oldStackPtr = eePtr->stackPtr;
+ if (move) {
+ moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
+ }
+ needed = growth + moveWords + WALLOCALIGN;
+
/*
- * We keep the stack reference count as a (char *), as that works nicely
- * as a portable pointer-sized counter.
+ * Check if there is enough room in the next stack (if there is one, it
+ * should be both empty and the last one!)
*/
- char *refCount = (char *) oldStackPtr[-1];
+ if (esPtr->nextPtr) {
+ oldPtr = esPtr;
+ esPtr = oldPtr->nextPtr;
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
+ if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) {
+ Tcl_Panic("STACK: Stack after current is in use");
+ }
+ if (esPtr->nextPtr) {
+ Tcl_Panic("STACK: Stack after current is not last");
+ }
+ if (needed <= currElems) {
+ goto newStackReady;
+ }
+ DeleteExecStack(esPtr);
+ esPtr = oldPtr;
+ } else {
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
+ }
/*
- * Copy the existing stack items to the new stack space, free the old
- * storage if appropriate, and record the refCount of the new stack held
- * by the environment.
+ * We need to allocate a new stack! It needs to store 'growth' words,
+ * including the elements to be copied over and the new marker.
*/
- newStackPtr++;
- memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
- (size_t) currBytes);
+#ifndef PURIFY
+ newElems = 2*currElems;
+ while (needed > newElems) {
+ newElems *= 2;
+ }
+#else
+ newElems = needed;
+#endif
+
+ newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
+
+ oldPtr = esPtr;
+ esPtr = ckalloc(newBytes);
- if (refCount == (char *) 1) {
- ckfree((VOID *) (oldStackPtr-1));
- } else {
- /*
- * Remove the reference corresponding to the environment pointer.
- */
+ oldPtr->nextPtr = esPtr;
+ esPtr->prevPtr = oldPtr;
+ esPtr->nextPtr = NULL;
+ esPtr->endPtr = &esPtr->stackWords[newElems-1];
+
+ newStackReady:
+ eePtr->execStackPtr = esPtr;
+
+ /*
+ * Store a NULL marker at the beginning of the stack, to indicate that
+ * this is the first marker in this stack and that rewinding to here
+ * should actually be a return to the previous stack.
+ */
- oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
+ esPtr->stackWords[0] = NULL;
+ esPtr->markerPtr = &esPtr->stackWords[0];
+ memStart = MEMSTART(esPtr->markerPtr);
+ esPtr->tosPtr = memStart - 1;
+
+ if (move) {
+ memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
+ esPtr->tosPtr += moveWords;
+ oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
+ oldPtr->tosPtr = markerPtr-1;
}
- eePtr->stackPtr = newStackPtr;
- eePtr->endPtr = newStackPtr + (newElems - 2); /* index of last usable item */
- eePtr->tosPtr += (newStackPtr - oldStackPtr);
- newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);
+ /*
+ * Free the old stack if it is now unused.
+ */
+
+ if (!oldPtr->markerPtr) {
+ DeleteExecStack(oldPtr);
+ }
+
+ return memStart;
}
/*
*--------------------------------------------------------------
*
- * TclStackAlloc --
+ * TclStackAlloc, TclStackRealloc, TclStackFree --
*
* Allocate memory from the execution stack; it has to be returned later
- * with a call to TclStackFree
+ * with a call to TclStackFree.
*
* Results:
* A pointer to the first byte allocated, or panics if the allocation did
@@ -640,65 +1263,144 @@ GrowEvaluationStack(eePtr)
*--------------------------------------------------------------
*/
-char *
-TclStackAlloc(interp, numBytes)
- Tcl_Interp *interp;
- int numBytes;
+static Tcl_Obj **
+StackAllocWords(
+ Tcl_Interp *interp,
+ int numWords)
{
+ /*
+ * Note that GrowEvaluationStack sets a marker in the stack. This marker
+ * is read when rewinding, e.g., by TclStackFree.
+ */
+
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
- int numWords;
- Tcl_Obj **tosPtr = eePtr->tosPtr;
- char **stackRefCountPtr;
+ Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
- /*
- * Add two words to store
- * - a pointer to the used execution stack
- * - the number of words reserved
- * These will be used later by TclStackFree.
- */
+ eePtr->execStackPtr->tosPtr += numWords;
+ return resPtr;
+}
- numWords = (numBytes + 3*sizeof(void *) - 1)/sizeof(void *);
+static Tcl_Obj **
+StackReallocWords(
+ Tcl_Interp *interp,
+ int numWords)
+{
+ Interp *iPtr = (Interp *) interp;
+ ExecEnv *eePtr = iPtr->execEnvPtr;
+ Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
- while ((tosPtr + numWords) > eePtr->endPtr) {
- GrowEvaluationStack(eePtr);
- tosPtr = eePtr->tosPtr;
+ eePtr->execStackPtr->tosPtr += numWords;
+ return resPtr;
+}
+
+void
+TclStackFree(
+ Tcl_Interp *interp,
+ void *freePtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ ExecEnv *eePtr;
+ ExecStack *esPtr;
+ Tcl_Obj **markerPtr, *marker;
+
+ if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+ ckfree((char *) freePtr);
+ return;
}
/*
- * Increase the stack's reference count, to make sure it is not freed
- * prematurely.
+ * Rewind the stack to the previous marker position. The current marker,
+ * as set in the last call to GrowEvaluationStack, contains a pointer to
+ * the previous marker.
*/
- stackRefCountPtr = (char **) (eePtr->stackPtr-1);
- ++*stackRefCountPtr;
+ eePtr = iPtr->execEnvPtr;
+ esPtr = eePtr->execStackPtr;
+ markerPtr = esPtr->markerPtr;
+ marker = *markerPtr;
+
+ if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
+ Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
+ freePtr, MEMSTART(markerPtr));
+ }
+
+ esPtr->tosPtr = markerPtr - 1;
+ esPtr->markerPtr = (Tcl_Obj **) marker;
+ if (marker) {
+ return;
+ }
/*
- * Reserve the space in the exec stack, and store the data for freeing.
+ * Return to previous active stack. Note that repeated expansions or
+ * reallocs could have generated several unused intervening stacks: free
+ * them too.
*/
- eePtr->tosPtr += numWords;
- *(eePtr->tosPtr-1) = (Tcl_Obj *) stackRefCountPtr;
- *(eePtr->tosPtr) = (Tcl_Obj *) numWords;
+ while (esPtr->nextPtr) {
+ esPtr = esPtr->nextPtr;
+ }
+ esPtr->tosPtr = STACK_BASE(esPtr);
+ while (esPtr->prevPtr) {
+ ExecStack *tmpPtr = esPtr->prevPtr;
+ if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) {
+ DeleteExecStack(tmpPtr);
+ } else {
+ break;
+ }
+ }
+ if (esPtr->prevPtr) {
+ eePtr->execStackPtr = esPtr->prevPtr;
+#ifdef PURIFY
+ eePtr->execStackPtr->nextPtr = NULL;
+ DeleteExecStack(esPtr);
+#endif
+ } else {
+ eePtr->execStackPtr = esPtr;
+ }
+}
+
+void *
+TclStackAlloc(
+ Tcl_Interp *interp,
+ int numBytes)
+{
+ Interp *iPtr = (Interp *) interp;
+ int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
+
+ if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+ return (void *) ckalloc(numBytes);
+ }
- return (char *) (tosPtr+1);
+ return (void *) StackAllocWords(interp, numWords);
}
-void
-TclStackFree(interp)
- Tcl_Interp *interp;
+void *
+TclStackRealloc(
+ Tcl_Interp *interp,
+ void *ptr,
+ int numBytes)
{
Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr = iPtr->execEnvPtr;
- char **stackRefCountPtr;
+ ExecEnv *eePtr;
+ ExecStack *esPtr;
+ Tcl_Obj **markerPtr;
+ int numWords;
- stackRefCountPtr = (char **) *(eePtr->tosPtr-1);
- eePtr->tosPtr -= (int) *(eePtr->tosPtr);
+ if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+ return (void *) ckrealloc((char *) ptr, numBytes);
+ }
- --*stackRefCountPtr;
- if (*stackRefCountPtr == (char *) 0) {
- ckfree((VOID *) stackRefCountPtr);
+ eePtr = iPtr->execEnvPtr;
+ esPtr = eePtr->execStackPtr;
+ markerPtr = esPtr->markerPtr;
+
+ if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
+ Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
}
+
+ numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
+ return (void *) StackReallocWords(interp, numWords);
}
/*
@@ -725,124 +1427,158 @@ TclStackFree(interp)
*/
int
-Tcl_ExprObj(interp, objPtr, resultPtrPtr)
- Tcl_Interp *interp; /* Context in which to evaluate the
+Tcl_ExprObj(
+ Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- register Tcl_Obj *objPtr; /* Points to Tcl object containing expression
+ register Tcl_Obj *objPtr, /* Points to Tcl object containing expression
* to evaluate. */
- Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression
+ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression
* result is stored if no errors occur. */
{
+ NRE_callback *rootPtr = TOP_CB(interp);
+ Tcl_Obj *resultPtr;
+
+ TclNewObj(resultPtr);
+ TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
+ NULL, NULL);
+ Tcl_NRExprObj(interp, objPtr, resultPtr);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+}
+
+static int
+CopyCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj **resultPtrPtr = data[0];
+ Tcl_Obj *resultPtr = data[1];
+
+ if (result == TCL_OK) {
+ *resultPtrPtr = resultPtr;
+ Tcl_IncrRefCount(resultPtr);
+ } else {
+ Tcl_DecrRefCount(resultPtr);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_NRExprObj --
+ *
+ * Request evaluation of the expression in a Tcl_Obj by the NR stack.
+ *
+ * Results:
+ * Returns TCL_OK.
+ *
+ * Side effects:
+ * Compiles objPtr as a Tcl expression and places callbacks on the
+ * NR stack to execute the bytecode and store the result in resultPtr.
+ * If bytecode execution raises an exception, nothing is written
+ * to resultPtr, and the exceptional return code flows up the NR
+ * stack. If the exception is TCL_ERROR, an error message is left
+ * in the interp result and the interp's return options dictionary
+ * holds additional error information too. Execution of the bytecode
+ * may have other side effects, depending on the expression.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_NRExprObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Obj *resultPtr)
+{
+ ByteCode *codePtr;
+ Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
+
+ Tcl_ResetResult(interp);
+ codePtr = CompileExprObj(interp, objPtr);
+
+ Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
+ NULL, NULL);
+ return TclNRExecuteByteCode(interp, codePtr);
+}
+
+static int
+ExprObjCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_InterpState state = data[0];
+ Tcl_Obj *resultPtr = data[1];
+
+ if (result == TCL_OK) {
+ TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
+ (void) Tcl_RestoreInterpState(interp, state);
+ } else {
+ Tcl_DiscardInterpState(state);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileExprObj --
+ * Compile a Tcl expression value into ByteCode.
+ *
+ * Results:
+ * A (ByteCode *) is returned pointing to the resulting ByteCode.
+ * The caller must manage its refCount and arrange for a call to
+ * TclCleanupByteCode() when the last reference disappears.
+ *
+ * Side effects:
+ * The Tcl_ObjType of objPtr is changed to the "bytecode" type,
+ * and the ByteCode is kept in the internal rep (along with context
+ * data for checking validity) for faster operations the next time
+ * CompileExprObj is called on the same value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ByteCode *
+CompileExprObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
+{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
- LiteralTable *localTablePtr = &(compEnv.localLitTable);
register ByteCode *codePtr = NULL;
- /* Tcl Internal type of bytecode. Initialized
+ /* Tcl Internal type of bytecode. Initialized
* to avoid compiler warning. */
- AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- Tcl_Obj *saveObjPtr, *resultPtr;
- char *string;
- int length, i, result;
-
- /*
- * First handle some common expressions specially.
- */
-
- string = Tcl_GetStringFromObj(objPtr, &length);
- if (length == 1) {
- if (*string == '0') {
- TclNewLongObj(resultPtr, 0);
- Tcl_IncrRefCount(resultPtr);
- *resultPtrPtr = resultPtr;
- return TCL_OK;
- } else if (*string == '1') {
- TclNewLongObj(resultPtr, 1);
- Tcl_IncrRefCount(resultPtr);
- *resultPtrPtr = resultPtr;
- return TCL_OK;
- }
- } else if ((length == 2) && (*string == '!')) {
- if (*(string+1) == '0') {
- TclNewLongObj(resultPtr, 1);
- Tcl_IncrRefCount(resultPtr);
- *resultPtrPtr = resultPtr;
- return TCL_OK;
- } else if (*(string+1) == '1') {
- TclNewLongObj(resultPtr, 0);
- Tcl_IncrRefCount(resultPtr);
- *resultPtrPtr = resultPtr;
- return TCL_OK;
- }
- }
/*
- * Get the ByteCode from the object. If it exists, make sure it hasn't
- * been invalidated by, e.g., someone redefining a command with a compile
- * procedure (this might make the compiled code wrong). If necessary,
- * convert the object to be a ByteCode object and compile it. Also, if
- * the code was compiled in/for a different interpreter, we recompile it.
- *
- * Precompiled expressions, however, are immutable and therefore they are
- * not recompiled, even if the epoch has changed.
+ * Get the expression ByteCode from the object. If it exists, make sure it
+ * is valid in the current context.
*/
+ if (objPtr->typePtr == &exprCodeType) {
+ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- if (objPtr->typePtr == &tclByteCodeType) {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_Panic("Tcl_ExprObj: compiled expression jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
- objPtr->typePtr->freeIntRepProc(objPtr);
- objPtr->typePtr = (Tcl_ObjType *) NULL;
- }
+ || (codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsPtr != namespacePtr)
+ || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
+ || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
+ FreeExprCodeInternalRep(objPtr);
}
}
- if (objPtr->typePtr != &tclByteCodeType) {
- TclInitCompileEnv(interp, &compEnv, string, length);
- result = TclCompileExpr(interp, string, length, &compEnv);
-
+ if (objPtr->typePtr != &exprCodeType) {
/*
- * Free the compilation environment's literal table bucket array if it
- * was dynamically allocated.
+ * TIP #280: No invoker (yet) - Expression compilation.
*/
- if (localTablePtr->buckets != localTablePtr->staticBuckets) {
- ckfree((char *) localTablePtr->buckets);
- }
-
- if (result != TCL_OK) {
- /*
- * Compilation errors. Free storage allocated for compilation.
- */
-
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyLocalLiteralTable(&compEnv);
-#endif /*TCL_COMPILE_DEBUG*/
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
+ int length;
+ const char *string = TclGetStringFromObj(objPtr, &length);
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
- }
- auxDataPtr++;
- }
- TclFreeCompileEnv(&compEnv);
- return result;
- }
+ TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+ TclCompileExpr(interp, string, length, &compEnv, 0);
/*
* Successful compilation. If the expression yielded no instructions,
@@ -862,176 +1598,441 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
TclEmitOpcode(INST_DONE, &compEnv);
TclInitByteCodeObj(objPtr, &compEnv);
+ objPtr->typePtr = &exprCodeType;
TclFreeCompileEnv(&compEnv);
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile == 2) {
TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
}
#endif /* TCL_COMPILE_DEBUG */
}
+ return codePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupExprCodeInternalRep --
+ *
+ * Part of the Tcl object type implementation for Tcl expression
+ * 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 expression value, and if it is to be used as a compiled
+ * expression, it will just need a recompile.
+ *
+ * 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,
+ * like we do for lists and dicts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Execute the expression after first saving the interpreter's result.
- */
-
- saveObjPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(saveObjPtr);
- Tcl_ResetResult(interp);
+static void
+DupExprCodeInternalRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
+{
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeExprCodeInternalRep --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
- */
+static void
+FreeExprCodeInternalRep(
+ Tcl_Obj *objPtr)
+{
+ ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- codePtr->refCount++;
- result = TclExecuteByteCode(interp, codePtr);
+ objPtr->typePtr = NULL;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
- objPtr->typePtr = NULL;
- objPtr->internalRep.otherValuePtr = NULL;
- }
-
- /*
- * If the expression evaluated successfully, store a pointer to its value
- * object in resultPtrPtr then restore the old interpreter result. We
- * increment the object's ref count to reflect the reference that we are
- * returning to the caller. We also decrement the ref count of the
- * interpreter's result object after calling Tcl_SetResult since we next
- * store into that field directly.
- */
-
- if (result == TCL_OK) {
- *resultPtrPtr = iPtr->objResultPtr;
- Tcl_IncrRefCount(iPtr->objResultPtr);
-
- Tcl_SetObjResult(interp, saveObjPtr);
}
- TclDecrRefCount(saveObjPtr);
- return result;
}
/*
*----------------------------------------------------------------------
*
- * TclCompEvalObj --
+ * TclCompileObj --
*
- * This procedure evaluates the script contained in a Tcl_Obj by first
- * compiling it and then passing it to TclExecuteByteCode.
+ * This procedure compiles the script contained in a Tcl_Obj.
*
* Results:
- * The return value is one of the return codes defined in tcl.h (such as
- * TCL_OK), and interp->objResultPtr refers to a Tcl object that either
- * contains the result of executing the code or an error message.
+ * A pointer to the corresponding ByteCode, never NULL.
*
* Side effects:
- * Almost certainly, depending on the ByteCode's instructions.
+ * The object is shimmered to bytecode type.
*
*----------------------------------------------------------------------
*/
-int
-TclCompEvalObj(interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
+ByteCode *
+TclCompileObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ const CmdFrame *invoker,
+ int word)
{
register Interp *iPtr = (Interp *) interp;
- register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
- int result;
- Namespace *namespacePtr;
-
- /*
- * Check that the interpreter is ready to execute scripts
- */
-
- iPtr->numLevels++;
- if (TclInterpReady(interp) == TCL_ERROR) {
- iPtr->numLevels--;
- return TCL_ERROR;
- }
-
- if (iPtr->varFramePtr != NULL) {
- namespacePtr = iPtr->varFramePtr->nsPtr;
- } else {
- namespacePtr = iPtr->globalNsPtr;
- }
+ register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
+ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
/*
* If the object is not already of tclByteCodeType, compile it (and reset
* the compilation flags in the interpreter; this should be done after any
- * compilation). Otherwise, check that it is "fresh" enough.
+ * compilation). Otherwise, check that it is "fresh" enough.
*/
- if (objPtr->typePtr != &tclByteCodeType) {
- recompileObj:
- iPtr->errorLine = 1;
- result = tclByteCodeType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- iPtr->numLevels--;
- return result;
- }
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- } else {
+ if (objPtr->typePtr == &tclByteCodeType) {
/*
* Make sure the Bytecode hasn't been invalidated by, e.g., someone
* redefining a command with a compile procedure (this might make the
- * compiled code wrong). The object needs to be recompiled if it was
+ * compiled code wrong). The object needs to be recompiled if it was
* compiled in/for a different interpreter, or for a different
* namespace, or for the same namespace but with different name
- * resolution rules. Precompiled objects, however, are immutable and
+ * resolution rules. Precompiled objects, however, are immutable and
* therefore they are not recompiled, even if the epoch has changed.
*
* To be pedantically correct, we should also check that the
* originating procPtr is the same as the current context procPtr
- * (assuming one exists at all - none for global level). This code is
+ * (assuming one exists at all - none for global level). This code is
* #def'ed out because [info body] was changed to never return a
* bytecode type object, which should obviate us from the extra checks
* here.
*/
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
-#ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */
- || (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
- iPtr->varFramePtr->procPtr == codePtr->procPtr))
-#endif
|| (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");
+ 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;
+ }
+
+ /*
+ * Check that any compiled locals do refer to the current proc
+ * environment! If not, recompile.
+ */
+
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
+ (codePtr->procPtr == NULL) &&
+ (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
+ goto recompileObj;
+ }
+
+ /*
+ * #280.
+ * Literal sharing fix. This part of the fix is not required by 8.4
+ * nor 8.5, because they eval-direct any literals, so just saving the
+ * argument locations per command in bytecode is enough, embedded
+ * 'eval' commands, etc. get the correct information.
+ *
+ * But in 8.6 all the embedded script are compiled, and the resulting
+ * bytecode stored in the literal. Now the shared literal has bytecode
+ * with location data for _one_ particular location this literal is
+ * found at. If we get executed from a different location the bytecode
+ * has to be recompiled to get the correct locations. Not doing this
+ * will execute the saved bytecode with data for a different location,
+ * causing 'info frame' to point to the wrong place in the sources.
+ *
+ * Future optimizations ...
+ * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
+ * case we recompile once per location of the literal, but not
+ * continously, because the moment we have all locations we do not
+ * need to recompile any longer.
+ *
+ * (2) Alternative: Do not recompile, tell the execution engine the
+ * offset between saved starting line and actual one. Then modify
+ * the users to adjust the locations they have by this offset.
+ *
+ * (3) Alternative 2: Do not fully recompile, adjust just the location
+ * information.
+ */
+
+ if (invoker == NULL) {
+ return codePtr;
+ } else {
+ Tcl_HashEntry *hePtr =
+ Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
+ ExtCmdLoc *eclPtr;
+ CmdFrame *ctxCopyPtr;
+ int redo;
+
+ if (!hePtr) {
+ return codePtr;
+ }
+
+ eclPtr = Tcl_GetHashValue(hePtr);
+ redo = 0;
+ ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ *ctxCopyPtr = *invoker;
+
+ if (invoker->type == TCL_LOCATION_BC) {
+ /*
+ * Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr used instead
+ */
+
+ TclGetSrcInfoForPc(ctxCopyPtr);
+ if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * The reference made by 'TclGetSrcInfoForPc' is dead.
+ */
+
+ Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
+ ctxCopyPtr->data.eval.path = NULL;
}
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
+ }
+
+ if (word < ctxCopyPtr->nline) {
/*
- * This byteCode is invalid: free it and recompile
+ * 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 ...).
*/
- objPtr->typePtr->freeIntRepProc(objPtr);
- goto recompileObj;
+
+ redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+ && (eclPtr->start != ctxCopyPtr->line[word]))
+ || ((eclPtr->type == TCL_LOCATION_BC)
+ && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
+ }
+
+ TclStackFree(interp, ctxCopyPtr);
+ if (!redo) {
+ return codePtr;
}
}
}
+ recompileObj:
+ iPtr->errorLine = 1;
+
/*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
+ * TIP #280. Remember the invoker for a moment in the interpreter
+ * structures so that the byte code compiler can pick it up when
+ * initializing the compilation environment, i.e. the extended location
+ * information.
*/
- codePtr->refCount++;
- result = TclExecuteByteCode(interp, codePtr);
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
+ iPtr->invokeCmdFramePtr = invoker;
+ iPtr->invokeWord = word;
+ TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
+ iPtr->invokeCmdFramePtr = NULL;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
}
- iPtr->numLevels--;
- return result;
+ return codePtr;
}
/*
*----------------------------------------------------------------------
*
- * TclExecuteByteCode --
+ * TclIncrObj --
+ *
+ * Increment an integeral value in a Tcl_Obj by an integeral value held
+ * in another Tcl_Obj. Caller is responsible for making sure we can
+ * update the first object.
+ *
+ * Results:
+ * TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
+ * error, an error message is left in the interpreter (if it is not NULL,
+ * of course).
+ *
+ * Side effects:
+ * valuePtr gets the new incrmented value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIncrObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *valuePtr,
+ Tcl_Obj *incrPtr)
+{
+ ClientData ptr1, ptr2;
+ int type1, type2;
+ mp_int value, incr;
+
+ if (Tcl_IsShared(valuePtr)) {
+ Tcl_Panic("%s called with shared object", "TclIncrObj");
+ }
+
+ if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
+ /*
+ * Produce error message (reparse?!)
+ */
+
+ return TclGetIntFromObj(interp, valuePtr, &type1);
+ }
+ if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) {
+ /*
+ * Produce error message (reparse?!)
+ */
+
+ TclGetIntFromObj(interp, incrPtr, &type1);
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ return TCL_ERROR;
+ }
+
+ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+ long augend = *((const long *) ptr1);
+ long addend = *((const long *) ptr2);
+ long sum = augend + addend;
+
+ /*
+ * Overflow when (augend and sum have different sign) and (augend and
+ * addend have the same sign). This is encapsulated in the Overflowing
+ * macro.
+ */
+
+ if (!Overflowing(augend, addend, sum)) {
+ TclSetLongObj(valuePtr, sum);
+ return TCL_OK;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ {
+ Tcl_WideInt w1 = (Tcl_WideInt) augend;
+ Tcl_WideInt w2 = (Tcl_WideInt) addend;
+
+ /*
+ * We know the sum value is outside the long range, so we use the
+ * macro form that doesn't range test again.
+ */
+
+ TclSetWideIntObj(valuePtr, w1 + w2);
+ return TCL_OK;
+ }
+#endif
+ }
+
+ if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
+ /*
+ * Produce error message (reparse?!)
+ */
+
+ return TclGetIntFromObj(interp, valuePtr, &type1);
+ }
+ if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
+ /*
+ * Produce error message (reparse?!)
+ */
+
+ TclGetIntFromObj(interp, incrPtr, &type1);
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ return TCL_ERROR;
+ }
+
+#ifndef TCL_WIDE_INT_IS_LONG
+ if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+ Tcl_WideInt w1, w2, sum;
+
+ TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ TclGetWideIntFromObj(NULL, incrPtr, &w2);
+ sum = w1 + w2;
+
+ /*
+ * Check for overflow.
+ */
+
+ if (!Overflowing(w1, w2, sum)) {
+ Tcl_SetWideIntObj(valuePtr, sum);
+ return TCL_OK;
+ }
+ }
+#endif
+
+ Tcl_TakeBignumFromObj(interp, valuePtr, &value);
+ Tcl_GetBignumFromObj(interp, incrPtr, &incr);
+ mp_add(&value, &incr, &value);
+ mp_clear(&incr);
+ Tcl_SetBignumObj(valuePtr, &value);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArgumentBCEnter --
+ *
+ * This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
+ * a code sequence that is fairly common in the code but *not* commonly
+ * called.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May register information about the bytecode in the command frame.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArgumentBCEnter(
+ Tcl_Interp *interp,
+ ByteCode *codePtr,
+ TEBCdata *tdPtr,
+ const unsigned char *pc,
+ int objc,
+ Tcl_Obj **objv)
+{
+ int cmd;
+
+ if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+ TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
+ pc - codePtr->codeStart);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRExecuteByteCode --
*
* This procedure executes the instructions of a ByteCode structure. It
* returns when a "done" instruction is executed or an error occurs.
@@ -1046,11 +2047,81 @@ TclCompEvalObj(interp, objPtr)
*
*----------------------------------------------------------------------
*/
+#define bcFramePtr (&TD->cmdFrame)
+#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1]))
+#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
+#define esPtr (iPtr->execEnvPtr->execStackPtr)
+
+int
+TclNRExecuteByteCode(
+ Tcl_Interp *interp, /* Token for command interpreter. */
+ ByteCode *codePtr) /* The bytecode sequence to interpret. */
+{
+ Interp *iPtr = (Interp *) interp;
+ TEBCdata *TD;
+ int size = sizeof(TEBCdata) - 1
+ + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
+ * sizeof(void *);
+ int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
+
+ codePtr->refCount++;
+
+ /*
+ * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
+ *
+ * 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
+ * catch commands that could ever be executing at the same time (this will
+ * be no more than the exception range array's depth). Make sure the
+ * execution stack is large enough to execute this ByteCode.
+ */
+
+ TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
+ esPtr->tosPtr = initTosPtr;
+
+ TD->codePtr = codePtr;
+ TD->catchTop = initCatchTop;
+ TD->auxObjList = NULL;
+
+ /*
+ * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
+ * every time that we call out from this TD, popped when we return to it.
+ */
+
+ bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+ ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
+ bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
+ bcFramePtr->framePtr = iPtr->framePtr;
+ bcFramePtr->nextPtr = iPtr->cmdFramePtr;
+ bcFramePtr->nline = 0;
+ bcFramePtr->line = NULL;
+ bcFramePtr->litarg = NULL;
+ bcFramePtr->data.tebc.codePtr = codePtr;
+ bcFramePtr->data.tebc.pc = NULL;
+ bcFramePtr->cmdObj = NULL;
+ bcFramePtr->cmd = NULL;
+ bcFramePtr->len = 0;
+
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.numExecutions++;
+#endif
+
+ /*
+ * Push the callback for bytecode execution
+ */
+
+ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
+ /* cleanup */ INT2PTR(0), NULL);
+ return TCL_OK;
+}
static int
-TclExecuteByteCode(interp, codePtr)
- Tcl_Interp *interp; /* Token for command interpreter. */
- ByteCode *codePtr; /* The bytecode sequence to interpret. */
+TEBCresume(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
{
/*
* Compiler cast directive - not a real variable.
@@ -1059,103 +2130,160 @@ TclExecuteByteCode(interp, codePtr)
#define iPtr ((Interp *) interp)
/*
- * Constants: variables that do not change during the execution, used
- * sporadically.
+ * Check just the read-traced/write-traced bit of a variable.
*/
- ExecEnv *eePtr; /* Points to the execution environment. */
- int initStackTop; /* Stack top at start of execution. */
- int initCatchTop; /* Catch stack top at start of execution. */
- Var *compiledLocals;
- Namespace *namespacePtr;
+#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ)
+#define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE)
+#define UnsetTraced(varPtr) ((varPtr)->flags & VAR_TRACED_UNSET)
/*
- * Globals: variables that store state, must remain valid at all times.
+ * Bottom of allocated stack holds the NR data
+ */
+
+ /*
+ * Constants: variables that do not change during the execution, used
+ * sporadically: no special need for speed.
*/
- int catchTop;
- register Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation stack. */
- register unsigned char *pc = codePtr->codeStart;
- /* The current program counter. */
int instructionCount = 0; /* Counter that is used to work out when to
* call Tcl_AsyncReady() */
- Tcl_Obj *expandNestList = NULL;
- int checkInterp = 0; /* Indicates when a check of interp readyness
- * is necessary. Set by DECACHE_STACK_INFO() */
+ const char *curInstName;
+#ifdef TCL_COMPILE_DEBUG
+ int traceInstructions; /* Whether we are doing instruction-level
+ * tracing or not. */
+#endif
+
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
+
+#define LOCAL(i) (&compiledLocals[(i)])
+#define TCONST(i) (constants[(i)])
/*
- * Transfer variables - needed only between opcodes, but not while
- * executing an instruction.
+ * These macros are just meant to save some global variables that are not
+ * used too frequently
*/
- register int cleanup;
- Tcl_Obj *objResultPtr;
+ TEBCdata *TD = data[0];
+#define auxObjList (TD->auxObjList)
+#define catchTop (TD->catchTop)
+#define codePtr (TD->codePtr)
+
+ /*
+ * 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 = data[1];
+ /* The current program counter. */
+ unsigned char inst; /* The currently running instruction */
+
/*
- * Result variable - needed only when going to checkForcatch or other
- * error handlers; also used as local in some opcodes.
+ * Transfer variables - needed only between opcodes, but not while
+ * executing an instruction.
*/
- int result = TCL_OK; /* Return code returned after execution. */
+ int cleanup = PTR2INT(data[2]);
+ Tcl_Obj *objResultPtr;
+ int checkInterp; /* Indicates when a check of interp readyness
+ * is necessary. Set by CACHE_STACK_INFO() */
/*
* Locals - variables that are used within opcodes or bounded sections of
* the file (jumps between opcodes within a family).
- * NOTE: These are now defined locally where needed.
+ * NOTE: These are now mostly defined locally where needed.
*/
+ Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
+ Tcl_Obj **objv;
+ int objc = 0;
+ int opnd, length, pcAdjustment;
+ Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
- int traceInstructions = (tclTraceExec == 3);
char cmdNameBuf[21];
#endif
- /*
- * The execution uses a unified stack: first the catch stack, immediately
- * above it the execution stack.
- *
- * Make sure the catch stack is large enough to hold the maximum number of
- * catch commands that could ever be executing at the same time (this will
- * be no more than the exception range array's depth). Make sure the
- * execution stack is large enough to execute this ByteCode.
- */
-
- eePtr = iPtr->execEnvPtr;
- initCatchTop = eePtr->tosPtr - eePtr->stackPtr;
- catchTop = initCatchTop;
- tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
+#ifdef TCL_COMPILE_DEBUG
+ int starting = 1;
+ traceInstructions = (tclTraceExec == 3);
+#endif
- while ((tosPtr + codePtr->maxStackDepth) > eePtr->endPtr) {
- GrowEvaluationStack(eePtr);
- tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
- }
- initStackTop = tosPtr - eePtr->stackPtr;
+ TEBC_DATA_DIG();
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
+ if (!pc && (tclTraceExec >= 2)) {
PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", initStackTop);
+ fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
fflush(stdout);
}
#endif
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.numExecutions++;
-#endif
-
- if (iPtr->varFramePtr != NULL) {
- namespacePtr = iPtr->varFramePtr->nsPtr;
- compiledLocals = iPtr->varFramePtr->compiledLocals;
+ if (!pc) {
+ /* bytecode is starting from scratch */
+ checkInterp = 0;
+ pc = codePtr->codeStart;
+ goto cleanup0;
} else {
- namespacePtr = iPtr->globalNsPtr;
- compiledLocals = NULL;
- }
+ /* resume from invocation */
+ CACHE_STACK_INFO();
+ if (iPtr->execEnvPtr->rewind) {
+ result = TCL_ERROR;
+ goto abnormalReturn;
+ }
- /*
- * Loop executing instructions until a "done" instruction, a TCL_RETURN,
- * or some error.
- */
+ NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
+ if (bcFramePtr->cmdObj) {
+ Tcl_DecrRefCount(bcFramePtr->cmdObj);
+ bcFramePtr->cmdObj = NULL;
+ bcFramePtr->cmd = NULL;
+ }
+ iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ TclArgumentBCRelease(interp, bcFramePtr);
+ }
+ if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+ }
- goto cleanup0;
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
+ }
+
+ /*
+ * 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));
+
+ /*
+ * 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.
+ *
+ * Note that the result object is now in objResultPtr, it keeps the
+ * refCount it had in its role of iPtr->objResultPtr.
+ */
+
+ objResultPtr = Tcl_GetObjResult(interp);
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+#ifndef TCL_COMPILE_DEBUG
+ if (*pc == INST_POP) {
+ TclDecrRefCount(objResultPtr);
+ NEXT_INST_V(1, cleanup, 0);
+ }
+#endif
+ NEXT_INST_V(0, cleanup, -1);
+ }
/*
* Targets for standard instruction endings; unrolled for speed in the
@@ -1166,297 +2294,477 @@ TclExecuteByteCode(interp, codePtr)
* cleanup.
*/
- {
- Tcl_Obj *valuePtr;
+ cleanupV_pushObjResultPtr:
+ switch (cleanup) {
+ case 0:
+ *(++tosPtr) = (objResultPtr);
+ goto cleanup0;
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ }
+ case 2:
+ cleanup2_pushObjResultPtr:
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ case 1:
+ cleanup1_pushObjResultPtr:
+ objPtr = OBJ_AT_TOS;
+ TclDecrRefCount(objPtr);
+ }
+ OBJ_AT_TOS = objResultPtr;
+ goto cleanup0;
- cleanupV_pushObjResultPtr:
- switch (cleanup) {
- case 0:
- *(++tosPtr) = (objResultPtr);
- goto cleanup0;
- default:
- cleanup -= 2;
- while (cleanup--) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
+ cleanupV:
+ switch (cleanup) {
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ }
+ case 2:
+ cleanup2:
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ case 1:
+ cleanup1:
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ case 0:
+ /*
+ * We really want to do nothing now, but this is needed for some
+ * compilers (SunPro CC).
+ */
+
+ break;
+ }
+ cleanup0:
+
+ /*
+ * Check for asynchronous handlers [Bug 746722]; we do the check every
+ * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+ */
+
+ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ DECACHE_STACK_INFO();
+ if (TclAsyncReady(iPtr)) {
+ result = Tcl_AsyncInvoke(interp, result);
+ if (result == TCL_ERROR) {
+ CACHE_STACK_INFO();
+ goto gotError;
}
- case 2:
- cleanup2_pushObjResultPtr:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 1:
- cleanup1_pushObjResultPtr:
- valuePtr = *tosPtr;
- TclDecrRefCount(valuePtr);
}
- *tosPtr = objResultPtr;
- goto cleanup0;
- cleanupV:
- switch (cleanup) {
- default:
- cleanup -= 2;
- while (cleanup--) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
+ if (TclCanceled(iPtr)) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ CACHE_STACK_INFO();
+ goto gotError;
}
- case 2:
- cleanup2:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 1:
- cleanup1:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 0:
- /*
- * We really want to do nothing now, but this is needed for some
- * compilers (SunPro CC)
- */
- break;
}
+
+ if (TclLimitReady(iPtr->limit)) {
+ if (Tcl_LimitCheck(interp) == TCL_ERROR) {
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ }
+ CACHE_STACK_INFO();
}
- cleanup0:
+
+ /*
+ * These two instructions account for 26% of all instructions (according
+ * to measurements on tclbench by Ben Vitale
+ * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf]
+ * Resolving them before the switch reduces the cost of branch
+ * mispredictions, seems to improve runtime by 5% to 15%, and (amazingly!)
+ * reduces total obj size.
+ */
+
+ inst = *pc;
+
+ peepholeStart:
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.instructionCount[*pc]++;
+#endif
#ifdef TCL_COMPILE_DEBUG
/*
- * Skip the stack depth check if an expansion is in progress
+ * Skip the stack depth check if an expansion is in progress.
*/
- ValidatePcAndStackTop(codePtr, pc, (tosPtr - eePtr->stackPtr),
- initStackTop, /*checkStack*/ (expandNestList == NULL));
+ CHECK_STACK();
if (traceInstructions) {
- fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (tosPtr - eePtr->stackPtr));
+ fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
TclPrintInstruction(codePtr, pc);
fflush(stdout);
}
#endif /* TCL_COMPILE_DEBUG */
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.instructionCount[*pc]++;
+ TCL_DTRACE_INST_NEXT();
+
+ if (inst == INST_LOAD_SCALAR1) {
+ goto instLoadScalar1;
+ } else if (inst == INST_PUSH1) {
+ PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+ TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS);
+ inst = *(pc += 2);
+ goto peepholeStart;
+ } else if (inst == INST_START_CMD) {
+ /*
+ * Peephole: do not run INST_START_CMD, just skip it
+ */
+
+ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
+ if (checkInterp) {
+ checkInterp = 0;
+ if (((codePtr->compileEpoch != iPtr->compileEpoch) ||
+ (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) &&
+ !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+ goto instStartCmdFailed;
+ }
+ }
+ inst = *(pc += 9);
+ goto peepholeStart;
+ } else if (inst == INST_NOP) {
+#ifndef TCL_COMPILE_DEBUG
+ while (inst == INST_NOP)
#endif
-
- /*
- * Check for asynchronous handlers [Bug 746722]; we do the check every
- * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
- */
-
- if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
- if (Tcl_AsyncReady()) {
- int localResult;
- DECACHE_STACK_INFO();
- localResult = Tcl_AsyncInvoke(interp, result);
- CACHE_STACK_INFO();
- if (localResult == TCL_ERROR) {
- result = localResult;
- goto checkForCatch;
- }
- }
- if (Tcl_LimitReady(interp)) {
- int localResult;
- DECACHE_STACK_INFO();
- localResult = Tcl_LimitCheck(interp);
- CACHE_STACK_INFO();
- if (localResult == TCL_ERROR) {
- result = localResult;
- goto checkForCatch;
- }
+ {
+ inst = *++pc;
}
+ goto peepholeStart;
}
-
- switch (*pc) {
+
+ switch (inst) {
+ case INST_SYNTAX:
case INST_RETURN_IMM: {
int code = TclGetInt4AtPtr(pc+1);
int level = TclGetUInt4AtPtr(pc+5);
- Tcl_Obj *returnOpts;
+
+ /*
+ * OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr.
+ */
TRACE(("%u %u => ", code, level));
- returnOpts = POP_OBJECT();
- result = TclProcessReturn(interp, code, level, returnOpts);
- Tcl_DecrRefCount(returnOpts);
- if (result != TCL_OK) {
- Tcl_SetObjResult(interp, *tosPtr);
- cleanup = 1;
- goto processExceptionReturn;
+ result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
+ if (result == TCL_OK) {
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
+ O2S(objResultPtr)));
+ NEXT_INST_F(9, 1, 0);
}
- TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
- O2S(objResultPtr)));
- NEXT_INST_F(9, 0, 0);
+ Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
+ if (*pc == INST_SYNTAX) {
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ }
+ cleanup = 2;
+ TRACE_APPEND(("\n"));
+ goto processExceptionReturn;
}
case INST_RETURN_STK:
TRACE(("=> "));
objResultPtr = POP_OBJECT();
- result = Tcl_SetReturnOptions(interp, POP_OBJECT());
- if (result != TCL_OK) {
+ result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+ if (result == TCL_OK) {
+ Tcl_DecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = objResultPtr;
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
+ O2S(objResultPtr)));
+ NEXT_INST_F(1, 0, 0);
+ } else if (result == TCL_ERROR) {
+ /*
+ * BEWARE! Must do this in this order, because an error in the
+ * option dictionary overrides the result (and can be verified by
+ * test).
+ */
+
+ Tcl_SetObjResult(interp, objResultPtr);
+ Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+ Tcl_DecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = objResultPtr;
+ } else {
+ Tcl_DecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = objResultPtr;
Tcl_SetObjResult(interp, objResultPtr);
- Tcl_DecrRefCount(objResultPtr);
- cleanup = 0;
- goto processExceptionReturn;
}
- TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
- O2S(objResultPtr)));
- NEXT_INST_F(1, 0, -1);
+ cleanup = 1;
+ TRACE_APPEND(("\n"));
+ goto processExceptionReturn;
- case INST_DONE:
- if (tosPtr <= eePtr->stackPtr + initStackTop) {
- tosPtr--;
- goto abnormalReturn;
+ {
+ CoroutineData *corPtr;
+ int yieldParameter;
+
+ case INST_YIELD:
+ 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));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
}
- /*
- * Set the interpreter's object result to point to the topmost object
- * from the stack, and check for a possible [catch]. The stackTop's
- * level and refCount will be handled by "processCatch" or
- * "abnormalReturn".
- */
-
- Tcl_SetObjResult(interp, *tosPtr);
#ifdef TCL_COMPILE_DEBUG
- TRACE_WITH_OBJ(("=> return code=%d, result=", result),
- iPtr->objResultPtr);
- if (traceInstructions) {
- fprintf(stdout, "\n");
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE_APPEND(("YIELD...\n"));
+ } else {
+ fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(OBJ_AT_TOS));
+ }
+ fflush(stdout);
}
#endif
- goto checkForCatch;
+ yieldParameter = 0;
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+ goto doYield;
+
+ case INST_YIELD_TO_INVOKE:
+ corPtr = iPtr->execEnvPtr->corPtr;
+ valuePtr = OBJ_AT_TOS;
+ if (!corPtr) {
+ TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+ TRACE(("[%.30s] => ERROR: yield in deleted\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
- case INST_PUSH1:
-#if !TCL_COMPILE_DEBUG
- instPush1Peephole:
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
+ } else {
+ /* FIXME: What is the right thing to trace? */
+ fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(valuePtr));
+ }
+ fflush(stdout);
+ }
#endif
- PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
- TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), *tosPtr);
- pc += 2;
-#if !TCL_COMPILE_DEBUG
+
/*
- * Runtime peephole optimisation: check if we are pushing again.
+ * Install a tailcall record in the caller and continue with the
+ * yield. The yield is switched into multi-return mode (via the
+ * 'yieldParameter').
+ */
+
+ Tcl_IncrRefCount(valuePtr);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ TclSetTailcall(interp, valuePtr);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
+
+ doYield:
+ /* 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 (*pc == INST_PUSH1) {
- goto instPush1Peephole;
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
-#endif
- NEXT_INST_F(0, 0, 0);
- case INST_PUSH4:
- objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
- TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
- NEXT_INST_F(5, 0, 1);
+ pc++;
+ cleanup = 1;
+ TEBC_YIELD();
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+ INT2PTR(yieldParameter), NULL, NULL);
+ return TCL_OK;
+ }
- case INST_POP: {
- Tcl_Obj *valuePtr;
+ case INST_TAILCALL: {
+ Tcl_Obj *listPtr, *nsObjPtr;
- TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
+ opnd = TclGetUInt1AtPtr(pc+1);
- /*
- * Runtime peephole optimisation: an INST_POP is scheduled at the end
- * of most commands. If the next instruction is an INST_START_CMD,
- * fall through to it.
- */
+ 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));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
- pc++;
-#if !TCL_COMPILE_DEBUG
- if (*pc == INST_START_CMD) {
- goto instStartCmdPeephole;
+#ifdef TCL_COMPILE_DEBUG
+ /* FIXME: What is the right thing to trace? */
+ {
+ 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
- NEXT_INST_F(0, 0, 0);
- }
- case INST_START_CMD:
-#if !TCL_COMPILE_DEBUG
- instStartCmdPeephole:
-#endif
/*
- * Remark that if the interpreter is marked for deletion its
- * compileEpoch is modified, so that the epoch check also verifies
- * that the interp is not deleted. If no outside call has been made
- * since the last check, it is safe to omit the check.
+ * Push the evaluation of the called command into the NR callback
+ * stack.
*/
- iPtr->cmdCount++;
- if (!checkInterp ||
- (((codePtr->compileEpoch == iPtr->compileEpoch)
- && (codePtr->nsEpoch == namespacePtr->resolverEpoch))
- || (codePtr->flags & TCL_BYTECODE_PRECOMPILED))) {
-#if !TCL_COMPILE_DEBUG
+ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
+ TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+ if (iPtr->varFramePtr->tailcallPtr) {
+ Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+ }
+ iPtr->varFramePtr->tailcallPtr = listPtr;
+
+ result = TCL_RETURN;
+ cleanup = opnd;
+ goto processExceptionReturn;
+ }
+
+ case INST_DONE:
+ if (tosPtr > initTosPtr) {
/*
- * Peephole optimisations: check if there are several
- * INST_START_CMD in a row. Many commands start by pushing a
- * literal argument or command name; optimise that case too.
+ * Set the interpreter's object result to point to the topmost
+ * object from the stack, and check for a possible [catch]. The
+ * stackTop's level and refCount will be handled by "processCatch"
+ * or "abnormalReturn".
*/
- while (*(pc += 5) == INST_START_CMD) {
- iPtr->cmdCount++;
- }
- if (*pc == INST_PUSH1) {
- goto instPush1Peephole;
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+#ifdef TCL_COMPILE_DEBUG
+ TRACE_WITH_OBJ(("=> return code=%d, result=", result),
+ iPtr->objResultPtr);
+ if (traceInstructions) {
+ fprintf(stdout, "\n");
}
- NEXT_INST_F(0, 0, 0);
-#else
- NEXT_INST_F(5, 0, 0);
#endif
- } else {
- char *bytes;
- int length, opnd;
- Tcl_Obj *newObjResultPtr;
-
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- DECACHE_STACK_INFO();
- result = Tcl_EvalEx(interp, bytes, length, 0);
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- cleanup = 0;
- goto processExceptionReturn;
- }
- opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = Tcl_GetObjResult(interp);
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- NEXT_INST_V(opnd, 0, -1);
+ goto checkForCatch;
}
+ (void) POP_OBJECT();
+ goto abnormalReturn;
+
+ case INST_PUSH4:
+ objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
+ TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
+ NEXT_INST_F(5, 0, 1);
+
+ case INST_POP:
+ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ NEXT_INST_F(1, 0, 0);
case INST_DUP:
- objResultPtr = *tosPtr;
+ objResultPtr = OBJ_AT_TOS;
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
- case INST_OVER: {
- int opnd;
-
+ case INST_OVER:
opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = *(tosPtr - opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
+ objResultPtr = OBJ_AT_DEPTH(opnd);
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_F(5, 0, 1);
+
+ case INST_REVERSE: {
+ Tcl_Obj **a, **b;
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ a = tosPtr-(opnd-1);
+ b = tosPtr;
+ while (a<b) {
+ tmpPtr = *a;
+ *a = *b;
+ *b = tmpPtr;
+ a++; b--;
+ }
+ TRACE(("%u => OK\n", opnd));
+ NEXT_INST_F(5, 0, 0);
}
- case INST_CONCAT1: {
- int opnd, length, appendLen = 0;
+ case INST_STR_CONCAT1: {
+ int appendLen = 0;
char *bytes, *p;
Tcl_Obj **currPtr;
+ int onlyb = 1;
opnd = TclGetUInt1AtPtr(pc+1);
/*
+ * Detect only-bytearray-or-null case.
+ */
+
+ for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
+ if (((*currPtr)->typePtr != &tclByteArrayType)
+ && ((*currPtr)->bytes != tclEmptyStringRep)) {
+ onlyb = 0;
+ break;
+ } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
+ ((*currPtr)->bytes != NULL)) {
+ onlyb = 0;
+ break;
+ }
+ }
+
+ /*
* Compute the length to be appended.
*/
- for (currPtr = tosPtr - (opnd-2); currPtr <= tosPtr; currPtr++) {
- bytes = Tcl_GetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- appendLen += length;
+ if (onlyb) {
+ for (currPtr = &OBJ_AT_DEPTH(opnd-2);
+ appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
+ if ((*currPtr)->bytes != tclEmptyStringRep) {
+ Tcl_GetByteArrayFromObj(*currPtr, &length);
+ appendLen += length;
+ }
+ }
+ } else {
+ for (currPtr = &OBJ_AT_DEPTH(opnd-2);
+ appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
+ bytes = TclGetStringFromObj(*currPtr, &length);
+ if (bytes != NULL) {
+ appendLen += length;
+ }
}
}
+ if (appendLen < 0) {
+ /* TODO: convert panic to error ? */
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
/*
* If nothing is to be appended, just return the first object by
* dropping all the others from the stack; this saves both the
* computation and copy of the string rep of the first object,
- * enabling the fast '$x[set x {}]' idiom for 'K $x [set x{}]'.
+ * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
*/
if (appendLen == 0) {
@@ -1466,54 +2774,106 @@ TclExecuteByteCode(interp, codePtr)
/*
* If the first object is shared, we need a new obj for the result;
- * otherwise, we can reuse the first object. In any case, make sure
- * it has enough room to accomodate all the concatenated bytes. Note
- * that if it is unshared its bytes are already copied by
- * Tcl_SetObjectLength, so that we set the loop parameters to avoid
- * copying them again: p points to the end of the already copied
- * bytes, currPtr to the second object.
- */
-
- objResultPtr = *(tosPtr-(opnd-1));
- bytes = Tcl_GetStringFromObj(objResultPtr, &length);
-#if !TCL_COMPILE_DEBUG
- if (!Tcl_IsShared(objResultPtr)) {
- Tcl_SetObjLength(objResultPtr, (length + appendLen));
- p = TclGetString(objResultPtr) + length;
- currPtr = tosPtr - (opnd - 2);
- } else {
+ * otherwise, we can reuse the first object. In any case, make sure it
+ * has enough room to accomodate all the concatenated bytes. Note that
+ * if it is unshared its bytes are copied by ckrealloc, so that we set
+ * the loop parameters to avoid copying them again: p points to the
+ * end of the already copied bytes, currPtr to the second object.
+ */
+
+ objResultPtr = OBJ_AT_DEPTH(opnd-1);
+ if (!onlyb) {
+ bytes = TclGetStringFromObj(objResultPtr, &length);
+ if (length + appendLen < 0) {
+ /* TODO: convert panic to error ? */
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
+ INT_MAX);
+ }
+#ifndef TCL_COMPILE_DEBUG
+ if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
+ TclFreeIntRep(objResultPtr);
+ objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
+ objResultPtr->length = length + appendLen;
+ p = TclGetString(objResultPtr) + length;
+ currPtr = &OBJ_AT_DEPTH(opnd - 2);
+ } else
#endif
- p = (char *) ckalloc((unsigned) (length + appendLen + 1));
- TclNewObj(objResultPtr);
- objResultPtr->bytes = p;
- objResultPtr->length = length + appendLen;
- currPtr = tosPtr - (opnd - 1);
-#if !TCL_COMPILE_DEBUG
- }
+ {
+ p = ckalloc(length + appendLen + 1);
+ TclNewObj(objResultPtr);
+ objResultPtr->bytes = p;
+ objResultPtr->length = length + appendLen;
+ currPtr = &OBJ_AT_DEPTH(opnd - 1);
+ }
+
+ /*
+ * Append the remaining characters.
+ */
+
+ for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
+ bytes = TclGetStringFromObj(*currPtr, &length);
+ if (bytes != NULL) {
+ memcpy(p, bytes, (size_t) length);
+ p += length;
+ }
+ }
+ *p = '\0';
+ } else {
+ bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
+ if (length + appendLen < 0) {
+ /* TODO: convert panic to error ? */
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
+ INT_MAX);
+ }
+#ifndef TCL_COMPILE_DEBUG
+ if (!Tcl_IsShared(objResultPtr)) {
+ bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
+ length + appendLen);
+ p = bytes + length;
+ currPtr = &OBJ_AT_DEPTH(opnd - 2);
+ } else
#endif
+ {
+ TclNewObj(objResultPtr);
+ bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
+ length + appendLen);
+ p = bytes;
+ currPtr = &OBJ_AT_DEPTH(opnd - 1);
+ }
- /*
- * Append the remaining characters.
- */
+ /*
+ * Append the remaining characters.
+ */
- for (; currPtr <= tosPtr; currPtr++) {
- bytes = Tcl_GetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- memcpy((VOID *) p, (VOID *) bytes, (size_t) length);
- p += length;
+ for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
+ if ((*currPtr)->bytes != tclEmptyStringRep) {
+ bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
+ memcpy(p, bytes, (size_t) length);
+ p += length;
+ }
}
}
- *p = '\0';
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
}
- case INST_EXPAND_START: {
+ case INST_CONCAT_STK:
+ /*
+ * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+ * and then decrement their ref counts.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+
+ case INST_EXPAND_START:
/*
- * Push an element to the expandNestList. This records the current
- * tosPtr - i.e., the point in the stack where the expanded command
- * starts.
+ * Push an element to the auxObjList. This records the current
+ * stack depth - i.e., the point in the stack where the expanded
+ * command starts.
*
* Use a Tcl_Obj as linked list element; slight mem waste, but faster
* allocation than ckalloc. This also abuses the Tcl_Obj structure, as
@@ -1523,91 +2883,135 @@ TclExecuteByteCode(interp, codePtr)
* error, also in INST_EXPAND_STKTOP).
*/
- Tcl_Obj *objPtr;
-
TclNewObj(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)
- (tosPtr - eePtr->stackPtr);
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
- expandNestList = objPtr;
+ objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
+ objPtr->length = 0;
+ PUSH_TAUX_OBJ(objPtr);
+ TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
- }
+
+ case INST_EXPAND_DROP:
+ /*
+ * Drops an element of the auxObjList, popping stack elements to
+ * restore the stack to the state before the point where the aux
+ * element was created.
+ */
+
+ CLANG_ASSERT(auxObjList);
+ objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ POP_TAUX_OBJ();
+#ifdef TCL_COMPILE_DEBUG
+ /* Ugly abuse! */
+ starting = 1;
+#endif
+ TRACE(("=> drop %d items\n", objc));
+ NEXT_INST_V(1, objc, 0);
case INST_EXPAND_STKTOP: {
- int objc, length, i;
- Tcl_Obj **objv, *valuePtr, *objPtr;
+ int i;
+ ptrdiff_t moved;
/*
- * Make sure that the element at stackTop is a list; if not, remove
- * the element from the expand link list and leave.
+ * Make sure that the element at stackTop is a list; if not, just
+ * leave with an error. Note that the element from the expand list
+ * will be removed at checkForCatch.
*/
- valuePtr = *tosPtr;
- if (Tcl_ListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
- result = TCL_ERROR;
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- objPtr = expandNestList;
- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
- TclDecrRefCount(objPtr);
- goto checkForCatch;
+ objPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
+ if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- tosPtr--;
+ (void) POP_OBJECT();
/*
* Make sure there is enough room in the stack to expand this list
* *and* process the rest of the command (at least up to the next
- * argument expansion or command end). The operand is the current
+ * argument expansion or command end). The operand is the current
* stack depth, as seen by the compiler.
*/
- length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
- while ((tosPtr + length) > eePtr->endPtr) {
+ auxObjList->length += objc - 1;
+ if ((objc > 1) && (auxObjList->length > 0)) {
+ length = auxObjList->length /* Total expansion room we need */
+ + codePtr->maxStackDepth /* Beyond the original max */
+ - CURR_DEPTH; /* Relative to where we are */
DECACHE_STACK_INFO();
- GrowEvaluationStack(eePtr);
- CACHE_STACK_INFO();
+ moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
+ - (Tcl_Obj **) TD;
+ if (moved) {
+ /*
+ * Change the global data to point to the new stack: move the
+ * TEBCdataPtr TD, recompute the position of every other
+ * stack-allocated parameter, update the stack pointers.
+ */
+
+ esPtr = iPtr->execEnvPtr->execStackPtr;
+ TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+
+ catchTop += moved;
+ tosPtr += moved;
+ }
}
/*
- * Expand the list at stacktop onto the stack; free the list.
+ * Expand the list at stacktop onto the stack; free the list. Knowing
+ * that it has a freeIntRepProc we use Tcl_DecrRefCount().
*/
for (i = 0; i < objc; i++) {
PUSH_OBJECT(objv[i]);
}
- TclDecrRefCount(valuePtr);
+
+ TRACE_APPEND(("OK\n"));
+ Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
- {
+ case INST_EXPR_STK: {
+ ByteCode *newCodePtr;
+
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+ DECACHE_STACK_INFO();
+ newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
+ CACHE_STACK_INFO();
+ cleanup = 1;
+ pc++;
+ TEBC_YIELD();
+ return TclNRExecuteByteCode(interp, newCodePtr);
+ }
+
/*
* INVOCATION BLOCK
*/
- int objc, pcAdjustment;
+ instEvalStk:
+ case INST_EVAL_STK:
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
- case INST_INVOKE_EXPANDED:
- {
- Tcl_Obj *objPtr;
+ cleanup = 1;
+ pc += 1;
+ TEBC_YIELD();
+ return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
- objPtr = expandNestList;
- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
- objc = tosPtr - eePtr->stackPtr
- - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
- TclDecrRefCount(objPtr);
+ case INST_INVOKE_EXPANDED:
+ CLANG_ASSERT(auxObjList);
+ objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ POP_TAUX_OBJ();
+ if (objc) {
+ pcAdjustment = 1;
+ goto doInvocation;
}
- if (objc == 0) {
- /*
- * Nothing was expanded, return {}.
- */
-
- TclNewObj(objResultPtr);
- NEXT_INST_F(1, 0, 1);
- }
+ /*
+ * Nothing was expanded, return {}.
+ */
- pcAdjustment = 1;
- goto doInvocation;
+ TclNewObj(objResultPtr);
+ NEXT_INST_F(1, 0, 1);
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
@@ -1619,224 +3023,211 @@ TclExecuteByteCode(interp, codePtr)
pcAdjustment = 2;
doInvocation:
- {
- Tcl_Obj **objv = (tosPtr - (objc-1));
- int length;
- char *bytes;
-
- /*
- * We keep the stack reference count as a (char *), as that works
- * nicely as a portable pointer-sized counter.
- */
-
- char **preservedStackRefCountPtr;
+ objv = &OBJ_AT_DEPTH(objc-1);
+ cleanup = objc;
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- int i;
-
- if (traceInstructions) {
- strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
- TRACE(("%u => call ", objc));
- } else {
- fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
- (unsigned int)(pc - codePtr->codeStart));
- }
- for (i = 0; i < objc; i++) {
- TclPrintObject(stdout, objv[i], 15);
- fprintf(stdout, " ");
- }
- fprintf(stdout, "\n");
- fflush(stdout);
- }
-#endif /*TCL_COMPILE_DEBUG*/
-
- /*
- * If trace procedures will be called, we need a command string to
- * pass to TclEvalObjvInternal; note that a copy of the string
- * will be made there to include the ending \0.
- */
+ if (tclTraceExec >= 2) {
+ int i;
- bytes = NULL;
- length = 0;
- if (iPtr->tracePtr != NULL) {
- Trace *tracePtr, *nextTracePtr;
-
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
- tracePtr = nextTracePtr) {
- nextTracePtr = tracePtr->nextPtr;
- if (tracePtr->level == 0 ||
- iPtr->numLevels <= tracePtr->level) {
- /*
- * Traces will be called: get command string
- */
-
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- break;
- }
- }
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ TRACE(("%u => call ", objc));
} else {
- Command *cmdPtr;
-
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if ((cmdPtr!=NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- }
+ fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
+ (unsigned)(pc - codePtr->codeStart));
}
+ for (i = 0; i < objc; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
- /*
- * A reference to part of the stack vector itself escapes our
- * control: increase its refCount to stop it from being
- * deallocated by a recursive call to ourselves. The extra
- * variable is needed because all others are liable to change due
- * to the trace procedures.
- */
-
- preservedStackRefCountPtr = (char **) (eePtr->stackPtr-1);
- ++*preservedStackRefCountPtr;
-
- /*
- * Reset the instructionCount variable, since we're about to check
- * for async stuff anyway while processing TclEvalObjvInternal.
- */
-
- instructionCount = 1;
+ /*
+ * Finally, let TclEvalObjv handle the command.
+ *
+ * TIP #280: Record the last piece of info needed by
+ * 'TclGetSrcInfoForPc', and push the frame.
+ */
- /*
- * Finally, let TclEvalObjvInternal handle the command.
- */
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
- DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
- CACHE_STACK_INFO();
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+ }
- /*
- * If the old stack is going to be released, it is safe to do so
- * now, since no references to objv are going to be used from now
- * on.
- */
+ DECACHE_STACK_INFO();
- --*preservedStackRefCountPtr;
- if (*preservedStackRefCountPtr == (char *) 0) {
- ckfree((VOID *) preservedStackRefCountPtr);
- }
+ pc += pcAdjustment;
+ TEBC_YIELD();
+ return TclNREvalObjv(interp, objc, objv,
+ TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
- if (result == TCL_OK) {
- Tcl_Obj *objPtr;
- /*
- * Push the call's object result and continue execution with
- * the next instruction.
- */
+#if TCL_SUPPORT_84_BYTECODE
+ case INST_CALL_BUILTIN_FUNC1:
+ /*
+ * Call one of the built-in pre-8.5 Tcl math functions. This
+ * translates to INST_INVOKE_STK1 with the first argument of
+ * ::tcl::mathfunc::$objv[0]. We need to insert the named math
+ * function into the stack.
+ */
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
+ opnd = TclGetUInt1AtPtr(pc+1);
+ if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
+ TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
+ Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
+ }
- objResultPtr = Tcl_GetObjResult(interp);
+ TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
+ Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
- /*
- * 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.
- *
- * Note that the result object is now in objResultPtr, it
- * keeps the refCount it had in its role of
- * iPtr->objResultPtr.
- */
+ /*
+ * Only 0, 1 or 2 args.
+ */
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
- NEXT_INST_V(pcAdjustment, objc, -1);
+ {
+ int numArgs = tclBuiltinFuncTable[opnd].numArgs;
+ Tcl_Obj *tmpPtr1, *tmpPtr2;
+
+ if (numArgs == 0) {
+ PUSH_OBJECT(objPtr);
+ } else if (numArgs == 1) {
+ tmpPtr1 = POP_OBJECT();
+ PUSH_OBJECT(objPtr);
+ PUSH_OBJECT(tmpPtr1);
+ Tcl_DecrRefCount(tmpPtr1);
} else {
- cleanup = objc;
- goto processExceptionReturn;
+ tmpPtr2 = POP_OBJECT();
+ tmpPtr1 = POP_OBJECT();
+ PUSH_OBJECT(objPtr);
+ PUSH_OBJECT(tmpPtr1);
+ PUSH_OBJECT(tmpPtr2);
+ Tcl_DecrRefCount(tmpPtr1);
+ Tcl_DecrRefCount(tmpPtr2);
}
+ objc = numArgs + 1;
}
- }
+ pcAdjustment = 2;
+ goto doInvocation;
- case INST_EVAL_STK: {
+ case INST_CALL_FUNC1:
/*
- * Note to maintainers: it is important that INST_EVAL_STK pop its
- * argument from the stack before jumping to checkForCatch! DO NOT
- * OPTIMISE!
+ * Call a non-builtin Tcl math function previously registered by a
+ * call to Tcl_CreateMathFunc pre-8.5. This is essentially
+ * INST_INVOKE_STK1 converting the first arg to
+ * ::tcl::mathfunc::$objv[0].
*/
- Tcl_Obj *objPtr;
+ objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
+ * name is the 0-th argument. */
- objPtr = *tosPtr;
- DECACHE_STACK_INFO();
- result = TclCompEvalObj(interp, objPtr);
- CACHE_STACK_INFO();
- if (result == TCL_OK) {
- /*
- * Normal return; push the eval's object result.
- */
+ objPtr = OBJ_AT_DEPTH(objc-1);
+ TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
+ Tcl_AppendObjToObj(tmpPtr, objPtr);
+ Tcl_DecrRefCount(objPtr);
- objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
+ /*
+ * Variation of PUSH_OBJECT.
+ */
- /*
- * 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.
- *
- * Note that the result object is now in objResultPtr, it keeps
- * the refCount it had in its role of iPtr->objResultPtr.
- */
+ OBJ_AT_DEPTH(objc-1) = tmpPtr;
+ Tcl_IncrRefCount(tmpPtr);
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
- NEXT_INST_F(1, 1, -1);
- } else {
- cleanup = 1;
- goto processExceptionReturn;
- }
- }
+ pcAdjustment = 2;
+ goto doInvocation;
+#else
+ /*
+ * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
+ * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
+ * remains for existing bytecode precompiled files.
+ */
- case INST_EXPR_STK: {
- Tcl_Obj *objPtr, *valuePtr;
+ case INST_CALL_BUILTIN_FUNC1:
+ Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
+ case INST_CALL_FUNC1:
+ Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+#endif
- objPtr = *tosPtr;
- DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = Tcl_ExprObj(interp, objPtr, &valuePtr);
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ case INST_INVOKE_REPLACE:
+ objc = TclGetUInt4AtPtr(pc+1);
+ opnd = TclGetUInt1AtPtr(pc+5);
+ objPtr = POP_OBJECT();
+ objv = &OBJ_AT_DEPTH(objc-1);
+ cleanup = objc;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ int i;
+
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
+ } else {
+ fprintf(stdout,
+ "%d: (%u) invoking (using implementation %s) ",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ O2S(objPtr));
+ }
+ for (i = 0; i < objc; i++) {
+ if (i < opnd) {
+ fprintf(stdout, "<");
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, ">");
+ } else {
+ TclPrintObject(stdout, objv[i], 15);
+ }
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
}
- objResultPtr = valuePtr;
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- NEXT_INST_F(1, 1, -1); /* already has right refct */
- }
+#endif /*TCL_COMPILE_DEBUG*/
+ {
+ Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
+ register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj **copyObjv = &listRepPtr->elements;
+ int i;
+
+ listRepPtr->elemCount = objc - opnd + 1;
+ copyObjv[0] = objPtr;
+ memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
+ for (i=1 ; i<objc-opnd+1 ; i++) {
+ Tcl_IncrRefCount(copyObjv[i]);
+ }
+ objPtr = copyPtr;
+ }
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+ }
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = opnd;
+ iPtr->ensembleRewrite.numInsertedObjs = 1;
+ DECACHE_STACK_INFO();
+ pc += 6;
+ TEBC_YIELD();
+
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
+ TclSkipTailcall(interp);
+ return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
/*
- * ---------------------------------------------------------
+ * -----------------------------------------------------------------
* Start of INST_LOAD instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
- * instructions set the value of some variables and then jump to somme
+ * WARNING: more 'goto' here than your doctor recommended! The different
+ * instructions set the value of some variables and then jump to some
* common execution code.
*/
- {
- int opnd, pcAdjustment;
- char *part1, *part2;
- Var *varPtr, *arrayPtr;
- Tcl_Obj *objPtr;
case INST_LOAD_SCALAR1:
+ instLoadScalar1:
opnd = TclGetUInt1AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -1845,6 +3236,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(2, 0, 1);
@@ -1852,13 +3244,12 @@ TclExecuteByteCode(interp, codePtr)
pcAdjustment = 2;
cleanup = 0;
arrayPtr = NULL;
- part2 = NULL;
+ part1Ptr = part2Ptr = NULL;
goto doCallPtrGetVar;
case INST_LOAD_SCALAR4:
opnd = TclGetUInt4AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -1867,6 +3258,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(5, 0, 1);
@@ -1874,42 +3266,7 @@ TclExecuteByteCode(interp, codePtr)
pcAdjustment = 5;
cleanup = 0;
arrayPtr = NULL;
- part2 = NULL;
- goto doCallPtrGetVar;
-
- case INST_LOAD_ARRAY_STK:
- cleanup = 2;
- part2 = Tcl_GetString(*tosPtr); /* element name */
- objPtr = *(tosPtr - 1); /* array name */
- TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
- goto doLoadStk;
-
- case INST_LOAD_STK:
- case INST_LOAD_SCALAR_STK:
- cleanup = 1;
- part2 = NULL;
- objPtr = *tosPtr; /* variable name */
- TRACE(("\"%.30s\" => ", O2S(objPtr)));
-
- doLoadStk:
- part1 = TclGetString(objPtr);
- varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
- "read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(1, cleanup, 1);
- }
- pcAdjustment = 1;
+ part1Ptr = part2Ptr = NULL;
goto doCallPtrGetVar;
case INST_LOAD_ARRAY4:
@@ -1922,31 +3279,69 @@ TclExecuteByteCode(interp, codePtr)
pcAdjustment = 2;
doLoadArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
+ part1Ptr = NULL;
+ part2Ptr = OBJ_AT_TOS;
+ arrayPtr = LOCAL(opnd);
while (TclIsVarLink(arrayPtr)) {
arrayPtr = arrayPtr->value.linkPtr;
}
- TRACE(("%u \"%.30s\" => ", opnd, part2));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+ TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
+ if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (varPtr && TclIsVarDirectReadable(varPtr)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(pcAdjustment, 1, 1);
+ }
+ }
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ cleanup = 1;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY_STK:
+ cleanup = 2;
+ part2Ptr = OBJ_AT_TOS; /* element name */
+ objPtr = OBJ_UNDER_TOS; /* array name */
+ TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), O2S(part2Ptr)));
+ goto doLoadStk;
+
+ case INST_LOAD_STK:
+ case INST_LOAD_SCALAR_STK:
+ cleanup = 1;
+ part2Ptr = NULL;
+ objPtr = OBJ_AT_TOS; /* variable name */
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
+
+ doLoadStk:
+ part1Ptr = objPtr;
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
+ &arrayPtr);
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+
+ if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(pcAdjustment, 1, 1);
+ NEXT_INST_V(1, cleanup, 1);
}
- cleanup = 1;
- goto doCallPtrGetVar;
+ pcAdjustment = 1;
+ opnd = -1;
doCallPtrGetVar:
/*
@@ -1955,110 +3350,179 @@ TclExecuteByteCode(interp, codePtr)
*/
DECACHE_STACK_INFO();
- objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2,
- TCL_LEAVE_ERR_MSG);
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+ part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(pcAdjustment, cleanup, 1);
- }
/*
* End of INST_LOAD instructions.
- * ---------------------------------------------------------
- */
-
- /*
- * ---------------------------------------------------------
+ * -----------------------------------------------------------------
* Start of INST_STORE and related instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
+ * WARNING: more 'goto' here than your doctor recommended! The different
* instructions set the value of some variables and then jump to somme
* common execution code.
*/
{
- int opnd, pcAdjustment, storeFlags;
- char *part1, *part2;
- Var *varPtr, *arrayPtr;
- Tcl_Obj *objPtr, *valuePtr;
+ int storeFlags;
+
+ case INST_STORE_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doStoreArrayDirect;
+
+ case INST_STORE_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doStoreArrayDirect:
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = OBJ_UNDER_TOS;
+ arrayPtr = LOCAL(opnd);
+ TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
+ O2S(valuePtr)));
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (varPtr && TclIsVarDirectWritable(varPtr)) {
+ tosPtr--;
+ Tcl_DecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = valuePtr;
+ goto doStoreVarDirect;
+ }
+ }
+ cleanup = 2;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ part1Ptr = NULL;
+ goto doStoreArrayDirectFailed;
+
+ case INST_STORE_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doStoreScalarDirect;
+
+ case INST_STORE_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doStoreScalarDirect:
+ valuePtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (!TclIsVarDirectWritable(varPtr)) {
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ part1Ptr = NULL;
+ goto doStoreScalar;
+ }
+
+ /*
+ * No traces, no errors, plain 'set': we can safely inline. The value
+ * *will* be set to what's requested, so that the stack top remains
+ * pointing to the same Tcl_Obj.
+ */
+
+ doStoreVarDirect:
+ valuePtr = varPtr->value.objPtr;
+ if (valuePtr != NULL) {
+ TclDecrRefCount(valuePtr);
+ }
+ objResultPtr = OBJ_AT_TOS;
+ varPtr->value.objPtr = objResultPtr;
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ tosPtr--;
+ NEXT_INST_F((pcAdjustment+1), 0, 0);
+ }
+#else
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
+ Tcl_IncrRefCount(objResultPtr);
+ NEXT_INST_F(pcAdjustment, 0, 0);
case INST_LAPPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
+ valuePtr = OBJ_AT_TOS; /* value to append */
+ part2Ptr = NULL;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreStk;
case INST_LAPPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
+ valuePtr = OBJ_AT_TOS; /* value to append */
+ part2Ptr = OBJ_UNDER_TOS;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreStk;
case INST_APPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
+ valuePtr = OBJ_AT_TOS; /* value to append */
+ part2Ptr = NULL;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
goto doStoreStk;
case INST_APPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
+ valuePtr = OBJ_AT_TOS; /* value to append */
+ part2Ptr = OBJ_UNDER_TOS;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
goto doStoreStk;
case INST_STORE_ARRAY_STK:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = OBJ_UNDER_TOS;
storeFlags = TCL_LEAVE_ERR_MSG;
goto doStoreStk;
case INST_STORE_STK:
case INST_STORE_SCALAR_STK:
- valuePtr = *tosPtr;
- part2 = NULL;
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = NULL;
storeFlags = TCL_LEAVE_ERR_MSG;
doStoreStk:
- objPtr = *(tosPtr - 1 - (part2 != NULL)); /* variable name */
- part1 = TclGetString(objPtr);
+ objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */
+ part1Ptr = objPtr;
#ifdef TCL_COMPILE_DEBUG
- if (part2 == NULL) {
- TRACE(("\"%.30s\" <- \"%.30s\" =>", part1, O2S(valuePtr)));
+ if (part2Ptr == NULL) {
+ TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr)));
} else {
TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
- part1, part2, O2S(valuePtr)));
+ O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
}
#endif
- varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+ varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- cleanup = ((part2 == NULL)? 2 : 3);
+ cleanup = ((part2Ptr == NULL)? 2 : 3);
pcAdjustment = 1;
+ opnd = -1;
goto doCallPtrSetVar;
case INST_LAPPEND_ARRAY4:
opnd = TclGetUInt4AtPtr(pc+1);
pcAdjustment = 5;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreArray;
case INST_LAPPEND_ARRAY1:
opnd = TclGetUInt1AtPtr(pc+1);
pcAdjustment = 2;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreArray;
case INST_APPEND_ARRAY4:
@@ -2073,48 +3537,39 @@ TclExecuteByteCode(interp, codePtr)
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
goto doStoreArray;
- case INST_STORE_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreArray;
-
- case INST_STORE_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
doStoreArray:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, part2, O2S(valuePtr)));
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = OBJ_UNDER_TOS;
+ arrayPtr = LOCAL(opnd);
+ TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
+ O2S(valuePtr)));
while (TclIsVarLink(arrayPtr)) {
arrayPtr = arrayPtr->value.linkPtr;
}
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
cleanup = 2;
+ part1Ptr = NULL;
+
+ doStoreArrayDirectFailed:
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
goto doCallPtrSetVar;
case INST_LAPPEND_SCALAR4:
opnd = TclGetUInt4AtPtr(pc+1);
pcAdjustment = 5;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreScalar;
case INST_LAPPEND_SCALAR1:
opnd = TclGetUInt1AtPtr(pc+1);
pcAdjustment = 2;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreScalar;
case INST_APPEND_SCALAR4:
@@ -2129,68 +3584,25 @@ TclExecuteByteCode(interp, codePtr)
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
goto doStoreScalar;
- case INST_STORE_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreScalar;
-
- case INST_STORE_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
doStoreScalar:
- valuePtr = *tosPtr;
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ valuePtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
cleanup = 1;
arrayPtr = NULL;
- part2 = NULL;
+ part1Ptr = part2Ptr = NULL;
doCallPtrSetVar:
- if ((storeFlags == TCL_LEAVE_ERR_MSG)
- && TclIsVarDirectWritable(varPtr)
- && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
- /*
- * No traces, no errors, plain 'set': we can safely inline. The
- * value *will* be set to what's requested, so that the stack top
- * remains pointing to the same Tcl_Obj.
- */
- valuePtr = varPtr->value.objPtr;
- objResultPtr = *tosPtr;
- if (valuePtr != objResultPtr) {
- if (valuePtr != NULL) {
- TclDecrRefCount(valuePtr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
- }
- varPtr->value.objPtr = objResultPtr;
- Tcl_IncrRefCount(objResultPtr);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
- }
-#else
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-#endif
- NEXT_INST_V(pcAdjustment, cleanup, 1);
- } else {
- DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
- part1, part2, valuePtr, storeFlags);
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+ part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
+ CACHE_STACK_INFO();
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
#ifndef TCL_COMPILE_DEBUG
if (*(pc+pcAdjustment) == INST_POP) {
@@ -2203,25 +3615,22 @@ TclExecuteByteCode(interp, codePtr)
/*
* End of INST_STORE and related instructions.
- * ---------------------------------------------------------
- */
-
- /*
- * ---------------------------------------------------------
+ * -----------------------------------------------------------------
* Start of INST_INCR instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
+ * WARNING: more 'goto' here than your doctor recommended! The different
* instructions set the value of some variables and then jump to somme
* common execution code.
*/
+/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
+
{
- Tcl_Obj *objPtr;
- int opnd, pcAdjustment, isWide;
- long i;
+ Tcl_Obj *incrPtr;
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
- char *part1, *part2;
- Var *varPtr, *arrayPtr;
+#endif
+ long increment;
case INST_INCR_SCALAR1:
case INST_INCR_ARRAY1:
@@ -2229,27 +3638,7 @@ TclExecuteByteCode(interp, codePtr)
case INST_INCR_SCALAR_STK:
case INST_INCR_STK:
opnd = TclGetUInt1AtPtr(pc+1);
- objPtr = *tosPtr;
- if (objPtr->typePtr == &tclIntType) {
- i = objPtr->internalRep.longValue;
- isWide = 0;
- } else if (objPtr->typePtr == &tclWideIntType) {
- i = 0; /* lint */
- w = objPtr->internalRep.wideValue;
- isWide = 1;
- } else {
- i = 0; /* lint */
- REQUIRE_WIDE_OR_INT(result, objPtr, i, w);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
- opnd, O2S(objPtr)), Tcl_GetObjResult(interp));
- Tcl_AddErrorInfo(interp, "\n (reading increment)");
- goto checkForCatch;
- }
- isWide = (objPtr->typePtr == &tclWideIntType);
- }
- tosPtr--;
- TclDecrRefCount(objPtr);
+ incrPtr = POP_OBJECT();
switch (*pc) {
case INST_INCR_SCALAR1:
pcAdjustment = 2;
@@ -2265,174 +3654,731 @@ TclExecuteByteCode(interp, codePtr)
case INST_INCR_ARRAY_STK_IMM:
case INST_INCR_SCALAR_STK_IMM:
case INST_INCR_STK_IMM:
- i = TclGetInt1AtPtr(pc+1);
- isWide = 0;
+ increment = TclGetInt1AtPtr(pc+1);
+ incrPtr = Tcl_NewIntObj(increment);
+ Tcl_IncrRefCount(incrPtr);
pcAdjustment = 2;
doIncrStk:
if ((*pc == INST_INCR_ARRAY_STK_IMM)
|| (*pc == INST_INCR_ARRAY_STK)) {
- part2 = TclGetString(*tosPtr);
- objPtr = *(tosPtr - 1);
+ part2Ptr = OBJ_AT_TOS;
+ objPtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
- O2S(objPtr), part2, i));
+ O2S(objPtr), O2S(part2Ptr), increment));
} else {
- part2 = NULL;
- objPtr = *tosPtr;
- TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
- }
- part1 = TclGetString(objPtr);
-
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
- if (varPtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ part2Ptr = NULL;
+ objPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
+ }
+ part1Ptr = objPtr;
+ opnd = -1;
+ varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
+ if (!varPtr) {
+ DECACHE_STACK_INFO();
+ Tcl_AddErrorInfo(interp,
+ "\n (reading value of variable to increment)");
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ Tcl_DecrRefCount(incrPtr);
+ goto gotError;
}
- cleanup = ((part2 == NULL)? 1 : 2);
+ cleanup = ((part2Ptr == NULL)? 1 : 2);
goto doIncrVar;
case INST_INCR_ARRAY1_IMM:
opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
+ increment = TclGetInt1AtPtr(pc+2);
+ incrPtr = Tcl_NewIntObj(increment);
+ Tcl_IncrRefCount(incrPtr);
pcAdjustment = 3;
doIncrArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
+ part1Ptr = NULL;
+ part2Ptr = OBJ_AT_TOS;
+ arrayPtr = LOCAL(opnd);
+ cleanup = 1;
while (TclIsVarLink(arrayPtr)) {
arrayPtr = arrayPtr->value.linkPtr;
}
- TRACE(("%u \"%.30s\" (by %ld) => ", opnd, part2, i));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment));
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ Tcl_DecrRefCount(incrPtr);
+ goto gotError;
}
- cleanup = 1;
goto doIncrVar;
case INST_INCR_SCALAR1_IMM:
opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
+ increment = TclGetInt1AtPtr(pc+2);
pcAdjustment = 3;
+ cleanup = 0;
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+
+ if (TclIsVarDirectModifyable(varPtr)) {
+ ClientData ptr;
+ int type;
+
+ objPtr = varPtr->value.objPtr;
+ if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
+ if (type == TCL_NUMBER_LONG) {
+ long augend = *((const long *)ptr);
+ long sum = augend + increment;
+
+ /*
+ * Overflow when (augend and sum have different sign) and
+ * (augend and increment have the same sign). This is
+ * encapsulated in the Overflowing macro.
+ */
+
+ if (!Overflowing(augend, increment, sum)) {
+ TRACE(("%u %ld => ", opnd, increment));
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* We know it's shared. */
+ TclNewLongObj(objResultPtr, sum);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ objResultPtr = objPtr;
+ TclSetLongObj(objPtr, sum);
+ }
+ goto doneIncr;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ w = (Tcl_WideInt)augend;
+
+ TRACE(("%u %ld => ", opnd, increment));
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* We know it's shared. */
+ objResultPtr = Tcl_NewWideIntObj(w+increment);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ objResultPtr = objPtr;
+
+ /*
+ * We know the sum value is outside the long range;
+ * use macro form that doesn't range test again.
+ */
+
+ TclSetWideIntObj(objPtr, w+increment);
+ }
+ goto doneIncr;
+#endif
+ } /* end if (type == TCL_NUMBER_LONG) */
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (type == TCL_NUMBER_WIDE) {
+ Tcl_WideInt sum;
+
+ w = *((const Tcl_WideInt *) ptr);
+ sum = w + increment;
+
+ /*
+ * Check for overflow.
+ */
+
+ if (!Overflowing(w, increment, sum)) {
+ TRACE(("%u %ld => ", opnd, increment));
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* We know it's shared. */
+ objResultPtr = Tcl_NewWideIntObj(sum);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ objResultPtr = objPtr;
+
+ /*
+ * We *do not* know the sum value is outside the
+ * long range (wide + long can yield long); use
+ * the function call that checks range.
+ */
+
+ Tcl_SetWideIntObj(objPtr, sum);
+ }
+ goto doneIncr;
+ }
+ }
+#endif
+ }
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* We know it's shared */
+ objResultPtr = Tcl_DuplicateObj(objPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ objResultPtr = objPtr;
+ }
+ TclNewLongObj(incrPtr, increment);
+ if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
+ Tcl_DecrRefCount(incrPtr);
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ Tcl_DecrRefCount(incrPtr);
+ goto doneIncr;
+ }
+
+ /*
+ * All other cases, flow through to generic handling.
+ */
+
+ TclNewLongObj(incrPtr, increment);
+ Tcl_IncrRefCount(incrPtr);
doIncrScalar:
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
arrayPtr = NULL;
- part2 = NULL;
+ part1Ptr = part2Ptr = NULL;
cleanup = 0;
- TRACE(("%u %ld => ", opnd, i));
+ TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
doIncrVar:
- objPtr = varPtr->value.objPtr;
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
- if (objPtr->typePtr == &tclIntType && !isWide) {
+ if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
+ objPtr = varPtr->value.objPtr;
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* We know it's shared */
+ objResultPtr = Tcl_DuplicateObj(objPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ objResultPtr = objPtr;
+ }
+ if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
+ Tcl_DecrRefCount(incrPtr);
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ Tcl_DecrRefCount(incrPtr);
+ } else {
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
+ part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
+ CACHE_STACK_INFO();
+ Tcl_DecrRefCount(incrPtr);
+ if (objResultPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ }
+ doneIncr:
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
+#endif
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+ }
+
+ /*
+ * End of INST_INCR instructions.
+ * -----------------------------------------------------------------
+ * Start of INST_EXIST instructions.
+ */
+
+ case INST_EXIST_SCALAR:
+ cleanup = 0;
+ pcAdjustment = 5;
+ opnd = TclGetUInt4AtPtr(pc+1);
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (ReadTraced(varPtr)) {
+ DECACHE_STACK_INFO();
+ TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
+ TCL_TRACE_READS, 0, opnd);
+ CACHE_STACK_INFO();
+ if (TclIsVarUndefined(varPtr)) {
+ TclCleanupVar(varPtr, NULL);
+ varPtr = NULL;
+ }
+ }
+ goto afterExistsPeephole;
+
+ case INST_EXIST_ARRAY:
+ cleanup = 1;
+ pcAdjustment = 5;
+ opnd = TclGetUInt4AtPtr(pc+1);
+ part2Ptr = OBJ_AT_TOS;
+ arrayPtr = LOCAL(opnd);
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
+ if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (!varPtr || !ReadTraced(varPtr)) {
+ goto afterExistsPeephole;
+ }
+ }
+ varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
+ 0, 1, arrayPtr, opnd);
+ if (varPtr) {
+ if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
+ DECACHE_STACK_INFO();
+ TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
+ TCL_TRACE_READS, 0, opnd);
+ CACHE_STACK_INFO();
+ }
+ if (TclIsVarUndefined(varPtr)) {
+ TclCleanupVar(varPtr, arrayPtr);
+ varPtr = NULL;
+ }
+ }
+ goto afterExistsPeephole;
+
+ case INST_EXIST_ARRAY_STK:
+ cleanup = 2;
+ pcAdjustment = 1;
+ part2Ptr = OBJ_AT_TOS; /* element name */
+ part1Ptr = OBJ_UNDER_TOS; /* array name */
+ TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
+ goto doExistStk;
+
+ case INST_EXIST_STK:
+ cleanup = 1;
+ pcAdjustment = 1;
+ part2Ptr = NULL;
+ part1Ptr = OBJ_AT_TOS; /* variable name */
+ TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+
+ doExistStk:
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access",
+ /*createPart1*/0, /*createPart2*/1, &arrayPtr);
+ if (varPtr) {
+ if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
+ DECACHE_STACK_INFO();
+ TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
+ TCL_TRACE_READS, 0, -1);
+ CACHE_STACK_INFO();
+ }
+ if (TclIsVarUndefined(varPtr)) {
+ TclCleanupVar(varPtr, arrayPtr);
+ varPtr = NULL;
+ }
+ }
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
+ */
+
+ afterExistsPeephole: {
+ int found = (varPtr && !TclIsVarUndefined(varPtr));
+
+ TRACE_APPEND(("%d\n", found ? 1 : 0));
+ JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
+ }
+
+ /*
+ * End of INST_EXIST instructions.
+ * -----------------------------------------------------------------
+ * Start of INST_UNSET instructions.
+ */
+
+ {
+ int flags;
+
+ case INST_UNSET_SCALAR:
+ flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+ opnd = TclGetUInt4AtPtr(pc+2);
+ varPtr = LOCAL(opnd);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
+ if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
+ /*
+ * No errors, no traces, no searches: just make the variable cease
+ * to exist.
+ */
+
+ if (!TclIsVarUndefined(varPtr)) {
+ TclDecrRefCount(varPtr->value.objPtr);
+ } else if (flags & TCL_LEAVE_ERR_MSG) {
+ goto slowUnsetScalar;
+ }
+ varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(6, 0, 0);
+ }
+
+ slowUnsetScalar:
+ DECACHE_STACK_INFO();
+ if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
+ opnd) != TCL_OK && flags) {
+ goto errorInUnset;
+ }
+ CACHE_STACK_INFO();
+ NEXT_INST_F(6, 0, 0);
+
+ case INST_UNSET_ARRAY:
+ flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+ opnd = TclGetUInt4AtPtr(pc+2);
+ part2Ptr = OBJ_AT_TOS;
+ arrayPtr = LOCAL(opnd);
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%s %u \"%.30s\" => ",
+ (flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
+ if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
/*
- * No errors, no traces, the variable already has an integer
- * value: inline processing.
+ * No nasty traces and element exists, so we can proceed to
+ * unset it. Might still not exist though...
*/
- i += objPtr->internalRep.longValue;
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it is shared */
- TclNewLongObj(objResultPtr, i);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- TclSetLongObj(objPtr, i);
- objResultPtr = objPtr;
+ if (!TclIsVarUndefined(varPtr)) {
+ TclDecrRefCount(varPtr->value.objPtr);
+ } else if (flags & TCL_LEAVE_ERR_MSG) {
+ goto slowUnsetArray;
}
- goto doneIncr;
- } else if (objPtr->typePtr == &tclWideIntType && isWide) {
+ varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(6, 1, 0);
+ } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
/*
- * No errors, no traces, the variable already has a wide
- * integer value: inline processing.
+ * Don't need to do anything here.
*/
- w += objPtr->internalRep.wideValue;
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it is shared */
- TclNewWideIntObj(objResultPtr, w);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- TclSetWideIntObj(objPtr, w);
- objResultPtr = objPtr;
- }
- goto doneIncr;
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(6, 1, 0);
}
}
+ slowUnsetArray:
DECACHE_STACK_INFO();
- if (isWide) {
- objResultPtr = TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1,
- part2, w, TCL_LEAVE_ERR_MSG);
- } else {
- objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
- part2, i, TCL_LEAVE_ERR_MSG);
+ varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
+ 0, 0, arrayPtr, opnd);
+ if (!varPtr) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ goto errorInUnset;
+ }
+ } else if (TclPtrUnsetVar(interp, varPtr, arrayPtr, NULL, part2Ptr,
+ flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
+ goto errorInUnset;
}
CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ NEXT_INST_F(6, 1, 0);
+
+ case INST_UNSET_ARRAY_STK:
+ flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+ cleanup = 2;
+ part2Ptr = OBJ_AT_TOS; /* element name */
+ part1Ptr = OBJ_UNDER_TOS; /* array name */
+ TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
+ O2S(part1Ptr), O2S(part2Ptr)));
+ goto doUnsetStk;
+
+ case INST_UNSET_STK:
+ flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+ cleanup = 1;
+ part2Ptr = NULL;
+ part1Ptr = OBJ_AT_TOS; /* variable name */
+ TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
+ O2S(part1Ptr)));
+
+ doUnsetStk:
+ DECACHE_STACK_INFO();
+ if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
+ && (flags & TCL_LEAVE_ERR_MSG)) {
+ goto errorInUnset;
+ }
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_V(2, cleanup, 0);
+
+ errorInUnset:
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+
+ /*
+ * This is really an unset operation these days. Do not issue.
+ */
+
+ case INST_DICT_DONE:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ TRACE(("%u => OK\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_ERROR(interp);
+ goto gotError;
+ }
+ }
+ if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ objResultPtr = TCONST(1);
+ } else {
+ objResultPtr = TCONST(0);
}
- doneIncr:
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ 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_ERROR(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);
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ CACHE_STACK_INFO();
+ TRACE_ERROR(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, 1);
- }
+ }
+ NEXT_INST_V(pcAdjustment, cleanup, 0);
/*
- * End of INST_INCR instructions.
- * ---------------------------------------------------------
+ * End of INST_ARRAY instructions.
+ * -----------------------------------------------------------------
+ * Start of variable linking instructions.
*/
- case INST_JUMP1:
- {
- int opnd;
+ {
+ Var *otherPtr;
+ CallFrame *framePtr, *savedFramePtr;
+ Tcl_Namespace *nsPtr;
+ Namespace *savedNsPtr;
+
+ case INST_UPVAR:
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
- opnd = TclGetInt1AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- NEXT_INST_F(opnd, 0, 0);
+ if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- case INST_JUMP4:
- {
- int opnd;
+ /*
+ * Locate the other variable.
+ */
+
+ savedFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = framePtr;
+ otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+ TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
+ /*createPart2*/ 1, &varPtr);
+ iPtr->varFramePtr = savedFramePtr;
+ if (!otherPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ goto doLinkVars;
+
+ case INST_NSUPVAR:
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+ if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ /*
+ * Locate the other variable.
+ */
- opnd = TclGetInt4AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- NEXT_INST_F(opnd, 0, 0);
+ savedNsPtr = iPtr->varFramePtr->nsPtr;
+ iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+ otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+ (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+ /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ if (!otherPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
+ goto doLinkVars;
+
+ case INST_VARIABLE:
+ TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
+ otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+ (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+ /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+ if (!otherPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ /*
+ * Do the [variable] magic.
+ */
+
+ TclSetVarNamespaceVar(otherPtr);
+
+ doLinkVars:
+
+ /*
+ * If we are here, the local variable has already been created: do the
+ * little work of TclPtrMakeUpvar that remains to be done right here
+ * if there are no errors; otherwise, let it handle the case.
+ */
+
+ opnd = TclGetInt4AtPtr(pc+1);
+ varPtr = LOCAL(opnd);
+ if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
+ && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
+ if (!TclIsVarUndefined(varPtr)) {
+ /*
+ * Then it is a defined link.
+ */
+
+ Var *linkPtr = varPtr->value.linkPtr;
+
+ if (linkPtr == otherPtr) {
+ TRACE_APPEND(("already linked\n"));
+ NEXT_INST_F(5, 1, 0);
+ }
+ if (TclIsVarInHash(linkPtr)) {
+ VarHashRefCount(linkPtr)--;
+ if (TclIsVarUndefined(linkPtr)) {
+ TclCleanupVar(linkPtr, NULL);
+ }
+ }
+ }
+ TclSetVarLink(varPtr);
+ varPtr->value.linkPtr = otherPtr;
+ if (TclIsVarInHash(otherPtr)) {
+ VarHashRefCount(otherPtr)++;
+ }
+ } else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
+ opnd) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ /*
+ * Do not pop the namespace or frame index, it may be needed for other
+ * variables - and [variable] did not push it at all.
+ */
+
+ TRACE_APPEND(("link made\n"));
+ NEXT_INST_F(5, 1, 0);
+ }
+
+ /*
+ * End of variable linking instructions.
+ * -----------------------------------------------------------------
+ */
+
+ case INST_JUMP1:
+ opnd = TclGetInt1AtPtr(pc+1);
+ TRACE(("%d => new pc %u\n", opnd,
+ (unsigned)(pc + opnd - codePtr->codeStart)));
+ NEXT_INST_F(opnd, 0, 0);
+
+ case INST_JUMP4:
+ opnd = TclGetInt4AtPtr(pc+1);
+ TRACE(("%d => new pc %u\n", opnd,
+ (unsigned)(pc + opnd - codePtr->codeStart)));
+ NEXT_INST_F(opnd, 0, 0);
{
- int jmpOffset[2];
- int b;
- Tcl_Obj *valuePtr;
+ int jmpOffset[2], b;
+ /* TODO: consider rewrite so we don't compute the offset we're not
+ * going to take. */
case INST_JUMP_FALSE4:
jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */
- jmpOffset[1] = 5; /* TRUE offset*/
+ jmpOffset[1] = 5; /* TRUE offset */
goto doCondJump;
case INST_JUMP_TRUE4:
@@ -2450,55 +4396,60 @@ TclExecuteByteCode(interp, codePtr)
jmpOffset[1] = TclGetInt1AtPtr(pc+1);
doCondJump:
- valuePtr = *tosPtr;
-
- if (valuePtr->typePtr == &tclIntType) {
- b = (valuePtr->internalRep.longValue != 0);
- } else if (valuePtr->typePtr == &tclDoubleType) {
- b = (valuePtr->internalRep.doubleValue != 0.0);
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w;
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("%d => ", jmpOffset[
+ (*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
- TclGetWide(w,valuePtr);
- b = (w != W0);
- } else {
- /*
- * Taking b's address impedes it being a register variable (in gcc
- * at least), so we avoid doing it.
- */
- int b1;
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
- if (result != TCL_OK) {
- if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
- jmpOffset[1] = jmpOffset[0];
- }
- TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[1]),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- b = b1;
+ /* TODO - check claim that taking address of b harms performance */
+ /* TODO - consider optimization search for constants */
+ if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
-#ifndef TCL_COMPILE_DEBUG
- NEXT_INST_F(jmpOffset[b], 1, 0);
-#else
+
+#ifdef TCL_COMPILE_DEBUG
if (b) {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr),
- (unsigned int)(pc+jmpOffset[1] - codePtr->codeStart)));
+ TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
+ (unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
} else {
- TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
}
- NEXT_INST_F(jmpOffset[1], 1, 0);
} else {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
} else {
- TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], O2S(valuePtr),
- (unsigned int)(pc + jmpOffset[1] - codePtr->codeStart)));
+ TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
+ (unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
}
- NEXT_INST_F(jmpOffset[0], 1, 0);
}
#endif
+ NEXT_INST_F(jmpOffset[b], 1, 0);
+ }
+
+ case INST_JUMP_TABLE: {
+ Tcl_HashEntry *hPtr;
+ JumptableInfo *jtPtr;
+
+ /*
+ * Jump to location looked up in a hashtable; fall through to next
+ * instr if lookup fails.
+ */
+
+ opnd = TclGetInt4AtPtr(pc+1);
+ jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+ TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
+ hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
+ if (hPtr != NULL) {
+ int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
+
+ TRACE_APPEND(("found in table, new pc %u\n",
+ (unsigned)(pc - codePtr->codeStart + jumpOffset)));
+ NEXT_INST_F(jumpOffset, 1, 0);
+ } else {
+ TRACE_APPEND(("not found in table\n"));
+ NEXT_INST_F(5, 1, 0);
+ }
}
/*
@@ -2507,370 +4458,649 @@ TclExecuteByteCode(interp, codePtr)
*/
case INST_LOR:
- case INST_LAND:
- {
+ case INST_LAND: {
/*
* Operands must be boolean or numeric. No int->double conversions are
* performed.
*/
- int i1, i2, length;
- int iResult;
- char *s;
- Tcl_ObjType *t1Ptr, *t2Ptr;
- Tcl_Obj *valuePtr, *value2Ptr;
- Tcl_WideInt w;
+ int i1, i2, iResult;
+
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+ if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
- t1Ptr = valuePtr->typePtr;
- t2Ptr = value2Ptr->typePtr;
-
- if (t1Ptr == &tclIntType) {
- i1 = (valuePtr->internalRep.longValue != 0);
- } else if (t1Ptr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- i1 = (w != W0);
- } else if (t1Ptr == &tclDoubleType) {
- i1 = (valuePtr->internalRep.doubleValue != 0.0);
+ if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
+ (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, value2Ptr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ if (*pc == INST_LOR) {
+ iResult = (i1 || i2);
} else {
- s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- long i = 0;
+ iResult = (i1 && i2);
+ }
+ objResultPtr = TCONST(iResult);
+ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
+ NEXT_INST_F(1, 2, 1);
+ }
- GET_WIDE_OR_INT(result, valuePtr, i, w);
- if (valuePtr->typePtr == &tclIntType) {
- i1 = (i != 0);
- } else {
- i1 = (w != W0);
+ /*
+ * -----------------------------------------------------------------
+ * 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;
+
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (level <= 0) {
+ level += framePtr->level;
+ }
+ for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ;
+ framePtr = framePtr->callerVarPtr) {
+ /* Empty loop body */
+ }
+ if (framePtr == rootFramePtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
+ TRACE_ERROR(interp);
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ }
+ {
+ Tcl_Command cmd, origCmd;
+
+ case INST_RESOLVE_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_ORIGIN_COMMAND:
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+ if (cmd == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("ERROR: not command\n"));
+ goto gotError;
+ }
+ origCmd = TclGetOriginalCommand(cmd);
+ if (origCmd == NULL) {
+ origCmd = cmd;
+ }
+ TclNewObj(objResultPtr);
+ Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+ TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ /*
+ * -----------------------------------------------------------------
+ * Start of TclOO support instructions.
+ */
+
+ {
+ Object *oPtr;
+ CallFrame *framePtr;
+ CallContext *contextPtr;
+ int skip, newDepth;
+
+ case INST_TCLOO_SELF:
+ framePtr = iPtr->varFramePtr;
+ 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));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ 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);
+
+ case INST_TCLOO_NEXT_CLASS:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ framePtr = iPtr->varFramePtr;
+ valuePtr = OBJ_AT_DEPTH(opnd - 2);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ skip = 2;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "nextto may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
+ if (oPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
+ goto gotError;
+ } else {
+ Class *classPtr = oPtr->classPtr;
+ struct MInvoke *miPtr;
+ int i;
+ const char *methodType;
+
+ if (classPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (!miPtr->isFilter &&
+ miPtr->mPtr->declaringClassPtr == classPtr) {
+ newDepth = i;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels,
+ (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ goto doInvokeNext;
}
+ }
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
} else {
- result = Tcl_GetBooleanFromObj(NULL, valuePtr, &i1);
+ methodType = "method";
}
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
- (t1Ptr? t1Ptr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
+
+ TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
+ O2S(valuePtr)));
+ for (i=contextPtr->index ; i>=0 ; i--) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (miPtr->isFilter
+ || miPtr->mPtr->declaringClassPtr != classPtr) {
+ continue;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
}
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
}
- if (t2Ptr == &tclIntType) {
- i2 = (value2Ptr->internalRep.longValue != 0);
- } else if (t2Ptr == &tclWideIntType) {
- TclGetWide(w,value2Ptr);
- i2 = (w != W0);
- } else if (t2Ptr == &tclDoubleType) {
- i2 = (value2Ptr->internalRep.doubleValue != 0.0);
- } else {
- s = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s, length)) {
- long i = 0;
+ case INST_TCLOO_NEXT:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ framePtr = iPtr->varFramePtr;
+ skip = 1;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "next may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
- GET_WIDE_OR_INT(result, value2Ptr, i, w);
- if (value2Ptr->typePtr == &tclIntType) {
- i2 = (i != 0);
- } else {
- i2 = (w != W0);
- }
+ newDepth = contextPtr->index + 1;
+ if (newDepth >= contextPtr->callPtr->numChain) {
+ /*
+ * We're at the end of the chain; generate an error message unless
+ * the interpreter is being torn down, in which case we might be
+ * getting here because of methods/destructors doing a [next] (or
+ * equivalent) unexpectedly.
+ */
+
+ const char *methodType;
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
} else {
- result = Tcl_GetBooleanFromObj(NULL, value2Ptr, &i2);
+ methodType = "method";
}
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
- (t2Ptr? t2Ptr->name : "null")));
- IllegalExprOperandType(interp, pc, value2Ptr);
- goto checkForCatch;
+
+ TRACE_APPEND(("ERROR: no TclOO next impl\n"));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+#ifdef TCL_COMPILE_DEBUG
+ } else if (tclTraceExec >= 2) {
+ int i;
+
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
}
+ fprintf(stdout, "\n");
+ fflush(stdout);
+#endif /*TCL_COMPILE_DEBUG*/
}
- /*
- * Reuse the valuePtr object already on stack if possible.
- */
+ doInvokeNext:
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
- if (*pc == INST_LOR) {
- iResult = (i1 || i2);
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
+ }
+
+ pcAdjustment = 2;
+ cleanup = opnd;
+ DECACHE_STACK_INFO();
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ pc += pcAdjustment;
+ TEBC_YIELD();
+
+ oPtr = contextPtr->oPtr;
+ if (oPtr->flags & FILTER_HANDLING) {
+ TclNRAddCallback(interp, FinalizeOONextFilter,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
} else {
- iResult = (i1 && i2);
+ TclNRAddCallback(interp, FinalizeOONext,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
+ }
+ contextPtr->skip = skip;
+ contextPtr->index = newDepth;
+ if (contextPtr->callPtr->chain[newDepth].isFilter
+ || contextPtr->callPtr->flags & FILTER_HANDLING) {
+ oPtr->flags |= FILTER_HANDLING;
+ } else {
+ oPtr->flags &= ~FILTER_HANDLING;
}
- if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, iResult);
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
- NEXT_INST_F(1, 2, 1);
- } else { /* reuse the valuePtr object */
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
- TclSetLongObj(valuePtr, iResult);
- NEXT_INST_F(1, 1, 0);
+
+ {
+ register Method *const mPtr =
+ contextPtr->callPtr->chain[newDepth].mPtr;
+
+ return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, opnd, objv);
+ }
+
+ 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);
}
/*
- * ---------------------------------------------------------
+ * End of TclOO support instructions.
+ * -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
- case INST_LIST: {
+ {
+ int index, numIndices, fromIdx, toIdx;
+ int nocase, match, length2, cflags, s1len, s2len;
+ const char *s1, *s2;
+
+ case INST_LIST:
/*
* Pop the opnd (objc) top stack elements into a new list obj and then
* decrement their ref counts.
*/
- int opnd;
-
opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = Tcl_NewListObj(opnd, (tosPtr - (opnd-1)));
+ objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(5, opnd, 1);
- }
-
- case INST_LIST_LENGTH: {
- Tcl_Obj *valuePtr;
- int length;
- valuePtr = *tosPtr;
-
- result = Tcl_ListObjLength(interp, valuePtr, &length);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ case INST_LIST_LENGTH:
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE_APPEND(("%d\n", length));
NEXT_INST_F(1, 1, 1);
- }
- case INST_LIST_INDEX: {
- /*** lindex with objc == 3 ***/
-
- Tcl_Obj *valuePtr, *value2Ptr;
+ case INST_LIST_INDEX: /* lindex with objc == 3 */
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
- * Pop the two operands
+ * Extract the desired list element.
*/
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
-
- /*
- * Extract the desired list element
- */
+ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
+ && (value2Ptr->typePtr != &tclListType)
+ && (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
+ &index) == TCL_OK)) {
+ TclDecrRefCount(value2Ptr);
+ tosPtr--;
+ pcAdjustment = 1;
+ goto lindexFastPath;
+ }
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Stash the list element on the stack
+ * Stash the list element on the stack.
*/
- TRACE(("%.20s %.20s => %s\n",
- O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
- NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
- }
-
- case INST_LIST_INDEX_IMM: {
- /*** lindex with objc==3 and index in bytecode stream ***/
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, -1); /* Already has the correct refCount */
- int listc, idx, opnd;
- Tcl_Obj **listv;
- Tcl_Obj *valuePtr;
+ case INST_LIST_INDEX_IMM: /* lindex with objc==3 and index in bytecode
+ * stream */
/*
- * Pop the list and get the index
+ * Pop the list and get the index.
*/
- valuePtr = *tosPtr;
+ valuePtr = OBJ_AT_TOS;
opnd = TclGetInt4AtPtr(pc+1);
+ TRACE(("\%.30s\" %d => ", O2S(valuePtr), opnd));
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
*/
- result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Select the list item based on the index. Negative operand means
+ * Select the list item based on the index. Negative operand means
* end-based indexing.
*/
if (opnd < -1) {
- idx = opnd+1 + listc;
+ index = opnd+1 + objc;
} else {
- idx = opnd;
+ index = opnd;
}
- if (idx >= 0 && idx < listc) {
- objResultPtr = listv[idx];
+ pcAdjustment = 5;
+
+ lindexFastPath:
+ if (index >= 0 && index < objc) {
+ objResultPtr = objv[index];
} else {
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd), objResultPtr);
- NEXT_INST_F(5, 1, 1);
- }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(pcAdjustment, 1, 1);
- case INST_LIST_INDEX_MULTI: {
+ case INST_LIST_INDEX_MULTI: /* 'lindex' with multiple index args */
/*
- * 'lindex' with multiple index args:
- *
* Determine the count of index args.
*/
- int numIdx, opnd;
-
opnd = TclGetUInt4AtPtr(pc+1);
- numIdx = opnd-1;
+ numIndices = opnd-1;
/*
* Do the 'lindex' operation.
*/
- objResultPtr = TclLindexFlat(interp, *(tosPtr - numIdx),
- numIdx, tosPtr - numIdx + 1);
-
- /*
- * Check for errors
- */
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE(("%d => ", opnd));
+ objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
+ numIndices, &OBJ_AT_DEPTH(numIndices - 1));
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Set result
+ * Set result.
*/
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, opnd, -1);
- }
- case INST_LSET_FLAT: {
+ case INST_LSET_FLAT:
/*
- * Lset with 3, 5, or more args. Get the number of index args.
+ * Lset with 3, 5, or more args. Get the number of index args.
*/
- int numIdx,opnd;
- Tcl_Obj *valuePtr, *value2Ptr;
opnd = TclGetUInt4AtPtr(pc + 1);
- numIdx = opnd - 2;
+ numIndices = opnd - 2;
+ TRACE(("%d => ", opnd));
/*
- * Get the old value of variable, and remove the stack ref. This is
+ * Get the old value of variable, and remove the stack ref. This is
* safe because the variable still references the object; the ref
- * count will never go zero here.
+ * count will never go zero here - we can use the smaller macro
+ * Tcl_DecrRefCount.
*/
- value2Ptr = POP_OBJECT();
- TclDecrRefCount(value2Ptr); /* This one should be done here */
- /*
- * Get the new element value.
- */
- valuePtr = *tosPtr;
+ valuePtr = POP_OBJECT();
+ Tcl_DecrRefCount(valuePtr); /* This one should be done here */
/*
- * Compute the new variable value
+ * Compute the new variable value.
*/
- objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
- tosPtr - numIdx, valuePtr);
- /*
- * Check for errors
- */
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+ objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
+ &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Set result
- */
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
- NEXT_INST_V(5, (numIdx+1), -1);
- }
-
- case INST_LSET_LIST: {
- /*
- * 'lset' with 4 args.
+ * Set result.
*/
- Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, numIndices+1, -1);
+ case INST_LSET_LIST: /* 'lset' with 4 args */
/*
- * Get the old value of variable, and remove the stack ref. This is
+ * Get the old value of variable, and remove the stack ref. This is
* safe because the variable still references the object; the ref
- * count will never go zero here.
+ * count will never go zero here - we can use the smaller macro
+ * Tcl_DecrRefCount.
*/
+
objPtr = POP_OBJECT();
- TclDecrRefCount(objPtr); /* This one should be done here */
+ Tcl_DecrRefCount(objPtr); /* This one should be done here. */
/*
- * Get the new element value, and the index list
+ * Get the new element value, and the index list.
*/
- valuePtr = *tosPtr;
- value2Ptr = *(tosPtr - 1);
- /*
- * Compute the new variable value
- */
- objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
+ valuePtr = OBJ_AT_TOS;
+ value2Ptr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+ O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
/*
- * Check for errors
+ * Compute the new variable value.
*/
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+
+ objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
+ if (!objResultPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Set result
+ * Set result.
*/
- TRACE(("=> %s\n", O2S(objResultPtr)));
- NEXT_INST_F(1, 2, -1);
- }
- case INST_LIST_RANGE_IMM: {
- /*** lrange with objc==4 and both indices in bytecode stream ***/
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, -1);
- int listc, fromIdx, toIdx;
- Tcl_Obj **listv;
- Tcl_Obj *valuePtr;
+ case INST_LIST_RANGE_IMM: /* lrange with objc==4 and both indices in
+ * bytecode stream */
/*
- * Pop the list and get the indices
+ * Pop the list and get the indices.
*/
- valuePtr = *tosPtr;
+
+ valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
+ TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
+ TclGetInt4AtPtr(pc+5)));
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
*/
- result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
- fromIdx, toIdx), Tcl_GetObjResult(interp));
- goto checkForCatch;
+
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
* Skip a lot of work if we're about to throw the result away (common
- * with uses of [lassign].)
+ * with uses of [lassign]).
*/
+
#ifndef TCL_COMPILE_DEBUG
if (*(pc+9) == INST_POP) {
NEXT_INST_F(10, 1, 0);
@@ -2880,333 +5110,744 @@ TclExecuteByteCode(interp, codePtr)
/*
* Adjust the indices for end-based handling.
*/
+
if (fromIdx < -1) {
- fromIdx += 1+listc;
+ fromIdx += 1+objc;
if (fromIdx < -1) {
fromIdx = -1;
}
- } else if (fromIdx > listc) {
- fromIdx = listc;
+ } else if (fromIdx > objc) {
+ fromIdx = objc;
}
if (toIdx < -1) {
- toIdx += 1+listc;
+ toIdx += 1 + objc;
if (toIdx < -1) {
toIdx = -1;
}
- } else if (toIdx > listc) {
- toIdx = listc;
+ } else if (toIdx > objc) {
+ toIdx = objc;
}
/*
* Check if we are referring to a valid, non-empty list range, and if
* so, build the list of elements in that range.
*/
- if (fromIdx<=toIdx && fromIdx<listc && toIdx>=0) {
- if (fromIdx<0) {
+
+ if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
+ if (fromIdx < 0) {
fromIdx = 0;
}
- if (toIdx >= listc) {
- toIdx = listc-1;
+ 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) {
+ for (index=toIdx+1; index<objc ; 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, listv+fromIdx);
+ objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
} else {
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
- TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
+ TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
- }
case INST_LIST_IN:
- case INST_LIST_NOT_IN: {
- /*
- * Basic list containment operators.
- */
- int found, s1len, s2len, llen, i;
- Tcl_Obj *valuePtr, *value2Ptr, *o;
- char *s1, *s2;
+ case INST_LIST_NOT_IN: /* Basic list containment operators. */
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
-
- s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
- result = Tcl_ListObjLength(interp, value2Ptr, &llen);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
- O2S(value2Ptr)), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ s1 = TclGetStringFromObj(valuePtr, &s1len);
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+ if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- found = 0;
- if (llen > 0) {
- /* An empty list doesn't match anything */
- i = 0;
+ match = 0;
+ if (length > 0) {
+ int i = 0;
+ Tcl_Obj *o;
+
+ /*
+ * An empty list doesn't match anything.
+ */
+
do {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
if (o != NULL) {
- s2 = Tcl_GetStringFromObj(o, &s2len);
+ s2 = TclGetStringFromObj(o, &s2len);
} else {
s2 = "";
+ s2len = 0;
}
if (s1len == s2len) {
- found = (strcmp(s1, s2) == 0);
+ match = (memcmp(s1, s2, s1len) == 0);
}
i++;
- } while (i < llen && found == 0);
+ } while (i < length && match == 0);
}
if (*pc == INST_LIST_NOT_IN) {
- found = !found;
+ match = !match;
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), found));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
+ * We're saving the effort of pushing a boolean value only to pop it
+ * for branching.
*/
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((found ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((found ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((found ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ JUMP_PEEPHOLE_F(match, 1, 2);
+
+ case INST_LIST_CONCAT:
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_DuplicateObj(valuePtr);
+ if (Tcl_ListObjAppendList(interp, objResultPtr,
+ value2Ptr) != TCL_OK) {
+ TRACE_ERROR(interp);
+ TclDecrRefCount(objResultPtr);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+ } else {
+ if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 1, 0);
}
-#endif
- TclNewIntObj(objResultPtr, found);
- NEXT_INST_F(0, 2, 1);
- }
/*
* End of INST_LIST and related instructions.
- * ---------------------------------------------------------
+ * -----------------------------------------------------------------
+ * Start of string-related instructions.
*/
case INST_STR_EQ:
- case INST_STR_NEQ: {
- /*
- * String (in)equality check
- */
- int iResult;
- Tcl_Obj *valuePtr, *value2Ptr;
-
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ case INST_STR_NEQ: /* String (in)equality check */
+ case INST_STR_CMP: /* String compare. */
+ stringCompare:
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
if (valuePtr == value2Ptr) {
+ match = 0;
+ } else {
/*
- * On the off-chance that the objects are the same, we don't
- * really have to think hard about equality.
+ * We only need to check (in)equality when we have equal length
+ * strings. We can use memcmp in all (n)eq cases because we
+ * don't need to worry about lexical LE/BE variance.
*/
- iResult = (*pc == INST_STR_EQ);
- } else {
- char *s1, *s2;
- int s1len, s2len;
- s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
- s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
- if (s1len == s2len) {
+ typedef int (*memCmpFn_t)(const void*, const void*, size_t);
+ memCmpFn_t memCmpFn;
+ int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
+ || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
+
+ if (TclIsPureByteArray(valuePtr)
+ && TclIsPureByteArray(value2Ptr)) {
+ s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
+ s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
+ memCmpFn = memcmp;
+ } else if (((valuePtr->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
+ * memcmp. In benchmark testing this proved the most efficient
+ * check between the unicode and string comparison operations.
+ */
+
+ s1len = Tcl_GetCharLength(valuePtr);
+ s2len = Tcl_GetCharLength(value2Ptr);
+ if ((s1len == valuePtr->length)
+ && (s2len == value2Ptr->length)) {
+ s1 = valuePtr->bytes;
+ s2 = value2Ptr->bytes;
+ memCmpFn = memcmp;
+ } else {
+ s1 = (char *) Tcl_GetUnicode(valuePtr);
+ s2 = (char *) Tcl_GetUnicode(value2Ptr);
+ if (
+#ifdef WORDS_BIGENDIAN
+ 1
+#else
+ checkEq
+#endif
+ ) {
+ memCmpFn = memcmp;
+ s1len *= sizeof(Tcl_UniChar);
+ s2len *= sizeof(Tcl_UniChar);
+ } else {
+ memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
+ }
+ }
+ } else {
/*
- * We only need to check (in)equality when we have equal
- * length strings.
+ * strcmp can't do a simple memcmp in order to handle the
+ * special Tcl \xC0\x80 null encoding for utf-8.
*/
- if (*pc == INST_STR_NEQ) {
- iResult = (strcmp(s1, s2) != 0);
+
+ s1 = TclGetStringFromObj(valuePtr, &s1len);
+ s2 = TclGetStringFromObj(value2Ptr, &s2len);
+ if (checkEq) {
+ memCmpFn = memcmp;
} else {
- /* INST_STR_EQ */
- iResult = (strcmp(s1, s2) == 0);
+ memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
}
+ }
+
+ if (checkEq && (s1len != s2len)) {
+ match = 1;
} else {
- iResult = (*pc == INST_STR_NEQ);
+ /*
+ * The comparison function should compare up to the minimum
+ * byte length only.
+ */
+ match = memCmpFn(s1, s2,
+ (size_t) ((s1len < s2len) ? s1len : s2len));
+ if (match == 0) {
+ match = s1len - s2len;
+ }
}
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
-
/*
- * Peep-hole optimisation: if you're about to jump, do jump from here.
+ * Make sure only -1,0,1 is returned
+ * TODO: consider peephole opt.
*/
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ if (*pc != INST_STR_CMP) {
+ /*
+ * Take care of the opcodes that goto'ed into here.
+ */
+
+ switch (*pc) {
+ case INST_STR_EQ:
+ case INST_EQ:
+ match = (match == 0);
+ break;
+ case INST_STR_NEQ:
+ case INST_NEQ:
+ match = (match != 0);
+ break;
+ case INST_LT:
+ match = (match < 0);
+ break;
+ case INST_GT:
+ match = (match > 0);
+ break;
+ case INST_LE:
+ match = (match <= 0);
+ break;
+ case INST_GE:
+ match = (match >= 0);
+ break;
+ }
}
-#endif
- objResultPtr = eePtr->constants[iResult];
- NEXT_INST_F(0, 2, 1);
- }
- case INST_STR_CMP: {
- /*
- * String compare
- */
- CONST char *s1, *s2;
- int s1len, s2len, iResult;
- Tcl_Obj *valuePtr, *value2Ptr;
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ (match < 0 ? -1 : match > 0 ? 1 : 0)));
+ JUMP_PEEPHOLE_F(match, 1, 2);
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ case INST_STR_LEN:
+ valuePtr = OBJ_AT_TOS;
+ length = Tcl_GetCharLength(valuePtr);
+ TclNewIntObj(objResultPtr, length);
+ TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
+ NEXT_INST_F(1, 1, 1);
+
+ case INST_STR_UPPER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToUpper(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_LOWER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToLower(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToLower(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_TITLE:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if (Tcl_IsShared(valuePtr)) {
+ s1 = TclGetStringFromObj(valuePtr, &length);
+ TclNewStringObj(objResultPtr, s1, length);
+ length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, length);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToTitle(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ case INST_STR_INDEX:
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
- * The comparison function should compare up to the minimum byte
- * length only.
+ * Get char length to calulate what 'end' means.
*/
- if (valuePtr == value2Ptr) {
- /*
- * In the pure equality case, set lengths too for the checks below
- * (or we could goto beyond it).
- */
- iResult = s1len = s2len = 0;
- } else if ((valuePtr->typePtr == &tclByteArrayType)
- && (value2Ptr->typePtr == &tclByteArrayType)) {
- s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
- s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
- iResult = memcmp(s1, s2,
- (size_t) ((s1len < s2len) ? s1len : s2len));
- } else if (((valuePtr->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
- * memcmp. In benchmark testing this proved the most efficient
- * check between the unicode and string comparison operations.
- */
- s1len = Tcl_GetCharLength(valuePtr);
- s2len = Tcl_GetCharLength(value2Ptr);
- if ((s1len == valuePtr->length) && (s2len == value2Ptr->length)) {
- iResult = memcmp(valuePtr->bytes, value2Ptr->bytes,
- (unsigned) ((s1len < s2len) ? s1len : s2len));
- } else {
- iResult = TclUniCharNcmp(Tcl_GetUnicode(valuePtr),
- Tcl_GetUnicode(value2Ptr),
- (unsigned) ((s1len < s2len) ? s1len : s2len));
- }
+ length = Tcl_GetCharLength(valuePtr);
+ if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ if ((index < 0) || (index >= length)) {
+ TclNewObj(objResultPtr);
+ } else if (TclIsPureByteArray(valuePtr)) {
+ objResultPtr = Tcl_NewByteArrayObj(
+ Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
+ } else if (valuePtr->bytes && length == valuePtr->length) {
+ objResultPtr = Tcl_NewStringObj((const char *)
+ valuePtr->bytes+index, 1);
} else {
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
+
/*
- * We can't do a simple memcmp in order to handle the special Tcl
- * \xC0\x80 null encoding for utf-8.
+ * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
+ * but creating the object as a string seems to be faster in
+ * practical use.
*/
- s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
- s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
- iResult = TclpUtfNcmp2(s1, s2,
- (size_t) ((s1len < s2len) ? s1len : s2len));
+
+ length = Tcl_UniCharToUtf(ch, buf);
+ objResultPtr = Tcl_NewStringObj(buf, length);
}
+ TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+
+ case INST_STR_RANGE:
+ TRACE(("\"%.20s\" %.20s %.20s =>",
+ O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+ length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+ &fromIdx) != TCL_OK
+ || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ &toIdx) != TCL_OK) {
+ TRACE_ERROR(interp);
+ 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));
+
/*
- * Make sure only -1,0,1 is returned
+ * Adjust indices for end-based indexing.
*/
- if (iResult == 0) {
- iResult = s1len - s2len;
+
+ if (fromIdx < -1) {
+ fromIdx += 1 + length;
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+ } else if (fromIdx >= length) {
+ fromIdx = length;
}
- if (iResult < 0) {
- iResult = -1;
- } else if (iResult > 0) {
- iResult = 1;
+ if (toIdx < -1) {
+ toIdx += 1 + length;
+ } else if (toIdx >= length) {
+ toIdx = length - 1;
}
- TclNewIntObj(objResultPtr, iResult);
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
- NEXT_INST_F(1, 2, 1);
- }
+ /*
+ * Check if we can do a sane substring.
+ */
- case INST_STR_LEN: {
- int length;
- Tcl_Obj *valuePtr;
+ if (fromIdx <= toIdx) {
+ objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
+ } else {
+ TclNewObj(objResultPtr);
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(9, 1, 1);
- valuePtr = *tosPtr;
+ {
+ Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
+ int length3;
+ Tcl_Obj *value3Ptr;
+
+ case INST_STR_REPLACE:
+ value3Ptr = POP_OBJECT();
+ valuePtr = OBJ_AT_DEPTH(2);
+ length = Tcl_GetCharLength(valuePtr) - 1;
+ TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+ &fromIdx) != TCL_OK
+ || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ &toIdx) != TCL_OK) {
+ TclDecrRefCount(value3Ptr);
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TclDecrRefCount(OBJ_AT_TOS);
+ (void) POP_OBJECT();
+ TclDecrRefCount(OBJ_AT_TOS);
+ (void) POP_OBJECT();
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+
+ if (fromIdx > toIdx || fromIdx > length) {
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ TclDecrRefCount(value3Ptr);
+ NEXT_INST_F(1, 0, 0);
+ }
- if (valuePtr->typePtr == &tclByteArrayType) {
- (void) Tcl_GetByteArrayFromObj(valuePtr, &length);
- } else {
- length = Tcl_GetCharLength(valuePtr);
+ if (toIdx > length) {
+ toIdx = length;
+ }
+
+ if (fromIdx == 0 && toIdx == length) {
+ TclDecrRefCount(OBJ_AT_TOS);
+ OBJ_AT_TOS = value3Ptr;
+ TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ length3 = Tcl_GetCharLength(value3Ptr);
+
+ /*
+ * Remove substring. In-place.
+ */
+
+ if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
+ TclDecrRefCount(value3Ptr);
+ Tcl_SetObjLength(valuePtr, fromIdx);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
+ /*
+ * See if we can splice in place. This happens when the number of
+ * characters being replaced is the same as the number of characters
+ * in the string to be inserted.
+ */
+
+ if (length3 - 1 == toIdx - fromIdx) {
+ unsigned char *bytes1, *bytes2;
+
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_DuplicateObj(valuePtr);
+ if (TclIsPureByteArray(objResultPtr)
+ && TclIsPureByteArray(value3Ptr)) {
+ bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
+ bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+ memcpy(bytes1 + fromIdx, bytes2, length3);
+ } else {
+ ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
+ ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
+ memcpy(ustring1 + fromIdx, ustring2,
+ length3 * sizeof(Tcl_UniChar));
+
+ /*
+ * Magic! Flush the info in the string internal rep that
+ * refers to the about-to-be-invalidated UTF-8 rep. This
+ * sets the 'allocated' field of the String structure to 0
+ * to indicate that a new buffer needs to be allocated.
+ * This is safe; we know we've got a tclStringTypePtr set
+ * at this point (post Tcl_GetUnicodeFromObj).
+ */
+
+ ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0;
+ }
+ Tcl_InvalidateStringRep(objResultPtr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ if (TclIsPureByteArray(valuePtr)
+ && TclIsPureByteArray(value3Ptr)) {
+ bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL);
+ bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+ memcpy(bytes1 + fromIdx, bytes2, length3);
+ } else {
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
+ ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
+ memcpy(ustring1 + fromIdx, ustring2,
+ length3 * sizeof(Tcl_UniChar));
+
+ /*
+ * Magic! Flush the info in the string internal rep that
+ * refers to the about-to-be-invalidated UTF-8 rep. This
+ * sets the 'allocated' field of the String structure to 0
+ * to indicate that a new buffer needs to be allocated.
+ * This is safe; we know we've got a tclStringTypePtr set
+ * at this point (post Tcl_GetUnicodeFromObj).
+ */
+
+ ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0;
+ }
+ Tcl_InvalidateStringRep(valuePtr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
}
- TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
- NEXT_INST_F(1, 1, 1);
- }
- case INST_STR_INDEX: {
/*
- * String compare
+ * Get the unicode representation; this is where we guarantee to lose
+ * bytearrays.
*/
- int index, length;
- char *bytes;
- Tcl_Obj *valuePtr, *value2Ptr;
- bytes = NULL; /* lint */
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ length--;
/*
- * If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
- * use the Unicode string rep to get the index'th char.
+ * Remove substring using copying.
*/
- if (valuePtr->typePtr == &tclByteArrayType) {
- bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
+ if (length3 == 0) {
+ if (fromIdx > 0) {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ } else {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ /*
+ * Splice string pieces by full copying.
+ */
+
+ if (fromIdx > 0) {
+ objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+ Tcl_AppendObjToObj(objResultPtr, value3Ptr);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ } else if (Tcl_IsShared(value3Ptr)) {
+ objResultPtr = Tcl_DuplicateObj(value3Ptr);
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
} else {
/*
- * Get Unicode char length to calulate what 'end' means.
+ * Be careful with splicing the stack in this case; we have a
+ * refCount:1 object in value3Ptr and we want to append to it and
+ * make it be the refCount:1 object at the top of the stack
+ * afterwards. [Bug 82e7f67325]
*/
- length = Tcl_GetCharLength(valuePtr);
- }
- result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index);
- if (result != TCL_OK) {
- goto checkForCatch;
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+ TclDecrRefCount(valuePtr);
+ OBJ_AT_TOS = value3Ptr; /* Tricky! */
+ NEXT_INST_F(1, 0, 0);
}
+ TclDecrRefCount(value3Ptr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
- if ((index >= 0) && (index < length)) {
- if (valuePtr->typePtr == &tclByteArrayType) {
- objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
- (&bytes[index]), 1);
- } else if (valuePtr->bytes && length == valuePtr->length) {
- objResultPtr = Tcl_NewStringObj((CONST char *)
- (&valuePtr->bytes[index]), 1);
+ 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;
+ goto doneStringMap;
+ } else if (valuePtr == value2Ptr) {
+ objResultPtr = value3Ptr;
+ goto doneStringMap;
+ }
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ if (length == 0) {
+ objResultPtr = valuePtr;
+ goto doneStringMap;
+ }
+ ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+ if (length2 > length || length2 == 0) {
+ objResultPtr = valuePtr;
+ goto doneStringMap;
+ } else if (length2 == length) {
+ if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
+ objResultPtr = valuePtr;
} else {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar ch;
+ objResultPtr = value3Ptr;
+ }
+ goto doneStringMap;
+ }
+ 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;
- ch = Tcl_GetUniChar(valuePtr, index);
- /*
- * This could be: Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch,
- * 1) but creating the object as a string seems to be faster
- * in practical use.
- */
- length = Tcl_UniCharToUtf(ch, buf);
- objResultPtr = Tcl_NewStringObj(buf, length);
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
}
- } else {
- TclNewObj(objResultPtr);
}
+ if (p != ustring1) {
+ /*
+ * Put the rest of the unmapped chars onto result.
+ */
+
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ }
+ doneStringMap:
+ TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
+ O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
+ NEXT_INST_V(1, 3, 1);
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
+ 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_MATCH: {
- int nocase, match;
- Tcl_Obj *valuePtr, *value2Ptr;
+ 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_CLASS:
+ opnd = TclGetInt1AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
+ O2S(valuePtr)));
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ match = 1;
+ if (length > 0) {
+ end = ustring1 + length;
+ for (p=ustring1 ; p<end ; p++) {
+ if (!tclStringClassTable[opnd].comparator(*p)) {
+ match = 0;
+ break;
+ }
+ }
+ }
+ TRACE_APPEND(("%d\n", match));
+ JUMP_PEEPHOLE_F(match, 2, 1);
+ }
- nocase = TclGetInt1AtPtr(pc+1);
- valuePtr = *tosPtr; /* String */
- value2Ptr = *(tosPtr - 1); /* Pattern */
+ case INST_STR_MATCH:
+ nocase = TclGetInt1AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS; /* String */
+ value2Ptr = OBJ_UNDER_TOS; /* Pattern */
/*
* Check that at least one of the objects is Unicode before promoting
@@ -3216,299 +5857,265 @@ TclExecuteByteCode(interp, codePtr)
if ((valuePtr->typePtr == &tclStringType)
|| (value2Ptr->typePtr == &tclStringType)) {
Tcl_UniChar *ustring1, *ustring2;
- int length1, length2;
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length1);
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
- match = TclUniCharMatch(ustring1, length1, ustring2, length2,
+ match = TclUniCharMatch(ustring1, length, ustring2, length2,
nocase);
+ } else if (TclIsPureByteArray(valuePtr) && !nocase) {
+ unsigned char *bytes1, *bytes2;
+
+ bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
+ bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
+ match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
} else {
match = Tcl_StringCaseMatch(TclGetString(valuePtr),
TclGetString(value2Ptr), nocase);
}
/*
- * Reuse value2Ptr object already on stack if possible. Adjustment is
+ * Reuse value2Ptr object already on stack if possible. Adjustment is
* 2 due to the nocase byte
*/
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
- objResultPtr = eePtr->constants[match];
- NEXT_INST_F(2, 2, 1);
- }
- case INST_EQ:
- case INST_NEQ:
- case INST_LT:
- case INST_GT:
- case INST_LE:
- case INST_GE: {
/*
- * Any type is allowed but the two operands must have the same type.
- * We will compute value op value2.
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
*/
- Tcl_ObjType *t1Ptr, *t2Ptr;
- char *s1 = NULL; /* Init. avoids compiler warning. */
- char *s2 = NULL; /* Init. avoids compiler warning. */
- long i2 = 0; /* Init. avoids compiler warning. */
- double d1 = 0.0; /* Init. avoids compiler warning. */
- double d2 = 0.0; /* Init. avoids compiler warning. */
- long iResult = 0; /* Init. avoids compiler warning. */
- Tcl_Obj *valuePtr, *value2Ptr;
- int length;
- Tcl_WideInt w;
- long i;
+ JUMP_PEEPHOLE_F(match, 2, 2);
+
+ {
+ const char *string1, *string2;
+ int trim1, trim2;
+
+ case INST_STR_TRIM_LEFT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ trim2 = 0;
+ goto createTrimmedString;
+ case INST_STR_TRIM_RIGHT:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ trim1 = 0;
+ goto createTrimmedString;
+ case INST_STR_TRIM:
+ valuePtr = OBJ_UNDER_TOS; /* String */
+ value2Ptr = OBJ_AT_TOS; /* TrimSet */
+ string2 = TclGetStringFromObj(value2Ptr, &length2);
+ string1 = TclGetStringFromObj(valuePtr, &length);
+ trim1 = TclTrimLeft(string1, length, string2, length2);
+ if (trim1 < length) {
+ trim2 = TclTrimRight(string1, length, string2, length2);
+ } else {
+ trim2 = 0;
+ }
+ createTrimmedString:
+ /*
+ * Careful here; trim set often contains non-ASCII characters so we
+ * take care when printing. [Bug 971cb4f1db]
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TRACE(("\"%.30s\" ", O2S(valuePtr)));
+ TclPrintObject(stdout, value2Ptr, 30);
+ printf(" => ");
+ }
+#endif
+ if (trim1 == 0 && trim2 == 0) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, valuePtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, objResultPtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 2, 1);
+ }
+ }
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ case INST_REGEXP:
+ cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
+ valuePtr = OBJ_AT_TOS; /* String */
+ value2Ptr = OBJ_UNDER_TOS; /* Pattern */
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
- * Be careful in the equal-object case; 'NaN' isn't supposed to be
- * equal to even itself. [Bug 761471]
+ * Compile and match the regular expression.
*/
- t1Ptr = valuePtr->typePtr;
- if (valuePtr == value2Ptr) {
- /*
- * If we are numeric already, or a dictionary (which is never like
- * a single-element list), we can proceed to the main equality
- * check right now. Otherwise, we need to try to coerce to a
- * numeric type so we can see if we've got a NaN but haven't
- * parsed it as numeric.
- */
- if (!IS_NUMERIC_TYPE(t1Ptr) && (t1Ptr != &tclDictType)) {
- if (t1Ptr == &tclListType) {
- int length;
- /*
- * Only a list of length 1 can be NaN or such things.
- */
- (void) Tcl_ListObjLength(NULL, valuePtr, &length);
- if (length == 1) {
- goto mustConvertForNaNCheck;
- }
- } else {
- /*
- * Too bad, we'll have to compute the string and try the
- * conversion
- */
+ {
+ Tcl_RegExp regExpr =
+ Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
- mustConvertForNaNCheck:
- s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1, length)) {
- GET_WIDE_OR_INT(iResult, valuePtr, i, w);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
- }
- t1Ptr = valuePtr->typePtr;
- }
+ if (regExpr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
-
- switch (*pc) {
- case INST_EQ:
- case INST_LE:
- case INST_GE:
- iResult = !((t1Ptr == &tclDoubleType)
- && IS_NAN(valuePtr->internalRep.doubleValue));
- break;
- case INST_LT:
- case INST_GT:
- iResult = 0;
- break;
- case INST_NEQ:
- iResult = ((t1Ptr == &tclDoubleType)
- && IS_NAN(valuePtr->internalRep.doubleValue));
- break;
+ match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
+ if (match < 0) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- goto foundResult;
}
- t2Ptr = value2Ptr->typePtr;
+ TRACE_APPEND(("%d\n", match));
/*
- * We only want to coerce numeric validation if neither type is NULL.
- * A NULL type means the arg is essentially an empty object ("", {} or
- * [list]).
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
+ * Adjustment is 2 due to the nocase byte.
*/
- if (!( (!t1Ptr && !valuePtr->bytes)
- || (valuePtr->bytes && !valuePtr->length)
- || (!t2Ptr && !value2Ptr->bytes)
- || (value2Ptr->bytes && !value2Ptr->length))) {
- if (!IS_NUMERIC_TYPE(t1Ptr)) {
- s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1, length)) {
- GET_WIDE_OR_INT(iResult, valuePtr, i, w);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
- }
- t1Ptr = valuePtr->typePtr;
+
+ JUMP_PEEPHOLE_F(match, 2, 2);
+ }
+
+ /*
+ * End of string-related instructions.
+ * -----------------------------------------------------------------
+ * Start of numeric operator instructions.
+ */
+
+ {
+ ClientData ptr1, ptr2;
+ int type1, type2;
+ long l1, l2, lResult;
+
+ case INST_NUM_TYPE:
+ if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
+ type1 = 0;
+ } else if (type1 == TCL_NUMBER_LONG) {
+ /* value is between LONG_MIN and LONG_MAX */
+ /* [string is integer] is -UINT_MAX to UINT_MAX range */
+ int i;
+
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
}
- if (!IS_NUMERIC_TYPE(t2Ptr)) {
- s2 = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s2, length)) {
- GET_WIDE_OR_INT(iResult, value2Ptr, i2, w);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
- }
- t2Ptr = value2Ptr->typePtr;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (type1 == TCL_NUMBER_WIDE) {
+ /* value is between WIDE_MIN and WIDE_MAX */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ int i;
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
+ type1 = TCL_NUMBER_LONG;
+ }
+#endif
+ } else if (type1 == TCL_NUMBER_BIG) {
+ /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ Tcl_WideInt w;
+
+ if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
}
}
- if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
+ TclNewIntObj(objResultPtr, type1);
+ TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
+ NEXT_INST_F(1, 1, 1);
+
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ case INST_LE:
+ case INST_GE: {
+ int iResult = 0, compare = 0;
+
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+
+ if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
/*
- * One operand is not numeric. Compare as strings. NOTE: strcmp
- * is not correct for \x00 < \x01, but that is unlikely to occur
- * here. We could use the TclUtfNCmp2 to handle this.
+ * At least one non-numeric argument - compare as strings.
*/
- int s1len, s2len;
- s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
- s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
- switch (*pc) {
- case INST_EQ:
- if (s1len == s2len) {
- iResult = (strcmp(s1, s2) == 0);
- } else {
- iResult = 0;
- }
- break;
- case INST_NEQ:
- if (s1len == s2len) {
- iResult = (strcmp(s1, s2) != 0);
- } else {
- iResult = 1;
- }
- break;
- case INST_LT:
- iResult = (strcmp(s1, s2) < 0);
- break;
- case INST_GT:
- iResult = (strcmp(s1, s2) > 0);
- break;
- case INST_LE:
- iResult = (strcmp(s1, s2) <= 0);
- break;
- case INST_GE:
- iResult = (strcmp(s1, s2) >= 0);
- break;
- }
- } else if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
+
+ goto stringCompare;
+ }
+ if (type1 == TCL_NUMBER_NAN) {
/*
- * Compare as doubles.
+ * NaN first arg: NaN != to everything, other compares are false.
*/
- if (t1Ptr == &tclDoubleType) {
- d1 = valuePtr->internalRep.doubleValue;
- GET_DOUBLE_VALUE(d2, value2Ptr, t2Ptr);
- } else { /* t1Ptr is integer, t2Ptr is double */
- GET_DOUBLE_VALUE(d1, valuePtr, t1Ptr);
- d2 = value2Ptr->internalRep.doubleValue;
- }
- switch (*pc) {
- case INST_EQ:
- iResult = d1 == d2;
- break;
- case INST_NEQ:
- iResult = d1 != d2;
- break;
- case INST_LT:
- iResult = d1 < d2;
- break;
- case INST_GT:
- iResult = d1 > d2;
- break;
- case INST_LE:
- iResult = d1 <= d2;
- break;
- case INST_GE:
- iResult = d1 >= d2;
- break;
- }
- } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) {
- Tcl_WideInt w2;
+
+ iResult = (*pc == INST_NEQ);
+ goto foundResult;
+ }
+ if (valuePtr == value2Ptr) {
+ compare = MP_EQ;
+ goto convertComparison;
+ }
+ if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
/*
- * Compare as wide ints (neither are doubles)
+ * At least one non-numeric argument - compare as strings.
*/
- if (t1Ptr == &tclIntType) {
- w = Tcl_LongAsWide(valuePtr->internalRep.longValue);
- TclGetWide(w2,value2Ptr);
- } else if (t2Ptr == &tclIntType) {
- TclGetWide(w,valuePtr);
- w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue);
- } else {
- TclGetWide(w,valuePtr);
- TclGetWide(w2,value2Ptr);
- }
- switch (*pc) {
- case INST_EQ:
- iResult = w == w2;
- break;
- case INST_NEQ:
- iResult = w != w2;
- break;
- case INST_LT:
- iResult = w < w2;
- break;
- case INST_GT:
- iResult = w > w2;
- break;
- case INST_LE:
- iResult = w <= w2;
- break;
- case INST_GE:
- iResult = w >= w2;
- break;
- }
- } else {
+
+ goto stringCompare;
+ }
+ if (type2 == TCL_NUMBER_NAN) {
/*
- * Compare as ints.
+ * NaN 2nd arg: NaN != to everything, other compares are false.
*/
- i = valuePtr->internalRep.longValue;
- i2 = value2Ptr->internalRep.longValue;
- switch (*pc) {
- case INST_EQ:
- iResult = i == i2;
- break;
- case INST_NEQ:
- iResult = i != i2;
- break;
- case INST_LT:
- iResult = i < i2;
- break;
- case INST_GT:
- iResult = i > i2;
- break;
- case INST_LE:
- iResult = i <= i2;
- break;
- case INST_GE:
- iResult = i >= i2;
- break;
- }
+
+ iResult = (*pc == INST_NEQ);
+ goto foundResult;
+ }
+ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+ l1 = *((const long *)ptr1);
+ l2 = *((const long *)ptr2);
+ compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+ } else {
+ compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
}
- TRACE(("%.20s %.20s => %ld\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+ /*
+ * Turn comparison outcome into appropriate result for opcode.
+ */
+
+ convertComparison:
+ switch (*pc) {
+ case INST_EQ:
+ iResult = (compare == MP_EQ);
+ break;
+ case INST_NEQ:
+ iResult = (compare != MP_EQ);
+ break;
+ case INST_LT:
+ iResult = (compare == MP_LT);
+ break;
+ case INST_GT:
+ iResult = (compare == MP_GT);
+ break;
+ case INST_LE:
+ iResult = (compare != MP_GT);
+ break;
+ case INST_GE:
+ iResult = (compare != MP_LT);
+ break;
+ }
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
*/
foundResult:
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = eePtr->constants[iResult];
- NEXT_INST_F(0, 2, 1);
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ iResult));
+ JUMP_PEEPHOLE_F(iResult, 1, 2);
}
case INST_MOD:
@@ -3516,1068 +6123,641 @@ TclExecuteByteCode(interp, codePtr)
case INST_RSHIFT:
case INST_BITOR:
case INST_BITXOR:
- case INST_BITAND: {
+ case INST_BITAND:
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+
+ if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+ || (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) {
+ TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
+ O2S(value2Ptr), (valuePtr->typePtr?
+ valuePtr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
+ || (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) {
+ TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
+ O2S(value2Ptr), (value2Ptr->typePtr?
+ value2Ptr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, value2Ptr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
/*
- * Only integers are allowed. We compute value op value2.
+ * Check for common, simple case.
*/
- long i = 0, i2 = 0, rem, neg_divisor = 0;
- long iResult = 0; /* Init. avoids compiler warning. */
- Tcl_WideInt w, w2, wResult = W0;
- int doWide = 0;
- Tcl_Obj *valuePtr, *value2Ptr;
+ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+ l1 = *((const long *)ptr1);
+ l2 = *((const long *)ptr2);
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- } else { /* try to convert to int */
- REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
- if (result != TCL_OK) {
- TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
- O2S(valuePtr), O2S(value2Ptr),
- (valuePtr->typePtr?
- valuePtr->typePtr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
- }
- }
- if (value2Ptr->typePtr == &tclIntType) {
- i2 = value2Ptr->internalRep.longValue;
- } else if (value2Ptr->typePtr == &tclWideIntType) {
- TclGetWide(w2,value2Ptr);
- } else {
- REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2);
- if (result != TCL_OK) {
- TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- O2S(valuePtr), O2S(value2Ptr),
- (value2Ptr->typePtr?
- value2Ptr->typePtr->name : "null")));
- IllegalExprOperandType(interp, pc, value2Ptr);
- goto checkForCatch;
- }
- }
+ switch (*pc) {
+ case INST_MOD:
+ if (l2 == 0) {
+ TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
+ O2S(value2Ptr)));
+ goto divideByZero;
+ } else if ((l2 == 1) || (l2 == -1)) {
+ /*
+ * Div. by |1| always yields remainder of 0.
+ */
- switch (*pc) {
- case INST_MOD:
- /*
- * This code is tricky: C doesn't guarantee much about the
- * quotient or remainder, and results with a negative divisor are
- * not specified. Tcl guarantees that the remainder will have the
- * same sign as the divisor and a smaller absolute value.
- */
- if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) {
- if (valuePtr->typePtr == &tclIntType) {
- TRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2));
- } else {
- TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
- }
- goto divideByZero;
- }
- if (value2Ptr->typePtr == &tclIntType && i2 == 0) {
- if (valuePtr->typePtr == &tclIntType) {
- TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
- } else {
- TRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2));
- }
- goto divideByZero;
- }
- if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
- Tcl_WideInt wRemainder;
- /*
- * Promote to wide
- */
- if (valuePtr->typePtr == &tclIntType) {
- w = Tcl_LongAsWide(i);
- } else if (value2Ptr->typePtr == &tclIntType) {
- w2 = Tcl_LongAsWide(i2);
- }
- if ( w == LLONG_MIN && w2 == -1 ) {
- /* Integer overflow could happen with (LLONG_MIN % -1)
- * even though it is not possible in the code below. */
- wRemainder = 0;
- } else if ( w == LLONG_MIN && w2 == LLONG_MAX ) {
- wRemainder = LLONG_MAX - 1;
- } else if ( w2 == LLONG_MIN ) {
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = TCONST(0);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+ } else if (l1 == 0) {
/*
- * In C, a modulus operation is not well defined when the
- * divisor is a negative number. So w % LLONG_MIN is not
- * well defined in the code below because -LLONG_MIN is
- * still a negative number.
+ * 0 % (non-zero) always yields remainder of 0.
*/
- if (w == 0 || w == LLONG_MIN) {
- wRemainder = 0;
- } else if (w < 0) {
- wRemainder = w;
- } else {
- wRemainder = LLONG_MIN + w;
- }
- neg_divisor = 1;
+
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = TCONST(0);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
} else {
- if (w2 < 0) {
- w2 = -w2;
- w = -w; /* Note: -LLONG_MIN == LLONG_MIN */
- neg_divisor = 1;
- }
- wRemainder = w % w2;
+ lResult = l1 / l2;
/*
- * remainder is (remainder + divisor) when the remainder
- * is negative. Watch out for the special case of a
- * LLONG_MIN dividend and a negative divisor. Don't add
- * the divisor in that case because the remainder should
- * not be negative.
+ * Force Tcl's integer division rules.
+ * TODO: examine for logic simplification
*/
- if (wRemainder < 0 && !(neg_divisor && (w == LLONG_MIN))) {
- wRemainder += w2;
+
+ if ((lResult < 0 || (lResult == 0 &&
+ ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
+ (lResult * l2 != l1)) {
+ lResult -= 1;
}
+ lResult = l1 - l2*lResult;
+ goto longResultOfArithmetic;
}
- if ((neg_divisor && (wRemainder > 0)) ||
- (!neg_divisor && (wRemainder < 0))) {
- wRemainder = -wRemainder;
- }
- wResult = wRemainder;
- doWide = 1;
- break;
- }
- if ( i == LONG_MIN && i2 == -1 ) {
- /*
- * Integer overflow could happen with (LONG_MIN % -1) even
- * though it is not possible in the code below.
- */
- rem = 0;
- } else if ( i == LONG_MIN && i2 == LONG_MAX ) {
- rem = LONG_MAX - 1;
- } else if ( i2 == LONG_MIN ) {
- /*
- * In C, a modulus operation is not well defined when the
- * divisor is a negative number. So i % LONG_MIN is not well
- * defined in the code below because -LONG_MIN is still a
- * negative number.
- */
- if (i == 0 || i == LONG_MIN) {
- rem = 0;
- } else if (i < 0) {
- rem = i;
+ case INST_RSHIFT:
+ if (l2 < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+ "domain error: argument not in valid range",
+ NULL);
+ CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+ goto gotError;
+ } else if (l1 == 0) {
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = TCONST(0);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
} else {
- rem = LONG_MIN + i;
- }
- neg_divisor = 1;
- } else {
- if (i2 < 0) {
- i2 = -i2;
- i = -i; /* Note: -LONG_MIN == LONG_MIN */
- neg_divisor = 1;
- }
- rem = i % i2;
+ /*
+ * Quickly force large right shifts to 0 or -1.
+ */
- /*
- * remainder is (remainder + divisor) when the remainder is
- * negative. Watch out for the special case of a LONG_MIN
- * dividend and a negative divisor. Don't add the divisor in
- * that case because the remainder should not be negative.
- */
- if (rem < 0 && !(neg_divisor && (i == LONG_MIN))) {
- rem += i2;
- }
- }
+ if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
+ /*
+ * We assume that INT_MAX is much larger than the
+ * number of bits in a long. This is a pretty safe
+ * assumption, given that the former is usually around
+ * 4e9 and the latter 32 or 64...
+ */
- if ((neg_divisor && (rem > 0)) ||
- (!neg_divisor && (rem < 0))) {
- rem = -rem;
- }
- iResult = rem;
- break;
- case INST_LSHIFT:
- /*
- * Shifts are never usefully 64-bits wide!
- */
- FORCE_LONG(value2Ptr, i2, w2);
- if (valuePtr->typePtr == &tclWideIntType) {
-#ifdef TCL_COMPILE_DEBUG
- w2 = Tcl_LongAsWide(i2);
-#endif /* TCL_COMPILE_DEBUG */
- wResult = w;
- /*
- * Shift in steps when the shift gets large to prevent
- * annoying compiler/processor bugs. [Bug 868467]
- */
- if (i2 >= 64) {
- wResult = Tcl_LongAsWide(0);
- } else if (i2 > 60) {
- wResult = w << 30;
- wResult <<= 30;
- wResult <<= i2-60;
- } else if (i2 > 30) {
- wResult = w << 30;
- wResult <<= i2-30;
- } else {
- wResult = w << i2;
- }
- doWide = 1;
- break;
- }
- /*
- * Shift in steps when the shift gets large to prevent annoying
- * compiler/processor bugs. [Bug 868467]
- */
- if (i2 >= 64) {
- iResult = 0;
- } else if (i2 > 60) {
- iResult = i << 30;
- iResult <<= 30;
- iResult <<= i2-60;
- } else if (i2 > 30) {
- iResult = i << 30;
- iResult <<= i2-30;
- } else {
- iResult = i << i2;
- }
- break;
- case INST_RSHIFT:
- /*
- * The following code is a bit tricky: it ensures that right
- * shifts propagate the sign bit even on machines where ">>" won't
- * do it by default.
- */
- /*
- * Shifts are never usefully 64-bits wide!
- */
- FORCE_LONG(value2Ptr, i2, w2);
- if (valuePtr->typePtr == &tclWideIntType) {
-#ifdef TCL_COMPILE_DEBUG
- w2 = Tcl_LongAsWide(i2);
-#endif /* TCL_COMPILE_DEBUG */
- if (w < 0) {
- wResult = ~w;
- } else {
- wResult = w;
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ if (l1 > 0L) {
+ objResultPtr = TCONST(0);
+ } else {
+ TclNewIntObj(objResultPtr, -1);
+ }
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+ }
+
+ /*
+ * Handle shifts within the native long range.
+ */
+
+ lResult = l1 >> ((int) l2);
+ goto longResultOfArithmetic;
}
- /*
- * Shift in steps when the shift gets large to prevent
- * annoying compiler/processor bugs. [Bug 868467]
- */
- if (i2 >= 64) {
- wResult = Tcl_LongAsWide(0);
- } else if (i2 > 60) {
- wResult >>= 30;
- wResult >>= 30;
- wResult >>= i2-60;
- } else if (i2 > 30) {
- wResult >>= 30;
- wResult >>= i2-30;
+
+ case INST_LSHIFT:
+ if (l2 < 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+ "domain error: argument not in valid range",
+ NULL);
+ CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+ goto gotError;
+ } else if (l1 == 0) {
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = TCONST(0);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+ } else if (l2 > (long) INT_MAX) {
+ /*
+ * Technically, we could hold the value (1 << (INT_MAX+1))
+ * in an mp_int, but since we're using mp_mul_2d() to do
+ * the work, and it takes only an int argument, that's a
+ * good place to draw the line.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ "integer value too large to represent", NULL);
+ CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+ goto gotError;
} else {
- wResult >>= i2;
- }
- if (w < 0) {
- wResult = ~wResult;
- }
- doWide = 1;
- break;
- }
- if (i < 0) {
- iResult = ~i;
- } else {
- iResult = i;
- }
- /*
- * Shift in steps when the shift gets large to prevent annoying
- * compiler/processor bugs. [Bug 868467]
- */
- if (i2 >= 64) {
- iResult = 0;
- } else if (i2 > 60) {
- iResult >>= 30;
- iResult >>= 30;
- iResult >>= i2-60;
- } else if (i2 > 30) {
- iResult >>= 30;
- iResult >>= i2-30;
- } else {
- iResult >>= i2;
- }
- if (i < 0) {
- iResult = ~iResult;
- }
- break;
- case INST_BITOR:
- if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
- /*
- * Promote to wide
- */
- if (valuePtr->typePtr == &tclIntType) {
- w = Tcl_LongAsWide(i);
- } else if (value2Ptr->typePtr == &tclIntType) {
- w2 = Tcl_LongAsWide(i2);
+ int shift = (int) l2;
+
+ /*
+ * Handle shifts within the native long range.
+ */
+
+ if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)
+ && !((l1>0 ? l1 : ~l1) &
+ -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
+ lResult = l1 << shift;
+ goto longResultOfArithmetic;
+ }
}
- wResult = w | w2;
- doWide = 1;
- break;
- }
- iResult = i | i2;
- break;
- case INST_BITXOR:
- if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
+
/*
- * Promote to wide
+ * Too large; need to use the broken-out function.
*/
- if (valuePtr->typePtr == &tclIntType) {
- w = Tcl_LongAsWide(i);
- } else if (value2Ptr->typePtr == &tclIntType) {
- w2 = Tcl_LongAsWide(i2);
- }
- wResult = w ^ w2;
- doWide = 1;
+
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
break;
- }
- iResult = i ^ i2;
- break;
- case INST_BITAND:
- if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
- /*
- * Promote to wide
- */
- if (valuePtr->typePtr == &tclIntType) {
- w = Tcl_LongAsWide(i);
- } else if (value2Ptr->typePtr == &tclIntType) {
- w2 = Tcl_LongAsWide(i2);
+
+ case INST_BITAND:
+ lResult = l1 & l2;
+ goto longResultOfArithmetic;
+ case INST_BITOR:
+ lResult = l1 | l2;
+ goto longResultOfArithmetic;
+ case INST_BITXOR:
+ lResult = l1 ^ l2;
+ longResultOfArithmetic:
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ if (Tcl_IsShared(valuePtr)) {
+ TclNewLongObj(objResultPtr, lResult);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
}
- wResult = w & w2;
- doWide = 1;
- break;
+ TclSetLongObj(valuePtr, lResult);
+ TRACE(("%s\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 1, 0);
}
- iResult = i & i2;
- break;
}
/*
- * Reuse the valuePtr object already on stack if possible.
+ * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
+ * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
+ * is highly undesirable due to the overall impact on size.
*/
- if (Tcl_IsShared(valuePtr)) {
- if (doWide) {
- TclNewWideIntObj(objResultPtr, wResult);
- TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
- } else {
- TclNewLongObj(objResultPtr, iResult);
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- }
- NEXT_INST_F(1, 2, 1);
- } else { /* reuse the valuePtr object */
- if (doWide) {
- TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
- TclSetWideIntObj(valuePtr, wResult);
- } else {
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- TclSetLongObj(valuePtr, iResult);
- }
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
+ valuePtr, value2Ptr);
+ if (objResultPtr == DIVIDED_BY_ZERO) {
+ TRACE_APPEND(("DIVIDE BY ZERO\n"));
+ goto divideByZero;
+ } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ } else if (objResultPtr == NULL) {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
+ } else {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
}
- }
+ case INST_EXPON:
case INST_ADD:
case INST_SUB:
- case INST_MULT:
case INST_DIV:
- case INST_EXPON: {
- /*
- * Operands must be numeric and ints get converted to floats if
- * necessary. We compute value op value2.
- */
-
- Tcl_ObjType *t1Ptr, *t2Ptr;
- long i = 0, i2 = 0, quot; /* Init. avoids compiler warning. */
- double d1, d2;
- long iResult = 0; /* Init. avoids compiler warning. */
- double dResult = 0.0; /* Init. avoids compiler warning. */
- int doDouble = 0; /* 1 if doing floating arithmetic */
- Tcl_WideInt w, w2, wquot;
- Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
- int doWide = 0; /* 1 if doing wide arithmetic. */
- Tcl_Obj *valuePtr,*value2Ptr;
- int length;
-
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
- t1Ptr = valuePtr->typePtr;
- t2Ptr = value2Ptr->typePtr;
+ case INST_MULT:
+ value2Ptr = OBJ_AT_TOS;
+ valuePtr = OBJ_UNDER_TOS;
+
+ if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+ || IsErroringNaNType(type1)) {
+ TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
+ O2S(value2Ptr), O2S(valuePtr),
+ (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
- if (t1Ptr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (t1Ptr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) {
+#ifdef ACCEPT_NAN
+ if (type1 == TCL_NUMBER_NAN) {
/*
- * We can only use the internal rep directly if there is no string
- * rep. Otherwise the string rep might actually look like an
- * integer, which is preferred.
+ * NaN first argument -> result is also NaN.
*/
- d1 = valuePtr->internalRep.doubleValue;
- } else {
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- GET_WIDE_OR_INT(result, valuePtr, i, w);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
- }
- if (result != TCL_OK) {
- TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
- s, O2S(valuePtr),
- (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
- }
- t1Ptr = valuePtr->typePtr;
+ NEXT_INST_F(1, 1, 0);
+ }
+#endif
+
+ if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
+ || IsErroringNaNType(type2)) {
+ TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+ O2S(value2Ptr), O2S(valuePtr),
+ (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, value2Ptr);
+ CACHE_STACK_INFO();
+ goto gotError;
}
- if (t2Ptr == &tclIntType) {
- i2 = value2Ptr->internalRep.longValue;
- } else if (t2Ptr == &tclWideIntType) {
- TclGetWide(w2,value2Ptr);
- } else if ((t2Ptr == &tclDoubleType) && (value2Ptr->bytes == NULL)) {
+#ifdef ACCEPT_NAN
+ if (type2 == TCL_NUMBER_NAN) {
/*
- * We can only use the internal rep directly if there is no string
- * rep. Otherwise the string rep might actually look like an
- * integer, which is preferred.
+ * NaN second argument -> result is also NaN.
*/
- d2 = value2Ptr->internalRep.doubleValue;
- } else {
- char *s = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s, length)) {
- GET_WIDE_OR_INT(result, value2Ptr, i2, w2);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
- }
- if (result != TCL_OK) {
- TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- O2S(value2Ptr), s,
- (value2Ptr->typePtr?
- value2Ptr->typePtr->name : "null")));
- IllegalExprOperandType(interp, pc, value2Ptr);
- goto checkForCatch;
- }
- t2Ptr = value2Ptr->typePtr;
+ objResultPtr = value2Ptr;
+ NEXT_INST_F(1, 2, 1);
}
+#endif
+
+ /*
+ * Handle (long,long) arithmetic as best we can without going out to
+ * an external function.
+ */
+
+ if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+ Tcl_WideInt w1, w2, wResult;
+
+ l1 = *((const long *)ptr1);
+ l2 = *((const long *)ptr2);
- if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
- /*
- * Do double arithmetic.
- */
- doDouble = 1;
- if (t1Ptr == &tclIntType) {
- d1 = i; /* promote value 1 to double */
- } else if (t2Ptr == &tclIntType) {
- d2 = i2; /* promote value 2 to double */
- } else if (t1Ptr == &tclWideIntType) {
- d1 = Tcl_WideAsDouble(w);
- } else if (t2Ptr == &tclWideIntType) {
- d2 = Tcl_WideAsDouble(w2);
- }
switch (*pc) {
case INST_ADD:
- dResult = d1 + d2;
- break;
- case INST_SUB:
- dResult = d1 - d2;
- break;
- case INST_MULT:
- dResult = d1 * d2;
- break;
- case INST_DIV:
-#ifndef IEEE_FLOATING_POINT
- if (d2 == 0.0) {
- TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
- goto divideByZero;
- }
-#endif
+ w1 = (Tcl_WideInt) l1;
+ w2 = (Tcl_WideInt) l2;
+ wResult = w1 + w2;
+#ifdef TCL_WIDE_INT_IS_LONG
/*
- * We presume that we are running with zero-divide unmasked if
- * we're on an IEEE box. Otherwise, this statement might cause
- * demons to fly out our noses.
+ * Check for overflow.
*/
- dResult = d1 / d2;
- break;
- case INST_EXPON:
- if (d1==0.0 && d2<0.0) {
- TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
- goto exponOfZero;
- }
- dResult = pow(d1, d2);
- break;
- }
- /*
- * Check now for IEEE floating-point error.
- */
+ if (Overflowing(w1, w2, wResult)) {
+ goto overflow;
+ }
+#endif
+ goto wideResultOfArithmetic;
- if (IS_NAN(dResult)) {
- TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
- O2S(valuePtr), O2S(value2Ptr)));
- TclExprFloatError(interp, dResult);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) {
- /*
- * Do wide integer arithmetic.
- */
- doWide = 1;
- if (t1Ptr == &tclIntType) {
- w = Tcl_LongAsWide(i);
- } else if (t2Ptr == &tclIntType) {
- w2 = Tcl_LongAsWide(i2);
- }
- switch (*pc) {
- case INST_ADD:
- wResult = w + w2;
- break;
case INST_SUB:
- wResult = w - w2;
- break;
- case INST_MULT:
- wResult = w * w2;
- break;
- case INST_DIV:
+ w1 = (Tcl_WideInt) l1;
+ w2 = (Tcl_WideInt) l2;
+ wResult = w1 - w2;
+#ifdef TCL_WIDE_INT_IS_LONG
/*
- * When performing integer division, protect against integer
- * overflow. Round towards zero when the quotient is positive,
- * otherwise round towards -Infinity.
+ * Must check for overflow. The macro tests for overflows in
+ * sums by looking at the sign bits. As we have a subtraction
+ * here, we are adding -w2. As -w2 could in turn overflow, we
+ * test with ~w2 instead: it has the opposite sign bit to w2
+ * so it does the job. Note that the only "bad" case (w2==0)
+ * is irrelevant for this macro, as in that case w1 and
+ * wResult have the same sign and there is no overflow anyway.
*/
- if (w2 == W0) {
- TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
- goto divideByZero;
+
+ if (Overflowing(w1, ~w2, wResult)) {
+ goto overflow;
}
- if (w == LLONG_MIN && w2 == -1) {
- /* Avoid integer overflow on (LLONG_MIN / -1) */
- wquot = LLONG_MIN;
- } else {
- wquot = w / w2;
- /*
- * Round down to a smaller negative number if there is a
- * remainder and the quotient is negative or zero and the
- * signs don't match. Note that we don't use a modulus to
- * find the remainder since it is not well defined in C
- * when the divisor is negative.
- */
- if (((wquot < 0) || ((wquot == 0) &&
- ((w < 0 && w2 > 0) || (w > 0 && w2 < 0)))) &&
- ((wquot * w2) != w)) {
- wquot -= 1;
- }
+#endif
+ wideResultOfArithmetic:
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_NewWideIntObj(wResult);
+ TRACE(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
}
- wResult = wquot;
- break;
- case INST_EXPON: {
- int errExpon;
+ Tcl_SetWideIntObj(valuePtr, wResult);
+ TRACE(("%s\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 1, 0);
- wResult = ExponWide(w, w2, &errExpon);
- if (errExpon) {
- TRACE((LLD" "LLD" => EXPONENT OF ZERO\n", w, w2));
- goto exponOfZero;
- }
- break;
- }
- }
- } else {
- /*
- * Do integer arithmetic.
- */
- switch (*pc) {
- case INST_ADD:
- iResult = i + i2;
- break;
- case INST_SUB:
- iResult = i - i2;
- break;
- case INST_MULT:
- iResult = i * i2;
- break;
case INST_DIV:
- /*
- * When performing integer division, protect against integer
- * overflow. Round towards zero when the quotient is positive,
- * otherwise round towards -Infinity.
- */
- if (i2 == 0) {
- TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
+ if (l2 == 0) {
+ TRACE(("%s %s => DIVIDE BY ZERO\n",
+ O2S(valuePtr), O2S(value2Ptr)));
goto divideByZero;
- }
- if (i == LONG_MIN && i2 == -1) {
- /* Avoid integer overflow on (LONG_MIN / -1) */
- quot = LONG_MIN;
- } else {
- quot = i / i2;
+ } else if ((l1 == LONG_MIN) && (l2 == -1)) {
/*
- * Round down to a smaller negative number if there is a
- * remainder and the quotient is negative or zero and the
- * signs don't match. Note that we don't use a modulus to
- * find the remainder since it is not well defined in C
- * when the divisor is negative.
+ * Can't represent (-LONG_MIN) as a long.
*/
- if (((quot < 0) || ((quot == 0) &&
- ((i<0 && i2>0) || (i>0 && i2<0)))) &&
- ((quot * i2) != i)) {
- quot -= 1;
- }
+
+ goto overflow;
}
- iResult = quot;
- break;
- case INST_EXPON: {
- int errExpon;
+ lResult = l1 / l2;
- iResult = ExponLong(i, i2, &errExpon);
- if (errExpon) {
- TRACE(("%ld %ld => EXPONENT OF ZERO\n", i, i2));
- goto exponOfZero;
+ /*
+ * Force Tcl's integer division rules.
+ * TODO: examine for logic simplification
+ */
+
+ if (((lResult < 0) || ((lResult == 0) &&
+ ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
+ ((lResult * l2) != l1)) {
+ lResult -= 1;
+ }
+ goto longResultOfArithmetic;
+
+ case INST_MULT:
+ if (((sizeof(long) >= 2*sizeof(int))
+ && (l1 <= INT_MAX) && (l1 >= INT_MIN)
+ && (l2 <= INT_MAX) && (l2 >= INT_MIN))
+ || ((sizeof(long) >= 2*sizeof(short))
+ && (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
+ && (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
+ lResult = l1 * l2;
+ goto longResultOfArithmetic;
}
- break;
- }
}
- }
- /*
- * Reuse the valuePtr object already on stack if possible.
- */
+ /*
+ * Fall through with INST_EXPON, INST_DIV and large multiplies.
+ */
+ }
- if (Tcl_IsShared(valuePtr)) {
- if (doDouble) {
- TclNewDoubleObj(objResultPtr, dResult);
- TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
- } else if (doWide) {
- TclNewWideIntObj(objResultPtr, wResult);
- TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
- } else {
- TclNewLongObj(objResultPtr, iResult);
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- }
- NEXT_INST_F(1, 2, 1);
- } else { /* reuse the valuePtr object */
- if (doDouble) { /* NB: stack top is off by 1 */
- TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
- TclSetDoubleObj(valuePtr, dResult);
- } else if (doWide) {
- TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
- TclSetWideIntObj(valuePtr, wResult);
- } else {
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- TclSetLongObj(valuePtr, iResult);
- }
+ overflow:
+ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+ objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
+ valuePtr, value2Ptr);
+ if (objResultPtr == DIVIDED_BY_ZERO) {
+ TRACE_APPEND(("DIVIDE BY ZERO\n"));
+ goto divideByZero;
+ } else if (objResultPtr == EXPONENT_OF_ZERO) {
+ TRACE_APPEND(("EXPONENT OF ZERO\n"));
+ goto exponOfZero;
+ } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ } else if (objResultPtr == NULL) {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
+ } else {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
}
- }
- case INST_UPLUS: {
- /*
- * Operand must be numeric.
- */
+ case INST_LNOT: {
+ int b;
- double d;
- Tcl_ObjType *tPtr;
- Tcl_Obj *valuePtr;
+ valuePtr = OBJ_AT_TOS;
- valuePtr = *tosPtr;
- tPtr = valuePtr->typePtr;
- if (IS_INTEGER_TYPE(tPtr)
- || ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
- /*
- * We already have a numeric internal rep, either some kind of
- * integer, or a "pure" double. (Need "pure" so that we know the
- * string rep of the double would not prefer to be interpreted as
- * an integer.)
- */
- } else {
+ /* TODO - check claim that taking address of b harms performance */
+ /* TODO - consider optimization search for constants */
+ if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
+ TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
+ (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ /* TODO: Consider peephole opt. */
+ objResultPtr = TCONST(!b);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ case INST_BITNOT:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+ || (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
/*
- * Otherwise, we need to generate a numeric internal rep. from
- * the string rep.
+ * ... ~$NonInteger => raise an error.
*/
- int length;
- long i; /* Set but never used, needed in GET_WIDE_OR_INT */
- Tcl_WideInt w;
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- GET_WIDE_OR_INT(result, valuePtr, i, w);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
- }
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
- s, (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
- }
- tPtr = valuePtr->typePtr;
+ TRACE_APPEND(("ERROR: illegal type %s\n",
+ (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
}
-
- /*
- * Ensure that the operand's string rep is the same as the formatted
- * version of its internal rep. This makes sure that "expr +000123"
- * yields "83", not "000123". We implement this by _discarding_ the
- * string rep since we know it will be regenerated, if needed later,
- * by formatting the internal rep's value.
- */
-
- if (Tcl_IsShared(valuePtr)) {
- if (tPtr == &tclIntType) {
- TclNewLongObj(objResultPtr, valuePtr->internalRep.longValue);
- } else if (tPtr == &tclWideIntType) {
- Tcl_WideInt w;
-
- TclGetWide(w,valuePtr);
- TclNewWideIntObj(objResultPtr, w);
- } else {
- TclNewDoubleObj(objResultPtr, valuePtr->internalRep.doubleValue);
+ if (type1 == TCL_NUMBER_LONG) {
+ l1 = *((const long *) ptr1);
+ if (Tcl_IsShared(valuePtr)) {
+ TclNewLongObj(objResultPtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
}
- TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
+ TclSetLongObj(valuePtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
+ if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
- TclInvalidateStringRep(valuePtr);
- TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
- }
case INST_UMINUS:
- case INST_LNOT: {
- /*
- * The operand must be numeric or a boolean string as accepted by
- * Tcl_GetBooleanFromObj(). If the operand object is unshared modify
- * it directly, otherwise create a copy to modify: this is "copy on
- * write". Free any old string representation since it is now
- * invalid.
- */
-
- double d;
- int boolvar;
- long i;
- int negate_value = 1;
- Tcl_WideInt w;
- Tcl_ObjType *tPtr;
- Tcl_Obj *valuePtr;
-
- valuePtr = *tosPtr;
- tPtr = valuePtr->typePtr;
- if (IS_INTEGER_TYPE(tPtr)
- || ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
- /*
- * We already have a numeric internal rep, either some kind of
- * integer, or a "pure" double. (Need "pure" so that we know the
- * string rep of the double would not prefer to be interpreted as
- * an integer.)
- */
- } else {
- /*
- * Otherwise, we need to generate a numeric internal rep. from
- * the string rep.
- */
- int length;
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- GET_WIDE_OR_INT(result, valuePtr, i, w);
-
- /*
- * An integer was parsed. If parsing a literal that is the
- * smallest long value, then it would have been promoted to a
- * wide since it would not fit in a long type without the
- * leading '-'. Convert back to the smallest possible long.
- */
-
- if ((result == TCL_OK) &&
- (*pc == INST_UMINUS) &&
- (valuePtr->typePtr == &tclWideIntType) &&
- (w == -Tcl_LongAsWide(LONG_MIN))) {
- valuePtr->typePtr = &tclIntType;
- valuePtr->internalRep.longValue = LONG_MIN;
- negate_value = 0;
- }
- } else {
- result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
- }
- if (result == TCL_ERROR && *pc == INST_LNOT) {
- result = Tcl_GetBooleanFromObj(NULL, valuePtr, &boolvar);
- i = (long)boolvar; /* i is long, not int! */
- }
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s,
- (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
- }
- tPtr = valuePtr->typePtr;
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+ if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+ || IsErroringNaNType(type1)) {
+ TRACE_APPEND(("ERROR: illegal type %s \n",
+ (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
+ goto gotError;
}
-
- if (*pc == INST_UMINUS) {
- if (Tcl_IsShared(valuePtr)) {
- /*
- * Create a new object.
- */
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- if (negate_value) {
- i = -i;
- }
- TclNewLongObj(objResultPtr, i);
- TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
- } else if (tPtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- TclNewWideIntObj(objResultPtr, -w);
- TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
- } else {
- d = valuePtr->internalRep.doubleValue;
- TclNewDoubleObj(objResultPtr, -d);
- TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
- }
- NEXT_INST_F(1, 1, 1);
- } else {
- /*
- * valuePtr is unshared. Modify it directly.
- */
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- if (negate_value) {
- i = -i;
- }
- TclSetLongObj(valuePtr, i);
- TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
- } else if (tPtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- TclSetWideIntObj(valuePtr, -w);
- TRACE_WITH_OBJ((LLD" => ", w), valuePtr);
- } else {
- d = valuePtr->internalRep.doubleValue;
- TclSetDoubleObj(valuePtr, -d);
- TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
+ switch (type1) {
+ case TCL_NUMBER_NAN:
+ /* -NaN => NaN */
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ case TCL_NUMBER_LONG:
+ l1 = *((const long *) ptr1);
+ if (l1 != LONG_MIN) {
+ if (Tcl_IsShared(valuePtr)) {
+ TclNewLongObj(objResultPtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
}
+ TclSetLongObj(valuePtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
- } else { /* *pc == INST_UMINUS */
- if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
- i = !valuePtr->internalRep.longValue;
- TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
- } else if (tPtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- i = (w == W0);
- TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
- } else {
- i = (valuePtr->internalRep.doubleValue == 0.0);
- TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
- }
- objResultPtr = eePtr->constants[i];
+ /* FALLTHROUGH */
+ }
+ objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
+ if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
+ } else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
}
- }
- case INST_BITNOT: {
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
/*
- * The operand must be an integer. If the operand object is unshared
- * modify it directly, otherwise modify a copy. Free any old string
- * representation since it is now invalid.
+ * Try to convert the topmost stack object to numeric object. This is
+ * done in order to support [expr]'s policy of interpreting operands
+ * if at all possible as numbers first, then strings.
*/
- Tcl_ObjType *tPtr;
- Tcl_Obj *valuePtr;
- Tcl_WideInt w;
- long i;
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+
+ if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
+ if (*pc == INST_UPLUS) {
+ /*
+ * ... +$NonNumeric => raise an error.
+ */
- valuePtr = *tosPtr;
- tPtr = valuePtr->typePtr;
- if (!IS_INTEGER_TYPE(tPtr)) {
- REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
- if (result != TCL_OK) { /* try to convert to double */
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
- O2S(valuePtr), (tPtr? tPtr->name : "null")));
+ TRACE_APPEND(("ERROR: illegal type %s\n",
+ (valuePtr->typePtr? valuePtr->typePtr->name:"null")));
+ DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- goto checkForCatch;
+ CACHE_STACK_INFO();
+ goto gotError;
}
- }
- if (valuePtr->typePtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- if (Tcl_IsShared(valuePtr)) {
- TclNewWideIntObj(objResultPtr, ~w);
- TRACE(("0x%llx => (%llu)\n", w, ~w));
- NEXT_INST_F(1, 1, 1);
- } else {
+ /* ... TryConvertToNumeric($NonNumeric) is acceptable */
+ TRACE_APPEND(("not numeric\n"));
+ NEXT_INST_F(1, 0, 0);
+ }
+ if (IsErroringNaNType(type1)) {
+ if (*pc == INST_UPLUS) {
/*
- * valuePtr is unshared. Modify it directly.
+ * ... +$NonNumeric => raise an error.
*/
- TclSetWideIntObj(valuePtr, ~w);
- TRACE(("0x%llx => (%llu)\n", w, ~w));
- NEXT_INST_F(1, 0, 0);
- }
- } else {
- i = valuePtr->internalRep.longValue;
- if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, ~i);
- TRACE(("0x%lx => (%lu)\n", i, ~i));
- NEXT_INST_F(1, 1, 1);
+
+ TRACE_APPEND(("ERROR: illegal type %s\n",
+ (valuePtr->typePtr? valuePtr->typePtr->name:"null")));
+ DECACHE_STACK_INFO();
+ IllegalExprOperandType(interp, pc, valuePtr);
+ CACHE_STACK_INFO();
} else {
/*
- * valuePtr is unshared. Modify it directly.
+ * Numeric conversion of NaN -> error.
*/
- TclSetLongObj(valuePtr, ~i);
- TRACE(("0x%lx => (%lu)\n", i, ~i));
- NEXT_INST_F(1, 0, 0);
+
+ TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
+ DECACHE_STACK_INFO();
+ TclExprFloatError(interp, *((const double *) ptr1));
+ CACHE_STACK_INFO();
}
+ goto gotError;
}
- }
-
- case INST_CALL_BUILTIN_FUNC1: {
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
- }
-
- case INST_CALL_FUNC1: {
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
- }
- case INST_TRY_CVT_TO_NUMERIC: {
/*
- * Try to convert the topmost stack object to an int or double object.
- * This is done in order to support Tcl's policy of interpreting
- * operands if at all possible as first integers, else floating-point
- * numbers.
+ * Ensure that the numeric value has a string rep the same as the
+ * formatted version of its internal rep. This is used, e.g., to make
+ * sure that "expr {0001}" yields "1", not "0001". We implement this
+ * by _discarding_ the string rep since we know it will be
+ * regenerated, if needed later, by formatting the internal rep's
+ * value.
*/
- double d;
- char *s;
- Tcl_ObjType *tPtr;
- int converted, needNew, length;
- Tcl_Obj *valuePtr;
- long i;
- Tcl_WideInt w;
-
- valuePtr = *tosPtr;
- tPtr = valuePtr->typePtr;
- converted = 0;
- if (IS_INTEGER_TYPE(tPtr)
- || ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
- /*
- * We already have a numeric internal rep, either some kind of
- * integer, or a "pure" double. (Need "pure" so that we know the
- * string rep of the double would not prefer to be interpreted as
- * an integer.)
- */
- } else {
+ if (valuePtr->bytes == NULL) {
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
+ NEXT_INST_F(1, 0, 0);
+ }
+ if (Tcl_IsShared(valuePtr)) {
/*
- * Otherwise, we need to generate a numeric internal rep. from
- * the string rep.
+ * Here we do some surgery within the Tcl_Obj internals. We want
+ * to copy the intrep, but not the string, so we temporarily hide
+ * the string so we do not copy it.
*/
- s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- GET_WIDE_OR_INT(result, valuePtr, i, w);
- } else {
- result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
- }
- if (result == TCL_OK) {
- converted = 1;
- }
- result = TCL_OK; /* reset the result variable */
- tPtr = valuePtr->typePtr;
- }
- /*
- * Ensure that the topmost stack object, if numeric, has a string rep
- * the same as the formatted version of its internal rep. This is
- * used, e.g., to make sure that "expr {0001}" yields "1", not
- * "0001". We implement this by _discarding_ the string rep since we
- * know it will be regenerated, if needed later, by formatting the
- * internal rep's value. Also check if there has been an IEEE floating
- * point error.
- */
+ char *savedString = valuePtr->bytes;
- objResultPtr = valuePtr;
- needNew = 0;
- if (IS_NUMERIC_TYPE(tPtr)) {
- if (Tcl_IsShared(valuePtr)) {
- if (valuePtr->bytes != NULL) {
- /*
- * We only need to make a copy of the object when it
- * already had a string rep
- */
- needNew = 1;
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- TclNewLongObj(objResultPtr, i);
- } else if (tPtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- TclNewWideIntObj(objResultPtr, w);
- } else {
- d = valuePtr->internalRep.doubleValue;
- TclNewDoubleObj(objResultPtr, d);
- }
- tPtr = objResultPtr->typePtr;
- }
- } else {
- Tcl_InvalidateStringRep(valuePtr);
- }
-
- if (tPtr == &tclDoubleType) {
- d = objResultPtr->internalRep.doubleValue;
- if (IS_NAN(d)) {
- TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(objResultPtr)));
- TclExprFloatError(interp, d);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- }
- converted = converted; /* lint, converted not used. */
- TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
- (converted? "converted" : "not converted"),
- (needNew? "new Tcl_Obj" : "same Tcl_Obj")));
- } else {
- TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
- }
- if (needNew) {
+ valuePtr->bytes = NULL;
+ objResultPtr = Tcl_DuplicateObj(valuePtr);
+ valuePtr->bytes = savedString;
+ TRACE_APPEND(("numeric, new Tcl_Obj\n"));
NEXT_INST_F(1, 1, 1);
- } else {
- NEXT_INST_F(1, 0, 0);
}
+ TclInvalidateStringRep(valuePtr);
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
+ NEXT_INST_F(1, 0, 0);
}
+ /*
+ * End of numeric operator instructions.
+ * -----------------------------------------------------------------
+ */
+
+ case INST_TRY_CVT_TO_BOOLEAN:
+ valuePtr = OBJ_AT_TOS;
+ if (valuePtr->typePtr == &tclBooleanType) {
+ objResultPtr = TCONST(1);
+ } else {
+ int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+ objResultPtr = TCONST(result);
+ }
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
case INST_BREAK:
+ /*
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
+ */
result = TCL_BREAK;
cleanup = 0;
+ TRACE(("=> BREAK!\n"));
goto processExceptionReturn;
case INST_CONTINUE:
+ /*
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
+ */
result = TCL_CONTINUE;
cleanup = 0;
+ TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
- case INST_FOREACH_START4: {
+ {
+ ForeachInfo *infoPtr;
+ Var *iterVarPtr, *listVarPtr;
+ Tcl_Obj *oldValuePtr, *listPtr, **elements;
+ ForeachVarList *varListPtr;
+ int numLists, iterNum, listTmpIndex, listLen, numVars;
+ int varIndex, valIndex, continueLoop, j, iterTmpIndex;
+ long i;
+
+ case INST_FOREACH_START4: /* DEPRECATED */
/*
* Initialize the temporary local var that holds the count of the
* number of iterations of the loop body to -1.
*/
- int opnd;
- ForeachInfo *infoPtr;
- int iterTmpIndex;
- Var *iterVarPtr;
- Tcl_Obj *oldValuePtr;
-
opnd = TclGetUInt4AtPtr(pc+1);
- infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+ infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
iterTmpIndex = infoPtr->loopCtTemp;
- iterVarPtr = &(compiledLocals[iterTmpIndex]);
+ iterVarPtr = LOCAL(iterTmpIndex);
oldValuePtr = iterVarPtr->value.objPtr;
if (oldValuePtr == NULL) {
@@ -4586,8 +6766,6 @@ TclExecuteByteCode(interp, codePtr)
} else {
TclSetLongObj(oldValuePtr, -1);
}
- TclSetVarScalar(iterVarPtr);
- TclClearVarUndefined(iterVarPtr);
TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
#ifndef TCL_COMPILE_DEBUG
@@ -4598,41 +6776,29 @@ TclExecuteByteCode(interp, codePtr)
*/
pc += 5;
+ TCL_DTRACE_INST_NEXT();
#else
NEXT_INST_F(5, 0, 0);
#endif
- }
- case INST_FOREACH_STEP4: {
+ case INST_FOREACH_STEP4: /* DEPRECATED */
/*
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
* the next value list element to each loop var.
*/
- int opnd;
- ForeachInfo *infoPtr;
- ForeachVarList *varListPtr;
- int numLists;
- Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
- Tcl_Obj **elements;
- Var *iterVarPtr, *listVarPtr;
- int iterNum, listTmpIndex, listLen, numVars;
- int varIndex, valIndex, continueLoop, j;
- long i;
- Var *varPtr;
- char *part1;
-
opnd = TclGetUInt4AtPtr(pc+1);
- infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+ TRACE(("%u => ", opnd));
+ infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
numLists = infoPtr->numLists;
/*
* Increment the temp holding the loop iteration number.
*/
- iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+ iterVarPtr = LOCAL(infoPtr->loopCtTemp);
valuePtr = iterVarPtr->value.objPtr;
- iterNum = (valuePtr->internalRep.longValue + 1);
+ iterNum = valuePtr->internalRep.longValue + 1;
TclSetLongObj(valuePtr, iterNum);
/*
@@ -4646,15 +6812,14 @@ TclExecuteByteCode(interp, codePtr)
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
- listVarPtr = &(compiledLocals[listTmpIndex]);
+ listVarPtr = LOCAL(listTmpIndex);
listPtr = listVarPtr->value.objPtr;
- result = Tcl_ListObjLength(interp, listPtr, &listLen);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
- opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+ TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
}
- if (listLen > (iterNum * numVars)) {
+ if (listLen > iterNum * numVars) {
continueLoop = 1;
}
listTmpIndex++;
@@ -4675,23 +6840,20 @@ TclExecuteByteCode(interp, codePtr)
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
- listVarPtr = &(compiledLocals[listTmpIndex]);
- listPtr = listVarPtr->value.objPtr;
- Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements);
+ listVarPtr = LOCAL(listTmpIndex);
+ listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
+ TclListObjGetElements(interp, listPtr, &listLen, &elements);
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
- int setEmptyStr = 0;
if (valIndex >= listLen) {
- setEmptyStr = 1;
TclNewObj(valuePtr);
} else {
valuePtr = elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];
- varPtr = &(compiledLocals[varIndex]);
- part1 = varPtr->name;
+ varPtr = LOCAL(varIndex);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -4700,35 +6862,31 @@ TclExecuteByteCode(interp, codePtr)
if (valuePtr != value2Ptr) {
if (value2Ptr != NULL) {
TclDecrRefCount(value2Ptr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
}
varPtr->value.objPtr = valuePtr;
Tcl_IncrRefCount(valuePtr);
}
} else {
DECACHE_STACK_INFO();
- value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
- NULL, valuePtr, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
- opnd, varIndex), Tcl_GetObjResult(interp));
- if (setEmptyStr) {
- TclDecrRefCount(valuePtr);
- }
- result = TCL_ERROR;
- goto checkForCatch;
+ if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+ CACHE_STACK_INFO();
+ TRACE_APPEND((
+ "ERROR init. index temp %d: %s\n",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
+ TclDecrRefCount(listPtr);
+ goto gotError;
}
+ CACHE_STACK_INFO();
}
valIndex++;
}
+ TclDecrRefCount(listPtr);
listTmpIndex++;
}
}
- TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
- iterNum, (continueLoop? "continue" : "exit")));
+ TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
* Run-time peep-hole optimisation: the compiler ALWAYS follows
@@ -4742,6 +6900,200 @@ TclExecuteByteCode(interp, codePtr)
} else {
NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
}
+
+ }
+ {
+ ForeachInfo *infoPtr;
+ Tcl_Obj *listPtr, **elements, *tmpPtr;
+ ForeachVarList *varListPtr;
+ int numLists, iterMax, listLen, numVars;
+ int iterTmp, iterNum, listTmpDepth;
+ int varIndex, valIndex, j;
+ long i;
+
+ case INST_FOREACH_START:
+ /*
+ * Initialize the data for the looping construct, pushing the
+ * corresponding Tcl_Objs to the stack.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
+ numLists = infoPtr->numLists;
+ TRACE(("%u => ", opnd));
+
+ /*
+ * Compute the number of iterations that will be run: iterMax
+ */
+
+ iterMax = 0;
+ listTmpDepth = numLists-1;
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+ listPtr = OBJ_AT_DEPTH(listTmpDepth);
+ if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+ TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ if (Tcl_IsShared(listPtr)) {
+ objPtr = TclListObjCopy(NULL, listPtr);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_DecrRefCount(listPtr);
+ OBJ_AT_DEPTH(listTmpDepth) = objPtr;
+ }
+ iterTmp = (listLen + (numVars - 1))/numVars;
+ if (iterTmp > iterMax) {
+ iterMax = iterTmp;
+ }
+ listTmpDepth--;
+ }
+
+ /*
+ * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
+ * nul-string obj with the pointer stored in the ptrValue so that the
+ * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
+ * it will never leave this scope and is read-only.
+ */
+
+ TclNewObj(tmpPtr);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
+ tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+ PUSH_OBJECT(tmpPtr); /* iterCounts object */
+
+ /*
+ * Store a pointer to the ForeachInfo struct; same dirty trick
+ * as above
+ */
+
+ TclNewObj(tmpPtr);
+ tmpPtr->internalRep.otherValuePtr = infoPtr;
+ PUSH_OBJECT(tmpPtr); /* infoPtr object */
+ TRACE_APPEND(("jump to loop step\n"));
+
+ /*
+ * Jump directly to the INST_FOREACH_STEP instruction; the C code just
+ * falls through.
+ */
+
+ pc += 5 - infoPtr->loopCtTemp;
+
+ case INST_FOREACH_STEP:
+ /*
+ * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+ * the next value list element to each loop var.
+ */
+
+ tmpPtr = OBJ_AT_TOS;
+ infoPtr = tmpPtr->internalRep.otherValuePtr;
+ numLists = infoPtr->numLists;
+ TRACE(("=> "));
+
+ tmpPtr = OBJ_AT_DEPTH(1);
+ iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+ iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+
+ /*
+ * If some list still has a remaining list element iterate one more
+ * time. Assign to var the next element from its value list.
+ */
+
+ if (iterNum < iterMax) {
+ /*
+ * Set the variables and jump back to run the body
+ */
+
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+
+ listTmpDepth = numLists + 1;
+
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+
+ listPtr = OBJ_AT_DEPTH(listTmpDepth);
+ TclListObjGetElements(interp, listPtr, &listLen, &elements);
+
+ valIndex = (iterNum * numVars);
+ for (j = 0; j < numVars; j++) {
+ if (valIndex >= listLen) {
+ TclNewObj(valuePtr);
+ } else {
+ valuePtr = elements[valIndex];
+ }
+
+ varIndex = varListPtr->varIndexes[j];
+ varPtr = LOCAL(varIndex);
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (TclIsVarDirectWritable(varPtr)) {
+ value2Ptr = varPtr->value.objPtr;
+ if (valuePtr != value2Ptr) {
+ if (value2Ptr != NULL) {
+ TclDecrRefCount(value2Ptr);
+ }
+ varPtr->value.objPtr = valuePtr;
+ Tcl_IncrRefCount(valuePtr);
+ }
+ } else {
+ DECACHE_STACK_INFO();
+ if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("ERROR init. index temp %d: %.30s",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ CACHE_STACK_INFO();
+ }
+ valIndex++;
+ }
+ listTmpDepth--;
+ }
+ TRACE_APPEND(("jump to loop start\n"));
+ /* loopCtTemp being 'misused' for storing the jump size */
+ NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+ }
+
+ TRACE_APPEND(("loop has no more iterations\n"));
+#ifdef TCL_COMPILE_DEBUG
+ NEXT_INST_F(1, 0, 0);
+#else
+ /*
+ * FALL THROUGH
+ */
+ pc++;
+#endif
+
+ case INST_FOREACH_END:
+ /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
+ tmpPtr = OBJ_AT_TOS;
+ infoPtr = tmpPtr->internalRep.otherValuePtr;
+ numLists = infoPtr->numLists;
+ TRACE(("=> loop terminated\n"));
+ NEXT_INST_V(1, numLists+2, 0);
+
+ case INST_LMAP_COLLECT:
+ /*
+ * This instruction is only issued by lmap. The stack is:
+ * - result
+ * - infoPtr
+ * - loop counters
+ * - valLists
+ * - collecting obj (unshared)
+ * The instruction lappends the result to the collecting obj.
+ */
+
+ tmpPtr = OBJ_AT_DEPTH(1);
+ infoPtr = tmpPtr->internalRep.otherValuePtr;
+ numLists = infoPtr->numLists;
+ TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
+
+ objPtr = OBJ_AT_DEPTH(3 + numLists);
+ Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+ NEXT_INST_F(1, 1, 0);
}
case INST_BEGIN_CATCH4:
@@ -4750,16 +7102,20 @@ TclExecuteByteCode(interp, codePtr)
* to the operand. Push the current stack depth onto the special catch
* stack.
*/
- eePtr->stackPtr[++catchTop] = (Tcl_Obj *) (tosPtr - eePtr->stackPtr);
+
+ *(++catchTop) = CURR_DEPTH;
TRACE(("%u => catchTop=%d, stackTop=%d\n",
- TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1),
- tosPtr - eePtr->stackPtr));
+ TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
+ (int) CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
case INST_END_CATCH:
catchTop--;
+ DECACHE_STACK_INFO();
+ Tcl_ResetResult(interp);
+ CACHE_STACK_INFO();
result = TCL_OK;
- TRACE(("=> catchTop=%d\n", (catchTop - initCatchTop - 1)));
+ TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
NEXT_INST_F(1, 0, 0);
case INST_PUSH_RESULT:
@@ -4769,67 +7125,127 @@ TclExecuteByteCode(interp, codePtr)
/*
* See the comments at INST_INVOKE_STK
*/
- {
- Tcl_Obj *newObjResultPtr;
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- }
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
- TclNewLongObj(objResultPtr, result);
+ TclNewIntObj(objResultPtr, result);
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
case INST_PUSH_RETURN_OPTIONS:
+ DECACHE_STACK_INFO();
objResultPtr = Tcl_GetReturnOptions(interp, result);
+ CACHE_STACK_INFO();
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ case INST_RETURN_CODE_BRANCH: {
+ int code;
+
+ if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) {
+ Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!");
+ }
+ if (code == TCL_OK) {
+ Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!");
+ }
+ if (code < TCL_ERROR || code > TCL_CONTINUE) {
+ code = TCL_CONTINUE + 1;
+ }
+ TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+ NEXT_INST_F(2*code-1, 1, 0);
+ }
+
+ /*
+ * -----------------------------------------------------------------
+ * Start of dictionary-related instructions.
+ */
+
{
- int opnd, opnd2, allocateDict;
- Tcl_Obj *dictPtr, *valPtr;
- Var *varPtr;
- char *part1;
+ int opnd2, allocateDict, done, i, allocdict;
+ 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(("\"%.30s\" => ", O2S(dictPtr)));
+ if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
+ TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+ O2S(dictPtr), 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;
+ register int found;
+
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
- dictPtr = *(tosPtr - opnd);
+ dictPtr = OBJ_AT_DEPTH(opnd);
+ if (*pc == INST_DICT_EXISTS) {
+ interp2 = NULL;
+ }
if (opnd > 1) {
- dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
- tosPtr - (opnd-1), DICT_PATH_READ);
+ dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1,
+ &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
if (dictPtr == NULL) {
+ if (*pc == INST_DICT_EXISTS) {
+ found = 0;
+ goto afterDictExists;
+ }
TRACE_WITH_OBJ((
- "%u => ERROR tracing dictionary path into \"%s\": ",
- opnd, O2S(*(tosPtr - opnd))),
+ "ERROR tracing dictionary path into \"%.30s\": ",
+ O2S(OBJ_AT_DEPTH(opnd))),
Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- cleanup = opnd + 1;
- goto checkForCatch;
+ goto gotError;
}
}
- result = Tcl_DictObjGet(interp, dictPtr, *tosPtr, &objResultPtr);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ((
- "%u => ERROR reading leaf dictionary key \"%s\": ",
- opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
- cleanup = opnd + 1;
- goto checkForCatch;
- }
- if (objResultPtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(*tosPtr),
- "\" not known in dictionary", NULL);
- TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- cleanup = opnd + 1;
- goto checkForCatch;
+ if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
+ &objResultPtr) == TCL_OK) {
+ if (*pc == INST_DICT_EXISTS) {
+ found = (objResultPtr ? 1 : 0);
+ goto afterDictExists;
+ }
+ if (!objResultPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd+1, 1);
+ } else if (*pc != INST_DICT_EXISTS) {
+ TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ } else {
+ found = 0;
}
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
+ afterDictExists:
+ TRACE_APPEND(("%d\n", found));
+
+ /*
+ * The INST_DICT_EXISTS instruction is usually followed by a
+ * conditional jump, so we can take advantage of this to do some
+ * peephole optimization (note that we're careful to not close out
+ * someone doing something else).
+ */
+
+ JUMP_PEEPHOLE_V(found, 5, opnd+1);
+ }
case INST_DICT_SET:
case INST_DICT_UNSET:
@@ -4837,8 +7253,7 @@ TclExecuteByteCode(interp, codePtr)
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
- varPtr = &(compiledLocals[opnd2]);
- part1 = varPtr->name;
+ varPtr = LOCAL(opnd2);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -4847,7 +7262,7 @@ TclExecuteByteCode(interp, codePtr)
dictPtr = varPtr->value.objPtr;
} else {
DECACHE_STACK_INFO();
- dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);
CACHE_STACK_INFO();
}
if (dictPtr == NULL) {
@@ -4863,51 +7278,36 @@ TclExecuteByteCode(interp, codePtr)
switch (*pc) {
case INST_DICT_SET:
cleanup = opnd + 1;
- result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd, tosPtr-opnd,
- *tosPtr);
+ result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd,
+ &OBJ_AT_DEPTH(opnd), OBJ_AT_TOS);
break;
case INST_DICT_INCR_IMM:
cleanup = 1;
opnd = TclGetInt4AtPtr(pc+1);
- result = Tcl_DictObjGet(interp, dictPtr, *tosPtr, &valPtr);
+ result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr);
if (result != TCL_OK) {
break;
}
- if (valPtr == NULL) {
- Tcl_DictObjPut(NULL, dictPtr, *tosPtr, Tcl_NewLongObj(opnd));
- } else if (valPtr->typePtr == &tclWideIntType) {
- Tcl_WideInt wvalue;
-
- Tcl_GetWideIntFromObj(NULL, valPtr, &wvalue);
- Tcl_DictObjPut(NULL, dictPtr, *tosPtr,
- Tcl_NewWideIntObj(wvalue + opnd));
- } else if (valPtr->typePtr == &tclIntType) {
- long value;
-
- Tcl_GetLongFromObj(NULL, valPtr, &value);
- Tcl_DictObjPut(NULL, dictPtr, *tosPtr,
- Tcl_NewLongObj(value + opnd));
+ if (valuePtr == NULL) {
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
} else {
- long value = 0; /* stop compiler warning */
- Tcl_WideInt wvalue;
-
- REQUIRE_WIDE_OR_INT(result, valPtr, value, wvalue);
- if (result != TCL_OK) {
- break;
+ value2Ptr = Tcl_NewIntObj(opnd);
+ Tcl_IncrRefCount(value2Ptr);
+ if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
}
- if (valPtr->typePtr == &tclWideIntType) {
- Tcl_DictObjPut(NULL, dictPtr, *tosPtr,
- Tcl_NewWideIntObj(wvalue + opnd));
- } else {
- Tcl_DictObjPut(NULL, dictPtr, *tosPtr,
- Tcl_NewLongObj(value + opnd));
+ result = TclIncrObj(interp, valuePtr, value2Ptr);
+ if (result == TCL_OK) {
+ TclInvalidateStringRep(dictPtr);
}
+ TclDecrRefCount(value2Ptr);
}
break;
case INST_DICT_UNSET:
cleanup = opnd;
result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
- tosPtr - (opnd-1));
+ &OBJ_AT_DEPTH(opnd-1));
break;
default:
cleanup = 0; /* stop compiler warning */
@@ -4916,23 +7316,19 @@ TclExecuteByteCode(interp, codePtr)
if (result != TCL_OK) {
if (allocateDict) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
- TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",opnd,opnd2),
- Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR updating dictionary: %s\n",
+ O2S(Tcl_GetObjResult(interp))));
goto checkForCatch;
}
if (TclIsVarDirectWritable(varPtr)) {
if (allocateDict) {
- Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
-
+ value2Ptr = varPtr->value.objPtr;
Tcl_IncrRefCount(dictPtr);
- if (oldValuePtr != NULL) {
- Tcl_DecrRefCount(oldValuePtr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
+ if (value2Ptr != NULL) {
+ TclDecrRefCount(value2Ptr);
}
varPtr->value.objPtr = dictPtr;
}
@@ -4940,14 +7336,13 @@ TclExecuteByteCode(interp, codePtr)
} else {
Tcl_IncrRefCount(dictPtr);
DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
- dictPtr, TCL_LEAVE_ERR_MSG);
+ objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
CACHE_STACK_INFO();
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
}
#ifndef TCL_COMPILE_DEBUG
@@ -4955,16 +7350,13 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_V(10, cleanup, 0);
}
#endif
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(9, cleanup, 1);
case INST_DICT_APPEND:
case INST_DICT_LAPPEND:
opnd = TclGetUInt4AtPtr(pc+1);
- cleanup = 2;
-
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
@@ -4973,7 +7365,7 @@ TclExecuteByteCode(interp, codePtr)
dictPtr = varPtr->value.objPtr;
} else {
DECACHE_STACK_INFO();
- dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
CACHE_STACK_INFO();
}
if (dictPtr == NULL) {
@@ -4986,73 +7378,95 @@ TclExecuteByteCode(interp, codePtr)
}
}
- result = Tcl_DictObjGet(interp, dictPtr, *(tosPtr - 1), &valPtr);
- if (result != TCL_OK) {
+ if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
+ &valuePtr) != TCL_OK) {
if (allocateDict) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
/*
- * Note that a non-existent key results in a NULL valPtr, which is a
+ * Note that a non-existent key results in a NULL valuePtr, which is a
* case handled separately below. What we *can* say at this point is
* that the write-back will always succeed.
*/
switch (*pc) {
case INST_DICT_APPEND:
- if (valPtr == NULL) {
- valPtr = *tosPtr;
+ if (valuePtr == NULL) {
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, OBJ_AT_TOS);
+ } else if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
+ Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
} else {
- if (Tcl_IsShared(valPtr)) {
- valPtr = Tcl_DuplicateObj(valPtr);
- }
- Tcl_AppendObjToObj(valPtr, *tosPtr);
+ 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:
/*
* More complex because list-append can fail.
*/
- if (valPtr == NULL) {
- valPtr = Tcl_NewListObj(1, tosPtr);
- } else if (Tcl_IsShared(valPtr)) {
- valPtr = Tcl_DuplicateObj(valPtr);
- result = Tcl_ListObjAppendElement(interp, valPtr, *tosPtr);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(valPtr);
+
+ if (valuePtr == NULL) {
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS,
+ Tcl_NewListObj(1, &OBJ_AT_TOS));
+ break;
+ } else if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
+ if (Tcl_ListObjAppendElement(interp, valuePtr,
+ OBJ_AT_TOS) != TCL_OK) {
+ TclDecrRefCount(valuePtr);
if (allocateDict) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
+ Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
} else {
- result = Tcl_ListObjAppendElement(interp, valPtr, *tosPtr);
- if (result != TCL_OK) {
+ if (Tcl_ListObjAppendElement(interp, valuePtr,
+ OBJ_AT_TOS) != TCL_OK) {
if (allocateDict) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ 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:
Tcl_Panic("Should not happen!");
}
- Tcl_DictObjPut(NULL, dictPtr, *(tosPtr - 1), valPtr);
-
if (TclIsVarDirectWritable(varPtr)) {
if (allocateDict) {
- Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
-
+ value2Ptr = varPtr->value.objPtr;
Tcl_IncrRefCount(dictPtr);
- if (oldValuePtr != NULL) {
- Tcl_DecrRefCount(oldValuePtr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
+ if (value2Ptr != NULL) {
+ TclDecrRefCount(value2Ptr);
}
varPtr->value.objPtr = dictPtr;
}
@@ -5060,55 +7474,44 @@ TclExecuteByteCode(interp, codePtr)
} else {
Tcl_IncrRefCount(dictPtr);
DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
- dictPtr, TCL_LEAVE_ERR_MSG);
+ objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ dictPtr, TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
}
#ifndef TCL_COMPILE_DEBUG
- if (*(pc+9) == INST_POP) {
+ if (*(pc+5) == INST_POP) {
NEXT_INST_F(6, 2, 0);
}
#endif
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(5, 2, 1);
- }
-
- {
- int opnd, done;
- Tcl_Obj *statePtr, *dictPtr, *keyPtr, *valuePtr, *emptyPtr;
- Var *varPtr;
- Tcl_DictSearch *searchPtr;
case INST_DICT_FIRST:
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
dictPtr = POP_OBJECT();
- searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
- result = Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
- &valuePtr, &done);
- Tcl_DecrRefCount(dictPtr);
- if (result != TCL_OK) {
- ckfree((char *) searchPtr);
- cleanup = 0;
- goto checkForCatch;
+ searchPtr = ckalloc(sizeof(Tcl_DictSearch));
+ if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
+ &valuePtr, &done) != TCL_OK) {
+ ckfree(searchPtr);
+ TRACE_ERROR(interp);
+ goto gotError;
}
TclNewObj(statePtr);
statePtr->typePtr = &dictIteratorType;
- statePtr->internalRep.otherValuePtr = (void *) searchPtr;
- varPtr = compiledLocals + opnd;
- if (varPtr->value.objPtr == NULL) {
- TclSetVarScalar(compiledLocals + opnd);
- TclClearVarUndefined(compiledLocals + opnd);
- } else if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
- Tcl_Panic("mis-issued dictFirst!");
- } else {
- Tcl_DecrRefCount(varPtr->value.objPtr);
+ statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
+ statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+ varPtr = LOCAL(opnd);
+ if (varPtr->value.objPtr) {
+ if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+ Tcl_Panic("mis-issued dictFirst!");
+ }
+ TclDecrRefCount(varPtr->value.objPtr);
}
varPtr->value.objPtr = statePtr;
Tcl_IncrRefCount(statePtr);
@@ -5117,11 +7520,11 @@ TclExecuteByteCode(interp, codePtr)
case INST_DICT_NEXT:
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
- statePtr = compiledLocals[opnd].value.objPtr;
+ statePtr = (*LOCAL(opnd)).value.objPtr;
if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
Tcl_Panic("mis-issued dictNext!");
}
- searchPtr = (Tcl_DictSearch *) statePtr->internalRep.otherValuePtr;
+ searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
pushDictIteratorResult:
if (done) {
@@ -5132,220 +7535,242 @@ TclExecuteByteCode(interp, codePtr)
PUSH_OBJECT(valuePtr);
PUSH_OBJECT(keyPtr);
}
- TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
- O2S(*(tosPtr-1)), O2S(*tosPtr), done));
- objResultPtr = Tcl_NewBooleanObj(done);
- NEXT_INST_F(5, 0, 1);
+ TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
- case INST_DICT_DONE:
- opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u => ", opnd));
- statePtr = compiledLocals[opnd].value.objPtr;
- if (statePtr == NULL) {
- Tcl_Panic("mis-issued dictDone!");
- }
- if (statePtr->typePtr == &dictIteratorType) {
- searchPtr = (Tcl_DictSearch *) statePtr->internalRep.otherValuePtr;
- Tcl_DictObjDone(searchPtr);
- ckfree((char *) searchPtr);
- }
/*
- * Set the internal variable to an empty object to signify
- * that we don't hold an iterator.
+ * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
+ * followed by a conditional jump, so we can take advantage of this to
+ * do some peephole optimization (note that we're careful to not close
+ * out someone doing something else).
*/
- Tcl_DecrRefCount(statePtr);
- TclNewObj(emptyPtr);
- compiledLocals[opnd].value.objPtr = emptyPtr;
- Tcl_IncrRefCount(emptyPtr);
- NEXT_INST_F(5, 0, 0);
- }
- {
- int opnd, i, length, length2, allocdict;
- Tcl_Obj **keyPtrPtr, **varIdxPtrPtr, *dictPtr;
- Var *varPtr;
- char *part1;
+ JUMP_PEEPHOLE_F(done, 5, 0);
case INST_DICT_UPDATE_START:
opnd = TclGetUInt4AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
+ varPtr = LOCAL(opnd);
+ duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
DECACHE_STACK_INFO();
- dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL,
- TCL_LEAVE_ERR_MSG);
+ dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
+ TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (dictPtr == NULL) {
- goto dictUpdateStartFailed;
+ TRACE_ERROR(interp);
+ goto gotError;
}
}
- if (Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length,
- &keyPtrPtr) != TCL_OK ||
- Tcl_ListObjGetElements(interp, *tosPtr, &length2,
- &varIdxPtrPtr) != TCL_OK) {
- goto dictUpdateStartFailed;
+ if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+ &keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- if (length != length2) {
+ if (length != duiPtr->length) {
Tcl_Panic("dictUpdateStart argument length mismatch");
}
for (i=0 ; i<length ; i++) {
- Tcl_Obj *valPtr;
- int varIdx;
-
if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
- &valPtr) != TCL_OK) {
- goto dictUpdateStartFailed;
+ &valuePtr) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
- Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx);
- varPtr = &(compiledLocals[varIdx]);
- part1 = varPtr->name;
+ varPtr = LOCAL(duiPtr->varIndices[i]);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
DECACHE_STACK_INFO();
- if (valPtr == NULL) {
- Tcl_UnsetVar(interp, part1, 0);
- } else if (TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
- valPtr, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (valuePtr == NULL) {
+ TclObjUnsetVar2(interp,
+ localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
+ NULL, 0);
+ } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ valuePtr, TCL_LEAVE_ERR_MSG,
+ duiPtr->varIndices[i]) == NULL) {
CACHE_STACK_INFO();
- dictUpdateStartFailed:
- cleanup = 2;
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
CACHE_STACK_INFO();
}
- NEXT_INST_F(5, 2, 0);
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(9, 0, 0);
case INST_DICT_UPDATE_END:
opnd = TclGetUInt4AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
+ opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
+ varPtr = LOCAL(opnd);
+ duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
DECACHE_STACK_INFO();
- dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
CACHE_STACK_INFO();
}
if (dictPtr == NULL) {
- NEXT_INST_F(5, 2, 0);
- }
- if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK ||
- Tcl_ListObjGetElements(interp, *(tosPtr - 1), &length,
- &keyPtrPtr) != TCL_OK ||
- Tcl_ListObjGetElements(interp, *tosPtr, &length2,
- &varIdxPtrPtr) != TCL_OK) {
- cleanup = 2;
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_APPEND(("storage was unset\n"));
+ NEXT_INST_F(9, 1, 0);
+ }
+ if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
+ || TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+ &keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
allocdict = Tcl_IsShared(dictPtr);
if (allocdict) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- }
+ }
+ if (length > 0) {
+ TclInvalidateStringRep(dictPtr);
+ }
for (i=0 ; i<length ; i++) {
- Tcl_Obj *valPtr;
- int varIdx;
- Var *var2Ptr;
- char *part1a;
-
- Tcl_GetIntFromObj(NULL, varIdxPtrPtr[i], &varIdx);
- var2Ptr = &(compiledLocals[varIdx]);
- part1a = var2Ptr->name;
+ Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
+
while (TclIsVarLink(var2Ptr)) {
var2Ptr = var2Ptr->value.linkPtr;
}
if (TclIsVarDirectReadable(var2Ptr)) {
- valPtr = var2Ptr->value.objPtr;
+ valuePtr = var2Ptr->value.objPtr;
} else {
DECACHE_STACK_INFO();
- valPtr = TclPtrGetVar(interp, var2Ptr, NULL, part1a, NULL, 0);
+ valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
+ duiPtr->varIndices[i]);
CACHE_STACK_INFO();
}
- if (valPtr == NULL) {
+ if (valuePtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
+ } else if (dictPtr == valuePtr) {
+ Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
+ Tcl_DuplicateObj(valuePtr));
} else {
- Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valPtr);
+ Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr);
}
}
if (TclIsVarDirectWritable(varPtr)) {
Tcl_IncrRefCount(dictPtr);
- Tcl_DecrRefCount(varPtr->value.objPtr);
+ TclDecrRefCount(varPtr->value.objPtr);
varPtr->value.objPtr = dictPtr;
} else {
DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
- dictPtr, TCL_LEAVE_ERR_MSG);
+ objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+ dictPtr, TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (objResultPtr == NULL) {
if (allocdict) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
- cleanup = 2;
- result = TCL_ERROR;
- goto checkForCatch;
+ TRACE_ERROR(interp);
+ goto gotError;
}
}
- NEXT_INST_F(5, 2, 0);
- }
-
- default:
- Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
- } /* end of switch on opCode */
+ TRACE_APPEND(("written back\n"));
+ NEXT_INST_F(9, 1, 0);
- /*
- * Division by zero in an expression. Control only reaches this point by
- * "goto divideByZero".
- */
+ case INST_DICT_EXPAND:
+ dictPtr = OBJ_UNDER_TOS;
+ listPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
+ if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
+ if (objResultPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
- divideByZero:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
- Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
- (char *) NULL);
+ 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_ERROR(interp);
+ TclDecrRefCount(keysPtr);
+ goto gotError;
+ }
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_ERROR(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_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(1, 2, 0);
- result = TCL_ERROR;
- goto checkForCatch;
+ 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_ERROR(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_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(5, 2, 0);
+ }
/*
- * Exponentiation of zero by negative number in an expression. Control
- * only reaches this point by "goto exponOfZero".
+ * End of dictionary-related instructions.
+ * -----------------------------------------------------------------
*/
- exponOfZero:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "exponentiation of zero by negative power", -1));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
- "exponentiation of zero by negative power", (char *) NULL);
- result = TCL_ERROR;
- goto checkForCatch;
+ default:
+ Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
+ } /* end of switch on opCode */
/*
- * Block for variables needed to process exception returns
+ * Block for variables needed to process exception returns.
*/
{
- ExceptionRange *rangePtr; /* Points to closest loop or catch
- * exception range enclosing the pc. Used
- * by various instructions and processCatch
- * to process break, continue, and
- * errors. */
- Tcl_Obj *valuePtr;
- char *bytes;
- int length;
-#if TCL_COMPILE_DEBUG
- int opnd;
-#endif
+ ExceptionRange *rangePtr;
+ /* Points to closest loop or catch exception
+ * range enclosing the pc. Used by various
+ * instructions and processCatch to process
+ * break, continue, and errors. */
+ const char *bytes;
/*
* An external evaluation (INST_INVOKE or INST_EVAL) returned
@@ -5354,7 +7779,7 @@ TclExecuteByteCode(interp, codePtr)
*/
processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
switch (*pc) {
case INST_INVOKE_STK1:
opnd = TclGetUInt1AtPtr(pc+1);
@@ -5370,7 +7795,7 @@ TclExecuteByteCode(interp, codePtr)
* the cleanup.
*/
- TRACE(("\"%.30s\" => ", O2S(*tosPtr)));
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
break;
default:
TRACE(("=> "));
@@ -5398,32 +7823,65 @@ TclExecuteByteCode(interp, codePtr)
StringForResultCode(result),
rangePtr->codeOffset, rangePtr->breakOffset));
NEXT_INST_F(0, 0, 0);
- } else {
- if (rangePtr->continueOffset == -1) {
- TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
- StringForResultCode(result)));
- goto checkForCatch;
- }
- result = TCL_OK;
- pc = (codePtr->codeStart + rangePtr->continueOffset);
- TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(result),
- rangePtr->codeOffset, rangePtr->continueOffset));
- NEXT_INST_F(0, 0, 0);
}
-#if TCL_COMPILE_DEBUG
- } else if (traceInstructions) {
- if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
- Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ if (rangePtr->continueOffset == -1) {
+ TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
+ StringForResultCode(result)));
+ goto checkForCatch;
+ }
+ result = TCL_OK;
+ pc = (codePtr->codeStart + rangePtr->continueOffset);
+ TRACE_APPEND(("%s, range at %d, new pc %d\n",
+ StringForResultCode(result),
+ rangePtr->codeOffset, rangePtr->continueOffset));
+ NEXT_INST_F(0, 0, 0);
+ }
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ objPtr = Tcl_GetObjResult(interp);
+ if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
+ TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
result, O2S(objPtr)));
} else {
- Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("%s, result= \"%s\"\n",
+ TRACE_APPEND(("%s, result=\"%.30s\"\n",
StringForResultCode(result), O2S(objPtr)));
}
-#endif
}
+#endif
+ goto checkForCatch;
+
+ /*
+ * Division by zero in an expression. Control only reaches this point
+ * by "goto divideByZero".
+ */
+
+ divideByZero:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+
+ /*
+ * Exponentiation of zero by negative number in an expression. Control
+ * only reaches this point by "goto exponOfZero".
+ */
+
+ exponOfZero:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponentiation of zero by negative power", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+ "exponentiation of zero by negative power", NULL);
+ CACHE_STACK_INFO();
+
+ /*
+ * Almost all error paths feed through here rather than assigning to
+ * result themselves (for a small but consistent saving).
+ */
+
+ gotError:
+ result = TCL_ERROR;
/*
* Execution has generated an "exception" such as TCL_ERROR. If the
@@ -5433,12 +7891,18 @@ TclExecuteByteCode(interp, codePtr)
* and return the "exception" code.
*/
- checkForCatch:
+ checkForCatch:
+ if (iPtr->execEnvPtr->rewind) {
+ goto abnormalReturn;
+ }
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- if (bytes != NULL) {
- Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
- }
+ const unsigned char *pcBeg;
+
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
+ DECACHE_STACK_INFO();
+ TclLogCommandInfo(interp, codePtr->source, bytes,
+ bytes ? length : 0, pcBeg, tosPtr);
+ CACHE_STACK_INFO();
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -5447,20 +7911,41 @@ TclExecuteByteCode(interp, codePtr)
* INST_BEGIN_CATCH.
*/
- while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
- ((ptrdiff_t) eePtr->stackPtr[catchTop] <=
- (ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
- Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
- TclDecrRefCount(expandNestList);
- expandNestList = objPtr;
+ while (auxObjList) {
+ if ((catchTop != initCatchTop)
+ && (*catchTop > (ptrdiff_t)
+ auxObjList->internalRep.ptrAndLongRep.value)) {
+ break;
+ }
+ POP_TAUX_OBJ();
+ }
+
+ /*
+ * We must not catch if the script in progress has been canceled with
+ * the TCL_CANCEL_UNWIND flag. Instead, it blows outwards until we
+ * either hit another interpreter (presumably where the script in
+ * progress has not been canceled) or we get to the top-level. We do
+ * NOT modify the interpreter result here because we know it will
+ * already be set prior to vectoring down to this point in the code.
+ */
+
+ if (TclCanceled(iPtr) && (Tcl_Canceled(interp, 0) == TCL_ERROR)) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... cancel with unwind, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
+ goto abnormalReturn;
}
/*
- * We must not catch an exceeded limit. Instead, it blows outwards
+ * We must not catch an exceeded limit. Instead, it blows outwards
* until we either hit another interpreter (presumably where the limit
* is not exceeded) or we get to the top-level.
*/
- if (Tcl_LimitExceeded(interp)) {
+
+ if (TclLimitExceeded(iPtr->limit)) {
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... limit exceeded, returning %s\n",
@@ -5483,8 +7968,9 @@ TclExecuteByteCode(interp, codePtr)
/*
* This is only possible when compiling a [catch] that sends its
* script to INST_EVAL. Cannot correct the compiler without
- * breakingcompat with previous .tbc compiled scripts.
+ * breaking compat with previous .tbc compiled scripts.
*/
+
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... no enclosing catch, returning %s\n",
@@ -5497,26 +7983,26 @@ TclExecuteByteCode(interp, codePtr)
/*
* A catch exception range (rangePtr) was found to handle an
* "exception". It was found either by checkForCatch just above or by
- * an instruction during break, continue, or error processing. Jump
- * to its catchOffset after unwinding the operand stack to the depth
- * it had when starting to execute the range's catch command.
+ * an instruction during break, continue, or error processing. Jump to
+ * its catchOffset after unwinding the operand stack to the depth it
+ * had when starting to execute the range's catch command.
*/
- processCatch:
- while (tosPtr > ((ptrdiff_t) (eePtr->stackPtr[catchTop])) + eePtr->stackPtr) {
+ processCatch:
+ while (CURR_DEPTH > *catchTop) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
- fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
- rangePtr->codeOffset, (catchTop - initCatchTop - 1),
- (int) eePtr->stackPtr[catchTop],
- (unsigned int)(rangePtr->catchOffset));
+ fprintf(stdout, " ... found catch at %d, catchTop=%d, "
+ "unwound to %ld, new pc %u\n",
+ rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
+ (long) *catchTop, (unsigned) rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
- NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
+ NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */
/*
* end of infinite loop dispatching on instructions.
@@ -5528,35 +8014,1499 @@ TclExecuteByteCode(interp, codePtr)
* initial level.
*/
- abnormalReturn:
+ abnormalReturn:
+ TCL_DTRACE_INST_LAST();
+
+ /*
+ * Clear all expansions and same-level NR calls.
+ *
+ * Note that expansion markers have a NULL type; avoid removing other
+ * markers.
+ */
+
+ while (auxObjList) {
+ POP_TAUX_OBJ();
+ }
+ while (tosPtr > initTosPtr) {
+ objPtr = POP_OBJECT();
+ Tcl_DecrRefCount(objPtr);
+ }
+
+ if (tosPtr < initTosPtr) {
+ fprintf(stderr,
+ "\nTclNRExecuteByteCode: abnormal return at pc %u: "
+ "stack top %d < entry stack top %d\n",
+ (unsigned)(pc - codePtr->codeStart),
+ (unsigned) CURR_DEPTH, (unsigned) 0);
+ Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
+ }
+ CLANG_ASSERT(bcFramePtr);
+ }
+
+ iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+ if (--codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ TclStackFree(interp, TD); /* free my stack */
+
+ return result;
+
+ /*
+ * INST_START_CMD failure case removed where it doesn't bother that much
+ *
+ * Remark that if the interpreter is marked for deletion its
+ * compileEpoch is modified, so that the epoch check also verifies
+ * that the interp is not deleted. If no outside call has been made
+ * since the last check, it is safe to omit the check.
+
+ * case INST_START_CMD:
+ */
+
+ instStartCmdFailed:
{
- Tcl_Obj **initTosPtr = eePtr->stackPtr + initStackTop;
- while (tosPtr > initTosPtr) {
- Tcl_Obj *objPtr = POP_OBJECT();
- TclDecrRefCount(objPtr);
+ const char *bytes;
+
+ checkInterp = 1;
+ length = 0;
+
+ /*
+ * We used to switch to direct eval; for NRE-awareness we now
+ * compile and eval the command so that this evaluation does not
+ * add a new TEBC instance. [Bug 2910748]
+ */
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ goto gotError;
+ }
+
+ codePtr->flags |= TCL_BYTECODE_RECOMPILE;
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pc += (opnd-1);
+ PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
+ goto instEvalStk;
+ }
+}
+
+#undef codePtr
+#undef iPtr
+#undef bcFramePtr
+#undef initCatchTop
+#undef initTosPtr
+#undef auxObjList
+#undef catchTop
+#undef TCONST
+
+static int
+FinalizeOONext(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+ return result;
+}
+
+static int
+FinalizeOONextFilter(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags |= FILTER_HANDLING;
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
+ *
+ * These functions do advanced math for binary and unary operators
+ * respectively, so that the main TEBC code does not bear the cost of
+ * them.
+ *
+ * Results:
+ * A Tcl_Obj* result, or a NULL (in which case valuePtr is updated to
+ * hold the result value), or one of the special flag values
+ * GENERAL_ARITHMETIC_ERROR, EXPONENT_OF_ZERO or DIVIDED_BY_ZERO. The
+ * latter two signify a zero value raised to a negative power or a value
+ * divided by zero, respectively. With GENERAL_ARITHMETIC_ERROR, all
+ * error information will have already been reported in the interpreter
+ * result.
+ *
+ * Side effects:
+ * May update the Tcl_Obj indicated valuePtr if it is unshared. Will
+ * return a NULL when that happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ExecuteExtendedBinaryMathOp(
+ Tcl_Interp *interp, /* Where to report errors. */
+ int opcode, /* What operation to perform. */
+ Tcl_Obj **constants, /* The execution environment's constants. */
+ Tcl_Obj *valuePtr, /* The first operand on the stack. */
+ Tcl_Obj *value2Ptr) /* The second operand on the stack. */
+{
+#define LONG_RESULT(l) \
+ if (Tcl_IsShared(valuePtr)) { \
+ TclNewLongObj(objResultPtr, l); \
+ return objResultPtr; \
+ } else { \
+ Tcl_SetLongObj(valuePtr, l); \
+ return NULL; \
+ }
+#define WIDE_RESULT(w) \
+ if (Tcl_IsShared(valuePtr)) { \
+ return Tcl_NewWideIntObj(w); \
+ } else { \
+ Tcl_SetWideIntObj(valuePtr, w); \
+ return NULL; \
+ }
+#define BIG_RESULT(b) \
+ if (Tcl_IsShared(valuePtr)) { \
+ return Tcl_NewBignumObj(b); \
+ } else { \
+ Tcl_SetBignumObj(valuePtr, b); \
+ return NULL; \
+ }
+#define DOUBLE_RESULT(d) \
+ if (Tcl_IsShared(valuePtr)) { \
+ TclNewDoubleObj(objResultPtr, (d)); \
+ return objResultPtr; \
+ } else { \
+ Tcl_SetDoubleObj(valuePtr, (d)); \
+ return NULL; \
+ }
+
+ int type1, type2;
+ ClientData ptr1, ptr2;
+ double d1, d2, dResult;
+ long l1, l2, lResult;
+ Tcl_WideInt w1, w2, wResult;
+ mp_int big1, big2, bigResult, bigRemainder;
+ Tcl_Obj *objResultPtr;
+ int invalid, numPos, zero;
+ long shift;
+
+ (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
+ (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
+
+ switch (opcode) {
+ case INST_MOD:
+ /* TODO: Attempts to re-use unshared operands on stack */
+
+ l2 = 0; /* silence gcc warning */
+ if (type2 == TCL_NUMBER_LONG) {
+ l2 = *((const long *)ptr2);
+ if (l2 == 0) {
+ return DIVIDED_BY_ZERO;
+ }
+ if ((l2 == 1) || (l2 == -1)) {
+ /*
+ * Div. by |1| always yields remainder of 0.
+ */
+
+ return constants[0];
+ }
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (type1 == TCL_NUMBER_WIDE) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ if (type2 != TCL_NUMBER_BIG) {
+ Tcl_WideInt wQuotient, wRemainder;
+ Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+ wQuotient = w1 / w2;
+
+ /*
+ * Force Tcl's integer division rules.
+ * TODO: examine for logic simplification
+ */
+
+ if (((wQuotient < (Tcl_WideInt) 0)
+ || ((wQuotient == (Tcl_WideInt) 0)
+ && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
+ || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
+ && (wQuotient * w2 != w1)) {
+ wQuotient -= (Tcl_WideInt) 1;
+ }
+ wRemainder = w1 - w2*wQuotient;
+ WIDE_RESULT(wRemainder);
+ }
+
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
+ /* TODO: internals intrusion */
+ if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
+ /*
+ * Arguments are opposite sign; remainder is sum.
+ */
+
+ TclBNInitBignumFromWideInt(&big1, w1);
+ mp_add(&big2, &big1, &big2);
+ mp_clear(&big1);
+ BIG_RESULT(&big2);
}
/*
- * Clear all expansions.
+ * Arguments are same sign; remainder is first operand.
*/
- while (expandNestList) {
- Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
- TclDecrRefCount(expandNestList);
- expandNestList = objPtr;
+ mp_clear(&big2);
+ return NULL;
+ }
+#endif
+ Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
+ Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
+ mp_init(&bigResult);
+ mp_init(&bigRemainder);
+ mp_div(&big1, &big2, &bigResult, &bigRemainder);
+ if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
+ mp_sub_d(&bigResult, 1, &bigResult);
+ mp_add(&bigRemainder, &big2, &bigRemainder);
+ }
+ mp_copy(&bigRemainder, &bigResult);
+ mp_clear(&bigRemainder);
+ mp_clear(&big1);
+ mp_clear(&big2);
+ BIG_RESULT(&bigResult);
+
+ case INST_LSHIFT:
+ case INST_RSHIFT: {
+ /*
+ * Reject negative shift argument.
+ */
+
+ switch (type2) {
+ case TCL_NUMBER_LONG:
+ invalid = (*((const long *)ptr2) < 0L);
+ break;
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
+ break;
+#endif
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ invalid = (mp_cmp_d(&big2, 0) == MP_LT);
+ mp_clear(&big2);
+ break;
+ default:
+ /* Unused, here to silence compiler warning */
+ invalid = 0;
+ }
+ if (invalid) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
+ return GENERAL_ARITHMETIC_ERROR;
+ }
+
+ /*
+ * Zero shifted any number of bits is still zero.
+ */
+
+ if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+ return constants[0];
+ }
+
+ if (opcode == INST_LSHIFT) {
+ /*
+ * Large left shifts create integer overflow.
+ *
+ * BEWARE! Can't use Tcl_GetIntFromObj() here because that
+ * converts values in the (unsigned) range to their signed int
+ * counterparts, leading to incorrect results.
+ */
+
+ if ((type2 != TCL_NUMBER_LONG)
+ || (*((const long *)ptr2) > (long) INT_MAX)) {
+ /*
+ * Technically, we could hold the value (1 << (INT_MAX+1)) in
+ * an mp_int, but since we're using mp_mul_2d() to do the
+ * work, and it takes only an int argument, that's a good
+ * place to draw the line.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
+ return GENERAL_ARITHMETIC_ERROR;
}
- if (tosPtr < initTosPtr) {
- fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n",
- (unsigned int)(pc - codePtr->codeStart),
- (unsigned int) (tosPtr - eePtr->stackPtr),
- (unsigned int) initStackTop);
- Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+ shift = (int)(*((const long *)ptr2));
+
+ /*
+ * Handle shifts within the native wide range.
+ */
+
+ if ((type1 != TCL_NUMBER_BIG)
+ && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
+ TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ if (!((w1>0 ? w1 : ~w1)
+ & -(((Tcl_WideInt)1)
+ << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
+ WIDE_RESULT(w1 << shift);
+ }
+ }
+ } else {
+ /*
+ * Quickly force large right shifts to 0 or -1.
+ */
+
+ if ((type2 != TCL_NUMBER_LONG)
+ || (*(const long *)ptr2 > INT_MAX)) {
+ /*
+ * Again, technically, the value to be shifted could be an
+ * mp_int so huge that a right shift by (INT_MAX+1) bits could
+ * not take us to the result of 0 or -1, but since we're using
+ * mp_div_2d to do the work, and it takes only an int
+ * argument, we draw the line there.
+ */
+
+ switch (type1) {
+ case TCL_NUMBER_LONG:
+ zero = (*(const long *)ptr1 > 0L);
+ break;
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
+ break;
+#endif
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+ zero = (mp_cmp_d(&big1, 0) == MP_GT);
+ mp_clear(&big1);
+ break;
+ default:
+ /* Unused, here to silence compiler warning. */
+ zero = 0;
+ }
+ if (zero) {
+ return constants[0];
+ }
+ LONG_RESULT(-1);
+ }
+ shift = (int)(*(const long *)ptr2);
+
+#ifndef TCL_WIDE_INT_IS_LONG
+ /*
+ * Handle shifts within the native wide range.
+ */
+
+ if (type1 == TCL_NUMBER_WIDE) {
+ w1 = *(const Tcl_WideInt *)ptr1;
+ if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
+ if (w1 >= (Tcl_WideInt)0) {
+ return constants[0];
+ }
+ LONG_RESULT(-1);
+ }
+ WIDE_RESULT(w1 >> shift);
}
- eePtr->tosPtr = initTosPtr - codePtr->maxExceptDepth;
+#endif
+ }
+
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+
+ mp_init(&bigResult);
+ if (opcode == INST_LSHIFT) {
+ mp_mul_2d(&big1, shift, &bigResult);
+ } else {
+ mp_init(&bigRemainder);
+ mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
+ if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
+ mp_sub_d(&bigResult, 1, &bigResult);
+ }
+ mp_clear(&bigRemainder);
}
+ mp_clear(&big1);
+ BIG_RESULT(&bigResult);
+ }
+
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
+ mp_int *First, *Second;
+
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
+ /*
+ * Count how many positive arguments we have. If only one of the
+ * arguments is negative, store it in 'Second'.
+ */
+
+ if (mp_cmp_d(&big1, 0) != MP_LT) {
+ numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
+ First = &big1;
+ Second = &big2;
+ } else {
+ First = &big2;
+ Second = &big1;
+ numPos = (mp_cmp_d(First, 0) != MP_LT);
+ }
+ mp_init(&bigResult);
+
+ switch (opcode) {
+ case INST_BITAND:
+ switch (numPos) {
+ case 2:
+ /*
+ * Both arguments positive, base case.
+ */
+
+ mp_and(First, Second, &bigResult);
+ break;
+ case 1:
+ /*
+ * First is positive; second negative:
+ * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
+ */
+
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_xor(First, Second, &bigResult);
+ mp_and(First, &bigResult, &bigResult);
+ break;
+ case 0:
+ /*
+ * Both arguments negative:
+ * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
+ */
+
+ mp_neg(First, First);
+ mp_sub_d(First, 1, First);
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_or(First, Second, &bigResult);
+ mp_neg(&bigResult, &bigResult);
+ mp_sub_d(&bigResult, 1, &bigResult);
+ break;
+ }
+ break;
+
+ case INST_BITOR:
+ switch (numPos) {
+ case 2:
+ /*
+ * Both arguments positive, base case.
+ */
+
+ mp_or(First, Second, &bigResult);
+ break;
+ case 1:
+ /*
+ * First is positive; second negative:
+ * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
+ */
+
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_xor(First, Second, &bigResult);
+ mp_and(Second, &bigResult, &bigResult);
+ mp_neg(&bigResult, &bigResult);
+ mp_sub_d(&bigResult, 1, &bigResult);
+ break;
+ case 0:
+ /*
+ * Both arguments negative:
+ * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
+ */
+
+ mp_neg(First, First);
+ mp_sub_d(First, 1, First);
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_and(First, Second, &bigResult);
+ mp_neg(&bigResult, &bigResult);
+ mp_sub_d(&bigResult, 1, &bigResult);
+ break;
+ }
+ break;
+
+ case INST_BITXOR:
+ switch (numPos) {
+ case 2:
+ /*
+ * Both arguments positive, base case.
+ */
+
+ mp_xor(First, Second, &bigResult);
+ break;
+ case 1:
+ /*
+ * First is positive; second negative:
+ * P^N = ~(P^~N) = -(P^(-N-1))-1
+ */
+
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_xor(First, Second, &bigResult);
+ mp_neg(&bigResult, &bigResult);
+ mp_sub_d(&bigResult, 1, &bigResult);
+ break;
+ case 0:
+ /*
+ * Both arguments negative:
+ * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
+ */
+
+ mp_neg(First, First);
+ mp_sub_d(First, 1, First);
+ mp_neg(Second, Second);
+ mp_sub_d(Second, 1, Second);
+ mp_xor(First, Second, &bigResult);
+ break;
+ }
+ break;
+ }
+
+ mp_clear(&big1);
+ mp_clear(&big2);
+ BIG_RESULT(&bigResult);
+ }
+
+#ifndef TCL_WIDE_INT_IS_LONG
+ if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
+ TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+
+ switch (opcode) {
+ case INST_BITAND:
+ wResult = w1 & w2;
+ break;
+ case INST_BITOR:
+ wResult = w1 | w2;
+ break;
+ case INST_BITXOR:
+ wResult = w1 ^ w2;
+ break;
+ default:
+ /* Unused, here to silence compiler warning. */
+ wResult = 0;
+ }
+ WIDE_RESULT(wResult);
+ }
+#endif
+ l1 = *((const long *)ptr1);
+ l2 = *((const long *)ptr2);
+
+ switch (opcode) {
+ case INST_BITAND:
+ lResult = l1 & l2;
+ break;
+ case INST_BITOR:
+ lResult = l1 | l2;
+ break;
+ case INST_BITXOR:
+ lResult = l1 ^ l2;
+ break;
+ default:
+ /* Unused, here to silence compiler warning. */
+ lResult = 0;
+ }
+ LONG_RESULT(lResult);
+
+ case INST_EXPON: {
+ int oddExponent = 0, negativeExponent = 0;
+ unsigned short base;
+
+ if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
+ Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
+ Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
+
+ if (d1==0.0 && d2<0.0) {
+ return EXPONENT_OF_ZERO;
+ }
+ dResult = pow(d1, d2);
+ goto doubleResult;
+ }
+ l1 = l2 = 0;
+ if (type2 == TCL_NUMBER_LONG) {
+ l2 = *((const long *) ptr2);
+ if (l2 == 0) {
+ /*
+ * Anything to the zero power is 1.
+ */
+
+ return constants[1];
+ } else if (l2 == 1) {
+ /*
+ * Anything to the first power is itself
+ */
+
+ return NULL;
+ }
+ }
+
+ switch (type2) {
+ case TCL_NUMBER_LONG:
+ negativeExponent = (l2 < 0);
+ oddExponent = (int) (l2 & 1);
+ break;
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ w2 = *((const Tcl_WideInt *)ptr2);
+ negativeExponent = (w2 < 0);
+ oddExponent = (int) (w2 & (Tcl_WideInt)1);
+ break;
+#endif
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+ mp_mod_2d(&big2, 1, &big2);
+ oddExponent = !mp_iszero(&big2);
+ mp_clear(&big2);
+ break;
+ }
+
+ if (type1 == TCL_NUMBER_LONG) {
+ l1 = *((const long *)ptr1);
+ }
+ if (negativeExponent) {
+ if (type1 == TCL_NUMBER_LONG) {
+ switch (l1) {
+ case 0:
+ /*
+ * Zero to a negative power is div by zero error.
+ */
+
+ return EXPONENT_OF_ZERO;
+ case -1:
+ if (oddExponent) {
+ LONG_RESULT(-1);
+ }
+ /* fallthrough */
+ case 1:
+ /*
+ * 1 to any power is 1.
+ */
+
+ return constants[1];
+ }
+ }
+
+ /*
+ * Integers with magnitude greater than 1 raise to a negative
+ * power yield the answer zero (see TIP 123).
+ */
+
+ return constants[0];
+ }
+
+ if (type1 == TCL_NUMBER_LONG) {
+ switch (l1) {
+ case 0:
+ /*
+ * Zero to a positive power is zero.
+ */
+
+ return constants[0];
+ case 1:
+ /*
+ * 1 to any power is 1.
+ */
+
+ return constants[1];
+ case -1:
+ if (!oddExponent) {
+ return constants[1];
+ }
+ LONG_RESULT(-1);
+ }
+ }
+
+ /*
+ * We refuse to accept exponent arguments that exceed one mp_digit
+ * which means the max exponent value is 2**28-1 = 0x0fffffff =
+ * 268435455, which fits into a signed 32 bit int which is within the
+ * range of the long int type. This means any numeric Tcl_Obj value
+ * not using TCL_NUMBER_LONG type must hold a value larger than we
+ * accept.
+ */
+
+ if (type2 != TCL_NUMBER_LONG) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
+ return GENERAL_ARITHMETIC_ERROR;
+ }
+
+ if (type1 == TCL_NUMBER_LONG) {
+ if (l1 == 2) {
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
+
+ if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
+ LONG_RESULT(1L << l2);
+ }
+#if !defined(TCL_WIDE_INT_IS_LONG)
+ if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
+ WIDE_RESULT(((Tcl_WideInt) 1) << l2);
+ }
+#endif
+ goto overflowExpon;
+ }
+ if (l1 == -2) {
+ int signum = oddExponent ? -1 : 1;
+
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
+
+ if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
+ LONG_RESULT(signum * (1L << l2));
+ }
+#if !defined(TCL_WIDE_INT_IS_LONG)
+ if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
+ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
+ }
+#endif
+ goto overflowExpon;
+ }
+#if (LONG_MAX == 0x7fffffff)
+ if (l2 - 2 < (long)MaxBase32Size
+ && l1 <= MaxBase32[l2 - 2]
+ && l1 >= -MaxBase32[l2 - 2]) {
+ /*
+ * Small powers of 32-bit integers.
+ */
+
+ lResult = l1 * l1; /* b**2 */
+ switch (l2) {
+ case 2:
+ break;
+ case 3:
+ lResult *= l1; /* b**3 */
+ break;
+ case 4:
+ lResult *= lResult; /* b**4 */
+ break;
+ case 5:
+ lResult *= lResult; /* b**4 */
+ lResult *= l1; /* b**5 */
+ break;
+ case 6:
+ lResult *= l1; /* b**3 */
+ lResult *= lResult; /* b**6 */
+ break;
+ case 7:
+ lResult *= l1; /* b**3 */
+ lResult *= lResult; /* b**6 */
+ lResult *= l1; /* b**7 */
+ break;
+ case 8:
+ lResult *= lResult; /* b**4 */
+ lResult *= lResult; /* b**8 */
+ break;
+ }
+ LONG_RESULT(lResult);
+ }
+
+ if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
+ && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
+ base = Exp32Index[l1 - 3]
+ + (unsigned short) (l2 - 2 - MaxBase32Size);
+ if (base < Exp32Index[l1 - 2]) {
+ /*
+ * 32-bit number raised to intermediate power, done by
+ * table lookup.
+ */
+
+ LONG_RESULT(Exp32Value[base]);
+ }
+ }
+ if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
+ && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
+ base = Exp32Index[-l1 - 3]
+ + (unsigned short) (l2 - 2 - MaxBase32Size);
+ if (base < Exp32Index[-l1 - 2]) {
+ /*
+ * 32-bit number raised to intermediate power, done by
+ * table lookup.
+ */
+
+ lResult = (oddExponent) ?
+ -Exp32Value[base] : Exp32Value[base];
+ LONG_RESULT(lResult);
+ }
+ }
+#endif
+ }
+#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
+ if (type1 == TCL_NUMBER_LONG) {
+ w1 = l1;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (type1 == TCL_NUMBER_WIDE) {
+ w1 = *((const Tcl_WideInt *) ptr1);
+#endif
+ } else {
+ goto overflowExpon;
+ }
+ if (l2 - 2 < (long)MaxBase64Size
+ && w1 <= MaxBase64[l2 - 2]
+ && w1 >= -MaxBase64[l2 - 2]) {
+ /*
+ * Small powers of integers whose result is wide.
+ */
+
+ wResult = w1 * w1; /* b**2 */
+ switch (l2) {
+ case 2:
+ break;
+ case 3:
+ wResult *= l1; /* b**3 */
+ break;
+ case 4:
+ wResult *= wResult; /* b**4 */
+ break;
+ case 5:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ break;
+ case 6:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ break;
+ case 7:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ break;
+ case 8:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ break;
+ case 9:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= w1; /* b**9 */
+ break;
+ case 10:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ break;
+ case 11:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ wResult *= w1; /* b**11 */
+ break;
+ case 12:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ break;
+ case 13:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ wResult *= w1; /* b**13 */
+ break;
+ case 14:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ break;
+ case 15:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ wResult *= w1; /* b**15 */
+ break;
+ case 16:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= wResult; /* b**16 */
+ break;
+ }
+ WIDE_RESULT(wResult);
+ }
+
+ /*
+ * Handle cases of powers > 16 that still fit in a 64-bit word by
+ * doing table lookup.
+ */
+
+ if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
+ && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ base = Exp64Index[w1 - 3]
+ + (unsigned short) (l2 - 2 - MaxBase64Size);
+ if (base < Exp64Index[w1 - 2]) {
+ /*
+ * 64-bit number raised to intermediate power, done by
+ * table lookup.
+ */
+
+ WIDE_RESULT(Exp64Value[base]);
+ }
+ }
+
+ if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
+ && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ base = Exp64Index[-w1 - 3]
+ + (unsigned short) (l2 - 2 - MaxBase64Size);
+ if (base < Exp64Index[-w1 - 2]) {
+ /*
+ * 64-bit number raised to intermediate power, done by
+ * table lookup.
+ */
+
+ wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
+ WIDE_RESULT(wResult);
+ }
+ }
+#endif
+
+ overflowExpon:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ if (big2.used > 1) {
+ mp_clear(&big2);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
+ return GENERAL_ARITHMETIC_ERROR;
+ }
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+ mp_init(&bigResult);
+ mp_expt_d(&big1, big2.dp[0], &bigResult);
+ mp_clear(&big1);
+ mp_clear(&big2);
+ BIG_RESULT(&bigResult);
+ }
+
+ case INST_ADD:
+ case INST_SUB:
+ case INST_MULT:
+ case INST_DIV:
+ if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
+ /*
+ * At least one of the values is floating-point, so perform
+ * floating point calculations.
+ */
+
+ Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
+ Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
+
+ switch (opcode) {
+ case INST_ADD:
+ dResult = d1 + d2;
+ break;
+ case INST_SUB:
+ dResult = d1 - d2;
+ break;
+ case INST_MULT:
+ dResult = d1 * d2;
+ break;
+ case INST_DIV:
+#ifndef IEEE_FLOATING_POINT
+ if (d2 == 0.0) {
+ return DIVIDED_BY_ZERO;
+ }
+#endif
+ /*
+ * We presume that we are running with zero-divide unmasked if
+ * we're on an IEEE box. Otherwise, this statement might cause
+ * demons to fly out our noses.
+ */
+
+ dResult = d1 / d2;
+ break;
+ default:
+ /* Unused, here to silence compiler warning. */
+ dResult = 0;
+ }
+
+ doubleResult:
+#ifndef ACCEPT_NAN
+ /*
+ * Check now for IEEE floating-point error.
+ */
+
+ if (TclIsNaN(dResult)) {
+ TclExprFloatError(interp, dResult);
+ return GENERAL_ARITHMETIC_ERROR;
+ }
+#endif
+ DOUBLE_RESULT(dResult);
+ }
+ if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+ TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+
+ switch (opcode) {
+ case INST_ADD:
+ wResult = w1 + w2;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+ {
+ /*
+ * Check for overflow.
+ */
+
+ if (Overflowing(w1, w2, wResult)) {
+ goto overflowBasic;
+ }
+ }
+ break;
+
+ case INST_SUB:
+ wResult = w1 - w2;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+ {
+ /*
+ * Must check for overflow. The macro tests for overflows
+ * in sums by looking at the sign bits. As we have a
+ * subtraction here, we are adding -w2. As -w2 could in
+ * turn overflow, we test with ~w2 instead: it has the
+ * opposite sign bit to w2 so it does the job. Note that
+ * the only "bad" case (w2==0) is irrelevant for this
+ * macro, as in that case w1 and wResult have the same
+ * sign and there is no overflow anyway.
+ */
+
+ if (Overflowing(w1, ~w2, wResult)) {
+ goto overflowBasic;
+ }
+ }
+ break;
+
+ case INST_MULT:
+ if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
+ || (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
+ goto overflowBasic;
+ }
+ wResult = w1 * w2;
+ break;
+
+ case INST_DIV:
+ if (w2 == 0) {
+ return DIVIDED_BY_ZERO;
+ }
+
+ /*
+ * Need a bignum to represent (LLONG_MIN / -1)
+ */
+
+ if ((w1 == LLONG_MIN) && (w2 == -1)) {
+ goto overflowBasic;
+ }
+ wResult = w1 / w2;
+
+ /*
+ * Force Tcl's integer division rules.
+ * TODO: examine for logic simplification
+ */
+
+ if (((wResult < 0) || ((wResult == 0) &&
+ ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+ (wResult*w2 != w1)) {
+ wResult -= 1;
+ }
+ break;
+
+ default:
+ /*
+ * Unused, here to silence compiler warning.
+ */
+
+ wResult = 0;
+ }
+
+ WIDE_RESULT(wResult);
+ }
+
+ overflowBasic:
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ mp_init(&bigResult);
+ switch (opcode) {
+ case INST_ADD:
+ mp_add(&big1, &big2, &bigResult);
+ break;
+ case INST_SUB:
+ mp_sub(&big1, &big2, &bigResult);
+ break;
+ case INST_MULT:
+ mp_mul(&big1, &big2, &bigResult);
+ break;
+ case INST_DIV:
+ if (mp_iszero(&big2)) {
+ mp_clear(&big1);
+ mp_clear(&big2);
+ mp_clear(&bigResult);
+ return DIVIDED_BY_ZERO;
+ }
+ mp_init(&bigRemainder);
+ mp_div(&big1, &big2, &bigResult, &bigRemainder);
+ /* TODO: internals intrusion */
+ if (!mp_iszero(&bigRemainder)
+ && (bigRemainder.sign != big2.sign)) {
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
+ mp_sub_d(&bigResult, 1, &bigResult);
+ mp_add(&bigRemainder, &big2, &bigRemainder);
+ }
+ mp_clear(&bigRemainder);
+ break;
+ }
+ mp_clear(&big1);
+ mp_clear(&big2);
+ BIG_RESULT(&bigResult);
+ }
+
+ Tcl_Panic("unexpected opcode");
+ return NULL;
+}
+
+static Tcl_Obj *
+ExecuteExtendedUnaryMathOp(
+ int opcode, /* What operation to perform. */
+ Tcl_Obj *valuePtr) /* The operand on the stack. */
+{
+ ClientData ptr;
+ int type;
+ Tcl_WideInt w;
+ mp_int big;
+ Tcl_Obj *objResultPtr;
+
+ (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
+
+ switch (opcode) {
+ case INST_BITNOT:
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (type == TCL_NUMBER_WIDE) {
+ w = *((const Tcl_WideInt *) ptr);
+ WIDE_RESULT(~w);
+ }
+#endif
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
+ /* ~a = - a - 1 */
+ mp_neg(&big, &big);
+ mp_sub_d(&big, 1, &big);
+ BIG_RESULT(&big);
+ case INST_UMINUS:
+ switch (type) {
+ case TCL_NUMBER_DOUBLE:
+ DOUBLE_RESULT(-(*((const double *) ptr)));
+ case TCL_NUMBER_LONG:
+ w = (Tcl_WideInt) (*((const long *) ptr));
+ if (w != LLONG_MIN) {
+ WIDE_RESULT(-w);
+ }
+ TclBNInitBignumFromLong(&big, *(const long *) ptr);
+ break;
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ w = *((const Tcl_WideInt *) ptr);
+ if (w != LLONG_MIN) {
+ WIDE_RESULT(-w);
+ }
+ TclBNInitBignumFromWideInt(&big, w);
+ break;
+#endif
+ default:
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
+ }
+ mp_neg(&big, &big);
+ BIG_RESULT(&big);
+ }
+
+ Tcl_Panic("unexpected opcode");
+ return NULL;
+}
+#undef LONG_RESULT
+#undef WIDE_RESULT
+#undef BIG_RESULT
+#undef DOUBLE_RESULT
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompareTwoNumbers --
+ *
+ * This function compares a pair of numbers in Tcl_Objs. Each argument
+ * must already be known to be numeric and not NaN.
+ *
+ * Results:
+ * One of MP_LT, MP_EQ or MP_GT, depending on whether valuePtr is less
+ * than, equal to, or greater than value2Ptr (respectively).
+ *
+ * Side effects:
+ * None, provided both values are numeric.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompareTwoNumbers(
+ Tcl_Obj *valuePtr,
+ Tcl_Obj *value2Ptr)
+{
+ int type1, type2, compare;
+ ClientData ptr1, ptr2;
+ mp_int big1, big2;
+ double d1, d2, tmp;
+ long l1, l2;
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt w1, w2;
+#endif
+
+ (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
+ (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
+
+ switch (type1) {
+ case TCL_NUMBER_LONG:
+ l1 = *((const long *)ptr1);
+ switch (type2) {
+ case TCL_NUMBER_LONG:
+ l2 = *((const long *)ptr2);
+ longCompare:
+ return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ w2 = *((const Tcl_WideInt *)ptr2);
+ w1 = (Tcl_WideInt)l1;
+ goto wideCompare;
+#endif
+ case TCL_NUMBER_DOUBLE:
+ d2 = *((const double *)ptr2);
+ d1 = (double) l1;
+
+ /*
+ * If the double has a fractional part, or if the long can be
+ * converted to double without loss of precision, then compare as
+ * doubles.
+ */
+
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
+ || modf(d2, &tmp) != 0.0) {
+ goto doubleCompare;
+ }
+
+ /*
+ * Otherwise, to make comparision based on full precision, need to
+ * convert the double to a suitably sized integer.
+ *
+ * Need this to get comparsions like
+ * expr 20000000000000003 < 20000000000000004.0
+ * right. Converting the first argument to double will yield two
+ * double values that are equivalent within double precision.
+ * Converting the double to an integer gets done exactly, then
+ * integer comparison can tell the difference.
+ */
+
+ if (d2 < (double)LONG_MIN) {
+ return MP_GT;
+ }
+ if (d2 > (double)LONG_MAX) {
+ return MP_LT;
+ }
+ l2 = (long) d2;
+ goto longCompare;
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ if (mp_cmp_d(&big2, 0) == MP_LT) {
+ compare = MP_GT;
+ } else {
+ compare = MP_LT;
+ }
+ mp_clear(&big2);
+ return compare;
+ }
+
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ w1 = *((const Tcl_WideInt *)ptr1);
+ switch (type2) {
+ case TCL_NUMBER_WIDE:
+ w2 = *((const Tcl_WideInt *)ptr2);
+ wideCompare:
+ return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
+ case TCL_NUMBER_LONG:
+ l2 = *((const long *)ptr2);
+ w2 = (Tcl_WideInt)l2;
+ goto wideCompare;
+ case TCL_NUMBER_DOUBLE:
+ d2 = *((const double *)ptr2);
+ d1 = (double) w1;
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+ || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
+ goto doubleCompare;
+ }
+ if (d2 < (double)LLONG_MIN) {
+ return MP_GT;
+ }
+ if (d2 > (double)LLONG_MAX) {
+ return MP_LT;
+ }
+ w2 = (Tcl_WideInt) d2;
+ goto wideCompare;
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ if (mp_cmp_d(&big2, 0) == MP_LT) {
+ compare = MP_GT;
+ } else {
+ compare = MP_LT;
+ }
+ mp_clear(&big2);
+ return compare;
+ }
+#endif
+
+ case TCL_NUMBER_DOUBLE:
+ d1 = *((const double *)ptr1);
+ switch (type2) {
+ case TCL_NUMBER_DOUBLE:
+ d2 = *((const double *)ptr2);
+ doubleCompare:
+ return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
+ case TCL_NUMBER_LONG:
+ l2 = *((const long *)ptr2);
+ d2 = (double) l2;
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2
+ || modf(d1, &tmp) != 0.0) {
+ goto doubleCompare;
+ }
+ if (d1 < (double)LONG_MIN) {
+ return MP_LT;
+ }
+ if (d1 > (double)LONG_MAX) {
+ return MP_GT;
+ }
+ l1 = (long) d1;
+ goto longCompare;
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+ w2 = *((const Tcl_WideInt *)ptr2);
+ d2 = (double) w2;
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+ || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
+ goto doubleCompare;
+ }
+ if (d1 < (double)LLONG_MIN) {
+ return MP_LT;
+ }
+ if (d1 > (double)LLONG_MAX) {
+ return MP_GT;
+ }
+ w1 = (Tcl_WideInt) d1;
+ goto wideCompare;
+#endif
+ case TCL_NUMBER_BIG:
+ if (TclIsInfinite(d1)) {
+ return (d1 > 0.0) ? MP_GT : MP_LT;
+ }
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
+ if (mp_cmp_d(&big2, 0) == MP_LT) {
+ compare = MP_GT;
+ } else {
+ compare = MP_LT;
+ }
+ mp_clear(&big2);
+ return compare;
+ }
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ && modf(d1, &tmp) != 0.0) {
+ d2 = TclBignumToDouble(&big2);
+ mp_clear(&big2);
+ goto doubleCompare;
+ }
+ Tcl_InitBignumFromDouble(NULL, d1, &big1);
+ goto bigCompare;
+ }
+
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+ switch (type2) {
+#ifndef TCL_WIDE_INT_IS_LONG
+ case TCL_NUMBER_WIDE:
+#endif
+ case TCL_NUMBER_LONG:
+ compare = mp_cmp_d(&big1, 0);
+ mp_clear(&big1);
+ return compare;
+ case TCL_NUMBER_DOUBLE:
+ d2 = *((const double *)ptr2);
+ if (TclIsInfinite(d2)) {
+ compare = (d2 > 0.0) ? MP_LT : MP_GT;
+ mp_clear(&big1);
+ return compare;
+ }
+ if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
+ compare = mp_cmp_d(&big1, 0);
+ mp_clear(&big1);
+ return compare;
+ }
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ && modf(d2, &tmp) != 0.0) {
+ d1 = TclBignumToDouble(&big1);
+ mp_clear(&big1);
+ goto doubleCompare;
+ }
+ Tcl_InitBignumFromDouble(NULL, d2, &big2);
+ goto bigCompare;
+ case TCL_NUMBER_BIG:
+ Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+ bigCompare:
+ compare = mp_cmp(&big1, &big2);
+ mp_clear(&big1);
+ mp_clear(&big2);
+ return compare;
+ }
+ default:
+ Tcl_Panic("unexpected number type");
+ return TCL_ERROR;
}
- return result;
-#undef iPtr
}
#ifdef TCL_COMPILE_DEBUG
@@ -5565,8 +9515,8 @@ TclExecuteByteCode(interp, codePtr)
*
* PrintByteCodeInfo --
*
- * This procedure prints a summary about a bytecode object to stdout. It
- * is called by TclExecuteByteCode when starting to execute the bytecode
+ * This procedure prints a summary about a bytecode object to stdout. It
+ * is called by TclNRExecuteByteCode when starting to execute the bytecode
* object if tclTraceExec has the value 2 or more.
*
* Results:
@@ -5579,16 +9529,15 @@ TclExecuteByteCode(interp, codePtr)
*/
static void
-PrintByteCodeInfo(codePtr)
- register ByteCode *codePtr; /* The bytecode whose summary is printed to
+PrintByteCodeInfo(
+ register ByteCode *codePtr) /* The bytecode whose summary is printed to
* stdout. */
{
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- fprintf(stdout, "\nExecuting ByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
- (unsigned int) codePtr, codePtr->refCount,
- codePtr->compileEpoch, (unsigned int) iPtr,
+ fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
+ codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
fprintf(stdout, " Source: ");
@@ -5600,25 +9549,25 @@ PrintByteCodeInfo(codePtr)
codePtr->numAuxDataItems, codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
codePtr->numSrcBytes?
- ((float)codePtr->structureSize)/codePtr->numSrcBytes :
+ ((float)codePtr->structureSize)/codePtr->numSrcBytes :
#endif
0.0);
#ifdef TCL_COMPILE_STATS
- fprintf(stdout, " Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
- codePtr->structureSize,
- (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+ fprintf(stdout, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+ (unsigned long) codePtr->structureSize,
+ (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)),
codePtr->numCodeBytes,
- (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
- (codePtr->numExceptRanges * sizeof(ExceptionRange)),
- (codePtr->numAuxDataItems * sizeof(AuxData)),
+ (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+ (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
if (procPtr != NULL) {
fprintf(stdout,
- " Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
- (unsigned int) procPtr, procPtr->refCount,
- procPtr->numArgs, procPtr->numCompiledLocals);
+ " Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
+ procPtr, procPtr->refCount, procPtr->numArgs,
+ procPtr->numCompiledLocals);
}
}
#endif /* TCL_COMPILE_DEBUG */
@@ -5628,7 +9577,7 @@ PrintByteCodeInfo(codePtr)
*
* ValidatePcAndStackTop --
*
- * This procedure is called by TclExecuteByteCode when debugging to
+ * This procedure is called by TclNRExecuteByteCode when debugging to
* verify that the program counter and stack top are valid during
* execution.
*
@@ -5644,53 +9593,54 @@ PrintByteCodeInfo(codePtr)
#ifdef TCL_COMPILE_DEBUG
static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
- register ByteCode *codePtr; /* The bytecode whose summary is printed to
+ValidatePcAndStackTop(
+ register ByteCode *codePtr, /* The bytecode whose summary is printed to
* stdout. */
- unsigned char *pc; /* Points to first byte of a bytecode
+ const unsigned char *pc, /* Points to first byte of a bytecode
* instruction. The program counter. */
- int stackTop; /* Current stack top. Must be between
+ int stackTop, /* Current stack top. Must be between
* stackLowerBound and stackUpperBound
* (inclusive). */
- int stackLowerBound; /* Smallest legal value for stackTop. */
- int checkStack; /* 0 if the stack depth check should be
+ int checkStack) /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ int stackUpperBound = codePtr->maxStackDepth;
/* Greatest legal value for stackTop. */
- unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
- unsigned int codeStart = (unsigned int) codePtr->codeStart;
- unsigned int codeEnd = (unsigned int)
+ unsigned relativePc = (unsigned) (pc - codePtr->codeStart);
+ unsigned long codeStart = (unsigned long) codePtr->codeStart;
+ unsigned long codeEnd = (unsigned long)
(codePtr->codeStart + codePtr->numCodeBytes);
unsigned char opCode = *pc;
- if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
- fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
- (unsigned int) pc);
- Tcl_Panic("TclExecuteByteCode execution failure: bad pc");
+ if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) {
+ fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
+ pc);
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
}
- if ((unsigned int) opCode > LAST_INST_OPCODE) {
- fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
- (unsigned int) opCode, relativePc);
- Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
+ if ((unsigned) opCode > LAST_INST_OPCODE) {
+ fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
+ (unsigned) opCode, relativePc);
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
- ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+ if (checkStack &&
+ ((stackTop < 0) || (stackTop > stackUpperBound))) {
int numChars;
- char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+ const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
- fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
- stackTop, relativePc, stackLowerBound, stackUpperBound);
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
+ stackTop, relativePc, stackUpperBound);
if (cmd != NULL) {
- Tcl_Obj *message = Tcl_NewStringObj("\n executing ", -1);
+ Tcl_Obj *message;
+
+ TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
- TclAppendLimitedToObj(message, cmd, numChars, 100, NULL);
+ Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
fprintf(stderr,"%s\n", Tcl_GetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
}
- Tcl_Panic("TclExecuteByteCode execution failure: bad stack top");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
}
}
#endif /* TCL_COMPILE_DEBUG */
@@ -5700,7 +9650,7 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
*
* IllegalExprOperandType --
*
- * Used by TclExecuteByteCode to append an error message to the interp
+ * Used by TclNRExecuteByteCode to append an error message to the interp
* result when an illegal operand type is detected by an expression
* instruction. The argument opndPtr holds the operand object in error.
*
@@ -5714,130 +9664,54 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
*/
static void
-IllegalExprOperandType(interp, pc, opndPtr)
- Tcl_Interp *interp; /* Interpreter to which error information
+IllegalExprOperandType(
+ Tcl_Interp *interp, /* Interpreter to which error information
* pertains. */
- unsigned char *pc; /* Points to the instruction being executed
+ const unsigned char *pc, /* Points to the instruction being executed
* when the illegal type was found. */
- Tcl_Obj *opndPtr; /* Points to the operand holding the value
+ Tcl_Obj *opndPtr) /* Points to the operand holding the value
* with the illegal type. */
{
- unsigned char opCode = *pc;
- CONST char *operator = operatorStrings[opCode - INST_LOR];
- if (opCode == INST_EXPON) {
+ ClientData ptr;
+ int type;
+ const unsigned char opcode = *pc;
+ const char *description, *operator = "unknown";
+
+ if (opcode == INST_EXPON) {
operator = "**";
+ } else if (opcode <= INST_STR_NEQ) {
+ operator = operatorStrings[opcode - INST_LOR];
}
- Tcl_SetObjResult(interp, Tcl_NewObj());
- if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
- Tcl_AppendResult(interp, "can't use empty string as operand of \"",
- operator, "\"", (char *) NULL);
- } else {
- char *msg = "non-numeric string";
- char *s, *p;
- int length;
- int looksLikeInt = 0;
-
- s = Tcl_GetStringFromObj(opndPtr, &length);
- p = s;
- /*
- * strtod() isn't at all consistent about detecting Inf and NaN
- * between platforms.
- */
- if (length == 3) {
- if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') &&
- (s[2]=='n' || s[2]=='N')) {
- msg = "non-numeric floating-point value";
- goto makeErrorMessage;
- }
- if ((s[0]=='i' || s[0]=='I') && (s[1]=='n' || s[1]=='N') &&
- (s[2]=='f' || s[2]=='F')) {
- msg = "infinite floating-point value";
- goto makeErrorMessage;
- }
- }
-
- /*
- * We cannot use TclLooksLikeInt here because it passes strings like
- * "10;" [Bug 587140]. We'll accept as "looking like ints" for the
- * present purposes any string that looks formally like a
- * (decimal|octal|hex) integer.
- */
-
- while (length && isspace(UCHAR(*p))) {
- length--;
- p++;
- }
- if (length && ((*p == '+') || (*p == '-'))) {
- length--;
- p++;
- }
- if (length) {
- if ((*p == '0') && ((*(p+1) == 'x') || (*(p+1) == 'X'))) {
- p += 2;
- length -= 2;
- looksLikeInt = ((length > 0) && isxdigit(UCHAR(*p)));
- if (looksLikeInt) {
- length--;
- p++;
- while (length && isxdigit(UCHAR(*p))) {
- length--;
- p++;
- }
- }
- } else {
- looksLikeInt = (length && isdigit(UCHAR(*p)));
- if (looksLikeInt) {
- length--;
- p++;
- while (length && isdigit(UCHAR(*p))) {
- length--;
- p++;
- }
- }
- }
- while (length && isspace(UCHAR(*p))) {
- length--;
- p++;
- }
- looksLikeInt = !length;
- }
- if (looksLikeInt) {
- /*
- * If something that looks like an integer could not be converted,
- * then it *must* be a bad octal or too large to represent [Bug
- * 542588].
- */
+ if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
- if (TclCheckBadOctal(NULL, s)) {
- msg = "invalid octal number";
- } else {
- msg = "integer value too large to represent";
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", (char *) NULL);
- }
+ if (numBytes == 0) {
+ description = "empty string";
+ } else if (TclCheckBadOctal(NULL, bytes)) {
+ description = "invalid octal number";
} else {
- /*
- * See if the operand can be interpreted as a double in order to
- * improve the error message.
- */
-
- double d;
-
- if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
- msg = "floating-point value";
- }
+ description = "non-numeric string";
}
- makeErrorMessage:
- Tcl_AppendResult(interp, "can't use ", msg, " as operand of \"",
- operator, "\"", (char *) NULL);
+ } else if (type == TCL_NUMBER_NAN) {
+ description = "non-numeric floating-point value";
+ } else if (type == TCL_NUMBER_DOUBLE) {
+ description = "floating-point value";
+ } else {
+ /* TODO: No caller needs this. Eliminate? */
+ description = "(big) integer";
}
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use %s as operand of \"%s\"", description, operator));
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
/*
*----------------------------------------------------------------------
*
- * GetSrcInfoForPc --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
*
* Given a program counter value, finds the closest command in the
* bytecode code unit's CmdLocation array and returns information about
@@ -5853,22 +9727,111 @@ IllegalExprOperandType(interp, pc, opndPtr)
* unchanged.
*
* Side effects:
- * None.
+ * The CmdFrame at *cfPtr is updated.
*
*----------------------------------------------------------------------
*/
-static char *
-GetSrcInfoForPc(pc, codePtr, lengthPtr)
- unsigned char *pc; /* The program counter value for which to
+Tcl_Obj *
+TclGetSourceFromFrame(
+ CmdFrame *cfPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ if (cfPtr == NULL) {
+ return Tcl_NewListObj(objc, objv);
+ }
+ if (cfPtr->cmdObj == NULL) {
+ if (cfPtr->cmd == NULL) {
+ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+ cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
+ cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
+ }
+ cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+ Tcl_IncrRefCount(cfPtr->cmdObj);
+ }
+ return cfPtr->cmdObj;
+}
+
+void
+TclGetSrcInfoForPc(
+ CmdFrame *cfPtr)
+{
+ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+ assert(cfPtr->type == TCL_LOCATION_BC);
+
+ if (cfPtr->cmd == NULL) {
+
+ cfPtr->cmd = GetSrcInfoForPc(
+ (unsigned char *) cfPtr->data.tebc.pc, codePtr,
+ &cfPtr->len, NULL, NULL);
+ }
+
+ if (cfPtr->cmd != NULL) {
+ /*
+ * We now have the command. We can get the srcOffset back and from
+ * there find the list of word locations for this command.
+ */
+
+ ExtCmdLoc *eclPtr;
+ ECL *locPtr = NULL;
+ int srcOffset, i;
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Tcl_HashEntry *hePtr =
+ Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
+
+ if (!hePtr) {
+ return;
+ }
+
+ srcOffset = cfPtr->cmd - codePtr->source;
+ eclPtr = Tcl_GetHashValue(hePtr);
+
+ for (i=0; i < eclPtr->nuloc; i++) {
+ if (eclPtr->loc[i].srcOffset == srcOffset) {
+ locPtr = eclPtr->loc+i;
+ break;
+ }
+ }
+ if (locPtr == NULL) {
+ Tcl_Panic("LocSearch failure");
+ }
+
+ cfPtr->line = locPtr->line;
+ cfPtr->nline = locPtr->nline;
+ cfPtr->type = eclPtr->type;
+
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ cfPtr->data.eval.path = eclPtr->path;
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
+ }
+
+ /*
+ * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for
+ * cfPtr->data.tebc.codePtr.
+ */
+ }
+}
+
+static const char *
+GetSrcInfoForPc(
+ 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. */
- ByteCode *codePtr; /* The bytecode sequence in which to look up
+ * 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. */
+ int *cmdIdxPtr) /* If non-NULL, the location where the index
+ * of the command containing the pc should
+ * be stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
int numCmds = codePtr->numCommands;
@@ -5878,8 +9841,10 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
+ int bestCmdIdx = -1;
if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+ if (pcBeg != NULL) *pcBeg = NULL;
return NULL;
}
@@ -5891,11 +9856,11 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
codeDeltaNext = codePtr->codeDeltaStart;
codeLengthNext = codePtr->codeLengthStart;
- srcDeltaNext = codePtr->srcDeltaStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
srcLengthNext = codePtr->srcLengthStart;
codeOffset = srcOffset = 0;
for (i = 0; i < numCmds; i++) {
- if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
@@ -5905,7 +9870,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
}
codeOffset += delta;
- if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
codeLengthNext++;
codeLen = TclGetInt4AtPtr(codeLengthNext);
codeLengthNext += 4;
@@ -5915,7 +9880,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
}
codeEnd = (codeOffset + codeLen - 1);
- if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
srcDeltaNext++;
delta = TclGetInt4AtPtr(srcDeltaNext);
srcDeltaNext += 4;
@@ -5925,7 +9890,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
}
srcOffset += delta;
- if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
srcLengthNext++;
srcLen = TclGetInt4AtPtr(srcLengthNext);
srcLengthNext += 4;
@@ -5934,18 +9899,38 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
srcLengthNext++;
}
- if (codeOffset > pcOffset) { /* best cmd already found */
+ if (codeOffset > pcOffset) { /* Best cmd already found */
break;
- } else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
+ }
+ if (pcOffset <= codeEnd) { /* This cmd's code encloses pc */
int dist = (pcOffset - codeOffset);
+
if (dist <= bestDist) {
bestDist = dist;
bestSrcOffset = srcOffset;
bestSrcLength = srcLen;
+ bestCmdIdx = i;
}
}
}
+ 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;
}
@@ -5953,6 +9938,11 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
if (lengthPtr != NULL) {
*lengthPtr = bestSrcLength;
}
+
+ if (cmdIdxPtr != NULL) {
+ *cmdIdxPtr = bestCmdIdx;
+ }
+
return (codePtr->source + bestSrcOffset);
}
@@ -5981,22 +9971,22 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
*/
static ExceptionRange *
-GetExceptRangeForPc(pc, catchOnly, codePtr)
- unsigned char *pc; /* The program counter value for which to
+GetExceptRangeForPc(
+ const unsigned char *pc, /* The program counter value for which to
* search for a closest enclosing exception
* range. This points to a bytecode
* instruction in codePtr's code. */
- int catchOnly; /* If 0, consider either loop or catch
+ int catchOnly, /* If 0, consider either loop or catch
* ExceptionRanges in search. If nonzero
* consider only catch ranges (and ignore any
* closer loop ranges). */
- ByteCode* codePtr; /* Points to the ByteCode in which to search
+ ByteCode *codePtr) /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
ExceptionRange *rangeArrayPtr;
int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
- int pcOffset = (pc - codePtr->codeStart);
+ int pcOffset = pc - codePtr->codeStart;
register int start;
if (numRanges == 0) {
@@ -6030,7 +10020,7 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
* GetOpcodeName --
*
* This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
- * in TclExecuteByteCode when debugging. It returns the name of the
+ * in TclNRExecuteByteCode when debugging. It returns the name of the
* bytecode instruction at a specified instruction pc.
*
* Results:
@@ -6043,9 +10033,9 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
*/
#ifdef TCL_COMPILE_DEBUG
-static char *
-GetOpcodeName(pc)
- unsigned char *pc; /* Points to the instruction whose name should
+static const char *
+GetOpcodeName(
+ const unsigned char *pc) /* Points to the instruction whose name should
* be returned. */
{
unsigned char opCode = *pc;
@@ -6072,33 +10062,33 @@ GetOpcodeName(pc)
*/
void
-TclExprFloatError(interp, value)
- Tcl_Interp *interp; /* Where to store error message. */
- double value; /* Value returned after error; used to
+TclExprFloatError(
+ Tcl_Interp *interp, /* Where to store error message. */
+ double value) /* Value returned after error; used to
* distinguish underflows from overflows. */
{
- CONST char *s;
+ const char *s;
- if ((errno == EDOM) || IS_NAN(value)) {
+ if ((errno == EDOM) || TclIsNaN(value)) {
s = "domain error: argument not in valid range";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
- } else if ((errno == ERANGE) || IS_INF(value)) {
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
+ } else if ((errno == ERANGE) || TclIsInfinite(value)) {
if (value == 0.0) {
s = "floating-point value too small to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
} else {
s = "floating-point value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
}
} else {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_Obj *objPtr = Tcl_ObjPrintf(
"unknown floating-point error, errno = %d", errno);
- Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
- Tcl_GetString(objPtr), (char *) NULL);
+
+ Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
+ Tcl_GetString(objPtr), NULL);
Tcl_SetObjResult(interp, objPtr);
}
}
@@ -6123,8 +10113,8 @@ TclExprFloatError(interp, value)
*/
int
-TclLog2(value)
- register int value; /* The integer for which to compute the log
+TclLog2(
+ register int value) /* The integer for which to compute the log
* base 2. */
{
register int n = value;
@@ -6155,15 +10145,15 @@ TclLog2(value)
*/
static int
-EvalStatsCmd(unused, interp, objc, objv)
- ClientData unused; /* Unused. */
- Tcl_Interp *interp; /* The current interpreter. */
- int objc; /* The number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument strings. */
+EvalStatsCmd(
+ ClientData unused, /* Unused. */
+ Tcl_Interp *interp, /* The current interpreter. */
+ int objc, /* The number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
- LiteralTable *globalTablePtr = &(iPtr->literalTable);
- ByteCodeStats *statsPtr = &(iPtr->stats);
+ LiteralTable *globalTablePtr = &iPtr->literalTable;
+ ByteCodeStats *statsPtr = &iPtr->stats;
double totalCodeBytes, currentCodeBytes;
double totalLiteralBytes, currentLiteralBytes;
double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
@@ -6175,6 +10165,12 @@ EvalStatsCmd(unused, interp, objc, objv)
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++) {
@@ -6193,7 +10189,7 @@ EvalStatsCmd(unused, interp, objc, objv)
numCurrentByteCodes =
statsPtr->numCompilations - statsPtr->numByteCodesFreed;
currentHeaderBytes = numCurrentByteCodes
- * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time)));
+ * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time));
literalMgmtBytes = sizeof(LiteralTable)
+ (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
+ (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
@@ -6206,65 +10202,65 @@ EvalStatsCmd(unused, interp, objc, objv)
* Summary statistics, total and current source and ByteCode sizes.
*/
- fprintf(stdout, "\n----------------------------------------------------------------\n");
- fprintf(stdout,
- "Compilation and execution statistics for interpreter 0x%x\n",
- (unsigned int) 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 %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n",
statsPtr->numExecutions);
- fprintf(stdout, "Number ByteCodes compiled %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Mean executions/compile %.1f\n",
- ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
+ Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n",
+ statsPtr->numExecutions / (float)statsPtr->numCompilations);
- fprintf(stdout, "\nInstructions executed %.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
numInstructions);
- fprintf(stdout, " Mean inst/compile %.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/compile\t\t%.0f\n",
numInstructions / statsPtr->numCompilations);
- fprintf(stdout, " Mean inst/execution %.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n",
numInstructions / statsPtr->numExecutions);
- fprintf(stdout, "\nTotal ByteCodes %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Source bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->totalSrcBytes);
- fprintf(stdout, " Code bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
totalCodeBytes);
- fprintf(stdout, " ByteCode bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->totalByteCodeBytes);
- fprintf(stdout, " Literal bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
totalLiteralBytes);
- fprintf(stdout, " table %d + bkts %d + entries %ld + objects %ld + strings %.6g\n",
- sizeof(LiteralTable),
- iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
- statsPtr->numLiteralsCreated * sizeof(LiteralEntry),
- statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
+ 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 %.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n",
totalCodeBytes / statsPtr->numCompilations);
- fprintf(stdout, " Mean code/source %.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
totalCodeBytes / statsPtr->totalSrcBytes);
- fprintf(stdout, "\nCurrent (active) ByteCodes %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
numCurrentByteCodes);
- fprintf(stdout, " Source bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->currentSrcBytes);
- fprintf(stdout, " Code bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
currentCodeBytes);
- fprintf(stdout, " ByteCode bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->currentByteCodeBytes);
- fprintf(stdout, " Literal bytes %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
- sizeof(LiteralTable),
- iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
- iPtr->literalTable.numEntries * sizeof(LiteralEntry),
- iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+ 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 %.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
currentCodeBytes / statsPtr->currentSrcBytes);
- fprintf(stdout, " Code + source bytes %.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);
@@ -6276,18 +10272,18 @@ EvalStatsCmd(unused, interp, objc, objv)
*/
numSharedMultX = 0;
- fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
- fprintf(stdout, " Object had refcount <=1 (not shared) %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 %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n",
i, tclObjsShared[i]);
numSharedMultX += tclObjsShared[i];
}
- fprintf(stdout, " refcount >=%d %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n",
i, tclObjsShared[0]);
numSharedMultX += tclObjsShared[0];
- fprintf(stdout, " Total shared objects %d\n",
+ Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n",
numSharedMultX);
/*
@@ -6297,11 +10293,11 @@ EvalStatsCmd(unused, interp, objc, objv)
numByteCodeLits = 0;
refCountSum = 0;
numSharedMultX = 0;
- numSharedOnce = 0;
- objBytesIfUnshared = 0.0;
- strBytesIfUnshared = 0.0;
+ numSharedOnce = 0;
+ objBytesIfUnshared = 0.0;
+ strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
- strBytesSharedOnce = 0.0;
+ strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
@@ -6324,93 +10320,93 @@ EvalStatsCmd(unused, interp, objc, objv)
sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
- currentLiteralBytes;
- fprintf(stdout, "\nTotal objects (all interps) %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
tclObjsAlloced);
- fprintf(stdout, "Current objects %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
(tclObjsAlloced - tclObjsFreed));
- fprintf(stdout, "Total literal objects %ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n",
statsPtr->numLiteralsCreated);
- fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
- (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
- fprintf(stdout, " ByteCode literals %ld (%0.1f%% of current literals)\n",
+ Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
numByteCodeLits,
- (numByteCodeLits * 100.0) / globalTablePtr->numEntries);
- fprintf(stdout, " Literals reused > 1x %d\n",
+ Percent(numByteCodeLits, globalTablePtr->numEntries));
+ Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n",
numSharedMultX);
- fprintf(stdout, " Mean reference count %.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n",
((double) refCountSum) / globalTablePtr->numEntries);
- fprintf(stdout, " Mean len, str reused >1x %.2f\n",
- (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0));
- fprintf(stdout, " Mean len, str used 1x %.2f\n",
- (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0));
- fprintf(stdout, " Total sharing savings %.6g (%0.1f%% of bytes if no sharing)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str reused >1x \t%.2f\n",
+ (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str used 1x\t\t%.2f\n",
+ (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
+ Tcl_AppendPrintfToObj(objPtr, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
sharingBytesSaved,
- (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared));
- fprintf(stdout, " Bytes with sharing %.6g\n",
+ Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
+ Tcl_AppendPrintfToObj(objPtr, " Bytes with sharing\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
- sizeof(LiteralTable),
- iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
- iPtr->literalTable.numEntries * sizeof(LiteralEntry),
- iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+ 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 %.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 %.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 %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,
- (literalMgmtBytes * 100.0) / currentLiteralBytes);
- fprintf(stdout, " table %d + buckets %d + entries %d\n",
- sizeof(LiteralTable),
- iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
- iPtr->literalTable.numEntries * sizeof(LiteralEntry));
+ Percent(literalMgmtBytes, currentLiteralBytes));
+ 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)));
/*
* 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,
- ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ 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,
- ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ 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,
- ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ 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,
- ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ 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,
- ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ 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,
- ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentCmdMapBytes / numCurrentByteCodes);
/*
* Detailed literal statistics.
*/
- fprintf(stdout, "\nLiteral string sizes:\n");
- fprintf(stdout, " Up to length Percentage\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) {
@@ -6422,21 +10418,21 @@ EvalStatsCmd(unused, interp, objc, objv)
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
- decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
+ 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, " Up to size Percentage\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) {
@@ -6454,12 +10450,12 @@ EvalStatsCmd(unused, interp, objc, objv)
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
- decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
+ decadeHigh, Percent(sum, statsPtr->numCompilations));
}
- fprintf(stdout, "\nByteCode sizes:\n");
- fprintf(stdout, " Up to size Percentage\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) {
@@ -6477,12 +10473,12 @@ EvalStatsCmd(unused, interp, objc, objv)
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
- decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
+ 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, " Up to ms Percentage\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) {
@@ -6500,37 +10496,54 @@ EvalStatsCmd(unused, interp, objc, objv)
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
- fprintf(stdout, " %12.3f %8.0f%%\n",
- decadeHigh / 1000.0,
- (sum * 100.0) / statsPtr->numByteCodesFreed);
+ Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
+ decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
}
/*
* Instruction counts.
*/
- fprintf(stdout, "\nInstruction counts:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
+ Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
+ tclInstructionTable[i].name, statsPtr->instructionCount[i]);
if (statsPtr->instructionCount[i]) {
- fprintf(stdout, "%20s %8ld %6.1f%%\n",
- tclInstructionTable[i].name,
- statsPtr->instructionCount[i],
- (statsPtr->instructionCount[i]*100.0) / 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);
+ Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
+ Percent(statsPtr->instructionCount[i], numInstructions));
+ } 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 */
@@ -6546,10 +10559,10 @@ EvalStatsCmd(unused, interp, objc, objv)
*
* Results:
* If the result code is one of the standard Tcl return codes, the result
- * is a string representing that code such as "TCL_ERROR". Otherwise,
- * the result string is that code formatted as a sequence of decimal
- * digit characters. Note that the resulting string must not be modified
- * by the caller.
+ * is a string representing that code such as "TCL_ERROR". Otherwise, the
+ * result string is that code formatted as a sequence of decimal digit
+ * characters. Note that the resulting string must not be modified by the
+ * caller.
*
* Side effects:
* None.
@@ -6557,9 +10570,9 @@ EvalStatsCmd(unused, interp, objc, objv)
*----------------------------------------------------------------------
*/
-static char *
-StringForResultCode(result)
- int result; /* The Tcl result code for which to generate a
+static const char *
+StringForResultCode(
+ int result) /* The Tcl result code for which to generate a
* string. */
{
static char buf[TCL_INTEGER_SPACE];
@@ -6573,136 +10586,9 @@ StringForResultCode(result)
#endif /* TCL_COMPILE_DEBUG */
/*
- *----------------------------------------------------------------------
- *
- * ExponWide --
- *
- * Procedure to return w**w2 as wide integer
- *
- * Results:
- * Return value is w to the power w2, unless the computation makes no
- * sense mathematically. In that case *errExpon is set to 1.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_WideInt
-ExponWide(w, w2, errExpon)
- Tcl_WideInt w; /* The value that must be exponentiated */
- Tcl_WideInt w2; /* The exponent */
- int *errExpon; /* Error code */
-{
- Tcl_WideInt result;
-
- *errExpon = 0;
-
- /*
- * Check for possible errors and simple/edge cases
- */
-
- if (w == 0) {
- if (w2 < 0) {
- *errExpon = 1;
- return W0;
- } else if (w2 > 0) {
- return W0;
- }
- return Tcl_LongAsWide(1); /* By definition and analysis */
- } else if (w < -1) {
- if (w2 < 0) {
- return W0;
- } else if (w2 == 0) {
- return Tcl_LongAsWide(1);
- }
- } else if (w == -1) {
- return (w2 & 1) ? Tcl_LongAsWide(-1) : Tcl_LongAsWide(1);
- } else if ((w == 1) || (w2 == 0)) {
- return Tcl_LongAsWide(1);
- } else if (w>1 && w2<0) {
- return W0;
- }
-
- /*
- * The general case.
- */
-
- result = Tcl_LongAsWide(1);
- for (; w2>Tcl_LongAsWide(1) ; w*=w,w2/=2) {
- if (w2 & 1) {
- result *= w;
- }
- }
- return result * w;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExponLong --
- *
- * Procedure to return i**i2 as long integer
- *
- * Results:
- * Return value is i to the power i2, unless the computation makes no
- * sense mathematically. In that case *errExpon is set to 1.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
*/
-
-static long
-ExponLong(i, i2, errExpon)
- long i; /* The value that must be exponentiated */
- long i2; /* The exponent */
- int *errExpon; /* Error code */
-{
- long result;
-
- *errExpon = 0;
-
- /*
- * Check for possible errors and simple cases
- */
-
- if (i == 0) {
- if (i2 < 0) {
- *errExpon = 1;
- return 0L;
- } else if (i2 > 0) {
- return 0L;
- }
- /*
- * By definition and analysis, 0**0 is 1.
- */
- return 1L;
- } else if (i < -1) {
- if (i2 < 0) {
- return 0L;
- } else if (i2 == 0) {
- return 1L;
- }
- } else if (i == -1) {
- return (i2&1) ? -1L : 1L;
- } else if ((i == 1) || (i2 == 0)) {
- return 1L;
- } else if (i > 1 && i2 < 0) {
- return 0L;
- }
-
- /*
- * The general case
- */
-
- result = 1;
- for (; i2>1 ; i*=i,i2/=2) {
- if (i2 & 1) {
- result *= i;
- }
- }
- return result * i;
-}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 3c79e85..6452fff 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -8,25 +8,23 @@
*
* 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.35 2005/07/24 22:56:43 dkf Exp $
*/
#include "tclInt.h"
+#include "tclFileSystem.h"
/*
* Declarations for local functions defined in this file:
*/
-static int CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
+static int CopyRenameOneFile(Tcl_Interp *interp,
Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
- int copyFlag, int force));
-static Tcl_Obj * FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr));
-static int FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int copyFlag));
-static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int *forcePtr));
+ int copyFlag, int force);
+static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static int FileCopyRename(Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[], int copyFlag);
+static int FileForceOption(Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[], int *forcePtr);
/*
*---------------------------------------------------------------------------
@@ -48,10 +46,12 @@ static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
*/
int
-TclFileRenameCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Interp for error reporting. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+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. */
+ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 0);
}
@@ -75,10 +75,12 @@ TclFileRenameCmd(interp, objc, objv)
*/
int
-TclFileCopyCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+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. */
+ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 1);
}
@@ -101,34 +103,31 @@ TclFileCopyCmd(interp, objc, objv)
*/
static int
-FileCopyRename(interp, objc, objv, copyFlag)
- Tcl_Interp *interp; /* Used for error reporting. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
- int copyFlag; /* If non-zero, copy source(s). Otherwise,
+FileCopyRename(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument strings passed to Tcl_FileCmd. */
+ int copyFlag) /* If non-zero, copy source(s). Otherwise,
* rename them. */
{
int i, result, force;
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]),
- " ?options? source ?source ...? target\"",
- (char *) 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,10 +147,9 @@ FileCopyRename(interp, objc, objv, copyFlag)
if ((objc - i) > 2) {
errno = ENOTDIR;
Tcl_PosixError(interp);
- Tcl_AppendResult(interp, "error ",
- ((copyFlag) ? "copying" : "renaming"), ": target \"",
- TclGetString(target), "\" is not a directory",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error %s: target \"%s\" is not a directory",
+ (copyFlag?"copying":"renaming"), TclGetString(target)));
result = TCL_ERROR;
} else {
/*
@@ -174,7 +172,6 @@ FileCopyRename(interp, objc, objv, copyFlag)
for ( ; i<objc-1 ; i++) {
Tcl_Obj *jargv[2];
Tcl_Obj *source, *newFileName;
- Tcl_Obj *temp;
source = FileBasename(interp, objv[i]);
if (source == NULL) {
@@ -183,13 +180,11 @@ FileCopyRename(interp, objc, objv, copyFlag)
}
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) {
@@ -216,28 +211,28 @@ FileCopyRename(interp, objc, objv, copyFlag)
*
*----------------------------------------------------------------------
*/
+
int
-TclFileMakeDirsCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting. */
- int objc; /* Number of arguments */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+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(interp, objc, objv)
* 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,9 +299,9 @@ TclFileMakeDirsCmd(interp, objc, objv)
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp, "can't create directory \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create directory \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
result = TCL_ERROR;
}
if (split != NULL) {
@@ -338,31 +331,25 @@ TclFileMakeDirsCmd(interp, objc, objv)
*/
int
-TclFileDeleteCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting */
- int objc; /* Number of arguments */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+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. */
{
int i, force, result;
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;
- if ((objc - i) < 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- TclGetString(objv[0]), " ", TclGetString(objv[1]),
- " ?options? file ?file ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
errfile = NULL;
result = TCL_OK;
- for ( ; i < objc; i++) {
+ for (i++ ; i < objc; i++) {
Tcl_StatBuf statBuf;
errfile = objv[i];
@@ -393,9 +380,9 @@ TclFileDeleteCmd(interp, objc, objv)
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",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": directory not empty",
+ TclGetString(objv[i])));
Tcl_PosixError(interp);
goto done;
}
@@ -435,12 +422,13 @@ TclFileDeleteCmd(interp, objc, objv)
* We try to accomodate poor error results from our Tcl_FS calls.
*/
- Tcl_AppendResult(interp, "error deleting unknown file: ",
- Tcl_PosixError(interp), (char *) 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),
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
}
}
@@ -471,15 +459,15 @@ TclFileDeleteCmd(interp, objc, objv)
*/
static int
-CopyRenameOneFile(interp, source, target, copyFlag, force)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *source; /* Pathname of file to copy. May need to be
+CopyRenameOneFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *source, /* Pathname of file to copy. May need to be
* translated. */
- Tcl_Obj *target; /* Pathname of file to create/overwrite. May
+ Tcl_Obj *target, /* Pathname of file to create/overwrite. May
* need to be translated. */
- int copyFlag; /* If non-zero, copy files. Otherwise, rename
+ int copyFlag, /* If non-zero, copy files. Otherwise, rename
* them. */
- int force; /* If non-zero, overwrite target file if it
+ int force) /* If non-zero, overwrite target file if it
* exists. Otherwise, error if target already
* exists. */
{
@@ -523,12 +511,13 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
}
/*
- * Prevent copying or renaming a file onto itself. Under Windows, stat
- * always returns 0 for st_ino. However, the Windows-specific code
- * knows how to deal with copying or renaming a file on top of itself.
- * It might be a good idea to write a stat that worked.
+ * Prevent copying or renaming a file onto itself. On Windows since
+ * 8.5 we do get an inode number, however the unsigned short field is
+ * insufficient to accept the Win32 API file id so it is truncated to
+ * 16 bits and we get collisions. See bug #2015723.
*/
+#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)) {
@@ -536,6 +525,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
goto done;
}
}
+#endif
/*
* Prevent copying/renaming a file onto a directory and vice-versa.
@@ -547,17 +537,17 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
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), "\"", (char *) 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), "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't overwrite directory \"%s\" with file \"%s\"",
+ TclGetString(target), TclGetString(source)));
goto done;
}
@@ -569,8 +559,10 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
{
- Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
+ Tcl_Obj *perm;
int index;
+
+ TclNewLiteralStringObj(perm, "u+w");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, target, perm);
@@ -586,10 +578,10 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
}
if (errno == EINVAL) {
- Tcl_AppendResult(interp, "error renaming \"",
- TclGetString(source), "\" to \"", TclGetString(target),
- "\": trying to rename a volume or ",
- "move a directory into itself", (char *) 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;
@@ -633,9 +625,9 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* Actual file doesn't exist.
*/
- Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
- "\": the target of this link doesn't exist",
- (char *) 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;
@@ -682,7 +674,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
/* Now 'actualSource' is the correct file */
}
}
-#endif
+#endif /* S_ISLNK */
#endif
if (S_ISDIR(sourceStatBuf.st_mode)) {
@@ -694,19 +686,20 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* cross-filesystem copy. We do this through our Tcl library.
*/
- Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
- Tcl_IncrRefCount(copyCommand);
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("::tcl::CopyDirectory",-1));
+ Tcl_Obj *copyCommand, *cmdObj, *opObj;
+
+ TclNewObj(copyCommand);
+ TclNewLiteralStringObj(cmdObj, "::tcl::CopyDirectory");
+ Tcl_ListObjAppendElement(interp, copyCommand, cmdObj);
if (copyFlag) {
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("copying",-1));
+ TclNewLiteralStringObj(opObj, "copying");
} else {
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("renaming",-1));
+ TclNewLiteralStringObj(opObj, "renaming");
}
+ Tcl_ListObjAppendElement(interp, copyCommand, opObj);
Tcl_ListObjAppendElement(interp, copyCommand, source);
Tcl_ListObjAppendElement(interp, copyCommand, target);
+ Tcl_IncrRefCount(copyCommand);
result = Tcl_EvalObjEx(interp, copyCommand,
TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
Tcl_DecrRefCount(copyCommand);
@@ -741,22 +734,20 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
errfile = target;
-
- /*
- * We now need to reset the result, because the above call, if it
- * failed, may have put an error message in place. (Ideally we
- * would prefer not to pass an interpreter in above, but the
- * channel IO code used by TclCrossFilesystemCopy currently
- * requires one).
- */
-
- Tcl_ResetResult(interp);
}
+ /*
+ * We now need to reset the result, because the above call,
+ * may have left set it. (Ideally we would prefer not to pass
+ * an interpreter in above, but the channel IO code used by
+ * TclCrossFilesystemCopy currently requires one)
+ */
+ Tcl_ResetResult(interp);
}
if ((copyFlag == 0) && (result == TCL_OK)) {
if (S_ISDIR(sourceStatBuf.st_mode)) {
result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
if (result != TCL_OK) {
+ errfile = errorBuffer;
if (Tcl_FSEqualPaths(errfile, source) == 0) {
errfile = source;
}
@@ -768,27 +759,27 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
}
}
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
- "\": ", Tcl_PosixError(interp), (char *) 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,
- ((copyFlag) ? "error copying \"" : "error renaming \""),
- TclGetString(source), (char *) NULL);
+ Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
+ (copyFlag ? "copying" : "renaming"), TclGetString(source));
+
if (errfile != source) {
- Tcl_AppendResult(interp, "\" to \"", TclGetString(target),
- (char *) NULL);
+ Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
+ TclGetString(target));
if (errfile != target) {
- Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),
- (char *) NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
+ TclGetString(errfile));
}
}
- Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
+ Tcl_SetObjResult(interp, errorMsg);
}
if (errorBuffer != NULL) {
Tcl_DecrRefCount(errorBuffer);
@@ -819,30 +810,33 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
static int
-FileForceOption(interp, objc, objv, forcePtr)
- Tcl_Interp *interp; /* Interp, for error return. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. First command line
+FileForceOption(
+ Tcl_Interp *interp, /* Interp, for error return. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument strings. First command line
* option, if it exists, begins at 0. */
- int *forcePtr; /* If the "-force" was specified, *forcePtr is
+ 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 --", (char *)NULL);
- return -1;
}
}
*forcePtr = force;
@@ -869,9 +863,9 @@ FileForceOption(interp, objc, objv, forcePtr)
*/
static Tcl_Obj *
-FileBasename(interp, pathPtr)
- Tcl_Interp *interp; /* Interp, for error return. */
- Tcl_Obj *pathPtr; /* Path whose basename to extract. */
+FileBasename(
+ Tcl_Interp *interp, /* Interp, for error return. */
+ Tcl_Obj *pathPtr) /* Path whose basename to extract. */
{
int objc;
Tcl_Obj *splitPtr;
@@ -923,13 +917,13 @@ FileBasename(interp, pathPtr)
* Tcl_Interp *interp; The interp to report errors with. Since
* this is an object-based API, the object
* form of the result should be used.
- * CONST char *fileName; This is extracted using
+ * const char *fileName; This is extracted using
* Tcl_TranslateFileName.
* TclObj **attrObjPtrPtr; A new object to hold the attribute is
* allocated and put here.
* The first two parameters of the callback used to write out the
* attributes are the same. The third parameter is:
- * CONST *attrObjPtr; A pointer to the object that has the new
+ * const *attrObjPtr; A pointer to the object that has the new
* attribute.
* They both return standard TCL errors; if the routine to get an
* attribute fails, no object is allocated and *attrObjPtrPtr is
@@ -945,33 +939,38 @@ FileBasename(interp, pathPtr)
*/
int
-TclFileAttrsCmd(interp, objc, objv)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int objc; /* Number of command line arguments. */
- Tcl_Obj *CONST objv[]; /* The command line objects. */
+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. */
{
int result;
- CONST char ** attributeStrings;
- Tcl_Obj* objStrings = NULL;
+ const char *const *attributeStrings;
+ const char **attributeStringsAllocated = NULL;
+ Tcl_Obj *objStrings = NULL;
int numObjStrings = -1;
Tcl_Obj *filePtr;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "name ?option? ?value? ?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;
+ 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;
@@ -983,12 +982,12 @@ TclFileAttrsCmd(interp, objc, objv)
* 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),
- (char *) NULL);
- return TCL_ERROR;
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(filePtr), Tcl_PosixError(interp)));
}
- goto end;
+ return TCL_ERROR;
}
/*
@@ -1004,14 +1003,24 @@ TclFileAttrsCmd(interp, objc, objv)
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
- attributeStrings = (CONST char **)
- ckalloc((1+numObjStrings) * sizeof(char*));
+ attributeStringsAllocated = (const char **)
+ TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
for (index = 0; index < numObjStrings; index++) {
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
- attributeStrings[index] = TclGetString(objPtr);
+ attributeStringsAllocated[index] = TclGetString(objPtr);
}
- attributeStrings[index] = NULL;
+ 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.
@@ -1052,7 +1061,7 @@ TclFileAttrsCmd(interp, objc, objv)
goto end;
}
- Tcl_SetObjResult(interp, listPtr);
+ Tcl_SetObjResult(interp, listPtr);
} else if (objc == 1) {
/*
* Get one attribute.
@@ -1062,9 +1071,10 @@ TclFileAttrsCmd(interp, objc, objv)
Tcl_Obj *objPtr = NULL;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- (char *) 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;
}
@@ -1072,6 +1082,9 @@ TclFileAttrsCmd(interp, objc, objv)
"option", 0, &index) != TCL_OK) {
goto end;
}
+ if (attributeStringsAllocated != NULL) {
+ TclFreeIntRep(objv[0]);
+ }
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
@@ -1085,47 +1098,410 @@ TclFileAttrsCmd(interp, objc, objv)
int i, index;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- (char *) 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;
}
- for (i = 0; i < objc ; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
+ for (i = 0; i < objc ; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
"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", (char *) 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,
- objv[i + 1]) != TCL_OK) {
+ if (Tcl_FSFileAttrsSet(interp, index, filePtr,
+ objv[i + 1]) != TCL_OK) {
goto end;
- }
- }
+ }
+ }
}
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 (numObjStrings != -1) {
+ 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;
+ }
+
+ /*
+ * Create link from source to target.
+ */
+
+ 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;
+ }
+
+ /*
+ * Read link
+ */
+
+ 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;
+ }
+ }
+ 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);
+
/*
- * Free up the array we allocated.
+ * Treat an empty string as if it wasn't there.
*/
- ckfree((char*)attributeStrings);
+ if (length == 0) {
+ goto makeTemporary;
+ }
/*
- * We don't need this object that was passed to us any more.
+ * The template only gives a directory if there is a directory
+ * separator in it.
*/
- if (objStrings != NULL) {
- Tcl_DecrRefCount(objStrings);
+ 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);
+ }
}
}
- return result;
+
+ /*
+ * 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 0bf1754..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.71 2005/07/17 21:17:40 dkf Exp $
*/
#include "tclInt.h"
@@ -28,18 +26,57 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
* Prototypes for local procedures defined in this file:
*/
-static CONST char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *user, Tcl_DString *resultPtr));
-static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
+static const char * DoTildeSubst(Tcl_Interp *interp,
+ const char *user, Tcl_DString *resultPtr);
+static const char * ExtractWinRoot(const char *path,
Tcl_DString *resultPtr, int offset,
- Tcl_PathType *typePtr));
-static int SkipToChar _ANSI_ARGS_((char **stringPtr, int match));
-static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path));
-static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path));
-static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *resultPtr, char *separators,
- Tcl_Obj *pathPtr, int flags, char *pattern,
- Tcl_GlobTypeData *types));
+ Tcl_PathType *typePtr);
+static int SkipToChar(char **stringPtr, int match);
+static Tcl_Obj * SplitWinPath(const char *path);
+static Tcl_Obj * SplitUnixPath(const char *path);
+static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
+ const char *separators, Tcl_Obj *pathPtr, int flags,
+ char *pattern, Tcl_GlobTypeData *types);
+
+/*
+ * When there is no support for getting the block size of a file in a stat()
+ * call, use this as a guess. Allow it to be overridden in the platform-
+ * specific files.
+ */
+
+#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE))
+#define GUESSED_BLOCK_SIZE 1024
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetResultLength --
+ *
+ * Resets the result DString for ExtractWinRoot to accommodate
+ * any NT extended path prefixes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May modify the Tcl_DString.
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetResultLength(
+ Tcl_DString *resultPtr,
+ int offset,
+ int extended)
+{
+ Tcl_DStringSetLength(resultPtr, offset);
+ if (extended == 2) {
+ TclDStringAppendLiteral(resultPtr, "//?/UNC/");
+ } else if (extended == 1) {
+ TclDStringAppendLiteral(resultPtr, "//?/");
+ }
+}
/*
*----------------------------------------------------------------------
@@ -51,7 +88,7 @@ static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp,
*
* Results:
* Returns the position in the path immediately after the root including
- * any trailing slashes. Appends a cleaned up version of the root to the
+ * any trailing slashes. Appends a cleaned up version of the root to the
* Tcl_DString at the specified offest.
*
* Side effects:
@@ -60,26 +97,41 @@ static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp,
*----------------------------------------------------------------------
*/
-static CONST char *
-ExtractWinRoot(path, resultPtr, offset, typePtr)
- CONST char *path; /* Path to parse. */
- Tcl_DString *resultPtr; /* Buffer to hold result. */
- int offset; /* Offset in buffer where result should be
+static const char *
+ExtractWinRoot(
+ const char *path, /* Path to parse. */
+ Tcl_DString *resultPtr, /* Buffer to hold result. */
+ int offset, /* Offset in buffer where result should be
* stored. */
- Tcl_PathType *typePtr; /* Where to store pathType result */
+ Tcl_PathType *typePtr) /* Where to store pathType result */
{
+ int extended = 0;
+
+ if ( (path[0] == '/' || path[0] == '\\')
+ && (path[1] == '/' || path[1] == '\\')
+ && (path[2] == '?')
+ && (path[3] == '/' || path[3] == '\\')) {
+ extended = 1;
+ path = path + 4;
+ if (path[0] == 'U' && path[1] == 'N' && path[2] == 'C'
+ && (path[3] == '/' || path[3] == '\\')) {
+ extended = 2;
+ path = path + 4;
+ }
+ }
+
if (path[0] == '/' || path[0] == '\\') {
/*
* Might be a UNC or Vol-Relative path.
*/
- CONST char *host, *share, *tail;
+ const char *host, *share, *tail;
int hlen, slen;
if (path[1] != '/' && path[1] != '\\') {
- Tcl_DStringSetLength(resultPtr, offset);
+ SetResultLength(resultPtr, offset, extended);
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[1];
}
host = &path[2];
@@ -100,19 +152,19 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
if (host[hlen] == 0 || host[hlen+1] == 0) {
/*
* The path given is simply of the form '/foo', '//foo',
- * '/////foo' or the same with backslashes. If there is exactly
+ * '/////foo' or the same with backslashes. If there is exactly
* one leading '/' the path is volume relative (see filename man
- * page). If there are more than one, we are simply assuming they
- * are superfluous and we trim them away. (An alternative
+ * page). If there are more than one, we are simply assuming they
+ * are superfluous and we trim them away. (An alternative
* interpretation would be that it is a host name, but we have
* been documented that that is not the case).
*/
*typePtr = TCL_PATH_VOLUME_RELATIVE;
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return &path[2];
}
- Tcl_DStringSetLength(resultPtr, offset);
+ SetResultLength(resultPtr, offset, extended);
share = &host[hlen];
/*
@@ -128,9 +180,9 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
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];
@@ -150,14 +202,14 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
* Might be a drive separator.
*/
- Tcl_DStringSetLength(resultPtr, offset);
+ SetResultLength(resultPtr, offset, extended);
if (path[2] != '/' && path[2] != '\\') {
*typePtr = TCL_PATH_VOLUME_RELATIVE;
Tcl_DStringAppend(resultPtr, path, 2);
return &path[2];
} else {
- char *tail = (char*)&path[3];
+ const char *tail = &path[3];
/*
* Skip separators.
@@ -169,7 +221,7 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
*typePtr = TCL_PATH_ABSOLUTE;
Tcl_DStringAppend(resultPtr, path, 2);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ TclDStringAppendLiteral(resultPtr, "/");
return tail;
}
@@ -249,7 +301,7 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
if (abs != 0) {
*typePtr = TCL_PATH_ABSOLUTE;
- Tcl_DStringSetLength(resultPtr, offset);
+ SetResultLength(resultPtr, offset, extended);
Tcl_DStringAppend(resultPtr, path, abs);
return path + abs;
}
@@ -286,8 +338,8 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
*/
Tcl_PathType
-Tcl_GetPathType(path)
- CONST char *path;
+Tcl_GetPathType(
+ const char *path)
{
Tcl_PathType type;
Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
@@ -307,11 +359,11 @@ Tcl_GetPathType(path)
* relative to the current volume, or absolute, but ONLY FOR THE NATIVE
* FILESYSTEM. This function is called from tclIOUtil.c (but needs to be
* here due to its dependence on static variables/functions in this
- * file). The exported function Tcl_FSGetPathType should be used by
+ * file). The exported function Tcl_FSGetPathType should be used by
* extensions.
*
* Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even
- * though expanding the '~' could lead to any possible path type. This
+ * though expanding the '~' could lead to any possible path type. This
* function should therefore be considered a low-level, string
* manipulation function only -- it doesn't actually do any expansion in
* making its determination.
@@ -327,24 +379,24 @@ Tcl_GetPathType(path)
*/
Tcl_PathType
-TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
- Tcl_Obj *pathPtr; /* Native path of interest */
- int *driveNameLengthPtr; /* Returns length of drive, if non-NULL and
+TclpGetNativePathType(
+ Tcl_Obj *pathPtr, /* Native path of interest */
+ int *driveNameLengthPtr, /* Returns length of drive, if non-NULL and
* path was absolute */
- Tcl_Obj **driveNameRef;
+ Tcl_Obj **driveNameRef)
{
Tcl_PathType type = TCL_PATH_ABSOLUTE;
int pathLen;
- char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
if (path[0] == '~') {
/*
- * This case is common to all platforms. Paths that begin with ~ are
+ * This case is common to all platforms. Paths that begin with ~ are
* absolute.
*/
if (driveNameLengthPtr != NULL) {
- char *end = path + 1;
+ const char *end = path + 1;
while ((*end != '\0') && (*end != '/')) {
end++;
}
@@ -353,31 +405,42 @@ TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
} else {
switch (tclPlatform) {
case TCL_PLATFORM_UNIX: {
- char *origPath = path;
+ const char *origPath = path;
/*
* 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;
@@ -386,15 +449,14 @@ TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
}
case TCL_PLATFORM_WINDOWS: {
Tcl_DString ds;
- CONST char *rootEnd;
+ const char *rootEnd;
Tcl_DStringInit(&ds);
rootEnd = ExtractWinRoot(path, &ds, 0, &type);
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);
}
}
@@ -419,7 +481,7 @@ TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
* functions, which require more memory allocation than is desirable.
*
* Results:
- * Returns list object with refCount of zero. If the passed in lenPtr is
+ * Returns list object with refCount of zero. If the passed in lenPtr is
* non-NULL, we use it to return the number of elements in the returned
* list.
*
@@ -429,12 +491,12 @@ TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpNativeSplitPath(pathPtr, lenPtr)
- Tcl_Obj *pathPtr; /* Path to split. */
- int *lenPtr; /* int to store number of path elements. */
+Tcl_Obj *
+TclpNativeSplitPath(
+ Tcl_Obj *pathPtr, /* Path to split. */
+ int *lenPtr) /* int to store number of path elements. */
{
- Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */
+ Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */
/*
* Perform platform specific splitting.
@@ -465,17 +527,17 @@ TclpNativeSplitPath(pathPtr, lenPtr)
*
* Tcl_SplitPath --
*
- * Split a path into a list of path components. The first element of the
+ * Split a path into a list of path components. The first element of the
* list will have the same path type as the original path.
*
* Results:
- * Returns a standard Tcl result. The interpreter result contains a list
- * of path components. *argvPtr will be filled in with the address of an
+ * Returns a standard Tcl result. The interpreter result contains a list
+ * of path components. *argvPtr will be filled in with the address of an
* array whose elements point to the elements of path, in order.
* *argcPtr will get filled in with the number of valid elements in the
- * array. A single block of memory is dynamically allocated to hold both
- * the argv array and a copy of the path elements. The caller must
- * eventually free this memory by calling ckfree() on *argvPtr. Note:
+ * array. A single block of memory is dynamically allocated to hold both
+ * the argv array and a copy of the path elements. The caller must
+ * eventually free this memory by calling ckfree() on *argvPtr. Note:
* *argvPtr and *argcPtr are only modified if the procedure returns
* normally.
*
@@ -486,17 +548,18 @@ TclpNativeSplitPath(pathPtr, lenPtr)
*/
void
-Tcl_SplitPath(path, argcPtr, argvPtr)
- CONST char *path; /* Pointer to string containing a path. */
- int *argcPtr; /* Pointer to location to fill in with the
+Tcl_SplitPath(
+ const char *path, /* Pointer to string containing a path. */
+ int *argcPtr, /* Pointer to location to fill in with the
* number of elements in the path. */
- CONST char ***argvPtr; /* Pointer to place to store pointer to array
+ const char ***argvPtr) /* Pointer to place to store pointer to array
* of pointers to path elements. */
{
- Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */
+ Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */
Tcl_Obj *tmpPtr, *eltPtr;
int i, size, len;
- char *p, *str;
+ char *p;
+ const char *str;
/*
* Perform the splitting, using objectified, vfs-aware code.
@@ -524,8 +587,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
* 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
@@ -536,7 +598,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
str = Tcl_GetStringFromObj(eltPtr, &len);
- memcpy((VOID *) p, (VOID *) str, (size_t) len+1);
+ memcpy(p, str, (size_t) len+1);
p += len+1;
}
@@ -576,60 +638,72 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-SplitUnixPath(path)
- CONST char *path; /* Pointer to string containing a path. */
+static Tcl_Obj *
+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;
+ }
}
/*
- * Split on slashes. Embedded elements that start with tilde will be
+ * Split on slashes. Embedded elements that start with tilde will be
* prefixed with "./" so they are not affected by tilde substitution.
*/
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)) {
- nextElt = Tcl_NewStringObj("./",2);
+ if ((elementStart[0] == '~') && (elementStart != origPath)) {
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
}
Tcl_ListObjAppendElement(NULL, result, nextElt);
}
- if (*p++ == '\0') {
+ if (*path++ == '\0') {
break;
}
}
@@ -653,12 +727,12 @@ SplitUnixPath(path)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-SplitWinPath(path)
- CONST char *path; /* Pointer to string containing a path. */
+static Tcl_Obj *
+SplitWinPath(
+ const char *path) /* Pointer to string containing a path. */
{
int length;
- CONST char *p, *elementStart;
+ const char *p, *elementStart;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
Tcl_DString buf;
Tcl_Obj *result = Tcl_NewObj();
@@ -671,13 +745,12 @@ SplitWinPath(path)
*/
if (p != path) {
- Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
- Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
+ Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));
}
Tcl_DStringFree(&buf);
/*
- * Split on slashes. Embedded elements that start with tilde or a drive
+ * Split on slashes. Embedded elements that start with tilde or a drive
* letter will be prefixed with "./" so they are not affected by tilde
* substitution.
*/
@@ -690,11 +763,10 @@ SplitWinPath(path)
length = p - elementStart;
if (length > 0) {
Tcl_Obj *nextElt;
- if ((elementStart != path)
- && ((elementStart[0] == '~')
+ if ((elementStart != path) && ((elementStart[0] == '~')
|| (isalpha(UCHAR(elementStart[0]))
&& elementStart[1] == ':'))) {
- nextElt = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
@@ -730,37 +802,33 @@ SplitWinPath(path)
*/
Tcl_Obj *
-Tcl_FSJoinToPath(pathPtr, objc, objv)
- Tcl_Obj *pathPtr; /* Valid path or NULL. */
- int objc; /* Number of array elements to join */
- Tcl_Obj *CONST objv[]; /* Path elements to join. */
+Tcl_FSJoinToPath(
+ Tcl_Obj *pathPtr, /* Valid path or NULL. */
+ 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);
+ if (objc == 1) {
+ Tcl_Obj *pair[2];
- /*
- * 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)).
- */
-
- 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;
+ }
}
/*
@@ -780,12 +848,14 @@ Tcl_FSJoinToPath(pathPtr, objc, objv)
*/
void
-TclpNativeJoinPath(prefix, joining)
- Tcl_Obj *prefix;
- char *joining;
+TclpNativeJoinPath(
+ Tcl_Obj *prefix,
+ const char *joining)
{
int length, needsSep;
- char *dest, *p, *start;
+ char *dest;
+ const char *p;
+ const char *start;
start = Tcl_GetStringFromObj(prefix, &length);
@@ -815,7 +885,7 @@ TclpNativeJoinPath(prefix, joining)
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -851,7 +921,7 @@ TclpNativeJoinPath(prefix, joining)
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -886,12 +956,12 @@ TclpNativeJoinPath(prefix, joining)
*
* Tcl_JoinPath --
*
- * Combine a list of paths in a platform specific manner. The function
+ * Combine a list of paths in a platform specific manner. The function
* 'Tcl_FSJoinPath' should be used in preference where possible.
*
* Results:
* Appends the joined path to the end of the specified Tcl_DString
- * returning a pointer to the resulting string. Note that the
+ * returning a pointer to the resulting string. Note that the
* Tcl_DString must already be initialized.
*
* Side effects:
@@ -901,15 +971,15 @@ TclpNativeJoinPath(prefix, joining)
*/
char *
-Tcl_JoinPath(argc, argv, resultPtr)
- int argc;
- CONST char * CONST *argv;
- Tcl_DString *resultPtr; /* Pointer to previously initialized DString */
+Tcl_JoinPath(
+ int argc,
+ const char *const *argv,
+ Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
{
int i, len;
Tcl_Obj *listObj = Tcl_NewObj();
Tcl_Obj *resultObj;
- char *resultStr;
+ const char *resultStr;
/*
* Build the list of paths.
@@ -950,7 +1020,7 @@ Tcl_JoinPath(argc, argv, resultPtr)
* Tcl_TranslateFileName --
*
* Converts a file name into a form usable by the native system
- * interfaces. If the name starts with a tilde, it will produce a name
+ * interfaces. If the name starts with a tilde, it will produce a name
* where the tilde and following characters have been replaced by the
* home directory location for the named user.
*
@@ -971,14 +1041,14 @@ Tcl_JoinPath(argc, argv, resultPtr)
*/
char *
-Tcl_TranslateFileName(interp, name, bufferPtr)
- Tcl_Interp *interp; /* Interpreter in which to store error message
+Tcl_TranslateFileName(
+ Tcl_Interp *interp, /* Interpreter in which to store error message
* (if necessary). */
- CONST char *name; /* File name, which may begin with "~" (to
+ const char *name, /* File name, which may begin with "~" (to
* indicate current user's home directory) or
* "~<user>" (to indicate any user's home
* directory). */
- Tcl_DString *bufferPtr; /* Uninitialized or free DString filled with
+ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name after tilde substitution. */
{
Tcl_Obj *path = Tcl_NewStringObj(name, -1);
@@ -992,7 +1062,7 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
}
Tcl_DStringInit(bufferPtr);
- Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
+ TclDStringAppendObj(bufferPtr, transPtr);
Tcl_DecrRefCount(path);
Tcl_DecrRefCount(transPtr);
@@ -1023,7 +1093,7 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
*
* Results:
* Returns a pointer into name which indicates where the extension
- * starts. If there is no extension, returns NULL.
+ * starts. If there is no extension, returns NULL.
*
* Side effects:
* None.
@@ -1031,11 +1101,11 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
*----------------------------------------------------------------------
*/
-CONST char *
-TclGetExtension(name)
- CONST char *name; /* File name to parse. */
+const char *
+TclGetExtension(
+ const char *name) /* File name to parse. */
{
- CONST char *p, *lastSep;
+ const char *p, *lastSep;
/*
* First find the last directory separator.
@@ -1063,7 +1133,7 @@ TclGetExtension(name)
/*
* In earlier versions, we used to back up to the first period in a series
- * so that "foo..o" would be split into "foo" and "..o". This is a
+ * so that "foo..o" would be split into "foo" and "..o". This is a
* confusing and usually incorrect behavior, so now we split at the last
* period in the name.
*/
@@ -1092,16 +1162,16 @@ TclGetExtension(name)
*----------------------------------------------------------------------
*/
-static CONST char *
-DoTildeSubst(interp, user, resultPtr)
- Tcl_Interp *interp; /* Interpreter in which to store error message
+static const char *
+DoTildeSubst(
+ Tcl_Interp *interp, /* Interpreter in which to store error message
* (if necessary). */
- CONST char *user; /* Name of user whose home directory should be
+ const char *user, /* Name of user whose home directory should be
* substituted, or "" for current user. */
- Tcl_DString *resultPtr; /* Initialized DString filled with name after
+ Tcl_DString *resultPtr) /* Initialized DString filled with name after
* tilde substitution. */
{
- CONST char *dir;
+ const char *dir;
if (*user == '\0') {
Tcl_DString dirString;
@@ -1109,9 +1179,10 @@ DoTildeSubst(interp, user, resultPtr)
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment ",
- "variable to expand path", (char *) 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;
}
@@ -1120,8 +1191,9 @@ DoTildeSubst(interp, user, resultPtr)
} else if (TclpGetUserHome(user, resultPtr) == NULL) {
if (interp) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", user));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
}
return NULL;
}
@@ -1133,7 +1205,7 @@ DoTildeSubst(interp, user, resultPtr)
*
* Tcl_GlobObjCmd --
*
- * This procedure is invoked to process the "glob" Tcl command. See the
+ * This procedure is invoked to process the "glob" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1147,18 +1219,19 @@ DoTildeSubst(interp, user, resultPtr)
/* ARGSUSED */
int
-Tcl_GlobObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_GlobObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int index, i, globFlags, length, join, dir, result;
- char *string, *separators;
- Tcl_Obj *typePtr, *resultPtr, *look;
+ char *string;
+ const char *separators;
+ Tcl_Obj *typePtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
- static CONST char *options[] = {
+ static const char *const options[] = {
"-directory", "-join", "-nocomplain", "-path", "-tails",
"-types", "--", NULL
};
@@ -1187,7 +1260,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
} else {
/*
* This clearly isn't an option; assume it's the first glob
- * pattern. We must clear the error.
+ * pattern. We must clear the error.
*/
Tcl_ResetResult(interp);
@@ -1203,11 +1276,14 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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;
@@ -1225,11 +1301,14 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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;
@@ -1240,6 +1319,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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];
@@ -1255,14 +1335,12 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
endOfForLoop:
- if (objc - i < 1) {
- Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
- return TCL_ERROR;
- }
if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
- Tcl_AppendResult(interp,
- "\"-tails\" must be used with either ",
- "\"-directory\" or \"-path\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-tails\" must be used with either "
+ "\"-directory\" or \"-path\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+ "BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
}
@@ -1278,8 +1356,8 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
if (dir == PATH_GENERAL) {
int pathlength;
- char *last;
- char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+ const char *last;
+ const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
/*
* Find the last path separator in the path
@@ -1305,7 +1383,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
Tcl_DStringInit(&pref);
if (last == first) {
/*
- * The whole thing is a prefix. This means we must remove any
+ * The whole thing is a prefix. This means we must remove any
* 'tails' flag too, since it is irrelevant now (the same
* effect will happen without it), but in particular its use
* in TclGlob requires a non-NULL pathOrDir.
@@ -1325,7 +1403,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
/*
* We must ensure that we haven't cut off too much, and turned
* a valid path like '/' or 'C:/' into an incorrect path like
- * '' or 'C:'. The way we do this is to add a separator if
+ * '' or 'C:'. The way we do this is to add a separator if
* there are none presently in the prefix.
*/
@@ -1342,7 +1420,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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') {
@@ -1363,12 +1441,15 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
if (typePtr != NULL) {
/*
* The rest of the possible type arguments (except 'd') are platform
- * specific. We don't complain when they are used on an incompatible
+ * specific. We don't complain when they are used on an incompatible
* platform.
*/
Tcl_ListObjLength(interp, typePtr, &length);
- globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
+ if (length <= 0) {
+ goto skipTypes;
+ }
+ globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1376,7 +1457,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
while (--length >= 0) {
int len;
- char *str;
+ const char *str;
Tcl_ListObjIndex(interp, typePtr, length, &look);
str = Tcl_GetStringFromObj(look, &len);
@@ -1432,10 +1513,10 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
Tcl_IncrRefCount(look);
} else {
- Tcl_Obj* item;
+ 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);
@@ -1460,15 +1541,15 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
/*
- * Error cases. We reset the 'join' flag to zero, since we
+ * Error cases. We reset the 'join' flag to zero, since we
* haven't yet made use of it.
*/
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;
@@ -1478,12 +1559,14 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
"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;
}
}
}
+ skipTypes:
/*
* Now we perform the actual glob below. This may involve joining together
* the pattern arguments, dealing with particular file types etc. We use a
@@ -1499,8 +1582,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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);
}
@@ -1516,11 +1598,9 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
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;
@@ -1544,7 +1624,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/*
- * This should never happen. Maybe we should be more dramatic.
+ * This should never happen. Maybe we should be more dramatic.
*/
result = TCL_ERROR;
@@ -1552,20 +1632,25 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
if (length == 0) {
- Tcl_AppendResult(interp, "no files matched glob pattern",
- (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
+ Tcl_Obj *errorMsg =
+ Tcl_ObjPrintf("no files matched glob pattern%s \"",
+ (join || (objc == 1)) ? "" : "s");
+
if (join) {
- Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
- (char *) NULL);
+ Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
} else {
- char *sep = "";
+ const char *sep = "";
+
for (i = 0; i < objc; i++) {
- string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, sep, string, (char *) NULL);
+ Tcl_AppendPrintfToObj(errorMsg, "%s%s",
+ sep, Tcl_GetString(objv[i]));
sep = " ";
}
}
- Tcl_AppendResult(interp, "\"", (char *) NULL);
+ Tcl_AppendToObj(errorMsg, "\"", -1);
+ Tcl_SetObjResult(interp, errorMsg);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
+ NULL);
result = TCL_ERROR;
}
}
@@ -1584,7 +1669,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
if (globTypes->macCreator != NULL) {
Tcl_DecrRefCount(globTypes->macCreator);
}
- ckfree((char *) globTypes);
+ TclStackFree(interp, globTypes);
}
return result;
}
@@ -1594,13 +1679,13 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
*
* TclGlob --
*
- * This procedure prepares arguments for the DoGlob call. It sets the
+ * This procedure prepares arguments for the DoGlob call. It sets the
* separator string based on the platform, performs * tilde substitution,
* and calls DoGlob.
*
* The interpreter's result, on entry to this function, must be a valid
* Tcl list (e.g. it could be empty), since we will lappend any new
- * results to that list. If it is not a valid list, this function will
+ * results to that list. If it is not a valid list, this function will
* fail to do anything very meaningful.
*
* Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then pathPrefix
@@ -1608,12 +1693,10 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
*
* Results:
* The return value is a standard Tcl result indicating whether an error
- * occurred in globbing. After a normal return the result in interp (set
+ * occurred in globbing. After a normal return the result in interp (set
* by DoGlob) holds all of the file names given by the pattern and
- * pathPrefix arguments. After an error the result in interp will hold
- * an error message, unless the 'TCL_GLOBMODE_NO_COMPLAIN' flag was
- * given, in which case an error results in a TCL_OK return leaving the
- * interpreter's result unmodified.
+ * pathPrefix arguments. After an error the result in interp will hold
+ * an error message.
*
* Side effects:
* The 'pattern' is written to.
@@ -1623,19 +1706,19 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-TclGlob(interp, pattern, pathPrefix, globFlags, types)
- Tcl_Interp *interp; /* Interpreter for returning error message or
+TclGlob(
+ Tcl_Interp *interp, /* Interpreter for returning error message or
* appending list of matching file names. */
- char *pattern; /* Glob pattern to match. Must not refer to a
+ char *pattern, /* Glob pattern to match. Must not refer to a
* static string. */
- Tcl_Obj *pathPrefix; /* Path prefix to glob pattern, if non-null,
+ Tcl_Obj *pathPrefix, /* Path prefix to glob pattern, if non-null,
* which is considered literally. */
- int globFlags; /* Stores or'ed combination of flags */
- Tcl_GlobTypeData *types; /* Struct containing acceptable types. May be
+ int globFlags, /* Stores or'ed combination of flags */
+ Tcl_GlobTypeData *types) /* Struct containing acceptable types. May be
* NULL. */
{
- char *separators;
- CONST char *head;
+ const char *separators;
+ const char *head;
char *tail, *start;
int result;
Tcl_Obj *filenamesObj, *savedResultObj;
@@ -1682,28 +1765,15 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
c = *tail;
*tail = '\0';
- if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- /*
- * We will ignore any error message here, and we don't want to
- * mess up the interpreter's result.
- */
- head = DoTildeSubst(NULL, start+1, &buffer);
- } else {
- head = DoTildeSubst(interp, start+1, &buffer);
- }
+ head = DoTildeSubst(interp, start+1, &buffer);
*tail = c;
if (head == NULL) {
- if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- return TCL_OK;
- } else {
- return TCL_ERROR;
- }
+ return TCL_ERROR;
}
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') {
@@ -1721,7 +1791,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
/*
* Handling empty path prefixes with glob patterns like 'C:' or
* 'c:////////' is a pain on Windows if we leave it too late, since these
- * aren't really patterns at all! We therefore check the head of the
+ * aren't really patterns at all! We therefore check the head of the
* pattern now for such cases, if we don't have an unquoted prefix yet.
*
* Similarly on Unix with '/' at the head of the pattern -- it just
@@ -1764,28 +1834,24 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
case TCL_PATH_VOLUME_RELATIVE: {
/*
* Volume relative path which is equivalent to a path in the
- * root of the cwd's volume. We will actually return
+ * root of the cwd's volume. We will actually return
* non-volume-relative paths here. i.e. 'glob /foo*' will
- * return 'C:/foobar'. This is much the same as globbing for
- * a path with '\\' will return one with '/' on Windows.
+ * return 'C:/foobar'. This is much the same as globbing for a
+ * path with '\\' will return one with '/' on Windows.
*/
Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
if (cwd == NULL) {
Tcl_DecrRefCount(temp);
- if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- return TCL_OK;
- } else {
- return TCL_ERROR;
- }
+ return TCL_ERROR;
}
pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3);
Tcl_DecrRefCount(cwd);
if (tail[0] == '/') {
tail++;
} else {
- tail+=2;
+ tail += 2;
}
Tcl_IncrRefCount(pathPrefix);
break;
@@ -1847,6 +1913,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
Tcl_IncrRefCount(savedResultObj);
Tcl_ResetResult(interp);
TclNewObj(filenamesObj);
+ Tcl_IncrRefCount(filenamesObj);
/*
* Now we do the actual globbing, adding filenames as we go to buffer in
@@ -1855,10 +1922,32 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
if (*tail == '\0' && pathPrefix != NULL) {
/*
- * An empty pattern
+ * An empty pattern. This means 'pathPrefix' is actually a full path
+ * of a file/directory we want to simply check for existence and type.
*/
- result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
- NULL, types);
+
+ if (types == NULL) {
+ /*
+ * We just want to check for existence. In this case we make it
+ * easy on Tcl_FSMatchInDirectory and its sub-implementations by
+ * not bothering them (even though they should support this
+ * situation) and we just use the simple existence check with
+ * Tcl_FSAccess.
+ */
+
+ if (Tcl_FSAccess(pathPrefix, F_OK) == 0) {
+ Tcl_ListObjAppendElement(interp, filenamesObj, pathPrefix);
+ }
+ result = TCL_OK;
+ } else {
+ /*
+ * We want to check for the correct type. Tcl_FSMatchInDirectory
+ * is documented to do this for us, if we give it a NULL pattern.
+ */
+
+ result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
+ NULL, types);
+ }
} else {
result = DoGlob(interp, filenamesObj, separators, pathPrefix,
globFlags & TCL_GLOBMODE_DIR, tail, types);
@@ -1870,21 +1959,19 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
if (result != TCL_OK) {
TclDecrRefCount(filenamesObj);
- if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
- /* Put back the old result and reset the return code */
- Tcl_SetObjResult(interp, savedResultObj);
- result = TCL_OK;
- }
TclDecrRefCount(savedResultObj);
+ if (pathPrefix != NULL) {
+ Tcl_DecrRefCount(pathPrefix);
+ }
return result;
}
/*
- * If we only want the tails, we must strip off the prefix now. It may
+ * If we only want the tails, we must strip off the prefix now. It may
* seem more efficient to pass the tails flag down into DoGlob,
* Tcl_FSMatchInDirectory, but those functions are continually adjusting
* the prefix as the various pieces of the pattern are assimilated, so
- * that would add a lot of complexity to the code. This way is a little
+ * that would add a lot of complexity to the code. This way is a little
* slower (when the -tails flag is given), but much simpler to code.
*
* We do it by rewriting the result list in-place.
@@ -1894,12 +1981,17 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
int objc, i;
Tcl_Obj **objv;
int prefixLen;
+ const char *pre;
/*
* If this length has never been set, set it here.
*/
- CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
+ if (pathPrefix == NULL) {
+ Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
+ }
+
+ pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
if (prefixLen > 0
&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
/*
@@ -1917,20 +2009,20 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
- char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
- Tcl_Obj* elems[1];
+ const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+ Tcl_Obj *elem;
if (len == prefixLen) {
if ((pattern[0] == '\0')
|| (strchr(separators, pattern[0]) == NULL)) {
- elems[0] = Tcl_NewStringObj(".", 1);
+ TclNewLiteralStringObj(elem, ".");
} else {
- elems[0] = Tcl_NewStringObj("/", 1);
+ TclNewLiteralStringObj(elem, "/");
}
} else {
- elems[0] = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
+ elem = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
}
- Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, elems);
+ Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, &elem);
}
}
@@ -1952,6 +2044,9 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
}
TclDecrRefCount(savedResultObj);
TclDecrRefCount(filenamesObj);
+ if (pathPrefix != NULL) {
+ Tcl_DecrRefCount(pathPrefix);
+ }
return result;
}
@@ -1966,7 +2061,7 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
*
* Results:
* Updates stringPtr to point to the matching character, or to the end of
- * the string if nothing matched. The return value is 1 if a match was
+ * the string if nothing matched. The return value is 1 if a match was
* found at the top level, otherwise it is 0.
*
* Side effects:
@@ -1976,9 +2071,9 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
*/
static int
-SkipToChar(stringPtr, match)
- char **stringPtr; /* Pointer string to check. */
- int match; /* Character to find. */
+SkipToChar(
+ char **stringPtr, /* Pointer string to check. */
+ int match) /* Character to find. */
{
int quoted, level;
register char *p;
@@ -2023,9 +2118,9 @@ SkipToChar(stringPtr, match)
*
* Results:
* The return value is a standard Tcl result indicating whether an error
- * occurred in globbing. After a normal return the result in interp will
+ * occurred in globbing. After a normal return the result in interp will
* be set to hold all of the file names given by the dir and remaining
- * arguments. After an error the result in interp will hold an error
+ * arguments. After an error the result in interp will hold an error
* message.
*
* Side effects:
@@ -2035,21 +2130,21 @@ SkipToChar(stringPtr, match)
*/
static int
-DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
- Tcl_Interp *interp; /* Interpreter to use for error reporting
+DoGlob(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting
* (e.g. unmatched brace). */
- Tcl_Obj *matchesObj; /* Unshared list object in which to place all
+ Tcl_Obj *matchesObj, /* Unshared list object in which to place all
* resulting filenames. Caller allocates and
* deallocates; DoGlob must not touch the
* refCount of this object. */
- char *separators; /* String containing separator characters that
+ const char *separators, /* String containing separator characters that
* should be used to identify globbing
* boundaries. */
- Tcl_Obj *pathPtr; /* Completely expanded prefix. */
- int flags; /* If non-zero then pathPtr is a directory */
- char *pattern; /* The pattern to match against. Must not be
- * a pointer to a static string. */
- Tcl_GlobTypeData *types; /* List object containing list of acceptable
+ Tcl_Obj *pathPtr, /* Completely expanded prefix. */
+ int flags, /* If non-zero then pathPtr is a directory */
+ char *pattern, /* The pattern to match against. Must not be a
+ * pointer to a static string. */
+ Tcl_GlobTypeData *types) /* List object containing list of acceptable
* types. May be NULL. */
{
int baseLength, quoted, count;
@@ -2068,8 +2163,8 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
if (*pattern == '\\') {
/*
* If the first character is escaped, either we have a directory
- * separator, or we have any other character. In the latter case
- * the rest is a pattern, and we must break from the loop. This
+ * separator, or we have any other character. In the latter case
+ * the rest is a pattern, and we must break from the loop. This
* is particularly important on Windows where '\' is both the
* escaping character and a directory separator.
*/
@@ -2086,67 +2181,6 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
}
/*
- * 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.
*/
@@ -2183,13 +2217,17 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
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;
}
}
@@ -2200,8 +2238,8 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
if (openBrace != NULL) {
char *element;
-
Tcl_DString newName;
+
Tcl_DStringInit(&newName);
/*
@@ -2250,12 +2288,13 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*/
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;
@@ -2274,7 +2313,7 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
TCL_GLOB_TYPE_DIR, 0, NULL, NULL
};
char save = *p;
- Tcl_Obj* subdirsPtr;
+ Tcl_Obj *subdirsPtr;
if (*p == '\0') {
return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr,
@@ -2288,18 +2327,48 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*p = '\0';
TclNewObj(subdirsPtr);
+ Tcl_IncrRefCount(subdirsPtr);
result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
pattern, &dirOnly);
*p = save;
if (result == TCL_OK) {
- int subdirc, i;
+ int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
result = Tcl_ListObjGetElements(interp, subdirsPtr,
&subdirc, &subdirv);
for (i=0; result==TCL_OK && i<subdirc; i++) {
+ Tcl_Obj *copy = NULL;
+
+ if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
+ Tcl_ListObjLength(NULL, matchesObj, &repair);
+ copy = subdirv[i];
+ subdirv[i] = Tcl_NewStringObj("./", 2);
+ Tcl_AppendObjToObj(subdirv[i], copy);
+ Tcl_IncrRefCount(subdirv[i]);
+ }
result = DoGlob(interp, matchesObj, separators, subdirv[i],
1, p+1, types);
+ if (copy) {
+ int end;
+
+ Tcl_DecrRefCount(subdirv[i]);
+ subdirv[i] = copy;
+ Tcl_ListObjLength(NULL, matchesObj, &end);
+ while (repair < end) {
+ 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);
+ Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
+ 1, &newObj);
+ repair++;
+ }
+ repair = -1;
+ }
}
}
TclDecrRefCount(subdirsPtr);
@@ -2311,6 +2380,9 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*/
if (*p == '\0') {
+ int length;
+ Tcl_DString append;
+
/*
* This is the code path reached by a command like 'glob foo'.
*
@@ -2323,9 +2395,6 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
* approach).
*/
- int length;
- Tcl_DString append;
-
Tcl_DStringInit(&append);
Tcl_DStringAppend(&append, pattern, p-pattern);
@@ -2340,30 +2409,20 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
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__)
- {
- extern int cygwin_conv_to_win32_path(CONST char *, char *);
- 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, ".");
}
}
break;
@@ -2374,8 +2433,7 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*/
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));
@@ -2387,7 +2445,7 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*/
int len;
- CONST char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
Tcl_AppendToObj(joinedPtr, "/", 1);
@@ -2398,9 +2456,10 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
}
Tcl_IncrRefCount(joinedPtr);
Tcl_DStringFree(&append);
- Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL, types);
+ result = Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL,
+ types);
Tcl_DecrRefCount(joinedPtr);
- return TCL_OK;
+ return result;
}
/*
@@ -2416,14 +2475,14 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
if (strchr(separators, pattern[0]) == NULL) {
/*
* The current prefix must end in a separator, unless this is a
- * volume-relative path. In particular globbing in Windows
- * shares, when not using -dir or -path, e.g. 'glob [file join
+ * volume-relative path. In particular globbing in Windows shares,
+ * when not using -dir or -path, e.g. 'glob [file join
* //machine/share/subdir *]' requires adding a separator here.
* This behaviour is not currently tested for in the test suite.
*/
int len;
- CONST char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
@@ -2446,7 +2505,7 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*
* Tcl_AllocStatBuf --
*
- * This procedure allocates a Tcl_StatBuf on the heap. It exists so that
+ * This procedure allocates a Tcl_StatBuf on the heap. It exists so that
* extensions may be used unchanged on systems where largefile support is
* optional.
*
@@ -2461,8 +2520,132 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types)
*/
Tcl_StatBuf *
-Tcl_AllocStatBuf() {
- return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
+Tcl_AllocStatBuf(void)
+{
+ return ckalloc(sizeof(Tcl_StatBuf));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Access functions for Tcl_StatBuf --
+ *
+ * These functions provide portable read-only access to the portable
+ * fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
+ * stat64' or something else related). [TIP #316]
+ *
+ * Results:
+ * The value from the field being retrieved.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned
+Tcl_GetFSDeviceFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (unsigned) statPtr->st_dev;
+}
+
+unsigned
+Tcl_GetFSInodeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (unsigned) statPtr->st_ino;
+}
+
+unsigned
+Tcl_GetModeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (unsigned) statPtr->st_mode;
+}
+
+int
+Tcl_GetLinkCountFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (int)statPtr->st_nlink;
+}
+
+int
+Tcl_GetUserIdFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (int) statPtr->st_uid;
+}
+
+int
+Tcl_GetGroupIdFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (int) statPtr->st_gid;
+}
+
+int
+Tcl_GetDeviceTypeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (int) statPtr->st_rdev;
+}
+
+Tcl_WideInt
+Tcl_GetAccessTimeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (Tcl_WideInt) statPtr->st_atime;
+}
+
+Tcl_WideInt
+Tcl_GetModificationTimeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (Tcl_WideInt) statPtr->st_mtime;
+}
+
+Tcl_WideInt
+Tcl_GetChangeTimeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (Tcl_WideInt) statPtr->st_ctime;
+}
+
+Tcl_WideUInt
+Tcl_GetSizeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+ return (Tcl_WideUInt) statPtr->st_size;
+}
+
+Tcl_WideUInt
+Tcl_GetBlocksFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+ return (Tcl_WideUInt) statPtr->st_blocks;
+#else
+ register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
+
+ return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
+#endif
+}
+
+unsigned
+Tcl_GetBlockSizeFromStat(
+ const Tcl_StatBuf *statPtr)
+{
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+ return (unsigned) statPtr->st_blksize;
+#else
+ /*
+ * Not a great guess, but will do...
+ */
+
+ return GUESSED_BLOCK_SIZE;
+#endif
}
/*
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 459e572..6be3e03 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -1,130 +1,74 @@
-/*
+/*
* tclFileSystem.h --
*
- * This file contains the common defintions and prototypes for
- * use by Tcl's filesystem and path handling layers.
+ * This file contains the common defintions and prototypes for use by
+ * Tcl's filesystem and path handling layers.
*
* Copyright (c) 2003 Vince Darley.
*
- * 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.10 2004/11/03 00:53:05 davygrvy Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLFILESYSTEM
#define _TCLFILESYSTEM
-#ifndef _TCL
#include "tcl.h"
-#endif
-
-/*
- * 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) */
- 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.
- *
+ * The internal TclFS API provides routines for handling and manipulating
+ * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
+ *
* These functions are not exported at all at present.
*/
-MODULE_SCOPE int TclFSCwdPointerEquals _ANSI_ARGS_((
- Tcl_Obj** pathPtrPtr));
-MODULE_SCOPE int TclFSMakePathFromNormalized _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *pathPtr,
- ClientData clientData));
-MODULE_SCOPE int TclFSNormalizeToUniquePath _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *pathPtr,
- int startAt, ClientData *clientDataPtr));
-MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *pathPtr,
- Tcl_Obj *cwdPtr));
-MODULE_SCOPE Tcl_Obj * TclFSInternalToNormalized _ANSI_ARGS_((
- Tcl_Filesystem *fromFilesystem,
- ClientData clientData,
- FilesystemRecord **fsRecPtrPtr));
-MODULE_SCOPE int TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathPtr,
- Tcl_Filesystem **fsPtrPtr));
-MODULE_SCOPE void TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathPtr,
- FilesystemRecord *fsRecPtr,
- ClientData clientData ));
-MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath _ANSI_ARGS_((
- Tcl_Interp* interp, Tcl_Obj *pathPtr,
- ClientData *clientDataPtr));
+MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
+MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int startAt);
+MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
+MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem **fsPtrPtr);
+MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem *fsPtr, ClientData clientData);
+MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
+MODULE_SCOPE int TclFSEpoch(void);
-/*
+/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
*/
-MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem;
-MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
-/*
- * Private shared functions for use by tclIOUtil.c, tclPathObj.c
- * and tclFileName.c, and any platform-specific filesystem code.
+MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
+
+/*
+ * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
+ * tclFileName.c, and any platform-specific filesystem code.
*/
-MODULE_SCOPE Tcl_PathType TclFSGetPathType _ANSI_ARGS_((
- Tcl_Obj *pathPtr,
- Tcl_Filesystem **filesystemPtrPtr,
- int *driveNameLengthPtr));
-MODULE_SCOPE Tcl_PathType TclFSNonnativePathType _ANSI_ARGS_((
- CONST char *pathPtr, int pathLen,
- Tcl_Filesystem **filesystemPtrPtr,
- int *driveNameLengthPtr,
- Tcl_Obj **driveNameRef));
-MODULE_SCOPE Tcl_PathType TclGetPathType _ANSI_ARGS_((
- Tcl_Obj *pathPtr,
- Tcl_Filesystem **filesystemPtrPtr,
- int *driveNameLengthPtr,
- Tcl_Obj **driveNameRef));
-MODULE_SCOPE int TclFSEpochOk _ANSI_ARGS_((
- int filesystemEpoch));
-MODULE_SCOPE int TclFSCwdIsNative _ANSI_ARGS_((void));
-MODULE_SCOPE Tcl_Obj* TclWinVolumeRelativeNormalize _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *path,
- Tcl_Obj **useThisCwdPtr));
+
+MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr);
+MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
+ int pathLen, const Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
+MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
+ const Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
+MODULE_SCOPE int TclFSEpochOk(int filesystemEpoch);
+MODULE_SCOPE int TclFSCwdIsNative(void);
+MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
+ const char *path, Tcl_Obj **useThisCwdPtr);
MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
#endif /* _TCLFILESYSTEM */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclGet.c b/generic/tclGet.c
index b28b3f92..97e8c7b 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -10,12 +10,9 @@
*
* 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.16 2005/07/24 22:56:43 dkf Exp $
*/
#include "tclInt.h"
-
/*
*----------------------------------------------------------------------
@@ -37,11 +34,12 @@
*/
int
-Tcl_GetInt(interp, src, intPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- CONST char *src; /* String containing a (possibly signed)
- * integer in a form acceptable to strtoul. */
- int *intPtr; /* Place to store converted result. */
+Tcl_GetInt(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ const char *src, /* String containing a (possibly signed)
+ * integer in a form acceptable to
+ * Tcl_GetIntFromObj(). */
+ int *intPtr) /* Place to store converted result. */
{
Tcl_Obj obj;
int code;
@@ -55,50 +53,7 @@ Tcl_GetInt(interp, src, intPtr)
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetLong --
- *
- * Given a string, produce the corresponding long integer value. This
- * routine is a version of Tcl_GetInt but returns a "long" instead of an
- * "int" (a difference that matters on 64-bit architectures).
- *
- * Results:
- * The return value is normally TCL_OK; in this case *longPtr will be set
- * to the long integer value equivalent to src. If src is improperly
- * formed then TCL_ERROR is returned and an error message will be left in
- * the interp's result if interp is non-NULL.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGetLong(interp, src, longPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting if not
- * NULL. */
- CONST char *src; /* String containing a (possibly signed) long
- * integer in a form acceptable to strtoul. */
- long *longPtr; /* Place to store converted long result. */
-{
- Tcl_Obj obj;
- int code;
-
- obj.refCount = 1;
- obj.bytes = (char *) src;
- obj.length = strlen(src);
- obj.typePtr = NULL;
-
- code = Tcl_GetLongFromObj(interp, &obj, longPtr);
- if (obj.refCount > 1) {
- Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
- }
+ TclFreeIntRep(&obj);
return code;
}
@@ -123,11 +78,12 @@ TclGetLong(interp, src, longPtr)
*/
int
-Tcl_GetDouble(interp, src, doublePtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- CONST char *src; /* String containing a floating-point number
- * in a form acceptable to strtod. */
- double *doublePtr; /* Place to store converted result. */
+Tcl_GetDouble(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ const char *src, /* String containing a floating-point number
+ * in a form acceptable to
+ * Tcl_GetDoubleFromObj(). */
+ double *doublePtr) /* Place to store converted result. */
{
Tcl_Obj obj;
int code;
@@ -141,6 +97,7 @@ Tcl_GetDouble(interp, src, doublePtr)
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
+ TclFreeIntRep(&obj);
return code;
}
@@ -165,12 +122,11 @@ Tcl_GetDouble(interp, src, doublePtr)
*/
int
-Tcl_GetBoolean(interp, src, boolPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- CONST char *src; /* String containing a boolean number
- * specified either as 1/0 or true/false or
- * yes/no. */
- int *boolPtr; /* Place to store converted result, which will
+Tcl_GetBoolean(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ const char *src, /* String containing one of the boolean values
+ * 1, 0, true, false, yes, no, on, off. */
+ int *boolPtr) /* Place to store converted result, which will
* be 0 or 1. */
{
Tcl_Obj obj;
@@ -181,7 +137,7 @@ Tcl_GetBoolean(interp, src, boolPtr)
obj.length = strlen(src);
obj.typePtr = NULL;
- code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
+ code = TclSetBooleanFromAny(interp, &obj);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index 800c04b..da4c3fd 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -1,39 +1,44 @@
-/*
+/*
* tclGetDate.y --
*
- * Contains yacc grammar for parsing date and time strings.
- * The output of this file should be the file tclDate.c which
- * is used directly in the Tcl sources.
+ * Contains yacc grammar for parsing date and time strings. The output of
+ * this file should be the file tclDate.c which is used directly in the
+ * Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
+ * only used when doing free-form date parsing, an ill-defined process
+ * anyway.
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-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: tclGetDate.y,v 1.27 2005/05/10 18:34:38 kennykb Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+%parse-param {DateInfo* info}
+%lex-param {DateInfo* info}
+%pure-parser
+ /* %error-verbose would be nice, but our token names are meaningless */
+%locations
+
%{
-/*
+/*
* tclDate.c --
*
- * This file is generated from a yacc grammar defined in
- * the file tclGetDate.y. It should not be edited directly.
+ * This file is generated from a yacc grammar defined in the file
+ * tclGetDate.y. It should not be edited directly.
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
*/
-
#include "tclInt.h"
/*
- * Bison generates several labels that happen to be unused. MS Visual
- * C++ doesn't like that, and complains. Tell it to shut up.
+ * Bison generates several labels that happen to be unused. MS Visual C++
+ * doesn't like that, and complains. Tell it to shut up.
*/
#ifdef _MSC_VER
@@ -41,325 +46,364 @@
#endif /* _MSC_VER */
/*
- * yyparse will accept a 'struct DateInfo' as its parameter;
- * that's where the parsed fields will be returned.
+ * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
+ * parsed fields will be returned.
*/
typedef struct DateInfo {
- time_t dateYear;
- time_t dateMonth;
- time_t dateDay;
- int dateHaveDate;
+ Tcl_Obj* messages; /* Error messages */
+ const char* separatrix; /* String separating messages */
- time_t dateHour;
- time_t dateMinutes;
- time_t dateSeconds;
- int dateMeridian;
- int dateHaveTime;
+ time_t dateYear;
+ time_t dateMonth;
+ time_t dateDay;
+ int dateHaveDate;
- time_t dateTimezone;
- int dateDSTmode;
- int dateHaveZone;
+ time_t dateHour;
+ time_t dateMinutes;
+ time_t dateSeconds;
+ int dateMeridian;
+ int dateHaveTime;
- time_t dateRelMonth;
- time_t dateRelDay;
- time_t dateRelSeconds;
- int dateHaveRel;
+ time_t dateTimezone;
+ int dateDSTmode;
+ int dateHaveZone;
- time_t dateMonthOrdinal;
- int dateHaveOrdinalMonth;
+ time_t dateRelMonth;
+ time_t dateRelDay;
+ time_t dateRelSeconds;
+ int dateHaveRel;
- time_t dateDayOrdinal;
- time_t dateDayNumber;
- int dateHaveDay;
+ time_t dateMonthOrdinal;
+ int dateHaveOrdinalMonth;
- char *dateInput;
- time_t *dateRelPointer;
+ time_t dateDayOrdinal;
+ time_t dateDayNumber;
+ int dateHaveDay;
- int dateDigitCount;
+ const char *dateStart;
+ const char *dateInput;
+ time_t *dateRelPointer;
+ int dateDigitCount;
} DateInfo;
-#define YYPARSE_PARAM info
-#define YYLEX_PARAM info
-
-#define yyDSTmode (((DateInfo*)info)->dateDSTmode)
-#define yyDayOrdinal (((DateInfo*)info)->dateDayOrdinal)
-#define yyDayNumber (((DateInfo*)info)->dateDayNumber)
-#define yyMonthOrdinal (((DateInfo*)info)->dateMonthOrdinal)
-#define yyHaveDate (((DateInfo*)info)->dateHaveDate)
-#define yyHaveDay (((DateInfo*)info)->dateHaveDay)
-#define yyHaveOrdinalMonth (((DateInfo*)info)->dateHaveOrdinalMonth)
-#define yyHaveRel (((DateInfo*)info)->dateHaveRel)
-#define yyHaveTime (((DateInfo*)info)->dateHaveTime)
-#define yyHaveZone (((DateInfo*)info)->dateHaveZone)
-#define yyTimezone (((DateInfo*)info)->dateTimezone)
-#define yyDay (((DateInfo*)info)->dateDay)
-#define yyMonth (((DateInfo*)info)->dateMonth)
-#define yyYear (((DateInfo*)info)->dateYear)
-#define yyHour (((DateInfo*)info)->dateHour)
-#define yyMinutes (((DateInfo*)info)->dateMinutes)
-#define yySeconds (((DateInfo*)info)->dateSeconds)
-#define yyMeridian (((DateInfo*)info)->dateMeridian)
-#define yyRelMonth (((DateInfo*)info)->dateRelMonth)
-#define yyRelDay (((DateInfo*)info)->dateRelDay)
-#define yyRelSeconds (((DateInfo*)info)->dateRelSeconds)
-#define yyRelPointer (((DateInfo*)info)->dateRelPointer)
-#define yyInput (((DateInfo*)info)->dateInput)
-#define yyDigitCount (((DateInfo*)info)->dateDigitCount)
-
-#define EPOCH 1970
-#define START_OF_TIME 1902
-#define END_OF_TIME 2037
+#define YYMALLOC ckalloc
+#define YYFREE(x) (ckfree((void*) (x)))
+
+#define yyDSTmode (info->dateDSTmode)
+#define yyDayOrdinal (info->dateDayOrdinal)
+#define yyDayNumber (info->dateDayNumber)
+#define yyMonthOrdinal (info->dateMonthOrdinal)
+#define yyHaveDate (info->dateHaveDate)
+#define yyHaveDay (info->dateHaveDay)
+#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
+#define yyHaveRel (info->dateHaveRel)
+#define yyHaveTime (info->dateHaveTime)
+#define yyHaveZone (info->dateHaveZone)
+#define yyTimezone (info->dateTimezone)
+#define yyDay (info->dateDay)
+#define yyMonth (info->dateMonth)
+#define yyYear (info->dateYear)
+#define yyHour (info->dateHour)
+#define yyMinutes (info->dateMinutes)
+#define yySeconds (info->dateSeconds)
+#define yyMeridian (info->dateMeridian)
+#define yyRelMonth (info->dateRelMonth)
+#define yyRelDay (info->dateRelDay)
+#define yyRelSeconds (info->dateRelSeconds)
+#define yyRelPointer (info->dateRelPointer)
+#define yyInput (info->dateInput)
+#define yyDigitCount (info->dateDigitCount)
+
+#define EPOCH 1970
+#define START_OF_TIME 1902
+#define END_OF_TIME 2037
/*
* The offset of tm_year of struct tm returned by localtime, gmtime, etc.
* Posix requires 1900.
*/
-#define TM_YEAR_BASE 1900
-#define HOUR(x) ((int) (60 * x))
-#define SECSPERDAY (24L * 60L * 60L)
-#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
+#define TM_YEAR_BASE 1900
+
+#define HOUR(x) ((int) (60 * x))
+#define SECSPERDAY (24L * 60L * 60L)
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
/*
- * An entry in the lexical lookup table.
+ * An entry in the lexical lookup table.
*/
+
typedef struct _TABLE {
- char *name;
- int type;
- time_t value;
+ const char *name;
+ int type;
+ time_t value;
} TABLE;
-
/*
- * Daylight-savings mode: on, off, or not yet known.
+ * Daylight-savings mode: on, off, or not yet known.
*/
+
typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
/*
- * Meridian: am, pm, or 24-hour style.
+ * Meridian: am, pm, or 24-hour style.
*/
+
typedef enum _MERIDIAN {
MERam, MERpm, MER24
} MERIDIAN;
+%}
+
+%union {
+ time_t Number;
+ enum _MERIDIAN Meridian;
+}
+
+%{
/*
* Prototypes of internal functions.
*/
-static void TclDateerror _ANSI_ARGS_((char *s));
-static time_t ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
- time_t Seconds, MERIDIAN Meridian));
-static int LookupWord _ANSI_ARGS_((char *buff));
-static int TclDatelex _ANSI_ARGS_((void* info));
+static int LookupWord(YYSTYPE* yylvalPtr, char *buff);
+ static void TclDateerror(YYLTYPE* location,
+ DateInfo* info, const char *s);
+ static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
+ DateInfo* info);
+static time_t ToSeconds(time_t Hours, time_t Minutes,
+ time_t Seconds, MERIDIAN Meridian);
+MODULE_SCOPE int yyparse(DateInfo*);
%}
-%union {
- time_t Number;
- enum _MERIDIAN Meridian;
-}
-
-%token tAGO tDAY tDAYZONE tID tMERIDIAN tMINUTE_UNIT tMONTH tMONTH_UNIT
-%token tSTARDATE tSEC_UNIT tSNUMBER tUNUMBER tZONE tEPOCH tDST tISOBASE
-%token tDAY_UNIT tNEXT
-
-%type <Number> tDAY tDAYZONE tMINUTE_UNIT tMONTH tMONTH_UNIT tDST
-%type <Number> tSEC_UNIT tSNUMBER tUNUMBER tZONE tISOBASE tDAY_UNIT
-%type <Number> unit sign tNEXT tSTARDATE
-%type <Meridian> tMERIDIAN o_merid
+%token tAGO
+%token tDAY
+%token tDAYZONE
+%token tID
+%token tMERIDIAN
+%token tMONTH
+%token tMONTH_UNIT
+%token tSTARDATE
+%token tSEC_UNIT
+%token tSNUMBER
+%token tUNUMBER
+%token tZONE
+%token tEPOCH
+%token tDST
+%token tISOBASE
+%token tDAY_UNIT
+%token tNEXT
+
+%type <Number> tDAY
+%type <Number> tDAYZONE
+%type <Number> tMONTH
+%type <Number> tMONTH_UNIT
+%type <Number> tDST
+%type <Number> tSEC_UNIT
+%type <Number> tSNUMBER
+%type <Number> tUNUMBER
+%type <Number> tZONE
+%type <Number> tISOBASE
+%type <Number> tDAY_UNIT
+%type <Number> unit
+%type <Number> sign
+%type <Number> tNEXT
+%type <Number> tSTARDATE
+%type <Meridian> tMERIDIAN
+%type <Meridian> o_merid
%%
-spec : /* NULL */
- | spec item
- ;
-
-item : time {
- yyHaveTime++;
- }
- | zone {
- yyHaveZone++;
- }
- | date {
- yyHaveDate++;
- }
- | ordMonth {
- yyHaveOrdinalMonth++;
- }
- | day {
- yyHaveDay++;
- }
- | relspec {
- yyHaveRel++;
- }
- | iso {
+spec : /* NULL */
+ | spec item
+ ;
+
+item : time {
yyHaveTime++;
+ }
+ | zone {
+ yyHaveZone++;
+ }
+ | date {
yyHaveDate++;
}
- | trek {
+ | ordMonth {
+ yyHaveOrdinalMonth++;
+ }
+ | day {
+ yyHaveDay++;
+ }
+ | relspec {
+ yyHaveRel++;
+ }
+ | iso {
+ yyHaveTime++;
+ yyHaveDate++;
+ }
+ | trek {
yyHaveTime++;
yyHaveDate++;
yyHaveRel++;
- }
- | number
- ;
-
-time : tUNUMBER tMERIDIAN {
- yyHour = $1;
- yyMinutes = 0;
- yySeconds = 0;
- yyMeridian = $2;
- }
- | tUNUMBER ':' tUNUMBER o_merid {
- yyHour = $1;
- yyMinutes = $3;
- yySeconds = 0;
- yyMeridian = $4;
- }
- | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($5 % 100 + ($5 / 100) * 60);
+ }
+ | number
+ ;
+
+time : tUNUMBER tMERIDIAN {
+ yyHour = $1;
+ yyMinutes = 0;
+ yySeconds = 0;
+ yyMeridian = $2;
+ }
+ | tUNUMBER ':' tUNUMBER o_merid {
+ yyHour = $1;
+ yyMinutes = $3;
+ yySeconds = 0;
+ yyMeridian = $4;
+ }
+ | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
+ yyHour = $1;
+ yyMinutes = $3;
+ yyMeridian = MER24;
+ yyDSTmode = DSToff;
+ yyTimezone = ($5 % 100 + ($5 / 100) * 60);
++yyHaveZone;
- }
- | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
- yyHour = $1;
- yyMinutes = $3;
- yySeconds = $5;
- yyMeridian = $6;
- }
- | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yySeconds = $5;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($7 % 100 + ($7 / 100) * 60);
+ }
+ | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
+ yyHour = $1;
+ yyMinutes = $3;
+ yySeconds = $5;
+ yyMeridian = $6;
+ }
+ | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
+ yyHour = $1;
+ yyMinutes = $3;
+ yySeconds = $5;
+ yyMeridian = MER24;
+ yyDSTmode = DSToff;
+ yyTimezone = ($7 % 100 + ($7 / 100) * 60);
++yyHaveZone;
- }
- ;
-
-zone : tZONE tDST {
- yyTimezone = $1;
- yyDSTmode = DSTon;
- }
- | tZONE {
- yyTimezone = $1;
- yyDSTmode = DSToff;
- }
- | tDAYZONE {
- yyTimezone = $1;
- yyDSTmode = DSTon;
- }
- ;
-
-day : tDAY {
- yyDayOrdinal = 1;
- yyDayNumber = $1;
- }
- | tDAY ',' {
- yyDayOrdinal = 1;
- yyDayNumber = $1;
- }
- | tUNUMBER tDAY {
- yyDayOrdinal = $1;
- yyDayNumber = $2;
- }
- | sign tUNUMBER tDAY {
- yyDayOrdinal = $1 * $2;
- yyDayNumber = $3;
- }
- | tNEXT tDAY {
- yyDayOrdinal = 2;
- yyDayNumber = $2;
- }
- ;
-
-date : tUNUMBER '/' tUNUMBER {
- yyMonth = $1;
- yyDay = $3;
- }
- | tUNUMBER '/' tUNUMBER '/' tUNUMBER {
- yyMonth = $1;
- yyDay = $3;
- yyYear = $5;
- }
- | tISOBASE {
+ }
+ ;
+
+zone : tZONE tDST {
+ yyTimezone = $1;
+ yyDSTmode = DSTon;
+ }
+ | tZONE {
+ yyTimezone = $1;
+ yyDSTmode = DSToff;
+ }
+ | tDAYZONE {
+ yyTimezone = $1;
+ yyDSTmode = DSTon;
+ }
+ ;
+
+day : tDAY {
+ yyDayOrdinal = 1;
+ yyDayNumber = $1;
+ }
+ | tDAY ',' {
+ yyDayOrdinal = 1;
+ yyDayNumber = $1;
+ }
+ | tUNUMBER tDAY {
+ yyDayOrdinal = $1;
+ yyDayNumber = $2;
+ }
+ | sign tUNUMBER tDAY {
+ yyDayOrdinal = $1 * $2;
+ yyDayNumber = $3;
+ }
+ | tNEXT tDAY {
+ yyDayOrdinal = 2;
+ yyDayNumber = $2;
+ }
+ ;
+
+date : tUNUMBER '/' tUNUMBER {
+ yyMonth = $1;
+ yyDay = $3;
+ }
+ | tUNUMBER '/' tUNUMBER '/' tUNUMBER {
+ yyMonth = $1;
+ yyDay = $3;
+ yyYear = $5;
+ }
+ | tISOBASE {
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
}
- | tUNUMBER '-' tMONTH '-' tUNUMBER {
+ | tUNUMBER '-' tMONTH '-' tUNUMBER {
yyDay = $1;
yyMonth = $3;
yyYear = $5;
}
- | tUNUMBER '-' tUNUMBER '-' tUNUMBER {
- yyMonth = $3;
- yyDay = $5;
- yyYear = $1;
- }
- | tMONTH tUNUMBER {
- yyMonth = $1;
- yyDay = $2;
- }
- | tMONTH tUNUMBER ',' tUNUMBER {
- yyMonth = $1;
- yyDay = $2;
- yyYear = $4;
- }
- | tUNUMBER tMONTH {
- yyMonth = $2;
- yyDay = $1;
- }
- | tEPOCH {
+ | tUNUMBER '-' tUNUMBER '-' tUNUMBER {
+ yyMonth = $3;
+ yyDay = $5;
+ yyYear = $1;
+ }
+ | tMONTH tUNUMBER {
+ yyMonth = $1;
+ yyDay = $2;
+ }
+ | tMONTH tUNUMBER ',' tUNUMBER {
+ yyMonth = $1;
+ yyDay = $2;
+ yyYear = $4;
+ }
+ | tUNUMBER tMONTH {
+ yyMonth = $2;
+ yyDay = $1;
+ }
+ | tEPOCH {
yyMonth = 1;
yyDay = 1;
yyYear = EPOCH;
}
- | tUNUMBER tMONTH tUNUMBER {
- yyMonth = $2;
- yyDay = $1;
- yyYear = $3;
- }
- ;
+ | tUNUMBER tMONTH tUNUMBER {
+ yyMonth = $2;
+ yyDay = $1;
+ yyYear = $3;
+ }
+ ;
ordMonth: tNEXT tMONTH {
yyMonthOrdinal = 1;
yyMonth = $2;
}
- | tNEXT tUNUMBER tMONTH {
+ | tNEXT tUNUMBER tMONTH {
yyMonthOrdinal = $2;
yyMonth = $3;
}
- ;
+ ;
-iso : tISOBASE tZONE tISOBASE {
- if ($2 != HOUR(- 7)) YYABORT;
+iso : tISOBASE tZONE tISOBASE {
+ if ($2 != HOUR( 7)) YYABORT;
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
yyHour = $3 / 10000;
yyMinutes = ($3 % 10000)/100;
yySeconds = $3 % 100;
- }
- | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
- if ($2 != HOUR(- 7)) YYABORT;
+ }
+ | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
+ if ($2 != HOUR( 7)) YYABORT;
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
yyHour = $3;
yyMinutes = $5;
yySeconds = $7;
- }
+ }
| tISOBASE tISOBASE {
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
@@ -367,21 +411,22 @@ iso : tISOBASE tZONE tISOBASE {
yyHour = $2 / 10000;
yyMinutes = ($2 % 10000)/100;
yySeconds = $2 % 100;
- }
- ;
+ }
+ ;
-trek : tSTARDATE tUNUMBER '.' tUNUMBER {
- /*
- * Offset computed year by -377 so that the returned years will
- * be in a range accessible with a 32 bit clock seconds value
+trek : tSTARDATE tUNUMBER '.' tUNUMBER {
+ /*
+ * Offset computed year by -377 so that the returned years will be
+ * in a range accessible with a 32 bit clock seconds value.
*/
- yyYear = $2/1000 + 2323 - 377;
- yyDay = 1;
+
+ yyYear = $2/1000 + 2323 - 377;
+ yyDay = 1;
yyMonth = 1;
yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000;
yyRelSeconds += $4 * 144 * 60;
- }
- ;
+ }
+ ;
relspec : relunits tAGO {
yyRelSeconds *= -1;
@@ -390,288 +435,340 @@ relspec : relunits tAGO {
}
| relunits
;
-relunits : sign tUNUMBER unit { *yyRelPointer += $1 * $2 * $3; }
- | tUNUMBER unit { *yyRelPointer += $1 * $2; }
- | tNEXT unit { *yyRelPointer += $2; }
- | tNEXT tUNUMBER unit { *yyRelPointer += $2 * $3; }
- | unit { *yyRelPointer += $1; }
- ;
-sign : '-' { $$ = -1; }
- | '+' { $$ = 1; }
- ;
-unit : tSEC_UNIT { $$ = $1; yyRelPointer = &yyRelSeconds; }
- | tDAY_UNIT { $$ = $1; yyRelPointer = &yyRelDay; }
- | tMONTH_UNIT { $$ = $1; yyRelPointer = &yyRelMonth; }
- ;
-
-number : tUNUMBER
- {
- if (yyHaveTime && yyHaveDate && !yyHaveRel) {
- yyYear = $1;
- } else {
- yyHaveTime++;
- if (yyDigitCount <= 2) {
- yyHour = $1;
- yyMinutes = 0;
+
+relunits : sign tUNUMBER unit {
+ *yyRelPointer += $1 * $2 * $3;
+ }
+ | tUNUMBER unit {
+ *yyRelPointer += $1 * $2;
+ }
+ | tNEXT unit {
+ *yyRelPointer += $2;
+ }
+ | tNEXT tUNUMBER unit {
+ *yyRelPointer += $2 * $3;
+ }
+ | unit {
+ *yyRelPointer += $1;
+ }
+ ;
+
+sign : '-' {
+ $$ = -1;
+ }
+ | '+' {
+ $$ = 1;
+ }
+ ;
+
+unit : tSEC_UNIT {
+ $$ = $1;
+ yyRelPointer = &yyRelSeconds;
+ }
+ | tDAY_UNIT {
+ $$ = $1;
+ yyRelPointer = &yyRelDay;
+ }
+ | tMONTH_UNIT {
+ $$ = $1;
+ yyRelPointer = &yyRelMonth;
+ }
+ ;
+
+number : tUNUMBER {
+ if (yyHaveTime && yyHaveDate && !yyHaveRel) {
+ yyYear = $1;
} else {
- yyHour = $1 / 100;
- yyMinutes = $1 % 100;
+ yyHaveTime++;
+ if (yyDigitCount <= 2) {
+ yyHour = $1;
+ yyMinutes = 0;
+ } else {
+ yyHour = $1 / 100;
+ yyMinutes = $1 % 100;
+ }
+ yySeconds = 0;
+ yyMeridian = MER24;
}
- yySeconds = 0;
- yyMeridian = MER24;
}
- }
-;
+ ;
o_merid : /* NULL */ {
- $$ = MER24;
- }
- | tMERIDIAN {
- $$ = $1;
- }
- ;
+ $$ = MER24;
+ }
+ | tMERIDIAN {
+ $$ = $1;
+ }
+ ;
%%
-
/*
* Month and day table.
*/
-static TABLE MonthDayTable[] = {
- { "january", tMONTH, 1 },
- { "february", tMONTH, 2 },
- { "march", tMONTH, 3 },
- { "april", tMONTH, 4 },
- { "may", tMONTH, 5 },
- { "june", tMONTH, 6 },
- { "july", tMONTH, 7 },
- { "august", tMONTH, 8 },
- { "september", tMONTH, 9 },
- { "sept", tMONTH, 9 },
- { "october", tMONTH, 10 },
- { "november", tMONTH, 11 },
- { "december", tMONTH, 12 },
- { "sunday", tDAY, 0 },
- { "monday", tDAY, 1 },
- { "tuesday", tDAY, 2 },
- { "tues", tDAY, 2 },
- { "wednesday", tDAY, 3 },
- { "wednes", tDAY, 3 },
- { "thursday", tDAY, 4 },
- { "thur", tDAY, 4 },
- { "thurs", tDAY, 4 },
- { "friday", tDAY, 5 },
- { "saturday", tDAY, 6 },
- { NULL }
+
+static const TABLE MonthDayTable[] = {
+ { "january", tMONTH, 1 },
+ { "february", tMONTH, 2 },
+ { "march", tMONTH, 3 },
+ { "april", tMONTH, 4 },
+ { "may", tMONTH, 5 },
+ { "june", tMONTH, 6 },
+ { "july", tMONTH, 7 },
+ { "august", tMONTH, 8 },
+ { "september", tMONTH, 9 },
+ { "sept", tMONTH, 9 },
+ { "october", tMONTH, 10 },
+ { "november", tMONTH, 11 },
+ { "december", tMONTH, 12 },
+ { "sunday", tDAY, 0 },
+ { "monday", tDAY, 1 },
+ { "tuesday", tDAY, 2 },
+ { "tues", tDAY, 2 },
+ { "wednesday", tDAY, 3 },
+ { "wednes", tDAY, 3 },
+ { "thursday", tDAY, 4 },
+ { "thur", tDAY, 4 },
+ { "thurs", tDAY, 4 },
+ { "friday", tDAY, 5 },
+ { "saturday", tDAY, 6 },
+ { NULL, 0, 0 }
};
/*
* Time units table.
*/
-static TABLE UnitsTable[] = {
- { "year", tMONTH_UNIT, 12 },
- { "month", tMONTH_UNIT, 1 },
- { "fortnight", tDAY_UNIT, 14 },
- { "week", tDAY_UNIT, 7 },
- { "day", tDAY_UNIT, 1 },
- { "hour", tSEC_UNIT, 60 * 60 },
- { "minute", tSEC_UNIT, 60 },
- { "min", tSEC_UNIT, 60 },
- { "second", tSEC_UNIT, 1 },
- { "sec", tSEC_UNIT, 1 },
- { NULL }
+
+static const TABLE UnitsTable[] = {
+ { "year", tMONTH_UNIT, 12 },
+ { "month", tMONTH_UNIT, 1 },
+ { "fortnight", tDAY_UNIT, 14 },
+ { "week", tDAY_UNIT, 7 },
+ { "day", tDAY_UNIT, 1 },
+ { "hour", tSEC_UNIT, 60 * 60 },
+ { "minute", tSEC_UNIT, 60 },
+ { "min", tSEC_UNIT, 60 },
+ { "second", tSEC_UNIT, 1 },
+ { "sec", tSEC_UNIT, 1 },
+ { NULL, 0, 0 }
};
/*
* Assorted relative-time words.
*/
-static TABLE OtherTable[] = {
- { "tomorrow", tDAY_UNIT, 1 },
- { "yesterday", tDAY_UNIT, -1 },
- { "today", tDAY_UNIT, 0 },
- { "now", tSEC_UNIT, 0 },
- { "last", tUNUMBER, -1 },
- { "this", tSEC_UNIT, 0 },
- { "next", tNEXT, 1 },
+
+static const TABLE OtherTable[] = {
+ { "tomorrow", tDAY_UNIT, 1 },
+ { "yesterday", tDAY_UNIT, -1 },
+ { "today", tDAY_UNIT, 0 },
+ { "now", tSEC_UNIT, 0 },
+ { "last", tUNUMBER, -1 },
+ { "this", tSEC_UNIT, 0 },
+ { "next", tNEXT, 1 },
#if 0
- { "first", tUNUMBER, 1 },
- { "second", tUNUMBER, 2 },
- { "third", tUNUMBER, 3 },
- { "fourth", tUNUMBER, 4 },
- { "fifth", tUNUMBER, 5 },
- { "sixth", tUNUMBER, 6 },
- { "seventh", tUNUMBER, 7 },
- { "eighth", tUNUMBER, 8 },
- { "ninth", tUNUMBER, 9 },
- { "tenth", tUNUMBER, 10 },
- { "eleventh", tUNUMBER, 11 },
- { "twelfth", tUNUMBER, 12 },
+ { "first", tUNUMBER, 1 },
+ { "second", tUNUMBER, 2 },
+ { "third", tUNUMBER, 3 },
+ { "fourth", tUNUMBER, 4 },
+ { "fifth", tUNUMBER, 5 },
+ { "sixth", tUNUMBER, 6 },
+ { "seventh", tUNUMBER, 7 },
+ { "eighth", tUNUMBER, 8 },
+ { "ninth", tUNUMBER, 9 },
+ { "tenth", tUNUMBER, 10 },
+ { "eleventh", tUNUMBER, 11 },
+ { "twelfth", tUNUMBER, 12 },
#endif
- { "ago", tAGO, 1 },
- { "epoch", tEPOCH, 0 },
- { "stardate", tSTARDATE, 0},
- { NULL }
+ { "ago", tAGO, 1 },
+ { "epoch", tEPOCH, 0 },
+ { "stardate", tSTARDATE, 0 },
+ { NULL, 0, 0 }
};
/*
- * The timezone table. (Note: This table was modified to not use any floating
+ * The timezone table. (Note: This table was modified to not use any floating
* point constants to work around an SGI compiler bug).
*/
-static TABLE TimezoneTable[] = {
- { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
- { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
- { "utc", tZONE, HOUR( 0) },
- { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
- { "wet", tZONE, HOUR( 0) }, /* Western European */
- { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
- { "wat", tZONE, HOUR( 1) }, /* West Africa */
- { "at", tZONE, HOUR( 2) }, /* Azores */
-#if 0
+
+static const TABLE TimezoneTable[] = {
+ { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
+ { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
+ { "utc", tZONE, HOUR( 0) },
+ { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
+ { "wet", tZONE, HOUR( 0) }, /* Western European */
+ { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
+ { "wat", tZONE, HOUR( 1) }, /* West Africa */
+ { "at", tZONE, HOUR( 2) }, /* Azores */
+#if 0
/* For completeness. BST is also British Summer, and GST is
* also Guam Standard. */
- { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */
- { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */
+ { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */
+ { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */
#endif
- { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */
- { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */
- { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */
- { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */
- { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */
- { "est", tZONE, HOUR( 5) }, /* Eastern Standard */
- { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */
- { "cst", tZONE, HOUR( 6) }, /* Central Standard */
- { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */
- { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */
- { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */
- { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */
- { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
- { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
- { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
- { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
- { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
- { "cat", tZONE, HOUR(10) }, /* Central Alaska */
- { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */
- { "nt", tZONE, HOUR(11) }, /* Nome */
- { "idlw", tZONE, HOUR(12) }, /* International Date Line West */
- { "cet", tZONE, -HOUR( 1) }, /* Central European */
- { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
- { "met", tZONE, -HOUR( 1) }, /* Middle European */
- { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
- { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
- { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */
- { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */
- { "fwt", tZONE, -HOUR( 1) }, /* French Winter */
- { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */
- { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */
- { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */
- { "it", tZONE, -HOUR( 7/2) }, /* Iran */
- { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */
- { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */
- { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */
- { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */
-#if 0
+ { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */
+ { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */
+ { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */
+ { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */
+ { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */
+ { "est", tZONE, HOUR( 5) }, /* Eastern Standard */
+ { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */
+ { "cst", tZONE, HOUR( 6) }, /* Central Standard */
+ { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */
+ { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */
+ { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */
+ { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */
+ { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
+ { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
+ { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
+ { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
+ { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
+ { "cat", tZONE, HOUR(10) }, /* Central Alaska */
+ { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */
+ { "nt", tZONE, HOUR(11) }, /* Nome */
+ { "idlw", tZONE, HOUR(12) }, /* International Date Line West */
+ { "cet", tZONE, -HOUR( 1) }, /* Central European */
+ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
+ { "met", tZONE, -HOUR( 1) }, /* Middle European */
+ { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
+ { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
+ { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */
+ { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */
+ { "fwt", tZONE, -HOUR( 1) }, /* French Winter */
+ { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */
+ { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */
+ { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */
+ { "it", tZONE, -HOUR( 7/2) }, /* Iran */
+ { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */
+ { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */
+ { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */
+ { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */
+#if 0
/* For completeness. NST is also Newfoundland Stanard, nad SST is
* also Swedish Summer. */
- { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */
- { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */
-#endif /* 0 */
- { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */
- { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */
- { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
- { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
- { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */
- { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */
- { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */
- { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */
- { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */
- { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */
- { "nzt", tZONE, -HOUR(12) }, /* New Zealand */
- { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
- { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */
- { "idle", tZONE, -HOUR(12) }, /* International Date Line East */
+ { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */
+ { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */
+#endif /* 0 */
+ { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */
+ { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */
+ { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
+ { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
+ { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */
+ { "jdt", tDAYZONE, -HOUR( 9) }, /* Japan Daylight */
+ { "kst", tZONE, -HOUR( 9) }, /* Korea Standard */
+ { "kdt", tDAYZONE, -HOUR( 9) }, /* Korea Daylight */
+ { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */
+ { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */
+ { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */
+ { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */
+ { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */
+ { "nzt", tZONE, -HOUR(12) }, /* New Zealand */
+ { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */
+ { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */
+ { "idle", tZONE, -HOUR(12) }, /* International Date Line East */
/* ADDED BY Marco Nijdam */
- { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */
+ { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */
/* End ADDED */
- { NULL }
+ { NULL, 0, 0 }
};
/*
* Military timezone table.
*/
-static TABLE MilitaryTable[] = {
- { "a", tZONE, HOUR( 1) },
- { "b", tZONE, HOUR( 2) },
- { "c", tZONE, HOUR( 3) },
- { "d", tZONE, HOUR( 4) },
- { "e", tZONE, HOUR( 5) },
- { "f", tZONE, HOUR( 6) },
- { "g", tZONE, HOUR( 7) },
- { "h", tZONE, HOUR( 8) },
- { "i", tZONE, HOUR( 9) },
- { "k", tZONE, HOUR( 10) },
- { "l", tZONE, HOUR( 11) },
- { "m", tZONE, HOUR( 12) },
- { "n", tZONE, HOUR(- 1) },
- { "o", tZONE, HOUR(- 2) },
- { "p", tZONE, HOUR(- 3) },
- { "q", tZONE, HOUR(- 4) },
- { "r", tZONE, HOUR(- 5) },
- { "s", tZONE, HOUR(- 6) },
- { "t", tZONE, HOUR(- 7) },
- { "u", tZONE, HOUR(- 8) },
- { "v", tZONE, HOUR(- 9) },
- { "w", tZONE, HOUR(-10) },
- { "x", tZONE, HOUR(-11) },
- { "y", tZONE, HOUR(-12) },
- { "z", tZONE, HOUR( 0) },
- { NULL }
-};
+static const TABLE MilitaryTable[] = {
+ { "a", tZONE, -HOUR( 1) },
+ { "b", tZONE, -HOUR( 2) },
+ { "c", tZONE, -HOUR( 3) },
+ { "d", tZONE, -HOUR( 4) },
+ { "e", tZONE, -HOUR( 5) },
+ { "f", tZONE, -HOUR( 6) },
+ { "g", tZONE, -HOUR( 7) },
+ { "h", tZONE, -HOUR( 8) },
+ { "i", tZONE, -HOUR( 9) },
+ { "k", tZONE, -HOUR(10) },
+ { "l", tZONE, -HOUR(11) },
+ { "m", tZONE, -HOUR(12) },
+ { "n", tZONE, HOUR( 1) },
+ { "o", tZONE, HOUR( 2) },
+ { "p", tZONE, HOUR( 3) },
+ { "q", tZONE, HOUR( 4) },
+ { "r", tZONE, HOUR( 5) },
+ { "s", tZONE, HOUR( 6) },
+ { "t", tZONE, HOUR( 7) },
+ { "u", tZONE, HOUR( 8) },
+ { "v", tZONE, HOUR( 9) },
+ { "w", tZONE, HOUR( 10) },
+ { "x", tZONE, HOUR( 11) },
+ { "y", tZONE, HOUR( 12) },
+ { "z", tZONE, HOUR( 0) },
+ { NULL, 0, 0 }
+};
/*
* Dump error messages in the bit bucket.
*/
+
static void
-TclDateerror(s)
- char *s;
+TclDateerror(
+ YYLTYPE* location,
+ DateInfo* infoPtr,
+ const char *s)
{
+ Tcl_Obj* t;
+ Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
+ Tcl_AppendToObj(infoPtr->messages, s, -1);
+ Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
+ t = Tcl_NewIntObj(location->first_column);
+ Tcl_IncrRefCount(t);
+ Tcl_AppendObjToObj(infoPtr->messages, t);
+ Tcl_DecrRefCount(t);
+ Tcl_AppendToObj(infoPtr->messages, "-", -1);
+ t = Tcl_NewIntObj(location->last_column);
+ Tcl_IncrRefCount(t);
+ Tcl_AppendObjToObj(infoPtr->messages, t);
+ Tcl_DecrRefCount(t);
+ Tcl_AppendToObj(infoPtr->messages, ")", -1);
+ infoPtr->separatrix = "\n";
}
static time_t
-ToSeconds(Hours, Minutes, Seconds, Meridian)
- time_t Hours;
- time_t Minutes;
- time_t Seconds;
- MERIDIAN Meridian;
+ToSeconds(
+ time_t Hours,
+ time_t Minutes,
+ time_t Seconds,
+ MERIDIAN Meridian)
{
- if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
- return -1;
+ if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
+ return -1;
+ }
switch (Meridian) {
case MER24:
- if (Hours < 0 || Hours > 23)
- return -1;
- return (Hours * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 0 || Hours > 23) {
+ return -1;
+ }
+ return (Hours * 60L + Minutes) * 60L + Seconds;
case MERam:
- if (Hours < 1 || Hours > 12)
- return -1;
- return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 1 || Hours > 12) {
+ return -1;
+ }
+ return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
case MERpm:
- if (Hours < 1 || Hours > 12)
- return -1;
- return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
+ if (Hours < 1 || Hours > 12) {
+ return -1;
+ }
+ return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
}
- return -1; /* Should never be reached */
+ return -1; /* Should never be reached */
}
-
static int
-LookupWord(buff)
- char *buff;
+LookupWord(
+ YYSTYPE* yylvalPtr,
+ char *buff)
{
register char *p;
register char *q;
- register TABLE *tp;
- int i;
- int abbrev;
+ register const TABLE *tp;
+ int i, abbrev;
/*
* Make it lowercase.
@@ -680,192 +777,213 @@ LookupWord(buff)
Tcl_UtfToLower(buff);
if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
- yylval.Meridian = MERam;
- return tMERIDIAN;
+ yylvalPtr->Meridian = MERam;
+ return tMERIDIAN;
}
if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
- yylval.Meridian = MERpm;
- return tMERIDIAN;
+ yylvalPtr->Meridian = MERpm;
+ return tMERIDIAN;
}
/*
* See if we have an abbreviation for a month.
*/
+
if (strlen(buff) == 3) {
- abbrev = 1;
+ abbrev = 1;
} else if (strlen(buff) == 4 && buff[3] == '.') {
- abbrev = 1;
- buff[3] = '\0';
+ abbrev = 1;
+ buff[3] = '\0';
} else {
- abbrev = 0;
+ abbrev = 0;
}
for (tp = MonthDayTable; tp->name; tp++) {
- if (abbrev) {
- if (strncmp(buff, tp->name, 3) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
- } else if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (abbrev) {
+ if (strncmp(buff, tp->name, 3) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
+ } else if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
for (tp = TimezoneTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
for (tp = UnitsTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
/*
* Strip off any plural and try the units table again.
*/
+
i = strlen(buff) - 1;
- if (buff[i] == 's') {
- buff[i] = '\0';
- for (tp = UnitsTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (i > 0 && buff[i] == 's') {
+ buff[i] = '\0';
+ for (tp = UnitsTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
for (tp = OtherTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
/*
* Military timezones.
*/
+
if (buff[1] == '\0' && !(*buff & 0x80)
- && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
- for (tp = MilitaryTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
+ for (tp = MilitaryTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
/*
* Drop out any periods and try the timezone table again.
*/
- for (i = 0, p = q = buff; *q; q++)
- if (*q != '.') {
- *p++ = *q;
- } else {
- i++;
+
+ for (i = 0, p = q = buff; *q; q++) {
+ if (*q != '.') {
+ *p++ = *q;
+ } else {
+ i++;
}
+ }
*p = '\0';
if (i) {
- for (tp = TimezoneTable; tp->name; tp++) {
- if (strcmp(buff, tp->name) == 0) {
- yylval.Number = tp->value;
- return tp->type;
- }
+ for (tp = TimezoneTable; tp->name; tp++) {
+ if (strcmp(buff, tp->name) == 0) {
+ yylvalPtr->Number = tp->value;
+ return tp->type;
+ }
}
}
-
+
return tID;
}
static int
-TclDatelex( void* info )
+TclDatelex(
+ YYSTYPE* yylvalPtr,
+ YYLTYPE* location,
+ DateInfo *info)
{
- register char c;
- register char *p;
- char buff[20];
- int Count;
+ register char c;
+ register char *p;
+ char buff[20];
+ int Count;
+ location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (isspace(UCHAR(*yyInput))) {
- yyInput++;
+ while (isspace(UCHAR(*yyInput))) {
+ yyInput++;
}
- if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
- /* convert the string into a number; count the number of digits */
+ if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+ /*
+ * Convert the string into a number; count the number of digits.
+ */
+
Count = 0;
- for (yylval.Number = 0;
- isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
- yylval.Number = 10 * yylval.Number + c - '0';
+ for (yylvalPtr->Number = 0;
+ isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
+ yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
Count++;
}
- yyInput--;
+ yyInput--;
yyDigitCount = Count;
- /* A number with 6 or more digits is considered an ISO 8601 base */
+
+ /*
+ * A number with 6 or more digits is considered an ISO 8601 base.
+ */
+
if (Count >= 6) {
+ location->last_column = yyInput - info->dateStart - 1;
return tISOBASE;
} else {
+ location->last_column = yyInput - info->dateStart - 1;
return tUNUMBER;
}
- }
- if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
- for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
+ }
+ if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
|| c == '.'; ) {
- if (p < &buff[sizeof buff - 1]) {
- *p++ = c;
+ if (p < &buff[sizeof buff - 1]) {
+ *p++ = c;
}
}
- *p = '\0';
- yyInput--;
- return LookupWord(buff);
- }
- if (c != '(') {
- return *yyInput++;
- }
- Count = 0;
- do {
- c = *yyInput++;
- if (c == '\0') {
- return c;
+ *p = '\0';
+ yyInput--;
+ location->last_column = yyInput - info->dateStart - 1;
+ return LookupWord(yylvalPtr, buff);
+ }
+ if (c != '(') {
+ location->last_column = yyInput - info->dateStart;
+ return *yyInput++;
+ }
+ Count = 0;
+ do {
+ c = *yyInput++;
+ if (c == '\0') {
+ location->last_column = yyInput - info->dateStart - 1;
+ return c;
} else if (c == '(') {
- Count++;
+ Count++;
} else if (c == ')') {
- Count--;
+ Count--;
}
- } while (Count > 0);
+ } while (Count > 0);
}
}
int
-TclClockOldscanObjCmd( clientData, interp, objc, objv )
- ClientData clientData; /* Unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Count of paraneters */
- Tcl_Obj *CONST *objv; /* Parameters */
+TclClockOldscanObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Count of paraneters */
+ Tcl_Obj *const *objv) /* Parameters */
{
-
- Tcl_Obj* result;
- Tcl_Obj* resultElement;
+ Tcl_Obj *result, *resultElement;
int yr, mo, da;
DateInfo dateInfo;
- void* info = (void*) &dateInfo;
+ DateInfo* info = &dateInfo;
+ int status;
- if ( objc != 5 ) {
- Tcl_WrongNumArgs( interp, 1, objv,
- "stringToParse baseYear baseMonth baseDay" );
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "stringToParse baseYear baseMonth baseDay" );
return TCL_ERROR;
}
yyInput = Tcl_GetString( objv[1] );
+ dateInfo.dateStart = yyInput;
yyHaveDate = 0;
- if ( Tcl_GetIntFromObj( interp, objv[2], &yr ) != TCL_OK
- || Tcl_GetIntFromObj( interp, objv[3], &mo ) != TCL_OK
- || Tcl_GetIntFromObj( interp, objv[4], &da ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
return TCL_ERROR;
}
yyYear = yr; yyMonth = mo; yyDay = da;
@@ -885,102 +1003,128 @@ TclClockOldscanObjCmd( clientData, interp, objc, objv )
yyHaveRel = 0;
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
- if ( yyparse( info ) ) {
- Tcl_SetObjResult( interp, Tcl_NewStringObj( "syntax error", -1 ) );
+ dateInfo.messages = Tcl_NewObj();
+ dateInfo.separatrix = "";
+ Tcl_IncrRefCount(dateInfo.messages);
+
+ status = yyparse(&dateInfo);
+ 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 "
+ "from date parser. Please "
+ "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);
- if ( yyHaveDate > 1 ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj( "more than one date in string", -1 ) );
+ 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 ) );
+ 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 ) );
+ 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 ) );
+ 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 ) );
+ 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;
}
-
+
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
- if ( yyHaveDate ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyYear ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonth ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDay ) );
+ if (yyHaveDate) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyYear));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonth));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDay));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
-
- if ( yyHaveTime ) {
- Tcl_ListObjAppendElement( interp, result,
- Tcl_NewIntObj( ToSeconds( yyHour,
- yyMinutes,
- yySeconds,
- yyMeridian ) ) );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
+
+ if (yyHaveTime) {
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
+ ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
} else {
- Tcl_ListObjAppendElement( interp, result, Tcl_NewObj() );
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
}
resultElement = Tcl_NewObj();
- if ( yyHaveZone ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( -yyTimezone ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( 1-yyDSTmode ) );
+ if (yyHaveZone) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) -yyTimezone));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj(1 - yyDSTmode));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveRel ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelMonth ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelDay ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyRelSeconds ) );
+ if (yyHaveRel) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelMonth));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelDay));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyRelSeconds));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveDay && !yyHaveDate ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDayOrdinal ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyDayNumber ) );
+ if (yyHaveDay && !yyHaveDate) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDayOrdinal));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyDayNumber));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
- if ( yyHaveOrdinalMonth ) {
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonthOrdinal ) );
- Tcl_ListObjAppendElement( interp, resultElement,
- Tcl_NewIntObj( yyMonth ) );
+ if (yyHaveOrdinalMonth) {
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonthOrdinal));
+ Tcl_ListObjAppendElement(interp, resultElement,
+ Tcl_NewIntObj((int) yyMonth));
}
- Tcl_ListObjAppendElement( interp, result, resultElement );
-
- Tcl_SetObjResult( interp, result );
+ Tcl_ListObjAppendElement(interp, result, resultElement);
+
+ Tcl_SetObjResult(interp, result);
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 861eb47..90be511 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclHash.c --
*
* Implementation of in-memory hash tables for Tcl and Tcl-based
@@ -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.23 2005/07/21 14:38:32 dkf Exp $
*/
#include "tclInt.h"
@@ -19,10 +17,8 @@
* Prevent macros from clashing with function definitions.
*/
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-# undef Tcl_FindHashEntry
-# undef Tcl_CreateHashEntry
-#endif
+#undef Tcl_FindHashEntry
+#undef Tcl_CreateHashEntry
/*
* When there are this many entries per bucket, on average, rebuild the hash
@@ -39,57 +35,51 @@
*/
#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.
*/
-static Tcl_HashEntry * AllocArrayEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareArrayKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int HashArrayKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
+static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
+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
-static Tcl_HashEntry * AllocOneWordEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareOneWordKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int HashOneWordKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
+static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr,
+ void *keyPtr);
+static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
#endif
/*
* Prototypes for the string hash key methods.
*/
-static Tcl_HashEntry * AllocStringEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareStringKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int HashStringKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
+static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr,
+ void *keyPtr);
+static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Function prototypes for static functions in this file:
*/
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-static Tcl_HashEntry * BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key));
-static Tcl_HashEntry * BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr));
-#endif
-
-static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const char *key);
+static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const char *key,
+ int *newPtr);
+static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
+ int *newPtr);
+static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
+static void RebuildTable(Tcl_HashTable *tablePtr);
-Tcl_HashKeyType tclArrayHashKeyType = {
+const Tcl_HashKeyType tclArrayHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */
HashArrayKey, /* hashKeyProc */
@@ -98,7 +88,7 @@ Tcl_HashKeyType tclArrayHashKeyType = {
NULL /* freeEntryProc */
};
-Tcl_HashKeyType tclOneWordHashKeyType = {
+const Tcl_HashKeyType tclOneWordHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
0, /* flags */
NULL, /* HashOneWordKey, */ /* hashProc */
@@ -107,7 +97,7 @@ Tcl_HashKeyType tclOneWordHashKeyType = {
NULL /* FreeOneWordKey, */ /* freeEntryProc */
};
-Tcl_HashKeyType tclStringHashKeyType = {
+const Tcl_HashKeyType tclStringHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
0, /* flags */
HashStringKey, /* hashKeyProc */
@@ -134,14 +124,14 @@ Tcl_HashKeyType tclStringHashKeyType = {
*----------------------------------------------------------------------
*/
-#undef Tcl_InitHashTable
void
-Tcl_InitHashTable(tablePtr, keyType)
- register Tcl_HashTable *tablePtr; /* Pointer to table record, which is
- * supplied by the caller. */
- int keyType; /* Type of keys to use in table:
- * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
- * or an integer >= 2. */
+Tcl_InitHashTable(
+ register Tcl_HashTable *tablePtr,
+ /* Pointer to table record, which is supplied
+ * by the caller. */
+ int keyType) /* Type of keys to use in table:
+ * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
+ * integer >= 2. */
{
/*
* Use a special value to inform the extended version that it must not
@@ -150,7 +140,7 @@ Tcl_InitHashTable(tablePtr, keyType)
* extended version by a macro.
*/
- Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
+ Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1);
}
/*
@@ -173,22 +163,22 @@ Tcl_InitHashTable(tablePtr, keyType)
*/
void
-Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
- register Tcl_HashTable *tablePtr; /* Pointer to table record, which is
- * supplied by the caller. */
- int keyType; /* Type of keys to use in table:
- * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
- * TCL_CUSTOM_TYPE_KEYS,
- * TCL_CUSTOM_PTR_KEYS, or an integer
- * >= 2. */
- Tcl_HashKeyType *typePtr; /* Pointer to structure which defines
- * the behaviour of this table. */
+Tcl_InitCustomHashTable(
+ register Tcl_HashTable *tablePtr,
+ /* Pointer to table record, which is supplied
+ * by the caller. */
+ int keyType, /* Type of keys to use in table:
+ * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
+ * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS,
+ * or an integer >= 2. */
+ const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
+ * behaviour of this table. */
{
-#if (TCL_SMALL_HASH_TABLE != 4)
- Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+#if (TCL_SMALL_HASH_TABLE != 4)
+ Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
TCL_SMALL_HASH_TABLE);
#endif
-
+
tablePtr->buckets = tablePtr->staticBuckets;
tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
@@ -198,9 +188,8 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
- tablePtr->findProc = Tcl_FindHashEntry;
- tablePtr->createProc = Tcl_CreateHashEntry;
+ tablePtr->findProc = FindHashEntry;
+ tablePtr->createProc = CreateHashEntry;
if (typePtr == NULL) {
/*
@@ -219,33 +208,6 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
* The caller has not been rebuilt so the hash table is not extended.
*/
}
-#else
- if (typePtr == NULL) {
- /*
- * Use the key type to decide which key type is needed.
- */
-
- if (keyType == TCL_STRING_KEYS) {
- typePtr = &tclStringHashKeyType;
- } else if (keyType == TCL_ONE_WORD_KEYS) {
- typePtr = &tclOneWordHashKeyType;
- } else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
- Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
- } else if (keyType == TCL_CUSTOM_PTR_KEYS) {
- Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
- } else {
- typePtr = &tclArrayHashKeyType;
- }
- } else if (typePtr == (Tcl_HashKeyType *) -1) {
- /*
- * If the caller has not been rebuilt then we cannot continue as the
- * hash table is not an extended version.
- */
-
- Tcl_Panic("Hash table is not compatible");
- }
- tablePtr->typePtr = typePtr;
-#endif
}
/*
@@ -266,79 +228,21 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
*/
Tcl_HashEntry *
-Tcl_FindHashEntry(tablePtr, key)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find matching entry. */
+Tcl_FindHashEntry(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const void *key) /* Key to use to find matching entry. */
{
- register Tcl_HashEntry *hPtr;
- Tcl_HashKeyType *typePtr;
- unsigned int hash;
- int index;
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
- if (tablePtr->keyType == TCL_STRING_KEYS) {
- typePtr = &tclStringHashKeyType;
- } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
- typePtr = &tclOneWordHashKeyType;
- } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
- || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
- typePtr = tablePtr->typePtr;
- } else {
- typePtr = &tclArrayHashKeyType;
- }
-#else
- typePtr = tablePtr->typePtr;
- if (typePtr == NULL) {
- Tcl_Panic("called Tcl_FindHashEntry on deleted table");
- return NULL;
- }
-#endif
-
- if (typePtr->hashKeyProc) {
- hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
- if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX (tablePtr, hash);
- } else {
- index = hash & tablePtr->mask;
- }
- } else {
- hash = (unsigned int) key;
- index = RANDOM_INDEX (tablePtr, hash);
- }
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
+ return (*((tablePtr)->findProc))(tablePtr, key);
+}
- if (typePtr->compareKeysProc) {
- Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
- if (hash != (unsigned int) hPtr->hash) {
- continue;
- }
-#endif
- if (compareKeysProc ((VOID *) key, hPtr)) {
- return hPtr;
- }
- }
- } else {
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
- if (hash != (unsigned int) hPtr->hash) {
- continue;
- }
-#endif
- if (key == hPtr->key.oneWordValue) {
- return hPtr;
- }
- }
- }
-
- return NULL;
+static Tcl_HashEntry *
+FindHashEntry(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const char *key) /* Key to use to find matching entry. */
+{
+ return CreateHashEntry(tablePtr, key, NULL);
}
+
/*
*----------------------------------------------------------------------
@@ -362,19 +266,29 @@ Tcl_FindHashEntry(tablePtr, key)
*/
Tcl_HashEntry *
-Tcl_CreateHashEntry(tablePtr, key, newPtr)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find or create matching
+Tcl_CreateHashEntry(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const void *key, /* Key to use to find or create matching
+ * entry. */
+ int *newPtr) /* Store info here telling whether a new entry
+ * was created. */
+{
+ return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
+}
+
+static Tcl_HashEntry *
+CreateHashEntry(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const char *key, /* Key to use to find or create matching
* entry. */
- int *newPtr; /* Store info here telling whether a new entry
+ int *newPtr) /* Store info here telling whether a new entry
* was created. */
{
register Tcl_HashEntry *hPtr;
- Tcl_HashKeyType *typePtr;
+ const Tcl_HashKeyType *typePtr;
unsigned int hash;
int index;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -385,24 +299,17 @@ Tcl_CreateHashEntry(tablePtr, key, newPtr)
} else {
typePtr = &tclArrayHashKeyType;
}
-#else
- typePtr = tablePtr->typePtr;
- if (typePtr == NULL) {
- Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
- return NULL;
- }
-#endif
if (typePtr->hashKeyProc) {
- hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
+ hash = typePtr->hashKeyProc(tablePtr, (void *) key);
if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX (tablePtr, hash);
+ index = RANDOM_INDEX(tablePtr, hash);
} else {
index = hash & tablePtr->mask;
}
} else {
- hash = (unsigned int) key;
- index = RANDOM_INDEX (tablePtr, hash);
+ hash = PTR2UINT(key);
+ index = RANDOM_INDEX(tablePtr, hash);
}
/*
@@ -411,15 +318,18 @@ Tcl_CreateHashEntry(tablePtr, key, newPtr)
if (typePtr->compareKeysProc) {
Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
+
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
- if (hash != (unsigned int) hPtr->hash) {
+ if (hash != PTR2UINT(hPtr->hash)) {
continue;
}
#endif
- if (compareKeysProc ((VOID *) key, hPtr)) {
- *newPtr = 0;
+ if (compareKeysProc((void *) key, hPtr)) {
+ if (newPtr) {
+ *newPtr = 0;
+ }
return hPtr;
}
}
@@ -427,44 +337,46 @@ Tcl_CreateHashEntry(tablePtr, key, newPtr)
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
- if (hash != (unsigned int) hPtr->hash) {
+ if (hash != PTR2UINT(hPtr->hash)) {
continue;
}
#endif
if (key == hPtr->key.oneWordValue) {
- *newPtr = 0;
+ if (newPtr) {
+ *newPtr = 0;
+ }
return hPtr;
}
}
}
+ if (!newPtr) {
+ return NULL;
+ }
+
/*
* Entry not found. Add a new one to the bucket.
*/
*newPtr = 1;
if (typePtr->allocEntryProc) {
- hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
+ 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;
}
-
+
hPtr->tablePtr = tablePtr;
#if TCL_HASH_KEY_STORE_HASH
-# if TCL_PRESERVE_BINARY_COMPATABILITY
- hPtr->hash = (VOID *) hash;
-# else
- hPtr->hash = hash;
-# endif
+ hPtr->hash = UINT2PTR(hash);
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
#else
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
+ hPtr->bucketPtr = &tablePtr->buckets[index];
hPtr->nextPtr = *hPtr->bucketPtr;
*hPtr->bucketPtr = hPtr;
#endif
- hPtr->clientData = 0;
tablePtr->numEntries++;
/*
@@ -497,11 +409,11 @@ Tcl_CreateHashEntry(tablePtr, key, newPtr)
*/
void
-Tcl_DeleteHashEntry(entryPtr)
- Tcl_HashEntry *entryPtr;
+Tcl_DeleteHashEntry(
+ Tcl_HashEntry *entryPtr)
{
register Tcl_HashEntry *prevPtr;
- Tcl_HashKeyType *typePtr;
+ const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
#if TCL_HASH_KEY_STORE_HASH
@@ -510,7 +422,6 @@ Tcl_DeleteHashEntry(entryPtr)
tablePtr = entryPtr->tablePtr;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -521,23 +432,20 @@ Tcl_DeleteHashEntry(entryPtr)
} else {
typePtr = &tclArrayHashKeyType;
}
-#else
- typePtr = tablePtr->typePtr;
-#endif
-
+
#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 = ((unsigned int) entryPtr->hash) & tablePtr->mask;
+ index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
}
- bucketPtr = &(tablePtr->buckets[index]);
+ bucketPtr = &tablePtr->buckets[index];
#else
bucketPtr = entryPtr->bucketPtr;
#endif
-
+
if (*bucketPtr == entryPtr) {
*bucketPtr = entryPtr->nextPtr;
} else {
@@ -554,9 +462,9 @@ Tcl_DeleteHashEntry(entryPtr)
tablePtr->numEntries--;
if (typePtr->freeEntryProc) {
- typePtr->freeEntryProc (entryPtr);
+ typePtr->freeEntryProc(entryPtr);
} else {
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
}
}
@@ -578,14 +486,13 @@ Tcl_DeleteHashEntry(entryPtr)
*/
void
-Tcl_DeleteHashTable(tablePtr)
- register Tcl_HashTable *tablePtr; /* Table to delete. */
+Tcl_DeleteHashTable(
+ register Tcl_HashTable *tablePtr) /* Table to delete. */
{
register Tcl_HashEntry *hPtr, *nextPtr;
- Tcl_HashKeyType *typePtr;
+ const Tcl_HashKeyType *typePtr;
int i;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -596,9 +503,6 @@ Tcl_DeleteHashTable(tablePtr)
} else {
typePtr = &tclArrayHashKeyType;
}
-#else
- typePtr = tablePtr->typePtr;
-#endif
/*
* Free up all the entries in the table.
@@ -609,9 +513,9 @@ Tcl_DeleteHashTable(tablePtr)
while (hPtr != NULL) {
nextPtr = hPtr->nextPtr;
if (typePtr->freeEntryProc) {
- typePtr->freeEntryProc (hPtr);
+ typePtr->freeEntryProc(hPtr);
} else {
- ckfree((char *) hPtr);
+ ckfree(hPtr);
}
hPtr = nextPtr;
}
@@ -625,7 +529,7 @@ Tcl_DeleteHashTable(tablePtr)
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
TclpSysFree((char *) tablePtr->buckets);
} else {
- ckfree((char *) tablePtr->buckets);
+ ckfree(tablePtr->buckets);
}
}
@@ -634,12 +538,8 @@ Tcl_DeleteHashTable(tablePtr)
* re-initialization.
*/
-#if TCL_PRESERVE_BINARY_COMPATABILITY
tablePtr->findProc = BogusFind;
tablePtr->createProc = BogusCreate;
-#else
- tablePtr->typePtr = NULL;
-#endif
}
/*
@@ -663,9 +563,9 @@ Tcl_DeleteHashTable(tablePtr)
*/
Tcl_HashEntry *
-Tcl_FirstHashEntry(tablePtr, searchPtr)
- Tcl_HashTable *tablePtr; /* Table to search. */
- Tcl_HashSearch *searchPtr; /* Place to store information about progress
+Tcl_FirstHashEntry(
+ Tcl_HashTable *tablePtr, /* Table to search. */
+ Tcl_HashSearch *searchPtr) /* Place to store information about progress
* through the table. */
{
searchPtr->tablePtr = tablePtr;
@@ -694,8 +594,8 @@ Tcl_FirstHashEntry(tablePtr, searchPtr)
*/
Tcl_HashEntry *
-Tcl_NextHashEntry(searchPtr)
- register Tcl_HashSearch *searchPtr;
+Tcl_NextHashEntry(
+ register Tcl_HashSearch *searchPtr)
/* Place to store information about progress
* through the table. Must have been
* initialized by calling
@@ -735,35 +635,15 @@ Tcl_NextHashEntry(searchPtr)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_HashStats(tablePtr)
- Tcl_HashTable *tablePtr; /* Table for which to produce stats. */
+char *
+Tcl_HashStats(
+ Tcl_HashTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
int count[NUM_COUNTERS], overflow, i, j;
double average, tmp;
register Tcl_HashEntry *hPtr;
char *result, *p;
- Tcl_HashKeyType *typePtr;
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
- if (tablePtr->keyType == TCL_STRING_KEYS) {
- typePtr = &tclStringHashKeyType;
- } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
- typePtr = &tclOneWordHashKeyType;
- } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
- || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
- typePtr = tablePtr->typePtr;
- } else {
- typePtr = &tclArrayHashKeyType;
- }
-#else
- typePtr = tablePtr->typePtr;
- if (typePtr == NULL) {
- Tcl_Panic("called Tcl_HashStats on deleted table");
- return NULL;
- }
-#endif
/*
* Compute a histogram of bucket usage.
@@ -794,11 +674,7 @@ Tcl_HashStats(tablePtr)
* Print out the histogram and a few other pieces of information.
*/
- if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
- result = (char *) TclpSysAlloc((unsigned) (NUM_COUNTERS*60) + 300, 0);
- } else {
- 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);
@@ -831,9 +707,9 @@ Tcl_HashStats(tablePtr)
*/
static Tcl_HashEntry *
-AllocArrayEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key to store in the hash table entry. */
+AllocArrayEntry(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
int *array = (int *) keyPtr;
register int *iPtr1, *iPtr2;
@@ -847,12 +723,13 @@ AllocArrayEntry(tablePtr, keyPtr)
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++) {
*iPtr2 = *iPtr1;
}
+ hPtr->clientData = 0;
return hPtr;
}
@@ -875,12 +752,12 @@ AllocArrayEntry(tablePtr, keyPtr)
*/
static int
-CompareArrayKeys(keyPtr, hPtr)
- VOID *keyPtr; /* New key to compare. */
- Tcl_HashEntry *hPtr; /* Existing key to compare. */
+CompareArrayKeys(
+ void *keyPtr, /* New key to compare. */
+ Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- register CONST int *iPtr1 = (CONST int *) keyPtr;
- register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
+ register const int *iPtr1 = (const int *) keyPtr;
+ register const int *iPtr2 = (const int *) hPtr->key.words;
Tcl_HashTable *tablePtr = hPtr->tablePtr;
int count;
@@ -914,11 +791,11 @@ CompareArrayKeys(keyPtr, hPtr)
*/
static unsigned int
-HashArrayKey(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key from which to compute hash value. */
+HashArrayKey(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
- register CONST int *array = (CONST int *) keyPtr;
+ register const int *array = (const int *) keyPtr;
register unsigned int result;
int count;
@@ -946,21 +823,21 @@ HashArrayKey(tablePtr, keyPtr)
*/
static Tcl_HashEntry *
-AllocStringEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key to store in the hash table entry. */
+AllocStringEntry(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
- CONST char *string = (CONST char *) keyPtr;
+ 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;
}
@@ -982,26 +859,14 @@ AllocStringEntry(tablePtr, keyPtr)
*/
static int
-CompareStringKeys(keyPtr, hPtr)
- VOID *keyPtr; /* New key to compare. */
- Tcl_HashEntry *hPtr; /* Existing key to compare. */
+CompareStringKeys(
+ void *keyPtr, /* New key to compare. */
+ Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- register CONST char *p1 = (CONST char *) keyPtr;
- register CONST char *p2 = (CONST char *) hPtr->key.string;
+ register const char *p1 = (const char *) keyPtr;
+ register const char *p2 = (const char *) hPtr->key.string;
-#ifdef TCL_COMPARE_HASHES_WITH_STRCMP
return !strcmp(p1, p2);
-#else
- for (;; p1++, p2++) {
- if (*p1 != *p2) {
- break;
- }
- if (*p1 == '\0') {
- return 1;
- }
- }
- return 0;
-#endif /* TCL_COMPARE_HASHES_WITH_STRCMP */
}
/*
@@ -1021,14 +886,14 @@ CompareStringKeys(keyPtr, hPtr)
*----------------------------------------------------------------------
*/
-static unsigned int
-HashStringKey(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key from which to compute hash value. */
+static unsigned
+HashStringKey(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
- register CONST char *string = (CONST char *) keyPtr;
+ register const char *string = keyPtr;
register unsigned int result;
- register int c;
+ register char c;
/*
* I tried a zillion different hash functions and asked many other people
@@ -1038,24 +903,38 @@ HashStringKey(tablePtr, keyPtr)
* following reasons:
*
* 1. Multiplying by 10 is perfect for keys that are decimal strings, and
- * multiplying by 9 is just about as good.
+ * multiplying by 9 is just about as good.
* 2. Times-9 is (shift-left-3) plus (old). This means that each
- * character's bits hang around in the low-order bits of the hash value
- * for ever, plus they spread fairly rapidly up to the high-order bits
- * to fill out the hash value. This seems works well both for decimal
- * and non-decimal strings, but isn't strong against maliciously-chosen
- * keys.
+ * character's bits hang around in the low-order bits of the hash value
+ * for ever, plus they spread fairly rapidly up to the high-order bits
+ * to fill out the hash value. This seems works well both for decimal
+ * and non-decimal strings, but isn't strong against maliciously-chosen
+ * keys.
+ *
+ * Note that this function is very weak against malicious strings; it's
+ * very easy to generate multiple keys that have the same hashcode. On the
+ * other hand, that hardly ever actually occurs and this function *is*
+ * very cheap, even by comparison with industry-standard hashes like FNV.
+ * If real strength of hash is required though, use a custom hash based on
+ * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
+ * Since Tcl command and namespace names are usually reasonably-named (the
+ * main use for string hashes in modern Tcl) speed is far more important
+ * than strength.
+ *
+ * See also HashString in tclLiteral.c.
+ * See also TclObjHashKey in tclObj.c.
+ *
+ * See [tcl-Feature Request #2958832]
*/
- result = 0;
-
- for (c=*string++ ; c ; c=*string++) {
- result += (result<<3) + c;
+ if ((result = UCHAR(*string)) != 0) {
+ while ((c = *++string) != 0) {
+ result += (result << 3) + UCHAR(c);
+ }
}
return result;
}
-#if TCL_PRESERVE_BINARY_COMPATABILITY
/*
*----------------------------------------------------------------------
*
@@ -1075,11 +954,11 @@ HashStringKey(tablePtr, keyPtr)
/* ARGSUSED */
static Tcl_HashEntry *
-BogusFind(tablePtr, key)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find matching entry. */
+BogusFind(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const char *key) /* Key to use to find matching entry. */
{
- Tcl_Panic("called Tcl_FindHashEntry on deleted table");
+ Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
return NULL;
}
@@ -1102,17 +981,16 @@ BogusFind(tablePtr, key)
/* ARGSUSED */
static Tcl_HashEntry *
-BogusCreate(tablePtr, key, newPtr)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find or create matching
+BogusCreate(
+ Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
+ const char *key, /* Key to use to find or create matching
* entry. */
- int *newPtr; /* Store info here telling whether a new entry
+ int *newPtr) /* Store info here telling whether a new entry
* was created. */
{
- Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
+ Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
return NULL;
}
-#endif
/*
*----------------------------------------------------------------------
@@ -1133,16 +1011,15 @@ BogusCreate(tablePtr, key, newPtr)
*/
static void
-RebuildTable(tablePtr)
- register Tcl_HashTable *tablePtr; /* Table to enlarge. */
+RebuildTable(
+ register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int oldSize, count, index;
Tcl_HashEntry **oldBuckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
- Tcl_HashKeyType *typePtr;
+ const Tcl_HashKeyType *typePtr;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -1153,9 +1030,6 @@ RebuildTable(tablePtr)
} else {
typePtr = &tclArrayHashKeyType;
}
-#else
- typePtr = tablePtr->typePtr;
-#endif
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -1170,8 +1044,8 @@ RebuildTable(tablePtr)
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++) {
@@ -1191,28 +1065,29 @@ RebuildTable(tablePtr)
#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 = ((unsigned int) hPtr->hash) & tablePtr->mask;
+ index = PTR2UINT(hPtr->hash) & tablePtr->mask;
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
#else
- VOID *key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
+ void *key = Tcl_GetHashKey(tablePtr, hPtr);
if (typePtr->hashKeyProc) {
unsigned int hash;
- hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
+
+ hash = typePtr->hashKeyProc(tablePtr, key);
if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX (tablePtr, hash);
+ index = RANDOM_INDEX(tablePtr, hash);
} else {
index = hash & tablePtr->mask;
}
} else {
- index = RANDOM_INDEX (tablePtr, key);
+ index = RANDOM_INDEX(tablePtr, key);
}
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
+ hPtr->bucketPtr = &tablePtr->buckets[index];
hPtr->nextPtr = *hPtr->bucketPtr;
*hPtr->bucketPtr = hPtr;
#endif
@@ -1227,7 +1102,7 @@ RebuildTable(tablePtr)
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 784a31d..b10d423 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclHistory.c --
*
* This module and the Tcl library file history.tcl together implement
@@ -9,14 +9,29 @@
* Copyright (c) 1990-1993 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: tclHistory.c,v 1.7 2004/10/06 14:59:02 dgp 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"
+/*
+ * Type of the assocData structure used to hold the reference to the [history
+ * add] subcommand, used in Tcl_RecordAndEvalObj.
+ */
+
+typedef struct {
+ Tcl_Obj *historyObj; /* == "::history" */
+ Tcl_Obj *addObj; /* == "add" */
+} HistoryObjs;
+
+#define HISTORY_OBJS_KEY "::tcl::HistoryObjs"
+
+/*
+ * Static functions in this file.
+ */
+
+static Tcl_InterpDeleteProc DeleteHistoryObjs;
/*
*----------------------------------------------------------------------
@@ -24,8 +39,7 @@
* Tcl_RecordAndEval --
*
* This procedure adds its command argument to the current list of
- * recorded events and then executes the command by calling
- * Tcl_Eval.
+ * recorded events and then executes the command by calling Tcl_Eval.
*
* Results:
* The return value is a standard Tcl return value, the result of
@@ -38,12 +52,12 @@
*/
int
-Tcl_RecordAndEval(interp, cmd, flags)
- Tcl_Interp *interp; /* Token for interpreter in which command
- * will be executed. */
- CONST char *cmd; /* Command to record. */
- int flags; /* Additional flags. TCL_NO_EVAL means
- * only record: don't execute command.
+Tcl_RecordAndEval(
+ Tcl_Interp *interp, /* Token for interpreter in which command will
+ * be executed. */
+ const char *cmd, /* Command to record. */
+ int flags) /* Additional flags. TCL_NO_EVAL means only
+ * record: don't execute command.
* TCL_EVAL_GLOBAL means use Tcl_GlobalEval
* instead of Tcl_Eval. */
{
@@ -61,8 +75,8 @@ Tcl_RecordAndEval(interp, cmd, flags)
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
/*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
+ * Move the interpreter's object result to the string result, then
+ * reset the object result.
*/
(void) Tcl_GetStringResult(interp);
@@ -70,8 +84,8 @@ Tcl_RecordAndEval(interp, cmd, flags)
/*
* Discard the Tcl object created to hold the command.
*/
-
- Tcl_DecrRefCount(cmdPtr);
+
+ Tcl_DecrRefCount(cmdPtr);
} else {
/*
* An empty string. Just reset the interpreter's result.
@@ -103,40 +117,68 @@ Tcl_RecordAndEval(interp, cmd, flags)
*/
int
-Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
- Tcl_Interp *interp; /* Token for interpreter in which command
- * will be executed. */
- Tcl_Obj *cmdPtr; /* Points to object holding the command to
+Tcl_RecordAndEvalObj(
+ Tcl_Interp *interp, /* Token for interpreter in which command will
+ * be executed. */
+ Tcl_Obj *cmdPtr, /* Points to object holding the command to
* record and execute. */
- int flags; /* Additional flags. TCL_NO_EVAL means
- * record only: don't execute the command.
- * TCL_EVAL_GLOBAL means evaluate the
- * script in global variable context instead
- * of the current procedure. */
+ int flags) /* Additional flags. TCL_NO_EVAL means record
+ * only: don't execute the command.
+ * TCL_EVAL_GLOBAL means evaluate the script
+ * in global variable context instead of the
+ * current procedure. */
{
- int result;
- Tcl_Obj *list[3];
- register Tcl_Obj *objPtr;
+ int result, call = 1;
+ Tcl_CmdInfo info;
+ HistoryObjs *histObjsPtr =
+ Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
/*
- * Do recording by eval'ing a tcl history command: history add $cmd.
+ * Create the references to the [::history add] command if necessary.
*/
- list[0] = Tcl_NewStringObj("history", -1);
- list[1] = Tcl_NewStringObj("add", -1);
- list[2] = cmdPtr;
-
- objPtr = Tcl_NewListObj(3, list);
- Tcl_IncrRefCount(objPtr);
- (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
- Tcl_DecrRefCount(objPtr);
+ if (histObjsPtr == NULL) {
+ histObjsPtr = ckalloc(sizeof(HistoryObjs));
+ TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
+ TclNewLiteralStringObj(histObjsPtr->addObj, "add");
+ Tcl_IncrRefCount(histObjsPtr->historyObj);
+ Tcl_IncrRefCount(histObjsPtr->addObj);
+ Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
+ histObjsPtr);
+ }
/*
- * One possible failure mode above: exceeding a resource limit
+ * Do not call [history] if it has been replaced by an empty proc
*/
- if (Tcl_LimitExceeded(interp)) {
- return TCL_ERROR;
+ result = Tcl_GetCommandInfo(interp, "::history", &info);
+ if (result && (info.deleteProc == TclProcDeleteProc)) {
+ Proc *procPtr = (Proc *) info.objClientData;
+ call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
+ }
+
+ if (call) {
+ Tcl_Obj *list[3];
+
+ /*
+ * Do recording by eval'ing a tcl history command: history add $cmd.
+ */
+
+ list[0] = histObjsPtr->historyObj;
+ list[1] = histObjsPtr->addObj;
+ list[2] = cmdPtr;
+
+ Tcl_IncrRefCount(cmdPtr);
+ (void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmdPtr);
+
+ /*
+ * One possible failure mode above: exceeding a resource limit.
+ */
+
+ if (Tcl_LimitExceeded(interp)) {
+ return TCL_ERROR;
+ }
}
/*
@@ -149,3 +191,40 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
}
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteHistoryObjs --
+ *
+ * Called to delete the references to the constant words used when adding
+ * to the history.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The constant words may be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteHistoryObjs(
+ ClientData clientData,
+ Tcl_Interp *interp)
+{
+ register HistoryObjs *histObjsPtr = clientData;
+
+ TclDecrRefCount(histObjsPtr->historyObj);
+ TclDecrRefCount(histObjsPtr->addObj);
+ ckfree(histObjsPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index b08e358..58c7b3c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -7,10 +7,8 @@
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-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: tclIO.c,v 1.94 2005/08/26 22:11:16 andreas_kupries 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"
@@ -18,8 +16,110 @@
#include <assert.h>
/*
+ * For each channel handler registered in a call to Tcl_CreateChannelHandler,
+ * there is one record of the following type. All of records for a specific
+ * channel are chained together in a singly linked list which is stored in
+ * the channel structure.
+ */
+
+typedef struct ChannelHandler {
+ Channel *chanPtr; /* The channel structure for this channel. */
+ int mask; /* Mask of desired events. */
+ Tcl_ChannelProc *proc; /* Procedure to call in the type of
+ * Tcl_CreateChannelHandler. */
+ ClientData clientData; /* Argument to pass to procedure. */
+ struct ChannelHandler *nextPtr;
+ /* Next one in list of registered handlers. */
+} ChannelHandler;
+
+/*
+ * This structure keeps track of the current ChannelHandler being invoked in
+ * the current invocation of ChannelHandlerEventProc. There is a potential
+ * problem if a ChannelHandler is deleted while it is the current one, since
+ * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * problem, structures of the type below indicate the next handler to be
+ * processed for any (recursively nested) dispatches in progress. The
+ * nextHandlerPtr field is updated if the handler being pointed to is deleted.
+ * The nextPtr field is used to chain together all recursive invocations, so
+ * that Tcl_DeleteChannelHandler can find all the recursively nested
+ * invocations of ChannelHandlerEventProc and compare the handler being
+ * deleted against the NEXT handler to be invoked in that invocation; when it
+ * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
+ * field of the structure to the next handler.
+ */
+
+typedef struct NextChannelHandler {
+ ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
+ * this invocation. */
+ struct NextChannelHandler *nestedHandlerPtr;
+ /* Next nested invocation of
+ * ChannelHandlerEventProc. */
+} NextChannelHandler;
+
+/*
+ * The following structure describes the event that is added to the Tcl
+ * event queue by the channel handler check procedure.
+ */
+
+typedef struct ChannelHandlerEvent {
+ Tcl_Event header; /* Standard header for all events. */
+ Channel *chanPtr; /* The channel that is ready. */
+ int readyMask; /* Events that have occurred. */
+} ChannelHandlerEvent;
+
+/*
+ * The following structure is used by Tcl_GetsObj() to encapsulates the
+ * state for a "gets" operation.
+ */
+
+typedef struct GetsState {
+ Tcl_Obj *objPtr; /* The object to which UTF-8 characters
+ * will be appended. */
+ char **dstPtr; /* Pointer into objPtr's string rep where
+ * next character should be stored. */
+ Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
+ * to UTF-8. */
+ ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
+ * emptied. */
+ Tcl_EncodingState state; /* The encoding state just before the last
+ * external to UTF-8 conversion in
+ * FilterInputBytes(). */
+ int rawRead; /* The number of bytes removed from bufPtr
+ * in the last call to FilterInputBytes(). */
+ int bytesWrote; /* The number of bytes of UTF-8 data
+ * appended to objPtr during the last call to
+ * FilterInputBytes(). */
+ int charsWrote; /* The corresponding number of UTF-8
+ * characters appended to objPtr during the
+ * last call to FilterInputBytes(). */
+ int totalChars; /* The total number of UTF-8 characters
+ * appended to objPtr so far, just before the
+ * last call to FilterInputBytes(). */
+} GetsState;
+
+/*
+ * The following structure encapsulates the state for a background channel
+ * copy. Note that the data buffer for the copy will be appended to this
+ * structure.
+ */
+
+typedef struct CopyState {
+ struct Channel *readPtr; /* Pointer to input channel. */
+ struct Channel *writePtr; /* Pointer to output channel. */
+ int readFlags; /* Original read channel flags. */
+ int writeFlags; /* Original write channel flags. */
+ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */
+ Tcl_WideInt total; /* Total bytes transferred (written). */
+ Tcl_Interp *interp; /* Interp that started the copy. */
+ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
+ int bufSize; /* Size of appended buffer. */
+ char buffer[1]; /* Copy buffer, this must be the last
+ * field. */
+} CopyState;
+
+/*
* All static variables used in this file are collected into a single instance
- * of the following structure. For multi-threaded implementations, there is
+ * of the following structure. For multi-threaded implementations, there is
* one instance of this structure for each thread.
*
* Notice that different structures with the same name appear in other files.
@@ -28,120 +128,334 @@
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
- /* This variable holds the list of
- * nested ChannelHandlerEventProc
- * invocations. */
- ChannelState *firstCSPtr; /* List of all channels currently
- * open, indexed by ChannelState, as
- * only one ChannelState exists per
- * set of stacked channels. */
-#ifdef oldcode
- int channelExitHandlerCreated; /* Has a channel exit handler been
- * created yet? */
- int channelEventSourceCreated; /* Has the channel event source been
- * created and registered with the
- * notifier? */
-#endif
- Tcl_Channel stdinChannel; /* Static variable for the stdin
- * channel. */
+ /* This variable holds the list of nested
+ * ChannelHandlerEventProc invocations. */
+ ChannelState *firstCSPtr; /* List of all channels currently open,
+ * indexed by ChannelState, as only one
+ * ChannelState exists per set of stacked
+ * channels. */
+ Tcl_Channel stdinChannel; /* Static variable for the stdin channel. */
int stdinInitialized;
- Tcl_Channel stdoutChannel; /* Static variable for the stdout
- * channel. */
+ Tcl_Channel stdoutChannel; /* Static variable for the stdout channel. */
int stdoutInitialized;
- Tcl_Channel stderrChannel; /* Static variable for the stderr
- * channel. */
+ Tcl_Channel stderrChannel; /* Static variable for the stderr channel. */
int stderrInitialized;
+ Tcl_Encoding binaryEncoding;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
+ * Structure to record a close callback. One such record exists for
+ * each close callback registered for a channel.
+ */
+
+typedef struct CloseCallback {
+ Tcl_CloseProc *proc; /* The procedure to call. */
+ ClientData clientData; /* Arbitrary one-word data to pass
+ * to the callback. */
+ struct CloseCallback *nextPtr; /* For chaining close callbacks. */
+} CloseCallback;
+
+/*
* Static functions in this file:
*/
-static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
-static void ChannelTimerProc _ANSI_ARGS_((
- ClientData clientData));
-static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
- int direction));
-static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr, int newlineFlag));
-static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
- ChannelState *statePtr));
-static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
- Tcl_Channel chan));
-static void CleanupChannelHandlers _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr));
-static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int errorCode));
-static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
- Tcl_Encoding encoding));
-static int CopyAndTranslateBuffer _ANSI_ARGS_((
- ChannelState *statePtr, char *result, int space));
-static int CopyBuffer _ANSI_ARGS_((Channel *chanPtr,
- char *result, int space));
-static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
-static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
- int mask));
-static void CreateScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mask, Tcl_Obj *scriptPtr));
-static void DeleteChannelTable _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mask));
-static int DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
-static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
- int discardSavedBuffers));
-static void DiscardOutputQueued _ANSI_ARGS_((
- ChannelState *chanPtr));
-static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- int slen));
-static int DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src,
- int srcLen));
-static int DoReadChars _ANSI_ARGS_((Channel *chan,
- Tcl_Obj *objPtr, int toRead, int appendFlag));
-static int DoWriteChars _ANSI_ARGS_((Channel *chan,
- CONST char *src, int len));
-static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
- GetsState *statePtr));
-static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int calledFromAsyncFlush));
-static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
-static int GetInput _ANSI_ARGS_((Channel *chanPtr));
-static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
- Tcl_ChannelTypeVersion minimumVersion));
-static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
- char **dstEndPtr, GetsState *gsPtr));
-static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
- Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
-static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
- Tcl_Obj *objPtr, int charsLeft,
- int *offsetPtr, int *factorPtr));
-static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
- ChannelBuffer *bufPtr, int mustDiscard));
-static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
- int mode));
-static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mode));
-static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
-static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
- char *dst, CONST char *src,
- int *dstLenPtr, int *srcLenPtr));
-static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
- char *dst, CONST char *src,
- int *dstLenPtr, int *srcLenPtr));
-static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
-static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
-static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
-static Tcl_Obj* FixLevelCode _ANSI_ARGS_ ((Tcl_Obj* msg));
-
-
-static void SpliceChannel _ANSI_ARGS_ ((Tcl_Channel chan));
-static void CutChannel _ANSI_ARGS_ ((Tcl_Channel chan));
+static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
+static void ChannelTimerProc(ClientData clientData);
+static int CheckChannelErrors(ChannelState *statePtr,
+ int direction);
+static int CheckForDeadChannel(Tcl_Interp *interp,
+ ChannelState *statePtr);
+static void CheckForStdChannelsBeingClosed(Tcl_Channel chan);
+static void CleanupChannelHandlers(Tcl_Interp *interp,
+ Channel *chanPtr);
+static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
+ int errorCode);
+static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
+ int errorCode, int flags);
+static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
+static void CommonGetsCleanup(Channel *chanPtr);
+static int CopyAndTranslateBuffer(ChannelState *statePtr,
+ char *result, int space);
+static int CopyBuffer(Channel *chanPtr, char *result, int space);
+static int CopyData(CopyState *csPtr, int mask);
+static void CopyEventProc(ClientData clientData, int mask);
+static void CreateScriptRecord(Tcl_Interp *interp,
+ Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
+static void DeleteChannelTable(ClientData clientData,
+ Tcl_Interp *interp);
+static void DeleteScriptRecord(Tcl_Interp *interp,
+ Channel *chanPtr, int mask);
+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, int allowShortReads);
+static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
+ int appendFlag);
+static int FilterInputBytes(Channel *chanPtr,
+ GetsState *statePtr);
+static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
+ int calledFromAsyncFlush);
+static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
+static Tcl_Encoding GetBinaryEncoding();
+static void FreeBinaryEncoding(ClientData clientData);
+static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp);
+static int GetInput(Channel *chanPtr);
+static int HaveVersion(const Tcl_ChannelType *typePtr,
+ Tcl_ChannelTypeVersion minimumVersion);
+static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
+ GetsState *gsPtr);
+static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
+ int charsLeft, int *offsetPtr);
+static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
+ int charsLeft, int *offsetPtr, int *factorPtr);
+static void RecycleBuffer(ChannelState *statePtr,
+ ChannelBuffer *bufPtr, int mustDiscard);
+static int StackSetBlockMode(Channel *chanPtr, int mode);
+static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
+ int mode);
+static void StopCopy(CopyState *csPtr);
+static int TranslateInputEOL(ChannelState *statePtr, char *dst,
+ const char *src, int *dstLenPtr, int *srcLenPtr);
+static void UpdateInterest(Channel *chanPtr);
+static int Write(Channel *chanPtr, const char *src,
+ int srcLen, Tcl_Encoding encoding);
+static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
+static void SpliceChannel(Tcl_Channel chan);
+static void CutChannel(Tcl_Channel chan);
+static int WillRead(Channel *chanPtr);
+
+#define WriteChars(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, chanPtr->state->encoding)
+#define WriteBytes(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, tclIdentityEncoding)
+
+/*
+ * Simplifying helper macros. All may use their argument(s) multiple times.
+ * The ANSI C "prototypes" for the macros are listed below, together with a
+ * short description of what the macro does.
+ *
+ * --------------------------------------------------------------------------
+ * int BytesLeft(ChannelBuffer *bufPtr)
+ *
+ * Returns the number of bytes of data remaining in the buffer.
+ *
+ * int SpaceLeft(ChannelBuffer *bufPtr)
+ *
+ * Returns the number of bytes of space remaining at the end of the
+ * buffer.
+ *
+ * int IsBufferReady(ChannelBuffer *bufPtr)
+ *
+ * Returns whether a buffer has bytes available within it.
+ *
+ * int IsBufferEmpty(ChannelBuffer *bufPtr)
+ *
+ * Returns whether a buffer is entirely empty. Note that this is not the
+ * inverse of the above operation; trying to merge the two seems to lead
+ * to occasional crashes...
+ *
+ * int IsBufferFull(ChannelBuffer *bufPtr)
+ *
+ * Returns whether more data can be added to a buffer.
+ *
+ * int IsBufferOverflowing(ChannelBuffer *bufPtr)
+ *
+ * Returns whether a buffer has more data in it than it should.
+ *
+ * char *InsertPoint(ChannelBuffer *bufPtr)
+ *
+ * Returns a pointer to where characters should be added to the buffer.
+ *
+ * char *RemovePoint(ChannelBuffer *bufPtr)
+ *
+ * Returns a pointer to where characters should be removed from the
+ * buffer.
+ * --------------------------------------------------------------------------
+ */
+
+#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
+
+#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
+
+#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
+
+#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
+
+#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+
+#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
+
+#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
+
+#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
+
+/*
+ * For working with channel state flag bits.
+ */
+
+#define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag))
+#define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag))
+#define GotFlag(statePtr, flag) ((statePtr)->flags & (flag))
+
+/*
+ * Macro for testing whether a string (in optionName, length len) matches a
+ * value (prefix matching rules). Arguments are the minimum length to match
+ * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is
+ * used in a situation where no objects are available.)
+ */
+
+#define HaveOpt(minLength, nameString) \
+ ((len > (minLength)) && (optionName[1] == (nameString)[1]) \
+ && (strncmp(optionName, (nameString), len) == 0))
+
+/*
+ * The ChannelObjType type. We actually store the ChannelState structure
+ * as that lives longest and we want to return the bottomChanPtr when
+ * requested (consistent with Tcl_GetChannel). The setFromAny and
+ * updateString can be NULL as they should not be called.
+ */
+
+static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static int SetChannelFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void FreeChannelIntRep(Tcl_Obj *objPtr);
+
+static const Tcl_ObjType chanObjType = {
+ "channel", /* name for this type */
+ FreeChannelIntRep, /* freeIntRepProc */
+ DupChannelIntRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc SetChannelFromAny */
+};
+
+#define GET_CHANNELSTATE(objPtr) \
+ ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_CHANNELSTATE(objPtr, storePtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
+#define GET_CHANNELINTERP(objPtr) \
+ ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
+#define SET_CHANNELINTERP(objPtr, storePtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
+
+#define BUSY_STATE(st, fl) \
+ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
+ (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
+
+#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite --
+ *
+ * Simplify the access to selected channel driver "methods" that are used
+ * in multiple places in a stereotypical fashion. These are just thin
+ * wrappers around the driver functions.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static inline int
+ChanClose(
+ Channel *chanPtr,
+ Tcl_Interp *interp)
+{
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
+ } else {
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
+ }
+}
+
+static inline int
+ChanCloseHalf(
+ Channel *chanPtr,
+ Tcl_Interp *interp,
+ int flags)
+{
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
+}
+
+static inline int
+ChanRead(
+ Channel *chanPtr,
+ char *dst,
+ int dstSize,
+ int *errnoPtr)
+{
+ if (WillRead(chanPtr) < 0) {
+ *errnoPtr = Tcl_GetErrno();
+ return -1;
+ }
+
+ return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
+ errnoPtr);
+}
+
+static inline Tcl_WideInt
+ChanSeek(
+ Channel *chanPtr,
+ Tcl_WideInt offset,
+ int mode,
+ int *errnoPtr)
+{
+ /*
+ * Note that we prefer the wideSeekProc if that field is available in the
+ * type and non-NULL.
+ */
+
+ if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
+ chanPtr->typePtr->wideSeekProc != NULL) {
+ return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
+ offset, mode, errnoPtr);
+ }
+ if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+ *errnoPtr = EOVERFLOW;
+ return Tcl_LongAsWide(-1);
+ }
+
+ return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
+ Tcl_WideAsLong(offset), mode, errnoPtr));
+}
+
+static inline void
+ChanThreadAction(
+ Channel *chanPtr,
+ int action)
+{
+ Tcl_DriverThreadActionProc *threadActionProc =
+ Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+
+ if (threadActionProc != NULL) {
+ threadActionProc(chanPtr->instanceData, action);
+ }
+}
+
+static inline void
+ChanWatch(
+ Channel *chanPtr,
+ int mask)
+{
+ chanPtr->typePtr->watchProc(chanPtr->instanceData, mask);
+}
+
+static inline int
+ChanWrite(
+ Channel *chanPtr,
+ const char *src,
+ int srcLen,
+ int *errnoPtr)
+{
+ return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen,
+ errnoPtr);
+}
/*
*---------------------------------------------------------------------------
@@ -161,7 +475,7 @@ static void CutChannel _ANSI_ARGS_ ((Tcl_Channel chan));
*/
void
-TclInitIOSubsystem()
+TclInitIOSubsystem(void)
{
/*
* By fetching thread local storage we take care of allocating it for each
@@ -191,77 +505,122 @@ TclInitIOSubsystem()
/* ARGSUSED */
void
-TclFinalizeIOSubsystem()
+TclFinalizeIOSubsystem(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr; /* Iterates over open channels. */
- ChannelState *nextCSPtr; /* Iterates over open channels. */
- ChannelState *statePtr; /* state of channel stack */
+ 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;
- for (statePtr = tsdPtr->firstCSPtr; statePtr != (ChannelState *) NULL;
- statePtr = nextCSPtr) {
- chanPtr = statePtr->topChanPtr;
- nextCSPtr = statePtr->nextCSPtr;
+ /* 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
+ * corresponding channels.
+ */
+
+ while (active) {
/*
- * Set the channel back into blocking mode to ensure that we wait for
- * all data to flush out.
+ * Iterate through the open channel list, and find the first channel
+ * that isn't dead. We start from the head of the list each time,
+ * because the close action on one channel can close others.
*/
- (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
-
- if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
- (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
- (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
- /*
- * Decrement the refcount which was earlier artificially bumped up
- * to keep the channel from being closed.
- */
-
- statePtr->refCount--;
+ active = 0;
+ for (statePtr = tsdPtr->firstCSPtr;
+ statePtr != NULL;
+ statePtr = statePtr->nextCSPtr) {
+ chanPtr = statePtr->topChanPtr;
+ 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;
+ }
}
- if (statePtr->refCount <= 0) {
- /*
- * Close it only if the refcount indicates that the channel is not
- * referenced from any interpreter. If it is, that interpreter
- * will close the channel when it gets destroyed.
- */
+ /*
+ * We've found a live (or bg-closing) channel. Close it.
+ */
- (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+ if (active) {
- } else {
/*
- * The refcount is greater than zero, so flush the channel.
+ * 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".
*/
+ 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) ||
+ (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
+ /*
+ * Decrement the refcount which was earlier artificially
+ * bumped up to keep the channel from being closed.
+ */
- Tcl_Flush((Tcl_Channel) chanPtr);
+ statePtr->refCount--;
+ }
- /*
- * Call the device driver to actually close the underlying device
- * for this channel.
- */
+ if (statePtr->refCount <= 0) {
+ /*
+ * Close it only if the refcount indicates that the channel is
+ * not referenced from any interpreter. If it is, that
+ * interpreter will close the channel when it gets destroyed.
+ */
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
- (Tcl_Interp *) NULL);
+ (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
} else {
- (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- (Tcl_Interp *) NULL, 0);
- }
+ /*
+ * The refcount is greater than zero, so flush the channel.
+ */
- /*
- * Finally, we clean up the fields in the channel data structure
- * since all of them have been deleted already. We mark the
- * channel with CHANNEL_DEAD to prevent any further IO operations
- * on it.
- */
+ Tcl_Flush((Tcl_Channel) chanPtr);
+
+ /*
+ * Call the device driver to actually close the underlying
+ * device for this channel.
+ */
+
+ (void) ChanClose(chanPtr, NULL);
- chanPtr->instanceData = (ClientData) NULL;
- statePtr->flags |= CHANNEL_DEAD;
+ /*
+ * Finally, we clean up the fields in the channel data
+ * structure since all of them have been deleted already. We
+ * mark the channel with CHANNEL_DEAD to prevent any further
+ * IO operations on it.
+ */
+
+ chanPtr->instanceData = NULL;
+ SetFlag(statePtr, CHANNEL_DEAD);
+ }
}
}
+
+ TclpFinalizeSockets();
TclpFinalizePipes();
}
@@ -283,11 +642,12 @@ TclFinalizeIOSubsystem()
*/
void
-Tcl_SetStdChannel(channel, type)
- Tcl_Channel channel;
- int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_SetStdChannel(
+ Tcl_Channel channel,
+ int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
switch (type) {
case TCL_STDIN:
tsdPtr->stdinInitialized = 1;
@@ -321,8 +681,8 @@ Tcl_SetStdChannel(channel, type)
*/
Tcl_Channel
-Tcl_GetStdChannel(type)
- int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_GetStdChannel(
+ int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -347,9 +707,8 @@ Tcl_GetStdChannel(type)
* standard input.
*/
- if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stdinChannel);
+ if (tsdPtr->stdinChannel != NULL) {
+ Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
}
}
channel = tsdPtr->stdinChannel;
@@ -358,9 +717,8 @@ Tcl_GetStdChannel(type)
if (!tsdPtr->stdoutInitialized) {
tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
tsdPtr->stdoutInitialized = 1;
- if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stdoutChannel);
+ if (tsdPtr->stdoutChannel != NULL) {
+ Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
}
}
channel = tsdPtr->stdoutChannel;
@@ -369,9 +727,8 @@ Tcl_GetStdChannel(type)
if (!tsdPtr->stderrInitialized) {
tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
tsdPtr->stderrInitialized = 1;
- if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stderrChannel);
+ if (tsdPtr->stderrChannel != NULL) {
+ Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
}
}
channel = tsdPtr->stderrChannel;
@@ -399,20 +756,18 @@ Tcl_GetStdChannel(type)
*/
void
-Tcl_CreateCloseHandler(chan, proc, clientData)
- Tcl_Channel chan; /* The channel for which to create the close
+Tcl_CreateCloseHandler(
+ Tcl_Channel chan, /* The channel for which to create the close
* callback. */
- Tcl_CloseProc *proc; /* The callback routine to call when the
+ Tcl_CloseProc *proc, /* The callback routine to call when the
* channel will be closed. */
- ClientData clientData; /* Arbitrary data to pass to the close
+ ClientData clientData) /* Arbitrary data to pass to the close
* callback. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
- statePtr = ((Channel *) chan)->state;
-
- cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
+ cbPtr = ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
@@ -439,30 +794,29 @@ Tcl_CreateCloseHandler(chan, proc, clientData)
*/
void
-Tcl_DeleteCloseHandler(chan, proc, clientData)
- Tcl_Channel chan; /* The channel for which to cancel the close
+Tcl_DeleteCloseHandler(
+ Tcl_Channel chan, /* The channel for which to cancel the close
* callback. */
- Tcl_CloseProc *proc; /* The procedure for the callback to
+ Tcl_CloseProc *proc, /* The procedure for the callback to
* remove. */
- ClientData clientData; /* The callback data for the callback to
+ ClientData clientData) /* The callback data for the callback to
* remove. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr, *cbPrevPtr;
- statePtr = ((Channel *) chan)->state;
- for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
- cbPtr != (CloseCallback *) NULL;
- cbPtr = cbPtr->nextPtr) {
+ for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
+ cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
- if (cbPrevPtr == (CloseCallback *) NULL) {
+ if (cbPrevPtr == NULL) {
statePtr->closeCbPtr = cbPtr->nextPtr;
+ } else {
+ cbPrevPtr->nextPtr = cbPtr->nextPtr;
}
- ckfree((char *) cbPtr);
+ ckfree(cbPtr);
break;
- } else {
- cbPrevPtr = cbPtr;
}
+ cbPrevPtr = cbPtr;
}
}
@@ -486,20 +840,18 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
*/
static Tcl_HashTable *
-GetChannelTable(interp)
- Tcl_Interp *interp;
+GetChannelTable(
+ Tcl_Interp *interp)
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_Channel stdinChan, stdoutChan, stderrChan;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+ hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
+ hTblPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
-
- (void) Tcl_SetAssocData(interp, "tclIO",
- (Tcl_InterpDeleteProc *) DeleteChannelTable,
- (ClientData) hTblPtr);
+ Tcl_SetAssocData(interp, "tclIO",
+ (Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
/*
* If the interpreter is trusted (not "safe"), insert channels for
@@ -545,9 +897,9 @@ GetChannelTable(interp)
*/
static void
-DeleteChannelTable(clientData, interp)
- ClientData clientData; /* The per-interpreter data structure. */
- Tcl_Interp *interp; /* The interpreter being deleted. */
+DeleteChannelTable(
+ ClientData clientData, /* The per-interpreter data structure. */
+ Tcl_Interp *interp) /* The interpreter being deleted. */
{
Tcl_HashTable *hTblPtr; /* The hash table. */
Tcl_HashSearch hSearch; /* Search variable. */
@@ -564,35 +916,31 @@ DeleteChannelTable(clientData, interp)
* refcount reaches zero.
*/
- hTblPtr = (Tcl_HashTable *) clientData;
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
+ hTblPtr = clientData;
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
-
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ chanPtr = Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
/*
* Remove any fileevents registered in this interpreter.
*/
- for (sPtr = statePtr->scriptRecordPtr,
- prevPtr = (EventScriptRecord *) NULL;
- sPtr != (EventScriptRecord *) NULL;
- sPtr = nextPtr) {
+ for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
+ sPtr != NULL; sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
- if (prevPtr == (EventScriptRecord *) NULL) {
+ if (prevPtr == NULL) {
statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -606,15 +954,17 @@ DeleteChannelTable(clientData, interp)
*/
Tcl_DeleteHashEntry(hPtr);
+ SetFlag(statePtr, CHANNEL_TAINTED);
statePtr->refCount--;
if (statePtr->refCount <= 0) {
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
+
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
+ ckfree(hTblPtr);
}
/*
@@ -640,27 +990,31 @@ DeleteChannelTable(clientData, interp)
*/
static void
-CheckForStdChannelsBeingClosed(chan)
- Tcl_Channel chan;
+CheckForStdChannelsBeingClosed(
+ Tcl_Channel chan)
{
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;
@@ -674,9 +1028,9 @@ CheckForStdChannelsBeingClosed(chan)
*
* Tcl_IsStandardChannel --
*
- * Test if the given channel is a standard channel. No attempt
- * is made to check if the channel or the standard channels
- * are initialized or otherwise valid.
+ * Test if the given channel is a standard channel. No attempt is made to
+ * check if the channel or the standard channels are initialized or
+ * otherwise valid.
*
* Results:
* Returns 1 if true, 0 if false.
@@ -688,8 +1042,8 @@ CheckForStdChannelsBeingClosed(chan)
*/
int
-Tcl_IsStandardChannel(chan)
- Tcl_Channel chan; /* Channel to check. */
+Tcl_IsStandardChannel(
+ Tcl_Channel chan) /* Channel to check. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -721,19 +1075,19 @@ Tcl_IsStandardChannel(chan)
*/
void
-Tcl_RegisterChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which to add the channel. */
- Tcl_Channel chan; /* The channel to add to this interpreter
+Tcl_RegisterChannel(
+ Tcl_Interp *interp, /* Interpreter in which to add the channel. */
+ Tcl_Channel chan) /* The channel to add to this interpreter
* channel table. */
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
- int new; /* Is the hash entry new or does it exist? */
+ int isNew; /* Is the hash entry new or does it exist? */
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State of the actual channel. */
/*
- * Always (un)register bottom-most channel in the stack. This makes
+ * Always (un)register bottom-most channel in the stack. This makes
* management of the channel list easier because no manipulation is
* necessary during (un)stack operation.
*/
@@ -741,20 +1095,20 @@ Tcl_RegisterChannel(interp, chan)
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
- if (statePtr->channelName == (CONST char *) NULL) {
+ if (statePtr->channelName == NULL) {
Tcl_Panic("Tcl_RegisterChannel: channel without name");
}
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
hTblPtr = GetChannelTable(interp);
- hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
- if (new == 0) {
- if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
- return;
+ hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew);
+ if (!isNew) {
+ if (chan == Tcl_GetHashValue(hPtr)) {
+ return;
}
Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");
}
- Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
+ Tcl_SetHashValue(hPtr, chanPtr);
}
statePtr->refCount++;
}
@@ -766,7 +1120,7 @@ Tcl_RegisterChannel(interp, chan)
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
- * reference count. (This all happens in the Tcl_DetachChannel helper
+ * reference count. (This all happens in the Tcl_DetachChannel helper
* function).
*
* Finally, if the reference count of the channel drops to zero, it is
@@ -786,18 +1140,19 @@ Tcl_RegisterChannel(interp, chan)
*/
int
-Tcl_UnregisterChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
+Tcl_UnregisterChannel(
+ Tcl_Interp *interp, /* Interpreter in which channel is defined. */
+ Tcl_Channel chan) /* Channel to delete. */
{
ChannelState *statePtr; /* State of the real channel. */
statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
- if (statePtr->flags & CHANNEL_INCLOSE) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "Illegal recursive call to close ",
- "through close-handler of channel", (char *) NULL);
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -823,33 +1178,31 @@ Tcl_UnregisterChannel(interp, chan)
*/
if (statePtr->refCount <= 0) {
-
/*
* Ensure that if there is another buffer, it gets flushed whether or
* not we are doing a background flush.
*/
if ((statePtr->curOutPtr != NULL) &&
- (statePtr->curOutPtr->nextAdded >
- statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
+ IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
}
- Tcl_Preserve((ClientData)statePtr);
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ Tcl_Preserve(statePtr);
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
* We don't want to re-enter Tcl_Close().
*/
- if (!(statePtr->flags & CHANNEL_CLOSED)) {
+ if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
- statePtr->flags |= CHANNEL_CLOSED;
- Tcl_Release((ClientData)statePtr);
+ SetFlag(statePtr, CHANNEL_CLOSED);
+ Tcl_Release(statePtr);
return TCL_ERROR;
}
}
}
- statePtr->flags |= CHANNEL_CLOSED;
- Tcl_Release((ClientData)statePtr);
+ SetFlag(statePtr, CHANNEL_CLOSED);
+ Tcl_Release(statePtr);
}
return TCL_OK;
}
@@ -861,9 +1214,9 @@ Tcl_UnregisterChannel(interp, chan)
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
- * reference count. Even if the ref count drops to zero, the channel is
- * NOT closed or cleaned up. This allows a channel to be detached from
- * an interpreter and left in the same state it was in when it was
+ * reference count. Even if the ref count drops to zero, the channel is
+ * NOT closed or cleaned up. This allows a channel to be detached from an
+ * interpreter and left in the same state it was in when it was
* originally returned by 'Tcl_OpenFileChannel', for example.
*
* This function cannot be used on the standard channels, and will return
@@ -871,15 +1224,15 @@ Tcl_UnregisterChannel(interp, chan)
*
* This function should only be necessary for special purposes in which
* you need to generate a pristine channel from one that has already been
- * used. All ordinary purposes will almost always want to use
+ * used. All ordinary purposes will almost always want to use
* Tcl_UnregisterChannel instead.
*
* Provided the channel is not attached to any other interpreter, it can
* then be closed with Tcl_Close, rather than with Tcl_UnregisterChannel.
*
* Results:
- * A standard Tcl result. If the channel is not currently registered
- * with the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
+ * A standard Tcl result. If the channel is not currently registered with
+ * the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
* However no error messages are left in the interp's result.
*
* Side effects:
@@ -889,9 +1242,9 @@ Tcl_UnregisterChannel(interp, chan)
*/
int
-Tcl_DetachChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
+Tcl_DetachChannel(
+ Tcl_Interp *interp, /* Interpreter in which channel is defined. */
+ Tcl_Channel chan) /* Channel to delete. */
{
if (Tcl_IsStandardChannel(chan)) {
return TCL_ERROR;
@@ -907,14 +1260,14 @@ Tcl_DetachChannel(interp, chan)
*
* Deletes the hash entry for a channel associated with an interpreter.
* If the interpreter given as argument is NULL, it only decrements the
- * reference count. Even if the ref count drops to zero, the channel is
- * NOT closed or cleaned up. This allows a channel to be detached from
- * an interpreter and left in the same state it was in when it was
+ * reference count. Even if the ref count drops to zero, the channel is
+ * NOT closed or cleaned up. This allows a channel to be detached from an
+ * interpreter and left in the same state it was in when it was
* originally returned by 'Tcl_OpenFileChannel', for example.
*
* Results:
- * A standard Tcl result. If the channel is not currently registered
- * with the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
+ * A standard Tcl result. If the channel is not currently registered with
+ * the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
* However no error messages are left in the interp's result.
*
* Side effects:
@@ -924,9 +1277,9 @@ Tcl_DetachChannel(interp, chan)
*/
static int
-DetachChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
+DetachChannel(
+ Tcl_Interp *interp, /* Interpreter in which channel is defined. */
+ Tcl_Channel chan) /* Channel to delete. */
{
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -934,7 +1287,7 @@ DetachChannel(interp, chan)
ChannelState *statePtr; /* State of the real channel. */
/*
- * Always (un)register bottom-most channel in the stack. This makes
+ * Always (un)register bottom-most channel in the stack. This makes
* management of the channel list easier because no manipulation is
* necessary during (un)stack operation.
*/
@@ -942,19 +1295,20 @@ DetachChannel(interp, chan)
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
- if (interp != (Tcl_Interp *) NULL) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
+ if (interp != NULL) {
+ hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
+ if (hPtr == NULL) {
return TCL_ERROR;
}
if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
+ SetFlag(statePtr, CHANNEL_TAINTED);
/*
* Remove channel handlers that refer to this interpreter, so that
@@ -983,7 +1337,7 @@ DetachChannel(interp, chan)
*
* Results:
* A Tcl_Channel or NULL on failure. If failed, interp's result object
- * contains an error message. *modePtr is filled with the modes in which
+ * contains an error message. *modePtr is filled with the modes in which
* the channel was opened.
*
* Side effects:
@@ -993,11 +1347,11 @@ DetachChannel(interp, chan)
*/
Tcl_Channel
-Tcl_GetChannel(interp, chanName, modePtr)
- Tcl_Interp *interp; /* Interpreter in which to find or create the
+Tcl_GetChannel(
+ Tcl_Interp *interp, /* Interpreter in which to find or create the
* channel. */
- CONST char *chanName; /* The name of the channel. */
- int *modePtr; /* Where to store the mode in which the
+ const char *chanName, /* The name of the channel. */
+ int *modePtr) /* Where to store the mode in which the
* channel was opened? Will contain an ORed
* combination of TCL_READABLE and
* TCL_WRITABLE, if non-NULL. */
@@ -1005,13 +1359,13 @@ Tcl_GetChannel(interp, chanName, modePtr)
Channel *chanPtr; /* The actual channel. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
- CONST char *name; /* Translated name. */
+ const char *name; /* Translated name. */
/*
- * Substitute "stdin", etc. Note that even though we immediately find the
+ * Substitute "stdin", etc. Note that even though we immediately find the
* channel using Tcl_GetStdChannel, we still need to look it up in the
* specified interpreter to ensure that it is present in the channel
- * table. Otherwise, safe interpreters would always have access to the
+ * table. Otherwise, safe interpreters would always have access to the
* standard channels.
*/
@@ -1032,9 +1386,10 @@ Tcl_GetChannel(interp, chanName, modePtr)
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendResult(interp, "can not find channel named \"",
- chanName, "\"", (char *) NULL);
+ if (hPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find channel named \"%s\"", chanName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
return NULL;
}
@@ -1044,16 +1399,64 @@ Tcl_GetChannel(interp, chanName, modePtr)
* compensate where necessary to retrieve the topmost channel again.
*/
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ chanPtr = Tcl_GetHashValue(hPtr);
chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
}
return (Tcl_Channel) chanPtr;
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetChannelFromObj --
+ *
+ * Finds an existing Tcl_Channel structure by name in a given
+ * interpreter. This function is public because it is used by
+ * channel-type-specific functions.
+ *
+ * Results:
+ * A Tcl_Channel or NULL on failure. If failed, interp's result object
+ * contains an error message. *modePtr is filled with the modes in which
+ * the channel was opened.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetChannelFromObj(
+ Tcl_Interp *interp, /* Interpreter in which to find or create the
+ * channel. */
+ Tcl_Obj *objPtr,
+ Tcl_Channel *channelPtr,
+ int *modePtr, /* Where to store the mode in which the
+ * channel was opened? Will contain an ORed
+ * combination of TCL_READABLE and
+ * TCL_WRITABLE, if non-NULL. */
+ int flags)
+{
+ ChannelState *statePtr;
+
+ if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ statePtr = GET_CHANNELSTATE(objPtr);
+ *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
+
+ if (modePtr != NULL) {
+ *modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
+ }
+
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_CreateChannel --
@@ -1070,17 +1473,18 @@ Tcl_GetChannel(interp, chanName, modePtr)
*/
Tcl_Channel
-Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
- Tcl_ChannelType *typePtr; /* The channel type record. */
- CONST char *chanName; /* Name of channel to record. */
- ClientData instanceData; /* Instance specific data. */
- int mask; /* TCL_READABLE & TCL_WRITABLE to indicate if
+Tcl_CreateChannel(
+ const Tcl_ChannelType *typePtr, /* The channel type record. */
+ const char *chanName, /* Name of channel to record. */
+ ClientData instanceData, /* Instance specific data. */
+ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if
* the channel is readable, writable. */
{
Channel *chanPtr; /* The channel structure newly created. */
ChannelState *statePtr; /* The stack-level independent state info for
* the channel. */
- CONST char *name;
+ const char *name;
+ char *tmp;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
@@ -1093,15 +1497,15 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* as well.
*/
- assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
+ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
* assignments to 0/NULL below.
*/
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
- statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
+ chanPtr = ckalloc(sizeof(Channel));
+ statePtr = ckalloc(sizeof(ChannelState));
chanPtr->state = statePtr;
chanPtr->instanceData = instanceData;
@@ -1112,23 +1516,30 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* information for the channel.
*/
- if (chanName != (char *) NULL) {
- char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
- statePtr->channelName = tmp;
+ if (chanName != NULL) {
+ unsigned len = strlen(chanName) + 1;
+
+ /*
+ * Make sure we allocate at least 7 bytes, so it fits for "stdout"
+ * later.
+ */
+
+ tmp = ckalloc((len < 7) ? 7 : len);
strcpy(tmp, chanName);
} else {
- Tcl_Panic("Tcl_CreateChannel: NULL channel name");
+ tmp = ckalloc(7);
+ tmp[0] = '\0';
}
-
+ statePtr->channelName = tmp;
statePtr->flags = mask;
/*
* Set the channel to system default encoding.
*
- * Note the strange bit of protection taking place here. If the system
+ * Note the strange bit of protection taking place here. If the system
* encoding name is reported back as "binary", something weird is
- * happening. Tcl provides no "binary" encoding, so someone else has
- * provided one. We ignore it so as not to interfere with the "magic"
+ * happening. Tcl provides no "binary" encoding, so someone else has
+ * provided one. We ignore it so as not to interfere with the "magic"
* interpretation that Tcl_Channels give to the "-encoding binary" option.
*/
@@ -1137,17 +1548,17 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
if (strcmp(name, "binary") != 0) {
statePtr->encoding = Tcl_GetEncoding(NULL, name);
}
- statePtr->inputEncodingState = NULL;
- statePtr->inputEncodingFlags = TCL_ENCODING_START;
- statePtr->outputEncodingState = NULL;
- statePtr->outputEncodingFlags = TCL_ENCODING_START;
+ statePtr->inputEncodingState = NULL;
+ statePtr->inputEncodingFlags = TCL_ENCODING_START;
+ statePtr->outputEncodingState = NULL;
+ statePtr->outputEncodingFlags = TCL_ENCODING_START;
/*
* Set the channel up initially in AUTO input translation mode to accept
* "\n", "\r" and "\r\n". Output translation mode is set to a platform
* specific default value. The eofChar is set to 0 for both input and
- * output, so that Tcl does not look for an in-file EOF indicator
- * (e.g. ^Z) and does not append an EOF indicator to files.
+ * output, so that Tcl does not look for an in-file EOF indicator (e.g.
+ * ^Z) and does not append an EOF indicator to files.
*/
statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
@@ -1157,25 +1568,21 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
statePtr->unreportedError = 0;
statePtr->refCount = 0;
- statePtr->closeCbPtr = (CloseCallback *) NULL;
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
- statePtr->outQueueHead = (ChannelBuffer *) NULL;
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
- statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
- statePtr->inQueueHead = (ChannelBuffer *) NULL;
- statePtr->inQueueTail = (ChannelBuffer *) NULL;
- statePtr->chPtr = (ChannelHandler *) NULL;
+ statePtr->closeCbPtr = NULL;
+ statePtr->curOutPtr = NULL;
+ statePtr->outQueueHead = NULL;
+ statePtr->outQueueTail = NULL;
+ statePtr->saveInBufPtr = NULL;
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
+ statePtr->chPtr = NULL;
statePtr->interestMask = 0;
- statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->scriptRecordPtr = NULL;
statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
statePtr->timer = NULL;
- statePtr->csPtr = NULL;
-
+ statePtr->csPtrR = NULL;
+ statePtr->csPtrW = NULL;
statePtr->outputStage = NULL;
- if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
- statePtr->outputStage = (char *)
- ckalloc((unsigned) (statePtr->bufSize + 2));
- }
/*
* As we are creating the channel, it is obviously the top for now.
@@ -1183,14 +1590,17 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
statePtr->topChanPtr = chanPtr;
statePtr->bottomChanPtr = chanPtr;
- chanPtr->downChanPtr = (Channel *) NULL;
- chanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ chanPtr->downChanPtr = NULL;
+ chanPtr->upChanPtr = NULL;
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
+
+ /*
+ * TIP #219, Tcl Channel Reflection API
+ */
- /* TIP #219, Tcl Channel Reflection API */
- statePtr->chanMsg = NULL;
- statePtr->unreportedMsg = NULL;
+ statePtr->chanMsg = NULL;
+ statePtr->unreportedMsg = NULL;
/*
* Link the channel into the list of all channels; create an on-exit
@@ -1201,7 +1611,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
*
* TIP #218.
* AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
- * We need Tcl_SpliceChannel, for the threadAction calls. There is no
+ * We need Tcl_SpliceChannel, for the threadAction calls. There is no
* real reason to duplicate all of this.
* NOTE: All drivers using thread actions now have to perform their TSD
* manipulation only in their thread action proc. Doing it when
@@ -1209,8 +1619,8 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* action activity and lead to damaged lists.
*/
- statePtr->nextCSPtr = (ChannelState *) NULL;
- SpliceChannel ((Tcl_Channel) chanPtr);
+ statePtr->nextCSPtr = NULL;
+ SpliceChannel((Tcl_Channel) chanPtr);
/*
* Install this channel in the first empty standard channel slot, if the
@@ -1218,16 +1628,19 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
*/
if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
+ strcpy(tmp, "stdin");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+ Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stdoutChannel == NULL) &&
(tsdPtr->stdoutInitialized == 1)) {
+ strcpy(tmp, "stdout");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+ Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
} else if ((tsdPtr->stderrChannel == NULL) &&
(tsdPtr->stderrInitialized == 1)) {
+ strcpy(tmp, "stderr");
Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+ Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
}
return (Tcl_Channel) chanPtr;
}
@@ -1251,33 +1664,33 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* information about prevChan.
*
* Side effects:
- * A new channel structure is allocated and linked below the existing
- * channel. The channel operations and client data of the existing channel
- * are copied down to the newly created channel, and the current channel
- * has its operations replaced by the new typePtr.
+ * A new channel structure is allocated and linked below the existing
+ * channel. The channel operations and client data of the existing
+ * channel are copied down to the newly created channel, and the current
+ * channel has its operations replaced by the new typePtr.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
-Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
- Tcl_Interp *interp; /* The interpreter we are working in */
- Tcl_ChannelType *typePtr; /* The channel type record for the new
+Tcl_StackChannel(
+ Tcl_Interp *interp, /* The interpreter we are working in */
+ const Tcl_ChannelType *typePtr,
+ /* The channel type record for the new
* channel. */
- ClientData instanceData; /* Instance specific data for the new
+ ClientData instanceData, /* Instance specific data for the new
* channel. */
- int mask; /* TCL_READABLE & TCL_WRITABLE to indicate if
+ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if
* the channel is readable, writable. */
- Tcl_Channel prevChan; /* The channel structure to replace */
+ Tcl_Channel prevChan) /* The channel structure to replace */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Channel *chanPtr, *prevChanPtr;
ChannelState *statePtr;
- Tcl_DriverThreadActionProc *threadActionProc;
/*
- * Find the given channel (prevChan) in the list of all channels. If we don't find
- * it, then it was never registered correctly.
+ * Find the given channel (prevChan) in the list of all channels. If we do
+ * not find it, then it was never registered correctly.
*
* This operation should occur at the top of a channel stack.
*/
@@ -1285,14 +1698,17 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
statePtr = (ChannelState *) tsdPtr->firstCSPtr;
prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
- while (statePtr->topChanPtr != prevChanPtr) {
+ while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
statePtr = statePtr->nextCSPtr;
}
if (statePtr == NULL) {
- Tcl_AppendResult(interp, "couldn't find state for channel \"",
- Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
- return (Tcl_Channel) NULL;
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find state for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
+ }
+ return NULL;
}
/*
@@ -1309,10 +1725,12 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
*/
if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
- Tcl_AppendResult(interp,
- "reading and writing both disallowed for channel \"",
- Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
- return (Tcl_Channel) NULL;
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "reading and writing both disallowed for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
+ }
+ return NULL;
}
/*
@@ -1323,20 +1741,31 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
*/
if ((mask & TCL_WRITABLE) != 0) {
- CopyState *csPtr;
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = (CopyState *) NULL;
+ statePtr->csPtrR = NULL;
+ statePtr->csPtrW = NULL;
+ /*
+ * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+ * the stacking state of this channel during its operations.
+ */
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
- return (Tcl_Channel) NULL;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
+ }
+ return NULL;
}
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
}
+
/*
* Discard any input in the buffers. They are not yet read by the user of
* the channel, so they have to go through the new transformation before
@@ -1352,8 +1781,7 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
* they are going away.
*/
- if (((mask & TCL_READABLE) != 0) &&
- (statePtr->inQueueHead != (ChannelBuffer *) NULL)) {
+ if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
/*
* Remark: It is possible that the channel buffers contain data from
* some earlier push-backs.
@@ -1362,15 +1790,15 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
prevChanPtr->inQueueHead = statePtr->inQueueHead;
- if (prevChanPtr->inQueueTail == (ChannelBuffer *) NULL) {
+ if (prevChanPtr->inQueueTail == NULL) {
prevChanPtr->inQueueTail = statePtr->inQueueTail;
}
- statePtr->inQueueHead = (ChannelBuffer *) NULL;
- statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
}
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+ chanPtr = ckalloc(sizeof(Channel));
/*
* Save some of the current state into the new structure, reinitialize the
@@ -1383,9 +1811,9 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
chanPtr->instanceData = instanceData;
chanPtr->typePtr = typePtr;
chanPtr->downChanPtr = prevChanPtr;
- chanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ chanPtr->upChanPtr = NULL;
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
/*
* Place new block at the head of a possibly existing list of previously
@@ -1395,7 +1823,8 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
prevChanPtr->upChanPtr = chanPtr;
statePtr->topChanPtr = chanPtr;
- /* TIP #218, Channel Thread Actions.
+ /*
+ * TIP #218, Channel Thread Actions.
*
* We call the thread actions for the new channel directly. We _cannot_
* use SpliceChannel, because the (thread-)global list of all channels
@@ -1405,11 +1834,7 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
* time, mangling it.
*/
- threadActionProc = Tcl_ChannelThreadActionProc (chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc) (chanPtr->instanceData,
- TCL_CHANNEL_THREAD_INSERT);
- }
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
return (Tcl_Channel) chanPtr;
}
@@ -1433,14 +1858,13 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
*/
int
-Tcl_UnstackChannel(interp, chan)
- Tcl_Interp *interp; /* The interpreter we are working in */
- Tcl_Channel chan; /* The channel to unstack */
+Tcl_UnstackChannel(
+ Tcl_Interp *interp, /* The interpreter we are working in */
+ Tcl_Channel chan) /* The channel to unstack */
{
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state;
int result = 0;
- Tcl_DriverThreadActionProc *threadActionProc;
/*
* This operation should occur at the top of a channel stack.
@@ -1448,12 +1872,19 @@ Tcl_UnstackChannel(interp, chan)
chanPtr = statePtr->topChanPtr;
- if (chanPtr->downChanPtr != (Channel *) NULL) {
+ if (chanPtr->downChanPtr != NULL) {
/*
* Instead of manipulating the per-thread / per-interp list/hashtable
- * of registered channels we wind down the state of the transformation,
- * and then restore the state of underlying channel into the old
- * structure.
+ * of registered channels we wind down the state of the
+ * transformation, and then restore the state of underlying channel
+ * into the old structure.
+ */
+
+ /*
+ * TODO: Figure out how to handle the situation where the chan
+ * operations called below by this unstacking operation cause
+ * another unstacking recursively. In that case the downChanPtr
+ * value we're holding on to will not be the right thing.
*/
Channel *downChanPtr = chanPtr->downChanPtr;
@@ -1466,29 +1897,35 @@ Tcl_UnstackChannel(interp, chan)
* CheckForChannelErrors inside.
*/
- if (statePtr->flags & TCL_WRITABLE) {
- CopyState *csPtr;
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = (CopyState *) NULL;
+ statePtr->csPtrR = NULL;
+ statePtr->csPtrW = NULL;
if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
- /* TIP #219, Tcl Channel Reflection API.
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move error messages put by the driver into the chan/ip
* bypass area into the regular interpreter result. Fall back
* to the regular message if nothing was found in the
* bypasses.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
- (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr)));
}
return TCL_ERROR;
}
- statePtr->csPtr = csPtr;
+ statePtr->csPtrR = csPtrR;
+ statePtr->csPtrW = csPtrW;
}
/*
@@ -1501,28 +1938,27 @@ Tcl_UnstackChannel(interp, chan)
* 'DiscardInputQueued' on that.
*/
- if (((statePtr->flags & TCL_READABLE) != 0) &&
- ((statePtr->inQueueHead != (ChannelBuffer *) NULL) ||
- (chanPtr->inQueueHead != (ChannelBuffer *) NULL))) {
-
- if ((statePtr->inQueueHead != (ChannelBuffer *) NULL) &&
- (chanPtr->inQueueHead != (ChannelBuffer *) NULL)) {
+ if (GotFlag(statePtr, TCL_READABLE) &&
+ ((statePtr->inQueueHead != NULL) ||
+ (chanPtr->inQueueHead != NULL))) {
+ if ((statePtr->inQueueHead != NULL) &&
+ (chanPtr->inQueueHead != NULL)) {
statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
statePtr->inQueueHead = statePtr->inQueueTail;
-
- } else if (chanPtr->inQueueHead != (ChannelBuffer *) NULL) {
+ } else if (chanPtr->inQueueHead != NULL) {
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
}
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
DiscardInputQueued(statePtr, 0);
}
- /* TIP #218, Channel Thread Actions.
+ /*
+ * TIP #218, Channel Thread Actions.
*
* We call the thread actions for the new channel directly. We
* _cannot_ use CutChannel, because the (thread-)global list of all
@@ -1533,67 +1969,62 @@ Tcl_UnstackChannel(interp, chan)
* the state which are still active.
*/
- threadActionProc = Tcl_ChannelThreadActionProc (chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc) (chanPtr->instanceData,
- TCL_CHANNEL_THREAD_REMOVE);
- }
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
statePtr->topChanPtr = downChanPtr;
- downChanPtr->upChanPtr = (Channel *) NULL;
+ downChanPtr->upChanPtr = NULL;
/*
* Leave this link intact for closeproc
- * chanPtr->downChanPtr = (Channel *) NULL;
+ * chanPtr->downChanPtr = NULL;
*/
/*
* Close and free the channel driver state.
*/
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
- interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- interp, 0);
- }
-
+ result = ChanClose(chanPtr, interp);
chanPtr->typePtr = NULL;
/*
* AK: Tcl_NotifyChannel may hold a reference to this block of memory
*/
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
- /* TIP #219, Tcl Channel Reflection API.
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move error messages put by the driver into the chan/ip bypass
* area into the regular interpreter result.
*/
- TclChanCaughtErrorBypass (interp, chan);
+
+ TclChanCaughtErrorBypass(interp, chan);
return TCL_ERROR;
}
} else {
/*
- * This channel does not cover another one. Simply do a close, if
+ * This channel does not cover another one. Simply do a close, if
* necessary.
*/
if (statePtr->refCount <= 0) {
if (Tcl_Close(interp, chan) != TCL_OK) {
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* "TclChanCaughtErrorBypass" is not required here, it was
* done already by "Tcl_Close".
*/
+
return TCL_ERROR;
}
}
- /* TIP #218, Channel Thread Actions.
+ /*
+ * TIP #218, Channel Thread Actions.
* Not required in this branch, this is done by Tcl_Close. If
* Tcl_Close is not called then the ChannelState is still active in
* the thread and no action has to be taken either.
@@ -1622,10 +2053,11 @@ Tcl_UnstackChannel(interp, chan)
*/
Tcl_Channel
-Tcl_GetStackedChannel(chan)
- Tcl_Channel chan;
+Tcl_GetStackedChannel(
+ Tcl_Channel chan)
{
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The actual channel. */
return (Tcl_Channel) chanPtr->downChanPtr;
}
@@ -1649,10 +2081,11 @@ Tcl_GetStackedChannel(chan)
*/
Tcl_Channel
-Tcl_GetTopChannel(chan)
- Tcl_Channel chan;
+Tcl_GetTopChannel(
+ Tcl_Channel chan)
{
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The actual channel. */
return (Tcl_Channel) chanPtr->state->topChanPtr;
}
@@ -1674,10 +2107,11 @@ Tcl_GetTopChannel(chan)
*/
ClientData
-Tcl_GetChannelInstanceData(chan)
- Tcl_Channel chan; /* Channel for which to return client data. */
+Tcl_GetChannelInstanceData(
+ Tcl_Channel chan) /* Channel for which to return client data. */
{
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The actual channel. */
return chanPtr->instanceData;
}
@@ -1687,7 +2121,7 @@ Tcl_GetChannelInstanceData(chan)
*
* Tcl_GetChannelThread --
*
- * Given a channel structure, returns the thread managing it. TIP #10
+ * Given a channel structure, returns the thread managing it. TIP #10
*
* Results:
* Returns the id of the thread managing the channel.
@@ -1699,11 +2133,12 @@ Tcl_GetChannelInstanceData(chan)
*/
Tcl_ThreadId
-Tcl_GetChannelThread(chan)
- Tcl_Channel chan; /* The channel to return managing thread
+Tcl_GetChannelThread(
+ Tcl_Channel chan) /* The channel to return the managing thread
* for. */
{
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The actual channel. */
return chanPtr->state->managingThread;
}
@@ -1724,9 +2159,9 @@ Tcl_GetChannelThread(chan)
*----------------------------------------------------------------------
*/
-Tcl_ChannelType *
-Tcl_GetChannelType(chan)
- Tcl_Channel chan; /* The channel to return type for. */
+const Tcl_ChannelType *
+Tcl_GetChannelType(
+ Tcl_Channel chan) /* The channel to return type for. */
{
Channel *chanPtr = (Channel *) chan;
/* The actual channel. */
@@ -1752,8 +2187,8 @@ Tcl_GetChannelType(chan)
*/
int
-Tcl_GetChannelMode(chan)
- Tcl_Channel chan; /* The channel for which the mode is being
+Tcl_GetChannelMode(
+ Tcl_Channel chan) /* The channel for which the mode is being
* computed. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
@@ -1779,13 +2214,13 @@ Tcl_GetChannelMode(chan)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetChannelName(chan)
- Tcl_Channel chan; /* The channel for which to return the name. */
+const char *
+Tcl_GetChannelName(
+ Tcl_Channel chan) /* The channel for which to return the name. */
{
- ChannelState *statePtr; /* State of actual channel. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of actual channel. */
- statePtr = ((Channel *) chan)->state;
return statePtr->channelName;
}
@@ -1807,18 +2242,24 @@ Tcl_GetChannelName(chan)
*/
int
-Tcl_GetChannelHandle(chan, direction, handlePtr)
- Tcl_Channel chan; /* The channel to get file from. */
- int direction; /* TCL_WRITABLE or TCL_READABLE. */
- ClientData *handlePtr; /* Where to store handle */
+Tcl_GetChannelHandle(
+ Tcl_Channel chan, /* The channel to get file from. */
+ int direction, /* TCL_WRITABLE or TCL_READABLE. */
+ ClientData *handlePtr) /* Where to store handle */
{
Channel *chanPtr; /* The actual channel. */
ClientData handle;
int result;
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
- result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
- direction, &handle);
+ if (!chanPtr->typePtr->getHandleProc) {
+ 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,
+ &handle);
if (handlePtr) {
*handlePtr = handle;
}
@@ -1850,20 +2291,45 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
*/
static ChannelBuffer *
-AllocChannelBuffer(length)
- int length; /* Desired length of channel buffer. */
+AllocChannelBuffer(
+ int length) /* Desired length of channel buffer. */
{
ChannelBuffer *bufPtr;
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;
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree(bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -1885,18 +2351,21 @@ AllocChannelBuffer(length)
*/
static void
-RecycleBuffer(statePtr, bufPtr, mustDiscard)
- ChannelState *statePtr; /* ChannelState in which to recycle buffers. */
- ChannelBuffer *bufPtr; /* The buffer to recycle. */
- int mustDiscard; /* If nonzero, free the buffer to the OS,
+RecycleBuffer(
+ ChannelState *statePtr, /* ChannelState in which to recycle buffers. */
+ ChannelBuffer *bufPtr, /* The buffer to recycle. */
+ int mustDiscard) /* If nonzero, free the buffer to the OS,
* always. */
{
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -1907,7 +2376,7 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
*/
if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -1915,13 +2384,13 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
* Only save buffers for the input queue if the channel is readable.
*/
- if (statePtr->flags & TCL_READABLE) {
- if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (GotFlag(statePtr, TCL_READABLE)) {
+ if (statePtr->inQueueHead == NULL) {
statePtr->inQueueHead = bufPtr;
statePtr->inQueueTail = bufPtr;
goto keepBuffer;
}
- if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
+ if (statePtr->saveInBufPtr == NULL) {
statePtr->saveInBufPtr = bufPtr;
goto keepBuffer;
}
@@ -1931,8 +2400,8 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
* Only save buffers for the output queue if the channel is writable.
*/
- if (statePtr->flags & TCL_WRITABLE) {
- if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
+ if (statePtr->curOutPtr == NULL) {
statePtr->curOutPtr = bufPtr;
goto keepBuffer;
}
@@ -1942,13 +2411,13 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
* If we reached this code we return the buffer to the OS.
*/
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->nextAdded = BUFFER_PADDING;
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ bufPtr->nextPtr = NULL;
}
/*
@@ -1968,18 +2437,18 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
*/
static void
-DiscardOutputQueued(statePtr)
- ChannelState *statePtr; /* ChannelState for which to discard output. */
+DiscardOutputQueued(
+ ChannelState *statePtr) /* ChannelState for which to discard output. */
{
ChannelBuffer *bufPtr;
- while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+ while (statePtr->outQueueHead != NULL) {
bufPtr = statePtr->outQueueHead;
statePtr->outQueueHead = bufPtr->nextPtr;
RecycleBuffer(statePtr, bufPtr, 0);
}
- statePtr->outQueueHead = (ChannelBuffer *) NULL;
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = NULL;
+ statePtr->outQueueTail = NULL;
}
/*
@@ -2000,20 +2469,20 @@ DiscardOutputQueued(statePtr)
*/
static int
-CheckForDeadChannel(interp, statePtr)
- Tcl_Interp *interp; /* For error reporting (can be NULL) */
- ChannelState *statePtr; /* The channel state to check. */
+CheckForDeadChannel(
+ Tcl_Interp *interp, /* For error reporting (can be NULL) */
+ ChannelState *statePtr) /* The channel state to check. */
{
- if (statePtr->flags & CHANNEL_DEAD) {
- Tcl_SetErrno(EINVAL);
- if (interp) {
- Tcl_AppendResult(interp,
- "unable to access channel: invalid channel",
- (char *) NULL);
- }
- return 1;
+ if (!GotFlag(statePtr, CHANNEL_DEAD)) {
+ return 0;
}
- return 0;
+
+ Tcl_SetErrno(EINVAL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to access channel: invalid channel", -1));
+ }
+ return 1;
}
/*
@@ -2021,9 +2490,9 @@ CheckForDeadChannel(interp, statePtr)
*
* FlushChannel --
*
- * This function flushes as much of the queued output as is possible
- * now. If calledFromAsyncFlush is nonzero, it is being called in an
- * event handler to flush channel output asynchronously.
+ * This function flushes as much of the queued output as is possible now.
+ * If calledFromAsyncFlush is nonzero, it is being called in an event
+ * handler to flush channel output asynchronously.
*
* Results:
* 0 if successful, else the error code that was returned by the channel
@@ -2031,32 +2500,30 @@ CheckForDeadChannel(interp, statePtr)
*
* Side effects:
* May produce output on a channel. May block indefinitely if the channel
- * is synchronous. May schedule an async flush on the channel. May
+ * is synchronous. May schedule an async flush on the channel. May
* recycle memory for buffers in the output queue.
*
*----------------------------------------------------------------------
*/
static int
-FlushChannel(interp, chanPtr, calledFromAsyncFlush)
- Tcl_Interp *interp; /* For error reporting during close. */
- Channel *chanPtr; /* The channel to flush on. */
- int calledFromAsyncFlush; /* If nonzero then we are being called
- * from an asynchronous flush
- * callback. */
+FlushChannel(
+ Tcl_Interp *interp, /* For error reporting during close. */
+ Channel *chanPtr, /* The channel to flush on. */
+ int calledFromAsyncFlush) /* If nonzero then we are being called from an
+ * asynchronous flush callback. */
{
ChannelState *statePtr = chanPtr->state;
- /* State of the channel stack. */
- ChannelBuffer *bufPtr; /* Iterates over buffered output
- * queue. */
- int toWrite; /* Amount of output data in current
- * buffer available to be written. */
- int written; /* Amount of output data actually
- * written in current round. */
- int errorCode = 0; /* Stores POSIX error codes from
- * channel driver operations. */
- int wroteSome = 0; /* Set to one if any data was written
- * to the driver. */
+ /* State of the channel stack. */
+ ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */
+ int toWrite; /* Amount of output data in current buffer
+ * available to be written. */
+ int written; /* Amount of output data actually written in
+ * current round. */
+ int errorCode = 0; /* Stores POSIX error codes from channel
+ * driver operations. */
+ int wroteSome = 0; /* Set to one if any data was written to the
+ * driver. */
/*
* Prevent writing on a dead channel -- a channel that has been closed but
@@ -2074,6 +2541,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* 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
@@ -2081,19 +2549,19 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* queue.
*/
- if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
- || ((statePtr->flags & BUFFER_READY) &&
- (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
- statePtr->flags &= (~(BUFFER_READY));
- statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
- if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ if (((statePtr->curOutPtr != NULL) &&
+ IsBufferFull(statePtr->curOutPtr))
+ || (GotFlag(statePtr, BUFFER_READY) &&
+ (statePtr->outQueueHead == NULL))) {
+ ResetFlag(statePtr, BUFFER_READY);
+ statePtr->curOutPtr->nextPtr = NULL;
+ if (statePtr->outQueueHead == NULL) {
statePtr->outQueueHead = statePtr->curOutPtr;
} else {
statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
}
statePtr->outQueueTail = statePtr->curOutPtr;
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
+ statePtr->curOutPtr = NULL;
}
bufPtr = statePtr->outQueueHead;
@@ -2102,27 +2570,31 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* is active, we just return without producing any output.
*/
- if ((!calledFromAsyncFlush) &&
- (statePtr->flags & BG_FLUSH_SCHEDULED)) {
- return 0;
+ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ errorCode = 0;
+ goto done;
}
/*
* If the output queue is still empty, break out of the while loop.
*/
- if (bufPtr == (ChannelBuffer *) NULL) {
- break; /* Out of the "while (1)". */
+ if (bufPtr == NULL) {
+ break; /* Out of the "while (1)". */
}
/*
* Produce the output on the channel.
*/
- toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
- written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextRemoved, toWrite,
- &errorCode);
+ PreserveChannelBuffer(bufPtr);
+ toWrite = BytesLeft(bufPtr);
+ if (toWrite == 0) {
+ written = 0;
+ } else {
+ written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
+ &errorCode);
+ }
/*
* If the write failed completely attempt to start the asynchronous
@@ -2131,7 +2603,6 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (written < 0) {
-
/*
* If the last attempt to write was interrupted, simply retry.
*/
@@ -2149,13 +2620,13 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
/*
* This used to check for CHANNEL_NONBLOCKING, and panic if
- * the channel was blocking. However, it appears that setting
+ * the channel was blocking. However, it appears that setting
* stdin to -blocking 0 has some effect on the stdout when
* it's a tty channel (dup'ed underneath)
*/
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
- statePtr->flags |= BG_FLUSH_SCHEDULED;
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
+ SetFlag(statePtr, BG_FLUSH_SCHEDULED);
UpdateInterest(chanPtr);
}
errorCode = 0;
@@ -2167,52 +2638,50 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (calledFromAsyncFlush) {
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* When defering the error copy a message from the bypass into
* the unreported area. Or discard it if the new error is to be
* ignored in favor of an earlier defered error.
*/
- Tcl_Obj* msg = statePtr->chanMsg;
+ Tcl_Obj *msg = statePtr->chanMsg;
if (statePtr->unreportedError == 0) {
statePtr->unreportedError = errorCode;
- statePtr->unreportedMsg = msg;
+ statePtr->unreportedMsg = msg;
if (msg != NULL) {
- Tcl_IncrRefCount (msg);
+ Tcl_IncrRefCount(msg);
}
} else {
- /* An old unreported error is kept, and this error
- * thrown away.
+ /*
+ * An old unreported error is kept, and this error thrown
+ * away.
*/
+
statePtr->chanMsg = NULL;
if (msg != NULL) {
- Tcl_DecrRefCount (msg);
+ TclDecrRefCount(msg);
}
}
} else {
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move error messages put by the driver into the chan bypass
* area into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypasses.
*/
Tcl_SetErrno(errorCode);
- if (interp != NULL) {
- if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) {
- /*
- * Casting away CONST here is safe because the
- * TCL_VOLATILE flag guarantees CONST treatment
- * of the Posix error string.
- */
-
- Tcl_SetResult(interp,
- (char *) Tcl_PosixError(interp),
- TCL_VOLATILE);
- }
+ if (interp != NULL && !TclChanCaughtErrorBypass(interp,
+ (Tcl_Channel) chanPtr)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- /* An unreportable bypassed message is kept, for the
- * caller of Tcl_Seek, Tcl_Write, etc.
+
+ /*
+ * An unreportable bypassed message is kept, for the caller of
+ * Tcl_Seek, Tcl_Write, etc.
*/
}
@@ -2227,35 +2696,37 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
wroteSome = 1;
}
- bufPtr->nextRemoved += written;
+ if (!IsBufferEmpty(bufPtr)) {
+ bufPtr->nextRemoved += written;
+ }
/*
* If this buffer is now empty, recycle it.
*/
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ if (IsBufferEmpty(bufPtr)) {
statePtr->outQueueHead = bufPtr->nextPtr;
- if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
+ if (statePtr->outQueueHead == NULL) {
+ statePtr->outQueueTail = NULL;
}
RecycleBuffer(statePtr, bufPtr, 0);
}
+ ReleaseChannelBuffer(bufPtr);
} /* Closes "while (1)". */
/*
* If we wrote some data while flushing in the background, we are done.
* We can't finish the background flush until we run out of data and the
- * channel becomes writable again. This ensures that all of the pending
+ * channel becomes writable again. This ensures that all of the pending
* data has been flushed at the system level.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
if (wroteSome) {
- return errorCode;
- } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
- statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
- statePtr->interestMask);
+ goto done;
+ } else if (statePtr->outQueueHead == NULL) {
+ ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
+ ChanWatch(chanPtr, statePtr->interestMask);
}
}
@@ -2265,13 +2736,30 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* current output buffer.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
- (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
- ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
- (statePtr->curOutPtr->nextAdded ==
- statePtr->curOutPtr->nextRemoved))) {
- return CloseChannel(interp, chanPtr, errorCode);
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+ (statePtr->outQueueHead == NULL) &&
+ ((statePtr->curOutPtr == NULL) ||
+ IsBufferEmpty(statePtr->curOutPtr))) {
+ errorCode = CloseChannel(interp, chanPtr, errorCode);
+ goto done;
}
+
+ /*
+ * If the write-side of the channel is flagged as closed, delete it when
+ * the output queue is empty and there is no output in the current output
+ * buffer.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
+ (statePtr->outQueueHead == NULL) &&
+ ((statePtr->curOutPtr == NULL) ||
+ IsBufferEmpty(statePtr->curOutPtr))) {
+ errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ goto done;
+ }
+
+ done:
+ Tcl_Release(chanPtr);
return errorCode;
}
@@ -2284,7 +2772,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*
* If the channel was stacked, then the it will copy the necessary
* elements of the NEXT channel into the TOP channel, in essence
- * unstacking the channel. The NEXT channel will then be freed.
+ * unstacking the channel. The NEXT channel will then be freed.
*
* If the channel was not stacked, then we will free all the bits for the
* TOP channel, including the data structure itself.
@@ -2300,14 +2788,13 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
static int
-CloseChannel(interp, chanPtr, errorCode)
- Tcl_Interp *interp; /* For error reporting. */
- Channel *chanPtr; /* The channel to close. */
- int errorCode; /* Status of operation so far. */
-{
- int result = 0; /* Of calling driver close
- * operation. */
- ChannelState *statePtr; /* state of the channel stack. */
+CloseChannel(
+ Tcl_Interp *interp, /* For error reporting. */
+ Channel *chanPtr, /* The channel to close. */
+ int errorCode) /* Status of operation so far. */
+{
+ int result = 0; /* Of calling driver close operation. */
+ ChannelState *statePtr; /* State of the channel stack. */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (chanPtr == NULL) {
@@ -2325,16 +2812,16 @@ CloseChannel(interp, chanPtr, errorCode)
* Discard a leftover buffer in the current output buffer field.
*/
- if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) statePtr->curOutPtr);
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
+ if (statePtr->curOutPtr != NULL) {
+ ReleaseChannelBuffer(statePtr->curOutPtr);
+ statePtr->curOutPtr = NULL;
}
/*
* The caller guarantees that there are no more buffers queued for output.
*/
- if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+ if (statePtr->outQueueHead != NULL) {
Tcl_Panic("TclFlush, closed channel: queued output left");
}
@@ -2343,23 +2830,24 @@ CloseChannel(interp, chanPtr, errorCode)
* device.
*/
- if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
int dummy;
char c = (char) statePtr->outEofChar;
- (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
+ (void) ChanWrite(chanPtr, &c, 1, &dummy);
}
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move a leftover error message in the channel bypass into the
* interpreter bypass. Just clear it if there is no interpreter.
*/
if (statePtr->chanMsg != NULL) {
if (interp != NULL) {
- Tcl_SetChannelErrorInterp (interp,statePtr->chanMsg);
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
}
- Tcl_DecrRefCount (statePtr->chanMsg);
+ TclDecrRefCount(statePtr->chanMsg);
statePtr->chanMsg = NULL;
}
@@ -2374,12 +2862,7 @@ CloseChannel(interp, chanPtr, errorCode)
* This may leave a TIP #219 error message in the interp.
*/
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- interp, 0);
- }
+ result = ChanClose(chanPtr, interp);
/*
* Some resources can be cleared only if the bottom channel in a stack is
@@ -2387,16 +2870,12 @@ CloseChannel(interp, chanPtr, errorCode)
*/
if (chanPtr == statePtr->bottomChanPtr) {
- if (statePtr->channelName != (char *) NULL) {
- ckfree((char *) statePtr->channelName);
+ if (statePtr->channelName != NULL) {
+ ckfree(statePtr->channelName);
statePtr->channelName = NULL;
}
Tcl_FreeEncoding(statePtr->encoding);
- if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
- statePtr->outputStage = (char *) NULL;
- }
}
/*
@@ -2407,16 +2886,19 @@ CloseChannel(interp, chanPtr, errorCode)
if (statePtr->unreportedError != 0) {
errorCode = statePtr->unreportedError;
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move an error message found in the unreported area into the regular
* bypass (interp). This kills any message in the channel bypass area.
*/
if (statePtr->chanMsg != NULL) {
- Tcl_DecrRefCount (statePtr->chanMsg);
+ TclDecrRefCount(statePtr->chanMsg);
statePtr->chanMsg = NULL;
}
- Tcl_SetChannelErrorInterp (interp,statePtr->unreportedMsg);
+ if (interp) {
+ Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
+ }
}
if (errorCode == 0) {
errorCode = result;
@@ -2435,31 +2917,31 @@ CloseChannel(interp, chanPtr, errorCode)
* Mark the channel as deleted by clearing the type structure.
*/
- if (chanPtr->downChanPtr != (Channel *) NULL) {
+ if (chanPtr->downChanPtr != NULL) {
Channel *downChanPtr = chanPtr->downChanPtr;
- statePtr->nextCSPtr = tsdPtr->firstCSPtr;
- tsdPtr->firstCSPtr = statePtr;
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
- statePtr->topChanPtr = downChanPtr;
- downChanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->typePtr = NULL;
+ statePtr->topChanPtr = downChanPtr;
+ downChanPtr->upChanPtr = NULL;
+ chanPtr->typePtr = NULL;
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
}
/*
* There is only the TOP Channel, so we free the remaining pointers we
- * have and then ourselves. Since this is the last of the channels in the
+ * have and then ourselves. Since this is the last of the channels in the
* stack, make sure to free the ChannelState structure associated with it.
* We use Tcl_EventuallyFree to allow for any last references.
*/
chanPtr->typePtr = NULL;
- Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
return errorCode;
}
@@ -2471,7 +2953,7 @@ CloseChannel(interp, chanPtr, errorCode)
* CutChannel --
*
* Removes a channel from the (thread-)global list of all channels (in
- * that thread). This is actually the statePtr for the stack of channel.
+ * that thread). This is actually the statePtr for the stack of channel.
*
* Results:
* Nothing.
@@ -2490,18 +2972,16 @@ CloseChannel(interp, chanPtr, errorCode)
*/
static void
-CutChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
+CutChannel(
+ Tcl_Channel chan) /* The channel being removed. Must not be
+ * referenced in any interpreter. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *prevCSPtr; /* Preceding channel state in list of
- * all states - used to splice a
- * channel out of the list on close. */
+ ChannelState *prevCSPtr; /* Preceding channel state in list of all
+ * states - used to splice a channel out of
+ * the list on close. */
ChannelState *statePtr = ((Channel *) chan)->state;
- /* state of the channel stack. */
- Tcl_DriverThreadActionProc *threadActionProc;
+ /* State of the channel stack. */
/*
* Remove this channel from of the list of all channels (in the current
@@ -2516,36 +2996,33 @@ CutChannel(chan)
prevCSPtr = prevCSPtr->nextCSPtr) {
/* Empty loop body. */
}
- if (prevCSPtr == (ChannelState *) NULL) {
+ if (prevCSPtr == NULL) {
Tcl_Panic("FlushChannel: damaged channel list");
}
prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
}
- statePtr->nextCSPtr = (ChannelState *) NULL;
+ statePtr->nextCSPtr = NULL;
- /* TIP #218, Channel Thread Actions */
- threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
- if (threadActionProc != NULL) {
- (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_REMOVE);
- }
+ /*
+ * TIP #218, Channel Thread Actions
+ */
+
+ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE);
}
void
-Tcl_CutChannel(chan)
- Tcl_Channel chan; /* The channel being added. Must not
- * be referenced in any
- * interpreter. */
+Tcl_CutChannel(
+ Tcl_Channel chan) /* The channel being added. Must not be
+ * referenced in any interpreter. */
{
- Channel* chanPtr = ((Channel*) chan)->state->bottomChanPtr;
+ Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *prevCSPtr; /* Preceding channel state in list of
- * all states - used to splice a
- * channel out of the list on close. */
+ ChannelState *prevCSPtr; /* Preceding channel state in list of all
+ * states - used to splice a channel out of
+ * the list on close. */
ChannelState *statePtr = chanPtr->state;
- /* state of the channel stack. */
- Tcl_DriverThreadActionProc *threadActionProc;
+ /* State of the channel stack. */
/*
* Remove this channel from of the list of all channels (in the current
@@ -2560,25 +3037,21 @@ Tcl_CutChannel(chan)
prevCSPtr = prevCSPtr->nextCSPtr) {
/* Empty loop body. */
}
- if (prevCSPtr == (ChannelState *) NULL) {
+ if (prevCSPtr == NULL) {
Tcl_Panic("FlushChannel: damaged channel list");
}
prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
}
- statePtr->nextCSPtr = (ChannelState *) NULL;
+ statePtr->nextCSPtr = NULL;
- /* TIP #218, Channel Thread Actions
+ /*
+ * TIP #218, Channel Thread Actions
* For all transformations and the base channel.
*/
- while (chanPtr) {
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc) (chanPtr->instanceData,
- TCL_CHANNEL_THREAD_REMOVE);
- }
- chanPtr= chanPtr->upChanPtr;
+ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
}
}
@@ -2609,16 +3082,14 @@ Tcl_CutChannel(chan)
*/
static void
-SpliceChannel(chan)
- Tcl_Channel chan; /* The channel being added. Must not
- * be referenced in any
- * interpreter. */
+SpliceChannel(
+ Tcl_Channel chan) /* The channel being added. Must not be
+ * referenced in any interpreter. */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *statePtr = ((Channel *) chan)->state;
- Tcl_DriverThreadActionProc *threadActionProc;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ChannelState *statePtr = ((Channel *) chan)->state;
- if (statePtr->nextCSPtr != (ChannelState *) NULL) {
+ if (statePtr->nextCSPtr != NULL) {
Tcl_Panic("SpliceChannel: trying to add channel used in different list");
}
@@ -2633,26 +3104,23 @@ SpliceChannel(chan)
statePtr->managingThread = Tcl_GetCurrentThread();
- /* TIP #218, Channel Thread Actions */
- threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
- if (threadActionProc != NULL) {
- (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_INSERT);
- }
+ /*
+ * TIP #218, Channel Thread Actions
+ */
+
+ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);
}
void
-Tcl_SpliceChannel(chan)
- Tcl_Channel chan; /* The channel being added. Must not
- * be referenced in any
- * interpreter. */
+Tcl_SpliceChannel(
+ Tcl_Channel chan) /* The channel being added. Must not be
+ * referenced in any interpreter. */
{
- Channel *chanPtr = ((Channel*) chan)->state->bottomChanPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *statePtr = chanPtr->state;
- Tcl_DriverThreadActionProc *threadActionProc;
+ Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ChannelState *statePtr = chanPtr->state;
- if (statePtr->nextCSPtr != (ChannelState *) NULL) {
+ if (statePtr->nextCSPtr != NULL) {
Tcl_Panic("SpliceChannel: trying to add channel used in different list");
}
@@ -2667,17 +3135,13 @@ Tcl_SpliceChannel(chan)
statePtr->managingThread = Tcl_GetCurrentThread();
- /* TIP #218, Channel Thread Actions
+ /*
+ * TIP #218, Channel Thread Actions
* For all transformations and the base channel.
*/
- while (chanPtr) {
- threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
- if (threadActionProc != NULL) {
- (*threadActionProc) (chanPtr->instanceData,
- TCL_CHANNEL_THREAD_INSERT);
- }
- chanPtr= chanPtr->upChanPtr;
+ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+ ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
}
}
@@ -2705,20 +3169,20 @@ Tcl_SpliceChannel(chan)
/* ARGSUSED */
int
-Tcl_Close(interp, chan)
- Tcl_Interp *interp; /* Interpreter for errors. */
- Tcl_Channel chan; /* The channel being closed. Must not
- * be referenced in any
- * interpreter. */
-{
- CloseCallback *cbPtr; /* Iterate over close callbacks for
- * this channel. */
- Channel *chanPtr; /* The real IO channel. */
- ChannelState *statePtr; /* State of real IO channel. */
- int result; /* Of calling FlushChannel. */
+Tcl_Close(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Tcl_Channel chan) /* The channel being closed. Must not be
+ * referenced in any interpreter. */
+{
+ CloseCallback *cbPtr; /* Iterate over close callbacks for this
+ * channel. */
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
+ int result; /* Of calling FlushChannel. */
int flushcode;
+ int stickyError;
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_OK;
}
@@ -2744,33 +3208,42 @@ Tcl_Close(interp, chan)
Tcl_Panic("called Tcl_Close on channel with refCount > 0");
}
- if (statePtr->flags & CHANNEL_INCLOSE) {
- Tcl_AppendResult(interp, "Illegal recursive call to close ",
- "through close-handler of channel", (char *) NULL);
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
+ }
return TCL_ERROR;
}
- statePtr->flags |= CHANNEL_INCLOSE;
+ SetFlag(statePtr, CHANNEL_INCLOSE);
/*
* When the channel has an escape sequence driven encoding such as
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ stickyError = 0;
+
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
- WriteChars(chanPtr, "", 0);
+ if (WriteChars(chanPtr, "", 0) < 0) {
+ stickyError = Tcl_GetErrno();
+ }
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move an error message found in the channel bypass into the
* interpreter bypass. Just clear it if there is no interpreter.
*/
if (statePtr->chanMsg != NULL) {
if (interp != NULL) {
- Tcl_SetChannelErrorInterp (interp,statePtr->chanMsg);
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
}
- Tcl_DecrRefCount (statePtr->chanMsg);
+ TclDecrRefCount(statePtr->chanMsg);
statePtr->chanMsg = NULL;
}
}
@@ -2781,22 +3254,21 @@ Tcl_Close(interp, chan)
* Invoke the registered close callbacks and delete their records.
*/
- while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
+ while (statePtr->closeCbPtr != NULL) {
cbPtr = statePtr->closeCbPtr;
statePtr->closeCbPtr = cbPtr->nextPtr;
- (cbPtr->proc) (cbPtr->clientData);
- ckfree((char *) cbPtr);
+ cbPtr->proc(cbPtr->clientData);
+ ckfree(cbPtr);
}
- statePtr->flags &= ~CHANNEL_INCLOSE;
+ ResetFlag(statePtr, CHANNEL_INCLOSE);
/*
* Ensure that the last output buffer will be flushed.
*/
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
}
/*
@@ -2805,7 +3277,7 @@ Tcl_Close(interp, chan)
*/
if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
TCL_CLOSE_READ);
} else {
result = 0;
@@ -2817,25 +3289,45 @@ Tcl_Close(interp, chan)
* be flushed and closed asynchronously.
*/
- statePtr->flags |= CHANNEL_CLOSED;
+ SetFlag(statePtr, CHANNEL_CLOSED);
flushcode = FlushChannel(interp, chanPtr, 0);
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result.
*
* Notes: Due to the assertion of CHANNEL_CLOSED in the flags
- * "FlushChannel" has called "CloseChannel" and thus freed all the channel
+ * FlushChannel() has called CloseChannel() and thus freed all the channel
* structures. We must not try to access "chan" anymore, hence the NULL
* argument in the call below. The only place which may still contain a
* message is the interpreter itself, and "CloseChannel" made sure to lift
* any channel message it generated into it.
*/
- if (TclChanCaughtErrorBypass (interp, NULL)) {
+
+ if (TclChanCaughtErrorBypass(interp, NULL)) {
result = EINVAL;
}
+ if (stickyError != 0) {
+ Tcl_SetErrno(stickyError);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+ }
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+ }
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
}
@@ -2845,6 +3337,353 @@ Tcl_Close(interp, chan)
/*
*----------------------------------------------------------------------
*
+ * Tcl_CloseEx --
+ *
+ * Closes one side of a channel, read or write.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes one direction of the channel.
+ *
+ * NOTE:
+ * Tcl_CloseEx closes the specified direction of the channel as far as
+ * the user is concerned. The channel keeps existing however. You cannot
+ * calls this function to close the last possible direction of the
+ * channel. Use Tcl_Close for that.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_CloseEx(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Tcl_Channel chan, /* The channel being closed. May still be used
+ * by some interpreter. */
+ int flags) /* Flags telling us which side to close. */
+{
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
+
+ if (chan == NULL) {
+ return TCL_OK;
+ }
+
+ /* TODO: assert flags validity ? */
+
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+
+ /*
+ * Does the channel support half-close anyway? Error if not.
+ */
+
+ if (!chanPtr->typePtr->close2Proc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "half-close of channels not supported by %ss",
+ chanPtr->typePtr->typeName));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Is the channel unstacked ? If not we fail.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "half-close not applicable to stack of transformations", -1));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check direction against channel mode. It is an error if we try to close
+ * a direction not supported by the channel (already closed, or never
+ * opened for that direction).
+ */
+
+ if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
+ const char *msg;
+
+ if (flags & TCL_CLOSE_READ) {
+ msg = "read";
+ } else {
+ msg = "write";
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened or"
+ " already closed", msg));
+ return TCL_ERROR;
+ }
+
+ /*
+ * A user may try to call half-close from within a channel close
+ * handler. That won't do.
+ */
+
+ if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
+ }
+ return TCL_ERROR;
+ }
+
+ if (flags & TCL_CLOSE_READ) {
+ /*
+ * Call the finalization code directly. There are no events to handle,
+ * there cannot be for the read-side.
+ */
+
+ return CloseChannelPart(interp, chanPtr, 0, flags);
+ } else if (flags & TCL_CLOSE_WRITE) {
+ if ((statePtr->curOutPtr != NULL) &&
+ IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
+ }
+ Tcl_Preserve(statePtr);
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ /*
+ * We don't want to re-enter CloseWrite().
+ */
+
+ if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) {
+ if (CloseWrite(interp, chanPtr) != TCL_OK) {
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ return TCL_ERROR;
+ }
+ }
+ }
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+ Tcl_Release(statePtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseWrite --
+ *
+ * Closes the write side a channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Closes the write side of the channel.
+ *
+ * NOTE:
+ * CloseWrite removes the channel as far as the user is concerned.
+ * However, the ooutput data structures may continue to exist for a while
+ * longer if it has a background flush scheduled. The device itself is
+ * eventually closed and the channel structures modified, in
+ * CloseChannelPart, below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseWrite(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel *chanPtr) /* The channel whose write side is being
+ * closed. May still be used by some
+ * interpreter */
+{
+ /* Notes: clear-channel-handlers - write side only ? or keep around, just
+ * not called. */
+ /* No close cllbacks are run - channel is still open (read side) */
+
+ ChannelState *statePtr = chanPtr->state;
+ /* State of real IO channel. */
+ int flushcode;
+ int result = 0;
+
+ /*
+ * Ensure that the last output buffer will be flushed.
+ */
+
+ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
+ }
+
+ /*
+ * The call to FlushChannel will flush any queued output and invoke the
+ * close function of the channel driver, or it will set up the channel to
+ * be flushed and closed asynchronously.
+ */
+
+ SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
+
+ flushcode = FlushChannel(interp, chanPtr, 0);
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result.
+ *
+ * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags
+ * FlushChannel() has called CloseChannelPart(). While we can still access
+ * "chan" (no structures were freed), the only place which may still
+ * contain a message is the interpreter itself, and "CloseChannelPart" made
+ * sure to lift any channel message it generated into it. Hence the NULL
+ * argument in the call below.
+ */
+
+ if (TclChanCaughtErrorBypass(interp, NULL)) {
+ result = EINVAL;
+ }
+
+ if ((flushcode != 0) || (result != 0)) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CloseChannelPart --
+ *
+ * Utility procedure to close a channel partially and free associated
+ * resources. If the channel was stacked it will never be run (The higher
+ * level forbid this). If the channel was not stacked, then we will free
+ * all the bits of the chosen side (read, or write) for the TOP channel.
+ *
+ * Results:
+ * Error code from an unreported error or the driver close2 operation.
+ *
+ * Side effects:
+ * May free memory, may change the value of errno.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CloseChannelPart(
+ Tcl_Interp *interp, /* Interpreter for errors. */
+ Channel *chanPtr, /* The channel being closed. May still be used
+ * by some interpreter. */
+ int errorCode, /* Status of operation so far. */
+ int flags) /* Flags telling us which side to close. */
+{
+ ChannelState *statePtr; /* State of real IO channel. */
+ int result; /* Of calling the close2proc. */
+
+ statePtr = chanPtr->state;
+
+ if (flags & TCL_CLOSE_READ) {
+ /*
+ * No more input can be consumed so discard any leftover input.
+ */
+
+ DiscardInputQueued(statePtr, 1);
+ } else if (flags & TCL_CLOSE_WRITE) {
+ /*
+ * The caller guarantees that there are no more buffers queued for
+ * output.
+ */
+
+ if (statePtr->outQueueHead != NULL) {
+ Tcl_Panic("ClosechanHalf, closed write-side of channel: "
+ "queued output left");
+ }
+
+ /*
+ * If the EOF character is set in the channel, append that to the
+ * output device.
+ */
+
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
+ int dummy;
+ char c = (char) statePtr->outEofChar;
+
+ (void) ChanWrite(chanPtr, &c, 1, &dummy);
+ }
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move a leftover error message in the channel bypass into the
+ * interpreter bypass. Just clear it if there is no interpreter.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ if (interp != NULL) {
+ Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
+ }
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ }
+
+ /*
+ * Finally do what is asked of us. Close and free the channel driver state
+ * for the chosen side of the channel. This may leave a TIP #219 error
+ * message in the interp.
+ */
+
+ result = ChanCloseHalf(chanPtr, interp, flags);
+
+ /*
+ * If we are being called synchronously, report either any latent error on
+ * the channel or the current error.
+ */
+
+ if (statePtr->unreportedError != 0) {
+ errorCode = statePtr->unreportedError;
+
+ /*
+ * TIP #219, Tcl Channel Reflection API.
+ * Move an error message found in the unreported area into the regular
+ * bypass (interp). This kills any message in the channel bypass area.
+ */
+
+ if (statePtr->chanMsg != NULL) {
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
+ }
+ if (interp) {
+ Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
+ }
+ }
+ if (errorCode == 0) {
+ errorCode = result;
+ if (errorCode != 0) {
+ Tcl_SetErrno(errorCode);
+ }
+ }
+
+ /*
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area and put
+ * them into the regular interpreter result. See also the bottom of
+ * CloseWrite().
+ */
+
+ if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
+ result = EINVAL;
+ }
+
+ if (result != 0) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Remove the closed side from the channel mode/flags.
+ */
+
+ ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ClearChannelHandlers --
*
* Removes all channel handlers and event scripts from the channel,
@@ -2861,8 +3700,8 @@ Tcl_Close(interp, chan)
*/
void
-Tcl_ClearChannelHandlers(channel)
- Tcl_Channel channel;
+Tcl_ClearChannelHandlers(
+ Tcl_Channel channel)
{
ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
@@ -2880,12 +3719,17 @@ Tcl_ClearChannelHandlers(channel)
chanPtr = statePtr->topChanPtr;
/*
+ * Cancel any outstanding timer.
+ */
+
+ Tcl_DeleteTimerHandler(statePtr->timer);
+
+ /*
* Remove any references to channel handlers for this channel that may be
* about to be invoked.
*/
- for (nhPtr = tsdPtr->nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
+ for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr &&
(nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
@@ -2897,25 +3741,24 @@ Tcl_ClearChannelHandlers(channel)
* Remove all the channel handler records attached to the channel itself.
*/
- for (chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chNext) {
+ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
chNext = chPtr->nextPtr;
- ckfree((char *) chPtr);
+ ckfree(chPtr);
}
- statePtr->chPtr = (ChannelHandler *) NULL;
+ statePtr->chPtr = NULL;
/*
* Cancel any pending copy operation.
*/
- StopCopy(statePtr->csPtr);
+ StopCopy(statePtr->csPtrR);
+ StopCopy(statePtr->csPtrW);
/*
- * Must set the interest mask now to 0, otherwise infinite loops will
- * occur if Tcl_DoOneEvent is called before the channel is finally deleted
- * in FlushChannel. This can happen if the channel has a background flush
- * active.
+ * Must set the interest mask now to 0, otherwise infinite loops
+ * will occur if Tcl_DoOneEvent is called before the channel is
+ * finally deleted in FlushChannel. This can happen if the channel
+ * has a background flush active.
*/
statePtr->interestMask = 0;
@@ -2924,14 +3767,12 @@ Tcl_ClearChannelHandlers(channel)
* Remove any EventScript records for this channel.
*/
- for (ePtr = statePtr->scriptRecordPtr;
- ePtr != (EventScriptRecord *) NULL;
- ePtr = eNextPtr) {
+ for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
TclDecrRefCount(ePtr->scriptPtr);
- ckfree((char *) ePtr);
+ ckfree(ePtr);
}
- statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->scriptRecordPtr = NULL;
}
/*
@@ -2959,18 +3800,18 @@ Tcl_ClearChannelHandlers(channel)
*/
int
-Tcl_Write(chan, src, srcLen)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* Data to queue in output buffer. */
- int srcLen; /* Length of data in bytes, or < 0 for
- * strlen(). */
+Tcl_Write(
+ Tcl_Channel chan, /* The channel to buffer output for. */
+ const char *src, /* Data to queue in output buffer. */
+ int srcLen) /* Length of data in bytes, or < 0 for
+ * strlen(). */
{
/*
* Always use the topmost channel of the stack
*/
Channel *chanPtr;
- ChannelState *statePtr; /* state info for channel */
+ ChannelState *statePtr; /* State info for channel */
statePtr = ((Channel *) chan)->state;
chanPtr = statePtr->topChanPtr;
@@ -2982,7 +3823,7 @@ Tcl_Write(chan, src, srcLen)
if (srcLen < 0) {
srcLen = strlen(src);
}
- return DoWrite(chanPtr, src, srcLen);
+ return WriteBytes(chanPtr, src, srcLen);
}
/*
@@ -3010,14 +3851,15 @@ Tcl_Write(chan, src, srcLen)
*/
int
-Tcl_WriteRaw(chan, src, srcLen)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* Data to queue in output buffer. */
- int srcLen; /* Length of data in bytes, or < 0 for
- * strlen(). */
+Tcl_WriteRaw(
+ Tcl_Channel chan, /* The channel to buffer output for. */
+ const char *src, /* Data to queue in output buffer. */
+ int srcLen) /* Length of data in bytes, or < 0 for
+ * strlen(). */
{
Channel *chanPtr = ((Channel *) chan);
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
int errorCode, written;
if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
@@ -3033,9 +3875,7 @@ Tcl_WriteRaw(chan, src, srcLen)
* The code was stolen from 'FlushChannel'.
*/
- written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- src, srcLen, &errorCode);
-
+ written = ChanWrite(chanPtr, src, srcLen, &errorCode);
if (written < 0) {
Tcl_SetErrno(errorCode);
}
@@ -3067,83 +3907,47 @@ Tcl_WriteRaw(chan, src, srcLen)
*/
int
-Tcl_WriteChars(chan, src, len)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 characters to queue in output
+Tcl_WriteChars(
+ Tcl_Channel chan, /* The channel to buffer output for. */
+ const char *src, /* UTF-8 characters to queue in output
* buffer. */
- int len; /* Length of string in bytes, or < 0 for
+ int len) /* Length of string in bytes, or < 0 for
* strlen(). */
{
- ChannelState *statePtr; /* state info for channel */
-
- statePtr = ((Channel *) chan)->state;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* State info for channel */
+ int result;
+ Tcl_Obj *objPtr;
if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
- return DoWriteChars((Channel *) chan, src, len);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * DoWriteChars --
- *
- * Takes a sequence of UTF-8 characters and converts them for output
- * using the channel's current encoding, may queue the buffer for output
- * if it gets full, and also remembers whether the current buffer is
- * ready e.g. if it contains a newline and we are in line buffering mode.
- * Compensates stacking, i.e. will redirect the data from the specified
- * channel to the topmost channel in a stack.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DoWriteChars(chanPtr, src, len)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 characters to queue in output
- * buffer. */
- int len; /* Length of string in bytes, or < 0 for
- * strlen(). */
-{
- /*
- * Always use the topmost channel of the stack
- */
-
- ChannelState *statePtr; /* state info for channel */
-
- statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
if (len < 0) {
len = strlen(src);
}
- if (statePtr->encoding == NULL) {
- /*
- * Inefficient way to convert UTF-8 to byte-array, but the code
- * parallels the way it is done for objects.
- */
+ if (statePtr->encoding) {
+ return WriteChars(chanPtr, src, len);
+ }
- Tcl_Obj *objPtr;
- int result;
+ /*
+ * Inefficient way to convert UTF-8 to byte-array, but the code
+ * parallels the way it is done for objects. Special case for 1-byte
+ * (used by eg [puts] for the \n) could be extended to more efficient
+ * translation of the src string.
+ */
- objPtr = Tcl_NewStringObj(src, len);
- src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
- result = WriteBytes(chanPtr, src, len);
- TclDecrRefCount(objPtr);
- return result;
+ if ((len == 1) && (UCHAR(*src) < 0xC0)) {
+ return WriteBytes(chanPtr, src, len);
}
- return WriteChars(chanPtr, src, len);
+
+ objPtr = Tcl_NewStringObj(src, len);
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+ result = WriteBytes(chanPtr, src, len);
+ TclDecrRefCount(objPtr);
+ return result;
}
/*
@@ -3151,11 +3955,11 @@ DoWriteChars(chanPtr, src, len)
*
* Tcl_WriteObj --
*
- * Takes the Tcl object and queues its contents for output. If the
+ * Takes the Tcl object and queues its contents for output. If the
* encoding of the channel is NULL, takes the byte-array representation
- * of the object and queues those bytes for output. Otherwise, takes the
+ * of the object and queues those bytes for output. Otherwise, takes the
* characters in the UTF-8 (string) representation of the object and
- * converts them for output using the channel's current encoding. May
+ * converts them for output using the channel's current encoding. May
* flush internal buffers to output if one becomes full or is ready for
* some other reason, e.g. if it contains a newline and the channel is in
* line buffering mode.
@@ -3172,17 +3976,17 @@ DoWriteChars(chanPtr, src, len)
*/
int
-Tcl_WriteObj(chan, objPtr)
- Tcl_Channel chan; /* The channel to buffer output for. */
- Tcl_Obj *objPtr; /* The object to write. */
+Tcl_WriteObj(
+ Tcl_Channel chan, /* The channel to buffer output for. */
+ Tcl_Obj *objPtr) /* The object to write. */
{
/*
* Always use the topmost channel of the stack
*/
Channel *chanPtr;
- ChannelState *statePtr; /* state info for channel */
- char *src;
+ ChannelState *statePtr; /* State info for channel */
+ const char *src;
int srcLen;
statePtr = ((Channel *) chan)->state;
@@ -3195,106 +3999,54 @@ Tcl_WriteObj(chan, objPtr)
src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
return WriteBytes(chanPtr, src, srcLen);
} else {
- src = Tcl_GetStringFromObj(objPtr, &srcLen);
+ src = TclGetStringFromObj(objPtr, &srcLen);
return WriteChars(chanPtr, src, srcLen);
}
}
-/*
- *----------------------------------------------------------------------
- *
- * WriteBytes --
- *
- * Write a sequence of bytes into an output buffer, may queue the buffer
- * for output if it gets full, and also remembers whether the current
- * buffer is ready e.g. if it contains a newline and we are in line
- * buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-WriteBytes(chanPtr, src, srcLen)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* Bytes to write. */
- int srcLen; /* Number of bytes to write. */
+static void
+WillWrite(
+ Channel *chanPtr)
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *bufPtr;
- char *dst;
- int dstMax, sawLF, savedLF, total, dstLen, toWrite;
-
- total = 0;
- sawLF = 0;
- savedLF = 0;
-
- /*
- * Loop over all bytes in src, storing them in output buffer with proper
- * EOL translation.
- */
+ int inputBuffered;
- while (srcLen + savedLF > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = bufPtr->buf + bufPtr->nextAdded;
- dstMax = bufPtr->bufLength - bufPtr->nextAdded;
- dstLen = dstMax;
-
- toWrite = dstLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
- }
-
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL() and
- * we need to store it in this buffer. If the channel is
- * line-based, we will need to flush it.
- */
+ if ((chanPtr->typePtr->seekProc != NULL) &&
+ ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
+ int ignore;
- *dst++ = '\n';
- dstLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
- sawLF++;
- }
- dstLen += savedLF;
- savedLF = 0;
-
- if (dstLen > dstMax) {
- savedLF = 1;
- dstLen = dstMax;
- }
- bufPtr->nextAdded += dstLen;
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
- total += dstLen;
- src += toWrite;
- srcLen -= toWrite;
- sawLF = 0;
+ DiscardInputQueued(chanPtr->state, 0);
+ ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
}
- return total;
+}
+
+static int
+WillRead(
+ Channel *chanPtr)
+{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
+ if ((chanPtr->typePtr->seekProc != NULL)
+ && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+ if ((chanPtr->state->curOutPtr != NULL)
+ && IsBufferReady(chanPtr->state->curOutPtr)) {
+ SetFlag(chanPtr->state, BUFFER_READY);
+ }
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
+ }
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * WriteChars --
+ * Write --
*
- * Convert UTF-8 bytes to the channel's external encoding and write the
+ * Convert srcLen bytes starting at src according to encoding and write
* produced bytes into an output buffer, may queue the buffer for output
* if it gets full, and also remembers whether the current buffer is
* ready e.g. if it contains a newline and we are in line buffering mode.
@@ -3311,25 +4063,20 @@ WriteBytes(chanPtr, src, srcLen)
*/
static int
-WriteChars(chanPtr, src, srcLen)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 string to write. */
- int srcLen; /* Length of UTF-8 string in bytes. */
+Write(
+ Channel *chanPtr, /* The channel to buffer output for. */
+ const char *src, /* UTF-8 string to write. */
+ int srcLen, /* Length of UTF-8 string in bytes. */
+ Tcl_Encoding encoding)
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *bufPtr;
- char *dst, *stage;
- int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
- int stageLen, toWrite, stageRead, endEncoding, result;
- int consumedSomething;
- Tcl_Encoding encoding;
- char safe[BUFFER_PADDING];
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
+ char *nextNewLine = NULL;
+ int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
- total = 0;
- sawLF = 0;
- savedLF = 0;
- saved = 0;
- encoding = statePtr->encoding;
+ if (srcLen) {
+ WillWrite(chanPtr);
+ }
/*
* Write the terminated escape sequence even if srcLen is 0.
@@ -3337,338 +4084,145 @@ WriteChars(chanPtr, src, srcLen)
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
- /*
- * Loop over all UTF-8 characters in src, storing them in staging buffer
- * with proper EOL translation.
- */
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
+ nextNewLine = memchr(src, '\n', srcLen);
+ }
- consumedSomething = 1;
- while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
- consumedSomething = 0;
- stage = statePtr->outputStage;
- stageMax = statePtr->bufSize;
- stageLen = stageMax;
+ while (srcLen + saved + endEncoding > 0) {
+ ChannelBuffer *bufPtr;
+ char *dst, safe[BUFFER_PADDING];
+ int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
- toWrite = stageLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
+ if (nextNewLine) {
+ srcLimit = nextNewLine - src;
}
-
- if (savedLF) {
+
+ /* Get space to write into */
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
+ }
+ if (saved) {
/*
- * A '\n' was left over from last call to TranslateOutputEOL() and
- * we need to store it in the staging buffer. If the channel is
- * line-based, we will need to flush the output buffer (after
- * translating the staging buffer).
+ * Here's some translated bytes left over from the last buffer
+ * that we need to stick at the beginning of this buffer.
*/
- *stage++ = '\n';
- stageLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) {
- sawLF++;
- }
-
- stage -= savedLF;
- stageLen += savedLF;
- savedLF = 0;
-
- if (stageLen > stageMax) {
- savedLF = 1;
- stageLen = stageMax;
- }
- src += toWrite;
- srcLen -= toWrite;
-
- /*
- * Loop over all UTF-8 characters in staging buffer, converting them
- * to external encoding, storing them in output buffer.
- */
-
- while (stageLen + saved + endEncoding > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = bufPtr->buf + bufPtr->nextAdded;
- dstLen = bufPtr->bufLength - bufPtr->nextAdded;
-
- if (saved != 0) {
- /*
- * Here's some translated bytes left over from the last buffer
- * that we need to stick at the beginning of this buffer.
- */
-
- memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
- bufPtr->nextAdded += saved;
- dst += saved;
- dstLen -= saved;
- saved = 0;
+ memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
+ bufPtr->nextAdded += saved;
+ saved = 0;
+ }
+ PreserveChannelBuffer(bufPtr);
+ dst = InsertPoint(bufPtr);
+ dstLen = SpaceLeft(bufPtr);
+
+ result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
+
+ /* See chan-io-1.[89]. Tcl Bug 506297. */
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
+
+ if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
+ /* We're reading from invalid/incomplete UTF-8 */
+ ReleaseChannelBuffer(bufPtr);
+ if (total == 0) {
+ Tcl_SetErrno(EINVAL);
+ return -1;
}
+ break;
+ }
- result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
- statePtr->outputEncodingFlags,
- &statePtr->outputEncodingState, dst,
- dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
-
- /* Fix for SF #506297, reported by Martin Forssen
- * <ruric@users.sourceforge.net>.
- *
- * The encoding chosen in the script exposing the bug writes out
- * three intro characters when TCL_ENCODING_START is set, but does
- * not consume any input as TCL_ENCODING_END is cleared. As some
- * output was generated the enclosing loop calls UtfToExternal
- * again, again with START set. Three more characters in the out
- * and still no use of input ... To break this infinite loop we
- * remove TCL_ENCODING_START from the set of flags after the first
- * call (no condition is required, the later calls remove an unset
- * flag, which is a no-op). This causes the subsequent calls to
- * UtfToExternal to consume and convert the actual input.
- */
-
- statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
+ bufPtr->nextAdded += dstWrote;
+ src += srcRead;
+ srcLen -= srcRead;
+ total += dstWrote;
+ dst += dstWrote;
+ dstLen -= dstWrote;
- /*
- * The following code must be executed only when result is not 0.
- */
+ if (src == nextNewLine && dstLen > 0) {
+ static char crln[3] = "\r\n";
+ char *nl = NULL;
+ int nlLen = 0;
- if ((result != 0) && ((stageRead + dstWrote) == 0)) {
- /*
- * We have an incomplete UTF-8 character at the end of the
- * staging buffer. It will get moved to the beginning of the
- * staging buffer followed by more bytes from src.
- */
-
- src -= stageLen;
- srcLen += stageLen;
- stageLen = 0;
- savedLF = 0;
+ switch (statePtr->outputTranslation) {
+ case TCL_TRANSLATE_LF:
+ nl = crln + 1;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CR:
+ nl = crln;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CRLF:
+ nl = crln;
+ nlLen = 2;
+ break;
+ default:
+ Tcl_Panic("unknown output translation requested");
break;
}
- bufPtr->nextAdded += dstWrote;
- if (bufPtr->nextAdded > bufPtr->bufLength) {
- /*
- * When translating from UTF-8 to external encoding, we
- * allowed the translation to produce a character that crossed
- * the end of the output buffer, so that we would get a
- * completely full buffer before flushing it. The extra bytes
- * will be moved to the beginning of the next buffer.
- */
-
- saved = bufPtr->nextAdded - bufPtr->bufLength;
- memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
- bufPtr->nextAdded = bufPtr->bufLength;
- }
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
+
+ result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
+
+ if (srcRead != nlLen) {
+ Tcl_Panic("Can This Happen?");
}
+ bufPtr->nextAdded += dstWrote;
+ src++;
+ srcLen--;
total += dstWrote;
- stage += stageRead;
- stageLen -= stageRead;
- sawLF = 0;
-
- consumedSomething = 1;
+ dst += dstWrote;
+ dstLen -= dstWrote;
+ nextNewLine = memchr(src, '\n', srcLen);
+ needNlFlush = 1;
+ }
+ if (IsBufferOverflowing(bufPtr)) {
/*
- * If all translated characters are written to the buffer,
- * endEncoding is set to 0 because the escape sequence may be
- * output.
+ * When translating from UTF-8 to external encoding, we
+ * allowed the translation to produce a character that crossed
+ * the end of the output buffer, so that we would get a
+ * completely full buffer before flushing it. The extra bytes
+ * will be moved to the beginning of the next buffer.
*/
- if ((stageLen + saved == 0) && (result == 0)) {
- endEncoding = 0;
- }
+ saved = -SpaceLeft(bufPtr);
+ memcpy(safe, dst + dstLen, (size_t) saved);
+ bufPtr->nextAdded = bufPtr->bufLength;
}
- }
-
- /*
- * If nothing was written and it happened because there was no progress in
- * the UTF conversion, we throw an error.
- */
-
- if (!consumedSomething && (total == 0)) {
- Tcl_SetErrno(EINVAL);
- return -1;
- }
- return total;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TranslateOutputEOL --
- *
- * Helper function for WriteBytes() and WriteChars(). Converts the '\n'
- * characters in the source buffer into the appropriate EOL form
- * specified by the output translation mode.
- *
- * EOL translation stops either when the source buffer is empty or the
- * output buffer is full.
- *
- * When converting to CRLF mode and there is only 1 byte left in the
- * output buffer, this routine stores the '\r' in the last byte and then
- * stores the '\n' in the byte just past the end of the buffer. The
- * caller is responsible for passing in a buffer that is large enough to
- * hold the extra byte.
- *
- * Results:
- * The return value is 1 if a '\n' was translated from the source buffer,
- * or 0 otherwise -- this can be used by the caller to decide to flush a
- * line-based channel even though the channel buffer is not full.
- *
- * *dstLenPtr is filled with how many bytes of the output buffer were
- * used. As mentioned above, this can be one more that the output
- * buffer's specified length if a CRLF was stored.
- *
- * *srcLenPtr is filled with how many bytes of the source buffer were
- * consumed.
- *
- * Side effects:
- * It may be obvious, but bears mentioning that when converting in CRLF
- * mode (which requires two bytes of storage in the output buffer), the
- * number of bytes consumed from the source buffer will be less than the
- * number of bytes stored in the output buffer.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
- ChannelState *statePtr; /* Channel being read, for translation and
- * buffering modes. */
- char *dst; /* Output buffer filled with UTF-8 chars by
- * applying appropriate EOL translation to
- * source characters. */
- CONST char *src; /* Source UTF-8 characters. */
- int *dstLenPtr; /* On entry, the maximum length of output
- * buffer in bytes. On exit, the number of
- * bytes actually used in output buffer. */
- int *srcLenPtr; /* On entry, the length of source buffer. On
- * exit, the number of bytes read from the
- * source buffer. */
-{
- char *dstEnd;
- int srcLen, newlineFound;
- newlineFound = 0;
- srcLen = *srcLenPtr;
-
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- for (dstEnd = dst + srcLen; dst < dstEnd; ) {
- if (*src == '\n') {
- newlineFound = 1;
- }
- *dst++ = *src++;
- }
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CR:
- for (dstEnd = dst + srcLen; dst < dstEnd;) {
- if (*src == '\n') {
- *dst++ = '\r';
- newlineFound = 1;
- src++;
- } else {
- *dst++ = *src++;
- }
+ if ((srcLen + saved == 0) && (result == TCL_OK)) {
+ endEncoding = 0;
}
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CRLF: {
- /*
- * Since this causes the number of bytes to grow, we start off trying
- * to put 'srcLen' bytes into the output buffer, but allow it to store
- * more bytes, as long as there's still source bytes and room in the
- * output buffer.
- */
-
- char *dstStart, *dstMax;
- CONST char *srcStart;
-
- dstStart = dst;
- dstMax = dst + *dstLenPtr;
- srcStart = src;
-
- if (srcLen < *dstLenPtr) {
- dstEnd = dst + srcLen;
- } else {
- dstEnd = dst + *dstLenPtr;
- }
- while (dst < dstEnd) {
- if (*src == '\n') {
- if (dstEnd < dstMax) {
- dstEnd++;
- }
- *dst++ = '\r';
- newlineFound = 1;
+ if (IsBufferFull(bufPtr)) {
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
}
- *dst++ = *src++;
- }
- *srcLenPtr = src - srcStart;
- *dstLenPtr = dst - dstStart;
- break;
- }
- default:
- break;
- }
- return newlineFound;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * CheckFlush --
- *
- * Helper function for WriteBytes() and WriteChars(). If the channel
- * buffer is ready to be flushed, flush it.
- *
- * Results:
- * The return value is -1 if there was a problem flushing the channel
- * buffer, or 0 otherwise.
- *
- * Side effects:
- * The buffer will be recycled if it is flushed.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-CheckFlush(chanPtr, bufPtr, newlineFlag)
- Channel *chanPtr; /* Channel being read, for buffering mode. */
- ChannelBuffer *bufPtr; /* Channel buffer to possibly flush. */
- int newlineFlag; /* Non-zero if a the channel buffer contains a
- * newline. */
-{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- /*
- * The current buffer is ready for output:
- * 1. if it is full.
- * 2. if it contains a newline and this channel is line-buffered.
- * 3. if it contains any output and this channel is unbuffered.
- */
-
- if ((statePtr->flags & BUFFER_READY) == 0) {
- if (bufPtr->nextAdded == bufPtr->bufLength) {
- statePtr->flags |= BUFFER_READY;
- } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
- if (newlineFlag != 0) {
- statePtr->flags |= BUFFER_READY;
+ flushed += statePtr->bufSize;
+ if (saved == 0 || src[-1] != '\n') {
+ needNlFlush = 0;
}
- } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
- statePtr->flags |= BUFFER_READY;
}
+ ReleaseChannelBuffer(bufPtr);
}
- if (statePtr->flags & BUFFER_READY) {
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
+ SetFlag(statePtr, BUFFER_READY);
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
}
- return 0;
+
+ return total;
}
/*
@@ -3684,29 +4238,27 @@ CheckFlush(chanPtr, bufPtr, newlineFlag)
* error or condition that occurred.
*
* Side effects:
- * May flush output on the channel. May cause input to be consumed from
+ * May flush output on the channel. May cause input to be consumed from
* the channel.
*
*---------------------------------------------------------------------------
*/
int
-Tcl_Gets(chan, lineRead)
- Tcl_Channel chan; /* Channel from which to read. */
- Tcl_DString *lineRead; /* The line read will be appended to this
- * DString as UTF-8 characters. The caller
+Tcl_Gets(
+ Tcl_Channel chan, /* Channel from which to read. */
+ Tcl_DString *lineRead) /* The line read will be appended to this
+ * DString as UTF-8 characters. The caller
* must have initialized it and is responsible
* for managing the storage. */
{
Tcl_Obj *objPtr;
- int charsStored, length;
- char *string;
+ int charsStored;
TclNewObj(objPtr);
charsStored = Tcl_GetsObj(chan, objPtr);
if (charsStored > 0) {
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_DStringAppend(lineRead, string, length);
+ TclDStringAppendObj(lineRead, objPtr);
}
TclDecrRefCount(objPtr);
return charsStored;
@@ -3718,48 +4270,62 @@ Tcl_Gets(chan, lineRead)
* Tcl_GetsObj --
*
* Accumulate input from the input channel until end-of-line or
- * end-of-file has been seen. Bytes read from the input channel are
+ * end-of-file has been seen. Bytes read from the input channel are
* converted to UTF-8 using the encoding specified by the channel.
*
* Results:
* Number of characters accumulated in the object or -1 if error,
- * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX
- * error code for the error or condition that occurred.
+ * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
+ * code for the error or condition that occurred.
*
* Side effects:
* Consumes input from the channel.
*
- * On reading EOF, leave channel pointing at EOF char. On reading EOL,
+ * On reading EOF, leave channel pointing at EOF char. On reading EOL,
* leave channel pointing after EOL, but don't return EOL in dst buffer.
*
*---------------------------------------------------------------------------
*/
int
-Tcl_GetsObj(chan, objPtr)
- Tcl_Channel chan; /* Channel from which to read. */
- Tcl_Obj *objPtr; /* The line read will be appended to this
+Tcl_GetsObj(
+ Tcl_Channel chan, /* Channel from which to read. */
+ Tcl_Obj *objPtr) /* The line read will be appended to this
* object as UTF-8 characters. */
{
GetsState gs;
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelBuffer *bufPtr;
int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
Tcl_Encoding encoding;
char *dst, *dstEnd, *eol, *eof;
Tcl_EncodingState oldState;
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
+ copiedTotal = -1;
+ goto done;
+ }
+
+ /*
+ * A binary version of Tcl_GetsObj. This could also handle encodings that
+ * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
+ * done on objPtr.
+ */
+
+ if ((statePtr->encoding == NULL)
+ && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
+ || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) {
+ return TclGetsObjBinary(chan, objPtr);
+ }
+
/*
* This operation should occur at the top of a channel stack.
*/
chanPtr = statePtr->topChanPtr;
-
- if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
- copiedTotal = -1;
- goto done;
- }
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -3769,7 +4335,7 @@ Tcl_GetsObj(chan, objPtr)
* newline in the available input.
*/
- Tcl_GetStringFromObj(objPtr, &oldLength);
+ TclGetStringFromObj(objPtr, &oldLength);
oldFlags = statePtr->inputEncodingFlags;
oldState = statePtr->inputEncodingState;
oldRemoved = BUFFER_PADDING;
@@ -3783,7 +4349,7 @@ Tcl_GetsObj(chan, objPtr)
*/
if (encoding == NULL) {
- encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ encoding = GetBinaryEncoding();
}
/*
@@ -3860,19 +4426,22 @@ Tcl_GetsObj(chan, objPtr)
/*
* If a CR is at the end of the buffer, then check for a
- * LF at the begining of the next buffer.
+ * LF at the begining of the next buffer, unless EOF char
+ * was found already.
*/
if (eol >= dstEnd) {
int offset;
- offset = eol - objPtr->bytes;
- dst = dstEnd;
- if (FilterInputBytes(chanPtr, &gs) != 0) {
- goto restore;
+ if (eol != eof) {
+ offset = eol - objPtr->bytes;
+ dst = dstEnd;
+ if (FilterInputBytes(chanPtr, &gs) != 0) {
+ goto restore;
+ }
+ dstEnd = dst + gs.bytesWrote;
+ eol = objPtr->bytes + offset;
}
- dstEnd = dst + gs.bytesWrote;
- eol = objPtr->bytes + offset;
if (eol >= dstEnd) {
skip = 0;
goto gotEOL;
@@ -3889,8 +4458,8 @@ Tcl_GetsObj(chan, objPtr)
case TCL_TRANSLATE_AUTO:
eol = dst;
skip = 1;
- if (statePtr->flags & INPUT_SAW_CR) {
- statePtr->flags &= ~INPUT_SAW_CR;
+ if (GotFlag(statePtr, INPUT_SAW_CR)) {
+ ResetFlag(statePtr, INPUT_SAW_CR);
if ((eol < dstEnd) && (*eol == '\n')) {
/*
* Skip the raw bytes that make up the '\n'.
@@ -3900,10 +4469,10 @@ Tcl_GetsObj(chan, objPtr)
int rawRead;
bufPtr = gs.bufPtr;
- Tcl_ExternalToUtf(NULL, gs.encoding,
- bufPtr->buf + bufPtr->nextRemoved, gs.rawRead,
- statePtr->inputEncodingFlags, &gs.state, tmp,
- 1 + TCL_UTF_MAX, &rawRead, NULL, NULL);
+ Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
+ gs.rawRead, statePtr->inputEncodingFlags,
+ &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
+ NULL);
bufPtr->nextRemoved += rawRead;
gs.rawRead -= rawRead;
gs.bytesWrote--;
@@ -3918,18 +4487,21 @@ Tcl_GetsObj(chan, objPtr)
if (eol == dstEnd) {
/*
* If buffer ended on \r, peek ahead to see if a \n is
- * available.
+ * available, unless EOF char was found already.
*/
- int offset;
+ if (eol != eof) {
+ int offset;
+
+ offset = eol - objPtr->bytes;
+ dst = dstEnd;
+ PeekAhead(chanPtr, &dstEnd, &gs);
+ eol = objPtr->bytes + offset;
+ }
- offset = eol - objPtr->bytes;
- dst = dstEnd;
- PeekAhead(chanPtr, &dstEnd, &gs);
- eol = objPtr->bytes + offset;
if (eol >= dstEnd) {
eol--;
- statePtr->flags |= INPUT_SAW_CR;
+ SetFlag(statePtr, INPUT_SAW_CR);
goto gotEOL;
}
}
@@ -3945,16 +4517,16 @@ Tcl_GetsObj(chan, objPtr)
}
if (eof != NULL) {
/*
- * EOF character was seen. On EOF, leave current file position
+ * EOF character was seen. On EOF, leave current file position
* pointing at the EOF character, but don't store the EOF
* character in the output string.
*/
dstEnd = eof;
- statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
eol = dstEnd;
if (eol == objPtr->bytes + oldLength) {
@@ -3964,7 +4536,7 @@ Tcl_GetsObj(chan, objPtr)
*/
Tcl_SetObjLength(objPtr, oldLength);
- CommonGetsCleanup(chanPtr, encoding);
+ CommonGetsCleanup(chanPtr);
copiedTotal = -1;
goto done;
}
@@ -3975,18 +4547,31 @@ Tcl_GetsObj(chan, objPtr)
/*
* Found EOL or EOF, but the output buffer may now contain too many UTF-8
- * characters. We need to know how many raw bytes correspond to the
- * number of UTF-8 characters we want, plus how many raw bytes correspond
- * to the character(s) making up EOL (if any), so we can remove the
- * correct number of bytes from the channel buffer.
+ * characters. We need to know how many raw bytes correspond to the number
+ * of UTF-8 characters we want, plus how many raw bytes correspond to the
+ * character(s) making up EOL (if any), so we can remove the correct
+ * number of bytes from the channel buffer.
*/
gotEOL:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
+
bufPtr = gs.bufPtr;
+ if (bufPtr == NULL) {
+ Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
+ }
statePtr->inputEncodingState = gs.state;
- Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
- gs.rawRead, statePtr->inputEncodingFlags,
- &statePtr->inputEncodingState, dst,
+ Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
&gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -3996,25 +4581,37 @@ Tcl_GetsObj(chan, objPtr)
*/
Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
- CommonGetsCleanup(chanPtr, encoding);
- statePtr->flags &= ~CHANNEL_BLOCKED;
+ CommonGetsCleanup(chanPtr);
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
copiedTotal = gs.totalChars + gs.charsWrote - skip;
goto done;
/*
- * Couldn't get a complete line. This only happens if we get a error
+ * Couldn't get a complete line. This only happens if we get a error
* reading from the channel or we are non-blocking and there wasn't an EOL
* or EOF in the data available.
*/
restore:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
bufPtr = statePtr->inQueueHead;
- bufPtr->nextRemoved = oldRemoved;
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
+ }
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
- CommonGetsCleanup(chanPtr, encoding);
+ CommonGetsCleanup(chanPtr);
statePtr->inputEncodingState = oldState;
statePtr->inputEncodingFlags = oldFlags;
@@ -4022,16 +4619,278 @@ Tcl_GetsObj(chan, objPtr)
/*
* We didn't get a complete line so we need to indicate to UpdateInterest
- * that the gets blocked. It will wait for more data instead of firing a
- * timer, avoiding a busy wait. This is where we are assuming that the
- * next operation is a gets. No more file events will be delivered on
- * this channel until new data arrives or some operation is performed on
- * the channel (e.g. gets, read, fconfigure) that changes the blocking
- * state. Note that this means a file event will not be delivered even
- * though a read would be able to consume the buffered data.
+ * that the gets blocked. It will wait for more data instead of firing a
+ * timer, avoiding a busy wait. This is where we are assuming that the
+ * next operation is a gets. No more file events will be delivered on this
+ * channel until new data arrives or some operation is performed on the
+ * channel (e.g. gets, read, fconfigure) that changes the blocking state.
+ * Note that this means a file event will not be delivered even though a
+ * read would be able to consume the buffered data.
+ */
+
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ copiedTotal = -1;
+
+ /*
+ * Update the notifier state so we don't block while there is still data
+ * in the buffers.
+ */
+
+ done:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
+ UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
+ return copiedTotal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetsObjBinary --
+ *
+ * A variation of Tcl_GetsObj that works directly on the buffers until
+ * end-of-line or end-of-file has been seen. Bytes read from the input
+ * channel return as a ByteArray obj.
+ *
+ * Results:
+ * Number of characters accumulated in the object or -1 if error,
+ * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
+ * code for the error or condition that occurred.
+ *
+ * Side effects:
+ * Consumes input from the channel.
+ *
+ * On reading EOF, leave channel pointing at EOF char. On reading EOL,
+ * leave channel pointing after EOL, but don't return EOL in dst buffer.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TclGetsObjBinary(
+ Tcl_Channel chan, /* Channel from which to read. */
+ Tcl_Obj *objPtr) /* The line read will be appended to this
+ * object as UTF-8 characters. */
+{
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
+ ChannelBuffer *bufPtr;
+ int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
+ int rawLen, byteLen, eolChar;
+ unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+
+ bufPtr = statePtr->inQueueHead;
+
+ /*
+ * Preserved so we can restore the channel's state in case we don't find a
+ * newline in the available input.
+ */
+
+ byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
+ oldFlags = statePtr->inputEncodingFlags;
+ oldRemoved = BUFFER_PADDING;
+ oldLength = byteLen;
+ if (bufPtr != NULL) {
+ oldRemoved = bufPtr->nextRemoved;
+ }
+
+ rawLen = 0;
+ skip = 0;
+ eof = NULL;
+ inEofChar = statePtr->inEofChar;
+
+ /*
+ * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR.
+ */
+
+ eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
+
+ while (1) {
+ /*
+ * Subtract the number of bytes that were removed from channel
+ * buffer during last call.
+ */
+
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved += rawLen;
+ if (!IsBufferReady(bufPtr)) {
+ bufPtr = bufPtr->nextPtr;
+ }
+ }
+
+ if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
+ /*
+ * All channel buffers were exhausted and the caller still
+ * hasn't seen EOL. Need to read more bytes from the channel
+ * device. Side effect is to allocate another channel buffer.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+ goto restore;
+ }
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
+ if (GetInput(chanPtr) != 0) {
+ goto restore;
+ }
+ bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
+ }
+
+ dst = (unsigned char *) RemovePoint(bufPtr);
+ dstEnd = dst + BytesLeft(bufPtr);
+
+ /*
+ * Remember if EOF char is seen, then look for EOL anyhow, because the
+ * EOL might be before the EOF char.
+ * XXX - in the binary case, consider coincident search for eol/eof.
+ */
+
+ if (inEofChar != '\0') {
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == inEofChar) {
+ dstEnd = eol;
+ eof = eol;
+ break;
+ }
+ }
+ }
+
+ /*
+ * On EOL, leave current file position pointing after the EOL, but
+ * don't store the EOL in the output string.
+ */
+
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == eolChar) {
+ skip = 1;
+ goto gotEOL;
+ }
+ }
+ if (eof != NULL) {
+ /*
+ * EOF character was seen. On EOF, leave current file position
+ * pointing at the EOF character, but don't store the EOF
+ * character in the output string.
+ */
+
+ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ }
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ skip = 0;
+ eol = dstEnd;
+ if ((dst == dstEnd) && (byteLen == oldLength)) {
+ /*
+ * If we didn't append any bytes before encountering EOF,
+ * caller needs to see -1.
+ */
+
+ byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
+ CommonGetsCleanup(chanPtr);
+ copiedTotal = -1;
+ goto done;
+ }
+ goto gotEOL;
+ }
+
+ /*
+ * Copy bytes from the channel buffer to the ByteArray.
+ * This may realloc space, so keep track of result.
+ */
+
+ rawLen = dstEnd - dst;
+ byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
+ memcpy(byteArray + byteLen, dst, (size_t) rawLen);
+ byteLen += rawLen;
+ }
+
+ /*
+ * Found EOL or EOF, but the output buffer may now contain too many bytes.
+ * We need to know how many bytes correspond to the number we want, so we
+ * can remove the correct number of bytes from the channel buffer.
+ */
+
+ gotEOL:
+ if (bufPtr == NULL) {
+ Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL");
+ }
+
+ rawLen = eol - dst;
+ byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
+ memcpy(byteArray + byteLen, dst, (size_t) rawLen);
+ byteLen += rawLen;
+ bufPtr->nextRemoved += rawLen + skip;
+
+ /*
+ * Convert the buffer if there was an encoding.
+ * XXX - unimplemented.
+ */
+
+ if (statePtr->encoding != NULL) {
+ }
+
+ /*
+ * Recycle all the emptied buffers.
+ */
+
+ CommonGetsCleanup(chanPtr);
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ copiedTotal = byteLen;
+ goto done;
+
+ /*
+ * Couldn't get a complete line. This only happens if we get a error
+ * reading from the channel or we are non-blocking and there wasn't an EOL
+ * or EOF in the data available.
+ */
+
+ restore:
+ bufPtr = statePtr->inQueueHead;
+ if (bufPtr) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
+ }
+
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ bufPtr->nextRemoved = BUFFER_PADDING;
+ }
+ CommonGetsCleanup(chanPtr);
+
+ statePtr->inputEncodingFlags = oldFlags;
+ byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
+
+ /*
+ * We didn't get a complete line so we need to indicate to UpdateInterest
+ * that the gets blocked. It will wait for more data instead of firing a
+ * timer, avoiding a busy wait. This is where we are assuming that the
+ * next operation is a gets. No more file events will be delivered on this
+ * channel until new data arrives or some operation is performed on the
+ * channel (e.g. gets, read, fconfigure) that changes the blocking state.
+ * Note that this means a file event will not be delivered even though a
+ * read would be able to consume the buffered data.
*/
- statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
copiedTotal = -1;
/*
@@ -4041,20 +4900,62 @@ Tcl_GetsObj(chan, objPtr)
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBinaryEncoding --
+ *
+ * Frees any "iso8859-1" Tcl_Encoding created by [gets] on a binary
+ * channel in a thread as part of that thread's finalization.
+ *
+ * Results:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeBinaryEncoding(
+ ClientData dummy) /* Not used */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->binaryEncoding != NULL) {
+ Tcl_FreeEncoding(tsdPtr->binaryEncoding);
+ tsdPtr->binaryEncoding = NULL;
+ }
+}
+
+static Tcl_Encoding
+GetBinaryEncoding()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (tsdPtr->binaryEncoding == NULL) {
+ tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
+ }
+ if (tsdPtr->binaryEncoding == NULL) {
+ Tcl_Panic("binary encoding is not available");
+ }
+ return tsdPtr->binaryEncoding;
+}
+
/*
*---------------------------------------------------------------------------
*
* FilterInputBytes --
*
- * Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw
+ * Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw
* bytes read from the channel.
*
- * Consumes available bytes from channel buffers. When channel buffers
+ * Consumes available bytes from channel buffers. When channel buffers
* are exhausted, reads more bytes from channel device into a new channel
- * buffer. It is the caller's responsibility to free the channel buffers
+ * buffer. It is the caller's responsibility to free the channel buffers
* that have been exhausted.
*
* Results:
@@ -4069,18 +4970,18 @@ Tcl_GetsObj(chan, objPtr)
*/
static int
-FilterInputBytes(chanPtr, gsPtr)
- Channel *chanPtr; /* Channel to read. */
- GetsState *gsPtr; /* Current state of gets operation. */
+FilterInputBytes(
+ Channel *chanPtr, /* Channel to read. */
+ GetsState *gsPtr) /* Current state of gets operation. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelBuffer *bufPtr;
- char *raw, *rawStart, *rawEnd;
- char *dst;
- int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
+ char *raw, *rawStart, *dst;
+ int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
Tcl_Obj *objPtr;
-#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at
- * a time. Since we don't know a priori how
+#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at
+ * a time. Since we don't know a priori how
* many bytes of storage this many source
* bytes will use, we actually need at least
* ENCODING_LINESIZE * TCL_MAX_UTF bytes of
@@ -4096,7 +4997,7 @@ FilterInputBytes(chanPtr, gsPtr)
bufPtr = gsPtr->bufPtr;
if (bufPtr != NULL) {
bufPtr->nextRemoved += gsPtr->rawRead;
- if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
+ if (!IsBufferReady(bufPtr)) {
bufPtr = bufPtr->nextPtr;
}
}
@@ -4105,18 +5006,18 @@ FilterInputBytes(chanPtr, gsPtr)
if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
/*
* All channel buffers were exhausted and the caller still hasn't seen
- * EOL. Need to read more bytes from the channel device. Side effect
+ * EOL. Need to read more bytes from the channel device. Side effect
* is to allocate another channel buffer.
*/
read:
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
}
- statePtr->flags &= ~CHANNEL_BLOCKED;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
}
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
@@ -4125,18 +5026,22 @@ FilterInputBytes(chanPtr, gsPtr)
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
}
/*
- * Convert some of the bytes from the channel buffer to UTF-8. Space in
- * objPtr's string rep is used to hold the UTF-8 characters. Grow the
+ * Convert some of the bytes from the channel buffer to UTF-8. Space in
+ * objPtr's string rep is used to hold the UTF-8 characters. Grow the
* string rep if we need more space.
*/
- rawStart = bufPtr->buf + bufPtr->nextRemoved;
+ rawStart = RemovePoint(bufPtr);
raw = rawStart;
- rawEnd = bufPtr->buf + bufPtr->nextAdded;
- rawLen = rawEnd - rawStart;
+ rawLen = BytesLeft(bufPtr);
dst = *gsPtr->dstPtr;
offset = dst - objPtr->bytes;
@@ -4144,15 +5049,19 @@ FilterInputBytes(chanPtr, gsPtr)
if (toRead > rawLen) {
toRead = rawLen;
}
- dstNeeded = toRead * TCL_UTF_MAX + 1;
- spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+ dstNeeded = toRead * TCL_UTF_MAX;
+ spaceLeft = objPtr->length - offset;
if (dstNeeded > spaceLeft) {
- length = offset * 2;
- if (offset < dstNeeded) {
+ int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+
+ if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
length = offset + dstNeeded;
+ if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+ dstNeeded = TCL_UTF_MAX - 1 + toRead;
+ length = offset + dstNeeded;
+ Tcl_SetObjLength(objPtr, length);
+ }
}
- length += TCL_UTF_MAX + 1;
- Tcl_SetObjLength(objPtr, length);
spaceLeft = length - offset;
dst = objPtr->bytes + offset;
*gsPtr->dstPtr = dst;
@@ -4160,12 +5069,12 @@ FilterInputBytes(chanPtr, gsPtr)
gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
+ dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
&gsPtr->charsWrote);
/*
* Make sure that if we go through 'gets', that we reset the
- * TCL_ENCODING_START flag still. [Bug #523988]
+ * TCL_ENCODING_START flag still. [Bug #523988]
*/
statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
@@ -4173,7 +5082,7 @@ FilterInputBytes(chanPtr, gsPtr)
if (result == TCL_CONVERT_MULTIBYTE) {
/*
* The last few bytes in this channel buffer were the start of a
- * multibyte sequence. If this buffer was full, then move them to the
+ * multibyte sequence. If this buffer was full, then move them to the
* next buffer so the bytes will be contiguous.
*/
@@ -4181,23 +5090,23 @@ FilterInputBytes(chanPtr, gsPtr)
int extra;
nextPtr = bufPtr->nextPtr;
- if (bufPtr->nextAdded < bufPtr->bufLength) {
+ if (!IsBufferFull(bufPtr)) {
if (gsPtr->rawRead > 0) {
/*
- * Some raw bytes were converted to UTF-8. Fall through,
+ * Some raw bytes were converted to UTF-8. Fall through,
* returning those UTF-8 characters because a EOL might be
* present in them.
*/
- } else if (statePtr->flags & CHANNEL_EOF) {
+ } else if (GotFlag(statePtr, CHANNEL_EOF)) {
/*
* There was a partial character followed by EOF on the
- * device. Fall through, returning that nothing was found.
+ * device. Fall through, returning that nothing was found.
*/
bufPtr->nextRemoved = bufPtr->nextAdded;
} else {
/*
- * There are no more cached raw bytes left. See if we can get
+ * There are no more cached raw bytes left. See if we can get
* some more.
*/
@@ -4210,8 +5119,8 @@ FilterInputBytes(chanPtr, gsPtr)
statePtr->inQueueTail = nextPtr;
}
extra = rawLen - gsPtr->rawRead;
- memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
- (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
+ memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
+ raw + gsPtr->rawRead, (size_t) extra);
nextPtr->nextRemoved -= extra;
bufPtr->nextAdded -= extra;
}
@@ -4226,7 +5135,7 @@ FilterInputBytes(chanPtr, gsPtr)
*
* PeekAhead --
*
- * Helper function used by Tcl_GetsObj(). Called when we've seen a \r at
+ * Helper function used by Tcl_GetsObj(). Called when we've seen a \r at
* the end of the UTF-8 string and want to look ahead one character to
* see if it is a \n.
*
@@ -4244,13 +5153,14 @@ FilterInputBytes(chanPtr, gsPtr)
*/
static void
-PeekAhead(chanPtr, dstEndPtr, gsPtr)
- Channel *chanPtr; /* The channel to read. */
- char **dstEndPtr; /* Filled with pointer to end of new range of
+PeekAhead(
+ Channel *chanPtr, /* The channel to read. */
+ char **dstEndPtr, /* Filled with pointer to end of new range of
* UTF-8 characters. */
- GetsState *gsPtr; /* Current state of gets operation. */
+ GetsState *gsPtr) /* Current state of gets operation. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelBuffer *bufPtr;
Tcl_DriverBlockModeProc *blockModeProc;
int bytesLeft;
@@ -4260,23 +5170,23 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
/*
* If there's any more raw input that's still buffered, we'll peek into
* that. Otherwise, only get more data from the channel driver if it looks
- * like there might actually be more data. The assumption is that if the
+ * like there might actually be more data. The assumption is that if the
* channel buffer is filled right up to the end, then there might be more
* data to read.
*/
blockModeProc = NULL;
if (bufPtr->nextPtr == NULL) {
- bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
+ bytesLeft = BytesLeft(bufPtr) - gsPtr->rawRead;
if (bytesLeft == 0) {
- if (bufPtr->nextAdded < bufPtr->bufLength) {
+ if (!IsBufferFull(bufPtr)) {
/*
* Don't peek ahead if last read was short read.
*/
goto cleanup;
}
- if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc == NULL) {
/*
@@ -4323,17 +5233,17 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
*/
static void
-CommonGetsCleanup(chanPtr, encoding)
- Channel *chanPtr;
- Tcl_Encoding encoding;
+CommonGetsCleanup(
+ Channel *chanPtr)
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelBuffer *bufPtr, *nextPtr;
bufPtr = statePtr->inQueueHead;
for ( ; bufPtr != NULL; bufPtr = nextPtr) {
nextPtr = bufPtr->nextPtr;
- if (bufPtr->nextRemoved < bufPtr->nextAdded) {
+ if (IsBufferReady(bufPtr)) {
break;
}
RecycleBuffer(statePtr, bufPtr, 0);
@@ -4345,20 +5255,20 @@ CommonGetsCleanup(chanPtr, encoding)
/*
* If any multi-byte characters were split across channel buffer
* boundaries, the split-up bytes were moved to the next channel
- * buffer by FilterInputBytes(). Move the bytes back to their
- * original buffer because the caller could change the channel's
- * encoding which could change the interpretation of whether those
- * bytes really made up multi-byte characters after all.
+ * buffer by FilterInputBytes(). Move the bytes back to their original
+ * buffer because the caller could change the channel's encoding which
+ * could change the interpretation of whether those bytes really made
+ * up multi-byte characters after all.
*/
nextPtr = bufPtr->nextPtr;
for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
int extra;
- extra = bufPtr->bufLength - bufPtr->nextAdded;
+ extra = SpaceLeft(bufPtr);
if (extra > 0) {
- memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
- (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
+ memcpy(InsertPoint(bufPtr),
+ nextPtr->buf + (BUFFER_PADDING - extra),
(size_t) extra);
bufPtr->nextAdded += extra;
nextPtr->nextRemoved = BUFFER_PADDING;
@@ -4366,9 +5276,6 @@ CommonGetsCleanup(chanPtr, encoding)
bufPtr = nextPtr;
}
}
- if (statePtr->encoding == NULL) {
- Tcl_FreeEncoding(encoding);
- }
}
/*
@@ -4376,7 +5283,7 @@ CommonGetsCleanup(chanPtr, encoding)
*
* Tcl_Read --
*
- * Reads a given number of bytes from a channel. EOL and EOF translation
+ * Reads a given number of bytes from a channel. EOL and EOF translation
* is done on the bytes being read, so the number of bytes consumed from
* the channel may not be equal to the number of bytes stored in the
* destination buffer.
@@ -4394,13 +5301,14 @@ CommonGetsCleanup(chanPtr, encoding)
*/
int
-Tcl_Read(chan, dst, bytesToRead)
- Tcl_Channel chan; /* The channel from which to read. */
- char *dst; /* Where to store input read. */
- int bytesToRead; /* Maximum number of bytes to read. */
+Tcl_Read(
+ Tcl_Channel chan, /* The channel from which to read. */
+ char *dst, /* Where to store input read. */
+ int bytesToRead) /* Maximum number of bytes to read. */
{
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
/*
* This operation should occur at the top of a channel stack.
@@ -4412,7 +5320,7 @@ Tcl_Read(chan, dst, bytesToRead)
return -1;
}
- return DoRead(chanPtr, dst, bytesToRead);
+ return DoRead(chanPtr, dst, bytesToRead, 0);
}
/*
@@ -4420,7 +5328,7 @@ Tcl_Read(chan, dst, bytesToRead)
*
* Tcl_ReadRaw --
*
- * Reads a given number of bytes from a channel. EOL and EOF translation
+ * Reads a given number of bytes from a channel. EOL and EOF translation
* is done on the bytes being read, so the number of bytes consumed from
* the channel may not be equal to the number of bytes stored in the
* destination buffer.
@@ -4438,15 +5346,15 @@ Tcl_Read(chan, dst, bytesToRead)
*/
int
-Tcl_ReadRaw(chan, bufPtr, bytesToRead)
- Tcl_Channel chan; /* The channel from which to read. */
- char *bufPtr; /* Where to store input read. */
- int bytesToRead; /* Maximum number of bytes to read. */
+Tcl_ReadRaw(
+ Tcl_Channel chan, /* The channel from which to read. */
+ char *bufPtr, /* Where to store input read. */
+ int bytesToRead) /* Maximum number of bytes to read. */
{
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- int nread, result;
- int copied, copiedNow;
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
+ int nread, result, copied, copiedNow;
/*
* The check below does too much because it will reject a call to this
@@ -4470,31 +5378,32 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
* requests more bytes.
*/
+ Tcl_Preserve(chanPtr);
for (copied = 0; copied < bytesToRead; copied += copiedNow) {
copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
bytesToRead - copied);
if (copiedNow == 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
goto done;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
goto done;
}
- statePtr->flags &= (~(CHANNEL_BLOCKED));
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
}
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/*
- * [SF Tcl Bug 943274]. Better emulation of non-blocking channels
- * for channels without BlockModeProc, by keeping track of true
+ * [Bug 943274]. Better emulation of non-blocking channels for
+ * channels without BlockModeProc, by keeping track of true
* fileevents generated by the OS == Data waiting and reading if
* and only if we are sure to have data.
*/
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+ !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
/*
* We bypass the driver; it would block as no data is
* available.
@@ -4502,51 +5411,46 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
nread = -1;
result = EWOULDBLOCK;
- } else {
+ } else
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
+ {
/*
* Now go to the driver to get as much as is possible to fill
* the remaining request. Do all the error handling by
- * ourselves. The code was stolen from 'GetInput' and
- * slightly adapted (different return value here).
+ * ourselves. The code was stolen from 'GetInput' and slightly
+ * adapted (different return value here).
*
* The case of 'bytesToRead == 0' at this point cannot happen.
*/
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
- bufPtr + copied, bytesToRead - copied, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
+ nread = ChanRead(chanPtr, bufPtr + copied,
+ bytesToRead - copied, &result);
}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
if (nread > 0) {
/*
- * If we get a short read, signal up that we may be
- * BLOCKED. We should avoid calling the driver because
- * on some platforms we will block in the low level
- * reading code even though the channel is set into
- * nonblocking mode.
+ * If we get a short read, signal up that we may be BLOCKED.
+ * We should avoid calling the driver because on some
+ * platforms we will block in the low level reading code even
+ * though the channel is set into nonblocking mode.
*/
if (nread < (bytesToRead - copied)) {
- statePtr->flags |= CHANNEL_BLOCKED;
+ SetFlag(statePtr, CHANNEL_BLOCKED);
}
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
if (nread <= (bytesToRead - copied)) {
/*
- * [SF Tcl Bug 943274] We have read the available data,
- * clear flag.
+ * [Bug 943274] We have read the available data, clear
+ * flag.
*/
- statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+ ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
} else if (nread == 0) {
- statePtr->flags |= CHANNEL_EOF;
+ SetFlag(statePtr, CHANNEL_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
} else if (nread < 0) {
@@ -4557,22 +5461,25 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
* over EAGAIN/WOULDBLOCK handling.
*/
- return copied;
+ goto done;
}
- statePtr->flags |= CHANNEL_BLOCKED;
+ SetFlag(statePtr, CHANNEL_BLOCKED);
result = EAGAIN;
}
Tcl_SetErrno(result);
- return -1;
+ copied = -1;
+ goto done;
}
- return copied + nread;
+ copied += nread;
+ goto done;
}
}
done:
+ Tcl_Release(chanPtr);
return copied;
}
@@ -4582,11 +5489,11 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
* Tcl_ReadChars --
*
* Reads from the channel until the requested number of characters have
- * been seen, EOF is seen, or the channel would block. EOL and EOF
- * translation is done. If reading binary data, the raw bytes are
- * wrapped in a Tcl byte array object. Otherwise, the raw bytes are
- * converted to UTF-8 using the channel's current encoding and stored in
- * a Tcl string object.
+ * been seen, EOF is seen, or the channel would block. EOL and EOF
+ * translation is done. If reading binary data, the raw bytes are wrapped
+ * in a Tcl byte array object. Otherwise, the raw bytes are converted to
+ * UTF-8 using the channel's current encoding and stored in a Tcl string
+ * object.
*
* Results:
* The number of characters read, or -1 on error. Use Tcl_GetErrno() to
@@ -4599,19 +5506,20 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
*/
int
-Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
- Tcl_Channel chan; /* The channel to read. */
- Tcl_Obj *objPtr; /* Input data is stored in this object. */
- int toRead; /* Maximum number of characters to store, or
+Tcl_ReadChars(
+ Tcl_Channel chan, /* The channel to read. */
+ Tcl_Obj *objPtr, /* Input data is stored in this object. */
+ int toRead, /* Maximum number of characters to store, or
* -1 to read all available data (up to EOF or
* when channel blocks). */
- int appendFlag; /* If non-zero, data read from the channel
- * will be appended to the object. Otherwise,
+ int appendFlag) /* 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. */
{
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
/*
* This operation should occur at the top of a channel stack.
@@ -4637,11 +5545,11 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
* DoReadChars --
*
* Reads from the channel until the requested number of characters have
- * been seen, EOF is seen, or the channel would block. EOL and EOF
- * translation is done. If reading binary data, the raw bytes are
- * wrapped in a Tcl byte array object. Otherwise, the raw bytes are
- * converted to UTF-8 using the channel's current encoding and stored in
- * a Tcl string object.
+ * been seen, EOF is seen, or the channel would block. EOL and EOF
+ * translation is done. If reading binary data, the raw bytes are wrapped
+ * in a Tcl byte array object. Otherwise, the raw bytes are converted to
+ * UTF-8 using the channel's current encoding and stored in a Tcl string
+ * object.
*
* Results:
* The number of characters read, or -1 on error. Use Tcl_GetErrno() to
@@ -4654,18 +5562,19 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
*/
static int
-DoReadChars(chanPtr, objPtr, toRead, appendFlag)
- Channel *chanPtr; /* The channel to read. */
- Tcl_Obj *objPtr; /* Input data is stored in this object. */
- int toRead; /* Maximum number of characters to store, or
+DoReadChars(
+ Channel *chanPtr, /* The channel to read. */
+ Tcl_Obj *objPtr, /* Input data is stored in this object. */
+ int toRead, /* Maximum number of characters to store, or
* -1 to read all available data (up to EOF or
* when channel blocks). */
- int appendFlag; /* If non-zero, data read from the channel
- * will be appended to the object. Otherwise,
+ int appendFlag) /* 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. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelBuffer *bufPtr;
int offset, factor, copied, copiedNow, result;
Tcl_Encoding encoding;
@@ -4678,6 +5587,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
+ Tcl_Preserve(chanPtr);
if (appendFlag == 0) {
if (encoding == NULL) {
@@ -4691,14 +5601,14 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
* been pure Unicode).
*/
- Tcl_GetString(objPtr);
+ TclGetString(objPtr);
}
offset = 0;
} else {
if (encoding == NULL) {
Tcl_GetByteArrayFromObj(objPtr, &offset);
} else {
- Tcl_GetStringFromObj(objPtr, &offset);
+ TclGetStringFromObj(objPtr, &offset);
}
}
@@ -4717,10 +5627,9 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
*/
bufPtr = statePtr->inQueueHead;
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
- ChannelBuffer *nextPtr;
+ if (IsBufferEmpty(bufPtr)) {
+ ChannelBuffer *nextPtr = bufPtr->nextPtr;
- nextPtr = bufPtr->nextPtr;
RecycleBuffer(statePtr, bufPtr, 0);
statePtr->inQueueHead = nextPtr;
if (nextPtr == NULL) {
@@ -4730,16 +5639,21 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
}
if (copiedNow < 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
break;
}
- statePtr->flags &= ~CHANNEL_BLOCKED;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
}
result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
if (result != 0) {
if (result == EAGAIN) {
break;
@@ -4753,7 +5667,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
}
}
- statePtr->flags &= ~CHANNEL_BLOCKED;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
if (encoding == NULL) {
Tcl_SetByteArrayLength(objPtr, offset);
} else {
@@ -4766,17 +5680,28 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
*/
done:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
+
/*
*---------------------------------------------------------------------------
*
* ReadBytes --
*
* Reads from the channel until the requested number of bytes have been
- * seen, EOF is seen, or the channel would block. Bytes from the channel
- * are stored in objPtr as a ByteArray object. EOL and EOF translation
+ * seen, EOF is seen, or the channel would block. Bytes from the channel
+ * are stored in objPtr as a ByteArray object. EOL and EOF translation
* are done.
*
* 'bytesToRead' can safely be a very large number because space is only
@@ -4795,22 +5720,22 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
*/
static int
-ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
- ChannelState *statePtr; /* State of the channel to read. */
- Tcl_Obj *objPtr; /* Input data is appended to this ByteArray
- * object. Its length is how much space has
+ReadBytes(
+ ChannelState *statePtr, /* State of the channel to read. */
+ Tcl_Obj *objPtr, /* Input data is appended to this ByteArray
+ * object. Its length is how much space has
* been allocated to hold data, not how many
* bytes of data have been stored in the
* object. */
- int bytesToRead; /* Maximum number of bytes to store, or < 0 to
+ int bytesToRead, /* Maximum number of bytes to store, or < 0 to
* get all available bytes. Bytes are obtained
* from the first buffer in the queue - even
* if this number is larger than the number of
* bytes available in the first buffer, only
* the bytes from the first buffer are
* returned. */
- int *offsetPtr; /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
+ int *offsetPtr) /* On input, contains how many bytes of objPtr
+ * have been used to hold data. On output,
* filled with how many bytes are now being
* used. */
{
@@ -4821,8 +5746,8 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
offset = *offsetPtr;
bufPtr = statePtr->inQueueHead;
- src = bufPtr->buf + bufPtr->nextRemoved;
- srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+ src = RemovePoint(bufPtr);
+ srcLen = BytesLeft(bufPtr);
toRead = bytesToRead;
if ((unsigned) toRead > (unsigned) srcLen) {
@@ -4845,8 +5770,8 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
}
dst += offset;
- if (statePtr->flags & INPUT_NEED_NL) {
- statePtr->flags &= ~INPUT_NEED_NL;
+ if (GotFlag(statePtr, INPUT_NEED_NL)) {
+ ResetFlag(statePtr, INPUT_NEED_NL);
if ((srcLen == 0) || (*src != '\n')) {
*dst = '\r';
*offsetPtr += 1;
@@ -4883,6 +5808,8 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
* 'charsToRead' can safely be a very large number because space is only
* allocated to hold data read from the channel as needed.
*
+ * 'charsToRead' may *not* be 0.
+ *
* Results:
* The return value is the number of characters appended to the object,
* *offsetPtr is filled with the number of bytes that were appended, and
@@ -4896,13 +5823,13 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
*/
static int
-ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
- ChannelState *statePtr; /* State of channel to read. */
- Tcl_Obj *objPtr; /* Input data is appended to this object.
+ReadChars(
+ ChannelState *statePtr, /* State of channel to read. */
+ Tcl_Obj *objPtr, /* Input data is appended to this object.
* objPtr->length is how much space has been
* allocated to hold data, not how many bytes
* of data have been stored in the object. */
- int charsToRead; /* Maximum number of characters to store, or
+ int charsToRead, /* Maximum number of characters to store, or
* -1 to get all available characters.
* Characters are obtained from the first
* buffer in the queue -- even if this number
@@ -4910,42 +5837,43 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* available in the first buffer, only the
* characters from the first buffer are
* returned. */
- int *offsetPtr; /* On input, contains how many bytes of objPtr
+ int *offsetPtr, /* On input, contains how many bytes of objPtr
* have been used to hold data. On output,
* filled with how many bytes are now being
* used. */
- int *factorPtr; /* On input, contains a guess of how many
+ int *factorPtr) /* On input, contains a guess of how many
* bytes need to be allocated to hold the
* result of converting N source bytes to
- * UTF-8. On output, contains another guess
+ * UTF-8. On output, contains another guess
* based on the data seen so far. */
{
- int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
+ int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
int srcRead, dstWrote, numChars, dstRead;
ChannelBuffer *bufPtr;
char *src, *dst;
Tcl_EncodingState oldState;
+ int encEndFlagSuppressed = 0;
factor = *factorPtr;
offset = *offsetPtr;
bufPtr = statePtr->inQueueHead;
- src = bufPtr->buf + bufPtr->nextRemoved;
- srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+ src = RemovePoint(bufPtr);
+ srcLen = BytesLeft(bufPtr);
toRead = charsToRead;
- if ((unsigned)toRead > (unsigned)srcLen) {
+ if ((unsigned) toRead > (unsigned) srcLen) {
toRead = srcLen;
}
/*
* 'factor' is how much we guess that the bytes in the source buffer will
- * expand when converted to UTF-8 chars. This guess comes from analyzing
+ * expand when converted to UTF-8 chars. This guess comes from analyzing
* how many characters were produced by the previous pass.
*/
- dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
- spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+ dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
+ spaceLeft = objPtr->length - offset;
if (dstNeeded > spaceLeft) {
/*
@@ -4954,13 +5882,17 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* larger.
*/
- length = offset * 2;
- if (offset < dstNeeded) {
+ int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+
+ if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
length = offset + dstNeeded;
+ if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+ dstNeeded = TCL_UTF_MAX - 1 + toRead;
+ length = offset + dstNeeded;
+ Tcl_SetObjLength(objPtr, length);
+ }
}
spaceLeft = length - offset;
- length += TCL_UTF_MAX + 1;
- Tcl_SetObjLength(objPtr, length);
}
if (toRead == srcLen) {
/*
@@ -4973,40 +5905,94 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
}
dst = objPtr->bytes + offset;
+ /*
+ * [Bug 1462248]: The cause of the crash reported in this bug is this:
+ *
+ * - ReadChars, called with a single buffer, with a incomplete
+ * multi-byte character at the end (only the first byte of it).
+ * - Encoding translation fails, asks for more data
+ * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
+ * - ReadChar is called again, converts the first buffer, but due to TEE
+ * it does not check for incomplete multi-byte data, and the character
+ * just after the end of the first buffer is a valid completion of the
+ * multi-byte header in the actual buffer. The conversion reads more
+ * characters from the buffer then present. This causes nextRemoved to
+ * overshoot nextAdded and the next reads compute a negative srcLen,
+ * cause further translations to fail, causing copying of data into the
+ * next buffer using bad arguments, causing the mecpy for to eventually
+ * fail.
+ *
+ * In the end it is a memory access bug spiraling out of control if the
+ * conditions are _just so_. And ultimate cause is that TEE is given to a
+ * conversion where it should not. TEE signals that this is the last
+ * buffer. Except in our case it is not.
+ *
+ * My solution is to suppress TEE if the first buffer is not the last. We
+ * will eventually need it given that EOF has been reached, but not right
+ * now. This is what the new flag "endEncSuppressFlag" is for.
+ *
+ * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
+ * actual buffer has been fixed as well, and fixes the problem with the
+ * crash too, but this would still allow the generic layer to
+ * accidentially break a multi-byte sequence if the conditions are just
+ * right, because again the ExternalToUtf would be successful where it
+ * should not.
+ */
+
+ if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
+ (bufPtr->nextPtr != NULL)) {
+ /*
+ * TEE is set for a buffer which is not the last. Squash it for now,
+ * and restore it later, before yielding control to our caller.
+ */
+
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+ encEndFlagSuppressed = 1;
+ }
+
oldState = statePtr->inputEncodingState;
- if (statePtr->flags & INPUT_NEED_NL) {
+ if (GotFlag(statePtr, INPUT_NEED_NL)) {
/*
* We want a '\n' because the last character we saw was '\r'.
*/
- statePtr->flags &= ~INPUT_NEED_NL;
+ ResetFlag(statePtr, INPUT_NEED_NL);
Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
if ((dstWrote > 0) && (*dst == '\n')) {
/*
- * The next char was a '\n'. Consume it and produce a '\n'.
+ * The next char was a '\n'. Consume it and produce a '\n'.
*/
bufPtr->nextRemoved += srcRead;
} else {
/*
- * The next char was not a '\n'. Produce a '\r'.
+ * The next char was not a '\n'. Produce a '\r'.
*/
*dst = '\r';
}
statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
*offsetPtr += 1;
+
+ if (encEndFlagSuppressed) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ }
return 1;
}
Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
+ dstNeeded + 1, &srcRead, &dstWrote, &numChars);
+
+ if (encEndFlagSuppressed) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ }
+
if (srcRead == 0) {
/*
- * Not enough bytes in src buffer to make a complete char. Copy the
+ * Not enough bytes in src buffer to make a complete char. Copy the
* bytes to the next buffer to make a new contiguous string, then tell
* the caller to fill the buffer with more bytes.
*/
@@ -5019,9 +6005,7 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
/*
* There isn't enough data in the buffers to complete the next
* character, so we need to wait for more data before the next
- * file event can be delivered.
- *
- * SF #478856.
+ * file event can be delivered. [Bug 478856]
*
* The exception to this is if the input buffer was completely
* empty before we tried to convert its contents. Nothing in,
@@ -5029,13 +6013,30 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* conversion before the current one was complete.
*/
- statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
}
return -1;
}
+
+ /*
+ * Space is made at the beginning of the buffer to copy the previous
+ * unused bytes there. Check first if the buffer we are using actually
+ * has enough space at its beginning for the data we are copying.
+ * Because if not we will write over the buffer management
+ * information, especially the 'nextPtr'.
+ *
+ * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
+ * prevent exactly this situation. I.e. it should never happen.
+ * Therefore it is ok to panic should it happen despite the
+ * precautions.
+ */
+
+ if (nextPtr->nextRemoved - srcLen < 0) {
+ Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+ }
+
nextPtr->nextRemoved -= srcLen;
- memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
- (size_t) srcLen);
+ memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
RecycleBuffer(statePtr, bufPtr, 0);
statePtr->inQueueHead = nextPtr;
return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
@@ -5066,16 +6067,15 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* '\n' in dst.
*/
- numChars -= (dstRead - dstWrote);
+ numChars -= dstRead - dstWrote;
if ((unsigned) numChars > (unsigned) toRead) {
/*
* Got too many chars.
*/
- CONST char *eof;
+ const char *eof = Tcl_UtfAtIndex(dst, toRead);
- eof = Tcl_UtfAtIndex(dst, toRead);
statePtr->inputEncodingState = oldState;
Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
@@ -5113,23 +6113,23 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
*/
static int
-TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
- ChannelState *statePtr; /* Channel being read, for EOL translation and
+TranslateInputEOL(
+ ChannelState *statePtr, /* Channel being read, for EOL translation and
* EOF character. */
- char *dstStart; /* Output buffer filled with chars by applying
+ char *dstStart, /* Output buffer filled with chars by applying
* appropriate EOL translation to source
* characters. */
- CONST char *srcStart; /* Source characters. */
- int *dstLenPtr; /* On entry, the maximum length of output
+ const char *srcStart, /* Source characters. */
+ int *dstLenPtr, /* On entry, the maximum length of output
* buffer in bytes; must be <= *srcLenPtr. On
* exit, the number of bytes actually used in
* output buffer. */
- int *srcLenPtr; /* On entry, the length of source buffer. On
+ int *srcLenPtr) /* On entry, the length of source buffer. On
* exit, the number of bytes read from the
* source buffer. */
{
int dstLen, srcLen, inEofChar;
- CONST char *eof;
+ const char *eof;
dstLen = *dstLenPtr;
@@ -5143,9 +6143,8 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
* buffer.
*/
- CONST char *src, *srcMax;
+ const char *src, *srcMax = srcStart + *srcLenPtr;
- srcMax = srcStart + *srcLenPtr;
for (src = srcStart; src < srcMax; src++) {
if (*src == inEofChar) {
eof = src;
@@ -5161,7 +6160,7 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF:
if (dstStart != srcStart) {
- memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
+ memcpy(dstStart, srcStart, (size_t) dstLen);
}
srcLen = dstLen;
break;
@@ -5169,7 +6168,7 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
char *dst, *dstEnd;
if (dstStart != srcStart) {
- memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
+ memcpy(dstStart, srcStart, (size_t) dstLen);
}
dstEnd = dstStart + dstLen;
for (dst = dstStart; dst < dstEnd; dst++) {
@@ -5182,7 +6181,7 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
}
case TCL_TRANSLATE_CRLF: {
char *dst;
- CONST char *src, *srcEnd, *srcMax;
+ const char *src, *srcEnd, *srcMax;
dst = dstStart;
src = srcStart;
@@ -5193,7 +6192,7 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
if (*src == '\r') {
src++;
if (src >= srcMax) {
- statePtr->flags |= INPUT_NEED_NL;
+ SetFlag(statePtr, INPUT_NEED_NL);
} else if (*src == '\n') {
*dst++ = *src++;
} else {
@@ -5209,24 +6208,24 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
}
case TCL_TRANSLATE_AUTO: {
char *dst;
- CONST char *src, *srcEnd, *srcMax;
+ const char *src, *srcEnd, *srcMax;
dst = dstStart;
src = srcStart;
srcEnd = srcStart + dstLen;
srcMax = srcStart + *srcLenPtr;
- if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+ if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
if (*src == '\n') {
src++;
}
- statePtr->flags &= ~INPUT_SAW_CR;
+ ResetFlag(statePtr, INPUT_SAW_CR);
}
for ( ; src < srcEnd; ) {
if (*src == '\r') {
src++;
if (src >= srcMax) {
- statePtr->flags |= INPUT_SAW_CR;
+ SetFlag(statePtr, INPUT_SAW_CR);
} else if (*src == '\n') {
if (srcEnd < srcMax) {
srcEnd++;
@@ -5249,14 +6248,14 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
if ((eof != NULL) && (srcStart + srcLen >= eof)) {
/*
- * EOF character was seen in EOL translated range. Leave current file
+ * EOF character was seen in EOL translated range. Leave current file
* position pointing at the EOF character, but don't store the EOF
* character in the output string.
*/
- statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
+ ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
return 1;
}
@@ -5282,17 +6281,17 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
*/
int
-Tcl_Ungets(chan, str, len, atEnd)
- Tcl_Channel chan; /* The channel for which to add the input. */
- CONST char *str; /* The input itself. */
- int len; /* The length of the input. */
- int atEnd; /* If non-zero, add at end of queue; otherwise
+Tcl_Ungets(
+ Tcl_Channel chan, /* The channel for which to add the input. */
+ const char *str, /* The input itself. */
+ int len, /* The length of the input. */
+ int atEnd) /* If non-zero, add at end of queue; otherwise
* add at head of queue. */
{
Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of actual channel. */
ChannelBuffer *bufPtr; /* Buffer to contain the data. */
- int i, flags;
+ int flags;
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
@@ -5321,22 +6320,21 @@ Tcl_Ungets(chan, str, len, atEnd)
* bit. We want to discover these conditions anew in each operation.
*/
- if (statePtr->flags & CHANNEL_STICKY_EOF) {
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
goto done;
}
- statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
+ ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
bufPtr = AllocChannelBuffer(len);
- for (i = 0; i < len; i++) {
- bufPtr->buf[bufPtr->nextAdded++] = str[i];
- }
+ memcpy(InsertPoint(bufPtr), str, (size_t) len);
+ bufPtr->nextAdded += len;
- if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ if (statePtr->inQueueHead == NULL) {
+ bufPtr->nextPtr = NULL;
statePtr->inQueueHead = bufPtr;
statePtr->inQueueTail = bufPtr;
} else if (atEnd) {
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ bufPtr->nextPtr = NULL;
statePtr->inQueueTail->nextPtr = bufPtr;
statePtr->inQueueTail = bufPtr;
} else {
@@ -5371,12 +6369,14 @@ Tcl_Ungets(chan, str, len, atEnd)
*/
int
-Tcl_Flush(chan)
- Tcl_Channel chan; /* The Channel to flush. */
+Tcl_Flush(
+ Tcl_Channel chan) /* The Channel to flush. */
{
- int result; /* Of calling FlushChannel. */
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- ChannelState *statePtr = chanPtr->state; /* State of actual channel. */
+ int result; /* Of calling FlushChannel. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The actual channel. */
+ ChannelState *statePtr = chanPtr->state;
+ /* State of actual channel. */
/*
* This operation should occur at the top of a channel stack.
@@ -5392,10 +6392,8 @@ Tcl_Flush(chan)
* Force current output buffer to be output also.
*/
- if ((statePtr->curOutPtr != NULL)
- && (statePtr->curOutPtr->nextAdded >
- statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
}
result = FlushChannel(NULL, chanPtr, 0);
@@ -5425,18 +6423,19 @@ Tcl_Flush(chan)
*/
static void
-DiscardInputQueued(statePtr, discardSavedBuffers)
- ChannelState *statePtr; /* Channel on which to discard the queued
+DiscardInputQueued(
+ ChannelState *statePtr, /* Channel on which to discard the queued
* input. */
- int discardSavedBuffers; /* If non-zero, discard all buffers including
+ int discardSavedBuffers) /* If non-zero, discard all buffers including
* last one. */
{
- ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
+ ChannelBuffer *bufPtr, *nxtPtr;
+ /* Loop variables. */
bufPtr = statePtr->inQueueHead;
- statePtr->inQueueHead = (ChannelBuffer *) NULL;
- statePtr->inQueueTail = (ChannelBuffer *) NULL;
- for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
+ for (; bufPtr != NULL; bufPtr = nxtPtr) {
nxtPtr = bufPtr->nextPtr;
RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
}
@@ -5446,11 +6445,9 @@ DiscardInputQueued(statePtr, discardSavedBuffers)
* saved buffer in the saveInBufPtr field.
*/
- if (discardSavedBuffers) {
- if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) statePtr->saveInBufPtr);
- statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
- }
+ if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
+ statePtr->saveInBufPtr = NULL;
}
}
@@ -5472,14 +6469,15 @@ DiscardInputQueued(statePtr, discardSavedBuffers)
*/
static int
-GetInput(chanPtr)
- Channel *chanPtr; /* Channel to read input from. */
+GetInput(
+ Channel *chanPtr) /* Channel to read input from. */
{
int toRead; /* How much to read? */
int result; /* Of calling driver. */
int nread; /* How much was read from channel? */
ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
/*
* Prevent reading from a dead channel -- a channel that has been closed
@@ -5502,16 +6500,16 @@ GetInput(chanPtr)
* buffer. In the latter case we can recycle it now.
*/
- if (chanPtr->inQueueHead != (ChannelBuffer *) NULL) {
- if (statePtr->inQueueHead != (ChannelBuffer *) NULL) {
+ if (chanPtr->inQueueHead != NULL) {
+ if (statePtr->inQueueHead != NULL) {
RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
- statePtr->inQueueHead = (ChannelBuffer *) NULL;
+ statePtr->inQueueHead = NULL;
}
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
return 0;
}
@@ -5527,29 +6525,28 @@ GetInput(chanPtr)
*/
bufPtr = statePtr->inQueueTail;
- if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
- toRead = bufPtr->bufLength - bufPtr->nextAdded;
+ if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
+ toRead = SpaceLeft(bufPtr);
} else {
bufPtr = statePtr->saveInBufPtr;
statePtr->saveInBufPtr = NULL;
/*
- * Check the actual buffersize against the requested
- * buffersize. Buffers which are smaller than requested are
- * squashed. This is done to honor dynamic changes of the buffersize
- * made by the user.
+ * Check the actual buffersize against the requested buffersize.
+ * Buffers which are smaller than requested are squashed. This is done
+ * to honor dynamic changes of the buffersize made by the user.
*/
if ((bufPtr != NULL)
&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
if (bufPtr == NULL) {
bufPtr = AllocChannelBuffer(statePtr->bufSize);
}
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ bufPtr->nextPtr = NULL;
/*
* SF #427196: Use the actual size of the buffer to determine the
@@ -5565,7 +6562,7 @@ GetInput(chanPtr)
* buffersize.
*/
- toRead = bufPtr->bufLength - bufPtr->nextAdded;
+ toRead = SpaceLeft(bufPtr);
if (statePtr->inQueueTail == NULL) {
statePtr->inQueueHead = bufPtr;
@@ -5580,38 +6577,36 @@ GetInput(chanPtr)
* platforms it is impossible to read from a device after EOF.
*/
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
return 0;
}
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/*
- * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
- * channels without BlockModeProc, by keeping track of true fileevents
- * generated by the OS == Data waiting and reading if and only if we are
- * sure to have data.
+ * [Bug 943274]: Better emulation of non-blocking channels for channels
+ * without BlockModeProc, by keeping track of true fileevents generated by
+ * the OS == Data waiting and reading if and only if we are sure to have
+ * data.
*/
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+ !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
/*
* Bypass the driver, it would block, as no data is available
*/
nread = -1;
result = EWOULDBLOCK;
- } else {
+ } else
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextAdded, toRead, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
+ {
+ PreserveChannelBuffer(bufPtr);
+ nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
if (nread > 0) {
+ result = 0;
bufPtr->nextAdded += nread;
/*
@@ -5622,32 +6617,31 @@ GetInput(chanPtr)
*/
if (nread < toRead) {
- statePtr->flags |= CHANNEL_BLOCKED;
+ SetFlag(statePtr, CHANNEL_BLOCKED);
}
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
if (nread <= toRead) {
/*
- * [SF Tcl Bug 943274] We have read the available data, clear
- * flag.
+ * [Bug 943274]: We have read the available data, clear flag.
*/
- statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+ ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
} else if (nread == 0) {
- statePtr->flags |= CHANNEL_EOF;
+ result = 0;
+ SetFlag(statePtr, CHANNEL_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
} else if (nread < 0) {
if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- statePtr->flags |= CHANNEL_BLOCKED;
+ SetFlag(statePtr, CHANNEL_BLOCKED);
result = EAGAIN;
}
Tcl_SetErrno(result);
- return result;
}
- return 0;
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -5669,13 +6663,15 @@ GetInput(chanPtr)
*/
Tcl_WideInt
-Tcl_Seek(chan, offset, mode)
- Tcl_Channel chan; /* The channel on which to seek. */
- Tcl_WideInt offset; /* Offset to seek to. */
- int mode; /* Relative to which location to seek? */
+Tcl_Seek(
+ Tcl_Channel chan, /* The channel on which to seek. */
+ Tcl_WideInt offset, /* Offset to seek to. */
+ int mode) /* Relative to which location to seek? */
{
- Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ Channel *chanPtr = (Channel *) chan;
+ /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
int inputBuffered, outputBuffered;
/* # bytes held in buffers. */
int result; /* Of device driver operations. */
@@ -5710,7 +6706,7 @@ Tcl_Seek(chan, offset, mode)
* defined. This means that the channel does not support seeking.
*/
- if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
+ if (chanPtr->typePtr->seekProc == NULL) {
Tcl_SetErrno(EINVAL);
return Tcl_LongAsWide(-1);
}
@@ -5749,8 +6745,8 @@ Tcl_Seek(chan, offset, mode)
* point. Also clear CR related flags.
*/
- statePtr->flags &=
- ~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR);
+ ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
+ INPUT_SAW_CR);
/*
* If the channel is in asynchronous output mode, switch it back to
@@ -5760,15 +6756,15 @@ Tcl_Seek(chan, offset, mode)
*/
wasAsync = 0;
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
wasAsync = 1;
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
if (result != 0) {
return Tcl_LongAsWide(-1);
}
- statePtr->flags &= (~(CHANNEL_NONBLOCKING));
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
- statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ ResetFlag(statePtr, CHANNEL_NONBLOCKING);
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
}
}
@@ -5777,43 +6773,27 @@ Tcl_Seek(chan, offset, mode)
* as ready to flush before invoking FlushChannel.
*/
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded >
- statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+ SetFlag(statePtr, BUFFER_READY);
}
/*
* If the flush fails we cannot recover the original position. In that
* case the seek is not attempted because we do not know where the access
* position is - instead we return the error. FlushChannel has already
- * called Tcl_SetErrno() to report the error upwards. If the flush
+ * called Tcl_SetErrno() to report the error upwards. If the flush
* succeeds we do the seek also.
*/
if (FlushChannel(NULL, chanPtr, 0) != 0) {
curPos = -1;
} else {
-
/*
* Now seek to the new position in the channel as requested by the
- * caller. Note that we prefer the wideSeekProc if that is available
- * and non-NULL...
+ * caller.
*/
- if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
- chanPtr->typePtr->wideSeekProc != NULL) {
- curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
- offset, mode, &result);
- } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
- offset > Tcl_LongAsWide(LONG_MAX)) {
- result = EOVERFLOW;
- curPos = Tcl_LongAsWide(-1);
- } else {
- curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
- chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
- &result));
- }
+ curPos = ChanSeek(chanPtr, offset, mode, &result);
if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(result);
}
@@ -5827,7 +6807,7 @@ Tcl_Seek(chan, offset, mode)
*/
if (wasAsync) {
- statePtr->flags |= CHANNEL_NONBLOCKING;
+ SetFlag(statePtr, CHANNEL_NONBLOCKING);
result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
if (result != 0) {
return Tcl_LongAsWide(-1);
@@ -5857,14 +6837,17 @@ Tcl_Seek(chan, offset, mode)
*/
Tcl_WideInt
-Tcl_Tell(chan)
- Tcl_Channel chan; /* The channel to return pos for. */
+Tcl_Tell(
+ Tcl_Channel chan) /* The channel to return pos for. */
{
- Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- int inputBuffered, outputBuffered; /* # bytes held in buffers. */
- int result; /* Of calling device driver. */
- Tcl_WideInt curPos; /* Position on device. */
+ Channel *chanPtr = (Channel *) chan;
+ /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
+ int inputBuffered, outputBuffered;
+ /* # bytes held in buffers. */
+ int result; /* Of calling device driver. */
+ Tcl_WideInt curPos; /* Position on device. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
return Tcl_LongAsWide(-1);
@@ -5892,7 +6875,7 @@ Tcl_Tell(chan)
* defined. This means that the channel does not support seeking.
*/
- if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
+ if (chanPtr->typePtr->seekProc == NULL) {
Tcl_SetErrno(EINVAL);
return Tcl_LongAsWide(-1);
}
@@ -5905,29 +6888,18 @@ Tcl_Tell(chan)
inputBuffered = Tcl_InputBuffered(chan);
outputBuffered = Tcl_OutputBuffered(chan);
- if ((inputBuffered != 0) && (outputBuffered != 0)) {
- Tcl_SetErrno(EFAULT);
- return Tcl_LongAsWide(-1);
- }
-
/*
* Get the current position in the device and compute the position where
- * the next character will be read or written. Note that we prefer the
+ * the next character will be read or written. Note that we prefer the
* wideSeekProc if that is available and non-NULL...
*/
- if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
- chanPtr->typePtr->wideSeekProc != NULL) {
- curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
- Tcl_LongAsWide(0), SEEK_CUR, &result);
- } else {
- curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
- chanPtr->instanceData, 0, SEEK_CUR, &result));
- }
+ curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(result);
return Tcl_LongAsWide(-1);
}
+
if (inputBuffered != 0) {
return curPos - inputBuffered;
}
@@ -5940,7 +6912,7 @@ Tcl_Tell(chan)
* Tcl_SeekOld, Tcl_TellOld --
*
* Backward-compatability versions of the seek/tell interface that do not
- * support 64-bit offsets. This interface is not documented or expected
+ * support 64-bit offsets. This interface is not documented or expected
* to be supported indefinitely.
*
* Results:
@@ -5954,26 +6926,25 @@ Tcl_Tell(chan)
*/
int
-Tcl_SeekOld(chan, offset, mode)
- Tcl_Channel chan; /* The channel on which to seek. */
- int offset; /* Offset to seek to. */
- int mode; /* Relative to which location to seek? */
+Tcl_SeekOld(
+ Tcl_Channel chan, /* The channel on which to seek. */
+ int offset, /* Offset to seek to. */
+ int mode) /* Relative to which location to seek? */
{
Tcl_WideInt wOffset, wResult;
- wOffset = Tcl_LongAsWide((long)offset);
+ wOffset = Tcl_LongAsWide((long) offset);
wResult = Tcl_Seek(chan, wOffset, mode);
- return (int)Tcl_WideAsLong(wResult);
+ return (int) Tcl_WideAsLong(wResult);
}
int
-Tcl_TellOld(chan)
- Tcl_Channel chan; /* The channel to return pos for. */
+Tcl_TellOld(
+ Tcl_Channel chan) /* The channel to return pos for. */
{
- Tcl_WideInt wResult;
+ Tcl_WideInt wResult = Tcl_Tell(chan);
- wResult = Tcl_Tell(chan);
- return (int)Tcl_WideAsLong(wResult);
+ return (int) Tcl_WideAsLong(wResult);
}
/*
@@ -5995,9 +6966,9 @@ Tcl_TellOld(chan)
*/
int
-Tcl_TruncateChannel(chan, length)
- Tcl_Channel chan;
- Tcl_WideInt length;
+Tcl_TruncateChannel(
+ Tcl_Channel chan, /* Channel to truncate. */
+ Tcl_WideInt length) /* Length to truncate it to. */
{
Channel *chanPtr = (Channel *) chan;
Tcl_DriverTruncateProc *truncateProc =
@@ -6009,15 +6980,17 @@ Tcl_TruncateChannel(chan, length)
* Feature not supported and it's not emulatable. Pretend it's
* returned an EINVAL, a very generic error!
*/
+
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
}
- if (!(chanPtr->state->flags & TCL_WRITABLE)) {
+ if (!GotFlag(chanPtr->state, TCL_WRITABLE)) {
/*
* We require that the file was opened of writing. Do that check now
* so that we only flush if we think we're going to succeed.
*/
+
Tcl_SetErrno(EINVAL);
return TCL_ERROR;
}
@@ -6027,8 +7000,10 @@ Tcl_TruncateChannel(chan, length)
* pre-read input data.
*/
- if (Tcl_Seek(chan, 0, SEEK_CUR) == Tcl_LongAsWide(-1)) {
- return TCL_ERROR;
+ WillWrite(chanPtr);
+
+ if (WillRead(chanPtr) < 0) {
+ return TCL_ERROR;
}
/*
@@ -6063,10 +7038,10 @@ Tcl_TruncateChannel(chan, length)
*/
static int
-CheckChannelErrors(statePtr, flags)
- ChannelState *statePtr; /* Channel to check. */
- int flags; /* Test if channel supports desired operation:
- * TCL_READABLE, TCL_WRITABLE. Also indicates
+CheckChannelErrors(
+ ChannelState *statePtr, /* Channel to check. */
+ int flags) /* Test if channel supports desired operation:
+ * TCL_READABLE, TCL_WRITABLE. Also indicates
* Raw read or write for special close
* processing */
{
@@ -6080,14 +7055,15 @@ CheckChannelErrors(statePtr, flags)
Tcl_SetErrno(statePtr->unreportedError);
statePtr->unreportedError = 0;
- /* TIP #219, Tcl Channel Reflection API.
+ /*
+ * TIP #219, Tcl Channel Reflection API.
* Move a defered error message back into the channel bypass.
*/
if (statePtr->chanMsg != NULL) {
- Tcl_DecrRefCount (statePtr->chanMsg);
+ TclDecrRefCount(statePtr->chanMsg);
}
- statePtr->chanMsg = statePtr->unreportedMsg;
+ statePtr->chanMsg = statePtr->unreportedMsg;
statePtr->unreportedMsg = NULL;
return -1;
}
@@ -6097,8 +7073,7 @@ CheckChannelErrors(statePtr, flags)
* order to drain data from stacked channels.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) &&
- ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -6120,7 +7095,7 @@ CheckChannelErrors(statePtr, flags)
* retrieving and transforming the data to copy.
*/
- if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
Tcl_SetErrno(EBUSY);
return -1;
}
@@ -6133,10 +7108,10 @@ CheckChannelErrors(statePtr, flags)
* discover these conditions anew in each operation.
*/
- if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
- statePtr->flags &= ~CHANNEL_EOF;
+ if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ ResetFlag(statePtr, CHANNEL_EOF);
}
- statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
}
return 0;
@@ -6159,14 +7134,14 @@ CheckChannelErrors(statePtr, flags)
*/
int
-Tcl_Eof(chan)
- Tcl_Channel chan; /* Does this channel have EOF? */
+Tcl_Eof(
+ Tcl_Channel chan) /* Does this channel have EOF? */
{
ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of real channel structure. */
+ /* State of real channel structure. */
- return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
- ((statePtr->flags & CHANNEL_EOF) &&
+ return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
+ (GotFlag(statePtr, CHANNEL_EOF) &&
(Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
@@ -6187,13 +7162,13 @@ Tcl_Eof(chan)
*/
int
-Tcl_InputBlocked(chan)
- Tcl_Channel chan; /* Is this channel blocked? */
+Tcl_InputBlocked(
+ Tcl_Channel chan) /* Is this channel blocked? */
{
ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of real channel structure. */
+ /* State of real channel structure. */
- return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+ return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
}
/*
@@ -6215,28 +7190,26 @@ Tcl_InputBlocked(chan)
*/
int
-Tcl_InputBuffered(chan)
- Tcl_Channel chan; /* The channel to query. */
+Tcl_InputBuffered(
+ Tcl_Channel chan) /* The channel to query. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of real channel structure. */
+ /* State of real channel structure. */
ChannelBuffer *bufPtr;
int bytesBuffered;
- for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
+ for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL;
bufPtr = bufPtr->nextPtr) {
- bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ bytesBuffered += BytesLeft(bufPtr);
}
/*
* Don't forget the bytes in the topmost pushback area.
*/
- for (bufPtr = statePtr->topChanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
+ for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;
bufPtr = bufPtr->nextPtr) {
- bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ bytesBuffered += BytesLeft(bufPtr);
}
return bytesBuffered;
@@ -6261,23 +7234,24 @@ Tcl_InputBuffered(chan)
*/
int
-Tcl_OutputBuffered(chan)
- Tcl_Channel chan; /* The channel to query. */
+Tcl_OutputBuffered(
+ Tcl_Channel chan) /* The channel to query. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
ChannelBuffer *bufPtr;
int bytesBuffered;
- for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL;
+ bufPtr = bufPtr->nextPtr) {
+ bytesBuffered += BytesLeft(bufPtr);
}
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
- bytesBuffered +=
- (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
+ if (statePtr->curOutPtr != NULL) {
+ register ChannelBuffer *curOutPtr = statePtr->curOutPtr;
+
+ if (IsBufferReady(curOutPtr)) {
+ bytesBuffered += BytesLeft(curOutPtr);
+ }
}
return bytesBuffered;
@@ -6302,18 +7276,17 @@ Tcl_OutputBuffered(chan)
*/
int
-Tcl_ChannelBuffered(chan)
- Tcl_Channel chan; /* The channel to query. */
+Tcl_ChannelBuffered(
+ Tcl_Channel chan) /* The channel to query. */
{
Channel *chanPtr = (Channel *) chan;
- /* real channel structure. */
+ /* Real channel structure. */
ChannelBuffer *bufPtr;
- int bytesBuffered;
+ int bytesBuffered = 0;
- for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
+ for (bufPtr = chanPtr->inQueueHead; bufPtr != NULL;
bufPtr = bufPtr->nextPtr) {
- bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ bytesBuffered += BytesLeft(bufPtr);
}
return bytesBuffered;
@@ -6337,36 +7310,24 @@ Tcl_ChannelBuffered(chan)
*/
void
-Tcl_SetChannelBufferSize(chan, sz)
- Tcl_Channel chan; /* The channel whose buffer size to
- * set. */
- int sz; /* The size to set. */
+Tcl_SetChannelBufferSize(
+ Tcl_Channel chan, /* The channel whose buffer size to set. */
+ int sz) /* The size to set. */
{
- ChannelState *statePtr; /* State of real channel structure. */
+ ChannelState *statePtr; /* State of real channel structure. */
/*
- * If the buffer size is smaller than 1 byte or larger than one MByte, do
- * not accept the requested size and leave the current buffer size.
+ * Clip the buffer size to force it into the [1,1M] range
*/
if (sz < 1) {
- return;
- }
- if (sz > (1024 * 1024)) {
- return;
+ sz = 1;
+ } else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
+ sz = MAX_CHANNEL_BUFFER_SIZE;
}
statePtr = ((Channel *) chan)->state;
statePtr->bufSize = sz;
-
- if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
- if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
- statePtr->outputStage = (char *)
- ckalloc((unsigned) (statePtr->bufSize + 2));
- }
}
/*
@@ -6386,12 +7347,12 @@ Tcl_SetChannelBufferSize(chan, sz)
*/
int
-Tcl_GetChannelBufferSize(chan)
- Tcl_Channel chan; /* The channel for which to find the
- * buffer size. */
+Tcl_GetChannelBufferSize(
+ Tcl_Channel chan) /* The channel for which to find the buffer
+ * size. */
{
ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of real channel structure. */
+ /* State of real channel structure. */
return statePtr->bufSize;
}
@@ -6402,7 +7363,7 @@ Tcl_GetChannelBufferSize(chan)
* Tcl_BadChannelOption --
*
* This procedure generates a "bad option" error message in an (optional)
- * interpreter. It is used by channel drivers when a invalid Set/Get
+ * interpreter. It is used by channel drivers when a invalid Set/Get
* option is requested. Its purpose is to concatenate the generic options
* list to the specific ones and factorize the generic options error
* message string.
@@ -6413,12 +7374,12 @@ Tcl_GetChannelBufferSize(chan)
* Side effects:
* An error message is generated in interp's result object to indicate
- * that a command was invoked with the a bad option. The message has the
+ * that a command was invoked with the a bad option. The message has the
* form:
* bad option "blah": should be one of
* <...generic options...>+<...specific options...>
* "blah" is the optionName argument and "<specific options>" is a space
- * separated list of specific option words. The function takes good care
+ * separated list of specific option words. The function takes good care
* of inserting minus signs before each option, commas after, and an "or"
* before the last option.
*
@@ -6426,25 +7387,25 @@ Tcl_GetChannelBufferSize(chan)
*/
int
-Tcl_BadChannelOption(interp, optionName, optionList)
- Tcl_Interp *interp; /* Current interpreter (can be NULL).*/
- CONST char *optionName; /* 'bad option' name */
- CONST char *optionList; /* Specific options list to append to
- * the standard generic options. Can
- * be NULL for generic options
- * only. */
+Tcl_BadChannelOption(
+ Tcl_Interp *interp, /* Current interpreter (can be NULL).*/
+ const char *optionName, /* 'bad option' name */
+ const char *optionList) /* Specific options list to append to the
+ * standard generic options. Can be NULL for
+ * generic options only. */
{
if (interp != NULL) {
- CONST char *genericopt =
+ const char *genericopt =
"blocking buffering buffersize encoding eofchar translation";
- CONST char **argv;
+ 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),
@@ -6452,15 +7413,16 @@ Tcl_BadChannelOption(interp, optionName, optionList)
Tcl_Panic("malformed option list in channel driver");
}
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad option \"", optionName,
- "\": should be one of ", (char *) NULL);
+ errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
+ optionName);
argc--;
for (i = 0; i < argc; i++) {
- Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
+ Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
}
- Tcl_AppendResult(interp, "or -", argv[i], (char *) 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;
@@ -6487,16 +7449,17 @@ Tcl_BadChannelOption(interp, optionName, optionList)
*/
int
-Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- Tcl_Channel chan; /* Channel on which to get option. */
- CONST char *optionName; /* Option to get. */
- Tcl_DString *dsPtr; /* Where to store value(s). */
+Tcl_GetChannelOption(
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ Tcl_Channel chan, /* Channel on which to get option. */
+ const char *optionName, /* Option to get. */
+ Tcl_DString *dsPtr) /* Where to store value(s). */
{
size_t len; /* Length of optionName string. */
char optionVal[128]; /* Buffer for sprintf. */
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
int flags;
/*
@@ -6520,12 +7483,10 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
* If we are in the middle of a background copy, use the saved flags.
*/
- if (statePtr->csPtr) {
- if (chanPtr == statePtr->csPtr->readPtr) {
- flags = statePtr->csPtr->readFlags;
- } else {
- flags = statePtr->csPtr->writeFlags;
- }
+ if (statePtr->csPtrR) {
+ flags = statePtr->csPtrR->readFlags;
+ } else if (statePtr->csPtrW) {
+ flags = statePtr->csPtrW->writeFlags;
} else {
flags = statePtr->flags;
}
@@ -6535,14 +7496,13 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
* and values.
*/
- if (optionName == (char *) NULL) {
+ if (optionName == NULL) {
len = 0;
} else {
len = strlen(optionName);
}
- if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-blocking", len) == 0))) {
+ if (len == 0 || HaveOpt(2, "-blocking")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-blocking");
}
@@ -6552,8 +7512,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-buffering", len) == 0))) {
+ if (len == 0 || HaveOpt(7, "-buffering")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffering");
}
@@ -6568,8 +7527,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-buffersize", len) == 0))) {
+ if (len == 0 || HaveOpt(7, "-buffersize")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffersize");
}
@@ -6579,8 +7537,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if ((len == 0) || ((len > 2) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-encoding", len) == 0))) {
+ if (len == 0 || HaveOpt(2, "-encoding")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-encoding");
}
@@ -6594,8 +7551,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if ((len == 0) || ((len > 2) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-eofchar", len) == 0))) {
+ if (len == 0 || HaveOpt(2, "-eofchar")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eofchar");
}
@@ -6638,8 +7594,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if ((len == 0) || ((len > 1) && (optionName[1] == 't') &&
- (strncmp(optionName, "-translation", len) == 0))) {
+ if (len == 0 || HaveOpt(1, "-translation")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-translation");
}
@@ -6684,14 +7639,15 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
return TCL_OK;
}
}
- if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
+
+ if (chanPtr->typePtr->getOptionProc != NULL) {
/*
* Let the driver specific handle additional options and result code
* and message.
*/
- return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
- interp, optionName, dsPtr);
+ return chanPtr->typePtr->getOptionProc(chanPtr->instanceData, interp,
+ optionName, dsPtr);
} else {
/*
* No driver specific options case.
@@ -6712,7 +7668,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
* Sets an option on a channel.
*
* Results:
- * A standard Tcl result. On error, sets interp's result object if
+ * A standard Tcl result. On error, sets interp's result object if
* interp is not NULL.
*
* Side effects:
@@ -6722,26 +7678,29 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
*/
int
-Tcl_SetChannelOption(interp, chan, optionName, newValue)
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- Tcl_Channel chan; /* Channel on which to set mode. */
- CONST char *optionName; /* Which option to set? */
- CONST char *newValue; /* New value for option. */
-{
- Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+Tcl_SetChannelOption(
+ Tcl_Interp *interp, /* For error reporting - can be NULL. */
+ Tcl_Channel chan, /* Channel on which to set mode. */
+ const char *optionName, /* Which option to set? */
+ const char *newValue) /* New value for option. */
+{
+ Channel *chanPtr = (Channel *) chan;
+ /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
size_t len; /* Length of optionName string. */
int argc;
- CONST char **argv;
+ const char **argv;
/*
* If the channel is in the middle of a background copy, fail.
*/
- if (statePtr->csPtr) {
+ if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
- Tcl_AppendResult(interp, "unable to set channel options: ",
- "background copy in progress", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to set channel options: background copy in"
+ " progress", -1));
}
return TCL_ERROR;
}
@@ -6765,9 +7724,9 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
len = strlen(optionName);
- if ((len > 2) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-blocking", len) == 0)) {
+ if (HaveOpt(2, "-blocking")) {
int newMode;
+
if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -6777,38 +7736,33 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
newMode = TCL_MODE_NONBLOCKING;
}
return SetBlockMode(interp, chanPtr, newMode);
- } else if ((len > 7) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-buffering", len) == 0)) {
+ } else if (HaveOpt(7, "-buffering")) {
len = strlen(newValue);
if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
- statePtr->flags &=
- (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
+ ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED);
} else if ((newValue[0] == 'l') &&
(strncmp(newValue, "line", len) == 0)) {
- statePtr->flags &= (~(CHANNEL_UNBUFFERED));
- statePtr->flags |= CHANNEL_LINEBUFFERED;
+ ResetFlag(statePtr, CHANNEL_UNBUFFERED);
+ SetFlag(statePtr, CHANNEL_LINEBUFFERED);
} else if ((newValue[0] == 'n') &&
(strncmp(newValue, "none", len) == 0)) {
- statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
- statePtr->flags |= CHANNEL_UNBUFFERED;
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "bad value for -buffering: ",
- "must be one of full, line, or none",
- (char *) NULL);
- return TCL_ERROR;
- }
+ ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
+ SetFlag(statePtr, CHANNEL_UNBUFFERED);
+ } else if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -buffering: must be one of"
+ " full, line, or none", -1));
+ return TCL_ERROR;
}
return TCL_OK;
- } else if ((len > 7) && (optionName[1] == 'b') &&
- (strncmp(optionName, "-buffersize", len) == 0)) {
+ } else if (HaveOpt(7, "-buffersize")) {
int newBufferSize;
+
if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_SetChannelBufferSize(chan, newBufferSize);
- } else if ((len > 2) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-encoding", len) == 0)) {
+ } else if (HaveOpt(2, "-encoding")) {
Tcl_Encoding encoding;
if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
@@ -6825,7 +7779,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
@@ -6836,79 +7791,82 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
statePtr->inputEncodingFlags = TCL_ENCODING_START;
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
- statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
+ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
- } else if ((len > 2) && (optionName[1] == 'e') &&
- (strncmp(optionName, "-eofchar", len) == 0)) {
+ } else if (HaveOpt(2, "-eofchar")) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 0) {
statePtr->inEofChar = 0;
statePtr->outEofChar = 0;
- } else if (argc == 1) {
- if (statePtr->flags & TCL_WRITABLE) {
- statePtr->outEofChar = (int) argv[0][0];
+ } else if (argc == 1 || argc == 2) {
+ int outIndex = (argc - 1);
+ int inValue = (int) argv[0][0];
+ int outValue = (int) argv[outIndex][0];
+
+ if (inValue & 0x80 || outValue & 0x80) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -eofchar: must be non-NUL ASCII"
+ " character", -1));
+ }
+ ckfree(argv);
+ return TCL_ERROR;
}
- if (statePtr->flags & TCL_READABLE) {
- statePtr->inEofChar = (int) argv[0][0];
+ if (GotFlag(statePtr, TCL_READABLE)) {
+ statePtr->inEofChar = inValue;
}
- } else if (argc != 2) {
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -eofchar: should be a list of zero,",
- " one, or two elements", (char *) NULL);
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
+ statePtr->outEofChar = outValue;
}
- ckfree((char *) argv);
- return TCL_ERROR;
} else {
- if (statePtr->flags & TCL_READABLE) {
- statePtr->inEofChar = (int) argv[0][0];
- }
- if (statePtr->flags & TCL_WRITABLE) {
- statePtr->outEofChar = (int) argv[1][0];
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -eofchar: should be a list of zero,"
+ " one, or two elements", -1));
}
+ ckfree(argv);
+ return TCL_ERROR;
}
if (argv != NULL) {
- ckfree((char *) argv);
+ ckfree(argv);
}
/*
- * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing the
- * character which signals eof can transform a current eof condition
- * into a 'go ahead'. Ditto for blocked.
+ * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
+ * which signals eof can transform a current eof condition into a 'go
+ * ahead'. Ditto for blocked.
*/
- statePtr->flags &=
- ~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED);
-
+ ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
return TCL_OK;
- } else if ((len > 1) && (optionName[1] == 't') &&
- (strncmp(optionName, "-translation", len) == 0)) {
- CONST char *readMode, *writeMode;
+ } else if (HaveOpt(1, "-translation")) {
+ const char *readMode, *writeMode;
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 1) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
} else if (argc == 2) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: must be a one or two",
- " element list", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be a one or two"
+ " element list", -1));
}
- ckfree((char *) argv);
+ ckfree(argv);
return TCL_ERROR;
}
if (readMode) {
TclEolTranslation translation;
+
if (*readMode == '\0') {
translation = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
@@ -6928,12 +7886,11 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
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", (char *) 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;
}
@@ -6945,8 +7902,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
if (translation != statePtr->inputTranslation) {
statePtr->inputTranslation = translation;
- statePtr->flags &= ~(INPUT_SAW_CR);
- statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
}
}
@@ -6956,7 +7912,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
} else if (strcmp(writeMode, "auto") == 0) {
/*
* This is a hack to get TCP sockets to produce output in CRLF
- * mode if they are being set into AUTO mode. A better
+ * mode if they are being set into AUTO mode. A better
* solution for achieving this effect will be coded later.
*/
@@ -6980,22 +7936,21 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
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", (char *) 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, optionName, newValue);
+ return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
+ optionName, newValue);
} else {
- return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
+ return Tcl_BadChannelOption(interp, optionName, NULL);
}
/*
@@ -7006,28 +7961,14 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
statePtr->saveInBufPtr = NULL;
}
- if (statePtr->inQueueHead != NULL) {
- if ((statePtr->inQueueHead->nextPtr == NULL)
- && (statePtr->inQueueHead->nextAdded ==
- statePtr->inQueueHead->nextRemoved)) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
- statePtr->inQueueHead = NULL;
- statePtr->inQueueTail = NULL;
- }
+ if ((statePtr->inQueueHead != NULL)
+ && (statePtr->inQueueHead->nextPtr == NULL)
+ && IsBufferEmpty(statePtr->inQueueHead)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
}
- /*
- * If encoding or bufsize changes, need to update output staging buffer.
- */
-
- if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
- if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
- statePtr->outputStage = (char *)
- ckalloc((unsigned) (statePtr->bufSize + 2));
- }
return TCL_OK;
}
@@ -7051,11 +7992,12 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
*/
static void
-CleanupChannelHandlers(interp, chanPtr)
- Tcl_Interp *interp;
- Channel *chanPtr;
+CleanupChannelHandlers(
+ Tcl_Interp *interp,
+ Channel *chanPtr)
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/*
@@ -7063,23 +8005,21 @@ CleanupChannelHandlers(interp, chanPtr)
* interpreter.
*/
- for (sPtr = statePtr->scriptRecordPtr,
- prevPtr = (EventScriptRecord *) NULL;
- sPtr != (EventScriptRecord *) NULL;
- sPtr = nextPtr) {
+ for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
+ sPtr != NULL; sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
- if (prevPtr == (EventScriptRecord *) NULL) {
+ if (prevPtr == NULL) {
statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, sPtr);
TclDecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
+ ckfree(sPtr);
} else {
prevPtr = sPtr;
}
@@ -7092,7 +8032,7 @@ CleanupChannelHandlers(interp, chanPtr)
* Tcl_NotifyChannel --
*
* This procedure is called by a channel driver when a driver detects an
- * event on a channel. This procedure is responsible for actually
+ * event on a channel. This procedure is responsible for actually
* handling the event by invoking any channel handler callbacks.
*
* Results:
@@ -7105,19 +8045,20 @@ CleanupChannelHandlers(interp, chanPtr)
*/
void
-Tcl_NotifyChannel(channel, mask)
- Tcl_Channel channel; /* Channel that detected an event. */
- int mask; /* OR'ed combination of TCL_READABLE,
+Tcl_NotifyChannel(
+ Tcl_Channel channel, /* Channel that detected an event. */
+ int mask) /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which events were detected. */
{
Channel *chanPtr = (Channel *) channel;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
ChannelHandler *chPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
Channel *upChanPtr;
- Tcl_ChannelType *upTypePtr;
+ const Tcl_ChannelType *upTypePtr;
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/*
@@ -7127,11 +8068,10 @@ Tcl_NotifyChannel(channel, mask)
*/
if ((mask & TCL_READABLE) &&
- (statePtr->flags & CHANNEL_NONBLOCKING) &&
+ GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_TIMER_FEV)) {
-
- statePtr->flags |= CHANNEL_HAS_MORE_DATA;
+ !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
+ SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
@@ -7147,14 +8087,14 @@ Tcl_NotifyChannel(channel, mask)
* their own events and pass them upward.
*/
- while (mask && (chanPtr->upChanPtr != ((Channel *) NULL))) {
+ while (mask && (chanPtr->upChanPtr != NULL)) {
Tcl_DriverHandlerProc *upHandlerProc;
upChanPtr = chanPtr->upChanPtr;
upTypePtr = upChanPtr->typePtr;
upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
if (upHandlerProc != NULL) {
- mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
+ mask = upHandlerProc(upChanPtr->instanceData, mask);
}
/*
@@ -7184,16 +8124,16 @@ Tcl_NotifyChannel(channel, mask)
* Preserve the channel struct in case the script closes it.
*/
- Tcl_Preserve((ClientData) channel);
- Tcl_Preserve((ClientData) statePtr);
+ Tcl_Preserve(channel);
+ Tcl_Preserve(statePtr);
/*
* If we are flushing in the background, be sure to call FlushChannel for
- * writable events. Note that we have to discard the writable event so we
+ * writable events. Note that we have to discard the writable event so we
* don't call any write handlers before the flush is complete.
*/
- if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
FlushChannel(NULL, chanPtr, 1);
mask &= ~TCL_WRITABLE;
}
@@ -7203,11 +8143,11 @@ Tcl_NotifyChannel(channel, mask)
* ChannelHandlerEventProc.
*/
- nh.nextHandlerPtr = (ChannelHandler *) NULL;
+ nh.nextHandlerPtr = NULL;
nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
tsdPtr->nestedHandlerPtr = &nh;
- for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+ for (chPtr = statePtr->chPtr; chPtr != NULL; ) {
/*
* If this channel handler is interested in any of the events that
* have occurred on the channel, invoke its procedure.
@@ -7215,7 +8155,7 @@ Tcl_NotifyChannel(channel, mask)
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
- (*(chPtr->proc))(chPtr->clientData, mask);
+ chPtr->proc(chPtr->clientData, mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -7232,8 +8172,8 @@ Tcl_NotifyChannel(channel, mask)
UpdateInterest(chanPtr);
}
- Tcl_Release((ClientData) statePtr);
- Tcl_Release((ClientData) channel);
+ Tcl_Release(statePtr);
+ Tcl_Release(channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
@@ -7256,33 +8196,38 @@ Tcl_NotifyChannel(channel, mask)
*/
static void
-UpdateInterest(chanPtr)
- Channel *chanPtr; /* Channel to update. */
+UpdateInterest(
+ Channel *chanPtr) /* Channel to update. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
mask |= TCL_WRITABLE;
}
/*
* If there is data in the input queue, and we aren't waiting for more
* data, then we need to schedule a timer so we don't block in the
- * notifier. Also, cancel the read interest so we don't get duplicate
+ * notifier. Also, cancel the read interest so we don't get duplicate
* events.
*/
if (mask & TCL_READABLE) {
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
- && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
- && (statePtr->inQueueHead->nextRemoved <
- statePtr->inQueueHead->nextAdded)) {
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
+ && (statePtr->inQueueHead != NULL)
+ && IsBufferReady(statePtr->inQueueHead)) {
mask &= ~TCL_READABLE;
/*
@@ -7326,12 +8271,12 @@ UpdateInterest(chanPtr)
mask &= ~TCL_EXCEPTION;
if (!statePtr->timer) {
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- (ClientData) chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc, chanPtr);
}
}
}
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
+ ChanWatch(chanPtr, mask);
}
/*
@@ -7352,24 +8297,24 @@ UpdateInterest(chanPtr)
*/
static void
-ChannelTimerProc(clientData)
- ClientData clientData;
+ChannelTimerProc(
+ ClientData clientData)
{
- Channel *chanPtr = (Channel *) clientData;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ Channel *chanPtr = clientData;
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->interestMask & TCL_READABLE)
- && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
- && (statePtr->inQueueHead->nextRemoved <
- statePtr->inQueueHead->nextAdded)) {
+ && (statePtr->inQueueHead != NULL)
+ && IsBufferReady(statePtr->inQueueHead)) {
/*
* Restart the timer in case a channel handler reenters the event loop
* before UpdateInterest gets called by Tcl_NotifyChannel.
*/
- statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- (ClientData) chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ ChannelTimerProc,chanPtr);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
/*
@@ -7380,20 +8325,20 @@ ChannelTimerProc(clientData)
* similar test is done in "PeekAhead".
*/
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
- statePtr->flags |= CHANNEL_TIMER_FEV;
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
+ (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
+ SetFlag(statePtr, CHANNEL_TIMER_FEV);
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- Tcl_Preserve((ClientData) statePtr);
- Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
+ Tcl_Preserve(statePtr);
+ Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- statePtr->flags &= ~CHANNEL_TIMER_FEV;
+ ResetFlag(statePtr, CHANNEL_TIMER_FEV);
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- Tcl_Release((ClientData) statePtr);
+ Tcl_Release(statePtr);
} else {
statePtr->timer = NULL;
UpdateInterest(chanPtr);
@@ -7422,20 +8367,21 @@ ChannelTimerProc(clientData)
*/
void
-Tcl_CreateChannelHandler(chan, mask, proc, clientData)
- Tcl_Channel chan; /* The channel to create the handler for. */
- int mask; /* OR'ed combination of TCL_READABLE,
+Tcl_CreateChannelHandler(
+ Tcl_Channel chan, /* The channel to create the handler for. */
+ int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. Use 0 to disable a registered
* handler. */
- Tcl_ChannelProc *proc; /* Procedure to call for each selected
+ Tcl_ChannelProc *proc, /* Procedure to call for each selected
* event. */
- ClientData clientData; /* Arbitrary data to pass to proc. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
{
ChannelHandler *chPtr;
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
/*
* Check whether this channel handler is not already registered. If it is
@@ -7443,16 +8389,14 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
* values).
*/
- for (chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
+ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
(chPtr->clientData == clientData)) {
break;
}
}
- if (chPtr == (ChannelHandler *) NULL) {
- chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
+ if (chPtr == NULL) {
+ chPtr = ckalloc(sizeof(ChannelHandler));
chPtr->mask = 0;
chPtr->proc = proc;
chPtr->clientData = clientData;
@@ -7474,9 +8418,7 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
*/
statePtr->interestMask = 0;
- for (chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
+ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
statePtr->interestMask |= chPtr->mask;
}
@@ -7502,25 +8444,25 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
*/
void
-Tcl_DeleteChannelHandler(chan, proc, clientData)
- Tcl_Channel chan; /* The channel for which to remove the
+Tcl_DeleteChannelHandler(
+ Tcl_Channel chan, /* The channel for which to remove the
* callback. */
- Tcl_ChannelProc *proc; /* The procedure in the callback to delete. */
- ClientData clientData; /* The client data in the callback to
+ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */
+ ClientData clientData) /* The client data in the callback to
* delete. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelHandler *chPtr, *prevChPtr;
Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
NextChannelHandler *nhPtr;
/*
* Find the entry and the previous one in the list.
*/
- for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
+ for (prevChPtr = NULL, chPtr = statePtr->chPtr; chPtr != NULL;
chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
&& (chPtr->proc == proc)) {
@@ -7533,7 +8475,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* If not found, return without doing anything.
*/
- if (chPtr == (ChannelHandler *) NULL) {
+ if (chPtr == NULL) {
return;
}
@@ -7542,8 +8484,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* process the next one instead - we are going to delete *this* one.
*/
- for (nhPtr = tsdPtr->nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
+ for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr == chPtr) {
nhPtr->nextHandlerPtr = chPtr->nextPtr;
@@ -7554,12 +8495,12 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* Splice it out of the list of channel handlers.
*/
- if (prevChPtr == (ChannelHandler *) NULL) {
+ if (prevChPtr == NULL) {
statePtr->chPtr = chPtr->nextPtr;
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
- ckfree((char *) chPtr);
+ ckfree(chPtr);
/*
* Recompute the interest list for the channel, so that infinite loops
@@ -7567,9 +8508,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
*/
statePtr->interestMask = 0;
- for (chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
+ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
statePtr->interestMask |= chPtr->mask;
}
@@ -7594,33 +8533,33 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
*/
static void
-DeleteScriptRecord(interp, chanPtr, mask)
- Tcl_Interp *interp; /* Interpreter in which script was to be
+DeleteScriptRecord(
+ Tcl_Interp *interp, /* Interpreter in which script was to be
* executed. */
- Channel *chanPtr; /* The channel for which to delete the script
+ Channel *chanPtr, /* The channel for which to delete the script
* record (if any). */
- int mask; /* Events in mask must exactly match mask of
+ int mask) /* Events in mask must exactly match mask of
* script to delete. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
EventScriptRecord *esPtr, *prevEsPtr;
- for (esPtr = statePtr->scriptRecordPtr,
- prevEsPtr = (EventScriptRecord *) NULL;
- esPtr != (EventScriptRecord *) NULL;
+ for (esPtr = statePtr->scriptRecordPtr, prevEsPtr = NULL; esPtr != NULL;
prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
if (esPtr == statePtr->scriptRecordPtr) {
statePtr->scriptRecordPtr = esPtr->nextPtr;
} else {
+ CLANG_ASSERT(prevEsPtr);
prevEsPtr->nextPtr = esPtr->nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, esPtr);
TclDecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
break;
}
@@ -7645,40 +8584,54 @@ DeleteScriptRecord(interp, chanPtr, mask)
*/
static void
-CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
- Tcl_Interp *interp; /* Interpreter in which to execute the
- * stored script. */
- Channel *chanPtr; /* Channel for which script is to be
- * stored. */
- int mask; /* Set of events for which script will
- * be invoked. */
- Tcl_Obj *scriptPtr; /* Pointer to script object. */
-{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+CreateScriptRecord(
+ Tcl_Interp *interp, /* Interpreter in which to execute the stored
+ * script. */
+ Channel *chanPtr, /* Channel for which script is to be stored */
+ int mask, /* Set of events for which script will be
+ * invoked. */
+ Tcl_Obj *scriptPtr) /* Pointer to script object. */
+{
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
EventScriptRecord *esPtr;
+ int makeCH;
- for (esPtr = statePtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = esPtr->nextPtr) {
+ for (esPtr=statePtr->scriptRecordPtr; esPtr!=NULL; esPtr=esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
TclDecrRefCount(esPtr->scriptPtr);
- esPtr->scriptPtr = (Tcl_Obj *) NULL;
+ esPtr->scriptPtr = NULL;
break;
}
}
- if (esPtr == (EventScriptRecord *) NULL) {
- esPtr = (EventScriptRecord *)
- ckalloc((unsigned) sizeof(EventScriptRecord));
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
- esPtr->nextPtr = statePtr->scriptRecordPtr;
- statePtr->scriptRecordPtr = esPtr;
+
+ makeCH = (esPtr == NULL);
+
+ if (makeCH) {
+ esPtr = ckalloc(sizeof(EventScriptRecord));
}
+
+ /*
+ * Initialize the structure before calling Tcl_CreateChannelHandler,
+ * 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].
+ */
+
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
Tcl_IncrRefCount(scriptPtr);
esPtr->scriptPtr = scriptPtr;
+
+ if (makeCH) {
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
+
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, esPtr);
+ }
}
/*
@@ -7700,9 +8653,9 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
*/
void
-TclChannelEventScriptInvoker(clientData, mask)
- ClientData clientData; /* The script+interp record. */
- int mask; /* Not used. */
+TclChannelEventScriptInvoker(
+ ClientData clientData, /* The script+interp record. */
+ int mask) /* Not used. */
{
Tcl_Interp *interp; /* Interpreter in which to eval the script. */
Channel *chanPtr; /* The channel for which this handler is
@@ -7711,10 +8664,10 @@ TclChannelEventScriptInvoker(clientData, mask)
* in. */
int result; /* Result of call to eval script. */
- esPtr = (EventScriptRecord *) clientData;
- chanPtr = esPtr->chanPtr;
- mask = esPtr->mask;
- interp = esPtr->interp;
+ esPtr = clientData;
+ chanPtr = esPtr->chanPtr;
+ mask = esPtr->mask;
+ interp = esPtr->interp;
/*
* We must preserve the interpreter so we can report errors on it later.
@@ -7722,7 +8675,8 @@ TclChannelEventScriptInvoker(clientData, mask)
* by Tcl_NotifyChannel before calling channel handlers.
*/
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
+ Tcl_Preserve(chanPtr);
result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
@@ -7737,9 +8691,10 @@ TclChannelEventScriptInvoker(clientData, mask)
if (chanPtr->typePtr != NULL) {
DeleteScriptRecord(interp, chanPtr, mask);
}
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, result);
}
- Tcl_Release((ClientData) interp);
+ Tcl_Release(chanPtr);
+ Tcl_Release(interp);
}
/*
@@ -7763,23 +8718,21 @@ TclChannelEventScriptInvoker(clientData, mask)
/* ARGSUSED */
int
-Tcl_FileEventObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter in which the channel
- * for which to create the handler is
- * found. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Channel *chanPtr; /* The channel to create the handler
- * for. */
- ChannelState *statePtr; /* state info for channel */
- Tcl_Channel chan; /* The opaque type for the channel. */
- char *chanName;
- int modeIndex; /* Index of mode argument. */
+Tcl_FileEventObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter in which the channel for which
+ * to create the handler is found. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Channel *chanPtr; /* The channel to create the handler for. */
+ ChannelState *statePtr; /* State info for channel */
+ Tcl_Channel chan; /* The opaque type for the channel. */
+ const char *chanName;
+ int modeIndex; /* Index of mode argument. */
int mask;
- static CONST char *modeOptions[] = {"readable", "writable", NULL};
- static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+ static const char *const modeOptions[] = {"readable", "writable", NULL};
+ static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
@@ -7791,17 +8744,16 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
}
mask = maskArray[modeIndex];
- chanName = Tcl_GetString(objv[1]);
+ chanName = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
if ((statePtr->flags & mask) == 0) {
- Tcl_AppendResult(interp, "channel is not ",
- (mask == TCL_READABLE) ? "readable" : "writable",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
+ (mask == TCL_READABLE) ? "readable" : "writable"));
return TCL_ERROR;
}
@@ -7811,8 +8763,8 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
if (objc == 3) {
EventScriptRecord *esPtr;
- for (esPtr = statePtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
+
+ for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
Tcl_SetObjResult(interp, esPtr->scriptPtr);
@@ -7826,7 +8778,7 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
* If we are supposed to delete a stored script, do so.
*/
- if (*(Tcl_GetString(objv[3])) == '\0') {
+ if (*(TclGetString(objv[3])) == '\0') {
DeleteScriptRecord(interp, chanPtr, mask);
return TCL_OK;
}
@@ -7845,12 +8797,39 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * 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
- * synchronously or asynchronously. If a command script is supplied, the
- * operation runs in the background. The script is invoked when the copy
- * completes. Otherwise the function waits until the copy is completed
+ * synchronously or asynchronously. If a command script is supplied, the
+ * operation runs in the background. The script is invoked when the copy
+ * completes. Otherwise the function waits until the copy is completed
* before returning.
*
* Results:
@@ -7864,12 +8843,24 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
*/
int
-TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Channel inChan; /* Channel to read from. */
- Tcl_Channel outChan; /* Channel to write to. */
- int toRead; /* Amount of data to copy, or -1 for all. */
- Tcl_Obj *cmdPtr; /* Pointer to script to execute or NULL. */
+TclCopyChannelOld(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Channel inChan, /* Channel to read from. */
+ Tcl_Channel outChan, /* Channel to write to. */
+ int toRead, /* Amount of data to copy, or -1 for all. */
+ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
+{
+ return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
+ cmdPtr);
+}
+
+int
+TclCopyChannel(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Channel inChan, /* Channel to read from. */
+ Tcl_Channel outChan, /* Channel to write to. */
+ Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */
+ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
{
Channel *inPtr = (Channel *) inChan;
Channel *outPtr = (Channel *) outChan;
@@ -7881,14 +8872,18 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
inStatePtr = inPtr->state;
outStatePtr = outPtr->state;
- if (inStatePtr->csPtr) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(inChan), "\" is busy", NULL);
+ if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
+ }
return TCL_ERROR;
}
- if (outStatePtr->csPtr) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(outChan), "\" is busy", NULL);
+ if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
+ }
return TCL_ERROR;
}
@@ -7896,61 +8891,65 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
writeFlags = outStatePtr->flags;
/*
- * Set up the blocking mode appropriately. Background copies need
- * non-blocking channels. Foreground copies need blocking channels. If
+ * Set up the blocking mode appropriately. Background copies need
+ * non-blocking channels. Foreground copies need blocking channels. If
* there is an error, restore the old blocking mode.
*/
if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
- if (SetBlockMode(interp, inPtr,
- nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
- != TCL_OK) {
+ if (SetBlockMode(interp, inPtr, nonBlocking ?
+ TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) {
return TCL_ERROR;
}
}
- if (inPtr != outPtr) {
- if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
- if (SetBlockMode(NULL, outPtr,
- nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
- != TCL_OK) {
- if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
- SetBlockMode(NULL, inPtr,
- (readFlags & CHANNEL_NONBLOCKING)
- ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
- return TCL_ERROR;
- }
- }
- }
+ if ((inPtr!=outPtr) && (nonBlocking!=(writeFlags&CHANNEL_NONBLOCKING)) &&
+ (SetBlockMode(NULL, outPtr, nonBlocking ?
+ TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) &&
+ (nonBlocking != (readFlags & CHANNEL_NONBLOCKING))) {
+ SetBlockMode(NULL, inPtr, (readFlags & CHANNEL_NONBLOCKING)
+ ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
+ return TCL_ERROR;
}
/*
* Make sure the output side is unbuffered.
*/
- outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
- | CHANNEL_UNBUFFERED;
+ outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED)
+ | CHANNEL_UNBUFFERED;
/*
* Allocate a new CopyState to maintain info about the current copy in
- * progress. This structure will be deallocated when the copy is
+ * progress. This structure will be deallocated when the copy is
* completed.
*/
- csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
+ csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
csPtr->bufSize = inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
csPtr->toRead = toRead;
- csPtr->total = 0;
+ csPtr->total = (Tcl_WideInt) 0;
csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
}
csPtr->cmdPtr = cmdPtr;
- inStatePtr->csPtr = csPtr;
- outStatePtr->csPtr = csPtr;
+
+ inStatePtr->csPtrR = csPtr;
+ 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.
@@ -7977,20 +8976,20 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
*/
static int
-CopyData(csPtr, mask)
- CopyState *csPtr; /* State of copy operation. */
- int mask; /* Current channel event flags. */
+CopyData(
+ CopyState *csPtr, /* State of copy operation. */
+ int mask) /* Current channel event flags. */
{
Tcl_Interp *interp;
- Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
- Tcl_Obj* msg = NULL;
+ Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
Tcl_Channel inChan, outChan;
ChannelState *inStatePtr, *outStatePtr;
- int result = TCL_OK, size, total, sizeb;
- char *buffer;
-
- int inBinary, outBinary, sameEncoding; /* Encoding control */
- int underflow; /* input underflow */
+ int result = TCL_OK, size, sizeb;
+ Tcl_WideInt total;
+ const char *buffer;
+ int inBinary, outBinary, sameEncoding;
+ /* Encoding control */
+ int underflow; /* Input underflow */
inChan = (Tcl_Channel) csPtr->readPtr;
outChan = (Tcl_Channel) csPtr->writePtr;
@@ -8016,77 +9015,94 @@ CopyData(csPtr, mask)
Tcl_IncrRefCount(bufObj);
}
- while (csPtr->toRead != 0) {
+ while (csPtr->toRead != (Tcl_WideInt) 0) {
/*
* Check for unreported background errors.
*/
- Tcl_GetChannelError (inChan, &msg);
+ Tcl_GetChannelError(inChan, &msg);
if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
Tcl_SetErrno(inStatePtr->unreportedError);
inStatePtr->unreportedError = 0;
goto readError;
}
- Tcl_GetChannelError (outChan, &msg);
+ Tcl_GetChannelError(outChan, &msg);
if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
Tcl_SetErrno(outStatePtr->unreportedError);
outStatePtr->unreportedError = 0;
goto writeError;
}
- /*
- * Read up to bufSize bytes.
- */
+ if (cmdPtr && (mask == 0)) {
+ /*
+ * In async mode, we skip reading synchronously and fake an
+ * underflow instead to prime the readable fileevent.
+ */
- if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
- sizeb = csPtr->bufSize;
+ size = 0;
+ underflow = 1;
} else {
- sizeb = csPtr->toRead;
- }
+ /*
+ * Read up to bufSize bytes.
+ */
- if (inBinary || sameEncoding) {
- size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
- } else {
- size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
+ if ((csPtr->toRead == (Tcl_WideInt) -1)
+ || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
+ sizeb = csPtr->bufSize;
+ } else {
+ sizeb = (int) csPtr->toRead;
+ }
+
+ if (inBinary || sameEncoding) {
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
+ !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
+ } else {
+ size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
+ 0 /* No append */);
+ }
+ underflow = (size >= 0) && (size < sizeb); /* Input underflow */
}
- underflow = (size >= 0) && (size < sizeb); /* input underflow */
if (size < 0) {
readError:
- TclNewObj(errObj);
- Tcl_AppendStringsToObj(errObj, "error reading \"",
- Tcl_GetChannelName(inChan), "\": ",
- (char *) NULL);
+ if (interp) {
+ TclNewObj(errObj);
+ Tcl_AppendStringsToObj(errObj, "error reading \"",
+ Tcl_GetChannelName(inChan), "\": ", NULL);
+ if (msg != NULL) {
+ Tcl_AppendObjToObj(errObj, msg);
+ } else {
+ Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
+ NULL);
+ }
+ }
if (msg != NULL) {
- Tcl_AppendObjToObj(errObj,msg);
- } else {
- Tcl_AppendStringsToObj(errObj,
- Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_DecrRefCount(msg);
}
break;
} else if (underflow) {
/*
- * We had an underflow on the read side. If we are at EOF, then
- * the copying is done, otherwise set up a channel handler to
- * detect when the channel becomes readable again.
+ * We had an underflow on the read side. If we are at EOF, and not
+ * in the synchronous part of an asynchronous fcopy, then the
+ * copying is done, otherwise set up a channel handler to detect
+ * when the channel becomes readable again.
*/
- if ((size == 0) && Tcl_Eof(inChan)) {
+ if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
break;
}
- if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
+ if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
+ !(mask & TCL_READABLE)) {
if (mask & TCL_WRITABLE) {
- Tcl_DeleteChannelHandler(outChan, CopyEventProc,
- (ClientData) csPtr);
+ Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
- Tcl_CreateChannelHandler(inChan, TCL_READABLE,
- CopyEventProc, (ClientData) csPtr);
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc,
+ csPtr);
}
if (size == 0) {
- if (bufObj != (Tcl_Obj *) NULL) {
+ if (bufObj != NULL) {
TclDecrRefCount(bufObj);
- bufObj = (Tcl_Obj *) NULL;
+ bufObj = NULL;
}
return TCL_OK;
}
@@ -8100,32 +9116,42 @@ CopyData(csPtr, mask)
buffer = csPtr->buffer;
sizeb = size;
} else {
- buffer = Tcl_GetStringFromObj(bufObj, &sizeb);
+ buffer = TclGetStringFromObj(bufObj, &sizeb);
}
if (outBinary || sameEncoding) {
- sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
} else {
- sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
}
- if (inBinary || sameEncoding) {
- /* Both read and write counted bytes */
- size = sizeb;
- } /* else : Read counted characters, write counted bytes, i.e. size != sizeb */
+ /*
+ * [Bug 2895565]. At this point 'size' still contains the number of
+ * bytes or characters which have been read. We keep this to later to
+ * update the totals and toRead information, see marker (UP) below. We
+ * must not overwrite it with 'sizeb', which is the number of written
+ * bytes or characters, and both EOL translation and encoding
+ * conversion may have changed this number unpredictably in relation
+ * to 'size' (It can be smaller or larger, in the latter case able to
+ * drive toRead below -1, causing infinite looping). Completely
+ * unsuitable for updating totals and toRead.
+ */
if (sizeb < 0) {
writeError:
- TclNewObj(errObj);
- Tcl_AppendStringsToObj(errObj, "error writing \"",
- Tcl_GetChannelName(outChan), "\": ",
- (char *) NULL);
+ if (interp) {
+ TclNewObj(errObj);
+ Tcl_AppendStringsToObj(errObj, "error writing \"",
+ Tcl_GetChannelName(outChan), "\": ", NULL);
+ if (msg != NULL) {
+ Tcl_AppendObjToObj(errObj, msg);
+ } else {
+ Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
+ NULL);
+ }
+ }
if (msg != NULL) {
- Tcl_AppendObjToObj(errObj,msg);
- } else {
- Tcl_AppendStringsToObj(errObj,
- Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_DecrRefCount(msg);
}
break;
}
@@ -8151,24 +9177,23 @@ CopyData(csPtr, mask)
}
/*
- * Check to see if the write is happening in the background. If so,
+ * Check to see if the write is happening in the background. If so,
* stop copying and wait for the channel to become writable again.
* After input underflow we already installed a readable handler
* therefore we don't need a writable handler.
*/
- if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
- Tcl_DeleteChannelHandler(inChan, CopyEventProc,
- (ClientData) csPtr);
+ Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
}
Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
- CopyEventProc, (ClientData) csPtr);
+ CopyEventProc, csPtr);
}
- if (bufObj != (Tcl_Obj *) NULL) {
+ if (bufObj != NULL) {
TclDecrRefCount(bufObj);
- bufObj = (Tcl_Obj *) NULL;
+ bufObj = NULL;
}
return TCL_OK;
}
@@ -8178,27 +9203,27 @@ CopyData(csPtr, mask)
* don't starve the rest of the system.
*/
- if (cmdPtr) {
+ if (cmdPtr && (csPtr->toRead != 0)) {
/*
* The first time we enter this code, there won't be a channel
* handler established yet, so do it here.
*/
if (mask == 0) {
- Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
- CopyEventProc, (ClientData) csPtr);
+ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc,
+ csPtr);
}
- if (bufObj != (Tcl_Obj *) NULL) {
+ if (bufObj != NULL) {
TclDecrRefCount(bufObj);
- bufObj = (Tcl_Obj *) NULL;
+ bufObj = NULL;
}
return TCL_OK;
}
} /* while */
- if (bufObj != (Tcl_Obj *) NULL) {
+ if (bufObj != NULL) {
TclDecrRefCount(bufObj);
- bufObj = (Tcl_Obj *) NULL;
+ bufObj = NULL;
}
/*
@@ -8207,36 +9232,41 @@ CopyData(csPtr, mask)
*/
total = csPtr->total;
- if (cmdPtr) {
+ if (cmdPtr && interp) {
+ int code;
+
/*
* Get a private copy of the command so we can mutate it by adding
- * arguments. Note that StopCopy frees our saved reference to the
+ * arguments. Note that StopCopy frees our saved reference to the
* original command obj.
*/
cmdPtr = Tcl_DuplicateObj(cmdPtr);
Tcl_IncrRefCount(cmdPtr);
StopCopy(csPtr);
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
- Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
if (errObj) {
Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
}
- if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
- Tcl_BackgroundError(interp);
+ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(interp, code);
result = TCL_ERROR;
}
TclDecrRefCount(cmdPtr);
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
} else {
StopCopy(csPtr);
- if (errObj) {
- Tcl_SetObjResult(interp, errObj);
- result = TCL_ERROR;
- } else {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
+ if (interp) {
+ if (errObj) {
+ Tcl_SetObjResult(interp, errObj);
+ result = TCL_ERROR;
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
+ }
}
}
return result;
@@ -8247,9 +9277,8 @@ CopyData(csPtr, mask)
*
* DoRead --
*
- * Reads a given number of bytes from a channel.
- *
- * No encoding conversions are applied to the bytes being read.
+ * Reads a given number of bytes from a channel. No encoding conversions
+ * are applied to the bytes being read.
*
* Results:
* The number of characters read, or -1 on error. Use Tcl_GetErrno() to
@@ -8262,12 +9291,14 @@ CopyData(csPtr, mask)
*/
static int
-DoRead(chanPtr, bufPtr, toRead)
- Channel *chanPtr; /* The channel from which to read. */
- char *bufPtr; /* Where to store input read. */
- int toRead; /* Maximum number of bytes to read. */
+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 allowShortReads) /* Allow half-blocking (pipes,sockets) */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
int copied; /* How many characters were copied into the
* result string? */
int copiedNow; /* How many characters were copied from the
@@ -8280,23 +9311,24 @@ DoRead(chanPtr, bufPtr, toRead)
* operation.
*/
- if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
- statePtr->flags &= ~CHANNEL_EOF;
+ Tcl_Preserve(chanPtr);
+ if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ ResetFlag(statePtr, CHANNEL_EOF);
}
- statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
for (copied = 0; copied < toRead; copied += copiedNow) {
copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
toRead - copied);
if (copiedNow == 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
goto done;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
goto done;
}
- statePtr->flags &= (~(CHANNEL_BLOCKED));
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
}
result = GetInput(chanPtr);
if (result != 0) {
@@ -8305,10 +9337,13 @@ DoRead(chanPtr, bufPtr, toRead)
}
goto done;
}
- }
+ } else if (allowShortReads) {
+ copied += copiedNow;
+ break;
+ }
}
- statePtr->flags &= (~(CHANNEL_BLOCKED));
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
/*
* Update the notifier state so we don't block while there is still data
@@ -8317,6 +9352,7 @@ DoRead(chanPtr, bufPtr, toRead)
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -8340,10 +9376,10 @@ DoRead(chanPtr, bufPtr, toRead)
*/
static int
-CopyAndTranslateBuffer(statePtr, result, space)
- ChannelState *statePtr; /* Channel state from which to read input. */
- char *result; /* Where to store the copied input. */
- int space; /* How many bytes are available in result to
+CopyAndTranslateBuffer(
+ ChannelState *statePtr, /* Channel state from which to read input. */
+ char *result, /* Where to store the copied input. */
+ int space) /* How many bytes are available in result to
* store the copied input? */
{
ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
@@ -8361,11 +9397,11 @@ CopyAndTranslateBuffer(statePtr, result, space)
* also that if the buffer is empty, we leave it in the queue.
*/
- if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (statePtr->inQueueHead == NULL) {
return 0;
}
bufPtr = statePtr->inQueueHead;
- bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+ bytesInBuffer = BytesLeft(bufPtr);
copied = 0;
switch (statePtr->inputTranslation) {
@@ -8381,8 +9417,7 @@ CopyAndTranslateBuffer(statePtr, result, space)
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
- memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
+ memcpy(result, RemovePoint(bufPtr), (size_t) space);
bufPtr->nextRemoved += space;
copied = space;
break;
@@ -8401,8 +9436,7 @@ CopyAndTranslateBuffer(statePtr, result, space)
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
- memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
+ memcpy(result, RemovePoint(bufPtr), (size_t) space);
bufPtr->nextRemoved += space;
copied = space;
@@ -8425,22 +9459,21 @@ CopyAndTranslateBuffer(statePtr, result, space)
if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
(INPUT_SAW_CR | CHANNEL_EOF)) {
result[0] = '\r';
- statePtr->flags &= ~INPUT_SAW_CR;
+ ResetFlag(statePtr, INPUT_SAW_CR);
return 1;
}
return 0;
}
/*
- * Copy the current chunk and replace "\r\n" with "\n"
- * (but not standalone "\r"!).
+ * Copy the current chunk and replace "\r\n" with "\n" (but not
+ * standalone "\r"!).
*/
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
- memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
+ memcpy(result, RemovePoint(bufPtr), (size_t) space);
bufPtr->nextRemoved += space;
copied = space;
@@ -8449,14 +9482,14 @@ CopyAndTranslateBuffer(statePtr, result, space)
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == '\n') {
- statePtr->flags &= ~INPUT_SAW_CR;
- } else if (statePtr->flags & INPUT_SAW_CR) {
- statePtr->flags &= ~INPUT_SAW_CR;
+ ResetFlag(statePtr, INPUT_SAW_CR);
+ } else if (GotFlag(statePtr, INPUT_SAW_CR)) {
+ ResetFlag(statePtr, INPUT_SAW_CR);
*dst = '\r';
dst++;
}
if (curByte == '\r') {
- statePtr->flags |= INPUT_SAW_CR;
+ SetFlag(statePtr, INPUT_SAW_CR);
} else {
*dst = (char) curByte;
dst++;
@@ -8480,8 +9513,7 @@ CopyAndTranslateBuffer(statePtr, result, space)
if (bytesInBuffer < space) {
space = bytesInBuffer;
}
- memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
+ memcpy(result, RemovePoint(bufPtr), (size_t) space);
bufPtr->nextRemoved += space;
copied = space;
@@ -8490,15 +9522,15 @@ CopyAndTranslateBuffer(statePtr, result, space)
for (src = result; src < end; src++) {
curByte = *src;
if (curByte == '\r') {
- statePtr->flags |= INPUT_SAW_CR;
+ SetFlag(statePtr, INPUT_SAW_CR);
*dst = '\n';
dst++;
} else {
- if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
+ if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {
*dst = (char) curByte;
dst++;
}
- statePtr->flags &= ~INPUT_SAW_CR;
+ ResetFlag(statePtr, INPUT_SAW_CR);
}
}
copied = dst - result;
@@ -8522,7 +9554,7 @@ CopyAndTranslateBuffer(statePtr, result, space)
* caller.
*/
- statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
copied = i;
break;
@@ -8534,10 +9566,10 @@ CopyAndTranslateBuffer(statePtr, result, space)
* If the current buffer is empty recycle it.
*/
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ if (IsBufferEmpty(bufPtr)) {
statePtr->inQueueHead = bufPtr->nextPtr;
- if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
- statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ if (statePtr->inQueueHead == NULL) {
+ statePtr->inQueueTail = NULL;
}
RecycleBuffer(statePtr, bufPtr, 0);
}
@@ -8569,10 +9601,10 @@ CopyAndTranslateBuffer(statePtr, result, space)
*/
static int
-CopyBuffer(chanPtr, result, space)
- Channel *chanPtr; /* Channel from which to read input. */
- char *result; /* Where to store the copied input. */
- int space; /* How many bytes are available in result to
+CopyBuffer(
+ Channel *chanPtr, /* Channel from which to read input. */
+ char *result, /* Where to store the copied input. */
+ int space) /* How many bytes are available in result to
* store the copied input? */
{
ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
@@ -8589,18 +9621,18 @@ CopyBuffer(chanPtr, result, space)
* recycle it.
*/
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (chanPtr->inQueueHead == NULL) {
return 0;
}
bufPtr = chanPtr->inQueueHead;
- bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+ bytesInBuffer = BytesLeft(bufPtr);
copied = 0;
if (bytesInBuffer == 0) {
RecycleBuffer(chanPtr->state, bufPtr, 0);
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
return 0;
}
@@ -8612,8 +9644,7 @@ CopyBuffer(chanPtr, result, space)
space = bytesInBuffer;
}
- memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
+ memcpy(result, RemovePoint(bufPtr), (size_t) space);
bufPtr->nextRemoved += space;
copied = space;
@@ -8627,10 +9658,10 @@ CopyBuffer(chanPtr, result, space)
* If the current buffer is empty recycle it.
*/
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ if (IsBufferEmpty(bufPtr)) {
chanPtr->inQueueHead = bufPtr->nextPtr;
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ if (chanPtr->inQueueHead == NULL) {
+ chanPtr->inQueueTail = NULL;
}
RecycleBuffer(chanPtr->state, bufPtr, 0);
}
@@ -8645,164 +9676,6 @@ CopyBuffer(chanPtr, result, space)
/*
*----------------------------------------------------------------------
*
- * DoWrite --
- *
- * Puts a sequence of characters into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DoWrite(chanPtr, src, srcLen)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* Data to write. */
- int srcLen; /* Number of bytes to write. */
-{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *outBufPtr; /* Current output buffer. */
- int foundNewline; /* Did we find a newline in output? */
- char *dPtr;
- CONST char *sPtr; /* Search variables for newline. */
- int crsent; /* In CRLF eol translation mode,
- * remember the fact that a CR was
- * output to the channel without its
- * following NL. */
- int i; /* Loop index for newline search. */
- int destCopied; /* How many bytes were used in this
- * destination buffer to hold the
- * output? */
- int totalDestCopied; /* How many bytes total were copied to
- * the channel buffer? */
- int srcCopied; /* How many bytes were copied from the
- * source string? */
- char *destPtr; /* Where in line to copy to? */
-
- /*
- * If we are in network (or windows) translation mode, record the fact
- * that we have not yet sent a CR to the channel.
- */
-
- crsent = 0;
-
- /*
- * Loop filling buffers and flushing them until all output has been
- * consumed.
- */
-
- srcCopied = 0;
- totalDestCopied = 0;
-
- while (srcLen > 0) {
-
- /*
- * Make sure there is a current output buffer to accept output.
- */
-
- if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
- statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
- }
-
- outBufPtr = statePtr->curOutPtr;
-
- destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
- if (destCopied > srcLen) {
- destCopied = srcLen;
- }
-
- destPtr = outBufPtr->buf + outBufPtr->nextAdded;
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- srcCopied = destCopied;
- memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
- break;
- case TCL_TRANSLATE_CR:
- srcCopied = destCopied;
- memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
- for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
- if (*dPtr == '\n') {
- *dPtr = '\r';
- }
- }
- break;
- case TCL_TRANSLATE_CRLF:
- for (srcCopied = 0, dPtr = destPtr, sPtr = src;
- dPtr < destPtr + destCopied;
- dPtr++, sPtr++, srcCopied++) {
- if (*sPtr == '\n') {
- if (crsent) {
- *dPtr = '\n';
- crsent = 0;
- } else {
- *dPtr = '\r';
- crsent = 1;
- sPtr--, srcCopied--;
- }
- } else {
- *dPtr = *sPtr;
- }
- }
- break;
- case TCL_TRANSLATE_AUTO:
- Tcl_Panic("Tcl_Write: AUTO output translation mode not supported");
- default:
- Tcl_Panic("Tcl_Write: unknown output translation mode");
- }
-
- /*
- * The current buffer is ready for output if it is full, or if it
- * contains a newline and this channel is line-buffered, or if it
- * contains any output and this channel is unbuffered.
- */
-
- outBufPtr->nextAdded += destCopied;
- if (!(statePtr->flags & BUFFER_READY)) {
- if (outBufPtr->nextAdded == outBufPtr->bufLength) {
- statePtr->flags |= BUFFER_READY;
- } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
- for (sPtr = src, i = 0, foundNewline = 0;
- (i < srcCopied) && (!foundNewline);
- i++, sPtr++) {
- if (*sPtr == '\n') {
- foundNewline = 1;
- break;
- }
- }
- if (foundNewline) {
- statePtr->flags |= BUFFER_READY;
- }
- } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
- statePtr->flags |= BUFFER_READY;
- }
- }
-
- totalDestCopied += srcCopied;
- src += srcCopied;
- srcLen -= srcCopied;
-
- if (statePtr->flags & BUFFER_READY) {
- if (FlushChannel(NULL, chanPtr, 0) != 0) {
- return -1;
- }
- }
- } /* Closes "while" */
-
- return totalDestCopied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* CopyEventProc --
*
* This routine is invoked as a channel event handler for the background
@@ -8819,11 +9692,11 @@ DoWrite(chanPtr, src, srcLen)
*/
static void
-CopyEventProc(clientData, mask)
- ClientData clientData;
- int mask;
+CopyEventProc(
+ ClientData clientData,
+ int mask)
{
- (void) CopyData((CopyState *) clientData, mask);
+ (void) CopyData(clientData, mask);
}
/*
@@ -8844,8 +9717,8 @@ CopyEventProc(clientData, mask)
*/
static void
-StopCopy(csPtr)
- CopyState *csPtr; /* State for bg copy to stop . */
+StopCopy(
+ CopyState *csPtr) /* State for bg copy to stop . */
{
ChannelState *inStatePtr, *outStatePtr;
int nonBlocking;
@@ -8861,34 +9734,34 @@ StopCopy(csPtr)
* Restore the old blocking mode and output buffering mode.
*/
- nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
+ nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING;
if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->readPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
if (csPtr->readPtr != csPtr->writePtr) {
- nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
+ nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING;
if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
}
- outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+ ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
outStatePtr->flags |=
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
if (csPtr->cmdPtr) {
Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
- (ClientData) csPtr);
+ csPtr);
if (csPtr->readPtr != csPtr->writePtr) {
Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
- CopyEventProc, (ClientData) csPtr);
+ CopyEventProc, csPtr);
}
TclDecrRefCount(csPtr->cmdPtr);
}
- inStatePtr->csPtr = NULL;
- outStatePtr->csPtr = NULL;
- ckfree((char *) csPtr);
+ inStatePtr->csPtrR = NULL;
+ outStatePtr->csPtrW = NULL;
+ ckfree(csPtr);
}
/*
@@ -8910,23 +9783,26 @@ StopCopy(csPtr)
*/
static int
-StackSetBlockMode(chanPtr, mode)
- Channel *chanPtr; /* Channel to modify. */
- int mode; /* One of TCL_MODE_BLOCKING or
+StackSetBlockMode(
+ Channel *chanPtr, /* Channel to modify. */
+ int mode) /* One of TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
+ ChannelState *statePtr = chanPtr->state;
/*
* Start at the top of the channel stack
+ * TODO: Examine what can go wrong when blockModeProc calls
+ * disturb the stacking state of the channel.
*/
- chanPtr = chanPtr->state->topChanPtr;
- while (chanPtr != (Channel *) NULL) {
+ chanPtr = statePtr->topChanPtr;
+ while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
- result = (*blockModeProc) (chanPtr->instanceData, mode);
+ result = blockModeProc(chanPtr->instanceData, mode);
if (result != 0) {
Tcl_SetErrno(result);
return result;
@@ -8956,19 +9832,21 @@ StackSetBlockMode(chanPtr, mode)
*/
static int
-SetBlockMode(interp, chanPtr, mode)
- Tcl_Interp *interp; /* Interp for error reporting. */
- Channel *chanPtr; /* Channel to modify. */
- int mode; /* One of TCL_MODE_BLOCKING or
+SetBlockMode(
+ Tcl_Interp *interp, /* Interp for error reporting. */
+ Channel *chanPtr, /* Channel to modify. */
+ int mode) /* One of TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
int result = 0;
+ ChannelState *statePtr = chanPtr->state;
+ /* State info for channel */
result = StackSetBlockMode(chanPtr, mode);
if (result != 0) {
- if (interp != (Tcl_Interp *) NULL) {
- /* TIP #219.
+ if (interp != NULL) {
+ /*
+ * TIP #219.
* Move 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.
@@ -8977,24 +9855,28 @@ SetBlockMode(interp, chanPtr, mode)
* area, StackSetBlockMode is restricted to the channel bypass.
* We still need the interp as the destination of the move.
*/
- if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) {
- Tcl_AppendResult(interp, "error setting blocking mode: ",
- Tcl_PosixError(interp), (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error setting blocking mode: %s",
+ Tcl_PosixError(interp)));
}
} else {
- /* TIP #219.
+ /*
+ * TIP #219.
* If we have no interpreter to put a bypass message into we have
* to clear it, to prevent its propagation and use in other places
* unrelated to the actual occurence of the problem.
*/
- Tcl_SetChannelError ((Tcl_Channel) chanPtr, NULL);
+
+ Tcl_SetChannelError((Tcl_Channel) chanPtr, NULL);
}
return TCL_ERROR;
}
if (mode == TCL_MODE_BLOCKING) {
- statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+ ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED);
} else {
- statePtr->flags |= CHANNEL_NONBLOCKING;
+ SetFlag(statePtr, CHANNEL_NONBLOCKING);
}
return TCL_OK;
}
@@ -9016,10 +9898,10 @@ SetBlockMode(interp, chanPtr, mode)
*/
int
-Tcl_GetChannelNames(interp)
- Tcl_Interp *interp; /* Interp for error reporting. */
+Tcl_GetChannelNames(
+ Tcl_Interp *interp) /* Interp for error reporting. */
{
- return Tcl_GetChannelNamesEx(interp, (char *) NULL);
+ return Tcl_GetChannelNamesEx(interp, NULL);
}
/*
@@ -9028,7 +9910,7 @@ Tcl_GetChannelNames(interp)
* Tcl_GetChannelNamesEx --
*
* Return the names of open channels in the interp filtered filtered
- * through a pattern. If pattern is NULL, it returns all the open
+ * through a pattern. If pattern is NULL, it returns all the open
* channels.
*
* Results:
@@ -9041,19 +9923,19 @@ Tcl_GetChannelNames(interp)
*/
int
-Tcl_GetChannelNamesEx(interp, pattern)
- Tcl_Interp *interp; /* Interp for error reporting. */
- CONST char *pattern; /* pattern to filter on. */
+Tcl_GetChannelNamesEx(
+ Tcl_Interp *interp, /* Interp for error reporting. */
+ const char *pattern) /* Pattern to filter on. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelState *statePtr;
- CONST char *name; /* name for channel */
- Tcl_Obj *resultPtr; /* pointer to result object */
+ const char *name; /* Name for channel */
+ Tcl_Obj *resultPtr; /* Pointer to result object */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_HashSearch hSearch; /* Search variable. */
- if (interp == (Tcl_Interp *) NULL) {
+ if (interp == NULL) {
return TCL_OK;
}
@@ -9074,11 +9956,11 @@ Tcl_GetChannelNamesEx(interp, pattern)
}
goto done;
}
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
+
if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
name = "stdin";
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
@@ -9113,7 +9995,7 @@ Tcl_GetChannelNamesEx(interp, pattern)
*
* Tcl_IsChannelRegistered --
*
- * Checks whether the channel is associated with the interp. See also
+ * Checks whether the channel is associated with the interp. See also
* Tcl_RegisterChannel and Tcl_UnregisterChannel.
*
* Results:
@@ -9126,29 +10008,29 @@ Tcl_GetChannelNamesEx(interp, pattern)
*/
int
-Tcl_IsChannelRegistered(interp, chan)
- Tcl_Interp *interp; /* The interp to query of the channel */
- Tcl_Channel chan; /* The channel to check */
+Tcl_IsChannelRegistered(
+ Tcl_Interp *interp, /* The interp to query of the channel */
+ Tcl_Channel chan) /* The channel to check */
{
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* The real IO channel. */
- ChannelState *statePtr; /* State of the real channel. */
+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of the real channel. */
/*
- * Always check bottom-most channel in the stack. This is the one that
+ * Always check bottom-most channel in the stack. This is the one that
* gets registered.
*/
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
+ hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
return 0;
}
hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
+ if (hPtr == NULL) {
return 0;
}
if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
@@ -9175,11 +10057,11 @@ Tcl_IsChannelRegistered(interp, chan)
*/
int
-Tcl_IsChannelShared(chan)
- Tcl_Channel chan; /* The channel to query */
+Tcl_IsChannelShared(
+ Tcl_Channel chan) /* The channel to query */
{
ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of real channel structure. */
+ /* State of real channel structure. */
return ((statePtr->refCount > 1) ? 1 : 0);
}
@@ -9190,7 +10072,7 @@ Tcl_IsChannelShared(chan)
* Tcl_IsChannelExisting --
*
* Checks whether a channel of the given name exists in the
- * (thread)-global list of all channels. See Tcl_GetChannelNamesEx for
+ * (thread)-global list of all channels. See Tcl_GetChannelNamesEx for
* function exposed at the Tcl level.
*
* Results:
@@ -9203,17 +10085,16 @@ Tcl_IsChannelShared(chan)
*/
int
-Tcl_IsChannelExisting(chanName)
- CONST char *chanName; /* The name of the channel to look for. */
+Tcl_IsChannelExisting(
+ const char *chanName) /* The name of the channel to look for. */
{
ChannelState *statePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- CONST char *name;
+ const char *name;
int chanNameLen;
chanNameLen = strlen(chanName);
- for (statePtr = tsdPtr->firstCSPtr;
- statePtr != NULL;
+ for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
name = "stdin";
@@ -9226,7 +10107,7 @@ Tcl_IsChannelExisting(chanName)
}
if ((*chanName == *name) &&
- (memcmp(name, chanName, (size_t) chanNameLen) == 0)) {
+ (memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
return 1;
}
}
@@ -9250,9 +10131,9 @@ Tcl_IsChannelExisting(chanName)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_ChannelName(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+const char *
+Tcl_ChannelName(
+ const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */
{
return chanTypePtr->typeName;
}
@@ -9274,8 +10155,9 @@ Tcl_ChannelName(chanTypePtr)
*/
Tcl_ChannelTypeVersion
-Tcl_ChannelVersion(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelVersion(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
return TCL_CHANNEL_VERSION_2;
@@ -9283,6 +10165,8 @@ Tcl_ChannelVersion(chanTypePtr)
return TCL_CHANNEL_VERSION_3;
} else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
return TCL_CHANNEL_VERSION_4;
+ } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_5) {
+ return TCL_CHANNEL_VERSION_5;
} else {
/*
* In <v2 channel versions, the version field is occupied by the
@@ -9311,13 +10195,13 @@ Tcl_ChannelVersion(chanTypePtr)
*/
static int
-HaveVersion(chanTypePtr, minimumVersion)
- Tcl_ChannelType *chanTypePtr;
- Tcl_ChannelTypeVersion minimumVersion;
+HaveVersion(
+ const Tcl_ChannelType *chanTypePtr,
+ Tcl_ChannelTypeVersion minimumVersion)
{
Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
- return ((int)actualVersion) >= ((int)minimumVersion);
+ return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
}
/*
@@ -9336,18 +10220,19 @@ HaveVersion(chanTypePtr, minimumVersion)
*---------------------------------------------------------------------- */
Tcl_DriverBlockModeProc *
-Tcl_ChannelBlockModeProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelBlockModeProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->blockModeProc;
- } else {
- /*
- * The v1 structure had the blockModeProc in a different place.
- */
-
- return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
}
+
+ /*
+ * The v1 structure had the blockModeProc in a different place.
+ */
+
+ return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
}
/*
@@ -9367,8 +10252,9 @@ Tcl_ChannelBlockModeProc(chanTypePtr)
*/
Tcl_DriverCloseProc *
-Tcl_ChannelCloseProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelCloseProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->closeProc;
}
@@ -9390,8 +10276,9 @@ Tcl_ChannelCloseProc(chanTypePtr)
*/
Tcl_DriverClose2Proc *
-Tcl_ChannelClose2Proc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelClose2Proc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->close2Proc;
}
@@ -9413,8 +10300,9 @@ Tcl_ChannelClose2Proc(chanTypePtr)
*/
Tcl_DriverInputProc *
-Tcl_ChannelInputProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelInputProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->inputProc;
}
@@ -9436,8 +10324,9 @@ Tcl_ChannelInputProc(chanTypePtr)
*/
Tcl_DriverOutputProc *
-Tcl_ChannelOutputProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelOutputProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->outputProc;
}
@@ -9459,8 +10348,9 @@ Tcl_ChannelOutputProc(chanTypePtr)
*/
Tcl_DriverSeekProc *
-Tcl_ChannelSeekProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelSeekProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->seekProc;
}
@@ -9482,8 +10372,9 @@ Tcl_ChannelSeekProc(chanTypePtr)
*/
Tcl_DriverSetOptionProc *
-Tcl_ChannelSetOptionProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelSetOptionProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->setOptionProc;
}
@@ -9505,8 +10396,9 @@ Tcl_ChannelSetOptionProc(chanTypePtr)
*/
Tcl_DriverGetOptionProc *
-Tcl_ChannelGetOptionProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelGetOptionProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->getOptionProc;
}
@@ -9528,8 +10420,9 @@ Tcl_ChannelGetOptionProc(chanTypePtr)
*/
Tcl_DriverWatchProc *
-Tcl_ChannelWatchProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelWatchProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->watchProc;
}
@@ -9551,8 +10444,9 @@ Tcl_ChannelWatchProc(chanTypePtr)
*/
Tcl_DriverGetHandleProc *
-Tcl_ChannelGetHandleProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelGetHandleProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
return chanTypePtr->getHandleProc;
}
@@ -9574,14 +10468,14 @@ Tcl_ChannelGetHandleProc(chanTypePtr)
*/
Tcl_DriverFlushProc *
-Tcl_ChannelFlushProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelFlushProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->flushProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -9601,14 +10495,14 @@ Tcl_ChannelFlushProc(chanTypePtr)
*/
Tcl_DriverHandlerProc *
-Tcl_ChannelHandlerProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelHandlerProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
return chanTypePtr->handlerProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -9628,14 +10522,14 @@ Tcl_ChannelHandlerProc(chanTypePtr)
*/
Tcl_DriverWideSeekProc *
-Tcl_ChannelWideSeekProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelWideSeekProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
return chanTypePtr->wideSeekProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -9643,7 +10537,7 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
*
* Tcl_ChannelThreadActionProc --
*
- * TIP #218, Channel Thread Actions. Return the
+ * TIP #218, Channel Thread Actions. Return the
* Tcl_DriverThreadActionProc of the channel type.
*
* Results:
@@ -9656,14 +10550,14 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
*/
Tcl_DriverThreadActionProc *
-Tcl_ChannelThreadActionProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelThreadActionProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
return chanTypePtr->threadActionProc;
- } else {
- return NULL;
}
+ return NULL;
}
/*
@@ -9671,7 +10565,7 @@ Tcl_ChannelThreadActionProc(chanTypePtr)
*
* Tcl_SetChannelErrorInterp --
*
- * TIP #219, Tcl Channel Reflection API.
+ * TIP #219, Tcl Channel Reflection API.
* Store an error message for the I/O system.
*
* Results:
@@ -9684,20 +10578,20 @@ Tcl_ChannelThreadActionProc(chanTypePtr)
*/
void
-Tcl_SetChannelErrorInterp (interp, msg)
- Tcl_Interp* interp; /* Interp to store the data into. */
- Tcl_Obj* msg; /* Error message to store. */
+Tcl_SetChannelErrorInterp(
+ Tcl_Interp *interp, /* Interp to store the data into. */
+ Tcl_Obj *msg) /* Error message to store. */
{
- Interp* iPtr = (Interp*) interp;
+ Interp *iPtr = (Interp *) interp;
if (iPtr->chanMsg != NULL) {
- Tcl_DecrRefCount (iPtr->chanMsg);
- iPtr->chanMsg = NULL;
+ TclDecrRefCount(iPtr->chanMsg);
+ iPtr->chanMsg = NULL;
}
if (msg != NULL) {
- iPtr->chanMsg = FixLevelCode (msg);
- Tcl_IncrRefCount (iPtr->chanMsg);
+ iPtr->chanMsg = FixLevelCode(msg);
+ Tcl_IncrRefCount(iPtr->chanMsg);
}
return;
}
@@ -9707,7 +10601,7 @@ Tcl_SetChannelErrorInterp (interp, msg)
*
* Tcl_SetChannelError --
*
- * TIP #219, Tcl Channel Reflection API.
+ * TIP #219, Tcl Channel Reflection API.
* Store an error message for the I/O system.
*
* Results:
@@ -9720,20 +10614,20 @@ Tcl_SetChannelErrorInterp (interp, msg)
*/
void
-Tcl_SetChannelError (chan, msg)
- Tcl_Channel chan; /* Channel to store the data into. */
- Tcl_Obj* msg; /* Error message to store. */
+Tcl_SetChannelError(
+ Tcl_Channel chan, /* Channel to store the data into. */
+ Tcl_Obj *msg) /* Error message to store. */
{
- ChannelState* statePtr = ((Channel*) chan)->state;
+ ChannelState *statePtr = ((Channel *) chan)->state;
if (statePtr->chanMsg != NULL) {
- Tcl_DecrRefCount (statePtr->chanMsg);
- statePtr->chanMsg = NULL;
+ TclDecrRefCount(statePtr->chanMsg);
+ statePtr->chanMsg = NULL;
}
if (msg != NULL) {
- statePtr->chanMsg = FixLevelCode (msg);
- Tcl_IncrRefCount (statePtr->chanMsg);
+ statePtr->chanMsg = FixLevelCode(msg);
+ Tcl_IncrRefCount(statePtr->chanMsg);
}
return;
}
@@ -9743,10 +10637,9 @@ Tcl_SetChannelError (chan, msg)
*
* FixLevelCode --
*
- * TIP #219, Tcl Channel Reflection API.
- * Scans an error message for bad -code / -level
- * directives. Returns a modified copy with such
- * directives corrected, and the input if it had
+ * TIP #219, Tcl Channel Reflection API.
+ * Scans an error message for bad -code / -level directives. Returns a
+ * modified copy with such directives corrected, and the input if it had
* no problems.
*
* Results:
@@ -9758,121 +10651,143 @@ Tcl_SetChannelError (chan, msg)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-FixLevelCode (msg)
-Tcl_Obj* msg;
+static Tcl_Obj *
+FixLevelCode(
+ Tcl_Obj *msg)
{
- int lc;
- Tcl_Obj** lv;
- int explicitResult;
- int numOptions;
- int lcn;
- Tcl_Obj** lvn;
- int res, i, j, val, lignore, cignore;
- Tcl_Obj* newlevel = NULL;
- Tcl_Obj* newcode = NULL;
+ int explicitResult, numOptions, lc, lcn;
+ Tcl_Obj **lv, **lvn;
+ int res, i, j, val, lignore, cignore;
+ int newlevel = -1, newcode = -1;
/* ASSERT msg != NULL */
- /* Process the caught message.
+ /*
+ * Process the caught message.
*
* Syntax = (option value)... ?message?
*
- * Bad syntax causes a panic. Because the other side uses
+ * Bad message syntax causes a panic, because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
- * information.
+ * information. Hence an error means that we've got serious breakage.
*/
- res = Tcl_ListObjGetElements (NULL, msg, &lc, &lv);
+ res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
if (res != TCL_OK) {
- Tcl_Panic ("Tcl_SetChannelError(Interp): Bad syntax of message");
+ Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
}
explicitResult = (1 == (lc % 2));
- numOptions = lc - explicitResult;
+ numOptions = lc - explicitResult;
- /* No options, nothing to do.
+ /*
+ * No options, nothing to do.
*/
if (numOptions == 0) {
return msg;
}
- /* Check for -code x, x != 1|error, and -level x, x != 0 */
+ /*
+ * Check for -code x, x != 1|error, and -level x, x != 0
+ */
for (i = 0; i < numOptions; i += 2) {
- if (0 == strcmp (Tcl_GetString (lv [i]), "-code")) {
- /* !"error", !integer, integer != 1 (numeric code for error) */
+ if (0 == strcmp(TclGetString(lv[i]), "-code")) {
+ /*
+ * !"error", !integer, integer != 1 (numeric code for error)
+ */
- res = Tcl_GetIntFromObj (NULL, lv [i+1], &val);
- if (((res == TCL_OK) && (val != 1)) ||
- ((res != TCL_OK) && (0 != strcmp (Tcl_GetString (lv [i+1]), "error")))) {
- newcode = Tcl_NewIntObj (1);
+ res = TclGetIntFromObj(NULL, lv[i+1], &val);
+ if (((res == TCL_OK) && (val != 1)) || ((res != TCL_OK) &&
+ (0 != strcmp(TclGetString(lv[i+1]), "error")))) {
+ newcode = 1;
}
- } else if (0 == strcmp (Tcl_GetString (lv [i]), "-level")) {
- /* !integer, integer != 0 */
- res = Tcl_GetIntFromObj (NULL, lv [i+1], &val);
+ } else if (0 == strcmp(TclGetString(lv[i]), "-level")) {
+ /*
+ * !integer, integer != 0
+ */
+
+ res = TclGetIntFromObj(NULL, lv [i+1], &val);
if ((res != TCL_OK) || (val != 0)) {
- newlevel = Tcl_NewIntObj (0);
+ newlevel = 0;
}
}
}
- /* -code, -level are either not present or ok. Nothing to do.
+ /*
+ * -code, -level are either not present or ok. Nothing to do.
*/
- if (!newlevel && !newcode) {
+ if ((newlevel < 0) && (newcode < 0)) {
return msg;
}
lcn = numOptions;
- if (explicitResult) lcn ++;
- if (newlevel) lcn += 2;
- if (newcode) lcn += 2;
+ if (explicitResult) {
+ lcn ++;
+ }
+ if (newlevel >= 0) {
+ lcn += 2;
+ }
+ if (newcode >= 0) {
+ 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
+ /*
+ * New level/code information is spliced into the first occurence of
* -level, -code, further occurences are ignored. The options cannot be
* not present, we would not come here. Options which are ok are simply
* copied over.
*/
lignore = cignore = 0;
- for (i = 0, j = 0; i < numOptions; i += 2) {
- if (0 == strcmp (Tcl_GetString (lv [i]), "-level")) {
- if (newlevel) {
- lvn [j] = lv [i]; j++;
- lvn [j] = newlevel; j++;
- newlevel = NULL;
+ for (i=0, j=0; i<numOptions; i+=2) {
+ if (0 == strcmp(TclGetString(lv[i]), "-level")) {
+ if (newlevel >= 0) {
+ lvn[j++] = lv[i];
+ lvn[j++] = Tcl_NewIntObj(newlevel);
+ newlevel = -1;
lignore = 1;
continue;
} else if (lignore) {
continue;
}
- } else if (0 == strcmp (Tcl_GetString (lv [i]), "-code")) {
- if (newcode) {
- lvn [j] = lv [i]; j++;
- lvn [j] = newcode; j++;
- newcode = NULL;
+ } else if (0 == strcmp(TclGetString(lv[i]), "-code")) {
+ if (newcode >= 0) {
+ lvn[j++] = lv[i];
+ lvn[j++] = Tcl_NewIntObj(newcode);
+ newcode = -1;
cignore = 1;
continue;
} else if (cignore) {
continue;
}
}
- /* Keep everything else, possibly copied down */
- lvn [j] = lv [i]; j++;
- lvn [j] = lv [i+1]; j++;
+
+ /*
+ * Keep everything else, possibly copied down.
+ */
+
+ lvn[j++] = lv[i];
+ lvn[j++] = lv[i+1];
+ }
+ if (newlevel >= 0) {
+ Tcl_Panic("Defined newlevel not used in rewrite");
+ }
+ if (newcode >= 0) {
+ Tcl_Panic("Defined newcode not used in rewrite");
}
if (explicitResult) {
- lvn [j] = lv [i]; j++;
+ lvn[j++] = lv[i];
}
- msg = Tcl_NewListObj (j, lvn);
+ msg = Tcl_NewListObj(j, lvn);
- ckfree ((char*) lvn);
+ ckfree(lvn);
return msg;
}
@@ -9881,7 +10796,7 @@ Tcl_Obj* msg;
*
* Tcl_GetChannelErrorInterp --
*
- * TIP #219, Tcl Channel Reflection API.
+ * TIP #219, Tcl Channel Reflection API.
* Return the message stored by the channel driver.
*
* Results:
@@ -9893,14 +10808,15 @@ Tcl_Obj* msg;
*----------------------------------------------------------------------
*/
-void Tcl_GetChannelErrorInterp (interp, msg)
- Tcl_Interp* interp; /* Interp to query. */
- Tcl_Obj** msg; /* Place for error message. */
+void
+Tcl_GetChannelErrorInterp(
+ Tcl_Interp *interp, /* Interp to query. */
+ Tcl_Obj **msg) /* Place for error message. */
{
- Interp* iPtr = (Interp*) interp;
+ Interp *iPtr = (Interp *) interp;
*msg = iPtr->chanMsg;
- iPtr->chanMsg = NULL;
+ iPtr->chanMsg = NULL;
}
/*
@@ -9908,7 +10824,7 @@ void Tcl_GetChannelErrorInterp (interp, msg)
*
* Tcl_GetChannelError --
*
- * TIP #219, Tcl Channel Reflection API.
+ * TIP #219, Tcl Channel Reflection API.
* Return the message stored by the channel driver.
*
* Results:
@@ -9920,14 +10836,15 @@ void Tcl_GetChannelErrorInterp (interp, msg)
*----------------------------------------------------------------------
*/
-void Tcl_GetChannelError (chan, msg)
- Tcl_Channel chan; /* Channel to query. */
- Tcl_Obj** msg; /* Place for error message. */
+void
+Tcl_GetChannelError(
+ Tcl_Channel chan, /* Channel to query. */
+ Tcl_Obj **msg) /* Place for error message. */
{
- ChannelState* statePtr = ((Channel*) chan)->state;
+ ChannelState *statePtr = ((Channel *) chan)->state;
*msg = statePtr->chanMsg;
- statePtr->chanMsg = NULL;
+ statePtr->chanMsg = NULL;
}
/*
@@ -9948,14 +10865,131 @@ void Tcl_GetChannelError (chan, msg)
*/
Tcl_DriverTruncateProc *
-Tcl_ChannelTruncateProc(chanTypePtr)
- Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+Tcl_ChannelTruncateProc(
+ const Tcl_ChannelType *chanTypePtr)
+ /* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
return chanTypePtr->truncateProc;
- } else {
- return NULL;
}
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupChannelIntRep --
+ *
+ * Initialize the internal representation of a new Tcl_Obj to a copy of
+ * the internal representation of an existing string object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to a copy of srcPtr's internal
+ * representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupChannelIntRep(
+ register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
+ * an internal rep of type "Channel". */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
+ * currently have an internal rep.*/
+{
+ ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
+
+ SET_CHANNELSTATE(copyPtr, statePtr);
+ SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
+ Tcl_Preserve(statePtr);
+ copyPtr->typePtr = srcPtr->typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetChannelFromAny --
+ *
+ * Create an internal representation of type "Channel" for an object.
+ *
+ * Results:
+ * This operation always succeeds and returns TCL_OK.
+ *
+ * Side effects:
+ * Any old internal reputation for objPtr is freed and the internal
+ * representation is set to "Channel".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetChannelFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
+{
+ ChannelState *statePtr;
+
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr == &chanObjType) {
+ /*
+ * The channel is valid until any call to DetachChannel occurs.
+ * Ensure consistency checks are done.
+ */
+
+ statePtr = GET_CHANNELSTATE(objPtr);
+ if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+ ResetFlag(statePtr, CHANNEL_TAINTED);
+ Tcl_Release(statePtr);
+ objPtr->typePtr = NULL;
+ } else if (interp != GET_CHANNELINTERP(objPtr)) {
+ Tcl_Release(statePtr);
+ objPtr->typePtr = NULL;
+ }
+ }
+ if (objPtr->typePtr != &chanObjType) {
+ Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
+
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ TclFreeIntRep(objPtr);
+ statePtr = ((Channel *) chan)->state;
+ Tcl_Preserve(statePtr);
+ SET_CHANNELSTATE(objPtr, statePtr);
+ SET_CHANNELINTERP(objPtr, interp);
+ objPtr->typePtr = &chanObjType;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeChannelIntRep --
+ *
+ * Release statePtr storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May cause state to be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeChannelIntRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
+{
+ Tcl_Release(GET_CHANNELSTATE(objPtr));
+ objPtr->typePtr = NULL;
}
#if 0
@@ -9965,14 +10999,14 @@ Tcl_ChannelTruncateProc(chanTypePtr)
*/
static int
-DumpFlags(str, flags)
- char *str;
- int flags;
+DumpFlags(
+ char *str,
+ int flags)
{
char buf[20];
int i = 0;
-#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
+#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
ChanFlag('r', TCL_READABLE);
ChanFlag('w', TCL_WRITABLE);
@@ -10007,5 +11041,7 @@ DumpFlags(str, flags)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 9ec4abc..1e02749 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -1,4 +1,4 @@
-/*
+/*
* tclIO.h --
*
* This file provides the generic portions (those that are the same on
@@ -7,18 +7,16 @@
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-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: tclIO.h,v 1.8 2005/08/24 17:56:23 andreas_kupries Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
/*
* Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
- * compile on systems where neither is defined. We want both defined so
- * that we can test safely for both. In the code we still have to test for
- * both because there may be systems on which both are defined and have
- * different values.
+ * compile on systems where neither is defined. We want both defined so that
+ * we can test safely for both. In the code we still have to test for both
+ * because there may be systems on which both are defined and have different
+ * values.
*/
#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
@@ -28,88 +26,57 @@
# define EAGAIN EWOULDBLOCK
#endif
#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
-error one of EWOULDBLOCK or EAGAIN must be defined
+#error one of EWOULDBLOCK or EAGAIN must be defined
#endif
/*
- * The following structure encapsulates the state for a background channel
- * copy. Note that the data buffer for the copy will be appended to this
- * structure.
- */
-
-typedef struct CopyState {
- struct Channel *readPtr; /* Pointer to input channel. */
- struct Channel *writePtr; /* Pointer to output channel. */
- int readFlags; /* Original read channel flags. */
- int writeFlags; /* Original write channel flags. */
- int toRead; /* Number of bytes to copy, or -1. */
- int total; /* Total bytes transferred (written). */
- Tcl_Interp *interp; /* Interp that started the copy. */
- Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
- int bufSize; /* Size of appended buffer. */
- char buffer[1]; /* Copy buffer, this must be the last
- * field. */
-} CopyState;
-
-/*
* struct ChannelBuffer:
*
* Buffers data being sent to or from a channel.
*/
typedef struct ChannelBuffer {
+ int refCount; /* Current uses count */
int nextAdded; /* The next position into which a character
- * will be put in the buffer. */
- int nextRemoved; /* Position of next byte to be removed
- * from the buffer. */
+ * will be put in the buffer. */
+ int nextRemoved; /* Position of next byte to be removed from
+ * the buffer. */
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
- * bytes. This must be the last field in
- * the structure. */
+ 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
- * buffer (when converting to UTF-8) or to hold bytes that will go to
- * next buffer (when converting from UTF-8).
- */
-
-#define BUFFER_PADDING 16
-
-/*
- * The following defines the *default* buffer size for channels.
+ * buffer (when converting to UTF-8) or to hold bytes that will go to next
+ * buffer (when converting from UTF-8).
*/
-#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
+#define BUFFER_PADDING 16
/*
- * Structure to record a close callback. One such record exists for
- * each close callback registered for a channel.
+ * The following defines the *default* buffer size for channels.
*/
-typedef struct CloseCallback {
- Tcl_CloseProc *proc; /* The procedure to call. */
- ClientData clientData; /* Arbitrary one-word data to pass
- * to the callback. */
- struct CloseCallback *nextPtr; /* For chaining close callbacks. */
-} CloseCallback;
+#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
/*
* The following structure describes the information saved from a call to
- * "fileevent". This is used later when the event being waited for to
- * invoke the saved script in the interpreter designed in this record.
+ * "fileevent". This is used later when the event being waited for to invoke
+ * the saved script in the interpreter designed in this record.
*/
typedef struct EventScriptRecord {
struct Channel *chanPtr; /* The channel for which this script is
- * registered. This is used only when an
- * error occurs during evaluation of the
- * script, to delete the handler. */
+ * registered. This is used only when an error
+ * occurs during evaluation of the script, to
+ * delete the handler. */
Tcl_Obj *scriptPtr; /* Script to invoke. */
Tcl_Interp *interp; /* In what interpreter to invoke script? */
int mask; /* Events must overlap current mask for the
@@ -121,29 +88,28 @@ typedef struct EventScriptRecord {
/*
* struct Channel:
*
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
+ * One of these structures is allocated for each open channel. It contains
+ * data specific to the channel but which belongs to the generic part of the
+ * Tcl channel mechanism, and it points at an instance specific (and type
+ * specific) instance data, and at a channel type structure.
*/
typedef struct Channel {
struct ChannelState *state; /* Split out state information */
-
- ClientData instanceData; /* Instance-specific data provided by
- * creator of channel. */
- Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
-
+ ClientData instanceData; /* Instance-specific data provided by creator
+ * of channel. */
+ const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
struct Channel *downChanPtr;/* Refers to channel this one was stacked
- * upon. This reference is NULL for normal
- * channels. See Tcl_StackChannel. */
+ * upon. This reference is NULL for normal
+ * channels. See Tcl_StackChannel. */
struct Channel *upChanPtr; /* Refers to the channel above stacked this
* one. NULL for the top most channel. */
/*
- * Intermediate buffers to hold pre-read data for consumption by a
- * newly stacked transformation. See 'Tcl_StackChannel'.
+ * Intermediate buffers to hold pre-read data for consumption by a newly
+ * stacked transformation. See 'Tcl_StackChannel'.
*/
+
ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
} Channel;
@@ -151,55 +117,54 @@ typedef struct Channel {
/*
* struct ChannelState:
*
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
+ * One of these structures is allocated for each open channel. It contains
+ * data specific to the channel but which belongs to the generic part of the
+ * Tcl channel mechanism, and it points at an instance specific (and type
+ * specific) instance data, and at a channel type structure.
*/
typedef struct ChannelState {
- CONST char *channelName; /* The name of the channel instance in Tcl
- * commands. Storage is owned by the generic IO
- * code, is dynamically allocated. */
+ const char *channelName; /* The name of the channel instance in Tcl
+ * commands. Storage is owned by the generic
+ * IO code, is dynamically allocated. */
int flags; /* ORed combination of the flags defined
* below. */
Tcl_Encoding encoding; /* Encoding to apply when reading or writing
- * data on this channel. NULL means no
+ * data on this channel. NULL means no
* encoding is applied to data. */
Tcl_EncodingState inputEncodingState;
- /* Current encoding state, used when converting
- * input data bytes to UTF-8. */
+ /* Current encoding state, used when
+ * converting input data bytes to UTF-8. */
int inputEncodingFlags; /* Encoding flags to pass to conversion
* routine when converting input data bytes to
- * UTF-8. May be TCL_ENCODING_START before
+ * UTF-8. May be TCL_ENCODING_START before
* converting first byte and TCL_ENCODING_END
* when EOF is seen. */
Tcl_EncodingState outputEncodingState;
- /* Current encoding state, used when converting
- * UTF-8 to output data bytes. */
+ /* Current encoding state, used when
+ * converting UTF-8 to output data bytes. */
int outputEncodingFlags; /* Encoding flags to pass to conversion
* routine when converting UTF-8 to output
- * data bytes. May be TCL_ENCODING_START
+ * data bytes. May be TCL_ENCODING_START
* before converting first byte and
* TCL_ENCODING_END when EOF is seen. */
TclEolTranslation inputTranslation;
/* What translation to apply for end of line
- * sequences on input? */
+ * sequences on input? */
TclEolTranslation outputTranslation;
- /* What translation to use for generating
- * end of line sequences in output? */
- int inEofChar; /* If nonzero, use this as a signal of EOF
- * on input. */
- int outEofChar; /* If nonzero, append this to the channel
- * when it is closed if it is open for
- * writing. */
+ /* What translation to use for generating end
+ * of line sequences in output? */
+ int inEofChar; /* If nonzero, use this as a signal of EOF on
+ * input. */
+ int outEofChar; /* If nonzero, append this to the channel when
+ * it is closed if it is open for writing. */
int unreportedError; /* Non-zero if an error report was deferred
* because it happened in the background. The
* value is the POSIX error code. */
int refCount; /* How many interpreters hold references to
* this IO channel? */
-
- CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
+ struct CloseCallback *closeCbPtr;
+ /* Callbacks registered to be called when the
* channel is closed. */
char *outputStage; /* Temporary staging buffer used when
* translating EOL before converting from
@@ -207,50 +172,48 @@ typedef struct ChannelState {
ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
-
ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
* need to allocate a new buffer for "gets"
* that crosses buffer boundaries. */
ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
-
- struct ChannelHandler *chPtr;/* List of channel handlers registered
- * for this channel. */
+ struct ChannelHandler *chPtr;/* List of channel handlers registered for
+ * this channel. */
int interestMask; /* Mask of all events this channel has
* handlers for. */
EventScriptRecord *scriptRecordPtr;
- /* Chain of all scripts registered for
- * event handlers ("fileevent") on this
- * channel. */
-
+ /* Chain of all scripts registered for event
+ * handlers ("fileevent") on this channel. */
int bufSize; /* What size buffers to allocate? */
Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
- CopyState *csPtr; /* State of background copy, or NULL. */
- Channel *topChanPtr; /* Refers to topmost channel in a stack.
- * Never NULL. */
+ struct CopyState *csPtrR; /* State of background copy for which channel
+ * is input, or NULL. */
+ struct CopyState *csPtrW; /* State of background copy for which channel
+ * is output, or NULL. */
+ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never
+ * NULL. */
Channel *bottomChanPtr; /* Refers to bottommost channel in a stack.
* This channel can be relied on to live as
* long as the channel state. Never NULL. */
struct ChannelState *nextCSPtr;
/* Next in list of channels currently open. */
- Tcl_ThreadId managingThread; /* TIP #10: Id of the thread managing
- * this stack of channels. */
+ Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this
+ * stack of channels. */
- /* TIP #219 ... Info for the I/O system ...
- * Error message set by channel drivers, for the propagation of
- * arbitrary Tcl errors. This information, if present (chanMsg not
- * NULL), takes precedence over a posix error code returned by a
- * channel operation.
+ /*
+ * TIP #219 ... Info for the I/O system ...
+ * Error message set by channel drivers, for the propagation of arbitrary
+ * Tcl errors. This information, if present (chanMsg not NULL), takes
+ * precedence over a posix error code returned by a channel operation.
*/
Tcl_Obj* chanMsg;
- Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was
- * deferred because it happened in the
- * background. The value is the
- * chanMg, if any. #219's companion to
- * 'unreportedError'. */
+ Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred
+ * because it happened in the background. The
+ * value is the chanMg, if any. #219's
+ * companion to 'unreportedError'. */
} ChannelState;
-
+
/*
* Values for the flags field in Channel. Any ORed combination of the
* following flags can be stored in the field. These flags record various
@@ -258,174 +221,108 @@ typedef struct ChannelState {
* the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
*/
-#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
- * nonblocking mode. */
+#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in nonblocking
+ * mode. */
#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
* flushed after every newline. */
#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
* be flushed immediately. */
#define BUFFER_READY (1<<6) /* Current output buffer (the
- * curOutPtr field in the
- * channel structure) should be
- * output as soon as possible even
- * though it may not be full. */
-#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the
- * queued output buffers has been
- * scheduled. */
-#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
- * further Tcl-level IO on the
- * channel is allowed. */
-#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
- * This bit is cleared before every
- * input operation. */
-#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
- * we saw the input eofChar. This bit
- * prevents clearing of the EOF bit
- * before every input operation. */
-#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
- * on this channel. This bit is
- * cleared before every input or
- * output operation. */
+ * curOutPtr field in the channel
+ * structure) should be output as soon
+ * as possible even though it may not
+ * be full. */
+#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued
+ * output buffers has been
+ * scheduled. */
+#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No further
+ * Tcl-level IO on the channel is
+ * allowed. */
+#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel. This
+ * bit is cleared before every input
+ * operation. */
+#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel
+ * because we saw the input
+ * eofChar. This bit prevents clearing
+ * of the EOF bit before every input
+ * operation. */
+#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred on
+ * this channel. This bit is cleared
+ * before every input or output
+ * operation. */
#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
- * translation mode and the last
- * byte seen was a "\r". */
+ * translation mode and the last byte
+ * seen was a "\r". */
#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
* and there should be a '\n' at
* beginning of next buffer. */
-#define CHANNEL_DEAD (1<<13) /* The channel has been closed by
- * the exit handler (on exit) but
- * not deallocated. When any IO
- * operation sees this flag on a
- * channel, it does not call driver
- * level functions to avoid referring
- * to deallocated data. */
+#define CHANNEL_DEAD (1<<13) /* The channel has been closed by the
+ * exit handler (on exit) but not
+ * deallocated. When any IO operation
+ * sees this flag on a channel, it
+ * does not call driver level
+ * functions to avoid referring to
+ * deallocated data. */
#define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
* because there was not enough data
- * to complete the operation. This
- * flag is set when gets fails to
- * get a complete line or when read
- * fails to get a complete character.
- * When set, file events will not be
+ * to complete the operation. This
+ * flag is set when gets fails to get
+ * a complete line or when read fails
+ * to get a complete character. When
+ * set, file events will not be
* delivered for buffered data until
- * the state of the channel changes. */
+ * the state of the channel
+ * changes. */
#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
* being used. */
#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are
- * notified by is a fileevent
- * generated by a timer. We
- * don't know if the driver
- * has more data and should
- * not try to read from it. If
- * the system needs more than
- * is in the buffers out read
- * routines will simulate a
- * short read (0 characters
- * read) */
-#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a
- * channel if and only if the
- * channel is configured
- * non-blocking, the driver
+#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are notified
+ * by is a fileevent generated by a
+ * timer. We don't know if the driver
+ * has more data and should not try to
+ * read from it. If the system needs
+ * more than is in the buffers out
+ * read routines will simulate a short
+ * read (0 characters read) */
+#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a channel
+ * if and only if the channel is
+ * configured non-blocking, the driver
* for said channel has no
- * blockmodeproc, and data has
- * arrived for reading at the
- * OS level). A GetInput will
- * pass reading from the
+ * blockmodeproc, and data has arrived
+ * for reading at the OS level). A
+ * GetInput will pass reading from the
* driver if the channel is
- * non-blocking, without
- * blockmode proc and the flag
- * has not been set. A read
- * will be performed if the
- * flag is set. This will
- * reset the flag as well. */
+ * non-blocking, without blockmode
+ * proc and the flag has not been set.
+ * A read will be performed if the
+ * flag is set. This will reset the
+ * flag as well. */
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being
- * closed. Its structures are
- * still live and usable, but
- * it may not be closed again
- * from within the close handler.
- */
-
-/*
- * For each channel handler registered in a call to Tcl_CreateChannelHandler,
- * there is one record of the following type. All of records for a specific
- * channel are chained together in a singly linked list which is stored in
- * the channel structure.
- */
-
-typedef struct ChannelHandler {
- Channel *chanPtr; /* The channel structure for this channel. */
- int mask; /* Mask of desired events. */
- Tcl_ChannelProc *proc; /* Procedure to call in the type of
- * Tcl_CreateChannelHandler. */
- ClientData clientData; /* Argument to pass to procedure. */
- struct ChannelHandler *nextPtr;
- /* Next one in list of registered handlers. */
-} ChannelHandler;
-
-/*
- * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
- * problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
- * problem, structures of the type below indicate the next handler to be
- * processed for any (recursively nested) dispatches in progress. The
- * nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
- * deleted against the NEXT handler to be invoked in that invocation; when it
- * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
- * field of the structure to the next handler.
- */
-
-typedef struct NextChannelHandler {
- ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
- * this invocation. */
- struct NextChannelHandler *nestedHandlerPtr;
- /* Next nested invocation of
- * ChannelHandlerEventProc. */
-} NextChannelHandler;
-
+#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed.
+ * Its structures are still live and
+ * usable, but it may not be closed
+ * again from within the close
+ * handler. */
+#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed.
+ * Used by Channel Tcl_Obj type to
+ * determine if we have to revalidate
+ * the channel. */
+#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed.
+ * No further Tcl-level write IO on
+ * the channel is allowed. */
/*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
+ * The length of time to wait between synthetic timer events. Must be zero or
+ * bad things tend to happen.
*/
-typedef struct ChannelHandlerEvent {
- Tcl_Event header; /* Standard header for all events. */
- Channel *chanPtr; /* The channel that is ready. */
- int readyMask; /* Events that have occurred. */
-} ChannelHandlerEvent;
-
+#define SYNTHETIC_EVENT_TIME 0
+
/*
- * The following structure is used by Tcl_GetsObj() to encapsulates the
- * state for a "gets" operation.
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
*/
-
-typedef struct GetsState {
- Tcl_Obj *objPtr; /* The object to which UTF-8 characters
- * will be appended. */
- char **dstPtr; /* Pointer into objPtr's string rep where
- * next character should be stored. */
- Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
- * to UTF-8. */
- ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
- * emptied. */
- Tcl_EncodingState state; /* The encoding state just before the last
- * external to UTF-8 conversion in
- * FilterInputBytes(). */
- int rawRead; /* The number of bytes removed from bufPtr
- * in the last call to FilterInputBytes(). */
- int bytesWrote; /* The number of bytes of UTF-8 data
- * appended to objPtr during the last call to
- * FilterInputBytes(). */
- int charsWrote; /* The corresponding number of UTF-8
- * characters appended to objPtr during the
- * last call to FilterInputBytes(). */
- int totalChars; /* The total number of UTF-8 characters
- * appended to objPtr so far, just before the
- * last call to FilterInputBytes(). */
-} GetsState;
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 9a7d308..14910d7 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.31 2005/08/24 17:56:23 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -18,30 +16,79 @@
*/
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;
/*
+ * Thread local storage used to maintain a per-thread stdout channel obj.
+ * It must be per-thread because of std channel limitations.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized; /* Set to 1 when the module is initialized. */
+ Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
* Static functions for this file:
*/
-static void AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
- Tcl_Channel chan, char *address, int port));
-static void RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
- AcceptCallback *acceptCallbackPtr));
-static void TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
-static void UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
- Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
+static void FinalizeIOCmdTSD(ClientData clientData);
+static void AcceptCallbackProc(ClientData callbackData,
+ Tcl_Channel chan, char *address, int port);
+static int ChanPendingObjCmd(ClientData unused,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ChanTruncateObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
+ AcceptCallback *acceptCallbackPtr);
+static void TcpAcceptCallbacksDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static void TcpServerCloseProc(ClientData callbackData);
+static void UnregisterTcpServerInterpCleanupProc(
+ Tcl_Interp *interp,
+ AcceptCallback *acceptCallbackPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeIOCmdTSD --
+ *
+ * Release the storage associated with the per-thread cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeIOCmdTSD(
+ ClientData clientData) /* Not used. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->stdoutObjPtr != NULL) {
+ Tcl_DecrRefCount(tsdPtr->stdoutObjPtr);
+ tsdPtr->stdoutObjPtr = NULL;
+ }
+ tsdPtr->initialized = 0;
+}
/*
*----------------------------------------------------------------------
*
* Tcl_PutsObjCmd --
*
- * This procedure is invoked to process the "puts" Tcl command. See the
+ * This function is invoked to process the "puts" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -55,79 +102,86 @@ static void UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
/* ARGSUSED */
int
-Tcl_PutsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_PutsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
Tcl_Obj *string; /* String to write. */
+ Tcl_Obj *chanObjPtr = NULL; /* channel object. */
int newline; /* Add a newline at end? */
- char *channelId; /* Name of channel for puts. */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
+ ThreadSpecificData *tsdPtr;
switch (objc) {
- case 2: /* [puts $x] */
+ case 2: /* [puts $x] */
string = objv[1];
newline = 1;
- channelId = "stdout";
break;
- case 3: /* [puts -nonewline $x] or [puts $chan $x] */
- if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+ if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
- channelId = "stdout";
} else {
newline = 1;
- channelId = Tcl_GetString(objv[1]);
+ chanObjPtr = objv[1];
}
string = objv[2];
break;
- case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
- if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
- channelId = Tcl_GetString(objv[2]);
+ 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.
*/
- char *arg;
- int length;
-
- arg = Tcl_GetStringFromObj(objv[3], &length);
- if ((length != 9) || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", (char *) NULL);
- return TCL_ERROR;
- }
- channelId = Tcl_GetString(objv[1]);
+ 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;
}
- chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chanObjPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout");
+ Tcl_IncrRefCount(tsdPtr->stdoutObjPtr);
+ Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL);
+ }
+ chanObjPtr = tsdPtr->stdoutObjPtr;
+ }
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", channelId,
- "\" wasn't opened for writing", (char *) NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -138,18 +192,22 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
goto error;
}
}
+ Tcl_Release(chan);
return TCL_OK;
- error:
- /* TIP #219.
+ /*
+ * 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_AppendResult(interp, "error writing \"", channelId, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+
+ error:
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
@@ -158,7 +216,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
*
* Tcl_FlushObjCmd --
*
- * This procedure is called to process the Tcl "flush" command. See the
+ * This function is called to process the Tcl "flush" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -172,43 +230,49 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FlushObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FlushObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Obj *chanObjPtr;
Tcl_Channel chan; /* The channel to flush on. */
- char *channelId;
int mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- channelId = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ chanObjPtr = objv[1];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", channelId,
- "\" wasn't opened for writing", (char *) NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
- /* TIP #219.
+ /*
+ * 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_AppendResult(interp, "error flushing \"", channelId, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error flushing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -217,7 +281,7 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
*
* Tcl_GetsObjCmd --
*
- * This procedure is called to process the Tcl "gets" command. See the
+ * This function is called to process the Tcl "gets" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -231,66 +295,69 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_GetsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_GetsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
- char *name;
- Tcl_Obj *linePtr;
+ Tcl_Obj *linePtr, *chanObjPtr;
+ int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
return TCL_ERROR;
}
- name = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ chanObjPtr = objv[1];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", name,
- "\" wasn't opened for reading", (char *) NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
linePtr = Tcl_NewObj();
-
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
- /* TIP #219.
+ /*
+ * 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 \"", name, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ Tcl_Release(chan);
+ return code;
}
/*
@@ -298,7 +365,7 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
*
* Tcl_ReadObjCmd --
*
- * This procedure is invoked to process the Tcl "read" command. See the
+ * This function is invoked to process the Tcl "read" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -312,19 +379,18 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ReadObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ReadObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int newline, i; /* Discard newline at end? */
int toRead; /* How many bytes to read? */
int charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
- char *name;
- Tcl_Obj *resultPtr;
+ Tcl_Obj *resultPtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Interp *iPtr;
@@ -340,13 +406,12 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId");
- iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
return TCL_ERROR;
}
i = 1;
newline = 0;
- if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 1;
i++;
}
@@ -355,56 +420,67 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
goto argerror;
}
- name = Tcl_GetString(objv[i]);
- chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ chanObjPtr = objv[i];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", name,
- "\" wasn't opened for reading", (char *) 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) {
- 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 = Tcl_GetString(objv[i]);
- if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */
- if (Tcl_GetIntFromObj(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\"", (char *) NULL);
- return TCL_ERROR;
+#endif
}
}
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ Tcl_Preserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
- /* TIP #219.
+ /*
+ * 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 \"", name, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- Tcl_DecrRefCount(resultPtr);
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
+ Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -413,15 +489,16 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
*/
if ((charactersRead > 0) && (newline != 0)) {
- char *result;
+ const char *result;
int length;
- result = Tcl_GetStringFromObj(resultPtr, &length);
+ result = TclGetStringFromObj(resultPtr, &length);
if (result[length - 1] == '\n') {
Tcl_SetObjLength(resultPtr, length - 1);
}
}
Tcl_SetObjResult(interp, resultPtr);
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -431,7 +508,7 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
*
* Tcl_SeekObjCmd --
*
- * This procedure is invoked to process the Tcl "seek" command. See the
+ * This function is invoked to process the Tcl "seek" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -446,30 +523,27 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_SeekObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SeekObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to tell on. */
- Tcl_WideInt offset; /* Where to seek? */
- int mode; /* How to seek? */
- Tcl_WideInt result; /* Of calling Tcl_Seek. */
- char *chanName;
+ Tcl_Channel chan; /* The channel to tell on. */
+ Tcl_WideInt offset; /* Where to seek? */
+ int mode; /* How to seek? */
+ Tcl_WideInt result; /* Of calling Tcl_Seek. */
int optionIndex;
- static CONST char *originOptions[] = {
- "start", "current", "end", (char *) NULL
+ 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?");
return TCL_ERROR;
}
- chanName = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
@@ -484,20 +558,25 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
mode = modeArray[optionIndex];
}
+ Tcl_Preserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
- /* TIP #219.
+ /*
+ * 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_AppendResult(interp, "error during seek on \"",
- chanName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during seek on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -506,7 +585,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
*
* Tcl_TellObjCmd --
*
- * This procedure is invoked to process the Tcl "tell" command. See the
+ * This function is invoked to process the Tcl "tell" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -520,15 +599,15 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_TellObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_TellObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to tell on. */
- char *chanName;
+ Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
+ int code;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -540,19 +619,23 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
* channel table of this interpreter.
*/
- chanName = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
newLoc = Tcl_Tell(chan);
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass (interp, chan)) {
+
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ Tcl_Release(chan);
+ if (code) {
return TCL_ERROR;
}
@@ -565,7 +648,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
*
* Tcl_CloseObjCmd --
*
- * This procedure is invoked to process the Tcl "close" command. See the
+ * This function is invoked to process the Tcl "close" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -579,26 +662,66 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_CloseObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_CloseObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to close. */
- char *arg;
+ 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) {
- Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
return TCL_ERROR;
}
- arg = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
+ if (objc == 3) {
+ int index, dir;
+
+ /*
+ * Get direction requested to close, and check syntax.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dir = dirArray[index];
+
+ /*
+ * Check direction against channel mode. It is an error if we try to
+ * close a direction not supported by the channel (already closed, or
+ * never opened for that direction).
+ */
+
+ if (!(dir & Tcl_GetChannelMode(chan))) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened"
+ " or already closed", dirOptions[index]));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Special handling is needed if and only if the channel mode supports
+ * more than the direction to close. Because if the close the last
+ * direction suppported we can and will go through the regular
+ * process.
+ */
+
+ if ((Tcl_GetChannelMode(chan) &
+ (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) {
+ return Tcl_CloseEx(interp, chan, dir);
+ }
+ }
+
if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
/*
* If there is an error message and it ends with a newline, remove the
@@ -611,16 +734,15 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
* a terminating newline.
*/
- Tcl_Obj *resultPtr;
- char *string;
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ const char *string;
int len;
- resultPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
Tcl_SetObjResult(interp, resultPtr);
}
- string = Tcl_GetStringFromObj(resultPtr, &len);
+ string = TclGetStringFromObj(resultPtr, &len);
if ((len > 0) && (string[len - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, len - 1);
}
@@ -635,8 +757,8 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
*
* Tcl_FconfigureObjCmd --
*
- * This procedure is invoked to process the Tcl "fconfigure" command.
- * See the user documentation for details on what it does.
+ * This function is invoked to process the Tcl "fconfigure" command. See
+ * the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -649,41 +771,42 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FconfigureObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *chanName, *optionName, *valueName;
- Tcl_Channel chan; /* The channel to set a mode on. */
- int i; /* Iterate over arg-value pairs. */
- Tcl_DString ds; /* DString to hold result of calling
- * Tcl_GetChannelOption. */
+ const char *optionName, *valueName;
+ Tcl_Channel chan; /* The channel to set a mode on. */
+ int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "channelId ?optionName? ?value? ?optionName value?...");
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
return TCL_ERROR;
}
- chanName = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 2) {
+ Tcl_DString ds; /* DString to hold result of calling
+ * Tcl_GetChannelOption. */
+
Tcl_DStringInit(&ds);
- if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
+ if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
} else if (objc == 3) {
+ Tcl_DString ds; /* DString to hold result of calling
+ * Tcl_GetChannelOption. */
+
Tcl_DStringInit(&ds);
- optionName = Tcl_GetString(objv[2]);
+ optionName = TclGetString(objv[2]);
if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
@@ -693,8 +816,8 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
}
for (i = 3; i < objc; i += 2) {
- optionName = Tcl_GetString(objv[i-1]);
- valueName = Tcl_GetString(objv[i]);
+ optionName = TclGetString(objv[i-1]);
+ valueName = TclGetString(objv[i]);
if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
!= TCL_OK) {
return TCL_ERROR;
@@ -709,7 +832,7 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
*
* Tcl_EofObjCmd --
*
- * This procedure is invoked to process the Tcl "eof" command. See the
+ * This function is invoked to process the Tcl "eof" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -724,24 +847,20 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_EofObjCmd(unused, interp, objc, objv)
- ClientData unused; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_EofObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
- int dummy;
- char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, &dummy);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -754,7 +873,7 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
*
* Tcl_ExecObjCmd --
*
- * This procedure is invoked to process the "exec" Tcl command. See the
+ * This function is invoked to process the "exec" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -768,39 +887,34 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ExecObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ExecObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- /*
- * This procedure generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
-#define NUM_ARGS 20
Tcl_Obj *resultPtr;
- CONST char **argv;
- char *string;
+ const char **argv; /* An array for the string arguments. Stored
+ * on the _Tcl_ stack. */
+ const char *string;
Tcl_Channel chan;
- CONST char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
- static CONST char *options[] = {
- "-keepnewline", "--", NULL
+ int ignoreStderr;
+ static const char *const options[] = {
+ "-ignorestderr", "-keepnewline", "--", NULL
};
enum options {
- EXEC_KEEPNEWLINE, EXEC_LAST
+ EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
};
/*
- * Check for a leading "-keepnewline" argument.
+ * Check for any leading option arguments.
*/
keepNewline = 0;
+ ignoreStderr = 0;
for (skip = 1; skip < objc; skip++) {
- string = Tcl_GetString(objv[skip]);
+ string = TclGetString(objv[skip]);
if (string[0] != '-') {
break;
}
@@ -810,13 +924,15 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
}
if (index == EXEC_KEEPNEWLINE) {
keepNewline = 1;
+ } else if (index == EXEC_IGNORESTDERR) {
+ ignoreStderr = 1;
} else {
skip++;
break;
}
}
if (objc <= skip) {
- Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?");
return TCL_ERROR;
}
@@ -825,7 +941,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*/
background = 0;
- string = Tcl_GetString(objv[objc - 1]);
+ string = TclGetString(objv[objc - 1]);
if ((string[0] == '&') && (string[1] == '\0')) {
objc--;
background = 1;
@@ -836,11 +952,8 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
* to hold the argc arguments plus 1 extra for the zero end-of-argv word.
*/
- argv = argStorage;
argc = objc - skip;
- if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
- argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
- }
+ argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
/*
* Copy the string conversions of each (post option) object into the
@@ -848,21 +961,19 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*/
for (i = 0; i < argc; i++) {
- argv[i] = Tcl_GetString(objv[i + skip]);
+ argv[i] = TclGetString(objv[i + skip]);
}
argv[argc] = NULL;
- chan = Tcl_OpenCommandChannel(interp, argc, argv,
- (background ? 0 : TCL_STDOUT | TCL_STDERR));
+ chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
+ ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
/*
- * Free the argv array if malloc'ed storage was used.
+ * Free the argv array.
*/
- if (argv != argStorage) {
- ckfree((char *)argv);
- }
+ TclStackFree(interp, (void *) argv);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
@@ -882,15 +993,17 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
- /* TIP #219.
+ /*
+ * 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 output from command: ",
- Tcl_PosixError(interp), (char *) NULL);
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading output from command: %s",
+ Tcl_PosixError(interp)));
Tcl_DecrRefCount(resultPtr);
}
return TCL_ERROR;
@@ -899,7 +1012,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
/*
* If the process produced anything on stderr, it will have been returned
- * in the interpreter result. It needs to be appended to the result
+ * in the interpreter result. It needs to be appended to the result
* string.
*/
@@ -912,7 +1025,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*/
if (keepNewline == 0) {
- string = Tcl_GetStringFromObj(resultPtr, &length);
+ string = TclGetStringFromObj(resultPtr, &length);
if ((length > 0) && (string[length - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, length - 1);
}
@@ -927,7 +1040,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*
* Tcl_FblockedObjCmd --
*
- * This procedure is invoked to process the Tcl "fblocked" command. See
+ * This function is invoked to process the Tcl "fblocked" command. See
* the user documentation for details on what it does.
*
* Results:
@@ -942,29 +1055,27 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FblockedObjCmd(unused, interp, objc, objv)
- ClientData unused; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FblockedObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
int mode;
- char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = Tcl_GetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, &mode);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for reading", (char *) NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
@@ -977,7 +1088,7 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
*
* Tcl_OpenObjCmd --
*
- * This procedure is invoked to process the "open" Tcl command. See the
+ * This function is invoked to process the "open" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -991,14 +1102,14 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_OpenObjCmd(notUsed, interp, objc, objv)
- ClientData notUsed; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_OpenObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int pipeline, prot;
- char *modeString, *what;
+ const char *modeString, *what;
Tcl_Channel chan;
if ((objc < 2) || (objc > 4)) {
@@ -1009,16 +1120,36 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
if (objc == 2) {
modeString = "r";
} else {
- modeString = Tcl_GetString(objv[2]);
+ modeString = TclGetString(objv[2]);
if (objc == 4) {
- if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
+ const char *permString = TclGetString(objv[3]);
+ int code = TCL_ERROR;
+ int scanned = TclParseAllWhiteSpace(permString, -1);
+
+ /*
+ * Support legacy octal numbers.
+ */
+
+ if ((permString[scanned] == '0')
+ && (permString[scanned+1] >= '0')
+ && (permString[scanned+1] <= '7')) {
+ Tcl_Obj *permObj;
+
+ TclNewLiteralStringObj(permObj, "0o");
+ Tcl_AppendToObj(permObj, permString+scanned+1, -1);
+ code = TclGetIntFromObj(NULL, permObj, &prot);
+ Tcl_DecrRefCount(permObj);
+ }
+
+ if ((code == TCL_ERROR)
+ && TclGetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
}
pipeline = 0;
- what = Tcl_GetString(objv[1]);
+ what = TclGetString(objv[1]);
if (what[0] == '|') {
pipeline = 1;
}
@@ -1031,7 +1162,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
int mode, seekFlag, cmdObjc, binary;
- CONST char **cmdArgv;
+ const char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
@@ -1058,17 +1189,17 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
break;
}
chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
- if (binary) {
+ if (binary && chan) {
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
}
}
- ckfree((char *) cmdArgv);
+ ckfree(cmdArgv);
}
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1095,25 +1226,23 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
/* ARGSUSED */
static void
-TcpAcceptCallbacksDeleteProc(clientData, interp)
- ClientData clientData; /* Data which was passed when the assocdata
+TcpAcceptCallbacksDeleteProc(
+ ClientData clientData, /* Data which was passed when the assocdata
* was registered. */
- Tcl_Interp *interp; /* Interpreter being deleted - not used. */
+ Tcl_Interp *interp) /* Interpreter being deleted - not used. */
{
- Tcl_HashTable *hTblPtr;
+ Tcl_HashTable *hTblPtr = clientData;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
- AcceptCallback *acceptCallbackPtr;
- hTblPtr = (Tcl_HashTable *) clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
- acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
+
+ acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
+ ckfree(hTblPtr);
}
/*
@@ -1136,10 +1265,10 @@ TcpAcceptCallbacksDeleteProc(clientData, interp)
*/
static void
-RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
- Tcl_Interp *interp; /* Interpreter for which we want to be
+RegisterTcpServerInterpCleanup(
+ Tcl_Interp *interp, /* Interpreter for which we want to be
* informed of deletion. */
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr)
/* The accept callback record whose interp
* field we want set to NULL when the
* interpreter is deleted. */
@@ -1148,21 +1277,22 @@ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
* smash when the interpreter will be
* deleted. */
Tcl_HashEntry *hPtr; /* Entry for this record. */
- int new; /* Is the entry new? */
+ int isNew; /* Is the entry new? */
+
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+ if (hTblPtr == NULL) {
+ hTblPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
- (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
- TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
+ Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+ TcpAcceptCallbacksDeleteProc, hTblPtr);
}
- hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
- if (!new) {
+
+ hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
+ if (!isNew) {
Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
}
- Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
+ Tcl_SetHashValue(hPtr, acceptCallbackPtr);
}
/*
@@ -1185,26 +1315,25 @@ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
*/
static void
-UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
- Tcl_Interp *interp; /* Interpreter in which the accept callback
+UnregisterTcpServerInterpCleanupProc(
+ Tcl_Interp *interp, /* Interpreter in which the accept callback
* record was registered. */
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr)
/* The record for which to delete the
* registration. */
{
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+ if (hTblPtr == NULL) {
return;
}
+
hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return;
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
}
- Tcl_DeleteHashEntry(hPtr);
}
/*
@@ -1225,23 +1354,16 @@ UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
*/
static void
-AcceptCallbackProc(callbackData, chan, address, port)
- ClientData callbackData; /* The data stored when the callback
- * was created in the call to
- * Tcl_OpenTcpServer. */
- Tcl_Channel chan; /* Channel for the newly accepted
- * connection. */
- char *address; /* Address of client that was
- * accepted. */
- int port; /* Port of client that was accepted. */
+AcceptCallbackProc(
+ ClientData callbackData, /* The data stored when the callback was
+ * created in the call to
+ * Tcl_OpenTcpServer. */
+ Tcl_Channel chan, /* Channel for the newly accepted
+ * connection. */
+ char *address, /* Address of client that was accepted. */
+ int port) /* Port of client that was accepted. */
{
- AcceptCallback *acceptCallbackPtr;
- Tcl_Interp *interp;
- char *script;
- char portBuf[TCL_INTEGER_SPACE];
- int result;
-
- acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
@@ -1249,13 +1371,14 @@ AcceptCallbackProc(callbackData, chan, address, port)
* data to NULL.
*/
- if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+ if (acceptCallbackPtr->interp != NULL) {
+ char portBuf[TCL_INTEGER_SPACE];
+ char *script = acceptCallbackPtr->script;
+ Tcl_Interp *interp = acceptCallbackPtr->interp;
+ int result;
- script = acceptCallbackPtr->script;
- interp = acceptCallbackPtr->interp;
-
- Tcl_Preserve((ClientData) script);
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(script);
+ Tcl_Preserve(interp);
TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
@@ -1265,12 +1388,12 @@ AcceptCallbackProc(callbackData, chan, address, port)
* deleted while the script is being evaluated.
*/
- Tcl_RegisterChannel((Tcl_Interp *) NULL, chan);
+ Tcl_RegisterChannel(NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
- " ", address, " ", portBuf, (char *) NULL);
+ " ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
}
@@ -1279,18 +1402,17 @@ AcceptCallbackProc(callbackData, chan, address, port)
* safe anymore to use "chan", because it may now be deleted.
*/
- Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
+ Tcl_UnregisterChannel(NULL, chan);
- Tcl_Release((ClientData) interp);
- Tcl_Release((ClientData) script);
+ Tcl_Release(interp);
+ 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((Tcl_Interp *) NULL, chan);
+ Tcl_Close(NULL, chan);
}
}
@@ -1316,20 +1438,19 @@ AcceptCallbackProc(callbackData, chan, address, port)
*/
static void
-TcpServerCloseProc(callbackData)
- ClientData callbackData; /* The data passed in the call to
+TcpServerCloseProc(
+ ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/* The actual data. */
- acceptCallbackPtr = (AcceptCallback *) callbackData;
- if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+ if (acceptCallbackPtr->interp != NULL) {
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
- Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
- ckfree((char *) acceptCallbackPtr);
+ Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
+ ckfree(acceptCallbackPtr);
}
/*
@@ -1337,8 +1458,8 @@ TcpServerCloseProc(callbackData)
*
* Tcl_SocketObjCmd --
*
- * This procedure is invoked to process the "socket" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "socket" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1350,48 +1471,41 @@ TcpServerCloseProc(callbackData)
*/
int
-Tcl_SocketObjCmd(notUsed, interp, objc, objv)
- ClientData notUsed; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SocketObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- static CONST char *socketOptions[] = {
- "-async", "-myaddr", "-myport","-server", (char *) NULL
+ static const char *const socketOptions[] = {
+ "-async", "-myaddr", "-myport", "-server", NULL
};
enum socketOptions {
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
- int optionIndex, a, server, port;
- char *arg, *copyScript, *host, *script;
- char *myaddr = NULL;
- int myport = 0;
- int async = 0;
+ int optionIndex, a, server = 0, port, myport = 0, async = 0;
+ const char *host, *script = NULL, *myaddr = NULL;
Tcl_Channel chan;
- AcceptCallback *acceptCallbackPtr;
-
- server = 0;
- script = NULL;
if (TclpHasSockets(interp) != TCL_OK) {
return TCL_ERROR;
}
for (a = 1; a < objc; a++) {
- arg = Tcl_GetString(objv[a]);
+ const char *arg = Tcl_GetString(objv[a]);
+
if (arg[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
- "option", TCL_EXACT, &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option",
+ TCL_EXACT, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum socketOptions) optionIndex) {
case SKT_ASYNC:
if (server == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot set -async option for server sockets", -1));
return TCL_ERROR;
}
async = 1;
@@ -1399,22 +1513,22 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
case SKT_MYADDR:
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myaddr option", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myaddr option", -1));
return TCL_ERROR;
}
- myaddr = Tcl_GetString(objv[a]);
+ myaddr = TclGetString(objv[a]);
break;
case SKT_MYPORT: {
- char *myPortName;
+ const char *myPortName;
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myport option", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myport option", -1));
return TCL_ERROR;
}
- myPortName = Tcl_GetString(objv[a]);
+ myPortName = TclGetString(objv[a]);
if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
return TCL_ERROR;
}
@@ -1422,19 +1536,18 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
}
case SKT_SERVER:
if (async == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets",
- (char *) 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", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -server option", -1));
return TCL_ERROR;
}
- script = Tcl_GetString(objv[a]);
+ script = TclGetString(objv[a]);
break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1443,12 +1556,12 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
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) {
- host = Tcl_GetString(objv[a]);
+ host = TclGetString(objv[a]);
a++;
} else {
Interp *iPtr;
@@ -1460,12 +1573,11 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv,
"-server command ?-myaddr addr? port");
- iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
return TCL_ERROR;
}
if (a == objc-1) {
- if (TclSockGetPort(interp, Tcl_GetString(objv[a]), "tcp",
+ if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
&port) != TCL_OK) {
return TCL_ERROR;
}
@@ -1474,17 +1586,19 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
}
if (server) {
- acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
- sizeof(AcceptCallback));
- copyScript = ckalloc((unsigned) strlen(script) + 1);
- strcpy(copyScript, script);
+ AcceptCallback *acceptCallbackPtr =
+ ckalloc(sizeof(AcceptCallback));
+ unsigned len = strlen(script) + 1;
+ char *copyScript = ckalloc(len);
+
+ memcpy(copyScript, script, len);
acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
- (ClientData) acceptCallbackPtr);
- if (chan == (Tcl_Channel) NULL) {
+ acceptCallbackPtr);
+ if (chan == NULL) {
ckfree(copyScript);
- ckfree((char *) acceptCallbackPtr);
+ ckfree(acceptCallbackPtr);
return TCL_ERROR;
}
@@ -1503,17 +1617,16 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
* be informed when the interpreter is deleted.
*/
- Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
- (ClientData) acceptCallbackPtr);
+ Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
}
- Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+ Tcl_RegisterChannel(interp, chan);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1522,7 +1635,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
*
* Tcl_FcopyObjCmd --
*
- * This procedure is invoked to process the "fcopy" Tcl command. See the
+ * This function is invoked to process the "fcopy" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1536,18 +1649,17 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
*/
int
-Tcl_FcopyObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FcopyObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel inChan, outChan;
- char *arg;
- int mode, i;
- int toRead, index;
+ int mode, i, index;
+ Tcl_WideInt toRead;
Tcl_Obj *cmdPtr;
- static CONST char* switches[] = { "-size", "-command", NULL };
+ static const char *const switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
@@ -1561,24 +1673,22 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
* writable, as appropriate.
*/
- arg = Tcl_GetString(objv[1]);
- inChan = Tcl_GetChannel(interp, arg, &mode);
- if (inChan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for reading", (char *) NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
- arg = Tcl_GetString(objv[2]);
- outChan = Tcl_GetChannel(interp, arg, &mode);
- if (outChan == (Tcl_Channel) NULL) {
+ if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for writing", (char *) NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(objv[2])));
return TCL_ERROR;
}
@@ -1586,14 +1696,24 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
cmdPtr = NULL;
for (i = 3; i < objc; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
- (int *) &index) != TCL_OK) {
+ &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case FcopySize:
- if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
return TCL_ERROR;
}
+ if (toRead < 0) {
+ /*
+ * Handle all negative sizes like -1, meaning 'copy all'. By
+ * resetting toRead we avoid changes in the core copying
+ * functions (which explicitly check for -1 and crash on any
+ * other negative value).
+ */
+
+ toRead = -1;
+ }
break;
case FcopyCommand:
cmdPtr = objv[i+1];
@@ -1605,11 +1725,76 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanPendingObjCmd --
+ *
+ * This function is invoked to process the Tcl "chan pending" command
+ * (TIP #287). See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Sets interp's result to the number of bytes of buffered input or
+ * output (depending on whether the first argument is "input" or
+ * "output"), or -1 if the channel wasn't opened for that mode.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ChanPendingObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Channel chan;
+ int index, mode;
+ static const char *const options[] = {"input", "output", NULL};
+ enum options {PENDING_INPUT, PENDING_OUTPUT};
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PENDING_INPUT:
+ 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)) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
+ }
+ break;
+ }
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
- * Tcl_ChanTruncateObjCmd --
+ * ChanTruncateObjCmd --
*
- * This procedure is invoked to process the "chan truncate" Tcl command.
+ * This function is invoked to process the "chan truncate" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
@@ -1621,25 +1806,21 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-int
-TclChanTruncateObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+ChanTruncateObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
- int mode;
Tcl_WideInt length;
- char *chanName;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?");
return TCL_ERROR;
}
- chanName = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, &mode);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -1652,8 +1833,8 @@ TclChanTruncateObjCmd(dummy, interp, objc, objv)
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 {
@@ -1663,16 +1844,17 @@ TclChanTruncateObjCmd(dummy, interp, objc, objv)
length = Tcl_Tell(chan);
if (length == Tcl_WideAsLong(-1)) {
- Tcl_AppendResult(interp,
- "could not determine current location in \"", chanName,
- "\": ", 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 \"", chanName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during truncate on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1680,10 +1862,165 @@ TclChanTruncateObjCmd(dummy, interp, objc, objv)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * ChanPipeObjCmd --
+ *
+ * This function is invoked to process the "chan pipe" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Creates a pair of Tcl channels wrapping both ends of a new
+ * anonymous pipe.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ChanPipeObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Channel rchan, wchan;
+ const char *channelNames[2];
+ Tcl_Obj *resultPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_CreatePipe(interp, &rchan, &wchan, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ channelNames[0] = Tcl_GetChannelName(rchan);
+ channelNames[1] = Tcl_GetChannelName(wchan);
+
+ resultPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(channelNames[0], -1));
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(channelNames[1], -1));
+ Tcl_SetObjResult(interp, resultPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A Tcl command handle.
+ *
+ * Side effects:
+ * None (since nothing is byte-compiled).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitChanCmd(
+ Tcl_Interp *interp)
+{
+ /*
+ * Most commands are plugged directly together, but some are done via
+ * alias-like rewriting; [chan configure] is this way for security reasons
+ * (want overwriting of [fconfigure] to control that nicely), and [chan
+ * names] because the functionality isn't available as a separate command
+ * function at the moment.
+ */
+ static const EnsembleImplMap initMap[] = {
+ {"blocked", Tcl_FblockedObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"close", Tcl_CloseObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
+ {"create", TclChanCreateObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"event", Tcl_FileEventObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+ {"flush", Tcl_FlushObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"gets", Tcl_GetsObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"names", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"pending", ChanPendingObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #287 */
+ {"pipe", ChanPipeObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, /* TIP #304 */
+ {"pop", TclChanPopObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, /* TIP #230 */
+ {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */
+ {"push", TclChanPushObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #230 */
+ {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
+ {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
+ {"seek", Tcl_SeekObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+ {"tell", Tcl_TellObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+ static const char *const extras[] = {
+ "configure", "::fconfigure",
+ NULL
+ };
+ Tcl_Command ensemble;
+ Tcl_Obj *mapObj;
+ int i;
+
+ ensemble = TclMakeEnsemble(interp, "chan", initMap);
+ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
+ for (i=0 ; extras[i] ; i+=2) {
+ /*
+ * Can assume that reference counts are all incremented.
+ */
+
+ Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1),
+ Tcl_NewStringObj(extras[i+1], -1));
+ }
+ Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
+ return ensemble;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
-
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 48419da..29996ea 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -1,93 +1,83 @@
/*
* tclIOGT.c --
*
- * Implements a generic transformation exposing the underlying API
- * at the script level. Contributed by Andreas Kupries.
+ * Implements a generic transformation exposing the underlying API at the
+ * script level. Contributed by Andreas Kupries.
*
* Copyright (c) 2000 Ajuba Solutions
* Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
*
- * 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.13 2005/07/17 21:17:41 dkf 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"
#include "tclIO.h"
/*
- * Forward declarations of internal procedures. First the driver procedures
- * of the transformation.
+ * Forward declarations of internal procedures. First the driver procedures of
+ * the transformation.
*/
-static int TransformBlockModeProc _ANSI_ARGS_((
- ClientData instanceData, int mode));
-static int TransformCloseProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp* interp));
-static int TransformInputProc _ANSI_ARGS_((
- ClientData instanceData, char *buf, int toRead,
- int *errorCodePtr));
-static int TransformOutputProc _ANSI_ARGS_((
- ClientData instanceData, CONST char *buf,
- int toWrite, int *errorCodePtr));
-static int TransformSeekProc _ANSI_ARGS_((
- ClientData instanceData, long offset, int mode,
- int *errorCodePtr));
-static int TransformSetOptionProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST char *optionName, CONST char *value));
-static int TransformGetOptionProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST char *optionName, Tcl_DString *dsPtr));
-static void TransformWatchProc _ANSI_ARGS_((
- ClientData instanceData, int mask));
-static int TransformGetFileHandleProc _ANSI_ARGS_((
- ClientData instanceData, int direction,
- ClientData *handlePtr));
-static int TransformNotifyProc _ANSI_ARGS_((
- ClientData instanceData, int mask));
-static Tcl_WideInt TransformWideSeekProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_WideInt offset,
- int mode, int *errorCodePtr));
+static int TransformBlockModeProc(ClientData instanceData,
+ int mode);
+static int TransformCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int TransformInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCodePtr);
+static int TransformOutputProc(ClientData instanceData,
+ const char *buf, int toWrite, int *errorCodePtr);
+static int TransformSeekProc(ClientData instanceData, long offset,
+ int mode, int *errorCodePtr);
+static int TransformSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
+static int TransformGetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static void TransformWatchProc(ClientData instanceData, int mask);
+static int TransformGetFileHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static int TransformNotifyProc(ClientData instanceData, int mask);
+static Tcl_WideInt TransformWideSeekProc(ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
- * Forward declarations of internal procedures. Secondly the procedures for
+ * Forward declarations of internal procedures. Secondly the procedures for
* handling and generating fileeevents.
*/
-static void TransformChannelHandlerTimer _ANSI_ARGS_((
- ClientData clientData));
+static void TransformChannelHandlerTimer(ClientData clientData);
/*
- * Forward declarations of internal procedures. Third, helper procedures
+ * Forward declarations of internal procedures. Third, helper procedures
* encapsulating essential tasks.
*/
typedef struct TransformChannelData TransformChannelData;
-static int ExecuteCallback _ANSI_ARGS_((
- TransformChannelData *ctrl, Tcl_Interp *interp,
- unsigned char *op, unsigned char *buf, int bufLen,
- int transmit, int preserve));
+static int ExecuteCallback(TransformChannelData *ctrl,
+ Tcl_Interp *interp, unsigned char *op,
+ unsigned char *buf, int bufLen, int transmit,
+ int preserve);
/*
- * Action codes to give to 'ExecuteCallback' (argument 'transmit') confering
- * to the procedure what to do with the result of the script it calls.
+ * Action codes to give to 'ExecuteCallback' (argument 'transmit'), telling
+ * the procedure what to do with the result of the script it calls.
*/
-#define TRANSMIT_DONT (0) /* No transfer to do */
-#define TRANSMIT_DOWN (1) /* Transfer to the underlying channel */
-#define TRANSMIT_SELF (2) /* Transfer into our channel. */
-#define TRANSMIT_IBUF (3) /* Transfer to internal input buffer */
-#define TRANSMIT_NUM (4) /* Transfer number to 'maxRead' */
+#define TRANSMIT_DONT 0 /* No transfer to do. */
+#define TRANSMIT_DOWN 1 /* Transfer to the underlying channel. */
+#define TRANSMIT_SELF 2 /* Transfer into our channel. */
+#define TRANSMIT_IBUF 3 /* Transfer to internal input buffer. */
+#define TRANSMIT_NUM 4 /* Transfer number to 'maxRead'. */
/*
- * Codes for 'preserve' of 'ExecuteCallback'
+ * Codes for 'preserve' of 'ExecuteCallback'.
*/
-#define P_PRESERVE (1)
-#define P_NO_PRESERVE (0)
+#define P_PRESERVE 1
+#define P_NO_PRESERVE 0
/*
* Strings for the action codes delivered to the script implementing a
@@ -113,74 +103,75 @@ static int ExecuteCallback _ANSI_ARGS_((
typedef struct ResultBuffer ResultBuffer;
-static void ResultClear _ANSI_ARGS_((ResultBuffer *r));
-static void ResultInit _ANSI_ARGS_((ResultBuffer *r));
-static int ResultLength _ANSI_ARGS_((ResultBuffer *r));
-static int ResultCopy _ANSI_ARGS_((ResultBuffer *r,
- unsigned char *buf, int toRead));
-static void ResultAdd _ANSI_ARGS_((ResultBuffer *r,
- unsigned char *buf, int toWrite));
+static inline void ResultClear(ResultBuffer *r);
+static inline void ResultInit(ResultBuffer *r);
+static inline int ResultEmpty(ResultBuffer *r);
+static inline int ResultCopy(ResultBuffer *r, unsigned char *buf,
+ size_t toRead);
+static inline void ResultAdd(ResultBuffer *r, unsigned char *buf,
+ size_t toWrite);
/*
- * This structure describes the channel type structure for Tcl based
+ * This structure describes the channel type structure for Tcl-based
* transformations.
*/
-static Tcl_ChannelType transformChannelType = {
- "transform", /* Type name. */
- TCL_CHANNEL_VERSION_3,
- TransformCloseProc, /* Close proc. */
- TransformInputProc, /* Input proc. */
- TransformOutputProc, /* Output proc. */
- TransformSeekProc, /* Seek proc. */
- TransformSetOptionProc, /* Set option proc. */
- TransformGetOptionProc, /* Get option proc. */
- TransformWatchProc, /* Initialize notifier. */
- TransformGetFileHandleProc, /* Get OS handles out of channel. */
- NULL, /* close2proc */
- TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
- NULL, /* Flush proc. */
- TransformNotifyProc, /* Handling of events bubbling up */
- TransformWideSeekProc, /* Wide seek proc */
+static const Tcl_ChannelType transformChannelType = {
+ "transform", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ TransformCloseProc, /* Close proc. */
+ TransformInputProc, /* Input proc. */
+ TransformOutputProc, /* Output proc. */
+ TransformSeekProc, /* Seek proc. */
+ TransformSetOptionProc, /* Set option proc. */
+ TransformGetOptionProc, /* Get option proc. */
+ TransformWatchProc, /* Initialize notifier. */
+ TransformGetFileHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc */
+ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
+ NULL, /* Flush proc. */
+ TransformNotifyProc, /* Handling of events bubbling up. */
+ TransformWideSeekProc, /* Wide seek proc. */
+ NULL, /* Thread action. */
+ NULL /* Truncate. */
};
/*
* Possible values for 'flags' field in control structure, see below.
*/
-#define CHANNEL_ASYNC (1<<0) /* non-blocking mode */
+#define CHANNEL_ASYNC (1<<0) /* Non-blocking mode. */
/*
- * Definition of the structure containing the information about the
- * internal input buffer.
+ * Definition of the structure containing the information about the internal
+ * input buffer.
*/
struct ResultBuffer {
unsigned char *buf; /* Reference to the buffer area. */
- int allocated; /* Allocated size of the buffer area. */
- int used; /* Number of bytes in the buffer, <=
- * allocated. */
+ size_t allocated; /* Allocated size of the buffer area. */
+ size_t used; /* Number of bytes in the buffer, no more than
+ * number allocated. */
};
/*
- * Additional bytes to allocate during buffer expansion
+ * Additional bytes to allocate during buffer expansion.
*/
-#define INCREMENT (512)
+#define INCREMENT 512
/*
* Number of milliseconds to wait before firing an event to flush out
* information waiting in buffers (fileevent support).
*/
-#define FLUSH_DELAY (5)
+#define FLUSH_DELAY 5
/*
* Convenience macro to make some casts easier to use.
*/
#define UCHARP(x) ((unsigned char *) (x))
-#define NO_INTERP ((Tcl_Interp *) NULL)
/*
* Definition of a structure used by all transformations generated here to
@@ -209,24 +200,44 @@ struct TransformChannelData {
*/
int maxRead; /* Maximum allowed number of bytes to read, as
- * given to us by the tcl script implementing
+ * given to us by the Tcl script implementing
* the transformation. */
Tcl_Interp *interp; /* Reference to the interpreter which created
* the transformation. Used to execute the
* code below. */
Tcl_Obj *command; /* Tcl code to execute for a buffer */
ResultBuffer result; /* Internal buffer used to store the result of
- * a transformation of incoming data.
- * Additionally serves as buffer of all data
- * not yet consumed by the reader. */
+ * a transformation of incoming data. Also
+ * serves as buffer of all data not yet
+ * consumed by the reader. */
+ int refCount;
};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree(dataPtr);
+}
/*
*----------------------------------------------------------------------
*
* TclChannelTransform --
*
- * Implements the Tcl "testchannel transform" debugging command. This is
+ * Implements the Tcl "testchannel transform" debugging command. This is
* part of the testing environment. This sets up a tcl script (cmdObjPtr)
* to be used as a transform on the channel.
*
@@ -241,21 +252,28 @@ struct TransformChannelData {
/* ARGSUSED */
int
-TclChannelTransform(interp, chan, cmdObjPtr)
- Tcl_Interp *interp; /* Interpreter for result. */
- Tcl_Channel chan; /* Channel to transform. */
- Tcl_Obj *cmdObjPtr; /* Script to use for transform. */
+TclChannelTransform(
+ Tcl_Interp *interp, /* Interpreter for result. */
+ Tcl_Channel chan, /* Channel to transform. */
+ Tcl_Obj *cmdObjPtr) /* Script to use for transform. */
{
Channel *chanPtr; /* The actual channel. */
- ChannelState *statePtr; /* state info for channel */
- int mode; /* rw mode of the channel */
+ ChannelState *statePtr; /* State info for channel. */
+ int mode; /* Read/write mode of the channel. */
+ int objc;
TransformChannelData *dataPtr;
- int res;
Tcl_DString ds;
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
+
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ return TCL_ERROR;
+ }
+
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -268,41 +286,35 @@ TclChannelTransform(interp, chan, cmdObjPtr)
* 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);
+ dataPtr->refCount = 1;
+ Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
-
dataPtr->readIsFlushed = 0;
- dataPtr->flags = 0;
-
+ dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
}
-
Tcl_DStringFree(&ds);
dataPtr->self = chan;
dataPtr->watchMask = 0;
dataPtr->mode = mode;
- dataPtr->timer = (Tcl_TimerToken) NULL;
- dataPtr->maxRead = 4096; /* Initial value not relevant */
+ dataPtr->timer = NULL;
+ dataPtr->maxRead = 4096; /* Initial value not relevant. */
dataPtr->interp = interp;
dataPtr->command = cmdObjPtr;
-
Tcl_IncrRefCount(dataPtr->command);
ResultInit(&dataPtr->result);
- dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
- (ClientData) dataPtr, mode, chan);
- if (dataPtr->self == (Tcl_Channel) NULL) {
- Tcl_AppendResult(interp, "\nfailed to stack channel \"",
- Tcl_GetChannelName(chan), "\"", (char *) NULL);
-
- Tcl_DecrRefCount(dataPtr->command);
- ResultClear(&dataPtr->result);
- ckfree((char *) dataPtr);
+ dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
+ mode, chan);
+ if (dataPtr->self == NULL) {
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
+ "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -310,29 +322,24 @@ TclChannelTransform(interp, chan, cmdObjPtr)
* At last initialize the transformation at the script level.
*/
- if (dataPtr->mode & TCL_WRITABLE) {
- res = ExecuteCallback(dataPtr, NO_INTERP, A_CREATE_WRITE, NULL, 0,
- TRANSMIT_DONT, P_NO_PRESERVE);
-
- if (res != TCL_OK) {
- Tcl_UnstackChannel(interp, chan);
- return TCL_ERROR;
- }
+ PreserveData(dataPtr);
+ if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
+ A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
+ Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
+ return TCL_ERROR;
}
- if (dataPtr->mode & TCL_READABLE) {
- res = ExecuteCallback(dataPtr, NO_INTERP, A_CREATE_READ, NULL, 0,
- TRANSMIT_DONT, P_NO_PRESERVE);
-
- if (res != TCL_OK) {
- ExecuteCallback(dataPtr, NO_INTERP, A_DELETE_WRITE, NULL, 0,
- TRANSMIT_DONT, P_NO_PRESERVE);
-
- Tcl_UnstackChannel(interp, chan);
- return TCL_ERROR;
- }
+ if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
+ A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
+ ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
+ Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
+ return TCL_ERROR;
}
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -354,20 +361,30 @@ TclChannelTransform(interp, chan, cmdObjPtr)
*/
static int
-ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
- TransformChannelData *dataPtr; /* Transformation with the callback */
- Tcl_Interp *interp; /* Current interpreter, possibly
- * NULL. */
- unsigned char *op; /* Operation invoking the callback */
- unsigned char *buf; /* Buffer to give to the script. */
- int bufLen; /* And its length */
- int transmit; /* Flag, determines whether the result
- * of the callback is sent to the
- * underlying channel or not. */
- int preserve; /* Flag. If true the procedure will
- * preserver the result state of all
- * accessed interpreters. */
+ExecuteCallback(
+ TransformChannelData *dataPtr,
+ /* Transformation with the callback. */
+ Tcl_Interp *interp, /* Current interpreter, possibly NULL. */
+ unsigned char *op, /* Operation invoking the callback. */
+ unsigned char *buf, /* Buffer to give to the script. */
+ int bufLen, /* And its length. */
+ int transmit, /* Flag, determines whether the result of the
+ * callback is sent to the underlying channel
+ * or not. */
+ int preserve) /* Flag. If true the procedure will preserve
+ * the result state of all accessed
+ * interpreters. */
{
+ Tcl_Obj *resObj; /* See below, switch (transmit). */
+ int resLen;
+ unsigned char *resBuf;
+ Tcl_InterpState state = NULL;
+ int res = TCL_OK;
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
+
/*
* Step 1, create the complete command to execute. Do this by appending
* operation and buffer to operate upon to a copy of the callback
@@ -376,56 +393,19 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
* arguments. Feather's curried commands would come in handy here.
*/
- Tcl_Obj *resObj; /* See below, switch (transmit) */
- int resLen;
- unsigned char *resBuf;
- Tcl_InterpState state = NULL;
- int res = TCL_OK;
- Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
- Tcl_Obj *temp;
-
- if (preserve) {
- state = Tcl_SaveInterpState(dataPtr->interp, res);
- }
-
- if (command == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
+ if (preserve == P_PRESERVE) {
+ state = Tcl_SaveInterpState(eval, res);
}
Tcl_IncrRefCount(command);
-
- temp = Tcl_NewStringObj((char*) op, -1);
-
- if (temp == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
- }
-
- res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
/*
* Use a byte-array to prevent the misinterpretation of binary data coming
* through as UTF while at the tcl level.
*/
- temp = Tcl_NewByteArrayObj(buf, bufLen);
-
- if (temp == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
- }
-
- res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
/*
* Step 2, execute the command at the global level of the interpreter used
@@ -435,13 +415,14 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
* current interpreter. Don't copy if in preservation mode.
*/
- res = Tcl_GlobalEvalObj(dataPtr->interp, command);
+ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
- command = (Tcl_Obj*) NULL;
+ command = NULL;
- if ((res != TCL_OK) && (interp != NO_INTERP) &&
- (dataPtr->interp != interp) && !preserve) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
+ && (preserve == P_NO_PRESERVE)) {
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
return res;
}
@@ -456,48 +437,39 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
- resBuf = (unsigned char *) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
resLen);
break;
case TRANSMIT_SELF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
- resBuf = (unsigned char *) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
break;
case TRANSMIT_IBUF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
- resBuf = (unsigned char *) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ resObj = Tcl_GetObjResult(eval);
+ resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
ResultAdd(&dataPtr->result, resBuf, resLen);
break;
case TRANSMIT_NUM:
- /* Interpret result as integer number */
- resObj = Tcl_GetObjResult(dataPtr->interp);
- Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
- break;
- }
-
- Tcl_ResetResult(dataPtr->interp);
-
- if (preserve) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
-
- return res;
+ /*
+ * Interpret result as integer number.
+ */
- cleanup:
- if (preserve) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
+ break;
}
- if (command != (Tcl_Obj*) NULL) {
- Tcl_DecrRefCount(command);
+ Tcl_ResetResult(eval);
+ if (preserve == P_PRESERVE) {
+ (void) Tcl_RestoreInterpState(eval, state);
}
-
+ Tcl_Release(eval);
return res;
}
@@ -519,16 +491,16 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
*/
static int
-TransformBlockModeProc(instanceData, mode)
- ClientData instanceData; /* State of transformation */
- int mode; /* New blocking mode */
+TransformBlockModeProc(
+ ClientData instanceData, /* State of transformation. */
+ int mode) /* New blocking mode. */
{
- TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
+ TransformChannelData *dataPtr = instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
- dataPtr->flags |= CHANNEL_ASYNC;
+ dataPtr->flags |= CHANNEL_ASYNC;
} else {
- dataPtr->flags &= ~(CHANNEL_ASYNC);
+ dataPtr->flags &= ~CHANNEL_ASYNC;
}
return 0;
}
@@ -551,18 +523,16 @@ TransformBlockModeProc(instanceData, mode)
*/
static int
-TransformCloseProc(instanceData, interp)
- ClientData instanceData;
- Tcl_Interp *interp;
+TransformCloseProc(
+ ClientData instanceData,
+ Tcl_Interp *interp)
{
- TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
+ TransformChannelData *dataPtr = instanceData;
/*
* Important: In this procedure 'dataPtr->self' already points to the
* underlying channel.
- */
-
- /*
+ *
* There is no need to cancel an existing channel handler, this is already
* done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
* 'Tcl_Close'.
@@ -571,9 +541,9 @@ TransformCloseProc(instanceData, interp)
* removed channel.
*/
- if (dataPtr->timer != (Tcl_TimerToken) NULL) {
- Tcl_DeleteTimerHandler(dataPtr->timer);
- dataPtr->timer = (Tcl_TimerToken) NULL;
+ if (dataPtr->timer != NULL) {
+ Tcl_DeleteTimerHandler(dataPtr->timer);
+ dataPtr->timer = NULL;
}
/*
@@ -583,35 +553,33 @@ TransformCloseProc(instanceData, interp)
* system rely on (f.e. signaling the close to interested parties).
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
- TRANSMIT_DOWN, 1);
+ ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
+ TRANSMIT_DOWN, P_PRESERVE);
}
if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
dataPtr->readIsFlushed = 1;
- ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0,
- TRANSMIT_IBUF, 1);
+ ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF,
+ P_PRESERVE);
}
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
- TRANSMIT_DONT, 1);
+ ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
+ TRANSMIT_DONT, P_PRESERVE);
}
-
if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
- TRANSMIT_DONT, 1);
+ ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
+ TRANSMIT_DONT, P_PRESERVE);
}
+ ReleaseData(dataPtr);
/*
- * General cleanup
+ * General cleanup.
*/
- ResultClear(&dataPtr->result);
- Tcl_DecrRefCount(dataPtr->command);
- ckfree((char *) dataPtr);
-
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -632,17 +600,19 @@ TransformCloseProc(instanceData, interp)
*/
static int
-TransformInputProc(instanceData, buf, toRead, errorCodePtr)
- ClientData instanceData;
- char *buf;
- int toRead;
- int *errorCodePtr;
+TransformInputProc(
+ ClientData instanceData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
{
- TransformChannelData* dataPtr = (TransformChannelData *) instanceData;
- int gotBytes, read, res, copied;
+ TransformChannelData *dataPtr = instanceData;
+ int gotBytes, read, copied;
Tcl_Channel downChan;
- /* should assert (dataPtr->mode & TCL_READABLE) */
+ /*
+ * Should assert(dataPtr->mode & TCL_READABLE);
+ */
if (toRead == 0) {
/*
@@ -654,24 +624,25 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
+ PreserveData(dataPtr);
while (toRead > 0) {
- /*
+ /*
* Loop until the request is satisfied (or no data is available from
* below, possibly EOF).
*/
- copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
-
+ copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
/*
- * The request was completely satisfied from our buffers. We can
+ * The request was completely satisfied from our buffers. We can
* break out of the loop and return to the caller.
*/
- return gotBytes;
+
+ break;
}
/*
@@ -686,37 +657,39 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
* matching.
*/
- ExecuteCallback(dataPtr, NO_INTERP, A_QUERY_MAXREAD, NULL, 0,
- TRANSMIT_NUM /* -> maxRead */, 1);
+ ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
+ TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
if (dataPtr->maxRead >= 0) {
if (dataPtr->maxRead < toRead) {
- toRead = dataPtr->maxRead;
+ toRead = dataPtr->maxRead;
}
- } /* else: 'maxRead < 0' == Accept the current value of toRead */
-
+ } /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
}
- read = Tcl_ReadRaw(downChan, buf, toRead);
+ /*
+ * Get bytes from the underlying channel.
+ */
+ read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
/*
- * Report errors to caller. EAGAIN is a special situation. If we
+ * Report errors to caller. EAGAIN is a special situation. If we
* had some data before we report that instead of the request to
* re-try.
*/
+ int error = Tcl_GetErrno();
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- return gotBytes;
+ if ((error == EAGAIN) && (gotBytes > 0)) {
+ break;
}
- *errorCodePtr = Tcl_GetErrno();
- return -1;
- }
-
- if (read == 0) {
+ *errorCodePtr = error;
+ gotBytes = -1;
+ break;
+ } else if (read == 0) {
/*
* Check wether we hit on EOF in the underlying channel or not. If
* not differentiate between blocking and non-blocking modes. In
@@ -727,48 +700,50 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
* convert and flush all waiting partial data.
*/
- if (! Tcl_Eof(downChan)) {
- if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
+ if (!Tcl_Eof(downChan)) {
+ if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
- return -1;
- } else {
- return gotBytes;
- }
- } else {
- if (dataPtr->readIsFlushed) {
- /*
- * Already flushed, nothing to do anymore.
- */
- return gotBytes;
+ gotBytes = -1;
}
+ break;
+ }
+
+ if (dataPtr->readIsFlushed) {
+ /*
+ * Already flushed, nothing to do anymore.
+ */
- dataPtr->readIsFlushed = 1;
+ break;
+ }
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_READ, NULL, 0,
- TRANSMIT_IBUF, P_PRESERVE);
+ dataPtr->readIsFlushed = 1;
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
+ TRANSMIT_IBUF, P_PRESERVE);
- if (ResultLength(&dataPtr->result) == 0) {
- /* we had nothing to flush */
- return gotBytes;
- }
+ if (ResultEmpty(&dataPtr->result)) {
+ /*
+ * We had nothing to flush.
+ */
- continue; /* at: while (toRead > 0) */
+ break;
}
+
+ continue; /* at: while (toRead > 0) */
} /* read == 0 */
/*
* Transform the read chunk and add the result to our read buffer
- * (dataPtr->result)
+ * (dataPtr->result).
*/
- res = ExecuteCallback(dataPtr, NO_INTERP, A_READ, UCHARP(buf), read,
- TRANSMIT_IBUF, P_PRESERVE);
-
- if (res != TCL_OK) {
+ if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
+ TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ gotBytes = -1;
+ break;
}
} /* while toRead > 0 */
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -790,31 +765,33 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
*/
static int
-TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
- ClientData instanceData;
- CONST char *buf;
- int toWrite;
- int *errorCodePtr;
+TransformOutputProc(
+ ClientData instanceData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
{
- TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
- int res;
+ TransformChannelData *dataPtr = instanceData;
- /* should assert (dataPtr->mode & TCL_WRITABLE) */
+ /*
+ * Should assert(dataPtr->mode & TCL_WRITABLE);
+ */
if (toWrite == 0) {
/*
* Catch a no-op.
*/
+
return 0;
}
- res = ExecuteCallback(dataPtr, NO_INTERP, A_WRITE, UCHARP(buf), toWrite,
- TRANSMIT_DOWN, P_NO_PRESERVE);
-
- if (res != TCL_OK) {
- *errorCodePtr = EINVAL;
- return -1;
+ PreserveData(dataPtr);
+ if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
+ TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ toWrite = -1;
}
+ ReleaseData(dataPtr);
return toWrite;
}
@@ -829,7 +806,7 @@ TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
*
* Side effects:
* Moves the location at which the channel will be accessed in future
- * operations. Flushes all transformation buffers, then forwards it to
+ * operations. Flushes all transformation buffers, then forwards it to
* the underlying channel.
*
* Result:
@@ -840,25 +817,25 @@ TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
*/
static int
-TransformSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* The channel to manipulate */
- long offset; /* Size of movement. */
- int mode; /* How to move */
- int *errorCodePtr; /* Location of error flag. */
+TransformSeekProc(
+ ClientData instanceData, /* The channel to manipulate. */
+ long offset, /* Size of movement. */
+ int mode, /* How to move. */
+ int *errorCodePtr) /* Location of error flag. */
{
- TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
+ TransformChannelData *dataPtr = instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
- Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
+ const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
if ((offset == 0) && (mode == SEEK_CUR)) {
- /*
+ /*
* This is no seek but a request to tell the caller the current
* location. Simply pass the request down.
*/
- return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
- offset, mode, errorCodePtr);
+ return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset,
+ mode, errorCodePtr);
}
/*
@@ -867,20 +844,22 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_WRITE, NULL, 0,
- TRANSMIT_DOWN, P_NO_PRESERVE);
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+ P_NO_PRESERVE);
}
if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_CLEAR_READ, NULL, 0,
- TRANSMIT_DONT, P_NO_PRESERVE);
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
- return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
- offset, mode, errorCodePtr);
+ return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
+ errorCodePtr);
}
/*
@@ -893,7 +872,7 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
*
* Side effects:
* Moves the location at which the channel will be accessed in future
- * operations. Flushes all transformation buffers, then forwards it to
+ * operations. Flushes all transformation buffers, then forwards it to
* the underlying channel.
*
* Result:
@@ -904,32 +883,31 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
*/
static Tcl_WideInt
-TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* The channel to manipulate */
- Tcl_WideInt offset; /* Size of movement. */
- int mode; /* How to move */
- int *errorCodePtr; /* Location of error flag. */
+TransformWideSeekProc(
+ ClientData instanceData, /* The channel to manipulate. */
+ Tcl_WideInt offset, /* Size of movement. */
+ int mode, /* How to move. */
+ int *errorCodePtr) /* Location of error flag. */
{
- TransformChannelData * dataPtr = (TransformChannelData *) instanceData;
+ TransformChannelData *dataPtr = instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
- Tcl_ChannelType* parentType = Tcl_GetChannelType(parent);
- Tcl_DriverSeekProc* parentSeekProc = Tcl_ChannelSeekProc(parentType);
- Tcl_DriverWideSeekProc* parentWideSeekProc =
+ const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
+ Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
+ Tcl_DriverWideSeekProc *parentWideSeekProc =
Tcl_ChannelWideSeekProc(parentType);
ClientData parentData = Tcl_GetChannelInstanceData(parent);
if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
- /*
+ /*
* This is no seek but a request to tell the caller the current
* location. Simply pass the request down.
*/
if (parentWideSeekProc != NULL) {
- return (*parentWideSeekProc) (parentData, offset, mode,
- errorCodePtr);
+ return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}
- return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,
+ return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
errorCodePtr));
}
@@ -939,31 +917,33 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_WRITE, NULL, 0,
- TRANSMIT_DOWN, P_NO_PRESERVE);
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+ P_NO_PRESERVE);
}
if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_CLEAR_READ, NULL, 0,
- TRANSMIT_DONT, P_NO_PRESERVE);
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+ P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
*/
if (parentWideSeekProc != NULL) {
- return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr);
+ return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}
/*
* We're transferring to narrow seeks at this point; this is a bit complex
* because we have to check whether the seek is possible first (i.e.
* whether we are losing information in truncating the bits of the
- * offset.) Luckily, there's a defined error for what happens when trying
+ * offset). Luckily, there's a defined error for what happens when trying
* to go out of the representable range.
*/
@@ -972,8 +952,8 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
return Tcl_LongAsWide(-1);
}
- return Tcl_LongAsWide((*parentSeekProc) (parentData,
- Tcl_WideAsLong(offset), mode, errorCodePtr));
+ return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
+ mode, errorCodePtr));
}
/*
@@ -995,22 +975,23 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
*/
static int
-TransformSetOptionProc(instanceData, interp, optionName, value)
- ClientData instanceData;
- Tcl_Interp *interp;
- CONST char *optionName;
- CONST char *value;
+TransformSetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ const char *value)
{
- TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ TransformChannelData *dataPtr = instanceData;
Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_DriverSetOptionProc *setOptionProc;
setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
- if (setOptionProc != NULL) {
- return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
- interp, optionName, value);
+ if (setOptionProc == NULL) {
+ return TCL_ERROR;
}
- return TCL_ERROR;
+
+ return setOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+ optionName, value);
}
/*
@@ -1032,21 +1013,21 @@ TransformSetOptionProc(instanceData, interp, optionName, value)
*/
static int
-TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData;
- Tcl_Interp *interp;
- CONST char *optionName;
- Tcl_DString *dsPtr;
+TransformGetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ Tcl_DString *dsPtr)
{
- TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ TransformChannelData *dataPtr = instanceData;
Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_DriverGetOptionProc *getOptionProc;
getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
if (getOptionProc != NULL) {
- return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
- interp, optionName, dsPtr);
- } else if (optionName == (CONST char*) NULL) {
+ return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+ optionName, dsPtr);
+ } else if (optionName == NULL) {
/*
* Request is query for all options, this is ok.
*/
@@ -1055,7 +1036,7 @@ TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
}
/*
- * Request for a specific option has to fail, we don't have any.
+ * Request for a specific option has to fail, since we don't have any.
*/
return TCL_ERROR;
@@ -1080,24 +1061,24 @@ TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
/* ARGSUSED */
static void
-TransformWatchProc(instanceData, mask)
- ClientData instanceData; /* Channel to watch */
- int mask; /* Events of interest */
+TransformWatchProc(
+ ClientData instanceData, /* Channel to watch. */
+ int mask) /* Events of interest. */
{
+ TransformChannelData *dataPtr = instanceData;
+ Tcl_Channel downChan;
+
/*
* The caller expressed interest in events occuring for this channel. We
* are forwarding the call to the underlying channel now.
*/
- TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
- Tcl_Channel downChan;
-
dataPtr->watchMask = mask;
/*
* No channel handlers any more. We will be notified automatically about
* events on the channel below via a call to our 'TransformNotifyProc'.
- * But we have to pass the interest down now. We are allowed to add
+ * But we have to pass the interest down now. We are allowed to add
* additional 'interest' to the mask if we want to. But this
* transformation has no such interest. It just passes the request down,
* unchanged.
@@ -1112,28 +1093,28 @@ TransformWatchProc(instanceData, mask)
* Management of the internal timer.
*/
- if ((dataPtr->timer != (Tcl_TimerToken) NULL) &&
- (!(mask & TCL_READABLE) || ResultLength(&dataPtr->result)==0)) {
- /*
+ if ((dataPtr->timer != NULL) &&
+ (!(mask & TCL_READABLE) || ResultEmpty(&dataPtr->result))) {
+ /*
* A pending timer exists, but either is there no (more) interest in
- * the events it generates or nothing is availablee for reading, so
+ * the events it generates or nothing is available for reading, so
* remove it.
*/
- Tcl_DeleteTimerHandler(dataPtr->timer);
- dataPtr->timer = (Tcl_TimerToken) NULL;
+ Tcl_DeleteTimerHandler(dataPtr->timer);
+ dataPtr->timer = NULL;
}
- if ((dataPtr->timer == (Tcl_TimerToken) NULL) &&
- (mask & TCL_READABLE) && (ResultLength(&dataPtr->result) > 0)) {
- /*
+ if ((dataPtr->timer == NULL) && (mask & TCL_READABLE)
+ && !ResultEmpty(&dataPtr->result)) {
+ /*
* There is no pending timer, but there is interest in readable events
* and we actually have data waiting, so generate a timer to flush
* that.
*/
dataPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY,
- TransformChannelHandlerTimer, (ClientData) dataPtr);
+ TransformChannelHandlerTimer, dataPtr);
}
}
@@ -1149,24 +1130,24 @@ TransformWatchProc(instanceData, mask)
* None.
*
* Result:
- * The appropriate Tcl_File or NULL if not present.
+ * The appropriate Tcl_File or NULL if not present.
*
*----------------------------------------------------------------------
*/
static int
-TransformGetFileHandleProc(instanceData, direction, handlePtr)
- ClientData instanceData; /* Channel to query */
- int direction; /* Direction of interest */
- ClientData *handlePtr; /* Place to store the handle into */
+TransformGetFileHandleProc(
+ ClientData instanceData, /* Channel to query. */
+ int direction, /* Direction of interest. */
+ ClientData *handlePtr) /* Place to store the handle into. */
{
+ TransformChannelData *dataPtr = instanceData;
+
/*
- * Return the handle belonging to parent channel. IOW, pass the request
+ * Return the handle belonging to parent channel. IOW, pass the request
* down and the result up.
*/
- TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
-
return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
direction, handlePtr);
}
@@ -1189,18 +1170,19 @@ TransformGetFileHandleProc(instanceData, direction, handlePtr)
*/
static int
-TransformNotifyProc(clientData, mask)
- ClientData clientData; /* The state of the notified transformation */
- int mask; /* The mask of occuring events */
+TransformNotifyProc(
+ ClientData clientData, /* The state of the notified
+ * transformation. */
+ int mask) /* The mask of occuring events. */
{
- TransformChannelData *dataPtr = (TransformChannelData *) clientData;
+ TransformChannelData *dataPtr = clientData;
/*
- * An event occured in the underlying channel. This transformation
- * doesn't process such events thus returns the incoming mask unchanged.
+ * An event occured in the underlying channel. This transformation doesn't
+ * process such events thus returns the incoming mask unchanged.
*/
- if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+ if (dataPtr->timer != NULL) {
/*
* Delete an existing timer. It was not fired, yet we are here, so the
* channel below generated such an event and we don't have to. The
@@ -1210,9 +1192,8 @@ TransformNotifyProc(clientData, mask)
*/
Tcl_DeleteTimerHandler(dataPtr->timer);
- dataPtr->timer = (Tcl_TimerToken) NULL;
+ dataPtr->timer = NULL;
}
-
return mask;
}
@@ -1234,15 +1215,13 @@ TransformNotifyProc(clientData, mask)
*/
static void
-TransformChannelHandlerTimer(clientData)
- ClientData clientData; /* Transformation to query */
+TransformChannelHandlerTimer(
+ ClientData clientData) /* Transformation to query. */
{
- TransformChannelData *dataPtr = (TransformChannelData *) clientData;
-
- dataPtr->timer = (Tcl_TimerToken) NULL;
+ TransformChannelData *dataPtr = clientData;
- if (!(dataPtr->watchMask & TCL_READABLE) ||
- (ResultLength(&dataPtr->result) == 0)) {
+ dataPtr->timer = NULL;
+ if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
/*
* The timer fired, but either is there no (more) interest in the
* events it generates or nothing is available for reading, so ignore
@@ -1251,7 +1230,6 @@ TransformChannelHandlerTimer(clientData)
return;
}
-
Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
}
@@ -1271,15 +1249,15 @@ TransformChannelHandlerTimer(clientData)
*----------------------------------------------------------------------
*/
-static void
-ResultClear(r)
- ResultBuffer *r; /* Reference to the buffer to clear out. */
+static inline void
+ResultClear(
+ ResultBuffer *r) /* Reference to the buffer to clear out. */
{
r->used = 0;
if (r->allocated) {
- ckfree((char *) r->buf);
- r->buf = UCHARP(NULL);
+ ckfree(r->buf);
+ r->buf = NULL;
r->allocated = 0;
}
}
@@ -1301,36 +1279,37 @@ ResultClear(r)
*----------------------------------------------------------------------
*/
-static void
-ResultInit(r)
- ResultBuffer *r; /* Reference to the structure to initialize */
+static inline void
+ResultInit(
+ ResultBuffer *r) /* Reference to the structure to
+ * initialize. */
{
r->used = 0;
r->allocated = 0;
- r->buf = UCHARP(NULL);
+ r->buf = NULL;
}
/*
*----------------------------------------------------------------------
*
- * ResultLength --
+ * ResultEmpty --
*
- * Returns the number of bytes stored in the buffer.
+ * Returns whether the number of bytes stored in the buffer is zero.
*
* Side effects:
* None.
*
* Result:
- * An integer, see above too.
+ * A boolean.
*
*----------------------------------------------------------------------
*/
-static int
-ResultLength(r)
- ResultBuffer *r; /* The structure to query */
+static inline int
+ResultEmpty(
+ ResultBuffer *r) /* The structure to query. */
{
- return r->used;
+ return r->used == 0;
}
/*
@@ -1351,52 +1330,44 @@ ResultLength(r)
*----------------------------------------------------------------------
*/
-static int
-ResultCopy(r, buf, toRead)
- ResultBuffer *r; /* The buffer to read from. */
- unsigned char *buf; /* The buffer to copy into. */
- int toRead; /* Number of requested bytes. */
+static inline int
+ResultCopy(
+ ResultBuffer *r, /* The buffer to read from. */
+ unsigned char *buf, /* The buffer to copy into. */
+ size_t toRead) /* Number of requested bytes. */
{
if (r->used == 0) {
- /*
+ /*
* Nothing to copy in the case of an empty buffer.
*/
- return 0;
- }
-
- if (r->used == toRead) {
- /*
+ return 0;
+ } else if (r->used == toRead) {
+ /*
* We have just enough. Copy everything to the caller.
*/
- memcpy((VOID *) buf, (VOID *) r->buf, (size_t) toRead);
+ memcpy(buf, r->buf, toRead);
r->used = 0;
- return toRead;
- }
-
- if (r->used > toRead) {
- /*
- * The internal buffer contains more than requested. Copy the
+ } else if (r->used > toRead) {
+ /*
+ * The internal buffer contains more than requested. Copy the
* requested subset to the caller, and shift the remaining bytes down.
*/
- memcpy((VOID *) buf, (VOID *) r->buf, (size_t) toRead);
- memmove((VOID *) r->buf, (VOID *) (r->buf + toRead),
- (size_t) r->used - toRead);
-
+ memcpy(buf, r->buf, toRead);
+ memmove(r->buf, r->buf + toRead, r->used - toRead);
r->used -= toRead;
- return toRead;
- }
-
- /*
- * There is not enough in the buffer to satisfy the caller, so take
- * everything.
- */
+ } else {
+ /*
+ * There is not enough in the buffer to satisfy the caller, so take
+ * everything.
+ */
- memcpy((VOID *) buf, (VOID *) r->buf, (size_t) r->used);
- toRead = r->used;
- r->used = 0;
+ memcpy(buf, r->buf, r->used);
+ toRead = r->used;
+ r->used = 0;
+ }
return toRead;
}
@@ -1416,29 +1387,31 @@ ResultCopy(r, buf, toRead)
*----------------------------------------------------------------------
*/
-static void
-ResultAdd(r, buf, toWrite)
- ResultBuffer *r; /* The buffer to extend */
- unsigned char *buf; /* The buffer to read from */
- int toWrite; /* The number of bytes in 'buf' */
+static inline void
+ResultAdd(
+ ResultBuffer *r, /* The buffer to extend. */
+ unsigned char *buf, /* The buffer to read from. */
+ size_t toWrite) /* The number of bytes in 'buf'. */
{
- if ((r->used + toWrite) > r->allocated) {
- /*
+ if (r->used + toWrite > r->allocated) {
+ /*
* Extension of the internal buffer is required.
*/
- if (r->allocated == 0) {
+ if (r->allocated == 0) {
r->allocated = toWrite + INCREMENT;
- r->buf = UCHARP(ckalloc((unsigned) r->allocated));
+ r->buf = ckalloc(r->allocated);
} else {
r->allocated += toWrite + INCREMENT;
- r->buf = UCHARP(ckrealloc((char *) r->buf,
- (unsigned) r->allocated));
+ r->buf = ckrealloc(r->buf, r->allocated);
}
}
- /* now copy data */
- memcpy(r->buf + r->used, buf, (size_t) toWrite);
+ /*
+ * Now we may copy the data.
+ */
+
+ memcpy(r->buf + r->used, buf, toWrite);
r->used += toWrite;
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 0a57eb3..94428bb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1,99 +1,85 @@
-/*
+/*
* tclIORChan.c --
*
- * This file contains the implementation of Tcl's generic
- * channel reflection code, which allows the implementation
- * of Tcl channels in Tcl code.
+ * This file contains the implementation of Tcl's generic channel
+ * reflection code, which allows the implementation of Tcl channels in
+ * Tcl code.
*
- * Parts of this file are based on code contributed by
- * Jean-Claude Wippler.
+ * Parts of this file are based on code contributed by Jean-Claude
+ * Wippler.
*
- * See TIP #219 for the specification of this functionality.
+ * See TIP #219 for the specification of this functionality.
*
* Copyright (c) 2004-2005 ActiveState, a divison of Sophos
*
- * 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.5 2005/09/15 16:40:02 dgp 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>
-#include <tclIO.h>
+#include "tclInt.h"
+#include "tclIO.h"
#include <assert.h>
#ifndef EINVAL
-#define EINVAL 9
+#define EINVAL 9
#endif
#ifndef EOK
-#define EOK 0
+#define EOK 0
#endif
/*
* Signatures of all functions used in the C layer of the reflection.
*/
-/* Required */
-static int RcClose _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-
-/* Required, "read" is optional despite this. */
-static int RcInput _ANSI_ARGS_((ClientData clientData,
- char *buf, int toRead, int *errorCodePtr));
-
-/* Required, "write" is optional despite this. */
-static int RcOutput _ANSI_ARGS_((ClientData clientData,
- CONST char *buf, int toWrite, int *errorCodePtr));
-
-/* Required */
-static void RcWatch _ANSI_ARGS_((ClientData clientData, int mask));
-
-/* NULL'able - "blocking", is optional */
-static int RcBlock _ANSI_ARGS_((ClientData clientData,
- int mode));
-
-/* NULL'able - "seek", is optional */
-static Tcl_WideInt RcSeekWide _ANSI_ARGS_((ClientData clientData,
- Tcl_WideInt offset,
- int mode, int *errorCodePtr));
-
-static int RcSeek _ANSI_ARGS_((ClientData clientData,
- long offset, int mode, int *errorCodePtr));
-
-/* NULL'able - "cget" / "cgetall", are optional */
-static int RcGetOption _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp,
- CONST char *optionName,
- Tcl_DString *dsPtr));
-
-/* NULL'able - "configure", is optional */
-static int RcSetOption _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp,
- CONST char *optionName,
- CONST char *newValue));
-
+static int ReflectClose(ClientData clientData,
+ Tcl_Interp *interp);
+static int ReflectInput(ClientData clientData, char *buf,
+ int toRead, int *errorCodePtr);
+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,
+ int mode, int *errorCodePtr);
+static int ReflectGetOption(ClientData clientData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static int ReflectSetOption(ClientData clientData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *newValue);
/*
- * The C layer channel type/driver definition used by the reflection.
- * This is a version 3 structure.
+ * The C layer channel type/driver definition used by the reflection. This is
+ * a version 3 structure.
*/
-static Tcl_ChannelType tclRChannelType = {
- "tclrchannel", /* Type name. */
- TCL_CHANNEL_VERSION_3,
- RcClose, /* Close channel, clean instance data */
- RcInput, /* Handle read request */
- RcOutput, /* Handle write request */
- RcSeek, /* Move location of access point. NULL'able */
- RcSetOption, /* Set options. NULL'able */
- RcGetOption, /* Get options. NULL'able */
- RcWatch, /* Initialize notifier */
- NULL, /* Get OS handle from the channel. NULL'able */
- NULL, /* No close2 support. NULL'able */
- RcBlock, /* Set blocking/nonblocking. NULL'able */
- NULL, /* Flush channel. Not used by core. NULL'able */
- NULL, /* Handle events. NULL'able */
- RcSeekWide /* Move access point (64 bit). NULL'able */
+static const Tcl_ChannelType tclRChannelType = {
+ "tclrchannel", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ ReflectClose, /* Close channel, clean instance data */
+ ReflectInput, /* Handle read request */
+ ReflectOutput, /* Handle write request */
+ ReflectSeek, /* Move location of access point. NULL'able */
+ ReflectSetOption, /* Set options. NULL'able */
+ ReflectGetOption, /* Get options. NULL'able */
+ ReflectWatch, /* Initialize notifier */
+ NULL, /* Get OS handle from the channel. NULL'able */
+ NULL, /* No close2 support. NULL'able */
+ ReflectBlock, /* Set blocking/nonblocking. NULL'able */
+ 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 */
};
/*
@@ -101,125 +87,124 @@ static Tcl_ChannelType tclRChannelType = {
*/
typedef struct {
- Tcl_Channel chan; /* Back reference to generic channel structure.
- */
- Tcl_Interp* interp; /* Reference to the interpreter containing the
- * Tcl level part of the channel. */
+ Tcl_Channel chan; /* Back reference to generic channel
+ * structure. */
+ Tcl_Interp *interp; /* Reference to the interpreter containing the
+ * Tcl level part of the channel. NULL here
+ * signals the channel is dead because the
+ * interpreter/thread containing its Tcl
+ * 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
+ Tcl_Obj *cmd; /* Callback command prefix */
+ Tcl_Obj *methods; /* Methods to append to command prefix */
+ Tcl_Obj *name; /* Name of the channel as created */
+
+ int mode; /* Mask of R/W mode */
+ 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.
+ *
+ * Most channel implementations need a timer in the C level to ensure that
+ * data in buffers is flushed out through the generation of fake file
+ * events.
+ *
+ * See 'rechan', 'memchan', etc.
+ *
+ * Here this is _not_ required. Interest in events is posted to the Tcl
+ * level via 'watch'. And posting of events is possible from the Tcl level
+ * as well, via 'chan postevent'. This means that the generation of all
+ * events, fake or not, timer based or not, is completely in the hands of
+ * the Tcl level. Therefore no timer here.
+ */
+} ReflectedChannel;
- /* See [==] as well.
- * Storage for the command prefix and the additional words required
- * for the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj** argv; /* Preallocated array for calling the handler.
- * args [0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words.
- */
-
- int methods; /* Bitmask of supported methods */
-
- /* ---------------------------------------- */
-
- /* NOTE (9): Should we have predefined shared literals
- * NOTE (9): for the method names ?
- */
-
- /* ---------------------------------------- */
-
- int mode; /* Mask of R/W mode */
- int interest; /* Mask of events the channel is interested in. */
-
- /* Note regarding the usage of timers.
- *
- * Most channel implementations need a timer in the
- * C level to ensure that data in buffers is flushed
- * out through the generation of fake file events.
- *
- * See 'rechan', 'memchan', etc.
- *
- * Here this is _not_ required. Interest in events is
- * posted to the Tcl level via 'watch'. And posting of
- * events is possible from the Tcl level as well, via
- * 'chan postevent'. This means that the generation of
- * all events, fake or not, timer based or not, is
- * completely in the hands of the Tcl level. Therefore
- * no timer here.
- */
-
-} ReflectingChannel;
+/*
+ * Structure of the table maping from channel handles to reflected
+ * channels. Each interpreter which has the handler command for one or more
+ * reflected channels records them in such a table, so that 'chan postevent'
+ * is able to find them even if the actual channel was moved to a different
+ * interpreter and/or thread.
+ *
+ * The table is reachable via the standard interpreter AssocData, the key is
+ * defined below.
+ */
+
+typedef struct {
+ Tcl_HashTable map;
+} ReflectedChannelMap;
+
+#define RCMKEY "ReflectedChannelMap"
/*
* Event literals. ==================================================
*/
-static CONST char *eventOptions[] = {
- "read", "write", (char *) NULL
+static const char *const eventOptions[] = {
+ "read", "write", NULL
};
typedef enum {
- EVENT_READ, EVENT_WRITE
+ EVENT_READ, EVENT_WRITE
} EventOption;
/*
* Method literals. ==================================================
*/
-static CONST char *methodNames[] = {
- "blocking", /* OPT */
- "cget", /* OPT \/ Together or none */
- "cgetall", /* OPT /\ of these two */
- "configure", /* OPT */
- "finalize", /* */
- "initialize", /* */
- "read", /* OPT */
- "seek", /* OPT */
- "watch", /* */
- "write", /* OPT */
- (char *) NULL
+static const char *const methodNames[] = {
+ "blocking", /* OPT */
+ "cget", /* OPT \/ Together or none */
+ "cgetall", /* OPT /\ of these two */
+ "configure", /* OPT */
+ "finalize", /* */
+ "initialize", /* */
+ "read", /* OPT */
+ "seek", /* OPT */
+ "watch", /* */
+ "write", /* OPT */
+ NULL
};
typedef enum {
- METH_BLOCKING,
- METH_CGET,
- METH_CGETALL,
- METH_CONFIGURE,
- METH_FINAL,
- METH_INIT,
- METH_READ,
- METH_SEEK,
- METH_WATCH,
- METH_WRITE,
+ METH_BLOCKING,
+ METH_CGET,
+ METH_CGETALL,
+ METH_CONFIGURE,
+ METH_FINAL,
+ METH_INIT,
+ METH_READ,
+ METH_SEEK,
+ METH_WATCH,
+ METH_WRITE
} MethodName;
#define FLAG(m) (1 << (m))
-#define REQUIRED_METHODS (FLAG (METH_INIT) | FLAG (METH_FINAL) | FLAG (METH_WATCH))
-#define NULLABLE_METHODS (FLAG (METH_BLOCKING) | FLAG (METH_SEEK) | \
- FLAG (METH_CONFIGURE) | FLAG (METH_CGET) | FLAG (METH_CGETALL))
+#define REQUIRED_METHODS \
+ (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
+#define NULLABLE_METHODS \
+ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
+ FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
-#define RANDW (TCL_READABLE|TCL_WRITABLE)
+#define RANDW \
+ (TCL_READABLE | TCL_WRITABLE)
-#define IMPLIES(a,b) ((!(a)) || (b))
+#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
-#define HAS(x,f) (x & FLAG(f))
-
+#define HAS(x,f) (x & FLAG(f))
#ifdef TCL_THREADS
/*
* Thread specific types and structures.
*
- * We are here essentially creating a very specific implementation of
- * 'thread send'.
+ * We are here essentially creating a very specific implementation of 'thread
+ * send'.
*/
/*
@@ -227,216 +212,230 @@ typedef enum {
*/
typedef enum {
- RcOpClose,
- RcOpInput,
- RcOpOutput,
- RcOpSeek,
- RcOpWatch,
- RcOpBlock,
- RcOpSetOpt,
- RcOpGetOpt,
- RcOpGetOptAll
-} RcOperation;
+ ForwardedClose,
+ ForwardedInput,
+ ForwardedOutput,
+ ForwardedSeek,
+ ForwardedWatch,
+ ForwardedBlock,
+ ForwardedSetOpt,
+ ForwardedGetOpt,
+ ForwardedGetOptAll
+} ForwardedOperation;
/*
- * Event used to forward driver invocations to the thread actually
- * managing the channel. We cannot construct the command to execute
- * and forward that. Because then it will contain a mixture of
- * Tcl_Obj's belonging to both the command handler thread (CT), and
- * the thread managing the channel (MT), executed in CT. Tcl_Obj's are
- * not allowed to cross thread boundaries. So we forward an operation
- * code, the argument details ,and reference to results. The command
- * is assembled in the CT and belongs fully to that thread. No sharing
- * problems.
+ * Event used to forward driver invocations to the thread actually managing
+ * the channel. We cannot construct the command to execute and forward that.
+ * Because then it will contain a mixture of Tcl_Obj's belonging to both the
+ * command handler thread (CT), and the thread managing the channel (MT),
+ * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
+ * forward an operation code, the argument details, and reference to results.
+ * The command is assembled in the CT and belongs fully to that thread. No
+ * sharing problems.
*/
-typedef struct RcForwardParamBase {
- int code; /* O: Ok/Fail of the cmd handler */
- char* msg; /* O: Error message for handler failure */
- int vol; /* O: True - msg is allocated, False - msg is static */
-} RcForwardParamBase;
+typedef struct ForwardParamBase {
+ int code; /* O: Ok/Fail of the cmd handler */
+ char *msgStr; /* O: Error message for handler failure */
+ int mustFree; /* O: True if msgStr is allocated, false if
+ * otherwise (static). */
+} ForwardParamBase;
/*
- * Operation specific parameter/result structures.
+ * Operation specific parameter/result structures. (These are "subtypes" of
+ * ForwardParamBase. Where an operation does not need any special types, it
+ * has no "subtype" and just uses ForwardParamBase, as listed above.)
*/
-typedef struct RcForwardParamClose {
- RcForwardParamBase b;
-} RcForwardParamClose;
-
-typedef struct RcForwardParamInput {
- RcForwardParamBase b;
- char* buf; /* O: Where to store the read bytes */
- int toRead; /* I: #bytes to read,
- * O: #bytes actually read */
-} RcForwardParamInput;
-
-typedef struct RcForwardParamOutput {
- RcForwardParamBase b;
- CONST char* buf; /* I: Where the bytes to write come from */
- int toWrite; /* I: #bytes to write,
- * O: #bytes actually written */
-} RcForwardParamOutput;
-
-typedef struct RcForwardParamSeek {
- RcForwardParamBase b;
- int seekMode; /* I: How to seek */
- Tcl_WideInt offset; /* I: Where to seek,
- * O: New location */
-} RcForwardParamSeek;
-
-typedef struct RcForwardParamWatch {
- RcForwardParamBase b;
- int mask; /* I: What events to watch for */
-} RcForwardParamWatch;
-
-typedef struct RcForwardParamBlock {
- RcForwardParamBase b;
- int nonblocking; /* I: What mode to activate */
-} RcForwardParamBlock;
-
-typedef struct RcForwardParamSetOpt {
- RcForwardParamBase b;
- CONST char* name; /* Name of option to set */
- CONST char* value; /* Value to set */
-} RcForwardParamSetOpt;
-
-typedef struct RcForwardParamGetOpt {
- RcForwardParamBase b;
- CONST char* name; /* Name of option to get, maybe NULL */
- Tcl_DString* value; /* Result */
-} RcForwardParamGetOpt;
+struct ForwardParamInput {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ char *buf; /* O: Where to store the read bytes */
+ int toRead; /* I: #bytes to read,
+ * O: #bytes actually read */
+};
+struct ForwardParamOutput {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ const char *buf; /* I: Where the bytes to write come from */
+ int toWrite; /* I: #bytes to write,
+ * O: #bytes actually written */
+};
+struct ForwardParamSeek {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int seekMode; /* I: How to seek */
+ Tcl_WideInt offset; /* I: Where to seek,
+ * O: New location */
+};
+struct ForwardParamWatch {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int mask; /* I: What events to watch for */
+};
+struct ForwardParamBlock {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int nonblocking; /* I: What mode to activate */
+};
+struct ForwardParamSetOpt {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ const char *name; /* Name of option to set */
+ const char *value; /* Value to set */
+};
+struct ForwardParamGetOpt {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ const char *name; /* Name of option to get, maybe NULL */
+ Tcl_DString *value; /* Result */
+};
/*
- * General event structure, with reference to
- * operation specific data.
+ * Now join all these together in a single union for convenience.
*/
-typedef struct RcForwardingEvent {
- Tcl_Event event; /* Basic event data, has to be first item */
- struct RcForwardingResult* resultPtr;
-
- RcOperation op; /* Forwarded driver operation */
- ReflectingChannel* rcPtr; /* Channel instance */
- CONST RcForwardParamBase* param; /* Arguments, a RcForwardParamXXX pointer */
-} RcForwardingEvent;
+typedef union ForwardParam {
+ ForwardParamBase base;
+ struct ForwardParamInput input;
+ struct ForwardParamOutput output;
+ struct ForwardParamSeek seek;
+ struct ForwardParamWatch watch;
+ struct ForwardParamBlock block;
+ struct ForwardParamSetOpt setOpt;
+ struct ForwardParamGetOpt getOpt;
+} ForwardParam;
/*
- * Structure to manage the result of the forwarding. This is not the
- * result of the operation itself, but about the success of the
- * forward event itself. The event can be successful, even if the
- * operation which was forwarded failed. It is also there to manage
- * the synchronization between the involved threads.
+ * Forward declaration.
*/
-typedef struct RcForwardingResult {
-
- Tcl_ThreadId src; /* Originating thread. */
- Tcl_ThreadId dst; /* Thread the op was forwarded to. */
- Tcl_Condition done; /* Condition variable the forwarder blocks on. */
- int result; /* TCL_OK or TCL_ERROR */
-
- struct RcForwardingEvent* evPtr; /* Event the result belongs to. */
-
- struct RcForwardingResult* prevPtr; /* Links into the list of pending */
- struct RcForwardingResult* nextPtr; /* forwarded results. */
-
-} RcForwardingResult;
+typedef struct ForwardingResult ForwardingResult;
/*
- * List of forwarded operations which have not completed yet, plus the
- * mutex to protect the access to this process global list.
+ * General event structure, with reference to operation specific data.
*/
-static RcForwardingResult* forwardList = (RcForwardingResult*) NULL;
-TCL_DECLARE_MUTEX (rcForwardMutex)
+typedef struct ForwardingEvent {
+ Tcl_Event event; /* Basic event data, has to be first item */
+ ForwardingResult *resultPtr;
+ ForwardedOperation op; /* Forwarded driver operation */
+ ReflectedChannel *rcPtr; /* Channel instance */
+ ForwardParam *param; /* Packaged arguments and return values, a
+ * ForwardParam pointer. */
+} ForwardingEvent;
/*
- * Function containing the generic code executing a forward, and
- * wrapper macros for the actual operations we wish to forward.
+ * Structure to manage the result of the forwarding. This is not the result of
+ * the operation itself, but about the success of the forward event itself.
+ * The event can be successful, even if the operation which was forwarded
+ * failed. It is also there to manage the synchronization between the involved
+ * threads.
*/
-static void
-RcForwardOp _ANSI_ARGS_ ((ReflectingChannel* rcPtr, RcOperation op,
- Tcl_ThreadId dst, CONST VOID* param));
+struct ForwardingResult {
+ Tcl_ThreadId src; /* Originating thread. */
+ Tcl_ThreadId dst; /* Thread the op was forwarded to. */
+ Tcl_Interp *dsti; /* Interpreter in the thread the op was
+ * forwarded to. */
+ /*
+ * Note regarding 'dsti' above: Its information is also available via the
+ * chain evPtr->rcPtr->interp, however, as can be seen, two more
+ * indirections are needed to retrieve it. And the evPtr may be gone,
+ * breaking the chain.
+ */
+ Tcl_Condition done; /* Condition variable the forwarder blocks
+ * on. */
+ int result; /* TCL_OK or TCL_ERROR */
+ ForwardingEvent *evPtr; /* Event the result belongs to. */
+ ForwardingResult *prevPtr, *nextPtr;
+ /* Links into the list of pending forwarded
+ * results. */
+};
-/*
- * The event function executed by the thread receiving a forwarding
- * event. Executes the appropriate function and collects the result,
- * if any.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * Table of all reflected channels owned by this thread. This is the
+ * per-thread version of the per-interpreter map.
+ */
-static int
-RcForwardProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int mask));
+ ReflectedChannelMap *rcmPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
- * Helpers which intercept when threads are going away, and clean up
- * after pending forwarding events. Different actions depending on
- * which thread went away, originator (src), or receiver (dst).
+ * List of forwarded operations which have not completed yet, plus the mutex
+ * to protect the access to this process global list.
*/
-static void
-RcSrcExitProc _ANSI_ARGS_ ((ClientData clientData));
+static ForwardingResult *forwardList = NULL;
+TCL_DECLARE_MUTEX(rcForwardMutex)
-static void
-RcDstExitProc _ANSI_ARGS_ ((ClientData clientData));
-
-#define RcFreeReceivedError(pb) \
- if ((pb).vol) {ckfree ((pb).msg);}
-
-#define RcPassReceivedErrorInterp(i,pb) \
- if ((i)) {Tcl_SetChannelErrorInterp ((i), Tcl_NewStringObj ((pb).msg,-1));} \
- RcFreeReceivedError (pb)
-
-#define RcPassReceivedError(c,pb) \
- Tcl_SetChannelError ((c), Tcl_NewStringObj ((pb).msg,-1)); \
- RcFreeReceivedError (pb)
-
-#define RcForwardSetStaticError(p,emsg) \
- (p)->code = TCL_ERROR; (p)->vol = 0; (p)->msg = (char*) (emsg);
+/*
+ * Function containing the generic code executing a forward, and wrapper
+ * macros for the actual operations we wish to forward. Uses ForwardProc as
+ * the event function executed by the thread receiving a forwarding event
+ * (which executes the appropriate function and collects the result, if any).
+ *
+ * The ExitProc ensures that things do not deadlock when the sending thread
+ * involved in the forwarding exits. It also clean things up so that we don't
+ * leak resources when threads go away.
+ */
-#define RcForwardSetDynError(p,emsg) \
- (p)->code = TCL_ERROR; (p)->vol = 1; (p)->msg = (char*) (emsg);
+static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
+ ForwardedOperation op, const void *param);
+static int ForwardProc(Tcl_Event *evPtr, int mask);
+static void SrcExitProc(ClientData clientData);
-static void
-RcForwardSetObjError _ANSI_ARGS_ ((RcForwardParamBase* p,
- Tcl_Obj* obj));
+#define FreeReceivedError(p) \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ }
+#define PassReceivedErrorInterp(i,p) \
+ 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.msgStr = (char *) (emsg)
+#define ForwardSetDynamicError(p,emsg) \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
+ (p)->base.msgStr = (char *) (emsg)
+
+static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
+
+static ReflectedChannelMap * GetThreadReflectedChannelMap(void);
+static void DeleteThreadReflectedChannelMap(ClientData clientData);
#endif /* TCL_THREADS */
-#define RcSetChannelErrorStr(c,msg) \
- Tcl_SetChannelError ((c), Tcl_NewStringObj ((msg),-1))
-
-static Tcl_Obj* RcErrorMarshall _ANSI_ARGS_ ((Tcl_Interp *interp));
-static void RcErrorReturn _ANSI_ARGS_ ((Tcl_Interp* interp, Tcl_Obj* msg));
+#define SetChannelErrorStr(c,msgStr) \
+ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
-
+static Tcl_Obj * MarshallError(Tcl_Interp *interp);
+static void UnmarshallErrorResult(Tcl_Interp *interp,
+ Tcl_Obj *msgObj);
/*
* Static functions for this file:
*/
-static int RcEncodeEventMask _ANSI_ARGS_((Tcl_Interp* interp,
- CONST char* objName, Tcl_Obj* obj,
- int* mask));
-
-static Tcl_Obj* RcDecodeEventMask _ANSI_ARGS_ ((int mask));
-
-static ReflectingChannel* RcNew _ANSI_ARGS_ ((Tcl_Interp* interp,
- Tcl_Obj* cmdpfxObj, int mode,
- Tcl_Obj* id));
-
-static Tcl_Obj* RcNewHandle _ANSI_ARGS_ ((void));
-
-static void RcFree _ANSI_ARGS_ ((ReflectingChannel* rcPtr));
-
-static void
-RcInvokeTclMethod _ANSI_ARGS_((ReflectingChannel* rcPtr,
- CONST char* method, Tcl_Obj* argone, Tcl_Obj* argtwo,
- int* result, Tcl_Obj** resultObj, int capture));
-
-#define NO_CAPTURE (0)
-#define DO_CAPTURE (1)
+static int EncodeEventMask(Tcl_Interp *interp,
+ const char *objName, Tcl_Obj *obj, int *mask);
+static Tcl_Obj * DecodeEventMask(int mask);
+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 int InvokeTclMethod(ReflectedChannel *rcPtr,
+ MethodName method, Tcl_Obj *argOneObj,
+ Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
+
+static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
+static void DeleteReflectedChannelMap(ClientData clientData,
+ Tcl_Interp *interp);
+static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
/*
* Global constant strings (messages). ==================
@@ -445,17 +444,16 @@ RcInvokeTclMethod _ANSI_ARGS_((ReflectingChannel* rcPtr,
* list-quoting to keep the words of the message together. See also [x].
*/
-static CONST char* msg_read_unsup = "{read not supported by Tcl driver}";
-static CONST char* msg_read_toomuch = "{read delivered more than requested}";
-static CONST char* msg_write_unsup = "{write not supported by Tcl driver}";
-static CONST char* msg_write_toomuch = "{write wrote more than requested}";
-static CONST char* msg_seek_beforestart = "{Tried to seek before origin}";
-
+static const char *msg_read_toomuch = "{read delivered more than requested}";
+static const char *msg_write_toomuch = "{write wrote more than requested}";
+static const char *msg_write_nothing = "{write wrote nothing}";
+static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
-static CONST char* msg_send_originlost = "{Origin thread lost}";
-static CONST char* msg_send_dstlost = "{Destination thread lost}";
+static const char *msg_send_originlost = "{Channel thread lost}";
+static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
-
+static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
+
/*
* Main methods to plug into the 'chan' ensemble'. ==================
*/
@@ -465,12 +463,12 @@ static CONST char* msg_send_dstlost = "{Destination thread lost}";
*
* TclChanCreateObjCmd --
*
- * This procedure is invoked to process the "chan create" Tcl
- * command. See the user documentation for details on what it does.
+ * This function is invoked to process the "chan create" Tcl command.
+ * See the user documentation for details on what it does.
*
* Results:
- * A standard Tcl result.
- * The handle of the new channel is placed in the interp result.
+ * A standard Tcl result. The handle of the new channel is placed in the
+ * interp result.
*
* Side effects:
* Creates a new channel.
@@ -479,223 +477,252 @@ static CONST char* msg_send_dstlost = "{Destination thread lost}";
*/
int
-TclChanCreateObjCmd (/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int objc;
- Tcl_Obj* CONST* objv;
+TclChanCreateObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- ReflectingChannel* rcPtr; /* Instance data of the new channel */
- Tcl_Obj* rcId; /* Handle of the new channel */
- int mode; /* R/W mode of new channel. Has to
- * match abilities of handler commands */
- Tcl_Obj* cmdObj; /* Command prefix, list of words */
- Tcl_Obj* cmdNameObj; /* Command name */
- Tcl_Channel chan; /* Token for the new channel */
- Tcl_Obj* modeObj; /* mode in obj form for method call */
- int listc; /* Result of 'initialize', and of */
- Tcl_Obj** listv; /* its sublist in the 2nd element */
- int methIndex; /* Encoded method name */
- int res; /* Result code for 'initialize' */
- Tcl_Obj* resObj; /* Result data for 'initialize' */
- int methods; /* Bitmask for supported methods. */
- Channel* chanPtr; /* 'chan' resolved to internal struct. */
-
- /* Syntax: chan create MODE CMDPREFIX
+ ReflectedChannel *rcPtr; /* Instance data of the new channel */
+ Tcl_Obj *rcId; /* Handle of the new channel */
+ int mode; /* R/W mode of new channel. Has to match
+ * abilities of handler commands */
+ Tcl_Obj *cmdObj; /* Command prefix, list of words */
+ Tcl_Obj *cmdNameObj; /* Command name */
+ Tcl_Channel chan; /* Token for the new channel */
+ Tcl_Obj *modeObj; /* mode in obj form for method call */
+ int listc; /* Result of 'initialize', and of */
+ Tcl_Obj **listv; /* its sublist in the 2nd element */
+ int methIndex; /* Encoded method name */
+ int result; /* Result code for 'initialize' */
+ Tcl_Obj *resObj; /* Result data for 'initialize' */
+ int methods; /* Bitmask for supported methods. */
+ Channel *chanPtr; /* 'chan' resolved to internal struct. */
+ Tcl_Obj *err; /* Error message */
+ ReflectedChannelMap *rcmPtr;
+ /* Map of reflected channels with handlers in
+ * this interp. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
+ int isNew; /* Placeholder. */
+
+ /*
+ * Syntax: chan create MODE CMDPREFIX
* [0] [1] [2] [3]
*
* Actually: rCreate MODE CMDPREFIX
* [0] [1] [2]
*/
-#define MODE (1)
-#define CMD (2)
+#define MODE (1)
+#define CMD (2)
- /* Number of arguments ... */
+ /*
+ * Number of arguments...
+ */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
+ Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
return TCL_ERROR;
}
- /* First argument is a list of modes. Allowed entries are "read",
- * "write". Expect at least one list element. Abbreviations are
- * ok.
+ /*
+ * First argument is a list of modes. Allowed entries are "read", "write".
+ * Expect at least one list element. Abbreviations are ok.
*/
- modeObj = objv [MODE];
- if (RcEncodeEventMask (interp, "mode", objv [MODE], &mode) != TCL_OK) {
- return TCL_ERROR;
+ modeObj = objv[MODE];
+ if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
+ return TCL_ERROR;
}
- /* Second argument is command prefix, i.e. list of words, first
- * word is name of handler command, other words are fixed
- * arguments. Run 'initialize' method to get the list of supported
- * methods. Validate this.
+ /*
+ * Second argument is command prefix, i.e. list of words, first word is
+ * name of handler command, other words are fixed arguments. Run the
+ * 'initialize' method to get the list of supported methods. Validate
+ * this.
*/
- cmdObj = objv [CMD];
+ cmdObj = objv[CMD];
- /* Basic check that the command prefix truly is a list. */
+ /*
+ * Basic check that the command prefix truly is a list.
+ */
if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
- /* Now create the channel.
+ /*
+ * Now create the channel.
*/
- rcId = RcNewHandle ();
- rcPtr = RcNew (interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel (&tclRChannelType,
- Tcl_GetString (rcId),
- rcPtr, mode);
- rcPtr->chan = chan;
- chanPtr = (Channel*) chan;
-
- /* Invoke 'initialize' and validate that the handler
- * is present and ok. Squash the channel if not.
- */
+ rcId = NextHandle();
+ rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
- /* Note: The conversion of 'mode' back into a Tcl_Obj ensures that
+ /*
+ * Invoke 'initialize' and validate that the handler is present and ok.
+ * Squash the channel if not.
+ *
+ * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
* 'initialize' is invoked with canonical mode names, and no
- * abbreviations. Using modeObj directly could feed abbreviations
- * into the handler, and the handler is not specified to handle
- * such.
+ * abbreviations. Using modeObj directly could feed abbreviations into the
+ * handler, and the handler is not specified to handle such.
*/
- modeObj = RcDecodeEventMask (mode);
- RcInvokeTclMethod (rcPtr, "initialize", modeObj, NULL,
- &res, &resObj, NO_CAPTURE);
- Tcl_DecrRefCount (modeObj);
-
- if (res != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+ modeObj = DecodeEventMask(mode);
+ /* assert modeObj.refCount == 1 */
+ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
+ Tcl_DecrRefCount(modeObj);
- Tcl_AppendObjToObj(err,resObj);
- Tcl_SetObjResult (interp,err);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ if (result != TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
goto error;
}
- /* Verify the result.
+ /*
+ * Verify the result.
* - List, of method names. Convert to mask.
* Check for non-optionals through the mask.
* Compare open mode against optional r/w.
*/
- Tcl_AppendResult (interp, "Initialize failure: ", (char*) NULL);
-
- if (Tcl_ListObjGetElements (interp, resObj,
- &listc, &listv) != TCL_OK) {
- /* The function above replaces my prefix in case of an error,
- * so more work for us to get the prefix back into the error
- * message
- */
-
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
-
- Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
- Tcl_SetObjResult (interp,err);
+ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+ Tcl_DecrRefCount(resObj);
goto error;
}
methods = 0;
while (listc > 0) {
- if (Tcl_GetIndexFromObj (interp, listv [listc-1],
- methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
-
- Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
- Tcl_SetObjResult (interp,err);
+ 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_DecrRefCount(resObj);
goto error;
}
- methods |= FLAG (methIndex);
- listc --;
+ methods |= FLAG(methIndex);
+ listc--;
}
+ Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- Tcl_AppendResult (interp, "Not all required methods supported",
- (char*) NULL);
+ 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)) {
- Tcl_AppendResult (interp, "Reading not supported, but requested",
- (char*) NULL);
+ if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
+ 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)) {
- Tcl_AppendResult (interp, "Writing not supported, but requested",
- (char*) NULL);
+ if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
+ 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))) {
- Tcl_AppendResult (interp, "'cgetall' not supported, but should be, as 'cget' is",
- (char*) NULL);
+ if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
+ 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))) {
- Tcl_AppendResult (interp, "'cget' not supported, but should be, as 'cgetall' is",
- (char*) NULL);
+ if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
- Tcl_ResetResult (interp);
+ Tcl_ResetResult(interp);
- /* Everything is fine now */
+ /*
+ * Everything is fine now.
+ */
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ Tcl_Preserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
- /* Some of the nullable methods are not supported. We clone
- * the channel type, null the associated C functions, and use
- * the result as the actual channel type.
+ /*
+ * Some of the nullable methods are not supported. We clone the
+ * channel type, null the associated C functions, and use the result
+ * as the actual channel type.
*/
- Tcl_ChannelType* clonePtr = (Tcl_ChannelType*) ckalloc (sizeof (Tcl_ChannelType));
- if (clonePtr == (Tcl_ChannelType*) NULL) {
- Tcl_Panic ("Out of memory in Tcl_RcCreate");
- }
+ Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType));
- memcpy (clonePtr, &tclRChannelType, sizeof (Tcl_ChannelType));
+ memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
- if (!(methods & FLAG (METH_CONFIGURE))) {
- clonePtr->setOptionProc = NULL;
+ if (!(methods & FLAG(METH_CONFIGURE))) {
+ clonePtr->setOptionProc = NULL;
}
- if (
- !(methods & FLAG (METH_CGET)) &&
- !(methods & FLAG (METH_CGETALL))
- ) {
+ if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) {
clonePtr->getOptionProc = NULL;
}
- if (!(methods & FLAG (METH_BLOCKING))) {
+ if (!(methods & FLAG(METH_BLOCKING))) {
clonePtr->blockModeProc = NULL;
}
- if (!(methods & FLAG (METH_SEEK))) {
- clonePtr->seekProc = NULL;
+ if (!(methods & FLAG(METH_SEEK))) {
+ clonePtr->seekProc = NULL;
clonePtr->wideSeekProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
- Tcl_RegisterChannel (interp, chan);
+ /*
+ * Register the channel in the I/O system, and in our our map for 'chan
+ * postevent'.
+ */
+
+ Tcl_RegisterChannel(interp, chan);
- /* Return handle as result of command */
+ rcmPtr = GetReflectedChannelMap(interp);
+ hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
+ &isNew);
+ if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
+ Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
+ }
+ Tcl_SetHashValue(hPtr, chan);
+#ifdef TCL_THREADS
+ rcmPtr = GetThreadReflectedChannelMap();
+ hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
+ &isNew);
+ Tcl_SetHashValue(hPtr, chan);
+#endif
- Tcl_SetObjResult (interp, rcId);
+ /*
+ * Return handle as result of command.
+ */
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(chanPtr->state->channelName, -1));
return TCL_OK;
- error:
- /* Signal to RcClose to not call 'finalize' */
- rcPtr->methods = 0;
- Tcl_Close (interp, chan);
+ error:
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree((char*) rcPtr);
return TCL_ERROR;
#undef MODE
@@ -707,190 +734,306 @@ TclChanCreateObjCmd (/*ignored*/ clientData, interp, objc, objv)
*
* TclChanPostEventObjCmd --
*
- * This procedure is invoked to process the "chan postevent"
- * Tcl command. See the user documentation for details on what it does.
+ * This function is invoked to process the "chan postevent" Tcl command.
+ * See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Posts events to a reflected channel, invokes event handlers.
- * The latter implies that arbitrary side effects are possible.
+ * Posts events to a reflected channel, invokes event handlers. The
+ * latter implies that arbitrary side effects are possible.
*
*----------------------------------------------------------------------
*/
+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 (/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int objc;
- Tcl_Obj* CONST* objv;
+TclChanPostEventObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
{
- /* Syntax: chan postevent CHANNEL EVENTSPEC
+ /*
+ * Ensure -> HANDLER thread
+ *
+ * Syntax: chan postevent CHANNEL EVENTSPEC
* [0] [1] [2] [3]
*
* Actually: rPostevent CHANNEL EVENTSPEC
* [0] [1] [2]
*
- * where EVENTSPEC = {read write ...} (Abbreviations allowed as well.
+ * where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
*/
-#define CHAN (1)
-#define EVENT (2)
+#define CHAN (1)
+#define EVENT (2)
- CONST char* chanId; /* Tcl level channel handle */
- Tcl_Channel chan; /* Channel associated to the handle */
- Tcl_ChannelType* chanTypePtr; /* Its associated driver structure */
- ReflectingChannel* rcPtr; /* Associated instance data */
- int mode; /* Dummy, r|w mode of the channel */
- int events; /* Mask of events to post */
+ const char *chanId; /* Tcl level channel handle */
+ Tcl_Channel chan; /* Channel associated to the handle */
+ const Tcl_ChannelType *chanTypePtr;
+ /* Its associated driver structure */
+ ReflectedChannel *rcPtr; /* Associated instance data */
+ int events; /* Mask of events to post */
+ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+ * this interp. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
- /* Number of arguments ... */
+ /*
+ * Number of arguments...
+ */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
+ Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
return TCL_ERROR;
}
- /* First argument is a channel, a reflected channel, and the call
- * of this command is done from the interp defining the channel
- * handler cmd.
+ /*
+ * First argument is a channel, a reflected channel, and the call of this
+ * command is done from the interp defining the channel handler cmd.
*/
- chanId = Tcl_GetString (objv [CHAN]);
- chan = Tcl_GetChannel(interp, chanId, &mode);
+ chanId = TclGetString(objv[CHAN]);
+
+ rcmPtr = GetReflectedChannelMap(interp);
+ hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
+ if (hPtr == 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;
}
- chanTypePtr = Tcl_GetChannelType (chan);
+ /*
+ * Note that the search above subsumes several of the older checks, namely:
+ *
+ * (1) Does the channel handle refer to a reflected channel ?
+ * (2) Is the post event issued from the interpreter holding the handler
+ * of the reflected channel ?
+ *
+ * A successful search answers yes to both. Because the map holds only
+ * handles of reflected channels, and only of such whose handler is
+ * defined in this interpreter.
+ *
+ * We keep the old checks for both, for paranioa, but abort now instead of
+ * throwing errors, as failure now means that our internal datastructures
+ * have gone seriously haywire.
+ */
+
+ chan = Tcl_GetHashValue(hPtr);
+ chanTypePtr = Tcl_GetChannelType(chan);
- /* We use a function referenced by the channel type as our cookie
- * to detect calls to non-reflecting channels. The channel type
- * itself is not suitable, as it might not be the static
- * definition in this file, but a clone thereof. And while we have
- * reserved the name of the type nothing in the core checks
- * against violation, so someone else might have created a channel
- * type using our name, clashing with ourselves.
+ /*
+ * We use a function referenced by the channel type as our cookie to
+ * detect calls to non-reflecting channels. The channel type itself is not
+ * suitable, as it might not be the static definition in this file, but a
+ * clone thereof. And while we have reserved the name of the type nothing
+ * in the core checks against violation, so someone else might have
+ * created a channel type using our name, clashing with ourselves.
*/
- if (chanTypePtr->watchProc != &RcWatch) {
- Tcl_AppendResult(interp, "channel \"", chanId,
- "\" is not a reflected channel",
- (char *) NULL);
- return TCL_ERROR;
+ if (chanTypePtr->watchProc != &ReflectWatch) {
+ Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel");
}
- rcPtr = (ReflectingChannel*) Tcl_GetChannelInstanceData (chan);
+ rcPtr = Tcl_GetChannelInstanceData(chan);
if (rcPtr->interp != interp) {
- Tcl_AppendResult(interp, "postevent for channel \"", chanId,
- "\" called from outside interpreter",
- (char *) NULL);
- return TCL_ERROR;
+ Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
}
- /* Second argument is a list of events. Allowed entries are
- * "read", "write". Expect at least one list element.
- * Abbreviations are ok.
+ /*
+ * Second argument is a list of events. Allowed entries are "read",
+ * "write". Expect at least one list element. Abbreviations are ok.
*/
- if (RcEncodeEventMask (interp, "event", objv [EVENT], &events) != TCL_OK) {
- return TCL_ERROR;
+ if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
+ return TCL_ERROR;
}
-
- /* Check that the channel is actually interested in the provided
- * events.
+
+ /*
+ * Check that the channel is actually interested in the provided events.
*/
if (events & ~rcPtr->interest) {
- Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
- "\" is not interested in",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tried to post events channel \"%s\" is not interested in",
+ chanId));
return TCL_ERROR;
}
- /* We have the channel and the events to post.
+ /*
+ * 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.
+ /*
+ * Squash interp results left by the event script.
*/
- Tcl_ResetResult (interp);
+ Tcl_ResetResult(interp);
return TCL_OK;
#undef CHAN
#undef EVENT
}
+/*
+ * Channel error message marshalling utilities.
+ */
-static Tcl_Obj*
-RcErrorMarshall (interp)
- Tcl_Interp *interp;
+static Tcl_Obj *
+MarshallError(
+ Tcl_Interp *interp)
{
- /* Capture the result status of the interpreter into a string.
- * => List of options and values, followed by the error message.
- * The result has refCount 0.
+ /*
+ * Capture the result status of the interpreter into a string. => List of
+ * options and values, followed by the error message. The result has
+ * refCount 0.
*/
-
- Tcl_Obj* returnOpt = Tcl_GetReturnOptions (interp, TCL_ERROR);
- /* => returnOpt.refCount == 0. We can append directly.
+ Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
+
+ /*
+ * => returnOpt.refCount == 0. We can append directly.
*/
- Tcl_ListObjAppendElement (NULL, returnOpt, Tcl_GetObjResult (interp));
+ Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
return returnOpt;
}
static void
-RcErrorReturn (interp, msg)
- Tcl_Interp *interp;
- Tcl_Obj *msg;
+UnmarshallErrorResult(
+ Tcl_Interp *interp,
+ Tcl_Obj *msgObj)
{
- int res;
- int lc;
- Tcl_Obj** lv;
- int explicitResult;
- int numOptions;
+ int lc;
+ Tcl_Obj **lv;
+ int explicitResult;
+ int numOptions;
- /* Process the caught message.
+ /*
+ * Process the caught message.
*
* Syntax = (option value)... ?message?
*
- * Bad syntax causes a panic. Because the other side uses
+ * Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
- * information.
+ * information; if we panic here, something has gone badly wrong already.
*/
- res = Tcl_ListObjGetElements (interp, msg, &lc, &lv);
- if (res != TCL_OK) {
- Tcl_Panic ("TclChanCaughtErrorBypass: Bad syntax of caught result");
+ if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
+ }
+ if (interp == NULL) {
+ return;
}
- explicitResult = (1 == (lc % 2));
- numOptions = lc - explicitResult;
+ explicitResult = lc & 1; /* Odd number of values? */
+ numOptions = lc - explicitResult;
if (explicitResult) {
- Tcl_SetObjResult (interp, lv [lc-1]);
+ Tcl_SetObjResult(interp, lv[lc-1]);
}
- (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj (numOptions, lv));
+ (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
+ ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
}
int
-TclChanCaughtErrorBypass (interp, chan)
- Tcl_Interp *interp;
- Tcl_Channel chan;
+TclChanCaughtErrorBypass(
+ Tcl_Interp *interp,
+ Tcl_Channel chan)
{
- Tcl_Obj* msgc = NULL;
- Tcl_Obj* msgi = NULL;
- Tcl_Obj* msg = NULL;
+ Tcl_Obj *chanMsgObj = NULL;
+ Tcl_Obj *interpMsgObj = NULL;
+ Tcl_Obj *msgObj = NULL;
- /* Get a bypassed error message from channel and/or interpreter, save the
+ /*
+ * Get a bypassed error message from channel and/or interpreter, save the
* reference, then kill the returned objects, if there were any. If there
* are messages in both the channel has preference.
*/
@@ -900,37 +1043,39 @@ TclChanCaughtErrorBypass (interp, chan)
}
if (chan != NULL) {
- Tcl_GetChannelError (chan, &msgc);
+ Tcl_GetChannelError(chan, &chanMsgObj);
}
if (interp != NULL) {
- Tcl_GetChannelErrorInterp (interp, &msgi);
+ Tcl_GetChannelErrorInterp(interp, &interpMsgObj);
}
- if (msgc != NULL) {
- msg = msgc;
- Tcl_IncrRefCount (msg);
- } else if (msgi != NULL) {
- msg = msgi;
- Tcl_IncrRefCount (msg);
+ if (chanMsgObj != NULL) {
+ msgObj = chanMsgObj;
+ } else if (interpMsgObj != NULL) {
+ msgObj = interpMsgObj;
+ }
+ if (msgObj != NULL) {
+ Tcl_IncrRefCount(msgObj);
}
- if (msgc != NULL) {
- Tcl_DecrRefCount (msgc);
+ if (chanMsgObj != NULL) {
+ Tcl_DecrRefCount(chanMsgObj);
}
- if (msgi != NULL) {
- Tcl_DecrRefCount (msgi);
+ if (interpMsgObj != NULL) {
+ Tcl_DecrRefCount(interpMsgObj);
}
- /* No message returned, nothing caught.
+ /*
+ * No message returned, nothing caught.
*/
- if (msg == NULL) {
+ if (msgObj == NULL) {
return 0;
}
- RcErrorReturn (interp, msg);
+ UnmarshallErrorResult(interp, msgObj);
- Tcl_DecrRefCount (msg);
+ Tcl_DecrRefCount(msgObj);
return 1;
}
@@ -941,10 +1086,10 @@ TclChanCaughtErrorBypass (interp, chan)
/*
*----------------------------------------------------------------------
*
- * RcClose --
+ * ReflectClose --
*
- * This function is invoked when the channel is closed, to delete
- * the driver specific instance data.
+ * This function is invoked when the channel is closed, to delete the
+ * driver specific instance data.
*
* Results:
* A posix error.
@@ -956,110 +1101,131 @@ TclChanCaughtErrorBypass (interp, chan)
*/
static int
-RcClose (clientData, interp)
- ClientData clientData;
- Tcl_Interp* interp;
+ReflectClose(
+ ClientData clientData,
+ Tcl_Interp *interp)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- int res; /* Result code for 'close' */
- Tcl_Obj* resObj; /* Result data for 'close' */
-
- if (interp == (Tcl_Interp*) NULL) {
- /* This call comes from TclFinalizeIOSystem. There are no
- * interpreters, and therefore we cannot call upon the handler
- * command anymore. Threading is irrelevant as well. We
- * simply clean up all our C level data structures and leave
- * the Tcl level to the other finalization functions.
+ ReflectedChannel *rcPtr = clientData;
+ int result; /* Result code for 'close' */
+ Tcl_Obj *resObj; /* Result data for 'close' */
+ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+ * this interp */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
+
+ if (TclInThreadExit()) {
+ /*
+ * This call comes from TclFinalizeIOSystem. There are no
+ * interpreters, and therefore we cannot call upon the handler command
+ * anymore. Threading is irrelevant as well. We simply clean up all
+ * our C level data structures and leave the Tcl level to the other
+ * finalization functions.
*/
- /* THREADED => Forward this to the origin thread */
- /* Note: Have a thread delete handler for the origin
- * thread. Use this to clean up the structure!
- */
+ /*
+ * THREADED => Forward this to the origin thread
+ *
+ * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
+ * for the origin thread. Use this to clean up the structure? Except
+ * if lost?
+ */
#ifdef TCL_THREADS
- /* Are we in the correct thread ?
- */
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamClose p;
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
+ result = p.base.code;
- RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
- res = p.b.code;
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
- /* RcFree is done in the forwarded operation!,
- * in the other thread. rcPtr here is gone!
- */
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
- if (res != TCL_OK) {
- RcFreeReceivedError (p.b);
+ if (result != TCL_OK) {
+ FreeReceivedError(&p);
}
- } else {
-#endif
- RcFree (rcPtr);
-#ifdef TCL_THREADS
+ return EOK;
}
#endif
+
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
- /* -------- */
-
- /* -- No -- ASSERT rcPtr->methods & FLAG (METH_FINAL) */
-
- /* A cleaned method mask here implies that the channel creation
- * was aborted, and "finalize" must not be called.
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->methods == 0) {
- RcFree (rcPtr);
- return EOK;
- } else {
#ifdef TCL_THREADS
- /* Are we in the correct thread ?
- */
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamClose p;
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
+ result = p.base.code;
- RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
- res = p.b.code;
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
- /* RcFree is done in the forwarded operation!,
- * in the other thread. rcPtr here is gone!
- */
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
- if (res != TCL_OK) {
- RcPassReceivedErrorInterp (interp, p.b);
- }
- } else {
+ if (result != TCL_OK) {
+ PassReceivedErrorInterp(interp, &p);
+ }
+ } else {
#endif
- RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
+ result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
+ if ((result != TCL_OK) && (interp != NULL)) {
+ Tcl_SetChannelErrorInterp(interp, resObj);
+ }
- if ((res != TCL_OK) && (interp != NULL)) {
- Tcl_SetChannelErrorInterp (interp, resObj);
- }
+ Tcl_DecrRefCount(resObj); /* Remove reference we held from the
+ * invoke */
+
+ /*
+ * Remove the channel from the map before releasing the memory, to
+ * prevent future accesses (like by 'postevent') from finding and
+ * dereferencing a dangling pointer.
+ *
+ * NOTE: The channel may not be in the map. This is ok, that happens
+ * when the channel was created in a different interpreter and/or
+ * thread and then was moved here.
+ *
+ * NOTE: The channel may have been removed from the map already via
+ * the per-interp DeleteReflectedChannelMap exit-handler.
+ */
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ if (!rcPtr->dead) {
+ rcmPtr = GetReflectedChannelMap(rcPtr->interp);
+ hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+ Tcl_GetChannelName(rcPtr->chan));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
#ifdef TCL_THREADS
- RcFree (rcPtr);
+ rcmPtr = GetThreadReflectedChannelMap();
+ hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+ Tcl_GetChannelName(rcPtr->chan));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
}
#endif
- return (res == TCL_OK) ? EOK : EINVAL;
- }
- Tcl_Panic ("Should not be reached");
- return EINVAL;
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+#ifdef TCL_THREADS
+ }
+#endif
+ return (result == TCL_OK) ? EOK : EINVAL;
}
/*
*----------------------------------------------------------------------
*
- * RcInput --
+ * ReflectInput --
*
- * This function is invoked when more data is requested from the
- * channel.
+ * This function is invoked when more data is requested from the channel.
*
* Results:
* The number of bytes read.
@@ -1071,99 +1237,99 @@ RcClose (clientData, interp)
*/
static int
-RcInput (clientData, buf, toRead, errorCodePtr)
- ClientData clientData;
- char* buf;
- int toRead;
- int* errorCodePtr;
+ReflectInput(
+ ClientData clientData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* toReadObj;
- int bytec; /* Number of returned bytes */
- unsigned char* bytev; /* Array of returned bytes */
- int res; /* Result code for 'read' */
- Tcl_Obj* resObj; /* Result data for 'read' */
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *toReadObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+ Tcl_Obj *resObj; /* Result data for 'read' */
- /* The following check can be done before thread redirection,
- * because we are reading from an item which is readonly, i.e.
- * will never change during the lifetime of the channel.
+ /*
+ * Are we in the correct thread?
*/
- if (!(rcPtr->methods & FLAG (METH_READ))) {
- RcSetChannelErrorStr (rcPtr->chan, msg_read_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
#ifdef TCL_THREADS
- /* Are we in the correct thread ?
- */
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamInput p;
+ p.input.buf = buf;
+ p.input.toRead = toRead;
- p.buf = buf;
- p.toRead = toRead;
+ ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
- RcForwardOp (rcPtr, RcOpInput, rcPtr->thread, &p);
-
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
- *errorCodePtr = EINVAL;
+ if (p.base.code != TCL_OK) {
+ if (p.base.code < 0) {
+ /* No error message, this is an errno signal. */
+ *errorCodePtr = -p.base.code;
+ } else {
+ PassReceivedError(rcPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ }
+ p.input.toRead = -1;
} else {
*errorCodePtr = EOK;
}
- return p.toRead;
+ return p.input.toRead;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_READ) */
+ /* ASSERT: rcPtr->method & FLAG(METH_READ) */
/* ASSERT: rcPtr->mode & TCL_READABLE */
+ Tcl_Preserve(rcPtr);
+
toReadObj = Tcl_NewIntObj(toRead);
- if (toReadObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInput");
- }
+ Tcl_IncrRefCount(toReadObj);
- RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
- &res, &resObj, DO_CAPTURE);
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
+ int code = ErrnoReturn(rcPtr, resObj);
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- *errorCodePtr = EINVAL;
- return -1;
+ if (code < 0) {
+ *errorCodePtr = -code;
+ goto error;
+ }
+
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ goto invalid;
}
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
if (toRead < bytec) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- RcSetChannelErrorStr (rcPtr->chan, msg_read_toomuch);
- *errorCodePtr = EINVAL;
- return -1;
+ SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
+ goto invalid;
}
*errorCodePtr = EOK;
if (bytec > 0) {
- memcpy (buf, bytev, bytec);
+ memcpy(buf, bytev, (size_t) bytec);
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ stop:
+ Tcl_DecrRefCount(toReadObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
return bytec;
+ invalid:
+ *errorCodePtr = EINVAL;
+ error:
+ bytec = -1;
+ goto stop;
}
/*
*----------------------------------------------------------------------
*
- * RcOutput --
+ * ReflectOutput --
*
- * This function is invoked when data is writen to the
- * channel.
+ * This function is invoked when data is writen to the channel.
*
* Results:
* The number of bytes actually written.
@@ -1175,105 +1341,111 @@ RcInput (clientData, buf, toRead, errorCodePtr)
*/
static int
-RcOutput (clientData, buf, toWrite, errorCodePtr)
- ClientData clientData;
- CONST char* buf;
- int toWrite;
- int* errorCodePtr;
+ReflectOutput(
+ ClientData clientData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* bufObj;
- int res; /* Result code for 'write' */
- Tcl_Obj* resObj; /* Result data for 'write' */
- int written;
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *bufObj;
+ Tcl_Obj *resObj; /* Result data for 'write' */
+ int written;
- /* The following check can be done before thread redirection,
- * because we are reading from an item which is readonly, i.e.
- * will never change during the lifetime of the channel.
+ /*
+ * Are we in the correct thread?
*/
- if (!(rcPtr->methods & FLAG (METH_WRITE))) {
- RcSetChannelErrorStr (rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
#ifdef TCL_THREADS
- /* Are we in the correct thread ?
- */
-
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamOutput p;
-
- p.buf = buf;
- p.toWrite = toWrite;
-
- RcForwardOp (rcPtr, RcOpOutput, rcPtr->thread, &p);
-
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
- *errorCodePtr = EINVAL;
- } else {
- *errorCodePtr = EOK;
- }
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ p.output.buf = buf;
+ p.output.toWrite = toWrite;
+
+ ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
+
+ if (p.base.code != TCL_OK) {
+ if (p.base.code < 0) {
+ /* No error message, this is an errno signal. */
+ *errorCodePtr = -p.base.code;
+ } else {
+ PassReceivedError(rcPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ }
+ p.output.toWrite = -1;
+ } else {
+ *errorCodePtr = EOK;
+ }
- return p.toWrite;
+ return p.output.toWrite;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_WRITE) */
+ /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
-
- bufObj = Tcl_NewByteArrayObj((unsigned char*) buf, toWrite);
- if (bufObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcOutput");
- }
- RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
- &res, &resObj, DO_CAPTURE);
+ Tcl_Preserve(rcPtr);
+
+ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+ Tcl_IncrRefCount(bufObj);
+
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
+ int code = ErrnoReturn(rcPtr, resObj);
+
+ if (code < 0) {
+ *errorCodePtr = -code;
+ goto error;
+ }
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- *errorCodePtr = EINVAL;
- return -1;
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ goto invalid;
}
- res = Tcl_GetIntFromObj (rcPtr->interp, resObj, &written);
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
- *errorCodePtr = EINVAL;
- return -1;
+ if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
+ goto invalid;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ if ((written == 0) && (toWrite > 0)) {
+ /*
+ * The handler claims to have written nothing of what it was
+ * given. That is bad.
+ */
- if ((written == 0) || (toWrite < written)) {
- /* The handler claims to have written more than it was given.
- * That is bad. Note that the I/O core would crash if we were
- * to return this information, trying to write -nnn bytes in
- * the next iteration.
+ SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
+ goto invalid;
+ }
+ if (toWrite < written) {
+ /*
+ * The handler claims to have written more than it was given. That is
+ * bad. Note that the I/O core would crash if we were to return this
+ * information, trying to write -nnn bytes in the next iteration.
*/
- RcSetChannelErrorStr (rcPtr->chan, msg_write_toomuch);
- *errorCodePtr = EINVAL;
- return -1;
+ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch);
+ goto invalid;
}
*errorCodePtr = EOK;
+ stop:
+ Tcl_DecrRefCount(bufObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
return written;
+ invalid:
+ *errorCodePtr = EINVAL;
+ error:
+ written = -1;
+ goto stop;
}
/*
*----------------------------------------------------------------------
*
- * RcSeekWide / RcSeek --
+ * ReflectSeekWide / ReflectSeek --
*
- * This function is invoked when the user wishes to seek on
- * the channel.
+ * This function is invoked when the user wishes to seek on the channel.
*
* Results:
* The new location of the access point.
@@ -1285,115 +1457,106 @@ RcOutput (clientData, buf, toWrite, errorCodePtr)
*/
static Tcl_WideInt
-RcSeekWide (clientData, offset, seekMode, errorCodePtr)
- ClientData clientData;
- Tcl_WideInt offset;
- int seekMode;
- int* errorCodePtr;
+ReflectSeekWide(
+ ClientData clientData,
+ Tcl_WideInt offset,
+ int seekMode,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* offObj;
- Tcl_Obj* baseObj;
- int res; /* Result code for 'seek' */
- Tcl_Obj* resObj; /* Result data for 'seek' */
- Tcl_WideInt newLoc;
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *offObj, *baseObj;
+ Tcl_Obj *resObj; /* Result for 'seek' */
+ Tcl_WideInt newLoc;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamSeek p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.seekMode = seekMode;
- p.offset = offset;
+ p.seek.seekMode = seekMode;
+ p.seek.offset = offset;
- RcForwardOp (rcPtr, RcOpSeek, rcPtr->thread, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
*errorCodePtr = EINVAL;
+ p.seek.offset = -1;
} else {
*errorCodePtr = EOK;
}
- return p.offset;
+ return p.seek.offset;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_SEEK) */
-
- offObj = Tcl_NewWideIntObj(offset);
- if (offObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ?
- "start" :
- ((seekMode == SEEK_CUR) ?
- "current" :
- "end"), -1);
+ /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */
- if (baseObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
+ Tcl_Preserve(rcPtr);
- RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
- &res, &resObj, DO_CAPTURE);
+ offObj = Tcl_NewWideIntObj(offset);
+ baseObj = Tcl_NewStringObj(
+ (seekMode == SEEK_SET) ? "start" :
+ (seekMode == SEEK_CUR) ? "current" : "end", -1);
+ Tcl_IncrRefCount(offObj);
+ Tcl_IncrRefCount(baseObj);
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- *errorCodePtr = EINVAL;
- return -1;
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ goto invalid;
}
- res = Tcl_GetWideIntFromObj (rcPtr->interp, resObj, &newLoc);
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
- *errorCodePtr = EINVAL;
- return -1;
+ if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
+ goto invalid;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
-
- if (newLoc < Tcl_LongAsWide (0)) {
- RcSetChannelErrorStr (rcPtr->chan, msg_seek_beforestart);
- *errorCodePtr = EINVAL;
- return -1;
+ if (newLoc < Tcl_LongAsWide(0)) {
+ SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
+ goto invalid;
}
*errorCodePtr = EOK;
+ stop:
+ Tcl_DecrRefCount(offObj);
+ Tcl_DecrRefCount(baseObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
return newLoc;
+ invalid:
+ *errorCodePtr = EINVAL;
+ newLoc = -1;
+ goto stop;
}
static int
-RcSeek (clientData, offset, seekMode, errorCodePtr)
- ClientData clientData;
- long offset;
- int seekMode;
- int* errorCodePtr;
+ReflectSeek(
+ ClientData clientData,
+ long offset,
+ int seekMode,
+ int *errorCodePtr)
{
- /* This function can be invoked from a transformation which is based
- * on standard seeking, i.e. non-wide. Because o this we have to
- * implement it, a dummy is not enough. We simply delegate the call
- * to the wide routine.
- */
-
- return (int) RcSeekWide (clientData, Tcl_LongAsWide (offset),
- seekMode, errorCodePtr);
+ /*
+ * This function can be invoked from a transformation which is based on
+ * standard seeking, i.e. non-wide. Because of this we have to implement
+ * it, a dummy is not enough. We simply delegate the call to the wide
+ * routine.
+ */
+
+ return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+ errorCodePtr);
}
/*
*----------------------------------------------------------------------
*
- * RcWatch --
+ * ReflectWatch --
*
- * This function is invoked to tell the channel what events
- * the I/O system is interested in.
+ * This function is invoked to tell the channel what events the I/O
+ * system is interested in.
*
* Results:
* None.
@@ -1405,62 +1568,68 @@ RcSeek (clientData, offset, seekMode, errorCodePtr)
*/
static void
-RcWatch (clientData, mask)
- ClientData clientData;
- int mask;
+ReflectWatch(
+ ClientData clientData,
+ int mask)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* maskObj;
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG (METH_WATCH) */
-
- /* We restrict the interest to what the channel can support
- * IOW there will never be write events for a channel which is
- * not writable. Analoguous for read events.
+ /*
+ * We restrict the interest to what the channel can support. IOW there
+ * will never be write events for a channel which is not writable.
+ * Analoguously for read events and non-readable channels.
*/
- mask = mask & rcPtr->mode;
+ mask &= rcPtr->mode;
if (mask == rcPtr->interest) {
- /* Same old, same old, why should we do something ? */
- return;
+ /*
+ * Same old, same old, why should we do something?
+ */
+
+ return;
}
rcPtr->interest = mask;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamWatch p;
-
- p.mask = mask;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- RcForwardOp (rcPtr, RcOpWatch, rcPtr->thread, &p);
+ p.watch.mask = mask;
+ ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
- /* Any failure from the forward is ignored. We have no place to
- * put this.
+ /*
+ * Any failure from the forward is ignored. We have no place to put
+ * this.
*/
+
return;
}
#endif
- /* -------- */
+ Tcl_Preserve(rcPtr);
+
+ maskObj = DecodeEventMask(mask);
+ /* assert maskObj.refCount == 1 */
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
+ Tcl_DecrRefCount(maskObj);
- maskObj = RcDecodeEventMask (mask);
- RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
- NULL, NULL, NO_CAPTURE);
- Tcl_DecrRefCount (maskObj);
+ Tcl_Release(rcPtr);
}
/*
*----------------------------------------------------------------------
*
- * RcBlock --
+ * ReflectBlock --
*
- * This function is invoked to tell the channel which blocking
- * behaviour is required of it.
+ * This function is invoked to tell the channel which blocking behaviour
+ * is required of it.
*
* Results:
* A posix error number.
@@ -1472,60 +1641,97 @@ RcWatch (clientData, mask)
*/
static int
-RcBlock (clientData, nonblocking)
- ClientData clientData;
- int nonblocking;
+ReflectBlock(
+ ClientData clientData,
+ int nonblocking)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* blockObj;
- int res; /* Result code for 'blocking' */
- Tcl_Obj* resObj; /* Result data for 'blocking' */
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *blockObj;
+ int errorNum; /* EINVAL or EOK (success). */
+ Tcl_Obj *resObj; /* Result data for 'blocking' */
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamBlock p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.nonblocking = nonblocking;
+ p.block.nonblocking = nonblocking;
- RcForwardOp (rcPtr, RcOpBlock, rcPtr->thread, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
return EINVAL;
- } else {
- return EOK;
}
+
+ return EOK;
}
#endif
- /* -------- */
-
blockObj = Tcl_NewBooleanObj(!nonblocking);
- if (blockObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcBlock");
- }
+ Tcl_IncrRefCount(blockObj);
- RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
- &res, &resObj, DO_CAPTURE);
+ Tcl_Preserve(rcPtr);
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- res = EINVAL;
+ if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ errorNum = EINVAL;
} else {
- res = EOK;
+ errorNum = EOK;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DecrRefCount(blockObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+
+ Tcl_Release(rcPtr);
+ return errorNum;
}
+#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
- * RcSetOption --
+ * 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
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSetOption --
*
* This function is invoked to configure a channel option.
*
@@ -1539,70 +1745,65 @@ RcBlock (clientData, nonblocking)
*/
static int
-RcSetOption (clientData, interp, optionName, newValue)
- ClientData clientData; /* Channel to query */
- Tcl_Interp *interp; /* Interpreter to leave error messages in */
- CONST char *optionName; /* Name of requested option */
- CONST char *newValue; /* The new value */
+ReflectSetOption(
+ ClientData clientData, /* Channel to query */
+ Tcl_Interp *interp, /* Interpreter to leave error messages in */
+ const char *optionName, /* Name of requested option */
+ const char *newValue) /* The new value */
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* optionObj;
- Tcl_Obj* valueObj;
- int res; /* Result code for 'configure' */
- Tcl_Obj* resObj; /* Result data for 'configure' */
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *optionObj, *valueObj;
+ int result; /* Result code for 'configure' */
+ Tcl_Obj *resObj; /* Result data for 'configure' */
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamSetOpt p;
-
- p.name = optionName;
- p.value = newValue;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- RcForwardOp (rcPtr, RcOpSetOpt, rcPtr->thread, &p);
+ p.setOpt.name = optionName;
+ p.setOpt.value = newValue;
- if (p.b.code != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
- RcErrorReturn (interp, err);
+ if (p.base.code != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
- Tcl_DecrRefCount (err);
- if (p.b.vol) {ckfree (p.b.msg);}
+ UnmarshallErrorResult(interp, err);
+ Tcl_DecrRefCount(err);
+ FreeReceivedError(&p);
}
- return p.b.code;
+ return p.base.code;
}
#endif
+ Tcl_Preserve(rcPtr);
- /* -------- */
-
- optionObj = Tcl_NewStringObj(optionName,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
+ optionObj = Tcl_NewStringObj(optionName, -1);
+ valueObj = Tcl_NewStringObj(newValue, -1);
- valueObj = Tcl_NewStringObj(newValue,-1);
- if (valueObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
+ Tcl_IncrRefCount(optionObj);
+ Tcl_IncrRefCount(valueObj);
- RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcErrorReturn (interp, resObj);
- }
+ result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
+ if (result != TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ }
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DecrRefCount(optionObj);
+ Tcl_DecrRefCount(valueObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * RcGetOption --
+ * ReflectGetOption --
*
* This function is invoked to retrieve all or a channel option.
*
@@ -1616,135 +1817,139 @@ RcSetOption (clientData, interp, optionName, newValue)
*/
static int
-RcGetOption (clientData, interp, optionName, dsPtr)
- ClientData clientData; /* Channel to query */
- Tcl_Interp* interp; /* Interpreter to leave error messages in */
- CONST char* optionName; /* Name of reuqested option */
- Tcl_DString* dsPtr; /* String to place the result into */
+ReflectGetOption(
+ ClientData clientData, /* Channel to query */
+ Tcl_Interp *interp, /* Interpreter to leave error messages in */
+ const char *optionName, /* Name of reuqested option */
+ Tcl_DString *dsPtr) /* String to place the result into */
{
- /* This code is special. It has regular passing of Tcl result, and
- * errors. The bypass functions are not required.
+ /*
+ * This code is special. It has regular passing of Tcl result, and errors.
+ * The bypass functions are not required.
*/
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* optionObj;
- int res; /* Result code for 'configure' */
- Tcl_Obj* resObj; /* Result data for 'configure' */
- int listc;
- Tcl_Obj** listv;
- const char* method;
+ ReflectedChannel *rcPtr = clientData;
+ Tcl_Obj *optionObj;
+ Tcl_Obj *resObj; /* Result data for 'configure' */
+ int listc, result = TCL_OK;
+ Tcl_Obj **listv;
+ MethodName method;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- int opcode;
- RcForwardParamGetOpt p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ int opcode;
+ ForwardParam p;
- p.name = optionName;
- p.value = dsPtr;
+ p.getOpt.name = optionName;
+ p.getOpt.value = dsPtr;
- if (optionName == (char*) NULL) {
- opcode = RcOpGetOptAll;
+ if (optionName == NULL) {
+ opcode = ForwardedGetOptAll;
} else {
- opcode = RcOpGetOpt;
+ opcode = ForwardedGetOpt;
}
- RcForwardOp (rcPtr, opcode, rcPtr->thread, &p);
-
- if (p.b.code != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+ ForwardOpToHandlerThread(rcPtr, opcode, &p);
- RcErrorReturn (interp, err);
+ if (p.base.code != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
- Tcl_DecrRefCount (err);
- if (p.b.vol) {ckfree (p.b.msg);}
+ UnmarshallErrorResult(interp, err);
+ Tcl_DecrRefCount(err);
+ FreeReceivedError(&p);
}
- return p.b.code;
+ return p.base.code;
}
#endif
- /* -------- */
+ if (optionName == NULL) {
+ /*
+ * Retrieve all options.
+ */
- if (optionName == (char*) NULL) {
- /* Retrieve all options. */
- method = "cgetall";
+ method = METH_CGETALL;
optionObj = NULL;
} else {
- /* Retrieve the value of one option */
-
- method = "cget";
- optionObj = Tcl_NewStringObj(optionName,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcGetOption");
- }
+ /*
+ * Retrieve the value of one option.
+ */
+
+ method = METH_CGET;
+ optionObj = Tcl_NewStringObj(optionName, -1);
+ Tcl_IncrRefCount(optionObj);
}
- RcInvokeTclMethod (rcPtr, method, optionObj, NULL,
- &res, &resObj, DO_CAPTURE);
+ Tcl_Preserve(rcPtr);
- if (res != TCL_OK) {
- RcErrorReturn (interp, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ goto error;
}
- /* The result has to go into the 'dsPtr' for propagation to the
- * caller of the driver.
+ /*
+ * The result has to go into the 'dsPtr' for propagation to the caller of
+ * the driver.
*/
if (optionObj != NULL) {
- Tcl_DStringAppend (dsPtr, Tcl_GetString (resObj), -1);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ TclDStringAppendObj(dsPtr, resObj);
+ goto ok;
}
- /* Extract the list and append each item as element.
+ /*
+ * Extract the list and append each item as element.
*/
- /* NOTE (4): If we extract the string rep we can assume a
- * NOTE (4): properly quoted string. Together with a separating
- * NOTE (4): space this way of simply appending the whole string
- * NOTE (4): rep might be faster. It also doesn't check if the
- * NOTE (4): result is a valid list. Nor that the list has an
- * NOTE (4): even number elements.
- * NOTE (4): ---
+ /*
+ * NOTE (4): If we extract the string rep we can assume a properly quoted
+ * string. Together with a separating space this way of simply appending
+ * the whole string rep might be faster. It also doesn't check if the
+ * result is a valid list. Nor that the list has an even number elements.
*/
- res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
-
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+ goto error;
}
if ((listc % 2) == 1) {
- /* Odd number of elements is wrong.
+ /*
+ * Odd number of elements is wrong.
*/
- Tcl_Obj *objPtr = Tcl_NewObj();
- Tcl_ResetResult(interp);
- TclObjPrintf(NULL, objPtr, "Expected list with even number of "
- "elements, got %d element%s instead", listc,
- (listc == 1 ? "" : "s"));
- Tcl_SetObjResult(interp, objPtr);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return TCL_ERROR;
- }
-
- {
- int len;
- char* str = Tcl_GetStringFromObj (resObj, &len);
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Expected list with even number of "
+ "elements, got %d element%s instead", listc,
+ (listc == 1 ? "" : "s")));
+ goto error;
+ } else {
+ int len;
+ const char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend (dsPtr, " ", 1);
- Tcl_DStringAppend (dsPtr, str, len);
+ TclDStringAppendLiteral(dsPtr, " ");
+ Tcl_DStringAppend(dsPtr, str, len);
}
+ goto ok;
+ }
+
+ ok:
+ result = TCL_OK;
+ stop:
+ if (optionObj) {
+ Tcl_DecrRefCount(optionObj);
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
+ return result;
+ error:
+ result = TCL_ERROR;
+ goto stop;
}
/*
@@ -1754,58 +1959,61 @@ RcGetOption (clientData, interp, optionName, dsPtr)
/*
*----------------------------------------------------------------------
*
- * RcEncodeEventMask --
+ * EncodeEventMask --
*
* This function takes a list of event items and constructs the
- * equivalent internal bitmask. The list has to contain at
- * least one element. Elements are "read", "write", or any unique
- * abbreviation thereof. Note that the bitmask is not changed if
- * problems are encountered.
+ * equivalent internal bitmask. The list must contain at least one
+ * element. Elements are "read", "write", or any unique abbreviation of
+ * them. Note that the bitmask is not changed if problems are
+ * encountered.
*
* Results:
- * A standard Tcl error code. A bitmask where TCL_READABLE
- * and/or TCL_WRITABLE can be set.
+ * A standard Tcl error code. A bitmask where TCL_READABLE and/or
+ * TCL_WRITABLE can be set.
*
* Side effects:
- * May shimmer 'obj' to a list representation. May place an
- * error message into the interp result.
+ * May shimmer 'obj' to a list representation. May place an error message
+ * into the interp result.
*
*----------------------------------------------------------------------
*/
static int
-RcEncodeEventMask (interp, objName, obj, mask)
- Tcl_Interp* interp;
- CONST char* objName;
- Tcl_Obj* obj;
- int* mask;
+EncodeEventMask(
+ Tcl_Interp *interp,
+ const char *objName,
+ Tcl_Obj *obj,
+ int *mask)
{
- int events; /* Mask of events to post */
- int listc; /* #elements in eventspec list */
- Tcl_Obj** listv; /* Elements of eventspec list */
- int evIndex; /* Id of event for an element of the
- * eventspec list */
+ int events; /* Mask of events to post */
+ int listc; /* #elements in eventspec list */
+ Tcl_Obj **listv; /* Elements of eventspec list */
+ int evIndex; /* Id of event for an element of the eventspec
+ * list. */
- if (Tcl_ListObjGetElements (interp, obj,
- &listc, &listv) != TCL_OK) {
- return TCL_ERROR;
+ if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
+ return TCL_ERROR;
}
if (listc < 1) {
- Tcl_AppendResult(interp, "bad ", objName, " list: is empty",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad %s list: is empty", objName));
return TCL_ERROR;
}
events = 0;
while (listc > 0) {
- if (Tcl_GetIndexFromObj (interp, listv [listc-1],
- eventOptions, objName, 0, &evIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
+ objName, 0, &evIndex) != TCL_OK) {
return TCL_ERROR;
}
switch (evIndex) {
- case EVENT_READ: events |= TCL_READABLE; break;
- case EVENT_WRITE: events |= TCL_WRITABLE; break;
+ case EVENT_READ:
+ events |= TCL_READABLE;
+ break;
+ case EVENT_WRITE:
+ events |= TCL_WRITABLE;
+ break;
}
listc --;
}
@@ -1817,14 +2025,14 @@ RcEncodeEventMask (interp, objName, obj, mask)
/*
*----------------------------------------------------------------------
*
- * RcDecodeEventMask --
+ * DecodeEventMask --
*
- * This function takes an internal bitmask of events and
- * constructs the equivalent list of event items.
+ * This function takes an internal bitmask of events and constructs the
+ * equivalent list of event items.
*
- * Results:
- * A Tcl_Obj reference. The object will have a refCount of
- * one. The user has to decrement it to release the object.
+ * Results, Contract:
+ * A Tcl_Obj reference. The object will have a refCount of one. The user
+ * has to decrement it to release the object.
*
* Side effects:
* None.
@@ -1832,31 +2040,41 @@ RcEncodeEventMask (interp, objName, obj, mask)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-RcDecodeEventMask (mask)
- int mask;
+static Tcl_Obj *
+DecodeEventMask(
+ int mask)
{
- Tcl_Obj* evObj = Tcl_NewStringObj (((mask & RANDW) == RANDW) ?
- "read write" :
- ((mask & TCL_READABLE) ?
- "read" :
- ((mask & TCL_WRITABLE) ?
- "write" : "")), -1);
- if (evObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcDecodeEventMask");
+ register const char *eventStr;
+ Tcl_Obj *evObj;
+
+ switch (mask & RANDW) {
+ case RANDW:
+ eventStr = "read write";
+ break;
+ case TCL_READABLE:
+ eventStr = "read";
+ break;
+ case TCL_WRITABLE:
+ eventStr = "write";
+ break;
+ default:
+ eventStr = "";
+ break;
}
- Tcl_IncrRefCount (evObj);
+ evObj = Tcl_NewStringObj(eventStr, -1);
+ Tcl_IncrRefCount(evObj);
+ /* assert evObj.refCount == 1 */
return evObj;
}
/*
*----------------------------------------------------------------------
*
- * RcNew --
+ * NewReflectedChannel --
*
- * This function is invoked to allocate and initialize the
- * instance data of a new reflected channel.
+ * This function is invoked to allocate and initialize the instance data
+ * of a new reflected channel.
*
* Results:
* A heap-allocated channel instance.
@@ -1867,691 +2085,1078 @@ RcDecodeEventMask (mask)
*----------------------------------------------------------------------
*/
-static ReflectingChannel*
-RcNew (interp, cmdpfxObj, mode, id)
- Tcl_Interp* interp;
- Tcl_Obj* cmdpfxObj;
- int mode;
- Tcl_Obj* id;
+static ReflectedChannel *
+NewReflectedChannel(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdpfxObj,
+ int mode,
+ Tcl_Obj *handleObj)
{
- ReflectingChannel* rcPtr;
- int listc;
- Tcl_Obj** listv;
- Tcl_Obj* word;
- int i;
+ ReflectedChannel *rcPtr;
+ MethodName mn = METH_BLOCKING;
- rcPtr = (ReflectingChannel*) ckalloc (sizeof(ReflectingChannel));
+ rcPtr = ckalloc(sizeof(ReflectedChannel));
- /* rcPtr->chan : Assigned by caller. Dummy data here. */
- /* rcPtr->methods : Assigned by caller. Dummy data here. */
+ /* rcPtr->chan: Assigned by caller. Dummy data here. */
- rcPtr->chan = (Tcl_Channel) NULL;
- rcPtr->methods = 0;
- rcPtr->interp = interp;
+ rcPtr->chan = NULL;
+ rcPtr->interp = interp;
+ rcPtr->dead = 0;
#ifdef TCL_THREADS
- rcPtr->thread = Tcl_GetCurrentThread ();
+ rcPtr->thread = Tcl_GetCurrentThread();
#endif
- rcPtr->mode = mode;
- rcPtr->interest = 0; /* Initially no interest registered */
-
- /* Method placeholder */
+ rcPtr->mode = mode;
+ rcPtr->interest = 0; /* Initially no interest registered */
/* ASSERT: cmdpfxObj is a Tcl List */
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
+ rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+ while (mn <= METH_WRITE) {
+ Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+ Tcl_NewStringObj(methodNames[mn++], -1));
+ }
+ Tcl_IncrRefCount(rcPtr->methods);
+ rcPtr->name = handleObj;
+ Tcl_IncrRefCount(rcPtr->name);
+ return rcPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextHandle --
+ *
+ * This function is invoked to generate a channel handle for a new
+ * reflected channel.
+ *
+ * Results:
+ * A Tcl_Obj containing the string of the new channel handle. The
+ * refcount of the returned object is -- zero --.
+ *
+ * Side effects:
+ * May allocate memory. Mutex protected critical section locks out other
+ * threads for a short time.
+ *
+ *----------------------------------------------------------------------
+ */
- Tcl_ListObjGetElements (interp, cmdpfxObj, &listc, &listv);
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required
- * for the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
+static Tcl_Obj *
+NextHandle(void)
+{
+ /*
+ * Count number of generated reflected channels. Used for id generation.
+ * Ids are never reclaimed and there is no dealing with wrap around. On
+ * the other hand, "unsigned long" should be big enough except for
+ * absolute longrunners (generate a 100 ids per second => overflow will
+ * occur in 1 1/3 years).
*/
- rcPtr->argc = listc + 2;
- rcPtr->argv = (Tcl_Obj**) ckalloc (sizeof (Tcl_Obj*) * (listc+4));
-
- for (i = 0; i < listc ; i++) {
- word = rcPtr->argv [i] = listv [i];
- Tcl_IncrRefCount (word);
- }
+ TCL_DECLARE_MUTEX(rcCounterMutex)
+ static unsigned long rcCounter = 0;
+ Tcl_Obj *resObj;
- i++; /* Skip placeholder for method */
+ Tcl_MutexLock(&rcCounterMutex);
+ resObj = Tcl_ObjPrintf("rc%lu", rcCounter);
+ rcCounter++;
+ Tcl_MutexUnlock(&rcCounterMutex);
- rcPtr->argv [i] = id ; Tcl_IncrRefCount (id);
+ return resObj;
+}
+
+static void
+FreeReflectedChannel(
+ ReflectedChannel *rcPtr)
+{
+ Channel *chanPtr = (Channel *) rcPtr->chan;
- /* The next two objects are kept empty, varying arguments */
+ if (chanPtr->typePtr != &tclRChannelType) {
+ /*
+ * Delete a cloned ChannelType structure.
+ */
- /* Initialization complete */
- return rcPtr;
+ ckfree(chanPtr->typePtr);
+ chanPtr->typePtr = NULL;
+ }
+ Tcl_Release(chanPtr);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree(rcPtr);
}
/*
*----------------------------------------------------------------------
*
- * RcNewHandle --
+ * InvokeTclMethod --
*
- * This function is invoked to generate a channel handle for
- * a new reflected channel.
+ * This function is used to invoke the Tcl level of a reflected channel.
+ * It handles all the command assembly, invokation, and generic state and
+ * result mgmt. It does *not* handle thread redirection; that is the
+ * responsibility of clients of this function.
*
* Results:
- * A Tcl_Obj containing the string of the new channel handle.
- * The refcount of the returned object is -- zero --.
+ * Result code and data as returned by the method.
*
* Side effects:
- * May allocate memory. Mutex protected critical section
- * locks out other threads for a short time.
+ * Arbitrary, as it calls upon a Tcl script.
+ *
+ * Contract:
+ * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
+ * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
+ * resObj.refCount in {0, 1, ...}
*
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-RcNewHandle ()
+static int
+InvokeTclMethod(
+ ReflectedChannel *rcPtr,
+ MethodName method,
+ Tcl_Obj *argOneObj, /* NULL'able */
+ Tcl_Obj *argTwoObj, /* NULL'able */
+ Tcl_Obj **resultObjPtr) /* NULL'able */
{
- /* Count number of generated reflected channels. Used for id
- * generation. Ids are never reclaimed and there is no dealing
- * with wrap around. On the other hand, "unsigned long" should be
- * big enough except for absolute longrunners (generate a 100 ids
- * per second => overflow will occur in 1 1/3 years).
+ Tcl_Obj *methObj = NULL; /* Method name in object form */
+ Tcl_InterpState sr; /* State of handler interp */
+ int result; /* Result code of method invokation */
+ Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
+
+ if (rcPtr->dead) {
+ /*
+ * The channel is marked as dead. Bail out immediately, with an
+ * appropriate error.
+ */
+
+ if (resultObjPtr != NULL) {
+ resObj = Tcl_NewStringObj(msg_dstlost,-1);
+ *resultObjPtr = resObj;
+ Tcl_IncrRefCount(resObj);
+ }
+
+ /*
+ * Not touching argOneObj, argTwoObj, they have not been used.
+ * See the contract as well.
+ */
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Insert method into the callback command, after the command prefix,
+ * before the channel id.
*/
-#ifdef TCL_THREADS
- TCL_DECLARE_MUTEX (rcCounterMutex)
-#endif
- static unsigned long rcCounter = 0;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
- Tcl_Obj* res = Tcl_NewObj ();
+ Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
-#ifdef TCL_THREADS
- Tcl_MutexLock (&rcCounterMutex);
-#endif
+ /*
+ * Append the additional argument containing method specific details
+ * behind the channel id. If specified.
+ *
+ * Because of the contract there is no need to increment the refcounts.
+ * The objects will survive the Tcl_EvalObjv without change.
+ */
- TclObjPrintf(NULL, res, "rc%lu", rcCounter);
- rcCounter ++;
+ if (argOneObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
+ if (argTwoObj) {
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
+ }
+ }
-#ifdef TCL_THREADS
- Tcl_MutexUnlock (&rcCounterMutex);
-#endif
+ /*
+ * And run the handler... This is done in auch a manner which leaves any
+ * existing state intact.
+ */
+
+ Tcl_IncrRefCount(cmd);
+ sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+ Tcl_Preserve(rcPtr->interp);
+ result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
+
+ /*
+ * We do not try to extract the result information if the caller has no
+ * interest in it. I.e. there is no need to put effort into creating
+ * something which is discarded immediately after.
+ */
+
+ if (resultObjPtr) {
+ if (result == TCL_OK) {
+ /*
+ * Ok result taken as is, also if the caller requests that there
+ * is no capture.
+ */
+
+ resObj = Tcl_GetObjResult(rcPtr->interp);
+ } else {
+ /*
+ * Non-ok result is always treated as an error. We have to capture
+ * the full state of the result, including additional options.
+ *
+ * This is complex and ugly, and would be completely unnecessary
+ * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
+ */
+
+ if (result != TCL_ERROR) {
+ int cmdLen;
+ const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+
+ Tcl_IncrRefCount(cmd);
+ Tcl_ResetResult(rcPtr->interp);
+ Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
+ "chan handler returned bad code: %d", result));
+ Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
+ cmdLen);
+ Tcl_DecrRefCount(cmd);
+ result = TCL_ERROR;
+ }
+ Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
+ "\n (chan handler subcommand \"%s\")",
+ methodNames[method]));
+ resObj = MarshallError(rcPtr->interp);
+ }
+ Tcl_IncrRefCount(resObj);
+ }
+ Tcl_DecrRefCount(cmd);
+ Tcl_RestoreInterpState(rcPtr->interp, sr);
+ Tcl_Release(rcPtr->interp);
+
+ /*
+ * The resObj has a ref count of 1 at this location. This means that the
+ * caller of InvokeTclMethod has to dispose of it (but only if it was
+ * returned to it).
+ */
- return res;
+ if (resultObjPtr != NULL) {
+ *resultObjPtr = resObj;
+ }
+
+ /*
+ * There no need to handle the case where nothing is returned, because for
+ * that case resObj was not set anyway.
+ */
+
+ return result;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ErrnoReturn --
+ *
+ * Checks a method error result if it returned an 'errno'.
+ *
+ * Results:
+ * The negative errno found in the error result, or 0.
+ *
+ * Side effects:
+ * None.
+ *
+ * Users:
+ * ReflectInput/Output(), to enable the signaling of EAGAIN
+ * on 0-sized short reads/writes.
+ *
+ *----------------------------------------------------------------------
+ */
-static void
-RcFree (rcPtr)
- ReflectingChannel* rcPtr;
+static int
+ErrnoReturn(
+ ReflectedChannel *rcPtr,
+ Tcl_Obj *resObj)
{
- Channel* chanPtr = (Channel*) rcPtr->chan;
- int i, n;
+ int code;
+ Tcl_InterpState sr; /* State of handler interp */
- if (chanPtr->typePtr != &tclRChannelType) {
- /* Delete a cloned ChannelType structure. */
- ckfree ((char*) chanPtr->typePtr);
+ if (rcPtr->dead) {
+ return 0;
}
- n = rcPtr->argc - 2;
- for (i = 0; i < n; i++) {
- Tcl_DecrRefCount (rcPtr->argv[i]);
+ sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+ UnmarshallErrorResult(rcPtr->interp, resObj);
+
+ resObj = Tcl_GetObjResult(rcPtr->interp);
+
+ if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
+ || (code >= 0))) {
+ if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
+ code = -EAGAIN;
+ } else {
+ code = 0;
+ }
}
- ckfree ((char*) rcPtr->argv);
- ckfree ((char*) rcPtr);
- return;
+ Tcl_RestoreInterpState(rcPtr->interp, sr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReflectedChannelMap --
+ *
+ * Gets and potentially initializes the reflected channel map for an
+ * interpreter.
+ *
+ * Results:
+ * A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ * Initializes the reflected channel map for an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedChannelMap *
+GetReflectedChannelMap(
+ Tcl_Interp *interp)
+{
+ ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
+
+ if (rcmPtr == NULL) {
+ rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
+ Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, RCMKEY,
+ (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
+ }
+ return rcmPtr;
}
/*
*----------------------------------------------------------------------
*
- * RcInvokeTclMethod --
+ * DeleteReflectedChannelMap --
*
- * This function is used to invoke the Tcl level of a reflected
- * channel. It handles all the command assembly, invokation, and
- * generic state and result mgmt.
+ * Deletes the channel table for an interpreter, closing any open
+ * channels whose refcount reaches zero. This procedure is invoked when
+ * an interpreter is deleted, via the AssocData cleanup mechanism.
*
* Results:
- * Result code and data as returned by the method.
+ * None.
*
* Side effects:
- * Arbitrary, as it calls upo na Tcl script.
+ * Deletes the hash table of channels. May close channels. May flush
+ * output on closed channels. Removes any channeEvent handlers that were
+ * registered in this interpreter.
*
*----------------------------------------------------------------------
*/
static void
-RcInvokeTclMethod (rcPtr, method, argone, argtwo, result, resultObj, capture)
- ReflectingChannel* rcPtr;
- CONST char* method;
- Tcl_Obj* argone; /* NULL'able */
- Tcl_Obj* argtwo; /* NULL'able */
- int* result; /* NULL'able */
- Tcl_Obj** resultObj; /* NULL'able */
- int capture;
+DeleteReflectedChannelMap(
+ ClientData clientData, /* The per-interpreter data structure. */
+ Tcl_Interp *interp) /* The interpreter being deleted. */
{
- /* Thread redirection was done by higher layers */
- /* ASSERT: Tcl_GetCurrentThread () == rcPtr->thread */
+ ReflectedChannelMap *rcmPtr = clientData;
+ /* The map */
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ ReflectedChannel *rcPtr;
+ Tcl_Channel chan;
+#ifdef TCL_THREADS
+ ForwardingResult *resultPtr;
+ ForwardingEvent *evPtr;
+ ForwardParam *paramPtr;
+#endif
- int cmdc; /* #words in constructed command */
- Tcl_Obj* methObj = NULL; /* Method name in object form */
- Tcl_InterpState sr; /* State of handler interp */
- int res; /* Result code of method invokation */
- Tcl_Obj* resObj = NULL; /* Result of method invokation. */
+ /*
+ * Delete all entries. The channels may have been closed already, or will
+ * be closed later, by the standard IO finalization of an interpreter
+ * under destruction. Except for the channels which were moved to a
+ * different interpreter and/or thread. They do not exist from the IO
+ * systems point of view and will not get closed. Therefore mark all as
+ * dead so that any future access will cause a proper error. For channels
+ * in a different thread we actually do the same as
+ * DeleteThreadReflectedChannelMap(), just restricted to the channels of
+ * this interp.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+ chan = Tcl_GetHashValue(hPtr);
+ rcPtr = Tcl_GetChannelInstanceData(chan);
+
+ rcPtr->dead = 1;
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(&rcmPtr->map);
+ ckfree(&rcmPtr->map);
- /* NOTE (5): Decide impl. issue: Cache objects with method names ?
- * NOTE (5): Requires TSD data as reflections can be created in
- * NOTE (5): many different threads.
- * NOTE (5): ---
+#ifdef TCL_THREADS
+ /*
+ * The origin interpreter for one or more reflected channels is gone.
*/
- /* Insert method into the pre-allocated area, after the command
- * prefix, before the channel id.
+ /*
+ * 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.
*/
- methObj = Tcl_NewStringObj (method, -1);
- if (methObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInvokeTclMethod");
+ Tcl_MutexLock(&rcForwardMutex);
+
+ for (resultPtr = forwardList;
+ resultPtr != NULL;
+ resultPtr = resultPtr->nextPtr) {
+ if (resultPtr->dsti != interp) {
+ /*
+ * Ignore results/events for other interpreters.
+ */
+
+ continue;
+ }
+
+ /*
+ * The receiver for the event exited, before processing the event. We
+ * detach the result now, wake the originator up and signal failure.
+ */
+
+ evPtr = resultPtr->evPtr;
+
+ /* Basic crash safety until this routine can get revised [3411310] */
+ if (evPtr == NULL) {
+ continue;
+ }
+ paramPtr = evPtr->param;
+
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
+
+ ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+ Tcl_ConditionNotify(&resultPtr->done);
}
- Tcl_IncrRefCount (methObj);
- rcPtr->argv [rcPtr->argc - 2] = methObj;
+ Tcl_MutexUnlock(&rcForwardMutex);
- /* Append the additional argument containing method specific
- * details behind the channel id. If specified.
+ /*
+ * Get the map of all channels handled by the current thread. This is a
+ * ReflectedChannelMap, 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.
*/
- cmdc = rcPtr->argc ;
- if (argone) {
- Tcl_IncrRefCount (argone);
- rcPtr->argv [cmdc] = argone;
- cmdc++;
+ rcmPtr = GetThreadReflectedChannelMap();
+ for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chan = Tcl_GetHashValue(hPtr);
+ rcPtr = Tcl_GetChannelInstanceData(chan);
+
+ if (rcPtr->interp != interp) {
+ /*
+ * Ignore entries for other interpreters.
+ */
+
+ continue;
+ }
+
+ rcPtr->dead = 1;
+ Tcl_DeleteHashEntry(hPtr);
}
- if (argtwo) {
- Tcl_IncrRefCount (argtwo);
- rcPtr->argv [cmdc] = argtwo;
- cmdc++;
+#endif
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadReflectedChannelMap --
+ *
+ * Gets and potentially initializes the reflected channel map for a
+ * thread.
+ *
+ * Results:
+ * A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ * Initializes the reflected channel map for a thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedChannelMap *
+GetThreadReflectedChannelMap(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->rcmPtr) {
+ tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
+ Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
+ Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
}
- /* And run the handler ... This is done in auch a manner which
- * leaves any existing state intact.
- */
+ return tsdPtr->rcmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteThreadReflectedChannelMap --
+ *
+ * Deletes the channel table for a thread. This procedure is invoked when
+ * a thread is deleted. The channels have already been marked as dead, in
+ * DeleteReflectedChannelMap().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the hash table of channels.
+ *
+ *----------------------------------------------------------------------
+ */
- sr = Tcl_SaveInterpState (rcPtr->interp, 0 /* Dummy */);
- res = Tcl_EvalObjv (rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+static void
+DeleteThreadReflectedChannelMap(
+ ClientData clientData) /* The per-thread data structure. */
+{
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ Tcl_ThreadId self = Tcl_GetCurrentThread();
+ ReflectedChannelMap *rcmPtr; /* The map */
+ ForwardingResult *resultPtr;
- /* We do not try to extract the result information if the caller has no
- * interest in it. I.e. there is no need to put effort into creating
- * something which is discarded immediately after.
+ /*
+ * The origin thread for one or more reflected channels is gone.
+ * NOTE: If this function is called due to a thread getting killed the
+ * per-interp DeleteReflectedChannelMap is apparently not called.
*/
- if (resultObj) {
- if ((res == TCL_OK) || !capture) {
- /* Ok result taken as is, also if the caller requests that there
- * is no capture.
- */
+ /*
+ * 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.
+ */
- resObj = Tcl_GetObjResult (rcPtr->interp);
- } else {
- /* Non-ok ressult is always treated as an error.
- * We have to capture the full state of the result,
- * including additional options.
+ Tcl_MutexLock(&rcForwardMutex);
+
+ for (resultPtr = forwardList;
+ resultPtr != NULL;
+ resultPtr = resultPtr->nextPtr) {
+ ForwardingEvent *evPtr;
+ ForwardParam *paramPtr;
+
+ if (resultPtr->dst != self) {
+ /*
+ * Ignore results/events for other threads.
*/
- res = TCL_ERROR;
- resObj = RcErrorMarshall (rcPtr->interp);
+ continue;
}
- Tcl_IncrRefCount(resObj);
- }
- Tcl_RestoreInterpState (rcPtr->interp, sr);
- /* ... */
+ /*
+ * The receiver for the event exited, before processing the event. We
+ * detach the result now, wake the originator up and signal failure.
+ */
- /* Cleanup of the dynamic parts of the command */
+ evPtr = resultPtr->evPtr;
- Tcl_DecrRefCount (methObj);
- if (argone) {Tcl_DecrRefCount (argone);}
- if (argtwo) {Tcl_DecrRefCount (argtwo);}
+ /* Basic crash safety until this routine can get revised [3411310] */
+ if (evPtr == NULL ) {
+ continue;
+ }
+ paramPtr = evPtr->param;
- /* The resObj has a ref count of 1 at this location. This means
- * that the caller of RcInvoke has to dispose of it (but only if
- * it was returned to it).
- */
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
- if (result) {
- *result = res;
- }
- if (resultObj) {
- *resultObj = resObj;
+ ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+ Tcl_ConditionNotify(&resultPtr->done);
}
- /* There no need to handle the case where nothing is returned, because for
- * that case resObj was not set anyway.
+ 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
+ * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
+ * through the channels, remove all, mark them as dead.
*/
+
+ rcmPtr = GetThreadReflectedChannelMap();
+ for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+ Tcl_Channel chan = Tcl_GetHashValue(hPtr);
+ ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
+
+ rcPtr->dead = 1;
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ ckfree(rcmPtr);
}
-#ifdef TCL_THREADS
static void
-RcForwardOp (rcPtr, op, dst, param)
- ReflectingChannel* rcPtr; /* Channel instance */
- RcOperation op; /* Forwarded driver operation */
- Tcl_ThreadId dst; /* Destination thread */
- CONST VOID* param; /* Arguments */
+ForwardOpToHandlerThread(
+ ReflectedChannel *rcPtr, /* Channel instance */
+ ForwardedOperation op, /* Forwarded driver operation */
+ const void *param) /* Arguments */
{
- RcForwardingEvent* evPtr;
- RcForwardingResult* resultPtr;
- int result;
+ /*
+ * Core of the communication from OWNER to HANDLER thread.
+ * The receiver is ForwardProc() below.
+ */
- /* Create and initialize the event and data structures */
+ Tcl_ThreadId dst = rcPtr->thread;
+ ForwardingEvent *evPtr;
+ ForwardingResult *resultPtr;
- evPtr = (RcForwardingEvent*) ckalloc (sizeof (RcForwardingEvent));
- resultPtr = (RcForwardingResult*) ckalloc (sizeof (RcForwardingResult));
+ /*
+ * We gather the lock early. This allows us to check the liveness of the
+ * channel without interference from DeleteThreadReflectedChannelMap().
+ */
- evPtr->event.proc = RcForwardProc;
- evPtr->resultPtr = resultPtr;
- evPtr->op = op;
- evPtr->rcPtr = rcPtr;
- evPtr->param = param;
+ Tcl_MutexLock(&rcForwardMutex);
+
+ 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.
+ */
- resultPtr->src = Tcl_GetCurrentThread ();
- resultPtr->dst = dst;
- resultPtr->done = (Tcl_Condition) NULL;
+ ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
+ Tcl_MutexUnlock(&rcForwardMutex);
+ return;
+ }
+
+ /*
+ * Create and initialize the event and data structures.
+ */
+
+ evPtr = ckalloc(sizeof(ForwardingEvent));
+ resultPtr = ckalloc(sizeof(ForwardingResult));
+
+ evPtr->event.proc = ForwardProc;
+ evPtr->resultPtr = resultPtr;
+ evPtr->op = op;
+ evPtr->rcPtr = rcPtr;
+ evPtr->param = (ForwardParam *) param;
+
+ resultPtr->src = Tcl_GetCurrentThread();
+ resultPtr->dst = dst;
+ resultPtr->dsti = rcPtr->interp;
+ resultPtr->done = NULL;
resultPtr->result = -1;
- resultPtr->evPtr = evPtr;
+ resultPtr->evPtr = evPtr;
- /* Now execute the forward */
+ /*
+ * Now execute the forward.
+ */
- Tcl_MutexLock(&rcForwardMutex);
TclSpliceIn(resultPtr, forwardList);
+ /* Do not unlock here. That is done by the ConditionWait */
/*
- * Ensure cleanup of the event if any of the two involved threads
- * exits while this event is pending or in progress.
+ * 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
+ * DeleteThreadReflectedChannelMap(), this is set up by
+ * GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
+ * (see above) for.
*/
- Tcl_CreateThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
- Tcl_CreateThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
+ Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);
/*
* Queue the event and poke the other thread's notifier.
*/
- Tcl_ThreadQueueEvent(dst, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL);
+ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
Tcl_ThreadAlert(dst);
/*
- * (*) Block until the other thread has either processed the transfer
- * or rejected it.
+ * (*) Block until the handler thread has either processed the transfer or
+ * rejected it.
*/
while (resultPtr->result < 0) {
- /* NOTE (1): Is it possible that the current thread goes away while waiting here ?
- * NOTE (1): IOW Is it possible that "RcSrcExitProc" is called while we are here ?
- * NOTE (1): See complementary note (2) in "RcSrcExitProc"
- * NOTE (1): ---
+ /*
+ * NOTE (1): Is it possible that the current thread goes away while
+ * waiting here? IOW Is it possible that "SrcExitProc" is called while
+ * we are here? See complementary note (2) in "SrcExitProc"
+ *
+ * The ConditionWait unlocks the mutex during the wait and relocks it
+ * immediately after.
*/
- Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
+ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
}
/*
- * Unlink result from the forwarder list.
+ * Unlink result from the forwarder list. No need to lock. Either still
+ * locked, or locked by the ConditionWait
*/
TclSpliceOut(resultPtr, forwardList);
- resultPtr->nextPtr = NULL;
- resultPtr->prevPtr = NULL;
+ resultPtr->nextPtr = NULL;
+ resultPtr->prevPtr = NULL;
Tcl_MutexUnlock(&rcForwardMutex);
Tcl_ConditionFinalize(&resultPtr->done);
/*
- * Kill the cleanup handlers now, and the result structure as well,
- * before returning the success code.
+ * Kill the cleanup handler now, and the result structure as well, before
+ * returning the success code.
*
* Note: The event structure has already been deleted.
*/
- Tcl_DeleteThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
- Tcl_DeleteThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
-
- result = resultPtr->result;
- ckfree ((char*) resultPtr);
+ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
+
+ ckfree(resultPtr);
}
static int
-RcForwardProc (evGPtr, mask)
- Tcl_Event *evGPtr;
- int mask;
+ForwardProc(
+ Tcl_Event *evGPtr,
+ int mask)
{
- /* Notes regarding access to the referenced data.
+ /*
+ * 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
- * evPtr->src), however this thread is currently blocked at (*),
- * i.e. quiescent. Because of this we can treat the data as
- * belonging to us, without fear of race conditions. I.e. we can
- * read and write as we like.
+ * evPtr->src), however this thread is currently blocked at (*), i.e.
+ * quiescent. Because of this we can treat the data as belonging to us,
+ * without fear of race conditions. I.e. we can read and write as we like.
*
- * The only thing we cannot be sure of is the resultPtr. This can be
- * be NULLed if the originating thread went away while the event
- * is handled here now.
+ * The only thing we cannot be sure of is the resultPtr. This can be be
+ * NULLed if the originating thread went away while the event is handled
+ * here now.
*/
- RcForwardingEvent* evPtr = (RcForwardingEvent*) evGPtr;
- RcForwardingResult* resultPtr = evPtr->resultPtr;
- ReflectingChannel* rcPtr = evPtr->rcPtr;
- Tcl_Interp* interp = rcPtr->interp;
- RcForwardParamBase* paramPtr = (RcForwardParamBase*) evPtr->param;
- int res = TCL_OK; /* Result code of RcInvokeTclMethod */
- Tcl_Obj* resObj = NULL; /* Interp result of RcInvokeTclMethod */
+ ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
+ ForwardingResult *resultPtr = evPtr->resultPtr;
+ ReflectedChannel *rcPtr = evPtr->rcPtr;
+ 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. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
- /* Ignore the event if no one is waiting for its result anymore.
+ /*
+ * Ignore the event if no one is waiting for its result anymore.
*/
if (!resultPtr) {
- return 1;
+ return 1;
}
- paramPtr->code = TCL_OK;
- paramPtr->msg = NULL;
- paramPtr->vol = 0;
+ paramPtr->base.code = TCL_OK;
+ paramPtr->base.msgStr = NULL;
+ paramPtr->base.mustFree = 0;
switch (evPtr->op) {
- /* The destination thread for the following operations is
- * rcPtr->thread, which contains rcPtr->interp, the interp
- * we have to call upon for the driver.
- */
-
- case RcOpClose:
- {
- /* No parameters/results */
- RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- }
-
- /* Freeing is done here, in the origin thread, because the
- * argv[] objects belong to this thread. Deallocating them
- * in a different thread is not allowed
- */
-
- RcFree (rcPtr);
- }
- break;
-
- case RcOpInput:
- {
- RcForwardParamInput* p = (RcForwardParamInput*) paramPtr;
- Tcl_Obj* toReadObj = Tcl_NewIntObj (p->toRead);
-
- if (toReadObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInput");
- }
-
- RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->toRead = -1;
- } else {
- /* Process a regular result. */
-
- int bytec; /* Number of returned bytes */
- unsigned char* bytev; /* Array of returned bytes */
-
- bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
- if (p->toRead < bytec) {
- RcForwardSetStaticError (paramPtr, msg_read_toomuch);
- p->toRead = -1;
-
- } else {
- if (bytec > 0) {
- memcpy (p->buf, bytev, bytec);
- }
-
- p->toRead = bytec;
- }
- }
- }
- break;
-
- case RcOpOutput:
- {
- RcForwardParamOutput* p = (RcForwardParamOutput*) paramPtr;
- Tcl_Obj* bufObj = Tcl_NewByteArrayObj((unsigned char*) p->buf, p->toWrite);
-
- if (bufObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcOutput");
- }
-
- RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->toWrite = -1;
- } else {
- /* Process a regular result. */
-
- int written;
-
- res = Tcl_GetIntFromObj (interp, resObj, &written);
- if (res != TCL_OK) {
-
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
- p->toWrite = -1;
-
- } else if ((written == 0) || (p->toWrite < written)) {
-
- RcForwardSetStaticError (paramPtr, msg_write_toomuch);
- p->toWrite = -1;
-
- } else {
- p->toWrite = written;
- }
- }
- }
- break;
-
- case RcOpSeek:
- {
- RcForwardParamSeek* p = (RcForwardParamSeek*) paramPtr;
-
- Tcl_Obj* offObj;
- Tcl_Obj* baseObj;
-
- offObj = Tcl_NewWideIntObj(p->offset);
- if (offObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- baseObj = Tcl_NewStringObj((p->seekMode == SEEK_SET) ?
- "start" :
- ((p->seekMode == SEEK_CUR) ?
- "current" :
- "end"), -1);
-
- if (baseObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->offset = -1;
- } else {
- /* Process a regular result. If the type is wrong this
- * may change into an error.
- */
-
- Tcl_WideInt newLoc;
- res = Tcl_GetWideIntFromObj (interp, resObj, &newLoc);
-
- if (res == TCL_OK) {
- if (newLoc < Tcl_LongAsWide (0)) {
- RcForwardSetStaticError (paramPtr, msg_seek_beforestart);
- p->offset = -1;
- } else {
- p->offset = newLoc;
- }
- } else {
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
- p->offset = -1;
- }
- }
- }
- break;
-
- case RcOpWatch:
- {
- RcForwardParamWatch* p = (RcForwardParamWatch*) paramPtr;
-
- Tcl_Obj* maskObj = RcDecodeEventMask (p->mask);
- RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
- NULL, NULL, NO_CAPTURE);
- Tcl_DecrRefCount (maskObj);
- }
- break;
-
- case RcOpBlock:
- {
- RcForwardParamBlock* p = (RcForwardParamBlock*) evPtr->param;
- Tcl_Obj* blockObj = Tcl_NewBooleanObj(!p->nonblocking);
-
- if (blockObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcBlock");
- }
-
- RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- }
- }
- break;
-
- case RcOpSetOpt:
- {
- RcForwardParamSetOpt* p = (RcForwardParamSetOpt*) paramPtr;
- Tcl_Obj* optionObj;
- Tcl_Obj* valueObj;
-
- optionObj = Tcl_NewStringObj(p->name,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- valueObj = Tcl_NewStringObj(p->value,-1);
- if (valueObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- }
- }
- break;
-
- case RcOpGetOpt:
- {
- /* Retrieve the value of one option */
-
- RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
- Tcl_Obj* optionObj;
-
- optionObj = Tcl_NewStringObj(p->name,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcGetOption");
- }
-
- RcInvokeTclMethod (rcPtr, "cget", optionObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- } else {
- Tcl_DStringAppend (p->value, Tcl_GetString (resObj), -1);
- }
- }
- break;
-
- case RcOpGetOptAll:
- {
- /* Retrieve all options. */
-
- RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
-
- RcInvokeTclMethod (rcPtr, "cgetall", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- } else {
- /* Extract list, validate that it is a list, and
- * #elements. See NOTE (4) as well.
- */
-
- int listc;
- Tcl_Obj** listv;
-
- res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
-
- } else if ((listc % 2) == 1) {
- /* Odd number of elements is wrong.
- * [x].
- */
-
- char* buf = ckalloc (200);
- sprintf (buf,
- "{Expected list with even number of elements, got %d %s instead}",
- listc,
- (listc == 1 ? "element" : "elements"));
-
- RcForwardSetDynError (paramPtr, buf);
- } else {
- int len;
- char* str = Tcl_GetStringFromObj (resObj, &len);
-
- if (len) {
- Tcl_DStringAppend (p->value, " ", 1);
- Tcl_DStringAppend (p->value, str, len);
- }
- }
- }
- }
- break;
+ /*
+ * The destination thread for the following operations is
+ * rcPtr->thread, which contains rcPtr->interp, the interp we have to
+ * call upon for the driver.
+ */
+
+ case ForwardedClose:
+ /*
+ * No parameters/results.
+ */
+
+ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+
+ /*
+ * Freeing is done here, in the origin thread, callback command
+ * objects belong to this thread. Deallocating them in a different
+ * thread is not allowed
+ *
+ * We remove the channel from both interpreter and thread maps before
+ * releasing the memory, to prevent future accesses (like by
+ * 'postevent') from finding and dereferencing a dangling pointer.
+ */
+
+ rcmPtr = GetReflectedChannelMap(interp);
+ hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+ Tcl_GetChannelName(rcPtr->chan));
+ Tcl_DeleteHashEntry(hPtr);
+
+ rcmPtr = GetThreadReflectedChannelMap();
+ hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+ Tcl_GetChannelName(rcPtr->chan));
+ Tcl_DeleteHashEntry(hPtr);
+
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ break;
+
+ case ForwardedInput: {
+ Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
+ Tcl_IncrRefCount(toReadObj);
+
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
+ int code = ErrnoReturn(rcPtr, resObj);
+
+ if (code < 0) {
+ paramPtr->base.code = code;
+ } else {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ paramPtr->input.toRead = -1;
+ } else {
+ /*
+ * Process a regular result.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ if (paramPtr->input.toRead < bytec) {
+ ForwardSetStaticError(paramPtr, msg_read_toomuch);
+ paramPtr->input.toRead = -1;
+ } else {
+ if (bytec > 0) {
+ memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
+ }
+ paramPtr->input.toRead = bytec;
+ }
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(toReadObj);
+ break;
+ }
+
+ case ForwardedOutput: {
+ Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+ paramPtr->output.buf, paramPtr->output.toWrite);
+ Tcl_IncrRefCount(bufObj);
+
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
+ int code = ErrnoReturn(rcPtr, resObj);
+
+ if (code < 0) {
+ paramPtr->base.code = code;
+ } else {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ paramPtr->output.toWrite = -1;
+ } else {
+ /*
+ * Process a regular result.
+ */
+
+ int written;
+
+ if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
+ 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);
+ paramPtr->output.toWrite = -1;
+ } else {
+ paramPtr->output.toWrite = written;
+ }
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(bufObj);
+ break;
+ }
+
+ 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);
+
+ Tcl_IncrRefCount(offObj);
+ Tcl_IncrRefCount(baseObj);
+
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->seek.offset = -1;
+ } else {
+ /*
+ * Process a regular result. If the type is wrong this may change
+ * into an error.
+ */
+
+ Tcl_WideInt newLoc;
+
+ if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
+ if (newLoc < Tcl_LongAsWide(0)) {
+ ForwardSetStaticError(paramPtr, msg_seek_beforestart);
+ paramPtr->seek.offset = -1;
+ } else {
+ paramPtr->seek.offset = newLoc;
+ }
+ } else {
+ Tcl_DecrRefCount(resObj);
+ resObj = MarshallError(interp);
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->seek.offset = -1;
+ }
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(offObj);
+ Tcl_DecrRefCount(baseObj);
+ break;
+ }
+
+ case ForwardedWatch: {
+ Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
+ /* assert maskObj.refCount == 1 */
+
+ Tcl_Preserve(rcPtr);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
+ Tcl_DecrRefCount(maskObj);
+ Tcl_Release(rcPtr);
+ break;
+ }
+
+ case ForwardedBlock: {
+ Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
+
+ Tcl_IncrRefCount(blockObj);
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
+ &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(blockObj);
+ break;
+ }
+
+ case ForwardedSetOpt: {
+ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
+ Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
+
+ Tcl_IncrRefCount(optionObj);
+ Tcl_IncrRefCount(valueObj);
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
+ &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(optionObj);
+ Tcl_DecrRefCount(valueObj);
+ break;
+ }
+
+ case ForwardedGetOpt: {
+ /*
+ * Retrieve the value of one option.
+ */
+
+ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
+
+ Tcl_IncrRefCount(optionObj);
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
+ ForwardSetObjError(paramPtr, resObj);
+ } else {
+ TclDStringAppendObj(paramPtr->getOpt.value, resObj);
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(optionObj);
+ break;
+ }
+
+ case ForwardedGetOptAll:
+ /*
+ * Retrieve all options.
+ */
+
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
+ ForwardSetObjError(paramPtr, resObj);
+ } else {
+ /*
+ * Extract list, validate that it is a list, and #elements. See
+ * NOTE (4) as well.
+ */
+
+ int listc;
+ Tcl_Obj **listv;
+
+ if (Tcl_ListObjGetElements(interp, resObj, &listc,
+ &listv) != TCL_OK) {
+ Tcl_DecrRefCount(resObj);
+ resObj = MarshallError(interp);
+ ForwardSetObjError(paramPtr, resObj);
+ } else if ((listc % 2) == 1) {
+ /*
+ * Odd number of elements is wrong. [x].
+ */
+
+ char *buf = ckalloc(200);
+ sprintf(buf,
+ "{Expected list with even number of elements, got %d %s instead}",
+ listc, (listc == 1 ? "element" : "elements"));
+
+ ForwardSetDynamicError(paramPtr, buf);
+ } else {
+ int len;
+ const char *str = Tcl_GetStringFromObj(resObj, &len);
+
+ if (len) {
+ TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
+ Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
+ }
+ }
+ }
+ Tcl_Release(rcPtr);
+ break;
default:
- /* Bad operation code */
- Tcl_Panic ("Bad operation code in RcForwardProc");
- break;
+ /*
+ * Bad operation code.
+ */
+
+ Tcl_Panic("Bad operation code in ForwardProc");
+ break;
}
- /* Remove the reference we held on the result of the invoke, if we had
- * such
+ /*
+ * Remove the reference we held on the result of the invoke, if we had
+ * such.
*/
+
if (resObj != NULL) {
- Tcl_DecrRefCount (resObj);
+ Tcl_DecrRefCount(resObj);
}
if (resultPtr) {
- /*
- * Report the forwarding result synchronously to the waiting
- * caller. This unblocks (*) as well. This is wrapped into a
- * conditional because the caller may have exited in the mean
- * time.
+ /*
+ * Report the forwarding result synchronously to the waiting caller.
+ * This unblocks (*) as well. This is wrapped into a conditional
+ * because the caller may have exited in the mean time.
*/
- Tcl_MutexLock(&rcForwardMutex);
+ Tcl_MutexLock(&rcForwardMutex);
resultPtr->result = TCL_OK;
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&rcForwardMutex);
@@ -2560,97 +3165,65 @@ RcForwardProc (evGPtr, mask)
return 1;
}
-
static void
-RcSrcExitProc (clientData)
- ClientData clientData;
+SrcExitProc(
+ ClientData clientData)
{
- RcForwardingEvent* evPtr = (RcForwardingEvent*) clientData;
- RcForwardingResult* resultPtr;
- RcForwardParamBase* paramPtr;
-
- /* NOTE (2): Can this handler be called with the originator blocked ?
- * NOTE (2): ---
- */
-
- /* The originator for the event exited. It is not sure if this
- * can happen, as the originator should be blocked at (*) while
- * the event is in transit/pending.
- */
-
- /*
- * We make sure that the event cannot refer to the result anymore,
- * remove it from the list of pending results and free the
- * structure. Locking the access ensures that we cannot get in
- * conflict with "RcForwardProc", should it already execute the
- * event.
- */
-
- Tcl_MutexLock(&rcForwardMutex);
+ ForwardingEvent *evPtr = clientData;
+ ForwardingResult *resultPtr;
+ ForwardParam *paramPtr;
- resultPtr = evPtr->resultPtr;
- paramPtr = (RcForwardParamBase*) evPtr->param;
-
- evPtr->resultPtr = NULL;
- resultPtr->evPtr = NULL;
- resultPtr->result = TCL_ERROR;
-
- RcForwardSetStaticError (paramPtr, msg_send_originlost);
-
- /* See below: TclSpliceOut(resultPtr, forwardList); */
+ /*
+ * NOTE (2): Can this handler be called with the originator blocked?
+ */
- Tcl_MutexUnlock(&rcForwardMutex);
+ /*
+ * The originator for the event exited. It is not sure if this can happen,
+ * as the originator should be blocked at (*) while the event is in
+ * transit/pending.
+ *
+ * We make sure that the event cannot refer to the result anymore, remove
+ * it from the list of pending results and free the structure. Locking the
+ * access ensures that we cannot get in conflict with "ForwardProc",
+ * should it already execute the event.
+ */
- /*
- * This unlocks (*). The structure will be spliced out and freed by
- * "RcForwardProc". Maybe.
- */
+ Tcl_MutexLock(&rcForwardMutex);
- Tcl_ConditionNotify(&resultPtr->done);
-}
-
+ resultPtr = evPtr->resultPtr;
+ paramPtr = evPtr->param;
-static void
-RcDstExitProc (clientData)
- ClientData clientData;
-{
- RcForwardingEvent* evPtr = (RcForwardingEvent*) clientData;
- RcForwardingResult* resultPtr = evPtr->resultPtr;
- RcForwardParamBase* paramPtr = (RcForwardParamBase*) evPtr->param;
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
- /* NOTE (3): It is not clear if the event still exists when this handler is called..
- * NOTE (3): We might have to use 'resultPtr' as our clientData instead.
- * NOTE (3): ---
- */
+ ForwardSetStaticError(paramPtr, msg_send_originlost);
- /* The receiver for the event exited, before processing the
- * event. We detach the result now, wake the originator up
- * and signal failure.
- */
+ /*
+ * See below: TclSpliceOut(resultPtr, forwardList);
+ */
- evPtr->resultPtr = NULL;
- resultPtr->evPtr = NULL;
- resultPtr->result = TCL_ERROR;
+ Tcl_MutexUnlock(&rcForwardMutex);
- RcForwardSetStaticError (paramPtr, msg_send_dstlost);
+ /*
+ * This unlocks (*). The structure will be spliced out and freed by
+ * "ForwardProc". Maybe.
+ */
- Tcl_ConditionNotify(&resultPtr->done);
+ Tcl_ConditionNotify(&resultPtr->done);
}
-
static void
-RcForwardSetObjError (p,obj)
- RcForwardParamBase* p;
- Tcl_Obj* obj;
+ForwardSetObjError(
+ ForwardParam *paramPtr,
+ Tcl_Obj *obj)
{
- int len;
- char* msg;
-
- msg = Tcl_GetStringFromObj (obj, &len);
+ int len;
+ const char *msgStr = Tcl_GetStringFromObj(obj, &len);
- p->code = TCL_ERROR;
- p->vol = 1;
- p->msg = strcpy(ckalloc (1+len), msg);
+ len++;
+ ForwardSetDynamicError(paramPtr, ckalloc(len));
+ memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
@@ -2659,5 +3232,7 @@ RcForwardSetObjError (p,obj)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
new file mode 100644
index 0000000..1de635f
--- /dev/null
+++ b/generic/tclIORTrans.c
@@ -0,0 +1,3420 @@
+/*
+ * tclIORTrans.c --
+ *
+ * This file contains the implementation of Tcl's generic transformation
+ * reflection code, which allows the implementation of Tcl channel
+ * transformations in Tcl code.
+ *
+ * Parts of this file are based on code contributed by Jean-Claude
+ * Wippler.
+ *
+ * See TIP #230 for the specification of this functionality.
+ *
+ * Copyright (c) 2007-2008 ActiveState.
+ *
+ * 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 "tclIO.h"
+#include <assert.h>
+
+#ifndef EINVAL
+#define EINVAL 9
+#endif
+#ifndef EOK
+#define EOK 0
+#endif
+
+/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
+static int HaveVersion(const Tcl_ChannelType *typePtr,
+ Tcl_ChannelTypeVersion minimumVersion);
+
+/*
+ * Signatures of all functions used in the C layer of the reflection.
+ */
+
+static int ReflectClose(ClientData clientData,
+ Tcl_Interp *interp);
+static int ReflectInput(ClientData clientData, char *buf,
+ int toRead, int *errorCodePtr);
+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);
+static Tcl_WideInt ReflectSeekWide(ClientData clientData,
+ Tcl_WideInt offset, int mode, int *errorCodePtr);
+static int ReflectSeek(ClientData clientData, long offset,
+ int mode, int *errorCodePtr);
+static int ReflectGetOption(ClientData clientData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static int ReflectSetOption(ClientData clientData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *newValue);
+static int ReflectHandle(ClientData clientData, int direction,
+ ClientData *handle);
+static int ReflectNotify(ClientData clientData, int mask);
+
+/*
+ * The C layer channel type/driver definition used by the reflection.
+ */
+
+static const Tcl_ChannelType tclRTransformType = {
+ "tclrtransform", /* Type name. */
+ TCL_CHANNEL_VERSION_5, /* v5 channel. */
+ ReflectClose, /* Close channel, clean instance data. */
+ ReflectInput, /* Handle read request. */
+ ReflectOutput, /* Handle write request. */
+ ReflectSeek, /* Move location of access point. */
+ ReflectSetOption, /* Set options. */
+ ReflectGetOption, /* Get options. */
+ ReflectWatch, /* Initialize notifier. */
+ ReflectHandle, /* Get OS handle from the channel. */
+ NULL, /* No close2 support. NULL'able. */
+ ReflectBlock, /* Set blocking/nonblocking. */
+ NULL, /* Flush channel. Not used by core.
+ * NULL'able. */
+ ReflectNotify, /* Handle events. */
+ ReflectSeekWide, /* Move access point (64 bit). */
+ NULL, /* thread action */
+ NULL /* truncate */
+};
+
+/*
+ * Structure of the buffer to hold transform results to be consumed by higher
+ * layers upon reading from the channel, plus the functions to manage such.
+ */
+
+typedef struct _ResultBuffer_ {
+ unsigned char *buf; /* Reference to the buffer area. */
+ int allocated; /* Allocated size of the buffer area. */
+ int used; /* Number of bytes in the buffer,
+ * <= allocated. */
+} ResultBuffer;
+
+#define ResultLength(r) ((r)->used)
+/* static int ResultLength(ResultBuffer *r); */
+
+static void ResultClear(ResultBuffer *r);
+static void ResultInit(ResultBuffer *r);
+static void ResultAdd(ResultBuffer *r, unsigned char *buf,
+ int toWrite);
+static int ResultCopy(ResultBuffer *r, unsigned char *buf,
+ int toRead);
+
+#define RB_INCREMENT (512)
+
+/*
+ * Convenience macro to make some casts easier to use.
+ */
+
+#define UCHARP(x) ((unsigned char *) (x))
+
+/*
+ * Instance data for a reflected transformation. ===========================
+ */
+
+typedef struct {
+ Tcl_Channel chan; /* Back reference to the channel of the
+ * transformation itself. */
+ Tcl_Channel parent; /* Reference to the channel the transformation
+ * was pushed on. */
+ Tcl_Interp *interp; /* Reference to the interpreter containing the
+ * Tcl level part of the channel. */
+ Tcl_Obj *handle; /* Reference to transform handle. Also stored
+ * in the argv, see below. The separate field
+ * gives us direct access, needed when working
+ * with the reflection maps. */
+#ifdef TCL_THREADS
+ Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
+#endif
+
+ Tcl_TimerToken timer;
+
+ /* See [==] as well.
+ * Storage for the command prefix and the additional words required for
+ * the invocation of methods in the command handler.
+ *
+ * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
+ * cmd ... pfx | method chan | detail1 detail2
+ * ~~~~ CT ~~~ ~~ CT ~~
+ *
+ * CT = Belongs to the 'Command handler Thread'.
+ */
+
+ int argc; /* Number of preallocated words - 2. */
+ Tcl_Obj **argv; /* Preallocated array for calling the handler.
+ * args[0] is placeholder for cmd word.
+ * Followed by the arguments in the prefix,
+ * plus 4 placeholders for method, channel,
+ * and at most two varying (method specific)
+ * words. */
+ int methods; /* Bitmask of supported methods. */
+
+ /*
+ * NOTE (9): Should we have predefined shared literals for the method
+ * names?
+ */
+
+ 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;
+
+/*
+ * Structure of the table mapping from transform handles to reflected
+ * transform (channels). Each interpreter which has the handler command for
+ * one or more reflected transforms records them in such a table, so that we
+ * are able to find them during interpreter/thread cleanup even if the actual
+ * channel they belong to was moved to a different interpreter and/or thread.
+ *
+ * The table is reachable via the standard interpreter AssocData, the key is
+ * defined below.
+ */
+
+typedef struct {
+ Tcl_HashTable map;
+} ReflectedTransformMap;
+
+#define RTMKEY "ReflectedTransformMap"
+
+/*
+ * Method literals. ==================================================
+ */
+
+static const char *const methodNames[] = {
+ "clear", /* OPT */
+ "drain", /* OPT, drain => read */
+ "finalize", /* */
+ "flush", /* OPT, flush => write */
+ "initialize", /* */
+ "limit?", /* OPT */
+ "read", /* OPT */
+ "write", /* OPT */
+ NULL
+};
+typedef enum {
+ METH_CLEAR,
+ METH_DRAIN,
+ METH_FINAL,
+ METH_FLUSH,
+ METH_INIT,
+ METH_LIMIT,
+ METH_READ,
+ METH_WRITE
+} MethodName;
+
+#define FLAG(m) (1 << (m))
+#define REQUIRED_METHODS \
+ (FLAG(METH_INIT) | FLAG(METH_FINAL))
+#define RANDW \
+ (TCL_READABLE | TCL_WRITABLE)
+
+#define IMPLIES(a,b) ((!(a)) || (b))
+#define NEGIMPL(a,b)
+#define HAS(x,f) (x & FLAG(f))
+
+#ifdef TCL_THREADS
+/*
+ * Thread specific types and structures.
+ *
+ * We are here essentially creating a very specific implementation of 'thread
+ * send'.
+ */
+
+/*
+ * Enumeration of all operations which can be forwarded.
+ */
+
+typedef enum {
+ ForwardedClear,
+ ForwardedClose,
+ ForwardedDrain,
+ ForwardedFlush,
+ ForwardedInput,
+ ForwardedLimit,
+ ForwardedOutput
+} ForwardedOperation;
+
+/*
+ * Event used to forward driver invocations to the thread actually managing
+ * the channel. We cannot construct the command to execute and forward that.
+ * Because then it will contain a mixture of Tcl_Obj's belonging to both the
+ * command handler thread (CT), and the thread managing the channel (MT),
+ * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
+ * forward an operation code, the argument details, and reference to results.
+ * The command is assembled in the CT and belongs fully to that thread. No
+ * sharing problems.
+ */
+
+typedef struct ForwardParamBase {
+ int code; /* O: Ok/Fail of the cmd handler */
+ char *msgStr; /* O: Error message for handler failure */
+ int mustFree; /* O: True if msgStr is allocated, false if
+ * otherwise (static). */
+} ForwardParamBase;
+
+/*
+ * Operation specific parameter/result structures. (These are "subtypes" of
+ * ForwardParamBase. Where an operation does not need any special types, it
+ * has no "subtype" and just uses ForwardParamBase, as listed above.)
+ */
+
+struct ForwardParamTransform {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ char *buf; /* I: Bytes to transform,
+ * O: Bytes in transform result */
+ int size; /* I: #bytes to transform,
+ * O: #bytes in the transform result */
+};
+struct ForwardParamLimit {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int max; /* O: Character read limit */
+};
+
+/*
+ * Now join all these together in a single union for convenience.
+ */
+
+typedef union ForwardParam {
+ ForwardParamBase base;
+ struct ForwardParamTransform transform;
+ struct ForwardParamLimit limit;
+} ForwardParam;
+
+/*
+ * Forward declaration.
+ */
+
+typedef struct ForwardingResult ForwardingResult;
+
+/*
+ * General event structure, with reference to operation specific data.
+ */
+
+typedef struct ForwardingEvent {
+ Tcl_Event event; /* Basic event data, has to be first item */
+ ForwardingResult *resultPtr;
+ ForwardedOperation op; /* Forwarded driver operation */
+ ReflectedTransform *rtPtr; /* Channel instance */
+ ForwardParam *param; /* Packaged arguments and return values, a
+ * ForwardParam pointer. */
+} ForwardingEvent;
+
+/*
+ * Structure to manage the result of the forwarding. This is not the result of
+ * the operation itself, but about the success of the forward event itself.
+ * The event can be successful, even if the operation which was forwarded
+ * failed. It is also there to manage the synchronization between the involved
+ * threads.
+ */
+
+struct ForwardingResult {
+ Tcl_ThreadId src; /* Originating thread. */
+ Tcl_ThreadId dst; /* Thread the op was forwarded to. */
+ Tcl_Interp *dsti; /* Interpreter in the thread the op was
+ * forwarded to. */
+ Tcl_Condition done; /* Condition variable the forwarder blocks
+ * on. */
+ int result; /* TCL_OK or TCL_ERROR */
+ ForwardingEvent *evPtr; /* Event the result belongs to. */
+ ForwardingResult *prevPtr, *nextPtr;
+ /* Links into the list of pending forwarded
+ * results. */
+};
+
+typedef struct ThreadSpecificData {
+ /*
+ * Table of all reflected transformations owned by this thread.
+ */
+
+ ReflectedTransformMap *rtmPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * List of forwarded operations which have not completed yet, plus the mutex
+ * to protect the access to this process global list.
+ */
+
+static ForwardingResult *forwardList = NULL;
+TCL_DECLARE_MUTEX(rtForwardMutex)
+
+/*
+ * Function containing the generic code executing a forward, and wrapper
+ * macros for the actual operations we wish to forward. Uses ForwardProc as
+ * the event function executed by the thread receiving a forwarding event
+ * (which executes the appropriate function and collects the result, if any).
+ *
+ * The two ExitProcs are handlers so that things do not deadlock when either
+ * thread involved in the forwarding exits. They also clean things up so that
+ * we don't leak resources when threads go away.
+ */
+
+static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
+ ForwardedOperation op, const void *param);
+static int ForwardProc(Tcl_Event *evPtr, int mask);
+static void SrcExitProc(ClientData clientData);
+
+#define FreeReceivedError(p) \
+ do { \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ } \
+ } while (0)
+#define PassReceivedErrorInterp(i,p) \
+ do { \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
+ FreeReceivedError(p); \
+ } while (0)
+#define PassReceivedError(c,p) \
+ do { \
+ Tcl_SetChannelError((c), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ FreeReceivedError(p); \
+ } while (0)
+#define ForwardSetStaticError(p,emsg) \
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
+#define ForwardSetDynamicError(p,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);
+#endif /* TCL_THREADS */
+
+#define SetChannelErrorStr(c,msgStr) \
+ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
+
+static Tcl_Obj * MarshallError(Tcl_Interp *interp);
+static void UnmarshallErrorResult(Tcl_Interp *interp,
+ Tcl_Obj *msgObj);
+
+/*
+ * Static functions for this file:
+ */
+
+static Tcl_Obj * DecodeEventMask(int mask);
+static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
+ Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj,
+ 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);
+
+static ReflectedTransformMap * GetReflectedTransformMap(Tcl_Interp *interp);
+static void DeleteReflectedTransformMap(ClientData clientData,
+ Tcl_Interp *interp);
+
+/*
+ * Global constant strings (messages). ==================
+ * These string are used directly as bypass errors, thus they have to be valid
+ * Tcl lists where the last element is the message itself. Hence the
+ * list-quoting to keep the words of the message together. See also [x].
+ */
+
+static const char *msg_read_unsup = "{read not supported by Tcl driver}";
+static const char *msg_write_unsup = "{write not supported by Tcl driver}";
+#ifdef TCL_THREADS
+static const char *msg_send_originlost = "{Channel thread lost}";
+static const char *msg_send_dstlost = "{Owner lost}";
+#endif /* TCL_THREADS */
+static const char *msg_dstlost =
+ "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
+
+/*
+ * Timer management (flushing out buffered data via artificial events).
+ */
+
+/*
+ * Helper functions encapsulating some of the thread forwarding to make the
+ * control flow in callers easier.
+ */
+
+static void TimerKill(ReflectedTransform *rtPtr);
+static void TimerSetup(ReflectedTransform *rtPtr);
+static void TimerRun(ClientData clientData);
+static int TransformRead(ReflectedTransform *rtPtr,
+ int *errorCodePtr, unsigned char *buf,
+ int toRead);
+static int TransformWrite(ReflectedTransform *rtPtr,
+ int *errorCodePtr, unsigned char *buf,
+ int toWrite);
+static int TransformDrain(ReflectedTransform *rtPtr,
+ int *errorCodePtr);
+static int TransformFlush(ReflectedTransform *rtPtr,
+ int *errorCodePtr, int op);
+static void TransformClear(ReflectedTransform *rtPtr);
+static int TransformLimit(ReflectedTransform *rtPtr,
+ int *errorCodePtr, int *maxPtr);
+
+/*
+ * Operation codes for TransformFlush().
+ */
+
+#define FLUSH_WRITE 1
+#define FLUSH_DISCARD 0
+
+/*
+ * Main methods to plug into the 'chan' ensemble'. ==================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPushObjCmd --
+ *
+ * This function is invoked to process the "chan push" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result. The handle of the new channel is placed in the
+ * interp result.
+ *
+ * Side effects:
+ * Creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPushObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ ReflectedTransform *rtPtr; /* Instance data of the new (transform)
+ * channel. */
+ Tcl_Obj *chanObj; /* Handle of parent channel */
+ Tcl_Channel parentChan; /* Token of parent channel */
+ int mode; /* R/W mode of parent, later the new channel.
+ * Has to match the abilities of the handler
+ * commands */
+ Tcl_Obj *cmdObj; /* Command prefix, list of words */
+ Tcl_Obj *cmdNameObj; /* Command name */
+ Tcl_Obj *rtId; /* Handle of the new transform (channel) */
+ Tcl_Obj *modeObj; /* mode in obj form for method call */
+ int listc; /* Result of 'initialize', and of */
+ Tcl_Obj **listv; /* its sublist in the 2nd element */
+ int methIndex; /* Encoded method name */
+ int result; /* Result code for 'initialize' */
+ Tcl_Obj *resObj; /* Result data for 'initialize' */
+ int methods; /* Bitmask for supported methods. */
+ ReflectedTransformMap *rtmPtr;
+ /* Map of reflected transforms with handlers
+ * in this interp. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
+ int isNew; /* Placeholder. */
+
+ /*
+ * Syntax: chan push CHANNEL CMDPREFIX
+ * [0] [1] [2] [3]
+ *
+ * Actually: rPush CHANNEL CMDPREFIX
+ * [0] [1] [2]
+ */
+
+#define CHAN (1)
+#define CMD (2)
+
+ /*
+ * Number of arguments...
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix");
+ return TCL_ERROR;
+ }
+
+ /*
+ * First argument is a channel handle.
+ */
+
+ chanObj = objv[CHAN];
+ parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
+ if (parentChan == NULL) {
+ return TCL_ERROR;
+ }
+ parentChan = Tcl_GetTopChannel(parentChan);
+
+ /*
+ * Second argument is command prefix, i.e. list of words, first word is
+ * name of handler command, other words are fixed arguments. Run the
+ * 'initialize' method to get the list of supported methods. Validate
+ * this.
+ */
+
+ cmdObj = objv[CMD];
+
+ /*
+ * Basic check that the command prefix truly is a list.
+ */
+
+ if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now create the transformation (channel).
+ */
+
+ rtId = NextHandle();
+ rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan);
+
+ /*
+ * Invoke 'initialize' and validate that the handler is present and ok.
+ * Squash the transformation if not.
+ */
+
+ modeObj = DecodeEventMask(mode);
+ /* assert modeObj.refCount == 1 */
+ result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
+ Tcl_DecrRefCount(modeObj);
+ if (result != TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ goto error;
+ }
+
+ /*
+ * Verify the result.
+ * - List, of method names. Convert to mask. Check for non-optionals
+ * through the mask. Compare open mode against optional r/w.
+ */
+
+ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+ Tcl_DecrRefCount(resObj);
+ goto error;
+ }
+
+ methods = 0;
+ while (listc > 0) {
+ if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
+ "method", TCL_EXACT, &methIndex) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned %s",
+ Tcl_GetString(cmdObj),
+ Tcl_GetString(Tcl_GetObjResult(interp))));
+ Tcl_DecrRefCount(resObj);
+ goto error;
+ }
+
+ methods |= FLAG(methIndex);
+ listc--;
+ }
+ Tcl_DecrRefCount(resObj);
+
+ if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
+ goto error;
+ }
+
+ /*
+ * Mode tell us what the parent channel supports. The methods tell us what
+ * the handler supports. We remove the non-supported bits from the mode
+ * and check that the channel is not completely inacessible. Afterward the
+ * mode tells us which methods are still required, and these methods will
+ * also be supported by the handler, by design of the check.
+ */
+
+ if (!HAS(methods, METH_READ)) {
+ mode &= ~TCL_READABLE;
+ }
+ if (!HAS(methods, METH_WRITE)) {
+ mode &= ~TCL_WRITABLE;
+ }
+
+ if (!mode) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ Tcl_GetString(cmdObj)));
+ goto error;
+ }
+
+ /*
+ * The mode and support for it is ok, now check the internal constraints.
+ */
+
+ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
+ 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))) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ Tcl_GetString(cmdObj)));
+ goto error;
+ }
+
+ Tcl_ResetResult(interp);
+
+ /*
+ * Everything is fine now.
+ */
+
+ rtPtr->methods = methods;
+ rtPtr->mode = mode;
+ rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, rtPtr, mode,
+ rtPtr->parent);
+
+ /*
+ * Register the transform in our our map for proper handling of deleted
+ * interpreters and/or threads.
+ */
+
+ rtmPtr = GetReflectedTransformMap(interp);
+ hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
+ if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
+ Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
+ }
+ Tcl_SetHashValue(hPtr, rtPtr);
+#ifdef TCL_THREADS
+ rtmPtr = GetThreadReflectedTransformMap();
+ hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
+ Tcl_SetHashValue(hPtr, rtPtr);
+#endif /* TCL_THREADS */
+
+ /*
+ * Return the channel as the result of the command.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetChannelName(rtPtr->chan), -1));
+ return TCL_OK;
+
+ error:
+ /*
+ * We are not going through ReflectClose as we never had a channel
+ * structure.
+ */
+
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ return TCL_ERROR;
+
+#undef CHAN
+#undef CMD
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPopObjCmd --
+ *
+ * This function is invoked to process the "chan pop" Tcl command. See
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Posts events to a reflected channel, invokes event handlers. The
+ * latter implies that arbitrary side effects are possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPopObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ /*
+ * Syntax: chan pop CHANNEL
+ * [0] [1] [2]
+ *
+ * Actually: rPop CHANNEL
+ * [0] [1]
+ */
+
+#define CHAN (1)
+
+ const char *chanId; /* Tcl level channel handle */
+ Tcl_Channel chan; /* Channel associated to the handle */
+ int mode; /* Channel r/w mode */
+
+ /*
+ * Number of arguments...
+ */
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channel");
+ return TCL_ERROR;
+ }
+
+ /*
+ * First argument is a channel, which may have a (reflected)
+ * transformation.
+ */
+
+ chanId = TclGetString(objv[CHAN]);
+ chan = Tcl_GetChannel(interp, chanId, &mode);
+
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Removing transformations is generic, and not restricted to reflected
+ * transformations.
+ */
+
+ Tcl_UnstackChannel(interp, chan);
+ return TCL_OK;
+
+#undef CHAN
+}
+
+/*
+ * Channel error message marshalling utilities.
+ */
+
+static Tcl_Obj *
+MarshallError(
+ Tcl_Interp *interp)
+{
+ /*
+ * Capture the result status of the interpreter into a string. => List of
+ * options and values, followed by the error message. The result has
+ * refCount 0.
+ */
+
+ Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
+
+ /*
+ * => returnOpt.refCount == 0. We can append directly.
+ */
+
+ Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
+ return returnOpt;
+}
+
+static void
+UnmarshallErrorResult(
+ Tcl_Interp *interp,
+ Tcl_Obj *msgObj)
+{
+ int lc;
+ Tcl_Obj **lv;
+ int explicitResult;
+ int numOptions;
+
+ /*
+ * Process the caught message.
+ *
+ * Syntax = (option value)... ?message?
+ *
+ * Bad syntax causes a panic. This is OK because the other side uses
+ * Tcl_GetReturnOptions and list construction functions to marshall the
+ * information; if we panic here, something has gone badly wrong already.
+ */
+
+ if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
+ }
+ if (interp == NULL) {
+ return;
+ }
+
+ explicitResult = lc & 1; /* Odd number of values? */
+ numOptions = lc - explicitResult;
+
+ if (explicitResult) {
+ Tcl_SetObjResult(interp, lv[lc-1]);
+ }
+
+ Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
+ ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+/*
+ * Driver functions. ================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectClose --
+ *
+ * This function is invoked when the channel is closed, to delete the
+ * driver specific instance data.
+ *
+ * Results:
+ * A posix error.
+ *
+ * Side effects:
+ * Releases memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectClose(
+ ClientData clientData,
+ Tcl_Interp *interp)
+{
+ ReflectedTransform *rtPtr = clientData;
+ 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
+ * in this interp. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
+
+ if (TclInThreadExit()) {
+ /*
+ * This call comes from TclFinalizeIOSystem. There are no
+ * interpreters, and therefore we cannot call upon the handler command
+ * anymore. Threading is irrelevant as well. We simply clean up all
+ * our C level data structures and leave the Tcl level to the other
+ * finalization functions.
+ */
+
+ /*
+ * THREADED => Forward this to the origin thread
+ *
+ * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
+ * for the origin thread. Use this to clean up the structure? Except
+ * if lost?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
+ result = p.base.code;
+
+ if (result != TCL_OK) {
+ FreeReceivedError(&p);
+ }
+ }
+#endif /* TCL_THREADS */
+
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ return EOK;
+ }
+
+ /*
+ * In the reflected channel implementation a cleaned method mask here
+ * implies that the channel creation was aborted, and "finalize" must not
+ * be called. for transformations however we are not going through here on
+ * such an abort, but directly through FreeReflectedTransform. So for us
+ * that check is not necessary. We always go through 'finalize'.
+ */
+
+ if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
+ if (!TransformDrain(rtPtr, &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)) {
+ if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ Tcl_EventuallyFree(rtPtr,
+ (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCode;
+ }
+#endif /* TCL_THREADS */
+ errorCodeSet = 1;
+ goto cleanup;
+ }
+ }
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
+ result = p.base.code;
+
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+
+ if (result != TCL_OK) {
+ PassReceivedErrorInterp(interp, &p);
+ return EINVAL;
+ }
+ return EOK;
+ }
+#endif /* TCL_THREADS */
+
+ /*
+ * Do the actual invokation of "finalize" now; we're in the right thread.
+ */
+
+ result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
+ if ((result != TCL_OK) && (interp != NULL)) {
+ Tcl_SetChannelErrorInterp(interp, resObj);
+ }
+
+ 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
+ * pointer.
+ *
+ * NOTE: The transform may not be in the map. This is ok, that happens
+ * when the transform was created in a different interpreter and/or thread
+ * and then was moved here.
+ *
+ * NOTE: The channel may have been removed from the map already via
+ * the per-interp DeleteReflectedTransformMap exit-handler.
+ */
+
+ 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.
+ */
+
+#ifdef TCL_THREADS
+ rtmPtr = GetThreadReflectedTransformMap();
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+#endif /* TCL_THREADS */
+ }
+
+ Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectInput --
+ *
+ * This function is invoked when more data is requested from the channel.
+ *
+ * Results:
+ * The number of bytes read.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectInput(
+ ClientData clientData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
+{
+ ReflectedTransform *rtPtr = clientData;
+ int gotBytes, copied, readBytes;
+
+ /*
+ * The following check can be done before thread redirection, because we
+ * are reading from an item which is readonly, i.e. will never change
+ * during the lifetime of the channel.
+ */
+
+ if (!(rtPtr->methods & FLAG(METH_READ))) {
+ SetChannelErrorStr(rtPtr->chan, msg_read_unsup);
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+
+ Tcl_Preserve(rtPtr);
+
+ gotBytes = 0;
+ while (toRead > 0) {
+ /*
+ * Loop until the request is satisfied (or no data available from
+ * below, possibly EOF).
+ */
+
+ copied = ResultCopy(&rtPtr->result, UCHARP(buf), toRead);
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
+
+ if (toRead == 0) {
+ goto stop;
+ }
+
+ /*
+ * 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 (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target
+ * to store the intermediary information read from the parent channel.
+ *
+ * Ask the transform how much data it allows us to read from the
+ * underlying channel. This feature allows the transform to signal EOF
+ * upstream although there is none downstream. Useful to control an
+ * unbounded 'fcopy' for example, either through counting bytes, or by
+ * pattern matching.
+ */
+
+ if ((rtPtr->methods & FLAG(METH_LIMIT))) {
+ int maxRead = -1;
+
+ if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) {
+ goto error;
+ }
+ if (maxRead == 0) {
+ goto stop;
+ } else if (maxRead > 0) {
+ if (maxRead < toRead) {
+ toRead = maxRead;
+ }
+ } /* else: 'maxRead < 0' == Accept the current value of toRead */
+ }
+
+ if (toRead <= 0) {
+ goto stop;
+ }
+
+ readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
+ 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.
+ */
+
+ goto stop;
+ }
+
+ *errorCodePtr = Tcl_GetErrno();
+ goto error;
+ }
+
+ if (readBytes == 0) {
+ /*
+ * 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.
+ */
+
+ if (!Tcl_Eof(rtPtr->parent)) {
+ /*
+ * The state of the seek system is unchanged!
+ */
+
+ if ((gotBytes == 0) && rtPtr->nonblocking) {
+ *errorCodePtr = EWOULDBLOCK;
+ goto error;
+ }
+ goto stop;
+ } else {
+ /*
+ * Eof in parent.
+ */
+
+ if (rtPtr->readIsDrained) {
+ goto stop;
+ }
+
+ /*
+ * Now this is a bit different. The partial data waiting is
+ * converted and returned.
+ */
+
+ if (HAS(rtPtr->methods, METH_DRAIN)) {
+ if (!TransformDrain(rtPtr, errorCodePtr)) {
+ goto error;
+ }
+ }
+
+ if (ResultLength(&rtPtr->result) == 0) {
+ /*
+ * The drain delivered nothing.
+ */
+
+ goto stop;
+ }
+
+ /*
+ * Reset eof, force caller to drain result buffer.
+ */
+
+ ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
+ continue; /* at: while (toRead > 0) */
+ }
+ } /* readBytes == 0 */
+
+ /*
+ * Transform the read chunk, which was not empty. Anything we got back
+ * is a transformation result is put into our buffers, and the next
+ * iteration will put it into the result.
+ */
+
+ if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) {
+ goto error;
+ }
+ } /* while toRead > 0 */
+
+ stop:
+ Tcl_Release(rtPtr);
+ return gotBytes;
+
+ error:
+ gotBytes = -1;
+ goto stop;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectOutput --
+ *
+ * This function is invoked when data is written to the channel.
+ *
+ * Results:
+ * The number of bytes actually written.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectOutput(
+ ClientData clientData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * The following check can be done before thread redirection, because we
+ * are reading from an item which is readonly, i.e. will never change
+ * during the lifetime of the channel.
+ */
+
+ if (!(rtPtr->methods & FLAG(METH_WRITE))) {
+ SetChannelErrorStr(rtPtr->chan, msg_write_unsup);
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+
+ if (toWrite == 0) {
+ /*
+ * Nothing came in to write, ignore the call
+ */
+
+ return 0;
+ }
+
+ /*
+ * Discard partial data in the input buffers, i.e. on the read side. Like
+ * we do when explicitly seeking as well.
+ */
+
+ Tcl_Preserve(rtPtr);
+
+ if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+ TransformClear(rtPtr);
+ }
+
+ /*
+ * Hand the data to the transformation itself. Anything it deigned to
+ * return to us is a (partial) transformation result and written to the
+ * parent channel for further processing.
+ */
+
+ if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) {
+ Tcl_Release(rtPtr);
+ return -1;
+ }
+
+ *errorCodePtr = EOK;
+ Tcl_Release(rtPtr);
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSeekWide / ReflectSeek --
+ *
+ * This function is invoked when the user wishes to seek on the channel.
+ *
+ * Results:
+ * The new location of the access point.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, per the parent channel, and the called
+ * scripts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+ReflectSeekWide(
+ ClientData clientData,
+ Tcl_WideInt offset,
+ int seekMode,
+ int *errorCodePtr)
+{
+ ReflectedTransform *rtPtr = clientData;
+ Channel *parent = (Channel *) rtPtr->parent;
+ Tcl_WideInt curPos; /* Position on the device. */
+
+ Tcl_DriverSeekProc *seekProc =
+ Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent));
+
+ /*
+ * Fail if the parent channel is not seekable.
+ */
+
+ if (seekProc == NULL) {
+ Tcl_SetErrno(EINVAL);
+ return Tcl_LongAsWide(-1);
+ }
+
+ /*
+ * Check if we can leave out involving the Tcl level, i.e. transformation
+ * handler. This is true for tell requests, and transformations which
+ * support neither flush, nor drain. For these cases we can pass the
+ * request down and the result back up unchanged.
+ */
+
+ Tcl_Preserve(rtPtr);
+
+ if (((seekMode != SEEK_CUR) || (offset != 0))
+ && (HAS(rtPtr->methods, METH_CLEAR)
+ || HAS(rtPtr->methods, METH_FLUSH))) {
+ /*
+ * Neither a tell request, nor clear/flush both not supported. We have
+ * to go through the Tcl level to clear and/or flush the
+ * transformation.
+ */
+
+ if (rtPtr->methods & FLAG(METH_CLEAR)) {
+ TransformClear(rtPtr);
+ }
+
+ /*
+ * When flushing the transform for seeking the generated results are
+ * irrelevant. We cannot put them into the channel, this would move
+ * the location, throwing it off with regard to where we are and are
+ * seeking to.
+ */
+
+ if (HAS(rtPtr->methods, METH_FLUSH)) {
+ if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) {
+ Tcl_Release(rtPtr);
+ return -1;
+ }
+ }
+ }
+
+ /*
+ * Now seek to the new position in the channel as requested by the
+ * caller. Note that we prefer the wideSeekProc if that is available and
+ * non-NULL...
+ */
+
+ if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
+ parent->typePtr->wideSeekProc != NULL) {
+ curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
+ seekMode, errorCodePtr);
+ } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
+ offset > Tcl_LongAsWide(LONG_MAX)) {
+ *errorCodePtr = EOVERFLOW;
+ curPos = Tcl_LongAsWide(-1);
+ } else {
+ curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
+ parent->instanceData, Tcl_WideAsLong(offset), seekMode,
+ errorCodePtr));
+ }
+ if (curPos == Tcl_LongAsWide(-1)) {
+ Tcl_SetErrno(*errorCodePtr);
+ }
+
+ *errorCodePtr = EOK;
+ Tcl_Release(rtPtr);
+ return curPos;
+}
+
+static int
+ReflectSeek(
+ ClientData clientData,
+ long offset,
+ int seekMode,
+ int *errorCodePtr)
+{
+ /*
+ * This function can be invoked from a transformation which is based on
+ * standard seeking, i.e. non-wide. Because of this we have to implement
+ * it, a dummy is not enough. We simply delegate the call to the wide
+ * routine.
+ */
+
+ return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+ errorCodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectWatch --
+ *
+ * This function is invoked to tell the channel what events the I/O
+ * system is interested in.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectWatch(
+ ClientData clientData,
+ int mask)
+{
+ ReflectedTransform *rtPtr = clientData;
+ Tcl_DriverWatchProc *watchProc;
+
+ watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent));
+ watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask);
+
+ /*
+ * Management of the internal timer.
+ */
+
+ if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) {
+ /*
+ * A pending timer may exist, but either is there no (more) interest
+ * in the events it generates or nothing is available for reading.
+ * Remove it, if existing.
+ */
+
+ TimerKill(rtPtr);
+ } else {
+ /*
+ * There might be no pending timer, but there is interest in readable
+ * events and we actually have data waiting, so generate a timer to
+ * flush that if it does not exist.
+ */
+
+ TimerSetup(rtPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectBlock --
+ *
+ * This function is invoked to tell the channel which blocking behaviour
+ * is required of it.
+ *
+ * Results:
+ * A posix error number.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectBlock(
+ ClientData clientData,
+ int nonblocking)
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * Transformations simply record the blocking mode in their C level
+ * structure for use by --> ReflectInput. The Tcl level doesn't see this
+ * information or change. As such thread forwarding is not required.
+ */
+
+ rtPtr->nonblocking = nonblocking;
+ return EOK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSetOption --
+ *
+ * This function is invoked to configure a channel option.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectSetOption(
+ ClientData clientData, /* Channel to query */
+ Tcl_Interp *interp, /* Interpreter to leave error messages in */
+ const char *optionName, /* Name of requested option */
+ const char *newValue) /* The new value */
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * Transformations have no options. Thus the call is passed down unchanged
+ * to the parent channel for processing. Its results are passed back
+ * unchanged as well. This all happens in the thread we are in. As the Tcl
+ * level is not involved there is no need for thread forwarding.
+ */
+
+ Tcl_DriverSetOptionProc *setOptionProc =
+ Tcl_ChannelSetOptionProc(Tcl_GetChannelType(rtPtr->parent));
+
+ if (setOptionProc == NULL) {
+ return TCL_ERROR;
+ }
+ return setOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp,
+ optionName, newValue);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectGetOption --
+ *
+ * This function is invoked to retrieve all or a channel options.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectGetOption(
+ ClientData clientData, /* Channel to query */
+ Tcl_Interp *interp, /* Interpreter to leave error messages in */
+ const char *optionName, /* Name of reuqested option */
+ Tcl_DString *dsPtr) /* String to place the result into */
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * Transformations have no options. Thus the call is passed down unchanged
+ * to the parent channel for processing. Its results are passed back
+ * unchanged as well. This all happens in the thread we are in. As the Tcl
+ * level is not involved there is no need for thread forwarding.
+ *
+ * Note that the parent not having a driver for option retrieval is not an
+ * immediate error. A query for all options is ok. Only a request for a
+ * specific option has to fail.
+ */
+
+ Tcl_DriverGetOptionProc *getOptionProc =
+ Tcl_ChannelGetOptionProc(Tcl_GetChannelType(rtPtr->parent));
+
+ if (getOptionProc != NULL) {
+ return getOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent),
+ interp, optionName, dsPtr);
+ } else if (optionName == NULL) {
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectHandle --
+ *
+ * This function is invoked to retrieve the associated file handle.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectHandle(
+ ClientData clientData,
+ int direction,
+ ClientData *handlePtr)
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * Transformations have no handle of their own. As such we simply query
+ * the parent channel for it. This way the qery will ripple down through
+ * all transformations until reaches the base channel. Which then returns
+ * its handle, or fails. The former will then ripple up the stack.
+ *
+ * This all happens in the thread we are in. As the Tcl level is not
+ * involved no forwarding is required.
+ */
+
+ return Tcl_GetChannelHandle(rtPtr->parent, direction, handlePtr);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectNotify --
+ *
+ * This function is invoked to reported incoming events.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectNotify(
+ ClientData clientData,
+ int mask)
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ /*
+ * An event occured in the underlying channel.
+ *
+ * We delete our timer. It was not fired, yet we are here, so the channel
+ * below generated such an event and we don't have to. The renewal of the
+ * interest after the execution of channel handlers will eventually cause
+ * us to recreate the timer (in ReflectWatch).
+ */
+
+ TimerKill(rtPtr);
+
+ /*
+ * Pass to higher layers.
+ */
+
+ return mask;
+}
+
+/*
+ * Helpers. =========================================================
+ */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodeEventMask --
+ *
+ * This function takes an internal bitmask of events and constructs the
+ * equivalent list of event items.
+ *
+ * Results:
+ * A Tcl_Obj reference. The object will have a refCount of one. The user
+ * has to decrement it to release the object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ * DUPLICATE of 'DecodeEventMask' in tclIORChan.c
+ */
+
+static Tcl_Obj *
+DecodeEventMask(
+ int mask)
+{
+ register const char *eventStr;
+ Tcl_Obj *evObj;
+
+ switch (mask & RANDW) {
+ case RANDW:
+ eventStr = "read write";
+ break;
+ case TCL_READABLE:
+ eventStr = "read";
+ break;
+ case TCL_WRITABLE:
+ eventStr = "write";
+ break;
+ default:
+ eventStr = "";
+ break;
+ }
+
+ evObj = Tcl_NewStringObj(eventStr, -1);
+ Tcl_IncrRefCount(evObj);
+ return evObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewReflectedTransform --
+ *
+ * This function is invoked to allocate and initialize the instance data
+ * of a new reflected channel.
+ *
+ * Results:
+ * A heap-allocated channel instance.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransform *
+NewReflectedTransform(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdpfxObj,
+ int mode,
+ Tcl_Obj *handleObj,
+ Tcl_Channel parentChan)
+{
+ ReflectedTransform *rtPtr;
+ int listc;
+ Tcl_Obj **listv;
+ int i;
+
+ rtPtr = ckalloc(sizeof(ReflectedTransform));
+
+ /* rtPtr->chan: Assigned by caller. Dummy data here. */
+ /* rtPtr->methods: Assigned by caller. Dummy data here. */
+
+ rtPtr->chan = NULL;
+ rtPtr->methods = 0;
+#ifdef TCL_THREADS
+ rtPtr->thread = Tcl_GetCurrentThread();
+#endif
+ rtPtr->parent = parentChan;
+ rtPtr->interp = interp;
+ rtPtr->handle = handleObj;
+ Tcl_IncrRefCount(handleObj);
+ rtPtr->timer = NULL;
+ rtPtr->mode = 0;
+ rtPtr->readIsDrained = 0;
+ rtPtr->nonblocking =
+ (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
+ rtPtr->dead = 0;
+
+ /*
+ * Query parent for current blocking mode.
+ */
+
+ ResultInit(&rtPtr->result);
+
+ /*
+ * Method placeholder.
+ */
+
+ /* ASSERT: cmdpfxObj is a Tcl List */
+
+ Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
+
+ /*
+ * See [==] as well.
+ * Storage for the command prefix and the additional words required for
+ * the invocation of methods in the command handler.
+ *
+ * listv [0] [listc-1] | [listc] [listc+1] |
+ * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
+ * cmd ... pfx | method chan | detail1 detail2
+ */
+
+ rtPtr->argc = listc + 2;
+ rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
+
+ /*
+ * Duplicate object references.
+ */
+
+ for (i=0; i<listc ; i++) {
+ Tcl_Obj *word = rtPtr->argv[i] = listv[i];
+
+ Tcl_IncrRefCount(word);
+ }
+
+ i++; /* Skip placeholder for method */
+
+ /*
+ * See [x] in FreeReflectedTransform for release
+ */
+ rtPtr->argv[i] = handleObj;
+ Tcl_IncrRefCount(handleObj);
+
+ /*
+ * The next two objects are kept empty, varying arguments.
+ */
+
+ /*
+ * Initialization complete.
+ */
+
+ return rtPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextHandle --
+ *
+ * This function is invoked to generate a channel handle for a new
+ * reflected channel.
+ *
+ * Results:
+ * A Tcl_Obj containing the string of the new channel handle. The
+ * refcount of the returned object is -- zero --.
+ *
+ * Side effects:
+ * May allocate memory. Mutex protected critical section locks out other
+ * threads for a short time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NextHandle(void)
+{
+ /*
+ * Count number of generated reflected channels. Used for id generation.
+ * Ids are never reclaimed and there is no dealing with wrap around. On
+ * the other hand, "unsigned long" should be big enough except for
+ * absolute longrunners (generate a 100 ids per second => overflow will
+ * occur in 1 1/3 years).
+ */
+
+ TCL_DECLARE_MUTEX(rtCounterMutex)
+ static unsigned long rtCounter = 0;
+ Tcl_Obj *resObj;
+
+ Tcl_MutexLock(&rtCounterMutex);
+ resObj = Tcl_ObjPrintf("rt%lu", rtCounter);
+ rtCounter++;
+ Tcl_MutexUnlock(&rtCounterMutex);
+
+ return resObj;
+}
+
+static void
+FreeReflectedTransformArgs(
+ ReflectedTransform *rtPtr)
+{
+ int i, n = rtPtr->argc - 2;
+
+ if (n < 0) {
+ return;
+ }
+
+ Tcl_DecrRefCount(rtPtr->handle);
+ rtPtr->handle = NULL;
+
+ for (i=0; i<n; i++) {
+ Tcl_DecrRefCount(rtPtr->argv[i]);
+ }
+
+ /*
+ * See [x] in NewReflectedTransform for lock
+ * n+1 = argc-1.
+ */
+ Tcl_DecrRefCount(rtPtr->argv[n+1]);
+
+ rtPtr->argc = 1;
+}
+
+static void
+FreeReflectedTransform(
+ ReflectedTransform *rtPtr)
+{
+ TimerKill(rtPtr);
+ ResultClear(&rtPtr->result);
+
+ FreeReflectedTransformArgs(rtPtr);
+
+ ckfree(rtPtr->argv);
+ ckfree(rtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeTclMethod --
+ *
+ * This function is used to invoke the Tcl level of a reflected channel.
+ * It handles all the command assembly, invokation, and generic state and
+ * result mgmt. It does *not* handle thread redirection; that is the
+ * responsibility of clients of this function.
+ *
+ * Results:
+ * Result code and data as returned by the method.
+ *
+ * Side effects:
+ * Arbitrary, as it calls upon a Tcl script.
+ *
+ * Contract:
+ * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
+ * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
+ * resObj.refCount in {0, 1, ...}
+ *
+ *----------------------------------------------------------------------
+ * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
+ * - Semi because different structures are used.
+ * - Still possible to factor out the commonalities into a separate structure.
+ */
+
+static int
+InvokeTclMethod(
+ ReflectedTransform *rtPtr,
+ const char *method,
+ Tcl_Obj *argOneObj, /* NULL'able */
+ Tcl_Obj *argTwoObj, /* NULL'able */
+ Tcl_Obj **resultObjPtr) /* NULL'able */
+{
+ int cmdc; /* #words in constructed command */
+ Tcl_Obj *methObj = NULL; /* Method name in object form */
+ Tcl_InterpState sr; /* State of handler interp */
+ int result; /* Result code of method invokation */
+ Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+
+ if (rtPtr->dead) {
+ /*
+ * The transform is marked as dead. Bail out immediately, with an
+ * appropriate error.
+ */
+
+ if (resultObjPtr != NULL) {
+ resObj = Tcl_NewStringObj(msg_dstlost,-1);
+ *resultObjPtr = resObj;
+ Tcl_IncrRefCount(resObj);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * NOTE (5): Decide impl. issue: Cache objects with method names?
+ * Requires TSD data as reflections can be created in many different
+ * threads.
+ * NO: Caching of command resolutions means storage per channel.
+ */
+
+ /*
+ * Insert method into the pre-allocated area, after the command prefix,
+ * before the channel id.
+ */
+
+ methObj = Tcl_NewStringObj(method, -1);
+ Tcl_IncrRefCount(methObj);
+ rtPtr->argv[rtPtr->argc - 2] = methObj;
+
+ /*
+ * Append the additional argument containing method specific details
+ * behind the channel id. If specified.
+ *
+ * Because of the contract there is no need to increment the refcounts.
+ * The objects will survive the Tcl_EvalObjv without change.
+ */
+
+ cmdc = rtPtr->argc;
+ if (argOneObj) {
+ rtPtr->argv[cmdc] = argOneObj;
+ cmdc++;
+ if (argTwoObj) {
+ rtPtr->argv[cmdc] = argTwoObj;
+ cmdc++;
+ }
+ }
+
+ /*
+ * And run the handler... This is done in auch a manner which leaves any
+ * existing state intact.
+ */
+
+ sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
+ Tcl_Preserve(rtPtr);
+ result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
+
+ /*
+ * We do not try to extract the result information if the caller has no
+ * interest in it. I.e. there is no need to put effort into creating
+ * something which is discarded immediately after.
+ */
+
+ if (resultObjPtr) {
+ if (result == TCL_OK) {
+ /*
+ * Ok result taken as is, also if the caller requests that there
+ * is no capture.
+ */
+
+ resObj = Tcl_GetObjResult(rtPtr->interp);
+ } else {
+ /*
+ * Non-ok result is always treated as an error. We have to capture
+ * the full state of the result, including additional options.
+ *
+ * This is complex and ugly, and would be completely unnecessary
+ * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
+ */
+ if (result != TCL_ERROR) {
+ Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
+ int cmdLen;
+ const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+
+ Tcl_IncrRefCount(cmd);
+ Tcl_ResetResult(rtPtr->interp);
+ Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
+ "chan handler returned bad code: %d", result));
+ Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
+ Tcl_DecrRefCount(cmd);
+ result = TCL_ERROR;
+ }
+ Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf(
+ "\n (chan handler subcommand \"%s\")", method));
+ resObj = MarshallError(rtPtr->interp);
+ }
+ Tcl_IncrRefCount(resObj);
+ }
+ Tcl_RestoreInterpState(rtPtr->interp, sr);
+ Tcl_Release(rtPtr);
+
+ /*
+ * Cleanup of the dynamic parts of the command.
+ *
+ * The detail objects survived the Tcl_EvalObjv without change because of
+ * the contract. Therefore there is no need to decrement the refcounts. Only
+ * the internal method object has to be disposed of.
+ */
+
+ Tcl_DecrRefCount(methObj);
+
+ /*
+ * The resObj has a ref count of 1 at this location. This means that the
+ * caller of InvokeTclMethod has to dispose of it (but only if it was
+ * returned to it).
+ */
+
+ if (resultObjPtr != NULL) {
+ *resultObjPtr = resObj;
+ }
+
+ /*
+ * There no need to handle the case where nothing is returned, because for
+ * that case resObj was not set anyway.
+ */
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReflectedTransformMap --
+ *
+ * Gets and potentially initializes the reflected channel map for an
+ * interpreter.
+ *
+ * Results:
+ * A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ * Initializes the reflected channel map for an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransformMap *
+GetReflectedTransformMap(
+ Tcl_Interp *interp)
+{
+ ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
+
+ if (rtmPtr == NULL) {
+ rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
+ Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, RTMKEY,
+ (Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
+ }
+ return rtmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteReflectedTransformMap --
+ *
+ * Deletes the channel table for an interpreter, closing any open
+ * channels whose refcount reaches zero. This procedure is invoked when
+ * an interpreter is deleted, via the AssocData cleanup mechanism.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the hash table of channels. May close channels. May flush
+ * output on closed channels. Removes any channeEvent handlers that were
+ * registered in this interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteReflectedTransformMap(
+ ClientData clientData, /* The per-interpreter data structure. */
+ Tcl_Interp *interp) /* The interpreter being deleted. */
+{
+ ReflectedTransformMap *rtmPtr; /* The map */
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ ReflectedTransform *rtPtr;
+#ifdef TCL_THREADS
+ ForwardingResult *resultPtr;
+ ForwardingEvent *evPtr;
+ ForwardParam *paramPtr;
+#endif /* TCL_THREADS */
+
+ /*
+ * Delete all entries. The channels may have been closed already, or will
+ * be closed later, by the standard IO finalization of an interpreter
+ * under destruction. Except for the channels which were moved to a
+ * different interpreter and/or thread. They do not exist from the IO
+ * systems point of view and will not get closed. Therefore mark all as
+ * dead so that any future access will cause a proper error. For channels
+ * in a different thread we actually do the same as
+ * DeleteThreadReflectedTransformMap(), just restricted to the channels of
+ * this interp.
+ */
+
+ rtmPtr = clientData;
+ for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
+ rtPtr = Tcl_GetHashValue(hPtr);
+
+ rtPtr->dead = 1;
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(&rtmPtr->map);
+ ckfree(&rtmPtr->map);
+
+#ifdef TCL_THREADS
+ /*
+ * The origin interpreter for one or more reflected channels is gone.
+ */
+
+ /*
+ * 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.
+ */
+
+ Tcl_MutexLock(&rtForwardMutex);
+
+ for (resultPtr = forwardList; resultPtr != NULL;
+ resultPtr = resultPtr->nextPtr) {
+ if (resultPtr->dsti != interp) {
+ /*
+ * Ignore results/events for other interpreters.
+ */
+
+ continue;
+ }
+
+ /*
+ * The receiver for the event exited, before processing the event. We
+ * detach the result now, wake the originator up and signal failure.
+ */
+
+ evPtr = resultPtr->evPtr;
+ paramPtr = evPtr->param;
+
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
+
+ ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+ Tcl_ConditionNotify(&resultPtr->done);
+ }
+ Tcl_MutexUnlock(&rtForwardMutex);
+#endif /* TCL_THREADS */
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadReflectedTransformMap --
+ *
+ * Gets and potentially initializes the reflected channel map for a
+ * thread.
+ *
+ * Results:
+ * A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ * Initializes the reflected channel map for a thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransformMap *
+GetThreadReflectedTransformMap(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->rtmPtr) {
+ tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
+ Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
+ Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
+ }
+
+ return tsdPtr->rtmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteThreadReflectedTransformMap --
+ *
+ * Deletes the channel table for a thread. This procedure is invoked when
+ * a thread is deleted. The channels have already been marked as dead, in
+ * DeleteReflectedTransformMap().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the hash table of channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteThreadReflectedTransformMap(
+ ClientData clientData) /* The per-thread data structure. */
+{
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ Tcl_ThreadId self = Tcl_GetCurrentThread();
+ ReflectedTransformMap *rtmPtr; /* The map */
+ ForwardingResult *resultPtr;
+
+ /*
+ * The origin thread for one or more reflected channels is gone.
+ * NOTE: If this function is called due to a thread getting killed the
+ * per-interp DeleteReflectedTransformMap is apparently not called.
+ */
+
+ /*
+ * 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.
+ */
+
+ Tcl_MutexLock(&rtForwardMutex);
+
+ for (resultPtr = forwardList; resultPtr != NULL;
+ resultPtr = resultPtr->nextPtr) {
+ ForwardingEvent *evPtr;
+ ForwardParam *paramPtr;
+
+ if (resultPtr->dst != self) {
+ /*
+ * Ignore results/events for other threads.
+ */
+
+ continue;
+ }
+
+ /*
+ * The receiver for the event exited, before processing the event. We
+ * detach the result now, wake the originator up and signal failure.
+ */
+
+ evPtr = resultPtr->evPtr;
+ paramPtr = evPtr->param;
+
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
+
+ ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+ Tcl_ConditionNotify(&resultPtr->done);
+ }
+ Tcl_MutexUnlock(&rtForwardMutex);
+}
+
+static void
+ForwardOpToOwnerThread(
+ ReflectedTransform *rtPtr, /* Channel instance */
+ ForwardedOperation op, /* Forwarded driver operation */
+ const void *param) /* Arguments */
+{
+ Tcl_ThreadId dst = rtPtr->thread;
+ ForwardingEvent *evPtr;
+ ForwardingResult *resultPtr;
+
+ /*
+ * We gather the lock early. This allows us to check the liveness of the
+ * channel without interference from DeleteThreadReflectedTransformMap().
+ */
+
+ Tcl_MutexLock(&rtForwardMutex);
+
+ 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.
+ */
+
+ ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
+ Tcl_MutexUnlock(&rtForwardMutex);
+ return;
+ }
+
+ /*
+ * Create and initialize the event and data structures.
+ */
+
+ evPtr = ckalloc(sizeof(ForwardingEvent));
+ resultPtr = ckalloc(sizeof(ForwardingResult));
+
+ evPtr->event.proc = ForwardProc;
+ evPtr->resultPtr = resultPtr;
+ evPtr->op = op;
+ evPtr->rtPtr = rtPtr;
+ evPtr->param = (ForwardParam *) param;
+
+ resultPtr->src = Tcl_GetCurrentThread();
+ resultPtr->dst = dst;
+ resultPtr->dsti = rtPtr->interp;
+ resultPtr->done = NULL;
+ resultPtr->result = -1;
+ resultPtr->evPtr = evPtr;
+
+ /*
+ * Now execute the forward.
+ */
+
+ TclSpliceIn(resultPtr, forwardList);
+ /* Do not unlock here. That is done by the ConditionWait */
+
+ /*
+ * 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
+ * GetThreadReflectedTransformMap(). This is what we use the 'forwardList'
+ * (see above) for.
+ */
+
+ Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);
+
+ /*
+ * Queue the event and poke the other thread's notifier.
+ */
+
+ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ Tcl_ThreadAlert(dst);
+
+ /*
+ * (*) Block until the other thread has either processed the transfer or
+ * rejected it.
+ */
+
+ while (resultPtr->result < 0) {
+ /*
+ * NOTE (1): Is it possible that the current thread goes away while
+ * waiting here? IOW Is it possible that "SrcExitProc" is called
+ * while we are here? See complementary note (2) in "SrcExitProc"
+ *
+ * The ConditionWait unlocks the mutex during the wait and relocks it
+ * immediately after.
+ */
+
+ Tcl_ConditionWait(&resultPtr->done, &rtForwardMutex, NULL);
+ }
+
+ /*
+ * Unlink result from the forwarder list. No need to lock. Either still
+ * locked, or locked by the ConditionWait
+ */
+
+ TclSpliceOut(resultPtr, forwardList);
+
+ resultPtr->nextPtr = NULL;
+ resultPtr->prevPtr = NULL;
+
+ Tcl_MutexUnlock(&rtForwardMutex);
+ Tcl_ConditionFinalize(&resultPtr->done);
+
+ /*
+ * Kill the cleanup handler now, and the result structure as well, before
+ * returning the success code.
+ *
+ * Note: The event structure has already been deleted by the destination
+ * notifier, after it serviced the event.
+ */
+
+ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
+
+ ckfree(resultPtr);
+}
+
+static int
+ForwardProc(
+ Tcl_Event *evGPtr,
+ int mask)
+{
+ /*
+ * Notes regarding access to the referenced data.
+ *
+ * In principle the data belongs to the originating thread (see
+ * evPtr->src), however this thread is currently blocked at (*), i.e.
+ * quiescent. Because of this we can treat the data as belonging to us,
+ * without fear of race conditions. I.e. we can read and write as we like.
+ *
+ * The only thing we cannot be sure of is the resultPtr. This can be be
+ * NULLed if the originating thread went away while the event is handled
+ * here now.
+ */
+
+ ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
+ ForwardingResult *resultPtr = evPtr->resultPtr;
+ ReflectedTransform *rtPtr = evPtr->rtPtr;
+ Tcl_Interp *interp = rtPtr->interp;
+ ForwardParam *paramPtr = evPtr->param;
+ Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
+ ReflectedTransformMap *rtmPtr;
+ /* Map of reflected channels with handlers in
+ * this interp. */
+ Tcl_HashEntry *hPtr; /* Entry in the above map */
+
+ /*
+ * Ignore the event if no one is waiting for its result anymore.
+ */
+
+ if (!resultPtr) {
+ return 1;
+ }
+
+ paramPtr->base.code = TCL_OK;
+ paramPtr->base.msgStr = NULL;
+ paramPtr->base.mustFree = 0;
+
+ switch (evPtr->op) {
+ /*
+ * The destination thread for the following operations is
+ * rtPtr->thread, which contains rtPtr->interp, the interp we have to
+ * call upon for the driver.
+ */
+
+ case ForwardedClose:
+ /*
+ * No parameters/results.
+ */
+
+ if (InvokeTclMethod(rtPtr, "finalize", NULL, NULL,
+ &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+
+ /*
+ * Freeing is done here, in the origin thread, because the argv[]
+ * objects belong to this thread. Deallocating them in a different
+ * thread is not allowed
+ */
+
+ /*
+ * Remove the channel from the map before releasing the memory, to
+ * prevent future accesses (like by 'postevent') from finding and
+ * dereferencing a dangling pointer.
+ */
+
+ rtmPtr = GetReflectedTransformMap(interp);
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ 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.
+ */
+
+ rtmPtr = GetThreadReflectedTransformMap();
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ Tcl_DeleteHashEntry(hPtr);
+
+ FreeReflectedTransformArgs(rtPtr);
+ break;
+
+ case ForwardedInput: {
+ Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+ paramPtr->transform.buf, paramPtr->transform.size);
+ Tcl_IncrRefCount(bufObj);
+
+ if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->transform.size = -1;
+ } else {
+ /*
+ * Process a regular return. Contains the transformation result.
+ * Sent it back to the request originator.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev;
+ /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ paramPtr->transform.size = bytec;
+
+ if (bytec > 0) {
+ paramPtr->transform.buf = ckalloc(bytec);
+ memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+ } else {
+ paramPtr->transform.buf = NULL;
+ }
+ }
+
+ Tcl_DecrRefCount(bufObj);
+ break;
+ }
+
+ case ForwardedOutput: {
+ Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+ paramPtr->transform.buf, paramPtr->transform.size);
+ Tcl_IncrRefCount(bufObj);
+
+ if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->transform.size = -1;
+ } else {
+ /*
+ * Process a regular return. Contains the transformation result.
+ * Sent it back to the request originator.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev;
+ /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ paramPtr->transform.size = bytec;
+
+ if (bytec > 0) {
+ paramPtr->transform.buf = ckalloc(bytec);
+ memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+ } else {
+ paramPtr->transform.buf = NULL;
+ }
+ }
+
+ Tcl_DecrRefCount(bufObj);
+ break;
+ }
+
+ case ForwardedDrain:
+ if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->transform.size = -1;
+ } else {
+ /*
+ * Process a regular return. Contains the transformation result.
+ * Sent it back to the request originator.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ paramPtr->transform.size = bytec;
+
+ if (bytec > 0) {
+ paramPtr->transform.buf = ckalloc(bytec);
+ memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+ } else {
+ paramPtr->transform.buf = NULL;
+ }
+ }
+ break;
+
+ case ForwardedFlush:
+ if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->transform.size = -1;
+ } else {
+ /*
+ * Process a regular return. Contains the transformation result.
+ * Sent it back to the request originator.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev;
+ /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ paramPtr->transform.size = bytec;
+
+ if (bytec > 0) {
+ paramPtr->transform.buf = ckalloc(bytec);
+ memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+ } else {
+ paramPtr->transform.buf = NULL;
+ }
+ }
+ break;
+
+ case ForwardedClear:
+ (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+ break;
+
+ case ForwardedLimit:
+ if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->limit.max = -1;
+ } else if (Tcl_GetIntFromObj(interp, resObj,
+ &paramPtr->limit.max) != TCL_OK) {
+ ForwardSetObjError(paramPtr, MarshallError(interp));
+ paramPtr->limit.max = -1;
+ }
+ break;
+
+ default:
+ /*
+ * Bad operation code.
+ */
+ Tcl_Panic("Bad operation code in ForwardProc");
+ break;
+ }
+
+ /*
+ * Remove the reference we held on the result of the invoke, if we had
+ * such.
+ */
+
+ if (resObj != NULL) {
+ Tcl_DecrRefCount(resObj);
+ }
+
+ if (resultPtr) {
+ /*
+ * Report the forwarding result synchronously to the waiting caller.
+ * This unblocks (*) as well. This is wrapped into a conditional
+ * because the caller may have exited in the mean time.
+ */
+
+ Tcl_MutexLock(&rtForwardMutex);
+ resultPtr->result = TCL_OK;
+ Tcl_ConditionNotify(&resultPtr->done);
+ Tcl_MutexUnlock(&rtForwardMutex);
+ }
+
+ return 1;
+}
+
+static void
+SrcExitProc(
+ ClientData clientData)
+{
+ ForwardingEvent *evPtr = clientData;
+ ForwardingResult *resultPtr;
+ ForwardParam *paramPtr;
+
+ /*
+ * NOTE (2): Can this handler be called with the originator blocked?
+ */
+
+ /*
+ * The originator for the event exited. It is not sure if this can happen,
+ * as the originator should be blocked at (*) while the event is in
+ * transit/pending.
+ *
+ * We make sure that the event cannot refer to the result anymore, remove
+ * it from the list of pending results and free the structure. Locking the
+ * access ensures that we cannot get in conflict with "ForwardProc",
+ * should it already execute the event.
+ */
+
+ Tcl_MutexLock(&rtForwardMutex);
+
+ resultPtr = evPtr->resultPtr;
+ paramPtr = evPtr->param;
+
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
+
+ ForwardSetStaticError(paramPtr, msg_send_originlost);
+
+ /*
+ * See below: TclSpliceOut(resultPtr, forwardList);
+ */
+
+ Tcl_MutexUnlock(&rtForwardMutex);
+
+ /*
+ * This unlocks (*). The structure will be spliced out and freed by
+ * "ForwardProc". Maybe.
+ */
+
+ Tcl_ConditionNotify(&resultPtr->done);
+}
+
+static void
+ForwardSetObjError(
+ ForwardParam *paramPtr,
+ Tcl_Obj *obj)
+{
+ int len;
+ const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+
+ len++;
+ ForwardSetDynamicError(paramPtr, ckalloc(len));
+ memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
+}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerKill --
+ *
+ * Timer management. Removes the internal timer if it exists.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerKill(
+ ReflectedTransform *rtPtr)
+{
+ if (rtPtr->timer == NULL) {
+ return;
+ }
+
+ /*
+ * Delete an existing flush-out timer, prevent it from firing on a
+ * removed/dead channel.
+ */
+
+ Tcl_DeleteTimerHandler(rtPtr->timer);
+ rtPtr->timer = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerSetup --
+ *
+ * Timer management. Creates the internal timer if it does not exist.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerSetup(
+ ReflectedTransform *rtPtr)
+{
+ if (rtPtr->timer != NULL) {
+ return;
+ }
+
+ rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ TimerRun, rtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerRun --
+ *
+ * Called by the notifier (-> timer) to flush out information waiting in
+ * channel buffers.
+ *
+ * Side effects:
+ * As of 'Tcl_NotifyChannel'.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerRun(
+ ClientData clientData)
+{
+ ReflectedTransform *rtPtr = clientData;
+
+ rtPtr->timer = NULL;
+ Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultInit --
+ *
+ * Initializes the specified buffer structure. The structure will contain
+ * valid information for an emtpy buffer.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultInit(
+ ResultBuffer *rPtr) /* Reference to the structure to
+ * initialize. */
+{
+ rPtr->used = 0;
+ rPtr->allocated = 0;
+ rPtr->buf = NULL;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultClear --
+ *
+ * Deallocates any memory allocated by 'ResultAdd'.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultClear(
+ ResultBuffer *rPtr) /* Reference to the buffer to clear out */
+{
+ rPtr->used = 0;
+
+ if (!rPtr->allocated) {
+ return;
+ }
+
+ ckfree((char *) rPtr->buf);
+ rPtr->buf = NULL;
+ rPtr->allocated = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultAdd --
+ *
+ * Adds the bytes in the specified array to the buffer, by appending it.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultAdd(
+ ResultBuffer *rPtr, /* The buffer to extend */
+ unsigned char *buf, /* The buffer to read from */
+ int toWrite) /* The number of bytes in 'buf' */
+{
+ if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
+ /*
+ * Extension of the internal buffer is required.
+ * NOTE: Currently linear. Should be doubling to amortize.
+ */
+
+ if (rPtr->allocated == 0) {
+ rPtr->allocated = toWrite + RB_INCREMENT;
+ rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
+ } else {
+ rPtr->allocated += toWrite + RB_INCREMENT;
+ rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
+ rPtr->allocated));
+ }
+ }
+
+ /*
+ * Now copy data.
+ */
+
+ memcpy(rPtr->buf + rPtr->used, buf, toWrite);
+ rPtr->used += toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 int
+ResultCopy(
+ ResultBuffer *rPtr, /* The buffer to read from */
+ unsigned char *buf, /* The buffer to copy into */
+ int toRead) /* Number of requested bytes */
+{
+ int copied;
+
+ if (rPtr->used == 0) {
+ /*
+ * Nothing to copy in the case of an empty buffer.
+ */
+
+ copied = 0;
+ } else if (rPtr->used == toRead) {
+ /*
+ * We have just enough. Copy everything to the caller.
+ */
+
+ memcpy(buf, rPtr->buf, toRead);
+ rPtr->used = 0;
+ copied = toRead;
+ } else if (rPtr->used > toRead) {
+ /*
+ * The internal buffer contains more than requested. Copy the
+ * requested subset to the caller, and shift the remaining bytes down.
+ */
+
+ memcpy(buf, rPtr->buf, toRead);
+ memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead);
+
+ rPtr->used -= toRead;
+ copied = toRead;
+ } else {
+ /*
+ * There is not enough in the buffer to satisfy the caller, so take
+ * everything.
+ */
+
+ memcpy(buf, rPtr->buf, rPtr->used);
+ toRead = rPtr->used;
+ rPtr->used = 0;
+ copied = toRead;
+ }
+
+ /* -- common postwork code ------- */
+
+ return copied;
+}
+
+static int
+TransformRead(
+ ReflectedTransform *rtPtr,
+ int *errorCodePtr,
+ unsigned char *buf,
+ int toRead)
+{
+ Tcl_Obj *bufObj;
+ Tcl_Obj *resObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ p.transform.buf = (char *) buf;
+ p.transform.size = toRead;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rtPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+ ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
+ ckfree(p.transform.buf);
+ return 1;
+ }
+#endif /* TCL_THREADS */
+
+ /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+ /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
+ Tcl_IncrRefCount(bufObj);
+
+ if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
+ Tcl_SetChannelError(rtPtr->chan, resObj);
+ Tcl_DecrRefCount(bufObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+ ResultAdd(&rtPtr->result, bytev, bytec);
+
+ Tcl_DecrRefCount(bufObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return 1;
+}
+
+static int
+TransformWrite(
+ ReflectedTransform *rtPtr,
+ int *errorCodePtr,
+ unsigned char *buf,
+ int toWrite)
+{
+ Tcl_Obj *bufObj;
+ Tcl_Obj *resObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+ int res;
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ p.transform.buf = (char *) buf;
+ p.transform.size = toWrite;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rtPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+ res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
+ p.transform.size);
+ ckfree(p.transform.buf);
+ } else
+#endif /* TCL_THREADS */
+ {
+ /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
+ /* ASSERT: rtPtr->mode & TCL_WRITABLE */
+
+ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+ Tcl_IncrRefCount(bufObj);
+ if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ Tcl_SetChannelError(rtPtr->chan, resObj);
+
+ Tcl_DecrRefCount(bufObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+ res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
+
+ Tcl_DecrRefCount(bufObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ }
+
+ if (res < 0) {
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ return 1;
+}
+
+static int
+TransformDrain(
+ ReflectedTransform *rtPtr,
+ int *errorCodePtr)
+{
+ Tcl_Obj *resObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rtPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+ ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
+ ckfree(p.transform.buf);
+ } else
+#endif /* TCL_THREADS */
+ {
+ if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rtPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+ ResultAdd(&rtPtr->result, bytev, bytec);
+
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ }
+
+ rtPtr->readIsDrained = 1;
+ return 1;
+}
+
+static int
+TransformFlush(
+ ReflectedTransform *rtPtr,
+ int *errorCodePtr,
+ int op)
+{
+ Tcl_Obj *resObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+ int res;
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rtPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+ if (op == FLUSH_WRITE) {
+ res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
+ p.transform.size);
+ } else {
+ res = 0;
+ }
+ ckfree(p.transform.buf);
+ } else
+#endif /* TCL_THREADS */
+ {
+ if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rtPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ if (op == FLUSH_WRITE) {
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+ res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
+ } else {
+ res = 0;
+ }
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ }
+
+ if (res < 0) {
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ return 1;
+}
+
+static void
+TransformClear(
+ ReflectedTransform *rtPtr)
+{
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
+ return;
+ }
+#endif /* TCL_THREADS */
+
+ /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+ /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+ (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+
+ rtPtr->readIsDrained = 0;
+ ResultClear(&rtPtr->result);
+}
+
+static int
+TransformLimit(
+ ReflectedTransform *rtPtr,
+ int *errorCodePtr,
+ int *maxPtr)
+{
+ Tcl_Obj *resObj;
+ Tcl_InterpState sr; /* State of handler interp */
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rtPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ *errorCodePtr = EOK;
+ *maxPtr = p.limit.max;
+ return 1;
+ }
+#endif
+
+ /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
+ /* ASSERT: rtPtr->mode & TCL_WRITABLE */
+
+ if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
+ Tcl_SetChannelError(rtPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+
+ sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
+
+ if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) {
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp));
+ *errorCodePtr = EINVAL;
+
+ Tcl_RestoreInterpState(rtPtr->interp, sr);
+ return 0;
+ }
+
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_RestoreInterpState(rtPtr->interp, sr);
+ return 1;
+}
+
+/* DUPLICATE of HaveVersion() in tclIO.c
+ *----------------------------------------------------------------------
+ *
+ * HaveVersion --
+ *
+ * Return whether a channel type is (at least) of a given version.
+ *
+ * Results:
+ * True if the minimum version is exceeded by the version actually
+ * present.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HaveVersion(
+ const Tcl_ChannelType *chanTypePtr,
+ Tcl_ChannelTypeVersion minimumVersion)
+{
+ Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
+
+ return PTR2INT(actualVersion) >= PTR2INT(minimumVersion);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 366d0ab..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.9 2005/07/19 22:45:35 dkf 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
/*
*---------------------------------------------------------------------------
@@ -33,15 +37,15 @@
*/
int
-TclSockGetPort(interp, string, proto, portPtr)
- Tcl_Interp *interp;
- char *string; /* Integer or service name */
- char *proto; /* "tcp" or "udp", typically */
- int *portPtr; /* Return port number */
+TclSockGetPort(
+ Tcl_Interp *interp,
+ const char *string, /* Integer or service name */
+ const char *proto, /* "tcp" or "udp", typically */
+ int *portPtr) /* Return port number */
{
struct servent *sp; /* Protocol info for named services */
Tcl_DString ds;
- CONST char *native;
+ const char *native;
if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
/*
@@ -60,8 +64,8 @@ TclSockGetPort(interp, string, proto, portPtr)
return TCL_ERROR;
}
if (*portPtr > 0xFFFF) {
- Tcl_AppendResult(interp, "couldn't open socket: port number too high",
- (char *) 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(interp, string, proto, portPtr)
*----------------------------------------------------------------------
*/
+#if !defined(_WIN32) && !defined(__CYGWIN__)
+# define SOCKET int
+#endif
+
int
-TclSockMinimumBuffers(sock, size)
- int sock; /* Socket file descriptor */
- int size; /* Minimum buffer size */
+TclSockMinimumBuffers(
+ 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 124da3a..f624cb7 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -5,7 +5,7 @@
* code, which supports a pluggable filesystem architecture allowing both
* platform specific filesystems and 'virtual filesystems'. All
* filesystem access should go through the functions defined in this
- * file. Most of this code was contributed by Vince Darley.
+ * file. Most of this code was contributed by Vince Darley.
*
* Parts of this file are based on code contributed by Karl Lehenbauer,
* Mark Diekhans and Peter da Silva.
@@ -16,55 +16,248 @@
*
* 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.123 2005/09/14 17:13:18 dgp Exp $
*/
#include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
/*
- * Prototypes for procedures defined later in this file.
+ * struct FilesystemRecord --
+ *
+ * A filesystem record is used to keep track of each filesystem currently
+ * registered with the core, in a linked list.
*/
-static FilesystemRecord * FsGetFirstFilesystem _ANSI_ARGS_((void));
-static void FsThrExitProc _ANSI_ARGS_((ClientData cd));
-static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
- CONST char *pattern));
-static void FsAddMountsToGlobResult _ANSI_ARGS_((
- Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
- CONST char *pattern,
- Tcl_GlobTypeData *types));
-static void FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj,
- ClientData clientData));
-
-#ifdef TCL_THREADS
-static void FsRecacheFilesystemList(void);
-#endif
+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.
+ */
+
+static int EvalFileCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
+static FilesystemRecord*FsGetFirstFilesystem(void);
+static void FsThrExitProc(ClientData cd);
+static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
+static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
+ Tcl_Obj *pathPtr, const char *pattern,
+ Tcl_GlobTypeData *types);
+static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
+static void FsRecacheFilesystemList(void);
+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);
/*
- * These form part of the native filesystem support. They are needed here
+ * These form part of the native filesystem support. They are needed here
* because we have a few native filesystem functions (which are the same for
- * win/unix) in this file. There is no need to place them in tclInt.h,
- * because they are not (and should not be) used anywhere else.
+ * win/unix) in this file. There is no need to place them in tclInt.h, because
+ * they are not (and should not be) used anywhere else.
+ */
+
+MODULE_SCOPE const char *const tclpFileAttrStrings[];
+MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
+
+/*
+ * Declare the native filesystem support. These functions should be considered
+ * private to Tcl, and should really not be called directly by any code other
+ * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
+ * the old string-based Tclp... native filesystem functions should not be
+ * called.
+ *
+ * The correct API to use now is the Tcl_FS... set of functions, which ensure
+ * correct and complete virtual filesystem support.
+ *
+ * We cannot make all of these static, since some of them are implemented in
+ * the platform-specific directories.
+ */
+
+static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
+static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
+static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
+static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
+static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
+
+/*
+ * The only reason these functions are not static is that they are either
+ * called by code in the native (win/unix) directories or they are actually
+ * implemented in those directories. They should simply not be called by code
+ * outside Tcl's native filesystem core i.e. they should be considered
+ * 'static' to Tcl's filesystem code (if we ever built the native filesystem
+ * support into a separate code library, this could actually be enforced).
+ */
+
+Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
+Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
+Tcl_FSStatProc TclpObjStat;
+Tcl_FSAccessProc TclpObjAccess;
+Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
+Tcl_FSChdirProc TclpObjChdir;
+Tcl_FSLstatProc TclpObjLstat;
+Tcl_FSCopyFileProc TclpObjCopyFile;
+Tcl_FSDeleteFileProc TclpObjDeleteFile;
+Tcl_FSRenameFileProc TclpObjRenameFile;
+Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
+Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
+Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
+Tcl_FSUnloadFileProc TclpUnloadFile;
+Tcl_FSLinkProc TclpObjLink;
+Tcl_FSListVolumesProc TclpObjListVolumes;
+
+/*
+ * Define the native filesystem dispatch table. If necessary, it is ok to make
+ * this non-static, but it should only be accessed by the functions actually
+ * listed within it (or perhaps other helper functions of them). Anything
+ * which is not part of this 'native filesystem implementation' should not be
+ * delving inside here!
*/
-extern CONST char * tclpFileAttrStrings[];
-extern CONST TclFileAttrProcs tclpFileAttrProcs[];
+const Tcl_Filesystem tclNativeFilesystem = {
+ "native",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_2,
+ TclNativePathInFilesystem,
+ TclNativeDupInternalRep,
+ NativeFreeInternalRep,
+ TclpNativeToNormalized,
+ TclNativeCreateNativeRep,
+ TclpObjNormalizePath,
+ TclpFilesystemPathType,
+ NativeFilesystemSeparator,
+ TclpObjStat,
+ TclpObjAccess,
+ TclpOpenFileChannel,
+ TclpMatchInDirectory,
+ TclpUtime,
+#ifndef S_IFLNK
+ NULL,
+#else
+ TclpObjLink,
+#endif /* S_IFLNK */
+ TclpObjListVolumes,
+ NativeFileAttrStrings,
+ NativeFileAttrsGet,
+ NativeFileAttrsSet,
+ TclpObjCreateDirectory,
+ TclpObjRemoveDirectory,
+ TclpObjDeleteFile,
+ TclpObjCopyFile,
+ TclpObjRenameFile,
+ TclpObjCopyDirectory,
+ TclpObjLstat,
+ /* Needs casts since we're using version_2. */
+ (Tcl_FSLoadFileProc *) TclpDlopen,
+ (Tcl_FSGetCwdProc *) TclpGetNativeCwd,
+ TclpObjChdir
+};
/*
+ * Define the tail of the linked list. Note that for unconventional uses of
+ * Tcl without a native filesystem, we may in the future wish to modify the
+ * current approach of hard-coding the native filesystem in the lookup list
+ * 'filesystemList' below.
+ *
+ * We initialize the record so that it thinks one file uses it. This means it
+ * will never be freed.
+ */
+
+static FilesystemRecord nativeFilesystemRecord = {
+ NULL,
+ &tclNativeFilesystem,
+ NULL,
+ NULL
+};
+
+/*
+ * This is incremented each time we modify the linked list of filesystems. Any
+ * time it changes, all cached filesystem representations are suspect and must
+ * be freed. For multithreading builds, change of the filesystem epoch will
+ * trigger cache cleanup in all threads.
+ */
+
+static int theFilesystemEpoch = 1;
+
+/*
+ * Stores the linked list of filesystems. A 1:1 copy of this list is also
+ * maintained in the TSD for each thread. This is to avoid synchronization
+ * issues.
+ */
+
+static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
+TCL_DECLARE_MUTEX(filesystemMutex)
+
+/*
+ * Used to implement Tcl_FSGetCwd in a file-system independent way.
+ */
+
+static Tcl_Obj *cwdPathPtr = NULL;
+static int cwdPathEpoch = 0;
+static ClientData cwdClientData = NULL;
+TCL_DECLARE_MUTEX(cwdMutex)
+
+static Tcl_ThreadDataKey fsDataKey;
+
+/*
+ * One of these structures is used each time we successfully load a file from
+ * a file system by way of making a temporary copy of the file on the native
+ * filesystem. We need to store both the actual unloadProc/clientData
+ * combination which was used, and the original and modified filenames, so
+ * that we can correctly undo the entire operation when we want to unload the
+ * code.
+ */
+
+typedef struct FsDivertLoad {
+ Tcl_LoadHandle loadHandle;
+ Tcl_FSUnloadFileProc *unloadProcPtr;
+ Tcl_Obj *divertedFile;
+ const Tcl_Filesystem *divertedFilesystem;
+ ClientData divertedFileNativeRep;
+} FsDivertLoad;
+
+/*
* The following functions are obsolete string based APIs, and should be
* removed in a future release (Tcl 9 would be a good time).
*/
-
+
/* Obsolete */
int
-Tcl_Stat(path, oldStyleBuf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *oldStyleBuf; /* Filled with results of stat call. */
+Tcl_Stat(
+ const char *path, /* Path of file to stat (in current CP). */
+ struct stat *oldStyleBuf) /* Filled with results of stat call. */
{
int ret;
Tcl_StatBuf buf;
@@ -75,31 +268,37 @@ Tcl_Stat(path, oldStyleBuf)
Tcl_DecrRefCount(pathPtr);
if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
-# define OUT_OF_RANGE(x) \
+ Tcl_WideInt tmp1, tmp2, tmp3 = 0;
+
+# define OUT_OF_RANGE(x) \
(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-# define OUT_OF_URANGE(x) \
- (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
+# define OUT_OF_URANGE(x) \
+ (((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
/*
* Perform the result-buffer overflow check manually.
*
* Note that ino_t/ino64_t is unsigned...
+ *
+ * Workaround gcc warning of "comparison is always false due to
+ * limited range of data type" by assigning to tmp var of type
+ * Tcl_WideInt.
*/
- if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
-#ifdef HAVE_ST_BLOCKS
- || OUT_OF_RANGE(buf.st_blocks)
+ tmp1 = (Tcl_WideInt) buf.st_ino;
+ tmp2 = (Tcl_WideInt) buf.st_size;
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+ tmp3 = (Tcl_WideInt) buf.st_blocks;
#endif
- ) {
-#ifdef EFBIG
+
+ if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
+#if defined(EFBIG)
errno = EFBIG;
-#else
-# ifdef EOVERFLOW
+#elif defined(EOVERFLOW)
errno = EOVERFLOW;
-# else
-# error "What status should be returned for file size out of range?"
-# endif
+#else
+#error "What status should be returned for file size out of range?"
#endif
return -1;
}
@@ -111,7 +310,7 @@ Tcl_Stat(path, oldStyleBuf)
/*
* Copy across all supported fields, with possible type coercions on
* those fields that change between the normal and lf64 versions of
- * the stat structure (on Solaris at least.) This is slow when the
+ * the stat structure (on Solaris at least). This is slow when the
* structure sizes coincide, but that's what you get for using an
* obsolete interface.
*/
@@ -127,9 +326,15 @@ Tcl_Stat(path, oldStyleBuf)
oldStyleBuf->st_atime = buf.st_atime;
oldStyleBuf->st_mtime = buf.st_mtime;
oldStyleBuf->st_ctime = buf.st_ctime;
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
oldStyleBuf->st_blksize = buf.st_blksize;
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+#ifdef HAVE_BLKCNT_T
oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
+#else
+ oldStyleBuf->st_blocks = (unsigned long) buf.st_blocks;
+#endif
#endif
}
return ret;
@@ -137,9 +342,9 @@ Tcl_Stat(path, oldStyleBuf)
/* Obsolete */
int
-Tcl_Access(path, mode)
- CONST char *path; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+Tcl_Access(
+ const char *path, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
@@ -153,13 +358,13 @@ Tcl_Access(path, mode)
/* Obsolete */
Tcl_Channel
-Tcl_OpenFileChannel(interp, path, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting; can be
+Tcl_OpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
* NULL. */
- CONST char *path; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or a string such
+ const char *path, /* Name of file to open. */
+ const char *modeString, /* A list of POSIX open modes or a string such
* as "rw". */
- int permissions; /* If the open involves creating a file, with
+ int permissions) /* If the open involves creating a file, with
* what modes to create it? */
{
Tcl_Channel ret;
@@ -174,8 +379,8 @@ Tcl_OpenFileChannel(interp, path, modeString, permissions)
/* Obsolete */
int
-Tcl_Chdir(dirName)
- CONST char *dirName;
+Tcl_Chdir(
+ const char *dirName)
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
@@ -187,31 +392,31 @@ Tcl_Chdir(dirName)
/* Obsolete */
char *
-Tcl_GetCwd(interp, cwdPtr)
- Tcl_Interp *interp;
- Tcl_DString *cwdPtr;
+Tcl_GetCwd(
+ Tcl_Interp *interp,
+ Tcl_DString *cwdPtr)
{
- Tcl_Obj *cwd;
- cwd = Tcl_FSGetCwd(interp);
+ Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
+
if (cwd == NULL) {
return NULL;
- } else {
- Tcl_DStringInit(cwdPtr);
- Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
- Tcl_DecrRefCount(cwd);
- return Tcl_DStringValue(cwdPtr);
}
+ Tcl_DStringInit(cwdPtr);
+ TclDStringAppendObj(cwdPtr, cwd);
+ Tcl_DecrRefCount(cwd);
+ return Tcl_DStringValue(cwdPtr);
}
/* Obsolete */
int
-Tcl_EvalFile(interp, fileName)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- CONST char *fileName; /* Name of file to process. Tilde-substitution
+Tcl_EvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ const char *fileName) /* Name of file to process. Tilde-substitution
* will be performed on this name. */
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+
Tcl_IncrRefCount(pathPtr);
ret = Tcl_FSEvalFile(interp, pathPtr);
Tcl_DecrRefCount(pathPtr);
@@ -219,239 +424,14 @@ Tcl_EvalFile(interp, fileName)
}
/*
- * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
- * complete, general hooked filesystem APIs should be used instead. This
- * define decides whether to include the obsolete hooks and related code. If
- * these are removed, we'll also want to remove them from stubs/tclInt. The
- * only known users of these APIs are prowrap and mktclapp. New
- * code/extensions should not use them, since they do not provide as full
- * support as the full filesystem API.
- *
- * As soon as prowrap and mktclapp are updated to use the full filesystem
- * support, I suggest all these hooks are removed.
- */
-
-#define USE_OBSOLETE_FS_HOOKS
-
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- * The following typedef declarations allow for hooking into the chain of
- * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
- * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
- * list is defined.
- */
-
-typedef struct StatProc {
- TclStatProc_ *proc; /* Function to process a 'stat()' call */
- struct StatProc *nextPtr; /* The next 'stat()' function to call */
-} StatProc;
-
-typedef struct AccessProc {
- TclAccessProc_ *proc; /* Function to process a 'access()' call */
- struct AccessProc *nextPtr; /* The next 'access()' function to call */
-} AccessProc;
-
-typedef struct OpenFileChannelProc {
- TclOpenFileChannelProc_ *proc; /* Function to process a
- * 'Tcl_OpenFileChannel()' call */
- struct OpenFileChannelProc *nextPtr;
- /* The next 'Tcl_OpenFileChannel()'
- * function to call */
-} OpenFileChannelProc;
-
-/*
- * For each type of (obsolete) hookable function, a static node is declared to
- * hold the function pointer for the "built-in" routine (e.g. 'TclpStat(...)')
- * and the respective list is initialized as a pointer to that node.
- *
- * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that these
- * statically declared list entry cannot be inadvertently removed.
- *
- * This method avoids the need to call any sort of "initialization" function.
- *
- * All three lists are protected by a global obsoleteFsHookMutex.
- */
-
-static StatProc *statProcList = NULL;
-static AccessProc *accessProcList = NULL;
-static OpenFileChannelProc *openFileChannelProcList = NULL;
-
-TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
-
-#endif /* USE_OBSOLETE_FS_HOOKS */
-
-/*
- * Declare the native filesystem support. These functions should be
- * considered private to Tcl, and should really not be called directly by any
- * code other than this file (i.e. neither by Tcl's core nor by extensions).
- * Similarly, the old string-based Tclp... native filesystem functions should
- * not be called.
- *
- * The correct API to use now is the Tcl_FS... set of functions, which ensure
- * correct and complete virtual filesystem support.
- *
- * We cannot make all of these static, since some of them are implemented in
- * the platform-specific directories.
- */
-
-static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
-static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
-static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
-static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
-
-/*
- * The only reason these functions are not static is that they are either
- * called by code in the native (win/unix) directories or they are actually
- * implemented in those directories. They should simply not be called by code
- * outside Tcl's native filesystem core i.e. they should be considered
- * 'static' to Tcl's filesystem code (if we ever built the native filesystem
- * support into a separate code library, this could actually be enforced).
- */
-
-Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
-Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
-Tcl_FSStatProc TclpObjStat;
-Tcl_FSAccessProc TclpObjAccess;
-Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
-Tcl_FSChdirProc TclpObjChdir;
-Tcl_FSLstatProc TclpObjLstat;
-Tcl_FSCopyFileProc TclpObjCopyFile;
-Tcl_FSDeleteFileProc TclpObjDeleteFile;
-Tcl_FSRenameFileProc TclpObjRenameFile;
-Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
-Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
-Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
-Tcl_FSUnloadFileProc TclpUnloadFile;
-Tcl_FSLinkProc TclpObjLink;
-Tcl_FSListVolumesProc TclpObjListVolumes;
-
-/*
- * Define the native filesystem dispatch table. If necessary, it is ok to
- * make this non-static, but it should only be accessed by the functions
- * actually listed within it (or perhaps other helper functions of them).
- * Anything which is not part of this 'native filesystem implementation'
- * should not be delving inside here!
- */
-
-Tcl_Filesystem tclNativeFilesystem = {
- "native",
- sizeof(Tcl_Filesystem),
- TCL_FILESYSTEM_VERSION_2,
- &TclNativePathInFilesystem,
- &TclNativeDupInternalRep,
- &NativeFreeInternalRep,
- &TclpNativeToNormalized,
- &TclNativeCreateNativeRep,
- &TclpObjNormalizePath,
- &TclpFilesystemPathType,
- &NativeFilesystemSeparator,
- &TclpObjStat,
- &TclpObjAccess,
- &TclpOpenFileChannel,
- &TclpMatchInDirectory,
- &TclpUtime,
-#ifndef S_IFLNK
- NULL,
-#else
- &TclpObjLink,
-#endif /* S_IFLNK */
- &TclpObjListVolumes,
- &NativeFileAttrStrings,
- &NativeFileAttrsGet,
- &NativeFileAttrsSet,
- &TclpObjCreateDirectory,
- &TclpObjRemoveDirectory,
- &TclpObjDeleteFile,
- &TclpObjCopyFile,
- &TclpObjRenameFile,
- &TclpObjCopyDirectory,
- &TclpObjLstat,
- &TclpDlopen,
- /* Needs a cast since we're using version_2 */
- (Tcl_FSGetCwdProc*)&TclpGetNativeCwd,
- &TclpObjChdir
-};
-
-/*
- * Define the tail of the linked list. Note that for unconventional uses of
- * Tcl without a native filesystem, we may in the future wish to modify the
- * current approach of hard-coding the native filesystem in the lookup list
- * 'filesystemList' below.
- *
- * We initialize the record so that it thinks one file uses it. This means it
- * will never be freed.
- */
-
-static FilesystemRecord nativeFilesystemRecord = {
- NULL,
- &tclNativeFilesystem,
- 1,
- NULL
-};
-
-/*
- * This is incremented each time we modify the linked list of filesystems.
- * Any time it changes, all cached filesystem representations are suspect and
- * must be freed. For multithreading builds, change of the filesystem epoch
- * will trigger cache cleanup in all threads.
- */
-
-static int theFilesystemEpoch = 0;
-
-/*
- * Stores the linked list of filesystems. A 1:1 copy of this list is also
- * maintained in the TSD for each thread. This is to avoid synchronization
- * issues.
- */
-
-static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
-TCL_DECLARE_MUTEX(filesystemMutex)
-
-/*
- * Used to implement Tcl_FSGetCwd in a file-system independent way.
- */
-
-static Tcl_Obj* cwdPathPtr = NULL;
-static int cwdPathEpoch = 0;
-static ClientData cwdClientData = NULL;
-TCL_DECLARE_MUTEX(cwdMutex)
-
-Tcl_ThreadDataKey tclFsDataKey;
-
-/*
- * Declare fallback support function and information for Tcl_FSLoadFile
- */
-
-static Tcl_FSUnloadFileProc FSUnloadTempFile;
-
-/*
- * One of these structures is used each time we successfully load a file from
- * a file system by way of making a temporary copy of the file on the native
- * filesystem. We need to store both the actual unloadProc/clientData
- * combination which was used, and the original and modified filenames, so
- * that we can correctly undo the entire operation when we want to unload the
- * code.
- */
-
-typedef struct FsDivertLoad {
- Tcl_LoadHandle loadHandle;
- Tcl_FSUnloadFileProc *unloadProcPtr;
- Tcl_Obj *divertedFile;
- Tcl_Filesystem *divertedFilesystem;
- ClientData divertedFileNativeRep;
-} FsDivertLoad;
-
-/*
- * Now move on to the basic filesystem implementation
+ * Now move on to the basic filesystem implementation.
*/
static void
-FsThrExitProc(cd)
- ClientData cd;
+FsThrExitProc(
+ ClientData cd)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
+ ThreadSpecificData *tsdPtr = cd;
FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
/*
@@ -460,6 +440,7 @@ FsThrExitProc(cd)
if (tsdPtr->cwdPathPtr != NULL) {
Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
+ tsdPtr->cwdPathPtr = NULL;
}
if (tsdPtr->cwdClientData != NULL) {
NativeFreeInternalRep(tsdPtr->cwdClientData);
@@ -472,17 +453,18 @@ FsThrExitProc(cd)
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()
+TclFSCwdIsNative(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (tsdPtr->cwdClientData != NULL) {
return 1;
@@ -504,7 +486,7 @@ TclFSCwdIsNative()
*
* Side effects:
* If the paths are equal, but are not the same object, this method will
- * modify the given pathPtrPtr to refer to the same object. In this case
+ * modify the given pathPtrPtr to refer to the same object. In this case
* the object pointed to by pathPtrPtr will have its refCount
* decremented, and it will be adjusted to point to the cwd (with a new
* refCount).
@@ -513,10 +495,10 @@ TclFSCwdIsNative()
*/
int
-TclFSCwdPointerEquals(pathPtrPtr)
- Tcl_Obj** pathPtrPtr;
+TclFSCwdPointerEquals(
+ Tcl_Obj **pathPtrPtr)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
Tcl_MutexLock(&cwdMutex);
if (tsdPtr->cwdPathPtr == NULL
@@ -543,7 +525,7 @@ TclFSCwdPointerEquals(pathPtrPtr)
Tcl_MutexUnlock(&cwdMutex);
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
tsdPtr->initialized = 1;
}
@@ -555,13 +537,13 @@ TclFSCwdPointerEquals(pathPtrPtr)
return 1;
} else {
int len1, len2;
- CONST char *str1, *str2;
+ const char *str1, *str2;
str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
- if (len1 == len2 && !strcmp(str1,str2)) {
+ if ((len1 == len2) && !memcmp(str1, str2, len1)) {
/*
- * They are equal, but different objects. Update so they will be
+ * They are equal, but different objects. Update so they will be
* the same object in the future.
*/
@@ -575,12 +557,11 @@ TclFSCwdPointerEquals(pathPtrPtr)
}
}
-#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.
@@ -589,20 +570,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 proceede.
- *
* Locate tail of the global filesystem list.
*/
+ Tcl_MutexLock(&filesystemMutex);
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr;
@@ -613,48 +590,46 @@ 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.
*/
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
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)) {
+FsGetFirstFilesystem(void)
+{
+ 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;
}
/*
@@ -663,26 +638,49 @@ FsGetFirstFilesystem(void) {
*/
int
-TclFSEpochOk(filesystemEpoch)
- int filesystemEpoch;
+TclFSEpochOk(
+ int filesystemEpoch)
+{
+ return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
+}
+
+static void
+Claim(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- (void) FsGetFirstFilesystem();
- return (filesystemEpoch == tsdPtr->filesystemEpoch);
+ 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);
+
+ return tsdPtr->filesystemEpoch;
+}
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
*/
static void
-FsUpdateCwd(cwdObj, clientData)
- Tcl_Obj *cwdObj;
- ClientData clientData;
+FsUpdateCwd(
+ Tcl_Obj *cwdObj,
+ ClientData clientData)
{
int len;
- char *str = NULL;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ const char *str = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (cwdObj != NULL) {
str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -705,7 +703,7 @@ FsUpdateCwd(cwdObj, clientData)
*/
cwdPathPtr = Tcl_NewStringObj(str, len);
- Tcl_IncrRefCount(cwdPathPtr);
+ Tcl_IncrRefCount(cwdPathPtr);
cwdClientData = TclNativeDupInternalRep(clientData);
}
@@ -735,8 +733,8 @@ FsUpdateCwd(cwdObj, clientData)
*
* TclFinalizeFilesystem --
*
- * Clean up the filesystem. After this, calls to all Tcl_FS...
- * functions will fail.
+ * Clean up the filesystem. After this, calls to all Tcl_FS... functions
+ * will fail.
*
* We will later call TclResetFilesystem to restore the FS to a pristine
* state.
@@ -751,12 +749,12 @@ FsUpdateCwd(cwdObj, clientData)
*/
void
-TclFinalizeFilesystem()
+TclFinalizeFilesystem(void)
{
FilesystemRecord *fsRecPtr;
/*
- * Assumption that only one thread is active now. Otherwise we would need
+ * Assumption that only one thread is active now. Otherwise we would need
* to put various mutexes around this code.
*/
@@ -772,23 +770,21 @@ TclFinalizeFilesystem()
/*
* Remove all filesystems, freeing any allocated memory that is no longer
- * needed
+ * needed.
*/
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
- if (fsRecPtr->fileRefCount <= 0) {
- /*
- * The native filesystem is static, so we don't free it.
- */
- if (fsRecPtr != &nativeFilesystemRecord) {
- ckfree((char *)fsRecPtr);
- }
+ /* The native filesystem is static, so we don't free it. */
+
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ ckfree(fsRecPtr);
}
fsRecPtr = tmpFsRecPtr;
}
+ theFilesystemEpoch++;
filesystemList = NULL;
/*
@@ -796,10 +792,7 @@ TclFinalizeFilesystem()
* filesystem is likely to fail.
*/
- statProcList = NULL;
- accessProcList = NULL;
- openFileChannelProcList = NULL;
-#ifdef __WIN32__
+#ifdef _WIN32
TclWinEncodingsCleanup();
#endif
}
@@ -821,16 +814,12 @@ TclFinalizeFilesystem()
*/
void
-TclResetFilesystem()
+TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
+ theFilesystemEpoch++;
- /*
- * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount
- * should equal 1 and if not, we should try to track down the cause.
- */
-
-#ifdef __WIN32__
+#ifdef _WIN32
/*
* Cleans up the win32 API filesystem proc lookup table. This must happen
* very late in finalization so that deleting of copied dlls can occur.
@@ -851,7 +840,7 @@ TclResetFilesystem()
* can use Tcl_FSData to check if it is in the list, provided the
* ClientData used was not NULL).
*
- * Note that the filesystem handling is head-to-tail of the list. Each
+ * Note that the filesystem handling is head-to-tail of the list. Each
* filesystem is asked in turn whether it can handle a particular
* request, until one of them says 'yes'. At that point no further
* filesystems are asked.
@@ -871,9 +860,9 @@ TclResetFilesystem()
*/
int
-Tcl_FSRegister(clientData, fsPtr)
- ClientData clientData; /* Client specific data for this fs */
- Tcl_Filesystem *fsPtr; /* The filesystem record for the new fs. */
+Tcl_FSRegister(
+ ClientData clientData, /* Client specific data for this fs. */
+ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */
{
FilesystemRecord *newFilesystemPtr;
@@ -881,23 +870,16 @@ Tcl_FSRegister(clientData, fsPtr)
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
+ * 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
- * list, it can't possibly have any effect on any of their loops. In fact
+ * list, it can't possibly have any effect on any of their loops. In fact
* it could be better not to wait, since we are adjusting the filesystem
* epoch, any cached representations calculated by existing iterators are
* going to have to be thrown away anyway.
@@ -932,14 +914,14 @@ Tcl_FSRegister(clientData, fsPtr)
* Tcl_FSUnregister --
*
* Remove the passed filesystem from the list of filesystem function
- * tables. It also ensures that the built-in (native) filesystem is not
+ * tables. It also ensures that the built-in (native) filesystem is not
* removable, although we may wish to change that decision in the future
* to allow a smaller Tcl core, in which the native filesystem is not
* used at all (we could, say, initialise Tcl completely over a network
* connection).
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * TCL_OK if the function pointer was successfully removed, TCL_ERROR
* otherwise.
*
* Side effects:
@@ -951,8 +933,8 @@ Tcl_FSRegister(clientData, fsPtr)
*/
int
-Tcl_FSUnregister(fsPtr)
- Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */
+Tcl_FSUnregister(
+ const Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */
{
int retVal = TCL_ERROR;
FilesystemRecord *fsRecPtr;
@@ -979,7 +961,7 @@ Tcl_FSUnregister(fsPtr)
/*
* Increment the filesystem epoch counter, since existing paths
- * might conceivably now belong to different filesystems. This
+ * might conceivably now belong to different filesystems. This
* should also ensure that paths which have cached the filesystem
* which is about to be deleted do not reference that filesystem
* (which would of course lead to memory exceptions).
@@ -987,10 +969,7 @@ Tcl_FSUnregister(fsPtr)
theFilesystemEpoch++;
- fsRecPtr->fileRefCount--;
- if (fsRecPtr->fileRefCount <= 0) {
- ckfree((char *)fsRecPtr);
- }
+ ckfree(fsRecPtr);
retVal = TCL_OK;
} else {
@@ -1008,17 +987,17 @@ Tcl_FSUnregister(fsPtr)
* Tcl_FSMatchInDirectory --
*
* This routine is used by the globbing code to search a directory for
- * all files which match a given pattern. The appropriate function for
- * the filesystem to which pathPtr belongs will be called. If pathPtr
+ * all files which match a given pattern. The appropriate function for
+ * the filesystem to which pathPtr belongs will be called. If pathPtr
* does not belong to any filesystem and if it is NULL or the empty
* string, then we assume the pattern is to be matched in the current
- * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
+ * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
* each filesystem from having to deal with this issue, we create a
* pathPtr on the fly (equal to the cwd), and then remove it from the
- * results returned. This makes filesystems easy to write, since they
- * can assume the pathPtr passed to them is an ordinary path. In fact
- * this means we could remove such special case handling from Tcl's
- * native filesystems.
+ * results returned. This makes filesystems easy to write, since they can
+ * assume the pathPtr passed to them is an ordinary path. In fact this
+ * means we could remove such special case handling from Tcl's native
+ * filesystems.
*
* If 'pattern' is NULL, then pathPtr is assumed to be a fully specified
* path of a single file/directory which must be checked for existence
@@ -1027,14 +1006,14 @@ Tcl_FSUnregister(fsPtr)
* Results:
*
* The return value is a standard Tcl result indicating whether an error
- * occurred in globbing. Error messages are placed in interp, but good
+ * occurred in globbing. Error messages are placed in interp, but good
* results are placed in the resultPtr given.
*
* Recursive searches, e.g.
* glob -dir $dir -join * pkgIndex.tcl
* which must recurse through each directory matching '*' are handled
* internally by Tcl, by passing specific flags in a modified 'types'
- * parameter. This means the actual filesystem only ever sees patterns
+ * parameter. This means the actual filesystem only ever sees patterns
* which match in a single directory.
*
* Side effects:
@@ -1044,26 +1023,26 @@ Tcl_FSUnregister(fsPtr)
*/
int
-Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter to receive error
- * messages, but may be NULL. */
- Tcl_Obj *resultPtr; /* List object to receive results. */
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+Tcl_FSMatchInDirectory(
+ Tcl_Interp *interp, /* Interpreter to receive error messages, but
+ * may be NULL. */
+ Tcl_Obj *resultPtr, /* List object to receive results. */
+ Tcl_Obj *pathPtr, /* Contains path to directory to search. */
+ const char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
- Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr;
Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
int resLength, i, ret = -1;
- if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+ if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) {
/*
* We don't currently allow querying of mounts by external code (a
* valuable future step), so since we're the only function that
* actually knows about mounts, this means we're being called
- * recursively by ourself. Return no matches.
+ * recursively by ourself. Return no matches.
*/
return TCL_OK;
@@ -1085,8 +1064,8 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_SetErrno(ENOENT);
return -1;
}
- ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
- pattern, types);
+ ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern,
+ types);
if (ret == TCL_OK && pattern != NULL) {
FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
}
@@ -1095,7 +1074,7 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
/*
* If the path isn't empty, we have no idea how to match files in a
- * directory which belongs to no known filesystem
+ * directory which belongs to no known filesystem.
*/
if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
@@ -1116,8 +1095,9 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
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;
}
@@ -1126,8 +1106,8 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
TclNewObj(tmpResultPtr);
Tcl_IncrRefCount(tmpResultPtr);
- ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
- pattern, types);
+ ret = fsPtr->matchInDirectoryProc(interp, tmpResultPtr, cwd, pattern,
+ types);
if (ret == TCL_OK) {
FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
@@ -1154,7 +1134,7 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
* FsAddMountsToGlobResult --
*
* This routine is used by the globbing code to take the results of a
- * directory listing and add any mounted paths to that listing. This is
+ * directory listing and add any mounted paths to that listing. This is
* required so that simple things like 'glob *' merge mounts and listings
* correctly.
*
@@ -1168,12 +1148,12 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
*/
static void
-FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
- Tcl_Obj *resultPtr; /* The current list of matching paths; must
+FsAddMountsToGlobResult(
+ Tcl_Obj *resultPtr, /* The current list of matching paths; must
* not be shared! */
- Tcl_Obj *pathPtr; /* The directory in question */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ Tcl_Obj *pathPtr, /* The directory in question. */
+ const char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
@@ -1212,13 +1192,12 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
gLength--;
}
- break; /* Break out of for loop */
+ break; /* Break out of for loop. */
}
}
if (!found && dir) {
+ Tcl_Obj *norm;
int len, mlen;
- CONST char *path;
- CONST char *mount;
/*
* We know mElt is absolute normalized and lies inside pathPtr, so
@@ -1226,19 +1205,23 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
* i.e. the representation which is relative to pathPtr.
*/
- mount = Tcl_GetStringFromObj(mElt, &mlen);
- path = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, pathPtr),
- &len);
- if (path[len-1] == '/') {
- /*
- * Deal with the root of the volume.
- */
+ norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (norm != NULL) {
+ const char *path, *mount;
- len--;
- }
- mElt = TclNewFSPathObj(pathPtr, mount + len + 1, mlen - len);
- Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
+ mount = Tcl_GetStringFromObj(mElt, &mlen);
+ path = Tcl_GetStringFromObj(norm, &len);
+ if (path[len-1] == '/') {
+ /*
+ * Deal with the root of the volume.
+ */
+ len--;
+ }
+ len++; /* account for '/' in the mElt [Bug 1602539] */
+ mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len);
+ Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
+ }
/*
* No need to increment gLength, since we don't want to compare
* mounts against mounts.
@@ -1268,7 +1251,7 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
* Clearly it should only therefore be called when it is really required!
* There are a few circumstances when it should be called:
*
- * (1) when a new filesystem is registered or unregistered. Strictly
+ * (1) when a new filesystem is registered or unregistered. Strictly
* speaking this is only necessary if the new filesystem accepts file
* paths as is (normally the filesystem itself is really a shell which
* hasn't yet had any mount points established and so its
@@ -1298,11 +1281,11 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
*/
void
-Tcl_FSMountsChanged(fsPtr)
- Tcl_Filesystem *fsPtr;
+Tcl_FSMountsChanged(
+ const Tcl_Filesystem *fsPtr)
{
/*
- * We currently don't do anything with this parameter. We could in the
+ * We currently don't do anything with this parameter. We could in the
* future only invalidate files for this filesystem or otherwise take more
* advanced action.
*/
@@ -1328,7 +1311,7 @@ Tcl_FSMountsChanged(fsPtr)
* that filesystem is not registered.
*
* Results:
- * A clientData value, or NULL. Note that if the filesystem was
+ * A clientData value, or NULL. Note that if the filesystem was
* registered with a NULL clientData field, this function will return
* that NULL value.
*
@@ -1339,14 +1322,14 @@ Tcl_FSMountsChanged(fsPtr)
*/
ClientData
-Tcl_FSData(fsPtr)
- Tcl_Filesystem *fsPtr; /* The filesystem record to query. */
+Tcl_FSData(
+ const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
{
ClientData retVal = NULL;
FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
/*
- * Traverse the list of filesystems look for a particular one. If found,
+ * Traverse the list of filesystems look for a particular one. If found,
* return that filesystem's clientData (originally provided when calling
* Tcl_FSRegister).
*/
@@ -1367,13 +1350,13 @@ Tcl_FSData(fsPtr)
* TclFSNormalizeToUniquePath --
*
* Takes a path specification containing no ../, ./ sequences, and
- * converts it into a unique path for the given platform. On Unix, this
+ * converts it into a unique path for the given platform. On Unix, this
* means the path must be free of symbolic links/aliases, and on Windows
* it means we want the long form, with that long form's case-dependence
* (which gives us a unique, case-dependent path).
*
* Results:
- * The pathPtr is modified in place. The return value is the last byte
+ * The pathPtr is modified in place. The return value is the last byte
* offset which was recognised in the path string.
*
* Side effects:
@@ -1382,7 +1365,7 @@ Tcl_FSData(fsPtr)
* Special notes:
* If the filesystem-specific normalizePathProcs can re-introduce ../, ./
* sequences into the path, then this function will not return the
- * correct result. This may be possible with symbolic links on unix.
+ * correct result. This may be possible with symbolic links on unix.
*
* Important assumption: if startAt is non-zero, it must point to a
* directory separator that we know exists and is already normalized (so
@@ -1392,59 +1375,61 @@ Tcl_FSData(fsPtr)
*/
int
-TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
- 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. */
+TclFSNormalizeToUniquePath(
+ Tcl_Interp *interp, /* Used for error messages. */
+ Tcl_Obj *pathPtr, /* The path to normalize in place. */
+ 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
* special case, in which if we have a native filesystem handler, we call
- * it first. This is because the root of Tcl's filesystem is always a
+ * it first. This is because the root of Tcl's filesystem is always a
* native filesystem (i.e. '/' on unix is native).
*/
firstFsRecPtr = FsGetFirstFilesystem();
- fsRecPtr = firstFsRecPtr;
- while (fsRecPtr != NULL) {
- if (fsRecPtr == &nativeFilesystemRecord) {
- Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
- if (proc != NULL) {
- startAt = (*proc)(interp, pathPtr, startAt);
- }
- break;
+ Claim();
+ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+ if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+ continue;
}
- fsRecPtr = fsRecPtr->nextPtr;
+
+ /*
+ * TODO: Assume that we always find the native file system; it should
+ * always be there...
+ */
+
+ if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+ startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+ startAt);
+ }
+ break;
}
- fsRecPtr = firstFsRecPtr;
- while (fsRecPtr != NULL) {
+ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
/*
* Skip the native system next time through.
*/
- if (fsRecPtr != &nativeFilesystemRecord) {
- Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
- if (proc != NULL) {
- startAt = (*proc)(interp, pathPtr, startAt);
- }
+ if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
+ continue;
+ }
- /*
- * We could add an efficiency check like this:
- * if (retVal == length-of(pathPtr)) {break;}
- * but there's not much benefit.
- */
+ if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+ startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+ startAt);
}
- fsRecPtr = fsRecPtr->nextPtr;
+
+ /*
+ * We could add an efficiency check like this:
+ * if (retVal == length-of(pathPtr)) {break;}
+ * but there's not much benefit.
+ */
}
+ Disclaim();
return startAt;
}
@@ -1455,7 +1440,7 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
* TclGetOpenMode --
*
* This routine is an obsolete, limited version of TclGetOpenModeEx()
- * below. It exists only to satisfy any extensions imprudently using it
+ * below. It exists only to satisfy any extensions imprudently using it
* via Tcl's internal stubs table.
*
* Results:
@@ -1468,14 +1453,12 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
*/
int
-TclGetOpenMode(interp, modeString, seekFlagPtr)
- Tcl_Interp *interp; /* Interpreter to use for error
- * reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
- * CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller should
- * seek to EOF during the opening of
- * the file. */
+TclGetOpenMode(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting -
+ * may be NULL. */
+ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */
+ int *seekFlagPtr) /* Set this to 1 if the caller should seek to
+ * EOF during the opening of the file. */
{
int binary = 0;
return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
@@ -1498,7 +1481,7 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller to
- * seek to EOF after opening the file, or to 0 otherwise. Sets the
+ * seek to EOF after opening the file, or to 0 otherwise. Sets the
* integer referenced by binaryPtr to 1 to tell the caller to seek to
* configure the channel for binary data, or to 0 otherwise.
*
@@ -1510,24 +1493,22 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
*/
int
-TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
- Tcl_Interp *interp; /* Interpreter to use for error
- * reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
- * CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller should
- * seek to EOF during the opening of
- * the file. */
- int *binaryPtr; /* Set this to 1 if the caller should
- * configure the opened channel for
- * binary operations */
+TclGetOpenModeEx(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting -
+ * may be NULL. */
+ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */
+ int *seekFlagPtr, /* Set this to 1 if the caller should seek to
+ * EOF during the opening of the file. */
+ int *binaryPtr) /* Set this to 1 if the caller should
+ * configure the opened channel for binary
+ * operations. */
{
int mode, modeArgc, c, i, gotRW;
- CONST char **modeArgv, *flag;
+ const char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
- * Check for the simpler fopen-like access modes (e.g. "r"). They are
+ * Check for the simpler fopen-like access modes (e.g. "r"). They are
* distinguished from the POSIX access modes by the presence of a
* lower-case first letter.
*/
@@ -1551,27 +1532,30 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
mode = O_WRONLY|O_CREAT|O_TRUNC;
break;
case 'a':
- mode = O_WRONLY|O_CREAT;
+ /*
+ * Added O_APPEND for proper automatic seek-to-end-on-write by the
+ * OS. [Bug 680143]
+ */
+
+ mode = O_WRONLY|O_CREAT|O_APPEND;
*seekFlagPtr = 1;
break;
default:
- error:
- *seekFlagPtr = 0;
- *binaryPtr = 0;
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "illegal access mode \"", modeString,
- "\"", (char *) NULL);
- }
- return -1;
+ goto error;
}
- i=1;
+ i = 1;
while (i<3 && modeString[i]) {
if (modeString[i] == modeString[i-1]) {
goto error;
}
switch (modeString[i++]) {
case '+':
- mode &= ~(O_RDONLY|O_WRONLY);
+ /*
+ * Must remove the O_APPEND flag so that the seek command
+ * works. [Bug 1773127]
+ */
+
+ mode &= ~(O_RDONLY|O_WRONLY|O_APPEND);
mode |= O_RDWR;
break;
case 'b':
@@ -1585,6 +1569,15 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
goto error;
}
return mode;
+
+ error:
+ *seekFlagPtr = 0;
+ *binaryPtr = 0;
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal access mode \"%s\"", modeString));
+ }
+ return -1;
}
/*
@@ -1596,7 +1589,7 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
*/
if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
Tcl_AddErrorInfo(interp, modeString);
@@ -1630,28 +1623,25 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
#ifdef O_NOCTTY
mode |= O_NOCTTY;
#else
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
return -1;
#endif
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
-#if defined(O_NDELAY) || defined(O_NONBLOCK)
-# ifdef O_NONBLOCK
+#ifdef O_NONBLOCK
mode |= O_NONBLOCK;
-# else
- mode |= O_NDELAY;
-# endif
-
#else
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
- ckfree((char *) modeArgv);
+ ckfree(modeArgv);
return -1;
#endif
@@ -1661,23 +1651,24 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
*binaryPtr = 1;
} else {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
- "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
- (char *) NULL);
+ if (interp != 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 != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode must include either",
- " RDONLY, WRONLY, or RDWR", (char *) NULL);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "access mode must include either RDONLY, WRONLY, or RDWR",
+ -1));
}
return -1;
}
@@ -1685,32 +1676,20 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
}
/*
- * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
- */
-
-int
-Tcl_FSEvalFile(interp, pathPtr)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
- * will be performed on this name. */
-{
- return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
-}
-
-/*
*----------------------------------------------------------------------
*
- * Tcl_FSEvalFileEx --
+ * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile --
*
* Read in a file and process the entire file as one gigantic Tcl
- * command.
+ * command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
+ * TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx.
*
* Results:
* A standard Tcl result, which is either the result of executing the
* file or an error indicating why the file couldn't be read.
*
* Side effects:
- * Depends on the commands in the file. During the evaluation of the
+ * Depends on the commands in the file. During the evaluation of the
* contents of the file, iPtr->scriptFile is made to point to pathPtr
* (the old value is cached and replaced when this function returns).
*
@@ -1718,53 +1697,58 @@ Tcl_FSEvalFile(interp, pathPtr)
*/
int
-Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
+Tcl_FSEvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution
* will be performed on this name. */
- CONST char *encodingName; /* If non-NULL, then use this encoding for the
- * file. */
{
- int result, length;
+ return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
+}
+
+int
+Tcl_FSEvalFileEx(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution
+ * will be performed on this name. */
+ const char *encodingName) /* If non-NULL, then use this encoding for the
+ * file. NULL means use the system encoding. */
+{
+ int length, result = TCL_ERROR;
Tcl_StatBuf statBuf;
Tcl_Obj *oldScriptFile;
Interp *iPtr;
- char *string;
+ const char *string;
Tcl_Channel chan;
Tcl_Obj *objPtr;
if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
- return TCL_ERROR;
+ return result;
}
- result = TCL_ERROR;
- objPtr = Tcl_NewObj();
-
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
- goto end;
+ 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 == (Tcl_Channel) NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
- goto end;
+ if (chan == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ return result;
}
/*
- * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
- * this cross-platform to allow for scripted documents. [Bug: 2040]
+ * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
+ * this cross-platform to allow for scripted documents. [Bug: 2040]
*/
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
/*
- * If the encoding is specified, set it for the channel. Else don't touch
+ * If the encoding is specified, set it for the channel. Else don't touch
* it (and use the system encoding) Report error on unknown encoding.
*/
@@ -1772,15 +1756,38 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
!= TCL_OK) {
Tcl_Close(interp,chan);
- goto end;
+ return result;
}
}
- if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
+ objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
+
+ /*
+ * 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_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_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
goto end;
}
@@ -1793,7 +1800,13 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
iPtr->scriptFile = pathPtr;
Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
- result = Tcl_EvalEx(interp, string, length, 0);
+
+ /*
+ * TIP #280 Force the evaluator to open a frame for a sourced file.
+ */
+
+ iPtr->evalFlags |= TCL_EVAL_FILE;
+ result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
/*
* Now we have to be careful; the script may have changed the
@@ -1812,19 +1825,171 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
/*
* Record information telling where the error occurred.
*/
- CONST char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
+
+ const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
int limit = 150;
int overflow = (length > limit);
- TclFormatToErrorInfo(interp, "\n (file \"%.*s%s\" line %d)",
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (file \"%.*s%s\" line %d)",
(overflow ? limit : length), pathString,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
end:
Tcl_DecrRefCount(objPtr);
return result;
}
+
+int
+TclNREvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution
+ * will be performed on this name. */
+ const char *encodingName) /* If non-NULL, then use this encoding for the
+ * file. NULL means use the system encoding. */
+{
+ Tcl_StatBuf statBuf;
+ Tcl_Obj *oldScriptFile, *objPtr;
+ Interp *iPtr;
+ Tcl_Channel chan;
+ const char *string;
+
+ if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
+ Tcl_SetErrno(errno);
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+ /*
+ * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
+ * this cross-platform to allow for scripted documents. [Bug: 2040]
+ */
+
+ Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
+
+ /*
+ * If the encoding is specified, set it for the channel. Else don't touch
+ * it (and use the system encoding) Report error on unknown encoding.
+ */
+
+ if (encodingName != NULL) {
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
+ != TCL_OK) {
+ Tcl_Close(interp,chan);
+ return TCL_ERROR;
+ }
+ }
+
+ objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
+
+ /*
+ * 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_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;
+ }
+
+ if (Tcl_Close(interp, chan) != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ return TCL_ERROR;
+ }
+
+ iPtr = (Interp *) interp;
+ oldScriptFile = iPtr->scriptFile;
+ iPtr->scriptFile = pathPtr;
+ Tcl_IncrRefCount(iPtr->scriptFile);
+
+ /*
+ * TIP #280: Force the evaluator to open a frame for a sourced file.
+ */
+
+ iPtr->evalFlags |= TCL_EVAL_FILE;
+ TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
+ NULL);
+ return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
+}
+
+static int
+EvalFileCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *oldScriptFile = data[0];
+ Tcl_Obj *pathPtr = data[1];
+ Tcl_Obj *objPtr = data[2];
+
+ /*
+ * Now we have to be careful; the script may have changed the
+ * iPtr->scriptFile value, so we must reset it without assuming it still
+ * points to 'pathPtr'.
+ */
+
+ if (iPtr->scriptFile != NULL) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ }
+ iPtr->scriptFile = oldScriptFile;
+
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo(iPtr);
+ } else if (result == TCL_ERROR) {
+ /*
+ * Record information telling where the error occurred.
+ */
+
+ int length;
+ const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
+ const int limit = 150;
+ int overflow = (length > limit);
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (file \"%.*s%s\" line %d)",
+ (overflow ? limit : length), pathString,
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ }
+
+ Tcl_DecrRefCount(objPtr);
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -1846,8 +2011,13 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
*/
int
-Tcl_GetErrno()
+Tcl_GetErrno(void)
{
+ /*
+ * On some platforms, errno is really a thread local (implemented by the C
+ * library).
+ */
+
return errno;
}
@@ -1856,7 +2026,9 @@ Tcl_GetErrno()
*
* Tcl_SetErrno --
*
- * Sets the Tcl error code variable to the supplied value.
+ * Sets the Tcl error code variable to the supplied value. On some saner
+ * platforms this is actually a thread-local (this is implemented in the
+ * C library) but this is *really* unsafe to assume!
*
* Results:
* None.
@@ -1868,9 +2040,14 @@ Tcl_GetErrno()
*/
void
-Tcl_SetErrno(err)
- int err; /* The new value. */
+Tcl_SetErrno(
+ int err) /* The new value. */
{
+ /*
+ * On some platforms, errno is really a thread local (implemented by the C
+ * library).
+ */
+
errno = err;
}
@@ -1879,8 +2056,8 @@ Tcl_SetErrno(err)
*
* Tcl_PosixError --
*
- * This procedure is typically called after UNIX kernel calls return
- * errors. It stores machine-readable information about the error in
+ * This function is typically called after UNIX kernel calls return
+ * errors. It stores machine-readable information about the error in
* errorCode field of interp and returns an information string for the
* caller's use.
*
@@ -1893,16 +2070,18 @@ Tcl_SetErrno(err)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_PosixError(interp)
- Tcl_Interp *interp; /* Interpreter whose errorCode field
- * is to be set. */
+const char *
+Tcl_PosixError(
+ Tcl_Interp *interp) /* Interpreter whose errorCode field is to be
+ * set. */
{
- CONST char *id, *msg;
+ const char *id, *msg;
msg = Tcl_ErrnoMsg(errno);
id = Tcl_ErrnoId();
- Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
+ if (interp) {
+ Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
+ }
return msg;
}
@@ -1911,7 +2090,7 @@ Tcl_PosixError(interp)
*
* Tcl_FSStat --
*
- * This procedure replaces the library version of stat and lsat.
+ * This function replaces the library version of stat and lsat.
*
* The appropriate function for the filesystem to which pathPtr belongs
* will be called.
@@ -1926,74 +2105,14 @@ Tcl_PosixError(interp)
*/
int
-Tcl_FSStat(pathPtr, buf)
- Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+Tcl_FSStat(
+ Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
- Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
- struct stat oldStyleStatBuffer;
- int retVal = -1;
-
- /*
- * Call each of the "stat" function in succession. A non-return value of
- * -1 indicates the particular function has succeeded.
- */
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
-
- if (statProcList != NULL) {
- StatProc *statProcPtr;
- char *path;
- Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- if (transPtr == NULL) {
- path = NULL;
- } else {
- path = Tcl_GetString(transPtr);
- }
-
- statProcPtr = statProcList;
- while ((retVal == -1) && (statProcPtr != NULL)) {
- retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
- statProcPtr = statProcPtr->nextPtr;
- }
- if (transPtr != NULL) {
- Tcl_DecrRefCount(transPtr);
- }
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
- if (retVal != -1) {
- /*
- * Note that EOVERFLOW is not a problem here, and these assignments
- * should all be widening (if not identity.)
- */
-
- buf->st_mode = oldStyleStatBuffer.st_mode;
- buf->st_ino = oldStyleStatBuffer.st_ino;
- buf->st_dev = oldStyleStatBuffer.st_dev;
- buf->st_rdev = oldStyleStatBuffer.st_rdev;
- buf->st_nlink = oldStyleStatBuffer.st_nlink;
- buf->st_uid = oldStyleStatBuffer.st_uid;
- buf->st_gid = oldStyleStatBuffer.st_gid;
- buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);
- buf->st_atime = oldStyleStatBuffer.st_atime;
- buf->st_mtime = oldStyleStatBuffer.st_mtime;
- buf->st_ctime = oldStyleStatBuffer.st_ctime;
-#ifdef HAVE_ST_BLOCKS
- buf->st_blksize = oldStyleStatBuffer.st_blksize;
- buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
-#endif
- return retVal;
- }
-#endif /* USE_OBSOLETE_FS_HOOKS */
-
- fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSStatProc *proc = fsPtr->statProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, buf);
- }
+ if (fsPtr != NULL && fsPtr->statProc != NULL) {
+ return fsPtr->statProc(pathPtr, buf);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -2004,7 +2123,7 @@ Tcl_FSStat(pathPtr, buf)
*
* Tcl_FSLstat --
*
- * This procedure replaces the library version of lstat. The appropriate
+ * This function replaces the library version of lstat. The appropriate
* function for the filesystem to which pathPtr belongs will be called.
* If no 'lstat' function is listed, but a 'stat' function is, then Tcl
* will fall back on the stat function.
@@ -2019,20 +2138,18 @@ Tcl_FSStat(pathPtr, buf)
*/
int
-Tcl_FSLstat(pathPtr, buf)
- Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+Tcl_FSLstat(
+ Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
- Tcl_FSLstatProc *proc = fsPtr->lstatProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, buf);
- } else {
- Tcl_FSStatProc *sproc = fsPtr->statProc;
- if (sproc != NULL) {
- return (*sproc)(pathPtr, buf);
- }
+ if (fsPtr->lstatProc != NULL) {
+ return fsPtr->lstatProc(pathPtr, buf);
+ }
+ if (fsPtr->statProc != NULL) {
+ return fsPtr->statProc(pathPtr, buf);
}
}
Tcl_SetErrno(ENOENT);
@@ -2044,9 +2161,8 @@ Tcl_FSLstat(pathPtr, buf)
*
* Tcl_FSAccess --
*
- * This procedure replaces the library version of access. The
- * appropriate function for the filesystem to which pathPtr belongs will
- * be called.
+ * This function replaces the library version of access. The appropriate
+ * function for the filesystem to which pathPtr belongs will be called.
*
* Results:
* See access documentation.
@@ -2058,55 +2174,15 @@ Tcl_FSLstat(pathPtr, buf)
*/
int
-Tcl_FSAccess(pathPtr, mode)
- Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+Tcl_FSAccess(
+ Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
- Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
- int retVal = -1;
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- /*
- * Call each of the "access" function in succession. A non-return value
- * of -1 indicates the particular function has succeeded.
- */
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
-
- if (accessProcList != NULL) {
- AccessProc *accessProcPtr;
- char *path;
- Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- if (transPtr == NULL) {
- path = NULL;
- } else {
- path = Tcl_GetString(transPtr);
- }
-
- accessProcPtr = accessProcList;
- while ((retVal == -1) && (accessProcPtr != NULL)) {
- retVal = (*accessProcPtr->proc)(path, mode);
- accessProcPtr = accessProcPtr->nextPtr;
- }
- if (transPtr != NULL) {
- Tcl_DecrRefCount(transPtr);
- }
- }
-
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
- if (retVal != -1) {
- return retVal;
+ if (fsPtr != NULL && fsPtr->accessProc != NULL) {
+ return fsPtr->accessProc(pathPtr, mode);
}
-#endif /* USE_OBSOLETE_FS_HOOKS */
-
- fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSAccessProc *proc = fsPtr->accessProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, mode);
- }
- }
-
Tcl_SetErrno(ENOENT);
return -1;
}
@@ -2130,54 +2206,19 @@ Tcl_FSAccess(pathPtr, mode)
*/
Tcl_Channel
-Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting; can be
+Tcl_FSOpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
* NULL. */
- Tcl_Obj *pathPtr; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or a string such
+ Tcl_Obj *pathPtr, /* Name of file to open. */
+ const char *modeString, /* A list of POSIX open modes or a string such
* as "rw". */
- int permissions; /* If the open involves creating a file, with
+ int permissions) /* If the open involves creating a file, with
* what modes to create it? */
{
- Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
+ const Tcl_Filesystem *fsPtr;
Tcl_Channel retVal = NULL;
/*
- * Call each of the "Tcl_OpenFileChannel" functions in succession. A
- * non-NULL return value indicates the particular function has succeeded.
- */
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
- if (openFileChannelProcList != NULL) {
- OpenFileChannelProc *openFileChannelProcPtr;
- char *path;
- Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-
- if (transPtr == NULL) {
- path = NULL;
- } else {
- path = Tcl_GetString(transPtr);
- }
-
- openFileChannelProcPtr = openFileChannelProcList;
-
- while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
- retVal = (*openFileChannelProcPtr->proc)(interp, path,
- modeString, permissions);
- openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
- }
- if (transPtr != NULL) {
- Tcl_DecrRefCount(transPtr);
- }
- }
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
- if (retVal != NULL) {
- return retVal;
- }
-#endif /* USE_OBSOLETE_FS_HOOKS */
-
- /*
* We need this just to ensure we return the correct error messages under
* some circumstances.
*/
@@ -2187,38 +2228,47 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
}
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
- if (proc != NULL) {
- int mode, seekFlag, binary;
+ if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) {
+ int mode, seekFlag, binary;
- mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
- if (mode == -1) {
- return NULL;
- }
+ /*
+ * Parse the mode, picking up whether we want to seek to start with
+ * and/or set the channel automatically into binary mode.
+ */
- retVal = (*proc)(interp, pathPtr, mode, permissions);
- if (retVal != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(retVal, (Tcl_WideInt)0,
- SEEK_END) < (Tcl_WideInt)0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file while opening \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- Tcl_Close(NULL, retVal);
- return NULL;
- }
- }
- if (binary) {
- Tcl_SetChannelOption(interp, retVal,
- "-translation", "binary");
- }
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
+ if (mode == -1) {
+ return NULL;
+ }
+
+ /*
+ * Do the actual open() call.
+ */
+
+ retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode,
+ permissions);
+ if (retVal == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Apply appropriate flags parsed out above.
+ */
+
+ if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
+ < (Tcl_WideInt) 0) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not seek to end of file while opening \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
- return retVal;
+ Tcl_Close(NULL, retVal);
+ return NULL;
+ }
+ if (binary) {
+ Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
}
+ return retVal;
}
/*
@@ -2227,8 +2277,9 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
Tcl_SetErrno(ENOENT);
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -2238,7 +2289,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*
* Tcl_FSUtime --
*
- * This procedure replaces the library version of utime. The appropriate
+ * This function replaces the library version of utime. The appropriate
* function for the filesystem to which pathPtr belongs will be called.
*
* Results:
@@ -2251,18 +2302,18 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*/
int
-Tcl_FSUtime(pathPtr, tval)
- Tcl_Obj *pathPtr; /* File to change access/modification times */
- struct utimbuf *tval; /* Structure containing access/modification
- * times to use. Should not be modified. */
+Tcl_FSUtime(
+ Tcl_Obj *pathPtr, /* File to change access/modification
+ * times. */
+ struct utimbuf *tval) /* Structure containing access/modification
+ * times to use. Should not be modified. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, tval);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
+ return fsPtr->utimeProc(pathPtr, tval);
}
+ /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
return -1;
}
@@ -2271,9 +2322,9 @@ Tcl_FSUtime(pathPtr, tval)
*
* NativeFileAttrStrings --
*
- * This procedure implements the platform dependent 'file attributes'
+ * This function implements the platform dependent 'file attributes'
* subcommand, for the native filesystem, for listing the set of possible
- * attribute strings. This function is part of Tcl's native filesystem
+ * attribute strings. This function is part of Tcl's native filesystem
* support, and is placed here because it is shared by Unix and Windows
* code.
*
@@ -2286,10 +2337,10 @@ Tcl_FSUtime(pathPtr, tval)
*----------------------------------------------------------------------
*/
-static CONST char**
-NativeFileAttrStrings(pathPtr, objPtrRef)
- Tcl_Obj *pathPtr;
- Tcl_Obj** objPtrRef;
+static const char *const *
+NativeFileAttrStrings(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
{
return tclpFileAttrStrings;
}
@@ -2299,15 +2350,15 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
*
* NativeFileAttrsGet --
*
- * This procedure implements the platform dependent 'file attributes'
- * subcommand, for the native filesystem, for 'get' operations. This
+ * This function implements the platform dependent 'file attributes'
+ * subcommand, for the native filesystem, for 'get' operations. This
* function is part of Tcl's native filesystem support, and is placed
* here because it is shared by Unix and Windows code.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
- * was returned) is likely to have a refCount of zero. Either way we
- * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we must
+ * either store it somewhere (e.g. the Tcl result), or Incr/Decr its
* refCount to ensure it is properly freed.
*
* Side effects:
@@ -2317,14 +2368,13 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
*/
static int
-NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* path of file we are operating on. */
- Tcl_Obj **objPtrRef; /* for output. */
+NativeFileAttrsGet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* path of file we are operating on. */
+ Tcl_Obj **objPtrRef) /* for output. */
{
- return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
- objPtrRef);
+ return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef);
}
/*
@@ -2332,7 +2382,7 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
*
* NativeFileAttrsSet --
*
- * This procedure implements the platform dependent 'file attributes'
+ * This function implements the platform dependent 'file attributes'
* subcommand, for the native filesystem, for 'set' operations. This
* function is part of Tcl's native filesystem support, and is placed
* here because it is shared by Unix and Windows code.
@@ -2347,13 +2397,13 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
*/
static int
-NativeFileAttrsSet(interp, index, pathPtr, objPtr)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* path of file we are operating on. */
- Tcl_Obj *objPtr; /* set to this value. */
+NativeFileAttrsSet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* path of file we are operating on. */
+ Tcl_Obj *objPtr) /* set to this value. */
{
- return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
+ return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr);
}
/*
@@ -2361,12 +2411,12 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
*
* Tcl_FSFileAttrStrings --
*
- * This procedure implements part of the hookable 'file attributes'
- * subcommand. The appropriate function for the filesystem to which
+ * This function implements part of the hookable 'file attributes'
+ * subcommand. The appropriate function for the filesystem to which
* pathPtr belongs will be called.
*
* Results:
- * The called procedure may either return an array of strings, or may
+ * The called function may either return an array of strings, or may
* instead return NULL and place a Tcl list into the given objPtrRef.
* Tcl will take that list and first increment its refCount before using
* it. On completion of that use, Tcl will decrement its refCount. Hence
@@ -2380,17 +2430,15 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
*----------------------------------------------------------------------
*/
-CONST char **
-Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
- Tcl_Obj *pathPtr;
- Tcl_Obj **objPtrRef;
+const char *const *
+Tcl_FSFileAttrStrings(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, objPtrRef);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
+ return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
}
Tcl_SetErrno(ENOENT);
return NULL;
@@ -2414,14 +2462,14 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
*/
int
-TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
- Tcl_Obj *pathPtr; /* File whose attributes are to be
- * indexed into. */
- CONST char *attributeName; /* The attribute being looked for. */
- int *indexPtr; /* Where to write the found index. */
+TclFSFileAttrIndex(
+ Tcl_Obj *pathPtr, /* File whose attributes are to be indexed
+ * into. */
+ const char *attributeName, /* The attribute being looked for. */
+ int *indexPtr) /* Where to write the found index. */
{
Tcl_Obj *listObj = NULL;
- CONST char **attrTable;
+ const char *const *attrTable;
/*
* Get the attribute table for the file.
@@ -2478,14 +2526,14 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
*
* Tcl_FSFileAttrsGet --
*
- * This procedure implements read access for the hookable 'file
- * attributes' subcommand. The appropriate function for the filesystem
- * to which pathPtr belongs will be called.
+ * This function implements read access for the hookable 'file
+ * attributes' subcommand. The appropriate function for the filesystem to
+ * which pathPtr belongs will be called.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
- * was returned) is likely to have a refCount of zero. Either way we
- * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we must
+ * either store it somewhere (e.g. the Tcl result), or Incr/Decr its
* refCount to ensure it is properly freed.
*
* Side effects:
@@ -2495,18 +2543,16 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
*/
int
-Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* filename we are operating on. */
- Tcl_Obj **objPtrRef; /* for output. */
+Tcl_FSFileAttrsGet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* filename we are operating on. */
+ Tcl_Obj **objPtrRef) /* for output. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
- if (proc != NULL) {
- return (*proc)(interp, index, pathPtr, objPtrRef);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
+ return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -2517,9 +2563,9 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
*
* Tcl_FSFileAttrsSet --
*
- * This procedure implements write access for the hookable 'file
- * attributes' subcommand. The appropriate function for the filesystem
- * to which pathPtr belongs will be called.
+ * This function implements write access for the hookable 'file
+ * attributes' subcommand. The appropriate function for the filesystem to
+ * which pathPtr belongs will be called.
*
* Results:
* Standard Tcl return code.
@@ -2531,18 +2577,16 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
*/
int
-Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* filename we are operating on. */
- Tcl_Obj *objPtr; /* Input value. */
+Tcl_FSFileAttrsSet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* filename we are operating on. */
+ Tcl_Obj *objPtr) /* Input value. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
- if (proc != NULL) {
- return (*proc)(interp, index, pathPtr, objPtr);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
+ return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -2555,10 +2599,10 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*
* This function replaces the library version of getcwd().
*
- * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its
- * own record (in a Tcl_Obj) of the cwd, and an attempt is made to
- * synchronise this with the cwd's containing filesystem, if that
- * filesystem provides a cwdProc (e.g. the native filesystem).
+ * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own
+ * record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this
+ * with the cwd's containing filesystem, if that filesystem provides a
+ * cwdProc (e.g. the native filesystem).
*
* Note that if Tcl's cwd is not in the native filesystem, then of course
* Tcl's cwd and the native cwd are different: extensions should
@@ -2575,10 +2619,10 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*
* Results:
* The result is a pointer to a Tcl_Obj specifying the current directory,
- * or NULL if the current directory could not be determined. If NULL is
+ * or NULL if the current directory could not be determined. If NULL is
* returned, an error message is left in the interp's result.
*
- * The result already has its refCount incremented for the caller. When
+ * The result already has its refCount incremented for the caller. When
* it is no longer needed, that refCount should be decremented.
*
* Side effects:
@@ -2587,74 +2631,78 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSGetCwd(interp)
- Tcl_Interp *interp;
+Tcl_Obj *
+Tcl_FSGetCwd(
+ Tcl_Interp *interp)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (TclFSCwdPointerEquals(NULL)) {
FilesystemRecord *fsRecPtr;
Tcl_Obj *retVal = NULL;
/*
- * We've never been called before, try to find a cwd. Call each of
- * the "Tcl_GetCwd" function in succession. A non-NULL return value
+ * We've never been called before, try to find a cwd. Call each of the
+ * "Tcl_GetCwd" function in succession. A non-NULL return value
* indicates the particular function has succeeded.
*/
fsRecPtr = FsGetFirstFilesystem();
- while ((retVal == NULL) && (fsRecPtr != NULL)) {
- Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
- if (proc != NULL) {
- if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
- ClientData retCd;
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
- retCd = (*proc2)(NULL);
- if (retCd != NULL) {
- Tcl_Obj *norm;
- /* Looks like a new current directory */
- retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
- retCd);
- Tcl_IncrRefCount(retVal);
- norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
- if (norm != NULL) {
- /*
- * We found a cwd, which is now in our global
- * storage. We must make a copy. Norm already has
- * a refCount of 1.
- *
- * Threading issue: note that multiple threads at
- * system startup could in principle call this
- * procedure simultaneously. They will therefore
- * each set the cwdPathPtr independently. That
- * behaviour is a bit peculiar, but should be
- * fine. Once we have a cwd, we'll always be in
- * the 'else' branch below which is simpler.
- */
-
- FsUpdateCwd(norm, retCd);
- Tcl_DecrRefCount(norm);
- } else {
- (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
- }
- Tcl_DecrRefCount(retVal);
- retVal = NULL;
- goto cdDidNotChange;
- } else {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- }
+ Claim();
+ for (; (retVal == NULL) && (fsRecPtr != NULL);
+ fsRecPtr = fsRecPtr->nextPtr) {
+ ClientData retCd;
+ TclFSGetCwdProc2 *proc2;
+ if (fsRecPtr->fsPtr->getCwdProc == NULL) {
+ continue;
+ }
+
+ if (fsRecPtr->fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
+ retVal = fsRecPtr->fsPtr->getCwdProc(interp);
+ continue;
+ }
+
+ proc2 = (TclFSGetCwdProc2 *) fsRecPtr->fsPtr->getCwdProc;
+ retCd = proc2(NULL);
+ if (retCd != NULL) {
+ Tcl_Obj *norm;
+
+ /*
+ * Looks like a new current directory.
+ */
+
+ retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
+ Tcl_IncrRefCount(retVal);
+ norm = TclFSNormalizeAbsolutePath(interp,retVal);
+ if (norm != NULL) {
+ /*
+ * We found a cwd, which is now in our global storage. We
+ * must make a copy. Norm already has a refCount of 1.
+ *
+ * Threading issue: note that multiple threads at system
+ * startup could in principle call this function
+ * simultaneously. They will therefore each set the
+ * cwdPathPtr independently. That behaviour is a bit
+ * peculiar, but should be fine. Once we have a cwd, we'll
+ * always be in the 'else' branch below which is simpler.
+ */
+
+ FsUpdateCwd(norm, retCd);
+ Tcl_DecrRefCount(norm);
} else {
- retVal = (*proc)(interp);
+ fsRecPtr->fsPtr->freeInternalRepProc(retCd);
}
+ Tcl_DecrRefCount(retVal);
+ retVal = NULL;
+ Disclaim();
+ goto cdDidNotChange;
+ } else if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
- fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
/*
* Now the 'cwd' may NOT be normalized, at least on some platforms.
@@ -2666,21 +2714,23 @@ Tcl_FSGetCwd(interp)
*/
if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
+
if (norm != NULL) {
/*
- * We found a cwd, which is now in our global storage. We
- * must make a copy. Norm already has a refCount of 1.
+ * We found a cwd, which is now in our global storage. We must
+ * make a copy. Norm already has a refCount of 1.
*
* Threading issue: note that multiple threads at system
- * startup could in principle call this procedure
- * simultaneously. They will therefore each set the
- * cwdPathPtr independently. That behaviour is a bit
- * peculiar, but should be fine. Once we have a cwd, we'll
- * always be in the 'else' branch below which is simpler.
+ * startup could in principle call this function
+ * simultaneously. They will therefore each set the cwdPathPtr
+ * independently. That behaviour is a bit peculiar, but should
+ * be fine. Once we have a cwd, we'll always be in the 'else'
+ * branch below which is simpler.
*/
ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
+
FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
Tcl_DecrRefCount(norm);
}
@@ -2690,106 +2740,116 @@ Tcl_FSGetCwd(interp)
/*
* We already have a cwd cached, but we want to give the filesystem it
* is in a chance to check whether that cwd has changed, or is perhaps
- * no longer accessible. This allows an error to be thrown if, say,
+ * no longer accessible. This allows an error to be thrown if, say,
* the permissions on that directory have changed.
*/
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ const Tcl_Filesystem *fsPtr =
+ Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ ClientData retCd = NULL;
+ Tcl_Obj *retVal, *norm;
/*
* If the filesystem couldn't be found, or if no cwd function exists
* for this filesystem, then we simply assume the cached cwd is ok.
* If we do call a cwd, we must watch for errors (if the cwd returns
- * NULL). This ensures that, say, on Unix if the permissions of the
+ * NULL). This ensures that, say, on Unix if the permissions of the
* cwd change, 'pwd' does actually throw the correct error in Tcl.
* (This is tested for in the test suite on unix).
*/
- if (fsPtr != NULL) {
- Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
- ClientData retCd = NULL;
- if (proc != NULL) {
- Tcl_Obj *retVal;
- if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
- retCd = (*proc2)(tsdPtr->cwdClientData);
- if (retCd == NULL && interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
+ if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
+ goto cdDidNotChange;
+ }
- if (retCd == tsdPtr->cwdClientData) {
- goto cdDidNotChange;
- }
+ if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
+ retVal = fsPtr->getCwdProc(interp);
+ } else {
+ /*
+ * New API.
+ */
- /*
- * Looks like a new current directory.
- */
+ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
- retVal = (*fsPtr->internalToNormalizedProc)(retCd);
- Tcl_IncrRefCount(retVal);
- } else {
- retVal = (*proc)(interp);
- }
- if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp,
- retVal, NULL);
+ retCd = proc2(tsdPtr->cwdClientData);
+ if (retCd == NULL && interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
+ }
- /*
- * Check whether cwd has changed from the value previously
- * stored in cwdPathPtr. Really 'norm' shouldn't be null,
- * but we are careful.
- */
+ if (retCd == tsdPtr->cwdClientData) {
+ goto cdDidNotChange;
+ }
- if (norm == NULL) {
- /* Do nothing */
- if (retCd != NULL) {
- (*fsPtr->freeInternalRepProc)(retCd);
- }
- } else if (norm == tsdPtr->cwdPathPtr) {
- goto cdEqual;
- } else {
- /*
- * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
- * normalized paths. Therefore we can be more
- * efficient than calling 'Tcl_FSEqualPaths', and in
- * addition avoid a nasty infinite loop bug when
- * trying to normalize tsdPtr->cwdPathPtr.
- */
-
- int len1, len2;
- char *str1, *str2;
-
- str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
- str2 = Tcl_GetStringFromObj(norm, &len2);
- if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
- /*
- * If the paths were equal, we can be more
- * efficient and retain the old path object which
- * will probably already be shared. In this case
- * we can simply free the normalized path we just
- * calculated.
- */
-
- cdEqual:
- Tcl_DecrRefCount(norm);
- if (retCd != NULL) {
- (*fsPtr->freeInternalRepProc)(retCd);
- }
- } else {
- FsUpdateCwd(norm, retCd);
- Tcl_DecrRefCount(norm);
- }
- }
- Tcl_DecrRefCount(retVal);
- } else {
- /* The 'cwd' function returned an error; reset the cwd */
- FsUpdateCwd(NULL, NULL);
+ /*
+ * Looks like a new current directory.
+ */
+
+ retVal = fsPtr->internalToNormalizedProc(retCd);
+ Tcl_IncrRefCount(retVal);
+ }
+
+ /*
+ * Check if the 'cwd' function returned an error; if so, reset the
+ * cwd.
+ */
+
+ if (retVal == NULL) {
+ FsUpdateCwd(NULL, NULL);
+ goto cdDidNotChange;
+ }
+
+ /*
+ * Normalize the path.
+ */
+
+ norm = TclFSNormalizeAbsolutePath(interp, retVal);
+
+ /*
+ * Check whether cwd has changed from the value previously stored in
+ * cwdPathPtr. Really 'norm' shouldn't be NULL, but we are careful.
+ */
+
+ if (norm == NULL) {
+ /* Do nothing */
+ if (retCd != NULL) {
+ fsPtr->freeInternalRepProc(retCd);
+ }
+ } else if (norm == tsdPtr->cwdPathPtr) {
+ goto cdEqual;
+ } else {
+ /*
+ * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are normalized
+ * paths. Therefore we can be more efficient than calling
+ * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop
+ * bug when trying to normalize tsdPtr->cwdPathPtr.
+ */
+
+ int len1, len2;
+ const char *str1, *str2;
+
+ str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+ str2 = Tcl_GetStringFromObj(norm, &len2);
+ if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
+ /*
+ * If the paths were equal, we can be more efficient and
+ * retain the old path object which will probably already be
+ * shared. In this case we can simply free the normalized path
+ * we just calculated.
+ */
+
+ cdEqual:
+ Tcl_DecrRefCount(norm);
+ if (retCd != NULL) {
+ fsPtr->freeInternalRepProc(retCd);
}
+ } else {
+ FsUpdateCwd(norm, retCd);
+ Tcl_DecrRefCount(norm);
}
}
+ Tcl_DecrRefCount(retVal);
}
cdDidNotChange:
@@ -2811,20 +2871,20 @@ Tcl_FSGetCwd(interp)
* it.
*
* Results:
- * See chdir() documentation. If successful, we keep a record of the
+ * See chdir() documentation. If successful, we keep a record of the
* successful path in cwdPathPtr for subsequent calls to getcwd.
*
* Side effects:
- * See chdir() documentation. The global cwdPathPtr may change value.
+ * See chdir() documentation. The global cwdPathPtr may change value.
*
*----------------------------------------------------------------------
*/
int
-Tcl_FSChdir(pathPtr)
- Tcl_Obj *pathPtr;
+Tcl_FSChdir(
+ Tcl_Obj *pathPtr)
{
- Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr;
int retVal = -1;
if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
@@ -2834,14 +2894,13 @@ Tcl_FSChdir(pathPtr)
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
- Tcl_FSChdirProc *proc = fsPtr->chdirProc;
- if (proc != NULL) {
+ if (fsPtr->chdirProc != NULL) {
/*
* If this fails, an appropriate errno will have been stored using
* 'Tcl_SetErrno()'.
*/
- retVal = (*proc)(pathPtr);
+ retVal = fsPtr->chdirProc(pathPtr);
} else {
/*
* Fallback on stat-based implementation.
@@ -2851,9 +2910,9 @@ Tcl_FSChdir(pathPtr)
/*
* If the file can be stat'ed and is a directory and is readable,
- * then we can chdir. If any of these actions fail, then
+ * then we can chdir. If any of these actions fail, then
* 'Tcl_SetErrno()' should automatically have been called to set
- * an appropriate error code
+ * an appropriate error code.
*/
if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode))
@@ -2870,22 +2929,20 @@ Tcl_FSChdir(pathPtr)
}
/*
- * The cwd changed, or an error was thrown. If an error was thrown, we
- * can just continue (and that will report the error to the user). If
- * there was no error we must assume that the cwd was actually changed to
- * the normalized value we calculated above, and we must therefore cache
- * that information.
- */
-
- /*
+ * The cwd changed, or an error was thrown. If an error was thrown, we can
+ * just continue (and that will report the error to the user). If there
+ * was no error we must assume that the cwd was actually changed to the
+ * normalized value we calculated above, and we must therefore cache that
+ * information.
+ *
* If the filesystem in question has a getCwdProc, then the correct logic
* which performs the part below is already part of the Tcl_FSGetCwd()
- * call, so no need to replicate it again. This will have a side effect
- * though. The private authoritative representation of the current
- * working directory stored in cwdPathPtr in static memory will be
- * out-of-sync with the real OS-maintained value. The first call to
- * Tcl_FSGetCwd will however recalculate the private copy to match the
- * OS-value so everything will work right.
+ * call, so no need to replicate it again. This will have a side effect
+ * though. The private authoritative representation of the current working
+ * directory stored in cwdPathPtr in static memory will be out-of-sync
+ * with the real OS-maintained value. The first call to Tcl_FSGetCwd will
+ * however recalculate the private copy to match the OS-value so
+ * everything will work right.
*
* However, if there is no getCwdProc, then we _must_ update our private
* storage of the cwd, since this is the only opportunity to do that!
@@ -2899,8 +2956,8 @@ Tcl_FSChdir(pathPtr)
/*
* Note that this normalized path may be different to what we found
* above (or at least a different object), if the filesystem epoch
- * changed recently. This can actually happen with scripted documents
- * very easily. Therefore we ask for the normalized path again (the
+ * changed recently. This can actually happen with scripted documents
+ * very easily. Therefore we ask for the normalized path again (the
* correct value will have been cached as a result of the
* Tcl_FSGetFileSystemForPath call above anyway).
*/
@@ -2916,29 +2973,33 @@ Tcl_FSChdir(pathPtr)
if (fsPtr == &tclNativeFilesystem) {
/*
* For the native filesystem, we keep a cache of the native
- * representation of the cwd. But, we want to do that for the
+ * representation of the cwd. But, we want to do that for the
* exact format that is returned by 'getcwd' (so that we can later
* compare the two representations for equality), which might not
* be exactly the same char-string as the native representation of
* the fully normalized path (e.g. on Windows there's a
- * forward-slash vs backslash difference). Hence we ask for this
- * again here. On Unix it might actually be true that we always
+ * forward-slash vs backslash difference). Hence we ask for this
+ * again here. On Unix it might actually be true that we always
* have the correct form in the native rep in which case we could
* simply use:
* cd = Tcl_FSGetNativePath(pathPtr);
- * instead. This should be examined by someone on Unix.
+ * 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;
/*
* Assumption we are using a filesystem version 2.
*/
- TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
- cd = (*proc2)(tsdPtr->cwdClientData);
- FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
+ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
+
+ cd = proc2(oldcd);
+ if (cd != oldcd) {
+ FsUpdateCwd(normDirName, cd);
+ }
} else {
FsUpdateCwd(normDirName, NULL);
}
@@ -2953,447 +3014,589 @@ Tcl_FSChdir(pathPtr)
* Tcl_FSLoadFile --
*
* Dynamically loads a binary code file into memory and returns the
- * addresses of two procedures within that file, if they are defined.
- * The appropriate function for the filesystem to which pathPtr belongs
- * will be called.
+ * addresses of two functions within that file, if they are defined. The
+ * appropriate function for the filesystem to which pathPtr belongs will
+ * be called.
*
* Note that the native filesystem doesn't actually assume 'pathPtr' is a
- * path. Rather it assumes pathPtr is either a path or just the name
+ * path. Rather it assumes pathPtr is either a path or just the name
* (tail) of a file which can be found somewhere in the environment's
- * loadable path. This behaviour is not very compatible with virtual
+ * loadable path. This behaviour is not very compatible with virtual
* filesystems (and has other problems documented in the load man-page),
* so it is advised that full paths are always used.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be unloaded by
+ * New code suddenly appears in memory. This may later be unloaded by
* passing the clientData to the unloadProc.
*
*----------------------------------------------------------------------
*/
int
-Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- handlePtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+Tcl_FSLoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code. */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in the
+ const char *sym1, const char *sym2,
+ /* Names of two functions to look up in the
* file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for dynamically loaded
+ Tcl_LoadHandle *handlePtr, /* 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. */
{
- CONST char *symbols[2];
- Tcl_PackageInitProc **procPtrs[2];
- ClientData clientData;
+ const char *symbols[3];
+ void *procPtrs[2];
int res;
- /* Initialize the arrays */
+ /*
+ * Initialize the arrays.
+ */
+
symbols[0] = sym1;
symbols[1] = sym2;
- procPtrs[0] = proc1Ptr;
- procPtrs[1] = proc2Ptr;
-
- /* Perform the load */
- res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs,
- handlePtr, &clientData, unloadProcPtr);
+ symbols[2] = NULL;
/*
- * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
- * library, we don't keep the loadHandle (for TclpFindSymbol) and the
- * clientData (for the unloadProc) separately. In fact we effectively
- * throw away the loadHandle and only use the clientData. It just so
- * happens, for the native filesystem only, that these two are identical.
- *
- * This also means that the signatures Tcl_FSUnloadFileProc and
- * Tcl_FSLoadFileProc are both misleading.
+ * Perform the load.
*/
- *handlePtr = (Tcl_LoadHandle) clientData;
+ res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
+ if (res == TCL_OK) {
+ *proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0];
+ *proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
+ } else {
+ *proc1Ptr = *proc2Ptr = NULL;
+ }
+
return res;
}
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * Tcl_LoadFile --
*
* Dynamically loads a binary code file into memory and returns the
- * addresses of a number of given procedures within that file, if they
- * are defined. The appropriate function for the filesystem to which
- * pathPtr belongs will be called.
+ * addresses of a number of given functions within that file, if they are
+ * defined. The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
*
* Note that the native filesystem doesn't actually assume 'pathPtr' is a
- * path. Rather it assumes pathPtr is either a path or just the name
+ * path. Rather it assumes pathPtr is either a path or just the name
* (tail) of a file which can be found somewhere in the environment's
- * loadable path. This behaviour is not very compatible with virtual
+ * loadable path. This behaviour is not very compatible with virtual
* filesystems (and has other problems documented in the load man-page),
* so it is advised that full paths are always used.
*
- * This function is currently private to Tcl. It may be exported in the
- * future and its interface fixed (but we should clean up the
- * loadHandle/clientData confusion at that time -- see the above comments
- * in Tcl_FSLoadFile for details). For a public function, see
- * Tcl_FSLoadFile.
- *
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be unloaded by
- * passing the clientData to the unloadProc.
+ * New code suddenly appears in memory. This may later be unloaded by
+ * calling TclFS_UnloadFile.
*
*----------------------------------------------------------------------
*/
int
-TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
- handlePtr, clientDataPtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+Tcl_LoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code. */
- int symc; /* Number of symbols/procPtrs in the next two
- * arrays. */
- CONST char *symbols[]; /* Names of procedures to look up in the
- * file's symbol table. */
- Tcl_PackageInitProc **procPtrs[];
- /* Where to return the addresses corresponding
- * to symbols[]. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for shared library
+ const char *const symbols[],/* Names of functions to look up in the file's
+ * symbol table. */
+ int flags, /* Flags */
+ void *procVPtrs, /* Where to return the addresses corresponding
+ * to symbols[]. */
+ Tcl_LoadHandle *handlePtr) /* Filled with token for shared library
* information which can be used in
* TclpFindSymbol. */
- 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
- Tcl_Filesystem *copyFsPtr;
- Tcl_Obj *copyToPtr;
-
- if (proc != NULL) {
- int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
- if (retVal == TCL_OK) {
- int i;
- if (*handlePtr == NULL) {
- return TCL_ERROR;
- }
- for (i=0 ; i<symc ; i++) {
- if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
- }
- }
+ void **procPtrs = (void **) procVPtrs;
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ const Tcl_Filesystem *copyFsPtr;
+ Tcl_FSUnloadFileProc *unloadProcPtr;
+ Tcl_Obj *copyToPtr;
+ Tcl_LoadHandle newLoadHandle = NULL;
+ Tcl_LoadHandle divertedLoadHandle = NULL;
+ Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
+ FsDivertLoad *tvdlPtr;
+ int retVal;
+ int i;
- /*
- * Copy this across, since both are equal for the native fs.
- */
+ if (fsPtr == NULL) {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
- *clientDataPtr = (ClientData)*handlePtr;
- Tcl_ResetResult(interp);
- return TCL_OK;
- }
- if (Tcl_GetErrno() != EXDEV) {
- return retVal;
+ if (fsPtr->loadFileProc != NULL) {
+ int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc))
+ (interp, pathPtr, handlePtr, &unloadProcPtr, flags);
+
+ if (retVal == TCL_OK) {
+ if (*handlePtr == NULL) {
+ return TCL_ERROR;
}
+ Tcl_ResetResult(interp);
+ goto resolveSymbols;
+ }
+ if (Tcl_GetErrno() != EXDEV) {
+ return retVal;
+ }
+ }
+
+ /*
+ * The filesystem doesn't support 'load', so we fall back on the following
+ * technique:
+ *
+ * First check if it is readable -- and exists!
+ */
+
+ if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load library \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+
+#ifdef TCL_LOAD_FROM_MEMORY
+ /*
+ * The platform supports loading code from memory, so ask for a buffer of
+ * the appropriate size, read the file into it and load the code from the
+ * buffer:
+ */
+
+ {
+ int ret, size;
+ void *buffer;
+ Tcl_StatBuf statBuf;
+ Tcl_Channel data;
+
+ ret = Tcl_FSStat(pathPtr, &statBuf);
+ if (ret < 0) {
+ goto mustCopyToTempAnyway;
}
+ size = (int) statBuf.st_size;
/*
- * The filesystem doesn't support 'load', so we fall back on the
- * following technique:
- *
- * First check if it is readable -- and exists!
+ * Tcl_Read takes an int: check that file size isn't wide.
*/
- if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ if (size != (Tcl_WideInt) statBuf.st_size) {
+ goto mustCopyToTempAnyway;
+ }
+ data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
+ if (!data) {
+ goto mustCopyToTempAnyway;
+ }
+ buffer = TclpLoadMemoryGetBuffer(interp, size);
+ if (!buffer) {
+ Tcl_Close(interp, data);
+ goto mustCopyToTempAnyway;
}
+ ret = Tcl_Read(data, buffer, size);
+ Tcl_Close(interp, data);
+ ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
+ &unloadProcPtr, flags);
+ if (ret == TCL_OK && *handlePtr != NULL) {
+ goto resolveSymbols;
+ }
+ }
-#ifdef TCL_LOAD_FROM_MEMORY
+ mustCopyToTempAnyway:
+ Tcl_ResetResult(interp);
+#endif /* TCL_LOAD_FROM_MEMORY */
+
+ /*
+ * Get a temporary filename to use, first to copy the file into, and then
+ * to load.
+ */
+
+ copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
+ if (copyToPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(copyToPtr);
+
+ copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
+ if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
/*
- * The platform supports loading code from memory, so ask for a buffer
- * of the appropriate size, read the file into it and load the code
- * from the buffer:
+ * We already know we can't use Tcl_FSLoadFile from this filesystem,
+ * and we must avoid a possible infinite loop. Try to delete the file
+ * we probably created, and then exit.
*/
- do {
- int ret, size;
- void *buffer;
- Tcl_StatBuf statBuf;
- Tcl_Channel data;
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load from current filesystem", -1));
+ return TCL_ERROR;
+ }
- ret = Tcl_FSStat(pathPtr, &statBuf);
- if (ret < 0) {
- break;
- }
- size = (int) statBuf.st_size;
+ if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) {
+ /*
+ * Cross-platform copy failed.
+ */
- /*
- * Tcl_Read takes an int: check that file size isn't wide.
- */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return TCL_ERROR;
+ }
- if (size != (Tcl_WideInt) statBuf.st_size) {
- break;
- }
- data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
- if (!data) {
- break;
- }
- buffer = TclpLoadMemoryGetBuffer(interp, size);
- if (!buffer) {
- Tcl_Close(interp, data);
- break;
- }
- Tcl_SetChannelOption(interp, data, "-translation", "binary");
- ret = Tcl_Read(data, buffer, size);
- Tcl_Close(interp, data);
- ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
- unloadProcPtr);
- if (ret == TCL_OK) {
- int i;
- if (*handlePtr == NULL) {
- break;
- }
- for (i = 0;i < symc;i++) {
- if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
- }
- }
- *clientDataPtr = (ClientData) *handlePtr;
- return TCL_OK;
- }
- } while (0);
- Tcl_ResetResult(interp);
+#ifndef _WIN32
+ /*
+ * Do we need to set appropriate permissions on the file? This may be
+ * required on some systems. On Unix we could loop over the file
+ * attributes, and set any that are called "-permissions" to 0700. However
+ * we just do this directly, like this:
+ */
+
+ {
+ int index;
+ Tcl_Obj *perm;
+
+ TclNewLiteralStringObj(perm, "0700");
+ Tcl_IncrRefCount(perm);
+ if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
+ Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
+ }
+ Tcl_DecrRefCount(perm);
+ }
#endif
+ /*
+ * We need to reset the result now, because the cross-filesystem copy may
+ * have stored the number of bytes in the result.
+ */
+
+ Tcl_ResetResult(interp);
+
+ retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
+ &newLoadHandle);
+ if (retVal != TCL_OK) {
/*
- * Get a temporary filename to use, first to copy the file into, and
- * then to load.
+ * The file didn't load successfully.
*/
- copyToPtr = TclpTempFileName();
- if (copyToPtr == NULL) {
- Tcl_AppendResult(interp, "couldn't create temporary file: ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_IncrRefCount(copyToPtr);
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return retVal;
+ }
- copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
- if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
- /*
- * We already know we can't use Tcl_FSLoadFile from this
- * filesystem, and we must avoid a possible infinite loop. Try to
- * delete the file we probably created, and then exit.
- */
+ /*
+ * Try to delete the file immediately - this is possible in some OSes, and
+ * avoids any worries about leaving the copy laying around on exit.
+ */
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- Tcl_AppendResult(interp, "couldn't load from current filesystem",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ Tcl_DecrRefCount(copyToPtr);
- if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
- Tcl_LoadHandle newLoadHandle = NULL;
- ClientData newClientData = NULL;
- Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
- FsDivertLoad *tvdlPtr;
- int retVal;
+ /*
+ * We tell our caller about the real shared library which was loaded.
+ * Note that this does mean that the package list maintained by 'load'
+ * will store the original (vfs) path alongside the temporary load
+ * handle and unload proc ptr.
+ */
-#if !defined(__WIN32__)
- /*
- * Do we need to set appropriate permissions on the file? This
- * may be required on some systems. On Unix we could loop over
- * the file attributes, and set any that are called "-permissions"
- * to 0700. However, we just do this directly, like this:
- */
+ *handlePtr = newLoadHandle;
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
- int index;
- Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
- Tcl_IncrRefCount(perm);
- if (TclFSFileAttrIndex(copyToPtr, "-permissions",
- &index) == TCL_OK) {
- Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
- }
- Tcl_DecrRefCount(perm);
-#endif
+ /*
+ * When we unload this file, we need to divert the unloading so we can
+ * unload and cleanup the temporary file correctly.
+ */
- /*
- * We need to reset the result now, because the cross- filesystem
- * copy may have stored the number of bytes in the result.
- */
+ tvdlPtr = ckalloc(sizeof(FsDivertLoad));
- Tcl_ResetResult(interp);
+ /*
+ * Remember three pieces of information. This allows us to cleanup the
+ * diverted load completely, on platforms which allow proper unloading of
+ * code.
+ */
- retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
- &newLoadHandle, &newClientData, &newUnloadProcPtr);
- if (retVal != TCL_OK) {
- /* The file didn't load successfully */
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- return retVal;
- }
+ tvdlPtr->loadHandle = newLoadHandle;
+ tvdlPtr->unloadProcPtr = newUnloadProcPtr;
- /*
- * Try to delete the file immediately - this is possible in some
- * OSes, and avoids any worries about leaving the copy laying
- * around on exit.
- */
+ if (copyFsPtr != &tclNativeFilesystem) {
+ /*
+ * copyToPtr is already incremented for this reference.
+ */
- if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
- Tcl_DecrRefCount(copyToPtr);
+ tvdlPtr->divertedFile = copyToPtr;
- /*
- * We tell our caller about the real shared library which was
- * loaded. Note that this does mean that the package list
- * maintained by 'load' will store the original (vfs) path
- * alongside the temporary load handle and unload proc ptr.
- */
+ /*
+ * This is the filesystem we loaded it into. Since we have a reference
+ * to 'copyToPtr', we already have a refCount on this filesystem, so
+ * we don't need to worry about it disappearing on us.
+ */
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = newClientData;
- (*unloadProcPtr) = newUnloadProcPtr;
- Tcl_ResetResult(interp);
- return TCL_OK;
- }
+ tvdlPtr->divertedFilesystem = copyFsPtr;
+ tvdlPtr->divertedFileNativeRep = NULL;
+ } else {
+ /*
+ * We need the native rep.
+ */
- /*
- * When we unload this file, we need to divert the unloading so we
- * can unload and cleanup the temporary file correctly.
- */
+ tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
+ Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
- tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+ /*
+ * We don't need or want references to the copied Tcl_Obj or the
+ * filesystem if it is the native one.
+ */
- /*
- * Remember three pieces of information. This allows us to
- * cleanup the diverted load completely, on platforms which allow
- * proper unloading of code.
- */
+ tvdlPtr->divertedFile = NULL;
+ tvdlPtr->divertedFilesystem = NULL;
+ Tcl_DecrRefCount(copyToPtr);
+ }
- tvdlPtr->loadHandle = newLoadHandle;
- tvdlPtr->unloadProcPtr = newUnloadProcPtr;
+ copyToPtr = NULL;
- if (copyFsPtr != &tclNativeFilesystem) {
- /* copyToPtr is already incremented for this reference */
- tvdlPtr->divertedFile = copyToPtr;
+ divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
+ divertedLoadHandle->clientData = tvdlPtr;
+ divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
+ divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
+ *handlePtr = divertedLoadHandle;
- /*
- * This is the filesystem we loaded it into. Since we have a
- * reference to 'copyToPtr', we already have a refCount on
- * this filesystem, so we don't need to worry about it
- * disappearing on us.
- */
+ Tcl_ResetResult(interp);
+ return retVal;
- tvdlPtr->divertedFilesystem = copyFsPtr;
- tvdlPtr->divertedFileNativeRep = NULL;
- } else {
- /* We need the native rep */
- tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
- Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
+ resolveSymbols:
+ /*
+ * At this point, *handlePtr is already set up to the handle for the
+ * loaded library. We now try to resolve the symbols.
+ */
- /*
- * We don't need or want references to the copied Tcl_Obj or
- * the filesystem if it is the native one.
+ if (symbols != NULL) {
+ for (i=0 ; symbols[i] != NULL; i++) {
+ procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
+ if (procPtrs[i] == NULL) {
+ /*
+ * At least one symbol in the list was not found. Unload the
+ * file, and report the problem back to the caller.
+ * (Tcl_FindSymbol should already have left an appropriate
+ * error message.)
*/
- tvdlPtr->divertedFile = NULL;
- tvdlPtr->divertedFilesystem = NULL;
- Tcl_DecrRefCount(copyToPtr);
+ (*handlePtr)->unloadFileProcPtr(*handlePtr);
+ *handlePtr = NULL;
+ return TCL_ERROR;
}
-
- copyToPtr = NULL;
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = (ClientData) tvdlPtr;
- (*unloadProcPtr) = &FSUnloadTempFile;
- Tcl_ResetResult(interp);
- return retVal;
-
- } else {
- /*
- * Cross-platform copy failed.
- */
-
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- return TCL_ERROR;
}
}
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
+ return TCL_OK;
}
+
/*
- * This function used to be in the platform specific directories, but it has
- * now been made to work cross-platform
+ *----------------------------------------------------------------------
+ *
+ * DivertFindSymbol --
+ *
+ * Find a symbol in a shared library loaded by copy-from-VFS.
+ *
+ *----------------------------------------------------------------------
*/
-int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- clientDataPtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
- * code (UTF-8). */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in the
- * file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, **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. */
+static void *
+DivertFindSymbol(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_LoadHandle loadHandle, /* Handle to the diverted module */
+ const char *symbol) /* Symbol to resolve */
{
- Tcl_LoadHandle handle = NULL;
- int res;
+ FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
+ Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;
+
+ return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DivertUnloadFile --
+ *
+ * Unloads a file that has been loaded by copying from VFS to the native
+ * filesystem.
+ *
+ * Parameters:
+ * loadHandle -- Handle of the file to unload
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DivertUnloadFile(
+ Tcl_LoadHandle loadHandle)
+{
+ FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
+ Tcl_LoadHandle originalHandle;
- res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
+ /*
+ * This test should never trigger, since we give the client data in the
+ * function above.
+ */
- if (res != TCL_OK) {
- return res;
+ if (tvdlPtr == NULL) {
+ return;
}
+ originalHandle = tvdlPtr->loadHandle;
- if (handle == NULL) {
- return TCL_ERROR;
+ /*
+ * Call the real 'unloadfile' proc we actually used. It is very important
+ * that we call this first, so that the shared library is actually
+ * unloaded by the OS. Otherwise, the following 'delete' may well fail
+ * because the shared library is still in use.
+ */
+
+ originalHandle->unloadFileProcPtr(originalHandle);
+
+ /*
+ * What filesystem contains the temp copy of the library?
+ */
+
+ if (tvdlPtr->divertedFilesystem == NULL) {
+ /*
+ * It was the native filesystem, and we have a special function
+ * available just for this purpose, which we know works even at this
+ * late stage.
+ */
+
+ TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
+ NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
+ } else {
+ /*
+ * Remove the temporary file we created. Note, we may crash here
+ * because encodings have been taken down already.
+ */
+
+ if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
+ != TCL_OK) {
+ /*
+ * The above may have failed because the filesystem, or something
+ * it depends upon (e.g. encodings) have been taken down because
+ * Tcl is exiting.
+ *
+ * We may need to work out how to delete this file more robustly
+ * (or give the filesystem the information it needs to delete the
+ * file more robustly).
+ *
+ * In particular, one problem might be that the filesystem cannot
+ * extract the information it needs from the above path object
+ * because Tcl's entire filesystem apparatus (the code in this
+ * file) has been finalized, and it refuses to pass the internal
+ * representation to the filesystem.
+ */
+ }
+
+ /*
+ * And free up the allocations. This will also of course remove a
+ * refCount from the Tcl_Filesystem to which this file belongs, which
+ * could then free up the filesystem if we are exiting.
+ */
+
+ Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
- *clientDataPtr = (ClientData)handle;
+ ckfree(tvdlPtr);
+ ckfree(loadHandle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindSymbol --
+ *
+ * Find a symbol in a loaded library
+ *
+ * Results:
+ * Returns a pointer to the symbol if found. If not found, returns NULL
+ * and leaves an error message in the interpreter result.
+ *
+ * This function was once filesystem-specific, but has been made portable by
+ * having TclpDlopen return a structure that includes procedure pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void *
+Tcl_FindSymbol(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_LoadHandle loadHandle, /* Handle to the loaded library */
+ const char *symbol) /* Name of the symbol to resolve */
+{
+ return loadHandle->findSymbolProcPtr(interp, loadHandle, symbol);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSUnloadFile --
+ *
+ * Unloads a library given its handle. Checks first that the library
+ * supports unloading.
+ *
+ *----------------------------------------------------------------------
+ */
- *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
- *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
+int
+Tcl_FSUnloadFile(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_LoadHandle handle) /* Handle of the file to unload */
+{
+ if (handle->unloadFileProcPtr == NULL) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot unload: filesystem does not support unloading",
+ -1));
+ }
+ return TCL_ERROR;
+ }
+ TclpUnloadFile(handle);
return TCL_OK;
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
+ *
+ * TclpUnloadFile --
+ *
+ * Unloads a library given its handle
+ *
+ * This function was once filesystem-specific, but has been made portable by
+ * having TclpDlopen return a structure that includes procedure pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(
+ Tcl_LoadHandle handle)
+{
+ if (handle->unloadFileProcPtr != NULL) {
+ handle->unloadFileProcPtr(handle);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
*
- * FSUnloadTempFile --
+ * TclFSUnloadTempFile --
*
* This function is called when we loaded a library of code via an
- * intermediate temporary file. This function ensures the library is
+ * intermediate temporary file. This function ensures the library is
* correctly unloaded and the temporary file is correctly deleted.
*
* Results:
@@ -3403,32 +3606,35 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
* The effects of the 'unload' function called, and of course the
* temporary file will be deleted.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-static void
-FSUnloadTempFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to
- * Tcl_FSLoadFile(). The loadHandle is a token
- * that represents the loaded file. */
+
+void
+TclFSUnloadTempFile(
+ Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
+ * Tcl_FSLoadFile(). The loadHandle is a token
+ * that represents the loaded file. */
{
- FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
+ FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle;
/*
* This test should never trigger, since we give the client data in the
* function above.
*/
- if (tvdlPtr == NULL) { return; }
+ if (tvdlPtr == NULL) {
+ return;
+ }
/*
* Call the real 'unloadfile' proc we actually used. It is very important
* that we call this first, so that the shared library is actually
- * unloaded by the OS. Otherwise, the following 'delete' may well fail
+ * unloaded by the OS. Otherwise, the following 'delete' may well fail
* because the shared library is still in use.
*/
if (tvdlPtr->unloadProcPtr != NULL) {
- (*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
+ tvdlPtr->unloadProcPtr(tvdlPtr->loadHandle);
}
if (tvdlPtr->divertedFilesystem == NULL) {
@@ -3440,10 +3646,9 @@ FSUnloadTempFile(loadHandle)
TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
-
} else {
/*
- * Remove the temporary file we created. Note, we may crash here
+ * Remove the temporary file we created. Note, we may crash here
* because encodings have been taken down already.
*/
@@ -3467,7 +3672,7 @@ FSUnloadTempFile(loadHandle)
}
/*
- * And free up the allocations. This will also of course remove a
+ * And free up the allocations. This will also of course remove a
* refCount from the Tcl_Filesystem to which this file belongs, which
* could then free up the filesystem if we are exiting.
*/
@@ -3475,7 +3680,7 @@ FSUnloadTempFile(loadHandle)
Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
- ckfree((char*)tvdlPtr);
+ ckfree(tvdlPtr);
}
/*
@@ -3484,18 +3689,18 @@ FSUnloadTempFile(loadHandle)
* Tcl_FSLink --
*
* This function replaces the library version of readlink() and can also
- * be used to make links. The appropriate function for the filesystem to
+ * be used to make links. The appropriate function for the filesystem to
* which pathPtr belongs will be called.
*
* Results:
* If toPtr is NULL, then the result is a Tcl_Obj specifying the contents
* of the symbolic link given by 'pathPtr', or NULL if the symbolic link
- * could not be read. The result is owned by the caller, which should
+ * could not be read. The result is owned by the caller, which should
* call Tcl_DecrRefCount when the result is no longer needed.
*
* If toPtr is non-NULL, then the result is toPtr if the link action was
- * successful, or NULL if not. In this case the result has no additional
- * reference count, and need not be freed. The actual action to perform
+ * successful, or NULL if not. In this case the result has no additional
+ * reference count, and need not be freed. The actual action to perform
* is given by the 'linkAction' flags, which is an or'd combination of:
*
* TCL_CREATE_SYMBOLIC_LINK
@@ -3506,35 +3711,33 @@ FSUnloadTempFile(loadHandle)
* is in the same FS as pathPtr.
*
* Side effects:
- * See readlink() documentation. A new filesystem link object may appear
+ * See readlink() documentation. A new filesystem link object may appear.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_FSLink(pathPtr, toPtr, linkAction)
- Tcl_Obj *pathPtr; /* Path of file to readlink or link */
- Tcl_Obj *toPtr; /* NULL or path to be linked to */
- int linkAction; /* Action to perform */
+Tcl_FSLink(
+ Tcl_Obj *pathPtr, /* Path of file to readlink or link. */
+ Tcl_Obj *toPtr, /* NULL or path to be linked to. */
+ int linkAction) /* Action to perform. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSLinkProc *proc = fsPtr->linkProc;
- if (proc != NULL) {
- return (*proc)(pathPtr, toPtr, linkAction);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->linkProc != NULL) {
+ return fsPtr->linkProc(pathPtr, toPtr, linkAction);
}
/*
* If S_IFLNK isn't defined it means that the machine doesn't support
- * symbolic links, so the file can't possibly be a symbolic link.
- * Generate an EINVAL error, which is what happens on machines that do
- * support symbolic links when you invoke readlink on a file that isn't a
- * symbolic link.
+ * symbolic links, so the file can't possibly be a symbolic link. Generate
+ * an EINVAL error, which is what happens on machines that do support
+ * symbolic links when you invoke readlink on a file that isn't a symbolic
+ * link.
*/
#ifndef S_IFLNK
- errno = EINVAL;
+ errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
#else
Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
@@ -3546,15 +3749,15 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
*
* Tcl_FSListVolumes --
*
- * Lists the currently mounted volumes. The chain of functions that have
+ * Lists the currently mounted volumes. The chain of functions that have
* been "inserted" into the filesystem will be called in succession; each
* may return a list of volumes, all of which are added to the result
* until all mounted file systems are listed.
*
* Notice that we assume the lists returned by each filesystem (if non
- * NULL) have been given a refCount for us already. However, we are NOT
+ * NULL) have been given a refCount for us already. However, we are NOT
* allowed to hang on to the list itself (it belongs to the filesystem we
- * called). Therefore we quite naturally add its contents to the result
+ * called). Therefore we quite naturally add its contents to the result
* we are building, and then decrement the refCount.
*
* Results:
@@ -3566,24 +3769,25 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
+Tcl_Obj *
Tcl_FSListVolumes(void)
{
FilesystemRecord *fsRecPtr;
Tcl_Obj *resultPtr = Tcl_NewObj();
/*
- * Call each of the "listVolumes" function in succession. A non-NULL
- * return value indicates the particular function has succeeded. We call
+ * Call each of the "listVolumes" function in succession. A non-NULL
+ * return value indicates the particular function has succeeded. We call
* all the functions registered, since we want a list of all drives from
* all filesystems.
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
- Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
- if (proc != NULL) {
- Tcl_Obj *thisFsVolumes = (*proc)();
+ if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
+ Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
+
if (thisFsVolumes != NULL) {
Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
Tcl_DecrRefCount(thisFsVolumes);
@@ -3591,6 +3795,7 @@ Tcl_FSListVolumes(void)
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3613,10 +3818,10 @@ Tcl_FSListVolumes(void)
*---------------------------------------------------------------------------
*/
-static Tcl_Obj*
-FsListMounts(pathPtr, pattern)
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
+static Tcl_Obj *
+FsListMounts(
+ Tcl_Obj *pathPtr, /* Contains path to directory to search. */
+ const char *pattern) /* Pattern to match against. */
{
FilesystemRecord *fsRecPtr;
Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
@@ -3624,25 +3829,25 @@ FsListMounts(pathPtr, pattern)
/*
* Call each of the "matchInDirectory" functions in succession, with the
- * specific type information 'mountsOnly'. A non-NULL return value
- * indicates the particular function has succeeded. We call all the
+ * specific type information 'mountsOnly'. A non-NULL return value
+ * indicates the particular function has succeeded. We call all the
* functions registered, since we want a list from each filesystems.
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
- if (fsRecPtr != &nativeFilesystemRecord) {
- Tcl_FSMatchInDirectoryProc *proc =
- fsRecPtr->fsPtr->matchInDirectoryProc;
- if (proc != NULL) {
- if (resultPtr == NULL) {
- resultPtr = Tcl_NewObj();
- }
- (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
+ if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
+ fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
+ if (resultPtr == NULL) {
+ resultPtr = Tcl_NewObj();
}
+ fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr,
+ pattern, &mountsOnly);
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3657,7 +3862,7 @@ FsListMounts(pathPtr, pattern)
* an element.
*
* Results:
- * Returns list object with refCount of zero. If the passed in lenPtr is
+ * Returns list object with refCount of zero. If the passed in lenPtr is
* non-NULL, we use it to return the number of elements in the returned
* list.
*
@@ -3667,16 +3872,16 @@ FsListMounts(pathPtr, pattern)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSSplitPath(pathPtr, lenPtr)
- Tcl_Obj *pathPtr; /* Path to split. */
- int *lenPtr; /* int to store number of path elements. */
+Tcl_Obj *
+Tcl_FSSplitPath(
+ Tcl_Obj *pathPtr, /* Path to split. */
+ int *lenPtr) /* int to store number of path elements. */
{
Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */
- Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr;
char separator = '/';
int driveNameLength;
- char *p;
+ const char *p;
/*
* Perform platform specific splitting.
@@ -3696,7 +3901,8 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
*/
if (fsPtr->filesystemSeparatorProc != NULL) {
- Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
+ Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr);
+
if (sep != NULL) {
Tcl_IncrRefCount(sep);
separator = Tcl_GetString(sep)[0];
@@ -3705,7 +3911,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
}
/*
- * Place the drive name as first element of the result list. The drive
+ * Place the drive name as first element of the result list. The drive
* name may contain strange characters, like colons and multiple forward
* slashes (for example 'ftp://' is a valid vfs drive name)
*/
@@ -3721,16 +3927,18 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
*/
for (;;) {
- char *elementStart = p;
+ const char *elementStart = p;
int length;
+
while ((*p != '\0') && (*p != separator)) {
p++;
}
length = p - elementStart;
if (length > 0) {
Tcl_Obj *nextElt;
+
if (elementStart[0] == '~') {
- nextElt = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
@@ -3747,36 +3955,10 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
*/
if (lenPtr != NULL) {
- Tcl_ListObjLength(NULL, result, lenPtr);
+ TclListObjLength(NULL, result, lenPtr);
}
return result;
}
-
-/* Simple helper function */
-Tcl_Obj*
-TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
- 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 (*fromFilesystem->internalToNormalizedProc)(clientData);
- } else {
- return NULL;
- }
-}
-
/*
*----------------------------------------------------------------------
*
@@ -3786,7 +3968,7 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
*
* Results:
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
+ * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
* only if it is non-NULL and the function's return value is
* TCL_PATH_ABSOLUTE.
*
@@ -3797,26 +3979,25 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
*/
Tcl_PathType
-TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
- Tcl_Obj *pathPtr; /* Path to determine type for */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
- * NULL, then set to the filesystem
- * which claims this path. */
- int *driveNameLengthPtr; /* If the path is absolute, and this
- * is non-NULL, then set to the length
- * of the driveName. */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and this
- * is non-NULL, then set to the name
- * of the drive, network-volume which
- * contains the path, already with a
- * refCount for the caller. */
+TclGetPathType(
+ Tcl_Obj *pathPtr, /* Path to determine type for. */
+ const Tcl_Filesystem **filesystemPtrPtr,
+ /* If absolute path and this is not NULL, then
+ * set to the filesystem which claims this
+ * path. */
+ int *driveNameLengthPtr, /* If the path is absolute, and this is
+ * non-NULL, then set to the length of the
+ * driveName. */
+ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is
+ * non-NULL, then set to the name of the
+ * drive, network-volume which contains the
+ * path, already with a refCount for the
+ * caller. */
{
int pathLen;
- char *path;
+ const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
Tcl_PathType type;
- path = Tcl_GetStringFromObj(pathPtr, &pathLen);
-
type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
driveNameLengthPtr, driveNameRef);
@@ -3835,14 +4016,14 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*
* TclFSNonnativePathType --
*
- * Helper function used by TclGetPathType. Its purpose is to check
+ * Helper function used by TclGetPathType. Its purpose is to check
* whether the given path starts with a string which corresponds to a
- * file volume in any registered filesystem except the native one. For
+ * file volume in any registered filesystem except the native one. For
* speed and historical reasons the native filesystem has special
* hard-coded checks dotted here and there in the filesystem code.
*
* Results:
- * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
+ * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
* reference will be set if and only if it is non-NULL and the function's
* return value is TCL_PATH_ABSOLUTE.
*
@@ -3853,21 +4034,21 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*/
Tcl_PathType
-TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
- driveNameRef)
- CONST char *path; /* Path to determine type for */
- int pathLen; /* Length of the path */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
- * NULL, then set to the filesystem
- * which claims this path. */
- int *driveNameLengthPtr; /* If the path is absolute, and this
- * is non-NULL, then set to the length
- * of the driveName. */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and this
- * is non-NULL, then set to the name
- * of the drive, network-volume which
- * contains the path, already with a
- * refCount for the caller. */
+TclFSNonnativePathType(
+ const char *path, /* Path to determine type for. */
+ int pathLen, /* Length of the path. */
+ const Tcl_Filesystem **filesystemPtrPtr,
+ /* If absolute path and this is not NULL, then
+ * set to the filesystem which claims this
+ * path. */
+ int *driveNameLengthPtr, /* If the path is absolute, and this is
+ * non-NULL, then set to the length of the
+ * driveName. */
+ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is
+ * non-NULL, then set to the name of the
+ * drive, network-volume which contains the
+ * path, already with a refCount for the
+ * caller. */
{
FilesystemRecord *fsRecPtr;
Tcl_PathType type = TCL_PATH_RELATIVE;
@@ -3879,39 +4060,39 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
- Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
-
/*
* We want to skip the native filesystem in this loop because
- * otherwise we won't necessarily pass all the Tcl testsuite -- this
- * is because some of the tests artificially change the current
- * platform (between win, unix) but the list of volumes we get by
- * calling (*proc) will reflect the current (real) platform only and
- * this may cause some tests to fail. In particular, on unix '/' will
- * match the beginning of certain absolute Windows paths starting '//'
- * and those tests will go wrong.
+ * otherwise we won't necessarily pass all the Tcl testsuite - this is
+ * because some of the tests artificially change the current platform
+ * (between win, unix) but the list of volumes we get by calling
+ * fsRecPtr->fsPtr->listVolumesProc will reflect the current (real)
+ * platform only and this may cause some tests to fail. In particular,
+ * on Unix '/' will match the beginning of certain absolute Windows
+ * paths starting '//' and those tests will go wrong.
*
* Besides these test-suite issues, there is one other reason to skip
- * the native filesystem --- since the tclFilename.c code has nice
- * fast 'absolute path' checkers, we don't want to waste time
- * repeating that effort here, and this function is actually called
- * quite often, so if we can save the overhead of the native
- * filesystem returning us a list of volumes all the time, it is
- * better.
+ * the native filesystem - since the tclFilename.c code has nice fast
+ * 'absolute path' checkers, we don't want to waste time repeating
+ * that effort here, and this function is actually called quite often,
+ * so if we can save the overhead of the native filesystem returning
+ * us a list of volumes all the time, it is better.
*/
- if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
+ if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
+ && (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
int numVolumes;
- Tcl_Obj *thisFsVolumes = (*proc)();
+ Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
+
if (thisFsVolumes != NULL) {
- if (Tcl_ListObjLength(NULL, thisFsVolumes,
- &numVolumes) != TCL_OK) {
+ if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
+ != TCL_OK) {
/*
- * This is VERY bad; the Tcl_FSListVolumesProc didn't
- * return a valid list. Set numVolumes to -1 so that we
- * skip the while loop below and just return with the
- * current value of 'type'.
+ * This is VERY bad; the listVolumesProc didn't return a
+ * valid list. Set numVolumes to -1 so that we skip the
+ * while loop below and just return with the current value
+ * of 'type'.
*
* It would be better if we could signal an error here
* (but Tcl_Panic seems a bit excessive).
@@ -3922,7 +4103,7 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
while (numVolumes > 0) {
Tcl_Obj *vol;
int len;
- char *strVol;
+ const char *strVol;
numVolumes--;
Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
@@ -3947,13 +4128,17 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
}
Tcl_DecrRefCount(thisFsVolumes);
if (type == TCL_PATH_ABSOLUTE) {
- /* We don't need to examine any more filesystems */
+ /*
+ * We don't need to examine any more filesystems.
+ */
+
break;
}
}
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return type;
}
@@ -3963,7 +4148,7 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
* Tcl_FSRenameFile --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystems rename function. Otherwise we simply return the posix
+ * filesystems rename function. Otherwise we simply return the POSIX
* error 'EXDEV', and -1.
*
* Results:
@@ -3976,22 +4161,21 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
*/
int
-Tcl_FSRenameFile(srcPathPtr, destPathPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of file or dir to be renamed
+Tcl_FSRenameFile(
+ Tcl_Obj *srcPathPtr, /* Pathname of file or dir to be renamed
* (UTF-8). */
- Tcl_Obj *destPathPtr; /* New pathname of file or directory
+ Tcl_Obj *destPathPtr) /* New pathname of file or directory
* (UTF-8). */
{
int retVal = -1;
- Tcl_Filesystem *fsPtr, *fsPtr2;
+ const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
- Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr);
- }
+ if ((fsPtr == fsPtr2) && (fsPtr != NULL)
+ && (fsPtr->renameFileProc != NULL)) {
+ retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -4005,8 +4189,8 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
* Tcl_FSCopyFile --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystem's copy function. Otherwise we simply return the posix
- * error 'EXDEV', and -1.
+ * filesystem's copy function. Otherwise we simply return the POSIX error
+ * 'EXDEV', and -1.
*
* Note that in the native filesystems, 'copyFileProc' is defined to copy
* soft links (i.e. it copies the links themselves, not the things they
@@ -4022,20 +4206,18 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
*/
int
-Tcl_FSCopyFile(srcPathPtr, destPathPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of file to be copied (UTF-8). */
- Tcl_Obj *destPathPtr; /* Pathname of file to copy to (UTF-8). */
+Tcl_FSCopyFile(
+ Tcl_Obj *srcPathPtr, /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *destPathPtr) /* Pathname of file to copy to (UTF-8). */
{
int retVal = -1;
- Tcl_Filesystem *fsPtr, *fsPtr2;
+ const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
- Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr);
- }
+ if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) {
+ retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -4049,7 +4231,7 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
* TclCrossFilesystemCopy --
*
* Helper for above function, and for Tcl_FSLoadFile, to copy files from
- * one filesystem to another. This function will overwrite the target
+ * one filesystem to another. This function will overwrite the target
* file if it already exists.
*
* Results:
@@ -4060,65 +4242,64 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
*
*---------------------------------------------------------------------------
*/
+
int
-TclCrossFilesystemCopy(interp, source, target)
- Tcl_Interp *interp; /* For error messages */
- Tcl_Obj *source; /* Pathname of file to be copied (UTF-8). */
- Tcl_Obj *target; /* Pathname of file to copy to (UTF-8). */
+TclCrossFilesystemCopy(
+ Tcl_Interp *interp, /* For error messages. */
+ Tcl_Obj *source, /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *target) /* Pathname of file to copy to (UTF-8). */
{
int result = TCL_ERROR;
int prot = 0666;
+ Tcl_Channel in, out;
+ Tcl_StatBuf sourceStatBuf;
+ struct utimbuf tval;
- Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
- if (out != NULL) {
+ out = Tcl_FSOpenFileChannel(interp, target, "wb", prot);
+ if (out == NULL) {
/*
- * It looks like we can copy it over.
+ * It looks like we cannot copy it over. Bail out...
*/
+ goto done;
+ }
- Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, "r", prot);
-
- if (in == NULL) {
- /*
- * This is very strange, we checked this above
- */
-
- Tcl_Close(interp, out);
-
- } else {
- Tcl_StatBuf sourceStatBuf;
- struct utimbuf tval;
+ in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
+ if (in == NULL) {
+ /*
+ * This is very strange, caller should have checked this...
+ */
- /*
- * Copy it synchronously. We might wish to add an asynchronous
- * option to support vfs's which are slow (e.g. network sockets).
- */
+ Tcl_Close(interp, out);
+ goto done;
+ }
- Tcl_SetChannelOption(interp, in, "-translation", "binary");
- Tcl_SetChannelOption(interp, out, "-translation", "binary");
+ /*
+ * Copy it synchronously. We might wish to add an asynchronous option to
+ * support vfs's which are slow (e.g. network sockets).
+ */
- if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
- result = TCL_OK;
- }
+ if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
+ result = TCL_OK;
+ }
- /*
- * If the copy failed, assume that copy channel left a good error
- * message.
- */
+ /*
+ * If the copy failed, assume that copy channel left a good error message.
+ */
- Tcl_Close(interp, in);
- Tcl_Close(interp, out);
+ Tcl_Close(interp, in);
+ Tcl_Close(interp, out);
- /*
- * Set modification date of copied file.
- */
+ /*
+ * Set modification date of copied file.
+ */
- if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
- tval.actime = sourceStatBuf.st_atime;
- tval.modtime = sourceStatBuf.st_mtime;
- Tcl_FSUtime(target, &tval);
- }
- }
+ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
+ tval.actime = sourceStatBuf.st_atime;
+ tval.modtime = sourceStatBuf.st_mtime;
+ Tcl_FSUtime(target, &tval);
}
+
+ done:
return result;
}
@@ -4140,15 +4321,13 @@ TclCrossFilesystemCopy(interp, source, target)
*/
int
-Tcl_FSDeleteFile(pathPtr)
- Tcl_Obj *pathPtr; /* Pathname of file to be removed (UTF-8). */
+Tcl_FSDeleteFile(
+ Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
- if (proc != NULL) {
- return (*proc)(pathPtr);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
+ return fsPtr->deleteFileProc(pathPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4172,15 +4351,13 @@ Tcl_FSDeleteFile(pathPtr)
*/
int
-Tcl_FSCreateDirectory(pathPtr)
- Tcl_Obj *pathPtr; /* Pathname of directory to create (UTF-8). */
+Tcl_FSCreateDirectory(
+ Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
- if (proc != NULL) {
- return (*proc)(pathPtr);
- }
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
+ return fsPtr->createDirectoryProc(pathPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4192,8 +4369,8 @@ Tcl_FSCreateDirectory(pathPtr)
* Tcl_FSCopyDirectory --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystems copy-directory function. Otherwise we simply return the
- * posix error 'EXDEV', and -1.
+ * filesystems copy-directory function. Otherwise we simply return the
+ * POSIX error 'EXDEV', and -1.
*
* Results:
* Standard Tcl error code if a function was called.
@@ -4205,24 +4382,22 @@ Tcl_FSCreateDirectory(pathPtr)
*/
int
-Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of directory to be copied
+Tcl_FSCopyDirectory(
+ Tcl_Obj *srcPathPtr, /* Pathname of directory to be copied
* (UTF-8). */
- Tcl_Obj *destPathPtr; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ Tcl_Obj *destPathPtr, /* Pathname of target directory (UTF-8). */
+ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new
* object containing name of file causing
* error, with refCount 1. */
{
int retVal = -1;
- Tcl_Filesystem *fsPtr, *fsPtr2;
+ const Tcl_Filesystem *fsPtr, *fsPtr2;
+
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
- Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
- if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
- }
+ if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){
+ retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
}
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
@@ -4248,56 +4423,57 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
*/
int
-Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
- Tcl_Obj *pathPtr; /* Pathname of directory to be removed
+Tcl_FSRemoveDirectory(
+ Tcl_Obj *pathPtr, /* Pathname of directory to be removed
* (UTF-8). */
- int recursive; /* If non-zero, removes directories that are
- * nonempty. Otherwise, will only remove
- * empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ int recursive, /* If non-zero, removes directories that are
+ * nonempty. Otherwise, will only remove empty
+ * directories. */
+ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new
* object containing name of file causing
* error, with refCount 1. */
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
- Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
- if (recursive) {
- /*
- * We check whether the cwd lies inside this directory and move it
- * if it does.
- */
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
+ if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
- if (cwdPtr != NULL) {
- char *cwdStr, *normPathStr;
- int cwdLen, normLen;
- Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ /*
+ * When working recursively, we check whether the cwd lies inside this
+ * directory and move it if it does.
+ */
- if (normPath != NULL) {
- normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
- cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
- if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
- (size_t) normLen) == 0)) {
- /*
- * The cwd is inside the directory, so we perform a
- * 'cd [file dirname $path]'.
- */
+ if (recursive) {
+ Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
- Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
- TCL_PATH_DIRNAME);
+ if (cwdPtr != NULL) {
+ const char *cwdStr, *normPathStr;
+ int cwdLen, normLen;
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- Tcl_FSChdir(dirPtr);
- Tcl_DecrRefCount(dirPtr);
- }
+ if (normPath != NULL) {
+ normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
+ cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+ if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
+ (size_t) normLen) == 0)) {
+ /*
+ * The cwd is inside the directory, so we perform a 'cd
+ * [file dirname $path]'.
+ */
+
+ Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
+ TCL_PATH_DIRNAME);
+
+ Tcl_FSChdir(dirPtr);
+ Tcl_DecrRefCount(dirPtr);
}
- Tcl_DecrRefCount(cwdPtr);
}
+ Tcl_DecrRefCount(cwdPtr);
}
- return (*proc)(pathPtr, recursive, errorPtr);
}
- Tcl_SetErrno(ENOENT);
- return -1;
+ return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
}
/*
@@ -4306,7 +4482,7 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
* Tcl_FSGetFileSystemForPath --
*
* This function determines which filesystem to use for a particular path
- * object, and returns the filesystem which accepts this file. If no
+ * object, and returns the filesystem which accepts this file. If no
* filesystem will accept this object as a valid file path, then NULL is
* returned.
*
@@ -4319,12 +4495,12 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Filesystem*
-Tcl_FSGetFileSystemForPath(pathPtr)
- Tcl_Obj* pathPtr;
+const Tcl_Filesystem *
+Tcl_FSGetFileSystemForPath(
+ Tcl_Obj *pathPtr)
{
FilesystemRecord *fsRecPtr;
- Tcl_Filesystem* retVal = NULL;
+ const Tcl_Filesystem *retVal = NULL;
if (pathPtr == NULL) {
Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
@@ -4332,7 +4508,7 @@ Tcl_FSGetFileSystemForPath(pathPtr)
}
/*
- * If the object has a refCount of zero, we reject it. This is to avoid
+ * If the object has a refCount of zero, we reject it. This is to avoid
* possible segfaults or nondeterministic memory leaks (i.e. the user
* doesn't know if they should decrement the ref count on return or not).
*/
@@ -4344,43 +4520,49 @@ Tcl_FSGetFileSystemForPath(pathPtr)
/*
* Check if the filesystem has changed in some way since this object's
- * internal representation was calculated. Before doing that, assure we
+ * internal representation was calculated. Before doing that, assure we
* have the most up-to-date copy of the master filesystem. This is
* accomplished by the FsGetFirstFilesystem() call.
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
+ Disclaim();
return NULL;
+ } else if (retVal != NULL) {
+ /* TODO: Can this happen? */
+ Disclaim();
+ return retVal;
}
/*
- * Call each of the "pathInFilesystem" functions in succession. A
+ * Call each of the "pathInFilesystem" functions in succession. A
* non-return value of -1 indicates the particular function has succeeded.
*/
- while ((retVal == NULL) && (fsRecPtr != NULL)) {
- Tcl_FSPathInFilesystemProc *proc =
- fsRecPtr->fsPtr->pathInFilesystemProc;
+ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) {
+ ClientData clientData = NULL;
- if (proc != NULL) {
- ClientData clientData = NULL;
- int ret = (*proc)(pathPtr, &clientData);
- if (ret != -1) {
- /*
- * We assume the type of pathPtr hasn't been changed by the
- * above call to the pathInFilesystemProc.
- */
+ if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) {
+ continue;
+ }
- TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
- retVal = fsRecPtr->fsPtr;
- }
+ if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) {
+ /*
+ * We assume the type of pathPtr hasn't been changed by the above
+ * call to the pathInFilesystemProc.
+ */
+
+ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
+ Disclaim();
+ return fsRecPtr->fsPtr;
}
- fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
- return retVal;
+ return NULL;
}
/*
@@ -4390,17 +4572,17 @@ Tcl_FSGetFileSystemForPath(pathPtr)
*
* This function is for use by the Win/Unix native filesystems, so that
* they can easily retrieve the native (char* or TCHAR*) representation
- * of a path. Other filesystems will probably want to implement similar
- * functions. They basically act as a safety net around
- * Tcl_FSGetInternalRep. Normally your file- system procedures will
- * always be called with path objects already converted to the correct
+ * of a path. Other filesystems will probably want to implement similar
+ * functions. They basically act as a safety net around
+ * Tcl_FSGetInternalRep. Normally your file-system functions will always
+ * be called with path objects already converted to the correct
* filesystem, but if for some reason they are called directly (i.e. by
- * procedures not in this file), then one cannot necessarily guarantee
+ * functions not in this file), then one cannot necessarily guarantee
* that the path object pointer is from the correct filesystem.
*
- * Note: in the future it might be desireable to have separate versions
+ * Note: in the future it might be desirable to have separate versions
* of this function with different signatures, for example
- * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
+ * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
* native paths are all string based, we use just one function.
*
* Results:
@@ -4412,11 +4594,11 @@ Tcl_FSGetFileSystemForPath(pathPtr)
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_FSGetNativePath(pathPtr)
- Tcl_Obj *pathPtr;
+const void *
+Tcl_FSGetNativePath(
+ Tcl_Obj *pathPtr)
{
- return (CONST char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
+ return Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}
/*
@@ -4436,10 +4618,10 @@ Tcl_FSGetNativePath(pathPtr)
*/
static void
-NativeFreeInternalRep(clientData)
- ClientData clientData;
+NativeFreeInternalRep(
+ ClientData clientData)
{
- ckfree((char *) clientData);
+ ckfree(clientData);
}
/*
@@ -4447,9 +4629,9 @@ NativeFreeInternalRep(clientData)
*
* Tcl_FSFileSystemInfo --
*
- * This function returns a list of two elements. The first element is
- * the name of the filesystem (e.g. "native" or "vfs"), and the second is
- * the particular type of the given path within that filesystem.
+ * This function returns a list of two elements. The first element is the
+ * name of the filesystem (e.g. "native" or "vfs"), and the second is the
+ * particular type of the given path within that filesystem.
*
* Results:
* A list of two elements.
@@ -4460,26 +4642,24 @@ NativeFreeInternalRep(clientData)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSFileSystemInfo(pathPtr)
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSFileSystemInfo(
+ Tcl_Obj *pathPtr)
{
Tcl_Obj *resPtr;
- Tcl_FSFilesystemPathTypeProc *proc;
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr == NULL) {
return NULL;
}
- resPtr = Tcl_NewListObj(0,NULL);
-
+ resPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, resPtr,
- Tcl_NewStringObj(fsPtr->typeName,-1));
+ Tcl_NewStringObj(fsPtr->typeName, -1));
+
+ if (fsPtr->filesystemPathTypeProc != NULL) {
+ Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);
- proc = fsPtr->filesystemPathTypeProc;
- if (proc != NULL) {
- Tcl_Obj *typePtr = (*proc)(pathPtr);
if (typePtr != NULL) {
Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
}
@@ -4493,7 +4673,7 @@ Tcl_FSFileSystemInfo(pathPtr)
*
* Tcl_FSPathSeparator --
*
- * This function returns the separator to be used for a given path. The
+ * This function returns the separator to be used for a given path. The
* object returned should have a refCount of zero
*
* Results:
@@ -4507,25 +4687,28 @@ Tcl_FSFileSystemInfo(pathPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSPathSeparator(pathPtr)
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSPathSeparator(
+ Tcl_Obj *pathPtr)
{
- Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ Tcl_Obj *resultObj;
if (fsPtr == NULL) {
return NULL;
}
- if (fsPtr->filesystemSeparatorProc != NULL) {
- return (*fsPtr->filesystemSeparatorProc)(pathPtr);
- } else {
- /*
- * Allow filesystems not to provide a filesystemSeparatorProc if they
- * wish to use the standard forward slash.
- */
- return Tcl_NewStringObj("/", 1);
+ if (fsPtr->filesystemSeparatorProc != NULL) {
+ return fsPtr->filesystemSeparatorProc(pathPtr);
}
+
+ /*
+ * Allow filesystems not to provide a filesystemSeparatorProc if they wish
+ * to use the standard forward slash.
+ */
+
+ TclNewLiteralStringObj(resultObj, "/");
+ return resultObj;
}
/*
@@ -4545,11 +4728,12 @@ Tcl_FSPathSeparator(pathPtr)
*---------------------------------------------------------------------------
*/
-static Tcl_Obj*
-NativeFilesystemSeparator(pathPtr)
- Tcl_Obj* pathPtr;
+static Tcl_Obj *
+NativeFilesystemSeparator(
+ Tcl_Obj *pathPtr)
{
- char *separator = NULL; /* lint */
+ const char *separator = NULL; /* lint */
+
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separator = "/";
@@ -4560,319 +4744,6 @@ NativeFilesystemSeparator(pathPtr)
}
return Tcl_NewStringObj(separator,1);
}
-
-/* Everything from here on is contained in this obsolete ifdef */
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * TclStatInsertProc --
- *
- * Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to 'TclStat(...)'. The passed
- * function should behave exactly like 'TclStat' when called during that
- * time (see 'TclStat(...)' for more information). The function will be
- * added even if it already in the list.
- *
- * Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- * not be allocated.
- *
- * Side effects:
- * Memory allocated and modifies the link list for 'TclStat' functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclStatInsertProc (proc)
- TclStatProc_ *proc;
-{
- int retVal = TCL_ERROR;
-
- if (proc != NULL) {
- StatProc *newStatProcPtr;
-
- newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
-
- if (newStatProcPtr != NULL) {
- newStatProcPtr->proc = proc;
- Tcl_MutexLock(&obsoleteFsHookMutex);
- newStatProcPtr->nextPtr = statProcList;
- statProcList = newStatProcPtr;
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- retVal = TCL_OK;
- }
- }
-
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclStatDeleteProc --
- *
- * Removed the passed function pointer from the list of 'TclStat'
- * functions. Ensures that the built-in stat function is not removvable.
- *
- * Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
- * otherwise.
- *
- * Side effects:
- * Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclStatDeleteProc (proc)
- TclStatProc_ *proc;
-{
- int retVal = TCL_ERROR;
- StatProc *tmpStatProcPtr;
- StatProc *prevStatProcPtr = NULL;
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
- tmpStatProcPtr = statProcList;
-
- /*
- * Traverse the 'statProcList' looking for the particular node whose
- * 'proc' member matches 'proc' and remove that one from the list. Ensure
- * that the "default" node cannot be removed.
- */
-
- while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
- if (tmpStatProcPtr->proc == proc) {
- if (prevStatProcPtr == NULL) {
- statProcList = tmpStatProcPtr->nextPtr;
- } else {
- prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
- }
-
- ckfree((char *)tmpStatProcPtr);
-
- retVal = TCL_OK;
- } else {
- prevStatProcPtr = tmpStatProcPtr;
- tmpStatProcPtr = tmpStatProcPtr->nextPtr;
- }
- }
-
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclAccessInsertProc --
- *
- * Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to 'TclAccess(...)'. The
- * passed function should behave exactly like 'TclAccess' when called
- * during that time (see 'TclAccess(...)' for more information). The
- * function will be added even if it already in the list.
- *
- * Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- * not be allocated.
- *
- * Side effects:
- * Memory allocated and modifies the link list for 'TclAccess' functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclAccessInsertProc(proc)
- TclAccessProc_ *proc;
-{
- int retVal = TCL_ERROR;
-
- if (proc != NULL) {
- AccessProc *newAccessProcPtr;
-
- newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
-
- if (newAccessProcPtr != NULL) {
- newAccessProcPtr->proc = proc;
- Tcl_MutexLock(&obsoleteFsHookMutex);
- newAccessProcPtr->nextPtr = accessProcList;
- accessProcList = newAccessProcPtr;
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- retVal = TCL_OK;
- }
- }
-
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclAccessDeleteProc --
- *
- * Removed the passed function pointer from the list of 'TclAccess'
- * functions. Ensures that the built-in access function is not
- * removvable.
- *
- * Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
- * otherwise.
- *
- * Side effects:
- * Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclAccessDeleteProc(proc)
- TclAccessProc_ *proc;
-{
- int retVal = TCL_ERROR;
- AccessProc *tmpAccessProcPtr;
- AccessProc *prevAccessProcPtr = NULL;
-
- /*
- * Traverse the 'accessProcList' looking for the particular node whose
- * 'proc' member matches 'proc' and remove that one from the list. Ensure
- * that the "default" node cannot be removed.
- */
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
- tmpAccessProcPtr = accessProcList;
- while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
- if (tmpAccessProcPtr->proc == proc) {
- if (prevAccessProcPtr == NULL) {
- accessProcList = tmpAccessProcPtr->nextPtr;
- } else {
- prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
- }
-
- ckfree((char *)tmpAccessProcPtr);
-
- retVal = TCL_OK;
- } else {
- prevAccessProcPtr = tmpAccessProcPtr;
- tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
- }
- }
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclOpenFileChannelInsertProc --
- *
- * Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to
- * 'Tcl_OpenFileChannel(...)'. The passed function should behave exactly
- * like 'Tcl_OpenFileChannel' when called during that time (see
- * 'Tcl_OpenFileChannel(...)' for more information). The function will be
- * added even if it already in the list.
- *
- * Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- * not be allocated.
- *
- * Side effects:
- * Memory allocated and modifies the link list for 'Tcl_OpenFileChannel'
- * functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclOpenFileChannelInsertProc(proc)
- TclOpenFileChannelProc_ *proc;
-{
- int retVal = TCL_ERROR;
-
- if (proc != NULL) {
- OpenFileChannelProc *newOpenFileChannelProcPtr;
-
- newOpenFileChannelProcPtr = (OpenFileChannelProc *)
- ckalloc(sizeof(OpenFileChannelProc));
-
- newOpenFileChannelProcPtr->proc = proc;
- Tcl_MutexLock(&obsoleteFsHookMutex);
- newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
- openFileChannelProcList = newOpenFileChannelProcPtr;
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- retVal = TCL_OK;
- }
-
- return retVal;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclOpenFileChannelDeleteProc --
- *
- * Removed the passed function pointer from the list of
- * 'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
- * channel function is not removable.
- *
- * Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
- * otherwise.
- *
- * Side effects:
- * Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclOpenFileChannelDeleteProc(proc)
- TclOpenFileChannelProc_ *proc;
-{
- int retVal = TCL_ERROR;
- OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
- OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
-
- /*
- * Traverse the 'openFileChannelProcList' looking for the particular node
- * whose 'proc' member matches 'proc' and remove that one from the list.
- */
-
- Tcl_MutexLock(&obsoleteFsHookMutex);
- tmpOpenFileChannelProcPtr = openFileChannelProcList;
- while ((retVal == TCL_ERROR) &&
- (tmpOpenFileChannelProcPtr != NULL)) {
- if (tmpOpenFileChannelProcPtr->proc == proc) {
- if (prevOpenFileChannelProcPtr == NULL) {
- openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
- } else {
- prevOpenFileChannelProcPtr->nextPtr =
- tmpOpenFileChannelProcPtr->nextPtr;
- }
-
- ckfree((char *) tmpOpenFileChannelProcPtr);
-
- retVal = TCL_OK;
- } else {
- prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
- tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
- }
- }
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
- return retVal;
-}
-#endif /* USE_OBSOLETE_FS_HOOKS */
/*
* Local Variables:
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 794f1c9..ce8b9fb 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -3,14 +3,14 @@
*
* This file implements objects of type "index". This object type is used
* to lookup a keyword in a table of valid values and cache the index of
- * the matching entry.
+ * the matching entry. Also provides table-based argv/argc processing.
*
+ * Copyright (c) 1990-1994 The Regents of the University of California.
* Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 2006 Sam Bromley.
*
* 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.26 2005/07/21 16:58:09 dgp Exp $
*/
#include "tclInt.h"
@@ -19,49 +19,62 @@
* Prototypes for functions defined later in this file:
*/
-static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *dupPtr));
-static void FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int GetIndexFromObjList(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,
+ const char *msg, int flags, int *indexPtr);
+static int SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfIndex(Tcl_Obj *objPtr);
+static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void FreeIndex(Tcl_Obj *objPtr);
+static int PrefixAllObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int PrefixLongestObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int PrefixMatchObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void PrintUsage(Tcl_Interp *interp,
+ const Tcl_ArgvInfo *argTable);
/*
* The structure below defines the index Tcl object type by means of functions
* that can be invoked by generic object code.
*/
-static Tcl_ObjType indexType = {
- "index", /* name */
- FreeIndex, /* freeIntRepProc */
- DupIndex, /* dupIntRepProc */
- UpdateStringOfIndex, /* updateStringProc */
- SetIndexFromAny /* setFromAnyProc */
+static const Tcl_ObjType indexType = {
+ "index", /* name */
+ FreeIndex, /* freeIntRepProc */
+ DupIndex, /* dupIntRepProc */
+ UpdateStringOfIndex, /* updateStringProc */
+ SetIndexFromAny /* setFromAnyProc */
};
/*
* The definition of the internal representation of the "index" object; The
- * internalRep.otherValuePtr field of an object of "index" type will be a
+ * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
* pointer to one of these structures.
*
* Keep this structure declaration in sync with tclTestObj.c
*/
typedef struct {
- VOID *tablePtr; /* Pointer to the table of strings */
- int offset; /* Offset between table entries */
- int index; /* Selected index into table. */
+ void *tablePtr; /* Pointer to the table of strings */
+ int offset; /* Offset between table entries */
+ int index; /* Selected index into table. */
} IndexRep;
/*
* The following macros greatly simplify moving through a table...
*/
-#define STRING_AT(table, offset, index) \
- (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
+
+#define STRING_AT(table, offset) \
+ (*((const char *const *)(((char *)(table)) + (offset))))
#define NEXT_ENTRY(table, offset) \
- (&(STRING_AT(table, offset, 1)))
+ (&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
- STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
+ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
/*
*----------------------------------------------------------------------
@@ -73,7 +86,7 @@ typedef struct {
*
* Results:
* If the value of objPtr is identical to or a unique abbreviation for
- * one of the entries in objPtr, then the return value is TCL_OK and the
+ * one of the entries in tablePtr, then the return value is TCL_OK and the
* index of the matching entry is stored at *indexPtr. If there isn't a
* proper match, then TCL_ERROR is returned and an error message is left
* in interp's result (unless interp is NULL). The msg argument is used
@@ -88,17 +101,18 @@ typedef struct {
*----------------------------------------------------------------------
*/
+#undef Tcl_GetIndexFromObj
int
-Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* Object containing the string to lookup. */
- CONST char **tablePtr; /* Array of strings to compare against the
+Tcl_GetIndexFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object containing the string to lookup. */
+ const char *const*tablePtr, /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
- CONST char *msg; /* Identifying word to use in error
+ const char *msg, /* Identifying word to use in error
* messages. */
- int flags; /* 0 or TCL_EXACT */
- int *indexPtr; /* Place to store resulting integer index. */
+ int flags, /* 0 or TCL_EXACT */
+ int *indexPtr) /* Place to store resulting integer index. */
{
/*
@@ -108,15 +122,15 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
*/
if (objPtr->typePtr == &indexType) {
- IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
/*
* Here's hoping we don't get hit by unfortunate packing constraints
* on odd platforms like a Cray PVP...
*/
- if (indexRep->tablePtr == (VOID *)tablePtr &&
- indexRep->offset == sizeof(char *)) {
+ if (indexRep->tablePtr == (void *) tablePtr
+ && indexRep->offset == sizeof(char *)) {
*indexPtr = indexRep->index;
return TCL_OK;
}
@@ -128,6 +142,90 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
/*
*----------------------------------------------------------------------
*
+ * GetIndexFromObjList --
+ *
+ * This procedure looks up an object's value in a table of strings and
+ * returns the index of the matching string, if any.
+ *
+ * Results:
+ * If the value of objPtr is identical to or a unique abbreviation for
+ * one of the entries in tableObjPtr, then the return value is TCL_OK and
+ * the index of the matching entry is stored at *indexPtr. If there isn't
+ * a proper match, then TCL_ERROR is returned and an error message is
+ * left in interp's result (unless interp is NULL). The msg argument is
+ * used in the error message; for example, if msg has the value "option"
+ * then the error message will say something flag 'bad option "foo": must
+ * be ...'
+ *
+ * Side effects:
+ * Removes any internal representation that the object might have. (TODO:
+ * find a way to cache the lookup.)
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+GetIndexFromObjList(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object containing the string to lookup. */
+ Tcl_Obj *tableObjPtr, /* List of strings to compare against the
+ * value of objPtr. */
+ const char *msg, /* Identifying word to use in error
+ * messages. */
+ int flags, /* 0 or TCL_EXACT */
+ int *indexPtr) /* Place to store resulting integer index. */
+{
+
+ int objc, result, t;
+ Tcl_Obj **objv;
+ const char **tablePtr;
+
+ /*
+ * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
+ * of the code there. This is a bit ineffiecient but simpler.
+ */
+
+ result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * Build a string table from the list.
+ */
+
+ 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(tablePtr);
+ *indexPtr = t;
+ return TCL_OK;
+ }
+
+ tablePtr[t] = Tcl_GetString(objv[t]);
+ }
+ tablePtr[objc] = NULL;
+
+ result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
+ sizeof(char *), msg, flags, indexPtr);
+
+ /*
+ * The internal rep must be cleared since tablePtr will go away.
+ */
+
+ TclFreeIntRep(objPtr);
+ ckfree(tablePtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetIndexFromObjStruct --
*
* This function looks up an object's value given a starting string and
@@ -136,13 +234,13 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
*
* Results:
* If the value of objPtr is identical to or a unique abbreviation for
- * one of the entries in objPtr, then the return value is TCL_OK and the
- * index of the matching entry is stored at *indexPtr. If there isn't a
- * proper match, then TCL_ERROR is returned and an error message is left
- * in interp's result (unless interp is NULL). The msg argument is used
- * in the error message; for example, if msg has the value "option" then
- * the error message will say something flag 'bad option "foo": must be
- * ...'
+ * one of the entries in tablePtr, then the return value is TCL_OK and
+ * the index of the matching entry is stored at *indexPtr. If there isn't
+ * a proper match, then TCL_ERROR is returned and an error message is
+ * left in interp's result (unless interp is NULL). The msg argument is
+ * used in the error message; for example, if msg has the value "option"
+ * then the error message will say something like 'bad option "foo": must
+ * be ...'
*
* Side effects:
* The result of the lookup is cached as the internal rep of objPtr, so
@@ -152,34 +250,37 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
*/
int
-Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
- indexPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* Object containing the string to lookup. */
- CONST VOID *tablePtr; /* The first string in the table. The second
+Tcl_GetIndexFromObjStruct(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object containing the string to lookup. */
+ const void *tablePtr, /* The first string in the table. The second
* string will be at this address plus the
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
- int offset; /* The number of bytes between entries */
- CONST char *msg; /* Identifying word to use in error
+ int offset, /* The number of bytes between entries */
+ const char *msg, /* Identifying word to use in error
* messages. */
- int flags; /* 0 or TCL_EXACT */
- int *indexPtr; /* Place to store resulting integer index. */
+ int flags, /* 0 or TCL_EXACT */
+ int *indexPtr) /* Place to store resulting integer index. */
{
- int index, length, i, numAbbrev;
- char *key, *p1;
- CONST char *p2;
- CONST char * CONST *entryPtr;
+ int index, idx, numAbbrev;
+ const char *key, *p1;
+ const char *p2;
+ const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
+ /* Protect against invalid values, like -1 or 0. */
+ if (offset < (int)sizeof(char *)) {
+ offset = (int)sizeof(char *);
+ }
/*
* See if there is a valid cached result from a previous lookup.
*/
if (objPtr->typePtr == &indexType) {
- indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ indexRep = objPtr->internalRep.twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
*indexPtr = indexRep->index;
return TCL_OK;
@@ -187,34 +288,26 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
}
/*
- * Lookup the value of the object in the table. Accept unique
+ * Lookup the value of the object in the table. Accept unique
* abbreviations unless TCL_EXACT is set in flags.
*/
- key = Tcl_GetStringFromObj(objPtr, &length);
+ key = TclGetString(objPtr);
index = -1;
numAbbrev = 0;
/*
- * The key should not be empty, otherwise it's not a match.
- */
-
- if (key[0] == '\0') {
- goto error;
- }
-
- /*
* Scan the table looking for one of:
* - An exact match (always preferred)
* - A single abbreviation (allowed depending on flags)
* - Several abbreviations (never allowed, but overridden by exact match)
*/
- for (entryPtr = tablePtr, i = 0; *entryPtr != NULL;
- entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
+ for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
+ entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == '\0') {
- index = i;
+ index = idx;
goto done;
}
}
@@ -228,7 +321,7 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
*/
numAbbrev++;
- index = i;
+ index = idx;
}
}
@@ -236,7 +329,7 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
* Check if we were instructed to disallow abbreviations.
*/
- if ((flags & TCL_EXACT) || (numAbbrev != 1)) {
+ if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) {
goto error;
}
@@ -248,14 +341,14 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
*/
if (objPtr->typePtr == &indexType) {
- indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ indexRep = objPtr->internalRep.twoPtrValue.ptr1;
} else {
TclFreeIntRep(objPtr);
- indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
- objPtr->typePtr = &indexType;
+ indexRep = ckalloc(sizeof(IndexRep));
+ objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
+ objPtr->typePtr = &indexType;
}
- indexRep->tablePtr = (VOID*) tablePtr;
+ indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
@@ -268,25 +361,35 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
* 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) ? "ambiguous " : "bad ", msg, " \"", key,
- "\": must be ", STRING_AT(tablePtr,offset,0), (char*) NULL);
- for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
- *entryPtr != NULL;
- entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
- if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
- Tcl_AppendStringsToObj(resultPtr,
- (count > 0) ? ", or " : " or ", *entryPtr,
- (char *) NULL);
- } else {
- Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
- (char *) NULL);
+ (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
+ msg, " \"", key, NULL);
+ if (*entryPtr == NULL) {
+ Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
+ } else {
+ Tcl_AppendStringsToObj(resultPtr, "\": must be ",
+ *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 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;
}
@@ -312,13 +415,15 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
*/
static int
-SetIndexFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+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;
}
@@ -340,16 +445,16 @@ SetIndexFromAny(interp, objPtr)
*/
static void
-UpdateStringOfIndex(objPtr)
- Tcl_Obj *objPtr;
+UpdateStringOfIndex(
+ Tcl_Obj *objPtr)
{
- IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
register char *buf;
register unsigned len;
- register CONST char *indexStr = EXPAND_OF(indexRep);
+ 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;
@@ -374,14 +479,15 @@ UpdateStringOfIndex(objPtr)
*/
static void
-DupIndex(srcPtr, dupPtr)
- Tcl_Obj *srcPtr, *dupPtr;
+DupIndex(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
{
- IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
- IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
+ IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
+ dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
dupPtr->typePtr = &indexType;
}
@@ -403,10 +509,323 @@ DupIndex(srcPtr, dupPtr)
*/
static void
-FreeIndex(objPtr)
- Tcl_Obj *objPtr;
+FreeIndex(
+ Tcl_Obj *objPtr)
{
- ckfree((char *) objPtr->internalRep.otherValuePtr);
+ ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitPrefixCmd --
+ *
+ * This procedure creates the "prefix" Tcl command. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitPrefixCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+ static const EnsembleImplMap prefixImplMap[] = {
+ {"all", PrefixAllObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"match", PrefixMatchObjCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+ Tcl_Command prefixCmd;
+
+ prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap);
+ Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
+ "prefix", 0);
+ return prefixCmd;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * PrefixMatchObjCmd --
+ *
+ * This function implements the 'prefix match' Tcl command. Refer to the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PrefixMatchObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int flags = 0, result, index;
+ int dummyLength, i, errorLength;
+ Tcl_Obj *errorPtr = NULL;
+ const char *message = "option";
+ Tcl_Obj *tablePtr, *objPtr, *resultPtr;
+ static const char *const matchOptions[] = {
+ "-error", "-exact", "-message", NULL
+ };
+ enum matchOptions {
+ PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
+ return TCL_ERROR;
+ }
+
+ for (i = 1; i < (objc - 2); i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum matchOptions) index) {
+ case PRFMATCH_EXACT:
+ flags |= TCL_EXACT;
+ break;
+ case PRFMATCH_MESSAGE:
+ 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_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value for -error", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
+ return TCL_ERROR;
+ }
+ i++;
+ result = Tcl_ListObjLength(interp, objv[i], &errorLength);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((errorLength % 2) != 0) {
+ 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];
+ break;
+ }
+ }
+
+ tablePtr = objv[objc - 2];
+ objPtr = objv[objc - 1];
+
+ /*
+ * Check that table is a valid list first, since we want to handle that
+ * error case regardless of level.
+ */
+
+ result = Tcl_ListObjLength(interp, tablePtr, &dummyLength);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags,
+ &index);
+ if (result != TCL_OK) {
+ if (errorPtr != NULL && errorLength == 0) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ } else if (errorPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_IsShared(errorPtr)) {
+ errorPtr = Tcl_DuplicateObj(errorPtr);
+ }
+ Tcl_ListObjAppendElement(interp, errorPtr,
+ Tcl_NewStringObj("-code", 5));
+ Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result));
+
+ return Tcl_SetReturnOptions(interp, errorPtr);
+ }
+
+ result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * PrefixAllObjCmd --
+ *
+ * This function implements the 'prefix all' Tcl command. Refer to the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PrefixAllObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int tableObjc, result, t, length, elemLength;
+ const char *string, *elemString;
+ Tcl_Obj **tableObjv, *resultPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "table string");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ if (result != TCL_OK) {
+ return result;
+ }
+ resultPtr = Tcl_NewListObj(0, NULL);
+ string = Tcl_GetStringFromObj(objv[2], &length);
+
+ for (t = 0; t < tableObjc; t++) {
+ elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+
+ /*
+ * A prefix cannot match if it is longest.
+ */
+
+ if (length <= elemLength) {
+ if (TclpUtfNcmp2(elemString, string, length) == 0) {
+ Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]);
+ }
+ }
+ }
+
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * PrefixLongestObjCmd --
+ *
+ * This function implements the 'prefix longest' Tcl command. Refer to
+ * the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PrefixLongestObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int tableObjc, result, i, t, length, elemLength, resultLength;
+ const char *string, *elemString, *resultString;
+ Tcl_Obj **tableObjv;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "table string");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ if (result != TCL_OK) {
+ return result;
+ }
+ string = Tcl_GetStringFromObj(objv[2], &length);
+
+ resultString = NULL;
+ resultLength = 0;
+
+ for (t = 0; t < tableObjc; t++) {
+ elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+
+ /*
+ * First check if the prefix string matches the element. A prefix
+ * cannot match if it is longest.
+ */
+
+ if ((length > elemLength) ||
+ TclpUtfNcmp2(elemString, string, length) != 0) {
+ continue;
+ }
+
+ if (resultString == NULL) {
+ /*
+ * If this is the first match, the longest common substring this
+ * far is the complete string. The result is part of this string
+ * so we only need to adjust the length later.
+ */
+
+ resultString = elemString;
+ resultLength = elemLength;
+ } else {
+ /*
+ * Longest common substring cannot be longer than shortest string.
+ */
+
+ if (elemLength < resultLength) {
+ resultLength = elemLength;
+ }
+
+ /*
+ * Compare strings.
+ */
+
+ for (i = 0; i < resultLength; i++) {
+ if (resultString[i] != elemString[i]) {
+ /*
+ * Adjust in case we stopped in the middle of a UTF char.
+ */
+
+ resultLength = Tcl_UtfPrev(&resultString[i+1],
+ resultString) - resultString;
+ break;
+ }
+ }
+ }
+ }
+ if (resultLength > 0) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(resultString, resultLength));
+ }
+ return TCL_OK;
}
/*
@@ -449,20 +868,19 @@ FreeIndex(objPtr)
*/
void
-Tcl_WrongNumArgs(interp, objc, objv, message)
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments to print from objv. */
- Tcl_Obj *CONST objv[]; /* Initial argument objects, which should be
+Tcl_WrongNumArgs(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments to print from objv. */
+ Tcl_Obj *const objv[], /* Initial argument objects, which should be
* included in the error message. */
- CONST char *message; /* Error message to print after the leading
+ const char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen, flags;
- register IndexRep *indexRep;
Interp *iPtr = (Interp *) interp;
- char *elementStr;
+ const char *elementStr;
/*
* [incr Tcl] does something fairly horrific when generating error
@@ -489,6 +907,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
+ iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", -1);
} else {
@@ -503,7 +922,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
if (iPtr->ensembleRewrite.sourceObjs != NULL) {
int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
- Tcl_Obj * CONST *origObjv = iPtr->ensembleRewrite.sourceObjs;
+ Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
/*
* We only know how to do rewriting if all the replaced objects are
@@ -532,16 +951,32 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
* Add the element, quoting it if necessary.
*/
- elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ if (origObjv[i]->typePtr == &indexType) {
+ register IndexRep *indexRep =
+ origObjv[i]->internalRep.twoPtrValue.ptr1;
+
+ elementStr = EXPAND_OF(indexRep);
+ elemLen = strlen(elementStr);
+ } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
+ register EnsembleCmdRep *ecrPtr =
+ origObjv[i]->internalRep.twoPtrValue.ptr1;
+
+ elementStr = ecrPtr->fullSubcmdName;
+ elemLen = strlen(elementStr);
+ } else {
+ elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
+ }
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = ckalloc((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);
- ckfree(quotedElementStr);
+ TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
@@ -554,7 +989,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (i<toPrint-1 || objc!=0 || message!=NULL) {
- Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, " ", NULL);
}
}
}
@@ -573,23 +1008,31 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (objv[i]->typePtr == &indexType) {
- indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
- Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
+ register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+
+ Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
+ } else if (objv[i]->typePtr == &tclEnsembleCmdType) {
+ register EnsembleCmdRep *ecrPtr =
+ objv[i]->internalRep.twoPtrValue.ptr1;
+
+ Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
*/
- elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ elementStr = TclGetStringFromObj(objv[i], &elemLen);
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = ckalloc((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);
- ckfree(quotedElementStr);
+ TclStackFree(interp, quotedElementStr);
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
@@ -603,7 +1046,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (i<objc-1 || message!=NULL) {
- Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, " ", NULL);
}
}
@@ -614,15 +1057,433 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (message != NULL) {
- Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, message, NULL);
}
- Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
#undef MAY_QUOTE_WORD
#undef AFTER_FIRST_WORD
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseArgsObjv --
+ *
+ * Process an objv array according to a table of expected command-line
+ * options. See the manual page for more details.
+ *
+ * Results:
+ * The return value is a standard Tcl return value. If an error occurs
+ * then an error message is left in the interp's result. Under normal
+ * conditions, both *objcPtr and *objv are modified to return the
+ * arguments that couldn't be processed here (they didn't match the
+ * option table, or followed an TCL_ARGV_REST argument).
+ *
+ * Side effects:
+ * Variables may be modified, or procedures may be called. It all depends
+ * on the arguments and their entries in argTable. See the user
+ * documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseArgsObjv(
+ Tcl_Interp *interp, /* Place to store error message. */
+ const Tcl_ArgvInfo *argTable,
+ /* Array of option descriptions. */
+ int *objcPtr, /* Number of arguments in objv. Modified to
+ * hold # args left in objv at end. */
+ Tcl_Obj *const *objv, /* Array of arguments to be parsed. */
+ Tcl_Obj ***remObjv) /* Pointer to array of arguments that were not
+ * processed here. Should be NULL if no return
+ * of arguments is desired. */
+{
+ Tcl_Obj **leftovers; /* Array to write back to remObjv on
+ * successful exit. Will include the name of
+ * the command. */
+ int nrem; /* Size of leftovers.*/
+ register const Tcl_ArgvInfo *infoPtr;
+ /* Pointer to the current entry in the table
+ * of argument descriptions. */
+ const Tcl_ArgvInfo *matchPtr;
+ /* Descriptor that matches current argument */
+ Tcl_Obj *curArg; /* Current argument */
+ const char *str = NULL;
+ register char c; /* Second character of current arg (used for
+ * quick check for matching; use 2nd char.
+ * because first char. will almost always be
+ * '-'). */
+ int srcIndex; /* Location from which to read next argument
+ * from objv. */
+ int dstIndex; /* Used to keep track of current arguments
+ * being processed, primarily for error
+ * reporting. */
+ int objc; /* # arguments in objv still to process. */
+ int length; /* Number of characters in current argument */
+
+ if (remObjv != NULL) {
+ /*
+ * 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 = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
+ leftovers[0] = objv[0];
+ } else {
+ nrem = 0;
+ leftovers = NULL;
+ }
+
+ /*
+ * OK, now start processing from the second element (1st argument).
+ */
+
+ srcIndex = dstIndex = 1;
+ objc = *objcPtr-1;
+
+ while (objc > 0) {
+ curArg = objv[srcIndex];
+ srcIndex++;
+ objc--;
+ str = Tcl_GetStringFromObj(curArg, &length);
+ if (length > 0) {
+ c = str[1];
+ } else {
+ c = 0;
+ }
+
+ /*
+ * Loop throught the argument descriptors searching for one with the
+ * matching key string. If found, leave a pointer to it in matchPtr.
+ */
+
+ matchPtr = NULL;
+ infoPtr = argTable;
+ for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) {
+ if (infoPtr->keyStr == NULL) {
+ continue;
+ }
+ if ((infoPtr->keyStr[1] != c)
+ || (strncmp(infoPtr->keyStr, str, length) != 0)) {
+ continue;
+ }
+ if (infoPtr->keyStr[length] == 0) {
+ matchPtr = infoPtr;
+ goto gotMatch;
+ }
+ if (matchPtr != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", str));
+ goto error;
+ }
+ matchPtr = infoPtr;
+ }
+ if (matchPtr == NULL) {
+ /*
+ * Unrecognized argument. Just copy it down, unless the caller
+ * prefers an error to be registered.
+ */
+
+ if (remObjv == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unrecognized argument \"%s\"", str));
+ goto error;
+ }
+
+ dstIndex++; /* This argument is now handled */
+ leftovers[nrem++] = curArg;
+ continue;
+ }
+
+ /*
+ * Take the appropriate action based on the option type
+ */
+
+ gotMatch:
+ infoPtr = matchPtr;
+ switch (infoPtr->type) {
+ case TCL_ARGV_CONSTANT:
+ *((int *) infoPtr->dstPtr) = PTR2INT(infoPtr->srcPtr);
+ break;
+ case TCL_ARGV_INT:
+ if (objc == 0) {
+ goto missingArg;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[srcIndex],
+ (int *) infoPtr->dstPtr) == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer argument for \"%s\" but got \"%s\"",
+ infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
+ goto error;
+ }
+ srcIndex++;
+ objc--;
+ break;
+ case TCL_ARGV_STRING:
+ if (objc == 0) {
+ goto missingArg;
+ }
+ *((const char **) infoPtr->dstPtr) =
+ Tcl_GetString(objv[srcIndex]);
+ srcIndex++;
+ objc--;
+ break;
+ case TCL_ARGV_REST:
+ /*
+ * 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) {
+ goto missingArg;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
+ (double *) infoPtr->dstPtr) == TCL_ERROR) {
+ 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 *)
+ infoPtr->srcPtr;
+ Tcl_Obj *argObj;
+
+ if (objc == 0) {
+ argObj = NULL;
+ } else {
+ argObj = objv[srcIndex];
+ }
+ if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
+ srcIndex++;
+ objc--;
+ }
+ break;
+ }
+ case TCL_ARGV_GENFUNC: {
+ Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
+ infoPtr->srcPtr;
+
+ objc = handlerProc(infoPtr->clientData, interp, objc,
+ &objv[srcIndex], infoPtr->dstPtr);
+ if (objc < 0) {
+ goto error;
+ }
+ break;
+ }
+ case TCL_ARGV_HELP:
+ PrintUsage(interp, argTable);
+ goto error;
+ 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. 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:
+ if (remObjv == NULL) {
+ /*
+ * Nothing to do.
+ */
+
+ return TCL_OK;
+ }
+
+ if (objc > 0) {
+ memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
+ nrem += objc;
+ }
+ leftovers[nrem] = NULL;
+ *objcPtr = nrem++;
+ *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
+ return TCL_OK;
+
+ /*
+ * Make sure to handle freeing any temporary space we've allocated on the
+ * way to an error.
+ */
+
+ missingArg:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" option requires an additional argument", str));
+ error:
+ if (leftovers != NULL) {
+ ckfree(leftovers);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintUsage --
+ *
+ * Generate a help string describing command-line options.
+ *
+ * Results:
+ * The interp's result will be modified to hold a help string describing
+ * all the options in argTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(
+ Tcl_Interp *interp, /* Place information in this interp's result
+ * area. */
+ const Tcl_ArgvInfo *argTable)
+ /* Array of command-specific argument
+ * descriptions. */
+{
+ register const Tcl_ArgvInfo *infoPtr;
+ int width, numSpaces;
+#define NUM_SPACES 20
+ 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
+ * everything line up.
+ */
+
+ width = 4;
+ for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
+ int length;
+
+ if (infoPtr->keyStr == NULL) {
+ continue;
+ }
+ length = strlen(infoPtr->keyStr);
+ if (length > width) {
+ width = length;
+ }
+ }
+
+ /*
+ * Now add the option information, with pretty-printing.
+ */
+
+ 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_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
+ continue;
+ }
+ Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
+ numSpaces = width + 1 - strlen(infoPtr->keyStr);
+ while (numSpaces > 0) {
+ if (numSpaces >= NUM_SPACES) {
+ Tcl_AppendToObj(msg, spaces, NUM_SPACES);
+ } else {
+ Tcl_AppendToObj(msg, spaces, numSpaces);
+ }
+ numSpaces -= NUM_SPACES;
+ }
+ Tcl_AppendToObj(msg, infoPtr->helpStr, -1);
+ switch (infoPtr->type) {
+ case TCL_ARGV_INT:
+ 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));
+ break;
+ case TCL_ARGV_STRING: {
+ char *string = *((char **) infoPtr->dstPtr);
+
+ if (string != NULL) {
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"",
+ string);
+ }
+ break;
+ }
+ default:
+ break;
+ }
+ }
+ Tcl_SetObjResult(interp, msg);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCompletionCodeFromObj --
+ *
+ * Parses Completion code Code
+ *
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetCompletionCodeFromObj(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *value,
+ int *codePtr) /* Argument objects. */
+{
+ static const char *const returnCodes[] = {
+ "ok", "error", "return", "break", "continue", NULL
+ };
+
+ if ((value->typePtr != &indexType)
+ && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
+ return TCL_OK;
+ }
+ 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_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
* c-basic-offset: 4
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 6ca9761..9f7b106 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -8,14 +8,13 @@
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# 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.92 2005/08/05 23:56:28 dkf Exp $
library tcl
-
+
# Define the unsupported generic interfaces.
interface tclInt
@@ -26,732 +25,737 @@ interface tclInt
# be changed between versions to avoid gratuitous incompatibilities.
# Replaced by Tcl_FSAccess in 8.4:
-#declare 0 generic {
-# int TclAccess(CONST char *path, int mode)
+#declare 0 {
+# int TclAccess(const char *path, int mode)
#}
-declare 1 generic {
- int TclAccessDeleteProc(TclAccessProc_ *proc)
-}
-declare 2 generic {
- int TclAccessInsertProc(TclAccessProc_ *proc)
-}
-declare 3 generic {
+#declare 1 {
+# int TclAccessDeleteProc(TclAccessProc_ *proc)
+#}
+#declare 2 {
+# int TclAccessInsertProc(TclAccessProc_ *proc)
+#}
+declare 3 {
void TclAllocateFreeObjects(void)
}
# Replaced by TclpChdir in 8.1:
-# declare 4 generic {
+# declare 4 {
# int TclChdir(Tcl_Interp *interp, char *dirName)
# }
-declare 5 {unix win} {
+declare 5 {
int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
Tcl_Channel errorChan)
}
-declare 6 generic {
+declare 6 {
void TclCleanupCommand(Command *cmdPtr)
}
-declare 7 generic {
- int TclCopyAndCollapse(int count, CONST char *src, char *dst)
+declare 7 {
+ int TclCopyAndCollapse(int count, const char *src, char *dst)
}
-declare 8 generic {
- int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
+declare 8 {
+ int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
# TclCreatePipeline unofficially exported for use by BLT.
-declare 9 {unix win} {
- int TclCreatePipeline(Tcl_Interp *interp, int argc, CONST char **argv,
+declare 9 {
+ int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv,
Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr,
TclFile *errFilePtr)
}
-declare 10 generic {
- int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
- CONST char *procName,
+declare 10 {
+ int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
+ const char *procName,
Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
}
-declare 11 generic {
+declare 11 {
void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
-declare 12 generic {
- void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
+declare 12 {
+ void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
# Removed in 8.5
-#declare 13 generic {
+#declare 13 {
# int TclDoGlob(Tcl_Interp *interp, char *separators,
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
-declare 14 generic {
- void TclDumpMemoryInfo(FILE *outFile)
+declare 14 {
+ int TclDumpMemoryInfo(ClientData clientData, int flags)
}
# Removed in 8.1:
-# declare 15 generic {
+# declare 15 {
# void TclExpandParseValue(ParseValue *pvPtr, int needed)
# }
-declare 16 generic {
+declare 16 {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
# Removed in 8.4
-#declare 17 generic {
-# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+#declare 17 {
+# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
-#declare 18 generic {
+#declare 18 {
# int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
#}
-#declare 19 generic {
+#declare 19 {
# int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
#}
-#declare 20 generic {
+#declare 20 {
# int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
#}
-#declare 21 generic {
+#declare 21 {
# int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
#}
-declare 22 generic {
- int TclFindElement(Tcl_Interp *interp, CONST char *listStr,
- int listLength, CONST char **elementPtr, CONST char **nextPtr,
+declare 22 {
+ int TclFindElement(Tcl_Interp *interp, const char *listStr,
+ int listLength, const char **elementPtr, const char **nextPtr,
int *sizePtr, int *bracePtr)
}
-declare 23 generic {
- Proc *TclFindProc(Interp *iPtr, CONST char *procName)
+declare 23 {
+ Proc *TclFindProc(Interp *iPtr, const char *procName)
}
-# Replaced with macro (see tclInt.h) in Tcl 8.5
-#declare 24 generic {
-# int TclFormatInt(char *buffer, long n)
-#}
-declare 25 generic {
+# 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)
}
# Removed in 8.1:
-# declare 26 generic {
+# declare 26 {
# char *TclGetCwd(Tcl_Interp *interp)
# }
# Removed in 8.5
-#declare 27 generic {
+#declare 27 {
# int TclGetDate(char *p, unsigned long now, long zone,
# unsigned long *timePtr)
#}
-declare 28 generic {
+declare 28 {
Tcl_Channel TclpGetDefaultStdChannel(int type)
}
# Removed in 8.4b2:
-#declare 29 generic {
+#declare 29 {
# Tcl_Obj *TclGetElementOfIndexedArray(Tcl_Interp *interp,
# int localIndex, Tcl_Obj *elemPtr, int flags)
#}
-# Replaced by char *TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1:
-# declare 30 generic {
-# char *TclGetEnv(CONST char *name)
+# Replaced by char *TclGetEnv(const char *name, Tcl_DString *valuePtr) in 8.1:
+# declare 30 {
+# char *TclGetEnv(const char *name)
# }
-declare 31 generic {
- CONST char *TclGetExtension(CONST char *name)
+declare 31 {
+ const char *TclGetExtension(const char *name)
}
-declare 32 generic {
- int TclGetFrame(Tcl_Interp *interp, CONST char *str,
+declare 32 {
+ int TclGetFrame(Tcl_Interp *interp, const char *str,
CallFrame **framePtrPtr)
}
# Removed in Tcl 8.5
-#declare 33 generic {
+#declare 33 {
# TclCmdProcType TclGetInterpProc(void)
#}
-declare 34 generic {
+declare 34 {
int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
int endValue, int *indexPtr)
}
# Removed in 8.4b2:
-#declare 35 generic {
+#declare 35 {
# Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
# int flags)
#}
-declare 36 generic {
- int TclGetLong(Tcl_Interp *interp, CONST char *str, long *longPtr)
-}
-declare 37 generic {
- int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
+# Removed in 8.6a2
+#declare 36 {
+# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
+#}
+declare 37 {
+ int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
}
-declare 38 generic {
- int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName,
+declare 38 {
+ int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
- CONST char **simpleNamePtr)
+ const char **simpleNamePtr)
}
-declare 39 generic {
+declare 39 {
TclObjCmdProcType TclGetObjInterpProc(void)
}
-declare 40 generic {
- int TclGetOpenMode(Tcl_Interp *interp, CONST char *str, int *seekFlagPtr)
+declare 40 {
+ int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
-declare 41 generic {
+declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
-declare 42 generic {
- char *TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
+declare 42 {
+ CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in Tcl 8.5a2
-#declare 43 generic {
+#declare 43 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int flags)
#}
-declare 44 generic {
- int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr)
+declare 44 {
+ int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
}
-declare 45 generic {
+declare 45 {
int TclHideUnsafeCommands(Tcl_Interp *interp)
}
-declare 46 generic {
+declare 46 {
int TclInExit(void)
}
# Removed in 8.4b2:
-#declare 47 generic {
+#declare 47 {
# Tcl_Obj *TclIncrElementOfIndexedArray(Tcl_Interp *interp,
# int localIndex, Tcl_Obj *elemPtr, long incrAmount)
#}
# Removed in 8.4b2:
-#declare 48 generic {
+#declare 48 {
# Tcl_Obj *TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex,
# long incrAmount)
#}
-declare 49 generic {
- Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
-}
-declare 50 generic {
+#declare 49 {
+# Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+# Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
+#}
+declare 50 {
void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
Namespace *nsPtr)
}
-declare 51 generic {
+declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
# Removed in Tcl 8.5a2
-#declare 52 generic {
-# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
+#declare 52 {
+# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
+# int flags)
#}
-declare 53 generic {
+declare 53 {
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
int argc, CONST84 char **argv)
}
-declare 54 generic {
+declare 54 {
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
+ int objc, Tcl_Obj *const objv[])
}
-declare 55 generic {
+declare 55 {
Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
-# declare 56 generic {
+# declare 56 {
# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
# Tcl_PackageInitProc **proc2Ptr)
# }
# Signature changed to take a length in 8.1:
-# declare 57 generic {
+# declare 57 {
# int TclLooksLikeInt(char *p)
# }
-declare 58 generic {
- Var *TclLookupVar(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
- int flags, CONST char *msg, int createPart1, int createPart2,
+declare 58 {
+ Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
+ int flags, const char *msg, int createPart1, int createPart2,
Var **arrayPtrPtr)
}
# Replaced by Tcl_FSMatchInDirectory in 8.4
-#declare 59 generic {
+#declare 59 {
# int TclpMatchFiles(Tcl_Interp *interp, char *separators,
# Tcl_DString *dirPtr, char *pattern, char *tail)
#}
-declare 60 generic {
- int TclNeedSpace(CONST char *start, CONST char *end)
+declare 60 {
+ int TclNeedSpace(const char *start, const char *end)
}
-declare 61 generic {
+declare 61 {
Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
-declare 62 generic {
+declare 62 {
int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
-declare 63 generic {
+declare 63 {
int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
+ int objc, Tcl_Obj *const objv[])
}
-declare 64 generic {
- int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
+declare 64 {
+ int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
}
# Removed in Tcl 8.5a2
-#declare 65 generic {
+#declare 65 {
# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
-# Tcl_Obj *CONST objv[], int flags)
+# Tcl_Obj *const objv[], int flags)
+#}
+#declare 66 {
+# int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
+#}
+#declare 67 {
+# int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
-declare 66 generic {
- int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
-}
-declare 67 generic {
- int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
-}
# Replaced by Tcl_FSAccess in 8.4:
-#declare 68 generic {
-# int TclpAccess(CONST char *path, int mode)
+#declare 68 {
+# int TclpAccess(const char *path, int mode)
#}
-declare 69 generic {
+declare 69 {
char *TclpAlloc(unsigned int size)
}
-#declare 70 generic {
-# int TclpCopyFile(CONST char *source, CONST char *dest)
+#declare 70 {
+# int TclpCopyFile(const char *source, const char *dest)
#}
-#declare 71 generic {
-# int TclpCopyDirectory(CONST char *source, CONST char *dest,
+#declare 71 {
+# int TclpCopyDirectory(const char *source, const char *dest,
# Tcl_DString *errorPtr)
#}
-#declare 72 generic {
-# int TclpCreateDirectory(CONST char *path)
+#declare 72 {
+# int TclpCreateDirectory(const char *path)
#}
-#declare 73 generic {
-# int TclpDeleteFile(CONST char *path)
+#declare 73 {
+# int TclpDeleteFile(const char *path)
#}
-declare 74 generic {
+declare 74 {
void TclpFree(char *ptr)
}
-declare 75 generic {
+declare 75 {
unsigned long TclpGetClicks(void)
}
-declare 76 generic {
+declare 76 {
unsigned long TclpGetSeconds(void)
}
# deprecated
-declare 77 generic {
+declare 77 {
void TclpGetTime(Tcl_Time *time)
}
-
-declare 78 generic {
- 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 generic {
+#declare 79 {
# int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
-#declare 80 generic {
+#declare 80 {
# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
# char *modeString, int permissions)
#}
-declare 81 generic {
+declare 81 {
char *TclpRealloc(char *ptr, unsigned int size)
}
-#declare 82 generic {
-# int TclpRemoveDirectory(CONST char *path, int recursive,
+#declare 82 {
+# int TclpRemoveDirectory(const char *path, int recursive,
# Tcl_DString *errorPtr)
#}
-#declare 83 generic {
-# int TclpRenameFile(CONST char *source, CONST char *dest)
+#declare 83 {
+# int TclpRenameFile(const char *source, const char *dest)
#}
# Removed in 8.1:
-# declare 84 generic {
+# declare 84 {
# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr,
# ParseValue *pvPtr)
# }
-# declare 85 generic {
+# declare 85 {
# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags,
# char **termPtr, ParseValue *pvPtr)
# }
-# declare 86 generic {
+# declare 86 {
# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
# int flags, char **termPtr, ParseValue *pvPtr)
# }
-# declare 87 generic {
+# declare 87 {
# void TclPlatformInit(Tcl_Interp *interp)
# }
-declare 88 generic {
+declare 88 {
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
- CONST char *name1, CONST char *name2, int flags)
+ const char *name1, const char *name2, int flags)
}
-declare 89 generic {
+declare 89 {
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
-# declare 90 generic {
+# declare 90 {
# void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
# }
-declare 91 generic {
+declare 91 {
void TclProcCleanupProc(Proc *procPtr)
}
-declare 92 generic {
+declare 92 {
int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
- Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description,
- CONST char *procName)
+ Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description,
+ const char *procName)
}
-declare 93 generic {
+declare 93 {
void TclProcDeleteProc(ClientData clientData)
}
# Removed in Tcl 8.5:
-#declare 94 generic {
+#declare 94 {
# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
-# int argc, CONST84 char **argv)
+# int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
-#declare 95 generic {
-# int TclpStat(CONST char *path, Tcl_StatBuf *buf)
+#declare 95 {
+# int TclpStat(const char *path, Tcl_StatBuf *buf)
#}
-declare 96 generic {
- int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName)
+declare 96 {
+ int TclRenameCommand(Tcl_Interp *interp, const char *oldName,
+ const char *newName)
}
-declare 97 generic {
+declare 97 {
void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
}
-declare 98 generic {
+declare 98 {
int TclServiceIdle(void)
}
# Removed in 8.4b2:
-#declare 99 generic {
+#declare 99 {
# Tcl_Obj *TclSetElementOfIndexedArray(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags)
#}
# Removed in 8.4b2:
-#declare 100 generic {
+#declare 100 {
# Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
-declare 101 generic {
- char *TclSetPreInitScript(char *string)
+declare 101 {
+ CONST86 char *TclSetPreInitScript(const char *string)
}
-declare 102 generic {
+declare 102 {
void TclSetupEnv(Tcl_Interp *interp)
}
-declare 103 generic {
- int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto,
+declare 103 {
+ int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
-declare 104 {unix win} {
- int TclSockMinimumBuffers(int sock, int size)
+declare 104 {
+ int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
-#declare 105 generic {
-# int TclStat(CONST char *path, Tcl_StatBuf *buf)
+#declare 105 {
+# int TclStat(const char *path, Tcl_StatBuf *buf)
#}
-declare 106 generic {
- int TclStatDeleteProc(TclStatProc_ *proc)
-}
-declare 107 generic {
- int TclStatInsertProc(TclStatProc_ *proc)
-}
-declare 108 generic {
+#declare 106 {
+# int TclStatDeleteProc(TclStatProc_ *proc)
+#}
+#declare 107 {
+# int TclStatInsertProc(TclStatProc_ *proc)
+#}
+declare 108 {
void TclTeardownNamespace(Namespace *nsPtr)
}
-declare 109 generic {
+declare 109 {
int TclUpdateReturnInfo(Interp *iPtr)
}
+declare 110 {
+ int TclSockMinimumBuffers(void *sock, int size)
+}
# Removed in 8.1:
-# declare 110 generic {
+# declare 110 {
# char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr)
# }
# Procedures used in conjunction with Tcl namespaces. They are
# defined here instead of in tcl.decls since they are not stable yet.
-declare 111 generic {
- void Tcl_AddInterpResolvers(Tcl_Interp *interp, CONST char *name,
+declare 111 {
+ void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
-declare 112 generic {
+declare 112 {
int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
-declare 113 generic {
- Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, CONST char *name,
+declare 113 {
+ Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
-declare 114 generic {
+declare 114 {
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
-declare 115 generic {
+declare 115 {
int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern, int resetListFirst)
+ const char *pattern, int resetListFirst)
}
-declare 116 generic {
- Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+declare 116 {
+ Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 117 generic {
- Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, CONST char *name,
+declare 117 {
+ Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 118 generic {
- int Tcl_GetInterpResolvers(Tcl_Interp *interp, CONST char *name,
+declare 118 {
+ int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolverInfo *resInfo)
}
-declare 119 generic {
+declare 119 {
int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
Tcl_ResolverInfo *resInfo)
}
-declare 120 generic {
- Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, CONST char *name,
+declare 120 {
+ Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
-declare 121 generic {
+declare 121 {
int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern)
+ const char *pattern)
}
-declare 122 generic {
+declare 122 {
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 123 generic {
+declare 123 {
void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
-declare 124 generic {
+declare 124 {
Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
}
-declare 125 generic {
+declare 125 {
Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
}
-declare 126 generic {
+declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
-declare 127 generic {
+declare 127 {
int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- CONST char *pattern, int allowOverwrite)
+ const char *pattern, int allowOverwrite)
}
-declare 128 generic {
+declare 128 {
void Tcl_PopCallFrame(Tcl_Interp *interp)
}
-declare 129 generic {
+declare 129 {
int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
Tcl_Namespace *nsPtr, int isProcCallFrame)
-}
-declare 130 generic {
- int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, CONST char *name)
}
-declare 131 generic {
+declare 130 {
+ int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
+}
+declare 131 {
void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
-declare 132 generic {
+declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
-declare 133 generic {
- struct tm *TclpGetDate(CONST time_t *time, int useGMT)
+declare 133 {
+ struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 8.5
-#declare 134 generic {
-# size_t TclpStrftime(char *s, size_t maxsize, CONST char *format,
-# CONST struct tm *t, int useGMT)
+#declare 134 {
+# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
+# const struct tm *t, int useGMT)
#}
-#declare 135 generic {
+#declare 135 {
# int TclpCheckStackSpace(void)
#}
# Added in 8.1:
-#declare 137 generic {
-# int TclpChdir(CONST char *dirName)
+#declare 137 {
+# int TclpChdir(const char *dirName)
#}
-declare 138 generic {
- CONST84_RETURN char *TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
+declare 138 {
+ CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
-#declare 139 generic {
+#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
#}
-declare 140 generic {
- int TclLooksLikeInt(CONST char *bytes, int length)
-}
+#declare 140 {
+# int TclLooksLikeInt(const char *bytes, int length)
+#}
# This is used by TclX, but should otherwise be considered private
-declare 141 generic {
+declare 141 {
CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
-declare 142 generic {
+declare 142 {
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
CompileHookProc *hookProc, ClientData clientData)
}
-declare 143 generic {
+declare 143 {
int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
LiteralEntry **litPtrPtr)
}
-declare 144 generic {
+declare 144 {
void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
int index)
}
-declare 145 generic {
- struct AuxDataType *TclGetAuxDataType(char *typeName)
+declare 145 {
+ const struct AuxDataType *TclGetAuxDataType(const char *typeName)
}
-
-declare 146 generic {
- TclHandle TclHandleCreate(VOID *ptr)
+declare 146 {
+ TclHandle TclHandleCreate(void *ptr)
}
-
-declare 147 generic {
+declare 147 {
void TclHandleFree(TclHandle handle)
}
-
-declare 148 generic {
+declare 148 {
TclHandle TclHandlePreserve(TclHandle handle)
}
-
-declare 149 generic {
+declare 149 {
void TclHandleRelease(TclHandle handle)
}
# Added for Tcl 8.2
-declare 150 generic {
+declare 150 {
int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
-declare 151 generic {
+declare 151 {
void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr,
int *endPtr)
}
-
-declare 152 generic {
+declare 152 {
void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
-declare 153 generic {
+declare 153 {
Tcl_Obj *TclGetLibraryPath(void)
}
# moved to tclTest.c (static) in 8.3.2/8.4a2
-#declare 154 generic {
+#declare 154 {
# int TclTestChannelCmd(ClientData clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
-#declare 155 generic {
+#declare 155 {
# int TclTestChannelEventCmd(ClientData clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
-declare 156 generic {
- void TclRegError(Tcl_Interp *interp, CONST char *msg,
+declare 156 {
+ void TclRegError(Tcl_Interp *interp, const char *msg,
int status)
}
-declare 157 generic {
- Var *TclVarTraceExists(Tcl_Interp *interp, CONST char *varName)
+declare 157 {
+ Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
-declare 158 generic {
- void TclSetStartupScriptFileName(CONST char *filename)
+# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
+declare 158 {
+ void TclSetStartupScriptFileName(const char *filename)
}
-declare 159 generic {
- CONST84_RETURN char *TclGetStartupScriptFileName(void)
+# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
+declare 159 {
+ const char *TclGetStartupScriptFileName(void)
}
-#declare 160 generic {
+#declare 160 {
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
-# Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
+# Tcl_DString *dirPtr, char *pattern, char *tail,
+# GlobTypeData *types)
#}
# new in 8.3.2/8.4a2
-declare 161 generic {
+declare 161 {
int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
Tcl_Obj *cmdObjPtr)
}
-declare 162 generic {
+declare 162 {
void TclChannelEventScriptInvoker(ClientData clientData, int flags)
}
-# ALERT: The result of 'TclGetInstructionTable' is actually an
-# "InstructionDesc*" but we do not want to describe this structure in
+# ALERT: The result of 'TclGetInstructionTable' is actually a
+# "const InstructionDesc*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h". Use a cast to the
# correct type when calling this procedure.
-declare 163 generic {
- void *TclGetInstructionTable(void)
+declare 163 {
+ const void *TclGetInstructionTable(void)
}
# ALERT: The argument of 'TclExpandCodeArray' is actually a
# "CompileEnv*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h".
-declare 164 generic {
+declare 164 {
void TclExpandCodeArray(void *envPtr)
}
# These functions are vfs aware, but are generally only useful internally.
-declare 165 generic {
+declare 165 {
void TclpSetInitialEncodings(void)
}
# New function due to TIP #33
-declare 166 generic {
- int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
+declare 166 {
+ int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
int index, Tcl_Obj *valuePtr)
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
-declare 167 generic {
+# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
+declare 167 {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
-declare 168 generic {
+# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
+declare 168 {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
-declare 169 generic {
- int TclpUtfNcmp2(CONST char *s1, CONST char *s2, unsigned long n)
+declare 169 {
+ int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
-declare 170 generic {
- int TclCheckInterpTraces(Tcl_Interp *interp, CONST char *command,
- int numChars, Command *cmdPtr, int result, int traceFlags,
- int objc, Tcl_Obj *CONST objv[])
+declare 170 {
+ int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
+ int numChars, Command *cmdPtr, int result, int traceFlags,
+ int objc, Tcl_Obj *const objv[])
}
-declare 171 generic {
- int TclCheckExecutionTraces(Tcl_Interp *interp, CONST char *command,
- 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 objc, Tcl_Obj *const objv[])
}
-
-declare 172 generic {
+declare 172 {
int TclInThreadExit(void)
}
# added for 8.4.2
-declare 173 generic {
- int TclUniCharMatch(CONST Tcl_UniChar *string, int strLen,
- CONST Tcl_UniChar *pattern, int ptnLen, int nocase)
+declare 173 {
+ int TclUniCharMatch(const Tcl_UniChar *string, int strLen,
+ const Tcl_UniChar *pattern, int ptnLen, int flags)
}
# added for 8.4.3
-declare 174 generic {
- Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
-}
+#declare 174 {
+# Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+# Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
+#}
# Factoring out of trace code
-declare 175 generic {
+declare 175 {
int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr,
- CONST char *part1, CONST char *part2, int flags, int leaveErrMsg)
+ const char *part1, const char *part2, int flags, int leaveErrMsg)
}
-declare 176 generic {
+declare 176 {
void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
-declare 177 generic {
- void TclVarErrMsg(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
- CONST char *operation, CONST char *reason)
+declare 177 {
+ void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
+ const char *operation, const char *reason)
}
-
-declare 178 generic {
- void Tcl_SetStartupScript(Tcl_Obj *pathPtr, CONST char* encodingName)
+# TIP 338 made these public - now declared in tcl.h too
+declare 178 {
+ void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
-declare 179 generic {
- Tcl_Obj *Tcl_GetStartupScript(CONST char **encodingNamePtr)
+declare 179 {
+ Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
}
# REMOVED
# Allocate lists without copying arrays
-# declare 180 generic {
+# declare 180 {
# Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
# }
-#declare 181 generic {
+#declare 181 {
# Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
-# CONST char *file, int line)
+# const char *file, int line)
#}
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
-declare 182 generic {
- struct tm *TclpLocaltime(CONST time_t *clock)
+declare 182 {
+ struct tm *TclpLocaltime(const time_t *clock)
}
-declare 183 generic {
- struct tm *TclpGmtime(CONST time_t *clock)
+declare 183 {
+ struct tm *TclpGmtime(const time_t *clock)
}
# For the new "Thread Storage" subsystem.
@@ -759,153 +763,256 @@ declare 183 generic {
### REMOVED on grounds it should never have been exposed. All these
### functions are now either static in tclThreadStorage.c or
### MODULE_SCOPE.
-# declare 184 generic {
+# declare 184 {
# void TclThreadStorageLockInit(void)
# }
-# declare 185 generic {
+# declare 185 {
# void TclThreadStorageLock(void)
# }
-# declare 186 generic {
+# declare 186 {
# void TclThreadStorageUnlock(void)
# }
-# declare 187 generic {
+# declare 187 {
# void TclThreadStoragePrint(FILE *outFile, int flags)
# }
-# declare 188 generic {
+# declare 188 {
# Tcl_HashTable *TclThreadStorageGetHashTable(Tcl_ThreadId id)
# }
-# declare 189 generic {
+# declare 189 {
# Tcl_HashTable *TclThreadStorageInit(Tcl_ThreadId id, void *reserved)
# }
-# declare 190 generic {
+# declare 190 {
# void TclThreadStorageDataKeyInit(Tcl_ThreadDataKey *keyPtr)
# }
-# declare 191 generic {
+# declare 191 {
# void *TclThreadStorageDataKeyGet(Tcl_ThreadDataKey *keyPtr)
# }
-# declare 192 generic {
+# declare 192 {
# void TclThreadStorageDataKeySet(Tcl_ThreadDataKey *keyPtr, void *data)
# }
-# declare 193 generic {
+# declare 193 {
# void TclFinalizeThreadStorageThread(Tcl_ThreadId id)
# }
-# declare 194 generic {
+# declare 194 {
# void TclFinalizeThreadStorage(void)
# }
-# declare 195 generic {
+# declare 195 {
# void TclFinalizeThreadStorageData(Tcl_ThreadDataKey *keyPtr)
# }
-# declare 196 generic {
+# declare 196 {
# void TclFinalizeThreadStorageDataKey(Tcl_ThreadDataKey *keyPtr)
# }
#
# Added in tcl8.5a5 for compiler/executor experimentation.
+# Disabled in Tcl 8.5.1; experiments terminated. :/
#
-declare 197 generic {
- int TclCompEvalObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
-}
-
-declare 198 generic {
+#declare 197 {
+# int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+# const CmdFrame *invoker, int word)
+#}
+declare 198 {
int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
CallFrame **framePtrPtr)
}
-#declare 199 generic {
-# int TclMatchIsTrivial(CONST char *pattern)
+#declare 199 {
+# int TclMatchIsTrivial(const char *pattern)
#}
# 200-208 exported for use by the test suite [Bug 1054748]
-declare 200 generic {
- int TclpObjRemoveDirectory (Tcl_Obj *pathPtr, int recursive,
+declare 200 {
+ int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive,
Tcl_Obj **errorPtr)
}
-declare 201 generic {
- int TclpObjCopyDirectory (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
+declare 201 {
+ int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
Tcl_Obj **errorPtr)
}
-declare 202 generic {
- int TclpObjCreateDirectory (Tcl_Obj *pathPtr)
+declare 202 {
+ int TclpObjCreateDirectory(Tcl_Obj *pathPtr)
}
-declare 203 generic {
- int TclpObjDeleteFile (Tcl_Obj *pathPtr)
+declare 203 {
+ int TclpObjDeleteFile(Tcl_Obj *pathPtr)
}
-declare 204 generic {
- int TclpObjCopyFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+declare 204 {
+ int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
-declare 205 generic {
- int TclpObjRenameFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+declare 205 {
+ int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
}
-declare 206 generic {
- int TclpObjStat (Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
+declare 206 {
+ int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
-declare 207 generic {
- int TclpObjAccess (Tcl_Obj *pathPtr, int mode)
+declare 207 {
+ int TclpObjAccess(Tcl_Obj *pathPtr, int mode)
}
-declare 208 generic {
- Tcl_Channel TclpOpenFileChannel (Tcl_Interp *interp,
+declare 208 {
+ Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
Tcl_Obj *pathPtr, int mode, int permissions)
}
-declare 209 generic {
- Tcl_Obj * TclGetEncodingSearchPath(void)
-}
-declare 210 generic {
- int TclSetEncodingSearchPath(Tcl_Obj *searchPath)
-}
-declare 211 generic {
- CONST char * TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
-}
-declare 212 generic {
- void TclpFindExecutable(CONST char *argv0)
+# Made public by TIP 258
+#declare 209 {
+# Tcl_Obj *TclGetEncodingSearchPath(void)
+#}
+#declare 210 {
+# int TclSetEncodingSearchPath(Tcl_Obj *searchPath)
+#}
+#declare 211 {
+# const char *TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
+#}
+declare 212 {
+ void TclpFindExecutable(const char *argv0)
}
-declare 213 generic {
- Tcl_Obj * TclGetObjNameOfExecutable(void)
+declare 213 {
+ Tcl_Obj *TclGetObjNameOfExecutable(void)
}
-declare 214 generic {
+declare 214 {
void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
-declare 215 generic {
- char * TclStackAlloc(Tcl_Interp *interp, int numBytes)
+declare 215 {
+ void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
}
-declare 216 generic {
- void TclStackFree(Tcl_Interp *interp)
+declare 216 {
+ void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
-declare 217 generic {
+declare 217 {
int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
- Tcl_Namespace *namespacePtr, int isProcCallFrame )
+ Tcl_Namespace *namespacePtr, int isProcCallFrame)
}
-declare 218 generic {
+declare 218 {
void TclPopStackFrame(Tcl_Interp *interp)
}
-# Entries in tommath needed only by tcltest
+# for use in tclTest.c
+declare 224 {
+ TclPlatformType *TclGetPlatform(void)
+}
-declare 219 generic {
- int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d)
+#
+declare 225 {
+ Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
+ int keyc, Tcl_Obj *const keyv[], int flags)
}
-declare 220 generic {
- int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *c)
+declare 226 {
+ int TclObjBeingDeleted(Tcl_Obj *objPtr)
}
-declare 221 generic {
- void TclBN_mp_clear(mp_int *a)
+declare 227 {
+ void TclSetNsPath(Namespace *nsPtr, int pathLength,
+ Tcl_Namespace *pathAry[])
}
-declare 222 generic {
- int TclBN_mp_init(mp_int *a)
+# Used to be needed for TclOO-extension; unneeded now that TclOO is in the
+# core and NRE-enabled
+# declare 228 {
+# int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
+# int skip, ProcErrorProc *errorProc)
+# }
+declare 229 {
+ int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
+ const char *myName, int myFlags, int index)
}
-declare 223 generic {
- int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
+declare 230 {
+ Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+ const char *part2, int flags, const char *msg,
+ const int createPart1, const int createPart2, Var **arrayPtrPtr)
}
-# for use in tclTest.c
-declare 224 generic {
- TclPlatformType *TclGetPlatform(void)
+declare 231 {
+ int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tcl_Namespace **nsPtrPtr)
}
-#
-declare 225 generic {
- Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
- int keyc, Tcl_Obj *CONST keyv[], int flags)
+# Bits and pieces of TIP#280's guts
+declare 232 {
+ int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
+ const CmdFrame *invoker, int word)
+}
+declare 233 {
+ void TclGetSrcInfoForPc(CmdFrame *contextPtr)
+}
+
+# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
+declare 234 {
+ Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
+ int *newPtr)
+}
+declare 235 {
+ void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
+}
+
+
+# TIP 337 made this one public
+declare 236 {
+ void TclBackgroundException(Tcl_Interp *interp, int code)
+}
+
+# TIP #285: Script cancellation support.
+declare 237 {
+ int TclResetCancellation(Tcl_Interp *interp, int force)
+}
+
+# NRE functions for "rogue" extensions to exploit NRE; they will need to
+# include NRE.h too.
+declare 238 {
+ int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[])
+}
+declare 239 {
+ int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
+ int skip, ProcErrorProc *errorProc)
+}
+declare 240 {
+ int TclNRRunCallbacks(Tcl_Interp *interp, int result,
+ struct NRE_callback *rootPtr)
+}
+declare 241 {
+ int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
+ const CmdFrame *invoker, int word)
+}
+declare 242 {
+ int TclNREvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags, Command *cmdPtr)
+}
+
+# Tcl_Obj leak detection support.
+declare 243 {
+ void TclDbDumpActiveObjects(FILE *outFile)
+}
+
+# Functions to make things better for itcl
+declare 244 {
+ Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
+}
+declare 245 {
+ Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
+}
+declare 246 {
+ int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
+ int numInserted, Tcl_Obj *const *objv)
+}
+declare 247 {
+ void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
+}
+
+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)
+}
+
+# Allow extensions for optimization
+declare 251 {
+ int TclRegisterLiteral(void *envPtr,
+ char *bytes, int length, int flags)
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
@@ -913,8 +1020,8 @@ declare 225 generic {
interface tclIntPlat
-############################
-# Windows specific internals
+################################
+# Windows specific functions
declare 0 win {
void TclWinConvertError(DWORD errCode)
@@ -923,33 +1030,41 @@ declare 1 win {
void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
- struct servent *TclWinGetServByName(CONST char *nm,
- CONST char *proto)
+ struct servent *TclWinGetServByName(const char *nm,
+ const char *proto)
}
declare 3 win {
int TclWinGetSockOpt(SOCKET s, int level, int optname,
- char FAR *optval, int FAR *optlen)
+ 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(SOCKET s, int level, int optname,
- CONST char FAR *optval, int optlen)
+ 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)
@@ -971,9 +1086,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 {
@@ -982,16 +1101,24 @@ 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)
}
declare 19 win {
- TclFile TclpOpenFile(CONST char *fname, int mode)
+ TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
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)
@@ -999,11 +1126,12 @@ declare 20 win {
# Added in 8.1:
declare 22 win {
- TclFile TclpCreateTempFile(CONST char *contents)
-}
-declare 23 win {
- char *TclpGetTZName(int isdst)
+ TclFile TclpCreateTempFile(const char *contents)
}
+# Removed in 8.6:
+#declare 23 win {
+# char *TclpGetTZName(int isdst)
+#}
declare 24 win {
char *TclWinNoBackslash(char *path)
}
@@ -1027,12 +1155,8 @@ declare 28 win {
void TclWinResetInterfaces(void)
}
-declare 29 win {
- int TclWinCPUID( unsigned int index, unsigned int *regs )
-}
-
-#########################
-# Unix specific internals
+################################
+# Unix specific functions
# Pipe channel functions
@@ -1050,9 +1174,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 {
@@ -1062,7 +1186,7 @@ declare 6 unix {
TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 unix {
- TclFile TclpOpenFile(CONST char *fname, int mode)
+ TclFile TclpOpenFile(const char *fname, int mode)
}
declare 8 unix {
int TclUnixWaitForFile(int fd, int mask, int timeout)
@@ -1071,7 +1195,7 @@ declare 8 unix {
# Added in 8.1:
declare 9 unix {
- TclFile TclpCreateTempFile(CONST char *contents)
+ TclFile TclpCreateTempFile(const char *contents)
}
# Added in 8.4:
@@ -1082,10 +1206,10 @@ declare 10 unix {
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
declare 11 unix {
- struct tm *TclpLocaltime_unix(CONST time_t *clock)
+ struct tm *TclpLocaltime_unix(const time_t *clock)
}
declare 12 unix {
- struct tm *TclpGmtime_unix(CONST time_t *clock)
+ struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 13 unix {
char *TclpInetNtoa(struct in_addr addr)
@@ -1094,22 +1218,45 @@ declare 13 unix {
# Added in 8.5:
declare 14 unix {
- int TclUnixCopyFile (CONST char *src, CONST char *dst,
- CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+ int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
+################################
+# Mac OS X specific functions
+
declare 15 macosx {
int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
-
declare 16 macosx {
int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
-
declare 17 macosx {
- int TclMacOSXCopyFileAttributes(CONST char *src, CONST char *dst,
- CONST Tcl_StatBuf *statBufPtr)
+ int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr)
}
+declare 18 macosx {
+ int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
+ const char *fileName, Tcl_StatBuf *statBufPtr,
+ Tcl_GlobTypeData *types)
+}
+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
+# End:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b810845..7b1f5bf 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -6,42 +6,38 @@
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
- * Copyright (c) 1998-19/99 by Scriptics Corporation.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
+ * Copyright (c) 2008 by Miguel Sofer. 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: tclInt.h,v 1.252 2005/09/14 03:46:50 dgp Exp $
*/
#ifndef _TCLINT
#define _TCLINT
/*
+ * Some numerics configuration options.
+ */
+
+#undef ACCEPT_NAN
+
+/*
* Common include files needed by most of the Tcl source files are included
* here, so that system-dependent personalizations for the include files only
* have to be made in once place. This results in a few extra includes, but
* greater modularity. The order of the three groups of #includes is
- * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_
- * declaration in tcl.h is needed by stdlib.h in some configurations.
+ * important. For example, stdio.h is needed by tcl.h.
*/
-#ifdef HAVE_TCL_CONFIG_H
-#include "tclConfig.h"
-#endif
-#ifndef _TCL
-#include "tcl.h"
-#endif
+#include "tclPort.h"
#include <stdio.h>
#include <ctype.h>
-#ifdef NO_LIMITS_H
-# include "../compat/limits.h"
-#else
-# include <limits.h>
-#endif
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
@@ -59,9 +55,9 @@ typedef int ptrdiff_t;
#endif
/*
- * Ensure WORDS_BIGENDIAN is defined correcly:
+ * Ensure WORDS_BIGENDIAN is defined correctly:
* Needs to happen here in addition to configure to work with fat compiles on
- * Darwin (i.e. ppc and i386 at the same time).
+ * Darwin (where configure runs only once for multiple architectures).
*/
#ifdef HAVE_SYS_TYPES_H
@@ -74,7 +70,7 @@ typedef int ptrdiff_t;
# ifdef BIG_ENDIAN
# if BYTE_ORDER == BIG_ENDIAN
# undef WORDS_BIGENDIAN
-# define WORDS_BIGENDIAN
+# define WORDS_BIGENDIAN 1
# endif
# endif
# ifdef LITTLE_ENDIAN
@@ -98,13 +94,42 @@ typedef int ptrdiff_t;
#endif
/*
+ * Macros used to cast between pointers and integers (e.g. when storing an int
+ * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
+ * to/from pointer from/to integer of different size".
+ */
+
+#if !defined(INT2PTR) && !defined(PTR2INT)
+# if defined(HAVE_INTPTR_T) || defined(intptr_t)
+# define INT2PTR(p) ((void *)(intptr_t)(p))
+# define PTR2INT(p) ((int)(intptr_t)(p))
+# else
+# define INT2PTR(p) ((void *)(p))
+# define PTR2INT(p) ((int)(p))
+# endif
+#endif
+#if !defined(UINT2PTR) && !defined(PTR2UINT)
+# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
+# define UINT2PTR(p) ((void *)(uintptr_t)(p))
+# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+# else
+# define UINT2PTR(p) ((void *)(p))
+# define PTR2UINT(p) ((unsigned int)(p))
+# endif
+#endif
+
+#if defined(_WIN32) && defined(_MSC_VER)
+# define vsnprintf _vsnprintf
+#endif
+
+/*
* The following procedures allow namespaces to be customized to support
* special name resolution rules for commands/variables.
*/
struct Tcl_ResolvedVarInfo;
-typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) (Tcl_Interp* interp,
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc)(Tcl_Interp *interp,
struct Tcl_ResolvedVarInfo *vinfoPtr);
typedef void (Tcl_ResolveVarDeleteProc)(struct Tcl_ResolvedVarInfo *vinfoPtr);
@@ -120,25 +145,27 @@ typedef struct Tcl_ResolvedVarInfo {
Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;
-typedef int (Tcl_ResolveCompiledVarProc) (Tcl_Interp* interp,
- CONST84 char* name, int length, Tcl_Namespace *context,
+typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
+ CONST84 char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr);
-typedef int (Tcl_ResolveVarProc) (Tcl_Interp* interp, CONST84 char* name,
+typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
-typedef int (Tcl_ResolveCmdProc) (Tcl_Interp* interp, CONST84 char* name,
+typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
typedef struct Tcl_ResolverInfo {
- Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name
- * resolution. */
- Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name
- * resolution for variables that
- * can only be handled at runtime. */
+ Tcl_ResolveCmdProc *cmdResProc;
+ /* Procedure handling command name
+ * resolution. */
+ Tcl_ResolveVarProc *varResProc;
+ /* Procedure handling variable name resolution
+ * for variables that can only be handled at
+ * runtime. */
Tcl_ResolveCompiledVarProc *compiledVarResProc;
- /* Procedure handling variable name
- * resolution at compile time. */
+ /* Procedure handling variable name resolution
+ * at compile time. */
} Tcl_ResolverInfo;
/*
@@ -151,6 +178,34 @@ typedef struct Tcl_Ensemble Tcl_Ensemble;
typedef struct NamespacePathEntry NamespacePathEntry;
/*
+ * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
+ * field added at the end: in this way variables can find their namespace
+ * without having to copy a pointer in their struct: they can access it via
+ * their hPtr->tablePtr.
+ */
+
+typedef struct TclVarHashTable {
+ Tcl_HashTable table;
+ struct Namespace *nsPtr;
+} TclVarHashTable;
+
+/*
+ * This is for itcl - it likes to search our varTables directly :(
+ */
+
+#define TclVarHashFindVar(tablePtr, key) \
+ TclVarHashCreateVar((tablePtr), (key), NULL)
+
+/*
+ * Define this to reduce the amount of space that the average namespace
+ * consumes by only allocating the table of child namespaces when necessary.
+ * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which
+ * reach directly into the Namespace structure.
+ */
+
+#undef BREAK_NAMESPACE_COMPAT
+
+/*
* The structure below defines a namespace.
* Note: the first five fields must match exactly the fields in a
* Tcl_Namespace structure (see tcl.h). If you change one, be sure to change
@@ -172,8 +227,15 @@ typedef struct Namespace {
struct Namespace *parentPtr;/* Points to the namespace that contains this
* one. NULL if this is the global
* namespace. */
+#ifndef BREAK_NAMESPACE_COMPAT
Tcl_HashTable childTable; /* Contains any child namespaces. Indexed by
* strings; values have type (Namespace *). */
+#else
+ Tcl_HashTable *childTablePtr;
+ /* Contains any child namespaces. Indexed by
+ * strings; values have type (Namespace *). If
+ * NULL, there are no children. */
+#endif
long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
@@ -194,7 +256,7 @@ typedef struct Namespace {
* ImportedCmdRef structure) to the Command
* structure in the source namespace's command
* table. */
- Tcl_HashTable varTable; /* Contains all the (global) variables
+ TclVarHashTable varTable; /* Contains all the (global) variables
* currently in this namespace. Indexed by
* strings; values have type (Var *). */
char **exportArrayPtr; /* Points to an array of string patterns
@@ -210,9 +272,9 @@ typedef struct Namespace {
* is currently allocated. */
int cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
- * has already cached a Command * pointer;
- * this causes all its cached Command*
- * pointers to be invalidated. */
+ * has already cached a Command* pointer; this
+ * causes all its cached Command* pointers to
+ * be invalidated. */
int resolverEpoch; /* Incremented whenever (a) the name
* resolution rules change for this namespace
* or (b) a newly added command shadows a
@@ -248,6 +310,9 @@ typedef struct Namespace {
Tcl_Ensemble *ensembles; /* List of structures that contain the details
* of the ensembles that are implemented on
* top of this namespace. */
+ Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command
+ * resolution in this namespace fails. TIP
+ * 181. */
int commandPathLength; /* The length of the explicit path. */
NamespacePathEntry *commandPathArray;
/* The explicit path of the namespace as an
@@ -255,6 +320,12 @@ typedef struct Namespace {
NamespacePathEntry *commandPathSourceList;
/* Linked list of path entries that point to
* this namespace. */
+ Tcl_NamespaceDeleteProc *earlyDeleteProc;
+ /* Just like the deleteProc field (and called
+ * with the same clientData) but called at the
+ * start of the deletion process, so there is
+ * a chance for code to do stuff inside the
+ * namespace before deletion completes. */
} Namespace;
/*
@@ -293,15 +364,22 @@ struct NamespacePathEntry {
* unit that refers to the namespace has been freed (i.e., when
* the namespace's refCount is 0), the namespace's storage will
* be freed.
+ * NS_KILLED - 1 means that TclTeardownNamespace has already been called on
+ * this namespace and it should not be called again [Bug 1355942]
+ * NS_SUPPRESS_COMPILATION -
+ * Marks the commands in this namespace for not being compiled,
+ * forcing them to be looked up every time.
*/
#define NS_DYING 0x01
#define NS_DEAD 0x02
+#define NS_KILLED 0x04
+#define NS_SUPPRESS_COMPILATION 0x08
/*
* Flags passed to TclGetNamespaceForQualName:
*
- * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns.
+ * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns.
* TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns.
* TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces.
* TCL_FIND_ONLY_NS - The name sought is a namespace name.
@@ -311,6 +389,114 @@ struct NamespacePathEntry {
#define TCL_FIND_ONLY_NS 0x1000
/*
+ * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
+ * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
+ * referring to the same subcommand, even where one is a duplicate of another.
+ */
+
+typedef struct {
+ Namespace *nsPtr; /* The namespace backing the ensemble which
+ * this is a subcommand of. */
+ int epoch; /* Used to confirm when the data in this
+ * really structure matches up with the
+ * ensemble. */
+ Tcl_Command token; /* Reference to the comamnd for which this
+ * structure is a cache of the resolution. */
+ char *fullSubcmdName; /* The full (local) name of the subcommand,
+ * allocated with ckalloc(). */
+ Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
+ * command that implements this ensemble
+ * subcommand. */
+} EnsembleCmdRep;
+
+/*
+ * The client data for an ensemble command. This consists of the table of
+ * commands that are actually exported by the namespace, and an epoch counter
+ * that, combined with the exportLookupEpoch field of the namespace structure,
+ * defines whether the table contains valid data or will need to be recomputed
+ * next time the ensemble command is called.
+ */
+
+typedef struct EnsembleConfig {
+ Namespace *nsPtr; /* The namspace backing this ensemble up. */
+ Tcl_Command token; /* The token for the command that provides
+ * ensemble support for the namespace, or NULL
+ * if the command has been deleted (or never
+ * existed; the global namespace never has an
+ * ensemble command.) */
+ int epoch; /* The epoch at which this ensemble's table of
+ * exported commands is valid. */
+ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
+ * consistent points, this will have the same
+ * number of entries as there are entries in
+ * the subcommandTable hash. */
+ Tcl_HashTable subcommandTable;
+ /* Hash table of ensemble subcommand names,
+ * which are its keys so this also provides
+ * the storage management for those subcommand
+ * names. The contents of the entry values are
+ * object version the prefix lists to use when
+ * substituting for the command/subcommand to
+ * build the ensemble implementation command.
+ * Has to be stored here as well as in
+ * subcommandDict because that field is NULL
+ * when we are deriving the ensemble from the
+ * namespace exports list. FUTURE WORK: use
+ * object hash table here. */
+ struct EnsembleConfig *next;/* The next ensemble in the linked list of
+ * ensembles associated with a namespace. If
+ * this field points to this ensemble, the
+ * structure has already been unlinked from
+ * all lists, and cannot be found by scanning
+ * the list from the namespace's ensemble
+ * field. */
+ int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX,
+ * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */
+
+ /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
+
+ Tcl_Obj *subcommandDict; /* Dictionary providing mapping from
+ * subcommands to their implementing command
+ * prefixes, or NULL if we are to build the
+ * map automatically from the namespace
+ * exports. */
+ Tcl_Obj *subcmdList; /* List of commands that this ensemble
+ * actually provides, and whose implementation
+ * will be built using the subcommandDict (if
+ * present and defined) and by simple mapping
+ * to the namespace otherwise. If NULL,
+ * indicates that we are using the (dynamic)
+ * list of currently exported commands. */
+ Tcl_Obj *unknownHandler; /* Script prefix used to handle the case when
+ * no match is found (according to the rule
+ * defined by flag bit TCL_ENSEMBLE_PREFIX) or
+ * NULL to use the default error-generating
+ * behaviour. The script execution gets all
+ * the arguments to the ensemble command
+ * (including objv[0]) and will have the
+ * results passed directly back to the caller
+ * (including the error code) unless the code
+ * is TCL_CONTINUE in which case the
+ * subcommand will be reparsed by the ensemble
+ * core, presumably because the ensemble
+ * itself has been updated. */
+ Tcl_Obj *parameterList; /* List of ensemble parameter names. */
+ int numParameters; /* Cached number of parameters. This is either
+ * 0 (if the parameterList field is NULL) or
+ * the length of the list in the parameterList
+ * field. */
+} EnsembleConfig;
+
+/*
+ * Various bits for the EnsembleConfig.flags field.
+ */
+
+#define ENSEMBLE_DEAD 0x1 /* Flag value to say that the ensemble is dead
+ * and on its way out. */
+#define ENSEMBLE_COMPILE 0x4 /* Flag to enable bytecode compilation of an
+ * ensemble. */
+
+/*
*----------------------------------------------------------------
* Data structures related to variables. These are used primarily in tclVar.c
*----------------------------------------------------------------
@@ -397,30 +583,6 @@ typedef struct ActiveVarTrace {
} ActiveVarTrace;
/*
- * The following structure describes an enumerative search in progress on an
- * array variable; this are invoked with options to the "array" command.
- */
-
-typedef struct ArraySearch {
- int id; /* Integer id used to distinguish among
- * multiple concurrent searches for the same
- * array. */
- struct Var *varPtr; /* Pointer to array variable that's being
- * searched. */
- Tcl_HashSearch search; /* Info kept by the hash module about progress
- * through the array. */
- Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
- * be enumerated (it's leftover from the
- * Tcl_FirstHashEntry call or from an "array
- * anymore" command). NULL means must call
- * Tcl_NextHashEntry to get value to
- * return. */
- struct ArraySearch *nextPtr;/* Next in list of all active searches for
- * this variable, or NULL if this is the last
- * one. */
-} ArraySearch;
-
-/*
* The structure below defines a variable, which associates a string name with
* a Tcl_Obj value. These structures are kept in procedure call frames (for
* local variables recognized by the compiler) or in the heap (for global
@@ -430,10 +592,12 @@ typedef struct ArraySearch {
*/
typedef struct Var {
+ int flags; /* Miscellaneous bits of information about
+ * variable. See below for definitions. */
union {
Tcl_Obj *objPtr; /* The variable's object value. Used for
* scalar variables and array elements. */
- Tcl_HashTable *tablePtr;/* For array variables, this points to
+ TclVarHashTable *tablePtr;/* For array variables, this points to
* information about the hash table used to
* implement the associative array. Points to
* ckalloc-ed data. */
@@ -442,48 +606,30 @@ typedef struct Var {
* "upvar", this field points to the
* referenced variable's Var struct. */
} value;
- char *name; /* NULL if the variable is in a hashtable,
- * otherwise points to the variable's name. It
- * is used, e.g., by TclLookupVar and "info
- * locals". The storage for the characters of
- * the name is not owned by the Var and must
- * not be freed when freeing the Var. */
- Namespace *nsPtr; /* Points to the namespace that contains this
- * variable or NULL if the variable is a local
- * variable in a Tcl procedure. */
- Tcl_HashEntry *hPtr; /* If variable is in a hashtable, either the
- * hash table entry that refers to this
- * variable or NULL if the variable has been
- * detached from its hash table (e.g. an array
- * is deleted, but some of its elements are
- * still referred to in upvars). NULL if the
- * variable is not in a hashtable. This is
- * used to delete an variable from its
- * hashtable if it is no longer needed. */
- int refCount; /* Counts number of active uses of this
- * variable, not including its entry in the
- * call frame or the hash table: 1 for each
- * additional variable whose linkPtr points
- * here, 1 for each nested trace active on
- * variable, and 1 if the variable is a
- * namespace variable. This record can't be
- * deleted until refCount becomes 0. */
- VarTrace *tracePtr; /* First in list of all traces set for this
- * variable. */
- ArraySearch *searchPtr; /* First in list of all searches active for
- * this variable, or NULL if none. */
- int flags; /* Miscellaneous bits of information about
- * variable. See below for definitions. */
} Var;
+typedef struct VarInHash {
+ Var var;
+ int refCount; /* Counts number of active uses of this
+ * variable: 1 for the entry in the hash
+ * table, 1 for each additional variable whose
+ * linkPtr points here, 1 for each nested
+ * trace active on variable, and 1 if the
+ * variable is a namespace variable. This
+ * record can't be deleted until refCount
+ * becomes 0. */
+ Tcl_HashEntry entry; /* The hash table entry that refers to this
+ * variable. This is used to find the name of
+ * the variable and to delete it from its
+ * hashtable if it is no longer needed. It
+ * also holds the variable's name. */
+} VarInHash;
+
/*
- * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK) are mutually exclusive and give the "type" of the variable.
- * VAR_UNDEFINED is independent of the variable's type.
+ * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
+ * mutually exclusive and give the "type" of the variable. If none is set,
+ * this is a scalar variable.
*
- * VAR_SCALAR - 1 means this is a scalar variable and not an
- * array or link. The "objPtr" field points to
- * the variable's value, a Tcl object.
* VAR_ARRAY - 1 means this is an array variable rather than
* a scalar variable or link. The "tablePtr"
* field points to the array's hashtable for its
@@ -495,21 +641,17 @@ typedef struct Var {
* through "upvar" and "global" commands, or
* through references to variables in enclosing
* namespaces.
- * VAR_UNDEFINED - 1 means that the variable is in the process of
- * being deleted. An undefined variable logically
- * does not exist and survives only while it has
- * a trace, or if it is a global variable
- * currently being used by some procedure.
+ *
+ * Flags that indicate the type and status of storage; none is set for
+ * compiled local variables (Var structs).
+ *
* VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and
* the Var structure is malloced. 0 if it is a
* local variable that was assigned a slot in a
* procedure frame by the compiler so the Var
* storage is part of the call frame.
- * VAR_TRACE_ACTIVE - 1 means that trace processing is currently
- * underway for a read or write access, so new
- * read or write accesses should not cause trace
- * procedures to be called and the variable can't
- * be deleted.
+ * VAR_DEAD_HASH 1 means that this var's entry in the hashtable
+ * has already been deleted.
* VAR_ARRAY_ELEMENT - 1 means that this variable is an array
* element, so it is not legal for it to be an
* array itself (the VAR_ARRAY flag had better
@@ -523,6 +665,19 @@ typedef struct Var {
* incremented to reflect the "reference" from
* its namespace.
*
+ * Flag values relating to the variable's trace and search status.
+ *
+ * VAR_TRACED_READ
+ * VAR_TRACED_WRITE
+ * VAR_TRACED_UNSET
+ * VAR_TRACED_ARRAY
+ * VAR_TRACE_ACTIVE - 1 means that trace processing is currently
+ * underway for a read or write access, so new
+ * read or write accesses should not cause trace
+ * procedures to be called and the variable can't
+ * be deleted.
+ * VAR_SEARCH_ACTIVE
+ *
* The following additional flags are used with the CompiledLocal type defined
* below:
*
@@ -533,21 +688,49 @@ typedef struct Var {
* name.
* VAR_RESOLVED - 1 if name resolution has been done for this
* variable.
+ * VAR_IS_ARGS 1 if this variable is the last argument and is
+ * named "args".
+ */
+
+/*
+ * FLAGS RENUMBERED: everything breaks already, make things simpler.
+ *
+ * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to
+ * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c
+ *
+ * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
+ * in precompiled scripts keep working.
*/
-#define VAR_SCALAR 0x1
-#define VAR_ARRAY 0x2
-#define VAR_LINK 0x4
-#define VAR_UNDEFINED 0x8
-#define VAR_IN_HASHTABLE 0x10
-#define VAR_TRACE_ACTIVE 0x20
-#define VAR_ARRAY_ELEMENT 0x40
-#define VAR_NAMESPACE_VAR 0x80
+/* Type of value (0 is scalar) */
+#define VAR_ARRAY 0x1
+#define VAR_LINK 0x2
+
+/* Type of storage (0 is compiled local) */
+#define VAR_IN_HASHTABLE 0x4
+#define VAR_DEAD_HASH 0x8
+#define VAR_ARRAY_ELEMENT 0x1000
+#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */
+
+#define VAR_ALL_HASH \
+ (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT)
+
+/* Trace and search state. */
-#define VAR_ARGUMENT 0x100
-#define VAR_TEMPORARY 0x200
-#define VAR_RESOLVED 0x400
-#define VAR_IS_ARGS 0x800
+#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */
+#define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */
+#define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */
+#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */
+#define VAR_TRACE_ACTIVE 0x2000
+#define VAR_SEARCH_ACTIVE 0x4000
+#define VAR_ALL_TRACES \
+ (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
+
+/* Special handling on initialisation (only CompiledLocal). */
+#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_IS_ARGS 0x400
+#define VAR_RESOLVED 0x8000
/*
* Macros to ensure that various flag bits are set properly for variables.
@@ -562,22 +745,22 @@ typedef struct Var {
*/
#define TclSetVarScalar(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+ (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK)
#define TclSetVarArray(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+ (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY
#define TclSetVarLink(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK
#define TclSetVarArrayElement(varPtr) \
(varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
#define TclSetVarUndefined(varPtr) \
- (varPtr)->flags |= VAR_UNDEFINED
+ (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\
+ (varPtr)->value.objPtr = NULL
-#define TclClearVarUndefined(varPtr) \
- (varPtr)->flags &= ~VAR_UNDEFINED
+#define TclClearVarUndefined(varPtr)
#define TclSetVarTraceActive(varPtr) \
(varPtr)->flags |= VAR_TRACE_ACTIVE
@@ -586,10 +769,20 @@ typedef struct Var {
(varPtr)->flags &= ~VAR_TRACE_ACTIVE
#define TclSetVarNamespaceVar(varPtr) \
- (varPtr)->flags |= VAR_NAMESPACE_VAR
+ if (!TclIsVarNamespaceVar(varPtr)) {\
+ (varPtr)->flags |= VAR_NAMESPACE_VAR;\
+ if (TclIsVarInHash(varPtr)) {\
+ ((VarInHash *)(varPtr))->refCount++;\
+ }\
+ }
#define TclClearVarNamespaceVar(varPtr) \
- (varPtr)->flags &= ~VAR_NAMESPACE_VAR
+ if (TclIsVarNamespaceVar(varPtr)) {\
+ (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
+ if (TclIsVarInHash(varPtr)) {\
+ ((VarInHash *)(varPtr))->refCount--;\
+ }\
+ }
/*
* Macros to read various flag bits of variables.
@@ -606,7 +799,7 @@ typedef struct Var {
*/
#define TclIsVarScalar(varPtr) \
- ((varPtr)->flags & VAR_SCALAR)
+ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
#define TclIsVarLink(varPtr) \
((varPtr)->flags & VAR_LINK)
@@ -615,7 +808,7 @@ typedef struct Var {
((varPtr)->flags & VAR_ARRAY)
#define TclIsVarUndefined(varPtr) \
- ((varPtr)->flags & VAR_UNDEFINED)
+ ((varPtr)->value.objPtr == NULL)
#define TclIsVarArrayElement(varPtr) \
((varPtr)->flags & VAR_ARRAY_ELEMENT)
@@ -635,24 +828,52 @@ typedef struct Var {
#define TclIsVarTraceActive(varPtr) \
((varPtr)->flags & VAR_TRACE_ACTIVE)
-#define TclIsVarUntraced(varPtr) \
- ((varPtr)->tracePtr == NULL)
+#define TclIsVarTraced(varPtr) \
+ ((varPtr)->flags & VAR_ALL_TRACES)
+
+#define TclIsVarInHash(varPtr) \
+ ((varPtr)->flags & VAR_IN_HASHTABLE)
+
+#define TclIsVarDeadHash(varPtr) \
+ ((varPtr)->flags & VAR_DEAD_HASH)
+
+#define TclGetVarNsPtr(varPtr) \
+ (TclIsVarInHash(varPtr) \
+ ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
+ : NULL)
+
+#define VarHashRefCount(varPtr) \
+ ((VarInHash *) (varPtr))->refCount
/*
- * Macros for direct variable access by TEBC
+ * Macros for direct variable access by TEBC.
*/
#define TclIsVarDirectReadable(varPtr) \
- (TclIsVarScalar(varPtr) \
- && !TclIsVarUndefined(varPtr) \
- && TclIsVarUntraced(varPtr))
+ ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
+ && (varPtr)->value.objPtr)
#define TclIsVarDirectWritable(varPtr) \
- ( !(((varPtr)->flags & VAR_IN_HASHTABLE) \
- && ((varPtr)->hPtr == NULL)) \
- && TclIsVarUntraced(varPtr) \
- && (TclIsVarScalar(varPtr) \
- || TclIsVarUndefined(varPtr)))
+ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))
+
+#define TclIsVarDirectUnsettable(varPtr) \
+ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH))
+
+#define TclIsVarDirectModifyable(varPtr) \
+ ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
+ && (varPtr)->value.objPtr)
+
+#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
+ (TclIsVarDirectReadable(varPtr) &&\
+ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
+
+#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
+ (TclIsVarDirectWritable(varPtr) &&\
+ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))
+
+#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \
+ (TclIsVarDirectModifyable(varPtr) &&\
+ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
/*
*----------------------------------------------------------------
@@ -693,9 +914,8 @@ typedef struct CompiledLocal {
* variables in the procedure call frame. */
int flags; /* Flag bits for the local variable. Same as
* the flags for the Var structure above,
- * although only VAR_SCALAR, VAR_ARRAY,
- * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and
- * VAR_RESOLVED make sense. */
+ * although only VAR_ARGUMENT, VAR_TEMPORARY,
+ * and VAR_RESOLVED make sense. */
Tcl_Obj *defValuePtr; /* Pointer to the default value of an
* argument, if any. NULL if not an argument
* or, if an argument, no default value. */
@@ -706,7 +926,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
@@ -749,6 +969,13 @@ typedef struct Proc {
} Proc;
/*
+ * The type of functions called to process errors found during the execution
+ * of a procedure (or lambda term or ...).
+ */
+
+typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
+
+/*
* The structure below defines a command trace. This is used to allow Tcl
* clients to find out whenever a command is about to be executed.
*/
@@ -760,9 +987,9 @@ typedef struct Trace {
ClientData clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
int flags; /* Flags governing the trace - see
- * Tcl_CreateObjTrace for details */
- Tcl_CmdObjTraceDeleteProc* delProc;
- /* Procedure to call when trace is deleted */
+ * Tcl_CreateObjTrace for details. */
+ Tcl_CmdObjTraceDeleteProc *delProc;
+ /* Procedure to call when trace is deleted. */
} Trace;
/*
@@ -795,8 +1022,8 @@ typedef struct ActiveInterpTrace {
* TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces.
* - passed to Tcl_CreateObjTrace to set up
* "leavestep" traces.
- *
*/
+
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
@@ -826,6 +1053,23 @@ typedef struct AssocData {
* Tcl_CallFrame structure in tcl.h. If you change one, change the other.
*/
+/*
+ * Will be grown to contain: pointers to the varnames (allocated at the end),
+ * plus the init values for each variable (suitable to be memcopied on init)
+ */
+
+typedef struct LocalCache {
+ int refCount;
+ int numVars;
+ Tcl_Obj *varName0;
+} LocalCache;
+
+#define localName(framePtr, i) \
+ ((&((framePtr)->localCachePtr->varName0))[(i)])
+
+MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp,
+ LocalCache *localCachePtr);
+
typedef struct CallFrame {
Namespace *nsPtr; /* Points to the namespace used to resolve
* commands and global variables. */
@@ -838,7 +1082,7 @@ typedef struct CallFrame {
* have local vars. */
int objc; /* This and objv below describe the arguments
* for this procedure call. */
- Tcl_Obj *CONST *objv; /* Array of argument objects. */
+ Tcl_Obj *const *objv; /* Array of argument objects. */
struct CallFrame *callerPtr;
/* Value of interp->framePtr when this
* procedure was invoked (i.e. next higher in
@@ -859,19 +1103,216 @@ typedef struct CallFrame {
* the number of compiled local variables
* (local variables assigned entries ["slots"]
* in the compiledLocals array below). */
- Tcl_HashTable *varTablePtr; /* Hash table containing local variables not
+ TclVarHashTable *varTablePtr;
+ /* Hash table containing local variables not
* recognized by the compiler, or created at
* execution time through, e.g., upvar.
* Initially NULL and created if needed. */
int numCompiledLocals; /* Count of local variables recognized by the
* compiler including arguments. */
- Var* compiledLocals; /* Points to the array of local variables
+ Var *compiledLocals; /* Points to the array of local variables
* recognized by the compiler. The compiler
* emits code that refers to these variables
* using an index into this array. */
+ ClientData clientData; /* Pointer to some context that is used by
+ * object systems. The meaning of the contents
+ * of this field is defined by the code that
+ * sets it, and it should only ever be set by
+ * the code that is pushing the frame. In that
+ * case, the code that sets it should also
+ * have some means of discovering what the
+ * meaning of the value is, which we do not
+ * specify. */
+ LocalCache *localCachePtr;
+ Tcl_Obj *tailcallPtr;
+ /* NULL if no tailcall is scheduled */
} CallFrame;
-#define FRAME_IS_PROC 0x1
+#define FRAME_IS_PROC 0x1
+#define FRAME_IS_LAMBDA 0x2
+#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's
+ * clientData field contains a CallContext
+ * reference. Part of TIP#257. */
+#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. Part of
+ * TIP#257. */
+
+/*
+ * TIP #280
+ * The structure below defines a command frame. A command frame provides
+ * location information for all commands executing a tcl script (source, eval,
+ * uplevel, procedure bodies, ...). The runtime structure essentially contains
+ * the stack trace as it would be if the currently executing command were to
+ * throw an error.
+ *
+ * For commands where it makes sense it refers to the associated CallFrame as
+ * well.
+ *
+ * The structures are chained in a single list, with the top of the stack
+ * anchored in the Interp structure.
+ *
+ * Instances can be allocated on the C stack, or the heap, the former making
+ * cleanup a bit simpler.
+ */
+
+typedef struct CmdFrame {
+ /*
+ * General data. Always available.
+ */
+
+ int type; /* Values see below. */
+ int level; /* Number of frames in stack, prevent O(n)
+ * scan of list. */
+ int *line; /* Lines the words of the command start on. */
+ int nline;
+ CallFrame *framePtr; /* Procedure activation record, may be
+ * NULL. */
+ struct CmdFrame *nextPtr; /* Link to calling frame. */
+ /*
+ * Data needed for Eval vs TEBC
+ *
+ * EXECUTION CONTEXTS and usage of CmdFrame
+ *
+ * Field TEBC EvalEx
+ * ======= ==== ======
+ * level yes yes
+ * type BC/PREBC SRC/EVAL
+ * line0 yes yes
+ * framePtr yes yes
+ * ======= ==== ======
+ *
+ * ======= ==== ========= union data
+ * line1 - yes
+ * line3 - yes
+ * path - yes
+ * ------- ---- ------
+ * codePtr yes -
+ * pc yes -
+ * ======= ==== ======
+ *
+ * ======= ==== ========= union cmd
+ * str.cmd yes yes
+ * str.len yes yes
+ * ------- ---- ------
+ */
+
+ union {
+ struct {
+ Tcl_Obj *path; /* Path of the sourced file the command is
+ * in. */
+ } eval;
+ struct {
+ const void *codePtr;/* Byte code currently executed... */
+ const char *pc; /* ... and instruction pointer. */
+ } tebc;
+ } data;
+ Tcl_Obj *cmdObj;
+ const char *cmd; /* The executed command, if possible... */
+ int len; /* ... and its length. */
+ const struct CFWordBC *litarg;
+ /* Link to set of literal arguments which have
+ * ben pushed on the lineLABCPtr stack by
+ * TclArgumentBCEnter(). These will be removed
+ * by TclArgumentBCRelease. */
+} CmdFrame;
+
+typedef struct CFWord {
+ CmdFrame *framePtr; /* CmdFrame to access. */
+ int word; /* Index of the word in the command. */
+ int refCount; /* Number of times the word is on the
+ * stack. */
+} CFWord;
+
+typedef struct CFWordBC {
+ CmdFrame *framePtr; /* CmdFrame to access. */
+ int pc; /* Instruction pointer of a command in
+ * ExtCmdLoc.loc[.] */
+ int word; /* Index of word in
+ * ExtCmdLoc.loc[cmd]->line[.] */
+ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */
+ struct CFWordBC *nextPtr; /* Next entry for same command call. See
+ * CmdFrame litarg field for the list start. */
+ Tcl_Obj *obj; /* Back reference to hashtable key */
+} CFWordBC;
+
+/*
+ * Structure to record the locations of invisible continuation lines in
+ * literal scripts, as character offset from the beginning of the script. Both
+ * compiler and direct evaluator use this information to adjust their line
+ * counters when tracking through the script, because when it is invoked the
+ * continuation line marker as a whole has been removed already, meaning that
+ * the \n which was part of it is gone as well, breaking regular line
+ * tracking.
+ *
+ * These structures are allocated and filled by both the function
+ * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
+ * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
+ * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
+ * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
+ * released by the function TclFreeObj(), in the file "tclObj.c", and also by
+ * the function TclThreadFinalizeObjects(), in the same file.
+ */
+
+#define CLL_END (-1)
+
+typedef struct ContLineLoc {
+ int num; /* Number of entries in loc, not counting the
+ * final -1 marker entry. */
+ int loc[1]; /* Table of locations, as character offsets.
+ * The table is allocated as part of the
+ * structure, extending behind the nominal end
+ * of the structure. An entry containing the
+ * value -1 is put after the last location, as
+ * end-marker/sentinel. */
+} ContLineLoc;
+
+/*
+ * The following macros define the allowed values for the type field of the
+ * CmdFrame structure above. Some of the values occur only in the extended
+ * location data referenced via the 'baseLocPtr'.
+ *
+ * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx.
+ * TCL_LOCATION_BC : Frame is for bytecode.
+ * TCL_LOCATION_PREBC : Frame is for precompiled bytecode.
+ * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a
+ * sourced file.
+ * TCL_LOCATION_PROC : Frame is for bytecode of a procedure.
+ *
+ * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
+ * types, per the context of the byte code in execution.
+ */
+
+#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */
+#define TCL_LOCATION_BC (2) /* Location in byte code. */
+#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
+ * location. */
+#define TCL_LOCATION_SOURCE (4) /* Location in a file. */
+#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */
+#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */
+
+/*
+ * Structure passed to describe procedure-like "procedures" that are not
+ * procedures (e.g. a lambda) so that their details can be reported correctly
+ * by [info frame]. Contains a sub-structure for each extra field.
+ */
+
+typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData);
+typedef struct {
+ const char *name; /* Name of this field. */
+ GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the
+ * clientData, or just use the clientData
+ * directly (after casting) if NULL. */
+ ClientData clientData; /* Context for above function, or Tcl_Obj* if
+ * proc field is NULL. */
+} ExtraFrameInfoField;
+typedef struct {
+ int length; /* Length of array. */
+ ExtraFrameInfoField fields[2];
+ /* Really as long as necessary, but this is
+ * long enough for nearly anything. */
+} ExtraFrameInfo;
/*
*----------------------------------------------------------------
@@ -881,37 +1322,17 @@ typedef struct CallFrame {
*----------------------------------------------------------------
*/
-typedef VOID **TclHandle;
+typedef void **TclHandle;
/*
*----------------------------------------------------------------
- * Data structures related to expressions. These are used only in tclExpr.c.
+ * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use
+ * only by Expect. It will probably go away in a later release.
*----------------------------------------------------------------
*/
-/*
- * The data structure below defines a math function (e.g. sin or hypot) for
- * use in Tcl expressions.
- */
-
-#define MAX_MATH_ARGS 5
-typedef struct MathFunc {
- int builtinFuncIndex; /* If this is a builtin math function, its
- * index in the array of builtin functions.
- * (tclCompilation.h lists these indices.)
- * The value is -1 if this is a new function
- * defined by Tcl_CreateMathFunc. The value is
- * also -1 if a builtin function is replaced
- * by a Tcl_CreateMathFunc call. */
- int numArgs; /* Number of arguments for function. */
- Tcl_ValueType argTypes[MAX_MATH_ARGS];
- /* Acceptable types for each argument. */
- Tcl_MathProc *proc; /* Procedure that implements this function.
- * NULL if isBuiltinFunc is 1. */
- ClientData clientData; /* Additional argument to pass to the function
- * when invoking it. NULL if isBuiltinFunc is
- * 1. */
-} MathFunc;
+#define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at
+ * the beginning of the string. */
/*
* These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet
@@ -919,9 +1340,9 @@ typedef struct MathFunc {
* really internal and Tcl clients should use Tcl_GetThreadData.
*/
-MODULE_SCOPE VOID * TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
+MODULE_SCOPE void * TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
- VOID *data);
+ void *data);
/*
* This is a convenience macro used to initialize a thread local storage ptr.
@@ -930,7 +1351,6 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
#define TCL_TSD_INIT(keyPtr) \
(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
-
/*
*----------------------------------------------------------------
* Data structures related to bytecode compilation and execution. These are
@@ -968,35 +1388,80 @@ struct CompileEnv;
#define TCL_OUT_LINE_COMPILE TCL_ERROR
-typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr,
- struct CompileEnv *compEnvPtr);
+typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
+ struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
/*
* The type of procedure called from the compilation hook point in
* SetByteCodeFromAny.
*/
-typedef int (CompileHookProc) (Tcl_Interp *interp,
+typedef int (CompileHookProc)(Tcl_Interp *interp,
struct CompileEnv *compEnvPtr, ClientData clientData);
/*
+ * The data structure for a (linked list of) execution stacks.
+ */
+
+typedef struct ExecStack {
+ struct ExecStack *prevPtr;
+ struct ExecStack *nextPtr;
+ Tcl_Obj **markerPtr;
+ Tcl_Obj **endPtr;
+ Tcl_Obj **tosPtr;
+ Tcl_Obj *stackWords[1];
+} ExecStack;
+
+/*
* The data structure defining the execution environment for ByteCode's.
* There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
* stack that holds command operands and results. The stack grows towards
- * increasing addresses. The "stackTop" member is cached by TclExecuteByteCode
- * in a local variable: it must be set before calling TclExecuteByteCode and
- * will be restored by TclExecuteByteCode before it returns.
+ * increasing addresses. The member stackPtr points to the stackItems of the
+ * currently active execution stack.
*/
+typedef struct CorContext {
+ struct CallFrame *framePtr;
+ struct CallFrame *varFramePtr;
+ struct CmdFrame *cmdFramePtr; /* See Interp.cmdFramePtr */
+ Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */
+} CorContext;
+
+typedef struct CoroutineData {
+ struct Command *cmdPtr; /* The command handle for the coroutine. */
+ struct ExecEnv *eePtr; /* The special execution environment (stacks,
+ * etc.) for the coroutine. */
+ struct ExecEnv *callerEEPtr;/* The execution environment for the caller of
+ * the coroutine, which might be the
+ * interpreter global environment or another
+ * coroutine. */
+ CorContext caller;
+ CorContext running;
+ Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */
+ void *stackLevel;
+ int auxNumLevels; /* While the coroutine is running the
+ * numLevels of the create/resume command is
+ * stored here; for suspended coroutines it
+ * holds the nesting numLevels at yield. */
+ int nargs; /* Number of args required for resuming this
+ * coroutine; -2 means "0 or 1" (default), -1
+ * means "any" */
+} CoroutineData;
+
typedef struct ExecEnv {
- Tcl_Obj **stackPtr; /* Points to the first item in the evaluation
+ ExecStack *execStackPtr; /* Points to the first item in the evaluation
* stack on the heap. */
- Tcl_Obj **tosPtr; /* Points to current top of stack;
- * (stackPtr-1) when the stack is empty. */
- Tcl_Obj **endPtr; /* Points to last usable item in stack. */
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
+ struct Tcl_Interp *interp;
+ struct NRE_callback *callbackPtr;
+ /* Top callback in NRE's stack. */
+ struct CoroutineData *corPtr;
+ int rewind;
} ExecEnv;
+#define COR_IS_SUSPENDED(corPtr) \
+ ((corPtr)->stackLevel == NULL)
+
/*
* The definitions for the LiteralTable and LiteralEntry structures. Each
* interpreter contains a LiteralTable. It is used to reduce the storage
@@ -1085,6 +1550,22 @@ typedef struct ByteCodeStats {
#endif /* TCL_COMPILE_STATS */
/*
+ * Structure used in implementation of those core ensembles which are
+ * partially compiled. Used as an array of these, with a terminating field
+ * whose 'name' is NULL.
+ */
+
+typedef struct {
+ const char *name; /* The name of the subcommand. */
+ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
+ 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;
+
+/*
*----------------------------------------------------------------
* Data structures related to commands.
*----------------------------------------------------------------
@@ -1174,6 +1655,7 @@ typedef struct Command {
* command. */
CommandTrace *tracePtr; /* First in list of all traces set for this
* command. */
+ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */
} Command;
/*
@@ -1190,6 +1672,9 @@ typedef struct Command {
* CMD_HAS_EXEC_TRACES - 1 means that this command has at least one
* execution trace (as opposed to simple
* delete/rename traces) in its tracePtr list.
+ * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that
+ * can handle expansion (provided it is not the
+ * first word).
* TCL_TRACE_RENAME - A rename trace is in progress. Further
* recursive renames will not be traced.
* TCL_TRACE_DELETE - A delete trace is in progress. Further
@@ -1197,9 +1682,11 @@ typedef struct Command {
* (these last two flags are defined in tcl.h)
*/
-#define CMD_IS_DELETED 0x1
-#define CMD_TRACE_ACTIVE 0x2
-#define CMD_HAS_EXEC_TRACES 0x4
+#define CMD_IS_DELETED 0x1
+#define CMD_TRACE_ACTIVE 0x2
+#define CMD_HAS_EXEC_TRACES 0x4
+#define CMD_COMPILES_EXPANDED 0x8
+#define CMD_REDEF_IN_PROGRESS 0x10
/*
*----------------------------------------------------------------
@@ -1239,6 +1726,33 @@ typedef struct ResolverScheme {
typedef struct LimitHandler LimitHandler;
/*
+ * TIP #268.
+ * Values for the selection mode, i.e the package require preferences.
+ */
+
+enum PkgPreferOptions {
+ PKG_PREFER_LATEST, PKG_PREFER_STABLE
+};
+
+/*
+ *----------------------------------------------------------------
+ * This structure shadows the first few fields of the memory cache for the
+ * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
+ * definition there.
+ * Some macros require knowledge of some fields in the struct in order to
+ * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
+ * to the relevant fields is kept in the objCache field in struct Interp.
+ *----------------------------------------------------------------
+ */
+
+typedef struct AllocCache {
+ struct Cache *nextPtr; /* Linked list of cache entries. */
+ Tcl_ThreadId owner; /* Which thread's cache is this? */
+ Tcl_Obj *firstObjPtr; /* List of free objects for thread. */
+ int numObjects; /* Number of objects for thread. */
+} AllocCache;
+
+/*
*----------------------------------------------------------------
* This structure defines an interpreter, which is a collection of commands
* plus other state information related to interpreting commands, such as
@@ -1277,7 +1791,8 @@ typedef struct Interp {
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number in the command where the error
* occurred (1 means first line). */
- struct TclStubs *stubTable; /* Pointer to the exported Tcl stub table. On
+ const struct TclStubs *stubTable;
+ /* Pointer to the exported Tcl stub table. On
* previous versions of Tcl this is a pointer
* to the objResultPtr or a pointer to a
* buckets array in a hash table. We therefore
@@ -1295,10 +1810,14 @@ typedef struct Interp {
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
- Tcl_HashTable mathFuncTable;/* Contains all the math functions currently
- * defined for the interpreter. Indexed by
- * strings (function names); values have type
- * (MathFunc *). */
+ union {
+ void (*optimizer)(void *envPtr);
+ Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
+ * unused space in interp was repurposed for
+ * pluggable bytecode optimizers. The core
+ * contains one optimizer, which can be
+ * selectively overriden by extensions. */
+ } extra;
/*
* Information related to procedures and variables. See tclProc.c and
@@ -1314,19 +1833,19 @@ typedef struct Interp {
* assumes that infinite recursion has
* occurred and it generates an error. */
CallFrame *framePtr; /* Points to top-most in stack of all nested
- * procedure invocations. NULL means there are
- * no active procedures. */
+ * procedure invocations. */
CallFrame *varFramePtr; /* Points to the call frame whose variables
* are currently in use (same as framePtr
- * unless an "uplevel" command is executing).
- * NULL means no procedure is active or
- * "uplevel 0" is executing. */
+ * unless an "uplevel" command is
+ * executing). */
ActiveVarTrace *activeVarTracePtr;
/* First in list of active traces for interp,
* or NULL if no active traces. */
- int returnCode; /* [return -code] parameter */
- char *unused3; /* No longer used (was errorInfo) */
- char *unused4; /* No longer used (was errorCode) */
+ int returnCode; /* [return -code] parameter. */
+ CallFrame *rootFramePtr; /* Global frame pointer for this
+ * interpreter. */
+ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
+ * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
/*
* Information used by Tcl_AppendResult to keep track of partial results.
@@ -1353,7 +1872,6 @@ typedef struct Interp {
* commands for packages that aren't described
* in packageTable. Ckalloc'ed, may be
* NULL. */
-
/*
* Miscellaneous information:
*/
@@ -1407,7 +1925,7 @@ typedef struct Interp {
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
- Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */
+ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */
ActiveCommandTrace *activeCmdTracePtr;
/* First in list of active command traces for
@@ -1416,19 +1934,22 @@ typedef struct Interp {
/* First in list of active traces for interp,
* or NULL if no active traces. */
- int tracesForbiddingInline; /* Count of traces (in the list headed by
+ int tracesForbiddingInline; /* Count of traces (in the list headed by
* tracePtr) that forbid inline bytecode
- * compilation */
+ * compilation. */
+
+ /*
+ * Fields used to manage extensible return options (TIP 90).
+ */
- /* Fields used to manage extensible return options (TIP 90) */
Tcl_Obj *returnOpts; /* A dictionary holding the options to the
- * last [return] command */
+ * last [return] command. */
- Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj) */
- Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable */
- Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj) */
- Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable */
- int returnLevel; /* [return -level] parameter */
+ Tcl_Obj *errorInfo; /* errorInfo value (now as a Tcl_Obj). */
+ Tcl_Obj *eiVar; /* cached ref to ::errorInfo variable. */
+ Tcl_Obj *errorCode; /* errorCode value (now as a Tcl_Obj). */
+ Tcl_Obj *ecVar; /* cached ref to ::errorInfo variable. */
+ int returnLevel; /* [return -level] parameter. */
/*
* Resource limiting framework support (TIP#143).
@@ -1474,7 +1995,7 @@ typedef struct Interp {
*/
struct {
- Tcl_Obj * CONST *sourceObjs;
+ Tcl_Obj *const *sourceObjs;
/* What arguments were actually input into the
* *root* ensemble command? (Nested ensembles
* don't rewrite this.) NULL if we're not
@@ -1486,36 +2007,169 @@ typedef struct Interp {
} ensembleRewrite;
/*
- * TIP #219 ... Global info for the I/O system ...
+ * TIP #219: Global info for the I/O system.
*/
- Tcl_Obj* chanMsg; /* Error message set by channel drivers, for
+ Tcl_Obj *chanMsg; /* Error message set by channel drivers, for
* the propagation of arbitrary Tcl errors.
* This information, if present (chanMsg not
- * NULL), takes precedence over a posix error
+ * NULL), takes precedence over a POSIX error
* code returned by a channel operation. */
/*
- * Statistical information about the bytecode compiler and interpreter's
- * operation.
+ * Source code origin information (TIP #280).
+ */
+
+ CmdFrame *cmdFramePtr; /* Points to the command frame containing the
+ * location information for the current
+ * command. */
+ const CmdFrame *invokeCmdFramePtr;
+ /* Points to the command frame which is the
+ * invoking context of the bytecode compiler.
+ * NULL when the byte code compiler is not
+ * active. */
+ int invokeWord; /* Index of the word in the command which
+ * is getting compiled. */
+ Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
+ * defined procedure the location information
+ * for its body. It is keyed by the address of
+ * the Proc structure for a procedure. The
+ * values are "struct CmdFrame*". */
+ Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode
+ * object the location information for its
+ * body. It is keyed by the address of the
+ * Proc structure for a procedure. The values
+ * are "struct ExtCmdLoc*". (See
+ * tclCompile.h) */
+ Tcl_HashTable *lineLABCPtr;
+ Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a
+ * command on the execution stack the index of
+ * the argument in the command, and the
+ * location data of the command. It is keyed
+ * by the address of the Tcl_Obj containing
+ * the argument. The values are "struct
+ * CFWord*" (See tclBasic.c). This allows
+ * commands like uplevel, eval, etc. to find
+ * location information for their arguments,
+ * if they are a proper literal argument to an
+ * invoking command. Alt view: An index to the
+ * CmdFrame stack keyed by command argument
+ * holders. */
+ ContLineLoc *scriptCLLocPtr;/* This table points to the location data for
+ * invisible continuation lines in the script,
+ * if any. This pointer is set by the function
+ * TclEvalObjEx() in file "tclBasic.c", and
+ * used by function ...() in the same file.
+ * It does for the eval/direct path of script
+ * execution what CompileEnv.clLoc does for
+ * the bytecode compiler.
+ */
+ /*
+ * TIP #268. The currently active selection mode, i.e. the package require
+ * preferences.
+ */
+
+ int packagePrefer; /* Current package selection mode. */
+
+ /*
+ * Hashtables for variable traces and searches.
+ */
+
+ Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's
+ * active trace list; varPtr is the key. */
+ Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's
+ * active searches list; varPtr is the key. */
+ /*
+ * The thread-specific data ekeko: cache pointers or values that
+ * (a) do not change during the thread's lifetime
+ * (b) require access to TSD to determine at runtime
+ * (c) are accessed very often (e.g., at each command call)
+ *
+ * Note that these are the same for all interps in the same thread. They
+ * just have to be initialised for the thread's master interp, slaves
+ * inherit the value.
+ *
+ * They are used by the macros defined below.
+ */
+
+ AllocCache *allocCache;
+ void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData
+ * structs for this interp's thread; see
+ * tclObj.c and tclThreadAlloc.c */
+ int *asyncReadyPtr; /* Pointer to the asyncReady indicator for
+ * this interp's thread; see tclAsync.c */
+ /*
+ * The pointer to the object system root ekeko. c.f. TIP #257.
+ */
+ void *objectFoundation; /* Pointer to the Foundation structure of the
+ * object system, which contains things like
+ * references to key namespaces. See
+ * tclOOInt.h and tclOO.c for real definition
+ * and setup. */
+
+ 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
+ * called - i.e., they should be run *before*
+ * any tailcall is invoked. */
+
+ /*
+ * TIP #285, Script cancellation support.
*/
+ Tcl_AsyncHandler asyncCancel;
+ /* Async handler token for Tcl_CancelEval. */
+ Tcl_Obj *asyncCancelMsg; /* Error message set by async cancel handler
+ * for the propagation of arbitrary Tcl
+ * errors. This information, if present
+ * (asyncCancelMsg not NULL), takes precedence
+ * over the default error messages returned by
+ * a script cancellation operation. */
+
+ /*
+ * TIP #348 IMPLEMENTATION - Substituted error stack
+ */
+ 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
+ /*
+ * Statistical information about the bytecode compiler and interpreter's
+ * operation. This should be the last field of Interp.
+ */
+
ByteCodeStats stats; /* Holds compilation and execution statistics
* for this interpreter. */
#endif /* TCL_COMPILE_STATS */
} Interp;
/*
- * General list of interpreters. Doubly linked for easier removal of items
- * deep in the list.
+ * Macros that use the TSD-ekeko.
+ */
+
+#define TclAsyncReady(iPtr) \
+ *((iPtr)->asyncReadyPtr)
+
+/*
+ * Macros for script cancellation support (TIP #285).
*/
-typedef struct InterpList {
- Interp* interpPtr;
- struct InterpList* prevPtr;
- struct InterpList* nextPtr;
-} InterpList;
+#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))
/*
* Macros for splicing into and out of doubly linked lists. They assume
@@ -1552,7 +2206,10 @@ typedef struct InterpList {
* other than these should be turned into errors.
*/
-#define TCL_ALLOW_EXCEPTIONS 4
+#define TCL_ALLOW_EXCEPTIONS 0x04
+#define TCL_EVAL_FILE 0x02
+#define TCL_EVAL_SOURCE_IN_FRAME 0x10
+#define TCL_EVAL_NORESOLVE 0x20
/*
* Flag bits for Interp structures:
@@ -1575,6 +2232,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.
@@ -1582,19 +2242,32 @@ typedef struct InterpList {
* of the wrong-num-args string in Tcl_WrongNumArgs.
* Makes it append instead of replacing and uses
* different intermediate text.
+ * CANCELED: Non-zero means that the script in progress should be
+ * canceled as soon as possible. This can be checked by
+ * extensions (and the core itself) by calling
+ * Tcl_Canceled and checking if TCL_ERROR is returned.
+ * This is a one-shot flag that is reset immediately upon
+ * being detected; however, if the TCL_CANCEL_UNWIND flag
+ * is set Tcl_Canceled will continue to report that the
+ * script in progress has been canceled thereby allowing
+ * the evaluation stack for the interp to be fully
+ * unwound.
*
* WARNING: For the sake of some extensions that have made use of former
* internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS)
* or 8 (formerly ERROR_CODE_SET).
*/
-#define DELETED 1
-#define ERR_ALREADY_LOGGED 4
-#define DONT_COMPILE_CMDS_INLINE 0x20
-#define RAND_SEED_INITIALIZED 0x40
-#define SAFE_INTERP 0x80
-#define INTERP_TRACE_IN_PROGRESS 0x200
-#define INTERP_ALTERNATE_WRONG_ARGS 0x400
+#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
+#define INTERP_TRACE_IN_PROGRESS 0x200
+#define INTERP_ALTERNATE_WRONG_ARGS 0x400
+#define ERR_LEGACY_COPY 0x800
+#define CANCELED 0x1000
/*
* Maximum number of levels of nesting permitted in Tcl commands (used to
@@ -1604,34 +2277,6 @@ typedef struct InterpList {
#define MAX_NESTING_DEPTH 1000
/*
- * TIP#143 limit handler internal representation.
- */
-
-struct LimitHandler {
- int flags; /* The state of this particular handler. */
- Tcl_LimitHandlerProc *handlerProc;
- /* The handler callback. */
- ClientData clientData; /* Opaque argument to the handler callback. */
- Tcl_LimitHandlerDeleteProc *deleteProc;
- /* How to delete the clientData */
- LimitHandler *prevPtr; /* Previous item in linked list of handlers */
- LimitHandler *nextPtr; /* Next item in linked list of handlers */
-};
-
-/*
- * Values for the LimitHandler flags field.
- * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
- * processed; handlers are never to be entered reentrantly.
- * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
- * should not normally be observed because when a handler is
- * deleted it is also spliced out of the list of handlers, but
- * even so we will be careful.
- */
-
-#define LIMIT_HANDLER_ACTIVE 0x01
-#define LIMIT_HANDLER_DELETED 0x02
-
-/*
* The macro below is used to modify a "char" value (e.g. by casting it to an
* unsigned character) so that it can be used safely with macros such as
* isspace.
@@ -1640,6 +2285,17 @@ struct LimitHandler {
#define UCHAR(c) ((unsigned char) (c))
/*
+ * This macro is used to properly align the memory allocated by Tcl, giving
+ * the same alignment as the native malloc.
+ */
+
+#if defined(__APPLE__)
+#define TCL_ALLOCALIGN 16
+#else
+#define TCL_ALLOCALIGN (2*sizeof(void *))
+#endif
+
+/*
* This macro is used to determine the offset needed to safely allocate any
* data structure in memory. Given a starting offset or size, it "rounds up"
* or "aligns" the offset to the next 8-byte boundary so that any data
@@ -1657,7 +2313,6 @@ struct LimitHandler {
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
-
/*
* The following enum values are used to specify the runtime platform setting
* of the tclPlatform variable.
@@ -1671,7 +2326,7 @@ typedef enum {
/*
* The following enum values are used to indicate the translation of a Tcl
* channel. Declared here so that each platform can define
- * TCL_PLATFORM_TRANSLATION to the native translation on that platform
+ * TCL_PLATFORM_TRANSLATION to the native translation on that platform.
*/
typedef enum TclEolTranslation {
@@ -1720,18 +2375,82 @@ 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 - do NOT forget to verify
- * that it is of list type before using!
+ * Macro used to get the elements of a list object.
*/
-#define TclListObjGetElements(listPtr, objc, objv) \
- { \
- List *listRepPtr = \
- (List *) (listPtr)->internalRep.twoPtrValue.ptr1;\
- (objc) = listRepPtr->elemCount;\
- (objv) = &listRepPtr->elements;\
- }
+#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)
+
+#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)\
+ : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)))
+
+#define TclListObjLength(interp, listPtr, lenPtr) \
+ (((listPtr)->typePtr == &tclListType) \
+ ? ((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.
+ *
+ * WARNING: these macros eval their args more than once.
+ */
+
+#define TclGetLongFromObj(interp, objPtr, longPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
+
+#if (LONG_MAX == INT_MAX)
+#define TclGetIntFromObj(interp, objPtr, intPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
+#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
+#else
+#define TclGetIntFromObj(interp, objPtr, intPtr) \
+ Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
+#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \
+ TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
+#endif
/*
* Flag values for TclTraceDictPath().
@@ -1774,7 +2493,9 @@ typedef struct List {
*/
#define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2)
-typedef ClientData (TclFSGetCwdProc2) (ClientData clientData);
+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
@@ -1784,9 +2505,9 @@ typedef ClientData (TclFSGetCwdProc2) (ClientData clientData);
* tclFCmd.c.
*/
-typedef int (TclGetFileAttrProc) (Tcl_Interp *interp, int objIndex,
+typedef int (TclGetFileAttrProc)(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr);
-typedef int (TclSetFileAttrProc) (Tcl_Interp *interp, int objIndex,
+typedef int (TclSetFileAttrProc)(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj *attrObjPtr);
typedef struct TclFileAttrProcs {
@@ -1824,10 +2545,10 @@ typedef enum Tcl_PathPart {
*----------------------------------------------------------------
*/
-typedef int (TclStatProc_) (CONST char *path, struct stat *buf);
-typedef int (TclAccessProc_) (CONST char *path, int mode);
-typedef Tcl_Channel (TclOpenFileChannelProc_) (Tcl_Interp *interp,
- CONST char *fileName, CONST char *modeString, int permissions);
+typedef int (TclStatProc_)(const char *path, struct stat *buf);
+typedef int (TclAccessProc_)(const char *path, int mode);
+typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
+ const char *fileName, const char *modeString, int permissions);
/*
*----------------------------------------------------------------
@@ -1844,7 +2565,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
-typedef void (TclInitProcessGlobalValueProc) (char **valuePtr, int *lengthPtr,
+typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -1873,53 +2594,94 @@ typedef struct ProcessGlobalValue {
} ProcessGlobalValue;
/*
+ *----------------------------------------------------------------------
+ * Flags for TclParseNumber
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_PARSE_DECIMAL_ONLY 1
+ /* Leading zero doesn't denote octal or
+ * hex. */
+#define TCL_PARSE_OCTAL_ONLY 2
+ /* Parse octal even without prefix. */
+#define TCL_PARSE_HEXADECIMAL_ONLY 4
+ /* Parse hexadecimal even without prefix. */
+#define TCL_PARSE_INTEGER_ONLY 8
+ /* Disable floating point parsing. */
+#define TCL_PARSE_SCAN_PREFIXES 16
+ /* Use [scan] rules dealing with 0?
+ * prefixes. */
+#define TCL_PARSE_NO_WHITESPACE 32
+ /* Reject leading/trailing whitespace. */
+#define TCL_PARSE_BINARY_ONLY 64
+ /* Parse binary even without prefix. */
+
+/*
+ *----------------------------------------------------------------------
+ * Type values TclGetNumberFromObj
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_NUMBER_LONG 1
+#define TCL_NUMBER_WIDE 2
+#define TCL_NUMBER_BIG 3
+#define TCL_NUMBER_DOUBLE 4
+#define TCL_NUMBER_NAN 5
+
+/*
*----------------------------------------------------------------
* Variables shared among Tcl modules but not used by the outside world.
*----------------------------------------------------------------
*/
-MODULE_SCOPE char * tclNativeExecutableName;
-MODULE_SCOPE int tclFindExecutableSearchDone;
-MODULE_SCOPE char * tclMemDumpFileName;
+MODULE_SCOPE char *tclNativeExecutableName;
+MODULE_SCOPE int tclFindExecutableSearchDone;
+MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
-MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier;
+MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
+
+MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
/*
* TIP #233 (Virtualized Time)
* Data for the time hooks, if any.
*/
-MODULE_SCOPE Tcl_GetTimeProc* tclGetTimeProcPtr;
-MODULE_SCOPE Tcl_ScaleTimeProc* tclScaleTimeProcPtr;
-MODULE_SCOPE ClientData tclTimeClientData;
+MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
+MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
+MODULE_SCOPE ClientData tclTimeClientData;
/*
* Variables denoting the Tcl object types defined in the core.
*/
-MODULE_SCOPE Tcl_ObjType tclBooleanType;
-MODULE_SCOPE Tcl_ObjType tclByteArrayType;
-MODULE_SCOPE Tcl_ObjType tclByteCodeType;
-MODULE_SCOPE Tcl_ObjType tclDoubleType;
-MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
-MODULE_SCOPE Tcl_ObjType tclIntType;
-MODULE_SCOPE Tcl_ObjType tclListType;
-MODULE_SCOPE Tcl_ObjType tclDictType;
-MODULE_SCOPE Tcl_ObjType tclProcBodyType;
-MODULE_SCOPE Tcl_ObjType tclStringType;
-MODULE_SCOPE Tcl_ObjType tclArraySearchType;
-MODULE_SCOPE Tcl_ObjType tclNsNameType;
-MODULE_SCOPE Tcl_ObjType tclWideIntType;
-MODULE_SCOPE Tcl_ObjType tclRegexpType;
+MODULE_SCOPE const Tcl_ObjType tclBignumType;
+MODULE_SCOPE const Tcl_ObjType tclBooleanType;
+MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
+MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
+MODULE_SCOPE const Tcl_ObjType tclDoubleType;
+MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
+MODULE_SCOPE const Tcl_ObjType tclIntType;
+MODULE_SCOPE const Tcl_ObjType tclListType;
+MODULE_SCOPE const Tcl_ObjType tclDictType;
+MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
+MODULE_SCOPE const Tcl_ObjType tclStringType;
+MODULE_SCOPE const Tcl_ObjType tclArraySearchType;
+MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
+#ifndef TCL_WIDE_INT_IS_LONG
+MODULE_SCOPE const Tcl_ObjType tclWideIntType;
+#endif
+MODULE_SCOPE const Tcl_ObjType tclRegexpType;
+MODULE_SCOPE Tcl_ObjType tclCmdNameType;
/*
* Variables denoting the hash key types defined in the core.
*/
-MODULE_SCOPE Tcl_HashKeyType tclArrayHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclOneWordHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclStringHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclObjHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;
/*
* The head of the list of free Tcl objects, and the total number of Tcl
@@ -1946,48 +2708,182 @@ MODULE_SCOPE char tclEmptyString;
/*
*----------------------------------------------------------------
+ * Procedures shared among Tcl modules but not used by the outside world,
+ * introduced by/for NRE.
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
+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 Tcl_ObjCmdProc TclNRInvoke;
+
+MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
+MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
+
+/* These two can be considered for the public api */
+MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp);
+MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp);
+
+/*
+ * This structure holds the data for the various iteration callbacks used to
+ * NRE the 'for' and 'while' commands. We need a separate structure because we
+ * have more than the 4 client data entries we can provide directly thorugh
+ * the callback API. It is the 'word' information which puts us over the
+ * limit. It is needed because the loop body is argument 4 of 'for' and
+ * argument 2 of 'while'. Not providing the correct index confuses the #280
+ * code. We TclSmallAlloc/Free this.
+ */
+
+typedef struct ForIterData {
+ Tcl_Obj *cond; /* Loop condition expression. */
+ Tcl_Obj *body; /* Loop body. */
+ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */
+ const char *msg; /* Error message part. */
+ int word; /* Index of the body script in the command */
+} ForIterData;
+
+/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
+ * and Tcl_FindSymbol. This structure corresponds to an opaque
+ * typedef in tcl.h */
+
+typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
+ const char* symbol);
+struct Tcl_LoadHandle_ {
+ ClientData clientData; /* Client data is the load handle in the
+ * native filesystem if a module was loaded
+ * there, or an opaque pointer to a structure
+ * for further bookkeeping on load-from-VFS
+ * and load-from-memory */
+ TclFindSymbolProc* findSymbolProcPtr;
+ /* Procedure that resolves symbols in a
+ * loaded module */
+ Tcl_FSUnloadFileProc* unloadFileProcPtr;
+ /* 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:
*----------------------------------------------------------------
*/
-MODULE_SCOPE int TclAppendFormattedObjs(Tcl_Interp *interp,
- Tcl_Obj *appendObj, CONST char *format,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE void TclAppendLimitedToObj(Tcl_Obj *objPtr,
- CONST char *bytes, int length, int limit,
- CONST char *ellipsis);
-MODULE_SCOPE void TclAppendObjToErrorInfo(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
+ const unsigned char *bytes, int len);
+MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags);
+MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next,
+ int loc);
+MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
+ const char *end);
+MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp,
+ Tcl_Obj *objv[], int objc, CmdFrame *cf);
+MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
+ Tcl_Obj *objv[], int objc);
+MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
+ Tcl_Obj *objv[], int objc,
+ void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
+MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
+ CmdFrame *cfPtr);
+MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
+ CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
-MODULE_SCOPE double TclBignumToDouble(mp_int* bignum);
-MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,CONST char *value);
-MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
+MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
+ int strLen, const unsigned char *pattern,
+ int ptnLen, int flags);
+MODULE_SCOPE double TclCeil(const mp_int *a);
+MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
+ const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
-MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp* interp,
- LiteralTable* tablePtr);
-MODULE_SCOPE int TclDoubleDigits(char* buf, double value, int* signum);
-MODULE_SCOPE void TclExpandTokenArray(Tcl_Parse *parsePtr);
-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 TclChannelNamesCmd;
+MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
+ Tcl_Interp *interp, int result);
+MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
+ int *loc);
+MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
+ int start, int *clNext);
+MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
+MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
+ Tcl_Obj *originObjPtr);
+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 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 TclFinalizeCompilation(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
MODULE_SCOPE void TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void TclFinalizeEnvironment(void);
+MODULE_SCOPE void TclFinalizeEvaluation(void);
MODULE_SCOPE void TclFinalizeExecution(void);
MODULE_SCOPE void TclFinalizeIOSubsystem(void);
MODULE_SCOPE void TclFinalizeFilesystem(void);
@@ -1999,26 +2895,51 @@ MODULE_SCOPE void TclFinalizeNotifier(void);
MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
+MODULE_SCOPE void TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
-MODULE_SCOPE void TclFormatNaN(double value, char* buffer);
-MODULE_SCOPE int TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST char *format, ...);
-MODULE_SCOPE int TclFormatToErrorInfo(Tcl_Interp *interp,
- CONST char *format, ...);
+MODULE_SCOPE void TclFinalizeThreadObjects(void);
+MODULE_SCOPE double TclFloor(const mp_int *a);
+MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
- CONST char *attributeName, int *indexPtr);
+ const char *attributeName, int *indexPtr);
+MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ const char *encodingName);
+MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
+MODULE_SCOPE int * TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
-MODULE_SCOPE int TclGetEncodingFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
-MODULE_SCOPE int TclGetNamespaceFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
+MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
+ int *modePtr, int flags);
+MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
+ Tcl_Obj *value, int *code);
+MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, ClientData *clientDataPtr,
+ int *typePtr);
MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
- CONST char *modeString, int *seekFlagPtr,
+ const char *modeString, int *seekFlagPtr,
int *binaryPtr);
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
+MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
- Tcl_GlobTypeData* types);
+ Tcl_GlobTypeData *types);
+MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+ Tcl_Obj *incrPtr);
+MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
+MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
+MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void TclInitAlloc(void);
MODULE_SCOPE void TclInitDbCkalloc(void);
MODULE_SCOPE void TclInitDoubleConversion(void);
@@ -2030,69 +2951,79 @@ MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp);
MODULE_SCOPE void TclInitNamespaceSubsystem(void);
MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
-MODULE_SCOPE void TclInitSubsystems ();
+MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
-MODULE_SCOPE int TclIsLocalScalar(CONST char *src, int len);
-MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int* result);
+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,
- Tcl_Obj* listPtr, Tcl_Obj* argPtr);
-MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp* interp, Tcl_Obj* listPtr,
- int indexCount, Tcl_Obj *CONST indexArray[]);
-MODULE_SCOPE int TclLoadFile(Tcl_Interp* interp, Tcl_Obj *pathPtr,
- int symc, CONST char *symbols[],
- Tcl_PackageInitProc **procPtrs[],
- Tcl_LoadHandle *handlePtr,
- ClientData *clientDataPtr,
- Tcl_FSUnloadFileProc **unloadProcPtr);
-MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp* interp, Tcl_Obj* listPtr,
- Tcl_Obj* indexPtr, Tcl_Obj* valuePtr);
-MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp* interp, Tcl_Obj* listPtr,
- int indexCount, Tcl_Obj *CONST indexArray[],
- Tcl_Obj* valuePtr);
+MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, Tcl_Obj *argPtr);
+MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ int indexCount, Tcl_Obj *const indexArray[]);
+/* TIP #280 */
+MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n,
+ int *lines, Tcl_Obj *const *elems);
+MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ int indexCount, Tcl_Obj *const indexArray[],
+ Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
+ const EnsembleImplMap map[]);
+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,
+ 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,
+ Tcl_Obj *part2Ptr, const char *operation,
+ const char *reason, int index);
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[],
+ int objc, Tcl_Obj *const objv[],
Tcl_Namespace *nsPtr, int flags);
-MODULE_SCOPE int TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST char *format, ...);
-MODULE_SCOPE int TclParseBackslash(CONST char *src,
+MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp,
+ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
+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);
-MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, CONST char *string,
+MODULE_SCOPE int TclParseHex(const char *src, int numBytes,
+ 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);
+MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string,
int numBytes, Tcl_Parse *parsePtr);
-MODULE_SCOPE int TclParseInteger(CONST char *string, int numBytes);
-MODULE_SCOPE int TclParseWhiteSpace(CONST char *src,
- int numBytes, Tcl_Parse *parsePtr, char *typePtr);
+MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes);
MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp,
int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-MODULE_SCOPE int TclpCheckStackSpace(void);
MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
-MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep,
+MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
+MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
int len);
-MODULE_SCOPE int TclpDeleteFile(CONST char *path);
+MODULE_SCOPE int TclpDeleteFile(const void *path);
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,
+ Tcl_ThreadCreateProc *proc, ClientData clientData,
int stackSize, int flags);
-MODULE_SCOPE int TclpFindVariable(CONST char *name, int *lengthPtr);
+MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
int *lengthPtr, Tcl_Encoding *encodingPtr);
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);
@@ -2100,65 +3031,102 @@ MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr, int nextCheckpoint);
-MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, char *joining);
+MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp,
+MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp,
Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp,
Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
- CONST char *pattern, Tcl_GlobTypeData *types);
+ const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
-MODULE_SCOPE Tcl_Obj* TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
int linkType);
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
+MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
+ Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+ Tcl_Obj *resultingNameObj);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
-MODULE_SCOPE void TclpPanic(CONST char *format, ...);
-MODULE_SCOPE char * TclpReadlink(CONST char *fileName,
+MODULE_SCOPE char * TclpReadlink(const char *fileName,
Tcl_DString *linkPtr);
-MODULE_SCOPE void TclpReleaseFile(TclFile file);
MODULE_SCOPE void TclpSetInterfaces(void);
MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp);
-MODULE_SCOPE void TclpUnloadFile(Tcl_LoadHandle loadHandle);
-MODULE_SCOPE VOID * TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
-MODULE_SCOPE void TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
- VOID *data);
+MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
+MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
+ void *data);
MODULE_SCOPE void TclpThreadExit(int status);
-MODULE_SCOPE int TclpThreadGetStackSize(void);
MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex);
-MODULE_SCOPE VOID TclRememberJoinableThread(Tcl_ThreadId id);
+MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
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,
+ mp_int *bignumValue);
+MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Command *cmdPtr);
+MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
Tcl_Obj *newValue, Tcl_Encoding encoding);
-MODULE_SCOPE VOID TclSignalExitThread(Tcl_ThreadId id, int result);
-MODULE_SCOPE double TclStrToD(CONST char* string, CONST char** endPtr);
+MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result);
+MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
+ int numBytes);
+MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
+ const char *pattern, int ptnLen, int flags);
+MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
+ Tcl_Obj *patternObj, int flags);
+MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
+MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
+ int numBytes, int flags, int line,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts,
+ Tcl_Obj *const opts[], int *flagPtr);
+MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
+ int numBytes, int flags, Tcl_Parse *parsePtr,
+ Tcl_InterpState *statePtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
- int count, int *tokensLeftPtr);
-MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result,
- Tcl_Interp *targetInterp);
+ 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 int TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
-MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj* pathPtr);
-MODULE_SCOPE Tcl_PackageInitProc* TclpFindSymbol(Tcl_Interp *interp,
- Tcl_LoadHandle loadHandle, CONST char *symbol);
+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 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 TclpFinalizeThreadDataThread(void);
+MODULE_SCOPE void TclFinalizeThreadDataThread(void);
MODULE_SCOPE void TclFinalizeThreadStorage(void);
+#ifdef TCL_WIDE_CLICKS
+MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
+MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
+#endif
+MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
+MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
+MODULE_SCOPE void * TclpThreadCreateKey(void);
+MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
+MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
+MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+
+MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
/*
*----------------------------------------------------------------
@@ -2168,280 +3136,291 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void);
MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_ArrayObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_BinaryObjCmd(ClientData clientData,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclChanTruncateObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockClicksObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockGetenvObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockMicrosecondsObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockMillisecondsObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockSecondsObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockLocaltimeObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int TclClockMktimeObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
+MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE void TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int TclClockOldscanObjCmd(
ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
Tcl_Time *timePtr, Tcl_TimerProc *proc,
ClientData clientData);
MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd(
ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_DictObjCmd(ClientData clientData,
+ 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[]);
+ 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[]);
-MODULE_SCOPE int TclEncodingDirsObjCmd(
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_FconfigureObjCmd(
ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
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[]);
+ 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[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_InfoObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData,
Tcl_Interp *interp, int argc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ 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[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData,
- Tcl_Interp* interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_NamespaceObjCmd(ClientData clientData,
+ 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[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int Tcl_StringObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------
@@ -2450,49 +3429,454 @@ MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData,
*/
MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ 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, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileDictCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+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);
+MODULE_SCOPE int TclCompileDictGetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileDictIncrCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+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);
+MODULE_SCOPE int TclCompileErrorCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileExprCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ 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, struct CompileEnv *envPtr);
+ 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, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp* interp,
- Tcl_Parse* parsePtr, struct CompileEnv* envPtr);
-MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp* interp,
- Tcl_Parse* parsePtr, struct CompileEnv* envPtr);
+ 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 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 TclCompileNamespaceOriginCmd(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 TclCompileObjectNextCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectNextToCmd(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, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileStringCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+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 TclCompileStringIsCmd(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 TclCompileStringReplaceCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringTrimRCmd(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, struct CompileEnv *envPtr);
+ 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);
+MODULE_SCOPE int TclCompileTryCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileUnsetCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ 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 TclCompileYieldToCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic0To2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasic1To3ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin0ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+
+MODULE_SCOPE int TclInvertOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclNotOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclAddOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclMulOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclAndOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclOrOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclXorOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclPowOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclModOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclNeqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclInOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclNiOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclMinusOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclDivOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclLessOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclLeqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclGeqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclEqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+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
@@ -2500,30 +3884,53 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
* the public interface.
*/
+MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp,
+ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags,
+ const char *msg, const int createPart1,
+ const int createPart2, Var **arrayPtrPtr);
MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp,
- CONST char *arrayName, CONST char *elName,
- CONST int flags, CONST char *msg,
- CONST int createPart1, CONST int createPart2,
- Var *arrayPtr);
-MODULE_SCOPE Var * TclObjLookupVar(Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, CONST char *part2, int flags,
- CONST char *msg, CONST int createPart1,
- CONST int createPart2, Var **arrayPtrPtr);
+ Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
+ const int flags, const char *msg,
+ const int createPart1, const int createPart2,
+ Var *arrayPtr, int index);
MODULE_SCOPE Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp,
- Var *varPtr, Var *arrayPtr, CONST char *part1,
- CONST char *part2, CONST int flags);
+ Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, const int flags, int index);
MODULE_SCOPE Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp,
- Var *varPtr, Var *arrayPtr, CONST char *part1,
- CONST char *part2, Tcl_Obj *newValuePtr,
- CONST int flags);
-MODULE_SCOPE Tcl_Obj * TclPtrIncrVar(Tcl_Interp *interp,
- Var *varPtr, Var *arrayPtr, CONST char *part1,
- CONST char *part2, CONST long i, CONST int flags);
-MODULE_SCOPE Tcl_Obj * TclPtrIncrWideVar(Tcl_Interp *interp,
- Var *varPtr, Var *arrayPtr, CONST char *part1,
- CONST char *part2, CONST Tcl_WideInt i,
- CONST int flags);
+ Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
+ const int flags, int index);
+MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp,
+ Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
+ const int flags, int index);
+MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
+ Tcl_Obj *myNamePtr, int myFlags, int index);
+MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, const int flags,
+ int index);
MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
+MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr,
+ Tcl_HashTable *tablePtr);
+
+/*
+ * The new extended interface to the variable traces.
+ */
+
+MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
+ Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+ int flags, int leaveErrMsg, int index);
+
+/*
+ * So tclObj.c and tclDictObj.c can share these implementations.
+ */
+
+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);
/*
*----------------------------------------------------------------
@@ -2546,6 +3953,22 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
*----------------------------------------------------------------
*/
+/*
+ * DTrace object allocation probe macros.
+ */
+
+#ifdef USE_DTRACE
+#ifndef _TCLDTRACE_H
+typedef const char *TclDTraceStr;
+#include "tclDTrace.h"
+#endif
+#define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr)
+#define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr)
+#else /* USE_DTRACE */
+#define TCL_DTRACE_OBJ_CREATE(objPtr) {}
+#define TCL_DTRACE_OBJ_FREE(objPtr) {}
+#endif /* USE_DTRACE */
+
#ifdef TCL_COMPILE_STATS
# define TclIncrObjsAllocated() \
tclObjsAlloced++
@@ -2556,6 +3979,12 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
# define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */
+# define TclAllocObjStorage(objPtr) \
+ TclAllocObjStorageEx(NULL, (objPtr))
+
+# define TclFreeObjStorage(objPtr) \
+ TclFreeObjStorageEx(NULL, (objPtr))
+
#ifndef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
TclIncrObjsAllocated(); \
@@ -2563,19 +3992,29 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
(objPtr)->refCount = 0; \
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
- (objPtr)->typePtr = NULL
+ (objPtr)->typePtr = NULL; \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
+
+/*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering) with
+ * 'length == -1'.
+ * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
+ */
# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount <= 0) { \
- if ((objPtr)->typePtr && (objPtr)->typePtr->freeIntRepProc) { \
- TclFreeObj(objPtr); \
- } else { \
+ if (--(objPtr)->refCount > 0) ; else { \
+ if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
+ TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
&& ((objPtr)->bytes != tclEmptyStringRep)) { \
ckfree((char *) (objPtr)->bytes); \
} \
+ (objPtr)->length = -1; \
TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
+ } else { \
+ TclFreeObj(objPtr); \
} \
}
@@ -2585,15 +4024,17 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
* The PURIFY mode is like the regular mode, but instead of doing block
* Tcl_Obj allocation and keeping a freed list for efficiency, it always
* allocates and frees a single Tcl_Obj so that tools like Purify can better
- * track memory leaks
+ * track memory leaks.
*/
-# define TclAllocObjStorage(objPtr) \
- (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+# define TclAllocObjStorageEx(interp, objPtr) \
+ (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
-# define TclFreeObjStorage(objPtr) \
+# define TclFreeObjStorageEx(interp, objPtr) \
ckfree((char *) (objPtr))
+#undef USE_THREAD_ALLOC
+#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
/*
@@ -2607,47 +4048,94 @@ MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void TclFreeAllocCache(void *);
MODULE_SCOPE void * TclpGetAllocCache(void);
MODULE_SCOPE void TclpSetAllocCache(void *);
-MODULE_SCOPE void TclFinalizeThreadAlloc(void);
-MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex* mutex);
+MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclpFreeAllocCache(void *);
-# define TclAllocObjStorage(objPtr) \
- (objPtr) = TclThreadAllocObj()
+/*
+ * These macros need to be kept in sync with the code of TclThreadAllocObj()
+ * and TclThreadFreeObj().
+ *
+ * Note that the optimiser should resolve the case (interp==NULL) at compile
+ * time.
+ */
-# define TclFreeObjStorage(objPtr) \
- TclThreadFreeObj((objPtr))
+# define ALLOC_NOBJHIGH 1200
+
+# define TclAllocObjStorageEx(interp, objPtr) \
+ do { \
+ AllocCache *cachePtr; \
+ if (((interp) == NULL) || \
+ ((cachePtr = ((Interp *)(interp))->allocCache), \
+ (cachePtr->numObjects == 0))) { \
+ (objPtr) = TclThreadAllocObj(); \
+ } else { \
+ (objPtr) = cachePtr->firstObjPtr; \
+ cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \
+ --cachePtr->numObjects; \
+ } \
+ } while (0)
+
+# define TclFreeObjStorageEx(interp, objPtr) \
+ do { \
+ AllocCache *cachePtr; \
+ if (((interp) == NULL) || \
+ ((cachePtr = ((Interp *)(interp))->allocCache), \
+ (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \
+ TclThreadFreeObj(objPtr); \
+ } else { \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
+ cachePtr->firstObjPtr = objPtr; \
+ ++cachePtr->numObjects; \
+ } \
+ } while (0)
#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;
#endif
-# define TclAllocObjStorage(objPtr) \
- Tcl_MutexLock(&tclObjMutex); \
- if (tclFreeObjList == NULL) { \
- TclAllocateFreeObjects(); \
- } \
- (objPtr) = tclFreeObjList; \
- tclFreeObjList = (Tcl_Obj *) \
- tclFreeObjList->internalRep.otherValuePtr; \
- Tcl_MutexUnlock(&tclObjMutex)
-
-# define TclFreeObjStorage(objPtr) \
- Tcl_MutexLock(&tclObjMutex); \
- (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
- tclFreeObjList = (objPtr); \
- Tcl_MutexUnlock(&tclObjMutex)
+# define TclAllocObjStorageEx(interp, objPtr) \
+ do { \
+ Tcl_MutexLock(&tclObjMutex); \
+ if (tclFreeObjList == NULL) { \
+ TclAllocateFreeObjects(); \
+ } \
+ (objPtr) = tclFreeObjList; \
+ tclFreeObjList = (Tcl_Obj *) \
+ tclFreeObjList->internalRep.twoPtrValue.ptr1; \
+ Tcl_MutexUnlock(&tclObjMutex); \
+ } while (0)
+
+# define TclFreeObjStorageEx(interp, objPtr) \
+ do { \
+ Tcl_MutexLock(&tclObjMutex); \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
+ tclFreeObjList = (objPtr); \
+ Tcl_MutexUnlock(&tclObjMutex); \
+ } while (0)
#endif
#else /* TCL_MEM_DEBUG */
-MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
+MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
+ int line);
# define TclDbNewObj(objPtr, file, line) \
- TclIncrObjsAllocated(); \
- (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
- TclDbInitNewObj(objPtr);
+ do { \
+ TclIncrObjsAllocated(); \
+ (objPtr) = (Tcl_Obj *) \
+ Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+ TclDbInitNewObj((objPtr), (file), (line)); \
+ TCL_DTRACE_OBJ_CREATE(objPtr); \
+ } while (0)
# define TclNewObj(objPtr) \
TclDbNewObj(objPtr, __FILE__, __LINE__);
@@ -2682,8 +4170,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
- memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
- (unsigned) (len)); \
+ memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
@@ -2703,6 +4190,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
#define TclGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
+#define TclGetStringFromObj(objPtr, lenPtr) \
+ ((objPtr)->bytes \
+ ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \
+ : Tcl_GetStringFromObj((objPtr), (lenPtr)))
+
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to clean out an object's internal
@@ -2714,9 +4206,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*/
#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; \
}
/*
@@ -2730,59 +4224,151 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
#define TclInvalidateStringRep(objPtr) \
if (objPtr->bytes != NULL) { \
- if (objPtr->bytes != tclEmptyStringRep) {\
- ckfree((char *) objPtr->bytes);\
- }\
- objPtr->bytes = NULL;\
- }\
-
+ if (objPtr->bytes != tclEmptyStringRep) { \
+ ckfree((char *) objPtr->bytes); \
+ } \
+ objPtr->bytes = NULL; \
+ }
/*
*----------------------------------------------------------------
- * Macro used by the Tcl core to get a Tcl_WideInt value out of a Tcl_Obj of
- * the "wideInt" type. Different implementation on different platforms
- * depending whether TCL_WIDE_INT_IS_LONG.
+ * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
+ * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
+ * int available, int append,
+ * Tcl_Token *staticPtr);
+ * MODULE_SCOPE void TclGrowParseTokenArray(Tcl_Parse *parsePtr,
+ * int append);
*----------------------------------------------------------------
*/
-#ifdef TCL_WIDE_INT_IS_LONG
-# define TclGetWide(resultVar, objPtr) \
- (resultVar) = (objPtr)->internalRep.longValue
-# define TclGetLongFromWide(resultVar, objPtr) \
- (resultVar) = (objPtr)->internalRep.longValue
-#else
-# define TclGetWide(resultVar, objPtr) \
- (resultVar) = (objPtr)->internalRep.wideValue
-# define TclGetLongFromWide(resultVar, objPtr) \
- (resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue)
+/* 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 TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \
+ do { \
+ int needed = (used) + (append); \
+ if (needed > TCL_MAX_TOKENS) { \
+ Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \
+ TCL_MAX_TOKENS); \
+ } \
+ if (needed > (available)) { \
+ int allocated = 2 * needed; \
+ Tcl_Token *oldPtr = (tokenPtr); \
+ Tcl_Token *newPtr; \
+ if (oldPtr == (staticPtr)) { \
+ oldPtr = NULL; \
+ } \
+ if (allocated > TCL_MAX_TOKENS) { \
+ allocated = TCL_MAX_TOKENS; \
+ } \
+ newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \
+ (unsigned int) (allocated * sizeof(Tcl_Token))); \
+ if (newPtr == NULL) { \
+ allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH; \
+ if (allocated > TCL_MAX_TOKENS) { \
+ allocated = TCL_MAX_TOKENS; \
+ } \
+ newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \
+ (unsigned int) (allocated * sizeof(Tcl_Token))); \
+ } \
+ (available) = allocated; \
+ if (oldPtr == NULL) { \
+ memcpy(newPtr, staticPtr, \
+ (size_t) ((used) * sizeof(Tcl_Token))); \
+ } \
+ (tokenPtr) = newPtr; \
+ } \
+ } while (0)
+
+#define TclGrowParseTokenArray(parsePtr, append) \
+ TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \
+ (parsePtr)->tokensAvailable, (append), \
+ (parsePtr)->staticTokens)
+
/*
*----------------------------------------------------------------
* Macro used by the Tcl core get a unicode char from a utf string. It checks
* to see if we have a one-byte utf char before calling the real
- * Tcl_UtfToUniChar, as this will save a lot of time for primarily ascii
+ * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII
* string handling. The macro's expression result is 1 for the 1-byte case or
* the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is:
*
- * MODULE_SCOPE int TclUtfToUniChar(CONST char *string, Tcl_UniChar *ch);
+ * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch);
*----------------------------------------------------------------
*/
#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))
/*
*----------------------------------------------------------------
+ * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
+ * -sensitive points where it pays to avoid a function call in the common case
+ * of counting along a string of all one-byte characters. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes,
+ * int numBytes);
+ *----------------------------------------------------------------
+ */
+
+#define TclNumUtfChars(numChars, bytes, numBytes) \
+ do { \
+ int count, i = (numBytes); \
+ unsigned char *str = (unsigned char *) (bytes); \
+ while (i && (*str < 0xC0)) { i--; str++; } \
+ count = (numBytes) - i; \
+ if (i) { \
+ count += Tcl_NumUtfChars((bytes) + count, i); \
+ } \
+ (numChars) = count; \
+ } while (0);
+
+/*
+ *----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+ (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+
+/*
+ *----------------------------------------------------------------
* Macro used by the Tcl core to compare Unicode strings. On big-endian
* systems we can use the more efficient memcmp, but this would not be
* lexically correct on little-endian systems. The ANSI C "prototype" for
* this macro is:
*
- * MODULE_SCOPE int TclUniCharNcmp(CONST Tcl_UniChar *cs,
- * CONST Tcl_UniChar *ct, unsigned long n);
+ * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs,
+ * const Tcl_UniChar *ct, unsigned long n);
*----------------------------------------------------------------
*/
@@ -2802,8 +4388,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*/
#define TclInvalidateNsCmdLookup(nsPtr) \
- if ((nsPtr)->numExportPatterns) { \
- (nsPtr)->exportLookupEpoch++; \
+ if ((nsPtr)->numExportPatterns) { \
+ (nsPtr)->exportLookupEpoch++; \
+ } \
+ if ((nsPtr)->commandPathLength) { \
+ (nsPtr)->cmdRefEpoch++; \
}
/*
@@ -2814,33 +4403,40 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*----------------------------------------------------------------------
*/
-MODULE_SCOPE void * TclBNAlloc(size_t nBytes);
-MODULE_SCOPE void * TclBNRealloc(void *oldBlock, size_t newNBytes);
-MODULE_SCOPE void TclBNFree(void *block);
+MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
-
+MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int *bignum,
+ Tcl_WideInt initVal);
+MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
+ Tcl_WideUInt initVal);
/*
- *----------------------------------------------------------------
- * Macro used by the Tcl core to check whether a pattern has any characters
- * special to [string match]. The ANSI C "prototype" for this macro is:
+ *----------------------------------------------------------------------
*
- * MODULE_SCOPE int TclMatchIsTrivial(CONST char *pattern);
- *----------------------------------------------------------------
+ * External (platform specific) initialization routine, these declarations
+ * explicitly don't use EXTERN since this code does not get compiled into the
+ * library:
+ *
+ *----------------------------------------------------------------------
*/
-#define TclMatchIsTrivial(pattern) strpbrk((pattern), "*[]]?\\") == NULL
+MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
+MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
+MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
+MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
+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:
+ * Macro used by the Tcl core to check whether a pattern has any characters
+ * special to [string match]. The ANSI C "prototype" for this macro is:
*
- * MODULE_SCOPE int TclFormatInt(char *buf, long n);
+ * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern);
*----------------------------------------------------------------
*/
-#define TclFormatInt(buf, n) sprintf((buf), "%ld", (long)(n))
+#define TclMatchIsTrivial(pattern) \
+ (strpbrk((pattern), "*[?\\") == NULL)
/*
*----------------------------------------------------------------
@@ -2857,14 +4453,16 @@ MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
*----------------------------------------------------------------
*/
-#define TclSetIntObj(objPtr, i) \
- TclInvalidateStringRep(objPtr);\
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.longValue = (long)(i); \
- (objPtr)->typePtr = &tclIntType
+#define TclSetLongObj(objPtr, i) \
+ do { \
+ TclInvalidateStringRep(objPtr); \
+ TclFreeIntRep(objPtr); \
+ (objPtr)->internalRep.longValue = (long)(i); \
+ (objPtr)->typePtr = &tclIntType; \
+ } while (0)
-#define TclSetLongObj(objPtr, l) \
- TclSetIntObj((objPtr), (l))
+#define TclSetIntObj(objPtr, l) \
+ TclSetLongObj(objPtr, l)
/*
* NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
@@ -2874,19 +4472,25 @@ MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
*/
#define TclSetBooleanObj(objPtr, b) \
- TclSetIntObj((objPtr), ((b)? 1 : 0));
+ TclSetLongObj(objPtr, (b)!=0);
+#ifndef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) \
- TclInvalidateStringRep(objPtr);\
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
- (objPtr)->typePtr = &tclWideIntType
+ do { \
+ TclInvalidateStringRep(objPtr); \
+ TclFreeIntRep(objPtr); \
+ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
+ (objPtr)->typePtr = &tclWideIntType; \
+ } while (0)
+#endif
#define TclSetDoubleObj(objPtr, d) \
- TclInvalidateStringRep(objPtr);\
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType
+ do { \
+ TclInvalidateStringRep(objPtr); \
+ TclFreeIntRep(objPtr); \
+ (objPtr)->internalRep.doubleValue = (double)(d); \
+ (objPtr)->typePtr = &tclDoubleType; \
+ } while (0)
/*
*----------------------------------------------------------------
@@ -2900,51 +4504,56 @@ MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
+ * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
*
*----------------------------------------------------------------
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
- TclIncrObjsAllocated(); \
- TclAllocObjStorage(objPtr); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = NULL; \
- (objPtr)->internalRep.longValue = (long)(i); \
- (objPtr)->typePtr = &tclIntType
-
-#define TclNewLongObj(objPtr, l) \
- TclNewIntObj((objPtr), (l))
+#define TclNewLongObj(objPtr, i) \
+ do { \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorage(objPtr); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = NULL; \
+ (objPtr)->internalRep.longValue = (long)(i); \
+ (objPtr)->typePtr = &tclIntType; \
+ TCL_DTRACE_OBJ_CREATE(objPtr); \
+ } while (0)
+
+#define TclNewIntObj(objPtr, l) \
+ TclNewLongObj(objPtr, l)
/*
* NOTE: There is to be no such thing as a "pure" boolean.
* See comment above TclSetBooleanObj macro above.
*/
#define TclNewBooleanObj(objPtr, b) \
- TclNewIntObj((objPtr), ((b)? 1 : 0))
-
-#define TclNewWideIntObj(objPtr, w) \
- TclIncrObjsAllocated(); \
- TclAllocObjStorage(objPtr); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = NULL; \
- (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
- (objPtr)->typePtr = &tclWideIntType
+ TclNewLongObj((objPtr), (b)!=0)
#define TclNewDoubleObj(objPtr, d) \
- TclIncrObjsAllocated(); \
- TclAllocObjStorage(objPtr); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = NULL; \
- (objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType
+ do { \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorage(objPtr); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = NULL; \
+ (objPtr)->internalRep.doubleValue = (double)(d); \
+ (objPtr)->typePtr = &tclDoubleType; \
+ TCL_DTRACE_OBJ_CREATE(objPtr); \
+ } while (0)
#define TclNewStringObj(objPtr, s, len) \
- TclNewObj(objPtr); \
- TclInitStringRep((objPtr), (s), (len))
+ do { \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorage(objPtr); \
+ (objPtr)->refCount = 0; \
+ TclInitStringRep((objPtr), (s), (len)); \
+ (objPtr)->typePtr = NULL; \
+ TCL_DTRACE_OBJ_CREATE(objPtr); \
+ } while (0)
#else /* TCL_MEM_DEBUG */
-#define TclNewIntObj(objPtr, i) \
+#define TclNewIntObj(objPtr, i) \
(objPtr) = Tcl_NewIntObj(i)
#define TclNewLongObj(objPtr, l) \
@@ -2953,9 +4562,6 @@ MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
#define TclNewBooleanObj(objPtr, b) \
(objPtr) = Tcl_NewBooleanObj(b)
-#define TclNewWideIntObj(objPtr, w)\
- (objPtr) = Tcl_NewWideIntObj(w)
-
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
@@ -2963,9 +4569,254 @@ MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
-#include "tclPort.h"
+/*
+ * The sLiteral argument *must* be a string literal; the incantation with
+ * sizeof(sLiteral "") will fail to compile otherwise.
+ */
+#define TclNewLiteralStringObj(objPtr, sLiteral) \
+ TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+
+/*
+ *----------------------------------------------------------------
+ * 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:
+ *
+ * MODULE_SCOPE int TclIsInfinite(double d);
+ * MODULE_SCOPE int TclIsNaN(double d);
+ */
+
+#ifdef _MSC_VER
+# define TclIsInfinite(d) (!(_finite((d))))
+# define TclIsNaN(d) (_isnan((d)))
+#else
+# define TclIsInfinite(d) ((d) > DBL_MAX || (d) < -DBL_MAX)
+# ifdef NO_ISNAN
+# define TclIsNaN(d) ((d) != (d))
+# else
+# define TclIsNaN(d) (isnan(d))
+# endif
+#endif
+
+/*
+ * ----------------------------------------------------------------------
+ * Macro to use to find the offset of a field in a structure. Computes number
+ * of bytes from beginning of structure to a given field.
+ */
+
+#ifdef offsetof
+#define TclOffset(type, field) ((int) offsetof(type, field))
+#else
+#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field))
+#endif
+
+/*
+ *----------------------------------------------------------------
+ * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
+ */
+
+#define TclGetCurrentNamespace(interp) \
+ (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr
+
+#define TclGetGlobalNamespace(interp) \
+ (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr
+
+/*
+ *----------------------------------------------------------------
+ * Inline version of TclCleanupCommand; still need the function as it is in
+ * the internal stubs, but the core can use the macro instead.
+ */
+
+#define TclCleanupCommandMacro(cmdPtr) \
+ if (--(cmdPtr)->refCount <= 0) { \
+ ckfree((char *) (cmdPtr));\
+ }
+
+/*
+ *----------------------------------------------------------------
+ * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
+ * of calls out of the critical path. Note that this code isn't particularly
+ * readable; the non-inline version (in tclInterp.c) is much easier to
+ * understand. Note also that these macros takes different args (iPtr->limit)
+ * to the non-inline version.
+ */
+
+#define TclLimitExceeded(limit) ((limit).exceeded != 0)
+
+#define TclLimitReady(limit) \
+ (((limit).active == 0) ? 0 : \
+ (++(limit).granularityTicker, \
+ ((((limit).active & TCL_LIMIT_COMMANDS) && \
+ (((limit).cmdGranularity == 1) || \
+ ((limit).granularityTicker % (limit).cmdGranularity == 0))) \
+ ? 1 : \
+ (((limit).active & TCL_LIMIT_TIME) && \
+ (((limit).timeGranularity == 1) || \
+ ((limit).granularityTicker % (limit).timeGranularity == 0)))\
+ ? 1 : 0)))
+
+/*
+ * Compile-time assertions: these produce a compile time error if the
+ * expression is not known to be true at compile time. If the assertion is
+ * known to be false, the compiler (or optimizer?) will error out with
+ * "division by zero". If the assertion cannot be evaluated at compile time,
+ * the compiler will error out with "non-static initializer".
+ *
+ * Adapted with permission from
+ * http://www.pixelbeat.org/programming/gcc/static_assert.html
+ */
+
+#define TCL_CT_ASSERT(e) \
+ {enum { ct_assert_value = 1/(!!(e)) };}
+
+/*
+ *----------------------------------------------------------------
+ * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
+ * Only checked at compile time.
+ *
+ * ONLY USE FOR CONSTANT nBytes.
+ *
+ * DO NOT LET THEM CROSS THREAD BOUNDARIES
+ *----------------------------------------------------------------
+ */
+
+#define TclSmallAlloc(nbytes, memPtr) \
+ TclSmallAllocEx(NULL, (nbytes), (memPtr))
+
+#define TclSmallFree(memPtr) \
+ TclSmallFreeEx(NULL, (memPtr))
+
+#ifndef TCL_MEM_DEBUG
+#define TclSmallAllocEx(interp, nbytes, memPtr) \
+ do { \
+ Tcl_Obj *objPtr; \
+ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
+ TclIncrObjsAllocated(); \
+ TclAllocObjStorageEx((interp), (objPtr)); \
+ memPtr = (ClientData) (objPtr); \
+ } while (0)
+
+#define TclSmallFreeEx(interp, memPtr) \
+ do { \
+ TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \
+ TclIncrObjsFreed(); \
+ } while (0)
+
+#else /* TCL_MEM_DEBUG */
+#define TclSmallAllocEx(interp, nbytes, memPtr) \
+ do { \
+ Tcl_Obj *objPtr; \
+ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
+ TclNewObj(objPtr); \
+ memPtr = (ClientData) objPtr; \
+ } while (0)
+
+#define TclSmallFreeEx(interp, memPtr) \
+ do { \
+ Tcl_Obj *objPtr = (Tcl_Obj *) memPtr; \
+ objPtr->bytes = NULL; \
+ objPtr->typePtr = NULL; \
+ objPtr->refCount = 1; \
+ TclDecrRefCount(objPtr); \
+ } while (0)
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
+ */
+
+#if defined(PURIFY) && defined(__clang__)
+#if __has_feature(attribute_analyzer_noreturn) && \
+ !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
+void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
+#endif
+#if !defined(CLANG_ASSERT)
+#include <assert.h>
+#define CLANG_ASSERT(x) assert(x)
+#endif
+#elif !defined(CLANG_ASSERT)
+#define CLANG_ASSERT(x)
+#endif /* PURIFY && __clang__ */
+
+/*
+ *----------------------------------------------------------------
+ * Parameters, structs and macros for the non-recursive engine (NRE)
+ *----------------------------------------------------------------
+ */
+
+#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */
+#define NRE_ENABLE_ASSERTS 1
+
+/*
+ * This is the main data struct for representing NR commands. It is designed
+ * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
+ * available.
+ */
+
+typedef struct NRE_callback {
+ Tcl_NRPostProc *procPtr;
+ ClientData data[4];
+ struct NRE_callback *nextPtr;
+} NRE_callback;
+
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+
+/*
+ * Inline version of Tcl_NRAddCallback.
+ */
+
+#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
+ do { \
+ NRE_callback *callbackPtr; \
+ TCLNR_ALLOC((interp), (callbackPtr)); \
+ callbackPtr->procPtr = (postProcPtr); \
+ callbackPtr->data[0] = (ClientData)(data0); \
+ callbackPtr->data[1] = (ClientData)(data1); \
+ callbackPtr->data[2] = (ClientData)(data2); \
+ callbackPtr->data[3] = (ClientData)(data3); \
+ callbackPtr->nextPtr = TOP_CB(interp); \
+ TOP_CB(interp) = callbackPtr; \
+ } while (0)
+
+#if NRE_USE_SMALL_ALLOC
+#define TCLNR_ALLOC(interp, 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(NRE_callback))))
+#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr))
+#endif
+
+#if NRE_ENABLE_ASSERTS
+#define NRE_ASSERT(expr) assert((expr))
+#else
+#define NRE_ASSERT(expr)
+#endif
+
#include "tclIntDecls.h"
#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 4d1fff3..f95f999 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.83 2005/08/05 23:57:35 dkf Exp $
*/
#ifndef _TCLINTDECLS
@@ -30,6 +28,22 @@
# endif
#endif
+/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
+#undef Tcl_CreateNamespace
+#undef Tcl_DeleteNamespace
+#undef Tcl_AppendExportList
+#undef Tcl_Export
+#undef Tcl_Import
+#undef Tcl_ForgetImport
+#undef Tcl_GetCurrentNamespace
+#undef Tcl_GetGlobalNamespace
+#undef Tcl_FindNamespace
+#undef Tcl_FindCommand
+#undef Tcl_GetCommandFromObj
+#undef Tcl_GetCommandFullName
+#undef Tcl_SetStartupScript
+#undef Tcl_GetStartupScript
+
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -38,893 +52,421 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
/* Slot 0 is reserved */
-#ifndef TclAccessDeleteProc_TCL_DECLARED
-#define TclAccessDeleteProc_TCL_DECLARED
-/* 1 */
-EXTERN int TclAccessDeleteProc _ANSI_ARGS_((
- TclAccessProc_ * proc));
-#endif
-#ifndef TclAccessInsertProc_TCL_DECLARED
-#define TclAccessInsertProc_TCL_DECLARED
-/* 2 */
-EXTERN int TclAccessInsertProc _ANSI_ARGS_((
- TclAccessProc_ * proc));
-#endif
-#ifndef TclAllocateFreeObjects_TCL_DECLARED
-#define TclAllocateFreeObjects_TCL_DECLARED
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
/* 3 */
-EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
-#endif
+EXTERN void TclAllocateFreeObjects(void);
/* Slot 4 is reserved */
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclCleanupChildren_TCL_DECLARED
-#define TclCleanupChildren_TCL_DECLARED
-/* 5 */
-EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
- int numPids, Tcl_Pid * pidPtr,
- Tcl_Channel errorChan));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclCleanupChildren_TCL_DECLARED
-#define TclCleanupChildren_TCL_DECLARED
/* 5 */
-EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
- int numPids, Tcl_Pid * pidPtr,
- Tcl_Channel errorChan));
-#endif
-#endif /* __WIN32__ */
-#ifndef TclCleanupCommand_TCL_DECLARED
-#define TclCleanupCommand_TCL_DECLARED
+EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids,
+ Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
-EXTERN void TclCleanupCommand _ANSI_ARGS_((Command * cmdPtr));
-#endif
-#ifndef TclCopyAndCollapse_TCL_DECLARED
-#define TclCopyAndCollapse_TCL_DECLARED
+EXTERN void TclCleanupCommand(Command *cmdPtr);
/* 7 */
-EXTERN int TclCopyAndCollapse _ANSI_ARGS_((int count,
- CONST char * src, char * dst));
-#endif
-#ifndef TclCopyChannel_TCL_DECLARED
-#define TclCopyChannel_TCL_DECLARED
+EXTERN int TclCopyAndCollapse(int count, const char *src,
+ char *dst);
/* 8 */
-EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel inChan, Tcl_Channel outChan,
- int toRead, Tcl_Obj * cmdPtr));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclCreatePipeline_TCL_DECLARED
-#define TclCreatePipeline_TCL_DECLARED
-/* 9 */
-EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, CONST char ** argv,
- Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
- TclFile * outPipePtr, TclFile * errFilePtr));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclCreatePipeline_TCL_DECLARED
-#define TclCreatePipeline_TCL_DECLARED
+EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
+ Tcl_Channel inChan, Tcl_Channel outChan,
+ int toRead, Tcl_Obj *cmdPtr);
/* 9 */
-EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, CONST char ** argv,
- Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
- TclFile * outPipePtr, TclFile * errFilePtr));
-#endif
-#endif /* __WIN32__ */
-#ifndef TclCreateProc_TCL_DECLARED
-#define TclCreateProc_TCL_DECLARED
+EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc,
+ const char **argv, Tcl_Pid **pidArrayPtr,
+ TclFile *inPipePtr, TclFile *outPipePtr,
+ TclFile *errFilePtr);
/* 10 */
-EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp * interp,
- Namespace * nsPtr, CONST char * procName,
- Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr,
- Proc ** procPtrPtr));
-#endif
-#ifndef TclDeleteCompiledLocalVars_TCL_DECLARED
-#define TclDeleteCompiledLocalVars_TCL_DECLARED
+EXTERN int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
+ const char *procName, Tcl_Obj *argsPtr,
+ Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
-EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_((
- Interp * iPtr, CallFrame * framePtr));
-#endif
-#ifndef TclDeleteVars_TCL_DECLARED
-#define TclDeleteVars_TCL_DECLARED
+EXTERN void TclDeleteCompiledLocalVars(Interp *iPtr,
+ CallFrame *framePtr);
/* 12 */
-EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr,
- Tcl_HashTable * tablePtr));
-#endif
+EXTERN void TclDeleteVars(Interp *iPtr,
+ TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
-#ifndef TclDumpMemoryInfo_TCL_DECLARED
-#define TclDumpMemoryInfo_TCL_DECLARED
/* 14 */
-EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
-#endif
+EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags);
/* Slot 15 is reserved */
-#ifndef TclExprFloatError_TCL_DECLARED
-#define TclExprFloatError_TCL_DECLARED
/* 16 */
-EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp,
- double value));
-#endif
+EXTERN void TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
-#ifndef TclFindElement_TCL_DECLARED
-#define TclFindElement_TCL_DECLARED
/* 22 */
-EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * listStr, int listLength,
- CONST char ** elementPtr,
- CONST char ** nextPtr, int * sizePtr,
- int * bracePtr));
-#endif
-#ifndef TclFindProc_TCL_DECLARED
-#define TclFindProc_TCL_DECLARED
+EXTERN int TclFindElement(Tcl_Interp *interp,
+ const char *listStr, int listLength,
+ const char **elementPtr,
+ const char **nextPtr, int *sizePtr,
+ int *bracePtr);
/* 23 */
-EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp * iPtr,
- CONST char * procName));
-#endif
-/* Slot 24 is reserved */
-#ifndef TclFreePackageInfo_TCL_DECLARED
-#define TclFreePackageInfo_TCL_DECLARED
+EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName);
+/* 24 */
+EXTERN int TclFormatInt(char *buffer, long n);
/* 25 */
-EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp * iPtr));
-#endif
+EXTERN void TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
-#ifndef TclpGetDefaultStdChannel_TCL_DECLARED
-#define TclpGetDefaultStdChannel_TCL_DECLARED
/* 28 */
-EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
-#endif
+EXTERN Tcl_Channel TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
/* Slot 30 is reserved */
-#ifndef TclGetExtension_TCL_DECLARED
-#define TclGetExtension_TCL_DECLARED
/* 31 */
-EXTERN CONST char * TclGetExtension _ANSI_ARGS_((CONST char * name));
-#endif
-#ifndef TclGetFrame_TCL_DECLARED
-#define TclGetFrame_TCL_DECLARED
+EXTERN const char * TclGetExtension(const char *name);
/* 32 */
-EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * str, CallFrame ** framePtrPtr));
-#endif
+EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str,
+ CallFrame **framePtrPtr);
/* Slot 33 is reserved */
-#ifndef TclGetIntForIndex_TCL_DECLARED
-#define TclGetIntForIndex_TCL_DECLARED
/* 34 */
-EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, int endValue,
- int * indexPtr));
-#endif
+EXTERN int TclGetIntForIndex(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int endValue, int *indexPtr);
/* Slot 35 is reserved */
-#ifndef TclGetLong_TCL_DECLARED
-#define TclGetLong_TCL_DECLARED
-/* 36 */
-EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * str, long * longPtr));
-#endif
-#ifndef TclGetLoadedPackages_TCL_DECLARED
-#define TclGetLoadedPackages_TCL_DECLARED
+/* Slot 36 is reserved */
/* 37 */
-EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
- Tcl_Interp * interp, char * targetName));
-#endif
-#ifndef TclGetNamespaceForQualName_TCL_DECLARED
-#define TclGetNamespaceForQualName_TCL_DECLARED
+EXTERN int TclGetLoadedPackages(Tcl_Interp *interp,
+ const char *targetName);
/* 38 */
-EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * qualName,
- Namespace * cxtNsPtr, int flags,
- Namespace ** nsPtrPtr,
- Namespace ** altNsPtrPtr,
- Namespace ** actualCxtPtrPtr,
- CONST char ** simpleNamePtr));
-#endif
-#ifndef TclGetObjInterpProc_TCL_DECLARED
-#define TclGetObjInterpProc_TCL_DECLARED
+EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp,
+ const char *qualName, Namespace *cxtNsPtr,
+ int flags, Namespace **nsPtrPtr,
+ Namespace **altNsPtrPtr,
+ Namespace **actualCxtPtrPtr,
+ const char **simpleNamePtr);
/* 39 */
-EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
-#endif
-#ifndef TclGetOpenMode_TCL_DECLARED
-#define TclGetOpenMode_TCL_DECLARED
+EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
/* 40 */
-EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * str, int * seekFlagPtr));
-#endif
-#ifndef TclGetOriginalCommand_TCL_DECLARED
-#define TclGetOriginalCommand_TCL_DECLARED
+EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str,
+ int *seekFlagPtr);
/* 41 */
-EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
- Tcl_Command command));
-#endif
-#ifndef TclpGetUserHome_TCL_DECLARED
-#define TclpGetUserHome_TCL_DECLARED
+EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
/* 42 */
-EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name,
- Tcl_DString * bufferPtr));
-#endif
+EXTERN CONST86 char * TclpGetUserHome(const char *name,
+ Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
-#ifndef TclGuessPackageName_TCL_DECLARED
-#define TclGuessPackageName_TCL_DECLARED
/* 44 */
-EXTERN int TclGuessPackageName _ANSI_ARGS_((
- CONST char * fileName, Tcl_DString * bufPtr));
-#endif
-#ifndef TclHideUnsafeCommands_TCL_DECLARED
-#define TclHideUnsafeCommands_TCL_DECLARED
+EXTERN int TclGuessPackageName(const char *fileName,
+ Tcl_DString *bufPtr);
/* 45 */
-EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef TclInExit_TCL_DECLARED
-#define TclInExit_TCL_DECLARED
+EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
-EXTERN int TclInExit _ANSI_ARGS_((void));
-#endif
+EXTERN int TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
-#ifndef TclIncrVar2_TCL_DECLARED
-#define TclIncrVar2_TCL_DECLARED
-/* 49 */
-EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
- long incrAmount, int part1NotParsed));
-#endif
-#ifndef TclInitCompiledLocals_TCL_DECLARED
-#define TclInitCompiledLocals_TCL_DECLARED
+/* Slot 49 is reserved */
/* 50 */
-EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
- Tcl_Interp * interp, CallFrame * framePtr,
- Namespace * nsPtr));
-#endif
-#ifndef TclInterpInit_TCL_DECLARED
-#define TclInterpInit_TCL_DECLARED
+EXTERN void TclInitCompiledLocals(Tcl_Interp *interp,
+ CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
-EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
+EXTERN int TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
-#ifndef TclInvokeObjectCommand_TCL_DECLARED
-#define TclInvokeObjectCommand_TCL_DECLARED
/* 53 */
-EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp * interp,
- int argc, CONST84 char ** argv));
-#endif
-#ifndef TclInvokeStringCommand_TCL_DECLARED
-#define TclInvokeStringCommand_TCL_DECLARED
+EXTERN int TclInvokeObjectCommand(ClientData clientData,
+ Tcl_Interp *interp, int argc,
+ CONST84 char **argv);
/* 54 */
-EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp * interp,
- int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef TclIsProc_TCL_DECLARED
-#define TclIsProc_TCL_DECLARED
+EXTERN int TclInvokeStringCommand(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
/* 55 */
-EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr));
-#endif
+EXTERN Proc * TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
-#ifndef TclLookupVar_TCL_DECLARED
-#define TclLookupVar_TCL_DECLARED
/* 58 */
-EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- int flags, CONST char * msg, int createPart1,
- int createPart2, Var ** arrayPtrPtr));
-#endif
+EXTERN Var * TclLookupVar(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags,
+ const char *msg, int createPart1,
+ int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
-#ifndef TclNeedSpace_TCL_DECLARED
-#define TclNeedSpace_TCL_DECLARED
/* 60 */
-EXTERN int TclNeedSpace _ANSI_ARGS_((CONST char * start,
- CONST char * end));
-#endif
-#ifndef TclNewProcBodyObj_TCL_DECLARED
-#define TclNewProcBodyObj_TCL_DECLARED
+EXTERN int TclNeedSpace(const char *start, const char *end);
/* 61 */
-EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc * procPtr));
-#endif
-#ifndef TclObjCommandComplete_TCL_DECLARED
-#define TclObjCommandComplete_TCL_DECLARED
+EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr);
/* 62 */
-EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj * cmdPtr));
-#endif
-#ifndef TclObjInterpProc_TCL_DECLARED
-#define TclObjInterpProc_TCL_DECLARED
+EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
-EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef TclObjInvoke_TCL_DECLARED
-#define TclObjInvoke_TCL_DECLARED
+EXTERN int TclObjInterpProc(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
/* 64 */
-EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp * interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-#endif
+EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
-#ifndef TclOpenFileChannelDeleteProc_TCL_DECLARED
-#define TclOpenFileChannelDeleteProc_TCL_DECLARED
-/* 66 */
-EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ * proc));
-#endif
-#ifndef TclOpenFileChannelInsertProc_TCL_DECLARED
-#define TclOpenFileChannelInsertProc_TCL_DECLARED
-/* 67 */
-EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ * proc));
-#endif
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
/* Slot 68 is reserved */
-#ifndef TclpAlloc_TCL_DECLARED
-#define TclpAlloc_TCL_DECLARED
/* 69 */
-EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
-#endif
+EXTERN char * TclpAlloc(unsigned int size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
-#ifndef TclpFree_TCL_DECLARED
-#define TclpFree_TCL_DECLARED
/* 74 */
-EXTERN void TclpFree _ANSI_ARGS_((char * ptr));
-#endif
-#ifndef TclpGetClicks_TCL_DECLARED
-#define TclpGetClicks_TCL_DECLARED
+EXTERN void TclpFree(char *ptr);
/* 75 */
-EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
-#endif
-#ifndef TclpGetSeconds_TCL_DECLARED
-#define TclpGetSeconds_TCL_DECLARED
+EXTERN unsigned long TclpGetClicks(void);
/* 76 */
-EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
-#endif
-#ifndef TclpGetTime_TCL_DECLARED
-#define TclpGetTime_TCL_DECLARED
+EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
-EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time));
-#endif
-#ifndef TclpGetTimeZone_TCL_DECLARED
-#define TclpGetTimeZone_TCL_DECLARED
-/* 78 */
-EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-#endif
+EXTERN void TclpGetTime(Tcl_Time *time);
+/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
-#ifndef TclpRealloc_TCL_DECLARED
-#define TclpRealloc_TCL_DECLARED
/* 81 */
-EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr,
- unsigned int size));
-#endif
+EXTERN char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
-#ifndef TclPrecTraceProc_TCL_DECLARED
-#define TclPrecTraceProc_TCL_DECLARED
/* 88 */
-EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, CONST char * name1,
- CONST char * name2, int flags));
-#endif
-#ifndef TclPreventAliasLoop_TCL_DECLARED
-#define TclPreventAliasLoop_TCL_DECLARED
+EXTERN char * TclPrecTraceProc(ClientData clientData,
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
/* 89 */
-EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Interp * cmdInterp, Tcl_Command cmd));
-#endif
+EXTERN int TclPreventAliasLoop(Tcl_Interp *interp,
+ Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
-#ifndef TclProcCleanupProc_TCL_DECLARED
-#define TclProcCleanupProc_TCL_DECLARED
/* 91 */
-EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc * procPtr));
-#endif
-#ifndef TclProcCompileProc_TCL_DECLARED
-#define TclProcCompileProc_TCL_DECLARED
+EXTERN void TclProcCleanupProc(Proc *procPtr);
/* 92 */
-EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp,
- Proc * procPtr, Tcl_Obj * bodyPtr,
- Namespace * nsPtr, CONST char * description,
- CONST char * procName));
-#endif
-#ifndef TclProcDeleteProc_TCL_DECLARED
-#define TclProcDeleteProc_TCL_DECLARED
+EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
+ Tcl_Obj *bodyPtr, Namespace *nsPtr,
+ const char *description,
+ const char *procName);
/* 93 */
-EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
-#endif
+EXTERN void TclProcDeleteProc(ClientData clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
-#ifndef TclRenameCommand_TCL_DECLARED
-#define TclRenameCommand_TCL_DECLARED
/* 96 */
-EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * oldName, char * newName));
-#endif
-#ifndef TclResetShadowedCmdRefs_TCL_DECLARED
-#define TclResetShadowedCmdRefs_TCL_DECLARED
+EXTERN int TclRenameCommand(Tcl_Interp *interp,
+ const char *oldName, const char *newName);
/* 97 */
-EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
- Tcl_Interp * interp, Command * newCmdPtr));
-#endif
-#ifndef TclServiceIdle_TCL_DECLARED
-#define TclServiceIdle_TCL_DECLARED
+EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp,
+ Command *newCmdPtr);
/* 98 */
-EXTERN int TclServiceIdle _ANSI_ARGS_((void));
-#endif
+EXTERN int TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
-#ifndef TclSetPreInitScript_TCL_DECLARED
-#define TclSetPreInitScript_TCL_DECLARED
/* 101 */
-EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
-#endif
-#ifndef TclSetupEnv_TCL_DECLARED
-#define TclSetupEnv_TCL_DECLARED
+EXTERN CONST86 char * TclSetPreInitScript(const char *string);
/* 102 */
-EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef TclSockGetPort_TCL_DECLARED
-#define TclSockGetPort_TCL_DECLARED
+EXTERN void TclSetupEnv(Tcl_Interp *interp);
/* 103 */
-EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, char * proto, int * portPtr));
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclSockMinimumBuffers_TCL_DECLARED
-#define TclSockMinimumBuffers_TCL_DECLARED
+EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
+ const char *proto, int *portPtr);
/* 104 */
-EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
- int size));
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclSockMinimumBuffers_TCL_DECLARED
-#define TclSockMinimumBuffers_TCL_DECLARED
-/* 104 */
-EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
- int size));
-#endif
-#endif /* __WIN32__ */
+EXTERN int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
-#ifndef TclStatDeleteProc_TCL_DECLARED
-#define TclStatDeleteProc_TCL_DECLARED
-/* 106 */
-EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc));
-#endif
-#ifndef TclStatInsertProc_TCL_DECLARED
-#define TclStatInsertProc_TCL_DECLARED
-/* 107 */
-EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ * proc));
-#endif
-#ifndef TclTeardownNamespace_TCL_DECLARED
-#define TclTeardownNamespace_TCL_DECLARED
+/* Slot 106 is reserved */
+/* Slot 107 is reserved */
/* 108 */
-EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace * nsPtr));
-#endif
-#ifndef TclUpdateReturnInfo_TCL_DECLARED
-#define TclUpdateReturnInfo_TCL_DECLARED
+EXTERN void TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
-EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp * iPtr));
-#endif
-/* Slot 110 is reserved */
-#ifndef Tcl_AddInterpResolvers_TCL_DECLARED
-#define Tcl_AddInterpResolvers_TCL_DECLARED
+EXTERN int TclUpdateReturnInfo(Interp *iPtr);
+/* 110 */
+EXTERN int TclSockMinimumBuffers(void *sock, int size);
/* 111 */
-EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- Tcl_ResolveCmdProc * cmdProc,
- Tcl_ResolveVarProc * varProc,
- Tcl_ResolveCompiledVarProc * compiledVarProc));
-#endif
-#ifndef Tcl_AppendExportList_TCL_DECLARED
-#define Tcl_AppendExportList_TCL_DECLARED
+EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
+ const char *name,
+ Tcl_ResolveCmdProc *cmdProc,
+ Tcl_ResolveVarProc *varProc,
+ Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
-EXTERN int Tcl_AppendExportList _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Namespace * nsPtr,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_CreateNamespace_TCL_DECLARED
-#define Tcl_CreateNamespace_TCL_DECLARED
+EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
-EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, ClientData clientData,
- Tcl_NamespaceDeleteProc * deleteProc));
-#endif
-#ifndef Tcl_DeleteNamespace_TCL_DECLARED
-#define Tcl_DeleteNamespace_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
+ const char *name, ClientData clientData,
+ Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
-EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((
- Tcl_Namespace * nsPtr));
-#endif
-#ifndef Tcl_Export_TCL_DECLARED
-#define Tcl_Export_TCL_DECLARED
+EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
-EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern,
- int resetListFirst));
-#endif
-#ifndef Tcl_FindCommand_TCL_DECLARED
-#define Tcl_FindCommand_TCL_DECLARED
+EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ const char *pattern, int resetListFirst);
/* 116 */
-EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_Namespace * contextNsPtr, int flags));
-#endif
-#ifndef Tcl_FindNamespace_TCL_DECLARED
-#define Tcl_FindNamespace_TCL_DECLARED
+EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+ Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
-EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name,
- Tcl_Namespace * contextNsPtr, int flags));
-#endif
-#ifndef Tcl_GetInterpResolvers_TCL_DECLARED
-#define Tcl_GetInterpResolvers_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *contextNsPtr, int flags);
/* 118 */
-EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- Tcl_ResolverInfo * resInfo));
-#endif
-#ifndef Tcl_GetNamespaceResolvers_TCL_DECLARED
-#define Tcl_GetNamespaceResolvers_TCL_DECLARED
+EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp,
+ const char *name, Tcl_ResolverInfo *resInfo);
/* 119 */
-EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_((
- Tcl_Namespace * namespacePtr,
- Tcl_ResolverInfo * resInfo));
-#endif
-#ifndef Tcl_FindNamespaceVar_TCL_DECLARED
-#define Tcl_FindNamespaceVar_TCL_DECLARED
+EXTERN int Tcl_GetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,
+ Tcl_ResolverInfo *resInfo);
/* 120 */
-EXTERN Tcl_Var Tcl_FindNamespaceVar _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name,
- Tcl_Namespace * contextNsPtr, int flags));
-#endif
-#ifndef Tcl_ForgetImport_TCL_DECLARED
-#define Tcl_ForgetImport_TCL_DECLARED
+EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
-EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern));
-#endif
-#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
-#define Tcl_GetCommandFromObj_TCL_DECLARED
+EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
-EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetCommandFullName_TCL_DECLARED
-#define Tcl_GetCommandFullName_TCL_DECLARED
+EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
/* 123 */
-EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Command command,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
-#define Tcl_GetCurrentNamespace_TCL_DECLARED
+EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
+ Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
-EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
-#define Tcl_GetGlobalNamespace_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
/* 125 */
-EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_((
- Tcl_Interp * interp));
-#endif
-#ifndef Tcl_GetVariableFullName_TCL_DECLARED
-#define Tcl_GetVariableFullName_TCL_DECLARED
+EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
/* 126 */
-EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Var variable,
- Tcl_Obj * objPtr));
-#endif
-#ifndef Tcl_Import_TCL_DECLARED
-#define Tcl_Import_TCL_DECLARED
+EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
+ Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
-EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, CONST char * pattern,
- int allowOverwrite));
-#endif
-#ifndef Tcl_PopCallFrame_TCL_DECLARED
-#define Tcl_PopCallFrame_TCL_DECLARED
+EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ const char *pattern, int allowOverwrite);
/* 128 */
-EXTERN void Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Tcl_PushCallFrame_TCL_DECLARED
-#define Tcl_PushCallFrame_TCL_DECLARED
+EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
-EXTERN int Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_CallFrame * framePtr,
- Tcl_Namespace * nsPtr, int isProcCallFrame));
-#endif
-#ifndef Tcl_RemoveInterpResolvers_TCL_DECLARED
-#define Tcl_RemoveInterpResolvers_TCL_DECLARED
+EXTERN int Tcl_PushCallFrame(Tcl_Interp *interp,
+ Tcl_CallFrame *framePtr,
+ Tcl_Namespace *nsPtr, int isProcCallFrame);
/* 130 */
-EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * name));
-#endif
-#ifndef Tcl_SetNamespaceResolvers_TCL_DECLARED
-#define Tcl_SetNamespaceResolvers_TCL_DECLARED
+EXTERN int Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
+ const char *name);
/* 131 */
-EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_((
- Tcl_Namespace * namespacePtr,
- Tcl_ResolveCmdProc * cmdProc,
- Tcl_ResolveVarProc * varProc,
- Tcl_ResolveCompiledVarProc * compiledVarProc));
-#endif
-#ifndef TclpHasSockets_TCL_DECLARED
-#define TclpHasSockets_TCL_DECLARED
+EXTERN void Tcl_SetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,
+ Tcl_ResolveCmdProc *cmdProc,
+ Tcl_ResolveVarProc *varProc,
+ Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
-EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef TclpGetDate_TCL_DECLARED
-#define TclpGetDate_TCL_DECLARED
+EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
-EXTERN struct tm * TclpGetDate _ANSI_ARGS_((CONST time_t * time,
- int useGMT));
-#endif
+EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
-#ifndef TclGetEnv_TCL_DECLARED
-#define TclGetEnv_TCL_DECLARED
/* 138 */
-EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char * name,
- Tcl_DString * valuePtr));
-#endif
+EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
+ Tcl_DString *valuePtr);
/* Slot 139 is reserved */
-#ifndef TclLooksLikeInt_TCL_DECLARED
-#define TclLooksLikeInt_TCL_DECLARED
-/* 140 */
-EXTERN int TclLooksLikeInt _ANSI_ARGS_((CONST char * bytes,
- int length));
-#endif
-#ifndef TclpGetCwd_TCL_DECLARED
-#define TclpGetCwd_TCL_DECLARED
+/* Slot 140 is reserved */
/* 141 */
-EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_DString * cwdPtr));
-#endif
-#ifndef TclSetByteCodeFromAny_TCL_DECLARED
-#define TclSetByteCodeFromAny_TCL_DECLARED
+EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
+ Tcl_DString *cwdPtr);
/* 142 */
-EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * objPtr,
- CompileHookProc * hookProc,
- ClientData clientData));
-#endif
-#ifndef TclAddLiteralObj_TCL_DECLARED
-#define TclAddLiteralObj_TCL_DECLARED
+EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, CompileHookProc *hookProc,
+ ClientData clientData);
/* 143 */
-EXTERN int TclAddLiteralObj _ANSI_ARGS_((
- struct CompileEnv * envPtr, Tcl_Obj * objPtr,
- LiteralEntry ** litPtrPtr));
-#endif
-#ifndef TclHideLiteral_TCL_DECLARED
-#define TclHideLiteral_TCL_DECLARED
+EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr,
+ Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
-EXTERN void TclHideLiteral _ANSI_ARGS_((Tcl_Interp * interp,
- struct CompileEnv * envPtr, int index));
-#endif
-#ifndef TclGetAuxDataType_TCL_DECLARED
-#define TclGetAuxDataType_TCL_DECLARED
+EXTERN void TclHideLiteral(Tcl_Interp *interp,
+ struct CompileEnv *envPtr, int index);
/* 145 */
-EXTERN struct AuxDataType * TclGetAuxDataType _ANSI_ARGS_((char * typeName));
-#endif
-#ifndef TclHandleCreate_TCL_DECLARED
-#define TclHandleCreate_TCL_DECLARED
+EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
-EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID * ptr));
-#endif
-#ifndef TclHandleFree_TCL_DECLARED
-#define TclHandleFree_TCL_DECLARED
+EXTERN TclHandle TclHandleCreate(void *ptr);
/* 147 */
-EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle));
-#endif
-#ifndef TclHandlePreserve_TCL_DECLARED
-#define TclHandlePreserve_TCL_DECLARED
+EXTERN void TclHandleFree(TclHandle handle);
/* 148 */
-EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
-#endif
-#ifndef TclHandleRelease_TCL_DECLARED
-#define TclHandleRelease_TCL_DECLARED
+EXTERN TclHandle TclHandlePreserve(TclHandle handle);
/* 149 */
-EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
-#endif
-#ifndef TclRegAbout_TCL_DECLARED
-#define TclRegAbout_TCL_DECLARED
+EXTERN void TclHandleRelease(TclHandle handle);
/* 150 */
-EXTERN int TclRegAbout _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_RegExp re));
-#endif
-#ifndef TclRegExpRangeUniChar_TCL_DECLARED
-#define TclRegExpRangeUniChar_TCL_DECLARED
+EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
-EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
- int index, int * startPtr, int * endPtr));
-#endif
-#ifndef TclSetLibraryPath_TCL_DECLARED
-#define TclSetLibraryPath_TCL_DECLARED
+EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index,
+ int *startPtr, int *endPtr);
/* 152 */
-EXTERN void TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef TclGetLibraryPath_TCL_DECLARED
-#define TclGetLibraryPath_TCL_DECLARED
+EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
-EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void));
-#endif
+EXTERN Tcl_Obj * TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
-#ifndef TclRegError_TCL_DECLARED
-#define TclRegError_TCL_DECLARED
/* 156 */
-EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * msg, int status));
-#endif
-#ifndef TclVarTraceExists_TCL_DECLARED
-#define TclVarTraceExists_TCL_DECLARED
+EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
+ int status);
/* 157 */
-EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * varName));
-#endif
-#ifndef TclSetStartupScriptFileName_TCL_DECLARED
-#define TclSetStartupScriptFileName_TCL_DECLARED
+EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
+ const char *varName);
/* 158 */
-EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
- CONST char * filename));
-#endif
-#ifndef TclGetStartupScriptFileName_TCL_DECLARED
-#define TclGetStartupScriptFileName_TCL_DECLARED
+EXTERN void TclSetStartupScriptFileName(const char *filename);
/* 159 */
-EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
-#endif
+EXTERN const char * TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
-#ifndef TclChannelTransform_TCL_DECLARED
-#define TclChannelTransform_TCL_DECLARED
/* 161 */
-EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan, Tcl_Obj * cmdObjPtr));
-#endif
-#ifndef TclChannelEventScriptInvoker_TCL_DECLARED
-#define TclChannelEventScriptInvoker_TCL_DECLARED
+EXTERN int TclChannelTransform(Tcl_Interp *interp,
+ Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
-EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_((
- ClientData clientData, int flags));
-#endif
-#ifndef TclGetInstructionTable_TCL_DECLARED
-#define TclGetInstructionTable_TCL_DECLARED
+EXTERN void TclChannelEventScriptInvoker(ClientData clientData,
+ int flags);
/* 163 */
-EXTERN void * TclGetInstructionTable _ANSI_ARGS_((void));
-#endif
-#ifndef TclExpandCodeArray_TCL_DECLARED
-#define TclExpandCodeArray_TCL_DECLARED
+EXTERN const void * TclGetInstructionTable(void);
/* 164 */
-EXTERN void TclExpandCodeArray _ANSI_ARGS_((void * envPtr));
-#endif
-#ifndef TclpSetInitialEncodings_TCL_DECLARED
-#define TclpSetInitialEncodings_TCL_DECLARED
+EXTERN void TclExpandCodeArray(void *envPtr);
/* 165 */
-EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void));
-#endif
-#ifndef TclListObjSetElement_TCL_DECLARED
-#define TclListObjSetElement_TCL_DECLARED
+EXTERN void TclpSetInitialEncodings(void);
/* 166 */
-EXTERN int TclListObjSetElement _ANSI_ARGS_((
- Tcl_Interp * interp, Tcl_Obj * listPtr,
- int index, Tcl_Obj * valuePtr));
-#endif
-#ifndef TclSetStartupScriptPath_TCL_DECLARED
-#define TclSetStartupScriptPath_TCL_DECLARED
+EXTERN int TclListObjSetElement(Tcl_Interp *interp,
+ Tcl_Obj *listPtr, int index,
+ Tcl_Obj *valuePtr);
/* 167 */
-EXTERN void TclSetStartupScriptPath _ANSI_ARGS_((
- Tcl_Obj * pathPtr));
-#endif
-#ifndef TclGetStartupScriptPath_TCL_DECLARED
-#define TclGetStartupScriptPath_TCL_DECLARED
+EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
-EXTERN Tcl_Obj * TclGetStartupScriptPath _ANSI_ARGS_((void));
-#endif
-#ifndef TclpUtfNcmp2_TCL_DECLARED
-#define TclpUtfNcmp2_TCL_DECLARED
+EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
/* 169 */
-EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((CONST char * s1,
- CONST char * s2, unsigned long n));
-#endif
-#ifndef TclCheckInterpTraces_TCL_DECLARED
-#define TclCheckInterpTraces_TCL_DECLARED
+EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
+ unsigned long n);
/* 170 */
-EXTERN int TclCheckInterpTraces _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * command,
- int numChars, Command * cmdPtr, int result,
- int traceFlags, int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef TclCheckExecutionTraces_TCL_DECLARED
-#define TclCheckExecutionTraces_TCL_DECLARED
+EXTERN int TclCheckInterpTraces(Tcl_Interp *interp,
+ const char *command, int numChars,
+ Command *cmdPtr, int result, int traceFlags,
+ int objc, Tcl_Obj *const objv[]);
/* 171 */
-EXTERN int TclCheckExecutionTraces _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * command,
- int numChars, Command * cmdPtr, int result,
- int traceFlags, int objc,
- Tcl_Obj *CONST objv[]));
-#endif
-#ifndef TclInThreadExit_TCL_DECLARED
-#define TclInThreadExit_TCL_DECLARED
+EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp,
+ const char *command, int numChars,
+ Command *cmdPtr, int result, int traceFlags,
+ int objc, Tcl_Obj *const objv[]);
/* 172 */
-EXTERN int TclInThreadExit _ANSI_ARGS_((void));
-#endif
-#ifndef TclUniCharMatch_TCL_DECLARED
-#define TclUniCharMatch_TCL_DECLARED
+EXTERN int TclInThreadExit(void);
/* 173 */
-EXTERN int TclUniCharMatch _ANSI_ARGS_((
- CONST Tcl_UniChar * string, int strLen,
- CONST Tcl_UniChar * pattern, int ptnLen,
- int nocase));
-#endif
-#ifndef TclIncrWideVar2_TCL_DECLARED
-#define TclIncrWideVar2_TCL_DECLARED
-/* 174 */
-EXTERN Tcl_Obj * TclIncrWideVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
- Tcl_WideInt wideIncrAmount,
- int part1NotParsed));
-#endif
-#ifndef TclCallVarTraces_TCL_DECLARED
-#define TclCallVarTraces_TCL_DECLARED
+EXTERN int TclUniCharMatch(const Tcl_UniChar *string,
+ int strLen, const Tcl_UniChar *pattern,
+ int ptnLen, int flags);
+/* Slot 174 is reserved */
/* 175 */
-EXTERN int TclCallVarTraces _ANSI_ARGS_((Interp * iPtr,
- Var * arrayPtr, Var * varPtr,
- CONST char * part1, CONST char * part2,
- int flags, int leaveErrMsg));
-#endif
-#ifndef TclCleanupVar_TCL_DECLARED
-#define TclCleanupVar_TCL_DECLARED
+EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
+ Var *varPtr, const char *part1,
+ const char *part2, int flags,
+ int leaveErrMsg);
/* 176 */
-EXTERN void TclCleanupVar _ANSI_ARGS_((Var * varPtr,
- Var * arrayPtr));
-#endif
-#ifndef TclVarErrMsg_TCL_DECLARED
-#define TclVarErrMsg_TCL_DECLARED
+EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr);
/* 177 */
-EXTERN void TclVarErrMsg _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * part1, CONST char * part2,
- CONST char * operation, CONST char * reason));
-#endif
-#ifndef Tcl_SetStartupScript_TCL_DECLARED
-#define Tcl_SetStartupScript_TCL_DECLARED
+EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
+ const char *part2, const char *operation,
+ const char *reason);
/* 178 */
-EXTERN void Tcl_SetStartupScript _ANSI_ARGS_((Tcl_Obj * pathPtr,
- CONST char* encodingName));
-#endif
-#ifndef Tcl_GetStartupScript_TCL_DECLARED
-#define Tcl_GetStartupScript_TCL_DECLARED
+EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr,
+ const char *encodingName);
/* 179 */
-EXTERN Tcl_Obj * Tcl_GetStartupScript _ANSI_ARGS_((
- CONST char ** encodingNamePtr));
-#endif
+EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
-#ifndef TclpLocaltime_TCL_DECLARED
-#define TclpLocaltime_TCL_DECLARED
/* 182 */
-EXTERN struct tm * TclpLocaltime _ANSI_ARGS_((CONST time_t * clock));
-#endif
-#ifndef TclpGmtime_TCL_DECLARED
-#define TclpGmtime_TCL_DECLARED
+EXTERN struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
-EXTERN struct tm * TclpGmtime _ANSI_ARGS_((CONST time_t * clock));
-#endif
+EXTERN struct tm * TclpGmtime(const time_t *clock);
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -938,1031 +480,719 @@ EXTERN struct tm * TclpGmtime _ANSI_ARGS_((CONST time_t * clock));
/* Slot 194 is reserved */
/* Slot 195 is reserved */
/* Slot 196 is reserved */
-#ifndef TclCompEvalObj_TCL_DECLARED
-#define TclCompEvalObj_TCL_DECLARED
-/* 197 */
-EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr));
-#endif
-#ifndef TclObjGetFrame_TCL_DECLARED
-#define TclObjGetFrame_TCL_DECLARED
+/* Slot 197 is reserved */
/* 198 */
-EXTERN int TclObjGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, CallFrame ** framePtrPtr));
-#endif
+EXTERN int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ CallFrame **framePtrPtr);
/* Slot 199 is reserved */
-#ifndef TclpObjRemoveDirectory_TCL_DECLARED
-#define TclpObjRemoveDirectory_TCL_DECLARED
/* 200 */
-EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_((
- Tcl_Obj * pathPtr, int recursive,
- Tcl_Obj ** errorPtr));
-#endif
-#ifndef TclpObjCopyDirectory_TCL_DECLARED
-#define TclpObjCopyDirectory_TCL_DECLARED
+EXTERN int TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
+ int recursive, Tcl_Obj **errorPtr);
/* 201 */
-EXTERN int TclpObjCopyDirectory _ANSI_ARGS_((
- Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr,
- Tcl_Obj ** errorPtr));
-#endif
-#ifndef TclpObjCreateDirectory_TCL_DECLARED
-#define TclpObjCreateDirectory_TCL_DECLARED
+EXTERN int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
/* 202 */
-EXTERN int TclpObjCreateDirectory _ANSI_ARGS_((
- Tcl_Obj * pathPtr));
-#endif
-#ifndef TclpObjDeleteFile_TCL_DECLARED
-#define TclpObjDeleteFile_TCL_DECLARED
+EXTERN int TclpObjCreateDirectory(Tcl_Obj *pathPtr);
/* 203 */
-EXTERN int TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj * pathPtr));
-#endif
-#ifndef TclpObjCopyFile_TCL_DECLARED
-#define TclpObjCopyFile_TCL_DECLARED
+EXTERN int TclpObjDeleteFile(Tcl_Obj *pathPtr);
/* 204 */
-EXTERN int TclpObjCopyFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
- Tcl_Obj * destPathPtr));
-#endif
-#ifndef TclpObjRenameFile_TCL_DECLARED
-#define TclpObjRenameFile_TCL_DECLARED
+EXTERN int TclpObjCopyFile(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr);
/* 205 */
-EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
- Tcl_Obj * destPathPtr));
-#endif
-#ifndef TclpObjStat_TCL_DECLARED
-#define TclpObjStat_TCL_DECLARED
+EXTERN int TclpObjRenameFile(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr);
/* 206 */
-EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj * pathPtr,
- Tcl_StatBuf * buf));
-#endif
-#ifndef TclpObjAccess_TCL_DECLARED
-#define TclpObjAccess_TCL_DECLARED
+EXTERN int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 207 */
-EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj * pathPtr,
- int mode));
-#endif
-#ifndef TclpOpenFileChannel_TCL_DECLARED
-#define TclpOpenFileChannel_TCL_DECLARED
+EXTERN int TclpObjAccess(Tcl_Obj *pathPtr, int mode);
/* 208 */
-EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * pathPtr, int mode, int permissions));
-#endif
-#ifndef TclGetEncodingSearchPath_TCL_DECLARED
-#define TclGetEncodingSearchPath_TCL_DECLARED
-/* 209 */
-EXTERN Tcl_Obj * TclGetEncodingSearchPath _ANSI_ARGS_((void));
-#endif
-#ifndef TclSetEncodingSearchPath_TCL_DECLARED
-#define TclSetEncodingSearchPath_TCL_DECLARED
-/* 210 */
-EXTERN int TclSetEncodingSearchPath _ANSI_ARGS_((
- Tcl_Obj * searchPath));
-#endif
-#ifndef TclpGetEncodingNameFromEnvironment_TCL_DECLARED
-#define TclpGetEncodingNameFromEnvironment_TCL_DECLARED
-/* 211 */
-EXTERN CONST char * TclpGetEncodingNameFromEnvironment _ANSI_ARGS_((
- Tcl_DString * bufPtr));
-#endif
-#ifndef TclpFindExecutable_TCL_DECLARED
-#define TclpFindExecutable_TCL_DECLARED
+EXTERN Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int mode, int permissions);
+/* Slot 209 is reserved */
+/* Slot 210 is reserved */
+/* Slot 211 is reserved */
/* 212 */
-EXTERN void TclpFindExecutable _ANSI_ARGS_((CONST char * argv0));
-#endif
-#ifndef TclGetObjNameOfExecutable_TCL_DECLARED
-#define TclGetObjNameOfExecutable_TCL_DECLARED
+EXTERN void TclpFindExecutable(const char *argv0);
/* 213 */
-EXTERN Tcl_Obj * TclGetObjNameOfExecutable _ANSI_ARGS_((void));
-#endif
-#ifndef TclSetObjNameOfExecutable_TCL_DECLARED
-#define TclSetObjNameOfExecutable_TCL_DECLARED
+EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void);
/* 214 */
-EXTERN void TclSetObjNameOfExecutable _ANSI_ARGS_((
- Tcl_Obj * name, Tcl_Encoding encoding));
-#endif
-#ifndef TclStackAlloc_TCL_DECLARED
-#define TclStackAlloc_TCL_DECLARED
+EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name,
+ Tcl_Encoding encoding);
/* 215 */
-EXTERN char * TclStackAlloc _ANSI_ARGS_((Tcl_Interp * interp,
- int numBytes));
-#endif
-#ifndef TclStackFree_TCL_DECLARED
-#define TclStackFree_TCL_DECLARED
+EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes);
/* 216 */
-EXTERN void TclStackFree _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef TclPushStackFrame_TCL_DECLARED
-#define TclPushStackFrame_TCL_DECLARED
+EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
-EXTERN int TclPushStackFrame _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_CallFrame ** framePtrPtr,
- Tcl_Namespace * namespacePtr,
- int isProcCallFrame));
-#endif
-#ifndef TclPopStackFrame_TCL_DECLARED
-#define TclPopStackFrame_TCL_DECLARED
+EXTERN int TclPushStackFrame(Tcl_Interp *interp,
+ Tcl_CallFrame **framePtrPtr,
+ Tcl_Namespace *namespacePtr,
+ int isProcCallFrame);
/* 218 */
-EXTERN void TclPopStackFrame _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef TclBN_mp_div_d_TCL_DECLARED
-#define TclBN_mp_div_d_TCL_DECLARED
-/* 219 */
-EXTERN int TclBN_mp_div_d _ANSI_ARGS_((mp_int * a, mp_digit b,
- mp_int * c, mp_digit * d));
-#endif
-#ifndef TclBN_mp_mul_d_TCL_DECLARED
-#define TclBN_mp_mul_d_TCL_DECLARED
-/* 220 */
-EXTERN int TclBN_mp_mul_d _ANSI_ARGS_((mp_int * a, mp_digit b,
- mp_int * c));
-#endif
-#ifndef TclBN_mp_clear_TCL_DECLARED
-#define TclBN_mp_clear_TCL_DECLARED
-/* 221 */
-EXTERN void TclBN_mp_clear _ANSI_ARGS_((mp_int * a));
-#endif
-#ifndef TclBN_mp_init_TCL_DECLARED
-#define TclBN_mp_init_TCL_DECLARED
-/* 222 */
-EXTERN int TclBN_mp_init _ANSI_ARGS_((mp_int * a));
-#endif
-#ifndef TclBN_mp_read_radix_TCL_DECLARED
-#define TclBN_mp_read_radix_TCL_DECLARED
-/* 223 */
-EXTERN int TclBN_mp_read_radix _ANSI_ARGS_((mp_int * a,
- const char * str, int radix));
-#endif
-#ifndef TclGetPlatform_TCL_DECLARED
-#define TclGetPlatform_TCL_DECLARED
+EXTERN void TclPopStackFrame(Tcl_Interp *interp);
+/* Slot 219 is reserved */
+/* Slot 220 is reserved */
+/* Slot 221 is reserved */
+/* Slot 222 is reserved */
+/* Slot 223 is reserved */
/* 224 */
-EXTERN TclPlatformType * TclGetPlatform _ANSI_ARGS_((void));
-#endif
-#ifndef TclTraceDictPath_TCL_DECLARED
-#define TclTraceDictPath_TCL_DECLARED
+EXTERN TclPlatformType * TclGetPlatform(void);
/* 225 */
-EXTERN Tcl_Obj * TclTraceDictPath _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * rootPtr, int keyc,
- Tcl_Obj *CONST keyv[], int flags));
-#endif
+EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp,
+ Tcl_Obj *rootPtr, int keyc,
+ Tcl_Obj *const keyv[], int flags);
+/* 226 */
+EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr);
+/* 227 */
+EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength,
+ Tcl_Namespace *pathAry[]);
+/* Slot 228 is reserved */
+/* 229 */
+EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
+ const char *myName, int myFlags, int index);
+/* 230 */
+EXTERN Var * TclObjLookupVar(Tcl_Interp *interp,
+ Tcl_Obj *part1Ptr, const char *part2,
+ int flags, const char *msg,
+ const int createPart1, const int createPart2,
+ Var **arrayPtrPtr);
+/* 231 */
+EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
+/* 232 */
+EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags, const CmdFrame *invoker, int word);
+/* 233 */
+EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr);
+/* 234 */
+EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
+ const char *key, int *newPtr);
+/* 235 */
+EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
+ Namespace *nsPtr);
+/* 236 */
+EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
+/* 237 */
+EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
+/* 238 */
+EXTERN int TclNRInterpProc(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+/* 239 */
+EXTERN int TclNRInterpProcCore(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj, int skip,
+ ProcErrorProc *errorProc);
+/* 240 */
+EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result,
+ struct NRE_callback *rootPtr);
+/* 241 */
+EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int flags, const CmdFrame *invoker, int word);
+/* 242 */
+EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags,
+ Command *cmdPtr);
+/* 243 */
+EXTERN void TclDbDumpActiveObjects(FILE *outFile);
+/* 244 */
+EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
+/* 245 */
+EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
+/* 246 */
+EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp,
+ int numRemoved, int numInserted,
+ Tcl_Obj *const *objv);
+/* 247 */
+EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp,
+ int isRootEnsemble);
+/* 248 */
+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);
+/* 251 */
+EXTERN int TclRegisterLiteral(void *envPtr, char *bytes,
+ int length, int flags);
typedef struct TclIntStubs {
int magic;
- struct TclIntStubHooks *hooks;
+ void *hooks;
- void *reserved0;
- int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */
- int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */
- void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
- void *reserved4;
-#if !defined(__WIN32__) /* UNIX */
- int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */
-#endif /* UNIX */
-#ifdef __WIN32__
- int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */
-#endif /* __WIN32__ */
- void (*tclCleanupCommand) _ANSI_ARGS_((Command * cmdPtr)); /* 6 */
- int (*tclCopyAndCollapse) _ANSI_ARGS_((int count, CONST char * src, char * dst)); /* 7 */
- int (*tclCopyChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj * cmdPtr)); /* 8 */
-#if !defined(__WIN32__) /* UNIX */
- int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
-#endif /* UNIX */
-#ifdef __WIN32__
- int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
-#endif /* __WIN32__ */
- int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
- void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */
- void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */
- void *reserved13;
- void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
- void *reserved15;
- void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
- void *reserved17;
- void *reserved18;
- void *reserved19;
- void *reserved20;
- void *reserved21;
- int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */
- Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, CONST char * procName)); /* 23 */
- void *reserved24;
- void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */
- void *reserved26;
- void *reserved27;
- Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
- void *reserved29;
- void *reserved30;
- CONST char * (*tclGetExtension) _ANSI_ARGS_((CONST char * name)); /* 31 */
- int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */
- void *reserved33;
- int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
- void *reserved35;
- int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * longPtr)); /* 36 */
- int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp * interp, char * targetName)); /* 37 */
- int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr)); /* 38 */
- TclObjCmdProcType (*tclGetObjInterpProc) _ANSI_ARGS_((void)); /* 39 */
- int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * seekFlagPtr)); /* 40 */
- Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */
- char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */
- void *reserved43;
- int (*tclGuessPackageName) _ANSI_ARGS_((CONST char * fileName, Tcl_DString * bufPtr)); /* 44 */
- int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */
- int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */
- void *reserved47;
- void *reserved48;
- Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */
- void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */
- int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */
- void *reserved52;
- int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 53 */
- int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */
- Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */
- void *reserved56;
- void *reserved57;
- Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */
- void *reserved59;
- int (*tclNeedSpace) _ANSI_ARGS_((CONST char * start, CONST char * end)); /* 60 */
- Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */
- int (*tclObjCommandComplete) _ANSI_ARGS_((Tcl_Obj * cmdPtr)); /* 62 */
- int (*tclObjInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 63 */
- int (*tclObjInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 64 */
- void *reserved65;
- int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */
- int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */
- void *reserved68;
- char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */
- void *reserved70;
- void *reserved71;
- void *reserved72;
- void *reserved73;
- void (*tclpFree) _ANSI_ARGS_((char * ptr)); /* 74 */
- unsigned long (*tclpGetClicks) _ANSI_ARGS_((void)); /* 75 */
- unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */
- void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */
- int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */
- void *reserved79;
- void *reserved80;
- char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */
- void *reserved82;
- void *reserved83;
- void *reserved84;
- void *reserved85;
- void *reserved86;
- void *reserved87;
- char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 88 */
- int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */
- void *reserved90;
- void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */
- int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */
- void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */
- void *reserved94;
- void *reserved95;
- int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */
- void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */
- int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */
- void *reserved99;
- void *reserved100;
- char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
- void (*tclSetupEnv) _ANSI_ARGS_((Tcl_Interp * interp)); /* 102 */
- int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * proto, int * portPtr)); /* 103 */
-#if !defined(__WIN32__) /* UNIX */
- int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */
-#endif /* UNIX */
-#ifdef __WIN32__
- int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */
-#endif /* __WIN32__ */
- void *reserved105;
- int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 106 */
- int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */
- void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace * nsPtr)); /* 108 */
- int (*tclUpdateReturnInfo) _ANSI_ARGS_((Interp * iPtr)); /* 109 */
- void *reserved110;
- void (*tcl_AddInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 111 */
- int (*tcl_AppendExportList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, Tcl_Obj * objPtr)); /* 112 */
- Tcl_Namespace * (*tcl_CreateNamespace) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)); /* 113 */
- void (*tcl_DeleteNamespace) _ANSI_ARGS_((Tcl_Namespace * nsPtr)); /* 114 */
- int (*tcl_Export) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern, int resetListFirst)); /* 115 */
- Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 116 */
- Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 117 */
- int (*tcl_GetInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_ResolverInfo * resInfo)); /* 118 */
- int (*tcl_GetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolverInfo * resInfo)); /* 119 */
- Tcl_Var (*tcl_FindNamespaceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 120 */
- int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern)); /* 121 */
- Tcl_Command (*tcl_GetCommandFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 122 */
- void (*tcl_GetCommandFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command, Tcl_Obj * objPtr)); /* 123 */
- Tcl_Namespace * (*tcl_GetCurrentNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 124 */
- Tcl_Namespace * (*tcl_GetGlobalNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 125 */
- void (*tcl_GetVariableFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Var variable, Tcl_Obj * objPtr)); /* 126 */
- int (*tcl_Import) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, CONST char * pattern, int allowOverwrite)); /* 127 */
- void (*tcl_PopCallFrame) _ANSI_ARGS_((Tcl_Interp * interp)); /* 128 */
- int (*tcl_PushCallFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_CallFrame * framePtr, Tcl_Namespace * nsPtr, int isProcCallFrame)); /* 129 */
- int (*tcl_RemoveInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 130 */
- void (*tcl_SetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 131 */
- int (*tclpHasSockets) _ANSI_ARGS_((Tcl_Interp * interp)); /* 132 */
- struct tm * (*tclpGetDate) _ANSI_ARGS_((CONST time_t * time, int useGMT)); /* 133 */
- void *reserved134;
- void *reserved135;
- void *reserved136;
- void *reserved137;
- CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */
- void *reserved139;
- int (*tclLooksLikeInt) _ANSI_ARGS_((CONST char * bytes, int length)); /* 140 */
- CONST84_RETURN char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */
- int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */
- int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */
- void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */
- struct AuxDataType * (*tclGetAuxDataType) _ANSI_ARGS_((char * typeName)); /* 145 */
- TclHandle (*tclHandleCreate) _ANSI_ARGS_((VOID * ptr)); /* 146 */
- void (*tclHandleFree) _ANSI_ARGS_((TclHandle handle)); /* 147 */
- TclHandle (*tclHandlePreserve) _ANSI_ARGS_((TclHandle handle)); /* 148 */
- void (*tclHandleRelease) _ANSI_ARGS_((TclHandle handle)); /* 149 */
- int (*tclRegAbout) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp re)); /* 150 */
- void (*tclRegExpRangeUniChar) _ANSI_ARGS_((Tcl_RegExp re, int index, int * startPtr, int * endPtr)); /* 151 */
- void (*tclSetLibraryPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 152 */
- Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */
- void *reserved154;
- void *reserved155;
- void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 156 */
- Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 157 */
- void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */
- CONST84_RETURN char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
- void *reserved160;
- int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
- void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
- void * (*tclGetInstructionTable) _ANSI_ARGS_((void)); /* 163 */
- void (*tclExpandCodeArray) _ANSI_ARGS_((void * envPtr)); /* 164 */
- void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 165 */
- int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj * valuePtr)); /* 166 */
- void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */
- Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */
- int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */
- int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */
- int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */
- int (*tclInThreadExit) _ANSI_ARGS_((void)); /* 172 */
- int (*tclUniCharMatch) _ANSI_ARGS_((CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int nocase)); /* 173 */
- Tcl_Obj * (*tclIncrWideVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)); /* 174 */
- int (*tclCallVarTraces) _ANSI_ARGS_((Interp * iPtr, Var * arrayPtr, Var * varPtr, CONST char * part1, CONST char * part2, int flags, int leaveErrMsg)); /* 175 */
- void (*tclCleanupVar) _ANSI_ARGS_((Var * varPtr, Var * arrayPtr)); /* 176 */
- void (*tclVarErrMsg) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * operation, CONST char * reason)); /* 177 */
- void (*tcl_SetStartupScript) _ANSI_ARGS_((Tcl_Obj * pathPtr, CONST char* encodingName)); /* 178 */
- Tcl_Obj * (*tcl_GetStartupScript) _ANSI_ARGS_((CONST char ** encodingNamePtr)); /* 179 */
- void *reserved180;
- void *reserved181;
- struct tm * (*tclpLocaltime) _ANSI_ARGS_((CONST time_t * clock)); /* 182 */
- struct tm * (*tclpGmtime) _ANSI_ARGS_((CONST time_t * clock)); /* 183 */
- void *reserved184;
- void *reserved185;
- void *reserved186;
- void *reserved187;
- void *reserved188;
- void *reserved189;
- void *reserved190;
- void *reserved191;
- void *reserved192;
- void *reserved193;
- void *reserved194;
- void *reserved195;
- void *reserved196;
- int (*tclCompEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 197 */
- int (*tclObjGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CallFrame ** framePtrPtr)); /* 198 */
- void *reserved199;
- int (*tclpObjRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 200 */
- int (*tclpObjCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 201 */
- int (*tclpObjCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 202 */
- int (*tclpObjDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 203 */
- int (*tclpObjCopyFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 204 */
- int (*tclpObjRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 205 */
- int (*tclpObjStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 206 */
- int (*tclpObjAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 207 */
- Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions)); /* 208 */
- Tcl_Obj * (*tclGetEncodingSearchPath) _ANSI_ARGS_((void)); /* 209 */
- int (*tclSetEncodingSearchPath) _ANSI_ARGS_((Tcl_Obj * searchPath)); /* 210 */
- CONST char * (*tclpGetEncodingNameFromEnvironment) _ANSI_ARGS_((Tcl_DString * bufPtr)); /* 211 */
- void (*tclpFindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 212 */
- Tcl_Obj * (*tclGetObjNameOfExecutable) _ANSI_ARGS_((void)); /* 213 */
- void (*tclSetObjNameOfExecutable) _ANSI_ARGS_((Tcl_Obj * name, Tcl_Encoding encoding)); /* 214 */
- char * (*tclStackAlloc) _ANSI_ARGS_((Tcl_Interp * interp, int numBytes)); /* 215 */
- void (*tclStackFree) _ANSI_ARGS_((Tcl_Interp * interp)); /* 216 */
- int (*tclPushStackFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_CallFrame ** framePtrPtr, Tcl_Namespace * namespacePtr, int isProcCallFrame)); /* 217 */
- void (*tclPopStackFrame) _ANSI_ARGS_((Tcl_Interp * interp)); /* 218 */
- int (*tclBN_mp_div_d) _ANSI_ARGS_((mp_int * a, mp_digit b, mp_int * c, mp_digit * d)); /* 219 */
- int (*tclBN_mp_mul_d) _ANSI_ARGS_((mp_int * a, mp_digit b, mp_int * c)); /* 220 */
- void (*tclBN_mp_clear) _ANSI_ARGS_((mp_int * a)); /* 221 */
- int (*tclBN_mp_init) _ANSI_ARGS_((mp_int * a)); /* 222 */
- int (*tclBN_mp_read_radix) _ANSI_ARGS_((mp_int * a, const char * str, int radix)); /* 223 */
- TclPlatformType * (*tclGetPlatform) _ANSI_ARGS_((void)); /* 224 */
- Tcl_Obj * (*tclTraceDictPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags)); /* 225 */
+ void (*reserved0)(void);
+ void (*reserved1)(void);
+ void (*reserved2)(void);
+ void (*tclAllocateFreeObjects) (void); /* 3 */
+ void (*reserved4)(void);
+ int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
+ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
+ int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
+ int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
+ int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
+ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
+ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
+ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
+ void (*reserved13)(void);
+ int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
+ void (*reserved15)(void);
+ void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
+ void (*reserved17)(void);
+ void (*reserved18)(void);
+ void (*reserved19)(void);
+ void (*reserved20)(void);
+ 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 */
+ int (*tclFormatInt) (char *buffer, long n); /* 24 */
+ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
+ void (*reserved26)(void);
+ void (*reserved27)(void);
+ Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
+ void (*reserved29)(void);
+ void (*reserved30)(void);
+ const char * (*tclGetExtension) (const char *name); /* 31 */
+ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
+ void (*reserved33)(void);
+ int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
+ void (*reserved35)(void);
+ void (*reserved36)(void);
+ int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
+ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
+ TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
+ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
+ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
+ CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
+ void (*reserved43)(void);
+ int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
+ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
+ int (*tclInExit) (void); /* 46 */
+ void (*reserved47)(void);
+ void (*reserved48)(void);
+ void (*reserved49)(void);
+ void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
+ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
+ void (*reserved52)(void);
+ int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
+ int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
+ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
+ void (*reserved56)(void);
+ void (*reserved57)(void);
+ Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
+ void (*reserved59)(void);
+ int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
+ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
+ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
+ int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */
+ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */
+ void (*reserved65)(void);
+ void (*reserved66)(void);
+ void (*reserved67)(void);
+ void (*reserved68)(void);
+ char * (*tclpAlloc) (unsigned int size); /* 69 */
+ void (*reserved70)(void);
+ void (*reserved71)(void);
+ void (*reserved72)(void);
+ void (*reserved73)(void);
+ void (*tclpFree) (char *ptr); /* 74 */
+ unsigned long (*tclpGetClicks) (void); /* 75 */
+ unsigned long (*tclpGetSeconds) (void); /* 76 */
+ void (*tclpGetTime) (Tcl_Time *time); /* 77 */
+ void (*reserved78)(void);
+ void (*reserved79)(void);
+ void (*reserved80)(void);
+ char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
+ void (*reserved82)(void);
+ void (*reserved83)(void);
+ void (*reserved84)(void);
+ void (*reserved85)(void);
+ void (*reserved86)(void);
+ void (*reserved87)(void);
+ char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
+ int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
+ void (*reserved90)(void);
+ void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
+ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
+ void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
+ void (*reserved94)(void);
+ void (*reserved95)(void);
+ int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
+ void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
+ int (*tclServiceIdle) (void); /* 98 */
+ void (*reserved99)(void);
+ void (*reserved100)(void);
+ 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 (*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 */
+ 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 */
+ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
+ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
+ Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
+ Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
+ int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
+ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
+ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
+ int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
+ Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
+ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
+ Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
+ Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
+ void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
+ int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
+ void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
+ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
+ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
+ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
+ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
+ struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
+ void (*reserved134)(void);
+ void (*reserved135)(void);
+ void (*reserved136)(void);
+ void (*reserved137)(void);
+ CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
+ void (*reserved139)(void);
+ void (*reserved140)(void);
+ CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
+ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
+ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
+ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
+ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
+ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
+ void (*tclHandleFree) (TclHandle handle); /* 147 */
+ TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
+ void (*tclHandleRelease) (TclHandle handle); /* 149 */
+ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
+ void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
+ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
+ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
+ void (*reserved154)(void);
+ void (*reserved155)(void);
+ void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
+ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
+ void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
+ const char * (*tclGetStartupScriptFileName) (void); /* 159 */
+ void (*reserved160)(void);
+ int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
+ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
+ const void * (*tclGetInstructionTable) (void); /* 163 */
+ void (*tclExpandCodeArray) (void *envPtr); /* 164 */
+ void (*tclpSetInitialEncodings) (void); /* 165 */
+ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
+ void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
+ Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
+ int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
+ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
+ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
+ int (*tclInThreadExit) (void); /* 172 */
+ int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
+ void (*reserved174)(void);
+ int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
+ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
+ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
+ void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
+ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
+ void (*reserved180)(void);
+ void (*reserved181)(void);
+ struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
+ struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
+ void (*reserved184)(void);
+ void (*reserved185)(void);
+ void (*reserved186)(void);
+ void (*reserved187)(void);
+ void (*reserved188)(void);
+ void (*reserved189)(void);
+ void (*reserved190)(void);
+ void (*reserved191)(void);
+ void (*reserved192)(void);
+ void (*reserved193)(void);
+ void (*reserved194)(void);
+ void (*reserved195)(void);
+ void (*reserved196)(void);
+ void (*reserved197)(void);
+ int (*tclObjGetFrame) (Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* 198 */
+ void (*reserved199)(void);
+ int (*tclpObjRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 200 */
+ int (*tclpObjCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 201 */
+ int (*tclpObjCreateDirectory) (Tcl_Obj *pathPtr); /* 202 */
+ int (*tclpObjDeleteFile) (Tcl_Obj *pathPtr); /* 203 */
+ int (*tclpObjCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 204 */
+ int (*tclpObjRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */
+ int (*tclpObjStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 206 */
+ int (*tclpObjAccess) (Tcl_Obj *pathPtr, int mode); /* 207 */
+ Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
+ void (*reserved209)(void);
+ void (*reserved210)(void);
+ void (*reserved211)(void);
+ void (*tclpFindExecutable) (const char *argv0); /* 212 */
+ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
+ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
+ void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
+ void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
+ int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
+ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
+ void (*reserved219)(void);
+ void (*reserved220)(void);
+ void (*reserved221)(void);
+ void (*reserved222)(void);
+ void (*reserved223)(void);
+ TclPlatformType * (*tclGetPlatform) (void); /* 224 */
+ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
+ int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
+ void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
+ void (*reserved228)(void);
+ int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
+ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
+ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
+ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
+ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
+ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
+ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
+ void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
+ 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 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 */
+ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
+ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
+ 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 */
+ int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
} TclIntStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern TclIntStubs *tclIntStubsPtr;
+extern const TclIntStubs *tclIntStubsPtr;
+
#ifdef __cplusplus
}
#endif
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
/* Slot 0 is reserved */
-#ifndef TclAccessDeleteProc
-#define TclAccessDeleteProc \
- (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
-#endif
-#ifndef TclAccessInsertProc
-#define TclAccessInsertProc \
- (tclIntStubsPtr->tclAccessInsertProc) /* 2 */
-#endif
-#ifndef TclAllocateFreeObjects
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
#define TclAllocateFreeObjects \
(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
-#endif
/* Slot 4 is reserved */
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclCleanupChildren
-#define TclCleanupChildren \
- (tclIntStubsPtr->tclCleanupChildren) /* 5 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclCleanupChildren
#define TclCleanupChildren \
(tclIntStubsPtr->tclCleanupChildren) /* 5 */
-#endif
-#endif /* __WIN32__ */
-#ifndef TclCleanupCommand
#define TclCleanupCommand \
(tclIntStubsPtr->tclCleanupCommand) /* 6 */
-#endif
-#ifndef TclCopyAndCollapse
#define TclCopyAndCollapse \
(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
-#endif
-#ifndef TclCopyChannel
-#define TclCopyChannel \
- (tclIntStubsPtr->tclCopyChannel) /* 8 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclCreatePipeline
+#define TclCopyChannelOld \
+ (tclIntStubsPtr->tclCopyChannelOld) /* 8 */
#define TclCreatePipeline \
(tclIntStubsPtr->tclCreatePipeline) /* 9 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclCreatePipeline
-#define TclCreatePipeline \
- (tclIntStubsPtr->tclCreatePipeline) /* 9 */
-#endif
-#endif /* __WIN32__ */
-#ifndef TclCreateProc
#define TclCreateProc \
(tclIntStubsPtr->tclCreateProc) /* 10 */
-#endif
-#ifndef TclDeleteCompiledLocalVars
#define TclDeleteCompiledLocalVars \
(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
-#endif
-#ifndef TclDeleteVars
#define TclDeleteVars \
(tclIntStubsPtr->tclDeleteVars) /* 12 */
-#endif
/* Slot 13 is reserved */
-#ifndef TclDumpMemoryInfo
#define TclDumpMemoryInfo \
(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
-#endif
/* Slot 15 is reserved */
-#ifndef TclExprFloatError
#define TclExprFloatError \
(tclIntStubsPtr->tclExprFloatError) /* 16 */
-#endif
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
-#ifndef TclFindElement
#define TclFindElement \
(tclIntStubsPtr->tclFindElement) /* 22 */
-#endif
-#ifndef TclFindProc
#define TclFindProc \
(tclIntStubsPtr->tclFindProc) /* 23 */
-#endif
-/* Slot 24 is reserved */
-#ifndef TclFreePackageInfo
+#define TclFormatInt \
+ (tclIntStubsPtr->tclFormatInt) /* 24 */
#define TclFreePackageInfo \
(tclIntStubsPtr->tclFreePackageInfo) /* 25 */
-#endif
/* Slot 26 is reserved */
/* Slot 27 is reserved */
-#ifndef TclpGetDefaultStdChannel
#define TclpGetDefaultStdChannel \
(tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
-#endif
/* Slot 29 is reserved */
/* Slot 30 is reserved */
-#ifndef TclGetExtension
#define TclGetExtension \
(tclIntStubsPtr->tclGetExtension) /* 31 */
-#endif
-#ifndef TclGetFrame
#define TclGetFrame \
(tclIntStubsPtr->tclGetFrame) /* 32 */
-#endif
/* Slot 33 is reserved */
-#ifndef TclGetIntForIndex
#define TclGetIntForIndex \
(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
-#endif
/* Slot 35 is reserved */
-#ifndef TclGetLong
-#define TclGetLong \
- (tclIntStubsPtr->tclGetLong) /* 36 */
-#endif
-#ifndef TclGetLoadedPackages
+/* Slot 36 is reserved */
#define TclGetLoadedPackages \
(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
-#endif
-#ifndef TclGetNamespaceForQualName
#define TclGetNamespaceForQualName \
(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
-#endif
-#ifndef TclGetObjInterpProc
#define TclGetObjInterpProc \
(tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
-#endif
-#ifndef TclGetOpenMode
#define TclGetOpenMode \
(tclIntStubsPtr->tclGetOpenMode) /* 40 */
-#endif
-#ifndef TclGetOriginalCommand
#define TclGetOriginalCommand \
(tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
-#endif
-#ifndef TclpGetUserHome
#define TclpGetUserHome \
(tclIntStubsPtr->tclpGetUserHome) /* 42 */
-#endif
/* Slot 43 is reserved */
-#ifndef TclGuessPackageName
#define TclGuessPackageName \
(tclIntStubsPtr->tclGuessPackageName) /* 44 */
-#endif
-#ifndef TclHideUnsafeCommands
#define TclHideUnsafeCommands \
(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
-#endif
-#ifndef TclInExit
#define TclInExit \
(tclIntStubsPtr->tclInExit) /* 46 */
-#endif
/* Slot 47 is reserved */
/* Slot 48 is reserved */
-#ifndef TclIncrVar2
-#define TclIncrVar2 \
- (tclIntStubsPtr->tclIncrVar2) /* 49 */
-#endif
-#ifndef TclInitCompiledLocals
+/* Slot 49 is reserved */
#define TclInitCompiledLocals \
(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
-#endif
-#ifndef TclInterpInit
#define TclInterpInit \
(tclIntStubsPtr->tclInterpInit) /* 51 */
-#endif
/* Slot 52 is reserved */
-#ifndef TclInvokeObjectCommand
#define TclInvokeObjectCommand \
(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
-#endif
-#ifndef TclInvokeStringCommand
#define TclInvokeStringCommand \
(tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
-#endif
-#ifndef TclIsProc
#define TclIsProc \
(tclIntStubsPtr->tclIsProc) /* 55 */
-#endif
/* Slot 56 is reserved */
/* Slot 57 is reserved */
-#ifndef TclLookupVar
#define TclLookupVar \
(tclIntStubsPtr->tclLookupVar) /* 58 */
-#endif
/* Slot 59 is reserved */
-#ifndef TclNeedSpace
#define TclNeedSpace \
(tclIntStubsPtr->tclNeedSpace) /* 60 */
-#endif
-#ifndef TclNewProcBodyObj
#define TclNewProcBodyObj \
(tclIntStubsPtr->tclNewProcBodyObj) /* 61 */
-#endif
-#ifndef TclObjCommandComplete
#define TclObjCommandComplete \
(tclIntStubsPtr->tclObjCommandComplete) /* 62 */
-#endif
-#ifndef TclObjInterpProc
#define TclObjInterpProc \
(tclIntStubsPtr->tclObjInterpProc) /* 63 */
-#endif
-#ifndef TclObjInvoke
#define TclObjInvoke \
(tclIntStubsPtr->tclObjInvoke) /* 64 */
-#endif
/* Slot 65 is reserved */
-#ifndef TclOpenFileChannelDeleteProc
-#define TclOpenFileChannelDeleteProc \
- (tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */
-#endif
-#ifndef TclOpenFileChannelInsertProc
-#define TclOpenFileChannelInsertProc \
- (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */
-#endif
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
/* Slot 68 is reserved */
-#ifndef TclpAlloc
#define TclpAlloc \
(tclIntStubsPtr->tclpAlloc) /* 69 */
-#endif
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
-#ifndef TclpFree
#define TclpFree \
(tclIntStubsPtr->tclpFree) /* 74 */
-#endif
-#ifndef TclpGetClicks
#define TclpGetClicks \
(tclIntStubsPtr->tclpGetClicks) /* 75 */
-#endif
-#ifndef TclpGetSeconds
#define TclpGetSeconds \
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
-#endif
-#ifndef TclpGetTime
#define TclpGetTime \
(tclIntStubsPtr->tclpGetTime) /* 77 */
-#endif
-#ifndef TclpGetTimeZone
-#define TclpGetTimeZone \
- (tclIntStubsPtr->tclpGetTimeZone) /* 78 */
-#endif
+/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
-#ifndef TclpRealloc
#define TclpRealloc \
(tclIntStubsPtr->tclpRealloc) /* 81 */
-#endif
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
-#ifndef TclPrecTraceProc
#define TclPrecTraceProc \
(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
-#endif
-#ifndef TclPreventAliasLoop
#define TclPreventAliasLoop \
(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
-#endif
/* Slot 90 is reserved */
-#ifndef TclProcCleanupProc
#define TclProcCleanupProc \
(tclIntStubsPtr->tclProcCleanupProc) /* 91 */
-#endif
-#ifndef TclProcCompileProc
#define TclProcCompileProc \
(tclIntStubsPtr->tclProcCompileProc) /* 92 */
-#endif
-#ifndef TclProcDeleteProc
#define TclProcDeleteProc \
(tclIntStubsPtr->tclProcDeleteProc) /* 93 */
-#endif
/* Slot 94 is reserved */
/* Slot 95 is reserved */
-#ifndef TclRenameCommand
#define TclRenameCommand \
(tclIntStubsPtr->tclRenameCommand) /* 96 */
-#endif
-#ifndef TclResetShadowedCmdRefs
#define TclResetShadowedCmdRefs \
(tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
-#endif
-#ifndef TclServiceIdle
#define TclServiceIdle \
(tclIntStubsPtr->tclServiceIdle) /* 98 */
-#endif
/* Slot 99 is reserved */
/* Slot 100 is reserved */
-#ifndef TclSetPreInitScript
#define TclSetPreInitScript \
(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
-#endif
-#ifndef TclSetupEnv
#define TclSetupEnv \
(tclIntStubsPtr->tclSetupEnv) /* 102 */
-#endif
-#ifndef TclSockGetPort
#define TclSockGetPort \
(tclIntStubsPtr->tclSockGetPort) /* 103 */
-#endif
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclSockMinimumBuffers
-#define TclSockMinimumBuffers \
- (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclSockMinimumBuffers
-#define TclSockMinimumBuffers \
- (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
-#endif
-#endif /* __WIN32__ */
+#define TclSockMinimumBuffersOld \
+ (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 105 is reserved */
-#ifndef TclStatDeleteProc
-#define TclStatDeleteProc \
- (tclIntStubsPtr->tclStatDeleteProc) /* 106 */
-#endif
-#ifndef TclStatInsertProc
-#define TclStatInsertProc \
- (tclIntStubsPtr->tclStatInsertProc) /* 107 */
-#endif
-#ifndef TclTeardownNamespace
+/* Slot 106 is reserved */
+/* Slot 107 is reserved */
#define TclTeardownNamespace \
(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
-#endif
-#ifndef TclUpdateReturnInfo
#define TclUpdateReturnInfo \
(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
-#endif
-/* Slot 110 is reserved */
-#ifndef Tcl_AddInterpResolvers
+#define TclSockMinimumBuffers \
+ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
-#endif
-#ifndef Tcl_AppendExportList
#define Tcl_AppendExportList \
(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
-#endif
-#ifndef Tcl_CreateNamespace
#define Tcl_CreateNamespace \
(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
-#endif
-#ifndef Tcl_DeleteNamespace
#define Tcl_DeleteNamespace \
(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
-#endif
-#ifndef Tcl_Export
#define Tcl_Export \
(tclIntStubsPtr->tcl_Export) /* 115 */
-#endif
-#ifndef Tcl_FindCommand
#define Tcl_FindCommand \
(tclIntStubsPtr->tcl_FindCommand) /* 116 */
-#endif
-#ifndef Tcl_FindNamespace
#define Tcl_FindNamespace \
(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
-#endif
-#ifndef Tcl_GetInterpResolvers
#define Tcl_GetInterpResolvers \
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
-#endif
-#ifndef Tcl_GetNamespaceResolvers
#define Tcl_GetNamespaceResolvers \
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
-#endif
-#ifndef Tcl_FindNamespaceVar
#define Tcl_FindNamespaceVar \
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
-#endif
-#ifndef Tcl_ForgetImport
#define Tcl_ForgetImport \
(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
-#endif
-#ifndef Tcl_GetCommandFromObj
#define Tcl_GetCommandFromObj \
(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
-#endif
-#ifndef Tcl_GetCommandFullName
#define Tcl_GetCommandFullName \
(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
-#endif
-#ifndef Tcl_GetCurrentNamespace
#define Tcl_GetCurrentNamespace \
(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
-#endif
-#ifndef Tcl_GetGlobalNamespace
#define Tcl_GetGlobalNamespace \
(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
-#endif
-#ifndef Tcl_GetVariableFullName
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
-#endif
-#ifndef Tcl_Import
#define Tcl_Import \
(tclIntStubsPtr->tcl_Import) /* 127 */
-#endif
-#ifndef Tcl_PopCallFrame
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
-#endif
-#ifndef Tcl_PushCallFrame
#define Tcl_PushCallFrame \
(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
-#endif
-#ifndef Tcl_RemoveInterpResolvers
#define Tcl_RemoveInterpResolvers \
(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
-#endif
-#ifndef Tcl_SetNamespaceResolvers
#define Tcl_SetNamespaceResolvers \
(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
-#endif
-#ifndef TclpHasSockets
#define TclpHasSockets \
(tclIntStubsPtr->tclpHasSockets) /* 132 */
-#endif
-#ifndef TclpGetDate
#define TclpGetDate \
(tclIntStubsPtr->tclpGetDate) /* 133 */
-#endif
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
-#ifndef TclGetEnv
#define TclGetEnv \
(tclIntStubsPtr->tclGetEnv) /* 138 */
-#endif
/* Slot 139 is reserved */
-#ifndef TclLooksLikeInt
-#define TclLooksLikeInt \
- (tclIntStubsPtr->tclLooksLikeInt) /* 140 */
-#endif
-#ifndef TclpGetCwd
+/* Slot 140 is reserved */
#define TclpGetCwd \
(tclIntStubsPtr->tclpGetCwd) /* 141 */
-#endif
-#ifndef TclSetByteCodeFromAny
#define TclSetByteCodeFromAny \
(tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */
-#endif
-#ifndef TclAddLiteralObj
#define TclAddLiteralObj \
(tclIntStubsPtr->tclAddLiteralObj) /* 143 */
-#endif
-#ifndef TclHideLiteral
#define TclHideLiteral \
(tclIntStubsPtr->tclHideLiteral) /* 144 */
-#endif
-#ifndef TclGetAuxDataType
#define TclGetAuxDataType \
(tclIntStubsPtr->tclGetAuxDataType) /* 145 */
-#endif
-#ifndef TclHandleCreate
#define TclHandleCreate \
(tclIntStubsPtr->tclHandleCreate) /* 146 */
-#endif
-#ifndef TclHandleFree
#define TclHandleFree \
(tclIntStubsPtr->tclHandleFree) /* 147 */
-#endif
-#ifndef TclHandlePreserve
#define TclHandlePreserve \
(tclIntStubsPtr->tclHandlePreserve) /* 148 */
-#endif
-#ifndef TclHandleRelease
#define TclHandleRelease \
(tclIntStubsPtr->tclHandleRelease) /* 149 */
-#endif
-#ifndef TclRegAbout
#define TclRegAbout \
(tclIntStubsPtr->tclRegAbout) /* 150 */
-#endif
-#ifndef TclRegExpRangeUniChar
#define TclRegExpRangeUniChar \
(tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */
-#endif
-#ifndef TclSetLibraryPath
#define TclSetLibraryPath \
(tclIntStubsPtr->tclSetLibraryPath) /* 152 */
-#endif
-#ifndef TclGetLibraryPath
#define TclGetLibraryPath \
(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
-#endif
/* Slot 154 is reserved */
/* Slot 155 is reserved */
-#ifndef TclRegError
#define TclRegError \
(tclIntStubsPtr->tclRegError) /* 156 */
-#endif
-#ifndef TclVarTraceExists
#define TclVarTraceExists \
(tclIntStubsPtr->tclVarTraceExists) /* 157 */
-#endif
-#ifndef TclSetStartupScriptFileName
#define TclSetStartupScriptFileName \
(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
-#endif
-#ifndef TclGetStartupScriptFileName
#define TclGetStartupScriptFileName \
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
-#endif
/* Slot 160 is reserved */
-#ifndef TclChannelTransform
#define TclChannelTransform \
(tclIntStubsPtr->tclChannelTransform) /* 161 */
-#endif
-#ifndef TclChannelEventScriptInvoker
#define TclChannelEventScriptInvoker \
(tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
-#endif
-#ifndef TclGetInstructionTable
#define TclGetInstructionTable \
(tclIntStubsPtr->tclGetInstructionTable) /* 163 */
-#endif
-#ifndef TclExpandCodeArray
#define TclExpandCodeArray \
(tclIntStubsPtr->tclExpandCodeArray) /* 164 */
-#endif
-#ifndef TclpSetInitialEncodings
#define TclpSetInitialEncodings \
(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
-#endif
-#ifndef TclListObjSetElement
#define TclListObjSetElement \
(tclIntStubsPtr->tclListObjSetElement) /* 166 */
-#endif
-#ifndef TclSetStartupScriptPath
#define TclSetStartupScriptPath \
(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
-#endif
-#ifndef TclGetStartupScriptPath
#define TclGetStartupScriptPath \
(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
-#endif
-#ifndef TclpUtfNcmp2
#define TclpUtfNcmp2 \
(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
-#endif
-#ifndef TclCheckInterpTraces
#define TclCheckInterpTraces \
(tclIntStubsPtr->tclCheckInterpTraces) /* 170 */
-#endif
-#ifndef TclCheckExecutionTraces
#define TclCheckExecutionTraces \
(tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */
-#endif
-#ifndef TclInThreadExit
#define TclInThreadExit \
(tclIntStubsPtr->tclInThreadExit) /* 172 */
-#endif
-#ifndef TclUniCharMatch
#define TclUniCharMatch \
(tclIntStubsPtr->tclUniCharMatch) /* 173 */
-#endif
-#ifndef TclIncrWideVar2
-#define TclIncrWideVar2 \
- (tclIntStubsPtr->tclIncrWideVar2) /* 174 */
-#endif
-#ifndef TclCallVarTraces
+/* Slot 174 is reserved */
#define TclCallVarTraces \
(tclIntStubsPtr->tclCallVarTraces) /* 175 */
-#endif
-#ifndef TclCleanupVar
#define TclCleanupVar \
(tclIntStubsPtr->tclCleanupVar) /* 176 */
-#endif
-#ifndef TclVarErrMsg
#define TclVarErrMsg \
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
-#endif
-#ifndef Tcl_SetStartupScript
#define Tcl_SetStartupScript \
(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
-#endif
-#ifndef Tcl_GetStartupScript
#define Tcl_GetStartupScript \
(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
-#endif
/* Slot 180 is reserved */
/* Slot 181 is reserved */
-#ifndef TclpLocaltime
#define TclpLocaltime \
(tclIntStubsPtr->tclpLocaltime) /* 182 */
-#endif
-#ifndef TclpGmtime
#define TclpGmtime \
(tclIntStubsPtr->tclpGmtime) /* 183 */
-#endif
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -1976,125 +1206,165 @@ extern TclIntStubs *tclIntStubsPtr;
/* Slot 194 is reserved */
/* Slot 195 is reserved */
/* Slot 196 is reserved */
-#ifndef TclCompEvalObj
-#define TclCompEvalObj \
- (tclIntStubsPtr->tclCompEvalObj) /* 197 */
-#endif
-#ifndef TclObjGetFrame
+/* Slot 197 is reserved */
#define TclObjGetFrame \
(tclIntStubsPtr->tclObjGetFrame) /* 198 */
-#endif
/* Slot 199 is reserved */
-#ifndef TclpObjRemoveDirectory
#define TclpObjRemoveDirectory \
(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
-#endif
-#ifndef TclpObjCopyDirectory
#define TclpObjCopyDirectory \
(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */
-#endif
-#ifndef TclpObjCreateDirectory
#define TclpObjCreateDirectory \
(tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */
-#endif
-#ifndef TclpObjDeleteFile
#define TclpObjDeleteFile \
(tclIntStubsPtr->tclpObjDeleteFile) /* 203 */
-#endif
-#ifndef TclpObjCopyFile
#define TclpObjCopyFile \
(tclIntStubsPtr->tclpObjCopyFile) /* 204 */
-#endif
-#ifndef TclpObjRenameFile
#define TclpObjRenameFile \
(tclIntStubsPtr->tclpObjRenameFile) /* 205 */
-#endif
-#ifndef TclpObjStat
#define TclpObjStat \
(tclIntStubsPtr->tclpObjStat) /* 206 */
-#endif
-#ifndef TclpObjAccess
#define TclpObjAccess \
(tclIntStubsPtr->tclpObjAccess) /* 207 */
-#endif
-#ifndef TclpOpenFileChannel
#define TclpOpenFileChannel \
(tclIntStubsPtr->tclpOpenFileChannel) /* 208 */
-#endif
-#ifndef TclGetEncodingSearchPath
-#define TclGetEncodingSearchPath \
- (tclIntStubsPtr->tclGetEncodingSearchPath) /* 209 */
-#endif
-#ifndef TclSetEncodingSearchPath
-#define TclSetEncodingSearchPath \
- (tclIntStubsPtr->tclSetEncodingSearchPath) /* 210 */
-#endif
-#ifndef TclpGetEncodingNameFromEnvironment
-#define TclpGetEncodingNameFromEnvironment \
- (tclIntStubsPtr->tclpGetEncodingNameFromEnvironment) /* 211 */
-#endif
-#ifndef TclpFindExecutable
+/* Slot 209 is reserved */
+/* Slot 210 is reserved */
+/* Slot 211 is reserved */
#define TclpFindExecutable \
(tclIntStubsPtr->tclpFindExecutable) /* 212 */
-#endif
-#ifndef TclGetObjNameOfExecutable
#define TclGetObjNameOfExecutable \
(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
-#endif
-#ifndef TclSetObjNameOfExecutable
#define TclSetObjNameOfExecutable \
(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
-#endif
-#ifndef TclStackAlloc
#define TclStackAlloc \
(tclIntStubsPtr->tclStackAlloc) /* 215 */
-#endif
-#ifndef TclStackFree
#define TclStackFree \
(tclIntStubsPtr->tclStackFree) /* 216 */
-#endif
-#ifndef TclPushStackFrame
#define TclPushStackFrame \
(tclIntStubsPtr->tclPushStackFrame) /* 217 */
-#endif
-#ifndef TclPopStackFrame
#define TclPopStackFrame \
(tclIntStubsPtr->tclPopStackFrame) /* 218 */
-#endif
-#ifndef TclBN_mp_div_d
-#define TclBN_mp_div_d \
- (tclIntStubsPtr->tclBN_mp_div_d) /* 219 */
-#endif
-#ifndef TclBN_mp_mul_d
-#define TclBN_mp_mul_d \
- (tclIntStubsPtr->tclBN_mp_mul_d) /* 220 */
-#endif
-#ifndef TclBN_mp_clear
-#define TclBN_mp_clear \
- (tclIntStubsPtr->tclBN_mp_clear) /* 221 */
-#endif
-#ifndef TclBN_mp_init
-#define TclBN_mp_init \
- (tclIntStubsPtr->tclBN_mp_init) /* 222 */
-#endif
-#ifndef TclBN_mp_read_radix
-#define TclBN_mp_read_radix \
- (tclIntStubsPtr->tclBN_mp_read_radix) /* 223 */
-#endif
-#ifndef TclGetPlatform
+/* Slot 219 is reserved */
+/* Slot 220 is reserved */
+/* Slot 221 is reserved */
+/* Slot 222 is reserved */
+/* Slot 223 is reserved */
#define TclGetPlatform \
(tclIntStubsPtr->tclGetPlatform) /* 224 */
-#endif
-#ifndef TclTraceDictPath
#define TclTraceDictPath \
(tclIntStubsPtr->tclTraceDictPath) /* 225 */
-#endif
+#define TclObjBeingDeleted \
+ (tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
+#define TclSetNsPath \
+ (tclIntStubsPtr->tclSetNsPath) /* 227 */
+/* Slot 228 is reserved */
+#define TclPtrMakeUpvar \
+ (tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
+#define TclObjLookupVar \
+ (tclIntStubsPtr->tclObjLookupVar) /* 230 */
+#define TclGetNamespaceFromObj \
+ (tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
+#define TclEvalObjEx \
+ (tclIntStubsPtr->tclEvalObjEx) /* 232 */
+#define TclGetSrcInfoForPc \
+ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
+#define TclVarHashCreateVar \
+ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
+#define TclInitVarHashTable \
+ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */
+#define TclBackgroundException \
+ (tclIntStubsPtr->tclBackgroundException) /* 236 */
+#define TclResetCancellation \
+ (tclIntStubsPtr->tclResetCancellation) /* 237 */
+#define TclNRInterpProc \
+ (tclIntStubsPtr->tclNRInterpProc) /* 238 */
+#define TclNRInterpProcCore \
+ (tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
+#define TclNRRunCallbacks \
+ (tclIntStubsPtr->tclNRRunCallbacks) /* 240 */
+#define TclNREvalObjEx \
+ (tclIntStubsPtr->tclNREvalObjEx) /* 241 */
+#define TclNREvalObjv \
+ (tclIntStubsPtr->tclNREvalObjv) /* 242 */
+#define TclDbDumpActiveObjects \
+ (tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */
+#define TclGetNamespaceChildTable \
+ (tclIntStubsPtr->tclGetNamespaceChildTable) /* 244 */
+#define TclGetNamespaceCommandTable \
+ (tclIntStubsPtr->tclGetNamespaceCommandTable) /* 245 */
+#define TclInitRewriteEnsemble \
+ (tclIntStubsPtr->tclInitRewriteEnsemble) /* 246 */
+#define TclResetRewriteEnsemble \
+ (tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */
+#define TclCopyChannel \
+ (tclIntStubsPtr->tclCopyChannel) /* 248 */
+#define TclDoubleDigits \
+ (tclIntStubsPtr->tclDoubleDigits) /* 249 */
+#define TclSetSlaveCancelFlags \
+ (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclRegisterLiteral \
+ (tclIntStubsPtr->tclRegisterLiteral) /* 251 */
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef TclGetStartupScriptFileName
+#undef TclSetStartupScriptFileName
+#undef TclGetStartupScriptPath
+#undef TclSetStartupScriptPath
+#undef TclBackgroundException
+
+#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+# undef Tcl_SetStartupScript
+# define Tcl_SetStartupScript \
+ (tclStubsPtr->tcl_SetStartupScript) /* 622 */
+# undef Tcl_GetStartupScript
+# define Tcl_GetStartupScript \
+ (tclStubsPtr->tcl_GetStartupScript) /* 623 */
+# undef Tcl_CreateNamespace
+# define Tcl_CreateNamespace \
+ (tclStubsPtr->tcl_CreateNamespace) /* 506 */
+# undef Tcl_DeleteNamespace
+# define Tcl_DeleteNamespace \
+ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+# undef Tcl_AppendExportList
+# define Tcl_AppendExportList \
+ (tclStubsPtr->tcl_AppendExportList) /* 508 */
+# undef Tcl_Export
+# define Tcl_Export \
+ (tclStubsPtr->tcl_Export) /* 509 */
+# undef Tcl_Import
+# define Tcl_Import \
+ (tclStubsPtr->tcl_Import) /* 510 */
+# undef Tcl_ForgetImport
+# define Tcl_ForgetImport \
+ (tclStubsPtr->tcl_ForgetImport) /* 511 */
+# undef Tcl_GetCurrentNamespace
+# define Tcl_GetCurrentNamespace \
+ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+# undef Tcl_GetGlobalNamespace
+# define Tcl_GetGlobalNamespace \
+ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+# undef Tcl_FindNamespace
+# define Tcl_FindNamespace \
+ (tclStubsPtr->tcl_FindNamespace) /* 514 */
+# undef Tcl_FindCommand
+# define Tcl_FindCommand \
+ (tclStubsPtr->tcl_FindCommand) /* 515 */
+# undef Tcl_GetCommandFromObj
+# define Tcl_GetCommandFromObj \
+ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+# undef Tcl_GetCommandFullName
+# define Tcl_GetCommandFullName \
+ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#endif
+
+#undef TclCopyChannelOld
+#undef TclSockMinimumBuffersOld
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index e9c1184..ac06787 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.27 2005/05/14 20:46:45 das 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
@@ -34,526 +37,531 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclGetAndDetachPids_TCL_DECLARED
-#define TclGetAndDetachPids_TCL_DECLARED
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
-EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan));
-#endif
-#ifndef TclpCloseFile_TCL_DECLARED
-#define TclpCloseFile_TCL_DECLARED
+EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
+ Tcl_Channel chan);
/* 1 */
-EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file));
-#endif
-#ifndef TclpCreateCommandChannel_TCL_DECLARED
-#define TclpCreateCommandChannel_TCL_DECLARED
+EXTERN int TclpCloseFile(TclFile file);
/* 2 */
-EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_((
- TclFile readFile, TclFile writeFile,
- TclFile errorFile, int numPids,
- Tcl_Pid * pidPtr));
-#endif
-#ifndef TclpCreatePipe_TCL_DECLARED
-#define TclpCreatePipe_TCL_DECLARED
+EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
+ TclFile writeFile, TclFile errorFile,
+ int numPids, Tcl_Pid *pidPtr);
/* 3 */
-EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
- TclFile * writePipe));
-#endif
-#ifndef TclpCreateProcess_TCL_DECLARED
-#define TclpCreateProcess_TCL_DECLARED
+EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
-EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, CONST char ** argv,
- TclFile inputFile, TclFile outputFile,
- TclFile errorFile, Tcl_Pid * pidPtr));
-#endif
+EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
+ const char **argv, TclFile inputFile,
+ TclFile outputFile, TclFile errorFile,
+ Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
-#ifndef TclpMakeFile_TCL_DECLARED
-#define TclpMakeFile_TCL_DECLARED
/* 6 */
-EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
- int direction));
-#endif
-#ifndef TclpOpenFile_TCL_DECLARED
-#define TclpOpenFile_TCL_DECLARED
+EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
-EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname,
- int mode));
-#endif
-#ifndef TclUnixWaitForFile_TCL_DECLARED
-#define TclUnixWaitForFile_TCL_DECLARED
+EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
-EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
- int timeout));
-#endif
-#ifndef TclpCreateTempFile_TCL_DECLARED
-#define TclpCreateTempFile_TCL_DECLARED
+EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
-EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
- CONST char * contents));
-#endif
-#ifndef TclpReaddir_TCL_DECLARED
-#define TclpReaddir_TCL_DECLARED
+EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
-EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR * dir));
-#endif
-#ifndef TclpLocaltime_unix_TCL_DECLARED
-#define TclpLocaltime_unix_TCL_DECLARED
+EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* 11 */
-EXTERN struct tm * TclpLocaltime_unix _ANSI_ARGS_((CONST time_t * clock));
-#endif
-#ifndef TclpGmtime_unix_TCL_DECLARED
-#define TclpGmtime_unix_TCL_DECLARED
+EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
-EXTERN struct tm * TclpGmtime_unix _ANSI_ARGS_((CONST time_t * clock));
-#endif
-#ifndef TclpInetNtoa_TCL_DECLARED
-#define TclpInetNtoa_TCL_DECLARED
+EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
/* 13 */
-EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
-#endif
-#ifndef TclUnixCopyFile_TCL_DECLARED
-#define TclUnixCopyFile_TCL_DECLARED
+EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 14 */
-EXTERN int TclUnixCopyFile _ANSI_ARGS_((CONST char * src,
- CONST char * dst,
- CONST Tcl_StatBuf * statBufPtr,
- int dontCopyAtts));
-#endif
+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__
-#ifndef TclWinConvertError_TCL_DECLARED
-#define TclWinConvertError_TCL_DECLARED
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
-EXTERN void TclWinConvertError _ANSI_ARGS_((DWORD errCode));
-#endif
-#ifndef TclWinConvertWSAError_TCL_DECLARED
-#define TclWinConvertWSAError_TCL_DECLARED
+EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
-EXTERN void TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
-#endif
-#ifndef TclWinGetServByName_TCL_DECLARED
-#define TclWinGetServByName_TCL_DECLARED
+EXTERN void TclWinConvertWSAError(DWORD errCode);
/* 2 */
-EXTERN struct servent * TclWinGetServByName _ANSI_ARGS_((CONST char * nm,
- CONST char * proto));
-#endif
-#ifndef TclWinGetSockOpt_TCL_DECLARED
-#define TclWinGetSockOpt_TCL_DECLARED
+EXTERN struct servent * TclWinGetServByName(const char *nm,
+ const char *proto);
/* 3 */
-EXTERN int TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
- int optname, char FAR * optval,
- int FAR * optlen));
-#endif
-#ifndef TclWinGetTclInstance_TCL_DECLARED
-#define TclWinGetTclInstance_TCL_DECLARED
+EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
+ char *optval, int *optlen);
/* 4 */
-EXTERN HINSTANCE TclWinGetTclInstance _ANSI_ARGS_((void));
-#endif
-/* Slot 5 is reserved */
-#ifndef TclWinNToHS_TCL_DECLARED
-#define TclWinNToHS_TCL_DECLARED
+EXTERN HINSTANCE TclWinGetTclInstance(void);
+/* 5 */
+EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
-EXTERN u_short TclWinNToHS _ANSI_ARGS_((u_short ns));
-#endif
-#ifndef TclWinSetSockOpt_TCL_DECLARED
-#define TclWinSetSockOpt_TCL_DECLARED
+EXTERN unsigned short TclWinNToHS(unsigned short ns);
/* 7 */
-EXTERN int TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
- int optname, CONST char FAR * optval,
- int optlen));
-#endif
-#ifndef TclpGetPid_TCL_DECLARED
-#define TclpGetPid_TCL_DECLARED
+EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
+ const char *optval, int optlen);
/* 8 */
-EXTERN unsigned long TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
-#endif
-#ifndef TclWinGetPlatformId_TCL_DECLARED
-#define TclWinGetPlatformId_TCL_DECLARED
+EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
-EXTERN int TclWinGetPlatformId _ANSI_ARGS_((void));
-#endif
-/* Slot 10 is reserved */
-#ifndef TclGetAndDetachPids_TCL_DECLARED
-#define TclGetAndDetachPids_TCL_DECLARED
+EXTERN int TclWinGetPlatformId(void);
+/* 10 */
+EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* 11 */
-EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Channel chan));
-#endif
-#ifndef TclpCloseFile_TCL_DECLARED
-#define TclpCloseFile_TCL_DECLARED
+EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
+ Tcl_Channel chan);
/* 12 */
-EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file));
-#endif
-#ifndef TclpCreateCommandChannel_TCL_DECLARED
-#define TclpCreateCommandChannel_TCL_DECLARED
+EXTERN int TclpCloseFile(TclFile file);
/* 13 */
-EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_((
- TclFile readFile, TclFile writeFile,
- TclFile errorFile, int numPids,
- Tcl_Pid * pidPtr));
-#endif
-#ifndef TclpCreatePipe_TCL_DECLARED
-#define TclpCreatePipe_TCL_DECLARED
+EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
+ TclFile writeFile, TclFile errorFile,
+ int numPids, Tcl_Pid *pidPtr);
/* 14 */
-EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
- TclFile * writePipe));
-#endif
-#ifndef TclpCreateProcess_TCL_DECLARED
-#define TclpCreateProcess_TCL_DECLARED
+EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 15 */
-EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, CONST char ** argv,
- TclFile inputFile, TclFile outputFile,
- TclFile errorFile, Tcl_Pid * pidPtr));
-#endif
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
-#ifndef TclpMakeFile_TCL_DECLARED
-#define TclpMakeFile_TCL_DECLARED
+EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
+ const char **argv, TclFile inputFile,
+ TclFile outputFile, TclFile errorFile,
+ Tcl_Pid *pidPtr);
+/* 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 _ANSI_ARGS_((Tcl_Channel channel,
- int direction));
-#endif
-#ifndef TclpOpenFile_TCL_DECLARED
-#define TclpOpenFile_TCL_DECLARED
+EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
-EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname,
- int mode));
-#endif
-#ifndef TclWinAddProcess_TCL_DECLARED
-#define TclWinAddProcess_TCL_DECLARED
+EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
-EXTERN void TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess,
- DWORD id));
-#endif
-/* Slot 21 is reserved */
-#ifndef TclpCreateTempFile_TCL_DECLARED
-#define TclpCreateTempFile_TCL_DECLARED
+EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
+/* 21 */
+EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 22 */
-EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
- CONST char * contents));
-#endif
-#ifndef TclpGetTZName_TCL_DECLARED
-#define TclpGetTZName_TCL_DECLARED
-/* 23 */
-EXTERN char * TclpGetTZName _ANSI_ARGS_((int isdst));
-#endif
-#ifndef TclWinNoBackslash_TCL_DECLARED
-#define TclWinNoBackslash_TCL_DECLARED
+EXTERN TclFile TclpCreateTempFile(const char *contents);
+/* Slot 23 is reserved */
/* 24 */
-EXTERN char * TclWinNoBackslash _ANSI_ARGS_((char * path));
-#endif
+EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
-#ifndef TclWinSetInterfaces_TCL_DECLARED
-#define TclWinSetInterfaces_TCL_DECLARED
/* 26 */
-EXTERN void TclWinSetInterfaces _ANSI_ARGS_((int wide));
-#endif
-#ifndef TclWinFlushDirtyChannels_TCL_DECLARED
-#define TclWinFlushDirtyChannels_TCL_DECLARED
+EXTERN void TclWinSetInterfaces(int wide);
/* 27 */
-EXTERN void TclWinFlushDirtyChannels _ANSI_ARGS_((void));
-#endif
-#ifndef TclWinResetInterfaces_TCL_DECLARED
-#define TclWinResetInterfaces_TCL_DECLARED
+EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
-EXTERN void TclWinResetInterfaces _ANSI_ARGS_((void));
-#endif
-#ifndef TclWinCPUID_TCL_DECLARED
-#define TclWinCPUID_TCL_DECLARED
+EXTERN void TclWinResetInterfaces(void);
/* 29 */
-EXTERN int TclWinCPUID _ANSI_ARGS_((unsigned int index,
- unsigned int * regs));
-#endif
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
-#ifndef TclMacOSXGetFileAttribute_TCL_DECLARED
-#define TclMacOSXGetFileAttribute_TCL_DECLARED
+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 */
+EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
+ Tcl_Channel chan);
+/* 1 */
+EXTERN int TclpCloseFile(TclFile file);
+/* 2 */
+EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
+ TclFile writeFile, TclFile errorFile,
+ int numPids, Tcl_Pid *pidPtr);
+/* 3 */
+EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+/* 4 */
+EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
+ const char **argv, TclFile inputFile,
+ TclFile outputFile, TclFile errorFile,
+ Tcl_Pid *pidPtr);
+/* Slot 5 is reserved */
+/* 6 */
+EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
+/* 7 */
+EXTERN TclFile TclpOpenFile(const char *fname, int mode);
+/* 8 */
+EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
+/* 9 */
+EXTERN TclFile TclpCreateTempFile(const char *contents);
+/* 10 */
+EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
+/* 11 */
+EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
+/* 12 */
+EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
+/* 13 */
+EXTERN char * TclpInetNtoa(struct in_addr addr);
+/* 14 */
+EXTERN int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr,
+ int dontCopyAtts);
/* 15 */
-EXTERN int TclMacOSXGetFileAttribute _ANSI_ARGS_((
- Tcl_Interp * interp, int objIndex,
- Tcl_Obj * fileName,
- Tcl_Obj ** attributePtrPtr));
-#endif
-#ifndef TclMacOSXSetFileAttribute_TCL_DECLARED
-#define TclMacOSXSetFileAttribute_TCL_DECLARED
+EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
+ int objIndex, Tcl_Obj *fileName,
+ Tcl_Obj **attributePtrPtr);
/* 16 */
-EXTERN int TclMacOSXSetFileAttribute _ANSI_ARGS_((
- Tcl_Interp * interp, int objIndex,
- Tcl_Obj * fileName, Tcl_Obj * attributePtr));
-#endif
-#ifndef TclMacOSXCopyFileAttributes_TCL_DECLARED
-#define TclMacOSXCopyFileAttributes_TCL_DECLARED
+EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
+ int objIndex, Tcl_Obj *fileName,
+ Tcl_Obj *attributePtr);
/* 17 */
-EXTERN int TclMacOSXCopyFileAttributes _ANSI_ARGS_((
- CONST char * src, CONST char * dst,
- CONST Tcl_StatBuf * statBufPtr));
-#endif
-#endif /* MAC_OSX_TCL */
+EXTERN int TclMacOSXCopyFileAttributes(const char *src,
+ const char *dst,
+ const Tcl_StatBuf *statBufPtr);
+/* 18 */
+EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
+ const char *pathName, const char *fileName,
+ Tcl_StatBuf *statBufPtr,
+ Tcl_GlobTypeData *types);
+/* 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;
- struct TclIntPlatStubHooks *hooks;
+ void *hooks;
-#if !defined(__WIN32__) /* UNIX */
- void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 0 */
- int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 1 */
- Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)); /* 2 */
- int (*tclpCreatePipe) _ANSI_ARGS_((TclFile * readPipe, TclFile * writePipe)); /* 3 */
- int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 4 */
- void *reserved5;
- TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */
- TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 7 */
- int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */
- TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 9 */
- Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR * dir)); /* 10 */
- struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((CONST time_t * clock)); /* 11 */
- struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((CONST time_t * clock)); /* 12 */
- char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
- int (*tclUnixCopyFile) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr, int dontCopyAtts)); /* 14 */
+#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 */
+ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
+ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
+ void (*reserved5)(void);
+ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
+ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
+ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
+ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
+ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
+ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
+ 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__
- void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
- void (*tclWinConvertWSAError) _ANSI_ARGS_((DWORD errCode)); /* 1 */
- struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char * nm, CONST char * proto)); /* 2 */
- int (*tclWinGetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, char FAR * optval, int FAR * optlen)); /* 3 */
- HINSTANCE (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */
- void *reserved5;
- u_short (*tclWinNToHS) _ANSI_ARGS_((u_short ns)); /* 6 */
- int (*tclWinSetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, CONST char FAR * optval, int optlen)); /* 7 */
- unsigned long (*tclpGetPid) _ANSI_ARGS_((Tcl_Pid pid)); /* 8 */
- int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */
- void *reserved10;
- void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 11 */
- int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 12 */
- Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)); /* 13 */
- int (*tclpCreatePipe) _ANSI_ARGS_((TclFile * readPipe, TclFile * writePipe)); /* 14 */
- int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 15 */
- void *reserved16;
- void *reserved17;
- TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */
- TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 19 */
- void (*tclWinAddProcess) _ANSI_ARGS_((HANDLE hProcess, DWORD id)); /* 20 */
- void *reserved21;
- TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 22 */
- char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */
- char * (*tclWinNoBackslash) _ANSI_ARGS_((char * path)); /* 24 */
- void *reserved25;
- void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */
- void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */
- void (*tclWinResetInterfaces) _ANSI_ARGS_((void)); /* 28 */
- int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int * regs)); /* 29 */
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
- int (*tclMacOSXGetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr)); /* 15 */
- int (*tclMacOSXSetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr)); /* 16 */
- int (*tclMacOSXCopyFileAttributes) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr)); /* 17 */
-#endif /* MAC_OSX_TCL */
+#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) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
+ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
+ 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 */
+ 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 */
+ 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) (HANDLE hProcess, DWORD id); /* 20 */
+ char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
+ TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
+ 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 */
+ int (*tclpCloseFile) (TclFile file); /* 1 */
+ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
+ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
+ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
+ void (*reserved5)(void);
+ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
+ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
+ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
+ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
+ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
+ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
+ 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 */
+ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
+ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
+ 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;
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern TclIntPlatStubs *tclIntPlatStubsPtr;
+extern const TclIntPlatStubs *tclIntPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
-#if !defined(__WIN32__) /* UNIX */
-#ifndef TclGetAndDetachPids
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
-#endif
-#ifndef TclpCloseFile
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
-#endif
-#ifndef TclpCreateCommandChannel
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
-#endif
-#ifndef TclpCreatePipe
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
-#endif
-#ifndef TclpCreateProcess
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
-#endif
/* Slot 5 is reserved */
-#ifndef TclpMakeFile
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
-#endif
-#ifndef TclpOpenFile
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
-#endif
-#ifndef TclUnixWaitForFile
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
-#endif
-#ifndef TclpCreateTempFile
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
-#endif
-#ifndef TclpReaddir
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
-#endif
-#ifndef TclpLocaltime_unix
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
-#endif
-#ifndef TclpGmtime_unix
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
-#endif
-#ifndef TclpInetNtoa
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
-#endif
-#ifndef TclUnixCopyFile
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#endif
+/* 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__
-#ifndef TclWinConvertError
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
-#endif
-#ifndef TclWinConvertWSAError
#define TclWinConvertWSAError \
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
-#endif
-#ifndef TclWinGetServByName
#define TclWinGetServByName \
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
-#endif
-#ifndef TclWinGetSockOpt
#define TclWinGetSockOpt \
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
-#endif
-#ifndef TclWinGetTclInstance
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
-#endif
-/* Slot 5 is reserved */
-#ifndef TclWinNToHS
+#define TclUnixWaitForFile \
+ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
-#endif
-#ifndef TclWinSetSockOpt
#define TclWinSetSockOpt \
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
-#endif
-#ifndef TclpGetPid
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
-#endif
-#ifndef TclWinGetPlatformId
#define TclWinGetPlatformId \
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
-#endif
-/* Slot 10 is reserved */
-#ifndef TclGetAndDetachPids
+#define TclpReaddir \
+ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
-#endif
-#ifndef TclpCloseFile
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
-#endif
-#ifndef TclpCreateCommandChannel
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
-#endif
-#ifndef TclpCreatePipe
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
-#endif
-#ifndef TclpCreateProcess
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
-#endif
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
-#ifndef TclpMakeFile
+#define TclpIsAtty \
+ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
-#endif
-#ifndef TclpOpenFile
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
-#endif
-#ifndef TclWinAddProcess
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
-#endif
-/* Slot 21 is reserved */
-#ifndef TclpCreateTempFile
+#define TclpInetNtoa \
+ (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-#endif
-#ifndef TclpGetTZName
-#define TclpGetTZName \
- (tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
-#endif
-#ifndef TclWinNoBackslash
+/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
-#endif
/* Slot 25 is reserved */
-#ifndef TclWinSetInterfaces
#define TclWinSetInterfaces \
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
-#endif
-#ifndef TclWinFlushDirtyChannels
#define TclWinFlushDirtyChannels \
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
-#endif
-#ifndef TclWinResetInterfaces
#define TclWinResetInterfaces \
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
-#endif
-#ifndef TclWinCPUID
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#endif
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
-#ifndef TclMacOSXGetFileAttribute
+#define TclUnixOpenTemporaryFile \
+ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+#define TclGetAndDetachPids \
+ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
+#define TclpCloseFile \
+ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
+#define TclpCreateCommandChannel \
+ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
+#define TclpCreatePipe \
+ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
+#define TclpCreateProcess \
+ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
+/* Slot 5 is reserved */
+#define TclpMakeFile \
+ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
+#define TclpOpenFile \
+ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
+#define TclUnixWaitForFile \
+ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
+#define TclpCreateTempFile \
+ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
+#define TclpReaddir \
+ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */
+#define TclpLocaltime_unix \
+ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
+#define TclpGmtime_unix \
+ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
+#define TclpInetNtoa \
+ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
-#endif
-#ifndef TclMacOSXSetFileAttribute
#define TclMacOSXSetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
-#endif
-#ifndef TclMacOSXCopyFileAttributes
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
-#endif
-#endif /* MAC_OSX_TCL */
+#define TclMacOSXMatchType \
+ (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) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef TclpLocaltime_unix
+#undef TclpGmtime_unix
+#undef TclWinConvertWSAError
+#define TclWinConvertWSAError TclWinConvertError
+#undef TclpInetNtoa
+#define TclpInetNtoa inet_ntoa
+
+#if defined(_WIN32)
+# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
+# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
+#else
+# undef TclpGetPid
+# define TclpGetPid(pid) ((unsigned long) (pid))
+#endif
#endif /* _TCLINTPLATDECLS */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index c521435..0da5d47 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.60 2005/07/17 21:17:42 dkf Exp $
*/
#include "tclInt.h"
@@ -18,11 +16,10 @@
/*
* A pointer to a string that holds an initialization script that if non-NULL
* is evaluated in Tcl_Init() prior to the built-in initialization script
- * above. This variable can be modified by the procedure below.
+ * above. This variable can be modified by the function below.
*/
-static char * tclPreInitScript = NULL;
-
+static const char *tclPreInitScript = NULL;
/* Forward declaration */
struct Target;
@@ -50,9 +47,9 @@ typedef struct Alias {
* This is used by alias deletion to remove
* the alias from the slave interpreter alias
* table. */
- struct Target *targetPtr; /* Entry for target command in master. This
- * is used in the master interpreter to map
- * back from the target command to aliases
+ struct Target *targetPtr; /* Entry for target command in master. This is
+ * used in the master interpreter to map back
+ * from the target command to aliases
* redirecting to it. */
int objc; /* Count of Tcl_Obj in the prefix of the
* target command to be invoked in the target
@@ -80,7 +77,7 @@ typedef struct Slave {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
- * slave interpreter. Used to find this
+ * slave interpreter. Used to find this
* record, and used when deleting the slave
* interpreter to delete it from the master's
* table. */
@@ -156,98 +153,137 @@ typedef struct InterpInfo {
/*
* Limit callbacks handled by scripts are modelled as structures which are
- * stored in hashes indexed by a two-word key. Note that the type of the
+ * stored in hashes indexed by a two-word key. Note that the type of the
* 'type' field in the key is not int; this is to make sure that things are
* likely to work properly on 64-bit architectures.
*/
-struct ScriptLimitCallback {
- Tcl_Interp *interp;
- Tcl_Obj *scriptObj;
- int type;
- Tcl_HashEntry *entryPtr;
-};
+typedef struct ScriptLimitCallback {
+ Tcl_Interp *interp; /* The interpreter in which to execute the
+ * callback. */
+ Tcl_Obj *scriptObj; /* The script to execute to perform the
+ * user-defined part of the callback. */
+ int type; /* What kind of callback is this. */
+ Tcl_HashEntry *entryPtr; /* The entry in the hash table maintained by
+ * the target interpreter that refers to this
+ * callback record, or NULL if the entry has
+ * already been deleted from that hash
+ * table. */
+} ScriptLimitCallback;
+
+typedef struct ScriptLimitCallbackKey {
+ Tcl_Interp *interp; /* The interpreter that the limit callback was
+ * attached to. This is not the interpreter
+ * that the callback runs in! */
+ long type; /* The type of callback that this is. */
+} ScriptLimitCallbackKey;
-struct ScriptLimitCallbackKey {
- Tcl_Interp *interp;
- long type;
+/*
+ * TIP#143 limit handler internal representation.
+ */
+
+struct LimitHandler {
+ int flags; /* The state of this particular handler. */
+ Tcl_LimitHandlerProc *handlerProc;
+ /* The handler callback. */
+ ClientData clientData; /* Opaque argument to the handler callback. */
+ Tcl_LimitHandlerDeleteProc *deleteProc;
+ /* How to delete the clientData. */
+ LimitHandler *prevPtr; /* Previous item in linked list of
+ * handlers. */
+ LimitHandler *nextPtr; /* Next item in linked list of handlers. */
};
/*
- * Prototypes for local static procedures:
+ * Values for the LimitHandler flags field.
+ * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
+ * processed; handlers are never to be entered reentrantly.
+ * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
+ * should not normally be observed because when a handler is
+ * deleted it is also spliced out of the list of handlers, but
+ * even so we will be careful.
+ */
+
+#define LIMIT_HANDLER_ACTIVE 0x01
+#define LIMIT_HANDLER_DELETED 0x02
+
+
+
+/*
+ * Prototypes for local static functions:
*/
-static int AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
+static int AliasCreate(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));
-static int AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));
-static int AliasList _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int AliasObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static int AliasDelete(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
+static int AliasDescribe(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
+static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
+static int AliasObjCmd(ClientData dummy,
Tcl_Interp *currentInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static void AliasObjCmdDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-
-static Tcl_Interp * GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr));
-static Tcl_Interp * GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void InterpInfoDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static int SlaveBgerror _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static Tcl_Interp * SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int safe));
-static int SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *const objv[]);
+static int AliasNRCmd(ClientData dummy,
+ Tcl_Interp *currentInterp, int objc,
+ Tcl_Obj *const objv[]);
+static void AliasObjCmdDeleteProc(ClientData clientData);
+static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void InterpInfoDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static int SlaveBgerror(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveHide _ANSI_ARGS_((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,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *const objv[]);
+static int SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+ int objc, Tcl_Obj *const objv[]);
+static int SlaveHidden(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp);
+static int SlaveInvokeHidden(Tcl_Interp *interp,
Tcl_Interp *slaveInterp,
- CONST char *namespaceName,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-static int SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
+ const char *namespaceName,
+ int objc, Tcl_Obj *const objv[]);
+static int SlaveMarkTrusted(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp);
+static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static void SlaveObjCmdDeleteProc(ClientData clientData);
+static int SlaveRecursionLimit(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveCommandLimitCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *const objv[]);
+static int SlaveCommandLimitCmd(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int consumedObjc,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveTimeLimitCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int SlaveTimeLimitCmd(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int consumedObjc,
- int objc, Tcl_Obj *CONST objv[]));
-static void InheritLimitsFromMaster _ANSI_ARGS_((
- Tcl_Interp *slaveInterp,
- Tcl_Interp *masterInterp));
-static void SetScriptLimitCallback _ANSI_ARGS_((Tcl_Interp *interp,
- int type, Tcl_Interp *targetInterp,
- Tcl_Obj *scriptObj));
-static void CallScriptLimitCallback _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void DeleteScriptLimitCallback _ANSI_ARGS_((
- ClientData clientData));
-static void RunLimitHandlers _ANSI_ARGS_((LimitHandler *handlerPtr,
- Tcl_Interp *interp));
-static void TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
+ int objc, Tcl_Obj *const objv[]);
+static void InheritLimitsFromMaster(Tcl_Interp *slaveInterp,
+ Tcl_Interp *masterInterp);
+static void SetScriptLimitCallback(Tcl_Interp *interp, int type,
+ Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
+static void CallScriptLimitCallback(ClientData clientData,
+ Tcl_Interp *interp);
+static void DeleteScriptLimitCallback(ClientData clientData);
+static void RunLimitHandlers(LimitHandler *handlerPtr,
+ Tcl_Interp *interp);
+static void TimeLimitCallback(ClientData clientData);
+
+/* NRE enabling */
+static Tcl_NRPostProc NRPostInvokeHidden;
+static Tcl_ObjCmdProc NRInterpCmd;
+static Tcl_ObjCmdProc NRSlaveCmd;
/*
@@ -267,11 +303,11 @@ static void TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
*----------------------------------------------------------------------
*/
-char *
-TclSetPreInitScript (string)
- char *string; /* Pointer to a script. */
+const char *
+TclSetPreInitScript(
+ const char *string) /* Pointer to a script. */
{
- char *prevString = tclPreInitScript;
+ const char *prevString = tclPreInitScript;
tclPreInitScript = string;
return(prevString);
}
@@ -281,7 +317,7 @@ TclSetPreInitScript (string)
*
* Tcl_Init --
*
- * This procedure is typically invoked by Tcl_AppInit procedures to find
+ * This function is typically invoked by Tcl_AppInit functions to find
* and source the "init.tcl" script, which should exist somewhere on the
* Tcl library path.
*
@@ -296,40 +332,40 @@ TclSetPreInitScript (string)
*/
int
-Tcl_Init(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
+Tcl_Init(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
{
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return (TCL_ERROR);
- };
+ return TCL_ERROR;
+ }
}
/*
* In order to find init.tcl during initialization, the following script
- * is invoked by Tcl_Init(). It looks in several different directories:
+ * is invoked by Tcl_Init(). It looks in several different directories:
*
* $tcl_library - can specify a primary location, if set, no
- * other locations will be checked. This is
- * the recommended way for a program that
- * embeds Tcl to specifically tell Tcl where to
- * find an init.tcl file.
+ * other locations will be checked. This is the
+ * recommended way for a program that embeds
+ * Tcl to specifically tell Tcl where to find
+ * an init.tcl file.
*
* $env(TCL_LIBRARY) - highest priority so user can always override
* the search path unless the application has
* specified an exact directory above
*
- * $tclDefaultLibrary - INTERNAL: This variable is set by Tcl
- * on those platforms where it can determine at
+ * $tclDefaultLibrary - INTERNAL: This variable is set by Tcl on
+ * those platforms where it can determine at
* runtime the directory where it expects the
- * init.tcl file to be. After [tclInit] reads
+ * init.tcl file to be. After [tclInit] reads
* and uses this value, it [unset]s it.
* External users of Tcl should not make use of
* the variable to customize [tclInit].
*
- * $tcl_libPath - OBSOLETE: This variable is no longer
- * set by Tcl itself, but [tclInit] examines it
- * in case some program that embeds Tcl is
+ * $tcl_libPath - OBSOLETE: This variable is no longer set by
+ * Tcl itself, but [tclInit] examines it in
+ * case some program that embeds Tcl is
* customizing [tclInit] by setting this
* variable to a list of directories in which
* to search.
@@ -343,11 +379,11 @@ Tcl_Init(interp)
* will be set as the value of tcl_library.
*
* Note that this entire search mechanism can be bypassed by defining an
- * alternate tclInit procedure before calling Tcl_Init().
+ * alternate tclInit command before calling Tcl_Init().
*/
return Tcl_Eval(interp,
-"if {[info proc tclInit]==\"\"} {\n"
+"if {[namespace which -command tclInit] eq \"\"} {\n"
" proc tclInit {} {\n"
" global tcl_libPath tcl_library env tclDefaultLibrary\n"
" rename tclInit {}\n"
@@ -417,8 +453,7 @@ Tcl_Init(interp)
* TclInterpInit --
*
* Initializes the invoking interpreter for using the master, slave and
- * safe interp facilities. This is called from inside
- * Tcl_CreateInterp().
+ * safe interp facilities. This is called from inside Tcl_CreateInterp().
*
* Results:
* Always returns TCL_OK for backwards compatibility.
@@ -431,15 +466,15 @@ Tcl_Init(interp)
*/
int
-TclInterpInit(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
+TclInterpInit(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
{
InterpInfo *interpInfoPtr;
Master *masterPtr;
Slave *slavePtr;
- interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
- ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;
+ interpInfoPtr = ckalloc(sizeof(InterpInfo));
+ ((Interp *) interp)->interpInfo = interpInfoPtr;
masterPtr = &interpInfoPtr->master;
Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
@@ -452,7 +487,8 @@ TclInterpInit(interp)
slavePtr->interpCmd = NULL;
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
- Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
+ Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
+ NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
return TCL_OK;
@@ -463,7 +499,7 @@ TclInterpInit(interp)
*
* InterpInfoDeleteProc --
*
- * Invoked when an interpreter is being deleted. It releases all storage
+ * Invoked when an interpreter is being deleted. It releases all storage
* used by the master/slave/safe interpreter facilities.
*
* Results:
@@ -476,9 +512,9 @@ TclInterpInit(interp)
*/
static void
-InterpInfoDeleteProc(clientData, interp)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* Interp being deleted. All commands for
+InterpInfoDeleteProc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp) /* Interp being deleted. All commands for
* slave interps should already be deleted. */
{
InterpInfo *interpInfoPtr;
@@ -534,7 +570,7 @@ InterpInfoDeleteProc(clientData, interp)
}
Tcl_DeleteHashTable(&slavePtr->aliasTable);
- ckfree((char *) interpInfoPtr);
+ ckfree(interpInfoPtr);
}
/*
@@ -542,8 +578,8 @@ InterpInfoDeleteProc(clientData, interp)
*
* Tcl_InterpObjCmd --
*
- * This procedure is invoked to process the "interp" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "interp" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -555,27 +591,40 @@ InterpInfoDeleteProc(clientData, interp)
*/
/* ARGSUSED */
int
-Tcl_InterpObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Unused. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_InterpObjCmd(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
+}
+
+static int
+NRInterpCmd(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Interp *slaveInterp;
int index;
- static CONST char *options[] = {
- "alias", "aliases", "bgerror", "create",
- "delete", "eval", "exists", "expose",
- "hide", "hidden", "issafe", "invokehidden",
- "limit", "marktrusted", "recursionlimit","slaves",
- "share", "target", "transfer",
+ static const char *const options[] = {
+ "alias", "aliases", "bgerror", "cancel",
+ "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_CREATE,
- 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
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
+ 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
};
if (objc < 2) {
@@ -588,30 +637,30 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
}
switch ((enum option) index) {
case OPT_ALIAS: {
- Tcl_Interp *slaveInterp, *masterInterp;
+ Tcl_Interp *masterInterp;
if (objc < 4) {
aliasArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
+ "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == (Tcl_Interp *) NULL) {
+ if (slaveInterp == NULL) {
return TCL_ERROR;
}
if (objc == 4) {
return AliasDescribe(interp, slaveInterp, objv[3]);
}
- if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {
+ if ((objc == 5) && (TclGetString(objv[4])[0] == '\0')) {
return AliasDelete(interp, slaveInterp, objv[3]);
}
if (objc > 5) {
masterInterp = GetInterp(interp, objv[4]);
- if (masterInterp == (Tcl_Interp *) NULL) {
+ if (masterInterp == NULL) {
return TCL_ERROR;
}
- if (Tcl_GetString(objv[5])[0] == '\0') {
+ if (TclGetString(objv[5])[0] == '\0') {
if (objc == 6) {
return AliasDelete(interp, slaveInterp, objv[3]);
}
@@ -622,18 +671,13 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
}
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;
@@ -643,13 +687,84 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
+ case OPT_CANCEL: {
+ int i, flags;
+ Tcl_Obj *resultObjPtr;
+ static const char *const cancelOptions[] = {
+ "-unwind", "--", NULL
+ };
+ enum option {
+ OPT_UNWIND, OPT_LAST
+ };
+
+ flags = 0;
+
+ for (i = 2; i < objc; i++) {
+ if (TclGetString(objv[i])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum option) index) {
+ case OPT_UNWIND:
+ /*
+ * The evaluation stack in the target interp is to be unwound.
+ */
+
+ flags |= TCL_CANCEL_UNWIND;
+ break;
+ case OPT_LAST:
+ i++;
+ goto endOfForLoop;
+ }
+ }
+
+ endOfForLoop:
+ if ((i + 2) < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-unwind? ?--? ?path? ?result?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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 (i < objc) {
+ resultObjPtr = objv[i];
+
+ /*
+ * Tcl_CancelEval removes this reference.
+ */
+
+ Tcl_IncrRefCount(resultObjPtr);
+ i++;
+ } else {
+ resultObjPtr = NULL;
+ }
+
+ return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
}
case OPT_CREATE: {
int i, last, safe;
Tcl_Obj *slavePtr;
char buf[16 + TCL_INTEGER_SPACE];
- static CONST char *options[] = {
- "-safe", "--", NULL
+ static const char *const createOptions[] = {
+ "-safe", "--", NULL
};
enum option {
OPT_SAFE, OPT_LAST
@@ -665,8 +780,8 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
last = 0;
for (i = 2; i < objc; i++) {
if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
+ "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_SAFE) {
@@ -712,10 +827,23 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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]);
@@ -724,6 +852,8 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
} 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;
@@ -732,9 +862,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
}
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;
@@ -744,12 +872,9 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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) {
@@ -761,9 +886,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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;
@@ -773,45 +896,34 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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;
}
slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == (Tcl_Interp *) NULL) {
+ if (slaveInterp == NULL) {
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, index;
- CONST char *namespaceName;
- Tcl_Interp *slaveInterp;
- static CONST char *hiddenOptions[] = {
- "-global", "-namespace", "--", NULL
+ int i;
+ const char *namespaceName;
+ static const char *const hiddenOptions[] = {
+ "-global", "-namespace", "--", NULL
};
enum hiddenOption {
OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST
@@ -819,7 +931,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
namespaceName = NULL;
for (i = 3; i < objc; i++) {
- if (Tcl_GetString(objv[i])[0] != '-') {
+ if (TclGetString(objv[i])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
@@ -832,7 +944,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
if (++i == objc) { /* There must be more arguments. */
break;
} else {
- namespaceName = Tcl_GetString(objv[i]);
+ namespaceName = TclGetString(objv[i]);
}
} else {
i++;
@@ -845,15 +957,14 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == (Tcl_Interp *) NULL) {
+ if (slaveInterp == NULL) {
return TCL_ERROR;
}
return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i,
objv + i);
}
case OPT_LIMIT: {
- Tcl_Interp *slaveInterp;
- static CONST char *limitTypes[] = {
+ static const char *const limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -862,7 +973,8 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
int limitType;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "path limitType ?-option value ...?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
@@ -880,9 +992,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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;
@@ -892,10 +1002,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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;
@@ -905,9 +1012,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
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;
@@ -929,9 +1034,9 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
+ 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) {
@@ -942,9 +1047,9 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
if (masterInterp == NULL) {
return TCL_ERROR;
}
- chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);
+ chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
if (chan == NULL) {
- TclTransferResult(masterInterp, TCL_OK, interp);
+ Tcl_TransferResult(masterInterp, TCL_OK, interp);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[4]);
@@ -952,14 +1057,24 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
Tcl_RegisterChannel(slaveInterp, chan);
+ if (index == OPT_TRANSFER) {
+ /*
+ * When transferring, as opposed to sharing, we must unhitch the
+ * channel from the interpreter where it started.
+ */
+
+ if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
+ Tcl_TransferResult(masterInterp, TCL_OK, interp);
+ return TCL_ERROR;
+ }
+ }
return TCL_OK;
}
case OPT_TARGET: {
- Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
- char *aliasName;
+ const char *aliasName;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path alias");
@@ -971,50 +1086,25 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- aliasName = Tcl_GetString(objv[3]);
+ aliasName = TclGetString(objv[3]);
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", (char *) 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 = (Alias *) Tcl_GetHashValue(hPtr);
+ 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", (char *) NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
- }
- case OPT_TRANSFER: {
- Tcl_Interp *slaveInterp; /* A slave. */
- Tcl_Interp *masterInterp; /* Its master. */
- Tcl_Channel chan;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
- return TCL_ERROR;
- }
- masterInterp = GetInterp(interp, objv[2]);
- if (masterInterp == NULL) {
- return TCL_ERROR;
- }
- chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);
- if (chan == NULL) {
- TclTransferResult(masterInterp, TCL_OK, interp);
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, objv[4]);
- if (slaveInterp == NULL) {
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(slaveInterp, chan);
- if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
- TclTransferResult(masterInterp, TCL_OK, interp);
+ 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;
@@ -1045,11 +1135,11 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
*/
static Tcl_Interp *
-GetInterp2(interp, objc, objv)
- Tcl_Interp *interp; /* Default interp if no interp was specified
+GetInterp2(
+ Tcl_Interp *interp, /* Default interp if no interp was specified
* on the command line. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc == 2) {
return interp;
@@ -1078,20 +1168,20 @@ GetInterp2(interp, objc, objv)
*/
int
-Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- CONST char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- CONST char *targetCmd; /* Name of target command. */
- int argc; /* How many additional arguments? */
- CONST char * CONST *argv; /* These are the additional args. */
+Tcl_CreateAlias(
+ Tcl_Interp *slaveInterp, /* Interpreter for source command. */
+ const char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *targetInterp, /* Interpreter for target command. */
+ const char *targetCmd, /* Name of target command. */
+ int argc, /* How many additional arguments? */
+ const char *const *argv) /* These are the additional args. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
Tcl_Obj **objv;
int i;
int result;
- objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
+ objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
@@ -1109,7 +1199,7 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
for (i = 0; i < argc; i++) {
Tcl_DecrRefCount(objv[i]);
}
- ckfree((char *) objv);
+ TclStackFree(slaveInterp, objv);
Tcl_DecrRefCount(targetObjPtr);
Tcl_DecrRefCount(slaveObjPtr);
@@ -1133,13 +1223,13 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
*/
int
-Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- CONST char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- CONST char *targetCmd; /* Name of target command. */
- int objc; /* How many additional arguments? */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
+Tcl_CreateAliasObj(
+ Tcl_Interp *slaveInterp, /* Interpreter for source command. */
+ const char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *targetInterp, /* Interpreter for target command. */
+ const char *targetCmd, /* Name of target command. */
+ int objc, /* How many additional arguments? */
+ Tcl_Obj *const objv[]) /* Argument vector. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
int result;
@@ -1175,29 +1265,29 @@ Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
*/
int
-Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
- argvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- CONST char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- CONST char **targetNamePtr; /* (Return) name of target command. */
- int *argcPtr; /* (Return) count of addnl args. */
- CONST char ***argvPtr; /* (Return) additional arguments. */
+Tcl_GetAlias(
+ Tcl_Interp *interp, /* Interp to start search from. */
+ const char *aliasName, /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr,
+ /* (Return) target interpreter. */
+ const char **targetNamePtr, /* (Return) name of target command. */
+ int *argcPtr, /* (Return) count of addnl args. */
+ const char ***argvPtr) /* (Return) additional arguments. */
{
- InterpInfo *iiPtr;
+ InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
int i, objc;
Tcl_Obj **objv;
- iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName,
- "\" not found", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ aliasPtr = Tcl_GetHashValue(hPtr);
objc = aliasPtr->objc;
objv = &aliasPtr->objPtr;
@@ -1205,16 +1295,16 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
*targetInterpPtr = aliasPtr->targetInterp;
}
if (targetNamePtr != NULL) {
- *targetNamePtr = Tcl_GetString(objv[0]);
+ *targetNamePtr = TclGetString(objv[0]);
}
if (argcPtr != NULL) {
*argcPtr = objc - 1;
}
if (argvPtr != NULL) {
- *argvPtr = (CONST char **)
- ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
+ *argvPtr = (const char **)
+ ckalloc(sizeof(const char *) * (objc - 1));
for (i = 1; i < objc; i++) {
- *argvPtr[i - 1] = Tcl_GetString(objv[i]);
+ (*argvPtr)[i - 1] = TclGetString(objv[i]);
}
}
return TCL_OK;
@@ -1237,42 +1327,42 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
*/
int
-Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
- objvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- CONST char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- CONST char **targetNamePtr; /* (Return) name of target command. */
- int *objcPtr; /* (Return) count of addnl args. */
- Tcl_Obj ***objvPtr; /* (Return) additional args. */
+Tcl_GetAliasObj(
+ Tcl_Interp *interp, /* Interp to start search from. */
+ const char *aliasName, /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr,
+ /* (Return) target interpreter. */
+ const char **targetNamePtr, /* (Return) name of target command. */
+ int *objcPtr, /* (Return) count of addnl args. */
+ Tcl_Obj ***objvPtr) /* (Return) additional args. */
{
- InterpInfo *iiPtr;
+ InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
int objc;
Tcl_Obj **objv;
- iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
- (char *) NULL);
+ if (hPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ aliasPtr = Tcl_GetHashValue(hPtr);
objc = aliasPtr->objc;
objv = &aliasPtr->objPtr;
- if (targetInterpPtr != (Tcl_Interp **) NULL) {
+ if (targetInterpPtr != NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
}
- if (targetNamePtr != (CONST char **) NULL) {
- *targetNamePtr = Tcl_GetString(objv[0]);
+ if (targetNamePtr != NULL) {
+ *targetNamePtr = TclGetString(objv[0]);
}
- if (objcPtr != (int *) NULL) {
+ if (objcPtr != NULL) {
*objcPtr = objc - 1;
}
- if (objvPtr != (Tcl_Obj ***) NULL) {
+ if (objvPtr != NULL) {
*objvPtr = objv + 1;
}
return TCL_OK;
@@ -1301,12 +1391,11 @@ Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
*/
int
-TclPreventAliasLoop(interp, cmdInterp, cmd)
- Tcl_Interp *interp; /* Interp in which to report errors. */
- Tcl_Interp *cmdInterp; /* Interp in which the command is
- * being defined. */
- Tcl_Command cmd; /* Tcl command we are attempting to
- * define. */
+TclPreventAliasLoop(
+ Tcl_Interp *interp, /* Interp in which to report errors. */
+ Tcl_Interp *cmdInterp, /* Interp in which the command is being
+ * defined. */
+ Tcl_Command cmd) /* Tcl command we are attempting to define. */
{
Command *cmdPtr = (Command *) cmd;
Alias *aliasPtr, *nextAliasPtr;
@@ -1328,7 +1417,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
* chain then we have a loop.
*/
- aliasPtr = (Alias *) cmdPtr->objClientData;
+ aliasPtr = cmdPtr->objClientData;
nextAliasPtr = aliasPtr;
while (1) {
Tcl_Obj *cmdNamePtr;
@@ -1344,24 +1433,26 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
* [Bug #641195]
*/
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": interpreter deleted", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot define or rename alias \"%s\": interpreter deleted",
+ Tcl_GetCommandName(cmdInterp, cmd)));
return TCL_ERROR;
}
cmdNamePtr = nextAliasPtr->objPtr;
aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
- Tcl_GetString(cmdNamePtr),
+ TclGetString(cmdNamePtr),
Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
/*flags*/ 0);
- if (aliasCmd == (Tcl_Command) NULL) {
+ if (aliasCmd == NULL) {
return TCL_OK;
}
aliasCmdPtr = (Command *) aliasCmd;
if (aliasCmdPtr == cmdPtr) {
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": would create a loop", (char *) 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;
}
@@ -1374,7 +1465,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
if (aliasCmdPtr->objProc != AliasObjCmd) {
return TCL_OK;
}
- nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
+ nextAliasPtr = aliasCmdPtr->objClientData;
}
/* NOTREACHED */
@@ -1398,17 +1489,16 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
*/
static int
-AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
- objc, objv)
- Tcl_Interp *interp; /* Interp for error reporting. */
- Tcl_Interp *slaveInterp; /* Interp where alias cmd will live or from
+AliasCreate(
+ Tcl_Interp *interp, /* Interp for error reporting. */
+ Tcl_Interp *slaveInterp, /* Interp where alias cmd will live or from
* which alias will be deleted. */
- Tcl_Interp *masterInterp; /* Interp in which target command will be
+ Tcl_Interp *masterInterp, /* Interp in which target command will be
* invoked. */
- Tcl_Obj *namePtr; /* Name of alias cmd. */
- Tcl_Obj *targetNamePtr; /* Name of target cmd. */
- int objc; /* Additional arguments to store */
- Tcl_Obj *CONST objv[]; /* with alias. */
+ Tcl_Obj *namePtr, /* Name of alias cmd. */
+ Tcl_Obj *targetNamePtr, /* Name of target cmd. */
+ int objc, /* Additional arguments to store */
+ Tcl_Obj *const objv[]) /* with alias. */
{
Alias *aliasPtr;
Tcl_HashEntry *hPtr;
@@ -1416,10 +1506,9 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
Slave *slavePtr;
Master *masterPtr;
Tcl_Obj **prefv;
- int new, i;
+ 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;
@@ -1437,17 +1526,23 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
Tcl_Preserve(slaveInterp);
Tcl_Preserve(masterInterp);
+ if (slaveInterp == masterInterp) {
+ aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
+ TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
+ AliasObjCmdDeleteProc);
+ } else {
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
- Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,
+ TclGetString(namePtr), AliasObjCmd, aliasPtr,
AliasObjCmdDeleteProc);
+ }
if (TclPreventAliasLoop(interp, slaveInterp,
aliasPtr->slaveCmd) != TCL_OK) {
/*
- * Found an alias loop! The last call to Tcl_CreateObjCommand made
- * the alias point to itself. Delete the command and its alias
- * record. Be careful to wipe out its client data first, so the
- * command doesn't try to delete itself.
+ * Found an alias loop! The last call to Tcl_CreateObjCommand made the
+ * alias point to itself. Delete the command and its alias record. Be
+ * careful to wipe out its client data first, so the command doesn't
+ * try to delete itself.
*/
Command *cmdPtr;
@@ -1464,7 +1559,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
- ckfree((char *) aliasPtr);
+ ckfree(aliasPtr);
/*
* The result was already set by TclPreventAliasLoop.
@@ -1482,11 +1577,11 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
while (1) {
Tcl_Obj *newToken;
- char *string;
+ const char *string;
- string = Tcl_GetString(aliasPtr->token);
- hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
- if (new != 0) {
+ string = TclGetString(aliasPtr->token);
+ hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
+ if (isNew != 0) {
break;
}
@@ -1502,7 +1597,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
* on the precise definition of these tokens.
*/
- newToken = Tcl_NewStringObj("::",-1);
+ TclNewLiteralStringObj(newToken, "::");
Tcl_AppendObjToObj(newToken, aliasPtr->token);
Tcl_DecrRefCount(aliasPtr->token);
aliasPtr->token = newToken;
@@ -1510,7 +1605,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
}
aliasPtr->aliasEntryPtr = hPtr;
- Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
+ Tcl_SetHashValue(hPtr, aliasPtr);
/*
* Create the new command. We must do it after deleting any old command,
@@ -1521,11 +1616,11 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
* 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) {
@@ -1558,10 +1653,10 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
*/
static int
-AliasDelete(interp, slaveInterp, namePtr)
- Tcl_Interp *interp; /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
- Tcl_Obj *namePtr; /* Name of alias to delete. */
+AliasDelete(
+ Tcl_Interp *interp, /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Obj *namePtr) /* Name of alias to delete. */
{
Slave *slavePtr;
Alias *aliasPtr;
@@ -1574,13 +1669,15 @@ AliasDelete(interp, slaveInterp, namePtr)
*/
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
- hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
+ hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", Tcl_GetString(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;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ aliasPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
return TCL_OK;
}
@@ -1604,10 +1701,10 @@ AliasDelete(interp, slaveInterp, namePtr)
*/
static int
-AliasDescribe(interp, slaveInterp, namePtr)
- Tcl_Interp *interp; /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
- Tcl_Obj *namePtr; /* Name of alias to describe. */
+AliasDescribe(
+ Tcl_Interp *interp, /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Obj *namePtr) /* Name of alias to describe. */
{
Slave *slavePtr;
Tcl_HashEntry *hPtr;
@@ -1625,7 +1722,7 @@ AliasDescribe(interp, slaveInterp, namePtr)
if (hPtr == NULL) {
return TCL_OK;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ aliasPtr = Tcl_GetHashValue(hPtr);
prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
Tcl_SetObjResult(interp, prefixPtr);
return TCL_OK;
@@ -1648,9 +1745,9 @@ AliasDescribe(interp, slaveInterp, namePtr)
*/
static int
-AliasList(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for data return. */
- Tcl_Interp *slaveInterp; /* Interp whose aliases to compute. */
+AliasList(
+ Tcl_Interp *interp, /* Interp for data return. */
+ Tcl_Interp *slaveInterp) /* Interp whose aliases to compute. */
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch hashSearch;
@@ -1662,7 +1759,7 @@ AliasList(interp, slaveInterp)
entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
- aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
+ aliasPtr = Tcl_GetHashValue(entryPtr);
Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -1674,9 +1771,9 @@ AliasList(interp, slaveInterp)
*
* AliasObjCmd --
*
- * This is the procedure that services invocations of aliases in a slave
+ * This is the function that services invocations of aliases in a slave
* interpreter. One such command exists for each alias. When invoked,
- * this procedure redirects the invocation to the target command in the
+ * this function redirects the invocation to the target command in the
* master interpreter as designated by the Alias record associated with
* this command.
*
@@ -1692,20 +1789,84 @@ AliasList(interp, slaveInterp)
*/
static int
-AliasObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Alias record. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
+AliasNRCmd(
+ ClientData clientData, /* Alias record. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument vector. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Alias *aliasPtr = clientData;
+ int prefc, cmdc, i;
+ Tcl_Obj **prefv, **cmdv;
+ int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+ Tcl_Obj *listPtr;
+ List *listRep;
+ int flags = TCL_EVAL_INVOKE;
+
+ /*
+ * Append the arguments to the command prefix and invoke the command in
+ * the target interp's global namespace.
+ */
+
+ prefc = aliasPtr->objc;
+ prefv = &aliasPtr->objPtr;
+ cmdc = prefc + objc - 1;
+
+ listPtr = Tcl_NewListObj(cmdc, NULL);
+ listRep = listPtr->internalRep.twoPtrValue.ptr1;
+ listRep->elemCount = cmdc;
+ cmdv = &listRep->elements;
+
+ prefv = &aliasPtr->objPtr;
+ memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+ memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+
+ for (i=0; i<cmdc; i++) {
+ Tcl_IncrRefCount(cmdv[i]);
+ }
+
+ /*
+ * Use the ensemble rewriting machinery to ensure correct error messages:
+ * only the source command should show, not the full target prefix.
+ */
+
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 1;
+ iPtr->ensembleRewrite.numInsertedObjs = prefc;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
+ }
+
+ /*
+ * We are sending a 0-refCount obj, do not need a callback: it will be
+ * cleaned up automatically. But we may need to clear the rootEnsemble
+ * stuff ...
+ */
+
+ if (isRootEnsemble) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ }
+ TclSkipTailcall(interp);
+ return Tcl_NREvalObj(interp, listPtr, flags);
+}
+
+static int
+AliasObjCmd(
+ ClientData clientData, /* Alias record. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
- Tcl_Interp *targetInterp;
- Alias *aliasPtr;
+ Alias *aliasPtr = clientData;
+ Tcl_Interp *targetInterp = aliasPtr->targetInterp;
int result, prefc, cmdc, i;
Tcl_Obj **prefv, **cmdv;
Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
- aliasPtr = (Alias *) clientData;
- targetInterp = aliasPtr->targetInterp;
+ Interp *tPtr = (Interp *) targetInterp;
+ int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
/*
* Append the arguments to the command prefix and invoke the command in
@@ -1718,34 +1879,74 @@ AliasObjCmd(clientData, interp, objc, objv)
if (cmdc <= ALIAS_CMDV_PREALLOC) {
cmdv = cmdArr;
} else {
- cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));
+ cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
}
prefv = &aliasPtr->objPtr;
- memcpy((VOID *) cmdv, (VOID *) prefv,
- (size_t) (prefc * sizeof(Tcl_Obj *)));
- memcpy((VOID *) (cmdv+prefc), (VOID *) (objv+1),
- (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+ memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+ memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
Tcl_ResetResult(targetInterp);
for (i=0; i<cmdc; i++) {
Tcl_IncrRefCount(cmdv[i]);
}
- if (targetInterp != interp) {
- Tcl_Preserve((ClientData) targetInterp);
- result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
- TclTransferResult(targetInterp, result, interp);
- Tcl_Release((ClientData) targetInterp);
+
+ /*
+ * Use the ensemble rewriting machinery to ensure correct error messages:
+ * only the source command should show, not the full target prefix.
+ */
+
+ if (isRootEnsemble) {
+ tPtr->ensembleRewrite.sourceObjs = objv;
+ tPtr->ensembleRewrite.numRemovedObjs = 1;
+ tPtr->ensembleRewrite.numInsertedObjs = prefc;
} else {
- result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+ tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
+ }
+
+ /*
+ * Protect the target interpreter if it isn't the same as the source
+ * interpreter so that we can continue to work with it after the target
+ * command completes.
+ */
+
+ if (targetInterp != interp) {
+ Tcl_Preserve(targetInterp);
+ }
+
+ /*
+ * Execute the target command in the target interpreter.
+ */
+
+ result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+
+ /*
+ * Clean up the ensemble rewrite info if we set it in the first place.
+ */
+
+ if (isRootEnsemble) {
+ tPtr->ensembleRewrite.sourceObjs = NULL;
+ tPtr->ensembleRewrite.numRemovedObjs = 0;
+ tPtr->ensembleRewrite.numInsertedObjs = 0;
+ }
+
+ /*
+ * If it was a cross-interpreter alias, we need to transfer the result
+ * back to the source interpreter and release the lock we previously set
+ * on the target interpreter.
+ */
+
+ if (targetInterp != interp) {
+ Tcl_TransferResult(targetInterp, result, interp);
+ Tcl_Release(targetInterp);
}
+
for (i=0; i<cmdc; i++) {
Tcl_DecrRefCount(cmdv[i]);
}
-
if (cmdv != cmdArr) {
- ckfree((char *) cmdv);
+ TclStackFree(interp, cmdv);
}
return result;
#undef ALIAS_CMDV_PREALLOC
@@ -1770,16 +1971,14 @@ AliasObjCmd(clientData, interp, objc, objv)
*/
static void
-AliasObjCmdDeleteProc(clientData)
- ClientData clientData; /* The alias record for this alias. */
+AliasObjCmdDeleteProc(
+ ClientData clientData) /* The alias record for this alias. */
{
- Alias *aliasPtr;
+ Alias *aliasPtr = clientData;
Target *targetPtr;
int i;
Tcl_Obj **objv;
- aliasPtr = (Alias *) clientData;
-
Tcl_DecrRefCount(aliasPtr->token);
objv = &aliasPtr->objPtr;
for (i = 0; i < aliasPtr->objc; i++) {
@@ -1797,14 +1996,15 @@ AliasObjCmdDeleteProc(clientData)
} else {
Master *masterPtr = &((InterpInfo *) ((Interp *)
aliasPtr->targetInterp)->interpInfo)->master;
+
masterPtr->targetsPtr = targetPtr->nextPtr;
}
if (targetPtr->nextPtr != NULL) {
targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
}
- ckfree((char *) targetPtr);
- ckfree((char *) aliasPtr);
+ ckfree(targetPtr);
+ ckfree(aliasPtr);
}
/*
@@ -1831,10 +2031,10 @@ AliasObjCmdDeleteProc(clientData)
*/
Tcl_Interp *
-Tcl_CreateSlave(interp, slavePath, isSafe)
- Tcl_Interp *interp; /* Interpreter to start search at. */
- CONST char *slavePath; /* Name of slave to create. */
- int isSafe; /* Should new slave be "safe" ? */
+Tcl_CreateSlave(
+ Tcl_Interp *interp, /* Interpreter to start search at. */
+ const char *slavePath, /* Name of slave to create. */
+ int isSafe) /* Should new slave be "safe" ? */
{
Tcl_Obj *pathPtr;
Tcl_Interp *slaveInterp;
@@ -1863,9 +2063,9 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
*/
Tcl_Interp *
-Tcl_GetSlave(interp, slavePath)
- Tcl_Interp *interp; /* Interpreter to start search from. */
- CONST char *slavePath; /* Path of slave to find. */
+Tcl_GetSlave(
+ Tcl_Interp *interp, /* Interpreter to start search from. */
+ const char *slavePath) /* Path of slave to find. */
{
Tcl_Obj *pathPtr;
Tcl_Interp *slaveInterp;
@@ -1894,12 +2094,12 @@ Tcl_GetSlave(interp, slavePath)
*/
Tcl_Interp *
-Tcl_GetMaster(interp)
- Tcl_Interp *interp; /* Get the master of this interpreter. */
+Tcl_GetMaster(
+ Tcl_Interp *interp) /* Get the master of this interpreter. */
{
Slave *slavePtr; /* Slave record of this interpreter. */
- if (interp == (Tcl_Interp *) NULL) {
+ if (interp == NULL) {
return NULL;
}
slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
@@ -1909,6 +2109,72 @@ Tcl_GetMaster(interp)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -1931,24 +2197,26 @@ Tcl_GetMaster(interp)
*/
int
-Tcl_GetInterpPath(askingInterp, targetInterp)
- Tcl_Interp *askingInterp; /* Interpreter to start search from. */
- Tcl_Interp *targetInterp; /* Interpreter to find. */
+Tcl_GetInterpPath(
+ Tcl_Interp *askingInterp, /* Interpreter to start search from. */
+ Tcl_Interp *targetInterp) /* Interpreter to find. */
{
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;
}
@@ -1970,9 +2238,9 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
*/
static Tcl_Interp *
-GetInterp(interp, pathPtr)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Tcl_Obj *pathPtr; /* List object containing name of interp. to
+GetInterp(
+ Tcl_Interp *interp, /* Interp. to start search from. */
+ Tcl_Obj *pathPtr) /* List object containing name of interp. to
* be found. */
{
Tcl_HashEntry *hPtr; /* Search element. */
@@ -1982,7 +2250,7 @@ GetInterp(interp, pathPtr)
Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
InterpInfo *masterInfoPtr;
- if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
}
@@ -1990,20 +2258,22 @@ GetInterp(interp, pathPtr)
for (i = 0; i < objc; i++) {
masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
- Tcl_GetString(objv[i]));
+ TclGetString(objv[i]));
if (hPtr == NULL) {
searchInterp = NULL;
break;
}
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ slavePtr = Tcl_GetHashValue(hPtr);
searchInterp = slavePtr->slaveInterp;
if (searchInterp == NULL) {
break;
}
}
if (searchInterp == NULL) {
- Tcl_AppendResult(interp, "could not find interpreter \"",
- Tcl_GetString(pathPtr), "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not find interpreter \"%s\"", TclGetString(pathPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
+ TclGetString(pathPtr), NULL);
}
return searchInterp;
}
@@ -2027,24 +2297,26 @@ GetInterp(interp, pathPtr)
*/
static int
-SlaveBgerror(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which limit is set/queried. */
- int objc; /* Set or Query. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveBgerror(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ int objc, /* Set or Query. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
if (objc) {
int length;
- if (TCL_ERROR == Tcl_ListObjLength(NULL, objv[0], &length)
+ if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
|| (length < 1)) {
- Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
- (char *) 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(interp, objv[0]);
+ TclSetBgErrorHandler(slaveInterp, objv[0]);
}
- Tcl_SetObjResult(interp, TclGetBgErrorHandler(interp));
+ Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));
return TCL_OK;
}
@@ -2068,17 +2340,17 @@ SlaveBgerror(interp, slaveInterp, objc, objv)
*/
static Tcl_Interp *
-SlaveCreate(interp, pathPtr, safe)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Tcl_Obj *pathPtr; /* Path (name) of slave to create. */
- int safe; /* Should we make it "safe"? */
+SlaveCreate(
+ Tcl_Interp *interp, /* Interp. to start search from. */
+ Tcl_Obj *pathPtr, /* Path (name) of slave to create. */
+ int safe) /* Should we make it "safe"? */
{
Tcl_Interp *masterInterp, *slaveInterp;
Slave *slavePtr;
InterpInfo *masterInfoPtr;
Tcl_HashEntry *hPtr;
- char *path;
- int new, objc;
+ const char *path;
+ int isNew, objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
@@ -2086,7 +2358,7 @@ SlaveCreate(interp, pathPtr, safe)
}
if (objc < 2) {
masterInterp = interp;
- path = Tcl_GetString(pathPtr);
+ path = TclGetString(pathPtr);
} else {
Tcl_Obj *objPtr;
@@ -2096,17 +2368,19 @@ SlaveCreate(interp, pathPtr, safe)
if (masterInterp == NULL) {
return NULL;
}
- path = Tcl_GetString(objv[objc - 1]);
+ path = TclGetString(objv[objc - 1]);
}
if (safe == 0) {
safe = Tcl_IsSafe(masterInterp);
}
masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
- hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);
- if (new == 0) {
- Tcl_AppendResult(interp, "interpreter named \"", path,
- "\" already exists, cannot create", (char *) NULL);
+ hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
+ &isNew);
+ if (isNew == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "interpreter named \"%s\" already exists, cannot create",
+ path));
return NULL;
}
@@ -2115,10 +2389,10 @@ SlaveCreate(interp, pathPtr, safe)
slavePtr->masterInterp = masterInterp;
slavePtr->slaveEntryPtr = hPtr;
slavePtr->slaveInterp = slaveInterp;
- slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
- SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);
+ slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
+ SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
- Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
+ Tcl_SetHashValue(hPtr, slavePtr);
Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/*
@@ -2151,13 +2425,20 @@ SlaveCreate(interp, pathPtr, safe)
InheritLimitsFromMaster(slaveInterp, masterInterp);
+ /*
+ * The [clock] command presents a safe API, but uses unsafe features in
+ * its implementation. This means it has to be implemented in safe interps
+ * as an alias to a version in the (trusted) master.
+ */
+
if (safe) {
- Tcl_Obj* clockObj = Tcl_NewStringObj("clock", -1);
+ Tcl_Obj *clockObj;
int status;
+ TclNewLiteralStringObj(clockObj, "clock");
Tcl_IncrRefCount(clockObj);
status = AliasCreate(interp, slaveInterp, masterInterp, clockObj,
- clockObj, 0, (Tcl_Obj *CONST *) NULL);
+ clockObj, 0, NULL);
Tcl_DecrRefCount(clockObj);
if (status != TCL_OK) {
goto error2;
@@ -2166,9 +2447,9 @@ SlaveCreate(interp, pathPtr, safe)
return slaveInterp;
- error:
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
- error2:
+ error:
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ error2:
Tcl_DeleteInterp(slaveInterp);
return NULL;
@@ -2192,26 +2473,37 @@ SlaveCreate(interp, pathPtr, safe)
*/
static int
-SlaveObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Slave interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveObjCmd(
+ ClientData clientData, /* Slave interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Interp *slaveInterp;
+ return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
+}
+
+static int
+NRSlaveCmd(
+ ClientData clientData, /* Slave interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Interp *slaveInterp = clientData;
int index;
- static CONST char *options[] = {
- "alias", "aliases", "bgerror", "eval",
- "expose", "hide", "hidden", "issafe",
- "invokehidden", "limit", "marktrusted", "recursionlimit", NULL
+ static const char *const options[] = {
+ "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
};
- slaveInterp = (Tcl_Interp *) clientData;
if (slaveInterp == NULL) {
Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
}
@@ -2231,7 +2523,7 @@ SlaveObjCmd(clientData, interp, objc, objv)
if (objc == 3) {
return AliasDescribe(interp, slaveInterp, objv[2]);
}
- if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (TclGetString(objv[3])[0] == '\0') {
if (objc == 4) {
return AliasDelete(interp, slaveInterp, objv[2]);
}
@@ -2240,11 +2532,11 @@ SlaveObjCmd(clientData, interp, objc, objv)
objv[3], objc - 4, objv + 4);
}
}
- Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
+ Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
return TCL_ERROR;
case OPT_ALIASES:
if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
return AliasList(interp, slaveInterp);
@@ -2254,6 +2546,16 @@ SlaveObjCmd(clientData, interp, objc, objv)
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 ...?");
@@ -2280,17 +2582,16 @@ SlaveObjCmd(clientData, interp, objc, objv)
return SlaveHidden(interp, slaveInterp);
case OPT_ISSAFE:
if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
return TCL_OK;
case OPT_INVOKEHIDDEN: {
- int i, index;
- CONST char *namespaceName;
- static CONST char *hiddenOptions[] = {
- "-global", "-namespace", "--",
- NULL
+ int i;
+ const char *namespaceName;
+ static const char *const hiddenOptions[] = {
+ "-global", "-namespace", "--", NULL
};
enum hiddenOption {
OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST
@@ -2298,7 +2599,7 @@ SlaveObjCmd(clientData, interp, objc, objv)
namespaceName = NULL;
for (i = 2; i < objc; i++) {
- if (Tcl_GetString(objv[i])[0] != '-') {
+ if (TclGetString(objv[i])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
@@ -2311,7 +2612,7 @@ SlaveObjCmd(clientData, interp, objc, objv)
if (++i == objc) { /* There must be more arguments. */
break;
} else {
- namespaceName = Tcl_GetString(objv[i]);
+ namespaceName = TclGetString(objv[i]);
}
} else {
i++;
@@ -2327,7 +2628,7 @@ SlaveObjCmd(clientData, interp, objc, objv)
objc - i, objv + i);
}
case OPT_LIMIT: {
- static CONST char *limitTypes[] = {
+ static const char *const limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -2336,7 +2637,7 @@ SlaveObjCmd(clientData, interp, objc, objv)
int limitType;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
+ Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
@@ -2387,13 +2688,13 @@ SlaveObjCmd(clientData, interp, objc, objv)
*/
static void
-SlaveObjCmdDeleteProc(clientData)
- ClientData clientData; /* The SlaveRecord for the command. */
+SlaveObjCmdDeleteProc(
+ ClientData clientData) /* The SlaveRecord for the command. */
{
- Slave *slavePtr; /* Interim storage for Slave record. */
- Tcl_Interp *slaveInterp; /* And for a slave interp. */
+ Slave *slavePtr; /* Interim storage for Slave record. */
+ Tcl_Interp *slaveInterp = clientData;
+ /* And for a slave interp. */
- slaveInterp = (Tcl_Interp *) clientData;
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
/*
@@ -2404,7 +2705,7 @@ SlaveObjCmdDeleteProc(clientData)
/*
* Set to NULL so that when the InterpInfo is cleaned up in the slave it
- * does not try to delete the command causing all sorts of grief. See
+ * does not try to delete the command causing all sorts of grief. See
* SlaveRecordDeleteProc().
*/
@@ -2418,6 +2719,77 @@ SlaveObjCmdDeleteProc(clientData)
/*
*----------------------------------------------------------------------
*
+ * 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.
@@ -2432,30 +2804,49 @@ SlaveObjCmdDeleteProc(clientData)
*/
static int
-SlaveEval(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter in which command
+SlaveEval(
+ 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. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
- Tcl_Obj *objPtr;
- Tcl_Preserve((ClientData) slaveInterp);
+ /*
+ * 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);
if (objc == 1) {
- result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
+ /*
+ * TIP #280: Make actual argument location available to eval'd script.
+ */
+
+ Interp *iPtr = (Interp *) interp;
+ CmdFrame *invoker = iPtr->cmdFramePtr;
+ int word = 0;
+
+ TclArgumentGet(interp, objv[0], &invoker, &word);
+
+ result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
} else {
- objPtr = Tcl_ConcatObj(objc, objv);
+ Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
Tcl_DecrRefCount(objPtr);
}
- TclTransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(slaveInterp, result, interp);
- Tcl_Release((ClientData) slaveInterp);
+ Tcl_Release(slaveInterp);
return result;
}
@@ -2477,25 +2868,27 @@ SlaveEval(interp, slaveInterp, objc, objv)
*/
static int
-SlaveExpose(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveExpose(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
- char *name;
+ const char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot expose commands",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
- name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
- if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
+ name = TclGetString(objv[(objc == 1) ? 0 : 1]);
+ if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
name) != TCL_OK) {
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2519,28 +2912,31 @@ SlaveExpose(interp, slaveInterp, objc, objv)
*/
static int
-SlaveRecursionLimit(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which limit is set/queried. */
- int objc; /* Set or Query. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveRecursionLimit(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ int objc, /* Set or Query. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
Interp *iPtr;
int limit;
if (objc) {
if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "permission denied: ",
- "safe interpreters cannot change recursion limit",
- (char *) 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 (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
+ if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
return TCL_ERROR;
}
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);
@@ -2548,6 +2944,7 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv)
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]);
@@ -2577,24 +2974,26 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv)
*/
static int
-SlaveHide(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveHide(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
- char *name;
+ const char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot hide commands",
-1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+ NULL);
return TCL_ERROR;
}
- name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
- if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]), name) != TCL_OK) {
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ name = TclGetString(objv[(objc == 1) ? 0 : 1]);
+ if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2618,9 +3017,9 @@ SlaveHide(interp, slaveInterp, objc, objv)
*/
static int
-SlaveHidden(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for data return. */
- Tcl_Interp *slaveInterp; /* Interp whose hidden commands to query. */
+SlaveHidden(
+ Tcl_Interp *interp, /* Interp for data return. */
+ Tcl_Interp *slaveInterp) /* Interp whose hidden commands to query. */
{
Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */
Tcl_HashTable *hTblPtr; /* For local searches. */
@@ -2628,9 +3027,9 @@ SlaveHidden(interp, slaveInterp)
Tcl_HashSearch hSearch; /* For local searches. */
hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
- if (hTblPtr != (Tcl_HashTable *) NULL) {
+ if (hTblPtr != NULL) {
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
+ hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
Tcl_ListObjAppendElement(NULL, listObjPtr,
Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
@@ -2657,13 +3056,13 @@ SlaveHidden(interp, slaveInterp)
*/
static int
-SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter in which command will
+SlaveInvokeHidden(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* The slave interpreter in which command will
* be invoked. */
- CONST char *namespaceName; /* The namespace to use, if any. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+ const char *namespaceName, /* The namespace to use, if any. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
@@ -2671,31 +3070,53 @@ SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv)
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;
}
- Tcl_Preserve((ClientData) slaveInterp);
+ Tcl_Preserve(slaveInterp);
Tcl_AllowExceptions(slaveInterp);
if (namespaceName == NULL) {
- result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+ NRE_callback *rootPtr = TOP_CB(slaveInterp);
+
+ Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+ rootPtr, NULL, NULL);
+ return TclNRInvoke(NULL, slaveInterp, objc, objv);
} else {
Namespace *nsPtr, *dummy1, *dummy2;
- CONST char *tail;
+ const char *tail;
- result = TclGetNamespaceForQualName(slaveInterp, namespaceName,
- (Namespace *) NULL, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY
- | TCL_LEAVE_ERR_MSG | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr,
- &dummy1, &dummy2, &tail);
+ result = TclGetNamespaceForQualName(slaveInterp, namespaceName, NULL,
+ TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG
+ | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if (result == TCL_OK) {
result = TclObjInvokeNamespace(slaveInterp, objc, objv,
- (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
+ (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
}
}
- TclTransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(slaveInterp, result, interp);
+
+ Tcl_Release(slaveInterp);
+ return result;
+}
+
+static int
+NRPostInvokeHidden(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+ NRE_callback *rootPtr = (NRE_callback *)data[1];
- Tcl_Release((ClientData) slaveInterp);
+ if (interp != slaveInterp) {
+ result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
+ Tcl_TransferResult(slaveInterp, result, interp);
+ }
+ Tcl_Release(slaveInterp);
return result;
}
@@ -2717,15 +3138,17 @@ SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv)
*/
static int
-SlaveMarkTrusted(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter which will be marked
+SlaveMarkTrusted(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp) /* The slave interpreter which will be marked
* trusted. */
{
if (Tcl_IsSafe(interp)) {
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;
@@ -2749,17 +3172,15 @@ SlaveMarkTrusted(interp, slaveInterp)
*/
int
-Tcl_IsSafe(interp)
- Tcl_Interp *interp; /* Is this interpreter "safe" ? */
+Tcl_IsSafe(
+ Tcl_Interp *interp) /* Is this interpreter "safe" ? */
{
- Interp *iPtr;
+ Interp *iPtr = (Interp *) interp;
- if (interp == (Tcl_Interp *) NULL) {
+ if (iPtr == NULL) {
return 0;
}
- iPtr = (Interp *) interp;
-
- return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
+ return (iPtr->flags & SAFE_INTERP) ? 1 : 0;
}
/*
@@ -2782,14 +3203,31 @@ Tcl_IsSafe(interp)
*/
int
-Tcl_MakeSafe(interp)
- Tcl_Interp *interp; /* Interpreter to be made safe. */
+Tcl_MakeSafe(
+ Tcl_Interp *interp) /* Interpreter to be made safe. */
{
Tcl_Channel chan; /* Channel to remove from safe interpreter. */
Interp *iPtr = (Interp *) interp;
+ Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;
TclHideUnsafeCommands(interp);
+ if (master != NULL) {
+ /*
+ * Alias these function implementations in the slave to those in the
+ * master; the overall implementations are safe, but they're normally
+ * defined by init.tcl which is not sourced by safe interpreters.
+ * Assume these functions all work. [Bug 2895741]
+ */
+
+ (void) Tcl_Eval(interp,
+ "namespace eval ::tcl {namespace eval mathfunc {}}");
+ (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
+ "::tcl::mathfunc::min", 0, NULL);
+ (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
+ "::tcl::mathfunc::max", 0, NULL);
+ }
+
iPtr->flags |= SAFE_INTERP;
/*
@@ -2832,15 +3270,15 @@ Tcl_MakeSafe(interp)
*/
chan = Tcl_GetStdChannel(TCL_STDIN);
- if (chan != (Tcl_Channel) NULL) {
+ if (chan != NULL) {
Tcl_UnregisterChannel(interp, chan);
}
chan = Tcl_GetStdChannel(TCL_STDOUT);
- if (chan != (Tcl_Channel) NULL) {
+ if (chan != NULL) {
Tcl_UnregisterChannel(interp, chan);
}
chan = Tcl_GetStdChannel(TCL_STDERR);
- if (chan != (Tcl_Channel) NULL) {
+ if (chan != NULL) {
Tcl_UnregisterChannel(interp, chan);
}
@@ -2862,12 +3300,15 @@ Tcl_MakeSafe(interp)
* Side effects:
* None.
*
+ * Notes:
+ * If you change this function, you MUST also update TclLimitExceeded() in
+ * tclInt.h.
*----------------------------------------------------------------------
*/
int
-Tcl_LimitExceeded(interp)
- Tcl_Interp *interp;
+Tcl_LimitExceeded(
+ Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
@@ -2889,12 +3330,16 @@ Tcl_LimitExceeded(interp)
* Side effects:
* Increments the limit granularity counter.
*
+ * Notes:
+ * If you change this function, you MUST also update TclLimitReady() in
+ * tclInt.h.
+ *
*----------------------------------------------------------------------
*/
int
-Tcl_LimitReady(interp)
- Tcl_Interp *interp;
+Tcl_LimitReady(
+ Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
@@ -2921,7 +3366,7 @@ Tcl_LimitReady(interp)
* Tcl_LimitCheck --
*
* Check all currently set limits in the interpreter (where permitted by
- * granularity). If a limit is exceeded, call its callbacks and, if the
+ * granularity). If a limit is exceeded, call its callbacks and, if the
* limit is still exceeded after the callbacks have run, make the
* interpreter generate an error that cannot be caught within the limited
* interpreter.
@@ -2939,8 +3384,8 @@ Tcl_LimitReady(interp)
*/
int
-Tcl_LimitCheck(interp)
- Tcl_Interp *interp;
+Tcl_LimitCheck(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
register int ticker = iPtr->limit.granularityTicker;
@@ -2959,8 +3404,9 @@ Tcl_LimitCheck(interp)
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;
}
@@ -2984,8 +3430,9 @@ Tcl_LimitCheck(interp)
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;
}
@@ -3015,9 +3462,9 @@ Tcl_LimitCheck(interp)
*/
static void
-RunLimitHandlers(handlerPtr, interp)
- LimitHandler *handlerPtr;
- Tcl_Interp *interp;
+RunLimitHandlers(
+ LimitHandler *handlerPtr,
+ Tcl_Interp *interp)
{
LimitHandler *nextPtr;
for (; handlerPtr!=NULL ; handlerPtr=nextPtr) {
@@ -3038,12 +3485,12 @@ RunLimitHandlers(handlerPtr, interp)
*/
handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
- (handlerPtr->handlerProc)(handlerPtr->clientData, interp);
+ handlerPtr->handlerProc(handlerPtr->clientData, interp);
handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;
/*
* Rediscover this value; it might have changed during the processing
- * of a limit handler. We have to record it here because we might
+ * of a limit handler. We have to record it here because we might
* delete the structure below, and reading a value out of a deleted
* structure is unsafe (even if actually legal with some
* malloc()/free() implementations.)
@@ -3059,9 +3506,9 @@ RunLimitHandlers(handlerPtr, interp)
if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
}
@@ -3083,12 +3530,12 @@ RunLimitHandlers(handlerPtr, interp)
*/
void
-Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
- Tcl_Interp *interp;
- int type;
- Tcl_LimitHandlerProc *handlerProc;
- ClientData clientData;
- Tcl_LimitHandlerDeleteProc *deleteProc;
+Tcl_LimitAddHandler(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData,
+ Tcl_LimitHandlerDeleteProc *deleteProc)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr;
@@ -3101,14 +3548,14 @@ Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
}
if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
- deleteProc = (Tcl_LimitHandlerDeleteProc *) NULL;
+ deleteProc = NULL;
}
/*
* Allocate a handler record.
*/
- handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+ handlerPtr = ckalloc(sizeof(LimitHandler));
handlerPtr->flags = 0;
handlerPtr->handlerProc = handlerProc;
handlerPtr->clientData = clientData;
@@ -3152,7 +3599,7 @@ Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
*
* Side effects:
* The handler is spliced out of the internal linked list for the limit,
- * and if not currently being invoked, deleted. Otherwise it is just
+ * and if not currently being invoked, deleted. Otherwise it is just
* marked for deletion and removed when the limit handler has finished
* executing.
*
@@ -3160,11 +3607,11 @@ Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
*/
void
-Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
- Tcl_Interp *interp;
- int type;
- Tcl_LimitHandlerProc *handlerProc;
- ClientData clientData;
+Tcl_LimitRemoveHandler(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr;
@@ -3219,15 +3666,15 @@ Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
return;
}
@@ -3252,8 +3699,8 @@ Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
*/
void
-TclLimitRemoveAllHandlers(interp)
- Tcl_Interp *interp;
+TclLimitRemoveAllHandlers(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr, *nextHandlerPtr;
@@ -3279,15 +3726,15 @@ TclLimitRemoveAllHandlers(interp)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
@@ -3312,15 +3759,15 @@ TclLimitRemoveAllHandlers(interp)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
- ckfree((char *) handlerPtr);
+ ckfree(handlerPtr);
}
}
@@ -3352,9 +3799,9 @@ TclLimitRemoveAllHandlers(interp)
*/
int
-Tcl_LimitTypeEnabled(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeEnabled(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3379,9 +3826,9 @@ Tcl_LimitTypeEnabled(interp, type)
*/
int
-Tcl_LimitTypeExceeded(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeExceeded(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3407,9 +3854,9 @@ Tcl_LimitTypeExceeded(interp, type)
*/
void
-Tcl_LimitTypeSet(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeSet(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3427,7 +3874,7 @@ Tcl_LimitTypeSet(interp, type)
* None.
*
* Side effects:
- * The limit is disabled. If the limit was exceeded when this function
+ * The limit is disabled. If the limit was exceeded when this function
* was called, the limit will no longer be exceeded afterwards and the
* interpreter will be free to execute further scripts (assuming it isn't
* also deleted, of course).
@@ -3436,9 +3883,9 @@ Tcl_LimitTypeSet(interp, type)
*/
void
-Tcl_LimitTypeReset(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeReset(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3457,7 +3904,7 @@ Tcl_LimitTypeReset(interp, type)
* None.
*
* Side effects:
- * Also resets whether the command limit was exceeded. This might permit
+ * Also resets whether the command limit was exceeded. This might permit
* a small amount of further execution in the interpreter even if the
* limit itself is theoretically exceeded.
*
@@ -3465,9 +3912,9 @@ Tcl_LimitTypeReset(interp, type)
*/
void
-Tcl_LimitSetCommands(interp, commandLimit)
- Tcl_Interp *interp;
- int commandLimit;
+Tcl_LimitSetCommands(
+ Tcl_Interp *interp,
+ int commandLimit)
{
Interp *iPtr = (Interp *) interp;
@@ -3493,8 +3940,8 @@ Tcl_LimitSetCommands(interp, commandLimit)
*/
int
-Tcl_LimitGetCommands(interp)
- Tcl_Interp *interp;
+Tcl_LimitGetCommands(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
@@ -3513,7 +3960,7 @@ Tcl_LimitGetCommands(interp)
* None.
*
* Side effects:
- * Also resets whether the time limit was exceeded. This might permit a
+ * Also resets whether the time limit was exceeded. This might permit a
* small amount of further execution in the interpreter even if the limit
* itself is theoretically exceeded.
*
@@ -3521,9 +3968,9 @@ Tcl_LimitGetCommands(interp)
*/
void
-Tcl_LimitSetTime(interp, timeLimitPtr)
- Tcl_Interp *interp;
- Tcl_Time *timeLimitPtr;
+Tcl_LimitSetTime(
+ Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_Time nextMoment;
@@ -3539,8 +3986,8 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
nextMoment.usec -= 1000000;
}
iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment,
- TimeLimitCallback, (ClientData) interp);
- iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
+ TimeLimitCallback, interp);
+ iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
}
/*
@@ -3562,18 +4009,30 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
*/
static void
-TimeLimitCallback(clientData)
- ClientData clientData;
+TimeLimitCallback(
+ ClientData clientData)
{
- Tcl_Interp *interp = (Tcl_Interp *) clientData;
+ Tcl_Interp *interp = clientData;
+ Interp *iPtr = clientData;
+ int code;
+
+ Tcl_Preserve(interp);
+ iPtr->limit.timeEvent = NULL;
+
+ /*
+ * Must reset the granularity ticker here to force an immediate full
+ * check. This is OK because we're swallowing the cost in the overall cost
+ * of the event loop. [Bug 2891362]
+ */
- Tcl_Preserve((ClientData) interp);
- ((Interp *)interp)->limit.timeEvent = NULL;
- if (Tcl_LimitCheck(interp) != TCL_OK) {
+ iPtr->limit.granularityTicker = 0;
+
+ code = Tcl_LimitCheck(interp);
+ if (code != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (while waiting for event)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
}
/*
@@ -3594,9 +4053,9 @@ TimeLimitCallback(clientData)
*/
void
-Tcl_LimitGetTime(interp, timeLimitPtr)
- Tcl_Interp *interp;
- Tcl_Time *timeLimitPtr;
+Tcl_LimitGetTime(
+ Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
@@ -3621,10 +4080,10 @@ Tcl_LimitGetTime(interp, timeLimitPtr)
*/
void
-Tcl_LimitSetGranularity(interp, type, granularity)
- Tcl_Interp *interp;
- int type;
- int granularity;
+Tcl_LimitSetGranularity(
+ Tcl_Interp *interp,
+ int type,
+ int granularity)
{
Interp *iPtr = (Interp *) interp;
if (granularity < 1) {
@@ -3659,9 +4118,9 @@ Tcl_LimitSetGranularity(interp, type, granularity)
*/
int
-Tcl_LimitGetGranularity(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitGetGranularity(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3694,15 +4153,16 @@ Tcl_LimitGetGranularity(interp, type)
*/
static void
-DeleteScriptLimitCallback(clientData)
- ClientData clientData;
+DeleteScriptLimitCallback(
+ ClientData clientData)
{
- struct ScriptLimitCallback *limitCBPtr =
- (struct ScriptLimitCallback *) clientData;
+ ScriptLimitCallback *limitCBPtr = clientData;
Tcl_DecrRefCount(limitCBPtr->scriptObj);
- Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
- ckfree((char *) limitCBPtr);
+ if (limitCBPtr->entryPtr != NULL) {
+ Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
+ }
+ ckfree(limitCBPtr);
}
/*
@@ -3710,26 +4170,25 @@ DeleteScriptLimitCallback(clientData)
*
* CallScriptLimitCallback --
*
- * Invoke a script limit callback. Used to implement limit callbacks set
+ * Invoke a script limit callback. Used to implement limit callbacks set
* at the Tcl level on child interpreters.
*
* Results:
* None.
*
* Side effects:
- * Depends on the callback script. Errors are reported as background
+ * Depends on the callback script. Errors are reported as background
* errors.
*
*----------------------------------------------------------------------
*/
static void
-CallScriptLimitCallback(clientData, interp)
- ClientData clientData;
- Tcl_Interp *interp; /* Interpreter which failed the limit */
+CallScriptLimitCallback(
+ ClientData clientData,
+ Tcl_Interp *interp) /* Interpreter which failed the limit */
{
- struct ScriptLimitCallback *limitCBPtr =
- (struct ScriptLimitCallback *) clientData;
+ ScriptLimitCallback *limitCBPtr = clientData;
int code;
if (Tcl_InterpDeleted(limitCBPtr->interp)) {
@@ -3739,7 +4198,7 @@ CallScriptLimitCallback(clientData, interp)
code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
TCL_EVAL_GLOBAL);
if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
- Tcl_BackgroundError(limitCBPtr->interp);
+ Tcl_BackgroundException(limitCBPtr->interp, code);
}
Tcl_Release(limitCBPtr->interp);
}
@@ -3751,7 +4210,7 @@ CallScriptLimitCallback(clientData, interp)
*
* Install (or remove, if scriptObj is NULL) a limit callback script that
* is called when the target interpreter exceeds the type of limit
- * specified. Each interpreter may only have one callback set on another
+ * specified. Each interpreter may only have one callback set on another
* interpreter through this mechanism (though as many interpreters may be
* limited as the programmer chooses overall).
*
@@ -3766,16 +4225,16 @@ CallScriptLimitCallback(clientData, interp)
*/
static void
-SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
- Tcl_Interp *interp;
- int type;
- Tcl_Interp *targetInterp;
- Tcl_Obj *scriptObj;
+SetScriptLimitCallback(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_Interp *targetInterp,
+ Tcl_Obj *scriptObj)
{
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hashPtr;
int isNew;
- struct ScriptLimitCallbackKey key;
+ ScriptLimitCallbackKey key;
Interp *iPtr = (Interp *) interp;
if (interp == targetInterp) {
@@ -3794,15 +4253,16 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
return;
}
- hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
+ hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key,
&isNew);
if (!isNew) {
+ limitCBPtr = Tcl_GetHashValue(hashPtr);
+ limitCBPtr->entryPtr = NULL;
Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
- Tcl_GetHashValue(hashPtr));
+ limitCBPtr);
}
- limitCBPtr = (struct ScriptLimitCallback *)
- ckalloc(sizeof(struct ScriptLimitCallback));
+ limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
limitCBPtr->interp = interp;
limitCBPtr->scriptObj = scriptObj;
limitCBPtr->entryPtr = hashPtr;
@@ -3810,8 +4270,8 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
Tcl_IncrRefCount(scriptObj);
Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,
- (ClientData) limitCBPtr, DeleteScriptLimitCallback);
- Tcl_SetHashValue(hashPtr, (ClientData) limitCBPtr);
+ limitCBPtr, DeleteScriptLimitCallback);
+ Tcl_SetHashValue(hashPtr, limitCBPtr);
}
/*
@@ -3820,7 +4280,7 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
* TclRemoveScriptLimitCallbacks --
*
* Remove all script-implemented limit callbacks that make calls back
- * into the given interpreter. This invoked as part of deleting an
+ * into the given interpreter. This invoked as part of deleting an
* interpreter.
*
* Results:
@@ -3833,17 +4293,17 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
*/
void
-TclRemoveScriptLimitCallbacks(interp)
- Tcl_Interp *interp;
+TclRemoveScriptLimitCallbacks(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hashPtr;
Tcl_HashSearch search;
- struct ScriptLimitCallbackKey *keyPtr;
+ ScriptLimitCallbackKey *keyPtr;
hashPtr = Tcl_FirstHashEntry(&iPtr->limit.callbacks, &search);
while (hashPtr != NULL) {
- keyPtr = (struct ScriptLimitCallbackKey *)
+ keyPtr = (ScriptLimitCallbackKey *)
Tcl_GetHashKey(&iPtr->limit.callbacks, hashPtr);
Tcl_LimitRemoveHandler(keyPtr->interp, keyPtr->type,
CallScriptLimitCallback, Tcl_GetHashValue(hashPtr));
@@ -3858,7 +4318,7 @@ TclRemoveScriptLimitCallbacks(interp)
* TclInitLimitSupport --
*
* Initialise all the parts of the interpreter relating to resource limit
- * management. This allows an interpreter to both have limits set upon
+ * management. This allows an interpreter to both have limits set upon
* itself and set limits upon other interpreters.
*
* Results:
@@ -3871,8 +4331,8 @@ TclRemoveScriptLimitCallbacks(interp)
*/
void
-TclInitLimitSupport(interp)
- Tcl_Interp *interp;
+TclInitLimitSupport(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
@@ -3887,7 +4347,7 @@ TclInitLimitSupport(interp)
iPtr->limit.timeEvent = NULL;
iPtr->limit.timeGranularity = 10;
Tcl_InitHashTable(&iPtr->limit.callbacks,
- sizeof(struct ScriptLimitCallbackKey)/sizeof(int));
+ sizeof(ScriptLimitCallbackKey)/sizeof(int));
}
/*
@@ -3911,8 +4371,9 @@ TclInitLimitSupport(interp)
*/
static void
-InheritLimitsFromMaster(slaveInterp, masterInterp)
- Tcl_Interp *slaveInterp, *masterInterp;
+InheritLimitsFromMaster(
+ Tcl_Interp *slaveInterp,
+ Tcl_Interp *masterInterp)
{
Interp *slavePtr = (Interp *) slaveInterp;
Interp *masterPtr = (Interp *) masterInterp;
@@ -3936,7 +4397,7 @@ InheritLimitsFromMaster(slaveInterp, masterInterp)
* SlaveCommandLimitCmd --
*
* Implementation of the [interp limit $i commands] and [$i limit
- * commands] subcommands. See the interp manual page for a full
+ * commands] subcommands. See the interp manual page for a full
* description.
*
* Results:
@@ -3949,14 +4410,14 @@ InheritLimitsFromMaster(slaveInterp, masterInterp)
*/
static int
-SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* Interpreter being adjusted. */
- int consumedObjc; /* Number of args already parsed. */
- int objc; /* Total number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveCommandLimitCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ int consumedObjc, /* Number of args already parsed. */
+ int objc, /* Total number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- static CONST char *options[] = {
+ static const char *const options[] = {
"-command", "-granularity", "-value", NULL
};
enum Options {
@@ -3964,10 +4425,24 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
};
Interp *iPtr = (Interp *) interp;
int index;
- struct ScriptLimitCallbackKey key;
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallbackKey key;
+ 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;
@@ -3976,8 +4451,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
limitCBPtr->scriptObj);
@@ -4019,8 +4493,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
}
@@ -4039,8 +4512,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option? ?value? ?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, limitLen = 0;
@@ -4059,12 +4531,14 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
break;
case OPT_GRAN:
granObj = objv[i+1];
- if (Tcl_GetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
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;
@@ -4074,12 +4548,14 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (limitLen == 0) {
break;
}
- if (Tcl_GetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
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;
@@ -4110,7 +4586,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
* SlaveTimeLimitCmd --
*
* Implementation of the [interp limit $i time] and [$i limit time]
- * subcommands. See the interp manual page for a full description.
+ * subcommands. See the interp manual page for a full description.
*
* Results:
* A standard Tcl result.
@@ -4122,14 +4598,14 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
*/
static int
-SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* Interpreter being adjusted. */
- int consumedObjc; /* Number of args already parsed. */
- int objc; /* Total number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveTimeLimitCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ int consumedObjc, /* Number of args already parsed. */
+ int objc, /* Total number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- static CONST char *options[] = {
+ static const char *const options[] = {
"-command", "-granularity", "-milliseconds", "-seconds", NULL
};
enum Options {
@@ -4137,10 +4613,24 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
};
Interp *iPtr = (Interp *) interp;
int index;
- struct ScriptLimitCallbackKey key;
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallbackKey key;
+ 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;
@@ -4149,8 +4639,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
limitCBPtr->scriptObj);
@@ -4198,8 +4687,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
}
@@ -4229,8 +4717,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option? ?value? ?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, milliLen = 0, secLen = 0;
@@ -4253,12 +4740,14 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
break;
case OPT_GRAN:
granObj = objv[i+1];
- if (Tcl_GetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
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;
@@ -4268,15 +4757,17 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (milliLen == 0) {
break;
}
- if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
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];
@@ -4284,12 +4775,14 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (secLen == 0) {
break;
}
- if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
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;
@@ -4300,17 +4793,23 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (milliObj != NULL) {
/*
* Setting -milliseconds but clearing -seconds, or resetting
- * -milliseconds but not resetting -seconds? Bad voodoo!
+ * -milliseconds but not resetting -seconds? Bad voodoo!
*/
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;
}
}
@@ -4318,7 +4817,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (milliLen > 0 || secLen > 0) {
/*
* Force usec to be in range [0..1000000), possibly
- * incrementing sec in the process. This makes it much easier
+ * incrementing sec in the process. This makes it much easier
* for people to write scripts that do small time increments.
*/
diff --git a/generic/tclLink.c b/generic/tclLink.c
index b16a113..2735256 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.12 2005/09/08 10:49:19 dkf Exp $
*/
#include "tclInt.h"
@@ -63,12 +61,23 @@ typedef struct Link {
#define LINK_BEING_UPDATED 2
/*
- * Forward references to procedures defined later in this file:
+ * Forward references to functions defined later in this file:
*/
static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
- CONST char *name1, CONST char *name2, int flags);
+ const char *name1, const char *name2, int flags);
static Tcl_Obj * ObjValue(Link *linkPtr);
+
+/*
+ * Convenience macro for accessing the value of the C variable pointed to by a
+ * link. Note that this macro produces something that may be regarded as an
+ * lvalue or rvalue; it may be assigned to as well as read. Also note that
+ * this macro assumes the name of the variable being accessed (linkPtr); this
+ * is not strictly a good thing, but it keeps the code much shorter and
+ * cleaner.
+ */
+
+#define LinkedVar(type) (*(type *) linkPtr->addr)
/*
*----------------------------------------------------------------------
@@ -91,19 +100,27 @@ static Tcl_Obj * ObjValue(Link *linkPtr);
*/
int
-Tcl_LinkVar(interp, varName, addr, type)
- Tcl_Interp *interp; /* Interpreter in which varName exists. */
- CONST char *varName; /* Name of a global variable in interp. */
- char *addr; /* Address of a C variable to be linked to
+Tcl_LinkVar(
+ Tcl_Interp *interp, /* Interpreter in which varName exists. */
+ const char *varName, /* Name of a global variable in interp. */
+ char *addr, /* Address of a C variable to be linked to
* varName. */
- int type; /* Type of C variable: TCL_LINK_INT, etc. Also
+ int type) /* Type of C variable: TCL_LINK_INT, etc. Also
* may have TCL_LINK_READ_ONLY OR'ed in. */
{
Tcl_Obj *objPtr;
Link *linkPtr;
int code;
- linkPtr = (Link *) ckalloc(sizeof(Link));
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ 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);
@@ -118,16 +135,15 @@ Tcl_LinkVar(interp, varName, addr, type)
if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DecrRefCount(linkPtr->varName);
- Tcl_DecrRefCount(objPtr);
- 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,
- (ClientData) linkPtr);
+ code = Tcl_TraceVar2(interp, varName, NULL,
+ 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;
}
@@ -151,22 +167,21 @@ Tcl_LinkVar(interp, varName, addr, type)
*/
void
-Tcl_UnlinkVar(interp, varName)
- Tcl_Interp *interp; /* Interpreter containing variable to unlink */
- CONST char *varName; /* Global variable in interp to unlink. */
+Tcl_UnlinkVar(
+ Tcl_Interp *interp, /* Interpreter containing variable to unlink */
+ const char *varName) /* Global variable in interp to unlink. */
{
- Link *linkPtr;
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
if (linkPtr == NULL) {
return;
}
- Tcl_UntraceVar(interp, varName,
+ Tcl_UntraceVar2(interp, varName, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- LinkTraceProc, (ClientData) linkPtr);
+ LinkTraceProc, linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
- ckfree((char *) linkPtr);
+ ckfree(linkPtr);
}
/*
@@ -174,9 +189,9 @@ Tcl_UnlinkVar(interp, varName)
*
* Tcl_UpdateLinkedVar --
*
- * This procedure is invoked after a linked variable has been changed by
- * C code. It updates the Tcl variable so that traces on the variable
- * will trigger.
+ * This function is invoked after a linked variable has been changed by C
+ * code. It updates the Tcl variable so that traces on the variable will
+ * trigger.
*
* Results:
* None.
@@ -189,15 +204,14 @@ Tcl_UnlinkVar(interp, varName)
*/
void
-Tcl_UpdateLinkedVar(interp, varName)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of global variable that is linked. */
+Tcl_UpdateLinkedVar(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *varName) /* Name of global variable that is linked. */
{
- Link *linkPtr;
+ Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
int savedFlag;
- linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
- LinkTraceProc, (ClientData) NULL);
if (linkPtr == NULL) {
return;
}
@@ -205,7 +219,14 @@ Tcl_UpdateLinkedVar(interp, varName)
linkPtr->flags |= LINK_BEING_UPDATED;
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
+ /*
+ * Callback may have unlinked the variable. [Bug 1740631]
+ */
+ linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+ TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
+ if (linkPtr != NULL) {
+ linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
+ }
}
/*
@@ -213,7 +234,7 @@ Tcl_UpdateLinkedVar(interp, varName)
*
* LinkTraceProc --
*
- * This procedure is invoked when a linked Tcl variable is read, written,
+ * This function is invoked when a linked Tcl variable is read, written,
* or unset from Tcl. It's responsible for keeping the C variable in sync
* with the Tcl variable.
*
@@ -230,16 +251,16 @@ Tcl_UpdateLinkedVar(interp, varName)
*/
static char *
-LinkTraceProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Contains information about the link. */
- Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
- CONST char *name1; /* First part of variable name. */
- CONST char *name2; /* Second part of variable name. */
- int flags; /* Miscellaneous additional information. */
+LinkTraceProc(
+ ClientData clientData, /* Contains information about the link. */
+ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */
+ const char *name1, /* First part of variable name. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Miscellaneous additional information. */
{
- Link *linkPtr = (Link *) clientData;
+ Link *linkPtr = clientData;
int changed, valueLength;
- CONST char *value;
+ const char *value;
char **pp;
Tcl_Obj *valueObj;
int valueInt;
@@ -252,15 +273,15 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
if (flags & TCL_TRACE_UNSETS) {
- if (flags & TCL_INTERP_DESTROYED) {
+ 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);
- Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+ Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
- |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
+ |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
}
return NULL;
}
@@ -284,51 +305,46 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
switch (linkPtr->type) {
case TCL_LINK_INT:
case TCL_LINK_BOOLEAN:
- changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+ changed = (LinkedVar(int) != linkPtr->lastValue.i);
break;
case TCL_LINK_DOUBLE:
- changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+ changed = (LinkedVar(double) != linkPtr->lastValue.d);
break;
case TCL_LINK_WIDE_INT:
- changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
+ changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
break;
case TCL_LINK_WIDE_UINT:
- changed = *(Tcl_WideUInt *)(linkPtr->addr) !=
- linkPtr->lastValue.uw;
+ changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
break;
case TCL_LINK_CHAR:
- changed = *(char *)(linkPtr->addr) != linkPtr->lastValue.c;
+ changed = (LinkedVar(char) != linkPtr->lastValue.c);
break;
case TCL_LINK_UCHAR:
- changed = *(unsigned char *)(linkPtr->addr) !=
- linkPtr->lastValue.uc;
+ changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
break;
case TCL_LINK_SHORT:
- changed = *(short *)(linkPtr->addr) != linkPtr->lastValue.s;
+ changed = (LinkedVar(short) != linkPtr->lastValue.s);
break;
case TCL_LINK_USHORT:
- changed = *(unsigned short *)(linkPtr->addr) !=
- linkPtr->lastValue.us;
+ changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
break;
case TCL_LINK_UINT:
- changed = *(unsigned int *)(linkPtr->addr) !=
- linkPtr->lastValue.ui;
+ changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
case TCL_LINK_LONG:
- changed = *(long *)(linkPtr->addr) != linkPtr->lastValue.l;
+ changed = (LinkedVar(long) != linkPtr->lastValue.l);
break;
case TCL_LINK_ULONG:
- changed = *(unsigned long *)(linkPtr->addr) !=
- linkPtr->lastValue.ul;
+ changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
break;
case TCL_LINK_FLOAT:
- changed = *(float *)(linkPtr->addr) != linkPtr->lastValue.f;
+ changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
case TCL_LINK_STRING:
changed = 1;
break;
default:
- return "internal error: bad linked variable type";
+ return (char *) "internal error: bad linked variable type";
}
if (changed) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -349,14 +365,15 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (linkPtr->flags & LINK_READ_ONLY) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "linked variable is read-only";
+ return (char *) "linked variable is read-only";
}
valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
if (valueObj == NULL) {
/*
* This shouldn't ever happen.
*/
- return "internal error: linked variable couldn't be read";
+
+ return (char *) "internal error: linked variable couldn't be read";
}
switch (linkPtr->type) {
@@ -365,9 +382,9 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ return (char *) "variable must have integer value";
}
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_WIDE_INT:
@@ -375,29 +392,36 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ return (char *) "variable must have integer value";
}
- *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
+ LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
case TCL_LINK_DOUBLE:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
!= TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return "variable must have real value";
+#ifdef ACCEPT_NAN
+ if (valueObj->typePtr != &tclDoubleType) {
+#endif
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+ ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+ return (char *) "variable must have real value";
+#ifdef ACCEPT_NAN
+ }
+ linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+#endif
}
- *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+ LinkedVar(double) = linkPtr->lastValue.d;
break;
case TCL_LINK_BOOLEAN:
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
- != TCL_OK) {
+ != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have boolean value";
+ return (char *) "variable must have boolean value";
}
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_CHAR:
@@ -405,10 +429,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have char value";
+ return (char *) "variable must have char value";
}
linkPtr->lastValue.c = (char)valueInt;
- *(char *)(linkPtr->addr) = linkPtr->lastValue.c;
+ LinkedVar(char) = linkPtr->lastValue.c;
break;
case TCL_LINK_UCHAR:
@@ -416,10 +440,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueInt < 0 || valueInt > UCHAR_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned char value";
+ return (char *) "variable must have unsigned char value";
}
linkPtr->lastValue.uc = (unsigned char) valueInt;
- *(unsigned char *)(linkPtr->addr) = linkPtr->lastValue.uc;
+ LinkedVar(unsigned char) = linkPtr->lastValue.uc;
break;
case TCL_LINK_SHORT:
@@ -427,10 +451,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have short value";
+ return (char *) "variable must have short value";
}
linkPtr->lastValue.s = (short)valueInt;
- *(short *)(linkPtr->addr) = linkPtr->lastValue.s;
+ LinkedVar(short) = linkPtr->lastValue.s;
break;
case TCL_LINK_USHORT:
@@ -438,10 +462,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueInt < 0 || valueInt > USHRT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned short value";
+ return (char *) "variable must have unsigned short value";
}
linkPtr->lastValue.us = (unsigned short)valueInt;
- *(unsigned short *)(linkPtr->addr) = linkPtr->lastValue.us;
+ LinkedVar(unsigned short) = linkPtr->lastValue.us;
break;
case TCL_LINK_UINT:
@@ -449,10 +473,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueWide < 0 || valueWide > UINT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned int value";
+ return (char *) "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueWide;
- *(unsigned int *)(linkPtr->addr) = linkPtr->lastValue.ui;
+ LinkedVar(unsigned int) = linkPtr->lastValue.ui;
break;
case TCL_LINK_LONG:
@@ -460,21 +484,21 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have long value";
+ return (char *) "variable must have long value";
}
linkPtr->lastValue.l = (long)valueWide;
- *(long *)(linkPtr->addr) = linkPtr->lastValue.l;
+ LinkedVar(long) = linkPtr->lastValue.l;
break;
case TCL_LINK_ULONG:
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
- || valueWide < 0 || valueWide > ULONG_MAX) {
+ || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned long value";
+ return (char *) "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueWide;
- *(unsigned long *)(linkPtr->addr) = linkPtr->lastValue.ul;
+ LinkedVar(unsigned long) = linkPtr->lastValue.ul;
break;
case TCL_LINK_WIDE_UINT:
@@ -484,36 +508,34 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have unsigned wide int value";
+ return (char *) "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
- *(Tcl_WideUInt *)(linkPtr->addr) = linkPtr->lastValue.uw;
+ LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
break;
case TCL_LINK_FLOAT:
if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
- || valueDouble < FLT_MIN || valueDouble > FLT_MAX) {
+ || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return "variable must have float value";
+ return (char *) "variable must have float value";
}
linkPtr->lastValue.f = (float)valueDouble;
- *(float *)(linkPtr->addr) = linkPtr->lastValue.f;
+ LinkedVar(float) = linkPtr->lastValue.f;
break;
case TCL_LINK_STRING:
value = Tcl_GetStringFromObj(valueObj, &valueLength);
valueLength++;
- pp = (char **)(linkPtr->addr);
- if (*pp != NULL) {
- ckfree(*pp);
- }
- *pp = (char *) ckalloc((unsigned) valueLength);
+ pp = (char **) linkPtr->addr;
+
+ *pp = ckrealloc(*pp, valueLength);
memcpy(*pp, value, (unsigned) valueLength);
break;
default:
- return "internal error: bad linked variable type";
+ return (char *) "internal error: bad linked variable type";
}
return NULL;
}
@@ -537,58 +559,60 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
static Tcl_Obj *
-ObjValue(linkPtr)
- Link *linkPtr; /* Structure describing linked variable. */
+ObjValue(
+ Link *linkPtr) /* Structure describing linked variable. */
{
char *p;
+ Tcl_Obj *resultObj;
switch (linkPtr->type) {
case TCL_LINK_INT:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ linkPtr->lastValue.i = LinkedVar(int);
return Tcl_NewIntObj(linkPtr->lastValue.i);
case TCL_LINK_WIDE_INT:
- linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
+ linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
return Tcl_NewWideIntObj(linkPtr->lastValue.w);
case TCL_LINK_DOUBLE:
- linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+ linkPtr->lastValue.d = LinkedVar(double);
return Tcl_NewDoubleObj(linkPtr->lastValue.d);
case TCL_LINK_BOOLEAN:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ linkPtr->lastValue.i = LinkedVar(int);
return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
case TCL_LINK_CHAR:
- linkPtr->lastValue.c = *(char *)(linkPtr->addr);
+ linkPtr->lastValue.c = LinkedVar(char);
return Tcl_NewIntObj(linkPtr->lastValue.c);
case TCL_LINK_UCHAR:
- linkPtr->lastValue.uc = *(unsigned char *)(linkPtr->addr);
+ linkPtr->lastValue.uc = LinkedVar(unsigned char);
return Tcl_NewIntObj(linkPtr->lastValue.uc);
case TCL_LINK_SHORT:
- linkPtr->lastValue.s = *(short *)(linkPtr->addr);
+ linkPtr->lastValue.s = LinkedVar(short);
return Tcl_NewIntObj(linkPtr->lastValue.s);
case TCL_LINK_USHORT:
- linkPtr->lastValue.us = *(unsigned short *)(linkPtr->addr);
+ linkPtr->lastValue.us = LinkedVar(unsigned short);
return Tcl_NewIntObj(linkPtr->lastValue.us);
case TCL_LINK_UINT:
- linkPtr->lastValue.ui = *(unsigned int *)(linkPtr->addr);
- return Tcl_NewWideIntObj(linkPtr->lastValue.ui);
+ linkPtr->lastValue.ui = LinkedVar(unsigned int);
+ return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
case TCL_LINK_LONG:
- linkPtr->lastValue.l = *(long *)(linkPtr->addr);
- return Tcl_NewWideIntObj(linkPtr->lastValue.l);
+ linkPtr->lastValue.l = LinkedVar(long);
+ return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
case TCL_LINK_ULONG:
- linkPtr->lastValue.ul = *(unsigned long *)(linkPtr->addr);
- return Tcl_NewWideIntObj(linkPtr->lastValue.ul);
+ linkPtr->lastValue.ul = LinkedVar(unsigned long);
+ return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
case TCL_LINK_FLOAT:
- linkPtr->lastValue.f = *(float *)(linkPtr->addr);
+ linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
case TCL_LINK_WIDE_UINT:
- linkPtr->lastValue.uw = *(Tcl_WideUInt *)(linkPtr->addr);
+ linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
/*
* FIXME: represent as a bignum.
*/
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
case TCL_LINK_STRING:
- p = *(char **)(linkPtr->addr);
+ p = LinkedVar(char *);
if (p == NULL) {
- return Tcl_NewStringObj("NULL", 4);
+ TclNewLiteralStringObj(resultObj, "NULL");
+ return resultObj;
}
return Tcl_NewStringObj(p, -1);
@@ -596,8 +620,10 @@ ObjValue(linkPtr)
* This code only gets executed if the link type is unknown (shouldn't
* ever happen).
*/
+
default:
- return Tcl_NewStringObj("??", 2);
+ TclNewLiteralStringObj(resultObj, "??");
+ return resultObj;
}
}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index e83a8f4..bd2dbc4 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.27 2005/09/06 14:40:11 dkf 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);
@@ -38,31 +38,33 @@ static void UpdateStringOfList(Tcl_Obj *listPtr);
* storage to avoid an auxiliary stack.
*/
-Tcl_ObjType tclListType = {
+const Tcl_ObjType tclListType = {
"list", /* name */
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
- NULL /* setFromAnyProc */
+ 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
@@ -71,33 +73,39 @@ Tcl_ObjType tclListType = {
*----------------------------------------------------------------------
*/
-static List*
-NewListIntRep(objc, objv)
- int objc;
- Tcl_Obj *CONST objv[];
+static List *
+NewListIntRep(
+ int objc,
+ Tcl_Obj *const objv[],
+ int p)
{
- Tcl_Obj **elemPtrs;
List *listRepPtr;
- int i;
if (objc <= 0) {
- return NULL;
+ Tcl_Panic("NewListIntRep: expects postive element count");
}
/*
* First check to see if we'd overflow and try to allocate an object
* larger than our memory allocator allows. Note that this is actually a
* fairly small value when you're on a serious 64-bit machine, but that
- * requires API changes to fix.
+ * requires API changes to fix. See [Bug 219196] for a discussion.
*/
- if (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;
}
@@ -106,6 +114,9 @@ NewListIntRep(objc, objv)
listRepPtr->maxElemCount = objc;
if (objv) {
+ Tcl_Obj **elemPtrs;
+ int i;
+
listRepPtr->elemCount = objc;
elemPtrs = &listRepPtr->elements;
for (i = 0; i < objc; i++) {
@@ -121,6 +132,51 @@ NewListIntRep(objc, objv)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -148,9 +204,9 @@ NewListIntRep(objc, objv)
#undef Tcl_NewListObj
Tcl_Obj *
-Tcl_NewListObj(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */
{
return Tcl_DbNewListObj(objc, objv, "unknown", 0);
}
@@ -158,9 +214,9 @@ Tcl_NewListObj(objc, objv)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewListObj(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */
{
List *listRepPtr;
Tcl_Obj *listPtr;
@@ -175,21 +231,14 @@ Tcl_NewListObj(objc, objv)
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to create the list\n");
- }
+ 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++;
-
+ TclInvalidateStringRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -226,12 +275,12 @@ Tcl_NewListObj(objc, objv)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
- CONST char *file; /* The name of the source file calling this
+Tcl_DbNewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */
+ const char *file, /* The name of the source file calling this
* function; used for debugging. */
- int line; /* Line number in the source file; used for
+ int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *listPtr;
@@ -247,20 +296,14 @@ Tcl_DbNewListObj(objc, objv, file, line)
* Create the internal rep.
*/
- listRepPtr = NewListIntRep(objc, objv);
- if (!listRepPtr) {
- Tcl_Panic("Not enough memory to create the list\n");
- }
+ 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++;
+ TclInvalidateStringRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
@@ -268,12 +311,12 @@ Tcl_DbNewListObj(objc, objv, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
- CONST char *file; /* The name of the source file calling this
+Tcl_DbNewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */
+ const char *file, /* The name of the source file calling this
* function; used for debugging. */
- int line; /* Line number in the source file; used for
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewListObj(objc, objv);
@@ -303,15 +346,15 @@ Tcl_DbNewListObj(objc, objv, file, line)
*/
void
-Tcl_SetListObj(objPtr, objc, objv)
- Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_SetListObj(
+ Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */
{
List *listRepPtr;
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetListObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
}
/*
@@ -319,8 +362,7 @@ Tcl_SetListObj(objPtr, objc, objv)
*/
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
/*
* Set the object's type to "list" and initialize the internal rep.
@@ -329,14 +371,8 @@ Tcl_SetListObj(objPtr, objc, objv)
*/
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;
@@ -346,6 +382,47 @@ Tcl_SetListObj(objPtr, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * TclListObjCopy --
+ *
+ * Makes a "pure list" copy of a list value. This provides for the C
+ * level a counterpart of the [lrange $list 0 end] command, while using
+ * internals details to be as efficient as possible.
+ *
+ * Results:
+ * Normally returns a pointer to a new Tcl_Obj, that contains the same
+ * list value as *listPtr does. The returned Tcl_Obj has a refCount of
+ * zero. If *listPtr does not hold a list, NULL is returned, and if
+ * interp is non-NULL, an error message is recorded there.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjCopy(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *listPtr) /* List object for which an element array is
+ * to be returned. */
+{
+ Tcl_Obj *copyPtr;
+
+ if (listPtr->typePtr != &tclListType) {
+ if (SetListFromAny(interp, listPtr) != TCL_OK) {
+ return NULL;
+ }
+ }
+
+ TclNewObj(copyPtr);
+ TclInvalidateStringRep(copyPtr);
+ DupListInternalRep(listPtr, copyPtr);
+ return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ListObjGetElements --
*
* This function returns an (objc,objv) array of the elements in a list
@@ -374,33 +451,31 @@ Tcl_SetListObj(objPtr, objc, objv)
*/
int
-Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object for which an element array is
+Tcl_ListObjGetElements(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object for which an element array is
* to be returned. */
- int *objcPtr; /* Where to store the count of objects
+ int *objcPtr, /* Where to store the count of objects
* referenced by objv. */
- Tcl_Obj ***objvPtr; /* Where to store the pointer to an array of
+ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
{
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) Tcl_GetStringFromObj(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;
@@ -411,16 +486,13 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
*
* 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
@@ -433,34 +505,32 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
*/
int
-Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object to append elements to. */
- Tcl_Obj *elemListPtr; /* List obj with elements to append. */
+Tcl_ListObjAppendList(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ 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("Tcl_ListObjAppendList called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
}
- result = Tcl_ListObjLength(interp, listPtr, &listLen);
- if (result != TCL_OK) {
- return result;
- }
+ /*
+ * Pull the elements to append from elemListPtr.
+ */
- result = Tcl_ListObjGetElements(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);
}
/*
@@ -491,82 +561,134 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
*/
int
-Tcl_ListObjAppendElement(interp, listPtr, objPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- Tcl_Obj *listPtr; /* List object to append objPtr to. */
- Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
+Tcl_ListObjAppendElement(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ 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("Tcl_ListObjAppendElement called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) Tcl_GetStringFromObj(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, 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++;
@@ -575,7 +697,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
* representation has changed.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
return TCL_OK;
}
@@ -606,30 +728,28 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
*/
int
-Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object to index into. */
- register int index; /* Index of element to return. */
- Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
+Tcl_ListObjIndex(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object to index into. */
+ register int index, /* Index of element to return. */
+ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) Tcl_GetStringFromObj(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 {
@@ -662,29 +782,27 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
*/
int
-Tcl_ListObjLength(interp, listPtr, intPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object whose #elements to return. */
- register int *intPtr; /* The resulting int is stored here. */
+Tcl_ListObjLength(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object whose #elements to return. */
+ register int *intPtr) /* The resulting int is stored here. */
{
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- (void) Tcl_GetStringFromObj(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;
}
@@ -728,71 +846,84 @@ Tcl_ListObjLength(interp, listPtr, intPtr)
*/
int
-Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *listPtr; /* List object whose elements to replace. */
- int first; /* Index of first element to replace. */
- int count; /* Number of elements to replace. */
- int objc; /* Number of objects to insert. */
- Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects to
+Tcl_ListObjReplace(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *listPtr, /* List object whose elements to replace. */
+ int first, /* Index of first element to replace. */
+ int count, /* Number of elements to replace. */
+ int objc, /* Number of objects to insert. */
+ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to
* insert. */
{
List *listRepPtr;
register Tcl_Obj **elemPtrs;
- Tcl_Obj *victimPtr;
- int numElems, numRequired, numAfterLast;
- int start, shift, newMax, i, j, result;
- int isShared;
+ int numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
- Tcl_Panic("Tcl_ListObjReplace called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (listPtr->typePtr != &tclListType) {
- int length;
-
- (void) Tcl_GetStringFromObj(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 {
- result = SetListFromAny(interp, listPtr);
+ int result = SetListFromAny(interp, listPtr);
+
if (result != TCL_OK) {
return result;
}
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ /*
+ * Note that when count == 0 and objc == 0, this routine is logically a
+ * no-op, removing and adding no elements to the list. However, by flowing
+ * through this routine anyway, we get the important side effect that the
+ * resulting listPtr is a list in canoncial form. This is important.
+ * Resist any temptation to optimize this case.
+ */
+
+ listRepPtr = ListRepPtr(listPtr);
elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
if (first < 0) {
- first = 0;
+ first = 0;
}
if (first >= numElems) {
first = numElems; /* So we'll insert after last element. */
}
if (count < 0) {
count = 0;
- } else if (numElems < first+count) {
+ } else if (numElems < first+count || first+count < 0) {
+ /*
+ * The 'first+count < 0' condition here guards agains integer
+ * overflow in determining 'first+count'.
+ */
+
count = numElems - first;
}
isShared = (listRepPtr->refCount > 1);
- numRequired = (numElems - count + objc);
+ numRequired = numElems - count + objc;
+
+ for (i = 0; i < objc; i++) {
+ Tcl_IncrRefCount(objv[i]);
+ }
+
+ if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+ int shift;
- if ((numRequired <= listRepPtr->maxElemCount)
- && !isShared) {
/*
* Can use the current List struct. First "delete" count elements
* starting at first.
*/
for (j = first; j < first + count; j++) {
- victimPtr = elemPtrs[j];
+ Tcl_Obj *victimPtr = elemPtrs[j];
+
TclDecrRefCount(victimPtr);
}
@@ -801,37 +932,55 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
* locations.
*/
- start = (first + count);
- numAfterLast = (numElems - start);
- shift = (objc - count); /* numNewElems - numDeleted */
+ start = first + count;
+ numAfterLast = numElems - start;
+ shift = objc - count; /* numNewElems - numDeleted */
if ((numAfterLast > 0) && (shift != 0)) {
- Tcl_Obj **src, **dst;
+ Tcl_Obj **src = elemPtrs + start;
- src = elemPtrs + start; dst = src + shift;
- memmove((VOID*) dst, (VOID*) src,
- (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
+ memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
}
} else {
/*
- * Cannot use the current List struct - it is shared, too small, or
+ * Cannot use the current List struct; it is shared, too small, or
* both. Allocate a new struct and insert elements into it.
*/
List *oldListRepPtr = listRepPtr;
Tcl_Obj **oldPtrs = elemPtrs;
+ int newMax;
if (numRequired > listRepPtr->maxElemCount){
- newMax = (2 * numRequired);
+ newMax = 2 * numRequired;
} else {
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) {
+ for (i = 0; i < objc; i++) {
+ /* See bug 3598580 */
+#if TCL_MAJOR_VERSION > 8
+ Tcl_DecrRefCount(objv[i]);
+#else
+ objv[i]->refCount--;
+#endif
+ }
+ return TCL_ERROR;
+ }
+ }
}
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -847,7 +996,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
elemPtrs[i] = oldPtrs[i];
Tcl_IncrRefCount(elemPtrs[i]);
}
- for (i= first + count, j = first + objc;
+ for (i = first + count, j = first + objc;
j < numRequired; i++, j++) {
elemPtrs[j] = oldPtrs[i];
Tcl_IncrRefCount(elemPtrs[j]);
@@ -860,8 +1009,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
*/
if (first > 0) {
- memcpy((VOID *) elemPtrs, (VOID *) oldPtrs,
- (size_t) (first * sizeof(Tcl_Obj *)));
+ memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
}
/*
@@ -869,7 +1017,8 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
*/
for (j = first; j < first + count; j++) {
- victimPtr = oldPtrs[j];
+ Tcl_Obj *victimPtr = oldPtrs[j];
+
TclDecrRefCount(victimPtr);
}
@@ -878,15 +1027,14 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
* new locations.
*/
- start = (first + count);
- numAfterLast = (numElems - start);
+ start = first + count;
+ numAfterLast = numElems - start;
if (numAfterLast > 0) {
- memcpy((VOID *) &(elemPtrs[first + objc]),
- (VOID *) &(oldPtrs[start]),
- (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
+ memcpy(elemPtrs + first + objc, oldPtrs + start,
+ (size_t) numAfterLast * sizeof(Tcl_Obj *));
}
- ckfree((char *) oldListRepPtr);
+ ckfree(oldListRepPtr);
}
}
@@ -896,7 +1044,6 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
for (i=0,j=first ; i<objc ; i++,j++) {
elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
}
/*
@@ -910,68 +1057,229 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
* reflects the list's internal representation.
*/
- Tcl_InvalidateStringRep(listPtr);
+ TclInvalidateStringRep(listPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclLsetList --
+ * TclLindexList --
*
- * Core of the 'lset' command when objc == 4. Objv[2] may be either a
- * scalar index or a list of indices.
+ * This procedure handles the 'lindex' command when objc==3.
*
* Results:
- * Returns the new value of the list variable, or NULL if an error
- * occurs.
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the result.
+ * None.
*
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack. The first action of this function is
- * to determine whether the object is shared, and to duplicate it if it
- * is. The reference count of the duplicate is incremented. At this
- * point, the reference count will be 1 for either case, so that the
- * object will appear to be unshared.
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLindexFlat. All it does is reconfigure the argument format into the
+ * form required by TclLindexFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this
- * dismisses any memory that was allocated by this function.
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLindexList(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* List being unpacked. */
+ Tcl_Obj *argPtr) /* Index or index list. */
+{
+
+ int index; /* Index into the list. */
+ Tcl_Obj *indexListCopy;
+
+ /*
+ * Determine whether argPtr designates a list or a single index. We have
+ * to be careful about the order of the checks to avoid repeated
+ * shimmering; see TIP#22 and TIP#33 for the details.
+ */
+
+ if (argPtr->typePtr != &tclListType
+ && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
+ /*
+ * argPtr designates a single index.
+ */
+
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
+ }
+
+ /*
+ * Here we make a private copy of the index list argument to avoid any
+ * shimmering issues that might invalidate the indices array below while
+ * we are still using it. This is probably unnecessary. It does not appear
+ * that any damaging shimmering is possible, and no test has been devised
+ * to show any error when this private copy is not made. But it's cheap,
+ * and it offers some future-proofing insurance in case the TclLindexFlat
+ * implementation changes in some unexpected way, or some new form of
+ * trace or callback permits things to happen that the current
+ * implementation does not.
+ */
+
+ indexListCopy = TclListObjCopy(NULL, argPtr);
+ if (indexListCopy == NULL) {
+ /*
+ * argPtr designates something that is neither an index nor a
+ * well-formed list. Report the error via TclLindexFlat.
+ */
+
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
+ }
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
*
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is done
- * to a reference count of the duplicate. Now the reference count of an
- * unduplicated object is 2 (the returned pointer, plus the one stored in
- * the variable). The reference count of a duplicate object is 1,
- * reflecting that the returned pointer is the only active reference.
- * The caller is expected to store the returned value back in the
- * variable and decrement its reference count. (INST_STORE_* does exactly
- * this.)
- *
- * Tcl_LsetFlat and related functions maintain a linked list of Tcl_Obj's
- * whose string representations must be spoilt by threading via 'ptr2' of
- * the two-pointer internal representation. On entry to Tcl_LsetList, the
- * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
- * Tcl_Obj that has been modified is set to NULL.
+ * TclLindexFlat --
+ *
+ * This procedure is the core of the 'lindex' command, with all index
+ * arguments presented as a flat list.
+ *
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
+ * Tcl_SetObjResult(interp, result);
+ * Tcl_DecrRefCount(result);
*
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* listPtr; /* Pointer to the list being modified */
- Tcl_Obj* indexArgPtr; /* Index or index-list arg to 'lset' */
- Tcl_Obj* valuePtr; /* Value arg to 'lset' */
+Tcl_Obj *
+TclLindexFlat(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Tcl object representing the list. */
+ int indexCount, /* Count of indices. */
+ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
+ * represent the indices in the list. */
{
- int indexCount; /* Number of indices in the index list */
- Tcl_Obj** indices; /* Vector of indices in the index list*/
- Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
- int index; /* Current index in the list - discarded */
int i;
- List *indexListRepPtr;
+
+ Tcl_IncrRefCount(listPtr);
+
+ for (i=0 ; i<indexCount && listPtr ; i++) {
+ int index, listLen = 0;
+ Tcl_Obj **elemPtrs = NULL, *sublistCopy;
+
+ /*
+ * Here we make a private copy of the current sublist, so we avoid any
+ * shimmering issues that might invalidate the elemPtr array below
+ * while we are still using it. See test lindex-8.4.
+ */
+
+ sublistCopy = TclListObjCopy(interp, listPtr);
+ Tcl_DecrRefCount(listPtr);
+ listPtr = NULL;
+
+ if (sublistCopy == NULL) {
+ /*
+ * The sublist is not a list at all => error.
+ */
+
+ break;
+ }
+ TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+
+ if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
+ &index) == TCL_OK) {
+ if (index<0 || index>=listLen) {
+ /*
+ * Index is out of range. Break out of loop with empty result.
+ * First check remaining indices for validity
+ */
+
+ while (++i < indexCount) {
+ if (TclGetIntForIndexM(interp, indexArray[i], -1, &index)
+ != TCL_OK) {
+ Tcl_DecrRefCount(sublistCopy);
+ return NULL;
+ }
+ }
+ listPtr = Tcl_NewObj();
+ } else {
+ /*
+ * Extract the pointer to the appropriate element.
+ */
+
+ listPtr = elemPtrs[index];
+ }
+ Tcl_IncrRefCount(listPtr);
+ }
+ Tcl_DecrRefCount(sublistCopy);
+ }
+
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLsetList --
+ *
+ * Core of the 'lset' command when objc == 4. Objv[2] may be either a
+ * scalar index or a list of indices.
+ *
+ * Results:
+ * Returns the new value of the list variable, or NULL if there was an
+ * error. The returned object includes one reference count for the
+ * pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLsetFlat. All it does is reconfigure the argument format into the
+ * form required by TclLsetFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLsetList(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Pointer to the list being modified. */
+ Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
+{
+ int indexCount = 0; /* Number of indices in the index list. */
+ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */
+ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
+ int index; /* Current index in the list - discarded. */
+ Tcl_Obj *indexListCopy;
/*
* Determine whether the index arg designates a list or a single index.
@@ -980,15 +1288,17 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
*/
if (indexArgPtr->typePtr != &tclListType
- && TclGetIntForIndex(NULL, indexArgPtr, 0, &index) == TCL_OK) {
+ && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
/*
* indexArgPtr designates a single index.
*/
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
- } else if (Tcl_ListObjGetElements(NULL, indexArgPtr, &indexCount,
- &indices) != TCL_OK) {
+ }
+
+ indexListCopy = TclListObjCopy(NULL, indexArgPtr);
+ if (indexListCopy == NULL) {
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
@@ -996,21 +1306,7 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
}
-
- /*
- * At this point, we know that argPtr designates a well formed list, and
- * the 'else if' above has parsed it into indexCount and indices.
- * Increase the reference count of the internal rep of indexArgPtr, in
- * order to insure the validity of pointers even if indexArgPtr shimmers
- * to another type.
- */
-
- if (indexCount) {
- indexListRepPtr = (List *) indexArgPtr->internalRep.twoPtrValue.ptr1;
- indexListRepPtr->refCount++;
- } else {
- indexListRepPtr = NULL; /* avoid compiler warning*/
- }
+ TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
/*
* Let TclLsetFlat handle the actual lset'ting.
@@ -1018,19 +1314,7 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
- /*
- * If we are the only users of indexListRepPtr, we free it before
- * returning.
- */
-
- if (indexCount) {
- if (--indexListRepPtr->refCount <= 0) {
- for (i=0; i<indexCount; i++) {
- Tcl_DecrRefCount(indices[i]);
- }
- ckfree((char *) indexListRepPtr);
- }
- }
+ Tcl_DecrRefCount(indexListCopy);
return retValuePtr;
}
@@ -1039,16 +1323,14 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
*
* TclLsetFlat --
*
- * Core of the 'lset' command when objc>=5. Objv[2], ... , objv[objc-2]
- * contain scalar indices.
+ * Core engine of the 'lset' command.
*
* Results:
* Returns the new value of the list variable, or NULL if an error
- * occurs.
+ * occurred. The returned object includes one reference count for the
+ * pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the result.
- *
* On entry, the reference count of the variable value does not reflect
* any references held on the stack. The first action of this function is
* to determine whether the object is shared, and to duplicate it if it
@@ -1065,45 +1347,35 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
* to a reference count of the duplicate. Now the reference count of an
* unduplicated object is 2 (the returned pointer, plus the one stored in
* the variable). The reference count of a duplicate object is 1,
- * reflecting that the returned pointer is the only active reference.
- * The caller is expected to store the returned value back in the
- * variable and decrement its reference count. (INST_STORE_* does exactly
- * this.)
- *
- * Tcl_LsetList and related functions maintain a linked list of Tcl_Obj's
- * whose string representations must be spoilt by threading via 'ptr2' of
- * the two-pointer internal representation. On entry to Tcl_LsetList, the
+ * reflecting that the returned pointer is the only active reference. The
+ * caller is expected to store the returned value back in the variable
+ * and decrement its reference count. (INST_STORE_* does exactly this.)
+ *
+ * Surgery is performed on the unshared list value to produce the result.
+ * TclLsetFlat maintains a linked list of Tcl_Obj's whose string
+ * representations must be spoilt by threading via 'ptr2' of the
+ * two-pointer internal representation. On entry to TclLsetFlat, the
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
* Tcl_Obj that has been modified is set to NULL.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* listPtr; /* Pointer to the list being modified */
- int indexCount; /* Number of index args */
- Tcl_Obj *CONST indexArray[];
- /* Index args */
- Tcl_Obj* valuePtr; /* Value arg to 'lset' */
+Tcl_Obj *
+TclLsetFlat(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Pointer to the list being modified. */
+ int indexCount, /* Number of index args. */
+ Tcl_Obj *const indexArray[],
+ /* Index args. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
{
- int duplicated; /* Flag == 1 if the obj has been duplicated, 0
- * otherwise */
- Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
- int elemCount; /* Length of one sublist being changed */
- Tcl_Obj** elemPtrs; /* Pointers to the elements of a sublist */
- Tcl_Obj* subListPtr; /* Pointer to the current sublist */
- int index; /* Index of the element to replace in the
- * current sublist */
- Tcl_Obj* chainPtr; /* Pointer to the enclosing list of the
- * current sublist. */
- int result; /* Status return from library calls */
- int i;
+ int index, result, len;
+ Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
/*
- * If there are no indices, then simply return the new value, counting the
- * returned pointer as a reference.
+ * If there are no indices, simply return the new value. (Without
+ * indices, [lset] is a synonym for [set].
*/
if (indexCount == 0) {
@@ -1112,136 +1384,184 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
}
/*
- * If the list is shared, make a private copy.
+ * 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 (Tcl_IsShared(listPtr)) {
- duplicated = 1;
- listPtr = Tcl_DuplicateObj(listPtr);
- Tcl_IncrRefCount(listPtr);
- } else {
- duplicated = 0;
- }
+ subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
/*
* Anchor the linked list of Tcl_Obj's whose string reps must be
* invalidated if the operation succeeds.
*/
- retValuePtr = listPtr;
+ retValuePtr = subListPtr;
chainPtr = NULL;
+ result = TCL_OK;
/*
- * Handle each index arg by diving into the appropriate sublist.
+ * Loop through all the index arguments, and for each one dive into the
+ * appropriate sublist.
*/
- for (i=0 ; ; i++) {
+ do {
+ int elemCount;
+ Tcl_Obj *parentList, **elemPtrs;
+
/*
- * Take the sublist apart.
+ * Check for the possible error conditions...
*/
- result = Tcl_ListObjGetElements(interp, listPtr, &elemCount, &elemPtrs);
- if (result != TCL_OK) {
- break;
- }
- if (elemCount == 0) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
+ if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
+ != TCL_OK) {
+ /* ...the sublist we're indexing into isn't a list at all. */
result = TCL_ERROR;
break;
}
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
/*
- * Determine the index of the requested element.
+ * WARNING: the macro TclGetIntForIndexM is not safe for
+ * post-increments, avoid '*indexArray++' here.
*/
- result = TclGetIntForIndex(interp, indexArray[i], elemCount-1, &index);
- if (result != TCL_OK) {
+ 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;
}
-
- /*
- * Check that the index is in range.
- */
-
- if (index<0 || index>=elemCount) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
+ indexArray++;
+
+ if (index < 0 || index > elemCount) {
+ /* ...the index points outside the sublist. */
+ 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;
}
/*
- * Break the loop after extracting the innermost sublist
+ * 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.
*/
- if (i >= indexCount-1) {
- result = TCL_OK;
- break;
- }
-
- /*
- * Extract the appropriate sublist, and make sure that it is unshared.
- */
+ if (--indexCount) {
+ parentList = subListPtr;
+ if (index == elemCount) {
+ subListPtr = Tcl_NewObj();
+ } else {
+ subListPtr = elemPtrs[index];
+ }
+ if (Tcl_IsShared(subListPtr)) {
+ subListPtr = Tcl_DuplicateObj(subListPtr);
+ }
- subListPtr = elemPtrs[index];
- if (Tcl_IsShared(subListPtr)) {
- subListPtr = Tcl_DuplicateObj(subListPtr);
- result = TclListObjSetElement(interp, listPtr, index, subListPtr);
- if (result != TCL_OK) {
- /*
- * We actually shouldn't be able to get here. If we do, it
- * would result in leaking subListPtr, but everything's been
- * validated already; the error exit from TclListObjSetElement
- * should never happen.
- */
+ /*
+ * Replace the original elemPtr[index] in parentList with a copy
+ * 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.
+ */
- break;
+ if (index == elemCount) {
+ Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
+ } else {
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
+ }
+ if (Tcl_IsShared(subListPtr)) {
+ subListPtr = Tcl_DuplicateObj(subListPtr);
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
}
- }
-
- /*
- * Chain the current sublist onto the linked list of Tcl_Obj's whose
- * string reps must be spoilt.
- */
- chainPtr = listPtr;
- listPtr = subListPtr;
- }
+ /*
+ * 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.
+ */
- /* Store the result in the list element */
+ parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
+ chainPtr = parentList;
+ }
+ } while (indexCount > 0);
- if (result == TCL_OK) {
- result = TclListObjSetElement(interp, listPtr, index, valuePtr);
- }
+ /*
+ * 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.
+ */
- if (result == TCL_OK) {
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+ while (chainPtr) {
+ Tcl_Obj *objPtr = chainPtr;
- /* Spoil all the string reps */
+ if (result == TCL_OK) {
+ /*
+ * We're going to store valuePtr, so spoil string reps of all
+ * containing lists.
+ */
- while (listPtr != NULL) {
- subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
- Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr = subListPtr;
+ TclInvalidateStringRep(objPtr);
}
- /* Return the new list if everything worked. */
+ /*
+ * 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.
+ */
- if (!duplicated) {
- Tcl_IncrRefCount(retValuePtr);
+ if (retValuePtr != listPtr) {
+ Tcl_DecrRefCount(retValuePtr);
}
- return retValuePtr;
+ return NULL;
}
- /* Clean up the one dangling reference otherwise */
+ /*
+ * 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).
+ */
- if (duplicated) {
- Tcl_DecrRefCount(retValuePtr);
+ len = -1;
+ TclListObjLength(NULL, subListPtr, &len);
+ if (index == len) {
+ Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
+ } else {
+ TclListObjSetElement(NULL, subListPtr, index, valuePtr);
}
- return NULL;
+ TclInvalidateStringRep(subListPtr);
+ Tcl_IncrRefCount(retValuePtr);
+ return retValuePtr;
}
/*
@@ -1274,36 +1594,37 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
*/
int
-TclListObjSetElement(interp, listPtr, index, valuePtr)
- Tcl_Interp* interp; /* Tcl interpreter; used for error reporting
- * if not NULL */
- Tcl_Obj* listPtr; /* List object in which element should be
- * stored */
- int index; /* Index of element to store */
- Tcl_Obj* valuePtr; /* Tcl object to store in the designated list
- * element */
+TclListObjSetElement(
+ Tcl_Interp *interp, /* Tcl interpreter; used for error reporting
+ * if not NULL. */
+ Tcl_Obj *listPtr, /* List object in which element should be
+ * stored. */
+ int index, /* Index of element to store. */
+ Tcl_Obj *valuePtr) /* Tcl object to store in the designated list
+ * element. */
{
- int result; /* Return value from this function */
- List* listRepPtr; /* Internal representation of the list being
- * modified */
- Tcl_Obj** elemPtrs; /* Pointers to elements of the list */
- int elemCount; /* Number of elements in the list */
- int i;
+ List *listRepPtr; /* Internal representation of the list being
+ * modified. */
+ Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */
+ int elemCount; /* Number of elements in the list. */
/*
* Ensure that the listPtr parameter designates an unshared list.
*/
if (Tcl_IsShared(listPtr)) {
- Tcl_Panic("Tcl_ListObjSetElement called with shared object");
+ Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
if (listPtr->typePtr != &tclListType) {
- int length;
-
- (void) Tcl_GetStringFromObj(listPtr, &length);
- if (!length) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
+ int result;
+
+ 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);
@@ -1312,9 +1633,8 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
}
}
- listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
- elemPtrs = &listRepPtr->elements;
/*
* Ensure that the index is in bounds.
@@ -1324,8 +1644,10 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
- return TCL_ERROR;
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX",
+ NULL);
}
+ return TCL_ERROR;
}
/*
@@ -1333,21 +1655,30 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
*/
if (listRepPtr->refCount > 1) {
- List *oldListRepPtr = listRepPtr;
- Tcl_Obj **oldElemPtrs = elemPtrs;
+ Tcl_Obj **dst, **src = &listRepPtr->elements;
+ List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
- listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
- listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
- elemPtrs = &listRepPtr->elements;
- for (i=0; i < elemCount; i++) {
- elemPtrs[i] = oldElemPtrs[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+ if (newPtr == NULL) {
+ newPtr = AttemptNewList(interp, elemCount, NULL);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
}
- listRepPtr->refCount++;
- listRepPtr->elemCount = elemCount;
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- oldListRepPtr->refCount--;
+ newPtr->refCount++;
+ newPtr->elemCount = elemCount;
+ newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+
+ dst = &newPtr->elements;
+ while (elemCount--) {
+ *dst = *src++;
+ Tcl_IncrRefCount(*dst++);
+ }
+
+ listRepPtr->refCount--;
+
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
}
+ elemPtrs = &listRepPtr->elements;
/*
* Add a reference to the new list element.
@@ -1390,25 +1721,22 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
*/
static void
-FreeListInternalRep(listPtr)
- Tcl_Obj *listPtr; /* List object with internal rep to free. */
+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;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr->typePtr = NULL;
}
/*
@@ -1429,16 +1757,13 @@ FreeListInternalRep(listPtr)
*/
static void
-DupListInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+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);
}
/*
@@ -1461,109 +1786,117 @@ DupListInternalRep(srcPtr, copyPtr)
*/
static int
-SetListFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
+SetListFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
- char *string, *s;
- CONST char *elemStart, *nextElem;
- int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
- 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;
/*
- * Get the string representation. Make it up-to-date if necessary.
+ * Dictionaries are a special case; they have a string representation such
+ * that *all* valid dictionaries are valid lists. Hence we can convert
+ * more directly. Only do this when there's no existing string rep; if
+ * there is, it is the string rep that's authoritative (because it could
+ * describe duplicate keys).
*/
- string = Tcl_GetStringFromObj(objPtr, &length);
+ if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_DictSearch search;
+ int done, size;
- /*
- * 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.
- */
+ /*
+ * Create the new list representation. Note that we do not need to do
+ * anything with the string representation as the transformation (and
+ * the reverse back to a dictionary) are both order-preserving. Also
+ * note that since we know we've got a valid dictionary (by
+ * representation) we also know that fetching the size of the
+ * dictionary or iterating over it will not fail.
+ */
- limit = (string + length);
- estCount = 1;
- for (p = string; p < limit; p++) {
- if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
- estCount++;
+ Tcl_DictObjSize(NULL, objPtr, &size);
+ listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
+ if (!listRepPtr) {
+ return TCL_ERROR;
}
- }
-
- /*
- * 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.
- */
+ listRepPtr->elemCount = 2 * size;
- listRepPtr = NewListIntRep(estCount, NULL);
- if (!listRepPtr) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "Not enough memory to allocate the list internal rep", -1));
- return TCL_ERROR;
- }
- elemPtrs = &listRepPtr->elements;
+ /*
+ * Populate the list representation.
+ */
- 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);
- }
- ckfree((char *) listRepPtr);
- return result;
- }
- if (elemStart >= limit) {
- break;
+ elemPtrs = &listRepPtr->elements;
+ Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
+ while (!done) {
+ *elemPtrs++ = keyPtr;
+ *elemPtrs++ = valuePtr;
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
- if (i > estCount) {
- Tcl_Panic("SetListFromAny: bad size estimate for list");
+ } else {
+ int estCount, length;
+ const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
+
+ /*
+ * Allocate enough space to hold a (Tcl_Obj *) for each
+ * (possible) list element.
+ */
+
+ 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 Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
+ * Each iteration, parse and store a list element.
*/
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+ while (nextElem < limit) {
+ const char *elemStart;
+ int elemSize, literal;
+
+ 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;
+ }
+ if (elemStart == limit) {
+ break;
+ }
+
+ /* 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);
+ }
+
+ 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.
*/
- listRepPtr->refCount++;
TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclListType;
+ ListSetIntRep(objPtr, listRepPtr);
return TCL_OK;
}
@@ -1589,23 +1922,36 @@ SetListFromAny(interp, objPtr)
*/
static void
-UpdateStringOfList(listPtr)
- Tcl_Obj *listPtr; /* List object with string rep to update. */
+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;
- char *elem, *dst;
- int length;
+ int i, length, bytesNeeded = 0;
+ const char *elem;
+ char *dst;
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.
*/
@@ -1613,55 +1959,44 @@ UpdateStringOfList(listPtr)
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
- flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
- }
- listPtr->length = 1;
- elemPtrs = &listRepPtr->elements;
- for (i = 0; i < numElems; i++) {
- elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
- listPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i]) + 1;
-
/*
- * Check for continued sanity. [Bug 1267380]
+ * We know numElems <= LIST_MAX, so this is safe.
*/
- if (listPtr->length < 1) {
- Tcl_Panic("string representation size exceeds sane bounds");
+ flagPtr = ckalloc(numElems * sizeof(int));
+ }
+ elemPtrs = &listRepPtr->elements;
+ for (i = 0; i < numElems; i++) {
+ flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
+ elem = TclGetStringFromObj(elemPtrs[i], &length);
+ 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++) {
- elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- *dst = ' ';
- dst++;
+ flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
+ elem = TclGetStringFromObj(elemPtrs[i], &length);
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
}
+ listPtr->bytes[listPtr->length] = '\0';
+
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
- }
- if (dst == listPtr->bytes) {
- *dst = 0;
- } else {
- dst--;
- *dst = 0;
+ ckfree(flagPtr);
}
- 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 c4bf5ee..2b0cc7e 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -12,12 +12,11 @@
*
* 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.25 2005/07/19 00:09:07 dkf Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+
/*
* When there are this many entries per bucket, on average, rebuild a
* literal's hash table to make it larger.
@@ -26,25 +25,25 @@
#define REBUILD_MULTIPLIER 3
/*
- * Procedure prototypes for static procedures in this file:
+ * Function prototypes for static functions in this file:
*/
-static int AddLocalLiteralEntry _ANSI_ARGS_((
- CompileEnv *envPtr, LiteralEntry *globalPtr,
- int localHash));
-static void ExpandLocalLiteralArray _ANSI_ARGS_((
- CompileEnv *envPtr));
-static unsigned int HashString _ANSI_ARGS_((CONST char *bytes,
- int length));
-static void RebuildLiteralTable _ANSI_ARGS_((
- LiteralTable *tablePtr));
+static int AddLocalLiteralEntry(CompileEnv *envPtr,
+ Tcl_Obj *objPtr, int localHash);
+static void ExpandLocalLiteralArray(CompileEnv *envPtr);
+static unsigned HashString(const char *string, int length);
+#ifdef TCL_COMPILE_DEBUG
+static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+#endif
+static void RebuildLiteralTable(LiteralTable *tablePtr);
/*
*----------------------------------------------------------------------
*
* TclInitLiteralTable --
*
- * This procedure is called to initialize the fields of a literal table
+ * This function is called to initialize the fields of a literal table
* structure for either an interpreter or a compilation's CompileEnv
* structure.
*
@@ -58,13 +57,13 @@ static void RebuildLiteralTable _ANSI_ARGS_((
*/
void
-TclInitLiteralTable(tablePtr)
- register LiteralTable *tablePtr;
+TclInitLiteralTable(
+ register LiteralTable *tablePtr)
/* Pointer to table structure, which is
* supplied by the caller. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
- Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+ Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable",
TCL_SMALL_HASH_TABLE);
#endif
@@ -73,87 +72,16 @@ TclInitLiteralTable(tablePtr)
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
tablePtr->numEntries = 0;
- tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+ tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE * REBUILD_MULTIPLIER;
tablePtr->mask = 3;
}
/*
*----------------------------------------------------------------------
*
- * TclCleanupLiteralTable --
- *
- * This procedure 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( interp, tablePtr )
- 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. */
- 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( "literal without a string rep" );
- }
- objPtr->typePtr = NULL;
- typePtr->freeIntRepProc(objPtr);
- didOne = 1;
- } else {
- entryPtr = nextPtr;
- }
- }
- } while (didOne);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclDeleteLiteralTable --
*
- * This procedure frees up everything associated with a literal table
+ * This function frees up everything associated with a literal table
* except for the table's structure itself. It is called when the
* interpreter is deleted.
*
@@ -169,10 +97,10 @@ TclCleanupLiteralTable( interp, tablePtr )
*/
void
-TclDeleteLiteralTable(interp, tablePtr)
- Tcl_Interp *interp; /* Interpreter containing shared literals
+TclDeleteLiteralTable(
+ Tcl_Interp *interp, /* Interpreter containing shared literals
* referenced by the table to delete. */
- LiteralTable *tablePtr; /* Points to the literal table to delete. */
+ LiteralTable *tablePtr) /* Points to the literal table to delete. */
{
LiteralEntry *entryPtr, *nextPtr;
Tcl_Obj *objPtr;
@@ -191,19 +119,19 @@ TclDeleteLiteralTable(interp, tablePtr)
/*
* We used to call TclReleaseLiteral for each literal in the table, which
* is rather inefficient as it causes one lookup-by-hash for each
- * reference to the literal. We now rely at interp-deletion on each
+ * reference to the literal. We now rely at interp-deletion on each
* bytecode object to release its references to the literal Tcl_Obj
* without requiring that it updates the global table itself, and deal
* here only with the table.
*/
- for (i = 0; i < tablePtr->numBuckets; i++) {
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
entryPtr = tablePtr->buckets[i];
while (entryPtr != NULL) {
objPtr = entryPtr->objPtr;
TclDecrRefCount(objPtr);
nextPtr = entryPtr->nextPtr;
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
entryPtr = nextPtr;
}
}
@@ -213,140 +141,96 @@ TclDeleteLiteralTable(interp, tablePtr)
*/
if (tablePtr->buckets != tablePtr->staticBuckets) {
- ckfree((char *) tablePtr->buckets);
+ ckfree(tablePtr->buckets);
}
}
/*
*----------------------------------------------------------------------
*
- * TclRegisterLiteral --
+ * TclCreateLiteral --
*
- * Find, or if necessary create, an object in a CompileEnv literal array
- * that has a string representation matching the argument string.
+ * Find, or if necessary create, an object in the interpreter's literal
+ * table that has a string representation matching the argument
+ * string. If nsPtr!=NULL then only literals stored for the namespace are
+ * considered.
*
* Results:
- * The index in the CompileEnv's literal array that references a shared
- * literal matching the string. The object is created if necessary.
+ * The literal object. If it was created in this call *newPtr is set to
+ * 1, else 0. NULL is returned if newPtr==NULL and no literal is found.
*
* Side effects:
- * To maximize sharing, we look up the string in the interpreter's global
- * literal table. If not found, we create a new shared literal in the
- * global table. We then add a reference to the shared literal in the
- * CompileEnv's literal array.
- *
- * If LITERAL_ON_HEAP is set in flags, this procedure is given ownership
- * of the string: if an object is created then its string representation
- * is set directly from string, otherwise the string is freed. Typically,
- * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
- * buffer holding the result of backslash substitutions.
+ * Increments the ref count of the global LiteralEntry since the caller
+ * now holds a reference. If LITERAL_ON_HEAP is set in flags, this
+ * function is given ownership of the string: if an object is created
+ * then its string representation is set directly from string, otherwise
+ * the string is freed. Typically, a caller sets LITERAL_ON_HEAP if
+ * "string" is an already heap-allocated buffer holding the result of
+ * backslash substitutions.
*
*----------------------------------------------------------------------
*/
-int
-TclRegisterLiteral(envPtr, bytes, length, flags)
- CompileEnv *envPtr; /* Points to the CompileEnv in whose object
- * array an object is found or created. */
- register char *bytes; /* Points to string for which to find or
- * create an object in CompileEnv's object
- * array. */
- int length; /* Number of bytes in the string. If < 0, the
- * string consists of all bytes up to the
- * first null character. */
- int flags; /* If LITERAL_ON_HEAP then the caller already
- * malloc'd bytes and ownership is passed to
- * this procedure. If LITERAL_NS_SCOPE then
- * the literal shouldnot be shared accross
- * namespaces. */
+Tcl_Obj *
+TclCreateLiteral(
+ Interp *iPtr,
+ char *bytes, /* The start of the string. Note that this is
+ * not a NUL-terminated string. */
+ int length, /* Number of bytes in the string. */
+ unsigned hash, /* The string's hash. If -1, it will be
+ * computed here. */
+ int *newPtr,
+ Namespace *nsPtr,
+ int flags,
+ LiteralEntry **globalPtrPtr)
{
- Interp *iPtr = envPtr->iPtr;
- LiteralTable *globalTablePtr = &(iPtr->literalTable);
- LiteralTable *localTablePtr = &(envPtr->localLitTable);
- register LiteralEntry *globalPtr, *localPtr;
- register Tcl_Obj *objPtr;
- unsigned int hash;
- int localHash, globalHash, objIndex;
- Namespace *nsPtr;
-
- if (length < 0) {
- length = (bytes ? strlen(bytes) : 0);
- }
- hash = HashString(bytes, length);
-
- /*
- * Is the literal already in the CompileEnv's local literal array? If so,
- * just return its index.
- */
-
- localHash = (hash & localTablePtr->mask);
- for (localPtr = localTablePtr->buckets[localHash];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
- objPtr = localPtr->objPtr;
- if ((objPtr->length == length) && ((length == 0)
- || ((objPtr->bytes[0] == bytes[0])
- && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
- if (flags & LITERAL_ON_HEAP) {
- ckfree(bytes);
- }
- objIndex = (localPtr - envPtr->literalArrayPtr);
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- return objIndex;
- }
- }
-
- /*
- * The literal is new to this CompileEnv. Should it be shared accross
- * namespaces? If it is a fully qualified name, the namespace
- * specification is not needed to avoid sharing.
- */
-
- if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
- && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
- nsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- nsPtr = NULL;
- }
+ LiteralTable *globalTablePtr = &iPtr->literalTable;
+ LiteralEntry *globalPtr;
+ int globalHash;
+ Tcl_Obj *objPtr;
/*
* Is it in the interpreter's global literal table?
*/
+ if (hash == (unsigned) -1) {
+ hash = HashString(bytes, length);
+ }
globalHash = (hash & globalTablePtr->mask);
- for (globalPtr = globalTablePtr->buckets[globalHash];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
+ globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
if ((globalPtr->nsPtr == nsPtr)
&& (objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
/*
- * A global literal was found. Add an entry to the CompileEnv's
- * local literal array.
+ * A literal was found: return it
*/
+ if (newPtr) {
+ *newPtr = 0;
+ }
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
+ }
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
-#ifdef TCL_COMPILE_DEBUG
- if (globalPtr->refCount < 1) {
- Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
- (length>60? 60 : length), bytes, globalPtr->refCount);
- }
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
- return objIndex;
+ globalPtr->refCount++;
+ return objPtr;
}
}
+ if (!newPtr) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ return NULL;
+ }
/*
* The literal is new to the interpreter. Add it to the global literal
- * table then add an entry to the CompileEnv's local literal array.
- * Convert the object to an integer object if possible.
+ * table.
*/
TclNewObj(objPtr);
@@ -358,35 +242,16 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
TclInitStringRep(objPtr, bytes, length);
}
-#if 0
- if (TclLooksLikeInt(bytes, length)) {
- /*
- * From here we use the objPtr, because it is NULL terminated
- */
-
- long n;
- char buf[TCL_INTEGER_SPACE];
-
- if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {
- TclFormatInt(buf, n);
- if (strcmp(objPtr->bytes, buf) == 0) {
- objPtr->internalRep.longValue = n;
- objPtr->typePtr = &tclIntType;
- }
- }
- }
-#endif
-
#ifdef TCL_COMPILE_DEBUG
- if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
- Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
- (length>60? 60 : length), bytes);
+ if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
+ Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
+ "TclRegisterLiteral", (length>60? 60 : length), bytes);
}
#endif
- globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
+ globalPtr = ckalloc(sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
- globalPtr->refCount = 0;
+ globalPtr->refCount = 1;
globalPtr->nsPtr = nsPtr;
globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
globalTablePtr->buckets[globalHash] = globalPtr;
@@ -400,11 +265,9 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
RebuildLiteralTable(globalTablePtr);
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
- TclVerifyLocalLiteralTable(envPtr);
{
LiteralEntry *entryPtr;
int found, i;
@@ -419,8 +282,8 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
}
}
if (!found) {
- Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
- (length>60? 60 : length), bytes);
+ Tcl_Panic("%s: literal \"%.*s\" wasn't global",
+ "TclRegisterLiteral", (length>60? 60 : length), bytes);
}
}
#endif /*TCL_COMPILE_DEBUG*/
@@ -432,13 +295,162 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
+ }
+ *newPtr = 1;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFetchLiteral --
+ *
+ * Fetch from a CompileEnv the literal value identified by an index
+ * value, as returned by a prior call to TclRegisterLiteral().
+ *
+ * Results:
+ * The literal value, or NULL if the index is out of range.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFetchLiteral(
+ CompileEnv *envPtr, /* Points to the CompileEnv from which to
+ * fetch the registered literal value. */
+ unsigned int index) /* Index of the desired literal, as returned
+ * by prior call to TclRegisterLiteral() */
+{
+ if (index >= (unsigned int) envPtr->literalArrayNext) {
+ return NULL;
+ }
+ return envPtr->literalArrayPtr[index].objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ * Find, or if necessary create, an object in a CompileEnv literal array
+ * that has a string representation matching the argument string.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references a shared
+ * literal matching the string. The object is created if necessary.
+ *
+ * Side effects:
+ * To maximize sharing, we look up the string in the interpreter's global
+ * literal table. If not found, we create a new shared literal in the
+ * global table. We then add a reference to the shared literal in the
+ * CompileEnv's literal array.
+ *
+ * If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ * of the string: if an object is created then its string representation
+ * is set directly from string, otherwise the string is freed. Typically,
+ * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ * buffer holding the result of backslash substitutions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(
+ void *ePtr, /* Points to the CompileEnv in whose object
+ * array an object is found or created. */
+ register char *bytes, /* Points to string for which to find or
+ * create an object in CompileEnv's object
+ * array. */
+ int length, /* Number of bytes in the string. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
+ int flags) /* If LITERAL_ON_HEAP then the caller already
+ * malloc'd bytes and ownership is passed to
+ * this function. If LITERAL_CMD_NAME then
+ * the literal should not be shared accross
+ * namespaces. */
+{
+ CompileEnv *envPtr = ePtr;
+ Interp *iPtr = envPtr->iPtr;
+ LiteralTable *localTablePtr = &envPtr->localLitTable;
+ LiteralEntry *globalPtr, *localPtr;
+ Tcl_Obj *objPtr;
+ unsigned hash;
+ int localHash, objIndex, new;
+ Namespace *nsPtr;
+
+ if (length < 0) {
+ length = (bytes ? strlen(bytes) : 0);
+ }
+ hash = HashString(bytes, length);
+
+ /*
+ * Is the literal already in the CompileEnv's local literal array? If so,
+ * just return its index.
+ */
+
+ localHash = (hash & localTablePtr->mask);
+ for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+ localPtr = localPtr->nextPtr) {
+ objPtr = localPtr->objPtr;
+ if ((objPtr->length == length) && ((length == 0)
+ || ((objPtr->bytes[0] == bytes[0])
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ return objIndex;
+ }
+ }
+
+ /*
+ * The literal is new to this CompileEnv. If it is a command name, avoid
+ * sharing it accross namespaces, and try not to share it with non-cmd
+ * literals. Note that FQ command names can be shared, so that we register
+ * the namespace as the interp's global NS.
+ */
+
+ if (flags & LITERAL_CMD_NAME) {
+ if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
+ nsPtr = iPtr->globalNsPtr;
+ } else {
+ nsPtr = iPtr->varFramePtr->nsPtr;
+ }
+ } else {
+ nsPtr = NULL;
+ }
+
+ /*
+ * Is it in the interpreter's global literal table? If not, create it.
+ */
+
+ objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
+ &globalPtr);
+ objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+ if (globalPtr->refCount < 1) {
+ Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
+ "TclRegisterLiteral", (length>60? 60 : length), bytes,
+ globalPtr->refCount);
+ }
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
return objIndex;
}
+#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
- * TclLookupLiteralEntry --
+ * LookupLiteralEntry --
*
* Finds the LiteralEntry that corresponds to a literal Tcl object
* holding a literal.
@@ -452,24 +464,24 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
*----------------------------------------------------------------------
*/
-LiteralEntry *
-TclLookupLiteralEntry(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+static LiteralEntry *
+LookupLiteralEntry(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a Tcl object holding a literal
+ register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
* that was previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
- LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ LiteralTable *globalTablePtr = &iPtr->literalTable;
register LiteralEntry *entryPtr;
- char *bytes;
+ const char *bytes;
int length, globalHash;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
globalHash = (HashString(bytes, length) & globalTablePtr->mask);
- for (entryPtr = globalTablePtr->buckets[globalHash];
- entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
+ for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
return entryPtr;
}
@@ -477,6 +489,7 @@ TclLookupLiteralEntry(interp, objPtr)
return NULL;
}
+#endif
/*
*----------------------------------------------------------------------
*
@@ -498,27 +511,27 @@ TclLookupLiteralEntry(interp, objPtr)
*/
void
-TclHideLiteral(interp, envPtr, index)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+TclHideLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register CompileEnv *envPtr;/* Points to CompileEnv whose literal array
+ register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
* contains the entry being hidden. */
- int index; /* The index of the entry in the literal
+ int index) /* The index of the entry in the literal
* array. */
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
- LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ LiteralTable *localTablePtr = &envPtr->localLitTable;
int localHash, length;
- char *bytes;
+ const char *bytes;
Tcl_Obj *newObjPtr;
- lPtr = &(envPtr->literalArrayPtr[index]);
+ lPtr = &envPtr->literalArrayPtr[index];
/*
* To avoid unwanted sharing we need to copy the object and remove it from
- * the local and global literal tables. It still has a slot in the
- * literal array so it can be referred to by byte codes, but it will not
- * be matched by literal searches.
+ * the local and global literal tables. It still has a slot in the literal
+ * array so it can be referred to by byte codes, but it will not be
+ * matched by literal searches.
*/
newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
@@ -526,7 +539,7 @@ TclHideLiteral(interp, envPtr, index)
TclReleaseLiteral(interp, lPtr->objPtr);
lPtr->objPtr = newObjPtr;
- bytes = Tcl_GetStringFromObj(newObjPtr, &length);
+ bytes = TclGetStringFromObj(newObjPtr, &length);
localHash = (HashString(bytes, length) & localTablePtr->mask);
nextPtrPtr = &localTablePtr->buckets[localHash];
@@ -563,11 +576,11 @@ TclHideLiteral(interp, envPtr, index)
*/
int
-TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
- register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array
+TclAddLiteralObj(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
- Tcl_Obj *objPtr; /* The object to insert into the array. */
- LiteralEntry **litPtrPtr; /* The location where the pointer to the new
+ Tcl_Obj *objPtr, /* The object to insert into the array. */
+ LiteralEntry **litPtrPtr) /* The location where the pointer to the new
* literal entry should be stored. May be
* NULL. */
{
@@ -580,7 +593,7 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
objIndex = envPtr->literalArrayNext;
envPtr->literalArrayNext++;
- lPtr = &(envPtr->literalArrayPtr[objIndex]);
+ lPtr = &envPtr->literalArrayPtr[objIndex];
lPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
lPtr->refCount = -1; /* i.e., unused */
@@ -605,27 +618,24 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
* literal.
*
* Side effects:
- * Increments the ref count of the global LiteralEntry since the
- * CompileEnv now refers to the literal. Expands the literal array if
- * necessary. May rebuild the hash bucket array of the CompileEnv's
- * literal array if it becomes too large.
+ * Expands the literal array if necessary. May rebuild the hash bucket
+ * array of the CompileEnv's literal array if it becomes too large.
*
*----------------------------------------------------------------------
*/
static int
-AddLocalLiteralEntry(envPtr, globalPtr, localHash)
- register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array
+AddLocalLiteralEntry(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
- LiteralEntry *globalPtr; /* Points to the global LiteralEntry for the
- * literal to add to the CompileEnv. */
- int localHash; /* Hash value for the literal's string. */
+ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */
+ int localHash) /* Hash value for the literal's string. */
{
- register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ register LiteralTable *localTablePtr = &envPtr->localLitTable;
LiteralEntry *localPtr;
int objIndex;
- objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+ objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
/*
* Add the literal to the local table.
@@ -635,8 +645,6 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
localTablePtr->buckets[localHash] = localPtr;
localTablePtr->numEntries++;
- globalPtr->refCount++;
-
/*
* If the CompileEnv's local literal table has exceeded a decent size,
* rebuild it with more buckets.
@@ -656,16 +664,16 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
for (i=0 ; i<localTablePtr->numBuckets ; i++) {
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
localPtr=localPtr->nextPtr) {
- if (localPtr->objPtr == globalPtr->objPtr) {
+ if (localPtr->objPtr == objPtr) {
found = 1;
}
}
}
if (!found) {
- bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
- Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
- (length>60? 60 : length), bytes);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
+ "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
}
}
#endif /*TCL_COMPILE_DEBUG*/
@@ -678,7 +686,7 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
*
* ExpandLocalLiteralArray --
*
- * Procedure that uses malloc to allocate more storage for a CompileEnv's
+ * Function that uses malloc to allocate more storage for a CompileEnv's
* local literal array.
*
* Results:
@@ -694,8 +702,8 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
*/
static void
-ExpandLocalLiteralArray(envPtr)
- register CompileEnv *envPtr;/* Points to the CompileEnv whose object array
+ExpandLocalLiteralArray(
+ register CompileEnv *envPtr)/* Points to the CompileEnv whose object array
* must be enlarged. */
{
/*
@@ -703,46 +711,47 @@ ExpandLocalLiteralArray(envPtr)
* 0 and (envPtr->literalArrayNext - 1) [inclusive].
*/
- LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ LiteralTable *localTablePtr = &envPtr->localLitTable;
int currElems = envPtr->literalArrayNext;
size_t currBytes = (currElems * sizeof(LiteralEntry));
- register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
- register LiteralEntry *newArrayPtr =
- (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
+ LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+ LiteralEntry *newArrayPtr;
int i;
- /*
- * Copy from the old literal array to the new, then update the local
- * literal table's bucket array.
- */
+ if (envPtr->mallocedLiteralArray) {
+ newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
+ } else {
+ /*
+ * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
+ * code a ckrealloc equivalent for ourselves.
+ */
- memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
- for (i=0 ; i<currElems ; i++) {
- if (currArrayPtr[i].nextPtr == NULL) {
- newArrayPtr[i].nextPtr = NULL;
- } else {
- newArrayPtr[i].nextPtr =
- newArrayPtr + (currArrayPtr[i].nextPtr - currArrayPtr);
- }
- }
- for (i=0 ; i<localTablePtr->numBuckets ; i++) {
- if (localTablePtr->buckets[i] != NULL) {
- localTablePtr->buckets[i] =
- newArrayPtr + (localTablePtr->buckets[i] - currArrayPtr);
- }
+ newArrayPtr = ckalloc(2 * currBytes);
+ memcpy(newArrayPtr, currArrayPtr, currBytes);
+ envPtr->mallocedLiteralArray = 1;
}
/*
- * Free the old literal array if needed, and mark the new literal array as
- * malloced.
+ * Update the local literal table's bucket array.
*/
- if (envPtr->mallocedLiteralArray) {
- ckfree((char *) currArrayPtr);
+ if (currArrayPtr != newArrayPtr) {
+ for (i=0 ; i<currElems ; i++) {
+ if (newArrayPtr[i].nextPtr != NULL) {
+ newArrayPtr[i].nextPtr = newArrayPtr
+ + (newArrayPtr[i].nextPtr - currArrayPtr);
+ }
+ }
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ if (localTablePtr->buckets[i] != NULL) {
+ localTablePtr->buckets[i] = newArrayPtr
+ + (localTablePtr->buckets[i] - currArrayPtr);
+ }
+ }
}
+
envPtr->literalArrayPtr = newArrayPtr;
envPtr->literalArrayEnd = (2 * currElems);
- envPtr->mallocedLiteralArray = 1;
}
/*
@@ -750,7 +759,7 @@ ExpandLocalLiteralArray(envPtr)
*
* TclReleaseLiteral --
*
- * This procedure releases a reference to one of the shared Tcl objects
+ * This function releases a reference to one of the shared Tcl objects
* that hold literals. It is called to release the literals referenced by
* a ByteCode that is being destroyed, and it is also called by
* TclDeleteLiteralTable.
@@ -767,20 +776,25 @@ ExpandLocalLiteralArray(envPtr)
*/
void
-TclReleaseLiteral(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+TclReleaseLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a literal object that was
+ register Tcl_Obj *objPtr) /* Points to a literal object that was
* previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
- LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
- char *bytes;
+ const char *bytes;
int length, index;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ if (iPtr == NULL) {
+ goto done;
+ }
+
+ globalTablePtr = &iPtr->literalTable;
+ bytes = TclGetStringFromObj(objPtr, &length);
index = (HashString(bytes, length) & globalTablePtr->mask);
/*
@@ -789,9 +803,8 @@ TclReleaseLiteral(interp, objPtr)
* local literal.
*/
- for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
- entryPtr != NULL;
- prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+ for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
+ entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
entryPtr->refCount--;
@@ -807,7 +820,7 @@ TclReleaseLiteral(interp, objPtr)
} else {
prevPtr->nextPtr = entryPtr->nextPtr;
}
- ckfree((char *) entryPtr);
+ ckfree(entryPtr);
globalTablePtr->numEntries--;
TclDecrRefCount(objPtr);
@@ -824,6 +837,7 @@ TclReleaseLiteral(interp, objPtr)
* Remove the reference corresponding to the local literal table entry.
*/
+ done:
Tcl_DecrRefCount(objPtr);
}
@@ -844,13 +858,12 @@ TclReleaseLiteral(interp, objPtr)
*----------------------------------------------------------------------
*/
-static unsigned int
-HashString(bytes, length)
- register CONST char *bytes; /* String for which to compute hash value. */
- int length; /* Number of bytes in the string. */
+static unsigned
+HashString(
+ register const char *string, /* String for which to compute hash value. */
+ int length) /* Number of bytes in the string. */
{
- register unsigned int result;
- register int i;
+ register unsigned int result = 0;
/*
* I tried a zillion different hash functions and asked many other people
@@ -860,17 +873,33 @@ HashString(bytes, length)
* following reasons:
*
* 1. Multiplying by 10 is perfect for keys that are decimal strings, and
- * multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
- * character's bits hang around in the low-order bits of the hash value
- * for ever, plus they spread fairly rapidly up to the high-order bits
- * to fill out the hash value. This seems works well both for decimal
- * and non-decimal strings.
+ * multiplying by 9 is just about as good.
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * character's bits hang around in the low-order bits of the hash value
+ * for ever, plus they spread fairly rapidly up to the high-order bits
+ * to fill out the hash value. This seems works well both for decimal
+ * and non-decimal strings.
+ *
+ * Note that this function is very weak against malicious strings; it's
+ * very easy to generate multiple keys that have the same hashcode. On the
+ * other hand, that hardly ever actually occurs and this function *is*
+ * very cheap, even by comparison with industry-standard hashes like FNV.
+ * If real strength of hash is required though, use a custom hash based on
+ * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
+ * Tcl scripts tend to not have a big issue in this area, and literals
+ * mostly aren't looked up by name anyway.
+ *
+ * See also HashStringKey in tclHash.c.
+ * See also TclObjHashKey in tclObj.c.
+ *
+ * See [tcl-Feature Request #2958832]
*/
- result = 0;
- for (i=0 ; i<length ; i++) {
- result += (result<<3) + bytes[i];
+ if (length > 0) {
+ result = UCHAR(*string);
+ while (--length) {
+ result += (result << 3) + UCHAR(*++string);
+ }
}
return result;
}
@@ -880,7 +909,7 @@ HashString(bytes, length)
*
* RebuildLiteralTable --
*
- * This procedure is invoked when the ratio of entries to hash buckets
+ * This function is invoked when the ratio of entries to hash buckets
* becomes too large in a local or global literal table. It allocates a
* larger bucket array and moves the entries into the new buckets.
*
@@ -894,15 +923,15 @@ HashString(bytes, length)
*/
static void
-RebuildLiteralTable(tablePtr)
- register LiteralTable *tablePtr;
+RebuildLiteralTable(
+ register LiteralTable *tablePtr)
/* Local or global table to enlarge. */
{
LiteralEntry **oldBuckets;
register LiteralEntry **oldChainPtr, **newChainPtr;
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
- char *bytes;
+ const char *bytes;
int oldSize, count, index, length;
oldSize = tablePtr->numBuckets;
@@ -914,11 +943,9 @@ RebuildLiteralTable(tablePtr)
*/
tablePtr->numBuckets *= 4;
- tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
- (tablePtr->numBuckets * sizeof(LiteralEntry *)));
- for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
- count > 0;
- count--, newChainPtr++) {
+ tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
+ for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
+ count>0 ; count--, newChainPtr++) {
*newChainPtr = NULL;
}
tablePtr->rebuildSize *= 4;
@@ -930,11 +957,11 @@ RebuildLiteralTable(tablePtr)
for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
- bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ bytes = TclGetStringFromObj(entryPtr->objPtr, &length);
index = (HashString(bytes, length) & tablePtr->mask);
*oldChainPtr = entryPtr->nextPtr;
- bucketPtr = &(tablePtr->buckets[index]);
+ bucketPtr = &tablePtr->buckets[index];
entryPtr->nextPtr = *bucketPtr;
*bucketPtr = entryPtr;
}
@@ -945,7 +972,52 @@ RebuildLiteralTable(tablePtr)
*/
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) {
+ if (literalObjPtr->typePtr == &tclCmdNameType) {
+ TclFreeIntRep(literalObjPtr);
+ }
+ /* Balance the refcount effects of TclCreateLiteral() above */
+ Tcl_IncrRefCount(literalObjPtr);
+ TclReleaseLiteral(interp, literalObjPtr);
}
}
@@ -969,8 +1041,8 @@ RebuildLiteralTable(tablePtr)
*/
char *
-TclLiteralStats(tablePtr)
- LiteralTable *tablePtr; /* Table for which to produce stats. */
+TclLiteralStats(
+ LiteralTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
int count[NUM_COUNTERS], overflow, i, j;
@@ -983,15 +1055,15 @@ TclLiteralStats(tablePtr)
* number of entries in the chain.
*/
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
count[i] = 0;
}
overflow = 0;
average = 0.0;
- for (i = 0; i < tablePtr->numBuckets; i++) {
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
j = 0;
- for (entryPtr = tablePtr->buckets[i]; entryPtr != NULL;
- entryPtr = entryPtr->nextPtr) {
+ for (entryPtr=tablePtr->buckets[i] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
j++;
}
if (j < NUM_COUNTERS) {
@@ -1007,11 +1079,11 @@ TclLiteralStats(tablePtr)
* 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);
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
sprintf(p, "number of buckets with %d entries: %d\n",
i, count[i]);
p += strlen(p);
@@ -1042,40 +1114,44 @@ TclLiteralStats(tablePtr)
*/
void
-TclVerifyLocalLiteralTable(envPtr)
- CompileEnv *envPtr; /* Points to CompileEnv whose literal table is
+TclVerifyLocalLiteralTable(
+ CompileEnv *envPtr) /* Points to CompileEnv whose literal table is
* to be validated. */
{
- register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ register LiteralTable *localTablePtr = &envPtr->localLitTable;
register LiteralEntry *localPtr;
char *bytes;
register int i;
int length, count;
count = 0;
- for (i = 0; i < localTablePtr->numBuckets; i++) {
- for (localPtr = localTablePtr->buckets[i];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
count++;
if (localPtr->refCount != -1) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
- Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+ Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
+ "TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes, localPtr->refCount);
}
- if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
+ if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
- Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+ Tcl_Panic("%s: local literal \"%.*s\" is not global",
+ "TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes);
}
if (localPtr->objPtr->bytes == NULL) {
- Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+ Tcl_Panic("%s: literal has NULL string rep",
+ "TclVerifyLocalLiteralTable");
}
}
}
if (count != localTablePtr->numEntries) {
- Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
- count, localTablePtr->numEntries);
+ Tcl_Panic("%s: local literal table had %d entries, should be %d",
+ "TclVerifyLocalLiteralTable", count,
+ localTablePtr->numEntries);
}
}
@@ -1096,34 +1172,37 @@ TclVerifyLocalLiteralTable(envPtr)
*/
void
-TclVerifyGlobalLiteralTable(iPtr)
- Interp *iPtr; /* Points to interpreter whose global literal
+TclVerifyGlobalLiteralTable(
+ Interp *iPtr) /* Points to interpreter whose global literal
* table is to be validated. */
{
- register LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ register LiteralTable *globalTablePtr = &iPtr->literalTable;
register LiteralEntry *globalPtr;
char *bytes;
register int i;
int length, count;
count = 0;
- for (i = 0; i < globalTablePtr->numBuckets; i++) {
- for (globalPtr = globalTablePtr->buckets[i];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+ for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
+ globalPtr=globalPtr->nextPtr) {
count++;
if (globalPtr->refCount < 1) {
bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
- Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+ Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
+ "TclVerifyGlobalLiteralTable",
(length>60? 60 : length), bytes, globalPtr->refCount);
}
if (globalPtr->objPtr->bytes == NULL) {
- Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+ Tcl_Panic("%s: literal has NULL string rep",
+ "TclVerifyGlobalLiteralTable");
}
}
}
if (count != globalTablePtr->numEntries) {
- Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
- count, globalTablePtr->numEntries);
+ Tcl_Panic("%s: global literal table had %d entries, should be %d",
+ "TclVerifyGlobalLiteralTable", count,
+ globalTablePtr->numEntries);
}
}
#endif /*TCL_COMPILE_DEBUG*/
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 72c33d4..7c70e03 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.14 2005/07/17 21:17:43 dkf Exp $
*/
#include "tclInt.h"
@@ -17,8 +15,8 @@
/*
* The following structure describes a package that has been loaded either
* dynamically (with the "load" command) or statically (as indicated by a call
- * to TclGetLoadedPackages). All such packages are linked together into a
- * single list for the process. Packages are never unloaded, until the
+ * to TclGetLoadedPackages). All such packages are linked together into a
+ * single list for the process. Packages are never unloaded, until the
* application exits, when TclFinalizeLoad is called, and these structures are
* freed.
*/
@@ -33,35 +31,30 @@ typedef struct LoadedPackage {
* Malloc-ed. */
Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be
* passed to (*unLoadProcPtr)() when the file
- * is no longer needed. If fileName is NULL,
+ * is no longer needed. If fileName is NULL,
* then this field is irrelevant. */
Tcl_PackageInitProc *initProc;
- /* Initialization procedure to call to
+ /* Initialization function to call to
* incorporate this package into a trusted
* interpreter. */
Tcl_PackageInitProc *safeInitProc;
- /* Initialization procedure to call to
+ /* Initialization function to call to
* incorporate this package into a safe
* interpreter (one that will execute
* untrusted scripts). NULL means the package
* can't be used in unsafe interpreters. */
Tcl_PackageUnloadProc *unloadProc;
- /* Finalisation procedure to unload a package
+ /* Finalisation function to unload a package
* from a trusted interpreter. NULL means that
* the package cannot be unloaded. */
Tcl_PackageUnloadProc *safeUnloadProc;
- /* Finalisation procedure to unload a package
+ /* Finalisation function to unload a package
* from a safe interpreter. NULL means that
* the package cannot be unloaded. */
int interpRefCount; /* How many times the package has been loaded
* in trusted interpreters. */
int safeInterpRefCount; /* How many times the package has been loaded
* in safe interpreters. */
- Tcl_FSUnloadFileProc *unLoadProcPtr;
- /* Procedure to use to unload this package.
- * If NULL, then we do not attempt to unload
- * the package. If fileName is NULL, then
- * this field is irrelevant. */
struct LoadedPackage *nextPtr;
/* Next in list of all packages loaded into
* this application process. NULL means end of
@@ -83,7 +76,7 @@ TCL_DECLARE_MUTEX(packageMutex)
/*
* The following structure represents a particular package that has been
* incorporated into a particular interpreter (by calling its initialization
- * procedure). There is a list of these structures for each interpreter, with
+ * function). There is a list of these structures for each interpreter, with
* an AssocData value (key "load") for the interpreter that points to the
* first package (if any).
*/
@@ -97,18 +90,18 @@ typedef struct InterpPackage {
} InterpPackage;
/*
- * Prototypes for procedures that are private to this file:
+ * Prototypes for functions that are private to this file:
*/
-static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
+static void LoadCleanupProc(ClientData clientData,
+ Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
*
* Tcl_LoadObjCmd --
*
- * This procedure is invoked to process the "load" Tcl command. See the
+ * This function is invoked to process the "load" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -121,29 +114,52 @@ static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
*/
int
-Tcl_LoadObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LoadObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
Tcl_DString pkgName, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
- Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
InterpPackage *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
- CONST char *symbols[4];
- Tcl_PackageInitProc **procPtrs[4];
- ClientData clientData;
- char *p, *fullFileName, *packageName;
+ const char *symbols[2];
+ Tcl_PackageInitProc *initProc;
+ const char *p, *fullFileName, *packageName;
Tcl_LoadHandle loadHandle;
- Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
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) {
@@ -166,9 +182,10 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
}
}
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;
}
@@ -179,7 +196,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
target = interp;
if (objc == 4) {
- char *slaveIntName = Tcl_GetString(objv[3]);
+ const char *slaveIntName = Tcl_GetString(objv[3]);
target = Tcl_GetSlave(interp, slaveIntName);
if (target == NULL) {
@@ -190,7 +207,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
/*
* Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * package we want is already loaded. We'll use a loaded package if it
* meets any of the following conditions:
* - Its name and file match the once we're looking for.
* - Its file matches, and we weren't given a name.
@@ -205,9 +222,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
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));
@@ -218,7 +235,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -232,9 +249,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
* Can't have two different packages loaded from the same file.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" is already loaded for package \"",
- pkgPtr->packageName, "\"", (char *) 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;
@@ -247,13 +266,12 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
/*
* Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then
+ * interpreter. If the package we want is already loaded there, then
* there's nothing for us to do.
*/
if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
- (Tcl_InterpDeleteProc **) NULL);
+ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->pkgPtr == pkgPtr) {
code = TCL_OK;
@@ -269,8 +287,10 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
*/
if (fullFileName[0] == 0) {
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" isn't loaded statically", (char *) 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;
}
@@ -290,10 +310,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
retc = TclGuessPackageName(fullFileName, &pkgName);
if (!retc) {
- Tcl_Obj *splitPtr;
- Tcl_Obj *pkgGuessPtr;
+ Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
- char *pkgGuess;
+ const char *pkgGuess;
/*
* The platform-specific code couldn't figure out the module
@@ -310,6 +329,12 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
&& (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)
@@ -320,13 +345,15 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
}
if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
- Tcl_AppendResult(interp,
- "couldn't figure out package name for ",
- fullFileName, (char *) 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);
}
}
@@ -341,69 +368,57 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
/*
- * Compute the names of the two initialization procedures, based on
- * the package name.
+ * Compute the names of the two initialization functions, based on the
+ * 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
- * initialization procedures.
+ * initialization functions.
*/
symbols[0] = Tcl_DStringValue(&initName);
- symbols[1] = Tcl_DStringValue(&safeInitName);
- symbols[2] = Tcl_DStringValue(&unloadName);
- symbols[3] = Tcl_DStringValue(&safeUnloadName);
- procPtrs[0] = &initProc;
- procPtrs[1] = &safeInitProc;
- procPtrs[2] = &unloadProc;
- procPtrs[3] = &safeUnloadProc;
+ symbols[1] = NULL;
Tcl_MutexLock(&packageMutex);
- code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
- &loadHandle, &clientData, &unLoadProcPtr);
+ code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
+ &loadHandle);
Tcl_MutexUnlock(&packageMutex);
- loadHandle = (Tcl_LoadHandle) clientData;
if (code != TCL_OK) {
goto done;
}
- if (*procPtrs[0] /* initProc */ == NULL) {
- Tcl_AppendResult(interp, "couldn't find procedure ",
- Tcl_DStringValue(&initName), (char *) NULL);
- if (unLoadProcPtr != NULL) {
- (*unLoadProcPtr)(loadHandle);
- }
- code = TCL_ERROR;
- goto done;
- }
-
/*
* Create a new record to describe this package.
*/
- pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *) ckalloc((unsigned)
- (strlen(fullFileName) + 1));
- strcpy(pkgPtr->fileName, fullFileName);
- pkgPtr->packageName = (char *) 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->unLoadProcPtr = unLoadProcPtr;
- pkgPtr->initProc = *procPtrs[0];
- pkgPtr->safeInitProc = *procPtrs[1];
- pkgPtr->unloadProc = (Tcl_PackageUnloadProc*) *procPtrs[2];
- pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc*) *procPtrs[3];
+ 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->interpRefCount = 0;
pkgPtr->safeInterpRefCount = 0;
@@ -411,60 +426,79 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
pkgPtr->nextPtr = firstPackagePtr;
firstPackagePtr = pkgPtr;
Tcl_MutexUnlock(&packageMutex);
+
+ /*
+ * The Tcl_FindSymbol calls may have left a spurious error message in
+ * the interpreter result.
+ */
+
+ Tcl_ResetResult(interp);
}
/*
- * Invoke the package's initialization procedure (either the normal one or
+ * Invoke the package's initialization function (either the normal one or
* the safe one, depending on whether or not the interpreter is safe).
*/
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", (char *) 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 {
- code = (*pkgPtr->initProc)(target);
+ 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 = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
- (Tcl_InterpDeleteProc **) NULL);
- ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
- ipPtr->nextPtr = ipFirstPtr;
- Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
- (ClientData) ipPtr);
+ Tcl_MutexLock(&packageMutex);
+ if (Tcl_IsSafe(target)) {
+ pkgPtr->safeInterpRefCount++;
} else {
- TclTransferResult(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);
@@ -481,8 +515,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
*
* Tcl_UnloadObjCmd --
*
- * This procedure is invoked to process the "unload" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "unload" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -494,11 +528,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
*/
int
-Tcl_UnloadObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UnloadObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedPackage *pkgPtr, *defaultPtr;
@@ -507,8 +541,9 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
InterpPackage *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
- char *fullFileName = "", *packageName;
- static CONST char *options[] = {
+ const char *fullFileName = "";
+ const char *packageName;
+ static const char *const options[] = {
"-nocomplain", "-keeplibrary", "--", NULL
};
enum options {
@@ -551,7 +586,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
endOfForLoop:
if ((objc-i < 1) || (objc-i > 3)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? fileName ?packageName? ?interp?");
+ "?-switch ...? fileName ?packageName? ?interp?");
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
@@ -570,9 +605,10 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
}
}
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;
}
@@ -583,8 +619,8 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
target = interp;
if (objc - i == 3) {
- char *slaveIntName;
- slaveIntName = Tcl_GetString(objv[i+2]);
+ const char *slaveIntName = Tcl_GetString(objv[i + 2]);
+
target = Tcl_GetSlave(interp, slaveIntName);
if (target == NULL) {
return TCL_ERROR;
@@ -593,7 +629,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
/*
* Scan through the packages that are currently loaded to see if the
- * package we want is already loaded. We'll use a loaded package if it
+ * package we want is already loaded. We'll use a loaded package if it
* meets any of the following conditions:
* - Its name and file match the once we're looking for.
* - Its file matches, and we weren't given a name.
@@ -610,9 +646,9 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
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));
@@ -623,7 +659,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
namesMatch = 0;
}
}
- Tcl_DStringSetLength(&pkgName, 0);
+ TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -642,9 +678,11 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
* It's an error to try unload a static package.
*/
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" is loaded statically and cannot be unloaded",
- (char *) 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;
}
@@ -653,22 +691,23 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
* The DLL pointed by the provided filename has never been loaded.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded", (char *) 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;
}
/*
* Scan through the list of packages already loaded in the target
- * interpreter. If the package we want is already loaded there, then we
+ * interpreter. If the package we want is already loaded there, then we
* should proceed with unloading.
*/
code = TCL_ERROR;
if (pkgPtr != NULL) {
- ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
- (Tcl_InterpDeleteProc **) NULL);
+ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->pkgPtr == pkgPtr) {
code = TCL_OK;
@@ -681,8 +720,11 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
* The package has not been loaded in this interpreter.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded in this interpreter", (char *) 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;
}
@@ -695,18 +737,22 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
if (Tcl_IsSafe(target)) {
if (pkgPtr->safeUnloadProc == NULL) {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded under a safe interpreter",
- (char *) 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",
- (char *) 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;
}
@@ -715,7 +761,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
/*
* We are ready to unload the package. First, evaluate the unload
- * procedure. If this fails, we cannot proceed with unload. Also, we must
+ * function. If this fails, we cannot proceed with unload. Also, we must
* specify the proper flag to pass to the unload callback.
* TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should
* only remove itself from the interpreter; the library will be unloaded
@@ -731,29 +777,29 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
Tcl_MutexUnlock(&packageMutex);
if (Tcl_IsSafe(target)) {
- --safeRefCount;
+ safeRefCount--;
} else {
- --trustedRefCount;
+ trustedRefCount--;
}
if (safeRefCount <= 0 && trustedRefCount <= 0) {
code = TCL_UNLOAD_DETACH_FROM_PROCESS;
}
}
- code = (*unloadProc)(target, code);
+ code = unloadProc(target, code);
if (code != TCL_OK) {
- TclTransferResult(target, code, interp);
+ Tcl_TransferResult(target, code, interp);
goto done;
}
/*
- * The unload procedure executed fine. Examine the reference count to see
+ * The unload function executed fine. Examine the reference count to see
* if we unload the DLL.
*/
Tcl_MutexLock(&packageMutex);
if (Tcl_IsSafe(target)) {
- --pkgPtr->safeInterpRefCount;
+ pkgPtr->safeInterpRefCount--;
/*
* Do not let counter get negative.
@@ -763,7 +809,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
pkgPtr->safeInterpRefCount = 0;
}
} else {
- --pkgPtr->interpRefCount;
+ pkgPtr->interpRefCount--;
/*
* Do not let counter get negative.
@@ -784,7 +830,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
* Unload the shared library from the application memory...
*/
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
@@ -793,12 +839,8 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
*/
if (pkgPtr->fileName[0] != '\0') {
- Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
-
- if (unLoadProcPtr != NULL) {
- Tcl_MutexLock(&packageMutex);
- (*unLoadProcPtr)(pkgPtr->loadHandle);
-
+ Tcl_MutexLock(&packageMutex);
+ if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
/*
* Remove this library from the loaded library cache.
*/
@@ -820,8 +862,7 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
* Remove this library from the interpreter's library cache.
*/
- ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
- "tclLoad", (Tcl_InterpDeleteProc **) NULL);
+ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ipFirstPtr;
if (ipPtr->pkgPtr == defaultPtr) {
ipFirstPtr = ipFirstPtr->nextPtr;
@@ -837,22 +878,22 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
}
}
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
- (ClientData) ipFirstPtr);
+ ipFirstPtr);
ckfree(defaultPtr->fileName);
ckfree(defaultPtr->packageName);
- ckfree((char *) defaultPtr);
- ckfree((char *) ipPtr);
+ ckfree(defaultPtr);
+ ckfree(ipPtr);
Tcl_MutexUnlock(&packageMutex);
} else {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded: filesystem does not support unloading",
- (char *) NULL);
code = TCL_ERROR;
}
}
#else
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded: unloading disabled", (char *) 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
}
@@ -860,40 +901,10 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
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.
- */
-
- objPtr[0] = Tcl_NewIntObj(trustedRefCount);
- objPtr[1] = Tcl_NewIntObj(safeRefCount);
- if (objPtr[0] == NULL || objPtr[1] == NULL) {
- if (objPtr[0]) {
- Tcl_DecrRefCount(objPtr[0]);
- }
- if (objPtr[1]) {
- Tcl_DecrRefCount(objPtr[1]);
- }
- } else {
- resultObjPtr = Tcl_NewListObj(2, objPtr);
- if (resultObjPtr != NULL) {
- Tcl_SetObjResult(interp, resultObjPtr);
- }
- }
-#endif
- }
return code;
}
@@ -902,33 +913,33 @@ Tcl_UnloadObjCmd(dummy, interp, objc, objv)
*
* Tcl_StaticPackage --
*
- * This procedure is invoked to indicate that a particular package has
+ * This function is invoked to indicate that a particular package has
* been linked statically with an application.
*
* Results:
* None.
*
* Side effects:
- * Once this procedure completes, the package becomes loadable via the
+ * Once this function completes, the package becomes loadable via the
* "load" command with an empty file name.
*
*----------------------------------------------------------------------
*/
void
-Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
- Tcl_Interp *interp; /* If not NULL, it means that the package has
+Tcl_StaticPackage(
+ Tcl_Interp *interp, /* If not NULL, it means that the package has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
- CONST char *pkgName; /* Name of package (must be properly
+ const char *pkgName, /* Name of package (must be properly
* capitalized: first letter upper case,
* others lower case). */
- Tcl_PackageInitProc *initProc;
- /* Procedure to call to incorporate this
+ Tcl_PackageInitProc *initProc,
+ /* Function to call to incorporate this
* package into a trusted interpreter. */
- Tcl_PackageInitProc *safeInitProc;
- /* Procedure to call to incorporate this
+ Tcl_PackageInitProc *safeInitProc)
+ /* Function to call to incorporate this
* package into a safe interpreter (one that
* will execute untrusted scripts). NULL means
* the package can't be used in safe
@@ -957,12 +968,11 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
* to the list now.
*/
- if ( pkgPtr == NULL ) {
- pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *) ckalloc((unsigned) 1);
+ if (pkgPtr == NULL) {
+ pkgPtr = ckalloc(sizeof(LoadedPackage));
+ pkgPtr->fileName = ckalloc(1);
pkgPtr->fileName[0] = 0;
- pkgPtr->packageName = (char *) ckalloc((unsigned)
- (strlen(pkgName) + 1));
+ pkgPtr->packageName = ckalloc(strlen(pkgName) + 1);
strcpy(pkgPtr->packageName, pkgName);
pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
@@ -980,10 +990,9 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
* it's already loaded.
*/
- ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
- (Tcl_InterpDeleteProc **) NULL);
- for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
- if ( ipPtr->pkgPtr == pkgPtr ) {
+ ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL);
+ for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ if (ipPtr->pkgPtr == pkgPtr) {
return;
}
}
@@ -993,11 +1002,10 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
* loaded.
*/
- ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+ ipPtr = ckalloc(sizeof(InterpPackage));
ipPtr->pkgPtr = pkgPtr;
ipPtr->nextPtr = ipFirstPtr;
- Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
- (ClientData) ipPtr);
+ Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
}
}
@@ -1006,7 +1014,7 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
*
* TclGetLoadedPackages --
*
- * This procedure returns information about all of the files that are
+ * This function returns information about all of the files that are
* loaded (either in a particular intepreter, or for all interpreters).
*
* Results:
@@ -1023,10 +1031,10 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
*/
int
-TclGetLoadedPackages(interp, targetName)
- Tcl_Interp *interp; /* Interpreter in which to return information
+TclGetLoadedPackages(
+ Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
- char *targetName; /* Name of target interpreter or NULL. If
+ const char *targetName) /* Name of target interpreter or NULL. If
* NULL, return info about all interps;
* otherwise, just return info about this
* interpreter. */
@@ -1034,24 +1042,24 @@ TclGetLoadedPackages(interp, targetName)
Tcl_Interp *target;
LoadedPackage *pkgPtr;
InterpPackage *ipPtr;
- 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, (char *) NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", (char *) 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;
}
@@ -1064,17 +1072,15 @@ TclGetLoadedPackages(interp, targetName)
if (target == NULL) {
return TCL_ERROR;
}
- ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
- (Tcl_InterpDeleteProc **) NULL);
- prefix = "{";
- for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+ resultObj = Tcl_NewObj();
+ for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
- Tcl_AppendResult(interp, prefix, (char *) NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", (char *) 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;
}
@@ -1083,7 +1089,7 @@ TclGetLoadedPackages(interp, targetName)
*
* LoadCleanupProc --
*
- * This procedure is called to delete all of the InterpPackage structures
+ * This function is called to delete all of the InterpPackage structures
* for an interpreter when the interpreter is deleted. It gets invoked
* via the Tcl AssocData mechanism.
*
@@ -1091,24 +1097,23 @@ TclGetLoadedPackages(interp, targetName)
* None.
*
* Side effects:
- * Storage for all of the InterpPackage procedures for interp get
- * deleted.
+ * Storage for all of the InterpPackage functions for interp get deleted.
*
*----------------------------------------------------------------------
*/
static void
-LoadCleanupProc(clientData, interp)
- ClientData clientData; /* Pointer to first InterpPackage structure
+LoadCleanupProc(
+ ClientData clientData, /* Pointer to first InterpPackage structure
* for interp. */
- Tcl_Interp *interp; /* Interpreter that is being deleted. */
+ Tcl_Interp *interp) /* Interpreter that is being deleted. */
{
InterpPackage *ipPtr, *nextPtr;
- ipPtr = (InterpPackage *) clientData;
+ ipPtr = clientData;
while (ipPtr != NULL) {
nextPtr = ipPtr->nextPtr;
- ckfree((char *) ipPtr);
+ ckfree(ipPtr);
ipPtr = nextPtr;
}
}
@@ -1118,7 +1123,7 @@ LoadCleanupProc(clientData, interp)
*
* TclFinalizeLoad --
*
- * This procedure is invoked just before the application exits. It frees
+ * This function is invoked just before the application exits. It frees
* all of the LoadedPackage structures.
*
* Results:
@@ -1131,40 +1136,37 @@ LoadCleanupProc(clientData, interp)
*/
void
-TclFinalizeLoad()
+TclFinalizeLoad(void)
{
LoadedPackage *pkgPtr;
/*
* No synchronization here because there should just be one thread alive
* at this point. Logically, packageMutex should be grabbed at this point,
- * but the Mutexes get finalized before the call to this routine. The
- * only subsystem left alive at this point is the memory allocator.
+ * but the Mutexes get finalized before the call to this routine. The only
+ * subsystem left alive at this point is the memory allocator.
*/
while (firstPackagePtr != NULL) {
pkgPtr = firstPackagePtr;
firstPackagePtr = pkgPtr->nextPtr;
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
* a core on exit because it wants to call a function in the dll after
- * it's been unloaded.
+ * it has been unloaded.
*/
if (pkgPtr->fileName[0] != '\0') {
- Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
- if (unLoadProcPtr != NULL) {
- (*unLoadProcPtr)(pkgPtr->loadHandle);
- }
+ Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
}
#endif
ckfree(pkgPtr->fileName);
ckfree(pkgPtr->packageName);
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
}
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 4507b06..c22c4c4 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -1,16 +1,13 @@
-/*
+/*
* tclLoadNone.c --
*
- * This procedure provides a version of the TclLoadFile for use
- * in systems that don't support dynamic loading; it just returns
- * an error.
+ * This procedure provides a version of the TclpDlopen for use in
+ * systems that don't support dynamic loading; it just returns an error.
*
* Copyright (c) 1995-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: tclLoadNone.c,v 1.11 2002/07/18 16:26:03 vincentdarley 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"
@@ -20,13 +17,13 @@
*
* TclpDlopen --
*
- * This procedure is called to carry out dynamic loading of binary
- * code; it is intended for use only on systems that don't support
- * dynamic loading (it returns an error).
+ * This procedure is called to carry out dynamic loading of binary code;
+ * it is intended for use only on systems that don't support dynamic
+ * loading (it returns an error).
*
* Results:
- * The result is TCL_ERROR, and an error message is left in
- * the interp's result.
+ * The result is TCL_ERROR, and an error message is left in the interp's
+ * result.
*
* Side effects:
* None.
@@ -35,61 +32,38 @@
*/
int
-TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+TclpDlopen(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
- Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ 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. */
+ * 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;
}
/*
*----------------------------------------------------------------------
*
- * TclpFindSymbol --
- *
- * Looks up a symbol, by name, through a handle associated with
- * a previously loaded piece of code (shared library).
- *
- * Results:
- * Returns a pointer to the function associated with 'symbol' if
- * it is found. Otherwise returns NULL and may leave an error
- * message in the interp's result.
- *
- *----------------------------------------------------------------------
- */
-Tcl_PackageInitProc*
-TclpFindSymbol(interp, loadHandle, symbol)
- Tcl_Interp *interp;
- Tcl_LoadHandle loadHandle;
- CONST char *symbol;
-{
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclGuessPackageName --
*
- * If the "load" command is invoked without providing a package
- * name, this procedure is invoked to try to figure it out.
+ * If the "load" command is invoked without providing a package name,
+ * this procedure is invoked to try to figure it out.
*
* Results:
- * Always returns 0 to indicate that we couldn't figure out a
- * package name; generic code will then try to guess the package
- * from the file name. A return value of 1 would have meant that
- * we figured out the package name and put it in bufPtr.
+ * Always returns 0 to indicate that we couldn't figure out a package
+ * name; generic code will then try to guess the package from the file
+ * name. A return value of 1 would have meant that we figured out the
+ * package name and put it in bufPtr.
*
* Side effects:
* None.
@@ -98,38 +72,52 @@ TclpFindSymbol(interp, loadHandle, symbol)
*/
int
-TclGuessPackageName(fileName, bufPtr)
- CONST char *fileName; /* Name of file containing package (already
+TclGuessPackageName(
+ const char *fileName, /* Name of file containing package (already
* translated to local form if needed). */
- Tcl_DString *bufPtr; /* Initialized empty dstring. Append
- * package name to this if possible. */
+ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
+ * name to this if possible. */
{
return 0;
}
/*
- *----------------------------------------------------------------------
- *
- * TclpUnloadFile --
- *
- * This procedure is called to carry out dynamic unloading of binary
- * code; it is intended for use only on systems that don't support
- * dynamic loading (it does nothing).
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
+ * These functions are fallbacks if we somehow determine that the platform can
+ * do loading from memory but the user wishes to disable it. They just report
+ * (gracefully) that they fail.
*/
-void
-TclpUnloadFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
- * to TclpDlopen(). The loadHandle is
- * a token that represents the loaded
- * file. */
+#ifdef TCL_LOAD_FROM_MEMORY
+
+MODULE_SCOPE void *
+TclpLoadMemoryGetBuffer(
+ Tcl_Interp *interp, /* Dummy: unused by this implementation */
+ int size) /* Dummy: unused by this implementation */
{
+ return NULL;
+}
+
+MODULE_SCOPE int
+TclpLoadMemory(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ void *buffer, /* Dummy: unused by this implementation */
+ int size, /* Dummy: unused by this implementation */
+ int codeSize, /* Dummy: unused by this implementation */
+ Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */
+ Tcl_FSUnloadFileProc **unloadProcPtr)
+ /* Dummy: unused by this implementation */
+{
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+ "is not available on this system", -1));
+ return TCL_ERROR;
}
+
+#endif /* TCL_LOAD_FROM_MEMORY */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 75fa70b..360f5e9 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,14 +14,25 @@
*
* 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.32 2005/09/15 16:40:02 dgp Exp $
*/
-#include "tclInt.h"
+/*
+ * 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.
+ */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
+#if defined(TCL_ASCII_MAIN)
+# ifdef UNICODE
+# undef UNICODE
+# undef _UNICODE
+# else
+# define UNICODE
+# define _UNICODE
+# endif
+#endif
+
+#include "tclInt.h"
/*
* The default prompt used when the user has not overridden it.
@@ -25,17 +41,61 @@
#define DEFAULT_PRIMARY_PROMPT "% "
/*
- * Declarations for various library procedures and variables (don't want to
+ * 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).
*/
-extern DLLIMPORT int isatty _ANSI_ARGS_((int fd));
+extern CRTIMPORT int isatty(int fd);
-static Tcl_Obj *tclStartupScriptPath = NULL;
-static Tcl_Obj *tclStartupScriptEncoding = NULL;
+/*
+ * The thread-local variables for this file's functions.
+ */
-static Tcl_MainLoopProc *mainLoopProc = NULL;
+typedef struct {
+ Tcl_Obj *path; /* The filename of the script for *_Main()
+ * routines to [source] as a startup script,
+ * or NULL for none set, meaning enter
+ * interactive mode. */
+ Tcl_Obj *encoding; /* The encoding of the startup script file. */
+ Tcl_MainLoopProc *mainLoopProc;
+ /* Any installed main loop handler. The main
+ * extension that installs these is Tk. */
+} ThreadSpecificData;
/*
* Structure definition for information used to keep the state of an
@@ -63,14 +123,17 @@ typedef struct InteractiveState {
} InteractiveState;
/*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
*/
-static void Prompt _ANSI_ARGS_((Tcl_Interp *interp,
- PromptType *promptPtr));
-static void StdinProc _ANSI_ARGS_((ClientData clientData,
- int mask));
+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;
+
/*
*----------------------------------------------------------------------
*
@@ -88,29 +151,31 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
*/
void
-Tcl_SetStartupScript(path, encoding)
- Tcl_Obj *path; /* Filesystem path of startup script file */
- CONST char *encoding; /* Encoding of the data in that file */
+Tcl_SetStartupScript(
+ Tcl_Obj *path, /* Filesystem path of startup script file */
+ const char *encoding) /* Encoding of the data in that file */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_Obj *newEncoding = NULL;
+
if (encoding != NULL) {
newEncoding = Tcl_NewStringObj(encoding, -1);
}
- if (tclStartupScriptPath != NULL) {
- Tcl_DecrRefCount(tclStartupScriptPath);
+ if (tsdPtr->path != NULL) {
+ Tcl_DecrRefCount(tsdPtr->path);
}
- tclStartupScriptPath = path;
- if (tclStartupScriptPath != NULL) {
- Tcl_IncrRefCount(tclStartupScriptPath);
+ tsdPtr->path = path;
+ if (tsdPtr->path != NULL) {
+ Tcl_IncrRefCount(tsdPtr->path);
}
- if (tclStartupScriptEncoding != NULL) {
- Tcl_DecrRefCount(tclStartupScriptEncoding);
+ if (tsdPtr->encoding != NULL) {
+ Tcl_DecrRefCount(tsdPtr->encoding);
}
- tclStartupScriptEncoding = newEncoding;
- if (tclStartupScriptEncoding != NULL) {
- Tcl_IncrRefCount(tclStartupScriptEncoding);
+ tsdPtr->encoding = newEncoding;
+ if (tsdPtr->encoding != NULL) {
+ Tcl_IncrRefCount(tsdPtr->encoding);
}
}
@@ -126,140 +191,40 @@ Tcl_SetStartupScript(path, encoding)
* The path of the startup script; NULL if none has been set.
*
* Side effects:
- * If encodingPtr is not NULL, stores a (CONST char *) in it pointing to
- * the encoding name registered for the startup script. Tcl retains
- * ownership of the string, and may free it. Caller should make a copy
- * for long-term use.
+ * If encodingPtr is not NULL, stores a (const char *) in it pointing to
+ * the encoding name registered for the startup script. Tcl retains
+ * ownership of the string, and may free it. Caller should make a copy
+ * for long-term use.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_GetStartupScript(encodingPtr)
- CONST char **encodingPtr; /* When not NULL, points to storage for the
- * (CONST char *) that points to the
+Tcl_GetStartupScript(
+ const char **encodingPtr) /* When not NULL, points to storage for the
+ * (const char *) that points to the
* registered encoding name for the startup
- * script */
+ * script. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
if (encodingPtr != NULL) {
- if (tclStartupScriptEncoding == NULL) {
+ if (tsdPtr->encoding == NULL) {
*encodingPtr = NULL;
} else {
- *encodingPtr = Tcl_GetString(tclStartupScriptEncoding);
+ *encodingPtr = Tcl_GetString(tsdPtr->encoding);
}
}
- return tclStartupScriptPath;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetStartupScriptPath --
- *
- * Primes the startup script VFS path, used to override the command line
- * processing.
- *
- * Results:
- * None.
- *
- * Side effects:
- * This procedure initializes the VFS path of the Tcl script to run at
- * startup.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetStartupScriptPath(path)
- Tcl_Obj *path;
-{
- Tcl_SetStartupScript(path, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetStartupScriptPath --
- *
- * Gets the startup script VFS path, used to override the command line
- * processing.
- *
- * Results:
- * The startup script VFS path, NULL if none has been set.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetStartupScriptPath()
-{
- return Tcl_GetStartupScript(NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetStartupScriptFileName --
- *
- * Primes the startup script file name, used to override the command line
- * processing.
- *
- * Results:
- * None.
- *
- * Side effects:
- * This procedure initializes the file name of the Tcl script to run at
- * startup.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetStartupScriptFileName(fileName)
- CONST char *fileName;
-{
- Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
- Tcl_SetStartupScript(path, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetStartupScriptFileName --
- *
- * Gets the startup script file name, used to override the command line
- * processing.
- *
- * Results:
- * The startup script file name, NULL if none has been set.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-CONST char *
-TclGetStartupScriptFileName()
-{
- Tcl_Obj *path = Tcl_GetStartupScript(NULL);
-
- if (path == NULL) {
- return NULL;
- }
- return Tcl_GetString(path);
+ return tsdPtr->path;
}
/*----------------------------------------------------------------------
*
* Tcl_SourceRCFile --
*
- * This procedure is typically invoked by Tcl_Main of Tk_Main procedure
- * to source an application specific rc file into the interpreter at
- * startup time.
+ * This function is typically invoked by Tcl_Main of Tk_Main function to
+ * source an application specific rc file into the interpreter at startup
+ * time.
*
* Results:
* None.
@@ -271,17 +236,17 @@ TclGetStartupScriptFileName()
*/
void
-Tcl_SourceRCFile(interp)
- Tcl_Interp *interp; /* Interpreter to source rc file into. */
+Tcl_SourceRCFile(
+ Tcl_Interp *interp) /* Interpreter to source rc file into. */
{
Tcl_DString temp;
- CONST char *fileName;
- Tcl_Channel errChannel;
+ const char *fileName;
+ Tcl_Channel chan;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
Tcl_Channel c;
- CONST char *fullName;
+ const char *fullName;
Tcl_DStringInit(&temp);
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
@@ -297,33 +262,34 @@ Tcl_SourceRCFile(interp)
*/
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
- if (c != (Tcl_Channel) NULL) {
+ 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);
+ }
+ }
+ }
}
Tcl_DStringFree(&temp);
}
}
+#endif /* !TCL_ASCII_MAIN */
/*----------------------------------------------------------------------
*
- * Tcl_Main --
+ * Tcl_Main, Tcl_MainEx --
*
* Main program for tclsh and most other Tcl-based applications.
*
* Results:
- * None. This procedure never returns (it exits the process when it's
+ * None. This function never returns (it exits the process when it's
* done).
*
* Side effects:
- * This procedure initializes the Tcl world and then starts interpreting
+ * This function initializes the Tcl world and then starts interpreting
* commands; almost anything could happen, depending on the script being
* interpreted.
*
@@ -331,31 +297,31 @@ Tcl_SourceRCFile(interp)
*/
void
-Tcl_Main(argc, argv, appInitProc)
- int argc; /* Number of arguments. */
- char **argv; /* Array of argument strings. */
- Tcl_AppInitProc *appInitProc;
+Tcl_MainEx(
+ int argc, /* Number of arguments. */
+ TCHAR **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
- * procedure to call after most initialization
+ * function to call after most initialization
* but before starting to execute commands. */
+ Tcl_Interp *interp)
{
- Tcl_Obj *path;
- Tcl_Obj *resultPtr;
- Tcl_Obj *commandPtr = NULL;
- CONST char *encodingName = NULL;
- char *args;
- PromptType prompt = PROMPT_START;
- int code, length, tty;
- int exitCode = 0;
- Tcl_Channel inChannel, outChannel, errChannel;
- Tcl_Interp *interp;
- Tcl_DString argString;
-
- Tcl_FindExecutable(argv[0]);
-
- interp = Tcl_CreateInterp();
+ Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
+ const char *encodingName = NULL;
+ int code, exitCode = 0;
+ Tcl_MainLoopProc *mainLoopProc;
+ Tcl_Channel chan;
+ InteractiveState is;
+
+ TclpSetInitialEncodings();
+ TclpFindExecutable((const char *)argv[0]);
+
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
@@ -363,72 +329,66 @@ Tcl_Main(argc, argv, appInitProc)
*/
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++;
}
}
- /*
- * The CONST casting is safe, and better we do it here than force all
- * callers of Tcl_Main to do it. (Those callers are likely in a main()
- * that can't easily change its signature.)
- */
-
- args = Tcl_Merge(argc-1, (CONST char **)argv+1);
- Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
- Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
- Tcl_DStringFree(&argString);
- ckfree(args);
-
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
- Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
+ appName = NewNativeObj(argv[0], -1);
} else {
- CONST char *pathName = Tcl_GetStringFromObj(path, &length);
- Tcl_ExternalToUtfDString(NULL, pathName, length, &argString);
- path = Tcl_NewStringObj(Tcl_DStringValue(&argString), -1);
- Tcl_SetStartupScript(path, encodingName);
+ appName = path;
}
+ Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
+ argc--;
+ argv++;
+
+ Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
- Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc-1),
- TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
+ argvPtr = Tcl_NewListObj(0, NULL);
+ while (argc--) {
+ Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
+ }
+ Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* 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.
*/
- Tcl_Preserve((ClientData) interp);
- if ((*appInitProc)(interp) != TCL_OK) {
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel) {
- Tcl_WriteChars(errChannel,
+ Tcl_Preserve(interp);
+ if (appInitProc(interp) != TCL_OK) {
+ 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)) {
@@ -437,36 +397,45 @@ Tcl_Main(argc, argv, appInitProc)
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 = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr;
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
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;
}
goto done;
}
- Tcl_DStringFree(&argString);
/*
* We're running interactively. Source a user-specific startup file if the
@@ -484,172 +453,159 @@ Tcl_Main(argc, argv, appInitProc)
* 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 != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
- if (tty) {
- Prompt(interp, &prompt);
- if (Tcl_InterpDeleted(interp)) {
- break;
- }
- if (Tcl_LimitExceeded(interp)) {
- break;
+ 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) {
+ int length;
+
+ if (is.tty) {
+ Prompt(interp, &is);
+ if (Tcl_InterpDeleted(interp)) {
+ break;
+ }
+ if (Tcl_LimitExceeded(interp)) {
+ break;
+ }
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ if (is.input == NULL) {
+ break;
+ }
}
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- if (inChannel == (Tcl_Channel) NULL) {
- break;
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
}
- }
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
- }
- length = Tcl_GetsObj(inChannel, commandPtr);
- if (length < 0) {
- if (Tcl_InputBlocked(inChannel)) {
+ length = Tcl_GetsObj(is.input, is.commandPtr);
+ if (length < 0) {
+ 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.
+ * This sets up a tight polling loop (since we have no
+ * event loop running). If this causes bad CPU hogging, we
+ * might try toggling the blocking on stdin instead.
+ */
+
+ continue;
+ }
+
/*
- * This can only happen if stdin has been set to non-blocking.
- * In that case cycle back and try again. This sets up a tight
- * polling loop (since we have no event loop running). If this
- * causes bad CPU hogging, we might try toggling the blocking
- * on stdin instead.
+ * Either EOF, or an error on stdin; we're done
*/
- continue;
+ break;
}
/*
- * Either EOF, or an error on stdin; we're done
+ * Add the newline removed by Tcl_GetsObj back to the string. Have
+ * to add it back before testing completeness, because it can make
+ * a difference. [Bug 1775878]
*/
- break;
- }
+ if (Tcl_IsShared(is.commandPtr)) {
+ Tcl_DecrRefCount(is.commandPtr);
+ is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+ Tcl_IncrRefCount(is.commandPtr);
+ }
+ Tcl_AppendToObj(is.commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(is.commandPtr)) {
+ is.prompt = PROMPT_CONTINUE;
+ continue;
+ }
+
+ is.prompt = PROMPT_START;
- if (!TclObjCommandComplete(commandPtr)) {
/*
- * Add the newline removed by Tcl_GetsObj back to the string.
+ * The final newline is syntactically redundant, and causes some
+ * error messages troubles deeper in, so lop it back off.
*/
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
- }
- Tcl_AppendToObj(commandPtr, "\n", 1);
- prompt = PROMPT_CONTINUE;
- continue;
- }
-
- prompt = PROMPT_START;
- 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);
- if (code != TCL_OK) {
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
- }
- } else if (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);
+ 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) {
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
+ }
+ } else if (is.tty) {
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultPtr);
+ Tcl_GetStringFromObj(resultPtr, &length);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if ((length > 0) && chan) {
+ Tcl_WriteObj(chan, resultPtr);
+ Tcl_WriteChars(chan, "\n", 1);
+ }
+ Tcl_DecrRefCount(resultPtr);
}
- Tcl_DecrRefCount(resultPtr);
- }
-
- if (mainLoopProc != NULL) {
+ } else { /* (mainLoopProc != NULL) */
/*
* If a main loop has been defined while running interactively, we
* want to start a fileevent based prompt by establishing a
* 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((int) 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,
- (ClientData) isPtr);
+
+ Tcl_CreateChannelHandler(is.input, TCL_READABLE,
+ StdinProc, &is);
}
- (*mainLoopProc)();
- mainLoopProc = 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 != (Tcl_Channel) NULL) {
- Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
- (ClientData) isPtr);
- }
- ckfree((char *)isPtr);
+ mainLoopProc();
+ Tcl_SetMainLoop(NULL);
+
+ 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) {
- mainLoopProc = NULL;
+ Tcl_SetMainLoop(NULL);
Tcl_DeleteInterp(interp);
}
-#endif
+#endif /* TCL_MEM_DEBUG */
}
done:
- 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
* this point.
*/
- (*mainLoopProc)();
- mainLoopProc = NULL;
+ mainLoopProc();
+ Tcl_SetMainLoop(NULL);
}
- if (commandPtr != NULL) {
- Tcl_DecrRefCount(commandPtr);
+ if (is.commandPtr != NULL) {
+ Tcl_DecrRefCount(is.commandPtr);
}
/*
@@ -658,67 +614,138 @@ Tcl_Main(argc, argv, appInitProc)
* exit. The Tcl_EvalObjEx call should never return.
*/
- if (!Tcl_InterpDeleted(interp)) {
- if (!Tcl_LimitExceeded(interp)) {
- Tcl_Obj *cmd = Tcl_NewObj();
- TclObjPrintf(NULL, cmd, "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((ClientData) 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_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
+}
+#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
+#ifndef TCL_ASCII_MAIN
+
/*
*---------------------------------------------------------------
*
* Tcl_SetMainLoop --
*
- * Sets an alternative main loop procedure.
+ * Sets an alternative main loop function.
*
* Results:
- * Returns the previously defined main loop procedure.
+ * None.
*
* Side effects:
- * This procedure will be called before Tcl exits, allowing for the
+ * This function will be called before Tcl exits, allowing for the
* creation of an event loop.
*
*---------------------------------------------------------------
*/
void
-Tcl_SetMainLoop(proc)
- Tcl_MainLoopProc *proc;
+Tcl_SetMainLoop(
+ Tcl_MainLoopProc *proc)
{
- mainLoopProc = proc;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tsdPtr->mainLoopProc = proc;
}
/*
+ *---------------------------------------------------------------
+ *
+ * TclGetMainLoop --
+ *
+ * Returns the current alternative main loop function.
+ *
+ * Results:
+ * Returns the previously defined main loop function, or NULL to indicate
+ * that no such function has been installed and standard tclsh behaviour
+ * (i.e., exit once the script is evaluated if not interactive) is
+ * requested..
+ *
+ * Side effects:
+ * None (other than possible creation of this file's TSD block).
+ *
+ *---------------------------------------------------------------
+ */
+
+Tcl_MainLoopProc *
+TclGetMainLoop(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ return tsdPtr->mainLoopProc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 procedure is invoked by the event dispatcher whenever standard
+ * This function is invoked by the event dispatcher whenever standard
* input becomes readable. It grabs the next line of input characters,
* adds them to a command being assembled, and executes the command if
* it's complete.
@@ -734,15 +761,15 @@ Tcl_SetMainLoop(proc)
/* ARGSUSED */
static void
-StdinProc(clientData, mask)
- ClientData clientData; /* The state of interactive cmd line */
- int mask; /* Not used. */
+StdinProc(
+ ClientData clientData, /* The state of interactive cmd line */
+ int mask) /* Not used. */
{
- InteractiveState *isPtr = (InteractiveState *) clientData;
+ 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);
@@ -763,21 +790,23 @@ StdinProc(clientData, mask)
Tcl_Exit(0);
}
- Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
+ Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
return;
}
+ if (Tcl_IsShared(commandPtr)) {
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
+ }
+ Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
- }
- Tcl_AppendToObj(commandPtr, "\n", 1);
isPtr->prompt = PROMPT_CONTINUE;
goto prompt;
}
isPtr->prompt = PROMPT_START;
+ Tcl_GetStringFromObj(commandPtr, &length);
+ Tcl_SetObjLength(commandPtr, --length);
/*
* Disable the stdin channel handler while evaluating the command;
@@ -786,30 +815,31 @@ StdinProc(clientData, mask)
* things, this will trash the text of the command being evaluated.
*/
- Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr);
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
Tcl_DecrRefCount(commandPtr);
isPtr->commandPtr = commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
- if (chan != (Tcl_Channel) NULL) {
- Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
- (ClientData) isPtr);
+ if (chan != NULL) {
+ Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
}
if (code != TCL_OK) {
- Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (errChannel != (Tcl_Channel) 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);
}
} 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 != (Tcl_Channel) 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);
}
@@ -819,8 +849,8 @@ StdinProc(clientData, mask)
*/
prompt:
- if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
- Prompt(interp, &(isPtr->prompt));
+ if (isPtr->tty && (isPtr->input != NULL)) {
+ Prompt(interp, isPtr);
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
}
}
@@ -843,22 +873,21 @@ StdinProc(clientData, mask)
*/
static void
-Prompt(interp, promptPtr)
- 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. */
+Prompt(
+ Tcl_Interp *interp, /* Interpreter to use for prompting. */
+ 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)) {
@@ -866,31 +895,58 @@ Prompt(interp, promptPtr)
}
if (promptCmdPtr == NULL) {
defaultPrompt:
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if ((*promptPtr == PROMPT_START)
- && (outChannel != (Tcl_Channel) 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 != (Tcl_Channel) 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 != (Tcl_Channel) 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 2acedcb..8f2f10e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -5,33 +5,26 @@
* commands and global variables. The global :: namespace is the
* traditional Tcl "global" scope. Other namespaces are created as
* children of the global namespace. These other namespaces contain
- * special-purpose commands and variables for packages. Also includes
- * the TIP#112 ensemble machinery.
+ * special-purpose commands and variables for packages.
*
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2002-2005 Donal K. Fellows.
+ * Copyright (c) 2006 Neil Madden.
+ * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
*
* Originally implemented by
* Michael J. McLennan
* Bell Labs Innovations for Lucent Technologies
* mmclennan@lucent.com
*
- * 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.84 2005/09/14 18:35:56 dgp 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"
-
-/*
- * Initial size of stack allocated space for tail list - used when resetting
- * shadowed command references in the functin: TclResetShadowedCmdRefs.
- */
-
-#define NUM_TRAIL_ELEMS 5
+#include "tclCompile.h" /* for TclLogCommandInfo visibility */
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -60,14 +53,12 @@ static Tcl_ThreadDataKey dataKey;
*/
typedef struct ResolvedNsName {
- Namespace *nsPtr; /* A cached namespace pointer. */
- long nsId; /* nsPtr's unique namespace id. Used to verify
- * that nsPtr is still valid (e.g., it's
- * possible that the namespace was deleted and
- * a new one created at the same address). */
- Namespace *refNsPtr; /* Points to the namespace containing the
- * reference (not the namespace that contains
- * the referenced namespace). */
+ Namespace *nsPtr; /* A cached pointer to the Namespace that the
+ * name resolved to. */
+ Namespace *refNsPtr; /* Points to the namespace context in which
+ * the name was resolved. NULL if the name is
+ * fully qualified and thus the resolution
+ * does not depend on the context. */
int refCount; /* Reference count: 1 for each nsName object
* that has a pointer to this ResolvedNsName
* structure as its internal rep. This
@@ -76,177 +67,77 @@ typedef struct ResolvedNsName {
} ResolvedNsName;
/*
- * The client data for an ensemble command. This consists of the table of
- * commands that are actually exported by the namespace, and an epoch counter
- * that, combined with the exportLookupEpoch field of the namespace structure,
- * defines whether the table contains valid data or will need to be recomputed
- * next time the ensemble command is called.
- */
-
-typedef struct EnsembleConfig {
- Namespace *nsPtr; /* The namspace backing this ensemble up. */
- Tcl_Command token; /* The token for the command that provides
- * ensemble support for the namespace, or NULL
- * if the command has been deleted (or never
- * existed; the global namespace never has an
- * ensemble command.) */
- int epoch; /* The epoch at which this ensemble's table of
- * exported commands is valid. */
- char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
- * consistent points, this will have the same
- * number of entries as there are entries in
- * the subcommandTable hash. */
- Tcl_HashTable subcommandTable;
- /* Hash table of ensemble subcommand names,
- * which are its keys so this also provides
- * the storage management for those subcommand
- * names. The contents of the entry values are
- * object version the prefix lists to use when
- * substituting for the command/subcommand to
- * build the ensemble implementation command.
- * Has to be stored here as well as in
- * subcommandDict because that field is NULL
- * when we are deriving the ensemble from the
- * namespace exports list. FUTURE WORK: use
- * object hash table here. */
- struct EnsembleConfig *next;/* The next ensemble in the linked list of
- * ensembles associated with a namespace. If
- * this field points to this ensemble, the
- * structure has already been unlinked from
- * all lists, and cannot be found by scanning
- * the list from the namespace's ensemble
- * field. */
- int flags; /* ORed combo of ENS_DEAD and
- * TCL_ENSEMBLE_PREFIX. */
-
- /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
-
- Tcl_Obj *subcommandDict; /* Dictionary providing mapping from
- * subcommands to their implementing command
- * prefixes, or NULL if we are to build the
- * map automatically from the namespace
- * exports. */
- Tcl_Obj *subcmdList; /* List of commands that this ensemble
- * actually provides, and whose implementation
- * will be built using the subcommandDict (if
- * present and defined) and by simple mapping
- * to the namespace otherwise. If NULL,
- * indicates that we are using the (dynamic)
- * list of currently exported commands. */
- Tcl_Obj *unknownHandler; /* Script prefix used to handle the case when
- * no match is found (according to the rule
- * defined by flag bit TCL_ENSEMBLE_PREFIX) or
- * NULL to use the default error-generating
- * behaviour. The script execution gets all
- * the arguments to the ensemble command
- * (including objv[0]) and will have the
- * results passed directly back to the caller
- * (including the error code) unless the code
- * is TCL_CONTINUE in which case the
- * subcommand will be reparsed by the ensemble
- * core, presumably because the ensemble
- * itself has been updated. */
-} EnsembleConfig;
-
-#define ENS_DEAD 0x1 /* Flag value to say that the ensemble is dead
- * and on its way out. */
-
-/*
- * The data cached in a subcommand's Tcl_Obj rep. This structure is not shared
- * between Tcl_Objs referring to the same subcommand, even where one is a
- * duplicate of another.
- */
-
-typedef struct EnsembleCmdRep {
- Namespace *nsPtr; /* The namespace backing the ensemble which
- * this is a subcommand of. */
- int epoch; /* Used to confirm when the data in this
- * really structure matches up with the
- * ensemble. */
- Tcl_Command token; /* Reference to the comamnd for which this
- * structure is a cache of the resolution. */
- char *fullSubcmdName; /* The full (local) name of the subcommand,
- * allocated with ckalloc(). */
- Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
- * command that implements this ensemble
- * subcommand. */
-} EnsembleCmdRep;
-
-/*
* Declarations for functions local to this file:
*/
static void DeleteImportedCmd(ClientData clientData);
static int DoImport(Tcl_Interp *interp,
Namespace *nsPtr, Tcl_HashEntry *hPtr,
- CONST char *cmdName, CONST char *pattern,
+ const char *cmdName, const char *pattern,
Namespace *importNsPtr, int allowOverwrite);
static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
static char * ErrorCodeRead(ClientData clientData,Tcl_Interp *interp,
- CONST char *name1, CONST char *name2, int flags);
+ const char *name1, const char *name2, int flags);
static char * ErrorInfoRead(ClientData clientData,Tcl_Interp *interp,
- CONST char *name1, CONST char *name2, int flags);
+ const char *name1, const char *name2, int flags);
static char * EstablishErrorCodeTraces(ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags);
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
static char * EstablishErrorInfoTraces(ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags);
+ Tcl_Interp *interp, const char *name1,
+ const char *name2, int flags);
static void FreeNsNameInternalRep(Tcl_Obj *objPtr);
+static int GetNamespaceFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int InvokeImportedCmd(ClientData clientData,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int InvokeImportedNRCmd(ClientData clientData,
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceChildrenCmd(ClientData dummy,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceCurrentCmd(ClientData dummy,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
-static int NamespaceEnsembleCmd(ClientData dummy,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ 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[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static void NamespaceFree(Namespace *nsPtr);
static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceInscopeCmd(ClientData dummy,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ 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[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespacePathCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int NamespaceQualifiersCmd(ClientData dummy,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
+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[]);
static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void UpdateStringOfNsName(Tcl_Obj *objPtr);
-static int NsEnsembleImplementationCmd(ClientData clientData,
- Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
-static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
-static int NsEnsembleStringOrder(CONST VOID *strPtr1,
- CONST VOID *strPtr2);
-static void DeleteEnsembleConfig(ClientData clientData);
-static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
- EnsembleConfig *ensemblePtr,
- CONST char *subcmdName, Tcl_Obj *prefixObjPtr);
-static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
-static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
static void UnlinkNsPath(Namespace *nsPtr);
-static void SetNsPath(Namespace *nsPtr, int pathLength,
- Tcl_Namespace *pathAry[]);
+
+static Tcl_NRPostProc NsEval_Callback;
/*
* This structure defines a Tcl object type that contains a namespace
@@ -255,27 +146,40 @@ static void SetNsPath(Namespace *nsPtr, int pathLength,
* the object.
*/
-Tcl_ObjType tclNsNameType = {
+static const Tcl_ObjType nsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
- UpdateStringOfNsName, /* updateStringProc */
+ NULL, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
/*
- * This structure defines a Tcl object type that contains a reference to an
- * ensemble subcommand (e.g. the "length" in [string length ab]) It is used to
- * cache the mapping between the subcommand itself and the real command that
- * implements it.
+ * Array of values describing how to implement each standard subcommand of the
+ * "namespace" command.
*/
-static Tcl_ObjType ensembleCmdType = {
- "ensembleCommand", /* the type's name */
- FreeEnsembleCmdRep, /* freeIntRepProc */
- DupEnsembleCmdRep, /* dupIntRepProc */
- StringOfEnsembleCmdRep, /* updateStringProc */
- NULL /* setFromAnyProc */
+static const EnsembleImplMap defaultNamespaceMap[] = {
+ {"children", NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
+ {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0},
+ {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
+ {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
+ {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0},
+ {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+ {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
+ {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0},
+ {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
+ {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0},
+ {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
+ {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
@@ -296,7 +200,7 @@ static Tcl_ObjType ensembleCmdType = {
*/
void
-TclInitNamespaceSubsystem()
+TclInitNamespaceSubsystem(void)
{
/*
* Does nothing for now.
@@ -320,19 +224,11 @@ TclInitNamespaceSubsystem()
*/
Tcl_Namespace *
-Tcl_GetCurrentNamespace(interp)
- register Tcl_Interp *interp;/* Interpreter whose current namespace is
+Tcl_GetCurrentNamespace(
+ register Tcl_Interp *interp)/* Interpreter whose current namespace is
* being queried. */
{
- register Interp *iPtr = (Interp *) interp;
- register Namespace *nsPtr;
-
- if (iPtr->varFramePtr != NULL) {
- nsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- nsPtr = iPtr->globalNsPtr;
- }
- return (Tcl_Namespace *) nsPtr;
+ return TclGetCurrentNamespace(interp);
}
/*
@@ -352,13 +248,11 @@ Tcl_GetCurrentNamespace(interp)
*/
Tcl_Namespace *
-Tcl_GetGlobalNamespace(interp)
- register Tcl_Interp *interp;/* Interpreter whose global namespace should
+Tcl_GetGlobalNamespace(
+ register Tcl_Interp *interp)/* Interpreter whose global namespace should
* be returned. */
{
- register Interp *iPtr = (Interp *) interp;
-
- return (Tcl_Namespace *) iPtr->globalNsPtr;
+ return TclGetGlobalNamespace(interp);
}
/*
@@ -381,10 +275,10 @@ Tcl_GetGlobalNamespace(interp)
*/
int
-Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
- Tcl_Interp *interp; /* Interpreter in which the new call frame is
+Tcl_PushCallFrame(
+ Tcl_Interp *interp, /* Interpreter in which the new call frame is
* to be pushed. */
- Tcl_CallFrame *callFramePtr;/* Points to a call frame structure to push.
+ Tcl_CallFrame *callFramePtr,/* Points to a call frame structure to push.
* Storage for this has already been allocated
* by the caller; typically this is the
* address of a CallFrame structure allocated
@@ -393,10 +287,10 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
* caller can pop the frame later with
* Tcl_PopCallFrame, and it is responsible for
* freeing the frame's storage. */
- Tcl_Namespace *namespacePtr;/* Points to the namespace in which the frame
+ Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame
* will execute. If NULL, the interpreter's
* current namespace will be used. */
- int isProcCallFrame; /* If nonzero, the frame represents a called
+ int isProcCallFrame) /* If nonzero, the frame represents a called
* Tcl procedure and may have local vars. Vars
* will ordinarily be looked up in the frame.
* If new variables are created, they will be
@@ -411,9 +305,19 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
register Namespace *nsPtr;
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
+
+ /*
+ * TODO: Examine whether it would be better to guard based on NS_DYING
+ * or NS_KILLED. It appears that these are not tested because they can
+ * be set in a global interp that has been [namespace delete]d, but
+ * which never really completely goes away because of lingering global
+ * things like ::errorInfo and [::unknown] and hidden commands.
+ * Review of those designs might permit stricter checking here.
+ */
+
if (nsPtr->flags & NS_DEAD) {
Tcl_Panic("Trying to push call frame for dead namespace");
/*NOTREACHED*/
@@ -430,13 +334,16 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
if (iPtr->varFramePtr != NULL) {
framePtr->level = (iPtr->varFramePtr->level + 1);
} else {
- framePtr->level = 1;
+ framePtr->level = 0;
}
framePtr->procPtr = NULL; /* no called procedure */
framePtr->varTablePtr = NULL; /* and no local variables */
framePtr->numCompiledLocals = 0;
framePtr->compiledLocals = NULL;
-
+ framePtr->clientData = NULL;
+ framePtr->localCachePtr = NULL;
+ framePtr->tailcallPtr = NULL;
+
/*
* Push the new call frame onto the interpreter's stack of procedure call
* frames making it the current frame.
@@ -444,6 +351,7 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
iPtr->framePtr = framePtr;
iPtr->varFramePtr = framePtr;
+
return TCL_OK;
}
@@ -467,8 +375,8 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
*/
void
-Tcl_PopCallFrame(interp)
- Tcl_Interp* interp; /* Interpreter with call frame to pop. */
+Tcl_PopCallFrame(
+ Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
register Interp *iPtr = (Interp *) interp;
register CallFrame *framePtr = iPtr->framePtr;
@@ -480,16 +388,24 @@ Tcl_PopCallFrame(interp)
* the variable deletion don't see the partially-deleted frame.
*/
- iPtr->framePtr = framePtr->callerPtr;
- iPtr->varFramePtr = framePtr->callerVarPtr;
+ if (framePtr->callerPtr) {
+ iPtr->framePtr = framePtr->callerPtr;
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ } else {
+ /* Tcl_PopCallFrame: trying to pop rootCallFrame! */
+ }
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
- ckfree((char *) framePtr->varTablePtr);
+ ckfree(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
+ if (--framePtr->localCachePtr->refCount == 0) {
+ TclFreeLocalCache(interp, framePtr->localCachePtr);
+ }
+ framePtr->localCachePtr = NULL;
}
/*
@@ -500,10 +416,15 @@ Tcl_PopCallFrame(interp)
nsPtr = framePtr->nsPtr;
nsPtr->activationCount--;
- if ((nsPtr->flags & NS_DYING) && (nsPtr->activationCount == 0)) {
+ if ((nsPtr->flags & NS_DYING)
+ && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
+
+ if (framePtr->tailcallPtr) {
+ TclSetTailcall(interp, framePtr->tailcallPtr);
+ }
}
/*
@@ -526,15 +447,15 @@ Tcl_PopCallFrame(interp)
*/
int
-TclPushStackFrame(interp, framePtrPtr, namespacePtr, isProcCallFrame)
- Tcl_Interp *interp; /* Interpreter in which the new call frame is
+TclPushStackFrame(
+ Tcl_Interp *interp, /* Interpreter in which the new call frame is
* to be pushed. */
- Tcl_CallFrame **framePtrPtr;/* Place to store a pointer to the stack
- * allocated call frame.*/
- Tcl_Namespace *namespacePtr;/* Points to the namespace in which the frame
+ Tcl_CallFrame **framePtrPtr,/* Place to store a pointer to the stack
+ * allocated call frame. */
+ Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame
* will execute. If NULL, the interpreter's
* current namespace will be used. */
- int isProcCallFrame; /* If nonzero, the frame represents a called
+ int isProcCallFrame) /* If nonzero, the frame represents a called
* Tcl procedure and may have local vars. Vars
* will ordinarily be looked up in the frame.
* If new variables are created, they will be
@@ -544,17 +465,19 @@ TclPushStackFrame(interp, framePtrPtr, namespacePtr, isProcCallFrame)
* treated as references to namespace
* variables. */
{
- *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
+ *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame));
return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
isProcCallFrame);
}
void
-TclPopStackFrame(interp)
- Tcl_Interp* interp; /* Interpreter with call frame to pop. */
+TclPopStackFrame(
+ Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
+ CallFrame *freePtr = ((Interp *) interp)->framePtr;
+
Tcl_PopCallFrame(interp);
- TclStackFree(interp);
+ TclStackFree(interp, freePtr);
}
/*
@@ -575,17 +498,17 @@ TclPopStackFrame(interp)
*/
static char *
-EstablishErrorCodeTraces(clientData, interp, name1, name2, flags)
- ClientData clientData;
- Tcl_Interp *interp;
- CONST char *name1;
- CONST char *name2;
- int flags;
+EstablishErrorCodeTraces(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ const char *name1,
+ const char *name2,
+ int flags)
{
- Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
- ErrorCodeRead, (ClientData) NULL);
- Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
- EstablishErrorCodeTraces, (ClientData) NULL);
+ Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
+ ErrorCodeRead, NULL);
+ Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
+ EstablishErrorCodeTraces, NULL);
return NULL;
}
@@ -607,20 +530,27 @@ EstablishErrorCodeTraces(clientData, interp, name1, name2, flags)
*/
static char *
-ErrorCodeRead(clientData, interp, name1, name2, flags)
- ClientData clientData;
- Tcl_Interp *interp;
- CONST char *name1;
- CONST char *name2;
- int flags;
+ErrorCodeRead(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ const char *name1,
+ const char *name2,
+ int flags)
{
- Interp *iPtr = (Interp *)interp;
+ Interp *iPtr = (Interp *) interp;
- if (flags & TCL_INTERP_DESTROYED || iPtr->errorCode == NULL) {
+ if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
+ return NULL;
+ }
+ if (iPtr->errorCode) {
+ Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+ iPtr->errorCode, TCL_GLOBAL_ONLY);
return NULL;
}
- Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode,
- TCL_GLOBAL_ONLY);
+ if (NULL == Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, TCL_GLOBAL_ONLY)) {
+ Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+ Tcl_NewObj(), TCL_GLOBAL_ONLY);
+ }
return NULL;
}
@@ -642,17 +572,17 @@ ErrorCodeRead(clientData, interp, name1, name2, flags)
*/
static char *
-EstablishErrorInfoTraces(clientData, interp, name1, name2, flags)
- ClientData clientData;
- Tcl_Interp *interp;
- CONST char *name1;
- CONST char *name2;
- int flags;
+EstablishErrorInfoTraces(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ const char *name1,
+ const char *name2,
+ int flags)
{
- Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
- ErrorInfoRead, (ClientData) NULL);
- Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
- EstablishErrorInfoTraces, (ClientData) NULL);
+ Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
+ ErrorInfoRead, NULL);
+ Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
+ EstablishErrorInfoTraces, NULL);
return NULL;
}
@@ -674,20 +604,27 @@ EstablishErrorInfoTraces(clientData, interp, name1, name2, flags)
*/
static char *
-ErrorInfoRead(clientData, interp, name1, name2, flags)
- ClientData clientData;
- Tcl_Interp *interp;
- CONST char *name1;
- CONST char *name2;
- int flags;
+ErrorInfoRead(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ const char *name1,
+ const char *name2,
+ int flags)
{
- Interp *iPtr = (Interp *)interp;
+ Interp *iPtr = (Interp *) interp;
- if (flags & TCL_INTERP_DESTROYED || iPtr->errorInfo == NULL) {
+ if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
+ return NULL;
+ }
+ if (iPtr->errorInfo) {
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+ iPtr->errorInfo, TCL_GLOBAL_ONLY);
return NULL;
}
- Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
- TCL_GLOBAL_ONLY);
+ if (NULL == Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY)) {
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+ Tcl_NewObj(), TCL_GLOBAL_ONLY);
+ }
return NULL;
}
@@ -713,15 +650,15 @@ ErrorInfoRead(clientData, interp, name1, name2, flags)
*/
Tcl_Namespace *
-Tcl_CreateNamespace(interp, name, clientData, deleteProc)
- Tcl_Interp *interp; /* Interpreter in which a new namespace is
+Tcl_CreateNamespace(
+ Tcl_Interp *interp, /* Interpreter in which a new namespace is
* being created. Also used for error
* reporting. */
- CONST char *name; /* Name for the new namespace. May be a
+ const char *name, /* Name for the new namespace. May be a
* qualified name with names of ancestor
* namespaces separated by "::"s. */
- ClientData clientData; /* One-word value to store with namespace. */
- Tcl_NamespaceDeleteProc *deleteProc;
+ ClientData clientData, /* One-word value to store with namespace. */
+ Tcl_NamespaceDeleteProc *deleteProc)
/* Function called to delete client data when
* the namespace is deleted. NULL if no
* function should be called. */
@@ -730,11 +667,16 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
register Namespace *nsPtr, *ancestorPtr;
Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
- CONST char *simpleName;
+ const char *simpleName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer1, buffer2;
- int newEntry;
+ Tcl_DString *namePtr, *buffPtr;
+ int newEntry, nameLen;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ const char *nameStr;
+ Tcl_DString tmpBuffer;
+
+ Tcl_DStringInit(&tmpBuffer);
/*
* If there is no active namespace, the interpreter is being initialized.
@@ -748,40 +690,78 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
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);
+ goto doCreate;
+ }
+
+ /*
+ * Ensure that there are no trailing colons as that causes chaos when a
+ * deleteProc is specified. [Bug d614d63989]
+ */
+
+ if (deleteProc != NULL) {
+ nameStr = name + strlen(name) - 2;
+ if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') {
+ Tcl_DStringAppend(&tmpBuffer, name, -1);
+ while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0
+ && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') {
+ Tcl_DStringSetLength(&tmpBuffer, nameLen-1);
+ }
+ name = Tcl_DStringValue(&tmpBuffer);
+ }
+ }
+
+ /*
+ * If we've ended up with an empty string now, we're attempting to create
+ * the global namespace despite the global namespace existing. That's
+ * naughty!
+ */
+
+ if (*name == '\0') {
+ 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);
+ Tcl_DStringFree(&tmpBuffer);
return NULL;
- } else {
- /*
- * Find the parent for the new namespace.
- */
+ }
- TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- /*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
- &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
+ /*
+ * Find the parent for the new namespace.
+ */
- /*
- * If the unqualified name at the end is empty, there were trailing
- * "::"s after the namespace's name which we ignore. The new namespace
- * was already (recursively) created and is pointed to by parentPtr.
- */
+ TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
+ &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
- if (*simpleName == '\0') {
- return (Tcl_Namespace *) parentPtr;
- }
+ /*
+ * If the unqualified name at the end is empty, there were trailing "::"s
+ * after the namespace's name which we ignore. The new namespace was
+ * already (recursively) created and is pointed to by parentPtr.
+ */
- /*
- * Check for a bad namespace name and make sure that the name does not
- * already exist in the parent namespace.
- */
+ if (*simpleName == '\0') {
+ Tcl_DStringFree(&tmpBuffer);
+ return (Tcl_Namespace *) parentPtr;
+ }
- if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
- Tcl_AppendResult(interp, "can't create namespace \"", name,
- "\": already exists", (char *) NULL);
- return NULL;
- }
+ /*
+ * Check for a bad namespace name and make sure that the name does not
+ * already exist in the parent namespace.
+ */
+
+ if (
+#ifndef BREAK_NAMESPACE_COMPAT
+ Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
+#else
+ parentPtr->childTablePtr != NULL &&
+ Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
+#endif
+ ) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create namespace \"%s\": already exists", name));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+ "CREATEEXISTING", NULL);
+ Tcl_DStringFree(&tmpBuffer);
+ return NULL;
}
/*
@@ -789,21 +769,27 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* of namespaces created.
*/
- nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
- nsPtr->name = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
- strcpy(nsPtr->name, simpleName);
- nsPtr->fullName = NULL; /* set below */
+ doCreate:
+ 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;
nsPtr->parentPtr = parentPtr;
+#ifndef BREAK_NAMESPACE_COMPAT
Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+#else
+ nsPtr->childTablePtr = NULL;
+#endif
nsPtr->nsId = ++(tsdPtr->numNsCreated);
nsPtr->interp = interp;
nsPtr->flags = 0;
nsPtr->activationCount = 0;
nsPtr->refCount = 0;
Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
- Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+ TclInitVarHashTable(&nsPtr->varTable, nsPtr);
nsPtr->exportArrayPtr = NULL;
nsPtr->numExportPatterns = 0;
nsPtr->maxExportPatterns = 0;
@@ -814,14 +800,17 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
nsPtr->compiledVarResProc = NULL;
nsPtr->exportLookupEpoch = 0;
nsPtr->ensembles = NULL;
+ nsPtr->unknownHandlerPtr = NULL;
nsPtr->commandPathLength = 0;
nsPtr->commandPathArray = NULL;
nsPtr->commandPathSourceList = NULL;
+ nsPtr->earlyDeleteProc = NULL;
if (parentPtr != NULL) {
- entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
- &newEntry);
- Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+ entryPtr = Tcl_CreateHashEntry(
+ TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr),
+ simpleName, &newEntry);
+ Tcl_SetHashValue(entryPtr, nsPtr);
} else {
/*
* In the global namespace create traces to maintain the ::errorInfo
@@ -839,25 +828,54 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
Tcl_DStringInit(&buffer1);
Tcl_DStringInit(&buffer2);
- for (ancestorPtr = nsPtr; ancestorPtr != NULL;
+ namePtr = &buffer1;
+ buffPtr = &buffer2;
+ for (ancestorPtr = nsPtr; ancestorPtr != NULL;
ancestorPtr = ancestorPtr->parentPtr) {
if (ancestorPtr != globalNsPtr) {
- Tcl_DStringAppend(&buffer1, "::", 2);
- Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
- }
- Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
+ register Tcl_DString *tempPtr = namePtr;
+
+ TclDStringAppendLiteral(buffPtr, "::");
+ Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
+ TclDStringAppendDString(buffPtr, namePtr);
+
+ /*
+ * Clear the unwanted buffer or we end up appending to previous
+ * results, making the namespace fullNames of nested namespaces
+ * very wrong (and strange).
+ */
+
+ TclDStringClear(namePtr);
- Tcl_DStringSetLength(&buffer2, 0);
- Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
- Tcl_DStringSetLength(&buffer1, 0);
+ /*
+ * Now swap the buffer pointers so that we build in the other
+ * buffer. This is faster than repeated copying back and forth
+ * between buffers.
+ */
+
+ namePtr = buffPtr;
+ buffPtr = tempPtr;
+ }
}
- name = Tcl_DStringValue(&buffer2);
- nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
- strcpy(nsPtr->fullName, name);
+ name = Tcl_DStringValue(namePtr);
+ nameLen = Tcl_DStringLength(namePtr);
+ nsPtr->fullName = ckalloc(nameLen + 1);
+ memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
Tcl_DStringFree(&buffer1);
Tcl_DStringFree(&buffer2);
+ Tcl_DStringFree(&tmpBuffer);
+
+ /*
+ * If compilation of commands originating from the parent NS is
+ * suppressed, suppress it for commands originating in this one too.
+ */
+
+ if (nsPtr->parentPtr != NULL &&
+ nsPtr->parentPtr->flags & NS_SUPPRESS_COMPILATION) {
+ nsPtr->flags |= NS_SUPPRESS_COMPILATION;
+ }
/*
* Return a pointer to the new namespace.
@@ -886,14 +904,58 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
*/
void
-Tcl_DeleteNamespace(namespacePtr)
- Tcl_Namespace *namespacePtr; /* Points to the namespace to delete */
+Tcl_DeleteNamespace(
+ Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{
register Namespace *nsPtr = (Namespace *) namespacePtr;
Interp *iPtr = (Interp *) nsPtr->interp;
- Namespace *globalNsPtr =
- (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+ Namespace *globalNsPtr = (Namespace *)
+ TclGetGlobalNamespace((Tcl_Interp *) iPtr);
Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ Command *cmdPtr;
+
+ /*
+ * Give anyone interested - notably TclOO - a chance to use this namespace
+ * normally despite the fact that the namespace is going to go. Allows the
+ * calling of destructors. Will only be called once (unless re-established
+ * by the called function). [Bug 2950259]
+ *
+ * Note that setting this field requires access to the internal definition
+ * of namespaces, so it should only be accessed by code that knows about
+ * being careful with reentrancy.
+ */
+
+ if (nsPtr->earlyDeleteProc != NULL) {
+ Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;
+
+ nsPtr->earlyDeleteProc = NULL;
+ nsPtr->activationCount++;
+ earlyDeleteProc(nsPtr->clientData);
+ nsPtr->activationCount--;
+ }
+
+ /*
+ * Delete all coroutine commands now: break the circular ref cycle between
+ * the namespace and the coroutine command [Bug 2724403]. This code is
+ * essentially duplicated in TclTeardownNamespace() for all other
+ * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
+ *
+ * NOTE: we could avoid traversing the ns's command list by keeping a
+ * separate list of coros.
+ */
+
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ entryPtr != NULL;) {
+ cmdPtr = Tcl_GetHashValue(entryPtr);
+ if (cmdPtr->nreProc == TclNRInterpCoroutine) {
+ Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+ (Tcl_Command) cmdPtr);
+ entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ } else {
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ }
/*
* If the namespace has associated ensemble commands, delete them first.
@@ -915,6 +977,16 @@ Tcl_DeleteNamespace(namespacePtr)
}
/*
+ * If the namespace has a registered unknown handler (TIP 181), then free
+ * it here.
+ */
+
+ if (nsPtr->unknownHandlerPtr != NULL) {
+ Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
+ nsPtr->unknownHandlerPtr = NULL;
+ }
+
+ /*
* If the namespace is on the call frame stack, it is marked as "dying"
* (NS_DYING is OR'd into its flags): the namespace can't be looked up by
* name but its commands and variables are still usable by those active
@@ -931,23 +1003,28 @@ Tcl_DeleteNamespace(namespacePtr)
* refCount reaches 0.
*/
- if (nsPtr->activationCount > 0) {
+ if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
nsPtr->flags |= NS_DYING;
if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
- nsPtr->name);
+ entryPtr = Tcl_FindHashEntry(
+ TclGetNamespaceChildTable((Tcl_Namespace *)
+ nsPtr->parentPtr), nsPtr->name);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
}
nsPtr->parentPtr = NULL;
- } else {
+ } else if (!(nsPtr->flags & NS_KILLED)) {
/*
* Delete the namespace and everything in it. If this is the global
* namespace, then clear it but don't free its storage unless the
- * interpreter is being torn down.
+ * interpreter is being torn down. Set the NS_KILLED flag to avoid
+ * recursive calls here - if the namespace is really in the process of
+ * being deleted, ignore any second call.
*/
+ nsPtr->flags |= (NS_DYING|NS_KILLED);
+
TclTeardownNamespace(nsPtr);
if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
@@ -958,9 +1035,16 @@ Tcl_DeleteNamespace(namespacePtr)
* one last time.
*/
- TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+ TclDeleteNamespaceVars(nsPtr);
+#ifndef BREAK_NAMESPACE_COMPAT
Tcl_DeleteHashTable(&nsPtr->childTable);
+#else
+ if (nsPtr->childTablePtr != NULL) {
+ Tcl_DeleteHashTable(nsPtr->childTablePtr);
+ ckfree(nsPtr->childTablePtr);
+ }
+#endif
Tcl_DeleteHashTable(&nsPtr->cmdTable);
/*
@@ -980,6 +1064,13 @@ Tcl_DeleteNamespace(namespacePtr)
EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+
+ /*
+ * We didn't really kill it, so remove the KILLED marks, so it can
+ * get killed later, avoiding mem leaks.
+ */
+
+ nsPtr->flags &= ~(NS_DYING|NS_KILLED);
}
}
}
@@ -1007,8 +1098,8 @@ Tcl_DeleteNamespace(namespacePtr)
*/
void
-TclTeardownNamespace(nsPtr)
- register Namespace *nsPtr; /* Points to the namespace to be dismantled
+TclTeardownNamespace(
+ register Namespace *nsPtr) /* Points to the namespace to be dismantled
* and unlinked from its parent. */
{
Interp *iPtr = (Interp *) nsPtr->interp;
@@ -1021,11 +1112,11 @@ TclTeardownNamespace(nsPtr)
/*
* Start by destroying the namespace's variable table, since variables
* might trigger traces. Variable table should be cleared but not freed!
- * TclDeleteVars frees it, so we reinitialize it afterwards.
+ * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
*/
- TclDeleteVars(iPtr, &nsPtr->varTable);
- Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+ TclDeleteNamespaceVars(nsPtr);
+ TclInitVarHashTable(&nsPtr->varTable, nsPtr);
/*
* Delete all commands in this namespace. Be careful when traversing the
@@ -1038,7 +1129,7 @@ TclTeardownNamespace(nsPtr)
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
- cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+ cmd = Tcl_GetHashValue(entryPtr);
Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
}
Tcl_DeleteHashTable(&nsPtr->cmdTable);
@@ -1049,8 +1140,9 @@ TclTeardownNamespace(nsPtr)
*/
if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
- nsPtr->name);
+ entryPtr = Tcl_FindHashEntry(
+ TclGetNamespaceChildTable((Tcl_Namespace *)
+ nsPtr->parentPtr), nsPtr->name);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
@@ -1067,29 +1159,44 @@ TclTeardownNamespace(nsPtr)
}
if (nsPtr->commandPathSourceList != NULL) {
NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+
do {
+ if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
+ nsPathPtr->creatorNsPtr->cmdRefEpoch++;
+ }
nsPathPtr->nsPtr = NULL;
nsPathPtr = nsPathPtr->nextPtr;
} while (nsPathPtr != NULL);
+ nsPtr->commandPathSourceList = NULL;
}
/*
* Delete all the child namespaces.
*
* BE CAREFUL: When each child is deleted, it will divorce itself from its
- * parent. You can't traverse a hash table properly if its elements are
- * being deleted. We use only the Tcl_FirstHashEntry function to be
- * safe.
+ * parent. You can't traverse a hash table properly if its elements are
+ * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
*
* Don't optimize to Tcl_NextHashEntry() because of traces.
*/
+#ifndef BREAK_NAMESPACE_COMPAT
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
entryPtr != NULL;
entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
- childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
+ childNsPtr = Tcl_GetHashValue(entryPtr);
Tcl_DeleteNamespace(childNsPtr);
}
+#else
+ if (nsPtr->childTablePtr != NULL) {
+ for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
+ childNsPtr = Tcl_GetHashValue(entryPtr);
+ Tcl_DeleteNamespace(childNsPtr);
+ }
+ }
+#endif
/*
* Free the namespace's export pattern array.
@@ -1099,7 +1206,7 @@ TclTeardownNamespace(nsPtr)
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;
@@ -1110,7 +1217,7 @@ TclTeardownNamespace(nsPtr)
*/
if (nsPtr->deleteProc != NULL) {
- (*nsPtr->deleteProc)(nsPtr->clientData);
+ nsPtr->deleteProc(nsPtr->clientData);
}
nsPtr->deleteProc = NULL;
nsPtr->clientData = NULL;
@@ -1142,8 +1249,8 @@ TclTeardownNamespace(nsPtr)
*/
static void
-NamespaceFree(nsPtr)
- register Namespace *nsPtr; /* Points to the namespace to free. */
+NamespaceFree(
+ register Namespace *nsPtr) /* Points to the namespace to free. */
{
/*
* Most of the namespace's contents are freed when the namespace is
@@ -1153,8 +1260,34 @@ NamespaceFree(nsPtr)
ckfree(nsPtr->name);
ckfree(nsPtr->fullName);
+ ckfree(nsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNsDecrRefCount --
+ *
+ * Drops a reference to a namespace and frees it if the namespace has
+ * been deleted and the last reference has just been dropped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- ckfree((char *) nsPtr);
+void
+TclNsDecrRefCount(
+ Namespace *nsPtr)
+{
+ nsPtr->refCount--;
+ if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+ NamespaceFree(nsPtr);
+ }
}
/*
@@ -1180,22 +1313,22 @@ NamespaceFree(nsPtr)
*/
int
-Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Namespace *namespacePtr;/* Points to the namespace from which commands
+Tcl_Export(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Namespace *namespacePtr,/* Points to the namespace from which commands
* are to be exported. NULL for the current
* namespace. */
- CONST char *pattern; /* String pattern indicating which commands to
+ const char *pattern, /* String pattern indicating which commands to
* export. This pattern may not include any
* namespace qualifiers; only commands in the
* specified namespace may be exported. */
- int resetListFirst; /* If nonzero, resets the namespace's export
+ int resetListFirst) /* If nonzero, resets the namespace's export
* list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- CONST char *simplePattern;
+ Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ const char *simplePattern;
char *patternCpy;
int neededElems, len, i;
@@ -1219,7 +1352,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
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;
@@ -1231,13 +1364,13 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
* Check that the pattern doesn't have namespace qualifiers.
*/
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
- Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
- "\": pattern can't specify a namespace", (char *) 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;
}
@@ -1249,8 +1382,9 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
for (i = 0; i < nsPtr->numExportPatterns; i++) {
if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
/*
- * The pattern already exists in the list
+ * The pattern already exists in the list.
*/
+
return TCL_OK;
}
}
@@ -1262,21 +1396,11 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
*/
neededElems = nsPtr->numExportPatterns + 1;
- if (nsPtr->exportArrayPtr == NULL) {
- nsPtr->exportArrayPtr = (char **)
- ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
- nsPtr->numExportPatterns = 0;
- nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
- } else if (neededElems > nsPtr->maxExportPatterns) {
- int numNewElems = 2 * nsPtr->maxExportPatterns;
- size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
- size_t newBytes = numNewElems * sizeof(char *);
- char **newPtr = (char **) ckalloc((unsigned) newBytes);
-
- memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr, currBytes);
- ckfree((char *) nsPtr->exportArrayPtr);
- nsPtr->exportArrayPtr = (char **) newPtr;
- nsPtr->maxExportPatterns = numNewElems;
+ if (neededElems > nsPtr->maxExportPatterns) {
+ nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
+ 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
+ nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
+ sizeof(char *) * nsPtr->maxExportPatterns);
}
/*
@@ -1284,8 +1408,8 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
*/
len = strlen(pattern);
- patternCpy = (char *) ckalloc((unsigned) (len + 1));
- strcpy(patternCpy, pattern);
+ patternCpy = ckalloc(len + 1);
+ memcpy(patternCpy, pattern, (unsigned) len + 1);
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
nsPtr->numExportPatterns++;
@@ -1324,12 +1448,12 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
*/
int
-Tcl_AppendExportList(interp, namespacePtr, objPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- Tcl_Namespace *namespacePtr;/* Points to the namespace whose export
+Tcl_AppendExportList(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
* pattern list is appended onto objPtr. NULL
* for the current namespace. */
- Tcl_Obj *objPtr; /* Points to the Tcl object onto which the
+ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the
* export pattern list is appended. */
{
Namespace *nsPtr;
@@ -1340,7 +1464,7 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
}
@@ -1386,22 +1510,22 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
*/
int
-Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Namespace *namespacePtr;/* Points to the namespace into which the
+Tcl_Import(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Namespace *namespacePtr,/* Points to the namespace into which the
* commands are to be imported. NULL for the
* current namespace. */
- CONST char *pattern; /* String pattern indicating which commands to
+ const char *pattern, /* String pattern indicating which commands to
* import. This pattern should be qualified by
* the name of the namespace from which to
* import the command(s). */
- int allowOverwrite; /* If nonzero, allow existing commands to be
+ int allowOverwrite) /* If nonzero, allow existing commands to be
* overwritten by imported commands. If 0,
* return an error if an imported cmd
* conflicts with an existing one. */
{
Namespace *nsPtr, *importNsPtr, *dummyPtr;
- CONST char *simplePattern;
+ const char *simplePattern;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
@@ -1410,7 +1534,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
}
@@ -1429,7 +1553,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
Tcl_Obj *objv[2];
int result;
- objv[0] = Tcl_NewStringObj("auto_import", -1);
+ TclNewLiteralStringObj(objv[0], "auto_import");
objv[1] = Tcl_NewStringObj(pattern, -1);
Tcl_IncrRefCount(objv[0]);
@@ -1450,27 +1574,30 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
if (strlen(pattern) == 0) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
return TCL_ERROR;
}
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
- pattern, "\"", (char *) 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,
- "\"", (char *) 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", (char *) 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;
}
@@ -1493,6 +1620,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+
if (Tcl_StringMatch(cmdName, simplePattern) &&
DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr,
allowOverwrite) == TCL_ERROR) {
@@ -1522,14 +1650,14 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
static int
-DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
- Tcl_Interp *interp;
- Namespace *nsPtr;
- Tcl_HashEntry *hPtr;
- CONST char *cmdName;
- CONST char *pattern;
- Namespace *importNsPtr;
- int allowOverwrite;
+DoImport(
+ Tcl_Interp *interp,
+ Namespace *nsPtr,
+ Tcl_HashEntry *hPtr,
+ const char *cmdName,
+ const char *pattern,
+ Namespace *importNsPtr,
+ int allowOverwrite)
{
int i = 0, exported = 0;
Tcl_HashEntry *found;
@@ -1540,7 +1668,8 @@ DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
*/
while (!exported && (i < importNsPtr->numExportPatterns)) {
- exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);
+ exported |= Tcl_StringMatch(cmdName,
+ importNsPtr->exportArrayPtr[i++]);
}
if (!exported) {
return TCL_OK;
@@ -1568,7 +1697,7 @@ DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
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);
@@ -1577,29 +1706,30 @@ DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
* namespace would create a cycle of imported command references.
*/
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ cmdPtr = Tcl_GetHashValue(hPtr);
if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
- Command *overwrite = (Command *) Tcl_GetHashValue(found);
- Command *link = cmdPtr;
-
- while (link->deleteProc == DeleteImportedCmd) {
- ImportedCmdData *dataPtr;
-
- dataPtr = (ImportedCmdData *) link->objClientData;
- link = dataPtr->realCmdPtr;
- if (overwrite == link) {
- Tcl_AppendResult(interp, "import pattern \"", pattern,
- "\" would create a loop containing command \"",
- Tcl_DStringValue(&ds), "\"", (char *) NULL);
+ Command *overwrite = Tcl_GetHashValue(found);
+ Command *linkCmd = cmdPtr;
+
+ while (linkCmd->deleteProc == DeleteImportedCmd) {
+ dataPtr = linkCmd->objClientData;
+ linkCmd = dataPtr->realCmdPtr;
+ if (overwrite == linkCmd) {
+ 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));
- importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
- InvokeImportedCmd, (ClientData) dataPtr, DeleteImportedCmd);
+ dataPtr = ckalloc(sizeof(ImportedCmdData));
+ importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
+ InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
+ DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
@@ -1610,23 +1740,27 @@ DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
* 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;
} else {
- Command *overwrite = (Command *) Tcl_GetHashValue(found);
+ Command *overwrite = Tcl_GetHashValue(found);
if (overwrite->deleteProc == DeleteImportedCmd) {
- ImportedCmdData *dataPtr = (ImportedCmdData *)
- overwrite->objClientData;
- if (dataPtr->realCmdPtr == (Command *) Tcl_GetHashValue(hPtr)) {
- /* Repeated import of same command -- acceptable */
+ ImportedCmdData *dataPtr = overwrite->objClientData;
+
+ if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
+ /*
+ * Repeated import of same command is acceptable.
+ */
+
return TCL_OK;
}
}
- Tcl_AppendResult(interp, "can't import command \"", cmdName,
- "\": already exists", (char *) 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;
@@ -1660,16 +1794,16 @@ DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
*/
int
-Tcl_ForgetImport(interp, namespacePtr, pattern)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Namespace *namespacePtr;/* Points to the namespace from which
+Tcl_ForgetImport(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Namespace *namespacePtr,/* Points to the namespace from which
* previously imported commands should be
* removed. NULL for current namespace. */
- CONST char *pattern; /* String pattern indicating which imported
+ const char *pattern) /* String pattern indicating which imported
* commands to remove. */
{
Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
- CONST char *simplePattern;
+ const char *simplePattern;
char *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
@@ -1679,7 +1813,7 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
if (namespacePtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
} else {
nsPtr = (Namespace *) namespacePtr;
}
@@ -1689,14 +1823,14 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
* simple pattern.
*/
- TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
- Tcl_AppendResult(interp,
- "unknown namespace in namespace forget pattern \"",
- pattern, "\"", (char *) 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;
}
@@ -1706,18 +1840,20 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
if (TclMatchIsTrivial(simplePattern)) {
- Command *cmdPtr;
hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
- if ((hPtr != NULL)
- && (cmdPtr = (Command *) Tcl_GetHashValue(hPtr))
- && (cmdPtr->deleteProc == DeleteImportedCmd)) {
- Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+ if (hPtr != NULL) {
+ Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
+ if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) {
+ Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+ }
}
return TCL_OK;
}
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
- Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
if (cmdPtr->deleteProc != DeleteImportedCmd) {
continue;
}
@@ -1736,11 +1872,11 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);
hPtr = Tcl_NextHashEntry(&search)) {
Tcl_CmdInfo info;
- Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr);
+ Tcl_Command token = Tcl_GetHashValue(hPtr);
Tcl_Command origin = TclGetOriginalCommand(token);
if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {
- continue; /* Not an imported command */
+ continue; /* Not an imported command. */
}
if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
/*
@@ -1749,9 +1885,9 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
Command *cmdPtr = (Command *) token;
- ImportedCmdData *dataPtr =
- (ImportedCmdData *) cmdPtr->objClientData;
+ ImportedCmdData *dataPtr = cmdPtr->objClientData;
Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
+
if (firstToken == origin) {
continue;
}
@@ -1761,7 +1897,7 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
}
origin = firstToken;
}
- if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) {
+ if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){
Tcl_DeleteCommandFromToken(interp, token);
}
}
@@ -1792,19 +1928,19 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
Tcl_Command
-TclGetOriginalCommand(command)
- Tcl_Command command; /* The imported command for which the original
+TclGetOriginalCommand(
+ Tcl_Command command) /* The imported command for which the original
* command should be returned. */
{
register Command *cmdPtr = (Command *) command;
ImportedCmdData *dataPtr;
if (cmdPtr->deleteProc != DeleteImportedCmd) {
- return (Tcl_Command) NULL;
+ return NULL;
}
while (cmdPtr->deleteProc == DeleteImportedCmd) {
- dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
+ dataPtr = cmdPtr->objClientData;
cmdPtr = dataPtr->realCmdPtr;
}
return (Tcl_Command) cmdPtr;
@@ -1830,17 +1966,29 @@ TclGetOriginalCommand(command)
*/
static int
-InvokeImportedCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Points to the imported command's
+InvokeImportedNRCmd(
+ ClientData clientData, /* Points to the imported command's
* ImportedCmdData structure. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
- register Command *realCmdPtr = dataPtr->realCmdPtr;
+ ImportedCmdData *dataPtr = clientData;
+ Command *realCmdPtr = dataPtr->realCmdPtr;
- return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+ TclSkipTailcall(interp);
+ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
+}
+
+static int
+InvokeImportedCmd(
+ ClientData clientData, /* Points to the imported command's
+ * ImportedCmdData structure. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
objc, objv);
}
@@ -1866,11 +2014,11 @@ InvokeImportedCmd(clientData, interp, objc, objv)
*/
static void
-DeleteImportedCmd(clientData)
- ClientData clientData; /* Points to the imported command's
+DeleteImportedCmd(
+ ClientData clientData) /* Points to the imported command's
* ImportedCmdData structure. */
{
- ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+ ImportedCmdData *dataPtr = clientData;
Command *realCmdPtr = dataPtr->realCmdPtr;
Command *selfPtr = dataPtr->selfPtr;
register ImportRef *refPtr, *prevPtr;
@@ -1884,13 +2032,13 @@ DeleteImportedCmd(clientData)
* that refer to it.
*/
- if (prevPtr == NULL) { /* refPtr is first in list */
+ if (prevPtr == NULL) { /* refPtr is first in list. */
realCmdPtr->importRefPtr = refPtr->nextPtr;
} else {
prevPtr->nextPtr = refPtr->nextPtr;
}
- ckfree((char *) refPtr);
- ckfree((char *) dataPtr);
+ ckfree(refPtr);
+ ckfree(dataPtr);
return;
}
prevPtr = refPtr;
@@ -1978,40 +2126,39 @@ DeleteImportedCmd(clientData)
*/
int
-TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
- nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
- Tcl_Interp *interp; /* Interpreter in which to find the namespace
+TclGetNamespaceForQualName(
+ Tcl_Interp *interp, /* Interpreter in which to find the namespace
* containing qualName. */
- CONST char *qualName; /* A namespace-qualified name of an command,
+ const char *qualName, /* A namespace-qualified name of an command,
* variable, or namespace. */
- Namespace *cxtNsPtr; /* The namespace in which to start the search
+ Namespace *cxtNsPtr, /* The namespace in which to start the search
* for qualName's namespace. If NULL start
* from the current namespace. Ignored if
* TCL_GLOBAL_ONLY is set. */
- int flags; /* Flags controlling the search: an OR'd
+ int flags, /* Flags controlling the search: an OR'd
* combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS, and
* TCL_CREATE_NS_IF_UNKNOWN. */
- Namespace **nsPtrPtr; /* Address where function stores a pointer to
+ Namespace **nsPtrPtr, /* Address where function stores a pointer to
* containing namespace if qualName is found
* starting from *cxtNsPtr or, if
* TCL_GLOBAL_ONLY is set, if qualName is
* found in the global :: namespace. NULL is
* stored otherwise. */
- Namespace **altNsPtrPtr; /* Address where function stores a pointer to
+ Namespace **altNsPtrPtr, /* Address where function stores a pointer to
* containing namespace if qualName is found
* starting from the global :: namespace.
* NULL is stored if qualName isn't found
* starting from :: or if the TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS,
* TCL_CREATE_NS_IF_UNKNOWN flag is set. */
- Namespace **actualCxtPtrPtr;/* Address where function stores a pointer to
+ Namespace **actualCxtPtrPtr,/* Address where function stores a pointer to
* the actual namespace from which the search
* started. This is either cxtNsPtr, the ::
* namespace if TCL_GLOBAL_ONLY was specified,
* or the current namespace if cxtNsPtr was
* NULL. */
- CONST char **simpleNamePtr; /* Address where function stores the simple
+ const char **simpleNamePtr) /* Address where function stores the simple
* name at end of the qualName, or NULL if
* qualName is "::" or the flag
* TCL_FIND_ONLY_NS was specified. */
@@ -2020,8 +2167,8 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
Namespace *nsPtr = cxtNsPtr;
Namespace *altNsPtr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
- CONST char *start, *end;
- CONST char *nsName;
+ const char *start, *end;
+ const char *nsName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer;
int len;
@@ -2038,25 +2185,23 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
if (flags & TCL_GLOBAL_ONLY) {
nsPtr = globalNsPtr;
} else if (nsPtr == NULL) {
- if (iPtr->varFramePtr != NULL) {
- nsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- nsPtr = iPtr->globalNsPtr;
- }
+ nsPtr = iPtr->varFramePtr->nsPtr;
}
- start = qualName; /* pts to start of qualifying namespace */
+ start = qualName; /* Points to start of qualifying
+ * namespace. */
if ((*qualName == ':') && (*(qualName+1) == ':')) {
- start = qualName+2; /* skip over the initial :: */
+ start = qualName+2; /* Skip over the initial :: */
while (*start == ':') {
- start++; /* skip over a subsequent : */
+ start++; /* Skip over a subsequent : */
}
nsPtr = globalNsPtr;
- if (*start == '\0') { /* qualName is just two or more ":"s */
+ if (*start == '\0') { /* qualName is just two or more
+ * ":"s. */
*nsPtrPtr = globalNsPtr;
*altNsPtrPtr = NULL;
*actualCxtPtrPtr = globalNsPtr;
- *simpleNamePtr = start; /* points to empty string */
+ *simpleNamePtr = start; /* Points to empty string. */
return TCL_OK;
}
}
@@ -2092,11 +2237,11 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
len = 0;
for (end = start; *end != '\0'; end++) {
if ((*end == ':') && (*(end+1) == ':')) {
- end += 2; /* skip over the initial :: */
+ end += 2; /* Skip over the initial :: */
while (*end == ':') {
- end++; /* skip over the subsequent : */
+ end++; /* Skip over the subsequent : */
}
- break; /* exit for loop; end is after ::'s */
+ break; /* Exit for loop; end is after ::'s */
}
len++;
}
@@ -2126,7 +2271,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
* qualName since it may be a string constant.
*/
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
Tcl_DStringAppend(&buffer, start, len);
nsName = Tcl_DStringValue(&buffer);
}
@@ -2139,23 +2284,32 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*/
if (nsPtr != NULL) {
+#ifndef BREAK_NAMESPACE_COMPAT
entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+#else
+ if (nsPtr->childTablePtr == NULL) {
+ entryPtr = NULL;
+ } else {
+ entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
+ }
+#endif
if (entryPtr != NULL) {
- nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+ nsPtr = Tcl_GetHashValue(entryPtr);
} else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
Tcl_CallFrame *framePtr;
(void) TclPushStackFrame(interp, &framePtr,
(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
- nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
- (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+ nsPtr = (Namespace *)
+ Tcl_CreateNamespace(interp, nsName, NULL, NULL);
TclPopStackFrame(interp);
if (nsPtr == NULL) {
Tcl_Panic("Could not create namespace '%s'", nsName);
}
- } else { /* namespace not found and wasn't created */
+ } else { /* Namespace not found and was not
+ * created. */
nsPtr = NULL;
}
}
@@ -2165,9 +2319,17 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*/
if (altNsPtr != NULL) {
+#ifndef BREAK_NAMESPACE_COMPAT
entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
+#else
+ if (altNsPtr->childTablePtr != NULL) {
+ entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
+ } else {
+ entryPtr = NULL;
+ }
+#endif
if (entryPtr != NULL) {
- altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+ altNsPtr = Tcl_GetHashValue(entryPtr);
} else {
altNsPtr = NULL;
}
@@ -2194,9 +2356,10 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*/
if ((flags & TCL_FIND_ONLY_NS) || (end>start && *(end-1)!=':')) {
- *simpleNamePtr = NULL; /* found namespace name */
+ *simpleNamePtr = NULL; /* Found namespace name. */
} else {
- *simpleNamePtr = end; /* found cmd/var: points to empty string */
+ *simpleNamePtr = end; /* Found cmd/var: points to empty
+ * string. */
}
/*
@@ -2236,25 +2399,25 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*/
Tcl_Namespace *
-Tcl_FindNamespace(interp, name, contextNsPtr, flags)
- Tcl_Interp *interp; /* The interpreter in which to find the
+Tcl_FindNamespace(
+ Tcl_Interp *interp, /* The interpreter in which to find the
* namespace. */
- CONST char *name; /* Namespace name. If it starts with "::",
+ const char *name, /* Namespace name. If it starts with "::",
* will be looked up in global namespace.
* Else, looked up first in contextNsPtr
* (current namespace if contextNsPtr is
* NULL), then in global namespace. */
- Tcl_Namespace *contextNsPtr;/* Ignored if TCL_GLOBAL_ONLY flag is set or
+ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or
* if the name starts with "::". Otherwise,
* points to namespace in which to resolve
* name; if NULL, look up name in the current
* namespace. */
- register int flags; /* Flags controlling namespace lookup: an OR'd
+ register int flags) /* Flags controlling namespace lookup: an OR'd
* combination of TCL_GLOBAL_ONLY and
* TCL_LEAVE_ERR_MSG flags. */
{
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
- CONST char *dummy;
+ const char *dummy;
/*
* Find the namespace(s) that contain the specified namespace name. Add
@@ -2267,10 +2430,12 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
if (nsPtr != NULL) {
return (Tcl_Namespace *) nsPtr;
- } else if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown namespace \"", name, "\"",
- (char *) NULL);
+ }
+
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
}
return NULL;
}
@@ -2295,19 +2460,19 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
*/
Tcl_Command
-Tcl_FindCommand(interp, name, contextNsPtr, flags)
- Tcl_Interp *interp; /* The interpreter in which to find the
+Tcl_FindCommand(
+ Tcl_Interp *interp, /* The interpreter in which to find the
* command and to report errors. */
- CONST char *name; /* Command's name. If it starts with "::",
+ const char *name, /* Command's name. If it starts with "::",
* will be looked up in global namespace.
* Else, looked up first in contextNsPtr
* (current namespace if contextNsPtr is
* NULL), then in global namespace. */
- Tcl_Namespace *contextNsPtr;/* Ignored if TCL_GLOBAL_ONLY flag set.
+ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
* Otherwise, points to namespace in which to
* resolve name. If NULL, look up name in the
* current namespace. */
- int flags; /* An OR'd combination of flags:
+ int flags) /* An OR'd combination of flags:
* TCL_GLOBAL_ONLY (look up name only in
* global namespace), TCL_NAMESPACE_ONLY (look
* up only in contextNsPtr, or the current
@@ -2316,11 +2481,11 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
* and TCL_NAMESPACE_ONLY are given,
* TCL_GLOBAL_ONLY is ignored. */
{
- Interp *iPtr = (Interp*)interp;
+ Interp *iPtr = (Interp *) interp;
Namespace *cxtNsPtr;
register Tcl_HashEntry *entryPtr;
register Command *cmdPtr;
- CONST char *simpleName;
+ const char *simpleName;
int result;
/*
@@ -2331,12 +2496,12 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
* signal an error.
*/
- if (flags & TCL_GLOBAL_ONLY) {
- cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ if ((flags & TCL_GLOBAL_ONLY) || !strncmp(name, "::", 2)) {
+ cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
} else if (contextNsPtr != NULL) {
cxtNsPtr = (Namespace *) contextNsPtr;
} else {
- cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
@@ -2344,7 +2509,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
Tcl_Command cmd;
if (cxtNsPtr->cmdResProc) {
- result = (*cxtNsPtr->cmdResProc)(interp, name,
+ result = cxtNsPtr->cmdResProc(interp, name,
(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
} else {
result = TCL_CONTINUE;
@@ -2352,7 +2517,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
while (result == TCL_CONTINUE && resPtr) {
if (resPtr->cmdResProc) {
- result = (*resPtr->cmdResProc)(interp, name,
+ result = resPtr->cmdResProc(interp, name,
(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
}
resPtr = resPtr->nextPtr;
@@ -2361,7 +2526,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
if (result == TCL_OK) {
return cmd;
} else if (result != TCL_CONTINUE) {
- return (Tcl_Command) NULL;
+ return NULL;
}
}
@@ -2370,17 +2535,21 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
*/
cmdPtr = NULL;
- if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)) {
+ if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
+ && !(flags & TCL_NAMESPACE_ONLY)) {
int i;
Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;
(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
- if (realNsPtr != NULL && simpleName != NULL) {
- entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
- if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ if ((realNsPtr != NULL) && (simpleName != NULL)) {
+ if ((cxtNsPtr == realNsPtr)
+ || !(realNsPtr->flags & NS_DYING)) {
+ entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
+ if (entryPtr != NULL) {
+ cmdPtr = Tcl_GetHashValue(entryPtr);
+ }
}
}
@@ -2396,10 +2565,11 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
(void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
- if (realNsPtr != NULL && simpleName != NULL) {
+ if ((realNsPtr != NULL) && (simpleName != NULL)
+ && !(realNsPtr->flags & NS_DYING)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ cmdPtr = Tcl_GetHashValue(entryPtr);
}
}
}
@@ -2413,10 +2583,11 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
(void) TclGetNamespaceForQualName(interp, name, NULL,
TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
- if (realNsPtr != NULL && simpleName != NULL) {
+ if ((realNsPtr != NULL) && (simpleName != NULL)
+ && !(realNsPtr->flags & NS_DYING)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ cmdPtr = Tcl_GetHashValue(entryPtr);
}
}
}
@@ -2438,7 +2609,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
simpleName);
if (entryPtr != NULL) {
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ cmdPtr = Tcl_GetHashValue(entryPtr);
}
}
}
@@ -2449,135 +2620,11 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
}
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown command \"", name,
- "\"", (char *) NULL);
- }
- return (Tcl_Command) NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindNamespaceVar --
- *
- * Searches for a namespace variable, a variable not local to a
- * procedure. The variable can be either a scalar or an array, but may
- * not be an element of an array.
- *
- * Results:
- * Returns a token for the variable if it is found. Otherwise, if it
- * can't be found or there is an error, returns NULL and leaves an error
- * message in the interpreter's result object if "flags" contains
- * TCL_LEAVE_ERR_MSG.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Var
-Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
- Tcl_Interp *interp; /* The interpreter in which to find the
- * variable. */
- CONST char *name; /* Variable's name. If it starts with "::",
- * will be looked up in global namespace.
- * Else, looked up first in contextNsPtr
- * (current namespace if contextNsPtr is
- * NULL), then in global namespace. */
- Tcl_Namespace *contextNsPtr;/* Ignored if TCL_GLOBAL_ONLY flag set.
- * Otherwise, points to namespace in which to
- * resolve name. If NULL, look up name in the
- * current namespace. */
- int flags; /* An OR'd combination of flags:
- * TCL_GLOBAL_ONLY (look up name only in
- * global namespace), TCL_NAMESPACE_ONLY (look
- * up only in contextNsPtr, or the current
- * namespace if contextNsPtr is NULL), and
- * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
- * and TCL_NAMESPACE_ONLY are given,
- * TCL_GLOBAL_ONLY is ignored. */
-{
- Interp *iPtr = (Interp*)interp;
- ResolverScheme *resPtr;
- Namespace *nsPtr[2], *cxtNsPtr;
- CONST char *simpleName;
- Tcl_HashEntry *entryPtr;
- Var *varPtr;
- register int search;
- int result;
- Tcl_Var var;
-
- /*
- * If this namespace has a variable resolver, then give it first crack at
- * the variable resolution. It may return a Tcl_Var value, it may signal
- * to continue onward, or it may signal an error.
- */
-
- if ((flags & TCL_GLOBAL_ONLY) != 0) {
- cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- } else if (contextNsPtr != NULL) {
- cxtNsPtr = (Namespace *) contextNsPtr;
- } else {
- cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- }
-
- if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
- resPtr = iPtr->resolverPtr;
-
- if (cxtNsPtr->varResProc) {
- result = (*cxtNsPtr->varResProc)(interp, name,
- (Tcl_Namespace *) cxtNsPtr, flags, &var);
- } else {
- result = TCL_CONTINUE;
- }
-
- while (result == TCL_CONTINUE && resPtr) {
- if (resPtr->varResProc) {
- result = (*resPtr->varResProc)(interp, name,
- (Tcl_Namespace *) cxtNsPtr, flags, &var);
- }
- resPtr = resPtr->nextPtr;
- }
-
- if (result == TCL_OK) {
- return var;
- } else if (result != TCL_CONTINUE) {
- return (Tcl_Var) NULL;
- }
- }
-
- /*
- * Find the namespace(s) that contain the variable.
- */
-
- TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
- flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
-
- /*
- * Look for the variable in the variable table of its namespace. Be sure
- * to check both possible search paths: from the specified namespace
- * context and from the global namespace.
- */
-
- varPtr = NULL;
- for (search = 0; (search < 2) && (varPtr == NULL); search++) {
- if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
- entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable, simpleName);
- if (entryPtr != NULL) {
- varPtr = (Var *) Tcl_GetHashValue(entryPtr);
- }
- }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown command \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
}
- if (varPtr != NULL) {
- return (Tcl_Var) varPtr;
- } else if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown variable \"", name, "\"",
- (char *) NULL);
- }
- return (Tcl_Var) NULL;
+ return NULL;
}
/*
@@ -2613,27 +2660,20 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
*/
void
-TclResetShadowedCmdRefs(interp, newCmdPtr)
- Tcl_Interp *interp; /* Interpreter containing the new command. */
- Command *newCmdPtr; /* Points to the new command. */
+TclResetShadowedCmdRefs(
+ Tcl_Interp *interp, /* Interpreter containing the new command. */
+ Command *newCmdPtr) /* Points to the new command. */
{
char *cmdName;
Tcl_HashEntry *hPtr;
register Namespace *nsPtr;
Namespace *trailNsPtr, *shadowNsPtr;
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
int found, i;
-
- /*
- * This function generates an array used to hold the trail list. This
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
- Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
- Namespace **trailPtr = trailStorage;
int trailFront = -1;
- int trailSize = NUM_TRAIL_ELEMS;
+ int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */
+ Namespace **trailPtr = TclStackAlloc(interp,
+ trailSize * sizeof(Namespace *));
/*
* Start at the namespace containing the new command, and work up through
@@ -2669,10 +2709,19 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
for (i = trailFront; i >= 0; i--) {
trailNsPtr = trailPtr[i];
+#ifndef BREAK_NAMESPACE_COMPAT
hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
trailNsPtr->name);
+#else
+ if (shadowNsPtr->childTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
+ trailNsPtr->name);
+ } else {
+ hPtr = NULL;
+ }
+#endif
if (hPtr != NULL) {
- shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);
+ shadowNsPtr = Tcl_GetHashValue(hPtr);
} else {
found = 0;
break;
@@ -2698,7 +2747,7 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
* for a fresh compilation of every bytecode.
*/
- if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL) {
+ if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL){
nsPtr->resolverEpoch++;
}
}
@@ -2711,265 +2760,124 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
trailFront++;
if (trailFront == trailSize) {
- size_t currBytes = trailSize * sizeof(Namespace *);
- int newSize = 2*trailSize;
- size_t newBytes = newSize * sizeof(Namespace *);
- Namespace **newPtr = (Namespace **) ckalloc((unsigned) newBytes);
-
- memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);
- if (trailPtr != trailStorage) {
- ckfree((char *) trailPtr);
- }
- trailPtr = newPtr;
+ int newSize = 2 * trailSize;
+
+ trailPtr = TclStackRealloc(interp, trailPtr,
+ newSize * sizeof(Namespace *));
trailSize = newSize;
}
trailPtr[trailFront] = nsPtr;
}
-
- /*
- * Free any allocated storage.
- */
-
- if (trailPtr != trailStorage) {
- ckfree((char *) trailPtr);
- }
+ TclStackFree(interp, trailPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclGetNamespaceFromObj --
+ * TclGetNamespaceFromObj, GetNamespaceFromObj --
*
* Gets the namespace specified by the name in a Tcl_Obj.
*
* Results:
* Returns TCL_OK if the namespace was resolved successfully, and stores
* a pointer to the namespace in the location specified by nsPtrPtr. If
- * the namespace can't be found, the function stores NULL in *nsPtrPtr
- * and returns TCL_OK. If anything else goes wrong, this function returns
- * TCL_ERROR.
+ * the namespace can't be found, or anything else goes wrong, this
+ * function returns TCL_ERROR and writes an error message to interp,
+ * if non-NULL.
*
* Side effects:
* May update the internal representation for the object, caching the
* namespace reference. The next time this function is called, the
* namespace value can be found quickly.
*
- * If anything goes wrong, an error message is left in the interpreter's
- * result object.
- *
*----------------------------------------------------------------------
*/
int
-TclGetNamespaceFromObj(interp, objPtr, nsPtrPtr)
- Tcl_Interp *interp; /* The current interpreter. */
- Tcl_Obj *objPtr; /* The object to be resolved as the name of a
+TclGetNamespaceFromObj(
+ Tcl_Interp *interp, /* The current interpreter. */
+ Tcl_Obj *objPtr, /* The object to be resolved as the name of a
* namespace. */
- Tcl_Namespace **nsPtrPtr; /* Result namespace pointer goes here. */
+ Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
- Interp *iPtr = (Interp *) interp;
- register ResolvedNsName *resNamePtr;
- register Namespace *nsPtr;
- Namespace *currNsPtr;
- CallFrame *savedFramePtr;
- int result = TCL_OK;
- char *name;
+ if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) {
+ const char *name = TclGetString(objPtr);
- /*
- * If the namespace name is fully qualified, do as if the lookup were done
- * from the global namespace; this helps avoid repeated lookups of fully
- * qualified names.
- */
-
- savedFramePtr = iPtr->varFramePtr;
- name = TclGetString(objPtr);
- if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
- }
-
- currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-
- /*
- * Get the internal representation, converting to a namespace type if
- * needed. The internal representation is a ResolvedNsName that points to
- * the actual namespace.
- */
+ if ((name[0] == ':') && (name[1] == ':')) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "namespace \"%s\" not found", name));
+ } else {
+ /*
+ * Get the current namespace name.
+ */
- if (objPtr->typePtr != &tclNsNameType) {
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- goto done;
+ NamespaceCurrentCmd(NULL, interp, 1, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "namespace \"%s\" not found in \"%s\"", name,
+ Tcl_GetStringResult(interp)));
}
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
+ return TCL_ERROR;
}
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+ return TCL_OK;
+}
- /*
- * Check the context namespace of the resolved symbol to make sure that it
- * is fresh. If not, then force another conversion to the namespace type,
- * to discard the old rep and create a new one. Note that we verify that
- * the namespace id of the cached namespace is the same as the id when we
- * cached it; this insures that the namespace wasn't deleted and a new one
- * created at the same address.
- */
+static int
+GetNamespaceFromObj(
+ Tcl_Interp *interp, /* The current interpreter. */
+ Tcl_Obj *objPtr, /* The object to be resolved as the name of a
+ * namespace. */
+ Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
+{
+ ResolvedNsName *resNamePtr;
+ Namespace *nsPtr, *refNsPtr;
- nsPtr = NULL;
- if ((resNamePtr != NULL) && (resNamePtr->refNsPtr == currNsPtr)
- && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+ if (objPtr->typePtr == &nsNameType) {
+ /*
+ * Check that the ResolvedNsName is still valid; avoid letting the ref
+ * cross interps.
+ */
+
+ resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
+ refNsPtr = resNamePtr->refNsPtr;
+ if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
+ (!refNsPtr || ((interp == refNsPtr->interp) &&
+ (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
+ *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+ return TCL_OK;
}
}
- if (nsPtr == NULL) { /* try again */
- result = tclNsNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- goto done;
- }
- resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
- if (resNamePtr != NULL) {
- nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
- }
- }
+ if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
+ resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ *nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
+ return TCL_OK;
}
- *nsPtrPtr = (Tcl_Namespace *) nsPtr;
-
- done:
- iPtr->varFramePtr = savedFramePtr;
- return result;
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * 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, interp, objc, objv)
- ClientData clientData; /* Arbitrary value passed to cmd. */
- Tcl_Interp *interp; /* Current interpreter. */
- register int objc; /* Number of arguments. */
- register Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_Command
+TclInitNamespaceCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
{
- static CONST char *subCmds[] = {
- "children", "code", "current", "delete", "ensemble",
- "eval", "exists", "export", "forget", "import",
- "inscope", "origin", "parent", "path", "qualifiers",
- "tail", "which", (char *) NULL
- };
- enum NSSubCmdIdx {
- NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
- NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
- NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
- NSTailIdx, NSWhichIdx
- };
- int index, result;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
-
- /*
- * Return an index reflecting the particular subcommand.
- */
-
- result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,
- "option", /*flags*/ 0, (int *) &index);
- if (result != TCL_OK) {
- return result;
- }
-
- switch (index) {
- case NSChildrenIdx:
- result = NamespaceChildrenCmd(clientData, interp, objc, objv);
- break;
- case NSCodeIdx:
- result = NamespaceCodeCmd(clientData, interp, objc, objv);
- break;
- case NSCurrentIdx:
- result = NamespaceCurrentCmd(clientData, interp, objc, objv);
- break;
- case NSDeleteIdx:
- result = NamespaceDeleteCmd(clientData, interp, objc, objv);
- break;
- case NSEnsembleIdx:
- result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
- break;
- case NSEvalIdx:
- result = NamespaceEvalCmd(clientData, interp, objc, objv);
- break;
- case NSExistsIdx:
- result = NamespaceExistsCmd(clientData, interp, objc, objv);
- break;
- case NSExportIdx:
- result = NamespaceExportCmd(clientData, interp, objc, objv);
- break;
- case NSForgetIdx:
- result = NamespaceForgetCmd(clientData, interp, objc, objv);
- break;
- case NSImportIdx:
- result = NamespaceImportCmd(clientData, interp, objc, objv);
- break;
- case NSInscopeIdx:
- result = NamespaceInscopeCmd(clientData, interp, objc, objv);
- break;
- case NSOriginIdx:
- result = NamespaceOriginCmd(clientData, interp, objc, objv);
- break;
- case NSParentIdx:
- result = NamespaceParentCmd(clientData, interp, objc, objv);
- break;
- case NSPathIdx:
- result = NamespacePathCmd(clientData, interp, objc, objv);
- break;
- case NSQualifiersIdx:
- result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
- break;
- case NSTailIdx:
- result = NamespaceTailCmd(clientData, interp, objc, objv);
- break;
- case NSWhichIdx:
- result = NamespaceWhichCmd(clientData, interp, objc, objv);
- break;
- }
- return result;
+ return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
}
/*
@@ -2994,16 +2902,16 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
*/
static int
-NamespaceChildrenCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceChildrenCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr, *childNsPtr;
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- char *pattern = NULL;
+ Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
+ const char *pattern = NULL;
Tcl_DString buffer;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
@@ -3013,21 +2921,15 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
* Get a pointer to the specified namespace, or the current namespace.
*/
- if (objc == 2) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- } else if ((objc == 3) || (objc == 4)) {
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
- return TCL_ERROR;
- }
- if (namespacePtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(objv[2]),
- "\" in namespace children command", (char *) NULL);
+ if (objc == 1) {
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ } 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;
}
@@ -3036,15 +2938,15 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
*/
Tcl_DStringInit(&buffer);
- if (objc == 4) {
- 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);
@@ -3056,17 +2958,36 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
* names match the specified pattern, if any.
*/
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ listPtr = Tcl_NewListObj(0, NULL);
if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- if (Tcl_FindHashEntry(&nsPtr->childTable, pattern) != NULL) {
+ unsigned int length = strlen(nsPtr->fullName);
+
+ if (strncmp(pattern, nsPtr->fullName, length) != 0) {
+ goto searchDone;
+ }
+ if (
+#ifndef BREAK_NAMESPACE_COMPAT
+ Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL
+#else
+ nsPtr->childTablePtr != NULL &&
+ Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL
+#endif
+ ) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(pattern, -1));
}
goto searchDone;
}
+#ifndef BREAK_NAMESPACE_COMPAT
entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+#else
+ if (nsPtr->childTablePtr == NULL) {
+ goto searchDone;
+ }
+ entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+#endif
while (entryPtr != NULL) {
- childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
+ childNsPtr = Tcl_GetHashValue(entryPtr);
if ((pattern == NULL)
|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
@@ -3110,39 +3031,35 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceCodeCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceCodeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Namespace *currNsPtr;
Tcl_Obj *listPtr, *objPtr;
- register 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 = Tcl_GetStringFromObj(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;
}
/*
@@ -3153,21 +3070,21 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
* "namespace inscope" command.
*/
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("::namespace", -1));
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("inscope", -1));
+ TclNewObj(listPtr);
+ TclNewLiteralStringObj(objPtr, "::namespace");
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ TclNewLiteralStringObj(objPtr, "inscope");
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
- objPtr = Tcl_NewStringObj("::", -1);
+ currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+ TclNewLiteralStringObj(objPtr, "::");
} else {
objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
}
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+ Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
@@ -3195,16 +3112,16 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceCurrentCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceCurrentCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Namespace *currNsPtr;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
@@ -3217,8 +3134,8 @@ NamespaceCurrentCmd(dummy, interp, objc, objv)
* namespace [namespace current]::bar { ... }
*/
- currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+ currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
} else {
Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1));
@@ -3258,18 +3175,18 @@ NamespaceCurrentCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceDeleteCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceDeleteCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
- char *name;
+ 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;
}
@@ -3279,14 +3196,16 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
* 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,
- (Tcl_Namespace *) NULL, /*flags*/ 0);
- if (namespacePtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(objv[i]),
- "\" in namespace delete command", (char *) NULL);
+ namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
+ if ((namespacePtr == NULL)
+ || (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
+ 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;
}
}
@@ -3295,10 +3214,9 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
* 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,
- (Tcl_Namespace *) NULL, /* flags */ 0);
+ namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
if (namespacePtr) {
Tcl_DeleteNamespace(namespacePtr);
}
@@ -3334,19 +3252,33 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceEvalCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+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. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ CmdFrame *invoker;
+ int word;
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
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;
}
@@ -3355,19 +3287,16 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
* namespace object along the way.
*/
- result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr);
- if (result != TCL_OK) {
- return result;
- }
+ result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
/*
* If the namespace wasn't found, try to create it.
*/
- if (namespacePtr == NULL) {
- char *name = TclGetString(objv[2]);
- namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL,
- (Tcl_NamespaceDeleteProc *) NULL);
+ if (result == TCL_ERROR) {
+ const char *name = TclGetString(objv[1]);
+
+ namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
if (namespacePtr == NULL) {
return TCL_ERROR;
}
@@ -3385,12 +3314,25 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
if (result != TCL_OK) {
return TCL_ERROR;
}
- framePtr->objc = objc;
- framePtr->objv = objv; /* Reference counts do not need to be
- * incremented here. */
- if (objc == 4) {
- result = Tcl_EvalObjEx(interp, objv[3], 0);
+ 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 == 3) {
+ /*
+ * TIP #280: Make actual argument location available to eval'd script.
+ */
+
+ objPtr = objv[2];
+ invoker = iPtr->cmdFramePtr;
+ word = 3;
+ TclArgumentGet(interp, objPtr, &invoker, &word);
} else {
/*
* More than one argument: concatenate them together with spaces
@@ -3398,19 +3340,39 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
* object when it decrements its refcount after eval'ing it.
*/
- objPtr = Tcl_ConcatObj(objc-3, objv+3);
- result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
+ objPtr = Tcl_ConcatObj(objc-2, objv+2);
+ invoker = NULL;
+ word = 0;
}
+ /*
+ * TIP #280: Make invoking context available to eval'd script.
+ */
+
+ TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
+ NULL, NULL);
+ return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+}
+
+static int
+NsEval_Callback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Namespace *namespacePtr = data[0];
+
if (result == TCL_ERROR) {
int length = strlen(namespacePtr->fullName);
int limit = 200;
int overflow = (length > limit);
+ char *cmd = data[1];
- TclFormatToErrorInfo(interp,
- "\n (in namespace eval \"%.*s%s\" script line %d)",
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in namespace %s \"%.*s%s\" script line %d)",
+ cmd,
(overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
@@ -3443,28 +3405,21 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceExistsCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceExistsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
- }
-
- /*
- * Check whether the given namespace exists
- */
-
- if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(namespacePtr != NULL));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
return TCL_OK;
}
@@ -3505,54 +3460,41 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceExportCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceExportCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
- char *pattern, *string;
- int resetListFirst = 0;
- int firstArg, patternCt, i, result;
+ int firstArg, i;
- 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;
}
/*
- * Process the optional "-clear" argument.
+ * If no pattern arguments are given, and "-clear" isn't specified, return
+ * the namespace's current export pattern list.
*/
- firstArg = 2;
- if (firstArg < objc) {
- string = TclGetString(objv[firstArg]);
- if (strcmp(string, "-clear") == 0) {
- resetListFirst = 1;
- firstArg++;
- }
+ if (objc == 1) {
+ Tcl_Obj *listPtr = Tcl_NewObj();
+
+ (void) Tcl_AppendExportList(interp, NULL, listPtr);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
}
/*
- * If no pattern arguments are given, and "-clear" isn't specified, return
- * the namespace's current export pattern list.
+ * Process the optional "-clear" argument.
*/
- patternCt = (objc - firstArg);
- if (patternCt == 0) {
- if (firstArg > 2) {
- return TCL_OK;
- } else { /* create list with export patterns */
- Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- result = Tcl_AppendExportList(interp,
- (Tcl_Namespace *) currNsPtr, listPtr);
- if (result != TCL_OK) {
- return result;
- }
- Tcl_SetObjResult(interp, listPtr);
- return TCL_OK;
- }
+ firstArg = 1;
+ if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
+ Tcl_Export(interp, NULL, "::", 1);
+ Tcl_ResetResult(interp);
+ firstArg++;
}
/*
@@ -3560,9 +3502,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
*/
for (i = firstArg; i < objc; i++) {
- pattern = TclGetString(objv[i]);
- result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
- ((i == firstArg)? resetListFirst : 0));
+ int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0);
if (result != TCL_OK) {
return result;
}
@@ -3601,23 +3541,23 @@ NamespaceExportCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceForgetCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceForgetCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *pattern;
+ 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, (Tcl_Namespace *) NULL, pattern);
+ result = Tcl_ForgetImport(interp, NULL, pattern);
if (result != TCL_OK) {
return result;
}
@@ -3650,6 +3590,10 @@ NamespaceForgetCmd(dummy, interp, objc, objv)
* treated as an error. But if the "-force" option is included, then
* existing commands are overwritten by the imported commands.
*
+ * If there are no pattern arguments and the "-force" flag isn't given,
+ * this command returns the list of commands currently imported in
+ * the current namespace.
+ *
* Results:
* Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
@@ -3662,19 +3606,19 @@ NamespaceForgetCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceImportCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceImportCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowOverwrite = 0;
- char *string, *pattern;
+ const char *string, *pattern;
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;
}
@@ -3682,13 +3626,36 @@ NamespaceImportCmd(dummy, interp, objc, objv)
* 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)) {
allowOverwrite = 1;
firstArg++;
}
+ } else {
+ /*
+ * When objc == 1, command is just [namespace import]. Introspection
+ * form to return list of imported commands.
+ */
+
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ Tcl_Obj *listPtr;
+
+ TclNewObj(listPtr);
+ for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
+ if (cmdPtr->deleteProc == DeleteImportedCmd) {
+ Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(
+ Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
+ }
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
}
/*
@@ -3697,8 +3664,7 @@ NamespaceImportCmd(dummy, interp, objc, objv)
for (i = firstArg; i < objc; i++) {
pattern = TclGetString(objv[i]);
- result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
- allowOverwrite);
+ result = Tcl_Import(interp, NULL, pattern, allowOverwrite);
if (result != TCL_OK) {
return result;
}
@@ -3744,18 +3710,31 @@ NamespaceImportCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceInscopeCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+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. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
- Tcl_CallFrame *framePtr;
+ 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;
}
@@ -3763,13 +3742,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
* Resolve the namespace reference.
*/
- result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr);
- if (result != TCL_OK) {
- return result;
- }
- if (namespacePtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[2]),
- "\" in inscope namespace command", (char *) NULL);
+ if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -3777,12 +3750,23 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
* Make the specified namespace the current namespace.
*/
- result = TclPushStackFrame(interp, &framePtr, namespacePtr,
- /*isProcCallFrame*/ 0);
+ framePtrPtr = &framePtr; /* This is needed to satisfy GCC's
+ * strict aliasing rules. */
+ result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ namespacePtr, /*isProcCallFrame*/ 0);
if (result != TCL_OK) {
return result;
}
+ 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
* script and evaluate it. Otherwise, create a list from the arguments
@@ -3790,45 +3774,29 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
* of extra arguments to form the command to evaluate.
*/
- if (objc == 4) {
- result = Tcl_EvalObjEx(interp, objv[3], 0);
+ if (objc == 3) {
+ cmdObjPtr = objv[2];
} else {
Tcl_Obj *concatObjv[2];
- register Tcl_Obj *listPtr, *cmdObjPtr;
-
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (i = 4; i < objc; i++) {
- result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(listPtr); /* free unneeded obj */
- return result;
+ register Tcl_Obj *listPtr;
+
+ listPtr = Tcl_NewListObj(0, NULL);
+ 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);
- result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
- Tcl_DecrRefCount(listPtr); /* we're done with the list object */
+ Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
}
- if (result == TCL_ERROR) {
- int length = strlen(namespacePtr->fullName);
- int limit = 200;
- int overflow = (length > limit);
-
- TclFormatToErrorInfo(interp,
- "\n (in namespace inscope \"%.*s%s\" script line %d)",
- (overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine);
- }
-
- /*
- * Restore the previous "current" namespace.
- */
-
- TclPopStackFrame(interp);
- return result;
+ TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
+ NULL, NULL);
+ return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
}
/*
@@ -3861,29 +3829,31 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceOriginCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceOriginCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
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]);
- if (command == (Tcl_Command) NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[2]), "\"", (char *) NULL);
+ command = Tcl_GetCommandFromObj(interp, objv[1]);
+ if (command == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
origCommand = TclGetOriginalCommand(command);
- resultPtr = Tcl_NewObj();
- if (origCommand == (Tcl_Command) NULL) {
+ TclNewObj(resultPtr);
+ if (origCommand == NULL) {
/*
* The specified command isn't an imported command. Return the
* command's name qualified by the full name of the namespace it was
@@ -3920,30 +3890,22 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
*/
static int
-NamespaceParentCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceParentCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *nsPtr;
- int result;
- if (objc == 2) {
- nsPtr = Tcl_GetCurrentNamespace(interp);
- } else if (objc == 3) {
- result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr);
- if (result != TCL_OK) {
- return result;
- }
- if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(objv[2]),
- "\" in namespace parent command", (char *) NULL);
+ if (objc == 1) {
+ nsPtr = TclGetCurrentNamespace(interp);
+ } 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;
}
@@ -3986,20 +3948,19 @@ NamespaceParentCmd(dummy, interp, objc, objv)
*/
static int
-NamespacePathCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespacePathCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
int i, nsObjc, result = TCL_ERROR;
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
- Tcl_Namespace *staticNs[4];
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
return TCL_ERROR;
}
@@ -4007,17 +3968,16 @@ NamespacePathCmd(dummy, interp, objc, objv)
* 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;
}
@@ -4025,27 +3985,18 @@ NamespacePathCmd(dummy, interp, objc, objv)
* There is a path given, so parse it into an array of namespace pointers.
*/
- if (Tcl_ListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
+ if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
goto badNamespace;
}
if (nsObjc != 0) {
- if (nsObjc > 4) {
- namespaceList = (Tcl_Namespace **)
- ckalloc(sizeof(Tcl_Namespace *) * nsObjc);
- } else {
- namespaceList = staticNs;
- }
+ namespaceList = TclStackAlloc(interp,
+ sizeof(Tcl_Namespace *) * nsObjc);
for (i=0 ; i<nsObjc ; i++) {
if (TclGetNamespaceFromObj(interp, nsObjv[i],
&namespaceList[i]) != TCL_OK) {
goto badNamespace;
}
- if (namespaceList[i] == NULL) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(nsObjv[i]), "\"", NULL);
- goto badNamespace;
- }
}
}
@@ -4053,12 +4004,12 @@ NamespacePathCmd(dummy, interp, objc, objv)
* Now we have the list of valid namespaces, install it as the path.
*/
- SetNsPath(nsPtr, nsObjc, namespaceList);
+ TclSetNsPath(nsPtr, nsObjc, namespaceList);
result = TCL_OK;
badNamespace:
- if (namespaceList != NULL && namespaceList != staticNs) {
- ckfree((char *) namespaceList);
+ if (namespaceList != NULL) {
+ TclStackFree(interp, namespaceList);
}
return result;
}
@@ -4066,7 +4017,7 @@ NamespacePathCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SetNsPath --
+ * TclSetNsPath --
*
* Sets the namespace command name resolution path to the given list of
* namespaces. If the list is empty (of zero length) the path is set to
@@ -4083,19 +4034,17 @@ NamespacePathCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-/* EXPOSE ME? */
-static void
-SetNsPath(nsPtr, pathLength, pathAry)
- Namespace *nsPtr; /* Namespace whose path is to be set. */
- int pathLength; /* Length of pathAry */
- Tcl_Namespace *pathAry[]; /* Array of namespaces that are the path. */
+void
+TclSetNsPath(
+ Namespace *nsPtr, /* Namespace whose path is to be set. */
+ int pathLength, /* Length of pathAry. */
+ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */
{
- NamespacePathEntry *tmpPathArray;
- int i;
-
if (pathLength != 0) {
- tmpPathArray = (NamespacePathEntry *)
+ NamespacePathEntry *tmpPathArray =
ckalloc(sizeof(NamespacePathEntry) * pathLength);
+ int i;
+
for (i=0 ; i<pathLength ; i++) {
tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
tmpPathArray[i].creatorNsPtr = nsPtr;
@@ -4142,12 +4091,13 @@ SetNsPath(nsPtr, pathLength, pathAry)
*/
static void
-UnlinkNsPath(nsPtr)
- Namespace *nsPtr;
+UnlinkNsPath(
+ Namespace *nsPtr)
{
int i;
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];
+
if (nsPathPtr->prevPtr != NULL) {
nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
}
@@ -4160,7 +4110,7 @@ UnlinkNsPath(nsPtr)
}
}
}
- ckfree((char *) nsPtr->commandPathArray);
+ ckfree(nsPtr->commandPathArray);
}
/*
@@ -4184,10 +4134,11 @@ UnlinkNsPath(nsPtr)
*/
void
-TclInvalidateNsPath(nsPtr)
- Namespace *nsPtr;
+TclInvalidateNsPath(
+ Namespace *nsPtr)
{
NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+
while (nsPathPtr != NULL) {
if (nsPathPtr->nsPtr != NULL) {
nsPathPtr->creatorNsPtr->cmdRefEpoch++;
@@ -4222,17 +4173,17 @@ TclInvalidateNsPath(nsPtr)
*/
static int
-NamespaceQualifiersCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceQualifiersCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- register char *name, *p;
+ 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;
}
@@ -4241,15 +4192,15 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
* the last "::" qualifier.
*/
- name = TclGetString(objv[2]);
+ name = TclGetString(objv[1]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
while (--p >= name) {
if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
- p -= 2; /* back up over the :: */
+ p -= 2; /* Back up over the :: */
while ((p >= name) && (*p == ':')) {
- p--; /* back up over the preceeding : */
+ p--; /* Back up over the preceeding : */
}
break;
}
@@ -4265,61 +4216,64 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * NamespaceTailCmd --
+ * NamespaceUnknownCmd --
*
- * Invoked to implement the "namespace tail" command that returns the
- * trailing name at the end of a string with "::" namespace qualifiers.
- * These qualifiers are namespace names separated by "::"s. For example,
- * for "::foo::p" this command returns "p", and for "::" it returns "".
- * This command is the complement of the "namespace qualifiers" command.
- * Note that this command does not check whether the "namespace" names
- * are, in fact, the names of currently defined namespaces. Handles the
- * following syntax:
+ * Invoked to implement the "namespace unknown" command (TIP 181) that
+ * sets or queries a per-namespace unknown command handler. This handler
+ * is called when command lookup fails (current and global ns). The
+ * default handler for the global namespace is ::unknown. The default
+ * handler for other namespaces is to call the global namespace unknown
+ * handler. Passing an empty list results in resetting the handler to its
+ * default.
*
- * namespace tail string
+ * namespace unknown ?handler?
*
* Results:
* Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
- * Returns a result in the interpreter's result object. If anything goes
+ * If no handler is specified, returns a result in the interpreter's
+ * result object, otherwise it sets the unknown handler pointer in the
+ * current namespace to the script fragment provided. If anything goes
* wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
static int
-NamespaceTailCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+NamespaceUnknownCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- register char *name, *p;
+ Tcl_Namespace *currNsPtr;
+ Tcl_Obj *resultPtr;
+ int rc;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?script?");
return TCL_ERROR;
}
- /*
- * Find the end of the string, then work backward and find the last "::"
- * qualifier.
- */
+ currNsPtr = TclGetCurrentNamespace(interp);
- name = TclGetString(objv[2]);
- for (p = name; *p != '\0'; p++) {
- /* empty body */
- }
- while (--p > name) {
- if ((*p == ':') && (*(p-1) == ':')) {
- p++; /* just after the last "::" */
- break;
- }
- }
+ if (objc == 1) {
+ /*
+ * Introspection - return the current namespace handler.
+ */
- if (p >= name) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
+ resultPtr = Tcl_GetNamespaceUnknownHandler(interp, currNsPtr);
+ if (resultPtr == NULL) {
+ TclNewObj(resultPtr);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]);
+ if (rc == TCL_OK) {
+ Tcl_SetObjResult(interp, objv[1]);
+ }
+ return rc;
}
return TCL_OK;
}
@@ -4327,2308 +4281,800 @@ NamespaceTailCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * NamespaceWhichCmd --
- *
- * Invoked to implement the "namespace which" command that returns the
- * fully-qualified name of a command or variable. If the specified
- * command or variable does not exist, it returns "". Handles the
- * following syntax:
+ * Tcl_GetNamespaceUnknownHandler --
*
- * namespace which ?-command? ?-variable? name
+ * Returns the unknown command handler registered for the given
+ * namespace.
*
* Results:
- * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ * Returns the current unknown command handler, or NULL if none exists
+ * for the namespace.
*
* Side effects:
- * Returns a result in the interpreter's result object. If anything goes
- * wrong, the result is an error message.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int
-NamespaceWhichCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_Obj *
+Tcl_GetNamespaceUnknownHandler(
+ Tcl_Interp *interp, /* The interpreter in which the namespace
+ * exists. */
+ Tcl_Namespace *nsPtr) /* The namespace. */
{
- static CONST char *opts[] = {
- "-command", "-variable", NULL
- };
- int lookupType = 0;
- Tcl_Obj *resultPtr;
+ Namespace *currNsPtr = (Namespace *) nsPtr;
- if (objc < 3 || objc > 4) {
- badArgs:
- Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
- return TCL_ERROR;
- } else if (objc == 4) {
+ if (currNsPtr->unknownHandlerPtr == NULL &&
+ currNsPtr == ((Interp *) interp)->globalNsPtr) {
/*
- * Look for a flag controlling the lookup.
+ * Default handler for global namespace is "::unknown". For all other
+ * namespaces, it is NULL (which falls back on the global unknown
+ * handler).
*/
- if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
- &lookupType) != TCL_OK) {
- /*
- * Preserve old style of error message!
- */
-
- Tcl_ResetResult(interp);
- goto badArgs;
- }
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+ Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
}
-
- resultPtr = Tcl_NewObj();
- switch (lookupType) {
- case 0: { /* -command */
- Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
-
- if (cmd != (Tcl_Command) NULL) {
- Tcl_GetCommandFullName(interp, cmd, resultPtr);
- }
- break;
- }
- case 1: { /* -variable */
- Tcl_Var var = Tcl_FindNamespaceVar(interp,
- TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
-
- if (var != (Tcl_Var) NULL) {
- Tcl_GetVariableFullName(interp, var, resultPtr);
- }
- break;
- }
- }
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_OK;
+ return currNsPtr->unknownHandlerPtr;
}
/*
*----------------------------------------------------------------------
*
- * FreeNsNameInternalRep --
+ * Tcl_SetNamespaceUnknownHandler --
*
- * Frees the resources associated with a nsName object's internal
- * representation.
+ * Sets the unknown command handler for the given namespace to the
+ * command prefix passed.
*
* Results:
- * None.
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
- * Decrements the ref count of any Namespace structure pointed to by the
- * nsName's internal representation. If there are no more references to
- * the namespace, it's structure will be freed.
+ * Sets the namespace unknown command handler. If the passed in handler
+ * is NULL or an empty list, then the handler is reset to its default. If
+ * an error occurs, then an error message is left in the interpreter
+ * result.
*
*----------------------------------------------------------------------
*/
-static void
-FreeNsNameInternalRep(objPtr)
- register Tcl_Obj *objPtr; /* nsName object with internal representation
- * to free */
+int
+Tcl_SetNamespaceUnknownHandler(
+ Tcl_Interp *interp, /* Interpreter in which the namespace
+ * exists. */
+ Tcl_Namespace *nsPtr, /* Namespace which is being updated. */
+ Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */
{
- register ResolvedNsName *resNamePtr = (ResolvedNsName *)
- objPtr->internalRep.otherValuePtr;
- Namespace *nsPtr;
+ int lstlen = 0;
+ Namespace *currNsPtr = (Namespace *) nsPtr;
/*
- * Decrement the reference count of the namespace. If there are no more
- * references, free it up.
+ * Ensure that we check for errors *first* before we change anything.
*/
- if (resNamePtr != NULL) {
- resNamePtr->refCount--;
- if (resNamePtr->refCount == 0) {
-
+ if (handlerPtr != NULL) {
+ if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
/*
- * Decrement the reference count for the cached namespace. If the
- * namespace is dead, and there are no more references to it, free
- * it.
+ * Not a list.
*/
- nsPtr = resNamePtr->nsPtr;
- nsPtr->refCount--;
- if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
- NamespaceFree(nsPtr);
- }
- ckfree((char *) resNamePtr);
+ return TCL_ERROR;
}
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupNsNameInternalRep --
- *
- * Initializes the internal representation of a nsName object to a copy
- * of the internal representation of another nsName object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * copyPtr's internal rep is set to refer to the same namespace
- * referenced by srcPtr's internal rep. Increments the ref count of the
- * ResolvedNsName structure used to hold the namespace reference.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupNsNameInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- register ResolvedNsName *resNamePtr = (ResolvedNsName *)
- srcPtr->internalRep.otherValuePtr;
+ if (lstlen > 0) {
+ /*
+ * We are going to be saving this handler. Increment the reference
+ * count before decrementing the refcount on the previous handler,
+ * so that nothing strange can happen if we are told to set the
+ * handler to the previous value.
+ */
- copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
- if (resNamePtr != NULL) {
- resNamePtr->refCount++;
+ Tcl_IncrRefCount(handlerPtr);
+ }
}
- copyPtr->typePtr = &tclNsNameType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetNsNameFromAny --
- *
- * Attempt to generate a nsName internal representation for a Tcl object.
- *
- * Results:
- * Returns TCL_OK if the value could be converted to a proper namespace
- * reference. Otherwise, it returns TCL_ERROR, along with an error
- * message in the interpreter's result object.
- *
- * Side effects:
- * If successful, the object is made a nsName object. Its internal rep is
- * set to point to a ResolvedNsName, which contains a cached pointer to
- * the Namespace. Reference counts are kept on both the ResolvedNsName
- * and the Namespace, so we can keep track of their usage and free them
- * when appropriate.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetNsNameFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Points to the namespace in which to resolve
- * name. Also used for error reporting if not
- * NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
-{
- char *name;
- CONST char *dummy;
- Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
- register ResolvedNsName *resNamePtr;
/*
- * Get the string representation. Make it up-to-date if necessary.
+ * Remove old handler next.
*/
- name = objPtr->bytes;
- if (name == NULL) {
- name = TclGetString(objPtr);
+ if (currNsPtr->unknownHandlerPtr != NULL) {
+ Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr);
}
/*
- * Look for the namespace "name" in the current namespace. If there is an
- * error parsing the (possibly qualified) name, return an error. If the
- * namespace isn't found, we convert the object to an nsName object with a
- * NULL ResolvedNsName* internal rep.
+ * Install the new handler.
*/
- TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
-
- /*
- * If we found a namespace, then create a new ResolvedNsName structure
- * that holds a reference to it.
- */
+ if (lstlen > 0) {
+ /*
+ * Just store the handler. It already has the correct reference count.
+ */
- if (nsPtr != NULL) {
- Namespace *currNsPtr =
- (Namespace *) Tcl_GetCurrentNamespace(interp);
-
- nsPtr->refCount++;
- resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
- resNamePtr->nsPtr = nsPtr;
- resNamePtr->nsId = nsPtr->nsId;
- resNamePtr->refNsPtr = currNsPtr;
- resNamePtr->refCount = 1;
+ currNsPtr->unknownHandlerPtr = handlerPtr;
} else {
- resNamePtr = NULL;
- }
-
- /*
- * 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.
- */
+ /*
+ * If NULL or an empty list is passed, this resets to the default
+ * handler.
+ */
- TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
- objPtr->typePtr = &tclNsNameType;
+ currNsPtr->unknownHandlerPtr = NULL;
+ }
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfNsName --
+ * NamespaceTailCmd --
*
- * Updates the string representation for a nsName object. Note: This
- * function does not free an existing old string rep so storage will be
- * lost if this has not already been done.
+ * Invoked to implement the "namespace tail" command that returns the
+ * trailing name at the end of a string with "::" namespace qualifiers.
+ * These qualifiers are namespace names separated by "::"s. For example,
+ * for "::foo::p" this command returns "p", and for "::" it returns "".
+ * This command is the complement of the "namespace qualifiers" command.
+ * Note that this command does not check whether the "namespace" names
+ * are, in fact, the names of currently defined namespaces. Handles the
+ * following syntax:
+ *
+ * namespace tail string
*
* Results:
- * None.
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
- * The object's string is set to a copy of the fully qualified namespace
- * name.
+ * Returns a result in the interpreter's result object. If anything goes
+ * wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
-static void
-UpdateStringOfNsName(objPtr)
- register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
+static int
+NamespaceTailCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- ResolvedNsName *resNamePtr =
- (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
- register Namespace *nsPtr;
- char *name = "";
- int length;
+ register const char *name, *p;
- if ((resNamePtr != NULL)
- && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
- nsPtr = resNamePtr->nsPtr;
- if (nsPtr->flags & NS_DEAD) {
- nsPtr = NULL;
- }
- if (nsPtr != NULL) {
- name = nsPtr->fullName;
- }
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
}
/*
- * The following sets the string rep to an empty string on the heap if the
- * internal rep is NULL.
+ * Find the end of the string, then work backward and find the last "::"
+ * qualifier.
*/
- length = strlen(name);
- if (length == 0) {
- objPtr->bytes = tclEmptyStringRep;
- } else {
- objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
- memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
- objPtr->bytes[length] = '\0';
+ name = TclGetString(objv[1]);
+ for (p = name; *p != '\0'; p++) {
+ /* empty body */
}
- objPtr->length = length;
+ while (--p > name) {
+ if ((*p == ':') && (*(p-1) == ':')) {
+ p++; /* Just after the last "::" */
+ break;
+ }
+ }
+
+ if (p >= name) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
+ }
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * NamespaceEnsembleCmd --
+ * NamespaceUpvarCmd --
*
- * Invoked to implement the "namespace ensemble" command that creates and
- * manipulates ensembles built on top of namespaces. Handles the
- * following syntax:
+ * Invoked to implement the "namespace upvar" command, that creates
+ * variables in the current scope linked to variables in another
+ * namespace. Handles the following syntax:
*
- * namespace ensemble name ?dictionary?
+ * namespace upvar ns otherVar myVar ?otherVar myVar ...?
*
* Results:
* Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
- * Creates the ensemble for the namespace if one did not previously
- * exist. Alternatively, alters the way that the ensemble's subcommand =>
- * implementation prefix is configured.
+ * Creates new variables in the current scope, linked to the
+ * corresponding variables in the stipulated nmamespace. If anything goes
+ * wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
static int
-NamespaceEnsembleCmd(dummy, interp, objc, objv)
- ClientData dummy;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+NamespaceUpvarCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Namespace *nsPtr;
- Tcl_Command token;
- static CONST char *subcommands[] = {
- "configure", "create", "exists", NULL
- };
- enum EnsSubcmds {
- ENS_CONFIG, ENS_CREATE, ENS_EXISTS
- };
- static CONST char *createOptions[] = {
- "-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
- };
- enum EnsCreateOpts {
- CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
- };
- static CONST char *configOptions[] = {
- "-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
- };
- enum EnsConfigOpts {
- CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
- };
- int index;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Namespace *nsPtr, *savedNsPtr;
+ Var *otherPtr, *arrayPtr;
+ const char *myName;
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
- if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
- "tried to manipulate ensemble of deleted namespace", NULL);
- }
+ if (objc < 2 || (objc & 1)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
return TCL_ERROR;
}
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0,
- &index) != TCL_OK) {
+ if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
return TCL_ERROR;
}
- switch ((enum EnsSubcmds) index) {
- case ENS_CREATE: {
- char *name;
- Tcl_DictSearch search;
- Tcl_Obj *listObj;
- int done, len, allocatedMapFlag = 0;
- /*
- * Defaults
- */
- Tcl_Obj *subcmdObj = NULL;
- Tcl_Obj *mapObj = NULL;
- int permitPrefix = 1;
- Tcl_Obj *unknownObj = NULL;
-
- objv += 3;
- objc -= 3;
-
- /*
- * Work out what name to use for the command to create. If supplied,
- * it is either fully specified or relative to the current namespace.
- * If not supplied, it is exactly the name of the current namespace.
- */
-
- name = nsPtr->fullName;
+ objc -= 2;
+ objv += 2;
+ for (; objc>0 ; objc-=2, objv+=2) {
/*
- * Parse the option list, applying type checks as we go. Note that we
- * are not incrementing any reference counts in the objects at this
- * stage, so the presence of an option multiple times won't cause any
- * memory leaks.
+ * Locate the other variable.
*/
- for (; objc>1 ; objc-=2,objv+=2 ) {
- if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option",
- 0, &index) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- switch ((enum EnsCreateOpts) index) {
- case CRT_CMD:
- name = TclGetString(objv[1]);
- continue;
- case CRT_SUBCMDS:
- if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- subcmdObj = (len > 0 ? objv[1] : NULL);
- continue;
- case CRT_MAP: {
- Tcl_Obj *patchedDict = NULL, *subcmdObj;
-
- /*
- * Verify that the map is sensible.
- */
-
- if (Tcl_DictObjFirst(interp, objv[1], &search,
- &subcmdObj, &listObj, &done) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- if (done) {
- mapObj = NULL;
- continue;
- }
- do {
- Tcl_Obj **listv;
- char *cmd;
-
- if (Tcl_ListObjGetElements(interp, listObj, &len,
- &listv) != TCL_OK) {
- Tcl_DictObjDone(&search);
- if (patchedDict) {
- Tcl_DecrRefCount(patchedDict);
- }
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- if (len < 1) {
- Tcl_SetResult(interp,
- "ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
- Tcl_DictObjDone(&search);
- if (patchedDict) {
- Tcl_DecrRefCount(patchedDict);
- }
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- cmd = TclGetString(listv[0]);
- if (!(cmd[0] == ':' && cmd[1] == ':')) {
- Tcl_Obj *newList = Tcl_NewListObj(len, listv);
- Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);
-
- if (nsPtr->parentPtr) {
- Tcl_AppendStringsToObj(newCmd, "::", NULL);
- }
- Tcl_AppendObjToObj(newCmd, listv[0]);
- Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
- if (patchedDict == NULL) {
- patchedDict = Tcl_DuplicateObj(objv[1]);
- }
- Tcl_DictObjPut(NULL, patchedDict, subcmdObj, newList);
- }
- Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
- } while (!done);
-
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- mapObj = (patchedDict ? patchedDict : objv[1]);
- if (patchedDict) {
- allocatedMapFlag = 1;
- }
- continue;
- }
- case CRT_PREFIX:
- if (Tcl_GetBooleanFromObj(interp, objv[1],
- &permitPrefix) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- continue;
- case CRT_UNKNOWN:
- if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- unknownObj = (len > 0 ? objv[1] : NULL);
- continue;
- }
+ savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+ iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+ otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
+ (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
+ if (otherPtr == NULL) {
+ return TCL_ERROR;
}
/*
- * Create the ensemble. Note that this might delete another ensemble
- * linked to the same namespace, so we must be careful. However, we
- * should be OK because we only link the namespace into the list once
- * we've created it (and after any deletions have occurred.)
- */
-
- token = Tcl_CreateEnsemble(interp, name, NULL,
- (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
- Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
- Tcl_SetEnsembleMappingDict(interp, token, mapObj);
- Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
-
- /*
- * Tricky! Must ensure that the result is not shared (command delete
- * traces could have corrupted the pristine object that we started
- * with). [Snit test rename-1.5]
+ * Create the new variable and link it to otherPtr.
*/
- Tcl_ResetResult(interp);
- Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
- return TCL_OK;
- }
-
- case ENS_EXISTS:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
- return TCL_OK;
-
- case ENS_CONFIG:
- if (objc < 4 || (objc != 5 && objc & 1)) {
- Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
- return TCL_ERROR;
- }
- token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
- if (token == NULL) {
+ myName = TclGetString(objv[1]);
+ if (TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1) != TCL_OK) {
return TCL_ERROR;
}
-
- if (objc == 5) {
- Tcl_Obj *resultObj;
-
- if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum EnsConfigOpts) index) {
- case CONF_SUBCMDS:
- Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
- if (resultObj != NULL) {
- Tcl_SetObjResult(interp, resultObj);
- }
- break;
- case CONF_MAP:
- Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
- if (resultObj != NULL) {
- Tcl_SetObjResult(interp, resultObj);
- }
- break;
- case CONF_NAMESPACE: {
- Tcl_Namespace *namespacePtr;
-
- Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_SetResult(interp, ((Namespace *)namespacePtr)->fullName,
- TCL_VOLATILE);
- break;
- }
- case CONF_PREFIX: {
- int flags;
-
- Tcl_GetEnsembleFlags(NULL, token, &flags);
- Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
- break;
- }
- case CONF_UNKNOWN:
- Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
- if (resultObj != NULL) {
- Tcl_SetObjResult(interp, resultObj);
- }
- break;
- }
- return TCL_OK;
-
- } else if (objc == 4) {
- /*
- * Produce list of all information.
- */
-
- Tcl_Obj *resultObj, *tmpObj;
- Tcl_Namespace *namespacePtr;
- int flags;
-
- TclNewObj(resultObj);
-
- /* -map option */
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(configOptions[CONF_MAP], -1));
- Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
- if (tmpObj != NULL) {
- Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
- } else {
- Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
- }
-
- /* -namespace option */
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
- Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
- -1));
-
- /* -prefix option */
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
- Tcl_GetEnsembleFlags(NULL, token, &flags);
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
-
- /* -subcommands option */
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
- Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
- if (tmpObj != NULL) {
- Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
- } else {
- Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
- }
-
- /* -unknown option */
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
- Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
- if (tmpObj != NULL) {
- Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
- } else {
- Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
- }
-
- Tcl_SetObjResult(interp, resultObj);
- return TCL_OK;
- } else {
- Tcl_DictSearch search;
- Tcl_Obj *listObj;
- int done, len, allocatedMapFlag = 0;
- Tcl_Obj *subcmdObj, *mapObj, *unknownObj; /* Defaults */
- int permitPrefix, flags;
-
- Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
- Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
- Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
- Tcl_GetEnsembleFlags(NULL, token, &flags);
- permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
-
- objv += 4;
- objc -= 4;
-
- /*
- * Parse the option list, applying type checks as we go. Note that
- * we are not incrementing any reference counts in the objects at
- * this stage, so the presence of an option multiple times won't
- * cause any memory leaks.
- */
-
- for (; objc>0 ; objc-=2,objv+=2 ) {
- if (Tcl_GetIndexFromObj(interp, objv[0], configOptions,
- "option", 0, &index) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- switch ((enum EnsConfigOpts) index) {
- case CONF_SUBCMDS:
- if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- subcmdObj = (len > 0 ? objv[1] : NULL);
- continue;
- case CONF_MAP: {
- Tcl_Obj *patchedDict = NULL, *subcmdObj;
-
- /*
- * Verify that the map is sensible.
- */
-
- if (Tcl_DictObjFirst(interp, objv[1], &search,
- &subcmdObj, &listObj, &done) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- if (done) {
- mapObj = NULL;
- continue;
- }
- do {
- Tcl_Obj **listv;
- char *cmd;
-
- if (Tcl_ListObjGetElements(interp, listObj, &len,
- &listv) != TCL_OK) {
- Tcl_DictObjDone(&search);
- if (patchedDict) {
- Tcl_DecrRefCount(patchedDict);
- }
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- if (len < 1) {
- Tcl_SetResult(interp,
- "ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
- Tcl_DictObjDone(&search);
- if (patchedDict) {
- Tcl_DecrRefCount(patchedDict);
- }
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- cmd = TclGetString(listv[0]);
- if (!(cmd[0] == ':' && cmd[1] == ':')) {
- Tcl_Obj *newList = Tcl_NewListObj(len, listv);
- Tcl_Obj *newCmd =
- Tcl_NewStringObj(nsPtr->fullName, -1);
- if (nsPtr->parentPtr) {
- Tcl_AppendStringsToObj(newCmd, "::", NULL);
- }
- Tcl_AppendObjToObj(newCmd, listv[0]);
- Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
- if (patchedDict == NULL) {
- patchedDict = Tcl_DuplicateObj(objv[1]);
- }
- Tcl_DictObjPut(NULL, patchedDict, subcmdObj,
- newList);
- }
- Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
- } while (!done);
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- mapObj = (patchedDict ? patchedDict : objv[1]);
- if (patchedDict) {
- allocatedMapFlag = 1;
- }
- continue;
- }
- case CONF_NAMESPACE:
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- Tcl_AppendResult(interp, "option -namespace is read-only",
- NULL);
- return TCL_ERROR;
- case CONF_PREFIX:
- if (Tcl_GetBooleanFromObj(interp, objv[1],
- &permitPrefix) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- continue;
- case CONF_UNKNOWN:
- if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
- if (allocatedMapFlag) {
- Tcl_DecrRefCount(mapObj);
- }
- return TCL_ERROR;
- }
- unknownObj = (len > 0 ? objv[1] : NULL);
- continue;
- }
- }
-
- /*
- * Update the namespace now that we've finished the parsing stage.
- */
-
- flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
- : flags&~TCL_ENSEMBLE_PREFIX);
- Tcl_SetEnsembleSubcommandList(NULL, token, subcmdObj);
- Tcl_SetEnsembleMappingDict(NULL, token, mapObj);
- Tcl_SetEnsembleUnknownHandler(NULL, token, unknownObj);
- Tcl_SetEnsembleFlags(NULL, token, flags);
- return TCL_OK;
- }
-
- default:
- Tcl_Panic("unexpected ensemble command");
}
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateEnsemble --
- *
- * Create a simple ensemble attached to the given namespace.
- *
- * Results:
- * The token for the command created.
- *
- * Side effects:
- * The ensemble is created and marked for compilation.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-Tcl_CreateEnsemble(interp, name, namespacePtr, flags)
- Tcl_Interp *interp;
- CONST char *name;
- Tcl_Namespace *namespacePtr;
- int flags;
-{
- Namespace *nsPtr = (Namespace *) namespacePtr;
- EnsembleConfig *ensemblePtr =
- (EnsembleConfig *) ckalloc(sizeof(EnsembleConfig));
- Tcl_Obj *nameObj = NULL;
-
- if (nsPtr == NULL) {
- nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- }
-
- /*
- * Make the name of the ensemble into a fully qualified name. This might
- * allocate a temporary object.
- */
-
- if (!(name[0] == ':' && name[1] == ':')) {
- nameObj = Tcl_NewStringObj(nsPtr->fullName, -1);
- if (nsPtr->parentPtr == NULL) {
- Tcl_AppendStringsToObj(nameObj, name, NULL);
- } else {
- Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
- }
- Tcl_IncrRefCount(nameObj);
- name = TclGetString(nameObj);
- }
-
- ensemblePtr->nsPtr = nsPtr;
- ensemblePtr->epoch = 0;
- Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
- ensemblePtr->subcommandArrayPtr = NULL;
- ensemblePtr->subcmdList = NULL;
- ensemblePtr->subcommandDict = NULL;
- ensemblePtr->flags = flags;
- ensemblePtr->unknownHandler = NULL;
- ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
- NsEnsembleImplementationCmd, (ClientData)ensemblePtr,
- DeleteEnsembleConfig);
- ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
- nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
-
- /*
- * Trigger an eventual recomputation of the ensemble command set. Note
- * that this is slightly tricky, as it means that we are not actually
- * counting the number of namespace export actions, but it is the simplest
- * way to go!
- */
-
- nsPtr->exportLookupEpoch++;
-
- if (nameObj != NULL) {
- TclDecrRefCount(nameObj);
- }
- return ensemblePtr->token;
-}
-
-/*
- *----------------------------------------------------------------------
+ * NamespaceWhichCmd --
*
- * Tcl_SetEnsembleSubcommandList --
+ * Invoked to implement the "namespace which" command that returns the
+ * fully-qualified name of a command or variable. If the specified
+ * command or variable does not exist, it returns "". Handles the
+ * following syntax:
*
- * Set the subcommand list for a particular ensemble.
+ * namespace which ?-command? ?-variable? name
*
* Results:
- * Tcl result code (error if command token does not indicate an ensemble
- * or the subcommand list - if non-NULL - is not a list).
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
*
* Side effects:
- * The ensemble is updated and marked for recompilation.
+ * Returns a result in the interpreter's result object. If anything goes
+ * wrong, the result is an error message.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_SetEnsembleSubcommandList(interp, token, subcmdList)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj *subcmdList;
+static int
+NamespaceWhichCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
- Tcl_Obj *oldList;
+ static const char *const opts[] = {
+ "-command", "-variable", NULL
+ };
+ int lookupType = 0;
+ Tcl_Obj *resultPtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
+ if (objc < 2 || objc > 3) {
+ badArgs:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
return TCL_ERROR;
- }
- if (subcmdList != NULL) {
- int length;
- if (Tcl_ListObjLength(interp, subcmdList, &length) != TCL_OK) {
- return TCL_ERROR;
- }
- if (length < 1) {
- subcmdList = NULL;
- }
- }
-
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- oldList = ensemblePtr->subcmdList;
- ensemblePtr->subcmdList = subcmdList;
- if (subcmdList != NULL) {
- Tcl_IncrRefCount(subcmdList);
- }
- if (oldList != NULL) {
- TclDecrRefCount(oldList);
- }
-
- /*
- * Trigger an eventual recomputation of the ensemble command set. Note
- * that this is slightly tricky, as it means that we are not actually
- * counting the number of namespace export actions, but it is the simplest
- * way to go!
- */
-
- ensemblePtr->nsPtr->exportLookupEpoch++;
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetEnsembleMappingDict --
- *
- * Set the mapping dictionary for a particular ensemble.
- *
- * Results:
- * Tcl result code (error if command token does not indicate an ensemble
- * or the mapping - if non-NULL - is not a dict).
- *
- * Side effects:
- * The ensemble is updated and marked for recompilation.
- *
- *----------------------------------------------------------------------
- */
+ } else if (objc == 3) {
+ /*
+ * Look for a flag controlling the lookup.
+ */
-int
-Tcl_SetEnsembleMappingDict(interp, token, mapDict)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj *mapDict;
-{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
- Tcl_Obj *oldDict;
+ if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
+ &lookupType) != TCL_OK) {
+ /*
+ * Preserve old style of error message!
+ */
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
- return TCL_ERROR;
- }
- if (mapDict != NULL) {
- int size;
- if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
- return TCL_ERROR;
- }
- if (size < 1) {
- mapDict = NULL;
+ Tcl_ResetResult(interp);
+ goto badArgs;
}
}
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- oldDict = ensemblePtr->subcommandDict;
- ensemblePtr->subcommandDict = mapDict;
- if (mapDict != NULL) {
- Tcl_IncrRefCount(mapDict);
- }
- if (oldDict != NULL) {
- TclDecrRefCount(oldDict);
- }
-
- /*
- * Trigger an eventual recomputation of the ensemble command set. Note
- * that this is slightly tricky, as it means that we are not actually
- * counting the number of namespace export actions, but it is the simplest
- * way to go!
- */
-
- ensemblePtr->nsPtr->exportLookupEpoch++;
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetEnsembleUnknownHandler --
- *
- * Set the unknown handler for a particular ensemble.
- *
- * Results:
- * Tcl result code (error if command token does not indicate an ensemble
- * or the unknown handler - if non-NULL - is not a list).
- *
- * Side effects:
- * The ensemble is updated and marked for recompilation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_SetEnsembleUnknownHandler(interp, token, unknownList)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj *unknownList;
-{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
- Tcl_Obj *oldList;
+ TclNewObj(resultPtr);
+ switch (lookupType) {
+ case 0: { /* -command */
+ Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ if (cmd != NULL) {
+ Tcl_GetCommandFullName(interp, cmd, resultPtr);
}
- return TCL_ERROR;
+ break;
}
- if (unknownList != NULL) {
- int length;
+ case 1: { /* -variable */
+ Tcl_Var var = Tcl_FindNamespaceVar(interp,
+ TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
- if (Tcl_ListObjLength(interp, unknownList, &length) != TCL_OK) {
- return TCL_ERROR;
- }
- if (length < 1) {
- unknownList = NULL;
+ if (var != NULL) {
+ Tcl_GetVariableFullName(interp, var, resultPtr);
}
+ break;
}
-
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- oldList = ensemblePtr->unknownHandler;
- ensemblePtr->unknownHandler = unknownList;
- if (unknownList != NULL) {
- Tcl_IncrRefCount(unknownList);
- }
- if (oldList != NULL) {
- TclDecrRefCount(oldList);
}
-
- /*
- * Trigger an eventual recomputation of the ensemble command set. Note
- * that this is slightly tricky, as it means that we are not actually
- * counting the number of namespace export actions, but it is the simplest
- * way to go!
- */
-
- ensemblePtr->nsPtr->exportLookupEpoch++;
-
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_SetEnsembleFlags --
+ * FreeNsNameInternalRep --
*
- * Set the flags for a particular ensemble.
+ * Frees the resources associated with a nsName object's internal
+ * representation.
*
* Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble).
+ * None.
*
* Side effects:
- * The ensemble is updated and marked for recompilation.
+ * Decrements the ref count of any Namespace structure pointed to by the
+ * nsName's internal representation. If there are no more references to
+ * the namespace, it's structure will be freed.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_SetEnsembleFlags(interp, token, flags)
- Tcl_Interp *interp;
- Tcl_Command token;
- int flags;
+static void
+FreeNsNameInternalRep(
+ register Tcl_Obj *objPtr) /* nsName object with internal representation
+ * to free. */
{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
+ ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
- return TCL_ERROR;
- }
-
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
/*
- * This API refuses to set the ENS_DEAD flag...
- */
- ensemblePtr->flags &= ENS_DEAD;
- ensemblePtr->flags |= flags & ~ENS_DEAD;
-
- /*
- * Trigger an eventual recomputation of the ensemble command set. Note
- * that this is slightly tricky, as it means that we are not actually
- * counting the number of namespace export actions, but it is the simplest
- * way to go!
+ * Decrement the reference count of the namespace. If there are no more
+ * references, free it up.
*/
- ensemblePtr->nsPtr->exportLookupEpoch++;
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleSubcommandList --
- *
- * Get the list of subcommands associated with a particular ensemble.
- *
- * Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble). The list of subcommands is returned by updating the
- * variable pointed to by the last parameter (NULL if this is to be
- * derived from the mapping dictionary or the associated namespace's
- * exported commands).
- *
- * Side effects:
- * None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleSubcommandList(interp, token, subcmdListPtr)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj **subcmdListPtr;
-{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
+ resNamePtr->refCount--;
+ if (resNamePtr->refCount == 0) {
+ /*
+ * Decrement the reference count for the cached namespace. If the
+ * namespace is dead, and there are no more references to it, free
+ * it.
+ */
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
- return TCL_ERROR;
+ TclNsDecrRefCount(resNamePtr->nsPtr);
+ ckfree(resNamePtr);
}
-
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- *subcmdListPtr = ensemblePtr->subcmdList;
- return TCL_OK;
+ objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetEnsembleMappingDict --
+ * DupNsNameInternalRep --
*
- * Get the command mapping dictionary associated with a particular
- * ensemble.
+ * Initializes the internal representation of a nsName object to a copy
+ * of the internal representation of another nsName object.
*
* Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble). The mapping dict is returned by updating the variable
- * pointed to by the last parameter (NULL if none is installed).
+ * None.
*
* Side effects:
- * None
+ * copyPtr's internal rep is set to refer to the same namespace
+ * referenced by srcPtr's internal rep. Increments the ref count of the
+ * ResolvedNsName structure used to hold the namespace reference.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_GetEnsembleMappingDict(interp, token, mapDictPtr)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj **mapDictPtr;
+static void
+DupNsNameInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
+ ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
- return TCL_ERROR;
- }
-
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- *mapDictPtr = ensemblePtr->subcommandDict;
- return TCL_OK;
+ copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
+ resNamePtr->refCount++;
+ copyPtr->typePtr = &nsNameType;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetEnsembleUnknownHandler --
+ * SetNsNameFromAny --
*
- * Get the unknown handler associated with a particular ensemble.
+ * Attempt to generate a nsName internal representation for a Tcl object.
*
* Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble). The unknown handler is returned by updating the variable
- * pointed to by the last parameter (NULL if no handler is installed).
+ * Returns TCL_OK if the value could be converted to a proper namespace
+ * reference. Otherwise, it returns TCL_ERROR, along with an error
+ * message in the interpreter's result object.
*
* Side effects:
- * None
+ * If successful, the object is made a nsName object. Its internal rep is
+ * set to point to a ResolvedNsName, which contains a cached pointer to
+ * the Namespace. Reference counts are kept on both the ResolvedNsName
+ * and the Namespace, so we can keep track of their usage and free them
+ * when appropriate.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_GetEnsembleUnknownHandler(interp, token, unknownListPtr)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Obj **unknownListPtr;
+static int
+SetNsNameFromAny(
+ Tcl_Interp *interp, /* Points to the namespace in which to resolve
+ * name. Also used for error reporting if not
+ * NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
+ const char *dummy;
+ Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
+ register ResolvedNsName *resNamePtr;
+ const char *name;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
+ if (interp == NULL) {
return TCL_ERROR;
}
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- *unknownListPtr = ensemblePtr->unknownHandler;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleFlags --
- *
- * Get the flags for a particular ensemble.
- *
- * Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble). The flags are returned by updating the variable pointed to
- * by the last parameter.
- *
- * Side effects:
- * None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleFlags(interp, token, flagsPtr)
- Tcl_Interp *interp;
- Tcl_Command token;
- int *flagsPtr;
-{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
-
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
- }
- return TCL_ERROR;
- }
+ name = TclGetString(objPtr);
+ TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
+ &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- *flagsPtr = ensemblePtr->flags;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleNamespace --
- *
- * Get the namespace associated with a particular ensemble.
- *
- * Results:
- * Tcl result code (error if command token does not indicate an
- * ensemble). Namespace is returned by updating the variable pointed to
- * by the last parameter.
- *
- * Side effects:
- * None
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * If we found a namespace, then create a new ResolvedNsName structure
+ * that holds a reference to it.
+ */
-int
-Tcl_GetEnsembleNamespace(interp, token, namespacePtrPtr)
- Tcl_Interp *interp;
- Tcl_Command token;
- Tcl_Namespace **namespacePtrPtr;
-{
- Command *cmdPtr = (Command *) token;
- EnsembleConfig *ensemblePtr;
+ if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+ /*
+ * Our failed lookup proves any previously cached nsName intrep is no
+ * longer valid. Get rid of it so we no longer waste memory storing
+ * it, nor time determining its invalidity again and again.
+ */
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ if (objPtr->typePtr == &nsNameType) {
+ TclFreeIntRep(objPtr);
}
return TCL_ERROR;
}
- ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
- *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
+ nsPtr->refCount++;
+ resNamePtr = ckalloc(sizeof(ResolvedNsName));
+ resNamePtr->nsPtr = nsPtr;
+ if ((name[0] == ':') && (name[1] == ':')) {
+ resNamePtr->refNsPtr = NULL;
+ } else {
+ resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ }
+ resNamePtr->refCount = 1;
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
+ objPtr->typePtr = &nsNameType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_FindEnsemble --
+ * TclGetNamespaceCommandTable --
*
- * Given a command name, get the ensemble token for it, allowing for
- * [namespace import]s. [Bug 1017022]
+ * Returns the hash table of commands.
*
* Results:
- * The token for the ensemble command with the given name, or NULL if the
- * command either does not exist or is not an ensemble (when an error
- * message will be written into the interp if thats non-NULL).
+ * Pointer to the hash table.
*
* Side effects:
- * None
+ * None.
*
*----------------------------------------------------------------------
*/
-Tcl_Command
-Tcl_FindEnsemble(interp, cmdNameObj, flags)
- Tcl_Interp *interp; /* Where to do the lookup, and where to write
- * the errors if TCL_LEAVE_ERR_MSG is set in
- * the flags. */
- Tcl_Obj *cmdNameObj; /* Name of command to look up. */
- int flags; /* Either 0 or TCL_LEAVE_ERR_MSG; other flags
- * are probably not useful. */
+Tcl_HashTable *
+TclGetNamespaceCommandTable(
+ Tcl_Namespace *nsPtr)
{
- Command *cmdPtr;
-
- cmdPtr = (Command *)
- Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
- if (cmdPtr == NULL) {
- return NULL;
- }
-
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- /*
- * Reuse existing infrastructure for following import link chains
- * rather than duplicating it.
- */
-
- cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
-
- if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
- "\" is not an ensemble command", NULL);
- }
- return NULL;
- }
- }
-
- return (Tcl_Command) cmdPtr;
+ return &((Namespace *) nsPtr)->cmdTable;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_IsEnsemble --
+ * TclGetNamespaceChildTable --
*
- * Simple test for ensemble-hood that takes into account imported
- * ensemble commands as well.
+ * Returns the hash table of child namespaces.
*
* Results:
- * Boolean value
+ * Pointer to the hash table.
*
* Side effects:
- * None
+ * Might allocate memory.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_IsEnsemble(token)
- Tcl_Command token;
+Tcl_HashTable *
+TclGetNamespaceChildTable(
+ Tcl_Namespace *nsPtr)
{
- Command *cmdPtr = (Command *) token;
- if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
- return 1;
- }
- cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
- if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
- return 0;
- }
- return 1;
+ Namespace *nPtr = (Namespace *) nsPtr;
+#ifndef BREAK_NAMESPACE_COMPAT
+ return &nPtr->childTable;
+#else
+ if (nPtr->childTablePtr == NULL) {
+ nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
+ }
+ return nPtr->childTablePtr;
+#endif
}
/*
*----------------------------------------------------------------------
*
- * NsEnsembleImplementationCmd --
+ * TclLogCommandInfo --
*
- * Implements an ensemble of commands (being those exported by a
- * namespace other than the global namespace) as a command with the same
- * (short) name as the namespace in the parent namespace.
+ * 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. 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:
- * A standard Tcl result code. Will be TCL_ERROR if the command is not an
- * unambiguous prefix of any command exported by the ensemble's
- * namespace.
+ * None.
*
* Side effects:
- * Depends on the command within the namespace that gets executed. If the
- * ensemble itself returns TCL_ERROR, a descriptive error message will be
- * placed in the interpreter's result.
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
-static int
-NsEnsembleImplementationCmd(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+void
+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
+ * 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 */
{
- EnsembleConfig *ensemblePtr = (EnsembleConfig *) clientData;
- /* The ensemble itself. */
- Tcl_Obj **tempObjv; /* Space used to construct the list of
- * arguments to pass to the command that
- * implements the ensemble subcommand. */
- int result; /* The result of the subcommand execution. */
- Tcl_Obj *prefixObj; /* An object containing the prefix words of
- * the command that implements the
- * subcommand. */
- Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully
- * specified but not yet cached command
- * names. */
- Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
- * target command prefix. */
- int prefixObjc; /* Size of prefixObjv of course! */
- int reparseCount = 0; /* Number of reparses. */
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
- return TCL_ERROR;
- }
-
- restartEnsembleParse:
- if (ensemblePtr->nsPtr->flags & NS_DEAD) {
- /*
- * Don't know how we got here, but make things give up quickly.
- */
-
- if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
- "ensemble activated for deleted namespace", NULL);
- }
- return TCL_ERROR;
- }
+ register const char *p;
+ Interp *iPtr = (Interp *) interp;
+ int overflow, limit = 150;
+ Var *varPtr, *arrayPtr;
- if (ensemblePtr->epoch != ensemblePtr->nsPtr->exportLookupEpoch) {
- ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
- BuildEnsembleConfig(ensemblePtr);
- } else {
+ if (iPtr->flags & ERR_ALREADY_LOGGED) {
/*
- * Table of subcommands is still valid; therefore there might be a
- * valid cache of discovered information which we can reuse. Do the
- * check here, and if we're still valid, we can jump straight to the
- * part where we do the invocation of the subcommand.
+ * Someone else has already logged error information for this command;
+ * we shouldn't add anything more.
*/
- if (objv[1]->typePtr == &ensembleCmdType) {
- EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)
- objv[1]->internalRep.otherValuePtr;
- if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
- ensembleCmd->epoch == ensemblePtr->epoch &&
- ensembleCmd->token == ensemblePtr->token) {
- prefixObj = ensembleCmd->realPrefixObj;
- Tcl_IncrRefCount(prefixObj);
- goto runResultingSubcommand;
- }
- }
+ return;
}
- /*
- * Look in the hashtable for the subcommand name; this is the fastest way
- * of all.
- */
-
- hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
- TclGetString(objv[1]));
- if (hPtr != NULL) {
- char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
- prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-
- /*
- * Cache for later in the subcommand object.
- */
-
- MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
- } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
- /*
- * Can't find and we are prohibited from using unambiguous prefixes.
- */
-
- goto unknownOrAmbiguousSubcommand;
- } else {
+ if (command != NULL) {
/*
- * If we've not already confirmed the command with the hash as part of
- * building our export table, we need to scan the sorted array for
- * matches.
+ * Compute the line number where the error occurred.
*/
- char *subcmdName; /* Name of the subcommand, or unique prefix of
- * it (will be an error for a non-unique
- * prefix). */
- char *fullName = NULL; /* Full name of the subcommand. */
- int stringLength, i;
- int tableLength = ensemblePtr->subcommandTable.numEntries;
-
- subcmdName = TclGetString(objv[1]);
- stringLength = objv[1]->length;
- for (i=0 ; i<tableLength ; i++) {
- register int cmp = strncmp(subcmdName,
- ensemblePtr->subcommandArrayPtr[i],
- (unsigned) stringLength);
- if (cmp == 0) {
- if (fullName != NULL) {
- /*
- * Since there's never the exact-match case to worry about
- * (hash search filters this), getting here indicates that
- * our subcommand is an ambiguous prefix of (at least) two
- * exported subcommands, which is an error case.
- */
-
- goto unknownOrAmbiguousSubcommand;
- }
- fullName = ensemblePtr->subcommandArrayPtr[i];
- } else if (cmp < 0) {
- /*
- * Because we are searching a sorted table, we can now stop
- * searching because we have gone past anything that could
- * possibly match.
- */
-
- break;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
}
}
- if (fullName == NULL) {
- /*
- * The subcommand is not a prefix of anything, so bail out!
- */
- goto unknownOrAmbiguousSubcommand;
- }
- hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
- if (hPtr == NULL) {
- Tcl_Panic("full name %s not found in supposedly synchronized hash",
- fullName);
+ if (length < 0) {
+ length = strlen(command);
}
- prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-
- /*
- * Cache for later in the subcommand object.
- */
-
- MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
- }
-
- /*
- * Do the real work of execution of the subcommand by building an array of
- * objects (note that this is potentially not the same length as the
- * number of arguments to this ensemble command), populating it and then
- * feeding it back through the main command-lookup engine. In theory, we
- * could look up the command in the namespace ourselves, as we already
- * have the namespace in which it is guaranteed to exist, but we don't do
- * that (the cacheing of the command object used should help with that.)
- */
-
- Tcl_IncrRefCount(prefixObj);
- runResultingSubcommand:
- {
- Interp *iPtr = (Interp *) interp;
- int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-
- Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
- if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 2;
- iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
- } else {
- int ni = iPtr->ensembleRewrite.numInsertedObjs;
- if (ni < 2) {
- iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 1;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 2;
- }
- }
- tempObjv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *)*(objc-2+prefixObjc));
- memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
- result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
- TCL_EVAL_INVOKE);
- Tcl_DecrRefCount(prefixObj);
- ckfree((char *)tempObjv);
- if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = NULL;
- iPtr->ensembleRewrite.numRemovedObjs = 0;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
- }
- return result;
- }
-
- unknownOrAmbiguousSubcommand:
- /*
- * Have not been able to match the subcommand asked for with a real
- * subcommand that we export. See whether a handler has been registered
- * for dealing with this situation. Will only call (at most) once for any
- * particular ensemble invocation.
- */
-
- if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
- int paramc, i;
- Tcl_Obj **paramv, *unknownCmd, *ensObj;
-
- unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
- TclNewObj(ensObj);
- Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
- Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
- for (i=1 ; i<objc ; i++) {
- Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
- }
- Tcl_ListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
- Tcl_Preserve(ensemblePtr);
- Tcl_IncrRefCount(unknownCmd);
- result = Tcl_EvalObjv(interp, paramc, paramv, 0);
- if (result == TCL_OK) {
- prefixObj = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(prefixObj);
- Tcl_DecrRefCount(unknownCmd);
- Tcl_Release(ensemblePtr);
- Tcl_ResetResult(interp);
- if (ensemblePtr->flags & ENS_DEAD) {
- Tcl_DecrRefCount(prefixObj);
- Tcl_SetResult(interp,
- "unknown subcommand handler deleted its ensemble",
- TCL_STATIC);
- return TCL_ERROR;
- }
+ 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,
+ NULL, 0, 0, &arrayPtr);
+ if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
/*
- * Namespace is still there. Check if the result is a valid list.
- * If it is, and it is non-empty, that list is what we are using
- * as our replacement.
+ * Should not happen.
*/
- if (Tcl_ListObjLength(interp, prefixObj, &prefixObjc) != TCL_OK) {
- Tcl_DecrRefCount(prefixObj);
- Tcl_AddErrorInfo(interp,
- "\n while parsing result of ensemble unknown subcommand handler");
- return TCL_ERROR;
- }
- if (prefixObjc > 0) {
- goto runResultingSubcommand;
- }
+ return;
+ } else {
+ Tcl_HashEntry *hPtr
+ = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+ VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
- /*
- * Namespace alive & empty result => reparse.
- */
+ 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_DecrRefCount(prefixObj);
- goto restartEnsembleParse;
- }
- if (!Tcl_InterpDeleted(interp)) {
- if (result != TCL_ERROR) {
- Tcl_ResetResult(interp);
- Tcl_SetResult(interp,
- "unknown subcommand handler returned bad code: ",
- TCL_STATIC);
- switch (result) {
- case TCL_RETURN:
- Tcl_AppendResult(interp, "return", NULL);
- break;
- case TCL_BREAK:
- Tcl_AppendResult(interp, "break", NULL);
- break;
- case TCL_CONTINUE:
- Tcl_AppendResult(interp, "continue", NULL);
- break;
- default: {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "%d", result);
- Tcl_AppendResult(interp, buf, NULL);
- }
- }
- Tcl_AddErrorInfo(interp,
- "\n result of ensemble unknown subcommand handler: ");
- Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
- } else {
- Tcl_AddErrorInfo(interp,
- "\n (ensemble unknown subcommand handler)");
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
+ TCL_GLOBAL_ONLY);
}
}
- Tcl_DecrRefCount(unknownCmd);
- Tcl_Release(ensemblePtr);
- return TCL_ERROR;
}
/*
- * Cannot determine what subcommand to hand off to, so generate a
- * (standard) failure message. Note the one odd case compared with
- * standard ensemble-like command, which is where a namespace has no
- * exported commands at all...
+ * TIP #348
*/
- Tcl_ResetResult(interp);
- if (ensemblePtr->subcommandTable.numEntries == 0) {
- Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
- "\": namespace ", ensemblePtr->nsPtr->fullName,
- " does not export any commands", NULL);
- return TCL_ERROR;
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
}
- Tcl_AppendResult(interp, "unknown ",
- (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
- "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
- if (ensemblePtr->subcommandTable.numEntries == 1) {
- Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
- } else {
- int i;
- for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
- Tcl_AppendResult(interp,
- ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
- }
- Tcl_AppendResult(interp, "or ",
- ensemblePtr->subcommandArrayPtr[i], NULL);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MakeCachedEnsembleCommand --
- *
- * Cache what we've computed so far; it's not nice to repeatedly copy
- * strings about. Note that to do this, we start by deleting any old
- * representation that there was (though if it was an out of date
- * ensemble rep, we can skip some of the deallocation process.)
- *
- * Results:
- * None
- *
- * Side effects:
- * Alters the internal representation of the first object parameter.
- *
- *----------------------------------------------------------------------
- */
-static void
-MakeCachedEnsembleCommand(objPtr, ensemblePtr, subcommandName, prefixObjPtr)
- Tcl_Obj *objPtr;
- EnsembleConfig *ensemblePtr;
- CONST char *subcommandName;
- Tcl_Obj *prefixObjPtr;
-{
- register EnsembleCmdRep *ensembleCmd;
- int length;
+ if (iPtr->resetErrorStack) {
+ int len;
+
+ iPtr->resetErrorStack = 0;
+ Tcl_ListObjLength(interp, iPtr->errorStack, &len);
- if (objPtr->typePtr == &ensembleCmdType) {
- ensembleCmd = (EnsembleCmdRep *) objPtr->internalRep.otherValuePtr;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- ensembleCmd->nsPtr->refCount--;
- if ((ensembleCmd->nsPtr->refCount == 0)
- && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
- NamespaceFree(ensembleCmd->nsPtr);
- }
- ckfree(ensembleCmd->fullSubcmdName);
- } else {
/*
- * Kill the old internal rep, and replace it with a brand new one of
- * our own.
+ * Reset while keeping the list intrep as much as possible.
*/
- TclFreeIntRep(objPtr);
- ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
- objPtr->internalRep.otherValuePtr = (VOID *) ensembleCmd;
- objPtr->typePtr = &ensembleCmdType;
- }
-
- /*
- * Populate the internal rep.
- */
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+ if (pc != NULL) {
+ Tcl_Obj *innerContext;
- ensembleCmd->nsPtr = ensemblePtr->nsPtr;
- ensembleCmd->epoch = ensemblePtr->epoch;
- ensembleCmd->token = ensemblePtr->token;
- ensemblePtr->nsPtr->refCount++;
- ensembleCmd->realPrefixObj = prefixObjPtr;
- length = strlen(subcommandName)+1;
- ensembleCmd->fullSubcmdName = ckalloc((unsigned) length);
- memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
- Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteEnsembleConfig --
- *
- * Destroys the data structure used to represent an ensemble. This is
- * called when the ensemble's command is deleted (which happens
- * automatically if the ensemble's namespace is deleted.) Maintainers
- * should note that ensembles should be deleted by deleting their
- * commands.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory is (eventually) deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DeleteEnsembleConfig(clientData)
- ClientData clientData;
-{
- EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
- Namespace *nsPtr = ensemblePtr->nsPtr;
- Tcl_HashSearch search;
- Tcl_HashEntry *hEnt;
-
- /*
- * Unlink from the ensemble chain if it has not been marked as having been
- * done already.
- */
-
- if (ensemblePtr->next != ensemblePtr) {
- EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;
- if (ensPtr == ensemblePtr) {
- nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
- } else {
- while (ensPtr != NULL) {
- if (ensPtr->next == ensemblePtr) {
- ensPtr->next = ensemblePtr->next;
- break;
- }
- ensPtr = ensPtr->next;
+ 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));
}
- }
-
- /*
- * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
- * whether disaster happened anyway.
- */
-
- ensemblePtr->flags |= ENS_DEAD;
-
- /*
- * Kill the pointer-containing fields.
- */
+ }
- if (ensemblePtr->subcommandTable.numEntries != 0) {
- ckfree((char *)ensemblePtr->subcommandArrayPtr);
- }
- hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
- while (hEnt != NULL) {
- Tcl_Obj *prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hEnt);
- Tcl_DecrRefCount(prefixObj);
- hEnt = Tcl_NextHashEntry(&search);
- }
- Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
- if (ensemblePtr->subcmdList != NULL) {
- Tcl_DecrRefCount(ensemblePtr->subcmdList);
- }
- if (ensemblePtr->subcommandDict != NULL) {
- Tcl_DecrRefCount(ensemblePtr->subcommandDict);
- }
- if (ensemblePtr->unknownHandler != NULL) {
- Tcl_DecrRefCount(ensemblePtr->unknownHandler);
- }
-
- /*
- * Arrange for the structure to be reclaimed. Note that this is complex
- * because we have to make sure that we can react sensibly when an
- * ensemble is deleted during the process of initialising the ensemble
- * (especially the unknown callback.)
- */
-
- Tcl_EventuallyFree((ClientData) ensemblePtr, TCL_DYNAMIC);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BuildEnsembleConfig --
- *
- * Create the internal data structures that describe how an ensemble
- * looks, being a hash mapping from the full command name to the Tcl list
- * that describes the implementation prefix words, and a sorted array of
- * all the full command names to allow for reasonably efficient
- * unambiguous prefix handling.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Reallocates and rebuilds the hash table and array stored at the
- * ensemblePtr argument. For large ensembles or large namespaces, this is
- * a potentially expensive operation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-BuildEnsembleConfig(ensemblePtr)
- EnsembleConfig *ensemblePtr;
-{
- Tcl_HashSearch search; /* Used for scanning the set of commands in
- * the namespace that backs up this
- * ensemble. */
- int i, j, isNew;
- Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
- Tcl_HashEntry *hPtr;
-
- if (hash->numEntries != 0) {
+ if (!iPtr->framePtr->objc) {
/*
- * Remove pre-existing table.
+ * Special frame, nothing to report.
*/
-
- Tcl_HashSearch search;
-
- ckfree((char *)ensemblePtr->subcommandArrayPtr);
- hPtr = Tcl_FirstHashEntry(hash, &search);
- while (hPtr != NULL) {
- Tcl_Obj *prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- Tcl_DecrRefCount(prefixObj);
- hPtr = Tcl_NextHashEntry(&search);
- }
- Tcl_DeleteHashTable(hash);
- Tcl_InitHashTable(hash, TCL_STRING_KEYS);
- }
-
- /*
- * See if we've got an export list. If so, we will only export exactly
- * those commands, which may be either implemented by the prefix in the
- * subcommandDict or mapped directly onto the namespace's commands.
- */
-
- if (ensemblePtr->subcmdList != NULL) {
- Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
- int subcmdc;
-
- Tcl_ListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
- &subcmdv);
- for (i=0 ; i<subcmdc ; i++) {
- char *name = TclGetString(subcmdv[i]);
-
- hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-
- /* Skip non-unique cases. */
- if (!isNew) {
- continue;
- }
-
- /*
- * Look in our dictionary (if present) for the command.
- */
-
- if (ensemblePtr->subcommandDict != NULL) {
- Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
- &target);
- if (target != NULL) {
- Tcl_SetHashValue(hPtr, (ClientData) target);
- Tcl_IncrRefCount(target);
- continue;
- }
- }
-
- /*
- * Not there, so map onto the namespace. Note in this case that we
- * do not guarantee that the command is actually there; that is
- * the programmer's responsibility (or [::unknown] of course).
- */
-
- cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
- if (ensemblePtr->nsPtr->parentPtr != NULL) {
- Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
- } else {
- Tcl_AppendStringsToObj(cmdObj, name, NULL);
- }
- cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
- Tcl_SetHashValue(hPtr, (ClientData) cmdPrefixObj);
- Tcl_IncrRefCount(cmdPrefixObj);
- }
- } else if (ensemblePtr->subcommandDict != NULL) {
+ } else if (iPtr->varFramePtr != iPtr->framePtr) {
/*
- * No subcmd list, but we do have a mapping dictionary so we should
- * use the keys of that. Convert the dictionary's contents into the
- * form required for the ensemble's internal hashtable.
+ * uplevel case, [lappend errorstack UP $relativelevel]
*/
- Tcl_DictSearch dictSearch;
- Tcl_Obj *keyObj, *valueObj;
- int done;
-
- Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
- &keyObj, &valueObj, &done);
- while (!done) {
- char *name = TclGetString(keyObj);
-
- hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
- Tcl_SetHashValue(hPtr, (ClientData) valueObj);
- Tcl_IncrRefCount(valueObj);
- Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
- }
- } else {
+ 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) {
/*
- * Discover what commands are actually exported by the namespace.
- * What we have is an array of patterns and a hash table whose keys
- * are the command names exported by the namespace (the contents do
- * not matter here.) We must find out what commands are actually
- * exported by filtering each command in the namespace against each of
- * the patterns in the export list. Note that we use an intermediate
- * hash table to make memory management easier, and because that makes
- * exact matching far easier too.
- *
- * Suggestion for future enhancement: compute the unique prefixes and
- * place them in the hash too, which should make for even faster
- * matching.
+ * normal case, [lappend errorstack CALL [info level 0]]
*/
- hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
- for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- char *nsCmdName = /* Name of command in namespace. */
- Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
-
- for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
- if (Tcl_StringMatch(nsCmdName,
- ensemblePtr->nsPtr->exportArrayPtr[i])) {
- hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
-
- /*
- * Remember, hash entries have a full reference to the
- * substituted part of the command (as a list) as their
- * content!
- */
-
- if (isNew) {
- Tcl_Obj *cmdObj, *cmdPrefixObj;
-
- TclNewObj(cmdObj);
- Tcl_AppendStringsToObj(cmdObj,
- ensemblePtr->nsPtr->fullName,
- (ensemblePtr->nsPtr->parentPtr ? "::" : ""),
- nsCmdName, NULL);
- cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
- Tcl_SetHashValue(hPtr, (ClientData) cmdPrefixObj);
- Tcl_IncrRefCount(cmdPrefixObj);
- }
- break;
- }
- }
- }
- }
-
- if (hash->numEntries == 0) {
- ensemblePtr->subcommandArrayPtr = NULL;
- return;
- }
-
- /*
- * Create a sorted array of all subcommands in the ensemble; hash tables
- * are all very well for a quick look for an exact match, but they can't
- * determine things like whether a string is a prefix of another (not
- * without lots of preparation anyway) and they're no good for when we're
- * generating the error message either.
- *
- * We do this by filling an array with the names (we use the hash keys
- * directly to save a copy, since any time we change the array we change
- * the hash too, and vice versa) and running quicksort over the array.
- */
-
- ensemblePtr->subcommandArrayPtr = (char **)
- ckalloc(sizeof(char *) * hash->numEntries);
-
- /*
- * Fill array from both ends as this makes us less likely to end up with
- * performance problems in qsort(), which is good. Note that doing this
- * makes this code much more opaque, but the naive alternatve:
- *
- * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
- * hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
- * ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
- * }
- *
- * can produce long runs of precisely ordered table entries when the
- * commands in the namespace are declared in a sorted fashion (an ordering
- * some people like) and the hashing functions (or the command names
- * themselves) are fairly unfortunate. By filling from both ends, it
- * requires active malice (and probably a debugger) to get qsort() to have
- * awful runtime behaviour.
- */
-
- i = 0;
- j = hash->numEntries;
- hPtr = Tcl_FirstHashEntry(hash, &search);
- while (hPtr != NULL) {
- ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
- hPtr = Tcl_NextHashEntry(&search);
- if (hPtr == NULL) {
- break;
- }
- ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
- hPtr = Tcl_NextHashEntry(&search);
- }
- if (hash->numEntries > 1) {
- qsort(ensemblePtr->subcommandArrayPtr, (unsigned)hash->numEntries,
- sizeof(char *), NsEnsembleStringOrder);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
+ iPtr->framePtr->objc, iPtr->framePtr->objv));
}
}
/*
*----------------------------------------------------------------------
*
- * NsEnsembleStringOrder --
+ * TclErrorStackResetIf --
*
- * Helper function to compare two pointers to two strings for use with
- * qsort().
- *
- * Results:
- * -1 if the first string is smaller, 1 if the second string is smaller,
- * and 0 if they are equal.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NsEnsembleStringOrder(strPtr1, strPtr2)
- CONST VOID *strPtr1, *strPtr2;
-{
- return strcmp(*(CONST char **)strPtr1, *(CONST char **)strPtr2);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeEnsembleCmdRep --
- *
- * Destroys the internal representation of a Tcl_Obj that has been
- * holding information about a command in an ensemble.
+ * The TIP 348 reset/no-bc part of TLCI, for specific use by
+ * TclCompileSyntaxError.
*
* Results:
* None.
*
* Side effects:
- * Memory is deallocated. If this held the last reference to a
- * namespace's main structure, that main structure will also be
- * destroyed.
+ * Reset errorstack if it needs be, and in that case remember the
+ * passed-in error message as inner context.
*
*----------------------------------------------------------------------
*/
-static void
-FreeEnsembleCmdRep(objPtr)
- Tcl_Obj *objPtr;
+void
+TclErrorStackResetIf(
+ Tcl_Interp *interp,
+ const char *msg,
+ int length)
{
- EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)
- objPtr->internalRep.otherValuePtr;
+ Interp *iPtr = (Interp *) interp;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- ckfree(ensembleCmd->fullSubcmdName);
- ensembleCmd->nsPtr->refCount--;
- if ((ensembleCmd->nsPtr->refCount == 0)
- && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
- NamespaceFree(ensembleCmd->nsPtr);
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
}
- ckfree((char *)ensembleCmd);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupEnsembleCmdRep --
- *
- * Makes one Tcl_Obj into a copy of another that is a subcommand of an
- * ensemble.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory is allocated, and the namespace that the ensemble is built on
- * top of gains another reference.
- *
- *----------------------------------------------------------------------
- */
+ if (iPtr->resetErrorStack) {
+ int len;
-static void
-DupEnsembleCmdRep(objPtr, copyPtr)
- Tcl_Obj *objPtr, *copyPtr;
-{
- EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)
- objPtr->internalRep.otherValuePtr;
- EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)
- ckalloc(sizeof(EnsembleCmdRep));
- int length = strlen(ensembleCmd->fullSubcmdName);
-
- copyPtr->typePtr = &ensembleCmdType;
- copyPtr->internalRep.otherValuePtr = (VOID *) ensembleCopy;
- ensembleCopy->nsPtr = ensembleCmd->nsPtr;
- ensembleCopy->epoch = ensembleCmd->epoch;
- ensembleCopy->token = ensembleCmd->token;
- ensembleCopy->nsPtr->refCount++;
- ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
- Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
- ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1);
- memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
- (unsigned) length+1);
+ 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));
+ }
}
/*
*----------------------------------------------------------------------
*
- * StringOfEnsembleCmdRep --
+ * Tcl_LogCommandInfo --
*
- * Creates a string representation of a Tcl_Obj that holds a subcommand
- * of an ensemble.
+ * 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:
- * The object gains a string (UTF-8) representation.
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
-static void
-StringOfEnsembleCmdRep(objPtr)
- Tcl_Obj *objPtr;
+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). */
{
- EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)
- objPtr->internalRep.otherValuePtr;
- int length = strlen(ensembleCmd->fullSubcmdName);
-
- objPtr->length = length;
- objPtr->bytes = ckalloc((unsigned) length+1);
- memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
+ TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}
+
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
* End:
*/
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index cb777af..e76bca8 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -13,13 +13,18 @@
*
* 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.19 2005/07/21 14:38:50 dkf Exp $
*/
#include "tclInt.h"
-extern TclStubs tclStubs;
+/*
+ * Module-scope struct of notifier hooks that are checked in the default
+ * notifier functions (for overriding via Tcl_SetNotifier).
+ */
+
+Tcl_NotifierProcs tclNotifierHooks = {
+ NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
+};
/*
* For each event source (created with Tcl_CreateEventSource) there is a
@@ -89,8 +94,8 @@ TCL_DECLARE_MUTEX(listLock)
* Declarations for routines used only in this file.
*/
-static void QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
- Tcl_Event* evPtr, Tcl_QueuePosition position));
+static void QueueEvent(ThreadSpecificData *tsdPtr,
+ Tcl_Event *evPtr, Tcl_QueuePosition position);
/*
*----------------------------------------------------------------------
@@ -110,7 +115,7 @@ static void QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
*/
void
-TclInitNotifier()
+TclInitNotifier(void)
{
ThreadSpecificData *tsdPtr;
Tcl_ThreadId threadId = Tcl_GetCurrentThread();
@@ -128,7 +133,7 @@ TclInitNotifier()
tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->threadId = threadId;
- tsdPtr->clientData = tclStubs.tcl_InitNotifier();
+ tsdPtr->clientData = Tcl_InitNotifier();
tsdPtr->initialized = 1;
tsdPtr->nextPtr = firstNotifierPtr;
firstNotifierPtr = tsdPtr;
@@ -162,7 +167,7 @@ TclInitNotifier()
*/
void
-TclFinalizeNotifier()
+TclFinalizeNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData **prevPtrPtr;
@@ -173,10 +178,10 @@ TclFinalizeNotifier()
}
Tcl_MutexLock(&(tsdPtr->queueMutex));
- for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
+ for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
hold = evPtr;
evPtr = evPtr->nextPtr;
- ckfree((char *) hold);
+ ckfree(hold);
}
tsdPtr->firstEventPtr = NULL;
tsdPtr->lastEventPtr = NULL;
@@ -184,9 +189,7 @@ TclFinalizeNotifier()
Tcl_MutexLock(&listLock);
- if (tclStubs.tcl_FinalizeNotifier) {
- tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
- }
+ Tcl_FinalizeNotifier(tsdPtr->clientData);
Tcl_MutexFinalize(&(tsdPtr->queueMutex));
for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
@@ -213,27 +216,17 @@ TclFinalizeNotifier()
* None.
*
* Side effects:
- * Overstomps part of the stub vector. This relies on hooks added to the
- * default functions in case those are called directly (i.e., not through
- * the stub table.)
+ * Set the tclNotifierHooks global, which is checked in the default
+ * notifier functions.
*
*----------------------------------------------------------------------
*/
void
-Tcl_SetNotifier(notifierProcPtr)
- Tcl_NotifierProcs *notifierProcPtr;
+Tcl_SetNotifier(
+ Tcl_NotifierProcs *notifierProcPtr)
{
-#if !defined(__WIN32__) /* UNIX */
- tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
- tclStubs.tcl_DeleteFileHandler = notifierProcPtr->deleteFileHandlerProc;
-#endif
- tclStubs.tcl_SetTimer = notifierProcPtr->setTimerProc;
- tclStubs.tcl_WaitForEvent = notifierProcPtr->waitForEventProc;
- tclStubs.tcl_InitNotifier = notifierProcPtr->initNotifierProc;
- tclStubs.tcl_FinalizeNotifier = notifierProcPtr->finalizeNotifierProc;
- tclStubs.tcl_AlertNotifier = notifierProcPtr->alertNotifierProc;
- tclStubs.tcl_ServiceModeHook = notifierProcPtr->serviceModeHookProc;
+ tclNotifierHooks = *notifierProcPtr;
}
/*
@@ -272,18 +265,18 @@ Tcl_SetNotifier(notifierProcPtr)
*/
void
-Tcl_CreateEventSource(setupProc, checkProc, clientData)
- Tcl_EventSetupProc *setupProc;
+Tcl_CreateEventSource(
+ Tcl_EventSetupProc *setupProc,
/* Function to invoke to figure out what to
* wait for. */
- Tcl_EventCheckProc *checkProc;
+ Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
- ClientData clientData; /* One-word argument to pass to setupProc and
+ ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
+ EventSource *sourcePtr = ckalloc(sizeof(EventSource));
sourcePtr->setupProc = setupProc;
sourcePtr->checkProc = checkProc;
@@ -304,21 +297,21 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
* None.
*
* Side effects:
- * The given event source is cancelled, so its function will never again
+ * The given event source is canceled, so its function will never again
* be called. If no such source exists, nothing happens.
*
*----------------------------------------------------------------------
*/
void
-Tcl_DeleteEventSource(setupProc, checkProc, clientData)
- Tcl_EventSetupProc *setupProc;
+Tcl_DeleteEventSource(
+ Tcl_EventSetupProc *setupProc,
/* Function to invoke to figure out what to
* wait for. */
- Tcl_EventCheckProc *checkProc;
+ Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
- ClientData clientData; /* One-word argument to pass to setupProc and
+ ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -337,7 +330,7 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
} else {
prevPtr->nextPtr = sourcePtr->nextPtr;
}
- ckfree((char *) sourcePtr);
+ ckfree(sourcePtr);
return;
}
}
@@ -359,16 +352,17 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
*/
void
-Tcl_QueueEvent(evPtr, position)
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+Tcl_QueueEvent(
+ Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
QueueEvent(tsdPtr, evPtr, position);
}
@@ -389,14 +383,14 @@ Tcl_QueueEvent(evPtr, position)
*/
void
-Tcl_ThreadQueueEvent(threadId, evPtr, position)
- Tcl_ThreadId threadId; /* Identifier for thread to use. */
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+Tcl_ThreadQueueEvent(
+ Tcl_ThreadId threadId, /* Identifier for thread to use. */
+ Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr;
@@ -417,6 +411,8 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
if (tsdPtr) {
QueueEvent(tsdPtr, evPtr, position);
+ } else {
+ ckfree(evPtr);
}
Tcl_MutexUnlock(&listLock);
}
@@ -443,15 +439,15 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
*/
static void
-QueueEvent(tsdPtr, evPtr, position)
- ThreadSpecificData *tsdPtr; /* Handle to thread local data that indicates
+QueueEvent(
+ ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates
* which event queue to use. */
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+ Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -518,32 +514,61 @@ QueueEvent(tsdPtr, evPtr, position)
*/
void
-Tcl_DeleteEvents(proc, clientData)
- Tcl_EventDeleteProc *proc; /* The function to call. */
- ClientData clientData; /* The type-specific data. */
+Tcl_DeleteEvents(
+ Tcl_EventDeleteProc *proc, /* The function to call. */
+ ClientData clientData) /* The type-specific data. */
{
- Tcl_Event *evPtr, *prevPtr, *hold;
+ Tcl_Event *evPtr; /* Pointer to the event being examined */
+ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if
+ * evPtr designates the first event in the
+ * queue for the thread. */
+ Tcl_Event *hold;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_MutexLock(&(tsdPtr->queueMutex));
- for (prevPtr = (Tcl_Event *) NULL, evPtr = tsdPtr->firstEventPtr;
- evPtr != (Tcl_Event *) NULL; /*EMPTY STEP*/) {
- if ((*proc) (evPtr, clientData) == 1) {
- if (tsdPtr->firstEventPtr == evPtr) {
+
+ /*
+ * Walk the queue of events for the thread, applying 'proc' to each to
+ * decide whether to eliminate the event.
+ */
+
+ prevPtr = NULL;
+ evPtr = tsdPtr->firstEventPtr;
+ while (evPtr != NULL) {
+ if (proc(evPtr, clientData) == 1) {
+ /*
+ * This event should be deleted. Unlink it.
+ */
+
+ if (prevPtr == NULL) {
tsdPtr->firstEventPtr = evPtr->nextPtr;
} else {
prevPtr->nextPtr = evPtr->nextPtr;
}
- if (evPtr->nextPtr == (Tcl_Event *) NULL) {
+
+ /*
+ * Update 'last' and 'marker' events if either has been deleted.
+ */
+
+ if (evPtr->nextPtr == NULL) {
tsdPtr->lastEventPtr = prevPtr;
}
if (tsdPtr->markerEventPtr == evPtr) {
tsdPtr->markerEventPtr = prevPtr;
}
+
+ /*
+ * Delete the event data structure.
+ */
+
hold = evPtr;
evPtr = evPtr->nextPtr;
- ckfree((char *) hold);
+ ckfree(hold);
} else {
+ /*
+ * Event is to be retained.
+ */
+
prevPtr = evPtr;
evPtr = evPtr->nextPtr;
}
@@ -572,8 +597,8 @@ Tcl_DeleteEvents(proc, clientData)
*/
int
-Tcl_ServiceEvent(flags)
- int flags; /* Indicates what events should be processed.
+Tcl_ServiceEvent(
+ int flags) /* Indicates what events should be processed.
* May be any combination of TCL_WINDOW_EVENTS
* TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
* flags defined elsewhere. Events not
@@ -592,7 +617,7 @@ Tcl_ServiceEvent(flags)
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
return 1;
}
@@ -642,7 +667,7 @@ Tcl_ServiceEvent(flags)
*/
Tcl_MutexUnlock(&(tsdPtr->queueMutex));
- result = (*proc)(evPtr, flags);
+ result = proc(evPtr, flags);
Tcl_MutexLock(&(tsdPtr->queueMutex));
if (result) {
@@ -677,7 +702,7 @@ Tcl_ServiceEvent(flags)
}
}
if (evPtr) {
- ckfree((char *) evPtr);
+ ckfree(evPtr);
}
Tcl_MutexUnlock(&(tsdPtr->queueMutex));
return 1;
@@ -711,7 +736,7 @@ Tcl_ServiceEvent(flags)
*/
int
-Tcl_GetServiceMode()
+Tcl_GetServiceMode(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -735,8 +760,8 @@ Tcl_GetServiceMode()
*/
int
-Tcl_SetServiceMode(mode)
- int mode; /* New service mode: TCL_SERVICE_ALL or
+Tcl_SetServiceMode(
+ int mode) /* New service mode: TCL_SERVICE_ALL or
* TCL_SERVICE_NONE */
{
int oldMode;
@@ -744,9 +769,7 @@ Tcl_SetServiceMode(mode)
oldMode = tsdPtr->serviceMode;
tsdPtr->serviceMode = mode;
- if (tclStubs.tcl_ServiceModeHook) {
- tclStubs.tcl_ServiceModeHook(mode);
- }
+ Tcl_ServiceModeHook(mode);
return oldMode;
}
@@ -770,8 +793,8 @@ Tcl_SetServiceMode(mode)
*/
void
-Tcl_SetMaxBlockTime(timePtr)
- Tcl_Time *timePtr; /* Specifies a maximum elapsed time for the
+Tcl_SetMaxBlockTime(
+ const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the
* next blocking operation in the event
* tsdPtr-> */
{
@@ -790,11 +813,7 @@ Tcl_SetMaxBlockTime(timePtr)
*/
if (!tsdPtr->inTraversal) {
- if (tsdPtr->blockTimeSet) {
- Tcl_SetTimer(&tsdPtr->blockTime);
- } else {
- Tcl_SetTimer(NULL);
- }
+ Tcl_SetTimer(&tsdPtr->blockTime);
}
}
@@ -822,8 +841,8 @@ Tcl_SetMaxBlockTime(timePtr)
*/
int
-Tcl_DoOneEvent(flags)
- int flags; /* Miscellaneous flag values: may be any
+Tcl_DoOneEvent(
+ int flags) /* Miscellaneous flag values: may be any
* combination of TCL_DONT_WAIT,
* TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
* TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
@@ -839,7 +858,7 @@ Tcl_DoOneEvent(flags)
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
return 1;
}
@@ -908,7 +927,7 @@ Tcl_DoOneEvent(flags)
for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->setupProc) {
- (sourcePtr->setupProc)(sourcePtr->clientData, flags);
+ sourcePtr->setupProc(sourcePtr->clientData, flags);
}
}
tsdPtr->inTraversal = 0;
@@ -937,7 +956,7 @@ Tcl_DoOneEvent(flags)
for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->checkProc) {
- (sourcePtr->checkProc)(sourcePtr->clientData, flags);
+ sourcePtr->checkProc(sourcePtr->clientData, flags);
}
}
@@ -1010,7 +1029,7 @@ Tcl_DoOneEvent(flags)
*/
int
-Tcl_ServiceAll()
+Tcl_ServiceAll(void)
{
int result = 0;
EventSource *sourcePtr;
@@ -1032,7 +1051,7 @@ Tcl_ServiceAll()
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
}
/*
@@ -1047,13 +1066,13 @@ Tcl_ServiceAll()
for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->setupProc) {
- (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
+ sourcePtr->setupProc(sourcePtr->clientData, TCL_ALL_EVENTS);
}
}
for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->checkProc) {
- (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
+ sourcePtr->checkProc(sourcePtr->clientData, TCL_ALL_EVENTS);
}
}
@@ -1092,8 +1111,8 @@ Tcl_ServiceAll()
*/
void
-Tcl_ThreadAlert(threadId)
- Tcl_ThreadId threadId; /* Identifier for thread to use. */
+Tcl_ThreadAlert(
+ Tcl_ThreadId threadId) /* Identifier for thread to use. */
{
ThreadSpecificData *tsdPtr;
@@ -1106,9 +1125,7 @@ Tcl_ThreadAlert(threadId)
Tcl_MutexLock(&listLock);
for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
if (tsdPtr->threadId == threadId) {
- if (tclStubs.tcl_AlertNotifier) {
- tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
- }
+ Tcl_AlertNotifier(tsdPtr->clientData);
break;
}
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
new file mode 100644
index 0000000..de00733
--- /dev/null
+++ b/generic/tclOO.c
@@ -0,0 +1,2977 @@
+/*
+ * tclOO.c --
+ *
+ * This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
+ *
+ * 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Commands in oo::define.
+ */
+
+static const struct {
+ const char *name;
+ Tcl_ObjCmdProc *objProc;
+ int flag;
+} defineCmds[] = {
+ {"constructor", TclOODefineConstructorObjCmd, 0},
+ {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
+ {"destructor", TclOODefineDestructorObjCmd, 0},
+ {"export", TclOODefineExportObjCmd, 0},
+ {"forward", TclOODefineForwardObjCmd, 0},
+ {"method", TclOODefineMethodObjCmd, 0},
+ {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
+ {"self", TclOODefineSelfObjCmd, 0},
+ {"unexport", TclOODefineUnexportObjCmd, 0},
+ {NULL, NULL, 0}
+}, objdefCmds[] = {
+ {"class", TclOODefineClassObjCmd, 1},
+ {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
+ {"export", TclOODefineExportObjCmd, 1},
+ {"forward", TclOODefineForwardObjCmd, 1},
+ {"method", TclOODefineMethodObjCmd, 1},
+ {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
+ {"unexport", TclOODefineUnexportObjCmd, 1},
+ {NULL, NULL, 0}
+};
+
+/*
+ * What sort of size of things we like to allocate.
+ */
+
+#define ALLOC_CHUNK 8
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj);
+static Object * AllocObject(Tcl_Interp *interp, const char *nameStr,
+ const char *nsNameStr);
+static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
+ Method *mPtr, Tcl_Obj *namePtr,
+ Method **newMPtrPtr);
+static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
+ Method *mPtr, Tcl_Obj *namePtr);
+static void DeletedDefineNamespace(ClientData clientData);
+static void DeletedObjdefNamespace(ClientData clientData);
+static void DeletedHelpersNamespace(ClientData clientData);
+static int FinalizeAlloc(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int FinalizeNext(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int FinalizeObjectCall(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int InitFoundation(Tcl_Interp *interp);
+static void KillFoundation(ClientData clientData,
+ Tcl_Interp *interp);
+static void MyDeleted(ClientData clientData);
+static void ObjectNamespaceDeleted(ClientData clientData);
+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,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+static int PublicNRObjectCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+static int PrivateObjectCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+static int PrivateNRObjectCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+
+/*
+ * Methods in the oo::object and oo::class classes. First, we define a helper
+ * macro that makes building the method type declaration structure a lot
+ * easier. No point in making life harder than it has to be!
+ *
+ * Note that the core methods don't need clone or free proc callbacks.
+ */
+
+#define DCM(name,visibility,proc) \
+ {name,visibility,\
+ {TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}
+
+static const DeclaredClassMethod objMethods[] = {
+ DCM("destroy", 1, TclOO_Object_Destroy),
+ DCM("eval", 0, TclOO_Object_Eval),
+ DCM("unknown", 0, TclOO_Object_Unknown),
+ DCM("variable", 0, TclOO_Object_LinkVar),
+ DCM("varname", 0, TclOO_Object_VarName),
+ {NULL, 0, {0, NULL, NULL, NULL, NULL}}
+}, clsMethods[] = {
+ DCM("create", 1, TclOO_Class_Create),
+ DCM("new", 1, TclOO_Class_New),
+ DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
+ {NULL, 0, {0, NULL, NULL, NULL, NULL}}
+};
+
+/*
+ * 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;
+
+/*
+ * Convenience macro for getting the foundation from an interpreter.
+ */
+
+#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))
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInit --
+ *
+ * Called to initialise the OO system within an interpreter.
+ *
+ * Result:
+ * TCL_OK if the setup succeeded. Currently assumed to always work.
+ *
+ * Side effects:
+ * Creates namespaces, commands, several classes and a number of
+ * callbacks. Upon return, the OO system is ready for use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOInit(
+ Tcl_Interp *interp) /* The interpreter to install into. */
+{
+ /*
+ * Build the core of the OO system.
+ */
+
+ if (InitFoundation(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Run our initialization script and, if that works, declare the package
+ * to be fully provided.
+ */
+
+ if (Tcl_Eval(interp, initScript) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
+ (ClientData) &tclOOStubs);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetFoundation --
+ *
+ * Get a reference to the OO core class system.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Foundation *
+TclOOGetFoundation(
+ Tcl_Interp *interp)
+{
+ return GetFoundation(interp);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitFoundation --
+ *
+ * Set up the core of the OO core class system. This is a structure
+ * holding references to the magical bits that need to be known about in
+ * other places, plus the oo::object and oo::class classes.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InitFoundation(
+ Tcl_Interp *interp)
+{
+ static Tcl_ThreadDataKey tsdKey;
+ ThreadLocalData *tsdPtr =
+ Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
+ Foundation *fPtr = ckalloc(sizeof(Foundation));
+ Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
+ Tcl_DString buffer;
+ Command *cmdPtr;
+ int i;
+
+ /*
+ * Initialize the structure that holds the OO system core. This is
+ * attached to the interpreter via an assocData entry; not very efficient,
+ * but the best we can do without hacking the core more.
+ */
+
+ memset(fPtr, 0, sizeof(Foundation));
+ ((Interp *) interp)->objectFoundation = fPtr;
+ fPtr->interp = interp;
+ fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
+ Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
+ fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
+ DeletedDefineNamespace);
+ fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
+ DeletedObjdefNamespace);
+ fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
+ DeletedHelpersNamespace);
+ fPtr->epoch = 0;
+ fPtr->tsdPtr = tsdPtr;
+ 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_IncrRefCount(fPtr->clonedName);
+ Tcl_IncrRefCount(fPtr->defineName);
+ Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
+ TclOOUnknownDefinition, NULL, NULL);
+ TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
+ Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
+ Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);
+
+ /*
+ * Create the subcommands in the oo::define and oo::objdefine spaces.
+ */
+
+ Tcl_DStringInit(&buffer);
+ for (i=0 ; defineCmds[i].name ; i++) {
+ 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++) {
+ 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);
+ Tcl_DStringFree(&buffer);
+ }
+
+ Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
+
+ /*
+ * Create the objects at the core of the object system. These need to be
+ * spliced manually.
+ */
+
+ fPtr->objectCls = AllocClass(interp,
+ AllocObject(interp, "::oo::object", NULL));
+ fPtr->classCls = AllocClass(interp,
+ 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(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);
+ AddRef(fPtr->objectCls);
+
+ /*
+ * Basic method declarations for the core classes.
+ */
+
+ for (i=0 ; objMethods[i].name ; i++) {
+ TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
+ }
+ for (i=0 ; clsMethods[i].name ; i++) {
+ TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
+ }
+
+ /*
+ * 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.
+ */
+
+ TclNewLiteralStringObj(namePtr, "new");
+ Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
+ namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
+ 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]
+ * ensemble.
+ */
+
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+ NULL, TclOONextObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextCmd;
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+ NULL, TclOONextToObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextToCmd;
+ 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);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
+ *
+ * Simple helpers used to clear fields of the foundation when they no
+ * longer hold useful information.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeletedDefineNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->defineNs = NULL;
+}
+
+static void
+DeletedObjdefNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->objdefNs = NULL;
+}
+
+static void
+DeletedHelpersNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->helpersNs = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * KillFoundation --
+ *
+ * Delete those parts of the OO core that are not deleted automatically
+ * when the objects and classes themselves are destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+KillFoundation(
+ ClientData clientData, /* Pointer to the OO system foundation
+ * structure. */
+ Tcl_Interp *interp) /* The interpreter containing the OO system
+ * foundation. */
+{
+ Foundation *fPtr = GetFoundation(interp);
+
+ DelRef(fPtr->objectCls->thisPtr);
+ DelRef(fPtr->objectCls);
+ TclDecrRefCount(fPtr->unknownMethodNameObj);
+ TclDecrRefCount(fPtr->constructorName);
+ TclDecrRefCount(fPtr->destructorName);
+ TclDecrRefCount(fPtr->clonedName);
+ TclDecrRefCount(fPtr->defineName);
+ ckfree(fPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AllocObject --
+ *
+ * Allocate an object of basic type. Does not splice the object into its
+ * class's instance list.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Object *
+AllocObject(
+ Tcl_Interp *interp, /* Interpreter within which to create the
+ * object. */
+ const char *nameStr, /* The name of the object to create, or NULL
+ * if the OO system should pick the object
+ * name itself (equal to the namespace
+ * name). */
+ const char *nsNameStr) /* The name of the namespace to create, or
+ * NULL if the OO system should pick a unique
+ * name itself. If this is non-NULL but names
+ * a namespace that already exists, the effect
+ * will be the same as if this was NULL. */
+{
+ Foundation *fPtr = GetFoundation(interp);
+ Object *oPtr;
+ Command *cmdPtr;
+ CommandTrace *tracePtr;
+ int creationEpoch, ignored;
+
+ oPtr = ckalloc(sizeof(Object));
+ memset(oPtr, 0, sizeof(Object));
+
+ /*
+ * Every object has a namespace; make one. Note that this also normally
+ * computes the creation epoch value for the object, a sequence number
+ * that is unique to the object (and which allows us to manage method
+ * caching without comparing pointers).
+ *
+ * When creating a namespace, we first check to see if the caller
+ * specified the name for the namespace. If not, we generate namespace
+ * names using the epoch until such time as a new namespace is actually
+ * created.
+ */
+
+ if (nsNameStr != NULL) {
+ oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr,
+ ObjectNamespaceDeleted);
+ if (oPtr->namespacePtr != NULL) {
+ creationEpoch = ++fPtr->tsdPtr->nsCount;
+ goto configNamespace;
+ }
+ Tcl_ResetResult(interp);
+ }
+
+ while (1) {
+ char objName[10 + TCL_INTEGER_SPACE];
+
+ sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
+ oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr,
+ ObjectNamespaceDeleted);
+ if (oPtr->namespacePtr != NULL) {
+ creationEpoch = fPtr->tsdPtr->nsCount;
+ break;
+ }
+
+ /*
+ * Could not make that namespace, so we make another. But first we
+ * have to get rid of the error message from Tcl_CreateNamespace,
+ * since that's something that should not be exposed to the user.
+ */
+
+ Tcl_ResetResult(interp);
+ }
+
+ /*
+ * Make the namespace know about the helper commands. This grants access
+ * to the [self] and [next] commands.
+ */
+
+ configNamespace:
+ if (fPtr->helpersNs != NULL) {
+ TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
+ }
+ TclOOSetupVariableResolver(oPtr->namespacePtr);
+
+ /*
+ * Suppress use of compiled versions of the commands in this object's
+ * namespace and its children; causes wrong behaviour without expensive
+ * recompilation. [Bug 2037727]
+ */
+
+ ((Namespace *) oPtr->namespacePtr)->flags |= NS_SUPPRESS_COMPILATION;
+
+ /*
+ * Set up a callback to get notification of the deletion of a namespace
+ * when enough of the namespace still remains to execute commands and
+ * access variables in it. [Bug 2950259]
+ */
+
+ ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = SquelchedNsFirst;
+
+ /*
+ * Fill in the rest of the non-zero/NULL parts of the structure.
+ */
+
+ oPtr->fPtr = fPtr;
+ oPtr->selfCls = fPtr->objectCls;
+ oPtr->creationEpoch = creationEpoch;
+ oPtr->refCount = 1;
+ oPtr->flags = USE_CLASS_CACHE;
+
+ /*
+ * Finally, create the object commands and initialize the trace on the
+ * public command (so that the object structures are deleted when the
+ * command is deleted).
+ */
+
+ if (!nameStr) {
+ oPtr->command = Tcl_CreateObjCommand(interp,
+ oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
+ } else if (nameStr[0] == ':' && nameStr[1] == ':') {
+ oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
+ PublicObjectCmd, oPtr, NULL);
+ } else {
+ Tcl_DString buffer;
+
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer,
+ Tcl_GetCurrentNamespace(interp)->fullName, -1);
+ TclDStringAppendLiteral(&buffer, "::");
+ Tcl_DStringAppend(&buffer, nameStr, -1);
+ oPtr->command = Tcl_CreateObjCommand(interp,
+ Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
+ Tcl_DStringFree(&buffer);
+ }
+
+ /*
+ * Add the NRE command and trace directly. While this breaks a number of
+ * abstractions, it is faster and we're inside Tcl here so we're allowed.
+ */
+
+ cmdPtr = (Command *) oPtr->command;
+ cmdPtr->nreProc = PublicNRObjectCmd;
+ cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
+ tracePtr->traceProc = ObjectRenamedTrace;
+ tracePtr->clientData = oPtr;
+ tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
+ tracePtr->nextPtr = NULL;
+ tracePtr->refCount = 1;
+
+ /*
+ * Access the namespace command table directly when creating "my" to avoid
+ * a bottleneck in string manipulation. Another abstraction-buster.
+ */
+
+ cmdPtr = ckalloc(sizeof(Command));
+ memset(cmdPtr, 0, sizeof(Command));
+ cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
+ cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
+ &ignored);
+ cmdPtr->refCount = 1;
+ cmdPtr->objProc = PrivateObjectCmd;
+ cmdPtr->deleteProc = MyDeleted;
+ cmdPtr->objClientData = cmdPtr->deleteData = oPtr;
+ cmdPtr->proc = TclInvokeObjectCommand;
+ cmdPtr->clientData = cmdPtr;
+ cmdPtr->nreProc = PrivateNRObjectCmd;
+ Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr);
+ oPtr->myCommand = (Tcl_Command) cmdPtr;
+
+ return oPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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
+ * by any mechanism. It just marks the object as not having a [my]
+ * command, and so prevents cleanup of that when the object itself is
+ * deleted.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+MyDeleted(
+ ClientData clientData) /* Reference to the object whose [my] has been
+ * squelched. */
+{
+ register Object *oPtr = clientData;
+
+ oPtr->myCommand = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SquelchedNsFirst --
+ *
+ * This callback is triggered when the object's namespace is deleted by
+ * any mechanism. It deletes the object's public command if it has not
+ * already been deleted, so ensuring that destructors get run at an
+ * appropriate time. [Bug 2950259]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+SquelchedNsFirst(
+ ClientData clientData)
+{
+ Object *oPtr = clientData;
+
+ if (oPtr->command) {
+ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectRenamedTrace --
+ *
+ * This callback is triggered when the object is deleted by any
+ * mechanism. It runs the destructors and arranges for the actual cleanup
+ * of the object's namespace, which in turn triggers cleansing of the
+ * object data structures.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ObjectRenamedTrace(
+ ClientData clientData, /* The object being deleted. */
+ Tcl_Interp *interp, /* The interpreter containing the object. */
+ const char *oldName, /* What the object was (last) called. */
+ const char *newName, /* Always NULL. */
+ int flags) /* Why was the object deleted? */
+{
+ Object *oPtr = clientData;
+ Foundation *fPtr = oPtr->fPtr;
+
+ /*
+ * If this is a rename and not a delete of the object, we just flush the
+ * cache of the object name.
+ */
+
+ if (flags & TCL_TRACE_RENAME) {
+ SquelchCachedName(oPtr);
+ return;
+ }
+
+ /*
+ * Oh dear, the object really is being deleted. Handle this by running the
+ * destructors and deleting the object's namespace, which in turn causes
+ * the real object structures to be deleted.
+ *
+ * Note that it is possible for the namespace to be deleted before the
+ * command. Because of that case, we must take care here to mark the
+ * command as being deleted so that if we return here we don't run into
+ * reentrancy problems.
+ *
+ * We also do not run destructors on the core class objects when the
+ * interpreter is being deleted; their incestuous nature causes problems
+ * in that case when the destructor is partially deleted before the uses
+ * of it have gone. [Bug 2949397]
+ */
+
+ AddRef(oPtr);
+ AddRef(fPtr->classCls);
+ AddRef(fPtr->objectCls);
+ AddRef(fPtr->classCls->thisPtr);
+ AddRef(fPtr->objectCls->thisPtr);
+ oPtr->command = 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) {
+ contextPtr->callPtr->flags |= DESTRUCTOR;
+ contextPtr->skip = 0;
+ state = Tcl_SaveInterpState(interp, TCL_OK);
+ result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
+ contextPtr, 0, NULL);
+ if (result != TCL_OK) {
+ Tcl_BackgroundException(interp, result);
+ }
+ Tcl_RestoreInterpState(interp, state);
+ TclOODeleteContext(contextPtr);
+ }
+ }
+
+ /*
+ * OK, the destructor's been run. Time to splat the class data (if any)
+ * and nuke the namespace (which triggers the final crushing of the object
+ * structure itself).
+ *
+ * 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 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) && IsRootObject(oPtr)
+ && !Deleted(fPtr->classCls->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
+ }
+
+ if (oPtr->classPtr != NULL) {
+ AddRef(oPtr->classPtr);
+ ReleaseClassContents(interp, oPtr);
+ }
+
+ /*
+ * The namespace is only deleted if it hasn't already been deleted. [Bug
+ * 2950259]
+ */
+
+ if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
+ Tcl_DeleteNamespace(oPtr->namespacePtr);
+ }
+ if (oPtr->classPtr) {
+ DelRef(oPtr->classPtr);
+ }
+ DelRef(fPtr->classCls->thisPtr);
+ DelRef(fPtr->objectCls->thisPtr);
+ DelRef(fPtr->classCls);
+ DelRef(fPtr->objectCls);
+ DelRef(oPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ReleaseClassContents --
+ *
+ * Tear down the special class data structure, including deleting all
+ * dependent classes and objects.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ReleaseClassContents(
+ Tcl_Interp *interp, /* The interpreter containing the class. */
+ Object *oPtr) /* The object representing the class. */
+{
+ 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");
+ }
+ }
+
+ /*
+ * Lock a number of dependent objects until we've stopped putting our
+ * fingers in them.
+ */
+
+ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+ if (mixinSubclassPtr != NULL) {
+ AddRef(mixinSubclassPtr);
+ AddRef(mixinSubclassPtr->thisPtr);
+ }
+ }
+ FOREACH(subclassPtr, clsPtr->subclasses) {
+ if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
+ AddRef(subclassPtr);
+ AddRef(subclassPtr->thisPtr);
+ }
+ }
+ if (!IsRootClass(oPtr)) {
+ FOREACH(instancePtr, clsPtr->instances) {
+ if (instancePtr != NULL && !IsRoot(instancePtr)) {
+ AddRef(instancePtr);
+ }
+ }
+ }
+
+ /*
+ * Squelch classes that this class has been mixed into.
+ */
+
+ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+ if (mixinSubclassPtr == NULL) {
+ continue;
+ }
+ if (!Deleted(mixinSubclassPtr->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp,
+ mixinSubclassPtr->thisPtr->command);
+ }
+ DelRef(mixinSubclassPtr->thisPtr);
+ DelRef(mixinSubclassPtr);
+ }
+ if (clsPtr->mixinSubs.list != NULL) {
+ ckfree(clsPtr->mixinSubs.list);
+ clsPtr->mixinSubs.list = NULL;
+ clsPtr->mixinSubs.num = 0;
+ }
+
+ /*
+ * 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;
+ }
+
+ /*
+ * 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);
+ }
+ }
+ 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;
+ }
+ if (clsPtr->destructorChainPtr) {
+ TclOODeleteChain(clsPtr->destructorChainPtr);
+ clsPtr->destructorChainPtr = NULL;
+ }
+ if (clsPtr->classChainCache) {
+ CallChain *callPtr;
+
+ FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
+ TclOODeleteChain(callPtr);
+ }
+ Tcl_DeleteHashTable(clsPtr->classChainCache);
+ ckfree(clsPtr->classChainCache);
+ clsPtr->classChainCache = NULL;
+ }
+
+ /*
+ * Squelch our filter list.
+ */
+
+ if (clsPtr->filters.num) {
+ Tcl_Obj *filterObj;
+
+ FOREACH(filterObj, clsPtr->filters) {
+ TclDecrRefCount(filterObj);
+ }
+ ckfree(clsPtr->filters.list);
+ clsPtr->filters.num = 0;
+ }
+
+ /*
+ * Squelch our metadata.
+ */
+
+ if (clsPtr->metadataPtr != NULL) {
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value;
+
+ FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+ metadataTypePtr->deleteProc(value);
+ }
+ Tcl_DeleteHashTable(clsPtr->metadataPtr);
+ ckfree(clsPtr->metadataPtr);
+ clsPtr->metadataPtr = NULL;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectNamespaceDeleted --
+ *
+ * Callback when the object's namespace is deleted. Used to clean up the
+ * data structures associated with the object. The complicated bit is
+ * that this can sometimes happen before the object's command is deleted
+ * (interpreter teardown is complex!)
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ObjectNamespaceDeleted(
+ ClientData clientData) /* Pointer to the class whose namespace is
+ * being deleted. */
+{
+ Object *oPtr = clientData;
+ FOREACH_HASH_DECLS;
+ Class *clsPtr = oPtr->classPtr, *mixinPtr;
+ Method *mPtr;
+ Tcl_Obj *filterObj, *variableObj;
+ int i;
+
+ /*
+ * Instruct everyone to no longer use any allocated fields of the object.
+ * Also delete the commands that refer to the object at this point (if
+ * they still exist) because otherwise their references to the object
+ * point into freed memory, allowing crashes.
+ */
+
+ if (oPtr->command) {
+ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+ }
+ if (oPtr->myCommand) {
+ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
+ }
+
+ /*
+ * Splice the object out of its context. After this, we must *not* call
+ * methods on the object.
+ */
+
+ if (!IsRootObject(oPtr)) {
+ TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+ }
+
+ FOREACH(mixinPtr, oPtr->mixins) {
+ TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
+ if (i) {
+ ckfree(oPtr->mixins.list);
+ }
+
+ FOREACH(filterObj, oPtr->filters) {
+ TclDecrRefCount(filterObj);
+ }
+ if (i) {
+ ckfree(oPtr->filters.list);
+ }
+
+ if (oPtr->methodsPtr) {
+ FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
+ TclOODelMethodRef(mPtr);
+ }
+ Tcl_DeleteHashTable(oPtr->methodsPtr);
+ ckfree(oPtr->methodsPtr);
+ }
+
+ FOREACH(variableObj, oPtr->variables) {
+ TclDecrRefCount(variableObj);
+ }
+ if (i) {
+ ckfree(oPtr->variables.list);
+ }
+
+ if (oPtr->chainCache) {
+ TclOODeleteChainCache(oPtr->chainCache);
+ }
+
+ SquelchCachedName(oPtr);
+
+ if (oPtr->metadataPtr != NULL) {
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value;
+
+ FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
+ metadataTypePtr->deleteProc(value);
+ }
+ Tcl_DeleteHashTable(oPtr->metadataPtr);
+ ckfree(oPtr->metadataPtr);
+ oPtr->metadataPtr = NULL;
+ }
+
+ if (clsPtr != NULL) {
+ Class *superPtr;
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value;
+
+ if (clsPtr->metadataPtr != NULL) {
+ FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+ metadataTypePtr->deleteProc(value);
+ }
+ Tcl_DeleteHashTable(clsPtr->metadataPtr);
+ ckfree(clsPtr->metadataPtr);
+ clsPtr->metadataPtr = NULL;
+ }
+
+ FOREACH(filterObj, clsPtr->filters) {
+ TclDecrRefCount(filterObj);
+ }
+ if (i) {
+ ckfree(clsPtr->filters.list);
+ clsPtr->filters.num = 0;
+ }
+ FOREACH(mixinPtr, clsPtr->mixins) {
+ if (!Deleted(mixinPtr->thisPtr)) {
+ TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+ }
+ }
+ if (i) {
+ ckfree(clsPtr->mixins.list);
+ clsPtr->mixins.num = 0;
+ }
+ FOREACH(superPtr, clsPtr->superclasses) {
+ if (!Deleted(superPtr->thisPtr)) {
+ TclOORemoveFromSubclasses(clsPtr, superPtr);
+ }
+ }
+ if (i) {
+ ckfree(clsPtr->superclasses.list);
+ clsPtr->superclasses.num = 0;
+ }
+ if (clsPtr->subclasses.list) {
+ ckfree(clsPtr->subclasses.list);
+ clsPtr->subclasses.num = 0;
+ }
+ if (clsPtr->instances.list) {
+ ckfree(clsPtr->instances.list);
+ clsPtr->instances.num = 0;
+ }
+ if (clsPtr->mixinSubs.list) {
+ ckfree(clsPtr->mixinSubs.list);
+ clsPtr->mixinSubs.num = 0;
+ }
+
+ FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
+ TclOODelMethodRef(mPtr);
+ }
+ Tcl_DeleteHashTable(&clsPtr->classMethods);
+ TclOODelMethodRef(clsPtr->constructorPtr);
+ TclOODelMethodRef(clsPtr->destructorPtr);
+
+ FOREACH(variableObj, clsPtr->variables) {
+ TclDecrRefCount(variableObj);
+ }
+ if (i) {
+ ckfree(clsPtr->variables.list);
+ }
+
+ DelRef(clsPtr);
+ }
+
+ /*
+ * Delete the object structure itself.
+ */
+
+ DelRef(oPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromInstances --
+ *
+ * Utility function to remove an object from the list of instances within
+ * a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromInstances(
+ Object *oPtr, /* The instance to remove. */
+ Class *clsPtr) /* The class (possibly) containing the
+ * reference to the instance. */
+{
+ int i;
+ Object *instPtr;
+
+ FOREACH(instPtr, clsPtr->instances) {
+ if (oPtr == instPtr) {
+ goto removeInstance;
+ }
+ }
+ return;
+
+ removeInstance:
+ 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;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToInstances --
+ *
+ * Utility function to add an object to the list of instances within a
+ * class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToInstances(
+ Object *oPtr, /* The instance to add. */
+ Class *clsPtr) /* The class to add the instance to. It is
+ * 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 = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
+ } else {
+ clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
+ sizeof(Object *) * clsPtr->instances.size);
+ }
+ }
+ clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromSubclasses --
+ *
+ * Utility function to remove a class from the list of subclasses within
+ * another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromSubclasses(
+ Class *subPtr, /* The subclass to remove. */
+ Class *superPtr) /* The superclass to (possibly) remove the
+ * subclass reference from. */
+{
+ int i;
+ Class *subclsPtr;
+
+ FOREACH(subclsPtr, superPtr->subclasses) {
+ if (subPtr == subclsPtr) {
+ goto removeSubclass;
+ }
+ }
+ return;
+
+ removeSubclass:
+ 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;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToSubclasses --
+ *
+ * Utility function to add a class to the list of subclasses within
+ * another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToSubclasses(
+ Class *subPtr, /* The subclass to add. */
+ Class *superPtr) /* The superclass to add the subclass to. It
+ * 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 = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
+ } else {
+ superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
+ sizeof(Class *) * superPtr->subclasses.size);
+ }
+ }
+ superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromMixinSubs --
+ *
+ * Utility function to remove a class from the list of mixinSubs within
+ * another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromMixinSubs(
+ Class *subPtr, /* The subclass to remove. */
+ Class *superPtr) /* The superclass to (possibly) remove the
+ * subclass reference from. */
+{
+ int i;
+ Class *subclsPtr;
+
+ FOREACH(subclsPtr, superPtr->mixinSubs) {
+ if (subPtr == subclsPtr) {
+ goto removeSubclass;
+ }
+ }
+ return;
+
+ removeSubclass:
+ 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;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToMixinSubs --
+ *
+ * Utility function to add a class to the list of mixinSubs within
+ * another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToMixinSubs(
+ Class *subPtr, /* The subclass to add. */
+ Class *superPtr) /* The superclass to add the subclass to. It
+ * 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 = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+ } else {
+ superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
+ sizeof(Class *) * superPtr->mixinSubs.size);
+ }
+ }
+ superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AllocClass --
+ *
+ * Allocate a basic class. Does not splice the class object into its
+ * class's instance list.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Class *
+AllocClass(
+ Tcl_Interp *interp, /* Interpreter within which to allocate the
+ * class. */
+ Object *useThisObj) /* Object that is to act as the class
+ * representation, or NULL if a new object
+ * (with automatic name) is to be used. */
+{
+ Foundation *fPtr = GetFoundation(interp);
+ Class *clsPtr = ckalloc(sizeof(Class));
+
+ /*
+ * Make an object if we haven't been given one.
+ */
+
+ memset(clsPtr, 0, sizeof(Class));
+ if (useThisObj == NULL) {
+ clsPtr->thisPtr = AllocObject(interp, NULL, NULL);
+ } else {
+ clsPtr->thisPtr = useThisObj;
+ }
+
+ /*
+ * Configure the namespace path for the class's object.
+ */
+
+ if (fPtr->helpersNs != NULL) {
+ Tcl_Namespace *path[2];
+
+ path[0] = fPtr->helpersNs;
+ path[1] = fPtr->ooNs;
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
+ } else {
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
+ &fPtr->ooNs);
+ }
+
+ /*
+ * Class objects inherit from the class of classes unless they inherit
+ * from some subclass of it. Enforce this right now.
+ */
+
+ clsPtr->thisPtr->selfCls = fPtr->classCls;
+
+ /*
+ * Classes are subclasses of oo::object, i.e. the objects they create are
+ * objects.
+ */
+
+ clsPtr->superclasses.num = 1;
+ clsPtr->superclasses.list = ckalloc(sizeof(Class *));
+ clsPtr->superclasses.list[0] = fPtr->objectCls;
+
+ /*
+ * Finish connecting the class structure to the object structure.
+ */
+
+ clsPtr->thisPtr->classPtr = clsPtr;
+
+ /*
+ * That's the complicated bit. Now fill in the rest of the non-zero/NULL
+ * fields.
+ */
+
+ clsPtr->refCount = 1;
+ Tcl_InitObjHashTable(&clsPtr->classMethods);
+ return clsPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewObjectInstance --
+ *
+ * Allocate a new instance of an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_NewObjectInstance(
+ Tcl_Interp *interp, /* Interpreter context. */
+ Tcl_Class cls, /* Class to create an instance of. */
+ const char *nameStr, /* Name of object to create, or NULL to ask
+ * the code to pick its own unique name. */
+ const char *nsNameStr, /* Name of namespace to create inside object,
+ * or NULL to ask the code to pick its own
+ * unique name. */
+ int objc, /* Number of arguments. Negative value means
+ * do not call constructor. */
+ Tcl_Obj *const *objv, /* Argument list. */
+ int skip) /* Number of arguments to _not_ pass to the
+ * constructor. */
+{
+ register Class *classPtr = (Class *) cls;
+ Foundation *fPtr = GetFoundation(interp);
+ Object *oPtr;
+
+ /*
+ * Check if we're going to create an object over an existing command;
+ * that's not allowed.
+ */
+
+ if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
+ TCL_NAMESPACE_ONLY)) {
+ 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;
+ }
+
+ /*
+ * Create the object.
+ */
+
+ oPtr = AllocObject(interp, nameStr, nsNameStr);
+ oPtr->selfCls = classPtr;
+ TclOOAddToInstances(oPtr, classPtr);
+
+ /*
+ * Check to see if we're really creating a class. If so, allocate the
+ * class structure as well.
+ */
+
+ if (TclOOIsReachable(fPtr->classCls, classPtr)) {
+ /*
+ * Is a class, so attach a class structure. Note that the AllocClass
+ * function splices the structure into the object, so we don't have
+ * to. Once that's done, we need to repatch the object to have the
+ * right class since AllocClass interferes with that.
+ */
+
+ AllocClass(interp, oPtr);
+ oPtr->selfCls = classPtr;
+ TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
+ }
+
+ /*
+ * Run constructors, except when objc < 0 (a special flag case used for
+ * object cloning only).
+ */
+
+ if (objc >= 0) {
+ CallContext *contextPtr =
+ TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
+
+ if (contextPtr != NULL) {
+ int result;
+ Tcl_InterpState state;
+
+ 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);
+
+ /*
+ * It's an error if the object was whacked in the constructor.
+ * Force this if it isn't already an error (don't want to lose
+ * errors by accident...) [Bug 2903011]
+ */
+
+ 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);
+ if (result != TCL_OK) {
+ Tcl_DiscardInterpState(state);
+
+ /*
+ * Take care to not delete a deleted object; that would be
+ * bad. [Bug 2903011]
+ */
+
+ if (!Deleted(oPtr)) {
+ Tcl_DeleteCommandFromToken(interp, oPtr->command);
+ }
+ return NULL;
+ }
+ Tcl_RestoreInterpState(interp, state);
+ }
+ }
+
+ return (Tcl_Object) oPtr;
+}
+
+int
+TclNRNewObjectInstance(
+ Tcl_Interp *interp, /* Interpreter context. */
+ Tcl_Class cls, /* Class to create an instance of. */
+ const char *nameStr, /* Name of object to create, or NULL to ask
+ * the code to pick its own unique name. */
+ const char *nsNameStr, /* Name of namespace to create inside object,
+ * or NULL to ask the code to pick its own
+ * unique name. */
+ int objc, /* Number of arguments. Negative value means
+ * do not call constructor. */
+ Tcl_Obj *const *objv, /* Argument list. */
+ int skip, /* Number of arguments to _not_ pass to the
+ * constructor. */
+ Tcl_Object *objectPtr) /* Place to write the object reference upon
+ * successful allocation. */
+{
+ register Class *classPtr = (Class *) cls;
+ Foundation *fPtr = GetFoundation(interp);
+ CallContext *contextPtr;
+ Tcl_InterpState state;
+ Object *oPtr;
+
+ /*
+ * Check if we're going to create an object over an existing command;
+ * that's not allowed.
+ */
+
+ if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
+ TCL_NAMESPACE_ONLY)) {
+ 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;
+ }
+
+ /*
+ * Create the object.
+ */
+
+ oPtr = AllocObject(interp, nameStr, nsNameStr);
+ oPtr->selfCls = classPtr;
+ TclOOAddToInstances(oPtr, classPtr);
+
+ /*
+ * Check to see if we're really creating a class. If so, allocate the
+ * class structure as well.
+ */
+
+ if (TclOOIsReachable(fPtr->classCls, classPtr)) {
+ /*
+ * Is a class, so attach a class structure. Note that the AllocClass
+ * function splices the structure into the object, so we don't have
+ * to. Once that's done, we need to repatch the object to have the
+ * right class since AllocClass interferes with that.
+ */
+
+ AllocClass(interp, oPtr);
+ oPtr->selfCls = classPtr;
+ TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
+ }
+
+ /*
+ * Run constructors, except when objc < 0 (a special flag case used for
+ * object cloning only). If there aren't any constructors, we do nothing.
+ */
+
+ if (objc < 0) {
+ *objectPtr = (Tcl_Object) oPtr;
+ return TCL_OK;
+ }
+ contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
+ if (contextPtr == NULL) {
+ *objectPtr = (Tcl_Object) oPtr;
+ return TCL_OK;
+ }
+
+ 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);
+ return TclOOInvokeContext(contextPtr, interp, objc, objv);
+}
+
+static int
+FinalizeAlloc(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+ Object *oPtr = data[1];
+ Tcl_InterpState state = data[2];
+ Tcl_Object *objectPtr = data[3];
+
+ /*
+ * It's an error if the object was whacked in the constructor. Force this
+ * if it isn't already an error (don't want to lose errors by accident...)
+ * [Bug 2903011]
+ */
+
+ 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);
+ if (result != TCL_OK) {
+ Tcl_DiscardInterpState(state);
+
+ /*
+ * Take care to not delete a deleted object; that would be bad. [Bug
+ * 2903011]
+ */
+
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_CopyObjectInstance --
+ *
+ * Creates a copy of an object. Does not copy the backing namespace,
+ * since the correct way to do that (e.g., shallow/deep) depends on the
+ * object/class's own policies.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_CopyObjectInstance(
+ Tcl_Interp *interp,
+ Tcl_Object sourceObject,
+ const char *targetName,
+ const char *targetNamespaceName)
+{
+ Object *oPtr = (Object *) sourceObject, *o2Ptr;
+ FOREACH_HASH_DECLS;
+ Method *mPtr;
+ Class *mixinPtr;
+ CallContext *contextPtr;
+ Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
+ int i, result;
+
+ /*
+ * Sanity check.
+ */
+
+ 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;
+ }
+
+ /*
+ * Build the instance. Note that this does not run any constructors.
+ */
+
+ o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
+ (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1,
+ NULL, -1);
+ if (o2Ptr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Copy the object-local methods to the new object.
+ */
+
+ if (oPtr->methodsPtr) {
+ FOREACH_HASH(keyPtr, mPtr, oPtr->methodsPtr) {
+ if (CloneObjectMethod(interp, o2Ptr, mPtr, keyPtr) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+ }
+
+ /*
+ * Copy the object's mixin references to the new object.
+ */
+
+ FOREACH(mixinPtr, o2Ptr->mixins) {
+ if (mixinPtr != o2Ptr->selfCls) {
+ TclOORemoveFromInstances(o2Ptr, mixinPtr);
+ }
+ }
+ DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
+ FOREACH(mixinPtr, o2Ptr->mixins) {
+ if (mixinPtr != o2Ptr->selfCls) {
+ TclOOAddToInstances(o2Ptr, mixinPtr);
+ }
+ }
+
+ /*
+ * Copy the object's filter list to the new object.
+ */
+
+ DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
+ FOREACH(filterObj, o2Ptr->filters) {
+ Tcl_IncrRefCount(filterObj);
+ }
+
+ /*
+ * 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
+ * call.
+ */
+
+ o2Ptr->flags = oPtr->flags & ~(
+ OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+
+ /*
+ * Copy the object's metadata.
+ */
+
+ if (oPtr->metadataPtr != NULL) {
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value, duplicate;
+
+ FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
+ if (metadataTypePtr->cloneProc == NULL) {
+ duplicate = value;
+ } else {
+ if (metadataTypePtr->cloneProc(interp, value,
+ &duplicate) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+ if (duplicate != NULL) {
+ Tcl_ObjectSetMetadata((Tcl_Object) o2Ptr, metadataTypePtr,
+ duplicate);
+ }
+ }
+ }
+
+ /*
+ * Copy the class, if present. Note that if there is a class present in
+ * the source object, there must also be one in the copy.
+ */
+
+ if (oPtr->classPtr != NULL) {
+ Class *clsPtr = oPtr->classPtr;
+ Class *cls2Ptr = o2Ptr->classPtr;
+ Class *superPtr;
+
+ /*
+ * Copy the class flags across.
+ */
+
+ cls2Ptr->flags = clsPtr->flags;
+
+ /*
+ * Ensure that the new class's superclass structure is the same as the
+ * old class's.
+ */
+
+ FOREACH(superPtr, cls2Ptr->superclasses) {
+ TclOORemoveFromSubclasses(cls2Ptr, superPtr);
+ }
+ if (cls2Ptr->superclasses.num) {
+ cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
+ sizeof(Class *) * clsPtr->superclasses.num);
+ } else {
+ cls2Ptr->superclasses.list =
+ ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
+ }
+ memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
+ sizeof(Class *) * clsPtr->superclasses.num);
+ cls2Ptr->superclasses.num = clsPtr->superclasses.num;
+ FOREACH(superPtr, cls2Ptr->superclasses) {
+ TclOOAddToSubclasses(cls2Ptr, superPtr);
+ }
+
+ /*
+ * Duplicate the source class's filters.
+ */
+
+ DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
+ FOREACH(filterObj, cls2Ptr->filters) {
+ Tcl_IncrRefCount(filterObj);
+ }
+
+ /*
+ * 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).
+ */
+
+ FOREACH(mixinPtr, cls2Ptr->mixins) {
+ TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
+ }
+ if (cls2Ptr->mixins.num != 0) {
+ ckfree(clsPtr->mixins.list);
+ }
+ DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
+ FOREACH(mixinPtr, cls2Ptr->mixins) {
+ TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
+ }
+
+ /*
+ * Duplicate the source class's methods, constructor and destructor.
+ */
+
+ FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {
+ if (CloneClassMethod(interp, cls2Ptr, mPtr, keyPtr,
+ NULL) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+ if (clsPtr->constructorPtr) {
+ if (CloneClassMethod(interp, cls2Ptr, clsPtr->constructorPtr,
+ NULL, &cls2Ptr->constructorPtr) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+ if (clsPtr->destructorPtr) {
+ if (CloneClassMethod(interp, cls2Ptr, clsPtr->destructorPtr, NULL,
+ &cls2Ptr->destructorPtr) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+
+ /*
+ * Duplicate the class's metadata.
+ */
+
+ if (clsPtr->metadataPtr != NULL) {
+ Tcl_ObjectMetadataType *metadataTypePtr;
+ ClientData value, duplicate;
+
+ FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+ if (metadataTypePtr->cloneProc == NULL) {
+ duplicate = value;
+ } else {
+ if (metadataTypePtr->cloneProc(interp, value,
+ &duplicate) != TCL_OK) {
+ Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+ return NULL;
+ }
+ }
+ if (duplicate != NULL) {
+ Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
+ duplicate);
+ }
+ }
+ }
+ }
+
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * CloneObjectMethod, CloneClassMethod --
+ *
+ * Helper functions used for cloning methods. They work identically to
+ * each other, except for the difference between them in how they
+ * register the cloned method on a successful clone.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+CloneObjectMethod(
+ Tcl_Interp *interp,
+ Object *oPtr,
+ Method *mPtr,
+ Tcl_Obj *namePtr)
+{
+ if (mPtr->typePtr == NULL) {
+ Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ mPtr->flags & PUBLIC_METHOD, NULL, NULL);
+ } else if (mPtr->typePtr->cloneProc) {
+ ClientData newClientData;
+
+ if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
+ &newClientData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
+ } else {
+ Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData);
+ }
+ return TCL_OK;
+}
+
+static int
+CloneClassMethod(
+ Tcl_Interp *interp,
+ Class *clsPtr,
+ Method *mPtr,
+ Tcl_Obj *namePtr,
+ Method **m2PtrPtr)
+{
+ Method *m2Ptr;
+
+ if (mPtr->typePtr == NULL) {
+ m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
+ } else if (mPtr->typePtr->cloneProc) {
+ ClientData newClientData;
+
+ if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
+ &newClientData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
+ newClientData);
+ } else {
+ m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
+ mPtr->clientData);
+ }
+ if (m2PtrPtr != NULL) {
+ *m2PtrPtr = m2Ptr;
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_ObjectGetMetadata,
+ * Tcl_ObjectSetMetadata --
+ *
+ * Metadata management API. The metadata system allows code in extensions
+ * to attach arbitrary non-NULL pointers to objects and classes without
+ * the different things that might be interested being able to interfere
+ * with each other. Apart from non-NULL-ness, these routines attach no
+ * interpretation to the meaning of the metadata pointers.
+ *
+ * The Tcl_*GetMetadata routines get the metadata pointer attached that
+ * has been related with a particular type, or NULL if no metadata
+ * associated with the given type has been attached.
+ *
+ * The Tcl_*SetMetadata routines set or delete the metadata pointer that
+ * is related to a particular type. The value associated with the type is
+ * deleted (if present; no-op otherwise) if the value is NULL, and
+ * attached (replacing the previous value, which is deleted if present)
+ * otherwise. This means it is impossible to attach a NULL value for any
+ * metadata type.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_ClassGetMetadata(
+ Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr)
+{
+ Class *clsPtr = (Class *) clazz;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * If there's no metadata store attached, the type in question has
+ * definitely not been attached either!
+ */
+
+ if (clsPtr->metadataPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * There is a metadata store, so look in it for the given type.
+ */
+
+ hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
+
+ /*
+ * Return the metadata value if we found it, otherwise NULL.
+ */
+
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+void
+Tcl_ClassSetMetadata(
+ Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr,
+ ClientData metadata)
+{
+ Class *clsPtr = (Class *) clazz;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ /*
+ * Attach the metadata store if not done already.
+ */
+
+ if (clsPtr->metadataPtr == NULL) {
+ if (metadata == NULL) {
+ return;
+ }
+ clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * If the metadata is NULL, we're deleting the metadata for the type.
+ */
+
+ if (metadata == NULL) {
+ hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
+ if (hPtr != NULL) {
+ typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ return;
+ }
+
+ /*
+ * Otherwise we're attaching the metadata. Note that if there was already
+ * some metadata attached of this type, we delete that first.
+ */
+
+ hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew);
+ if (!isNew) {
+ typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+ }
+ Tcl_SetHashValue(hPtr, metadata);
+}
+
+ClientData
+Tcl_ObjectGetMetadata(
+ Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr)
+{
+ Object *oPtr = (Object *) object;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * If there's no metadata store attached, the type in question has
+ * definitely not been attached either!
+ */
+
+ if (oPtr->metadataPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * There is a metadata store, so look in it for the given type.
+ */
+
+ hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
+
+ /*
+ * Return the metadata value if we found it, otherwise NULL.
+ */
+
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+void
+Tcl_ObjectSetMetadata(
+ Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr,
+ ClientData metadata)
+{
+ Object *oPtr = (Object *) object;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ /*
+ * Attach the metadata store if not done already.
+ */
+
+ if (oPtr->metadataPtr == NULL) {
+ if (metadata == NULL) {
+ return;
+ }
+ oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * If the metadata is NULL, we're deleting the metadata for the type.
+ */
+
+ if (metadata == NULL) {
+ hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
+ if (hPtr != NULL) {
+ typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ return;
+ }
+
+ /*
+ * Otherwise we're attaching the metadata. Note that if there was already
+ * some metadata attached of this type, we delete that first.
+ */
+
+ hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew);
+ if (!isNew) {
+ typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+ }
+ Tcl_SetHashValue(hPtr, metadata);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
+ *
+ * Main entry point for object invokations. The Public* and Private*
+ * wrapper functions (implementations of both object instance commands
+ * and [my]) are just thin wrappers round the main TclOOObjectCmdCore
+ * function. Note that the core is function is NRE-aware.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+PublicObjectCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
+}
+
+static int
+PublicNRObjectCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
+ NULL);
+}
+
+static int
+PrivateObjectCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
+}
+
+static int
+PrivateNRObjectCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL);
+}
+
+int
+TclOOInvokeObject(
+ Tcl_Interp *interp, /* Interpreter for commands, variables,
+ * results, error reporting, etc. */
+ Tcl_Object object, /* The object to invoke. */
+ Tcl_Class startCls, /* Where in the class chain to start the
+ * invoke from, or NULL to traverse the whole
+ * chain including filters. */
+ int publicPrivate, /* Whether this is an invoke from a public
+ * context (PUBLIC_METHOD), a private context
+ * (PRIVATE_METHOD), or a *really* private
+ * context (any other value; conventionally
+ * 0). */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed
+ * that the name of the method to invoke will
+ * be at index 1. */
+{
+ switch (publicPrivate) {
+ case PUBLIC_METHOD:
+ return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
+ PUBLIC_METHOD, (Class *) startCls);
+ case PRIVATE_METHOD:
+ return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
+ PRIVATE_METHOD, (Class *) startCls);
+ default:
+ return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
+ (Class *) startCls);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectCmdCore, FinalizeObjectCall --
+ *
+ * Main function for object invokations. Does call chain creation,
+ * management and invokation. The function FinalizeObjectCall exists to
+ * clean up after the non-recursive processing of TclOOObjectCmdCore.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOObjectCmdCore(
+ Object *oPtr, /* The object being invoked. */
+ Tcl_Interp *interp, /* The interpreter containing the object. */
+ int objc, /* How many arguments are being passed in. */
+ Tcl_Obj *const *objv, /* The array of arguments. */
+ int flags, /* Whether this is an invokation through the
+ * public or the private command interface. */
+ Class *startCls) /* Where to start in the call chain, or NULL
+ * if we are to start at the front with
+ * filters and the object's methods (which is
+ * the normal case). */
+{
+ CallContext *contextPtr;
+ Tcl_Obj *methodNamePtr;
+ int result;
+
+ /*
+ * If we've no method name, throw this directly into the unknown
+ * processing.
+ */
+
+ if (objc < 2) {
+ flags |= FORCE_UNKNOWN;
+ methodNamePtr = NULL;
+ goto noMapping;
+ }
+
+ /*
+ * Give plugged in code a chance to remap the method name.
+ */
+
+ methodNamePtr = objv[1];
+ if (oPtr->mapMethodNameProc != NULL) {
+ register Class **startClsPtr = &startCls;
+ Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr);
+
+ result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
+ (Tcl_Class *) startClsPtr, mappedMethodName);
+ if (result != TCL_OK) {
+ TclDecrRefCount(mappedMethodName);
+ if (result == TCL_BREAK) {
+ goto noMapping;
+ } else if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\n (while mapping method name)");
+ }
+ return result;
+ }
+
+ /*
+ * Get the call chain for the remapped name.
+ */
+
+ Tcl_IncrRefCount(mappedMethodName);
+ contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
+ flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
+ TclDecrRefCount(mappedMethodName);
+ if (contextPtr == 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 {
+ /*
+ * Get the call chain.
+ */
+
+ noMapping:
+ contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
+ flags | (oPtr->flags & FILTER_HANDLING), NULL);
+ if (contextPtr == 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;
+ }
+ }
+
+ /*
+ * Check to see if we need to apply magical tricks to start part way
+ * through the call chain.
+ */
+
+ if (startCls != NULL) {
+ for (; contextPtr->index < contextPtr->callPtr->numChain;
+ contextPtr->index++) {
+ register struct MInvoke *miPtr =
+ &contextPtr->callPtr->chain[contextPtr->index];
+
+ if (miPtr->isFilter) {
+ continue;
+ }
+ if (miPtr->mPtr->declaringClassPtr == startCls) {
+ break;
+ }
+ }
+ if (contextPtr->index >= contextPtr->callPtr->numChain) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no valid method implementation", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(methodNamePtr), NULL);
+ TclOODeleteContext(contextPtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Invoke the call chain, locking the object structure against deletion
+ * for the duration.
+ */
+
+ TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
+ return TclOOInvokeContext(contextPtr, interp, objc, objv);
+}
+
+static int
+FinalizeObjectCall(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ /*
+ * Dispose of the call chain, which drops the lock on the object's
+ * structure.
+ */
+
+ TclOODeleteContext(data[0]);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext, FinalizeNext --
+ *
+ * Invokes the next stage of the call chain described in an object
+ * context. This is the core of the implementation of the [next] command.
+ * Does not do management of the call-frame stack. Available in public
+ * (standard API) and private (NRE-aware) forms. FinalizeNext is a
+ * private function used to clean up in the NRE case.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+Tcl_ObjectContextInvokeNext(
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv,
+ int skip)
+{
+ CallContext *contextPtr = (CallContext *) context;
+ int savedIndex = contextPtr->index;
+ int savedSkip = contextPtr->skip;
+ int result;
+
+ if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+ /*
+ * We're at the end of the chain; generate an error message unless the
+ * interpreter is being torn down, in which case we might be getting
+ * here because of methods/destructors doing a [next] (or equivalent)
+ * unexpectedly.
+ */
+
+ const char *methodType;
+
+ if (Tcl_InterpDeleted(interp)) {
+ return TCL_OK;
+ }
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Advance to the next method implementation in the chain in the method
+ * call context while we process the body. However, need to adjust the
+ * argument-skip control because we're guaranteed to have a single prefix
+ * arg (i.e., 'next') and not the variable amount that can happen because
+ * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
+ * all) come through the same code.
+ */
+
+ contextPtr->index++;
+ contextPtr->skip = skip;
+
+ /*
+ * Invoke the (advanced) method call context in the caller context.
+ */
+
+ result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc,
+ objv);
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = savedIndex;
+ contextPtr->skip = savedSkip;
+
+ return result;
+}
+
+int
+TclNRObjectContextInvokeNext(
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv,
+ int skip)
+{
+ register CallContext *contextPtr = (CallContext *) context;
+
+ if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+ /*
+ * We're at the end of the chain; generate an error message unless the
+ * interpreter is being torn down, in which case we might be getting
+ * here because of methods/destructors doing a [next] (or equivalent)
+ * unexpectedly.
+ */
+
+ const char *methodType;
+
+ if (Tcl_InterpDeleted(interp)) {
+ return TCL_OK;
+ }
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Advance to the next method implementation in the chain in the method
+ * call context while we process the body. However, need to adjust the
+ * argument-skip control because we're guaranteed to have a single prefix
+ * arg (i.e., 'next') and not the variable amount that can happen because
+ * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
+ * all) come through the same code.
+ */
+
+ TclNRAddCallback(interp, FinalizeNext, contextPtr,
+ INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL);
+ contextPtr->index++;
+ contextPtr->skip = skip;
+
+ /*
+ * Invoke the (advanced) method call context in the caller context.
+ */
+
+ return TclOOInvokeContext(contextPtr, interp, objc, objv);
+}
+
+static int
+FinalizeNext(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[1]);
+ contextPtr->skip = PTR2INT(data[2]);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_GetObjectFromObj --
+ *
+ * Utility function to get an object from a Tcl_Obj containing its name.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_GetObjectFromObj(
+ Tcl_Interp *interp, /* Interpreter in which to locate the object.
+ * Will have an error message placed in it if
+ * the name does not refer to an object. */
+ Tcl_Obj *objPtr) /* The name of the object to look up, which is
+ * exactly the name of its public command. */
+{
+ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
+
+ if (cmdPtr == NULL) {
+ goto notAnObject;
+ }
+ if (cmdPtr->objProc != PublicObjectCmd) {
+ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+ if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
+ goto notAnObject;
+ }
+ }
+ return cmdPtr->objClientData;
+
+ notAnObject:
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOIsReachable --
+ *
+ * Utility function that tests whether a class is a subclass (whether
+ * directly or indirectly) of another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOIsReachable(
+ Class *targetPtr,
+ Class *startPtr)
+{
+ int i;
+ Class *superPtr;
+
+ tailRecurse:
+ if (startPtr == targetPtr) {
+ return 1;
+ }
+ if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {
+ startPtr = startPtr->superclasses.list[0];
+ goto tailRecurse;
+ }
+ FOREACH(superPtr, startPtr->superclasses) {
+ if (TclOOIsReachable(targetPtr, superPtr)) {
+ return 1;
+ }
+ }
+ FOREACH(superPtr, startPtr->mixins) {
+ if (TclOOIsReachable(targetPtr, superPtr)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectName, Tcl_GetObjectName --
+ *
+ * Utility function that returns the name of the object. Note that this
+ * simplifies cache management by keeping the code to do it in one place
+ * and not sprayed all over. The value returned always has a reference
+ * count of at least one.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOObjectName(
+ Tcl_Interp *interp,
+ Object *oPtr)
+{
+ Tcl_Obj *namePtr;
+
+ if (oPtr->cachedNameObj) {
+ return oPtr->cachedNameObj;
+ }
+ namePtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, oPtr->command, namePtr);
+ Tcl_IncrRefCount(namePtr);
+ oPtr->cachedNameObj = namePtr;
+ return namePtr;
+}
+
+Tcl_Obj *
+Tcl_GetObjectName(
+ Tcl_Interp *interp,
+ Tcl_Object object)
+{
+ return TclOOObjectName(interp, (Object *) object);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * assorted trivial 'getter' functions
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_ObjectContextMethod(
+ Tcl_ObjectContext context)
+{
+ CallContext *contextPtr = (CallContext *) context;
+ return (Tcl_Method) contextPtr->callPtr->chain[contextPtr->index].mPtr;
+}
+
+int
+Tcl_ObjectContextIsFiltering(
+ Tcl_ObjectContext context)
+{
+ CallContext *contextPtr = (CallContext *) context;
+ return contextPtr->callPtr->chain[contextPtr->index].isFilter;
+}
+
+Tcl_Object
+Tcl_ObjectContextObject(
+ Tcl_ObjectContext context)
+{
+ return (Tcl_Object) ((CallContext *)context)->oPtr;
+}
+
+int
+Tcl_ObjectContextSkippedArgs(
+ Tcl_ObjectContext context)
+{
+ return ((CallContext *)context)->skip;
+}
+
+Tcl_Namespace *
+Tcl_GetObjectNamespace(
+ Tcl_Object object)
+{
+ return ((Object *)object)->namespacePtr;
+}
+
+Tcl_Command
+Tcl_GetObjectCommand(
+ Tcl_Object object)
+{
+ return ((Object *)object)->command;
+}
+
+Tcl_Class
+Tcl_GetObjectAsClass(
+ Tcl_Object object)
+{
+ return (Tcl_Class) ((Object *)object)->classPtr;
+}
+
+int
+Tcl_ObjectDeleted(
+ Tcl_Object object)
+{
+ return Deleted(object) ? 1 : 0;
+}
+
+Tcl_Object
+Tcl_GetClassAsObject(
+ Tcl_Class clazz)
+{
+ return (Tcl_Object) ((Class *)clazz)->thisPtr;
+}
+
+Tcl_ObjectMapMethodNameProc *
+Tcl_ObjectGetMethodNameMapper(
+ Tcl_Object object)
+{
+ return ((Object *) object)->mapMethodNameProc;
+}
+
+void
+Tcl_ObjectSetMethodNameMapper(
+ Tcl_Object object,
+ Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
+{
+ ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
new file mode 100644
index 0000000..265ba88
--- /dev/null
+++ b/generic/tclOO.decls
@@ -0,0 +1,218 @@
+# tclOO.decls --
+#
+# This file contains the declarations for all supported public functions
+# that are exported by the TclOO package that is embedded within the Tcl
+# library via the stubs table. This file is used to generate the
+# tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
+#
+# Copyright (c) 2008-2013 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.
+
+library tclOO
+
+######################################################################
+# Public API, exposed for general users of TclOO.
+#
+
+interface tclOO
+hooks tclOOInt
+scspec TCLAPI
+
+declare 0 {
+ Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+ Tcl_Object sourceObject, const char *targetName,
+ const char *targetNamespaceName)
+}
+declare 1 {
+ Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz)
+}
+declare 2 {
+ Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object)
+}
+declare 3 {
+ Tcl_Command Tcl_GetObjectCommand(Tcl_Object object)
+}
+declare 4 {
+ Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 5 {
+ Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object)
+}
+declare 6 {
+ Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method)
+}
+declare 7 {
+ Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
+}
+declare 8 {
+ int Tcl_MethodIsPublic(Tcl_Method method)
+}
+declare 9 {
+ int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
+ ClientData *clientDataPtr)
+}
+declare 10 {
+ Tcl_Obj *Tcl_MethodName(Tcl_Method method)
+}
+declare 11 {
+ Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
+ Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+ ClientData clientData)
+}
+declare 12 {
+ Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+ Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+ ClientData clientData)
+}
+declare 13 {
+ Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
+ const char *nameStr, const char *nsNameStr, int objc,
+ Tcl_Obj *const *objv, int skip)
+}
+declare 14 {
+ int Tcl_ObjectDeleted(Tcl_Object object)
+}
+declare 15 {
+ int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
+}
+declare 16 {
+ Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
+}
+declare 17 {
+ Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
+}
+declare 18 {
+ int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
+}
+declare 19 {
+ ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr)
+}
+declare 20 {
+ void Tcl_ClassSetMetadata(Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
+}
+declare 21 {
+ ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr)
+}
+declare 22 {
+ void Tcl_ObjectSetMetadata(Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
+}
+declare 23 {
+ int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+ Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
+ int skip)
+}
+declare 24 {
+ Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
+ Tcl_Object object)
+}
+declare 25 {
+ void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+ Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
+}
+declare 26 {
+ void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
+ Tcl_Method method)
+}
+declare 27 {
+ void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
+ Tcl_Method method)
+}
+declare 28 {
+ Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
+}
+
+######################################################################
+# Private API, exposed to support advanced OO systems that plug in on top of
+# TclOO; not intended for general use and does not have any commitment to
+# long-term support.
+#
+
+interface tclOOInt
+
+declare 0 {
+ Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
+}
+declare 1 {
+ 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)
+}
+declare 2 {
+ 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)
+}
+declare 3 {
+ Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
+ int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ ProcedureMethod **pmPtrPtr)
+}
+declare 4 {
+ Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+ int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ ProcedureMethod **pmPtrPtr)
+}
+declare 5 {
+ int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv, int publicOnly, Class *startCls)
+}
+declare 6 {
+ int TclOOIsReachable(Class *targetPtr, Class *startPtr)
+}
+declare 7 {
+ Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,
+ int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
+}
+declare 8 {
+ Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
+ int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
+}
+declare 9 {
+ Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+ Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
+ TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
+ ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
+ Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
+}
+declare 10 {
+ Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
+ TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
+ ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj,
+ Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
+ void **internalTokenPtr)
+}
+declare 11 {
+ int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
+ Tcl_Class startCls, int publicPrivate, int objc,
+ Tcl_Obj *const *objv)
+}
+declare 12 {
+ void TclOOObjectSetFilters(Object *oPtr, int numFilters,
+ Tcl_Obj *const *filters)
+}
+declare 13 {
+ void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
+ int numFilters, Tcl_Obj *const *filters)
+}
+declare 14 {
+ void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+ Class *const *mixins)
+}
+declare 15 {
+ void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
+ int numMixins, Class *const *mixins)
+}
+
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tclOO.h b/generic/tclOO.h
new file mode 100644
index 0000000..a6e8a22
--- /dev/null
+++ b/generic/tclOO.h
@@ -0,0 +1,147 @@
+/*
+ * tclOO.h --
+ *
+ * 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-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.
+ */
+
+#ifndef TCLOO_H_INCLUDED
+#define TCLOO_H_INCLUDED
+
+/*
+ * 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 "1.0.1"
+#define TCLOO_PATCHLEVEL TCLOO_VERSION
+
+#include "tcl.h"
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern const char *TclOOInitializeStubs(
+ Tcl_Interp *, const char *version);
+#define Tcl_OOInitStubs(interp) \
+ TclOOInitializeStubs((interp), TCLOO_VERSION)
+#ifndef USE_TCL_STUBS
+# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
+#endif
+
+/*
+ * These are opaque types.
+ */
+
+typedef struct Tcl_Class_ *Tcl_Class;
+typedef struct Tcl_Method_ *Tcl_Method;
+typedef struct Tcl_Object_ *Tcl_Object;
+typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
+
+/*
+ * Public datatypes for callbacks and structures used in the TIP#257 (OO)
+ * implementation. These are used to implement custom types of method calls
+ * and to allow the attachment of arbitrary data to objects and classes.
+ */
+
+typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
+ Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
+typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
+typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
+ ClientData *newClientData);
+typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
+typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
+ Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
+
+/*
+ * The type of a method implementation. This describes how to call the method
+ * implementation, how to delete it (when the object or class is deleted) and
+ * how to create a clone of it (when the object or class is copied).
+ */
+
+typedef struct {
+ int version; /* Structure version field. Always to be equal
+ * to TCL_OO_METHOD_VERSION_CURRENT in
+ * declarations. */
+ const char *name; /* Name of this type of method, mostly for
+ * debugging purposes. */
+ Tcl_MethodCallProc *callProc;
+ /* How to invoke this method. */
+ Tcl_MethodDeleteProc *deleteProc;
+ /* How to delete this method's type-specific
+ * data, or NULL if the type-specific data
+ * does not need deleting. */
+ Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific
+ * data, or NULL if the type-specific data can
+ * be copied directly. */
+} Tcl_MethodType;
+
+/*
+ * The correct value for the version field of the Tcl_MethodType structure.
+ * This allows new versions of the structure to be introduced without breaking
+ * binary compatability.
+ */
+
+#define TCL_OO_METHOD_VERSION_CURRENT 1
+
+/*
+ * The type of some object (or class) metadata. This describes how to delete
+ * the metadata (when the object or class is deleted) and how to create a
+ * clone of it (when the object or class is copied).
+ */
+
+typedef struct {
+ int version; /* Structure version field. Always to be equal
+ * to TCL_OO_METADATA_VERSION_CURRENT in
+ * declarations. */
+ const char *name;
+ Tcl_ObjectMetadataDeleteProc *deleteProc;
+ /* How to delete the metadata. This must not
+ * be NULL. */
+ Tcl_CloneProc *cloneProc; /* How to copy the metadata, or NULL if the
+ * type-specific data can be copied
+ * directly. */
+} Tcl_ObjectMetadataType;
+
+/*
+ * The correct value for the version field of the Tcl_ObjectMetadataType
+ * structure. This allows new versions of the structure to be introduced
+ * without breaking binary compatability.
+ */
+
+#define TCL_OO_METADATA_VERSION_CURRENT 1
+
+/*
+ * Include all the public API, generated from tclOO.decls.
+ */
+
+#include "tclOODecls.h"
+
+#ifdef __cplusplus
+}
+#endif
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
new file mode 100644
index 0000000..0b0516b
--- /dev/null
+++ b/generic/tclOOBasic.c
@@ -0,0 +1,1249 @@
+/*
+ * tclOOBasic.c --
+ *
+ * This file contains implementations of the "simple" commands and
+ * methods from the object-system core.
+ *
+ * Copyright (c) 2005-2013 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
+static Tcl_NRPostProc AfterNRDestructor;
+static Tcl_NRPostProc DecrRefsPostClassConstructor;
+static Tcl_NRPostProc FinalizeConstruction;
+static Tcl_NRPostProc FinalizeEval;
+static Tcl_NRPostProc NextRestoreFrame;
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddCreateCallback, FinalizeConstruction --
+ *
+ * Special version of TclNRAddCallback that allows the caller to splice
+ * the object created later on. Always calls FinalizeConstruction, which
+ * converts the object into its name and stores that in the interpreter
+ * result. This is shared by all the construction methods (create,
+ * createWithNamespace, new).
+ *
+ * Note that this is the only code in this file (or, indeed, the whole of
+ * TclOO) that uses NRE internals; it is the only code that does
+ * non-standard poking in the NRE guts.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline Tcl_Object *
+AddConstructionFinalizer(
+ Tcl_Interp *interp)
+{
+ TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
+ return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
+}
+
+static int
+FinalizeConstruction(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Object *oPtr = data[0];
+
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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;
+
+ 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 = ckalloc(3 * sizeof(Tcl_Obj *));
+ 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, NULL, NULL, 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)
+{
+ Tcl_Obj **invoke = data[0];
+
+ TclDecrRefCount(invoke[0]);
+ TclDecrRefCount(invoke[1]);
+ TclDecrRefCount(invoke[2]);
+ ckfree(invoke);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_Create --
+ *
+ * Implementation for oo::class->create method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Create(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ const char *objName;
+ int len;
+
+ /*
+ * Sanity check; should not be possible to invoke this method on a
+ * non-class.
+ */
+
+ if (oPtr->classPtr == NULL) {
+ Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check we have the right number of (sensible) arguments.
+ */
+
+ if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "objectName ?arg ...?");
+ return TCL_ERROR;
+ }
+ objName = Tcl_GetStringFromObj(
+ objv[Tcl_ObjectContextSkippedArgs(context)], &len);
+ if (len == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object name must not be empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the object and return its name.
+ */
+
+ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+ objName, NULL, objc, objv,
+ Tcl_ObjectContextSkippedArgs(context)+1,
+ AddConstructionFinalizer(interp));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_CreateNs --
+ *
+ * Implementation for oo::class->createWithNamespace method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_CreateNs(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ const char *objName, *nsName;
+ int len;
+
+ /*
+ * Sanity check; should not be possible to invoke this method on a
+ * non-class.
+ */
+
+ if (oPtr->classPtr == NULL) {
+ Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check we have the right number of (sensible) arguments.
+ */
+
+ if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "objectName namespaceName ?arg ...?");
+ return TCL_ERROR;
+ }
+ objName = Tcl_GetStringFromObj(
+ objv[Tcl_ObjectContextSkippedArgs(context)], &len);
+ if (len == 0) {
+ 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_SetObjResult(interp, Tcl_NewStringObj(
+ "namespace name must not be empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the object and return its name.
+ */
+
+ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+ objName, nsName, objc, objv,
+ Tcl_ObjectContextSkippedArgs(context)+2,
+ AddConstructionFinalizer(interp));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_New --
+ *
+ * Implementation for oo::class->new method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_New(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+
+ /*
+ * Sanity check; should not be possible to invoke this method on a
+ * non-class.
+ */
+
+ if (oPtr->classPtr == NULL) {
+ Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the object and return its name.
+ */
+
+ return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+ NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context),
+ AddConstructionFinalizer(interp));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Destroy --
+ *
+ * Implementation for oo::object->destroy method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Destroy(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ CallContext *contextPtr;
+
+ if (objc != Tcl_ObjectContextSkippedArgs(context)) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
+ oPtr->flags |= DESTRUCTOR_CALLED;
+ contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+ if (contextPtr != NULL) {
+ contextPtr->callPtr->flags |= DESTRUCTOR;
+ contextPtr->skip = 0;
+ TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
+ NULL, NULL, NULL);
+ TclPushTailcallPoint(interp);
+ return TclOOInvokeContext(contextPtr, interp, 0, NULL);
+ }
+ }
+ if (oPtr->command) {
+ Tcl_DeleteCommandFromToken(interp, oPtr->command);
+ }
+ return TCL_OK;
+}
+
+static int
+AfterNRDestructor(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+
+ if (contextPtr->oPtr->command) {
+ Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
+ }
+ TclOODeleteContext(contextPtr);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Eval --
+ *
+ * Implementation for oo::object->eval method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Eval(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ CallContext *contextPtr = (CallContext *) context;
+ Tcl_Object object = Tcl_ObjectContextObject(context);
+ register const int skip = Tcl_ObjectContextSkippedArgs(context);
+ CallFrame *framePtr, **framePtrPtr = &framePtr;
+ Tcl_Obj *scriptPtr;
+ int result;
+ CmdFrame *invoker;
+
+ if (objc-1 < skip) {
+ Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the object's namespace the current namespace and evaluate the
+ * command(s).
+ */
+
+ result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ Tcl_GetObjectNamespace(object), 0);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ framePtr->objc = objc;
+ framePtr->objv = objv; /* Reference counts do not need to be
+ * incremented here. */
+
+ if (!(contextPtr->callPtr->flags & PUBLIC_METHOD)) {
+ object = NULL; /* Now just for error mesage printing. */
+ }
+
+ /*
+ * Work out what script we are actually going to evaluate.
+ *
+ * When there's more than one argument, we concatenate them together with
+ * spaces between, then evaluate the result. Tcl_EvalObjEx will delete the
+ * object when it decrements its refcount after eval'ing it.
+ */
+
+ if (objc != skip+1) {
+ scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
+ invoker = NULL;
+ } else {
+ scriptPtr = objv[skip];
+ invoker = ((Interp *) interp)->cmdFramePtr;
+ }
+
+ /*
+ * Evaluate the script now, with FinalizeEval to do the processing after
+ * the script completes.
+ */
+
+ TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
+ return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
+}
+
+static int
+FinalizeEval(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ if (result == TCL_ERROR) {
+ Object *oPtr = data[0];
+ const char *namePtr;
+
+ if (oPtr) {
+ namePtr = TclGetString(TclOOObjectName(interp, oPtr));
+ } else {
+ namePtr = "my";
+ }
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in \"%s eval\" script line %d)",
+ namePtr, Tcl_GetErrorLine(interp)));
+ }
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Unknown --
+ *
+ * Default unknown method handler method (defined in oo::object). This
+ * just creates a suitable error message.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Unknown(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ CallContext *contextPtr = (CallContext *) context;
+ 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, "method ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the list of methods that we want to know about.
+ */
+
+ numMethodNames = TclOOGetSortedMethodList(oPtr,
+ contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
+
+ /*
+ * Special message when there are no visible methods at all.
+ */
+
+ if (numMethodNames == 0) {
+ Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
+ const char *piece;
+
+ if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
+ piece = "visible methods";
+ } else {
+ 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;
+ }
+
+ errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
+ TclGetString(objv[skip]));
+ for (i=0 ; i<numMethodNames-1 ; i++) {
+ if (i) {
+ Tcl_AppendToObj(errorMsg, ", ", -1);
+ }
+ Tcl_AppendToObj(errorMsg, methodNames[i], -1);
+ }
+ if (i) {
+ Tcl_AppendToObj(errorMsg, " or ", -1);
+ }
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_LinkVar --
+ *
+ * Implementation of oo::object->variable method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_LinkVar(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Object object = Tcl_ObjectContextObject(context);
+ Namespace *savedNsPtr;
+ int i;
+
+ if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "?varName ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * A sanity check. Shouldn't ever happen. (This is all that remains of a
+ * more complex check inherited from [global] after we have applied the
+ * fix for [Bug 2903811]; note that the fix involved *removing* code.)
+ */
+
+ if (iPtr->varFramePtr == NULL) {
+ return TCL_OK;
+ }
+
+ for (i=Tcl_ObjectContextSkippedArgs(context) ; i<objc ; i++) {
+ Var *varPtr, *aryPtr;
+ const char *varName = TclGetString(objv[i]);
+
+ /*
+ * The variable name must not contain a '::' since that's illegal in
+ * local names.
+ */
+
+ if (strstr(varName, "::") != 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;
+ }
+
+ /*
+ * Switch to the object's namespace for the duration of this call.
+ * Like this, the variable is looked up in the namespace of the
+ * object, and not in the namespace of the caller. Otherwise this
+ * would only work if the caller was a method of the object itself,
+ * which might not be true if the method was exported. This is a bit
+ * of a hack, but the simplest way to do this (pushing a stack frame
+ * would be horribly expensive by comparison).
+ */
+
+ savedNsPtr = iPtr->varFramePtr->nsPtr;
+ iPtr->varFramePtr->nsPtr = (Namespace *)
+ Tcl_GetObjectNamespace(object);
+ varPtr = TclObjLookupVar(interp, objv[i], NULL, TCL_NAMESPACE_ONLY,
+ "define", 1, 0, &aryPtr);
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+
+ if (varPtr == NULL || aryPtr != NULL) {
+ /*
+ * Variable cannot be an element in an array. If aryPtr is not
+ * NULL, it is an element, so throw up an error and return.
+ */
+
+ TclVarErrMsg(interp, varName, NULL, "define",
+ "name refers to an element in an array");
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Arrange for the lifetime of the variable to be correctly managed.
+ * This is copied out of Tcl_VariableObjCmd...
+ */
+
+ if (!TclIsVarNamespaceVar(varPtr)) {
+ TclSetVarNamespaceVar(varPtr);
+ }
+
+ if (TclPtrMakeUpvar(interp, varPtr, varName, 0, -1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_VarName --
+ *
+ * Implementation of the oo::object->varname method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_VarName(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* Interpreter in which to create the object;
+ * also used for error reporting. */
+ Tcl_ObjectContext context, /* The object/call context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* The actual arguments. */
+{
+ Var *varPtr, *aryVar;
+ Tcl_Obj *varNamePtr, *argPtr;
+ const char *arg;
+
+ if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "varName");
+ return TCL_ERROR;
+ }
+ argPtr = objv[objc-1];
+ arg = Tcl_GetString(argPtr);
+
+ /*
+ * Convert the variable name to fully-qualified form if it wasn't already.
+ * This has to be done prior to lookup because we can run into problems
+ * with resolvers otherwise. [Bug 3603695]
+ *
+ * We still need to do the lookup; the variable could be linked to another
+ * variable and we want the target's name.
+ */
+
+ if (arg[0] == ':' && arg[1] == ':') {
+ varNamePtr = argPtr;
+ } else {
+ Tcl_Namespace *namespacePtr =
+ Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
+
+ varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
+ Tcl_AppendToObj(varNamePtr, "::", 2);
+ Tcl_AppendObjToObj(varNamePtr, argPtr);
+ }
+ Tcl_IncrRefCount(varNamePtr);
+ varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
+ TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
+ Tcl_DecrRefCount(varNamePtr);
+ if (varPtr == NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now that we've pinned down what variable we're really talking about
+ * (including traversing variable links), convert back to a name.
+ */
+
+ varNamePtr = Tcl_NewObj();
+ if (aryVar != NULL) {
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
+
+ /*
+ * WARNING! This code pokes inside the implementation of hash tables!
+ */
+
+ hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
+ &search);
+ while (hPtr != NULL) {
+ if (varPtr == Tcl_GetHashValue(hPtr)) {
+ Tcl_AppendToObj(varNamePtr, "(", -1);
+ Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
+ Tcl_AppendToObj(varNamePtr, ")", -1);
+ break;
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ } else {
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
+ }
+ Tcl_SetObjResult(interp, varNamePtr);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONextObjCmd, TclOONextToObjCmd --
+ *
+ * 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.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOONextObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *framePtr = iPtr->varFramePtr;
+ Tcl_ObjectContext context;
+
+ /*
+ * 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;
+ }
+ context = framePtr->clientData;
+
+ /*
+ * Invoke the (advanced) method call context in the caller context. Note
+ * that this is like [uplevel 1] and not [eval].
+ */
+
+ TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ 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;
+ const char *methodType;
+
+ /*
+ * 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, NextRestoreFrame, 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.
+ */
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ 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(
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ return TCL_ERROR;
+}
+
+static int
+NextRestoreFrame(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ iPtr->varFramePtr = data[0];
+ if (contextPtr != NULL) {
+ contextPtr->index = PTR2INT(data[2]);
+ }
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOSelfObjCmd --
+ *
+ * Implementation of the [self] command, which provides introspection of
+ * the call context.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOSelfObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ static const char *const subcmds[] = {
+ "call", "caller", "class", "filter", "method", "namespace", "next",
+ "object", "target", NULL
+ };
+ enum SelfCmds {
+ 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) \
+ ((contextPtr)->callPtr->chain[(contextPtr)->index])
+
+ /*
+ * Start with sanity checks on the calling context and the method 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;
+
+ /*
+ * Now we do "conventional" argument parsing for a while. Note that no
+ * subcommand takes arguments.
+ */
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
+ return TCL_ERROR;
+ } else if (objc == 1) {
+ index = SELF_OBJECT;
+ } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum SelfCmds) index) {
+ case SELF_OBJECT:
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
+ return TCL_OK;
+ case SELF_NS:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ contextPtr->oPtr->namespacePtr->fullName,-1));
+ return TCL_OK;
+ case SELF_CLASS: {
+ Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;
+
+ if (clsPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method not defined by a class", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
+ return TCL_OK;
+ }
+ case SELF_METHOD:
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
+ } else {
+ Tcl_SetObjResult(interp,
+ CurrentlyInvoked(contextPtr).mPtr->namePtr);
+ }
+ return TCL_OK;
+ case SELF_FILTER:
+ if (!CurrentlyInvoked(contextPtr).isFilter) {
+ 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);
+ Object *oPtr;
+ const char *type;
+
+ if (miPtr->filterDeclarer != NULL) {
+ oPtr = miPtr->filterDeclarer->thisPtr;
+ type = "class";
+ } else {
+ oPtr = contextPtr->oPtr;
+ type = "object";
+ }
+
+ result[0] = TclOOObjectName(interp, oPtr);
+ result[1] = Tcl_NewStringObj(type, -1);
+ result[2] = miPtr->mPtr->namePtr;
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+ return TCL_OK;
+ }
+ case SELF_CALLER:
+ if ((framePtr->callerVarPtr == NULL) ||
+ !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
+ 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;
+
+ if (mPtr->declaringClassPtr != NULL) {
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ } else if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ } else {
+ /*
+ * This should be unreachable code.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
+ return TCL_ERROR;
+ }
+
+ result[0] = TclOOObjectName(interp, declarerPtr);
+ result[1] = TclOOObjectName(interp, callerPtr->oPtr);
+ if (callerPtr->callPtr->flags & CONSTRUCTOR) {
+ result[2] = declarerPtr->fPtr->constructorName;
+ } else if (callerPtr->callPtr->flags & DESTRUCTOR) {
+ result[2] = declarerPtr->fPtr->destructorName;
+ } else {
+ result[2] = mPtr->namePtr;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+ return TCL_OK;
+ }
+ case SELF_NEXT:
+ if (contextPtr->index < contextPtr->callPtr->numChain-1) {
+ Method *mPtr =
+ contextPtr->callPtr->chain[contextPtr->index+1].mPtr;
+ Object *declarerPtr;
+
+ if (mPtr->declaringClassPtr != NULL) {
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ } else if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ } else {
+ /*
+ * This should be unreachable code.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
+ return TCL_ERROR;
+ }
+
+ result[0] = TclOOObjectName(interp, declarerPtr);
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ result[1] = declarerPtr->fPtr->constructorName;
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ result[1] = declarerPtr->fPtr->destructorName;
+ } else {
+ result[1] = mPtr->namePtr;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+ }
+ return TCL_OK;
+ case SELF_TARGET:
+ if (!CurrentlyInvoked(contextPtr).isFilter) {
+ 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;
+ int i;
+
+ for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
+ if (!contextPtr->callPtr->chain[i].isFilter) {
+ break;
+ }
+ }
+ if (i == contextPtr->callPtr->numChain) {
+ Tcl_Panic("filtering call chain without terminal non-filter");
+ }
+ mPtr = contextPtr->callPtr->chain[i].mPtr;
+ if (mPtr->declaringClassPtr != NULL) {
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ } else if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ } else {
+ /*
+ * This should be unreachable code.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
+ return TCL_ERROR;
+ }
+ result[0] = TclOOObjectName(interp, declarerPtr);
+ result[1] = mPtr->namePtr;
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * CopyObjectCmd --
+ *
+ * Implementation of the [oo::copy] command, which clones an object (but
+ * not its namespace). Note that no constructors are called during this
+ * process.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOCopyObjectCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Tcl_Object oPtr, o2Ptr;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?");
+ return TCL_ERROR;
+ }
+
+ oPtr = Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create a cloned object of the correct class. Note that constructors are
+ * not called. Also note that we must resolve the object name ourselves
+ * because we do not want to create the object in the current namespace,
+ * but rather in the context of the namespace of the caller of the overall
+ * [oo::define] command.
+ */
+
+ if (objc == 2) {
+ o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
+ } else {
+ const char *name;
+ Tcl_DString buffer;
+
+ name = TclGetString(objv[2]);
+ Tcl_DStringInit(&buffer);
+ if (name[0]!=':' || name[1]!=':') {
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->varFramePtr != NULL) {
+ Tcl_DStringAppend(&buffer,
+ iPtr->varFramePtr->nsPtr->fullName, -1);
+ }
+ TclDStringAppendLiteral(&buffer, "::");
+ Tcl_DStringAppend(&buffer, name, -1);
+ name = Tcl_DStringValue(&buffer);
+ }
+ o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
+ Tcl_DStringFree(&buffer);
+ }
+
+ if (o2Ptr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Return the name of the cloned object.
+ */
+
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr));
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
new file mode 100644
index 0000000..26fd09f
--- /dev/null
+++ b/generic/tclOOCall.c
@@ -0,0 +1,1495 @@
+/*
+ * tclOOCall.c --
+ *
+ * This file contains the method call chain management code for the
+ * object-system core.
+ *
+ * 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Structure containing a CallContext and any other values needed only during
+ * the construction of the CallContext.
+ */
+
+struct ChainBuilder {
+ CallChain *callChainPtr; /* The call chain being built. */
+ int filterLength; /* Number of entries in the call chain that
+ * are due to processing filters and not the
+ * main call chain. */
+ Object *oPtr; /* The object that we are building the chain
+ * for. */
+};
+
+/*
+ * Extra flags used for call chain management.
+ */
+
+#define DEFINITE_PROTECTED 0x100000
+#define DEFINITE_PUBLIC 0x200000
+#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
+#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static void AddClassFiltersToCallContext(Object *const oPtr,
+ Class *clsPtr, struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters);
+static void AddClassMethodNames(Class *clsPtr, const int flags,
+ Tcl_HashTable *const namesPtr);
+static inline void AddMethodToCallChain(Method *const mPtr,
+ struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters,
+ Class *const filterDecl);
+static inline void AddSimpleChainToCallContext(Object *const oPtr,
+ Tcl_Obj *const methodNameObj,
+ struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters, int flags,
+ Class *const filterDecl);
+static void AddSimpleClassChainToCallContext(Class *classPtr,
+ Tcl_Obj *const methodNameObj,
+ struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters, int flags,
+ Class *const filterDecl);
+static int CmpStr(const void *ptr1, const void *ptr2);
+static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
+static int FinalizeMethodRefs(ClientData data[],
+ Tcl_Interp *interp, int result);
+static void FreeMethodNameRep(Tcl_Obj *objPtr);
+static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
+ int flags, int reuseMask);
+static int ResetFilterFlags(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int SetFilterFlags(ClientData data[],
+ Tcl_Interp *interp, int result);
+static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
+
+/*
+ * Object type used to manage type caches attached to method names.
+ */
+
+static const Tcl_ObjType methodNameType = {
+ "TclOO method name",
+ FreeMethodNameRep,
+ DupMethodNameRep,
+ NULL,
+ NULL
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteContext --
+ *
+ * Destroys a method call-chain context, which should not be in use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteContext(
+ CallContext *contextPtr)
+{
+ register Object *oPtr = contextPtr->oPtr;
+
+ TclOODeleteChain(contextPtr->callPtr);
+ if (oPtr != NULL) {
+ TclStackFree(oPtr->fPtr->interp, contextPtr);
+ DelRef(oPtr);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteChainCache --
+ *
+ * Destroy the cache of method call-chains.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteChainCache(
+ Tcl_HashTable *tablePtr)
+{
+ FOREACH_HASH_DECLS;
+ CallChain *callPtr;
+
+ FOREACH_HASH_VALUE(callPtr, tablePtr) {
+ if (callPtr) {
+ TclOODeleteChain(callPtr);
+ }
+ }
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree(tablePtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteChain --
+ *
+ * Destroys a method call-chain.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteChain(
+ CallChain *callPtr)
+{
+ if (--callPtr->refCount >= 1) {
+ return;
+ }
+ if (callPtr->chain != callPtr->staticChain) {
+ ckfree(callPtr->chain);
+ }
+ ckfree(callPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOStashContext --
+ *
+ * Saves a reference to a method call context in a Tcl_Obj's internal
+ * representation.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+StashCallChain(
+ Tcl_Obj *objPtr,
+ CallChain *callPtr)
+{
+ callPtr->refCount++;
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = &methodNameType;
+ objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+}
+
+void
+TclOOStashContext(
+ Tcl_Obj *objPtr,
+ CallContext *contextPtr)
+{
+ StashCallChain(objPtr, contextPtr->callPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DupMethodNameRep, FreeMethodNameRep --
+ *
+ * Functions to implement the required parts of the Tcl_Obj guts needed
+ * for caching of method contexts in Tcl_Objs.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DupMethodNameRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dstPtr)
+{
+ register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+
+ dstPtr->typePtr = &methodNameType;
+ dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+ callPtr->refCount++;
+}
+
+static void
+FreeMethodNameRep(
+ Tcl_Obj *objPtr)
+{
+ register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ TclOODeleteChain(callPtr);
+ objPtr->typePtr = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInvokeContext --
+ *
+ * Invokes a single step along a method call-chain context. Note that the
+ * invokation of a step along the chain can cause further steps along the
+ * chain to be invoked. Note that this function is written to be as light
+ * in stack usage as possible.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOInvokeContext(
+ ClientData clientData, /* The method call context. */
+ Tcl_Interp *interp, /* Interpreter for error reporting, and many
+ * other sorts of context handling (e.g.,
+ * commands, variables) depending on method
+ * implementation. */
+ int objc, /* The number of arguments. */
+ Tcl_Obj *const objv[]) /* The arguments as actually seen. */
+{
+ register CallContext *const contextPtr = clientData;
+ Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+ const int isFilter =
+ contextPtr->callPtr->chain[contextPtr->index].isFilter;
+
+ /*
+ * If this is the first step along the chain, we preserve the method
+ * entries in the chain so that they do not get deleted out from under our
+ * feet.
+ */
+
+ if (contextPtr->index == 0) {
+ int i;
+
+ for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+ AddRef(contextPtr->callPtr->chain[i].mPtr);
+ }
+
+ /*
+ * Ensure that the method name itself is part of the arguments when
+ * we're doing unknown processing.
+ */
+
+ if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
+ contextPtr->skip--;
+ }
+
+ /*
+ * Add a callback to ensure that method references are dropped once
+ * this call is finished.
+ */
+
+ TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
+ NULL);
+ }
+
+ /*
+ * Save whether we were in a filter and set up whether we are now.
+ */
+
+ if (contextPtr->oPtr->flags & FILTER_HANDLING) {
+ TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
+ } else {
+ TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
+ }
+ if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
+ contextPtr->oPtr->flags |= FILTER_HANDLING;
+ } else {
+ contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+ }
+
+ /*
+ * Run the method implementation.
+ */
+
+ return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, objc, objv);
+}
+
+static int
+SetFilterFlags(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+
+ contextPtr->oPtr->flags |= FILTER_HANDLING;
+ return result;
+}
+
+static int
+ResetFilterFlags(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+
+ contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+ return result;
+}
+
+static int
+FinalizeMethodRefs(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallContext *contextPtr = data[0];
+ int i;
+
+ for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+ TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
+ }
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
+ *
+ * Discovers the list of method names supported by an object or class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOGetSortedMethodList(
+ Object *oPtr, /* The object to get the method names for. */
+ int flags, /* Whether we just want the public method
+ * names. */
+ const char ***stringsPtr) /* Where to write a pointer to the array of
+ * strings to. */
+{
+ Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
+ * mapping. */
+ FOREACH_HASH_DECLS;
+ int i;
+ Class *mixinPtr;
+ Tcl_Obj *namePtr;
+ Method *mPtr;
+ int isWantedIn;
+ void *isWanted;
+
+ Tcl_InitObjHashTable(&names);
+
+ /*
+ * Name the bits used in the names table values.
+ */
+#define IN_LIST 1
+#define NO_IMPLEMENTATION 2
+
+ /*
+ * Process method names due to the object.
+ */
+
+ if (oPtr->methodsPtr) {
+ FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
+ int isNew;
+
+ if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
+ continue;
+ }
+ hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
+ if (isNew) {
+ isWantedIn = ((!(flags & PUBLIC_METHOD)
+ || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
+ isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
+ Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
+ }
+ }
+ }
+
+ /*
+ * Process method names due to private methods on the object's class.
+ */
+
+ if (flags & PRIVATE_METHOD) {
+ FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
+ if (mPtr->flags & PRIVATE_METHOD) {
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
+ if (isNew) {
+ isWantedIn = IN_LIST;
+ if (mPtr->typePtr == NULL) {
+ isWantedIn |= NO_IMPLEMENTATION;
+ }
+ Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
+ } else if (mPtr->typePtr != NULL) {
+ isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
+ if (isWantedIn & NO_IMPLEMENTATION) {
+ isWantedIn &= ~NO_IMPLEMENTATION;
+ Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Process (normal) method names from the class hierarchy and the mixin
+ * hierarchy.
+ */
+
+ AddClassMethodNames(oPtr->selfCls, flags, &names);
+ FOREACH(mixinPtr, oPtr->mixins) {
+ AddClassMethodNames(mixinPtr, flags, &names);
+ }
+
+ /*
+ * See how many (visible) method names there are. If none, we do not (and
+ * should not) try to sort the list of them.
+ */
+
+ i = 0;
+ if (names.numEntries != 0) {
+ const char **strings;
+
+ /*
+ * We need to build the list of methods to sort. We will be using
+ * qsort() for this, because it is very unlikely that the list will be
+ * heavily sorted when it is long enough to matter.
+ */
+
+ strings = ckalloc(sizeof(char *) * names.numEntries);
+ FOREACH_HASH(namePtr, isWanted, &names) {
+ if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
+ if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
+ continue;
+ }
+ strings[i++] = TclGetString(namePtr);
+ }
+ }
+
+ /*
+ * Note that 'i' may well be less than names.numEntries when we are
+ * dealing with public method names.
+ */
+
+ if (i > 0) {
+ if (i > 1) {
+ qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
+ }
+ *stringsPtr = strings;
+ } else {
+ ckfree(strings);
+ }
+ }
+
+ Tcl_DeleteHashTable(&names);
+ return i;
+}
+
+int
+TclOOGetSortedClassMethodList(
+ Class *clsPtr, /* The class to get the method names for. */
+ int flags, /* Whether we just want the public method
+ * names. */
+ const char ***stringsPtr) /* Where to write a pointer to the array of
+ * strings to. */
+{
+ Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
+ * mapping. */
+ FOREACH_HASH_DECLS;
+ int i;
+ Tcl_Obj *namePtr;
+ void *isWanted;
+
+ Tcl_InitObjHashTable(&names);
+
+ /*
+ * Process method names from the class hierarchy and the mixin hierarchy.
+ */
+
+ AddClassMethodNames(clsPtr, flags, &names);
+
+ /*
+ * See how many (visible) method names there are. If none, we do not (and
+ * should not) try to sort the list of them.
+ */
+
+ i = 0;
+ if (names.numEntries != 0) {
+ const char **strings;
+
+ /*
+ * We need to build the list of methods to sort. We will be using
+ * qsort() for this, because it is very unlikely that the list will be
+ * heavily sorted when it is long enough to matter.
+ */
+
+ strings = ckalloc(sizeof(char *) * names.numEntries);
+ FOREACH_HASH(namePtr, isWanted, &names) {
+ if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
+ if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
+ continue;
+ }
+ strings[i++] = TclGetString(namePtr);
+ }
+ }
+
+ /*
+ * Note that 'i' may well be less than names.numEntries when we are
+ * dealing with public method names.
+ */
+
+ if (i > 0) {
+ if (i > 1) {
+ qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
+ }
+ *stringsPtr = strings;
+ } else {
+ ckfree(strings);
+ }
+ }
+
+ Tcl_DeleteHashTable(&names);
+ return i;
+}
+
+/* Comparator for GetSortedMethodList */
+static int
+CmpStr(
+ const void *ptr1,
+ const void *ptr2)
+{
+ const char **strPtr1 = (const char **) ptr1;
+ const char **strPtr2 = (const char **) ptr2;
+
+ return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddClassMethodNames --
+ *
+ * Adds the method names defined by a class (or its superclasses) to the
+ * collection being built. The collection is built in a hash table to
+ * ensure that duplicates are excluded. Helper for GetSortedMethodList().
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddClassMethodNames(
+ Class *clsPtr, /* Class to get method names from. */
+ const int flags, /* Whether we are interested in just the
+ * public method names. */
+ Tcl_HashTable *const namesPtr)
+ /* Reference to the hash table to put the
+ * information in. The hash table maps the
+ * Tcl_Obj * method name to an integral value
+ * describing whether the method is wanted.
+ * This ensures that public/private override
+ * semantics are handled correctly.*/
+{
+ /*
+ * Scope all declarations so that the compiler can stand a good chance of
+ * making the recursive step highly efficient. We also hand-implement the
+ * tail-recursive case using a while loop; C compilers typically cannot do
+ * tail-recursion optimization usefully.
+ */
+
+ if (clsPtr->mixins.num != 0) {
+ Class *mixinPtr;
+ int i;
+
+ /* TODO: Beware of infinite loops! */
+ FOREACH(mixinPtr, clsPtr->mixins) {
+ AddClassMethodNames(mixinPtr, flags, namesPtr);
+ }
+ }
+
+ while (1) {
+ FOREACH_HASH_DECLS;
+ Tcl_Obj *namePtr;
+ Method *mPtr;
+
+ FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
+ if (isNew) {
+ int isWanted = (!(flags & PUBLIC_METHOD)
+ || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
+
+ Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
+ } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
+ && mPtr->typePtr != NULL) {
+ int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
+
+ isWanted &= ~NO_IMPLEMENTATION;
+ Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
+ }
+ }
+
+ if (clsPtr->superclasses.num != 1) {
+ break;
+ }
+ clsPtr = clsPtr->superclasses.list[0];
+ }
+ if (clsPtr->superclasses.num != 0) {
+ Class *superPtr;
+ int i;
+
+ FOREACH(superPtr, clsPtr->superclasses) {
+ AddClassMethodNames(superPtr, flags, namesPtr);
+ }
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleChainToCallContext --
+ *
+ * The core of the call-chain construction engine, this handles calling a
+ * particular method on a particular object. Note that filters and
+ * unknown handling are already handled by the logic that uses this
+ * function.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddSimpleChainToCallContext(
+ Object *const oPtr, /* Object to add call chain entries for. */
+ Tcl_Obj *const methodNameObj,
+ /* Name of method to add the call chain
+ * entries for. */
+ struct ChainBuilder *const cbPtr,
+ /* Where to add the call chain entries. */
+ Tcl_HashTable *const doneFilters,
+ /* Where to record what call chain entries
+ * have been processed. */
+ int flags, /* What sort of call chain are we building. */
+ Class *const filterDecl) /* The class that declared the filter. If
+ * NULL, either the filter was declared by the
+ * object or this isn't a filter. */
+{
+ int i;
+
+ if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
+ (char *) methodNameObj);
+
+ if (hPtr != NULL) {
+ Method *mPtr = Tcl_GetHashValue(hPtr);
+
+ if (flags & PUBLIC_METHOD) {
+ if (!(mPtr->flags & PUBLIC_METHOD)) {
+ return;
+ } else {
+ flags |= DEFINITE_PUBLIC;
+ }
+ } else {
+ flags |= DEFINITE_PROTECTED;
+ }
+ }
+ }
+ if (!(flags & SPECIAL)) {
+ Tcl_HashEntry *hPtr;
+ Class *mixinPtr;
+
+ FOREACH(mixinPtr, oPtr->mixins) {
+ AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
+ doneFilters, flags, filterDecl);
+ }
+ if (oPtr->methodsPtr) {
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
+ if (hPtr != NULL) {
+ AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
+ doneFilters, filterDecl);
+ }
+ }
+ }
+ AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
+ doneFilters, flags, filterDecl);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddMethodToCallChain --
+ *
+ * Utility method that manages the adding of a particular method
+ * implementation to a call-chain.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddMethodToCallChain(
+ Method *const mPtr, /* Actual method implementation to add to call
+ * chain (or NULL, a no-op). */
+ struct ChainBuilder *const cbPtr,
+ /* The call chain to add the method
+ * implementation to. */
+ Tcl_HashTable *const doneFilters,
+ /* Where to record what filters have been
+ * processed. If NULL, not processing filters.
+ * Note that this function does not update
+ * this hashtable. */
+ Class *const filterDecl) /* The class that declared the filter. If
+ * NULL, either the filter was declared by the
+ * object or this isn't a filter. */
+{
+ register CallChain *callPtr = cbPtr->callChainPtr;
+ int i;
+
+ /*
+ * Return if this is just an entry used to record whether this is a public
+ * method. If so, there's nothing real to call and so nothing to add to
+ * the call chain.
+ */
+
+ if (mPtr == NULL || mPtr->typePtr == NULL) {
+ return;
+ }
+
+ /*
+ * Enforce real private method handling here. We will skip adding this
+ * method IF
+ * 1) we are not allowing private methods, AND
+ * 2) this is a private method, AND
+ * 3) this is a class method, AND
+ * 4) this method was not declared by the class of the current object.
+ *
+ * This does mean that only classes really handle private methods. This
+ * should be sufficient for [incr Tcl] support though.
+ */
+
+ if (!(callPtr->flags & PRIVATE_METHOD)
+ && (mPtr->flags & PRIVATE_METHOD)
+ && (mPtr->declaringClassPtr != NULL)
+ && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
+ return;
+ }
+
+ /*
+ * First test whether the method is already in the call chain. Skip over
+ * any leading filters.
+ */
+
+ for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) {
+ if (callPtr->chain[i].mPtr == mPtr &&
+ callPtr->chain[i].isFilter == (doneFilters != NULL)) {
+ /*
+ * Call chain semantics states that methods come as *late* in the
+ * call chain as possible. This is done by copying down the
+ * following methods. Note that this does not change the number of
+ * method invokations in the call chain; it just rearranges them.
+ */
+
+ Class *declCls = callPtr->chain[i].filterDeclarer;
+
+ for (; i+1<callPtr->numChain ; i++) {
+ callPtr->chain[i] = callPtr->chain[i+1];
+ }
+ callPtr->chain[i].mPtr = mPtr;
+ callPtr->chain[i].isFilter = (doneFilters != NULL);
+ callPtr->chain[i].filterDeclarer = declCls;
+ return;
+ }
+ }
+
+ /*
+ * Need to really add the method. This is made a bit more complex by the
+ * fact that we are using some "static" space initially, and only start
+ * realloc-ing if the chain gets long.
+ */
+
+ if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
+ 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 = ckrealloc(callPtr->chain,
+ sizeof(struct MInvoke) * (callPtr->numChain + 1));
+ }
+ callPtr->chain[i].mPtr = mPtr;
+ callPtr->chain[i].isFilter = (doneFilters != NULL);
+ callPtr->chain[i].filterDeclarer = filterDecl;
+ callPtr->numChain++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitCallChain --
+ * Encoding of the policy of how to set up a call chain. Doesn't populate
+ * the chain with the method implementation data.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+InitCallChain(
+ CallChain *callPtr,
+ Object *oPtr,
+ int flags)
+{
+ callPtr->flags = flags &
+ (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
+ if (oPtr->flags & USE_CLASS_CACHE) {
+ oPtr = oPtr->selfCls->thisPtr;
+ callPtr->flags |= USE_CLASS_CACHE;
+ }
+ callPtr->epoch = oPtr->fPtr->epoch;
+ callPtr->objectCreationEpoch = oPtr->creationEpoch;
+ callPtr->objectEpoch = oPtr->epoch;
+ callPtr->refCount = 1;
+ callPtr->numChain = 0;
+ callPtr->chain = callPtr->staticChain;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * IsStillValid --
+ * Calculates whether the given call chain can be used for executing a
+ * method for the given object. The condition on a chain from a cached
+ * location being reusable is:
+ * - Refers to the same object (same creation epoch), and
+ * - Still across the same class structure (same global epoch), and
+ * - Still across the same object strucutre (same local epoch), and
+ * - No public/private/filter magic leakage (same flags, modulo the fact
+ * that a public chain will satisfy a non-public call).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+IsStillValid(
+ CallChain *callPtr,
+ Object *oPtr,
+ int flags,
+ int mask)
+{
+ if ((oPtr->flags & USE_CLASS_CACHE)) {
+ oPtr = oPtr->selfCls->thisPtr;
+ flags |= USE_CLASS_CACHE;
+ }
+ return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
+ && (callPtr->epoch == oPtr->fPtr->epoch)
+ && (callPtr->objectEpoch == oPtr->epoch)
+ && ((callPtr->flags & mask) == (flags & mask)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetCallContext --
+ *
+ * Responsible for constructing the call context, an ordered list of all
+ * method implementations to be called as part of a method invokation.
+ * This method is central to the whole operation of the OO system.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+CallContext *
+TclOOGetCallContext(
+ Object *oPtr, /* 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. */
+ Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
+ * to be in the same object as the
+ * methodNameObj. */
+{
+ CallContext *contextPtr;
+ CallChain *callPtr;
+ struct ChainBuilder cb;
+ int i, count, doFilters;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable doneFilters;
+
+ if (cacheInThisObj == NULL) {
+ cacheInThisObj = methodNameObj;
+ }
+ if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
+ hPtr = NULL;
+ doFilters = 0;
+
+ /*
+ * Check if we have a cached valid constructor or destructor.
+ */
+
+ if (flags & CONSTRUCTOR) {
+ callPtr = oPtr->selfCls->constructorChainPtr;
+ if ((callPtr != NULL)
+ && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
+ && (callPtr->epoch == oPtr->fPtr->epoch)) {
+ callPtr->refCount++;
+ goto returnContext;
+ }
+ } else if (flags & DESTRUCTOR) {
+ callPtr = oPtr->selfCls->destructorChainPtr;
+ if ((oPtr->mixins.num == 0) && (callPtr != NULL)
+ && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
+ && (callPtr->epoch == oPtr->fPtr->epoch)) {
+ callPtr->refCount++;
+ goto returnContext;
+ }
+ }
+ } else {
+ /*
+ * 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).
+ */
+
+ const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
+
+ if (cacheInThisObj->typePtr == &methodNameType) {
+ callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
+ if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
+ callPtr->refCount++;
+ goto returnContext;
+ }
+ FreeMethodNameRep(cacheInThisObj);
+ }
+
+ if (oPtr->flags & USE_CLASS_CACHE) {
+ if (oPtr->selfCls->classChainCache != NULL) {
+ hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
+ (char *) methodNameObj);
+ } else {
+ hPtr = NULL;
+ }
+ } else {
+ if (oPtr->chainCache != NULL) {
+ hPtr = Tcl_FindHashEntry(oPtr->chainCache,
+ (char *) methodNameObj);
+ } else {
+ hPtr = NULL;
+ }
+ }
+
+ if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
+ callPtr = Tcl_GetHashValue(hPtr);
+ if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
+ callPtr->refCount++;
+ goto returnContext;
+ }
+ Tcl_SetHashValue(hPtr, NULL);
+ TclOODeleteChain(callPtr);
+ }
+
+ doFilters = 1;
+ }
+
+ callPtr = ckalloc(sizeof(CallChain));
+ InitCallChain(callPtr, oPtr, flags);
+
+ cb.callChainPtr = callPtr;
+ cb.filterLength = 0;
+ 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).
+ */
+
+ if (doFilters) {
+ Tcl_Obj *filterObj;
+ Class *mixinPtr;
+
+ doFilters = 1;
+ Tcl_InitObjHashTable(&doneFilters);
+ FOREACH(mixinPtr, oPtr->mixins) {
+ AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
+ }
+ FOREACH(filterObj, oPtr->filters) {
+ AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
+ NULL);
+ }
+ AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
+ Tcl_DeleteHashTable(&doneFilters);
+ }
+ count = cb.filterLength = callPtr->numChain;
+
+ /*
+ * Add the actual method implementations.
+ */
+
+ AddSimpleChainToCallContext(oPtr, 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) {
+ /*
+ * Method does not actually exist. If we're dealing with constructors
+ * or destructors, this isn't a problem.
+ */
+
+ if (flags & SPECIAL) {
+ TclOODeleteChain(callPtr);
+ return NULL;
+ }
+ AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+ &cb, NULL, 0, NULL);
+ callPtr->flags |= OO_UNKNOWN_METHOD;
+ callPtr->epoch = -1;
+ if (count == callPtr->numChain) {
+ TclOODeleteChain(callPtr);
+ return NULL;
+ }
+ } else if (doFilters) {
+ if (hPtr == NULL) {
+ if (oPtr->flags & USE_CLASS_CACHE) {
+ if (oPtr->selfCls->classChainCache == NULL) {
+ oPtr->selfCls->classChainCache =
+ ckalloc(sizeof(Tcl_HashTable));
+
+ Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
+ }
+ hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
+ (char *) methodNameObj, &i);
+ } else {
+ if (oPtr->chainCache == NULL) {
+ oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));
+
+ Tcl_InitObjHashTable(oPtr->chainCache);
+ }
+ hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
+ (char *) methodNameObj, &i);
+ }
+ }
+ callPtr->refCount++;
+ Tcl_SetHashValue(hPtr, callPtr);
+ StashCallChain(cacheInThisObj, callPtr);
+ } else if (flags & CONSTRUCTOR) {
+ if (oPtr->selfCls->constructorChainPtr) {
+ TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
+ }
+ oPtr->selfCls->constructorChainPtr = callPtr;
+ callPtr->refCount++;
+ } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
+ if (oPtr->selfCls->destructorChainPtr) {
+ TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
+ }
+ oPtr->selfCls->destructorChainPtr = callPtr;
+ callPtr->refCount++;
+ }
+
+ returnContext:
+ contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
+ contextPtr->oPtr = oPtr;
+ AddRef(oPtr);
+ contextPtr->callPtr = callPtr;
+ contextPtr->skip = 2;
+ contextPtr->index = 0;
+ return contextPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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
+ * easier.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddClassFiltersToCallContext(
+ Object *const oPtr, /* Object that the filters operate on. */
+ Class *clsPtr, /* Class to get the filters from. */
+ struct ChainBuilder *const cbPtr,
+ /* Context to fill with call chain entries. */
+ Tcl_HashTable *const doneFilters)
+ /* Where to record what filters have been
+ * processed. Keys are objects, values are
+ * ignored. */
+{
+ int i;
+ Class *superPtr, *mixinPtr;
+ Tcl_Obj *filterObj;
+
+ tailRecurse:
+ if (clsPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Add all the filters defined by classes mixed into the main class
+ * hierarchy.
+ */
+
+ FOREACH(mixinPtr, clsPtr->mixins) {
+ AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
+ }
+
+ /*
+ * Add all the class filters from the current class. Note that the filters
+ * are added starting at the object root, as this allows the object to
+ * override how filters work to extend their behaviour.
+ */
+
+ FOREACH(filterObj, clsPtr->filters) {
+ int isNew;
+
+ (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
+ if (isNew) {
+ AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
+ 0, clsPtr);
+ }
+ }
+
+ /*
+ * Now process the recursive case. Notice the tail-call optimization.
+ */
+
+ switch (clsPtr->superclasses.num) {
+ case 1:
+ clsPtr = clsPtr->superclasses.list[0];
+ goto tailRecurse;
+ default:
+ FOREACH(superPtr, clsPtr->superclasses) {
+ AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
+ }
+ case 0:
+ return;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleClassChainToCallContext --
+ *
+ * Construct a call-chain from a class hierarchy.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddSimpleClassChainToCallContext(
+ Class *classPtr, /* Class to add the call chain entries for. */
+ Tcl_Obj *const methodNameObj,
+ /* Name of method to add the call chain
+ * entries for. */
+ struct ChainBuilder *const cbPtr,
+ /* Where to add the call chain entries. */
+ Tcl_HashTable *const doneFilters,
+ /* Where to record what call chain entries
+ * have been processed. */
+ int flags, /* What sort of call chain are we building. */
+ Class *const filterDecl) /* The class that declared the filter. If
+ * NULL, either the filter was declared by the
+ * object or this isn't a filter. */
+{
+ int i;
+ Class *superPtr;
+
+ /*
+ * We hard-code the tail-recursive form. It's by far the most common case
+ * *and* it is much more gentle on the stack.
+ *
+ * Note that mixins must be processed before the main class hierarchy.
+ * [Bug 1998221]
+ */
+
+ tailRecurse:
+ FOREACH(superPtr, classPtr->mixins) {
+ AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
+ doneFilters, flags, filterDecl);
+ }
+
+ if (flags & CONSTRUCTOR) {
+ AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
+ filterDecl);
+
+ } else if (flags & DESTRUCTOR) {
+ AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
+ filterDecl);
+ } else {
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
+ (char *) methodNameObj);
+
+ if (hPtr != NULL) {
+ register Method *mPtr = Tcl_GetHashValue(hPtr);
+
+ if (!(flags & KNOWN_STATE)) {
+ if (flags & PUBLIC_METHOD) {
+ if (mPtr->flags & PUBLIC_METHOD) {
+ flags |= DEFINITE_PUBLIC;
+ } else {
+ return;
+ }
+ } else {
+ flags |= DEFINITE_PROTECTED;
+ }
+ }
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
+ }
+ }
+
+ switch (classPtr->superclasses.num) {
+ case 1:
+ classPtr = classPtr->superclasses.list[0];
+ goto tailRecurse;
+ default:
+ FOREACH(superPtr, classPtr->superclasses) {
+ AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
+ doneFilters, flags, filterDecl);
+ }
+ case 0:
+ return;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
new file mode 100644
index 0000000..9fd62ec
--- /dev/null
+++ b/generic/tclOODecls.h
@@ -0,0 +1,234 @@
+/*
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+#ifndef _TCLOODECLS
+#define _TCLOODECLS
+
+#ifndef TCLAPI
+# ifdef BUILD_tcl
+# define TCLAPI extern DLLEXPORT
+# else
+# define TCLAPI extern DLLIMPORT
+# endif
+#endif
+
+#ifdef USE_TCL_STUBS
+# undef USE_TCLOO_STUBS
+# define USE_TCLOO_STUBS
+#endif
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+ Tcl_Object sourceObject,
+ const char *targetName,
+ const char *targetNamespaceName);
+/* 1 */
+TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
+/* 2 */
+TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
+/* 3 */
+TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
+/* 4 */
+TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+/* 5 */
+TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+/* 6 */
+TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
+/* 7 */
+TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
+/* 8 */
+TCLAPI int Tcl_MethodIsPublic(Tcl_Method method);
+/* 9 */
+TCLAPI int Tcl_MethodIsType(Tcl_Method method,
+ const Tcl_MethodType *typePtr,
+ ClientData *clientDataPtr);
+/* 10 */
+TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
+/* 11 */
+TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
+ Tcl_Object object, Tcl_Obj *nameObj,
+ int isPublic, const Tcl_MethodType *typePtr,
+ ClientData clientData);
+/* 12 */
+TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+ Tcl_Obj *nameObj, int isPublic,
+ const Tcl_MethodType *typePtr,
+ ClientData clientData);
+/* 13 */
+TCLAPI 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 */
+TCLAPI int Tcl_ObjectDeleted(Tcl_Object object);
+/* 15 */
+TCLAPI int Tcl_ObjectContextIsFiltering(
+ Tcl_ObjectContext context);
+/* 16 */
+TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+/* 17 */
+TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
+/* 18 */
+TCLAPI int Tcl_ObjectContextSkippedArgs(
+ Tcl_ObjectContext context);
+/* 19 */
+TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr);
+/* 20 */
+TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
+ const Tcl_ObjectMetadataType *typePtr,
+ ClientData metadata);
+/* 21 */
+TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr);
+/* 22 */
+TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
+ const Tcl_ObjectMetadataType *typePtr,
+ ClientData metadata);
+/* 23 */
+TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+ Tcl_ObjectContext context, int objc,
+ Tcl_Obj *const *objv, int skip);
+/* 24 */
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+ Tcl_Object object);
+/* 25 */
+TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+ Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
+/* 26 */
+TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
+ Tcl_Class clazz, Tcl_Method method);
+/* 27 */
+TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
+ Tcl_Class clazz, Tcl_Method method);
+/* 28 */
+TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
+ Tcl_Object object);
+
+typedef struct {
+ const struct TclOOIntStubs *tclOOIntStubs;
+} TclOOStubHooks;
+
+typedef struct TclOOStubs {
+ int magic;
+ 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 */
+ Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
+ Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
+ Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
+ Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
+ Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
+ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
+ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
+ int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
+ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
+ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
+ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
+ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
+ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
+ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
+ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
+ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
+ int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
+ ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
+ void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
+ ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
+ void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
+ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
+ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
+ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
+ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
+ void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
+ Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
+} TclOOStubs;
+
+extern const TclOOStubs *tclOOStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCLOO_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define Tcl_CopyObjectInstance \
+ (tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */
+#define Tcl_GetClassAsObject \
+ (tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */
+#define Tcl_GetObjectAsClass \
+ (tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */
+#define Tcl_GetObjectCommand \
+ (tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */
+#define Tcl_GetObjectFromObj \
+ (tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */
+#define Tcl_GetObjectNamespace \
+ (tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */
+#define Tcl_MethodDeclarerClass \
+ (tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */
+#define Tcl_MethodDeclarerObject \
+ (tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */
+#define Tcl_MethodIsPublic \
+ (tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */
+#define Tcl_MethodIsType \
+ (tclOOStubsPtr->tcl_MethodIsType) /* 9 */
+#define Tcl_MethodName \
+ (tclOOStubsPtr->tcl_MethodName) /* 10 */
+#define Tcl_NewInstanceMethod \
+ (tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */
+#define Tcl_NewMethod \
+ (tclOOStubsPtr->tcl_NewMethod) /* 12 */
+#define Tcl_NewObjectInstance \
+ (tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */
+#define Tcl_ObjectDeleted \
+ (tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */
+#define Tcl_ObjectContextIsFiltering \
+ (tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */
+#define Tcl_ObjectContextMethod \
+ (tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */
+#define Tcl_ObjectContextObject \
+ (tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */
+#define Tcl_ObjectContextSkippedArgs \
+ (tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */
+#define Tcl_ClassGetMetadata \
+ (tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */
+#define Tcl_ClassSetMetadata \
+ (tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */
+#define Tcl_ObjectGetMetadata \
+ (tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */
+#define Tcl_ObjectSetMetadata \
+ (tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */
+#define Tcl_ObjectContextInvokeNext \
+ (tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */
+#define Tcl_ObjectGetMethodNameMapper \
+ (tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */
+#define Tcl_ObjectSetMethodNameMapper \
+ (tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
+#define Tcl_ClassSetConstructor \
+ (tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
+#define Tcl_ClassSetDestructor \
+ (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
+#define Tcl_GetObjectName \
+ (tclOOStubsPtr->tcl_GetObjectName) /* 28 */
+
+#endif /* defined(USE_TCLOO_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLOODECLS */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
new file mode 100644
index 0000000..5a6c0ad
--- /dev/null
+++ b/generic/tclOODefineCmds.c
@@ -0,0 +1,2697 @@
+/*
+ * tclOODefineCmds.c --
+ *
+ * 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-2013 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#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,
+ Tcl_Namespace *namespacePtr, Object *oPtr,
+ int objc, Tcl_Obj *const objv[]);
+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}}
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * BumpGlobalEpoch --
+ * Utility that ensures that call chains that are invalid will get thrown
+ * away at an appropriate time. Note that exactly which epoch gets
+ * advanced will depend on exactly what the class is tangled up in; in
+ * the worst case, the simplest option is to advance the global epoch,
+ * causing *everything* to be thrown away on next usage.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+BumpGlobalEpoch(
+ Tcl_Interp *interp,
+ Class *classPtr)
+{
+ if (classPtr != NULL
+ && classPtr->subclasses.num == 0
+ && classPtr->instances.num == 0
+ && classPtr->mixinSubs.num == 0) {
+ /*
+ * If a class has no subclasses or instances, and is not mixed into
+ * anything, a change to its structure does not require us to
+ * invalidate any call chains. Note that we still bump our object's
+ * epoch if it has any mixins; the relation between a class and its
+ * representative object is special. But it won't hurt.
+ */
+
+ if (classPtr->thisPtr->mixins.num > 0) {
+ classPtr->thisPtr->epoch++;
+ }
+ return;
+ }
+
+ /*
+ * Either there's no class (?!) or we're reconfiguring something that is
+ * in use. Force regeneration of call chains.
+ */
+
+ TclOOGetFoundation(interp)->epoch++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RecomputeClassCacheFlag --
+ * Determine whether the object is prototypical of its class, and hence
+ * able to use the class's method chain cache.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+RecomputeClassCacheFlag(
+ Object *oPtr)
+{
+ if ((oPtr->methodsPtr == NULL || oPtr->methodsPtr->numEntries == 0)
+ && (oPtr->mixins.num == 0) && (oPtr->filters.num == 0)) {
+ oPtr->flags |= USE_CLASS_CACHE;
+ } else {
+ oPtr->flags &= ~USE_CLASS_CACHE;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectSetFilters --
+ * Install a list of filter method names into an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOObjectSetFilters(
+ Object *oPtr,
+ int numFilters,
+ Tcl_Obj *const *filters)
+{
+ int i;
+
+ if (oPtr->filters.num) {
+ Tcl_Obj *filterObj;
+
+ FOREACH(filterObj, oPtr->filters) {
+ Tcl_DecrRefCount(filterObj);
+ }
+ }
+
+ if (numFilters == 0) {
+ /*
+ * No list of filters was supplied, so we're deleting filters.
+ */
+
+ ckfree(oPtr->filters.list);
+ oPtr->filters.list = NULL;
+ oPtr->filters.num = 0;
+ RecomputeClassCacheFlag(oPtr);
+ } else {
+ /*
+ * We've got a list of filters, so we're creating filters.
+ */
+
+ Tcl_Obj **filtersList;
+ int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */
+
+ if (oPtr->filters.num == 0) {
+ filtersList = ckalloc(size);
+ } else {
+ filtersList = ckrealloc(oPtr->filters.list, size);
+ }
+ for (i=0 ; i<numFilters ; i++) {
+ filtersList[i] = filters[i];
+ Tcl_IncrRefCount(filters[i]);
+ }
+ oPtr->filters.list = filtersList;
+ oPtr->filters.num = numFilters;
+ oPtr->flags &= ~USE_CLASS_CACHE;
+ }
+ oPtr->epoch++; /* Only this object can be affected. */
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOClassSetFilters --
+ * Install a list of filter method names into a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOClassSetFilters(
+ Tcl_Interp *interp,
+ Class *classPtr,
+ int numFilters,
+ Tcl_Obj *const *filters)
+{
+ int i;
+
+ if (classPtr->filters.num) {
+ Tcl_Obj *filterObj;
+
+ FOREACH(filterObj, classPtr->filters) {
+ Tcl_DecrRefCount(filterObj);
+ }
+ }
+
+ if (numFilters == 0) {
+ /*
+ * No list of filters was supplied, so we're deleting filters.
+ */
+
+ ckfree(classPtr->filters.list);
+ classPtr->filters.list = NULL;
+ classPtr->filters.num = 0;
+ } else {
+ /*
+ * We've got a list of filters, so we're creating filters.
+ */
+
+ Tcl_Obj **filtersList;
+ int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */
+
+ if (classPtr->filters.num == 0) {
+ filtersList = ckalloc(size);
+ } else {
+ filtersList = ckrealloc(classPtr->filters.list, size);
+ }
+ for (i=0 ; i<numFilters ; i++) {
+ filtersList[i] = filters[i];
+ Tcl_IncrRefCount(filters[i]);
+ }
+ classPtr->filters.list = filtersList;
+ classPtr->filters.num = numFilters;
+ }
+
+ /*
+ * There may be many objects affected, so bump the global epoch.
+ */
+
+ BumpGlobalEpoch(interp, classPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectSetMixins --
+ * Install a list of mixin classes into an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOObjectSetMixins(
+ Object *oPtr,
+ int numMixins,
+ Class *const *mixins)
+{
+ Class *mixinPtr;
+ int i;
+
+ if (numMixins == 0) {
+ if (oPtr->mixins.num != 0) {
+ FOREACH(mixinPtr, oPtr->mixins) {
+ TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
+ ckfree(oPtr->mixins.list);
+ oPtr->mixins.num = 0;
+ }
+ RecomputeClassCacheFlag(oPtr);
+ } else {
+ if (oPtr->mixins.num != 0) {
+ FOREACH(mixinPtr, oPtr->mixins) {
+ if (mixinPtr != oPtr->selfCls) {
+ TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
+ }
+ oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
+ sizeof(Class *) * numMixins);
+ } else {
+ oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
+ oPtr->flags &= ~USE_CLASS_CACHE;
+ }
+ oPtr->mixins.num = numMixins;
+ memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
+ FOREACH(mixinPtr, oPtr->mixins) {
+ if (mixinPtr != oPtr->selfCls) {
+ TclOOAddToInstances(oPtr, mixinPtr);
+ }
+ }
+ }
+ oPtr->epoch++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOClassSetMixins --
+ * Install a list of mixin classes into a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOClassSetMixins(
+ Tcl_Interp *interp,
+ Class *classPtr,
+ int numMixins,
+ Class *const *mixins)
+{
+ Class *mixinPtr;
+ int i;
+
+ if (numMixins == 0) {
+ if (classPtr->mixins.num != 0) {
+ FOREACH(mixinPtr, classPtr->mixins) {
+ TclOORemoveFromMixinSubs(classPtr, mixinPtr);
+ }
+ ckfree(classPtr->mixins.list);
+ classPtr->mixins.num = 0;
+ }
+ } else {
+ if (classPtr->mixins.num != 0) {
+ FOREACH(mixinPtr, classPtr->mixins) {
+ TclOORemoveFromMixinSubs(classPtr, mixinPtr);
+ }
+ classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
+ sizeof(Class *) * numMixins);
+ } else {
+ classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
+ }
+ classPtr->mixins.num = numMixins;
+ memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
+ FOREACH(mixinPtr, classPtr->mixins) {
+ TclOOAddToMixinSubs(classPtr, mixinPtr);
+ }
+ }
+ BumpGlobalEpoch(interp, classPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RenameDeleteMethod --
+ * Core of the code to rename and delete methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+RenameDeleteMethod(
+ Tcl_Interp *interp,
+ Object *oPtr,
+ int useClass,
+ Tcl_Obj *const fromPtr,
+ Tcl_Obj *const toPtr)
+{
+ Tcl_HashEntry *hPtr, *newHPtr = NULL;
+ Method *mPtr;
+ int isNew;
+
+ if (!useClass) {
+ if (!oPtr->methodsPtr) {
+ noSuchMethod:
+ 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);
+ if (hPtr == NULL) {
+ goto noSuchMethod;
+ }
+ if (toPtr) {
+ newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr,
+ &isNew);
+ if (hPtr == newHPtr) {
+ renameToSelf:
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "method called %s already exists",
+ TclGetString(toPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
+ return TCL_ERROR;
+ }
+ }
+ } else {
+ hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
+ (char *) fromPtr);
+ if (hPtr == NULL) {
+ goto noSuchMethod;
+ }
+ if (toPtr) {
+ newHPtr = Tcl_CreateHashEntry(&oPtr->classPtr->classMethods,
+ (char *) toPtr, &isNew);
+ if (hPtr == newHPtr) {
+ goto renameToSelf;
+ } else if (!isNew) {
+ goto renameToExisting;
+ }
+ }
+ }
+
+ /*
+ * Complete the splicing by changing the method's name.
+ */
+
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (toPtr) {
+ Tcl_IncrRefCount(toPtr);
+ Tcl_DecrRefCount(mPtr->namePtr);
+ mPtr->namePtr = toPtr;
+ Tcl_SetHashValue(newHPtr, mPtr);
+ } else {
+ if (!useClass) {
+ RecomputeClassCacheFlag(oPtr);
+ }
+ TclOODelMethodRef(mPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOUnknownDefinition --
+ * Handles what happens when an unknown command is encountered during the
+ * processing of a definition script. Works by finding a command in the
+ * operating definition namespace that the requested command is a unique
+ * prefix of.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOUnknownDefinition(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ int soughtLen;
+ const char *soughtStr, *matchedStr = NULL;
+
+ if (objc < 2) {
+ 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) {
+ return TCL_ERROR;
+ }
+
+ soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
+ if (soughtLen == 0) {
+ goto noMatch;
+ }
+ hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ while (hPtr != NULL) {
+ const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
+
+ if (strncmp(soughtStr, nameStr, soughtLen) == 0) {
+ if (matchedStr != NULL) {
+ goto noMatch;
+ }
+ matchedStr = nameStr;
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+
+ if (matchedStr != NULL) {
+ /*
+ * Got one match, and only one match!
+ */
+
+ Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
+ int result;
+
+ newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ if (objc > 2) {
+ memcpy(newObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+ }
+ result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
+ Tcl_DecrRefCount(newObjv[0]);
+ TclStackFree(interp, newObjv);
+ return result;
+ }
+
+ noMatch:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", soughtStr));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
+ return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FindCommand --
+ * Specialized version of Tcl_FindCommand that handles command prefixes
+ * and disallows namespace magic.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Command
+FindCommand(
+ Tcl_Interp *interp,
+ Tcl_Obj *stringObj,
+ Tcl_Namespace *const namespacePtr)
+{
+ int length;
+ const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
+ register Namespace *const nsPtr = (Namespace *) namespacePtr;
+ FOREACH_HASH_DECLS;
+ Tcl_Command cmd, cmd2;
+
+ /*
+ * If someone is playing games, we stop playing right now.
+ */
+
+ if (string[0] == '\0' || strstr(string, "::") != NULL) {
+ return NULL;
+ }
+
+ /*
+ * Do the exact lookup first.
+ */
+
+ cmd = Tcl_FindCommand(interp, string, namespacePtr, TCL_NAMESPACE_ONLY);
+ if (cmd != NULL) {
+ return cmd;
+ }
+
+ /*
+ * Bother, need to perform an approximate match. Iterate across the hash
+ * table of commands in the namespace.
+ */
+
+ FOREACH_HASH(nameStr, cmd2, &nsPtr->cmdTable) {
+ if (strncmp(string, nameStr, length) == 0) {
+ if (cmd != NULL) {
+ return NULL;
+ }
+ cmd = cmd2;
+ }
+ }
+
+ /*
+ * Either we found one thing or we found nothing. Either way, return it.
+ */
+
+ return cmd;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitDefineContext --
+ * Does the magic incantations necessary to push the special stack frame
+ * used when processing object definitions. It is up to the caller to
+ * dispose of the frame (with TclPopStackFrame) when finished.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+InitDefineContext(
+ Tcl_Interp *interp,
+ Tcl_Namespace *namespacePtr,
+ Object *oPtr,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ CallFrame *framePtr, **framePtrPtr = &framePtr;
+ int result;
+
+ if (namespacePtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot process definitions; support namespace deleted",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+
+ result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ namespacePtr, FRAME_IS_OO_DEFINE);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ framePtr->clientData = oPtr;
+ framePtr->objc = objc;
+ framePtr->objv = objv; /* Reference counts do not need to be
+ * incremented here. */
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetDefineCmdContext --
+ * Extracts the magic token from the current stack frame, or returns NULL
+ * (and leaves an error message) otherwise.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+TclOOGetDefineCmdContext(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Object object;
+
+ if ((iPtr->varFramePtr == NULL)
+ || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
+ 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 object;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * GetClassInOuterContext --
+ * Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
+ * context that called oo::define (or equivalent). Note that this may
+ * have to go up multiple levels to get the level that we started doing
+ * definitions at.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline Class *
+GetClassInOuterContext(
+ Tcl_Interp *interp,
+ Tcl_Obj *className,
+ const char *errMsg)
+{
+ Interp *iPtr = (Interp *) interp;
+ Object *oPtr;
+ CallFrame *savedFramePtr = iPtr->varFramePtr;
+
+ while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
+ if (iPtr->varFramePtr->callerVarPtr == NULL) {
+ Tcl_Panic("getting outer context when already in global context");
+ }
+ iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
+ iPtr->varFramePtr = savedFramePtr;
+ if (oPtr == NULL) {
+ return NULL;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(className), NULL);
+ return NULL;
+ }
+ return oPtr->classPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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
+ * object to be modified is known to the commands in the target
+ * namespace. Also does ensemble-like tricks with dispatch so that error
+ * messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Foundation *fPtr = TclOOGetFoundation(interp);
+ int result;
+ Object *oPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == 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;
+ }
+
+ /*
+ * Make the oo::define namespace the current namespace and evaluate the
+ * command(s).
+ */
+
+ if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ 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) {
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class");
+ }
+ TclDecrRefCount(objNameObj);
+ } else {
+ Tcl_Obj *objPtr, *obj2Ptr, **objs;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Command cmd;
+ int dummy;
+
+ /*
+ * More than one argument: fire them through the ensemble processing
+ * engine so that everything appears to be good and proper in error
+ * messages. Note that we cannot just concatenate and send through
+ * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+ * cannot go through Tcl_EvalObjv without the extra work to pre-find
+ * the command, as that finds command names in the wrong namespace at
+ * the moment. Ugly!
+ */
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 3;
+ iPtr->ensembleRewrite.numInsertedObjs = 1;
+ } else {
+ int ni = iPtr->ensembleRewrite.numInsertedObjs;
+ if (ni < 3) {
+ iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs -= 2;
+ }
+ }
+
+ /*
+ * Build the list of arguments using a Tcl_Obj as a workspace. See
+ * comments above for why these contortions are necessary.
+ */
+
+ objPtr = Tcl_NewObj();
+ obj2Ptr = Tcl_NewObj();
+ cmd = FindCommand(interp, objv[2], fPtr->defineNs);
+ if (cmd == NULL) {
+ /* punt this case! */
+ Tcl_AppendObjToObj(obj2Ptr, objv[2]);
+ } else {
+ Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
+ Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+ result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+ Tcl_DecrRefCount(objPtr);
+ }
+ DelRef(oPtr);
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjDefObjCmd --
+ * Implementation of the "oo::objdefine" command. Works by effectively
+ * doing the same as 'namespace eval', but with extra magic applied so
+ * that the object to be modified is known to the commands in the target
+ * namespace. Also does ensemble-like tricks with dispatch so that error
+ * messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOObjDefObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Foundation *fPtr = TclOOGetFoundation(interp);
+ int result;
+ Object *oPtr;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the oo::objdefine namespace the current namespace and evaluate the
+ * command(s).
+ */
+
+ if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ 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) {
+ GenerateErrorInfo(interp, oPtr, objNameObj, "object");
+ }
+ TclDecrRefCount(objNameObj);
+ } else {
+ Tcl_Obj *objPtr, *obj2Ptr, **objs;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Command cmd;
+ int dummy;
+
+ /*
+ * More than one argument: fire them through the ensemble processing
+ * engine so that everything appears to be good and proper in error
+ * messages. Note that we cannot just concatenate and send through
+ * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+ * cannot go through Tcl_EvalObjv without the extra work to pre-find
+ * the command, as that finds command names in the wrong namespace at
+ * the moment. Ugly!
+ */
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 3;
+ iPtr->ensembleRewrite.numInsertedObjs = 1;
+ } else {
+ int ni = iPtr->ensembleRewrite.numInsertedObjs;
+ if (ni < 3) {
+ iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs -= 2;
+ }
+ }
+
+ /*
+ * Build the list of arguments using a Tcl_Obj as a workspace. See
+ * comments above for why these contortions are necessary.
+ */
+
+ objPtr = Tcl_NewObj();
+ obj2Ptr = Tcl_NewObj();
+ cmd = FindCommand(interp, objv[2], fPtr->objdefNs);
+ if (cmd == NULL) {
+ /* punt this case! */
+ Tcl_AppendObjToObj(obj2Ptr, objv[2]);
+ } else {
+ Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
+ Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+ result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+ Tcl_DecrRefCount(objPtr);
+ }
+ DelRef(oPtr);
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineSelfObjCmd --
+ * Implementation of the "self" subcommand of the "oo::define" command.
+ * Works by effectively doing the same as 'namespace eval', but with
+ * extra magic applied so that the object to be modified is known to the
+ * commands in the target namespace. Also does ensemble-like tricks with
+ * dispatch so that error messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineSelfObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Foundation *fPtr = TclOOGetFoundation(interp);
+ int result;
+ Object *oPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make the oo::objdefine namespace the current namespace and evaluate the
+ * command(s).
+ */
+
+ if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+ return TCL_ERROR;
+ }
+
+ 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) {
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
+ }
+ TclDecrRefCount(objNameObj);
+ } else {
+ Tcl_Obj *objPtr, *obj2Ptr, **objs;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Command cmd;
+ int dummy;
+
+ /*
+ * More than one argument: fire them through the ensemble processing
+ * engine so that everything appears to be good and proper in error
+ * messages. Note that we cannot just concatenate and send through
+ * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+ * cannot go through Tcl_EvalObjv without the extra work to pre-find
+ * the command, as that finds command names in the wrong namespace at
+ * the moment. Ugly!
+ */
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 2;
+ iPtr->ensembleRewrite.numInsertedObjs = 1;
+ } else {
+ int ni = iPtr->ensembleRewrite.numInsertedObjs;
+ if (ni < 2) {
+ iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs -= 1;
+ }
+ }
+
+ /*
+ * Build the list of arguments using a Tcl_Obj as a workspace. See
+ * comments above for why these contortions are necessary.
+ */
+
+ objPtr = Tcl_NewObj();
+ obj2Ptr = Tcl_NewObj();
+ cmd = FindCommand(interp, objv[1], fPtr->objdefNs);
+ if (cmd == NULL) {
+ /* punt this case! */
+ Tcl_AppendObjToObj(obj2Ptr, objv[1]);
+ } else {
+ Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
+ Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+ result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
+ Tcl_DecrRefCount(objPtr);
+ }
+ DelRef(oPtr);
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineClassObjCmd --
+ * Implementation of the "class" subcommand of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineClassObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr;
+ Class *clsPtr;
+ Foundation *fPtr = TclOOGetFoundation(interp);
+
+ /*
+ * Parse the context to get the object to operate on.
+ */
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->flags & ROOT_OBJECT) {
+ 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_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;
+ }
+
+ /*
+ * Parse the argument to get the class to set the object's class to.
+ */
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassInOuterContext(interp, objv[1],
+ "the class of an object must be a class");
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Apply semantic checks. In particular, classes and non-classes are not
+ * interchangable (too complicated to do the conversion!) so we must
+ * produce an error if any attempt is made to swap from one to the other.
+ */
+
+ if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
+ 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;
+ }
+
+ /*
+ * Set the object's class.
+ */
+
+ if (oPtr->selfCls != clsPtr) {
+ TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+ oPtr->selfCls = clsPtr;
+ TclOOAddToInstances(oPtr, oPtr->selfCls);
+ if (oPtr->classPtr != NULL) {
+ BumpGlobalEpoch(interp, oPtr->classPtr);
+ } else {
+ oPtr->epoch++;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineConstructorObjCmd --
+ * Implementation of the "constructor" subcommand of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineConstructorObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr;
+ Class *clsPtr;
+ Tcl_Method method;
+ int bodyLength;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract and validate the context, which is the class that we wish to
+ * modify.
+ */
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ clsPtr = oPtr->classPtr;
+
+ Tcl_GetStringFromObj(objv[2], &bodyLength);
+ if (bodyLength > 0) {
+ /*
+ * Create the method structure.
+ */
+
+ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
+ PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
+ if (method == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Delete the constructor method record and set the field in the
+ * class record to NULL.
+ */
+
+ method = NULL;
+ }
+
+ /*
+ * Place the method structure in the class record. Note that we might not
+ * immediately delete the constructor as this might be being done during
+ * execution of the constructor itself.
+ */
+
+ Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineDeleteMethodObjCmd --
+ * Implementation of the "deletemethod" subcommand of the "oo::define"
+ * and "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineDeleteMethodObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceDeleteMethod = (clientData != NULL);
+ Object *oPtr;
+ int i;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceDeleteMethod && !oPtr->classPtr) {
+ 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++) {
+ /*
+ * Delete the method structure from the appropriate hash table.
+ */
+
+ if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
+ objv[i], NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (isInstanceDeleteMethod) {
+ oPtr->epoch++;
+ } else {
+ BumpGlobalEpoch(interp, oPtr->classPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineDestructorObjCmd --
+ * Implementation of the "destructor" subcommand of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineDestructorObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr;
+ Class *clsPtr;
+ Tcl_Method method;
+ int bodyLength;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "body");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ clsPtr = oPtr->classPtr;
+
+ Tcl_GetStringFromObj(objv[1], &bodyLength);
+ if (bodyLength > 0) {
+ /*
+ * Create the method structure.
+ */
+
+ method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
+ PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
+ if (method == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Delete the destructor method record and set the field in the class
+ * record to NULL.
+ */
+
+ method = NULL;
+ }
+
+ /*
+ * Place the method structure in the class record. Note that we might not
+ * immediately delete the destructor as this might be being done during
+ * execution of the destructor itself. Also note that setting a
+ * destructor during a destructor is fairly dumb anyway.
+ */
+
+ Tcl_ClassSetDestructor(interp, (Tcl_Class) clsPtr, method);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineExportObjCmd --
+ * Implementation of the "export" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineExportObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceExport = (clientData != NULL);
+ Object *oPtr;
+ Method *mPtr;
+ Tcl_HashEntry *hPtr;
+ Class *clsPtr;
+ int i, isNew, changed = 0;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ clsPtr = oPtr->classPtr;
+ if (!isInstanceExport && !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++) {
+ /*
+ * Exporting is done by adding the PUBLIC_METHOD flag to 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 with that flag; such
+ * records are skipped over by the call chain engine *except* for
+ * their flags member.
+ */
+
+ if (isInstanceExport) {
+ 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;
+ }
+ }
+
+ /*
+ * Bump the right epoch if we actually changed anything.
+ */
+
+ if (changed) {
+ if (isInstanceExport) {
+ oPtr->epoch++;
+ } else {
+ BumpGlobalEpoch(interp, clsPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineForwardObjCmd --
+ * Implementation of the "forward" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineForwardObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceForward = (clientData != NULL);
+ Object *oPtr;
+ Method *mPtr;
+ int isPublic;
+ Tcl_Obj *prefixObj;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceForward && !oPtr->classPtr) {
+ 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]*")
+ ? PUBLIC_METHOD : 0;
+
+ /*
+ * Create the method structure.
+ */
+
+ prefixObj = Tcl_NewListObj(objc-2, objv+2);
+ if (isInstanceForward) {
+ mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
+ prefixObj);
+ } else {
+ mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
+ objv[1], prefixObj);
+ }
+ if (mPtr == NULL) {
+ Tcl_DecrRefCount(prefixObj);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineMethodObjCmd --
+ * Implementation of the "method" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineMethodObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceMethod = (clientData != NULL);
+ Object *oPtr;
+ int isPublic;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceMethod && !oPtr->classPtr) {
+ 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]*")
+ ? PUBLIC_METHOD : 0;
+
+ /*
+ * Create the method by using the right back-end API.
+ */
+
+ if (isInstanceMethod) {
+ if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
+ objv[2], objv[3], NULL) == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1],
+ objv[2], objv[3], NULL) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineMixinObjCmd --
+ * Implementation of the "mixin" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineMixinObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ const int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceMixin = (clientData != NULL);
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Class **mixins;
+ int i;
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceMixin && !oPtr->classPtr) {
+ 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));
+
+ for (i=1 ; i<objc ; i++) {
+ Class *clsPtr = GetClassInOuterContext(interp, objv[i],
+ "may only mix in classes");
+
+ if (clsPtr == NULL) {
+ goto freeAndError;
+ }
+ if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
+ 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;
+ }
+
+ if (isInstanceMixin) {
+ TclOOObjectSetMixins(oPtr, objc-1, mixins);
+ } else {
+ TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
+ }
+
+ TclStackFree(interp, mixins);
+ return TCL_OK;
+
+ freeAndError:
+ TclStackFree(interp, mixins);
+ return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineRenameMethodObjCmd --
+ * Implementation of the "renamemethod" subcommand of the "oo::define"
+ * and "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineRenameMethodObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceRenameMethod = (clientData != NULL);
+ Object *oPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!isInstanceRenameMethod && !oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Delete the method entry from the appropriate hash table, and transfer
+ * the thing it points to to its new entry. To do this, we first need to
+ * get the entries from the appropriate hash tables (this can generate a
+ * range of errors...)
+ */
+
+ if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
+ objv[1], objv[2]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (isInstanceRenameMethod) {
+ oPtr->epoch++;
+ } else {
+ BumpGlobalEpoch(interp, oPtr->classPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineUnexportObjCmd --
+ * Implementation of the "unexport" subcommand of the "oo::define" and
+ * "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineUnexportObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstanceUnexport = (clientData != NULL);
+ Object *oPtr;
+ Method *mPtr;
+ Tcl_HashEntry *hPtr;
+ Class *clsPtr;
+ int i, isNew, changed = 0;
+
+ if (objc < 2) {
+ 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;
+ }
+ }
+
+ /*
+ * Bump the right epoch if we actually changed anything.
+ */
+
+ 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;
+ }
+
+ 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 == 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;
+ }
+
+ /*
+ * Allocate some working space.
+ */
+
+ superclasses = (Class **) ckalloc(sizeof(Class *) * superc);
+
+ /*
+ * Parse the arguments to get the class to use as superclasses.
+ *
+ * Note that zero classes is special, as it is equivalent to just the
+ * class of objects. [Bug 9d61624b3d]
+ */
+
+ if (superc == 0) {
+ superclasses = ckrealloc(superclasses, sizeof(Class *));
+ superclasses[0] = oPtr->fPtr->objectCls;
+ superc = 1;
+ if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
+ superclasses[0] = oPtr->fPtr->classCls;
+ }
+ } else {
+ for (i=0 ; i<superc ; i++) {
+ superclasses[i] = GetClassInOuterContext(interp, superv[i],
+ "only a class can be a superclass");
+ if (superclasses[i] == NULL) {
+ goto failedAfterAlloc;
+ }
+ for (j=0 ; j<i ; j++) {
+ 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, 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;
+ }
+ }
+ }
+
+ /*
+ * Install the list of superclasses into the class. Note that this also
+ * involves splicing the class out of the superclasses' subclass list that
+ * it used to be a member of and splicing it into the new superclasses'
+ * subclass list.
+ */
+
+ if (oPtr->classPtr->superclasses.num != 0) {
+ FOREACH(superPtr, oPtr->classPtr->superclasses) {
+ TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
+ }
+ ckfree((char *) oPtr->classPtr->superclasses.list);
+ }
+ oPtr->classPtr->superclasses.list = superclasses;
+ oPtr->classPtr->superclasses.num = superc;
+ FOREACH(superPtr, oPtr->classPtr->superclasses) {
+ TclOOAddToSubclasses(oPtr->classPtr, superPtr);
+ }
+ BumpGlobalEpoch(interp, oPtr->classPtr);
+
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassVarsGet, ClassVarsSet --
+ * Implementation of the "variable" slot accessors of the "oo::define"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ClassVarsGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj, *variableObj;
+ 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(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);
+
+ 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;
+ }
+
+ 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;
+ }
+ }
+
+ 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 {
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * varc);
+ }
+ }
+
+ oPtr->classPtr->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->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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectFilterGet, ObjectFilterSet --
+ * Implementation of the "filter" slot accessors of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ObjFilterGet(
+ 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;
+ } 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;
+ }
+ objv += Tcl_ObjectContextSkippedArgs(context);
+ if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
+ &filterv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ TclOOObjectSetFilters(oPtr, filterc, filterv);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectMixinGet, ObjectMixinSet --
+ * Implementation of the "mixin" slot accessors of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+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;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(mixinPtr, oPtr->mixins) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+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;
+ }
+ }
+
+ TclOOObjectSetMixins(oPtr, mixinc, mixins);
+ TclStackFree(interp, mixins);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectVarsGet, ObjectVarsSet --
+ * Implementation of the "variable" slot accessors of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ObjVarsGet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Tcl_Obj *resultObj, *variableObj;
+ 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;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+static int
+ObjVarsSet(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int varc, i;
+ Tcl_Obj **varv, *variableObj;
+
+ 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;
+ }
+ 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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
new file mode 100644
index 0000000..3217f98
--- /dev/null
+++ b/generic/tclOOInfo.c
@@ -0,0 +1,1526 @@
+/*
+ * tclOODefineCmds.c --
+ *
+ * This file contains the implementation of the ::oo-related [info]
+ * subcommands.
+ *
+ * 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#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;
+static Tcl_ObjCmdProc InfoObjectForwardCmd;
+static Tcl_ObjCmdProc InfoObjectIsACmd;
+static Tcl_ObjCmdProc InfoObjectMethodsCmd;
+static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
+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;
+static Tcl_ObjCmdProc InfoClassFiltersCmd;
+static Tcl_ObjCmdProc InfoClassForwardCmd;
+static Tcl_ObjCmdProc InfoClassInstancesCmd;
+static Tcl_ObjCmdProc InfoClassMethodsCmd;
+static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
+static Tcl_ObjCmdProc InfoClassMixinsCmd;
+static Tcl_ObjCmdProc InfoClassSubsCmd;
+static Tcl_ObjCmdProc InfoClassSupersCmd;
+static Tcl_ObjCmdProc InfoClassVariablesCmd;
+
+/*
+ * List of commands that are used to implement the [info object] subcommands.
+ */
+
+static const EnsembleImplMap infoObjectCmds[] = {
+ {"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
+ {"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0},
+ {"methods", InfoObjectMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
+ {"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
+
+/*
+ * List of commands that are used to implement the [info class] subcommands.
+ */
+
+static const EnsembleImplMap infoClassCmds[] = {
+ {"call", InfoClassCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"constructor", InfoClassConstrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"definition", InfoClassDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"destructor", InfoClassDestrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"filters", InfoClassFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"forward", InfoClassForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"instances", InfoClassInstancesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"methods", InfoClassMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+ {"methodtype", InfoClassMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInitInfo --
+ *
+ * Adjusts the Tcl core [info] command to contain subcommands ("object"
+ * and "class") for introspection of objects and classes.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOInitInfo(
+ Tcl_Interp *interp)
+{
+ Tcl_Command infoCmd;
+ Tcl_Obj *mapDict;
+
+ /*
+ * Build the ensembles used to implement [info object] and [info class].
+ */
+
+ 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);
+ 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);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * GetClassFromObj --
+ *
+ * How to correctly get a class from a Tcl_Obj. Just a wrapper round
+ * Tcl_GetObjectFromObj, but this is an idiom that was used heavily.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline Class *
+GetClassFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
+{
+ Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr);
+
+ if (oPtr == NULL) {
+ return NULL;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objPtr), NULL);
+ return NULL;
+ }
+ return oPtr->classPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectClassCmd --
+ *
+ * Implements [info object class $objName ?$className?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectClassCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ Tcl_SetObjResult(interp,
+ TclOOObjectName(interp, oPtr->selfCls->thisPtr));
+ return TCL_OK;
+ } else {
+ Class *mixinPtr, *o2clsPtr;
+ int i;
+
+ o2clsPtr = GetClassFromObj(interp, objv[2]);
+ if (o2clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ FOREACH(mixinPtr, oPtr->mixins) {
+ if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ return TCL_OK;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
+ return TCL_OK;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectDefnCmd --
+ *
+ * Implements [info object definition $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectDefnCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ Tcl_HashEntry *hPtr;
+ Proc *procPtr;
+ CompiledLocal *localPtr;
+ Tcl_Obj *resultObjs[2];
+
+ 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;
+ }
+
+ if (!oPtr->methodsPtr) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
+ if (hPtr == NULL) {
+ unknownMethod:
+ 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_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;
+ }
+
+ resultObjs[0] = Tcl_NewObj();
+ for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_Obj *argObj;
+
+ argObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, argObj,
+ Tcl_NewStringObj(localPtr->name, -1));
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+ }
+ Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
+ }
+ }
+ resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectFiltersCmd --
+ *
+ * Implements [info object filters $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectFiltersCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int i;
+ Tcl_Obj *filterObj, *resultObj;
+ Object *oPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectForwardCmd --
+ *
+ * Implements [info object forward $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectForwardCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *prefixObj;
+
+ 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;
+ }
+
+ if (!oPtr->methodsPtr) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
+ if (hPtr == NULL) {
+ unknownMethod:
+ 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_SetObjResult(interp, Tcl_NewStringObj(
+ "prefix argument list not available for this kind of method",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, prefixObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectIsACmd --
+ *
+ * Implements [info object isa $category $objName ...]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectIsACmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *const categories[] = {
+ "class", "metaclass", "mixin", "object", "typeof", NULL
+ };
+ enum IsACats {
+ IsClass, IsMetaclass, IsMixin, IsObject, IsType
+ };
+ Object *oPtr, *o2Ptr;
+ int idx, i;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (idx == IsObject) {
+ int ok = (Tcl_GetObjectFromObj(interp, objv[2]) != NULL);
+
+ if (!ok) {
+ Tcl_ResetResult(interp);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
+ return TCL_OK;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum IsACats) idx) {
+ case IsClass:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objName");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
+ return TCL_OK;
+ case IsMetaclass:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objName");
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ } else {
+ Class *classCls = TclOOGetFoundation(interp)->classCls;
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
+ }
+ return TCL_OK;
+ case IsMixin:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objName className");
+ return TCL_ERROR;
+ }
+ o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+ if (o2Ptr == NULL) {
+ return TCL_ERROR;
+ }
+ if (o2Ptr->classPtr == 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;
+
+ FOREACH(mixinPtr, oPtr->mixins) {
+ if (mixinPtr == o2Ptr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ return TCL_OK;
+ }
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ return TCL_OK;
+ case IsType:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objName className");
+ return TCL_ERROR;
+ }
+ o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+ if (o2Ptr == NULL) {
+ return TCL_ERROR;
+ }
+ if (o2Ptr->classPtr == 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)) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ }
+ return TCL_OK;
+ case IsObject:
+ Tcl_Panic("unexpected fallthrough");
+ }
+ return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectMethodsCmd --
+ *
+ * Implements [info object methods $objName ?$option ...?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectMethodsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ int flag = PUBLIC_METHOD, recurse = 0;
+ FOREACH_HASH_DECLS;
+ Tcl_Obj *namePtr, *resultObj;
+ Method *mPtr;
+ static const char *const options[] = {
+ "-all", "-localprivate", "-private", NULL
+ };
+ enum Options {
+ OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc != 2) {
+ int i, idx;
+
+ for (i=2 ; i<objc ; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum Options) idx) {
+ case OPT_ALL:
+ recurse = 1;
+ break;
+ case OPT_LOCALPRIVATE:
+ flag = PRIVATE_METHOD;
+ break;
+ case OPT_PRIVATE:
+ flag = 0;
+ break;
+ }
+ }
+ }
+
+ resultObj = Tcl_NewObj();
+ if (recurse) {
+ const char **names;
+ int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
+
+ for (i=0 ; i<numNames ; i++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(names[i], -1));
+ }
+ if (numNames > 0) {
+ ckfree(names);
+ }
+ } else if (oPtr->methodsPtr) {
+ FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
+ if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+ Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
+ }
+ }
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectMethodTypeCmd --
+ *
+ * Implements [info object methodtype $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectMethodTypeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ Tcl_HashEntry *hPtr;
+ Method *mPtr;
+
+ 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;
+ }
+
+ if (!oPtr->methodsPtr) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
+ if (hPtr == NULL) {
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (mPtr->typePtr == NULL) {
+ /*
+ * Special entry for visibility control: pretend the method doesnt
+ * exist.
+ */
+
+ goto unknownMethod;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectMixinsCmd --
+ *
+ * Implements [info object mixins $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectMixinsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *mixinPtr;
+ Object *oPtr;
+ Tcl_Obj *resultObj;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(mixinPtr, oPtr->mixins) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectNsCmd --
+ *
+ * Implements [info object namespace $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectNsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectVariablesCmd --
+ *
+ * Implements [info object variables $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectVariablesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ Tcl_Obj *variableObj, *resultObj;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectVarsCmd --
+ *
+ * Implements [info object vars $objName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectVarsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ const char *pattern = NULL;
+ FOREACH_HASH_DECLS;
+ VarInHash *vihPtr;
+ Tcl_Obj *nameObj, *resultObj;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ pattern = TclGetString(objv[2]);
+ }
+ resultObj = Tcl_NewObj();
+
+ /*
+ * Extract the information we need from the object's namespace's table of
+ * variables. Note that this involves horrific knowledge of the guts of
+ * tclVar.c, so we can't leverage our hash-iteration macros properly.
+ */
+
+ FOREACH_HASH_VALUE(vihPtr,
+ &((Namespace *) oPtr->namespacePtr)->varTable.table) {
+ nameObj = vihPtr->entry.key.objPtr;
+
+ if (TclIsVarUndefined(&vihPtr->var)
+ || !TclIsVarNamespaceVar(&vihPtr->var)) {
+ continue;
+ }
+ if (pattern != NULL
+ && !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
+ }
+
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassConstrCmd --
+ *
+ * Implements [info class constructor $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassConstrCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Proc *procPtr;
+ CompiledLocal *localPtr;
+ Tcl_Obj *resultObjs[2];
+ Class *clsPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (clsPtr->constructorPtr == NULL) {
+ return TCL_OK;
+ }
+ procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
+ if (procPtr == 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;
+ }
+
+ resultObjs[0] = Tcl_NewObj();
+ for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_Obj *argObj;
+
+ argObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, argObj,
+ Tcl_NewStringObj(localPtr->name, -1));
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+ }
+ Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
+ }
+ }
+ resultObjs[1] = TclOOGetMethodBody(clsPtr->constructorPtr);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassDefnCmd --
+ *
+ * Implements [info class definition $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassDefnCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_HashEntry *hPtr;
+ Proc *procPtr;
+ CompiledLocal *localPtr;
+ Tcl_Obj *resultObjs[2];
+ Class *clsPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
+ if (hPtr == 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_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;
+ }
+
+ resultObjs[0] = Tcl_NewObj();
+ for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_Obj *argObj;
+
+ argObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, argObj,
+ Tcl_NewStringObj(localPtr->name, -1));
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+ }
+ Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
+ }
+ }
+ resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassDestrCmd --
+ *
+ * Implements [info class destructor $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassDestrCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Proc *procPtr;
+ Class *clsPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (clsPtr->destructorPtr == NULL) {
+ return TCL_OK;
+ }
+ procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
+ if (procPtr == 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;
+ }
+
+ Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassFiltersCmd --
+ *
+ * Implements [info class filters $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassFiltersCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int i;
+ Tcl_Obj *filterObj, *resultObj;
+ Class *clsPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(filterObj, clsPtr->filters) {
+ Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassForwardCmd --
+ *
+ * Implements [info class forward $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassForwardCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *prefixObj;
+ Class *clsPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
+ if (hPtr == 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_SetObjResult(interp, Tcl_NewStringObj(
+ "prefix argument list not available for this kind of method",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, prefixObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassInstancesCmd --
+ *
+ * Implements [info class instances $clsName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassInstancesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+ Class *clsPtr;
+ int i;
+ const char *pattern = NULL;
+ Tcl_Obj *resultObj;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ pattern = TclGetString(objv[2]);
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(oPtr, clsPtr->instances) {
+ Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr);
+
+ if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassMethodsCmd --
+ *
+ * Implements [info class methods $clsName ?-private?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassMethodsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int flag = PUBLIC_METHOD, recurse = 0;
+ Tcl_Obj *namePtr, *resultObj;
+ Method *mPtr;
+ Class *clsPtr;
+ static const char *const options[] = {
+ "-all", "-localprivate", "-private", NULL
+ };
+ enum Options {
+ OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc != 2) {
+ int i, idx;
+
+ for (i=2 ; i<objc ; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum Options) idx) {
+ case OPT_ALL:
+ recurse = 1;
+ break;
+ case OPT_LOCALPRIVATE:
+ flag = PRIVATE_METHOD;
+ break;
+ case OPT_PRIVATE:
+ flag = 0;
+ break;
+ }
+ }
+ }
+
+ resultObj = Tcl_NewObj();
+ if (recurse) {
+ const char **names;
+ int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);
+
+ for (i=0 ; i<numNames ; i++) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(names[i], -1));
+ }
+ if (numNames > 0) {
+ ckfree(names);
+ }
+ } else {
+ FOREACH_HASH_DECLS;
+
+ FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
+ if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+ Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
+ }
+ }
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassMethodTypeCmd --
+ *
+ * Implements [info class methodtype $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassMethodTypeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_HashEntry *hPtr;
+ Method *mPtr;
+ Class *clsPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
+ if (hPtr == NULL) {
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (mPtr->typePtr == NULL) {
+ /*
+ * Special entry for visibility control: pretend the method doesnt
+ * exist.
+ */
+
+ goto unknownMethod;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassMixinsCmd --
+ *
+ * Implements [info class mixins $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassMixinsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *clsPtr, *mixinPtr;
+ Tcl_Obj *resultObj;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(mixinPtr, clsPtr->mixins) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, mixinPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassSubsCmd --
+ *
+ * Implements [info class subclasses $clsName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassSubsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *clsPtr, *subclassPtr;
+ Tcl_Obj *resultObj;
+ int i;
+ const char *pattern = NULL;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ pattern = TclGetString(objv[2]);
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(subclassPtr, clsPtr->subclasses) {
+ Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
+
+ if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
+ }
+ FOREACH(subclassPtr, clsPtr->mixinSubs) {
+ Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
+
+ if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassSupersCmd --
+ *
+ * Implements [info class superclasses $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassSupersCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *clsPtr, *superPtr;
+ Tcl_Obj *resultObj;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(superPtr, clsPtr->superclasses) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ TclOOObjectName(interp, superPtr->thisPtr));
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassVariablesCmd --
+ *
+ * Implements [info class variables $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassVariablesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Class *clsPtr;
+ Tcl_Obj *variableObj, *resultObj;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultObj = Tcl_NewObj();
+ FOREACH(variableObj, clsPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
new file mode 100644
index 0000000..c0e4022
--- /dev/null
+++ b/generic/tclOOInt.h
@@ -0,0 +1,604 @@
+/*
+ * tclOOInt.h --
+ *
+ * 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-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.
+ */
+
+#ifndef TCL_OO_INTERNAL_H
+#define TCL_OO_INTERNAL_H 1
+
+#include "tclInt.h"
+#include "tclOO.h"
+
+/*
+ * Hack to make things work with Objective C. Note that ObjC isn't really
+ * supported, but we don't want to to be actively hostile to it. [Bug 2163447]
+ */
+
+#ifdef __OBJC__
+#define Class TclOOClass
+#define Object TclOOObject
+#endif /* __OBJC__ */
+
+/*
+ * Forward declarations.
+ */
+
+struct CallChain;
+struct Class;
+struct Foundation;
+struct Object;
+
+/*
+ * The data that needs to be stored per method. This record is used to collect
+ * information about all sorts of methods, including forwards, constructors
+ * and destructors.
+ */
+
+typedef struct Method {
+ const Tcl_MethodType *typePtr;
+ /* The type of method. If NULL, this is a
+ * special flag record which is just used for
+ * the setting of the flags field. */
+ int refCount;
+ ClientData clientData; /* Type-specific data. */
+ Tcl_Obj *namePtr; /* Name of the method. */
+ struct Object *declaringObjectPtr;
+ /* The object that declares this method, or
+ * NULL if it was declared by a class. */
+ struct Class *declaringClassPtr;
+ /* The class that declares this method, or
+ * NULL if it was declared directly on an
+ * object. */
+ int flags; /* Assorted flags. Includes whether this
+ * method is public/exported or not. */
+} Method;
+
+/*
+ * Pre- and post-call callbacks, to allow procedure-like methods to be fine
+ * tuned in their behaviour.
+ */
+
+typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
+ Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
+typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
+ Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
+typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
+typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData);
+
+/*
+ * Procedure-like methods have the following extra information.
+ */
+
+typedef struct ProcedureMethod {
+ int version; /* Version of this structure. Currently must
+ * be 0. */
+ Proc *procPtr; /* Core of the implementation of the method;
+ * includes the argument definition and the
+ * body bytecodes. */
+ int flags; /* Flags to control features. */
+ int refCount;
+ ClientData clientData;
+ TclOO_PmCDDeleteProc *deleteClientdataProc;
+ TclOO_PmCDCloneProc *cloneClientdataProc;
+ ProcErrorProc *errProc; /* Replacement error handler. */
+ TclOO_PreCallProc *preCallProc;
+ /* Callback to allow for additional setup
+ * before the method executes. */
+ TclOO_PostCallProc *postCallProc;
+ /* Callback to allow for additional cleanup
+ * after the method executes. */
+ GetFrameInfoValueProc *gfivProc;
+ /* Callback to allow for fine tuning of how
+ * the method reports itself. */
+} ProcedureMethod;
+
+#define TCLOO_PROCEDURE_METHOD_VERSION 0
+
+/*
+ * Flags for use in a ProcedureMethod.
+ *
+ * When the USE_DECLARER_NS flag is set, the method will use the namespace of
+ * the object or class that declared it (or the clone of it, if it was from
+ * such that the implementation of the method came to the particular use)
+ * instead of the namespace of the object on which the method was invoked.
+ * This flag must be distinct from all others that are associated with
+ * methods.
+ */
+
+#define USE_DECLARER_NS 0x80
+
+/*
+ * Forwarded methods have the following extra information.
+ */
+
+typedef struct ForwardMethod {
+ Tcl_Obj *prefixObj; /* The list of values to use to replace the
+ * object and method name with. Will be a
+ * non-empty list. */
+} ForwardMethod;
+
+/*
+ * Helper definitions that declare a "list" array. The two varieties are
+ * either optimized for simplicity (in the case that the whole array is
+ * typically assigned at once) or efficiency (in the case that the array is
+ * expected to be expanded over time). These lists are designed to be iterated
+ * over with the help of the FOREACH macro (see later in this file).
+ *
+ * The "num" field always counts the number of listType_t elements used in the
+ * "list" field. When a "size" field exists, it describes how many elements
+ * are present in the list; when absent, exactly "num" elements are present.
+ */
+
+#define LIST_STATIC(listType_t) \
+ struct { int num; listType_t *list; }
+#define LIST_DYNAMIC(listType_t) \
+ struct { int num, size; listType_t *list; }
+
+/*
+ * Now, the definition of what an object actually is.
+ */
+
+typedef struct Object {
+ struct Foundation *fPtr; /* The basis for the object system. Putting
+ * this here allows the avoidance of quite a
+ * lot of hash lookups on the critical path
+ * for object invokation and creation. */
+ Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
+ Tcl_Command command; /* Reference to this object's public
+ * command. */
+ Tcl_Command myCommand; /* Reference to this object's internal
+ * command. */
+ struct Class *selfCls; /* This object's class. */
+ Tcl_HashTable *methodsPtr; /* Object-local Tcl_Obj (method name) to
+ * Method* mapping. */
+ LIST_STATIC(struct Class *) mixins;
+ /* Classes mixed into this object. */
+ LIST_STATIC(Tcl_Obj *) filters;
+ /* List of filter names. */
+ struct Class *classPtr; /* All classes have this non-NULL; it points
+ * to the class structure. Everything else has
+ * this NULL. */
+ int refCount; /* Number of strong references to this object.
+ * Note that there may be many more weak
+ * references; this mechanism is there to
+ * avoid Tcl_Preserve. */
+ int flags;
+ int creationEpoch; /* Unique value to make comparisons of objects
+ * easier. */
+ int epoch; /* Per-object epoch, incremented when the way
+ * an object should resolve call chains is
+ * changed. */
+ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to
+ * the ClientData values that are the values
+ * of each piece of attached metadata. This
+ * field starts out as NULL and is only
+ * allocated if metadata is attached. */
+ Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */
+ Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table
+ * is indexed by method name as Tcl_Obj. */
+ Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
+ /* Function to allow remapping of method
+ * names. For itcl-ng. */
+ LIST_STATIC(Tcl_Obj *) variables;
+} Object;
+
+#define OBJECT_DELETED 1 /* Flag to say that an object has been
+ * destroyed. */
+#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
+ * called. */
+#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
+ * the class hierarchy and should be treated
+ * specially during teardown. */
+#define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a
+ * filter; when set, filters are *not*
+ * processed on the object, preventing nasty
+ * recursive filtering problems. */
+#define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure
+ * instance of the class, and has had nothing
+ * added that changes the dispatch chain (i.e.
+ * no methods, mixins, or filters. */
+#define ROOT_CLASS 0x8000 /* Flag to say that this object is the root
+ * 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
+ * object, through which it is manipulated.
+ */
+
+typedef struct Class {
+ Object *thisPtr; /* Reference to the object associated with
+ * this class. */
+ int refCount; /* Number of strong references to this class.
+ * Weak references are not counted; the
+ * purpose of this is to avoid Tcl_Preserve as
+ * that is quite slow. */
+ int flags; /* Assorted flags. */
+ LIST_STATIC(struct Class *) superclasses;
+ /* List of superclasses, used for generation
+ * of method call chains. */
+ LIST_DYNAMIC(struct Class *) subclasses;
+ /* List of subclasses, used to ensure deletion
+ * of dependent entities happens properly when
+ * the class itself is deleted. */
+ LIST_DYNAMIC(Object *) instances;
+ /* List of instances, used to ensure deletion
+ * of dependent entities happens properly when
+ * the class itself is deleted. */
+ LIST_STATIC(Tcl_Obj *) filters;
+ /* List of filter names, used for generation
+ * of method call chains. */
+ LIST_STATIC(struct Class *) mixins;
+ /* List of mixin classes, used for generation
+ * of method call chains. */
+ LIST_DYNAMIC(struct Class *) mixinSubs;
+ /* List of classes that this class is mixed
+ * into, used to ensure deletion of dependent
+ * entities happens properly when the class
+ * itself is deleted. */
+ Tcl_HashTable classMethods; /* Hash table of all methods. Hash maps from
+ * the (Tcl_Obj*) method name to the (Method*)
+ * method record. */
+ Method *constructorPtr; /* Method record of the class constructor (if
+ * any). */
+ Method *destructorPtr; /* Method record of the class destructor (if
+ * any). */
+ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to
+ * the ClientData values that are the values
+ * of each piece of attached metadata. This
+ * field starts out as NULL and is only
+ * allocated if metadata is attached. */
+ struct CallChain *constructorChainPtr;
+ struct CallChain *destructorChainPtr;
+ Tcl_HashTable *classChainCache;
+ /* Places where call chains are stored. For
+ * constructors, the class chain is always
+ * used. For destructors and ordinary methods,
+ * the class chain is only used when the
+ * object doesn't override with its own mixins
+ * (and filters and method implementations for
+ * when getting method chains). */
+ LIST_STATIC(Tcl_Obj *) variables;
+} Class;
+
+/*
+ * The foundation of the object system within an interpreter contains
+ * references to the key classes and namespaces, together with a few other
+ * useful bits and pieces. Probably ought to eventually go in the Interp
+ * structure itself.
+ */
+
+typedef struct ThreadLocalData {
+ int nsCount; /* Master epoch counter is used for keeping
+ * the values used in Tcl_Obj internal
+ * representations sane. Must be thread-local
+ * because Tcl_Objs can cross interpreter
+ * boundaries within a thread (objects don't
+ * generally cross threads). */
+} ThreadLocalData;
+
+typedef struct Foundation {
+ Tcl_Interp *interp;
+ Class *objectCls; /* The root of the object system. */
+ Class *classCls; /* The class of all classes. */
+ Tcl_Namespace *ooNs; /* Master ::oo namespace. */
+ Tcl_Namespace *defineNs; /* Namespace containing special commands for
+ * manipulating objects and classes. The
+ * "oo::define" command acts as a special kind
+ * of ensemble for this namespace. */
+ Tcl_Namespace *objdefNs; /* Namespace containing special commands for
+ * manipulating objects and classes. The
+ * "oo::objdefine" command acts as a special
+ * kind of ensemble for this namespace. */
+ Tcl_Namespace *helpersNs; /* Namespace containing the commands that are
+ * only valid when executing inside a
+ * procedural method. */
+ int epoch; /* Used to invalidate method chains when the
+ * class structure changes. */
+ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique
+ * namespace to each object. */
+ Tcl_Obj *unknownMethodNameObj;
+ /* Shared object containing the name of the
+ * unknown method handler method. */
+ Tcl_Obj *constructorName; /* Shared object containing the "name" of a
+ * 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;
+
+/*
+ * A call context structure is built when a method is called. They contain the
+ * chain of method implementations that are to be invoked by a particular
+ * call, and the process of calling walks the chain, with the [next] command
+ * proceeding to the next entry in the chain.
+ */
+
+#define CALL_CHAIN_STATIC_SIZE 4
+
+struct MInvoke {
+ Method *mPtr; /* Reference to the method implementation
+ * record. */
+ int isFilter; /* Whether this is a filter invokation. */
+ Class *filterDeclarer; /* What class decided to add the filter; if
+ * NULL, it was added by the object. */
+};
+
+typedef struct CallChain {
+ int objectCreationEpoch; /* The object's creation epoch. Note that the
+ * object reference is not stored in the call
+ * chain; it is in the call context. */
+ int objectEpoch; /* Local (object structure) epoch counter
+ * snapshot. */
+ int epoch; /* Global (class structure) epoch counter
+ * snapshot. */
+ int flags; /* Assorted flags, see below. */
+ int refCount; /* Reference count. */
+ int numChain; /* Size of the call chain. */
+ struct MInvoke *chain; /* Array of call chain entries. May point to
+ * staticChain if the number of entries is
+ * small. */
+ struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
+} CallChain;
+
+typedef struct CallContext {
+ Object *oPtr; /* The object associated with this call. */
+ int index; /* Index into the call chain of the currently
+ * executing method implementation. */
+ int skip; /* Current number of arguments to skip; can
+ * vary depending on whether it is a direct
+ * method call or a continuation via the
+ * [next] command. */
+ CallChain *callPtr; /* The actual call chain. */
+} CallContext;
+
+/*
+ * Bits for the 'flags' field of the call chain.
+ */
+
+#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
+#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
+ * only) method. */
+#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
+#define CONSTRUCTOR 0x08 /* This is a constructor. */
+#define DESTRUCTOR 0x10 /* This is a destructor. */
+
+/*
+ * Structure containing definition information about basic class methods.
+ */
+
+typedef struct {
+ const char *name; /* Name of the method in question. */
+ int isPublic; /* Whether the method is public by default. */
+ Tcl_MethodType definition; /* How to call the method. */
+} DeclaredClassMethod;
+
+/*
+ *----------------------------------------------------------------
+ * Commands relating to OO support.
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
+MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineExportObjCmd(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 TclOODefineRenameMethodObjCmd(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 TclOODefineClassObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+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);
+
+/*
+ * 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);
+MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Class_New(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+
+/*
+ * Private definitions, some of which perhaps ought to be exposed properly or
+ * maybe just put in the internal stubs table.
+ */
+
+MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
+MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
+MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
+ Tcl_Class cls, const char *nameStr,
+ 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);
+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);
+MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
+MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
+ int flags, const char ***stringsPtr);
+MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
+ const char ***stringsPtr);
+MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
+MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
+MODULE_SCOPE int TclOOInvokeContext(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
+ Tcl_ObjectContext context, int objc,
+ Tcl_Obj *const *objv, int skip);
+MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
+ const DeclaredClassMethod *dcm);
+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);
+
+/*
+ * Include all the private API, generated from tclOO.decls.
+ */
+
+#include "tclOOIntDecls.h"
+
+/*
+ * A convenience macro for iterating through the lists used in the internal
+ * memory management of objects. This is a bit gnarly because we want to do
+ * the assignment of the picked-out value only when the body test succeeds,
+ * but we cannot rely on the assigned value being useful, forcing us to do
+ * some nasty stuff with the comma operator. The compiler's optimizer should
+ * be able to sort it all out!
+ *
+ * REQUIRES DECLARATION: int i;
+ */
+
+#define FOREACH(var,ary) \
+ for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
+
+/*
+ * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
+ * sets up the declarations needed for the main macro, FOREACH_HASH, which
+ * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
+ * only iterates over values.
+ */
+
+#define FOREACH_HASH_DECLS \
+ Tcl_HashEntry *hPtr;Tcl_HashSearch search
+#define FOREACH_HASH(key,val,tablePtr) \
+ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
+ ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
+ (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
+#define FOREACH_HASH_VALUE(val,tablePtr) \
+ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
+ ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
+
+/*
+ * Convenience macro for duplicating a list. Needs no external declaration,
+ * but all arguments are used multiple times and so must have no side effects.
+ */
+
+#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
+#define DUPLICATE(target,source,type) \
+ do { \
+ register unsigned len = sizeof(type) * ((target).num=(source).num);\
+ if (len != 0) { \
+ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
+ } else { \
+ (target).list = NULL; \
+ } \
+ } while(0)
+
+/*
+ * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
+ */
+
+#define AddRef(ptr) ((ptr)->refCount++)
+#define DelRef(ptr) do { \
+ if (--(ptr)->refCount < 1) { \
+ ckfree((char *) (ptr)); \
+ } \
+ } while(0)
+
+#endif /* TCL_OO_INTERNAL_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
new file mode 100644
index 0000000..74a8d81
--- /dev/null
+++ b/generic/tclOOIntDecls.h
@@ -0,0 +1,166 @@
+/*
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+#ifndef _TCLOOINTDECLS
+#define _TCLOOINTDECLS
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
+/* 1 */
+TCLAPI 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 */
+TCLAPI 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 */
+TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
+ Object *oPtr, int flags, Tcl_Obj *nameObj,
+ Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ ProcedureMethod **pmPtrPtr);
+/* 4 */
+TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+ int flags, Tcl_Obj *nameObj,
+ Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ ProcedureMethod **pmPtrPtr);
+/* 5 */
+TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv,
+ int publicOnly, Class *startCls);
+/* 6 */
+TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
+/* 7 */
+TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
+ Class *clsPtr, int isPublic,
+ Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
+/* 8 */
+TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+ Object *oPtr, int isPublic, Tcl_Obj *nameObj,
+ Tcl_Obj *prefixObj);
+/* 9 */
+TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+ Tcl_Object oPtr,
+ TclOO_PreCallProc *preCallPtr,
+ TclOO_PostCallProc *postCallPtr,
+ ProcErrorProc *errProc,
+ ClientData clientData, Tcl_Obj *nameObj,
+ Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ int flags, void **internalTokenPtr);
+/* 10 */
+TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
+ Tcl_Class clsPtr,
+ TclOO_PreCallProc *preCallPtr,
+ TclOO_PostCallProc *postCallPtr,
+ ProcErrorProc *errProc,
+ ClientData clientData, Tcl_Obj *nameObj,
+ Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+ int flags, void **internalTokenPtr);
+/* 11 */
+TCLAPI int TclOOInvokeObject(Tcl_Interp *interp,
+ Tcl_Object object, Tcl_Class startCls,
+ int publicPrivate, int objc,
+ Tcl_Obj *const *objv);
+/* 12 */
+TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
+ Tcl_Obj *const *filters);
+/* 13 */
+TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
+ Class *classPtr, int numFilters,
+ Tcl_Obj *const *filters);
+/* 14 */
+TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+ Class *const *mixins);
+/* 15 */
+TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
+ Class *classPtr, int numMixins,
+ Class *const *mixins);
+
+typedef struct TclOOIntStubs {
+ int magic;
+ 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 */
+ 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); /* 2 */
+ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
+ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
+ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
+ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
+ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
+ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
+ Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
+ Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
+ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
+ void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
+ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
+ void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
+ void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
+} TclOOIntStubs;
+
+extern const TclOOIntStubs *tclOOIntStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCLOO_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define TclOOGetDefineCmdContext \
+ (tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */
+#define TclOOMakeProcInstanceMethod \
+ (tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */
+#define TclOOMakeProcMethod \
+ (tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */
+#define TclOONewProcInstanceMethod \
+ (tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */
+#define TclOONewProcMethod \
+ (tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */
+#define TclOOObjectCmdCore \
+ (tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */
+#define TclOOIsReachable \
+ (tclOOIntStubsPtr->tclOOIsReachable) /* 6 */
+#define TclOONewForwardMethod \
+ (tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */
+#define TclOONewForwardInstanceMethod \
+ (tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */
+#define TclOONewProcInstanceMethodEx \
+ (tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */
+#define TclOONewProcMethodEx \
+ (tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */
+#define TclOOInvokeObject \
+ (tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */
+#define TclOOObjectSetFilters \
+ (tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */
+#define TclOOClassSetFilters \
+ (tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */
+#define TclOOObjectSetMixins \
+ (tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */
+#define TclOOClassSetMixins \
+ (tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */
+
+#endif /* defined(USE_TCLOO_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLOOINTDECLS */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
new file mode 100644
index 0000000..61215de
--- /dev/null
+++ b/generic/tclOOMethod.c
@@ -0,0 +1,1783 @@
+/*
+ * tclOOMethod.c --
+ *
+ * This file contains code to create and manage methods.
+ *
+ * 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.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+#include "tclCompile.h"
+
+/*
+ * Structure used to help delay computing names of objects or classes for
+ * [info frame] until needed, making invokation faster in the normal case.
+ */
+
+struct PNI {
+ Tcl_Interp *interp; /* Interpreter in which to compute the name of
+ * a method. */
+ Tcl_Method method; /* Method to compute the name of. */
+};
+
+/*
+ * Structure used to contain all the information needed about a call frame
+ * used in a procedure-like method.
+ */
+
+typedef struct {
+ CallFrame *framePtr; /* Reference to the call frame itself (it's
+ * actually allocated on the Tcl stack). */
+ ProcErrorProc *errProc; /* The error handler for the body. */
+ 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;
+
+/*
+ * Structure used to pass information about variable resolution to the
+ * on-the-ground resolvers used when working with resolved compiled variables.
+ */
+
+typedef struct {
+ Tcl_ResolvedVarInfo info; /* "Type" information so that the compiled
+ * variable can be linked to the namespace
+ * variable at the right time. */
+ Tcl_Obj *variableObj; /* The name of the variable. */
+ Tcl_Var cachedObjectVar; /* TODO: When to flush this cache? Can class
+ * variables be cached? */
+} OOResVarInfo;
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv, int toRewrite,
+ int rewriteLength, Tcl_Obj *const *rewriteObjs,
+ int *lengthPtr);
+static int InvokeProcedureMethod(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static int FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int FinalizePMCall(ClientData data[], Tcl_Interp *interp,
+ int result);
+static int PushMethodCallFrame(Tcl_Interp *interp,
+ CallContext *contextPtr, ProcedureMethod *pmPtr,
+ int objc, Tcl_Obj *const *objv,
+ PMFrameData *fdPtr);
+static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
+static void DeleteProcedureMethod(ClientData clientData);
+static int CloneProcedureMethod(Tcl_Interp *interp,
+ ClientData clientData, ClientData *newClientData);
+static void MethodErrorHandler(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj);
+static void ConstructorErrorHandler(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj);
+static void DestructorErrorHandler(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj);
+static Tcl_Obj * RenderDeclarerName(ClientData clientData);
+static int InvokeForwardMethod(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
+static void DeleteForwardMethod(ClientData clientData);
+static int CloneForwardMethod(Tcl_Interp *interp,
+ ClientData clientData, ClientData *newClientData);
+static int ProcedureMethodVarResolver(Tcl_Interp *interp,
+ const char *varName, Tcl_Namespace *contextNs,
+ int flags, Tcl_Var *varPtr);
+static int ProcedureMethodCompiledVarResolver(Tcl_Interp *interp,
+ const char *varName, int length,
+ Tcl_Namespace *contextNs,
+ Tcl_ResolvedVarInfo **rPtrPtr);
+
+/*
+ * The types of methods defined by the core OO system.
+ */
+
+static const Tcl_MethodType procMethodType = {
+ TCL_OO_METHOD_VERSION_CURRENT, "method",
+ InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod
+};
+static const Tcl_MethodType fwdMethodType = {
+ TCL_OO_METHOD_VERSION_CURRENT, "forward",
+ InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod
+};
+
+/*
+ * Helper macros (derived from things private to tclVar.c)
+ */
+
+#define TclVarTable(contextNs) \
+ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
+#define TclVarHashGetValue(hPtr) \
+ ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewInstanceMethod --
+ *
+ * Attach a method to an object instance.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_NewInstanceMethod(
+ Tcl_Interp *interp, /* Unused? */
+ Tcl_Object object, /* The object that has the method attached to
+ * it. */
+ Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so,
+ * up to caller to manage storage (e.g., when
+ * it is a constructor or destructor). */
+ int flags, /* Whether this is a public method. */
+ const Tcl_MethodType *typePtr,
+ /* The type of method this is, which defines
+ * how to invoke, delete and clone the
+ * method. */
+ ClientData clientData) /* Some data associated with the particular
+ * method to be created. */
+{
+ register Object *oPtr = (Object *) object;
+ register Method *mPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ if (nameObj == NULL) {
+ mPtr = ckalloc(sizeof(Method));
+ mPtr->namePtr = NULL;
+ mPtr->refCount = 1;
+ goto populate;
+ }
+ if (!oPtr->methodsPtr) {
+ 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 = ckalloc(sizeof(Method));
+ mPtr->namePtr = nameObj;
+ mPtr->refCount = 1;
+ Tcl_IncrRefCount(nameObj);
+ Tcl_SetHashValue(hPtr, mPtr);
+ } else {
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+ mPtr->typePtr->deleteProc(mPtr->clientData);
+ }
+ }
+
+ populate:
+ mPtr->typePtr = typePtr;
+ mPtr->clientData = clientData;
+ mPtr->flags = 0;
+ mPtr->declaringObjectPtr = oPtr;
+ mPtr->declaringClassPtr = NULL;
+ if (flags) {
+ mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+ }
+ oPtr->epoch++;
+ return (Tcl_Method) mPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewMethod --
+ *
+ * Attach a method to a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_NewMethod(
+ Tcl_Interp *interp, /* The interpreter containing the class. */
+ Tcl_Class cls, /* The class to attach the method to. */
+ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
+ * for constructors or destructors); if so, up
+ * to caller to manage storage. */
+ int flags, /* Whether this is a public method. */
+ const Tcl_MethodType *typePtr,
+ /* The type of method this is, which defines
+ * how to invoke, delete and clone the
+ * method. */
+ ClientData clientData) /* Some data associated with the particular
+ * method to be created. */
+{
+ register Class *clsPtr = (Class *) cls;
+ register Method *mPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ if (nameObj == NULL) {
+ mPtr = ckalloc(sizeof(Method));
+ mPtr->namePtr = NULL;
+ mPtr->refCount = 1;
+ goto populate;
+ }
+ hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
+ if (isNew) {
+ mPtr = ckalloc(sizeof(Method));
+ mPtr->refCount = 1;
+ mPtr->namePtr = nameObj;
+ Tcl_IncrRefCount(nameObj);
+ Tcl_SetHashValue(hPtr, mPtr);
+ } else {
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+ mPtr->typePtr->deleteProc(mPtr->clientData);
+ }
+ }
+
+ populate:
+ clsPtr->thisPtr->fPtr->epoch++;
+ mPtr->typePtr = typePtr;
+ mPtr->clientData = clientData;
+ mPtr->flags = 0;
+ mPtr->declaringObjectPtr = NULL;
+ mPtr->declaringClassPtr = clsPtr;
+ if (flags) {
+ mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+ }
+
+ return (Tcl_Method) mPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODelMethodRef --
+ *
+ * How to delete a method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODelMethodRef(
+ Method *mPtr)
+{
+ if ((mPtr != NULL) && (--mPtr->refCount <= 0)) {
+ if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+ mPtr->typePtr->deleteProc(mPtr->clientData);
+ }
+ if (mPtr->namePtr != NULL) {
+ Tcl_DecrRefCount(mPtr->namePtr);
+ }
+
+ ckfree(mPtr);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewBasicMethod --
+ *
+ * Helper that makes it cleaner to create very simple methods during
+ * basic system initialization. Not suitable for general use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOONewBasicMethod(
+ Tcl_Interp *interp,
+ Class *clsPtr, /* Class to attach the method to. */
+ const DeclaredClassMethod *dcm)
+ /* Name of the method, whether it is public,
+ * and the function to implement it. */
+{
+ Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);
+
+ Tcl_IncrRefCount(namePtr);
+ Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr,
+ (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
+ Tcl_DecrRefCount(namePtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewProcInstanceMethod --
+ *
+ * Create a new procedure-like method for an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewProcInstanceMethod(
+ Tcl_Interp *interp, /* The interpreter containing the object. */
+ Object *oPtr, /* The object to modify. */
+ int flags, /* Whether this is a public method. */
+ Tcl_Obj *nameObj, /* The name of the method, which must not be
+ * NULL. */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which must not be NULL. */
+ Tcl_Obj *bodyObj, /* The body of the method, which must not be
+ * NULL. */
+ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method
+ * structure to allow for deeper tuning of the
+ * structure's contents. NULL if caller is not
+ * interested. */
+{
+ int argsLen;
+ register ProcedureMethod *pmPtr;
+ Tcl_Method method;
+
+ if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+ return NULL;
+ }
+ pmPtr = ckalloc(sizeof(ProcedureMethod));
+ memset(pmPtr, 0, sizeof(ProcedureMethod));
+ pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
+ pmPtr->flags = flags & USE_DECLARER_NS;
+ pmPtr->refCount = 1;
+
+ method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
+ argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
+ if (method == NULL) {
+ ckfree(pmPtr);
+ } else if (pmPtrPtr != NULL) {
+ *pmPtrPtr = pmPtr;
+ }
+ return (Method *) method;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewProcMethod --
+ *
+ * Create a new procedure-like method for a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewProcMethod(
+ Tcl_Interp *interp, /* The interpreter containing the class. */
+ Class *clsPtr, /* The class to modify. */
+ int flags, /* Whether this is a public method. */
+ Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
+ * if so, up to caller to manage storage
+ * (e.g., because it is a constructor or
+ * destructor). */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which may be NULL; if so, it is equivalent
+ * to an empty list. */
+ Tcl_Obj *bodyObj, /* The body of the method, which must not be
+ * NULL. */
+ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method
+ * structure to allow for deeper tuning of the
+ * structure's contents. NULL if caller is not
+ * interested. */
+{
+ int argsLen; /* -1 => delete argsObj before exit */
+ register ProcedureMethod *pmPtr;
+ const char *procName;
+ Tcl_Method method;
+
+ if (argsObj == NULL) {
+ argsLen = -1;
+ argsObj = Tcl_NewObj();
+ Tcl_IncrRefCount(argsObj);
+ procName = "<destructor>";
+ } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+ return NULL;
+ } else {
+ procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
+ }
+
+ pmPtr = ckalloc(sizeof(ProcedureMethod));
+ memset(pmPtr, 0, sizeof(ProcedureMethod));
+ pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
+ pmPtr->flags = flags & USE_DECLARER_NS;
+ pmPtr->refCount = 1;
+
+ method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
+ argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
+
+ if (argsLen == -1) {
+ Tcl_DecrRefCount(argsObj);
+ }
+ if (method == NULL) {
+ ckfree(pmPtr);
+ } else if (pmPtrPtr != NULL) {
+ *pmPtrPtr = pmPtr;
+ }
+
+ return (Method *) method;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOMakeProcInstanceMethod --
+ *
+ * The guts of the code to make a procedure-like method for an object.
+ * Split apart so that it is easier for other extensions to reuse (in
+ * particular, it frees them from having to pry so deeply into Tcl's
+ * guts).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+TclOOMakeProcInstanceMethod(
+ Tcl_Interp *interp, /* The interpreter containing the object. */
+ Object *oPtr, /* The object to modify. */
+ int flags, /* Whether this is a public method. */
+ Tcl_Obj *nameObj, /* The name of the method, which _must not_ be
+ * NULL. */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which _must not_ be NULL. */
+ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be
+ * NULL. */
+ const Tcl_MethodType *typePtr,
+ /* The type of the method to create. */
+ ClientData clientData, /* The per-method type-specific data. */
+ Proc **procPtrPtr) /* A pointer to the variable in which to write
+ * the procedure record reference. Presumably
+ * inside the structure indicated by the
+ * pointer in clientData. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Proc *procPtr;
+
+ if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
+ procPtrPtr) != TCL_OK) {
+ return NULL;
+ }
+ procPtr = *procPtrPtr;
+ procPtr->cmdPtr = NULL;
+
+ if (iPtr->cmdFramePtr) {
+ CmdFrame context = *iPtr->cmdFramePtr;
+
+ if (context.type == TCL_LOCATION_BC) {
+ /*
+ * Retrieve source information from the bytecode, if possible. If
+ * the information is retrieved successfully, context.type will be
+ * TCL_LOCATION_SOURCE and the reference held by
+ * context.data.eval.path will be counted.
+ */
+
+ TclGetSrcInfoForPc(&context);
+ } else if (context.type == TCL_LOCATION_SOURCE) {
+ /*
+ * The copy into 'context' up above has created another reference
+ * to 'context.data.eval.path'; account for it.
+ */
+
+ Tcl_IncrRefCount(context.data.eval.path);
+ }
+
+ if (context.type == TCL_LOCATION_SOURCE) {
+ /*
+ * We can account for source location within a proc only if the
+ * proc body was not created by substitution.
+ * (FIXME: check that this is sane and correct!)
+ */
+
+ if (context.line
+ && (context.nline >= 4) && (context.line[3] >= 0)) {
+ int isNew;
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
+ Tcl_HashEntry *hPtr;
+
+ cfPtr->level = -1;
+ cfPtr->type = context.type;
+ cfPtr->line = ckalloc(sizeof(int));
+ cfPtr->line[0] = context.line[3];
+ cfPtr->nline = 1;
+ cfPtr->framePtr = NULL;
+ cfPtr->nextPtr = NULL;
+
+ cfPtr->data.eval.path = context.data.eval.path;
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+ cfPtr->cmd = NULL;
+ cfPtr->len = 0;
+
+ hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+ (char *) procPtr, &isNew);
+ Tcl_SetHashValue(hPtr, cfPtr);
+ }
+
+ /*
+ * 'context' is going out of scope; account for the reference that
+ * it's holding to the path name.
+ */
+
+ Tcl_DecrRefCount(context.data.eval.path);
+ context.data.eval.path = NULL;
+ }
+ }
+
+ return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
+ typePtr, clientData);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOMakeProcMethod --
+ *
+ * The guts of the code to make a procedure-like method for a class.
+ * Split apart so that it is easier for other extensions to reuse (in
+ * particular, it frees them from having to pry so deeply into Tcl's
+ * guts).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+TclOOMakeProcMethod(
+ Tcl_Interp *interp, /* The interpreter containing the class. */
+ Class *clsPtr, /* The class to modify. */
+ int flags, /* Whether this is a public method. */
+ Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
+ * if so, up to caller to manage storage
+ * (e.g., because it is a constructor or
+ * destructor). */
+ const char *namePtr, /* The name of the method as a string, which
+ * _must not_ be NULL. */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which _must not_ be NULL. */
+ Tcl_Obj *bodyObj, /* The body of the method, which _must not_ be
+ * NULL. */
+ const Tcl_MethodType *typePtr,
+ /* The type of the method to create. */
+ ClientData clientData, /* The per-method type-specific data. */
+ Proc **procPtrPtr) /* A pointer to the variable in which to write
+ * the procedure record reference. Presumably
+ * inside the structure indicated by the
+ * pointer in clientData. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Proc *procPtr;
+
+ if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
+ procPtrPtr) != TCL_OK) {
+ return NULL;
+ }
+ procPtr = *procPtrPtr;
+ procPtr->cmdPtr = NULL;
+
+ if (iPtr->cmdFramePtr) {
+ CmdFrame context = *iPtr->cmdFramePtr;
+
+ if (context.type == TCL_LOCATION_BC) {
+ /*
+ * Retrieve source information from the bytecode, if possible. If
+ * the information is retrieved successfully, context.type will be
+ * TCL_LOCATION_SOURCE and the reference held by
+ * context.data.eval.path will be counted.
+ */
+
+ TclGetSrcInfoForPc(&context);
+ } else if (context.type == TCL_LOCATION_SOURCE) {
+ /*
+ * The copy into 'context' up above has created another reference
+ * to 'context.data.eval.path'; account for it.
+ */
+
+ Tcl_IncrRefCount(context.data.eval.path);
+ }
+
+ if (context.type == TCL_LOCATION_SOURCE) {
+ /*
+ * We can account for source location within a proc only if the
+ * proc body was not created by substitution.
+ * (FIXME: check that this is sane and correct!)
+ */
+
+ if (context.line
+ && (context.nline >= 4) && (context.line[3] >= 0)) {
+ int isNew;
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
+ Tcl_HashEntry *hPtr;
+
+ cfPtr->level = -1;
+ cfPtr->type = context.type;
+ cfPtr->line = ckalloc(sizeof(int));
+ cfPtr->line[0] = context.line[3];
+ cfPtr->nline = 1;
+ cfPtr->framePtr = NULL;
+ cfPtr->nextPtr = NULL;
+
+ cfPtr->data.eval.path = context.data.eval.path;
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+ cfPtr->cmd = NULL;
+ cfPtr->len = 0;
+
+ hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+ (char *) procPtr, &isNew);
+ Tcl_SetHashValue(hPtr, cfPtr);
+ }
+
+ /*
+ * 'context' is going out of scope; account for the reference that
+ * it's holding to the path name.
+ */
+
+ Tcl_DecrRefCount(context.data.eval.path);
+ context.data.eval.path = NULL;
+ }
+ }
+
+ return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
+ clientData);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InvokeProcedureMethod, PushMethodCallFrame --
+ *
+ * How to invoke a procedure-like method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InvokeProcedureMethod(
+ ClientData clientData, /* Pointer to some per-method context. */
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context, /* The method calling context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Arguments as actually seen. */
+{
+ ProcedureMethod *pmPtr = clientData;
+ int result;
+ PMFrameData *fdPtr; /* Important data that has to have a lifetime
+ * matched by this function (or rather, by the
+ * call frame's lifetime). */
+
+ /*
+ * If the interpreter was deleted, we just skip to the next thing in the
+ * chain.
+ */
+
+ if (Tcl_InterpDeleted(interp)) {
+ return TclNRObjectContextInvokeNext(interp, context, objc, objv,
+ Tcl_ObjectContextSkippedArgs(context));
+ }
+
+ /*
+ * Allocate the special frame data.
+ */
+
+ fdPtr = TclStackAlloc(interp, sizeof(PMFrameData));
+
+ /*
+ * Create a call frame for this method.
+ */
+
+ result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
+ objc, objv, fdPtr);
+ if (result != TCL_OK) {
+ TclStackFree(interp, fdPtr);
+ return result;
+ }
+ pmPtr->refCount++;
+
+ /*
+ * Give the pre-call callback a chance to do some setup and, possibly,
+ * veto the call.
+ */
+
+ if (pmPtr->preCallProc != NULL) {
+ int isFinished;
+
+ 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) {
+ DeleteProcedureMethodRecord(pmPtr);
+ }
+ TclStackFree(interp, fdPtr);
+ return result;
+ }
+ }
+
+ /*
+ * Now invoke the body of the method.
+ */
+
+ TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
+ return TclNRInterpProcCore(interp, fdPtr->nameObj,
+ Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
+}
+
+static int
+FinalizePMCall(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ ProcedureMethod *pmPtr = data[0];
+ Tcl_ObjectContext context = data[1];
+ PMFrameData *fdPtr = data[2];
+
+ /*
+ * Give the post-call callback a chance to do some cleanup. Note that at
+ * this point the call frame itself is invalid; it's already been popped.
+ */
+
+ if (pmPtr->postCallProc) {
+ result = pmPtr->postCallProc(pmPtr->clientData, interp, context,
+ Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),
+ result);
+ }
+
+ /*
+ * 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!
+ */
+
+ if (--pmPtr->refCount < 1) {
+ DeleteProcedureMethodRecord(pmPtr);
+ }
+ TclStackFree(interp, fdPtr);
+ return result;
+}
+
+static int
+PushMethodCallFrame(
+ Tcl_Interp *interp, /* Current interpreter. */
+ CallContext *contextPtr, /* Current method call context. */
+ ProcedureMethod *pmPtr, /* Information about this procedure-like
+ * method. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv, /* Array of arguments. */
+ PMFrameData *fdPtr) /* Place to store information about the call
+ * frame. */
+{
+ Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr;
+ register int result;
+ const char *namePtr;
+ CallFrame **framePtrPtr = &fdPtr->framePtr;
+
+ /*
+ * Compute basic information on the basis of the type of method it is.
+ */
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ namePtr = "<constructor>";
+ fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName;
+ fdPtr->errProc = ConstructorErrorHandler;
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ namePtr = "<destructor>";
+ fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName;
+ fdPtr->errProc = DestructorErrorHandler;
+ } else {
+ fdPtr->nameObj = Tcl_MethodName(
+ Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr));
+ namePtr = TclGetString(fdPtr->nameObj);
+ fdPtr->errProc = MethodErrorHandler;
+ }
+ if (pmPtr->errProc != NULL) {
+ fdPtr->errProc = pmPtr->errProc;
+ }
+
+ /*
+ * Magic to enable things like [incr Tcl], which wants methods to run in
+ * their class's namespace.
+ */
+
+ if (pmPtr->flags & USE_DECLARER_NS) {
+ register Method *mPtr =
+ contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+ if (mPtr->declaringClassPtr != NULL) {
+ nsPtr = (Namespace *)
+ mPtr->declaringClassPtr->thisPtr->namespacePtr;
+ } else {
+ nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr;
+ }
+ }
+
+ /*
+ * 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.
+ */
+
+ fdPtr->efi.length = 2;
+ memset(&fdPtr->cmd, 0, sizeof(Command));
+ fdPtr->cmd.nsPtr = nsPtr;
+ fdPtr->cmd.clientData = &fdPtr->efi;
+ pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
+
+ /*
+ * [Bug 2037727] Always call TclProcCompileProc so that we check not only
+ * that we have bytecode, but also that it remains valid. Note that we set
+ * the namespace of the code here directly; this is a hack, but the
+ * alternative is *so* slow...
+ */
+
+ if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+ ByteCode *codePtr =
+ pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+
+ codePtr->nsPtr = nsPtr;
+ }
+ result = TclProcCompileProc(interp, pmPtr->procPtr,
+ pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
+ if (result != TCL_OK) {
+ goto failureReturn;
+ }
+
+ /*
+ * Make the stack frame and fill it out with information about this call.
+ * This operation may fail.
+ */
+
+ result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
+ if (result != TCL_OK) {
+ goto failureReturn;
+ }
+
+ fdPtr->framePtr->clientData = contextPtr;
+ fdPtr->framePtr->objc = objc;
+ fdPtr->framePtr->objv = objv;
+ fdPtr->framePtr->procPtr = pmPtr->procPtr;
+
+ /*
+ * Finish filling out the extra frame info so that [info frame] works.
+ */
+
+ fdPtr->efi.fields[0].name = "method";
+ fdPtr->efi.fields[0].proc = NULL;
+ fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
+ if (pmPtr->gfivProc != NULL) {
+ fdPtr->efi.fields[1].name = "";
+ fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
+ fdPtr->efi.fields[1].clientData = pmPtr;
+ } else {
+ register Tcl_Method method =
+ Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);
+
+ if (Tcl_MethodDeclarerObject(method) != NULL) {
+ fdPtr->efi.fields[1].name = "object";
+ } else {
+ fdPtr->efi.fields[1].name = "class";
+ }
+ fdPtr->efi.fields[1].proc = RenderDeclarerName;
+ fdPtr->efi.fields[1].clientData = &fdPtr->pni;
+ fdPtr->pni.interp = interp;
+ fdPtr->pni.method = method;
+ }
+
+ 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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOSetupVariableResolver, etc. --
+ *
+ * Variable resolution engine used to connect declared variables to local
+ * variables used in methods. The compiled variable resolver is more
+ * important, but both are needed as it is possible to have a variable
+ * that is only referred to in ways that aren't compilable and we can't
+ * force LVT presence. [TIP #320]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOSetupVariableResolver(
+ Tcl_Namespace *nsPtr)
+{
+ Tcl_ResolverInfo info;
+
+ Tcl_GetNamespaceResolvers(nsPtr, &info);
+ if (info.compiledVarResProc == NULL) {
+ Tcl_SetNamespaceResolvers(nsPtr, NULL, ProcedureMethodVarResolver,
+ ProcedureMethodCompiledVarResolver);
+ }
+}
+
+static int
+ProcedureMethodVarResolver(
+ Tcl_Interp *interp,
+ const char *varName,
+ Tcl_Namespace *contextNs,
+ int flags,
+ Tcl_Var *varPtr)
+{
+ int result;
+ Tcl_ResolvedVarInfo *rPtr = NULL;
+
+ result = ProcedureMethodCompiledVarResolver(interp, varName,
+ strlen(varName), contextNs, &rPtr);
+
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ *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);
+}
+
+static Tcl_Var
+ProcedureMethodCompiledVarConnect(
+ Tcl_Interp *interp,
+ Tcl_ResolvedVarInfo *rPtr)
+{
+ OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *framePtr = iPtr->varFramePtr;
+ CallContext *contextPtr;
+ Tcl_Obj *variableObj;
+ Tcl_HashEntry *hPtr;
+ int i, isNew, cacheIt, varLen, len;
+ const char *match, *varName;
+
+ /*
+ * 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
+ * in a procedure of that namespace) then we do nothing.
+ */
+
+ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ return NULL;
+ }
+ contextPtr = framePtr->clientData;
+
+ /*
+ * If we've done the work before (in a comparable context) then reuse that
+ * rather than performing resolution ourselves.
+ */
+
+ if (infoPtr->cachedObjectVar) {
+ return infoPtr->cachedObjectVar;
+ }
+
+ /*
+ * Check if the variable is one we want to resolve at all (i.e. whether it
+ * is in the list provided by the user). If not, we mustn't do anything
+ * either.
+ */
+
+ varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
+ if (contextPtr->callPtr->chain[contextPtr->index]
+ .mPtr->declaringClassPtr != NULL) {
+ FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
+ .mPtr->declaringClassPtr->variables) {
+ match = TclGetStringFromObj(variableObj, &len);
+ if ((len == varLen) && !memcmp(match, varName, len)) {
+ cacheIt = 0;
+ goto gotMatch;
+ }
+ }
+ } else {
+ FOREACH(variableObj, contextPtr->oPtr->variables) {
+ match = TclGetStringFromObj(variableObj, &len);
+ if ((len == varLen) && !memcmp(match, varName, len)) {
+ cacheIt = 1;
+ goto gotMatch;
+ }
+ }
+ }
+ return NULL;
+
+ /*
+ * It is a variable we want to resolve, so resolve it.
+ */
+
+ gotMatch:
+ hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr),
+ (char *) variableObj, &isNew);
+ if (isNew) {
+ TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr));
+ }
+ 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);
+}
+
+static void
+ProcedureMethodCompiledVarDelete(
+ Tcl_ResolvedVarInfo *rPtr)
+{
+ 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(infoPtr);
+}
+
+static int
+ProcedureMethodCompiledVarResolver(
+ Tcl_Interp *interp,
+ const char *varName,
+ int length,
+ Tcl_Namespace *contextNs,
+ Tcl_ResolvedVarInfo **rPtrPtr)
+{
+ OOResVarInfo *infoPtr;
+ Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);
+
+ /*
+ * Do not create resolvers for cases that contain namespace separators or
+ * which look like array accesses. Both will lead us astray.
+ */
+
+ if (strstr(Tcl_GetString(variableObj), "::") != NULL ||
+ Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
+ Tcl_DecrRefCount(variableObj);
+ return TCL_CONTINUE;
+ }
+
+ infoPtr = ckalloc(sizeof(OOResVarInfo));
+ infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
+ infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
+ infoPtr->cachedObjectVar = NULL;
+ infoPtr->variableObj = variableObj;
+ Tcl_IncrRefCount(variableObj);
+ *rPtrPtr = &infoPtr->info;
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RenderDeclarerName --
+ *
+ * Returns the name of the entity (object or class) which declared a
+ * method. Used for producing information for [info frame] in such a way
+ * that the expensive part of this (generating the object or class name
+ * itself) isn't done until it is needed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+RenderDeclarerName(
+ ClientData clientData)
+{
+ struct PNI *pni = clientData;
+ Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
+
+ if (object == NULL) {
+ object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
+ }
+ return TclOOObjectName(pni->interp, (Object *) object);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler --
+ *
+ * How to fill in the stack trace correctly upon error in various forms
+ * of procedure-like methods. LIMIT is how long the inserted strings in
+ * the error traces should get before being converted to have ellipses,
+ * and ELLIPSIFY is a macro to do the conversion (with the help of a
+ * %.*s%s format field). Note that ELLIPSIFY is only safe for use in
+ * suitable formatting contexts.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+#define LIMIT 60
+#define ELLIPSIFY(str,len) \
+ ((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "")
+
+static void
+MethodErrorHandler(
+ Tcl_Interp *interp,
+ Tcl_Obj *methodNameObj)
+{
+ int nameLen, objectNameLen;
+ CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+ Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+ const char *objectName, *kindName, *methodName =
+ Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
+ Object *declarerPtr;
+
+ if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ kindName = "object";
+ } else {
+ if (mPtr->declaringClassPtr == NULL) {
+ Tcl_Panic("method not declared in class or object");
+ }
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ kindName = "class";
+ }
+
+ objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+ &objectNameLen);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
+ kindName, ELLIPSIFY(objectName, objectNameLen),
+ ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
+}
+
+static void
+ConstructorErrorHandler(
+ Tcl_Interp *interp,
+ Tcl_Obj *methodNameObj)
+{
+ CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+ Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+ Object *declarerPtr;
+ const char *objectName, *kindName;
+ int objectNameLen;
+
+ if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ kindName = "object";
+ } else {
+ if (mPtr->declaringClassPtr == NULL) {
+ Tcl_Panic("method not declared in class or object");
+ }
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ kindName = "class";
+ }
+
+ objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+ &objectNameLen);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.*s%s\" constructor line %d)", kindName,
+ ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
+}
+
+static void
+DestructorErrorHandler(
+ Tcl_Interp *interp,
+ Tcl_Obj *methodNameObj)
+{
+ CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+ Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+ Object *declarerPtr;
+ const char *objectName, *kindName;
+ int objectNameLen;
+
+ if (mPtr->declaringObjectPtr != NULL) {
+ declarerPtr = mPtr->declaringObjectPtr;
+ kindName = "object";
+ } else {
+ if (mPtr->declaringClassPtr == NULL) {
+ Tcl_Panic("method not declared in class or object");
+ }
+ declarerPtr = mPtr->declaringClassPtr->thisPtr;
+ kindName = "class";
+ }
+
+ objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+ &objectNameLen);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s \"%.*s%s\" destructor line %d)", kindName,
+ ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteProcedureMethod, CloneProcedureMethod --
+ *
+ * How to delete and clone procedure-like methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteProcedureMethodRecord(
+ ProcedureMethod *pmPtr)
+{
+ TclProcDeleteProc(pmPtr->procPtr);
+ if (pmPtr->deleteClientdataProc) {
+ pmPtr->deleteClientdataProc(pmPtr->clientData);
+ }
+ ckfree(pmPtr);
+}
+
+static void
+DeleteProcedureMethod(
+ ClientData clientData)
+{
+ register ProcedureMethod *pmPtr = clientData;
+
+ if (--pmPtr->refCount < 1) {
+ DeleteProcedureMethodRecord(pmPtr);
+ }
+}
+
+static int
+CloneProcedureMethod(
+ Tcl_Interp *interp,
+ ClientData clientData,
+ ClientData *newClientData)
+{
+ ProcedureMethod *pmPtr = clientData;
+ ProcedureMethod *pm2Ptr;
+ Tcl_Obj *bodyObj, *argsObj;
+ CompiledLocal *localPtr;
+
+ /*
+ * Copy the argument list.
+ */
+
+ argsObj = Tcl_NewObj();
+ for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_Obj *argObj = Tcl_NewObj();
+
+ Tcl_ListObjAppendElement(NULL, argObj,
+ Tcl_NewStringObj(localPtr->name, -1));
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+ }
+ Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+ }
+ }
+
+ /*
+ * Must strip the internal representation in order to ensure that any
+ * bound references to instance variables are removed. [Bug 3609693]
+ */
+
+ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+ TclFreeIntRep(bodyObj);
+
+ /*
+ * Create the actual copy of the method record, manufacturing a new proc
+ * record.
+ */
+
+ pm2Ptr = ckalloc(sizeof(ProcedureMethod));
+ memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
+ pm2Ptr->refCount = 1;
+ Tcl_IncrRefCount(argsObj);
+ Tcl_IncrRefCount(bodyObj);
+ if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
+ &pm2Ptr->procPtr) != TCL_OK) {
+ Tcl_DecrRefCount(argsObj);
+ Tcl_DecrRefCount(bodyObj);
+ ckfree(pm2Ptr);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(argsObj);
+ Tcl_DecrRefCount(bodyObj);
+
+ if (pmPtr->cloneClientdataProc) {
+ pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
+ }
+ *newClientData = pm2Ptr;
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewForwardMethod --
+ *
+ * Create a forwarded method for an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewForwardInstanceMethod(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Object *oPtr, /* The object to attach the method to. */
+ int flags, /* Whether the method is public or not. */
+ Tcl_Obj *nameObj, /* The name of the method. */
+ Tcl_Obj *prefixObj) /* List of arguments that form the command
+ * prefix to forward to. */
+{
+ int prefixLen;
+ register ForwardMethod *fmPtr;
+ Tcl_Obj *cmdObj;
+
+ if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+ return NULL;
+ }
+ if (prefixLen < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+ return NULL;
+ }
+
+ fmPtr = ckalloc(sizeof(ForwardMethod));
+ fmPtr->prefixObj = prefixObj;
+ Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
+ Tcl_IncrRefCount(prefixObj);
+ return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
+ nameObj, flags, &fwdMethodType, fmPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewForwardMethod --
+ *
+ * Create a new forwarded method for a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewForwardMethod(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Class *clsPtr, /* The class to attach the method to. */
+ int flags, /* Whether the method is public or not. */
+ Tcl_Obj *nameObj, /* The name of the method. */
+ Tcl_Obj *prefixObj) /* List of arguments that form the command
+ * prefix to forward to. */
+{
+ int prefixLen;
+ register ForwardMethod *fmPtr;
+ Tcl_Obj *cmdObj;
+
+ if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+ return NULL;
+ }
+ if (prefixLen < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+ return NULL;
+ }
+
+ fmPtr = ckalloc(sizeof(ForwardMethod));
+ fmPtr->prefixObj = prefixObj;
+ Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
+ Tcl_IncrRefCount(prefixObj);
+ return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
+ flags, &fwdMethodType, fmPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InvokeForwardMethod --
+ *
+ * How to invoke a forwarded method. Works by doing some ensemble-like
+ * command rearranging and then invokes some other Tcl command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InvokeForwardMethod(
+ ClientData clientData, /* Pointer to some per-method context. */
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context, /* The method calling context. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Arguments as actually seen. */
+{
+ CallContext *contextPtr = (CallContext *) context;
+ ForwardMethod *fmPtr = clientData;
+ Tcl_Obj **argObjs, **prefixObjs;
+ int numPrefixes, len, skip = contextPtr->skip;
+
+ /*
+ * Build the real list of arguments to use. Note that we know that the
+ * prefixObj field of the ForwardMethod structure holds a reference to a
+ * non-empty list, so there's a whole class of failures ("not a list") we
+ * can ignore here.
+ */
+
+ Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
+ argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
+ numPrefixes, prefixObjs, &len);
+ Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+ ((Interp *)interp)->lookupNsPtr
+ = (Namespace *) contextPtr->oPtr->namespacePtr;
+ return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+FinalizeForwardCall(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj **argObjs = data[0];
+
+ TclStackFree(interp, argObjs);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteForwardMethod, CloneForwardMethod --
+ *
+ * How to delete and clone forwarded methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteForwardMethod(
+ ClientData clientData)
+{
+ ForwardMethod *fmPtr = clientData;
+
+ Tcl_DecrRefCount(fmPtr->prefixObj);
+ ckfree(fmPtr);
+}
+
+static int
+CloneForwardMethod(
+ Tcl_Interp *interp,
+ ClientData clientData,
+ ClientData *newClientData)
+{
+ ForwardMethod *fmPtr = clientData;
+ ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
+
+ fm2Ptr->prefixObj = fmPtr->prefixObj;
+ Tcl_IncrRefCount(fm2Ptr->prefixObj);
+ *newClientData = fm2Ptr;
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetProcFromMethod, TclOOGetFwdFromMethod --
+ *
+ * Utility functions used for procedure-like and forwarding method
+ * introspection.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Proc *
+TclOOGetProcFromMethod(
+ Method *mPtr)
+{
+ if (mPtr->typePtr == &procMethodType) {
+ ProcedureMethod *pmPtr = mPtr->clientData;
+
+ return pmPtr->procPtr;
+ }
+ return NULL;
+}
+
+Tcl_Obj *
+TclOOGetMethodBody(
+ Method *mPtr)
+{
+ if (mPtr->typePtr == &procMethodType) {
+ ProcedureMethod *pmPtr = mPtr->clientData;
+
+ if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
+ (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
+ }
+ return pmPtr->procPtr->bodyPtr;
+ }
+ return NULL;
+}
+
+Tcl_Obj *
+TclOOGetFwdFromMethod(
+ Method *mPtr)
+{
+ if (mPtr->typePtr == &fwdMethodType) {
+ ForwardMethod *fwPtr = mPtr->clientData;
+
+ return fwPtr->prefixObj;
+ }
+ return NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitEnsembleRewrite --
+ *
+ * Utility function that wraps up a lot of the complexity involved in
+ * doing ensemble-like command forwarding. Here is a picture of memory
+ * management plan:
+ *
+ * <-----------------objc---------------------->
+ * objv: |=============|===============================|
+ * <-toRewrite-> |
+ * \
+ * <-rewriteLength-> \
+ * rewriteObjs: |=================| \
+ * | |
+ * V V
+ * argObjs: |=================|===============================|
+ * <------------------*lengthPtr------------------->
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj **
+InitEnsembleRewrite(
+ Tcl_Interp *interp, /* Place to log the rewrite info. */
+ int objc, /* Number of real arguments. */
+ Tcl_Obj *const *objv, /* The real arguments. */
+ int toRewrite, /* Number of real arguments to replace. */
+ int rewriteLength, /* Number of arguments to insert instead. */
+ Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
+ int *lengthPtr) /* Where to write the resulting length of the
+ * array of rewritten arguments. */
+{
+ Interp *iPtr = (Interp *) interp;
+ int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+ Tcl_Obj **argObjs;
+ unsigned len = rewriteLength + objc - toRewrite;
+
+ argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
+ memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
+ memcpy(argObjs + rewriteLength, objv + toRewrite,
+ sizeof(Tcl_Obj *) * (objc - toRewrite));
+
+ /*
+ * Now plumb this into the core ensemble rewrite logging system so that
+ * Tcl_WrongNumArgs() can rewrite its result appropriately. The rules for
+ * how to store the rewrite rules get complex solely because of the case
+ * where an ensemble rewrites itself out of the picture; when that
+ * happens, the quality of the error message rewrite falls drastically
+ * (and unavoidably).
+ */
+
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = toRewrite;
+ iPtr->ensembleRewrite.numInsertedObjs = rewriteLength;
+ } else {
+ int numIns = iPtr->ensembleRewrite.numInsertedObjs;
+
+ if (numIns < toRewrite) {
+ iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns;
+ iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs +=
+ rewriteLength - toRewrite;
+ }
+ }
+
+ *lengthPtr = len;
+ return argObjs;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * assorted trivial 'getter' functions
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_MethodDeclarerObject(
+ Tcl_Method method)
+{
+ return (Tcl_Object) ((Method *) method)->declaringObjectPtr;
+}
+
+Tcl_Class
+Tcl_MethodDeclarerClass(
+ Tcl_Method method)
+{
+ return (Tcl_Class) ((Method *) method)->declaringClassPtr;
+}
+
+Tcl_Obj *
+Tcl_MethodName(
+ Tcl_Method method)
+{
+ return ((Method *) method)->namePtr;
+}
+
+int
+Tcl_MethodIsType(
+ Tcl_Method method,
+ const Tcl_MethodType *typePtr,
+ ClientData *clientDataPtr)
+{
+ Method *mPtr = (Method *) method;
+
+ if (mPtr->typePtr == typePtr) {
+ if (clientDataPtr != NULL) {
+ *clientDataPtr = mPtr->clientData;
+ }
+ return 1;
+ }
+ return 0;
+}
+
+int
+Tcl_MethodIsPublic(
+ Tcl_Method method)
+{
+ return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
+}
+
+/*
+ * Extended method construction for itcl-ng.
+ */
+
+Tcl_Method
+TclOONewProcInstanceMethodEx(
+ Tcl_Interp *interp, /* The interpreter containing the object. */
+ Tcl_Object oPtr, /* The object to modify. */
+ TclOO_PreCallProc *preCallPtr,
+ TclOO_PostCallProc *postCallPtr,
+ ProcErrorProc *errProc,
+ ClientData clientData,
+ Tcl_Obj *nameObj, /* The name of the method, which must not be
+ * NULL. */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which must not be NULL. */
+ Tcl_Obj *bodyObj, /* The body of the method, which must not be
+ * NULL. */
+ int flags, /* Whether this is a public method. */
+ void **internalTokenPtr) /* If non-NULL, points to a variable that gets
+ * the reference to the ProcedureMethod
+ * structure. */
+{
+ ProcedureMethod *pmPtr;
+ Tcl_Method method = (Tcl_Method) TclOONewProcInstanceMethod(interp,
+ (Object *) oPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
+
+ if (method == NULL) {
+ return NULL;
+ }
+ pmPtr->flags = flags & USE_DECLARER_NS;
+ pmPtr->preCallProc = preCallPtr;
+ pmPtr->postCallProc = postCallPtr;
+ pmPtr->errProc = errProc;
+ pmPtr->clientData = clientData;
+ if (internalTokenPtr != NULL) {
+ *internalTokenPtr = pmPtr;
+ }
+ return method;
+}
+
+Tcl_Method
+TclOONewProcMethodEx(
+ Tcl_Interp *interp, /* The interpreter containing the class. */
+ Tcl_Class clsPtr, /* The class to modify. */
+ TclOO_PreCallProc *preCallPtr,
+ TclOO_PostCallProc *postCallPtr,
+ ProcErrorProc *errProc,
+ ClientData clientData,
+ Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
+ * if so, up to caller to manage storage
+ * (e.g., because it is a constructor or
+ * destructor). */
+ Tcl_Obj *argsObj, /* The formal argument list for the method,
+ * which may be NULL; if so, it is equivalent
+ * to an empty list. */
+ Tcl_Obj *bodyObj, /* The body of the method, which must not be
+ * NULL. */
+ int flags, /* Whether this is a public method. */
+ void **internalTokenPtr) /* If non-NULL, points to a variable that gets
+ * the reference to the ProcedureMethod
+ * structure. */
+{
+ ProcedureMethod *pmPtr;
+ Tcl_Method method = (Tcl_Method) TclOONewProcMethod(interp,
+ (Class *) clsPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
+
+ if (method == NULL) {
+ return NULL;
+ }
+ pmPtr->flags = flags & USE_DECLARER_NS;
+ pmPtr->preCallProc = preCallPtr;
+ pmPtr->postCallProc = postCallPtr;
+ pmPtr->errProc = errProc;
+ pmPtr->clientData = clientData;
+ if (internalTokenPtr != NULL) {
+ *internalTokenPtr = pmPtr;
+ }
+ return method;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
new file mode 100644
index 0000000..900ab22
--- /dev/null
+++ b/generic/tclOOStubInit.c
@@ -0,0 +1,78 @@
+/*
+ * This file is (mostly) automatically generated from tclOO.decls.
+ * It is compiled and linked in with the tclOO package proper.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclOOInt.h"
+
+MODULE_SCOPE const TclOOStubs tclOOStubs;
+
+#ifdef __GNUC__
+#pragma GCC dependency "tclOO.decls"
+#endif
+
+/* !BEGIN!: Do not edit below this line. */
+
+static const TclOOIntStubs tclOOIntStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+ TclOOGetDefineCmdContext, /* 0 */
+ TclOOMakeProcInstanceMethod, /* 1 */
+ TclOOMakeProcMethod, /* 2 */
+ TclOONewProcInstanceMethod, /* 3 */
+ TclOONewProcMethod, /* 4 */
+ TclOOObjectCmdCore, /* 5 */
+ TclOOIsReachable, /* 6 */
+ TclOONewForwardMethod, /* 7 */
+ TclOONewForwardInstanceMethod, /* 8 */
+ TclOONewProcInstanceMethodEx, /* 9 */
+ TclOONewProcMethodEx, /* 10 */
+ TclOOInvokeObject, /* 11 */
+ TclOOObjectSetFilters, /* 12 */
+ TclOOClassSetFilters, /* 13 */
+ TclOOObjectSetMixins, /* 14 */
+ TclOOClassSetMixins, /* 15 */
+};
+
+static const TclOOStubHooks tclOOStubHooks = {
+ &tclOOIntStubs
+};
+
+const TclOOStubs tclOOStubs = {
+ TCL_STUB_MAGIC,
+ &tclOOStubHooks,
+ Tcl_CopyObjectInstance, /* 0 */
+ Tcl_GetClassAsObject, /* 1 */
+ Tcl_GetObjectAsClass, /* 2 */
+ Tcl_GetObjectCommand, /* 3 */
+ Tcl_GetObjectFromObj, /* 4 */
+ Tcl_GetObjectNamespace, /* 5 */
+ Tcl_MethodDeclarerClass, /* 6 */
+ Tcl_MethodDeclarerObject, /* 7 */
+ Tcl_MethodIsPublic, /* 8 */
+ Tcl_MethodIsType, /* 9 */
+ Tcl_MethodName, /* 10 */
+ Tcl_NewInstanceMethod, /* 11 */
+ Tcl_NewMethod, /* 12 */
+ Tcl_NewObjectInstance, /* 13 */
+ Tcl_ObjectDeleted, /* 14 */
+ Tcl_ObjectContextIsFiltering, /* 15 */
+ Tcl_ObjectContextMethod, /* 16 */
+ Tcl_ObjectContextObject, /* 17 */
+ Tcl_ObjectContextSkippedArgs, /* 18 */
+ Tcl_ClassGetMetadata, /* 19 */
+ Tcl_ClassSetMetadata, /* 20 */
+ Tcl_ObjectGetMetadata, /* 21 */
+ Tcl_ObjectSetMetadata, /* 22 */
+ Tcl_ObjectContextInvokeNext, /* 23 */
+ Tcl_ObjectGetMethodNameMapper, /* 24 */
+ Tcl_ObjectSetMethodNameMapper, /* 25 */
+ Tcl_ClassSetConstructor, /* 26 */
+ Tcl_ClassSetDestructor, /* 27 */
+ Tcl_GetObjectName, /* 28 */
+};
+
+/* !END!: Do not edit above this line. */
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
new file mode 100644
index 0000000..a9fa212
--- /dev/null
+++ b/generic/tclOOStubLib.c
@@ -0,0 +1,71 @@
+/*
+ * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
+ */
+
+#include "tclOOInt.h"
+
+MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
+MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;
+
+const TclOOStubs *tclOOStubsPtr = NULL;
+const TclOOIntStubs *tclOOIntStubsPtr = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOOInitializeStubs --
+ * Load the tclOO package, initialize stub table pointer. Do not call
+ * this function directly, use Tcl_OOInitStubs() macro instead.
+ *
+ * Results:
+ * The actual version of the package that satisfies the request, or NULL
+ * to indicate that an error occurred.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef TclOOInitializeStubs
+
+MODULE_SCOPE const char *
+TclOOInitializeStubs(
+ Tcl_Interp *interp,
+ const char *version)
+{
+ int exact = 0;
+ const char *packageName = "TclOO";
+ const char *errMsg = NULL;
+ TclOOStubs *stubsPtr = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, exact, &stubsPtr);
+
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ if (stubsPtr == NULL) {
+ errMsg = "missing stub table pointer";
+ } else {
+ tclOOStubsPtr = stubsPtr;
+ if (stubsPtr->hooks) {
+ tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
+ } else {
+ tclOOIntStubsPtr = NULL;
+ }
+ return actualVersion;
+ }
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 89ff127..930e1fd 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,33 +1,22 @@
/*
* tclObj.c --
*
- * This file contains Tcl object-related procedures that are used by many
+ * This file contains Tcl object-related functions that are used by many
* Tcl commands.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
* Copyright (c) 2001 by ActiveState Corporation.
* Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* 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.95 2005/09/05 10:25:54 dkf Exp $
*/
#include "tclInt.h"
#include "tommath.h"
-#include <float.h>
-
-/*
- * Define test for NaN
- */
-
-#ifdef _MSC_VER
-#define IS_NAN(f) _isnan((f))
-#else
-#define IS_NAN(f) ((f) != (f))
-#endif
+#include <math.h>
/*
* Table of all object types.
@@ -44,11 +33,12 @@ TCL_DECLARE_MUTEX(tableMutex)
Tcl_Obj *tclFreeObjList = NULL;
/*
- * The object allocator is single threaded. This mutex is referenced by the
+ * The object allocator is single threaded. This mutex is referenced by the
* TclNewObj macro, however, so must be visible.
*/
#ifdef TCL_THREADS
+MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif
@@ -63,22 +53,58 @@ char *tclEmptyStringRep = &tclEmptyString;
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
- * Thread local table that is used to check that a Tcl_Obj was not allocated
- * by some other thread.
+ * 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 {
+ Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
+ const char *file; /* The name of the source file calling this
+ * function; used for debugging. */
+ int line; /* Line number in the source file; used for
+ * debugging. */
+} ObjData;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+
+/*
+ * All static variables used in this file are collected into a single instance
+ * of the following structure. For multi-threaded implementations, there is
+ * one instance of this structure for each thread.
+ *
+ * Notice that different structures with the same name appear in other files.
+ * The structure defined below is used in this file only.
*/
+
typedef struct ThreadSpecificData {
- Tcl_HashTable *objThreadMap;
+ Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
+ * generated by a call to the function
+ * 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.
+ * Its keys are Tcl_Obj pointers, the values
+ * are ContLineLoc pointers. See the file
+ * tclCompile.h for the definition of this
+ * structure, and for references to all
+ * related places in the core. */
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
+ * that a Tcl_Obj was not allocated by some
+ * other thread. */
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+static void TclThreadFinalizeContLines(ClientData clientData);
+static ThreadSpecificData *TclGetContLineTable(void);
/*
* Nested Tcl_Obj deletion management support
*
* All context references used in the object freeing code are pointers to this
- * structure; every thread will have its own structure instance. The purpose
+ * structure; every thread will have its own structure instance. The purpose
* of this structure is to allow deeply nested collections of Tcl_Objs to be
* freed without taking a vast depth of C stack (which could cause all sorts
* of breakage.)
@@ -120,17 +146,12 @@ typedef struct PendingObjData {
#define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr) \
- /* Invalidate the string rep first so we can use the bytes value \
- * for our pointer chain. */ \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
- /* Now push onto the head of the stack. */ \
- (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
+ /* The string rep is already invalidated so we can use the bytes value \
+ * for our pointer chain: push onto the head of the stack. */ \
+ (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
(contextPtr)->deletionStack = (objPtr)
#define PopObjToDelete(contextPtr,objPtrVar) \
- (objPtrVar) = (contextPtr)->deletionStack; \
+ (objPtrVar) = (contextPtr)->deletionStack; \
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
/*
@@ -139,155 +160,150 @@ typedef struct PendingObjData {
#ifndef TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
- PendingObjData *CONST contextPtr = &pendingObjData
+ 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) \
- PendingObjData *CONST contextPtr = (PendingObjData *) \
+ PendingObjData *const contextPtr = \
Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
-
/*
* Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
*/
#define PACK_BIGNUM(bignum, objPtr) \
- do { \
- (objPtr)->internalRep.bignumValue.digits = (void*) (bignum).dp; \
- (objPtr)->internalRep.bignumValue.misc = ( \
- ((bignum).sign << 30) \
- | ((bignum).alloc << 15) \
- | ((bignum).used)); \
- } while (0)
+ if ((bignum).used > 0x7fff) { \
+ mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
+ *temp = bignum; \
+ (objPtr)->internalRep.ptrAndLongRep.ptr = temp; \
+ (objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
+ } else { \
+ if ((bignum).alloc > 0x7fff) { \
+ mp_shrink(&(bignum)); \
+ } \
+ (objPtr)->internalRep.ptrAndLongRep.ptr = (void *) (bignum).dp; \
+ (objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
+ | ((bignum).alloc << 15) | ((bignum).used)); \
+ }
#define UNPACK_BIGNUM(objPtr, bignum) \
- do { \
- (bignum).dp = (mp_digit*) (objPtr)->internalRep.bignumValue.digits; \
- (bignum).sign = (objPtr)->internalRep.bignumValue.misc >> 30; \
- (bignum).alloc = \
- ((objPtr)->internalRep.bignumValue.misc >> 15) & 0x7fff; \
- (bignum).used = (objPtr)->internalRep.bignumValue.misc & 0x7fff; \
- } while (0)
-
-/*
- * Prototypes for procedures defined later in this file:
- */
-
-static int SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static int SetIntOrWideFromAny _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+ if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
+ (bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
+ } else { \
+ (bignum).dp = (objPtr)->internalRep.ptrAndLongRep.ptr; \
+ (bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
+ (bignum).alloc = \
+ ((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
+ (bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
+ }
+/*
+ * Prototypes for functions defined later in this file:
+ */
+
+static int ParseBoolean(Tcl_Obj *objPtr);
+static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfDouble(Tcl_Obj *objPtr);
+static void UpdateStringOfInt(Tcl_Obj *objPtr);
#ifndef TCL_WIDE_INT_IS_LONG
-static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
+static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
-
-static void FreeBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void DupBignum _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static void UpdateStringOfBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int SetBignumFromAny _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj* objPtr));
+static void FreeBignum(Tcl_Obj *objPtr);
+static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void UpdateStringOfBignum(Tcl_Obj *objPtr);
+static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int copy, mp_int *bignumValue);
/*
* Prototypes for the array hash key methods.
*/
-static Tcl_HashEntry * AllocObjEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareObjKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static void FreeObjEntry _ANSI_ARGS_((
- Tcl_HashEntry *hPtr));
-static unsigned int HashObjKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
+static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the CommandName object type.
*/
-static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static void FreeCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-
+static void DupCmdNameInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static void FreeCmdNameInternalRep(Tcl_Obj *objPtr);
+static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
* The structures below defines the Tcl object types defined in this file by
- * means of procedures that can be invoked by generic object code. See also
+ * means of functions that can be invoked by generic object code. See also
* tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
* implementations.
*/
-Tcl_ObjType tclBooleanType = {
- "boolean", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+static const Tcl_ObjType oldBooleanType = {
+ "boolean", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
-
-Tcl_ObjType tclDoubleType = {
- "double", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
- UpdateStringOfDouble, /* updateStringProc */
- SetDoubleFromAny /* setFromAnyProc */
+const Tcl_ObjType tclBooleanType = {
+ "booleanString", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
-
-Tcl_ObjType tclIntType = {
- "int", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
- UpdateStringOfInt, /* updateStringProc */
- SetIntFromAny /* setFromAnyProc */
+const Tcl_ObjType tclDoubleType = {
+ "double", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfDouble, /* updateStringProc */
+ SetDoubleFromAny /* setFromAnyProc */
};
-
-Tcl_ObjType tclWideIntType = {
- "wideInt", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
-#ifdef TCL_WIDE_INT_IS_LONG
- UpdateStringOfInt, /* updateStringProc */
-#else /* !TCL_WIDE_INT_IS_LONG */
- UpdateStringOfWideInt, /* updateStringProc */
-#endif /* TCL_WIDE_INT_IS_LONG */
- SetWideIntFromAny /* setFromAnyProc */
+const Tcl_ObjType tclIntType = {
+ "int", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInt, /* updateStringProc */
+ SetIntFromAny /* setFromAnyProc */
};
-
-Tcl_ObjType tclBignumType = {
- "bignum", /* name */
- FreeBignum, /* freeIntRepProc */
- DupBignum, /* dupIntRepProc */
- UpdateStringOfBignum, /* updateStringProc */
- SetBignumFromAny /* setFromAnyProc */
+#ifndef TCL_WIDE_INT_IS_LONG
+const Tcl_ObjType tclWideIntType = {
+ "wideInt", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfWideInt, /* updateStringProc */
+ SetWideIntFromAny /* setFromAnyProc */
+};
+#endif
+const Tcl_ObjType tclBignumType = {
+ "bignum", /* name */
+ FreeBignum, /* freeIntRepProc */
+ DupBignum, /* dupIntRepProc */
+ UpdateStringOfBignum, /* updateStringProc */
+ NULL /* setFromAnyProc */
};
/*
* The structure below defines the Tcl obj hash key type.
*/
-Tcl_HashKeyType tclObjHashKeyType = {
- TCL_HASH_KEY_TYPE_VERSION, /* version */
- 0, /* flags */
- HashObjKey, /* hashKeyProc */
- CompareObjKeys, /* compareKeysProc */
- AllocObjEntry, /* allocEntryProc */
- FreeObjEntry /* freeEntryProc */
+
+const Tcl_HashKeyType tclObjHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ TclHashObjKey, /* hashKeyProc */
+ TclCompareObjKeys, /* compareKeysProc */
+ AllocObjEntry, /* allocEntryProc */
+ TclFreeObjEntry /* freeEntryProc */
};
/*
* The structure below defines the command name Tcl object type by means of
- * procedures that can be invoked by generic object code. Objects of this type
+ * functions that can be invoked by generic object code. Objects of this type
* cache the Command pointer that results from looking up command names in the
* command hashtable. Such objects appear as the zeroth ("command name")
* argument in a Tcl command.
@@ -298,17 +314,24 @@ Tcl_HashKeyType tclObjHashKeyType = {
* ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions
* use the second internal pointer field of the twoPtrValue field for their
* own purposes.
+ *
+ * TRICKY POINT! Some extensions update this structure! (Notably, these
+ * include TclBlend and TCom). This is highly ill-advised on their part, but
+ * does allow them to delete a command when references to it are gone, which
+ * is fragile but useful given their somewhat-OO style. Because of this, this
+ * structure MUST NOT be const so that the C compiler puts the data in
+ * writable memory. [Bug 2558422]
+ * TODO: Provide a better API for those extensions so that they can coexist...
*/
-static Tcl_ObjType tclCmdNameType = {
- "cmdName", /* name */
- FreeCmdNameInternalRep, /* freeIntRepProc */
- DupCmdNameInternalRep, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
- SetCmdNameFromAny /* setFromAnyProc */
+Tcl_ObjType tclCmdNameType = {
+ "cmdName", /* name */
+ FreeCmdNameInternalRep, /* freeIntRepProc */
+ DupCmdNameInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetCmdNameFromAny /* setFromAnyProc */
};
-
/*
* Structure containing a cached pointer to a command that is the result of
* resolving the command's name in some namespace. It is the internal
@@ -320,7 +343,8 @@ typedef struct ResolvedCmdName {
Command *cmdPtr; /* A cached Command pointer. */
Namespace *refNsPtr; /* Points to the namespace containing the
* reference (not the namespace that contains
- * the referenced command). */
+ * the referenced command). NULL if the name
+ * is fully qualified.*/
long refNsId; /* refNsPtr's unique namespace id. Used to
* verify that refNsPtr is still valid (e.g.,
* it's possible that the cmd's containing
@@ -343,14 +367,13 @@ typedef struct ResolvedCmdName {
* structure can be freed when refCount
* becomes zero. */
} ResolvedCmdName;
-
/*
*-------------------------------------------------------------------------
*
* TclInitObjectSubsystem --
*
- * This procedure is invoked to perform once-only initialization of the
+ * This function is invoked to perform once-only initialization of the
* type table. It also registers the object types defined in this file.
*
* Results:
@@ -364,7 +387,7 @@ typedef struct ResolvedCmdName {
*/
void
-TclInitObjSubsystem()
+TclInitObjSubsystem(void)
{
Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
@@ -375,23 +398,28 @@ TclInitObjSubsystem()
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
- Tcl_RegisterObjType(&tclWideIntType);
- Tcl_RegisterObjType(&tclBignumType);
Tcl_RegisterObjType(&tclStringType);
+ Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclArraySearchType);
- Tcl_RegisterObjType(&tclNsNameType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
+ /* For backward compatibility only ... */
+ Tcl_RegisterObjType(&oldBooleanType);
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_RegisterObjType(&tclWideIntType);
+#endif
+
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
tclObjsFreed = 0;
{
int i;
+
for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
tclObjsShared[i] = 0;
}
@@ -403,10 +431,53 @@ TclInitObjSubsystem()
/*
*----------------------------------------------------------------------
*
+ * TclFinalizeThreadObjects --
+ *
+ * This function is called by Tcl_FinalizeThread to clean up thread
+ * specific Tcl_Obj information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadObjects(void)
+{
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+
+ if (tablePtr != NULL) {
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ ckfree(objData);
+ }
+ }
+
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree(tablePtr);
+ tsdPtr->objThreadMap = NULL;
+ }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclFinalizeObjects --
*
- * This procedure is called by Tcl_Finalize to clean up all
- * registered Tcl_ObjType's and to reset the tclFreeObjList.
+ * This function is called by Tcl_Finalize to clean up all registered
+ * Tcl_ObjType's and to reset the tclFreeObjList.
*
* Results:
* None.
@@ -418,7 +489,7 @@ TclInitObjSubsystem()
*/
void
-TclFinalizeObjects()
+TclFinalizeObjects(void)
{
Tcl_MutexLock(&tableMutex);
if (typeTableInitialized) {
@@ -428,9 +499,9 @@ TclFinalizeObjects()
Tcl_MutexUnlock(&tableMutex);
/*
- * All we do here is reset the head pointer of the linked list of
- * free Tcl_Obj's to NULL; the memory finalization will take care
- * of releasing memory for us.
+ * All we do here is reset the head pointer of the linked list of free
+ * Tcl_Obj's to NULL; the memory finalization will take care of releasing
+ * memory for us.
*/
Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
@@ -438,12 +509,316 @@ TclFinalizeObjects()
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetContLineTable --
+ *
+ * This procedure is a helper which returns the thread-specific
+ * hash-table used to track continuation line information associated with
+ * Tcl_Obj*, and the objThreadMap, etc.
+ *
+ * Results:
+ * A reference to the thread-data.
+ *
+ * Side effects:
+ * May allocate memory for the thread-data.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+TclGetContLineTable(void)
+{
+ /*
+ * Initialize the hashtable tracking invisible continuation lines. For
+ * the release we use a thread exit handler to ensure that this is done
+ * before TSD blocks are made invalid. The TclFinalizeObjects() which
+ * would be the natural place for this is invoked afterwards, meaning that
+ * we try to operate on a data structure already gone.
+ */
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->lineCLPtr) {
+ tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
+ Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsEnter --
+ *
+ * This procedure is a helper which saves the continuation line
+ * information associated with a Tcl_Obj*.
+ *
+ * Results:
+ * A reference to the newly created continuation line location table.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+ContLineLoc *
+TclContinuationsEnter(
+ Tcl_Obj *objPtr,
+ int num,
+ int *loc)
+{
+ int newEntry;
+ ThreadSpecificData *tsdPtr = TclGetContLineTable();
+ Tcl_HashEntry *hPtr =
+ Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
+ ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
+
+ if (!newEntry) {
+ /*
+ * We're entering ContLineLoc data for the same value more than one
+ * time. Taking care not to leak the old entry.
+ *
+ * This can happen when literals in a proc body are shared. See for
+ * example test info-30.19 where the action (code) for all branches of
+ * the switch command is identical, mapping them all to the same
+ * literal. An interesting result of this is that the number and
+ * locations (offset) of invisible continuation lines in the literal
+ * are the same for all occurences.
+ *
+ * Note that while reusing the existing entry is possible it requires
+ * the same actions as for a new entry because we have to copy the
+ * incoming num/loc data even so. Because we are called from
+ * TclContinuationsEnterDerived for this case, which modified the
+ * stored locations (Rebased to the proper relative offset). Just
+ * returning the stored entry would rebase them a second time, or
+ * more, hosing the data. It is easier to simply replace, as we are
+ * doing.
+ */
+
+ ckfree(Tcl_GetHashValue(hPtr));
+ }
+
+ clLocPtr->num = num;
+ memcpy(&clLocPtr->loc, loc, num*sizeof(int));
+ clLocPtr->loc[num] = CLL_END; /* Sentinel */
+ Tcl_SetHashValue(hPtr, clLocPtr);
+
+ return clLocPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsEnterDerived --
+ *
+ * This procedure is a helper which computes the continuation line
+ * information associated with a Tcl_Obj* cut from the middle of a
+ * script.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclContinuationsEnterDerived(
+ Tcl_Obj *objPtr,
+ int start,
+ int *clNext)
+{
+ int length, end, num;
+ int *wordCLLast = clNext;
+
+ /*
+ * We have to handle invisible continuations lines here as well, despite
+ * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If
+ * our script is the sole argument to an 'eval' command, for example, the
+ * scriptCLLocPtr we are using was generated by a previous call to TST,
+ * and while the words we have here may contain continuation lines they
+ * are invisible already, and the inner call to TST had no bs+nl sequences
+ * to trigger its code.
+ *
+ * Luckily for us, the table we have to create here for the current word
+ * has to be a slice of the table currently in use, with the locations
+ * suitably modified to be relative to the start of the word instead of
+ * relative to the script.
+ *
+ * That is what we are doing now. Determine the slice we need, and if not
+ * empty, wrap it into a new table, and save the result into our
+ * thread-global hashtable, as usual.
+ */
+
+ /*
+ * First compute the range of the word within the script. (Is there a
+ * better way which doesn't shimmer?)
+ */
+
+ Tcl_GetStringFromObj(objPtr, &length);
+ end = start + length; /* First char after the word */
+
+ /*
+ * Then compute the table slice covering the range of the word.
+ */
+
+ while (*wordCLLast >= 0 && *wordCLLast < end) {
+ wordCLLast++;
+ }
+
+ /*
+ * And generate the table from the slice, if it was not empty.
+ */
+
+ num = wordCLLast - clNext;
+ if (num) {
+ int i;
+ ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
+
+ /*
+ * Re-base the locations.
+ */
+
+ for (i=0 ; i<num ; i++) {
+ clLocPtr->loc[i] -= start;
+
+ /*
+ * Continuation lines coming before the string and affecting us
+ * should not happen, due to the proper maintenance of clNext
+ * during compilation.
+ */
+
+ if (clLocPtr->loc[i] < 0) {
+ Tcl_Panic("Derived ICL data for object using offsets from before the script");
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsCopy --
+ *
+ * This procedure is a helper which copies the continuation line
+ * information associated with a Tcl_Obj* to another Tcl_Obj*. It is
+ * assumed that both contain the same string/script. Use this when a
+ * script is duplicated because it was shared.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclContinuationsCopy(
+ Tcl_Obj *objPtr,
+ Tcl_Obj *originObjPtr)
+{
+ ThreadSpecificData *tsdPtr = TclGetContLineTable();
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
+
+ if (hPtr) {
+ ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
+
+ TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsGet --
+ *
+ * This procedure is a helper which retrieves the continuation line
+ * information associated with a Tcl_Obj*, if it has any.
+ *
+ * Results:
+ * A reference to the continuation line location table, or NULL if the
+ * Tcl_Obj* has no such information associated with it.
+ *
+ * Side effects:
+ * None.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+ContLineLoc *
+TclContinuationsGet(
+ Tcl_Obj *objPtr)
+{
+ ThreadSpecificData *tsdPtr = TclGetContLineTable();
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+
+ if (!hPtr) {
+ return NULL;
+ }
+ return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadFinalizeContLines --
+ *
+ * This procedure is a helper which releases all continuation line
+ * information currently known. It is run as a thread exit handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static void
+TclThreadFinalizeContLines(
+ ClientData clientData)
+{
+ /*
+ * Release the hashtable tracking invisible continuation lines.
+ */
+
+ ThreadSpecificData *tsdPtr = TclGetContLineTable();
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+
+ for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
+ ckfree(tsdPtr->lineCLPtr);
+ tsdPtr->lineCLPtr = NULL;
+}
+
+/*
*--------------------------------------------------------------
*
* Tcl_RegisterObjType --
*
- * This procedure is called to register a new Tcl object type in the
- * table of all object types supported by Tcl.
+ * This function is called to register a new Tcl object type in the table
+ * of all object types supported by Tcl.
*
* Results:
* None.
@@ -457,15 +832,16 @@ TclFinalizeObjects()
*/
void
-Tcl_RegisterObjType(typePtr)
- Tcl_ObjType *typePtr; /* Information about object type; storage must
+Tcl_RegisterObjType(
+ const Tcl_ObjType *typePtr) /* Information about object type; storage must
* be statically allocated (must live
* forever). */
{
- int new;
+ int isNew;
+
Tcl_MutexLock(&tableMutex);
Tcl_SetHashValue(
- Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr);
+ Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
Tcl_MutexUnlock(&tableMutex);
}
@@ -474,10 +850,10 @@ Tcl_RegisterObjType(typePtr)
*
* Tcl_AppendAllObjTypes --
*
- * This procedure appends onto the argument object the name of each
- * object type as a list element. This includes the builtin object types
- * (e.g. int, list) as well as those added using Tcl_NewObj. These names
- * can be used, for example, with Tcl_GetObjType to get pointers to the
+ * This function appends onto the argument object the name of each object
+ * type as a list element. This includes the builtin object types (e.g.
+ * int, list) as well as those added using Tcl_NewObj. These names can be
+ * used, for example, with Tcl_GetObjType to get pointers to the
* corresponding Tcl_ObjType structures.
*
* Results:
@@ -494,33 +870,32 @@ Tcl_RegisterObjType(typePtr)
*/
int
-Tcl_AppendAllObjTypes(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- Tcl_Obj *objPtr; /* Points to the Tcl object onto which the
+Tcl_AppendAllObjTypes(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the
* name of each registered type is appended as
* a list element. */
{
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- int objc;
- Tcl_Obj **objv;
+ int numElems;
- /*
+ /*
* Get the test for a valid list out of the way first.
*/
- if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
return TCL_ERROR;
}
/*
- * Type names are NUL-terminated, not counted strings.
- * This code relies on that.
+ * Type names are NUL-terminated, not counted strings. This code relies on
+ * that.
*/
Tcl_MutexLock(&tableMutex);
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
}
@@ -533,7 +908,7 @@ Tcl_AppendAllObjTypes(interp, objPtr)
*
* Tcl_GetObjType --
*
- * This procedure looks up an object type by name.
+ * This function looks up an object type by name.
*
* Results:
* If an object type with name matching "typeName" is found, a pointer to
@@ -545,17 +920,17 @@ Tcl_AppendAllObjTypes(interp, objPtr)
*----------------------------------------------------------------------
*/
-Tcl_ObjType *
-Tcl_GetObjType(typeName)
- CONST char *typeName; /* Name of Tcl object type to look up. */
+const Tcl_ObjType *
+Tcl_GetObjType(
+ const char *typeName) /* Name of Tcl object type to look up. */
{
register Tcl_HashEntry *hPtr;
- Tcl_ObjType *typePtr = NULL;
+ const Tcl_ObjType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
- if (hPtr != (Tcl_HashEntry *) NULL) {
- typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+ if (hPtr != NULL) {
+ typePtr = Tcl_GetHashValue(hPtr);
}
Tcl_MutexUnlock(&tableMutex);
return typePtr;
@@ -572,7 +947,7 @@ Tcl_GetObjType(typeName)
* The return value is TCL_OK on success and TCL_ERROR on failure. If
* TCL_ERROR is returned, then the interpreter's result contains an error
* message unless "interp" is NULL. Passing a NULL "interp" allows this
- * procedure to be used as a test whether the conversion could be done
+ * function to be used as a test whether the conversion could be done
* (and in fact was done).
*
* Side effects:
@@ -582,10 +957,10 @@ Tcl_GetObjType(typeName)
*/
int
-Tcl_ConvertToType(interp, objPtr, typePtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
- Tcl_ObjType *typePtr; /* The target type. */
+Tcl_ConvertToType(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* The object to convert. */
+ const Tcl_ObjType *typePtr) /* The target type. */
{
if (objPtr->typePtr == typePtr) {
return TCL_OK;
@@ -598,13 +973,67 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
*/
if (typePtr->setFromAnyProc == NULL) {
- Tcl_Panic("may not convert object to type %s", typePtr->name);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't convert value to type %s", typePtr->name));
+ Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL);
+ }
+ return TCL_ERROR;
}
return typePtr->setFromAnyProc(interp, objPtr);
}
/*
+ *--------------------------------------------------------------
+ *
+ * TclDbDumpActiveObjects --
+ *
+ * This function is called to dump all of the active Tcl_Obj structs this
+ * allocator knows about.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclDbDumpActiveObjects(
+ FILE *outFile)
+{
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable *tablePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tablePtr = tsdPtr->objThreadMap;
+
+ if (tablePtr != NULL) {
+ fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ fprintf(outFile,
+ "key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
+ Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr,
+ objData->file, objData->line);
+ } else {
+ fprintf(outFile, "key = 0x%p\n",
+ Tcl_GetHashKey(tablePtr, hPtr));
+ }
+ }
+ }
+#endif
+}
+
+/*
*----------------------------------------------------------------------
*
* TclDbInitNewObj --
@@ -623,8 +1052,13 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
*/
#ifdef TCL_MEM_DEBUG
-void TclDbInitNewObj(objPtr)
- register Tcl_Obj *objPtr;
+void
+TclDbInitNewObj(
+ register Tcl_Obj *objPtr,
+ register const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ register int line) /* Line number in the source file; used for
+ * debugging. */
{
objPtr->refCount = 0;
objPtr->bytes = tclEmptyStringRep;
@@ -640,20 +1074,29 @@ void TclDbInitNewObj(objPtr)
if (!TclInExit()) {
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
- int new;
+ int isNew;
+ ObjData *objData;
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;
- hPtr = Tcl_CreateHashEntry(tablePtr, (char *) objPtr, &new);
- if (!new) {
+ hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
+ if (!isNew) {
Tcl_Panic("expected to create new entry for object map");
}
- Tcl_SetHashValue(hPtr, NULL);
+
+ /*
+ * Record the debugging information.
+ */
+
+ objData = ckalloc(sizeof(ObjData));
+ objData->objPtr = objPtr;
+ objData->file = file;
+ objData->line = line;
+ Tcl_SetHashValue(hPtr, objData);
}
#endif /* TCL_THREADS */
}
@@ -664,13 +1107,13 @@ void TclDbInitNewObj(objPtr)
*
* Tcl_NewObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
* the empty string. These objects have a NULL object type and NULL
* string representation byte pointer. Type managers call this routine to
* allocate new objects that they further initialize.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewObj.
*
* Results:
@@ -679,7 +1122,7 @@ void TclDbInitNewObj(objPtr)
* to 0.
*
* Side effects:
- * If compiling with TCL_COMPILE_STATS, this procedure increments the
+ * If compiling with TCL_COMPILE_STATS, this function increments the
* global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
@@ -689,7 +1132,7 @@ void TclDbInitNewObj(objPtr)
#undef Tcl_NewObj
Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
{
return Tcl_DbNewObj("unknown", 0);
}
@@ -697,7 +1140,7 @@ Tcl_NewObj()
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
{
register Tcl_Obj *objPtr;
@@ -715,15 +1158,15 @@ Tcl_NewObj()
*
* Tcl_DbNewObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
- * empty string. It is the same as the Tcl_NewObj procedure above except
+ * empty string. It is the same as the Tcl_NewObj function above except
* that it calls Tcl_DbCkalloc directly with the file name and line
* number from its caller. This simplifies debugging since then the
* [memory active] command will report the correct file name and line
* number when reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewObj.
*
* Results:
@@ -731,7 +1174,7 @@ Tcl_NewObj()
* new object's typePtr is set NULL and its ref count is set to 0.
*
* Side effects:
- * If compiling with TCL_COMPILE_STATS, this procedure increments the
+ * If compiling with TCL_COMPILE_STATS, this function increments the
* global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
@@ -740,10 +1183,10 @@ Tcl_NewObj()
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewObj(file, line)
- register CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- register int line; /* Line number in the source file; used for
+Tcl_DbNewObj(
+ register const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ register int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -758,10 +1201,10 @@ Tcl_DbNewObj(file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewObj(file, line)
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewObj(
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewObj();
@@ -773,7 +1216,7 @@ Tcl_DbNewObj(file, line)
*
* TclAllocateFreeObjects --
*
- * Procedure to allocate a number of free Tcl_Objs. This is done using a
+ * Function to allocate a number of free Tcl_Objs. This is done using a
* single ckalloc to reduce the overhead for Tcl_Obj allocation.
*
* Assumes mutex is held.
@@ -784,7 +1227,7 @@ Tcl_DbNewObj(file, line)
* Side effects:
* tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
* first of a number of free Tcl_Obj's linked together by their
- * internalRep.otherValuePtrs.
+ * internalRep.twoPtrValue.ptr1's.
*
*----------------------------------------------------------------------
*/
@@ -792,7 +1235,7 @@ Tcl_DbNewObj(file, line)
#define OBJS_TO_ALLOC_EACH_TIME 100
void
-TclAllocateFreeObjects()
+TclAllocateFreeObjects(void)
{
size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
char *basePtr;
@@ -800,21 +1243,20 @@ TclAllocateFreeObjects()
register int i;
/*
- * This has been noted by Purify to be a potential leak. The problem is
+ * This has been noted by Purify to be a potential leak. The problem is
* that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
* Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
- * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
+ * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
* but leaves it to Tcl's memory subsystem finalization to release it.
* Purify apparently can't figure that out, and fires a false alarm.
*/
- basePtr = (char *) ckalloc(bytesToAlloc);
- memset(basePtr, 0, bytesToAlloc);
+ basePtr = ckalloc(bytesToAlloc);
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
- objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
prevPtr = objPtr;
objPtr++;
}
@@ -827,7 +1269,7 @@ TclAllocateFreeObjects()
*
* TclFreeObj --
*
- * This procedure frees the memory associated with the argument object.
+ * This function frees the memory associated with the argument object.
* It is called by the tcl.h macro Tcl_DecrRefCount when an object's ref
* count is zero. It is only "public" since it must be callable by that
* macro wherever the macro is used. It should not be directly called by
@@ -840,7 +1282,7 @@ TclAllocateFreeObjects()
* Deallocates the storage for the object's Tcl_Obj structure after
* deallocating the string representation and calling the type-specific
* Tcl_FreeInternalRepProc to deallocate the object's internal
- * representation. If compiling with TCL_COMPILE_STATS, this procedure
+ * representation. If compiling with TCL_COMPILE_STATS, this function
* increments the global count of freed objects (tclObjsFreed).
*
*----------------------------------------------------------------------
@@ -848,10 +1290,10 @@ TclAllocateFreeObjects()
#ifdef TCL_MEM_DEBUG
void
-TclFreeObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to be freed. */
+TclFreeObj(
+ register Tcl_Obj *objPtr) /* The object to be freed. */
{
- register Tcl_ObjType *typePtr = objPtr->typePtr;
+ register const Tcl_ObjType *typePtr = objPtr->typePtr;
/*
* This macro declares a variable, so must come here...
@@ -859,58 +1301,106 @@ TclFreeObj(objPtr)
ObjInitDeletionContext(context);
+ /*
+ * Check for a double free of the same value. This is slightly tricky
+ * because it is customary to free a Tcl_Obj when its refcount falls
+ * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though,
+ * and so on, is always a sign of a botch in the caller.
+ */
if (objPtr->refCount < -1) {
- Tcl_Panic("Reference count for %lx was negative", objPtr);
+ Tcl_Panic("Reference count for %p was negative", objPtr);
}
+ /*
+ * Now, in case we just approved drop from 1 to 0 as acceptable, make
+ * sure we do not accept a second free when falling from 0 to -1.
+ * Skip that possibility so any double free will trigger the panic.
+ */
+ objPtr->refCount = -1;
+
+ /*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering)
+ * with 'length == -1'.
+ */
+
+ TclInvalidateStringRep(objPtr);
+ objPtr->length = -1;
if (ObjDeletePending(context)) {
PushObjToDelete(context, objPtr);
} else {
+ TCL_DTRACE_OBJ_FREE(objPtr);
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
ObjDeletionLock(context);
typePtr->freeIntRepProc(objPtr);
ObjDeletionUnlock(context);
}
- Tcl_InvalidateStringRep(objPtr);
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objPtr);
+ ckfree(objPtr);
Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+ TclIncrObjsFreed();
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
- PopObjToDelete(context,objToFree);
+ PopObjToDelete(context, objToFree);
+ TCL_DTRACE_OBJ_FREE(objToFree);
TclFreeIntRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objToFree);
+ ckfree(objToFree);
Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+ TclIncrObjsFreed();
}
ObjDeletionUnlock(context);
}
+
+ /*
+ * We cannot use TclGetContinuationTable() here, because that may
+ * re-initialize the thread-data for calls coming after the finalization.
+ * We have to access it using the low-level call and then check for
+ * validity. This function can be called after TclFinalizeThreadData() has
+ * already killed the thread-global data structures. Performing
+ * TCL_TSD_INIT will leave us with an un-initialized memory block upon
+ * which we crash (if we where to access the uninitialized hashtable).
+ */
+
+ {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashEntry *hPtr;
+
+ if (tsdPtr->lineCLPtr) {
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ if (hPtr) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
+ }
}
#else /* TCL_MEM_DEBUG */
void
-TclFreeObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to be freed. */
+TclFreeObj(
+ register Tcl_Obj *objPtr) /* The object to be freed. */
{
+ /*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering)
+ * with 'length == -1'.
+ */
+
+ TclInvalidateStringRep(objPtr);
+ objPtr->length = -1;
+
if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
/*
* objPtr can be freed safely, as it will not attempt to free any
* other objects: it will not cause recursive calls to this function.
*/
- if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) {
- ckfree((char *) objPtr->bytes);
- }
+ TCL_DTRACE_OBJ_FREE(objPtr);
TclFreeObjStorage(objPtr);
TclIncrObjsFreed();
} else {
@@ -933,19 +1423,19 @@ TclFreeObj(objPtr)
* satisfy this.
*/
+ TCL_DTRACE_OBJ_FREE(objPtr);
ObjDeletionLock(context);
objPtr->typePtr->freeIntRepProc(objPtr);
ObjDeletionUnlock(context);
- if (objPtr->bytes && (objPtr->bytes != tclEmptyStringRep)) {
- ckfree((char *) objPtr->bytes);
- }
TclFreeObjStorage(objPtr);
TclIncrObjsFreed();
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
- PopObjToDelete(context,objToFree);
+
+ PopObjToDelete(context, objToFree);
+ TCL_DTRACE_OBJ_FREE(objToFree);
if ((objToFree->typePtr != NULL)
&& (objToFree->typePtr->freeIntRepProc != NULL)) {
objToFree->typePtr->freeIntRepProc(objToFree);
@@ -956,8 +1446,56 @@ TclFreeObj(objPtr)
ObjDeletionUnlock(context);
}
}
+
+ /*
+ * We cannot use TclGetContinuationTable() here, because that may
+ * re-initialize the thread-data for calls coming after the finalization.
+ * We have to access it using the low-level call and then check for
+ * validity. This function can be called after TclFinalizeThreadData() has
+ * already killed the thread-global data structures. Performing
+ * TCL_TSD_INIT will leave us with an un-initialized memory block upon
+ * which we crash (if we where to access the uninitialized hashtable).
+ */
+
+ {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashEntry *hPtr;
+
+ if (tsdPtr->lineCLPtr) {
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ if (hPtr) {
+ ckfree(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
+ }
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjBeingDeleted --
+ *
+ * This function returns 1 when the Tcl_Obj is being deleted. It is
+ * provided for the rare cases where the reason for the loss of an
+ * internal rep might be relevant. [FR 1512138]
+ *
+ * Results:
+ * 1 if being deleted, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjBeingDeleted(
+ Tcl_Obj *objPtr)
+{
+ return (objPtr->length == -1);
}
-#endif
/*
*----------------------------------------------------------------------
@@ -988,30 +1526,47 @@ TclFreeObj(objPtr)
*----------------------------------------------------------------------
*/
+#define SetDuplicateObj(dupPtr, objPtr) \
+ { \
+ const Tcl_ObjType *typePtr = (objPtr)->typePtr; \
+ const char *bytes = (objPtr)->bytes; \
+ if (bytes) { \
+ TclInitStringRep((dupPtr), bytes, (objPtr)->length); \
+ } else { \
+ (dupPtr)->bytes = NULL; \
+ } \
+ if (typePtr) { \
+ if (typePtr->dupIntRepProc) { \
+ typePtr->dupIntRepProc((objPtr), (dupPtr)); \
+ } else { \
+ (dupPtr)->internalRep = (objPtr)->internalRep; \
+ (dupPtr)->typePtr = typePtr; \
+ } \
+ } \
+ }
+
Tcl_Obj *
-Tcl_DuplicateObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to duplicate. */
+Tcl_DuplicateObj(
+ Tcl_Obj *objPtr) /* The object to duplicate. */
{
- register Tcl_ObjType *typePtr = objPtr->typePtr;
- register Tcl_Obj *dupPtr;
+ Tcl_Obj *dupPtr;
TclNewObj(dupPtr);
+ SetDuplicateObj(dupPtr, objPtr);
+ return dupPtr;
+}
- if (objPtr->bytes == NULL) {
- dupPtr->bytes = NULL;
- } else if (objPtr->bytes != tclEmptyStringRep) {
- TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
- }
-
- if (typePtr != NULL) {
- if (typePtr->dupIntRepProc == NULL) {
- dupPtr->internalRep = objPtr->internalRep;
- dupPtr->typePtr = typePtr;
- } else {
- (*typePtr->dupIntRepProc)(objPtr, dupPtr);
- }
+void
+TclSetDuplicateObj(
+ Tcl_Obj *dupPtr,
+ Tcl_Obj *objPtr)
+{
+ if (Tcl_IsShared(dupPtr)) {
+ Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
}
- return dupPtr;
+ TclInvalidateStringRep(dupPtr);
+ TclFreeIntRep(dupPtr);
+ SetDuplicateObj(dupPtr, objPtr);
}
/*
@@ -1036,19 +1591,37 @@ Tcl_DuplicateObj(objPtr)
*/
char *
-Tcl_GetString(objPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_GetString(
+ register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be returned. */
{
if (objPtr->bytes != NULL) {
return objPtr->bytes;
}
+ /*
+ * Note we do not check for objPtr->typePtr == NULL. An invariant of
+ * a properly maintained Tcl_Obj is that at least one of objPtr->bytes
+ * and objPtr->typePtr must not be NULL. If broken extensions fail to
+ * maintain that invariant, we can crash here.
+ */
+
if (objPtr->typePtr->updateStringProc == NULL) {
+ /*
+ * Those Tcl_ObjTypes which choose not to define an updateStringProc
+ * must be written in such a way that (objPtr->bytes) never becomes
+ * NULL. This panic was added in Tcl 8.1.
+ */
+
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
- (*objPtr->typePtr->updateStringProc)(objPtr);
+ objPtr->typePtr->updateStringProc(objPtr);
+ if (objPtr->bytes == NULL || objPtr->length < 0
+ || objPtr->bytes[objPtr->length] != '\0') {
+ Tcl_Panic("UpdateStringProc for type '%s' "
+ "failed to create a valid string rep", objPtr->typePtr->name);
+ }
return objPtr->bytes;
}
@@ -1076,20 +1649,14 @@ Tcl_GetString(objPtr)
*/
char *
-Tcl_GetStringFromObj(objPtr, lengthPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_GetStringFromObj(
+ register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
* be returned. */
- register int *lengthPtr; /* If non-NULL, the location where the string
+ register int *lengthPtr) /* If non-NULL, the location where the string
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
- if (objPtr->bytes == NULL) {
- if (objPtr->typePtr->updateStringProc == NULL) {
- Tcl_Panic("UpdateStringProc should not be invoked for type %s",
- objPtr->typePtr->name);
- }
- (*objPtr->typePtr->updateStringProc)(objPtr);
- }
+ (void) TclGetString(objPtr);
if (lengthPtr != NULL) {
*lengthPtr = objPtr->length;
@@ -1102,7 +1669,7 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
*
* Tcl_InvalidateStringRep --
*
- * This procedure is called to invalidate an object's string
+ * This function is called to invalidate an object's string
* representation.
*
* Results:
@@ -1116,25 +1683,24 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
*/
void
-Tcl_InvalidateStringRep(objPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_InvalidateStringRep(
+ register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be freed. */
{
TclInvalidateStringRep(objPtr);
}
-
/*
*----------------------------------------------------------------------
*
* Tcl_NewBooleanObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
* initializes it from the argument boolean value. A nonzero "boolValue"
* is coerced to 1.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewBooleanObj.
*
* Results:
@@ -1147,12 +1713,12 @@ Tcl_InvalidateStringRep(objPtr)
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBooleanObj
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
- register int boolValue; /* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+ register int boolValue) /* Boolean used to initialize new object. */
{
return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
}
@@ -1160,8 +1726,8 @@ Tcl_NewBooleanObj(boolValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
- register int boolValue; /* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+ register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
@@ -1175,15 +1741,15 @@ Tcl_NewBooleanObj(boolValue)
*
* Tcl_DbNewBooleanObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- * same as the Tcl_NewBooleanObj procedure above except that it calls
+ * same as the Tcl_NewBooleanObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewBooleanObj.
*
* Results:
@@ -1196,14 +1762,15 @@ Tcl_NewBooleanObj(boolValue)
*----------------------------------------------------------------------
*/
+#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
- register int boolValue; /* Boolean used to initialize new object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewBooleanObj(
+ register int boolValue, /* Boolean used to initialize new object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -1219,11 +1786,11 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
- register int boolValue; /* Boolean used to initialize new object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewBooleanObj(
+ register int boolValue, /* Boolean used to initialize new object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewBooleanObj(boolValue);
@@ -1248,13 +1815,14 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
*----------------------------------------------------------------------
*/
+#undef Tcl_SetBooleanObj
void
-Tcl_SetBooleanObj(objPtr, boolValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register int boolValue; /* Boolean used to set object's value. */
+Tcl_SetBooleanObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetBooleanObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
TclSetBooleanObj(objPtr, boolValue);
@@ -1280,104 +1848,56 @@ Tcl_SetBooleanObj(objPtr, boolValue)
*/
int
-Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get boolean. */
- register int *boolPtr; /* Place to store resulting boolean. */
+Tcl_GetBooleanFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get boolean. */
+ register int *boolPtr) /* Place to store resulting boolean. */
{
- double d;
- long l;
-
- /*
- * The flow through this routine is "optimized" to avoid the generation of
- * string rep. for "pure" numeric values. However, once the string rep is
- * generated it's fairly inefficient at determining a string is *not* a
- * valid boolean. It has to scan the string as many as four times (ruling
- * out "double", "long", "wideint", and "boolean" in turn) to figure out
- * that an invalid boolean value is stored in objPtr->bytes.
- */
-
- if (objPtr->typePtr == &tclIntType) {
- *boolPtr = (int) (objPtr->internalRep.longValue != 0);
- return TCL_OK;
- }
- if (objPtr->typePtr == &tclBooleanType) {
- *boolPtr = (int) objPtr->internalRep.longValue;
- return TCL_OK;
- }
- if (objPtr->typePtr == &tclWideIntType) {
- *boolPtr = (int) (objPtr->internalRep.wideValue != 0);
- return TCL_OK;
- }
-
- /*
- * Caution: Don't be tempted to check directly for the "double"
- * Tcl_ObjType and then compare the intrep to 0.0. This isn't reliable
- * because a "double" Tcl_ObjType can hold the NaN value. Use the API
- * Tcl_GetDoubleFromObj, which does the checking for us.
- */
-
- /*
- * The following call retrieves a numeric value without generating the
- * string rep of a double.
- */
-
- if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) {
- *boolPtr = (d != 0.0);
-
- /*
- * Tcl_GetDoubleFromObj() will succeed on the strings "0" and "1", but
- * we'd rather keep those values around as a better objType for
- * boolean value. Following call will shimmer appropriately.
- */
-
- if (objPtr->bytes != NULL) {
- SetBooleanFromAny(NULL, objPtr);
+ do {
+ if (objPtr->typePtr == &tclIntType) {
+ *boolPtr = (objPtr->internalRep.longValue != 0);
+ return TCL_OK;
}
- return TCL_OK;
- }
+ if (objPtr->typePtr == &tclBooleanType) {
+ *boolPtr = (int) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclDoubleType) {
+ /*
+ * Caution: Don't be tempted to check directly for the "double"
+ * Tcl_ObjType and then compare the intrep to 0.0. This isn't
+ * reliable because a "double" Tcl_ObjType can hold the NaN value.
+ * Use the API Tcl_GetDoubleFromObj, which does the checking and
+ * sets the proper error message for us.
+ */
- /*
- * Value didn't already have a numeric intrep, but perhaps we can generate
- * one. Try a long value first...
- */
+ double d;
- if (Tcl_GetLongFromObj(NULL, objPtr, &l) == TCL_OK) {
- *boolPtr = (l != 0);
- return TCL_OK;
- }
+ if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *boolPtr = (d != 0.0);
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclBignumType) {
+ *boolPtr = 1;
+ return TCL_OK;
+ }
#ifndef TCL_WIDE_INT_IS_LONG
- else {
- Tcl_WideInt w;
-
- /*
- * ...then a wide. Check in that order so that we don't promote
- * anything to wide unnecessarily.
- */
-
- if (Tcl_GetWideIntFromObj(NULL, objPtr, &w) == TCL_OK) {
- *boolPtr = (w != 0);
+ if (objPtr->typePtr == &tclWideIntType) {
+ *boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
- }
#endif
-
- /*
- * Finally, check for the string values like "yes" and generate error
- * message for non-boolean values.
- */
-
- if (SetBooleanFromAny(interp, objPtr) == TCL_OK) {
- *boolPtr = (int) objPtr->internalRep.longValue;
- return TCL_OK;
- }
+ } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
+ TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * SetBooleanFromAny --
+ * TclSetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
* "objPtr".
@@ -1394,14 +1914,11 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
*----------------------------------------------------------------------
*/
-static int
-SetBooleanFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+int
+TclSetBooleanFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
- char *str, lowerCase[6];
- int i, newBool, length;
-
/*
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
* whether a boolean conversion is possible without generating the string
@@ -1409,9 +1926,6 @@ SetBooleanFromAny(interp, objPtr)
*/
if (objPtr->bytes == NULL) {
- if (objPtr->typePtr == &tclDoubleType) {
- goto badBoolean;
- }
if (objPtr->typePtr == &tclIntType) {
switch (objPtr->internalRep.longValue) {
case 0L: case 1L:
@@ -1419,26 +1933,55 @@ SetBooleanFromAny(interp, objPtr)
}
goto badBoolean;
}
+
+ if (objPtr->typePtr == &tclBignumType) {
+ goto badBoolean;
+ }
+
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w = objPtr->internalRep.wideValue;
- if (w == 0 || w == 1) {
- newBool = (int) w;
- goto numericBoolean;
- } else {
- goto badBoolean;
- }
+ goto badBoolean;
+ }
+#endif
+
+ if (objPtr->typePtr == &tclDoubleType) {
+ goto badBoolean;
}
}
- /*
- * Parse the string as a boolean. We use an implementation here that
- * doesn't report errors in interp if interp is NULL.
- */
+ if (ParseBoolean(objPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ badBoolean:
+ if (interp != NULL) {
+ int length;
+ const char *str = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_Obj *msg;
+
+ TclNewLiteralStringObj(msg, "expected boolean value but got \"");
+ Tcl_AppendLimitedToObj(msg, str, length, 50, "");
+ Tcl_AppendToObj(msg, "\"", -1);
+ Tcl_SetObjResult(interp, msg);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
+ }
+ return TCL_ERROR;
+}
+
+static int
+ParseBoolean(
+ register Tcl_Obj *objPtr) /* The object to parse/convert. */
+{
+ int i, length, newBool;
+ char lowerCase[6];
+ const char *str = TclGetStringFromObj(objPtr, &length);
- str = Tcl_GetStringFromObj(objPtr, &length);
if ((length == 0) || (length > 5)) {
- /* longest valid boolean string rep. is "false" */
- goto badBoolean;
+ /*
+ * Longest valid boolean string rep. is "false".
+ */
+
+ return TCL_ERROR;
}
switch (str[0]) {
@@ -1447,22 +1990,23 @@ SetBooleanFromAny(interp, objPtr)
newBool = 0;
goto numericBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
case '1':
if (length == 1) {
newBool = 1;
goto numericBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
}
/*
- * Force to lower case for case-insensitive detection. Filter out known
+ * Force to lower case for case-insensitive detection. Filter out known
* invalid characters at the same time.
*/
for (i=0; i < length; i++) {
char c = str[i];
+
switch (c) {
case 'A': case 'E': case 'F': case 'L': case 'N':
case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y':
@@ -1473,7 +2017,7 @@ SetBooleanFromAny(interp, objPtr)
lowerCase[i] = c;
break;
default:
- goto badBoolean;
+ return TCL_ERROR;
}
}
lowerCase[length] = 0;
@@ -1486,28 +2030,28 @@ SetBooleanFromAny(interp, objPtr)
newBool = 1;
goto goodBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
case 'n':
if (strncmp(lowerCase, "no", (size_t) length) == 0) {
newBool = 0;
goto goodBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
case 't':
if (strncmp(lowerCase, "true", (size_t) length) == 0) {
newBool = 1;
goto goodBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
case 'f':
if (strncmp(lowerCase, "false", (size_t) length) == 0) {
newBool = 0;
goto goodBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
case 'o':
if (length < 2) {
- goto badBoolean;
+ return TCL_ERROR;
}
if (strncmp(lowerCase, "on", (size_t) length) == 0) {
newBool = 1;
@@ -1516,9 +2060,9 @@ SetBooleanFromAny(interp, objPtr)
newBool = 0;
goto goodBoolean;
}
- goto badBoolean;
+ return TCL_ERROR;
default:
- goto badBoolean;
+ return TCL_ERROR;
}
/*
@@ -1533,17 +2077,6 @@ SetBooleanFromAny(interp, objPtr)
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
- badBoolean:
- if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected boolean value but got \"", -1);
- str = Tcl_GetStringFromObj(objPtr, &length);
- TclAppendLimitedToObj(msg, str, length, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- }
- return TCL_ERROR;
-
numericBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
@@ -1556,11 +2089,11 @@ SetBooleanFromAny(interp, objPtr)
*
* Tcl_NewDoubleObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new double object and
* initializes it from the argument double value.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewDoubleObj.
*
* Results:
@@ -1577,8 +2110,8 @@ SetBooleanFromAny(interp, objPtr)
#undef Tcl_NewDoubleObj
Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
- register double dblValue; /* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+ register double dblValue) /* Double used to initialize the object. */
{
return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
}
@@ -1586,8 +2119,8 @@ Tcl_NewDoubleObj(dblValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
- register double dblValue; /* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+ register double dblValue) /* Double used to initialize the object. */
{
register Tcl_Obj *objPtr;
@@ -1601,15 +2134,15 @@ Tcl_NewDoubleObj(dblValue)
*
* Tcl_DbNewDoubleObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new double objects. It is the
- * same as the Tcl_NewDoubleObj procedure above except that it calls
+ * same as the Tcl_NewDoubleObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewDoubleObj.
*
* Results:
@@ -1625,11 +2158,11 @@ Tcl_NewDoubleObj(dblValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
- register double dblValue; /* Double used to initialize the object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewDoubleObj(
+ register double dblValue, /* Double used to initialize the object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -1645,11 +2178,11 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
- register double dblValue; /* Double used to initialize the object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewDoubleObj(
+ register double dblValue, /* Double used to initialize the object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewDoubleObj(dblValue);
@@ -1675,12 +2208,12 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
*/
void
-Tcl_SetDoubleObj(objPtr, dblValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register double dblValue; /* Double used to set the object's value. */
+Tcl_SetDoubleObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register double dblValue) /* Double used to set the object's value. */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetDoubleObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
}
TclSetDoubleObj(objPtr, dblValue);
@@ -1707,34 +2240,44 @@ Tcl_SetDoubleObj(objPtr, dblValue)
*/
int
-Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a double. */
- register double *dblPtr; /* Place to store resulting double. */
+Tcl_GetDoubleFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a double. */
+ register double *dblPtr) /* Place to store resulting double. */
{
- register int result;
+ do {
+ if (objPtr->typePtr == &tclDoubleType) {
+ if (TclIsNaN(objPtr->internalRep.doubleValue)) {
+ 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;
+ }
+ *dblPtr = (double) objPtr->internalRep.doubleValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclIntType) {
+ *dblPtr = objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclBignumType) {
+ mp_int big;
- if (objPtr->typePtr == &tclIntType) {
- *dblPtr = objPtr->internalRep.longValue;
- return TCL_OK;
- } else if (objPtr->typePtr == &tclWideIntType) {
- *dblPtr = (double) objPtr->internalRep.wideValue;
- return TCL_OK;
- } else if (objPtr->typePtr != &tclDoubleType) {
- result = SetDoubleFromAny(interp, objPtr);
- if (result != TCL_OK) {
- return TCL_ERROR;
+ UNPACK_BIGNUM(objPtr, big);
+ *dblPtr = TclBignumToDouble(&big);
+ return TCL_OK;
}
- }
- if (IS_NAN(objPtr->internalRep.doubleValue)) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "floating point value is Not a Number", -1));
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (objPtr->typePtr == &tclWideIntType) {
+ *dblPtr = (double) objPtr->internalRep.wideValue;
+ return TCL_OK;
}
- return TCL_ERROR;
- }
- *dblPtr = objPtr->internalRep.doubleValue;
- return TCL_OK;
+#endif
+ } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
+ return TCL_ERROR;
}
/*
@@ -1758,70 +2301,12 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
*/
static int
-SetDoubleFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetDoubleFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
- CONST char *string, *end;
- double newDouble;
- int length;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = Tcl_GetStringFromObj(objPtr, &length);
-
- /*
- * Now parse "objPtr"s string as an double. Numbers can't have embedded
- * NULLs. We use an implementation here that doesn't report errors in
- * interp if interp is NULL.
- */
-
- errno = 0;
- newDouble = TclStrToD(string, &end);
- if (end == string) {
- badDouble:
- if (interp != NULL) {
- Tcl_Obj *msg = Tcl_NewStringObj(
- "expected floating-point number but got \"", -1);
- TclAppendLimitedToObj(msg, string, length, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- }
- return TCL_ERROR;
- }
-
- /*
- * Make sure that the string has no garbage after the end of the double.
- */
-
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (end != (string+length)) {
- goto badDouble;
- }
-
- if (errno != 0 && errno != ERANGE) {
- if (interp != NULL) {
- TclExprFloatError(interp, newDouble);
- }
- return TCL_ERROR;
- }
-
- /*
- * The conversion to double succeeded. 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.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.doubleValue = newDouble;
- objPtr->typePtr = &tclDoubleType;
- return TCL_OK;
+ return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
+ NULL, 0);
}
/*
@@ -1831,7 +2316,7 @@ SetDoubleFromAny(interp, objPtr)
*
* Update the string representation for a double-precision floating point
* object. This must obey the current tcl_precision value for
- * double-to-string conversions. Note: This procedure does not free an
+ * double-to-string conversions. Note: This function does not free an
* existing old string rep so storage will be lost if this has not
* already been done.
*
@@ -1846,18 +2331,17 @@ SetDoubleFromAny(interp, objPtr)
*/
static void
-UpdateStringOfDouble(objPtr)
- register Tcl_Obj *objPtr; /* Double obj with string rep to update. */
+UpdateStringOfDouble(
+ register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
{
char buffer[TCL_DOUBLE_SPACE];
register int len;
- Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
- buffer);
+ 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;
}
@@ -1868,7 +2352,7 @@ UpdateStringOfDouble(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj to create a new integer object end up calling the
- * debugging procedure Tcl_DbNewLongObj instead.
+ * debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewIntObj result in a call to one of the two
@@ -1891,12 +2375,12 @@ UpdateStringOfDouble(objPtr)
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
#undef Tcl_NewIntObj
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_NewIntObj(intValue)
- register int intValue; /* Int used to initialize the new object. */
+Tcl_NewIntObj(
+ register int intValue) /* Int used to initialize the new object. */
{
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}
@@ -1904,8 +2388,8 @@ Tcl_NewIntObj(intValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewIntObj(intValue)
- register int intValue; /* Int used to initialize the new object. */
+Tcl_NewIntObj(
+ register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
@@ -1932,13 +2416,14 @@ Tcl_NewIntObj(intValue)
*----------------------------------------------------------------------
*/
+#undef Tcl_SetIntObj
void
-Tcl_SetIntObj(objPtr, intValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register int intValue; /* Integer used to set object's value. */
+Tcl_SetIntObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetIntObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
TclSetIntObj(objPtr, intValue);
@@ -1971,50 +2456,31 @@ Tcl_SetIntObj(objPtr, intValue)
*/
int
-Tcl_GetIntFromObj(interp, objPtr, intPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a int. */
- register int *intPtr; /* Place to store resulting int. */
+Tcl_GetIntFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a int. */
+ register int *intPtr) /* Place to store resulting int. */
{
- int result;
- Tcl_WideInt w = 0;
-
- /*
- * If the object isn't already an integer of any width, try to convert it
- * to one.
- */
-
- if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
- result = SetIntOrWideFromAny(interp, objPtr);
- if (result != TCL_OK) {
- return result;
- }
- }
-
- /*
- * Object should now be either int or wide. Get its value.
- */
+#if (LONG_MAX == INT_MAX)
+ return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
+#else
+ long l;
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- w = objPtr->internalRep.wideValue;
- } else
-#endif
- {
- w = Tcl_LongAsWide(objPtr->internalRep.longValue);
+ if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
+ return TCL_ERROR;
}
-
- if ((LLONG_MAX > UINT_MAX)
- && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) {
+ if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent as non-long integer",
- -1));
+ const char *s =
+ "integer value too large to represent as non-long integer";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
- *intPtr = (int)w;
+ *intPtr = (int) l;
return TCL_OK;
+#endif
}
/*
@@ -2026,156 +2492,21 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
* tclIntType, specifically.
*
* Results:
- * The return value is a standard object Tcl result. If an error occurs
- * during conversion, an error message is left in the interpreter's
- * result unless "interp" is NULL.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetIntFromAny(interp, objPtr)
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* objPtr; /* Pointer to the object to convert */
-{
- int result;
-
- result = SetIntOrWideFromAny(interp, objPtr);
- if (result != TCL_OK) {
- return result;
- }
- if (objPtr->typePtr != &tclIntType) {
- if (interp != NULL) {
- CONST char *s = "integer value too large to represent";
- Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
- }
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetIntOrWideFromAny --
- *
- * Attempt to generate an integer internal form for the Tcl object
- * "objPtr".
- *
- * Results:
* The return value is a standard object Tcl result. If an error occurs
* during conversion, an error message is left in the interpreter's
* result unless "interp" is NULL.
*
- * Side effects:
- * If no error occurs, an int is stored as "objPtr"s internal
- * representation.
- *
*----------------------------------------------------------------------
*/
static int
-SetIntOrWideFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetIntFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
- char *string, *end;
- int length;
- register char *p;
- unsigned long newLong;
- int isNegative = 0;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- p = string = Tcl_GetStringFromObj(objPtr, &length);
-
- /*
- * Now parse "objPtr"s string as an int. We use an implementation here
- * that doesn't report errors in interp if interp is NULL. Note: use
- * strtoul instead of strtol for integer conversions to allow full-size
- * unsigned numbers. We parse the leading space and sign ourselves so we
- * can tell the difference between apparently positive and negative
- * values.
- */
-
- errno = 0;
- for (; isspace(UCHAR(*p)) ; p++) { /* INTL: ISO space. */
- /* Empty loop body. */
- }
- if (*p == '-') {
- isNegative = 1;
- p++;
- } else if (*p == '+') {
- p++;
- }
- if (!isdigit(UCHAR(*p))) {
- badInteger:
- if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected integer but got \"", -1);
- TclAppendLimitedToObj(msg, string, length, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- TclCheckBadOctal(interp, string);
- }
- return TCL_ERROR;
- }
- newLong = strtoul(p, &end, 0);
- if (end == p) {
- goto badInteger;
- }
-
- /*
- * Make sure that the string has no garbage after the end of the int.
- */
-
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (end != (string+length)) {
- goto badInteger;
- }
-
- if (errno == ERANGE) {
- if (interp != NULL) {
- CONST char *s = "integer value too large to represent";
- Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
- }
- return TCL_ERROR;
- }
-
- /*
- * The conversion to int succeeded. 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.
- */
-
- TclFreeIntRep(objPtr);
-#ifndef TCL_WIDE_INT_IS_LONG
- /*
- * If the resulting integer will exceed the range of a long, put it into a
- * wide instead. (Tcl Bug #868489)
- */
+ long l;
- if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1)
- || (!isNegative && newLong > LONG_MAX)) {
- objPtr->internalRep.wideValue =
- (isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong);
- objPtr->typePtr = &tclWideIntType;
- } else
-#endif
- {
- objPtr->internalRep.longValue =
- (isNegative ? -(long)newLong : (long)newLong);
- objPtr->typePtr = &tclIntType;
- }
- return TCL_OK;
+ return TclGetLongFromObj(interp, objPtr, &l);
}
/*
@@ -2183,8 +2514,8 @@ SetIntOrWideFromAny(interp, objPtr)
*
* UpdateStringOfInt --
*
- * Update the string representation for an integer object. Note: This
- * procedure does not free an existing old string rep so storage will be
+ * Update the string representation for an integer object. Note: This
+ * function does not free an existing old string rep so storage will be
* lost if this has not already been done.
*
* Results:
@@ -2198,16 +2529,16 @@ SetIntOrWideFromAny(interp, objPtr)
*/
static void
-UpdateStringOfInt(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
+UpdateStringOfInt(
+ register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
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;
}
@@ -2218,7 +2549,7 @@ UpdateStringOfInt(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewLongObj to create a new long integer object end up calling the
- * debugging procedure Tcl_DbNewLongObj instead.
+ * debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewLongObj result in a call to one of the two
@@ -2245,8 +2576,8 @@ UpdateStringOfInt(objPtr)
#undef Tcl_NewLongObj
Tcl_Obj *
-Tcl_NewLongObj(longValue)
- register long longValue; /* Long integer used to initialize the
+Tcl_NewLongObj(
+ register long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
@@ -2255,8 +2586,8 @@ Tcl_NewLongObj(longValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewLongObj(longValue)
- register long longValue; /* Long integer used to initialize the
+Tcl_NewLongObj(
+ register long longValue) /* Long integer used to initialize the
* new object. */
{
register Tcl_Obj *objPtr;
@@ -2273,7 +2604,7 @@ Tcl_NewLongObj(longValue)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
- * objects end up calling the debugging procedure Tcl_DbNewLongObj
+ * objects end up calling the debugging function Tcl_DbNewLongObj
* instead. We provide two implementations of Tcl_DbNewLongObj so that
* whether the Tcl core is compiled to do memory debugging of the core is
* independent of whether a client requests debugging for itself.
@@ -2285,7 +2616,7 @@ Tcl_NewLongObj(longValue)
* reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- * this procedure just returns the result of calling Tcl_NewLongObj.
+ * this function just returns the result of calling Tcl_NewLongObj.
*
* Results:
* The newly created long integer object is returned. This object will
@@ -2301,12 +2632,12 @@ Tcl_NewLongObj(longValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
- register long longValue; /* Long integer used to initialize the new
+Tcl_DbNewLongObj(
+ register long longValue, /* Long integer used to initialize the new
* object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -2322,12 +2653,12 @@ Tcl_DbNewLongObj(longValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
- register long longValue; /* Long integer used to initialize the new
+Tcl_DbNewLongObj(
+ register long longValue, /* Long integer used to initialize the new
* object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewLongObj(longValue);
@@ -2353,13 +2684,13 @@ Tcl_DbNewLongObj(longValue, file, line)
*/
void
-Tcl_SetLongObj(objPtr, longValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register long longValue; /* Long integer used to initialize the
+Tcl_SetLongObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetLongObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
}
TclSetLongObj(objPtr, longValue);
@@ -2387,156 +2718,100 @@ Tcl_SetLongObj(objPtr, longValue)
*/
int
-Tcl_GetLongFromObj(interp, objPtr, longPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a long. */
- register long *longPtr; /* Place to store resulting long. */
+Tcl_GetLongFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a long. */
+ register long *longPtr) /* Place to store resulting long. */
{
- register int result;
-
- if (objPtr->typePtr != &tclIntType
- && objPtr->typePtr != &tclWideIntType) {
- result = SetIntOrWideFromAny(interp, objPtr);
- if (result != TCL_OK) {
- return result;
+ do {
+ if (objPtr->typePtr == &tclIntType) {
+ *longPtr = objPtr->internalRep.longValue;
+ return TCL_OK;
}
- }
-
#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- /*
- * If the object is already a wide integer, don't convert it. This
- * code allows for any integer in the range -ULONG_MAX to ULONG_MAX to
- * be converted to a long, ignoring overflow. The rule preserves
- * existing semantics for conversion of integers on input, but avoids
- * inadvertent demotion of wide integers to 32-bit ones in the
- * internal rep.
- */
+ if (objPtr->typePtr == &tclWideIntType) {
+ /*
+ * We return any integer in the range -ULONG_MAX to ULONG_MAX
+ * converted to a long, ignoring overflow. The rule preserves
+ * existing semantics for conversion of integers on input, but
+ * avoids inadvertent demotion of wide integers to 32-bit ones in
+ * the internal rep.
+ */
- Tcl_WideInt w = objPtr->internalRep.wideValue;
- if (w >= -(Tcl_WideInt)(ULONG_MAX)
- && w <= (Tcl_WideInt)(ULONG_MAX)) {
- *longPtr = Tcl_WideAsLong(w);
- return TCL_OK;
- } else {
+ Tcl_WideInt w = objPtr->internalRep.wideValue;
+
+ if (w >= -(Tcl_WideInt)(ULONG_MAX)
+ && w <= (Tcl_WideInt)(ULONG_MAX)) {
+ *longPtr = Tcl_WideAsLong(w);
+ return TCL_OK;
+ }
+ goto tooLarge;
+ }
+#endif
+ if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
}
- }
-#endif
-
- *longPtr = objPtr->internalRep.longValue;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWideIntFromAny --
- *
- * Attempt to generate an integer internal form for the Tcl object
- * "objPtr".
- *
- * Results:
- * The return value is a standard object Tcl result. If an error occurs
- * during conversion, an error message is left in the interpreter's
- * result unless "interp" is NULL.
- *
- * Side effects:
- * If no error occurs, an int is stored as "objPtr"s internal
- * representation.
- *
- *----------------------------------------------------------------------
- */
+ if (objPtr->typePtr == &tclBignumType) {
+ /*
+ * Must check for those bignum values that can fit in a long, even
+ * when auto-narrowing is enabled. Only those values in the signed
+ * long range get auto-narrowed to tclIntType, while all the
+ * values in the unsigned long range will fit in a long.
+ */
-static int
-SetWideIntFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
-{
+ mp_int big;
+
+ UNPACK_BIGNUM(objPtr, big);
+ if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
+ / DIGIT_BIT) {
+ unsigned long value = 0, numBytes = sizeof(long);
+ long scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
+
+ if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
+ while (numBytes-- > 0) {
+ value = (value << CHAR_BIT) | *bytes++;
+ }
+ if (big.sign) {
+ *longPtr = - (long) value;
+ } else {
+ *longPtr = (long) value;
+ }
+ return TCL_OK;
+ }
+ }
#ifndef TCL_WIDE_INT_IS_LONG
- char *string, *end;
- int length;
- register char *p;
- Tcl_WideInt newWide;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- p = string = Tcl_GetStringFromObj(objPtr, &length);
-
- /*
- * Now parse "objPtr"s string as an int. We use an implementation here
- * that doesn't report errors in interp if interp is NULL. Note: use
- * strtoull instead of strtoll for integer conversions to allow full-size
- * unsigned numbers.
- */
-
- errno = 0;
- newWide = strtoull(p, &end, 0);
- if (end == p) {
- badInteger:
- if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected integer but got \"", -1);
- TclAppendLimitedToObj(msg, string, length, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- TclCheckBadOctal(interp, string);
- }
- return TCL_ERROR;
- }
-
- /*
- * Make sure that the string has no garbage after the end of the int.
- */
-
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (end != (string+length)) {
- goto badInteger;
- }
+ tooLarge:
+#endif
+ if (interp != NULL) {
+ const char *s = "integer value too large to represent";
+ Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
- if (errno == ERANGE) {
- if (interp != NULL) {
- CONST char *s = "integer value too large to represent";
- Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+ Tcl_SetObjResult(interp, msg);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ }
+ return TCL_ERROR;
}
- return TCL_ERROR;
- }
- /*
- * The conversion to int succeeded. 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.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.wideValue = newWide;
-#else
- if (TCL_ERROR == SetIntFromAny(interp, objPtr)) {
- return TCL_ERROR;
- }
-#endif
- objPtr->typePtr = &tclWideIntType;
- return TCL_OK;
+ } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+ TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+ return TCL_ERROR;
}
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
*
* UpdateStringOfWideInt --
*
- * Update the string representation for a wide integer object. Note:
- * This procedure does not free an existing old string rep so storage
- * will be lost if this has not already been done.
+ * Update the string representation for a wide integer object. Note: this
+ * function does not free an existing old string rep so storage will be
+ * lost if this has not already been done.
*
* Results:
* None.
@@ -2548,10 +2823,9 @@ SetWideIntFromAny(interp, objPtr)
*----------------------------------------------------------------------
*/
-#ifndef TCL_WIDE_INT_IS_LONG
static void
-UpdateStringOfWideInt(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
+UpdateStringOfWideInt(
+ register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE+2];
register unsigned len;
@@ -2566,11 +2840,11 @@ UpdateStringOfWideInt(objPtr)
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;
}
-#endif /* TCL_WIDE_INT_IS_LONG */
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -2579,7 +2853,7 @@ UpdateStringOfWideInt(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewWideIntObj to create a new 64-bit integer object end up calling
- * the debugging procedure Tcl_DbNewWideIntObj instead.
+ * the debugging function Tcl_DbNewWideIntObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewWideIntObj result in a call to one of the two
@@ -2601,9 +2875,10 @@ UpdateStringOfWideInt(objPtr)
#undef Tcl_NewWideIntObj
Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the new object. */
+Tcl_NewWideIntObj(
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the new
+ * object. */
{
return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
}
@@ -2611,13 +2886,15 @@ Tcl_NewWideIntObj(wideValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the new object. */
+Tcl_NewWideIntObj(
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the new
+ * object. */
{
register Tcl_Obj *objPtr;
- TclNewWideIntObj(objPtr, wideValue);
+ TclNewObj(objPtr);
+ Tcl_SetWideIntObj(objPtr, wideValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2629,7 +2906,7 @@ Tcl_NewWideIntObj(wideValue)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewWideIntObj to create new wide integer end up calling the
- * debugging procedure Tcl_DbNewWideIntObj instead. We provide two
+ * debugging function Tcl_DbNewWideIntObj instead. We provide two
* implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is
* compiled to do memory debugging of the core is independent of whether
* a client requests debugging for itself.
@@ -2641,7 +2918,7 @@ Tcl_NewWideIntObj(wideValue)
* number when reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- * this procedure just returns the result of calling Tcl_NewWideIntObj.
+ * this function just returns the result of calling Tcl_NewWideIntObj.
*
* Results:
* The newly created wide integer object is returned. This object will
@@ -2657,36 +2934,33 @@ Tcl_NewWideIntObj(wideValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize the
- * new object. */
- CONST char *file; /* The name of the source file calling
- * this procedure; used for
- * debugging. */
- int line; /* Line number in the source file;
- * used for debugging. */
+Tcl_DbNewWideIntObj(
+ register Tcl_WideInt wideValue,
+ /* Wide integer used to initialize the new
+ * object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
+ * debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.wideValue = wideValue;
- objPtr->typePtr = &tclWideIntType;
+ Tcl_SetWideIntObj(objPtr, wideValue);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
- register Tcl_WideInt wideValue; /* Long integer used to initialize the
- * new object. */
- CONST char *file; /* The name of the source file calling
- * this procedure; used for
- * debugging. */
- int line; /* Line number in the source file;
- * used for debugging. */
+Tcl_DbNewWideIntObj(
+ register Tcl_WideInt wideValue,
+ /* Long integer used to initialize the new
+ * object. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
+ * debugging. */
{
return Tcl_NewWideIntObj(wideValue);
}
@@ -2711,16 +2985,29 @@ Tcl_DbNewWideIntObj(wideValue, file, line)
*/
void
-Tcl_SetWideIntObj(objPtr, wideValue)
- register Tcl_Obj *objPtr; /* Object w. internal rep to init. */
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the object's value. */
+Tcl_SetWideIntObj(
+ register Tcl_Obj *objPtr, /* Object w. internal rep to init. */
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the
+ * object's value. */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetWideIntObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
}
- TclSetWideIntObj(objPtr, wideValue);
+ if ((wideValue >= (Tcl_WideInt) LONG_MIN)
+ && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
+ TclSetLongObj(objPtr, (long) wideValue);
+ } else {
+#ifndef TCL_WIDE_INT_IS_LONG
+ TclSetWideIntObj(objPtr, wideValue);
+#else
+ mp_int big;
+
+ TclBNInitBignumFromWideInt(&big, wideValue);
+ Tcl_SetBignumObj(objPtr, &big);
+#endif
+ }
}
/*
@@ -2745,198 +3032,158 @@ Tcl_SetWideIntObj(objPtr, wideValue)
*/
int
-Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* Object from which to get a wide int. */
- register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */
+Tcl_GetWideIntFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
+ register Tcl_WideInt *wideIntPtr)
+ /* Place to store resulting long. */
{
- register int result;
+ do {
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (objPtr->typePtr == &tclWideIntType) {
+ *wideIntPtr = objPtr->internalRep.wideValue;
+ return TCL_OK;
+ }
+#endif
+ if (objPtr->typePtr == &tclIntType) {
+ *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclDoubleType) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr == &tclBignumType) {
+ /*
+ * Must check for those bignum values that can fit in a
+ * Tcl_WideInt, even when auto-narrowing is enabled.
+ */
- if (objPtr->typePtr == &tclWideIntType) {
- *wideIntPtr = objPtr->internalRep.wideValue;
- return TCL_OK;
- }
- result = SetWideIntFromAny(interp, objPtr);
- if (result == TCL_OK) {
- *wideIntPtr = objPtr->internalRep.wideValue;
- }
- return result;
+ mp_int big;
+
+ UNPACK_BIGNUM(objPtr, big);
+ if ((size_t) big.used <= (CHAR_BIT * sizeof(Tcl_WideInt)
+ + DIGIT_BIT - 1) / DIGIT_BIT) {
+ Tcl_WideUInt value = 0;
+ unsigned long numBytes = sizeof(Tcl_WideInt);
+ Tcl_WideInt scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
+
+ if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
+ while (numBytes-- > 0) {
+ value = (value << CHAR_BIT) | *bytes++;
+ }
+ if (big.sign) {
+ *wideIntPtr = - (Tcl_WideInt) value;
+ } else {
+ *wideIntPtr = (Tcl_WideInt) value;
+ }
+ return TCL_OK;
+ }
+ }
+ if (interp != NULL) {
+ const char *s = "integer value too large to represent";
+ Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+
+ Tcl_SetObjResult(interp, msg);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ }
+ return TCL_ERROR;
+ }
+ } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+ TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+ return TCL_ERROR;
}
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
*
- * FreeBignum --
+ * SetWideIntFromAny --
*
- * This procedure frees the internal rep of a bignum.
+ * Attempts to force the internal representation for a Tcl object to
+ * tclWideIntType, specifically.
*
* Results:
- * None.
+ * The return value is a standard object Tcl result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
*
*----------------------------------------------------------------------
*/
-static void
-FreeBignum(Tcl_Obj *objPtr)
+static int
+SetWideIntFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
- mp_int toFree; /* Bignum to free */
-
- UNPACK_BIGNUM(objPtr, toFree);
- mp_clear(&toFree);
+ Tcl_WideInt w;
+ return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
*
- * DupBignum --
+ * FreeBignum --
*
- * This procedure duplicates the internal rep of a bignum.
+ * This function frees the internal rep of a bignum.
*
* Results:
* None.
*
- * Side effects:
- * The destination object receies a copy of the source object
- *
*----------------------------------------------------------------------
*/
static void
-DupBignum(srcPtr, copyPtr)
- Tcl_Obj* srcPtr;
- Tcl_Obj* copyPtr;
+FreeBignum(
+ Tcl_Obj *objPtr)
{
- mp_int bignumVal;
- mp_int bignumCopy;
+ mp_int toFree; /* Bignum to free */
- copyPtr->typePtr = &tclBignumType;
- UNPACK_BIGNUM(srcPtr, bignumVal);
- if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
- Tcl_Panic("initialization failure in DupBignum");
+ UNPACK_BIGNUM(objPtr, toFree);
+ mp_clear(&toFree);
+ if ((long) objPtr->internalRep.ptrAndLongRep.value < 0) {
+ ckfree(objPtr->internalRep.ptrAndLongRep.ptr);
}
- PACK_BIGNUM(bignumVal, copyPtr);
+ objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
*
- * SetBignumFromAny --
+ * DupBignum --
*
- * This procedure interprets a Tcl_Obj as a bignum and sets the internal
- * representation accordingly.
+ * This function duplicates the internal rep of a bignum.
*
* Results:
- * Returns a standard Tcl status. If conversion fails, an error message
- * is left in the interpreter result.
+ * None.
*
* Side effects:
- * The bignum internal representation is packed into the object.
+ * The destination object receies a copy of the source object
*
*----------------------------------------------------------------------
*/
-static int
-SetBignumFromAny(interp, objPtr)
- Tcl_Interp* interp;
- Tcl_Obj* objPtr;
+static void
+DupBignum(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
{
- CONST char* stringVal;
- CONST char* p;
- int length;
- int signum = MP_ZPOS;
- int radix = 10;
- int status;
mp_int bignumVal;
+ mp_int bignumCopy;
- if (objPtr->typePtr == &tclIntType) {
-
- /*
- * If the number already contains an integer, simply widen it to a
- * bignum.
- */
-
- TclBNInitBignumFromLong(&bignumVal, objPtr->internalRep.longValue);
- } else {
-
- /*
- * The number doesn't contain an integer. Convert its string rep to a
- * bignum, handling 0XXX and 0xXXX notation
- */
-
- stringVal = Tcl_GetStringFromObj(objPtr, &length);
- p = stringVal;
-
- /*
- * Pull off the signum
- */
-
- if (*p == '+') {
- ++p;
- } else if (*p == '-') {
- ++p;
- signum = MP_NEG;
- }
-
- /*
- * Handle octal and hexadecimal
- */
-
- if (*p == '0') {
- ++p;
- if (*p == 'x' || *p == 'X') {
- ++p;
- radix = 16;
- } else {
- --p;
- radix = 8;
- }
- }
-
- /* Convert the value */
-
- if (mp_init(&bignumVal) != MP_OKAY) {
- Tcl_Panic("initialization failure in SetBignumFromAny");
- }
- status = mp_read_radix(&bignumVal, p, radix);
- switch (status) {
- case MP_MEM:
- Tcl_Panic("out of memory in SetBignumFromAny");
- case MP_OKAY:
- break;
- default:
- if (interp != NULL) {
- Tcl_Obj* msg = Tcl_NewStringObj(
- "expected integer but got \"", -1);
- TclAppendLimitedToObj(msg, stringVal, length, 50, "");
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
- TclCheckBadOctal(interp, stringVal);
- }
- mp_clear(&bignumVal);
- return TCL_ERROR;
- }
-
- /* Conversion to bignum succeeded. Make sure that everything fits. */
-
- if (bignumVal.alloc > 0x7fff) {
- Tcl_Obj* msg =
- Tcl_NewStringObj("integer value too large to represent",-1);
- Tcl_SetObjResult(interp, msg);
- mp_clear(&bignumVal);
- return TCL_ERROR;
- }
+ copyPtr->typePtr = &tclBignumType;
+ UNPACK_BIGNUM(srcPtr, bignumVal);
+ if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
+ Tcl_Panic("initialization failure in DupBignum");
}
-
- /*
- * Conversion succeeded. Clean up the old internal rep and store the new
- * one.
- */
-
- TclFreeIntRep(objPtr);
- bignumVal.sign = signum;
- PACK_BIGNUM(bignumVal, objPtr);
- objPtr->typePtr = &tclBignumType;
- return TCL_OK;
+ PACK_BIGNUM(bignumCopy, copyPtr);
}
/*
@@ -2944,7 +3191,7 @@ SetBignumFromAny(interp, objPtr)
*
* UpdateStringOfBignum --
*
- * This procedure updates the string representation of a bignum object.
+ * This function updates the string representation of a bignum object.
*
* Results:
* None.
@@ -2954,29 +3201,46 @@ SetBignumFromAny(interp, objPtr)
* to-string conversion.
*
* The object's existing string representation is NOT freed; memory will leak
- * if the string rep is still valid at the time this procedure is called.
+ * if the string rep is still valid at the time this function is called.
+ *
+ *----------------------------------------------------------------------
*/
static void
-UpdateStringOfBignum(Tcl_Obj* objPtr)
+UpdateStringOfBignum(
+ Tcl_Obj *objPtr)
{
mp_int bignumVal;
int size;
int status;
- char* stringVal;
+ char *stringVal;
UNPACK_BIGNUM(objPtr, bignumVal);
status = mp_radix_size(&bignumVal, 10, &size);
if (status != MP_OKAY) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
- stringVal = Tcl_Alloc((size_t) size);
+ if (size == 3) {
+ /*
+ * mp_radix_size() returns 3 when more than INT_MAX bytes would be
+ * needed to hold the string rep (because mp_radix_size ignores
+ * integer overflow issues). When we know the string rep will be more
+ * than 3, we can conclude the string rep would overflow our string
+ * length limits.
+ *
+ * Note that so long as we enforce our bignums to the size that fits
+ * in a packed bignum, this branch will never be taken.
+ */
+
+ Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
+ }
+ 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. */
}
/*
@@ -2997,26 +3261,22 @@ UpdateStringOfBignum(Tcl_Obj* objPtr)
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBignumObj
-Tcl_Obj*
-Tcl_NewBignumObj(mp_int* bignumValue)
+
+Tcl_Obj *
+Tcl_NewBignumObj(
+ mp_int *bignumValue)
{
return Tcl_DbNewBignumObj(bignumValue, "unknown", 0);
}
#else
Tcl_Obj *
-Tcl_NewBignumObj(mp_int* bignumValue)
+Tcl_NewBignumObj(
+ mp_int *bignumValue)
{
- Tcl_Obj* objPtr;
+ Tcl_Obj *objPtr;
TclNewObj(objPtr);
- PACK_BIGNUM(*bignumValue, objPtr);
- objPtr->typePtr=&tclBignumType;
- objPtr->bytes = NULL;
-
- /* Clear with mp_init; mp_clear would overwrite the digit array. */
-
- mp_init(bignumValue);
-
+ Tcl_SetBignumObj(objPtr, bignumValue);
return objPtr;
}
#endif
@@ -3026,9 +3286,9 @@ Tcl_NewBignumObj(mp_int* bignumValue)
*
* Tcl_DbNewBignumObj --
*
- * This procedure is normally called when debugging: that is, when
- * TCL_MEM_DEBUG is defined. It constructs a bignum object, recording
- * the creation point so that [memory active] can report it.
+ * This function is normally called when debugging: that is, when
+ * TCL_MEM_DEBUG is defined. It constructs a bignum object, recording the
+ * creation point so that [memory active] can report it.
*
* Results:
* Returns the newly created object.
@@ -3040,26 +3300,24 @@ Tcl_NewBignumObj(mp_int* bignumValue)
*/
#ifdef TCL_MEM_DEBUG
-Tcl_Obj*
-Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+ mp_int *bignumValue,
+ const char *file,
+ int line)
{
- Tcl_Obj* objPtr;
+ Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
- PACK_BIGNUM(*bignumValue, objPtr);
- objPtr->typePtr = &tclBignumType;
- objPtr->bytes = NULL;
-
- /* Clear with mp_init; mp_clear would overwrite the digit array. */
-
- mp_init(bignumValue);
-
+ Tcl_SetBignumObj(objPtr, bignumValue);
return objPtr;
}
#else
-Tcl_Obj*
-Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+ mp_int *bignumValue,
+ const char *file,
+ int line)
{
return Tcl_NewBignumObj(bignumValue);
}
@@ -3068,44 +3326,141 @@ Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
/*
*----------------------------------------------------------------------
*
+ * GetBignumFromObj --
+ *
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary. Either copies or transfers the mp_int value
+ * depending on the copy flag value passed in.
+ *
+ * Results:
+ * Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
+ *
+ * Side effects:
+ * A copy of bignum is stored in *bignumValue, which is expected to be
+ * uninitialized or cleared. If conversion fails, and the 'interp'
+ * argument is not NULL, an error message is stored in the interpreter
+ * result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetBignumFromObj(
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
+ int copy, /* Whether to copy the returned bignum value */
+ mp_int *bignumValue) /* Returned bignum value. */
+{
+ do {
+ if (objPtr->typePtr == &tclBignumType) {
+ if (copy || Tcl_IsShared(objPtr)) {
+ mp_int temp;
+
+ UNPACK_BIGNUM(objPtr, temp);
+ mp_init_copy(bignumValue, &temp);
+ } else {
+ UNPACK_BIGNUM(objPtr, *bignumValue);
+ objPtr->internalRep.ptrAndLongRep.ptr = NULL;
+ objPtr->internalRep.ptrAndLongRep.value = 0;
+ objPtr->typePtr = NULL;
+ if (objPtr->bytes == NULL) {
+ TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ }
+ }
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclIntType) {
+ TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
+ return TCL_OK;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (objPtr->typePtr == &tclWideIntType) {
+ TclBNInitBignumFromWideInt(bignumValue,
+ objPtr->internalRep.wideValue);
+ return TCL_OK;
+ }
+#endif
+ if (objPtr->typePtr == &tclDoubleType) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ }
+ return TCL_ERROR;
+ }
+ } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+ TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetBignumFromObj --
*
- * This procedure retrieves a 'bignum' value from a Tcl object,
- * converting the object if necessary.
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary.
*
* Results:
* Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
*
* Side effects:
* A copy of bignum is stored in *bignumValue, which is expected to be
- * uninitialized or cleared. If conversion fails, an the 'interp'
+ * uninitialized or cleared. If conversion fails, an the 'interp'
* argument is not NULL, an error message is stored in the interpreter
* result.
*
* It is expected that the caller will NOT have invoked mp_init on the
- * bignum value before passing it in. The raw value of the object is
- * returned, and Tcl owns that memory, so the caller should NOT invoke
- * mp_clear afterwards.
+ * bignum value before passing it in. Tcl will initialize the mp_int as
+ * it sets the value. The value is a copy of the value in objPtr, so it
+ * becomes the responsibility of the caller to call mp_clear on it.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetBignumFromObj(
- Tcl_Interp* interp, /* Tcl interpreter for error reporting */
- Tcl_Obj* objPtr, /* Object to read */
- mp_int* bignumValue) /* Returned bignum value. */
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
+ mp_int *bignumValue) /* Returned bignum value. */
{
- mp_int temp;
+ return GetBignumFromObj(interp, objPtr, 1, bignumValue);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TakeBignumFromObj --
+ *
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary.
+ *
+ * Results:
+ * Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
+ *
+ * Side effects:
+ * A copy of bignum is stored in *bignumValue, which is expected to be
+ * uninitialized or cleared. If conversion fails, an the 'interp'
+ * argument is not NULL, an error message is stored in the interpreter
+ * result.
+ *
+ * It is expected that the caller will NOT have invoked mp_init on the
+ * bignum value before passing it in. Tcl will initialize the mp_int as
+ * it sets the value. The value is transferred from the internals of
+ * objPtr to the caller, passing responsibility of the caller to call
+ * mp_clear on it. The objPtr is cleared to hold an empty value.
+ *
+ *----------------------------------------------------------------------
+ */
- if (objPtr->typePtr != &tclBignumType) {
- if (SetBignumFromAny(interp, objPtr) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- UNPACK_BIGNUM(objPtr, temp);
- mp_init_copy(bignumValue, &temp);
- return TCL_OK;
+int
+Tcl_TakeBignumFromObj(
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
+ mp_int *bignumValue) /* Returned bignum value. */
+{
+ return GetBignumFromObj(interp, objPtr, 0, bignumValue);
}
/*
@@ -3113,13 +3468,13 @@ Tcl_GetBignumFromObj(
*
* Tcl_SetBignumObj --
*
- * This procedure sets the value of a Tcl_Obj to a large integer.
+ * This function sets the value of a Tcl_Obj to a large integer.
*
* Results:
* None.
*
* Side effects:
- * Object value is stored. The bignum value is cleared, since ownership
+ * Object value is stored. The bignum value is cleared, since ownership
* has transferred to Tcl.
*
*----------------------------------------------------------------------
@@ -3127,20 +3482,168 @@ Tcl_GetBignumFromObj(
void
Tcl_SetBignumObj(
- Tcl_Obj* objPtr, /* Object to set */
- mp_int* bignumValue) /* Value to store */
+ Tcl_Obj *objPtr, /* Object to set */
+ mp_int *bignumValue) /* Value to store */
{
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetBignumObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
+ if ((size_t) bignumValue->used
+ <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
+ unsigned long value = 0, numBytes = sizeof(long);
+ long scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
+
+ if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
+ goto tooLargeForLong;
+ }
+ while (numBytes-- > 0) {
+ value = (value << CHAR_BIT) | *bytes++;
+ }
+ if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
+ goto tooLargeForLong;
+ }
+ if (bignumValue->sign) {
+ TclSetLongObj(objPtr, -(long)value);
+ } else {
+ TclSetLongObj(objPtr, (long)value);
+ }
+ mp_clear(bignumValue);
+ return;
+ }
+ tooLargeForLong:
+#ifndef TCL_WIDE_INT_IS_LONG
+ if ((size_t) bignumValue->used
+ <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
+ Tcl_WideUInt value = 0;
+ unsigned long numBytes = sizeof(Tcl_WideInt);
+ Tcl_WideInt scratch;
+ unsigned char *bytes = (unsigned char *)&scratch;
+
+ if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
+ goto tooLargeForWide;
+ }
+ while (numBytes-- > 0) {
+ value = (value << CHAR_BIT) | *bytes++;
+ }
+ if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
+ goto tooLargeForWide;
+ }
+ if (bignumValue->sign) {
+ TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
+ } else {
+ TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
+ }
+ mp_clear(bignumValue);
+ return;
+ }
+ tooLargeForWide:
+#endif
+ TclInvalidateStringRep(objPtr);
TclFreeIntRep(objPtr);
+ 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,
+ mp_int *bignumValue)
+{
objPtr->typePtr = &tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
- Tcl_InvalidateStringRep(objPtr);
- /* Clear the value with mp_init; mp_clear overwrites the digit array. */
+ /*
+ * Clear the mp_int value.
+ *
+ * Don't call mp_clear() because it would free the digit array we just
+ * packed into the Tcl_Obj.
+ */
+
+ bignumValue->dp = NULL;
+ bignumValue->alloc = bignumValue->used = 0;
+ bignumValue->sign = MP_NEG;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
- mp_init(bignumValue);
+int
+TclGetNumberFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ ClientData *clientDataPtr,
+ int *typePtr)
+{
+ do {
+ if (objPtr->typePtr == &tclDoubleType) {
+ if (TclIsNaN(objPtr->internalRep.doubleValue)) {
+ *typePtr = TCL_NUMBER_NAN;
+ } else {
+ *typePtr = TCL_NUMBER_DOUBLE;
+ }
+ *clientDataPtr = &objPtr->internalRep.doubleValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclIntType) {
+ *typePtr = TCL_NUMBER_LONG;
+ *clientDataPtr = &objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (objPtr->typePtr == &tclWideIntType) {
+ *typePtr = TCL_NUMBER_WIDE;
+ *clientDataPtr = &objPtr->internalRep.wideValue;
+ return TCL_OK;
+ }
+#endif
+ if (objPtr->typePtr == &tclBignumType) {
+ static Tcl_ThreadDataKey bignumKey;
+ mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
+ (int) sizeof(mp_int));
+
+ UNPACK_BIGNUM(objPtr, *bigPtr);
+ *typePtr = TCL_NUMBER_BIG;
+ *clientDataPtr = bigPtr;
+ return TCL_OK;
+ }
+ } while (TCL_OK ==
+ TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
+ return TCL_ERROR;
}
/*
@@ -3148,11 +3651,11 @@ Tcl_SetBignumObj(
*
* Tcl_DbIncrRefCount --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
* has been freed before incrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just increments the
+ * When TCL_MEM_DEBUG is not defined, this function just increments the
* reference count of the object.
*
* Results:
@@ -3165,19 +3668,19 @@ Tcl_SetBignumObj(
*/
void
-Tcl_DbIncrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are registering a reference
+Tcl_DbIncrRefCount(
+ register Tcl_Obj *objPtr, /* The object we are registering a reference
* to. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
#ifdef TCL_MEM_DEBUG
if (objPtr->refCount == 0x61616161) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
- Tcl_Panic("Trying to increment refCount of previously disposed object.");
+ Tcl_Panic("incrementing refCount of previously disposed object");
}
# ifdef TCL_THREADS
@@ -3188,23 +3691,21 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*/
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, (char *) objPtr);
+ 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;
}
@@ -3213,11 +3714,11 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*
* Tcl_DbDecrRefCount --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
* has been freed before decrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just decrements the
+ * When TCL_MEM_DEBUG is not defined, this function just decrements the
* reference count of the object.
*
* Results:
@@ -3230,19 +3731,19 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*/
void
-Tcl_DbDecrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are releasing a reference
+Tcl_DbDecrRefCount(
+ register Tcl_Obj *objPtr, /* The object we are releasing a reference
* to. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
#ifdef TCL_MEM_DEBUG
if (objPtr->refCount == 0x61616161) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
- Tcl_Panic("Trying to decrement refCount of previously disposed object.");
+ Tcl_Panic("decrementing refCount of previously disposed object");
}
# ifdef TCL_THREADS
@@ -3253,28 +3754,36 @@ Tcl_DbDecrRefCount(objPtr, file, line)
*/
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, (char *) objPtr);
+ 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");
}
- /* If the Tcl_Obj is going to be deleted, remove the entry */
- if ((((objPtr)->refCount) - 1) <= 0) {
+ /*
+ * If the Tcl_Obj is going to be deleted, remove the entry.
+ */
+
+ if ((objPtr->refCount - 1) <= 0) {
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ ckfree(objData);
+ }
+
Tcl_DeleteHashEntry(hPtr);
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
+
if (--(objPtr)->refCount <= 0) {
TclFreeObj(objPtr);
}
@@ -3285,11 +3794,11 @@ Tcl_DbDecrRefCount(objPtr, file, line)
*
* Tcl_DbIsShared --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It tests whether the object has a ref count
* greater than one.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just tests if the
+ * When TCL_MEM_DEBUG is not defined, this function just tests if the
* object has a ref count greater than one.
*
* Results:
@@ -3302,18 +3811,18 @@ Tcl_DbDecrRefCount(objPtr, file, line)
*/
int
-Tcl_DbIsShared(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object to test for being shared. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbIsShared(
+ register Tcl_Obj *objPtr, /* The object to test for being shared. */
+ const char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
* debugging. */
{
#ifdef TCL_MEM_DEBUG
if (objPtr->refCount == 0x61616161) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
- Tcl_Panic("Trying to check whether previously disposed object is shared.");
+ Tcl_Panic("checking whether previously disposed object is shared");
}
# ifdef TCL_THREADS
@@ -3324,22 +3833,21 @@ Tcl_DbIsShared(objPtr, file, line)
*/
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, (char *) objPtr);
+ 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);
@@ -3351,7 +3859,7 @@ Tcl_DbIsShared(objPtr, file, line)
tclObjsShared[0]++;
}
Tcl_MutexUnlock(&tclObjMutex);
-#endif
+#endif /* TCL_COMPILE_STATS */
return ((objPtr)->refCount > 1);
}
@@ -3375,8 +3883,8 @@ Tcl_DbIsShared(objPtr, file, line)
*/
void
-Tcl_InitObjHashTable(tablePtr)
- register Tcl_HashTable *tablePtr;
+Tcl_InitObjHashTable(
+ register Tcl_HashTable *tablePtr)
/* Pointer to table record, which is supplied
* by the caller. */
{
@@ -3401,16 +3909,16 @@ Tcl_InitObjHashTable(tablePtr)
*/
static Tcl_HashEntry *
-AllocObjEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key to store in the hash table entry. */
+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;
return hPtr;
}
@@ -3418,7 +3926,7 @@ AllocObjEntry(tablePtr, keyPtr)
/*
*----------------------------------------------------------------------
*
- * CompareObjKeys --
+ * TclCompareObjKeys --
*
* Compares two Tcl_Obj * keys.
*
@@ -3432,14 +3940,14 @@ AllocObjEntry(tablePtr, keyPtr)
*----------------------------------------------------------------------
*/
-static int
-CompareObjKeys(keyPtr, hPtr)
- VOID *keyPtr; /* New key to compare. */
- Tcl_HashEntry *hPtr; /* Existing key to compare. */
+int
+TclCompareObjKeys(
+ void *keyPtr, /* New key to compare. */
+ Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+ Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
- register CONST char *p1, *p2;
+ register const char *p1, *p2;
register int l1, l2;
/*
@@ -3481,7 +3989,7 @@ CompareObjKeys(keyPtr, hPtr)
/*
*----------------------------------------------------------------------
*
- * FreeObjEntry --
+ * TclFreeObjEntry --
*
* Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
*
@@ -3494,20 +4002,20 @@ CompareObjKeys(keyPtr, hPtr)
*----------------------------------------------------------------------
*/
-static void
-FreeObjEntry(hPtr)
- Tcl_HashEntry *hPtr; /* Hash entry to free. */
+void
+TclFreeObjEntry(
+ Tcl_HashEntry *hPtr) /* Hash entry to free. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
Tcl_DecrRefCount(objPtr);
- ckfree((char *) hPtr);
+ ckfree(hPtr);
}
/*
*----------------------------------------------------------------------
*
- * HashObjKey --
+ * TclHashObjKey --
*
* Compute a one-word summary of the string representation of the
* Tcl_Obj, which can be used to generate a hash index.
@@ -3522,35 +4030,55 @@ FreeObjEntry(hPtr)
*----------------------------------------------------------------------
*/
-static unsigned int
-HashObjKey(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key from which to compute hash value. */
+unsigned int
+TclHashObjKey(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
- Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
- CONST char *string = TclGetString(objPtr);
- int length = objPtr->length;
+ Tcl_Obj *objPtr = keyPtr;
+ int length;
+ const char *string = TclGetStringFromObj(objPtr, &length);
unsigned int result = 0;
- int i;
/*
* I tried a zillion different hash functions and asked many other people
- * for advice. Many people had their own favorite functions, all
- * different, but no-one had much idea why they were good ones. I chose
+ * for advice. Many people had their own favorite functions, all
+ * different, but no-one had much idea why they were good ones. I chose
* the one below (multiply by 9 and add new character) because of the
* following reasons:
*
* 1. Multiplying by 10 is perfect for keys that are decimal strings, and
- * multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
- * character's bits hang around in the low-order bits of the hash value
- * for ever, plus they spread fairly rapidly up to the high-order bits
- * to fill out the hash value. This seems works well both for decimal
- * and *non-decimal strings.
+ * multiplying by 9 is just about as good.
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * character's bits hang around in the low-order bits of the hash value
+ * for ever, plus they spread fairly rapidly up to the high-order bits
+ * to fill out the hash value. This seems works well both for decimal
+ * and non-decimal strings.
+ *
+ * Note that this function is very weak against malicious strings; it's
+ * very easy to generate multiple keys that have the same hashcode. On the
+ * other hand, that hardly ever actually occurs and this function *is*
+ * very cheap, even by comparison with industry-standard hashes like FNV.
+ * If real strength of hash is required though, use a custom hash based on
+ * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
+ * Tcl does not use that level of strength because it typically does not
+ * need it (and some of the aspects of that strength are genuinely
+ * unnecessary given the rest of Tcl's hash machinery, and the fact that
+ * we do not either transfer hashes to another machine, use them as a true
+ * substitute for equality, or attempt to minimize work in rebuilding the
+ * hash table).
+ *
+ * See also HashStringKey in tclHash.c.
+ * See also HashString in tclLiteral.c.
+ *
+ * See [tcl-Feature Request #2958832]
*/
- for (i=0 ; i<length ; i++) {
- result += (result << 3) + string[i];
+ if (length > 0) {
+ result = UCHAR(*string);
+ while (--length) {
+ result += (result << 3) + UCHAR(*++string);
+ }
}
return result;
}
@@ -3568,103 +4096,73 @@ HashObjKey(tablePtr, keyPtr)
*
* Side effects:
* May update the internal representation for the object, caching the
- * command reference so that the next time this procedure is called with
+ * command reference so that the next time this function is called with
* the same object, the command can be found quickly.
*
*----------------------------------------------------------------------
*/
Tcl_Command
-Tcl_GetCommandFromObj(interp, objPtr)
- Tcl_Interp *interp; /* The interpreter in which to resolve the
+Tcl_GetCommandFromObj(
+ Tcl_Interp *interp, /* The interpreter in which to resolve the
* command and to report errors. */
- register Tcl_Obj *objPtr; /* The object containing the command's name.
+ register Tcl_Obj *objPtr) /* The object containing the command's name.
* If the name starts with "::", will be
* looked up in global namespace. Else, looked
* up first in the current namespace, then in
* global namespace. */
{
- Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
- register Command *cmdPtr;
- Namespace *currNsPtr;
- int result;
- CallFrame *savedFramePtr;
- char *name;
-
- /*
- * If the variable name is fully qualified, do as if the lookup were done
- * from the global namespace; this helps avoid repeated lookups of fully
- * qualified names. It costs close to nothing, and may be very helpful for
- * OO applications which pass along a command name ("this"), [Patch
- * 456668]
- */
-
- savedFramePtr = iPtr->varFramePtr;
- name = Tcl_GetString(objPtr);
- if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
- }
/*
* Get the internal representation, converting to a command type if
* needed. The internal representation is a ResolvedCmdName that points to
* the actual command.
+ *
+ * Check the context namespace and the namespace epoch of the resolved
+ * symbol to make sure that it is fresh. Note that we verify that the
+ * namespace id of the context namespace is the same as the one we cached;
+ * this insures that the namespace wasn't deleted and a new one created at
+ * the same address with the same command epoch. Note that fully qualified
+ * names have a NULL refNsPtr, these checks needn't be made.
+ *
+ * Check also that the command's epoch is up to date, and that the command
+ * is not deleted.
+ *
+ * If any check fails, then force another conversion to the command type,
+ * to discard the old rep and create a new one.
*/
- if (objPtr->typePtr != &tclCmdNameType) {
- result = tclCmdNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- iPtr->varFramePtr = savedFramePtr;
- return (Tcl_Command) NULL;
- }
- }
- resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
-
- /*
- * Get the current namespace.
- */
-
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
+ register Command *cmdPtr = resPtr->cmdPtr;
+
+ if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
+ && !(cmdPtr->flags & CMD_IS_DELETED)
+ && (interp == cmdPtr->nsPtr->interp)
+ && !(cmdPtr->nsPtr->flags & NS_DYING)) {
+ register Namespace *refNsPtr = (Namespace *)
+ TclGetCurrentNamespace(interp);
+
+ if ((resPtr->refNsPtr == NULL)
+ || ((refNsPtr == resPtr->refNsPtr)
+ && (resPtr->refNsId == refNsPtr->nsId)
+ && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
+ return (Tcl_Command) cmdPtr;
+ }
+ }
}
/*
- * Check the context namespace and the namespace epoch of the resolved
- * symbol to make sure that it is fresh. If not, then force another
- * conversion to the command type, to discard the old rep and create a new
- * one. Note that we verify that the namespace id of the context namespace
- * is the same as the one we cached; this insures that the namespace
- * wasn't deleted and a new one created at the same address with the same
- * command epoch.
+ * OK, must create a new internal representation (or fail) as any cache we
+ * had is invalid one way or another.
*/
- cmdPtr = NULL;
- if ((resPtr != NULL)
- && (resPtr->refNsPtr == currNsPtr)
- && (resPtr->refNsId == currNsPtr->nsId)
- && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
- cmdPtr = resPtr->cmdPtr;
- if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
- cmdPtr = NULL;
- }
+ if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
+ return NULL;
}
-
- if (cmdPtr == NULL) {
- result = tclCmdNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- iPtr->varFramePtr = savedFramePtr;
- return (Tcl_Command) NULL;
- }
- resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
- if (resPtr != NULL) {
- cmdPtr = resPtr->cmdPtr;
- }
- }
- iPtr->varFramePtr = savedFramePtr;
- return (Tcl_Command) cmdPtr;
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}
/*
@@ -3682,69 +4180,59 @@ Tcl_GetCommandFromObj(interp, objPtr)
* The object's old internal rep is freed. It's string rep is not
* changed. The refcount in the Command structure is incremented to keep
* it from being freed if the command is later deleted until
- * TclExecuteByteCode has a chance to recognize that it was deleted.
+ * TclNRExecuteByteCode has a chance to recognize that it was deleted.
*
*----------------------------------------------------------------------
*/
void
-TclSetCmdNameObj(interp, objPtr, cmdPtr)
- Tcl_Interp *interp; /* Points to interpreter containing command
+TclSetCmdNameObj(
+ Tcl_Interp *interp, /* Points to interpreter containing command
* that should be cached in objPtr. */
- register Tcl_Obj *objPtr; /* Points to Tcl object to be changed to a
+ register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
* CmdName object. */
- Command *cmdPtr; /* Points to Command structure that the
+ Command *cmdPtr) /* Points to Command structure that the
* CmdName object should refer to. */
{
Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
register Namespace *currNsPtr;
- CallFrame *savedFramePtr;
- char *name;
+ const char *name;
if (objPtr->typePtr == &tclCmdNameType) {
return;
}
- /*
- * If the variable name is fully qualified, do as if the lookup were done
- * from the global namespace; this helps avoid repeated lookups of fully
- * qualified names. It costs close to nothing, and may be very helpful for
- * OO applications which pass along a command name ("this"), [Patch
- * 456668] (Copied over from Tcl_GetCommandFromObj)
- */
+ cmdPtr->refCount++;
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
+ resPtr->cmdPtr = cmdPtr;
+ resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+ resPtr->refCount = 1;
- savedFramePtr = iPtr->varFramePtr;
- name = Tcl_GetString(objPtr);
+ name = TclGetString(objPtr);
if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
- }
+ /*
+ * The name is fully qualified: set the referring namespace to
+ * NULL.
+ */
- /*
- * Get the current namespace.
- */
+ resPtr->refNsPtr = NULL;
+ } else {
+ /*
+ * Get the current namespace.
+ */
- if (iPtr->varFramePtr != NULL) {
currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
- }
- cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
- resPtr->cmdPtr = cmdPtr;
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- resPtr->refCount = 1;
+ resPtr->refNsPtr = currNsPtr;
+ resPtr->refNsId = currNsPtr->nsId;
+ resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ }
TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
-
- iPtr->varFramePtr = savedFramePtr;
}
/*
@@ -3769,16 +4257,15 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
*/
static void
-FreeCmdNameInternalRep(objPtr)
- register Tcl_Obj *objPtr; /* CmdName object with internal
+FreeCmdNameInternalRep(
+ register Tcl_Obj *objPtr) /* CmdName object with internal
* representation to free. */
{
- register ResolvedCmdName *resPtr =
- (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+ register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
if (resPtr != NULL) {
/*
- * Decrement the reference count of the ResolvedCmdName structure. If
+ * Decrement the reference count of the ResolvedCmdName structure. If
* there are no more uses, free the ResolvedCmdName structure.
*/
@@ -3791,10 +4278,12 @@ FreeCmdNameInternalRep(objPtr)
*/
Command *cmdPtr = resPtr->cmdPtr;
- TclCleanupCommand(cmdPtr);
- ckfree((char *) resPtr);
+
+ TclCleanupCommandMacro(cmdPtr);
+ ckfree(resPtr);
}
}
+ objPtr->typePtr = NULL;
}
/*
@@ -3818,14 +4307,13 @@ FreeCmdNameInternalRep(objPtr)
*/
static void
-DupCmdNameInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupCmdNameInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- register ResolvedCmdName *resPtr = (ResolvedCmdName *)
- srcPtr->internalRep.twoPtrValue.ptr1;
+ register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
if (resPtr != NULL) {
resPtr->refCount++;
@@ -3855,24 +4343,18 @@ DupCmdNameInternalRep(srcPtr, copyPtr)
*/
static int
-SetCmdNameFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetCmdNameFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
- char *name;
- Tcl_Command cmd;
+ const char *name;
register Command *cmdPtr;
Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
- /*
- * Get "objPtr"s string representation. Make it up-to-date if necessary.
- */
-
- name = objPtr->bytes;
- if (name == NULL) {
- name = Tcl_GetString(objPtr);
+ if (interp == NULL) {
+ return TCL_ERROR;
}
/*
@@ -3883,43 +4365,128 @@ SetCmdNameFromAny(interp, objPtr)
* referenced from a CmdName object.
*/
- cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
- cmdPtr = (Command *) cmd;
- if (cmdPtr != NULL) {
- /*
- * Get the current namespace.
- */
+ name = TclGetString(objPtr);
+ cmdPtr = (Command *)
+ Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ /*
+ * Free the old internalRep before setting the new one. Do this after
+ * getting the string rep to allow the conversion code (in particular,
+ * Tcl_GetStringFromObj) to use that old internalRep.
+ */
+
+ if (cmdPtr) {
+ cmdPtr->refCount++;
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if ((objPtr->typePtr == &tclCmdNameType)
+ && resPtr && (resPtr->refCount == 1)) {
+ /*
+ * Reuse the old ResolvedCmdName struct instead of freeing it
+ */
+
+ Command *oldCmdPtr = resPtr->cmdPtr;
+
+ if (--oldCmdPtr->refCount == 0) {
+ TclCleanupCommandMacro(oldCmdPtr);
+ }
} else {
- currNsPtr = iPtr->globalNsPtr;
+ TclFreeIntRep(objPtr);
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
+ resPtr->refCount = 1;
+ objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
}
+ resPtr->cmdPtr = cmdPtr;
+ resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+ if ((*name++ == ':') && (*name == ':')) {
+ /*
+ * The name is fully qualified: set the referring namespace to
+ * NULL.
+ */
- cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
- resPtr->cmdPtr = cmdPtr;
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- resPtr->refCount = 1;
+ resPtr->refNsPtr = NULL;
+ } else {
+ /*
+ * Get the current namespace.
+ */
+
+ currNsPtr = iPtr->varFramePtr->nsPtr;
+
+ resPtr->refNsPtr = currNsPtr;
+ resPtr->refNsId = currNsPtr->nsId;
+ resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ }
} else {
- resPtr = NULL; /* no command named "name" was found */
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RepresentationCmd --
+ *
+ * Implementation of the "tcl::unsupported::representation" command.
+ *
+ * Results:
+ * Reports the current representation (Tcl_Obj type) of its argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RepresentationCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ char ptrBuffer[2*TCL_INTEGER_SPACE+6];
+ Tcl_Obj *descObj;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "value");
+ return TCL_ERROR;
}
/*
- * Free the old internalRep before setting the new one. We do this as late
- * as possible to allow the conversion code, in particular
- * GetStringFromObj, to use that old internalRep. If no Command structure
- * was found, leave NULL as the cached value.
+ * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
+ * internal representation 0x45671234:0x98765432, string representation
+ * "1872361827361287"
*/
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+ 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(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) {
+ Tcl_AppendToObj(descObj, ", string representation \"", -1);
+ Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
+ 16, "...");
+ Tcl_AppendToObj(descObj, "\"", -1);
+ } else {
+ Tcl_AppendToObj(descObj, ", no string representation", -1);
+ }
+
+ Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
@@ -3928,5 +4495,7 @@ SetCmdNameFromAny(interp, objPtr)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
new file mode 100644
index 0000000..827d89d
--- /dev/null
+++ b/generic/tclOptimize.c
@@ -0,0 +1,444 @@
+/*
+ * tclOptimize.c --
+ *
+ * This file contains the bytecode optimizer.
+ *
+ * Copyright (c) 2013 by Donal Fellows.
+ *
+ * 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 "tclCompile.h"
+#include <assert.h>
+
+/*
+ * Forward declarations.
+ */
+
+static void AdvanceJumps(CompileEnv *envPtr);
+static void ConvertZeroEffectToNOP(CompileEnv *envPtr);
+static void LocateTargetAddresses(CompileEnv *envPtr,
+ Tcl_HashTable *tablePtr);
+static void TrimUnreachable(CompileEnv *envPtr);
+
+/*
+ * Helper macros.
+ */
+
+#define DefineTargetAddress(tablePtr, address) \
+ ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew))
+#define IsTargetAddress(tablePtr, address) \
+ (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL)
+#define AddrLength(address) \
+ (tclInstructionTable[*(unsigned char *)(address)].numBytes)
+#define InstLength(instruction) \
+ (tclInstructionTable[(unsigned char)(instruction)].numBytes)
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * LocateTargetAddresses --
+ *
+ * Populate a hash table with places that we need to be careful around
+ * because they're the targets of various kinds of jumps and other
+ * non-local behavior.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+LocateTargetAddresses(
+ CompileEnv *envPtr,
+ Tcl_HashTable *tablePtr)
+{
+ unsigned char *currentInstPtr, *targetInstPtr;
+ int isNew, i;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+
+ Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);
+
+ /*
+ * The starts of commands represent target addresses.
+ */
+
+ for (i=0 ; i<envPtr->numCommands ; i++) {
+ DefineTargetAddress(tablePtr,
+ envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset);
+ }
+
+ /*
+ * Find places where we should be careful about replacing instructions
+ * because they are the targets of various types of jumps.
+ */
+
+ for (currentInstPtr = envPtr->codeStart ;
+ currentInstPtr < envPtr->codeNext ;
+ currentInstPtr += AddrLength(currentInstPtr)) {
+ switch (*currentInstPtr) {
+ case INST_JUMP1:
+ case INST_JUMP_TRUE1:
+ case INST_JUMP_FALSE1:
+ targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1);
+ goto storeTarget;
+ case INST_JUMP4:
+ case INST_JUMP_TRUE4:
+ case INST_JUMP_FALSE4:
+ case INST_START_CMD:
+ targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1);
+ goto storeTarget;
+ case INST_BEGIN_CATCH4:
+ targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[
+ TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset;
+ storeTarget:
+ DefineTargetAddress(tablePtr, targetInstPtr);
+ break;
+ case INST_JUMP_TABLE:
+ hPtr = Tcl_FirstHashEntry(
+ &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable,
+ &hSearch);
+ for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ targetInstPtr = currentInstPtr +
+ PTR2INT(Tcl_GetHashValue(hPtr));
+ DefineTargetAddress(tablePtr, targetInstPtr);
+ }
+ break;
+ case INST_RETURN_CODE_BRANCH:
+ for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) {
+ DefineTargetAddress(tablePtr, currentInstPtr + 2*i - 1);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Add a marker *after* the last bytecode instruction. WARNING: points to
+ * one past the end!
+ */
+
+ DefineTargetAddress(tablePtr, currentInstPtr);
+
+ /*
+ * Enter in the targets of exception ranges.
+ */
+
+ for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+
+ if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+ targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
+ DefineTargetAddress(tablePtr, targetInstPtr);
+ } else {
+ targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
+ DefineTargetAddress(tablePtr, targetInstPtr);
+ if (rangePtr->continueOffset >= 0) {
+ targetInstPtr = envPtr->codeStart + rangePtr->continueOffset;
+ DefineTargetAddress(tablePtr, targetInstPtr);
+ }
+ }
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TrimUnreachable --
+ *
+ * Converts code that provably can't be executed into NOPs and reduces
+ * the overall reported length of the bytecode where that is possible.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+TrimUnreachable(
+ CompileEnv *envPtr)
+{
+ unsigned char *currentInstPtr;
+ Tcl_HashTable targets;
+
+ LocateTargetAddresses(envPtr, &targets);
+
+ for (currentInstPtr = envPtr->codeStart ;
+ currentInstPtr < envPtr->codeNext-1 ;
+ currentInstPtr += AddrLength(currentInstPtr)) {
+ int clear = 0;
+
+ if (*currentInstPtr != INST_DONE) {
+ continue;
+ }
+
+ while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) {
+ clear += AddrLength(currentInstPtr + 1 + clear);
+ }
+ if (currentInstPtr + 1 + clear == envPtr->codeNext) {
+ envPtr->codeNext -= clear;
+ } else {
+ while (clear --> 0) {
+ *(currentInstPtr + 1 + clear) = INST_NOP;
+ }
+ }
+ }
+
+ Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ConvertZeroEffectToNOP --
+ *
+ * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
+ * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
+ * operation that guarantees the check for arithmeticity) and eliminate
+ * LNOT when we can invert the following JUMP condition.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ConvertZeroEffectToNOP(
+ CompileEnv *envPtr)
+{
+ unsigned char *currentInstPtr;
+ int size;
+ Tcl_HashTable targets;
+
+ LocateTargetAddresses(envPtr, &targets);
+ for (currentInstPtr = envPtr->codeStart ;
+ currentInstPtr < envPtr->codeNext ; currentInstPtr += size) {
+ int blank = 0, i, nextInst;
+
+ size = AddrLength(currentInstPtr);
+ while ((currentInstPtr + size < envPtr->codeNext)
+ && *(currentInstPtr+size) == INST_NOP) {
+ if (IsTargetAddress(&targets, currentInstPtr + size)) {
+ break;
+ }
+ size += InstLength(INST_NOP);
+ }
+ if (IsTargetAddress(&targets, currentInstPtr + size)) {
+ continue;
+ }
+ nextInst = *(currentInstPtr + size);
+ switch (*currentInstPtr) {
+ case INST_PUSH1:
+ if (nextInst == INST_POP) {
+ blank = size + InstLength(nextInst);
+ } else if (nextInst == INST_STR_CONCAT1
+ && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
+ Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+ TclGetUInt1AtPtr(currentInstPtr + 1));
+ int numBytes;
+
+ (void) Tcl_GetStringFromObj(litPtr, &numBytes);
+ if (numBytes == 0) {
+ blank = size + InstLength(nextInst);
+ }
+ }
+ break;
+ case INST_PUSH4:
+ if (nextInst == INST_POP) {
+ blank = size + 1;
+ } else if (nextInst == INST_STR_CONCAT1
+ && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
+ Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+ TclGetUInt4AtPtr(currentInstPtr + 1));
+ int numBytes;
+
+ (void) Tcl_GetStringFromObj(litPtr, &numBytes);
+ if (numBytes == 0) {
+ blank = size + InstLength(nextInst);
+ }
+ }
+ break;
+
+ case INST_LNOT:
+ switch (nextInst) {
+ case INST_JUMP_TRUE1:
+ blank = size;
+ *(currentInstPtr + size) = INST_JUMP_FALSE1;
+ break;
+ case INST_JUMP_FALSE1:
+ blank = size;
+ *(currentInstPtr + size) = INST_JUMP_TRUE1;
+ break;
+ case INST_JUMP_TRUE4:
+ blank = size;
+ *(currentInstPtr + size) = INST_JUMP_FALSE4;
+ break;
+ case INST_JUMP_FALSE4:
+ blank = size;
+ *(currentInstPtr + size) = INST_JUMP_TRUE4;
+ break;
+ }
+ break;
+
+ case INST_TRY_CVT_TO_NUMERIC:
+ switch (nextInst) {
+ case INST_JUMP_TRUE1:
+ case INST_JUMP_TRUE4:
+ case INST_JUMP_FALSE1:
+ case INST_JUMP_FALSE4:
+ case INST_INCR_SCALAR1:
+ case INST_INCR_ARRAY1:
+ case INST_INCR_ARRAY_STK:
+ case INST_INCR_SCALAR_STK:
+ case INST_INCR_STK:
+ case INST_LOR:
+ case INST_LAND:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_LE:
+ case INST_GT:
+ 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:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ blank = size;
+ break;
+ }
+ break;
+ }
+
+ if (blank > 0) {
+ for (i=0 ; i<blank ; i++) {
+ *(currentInstPtr + i) = INST_NOP;
+ }
+ size = blank;
+ }
+ }
+ Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AdvanceJumps --
+ *
+ * Advance jumps past NOPs and chained JUMPs. After this runs, the only
+ * JUMPs that jump to a NOP or a JUMP will be length-1 ones that run out
+ * of room in their opcode to be targeted to where they really belong.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AdvanceJumps(
+ CompileEnv *envPtr)
+{
+ unsigned char *currentInstPtr;
+ Tcl_HashTable jumps;
+
+ for (currentInstPtr = envPtr->codeStart ;
+ currentInstPtr < envPtr->codeNext-1 ;
+ currentInstPtr += AddrLength(currentInstPtr)) {
+ int offset, delta, isNew;
+
+ switch (*currentInstPtr) {
+ case INST_JUMP1:
+ case INST_JUMP_TRUE1:
+ case INST_JUMP_FALSE1:
+ offset = TclGetInt1AtPtr(currentInstPtr + 1);
+ Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+ for (delta=0 ; offset+delta != 0 ;) {
+ if (offset + delta < -128 || offset + delta > 127) {
+ break;
+ }
+ Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+ if (!isNew) {
+ offset = TclGetInt1AtPtr(currentInstPtr + 1);
+ break;
+ }
+ offset += delta;
+ switch (*(currentInstPtr + offset)) {
+ case INST_NOP:
+ delta = InstLength(INST_NOP);
+ continue;
+ case INST_JUMP1:
+ delta = TclGetInt1AtPtr(currentInstPtr + offset + 1);
+ continue;
+ case INST_JUMP4:
+ delta = TclGetInt4AtPtr(currentInstPtr + offset + 1);
+ continue;
+ }
+ break;
+ }
+ Tcl_DeleteHashTable(&jumps);
+ TclStoreInt1AtPtr(offset, currentInstPtr + 1);
+ continue;
+
+ case INST_JUMP4:
+ case INST_JUMP_TRUE4:
+ case INST_JUMP_FALSE4:
+ Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+ Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew);
+ for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
+ Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+ if (!isNew) {
+ offset = TclGetInt4AtPtr(currentInstPtr + 1);
+ break;
+ }
+ switch (*(currentInstPtr + offset)) {
+ case INST_NOP:
+ offset += InstLength(INST_NOP);
+ continue;
+ case INST_JUMP1:
+ offset += TclGetInt1AtPtr(currentInstPtr + offset + 1);
+ continue;
+ case INST_JUMP4:
+ offset += TclGetInt4AtPtr(currentInstPtr + offset + 1);
+ continue;
+ }
+ break;
+ }
+ Tcl_DeleteHashTable(&jumps);
+ TclStoreInt4AtPtr(offset, currentInstPtr + 1);
+ continue;
+ }
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOptimizeBytecode --
+ *
+ * A very simple peephole optimizer for bytecode.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOptimizeBytecode(
+ void *envPtr)
+{
+ ConvertZeroEffectToNOP(envPtr);
+ AdvanceJumps(envPtr);
+ TrimUnreachable(envPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b69706c..2a453b9 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -11,25 +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.7 2005/09/13 21:23:51 dgp Exp $
*/
#include "tclInt.h"
+#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;
-
-/*
- * The platformPanicProc variable contains a pointer to a platform specific
- * panic procedure, if any. (TclpPanic may be NULL via a macro.)
- */
-
-static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
+#endif
/*
*----------------------------------------------------------------------
@@ -48,9 +46,17 @@ static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
*/
void
-Tcl_SetPanicProc(proc)
- Tcl_PanicProc *proc;
+Tcl_SetPanicProc(
+ Tcl_PanicProc *proc)
{
+#if defined(_WIN32)
+ /* tclWinDebugPanic only installs if there is no panicProc yet. */
+ if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#elif defined(__CYGWIN__)
+ if (proc == NULL)
+ panicProc = tclWinDebugPanic;
+ else
+#endif
panicProc = proc;
}
@@ -71,14 +77,14 @@ Tcl_SetPanicProc(proc)
*/
void
-Tcl_PanicVA(format, argList)
- CONST char *format; /* Format string, suitable for passing to
+Tcl_PanicVA(
+ const char *format, /* Format string, suitable for passing to
* fprintf. */
- va_list argList; /* Variable argument list. */
+ va_list argList) /* Variable argument list. */
{
- char *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in
- * number) to pass to fprintf. */
- char *arg5, *arg6, *arg7, *arg8;
+ char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
+ * to pass to fprintf. */
+ char *arg4, *arg5, *arg6, *arg7, *arg8;
arg1 = va_arg(argList, char *);
arg2 = va_arg(argList, char *);
@@ -90,17 +96,32 @@ Tcl_PanicVA(format, argList)
arg8 = va_arg(argList, char *);
if (panicProc != NULL) {
- (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
- arg5, arg6, arg7, arg8);
- } else if (platformPanicProc != NULL) {
- (void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
- arg5, arg6, arg7, arg8);
+ 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 {
- (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
- arg7, arg8);
- (void) fprintf(stderr, "\n");
- (void) fflush(stderr);
+ 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
}
}
@@ -122,7 +143,9 @@ Tcl_PanicVA(format, argList)
/* ARGSUSED */
void
-Tcl_Panic(CONST char *format, ...)
+Tcl_Panic(
+ const char *format,
+ ...)
{
va_list argList;
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 53b2021..ee0d4c4 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -11,11 +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: tclParse.c,v 1.43 2005/07/21 14:38:50 dkf Exp $
*/
-
+
#include "tclInt.h"
+#include "tclParse.h"
+#include <assert.h>
/*
* The following table provides parsing information about each possible 8-bit
@@ -43,18 +43,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:
*/
@@ -171,44 +160,45 @@ static CONST char charTypeTable[] = {
* Prototypes for local functions defined in this file:
*/
-static int CommandComplete _ANSI_ARGS_((CONST char *script,
- int numBytes));
-static int ParseComment _ANSI_ARGS_((CONST char *src,
- int numBytes, Tcl_Parse *parsePtr));
-static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
- int mask, int flags, Tcl_Parse *parsePtr));
+static inline int CommandComplete(const char *script, int numBytes);
+static int ParseComment(const char *src, int numBytes,
+ Tcl_Parse *parsePtr);
+static int ParseTokens(const char *src, int numBytes, int mask,
+ int flags, Tcl_Parse *parsePtr);
+static int ParseWhiteSpace(const char *src, int numBytes,
+ int *incompletePtr, char *typePtr);
/*
*----------------------------------------------------------------------
*
* TclParseInit --
*
- * Initialize the fields of a Tcl_Parse struct.
+ * Initialize the fields of a Tcl_Parse struct.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The Tcl_Parse struct pointed to by parsePtr gets initialized.
+ * The Tcl_Parse struct pointed to by parsePtr gets initialized.
*
*----------------------------------------------------------------------
*/
void
-TclParseInit(interp, string, numBytes, parsePtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting */
- CONST char *string; /* String to be parsed. */
- int numBytes; /* Total number of bytes in string. If < 0,
+TclParseInit(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting */
+ const char *start, /* Start of string to be parsed. */
+ int numBytes, /* Total number of bytes in string. If < 0,
* the script consists of all bytes up to the
* first null character. */
- Tcl_Parse *parsePtr; /* Points to struct to initialize */
+ Tcl_Parse *parsePtr) /* Points to struct to initialize */
{
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
- parsePtr->string = string;
- parsePtr->end = string + numBytes;
+ parsePtr->string = start;
+ parsePtr->end = start + numBytes;
parsePtr->term = parsePtr->end;
parsePtr->interp = interp;
parsePtr->incomplete = 0;
@@ -239,37 +229,38 @@ TclParseInit(interp, string, numBytes, parsePtr)
*/
int
-Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting; if
+Tcl_ParseCommand(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
- CONST char *start; /* First character of string containing one or
+ const char *start, /* First character of string containing one or
* more Tcl commands. */
- register int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes, /* Total number of bytes in string. If < 0,
* the script consists of all bytes up to the
* first null character. */
- int nested; /* Non-zero means this is a nested command:
+ int nested, /* Non-zero means this is a nested command:
* close bracket should be considered a
* command terminator. If zero, then close
* bracket has no special meaning. */
- register Tcl_Parse *parsePtr;
- /* Structure to fill in with information about
+ register Tcl_Parse *parsePtr)
+ /* Structure to fill in with information about
* the parsed command; any previous
* information in the structure is ignored. */
{
- register CONST char *src; /* Points to current character in the
+ register const char *src; /* Points to current character in the
* command. */
char type; /* Result returned by CHAR_TYPE(*src). */
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
int wordIndex; /* Index of word token for current word. */
int terminators; /* CHAR_TYPE bits that indicate the end of a
* command. */
- CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
+ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
int scanned;
- if ((start == NULL) && (numBytes>0)) {
+ 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;
}
@@ -314,9 +305,7 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
* Create the token for the word.
*/
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 1);
wordIndex = parsePtr->numTokens;
tokenPtr = &parsePtr->tokenPtr[wordIndex];
tokenPtr->type = TCL_TOKEN_WORD;
@@ -326,7 +315,7 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
* sequence: it should be treated just like white space.
*/
- scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
src += scanned;
numBytes -= scanned;
if (numBytes == 0) {
@@ -350,44 +339,41 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
parseWord:
if (*src == '"') {
- if (Tcl_ParseQuotedString(interp, src, numBytes,
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1,
+ &termPtr) != TCL_OK) {
goto error;
}
src = termPtr;
numBytes = parsePtr->end - src;
} else if (*src == '{') {
- static char expPfx[] = "expand";
- CONST size_t expPfxLen = sizeof(expPfx) - 1;
int expIdx = wordIndex + 1;
Tcl_Token *expPtr;
- if (Tcl_ParseBraces(interp, src, numBytes,
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
+ &termPtr) != TCL_OK) {
goto error;
}
src = termPtr;
numBytes = parsePtr->end - src;
/*
- * Check whether the braces contained the word expansion prefix.
+ * Check whether the braces contained the word expansion prefix
+ * {*}
*/
expPtr = &parsePtr->tokenPtr[expIdx];
- if ((expPfxLen == (size_t) expPtr->size)
- /* Same length as prefix */
- && (0 == expandWord)
- /* Haven't seen prefix already */
+ if ((0 == expandWord)
+ /* Haven't seen prefix already */
&& (1 == parsePtr->numTokens - expIdx)
- /* Only one token */
- && (0 == strncmp(expPfx,expPtr->start,expPfxLen))
- /* Is the prefix */
- && (numBytes > 0)
- && (TclParseWhiteSpace(termPtr, numBytes, parsePtr, &type)
- == 0)
+ /* Only one token */
+ && (((1 == (size_t) expPtr->size)
+ /* Same length as prefix */
+ && (expPtr->start[0] == '*')))
+ /* Is the prefix */
+ && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
+ numBytes, &parsePtr->incomplete, &type))
&& (type != TYPE_COMMAND_END)
- /* Non-whitespace follows */
- ) {
+ /* Non-whitespace follows */) {
expandWord = 1;
parsePtr->numTokens--;
goto parseWord;
@@ -414,13 +400,151 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
tokenPtr = &parsePtr->tokenPtr[wordIndex];
tokenPtr->size = src - tokenPtr->start;
tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
- if ((tokenPtr->numComponents == 1)
+ if (expandWord) {
+ int i, isLiteral = 1;
+
+ /*
+ * When a command includes a word that is an expanded literal; for
+ * example, {*}{1 2 3}, the parser performs that expansion
+ * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
+ * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
+ * caller might have to expand. This notably makes it simpler for
+ * those callers that wish to track line endings, such as those
+ * that implement key parts of TIP 280.
+ *
+ * First check whether the thing to be expanded is a literal,
+ * in the sense of being composed entirely of TCL_TOKEN_TEXT
+ * tokens.
+ */
+
+ for (i = 1; i <= tokenPtr->numComponents; i++) {
+ if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
+ isLiteral = 0;
+ break;
+ }
+ }
+
+ if (isLiteral) {
+ int elemCount = 0, code = TCL_OK, literal = 1;
+ const char *nextElem, *listEnd, *elemStart;
+
+ /*
+ * The word to be expanded is a literal, so determine the
+ * boundaries of the literal string to be treated as a list
+ * and expanded. That literal string starts at
+ * tokenPtr[1].start, and includes all bytes up to, but not
+ * including (tokenPtr[tokenPtr->numComponents].start +
+ * tokenPtr[tokenPtr->numComponents].size)
+ */
+
+ listEnd = (tokenPtr[tokenPtr->numComponents].start +
+ tokenPtr[tokenPtr->numComponents].size);
+ nextElem = tokenPtr[1].start;
+
+ /*
+ * Step through the literal string, parsing and counting list
+ * elements.
+ */
+
+ while (nextElem < listEnd) {
+ int size;
+
+ code = TclFindElement(NULL, nextElem, listEnd - nextElem,
+ &elemStart, &nextElem, &size, &literal);
+ if ((code != TCL_OK) || !literal) {
+ break;
+ }
+ if (elemStart < listEnd) {
+ elemCount++;
+ }
+ }
+
+ if ((code != TCL_OK) || !literal) {
+ /*
+ * 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
+ * substitution.
+ */
+
+ tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
+ } else if (elemCount == 0) {
+ /*
+ * We are expanding a literal empty list. This means that
+ * the expanding word completely disappears, leaving no
+ * word generated this pass through the loop. Adjust
+ * accounting appropriately.
+ */
+
+ parsePtr->numWords--;
+ parsePtr->numTokens = wordIndex;
+ } else {
+ /*
+ * Recalculate the number of Tcl_Tokens needed to store
+ * tokens representing the expanded list.
+ */
+
+ const char *listStart;
+ int growthNeeded = wordIndex + 2*elemCount
+ - parsePtr->numTokens;
+
+ parsePtr->numWords += elemCount - 1;
+ if (growthNeeded > 0) {
+ TclGrowParseTokenArray(parsePtr, growthNeeded);
+ tokenPtr = &parsePtr->tokenPtr[wordIndex];
+ }
+ parsePtr->numTokens = wordIndex + 2*elemCount;
+
+ /*
+ * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for
+ * each element of the literal list we are expanding in
+ * place. Take care with the start and size fields of each
+ * token so they point to the right literal characters in
+ * the original script to represent the right expanded
+ * word value.
+ */
+
+ listStart = nextElem = tokenPtr[1].start;
+ while (nextElem < listEnd) {
+ int quoted;
+
+ tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
+ tokenPtr->numComponents = 1;
+
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->numComponents = 0;
+ TclFindElement(NULL, nextElem, listEnd - nextElem,
+ &(tokenPtr->start), &nextElem,
+ &(tokenPtr->size), NULL);
+
+ 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++;
+ }
+ }
+ } else {
+ /*
+ * The word to be expanded is not a literal, so defer
+ * expansion to compile/eval time by marking with a
+ * TCL_TOKEN_EXPAND_WORD token.
+ */
+
+ tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
+ }
+ } else if ((tokenPtr->numComponents == 1)
&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
}
- if (expandWord) {
- tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
- }
/*
* Do two additional checks: (a) make sure we're really at the end of
@@ -428,7 +552,7 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
* word), and (b) check for the end of the command.
*/
- scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
if (scanned) {
src += scanned;
numBytes -= scanned;
@@ -446,14 +570,14 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
}
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;
}
@@ -473,10 +597,34 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
/*
*----------------------------------------------------------------------
*
- * TclParseWhiteSpace --
+ * TclIsSpaceProc --
*
- * Scans up to numBytes bytes starting at src, consuming white space as
- * defined by Tcl's parsing rules.
+ * 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
+ * between words as defined by Tcl's parsing rules.
*
* Results:
* Returns the number of bytes recognized as white space. Records at
@@ -490,18 +638,17 @@ Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr)
*----------------------------------------------------------------------
*/
-int
-TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
- CONST char *src; /* First character to parse. */
- register int numBytes; /* Max number of bytes to scan. */
- Tcl_Parse *parsePtr; /* Information about parse in progress.
- * Updated if parsing indicates an incomplete
- * command. */
- char *typePtr; /* Points to location to store character type
+static int
+ParseWhiteSpace(
+ const char *src, /* First character to parse. */
+ register int numBytes, /* Max number of bytes to scan. */
+ int *incompletePtr, /* Set this boolean memory to true if parsing
+ * indicates an incomplete command. */
+ char *typePtr) /* Points to location to store character type
* of character that ends run of whitespace */
{
register char type = TYPE_NORMAL;
- register CONST char *p = src;
+ register const char *p = src;
while (1) {
while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
@@ -518,9 +665,9 @@ TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
if (p[1] != '\n') {
break;
}
- p+=2;
+ p += 2;
if (--numBytes == 0) {
- parsePtr->incomplete = 1;
+ *incompletePtr = 1;
break;
}
continue;
@@ -534,6 +681,38 @@ TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
/*
*----------------------------------------------------------------------
*
+ * TclParseAllWhiteSpace --
+ *
+ * Scans up to numBytes bytes starting at src, consuming all white space
+ * including the command-terminating newline characters.
+ *
+ * Results:
+ * Returns the number of bytes recognized as white space.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclParseAllWhiteSpace(
+ const char *src, /* First character to parse. */
+ int numBytes) /* Max number of byes to scan */
+{
+ int dummy;
+ char type;
+ const char *p = src;
+
+ do {
+ int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);
+
+ p += scanned;
+ numBytes -= scanned;
+ } while (numBytes && (*p == '\n') && (p++, --numBytes));
+ return (p-src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclParseHex --
*
* Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing
@@ -554,24 +733,24 @@ TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
*/
int
-TclParseHex(src, numBytes, resultPtr)
- 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
+TclParseHex(
+ const char *src, /* First character to parse. */
+ int numBytes, /* Max number of byes to scan */
+ int *resultPtr) /* Points to storage provided by caller where
+ * the character resulting from the
* conversion is to be written. */
{
- Tcl_UniChar result = 0;
- register CONST char *p = src;
+ int result = 0;
+ register const char *p = src;
while (numBytes--) {
unsigned char digit = UCHAR(*p);
- if (!isxdigit(digit)) {
+ if (!isxdigit(digit) || (result > 0x10fff)) {
break;
}
- ++p;
+ p++;
result <<= 4;
if (digit >= 'a') {
@@ -596,32 +775,33 @@ TclParseHex(src, numBytes, resultPtr)
* sequence as defined by Tcl's parsing rules.
*
* Results:
- * Records at readPtr the number of bytes making up the backslash
- * sequence. Records at dst the UTF-8 encoded equivalent of that
- * backslash sequence. Returns the number of bytes written to dst, at
- * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
- * are not needed, but the return value is the same either way.
+ * Records at readPtr the number of bytes making up the backslash
+ * sequence. Records at dst the UTF-8 encoded equivalent of that
+ * backslash sequence. Returns the number of bytes written to dst, at
+ * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
+ * are not needed, but the return value is the same either way.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-TclParseBackslash(src, numBytes, readPtr, dst)
- CONST char *src; /* Points to the backslash character of a a
+TclParseBackslash(
+ const char *src, /* Points to the backslash character of a a
* backslash sequence. */
- int numBytes; /* Max number of bytes to scan. */
- int *readPtr; /* NULL, or points to storage where the number
+ int numBytes, /* Max number of bytes to scan. */
+ int *readPtr, /* NULL, or points to storage where the number
* of bytes scanned should be written. */
- char *dst; /* NULL, or points to buffer where the UTF-8
+ char *dst) /* NULL, or points to buffer where the UTF-8
* encoding of the backslash sequence is to be
* written. At most TCL_UTF_MAX bytes will be
* written there. */
{
- register CONST char *p = src+1;
- Tcl_UniChar result;
+ register const char *p = src+1;
+ Tcl_UniChar unichar;
+ int result;
int count;
char buf[TCL_UTF_MAX];
@@ -678,7 +858,7 @@ TclParseBackslash(src, numBytes, readPtr, dst)
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".
@@ -693,7 +873,7 @@ TclParseBackslash(src, numBytes, readPtr, dst)
}
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".
@@ -701,6 +881,15 @@ TclParseBackslash(src, numBytes, readPtr, dst)
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 {
@@ -719,21 +908,21 @@ TclParseBackslash(src, numBytes, readPtr, dst)
*/
if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
- result = (unsigned char)(*p - '0');
+ result = *p - '0';
p++;
if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
|| (UCHAR(*p) >= '8')) {
break;
}
count = 3;
- result = (unsigned char)((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;
- result = (unsigned char)((result << 3) + (*p - '0'));
+ result = UCHAR((result << 3) + (*p - '0'));
break;
}
@@ -745,14 +934,15 @@ TclParseBackslash(src, numBytes, readPtr, dst)
*/
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;
}
@@ -760,7 +950,7 @@ TclParseBackslash(src, numBytes, readPtr, dst)
if (readPtr != NULL) {
*readPtr = count;
}
- return Tcl_UniCharToUtf((int) result, dst);
+ return Tcl_UniCharToUtf(result, dst);
}
/*
@@ -772,30 +962,32 @@ TclParseBackslash(src, numBytes, readPtr, dst)
* defined by Tcl's parsing rules.
*
* Results:
- * Records in parsePtr information about the parse. Returns the number of
- * bytes consumed.
+ * Records in parsePtr information about the parse. Returns the number of
+ * bytes consumed.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-ParseComment(src, numBytes, parsePtr)
- CONST char *src; /* First character to parse. */
- register int numBytes; /* Max number of bytes to scan. */
- Tcl_Parse *parsePtr; /* Information about parse in progress.
+ParseComment(
+ const char *src, /* First character to parse. */
+ register int numBytes, /* Max number of bytes to scan. */
+ Tcl_Parse *parsePtr) /* Information about parse in progress.
* Updated if parsing indicates an incomplete
* command. */
{
- register CONST char *p = src;
+ register const char *p = src;
+
while (numBytes) {
char type;
int scanned;
do {
- scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(p, numBytes,
+ &parsePtr->incomplete, &type);
p += scanned;
numBytes -= scanned;
} while (numBytes && (*p == '\n') && (p++,numBytes--));
@@ -809,7 +1001,8 @@ ParseComment(src, numBytes, parsePtr)
while (numBytes) {
if (*p == '\\') {
- scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
+ &type);
if (scanned) {
p += scanned;
numBytes -= scanned;
@@ -864,28 +1057,27 @@ ParseComment(src, numBytes, parsePtr)
*/
static int
-ParseTokens(src, numBytes, mask, flags, parsePtr)
- register CONST char *src; /* First character to parse. */
- register int numBytes; /* Max number of bytes to scan. */
- int flags; /* OR-ed bits indicating what substitutions to
- perform: TCL_SUBST_COMMANDS,
- TCL_SUBST_VARIABLES, and
- TCL_SUBST_BACKSLASHES */
- int mask; /* Specifies when to stop parsing. The parse
+ParseTokens(
+ register const char *src, /* First character to parse. */
+ register int numBytes, /* Max number of bytes to scan. */
+ int mask, /* Specifies when to stop parsing. The parse
* stops at the first unquoted character whose
* CHAR_TYPE contains any of the bits in
* mask. */
- Tcl_Parse *parsePtr; /* Information about parse in progress.
+ int flags, /* OR-ed bits indicating what substitutions to
+ * perform: TCL_SUBST_COMMANDS,
+ * TCL_SUBST_VARIABLES, and
+ * TCL_SUBST_BACKSLASHES */
+ Tcl_Parse *parsePtr) /* Information about parse in progress.
* Updated with additional tokens and
* termination information. */
{
char type;
- int originalTokens, varToken;
+ int originalTokens;
int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
Tcl_Token *tokenPtr;
- Tcl_Parse nested;
/*
* Each iteration through the following loop adds one token of type
@@ -896,9 +1088,7 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
originalTokens = parsePtr->numTokens;
while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 1);
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
tokenPtr->start = src;
tokenPtr->numComponents = 0;
@@ -917,6 +1107,8 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
tokenPtr->size = src - tokenPtr->start;
parsePtr->numTokens++;
} else if (*src == '$') {
+ int varToken;
+
if (noSubstVars) {
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
@@ -932,13 +1124,15 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
*/
varToken = parsePtr->numTokens;
- if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
- parsePtr, 1) != TCL_OK) {
+ if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr,
+ 1) != TCL_OK) {
return TCL_ERROR;
}
src += parsePtr->tokenPtr[varToken].size;
numBytes -= parsePtr->tokenPtr[varToken].size;
} else if (*src == '[') {
+ Tcl_Parse *nestedPtr;
+
if (noSubstCmds) {
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
@@ -956,25 +1150,19 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
src++;
numBytes--;
+ nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
while (1) {
- if (Tcl_ParseCommand(parsePtr->interp, src,
- numBytes, 1, &nested) != TCL_OK) {
- parsePtr->errorType = nested.errorType;
- parsePtr->term = nested.term;
- parsePtr->incomplete = nested.incomplete;
+ if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
+ nestedPtr) != TCL_OK) {
+ parsePtr->errorType = nestedPtr->errorType;
+ parsePtr->term = nestedPtr->term;
+ parsePtr->incomplete = nestedPtr->incomplete;
+ TclStackFree(parsePtr->interp, nestedPtr);
return TCL_ERROR;
}
- src = nested.commandStart + nested.commandSize;
+ src = nestedPtr->commandStart + nestedPtr->commandSize;
numBytes = parsePtr->end - src;
-
- /*
- * This is equivalent to Tcl_FreeParse(&nested), but
- * presumably inlined here for sake of runtime optimization
- */
-
- if (nested.tokenPtr != nested.staticTokens) {
- ckfree((char *) nested.tokenPtr);
- }
+ Tcl_FreeParse(nestedPtr);
/*
* Check for the closing ']' that ends the command
@@ -982,21 +1170,24 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
* parsed command.
*/
- if ((nested.term < parsePtr->end) && (*nested.term == ']')
- && !nested.incomplete) {
+ if ((nestedPtr->term < parsePtr->end)
+ && (*(nestedPtr->term) == ']')
+ && !(nestedPtr->incomplete)) {
break;
}
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;
parsePtr->incomplete = 1;
+ TclStackFree(parsePtr->interp, nestedPtr);
return TCL_ERROR;
}
}
+ TclStackFree(parsePtr->interp, nestedPtr);
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->size = src - tokenPtr->start;
parsePtr->numTokens++;
@@ -1063,13 +1254,11 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
}
if (parsePtr->numTokens == originalTokens) {
/*
- * There was nothing in this range of text. Add an empty token for
- * the empty range, so that there is always at least one token added.
+ * There was nothing in this range of text. Add an empty token for the
+ * empty range, so that there is always at least one token added.
*/
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 1);
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
tokenPtr->start = src;
tokenPtr->numComponents = 0;
@@ -1102,12 +1291,12 @@ ParseTokens(src, numBytes, mask, flags, parsePtr)
*/
void
-Tcl_FreeParse(parsePtr)
- Tcl_Parse *parsePtr; /* Structure that was filled in by a previous
+Tcl_FreeParse(
+ Tcl_Parse *parsePtr) /* Structure that was filled in by a previous
* call to Tcl_ParseCommand. */
{
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree((char *) parsePtr->tokenPtr);
+ ckfree(parsePtr->tokenPtr);
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
@@ -1115,48 +1304,10 @@ Tcl_FreeParse(parsePtr)
/*
*----------------------------------------------------------------------
*
- * TclExpandTokenArray --
- *
- * This function is invoked when the current space for tokens in a
- * Tcl_Parse structure fills up; it allocates memory to grow the token
- * array
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory is allocated for a new larger token array; the memory for the
- * old array is freed, if it had been dynamically allocated.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclExpandTokenArray(parsePtr)
- Tcl_Parse *parsePtr; /* Parse structure whose token space has
- * overflowed. */
-{
- int newCount;
- Tcl_Token *newPtr;
-
- newCount = parsePtr->tokensAvailable*2;
- newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
- memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
- (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
- if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree((char *) parsePtr->tokenPtr);
- }
- parsePtr->tokenPtr = newPtr;
- parsePtr->tokensAvailable = newCount;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_ParseVarName --
*
* Given a string starting with a $ sign, parse off a variable name and
- * return information about the parse. No more than numBytes bytes will
+ * return information about the parse. No more than numBytes bytes will
* be scanned.
*
* Results:
@@ -1178,23 +1329,23 @@ TclExpandTokenArray(parsePtr)
*/
int
-Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
- Tcl_Interp *interp; /* Interpreter to use for error reporting; if
+Tcl_ParseVarName(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
- CONST char *start; /* Start of variable substitution string.
+ const char *start, /* Start of variable substitution string.
* First character must be "$". */
- register int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
- Tcl_Parse *parsePtr; /* Structure to fill in with information about
+ Tcl_Parse *parsePtr, /* Structure to fill in with information about
* the variable name. */
- int append; /* Non-zero means append tokens to existing
+ int append) /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
{
Tcl_Token *tokenPtr;
- register CONST char *src;
+ register const char *src;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
@@ -1217,9 +1368,7 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
*/
src = start;
- if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 2);
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
tokenPtr->type = TCL_TOKEN_VARIABLE;
tokenPtr->start = src;
@@ -1240,12 +1389,12 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
* 1. The $ sign is followed by an open curly brace. Then the variable
* name is everything up to the next close curly brace, and the
* variable is a scalar variable.
- * 2. The $ sign is not followed by an open curly brace. Then the
- * variable name is everything up to the next character that isn't a
- * letter, digit, or underscore. :: sequences are also considered part
- * of the variable name, in order to support namespaces. If the
- * following character is an open parenthesis, then the information
- * between parentheses is the array element name.
+ * 2. The $ sign is not followed by an open curly brace. Then the variable
+ * name is everything up to the next character that isn't a letter,
+ * digit, or underscore. :: sequences are also considered part of the
+ * variable name, in order to support namespaces. If the following
+ * character is an open parenthesis, then the information between
+ * parentheses is the array element name.
* 3. The $ sign is followed by something that isn't a letter, digit, or
* underscore: in this case, there is no variable name and the token is
* just "$".
@@ -1263,9 +1412,9 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
src++;
}
if (numBytes == 0) {
- if (interp != NULL) {
- Tcl_SetResult(interp, "missing close-brace for variable name",
- TCL_STATIC);
+ if (parsePtr->interp != NULL) {
+ 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;
@@ -1292,7 +1441,7 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
offset = Tcl_UtfToUniChar(utfBytes, &ch);
}
c = UCHAR(ch);
- if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
+ if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
src += offset;
numBytes -= offset;
continue;
@@ -1330,10 +1479,10 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
TCL_SUBST_ALL, parsePtr)) {
goto error;
}
- if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')) {
+ 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;
@@ -1349,7 +1498,7 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
return TCL_OK;
/*
- * The dollar sign isn't followed by a variable name. Replace the
+ * The dollar sign isn't followed by a variable name. Replace the
* TCL_TOKEN_VARIABLE token with a TCL_TOKEN_TEXT token for the dollar
* sign.
*/
@@ -1376,9 +1525,9 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
*
* Results:
* The return value is the contents of the variable given by the leading
- * characters of string. If termPtr isn't NULL, *termPtr gets filled in
+ * characters of string. If termPtr isn't NULL, *termPtr gets filled in
* with the address of the character just after the last one in the
- * variable specifier. If the variable doesn't exist, then the return
+ * variable specifier. If the variable doesn't exist, then the return
* value is NULL and an error message will be left in interp's result.
*
* Side effects:
@@ -1387,35 +1536,40 @@ Tcl_ParseVarName(interp, start, numBytes, parsePtr, append)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_ParseVar(interp, start, termPtr)
- Tcl_Interp *interp; /* Context for looking up variable. */
- register CONST char *start; /* Start of variable substitution.
- * First character must be "$". */
- CONST char **termPtr; /* If non-NULL, points to word to fill
- * in with character just after last
- * one in the variable specifier. */
+const char *
+Tcl_ParseVar(
+ Tcl_Interp *interp, /* Context for looking up variable. */
+ register const char *start, /* Start of variable substitution. First
+ * character must be "$". */
+ const char **termPtr) /* If non-NULL, points to word to fill in with
+ * character just after last one in the
+ * variable specifier. */
{
- Tcl_Parse parse;
register Tcl_Obj *objPtr;
int code;
+ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
- if (Tcl_ParseVarName(interp, start, -1, &parse, 0) != TCL_OK) {
+ if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
+ TclStackFree(interp, parsePtr);
return NULL;
}
if (termPtr != NULL) {
- *termPtr = start + parse.tokenPtr->size;
+ *termPtr = start + parsePtr->tokenPtr->size;
}
- if (parse.numTokens == 1) {
+ if (parsePtr->numTokens == 1) {
/*
* There isn't a variable name after all: the $ is just a $.
*/
+ TclStackFree(interp, parsePtr);
return "$";
}
- code = TclSubstTokens(interp, parse.tokenPtr, parse.numTokens, NULL);
+ code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
+ NULL, 1, NULL, NULL);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
}
@@ -1425,16 +1579,13 @@ Tcl_ParseVar(interp, start, termPtr)
* At this point we should have an object containing the value of a
* variable. Just return the string from that object.
*
- * This should have returned the object for the user to manage, but
- * instead we have some weak reference to the string value in the object,
- * which is why we make sure the object exists after resetting the result.
- * This isn't ideal, but it's the best we can do with the current
- * documented interface. -- hobbs
+ * Since TclSubstTokens above returned TCL_OK, we know that objPtr
+ * is shared. It is in both the interp result and the value of the
+ * variable. Returning the string relies on that to be true.
*/
- if (!Tcl_IsShared(objPtr)) {
- Tcl_IncrRefCount(objPtr);
- }
+ assert( Tcl_IsShared(objPtr) );
+
Tcl_ResetResult(interp);
return TclGetString(objPtr);
}
@@ -1468,29 +1619,28 @@ Tcl_ParseVar(interp, start, termPtr)
*/
int
-Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting; if
+Tcl_ParseBraces(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
- CONST char *start; /* Start of string enclosed in braces. The
+ const char *start, /* Start of string enclosed in braces. The
* first character must be {'. */
- register int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
- register Tcl_Parse *parsePtr;
- /* Structure to fill in with information about
+ register Tcl_Parse *parsePtr,
+ /* Structure to fill in with information about
* the string. */
- int append; /* Non-zero means append tokens to existing
+ int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
- CONST char **termPtr; /* If non-NULL, points to word in which to
+ const char **termPtr) /* If non-NULL, points to word in which to
* store a pointer to the character just after
* the terminating '}' if the parse was
* successful. */
-
{
Tcl_Token *tokenPtr;
- register CONST char *src;
+ register const char *src;
int startIndex, level, length;
if ((numBytes == 0) || (start == NULL)) {
@@ -1507,9 +1657,7 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
src = start;
startIndex = parsePtr->numTokens;
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 1);
tokenPtr = &parsePtr->tokenPtr[startIndex];
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src+1;
@@ -1572,9 +1720,7 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
if (tokenPtr->size != 0) {
parsePtr->numTokens++;
}
- if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
+ TclGrowParseTokenArray(parsePtr, 2);
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
tokenPtr->type = TCL_TOKEN_BS;
tokenPtr->start = src;
@@ -1600,7 +1746,7 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
parsePtr->term = start;
parsePtr->incomplete = 1;
- if (interp == NULL) {
+ if (parsePtr->interp == NULL) {
/*
* Skip straight to the exit code since we have no interpreter to put
* error message in.
@@ -1609,7 +1755,8 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
goto error;
}
- Tcl_SetResult(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
@@ -1621,7 +1768,7 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
{
register int openBrace = 0;
- for (; src > start; src--) {
+ while (--src > start) {
switch (*src) {
case '{':
openBrace = 1;
@@ -1630,10 +1777,9 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
openBrace = 0;
break;
case '#' :
- if (openBrace && (isspace(UCHAR(src[-1])))) {
- Tcl_AppendResult(interp,
- ": possible unbalanced brace in comment",
- (char *) NULL);
+ if (openBrace && TclIsSpaceProc(src[-1])) {
+ Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
+ ": possible unbalanced brace in comment", -1);
goto error;
}
break;
@@ -1675,22 +1821,22 @@ Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr)
*/
int
-Tcl_ParseQuotedString(interp, start, numBytes, parsePtr, append, termPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting; if
+Tcl_ParseQuotedString(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
- CONST char *start; /* Start of the quoted string. The first
+ const char *start, /* Start of the quoted string. The first
* character must be '"'. */
- register int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes, /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
- register Tcl_Parse *parsePtr;
- /* Structure to fill in with information about
+ register Tcl_Parse *parsePtr,
+ /* Structure to fill in with information about
* the string. */
- int append; /* Non-zero means append tokens to existing
+ int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
- CONST char **termPtr; /* If non-NULL, points to word in which to
+ const char **termPtr) /* If non-NULL, points to word in which to
* store a pointer to the character just after
* the quoted string's terminating close-quote
* if the parse succeeds. */
@@ -1706,13 +1852,14 @@ Tcl_ParseQuotedString(interp, start, numBytes, parsePtr, append, termPtr)
TclParseInit(interp, start, numBytes, parsePtr);
}
- if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE,
- TCL_SUBST_ALL, parsePtr)) {
+ if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
+ parsePtr)) {
goto error;
}
if (*parsePtr->term != '"') {
- if (interp != NULL) {
- Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
+ if (parsePtr->interp != NULL) {
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing \"", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
parsePtr->term = start;
@@ -1732,35 +1879,44 @@ Tcl_ParseQuotedString(interp, start, numBytes, parsePtr, append, termPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_SubstObj --
- *
- * This function performs the substitutions specified on the given string
- * as described in the user documentation for the "subst" Tcl command.
+ * TclSubstParse --
*
+ * Token parser used by the [subst] command. Parses the string made up of
+ * 'numBytes' bytes starting at 'bytes'. Parsing is controlled by the
+ * flags argument to provide support for the -nobackslashes, -nocommands,
+ * and -novariables options, as represented by the flag values
+ * TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
+ *
* Results:
- * A Tcl_Obj* containing the substituted string, or NULL to indicate that
- * an error occurred.
+ * None.
*
* Side effects:
- * See the user documentation.
+ * 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
+ * Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the
+ * value written there.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj *
-Tcl_SubstObj(interp, objPtr, flags)
- Tcl_Interp *interp; /* Interpreter in which substitution occurs */
- Tcl_Obj *objPtr; /* The value to be substituted. */
- int flags; /* What substitutions to do. */
+void
+TclSubstParse(
+ Tcl_Interp *interp,
+ const char *bytes,
+ int numBytes,
+ int flags,
+ Tcl_Parse *parsePtr,
+ Tcl_InterpState *statePtr)
{
- int length, tokensLeft, code;
- Tcl_Parse parse;
- Tcl_Token *endTokenPtr;
- Tcl_Obj *result;
- Tcl_Obj *errMsg = NULL;
- CONST char *p = Tcl_GetStringFromObj(objPtr, &length);
+ int length = numBytes;
+ const char *p = bytes;
- TclParseInit(interp, p, length, &parse);
+ TclParseInit(interp, p, length, parsePtr);
/*
* First parse the string rep of objPtr, as if it were enclosed as a
@@ -1768,14 +1924,13 @@ Tcl_SubstObj(interp, objPtr, flags)
* inhibit types of substitution.
*/
- if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, &parse)) {
+ if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
/*
- * There was a parse error. Save the error message for possible
- * reporting later.
+ * There was a parse error. Save the interpreter state for possible
+ * error reporting later.
*/
- errMsg = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(errMsg);
+ *statePtr = Tcl_SaveInterpState(interp, TCL_ERROR);
/*
* We need to re-parse to get the portion of the string we can [subst]
@@ -1790,18 +1945,19 @@ Tcl_SubstObj(interp, objPtr, flags)
*/
do {
- parse.numTokens = 0;
- parse.tokensAvailable = NUM_STATIC_TOKENS;
- parse.end = parse.term;
- parse.incomplete = 0;
- parse.errorType = TCL_PARSE_SUCCESS;
- } while (TCL_OK != ParseTokens(p, parse.end - p, 0, flags, &parse));
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->end = parsePtr->term;
+ parsePtr->incomplete = 0;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ } while (TCL_OK !=
+ ParseTokens(p, parsePtr->end - p, 0, flags, parsePtr));
/*
* The good parse will have to be followed by {, (, or [.
*/
- switch (*parse.term) {
+ switch (*(parsePtr->term)) {
case '{':
/*
* Parse error was a missing } in a ${varname} variable
@@ -1818,7 +1974,7 @@ Tcl_SubstObj(interp, objPtr, flags)
* array variable substitution at the toplevel.
*/
- if (*(parse.term - 1) == '$') {
+ if (*(parsePtr->term - 1) == '$') {
/*
* Special case where removing the array index left us with
* just a dollar sign (array variable with name the empty
@@ -1837,15 +1993,15 @@ Tcl_SubstObj(interp, objPtr, flags)
*/
Tcl_Token *varTokenPtr =
- parse.tokenPtr + parse.numTokens - 2;
+ parsePtr->tokenPtr + parsePtr->numTokens - 2;
if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
- Tcl_Panic("Tcl_SubstObj: programming error");
+ Tcl_Panic("TclSubstParse: programming error");
}
if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
- Tcl_Panic("Tcl_SubstObj: programming error");
+ Tcl_Panic("TclSubstParse: programming error");
}
- parse.numTokens -= 2;
+ parsePtr->numTokens -= 2;
}
break;
case '[':
@@ -1854,32 +2010,33 @@ Tcl_SubstObj(interp, objPtr, flags)
* substitution.
*/
- parse.end = p + length;
- p = parse.term + 1;
- length = parse.end - p;
+ parsePtr->end = p + length;
+ p = parsePtr->term + 1;
+ length = parsePtr->end - p;
if (length == 0) {
/*
- * No commands, just an unmatched [. As in previous cases,
+ * No commands, just an unmatched [. As in previous cases,
* existing token stream is OK.
*/
} else {
/*
* We want to add the parsing of as many commands as we can
* within that substitution until we reach the actual parse
- * error. We'll do additional parsing to determine what
- * length to claim for the final TCL_TOKEN_COMMAND token.
+ * error. We'll do additional parsing to determine what length
+ * to claim for the final TCL_TOKEN_COMMAND token.
*/
Tcl_Token *tokenPtr;
- Tcl_Parse nested;
- CONST char *lastTerm = parse.term;
+ const char *lastTerm = parsePtr->term;
+ Tcl_Parse *nestedPtr =
+ TclStackAlloc(interp, sizeof(Tcl_Parse));
while (TCL_OK ==
- Tcl_ParseCommand(NULL, p, length, 0, &nested)) {
- Tcl_FreeParse(&nested);
- p = nested.term + (nested.term < nested.end);
- length = nested.end - p;
- if ((length == 0) && (nested.term == nested.end)) {
+ Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
+ Tcl_FreeParse(nestedPtr);
+ p = nestedPtr->term + (nestedPtr->term < nestedPtr->end);
+ length = nestedPtr->end - p;
+ if ((length == 0) && (nestedPtr->term == nestedPtr->end)) {
/*
* If we run out of string, blame the missing close
* bracket on the last command, and do not evaluate it
@@ -1888,13 +2045,14 @@ Tcl_SubstObj(interp, objPtr, flags)
break;
}
- lastTerm = nested.term;
+ lastTerm = nestedPtr->term;
}
+ TclStackFree(interp, nestedPtr);
- if (lastTerm == parse.term) {
+ if (lastTerm == parsePtr->term) {
/*
- * Parse error in first command. No commands to subst,
- * add no more tokens.
+ * Parse error in first command. No commands to subst, add
+ * no more tokens.
*/
break;
}
@@ -1904,73 +2062,19 @@ Tcl_SubstObj(interp, objPtr, flags)
* got parsed.
*/
- if (parse.numTokens == parse.tokensAvailable) {
- TclExpandTokenArray(&parse);
- }
- tokenPtr = &parse.tokenPtr[parse.numTokens];
- tokenPtr->start = parse.term;
+ TclGrowParseTokenArray(parsePtr, 1);
+ tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]);
+ tokenPtr->start = parsePtr->term;
tokenPtr->numComponents = 0;
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->size = lastTerm - tokenPtr->start + 1;
- parse.numTokens++;
+ parsePtr->numTokens++;
}
break;
default:
- Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
- }
- }
-
- /*
- * Next, substitute the parsed tokens just as in normal Tcl evaluation.
- */
-
- endTokenPtr = parse.tokenPtr + parse.numTokens;
- tokensLeft = parse.numTokens;
- code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
- &tokensLeft);
- if (code == TCL_OK) {
- Tcl_FreeParse(&parse);
- if (errMsg != NULL) {
- Tcl_SetObjResult(interp, errMsg);
- Tcl_DecrRefCount(errMsg);
- return NULL;
+ Tcl_Panic("bad parse in TclSubstParse: %c", p[length]);
}
- return Tcl_GetObjResult(interp);
- }
-
- result = Tcl_NewObj();
- while (1) {
- switch (code) {
- case TCL_ERROR:
- Tcl_FreeParse(&parse);
- Tcl_DecrRefCount(result);
- if (errMsg != NULL) {
- Tcl_DecrRefCount(errMsg);
- }
- return NULL;
- case TCL_BREAK:
- tokensLeft = 0; /* Halt substitution */
- default:
- Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
- }
-
- if (tokensLeft == 0) {
- Tcl_FreeParse(&parse);
- if (errMsg != NULL) {
- if (code != TCL_BREAK) {
- Tcl_DecrRefCount(result);
- Tcl_SetObjResult(interp, errMsg);
- Tcl_DecrRefCount(errMsg);
- return NULL;
- }
- Tcl_DecrRefCount(errMsg);
- }
- return result;
- }
-
- code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
- &tokensLeft);
}
}
@@ -1985,32 +2089,55 @@ Tcl_SubstObj(interp, objPtr, flags)
* non-TCL_OK completion code arises.
*
* Results:
- * The return value is a standard Tcl completion code. The result in
- * interp is the substituted value, or an error message if TCL_ERROR is
- * returned. If tokensLeftPtr is not NULL, then it points to an int where
- * the number of tokens remaining to be processed is written.
+ * The return value is a standard Tcl completion code. The result in
+ * interp is the substituted value, or an error message if TCL_ERROR is
+ * returned. If tokensLeftPtr is not NULL, then it points to an int where
+ * the number of tokens remaining to be processed is written.
*
* Side effects:
- * Can be anything, depending on the types of substitution done.
+ * Can be anything, depending on the types of substitution done.
*
*----------------------------------------------------------------------
*/
int
-TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
- Tcl_Interp *interp; /* Interpreter in which to lookup variables,
+TclSubstTokens(
+ Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens to
+ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
+ int count, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
- int *tokensLeftPtr; /* If not NULL, points to memory where an
+ int *tokensLeftPtr, /* If not NULL, points to memory where an
* integer representing the number of tokens
* left to be substituted will be written */
+ 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 by
+ * EvalEx() to properly handle [...]-nested
+ * commands. The 'outerScript' refers to the
+ * most-outer script containing the embedded
+ * command, which is refered to by 'script'.
+ * The 'clNextOuter' refers to the current
+ * entry in the table of continuation lines in
+ * this "master script", and the character
+ * offsets are relative to the 'outerScript'
+ * as well.
+ *
+ * If outerScript == script, then this call is
+ * for words in the outer-most script or
+ * command. See Tcl_EvalEx and TclEvalObjEx
+ * for the places generating arguments for
+ * which this is true. */
{
Tcl_Obj *result;
int code = TCL_OK;
+#define NUM_STATIC_POS 20
+ int isLiteral, maxNumCL, numCL, i, adjust;
+ int *clPosition = NULL;
+ Interp *iPtr = (Interp *) interp;
+ int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
/*
* Each pass through this loop will substitute one token, and its
@@ -2022,10 +2149,35 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
* of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
*/
+ /*
+ * For the handling of continuation lines in literals we first check if
+ * this is actually a literal. For if not we can forego the additional
+ * processing. Otherwise we pre-allocate a small table to store the
+ * locations of all continuation lines we find in this literal, if any.
+ * The table is extended if needed.
+ */
+
+ numCL = 0;
+ maxNumCL = 0;
+ isLiteral = 1;
+ for (i=0 ; i < count; i++) {
+ if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
+ && (tokenPtr[i].type != TCL_TOKEN_BS)) {
+ isLiteral = 0;
+ break;
+ }
+ }
+
+ if (isLiteral) {
+ maxNumCL = NUM_STATIC_POS;
+ clPosition = ckalloc(maxNumCL * sizeof(int));
+ }
+
+ adjust = 0;
result = NULL;
for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
Tcl_Obj *appendObj = NULL;
- CONST char *append = NULL;
+ const char *append = NULL;
int appendByteLength = 0;
char utfCharBytes[TCL_UTF_MAX];
@@ -2036,21 +2188,79 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
break;
case TCL_TOKEN_BS:
- appendByteLength = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
- utfCharBytes);
+ appendByteLength = TclParseBackslash(tokenPtr->start,
+ tokenPtr->size, NULL, utfCharBytes);
append = utfCharBytes;
+
+ /*
+ * If the backslash sequence we found is in a literal, and
+ * represented a continuation line, we compute and store its
+ * location (as char offset to the beginning of the _result_
+ * script). We may have to extend the table of locations.
+ *
+ * Note that the continuation line information is relevant even if
+ * the word we are processing is not a literal, as it can affect
+ * nested commands. See the branch for TCL_TOKEN_COMMAND below,
+ * where the adjustment we are tracking here is taken into
+ * account. The good thing is that we do not need a table of
+ * everything, just the number of lines we have to add as
+ * correction.
+ */
+
+ if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
+ && (tokenPtr->start[1] == '\n')) {
+ if (isLiteral) {
+ int clPos;
+
+ if (result == 0) {
+ clPos = 0;
+ } else {
+ Tcl_GetStringFromObj(result, &clPos);
+ }
+
+ if (numCL >= maxNumCL) {
+ maxNumCL *= 2;
+ clPosition = ckrealloc(clPosition,
+ maxNumCL * sizeof(int));
+ }
+ clPosition[numCL] = clPos;
+ numCL++;
+ }
+ adjust++;
+ }
break;
case TCL_TOKEN_COMMAND: {
- Interp *iPtr = (Interp *) interp;
-
+ /* TIP #280: Transfer line information to nested command */
iPtr->numLevels++;
code = TclInterpReady(interp);
if (code == TCL_OK) {
- code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
- 0);
+ /*
+ * Test cases: info-30.{6,8,9}
+ */
+
+ int theline;
+
+ TclAdvanceContinuations(&line, &clNextOuter,
+ tokenPtr->start - outerScript);
+ theline = line + adjust;
+ code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+ 0, theline, clNextOuter, outerScript);
+
+ TclAdvanceLines(&line, tokenPtr->start+1,
+ tokenPtr->start + tokenPtr->size - 1);
+
+ /*
+ * Restore flag reset by nested eval for future bracketed
+ * commands and their cmdframe setup
+ */
+
+ if (inFile) {
+ iPtr->evalFlags |= TCL_EVAL_FILE;
+ }
}
iPtr->numLevels--;
+ TclResetCancellation(interp, 0);
appendObj = Tcl_GetObjResult(interp);
break;
}
@@ -2065,7 +2275,7 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
*/
code = TclSubstTokens(interp, tokenPtr+2,
- tokenPtr->numComponents - 1, NULL);
+ tokenPtr->numComponents - 1, NULL, line, NULL, NULL);
arrayIndex = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(arrayIndex);
}
@@ -2149,6 +2359,27 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
if (code != TCL_ERROR) { /* Keep error message in result! */
if (result != NULL) {
Tcl_SetObjResult(interp, result);
+
+ /*
+ * If the code found continuation lines (which implies that this
+ * word is a literal), then we store the accumulated table of
+ * locations in the thread-global data structure for the bytecode
+ * compiler to find later, assuming that the literal is a script
+ * which will be compiled.
+ */
+
+ if (numCL) {
+ TclContinuationsEnter(result, numCL, clPosition);
+ }
+
+ /*
+ * Release the temp table we used to collect the locations of
+ * continuation lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree(clPosition);
+ }
} else {
Tcl_ResetResult(interp);
}
@@ -2182,19 +2413,18 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
*----------------------------------------------------------------------
*/
-static int
-CommandComplete(script, numBytes)
- CONST char *script; /* Script to check. */
- int numBytes; /* Number of bytes in script. */
+static inline int
+CommandComplete(
+ const char *script, /* Script to check. */
+ int numBytes) /* Number of bytes in script. */
{
Tcl_Parse parse;
- CONST char *p, *end;
+ const char *p, *end;
int result;
p = script;
end = p + numBytes;
- while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
- == TCL_OK) {
+ while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) {
p = parse.commandStart + parse.commandSize;
if (p >= end) {
break;
@@ -2220,7 +2450,7 @@ CommandComplete(script, numBytes)
* and quotes and brackets.
*
* Results:
- * 1 is returned if the script is complete, 0 otherwise. 1 is also
+ * 1 is returned if the script is complete, 0 otherwise. 1 is also
* returned if there is a parse error in the script other than unmatched
* delimiters.
*
@@ -2231,8 +2461,8 @@ CommandComplete(script, numBytes)
*/
int
-Tcl_CommandComplete(script)
- CONST char *script; /* Script to check. */
+Tcl_CommandComplete(
+ const char *script) /* Script to check. */
{
return CommandComplete(script, (int) strlen(script));
}
@@ -2256,14 +2486,13 @@ Tcl_CommandComplete(script)
*/
int
-TclObjCommandComplete(objPtr)
- Tcl_Obj *objPtr; /* Points to object holding script to
+TclObjCommandComplete(
+ Tcl_Obj *objPtr) /* Points to object holding script to
* check. */
{
- CONST char *script;
int length;
+ const char *script = Tcl_GetStringFromObj(objPtr, &length);
- script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
@@ -2285,16 +2514,16 @@ TclObjCommandComplete(objPtr)
*/
int
-TclIsLocalScalar(src, len)
- CONST char *src;
- int len;
+TclIsLocalScalar(
+ const char *src,
+ int len)
{
- CONST char *p;
- CONST char *lastChar = src + (len - 1);
+ const char *p;
+ const char *lastChar = src + (len - 1);
for (p=src ; p<=lastChar ; p++) {
- if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
- (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
+ if ((CHAR_TYPE(*p) != TYPE_NORMAL)
+ && (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
/*
* TCL_COMMAND_END is returned for the last character of the
* string. By this point we know it isn't an array or namespace
@@ -2303,12 +2532,12 @@ TclIsLocalScalar(src, len)
return 0;
}
- if (*p == '(') {
- if (*lastChar == ')') { /* we have an array element */
+ if (*p == '(') {
+ if (*lastChar == ')') { /* We have an array element */
return 0;
}
} else if (*p == ':') {
- if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+ if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
return 0;
}
}
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/tclParseExpr.c b/generic/tclParseExpr.c
deleted file mode 100644
index b6f3548..0000000
--- a/generic/tclParseExpr.c
+++ /dev/null
@@ -1,2148 +0,0 @@
-/*
- * tclParseExpr.c --
- *
- * This file contains functions that parse Tcl expressions. They do so in
- * a general-purpose fashion that can be used for many different
- * purposes, including compilation, direct execution, code analysis, etc.
- *
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclParseExpr.c,v 1.27 2005/07/21 14:38:50 dkf Exp $
- */
-
-#include "tclInt.h"
-
-/*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use the
- * errno from tclExecute.c here.
- */
-
-#ifdef TCL_GENERIC_ONLY
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-extern int errno; /* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
-
-/*
- * Boolean variable that controls whether expression parse tracing is enabled.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static int traceParseExpr = 0;
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- * The ParseInfo structure holds state while parsing an expression. A pointer
- * to an ParseInfo record is passed among the routines in this module.
- */
-
-typedef struct ParseInfo {
- Tcl_Parse *parsePtr; /* Points to structure to fill in with
- * information about the expression. */
- int lexeme; /* Type of last lexeme scanned in expr. See
- * below for definitions. Corresponds to size
- * characters beginning at start. */
- CONST char *start; /* First character in lexeme. */
- int size; /* Number of bytes in lexeme. */
- CONST char *next; /* Position of the next character to be
- * scanned in the expression string. */
- CONST char *prevEnd; /* Points to the character just after the last
- * one in the previous lexeme. Used to compute
- * size of subexpression tokens. */
- CONST char *originalExpr; /* Points to the start of the expression
- * originally passed to Tcl_ParseExpr. */
- CONST char *lastChar; /* Points just after last byte of expr. */
-} ParseInfo;
-
-/*
- * Definitions of the different lexemes that appear in expressions. The order
- * of these must match the corresponding entries in the operatorStrings array
- * below.
- *
- * Basic lexemes:
- */
-
-#define LITERAL 0
-#define FUNC_NAME 1
-#define OPEN_BRACKET 2
-#define OPEN_BRACE 3
-#define OPEN_PAREN 4
-#define CLOSE_PAREN 5
-#define DOLLAR 6
-#define QUOTE 7
-#define COMMA 8
-#define END 9
-#define UNKNOWN 10
-#define UNKNOWN_CHAR 11
-
-/*
- * Binary numeric operators:
- */
-
-#define MULT 12
-#define DIVIDE 13
-#define MOD 14
-#define PLUS 15
-#define MINUS 16
-#define LEFT_SHIFT 17
-#define RIGHT_SHIFT 18
-#define LESS 19
-#define GREATER 20
-#define LEQ 21
-#define GEQ 22
-#define EQUAL 23
-#define NEQ 24
-#define BIT_AND 25
-#define BIT_XOR 26
-#define BIT_OR 27
-#define AND 28
-#define OR 29
-#define QUESTY 30
-#define COLON 31
-
-/*
- * Unary operators. Unary minus and plus are represented by the (binary)
- * lexemes MINUS and PLUS.
- */
-
-#define NOT 32
-#define BIT_NOT 33
-
-/*
- * Binary string operators:
- */
-
-#define STREQ 34
-#define STRNEQ 35
-
-/*
- * Exponentiation operator:
- */
-
-#define EXPON 36
-
-/*
- * List containment operators
- */
-
-#define IN_LIST 37
-#define NOT_IN_LIST 38
-
-/*
- * Mapping from lexemes to strings; used for debugging messages. These entries
- * must match the order and number of the lexeme definitions above.
- */
-
-static char *lexemeStrings[] = {
- "LITERAL", "FUNCNAME",
- "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
- "*", "/", "%", "+", "-",
- "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
- "&", "^", "|", "&&", "||", "?", ":",
- "!", "~", "eq", "ne", "**", "in", "ni"
-};
-
-/*
- * Declarations for local functions to this file:
- */
-
-static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
-static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
- CONST char *extraInfo));
-static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
- CONST char *end));
-static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseExponentialExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
- int opBytes, CONST char *src, int srcBytes,
- int firstIndex, ParseInfo *infoPtr));
-
-/*
- * Macro used to debug the execution of the recursive descent parser used to
- * parse expressions.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-#define HERE(production, level) \
- if (traceParseExpr) { \
- fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
- (level), " ", (production), \
- lexemeStrings[infoPtr->lexeme], infoPtr->next); \
- }
-#else
-#define HERE(production, level)
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ParseExpr --
- *
- * Given a string, this function parses the first Tcl expression in the
- * string and returns information about the structure of the expression.
- * This function is the top-level interface to the the expression parsing
- * module. No more than numBytes bytes will be scanned.
- *
- * Note that this parser is a LL(1) parser; the operator precedence rules
- * are completely hard coded in the recursive structure of the parser
- * itself.
- *
- * Results:
- * The return value is TCL_OK if the command was parsed successfully and
- * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
- * error message is left in its result. On a successful return, parsePtr
- * is filled in with information about the expression that was parsed.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the expression, then additional space is malloc-ed. If the
- * function returns TCL_OK then the caller must eventually invoke
- * Tcl_FreeParse to release any additional space that was allocated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ParseExpr(interp, start, numBytes, parsePtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- CONST char *start; /* Start of source string to parse. */
- int numBytes; /* Number of bytes in string. If < 0, the
- * string consists of all bytes up to the
- * first null character. */
- Tcl_Parse *parsePtr; /* Structure to fill with information about
- * the parsed expression; any previous
- * information in the structure is ignored. */
-{
- ParseInfo info;
- int code;
-
- if (numBytes < 0) {
- numBytes = (start? strlen(start) : 0);
- }
-#ifdef TCL_COMPILE_DEBUG
- if (traceParseExpr) {
- fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
- numBytes, start);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- TclParseInit(interp, start, numBytes, parsePtr);
-
- /*
- * Initialize the ParseInfo structure that holds state while parsing the
- * expression.
- */
-
- info.parsePtr = parsePtr;
- info.lexeme = UNKNOWN;
- info.start = NULL;
- info.size = 0;
- info.next = start;
- info.prevEnd = start;
- info.originalExpr = start;
- info.lastChar = (start + numBytes); /* just after last char of expr */
-
- /*
- * Get the first lexeme then parse the expression.
- */
-
- code = GetLexeme(&info);
- if (code != TCL_OK) {
- goto error;
- }
- code = ParseCondExpr(&info);
- if (code != TCL_OK) {
- goto error;
- }
- if (info.lexeme != END) {
- LogSyntaxError(&info, "extra tokens at end of expression");
- goto error;
- }
- return TCL_OK;
-
- error:
- if (parsePtr->tokenPtr != parsePtr->staticTokens) {
- ckfree((char *) parsePtr->tokenPtr);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseCondExpr --
- *
- * This function parses a Tcl conditional expression:
- * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
- *
- * Note that this is the topmost recursive-descent parsing routine used
- * by Tcl_ParseExpr to parse expressions. This avoids an extra function
- * call since such a function would only return the result of calling
- * ParseCondExpr. Other recursive-descent functions that need to parse
- * complete expressions also call ParseCondExpr.
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseCondExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
- int firstIndex, numToMove, code;
- CONST char *srcStart;
-
- HERE("condExpr", 1);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseLorExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- if (infoPtr->lexeme == QUESTY) {
- /*
- * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
- * conditional expression, and a TCL_TOKEN_OPERATOR token for the "?"
- * operator. Note that these two tokens must be inserted before the
- * LOR operand tokens generated above.
- */
-
- if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
- tokenPtr = (firstTokenPtr + 2);
- numToMove = (parsePtr->numTokens - firstIndex);
- memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
- (size_t) (numToMove * sizeof(Tcl_Token)));
- parsePtr->numTokens += 2;
-
- tokenPtr = firstTokenPtr;
- tokenPtr->type = TCL_TOKEN_SUB_EXPR;
- tokenPtr->start = srcStart;
-
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_OPERATOR;
- tokenPtr->start = infoPtr->start;
- tokenPtr->size = 1;
- tokenPtr->numComponents = 0;
-
- /*
- * Skip over the '?'.
- */
-
- code = GetLexeme(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Parse the "then" expression.
- */
-
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
- if (infoPtr->lexeme != COLON) {
- LogSyntaxError(infoPtr, "missing colon from ternary conditional");
- return TCL_ERROR;
- }
- code = GetLexeme(infoPtr); /* skip over the ':' */
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Parse the "else" expression.
- */
-
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Now set the size-related fields in the '?' subexpression token.
- */
-
- condTokenPtr = &parsePtr->tokenPtr[firstIndex];
- condTokenPtr->size = (infoPtr->prevEnd - srcStart);
- condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLorExpr --
- *
- * This function parses a Tcl logical or expression:
- * lorExpr ::= landExpr {'||' landExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseLorExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, code;
- CONST char *srcStart, *operator;
-
- HERE("lorExpr", 2);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseLandExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == OR) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '||' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseLandExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the LOR subexpression and the '||' operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLandExpr --
- *
- * This function parses a Tcl logical and expression:
- * landExpr ::= bitOrExpr {'&&' bitOrExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseLandExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, code;
- CONST char *srcStart, *operator;
-
- HERE("landExpr", 3);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseBitOrExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == AND) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '&&' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseBitOrExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the LAND subexpression and the '&&' operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitOrExpr --
- *
- * This function parses a Tcl bitwise or expression:
- * bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitOrExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, code;
- CONST char *srcStart, *operator;
-
- HERE("bitOrExpr", 4);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseBitXorExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == BIT_OR) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '|' */
- if (code != TCL_OK) {
- return code;
- }
-
- code = ParseBitXorExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the BITOR subexpression and the '|' operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitXorExpr --
- *
- * This function parses a Tcl bitwise exclusive or expression:
- * bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitXorExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, code;
- CONST char *srcStart, *operator;
-
- HERE("bitXorExpr", 5);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseBitAndExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == BIT_XOR) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '^' */
- if (code != TCL_OK) {
- return code;
- }
-
- code = ParseBitAndExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the XOR subexpression and the '^' operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitAndExpr --
- *
- * This function parses a Tcl bitwise and expression:
- * bitAndExpr ::= equalityExpr {'&' equalityExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitAndExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, code;
- CONST char *srcStart, *operator;
-
- HERE("bitAndExpr", 6);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseEqualityExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme == BIT_AND) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the '&' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseEqualityExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the BITAND subexpression and '&' operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseEqualityExpr --
- *
- * This function parses a Tcl equality (inequality) expression:
- * equalityExpr ::= relationalExpr
- * {('==' | '!=' | 'ne' | 'eq') relationalExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseEqualityExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("equalityExpr", 7);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseRelationalExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while (lexeme == EQUAL || lexeme == NEQ || lexeme == NOT_IN_LIST ||
- lexeme == IN_LIST || lexeme == STREQ || lexeme == STRNEQ) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseRelationalExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
- * operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseRelationalExpr --
- *
- * This function parses a Tcl relational expression:
- * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseRelationalExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, operatorSize, code;
- CONST char *srcStart, *operator;
-
- HERE("relationalExpr", 8);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseShiftExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
- || (lexeme == GEQ)) {
- operator = infoPtr->start;
- if ((lexeme == LEQ) || (lexeme == GEQ)) {
- operatorSize = 2;
- } else {
- operatorSize = 1;
- }
- code = GetLexeme(infoPtr); /* skip over the operator */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseShiftExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and the operator.
- */
-
- PrependSubExprTokens(operator, operatorSize, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseShiftExpr --
- *
- * This function parses a Tcl shift expression:
- * shiftExpr ::= addExpr {('<<' | '>>') addExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseShiftExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("shiftExpr", 9);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseAddExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over << or >> */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseAddExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and '<<' or '>>' operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseAddExpr --
- *
- * This function parses a Tcl addition expression:
- * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseAddExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("addExpr", 10);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseMultiplyExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while ((lexeme == PLUS) || (lexeme == MINUS)) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over + or - */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseMultiplyExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and '+' or '-' operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseMultiplyExpr --
- *
- * This function parses a Tcl multiply expression:
- * multiplyExpr ::= exponentialExpr {('*' | '/' | '%') exponentialExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseMultiplyExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("multiplyExpr", 11);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseExponentialExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over * or / or % */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseExponentialExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and * or / or % operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseExponentialExpr --
- *
- * This function parses a Tcl exponential expression:
- * exponentialExpr ::= unaryExpr {'**' unaryExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseExponentialExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("exponentiateExpr", 12);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- code = ParseUnaryExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- lexeme = infoPtr->lexeme;
- while (lexeme == EXPON) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over ** */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseUnaryExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and ** operator.
- */
-
- PrependSubExprTokens(operator, 2, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- lexeme = infoPtr->lexeme;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseUnaryExpr --
- *
- * This function parses a Tcl unary expression:
- * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseUnaryExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- int firstIndex, lexeme, code;
- CONST char *srcStart, *operator;
-
- HERE("unaryExpr", 13);
- srcStart = infoPtr->start;
- firstIndex = parsePtr->numTokens;
-
- lexeme = infoPtr->lexeme;
- if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
- || (lexeme == NOT)) {
- operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over the unary operator */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseUnaryExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- /*
- * Generate tokens for the subexpression and the operator.
- */
-
- PrependSubExprTokens(operator, 1, srcStart,
- (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
- } else { /* must be a primaryExpr */
- code = ParsePrimaryExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParsePrimaryExpr --
- *
- * This function parses a Tcl primary expression:
- * primaryExpr ::= literal | varReference | quotedString |
- * '[' command ']' | mathFuncCall | '(' condExpr ')'
- *
- * Results:
- * The return value is TCL_OK on a successful parse and TCL_ERROR on
- * failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParsePrimaryExpr(infoPtr)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- Tcl_Interp *interp = parsePtr->interp;
- Tcl_Token *tokenPtr, *exprTokenPtr;
- Tcl_Parse nested;
- CONST char *dollarPtr, *stringStart, *termPtr, *src;
- int lexeme, exprIndex, firstIndex, numToMove, code;
-
- /*
- * We simply recurse on parenthesized subexpressions.
- */
-
- HERE("primaryExpr", 14);
- lexeme = infoPtr->lexeme;
- if (lexeme == OPEN_PAREN) {
- code = GetLexeme(infoPtr); /* skip over the '(' */
- if (code != TCL_OK) {
- return code;
- }
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
- if (infoPtr->lexeme != CLOSE_PAREN) {
- LogSyntaxError(infoPtr, "looking for close parenthesis");
- return TCL_ERROR;
- }
- code = GetLexeme(infoPtr); /* skip over the ')' */
- if (code != TCL_OK) {
- return code;
- }
- return TCL_OK;
- }
-
- /*
- * Start a TCL_TOKEN_SUB_EXPR token for the primary.
- */
-
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- exprIndex = parsePtr->numTokens;
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
- exprTokenPtr->start = infoPtr->start;
- parsePtr->numTokens++;
-
- /*
- * Process the primary then finish setting the fields of the
- * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now stored
- * in "exprTokenPtr" in the code below since the token array might be
- * reallocated.
- */
-
- firstIndex = parsePtr->numTokens;
- switch (lexeme) {
- case LITERAL:
- /*
- * Int or double number.
- */
-
- tokenizeLiteral:
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = infoPtr->start;
- tokenPtr->size = infoPtr->size;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = infoPtr->size;
- exprTokenPtr->numComponents = 1;
- break;
-
- case DOLLAR:
- /*
- * $var variable reference.
- */
-
- dollarPtr = (infoPtr->next - 1);
- code = Tcl_ParseVarName(interp, dollarPtr,
- (infoPtr->lastChar - dollarPtr), parsePtr, 1);
- if (code != TCL_OK) {
- return code;
- }
- infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
- exprTokenPtr->numComponents =
- (parsePtr->tokenPtr[firstIndex].numComponents + 1);
- break;
-
- case QUOTE:
- /*
- * '"' string '"'
- */
-
- stringStart = infoPtr->next;
- code = Tcl_ParseQuotedString(interp, infoPtr->start,
- (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
- if (code != TCL_OK) {
- return code;
- }
- infoPtr->next = termPtr;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = (termPtr - exprTokenPtr->start);
- exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
-
- /*
- * If parsing the quoted string resulted in more than one token,
- * insert a TCL_TOKEN_WORD token before them. This indicates that the
- * quoted string represents a concatenation of multiple tokens.
- */
-
- if (exprTokenPtr->numComponents > 1) {
- if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[firstIndex];
- numToMove = (parsePtr->numTokens - firstIndex);
- memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
- (size_t) (numToMove * sizeof(Tcl_Token)));
- parsePtr->numTokens++;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->numComponents++;
-
- tokenPtr->type = TCL_TOKEN_WORD;
- tokenPtr->start = exprTokenPtr->start;
- tokenPtr->size = exprTokenPtr->size;
- tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
- }
- break;
-
- case OPEN_BRACKET:
- /*
- * '[' command {command} ']'
- */
-
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_COMMAND;
- tokenPtr->start = infoPtr->start;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- /*
- * Call Tcl_ParseCommand repeatedly to parse the nested command(s) to
- * find their end, then throw away that parse information.
- */
-
- src = infoPtr->next;
- while (1) {
- if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
- &nested) != TCL_OK) {
- parsePtr->term = nested.term;
- parsePtr->errorType = nested.errorType;
- parsePtr->incomplete = nested.incomplete;
- return TCL_ERROR;
- }
- src = (nested.commandStart + nested.commandSize);
-
- /*
- * This is equivalent to Tcl_FreeParse(&nested), but presumably
- * inlined here for sake of runtime optimization
- */
-
- if (nested.tokenPtr != nested.staticTokens) {
- ckfree((char *) nested.tokenPtr);
- }
-
- /*
- * Check for the closing ']' that ends the command substitution.
- * It must have been the last character of the parsed command.
- */
-
- if ((nested.term < parsePtr->end) && (*nested.term == ']')
- && !nested.incomplete) {
- break;
- }
- if (src == parsePtr->end) {
- if (parsePtr->interp != NULL) {
- Tcl_SetResult(interp, "missing close-bracket",
- TCL_STATIC);
- }
- parsePtr->term = tokenPtr->start;
- parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
- parsePtr->incomplete = 1;
- return TCL_ERROR;
- }
- }
- tokenPtr->size = (src - tokenPtr->start);
- infoPtr->next = src;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = (src - tokenPtr->start);
- exprTokenPtr->numComponents = 1;
- break;
-
- case OPEN_BRACE:
- /*
- * '{' string '}'
- */
-
- code = Tcl_ParseBraces(interp, infoPtr->start,
- (infoPtr->lastChar - infoPtr->start), parsePtr, 1, &termPtr);
- if (code != TCL_OK) {
- return code;
- }
- infoPtr->next = termPtr;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = (termPtr - infoPtr->start);
- exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
-
- /*
- * If parsing the braced string resulted in more than one token,
- * insert a TCL_TOKEN_WORD token before them. This indicates that the
- * braced string represents a concatenation of multiple tokens.
- */
-
- if (exprTokenPtr->numComponents > 1) {
- if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[firstIndex];
- numToMove = (parsePtr->numTokens - firstIndex);
- memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
- (size_t) (numToMove * sizeof(Tcl_Token)));
- parsePtr->numTokens++;
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->numComponents++;
-
- tokenPtr->type = TCL_TOKEN_WORD;
- tokenPtr->start = exprTokenPtr->start;
- tokenPtr->size = exprTokenPtr->size;
- tokenPtr->numComponents = exprTokenPtr->numComponents-1;
- }
- break;
-
- case STREQ:
- case STRNEQ:
- case IN_LIST:
- case NOT_IN_LIST:
- case FUNC_NAME: {
- /*
- * math_func '(' expr {',' expr} ')'
- */
-
- ParseInfo savedInfo = *infoPtr;
-
- code = GetLexeme(infoPtr); /* skip over function name */
- if (code != TCL_OK) {
- return code;
- }
- if (infoPtr->lexeme != OPEN_PAREN) {
-
- int code;
- Tcl_Obj *errMsg, *objPtr =
- Tcl_NewStringObj(savedInfo.start, savedInfo.size);
-
- /*
- * Check for boolean literals (true, false, yes, no, on, off).
- */
-
- Tcl_IncrRefCount(objPtr);
- code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
- Tcl_DecrRefCount(objPtr);
- if (code == TCL_OK) {
- *infoPtr = savedInfo;
- goto tokenizeLiteral;
- }
-
- /*
- * Either there's a math function without a (, or a variable name
- * without a '$'.
- */
-
- errMsg = Tcl_NewStringObj( "syntax error in expression \"", -1 );
- TclAppendLimitedToObj(errMsg, infoPtr->originalExpr,
- (int) (infoPtr->lastChar - infoPtr->originalExpr),
- 63, NULL);
- Tcl_AppendToObj(errMsg, "\": the word \"", -1);
- Tcl_AppendToObj(errMsg, savedInfo.start, savedInfo.size);
- Tcl_AppendToObj(errMsg,
- "\" requires a preceding $ if it's a variable ", -1);
- Tcl_AppendToObj(errMsg,
- "or function arguments if it's a function", -1);
- Tcl_SetObjResult(infoPtr->parsePtr->interp, errMsg);
- infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
- infoPtr->parsePtr->term = infoPtr->start;
- return TCL_ERROR;
-
- }
-
- if (parsePtr->numTokens == parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_OPERATOR;
- tokenPtr->start = savedInfo.start;
- tokenPtr->size = savedInfo.size;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- code = GetLexeme(infoPtr); /* skip over '(' */
- if (code != TCL_OK) {
- return code;
- }
-
- while (infoPtr->lexeme != CLOSE_PAREN) {
- code = ParseCondExpr(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
-
- if (infoPtr->lexeme == COMMA) {
- code = GetLexeme(infoPtr); /* skip over , */
- if (code != TCL_OK) {
- return code;
- }
- } else if (infoPtr->lexeme != CLOSE_PAREN) {
- LogSyntaxError(infoPtr,
- "missing close parenthesis at end of function call");
- return TCL_ERROR;
- }
- }
-
- exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
- exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
- exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
- break;
- }
-
- case COMMA:
- LogSyntaxError(infoPtr,
- "commas can only separate function arguments");
- return TCL_ERROR;
- case END:
- LogSyntaxError(infoPtr, "premature end of expression");
- return TCL_ERROR;
- case UNKNOWN:
- LogSyntaxError(infoPtr,
- "single equality character not legal in expressions");
- return TCL_ERROR;
- case UNKNOWN_CHAR:
- LogSyntaxError(infoPtr, "character not legal in expressions");
- return TCL_ERROR;
- case QUESTY:
- LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
- return TCL_ERROR;
- case COLON:
- LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
- return TCL_ERROR;
- case CLOSE_PAREN:
- LogSyntaxError(infoPtr, "unexpected close parenthesis");
- return TCL_ERROR;
-
- default:
- {
- char buf[64];
-
- sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
- LogSyntaxError(infoPtr, buf);
- return TCL_ERROR;
- }
- }
-
- /*
- * Advance to the next lexeme before returning.
- */
-
- code = GetLexeme(infoPtr);
- if (code != TCL_OK) {
- return code;
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetLexeme --
- *
- * Lexical scanner for Tcl expressions: scans a single operator or other
- * syntactic element from an expression string.
- *
- * Results:
- * TCL_OK is returned unless an error occurred. In that case a standard
- * Tcl error code is returned and, if infoPtr->parsePtr->interp is
- * non-NULL, the interpreter's result is set to hold an error message.
- * TCL_ERROR is returned if an integer overflow, or a floating-point
- * overflow or underflow occurred while reading in a number. If the
- * lexical analysis is successful, infoPtr->lexeme refers to the next
- * symbol in the expression string, and infoPtr->next is advanced past
- * the lexeme. Also, if the lexeme is a LITERAL or FUNC_NAME, then
- * infoPtr->start is set to the first character of the lexeme; otherwise
- * it is set NULL.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold all the information
- * about the subexpression, then additional space is malloc-ed..
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetLexeme(infoPtr)
- ParseInfo *infoPtr; /* Holds state needed to parse the expr,
- * including the resulting lexeme. */
-{
- register CONST char *src; /* Points to current source char. */
- char c;
- int offset, length, numBytes;
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- Tcl_Interp *interp = parsePtr->interp;
- Tcl_UniChar ch;
-
- /*
- * Record where the previous lexeme ended. Since we always read one lexeme
- * ahead during parsing, this helps us know the source length of
- * subexpression tokens.
- */
-
- infoPtr->prevEnd = infoPtr->next;
-
- /*
- * Scan over leading white space at the start of a lexeme.
- */
-
- src = infoPtr->next;
- numBytes = parsePtr->end - src;
-
- do {
- char type;
- int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
-
- src += scanned;
- numBytes -= scanned;
- } while (numBytes && (*src == '\n') && (src++,numBytes--));
-
- parsePtr->term = src;
- if (numBytes == 0) {
- infoPtr->lexeme = END;
- infoPtr->next = src;
- return TCL_OK;
- }
-
- /*
- * Try to parse the lexeme first as an integer or floating-point number.
- * Don't check for a number if the first character c is "+" or "-". If we
- * did, we might treat a binary operator as unary by mistake, which would
- * eventually cause a syntax error.
- */
-
- c = *src;
- if ((c != '+') && (c != '-')) {
- CONST char *end = infoPtr->lastChar;
- if ((length = TclParseInteger(src, end-src))) {
- /*
- * First length bytes look like an integer. Verify by attempting
- * the conversion to the largest integer we have.
- */
-
- int code;
- Tcl_WideInt wide;
- Tcl_Obj *value = Tcl_NewStringObj(src, length);
-
- Tcl_IncrRefCount(value);
- code = Tcl_GetWideIntFromObj(interp, value, &wide);
- Tcl_DecrRefCount(value);
- if (code == TCL_ERROR) {
- parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
- return TCL_ERROR;
- }
- infoPtr->lexeme = LITERAL;
- infoPtr->start = src;
- infoPtr->size = length;
- infoPtr->next = (src + length);
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- } else if ((length = ParseMaxDoubleLength(src, end))) {
- /*
- * There are length characters that could be a double. Let
- * strtod() tells us for sure. Need a writable copy so we can set
- * an terminating NULL to keep strtod from scanning too far.
- */
-
- char *startPtr;
- CONST char *termPtr;
- double doubleValue;
- Tcl_DString toParse;
-
- errno = 0;
- Tcl_DStringInit(&toParse);
- startPtr = Tcl_DStringAppend(&toParse, src, length);
- doubleValue = TclStrToD(startPtr, &termPtr);
- Tcl_DStringFree(&toParse);
- if (termPtr != startPtr) {
- /*
- * startPtr was the start of a valid double, copied from src.
- */
-
- infoPtr->lexeme = LITERAL;
- infoPtr->start = src;
- if ((termPtr - startPtr) > length) {
- infoPtr->size = length;
- } else {
- infoPtr->size = (termPtr - startPtr);
- }
- infoPtr->next = src + infoPtr->size;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- }
- }
- }
-
- /*
- * Not an integer or double literal. Initialize the lexeme's fields
- * assuming the common case of a single character lexeme.
- */
-
- infoPtr->start = src;
- infoPtr->size = 1;
- infoPtr->next = src+1;
- parsePtr->term = infoPtr->next;
-
- switch (*src) {
- case '[':
- infoPtr->lexeme = OPEN_BRACKET;
- return TCL_OK;
-
- case '{':
- infoPtr->lexeme = OPEN_BRACE;
- return TCL_OK;
-
- case '(':
- infoPtr->lexeme = OPEN_PAREN;
- return TCL_OK;
-
- case ')':
- infoPtr->lexeme = CLOSE_PAREN;
- return TCL_OK;
-
- case '$':
- infoPtr->lexeme = DOLLAR;
- return TCL_OK;
-
- case '\"':
- infoPtr->lexeme = QUOTE;
- return TCL_OK;
-
- case ',':
- infoPtr->lexeme = COMMA;
- return TCL_OK;
-
- case '*':
- infoPtr->lexeme = MULT;
- if ((infoPtr->lastChar - src)>1 && src[1]=='*') {
- infoPtr->lexeme = EXPON;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- parsePtr->term = infoPtr->next;
- }
- return TCL_OK;
-
- case '/':
- infoPtr->lexeme = DIVIDE;
- return TCL_OK;
-
- case '%':
- infoPtr->lexeme = MOD;
- return TCL_OK;
-
- case '+':
- infoPtr->lexeme = PLUS;
- return TCL_OK;
-
- case '-':
- infoPtr->lexeme = MINUS;
- return TCL_OK;
-
- case '?':
- infoPtr->lexeme = QUESTY;
- return TCL_OK;
-
- case ':':
- infoPtr->lexeme = COLON;
- return TCL_OK;
-
- case '<':
- infoPtr->lexeme = LESS;
- if ((infoPtr->lastChar - src) > 1) {
- switch (src[1]) {
- case '<':
- infoPtr->lexeme = LEFT_SHIFT;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- case '=':
- infoPtr->lexeme = LEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- }
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '>':
- infoPtr->lexeme = GREATER;
- if ((infoPtr->lastChar - src) > 1) {
- switch (src[1]) {
- case '>':
- infoPtr->lexeme = RIGHT_SHIFT;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- case '=':
- infoPtr->lexeme = GEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- }
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '=':
- infoPtr->lexeme = UNKNOWN;
- if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
- infoPtr->lexeme = EQUAL;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '!':
- infoPtr->lexeme = NOT;
- if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
- infoPtr->lexeme = NEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '&':
- infoPtr->lexeme = BIT_AND;
- if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
- infoPtr->lexeme = AND;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '^':
- infoPtr->lexeme = BIT_XOR;
- return TCL_OK;
-
- case '|':
- infoPtr->lexeme = BIT_OR;
- if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
- infoPtr->lexeme = OR;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- }
- parsePtr->term = infoPtr->next;
- return TCL_OK;
-
- case '~':
- infoPtr->lexeme = BIT_NOT;
- return TCL_OK;
-
- case 'e':
- if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
- infoPtr->lexeme = STREQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- } else {
- goto checkFuncName;
- }
-
- case 'n':
- if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
- infoPtr->lexeme = STRNEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- } else if ((src[1] == 'i') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
- infoPtr->lexeme = NOT_IN_LIST;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- } else {
- goto checkFuncName;
- }
-
- case 'i':
- if ((src[1] == 'n') && ((infoPtr->lastChar - src) > 1) &&
- (infoPtr->lastChar-src==2 || !isalpha(UCHAR(src[2])))) {
- infoPtr->lexeme = IN_LIST;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- } else {
- goto checkFuncName;
- }
-
- default:
- checkFuncName:
- length = (infoPtr->lastChar - src);
- if (Tcl_UtfCharComplete(src, length)) {
- offset = Tcl_UtfToUniChar(src, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
-
- memcpy(utfBytes, src, (size_t) length);
- utfBytes[length] = '\0';
- offset = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- c = UCHAR(ch);
- if (isalpha(UCHAR(c))) { /* INTL: ISO only. */
- infoPtr->lexeme = FUNC_NAME;
- while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
- src += offset;
- length -= offset;
- if (Tcl_UtfCharComplete(src, length)) {
- offset = Tcl_UtfToUniChar(src, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
-
- memcpy(utfBytes, src, (size_t) length);
- utfBytes[length] = '\0';
- offset = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- c = UCHAR(ch);
- }
- infoPtr->size = (src - infoPtr->start);
- infoPtr->next = src;
- parsePtr->term = infoPtr->next;
- return TCL_OK;
- }
- infoPtr->lexeme = UNKNOWN_CHAR;
- return TCL_OK;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclParseInteger --
- *
- * Scans up to numBytes bytes starting at src, and checks whether the
- * leading bytes look like an integer's string representation.
- *
- * Results:
- * Returns 0 if the leading bytes do not look like an integer.
- * Otherwise, returns the number of bytes examined that look like an
- * integer. This may be less than numBytes if the integer is only the
- * leading part of the string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclParseInteger(string, numBytes)
- register CONST char *string;/* The string to examine. */
- register int numBytes; /* Max number of bytes to scan. */
-{
- register CONST char *p = string;
-
- /*
- * Take care of introductory "0x".
- */
-
- if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
- int scanned;
- Tcl_UniChar ch;
-
- p += 2;
- numBytes -= 2;
- scanned = TclParseHex(p, numBytes, &ch);
- if (scanned) {
- return scanned+2;
- }
-
- /*
- * Recognize the 0 as valid integer, but x is left behind.
- */
-
- return 1;
- }
- while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */
- numBytes--; p++;
- }
- if (numBytes == 0) {
- return (p - string);
- }
- if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
- return (p - string);
- }
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseMaxDoubleLength --
- *
- * Scans a sequence of bytes checking that the characters could be in a
- * string rep of a double.
- *
- * Results:
- * Returns the number of bytes starting with string, running to, but not
- * including end, all of which could be part of a string rep. of a
- * double. Only character identity is used, no actual parsing is done.
- *
- * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', '.', '+', '-',
- * 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'. This covers the values
- * "Inf" and "Nan" as well as the decimal and hexadecimal representations
- * recognized by a C99-compliant strtod().
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseMaxDoubleLength(string, end)
- register CONST char *string;/* The string to examine. */
- CONST char *end; /* Point to the first character past the end
- * of the string we are examining. */
-{
- CONST char *p = string;
- while (p < end) {
- switch (*p) {
- case '0': case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9': case 'A': case 'B':
- case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
- case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
- case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
- case '.': case '+': case '-': case '(': case ' ': case ')':
- p++;
- break;
- default:
- goto done;
- }
- }
- done:
- return (p - string);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrependSubExprTokens --
- *
- * This function is called after the operands of an subexpression have
- * been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
- * the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
- * These two tokens are inserted before the operand tokens.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If there is insufficient space in parsePtr to hold the new tokens,
- * additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
- CONST char *op; /* Points to first byte of the operator in the
- * source script. */
- int opBytes; /* Number of bytes in the operator. */
- CONST char *src; /* Points to first byte of the subexpression
- * in the source script. */
- int srcBytes; /* Number of bytes in subexpression's
- * source. */
- int firstIndex; /* Index of first token already emitted for
- * operator's first (or only) operand. */
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
-{
- Tcl_Parse *parsePtr = infoPtr->parsePtr;
- Tcl_Token *tokenPtr, *firstTokenPtr;
- int numToMove;
-
- if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
- tokenPtr = (firstTokenPtr + 2);
- numToMove = (parsePtr->numTokens - firstIndex);
- memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
- (size_t) (numToMove * sizeof(Tcl_Token)));
- parsePtr->numTokens += 2;
-
- tokenPtr = firstTokenPtr;
- tokenPtr->type = TCL_TOKEN_SUB_EXPR;
- tokenPtr->start = src;
- tokenPtr->size = srcBytes;
- tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
-
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_OPERATOR;
- tokenPtr->start = op;
- tokenPtr->size = opBytes;
- tokenPtr->numComponents = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * LogSyntaxError --
- *
- * This function is invoked after an error occurs when parsing an
- * expression. It sets the interpreter result to an error message
- * describing the error.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the interpreter result to an error message describing the
- * expression that was being parsed when the error occurred, and why the
- * parser considers that to be a syntax error at all.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-LogSyntaxError(infoPtr, extraInfo)
- ParseInfo *infoPtr; /* Holds the parse state for the expression
- * being parsed. */
- CONST char *extraInfo; /* String to provide extra information about
- * the syntax error. */
-{
- Tcl_Obj *result =
- Tcl_NewStringObj("syntax error in expression \"", -1);
- TclAppendLimitedToObj(result, infoPtr->originalExpr,
- (int)(infoPtr->lastChar - infoPtr->originalExpr), 63, NULL);
- Tcl_AppendStringsToObj(result, "\": ", extraInfo, (char *) NULL);
- Tcl_SetObjResult(infoPtr->parsePtr->interp, result);
- infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
- infoPtr->parsePtr->term = infoPtr->start;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index f46854e..fe6063f 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.45 2005/08/09 11:02:36 dkf Exp $
*/
#include "tclInt.h"
@@ -20,22 +18,24 @@
* Prototypes for functions defined later in this file.
*/
-static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr));
-static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr));
-static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr));
-static int FindSplitPos _ANSI_ARGS_((CONST char *path, int separator));
-static int IsSeparatorOrNull _ANSI_ARGS_((int ch));
-static Tcl_Obj* GetExtension _ANSI_ARGS_((Tcl_Obj *pathPtr));
+static Tcl_Obj * AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
+static void DupFsPathInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static void FreeFsPathInternalRep(Tcl_Obj *pathPtr);
+static void UpdateStringOfFsPath(Tcl_Obj *pathPtr);
+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
* internally.
*/
-Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType tclFsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
@@ -46,7 +46,7 @@ Tcl_ObjType tclFsPathType = {
/*
* struct FsPath --
*
- * Internal representation of a Tcl_Obj of "path" type. This can be used to
+ * Internal representation of a Tcl_Obj of "path" type. This can be used to
* represent relative or absolute paths, and has certain optimisations when
* used to represent paths which are already normalized and absolute.
*
@@ -58,8 +58,8 @@ Tcl_ObjType tclFsPathType = {
* (i) flags == 0, => Ordinary path.
*
* translatedPathPtr contains the translated path (which may be a circular
- * reference to the object itself). If it is NULL then the path is pure
- * normalized (and the normPathPtr will be a circular reference). cwdPtr is
+ * reference to the object itself). If it is NULL then the path is pure
+ * normalized (and the normPathPtr will be a circular reference). cwdPtr is
* null for an absolute path, and non-null for a relative path (unless the cwd
* has never been set, in which case the cwdPtr may also be null for a
* relative path).
@@ -72,7 +72,7 @@ Tcl_ObjType tclFsPathType = {
*/
typedef struct FsPath {
- Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
+ Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
* is NULL, then this is a pure normalized,
* absolute path object, in which the parent
* Tcl_Obj's string rep is already both
@@ -84,19 +84,17 @@ typedef struct FsPath {
* container. If that is NOT the case, we have
* a refCount on the object. */
Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points
- * to the cwd object used for this path. We
+ * to the cwd object used for this path. We
* have a refCount on the object. */
int flags; /* Flags to describe interpretation - see
* below. */
- ClientData nativePathPtr; /* Native representation of this path, which
+ ClientData nativePathPtr; /* Native representation of this path, which
* is filesystem dependent. */
int filesystemEpoch; /* Used to ensure the path representation was
* 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;
/*
@@ -104,16 +102,17 @@ typedef struct FsPath {
*/
#define TCLPATH_APPENDED 1
+#define TCLPATH_NEEDNORM 4
/*
* Define some macros to give us convenient access to path-object specific
* fields.
*/
-#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr)
-#define PATHFLAGS(pathPtr) \
- (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags)
-
+#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
+#define SETPATHOBJ(pathPtr,fsPathPtr) \
+ ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
*---------------------------------------------------------------------------
@@ -123,8 +122,8 @@ typedef struct FsPath {
* Takes an absolute path specification and computes a 'normalized' path
* from it.
*
- * A normalized path is one which has all '../', './' removed. Also it
- * is one which is in the 'standard' format for the native platform. On
+ * A normalized path is one which has all '../', './' removed. Also it is
+ * one which is in the 'standard' format for the native platform. On
* Unix, this means the path must be free of symbolic links/aliases, and
* on Windows it means we want the long form, with that long form's
* case-dependence (which gives us a unique, case-dependent path).
@@ -150,18 +149,12 @@ typedef struct FsPath {
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
- 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 *
+TclFSNormalizeAbsolutePath(
+ Tcl_Interp *interp, /* Interpreter to use */
+ Tcl_Obj *pathPtr) /* Absolute path to normalize */
{
- ClientData clientData = NULL;
- CONST char *dirSep, *oldDirSep;
+ const char *dirSep, *oldDirSep;
int first = 1; /* Set to zero once we've passed the first
* directory separator - we can't use '..' to
* remove the volume in a path. */
@@ -169,6 +162,21 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
dirSep = TclGetString(pathPtr);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+ if ( (dirSep[0] == '/' || dirSep[0] == '\\')
+ && (dirSep[1] == '/' || dirSep[1] == '\\')
+ && (dirSep[2] == '?')
+ && (dirSep[3] == '/' || dirSep[3] == '\\')) {
+ /* NT extended path */
+ dirSep += 4;
+
+ if ( (dirSep[0] == 'U' || dirSep[0] == 'u')
+ && (dirSep[1] == 'N' || dirSep[1] == 'n')
+ && (dirSep[2] == 'C' || dirSep[2] == 'c')
+ && (dirSep[3] == '/' || dirSep[3] == '\\')) {
+ /* NT extended UNC path */
+ dirSep += 4;
+ }
+ }
if (dirSep[0] != 0 && dirSep[1] == ':' &&
(dirSep[2] == '/' || dirSep[2] == '\\')) {
/* Do nothing */
@@ -189,7 +197,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
/*
* Scan forward from one directory separator to the next, checking for
- * '..' and '.' sequences which must be handled specially. In particular
+ * '..' and '.' sequences which must be handled specially. In particular
* handling of '..' can be complicated if the directory before is a link,
* since we will have to expand the link to be able to back up one level.
*/
@@ -216,12 +224,17 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
/*
* Need to skip '.' in the path.
*/
+ int curLen;
if (retVal == NULL) {
- CONST char *path = TclGetString(pathPtr);
+ const char *path = TclGetString(pathPtr);
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
+ Tcl_GetStringFromObj(retVal, &curLen);
+ if (curLen == 0) {
+ Tcl_AppendToObj(retVal, dirSep, 1);
+ }
dirSep += 2;
oldDirSep = dirSep;
if (dirSep[0] != 0 && dirSep[1] == '.') {
@@ -230,7 +243,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
continue;
}
if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
- Tcl_Obj *link;
+ Tcl_Obj *linkObj;
int curLen;
char *linkStr;
@@ -239,28 +252,42 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
*/
if (retVal == NULL) {
- CONST char *path = TclGetString(pathPtr);
+ const char *path = TclGetString(pathPtr);
+
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
+ Tcl_GetStringFromObj(retVal, &curLen);
+ if (curLen == 0) {
+ Tcl_AppendToObj(retVal, dirSep, 1);
+ }
if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
- link = Tcl_FSLink(retVal, NULL, 0);
- if (link != NULL) {
+ 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
* or absolute, for those platforms where relative
* links exist.
*/
- if (tclPlatform != TCL_PLATFORM_WINDOWS &&
- Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) {
+ if (tclPlatform != TCL_PLATFORM_WINDOWS
+ && Tcl_FSGetPathType(linkObj)
+ == TCL_PATH_RELATIVE) {
/*
* We need to follow this link which is relative
* to retVal's directory. This means concatenating
* the link onto the directory of the path so far.
*/
- CONST char *path =
+ const char *path =
Tcl_GetStringFromObj(retVal, &curLen);
while (--curLen >= 0) {
@@ -268,19 +295,14 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
break;
}
}
- if (Tcl_IsShared(retVal)) {
- TclDecrRefCount(retVal);
- retVal = Tcl_DuplicateObj(retVal);
- Tcl_IncrRefCount(retVal);
- }
/*
* We want the trailing slash.
*/
Tcl_SetObjLength(retVal, curLen+1);
- Tcl_AppendObjToObj(retVal, link);
- TclDecrRefCount(link);
+ Tcl_AppendObjToObj(retVal, linkObj);
+ TclDecrRefCount(linkObj);
linkStr = Tcl_GetStringFromObj(retVal, &curLen);
} else {
/*
@@ -288,7 +310,12 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
*/
TclDecrRefCount(retVal);
- retVal = link;
+ if (Tcl_IsShared(linkObj)) {
+ retVal = Tcl_DuplicateObj(linkObj);
+ TclDecrRefCount(linkObj);
+ } else {
+ retVal = linkObj;
+ }
linkStr = Tcl_GetStringFromObj(retVal, &curLen);
/*
@@ -297,6 +324,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
int i;
+
for (i = 0; i < curLen; i++) {
if (linkStr[i] == '\\') {
linkStr[i] = '/';
@@ -309,18 +337,28 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
}
/*
- * Either way, we now remove the last path element.
+ * Either way, we now remove the last path element (but
+ * not the first character of the path).
*/
while (--curLen >= 0) {
if (IsSeparatorOrNull(linkStr[curLen])) {
- Tcl_SetObjLength(retVal, curLen);
+ if (curLen) {
+ Tcl_SetObjLength(retVal, curLen);
+ } else {
+ Tcl_SetObjLength(retVal, 1);
+ }
break;
}
}
}
dirSep += 3;
oldDirSep = dirSep;
+
+ if ((curLen == 0) && (dirSep[0] != 0)) {
+ Tcl_SetObjLength(retVal, 0);
+ }
+
if (dirSep[0] != 0 && dirSep[1] == '.') {
goto again;
}
@@ -345,9 +383,9 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
/*
* Unfortunately, the platform-specific normalization code which
* will be called below has no way of dealing with the case where
- * an object is shared. It is expecting to modify an object in
- * place. So, we must duplicate this here to ensure an object
- * with a single ref-count.
+ * an object is shared. It is expecting to modify an object in
+ * place. So, we must duplicate this here to ensure an object with
+ * a single ref-count.
*
* If that changes in the future (e.g. the normalize proc is given
* one object and is able to return a different one), then we
@@ -361,12 +399,12 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
}
/*
- * Ensure a windows drive like C:/ has a trailing separator
+ * Ensure a windows drive like C:/ has a trailing separator.
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
int len;
- CONST char *path = Tcl_GetStringFromObj(retVal, &len);
+ const char *path = Tcl_GetStringFromObj(retVal, &len);
if (len == 2 && path[0] != 0 && path[1] == ':') {
if (Tcl_IsShared(retVal)) {
@@ -380,7 +418,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
/*
* Now we have an absolute path, with no '..', '.' sequences, but it still
- * may not be in 'unique' form, depending on the platform. For instance,
+ * may not be in 'unique' form, depending on the platform. For instance,
* Unix is case-sensitive, so the path is ok. Windows is case-insensitive,
* and also has the weird 'longname/shortname' thing (e.g. C:/Program
* Files/ and C:/Progra~1/ are equivalent).
@@ -389,17 +427,14 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
* 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.
@@ -427,8 +462,8 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
*/
Tcl_PathType
-Tcl_FSGetPathType(pathPtr)
- Tcl_Obj *pathPtr;
+Tcl_FSGetPathType(
+ Tcl_Obj *pathPtr)
{
return TclFSGetPathType(pathPtr, NULL, NULL);
}
@@ -457,28 +492,38 @@ Tcl_FSGetPathType(pathPtr)
*/
Tcl_PathType
-TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr)
- Tcl_Obj *pathPtr;
- Tcl_Filesystem **filesystemPtrPtr;
- int *driveNameLengthPtr;
+TclFSGetPathType(
+ Tcl_Obj *pathPtr,
+ const Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr)
{
+ FsPath *fsPathPtr;
+
if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
- return TclGetPathType(pathPtr, filesystemPtrPtr,
- driveNameLengthPtr, NULL);
- } else {
- FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+ NULL);
+ }
- if (fsPathPtr->cwdPtr != NULL) {
- if (PATHFLAGS(pathPtr) == 0) {
- return TCL_PATH_RELATIVE;
- }
- return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
- driveNameLengthPtr);
- } else {
- return TclGetPathType(pathPtr, filesystemPtrPtr,
- driveNameLengthPtr, NULL);
- }
+ fsPathPtr = PATHOBJ(pathPtr);
+ if (fsPathPtr->cwdPtr == NULL) {
+ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+ NULL);
+ }
+
+ if (PATHFLAGS(pathPtr) == 0) {
+ /* The path is not absolute... */
+#ifdef _WIN32
+ /* ... on Windows we must make another call to determine whether
+ * it's relative or volumerelative [Bug 2571597]. */
+ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+ NULL);
+#else
+ /* On other systems, quickly deduce !absolute -> relative */
+ return TCL_PATH_RELATIVE;
+#endif
}
+ return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
+ driveNameLengthPtr);
}
/*
@@ -494,7 +539,7 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr)
* - the extension ('file extension')
* - the root ('file root')
*
- * The 'portion' parameter dictates which of these to calculate. There
+ * The 'portion' parameter dictates which of these to calculate. There
* are a number of special cases both to be more efficient, and because
* the behaviour when given a path with only a single element is defined
* to require the expansion of that single element, where possible.
@@ -512,16 +557,16 @@ TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclPathPart(interp, pathPtr, portion)
- Tcl_Interp *interp; /* Used for error reporting */
- Tcl_Obj *pathPtr; /* Path to take dirname of */
- Tcl_PathPart portion; /* Requested portion of name */
+Tcl_Obj *
+TclPathPart(
+ Tcl_Interp *interp, /* Used for error reporting */
+ Tcl_Obj *pathPtr, /* Path to take dirname of */
+ Tcl_PathPart portion) /* Requested portion of name */
{
if (pathPtr->typePtr == &tclFsPathType) {
- FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
- && (PATHFLAGS(pathPtr) != 0)) {
+ FsPath *fsPathPtr = PATHOBJ(pathPtr);
+
+ if (PATHFLAGS(pathPtr) != 0) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
@@ -532,11 +577,24 @@ TclPathPart(interp, pathPtr, portion)
* the standardPath code.
*/
- CONST char *rest = TclGetString(fsPathPtr->normPathPtr);
+ int numBytes;
+ const char *rest =
+ Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
if (strchr(rest, '/') != NULL) {
goto standardPath;
}
+ /*
+ * If the joined-on bit is empty, then [file dirname] is
+ * documented to return all but the last non-empty element
+ * of the path, so we need to split apart the main part to
+ * get the right answer. We could do that here, but it's
+ * simpler to fall back to the standardPath code.
+ * [Bug 2710920]
+ */
+ if (numBytes == 0) {
+ goto standardPath;
+ }
if (tclPlatform == TCL_PLATFORM_WINDOWS
&& strchr(rest, '\\') != NULL) {
goto standardPath;
@@ -557,11 +615,24 @@ TclPathPart(interp, pathPtr, portion)
* we don't, and instead just use the standardPath code.
*/
- CONST char *rest = TclGetString(fsPathPtr->normPathPtr);
+ int numBytes;
+ const char *rest =
+ Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
if (strchr(rest, '/') != NULL) {
goto standardPath;
}
+ /*
+ * If the joined-on bit is empty, then [file tail] is
+ * documented to return the last non-empty element
+ * of the path, so we need to split off the last element
+ * of the main part to get the right answer. We could do
+ * that here, but it's simpler to fall back to the
+ * standardPath code. [Bug 2710920]
+ */
+ if (numBytes == 0) {
+ goto standardPath;
+ }
if (tclPlatform == TCL_PLATFORM_WINDOWS
&& strchr(rest, '\\') != NULL) {
goto standardPath;
@@ -572,7 +643,7 @@ TclPathPart(interp, pathPtr, portion)
case TCL_PATH_EXTENSION:
return GetExtension(fsPathPtr->normPathPtr);
case TCL_PATH_ROOT: {
- CONST char *fileName, *extension;
+ const char *fileName, *extension;
int length;
fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
@@ -588,34 +659,18 @@ TclPathPart(interp, pathPtr, portion)
return pathPtr;
} else {
/*
- * Duplicate the object we were given and then trim off
- * the extension of the tail component of the path.
+ * Need to return the whole path with the extension
+ * suffix removed. Do that by joining our "head" to
+ * our "tail" with the extension suffix removed from
+ * the tail.
*/
- FsPath *fsDupPtr;
- Tcl_Obj *root = Tcl_DuplicateObj(pathPtr);
+ Tcl_Obj *resultPtr =
+ TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
+ (int)(length - strlen(extension)));
- Tcl_IncrRefCount(root);
- fsDupPtr = (FsPath*) PATHOBJ(root);
- if (Tcl_IsShared(fsDupPtr->normPathPtr)) {
- TclDecrRefCount(fsDupPtr->normPathPtr);
- fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName,
- (int)(length - strlen(extension)));
- Tcl_IncrRefCount(fsDupPtr->normPathPtr);
- } else {
- Tcl_SetObjLength(fsDupPtr->normPathPtr,
- (int)(length - strlen(extension)));
- }
-
- /*
- * Must also trim the string representation if we have it.
- */
-
- if (root->bytes != NULL && root->length > 0) {
- root->length -= strlen(extension);
- root->bytes[root->length] = 0;
- }
- return root;
+ Tcl_IncrRefCount(resultPtr);
+ return resultPtr;
}
}
default:
@@ -633,8 +688,7 @@ TclPathPart(interp, pathPtr, portion)
}
} else {
int splitElements;
- Tcl_Obj *splitPtr;
- Tcl_Obj *resultPtr;
+ Tcl_Obj *splitPtr, *resultPtr;
standardPath:
resultPtr = NULL;
@@ -642,7 +696,7 @@ TclPathPart(interp, pathPtr, portion)
return GetExtension(pathPtr);
} else if (portion == TCL_PATH_ROOT) {
int length;
- CONST char *fileName, *extension;
+ const char *fileName, *extension;
fileName = Tcl_GetStringFromObj(pathPtr, &length);
extension = TclGetExtension(fileName);
@@ -652,6 +706,7 @@ TclPathPart(interp, pathPtr, portion)
} else {
Tcl_Obj *root = Tcl_NewStringObj(fileName,
(int) (length - strlen(extension)));
+
Tcl_IncrRefCount(root);
return root;
}
@@ -700,7 +755,7 @@ TclPathPart(interp, pathPtr, portion)
resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
} else if (splitElements == 0 ||
(Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
- resultPtr = Tcl_NewStringObj(".", 1);
+ TclNewLiteralStringObj(resultPtr, ".");
} else {
Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr);
}
@@ -715,11 +770,11 @@ TclPathPart(interp, pathPtr, portion)
* Simple helper function
*/
-static Tcl_Obj*
-GetExtension(pathPtr)
- Tcl_Obj *pathPtr;
+static Tcl_Obj *
+GetExtension(
+ Tcl_Obj *pathPtr)
{
- CONST char *tail, *extension;
+ const char *tail, *extension;
Tcl_Obj *ret;
tail = TclGetString(pathPtr);
@@ -767,54 +822,45 @@ GetExtension(pathPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSJoinPath(listObj, elements)
- Tcl_Obj *listObj; /* Path elements to join, may have a zero
+Tcl_Obj *
+Tcl_FSJoinPath(
+ Tcl_Obj *listObj, /* Path elements to join, may have a zero
* reference count. */
- int elements; /* Number of elements to use (-1 = all) */
+ int elements) /* Number of elements to use (-1 = all) */
{
- Tcl_Obj *res;
- int i;
- Tcl_Filesystem *fsPtr = NULL;
-
- if (elements < 0) {
- if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
- return NULL;
- }
- } else {
- /*
- * Just make sure it is a valid list.
- */
+ Tcl_Obj *copy, *res;
+ int objc;
+ Tcl_Obj **objv;
- 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;
- int driveNameLength;
+ int driveNameLength, strEltLen, length;
Tcl_PathType type;
- char *strElt;
- int strEltLen;
- int length;
- char *ptr;
+ char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
-
- Tcl_ListObjIndex(NULL, listObj, i, &elt);
+ Tcl_Obj *elt = objv[i];
/*
* This is a special case where we can be much more efficient, where
@@ -825,18 +871,17 @@ Tcl_FSJoinPath(listObj, elements)
* could expand that in the future.
*/
- if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
- && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
- Tcl_Obj *tail;
- Tcl_PathType type;
+ if ((i == (elements-2)) && (i == 0)
+ && (elt->typePtr == &tclFsPathType)
+ && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {
+ Tcl_Obj *tailObj = objv[i+1];
- Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
- type = TclGetPathType(tail, NULL, NULL, NULL);
+ type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
- CONST char *str;
+ const char *str;
int len;
- str = Tcl_GetStringFromObj(tail, &len);
+ str = Tcl_GetStringFromObj(tailObj, &len);
if (len == 0) {
/*
* This happens if we try to handle the root volume '/'.
@@ -851,7 +896,7 @@ Tcl_FSJoinPath(listObj, elements)
}
/*
- * If it doesn't begin with '.' and is a unix path or it a
+ * If it doesn't begin with '.' and is a unix path or it a
* windows path without backslashes, then we can be very
* efficient here. (In fact even a windows path with
* backslashes can be joined efficiently, but the path object
@@ -878,24 +923,22 @@ Tcl_FSJoinPath(listObj, elements)
/*
* Otherwise we don't have an easy join, and we must let the
- * more general code below handle things
+ * more general code below handle things.
*/
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
if (res != NULL) {
TclDecrRefCount(res);
}
- return tail;
+ return tailObj;
} else {
- CONST char *str;
- int len;
+ const char *str = TclGetString(tailObj);
- str = Tcl_GetStringFromObj(tail, &len);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (strchr(str, '\\') == NULL) {
if (res != NULL) {
TclDecrRefCount(res);
}
- return tail;
+ return tailObj;
}
}
}
@@ -931,20 +974,22 @@ Tcl_FSJoinPath(listObj, elements)
res = Tcl_NewStringObj(strElt, driveNameLength);
}
strElt += driveNameLength;
+ } else if (driveName != NULL) {
+ Tcl_DecrRefCount(driveName);
}
/*
* Optimisation block: if this is the last element to be examined, and
* it is absolute or the only element, and the drive-prefix was ok (if
* there is one), it might be that the path is already in a suitable
- * form to be returned. Then we can short-cut the rest of this
+ * form to be returned. Then we can short-cut the rest of this
* function.
*/
if ((driveName == NULL) && (i == (elements - 1))
&& (type != TCL_PATH_RELATIVE || res == NULL)) {
/*
- * It's the last path segment. Perform a quick check if the path
+ * It's the last path segment. Perform a quick check if the path
* is already in a suitable form.
*/
@@ -960,6 +1005,7 @@ Tcl_FSJoinPath(listObj, elements)
* We have a repeated file separator, which means the path
* is not in normalized form
*/
+
goto noQuickReturn;
}
ptr++;
@@ -969,8 +1015,8 @@ Tcl_FSJoinPath(listObj, elements)
}
/*
- * This element is just what we want to return already - no
- * further manipulation is requred.
+ * This element is just what we want to return already; no further
+ * manipulation is requred.
*/
return elt;
@@ -982,7 +1028,6 @@ Tcl_FSJoinPath(listObj, elements)
*/
noQuickReturn:
-
if (res == NULL) {
res = Tcl_NewObj();
ptr = Tcl_GetStringFromObj(res, &length);
@@ -1017,15 +1062,22 @@ Tcl_FSJoinPath(listObj, elements)
int needsSep = 0;
if (fsPtr->filesystemSeparatorProc != NULL) {
- Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+ Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res);
+
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));
@@ -1077,56 +1129,55 @@ Tcl_FSJoinPath(listObj, elements)
*/
int
-Tcl_FSConvertToPathType(interp, pathPtr)
- Tcl_Interp *interp; /* Interpreter in which to store error message
+Tcl_FSConvertToPathType(
+ Tcl_Interp *interp, /* Interpreter in which to store error message
* (if necessary). */
- Tcl_Obj *pathPtr; /* Object to convert to a valid, current path
+ Tcl_Obj *pathPtr) /* Object to convert to a valid, current path
* type. */
{
/*
* While it is bad practice to examine an object's type directly, this is
- * actually the best thing to do here. The reason is that if we are
+ * actually the best thing to do here. The reason is that if we are
* converting this object to FsPath type for the first time, we don't need
- * to worry whether the 'cwd' has changed. On the other hand, if this
+ * to worry whether the 'cwd' has changed. On the other hand, if this
* object is already of FsPath type, and is a relative path, we do have to
- * worry about the cwd. If the cwd has changed, we must recompute the
+ * worry about the cwd. If the cwd has changed, we must recompute the
* path.
*/
if (pathPtr->typePtr == &tclFsPathType) {
- FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (!TclFSEpochOk(fsPathPtr->filesystemEpoch)) {
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
- return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+ if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
+ return TCL_OK;
}
- return TCL_OK;
- /*
- * We used to have more complex code here:
- *
- * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
- * return TCL_OK;
- * } else {
- * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
- * return TCL_OK;
- * } else {
- * if (pathPtr->bytes == NULL) {
- * UpdateStringOfFsPath(pathPtr);
- * }
- * FreeFsPathInternalRep(pathPtr);
- * pathPtr->typePtr = NULL;
- * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
- * }
- * }
- *
- * But we no longer believe this is necessary.
- */
- } else {
- return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+
+ if (pathPtr->bytes == NULL) {
+ UpdateStringOfFsPath(pathPtr);
+ }
+ FreeFsPathInternalRep(pathPtr);
}
+
+ return SetFsPathFromAny(interp, pathPtr);
+
+ /*
+ * We used to have more complex code here:
+ *
+ * FsPath *fsPathPtr = PATHOBJ(pathPtr);
+ * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
+ * return TCL_OK;
+ * } else {
+ * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
+ * return TCL_OK;
+ * } else {
+ * if (pathPtr->bytes == NULL) {
+ * UpdateStringOfFsPath(pathPtr);
+ * }
+ * FreeFsPathInternalRep(pathPtr);
+ * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+ * }
+ * }
+ *
+ * But we no longer believe this is necessary.
+ */
}
/*
@@ -1134,8 +1185,8 @@ Tcl_FSConvertToPathType(interp, pathPtr)
*/
static int
-IsSeparatorOrNull(ch)
- int ch;
+IsSeparatorOrNull(
+ int ch)
{
if (ch == 0) {
return 1;
@@ -1150,15 +1201,15 @@ IsSeparatorOrNull(ch)
}
/*
- * Helper function for SetFsPathFromAny. Returns position of first directory
- * delimiter in the path. If no separator is found, then returns the position
+ * Helper function for SetFsPathFromAny. Returns position of first directory
+ * delimiter in the path. If no separator is found, then returns the position
* of the end of the string.
*/
static int
-FindSplitPos(path, separator)
- CONST char *path;
- int separator;
+FindSplitPos(
+ const char *path,
+ int separator)
{
int count = 0;
switch (tclPlatform) {
@@ -1194,28 +1245,54 @@ FindSplitPos(path, separator)
* 'file dirname', 'file tail', etc.
*
* Assumptions:
- * 'dirPtr' must be an absolute path. 'len' may not be zero.
+ * 'dirPtr' must be an absolute path. 'len' may not be zero.
*
* Results:
* The new Tcl object, with refCount zero.
*
* Side effects:
- * Memory is allocated. 'dirPtr' gets an additional refCount.
+ * Memory is allocated. 'dirPtr' gets an additional refCount.
*
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
+Tcl_Obj *
+TclNewFSPathObj(
+ Tcl_Obj *dirPtr,
+ const char *addStrRep,
+ int len)
{
FsPath *fsPathPtr;
Tcl_Obj *pathPtr;
- ThreadSpecificData *tsdPtr;
+ const char *p;
+ int state = 0, count = 0;
+
+ /* [Bug 2806250] - this is only a partial solution of the problem.
+ * The PATHFLAGS != 0 representation assumes in many places that
+ * the "tail" part stored in the normPathPtr field is itself a
+ * relative path. Strings that begin with "~" are not relative paths,
+ * so we must prevent their storage in the normPathPtr field.
+ *
+ * More generally we ought to be testing "addStrRep" for any value
+ * that is not a relative path, but in an unconstrained VFS world
+ * that could be just about anything, and testing could be expensive.
+ * Since this routine plays a big role in [glob], anything that slows
+ * it down would be unwelcome. For now, continue the risk of further
+ * bugs when some Tcl_Filesystem uses otherwise relative path strings
+ * as absolute path strings. Sensible Tcl_Filesystems will avoid
+ * that by mounting on path prefixes like foo:// which cannot be the
+ * name of a file or directory read from a native [glob] operation.
+ */
+ if (addStrRep[0] == '~') {
+ Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len);
- tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ pathPtr = AppendPath(dirPtr, tail);
+ Tcl_DecrRefCount(tail);
+ return pathPtr;
+ }
pathPtr = Tcl_NewObj();
- fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* Set up the path.
@@ -1227,17 +1304,82 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
fsPathPtr->cwdPtr = dirPtr;
Tcl_IncrRefCount(dirPtr);
fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = NULL;
+ fsPathPtr->filesystemEpoch = 0;
- PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
+ SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
pathPtr->typePtr = &tclFsPathType;
pathPtr->bytes = NULL;
pathPtr->length = 0;
+ /*
+ * Look for path components made up of only "."
+ * This is overly conservative analysis to keep simple. It may mark some
+ * things as needing more aggressive normalization that don't actually
+ * need it. No harm done.
+ */
+ for (p = addStrRep; len > 0; p++, len--) {
+ switch (state) {
+ case 0: /* So far only "." since last dirsep or start */
+ switch (*p) {
+ case '.':
+ count++;
+ break;
+ case '/':
+ case '\\':
+ case ':':
+ if (count) {
+ PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+ len = 0;
+ }
+ break;
+ default:
+ count = 0;
+ state = 1;
+ }
+ case 1: /* Scanning for next dirsep */
+ switch (*p) {
+ case '/':
+ case '\\':
+ case ':':
+ state = 0;
+ break;
+ }
+ }
+ }
+ if (len == 0 && count) {
+ PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+ }
+
return pathPtr;
}
+
+static Tcl_Obj *
+AppendPath(
+ Tcl_Obj *head,
+ Tcl_Obj *tail)
+{
+ int numBytes;
+ const char *bytes;
+ Tcl_Obj *copy = Tcl_DuplicateObj(head);
+
+ /*
+ * 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.
+ */
+ bytes = Tcl_GetStringFromObj(tail, &numBytes);
+ if (numBytes == 0) {
+ Tcl_AppendToObj(copy, "/", 1);
+ } else {
+ TclpNativeJoinPath(copy, bytes);
+ }
+ return copy;
+}
/*
*---------------------------------------------------------------------------
@@ -1248,15 +1390,9 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
*
* Takes a path and a directory, where we _assume_ both path and
* directory are absolute, normalized and that the path lies inside the
- * directory. Returns a Tcl_Obj representing filename of the path
+ * directory. Returns a Tcl_Obj representing filename of the path
* relative to the directory.
*
- * In the case where the resulting path would start with a '~', we take
- * special care to return an ordinary string. This means to use that
- * path (and not have it interpreted as a user name), one must prepend
- * './'. This may seem strange, but that is how 'glob' is currently
- * defined.
- *
* Results:
* NULL on error, otherwise a valid object, typically with refCount of
* zero, which it is assumed the caller will increment.
@@ -1267,73 +1403,20 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclFSMakePathRelative(interp, pathPtr, cwdPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *pathPtr; /* The path we have. */
- Tcl_Obj *cwdPtr; /* Make it relative to this. */
+Tcl_Obj *
+TclFSMakePathRelative(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *pathPtr, /* The path we have. */
+ Tcl_Obj *cwdPtr) /* Make it relative to this. */
{
int cwdLen, len;
- CONST char *tempStr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ const char *tempStr;
if (pathPtr->typePtr == &tclFsPathType) {
- FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (PATHFLAGS(pathPtr) != 0
- && fsPathPtr->cwdPtr == cwdPtr) {
- pathPtr = fsPathPtr->normPathPtr;
-
- /*
- * Free old representation.
- */
+ FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't find object",
- "string representation", (char *) NULL);
- }
- return NULL;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
- /*
- * Now pathPtr is a string object.
- */
-
- if (Tcl_GetString(pathPtr)[0] == '~') {
- /*
- * If the first character of the path is a tilde, we must just
- * return the path as is, to agree with the defined behaviour
- * of 'glob'.
- */
- return pathPtr;
- }
-
- fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-
- /*
- * Circular reference, by design.
- */
-
- fsPathPtr->translatedPathPtr = pathPtr;
- fsPathPtr->normPathPtr = NULL;
- fsPathPtr->cwdPtr = cwdPtr;
- Tcl_IncrRefCount(cwdPtr);
- fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
- PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
- PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
-
- return pathPtr;
+ if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
+ return fsPathPtr->normPathPtr;
}
}
@@ -1376,7 +1459,7 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr)
/*
*---------------------------------------------------------------------------
*
- * TclFSMakePathFromNormalized --
+ * MakePathFromNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an absolute
* normalized path. Only for internal use.
@@ -1390,15 +1473,12 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr)
*---------------------------------------------------------------------------
*/
-int
-TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
- 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. */
+static int
+MakePathFromNormalized(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -1412,9 +1492,10 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
if (pathPtr->bytes == NULL) {
if (pathPtr->typePtr->updateStringProc == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't find object",
- "string representation", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find object string representation", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+ NULL);
}
return TCL_ERROR;
}
@@ -1423,7 +1504,7 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
/*
* It's a pure normalized absolute path.
@@ -1437,11 +1518,12 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
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();
- PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
+ SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
pathPtr->typePtr = &tclFsPathType;
@@ -1474,18 +1556,17 @@ TclFSMakePathFromNormalized(interp, pathPtr, nativeRep)
*/
Tcl_Obj *
-Tcl_FSNewNativePath(fromFilesystem, clientData)
- Tcl_Filesystem* fromFilesystem;
- ClientData clientData;
+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;
}
@@ -1505,7 +1586,7 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
TclFreeIntRep(pathPtr);
}
- fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+ fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
@@ -1516,11 +1597,10 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
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();
- PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
+ SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
pathPtr->typePtr = &tclFsPathType;
@@ -1546,10 +1626,10 @@ Tcl_FSNewNativePath(fromFilesystem, clientData)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSGetTranslatedPath(interp, pathPtr)
- Tcl_Interp *interp;
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSGetTranslatedPath(
+ Tcl_Interp *interp,
+ Tcl_Obj *pathPtr)
{
Tcl_Obj *retObj = NULL;
FsPath *srcFsPathPtr;
@@ -1557,14 +1637,37 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return NULL;
}
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ srcFsPathPtr = PATHOBJ(pathPtr);
if (srcFsPathPtr->translatedPathPtr == NULL) {
if (PATHFLAGS(pathPtr) != 0) {
- retObj = Tcl_FSGetNormalizedPath(interp, pathPtr);
+ /*
+ * We lack a translated path result, but we have a directory
+ * (cwdPtr) and a tail (normPathPtr), and if we join the
+ * translated version of cwdPtr to normPathPtr, we'll get the
+ * translated result we need, and can store it for future use.
+ */
+
+ Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
+ srcFsPathPtr->cwdPtr);
+ if (translatedCwdPtr == NULL) {
+ return NULL;
+ }
+
+ 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 {
/*
- * It is a pure absolute, normalized path object. This is
- * something like being a 'pure list'. The object's string,
+ * It is a pure absolute, normalized path object. This is
+ * something like being a 'pure list'. The object's string,
* translatedPath and normalizedPath are all identical.
*/
@@ -1578,7 +1681,9 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
retObj = srcFsPathPtr->translatedPathPtr;
}
- Tcl_IncrRefCount(retObj);
+ if (retObj != NULL) {
+ Tcl_IncrRefCount(retObj);
+ }
return retObj;
}
@@ -1601,20 +1706,19 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
*---------------------------------------------------------------------------
*/
-CONST char*
-Tcl_FSGetTranslatedStringPath(interp, pathPtr)
- Tcl_Interp *interp;
- Tcl_Obj* pathPtr;
+const char *
+Tcl_FSGetTranslatedStringPath(
+ Tcl_Interp *interp,
+ Tcl_Obj *pathPtr)
{
Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
if (transPtr != NULL) {
int len;
- CONST char *result, *orig;
+ const char *orig = Tcl_GetStringFromObj(transPtr, &len);
+ char *result = ckalloc(len+1);
- orig = Tcl_GetStringFromObj(transPtr, &len);
- result = (char*) ckalloc((unsigned)(len+1));
- memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
+ memcpy(result, orig, (size_t) len+1);
TclDecrRefCount(transPtr);
return result;
}
@@ -1635,23 +1739,23 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr)
* NULL or a valid path object pointer.
*
* Side effects:
- * New memory may be allocated. The Tcl 'errno' may be modified in the
+ * New memory may be allocated. The Tcl 'errno' may be modified in the
* process of trying to examine various path possibilities.
*
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSGetNormalizedPath(interp, pathPtr)
- Tcl_Interp *interp;
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSGetNormalizedPath(
+ Tcl_Interp *interp,
+ Tcl_Obj *pathPtr)
{
FsPath *fsPathPtr;
if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return NULL;
}
- fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0) {
/*
@@ -1660,70 +1764,77 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
*/
Tcl_Obj *dir, *copy;
- int cwdLen;
- int pathType;
- CONST char *cwdStr;
- ClientData clientData = NULL;
+ int tailLen, cwdLen, pathType;
pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
if (dir == NULL) {
return NULL;
}
+ /* TODO: Figure out why this is needed. */
if (pathPtr->bytes == NULL) {
UpdateStringOfFsPath(pathPtr);
}
- copy = Tcl_DuplicateObj(dir);
- Tcl_IncrRefCount(copy);
+
+ Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
+ if (tailLen) {
+ copy = AppendPath(dir, fsPathPtr->normPathPtr);
+ } else {
+ copy = Tcl_DuplicateObj(dir);
+ }
Tcl_IncrRefCount(dir);
+ Tcl_IncrRefCount(copy);
/*
* We now own a reference on both 'dir' and 'copy'
*/
- cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
+ (void) Tcl_GetStringFromObj(dir, &cwdLen);
+ cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
- /*
- * 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 cwdLen == 0 in this code path.
- */
+ /* Normalize the combined string. */
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- if (cwdStr[cwdLen-1] != '/') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- break;
- case TCL_PLATFORM_WINDOWS:
- if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- break;
- }
- Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
+ if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
+ /*
+ * If the "tail" part has components (like /../) that cause the
+ * combined path to need more complete normalizing, call on the
+ * more powerful routine to accomplish that so we avoid [Bug
+ * 2385549] ...
+ */
- /*
- * Normalize the combined string, but only starting after the end of
- * the previously normalized 'dir'. This should be much faster! We
- * use 'cwdLen-1' so that we are already pointing at the dir-separator
- * that we know about. The normalization code will actually start off
- * directly after that separator.
- */
+ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
- TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
- (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
+ Tcl_DecrRefCount(copy);
+ copy = newCopy;
+ } else {
+ /*
+ * ... but in most cases where we join a trouble free tail to a
+ * normalized head, we can more efficiently normalize the combined
+ * path by passing over only the unnormalized tail portion. When
+ * this is sufficient, prior developers claim this should be much
+ * faster. We use 'cwdLen-1' so that we are already pointing at
+ * the dir-separator that we know about. The normalization code
+ * will actually start off directly after that separator.
+ */
- /*
- * Now we need to construct the new path object
- */
+ TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
+ }
+
+ /* Now we need to construct the new path object. */
if (pathType == TCL_PATH_RELATIVE) {
- FsPath* origDirFsPathPtr;
Tcl_Obj *origDir = fsPathPtr->cwdPtr;
- origDirFsPathPtr = (FsPath*) PATHOBJ(origDir);
+
+ /*
+ * NOTE: here we are (dangerously?) assuming that origDir points
+ * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The
+ * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
+ * above that set the pathType value should have established that,
+ * but it's far less clear on what basis we know there's been no
+ * shimmering since then.
+ */
+
+ FsPath *origDirFsPathPtr = PATHOBJ(origDir);
fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
Tcl_IncrRefCount(fsPathPtr->cwdPtr);
@@ -1749,9 +1860,6 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
TclDecrRefCount(dir);
}
- if (clientData != NULL) {
- fsPathPtr->nativePathPtr = clientData;
- }
PATHFLAGS(pathPtr) = 0;
}
@@ -1765,60 +1873,32 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
- if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
+ if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
return NULL;
}
- fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ fsPathPtr = PATHOBJ(pathPtr);
} else if (fsPathPtr->normPathPtr == NULL) {
int cwdLen;
Tcl_Obj *copy;
- CONST char *cwdStr;
- ClientData clientData = NULL;
- copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
- Tcl_IncrRefCount(copy);
- cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
-
- /*
- * 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 cwdLen == 0 in
- * this code path.
- */
+ copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- if (cwdStr[cwdLen-1] != '/') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- break;
- case TCL_PLATFORM_WINDOWS:
- if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- break;
- }
- Tcl_AppendObjToObj(copy, pathPtr);
+ (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
+ cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
/*
* Normalize the combined string, but only starting after the end
* 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;
- if (clientData != NULL) {
- fsPathPtr->nativePathPtr = clientData;
- }
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr);
}
}
if (fsPathPtr->normPathPtr == NULL) {
- ClientData clientData = NULL;
Tcl_Obj *useThisCwd = NULL;
+ int pureNormalized = 1;
/*
* Since normPathPtr is NULL, but this is a valid path object, we know
@@ -1826,7 +1906,9 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
*/
Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
- CONST char *path = TclGetString(absolutePath);
+ const char *path = TclGetString(absolutePath);
+
+ Tcl_IncrRefCount(absolutePath);
/*
* We have to be a little bit careful here to avoid infinite loops
@@ -1835,7 +1917,20 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
* might loop back through here.
*/
- if (path[0] != '\0') {
+ if (path[0] == '\0') {
+ /*
+ * Special handling for the empty string value. This one is very
+ * weird with [file normalize {}] => {}. (The reasoning supporting
+ * this is unknown to DGP, but he fears changing it.) Attempt here
+ * to keep the expectations of other parts of Tcl_Filesystem code
+ * about state of the FsPath fields satisfied.
+ *
+ * In particular, capture the cwd value and save so it can be
+ * stored in the cwdPtr field below.
+ */
+
+ useThisCwd = Tcl_FSGetCwd(interp);
+ } else {
/*
* We don't ask for the type of 'pathPtr' here, because that is
* not correct for our purposes when we have a path like '~'. Tcl
@@ -1853,23 +1948,28 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
return NULL;
}
+ pureNormalized = 0;
+ Tcl_DecrRefCount(absolutePath);
absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
Tcl_IncrRefCount(absolutePath);
/*
* We have a refCount on the cwd.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
/*
* Only Windows has volume-relative paths.
*/
+
+ Tcl_DecrRefCount(absolutePath);
absolutePath = TclWinVolumeRelativeNormalize(interp,
path, &useThisCwd);
if (absolutePath == NULL) {
return NULL;
}
-#endif /* __WIN32__ */
+ pureNormalized = 0;
+#endif /* _WIN32 */
}
}
@@ -1878,21 +1978,20 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
*/
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
* is an absolute path).
*/
- if (useThisCwd == NULL) {
- if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
- TclGetString(pathPtr))) {
+ if (pureNormalized) {
+ int normPathLen, pathLen;
+ const char *normPath;
+
+ path = TclGetStringFromObj(pathPtr, &pathLen);
+ normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
+ if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
/*
* The path was already normalized. Get rid of the duplicate.
*/
@@ -1906,16 +2005,17 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
fsPathPtr->normPathPtr = pathPtr;
}
- } else {
+ }
+ if (useThisCwd != NULL) {
/*
* We just need to free an object we allocated above for relative
* paths (this was returned by Tcl_FSJoinToPath above), and then
* of course store the cwd.
*/
- TclDecrRefCount(absolutePath);
fsPathPtr->cwdPtr = useThisCwd;
}
+ TclDecrRefCount(absolutePath);
}
return fsPathPtr->normPathPtr;
@@ -1927,7 +2027,7 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
* Tcl_FSGetInternalRep --
*
* Extract the internal representation of a given path object, in the
- * given filesystem. If the path object belongs to a different
+ * given filesystem. If the path object belongs to a different
* filesystem, we return NULL.
*
* If the internal representation is currently NULL, we attempt to
@@ -1944,38 +2044,38 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
*/
ClientData
-Tcl_FSGetInternalRep(pathPtr, fsPtr)
- Tcl_Obj* pathPtr;
- Tcl_Filesystem *fsPtr;
+Tcl_FSGetInternalRep(
+ Tcl_Obj *pathPtr,
+ const Tcl_Filesystem *fsPtr)
{
- FsPath* srcFsPathPtr;
+ FsPath *srcFsPathPtr;
if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
return NULL;
}
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ srcFsPathPtr = PATHOBJ(pathPtr);
/*
* We will only return the native representation for the caller's
- * filesystem. Otherwise we will simply return NULL. This means that
- * there must be a unique bi-directional mapping between paths and
- * filesystems, and that this mapping will not allow 'remapped' files --
- * files which are in one filesystem but mapped into another. Another way
- * of putting this is that 'stacked' filesystems are not allowed. We
- * recognise that this is a potentially useful feature for the future.
+ * filesystem. Otherwise we will simply return NULL. This means that there
+ * must be a unique bi-directional mapping between paths and filesystems,
+ * and that this mapping will not allow 'remapped' files -- files which
+ * are in one filesystem but mapped into another. Another way of putting
+ * this is that 'stacked' filesystems are not allowed. We recognise that
+ * this is a potentially useful feature for the future.
*
* Even something simple like a 'pass through' filesystem which logs all
* activity and passes the calls onto the native system would be nice, but
* 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
* Tcl_FS.. functions should always have a filesystem already set.
* Whether this code path is legal or not depends on whether we decide
- * to allow external code to call the native filesystem directly. It
+ * to allow external code to call the native filesystem directly. It
* is at least safer to allow this sub-optimal routing.
*/
@@ -1988,8 +2088,8 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr)
* (e.g. from the Tcl testsuite).
*/
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- if (srcFsPathPtr->fsRecPtr == NULL) {
+ srcFsPathPtr = PATHOBJ(pathPtr);
+ if (srcFsPathPtr->fsPtr == NULL) {
return NULL;
}
}
@@ -1997,12 +2097,12 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr)
/*
* There is still one possibility we should consider; if the file belongs
* to a different filesystem, perhaps it is actually linked through to a
- * file in our own filesystem which we do care about. The way we can
- * check for this is we ask what filesystem this path belongs to.
+ * file in our own filesystem which we do care about. The way we can check
+ * for this is we ask what filesystem this path belongs to.
*/
- if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
- Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != srcFsPathPtr->fsPtr) {
+ const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
if (actualFs == fsPtr) {
return Tcl_FSGetInternalRep(pathPtr, fsPtr);
@@ -2012,12 +2112,16 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr)
if (srcFsPathPtr->nativePathPtr == NULL) {
Tcl_FSCreateInternalRepProc *proc;
- proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
+ char *nativePathPtr;
+ proc = srcFsPathPtr->fsPtr->createInternalRepProc;
if (proc == NULL) {
return NULL;
}
- srcFsPathPtr->nativePathPtr = (*proc)(pathPtr);
+
+ nativePathPtr = proc(pathPtr);
+ srcFsPathPtr = PATHOBJ(pathPtr);
+ srcFsPathPtr->nativePathPtr = nativePathPtr;
}
return srcFsPathPtr->nativePathPtr;
@@ -2042,17 +2146,17 @@ Tcl_FSGetInternalRep(pathPtr, fsPtr)
*/
int
-TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
- Tcl_Obj* pathPtr;
- Tcl_Filesystem **fsPtrPtr;
+TclFSEnsureEpochOk(
+ Tcl_Obj *pathPtr,
+ const Tcl_Filesystem **fsPtrPtr)
{
- FsPath* srcFsPathPtr;
+ FsPath *srcFsPathPtr;
if (pathPtr->typePtr != &tclFsPathType) {
return TCL_OK;
}
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ srcFsPathPtr = PATHOBJ(pathPtr);
/*
* Check if the filesystem has changed in some way since this object's
@@ -2068,19 +2172,18 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
UpdateStringOfFsPath(pathPtr);
}
FreeFsPathInternalRep(pathPtr);
- pathPtr->typePtr = NULL;
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ srcFsPathPtr = PATHOBJ(pathPtr);
}
/*
* 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;
}
@@ -2102,13 +2205,12 @@ TclFSEnsureEpochOk(pathPtr, fsPtrPtr)
*/
void
-TclFSSetPathDetails(pathPtr, fsRecPtr, clientData)
- Tcl_Obj *pathPtr;
- FilesystemRecord *fsRecPtr;
- ClientData clientData;
+TclFSSetPathDetails(
+ Tcl_Obj *pathPtr,
+ const Tcl_Filesystem *fsPtr,
+ ClientData clientData)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FsPath* srcFsPathPtr;
+ FsPath *srcFsPathPtr;
/*
* Make sure pathPtr is of the correct type.
@@ -2120,11 +2222,10 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData)
}
}
- srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- srcFsPathPtr->fsRecPtr = fsRecPtr;
+ srcFsPathPtr = PATHOBJ(pathPtr);
+ srcFsPathPtr->fsPtr = fsPtr;
srcFsPathPtr->nativePathPtr = clientData;
- srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
- fsRecPtr->fileRefCount++;
+ srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}
/*
@@ -2145,11 +2246,11 @@ TclFSSetPathDetails(pathPtr, fsRecPtr, clientData)
*/
int
-Tcl_FSEqualPaths(firstPtr, secondPtr)
- Tcl_Obj* firstPtr;
- Tcl_Obj* secondPtr;
+Tcl_FSEqualPaths(
+ Tcl_Obj *firstPtr,
+ Tcl_Obj *secondPtr)
{
- char *firstStr, *secondStr;
+ const char *firstStr, *secondStr;
int firstLen, secondLen, tempErrno;
if (firstPtr == secondPtr) {
@@ -2159,9 +2260,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr)
if (firstPtr == NULL || secondPtr == NULL) {
return 0;
}
- firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
- secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
- if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
+ firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+ secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+ if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
return 1;
}
@@ -2179,9 +2280,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr)
return 0;
}
- firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
- secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
- return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
+ firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+ secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+ return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
}
/*
@@ -2205,15 +2306,14 @@ Tcl_FSEqualPaths(firstPtr, secondPtr)
*/
static int
-SetFsPathFromAny(interp, pathPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *pathPtr; /* The object to convert. */
+SetFsPathFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *pathPtr) /* The object to convert. */
{
int len;
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -2240,14 +2340,16 @@ SetFsPathFromAny(interp, pathPtr)
*/
if (name[0] == '~') {
- char *expandedUser;
Tcl_DString temp;
int split;
- char separator='/';
+ char separator = '/';
split = FindSplitPos(name, separator);
if (split != len) {
- /* We have multiple pieces '~user/foo/bar...' */
+ /*
+ * We have multiple pieces '~user/foo/bar...'
+ */
+
name[split] = '\0';
}
@@ -2260,7 +2362,7 @@ SetFsPathFromAny(interp, pathPtr)
* We have just '~'
*/
- CONST char *dir;
+ const char *dir;
Tcl_DString dirString;
if (split != len) {
@@ -2270,9 +2372,11 @@ SetFsPathFromAny(interp, pathPtr)
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment ",
- "variable to expand path", (char *) 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;
}
@@ -2287,9 +2391,10 @@ SetFsPathFromAny(interp, pathPtr)
Tcl_DStringInit(&temp);
if (TclpGetUserHome(name+1, &temp) == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", (name+1),
- "\" doesn't exist", (char *) 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) {
@@ -2302,8 +2407,7 @@ SetFsPathFromAny(interp, pathPtr)
}
}
- expandedUser = Tcl_DStringValue(&temp);
- transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
+ transPtr = TclDStringToObj(&temp);
if (split != len) {
/*
@@ -2329,7 +2433,7 @@ SetFsPathFromAny(interp, pathPtr)
objc--; objv++;
while (objc--) {
- TclpNativeJoinPath(transPtr, TclGetString(*objv++));
+ TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
}
TclDecrRefCount(parts);
} else {
@@ -2348,65 +2452,46 @@ SetFsPathFromAny(interp, pathPtr)
transPtr = joined;
}
}
- Tcl_DStringFree(&temp);
} else {
- transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
+ transPtr = TclJoinPath(1, &pathPtr);
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
- {
- extern int cygwin_conv_to_win32_path(CONST char *, char *);
- 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);
- 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((unsigned)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.
*/
TclFreeIntRep(pathPtr);
- PATHOBJ(pathPtr) = (VOID *) fsPathPtr;
+ SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
pathPtr->typePtr = &tclFsPathType;
-
return TCL_OK;
}
static void
-FreeFsPathInternalRep(pathPtr)
- Tcl_Obj *pathPtr; /* Path object with internal rep to free. */
+FreeFsPathInternalRep(
+ Tcl_Obj *pathPtr) /* Path object with internal rep to free. */
{
- FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
+ FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (fsPathPtr->translatedPathPtr != NULL) {
if (fsPathPtr->translatedPathPtr != pathPtr) {
@@ -2422,83 +2507,73 @@ FreeFsPathInternalRep(pathPtr)
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);
+ 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;
}
static void
-DupFsPathInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Path obj with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Path obj with internal rep to set. */
+DupFsPathInternalRep(
+ Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */
{
- FsPath* srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr);
- FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath));
+ FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
+ FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));
- PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr;
+ 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 =
- (*dupProc)(srcFsPathPtr->nativePathPtr);
+ dupProc(srcFsPathPtr->nativePathPtr);
} else {
copyFsPathPtr->nativePathPtr = NULL;
}
} 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;
}
@@ -2520,11 +2595,10 @@ DupFsPathInternalRep(srcPtr, copyPtr)
*/
static void
-UpdateStringOfFsPath(pathPtr)
- register Tcl_Obj *pathPtr; /* path obj with string rep to update. */
+UpdateStringOfFsPath(
+ register Tcl_Obj *pathPtr) /* path obj with string rep to update. */
{
- FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr);
- CONST char *cwdStr;
+ FsPath *fsPathPtr = PATHOBJ(pathPtr);
int cwdLen;
Tcl_Obj *copy;
@@ -2532,42 +2606,8 @@ UpdateStringOfFsPath(pathPtr)
Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
}
- copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
- Tcl_IncrRefCount(copy);
-
- cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
-
- /*
- * 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 cwdLen == 0 in this code path.
- */
+ copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- if (cwdStr[cwdLen-1] != '/') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- break;
-
- case TCL_PLATFORM_WINDOWS:
- /*
- * We need the extra 'cwdLen != 2', and ':' checks because a volume
- * relative path doesn't get a '/'. For example 'glob C:*cat*.exe'
- * will return 'C:cat32.exe'
- */
-
- if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
- if (cwdLen != 2 || cwdStr[1] != ':') {
- Tcl_AppendToObj(copy, "/", 1);
- cwdLen++;
- }
- }
- break;
- }
-
- Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
pathPtr->length = cwdLen;
copy->bytes = tclEmptyStringRep;
@@ -2597,9 +2637,9 @@ UpdateStringOfFsPath(pathPtr)
*/
int
-TclNativePathInFilesystem(pathPtr, clientDataPtr)
- Tcl_Obj *pathPtr;
- ClientData *clientDataPtr;
+TclNativePathInFilesystem(
+ Tcl_Obj *pathPtr,
+ ClientData *clientDataPtr)
{
/*
* A special case is required to handle the empty path "". This is a valid
@@ -2613,8 +2653,10 @@ TclNativePathInFilesystem(pathPtr, clientDataPtr)
/*
* We reject the empty path "".
*/
+
return -1;
}
+
/*
* Otherwise there is no way this path can be empty.
*/
@@ -2627,11 +2669,12 @@ TclNativePathInFilesystem(pathPtr, clientDataPtr)
int len;
- Tcl_GetStringFromObj(pathPtr, &len);
+ (void) Tcl_GetStringFromObj(pathPtr, &len);
if (len == 0) {
/*
* We reject the empty path "".
*/
+
return -1;
}
}
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index f7bc038..83fb818 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclPipe.c --
*
* This file contains the generic portion of the command channel driver
@@ -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.12 2005/07/28 10:55:36 dkf Exp $
*/
#include "tclInt.h"
@@ -34,10 +32,10 @@ TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */
* Declarations for local functions defined in this file:
*/
-static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *spec, int atOk, CONST char *arg,
- CONST char *nextArg, int flags, int *skipPtr,
- int *closePtr, int *releasePtr));
+static TclFile FileForRedirect(Tcl_Interp *interp, const char *spec,
+ int atOk, const char *arg, const char *nextArg,
+ int flags, int *skipPtr, int *closePtr,
+ int *releasePtr);
/*
*----------------------------------------------------------------------
@@ -61,34 +59,33 @@ static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
*/
static TclFile
-FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
- releasePtr)
- Tcl_Interp *interp; /* Intepreter to use for error reporting. */
- CONST char *spec; /* Points to character just after redirection
+FileForRedirect(
+ Tcl_Interp *interp, /* Intepreter to use for error reporting. */
+ const char *spec, /* Points to character just after redirection
* character. */
- int atOK; /* Non-zero means that '@' notation can be
+ int atOK, /* Non-zero means that '@' notation can be
* used to specify a channel, zero means that
* it isn't. */
- CONST char *arg; /* Pointer to entire argument containing spec:
+ const char *arg, /* Pointer to entire argument containing spec:
* used for error reporting. */
- CONST char *nextArg; /* Next argument in argc/argv array, if needed
+ const char *nextArg, /* Next argument in argc/argv array, if needed
* for file name or channel name. May be
* NULL. */
- int flags; /* Flags to use for opening file or to specify
+ int flags, /* Flags to use for opening file or to specify
* mode for channel. */
- int *skipPtr; /* Filled with 1 if redirection target was in
+ int *skipPtr, /* Filled with 1 if redirection target was in
* spec, 2 if it was in nextArg. */
- int *closePtr; /* Filled with one if the caller should close
+ int *closePtr, /* Filled with one if the caller should close
* the file when done with it, zero
* otherwise. */
- int *releasePtr;
+ int *releasePtr)
{
int writing = (flags & O_WRONLY);
Tcl_Channel chan;
TclFile file;
*skipPtr = 1;
- if ((atOK != 0) && (*spec == '@')) {
+ if ((atOK != 0) && (*spec == '@')) {
spec++;
if (*spec == '\0') {
spec = nextArg;
@@ -97,17 +94,27 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
}
*skipPtr = 2;
}
- chan = Tcl_GetChannel(interp, spec, NULL);
- if (chan == (Tcl_Channel) NULL) {
- return NULL;
- }
+ chan = Tcl_GetChannel(interp, spec, NULL);
+ if (chan == (Tcl_Channel) NULL) {
+ return NULL;
+ }
file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
- if (file == NULL) {
- Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
- "\" wasn't opened for ",
- ((writing) ? "writing" : "reading"), (char *) NULL);
- return NULL;
- }
+ if (file == NULL) {
+ Tcl_Obj *msg;
+
+ Tcl_GetChannelError(chan, &msg);
+ if (msg) {
+ Tcl_SetObjResult(interp, msg);
+ } else {
+ 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;
+ }
*releasePtr = 1;
if (writing) {
/*
@@ -115,10 +122,10 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
* by the child appears after stuff we've already written.
*/
- Tcl_Flush(chan);
+ Tcl_Flush(chan);
}
} else {
- CONST char *name;
+ const char *name;
Tcl_DString nameString;
if (*spec == '\0') {
@@ -129,25 +136,26 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
*skipPtr = 2;
}
name = Tcl_TranslateFileName(interp, spec, &nameString);
- if (name != NULL) {
- file = TclpOpenFile(name, flags);
- } else {
- file = NULL;
+ if (name == NULL) {
+ return NULL;
}
+ file = TclpOpenFile(name, flags);
Tcl_DStringFree(&nameString);
if (file == NULL) {
- Tcl_AppendResult(interp, "couldn't ",
- ((writing) ? "write" : "read"), " file \"", spec, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't %s file \"%s\": %s",
+ (writing ? "write" : "read"), spec,
+ Tcl_PosixError(interp)));
return NULL;
}
- *closePtr = 1;
+ *closePtr = 1;
}
return file;
badLastArg:
- Tcl_AppendResult(interp, "can't specify \"", arg,
- "\" as last word in command", (char *) 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;
}
@@ -170,17 +178,17 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
*/
void
-Tcl_DetachPids(numPids, pidPtr)
- int numPids; /* Number of pids to detach: gives size of
+Tcl_DetachPids(
+ int numPids, /* Number of pids to detach: gives size of
* array pointed to by pidPtr. */
- Tcl_Pid *pidPtr; /* Array of pids to detach. */
+ Tcl_Pid *pidPtr) /* Array of pids to detach. */
{
register Detached *detPtr;
int i;
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;
@@ -209,7 +217,7 @@ Tcl_DetachPids(numPids, pidPtr)
*/
void
-Tcl_ReapDetachedProcs()
+Tcl_ReapDetachedProcs(void)
{
register Detached *detPtr;
Detached *nextPtr, *prevPtr;
@@ -230,7 +238,7 @@ Tcl_ReapDetachedProcs()
} else {
prevPtr->nextPtr = detPtr->nextPtr;
}
- ckfree((char *) detPtr);
+ ckfree(detPtr);
detPtr = nextPtr;
}
Tcl_MutexUnlock(&pipeMutex);
@@ -259,48 +267,48 @@ Tcl_ReapDetachedProcs()
*/
int
-TclCleanupChildren(interp, numPids, pidPtr, errorChan)
- Tcl_Interp *interp; /* Used for error messages. */
- int numPids; /* Number of entries in pidPtr array. */
- Tcl_Pid *pidPtr; /* Array of process ids of children. */
- Tcl_Channel errorChan; /* Channel for file containing stderr output
+TclCleanupChildren(
+ Tcl_Interp *interp, /* Used for error messages. */
+ int numPids, /* Number of entries in pidPtr array. */
+ Tcl_Pid *pidPtr, /* Array of process ids of children. */
+ Tcl_Channel errorChan) /* Channel for file containing stderr output
* from pipeline. NULL means there isn't any
* stderr output. */
{
int result = TCL_OK;
int i, abnormalExit, anyErrorInfo;
Tcl_Pid pid;
- WAIT_STATUS_TYPE waitStatus;
- CONST char *msg;
+ int waitStatus;
+ const char *msg;
unsigned long resolvedPid;
abnormalExit = 0;
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.
*/
resolvedPid = TclpGetPid(pidPtr[i]);
- pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
+ pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
if (pid == (Tcl_Pid) -1) {
result = TCL_ERROR;
- if (interp != (Tcl_Interp *) NULL) {
- msg = Tcl_PosixError(interp);
- if (errno == ECHILD) {
+ if (interp != NULL) {
+ msg = Tcl_PosixError(interp);
+ if (errno == ECHILD) {
/*
- * This changeup in message suggested by Mark Diekhans to
- * remind people that ECHILD errors can occur on some
- * systems if SIGCHLD isn't in its default state.
- */
-
- msg =
- "child process lost (is SIGCHLD ignored or trapped?)";
- }
- Tcl_AppendResult(interp, "error waiting for process to exit: ",
- msg, (char *) NULL);
- }
+ * This changeup in message suggested by Mark Diekhans to
+ * remind people that ECHILD errors can occur on some
+ * systems if SIGCHLD isn't in its default state.
+ */
+
+ msg =
+ "child process lost (is SIGCHLD ignored or trapped?)";
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error waiting for process to exit: %s", msg));
+ }
continue;
}
@@ -317,40 +325,32 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
result = TCL_ERROR;
sprintf(msg1, "%lu", resolvedPid);
if (WIFEXITED(waitStatus)) {
- if (interp != (Tcl_Interp *) NULL) {
- sprintf(msg2, "%hu", WEXITSTATUS(waitStatus));
- Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
- (char *) NULL);
- }
+ if (interp != NULL) {
+ sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
+ Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
+ }
abnormalExit = 1;
- } else if (WIFSIGNALED(waitStatus)) {
- if (interp != (Tcl_Interp *) NULL) {
- CONST char *p;
-
- p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
- Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
- Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
- (char *) NULL);
- Tcl_AppendResult(interp, "child killed: ", p, "\n",
- (char *) NULL);
- }
- } else if (WIFSTOPPED(waitStatus)) {
- if (interp != (Tcl_Interp *) NULL) {
- CONST char *p;
-
- p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
- Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
- Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
- p, (char *) NULL);
- Tcl_AppendResult(interp, "child suspended: ", p, "\n",
- (char *) NULL);
- }
- } else {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "child wait status didn't make sense\n",
- (char *) NULL);
- }
+ } else if (interp != NULL) {
+ const char *p;
+
+ if (WIFSIGNALED(waitStatus)) {
+ p = Tcl_SignalMsg(WTERMSIG(waitStatus));
+ Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
+ Tcl_SignalId(WTERMSIG(waitStatus)), p, 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "child suspended: %s\n", p));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child wait status didn't make sense\n", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+ "ODDWAITRESULT", msg1, NULL);
+ }
}
}
}
@@ -366,10 +366,10 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
* Make sure we start at the beginning of the file.
*/
- if (interp != NULL) {
+ if (interp != NULL) {
int count;
Tcl_Obj *objPtr;
-
+
Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
objPtr = Tcl_NewObj();
count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
@@ -377,8 +377,9 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
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);
@@ -396,8 +397,8 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
*/
if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
- Tcl_AppendResult(interp, "child process exited abnormally",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child process exited abnormally", -1));
}
return result;
}
@@ -432,30 +433,29 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
*/
int
-TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
- outPipePtr, errFilePtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- int argc; /* Number of entries in argv. */
- CONST char **argv; /* Array of strings describing commands in
+TclCreatePipeline(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ int argc, /* Number of entries in argv. */
+ const char **argv, /* Array of strings describing commands in
* pipeline plus I/O redirection with <, <<,
* >, etc. Argv[argc] must be NULL. */
- Tcl_Pid **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with
+ Tcl_Pid **pidArrayPtr, /* Word at *pidArrayPtr gets filled in with
* address of array of pids for processes in
* pipeline (first pid is first process in
* pipeline). */
- TclFile *inPipePtr; /* If non-NULL, input to the pipeline comes
+ TclFile *inPipePtr, /* If non-NULL, input to the pipeline comes
* from a pipe (unless overridden by
* redirection in the command). The file id
* with which to write to this pipe is stored
* at *inPipePtr. NULL means command specified
* its own input source. */
- TclFile *outPipePtr; /* If non-NULL, output to the pipeline goes to
+ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to
* a pipe, unless overriden by redirection in
* the command. The file id with which to read
* frome this pipe is stored at *outPipePtr.
* NULL means command specified its own output
* sink. */
- TclFile *errFilePtr; /* If non-NULL, all stderr output from the
+ TclFile *errFilePtr) /* If non-NULL, all stderr output from the
* pipeline will go to a temporary file
* created here, and a descriptor to read the
* file will be left at *errFilePtr. The file
@@ -472,7 +472,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* *pidPtr right now. */
int cmdCount; /* Count of number of distinct commands found
* in argc/argv. */
- CONST char *inputLiteral = NULL;
+ const char *inputLiteral = NULL;
/* If non-null, then this points to a string
* containing input data (specified via <<) to
* be piped to the first process in the
@@ -481,22 +481,23 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* first process in pipeline (specified via <
* or <@). */
int inputClose = 0; /* If non-zero, then inputFile should be
- * closed when cleaning up. */
+ * closed when cleaning up. */
int inputRelease = 0;
TclFile outputFile = NULL; /* Writable file for output from last command
* in pipeline (could be file or pipe). NULL
* means use stdout. */
int outputClose = 0; /* If non-zero, then outputFile should be
- * closed when cleaning up. */
+ * closed when cleaning up. */
int outputRelease = 0;
TclFile errorFile = NULL; /* Writable file for error output from all
* commands in pipeline. NULL means use
* stderr. */
int errorClose = 0; /* If non-zero, then errorFile should be
- * closed when cleaning up. */
+ * closed when cleaning up. */
int errorRelease = 0;
- CONST char *p;
- int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput = 0;
+ const char *p;
+ const char *nextArg;
+ int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0;
Tcl_DString execBuffer;
TclFile pipeIn;
TclFile curInFile, curOutFile, curErrFile;
@@ -513,7 +514,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
Tcl_DStringInit(&execBuffer);
-
+
pipeIn = NULL;
curInFile = NULL;
curOutFile = NULL;
@@ -534,6 +535,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
lastBar = -1;
cmdCount = 1;
+ needCmd = 1;
for (i = 0; i < argc; i++) {
errorToOutput = 0;
skip = 0;
@@ -545,13 +547,16 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
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;
}
}
lastBar = i;
cmdCount++;
+ needCmd = 1;
break;
case '<':
@@ -568,17 +573,21 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
inputLiteral = p + 1;
skip = 1;
if (*inputLiteral == '\0') {
- inputLiteral = argv[i + 1];
+ inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
if (inputLiteral == NULL) {
- Tcl_AppendResult(interp, "can't specify \"", argv[i],
- "\" as last word in command", (char *) 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;
}
} else {
+ nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
inputLiteral = NULL;
- inputFile = FileForRedirect(interp, p, 1, argv[i], argv[i+1],
+ inputFile = FileForRedirect(interp, p, 1, argv[i], nextArg,
O_RDONLY, &skip, &inputClose, &inputRelease);
if (inputFile == NULL) {
goto error;
@@ -630,7 +639,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
TclpReleaseFile(outputFile);
}
}
- outputFile = FileForRedirect(interp, p, atOK, argv[i], argv[i+1],
+ nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
+ outputFile = FileForRedirect(interp, p, atOK, argv[i], nextArg,
flags, &skip, &outputClose, &outputRelease);
if (outputFile == NULL) {
goto error;
@@ -676,21 +686,33 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
*/
if (i != argc-1) {
- Tcl_AppendResult(interp, "must specify \"", argv[i],
- "\" as last word in command", (char *) 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;
errorToOutput = 2;
skip = 1;
} else {
- errorFile = FileForRedirect(interp, p, atOK, argv[i],
- argv[i+1], flags, &skip, &errorClose, &errorRelease);
+ nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
+ errorFile = FileForRedirect(interp, p, atOK, argv[i],
+ nextArg, flags, &skip, &errorClose, &errorRelease);
if (errorFile == NULL) {
goto error;
}
}
break;
+
+ default:
+ /*
+ * Got a command word, not a redirection.
+ */
+
+ needCmd = 0;
+ break;
}
if (skip != 0) {
@@ -702,6 +724,18 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
}
+ if (needCmd) {
+ /*
+ * We had a bar followed only by redirections.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal use of | or |& in command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
+ NULL);
+ goto error;
+ }
+
if (inputFile == NULL) {
if (inputLiteral != NULL) {
/*
@@ -712,9 +746,9 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
inputFile = TclpCreateTempFile(inputLiteral);
if (inputFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create input file for command: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -725,9 +759,9 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
*/
if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create input pipe for command: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -754,9 +788,9 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
*/
if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create output pipe for command: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create output pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
outputClose = 1;
@@ -794,9 +828,9 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
errorFile = TclpCreateTempFile(NULL);
if (errorFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create error file for command: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create error file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
*errFilePtr = errorFile;
@@ -814,24 +848,24 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
}
}
-
+
/*
* Scan through the argc array, creating a process for each group of
* arguments between the "|" characters.
*/
Tcl_ReapDetachedProcs();
- pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
+ pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
curInFile = inputFile;
- for (i = 0; i < argc; i = lastArg + 1) {
+ for (i = 0; i < argc; i = lastArg + 1) {
int result, joinThisError;
Tcl_Pid pid;
- CONST char *oldName;
+ const char *oldName;
/*
- * Convert the program name into native form.
+ * Convert the program name into native form.
*/
if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
@@ -844,17 +878,17 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
joinThisError = 0;
for (lastArg = i; lastArg < argc; lastArg++) {
- if (argv[lastArg][0] == '|') {
- if (argv[lastArg][1] == '\0') {
- break;
- }
- if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
- joinThisError = 1;
- break;
- }
+ if (argv[lastArg][0] != '|') {
+ continue;
+ }
+ if (argv[lastArg][1] == '\0') {
+ break;
+ }
+ if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
+ joinThisError = 1;
+ break;
}
}
- argv[lastArg] = NULL;
/*
* If this is the last segment, use the specified outputFile.
@@ -862,12 +896,13 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* curInFile for the next segment of the pipe.
*/
- if (lastArg == argc) {
+ if (lastArg == argc) {
curOutFile = outputFile;
} else {
+ argv[lastArg] = NULL;
if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
- Tcl_AppendResult(interp, "couldn't create pipe: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create pipe: %s", Tcl_PosixError(interp)));
goto error;
}
}
@@ -882,7 +917,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* Restore argv[i], since a caller wouldn't expect the contents of
* argv to be modified.
*/
-
+
oldName = argv[i];
argv[i] = Tcl_DStringValue(&execBuffer);
result = TclpCreateProcess(interp, lastArg - i, argv + i,
@@ -973,7 +1008,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
Tcl_DetachPids(1, &pidPtr[i]);
}
}
- ckfree((char *) pidPtr);
+ ckfree(pidPtr);
}
numPids = -1;
goto cleanup;
@@ -1012,12 +1047,12 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
*/
Tcl_Channel
-Tcl_OpenCommandChannel(interp, argc, argv, flags)
- Tcl_Interp *interp; /* Interpreter for error reporting. Can NOT be
- * NULL. */
- int argc; /* How many arguments. */
- CONST char **argv; /* Array of arguments for command pipe. */
- int flags; /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
+Tcl_OpenCommandChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be
+ * NULL. */
+ int argc, /* How many arguments. */
+ const char **argv, /* Array of arguments for command pipe. */
+ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
* TCL_STDERR, and TCL_ENFORCE_MODE. */
{
TclFile *inPipePtr, *outPipePtr, *errFilePtr;
@@ -1031,9 +1066,9 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
-
+
numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
- outPipePtr, errFilePtr);
+ outPipePtr, errFilePtr);
if (numPids < 0) {
goto error;
@@ -1046,23 +1081,30 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
if (flags & TCL_ENFORCE_MODE) {
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
- Tcl_AppendResult(interp, "can't read output from command:",
- " standard output was redirected", (char *) 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", (char *) 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;
}
}
-
+
channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
numPids, pidPtr);
- if (channel == (Tcl_Channel) NULL) {
- Tcl_AppendResult(interp, "pipe for command could not be created",
- (char *) NULL);
+ if (channel == 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;
@@ -1070,7 +1112,7 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
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 397acd9..df90cea 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -5,11 +5,14 @@
* "package" command and a few C APIs.
*
* Copyright (c) 1996 Sun Microsystems, Inc.
+ * Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
*
* 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.12 2005/07/19 22:45:35 dkf Exp $
+ * TIP #268.
+ * Heavily rewritten to handle the extend version numbers, and extended
+ * package requirements.
*/
#include "tclInt.h"
@@ -23,7 +26,7 @@
typedef struct PkgAvail {
char *version; /* Version string; malloc'ed. */
char *script; /* Script to invoke to provide this version of
- * the package. Malloc'ed and protected by
+ * the package. Malloc'ed and protected by
* Tcl_Preserve and Tcl_Release. */
struct PkgAvail *nextPtr; /* Next in list of available versions of the
* same package. */
@@ -31,7 +34,7 @@ typedef struct PkgAvail {
/*
* For each package that is known in any way to an interpreter, there is one
- * record of the following type. These records are stored in the
+ * record of the following type. These records are stored in the
* "packageTable" hash table in the interpreter, keyed by package name such as
* "Tk" (no version number).
*/
@@ -39,30 +42,55 @@ typedef struct PkgAvail {
typedef struct Package {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
- * (malloc'ed). NULL means the package
- * doesn't exist in this interpreter yet. */
+ * (malloc'ed). NULL means the package doesn't
+ * exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
- ClientData clientData; /* Client data. */
+ const void *clientData; /* Client data. */
} Package;
/*
- * Prototypes for procedures defined in this file:
+ * Prototypes for functions defined in this file:
*/
-static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *string));
-static int ComparePkgVersions _ANSI_ARGS_((CONST char *v1,
- CONST char *v2, int *satPtr));
-static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *name));
+static int CheckVersionAndConvert(Tcl_Interp *interp,
+ const char *string, char **internal, int *stable);
+static int CompareVersions(char *v1i, char *v2i,
+ int *isMajorPtr);
+static int CheckRequirement(Tcl_Interp *interp,
+ const char *string);
+static int CheckAllRequirements(Tcl_Interp *interp, int reqc,
+ Tcl_Obj *const reqv[]);
+static int RequirementSatisfied(char *havei, const char *req);
+static int SomeRequirementSatisfied(char *havei, int reqc,
+ Tcl_Obj *const reqv[]);
+static void AddRequirementsToResult(Tcl_Interp *interp, int reqc,
+ Tcl_Obj *const reqv[]);
+static void AddRequirementsToDString(Tcl_DString *dstring,
+ int reqc, Tcl_Obj *const reqv[]);
+static Package * FindPackage(Tcl_Interp *interp, const char *name);
+static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
+ int reqc, Tcl_Obj *const reqv[],
+ void *clientDataPtr);
+
+/*
+ * Helper macros.
+ */
+
+#define DupBlock(v,s,len) \
+ ((v) = ckalloc(len), memcpy((v),(s),(len)))
+#define DupString(v,s) \
+ do { \
+ unsigned local__len = (unsigned) (strlen(s) + 1); \
+ DupBlock((v),(s),local__len); \
+ } while (0)
/*
*----------------------------------------------------------------------
*
* Tcl_PkgProvide / Tcl_PkgProvideEx --
*
- * This procedure is invoked to declare that a particular version of a
+ * This function is invoked to declare that a particular version of a
* particular package is now present in an interpreter. There must not be
* any other version of this package already provided in the interpreter.
*
@@ -78,54 +106,71 @@ static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
*----------------------------------------------------------------------
*/
+#undef Tcl_PkgProvide
int
-Tcl_PkgProvide(interp, name, version)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgProvide(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of package. */
- CONST char *version; /* Version string for package. */
+ const char *name, /* Name of package. */
+ const char *version) /* Version string for package. */
{
- return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
+ return Tcl_PkgProvideEx(interp, name, version, NULL);
}
int
-Tcl_PkgProvideEx(interp, name, version, clientData)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgProvideEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of package. */
- CONST char *version; /* Version string for package. */
- ClientData clientData; /* clientdata for this package (normally used
+ const char *name, /* Name of package. */
+ const char *version, /* Version string for package. */
+ const void *clientData) /* clientdata for this package (normally used
* for C callback function table) */
{
Package *pkgPtr;
+ char *pvi, *vi;
+ int res;
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version == NULL) {
- pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));
- strcpy(pkgPtr->version, version);
+ DupString(pkgPtr->version, version);
pkgPtr->clientData = clientData;
return TCL_OK;
}
- if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
+
+ if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
+ NULL) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
+ ckfree(pvi);
+ return TCL_ERROR;
+ }
+
+ res = CompareVersions(pvi, vi, NULL);
+ ckfree(pvi);
+ ckfree(vi);
+
+ if (res == 0) {
if (clientData != NULL) {
pkgPtr->clientData = clientData;
}
return TCL_OK;
}
- Tcl_AppendResult(interp, "conflicting versions provided for package \"",
- name, "\": ", pkgPtr->version, ", then ", version, (char *) 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;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgRequire / Tcl_PkgRequireEx --
+ * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
*
- * This procedure is called by code that depends on a particular version
+ * This function is called by code that depends on a particular version
* of a particular package. If the package is not already provided in the
- * interpreter, this procedure invokes a Tcl script to provide it. If the
- * package is already provided, this procedure makes sure that the
+ * interpreter, this function invokes a Tcl script to provide it. If the
+ * package is already provided, this function makes sure that the
* caller's needs don't conflict with the version that is present.
*
* Results:
@@ -144,40 +189,38 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_PkgRequire(interp, name, version, exact)
- Tcl_Interp *interp; /* Interpreter in which package is now
+#undef Tcl_PkgRequire
+const char *
+Tcl_PkgRequire(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ const char *name, /* Name of desired package. */
+ const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact) /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
{
- return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
+ return Tcl_PkgRequireEx(interp, name, version, exact, NULL);
}
-CONST char *
-Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
- Tcl_Interp *interp; /* Interpreter in which package is now
+const char *
+Tcl_PkgRequireEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ const char *name, /* Name of desired package. */
+ const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- ClientData *clientDataPtr; /* Used to return the client data for this
+ void *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
{
- Package *pkgPtr;
- PkgAvail *availPtr, *bestPtr;
- char *script;
- int code, satisfies, result, pass;
- Tcl_DString command;
+ Tcl_Obj *ov;
+ const char *result = NULL;
/*
* If an attempt is being made to load this into a standalone executable
@@ -189,7 +232,6 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*/
if (tclEmptyStringRep == NULL) {
-
/*
* OK, so what's going on here?
*
@@ -245,9 +287,78 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*/
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;
+ }
+
+ /*
+ * Translate between old and new API, and defer to the new function.
+ */
+
+ if (version == NULL) {
+ result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
+ } else {
+ if (exact && TCL_OK
+ != CheckVersionAndConvert(interp, version, NULL, NULL)) {
+ return NULL;
+ }
+ ov = Tcl_NewStringObj(version, -1);
+ if (exact) {
+ Tcl_AppendStringsToObj(ov, "-", version, NULL);
+ }
+ Tcl_IncrRefCount(ov);
+ result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
+ TclDecrRefCount(ov);
+ }
+
+ return result;
+}
+
+int
+Tcl_PkgRequireProc(
+ Tcl_Interp *interp, /* Interpreter in which package is now
+ * available. */
+ const char *name, /* Name of desired package. */
+ int reqc, /* Requirements constraining the desired
+ * version. */
+ Tcl_Obj *const reqv[], /* 0 means to use the latest version
+ * available. */
+ void *clientDataPtr)
+{
+ const char *result =
+ PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
+
+ if (result == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
+ return TCL_OK;
+}
+
+static const char *
+PkgRequireCore(
+ Tcl_Interp *interp, /* Interpreter in which package is now
+ * available. */
+ const char *name, /* Name of desired package. */
+ int reqc, /* Requirements constraining the desired
+ * version. */
+ Tcl_Obj *const reqv[], /* 0 means to use the latest version
+ * available. */
+ void *clientDataPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Package *pkgPtr;
+ PkgAvail *availPtr, *bestPtr, *bestStablePtr;
+ char *availVersion, *bestVersion;
+ /* Internal rep. of versions */
+ int availStable, code, satisfies, pass;
+ char *script, *pkgVersionI;
+ Tcl_DString command;
+
+ if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
return NULL;
}
@@ -258,62 +369,216 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
* the "package ifneeded" script.
*/
- for (pass = 1; ; pass++) {
+ for (pass=1 ;; pass++) {
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version != NULL) {
break;
}
/*
- * The package isn't yet present. Search the list of available
- * versions and invoke the script for the best available version.
+ * Check whether we're already attempting to load some version of this
+ * package (circular dependency detection).
+ */
+
+ if (pkgPtr->clientData != 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;
+ }
+
+ /*
+ * The package isn't yet present. Search the list of available
+ * versions and invoke the script for the best available version. We
+ * are actually locating the best, and the best stable version. One of
+ * them is then chosen based on the selection mode.
*/
bestPtr = NULL;
+ bestStablePtr = NULL;
+ bestVersion = NULL;
+
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
- if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
- bestPtr->version, (int *) NULL) <= 0)) {
+ if (CheckVersionAndConvert(interp, availPtr->version,
+ &availVersion, &availStable) != TCL_OK) {
+ /*
+ * The provided version number has invalid syntax. This
+ * should not happen. This should have been caught by the
+ * 'package ifneeded' registering the package.
+ */
+
continue;
}
- if (version != NULL) {
- result = ComparePkgVersions(availPtr->version, version,
- &satisfies);
- if ((result != 0) && exact) {
+
+ if (bestPtr != NULL) {
+ int res = CompareVersions(availVersion, bestVersion, NULL);
+
+ /*
+ * Note: Use internal reps!
+ */
+
+ if (res <= 0) {
+ /*
+ * The version of the package sought is not as good as the
+ * currently selected version. Ignore it.
+ */
+
+ ckfree(availVersion);
+ availVersion = NULL;
continue;
}
+ }
+
+ /*
+ * We have found a version which is better than our max.
+ */
+
+ if (reqc > 0) {
+ /* Check satisfaction of requirements. */
+
+ satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
if (!satisfies) {
+ ckfree(availVersion);
+ availVersion = NULL;
continue;
}
}
+
bestPtr = availPtr;
+
+ if (bestVersion != NULL) {
+ ckfree(bestVersion);
+ }
+ bestVersion = availVersion;
+
+ /*
+ * If this new best version is stable then it also has to be
+ * better than the max stable version found so far.
+ */
+
+ if (availStable) {
+ bestStablePtr = availPtr;
+ }
}
+
+ if (bestVersion != NULL) {
+ ckfree(bestVersion);
+ }
+
+ /*
+ * Now choose a version among the two best. For 'latest' we simply
+ * take (actually keep) the best. For 'stable' we take the best
+ * stable, if there is any, or the best if there is nothing stable.
+ */
+
+ if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
+ && (bestStablePtr != NULL)) {
+ bestPtr = bestStablePtr;
+ }
+
if (bestPtr != NULL) {
/*
- * We found an ifneeded script for the package. Be careful while
+ * We found an ifneeded script for the package. Be careful while
* executing it: this could cause reentrancy, so (a) protect the
* script itself from deletion and (b) don't assume that bestPtr
* will still exist when the script completes.
*/
+ char *versionToProvide = bestPtr->version;
script = bestPtr->script;
- Tcl_Preserve((ClientData) script);
- code = Tcl_GlobalEval(interp, script);
- Tcl_Release((ClientData) script);
+
+ pkgPtr->clientData = versionToProvide;
+ Tcl_Preserve(script);
+ Tcl_Preserve(versionToProvide);
+ code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
+ Tcl_Release(script);
+
+ pkgPtr = FindPackage(interp, name);
+ if (code == TCL_OK) {
+ Tcl_ResetResult(interp);
+ if (pkgPtr->version == NULL) {
+ code = TCL_ERROR;
+ 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;
+
+ if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
+ NULL) != TCL_OK) {
+ code = TCL_ERROR;
+ } else if (CheckVersionAndConvert(interp,
+ versionToProvide, &vi, NULL) != TCL_OK) {
+ ckfree(pvi);
+ code = TCL_ERROR;
+ } else {
+ int res = CompareVersions(pvi, vi, NULL);
+
+ ckfree(pvi);
+ ckfree(vi);
+ if (res != 0) {
+ code = TCL_ERROR;
+ 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_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;
+ }
+
+ if (code == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"package ifneeded %s %s\" script)",
+ name, versionToProvide));
+ }
+ Tcl_Release(versionToProvide);
+
if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddErrorInfo(interp,
- "\n (\"package ifneeded\" script)");
+ /*
+ * Take a non-TCL_OK code from the script as an indication the
+ * package wasn't loaded properly, so the package system
+ * should not remember an improper load.
+ *
+ * This is consistent with our returning NULL. If we're not
+ * willing to tell our caller we got a particular version, we
+ * shouldn't store that version for telling future callers
+ * either.
+ */
+
+ if (pkgPtr->version != NULL) {
+ ckfree(pkgPtr->version);
+ pkgPtr->version = NULL;
}
+ pkgPtr->clientData = NULL;
return NULL;
}
- Tcl_ResetResult(interp);
- pkgPtr = FindPackage(interp, name);
+
break;
}
/*
- * Package not in the database. If there is a "package unknown"
+ * The package is not in the database. If there is a "package unknown"
* command, invoke it (but only on the first pass; after that, we
* should not get here in the first place).
*/
@@ -321,24 +586,27 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
if (pass > 1) {
break;
}
+
script = ((Interp *) interp)->packageUnknown;
if (script != NULL) {
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, script, -1);
Tcl_DStringAppendElement(&command, name);
- Tcl_DStringAppend(&command, " ", 1);
- Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
- -1);
- if (exact) {
- Tcl_DStringAppend(&command, " -exact", 7);
- }
- code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
+ AddRequirementsToDString(&command, reqc, reqv);
+
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
+ Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
Tcl_DStringFree(&command);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddErrorInfo(interp,
- "\n (\"package unknown\" script)");
- }
+
+ if ((code != TCL_OK) && (code != TCL_ERROR)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad return code: %d", code));
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+ code = TCL_ERROR;
+ }
+ if (code == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (\"package unknown\" script)");
return NULL;
}
Tcl_ResetResult(interp);
@@ -346,41 +614,46 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
}
if (pkgPtr->version == NULL) {
- Tcl_AppendResult(interp, "can't find package ", name,
- (char *) NULL);
- if (version != NULL) {
- Tcl_AppendResult(interp, " ", version, (char *) 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;
}
/*
- * At this point we know that the package is present. Make sure that the
- * provided version meets the current requirement.
+ * At this point we know that the package is present. Make sure that the
+ * provided version meets the current requirements.
*/
- if (version == NULL) {
- if (clientDataPtr) {
- *clientDataPtr = pkgPtr->clientData;
+ if (reqc != 0) {
+ CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
+ satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
+
+ ckfree(pkgVersionI);
+
+ 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;
}
- result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
- if ((satisfies && !exact) || (result == 0)) {
- if (clientDataPtr) {
- *clientDataPtr = pkgPtr->clientData;
- }
- return pkgPtr->version;
+
+ if (clientDataPtr) {
+ const void **ptr = (const void **) clientDataPtr;
+
+ *ptr = pkgPtr->clientData;
}
- Tcl_AppendResult(interp, "version conflict for package \"",
- name, "\": have ", pkgPtr->version, ", need ", version,
- (char *) NULL);
- return NULL;
+ return pkgPtr->version;
}
/*
*----------------------------------------------------------------------
- *q
+ *
* Tcl_PkgPresent / Tcl_PkgPresentEx --
*
* Checks to see whether the specified package is present. If it is not
@@ -399,31 +672,32 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_PkgPresent(interp, name, version, exact)
- Tcl_Interp *interp; /* Interpreter in which package is now
+#undef Tcl_PkgPresent
+const char *
+Tcl_PkgPresent(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ const char *name, /* Name of desired package. */
+ const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact) /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
{
- return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
+ return Tcl_PkgPresentEx(interp, name, version, exact, NULL);
}
-CONST char *
-Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
- Tcl_Interp *interp; /* Interpreter in which package is now
+const char *
+Tcl_PkgPresentEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ const char *name, /* Name of desired package. */
+ const char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- ClientData *clientDataPtr; /* Used to return the client data for this
+ void *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
@@ -431,46 +705,36 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
Package *pkgPtr;
- int satisfies, result;
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
if (hPtr) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
/*
* At this point we know that the package is present. Make sure
- * that the provided version meets the current requirement.
+ * that the provided version meets the current requirement by
+ * calling Tcl_PkgRequireEx() to check for us.
*/
- if (version == NULL) {
- if (clientDataPtr) {
- *clientDataPtr = pkgPtr->clientData;
- }
-
- return pkgPtr->version;
- }
- result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
- if ((satisfies && !exact) || (result == 0)) {
- if (clientDataPtr) {
- *clientDataPtr = pkgPtr->clientData;
- }
+ const char *foundVersion = Tcl_PkgRequireEx(interp, name, version,
+ exact, clientDataPtr);
- return pkgPtr->version;
+ if (foundVersion == NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
+ NULL);
}
- Tcl_AppendResult(interp, "version conflict for package \"", name,
- "\": have ", pkgPtr->version, ", need ", version,
- (char *) NULL);
- return NULL;
+ return foundVersion;
}
}
if (version != NULL) {
- Tcl_AppendResult(interp, "package ", name, " ", version,
- " is not present", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s %s is not present", name, version));
} else {
- Tcl_AppendResult(interp, "package ", name, " is not present",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s is not present", name));
}
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
return NULL;
}
@@ -479,8 +743,8 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
*
* Tcl_PackageObjCmd --
*
- * This procedure is invoked to process the "package" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "package" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -493,20 +757,21 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
/* ARGSUSED */
int
-Tcl_PackageObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_PackageObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- static CONST char *pkgOptions[] = {
- "forget", "ifneeded", "names", "present", "provide", "require",
- "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL
+ static const char *const pkgOptions[] = {
+ "forget", "ifneeded", "names", "prefer", "present",
+ "provide", "require", "unknown", "vcompare", "versions",
+ "vsatisfies", NULL
};
enum pkgOptions {
- PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT,
- PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
- PKG_VERSIONS, PKG_VSATISFIES
+ PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT,
+ PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
+ PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
int optionIndex, exact, i, satisfies;
@@ -515,11 +780,12 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *tablePtr;
- CONST char *version;
- char *argv2, *argv3, *argv4;
+ const char *version;
+ const char *argv2, *argv3, *argv4;
+ char *iva = NULL, *ivb = NULL;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
@@ -529,15 +795,15 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
}
switch ((enum pkgOptions) optionIndex) {
case PKG_FORGET: {
- char *keyString;
+ const char *keyString;
for (i = 2; i < objc; i++) {
- keyString = Tcl_GetString(objv[i]);
+ keyString = TclGetString(objv[i]);
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
continue;
}
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ pkgPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
@@ -545,54 +811,70 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
- ckfree(availPtr->version);
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
+ Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
+ Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ ckfree(availPtr);
}
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
break;
}
case PKG_IFNEEDED: {
- int length;
+ int length, res;
+ char *argv3i, *avi;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
return TCL_ERROR;
}
- argv3 = Tcl_GetString(objv[3]);
- if (CheckVersion(interp, argv3) != TCL_OK) {
+ argv3 = TclGetString(objv[3]);
+ if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
return TCL_ERROR;
}
- argv2 = Tcl_GetString(objv[2]);
+ argv2 = TclGetString(objv[2]);
if (objc == 4) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr == NULL) {
+ ckfree(argv3i);
return TCL_OK;
}
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ pkgPtr = Tcl_GetHashValue(hPtr);
} else {
pkgPtr = FindPackage(interp, argv2);
}
argv3 = Tcl_GetStringFromObj(objv[3], &length);
+
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
prevPtr = availPtr, availPtr = availPtr->nextPtr) {
- if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)==0){
+ if (CheckVersionAndConvert(interp, availPtr->version, &avi,
+ NULL) != TCL_OK) {
+ ckfree(argv3i);
+ return TCL_ERROR;
+ }
+
+ res = CompareVersions(avi, argv3i, NULL);
+ ckfree(avi);
+
+ if (res == 0){
if (objc == 4) {
- Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+ ckfree(argv3i);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(availPtr->script, -1));
return TCL_OK;
}
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
break;
}
}
+ ckfree(argv3i);
+
if (objc == 4) {
return TCL_OK;
}
if (availPtr == NULL) {
- availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
- availPtr->version = ckalloc((unsigned) (length + 1));
- strcpy(availPtr->version, argv3);
+ availPtr = ckalloc(sizeof(PkgAvail));
+ DupBlock(availPtr->version, argv3, (unsigned) length + 1);
+
if (prevPtr == NULL) {
availPtr->nextPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr;
@@ -602,115 +884,151 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
}
}
argv4 = Tcl_GetStringFromObj(objv[4], &length);
- availPtr->script = ckalloc((unsigned) (length + 1));
- strcpy(availPtr->script, argv4);
+ DupBlock(availPtr->script, argv4, (unsigned) length + 1);
break;
}
case PKG_NAMES:
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 = (Package *) 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:
+ case PKG_PRESENT: {
+ const char *name;
+
if (objc < 3) {
- presentSyntax:
- Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
- return TCL_ERROR;
+ goto require;
}
- argv2 = Tcl_GetString(objv[2]);
+ argv2 = TclGetString(objv[2]);
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ if (objc != 5) {
+ goto requireSyntax;
+ }
exact = 1;
+ name = TclGetString(objv[3]);
} else {
exact = 0;
+ name = argv2;
}
- version = NULL;
- if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
- if (CheckVersion(interp, version) != TCL_OK) {
- return TCL_ERROR;
+
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
+ if (hPtr != NULL) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ if (pkgPtr->version != NULL) {
+ goto require;
}
- } else if ((objc != 3) || exact) {
- goto presentSyntax;
}
+
+ version = NULL;
if (exact) {
- argv3 = Tcl_GetString(objv[3]);
- version = Tcl_PkgPresent(interp, argv3, version, exact);
+ version = TclGetString(objv[4]);
+ if (CheckVersionAndConvert(interp, version, NULL,
+ NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
} else {
- version = Tcl_PkgPresent(interp, argv2, version, exact);
- }
- if (version == NULL) {
- return TCL_ERROR;
+ if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((objc > 3) && (CheckVersionAndConvert(interp,
+ TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
+ version = TclGetString(objv[3]);
+ }
}
- Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL);
+ return TCL_ERROR;
break;
+ }
case PKG_PROVIDE:
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
return TCL_ERROR;
}
- argv2 = Tcl_GetString(objv[2]);
+ argv2 = TclGetString(objv[2]);
if (objc == 3) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr != NULL) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ 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;
}
- argv3 = Tcl_GetString(objv[3]);
- if (CheckVersion(interp, argv3) != TCL_OK) {
+ argv3 = TclGetString(objv[3]);
+ if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_PkgProvide(interp, argv2, argv3);
+ return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
case PKG_REQUIRE:
+ require:
if (objc < 3) {
requireSyntax:
- Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-exact? package ?requirement ...?");
return TCL_ERROR;
}
- argv2 = Tcl_GetString(objv[2]);
- if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
- exact = 1;
- } else {
- exact = 0;
- }
+
version = NULL;
- if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
- if (CheckVersion(interp, version) != TCL_OK) {
+
+ argv2 = TclGetString(objv[2]);
+ if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ Tcl_Obj *ov;
+ int res;
+
+ if (objc != 5) {
+ goto requireSyntax;
+ }
+
+ version = TclGetString(objv[4]);
+ if (CheckVersionAndConvert(interp, version, NULL,
+ NULL) != TCL_OK) {
return TCL_ERROR;
}
- } else if ((objc != 3) || exact) {
- goto requireSyntax;
- }
- if (exact) {
- argv3 = Tcl_GetString(objv[3]);
- version = Tcl_PkgRequire(interp, argv3, version, exact);
+
+ /*
+ * Create a new-style requirement for the exact version.
+ */
+
+ ov = Tcl_NewStringObj(version, -1);
+ Tcl_AppendStringsToObj(ov, "-", version, NULL);
+ version = NULL;
+ argv3 = TclGetString(objv[3]);
+
+ Tcl_IncrRefCount(ov);
+ res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
+ TclDecrRefCount(ov);
+ return res;
} else {
- version = Tcl_PkgRequire(interp, argv2, version, exact);
- }
- if (version == NULL) {
- return TCL_ERROR;
+ if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(version, -1));
break;
case PKG_UNKNOWN: {
int length;
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) {
@@ -720,8 +1038,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
if (argv2[0] == 0) {
iPtr->packageUnknown = NULL;
} else {
- iPtr->packageUnknown = (char *) ckalloc((unsigned) (length+1));
- strcpy(iPtr->packageUnknown, argv2);
+ DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
}
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?command?");
@@ -729,49 +1046,114 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
}
break;
}
+ case PKG_PREFER: {
+ static const char *const pkgPreferOptions[] = {
+ "latest", "stable", NULL
+ };
+
+ /*
+ * See tclInt.h for the enum, just before Interp.
+ */
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?");
+ return TCL_ERROR;
+ } else if (objc == 3) {
+ /*
+ * Seting the value.
+ */
+
+ int newPref;
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions,
+ "preference", 0, &newPref) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (newPref < iPtr->packagePrefer) {
+ iPtr->packagePrefer = newPref;
+ }
+ }
+
+ /*
+ * Always return current value.
+ */
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1));
+ break;
+ }
case PKG_VCOMPARE:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
return TCL_ERROR;
}
- argv3 = Tcl_GetString(objv[3]);
- argv2 = Tcl_GetString(objv[2]);
- if ((CheckVersion(interp, argv2) != TCL_OK)
- || (CheckVersion(interp, argv3) != TCL_OK)) {
+ argv3 = TclGetString(objv[3]);
+ argv2 = TclGetString(objv[2]);
+ if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
+ CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
+ if (iva != NULL) {
+ ckfree(iva);
+ }
+
+ /*
+ * ivb cannot be set in this branch.
+ */
+
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- ComparePkgVersions(argv2, argv3, (int *) NULL)));
+
+ /*
+ * Comparison is done on the internal representation.
+ */
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
+ ckfree(iva);
+ ckfree(ivb);
break;
case PKG_VERSIONS:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "package");
return TCL_ERROR;
- }
- argv2 = Tcl_GetString(objv[2]);
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr != NULL) {
- pkgPtr = (Package *) 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:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
+ case PKG_VSATISFIES: {
+ char *argv2i = NULL;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
return TCL_ERROR;
}
- argv3 = Tcl_GetString(objv[3]);
- argv2 = Tcl_GetString(objv[2]);
- if ((CheckVersion(interp, argv2) != TCL_OK)
- || (CheckVersion(interp, argv3) != TCL_OK)) {
+
+ argv2 = TclGetString(objv[2]);
+ if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
+ ckfree(argv2i);
return TCL_ERROR;
}
- ComparePkgVersions(argv2, argv3, &satisfies);
+
+ satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
+ ckfree(argv2i);
+
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
break;
+ }
default:
Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
}
@@ -783,7 +1165,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
*
* FindPackage --
*
- * This procedure finds the Package record for a particular package in a
+ * This function finds the Package record for a particular package in a
* particular interpreter, creating a record if one doesn't already
* exist.
*
@@ -797,24 +1179,24 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
*/
static Package *
-FindPackage(interp, name)
- Tcl_Interp *interp; /* Interpreter to use for package lookup. */
- CONST char *name; /* Name of package to fine. */
+FindPackage(
+ Tcl_Interp *interp, /* Interpreter to use for package lookup. */
+ const char *name) /* Name of package to fine. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
Package *pkgPtr;
- hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
- if (new) {
- pkgPtr = (Package *) ckalloc(sizeof(Package));
+ hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
+ if (isNew) {
+ pkgPtr = ckalloc(sizeof(Package));
pkgPtr->version = NULL;
pkgPtr->availPtr = NULL;
pkgPtr->clientData = NULL;
Tcl_SetHashValue(hPtr, pkgPtr);
} else {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ pkgPtr = Tcl_GetHashValue(hPtr);
}
return pkgPtr;
}
@@ -824,8 +1206,8 @@ FindPackage(interp, name)
*
* TclFreePackageInfo --
*
- * This procedure is called during interpreter deletion to free all of
- * the package-related information for the interpreter.
+ * This function is called during interpreter deletion to free all of the
+ * package-related information for the interpreter.
*
* Results:
* None.
@@ -837,8 +1219,8 @@ FindPackage(interp, name)
*/
void
-TclFreePackageInfo(iPtr)
- Interp *iPtr; /* Interpereter that is being deleted. */
+TclFreePackageInfo(
+ Interp *iPtr) /* Interpereter that is being deleted. */
{
Package *pkgPtr;
Tcl_HashSearch search;
@@ -846,19 +1228,19 @@ TclFreePackageInfo(iPtr)
PkgAvail *availPtr;
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
- ckfree(availPtr->version);
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
+ Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
+ Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ ckfree(availPtr);
}
- ckfree((char *) pkgPtr);
+ ckfree(pkgPtr);
}
Tcl_DeleteHashTable(&iPtr->packageTable);
if (iPtr->packageUnknown != NULL) {
@@ -869,10 +1251,11 @@ TclFreePackageInfo(iPtr)
/*
*----------------------------------------------------------------------
*
- * CheckVersion --
+ * CheckVersionAndConvert --
*
- * This procedure checks to see whether a version number has valid
- * syntax.
+ * This function checks to see whether a version number has valid syntax.
+ * It also generates a semi-internal representation (string rep of a list
+ * of numbers).
*
* Results:
* If string is a properly formed version number the TCL_OK is returned.
@@ -886,45 +1269,115 @@ TclFreePackageInfo(iPtr)
*/
static int
-CheckVersion(interp, string)
- Tcl_Interp *interp; /* Used for error reporting. */
- CONST char *string; /* Supposedly a version number, which is
+CheckVersionAndConvert(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *string, /* Supposedly a version number, which is
* groups of decimal digits separated by
* dots. */
+ char **internal, /* Internal normalized representation */
+ int *stable) /* Flag: Version is (un)stable. */
{
- CONST char *p = string;
+ const char *p = string;
char prevChar;
+ int hasunstable = 0;
+ /*
+ * 4* assuming that each char is a separator (a,b become ' -x ').
+ * 4+ to have spce for an additional -2 at the end
+ */
+ char *ibuf = ckalloc(4 + 4*strlen(string));
+ char *ip = ibuf;
+
+ /*
+ * Basic rules
+ * (1) First character has to be a digit.
+ * (2) All other characters have to be a digit or '.'
+ * (3) Two '.'s may not follow each other.
+ *
+ * TIP 268, Modified rules
+ * (1) s.a.
+ * (2) All other characters have to be a digit, 'a', 'b', or '.'
+ * (3) s.a.
+ * (4) Only one of 'a' or 'b' may occur.
+ * (5) Neither 'a', nor 'b' may occur before or after a '.'
+ */
- if (!isdigit(UCHAR(*p))) { /* INTL: digit */
+ if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
+
+ *ip++ = *p;
+
for (prevChar = *p, p++; *p != 0; p++) {
- if (!isdigit(UCHAR(*p)) &&
- ((*p != '.') || (prevChar == '.'))) { /* INTL: digit */
+ if (!isdigit(UCHAR(*p)) && /* INTL: digit */
+ ((*p!='.' && *p!='a' && *p!='b') ||
+ ((hasunstable && (*p=='a' || *p=='b')) ||
+ ((prevChar=='a' || prevChar=='b' || prevChar=='.')
+ && (*p=='.')) ||
+ ((*p=='a' || *p=='b' || *p=='.') && prevChar=='.')))) {
goto error;
}
+
+ if (*p == 'a' || *p == 'b') {
+ hasunstable = 1;
+ }
+
+ /*
+ * Translation to the internal rep. Regular version chars are copied
+ * as is. The separators are translated to numerics. The new separator
+ * for all parts is space.
+ */
+
+ if (*p == '.') {
+ *ip++ = ' ';
+ *ip++ = '0';
+ *ip++ = ' ';
+ } else if (*p == 'a') {
+ *ip++ = ' ';
+ *ip++ = '-';
+ *ip++ = '2';
+ *ip++ = ' ';
+ } else if (*p == 'b') {
+ *ip++ = ' ';
+ *ip++ = '-';
+ *ip++ = '1';
+ *ip++ = ' ';
+ } else {
+ *ip++ = *p;
+ }
+
prevChar = *p;
}
- if (prevChar != '.') {
+ if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
+ *ip = '\0';
+ if (internal != NULL) {
+ *internal = ibuf;
+ } else {
+ ckfree(ibuf);
+ }
+ if (stable != NULL) {
+ *stable = !hasunstable;
+ }
return TCL_OK;
}
error:
- Tcl_AppendResult(interp, "expected version number but got \"", string,
- "\"", (char *) NULL);
+ ckfree(ibuf);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected version number but got \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * ComparePkgVersions --
+ * CompareVersions --
*
- * This procedure compares two version numbers.
+ * This function compares two version numbers (in internal rep).
*
* Results:
* The return value is -1 if v1 is less than v2, 0 if the two version
- * numbers are the same, and 1 if v1 is greater than v2. If *satPtr is
+ * numbers are the same, and 1 if v1 is greater than v2. If *satPtr is
* non-NULL, the word it points to is filled in with 1 if v2 >= v1 and
* both numbers have the same major number or 0 otherwise.
*
@@ -935,71 +1388,533 @@ CheckVersion(interp, string)
*/
static int
-ComparePkgVersions(v1, v2, satPtr)
- CONST char *v1;
- CONST char *v2; /* Versions strings, of form 2.1.3 (any number
+CompareVersions(
+ char *v1, char *v2, /* Versions strings, of form 2.1.3 (any number
* of version numbers). */
- int *satPtr; /* If non-null, the word pointed to is filled
- * in with a 0/1 value. 1 means v1 "satisfies"
- * v2: v1 is greater than or equal to v2 and
- * both version numbers have the same major
- * number. */
+ int *isMajorPtr) /* If non-null, the word pointed to is filled
+ * in with a 0/1 value. 1 means that the
+ * difference occured in the first element. */
{
- int thisIsMajor, n1, n2;
+ int thisIsMajor, res, flip;
+ char *s1, *e1, *s2, *e2, o1, o2;
/*
* Each iteration of the following loop processes one number from each
- * string, terminated by a ".". If those numbers don't match then the
- * comparison is over; otherwise, we loop back for the next number.
+ * string, terminated by a " " (space). If those numbers don't match then
+ * the comparison is over; otherwise, we loop back for the next number.
+ *
+ * TIP 268.
+ * This is identical the function 'ComparePkgVersion', but using the new
+ * space separator as used by the internal rep of version numbers. The
+ * special separators 'a' and 'b' have already been dealt with in
+ * 'CheckVersionAndConvert', they were translated into numbers as well.
+ * This keeps the comparison sane. Otherwise we would have to compare
+ * numerics, the separators, and also deal with the special case of
+ * end-of-string compared to separators. The semi-list rep we get here is
+ * much easier to handle, as it is still regular.
+ *
+ * Rewritten to not compute a numeric value for the extracted version
+ * number, but do string comparison. Skip any leading zeros for that to
+ * work. This change breaks through the 32bit-limit on version numbers.
*/
thisIsMajor = 1;
+ s1 = v1;
+ s2 = v2;
+
while (1) {
/*
- * Parse one decimal number from the front of each string.
+ * Parse one decimal number from the front of each string. Skip
+ * leading zeros. Terminate found number for upcoming string-wise
+ * comparison, if needed.
*/
- n1 = n2 = 0;
- while ((*v1 != 0) && (*v1 != '.')) {
- n1 = 10*n1 + (*v1 - '0');
- v1++;
+ while ((*s1 != 0) && (*s1 == '0')) {
+ s1++;
+ }
+ while ((*s2 != 0) && (*s2 == '0')) {
+ s2++;
}
- while ((*v2 != 0) && (*v2 != '.')) {
- n2 = 10*n2 + (*v2 - '0');
- v2++;
+
+ /*
+ * s1, s2 now point to the beginnings of the numbers to compare. Test
+ * for their signs first, as shortcut to the result (different signs),
+ * or determines if result has to be flipped (both negative). If there
+ * is no shortcut we have to insert terminators later to limit the
+ * strcmp.
+ */
+
+ if ((*s1 == '-') && (*s2 != '-')) {
+ /* s1 < 0, s2 >= 0 => s1 < s2 */
+ res = -1;
+ break;
+ }
+ if ((*s1 != '-') && (*s2 == '-')) {
+ /* s1 >= 0, s2 < 0 => s1 > s2 */
+ res = 1;
+ break;
+ }
+
+ if ((*s1 == '-') && (*s2 == '-')) {
+ /* a < b => -a > -b, etc. */
+ s1++;
+ s2++;
+ flip = 1;
+ } else {
+ flip = 0;
+ }
+
+ /*
+ * The string comparison is needed, so now we determine where the
+ * numbers end.
+ */
+
+ e1 = s1;
+ while ((*e1 != 0) && (*e1 != ' ')) {
+ e1++;
+ }
+ e2 = s2;
+ while ((*e2 != 0) && (*e2 != ' ')) {
+ e2++;
+ }
+
+ /*
+ * s1 .. e1 and s2 .. e2 now bracket the numbers to compare. Insert
+ * terminators, compare, and restore actual contents. First however
+ * another shortcut. Compare lengths. Shorter string is smaller
+ * number! Thus we strcmp only strings of identical length.
+ */
+
+ if ((e1-s1) < (e2-s2)) {
+ res = -1;
+ } else if ((e2-s2) < (e1-s1)) {
+ res = 1;
+ } else {
+ o1 = *e1;
+ *e1 = '\0';
+ o2 = *e2;
+ *e2 = '\0';
+
+ res = strcmp(s1, s2);
+ res = (res < 0) ? -1 : (res ? 1 : 0);
+
+ *e1 = o1;
+ *e2 = o2;
}
/*
- * Compare and go on to the next version number if the current numbers
- * match.
+ * Stop comparing segments when a difference has been found. Here we
+ * may have to flip the result to account for signs.
*/
- if (n1 != n2) {
+ if (res != 0) {
+ if (flip) {
+ res = -res;
+ }
break;
}
- if (*v1 != 0) {
- v1++;
- } else if (*v2 == 0) {
+
+ /*
+ * Go on to the next version number if the current numbers match.
+ * However stop processing if the end of both numbers has been
+ * reached.
+ */
+
+ s1 = e1;
+ s2 = e2;
+
+ if (*s1 != 0) {
+ s1++;
+ } else if (*s2 == 0) {
+ /*
+ * s1, s2 both at the end => identical
+ */
+
+ res = 0;
break;
}
- if (*v2 != 0) {
- v2++;
+ if (*s2 != 0) {
+ s2++;
}
thisIsMajor = 0;
}
- if (satPtr != NULL) {
- *satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);
+
+ if (isMajorPtr != NULL) {
+ *isMajorPtr = thisIsMajor;
+ }
+
+ return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckAllRequirements --
+ *
+ * This function checks to see whether all requirements in a set have
+ * valid syntax.
+ *
+ * Results:
+ * TCL_OK is returned if all requirements are valid. Otherwise TCL_ERROR
+ * is returned and an error message is left in the interp's result.
+ *
+ * Side effects:
+ * May modify the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckAllRequirements(
+ Tcl_Interp *interp,
+ int reqc, /* Requirements to check. */
+ Tcl_Obj *const reqv[])
+{
+ int i;
+
+ for (i = 0; i < reqc; i++) {
+ if ((CheckRequirement(interp, TclGetString(reqv[i])) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckRequirement --
+ *
+ * This function checks to see whether a requirement has valid syntax.
+ *
+ * Results:
+ * If string is a properly formed requirement then TCL_OK is returned.
+ * Otherwise TCL_ERROR is returned and an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckRequirement(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ const char *string) /* Supposedly a requirement. */
+{
+ /*
+ * Syntax of requirement = version
+ * = version-version
+ * = version-
+ */
+
+ char *dash = NULL, *buf;
+
+ dash = strchr(string, '-');
+ if (dash == NULL) {
+ /*
+ * No dash found, has to be a simple version.
+ */
+
+ return CheckVersionAndConvert(interp, string, NULL, NULL);
+ }
+
+ if (strchr(dash+1, '-') != NULL) {
+ /*
+ * More dashes found after the first. This is wrong.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected versionMin-versionMax but got \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Exactly one dash is present. Copy the string, split at the location of
+ * dash and check that both parts are versions. Note that the max part can
+ * be empty. Also note that the string allocated with strdup() must be
+ * freed with free() and not ckfree().
+ */
+
+ DupString(buf, string);
+ dash = buf + (dash - string);
+ *dash = '\0'; /* buf now <=> min part */
+ dash++; /* dash now <=> max part */
+
+ if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
+ ((*dash != '\0') &&
+ (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
+ ckfree(buf);
+ return TCL_ERROR;
+ }
+
+ ckfree(buf);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddRequirementsToResult --
+ *
+ * This function accumulates requirements in the interpreter result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter result is extended.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AddRequirementsToResult(
+ Tcl_Interp *interp,
+ int reqc, /* Requirements constraining the desired
+ * version. */
+ Tcl_Obj *const reqv[]) /* 0 means to use the latest version
+ * available. */
+{
+ Tcl_Obj *result = Tcl_GetObjResult(interp);
+ int 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_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
+ } else {
+ Tcl_AppendPrintfToObj(result, " %s", v);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddRequirementsToDString --
+ *
+ * This function accumulates requirements in a DString.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The DString argument is extended.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AddRequirementsToDString(
+ Tcl_DString *dsPtr,
+ int reqc, /* Requirements constraining the desired
+ * version. */
+ Tcl_Obj *const reqv[]) /* 0 means to use the latest version
+ * available. */
+{
+ int i;
+
+ if (reqc > 0) {
+ for (i = 0; i < reqc; i++) {
+ TclDStringAppendLiteral(dsPtr, " ");
+ TclDStringAppendObj(dsPtr, reqv[i]);
+ }
+ } else {
+ TclDStringAppendLiteral(dsPtr, " 0-");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SomeRequirementSatisfied --
+ *
+ * This function checks to see whether a version satisfies at least one
+ * of a set of requirements.
+ *
+ * Results:
+ * If the requirements are satisfied 1 is returned. Otherwise 0 is
+ * returned. The function assumes that all pieces have valid syntax. And
+ * is allowed to make that assumption.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SomeRequirementSatisfied(
+ char *availVersionI, /* Candidate version to check against the
+ * requirements. */
+ int reqc, /* Requirements constraining the desired
+ * version. */
+ Tcl_Obj *const reqv[]) /* 0 means to use the latest version
+ * available. */
+{
+ int i;
+
+ for (i = 0; i < reqc; i++) {
+ if (RequirementSatisfied(availVersionI, TclGetString(reqv[i]))) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RequirementSatisfied --
+ *
+ * This function checks to see whether a version satisfies a requirement.
+ *
+ * Results:
+ * If the requirement is satisfied 1 is returned. Otherwise 0 is
+ * returned. The function assumes that all pieces have valid syntax, and
+ * is allowed to make that assumption.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RequirementSatisfied(
+ char *havei, /* Version string, of candidate package we
+ * have. */
+ const char *req) /* Requirement string the candidate has to
+ * satisfy. */
+{
+ /*
+ * The have candidate is already in internal rep.
+ */
+
+ int satisfied, res;
+ char *dash = NULL, *buf, *min, *max;
+
+ dash = strchr(req, '-');
+ if (dash == NULL) {
+ /*
+ * No dash found, is a simple version, fallback to regular check. The
+ * 'CheckVersionAndConvert' cannot fail. We pad the requirement with
+ * 'a0', i.e '-2' before doing the comparison to properly accept
+ * unstables as well.
+ */
+
+ char *reqi = NULL;
+ int thisIsMajor;
+
+ CheckVersionAndConvert(NULL, req, &reqi, NULL);
+ strcat(reqi, " -2");
+ res = CompareVersions(havei, reqi, &thisIsMajor);
+ satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
+ ckfree(reqi);
+ return satisfied;
+ }
+
+ /*
+ * Exactly one dash is present (Assumption of valid syntax). Copy the req,
+ * split at the location of dash and check that both parts are versions.
+ * Note that the max part can be empty.
+ */
+
+ DupString(buf, req);
+ dash = buf + (dash - req);
+ *dash = '\0'; /* buf now <=> min part */
+ dash++; /* dash now <=> max part */
+
+ if (*dash == '\0') {
+ /*
+ * We have a min, but no max. For the comparison we generate the
+ * internal rep, padded with 'a0' i.e. '-2'.
+ */
+
+ CheckVersionAndConvert(NULL, buf, &min, NULL);
+ strcat(min, " -2");
+ satisfied = (CompareVersions(havei, min, NULL) >= 0);
+ ckfree(min);
+ ckfree(buf);
+ return satisfied;
}
- if (n1 > n2) {
- return 1;
- } else if (n1 == n2) {
- return 0;
+
+ /*
+ * We have both min and max, and generate their internal reps. When
+ * identical we compare as is, otherwise we pad with 'a0' to ove the range
+ * a bit.
+ */
+
+ CheckVersionAndConvert(NULL, buf, &min, NULL);
+ CheckVersionAndConvert(NULL, dash, &max, NULL);
+
+ if (CompareVersions(min, max, NULL) == 0) {
+ satisfied = (CompareVersions(min, havei, NULL) == 0);
} else {
- return -1;
+ strcat(min, " -2");
+ strcat(max, " -2");
+ satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
+ (CompareVersions(havei, max, NULL) < 0));
}
+
+ ckfree(min);
+ ckfree(max);
+ ckfree(buf);
+ return satisfied;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PkgInitStubsCheck --
+ *
+ * This is a replacement routine for Tcl_InitStubs() that is called
+ * from code where -DUSE_TCL_STUBS has not been enabled.
+ *
+ * Results:
+ * Returns the version of a conforming stubs table, or NULL, if
+ * the table version doesn't satisfy the requested requirements,
+ * according to historical practice.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tcl_PkgInitStubsCheck(
+ Tcl_Interp *interp,
+ const char * version,
+ int exact)
+{
+ const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
+
+ if (exact && actualVersion) {
+ const char *p = version;
+ int count = 0;
+
+ while (*p) {
+ count += !isdigit(UCHAR(*p++));
+ }
+ if (count == 1) {
+ if (0 != strncmp(version, actualVersion, strlen(version))) {
+ /* Construct error message */
+ Tcl_PkgPresent(interp, "Tcl", version, 1);
+ return NULL;
+ }
+ } else {
+ return Tcl_PkgPresent(interp, "Tcl", version, 1);
+ }
+ }
+ return actualVersion;
+}
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index b339607..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.3 2005/07/21 14:38:50 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"
@@ -90,7 +88,7 @@
# define CFG_PROFILED "0"
#endif
-static Tcl_Config cfg[] = {
+static Tcl_Config const cfg[] = {
{"debug", CFG_DEBUG},
{"threaded", CFG_THREADED},
{"profiled", CFG_PROFILED},
@@ -121,8 +119,8 @@ static Tcl_Config cfg[] = {
};
void
-TclInitEmbeddedConfigurationInformation(interp)
- Tcl_Interp* interp; /* Interpreter the configuration command is
+TclInitEmbeddedConfigurationInformation(
+ Tcl_Interp *interp) /* Interpreter the configuration command is
* registered in. */
{
Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING);
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index 6dc83e0..abc8ee8 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.24 2004/11/03 19:13:40 davygrvy Exp $
*/
#ifndef _TCLPLATDECLS
@@ -24,113 +22,95 @@
#endif
/*
- * Pull in the typedef of TCHAR for windows.
+ * 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/tcl.decls script.
*/
-#if defined(__CYGWIN__)
- typedef char TCHAR;
-#elif defined(__WIN32__) && !defined(_TCHAR_DEFINED)
-# include <tchar.h>
-# ifndef _TCHAR_DEFINED
- /* Borland seems to forget to set this. */
- typedef _TCHAR TCHAR;
-# define _TCHAR_DEFINED
-# endif
-# if defined(_MSC_VER) && defined(__STDC__)
- /* MSVC++ misses this. */
- typedef _TCHAR TCHAR;
+
+/*
+ * 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(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
+# if defined(_UNICODE)
+ typedef wchar_t TCHAR;
+# else
+ typedef char TCHAR;
# endif
+# define _TCHAR_DEFINED
#endif
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#ifdef __WIN32__
-#ifndef Tcl_WinUtfToTChar_TCL_DECLARED
-#define Tcl_WinUtfToTChar_TCL_DECLARED
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
-EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char * str,
- int len, Tcl_DString * dsPtr));
-#endif
-#ifndef Tcl_WinTCharToUtf_TCL_DECLARED
-#define Tcl_WinTCharToUtf_TCL_DECLARED
+EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
+ Tcl_DString *dsPtr);
/* 1 */
-EXTERN char * Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR * str,
- int len, Tcl_DString * dsPtr));
-#endif
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
-#ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED
-#define Tcl_MacOSXOpenBundleResources_TCL_DECLARED
+EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
+ Tcl_DString *dsPtr);
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
-EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * bundleName,
- int hasResourceFile, int maxPathLen,
- char * libraryPath));
-#endif
-#ifndef Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
-#define Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
+EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
+ const char *bundleName, int hasResourceFile,
+ int maxPathLen, char *libraryPath);
/* 1 */
-EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_((
- Tcl_Interp * interp, CONST char * bundleName,
- CONST char * bundleVersion,
- int hasResourceFile, int maxPathLen,
- char * libraryPath));
-#endif
-#endif /* MAC_OSX_TCL */
+EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
+ Tcl_Interp *interp, const char *bundleName,
+ const char *bundleVersion,
+ int hasResourceFile, int maxPathLen,
+ char *libraryPath);
+#endif /* MACOSX */
typedef struct TclPlatStubs {
int magic;
- struct TclPlatStubHooks *hooks;
-
-#ifdef __WIN32__
- TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char * str, int len, Tcl_DString * dsPtr)); /* 0 */
- char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR * str, int len, Tcl_DString * dsPtr)); /* 1 */
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
- int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 0 */
- int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 1 */
-#endif /* MAC_OSX_TCL */
+ void *hooks;
+
+#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 */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
+ int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
+#endif /* MACOSX */
} TclPlatStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern TclPlatStubs *tclPlatStubsPtr;
+extern const TclPlatStubs *tclPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
-#ifdef __WIN32__
-#ifndef Tcl_WinUtfToTChar
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
-#endif
-#ifndef Tcl_WinTCharToUtf
#define Tcl_WinTCharToUtf \
(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
-#endif
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
-#ifndef Tcl_MacOSXOpenBundleResources
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
-#endif
-#ifndef Tcl_MacOSXOpenVersionedBundleResources
#define Tcl_MacOSXOpenVersionedBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
-#endif
-#endif /* MAC_OSX_TCL */
+#endif /* MACOSX */
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
diff --git a/generic/tclPort.h b/generic/tclPort.h
index ad98823..12a60db 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.15 2005/05/10 18:34:47 kennykb Exp $
*/
#ifndef _TCLPORT
@@ -19,13 +17,12 @@
#ifdef HAVE_TCL_CONFIG_H
#include "tclConfig.h"
#endif
-#include "tcl.h"
-
-#if defined(__WIN32__)
-# include "../win/tclWinPort.h"
+#if defined(_WIN32)
+# include "tclWinPort.h"
#else
# include "tclUnixPort.h"
#endif
+#include "tcl.h"
#if !defined(LLONG_MIN)
# ifdef TCL_WIDE_INT_IS_LONG
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index 7cb2bdb..411eb27 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclPosixStr.c --
*
* This file contains procedures that generate strings corresponding to
@@ -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.11 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -33,11 +31,11 @@
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_ErrnoId()
+const char *
+Tcl_ErrnoId(void)
{
switch (errno) {
-#ifdef E2BIG
+#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
case E2BIG: return "E2BIG";
#endif
#ifdef EACCES
@@ -61,7 +59,7 @@ Tcl_ErrnoId()
#ifdef EALIGN
case EALIGN: return "EALIGN";
#endif
-#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
case EALREADY: return "EALREADY";
#endif
#ifdef EBADE
@@ -76,6 +74,9 @@ Tcl_ErrnoId()
#ifdef EBADMSG
case EBADMSG: return "EBADMSG";
#endif
+#ifdef ECANCELED
+ case ECANCELED: return "ECANCELED";
+#endif
#ifdef EBADR
case EBADR: return "EBADR";
#endif
@@ -202,7 +203,7 @@ Tcl_ErrnoId()
#ifdef ELIBEXEC
case ELIBEXEC: return "ELIBEXEC";
#endif
-#ifdef ELIBMAX
+#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
case ELIBMAX: return "ELIBMAX";
#endif
#ifdef ELIBSCN
@@ -310,6 +311,9 @@ Tcl_ErrnoId()
#ifdef ENOTCONN
case ENOTCONN: return "ENOTCONN";
#endif
+#ifdef ENOTRECOVERABLE
+ case ENOTRECOVERABLE: return "ENOTRECOVERABLE";
+#endif
#ifdef ENOTDIR
case ENOTDIR: return "ENOTDIR";
#endif
@@ -337,9 +341,15 @@ Tcl_ErrnoId()
#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
-#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
+#ifdef EOTHER
+ case EOTHER: return "EOTHER";
+#endif
+#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
case EOVERFLOW: return "EOVERFLOW";
#endif
+#ifdef EOWNERDEAD
+ case EOWNERDEAD: return "EOWNERDEAD";
+#endif
#ifdef EPERM
case EPERM: return "EPERM";
#endif
@@ -479,12 +489,12 @@ Tcl_ErrnoId()
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_ErrnoMsg(err)
- int err; /* Error number (such as in errno variable). */
+const char *
+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
@@ -494,13 +504,13 @@ Tcl_ErrnoMsg(err)
case EADDRINUSE: return "address already in use";
#endif
#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL: return "can't assign requested address";
+ case EADDRNOTAVAIL: return "cannot assign requested address";
#endif
#ifdef EADV
case EADV: return "advertise error";
#endif
#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT: return "address family not supported by protocol family";
+ case EAFNOSUPPORT: return "address family not supported by protocol";
#endif
#ifdef EAGAIN
case EAGAIN: return "resource temporarily unavailable";
@@ -508,7 +518,7 @@ Tcl_ErrnoMsg(err)
#ifdef EALIGN
case EALIGN: return "EALIGN";
#endif
-#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
+#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
case EALREADY: return "operation already in progress";
#endif
#ifdef EBADE
@@ -523,6 +533,9 @@ Tcl_ErrnoMsg(err)
#ifdef EBADMSG
case EBADMSG: return "not a data message";
#endif
+#ifdef ECANCELED
+ case ECANCELED: return "operation canceled";
+#endif
#ifdef EBADR
case EBADR: return "bad request descriptor";
#endif
@@ -641,17 +654,17 @@ Tcl_ErrnoMsg(err)
case EL3RST: return "level 3 reset";
#endif
#ifdef ELIBACC
- case ELIBACC: return "can not access a needed shared library";
+ case ELIBACC: return "cannot access a needed shared library";
#endif
#ifdef ELIBBAD
case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
- case ELIBEXEC: return "can not exec a shared library directly";
+ 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";
+ "attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
case ELIBSCN: return ".lib section in a.out corrupted";
@@ -720,7 +733,7 @@ Tcl_ErrnoMsg(err)
case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
- case ENOLINK: return "link has be severed";
+ case ENOLINK: return "link has been severed";
#endif
#ifdef ENOMEM
case ENOMEM: return "not enough memory";
@@ -758,6 +771,9 @@ Tcl_ErrnoMsg(err)
#ifdef ENOTCONN
case ENOTCONN: return "socket is not connected";
#endif
+#ifdef ENOTRECOVERABLE
+ case ENOTRECOVERABLE: return "state not recoverable";
+#endif
#ifdef ENOTDIR
case ENOTDIR: return "not a directory";
#endif
@@ -785,9 +801,15 @@ Tcl_ErrnoMsg(err)
#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "operation not supported on socket";
#endif
-#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
+#ifdef EOTHER
+ case EOTHER: return "other error";
+#endif
+#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
case EOVERFLOW: return "file too big";
#endif
+#ifdef EOWNERDEAD
+ case EOWNERDEAD: return "owner died";
+#endif
#ifdef EPERM
case EPERM: return "not owner";
#endif
@@ -813,7 +835,7 @@ Tcl_ErrnoMsg(err)
case EPROTO: return "protocol error";
#endif
#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT: return "protocol not suppored";
+ case EPROTONOSUPPORT: return "protocol not supported";
#endif
#ifdef EPROTOTYPE
case EPROTOTYPE: return "protocol wrong type for socket";
@@ -849,7 +871,7 @@ Tcl_ErrnoMsg(err)
case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
- case ESHUTDOWN: return "can't send afer socket shutdown";
+ case ESHUTDOWN: return "cannot send after socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
case ESOCKTNOSUPPORT: return "socket type not supported";
@@ -876,7 +898,7 @@ Tcl_ErrnoMsg(err)
case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
- case ETOOMANYREFS: return "too many references: can't splice";
+ case ETOOMANYREFS: return "too many references: cannot splice";
#endif
#ifdef ETXTBSY
case ETXTBSY: return "text file or pseudo-device busy";
@@ -906,7 +928,7 @@ Tcl_ErrnoMsg(err)
#ifdef NO_STRERROR
return "unknown POSIX error";
#else
- return strerror(errno);
+ return strerror(err);
#endif
}
}
@@ -929,9 +951,9 @@ Tcl_ErrnoMsg(err)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_SignalId(sig)
- int sig; /* Number of signal. */
+const char *
+Tcl_SignalId(
+ int sig) /* Number of signal. */
{
switch (sig) {
#ifdef SIGABRT
@@ -994,7 +1016,7 @@ Tcl_SignalId(sig)
#ifdef SIGQUIT
case SIGQUIT: return "SIGQUIT";
#endif
-#ifdef SIGSEGV
+#if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS))
case SIGSEGV: return "SIGSEGV";
#endif
#ifdef SIGSTOP
@@ -1039,6 +1061,9 @@ Tcl_SignalId(sig)
#ifdef SIGXFSZ
case SIGXFSZ: return "SIGXFSZ";
#endif
+#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
+ case SIGINFO: return "SIGINFO";
+#endif
}
return "unknown signal";
}
@@ -1060,9 +1085,9 @@ Tcl_SignalId(sig)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_SignalMsg(sig)
- int sig; /* Number of signal. */
+const char *
+Tcl_SignalMsg(
+ int sig) /* Number of signal. */
{
switch (sig) {
#ifdef SIGABRT
@@ -1125,7 +1150,7 @@ Tcl_SignalMsg(sig)
#ifdef SIGQUIT
case SIGQUIT: return "quit signal";
#endif
-#ifdef SIGSEGV
+#if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS))
case SIGSEGV: return "segmentation violation";
#endif
#ifdef SIGSTOP
@@ -1170,6 +1195,9 @@ Tcl_SignalMsg(sig)
#ifdef SIGXFSZ
case SIGXFSZ: return "exceeded file size limit";
#endif
+#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
+ case SIGINFO: return "information request";
+#endif
}
return "unknown signal";
}
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 8281bc4..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.7 2005/07/24 22:56:43 dkf Exp $
*/
#include "tclInt.h"
@@ -38,7 +36,7 @@ typedef struct {
* These variables are protected by "preserveMutex".
*/
-static Reference *refArray; /* First in array of references. */
+static Reference *refArray = NULL; /* First in array of references. */
static int spaceAvl = 0; /* Total number of structures available at
* *firstRefPtr. */
static int inUse = 0; /* Count of structures currently in use in
@@ -56,12 +54,12 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
*/
typedef struct HandleStruct {
- VOID *ptr; /* Pointer to the memory block being tracked.
+ void *ptr; /* Pointer to the memory block being tracked.
* This field will become NULL when the memory
* block is deleted. This field must be the
* first in the structure. */
#ifdef TCL_MEM_DEBUG
- VOID *ptr2; /* Backup copy of the above pointer used to
+ void *ptr2; /* Backup copy of the above pointer used to
* ensure that the contents of the handle are
* not changed by anyone else. */
#endif
@@ -87,14 +85,14 @@ typedef struct HandleStruct {
/* ARGSUSED */
void
-TclFinalizePreserve()
+TclFinalizePreserve(void)
{
Tcl_MutexLock(&preserveMutex);
if (spaceAvl != 0) {
- ckfree((char *) refArray);
- refArray = (Reference *) NULL;
- inUse = 0;
- spaceAvl = 0;
+ ckfree(refArray);
+ refArray = NULL;
+ inUse = 0;
+ spaceAvl = 0;
}
Tcl_MutexUnlock(&preserveMutex);
}
@@ -119,8 +117,8 @@ TclFinalizePreserve()
*/
void
-Tcl_Preserve(clientData)
- ClientData clientData; /* Pointer to malloc'ed block of memory. */
+Tcl_Preserve(
+ ClientData clientData) /* Pointer to malloc'ed block of memory. */
{
Reference *refPtr;
int i;
@@ -145,21 +143,8 @@ Tcl_Preserve(clientData)
*/
if (inUse == spaceAvl) {
- if (spaceAvl == 0) {
- refArray = (Reference *) ckalloc((unsigned)
- (INITIAL_SIZE*sizeof(Reference)));
- spaceAvl = INITIAL_SIZE;
- } else {
- Reference *new;
-
- new = (Reference *) ckalloc((unsigned)
- (2*spaceAvl*sizeof(Reference)));
- memcpy((VOID *) new, (VOID *) refArray,
- spaceAvl*sizeof(Reference));
- ckfree((char *) refArray);
- refArray = new;
- spaceAvl *= 2;
- }
+ spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
+ refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
}
/*
@@ -195,8 +180,8 @@ Tcl_Preserve(clientData)
*/
void
-Tcl_Release(clientData)
- ClientData clientData; /* Pointer to malloc'ed block of memory. */
+Tcl_Release(
+ ClientData clientData) /* Pointer to malloc'ed block of memory. */
{
Reference *refPtr;
int i;
@@ -239,9 +224,9 @@ Tcl_Release(clientData)
Tcl_MutexUnlock(&preserveMutex);
if (mustFree) {
if (freeProc == TCL_DYNAMIC) {
- ckfree((char *) clientData);
+ ckfree(clientData);
} else {
- (*freeProc)((char *) clientData);
+ freeProc(clientData);
}
}
return;
@@ -252,7 +237,7 @@ Tcl_Release(clientData)
* 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);
}
/*
@@ -274,9 +259,9 @@ Tcl_Release(clientData)
*/
void
-Tcl_EventuallyFree(clientData, freeProc)
- ClientData clientData; /* Pointer to malloc'ed block of memory. */
- Tcl_FreeProc *freeProc; /* Function to actually do free. */
+Tcl_EventuallyFree(
+ ClientData clientData, /* Pointer to malloc'ed block of memory. */
+ Tcl_FreeProc *freeProc) /* Function to actually do free. */
{
Reference *refPtr;
int i;
@@ -292,13 +277,12 @@ Tcl_EventuallyFree(clientData, freeProc)
continue;
}
if (refPtr->mustFree) {
- Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x\n",
- clientData);
- }
- refPtr->mustFree = 1;
+ Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData);
+ }
+ refPtr->mustFree = 1;
refPtr->freeProc = freeProc;
Tcl_MutexUnlock(&preserveMutex);
- return;
+ return;
}
Tcl_MutexUnlock(&preserveMutex);
@@ -307,9 +291,9 @@ Tcl_EventuallyFree(clientData, freeProc)
*/
if (freeProc == TCL_DYNAMIC) {
- ckfree((char *) clientData);
+ ckfree(clientData);
} else {
- (*freeProc)((char *)clientData);
+ freeProc(clientData);
}
}
@@ -338,14 +322,13 @@ Tcl_EventuallyFree(clientData, freeProc)
*/
TclHandle
-TclHandleCreate(ptr)
- VOID *ptr; /* Pointer to an arbitrary block of memory to
+TclHandleCreate(
+ void *ptr) /* Pointer to an arbitrary block of memory to
* 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;
@@ -374,8 +357,8 @@ TclHandleCreate(ptr)
*/
void
-TclHandleFree(handle)
- TclHandle handle; /* Previously created handle associated with a
+TclHandleFree(
+ TclHandle handle) /* Previously created handle associated with a
* malloc'd block that is being deleted. The
* handle is modified so that doubly
* dereferencing it will give NULL. */
@@ -385,16 +368,16 @@ TclHandleFree(handle)
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);
}
}
@@ -419,8 +402,8 @@ TclHandleFree(handle)
*/
TclHandle
-TclHandlePreserve(handle)
- TclHandle handle; /* Declare an interest in the block of memory
+TclHandlePreserve(
+ TclHandle handle) /* Declare an interest in the block of memory
* referenced by this handle. */
{
HandleStruct *handlePtr;
@@ -428,10 +411,10 @@ TclHandlePreserve(handle)
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
@@ -460,8 +443,8 @@ TclHandlePreserve(handle)
*/
void
-TclHandleRelease(handle)
- TclHandle handle; /* Unregister interest in the block of memory
+TclHandleRelease(
+ TclHandle handle) /* Unregister interest in the block of memory
* referenced by this handle. */
{
HandleStruct *handlePtr;
@@ -469,16 +452,16 @@ TclHandleRelease(handle)
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 b184c8a..ce1c767 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -6,36 +6,62 @@
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004-2006 Miguel Sofer
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* 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.80 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+#include "tclOOInt.h"
/*
- * Prototypes for static functions in this file
+ * Variables that are part of the [apply] command implementation and which
+ * have to be passed to the other side of the NRE call.
*/
-static void ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
-static void ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
- char *procName, int nameLen, int returnCode));
-static int TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+typedef struct {
+ int isRootEnsemble;
+ Command cmd;
+ ExtraFrameInfo efi;
+} ApplyExtraData;
-static void InitCompiledLocals _ANSI_ARGS_((Tcl_Interp *interp,
- ByteCode *codePtr, CompiledLocal *localPtr,
- Var *varPtr, Namespace *nsPtr));
+/*
+ * Prototypes for static functions in this file
+ */
+
+static void DupLambdaInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static void FreeLambdaInternalRep(Tcl_Obj *objPtr);
+static int InitArgsAndLocals(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj, int skip);
+static void InitResolvedLocals(Tcl_Interp *interp,
+ ByteCode *codePtr, Var *defPtr,
+ Namespace *nsPtr);
+static void InitLocalCache(Proc *procPtr);
+static int PushProcCallFrame(ClientData clientData,
+ register Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int isLambda);
+static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void ProcBodyFree(Tcl_Obj *objPtr);
+static int ProcWrongNumArgs(Tcl_Interp *interp, int skip);
+static void MakeProcError(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj);
+static void MakeLambdaError(Tcl_Interp *interp,
+ Tcl_Obj *procNameObj);
+static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+
+static Tcl_NRPostProc ApplyNR2;
+static Tcl_NRPostProc InterpProcNR2;
+static Tcl_NRPostProc Uplevel_Callback;
/*
* The ProcBodyObjType type
*/
-Tcl_ObjType tclProcBodyType = {
+const Tcl_ObjType tclProcBodyType = {
"procbody", /* name for this type */
ProcBodyFree, /* FreeInternalRep function */
ProcBodyDup, /* DupInternalRep function */
@@ -47,18 +73,35 @@ Tcl_ObjType tclProcBodyType = {
};
/*
- * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
- * encoding the type of level reference in ptr1 and the actual parsed out
- * offset in ptr2.
+ * The [upvar]/[uplevel] level reference type. Uses the ptrAndLongRep field,
+ * encoding the type of level reference in ptr and the actual parsed out
+ * offset in value.
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
-static Tcl_ObjType levelReferenceType = {
+static const Tcl_ObjType levelReferenceType = {
"levelReference",
NULL, NULL, NULL, NULL
};
+
+/*
+ * The type of lambdas. Note that every lambda will *always* have a string
+ * representation.
+ *
+ * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
+ * command name, and ptr2 is a pointer to the namespace that the Proc instance
+ * will execute within.
+ */
+
+static const Tcl_ObjType lambdaType = {
+ "lambdaExpr", /* name */
+ FreeLambdaInternalRep, /* freeIntRepProc */
+ DupLambdaInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetLambdaFromAny /* setFromAnyProc */
+};
/*
*----------------------------------------------------------------------
@@ -79,16 +122,16 @@ static Tcl_ObjType levelReferenceType = {
/* ARGSUSED */
int
-Tcl_ProcObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ProcObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
Proc *procPtr;
- char *fullName;
- CONST char *procName, *procArgs, *procBody;
+ const char *fullName;
+ const char *procName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
Tcl_DString ds;
@@ -105,24 +148,29 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
*/
fullName = TclGetString(objv[1]);
- TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL, 0,
+ TclGetNamespaceForQualName(interp, fullName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", (char *) 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", (char *) 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 \":\"",
- (char *) 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;
}
@@ -132,6 +180,9 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
&procPtr) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (creating proc \"");
+ Tcl_AddErrorInfo(interp, procName);
+ Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
@@ -145,13 +196,12 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- Tcl_DStringAppend(&ds, "::", 2);
+ TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
- cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
- TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
-
+ cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
+ TclNRInterpProc, procPtr, TclProcDeleteProc);
Tcl_DStringFree(&ds);
/*
@@ -164,6 +214,101 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
procPtr->cmdPtr = (Command *) cmd;
/*
+ * TIP #280: Remember the line the procedure body is starting on. In a
+ * bytecode context we ask the engine to provide us with the necessary
+ * information. This is for the initialization of the byte code compiler
+ * when the body is used for the first time.
+ *
+ * This code is nearly identical to the #280 code in SetLambdaFromAny, see
+ * this file. The differences are the different index of the body in the
+ * line array of the context, and the lamdba code requires some special
+ * processing. Find a way to factor the common elements into a single
+ * function.
+ */
+
+ if (iPtr->cmdFramePtr) {
+ CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+
+ *contextPtr = *iPtr->cmdFramePtr;
+ if (contextPtr->type == TCL_LOCATION_BC) {
+ /*
+ * Retrieve source information from the bytecode, if possible. If
+ * the information is retrieved successfully, context.type will be
+ * TCL_LOCATION_SOURCE and the reference held by
+ * context.data.eval.path will be counted.
+ */
+
+ TclGetSrcInfoForPc(contextPtr);
+ } else if (contextPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * The copy into 'context' up above has created another reference
+ * to 'context.data.eval.path'; account for it.
+ */
+
+ Tcl_IncrRefCount(contextPtr->data.eval.path);
+ }
+
+ if (contextPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * We can account for source location within a proc only if the
+ * proc body was not created by substitution.
+ */
+
+ if (contextPtr->line
+ && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
+ int isNew;
+ Tcl_HashEntry *hePtr;
+ CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
+
+ cfPtr->level = -1;
+ cfPtr->type = contextPtr->type;
+ cfPtr->line = ckalloc(sizeof(int));
+ cfPtr->line[0] = contextPtr->line[3];
+ cfPtr->nline = 1;
+ cfPtr->framePtr = NULL;
+ cfPtr->nextPtr = NULL;
+
+ cfPtr->data.eval.path = contextPtr->data.eval.path;
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+ cfPtr->cmd = NULL;
+ cfPtr->len = 0;
+
+ hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+ procPtr, &isNew);
+ if (!isNew) {
+ /*
+ * Get the old command frame and release it. See also
+ * TclProcCleanupProc in this file. Currently it seems as
+ * if only the procbodytest::proc command of the testsuite
+ * is able to trigger this situation.
+ */
+
+ CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
+
+ if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
+ Tcl_DecrRefCount(cfOldPtr->data.eval.path);
+ cfOldPtr->data.eval.path = NULL;
+ }
+ ckfree(cfOldPtr->line);
+ cfOldPtr->line = NULL;
+ ckfree(cfOldPtr);
+ }
+ Tcl_SetHashValue(hePtr, cfPtr);
+ }
+
+ /*
+ * 'contextPtr' is going out of scope; account for the reference
+ * that it's holding to the path name.
+ */
+
+ Tcl_DecrRefCount(contextPtr->data.eval.path);
+ contextPtr->data.eval.path = NULL;
+ }
+ TclStackFree(interp, contextPtr);
+ }
+
+ /*
* Optimize for no-op procs: if the body is not precompiled (like a TclPro
* procbody), and the argument list is just "args" and the body is empty,
* define a compileProc to compile a no-op.
@@ -190,8 +335,10 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
}
if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
+ int numBytes;
+
procArgs +=4;
- while(*procArgs != '\0') {
+ while (*procArgs != '\0') {
if (*procArgs != ' ') {
goto done;
}
@@ -202,12 +349,9 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* 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;
}
/*
@@ -246,20 +390,20 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
*/
int
-TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
- Tcl_Interp *interp; /* interpreter containing proc */
- Namespace *nsPtr; /* namespace containing this proc */
- CONST char *procName; /* unqualified name of this proc */
- Tcl_Obj *argsPtr; /* description of arguments */
- Tcl_Obj *bodyPtr; /* command body */
- Proc **procPtrPtr; /* returns: pointer to proc data */
+TclCreateProc(
+ Tcl_Interp *interp, /* Interpreter containing proc. */
+ Namespace *nsPtr, /* Namespace containing this proc. */
+ const char *procName, /* Unqualified name of this proc. */
+ Tcl_Obj *argsPtr, /* Description of arguments. */
+ Tcl_Obj *bodyPtr, /* Command body. */
+ Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
- Interp *iPtr = (Interp*)interp;
- CONST char **argArray = NULL;
+ Interp *iPtr = (Interp *) interp;
+ const char **argArray = NULL;
register Proc *procPtr;
int i, length, result, numArgs;
- CONST char *args, *bytes, *p;
+ const char *args, *bytes, *p;
register CompiledLocal *localPtr = NULL;
Tcl_Obj *defPtr;
int precompiled = 0;
@@ -277,7 +421,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* will be holding a reference to it.
*/
- procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
+ procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
@@ -287,9 +431,9 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* is identical to, e.g., the body of another procedure, we must
* create a private copy for this procedure to use. Such sharing of
* procedure bodies is rare but can cause problems. A procedure body
- * is compiled in a context that includes the number of
- * compiler-allocated "slots" for local variables. Each formal
- * parameter is given a local variable slot (the
+ * is compiled in a context that includes the number of "slots"
+ * allocated by the compiler for local variables. There is a local
+ * variable slot for each formal parameter (the
* "procPtr->numCompiledLocals = numArgs" assignment below). This
* means that the same code can not be shared by two procedures that
* have a different number of arguments, even if their bodies are
@@ -298,8 +442,18 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
*/
if (Tcl_IsShared(bodyPtr)) {
- bytes = Tcl_GetStringFromObj(bodyPtr, &length);
+ Tcl_Obj *sharedBodyPtr = bodyPtr;
+
+ bytes = TclGetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
+
+ /*
+ * TIP #280.
+ * Ensure that the continuation line data for the original body is
+ * not lost and applies to the new body as well.
+ */
+
+ TclContinuationsCopy(bodyPtr, sharedBodyPtr);
}
/*
@@ -310,11 +464,11 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
Tcl_IncrRefCount(bodyPtr);
- procPtr = (Proc *) ckalloc(sizeof(Proc));
+ procPtr = ckalloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
procPtr->bodyPtr = bodyPtr;
- procPtr->numArgs = 0; /* actual argument count is set below. */
+ procPtr->numArgs = 0; /* Actual argument count is set below. */
procPtr->numCompiledLocals = 0;
procPtr->firstLocalPtr = NULL;
procPtr->lastLocalPtr = NULL;
@@ -322,14 +476,14 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
/*
* Break up the argument list into argument specifiers, then process each
- * argument specifier. If the body is precompiled, processing is limited
+ * argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*
- * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
+ * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
*/
- args = Tcl_GetStringFromObj(argsPtr, &length);
+ args = TclGetStringFromObj(argsPtr, &length);
result = Tcl_SplitList(interp, args, &numArgs, &argArray);
if (result != TCL_OK) {
goto procError;
@@ -337,12 +491,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains %d entries, "
"precompiled header expects %d", procName, numArgs,
- procPtr->numArgs);
- Tcl_SetObjResult(interp, objPtr);
+ procPtr->numArgs));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -353,7 +507,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
for (i = 0; i < numArgs; i++) {
int fieldCount, nameLength, valueLength;
- CONST char **fieldValues;
+ const char **fieldValues;
/*
* Now divide the specifier up into name and default.
@@ -365,16 +519,20 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
goto procError;
}
if (fieldCount > 2) {
- ckfree((char *) fieldValues);
- Tcl_AppendResult(interp,
- "too many fields in argument specifier \"",
- argArray[i], "\"", (char *) 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, "procedure \"", procName,
- "\" has argument with no name", (char *) NULL);
+ ckfree(fieldValues);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "argument with no name", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
goto procError;
}
@@ -392,23 +550,27 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
p = fieldValues[0];
while (*p != '\0') {
if (*p == '(') {
- CONST char *q = p;
+ const char *q = p;
do {
q++;
} while (*q != '\0');
q--;
- if (*q == ')') { /* we have an array element */
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\" has formal parameter \"", fieldValues[0],
- "\" that is an array element", (char *) NULL);
- ckfree((char *) fieldValues);
+ if (*q == ')') { /* We have an array element. */
+ 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, "procedure \"", procName,
- "\" has formal parameter \"", fieldValues[0],
- "\" that is not a simple name", (char *) 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++;
@@ -416,54 +578,57 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (precompiled) {
/*
- * Compare the parsed argument with the stored one. For the flags,
- * we and out VAR_UNDEFINED to support bridging precompiled <= 8.3
- * code in 8.4 where this is now used as an optimization
- * indicator. Yes, this is a hack. -- hobbs
+ * Compare the parsed argument with the stored one. Note that the
+ * only flag value that makes sense at this point is VAR_ARGUMENT
+ * (its value was kept the same as pre VarReform to simplify
+ * tbcload's processing of older byetcodes).
+ *
+ * The only other flag vlaue that is important to retrieve from
+ * precompiled procs is VAR_TEMPORARY (also unchanged). It is
+ * needed later when retrieving the variable names.
*/
if ((localPtr->nameLength != nameLength)
|| (strcmp(localPtr->name, fieldValues[0]))
|| (localPtr->frameIndex != i)
- || ((localPtr->flags & ~VAR_UNDEFINED)
- != (VAR_SCALAR | VAR_ARGUMENT))
+ || !(localPtr->flags & VAR_ARGUMENT)
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter %d is "
- "inconsistent with precompiled body", procName, i);
- Tcl_SetObjResult(interp, objPtr);
- ckfree((char *) fieldValues);
+ "inconsistent with precompiled body", procName, i));
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
/*
- * compare the default value if any
+ * Compare the default value if any.
*/
if (localPtr->defValuePtr != NULL) {
int tmpLength;
- char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
+ const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
&tmpLength);
+
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
- Tcl_Obj *objPtr = Tcl_NewObj();
-
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
- procName, fieldValues[0]);
- Tcl_SetObjResult(interp, objPtr);
- ckfree((char *) fieldValues);
+ procName, fieldValues[0]));
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "BYTECODELIES", NULL);
goto procError;
}
- if ((i == numArgs - 1)
- && (localPtr->nameLength == 4)
- && (localPtr->name[0] == 'a')
- && (strcmp(localPtr->name, "args") == 0)) {
- localPtr->flags |= VAR_IS_ARGS;
- }
+ }
+ if ((i == numArgs - 1)
+ && (localPtr->nameLength == 4)
+ && (localPtr->name[0] == 'a')
+ && (strcmp(localPtr->name, "args") == 0)) {
+ localPtr->flags |= VAR_IS_ARGS;
}
localPtr = localPtr->nextPtr;
@@ -473,9 +638,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* 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 {
@@ -485,7 +648,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
localPtr->nextPtr = NULL;
localPtr->nameLength = nameLength;
localPtr->frameIndex = i;
- localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+ localPtr->flags = VAR_ARGUMENT;
localPtr->resolveInfo = NULL;
if (fieldCount == 2) {
@@ -495,7 +658,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
} 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')
@@ -504,11 +667,11 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
}
}
- ckfree((char *) fieldValues);
+ ckfree(fieldValues);
}
*procPtrPtr = procPtr;
- ckfree((char *) argArray);
+ ckfree(argArray);
return TCL_OK;
procError:
@@ -525,12 +688,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
Tcl_DecrRefCount(defPtr);
}
- ckfree((char *) localPtr);
+ ckfree(localPtr);
}
- ckfree((char *) procPtr);
+ ckfree(procPtr);
}
if (argArray != NULL) {
- ckfree((char *) argArray);
+ ckfree(argArray);
}
return TCL_ERROR;
}
@@ -548,7 +711,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* The return value is -1 if an error occurred in finding the frame (in
* this case an error message is left in the interp's result). 1 is
* returned if string was either a number or a number preceded by "#" and
- * it specified a valid frame. 0 is returned if string isn't one of the
+ * it specified a valid frame. 0 is returned if string isn't one of the
* two things above (in this case, the lookup acts as if string were
* "1"). The variable pointed to by framePtrPtr is filled in with the
* address of the desired frame (unless an error occurs, in which case it
@@ -561,10 +724,10 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
*/
int
-TclGetFrame(interp, name, framePtrPtr)
- Tcl_Interp *interp; /* Interpreter in which to find frame. */
- CONST char *name; /* String describing frame. */
- CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL if
+TclGetFrame(
+ Tcl_Interp *interp, /* Interpreter in which to find frame. */
+ const char *name, /* String describing frame. */
+ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
@@ -576,7 +739,7 @@ TclGetFrame(interp, name, framePtrPtr)
*/
result = 1;
- curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+ curLevel = iPtr->varFramePtr->level;
if (*name== '#') {
if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
goto levelError;
@@ -595,25 +758,22 @@ TclGetFrame(interp, name, framePtrPtr)
* Figure out which frame to use, and return it to the caller.
*/
- if (level == 0) {
- framePtr = NULL;
- } else {
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
+ for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ framePtr = framePtr->callerVarPtr) {
+ if (framePtr->level == level) {
+ break;
}
}
+ if (framePtr == NULL) {
+ goto levelError;
+ }
+
*framePtrPtr = framePtr;
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -643,99 +803,109 @@ TclGetFrame(interp, name, framePtrPtr)
*/
int
-TclObjGetFrame(interp, objPtr, framePtrPtr)
- Tcl_Interp *interp; /* Interpreter in which to find frame. */
- Tcl_Obj *objPtr; /* Object describing frame. */
- CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL if
+TclObjGetFrame(
+ Tcl_Interp *interp, /* Interpreter in which to find frame. */
+ Tcl_Obj *objPtr, /* Object describing frame. */
+ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
CallFrame *framePtr;
- CONST char *name = TclGetString(objPtr);
+ const char *name;
/*
* Parse object to figure out which level number to go to.
*/
result = 1;
- curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+ curLevel = iPtr->varFramePtr->level;
+ if (objPtr == NULL) {
+ name = "1";
+ goto haveLevel1;
+ }
+
+ name = TclGetString(objPtr);
if (objPtr->typePtr == &levelReferenceType) {
- if ((int) objPtr->internalRep.twoPtrValue.ptr1) {
- level = curLevel - (int) objPtr->internalRep.twoPtrValue.ptr2;
+ if (objPtr->internalRep.ptrAndLongRep.ptr != NULL) {
+ level = curLevel - objPtr->internalRep.ptrAndLongRep.value;
} else {
- level = (int) objPtr->internalRep.twoPtrValue.ptr2;
+ level = objPtr->internalRep.ptrAndLongRep.value;
}
if (level < 0) {
goto levelError;
}
- } else if (objPtr->typePtr == &tclIntType ||
- objPtr->typePtr == &tclWideIntType) {
- if (Tcl_GetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
+ /* TODO: Consider skipping the typePtr checks */
+ } else if (objPtr->typePtr == &tclIntType
+#ifndef TCL_WIDE_INT_IS_LONG
+ || objPtr->typePtr == &tclWideIntType
+#endif
+ ) {
+ if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
goto levelError;
}
level = curLevel - level;
- } else {
- if (*name == '#') {
- if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
- goto levelError;
- }
+ } else if (*name == '#') {
+ if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
+ goto levelError;
+ }
- /*
- * Cache for future reference.
- */
+ /*
+ * Cache for future reference.
+ *
+ * TODO: Use the new ptrAndLongRep intrep
+ */
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 0;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
- } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
- if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
- return -1;
- }
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = &levelReferenceType;
+ objPtr->internalRep.ptrAndLongRep.ptr = NULL;
+ objPtr->internalRep.ptrAndLongRep.value = level;
+ } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
+ if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
+ return -1;
+ }
- /*
- * Cache for future reference.
- */
+ /*
+ * Cache for future reference.
+ *
+ * TODO: Use the new ptrAndLongRep intrep
+ */
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 1;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
- level = curLevel - level;
- } else {
- /*
- * Don't cache as the object *isn't* a level reference.
- */
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = &levelReferenceType;
+ objPtr->internalRep.ptrAndLongRep.ptr = (void *) 1; /* non-NULL */
+ objPtr->internalRep.ptrAndLongRep.value = level;
+ level = curLevel - level;
+ } else {
+ /*
+ * Don't cache as the object *isn't* a level reference (might even be
+ * NULL...)
+ */
- level = curLevel - 1;
- result = 0;
- }
+ haveLevel1:
+ level = curLevel - 1;
+ result = 0;
}
/*
* Figure out which frame to use, and return it to the caller.
*/
- if (level == 0) {
- framePtr = NULL;
- } else {
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
+ for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ framePtr = framePtr->callerVarPtr) {
+ if (framePtr->level == level) {
+ break;
}
}
+ if (framePtr == NULL) {
+ goto levelError;
+ }
*framePtrPtr = framePtr;
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -756,17 +926,52 @@ TclObjGetFrame(interp, objPtr, framePtrPtr)
*----------------------------------------------------------------------
*/
+static int
+Uplevel_Callback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CallFrame *savedVarFramePtr = data[0];
+
+ if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
+ }
+
+ /*
+ * Restore the variable frame, and return.
+ */
+
+ ((Interp *)interp)->varFramePtr = savedVarFramePtr;
+ return result;
+}
+
/* ARGSUSED */
int
-Tcl_UplevelObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UplevelObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
+ return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRUplevelObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+
register Interp *iPtr = (Interp *) interp;
+ CmdFrame *invoker = NULL;
+ int word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
+ Tcl_Obj *objPtr;
if (objc < 2) {
uplevelSyntax:
@@ -782,11 +987,11 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
if (result == -1) {
return TCL_ERROR;
}
- objc -= (result+1);
+ objc -= result + 1;
if (objc == 0) {
goto uplevelSyntax;
}
- objv += (result+1);
+ objv += result + 1;
/*
* Modify the interpreter state to execute in the given frame.
@@ -800,30 +1005,26 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
*/
if (objc == 1) {
- result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
+ /*
+ * TIP #280. Make actual argument location available to eval'd script
+ */
+
+ TclArgumentGet(interp, objv[0], &invoker, &word);
+ objPtr = objv[0];
+
} else {
/*
* More than one argument: concatenate them together with spaces
- * between, then evaluate the result. Tcl_EvalObjEx will delete the
+ * between, then evaluate the result. Tcl_EvalObjEx will delete the
* object when it decrements its refcount after eval'ing it.
*/
- Tcl_Obj *objPtr;
-
objPtr = Tcl_ConcatObj(objc, objv);
- result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
- }
- if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"uplevel\" body line %d)",
- interp->errorLine);
}
- /*
- * Restore the variable frame, and return.
- */
-
- iPtr->varFramePtr = savedVarFramePtr;
- return result;
+ TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
+ NULL);
+ return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}
/*
@@ -850,29 +1051,20 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
*/
Proc *
-TclFindProc(iPtr, procName)
- Interp *iPtr; /* Interpreter in which to look. */
- CONST char *procName; /* Name of desired procedure. */
+TclFindProc(
+ Interp *iPtr, /* Interpreter in which to look. */
+ const char *procName) /* Name of desired procedure. */
{
Tcl_Command cmd;
- Tcl_Command origCmd;
Command *cmdPtr;
- cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
- (Tcl_Namespace *) NULL, /*flags*/ 0);
+ cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0);
if (cmd == (Tcl_Command) NULL) {
return NULL;
}
cmdPtr = (Command *) cmd;
- origCmd = TclGetOriginalCommand(cmd);
- if (origCmd != NULL) {
- cmdPtr = (Command *) origCmd;
- }
- if (cmdPtr->objProc != TclObjInterpProc) {
- return NULL;
- }
- return (Proc *) cmdPtr->objClientData;
+ return TclIsProc(cmdPtr);
}
/*
@@ -894,149 +1086,80 @@ TclFindProc(iPtr, procName)
*/
Proc *
-TclIsProc(cmdPtr)
- Command *cmdPtr; /* Command to test. */
+TclIsProc(
+ Command *cmdPtr) /* Command to test. */
{
- Tcl_Command origCmd;
+ Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
- origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
- if (cmdPtr->objProc == TclObjInterpProc) {
- return (Proc *) cmdPtr->objClientData;
+ if (cmdPtr->deleteProc == TclProcDeleteProc) {
+ return cmdPtr->objClientData;
}
- return (Proc *) 0;
+ return NULL;
}
-/*
- *----------------------------------------------------------------------
- *
- * InitCompiledLocals --
- *
- * This routine is invoked in order to initialize the compiled locals
- * table for a new call frame.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May invoke various name resolvers in order to determine which
- * variables are being referenced at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- ByteCode *codePtr;
- CompiledLocal *localPtr;
- Var *varPtr;
- Namespace *nsPtr; /* Pointer to current namespace. */
+static int
+ProcWrongNumArgs(
+ Tcl_Interp *interp,
+ int skip)
{
- Interp *iPtr = (Interp*) interp;
- int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
- CompiledLocal *firstLocalPtr;
+ CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+ register Proc *procPtr = framePtr->procPtr;
+ register Var *defPtr;
+ int localCt = procPtr->numCompiledLocals, numArgs, i;
+ Tcl_Obj **desiredObjs;
+ const char *final = NULL;
- if (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS) {
- /*
- * This is the first run after a recompile, or else the resolver epoch
- * has changed: update the resolver cache.
- */
+ /*
+ * Build up desired argument list for Tcl_WrongNumArgs
+ */
- firstLocalPtr = localPtr;
- for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
+ numArgs = framePtr->procPtr->numArgs;
+ desiredObjs = TclStackAlloc(interp,
+ (int) sizeof(Tcl_Obj *) * (numArgs+1));
- if (localPtr->resolveInfo) {
- if (localPtr->resolveInfo->deleteProc) {
- localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
- } else {
- ckfree((char*)localPtr->resolveInfo);
- }
- localPtr->resolveInfo = NULL;
- }
- localPtr->flags &= ~VAR_RESOLVED;
+ if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
+ desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
+ } else {
+ ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
- if (haveResolvers &&
- !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
- ResolverScheme *resPtr = iPtr->resolverPtr;
- Tcl_ResolvedVarInfo *vinfo;
- int result;
+#ifdef AVOID_HACKS_FOR_ITCL
+ desiredObjs[0] = framePtr->objv[skip-1];
+#else
+ desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
+#endif /* AVOID_HACKS_FOR_ITCL */
+ }
+ Tcl_IncrRefCount(desiredObjs[0]);
- if (nsPtr->compiledVarResProc) {
- result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
- localPtr->name, localPtr->nameLength,
- (Tcl_Namespace *) nsPtr, &vinfo);
- } else {
- result = TCL_CONTINUE;
- }
+ defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+ for (i=1 ; i<=numArgs ; i++, defPtr++) {
+ Tcl_Obj *argObj;
+ Tcl_Obj *namePtr = localName(framePtr, i-1);
- while ((result == TCL_CONTINUE) && resPtr) {
- if (resPtr->compiledVarResProc) {
- result = (*resPtr->compiledVarResProc)(nsPtr->interp,
- localPtr->name, localPtr->nameLength,
- (Tcl_Namespace *) nsPtr, &vinfo);
- }
- resPtr = resPtr->nextPtr;
- }
- if (result == TCL_OK) {
- localPtr->resolveInfo = vinfo;
- localPtr->flags |= VAR_RESOLVED;
- }
- }
+ if (defPtr->value.objPtr != NULL) {
+ TclNewObj(argObj);
+ Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+ } else if (defPtr->flags & VAR_IS_ARGS) {
+ numArgs--;
+ final = "?arg ...?";
+ break;
+ } else {
+ argObj = namePtr;
+ Tcl_IncrRefCount(namePtr);
}
- localPtr = firstLocalPtr;
- codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+ desiredObjs[i] = argObj;
}
- /*
- * Initialize the array of local variables stored in the call frame. Some
- * variables may have special resolution rules. In that case, we call
- * their "resolver" procs to get our hands on the variable, and we make
- * the compiled local a link to the real variable.
- */
-
- if (haveResolvers) {
- Tcl_ResolvedVarInfo *resVarInfo;
- for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
- varPtr->value.objPtr = NULL;
- varPtr->name = localPtr->name; /* will be just '\0' if temp var */
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
-
- /*
- * Now invoke the resolvers to determine the exact variables that
- * should be used.
- */
+ Tcl_ResetResult(interp);
+ Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);
- resVarInfo = localPtr->resolveInfo;
- if (resVarInfo && resVarInfo->fetchProc) {
- Var *resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
- resVarInfo);
- if (resolvedVarPtr) {
- resolvedVarPtr->refCount++;
- varPtr->value.linkPtr = resolvedVarPtr;
- varPtr->flags = VAR_LINK;
- }
- }
- }
- } else {
- for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
- varPtr->value.objPtr = NULL;
- varPtr->name = localPtr->name; /* will be just '\0' if temp var */
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
- }
+ for (i=0 ; i<=numArgs ; i++) {
+ Tcl_DecrRefCount(desiredObjs[i]);
}
+ TclStackFree(interp, desiredObjs);
+ return TCL_ERROR;
}
/*
@@ -1061,102 +1184,279 @@ InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
*/
void
-TclInitCompiledLocals(interp, framePtr, nsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- CallFrame *framePtr; /* Call frame to initialize. */
- Namespace *nsPtr; /* Pointer to current namespace. */
+TclInitCompiledLocals(
+ Tcl_Interp *interp, /* Current interpreter. */
+ CallFrame *framePtr, /* Call frame to initialize. */
+ Namespace *nsPtr) /* Pointer to current namespace. */
{
Var *varPtr = framePtr->compiledLocals;
Tcl_Obj *bodyPtr;
ByteCode *codePtr;
- CompiledLocal *localPtr = framePtr->procPtr->firstLocalPtr;
bodyPtr = framePtr->procPtr->bodyPtr;
if (bodyPtr->typePtr != &tclByteCodeType) {
Tcl_Panic("body object for proc attached to frame is not a byte code type");
}
- codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+ codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
+
+ if (framePtr->numCompiledLocals) {
+ if (!codePtr->localCachePtr) {
+ InitLocalCache(framePtr->procPtr) ;
+ }
+ framePtr->localCachePtr = codePtr->localCachePtr;
+ framePtr->localCachePtr->refCount++;
+ }
- InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+ InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclObjInterpProc --
+ * InitResolvedLocals --
*
- * When a Tcl procedure gets invoked during bytecode evaluation, this
- * object-based routine gets invoked to interpret the procedure.
+ * This routine is invoked in order to initialize the compiled locals
+ * table for a new call frame.
*
* Results:
- * A standard Tcl object result value.
+ * None.
*
* Side effects:
- * Depends on the commands in the procedure.
+ * May invoke various name resolvers in order to determine which
+ * variables are being referenced at runtime.
*
*----------------------------------------------------------------------
*/
-int
-TclObjInterpProc(clientData, interp, objc, objv)
- ClientData clientData; /* Record describing procedure to be
- * interpreted. */
- register Tcl_Interp *interp; /* Interpreter in which procedure was
- * invoked. */
- int objc; /* Count of number of arguments to this
- * procedure. */
- Tcl_Obj *CONST objv[]; /* Argument value objects. */
+static void
+InitResolvedLocals(
+ Tcl_Interp *interp, /* Current interpreter. */
+ ByteCode *codePtr,
+ Var *varPtr,
+ Namespace *nsPtr) /* Pointer to current namespace. */
{
- register Proc *procPtr = (Proc *) clientData;
- Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
- CallFrame *framePtr, **framePtrPtr;
- register Var *varPtr;
- register CompiledLocal *localPtr;
- char *procName;
- int nameLen, localCt, numArgs, argCt, i, imax, result;
- Var *compiledLocals;
+ Interp *iPtr = (Interp *) interp;
+ int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
+ CompiledLocal *firstLocalPtr, *localPtr;
+ int varNum;
+ Tcl_ResolvedVarInfo *resVarInfo;
/*
- * Get the procedure's name.
+ * Find the localPtr corresponding to varPtr
*/
- procName = Tcl_GetStringFromObj(objv[0], &nameLen);
+ varNum = varPtr - iPtr->framePtr->compiledLocals;
+ localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
+ while (varNum--) {
+ localPtr = localPtr->nextPtr;
+ }
+
+ if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
+ goto doInitResolvedLocals;
+ }
/*
- * If necessary, compile the procedure's body. The compiler will allocate
- * frame slots for the procedure's non-argument local variables. Note that
- * compiling the body might increase procPtr->numCompiledLocals if new
- * local variables are found while compiling.
+ * This is the first run after a recompile, or else the resolver epoch
+ * has changed: update the resolver cache.
*/
- result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
- "body of proc", procName);
+ firstLocalPtr = localPtr;
+ for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
+ if (localPtr->resolveInfo) {
+ if (localPtr->resolveInfo->deleteProc) {
+ localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+ } else {
+ ckfree(localPtr->resolveInfo);
+ }
+ localPtr->resolveInfo = NULL;
+ }
+ localPtr->flags &= ~VAR_RESOLVED;
+
+ if (haveResolvers &&
+ !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
+ ResolverScheme *resPtr = iPtr->resolverPtr;
+ Tcl_ResolvedVarInfo *vinfo;
+ int result;
+
+ if (nsPtr->compiledVarResProc) {
+ result = nsPtr->compiledVarResProc(nsPtr->interp,
+ localPtr->name, localPtr->nameLength,
+ (Tcl_Namespace *) nsPtr, &vinfo);
+ } else {
+ result = TCL_CONTINUE;
+ }
- if (result != TCL_OK) {
- return result;
+ while ((result == TCL_CONTINUE) && resPtr) {
+ if (resPtr->compiledVarResProc) {
+ result = resPtr->compiledVarResProc(nsPtr->interp,
+ localPtr->name, localPtr->nameLength,
+ (Tcl_Namespace *) nsPtr, &vinfo);
+ }
+ resPtr = resPtr->nextPtr;
+ }
+ if (result == TCL_OK) {
+ localPtr->resolveInfo = vinfo;
+ localPtr->flags |= VAR_RESOLVED;
+ }
+ }
+ }
+ localPtr = firstLocalPtr;
+ codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+
+ /*
+ * Initialize the array of local variables stored in the call frame. Some
+ * variables may have special resolution rules. In that case, we call
+ * their "resolver" procs to get our hands on the variable, and we make
+ * the compiled local a link to the real variable.
+ */
+
+ doInitResolvedLocals:
+ for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
+ varPtr->flags = 0;
+ varPtr->value.objPtr = NULL;
+
+ /*
+ * Now invoke the resolvers to determine the exact variables that
+ * should be used.
+ */
+
+ resVarInfo = localPtr->resolveInfo;
+ if (resVarInfo && resVarInfo->fetchProc) {
+ register Var *resolvedVarPtr = (Var *)
+ resVarInfo->fetchProc(interp, resVarInfo);
+
+ if (resolvedVarPtr) {
+ if (TclIsVarInHash(resolvedVarPtr)) {
+ VarHashRefCount(resolvedVarPtr)++;
+ }
+ varPtr->flags = VAR_LINK;
+ varPtr->value.linkPtr = resolvedVarPtr;
+ }
+ }
+ }
+}
+
+void
+TclFreeLocalCache(
+ Tcl_Interp *interp,
+ LocalCache *localCachePtr)
+{
+ int i;
+ Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
+
+ for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
+ register Tcl_Obj *objPtr = *namePtrPtr;
+
+ if (objPtr) {
+ /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
+ TclReleaseLiteral(interp, objPtr);
+ }
}
+ ckfree(localCachePtr);
+}
+
+static void
+InitLocalCache(
+ Proc *procPtr)
+{
+ Interp *iPtr = procPtr->iPtr;
+ ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ int localCt = procPtr->numCompiledLocals;
+ int numArgs = procPtr->numArgs, i = 0;
+ Tcl_Obj **namePtr;
+ Var *varPtr;
+ LocalCache *localCachePtr;
+ CompiledLocal *localPtr;
+ int new;
/*
- * Set up and push a new call frame for the new procedure invocation.
- * This call frame will execute in the proc's namespace, which might be
- * different than the current namespace. The proc's namespace is that of
- * its command, which can change if the command is renamed from one
- * namespace to another.
+ * Cache the names and initial values of local variables; store the
+ * cache in both the framePtr for this execution and in the codePtr
+ * for future calls.
*/
- framePtrPtr = &framePtr;
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
- (Tcl_Namespace *) nsPtr, FRAME_IS_PROC);
+ localCachePtr = ckalloc(sizeof(LocalCache)
+ + (localCt - 1) * sizeof(Tcl_Obj *)
+ + numArgs * sizeof(Var));
- if (result != TCL_OK) {
- return result;
+ namePtr = &localCachePtr->varName0;
+ varPtr = (Var *) (namePtr + localCt);
+ localPtr = procPtr->firstLocalPtr;
+ while (localPtr) {
+ if (TclIsVarTemporary(localPtr)) {
+ *namePtr = NULL;
+ } else {
+ *namePtr = TclCreateLiteral(iPtr, localPtr->name,
+ localPtr->nameLength, /* hash */ (unsigned int) -1,
+ &new, /* nsPtr */ NULL, 0, NULL);
+ Tcl_IncrRefCount(*namePtr);
+ }
+
+ if (i < numArgs) {
+ varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
+ varPtr->value.objPtr = localPtr->defValuePtr;
+ varPtr++;
+ i++;
+ }
+ namePtr++;
+ localPtr = localPtr->nextPtr;
}
+ codePtr->localCachePtr = localCachePtr;
+ localCachePtr->refCount = 1;
+ localCachePtr->numVars = localCt;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitArgsAndLocals --
+ *
+ * This routine is invoked in order to initialize the arguments and other
+ * compiled locals table for a new call frame.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Allocates memory on the stack for the compiled local variables, the
+ * caller is responsible for freeing them. Initialises all variables. May
+ * invoke various name resolvers in order to determine which variables
+ * are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+InitArgsAndLocals(
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
+ int skip) /* Number of initial arguments to be skipped,
+ * i.e., words in the "command name". */
+{
+ CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+ register Proc *procPtr = framePtr->procPtr;
+ ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ register Var *varPtr, *defPtr;
+ int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
+ Tcl_Obj *const *argObjs;
- framePtr->objc = objc;
- framePtr->objv = objv; /* ref counts for args are incremented below */
- framePtr->procPtr = procPtr;
+ /*
+ * Make sure that the local cache of variable names and initial values has
+ * been initialised properly .
+ */
+
+ if (localCt) {
+ if (!codePtr->localCachePtr) {
+ InitLocalCache(procPtr) ;
+ }
+ framePtr->localCachePtr = codePtr->localCachePtr;
+ framePtr->localCachePtr->refCount++;
+ defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+ } else {
+ defPtr = NULL;
+ }
/*
* Create the "compiledLocals" array. Make sure it is large enough to hold
@@ -1164,10 +1464,9 @@ TclObjInterpProc(clientData, interp, objc, objv)
* parameters.
*/
- localCt = procPtr->numCompiledLocals;
- compiledLocals = (Var *) TclStackAlloc(interp, localCt*sizeof(Var));
+ varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
+ framePtr->compiledLocals = varPtr;
framePtr->numCompiledLocals = localCt;
- framePtr->compiledLocals = compiledLocals;
/*
* Match and assign the call's actual parameters to the procedure's formal
@@ -1177,169 +1476,303 @@ TclObjInterpProc(clientData, interp, objc, objv)
*/
numArgs = procPtr->numArgs;
- argCt = objc-1; /* set it to the number of args to the proc */
- varPtr = framePtr->compiledLocals;
- localPtr = procPtr->firstLocalPtr;
+ argCt = framePtr->objc - skip; /* Set it to the number of args to the
+ * procedure. */
+ argObjs = framePtr->objv + skip;
if (numArgs == 0) {
if (argCt) {
goto incorrectArgs;
} else {
- goto runProc;
+ goto correctArgs;
}
}
- imax = ((argCt < numArgs - 1)? argCt : (numArgs - 1));
- for (i = 1; i <= imax; i++) {
+ imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
+ for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
/*
* "Normal" arguments; last formal is special, depends on it being
* 'args'.
*/
- Tcl_Obj *objPtr = objv[i];
+ Tcl_Obj *objPtr = argObjs[i];
+ varPtr->flags = 0;
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
- varPtr->name = localPtr->name;
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
- varPtr++;
- localPtr = localPtr->nextPtr;
+ Tcl_IncrRefCount(objPtr); /* Local var is a reference. */
}
- for (; i < numArgs; i++) {
+ for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
/*
- * This loop is entered if argCt < (numArgs-1). Set default values;
+ * This loop is entered if argCt < (numArgs-1). Set default values;
* last formal is special.
*/
- if (localPtr->defValuePtr != NULL) {
- Tcl_Obj *objPtr = localPtr->defValuePtr;
-
- varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
- varPtr->name = localPtr->name;
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
- varPtr++;
- localPtr = localPtr->nextPtr;
- } else {
+ Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
+
+ if (!objPtr) {
goto incorrectArgs;
}
+ varPtr->flags = 0;
+ varPtr->value.objPtr = objPtr;
+ Tcl_IncrRefCount(objPtr); /* Local var reference. */
}
/*
* When we get here, the last formal argument remains to be defined:
- * localPtr and varPtr point to the last argument to be initialized.
+ * defPtr and varPtr point to the last argument to be initialized.
*/
- if (localPtr->flags & VAR_IS_ARGS) {
- Tcl_Obj *listPtr = Tcl_NewListObj(objc-numArgs, &(objv[numArgs]));
+ varPtr->flags = 0;
+ if (defPtr && defPtr->flags & VAR_IS_ARGS) {
+ Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
+
varPtr->value.objPtr = listPtr;
- Tcl_IncrRefCount(listPtr); /* local var is a reference */
+ Tcl_IncrRefCount(listPtr); /* Local var is a reference. */
} else if (argCt == numArgs) {
- Tcl_Obj *objPtr = objv[numArgs];
+ Tcl_Obj *objPtr = argObjs[i];
+
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
- } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) {
- Tcl_Obj *objPtr = localPtr->defValuePtr;
+ Tcl_IncrRefCount(objPtr); /* Local var is a reference. */
+ } else if ((argCt < numArgs) && defPtr && defPtr->value.objPtr) {
+ Tcl_Obj *objPtr = defPtr->value.objPtr;
+
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ Tcl_IncrRefCount(objPtr); /* Local var is a reference. */
} else {
- Tcl_Obj **desiredObjs, *argObj;
- ByteCode *codePtr;
+ goto incorrectArgs;
+ }
+ varPtr++;
- /*
- * Do initialise all compiled locals, to avoid problems at
- * DeleteLocalVars.
- */
+ /*
+ * Initialise and resolve the remaining compiledLocals. In the absence of
+ * resolvers, they are undefined local vars: (flags=0, value=NULL).
+ */
- incorrectArgs:
- codePtr = (ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr;
- InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+ correctArgs:
+ if (numArgs < localCt) {
+ if (!framePtr->nsPtr->compiledVarResProc
+ && !((Interp *)interp)->resolverPtr) {
+ memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
+ } else {
+ InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
+ }
+ }
- /*
- * Build up desired argument list for Tcl_WrongNumArgs
- */
+ return TCL_OK;
- desiredObjs = (Tcl_Obj **)
- ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));
+ /*
+ * Initialise all compiled locals to avoid problems at DeleteLocalVars.
+ */
-#ifdef AVOID_HACKS_FOR_ITCL
- desiredObjs[0] = objv[0];
-#else
- desiredObjs[0] = Tcl_NewListObj(1, objv);
-#endif /* AVOID_HACKS_FOR_ITCL */
+ incorrectArgs:
+ memset(varPtr, 0,
+ ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
+ return ProcWrongNumArgs(interp, skip);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PushProcCallFrame --
+ *
+ * Compiles a proc body if necessary, then pushes a CallFrame suitable
+ * for executing it.
+ *
+ * Results:
+ * A standard Tcl object result value.
+ *
+ * Side effects:
+ * The proc's body may be recompiled. A CallFrame is pushed, it will have
+ * to be popped by the caller.
+ *
+ *----------------------------------------------------------------------
+ */
- localPtr = procPtr->firstLocalPtr;
- for (i=1 ; i<=numArgs ; i++) {
- TclNewObj(argObj);
- if (localPtr->defValuePtr != NULL) {
- Tcl_AppendStringsToObj(argObj,
- "?", localPtr->name, "?", (char *) NULL);
- } else if ((i==numArgs) && !strcmp(localPtr->name, "args")) {
- Tcl_AppendStringsToObj(argObj, "...", (char *) NULL);
- } else {
- Tcl_AppendStringsToObj(argObj, localPtr->name, (char *) NULL);
- }
- desiredObjs[i] = argObj;
- localPtr = localPtr->nextPtr;
- }
+static int
+PushProcCallFrame(
+ ClientData clientData, /* Record describing procedure to be
+ * interpreted. */
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ int objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *const objv[], /* Argument value objects. */
+ int isLambda) /* 1 if this is a call by ApplyObjCmd: it
+ * needs special rules for error msg */
+{
+ Proc *procPtr = clientData;
+ Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
+ CallFrame *framePtr, **framePtrPtr;
+ int result;
+ ByteCode *codePtr;
- Tcl_ResetResult(interp);
- Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL);
- result = TCL_ERROR;
+ /*
+ * If necessary (i.e. if we haven't got a suitable compilation already
+ * cached) compile the procedure's body. The compiler will allocate frame
+ * slots for the procedure's non-argument local variables. Note that
+ * compiling the body might increase procPtr->numCompiledLocals if new
+ * local variables are found while compiling.
+ */
-#ifdef AVOID_HACKS_FOR_ITCL
- for (i=1 ; i<=numArgs ; i++) {
- TclDecrRefCount(desiredObjs[i]);
+ if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * When we've got bytecode, this is the check for validity. That is,
+ * the bytecode must be for the right interpreter (no cross-leaks!),
+ * the code must be from the current epoch (so subcommand compilation
+ * is up-to-date), the namespace must match (so variable handling
+ * is right) and the resolverEpoch must match (so that new shadowed
+ * commands and/or resolver changes are considered).
+ */
+
+ codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ if (((Interp *) *codePtr->interpHandle != iPtr)
+ || (codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsPtr != nsPtr)
+ || (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
+ goto doCompilation;
}
-#else
- for (i=0 ; i<=numArgs ; i++) {
- TclDecrRefCount(desiredObjs[i]);
+ } else {
+ doCompilation:
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+ (isLambda ? "body of lambda term" : "body of proc"),
+ TclGetString(objv[isLambda]));
+ if (result != TCL_OK) {
+ return result;
}
-#endif /* AVOID_HACKS_FOR_ITCL */
- ckfree((char *) desiredObjs);
- goto procDone;
}
- varPtr->name = localPtr->name;
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
+ /*
+ * Set up and push a new call frame for the new procedure invocation.
+ * This call frame will execute in the proc's namespace, which might be
+ * different than the current namespace. The proc's namespace is that of
+ * its command, which can change if the command is renamed from one
+ * namespace to another.
+ */
- localPtr = localPtr->nextPtr;
- varPtr++;
+ framePtrPtr = &framePtr;
+ result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (Tcl_Namespace *) nsPtr,
+ (isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC));
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ framePtr->objc = objc;
+ framePtr->objv = objv;
+ framePtr->procPtr = procPtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInterpProc --
+ *
+ * When a Tcl procedure gets invoked during bytecode evaluation, this
+ * object-based routine gets invoked to interpret the procedure.
+ *
+ * Results:
+ * A standard Tcl object result value.
+ *
+ * Side effects:
+ * Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclObjInterpProc(
+ ClientData clientData, /* Record describing procedure to be
+ * interpreted. */
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ int objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *const objv[]) /* Argument value objects. */
+{
/*
- * Initialise and resolve the remaining compiledLocals.
+ * Not used much in the core; external interface for iTcl
*/
- runProc:
- if (localPtr) {
- ByteCode *codePtr = (ByteCode *)
- procPtr->bodyPtr->internalRep.otherValuePtr;
+ return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
+}
- InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+int
+TclNRInterpProc(
+ ClientData clientData, /* Record describing procedure to be
+ * interpreted. */
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ int objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *const objv[]) /* Argument value objects. */
+{
+ int result = PushProcCallFrame(clientData, interp, objc, objv,
+ /*isLambda*/ 0);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
}
+ return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRInterpProcCore --
+ *
+ * When a Tcl procedure, lambda term or anything else that works like a
+ * procedure gets invoked during bytecode evaluation, this object-based
+ * routine gets invoked to interpret the body.
+ *
+ * Results:
+ * A standard Tcl object result value.
+ *
+ * Side effects:
+ * Nearly anything; depends on the commands in the procedure body.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Invoke the commands in the procedure's body.
- */
+int
+TclNRInterpProcCore(
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
+ int skip, /* Number of initial arguments to be skipped,
+ * i.e., words in the "command name". */
+ ProcErrorProc *errorProc) /* How to convert results from the script into
+ * results of the overall procedure. */
+{
+ Interp *iPtr = (Interp *) interp;
+ register Proc *procPtr = iPtr->varFramePtr->procPtr;
+ int result;
+ CallFrame *freePtr;
+ ByteCode *codePtr;
-#ifdef TCL_COMPILE_DEBUG
+ result = InitArgsAndLocals(interp, procNameObj, skip);
+ if (result != TCL_OK) {
+ freePtr = iPtr->framePtr;
+ Tcl_PopCallFrame(interp); /* Pop but do not free. */
+ TclStackFree(interp, freePtr->compiledLocals);
+ /* Free compiledLocals. */
+ TclStackFree(interp, freePtr); /* Free CallFrame. */
+ return TCL_ERROR;
+ }
+
+#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
- fprintf(stdout, "Calling proc ");
- for (i = 0; i < objc; i++) {
- TclPrintObject(stdout, objv[i], 15);
+ register CallFrame *framePtr = iPtr->varFramePtr;
+ register int i;
+
+ if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
+ fprintf(stdout, "Calling lambda ");
+ } else {
+ fprintf(stdout, "Calling proc ");
+ }
+ for (i = 0; i < framePtr->objc; i++) {
+ TclPrintObject(stdout, framePtr->objv[i], 15);
fprintf(stdout, " ");
}
fprintf(stdout, "\n");
@@ -1347,23 +1780,80 @@ TclObjInterpProc(clientData, interp, objc, objv)
}
#endif /*TCL_COMPILE_DEBUG*/
- procPtr->refCount++;
- result = TclCompEvalObj(interp, procPtr->bodyPtr);
- procPtr->refCount--;
- if (procPtr->refCount <= 0) {
- TclProcCleanupProc(procPtr);
+#ifdef USE_DTRACE
+ if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ const char *a[10];
+ int i;
+
+ for (i = 0 ; i < 10 ; i++) {
+ a[i] = (l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
+ l++;
+ }
+ TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
}
+ if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
+ Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+ const char *a[6]; int i[2];
- if (result != TCL_OK) {
- result = ProcessProcResultCode(interp, procName, nameLen, result);
+ TclDTraceInfo(info, a, i);
+ TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
+ TclDecrRefCount(info);
}
+ 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));
+ }
+ 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 */
/*
- * Pop and free the call frame for this procedure invocation, then free
- * the compiledLocals array if malloc'ed storage was used.
+ * Invoke the commands in the procedure's body.
*/
- procDone:
+ procPtr->refCount++;
+ codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+
+ TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
+ NULL, NULL);
+ return TclNRExecuteByteCode(interp, codePtr);
+}
+
+static int
+InterpProcNR2(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Proc *procPtr = iPtr->varFramePtr->procPtr;
+ CallFrame *freePtr;
+ Tcl_Obj *procNameObj = data[0];
+ ProcErrorProc *errorProc = (ProcErrorProc *)data[1];
+
+ if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+ TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
+ }
+ if (--procPtr->refCount <= 0) {
+ TclProcCleanupProc(procPtr);
+ }
+
/*
* Free the stack-allocated compiled locals and CallFrame. It is important
* to pop the call frame without freeing it first: the compiledLocals
@@ -1372,11 +1862,68 @@ TclObjInterpProc(clientData, interp, objc, objv)
* allocated later on the stack.
*/
- Tcl_PopCallFrame(interp); /* pop but do not free */
- TclStackFree(interp); /* free compiledLocals */
- TclStackFree(interp); /* free CallFrame */
+ if (result != TCL_OK) {
+ goto process;
+ }
+
+ done:
+ if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+ TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+ TclGetString(r), r);
+ }
+
+ freePtr = iPtr->framePtr;
+ Tcl_PopCallFrame(interp); /* Pop but do not free. */
+ TclStackFree(interp, freePtr->compiledLocals);
+ /* Free compiledLocals. */
+ TclStackFree(interp, freePtr); /* Free CallFrame. */
return result;
-#undef NUM_LOCALS
+
+ /*
+ * Process any non-TCL_OK result code.
+ */
+
+ process:
+ switch (result) {
+ case TCL_RETURN:
+ /*
+ * If it is a 'return', do the TIP#90 processing now.
+ */
+
+ result = TclUpdateReturnInfo((Interp *) interp);
+ break;
+
+ case TCL_CONTINUE:
+ case TCL_BREAK:
+ /*
+ * It's an error to get to this point from a 'break' or 'continue', so
+ * transform to an error now.
+ */
+
+ 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;
+
+ /*
+ * Fall through to the TCL_ERROR handling code.
+ */
+
+ case TCL_ERROR:
+ /*
+ * Now it _must_ be an error, so we need to log it as such. This means
+ * filling out the error trace. Luckily, we just hand this off to the
+ * function handed to us as an argument.
+ */
+
+ errorProc(interp, procNameObj);
+ }
+ goto done;
}
/*
@@ -1387,7 +1934,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
* Called just before a procedure is executed to compile the body to byte
* codes. If the type of the body is not "byte code" or if the compile
* conditions have changed (namespace context, epoch counters, etc.) then
- * the body is recompiled. Otherwise, this function does nothing.
+ * the body is recompiled. Otherwise, this function does nothing.
*
* Results:
* None.
@@ -1400,21 +1947,19 @@ TclObjInterpProc(clientData, interp, objc, objv)
*/
int
-TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
- Tcl_Interp *interp; /* Interpreter containing procedure. */
- Proc *procPtr; /* Data associated with procedure. */
- Tcl_Obj *bodyPtr; /* Body of proc. (Usually procPtr->bodyPtr,
- * but could be any code fragment compiled in
- * the context of this procedure.) */
- Namespace *nsPtr; /* Namespace containing procedure. */
- CONST char *description; /* string describing this body of code. */
- CONST char *procName; /* Name of this procedure. */
+TclProcCompileProc(
+ Tcl_Interp *interp, /* Interpreter containing procedure. */
+ Proc *procPtr, /* Data associated with procedure. */
+ Tcl_Obj *bodyPtr, /* Body of proc. (Usually procPtr->bodyPtr,
+ * but could be any code fragment compiled in
+ * the context of this procedure.) */
+ Namespace *nsPtr, /* Namespace containing procedure. */
+ const char *description, /* string describing this body of code. */
+ const char *procName) /* Name of this procedure. */
{
- Interp *iPtr = (Interp*)interp;
- int result;
+ Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
- Proc *saveProcPtr;
- ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
/*
* If necessary, compile the procedure's body. The compiler will allocate
@@ -1431,83 +1976,119 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
*/
if (bodyPtr->typePtr == &tclByteCodeType) {
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsPtr != nsPtr)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_AppendResult(interp,
- "a precompiled script jumped interps", NULL);
- return TCL_ERROR;
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- codePtr->nsPtr = nsPtr;
- } else {
- bodyPtr->typePtr->freeIntRepProc(bodyPtr);
- bodyPtr->typePtr = (Tcl_ObjType *) NULL;
+ if (((Interp *) *codePtr->interpHandle == iPtr)
+ && (codePtr->compileEpoch == iPtr->compileEpoch)
+ && (codePtr->nsPtr == nsPtr)
+ && (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
+ return TCL_OK;
+ }
+
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
+ 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 {
+ TclFreeIntRep(bodyPtr);
+ }
}
+
if (bodyPtr->typePtr != &tclByteCodeType) {
+ Tcl_HashEntry *hePtr;
+
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 1) {
- /*
- * Display a line summarizing the top level command we are about
- * to compile.
- */
+ if (tclTraceCompile >= 1) {
+ /*
+ * Display a line summarizing the top level command we are about
+ * to compile.
+ */
- Tcl_Obj *message = Tcl_NewStringObj("Compiling ", -1);
+ Tcl_Obj *message;
+ TclNewLiteralStringObj(message, "Compiling ");
Tcl_IncrRefCount(message);
Tcl_AppendStringsToObj(message, description, " \"", NULL);
- TclAppendLimitedToObj(message, procName, -1, 50, NULL);
- fprintf(stdout, "%s\"\n", TclGetString(message));
+ Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
+ fprintf(stdout, "%s\"\n", TclGetString(message));
Tcl_DecrRefCount(message);
- }
+ }
#endif
- /*
- * Plug the current procPtr into the interpreter and coerce the code
- * body to byte codes. The interpreter needs to know which proc it's
- * compiling so that it can access its list of compiled locals.
- *
- * TRICKY NOTE: Be careful to push a call frame with the proper
- * namespace context, so that the byte codes are compiled in the
- * appropriate class context.
- */
+ /*
+ * Plug the current procPtr into the interpreter and coerce the code
+ * body to byte codes. The interpreter needs to know which proc it's
+ * compiling so that it can access its list of compiled locals.
+ *
+ * TRICKY NOTE: Be careful to push a call frame with the proper
+ * namespace context, so that the byte codes are compiled in the
+ * appropriate class context.
+ */
+
+ iPtr->compiledProcPtr = procPtr;
- saveProcPtr = iPtr->compiledProcPtr;
- iPtr->compiledProcPtr = procPtr;
+ if (procPtr->numCompiledLocals > procPtr->numArgs) {
+ CompiledLocal *clPtr = procPtr->firstLocalPtr;
+ CompiledLocal *lastPtr = NULL;
+ int i, numArgs = procPtr->numArgs;
- result = TclPushStackFrame(interp, &framePtr,
- (Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0);
+ for (i = 0; i < numArgs; i++) {
+ lastPtr = clPtr;
+ clPtr = clPtr->nextPtr;
+ }
- if (result == TCL_OK) {
- result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
- TclPopStackFrame(interp);
+ if (lastPtr) {
+ lastPtr->nextPtr = NULL;
+ } else {
+ procPtr->firstLocalPtr = NULL;
+ }
+ procPtr->lastLocalPtr = lastPtr;
+ while (clPtr) {
+ CompiledLocal *toFree = clPtr;
+
+ clPtr = clPtr->nextPtr;
+ if (toFree->resolveInfo) {
+ if (toFree->resolveInfo->deleteProc) {
+ toFree->resolveInfo->deleteProc(toFree->resolveInfo);
+ } else {
+ ckfree(toFree->resolveInfo);
+ }
+ }
+ ckfree(toFree);
+ }
+ procPtr->numCompiledLocals = procPtr->numArgs;
}
- iPtr->compiledProcPtr = saveProcPtr;
+ TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
+ /* isProcCallFrame */ 0);
+
+ /*
+ * TIP #280: We get the invoking context from the cmdFrame which
+ * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
+ */
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- int length = strlen(procName);
- int limit = 50;
- int overflow = (length > limit);
+ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
- TclFormatToErrorInfo(interp,
- "\n (compiling %s \"%.*s%s\", line %d)",
- description, (overflow ? limit : length), procName,
- (overflow ? "..." : ""), interp->errorLine);
- }
- return result;
- }
+ /*
+ * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
+ */
+
+ iPtr->invokeWord = 0;
+ iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
+ TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
+ iPtr->invokeCmdFramePtr = NULL;
+ TclPopStackFrame(interp);
} else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
/*
* The resolver epoch has changed, but we only need to invalidate the
* resolver cache.
*/
+ codePtr->nsEpoch = nsPtr->resolverEpoch;
codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS;
}
return TCL_OK;
@@ -1516,56 +2097,36 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
/*
*----------------------------------------------------------------------
*
- * ProcessProcResultCode --
+ * MakeProcError --
*
- * Function called by TclObjInterpProc to process a return code other
- * than TCL_OK returned by a Tcl procedure.
+ * Function called by TclObjInterpProc to create the stack information
+ * upon an error from a procedure.
*
* Results:
- * Depending on the argument return code, the result returned is another
- * return code and the interpreter's result is set to a value to
- * supplement that return code.
+ * The interpreter's error info trace is set to a value that supplements
+ * the error code.
*
* Side effects:
- * If the result returned is TCL_ERROR, traceback information about the
- * procedure just executed is appended to the interpreter's errorInfo
- * field.
+ * none.
*
*----------------------------------------------------------------------
*/
-static int
-ProcessProcResultCode(interp, procName, nameLen, returnCode)
- Tcl_Interp *interp; /* The interpreter in which the procedure was
- * called and returned returnCode. */
- char *procName; /* Name of the procedure. Used for error
+static void
+MakeProcError(
+ Tcl_Interp *interp, /* The interpreter in which the procedure was
+ * called. */
+ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error
* messages and trace information. */
- int nameLen; /* Number of bytes in procedure's name. */
- int returnCode; /* The unexpected result code. */
{
- Interp *iPtr = (Interp *) interp;
- int overflow, limit = 60;
+ int overflow, limit = 60, nameLen;
+ const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
- if (returnCode == TCL_OK) {
- return TCL_OK;
- }
- if ((returnCode > TCL_CONTINUE) || (returnCode < TCL_OK)) {
- return returnCode;
- }
- if (returnCode == TCL_RETURN) {
- return TclUpdateReturnInfo(iPtr);
- }
- if (returnCode != TCL_ERROR) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "invoked \"",
- ((returnCode == TCL_BREAK) ? "break" : "continue"),
- "\" outside of a loop", NULL);
- }
overflow = (nameLen > limit);
- TclFormatToErrorInfo(interp, "\n (procedure \"%.*s%s\" line %d)",
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (procedure \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine);
- return TCL_ERROR;
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
@@ -1589,10 +2150,10 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
*/
void
-TclProcDeleteProc(clientData)
- ClientData clientData; /* Procedure to be deleted. */
+TclProcDeleteProc(
+ ClientData clientData) /* Procedure to be deleted. */
{
- Proc *procPtr = (Proc *) clientData;
+ Proc *procPtr = clientData;
procPtr->refCount--;
if (procPtr->refCount <= 0) {
@@ -1618,13 +2179,16 @@ TclProcDeleteProc(clientData)
*/
void
-TclProcCleanupProc(procPtr)
- register Proc *procPtr; /* Procedure to be deleted. */
+TclProcCleanupProc(
+ register Proc *procPtr) /* Procedure to be deleted. */
{
register CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
Tcl_Obj *defPtr;
Tcl_ResolvedVarInfo *resVarInfo;
+ Tcl_HashEntry *hePtr = NULL;
+ CmdFrame *cfPtr = NULL;
+ Interp *iPtr = procPtr->iPtr;
if (bodyPtr != NULL) {
Tcl_DecrRefCount(bodyPtr);
@@ -1635,9 +2199,9 @@ TclProcCleanupProc(procPtr)
resVarInfo = localPtr->resolveInfo;
if (resVarInfo) {
if (resVarInfo->deleteProc) {
- (*resVarInfo->deleteProc)(resVarInfo);
+ resVarInfo->deleteProc(resVarInfo);
} else {
- ckfree((char *) resVarInfo);
+ ckfree(resVarInfo);
}
}
@@ -1645,10 +2209,38 @@ TclProcCleanupProc(procPtr)
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
+ * structure, if any. The interpreter may not exist (For example for
+ * procbody structures created by tbcload.
+ */
+
+ if (iPtr == NULL) {
+ return;
+ }
+
+ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
+ if (!hePtr) {
+ return;
+ }
+
+ cfPtr = Tcl_GetHashValue(hePtr);
+
+ 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);
+ }
+ Tcl_DeleteHashEntry(hePtr);
}
/*
@@ -1657,7 +2249,7 @@ TclProcCleanupProc(procPtr)
* TclUpdateReturnInfo --
*
* This function is called when procedures return, and at other points
- * where the TCL_RETURN code is used. It examines the returnLevel and
+ * where the TCL_RETURN code is used. It examines the returnLevel and
* returnCode to determine the real return status.
*
* Results:
@@ -1671,8 +2263,8 @@ TclProcCleanupProc(procPtr)
*/
int
-TclUpdateReturnInfo(iPtr)
- Interp *iPtr; /* Interpreter for which TCL_RETURN exception
+TclUpdateReturnInfo(
+ Interp *iPtr) /* Interpreter for which TCL_RETURN exception
* is being processed. */
{
int code = TCL_RETURN;
@@ -1684,9 +2276,17 @@ TclUpdateReturnInfo(iPtr)
if (iPtr->returnLevel == 0) {
/*
* Now we've reached the level to return the requested -code.
+ * Since iPtr->returnLevel and iPtr->returnCode have completed
+ * their task, we now reset them to default values so that any
+ * bare "return TCL_RETURN" that may follow will work [Bug 2152286].
*/
code = iPtr->returnCode;
+ iPtr->returnLevel = 1;
+ iPtr->returnCode = TCL_OK;
+ if (code == TCL_ERROR) {
+ iPtr->flags |= ERR_LEGACY_COPY;
+ }
}
return code;
}
@@ -1711,7 +2311,7 @@ TclUpdateReturnInfo(iPtr)
*/
TclObjCmdProcType
-TclGetObjInterpProc()
+TclGetObjInterpProc(void)
{
return (TclObjCmdProcType) TclObjInterpProc;
}
@@ -1722,11 +2322,11 @@ TclGetObjInterpProc()
* TclNewProcBodyObj --
*
* Creates a new object, of type "procbody", whose internal
- * representation is the given Proc struct. The newly created object's
+ * representation is the given Proc struct. The newly created object's
* reference count is 0.
*
* Results:
- * Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
+ * Returns a pointer to a newly allocated Tcl_Obj, NULL on error.
*
* Side effects:
* The reference count in the ByteCode attached to the Proc is bumped up
@@ -1736,21 +2336,20 @@ TclGetObjInterpProc()
*/
Tcl_Obj *
-TclNewProcBodyObj(procPtr)
- Proc *procPtr; /* the Proc struct to store as the internal
+TclNewProcBodyObj(
+ Proc *procPtr) /* the Proc struct to store as the internal
* representation. */
{
Tcl_Obj *objPtr;
if (!procPtr) {
- return (Tcl_Obj *) NULL;
+ return NULL;
}
- objPtr = Tcl_NewStringObj("", 0);
-
+ TclNewObj(objPtr);
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
procPtr->refCount++;
}
@@ -1763,7 +2362,7 @@ TclNewProcBodyObj(procPtr)
*
* ProcBodyDup --
*
- * Tcl_ObjType's Dup function for the proc body object. Bumps the
+ * Tcl_ObjType's Dup function for the proc body object. Bumps the
* reference count on the Proc stored in the internal representation.
*
* Results:
@@ -1776,14 +2375,14 @@ TclNewProcBodyObj(procPtr)
*/
static void
-ProcBodyDup(srcPtr, dupPtr)
- Tcl_Obj *srcPtr; /* object to copy */
- Tcl_Obj *dupPtr; /* target object for the duplication */
+ProcBodyDup(
+ Tcl_Obj *srcPtr, /* Object to copy. */
+ Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
- Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
+ Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
dupPtr->typePtr = &tclProcBodyType;
- dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+ dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
procPtr->refCount++;
}
@@ -1807,56 +2406,651 @@ ProcBodyDup(srcPtr, dupPtr)
*/
static void
-ProcBodyFree(objPtr)
- Tcl_Obj *objPtr; /* the object to clean up */
+ProcBodyFree(
+ Tcl_Obj *objPtr) /* The object to clean up. */
{
- Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
+ Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (procPtr->refCount-- < 2) {
+ TclProcCleanupProc(procPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupLambdaInternalRep, FreeLambdaInternalRep, SetLambdaFromAny --
+ *
+ * How to manage the internal representations of lambda term objects.
+ * Syntactically they look like a two- or three-element list, where the
+ * first element is the formal arguments, the second is the the body, and
+ * the (optional) third is the namespace to execute the lambda term
+ * within (the global namespace is assumed if it is absent).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupLambdaInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
+
+ copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+
+ procPtr->refCount++;
+ Tcl_IncrRefCount(nsObjPtr);
+ copyPtr->typePtr = &lambdaType;
+}
+
+static void
+FreeLambdaInternalRep(
+ register Tcl_Obj *objPtr) /* CmdName object with internal representation
+ * to free. */
+{
+ Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
+
procPtr->refCount--;
- if (procPtr->refCount <= 0) {
+ if (procPtr->refCount == 0) {
TclProcCleanupProc(procPtr);
}
+ TclDecrRefCount(nsObjPtr);
+ objPtr->typePtr = NULL;
+}
+
+static int
+SetLambdaFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
+{
+ Interp *iPtr = (Interp *) interp;
+ const char *name;
+ 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(NULL, objPtr, &objc, &objv);
+ if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
+ 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;
+ }
+
+ argsPtr = objv[0];
+ bodyPtr = objv[1];
+
+ /*
+ * Create and initialize the Proc struct. The cmdPtr field is set to NULL
+ * to signal that this is an anonymous function.
+ */
+
+ name = TclGetString(objPtr);
+
+ if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr,
+ &procPtr) != TCL_OK) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (parsing lambda expression \"%s\")", name));
+ return TCL_ERROR;
+ }
+
+ /*
+ * CAREFUL: TclCreateProc returns refCount==1! [Bug 1578454]
+ * procPtr->refCount = 1;
+ */
+
+ procPtr->cmdPtr = NULL;
+
+ /*
+ * TIP #280: Remember the line the apply body is starting on. In a Byte
+ * code context we ask the engine to provide us with the necessary
+ * information. This is for the initialization of the byte code compiler
+ * when the body is used for the first time.
+ *
+ * NOTE: The body is the second word in the 'objPtr'. Its location,
+ * accessible through 'context.line[1]' (see below) is therefore only the
+ * first approximation of the actual line the body is on. We have to use
+ * the string rep of the 'objPtr' to determine the exact line. This is
+ * available already through 'name'. Use 'TclListLines', see 'switch'
+ * (tclCmdMZ.c).
+ *
+ * This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see
+ * this file. The differences are the different index of the body in the
+ * line array of the context, and the special processing mentioned in the
+ * previous paragraph to track into the list. Find a way to factor the
+ * common elements into a single function.
+ */
+
+ if (iPtr->cmdFramePtr) {
+ CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+
+ *contextPtr = *iPtr->cmdFramePtr;
+ if (contextPtr->type == TCL_LOCATION_BC) {
+ /*
+ * Retrieve the source context from the bytecode. This call
+ * accounts for the reference to the source file, if any, held in
+ * 'context.data.eval.path'.
+ */
+
+ TclGetSrcInfoForPc(contextPtr);
+ } else if (contextPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * We created a new reference to the source file path name when we
+ * created 'context' above. Account for the reference.
+ */
+
+ Tcl_IncrRefCount(contextPtr->data.eval.path);
+
+ }
+
+ if (contextPtr->type == TCL_LOCATION_SOURCE) {
+ /*
+ * We can record source location within a lambda only if the body
+ * was not created by substitution.
+ */
+
+ if (contextPtr->line
+ && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
+ 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 = ckalloc(sizeof(int));
+ cfPtr->line[0] = buf[1];
+ cfPtr->nline = 1;
+ cfPtr->framePtr = NULL;
+ cfPtr->nextPtr = NULL;
+
+ cfPtr->data.eval.path = contextPtr->data.eval.path;
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+ cfPtr->cmd = NULL;
+ cfPtr->len = 0;
+ }
+
+ /*
+ * 'contextPtr' is going out of scope. Release the reference that
+ * it's holding to the source file path
+ */
+
+ Tcl_DecrRefCount(contextPtr->data.eval.path);
+ }
+ 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
+ * global reference, or else global per default.
+ */
+
+ if (objc == 2) {
+ TclNewLiteralStringObj(nsObjPtr, "::");
+ } else {
+ const char *nsName = TclGetString(objv[2]);
+
+ if ((*nsName != ':') || (*(nsName+1) != ':')) {
+ TclNewLiteralStringObj(nsObjPtr, "::");
+ Tcl_AppendObjToObj(nsObjPtr, objv[2]);
+ } else {
+ nsObjPtr = objv[2];
+ }
+ }
+
+ Tcl_IncrRefCount(nsObjPtr);
+
+ /*
+ * Free the list internalrep of objPtr - this will free argsPtr, but
+ * bodyPtr retains a reference from the Proc structure. Then finish the
+ * conversion to lambdaType.
+ */
+
+ TclFreeIntRep(objPtr);
+
+ objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+ objPtr->typePtr = &lambdaType;
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileNoOp --
+ * Tcl_ApplyObjCmd --
*
- * Function called to compile no-op's
+ * This object-based function is invoked to process the "apply" Tcl
+ * command. See the user documentation for details on what it does.
*
* Results:
- * The return value is TCL_OK, indicating successful compilation.
+ * A standard Tcl object result value.
*
* Side effects:
- * Instructions are added to envPtr to execute a no-op at runtime.
+ * Depends on the content of the lambda term (i.e., objv[1]).
*
*----------------------------------------------------------------------
*/
+int
+Tcl_ApplyObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRApplyObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Proc *procPtr = NULL;
+ Tcl_Obj *lambdaPtr, *nsObjPtr;
+ int result, isRootEnsemble;
+ Tcl_Namespace *nsPtr;
+ ApplyExtraData *extraPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set lambdaPtr, convert it to lambdaType in the current interp if
+ * necessary.
+ */
+
+ lambdaPtr = objv[1];
+ if (lambdaPtr->typePtr == &lambdaType) {
+ procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+ }
+
+#define JOE_EXTENSION 0
+/*
+ * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT
+ * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt
+ * the code. (MS)
+ */
+
+#if JOE_EXTENSION
+ else {
+ /*
+ * Joe English's suggestion to allow cmdNames to function as lambdas.
+ */
+
+ Tcl_Obj *elemPtr;
+ int numElem;
+
+ if ((lambdaPtr->typePtr == &tclCmdNameType) ||
+ (TclListObjGetElements(interp, lambdaPtr, &numElem,
+ &elemPtr) == TCL_OK && numElem == 1)) {
+ return Tcl_EvalObjv(interp, objc-1, objv+1, 0);
+ }
+ }
+#endif
+
+ if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
+ result = SetLambdaFromAny(interp, lambdaPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+ }
+
+ /*
+ * Find the namespace where this lambda should run, and push a call frame
+ * for that namespace. Note that TclObjInterpProc() will pop it.
+ */
+
+ nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
+ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
+ memset(&extraPtr->cmd, 0, sizeof(Command));
+ procPtr->cmdPtr = &extraPtr->cmd;
+ extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
+
+ /*
+ * TIP#280 (semi-)HACK!
+ *
+ * Using cmd.clientData to tell [info frame] how to render the lambdaPtr.
+ * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL.
+ * This condition holds here because of the memset() above, and nowhere
+ * else (in the core). Regular commands always have a valid hPtr, and
+ * lambda's never.
+ */
+
+ extraPtr->efi.length = 1;
+ extraPtr->efi.fields[0].name = "lambda";
+ extraPtr->efi.fields[0].proc = NULL;
+ extraPtr->efi.fields[0].clientData = lambdaPtr;
+ extraPtr->cmd.clientData = &extraPtr->efi;
+
+ isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 1;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs -= 1;
+ }
+ extraPtr->isRootEnsemble = isRootEnsemble;
+
+ result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
+ if (result == TCL_OK) {
+ TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
+ result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
+ }
+ return result;
+}
+
static int
-TclCompileNoOp(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ApplyNR2(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
{
- Tcl_Token *tokenPtr;
- int i;
- int savedStackDepth = envPtr->currStackDepth;
+ ApplyExtraData *extraPtr = data[0];
- tokenPtr = parsePtr->tokenPtr;
- for(i = 1; i < parsePtr->numWords; i++) {
- tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
- envPtr->currStackDepth = savedStackDepth;
+ if (extraPtr->isRootEnsemble) {
+ ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
+ }
+
+ TclStackFree(interp, extraPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeLambdaError --
+ *
+ * Function called by TclObjInterpProc to create the stack information
+ * upon an error from a lambda term.
+ *
+ * Results:
+ * The interpreter's error info trace is set to a value that supplements
+ * the error code.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MakeLambdaError(
+ Tcl_Interp *interp, /* The interpreter in which the procedure was
+ * called. */
+ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error
+ * messages and trace information. */
+{
+ int overflow, limit = 60, nameLen;
+ const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
- envPtr);
- TclEmitOpcode(INST_POP, envPtr);
+ overflow = (nameLen > limit);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (lambda term \"%.*s%s\" line %d)",
+ (overflow ? limit : nameLen), procName,
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DisassembleObjCmd --
+ *
+ * Implementation of the "::tcl::unsupported::disassemble" command. This
+ * command is not documented, but will disassemble procedures, lambda
+ * terms and general scripts. Note that will compile terms if necessary
+ * in order to disassemble them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DisassembleObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const types[] = {
+ "lambda", "method", "objmethod", "proc", "script", NULL
+ };
+ enum Types {
+ DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
+ DISAS_SCRIPT
+ };
+ int idx, result;
+ Tcl_Obj *codeObjPtr = NULL;
+ Proc *procPtr = NULL;
+ Tcl_HashEntry *hPtr;
+ Object *oPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type ...");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+ return TCL_ERROR;
+ }
+
+ switch ((enum Types) idx) {
+ case DISAS_LAMBDA: {
+ Command cmd;
+ Tcl_Obj *nsObjPtr;
+ Tcl_Namespace *nsPtr;
+
+ /*
+ * Compile (if uncompiled) and disassemble a lambda term.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
+ return TCL_ERROR;
+ }
+ if (objv[2]->typePtr == &lambdaType) {
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+ if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+ result = SetLambdaFromAny(interp, objv[2]);
+ if (result != TCL_OK) {
+ return result;
+ }
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+
+ memset(&cmd, 0, sizeof(Command));
+ nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+ if (result != TCL_OK) {
+ return result;
}
+ cmd.nsPtr = (Namespace *) nsPtr;
+ procPtr->cmdPtr = &cmd;
+ result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ }
+ case DISAS_PROC:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "procName");
+ return TCL_ERROR;
+ }
+
+ 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;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "script");
+ return TCL_ERROR;
+ }
+ if ((objv[2]->typePtr != &tclByteCodeType)
+ && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ codeObjPtr = objv[2];
+ break;
+
+ case DISAS_CLASS_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a class method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == 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,
+ (char *) objv[3]);
+ goto methodBody;
+ case DISAS_OBJECT_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of an instance method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->methodsPtr == NULL) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+
+ /*
+ * Compile (if necessary) and disassemble a method body.
+ */
+
+ methodBody:
+ if (hPtr == NULL) {
+ unknownMethod:
+ 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_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) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of method",
+ TclGetString(objv[3]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ default:
+ CLANG_ASSERT(0);
+ }
+
+ /*
+ * Do the actual disassembly.
+ */
+
+ if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags
+ & TCL_BYTECODE_PRECOMPILED) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not disassemble prebuilt bytecode", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "BYTECODE", NULL);
+ return TCL_ERROR;
}
- envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
return TCL_OK;
}
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 98458a6..6348e4a 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.20 2005/07/21 14:38:51 dkf Exp $
*/
#include "tclInt.h"
@@ -55,8 +53,8 @@
*
* *** NOTE: this code has been altered slightly for use in Tcl: ***
* *** 1. Names have been changed, e.g. from re_comp to ***
- * *** TclRegComp, to avoid clashes with other ***
- * *** regexp implementations used by applications. ***
+ * *** TclRegComp, to avoid clashes with other ***
+ * *** regexp implementations used by applications. ***
*/
/*
@@ -85,25 +83,24 @@ static Tcl_ThreadDataKey dataKey;
* Declarations for functions used only in this file.
*/
-static TclRegexp * CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *pattern, int length, int flags));
-static void DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FinalizeRegexp _ANSI_ARGS_((ClientData clientData));
-static void FreeRegexp _ANSI_ARGS_((TclRegexp *regexpPtr));
-static void FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int RegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_RegExp re, CONST Tcl_UniChar *uniString,
- int numChars, int nmatches, int flags));
-static int SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+static TclRegexp * CompileRegexp(Tcl_Interp *interp, const char *pattern,
+ int length, int flags);
+static void DupRegexpInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static void FinalizeRegexp(ClientData clientData);
+static void FreeRegexp(TclRegexp *regexpPtr);
+static void FreeRegexpInternalRep(Tcl_Obj *objPtr);
+static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
+ const Tcl_UniChar *uniString, int numChars,
+ int nmatches, int flags);
+static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
* The regular expression Tcl object type. This serves as a cache of the
* compiled form of the regular expression.
*/
-Tcl_ObjType tclRegexpType = {
+const Tcl_ObjType tclRegexpType = {
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
@@ -134,10 +131,10 @@ Tcl_ObjType tclRegexpType = {
*/
Tcl_RegExp
-Tcl_RegExpCompile(interp, pattern)
- Tcl_Interp *interp; /* For use in error reporting and to access
+Tcl_RegExpCompile(
+ Tcl_Interp *interp, /* For use in error reporting and to access
* the interp regexp cache. */
- CONST char *pattern; /* String for which to produce compiled
+ const char *pattern) /* String for which to produce compiled
* regular expression. */
{
return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern),
@@ -165,20 +162,20 @@ Tcl_RegExpCompile(interp, pattern)
*/
int
-Tcl_RegExpExec(interp, re, text, start)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; must have been
+Tcl_RegExpExec(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
- CONST char *text; /* Text against which to match re. */
- CONST char *start; /* If text is part of a larger string, this
+ const char *text, /* Text against which to match re. */
+ const char *start) /* If text is part of a larger string, this
* identifies beginning of larger string, so
* that "^" won't match. */
{
int flags, result, numChars;
- TclRegexp *regexp = (TclRegexp *)re;
+ TclRegexp *regexp = (TclRegexp *) re;
Tcl_DString ds;
- CONST Tcl_UniChar *ustr;
+ const Tcl_UniChar *ustr;
/*
* If the starting point is offset from the beginning of the buffer, then
@@ -232,19 +229,19 @@ Tcl_RegExpExec(interp, re, text, start)
*/
void
-Tcl_RegExpRange(re, index, startPtr, endPtr)
- Tcl_RegExp re; /* Compiled regular expression that has been
+Tcl_RegExpRange(
+ Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
- int index; /* 0 means give the range of the entire match,
+ int index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange. */
- CONST char **startPtr; /* Store address of first character in
+ const char **startPtr, /* Store address of first character in
* (sub-)range here. */
- CONST char **endPtr; /* Store address of character just after last
+ const char **endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
- CONST char *string;
+ const char *string;
if ((size_t) index > regexpPtr->re.re_nsub) {
*startPtr = *endPtr = NULL;
@@ -252,7 +249,7 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
*startPtr = *endPtr = NULL;
} else {
if (regexpPtr->objPtr) {
- string = Tcl_GetString(regexpPtr->objPtr);
+ string = TclGetString(regexpPtr->objPtr);
} else {
string = regexpPtr->string;
}
@@ -282,17 +279,17 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
*/
static int
-RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; returned by a
+RegExpExecUniChar(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; returned by a
* previous call to Tcl_GetRegExpFromObj */
- CONST Tcl_UniChar *wString; /* String against which to match re. */
- int numChars; /* Length of Tcl_UniChar string (must be
+ const Tcl_UniChar *wString, /* String against which to match re. */
+ int numChars, /* Length of Tcl_UniChar string (must be
* >=0). */
- int nmatches; /* How many subexpression matches (counting
+ int nmatches, /* How many subexpression matches (counting
* the whole match as subexpression 0) are of
* interest. -1 means "don't know". */
- int flags; /* Regular expression flags. */
+ int flags) /* Regular expression flags. */
{
int status;
TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -344,16 +341,16 @@ RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
*/
void
-TclRegExpRangeUniChar(re, index, startPtr, endPtr)
- Tcl_RegExp re; /* Compiled regular expression that has been
+TclRegExpRangeUniChar(
+ Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
- int index; /* 0 means give the range of the entire match,
+ int index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange, -1 means the range of the
* rm_extend field. */
- int *startPtr; /* Store address of first character in
+ int *startPtr, /* Store address of first character in
* (sub-)range here. */
- int *endPtr; /* Store address of character just after last
+ int *endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -389,14 +386,13 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr)
*/
int
-Tcl_RegExpMatch(interp, text, pattern)
- Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
- CONST char *text; /* Text to search for pattern matches. */
- CONST char *pattern; /* Regular expression to match against text. */
+Tcl_RegExpMatch(
+ Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
+ const char *text, /* Text to search for pattern matches. */
+ const char *pattern) /* Regular expression to match against text. */
{
- Tcl_RegExp re;
+ Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern);
- re = Tcl_RegExpCompile(interp, pattern);
if (re == NULL) {
return -1;
}
@@ -422,22 +418,44 @@ Tcl_RegExpMatch(interp, text, pattern)
*/
int
-Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; must have been
+Tcl_RegExpExecObj(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
- Tcl_Obj *textObj; /* Text against which to match re. */
- int offset; /* Character index that marks where matching
+ Tcl_Obj *textObj, /* Text against which to match re. */
+ int offset, /* Character index that marks where matching
* should begin. */
- int nmatches; /* How many subexpression matches (counting
+ int nmatches, /* How many subexpression matches (counting
* the whole match as subexpression 0) are of
* interest. -1 means all of them. */
- int flags; /* Regular expression execution flags. */
+ int flags) /* Regular expression execution flags. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
Tcl_UniChar *udata;
int length;
+ int reflags = regexpPtr->flags;
+#define TCL_REG_GLOBOK_FLAGS \
+ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
+
+ /*
+ * Take advantage of the equivalent glob pattern, if one exists.
+ * This is possible based only on the right mix of incoming flags (0)
+ * and regexp compile flags.
+ */
+ if ((offset == 0) && (nmatches == 0) && (flags == 0)
+ && !(reflags & ~TCL_REG_GLOBOK_FLAGS)
+ && (regexpPtr->globObjPtr != NULL)) {
+ int nocase = (reflags & TCL_REG_NOCASE) ? TCL_MATCH_NOCASE : 0;
+
+ /*
+ * Pass to TclStringMatchObj for obj-specific handling.
+ * XXX: Currently doesn't take advantage of exact-ness that
+ * XXX: TclReToGlob tells us about
+ */
+
+ return TclStringMatchObj(textObj, regexpPtr->globObjPtr, nocase);
+ }
/*
* Save the target object so we can extract strings from it later.
@@ -476,10 +494,10 @@ Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags)
*/
int
-Tcl_RegExpMatchObj(interp, textObj, patternObj)
- Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
- Tcl_Obj *textObj; /* Object containing the String to search. */
- Tcl_Obj *patternObj; /* Regular expression to match against
+Tcl_RegExpMatchObj(
+ Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
+ Tcl_Obj *textObj, /* Object containing the String to search. */
+ Tcl_Obj *patternObj) /* Regular expression to match against
* string. */
{
Tcl_RegExp re;
@@ -510,9 +528,9 @@ Tcl_RegExpMatchObj(interp, textObj, patternObj)
*/
void
-Tcl_RegExpGetInfo(regexp, infoPtr)
- Tcl_RegExp regexp; /* Pattern from which to get subexpressions. */
- Tcl_RegExpInfo *infoPtr; /* Match information is stored here. */
+Tcl_RegExpGetInfo(
+ Tcl_RegExp regexp, /* Pattern from which to get subexpressions. */
+ Tcl_RegExpInfo *infoPtr) /* Match information is stored here. */
{
TclRegexp *regexpPtr = (TclRegexp *) regexp;
@@ -542,28 +560,28 @@ Tcl_RegExpGetInfo(regexp, infoPtr)
*/
Tcl_RegExp
-Tcl_GetRegExpFromObj(interp, objPtr, flags)
- Tcl_Interp *interp; /* For use in error reporting, and to access
+Tcl_GetRegExpFromObj(
+ Tcl_Interp *interp, /* For use in error reporting, and to access
* the interp regexp cache. */
- Tcl_Obj *objPtr; /* Object whose string rep contains regular
+ Tcl_Obj *objPtr, /* Object whose string rep contains regular
* expression pattern. Internal rep will be
* changed to compiled form of this regular
* expression. */
- int flags; /* Regular expression compilation flags. */
+ int flags) /* Regular expression compilation flags. */
{
int length;
TclRegexp *regexpPtr;
- char *pattern;
+ const char *pattern;
/*
* This is OK because we only actually interpret this value properly as a
* TclRegexp* when the type is tclRegexpType.
*/
- regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+ regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
- pattern = Tcl_GetStringFromObj(objPtr, &length);
+ pattern = TclGetStringFromObj(objPtr, &length);
regexpPtr = CompileRegexp(interp, pattern, length, flags);
if (regexpPtr == NULL) {
@@ -583,7 +601,7 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
objPtr->typePtr = &tclRegexpType;
}
return (Tcl_RegExp) regexpPtr;
@@ -609,16 +627,16 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
*/
int
-TclRegAbout(interp, re)
- Tcl_Interp *interp; /* For use in variable assignment. */
- Tcl_RegExp re; /* The compiled regular expression. */
+TclRegAbout(
+ Tcl_Interp *interp, /* For use in variable assignment. */
+ Tcl_RegExp re) /* The compiled regular expression. */
{
- TclRegexp *regexpPtr = (TclRegexp *)re;
- char buf[TCL_INTEGER_SPACE];
- static struct infoname {
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+ struct infoname {
int bit;
- char *text;
- } infonames[] = {
+ const char *text;
+ };
+ static const struct infoname infonames[] = {
{REG_UBACKREF, "REG_UBACKREF"},
{REG_ULOOKAHEAD, "REG_ULOOKAHEAD"},
{REG_UBOUNDS, "REG_UBOUNDS"},
@@ -633,38 +651,42 @@ TclRegAbout(interp, re)
{REG_UEMPTYMATCH, "REG_UEMPTYMATCH"},
{REG_UIMPOSSIBLE, "REG_UIMPOSSIBLE"},
{REG_USHORTEST, "REG_USHORTEST"},
- {0, ""}
+ {0, NULL}
};
- struct infoname *inf;
- int n;
+ const struct infoname *inf;
+ Tcl_Obj *infoObj, *resultObj;
+
+ /*
+ * The reset here guarantees that the interpreter result is empty and
+ * unshared. This means that we can use Tcl_ListObjAppendElement on the
+ * result object quite safely.
+ */
Tcl_ResetResult(interp);
- sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));
- Tcl_AppendElement(interp, buf);
+ /*
+ * Assume that there will never be more than INT_MAX subexpressions. This
+ * is a pretty reasonable assumption; the RE engine doesn't scale _that_
+ * well and Tcl has other limits that constrain things as well...
+ */
+
+ resultObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
/*
- * Must count bits before generating list, because we must know whether {}
- * are needed before we start appending names.
+ * Now append a list of all the bit-flags set for the RE.
*/
- n = 0;
- for (inf = infonames; inf->bit != 0; inf++) {
- if (regexpPtr->re.re_info&inf->bit) {
- n++;
+ TclNewObj(infoObj);
+ for (inf=infonames ; inf->bit != 0 ; inf++) {
+ if (regexpPtr->re.re_info & inf->bit) {
+ Tcl_ListObjAppendElement(NULL, infoObj,
+ Tcl_NewStringObj(inf->text, -1));
}
}
- if (n != 1) {
- Tcl_AppendResult(interp, " {", NULL);
- }
- for (inf = infonames; inf->bit != 0; inf++) {
- if (regexpPtr->re.re_info&inf->bit) {
- Tcl_AppendElement(interp, inf->text);
- }
- }
- if (n != 1) {
- Tcl_AppendResult(interp, "}", NULL);
- }
+ Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
+ Tcl_SetObjResult(interp, resultObj);
return 0;
}
@@ -686,23 +708,23 @@ TclRegAbout(interp, re)
*/
void
-TclRegError(interp, msg, status)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- CONST char *msg; /* Message to prepend to error. */
- int status; /* Status code to report. */
+TclRegError(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ const char *msg, /* Message to prepend to error. */
+ 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;
- char *p;
+ const char *p;
Tcl_ResetResult(interp);
- n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
+ 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, (regex_t *)NULL, cbuf, sizeof(cbuf));
+ (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
}
@@ -724,10 +746,10 @@ TclRegError(interp, msg, status)
*/
static void
-FreeRegexpInternalRep(objPtr)
- Tcl_Obj *objPtr; /* Regexp object with internal rep to free. */
+FreeRegexpInternalRep(
+ Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
- TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+ TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
/*
* If this is the last reference to the regexp, free it.
@@ -736,6 +758,7 @@ FreeRegexpInternalRep(objPtr)
if (--(regexpRepPtr->refCount) <= 0) {
FreeRegexp(regexpRepPtr);
}
+ objPtr->typePtr = NULL;
}
/*
@@ -756,14 +779,14 @@ FreeRegexpInternalRep(objPtr)
*/
static void
-DupRegexpInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupRegexpInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
+ TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
regexpPtr->refCount++;
- copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->typePtr = &tclRegexpType;
}
@@ -788,9 +811,9 @@ DupRegexpInternalRep(srcPtr, copyPtr)
*/
static int
-SetRegexpFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
+SetRegexpFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
return TCL_ERROR;
@@ -821,17 +844,16 @@ SetRegexpFromAny(interp, objPtr)
*/
static TclRegexp *
-CompileRegexp(interp, string, length, flags)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- CONST char *string; /* The regexp to compile (UTF-8). */
- int length; /* The length of the string in bytes. */
- int flags; /* Compilation flags. */
+CompileRegexp(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ const char *string, /* The regexp to compile (UTF-8). */
+ int length, /* The length of the string in bytes. */
+ int flags) /* Compilation flags. */
{
TclRegexp *regexpPtr;
- CONST Tcl_UniChar *uniString;
- int numChars;
+ const Tcl_UniChar *uniString;
+ int numChars, status, i, exact;
Tcl_DString stringBuf;
- int status, i;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->initialized) {
@@ -883,7 +905,7 @@ CompileRegexp(interp, string, length, flags)
* 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;
@@ -910,22 +932,34 @@ CompileRegexp(interp, string, length, flags)
* 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);
+ "couldn't compile regular expression pattern: ", status);
}
return NULL;
}
/*
+ * Convert RE to a glob pattern equivalent, if any, and cache it. If this
+ * is not possible, then globObjPtr will be NULL. This is used by
+ * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
+ */
+
+ if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
+ regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
+ Tcl_IncrRefCount(regexpPtr->globObjPtr);
+ } else {
+ regexpPtr->globObjPtr = NULL;
+ }
+
+ /*
* Allocate enough space for all of the subexpressions, plus one extra for
* the entire pattern.
*/
- regexpPtr->matches = (regmatch_t *) ckalloc(
- sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
+ regexpPtr->matches =
+ ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
/*
* Initialize the refcount to one initially, since it is in the cache.
@@ -940,6 +974,7 @@ CompileRegexp(interp, string, length, flags)
if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
+
if (--(oldRegexpPtr->refCount) <= 0) {
FreeRegexp(oldRegexpPtr);
}
@@ -950,8 +985,8 @@ CompileRegexp(interp, string, length, flags)
tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
}
- tsdPtr->patterns[0] = (char *) 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;
@@ -975,14 +1010,17 @@ CompileRegexp(interp, string, length, flags)
*/
static void
-FreeRegexp(regexpPtr)
- TclRegexp *regexpPtr; /* Compiled regular expression to free. */
+FreeRegexp(
+ TclRegexp *regexpPtr) /* Compiled regular expression to free. */
{
TclReFree(&regexpPtr->re);
+ if (regexpPtr->globObjPtr) {
+ TclDecrRefCount(regexpPtr->globObjPtr);
+ }
if (regexpPtr->matches) {
- ckfree((char *) regexpPtr->matches);
+ ckfree(regexpPtr->matches);
}
- ckfree((char *) regexpPtr);
+ ckfree(regexpPtr);
}
/*
@@ -990,8 +1028,7 @@ FreeRegexp(regexpPtr)
*
* FinalizeRegexp --
*
- * Release the storage associated with the per-thread regexp
- * cache.
+ * Release the storage associated with the per-thread regexp cache.
*
* Results:
* None.
@@ -1003,8 +1040,8 @@ FreeRegexp(regexpPtr)
*/
static void
-FinalizeRegexp(clientData)
- ClientData clientData; /* Not used. */
+FinalizeRegexp(
+ ClientData clientData) /* Not used. */
{
int i;
TclRegexp *regexpPtr;
@@ -1016,7 +1053,15 @@ FinalizeRegexp(clientData)
FreeRegexp(regexpPtr);
}
ckfree(tsdPtr->patterns[i]);
+ tsdPtr->patterns[i] = NULL;
}
+
+ /*
+ * We may find ourselves reinitialized if another finalization routine
+ * invokes regexps.
+ */
+
+ tsdPtr->initialized = 0;
}
/*
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index 309c00a..3b2433e 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -1,16 +1,14 @@
-/*
+/*
* tclRegexp.h --
*
- * This file contains definitions used internally by Henry
- * Spencer's regular expression code.
+ * This file contains definitions used internally by Henry Spencer's
+ * regular expression code.
*
* Copyright (c) 1998 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: tclRegexp.h,v 1.12 2004/11/03 00:57:45 davygrvy Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLREGEXP
@@ -19,20 +17,20 @@
#include "regex.h"
/*
- * The TclRegexp structure encapsulates a compiled regex_t,
- * the flags that were used to compile it, and an array of pointers
- * that are used to indicate subexpressions after a call to Tcl_RegExpExec.
- * Note that the string and objPtr are mutually exclusive. These values
- * are needed by Tcl_RegExpRange in order to return pointers into the
- * original string.
+ * The TclRegexp structure encapsulates a compiled regex_t, the flags that
+ * were used to compile it, and an array of pointers that are used to indicate
+ * subexpressions after a call to Tcl_RegExpExec. Note that the string and
+ * objPtr are mutually exclusive. These values are needed by Tcl_RegExpRange
+ * in order to return pointers into the original string.
*/
typedef struct TclRegexp {
int flags; /* Regexp compile flags. */
regex_t re; /* Compiled re, includes number of
* subexpressions. */
- CONST char *string; /* Last string passed to Tcl_RegExpExec. */
+ const char *string; /* Last string passed to Tcl_RegExpExec. */
Tcl_Obj *objPtr; /* Last object passed to Tcl_RegExpExecObj. */
+ Tcl_Obj *globObjPtr; /* Glob pattern rep of RE or NULL if none. */
regmatch_t *matches; /* Array of indices into the Tcl_UniChar
* representation of the last string matched
* with this regexp to indicate the location
@@ -44,3 +42,11 @@ typedef struct TclRegexp {
} TclRegexp;
#endif /* _TCLREGEXP */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index e9c7cc5..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.7 2005/07/23 00:04:31 dkf Exp $
*/
#include "tclInt.h"
@@ -20,7 +18,7 @@
* Declarations for functions local to this file:
*/
-static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
+static void BumpCmdRefEpochs(Namespace *nsPtr);
/*
*----------------------------------------------------------------------
@@ -54,20 +52,20 @@ static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
*/
void
-Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being modified. */
- CONST char *name; /* Name of this resolution scheme. */
- Tcl_ResolveCmdProc *cmdProc; /* New function for command
- * resolution. */
- Tcl_ResolveVarProc *varProc; /* Function for variable resolution at
- * runtime. */
- Tcl_ResolveCompiledVarProc *compiledVarProc;
- /* Function for variable resolution at
- * compile time. */
+Tcl_AddInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being modified. */
+ const char *name, /* Name of this resolution scheme. */
+ Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */
+ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+ * runtime. */
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+ /* Function for variable resolution at compile
+ * time. */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme *resPtr;
+ unsigned len;
/*
* Since we're adding a new name resolution scheme, we must force all code
@@ -103,9 +101,10 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
* 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;
@@ -134,12 +133,13 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
*/
int
-Tcl_GetInterpResolvers(interp, name, resInfoPtr)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being queried. */
- CONST char *name; /* Look for a scheme with this name. */
- Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the functions,
- * if found */
+Tcl_GetInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being queried. */
+ const char *name, /* Look for a scheme with this name. */
+ Tcl_ResolverInfo *resInfoPtr)
+ /* Returns pointers to the functions, if
+ * found */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme *resPtr;
@@ -185,10 +185,10 @@ Tcl_GetInterpResolvers(interp, name, resInfoPtr)
*/
int
-Tcl_RemoveInterpResolvers(interp, name)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being modified. */
- CONST char *name; /* Name of the scheme to be removed. */
+Tcl_RemoveInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being modified. */
+ const char *name) /* Name of the scheme to be removed. */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme **prevPtrPtr, *resPtr;
@@ -226,7 +226,7 @@ Tcl_RemoveInterpResolvers(interp, name)
*prevPtrPtr = resPtr->nextPtr;
ckfree(resPtr->name);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
return 1;
}
@@ -254,19 +254,31 @@ Tcl_RemoveInterpResolvers(interp, name)
*/
static void
-BumpCmdRefEpochs(nsPtr)
- Namespace *nsPtr; /* Namespace being modified. */
+BumpCmdRefEpochs(
+ Namespace *nsPtr) /* Namespace being modified. */
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
nsPtr->cmdRefEpoch++;
+#ifndef BREAK_NAMESPACE_COMPAT
for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
- Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+ Namespace *childNsPtr = Tcl_GetHashValue(entry);
+
BumpCmdRefEpochs(childNsPtr);
}
+#else
+ if (nsPtr->childTablePtr != NULL) {
+ for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ Namespace *childNsPtr = Tcl_GetHashValue(entry);
+
+ BumpCmdRefEpochs(childNsPtr);
+ }
+ }
+#endif
TclInvalidateNsPath(nsPtr);
}
@@ -282,24 +294,23 @@ BumpCmdRefEpochs(nsPtr)
*
* Command resolution is handled by a function of the following type:
*
- * typedef int (*Tcl_ResolveCmdProc)(Tcl_Interp *interp,
- * CONST char *name, Tcl_Namespace *context,
+ * typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp,
+ * const char *name, Tcl_Namespace *context,
* int flags, Tcl_Command *rPtr);
*
* Whenever a command is executed or Tcl_FindCommand is invoked within
- * the namespace, this function is called to resolve the command name.
- * If this function is able to resolve the name, it should return the
- * status code TCL_OK, along with the corresponding Tcl_Command in the
- * rPtr argument. Otherwise, the function can return TCL_CONTINUE, and
- * the command will be treated under the usual name resolution rules.
- * Or, it can return TCL_ERROR, and the command will be considered
- * invalid.
+ * the namespace, this function is called to resolve the command name. If
+ * this function is able to resolve the name, it should return the status
+ * code TCL_OK, along with the corresponding Tcl_Command in the rPtr
+ * argument. Otherwise, the function can return TCL_CONTINUE, and the
+ * command will be treated under the usual name resolution rules. Or, it
+ * can return TCL_ERROR, and the command will be considered invalid.
*
* Variable resolution is handled by two functions. The first is called
* whenever a variable needs to be resolved at compile time:
*
- * typedef int (*Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
- * CONST char *name, Tcl_Namespace *context,
+ * typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
+ * const char *name, Tcl_Namespace *context,
* Tcl_ResolvedVarInfo *rPtr);
*
* If this function is able to resolve the name, it should return the
@@ -314,8 +325,8 @@ BumpCmdRefEpochs(nsPtr)
* the variable may be requested via Tcl_FindNamespaceVar.) This function
* has the following type:
*
- * typedef int (*Tcl_ResolveVarProc)(Tcl_Interp *interp,
- * CONST char *name, Tcl_Namespace *context,
+ * typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp,
+ * const char *name, Tcl_Namespace *context,
* int flags, Tcl_Var *rPtr);
*
* This function is quite similar to the compile-time version. It returns
@@ -335,15 +346,15 @@ BumpCmdRefEpochs(nsPtr)
*/
void
-Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
- Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
- * are being modified. */
- Tcl_ResolveCmdProc *cmdProc; /* Function for command resolution */
- Tcl_ResolveVarProc *varProc; /* Function for variable resolution at
- * run-time */
- Tcl_ResolveCompiledVarProc *compiledVarProc;
- /* Function for variable resolution at
- * compile time. */
+Tcl_SetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+ * modified. */
+ Tcl_ResolveCmdProc *cmdProc,/* Function for command resolution */
+ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+ * run-time */
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+ /* Function for variable resolution at compile
+ * time. */
{
Namespace *nsPtr = (Namespace *) namespacePtr;
@@ -384,12 +395,12 @@ Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
*/
int
-Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
- Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
- * are being modified. */
- Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all name
- * resolution functions assigned to
- * this namespace. */
+Tcl_GetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+ * modified. */
+ Tcl_ResolverInfo *resInfoPtr)
+ /* Returns: pointers for all name resolution
+ * functions assigned to this namespace. */
{
Namespace *nsPtr = (Namespace *) namespacePtr;
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 53b45a0..2f2563a 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.31 2005/09/13 21:23:51 dgp Exp $
*/
#include "tclInt.h"
@@ -19,18 +17,17 @@
enum returnKeys {
KEY_CODE, KEY_ERRORCODE, KEY_ERRORINFO, KEY_ERRORLINE,
- KEY_LEVEL, KEY_OPTIONS, KEY_LAST
+ KEY_LEVEL, KEY_OPTIONS, KEY_ERRORSTACK, KEY_LAST
};
/*
* Function prototypes for local functions in this file:
*/
-static Tcl_Obj ** GetKeys _ANSI_ARGS_((void));
-static void ReleaseKeys _ANSI_ARGS_((ClientData clientData));
-static void ResetObjResult _ANSI_ARGS_((Interp *iPtr));
-static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
- int newSpace));
+static Tcl_Obj ** GetKeys(void);
+static void ReleaseKeys(ClientData clientData);
+static void ResetObjResult(Interp *iPtr);
+static void SetupAppendBuffer(Interp *iPtr, int newSpace);
/*
* This structure is used to take a snapshot of the interpreter state in
@@ -47,6 +44,8 @@ typedef struct InterpState {
Tcl_Obj *errorCode;
Tcl_Obj *returnOpts;
Tcl_Obj *objResult;
+ Tcl_Obj *errorStack;
+ int resetErrorStack;
} InterpState;
/*
@@ -71,18 +70,20 @@ typedef struct InterpState {
*/
Tcl_InterpState
-Tcl_SaveInterpState(interp, status)
- Tcl_Interp* interp; /* Interpreter's state to be saved */
- int status; /* status code for current operation */
+Tcl_SaveInterpState(
+ Tcl_Interp *interp, /* Interpreter's state to be saved */
+ int status) /* status code for current operation */
{
- Interp *iPtr = (Interp *)interp;
- InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));
+ Interp *iPtr = (Interp *) interp;
+ InterpState *statePtr = ckalloc(sizeof(InterpState));
statePtr->status = status;
statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
statePtr->returnLevel = iPtr->returnLevel;
statePtr->returnCode = iPtr->returnCode;
statePtr->errorInfo = iPtr->errorInfo;
+ statePtr->errorStack = iPtr->errorStack;
+ statePtr->resetErrorStack = iPtr->resetErrorStack;
if (statePtr->errorInfo) {
Tcl_IncrRefCount(statePtr->errorInfo);
}
@@ -94,6 +95,9 @@ Tcl_SaveInterpState(interp, status)
if (statePtr->returnOpts) {
Tcl_IncrRefCount(statePtr->returnOpts);
}
+ if (statePtr->errorStack) {
+ Tcl_IncrRefCount(statePtr->errorStack);
+ }
statePtr->objResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(statePtr->objResult);
return (Tcl_InterpState) statePtr;
@@ -118,12 +122,12 @@ Tcl_SaveInterpState(interp, status)
*/
int
-Tcl_RestoreInterpState(interp, state)
- Tcl_Interp* interp; /* Interpreter's state to be restored*/
- Tcl_InterpState state; /* saved interpreter state */
+Tcl_RestoreInterpState(
+ Tcl_Interp *interp, /* Interpreter's state to be restored. */
+ Tcl_InterpState state) /* Saved interpreter state. */
{
- Interp *iPtr = (Interp *)interp;
- InterpState *statePtr = (InterpState *)state;
+ Interp *iPtr = (Interp *) interp;
+ InterpState *statePtr = (InterpState *) state;
int status = statePtr->status;
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -131,6 +135,7 @@ Tcl_RestoreInterpState(interp, state)
iPtr->returnLevel = statePtr->returnLevel;
iPtr->returnCode = statePtr->returnCode;
+ iPtr->resetErrorStack = statePtr->resetErrorStack;
if (iPtr->errorInfo) {
Tcl_DecrRefCount(iPtr->errorInfo);
}
@@ -145,6 +150,13 @@ Tcl_RestoreInterpState(interp, state)
if (iPtr->errorCode) {
Tcl_IncrRefCount(iPtr->errorCode);
}
+ if (iPtr->errorStack) {
+ Tcl_DecrRefCount(iPtr->errorStack);
+ }
+ iPtr->errorStack = statePtr->errorStack;
+ if (iPtr->errorStack) {
+ Tcl_IncrRefCount(iPtr->errorStack);
+ }
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
@@ -175,10 +187,10 @@ Tcl_RestoreInterpState(interp, state)
*/
void
-Tcl_DiscardInterpState(state)
- Tcl_InterpState state; /* saved interpreter state */
+Tcl_DiscardInterpState(
+ Tcl_InterpState state) /* saved interpreter state */
{
- InterpState *statePtr = (InterpState *)state;
+ InterpState *statePtr = (InterpState *) state;
if (statePtr->errorInfo) {
Tcl_DecrRefCount(statePtr->errorInfo);
@@ -189,8 +201,11 @@ Tcl_DiscardInterpState(state)
if (statePtr->returnOpts) {
Tcl_DecrRefCount(statePtr->returnOpts);
}
+ if (statePtr->errorStack) {
+ Tcl_DecrRefCount(statePtr->errorStack);
+ }
Tcl_DecrRefCount(statePtr->objResult);
- ckfree((char*) statePtr);
+ ckfree(statePtr);
}
/*
@@ -215,10 +230,11 @@ Tcl_DiscardInterpState(state)
*----------------------------------------------------------------------
*/
+#undef Tcl_SaveResult
void
-Tcl_SaveResult(interp, statePtr)
- Tcl_Interp *interp; /* Interpreter to save. */
- Tcl_SavedResult *statePtr; /* Pointer to state structure. */
+Tcl_SaveResult(
+ Tcl_Interp *interp, /* Interpreter to save. */
+ Tcl_SavedResult *statePtr) /* Pointer to state structure. */
{
Interp *iPtr = (Interp *) interp;
@@ -289,10 +305,11 @@ Tcl_SaveResult(interp, statePtr)
*----------------------------------------------------------------------
*/
+#undef Tcl_RestoreResult
void
-Tcl_RestoreResult(interp, statePtr)
- Tcl_Interp* interp; /* Interpreter being restored. */
- Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+Tcl_RestoreResult(
+ Tcl_Interp *interp, /* Interpreter being restored. */
+ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
Interp *iPtr = (Interp *) interp;
@@ -316,7 +333,7 @@ Tcl_RestoreResult(interp, statePtr)
*/
if (iPtr->appendResult != NULL) {
- ckfree((char *)iPtr->appendResult);
+ ckfree(iPtr->appendResult);
}
iPtr->appendResult = statePtr->appendResult;
@@ -357,20 +374,19 @@ Tcl_RestoreResult(interp, statePtr)
*----------------------------------------------------------------------
*/
+#undef Tcl_DiscardResult
void
-Tcl_DiscardResult(statePtr)
- Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+Tcl_DiscardResult(
+ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
TclDecrRefCount(statePtr->objResultPtr);
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);
}
}
@@ -392,17 +408,16 @@ Tcl_DiscardResult(statePtr)
*/
void
-Tcl_SetResult(interp, result, freeProc)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_SetResult(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
- register char *result; /* Value to be returned. If NULL, the result
+ register char *result, /* Value to be returned. If NULL, the result
* is set to an empty string. */
- Tcl_FreeProc *freeProc; /* Gives information about the string:
+ Tcl_FreeProc *freeProc) /* Gives information about the string:
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
Interp *iPtr = (Interp *) interp;
- int length;
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
char *oldResult = iPtr->result;
@@ -411,17 +426,18 @@ Tcl_SetResult(interp, result, freeProc)
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
} else if (freeProc == TCL_VOLATILE) {
- length = strlen(result);
+ int length = strlen(result);
+
if (length > TCL_RESULT_SIZE) {
- iPtr->result = (char *) 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 = result;
+ iPtr->result = (char *) result;
iPtr->freeProc = freeProc;
}
@@ -435,7 +451,7 @@ Tcl_SetResult(interp, result, freeProc)
if (oldFreeProc == TCL_DYNAMIC) {
ckfree(oldResult);
} else {
- (*oldFreeProc)(oldResult);
+ oldFreeProc(oldResult);
}
}
@@ -463,20 +479,22 @@ Tcl_SetResult(interp, result, freeProc)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetStringResult(interp)
- register Tcl_Interp *interp;/* Interpreter whose result to return. */
+const char *
+Tcl_GetStringResult(
+ register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
- if (*(interp->result) == 0) {
+ Interp *iPtr = (Interp *) interp;
+
+ if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
- return interp->result;
+ return iPtr->result;
}
/*
@@ -499,10 +517,10 @@ Tcl_GetStringResult(interp)
*/
void
-Tcl_SetObjResult(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_SetObjResult(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return object value. */
- register Tcl_Obj *objPtr; /* Tcl object to be returned. If NULL, the obj
+ register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
* result is made an empty string object. */
{
register Interp *iPtr = (Interp *) interp;
@@ -526,7 +544,7 @@ Tcl_SetObjResult(interp, objPtr)
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
- (*iPtr->freeProc)(iPtr->result);
+ iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
@@ -556,8 +574,8 @@ Tcl_SetObjResult(interp, objPtr)
*/
Tcl_Obj *
-Tcl_GetObjResult(interp)
- Tcl_Interp *interp; /* Interpreter whose result to return. */
+Tcl_GetObjResult(
+ Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
Tcl_Obj *objResultPtr;
@@ -568,7 +586,7 @@ Tcl_GetObjResult(interp)
* result, then reset the string result.
*/
- if (*(iPtr->result) != 0) {
+ if (iPtr->result[0] != 0) {
ResetObjResult(iPtr);
objResultPtr = iPtr->objResultPtr;
@@ -579,12 +597,12 @@ Tcl_GetObjResult(interp)
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
- (*iPtr->freeProc)(iPtr->result);
+ iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
+ iPtr->result[0] = 0;
}
return iPtr->objResultPtr;
}
@@ -610,10 +628,10 @@ Tcl_GetObjResult(interp)
*/
void
-Tcl_AppendResultVA(interp, argList)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_AppendResultVA(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
- va_list argList; /* Variable argument list. */
+ va_list argList) /* Variable argument list. */
{
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
@@ -631,14 +649,14 @@ Tcl_AppendResultVA(interp, argList)
* 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 */
}
/*
@@ -663,7 +681,8 @@ Tcl_AppendResultVA(interp, argList)
*/
void
-Tcl_AppendResult(Tcl_Interp *interp, ...)
+Tcl_AppendResult(
+ Tcl_Interp *interp, ...)
{
va_list argList;
@@ -696,10 +715,10 @@ Tcl_AppendResult(Tcl_Interp *interp, ...)
*/
void
-Tcl_AppendElement(interp, element)
- Tcl_Interp *interp; /* Interpreter whose result is to be
+Tcl_AppendElement(
+ Tcl_Interp *interp, /* Interpreter whose result is to be
* extended. */
- CONST char *element; /* String to convert to list element and add
+ const char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
@@ -768,9 +787,9 @@ Tcl_AppendElement(interp, element)
*/
static void
-SetupAppendBuffer(iPtr, newSpace)
- Interp *iPtr; /* Interpreter whose result is being set up. */
- int newSpace; /* Make sure that at least this many bytes of
+SetupAppendBuffer(
+ Interp *iPtr, /* Interpreter whose result is being set up. */
+ int newSpace) /* Make sure that at least this many bytes of
* new information may be added. */
{
int totalSpace;
@@ -813,7 +832,7 @@ SetupAppendBuffer(iPtr, newSpace)
} else {
totalSpace *= 2;
}
- new = (char *) ckalloc((unsigned) totalSpace);
+ new = ckalloc(totalSpace);
strcpy(new, iPtr->result);
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
@@ -851,8 +870,8 @@ SetupAppendBuffer(iPtr, newSpace)
*/
void
-Tcl_FreeResult(interp)
- register Tcl_Interp *interp; /* Interpreter for which to free result. */
+Tcl_FreeResult(
+ register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
register Interp *iPtr = (Interp *) interp;
@@ -860,7 +879,7 @@ Tcl_FreeResult(interp)
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
- (*iPtr->freeProc)(iPtr->result);
+ iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
@@ -881,15 +900,15 @@ Tcl_FreeResult(interp)
* Side effects:
* It resets the result object to an unshared empty object. It then
* restores the interpreter's string result area to its default
- * initialized state, freeing up any memory that may have been
- * allocated. It also clears any error information for the interpreter.
+ * initialized state, freeing up any memory that may have been allocated.
+ * It also clears any error information for the interpreter.
*
*----------------------------------------------------------------------
*/
void
-Tcl_ResetResult(interp)
- register Tcl_Interp *interp; /* Interpreter for which to clear result. */
+Tcl_ResetResult(
+ register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
register Interp *iPtr = (Interp *) interp;
@@ -898,7 +917,7 @@ Tcl_ResetResult(interp)
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
- (*iPtr->freeProc)(iPtr->result);
+ iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
@@ -906,25 +925,30 @@ Tcl_ResetResult(interp)
iPtr->resultSpace[0] = 0;
if (iPtr->errorCode) {
/* Legacy support */
- Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
- iPtr->errorCode, TCL_GLOBAL_ONLY);
+ if (iPtr->flags & ERR_LEGACY_COPY) {
+ Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+ iPtr->errorCode, TCL_GLOBAL_ONLY);
+ }
Tcl_DecrRefCount(iPtr->errorCode);
iPtr->errorCode = NULL;
}
if (iPtr->errorInfo) {
/* Legacy support */
- Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
- iPtr->errorInfo, TCL_GLOBAL_ONLY);
+ if (iPtr->flags & ERR_LEGACY_COPY) {
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+ iPtr->errorInfo, TCL_GLOBAL_ONLY);
+ }
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
+ iPtr->resetErrorStack = 1;
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
iPtr->returnOpts = NULL;
}
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY);
}
/*
@@ -946,8 +970,8 @@ Tcl_ResetResult(interp)
*/
static void
-ResetObjResult(iPtr)
- register Interp *iPtr; /* Points to the interpreter whose result
+ResetObjResult(
+ register Interp *iPtr) /* Points to the interpreter whose result
* object should be reset. */
{
register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
@@ -958,14 +982,14 @@ ResetObjResult(iPtr)
Tcl_IncrRefCount(objResultPtr);
iPtr->objResultPtr = objResultPtr;
} else {
- if ((objResultPtr->bytes != NULL)
- && (objResultPtr->bytes != tclEmptyStringRep)) {
- ckfree((char *) objResultPtr->bytes);
+ 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 = (Tcl_ObjType *) NULL;
}
}
@@ -989,9 +1013,9 @@ ResetObjResult(iPtr)
*/
void
-Tcl_SetErrorCodeVA(interp, argList)
- Tcl_Interp *interp; /* Interpreter in which to set errorCode */
- va_list argList; /* Variable argument list. */
+Tcl_SetErrorCodeVA(
+ Tcl_Interp *interp, /* Interpreter in which to set errorCode */
+ va_list argList) /* Variable argument list. */
{
Tcl_Obj *errorObj = Tcl_NewObj();
@@ -1002,6 +1026,7 @@ Tcl_SetErrorCodeVA(interp, argList)
while (1) {
char *elem = va_arg(argList, char *);
+
if (elem == NULL) {
break;
}
@@ -1030,7 +1055,8 @@ Tcl_SetErrorCodeVA(interp, argList)
*/
void
-Tcl_SetErrorCode(Tcl_Interp *interp, ...)
+Tcl_SetErrorCode(
+ Tcl_Interp *interp, ...)
{
va_list argList;
@@ -1063,9 +1089,9 @@ Tcl_SetErrorCode(Tcl_Interp *interp, ...)
*/
void
-Tcl_SetObjErrorCode(interp, errorObjPtr)
- Tcl_Interp *interp;
- Tcl_Obj *errorObjPtr;
+Tcl_SetObjErrorCode(
+ Tcl_Interp *interp,
+ Tcl_Obj *errorObjPtr)
{
Interp *iPtr = (Interp *) interp;
@@ -1079,6 +1105,43 @@ Tcl_SetObjErrorCode(interp, errorObjPtr)
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetErrorLine --
+ *
+ * Returns the line number associated with the current error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_GetErrorLine
+int
+Tcl_GetErrorLine(
+ Tcl_Interp *interp)
+{
+ return ((Interp *) interp)->errorLine;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorLine --
+ *
+ * Sets the line number associated with the current error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_SetErrorLine
+void
+Tcl_SetErrorLine(
+ Tcl_Interp *interp,
+ int value)
+{
+ ((Interp *) interp)->errorLine = value;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* GetKeys --
*
* Returns a Tcl_Obj * array of the standard keys used in the return
@@ -1091,14 +1154,14 @@ Tcl_SetObjErrorCode(interp, errorObjPtr)
* A Tcl_Obj * array.
*
* Side effects:
- * First time called in a thread, creates the keys (allocating memory)
- * and arranges for their cleanup at thread exit.
+ * First time called in a thread, creates the keys (allocating memory)
+ * and arranges for their cleanup at thread exit.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj **
-GetKeys()
+GetKeys(void)
{
static Tcl_ThreadDataKey returnKeysKey;
Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey,
@@ -1111,12 +1174,13 @@ GetKeys()
int i;
- keys[KEY_CODE] = Tcl_NewStringObj("-code", -1);
- keys[KEY_ERRORCODE] = Tcl_NewStringObj("-errorcode", -1);
- keys[KEY_ERRORINFO] = Tcl_NewStringObj("-errorinfo", -1);
- keys[KEY_ERRORLINE] = Tcl_NewStringObj("-errorline", -1);
- keys[KEY_LEVEL] = Tcl_NewStringObj("-level", -1);
- keys[KEY_OPTIONS] = Tcl_NewStringObj("-options", -1);
+ TclNewLiteralStringObj(keys[KEY_CODE], "-code");
+ TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
+ TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
+ TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
+ TclNewLiteralStringObj(keys[KEY_ERRORSTACK],"-errorstack");
+ TclNewLiteralStringObj(keys[KEY_LEVEL], "-level");
+ TclNewLiteralStringObj(keys[KEY_OPTIONS], "-options");
for (i = KEY_CODE; i < KEY_LAST; i++) {
Tcl_IncrRefCount(keys[i]);
@@ -1126,7 +1190,7 @@ GetKeys()
* ... and arrange for their clenaup.
*/
- Tcl_CreateThreadExitHandler(ReleaseKeys, (ClientData) keys);
+ Tcl_CreateThreadExitHandler(ReleaseKeys, keys);
}
return keys;
}
@@ -1143,20 +1207,21 @@ GetKeys()
* None.
*
* Side effects:
- * Frees memory.
+ * Frees memory.
*
*----------------------------------------------------------------------
*/
static void
-ReleaseKeys(clientData)
- ClientData clientData;
+ReleaseKeys(
+ ClientData clientData)
{
- Tcl_Obj **keys = (Tcl_Obj **)clientData;
+ Tcl_Obj **keys = clientData;
int i;
for (i = KEY_CODE; i < KEY_LAST; i++) {
Tcl_DecrRefCount(keys[i]);
+ keys[i] = NULL;
}
}
@@ -1175,17 +1240,17 @@ ReleaseKeys(clientData)
* Returns the return code the [return] command should return.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-TclProcessReturn(interp, code, level, returnOpts)
- Tcl_Interp *interp;
- int code;
- int level;
- Tcl_Obj *returnOpts;
+TclProcessReturn(
+ Tcl_Interp *interp,
+ int code,
+ int level,
+ Tcl_Obj *returnOpts)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *valuePtr;
@@ -1208,27 +1273,64 @@ TclProcessReturn(interp, code, level, returnOpts)
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;
- (void) Tcl_GetStringFromObj(valuePtr, &infoLen);
+ (void) TclGetStringFromObj(valuePtr, &infoLen);
if (infoLen) {
iPtr->errorInfo = valuePtr;
Tcl_IncrRefCount(iPtr->errorInfo);
iPtr->flags |= ERR_ALREADY_LOGGED;
}
}
- Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+ Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
+ &valuePtr);
+ if (valuePtr != NULL) {
+ int len, valueObjc;
+ Tcl_Obj **valueObjv;
+
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ 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) {
+ 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);
+ }
+ 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) {
- Tcl_GetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
+ TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
}
}
if (level != 0) {
@@ -1236,6 +1338,9 @@ TclProcessReturn(interp, code, level, returnOpts)
iPtr->returnCode = code;
return TCL_RETURN;
}
+ if (code == TCL_ERROR) {
+ iPtr->flags |= ERR_LEGACY_COPY;
+ }
return code;
}
@@ -1247,30 +1352,30 @@ TclProcessReturn(interp, code, level, returnOpts)
* Parses, checks, and stores the options to the [return] command.
*
* Results:
- * Returns TCL_ERROR is any of the option values are invalid. Otherwise,
+ * Returns TCL_ERROR if any of the option values are invalid. Otherwise,
* returns TCL_OK, and writes the returnOpts, code, and level values to
* the pointers provided.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
- Tcl_Obj **optionsPtrPtr; /* If not NULL, points to space for a (Tcl_Obj
+TclMergeReturnOptions(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[], /* Argument objects. */
+ Tcl_Obj **optionsPtrPtr, /* If not NULL, points to space for a (Tcl_Obj
* *) where the pointer to the merged return
- * options dictionary should be written */
- int *codePtr; /* If not NULL, points to space where the
- * -code value should be written */
- int *levelPtr; /* If not NULL, points to space where the
- * -level value should be written */
+ * options dictionary should be written. */
+ int *codePtr, /* If not NULL, points to space where the
+ * -code value should be written. */
+ int *levelPtr) /* If not NULL, points to space where the
+ * -level value should be written. */
{
- int code=TCL_OK;
+ int code = TCL_OK;
int level = 1;
Tcl_Obj *valuePtr;
Tcl_Obj *returnOpts = Tcl_NewObj();
@@ -1278,12 +1383,12 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
for (; objc > 1; objv += 2, objc -= 2) {
int optLen;
- CONST char *opt = Tcl_GetStringFromObj(objv[0], &optLen);
+ const char *opt = TclGetStringFromObj(objv[0], &optLen);
int compareLen;
- CONST char *compare =
- Tcl_GetStringFromObj(keys[KEY_OPTIONS], &compareLen);
+ const char *compare =
+ TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
- if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
+ if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
Tcl_DictSearch search;
int done = 0;
Tcl_Obj *keyPtr;
@@ -1296,10 +1401,11 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
* Value is not a legal dictionary.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad ", compare,
- " value: expected dictionary but got \"",
- TclGetString(objv[1]), "\"", (char *) 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;
}
@@ -1325,20 +1431,9 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
- if ((valuePtr != NULL)
- && (TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &code))) {
- static CONST char *returnCodes[] = {
- "ok", "error", "return", "break", "continue", NULL
- };
-
- if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
- NULL, TCL_EXACT, &code)) {
- /* Value is not a legal return code */
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad completion code \"",
- TclGetString(valuePtr),
- "\": must be ok, error, return, break, ",
- "continue, or an integer", (char *) NULL);
+ if (valuePtr != NULL) {
+ if (TclGetCompletionCodeFromObj(interp, valuePtr,
+ &code) == TCL_ERROR) {
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
@@ -1350,22 +1445,78 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr);
if (valuePtr != NULL) {
- if ((TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &level))
+ if ((TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &level))
|| (level < 0)) {
/*
* Value is not a legal level.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -level value: ",
- "expected non-negative integer but got \"",
- TclGetString(valuePtr), "\"", (char *) 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;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
}
/*
+ * Check for bogus -errorcode value.
+ */
+
+ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+ if (valuePtr != NULL) {
+ int length;
+
+ if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
+ /*
+ * Value is not a list, which is illegal for -errorcode.
+ */
+
+ 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;
+ }
+ }
+
+ /*
+ * Check for bogus -errorstack value.
+ */
+
+ Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
+ if (valuePtr != NULL) {
+ int length;
+
+ if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
+ /*
+ * Value is not a list, which is illegal for -errorstack.
+ */
+
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "forbidden odd-sized list for -errorstack: \"%s\"",
+ TclGetString(valuePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "RESULT",
+ "ODDSIZEDLIST_ERRORSTACK", NULL);
+ goto error;
+ }
+ }
+
+ /*
* Convert [return -code return -level X] to [return -code ok -level X+1]
*/
@@ -1414,9 +1565,9 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
*/
Tcl_Obj *
-Tcl_GetReturnOptions(interp, result)
- Tcl_Interp *interp;
- int result;
+Tcl_GetReturnOptions(
+ Tcl_Interp *interp,
+ int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *options;
@@ -1441,14 +1592,14 @@ Tcl_GetReturnOptions(interp, result)
}
if (result == TCL_ERROR) {
- /*
- * When result was an error, fill in any missing values for
- * -errorinfo, -errorcode, and -errorline
- */
-
- Tcl_AddObjErrorInfo(interp, "", -1);
- Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
+ Tcl_AddErrorInfo(interp, "");
+ Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
+ }
+ if (iPtr->errorCode) {
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
+ }
+ if (iPtr->errorInfo) {
+ Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE],
Tcl_NewIntObj(iPtr->errorLine));
}
@@ -1458,6 +1609,31 @@ Tcl_GetReturnOptions(interp, result)
/*
*-------------------------------------------------------------------------
*
+ * 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
@@ -1476,18 +1652,19 @@ Tcl_GetReturnOptions(interp, result)
*/
int
-Tcl_SetReturnOptions(interp, options)
- Tcl_Interp *interp;
- Tcl_Obj *options;
+Tcl_SetReturnOptions(
+ Tcl_Interp *interp,
+ Tcl_Obj *options)
{
int objc, level, code;
Tcl_Obj **objv, *mergedOpts;
- if (TCL_ERROR == Tcl_ListObjGetElements(interp, options, &objc, &objv)
+ Tcl_IncrRefCount(options);
+ if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
|| (objc % 2)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected dict but got \"",
- Tcl_GetString(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,
&mergedOpts, &code, &level)) {
@@ -1503,7 +1680,7 @@ Tcl_SetReturnOptions(interp, options)
/*
*-------------------------------------------------------------------------
*
- * TclTransferResult --
+ * Tcl_TransferResult --
*
* Copy the result (and error information) from one interp to another.
* Used when one interp has caused another interp to evaluate a script
@@ -1529,27 +1706,40 @@ Tcl_SetReturnOptions(interp, options)
*/
void
-TclTransferResult(sourceInterp, result, targetInterp)
- Tcl_Interp *sourceInterp; /* Interp whose result and error information
+Tcl_TransferResult(
+ Tcl_Interp *sourceInterp, /* Interp whose result and error information
* should be moved to the target interp.
* After moving result, this interp's result
* is reset. */
- int result; /* TCL_OK if just the result should be copied,
+ int result, /* TCL_OK if just the result should be copied,
* TCL_ERROR if both the result and error
* information should be copied. */
- Tcl_Interp *targetInterp; /* Interp where result and error information
+ Tcl_Interp *targetInterp) /* Interp where result and error information
* should be stored. If source and target are
* the same, nothing is done. */
{
- Interp *iPtr = (Interp *) targetInterp;
+ Interp *tiPtr = (Interp *) targetInterp;
+ Interp *siPtr = (Interp *) sourceInterp;
if (sourceInterp == targetInterp) {
return;
}
- Tcl_SetReturnOptions(targetInterp,
- Tcl_GetReturnOptions(sourceInterp, result));
- iPtr->flags &= ~(ERR_ALREADY_LOGGED);
+ if (result == TCL_OK && siPtr->returnOpts == NULL) {
+ /*
+ * Special optimization for the common case of normal command return
+ * code and no explicit return options.
+ */
+
+ if (tiPtr->returnOpts) {
+ Tcl_DecrRefCount(tiPtr->returnOpts);
+ tiPtr->returnOpts = NULL;
+ }
+ } else {
+ Tcl_SetReturnOptions(targetInterp,
+ Tcl_GetReturnOptions(sourceInterp, result));
+ tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
+ }
Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
Tcl_ResetResult(sourceInterp);
}
@@ -1559,5 +1749,7 @@ TclTransferResult(sourceInterp, result, targetInterp)
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 54f9b78..4dfc2d6 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.18 2005/07/21 14:38:51 dkf Exp $
*/
#include "tclInt.h"
@@ -22,14 +20,8 @@
#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
#define SCAN_WIDTH 0x8 /* A width value was supplied. */
-#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */
-#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */
-#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */
-#define SCAN_XOK 0x80 /* An 'x' is allowed. */
-#define SCAN_PTOK 0x100 /* Decimal point is allowed. */
-#define SCAN_EXPOK 0x200 /* An exponent is allowed. */
-
#define SCAN_LONGER 0x400 /* Asked for a wide value. */
+#define SCAN_BIG 0x800 /* Asked for a bignum value. */
/*
* The following structure contains the information associated with a
@@ -51,11 +43,11 @@ typedef struct CharSet {
* Declarations for functions used only in this file.
*/
-static char * BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));
-static int CharInSet _ANSI_ARGS_((CharSet *cset, int ch));
-static void ReleaseCharSet _ANSI_ARGS_((CharSet *cset));
-static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
- int numVars, int *totalVars));
+static const char * BuildCharSet(CharSet *cset, const char *format);
+static int CharInSet(CharSet *cset, int ch);
+static void ReleaseCharSet(CharSet *cset);
+static int ValidateFormat(Tcl_Interp *interp, const char *format,
+ int numVars, int *totalVars);
/*
*----------------------------------------------------------------------
@@ -75,14 +67,14 @@ static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
*----------------------------------------------------------------------
*/
-static char *
-BuildCharSet(cset, format)
- CharSet *cset;
- char *format; /* Points to first char of set. */
+static const char *
+BuildCharSet(
+ CharSet *cset,
+ const char *format) /* Points to first char of set. */
{
Tcl_UniChar ch, start;
int offset, nranges;
- char *end;
+ const char *end;
memset(cset, 0, sizeof(CharSet));
@@ -109,10 +101,9 @@ BuildCharSet(cset, format)
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;
}
@@ -187,13 +178,14 @@ BuildCharSet(cset, format)
*/
static int
-CharInSet(cset, c)
- CharSet *cset;
- int c; /* Character to test, passed as int because of
+CharInSet(
+ CharSet *cset,
+ int c) /* Character to test, passed as int because of
* non-ANSI prototypes. */
{
Tcl_UniChar ch = (Tcl_UniChar) c;
int i, match = 0;
+
for (i = 0; i < cset->nchars; i++) {
if (cset->chars[i] == ch) {
match = 1;
@@ -202,8 +194,7 @@ CharInSet(cset, c)
}
if (!match) {
for (i = 0; i < cset->nranges; i++) {
- if ((cset->ranges[i].start <= ch)
- && (ch <= cset->ranges[i].end)) {
+ if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) {
match = 1;
break;
}
@@ -229,12 +220,12 @@ CharInSet(cset, c)
*/
static void
-ReleaseCharSet(cset)
- CharSet *cset;
+ReleaseCharSet(
+ CharSet *cset)
{
- ckfree((char *)cset->chars);
+ ckfree(cset->chars);
if (cset->ranges) {
- ckfree((char *)cset->ranges);
+ ckfree(cset->ranges);
}
}
@@ -256,22 +247,24 @@ ReleaseCharSet(cset)
*/
static int
-ValidateFormat(interp, format, numVars, totalSubs)
- Tcl_Interp *interp; /* Current interpreter. */
- char *format; /* The format string. */
- int numVars; /* The number of variables passed to the scan
+ValidateFormat(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *format, /* The format string. */
+ int numVars, /* The number of variables passed to the scan
* command. */
- int *totalSubs; /* The number of variables that will be
+ int *totalSubs) /* The number of variables that will be
* required. */
{
-#define STATIC_LIST_SIZE 16
int gotXpg, gotSequential, value, i, flags;
char *end;
Tcl_UniChar ch;
- int staticAssign[STATIC_LIST_SIZE];
- int *nassign = staticAssign;
- int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+ 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
@@ -279,10 +272,6 @@ ValidateFormat(interp, format, numVars, totalSubs)
* is multiply assigned or left unassigned.
*/
- if (numVars > nspace) {
- nassign = (int*)ckalloc(sizeof(int) * numVars);
- nspace = numVars;
- }
for (i = 0; i < nspace; i++) {
nassign[i] = 0;
}
@@ -307,14 +296,14 @@ ValidateFormat(interp, format, numVars, totalSubs)
goto xpgCheckDone;
}
- if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
/*
* Check for an XPG3-style %n$ specification. Note: there must
* not be a mixture of XPG3 specs and non-XPG3 specs in the same
* format string.
*/
- value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+ value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
if (*end != '$') {
goto notXpg;
}
@@ -343,9 +332,10 @@ ValidateFormat(interp, format, numVars, totalSubs)
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;
}
@@ -354,8 +344,8 @@ ValidateFormat(interp, format, numVars, totalSubs)
* Parse any width specifier.
*/
- if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */
flags |= SCAN_WIDTH;
format += Tcl_UtfToUniChar(format, &ch);
}
@@ -366,6 +356,12 @@ ValidateFormat(interp, format, numVars, totalSubs)
switch (ch) {
case 'l':
+ if (*format == 'l') {
+ flags |= SCAN_BIG;
+ format += 1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ break;
+ }
case 'L':
flags |= SCAN_LONGER;
case 'h':
@@ -383,9 +379,10 @@ ValidateFormat(interp, format, numVars, totalSubs)
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;
}
/*
@@ -393,12 +390,15 @@ ValidateFormat(interp, format, numVars, totalSubs)
*/
case 'n':
case 's':
- if (flags & SCAN_LONGER) {
- invalidLonger:
+ if (flags & (SCAN_LONGER|SCAN_BIG)) {
+ invalidFieldSize:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp,
- "'l' 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;
}
/*
@@ -406,19 +406,30 @@ ValidateFormat(interp, format, numVars, totalSubs)
*/
case 'd':
case 'e':
+ case 'E':
case 'f':
case 'g':
+ case 'G':
case 'i':
case 'o':
- case 'u':
case 'x':
+ case 'X':
+ case 'b':
+ break;
+ case 'u':
+ if (flags & SCAN_BIG) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+ goto error;
+ }
break;
/*
* Bracket terms need special checking
*/
case '[':
- if (flags & SCAN_LONGER) {
- goto invalidLonger;
+ if (flags & (SCAN_LONGER|SCAN_BIG)) {
+ goto invalidFieldSize;
}
if (*format == '\0') {
goto badSet;
@@ -444,18 +455,19 @@ ValidateFormat(interp, format, numVars, totalSubs)
}
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:
- {
- char buf[TCL_UTF_MAX+1];
-
- buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad scan conversion character \"",
- buf, "\"", NULL);
- goto error;
- }
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ 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)) {
if (objIndex >= nspace) {
@@ -469,17 +481,10 @@ ValidateFormat(interp, format, numVars, totalSubs)
if (xpgSize) {
nspace = xpgSize;
} else {
- nspace += STATIC_LIST_SIZE;
- }
- if (nassign == staticAssign) {
- nassign = (void *)ckalloc(nspace * sizeof(int));
- for (i = 0; i < STATIC_LIST_SIZE; ++i) {
- nassign[i] = staticAssign[i];
- }
- } else {
- nassign = (void *)ckrealloc((void *)nassign,
- nspace * sizeof(int));
+ nspace += 16; /* formerly STATIC_LIST_SIZE */
}
+ nassign = TclStackRealloc(interp, nassign,
+ nspace * sizeof(int));
for (i = value; i < nspace; i++) {
nassign[i] = 0;
}
@@ -505,9 +510,10 @@ ValidateFormat(interp, format, numVars, totalSubs)
}
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)) {
/*
@@ -515,34 +521,32 @@ ValidateFormat(interp, format, numVars, totalSubs)
* 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;
}
}
- if (nassign != staticAssign) {
- ckfree((char *)nassign);
- }
+ TclStackFree(interp, nassign);
return TCL_OK;
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:
- if (nassign != staticAssign) {
- ckfree((char *)nassign);
- }
+ TclStackFree(interp, nassign);
return TCL_ERROR;
-#undef STATIC_LIST_SIZE
}
/*
@@ -564,26 +568,20 @@ ValidateFormat(interp, format, numVars, totalSubs)
/* ARGSUSED */
int
-Tcl_ScanObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ScanObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *format;
+ const char *format;
int numVars, nconversions, totalVars = -1;
int objIndex, offset, i, result, code;
long value;
- char *string, *end, *baseString;
+ const char *string, *end, *baseString;
char op = 0;
- int base = 0;
- int underflow = 0;
- size_t width;
- long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL;
-#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL;
+ int width, underflow = 0;
Tcl_WideInt wideValue;
-#endif
Tcl_UniChar ch, sch;
Tcl_Obj **objs = NULL, *objPtr = NULL;
int flags;
@@ -593,7 +591,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
- "string format ?varName varName ...?");
+ "string format ?varName ...?");
return TCL_ERROR;
}
@@ -613,7 +611,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
*/
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;
}
@@ -631,6 +629,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
objIndex = 0;
nconversions = 0;
while (*format != '\0') {
+ int parseFlag = TCL_PARSE_NO_WHITESPACE;
format += Tcl_UtfToUniChar(format, &ch);
flags = 0;
@@ -678,9 +677,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
flags |= SCAN_SUPPRESS;
format += Tcl_UtfToUniChar(format, &ch);
} else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
- if (*end == '$') {
- format = end+1;
+ char *formatEnd;
+ value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
+ if (*formatEnd == '$') {
+ format = formatEnd+1;
format += Tcl_UtfToUniChar(format, &ch);
objIndex = (int) value - 1;
}
@@ -691,7 +691,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
*/
if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+ width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
format += Tcl_UtfToUniChar(format, &ch);
} else {
width = 0;
@@ -703,6 +703,12 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
switch (ch) {
case 'l':
+ if (*format == 'l') {
+ flags |= SCAN_BIG;
+ format += 1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ break;
+ }
case 'L':
flags |= SCAN_LONGER;
/*
@@ -721,6 +727,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj(string - baseString);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
nconversions++;
@@ -728,49 +735,36 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
case 'd':
op = 'i';
- base = 10;
- fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol;
-#ifndef TCL_WIDE_INT_IS_LONG
- lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
-#endif
+ parseFlag |= TCL_PARSE_DECIMAL_ONLY;
break;
case 'i':
op = 'i';
- base = 0;
- fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol;
-#ifndef TCL_WIDE_INT_IS_LONG
- lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
-#endif
+ parseFlag |= TCL_PARSE_SCAN_PREFIXES;
break;
case 'o':
op = 'i';
- base = 8;
- fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
- lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
-#endif
+ parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
break;
case 'x':
+ case 'X':
op = 'i';
- base = 16;
- fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
- lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
-#endif
+ parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
+ break;
+ case 'b':
+ op = 'i';
+ parseFlag |= TCL_PARSE_BINARY_ONLY;
break;
case 'u':
op = 'i';
- base = 10;
+ parseFlag |= TCL_PARSE_DECIMAL_ONLY;
flags |= SCAN_UNSIGNED;
- fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
- lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
-#endif
break;
case 'f':
case 'e':
+ case 'E':
case 'g':
+ case 'G':
op = 'f';
break;
@@ -828,7 +822,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
*/
if (width == 0) {
- width = (size_t) ~0;
+ width = ~0;
}
end = string;
while (*end != '\0') {
@@ -844,6 +838,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewStringObj(string, end-string);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
string = end;
@@ -853,7 +848,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
CharSet cset;
if (width == 0) {
- width = (size_t) ~0;
+ width = ~0;
}
end = string;
@@ -894,6 +889,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj((int)sch);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
break;
@@ -902,152 +898,60 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
/*
* Scan an unsigned or signed integer.
*/
-
- if ((width == 0) || (width > sizeof(buf) - 1)) {
- width = sizeof(buf) - 1;
+ objPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(objPtr);
+ if (width == 0) {
+ width = ~0;
}
- flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
- for (end = buf; width > 0; width--) {
- switch (*string) {
- /*
- * The 0 digit has special meaning at the beginning of a
- * number. If we are unsure of the base, it indicates that
- * we are in base 8 or base 16 (if it is followed by an
- * 'x').
- *
- * 8.1 - 8.3.4 incorrectly handled 0x... base-16 cases for
- * %x by not reading the 0x as the auto-prelude for
- * base-16. [Bug #495213]
- */
- case '0':
- if (base == 0) {
- base = 8;
- flags |= SCAN_XOK;
- }
- if (base == 16) {
- flags |= SCAN_XOK;
- }
- if (flags & SCAN_NOZERO) {
- flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO);
- } else {
- flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
- }
- goto addToInt;
-
- case '1': case '2': case '3': case '4':
- case '5': case '6': case '7':
- if (base == 0) {
- base = 10;
- }
- flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
- goto addToInt;
-
- case '8': case '9':
- if (base == 0) {
- base = 10;
- }
- if (base <= 8) {
- break;
- }
- flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
- goto addToInt;
-
- case 'A': case 'B': case 'C':
- case 'D': case 'E': case 'F':
- case 'a': case 'b': case 'c':
- case 'd': case 'e': case 'f':
- if (base <= 10) {
- break;
- }
- flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
- goto addToInt;
-
- case '+': case '-':
- if (flags & SCAN_SIGNOK) {
- flags &= ~SCAN_SIGNOK;
- goto addToInt;
+ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+ &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
+ Tcl_DecrRefCount(objPtr);
+ if (width < 0) {
+ if (*end == '\0') {
+ underflow = 1;
}
- break;
-
- case 'x': case 'X':
- if ((flags & SCAN_XOK) && (end == buf+1)) {
- base = 16;
- flags &= ~SCAN_XOK;
- goto addToInt;
+ } else {
+ if (end == string + width) {
+ underflow = 1;
}
- break;
- }
-
- /*
- * We got an illegal character so we are done accumulating.
- */
-
- break;
-
- addToInt:
- /*
- * Add the character to the temporary buffer.
- */
-
- *end++ = *string++;
- if (*string == '\0') {
- break;
- }
- }
-
- /*
- * Check to see if we need to back up because we only got a sign
- * or a trailing x after a 0.
- */
-
- if (flags & SCAN_NODIGITS) {
- if (*string == '\0') {
- underflow = 1;
}
goto done;
- } else if (end[-1] == 'x' || end[-1] == 'X') {
- end--;
- string--;
}
-
- /*
- * Scan the value from the temporary buffer. If we are returning a
- * large unsigned value, we have to convert it back to a string
- * since Tcl only supports signed values.
- */
-
- if (!(flags & SCAN_SUPPRESS)) {
- *end = '\0';
-#ifndef TCL_WIDE_INT_IS_LONG
- if (flags & SCAN_LONGER) {
- wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base);
- if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
- /* INTL: ISO digit */
- sprintf(buf, "%" TCL_LL_MODIFIER "u",
- (Tcl_WideUInt)wideValue);
- objPtr = Tcl_NewStringObj(buf, -1);
- } else {
- objPtr = Tcl_NewWideIntObj(wideValue);
+ string = end;
+ if (flags & SCAN_SUPPRESS) {
+ Tcl_DecrRefCount(objPtr);
+ break;
+ }
+ if (flags & SCAN_LONGER) {
+ if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
+ wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */
+ if (TclGetString(objPtr)[0] == '-') {
+ wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
}
+ }
+ if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
+ sprintf(buf, "%" TCL_LL_MODIFIER "u",
+ (Tcl_WideUInt)wideValue);
+ Tcl_SetStringObj(objPtr, buf, -1);
} else {
-#endif /* !TCL_WIDE_INT_IS_LONG */
- value = (long) (*fn)(buf, NULL, base);
- if ((flags & SCAN_UNSIGNED) && (value < 0)) {
- sprintf(buf, "%lu", value); /* INTL: ISO digit */
- objPtr = Tcl_NewStringObj(buf, -1);
- } else if ((flags & SCAN_LONGER)
- || (unsigned long) value > UINT_MAX) {
- objPtr = Tcl_NewLongObj(value);
+ Tcl_SetWideIntObj(objPtr, wideValue);
+ }
+ } else if (!(flags & SCAN_BIG)) {
+ if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
+ if (TclGetString(objPtr)[0] == '-') {
+ value = LONG_MIN;
} else {
- objPtr = Tcl_NewIntObj(value);
+ value = LONG_MAX;
}
-#ifndef TCL_WIDE_INT_IS_LONG
}
-#endif
- Tcl_IncrRefCount(objPtr);
- objs[objIndex++] = objPtr;
+ if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+ sprintf(buf, "%lu", value); /* INTL: ISO digit */
+ Tcl_SetStringObj(objPtr, buf, -1);
+ } else {
+ Tcl_SetLongObj(objPtr, value);
+ }
}
-
+ objs[objIndex++] = objPtr;
break;
case 'f':
@@ -1055,105 +959,45 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
* Scan a floating point number
*/
- if ((width == 0) || (width > sizeof(buf) - 1)) {
- width = sizeof(buf) - 1;
+ objPtr = Tcl_NewDoubleObj(0.0);
+ Tcl_IncrRefCount(objPtr);
+ if (width == 0) {
+ width = ~0;
}
- flags &= ~SCAN_LONGER;
- flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
- for (end = buf; width > 0; width--) {
- switch (*string) {
- case '0': case '1': case '2': case '3':
- case '4': case '5': case '6': case '7':
- case '8': case '9':
- flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
- goto addToFloat;
- case '+': case '-':
- if (flags & SCAN_SIGNOK) {
- flags &= ~SCAN_SIGNOK;
- goto addToFloat;
- }
- break;
- case '.':
- if (flags & SCAN_PTOK) {
- flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
- goto addToFloat;
- }
- break;
- case 'e': case 'E':
- /*
- * An exponent is not allowed until there has been at
- * least one digit.
- */
-
- if ((flags & (SCAN_NODIGITS | SCAN_EXPOK)) == SCAN_EXPOK) {
- flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
- | SCAN_SIGNOK | SCAN_NODIGITS;
- goto addToFloat;
+ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+ &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
+ Tcl_DecrRefCount(objPtr);
+ if (width < 0) {
+ if (*end == '\0') {
+ underflow = 1;
}
- break;
- }
-
- /*
- * We got an illegal character so we are done accumulating.
- */
-
- break;
-
- addToFloat:
- /*
- * Add the character to the temporary buffer.
- */
-
- *end++ = *string++;
- if (*string == '\0') {
- break;
- }
- }
-
- /*
- * Check to see if we need to back up because we saw a trailing
- * 'e' or sign.
- */
-
- if (flags & SCAN_NODIGITS) {
- if (flags & SCAN_EXPOK) {
- /*
- * There were no digits at all so scanning has failed and
- * we are done.
- */
-
- if (*string == '\0') {
+ } else {
+ if (end == string + width) {
underflow = 1;
}
- goto done;
- }
-
- /*
- * We got a bad exponent ('e' and maybe a sign).
- */
-
- end--;
- string--;
- if (*end != 'e' && *end != 'E') {
- end--;
- string--;
}
- }
-
- /*
- * Scan the value from the temporary buffer.
- */
-
- if (!(flags & SCAN_SUPPRESS)) {
+ goto done;
+ } else if (flags & SCAN_SUPPRESS) {
+ Tcl_DecrRefCount(objPtr);
+ string = end;
+ } else {
double dvalue;
-
- *end = '\0';
- dvalue = TclStrToD(buf, NULL);
- objPtr = Tcl_NewDoubleObj(dvalue);
- Tcl_IncrRefCount(objPtr);
+ if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
+#ifdef ACCEPT_NAN
+ if (objPtr->typePtr == &tclDoubleType) {
+ dvalue = objPtr->internalRep.doubleValue;
+ } else
+#endif
+ {
+ Tcl_DecrRefCount(objPtr);
+ goto done;
+ }
+ }
+ Tcl_SetDoubleObj(objPtr, dvalue);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
+ string = end;
}
- break;
}
nconversions++;
}
@@ -1172,9 +1016,14 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
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]), "\"", (char *) 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]);
@@ -1200,7 +1049,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
}
}
if (objs != NULL) {
- ckfree((char*) objs);
+ ckfree(objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 68f6c30..883e2ea 100755..100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1,87 +1,198 @@
/*
- *----------------------------------------------------------------------
- *
* tclStrToD.c --
*
- * This file contains a TclStrToD procedure that handles conversion of
- * string to double, with correct rounding even where extended precision
- * is needed to achieve that. It also contains a TclDoubleDigits
- * procedure that handles conversion of double to string (at least the
- * significand), and several utility functions for interconverting
- * 'double' and the integer types.
- *
- * Copyright (c) 2005 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.
+ * This file contains a collection of procedures for managing conversions
+ * to/from floating-point in Tcl. They include TclParseNumber, which
+ * parses numbers from strings; TclDoubleDigits, which formats numbers
+ * into strings of digits, and procedures for interconversion among
+ * 'double' and 'mp_int' types.
*
- * RCS: @(#) $Id: tclStrToD.c,v 1.8 2005/08/24 15:15:45 kennykb Exp $
+ * Copyright (c) 2005 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.
*/
-#include <tclInt.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <float.h>
-#include <limits.h>
+#include "tclInt.h"
+#include "tommath.h"
#include <math.h>
-#include <ctype.h>
-#include <tommath.h>
/*
- * The stuff below is a bit of a hack so that this file can be used in
- * environments that include no UNIX, i.e. no errno: just arrange to use the
- * errno from tclExecute.c here.
+ * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
+ * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
*/
-#ifdef TCL_GENERIC_ONLY
-# define NO_ERRNO_H
-#endif
+#undef KILL_OCTAL
-#ifdef NO_ERRNO_H
-extern int errno; /* Use errno from tclExecute.c. */
-# define ERANGE 34
-#endif
+/*
+ * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
+ * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
+ * uniquely determined by radix and by the widths of significand and exponent.
+ */
#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
# define IEEE_FLOATING_POINT
#endif
/*
- * gcc on x86 needs access to rounding controls. It is tempting to include
- * fpu_control.h, but that file exists only on Linux; it is missing on Cygwin
- * and MinGW. Most gcc-isms and ix86-isms are factored out here.
+ * Rounding controls. (Thanks a lot, Intel!)
*/
-#if defined(__GNUC__) && defined(__i386)
-typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
-# define _FPU_GETCW(cw) __asm__ ("fnstcw %0" : "=m" (*&cw))
-# define _FPU_SETCW(cw) __asm__ ("fldcw %0" : : "m" (*&cw))
+#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
+ * file exists only on Linux; it is missing on Cygwin and MinGW. Most gcc-isms
+ * and ix86-isms are factored out here.
+ */
+
+#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
+#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.
+ */
+#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.
+ */
+
+#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?)
+ * 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
/*
- * There now follows a lot of static variables that are shared across all
- * threads but which are not guarded by mutexes. This is OK, because they are
- * only ever assigned _ONCE_ during Tcl's library initialization sequence.
+ * Constants used by this file (most of which are only ever calculated at
+ * 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.
*/
-static const double pow_10_2_n[] = { /* Inexact higher powers of ten */
+#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;
+#define MAXPOW 22
+static double pow10vals[MAXPOW+1];
+ /* The powers of ten that can be represented
+ * exactly as IEEE754 doubles. */
+static int mmaxpow; /* Largest power of ten that can be
+ * represented exactly in a 'double'. */
+static int log10_DIGIT_MAX; /* The number of decimal digits that fit in an
+ * mp_digit. */
+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 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 const double pow_10_2_n[] = { /* Inexact higher powers of ten. */
1.0,
100.0,
10000.0,
@@ -92,436 +203,1564 @@ static const double pow_10_2_n[] = { /* Inexact higher powers of ten */
1.0e+128,
1.0e+256
};
-#define MAXPOW 22 /* Num of exactly representable powers of 10 */
-static double pow10[MAXPOW+1]; /* The powers of ten that can be represented
- * exactly as IEEE754 doubles. */
-static int mmaxpow; /* Largest power of ten that can be
- * represented exactly in a 'double'. */
-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; /* 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 functions defined in this file */
+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. */
+
+/*
+ * 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 double RefineResult(double approx, CONST char *start, int nDigits,
- long exponent);
-static double ParseNaN(int signum, CONST char **end);
-static double SafeLdExp(double fraction, int exponent);
+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 int AccumulateDecimalDigit(unsigned, int,
+ Tcl_WideUInt *, mp_int *, int);
+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);
+#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
/*
*----------------------------------------------------------------------
*
- * TclStrToD --
+ * TclParseNumber --
+ *
+ * Scans bytes, interpreted as characters in Tcl's internal encoding, and
+ * parses the longest prefix that is the string representation of a
+ * number in a format recognized by Tcl.
+ *
+ * The arguments bytes, numBytes, and objPtr are the inputs which
+ * determine the string to be parsed. If bytes is non-NULL, it points to
+ * the first byte to be scanned. If bytes is NULL, then objPtr must be
+ * non-NULL, and the string representation of objPtr will be scanned
+ * (generated first, if necessary). The numBytes argument determines the
+ * number of bytes to be scanned. If numBytes is negative, the first NUL
+ * byte encountered will terminate the scan. If numBytes is non-negative,
+ * then no more than numBytes bytes will be scanned.
+ *
+ * The argument flags is an input that controls the numeric formats
+ * recognized by the parser. The flag bits are:
+ *
+ * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject
+ * strings that denote floating point values (or accept only the
+ * leading portion of them that are integer values).
+ * - TCL_PARSE_SCAN_PREFIXES: ignore the prefixes 0b and 0o that are
+ * not part of the [scan] command's vocabulary. Use only in
+ * combination with TCL_PARSE_INTEGER_ONLY.
+ * - TCL_PARSE_OCTAL_ONLY: parse only in the octal format, whether
+ * or not a prefix is present that would lead to octal parsing.
+ * Use only in combination with TCL_PARSE_INTEGER_ONLY.
+ * - TCL_PARSE_HEXADECIMAL_ONLY: parse only in the hexadecimal format,
+ * whether or not a prefix is present that would lead to
+ * hexadecimal parsing. Use only in combination with
+ * TCL_PARSE_INTEGER_ONLY.
+ * - TCL_PARSE_DECIMAL_ONLY: parse only in the decimal format, no
+ * matter whether a 0 prefix would normally force a different
+ * base.
+ * - TCL_PARSE_NO_WHITESPACE: reject any leading/trailing whitespace
+ *
+ * The arguments interp and expected are inputs that control error
+ * message generation. If interp is NULL, no error message will be
+ * generated. If interp is non-NULL, then expected must also be non-NULL.
+ * When TCL_ERROR is returned, an error message will be left in the
+ * result of interp, and the expected argument will appear in the error
+ * message as the thing TclParseNumber expected, but failed to find in
+ * the string.
+ *
+ * The arguments objPtr and endPtrPtr as well as the return code are the
+ * outputs.
+ *
+ * When the parser cannot find any prefix of the string that matches a
+ * format it is looking for, TCL_ERROR is returned and an error message
+ * may be generated and returned as described above. The contents of
+ * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to the
+ * character in the string that terminated the scan will be written to
+ * *endPtrPtr.
+ *
+ * When the parser determines that the entire string matches a format it
+ * is looking for, TCL_OK is returned, and if objPtr is non-NULL, then
+ * the internal rep and Tcl_ObjType of objPtr are set to the "canonical"
+ * numeric value that matches the scanned string. If endPtrPtr is not
+ * NULL, a pointer to the end of the string will be written to *endPtrPtr
+ * (that is, either bytes+numBytes or a pointer to a terminating NUL
+ * byte).
+ *
+ * When the parser determines that a partial string matches a format it
+ * is looking for, the value of endPtrPtr determines what happens:
+ *
+ * - If endPtrPtr is NULL, then TCL_ERROR is returned, with error message
+ * generation as above.
+ *
+ * - If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr
+ * internals are set as above. Also, a pointer to the first
+ * character following the parsed numeric string is written to
+ * *endPtrPtr.
*
- * Scans a double from a string.
+ * In some cases where the string being scanned is the string rep of
+ * objPtr, this routine can leave objPtr in an inconsistent state where
+ * its string rep and its internal rep do not agree. In these cases the
+ * internal rep will be in agreement with only some substring of the
+ * string rep. This might happen if the caller passes in a non-NULL bytes
+ * value that points somewhere into the string rep. It might happen if
+ * the caller passes in a numBytes value that limits the scan to only a
+ * prefix of the string rep. Or it might happen if a non-NULL value of
+ * endPtrPtr permits a TCL_OK return from only a partial string match. It
+ * is the responsibility of the caller to detect and correct such
+ * inconsistencies when they can and do arise.
*
* Results:
- * Returns the scanned number. In the case of underflow, returns an
- * appropriately signed zero; in the case of overflow, returns an
- * appropriately signed HUGE_VAL.
+ * Returns a standard Tcl result.
*
* Side effects:
- * Stores a pointer to the end of the scanned number in '*endPtr', if
- * endPtr is not NULL. If '*endPtr' is equal to 's' on return from this
- * function, it indicates that the input string could not be recognized
- * as a number. In the case of underflow or overflow, 'errno' is set to
- * ERANGE.
+ * The string representaton of objPtr may be generated.
*
- *------------------------------------------------------------------------
+ * The internal representation and Tcl_ObjType of objPtr may be changed.
+ * This may involve allocation and/or freeing of memory.
+ *
+ *----------------------------------------------------------------------
*/
-double
-TclStrToD(CONST char *s, /* String to scan. */
- CONST char **endPtr) /* Pointer to the end of the scanned number. */
+int
+TclParseNumber(
+ Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
+ Tcl_Obj *objPtr, /* Object to receive the internal rep. */
+ const char *expected, /* Description of the type of number the
+ * caller expects to be able to parse
+ * ("integer", "boolean value", etc.). */
+ const char *bytes, /* Pointer to the start of the string to
+ * scan. */
+ int numBytes, /* Maximum number of bytes to scan, see
+ * above. */
+ const char **endPtrPtr, /* Place to store pointer to the character
+ * that terminated the scan. */
+ int flags) /* Flags governing the parse. */
{
- const char *p = s;
- const char *startOfSignificand = NULL;
- /* Start of the significand in the string. */
- int signum = 0; /* Sign of the significand. */
- double exactSignificand = 0.0;
- /* Significand, represented exactly as a
- * floating-point number. */
- int seenDigit = 0; /* Flag == 1 if a digit has been seen. */
- int nSigDigs = 0; /* Number of significant digits presented. */
- int nDigitsAfterDp = 0; /* Number of digits after the decimal point. */
- int nTrailZero = 0; /* Number of trailing zeros in the
+ enum State {
+ INITIAL, SIGNUM, ZERO, ZERO_X,
+ ZERO_O, ZERO_B, BINARY,
+ HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
+ LEADING_RADIX_POINT, FRACTION,
+ EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
+ sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
+#ifdef IEEE_FLOATING_POINT
+ , sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
+#endif
+ } state = INITIAL;
+ enum State acceptState = INITIAL;
+
+ int signum = 0; /* Sign of the number being parsed. */
+ Tcl_WideUInt significandWide = 0;
+ /* Significand of the number being parsed (if
+ * no overflow). */
+ mp_int significandBig; /* Significand of the number being parsed (if
+ * 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'. */
+ mp_int octalSignificandBig; /* Significand of octal number once
+ * octalSignificandWide overflows. */
+ int octalSignificandOverflow = 0;
+ /* Flag==1 if octalSignificandBig is used. */
+ int numSigDigs = 0; /* Number of significant digits in the decimal
* significand. */
- long exponent = 0; /* Exponent. */
- int seenDp = 0; /* Flag == 1 if decimal point has been seen. */
- char c; /* One character extracted from the input. */
- volatile double v; /* Scanned value; must be 'volatile double' on
- * gc-ix86 to force correct rounding to IEEE
- * double and not Intel double-extended. */
- int machexp; /* Exponent of the machine rep of the scanned
- * value. */
- int expt2; /* Exponent for computing first approximation
- * to the true value. */
- int i, j;
+ 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. */
+ 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. */
+ const char *acceptPoint; /* Pointer to position after last character in
+ * an acceptable number. */
+ size_t acceptLen; /* Number of characters following that
+ * point. */
+ 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 */
+ int explicitOctal = 0;
+
+#define ALL_BITS (~(Tcl_WideUInt)0)
+#define MOST_BITS (ALL_BITS >> 1)
/*
- * With gcc on x86, the floating point rounding mode is double-extended.
- * This causes the result of double-precision calculations to be rounded
- * twice: once to the precision of double-extended and then again to the
- * precision of double. Double-rounding introduces gratuitous errors of
- * one ulp, so we need to change rounding mode to 53-bits.
+ * Initialize bytes to start of the object's string rep if the caller
+ * didn't pass anything else.
*/
-#ifdef ADJUST_FPU_CONTROL_WORD
- fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING;
- fpu_control_t oldRoundingMode;
- _FPU_GETCW(oldRoundingMode);
- _FPU_SETCW(roundTo53Bits);
-# define RestoreRoundingMode() _FPU_SETCW(oldRoundingMode)
-#else
-# define RestoreRoundingMode() (void) 0 /* Do nothing */
+ if (bytes == NULL) {
+ bytes = TclGetString(objPtr);
+ }
+
+ p = bytes;
+ len = numBytes;
+ acceptPoint = p;
+ acceptLen = len;
+ while (1) {
+ char c = len ? *p : '\0';
+ switch (state) {
+
+ case INITIAL:
+ /*
+ * Initial state. Acceptable characters are +, -, digits, period,
+ * I, N, and whitespace.
+ */
+
+ if (TclIsSpaceProc(c)) {
+ if (flags & TCL_PARSE_NO_WHITESPACE) {
+ goto endgame;
+ }
+ break;
+ } else if (c == '+') {
+ state = SIGNUM;
+ break;
+ } else if (c == '-') {
+ signum = 1;
+ state = SIGNUM;
+ break;
+ }
+ /* FALLTHROUGH */
+
+ case SIGNUM:
+ /*
+ * Scanned a leading + or -. Acceptable characters are digits,
+ * period, I, and N.
+ */
+
+ if (c == '0') {
+ if (flags & TCL_PARSE_DECIMAL_ONLY) {
+ state = DECIMAL;
+ } else {
+ state = ZERO;
+ }
+ break;
+ } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
+ goto zerox;
+ } else if (flags & TCL_PARSE_BINARY_ONLY) {
+ goto zerob;
+ } else if (flags & TCL_PARSE_OCTAL_ONLY) {
+ goto zeroo;
+ } else if (isdigit(UCHAR(c))) {
+ significandWide = c - '0';
+ numSigDigs = 1;
+ state = DECIMAL;
+ break;
+ } else if (flags & TCL_PARSE_INTEGER_ONLY) {
+ goto endgame;
+ } else if (c == '.') {
+ state = LEADING_RADIX_POINT;
+ break;
+ } else if (c == 'I' || c == 'i') {
+ state = sI;
+ break;
+#ifdef IEEE_FLOATING_POINT
+ } else if (c == 'N' || c == 'n') {
+ state = sN;
+ break;
#endif
+ }
+ goto endgame;
- /*
- * Discard leading whitespace from input.
- */
+ 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'.
+ */
- while (isspace(UCHAR(*p))) {
- ++p;
- }
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (c == 'x' || c == 'X') {
+ state = ZERO_X;
+ break;
+ }
+ if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
+ goto zerox;
+ }
+ if (flags & TCL_PARSE_SCAN_PREFIXES) {
+ goto zeroo;
+ }
+ if (c == 'b' || c == 'B') {
+ state = ZERO_B;
+ break;
+ }
+ if (flags & TCL_PARSE_BINARY_ONLY) {
+ goto zerob;
+ }
+ if (c == 'o' || c == 'O') {
+ explicitOctal = 1;
+ state = ZERO_O;
+ break;
+ }
+#ifdef KILL_OCTAL
+ goto decimal;
+#endif
+ /* FALLTHROUGH */
- /*
- * Determine the sign of the significand.
- */
+ case OCTAL:
+ /*
+ * Scanned an optional + or -, followed by a string of octal
+ * digits. Acceptable inputs are more digits, period, or E. If 8
+ * or 9 is encountered, commit to floating point.
+ */
- switch (*p) {
- case '-':
- signum = 1;
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ /* FALLTHROUGH */
+ case ZERO_O:
+ zeroo:
+ if (c == '0') {
+ numTrailZeros++;
+ state = OCTAL;
+ break;
+ } else if (c >= '1' && c <= '7') {
+ if (objPtr != NULL) {
+ shift = 3 * (numTrailZeros + 1);
+ significandOverflow = AccumulateDecimalDigit(
+ (unsigned)(c-'0'), numTrailZeros,
+ &significandWide, &significandBig,
+ significandOverflow);
+
+ if (!octalSignificandOverflow) {
+ /*
+ * Shifting by more bits than are in the value being
+ * shifted is at least de facto nonportable. Check for
+ * too large shifts first.
+ */
+
+ if ((octalSignificandWide != 0)
+ && (((size_t)shift >=
+ CHAR_BIT*sizeof(Tcl_WideUInt))
+ || (octalSignificandWide >
+ (~(Tcl_WideUInt)0 >> shift)))) {
+ octalSignificandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ octalSignificandWide);
+ }
+ }
+ if (!octalSignificandOverflow) {
+ octalSignificandWide =
+ (octalSignificandWide << shift) + (c - '0');
+ } else {
+ mp_mul_2d(&octalSignificandBig, shift,
+ &octalSignificandBig);
+ mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'),
+ &octalSignificandBig);
+ }
+ }
+ if (numSigDigs != 0) {
+ numSigDigs += numTrailZeros+1;
+ } else {
+ numSigDigs = 1;
+ }
+ numTrailZeros = 0;
+ state = OCTAL;
+ break;
+ }
/* FALLTHROUGH */
- case '+':
- ++p;
- }
- /*
- * Discard leading zeroes from input.
- */
+ case BAD_OCTAL:
+ if (explicitOctal) {
+ /*
+ * No forgiveness for bad digits in explicitly octal numbers.
+ */
- while (*p == '0') {
- seenDigit = 1;
- ++p;
- }
+ goto endgame;
+ }
+ if (flags & TCL_PARSE_INTEGER_ONLY) {
+ /*
+ * No seeking floating point when parsing only integer.
+ */
- /*
- * Scan digits from the significand. Simultaneously, keep track of the
- * number of digits after the decimal point. Maintain a pointer to the
- * start of the significand. Keep "exactSignificand" equal to the
- * conversion of the DBL_DIG most significant digits.
- */
+ goto endgame;
+ }
+#ifndef KILL_OCTAL
+
+ /*
+ * Scanned a number with a leading zero that contains an 8, 9,
+ * radix point or E. This is an invalid octal number, but might
+ * still be floating point.
+ */
- for (;;) {
- c = *p;
- if (c == '.' && !seenDp) {
- seenDp = 1;
- ++p;
- } else if (isdigit(UCHAR(c))) {
if (c == '0') {
- if (startOfSignificand != NULL) {
- ++nTrailZero;
+ numTrailZeros++;
+ state = BAD_OCTAL;
+ break;
+ } else if (isdigit(UCHAR(c))) {
+ if (objPtr != NULL) {
+ significandOverflow = AccumulateDecimalDigit(
+ (unsigned)(c-'0'), numTrailZeros,
+ &significandWide, &significandBig,
+ significandOverflow);
+ }
+ if (numSigDigs != 0) {
+ numSigDigs += (numTrailZeros + 1);
+ } else {
+ numSigDigs = 1;
}
+ numTrailZeros = 0;
+ state = BAD_OCTAL;
+ break;
+ } else if (c == '.') {
+ state = FRACTION;
+ break;
+ } else if (c == 'E' || c == 'e') {
+ state = EXPONENT_START;
+ break;
+ }
+#endif
+ goto endgame;
+
+ /*
+ * Scanned 0x. If state is HEXADECIMAL, scanned at least one
+ * character following the 0x. The only acceptable inputs are
+ * hexadecimal digits.
+ */
+
+ case HEXADECIMAL:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ /* FALLTHROUGH */
+
+ case ZERO_X:
+ zerox:
+ if (c == '0') {
+ numTrailZeros++;
+ state = HEXADECIMAL;
+ break;
+ } else if (isdigit(UCHAR(c))) {
+ d = (c-'0');
+ } else if (c >= 'A' && c <= 'F') {
+ d = (c-'A'+10);
+ } else if (c >= 'a' && c <= 'f') {
+ d = (c-'a'+10);
} else {
- if (startOfSignificand == NULL) {
- startOfSignificand = p;
- } else if (nTrailZero) {
- if (nTrailZero + nSigDigs < DBL_DIG) {
- exactSignificand *= pow10[nTrailZero];
- } else if (nSigDigs < DBL_DIG) {
- exactSignificand *= pow10[DBL_DIG - nSigDigs];
+ goto endgame;
+ }
+ if (objPtr != NULL) {
+ shift = 4 * (numTrailZeros + 1);
+ if (!significandOverflow) {
+ /*
+ * Shifting by more bits than are in the value being
+ * shifted is at least de facto nonportable. Check for too
+ * large shifts first.
+ */
+
+ if (significandWide != 0 &&
+ ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+ significandWide > (~(Tcl_WideUInt)0 >> shift))) {
+ significandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&significandBig,
+ significandWide);
}
- nSigDigs += nTrailZero;
}
- if (nSigDigs < DBL_DIG) {
- exactSignificand = 10. * exactSignificand + (c - '0');
+ if (!significandOverflow) {
+ significandWide = (significandWide << shift) + d;
+ } else {
+ mp_mul_2d(&significandBig, shift, &significandBig);
+ mp_add_d(&significandBig, (mp_digit) d, &significandBig);
}
- ++nSigDigs;
- nTrailZero = 0;
}
- if (seenDp) {
- ++nDigitsAfterDp;
+ numTrailZeros = 0;
+ state = HEXADECIMAL;
+ break;
+
+ case BINARY:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ case ZERO_B:
+ zerob:
+ if (c == '0') {
+ numTrailZeros++;
+ state = BINARY;
+ break;
+ } else if (c != '1') {
+ goto endgame;
+ }
+ if (objPtr != NULL) {
+ shift = numTrailZeros + 1;
+ if (!significandOverflow) {
+ /*
+ * Shifting by more bits than are in the value being
+ * shifted is at least de facto nonportable. Check for too
+ * large shifts first.
+ */
+
+ if (significandWide != 0 &&
+ ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+ significandWide > (~(Tcl_WideUInt)0 >> shift))) {
+ significandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&significandBig,
+ significandWide);
+ }
+ }
+ if (!significandOverflow) {
+ significandWide = (significandWide << shift) + 1;
+ } else {
+ mp_mul_2d(&significandBig, shift, &significandBig);
+ mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
+ }
}
- seenDigit = 1;
- ++p;
- } else {
+ numTrailZeros = 0;
+ state = BINARY;
break;
- }
- }
- /*
- * At this point, we've scanned the significand, and p points to the
- * character beyond it. "startOfSignificand" is the first non-zero
- * character in the significand. "nSigDigs" is the number of significant
- * digits of the significand, not including any trailing zeroes.
- * "exactSignificand" is a floating point number that represents, without
- * loss of precision, the first min(DBL_DIG,n) digits of the significand.
- * "nDigitsAfterDp" is the number of digits after the decimal point, again
- * excluding trailing zeroes.
- *
- * Now scan 'E' format
- */
+ case DECIMAL:
+ /*
+ * Scanned an optional + or - followed by a string of decimal
+ * digits.
+ */
+
+#ifdef KILL_OCTAL
+ decimal:
+#endif
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (c == '0') {
+ numTrailZeros++;
+ state = DECIMAL;
+ break;
+ } else if (isdigit(UCHAR(c))) {
+ if (objPtr != NULL) {
+ significandOverflow = AccumulateDecimalDigit(
+ (unsigned)(c - '0'), numTrailZeros,
+ &significandWide, &significandBig,
+ significandOverflow);
+ }
+ numSigDigs += numTrailZeros+1;
+ numTrailZeros = 0;
+ state = DECIMAL;
+ break;
+ } else if (flags & TCL_PARSE_INTEGER_ONLY) {
+ goto endgame;
+ } else if (c == '.') {
+ state = FRACTION;
+ break;
+ } else if (c == 'E' || c == 'e') {
+ state = EXPONENT_START;
+ break;
+ }
+ goto endgame;
- exponent = 0;
- if (seenDigit && (*p == 'e' || *p == 'E')) {
- const char* stringSave = p;
- ++p;
- c = *p;
- if (isdigit(UCHAR(c)) || c == '+' || c == '-') {
- errno = 0;
- exponent = strtol(p, (char**)&p, 10);
- if (errno == ERANGE) {
- if (exponent > 0) {
- v = HUGE_VAL;
+ /*
+ * Found a decimal point. If no digits have yet been scanned, E is
+ * not allowed; otherwise, it introduces the exponent. If at least
+ * one digit has been found, we have a possible complete number.
+ */
+
+ case FRACTION:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (c == 'E' || c=='e') {
+ state = EXPONENT_START;
+ break;
+ }
+ /* FALLTHROUGH */
+
+ case LEADING_RADIX_POINT:
+ if (c == '0') {
+ numDigitsAfterDp++;
+ numTrailZeros++;
+ state = FRACTION;
+ break;
+ } else if (isdigit(UCHAR(c))) {
+ numDigitsAfterDp++;
+ if (objPtr != NULL) {
+ significandOverflow = AccumulateDecimalDigit(
+ (unsigned)(c-'0'), numTrailZeros,
+ &significandWide, &significandBig,
+ significandOverflow);
+ }
+ if (numSigDigs != 0) {
+ numSigDigs += numTrailZeros+1;
} else {
- v = 0.0;
+ numSigDigs = 1;
}
- *endPtr = p;
- goto returnValue;
+ numTrailZeros = 0;
+ state = FRACTION;
+ break;
}
+ goto endgame;
+
+ case EXPONENT_START:
+ /*
+ * Scanned the E at the start of an exponent. Make sure a legal
+ * character follows before using the C library strtol routine,
+ * which allows whitespace.
+ */
+
+ if (c == '+') {
+ state = EXPONENT_SIGNUM;
+ break;
+ } else if (c == '-') {
+ exponentSignum = 1;
+ state = EXPONENT_SIGNUM;
+ break;
+ }
+ /* FALLTHROUGH */
+
+ case EXPONENT_SIGNUM:
+ /*
+ * Found the E at the start of the exponent, followed by a sign
+ * character.
+ */
+
+ if (isdigit(UCHAR(c))) {
+ exponent = c - '0';
+ state = EXPONENT;
+ break;
+ }
+ goto endgame;
+
+ case EXPONENT:
+ /*
+ * Found an exponent with at least one digit. Accumulate it,
+ * making sure to hard-pin it to LONG_MAX on overflow.
+ */
+
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (isdigit(UCHAR(c))) {
+ if (exponent < (LONG_MAX - 9) / 10) {
+ exponent = 10 * exponent + (c - '0');
+ } else {
+ exponent = LONG_MAX;
+ }
+ state = EXPONENT;
+ break;
+ }
+ goto endgame;
+
+ /*
+ * Parse out INFINITY by simply spelling it out. INF is accepted
+ * as an abbreviation; other prefices are not.
+ */
+
+ case sI:
+ if (c == 'n' || c == 'N') {
+ state = sIN;
+ break;
+ }
+ goto endgame;
+ case sIN:
+ if (c == 'f' || c == 'F') {
+ state = sINF;
+ break;
+ }
+ goto endgame;
+ case sINF:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (c == 'i' || c == 'I') {
+ state = sINFI;
+ break;
+ }
+ goto endgame;
+ case sINFI:
+ if (c == 'n' || c == 'N') {
+ state = sINFIN;
+ break;
+ }
+ goto endgame;
+ case sINFIN:
+ if (c == 'i' || c == 'I') {
+ state = sINFINI;
+ break;
+ }
+ goto endgame;
+ case sINFINI:
+ if (c == 't' || c == 'T') {
+ state = sINFINIT;
+ break;
+ }
+ goto endgame;
+ case sINFINIT:
+ if (c == 'y' || c == 'Y') {
+ state = sINFINITY;
+ break;
+ }
+ goto endgame;
+
+ /*
+ * Parse NaN's.
+ */
+#ifdef IEEE_FLOATING_POINT
+ case sN:
+ if (c == 'a' || c == 'A') {
+ state = sNA;
+ break;
+ }
+ goto endgame;
+ case sNA:
+ if (c == 'n' || c == 'N') {
+ state = sNAN;
+ break;
+ }
+ goto endgame;
+ case sNAN:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ if (c == '(') {
+ state = sNANPAREN;
+ break;
+ }
+ goto endgame;
+
+ /*
+ * Parse NaN(hexdigits)
+ */
+ case sNANHEX:
+ if (c == ')') {
+ state = sNANFINISH;
+ break;
+ }
+ /* FALLTHROUGH */
+ case sNANPAREN:
+ if (TclIsSpaceProc(c)) {
+ break;
+ }
+ if (numSigDigs < 13) {
+ if (c >= '0' && c <= '9') {
+ d = c - '0';
+ } else if (c >= 'a' && c <= 'f') {
+ 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;
+ }
+ goto endgame;
+ case sNANFINISH:
+#endif
+
+ case sINFINITY:
+ acceptState = state;
+ acceptPoint = p;
+ acceptLen = len;
+ goto endgame;
}
- if (p == stringSave+1) {
- p = stringSave;
- exponent = 0;
- }
+ p++;
+ len--;
}
- exponent += nTrailZero - nDigitsAfterDp;
- /*
- * If we come here with no significant digits, we might still be looking
- * at Inf or NaN. Go parse them.
- */
+ endgame:
+ if (acceptState == INITIAL) {
+ /*
+ * No numeric string at all found.
+ */
- if (!seenDigit) {
+ status = TCL_ERROR;
+ if (endPtrPtr != NULL) {
+ *endPtrPtr = p;
+ }
+ } else {
/*
- * Test for Inf or Infinity (in any case).
+ * Back up to the last accepting state in the lexer.
*/
- if (c == 'I' || c == 'i') {
- if ((p[1] == 'N' || p[1] == 'n')
- && (p[2] == 'F' || p[2] == 'f')) {
- p += 3;
- if ((p[0] == 'I' || p[0] == 'i')
- && (p[1] == 'N' || p[1] == 'n')
- && (p[2] == 'I' || p[2] == 'i')
- && (p[3] == 'T' || p[3] == 't')
- && (p[4] == 'Y' || p[1] == 'y')) {
- p += 5;
+ p = acceptPoint;
+ len = acceptLen;
+ if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
+ /*
+ * Accept trailing whitespace.
+ */
+
+ while (len != 0 && TclIsSpaceProc(*p)) {
+ p++;
+ len--;
+ }
+ }
+ if (endPtrPtr == NULL) {
+ if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
+ status = TCL_ERROR;
+ }
+ } else {
+ *endPtrPtr = p;
+ }
+ }
+
+ /*
+ * Generate and store the appropriate internal rep.
+ */
+
+ if (status == TCL_OK && objPtr != NULL) {
+ TclFreeIntRep(objPtr);
+ switch (acceptState) {
+ case SIGNUM:
+ case BAD_OCTAL:
+ case ZERO_X:
+ case ZERO_O:
+ case ZERO_B:
+ case LEADING_RADIX_POINT:
+ case EXPONENT_START:
+ case EXPONENT_SIGNUM:
+ case sI:
+ case sIN:
+ case sINFI:
+ case sINFIN:
+ case sINFINI:
+ case sINFINIT:
+#ifdef IEEE_FLOATING_POINT
+ case sN:
+ case sNA:
+ case sNANPAREN:
+ case sNANHEX:
+ Tcl_Panic("TclParseNumber: bad acceptState %d parsing '%s'",
+ acceptState, bytes);
+#endif
+ case BINARY:
+ shift = numTrailZeros;
+ if (!significandOverflow && significandWide != 0 &&
+ ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+ significandWide > (MOST_BITS + signum) >> shift)) {
+ significandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ }
+ if (shift) {
+ if (!significandOverflow) {
+ significandWide <<= shift;
+ } else {
+ mp_mul_2d(&significandBig, shift, &significandBig);
}
- errno = ERANGE;
- v = HUGE_VAL;
- if (endPtr != NULL) {
- *endPtr = p;
+ }
+ goto returnInteger;
+
+ case HEXADECIMAL:
+ /*
+ * Returning a hex integer. Final scaling step.
+ */
+
+ shift = 4 * numTrailZeros;
+ if (!significandOverflow && significandWide !=0 &&
+ ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+ significandWide > (MOST_BITS + signum) >> shift)) {
+ significandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ }
+ if (shift) {
+ if (!significandOverflow) {
+ significandWide <<= shift;
+ } else {
+ mp_mul_2d(&significandBig, shift, &significandBig);
}
- goto returnValue;
}
+ goto returnInteger;
-#ifdef IEEE_FLOATING_POINT
+ case OCTAL:
/*
- * Only IEEE floating point supports NaN
+ * Returning an octal integer. Final scaling step.
*/
- } else if ((c == 'N' || c == 'n')
- && (sizeof(Tcl_WideUInt) == sizeof(double))) {
- if ((p[1] == 'A' || p[1] == 'a')
- && (p[2] == 'N' || p[2] == 'n')) {
- p += 3;
-
- if (endPtr != NULL) {
- *endPtr = p;
+
+ shift = 3 * numTrailZeros;
+ if (!octalSignificandOverflow && octalSignificandWide != 0 &&
+ ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+ octalSignificandWide > (MOST_BITS + signum) >> shift)) {
+ octalSignificandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ octalSignificandWide);
+ }
+ if (shift) {
+ if (!octalSignificandOverflow) {
+ octalSignificandWide <<= shift;
+ } else {
+ mp_mul_2d(&octalSignificandBig, shift,
+ &octalSignificandBig);
+ }
+ }
+ if (!octalSignificandOverflow) {
+ if (octalSignificandWide >
+ (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (octalSignificandWide <= (MOST_BITS + signum)) {
+ objPtr->typePtr = &tclWideIntType;
+ if (signum) {
+ objPtr->internalRep.wideValue =
+ - (Tcl_WideInt) octalSignificandWide;
+ } else {
+ objPtr->internalRep.wideValue =
+ (Tcl_WideInt) octalSignificandWide;
+ }
+ break;
+ }
+#endif
+ TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ octalSignificandWide);
+ octalSignificandOverflow = 1;
+ } else {
+ objPtr->typePtr = &tclIntType;
+ if (signum) {
+ objPtr->internalRep.longValue =
+ - (long) octalSignificandWide;
+ } else {
+ objPtr->internalRep.longValue =
+ (long) octalSignificandWide;
+ }
+ }
+ }
+ if (octalSignificandOverflow) {
+ if (signum) {
+ mp_neg(&octalSignificandBig, &octalSignificandBig);
+ }
+ TclSetBignumIntRep(objPtr, &octalSignificandBig);
+ }
+ break;
+
+ case ZERO:
+ case DECIMAL:
+ significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
+ &significandWide, &significandBig, significandOverflow);
+ if (!significandOverflow && (significandWide > MOST_BITS+signum)){
+ significandOverflow = 1;
+ TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ }
+ returnInteger:
+ if (!significandOverflow) {
+ if (significandWide >
+ (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (significandWide <= MOST_BITS+signum) {
+ objPtr->typePtr = &tclWideIntType;
+ if (signum) {
+ objPtr->internalRep.wideValue =
+ - (Tcl_WideInt) significandWide;
+ } else {
+ objPtr->internalRep.wideValue =
+ (Tcl_WideInt) significandWide;
+ }
+ break;
+ }
+#endif
+ TclBNInitBignumFromWideUInt(&significandBig,
+ significandWide);
+ significandOverflow = 1;
+ } else {
+ objPtr->typePtr = &tclIntType;
+ if (signum) {
+ objPtr->internalRep.longValue =
+ - (long) significandWide;
+ } else {
+ objPtr->internalRep.longValue =
+ (long) significandWide;
+ }
}
+ }
+ if (significandOverflow) {
+ if (signum) {
+ mp_neg(&significandBig, &significandBig);
+ }
+ TclSetBignumIntRep(objPtr, &significandBig);
+ }
+ break;
- /*
- * Restore FPU mode word.
- */
+ case FRACTION:
+ case EXPONENT:
- RestoreRoundingMode();
- return ParseNaN(signum, endPtr);
+ /*
+ * Here, we're parsing a floating-point number. 'significandWide'
+ * or 'significandBig' contains the exact significand, according
+ * to whether 'significandOverflow' is set. The desired floating
+ * point value is significand * 10**k, where
+ * k = numTrailZeros+exponent-numDigitsAfterDp.
+ */
+
+ objPtr->typePtr = &tclDoubleType;
+ if (exponentSignum) {
+ exponent = -exponent;
+ }
+ if (!significandOverflow) {
+ objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
+ signum, significandWide, numSigDigs,
+ numTrailZeros + exponent - numDigitsAfterDp);
+ } else {
+ objPtr->internalRep.doubleValue = MakeHighPrecisionDouble(
+ signum, &significandBig, numSigDigs,
+ numTrailZeros + exponent - numDigitsAfterDp);
}
+ break;
+
+ case sINF:
+ case sINFINITY:
+ if (signum) {
+ objPtr->internalRep.doubleValue = -HUGE_VAL;
+ } else {
+ objPtr->internalRep.doubleValue = HUGE_VAL;
+ }
+ objPtr->typePtr = &tclDoubleType;
+ break;
+
+#ifdef IEEE_FLOATING_POINT
+ case sNAN:
+ case sNANFINISH:
+ objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide);
+ objPtr->typePtr = &tclDoubleType;
+ break;
#endif
+ case INITIAL:
+ /* This case only to silence compiler warning. */
+ Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
}
+ }
- goto error;
+ /*
+ * Format an error message when an invalid number is encountered.
+ */
+
+ if (status != TCL_OK) {
+ if (interp != NULL) {
+ Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
+ expected);
+
+ Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
+ Tcl_AppendToObj(msg, "\"", -1);
+ if (state == BAD_OCTAL) {
+ Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
+ }
+ Tcl_SetObjResult(interp, msg);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+ }
}
/*
- * We've successfully scanned; update the end-of-element pointer.
+ * Free memory.
*/
- if (endPtr != NULL) {
- *endPtr = p;
+ if (octalSignificandOverflow) {
+ mp_clear(&octalSignificandBig);
}
+ if (significandOverflow) {
+ mp_clear(&significandBig);
+ }
+ return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AccumulateDecimalDigit --
+ *
+ * Consume a decimal digit in a number being scanned.
+ *
+ * Results:
+ * Returns 1 if the number has overflowed to a bignum, 0 if it still fits
+ * in a wide integer.
+ *
+ * Side effects:
+ * Updates either the wide or bignum representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AccumulateDecimalDigit(
+ unsigned digit, /* Digit being scanned. */
+ int numZeros, /* Count of zero digits preceding the digit
+ * being scanned. */
+ Tcl_WideUInt *wideRepPtr, /* Representation of the partial number as a
+ * wide integer. */
+ mp_int *bignumRepPtr, /* Representation of the partial number as a
+ * bignum. */
+ int bignumFlag) /* Flag == 1 if the number overflowed previous
+ * to this digit. */
+{
+ int i, n;
+ Tcl_WideUInt w;
/*
- * Test for zero.
+ * Try wide multiplication first.
*/
- if (nSigDigs == 0) {
- v = 0.0;
- goto returnValue;
+ if (!bignumFlag) {
+ w = *wideRepPtr;
+ if (w == 0) {
+ /*
+ * There's no need to multiply if the multiplicand is zero.
+ */
+
+ *wideRepPtr = digit;
+ return 0;
+ } else if (numZeros >= maxpow10_wide
+ || 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.
+ */
+
+ TclBNInitBignumFromWideUInt(bignumRepPtr, w);
+ } else {
+ /*
+ * Wide multiplication.
+ */
+
+ *wideRepPtr = w * pow10_wide[numZeros+1] + digit;
+ return 0;
+ }
}
/*
- * The easy cases are where we have an exact significand and the exponent
- * is small enough that we can compute the value with only one roundoff.
- * In addition to the cases where we can multiply or divide an
- * exact-integer significand by an exact-integer power of 10, there is
- * also David Gay's case where we can scale the significand by a power of
- * 10 (still keeping it exact) and then multiply by an exact power of 10.
- * The last case enables combinations like 83e25 that would otherwise
- * require high precision arithmetic.
+ * Bignum multiplication.
*/
- if (nSigDigs <= DBL_DIG) {
- if (exponent >= 0) {
- if (exponent <= mmaxpow) {
- v = exactSignificand * pow10[exponent];
- goto returnValue;
- } else {
- int diff = DBL_DIG - nSigDigs;
- if (exponent - diff <= mmaxpow) {
- volatile double factor = exactSignificand * pow10[diff];
- v = factor * pow10[exponent - diff];
- goto returnValue;
- }
+ if (numZeros < log10_DIGIT_MAX) {
+ /*
+ * Up to about 8 zeros - single digit multiplication.
+ */
+
+ mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1],
+ bignumRepPtr);
+ mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
+ } else {
+ /*
+ * More than single digit multiplication. Multiply by the appropriate
+ * small powers of 5, and then shift. Large strings of zeroes are
+ * eaten 256 at a time; this is less efficient than it could be, but
+ * seems implausible. We presume that DIGIT_BIT is at least 27. The
+ * first multiplication, by up to 10**7, is done with a one-DIGIT
+ * multiply (this presumes that DIGIT_BIT >= 24).
+ */
+
+ n = numZeros + 1;
+ mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr);
+ for (i=3; i<=7; ++i) {
+ if (n & (1 << i)) {
+ mp_mul(bignumRepPtr, pow5+i, bignumRepPtr);
}
- } else if (exponent >= -mmaxpow) {
- v = exactSignificand / pow10[-exponent];
- goto returnValue;
}
+ while (n >= 256) {
+ mp_mul(bignumRepPtr, pow5+8, bignumRepPtr);
+ n -= 256;
+ }
+ mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr);
+ mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
}
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeLowPrecisionDouble --
+ *
+ * Makes the double precision number, signum*significand*10**exponent.
+ *
+ * Results:
+ * Returns the constructed number.
+ *
+ * Common cases, where there are few enough digits that the number can be
+ * represented with at most roundoff, are handled specially here. If the
+ * number requires more than one rounded operation to compute, the code
+ * promotes the significand to a bignum and calls MakeHighPrecisionDouble
+ * to do it instead.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ double retval; /* Value of the number. */
+ mp_int significandBig; /* Significand expressed as a bignum. */
+
/*
- * We don't have one of the easy cases, so we can't compute the scanned
- * number exactly, and have to do it in multiple precision. Begin by
- * testing for obvious overflows and underflows.
+ * With gcc on x86, the floating point rounding mode is double-extended.
+ * This causes the result of double-precision calculations to be rounded
+ * twice: once to the precision of double-extended and then again to the
+ * precision of double. Double-rounding introduces gratuitous errors of 1
+ * ulp, so we need to change rounding mode to 53-bits.
*/
- if (nSigDigs + exponent - 1 > maxDigits) {
- v = HUGE_VAL;
- errno = ERANGE;
- goto returnValue;
- }
- if (nSigDigs + exponent - 1 < minDigits) {
- errno = ERANGE;
- v = 0.;
- goto returnValue;
- }
+ TCL_IEEE_DOUBLE_ROUNDING;
/*
- * Nothing exceeds the boundaries of the tables, at least. Compute an
- * approximate value for the number, with no possibility of overflow
- * because we manage the exponent separately.
+ * Test for the easy cases.
*/
- if (nSigDigs > DBL_DIG) {
- expt2 = exponent + nSigDigs - DBL_DIG;
- } else {
- expt2 = exponent;
- }
- v = frexp(exactSignificand, &machexp);
- if (expt2 > 0) {
- v = frexp(v * pow10[expt2 & 0xf], &j);
- machexp += j;
- for (i=4 ; i<9 ; ++i) {
- if (expt2 & (1 << i)) {
- v = frexp(v * pow_10_2_n[i], &j);
- machexp += j;
+ if (numSigDigs <= DBL_DIG) {
+ if (exponent >= 0) {
+ if (exponent <= mmaxpow) {
+ /*
+ * The significand is an exact integer, and so is
+ * 10**exponent. The product will be correct to within 1/2 ulp
+ * without special handling.
+ */
+
+ 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
+ * 10**(exponent-diff) is exact, and so is
+ * significand*10**diff, so we can still compute the value
+ * with only one roundoff.
+ */
+
+ volatile double factor = (double)
+ ((Tcl_WideInt)significand * pow10vals[diff]);
+ retval = factor * pow10vals[exponent-diff];
+ goto returnValue;
+ }
}
- }
- } else {
- v = frexp(v / pow10[(-expt2) & 0xf], &j);
- machexp += j;
- for (i=4 ; i<9 ; ++i) {
- if ((-expt2) & (1 << i)) {
- v = frexp(v / pow_10_2_n[i], &j);
- machexp += j;
+ } else {
+ if (exponent >= -mmaxpow) {
+ /*
+ * 10**-exponent is an exact integer, and so is the
+ * significand. Compute the result by one division, again with
+ * only one rounding.
+ */
+
+ retval = (double)
+ ((Tcl_WideInt)significand / pow10vals[-exponent]);
+ goto returnValue;
}
}
}
/*
- * A first approximation is that the result will be v * 2 ** machexp. v is
- * greater than or equal to 0.5 and less than 1. If machexp >
- * DBL_MAX_EXP*log2(FLT_RADIX), there is an overflow. Constrain the result
- * to the smallest representible number to avoid premature underflow.
+ * All the easy cases have failed. Promote ths significand to bignum and
+ * call MakeHighPrecisionDouble to do it the hard way.
*/
- if (machexp > DBL_MAX_EXP * log2FLT_RADIX) {
- v = HUGE_VAL;
- errno = ERANGE;
- goto returnValue;
- }
+ TclBNInitBignumFromWideUInt(&significandBig, significand);
+ retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
+ exponent);
+ mp_clear(&significandBig);
+
+ /*
+ * Come here to return the computed value.
+ */
- v = SafeLdExp(v, machexp);
- if (v < tiny) {
- v = tiny;
+ returnValue:
+ if (signum) {
+ retval = -retval;
}
/*
- * We have a first approximation in v. Now we need to refine it.
+ * On gcc on x86, restore the floating point mode word.
*/
- v = RefineResult(v, startOfSignificand, nSigDigs, exponent);
+ TCL_DEFAULT_DOUBLE_ROUNDING;
+
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeHighPrecisionDouble --
+ *
+ * Makes the double precision number, signum*significand*10**exponent.
+ *
+ * Results:
+ * Returns the constructed number.
+ *
+ * MakeHighPrecisionDouble is used when arbitrary-precision arithmetic is
+ * needed to ensure correct rounding. It begins by calculating a
+ * low-precision approximation to the desired number, and then refines
+ * the answer in high precision.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ double retval;
+ int machexp; /* Machine exponent of a power of 10. */
/*
- * In a very few cases, a second iteration is needed. e.g., 457e-102
+ * With gcc on x86, the floating point rounding mode is double-extended.
+ * This causes the result of double-precision calculations to be rounded
+ * twice: once to the precision of double-extended and then again to the
+ * precision of double. Double-rounding introduces gratuitous errors of 1
+ * ulp, so we need to change rounding mode to 53-bits.
*/
- v = RefineResult(v, startOfSignificand, nSigDigs, exponent);
+ TCL_IEEE_DOUBLE_ROUNDING;
/*
- * Handle underflow.
+ * Quick checks for over/underflow.
*/
- returnValue:
- if (nSigDigs != 0 && v == 0.0) {
- errno = ERANGE;
+ if (numSigDigs+exponent-1 > maxDigits) {
+ retval = HUGE_VAL;
+ goto returnValue;
+ }
+ if (numSigDigs+exponent-1 < minDigits) {
+ retval = 0;
+ goto returnValue;
}
/*
- * Return a number with correct sign.
+ * Develop a first approximation to the significand. It is tempting simply
+ * to force bignum to double, but that will overflow on input numbers like
+ * 1.[string repeat 0 1000]1; while this is a not terribly likely
+ * scenario, we still have to deal with it. Use fraction and exponent
+ * instead. Once we have the significand, multiply by 10**exponent. Test
+ * for overflow. Convert back to a double, and test for underflow.
*/
- if (signum) {
- v = -v;
+ retval = BignumToBiasedFrExp(significand, &machexp);
+ retval = Pow10TimesFrExp(exponent, retval, &machexp);
+ if (machexp > DBL_MAX_EXP*log2FLT_RADIX) {
+ retval = HUGE_VAL;
+ goto returnValue;
+ }
+ retval = SafeLdExp(retval, machexp);
+ if (tiny == 0.0) {
+ tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
+ }
+ if (retval < tiny) {
+ retval = tiny;
}
/*
- * Restore FPU mode word and return.
+ * Refine the result twice. (The second refinement should be necessary
+ * only if the best approximation is a power of 2 minus 1/2 ulp).
*/
- RestoreRoundingMode();
- return v;
+ retval = RefineApproximation(retval, significand, exponent);
+ retval = RefineApproximation(retval, significand, exponent);
/*
- * Come here on an invalid input.
+ * Come here to return the computed value.
*/
- error:
- if (endPtr != NULL) {
- *endPtr = s;
+ returnValue:
+ if (signum) {
+ retval = -retval;
}
/*
- * Restore FPU mode word and return.
+ * On gcc on x86, restore the floating point mode word.
*/
- RestoreRoundingMode();
- return 0.0;
+ TCL_DEFAULT_DOUBLE_ROUNDING;
+
+ return retval;
}
/*
*----------------------------------------------------------------------
*
- * RefineResult --
+ * MakeNaN --
+ *
+ * Makes a "Not a Number" given a set of bits to put in the tag bits
+ *
+ * Note that a signalling NaN is never returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#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. */
+{
+ union {
+ Tcl_WideUInt iv;
+ double dv;
+ } theNaN;
+
+ theNaN.iv = tags;
+ theNaN.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
+ if (signum) {
+ theNaN.iv |= ((Tcl_WideUInt) (0x8000 | NAN_START)) << 48;
+ } else {
+ theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48;
+ }
+ if (n770_fp) {
+ theNaN.iv = Nokia770Twiddle(theNaN.iv);
+ }
+ return theNaN.dv;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefineApproximation --
*
* Given a poor approximation to a floating point number, returns a
* better one. (The better approximation is correct to within 1 ulp, and
@@ -534,12 +1773,10 @@ TclStrToD(CONST char *s, /* String to scan. */
*/
static double
-RefineResult(double approxResult, /* Approximate result of conversion. */
- CONST char* sigStart,
- /* Pointer to start of significand in input
- * string. */
- int nSigDigs, /* Number of significant digits. */
- long exponent) /* Power of ten to multiply by significand. */
+RefineApproximation(
+ 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
@@ -562,7 +1799,6 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
double minincr; /* Lower bound on the absolute value of the
* correction term. */
int i;
- const char* p;
/*
* The first approximation is always low. If we find that it's HUGE_VAL,
@@ -589,14 +1825,15 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
M5 = 0;
} else {
M5 = -exponent;
- if ((M5-1) > M2) {
- M2 = M5-1;
+ if (M5 - 1 > M2) {
+ M2 = M5 - 1;
}
}
/*
- * The floating point number is significand*2**binExponent. The 2**-1 bit
- * of the significand (the most significant) corresponds to the
+ * The floating point number is significand*2**binExponent. Compute the
+ * large integer significand*2**(binExponent+M2+1). The 2**-1 bit of the
+ * significand (the most significant) corresponds to the
* 2**(binExponent+M2 + 1) bit of 2*M2*v. Allocate enough digits to hold
* that quantity, then convert the significand to a large integer, scaled
* appropriately. Then multiply by the appropriate power of 5.
@@ -613,7 +1850,7 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
significand -= (mp_digit) significand;
significand = SafeLdExp(significand, DIGIT_BIT);
}
- for (i=0 ; i<=8 ; ++i) {
+ for (i = 0; i <= 8; ++i) {
if (M5 & (1 << i)) {
mp_mul(&twoMv, pow5+i, &twoMv);
}
@@ -626,22 +1863,9 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
* 5**(M5+exponent).
*/
- mp_init(&twoMd);
- mp_zero(&twoMd);
- i = nSigDigs;
- for (p=sigStart ;; ++p) {
- char c = *p;
- if (isdigit(UCHAR(c))) {
- mp_mul_d(&twoMd, (unsigned) 10, &twoMd);
- mp_add_d(&twoMd, (unsigned) (c - '0'), &twoMd);
- --i;
- if (i == 0) {
- break;
- }
- }
- }
- for (i=0 ; i<=8 ; ++i) {
- if ((M5+exponent) & (1 << i)) {
+ mp_init_copy(&twoMd, exactSignificand);
+ for (i=0; i<=8; ++i) {
+ if ((M5 + exponent) & (1 << i)) {
mp_mul(&twoMd, pow5+i, &twoMd);
}
}
@@ -651,13 +1875,13 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
/*
* 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;
mp_set(&twoMv, 1);
- for (i=0 ; i<=8 ; ++i) {
+ for (i=0; i<=8; ++i) {
if (M5 & (1 << i)) {
mp_mul(&twoMv, pow5+i, &twoMv);
}
@@ -689,7 +1913,7 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
den = TclBignumToDouble(&twoMv);
quot = SafeLdExp(num/den, scale);
- minincr = SafeLdExp(1.0, binExponent - mantBits);
+ minincr = SafeLdExp(1.0, binExponent-mantBits);
if (quot<0. && quot>-minincr) {
quot = -minincr;
@@ -706,412 +1930,2387 @@ RefineResult(double approxResult, /* Approximate result of conversion. */
/*
*----------------------------------------------------------------------
*
- * ParseNaN --
+ * MultPow5 --
*
- * Parses a "not a number" from an input string, and returns the double
- * precision NaN corresponding to it.
+ * Multiply a bignum by a power of 5.
*
* Side effects:
- * Advances endPtr to follow any (hex) in the input string.
+ * Stores base*5**n in result.
*
- * If the NaN is followed by a left paren, a string of spaes and
- * hexadecimal digits, and a right paren, endPtr is advanced to follow
- * it.
+ *----------------------------------------------------------------------
+ */
+
+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 --
*
- * The string of hexadecimal digits is OR'ed into the resulting NaN, and
- * the signum is set as well. Note that a signalling NaN is never
- * returned.
+ * Shifts a number rightward until it is odd (that is, until the least
+ * significant bit is nonzero.
+ *
+ * Results:
+ * Returns the number of bit positions by which the number was shifted.
+ *
+ * Side effects:
+ * Shifts the number in place; *wPtr is replaced by the shifted number.
*
*----------------------------------------------------------------------
*/
-static double
-ParseNaN(int signum, /* Flag == 1 if minus sign has been seen in
- * front of NaN. */
- CONST char** endPtr) /* Pointer-to-pointer to char following "NaN"
- * in the input string. */
+inline static int
+NormalizeRightward(
+ Tcl_WideUInt *wPtr) /* INOUT: Number to shift. */
{
- const char* p = *endPtr;
- char c;
- union {
- Tcl_WideUInt iv;
- double dv;
- } theNaN;
+ int rv = 0;
+ Tcl_WideUInt w = *wPtr;
- /*
- * Scan off a hex number in parentheses. Embedded blanks are ok.
- */
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- theNaN.iv = 0;
- if (*p == '(') {
- ++p;
- for (;;) {
- c = *p++;
- if (isspace(UCHAR(c))) {
- continue;
- } else if (c == ')') {
- *endPtr = p;
- break;
- } else if (isdigit(UCHAR(c))) {
- c -= '0';
- } else if (c >= 'A' && c <= 'F') {
- c -= 'A' + 10;
- } else if (c >= 'a' && c <= 'f') {
- c -= 'a' + 10;
- } else {
- theNaN.iv = (((Tcl_WideUInt) NAN_START) << 48)
- | (((Tcl_WideUInt) signum) << 63);
- return theNaN.dv;
- }
- theNaN.iv = (theNaN.iv << 4) | c;
- }
+static int
+RequiredPrecision(
+ Tcl_WideUInt w) /* Number to interrogate. */
+{
+ 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;
/*
- * Mask the hex number down to the least significant 51 bits.
+ * Extract exponent and significand.
*/
- theNaN.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
- if (signum) {
- theNaN.iv |= ((Tcl_WideUInt) 0xfff8) << 48;
+ 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 {
- theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- *endPtr = p;
- return theNaN.dv;
+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;
+ }
}
/*
*----------------------------------------------------------------------
*
- * TclDoubleDigits --
+ * FormatInfAndNaN --
*
- * Converts a double to a string of digits.
+ * Bailout for formatting infinities and Not-A-Number.
*
* 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 one of the strings 'Infinity' and 'NaN'. The string returned
+ * must be freed by the caller using 'ckfree'.
*
* Side effects:
- * Stores the digits in the given buffer and sets 'signum' according to
- * the sign of the number.
+ * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
+ * NUL byte of the string if 'endPtr' is not NULL.
*
*----------------------------------------------------------------------
*/
-int
-TclDoubleDigits(char * strPtr, /* 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. */
+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 */
{
- double f; /* Significand of v. */
- 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 */
- 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;
- double a;
- char c;
- int i, k, n;
+ 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;
/*
- * 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.)
+ * 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))
*/
-#ifndef IEEE_FLOATING_POINT
- if (v >= 0.0) {
- *signum = 0;
+ 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. */
+{
+ /*
+ * Performance hack. If k is in the range 0..TEN_PMAX, then we can use a
+ * powers-of-ten table to check it.
+ */
+
+ if (k >= 0 && k <= TEN_PMAX) {
+ if (d < tens[k]) {
+ k--;
+ }
+ *k_check = 0;
} else {
- *signum = 1;
- v = -v;
+ *k_check = 1;
}
-#else
- union {
- Tcl_WideUInt iv;
- double dv;
- } bitwhack;
- bitwhack.dv = v;
- if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
- *signum = 1;
- bitwhack.iv &= ~((Tcl_WideUInt) 1 << 63);
- v = bitwhack.dv;
+ 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.
+ */
+
+ if (be <= 0) {
+ *b2 = 0;
+ *s2 = -be;
} else {
- *signum = 0;
+ *b2 = be;
+ *s2 = 0;
}
-#endif
/*
- * Handle zero specially.
+ * Scale numerator and denominator so that the output decimal number is
+ * the ratio of integers.
*/
- if (v == 0.0) {
- *strPtr++ = '0';
- *strPtr++ = '\0';
- return 1;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ }
+
+ *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 */
/*
- * Develop f and e such that v = f * FLT_RADIX**e, with
- * 1.0/FLT_RADIX <= f < 1.
+ * Bring d into the range [1 .. 10).
*/
- f = frexp(v, &e);
- n = e % log2FLT_RADIX;
- if (n > 0) {
- n -= log2FLT_RADIX;
- e += 1;
+ 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;
}
- f *= ldexp(1.0, n);
- e = (e - n) / log2FLT_RADIX;
- if (f == 1.0) {
- f = 1.0 / FLT_RADIX;
- e += 1;
+
+ /*
+ * 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;
+ }
}
/*
- * If the original number was denormalized, adjust e and f to be denormal
- * as well.
+ * Format the digit string.
*/
- 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;
+ if (flags & TCL_DD_SHORTEN_FLAG) {
+ end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
} else {
- n = mantDIGIT;
+ 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. */
/*
- * 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.
+ * Adjust if the logarithm was guessed wrong.
*/
- a = f;
- n = mantDIGIT;
- mp_init_size(&r, n);
- r.used = n;
- r.sign = MP_ZPOS;
- i = (mantBits % DIGIT_BIT);
- if (i == 0) {
- i = DIGIT_BIT;
- }
- while (n > 0) {
- a *= ldexp(1.0, i);
- i = DIGIT_BIT;
- r.dp[--n] = (mp_digit) a;
- a -= (mp_digit) a;
+ if (b < S) {
+ b = 10 * b;
+ ++m2plus; ++m2minus; ++m5;
+ ilim = ilim1;
+ --k;
}
- e -= DBL_MANT_DIG;
- lowOK = highOK = (mp_iseven(&r));
+ /*
+ * Compute roundoff ranges.
+ */
+
+ mplus = wuipow5[m5] << m2plus;
+ mminus = wuipow5[m5] << m2minus;
/*
- * 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.
+ * Loop through the digits.
*/
- if (e >= 0) {
- int bits = e * log2FLT_RADIX;
+ i = 1;
+ for (;;) {
+ digit = (int)(b / S);
+ if (digit > 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ b = b % S;
- if (f != 1.0/FLT_RADIX) {
+ /*
+ * Does the current digit put us on the low side of the exact value
+ * but within within roundoff of being exact?
+ */
+
+ if (b < mplus || (b == mplus
+ && convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
/*
- * Normal case, m+ and m- are both FLT_RADIX**e
+ * Make sure we shouldn't be rounding *up* instead, in case the
+ * next number above is closer.
*/
- rfac2 += bits + 1;
- sfac2 = 1;
- mplusfac2 = bits;
- mminusfac2 = bits;
- } else {
+ if (2 * b > S || (2 * b == S && (digit & 1) != 0)) {
+ ++digit;
+ if (digit == 10) {
+ *s++ = '9';
+ s = BumpUp(s, retval, &k);
+ break;
+ }
+ }
+
/*
- * 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.
+ * Stash the current digit.
*/
- rfac2 += bits + log2FLT_RADIX + 1;
- sfac2 = 1 + log2FLT_RADIX;
- mplusfac2 = bits + log2FLT_RADIX;
- mminusfac2 = bits;
+ *s++ = '0' + digit;
+ break;
}
- } else {
+
/*
- * v has digits after the binary point
+ * Does one plus the current digit put us within roundoff of the
+ * number?
*/
- if (e <= DBL_MIN_EXP-DBL_MANT_DIG || f != 1.0/FLT_RADIX) {
- /*
- * Either f isn't the smallest significand or e is the smallest
- * exponent. mplus and mminus will both be 1.
- */
+ 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;
+ }
- rfac2 += 1;
- sfac2 = 1 - e * log2FLT_RADIX;
- mplusfac2 = 0;
- mminusfac2 = 0;
- } else {
- /*
- * 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.
- */
+ /*
+ * Have we converted all the requested digits?
+ */
- rfac2 += 1 + log2FLT_RADIX;
- sfac2 = 1 + log2FLT_RADIX * (1 - e);
- mplusfac2 = FLT_RADIX;
- mminusfac2 = 0;
+ *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. */
/*
- * Scale r, s, mplus, mminus by the appropriate powers of 2 and 5.
+ * Adjust if the logarithm was guessed wrong.
*/
- mp_init_set(&mplus, 1);
- for (i=0 ; i<=8 ; ++i) {
- if (rfac5 & (1 << i)) {
- mp_mul(&mplus, pow5+i, &mplus);
+ if (b < S) {
+ b = 10 * b;
+ ilim = ilim1;
+ --k;
+ }
+
+ /*
+ * Loop through the digits.
+ */
+
+ 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;
}
- 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);
+ 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;
+ }
+ 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?
+ */
+
+ 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(&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);
+ mp_mul_d(&b, 10, &b);
mp_mul_d(&mminus, 10, &mminus);
- tc1 = mp_cmp_mag(&r, &mminus);
- if (lowOK) {
- tc1 = (tc1 <= 0);
+ if (m2plus > m2minus) {
+ mp_mul_2d(&mminus, m2plus-m2minus, &mplus);
+ }
+ ++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 {
- tc1 = (tc1 < 0);
+ digit = b.dp[sd];
+ if (b.used > sd+1 || digit >= 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ --b.used;
+ mp_clamp(&b);
+ }
+
+ /*
+ * 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;
}
- mp_add(&r, &mplus, &temp);
- tc2 = mp_cmp_mag(&temp, &s);
- if (highOK) {
- tc2 = (tc2 >= 0);
+
+ /*
+ * 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 {
- tc2= (tc2 > 0);
+ return isodd;
}
- if (!tc1) {
- if (!tc2) {
- *strPtr++ = '0' + i;
- } else {
- c = (char) (i + '1');
+ 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;
+ }
+
+ /*
+ * 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 {
- if (!tc2) {
- c = (char) (i + '0');
+ mp_mul_d(&b, 10, &b);
+ mp_mul_d(&mminus, 10, &mminus);
+ if (m2plus > m2minus) {
+ mp_mul_2d(&mplus, 10, &mplus);
+ }
+ }
+
+ ++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, &dig, &S, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StrictBignumConversion --
+ *
+ * Convert a floating point number to a fixed-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 *
+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;
+
+ /*
+ * b = bw * 2**b2 * 5**b5
+ * S = 2**s2 * 5*s5
+ */
+
+ 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;
+ }
+
+ /*
+ * Convert the leading digit.
+ */
+
+ i = 0;
+ mp_div(&b, &S, &dig, &b);
+ if (dig.used > 1 || dig.dp[0] >= 10) {
+ Tcl_Panic("wrong digit!");
+ }
+ 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);
+ }
+ } else {
+ 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_2d(&r, 1, &r);
- n = mp_cmp_mag(&r, &s);
- if (n < 0) {
- c = (char) (i + '0');
- } else {
- c = (char) (i + '1');
+ 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;
}
- break;
}
- };
- *strPtr++ = c;
- *strPtr++ = '\0';
+ }
+ while (*--s == '0') {
+ /* do nothing */
+ }
+ ++s;
/*
- * 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;
+ mp_clear_multi(&b, &S, &temp, &dig, NULL);
+ *s = '\0';
+ *decpt = k;
+ if (endPtr) {
+ *endPtr = s;
+ }
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDoubleDigits --
+ *
+ * Core of Tcl's conversion of double-precision floating point numbers to
+ * decimal.
+ *
+ * Results:
+ * Returns a newly-allocated string of digits.
+ *
+ * Side effects:
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ 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;
+
+ /*
+ * Handle the cases of negative numbers (by taking the absolute value:
+ * this includes -Inf and -NaN!), infinity, Not a Number, and zero.
+ */
+
+ TakeAbsoluteValue(&d, sign);
+ if ((d.w.word0 & EXP_MASK) == EXP_MASK) {
+ return FormatInfAndNaN(&d, decpt, endPtr);
+ }
+ if (d.d == 0.0) {
+ return FormatZero(decpt, endPtr);
+ }
+
+ /*
+ * 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)).
+ */
+
+ 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);
+
+ /*
+ * Try to do low-precision conversion in floating point rather than
+ * resorting to expensive multiprecision arithmetic.
+ */
+
+ 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;
+ }
+ }
+
+ /*
+ * 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);
+ }
+ }
}
/*
@@ -1138,14 +4337,53 @@ TclInitDoubleConversion(void)
{
int i;
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;
+
+ mipsCR.fc_word = get_fpc_csr();
+ mipsCR.fc_struct.flush = 0;
+ set_fpc_csr(mipsCR.fc_word);
+#endif
+
+ /*
+ * Initialize table of powers of 10 expressed as wide integers.
+ */
+
+ maxpow10_wide = (int)
+ floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
+ pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
+ u = 1;
+ for (i = 0; i < maxpow10_wide; ++i) {
+ pow10_wide[i] = u;
+ u *= 10;
+ }
+ pow10_wide[i] = u;
+
+ /*
+ * 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) {
Tcl_Panic("This code doesn't work on a decimal machine!");
}
- --log2FLT_RADIX;
+ log2FLT_RADIX--;
mantBits = DBL_MANT_DIG * log2FLT_RADIX;
d = 1.0;
+
+ /*
+ * 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));
if (x < MAXPOW) {
mmaxpow = x;
@@ -1153,22 +4391,58 @@ TclInitDoubleConversion(void)
mmaxpow = MAXPOW;
}
for (i=0 ; i<=mmaxpow ; ++i) {
- pow10[i] = d;
+ pow10vals[i] = d;
d *= 10.0;
}
- for (i=0 ; i<9 ; ++i) {
+
+ /*
+ * Initialize a table of large powers of five.
+ */
+
+ for (i=0; i<9; ++i) {
mp_init(pow5 + i);
}
mp_set(pow5, 5);
- for (i=0 ; i<8 ; ++i) {
+ for (i=0; i<8; ++i) {
mp_sqr(pow5+i, pow5+i+1);
}
- tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
- maxDigits = (int)
- ((DBL_MAX_EXP * log((double) FLT_RADIX) + log(10.)/2) / log(10.));
- minDigits = (int)
- floor((DBL_MIN_EXP-DBL_MANT_DIG)*log((double)FLT_RADIX)/log(10.));
- mantDIGIT = (mantBits + DIGIT_BIT - 1) / DIGIT_BIT;
+ 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
+ * decimal point in the largest and smallest double, the smallest double
+ * that differs from zero, and the number of mp_digits needed to represent
+ * the significand of a double.
+ */
+
+ maxDigits = (int) ((DBL_MAX_EXP * log((double) FLT_RADIX)
+ + 0.5 * log(10.)) / log(10.));
+ minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG)
+ * log((double) FLT_RADIX) / log(10.));
+ log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.));
+
+ /*
+ * Nokia 770's software-emulated floating point is "middle endian": the
+ * bytes within a 32-bit word are little-endian (like the native
+ * integers), but the two words of a 'double' are presented most
+ * significant word first.
+ */
+
+#ifdef IEEE_FLOATING_POINT
+ bitwhack.dv = 1.000000238418579;
+ /* 3ff0 0000 4000 0000 */
+ if ((bitwhack.iv >> 32) == 0x3ff00000) {
+ n770_fp = 0;
+ } else if ((bitwhack.iv & 0xffffffff) == 0x3ff00000) {
+ n770_fp = 1;
+ } else {
+ Tcl_Panic("unknown floating point word order on this machine");
+ }
+#endif
}
/*
@@ -1188,12 +4462,76 @@ TclInitDoubleConversion(void)
*/
void
-TclFinalizeDoubleConversion()
+TclFinalizeDoubleConversion(void)
{
int i;
- for (i=0 ; i<9 ; ++i) {
+
+ ckfree(pow10_wide);
+ for (i=0; i<9; ++i) {
mp_clear(pow5 + i);
}
+ for (i=0; i < 5; ++i) {
+ mp_clear(pow5_13 + i);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitBignumFromDouble --
+ *
+ * Extracts the integer part of a double and converts it to an arbitrary
+ * precision integer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Initializes the bignum supplied, and stores the converted number in
+ * it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InitBignumFromDouble(
+ Tcl_Interp *interp, /* For error message. */
+ double d, /* Number to convert. */
+ mp_int *b) /* Place to store the result. */
+{
+ double fract;
+ int expt;
+
+ /*
+ * Infinite values can't convert to bignum.
+ */
+
+ if (TclIsInfinite(d)) {
+ if (interp != NULL) {
+ const char *s = "integer value too large to represent";
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ fract = frexp(d,&expt);
+ if (expt <= 0) {
+ mp_init(b);
+ mp_zero(b);
+ } else {
+ Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
+ int shift = expt - mantBits;
+
+ TclBNInitBignumFromWideInt(b, w);
+ if (shift < 0) {
+ mp_div_2d(b, -shift, b, NULL);
+ } else if (shift > 0) {
+ mp_mul_2d(b, shift, b);
+ }
+ }
+ return TCL_OK;
}
/*
@@ -1205,42 +4543,83 @@ TclFinalizeDoubleConversion()
* number.
*
* Results:
- * Returns the converted number. Sets errno to ERANGE if the number is
+ * Returns the converted number. Sets errno to ERANGE if the number is
* too large to convert.
*
*----------------------------------------------------------------------
*/
double
-TclBignumToDouble(mp_int *a) /* Integer to convert. */
+TclBignumToDouble(
+ const mp_int *a) /* Integer to convert. */
{
mp_int b;
- int bits;
- int shift;
- int 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);
if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
errno = ERANGE;
- return HUGE_VAL;
+ if (a->sign == MP_ZPOS) {
+ return HUGE_VAL;
+ } else {
+ 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.
@@ -1272,6 +4651,241 @@ TclBignumToDouble(mp_int *a) /* Integer to convert. */
/*
*----------------------------------------------------------------------
*
+ * TclCeil --
+ *
+ * Computes the smallest floating point number that is at least the
+ * mp_int argument.
+ *
+ * Results:
+ * Returns the floating point number.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclCeil(
+ const mp_int *a) /* Integer to convert. */
+{
+ double r = 0.0;
+ mp_int b;
+
+ mp_init(&b);
+ if (mp_cmp_d(a, 0) == MP_LT) {
+ mp_neg(a, &b);
+ r = -TclFloor(&b);
+ } else {
+ int bits = mp_count_bits(a);
+
+ if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
+ r = HUGE_VAL;
+ } else {
+ int i, exact = 1, shift = mantBits - bits;
+
+ if (shift > 0) {
+ mp_mul_2d(a, shift, &b);
+ } else if (shift < 0) {
+ mp_int d;
+ mp_init(&d);
+ mp_div_2d(a, -shift, &b, &d);
+ exact = mp_iszero(&d);
+ mp_clear(&d);
+ } else {
+ mp_copy(a, &b);
+ }
+ if (!exact) {
+ mp_add_d(&b, 1, &b);
+ }
+ for (i=b.used-1 ; i>=0 ; --i) {
+ r = ldexp(r, DIGIT_BIT) + b.dp[i];
+ }
+ r = ldexp(r, bits - mantBits);
+ }
+ }
+ 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(
+ const mp_int *a) /* Integer to convert. */
+{
+ double r = 0.0;
+ mp_int b;
+
+ mp_init(&b);
+ if (mp_cmp_d(a, 0) == MP_LT) {
+ mp_neg(a, &b);
+ r = -TclCeil(&b);
+ } else {
+ int bits = mp_count_bits(a);
+
+ if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
+ r = DBL_MAX;
+ } else {
+ int i, shift = mantBits - bits;
+
+ 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);
+ }
+ for (i=b.used-1 ; i>=0 ; --i) {
+ r = ldexp(r, DIGIT_BIT) + b.dp[i];
+ }
+ r = ldexp(r, bits - mantBits);
+ }
+ }
+ mp_clear(&b);
+ return r;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BignumToBiasedFrExp --
+ *
+ * Convert an arbitrary-precision integer to a native floating point
+ * number in the range [0.5,1) times a power of two. NOTE: Intentionally
+ * converts to a number that's a few ulp too small, so that
+ * RefineApproximation will not overflow near the high end of the
+ * machine's arithmetic range.
+ *
+ * Results:
+ * Returns the converted number.
+ *
+ * Side effects:
+ * Stores the exponent of two in 'machexp'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+BignumToBiasedFrExp(
+ const mp_int *a, /* Integer to convert. */
+ int *machexp) /* Power of two. */
+{
+ mp_int b;
+ int bits;
+ int shift;
+ int i;
+ double r;
+
+ /*
+ * Determine how many bits we need, and extract that many from the input.
+ * Round to nearest unit in the last place.
+ */
+
+ bits = mp_count_bits(a);
+ shift = mantBits - 2 - bits;
+ mp_init(&b);
+ 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);
+ }
+
+ /*
+ * Accumulate the result, one mp_digit at a time.
+ */
+
+ r = 0.0;
+ for (i=b.used-1; i>=0; --i) {
+ r = ldexp(r, DIGIT_BIT) + b.dp[i];
+ }
+ mp_clear(&b);
+
+ /*
+ * Return the result with the appropriate sign.
+ */
+
+ *machexp = bits - mantBits + 2;
+ return ((a->sign == MP_ZPOS) ? r : -r);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pow10TimesFrExp --
+ *
+ * Multiply a power of ten by a number expressed as fraction and
+ * exponent.
+ *
+ * Results:
+ * Returns the significand of the result.
+ *
+ * Side effects:
+ * Overwrites the 'machexp' parameter with the exponent of the result.
+ *
+ * Assumes that 'exponent' is such that 10**exponent would be a double, even
+ * though 'fraction*10**(machexp+exponent)' might overflow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+Pow10TimesFrExp(
+ 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. */
+{
+ int i, j;
+ int expt = *machexp;
+ double retval = fraction;
+
+ if (exponent > 0) {
+ /*
+ * Multiply by 10**exponent.
+ */
+
+ retval = frexp(retval * pow10vals[exponent&0xf], &j);
+ expt += j;
+ for (i=4; i<9; ++i) {
+ if (exponent & (1<<i)) {
+ retval = frexp(retval * pow_10_2_n[i], &j);
+ expt += j;
+ }
+ }
+ } else if (exponent < 0) {
+ /*
+ * Divide by 10**-exponent.
+ */
+
+ retval = frexp(retval / pow10vals[(-exponent) & 0xf], &j);
+ expt += j;
+ for (i=4; i<9; ++i) {
+ if ((-exponent) & (1<<i)) {
+ retval = frexp(retval / pow_10_2_n[i], &j);
+ expt += j;
+ }
+ }
+ }
+
+ *machexp = expt;
+ return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SafeLdExp --
*
* Do an 'ldexp' operation, but handle denormals gracefully.
@@ -1288,10 +4902,13 @@ TclBignumToDouble(mp_int *a) /* Integer to convert. */
*/
static double
-SafeLdExp(double fract, int expt)
+SafeLdExp(
+ double fract,
+ int expt)
{
int minexpt = DBL_MIN_EXP * log2FLT_RADIX;
volatile double a, b, retval;
+
if (expt < minexpt) {
a = ldexp(fract, expt - mantBits - minexpt);
b = ldexp(1.0, mantBits + minexpt);
@@ -1320,8 +4937,9 @@ SafeLdExp(double fract, int expt)
*/
void
-TclFormatNaN(double value, /* The Not-a-Number to format. */
- char *buffer) /* String representation. */
+TclFormatNaN(
+ double value, /* The Not-a-Number to format. */
+ char *buffer) /* String representation. */
{
#ifndef IEEE_FLOATING_POINT
strcpy(buffer, "NaN");
@@ -1333,6 +4951,9 @@ TclFormatNaN(double value, /* The Not-a-Number to format. */
} bitwhack;
bitwhack.dv = value;
+ if (n770_fp) {
+ bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+ }
if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
bitwhack.iv &= ~ ((Tcl_WideUInt) 1 << 63);
*buffer++ = '-';
@@ -1348,3 +4969,47 @@ TclFormatNaN(double value, /* The Not-a-Number to format. */
}
#endif /* IEEE_FLOATING_POINT */
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Nokia770Twiddle --
+ *
+ * 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. */
+{
+ return (((w >> 32) & 0xffffffff) | (w << 32));
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNokia770Doubles --
+ *
+ * Transpose the two words of a number for Nokia 770 floating point
+ * handling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNokia770Doubles(void)
+{
+ return n770_fp;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index d5dedc2..dffa38c 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -32,45 +32,57 @@
*
* 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.48 2005/09/15 16:58:24 dgp Exp $ */
+ */
#include "tclInt.h"
+#include "tommath.h"
+
+/*
+ * 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
+ * post-8.6 development begins.
+ */
+
+#define COMPAT 0
/*
* Prototypes for functions defined later in this file:
*/
-static void AppendUnicodeToUnicodeRep _ANSI_ARGS_((
- Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
- int appendNumChars));
-static void AppendUnicodeToUtfRep _ANSI_ARGS_((
- Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
- int numChars));
-static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- CONST char *bytes, int numBytes));
-static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- CONST char *bytes, int numBytes));
-static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, CONST char *format,
- va_list argList));
-static int ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, CONST char *format,
- va_list argList));
-static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void AppendPrintfToObjVA(Tcl_Obj *objPtr,
+ const char *format, va_list argList);
+static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int appendNumChars);
+static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int numChars);
+static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
+ const char *bytes, int numBytes);
+static void AppendUtfToUtfRep(Tcl_Obj *objPtr,
+ const char *bytes, int numBytes);
+static void DupStringInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int numChars);
+static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
+ const char *bytes, int numBytes,
+ int numAppendChars);
+static void FillUnicodeRep(Tcl_Obj *objPtr);
+static void FreeStringInternalRep(Tcl_Obj *objPtr);
+static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
+static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
+static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void SetUnicodeObj(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, int numChars);
+static int UnicodeLength(const Tcl_UniChar *unicode);
+static void UpdateStringOfString(Tcl_Obj *objPtr);
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
*/
-Tcl_ObjType tclStringType = {
+const Tcl_ObjType tclStringType = {
"string", /* name */
FreeStringInternalRep, /* freeIntRepPro */
DupStringInternalRep, /* dupIntRepProc */
@@ -98,28 +110,40 @@ typedef struct String {
* means that there is a valid Unicode rep, or
* that the number of UTF bytes == the number
* of chars. */
- size_t allocated; /* The amount of space actually allocated for
+ int allocated; /* The amount of space actually allocated for
* the UTF string (minus 1 byte for the
* termination char). */
- size_t uallocated; /* The amount of space actually allocated for
- * the Unicode string (minus 2 bytes for the
- * termination char). */
+ int maxChars; /* Max number of chars that can fit in the
+ * space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
- Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual size
- * of this field depends on the 'uallocated'
+ Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
+ * of this field depends on the 'maxChars'
* field above. */
} String;
-#define STRING_UALLOC(numChars) \
- (numChars * sizeof(Tcl_UniChar))
-#define STRING_SIZE(ualloc) \
- ((unsigned) (sizeof(String) - sizeof(Tcl_UniChar) + ualloc))
+#define STRING_MAXCHARS \
+ (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
+#define STRING_SIZE(numChars) \
+ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+#define stringCheckLimits(numChars) \
+ if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
+ 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((ptr), (unsigned) STRING_SIZE(numChars) )
+#define stringAttemptRealloc(ptr, numChars) \
+ (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \
- ((String *) (objPtr)->internalRep.otherValuePtr)
+ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
- ((objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr))
-
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+
/*
* TCL STRING GROWTH ALGORITHM
*
@@ -128,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
@@ -142,21 +165,124 @@ 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
+GrowStringBuffer(
+ Tcl_Obj *objPtr,
+ int needed,
+ int flag)
+{
+ /*
+ * Pre-conditions:
+ * objPtr->typePtr == &tclStringType
+ * needed > stringPtr->allocated
+ * flag || objPtr->bytes != NULL
+ */
+
+ String *stringPtr = GET_STRING(objPtr);
+ char *ptr = NULL;
+ int attempt;
+
+ if (objPtr->bytes == tclEmptyStringRep) {
+ objPtr->bytes = NULL;
+ }
+ if (flag == 0 || stringPtr->allocated > 0) {
+ attempt = 2 * needed;
+ if (attempt >= 0) {
+ 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_MIN_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ attempt = needed + growth;
+ ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
+ }
+ }
+ if (ptr == NULL) {
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
+ attempt = needed;
+ ptr = ckrealloc(objPtr->bytes, attempt + 1);
+ }
+ objPtr->bytes = ptr;
+ stringPtr->allocated = attempt;
+}
+
+static void
+GrowUnicodeBuffer(
+ Tcl_Obj *objPtr,
+ int needed)
+{
+ /*
+ * 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.
+ */
+
+ attempt = 2 * needed;
+ if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
+ ptr = stringAttemptRealloc(stringPtr, attempt);
+ }
+ if (ptr == NULL) {
+ /*
+ * 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_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.
+ */
+
+ attempt = needed;
+ ptr = stringRealloc(stringPtr, attempt);
+ }
+ stringPtr = ptr;
+ stringPtr->maxChars = attempt;
+ SET_STRING(objPtr, stringPtr);
+}
/*
*----------------------------------------------------------------------
@@ -176,9 +302,9 @@ typedef struct String {
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
- * bytes up to the first NULL byte; i.e., assume "bytes" points to a
- * C-style NULL-terminated string. The object's type is set to NULL. An
- * extra NULL is added to the end of the new object's byte array.
+ * bytes up to the first NUL byte; i.e., assume "bytes" points to a
+ * C-style NUL-terminated string. The object's type is set to NULL. An
+ * extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
@@ -186,27 +312,27 @@ typedef struct String {
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
-Tcl_NewStringObj(bytes, length)
- CONST char *bytes; /* Points to the first of the length bytes
+Tcl_NewStringObj(
+ const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- int length; /* The number of bytes to copy from "bytes"
+ int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
- * negative, use bytes up to the first NULL
+ * negative, use bytes up to the first NUL
* byte. */
{
return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewStringObj(bytes, length)
- CONST char *bytes; /* Points to the first of the length bytes
+Tcl_NewStringObj(
+ const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- int length; /* The number of bytes to copy from "bytes"
+ int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
- * negative, use bytes up to the first NULL
+ * negative, use bytes up to the first NUL
* byte. */
{
- register Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
@@ -238,28 +364,28 @@ Tcl_NewStringObj(bytes, length)
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
- * bytes up to the first NULL byte; i.e., assume "bytes" points to a
- * C-style NULL-terminated string. The object's type is set to NULL. An
- * extra NULL is added to the end of the new object's byte array.
+ * bytes up to the first NUL byte; i.e., assume "bytes" points to a
+ * C-style NUL-terminated string. The object's type is set to NULL. An
+ * extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
- CONST char *bytes; /* Points to the first of the length bytes
+Tcl_DbNewStringObj(
+ const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- int length; /* The number of bytes to copy from "bytes"
+ int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
- * negative, use bytes up to the first NULL
+ * negative, use bytes up to the first NUL
* byte. */
- CONST char *file; /* The name of the source file calling this
+ const char *file, /* The name of the source file calling this
* function; used for debugging. */
- int line; /* Line number in the source file; used for
+ int line) /* Line number in the source file; used for
* debugging. */
{
- register Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
@@ -270,16 +396,16 @@ Tcl_DbNewStringObj(bytes, length, file, line)
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
- CONST char *bytes; /* Points to the first of the length bytes
+Tcl_DbNewStringObj(
+ const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- register int length; /* The number of bytes to copy from "bytes"
+ int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
- * negative, use bytes up to the first NULL
+ * negative, use bytes up to the first NUL
* byte. */
- CONST char *file; /* The name of the source file calling this
+ const char *file, /* The name of the source file calling this
* function; used for debugging. */
- int line; /* Line number in the source file; used for
+ int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewStringObj(bytes, length);
@@ -292,7 +418,7 @@ Tcl_DbNewStringObj(bytes, length, file, line)
* Tcl_NewUnicodeObj --
*
* This function is creates a new String object and initializes it from
- * the given Unicode String. If the Utf String is the same size as the
+ * the given Unicode String. If the Utf String is the same size as the
* Unicode string, don't duplicate the data.
*
* Results:
@@ -306,42 +432,16 @@ Tcl_DbNewStringObj(bytes, length, file, line)
*/
Tcl_Obj *
-Tcl_NewUnicodeObj(unicode, numChars)
- CONST Tcl_UniChar *unicode; /* The unicode string used to initialize the
+Tcl_NewUnicodeObj(
+ const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
- int numChars; /* Number of characters in the unicode
+ int numChars) /* Number of characters in the unicode
* string. */
{
Tcl_Obj *objPtr;
- String *stringPtr;
- size_t uallocated;
-
- if (numChars < 0) {
- numChars = 0;
- if (unicode) {
- while (unicode[numChars] != 0) {
- numChars++;
- }
- }
- }
- uallocated = STRING_UALLOC(numChars);
-
- /*
- * Create a new obj with an invalid string rep.
- */
TclNewObj(objPtr);
- Tcl_InvalidateStringRep(objPtr);
- objPtr->typePtr = &tclStringType;
-
- stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
- stringPtr->numChars = numChars;
- stringPtr->uallocated = uallocated;
- stringPtr->hasUnicode = (numChars > 0);
- stringPtr->allocated = 0;
- memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
- stringPtr->unicode[numChars] = 0;
- SET_STRING(objPtr, stringPtr);
+ SetUnicodeObj(objPtr, unicode, numChars);
return objPtr;
}
@@ -363,67 +463,55 @@ Tcl_NewUnicodeObj(unicode, numChars)
*/
int
-Tcl_GetCharLength(objPtr)
- Tcl_Obj *objPtr; /* The String object to get the num chars
+Tcl_GetCharLength(
+ Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
String *stringPtr;
-
- SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ int numChars;
/*
- * If numChars is unknown, then calculate the number of characaters while
- * populating the Unicode string.
+ * Optimize the case where we're really dealing with a bytearray object
+ * without string representation; we don't need to convert to a string to
+ * perform the get-length operation.
*/
- if (stringPtr->numChars == -1) {
- register int i = objPtr->length;
- register unsigned char *str = (unsigned char *) objPtr->bytes;
+ if (TclIsPureByteArray(objPtr)) {
+ int length;
- /*
- * This is a speed sensitive function, so run specially over the
- * string to count continuous ascii characters before resorting to the
- * Tcl_NumUtfChars call. This is a long form of:
- stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes,objPtr->length);
- */
+ (void) Tcl_GetByteArrayFromObj(objPtr, &length);
+ return length;
+ }
- while (i && (*str < 0xC0)) {
- i--;
- str++;
- }
- stringPtr->numChars = objPtr->length - i;
- if (i) {
- stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
- + (objPtr->length - i), i);
- }
+ /*
+ * OK, need to work with the object as a string.
+ */
- if (stringPtr->numChars == objPtr->length) {
- /*
- * Since we've just calculated the number of chars, and all UTF
- * chars are 1-byte long, we don't need to store the unicode
- * string.
- */
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+ numChars = stringPtr->numChars;
- stringPtr->hasUnicode = 0;
- } else {
- /*
- * Since we've just calucalated the number of chars, and not all
- * UTF chars are 1-byte long, go ahead and populate the unicode
- * string.
- */
+ /*
+ * If numChars is unknown, compute it.
+ */
- FillUnicodeRep(objPtr);
+ if (numChars == -1) {
+ TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
+ stringPtr->numChars = numChars;
+#if COMPAT
+ if (numChars < objPtr->length) {
/*
- * We need to fetch the pointer again because we have just
- * reallocated the structure to make room for the Unicode data.
+ * 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.
*/
- stringPtr = GET_STRING(objPtr);
+ FillUnicodeRep(objPtr);
}
+#endif
}
- return stringPtr->numChars;
+ return numChars;
}
/*
@@ -444,44 +532,47 @@ Tcl_GetCharLength(objPtr)
*/
Tcl_UniChar
-Tcl_GetUniChar(objPtr, index)
- Tcl_Obj *objPtr; /* The object to get the Unicode charater
+Tcl_GetUniChar(
+ Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
- int index; /* Get the index'th Unicode character. */
+ int index) /* Get the index'th Unicode character. */
{
- Tcl_UniChar unichar;
String *stringPtr;
- SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ /*
+ * Optimize the case where we're really dealing with a bytearray object
+ * without string representation; we don't need to convert to a string to
+ * perform the indexing operation.
+ */
- if (stringPtr->numChars == -1) {
- /*
- * We haven't yet calculated the length, so we don't have the Unicode
- * str. We need to know the number of chars before we can do indexing.
- */
+ if (TclIsPureByteArray(objPtr)) {
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
- Tcl_GetCharLength(objPtr);
+ return (Tcl_UniChar) bytes[index];
+ }
- /*
- * We need to fetch the pointer again because we may have just
- * reallocated the structure.
- */
+ /*
+ * OK, need to work with the object as a string.
+ */
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
- stringPtr = GET_STRING(objPtr);
- }
if (stringPtr->hasUnicode == 0) {
/*
- * All of the characters in the Utf string are 1 byte chars, so we
- * don't store the unicode char. We get the Utf string and convert the
- * index'th byte to a Unicode character.
+ * If numChars is unknown, compute it.
*/
- unichar = (Tcl_UniChar) objPtr->bytes[index];
- } else {
- unichar = stringPtr->unicode[index];
+ if (stringPtr->numChars == -1) {
+ TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
+ }
+ if (stringPtr->numChars == objPtr->length) {
+ return (Tcl_UniChar) objPtr->bytes[index];
+ }
+ FillUnicodeRep(objPtr);
+ stringPtr = GET_STRING(objPtr);
}
- return unichar;
+ return stringPtr->unicode[index];
}
/*
@@ -504,34 +595,11 @@ Tcl_GetUniChar(objPtr, index)
*/
Tcl_UniChar *
-Tcl_GetUnicode(objPtr)
- Tcl_Obj *objPtr; /* The object to find the unicode string
+Tcl_GetUnicode(
+ Tcl_Obj *objPtr) /* The object to find the unicode string
* for. */
{
- String *stringPtr;
-
- SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
-
- if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
- /*
- * We haven't yet calculated the length, or all of the characters in
- * the Utf string are 1 byte chars (so we didn't store the unicode
- * str). Since this function must return a unicode string, and one has
- * not yet been stored, force the Unicode to be calculated and stored
- * now.
- */
-
- FillUnicodeRep(objPtr);
-
- /*
- * We need to fetch the pointer again because we have just reallocated
- * the structure to make room for the Unicode data.
- */
-
- stringPtr = GET_STRING(objPtr);
- }
- return stringPtr->unicode;
+ return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
/*
@@ -554,10 +622,10 @@ Tcl_GetUnicode(objPtr)
*/
Tcl_UniChar *
-Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
- Tcl_Obj *objPtr; /* The object to find the unicode string
+Tcl_GetUnicodeFromObj(
+ Tcl_Obj *objPtr, /* The object to find the unicode string
* for. */
- int *lengthPtr; /* If non-NULL, the location where the string
+ int *lengthPtr) /* If non-NULL, the location where the string
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
@@ -566,22 +634,8 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
- if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
- /*
- * We haven't yet calculated the length, or all of the characters in
- * the Utf string are 1 byte chars (so we didn't store the unicode
- * str). Since this function must return a unicode string, and one has
- * not yet been stored, force the Unicode to be calculated and stored
- * now.
- */
-
+ if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
-
- /*
- * We need to fetch the pointer again because we have just reallocated
- * the structure to make room for the Unicode data.
- */
-
stringPtr = GET_STRING(objPtr);
}
@@ -611,57 +665,58 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
*/
Tcl_Obj *
-Tcl_GetRange(objPtr, first, last)
- Tcl_Obj *objPtr; /* The Tcl object to find the range of. */
- int first; /* First index of the range. */
- int last; /* Last index of the range. */
+Tcl_GetRange(
+ Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
+ int first, /* First index of the range. */
+ int last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
- SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
-
- if (stringPtr->numChars == -1) {
- /*
- * We haven't yet calculated the length, so we don't have the Unicode
- * str. We need to know the number of chars before we can do indexing.
- */
+ /*
+ * Optimize the case where we're really dealing with a bytearray object
+ * without string representation; we don't need to convert to a string to
+ * perform the substring operation.
+ */
- Tcl_GetCharLength(objPtr);
+ if (TclIsPureByteArray(objPtr)) {
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
- /*
- * We need to fetch the pointer again because we may have just
- * reallocated the structure.
- */
-
- stringPtr = GET_STRING(objPtr);
+ return Tcl_NewByteArrayObj(bytes+first, last-first+1);
}
- if (stringPtr->numChars == objPtr->length) {
- char *str = Tcl_GetString(objPtr);
+ /*
+ * OK, need to work with the object as a string.
+ */
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (stringPtr->hasUnicode == 0) {
/*
- * All of the characters in the Utf string are 1 byte chars, so we
- * don't store the unicode char. Create a new string object containing
- * the specified range of chars.
+ * If numChars is unknown, compute it.
*/
- newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
+ 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 new string only has 1-byte chars, we can set it's
- * numChars field.
- */
+ /*
+ * Since we know the char length of the result, store it.
+ */
- SetStringFromAny(NULL, newObjPtr);
- stringPtr = GET_STRING(newObjPtr);
- stringPtr->numChars = last-first+1;
- } else {
- newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
- last-first+1);
+ SetStringFromAny(NULL, newObjPtr);
+ stringPtr = GET_STRING(newObjPtr);
+ stringPtr->numChars = newObjPtr->length;
+ return newObjPtr;
+ }
+ FillUnicodeRep(objPtr);
+ stringPtr = GET_STRING(objPtr);
}
- return newObjPtr;
+
+ return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
/*
@@ -678,29 +733,24 @@ Tcl_GetRange(objPtr, first, last)
* Side effects:
* The object's string representation will be set to a copy of the
* "length" bytes starting at "bytes". If "length" is negative, use bytes
- * up to the first NULL byte; i.e., assume "bytes" points to a C-style
- * NULL-terminated string. The object's old string and internal
+ * up to the first NUL byte; i.e., assume "bytes" points to a C-style
+ * NUL-terminated string. The object's old string and internal
* representations are freed and the object's type is set NULL.
*
*----------------------------------------------------------------------
*/
void
-Tcl_SetStringObj(objPtr, bytes, length)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- CONST char *bytes; /* Points to the first of the length bytes
+Tcl_SetStringObj(
+ Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
- register int length; /* The number of bytes to copy from "bytes"
+ int length) /* The number of bytes to copy from "bytes"
* when initializing the object. If negative,
- * use bytes up to the first NULL byte.*/
+ * use bytes up to the first NUL byte.*/
{
- /*
- * Free any old string rep, then set the string rep to a copy of the
- * length bytes starting at "bytes".
- */
-
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetStringObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
@@ -708,9 +758,13 @@ Tcl_SetStringObj(objPtr, bytes, length)
*/
TclFreeIntRep(objPtr);
- objPtr->typePtr = NULL;
- Tcl_InvalidateStringRep(objPtr);
+ /*
+ * Free any old string rep, then set the string rep to a copy of the
+ * length bytes starting at "bytes".
+ */
+
+ TclInvalidateStringRep(objPtr);
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
@@ -741,65 +795,53 @@ Tcl_SetStringObj(objPtr, bytes, length)
*/
void
-Tcl_SetObjLength(objPtr, length)
- register Tcl_Obj *objPtr; /* Pointer to object. This object must not
+Tcl_SetObjLength(
+ Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
- register int length; /* Number of bytes desired for string
+ int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
+ if (length < 0) {
+ /*
+ * Setting to a negative length is nonsense. This is probably the
+ * result of overflowing the signed integer range.
+ */
+
+ Tcl_Panic("Tcl_SetObjLength: negative length requested: "
+ "%d (integer overflow?)", length);
+ }
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_SetObjLength called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
}
- SetStringFromAny(NULL, objPtr);
-
- stringPtr = GET_STRING(objPtr);
- /*
- * Check that we're not extending a pure unicode string.
- */
+ if (objPtr->bytes && objPtr->length == length) {
+ return;
+ }
- if (length > (int) stringPtr->allocated &&
- (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
- char *new;
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+ if (objPtr->bytes != NULL) {
/*
- * Not enough space in current string. Reallocate the string space and
- * free the old string.
+ * Change length of an existing string rep.
*/
-
- if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
- new = (char *) ckrealloc((char *)objPtr->bytes,
- (unsigned)(length+1));
- } else {
- new = (char *) ckalloc((unsigned) (length+1));
- if (objPtr->bytes != NULL && objPtr->length != 0) {
- memcpy((VOID *) new, (VOID *) objPtr->bytes,
- (size_t) objPtr->length);
- Tcl_InvalidateStringRep(objPtr);
+ if (length > stringPtr->allocated) {
+ /*
+ * Need to enlarge the buffer.
+ */
+ if (objPtr->bytes == tclEmptyStringRep) {
+ objPtr->bytes = ckalloc(length + 1);
+ } else {
+ objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
}
+ stringPtr->allocated = length;
}
- objPtr->bytes = new;
- stringPtr->allocated = length;
- /*
- * Invalidate the unicode data.
- */
-
- stringPtr->hasUnicode = 0;
- }
-
- if (objPtr->bytes != NULL) {
objPtr->length = length;
- if (objPtr->bytes != tclEmptyStringRep) {
- /*
- * Ensure the string is NULL-terminated.
- */
-
- objPtr->bytes[length] = 0;
- }
+ objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
@@ -812,24 +854,25 @@ Tcl_SetObjLength(objPtr, length)
* Changing length of pure unicode string.
*/
- size_t uallocated = STRING_UALLOC(length);
-
- if (uallocated > stringPtr->uallocated) {
- stringPtr = (String *) ckrealloc((char*) stringPtr,
- STRING_SIZE(uallocated));
+ stringCheckLimits(length);
+ if (length > stringPtr->maxChars) {
+ stringPtr = stringRealloc(stringPtr, length);
SET_STRING(objPtr, stringPtr);
- stringPtr->uallocated = uallocated;
+ stringPtr->maxChars = length;
}
- stringPtr->numChars = length;
- stringPtr->hasUnicode = (length > 0);
/*
- * Ensure the string is NULL-terminated.
+ * Mark the new end of the unicode string
*/
+ stringPtr->numChars = length;
stringPtr->unicode[length] = 0;
- stringPtr->allocated = 0;
- objPtr->length = 0;
+ stringPtr->hasUnicode = 1;
+
+ /*
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
+ */
}
}
@@ -857,71 +900,58 @@ Tcl_SetObjLength(objPtr, length)
*/
int
-Tcl_AttemptSetObjLength(objPtr, length)
- register Tcl_Obj *objPtr; /* Pointer to object. This object must not
+Tcl_AttemptSetObjLength(
+ Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
- register int length; /* Number of bytes desired for string
+ int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
+ if (length < 0) {
+ /*
+ * Setting to a negative length is nonsense. This is probably the
+ * result of overflowing the signed integer range.
+ */
+
+ return 0;
+ }
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_AttemptSetObjLength called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
+ }
+ if (objPtr->bytes && objPtr->length == length) {
+ return 1;
}
- SetStringFromAny(NULL, objPtr);
+ SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
- /*
- * Check that we're not extending a pure unicode string.
- */
-
- if (length > (int) stringPtr->allocated &&
- (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
- char *new;
-
+ if (objPtr->bytes != NULL) {
/*
- * Not enough space in current string. Reallocate the string space and
- * free the old string.
+ * Change length of an existing string rep.
*/
+ if (length > stringPtr->allocated) {
+ /*
+ * Need to enlarge the buffer.
+ */
- if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
- new = (char *) attemptckrealloc((char *)objPtr->bytes,
- (unsigned)(length+1));
- if (new == NULL) {
- return 0;
+ char *newBytes;
+
+ if (objPtr->bytes == tclEmptyStringRep) {
+ newBytes = attemptckalloc(length + 1);
+ } else {
+ newBytes = attemptckrealloc(objPtr->bytes, length + 1);
}
- } else {
- new = (char *) attemptckalloc((unsigned) (length+1));
- if (new == NULL) {
+ if (newBytes == NULL) {
return 0;
}
- if (objPtr->bytes != NULL && objPtr->length != 0) {
- memcpy((VOID *) new, (VOID *) objPtr->bytes,
- (size_t) objPtr->length);
- Tcl_InvalidateStringRep(objPtr);
- }
+ objPtr->bytes = newBytes;
+ stringPtr->allocated = length;
}
- objPtr->bytes = new;
- stringPtr->allocated = length;
-
- /*
- * Invalidate the unicode data.
- */
- stringPtr->hasUnicode = 0;
- }
-
- if (objPtr->bytes != NULL) {
objPtr->length = length;
- if (objPtr->bytes != tclEmptyStringRep) {
- /*
- * Ensure the string is NULL-terminated.
- */
-
- objPtr->bytes[length] = 0;
- }
+ objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
@@ -934,27 +964,30 @@ Tcl_AttemptSetObjLength(objPtr, length)
* Changing length of pure unicode string.
*/
- size_t uallocated = STRING_UALLOC(length);
-
- if (uallocated > stringPtr->uallocated) {
- stringPtr = (String *) attemptckrealloc((char*) stringPtr,
- STRING_SIZE(uallocated));
+ if (length > STRING_MAXCHARS) {
+ return 0;
+ }
+ if (length > stringPtr->maxChars) {
+ stringPtr = stringAttemptRealloc(stringPtr, length);
if (stringPtr == NULL) {
return 0;
}
SET_STRING(objPtr, stringPtr);
- stringPtr->uallocated = uallocated;
+ stringPtr->maxChars = length;
}
- stringPtr->numChars = length;
- stringPtr->hasUnicode = (length > 0);
/*
- * Ensure the string is NULL-terminated.
+ * Mark the new end of the unicode string.
*/
stringPtr->unicode[length] = 0;
- stringPtr->allocated = 0;
- objPtr->length = 0;
+ stringPtr->numChars = length;
+ stringPtr->hasUnicode = 1;
+
+ /*
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
+ */
}
return 1;
}
@@ -962,7 +995,7 @@ Tcl_AttemptSetObjLength(objPtr, length)
/*
*---------------------------------------------------------------------------
*
- * TclSetUnicodeObj --
+ * Tcl_SetUnicodeObj --
*
* Modify an object to hold the Unicode string indicated by "unicode".
*
@@ -976,54 +1009,72 @@ Tcl_AttemptSetObjLength(objPtr, length)
*/
void
-Tcl_SetUnicodeObj(objPtr, unicode, numChars)
- Tcl_Obj *objPtr; /* The object to set the string of. */
- CONST Tcl_UniChar *unicode; /* The unicode string used to initialize the
+Tcl_SetUnicodeObj(
+ Tcl_Obj *objPtr, /* The object to set the string of. */
+ const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
- int numChars; /* Number of characters in the unicode
+ int numChars) /* Number of characters in the unicode
* string. */
{
- String *stringPtr;
- size_t uallocated;
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
+ }
+ TclFreeIntRep(objPtr);
+ SetUnicodeObj(objPtr, unicode, numChars);
+}
- if (numChars < 0) {
- numChars = 0;
- if (unicode) {
- while (unicode[numChars] != 0) {
- numChars++;
- }
+static int
+UnicodeLength(
+ const Tcl_UniChar *unicode)
+{
+ int numChars = 0;
+
+ if (unicode) {
+ while (numChars >= 0 && unicode[numChars] != 0) {
+ numChars++;
}
}
- uallocated = STRING_UALLOC(numChars);
+ stringCheckLimits(numChars);
+ return numChars;
+}
- /*
- * Free the internal rep if one exists, and invalidate the string rep.
- */
+static void
+SetUnicodeObj(
+ Tcl_Obj *objPtr, /* The object to set the string of. */
+ const Tcl_UniChar *unicode, /* The unicode string used to initialize the
+ * object. */
+ int numChars) /* Number of characters in the unicode
+ * string. */
+{
+ String *stringPtr;
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &tclStringType;
+ if (numChars < 0) {
+ numChars = UnicodeLength(unicode);
+ }
/*
* Allocate enough space for the String structure + Unicode string.
*/
- stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
- stringPtr->numChars = numChars;
- stringPtr->uallocated = uallocated;
- stringPtr->hasUnicode = (numChars > 0);
- stringPtr->allocated = 0;
- memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
+ stringCheckLimits(numChars);
+ stringPtr = stringAlloc(numChars);
+ SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
+
+ stringPtr->maxChars = numChars;
+ memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
+ stringPtr->numChars = numChars;
+ stringPtr->hasUnicode = 1;
- SET_STRING(objPtr, stringPtr);
- Tcl_InvalidateStringRep(objPtr);
- return;
+ TclInvalidateStringRep(objPtr);
+ stringPtr->allocated = 0;
}
/*
*----------------------------------------------------------------------
*
- * TclAppendLimitedToObj --
+ * Tcl_AppendLimitedToObj --
*
* This function appends a limited number of bytes from a sequence of
* bytes to an object, marking any limitation with an ellipsis.
@@ -1039,16 +1090,16 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
*/
void
-TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
- register Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST char *bytes; /* Points to the bytes to append to the
+Tcl_AppendLimitedToObj(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const char *bytes, /* Points to the bytes to append to the
* object. */
- register int length; /* The number of bytes available to be
+ int length, /* The number of bytes available to be
* appended from "bytes". If < 0, then all
- * bytes up to a NULL byte are available. */
- register int limit; /* The maximum number of bytes to append to
+ * bytes up to a NUL byte are available. */
+ int limit, /* The maximum number of bytes to append to
* the object. */
- CONST char *ellipsis; /* Ellipsis marker string, appended to the
+ const char *ellipsis) /* Ellipsis marker string, appended to the
* object to indicate not all available bytes
* at "bytes" were appended. */
{
@@ -1056,11 +1107,9 @@ TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
int toCopy = 0;
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("TclAppendLimitedToObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
- SetStringFromAny(NULL, objPtr);
-
if (length < 0) {
length = (bytes ? strlen(bytes) : 0);
}
@@ -1083,8 +1132,10 @@ TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
* objPtr's string rep.
*/
+ SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
- if (stringPtr->hasUnicode != 0) {
+
+ if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
@@ -1095,10 +1146,10 @@ TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
}
stringPtr = GET_STRING(objPtr);
- if (stringPtr->hasUnicode != 0) {
- AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
+ if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
+ AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
} else {
- AppendUtfToUtfRep(objPtr, ellipsis, -1);
+ AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
}
}
@@ -1120,15 +1171,15 @@ TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
*/
void
-Tcl_AppendToObj(objPtr, bytes, length)
- register Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST char *bytes; /* Points to the bytes to append to the
+Tcl_AppendToObj(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const char *bytes, /* Points to the bytes to append to the
* object. */
- register int length; /* The number of bytes to append from "bytes".
- * If < 0, then append all bytes up to NULL
+ int length) /* The number of bytes to append from "bytes".
+ * If < 0, then append all bytes up to NUL
* byte. */
{
- TclAppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
+ Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
}
/*
@@ -1149,16 +1200,16 @@ Tcl_AppendToObj(objPtr, bytes, length)
*/
void
-Tcl_AppendUnicodeToObj(objPtr, unicode, length)
- register Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST Tcl_UniChar *unicode; /* The unicode string to append to the
+Tcl_AppendUnicodeToObj(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
- int length; /* Number of chars in "unicode". */
+ int length) /* Number of chars in "unicode". */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_AppendUnicodeToObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
}
if (length == 0) {
@@ -1174,7 +1225,11 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
* objPtr's string rep.
*/
- if (stringPtr->hasUnicode != 0) {
+ if (stringPtr->hasUnicode
+#if COMPAT
+ && stringPtr->numChars > 0
+#endif
+ ) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1200,42 +1255,100 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
*/
void
-Tcl_AppendObjToObj(objPtr, appendObjPtr)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- Tcl_Obj *appendObjPtr; /* Object to append. */
+Tcl_AppendObjToObj(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
- int length, numChars, allOneByteChars;
- char *bytes;
+ int length, numChars, appendNumChars = -1;
+ 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) || objPtr->bytes == tclEmptyStringRep)
+ && TclIsPureByteArray(appendObjPtr)) {
+
+ /*
+ * You might expect the code here to be
+ *
+ * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
+ * TclAppendBytesToByteArray(objPtr, bytes, length);
+ *
+ * and essentially all of the time that would be fine. However,
+ * it would run into trouble in the case where objPtr and
+ * appendObjPtr point to the same thing. That may never be a
+ * good idea. It seems to violate Copy On Write, and we don't
+ * have any tests for the situation, since making any Tcl commands
+ * that call Tcl_AppendObjToObj() do that appears impossible
+ * (They honor Copy On Write!). For the sake of extensions that
+ * go off into that realm, though, here's a more complex approach
+ * that can handle all the cases.
+ */
+
+ /* Get lengths */
+ int lengthSrc;
+
+ (void) Tcl_GetByteArrayFromObj(objPtr, &length);
+ (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
+
+ /* Grow buffer enough for the append */
+ TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
+
+ /* Reset objPtr back to the original value */
+ Tcl_SetByteArrayLength(objPtr, length);
+
+ /*
+ * Now do the append knowing that buffer growth cannot cause
+ * any trouble.
+ */
+
+ TclAppendBytesToByteArray(objPtr,
+ Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
+ return;
+ }
+
+ /*
+ * Must append as strings.
+ */
SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
*/
- stringPtr = GET_STRING(objPtr);
- if (stringPtr->hasUnicode != 0) {
+ if (stringPtr->hasUnicode
+#if COMPAT
+ && stringPtr->numChars > 0
+#endif
+ ) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
if (appendObjPtr->typePtr == &tclStringType) {
- stringPtr = GET_STRING(appendObjPtr);
- if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
- /*
- * If appendObjPtr is a string obj with no valid Unicode rep,
- * then fill its unicode rep.
- */
+ Tcl_UniChar *unicode =
+ Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
- FillUnicodeRep(appendObjPtr);
- stringPtr = GET_STRING(appendObjPtr);
- }
- AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
- stringPtr->numChars);
+ AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
} else {
- bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+ bytes = TclGetStringFromObj(appendObjPtr, &length);
AppendUtfToUnicodeRep(objPtr, bytes, length);
}
return;
@@ -1247,23 +1360,22 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
* characters in the final (appended-to) object.
*/
- bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+ bytes = TclGetStringFromObj(appendObjPtr, &length);
- allOneByteChars = 0;
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
- stringPtr = GET_STRING(appendObjPtr);
- if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
- numChars += stringPtr->numChars;
- allOneByteChars = 1;
- }
+ String *appendStringPtr = GET_STRING(appendObjPtr);
+ appendNumChars = appendStringPtr->numChars;
}
AppendUtfToUtfRep(objPtr, bytes, length);
- if (allOneByteChars) {
- stringPtr = GET_STRING(objPtr);
- stringPtr->numChars = numChars;
+ if (numChars >= 0 && appendNumChars >= 0
+#if COMPAT
+ && appendNumChars == length
+#endif
+ ) {
+ stringPtr->numChars = numChars + appendNumChars;
}
}
@@ -1285,21 +1397,16 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
*/
static void
-AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST Tcl_UniChar *unicode; /* String to append. */
- int appendNumChars; /* Number of chars of "unicode" to append. */
+AppendUnicodeToUnicodeRep(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const Tcl_UniChar *unicode, /* String to append. */
+ int appendNumChars) /* Number of chars of "unicode" to append. */
{
- String *stringPtr, *tmpString;
- size_t numChars;
+ String *stringPtr;
+ int numChars;
if (appendNumChars < 0) {
- appendNumChars = 0;
- if (unicode) {
- while (unicode[appendNumChars] != 0) {
- appendNumChars++;
- }
- }
+ appendNumChars = UnicodeLength(unicode);
}
if (appendNumChars == 0) {
return;
@@ -1317,20 +1424,32 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
*/
numChars = stringPtr->numChars + appendNumChars;
+ 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.
+ */
- if (STRING_UALLOC(numChars) >= stringPtr->uallocated) {
- stringPtr->uallocated = STRING_UALLOC(2 * numChars);
- tmpString = (String *) attemptckrealloc((char *)stringPtr,
- STRING_SIZE(stringPtr->uallocated));
- if (tmpString == NULL) {
- stringPtr->uallocated =
- STRING_UALLOC(numChars + appendNumChars)
- + TCL_GROWTH_MIN_ALLOC;
- tmpString = (String *) ckrealloc((char *)stringPtr,
- STRING_SIZE(stringPtr->uallocated));
+ if (unicode >= stringPtr->unicode
+ && unicode <= stringPtr->unicode + stringPtr->maxChars) {
+ offset = unicode - stringPtr->unicode;
+ }
+
+ GrowUnicodeBuffer(objPtr, numChars);
+ stringPtr = GET_STRING(objPtr);
+
+ /*
+ * Relocate unicode if needed; see above.
+ */
+
+ if (offset >= 0) {
+ unicode = stringPtr->unicode + offset;
}
- stringPtr = tmpString;
- SET_STRING(objPtr, stringPtr);
}
/*
@@ -1338,12 +1457,13 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
* trailing null.
*/
- memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
+ memmove(stringPtr->unicode + stringPtr->numChars, unicode,
appendNumChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
+ stringPtr->allocated = 0;
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
}
/*
@@ -1364,30 +1484,26 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
*/
static void
-AppendUnicodeToUtfRep(objPtr, unicode, numChars)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST Tcl_UniChar *unicode; /* String to convert to UTF. */
- int numChars; /* Number of chars of "unicode" to convert. */
+AppendUnicodeToUtfRep(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const Tcl_UniChar *unicode, /* String to convert to UTF. */
+ int numChars) /* Number of chars of "unicode" to convert. */
{
- Tcl_DString dsPtr;
- CONST char *bytes;
+ String *stringPtr = GET_STRING(objPtr);
- if (numChars < 0) {
- numChars = 0;
- if (unicode) {
- while (unicode[numChars] != 0) {
- numChars++;
- }
- }
- }
- if (numChars == 0) {
- return;
+ numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
+
+ if (stringPtr->numChars != -1) {
+ stringPtr->numChars += numChars;
}
- Tcl_DStringInit(&dsPtr);
- bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
- AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
- Tcl_DStringFree(&dsPtr);
+#if COMPAT
+ /*
+ * Invalidate the unicode rep.
+ */
+
+ stringPtr->hasUnicode = 0;
+#endif
}
/*
@@ -1397,7 +1513,7 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
*
* 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.
+ * valid Unicode rep. numBytes must be non-negative.
*
* Results:
* None.
@@ -1409,27 +1525,21 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
*/
static void
-AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST char *bytes; /* String to convert to Unicode. */
- int numBytes; /* Number of bytes of "bytes" to convert. */
+AppendUtfToUnicodeRep(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const char *bytes, /* String to convert to Unicode. */
+ int numBytes) /* Number of bytes of "bytes" to convert. */
{
- Tcl_DString dsPtr;
- int numChars;
- Tcl_UniChar *unicode;
+ String *stringPtr;
- if (numBytes < 0) {
- numBytes = (bytes ? strlen(bytes) : 0);
- }
if (numBytes == 0) {
return;
}
- Tcl_DStringInit(&dsPtr);
- numChars = Tcl_NumUtfChars(bytes, numBytes);
- unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
- AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
- Tcl_DStringFree(&dsPtr);
+ ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
+ TclInvalidateStringRep(objPtr);
+ stringPtr = GET_STRING(objPtr);
+ stringPtr->allocated = 0;
}
/*
@@ -1439,6 +1549,7 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
*
* This function appends "numBytes" bytes of "bytes" to the UTF string
* rep of "objPtr". objPtr must already have a valid String rep.
+ * numBytes must be non-negative.
*
* Results:
* None.
@@ -1450,17 +1561,14 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
*/
static void
-AppendUtfToUtfRep(objPtr, bytes, numBytes)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- CONST char *bytes; /* String to append. */
- int numBytes; /* Number of bytes of "bytes" to append. */
+AppendUtfToUtfRep(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const char *bytes, /* String to append. */
+ int numBytes) /* Number of bytes of "bytes" to append. */
{
String *stringPtr;
int newLength, oldLength;
- if (numBytes < 0) {
- numBytes = (bytes ? strlen(bytes) : 0);
- }
if (numBytes == 0) {
return;
}
@@ -1470,22 +1578,43 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
* trailing null.
*/
+ if (objPtr->bytes == NULL) {
+ objPtr->length = 0;
+ }
oldLength = objPtr->length;
newLength = numBytes + oldLength;
+ if (newLength < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
stringPtr = GET_STRING(objPtr);
- if (newLength > (int) stringPtr->allocated) {
+ if (newLength > stringPtr->allocated) {
+ int offset = -1;
+
/*
- * There isn't currently enough space in the string representation so
- * allocate additional space. First, try to double the length
- * required. If that fails, try a more modest allocation. See the "TCL
- * STRING GROWTH ALGORITHM" comment at the top of this file for an
- * explanation of this growth algorithm.
+ * Protect against case where unicode points into the existing
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
- Tcl_SetObjLength(objPtr,
- newLength + numBytes + TCL_GROWTH_MIN_ALLOC);
+ 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.
+ */
+
+ GrowStringBuffer(objPtr, newLength, 0);
+
+ /*
+ * Relocate bytes if needed; see above.
+ */
+
+ if (offset >= 0) {
+ bytes = objPtr->bytes + offset;
}
}
@@ -1496,8 +1625,7 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
- memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
- (size_t) numBytes);
+ memmove(objPtr->bytes + oldLength, bytes, numBytes);
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
@@ -1521,128 +1649,22 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
*/
void
-Tcl_AppendStringsToObjVA (objPtr, argList)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- va_list argList; /* Variable argument list. */
+Tcl_AppendStringsToObjVA(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ va_list argList) /* Variable argument list. */
{
-#define STATIC_LIST_SIZE 16
- String *stringPtr;
- int newLength, oldLength, attemptLength;
- register char *string, *dst;
- char *static_list[STATIC_LIST_SIZE];
- char **args = static_list;
- int nargs_space = STATIC_LIST_SIZE;
- int nargs, i;
-
if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("Tcl_AppendStringsToObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
}
- SetStringFromAny(NULL, objPtr);
-
- /*
- * Figure out how much space is needed for all the strings, and expand the
- * string representation if it isn't big enough. If no bytes would be
- * appended, just return. Note that on some platforms (notably OS/390) the
- * argList is an array so we need to use memcpy.
- */
-
- nargs = 0;
- newLength = 0;
- oldLength = objPtr->length;
while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
- }
- if (nargs >= nargs_space) {
- /*
- * Expand the args buffer.
- */
-
- nargs_space += STATIC_LIST_SIZE;
- if (args == static_list) {
- args = (void *) ckalloc(nargs_space * sizeof(char *));
- for (i = 0; i < nargs; ++i) {
- args[i] = static_list[i];
- }
- } else {
- args = (void *) ckrealloc((void *) args,
- nargs_space * sizeof(char *));
- }
- }
- newLength += strlen(string);
- args[nargs++] = string;
- }
- if (newLength == 0) {
- goto done;
- }
-
- stringPtr = GET_STRING(objPtr);
- if (oldLength + newLength > (int) stringPtr->allocated) {
- /*
- * There isn't currently enough space in the string representation, so
- * allocate additional space. If the current string representation
- * isn't empty (i.e. it looks like we're doing a series of appends)
- * then try to allocate extra space to accomodate future growth: first
- * try to double the required memory; if that fails, try a more modest
- * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the
- * top of this file for an explanation of this growth algorithm.
- * Otherwise, if the current string representation is empty, exactly
- * enough memory is allocated.
- */
+ const char *bytes = va_arg(argList, char *);
- if (oldLength == 0) {
- Tcl_SetObjLength(objPtr, newLength);
- } else {
- attemptLength = 2 * (oldLength + newLength);
- if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
- attemptLength = oldLength + (2 * newLength) +
- TCL_GROWTH_MIN_ALLOC;
- Tcl_SetObjLength(objPtr, attemptLength);
- }
- }
- }
-
- /*
- * Make a second pass through the arguments, appending all the strings to
- * the object.
- */
-
- dst = objPtr->bytes + oldLength;
- for (i = 0; i < nargs; ++i) {
- string = args[i];
- if (string == NULL) {
+ if (bytes == NULL) {
break;
}
- while (*string != 0) {
- *dst = *string;
- dst++;
- string++;
- }
- }
-
- /*
- * Add a null byte to terminate the string. However, be careful: it's
- * possible that the object is totally empty (if it was empty originally
- * and there was nothing to append). In this case dst is NULL; just leave
- * everything alone.
- */
-
- if (dst != NULL) {
- *dst = 0;
- }
- objPtr->length = oldLength + newLength;
-
- done:
- /*
- * If we had to allocate a buffer from the heap, free it now.
- */
-
- if (args != static_list) {
- ckfree((void *)args);
+ Tcl_AppendToObj(objPtr, bytes, -1);
}
-#undef STATIC_LIST_SIZE
}
/*
@@ -1664,7 +1686,9 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
*/
void
-Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
+Tcl_AppendStringsToObj(
+ Tcl_Obj *objPtr,
+ ...)
{
va_list argList;
@@ -1676,12 +1700,12 @@ Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
/*
*----------------------------------------------------------------------
*
- * TclAppendFormattedObjs --
+ * Tcl_AppendFormatToObj --
*
- * This function appends a list of Tcl_Obj's to a Tcl_Obj according
- * to the formatting instructions embedded in the format string. The
- * formatting instructions are inspired by sprintf(). Returns TCL_OK
- * when successful. If there's an error in the arguments, TCL_ERROR is
+ * This function appends a list of Tcl_Obj's to a Tcl_Obj according to
+ * the formatting instructions embedded in the format string. The
+ * formatting instructions are inspired by sprintf(). Returns TCL_OK when
+ * successful. If there's an error in the arguments, TCL_ERROR is
* returned, and an error message is written to the interp, if non-NULL.
*
* Results:
@@ -1694,36 +1718,39 @@ Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
*/
int
-TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
- Tcl_Interp *interp;
- Tcl_Obj *appendObj;
- CONST char *format;
- int objc;
- Tcl_Obj *CONST objv[];
+Tcl_AppendFormatToObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *appendObj,
+ const char *format,
+ int objc,
+ Tcl_Obj *const objv[])
{
- CONST char *span = format;
- int numBytes = 0;
- int objIndex = 0;
- int gotXpg = 0, gotSequential = 0;
- int originalLength;
- CONST char *msg;
- CONST char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers";
- CONST char *badIndex[2] = {
+ const char *span = format, *msg, *errCode;
+ int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
+ int originalLength, limit;
+ static const char *mixedXPG =
+ "cannot mix \"%\" and \"%n$\" conversion specifiers";
+ static const char *const badIndex[2] = {
"not enough arguments for all format specifiers",
"\"%n$\" argument index out of range"
};
+ static const char *overflow = "max size for a Tcl value exceeded";
if (Tcl_IsShared(appendObj)) {
- Tcl_Panic("TclAppendFormattedObjs called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
}
- Tcl_GetStringFromObj(appendObj, &originalLength);
+ TclGetStringFromObj(appendObj, &originalLength);
+ limit = INT_MAX - originalLength;
+
+ /*
+ * Format string is NUL-terminated.
+ */
- /* format string is NUL-terminated */
while (*format != '\0') {
char *end;
int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
- int width, gotPrecision, precision, useShort, useWide;
- int newXpg, numChars, allocSegment = 0;
+ int width, gotPrecision, precision, useShort, useWide, useBig;
+ int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_UniChar ch;
int step = Tcl_UtfToUniChar(format, &ch);
@@ -1734,12 +1761,21 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
continue;
}
if (numBytes) {
+ if (numBytes > limit) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
Tcl_AppendToObj(appendObj, span, numBytes);
+ limit -= numBytes;
numBytes = 0;
}
- /* Saw a % : process the format specifier */
- /* 0. %% : Escape format handling */
+ /*
+ * Saw a % : process the format specifier.
+ *
+ * Step 0. Handle special case of escaped format marker (i.e., %%).
+ */
step = Tcl_UtfToUniChar(format, &ch);
if (ch == '%') {
@@ -1749,11 +1785,14 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
continue;
}
- /* 1. XPG3 position specifier */
+ /*
+ * Step 1. XPG3 position specifier
+ */
newXpg = 0;
if (isdigit(UCHAR(ch))) {
int position = strtoul(format, &end, 10);
+
if (*end == '$') {
newXpg = 1;
objIndex = position - 1;
@@ -1764,22 +1803,27 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
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;
}
- /* 2. Set of flags */
+ /*
+ * Step 2. Set of flags.
+ */
gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
sawFlag = 1;
@@ -1809,7 +1853,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
} while (sawFlag);
- /* 3. Minimum field width */
+ /*
+ * Step 3. Minimum field width.
+ */
width = 0;
if (isdigit(UCHAR(ch))) {
@@ -1819,9 +1865,10 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
+ errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
- if (Tcl_GetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
+ if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
goto error;
}
if (width < 0) {
@@ -1832,8 +1879,15 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
+ if (width > limit) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
- /* 4. Precision */
+ /*
+ * Step 4. Precision.
+ */
gotPrecision = precision = 0;
if (ch == '.') {
@@ -1848,13 +1902,18 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
+ errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
- if (Tcl_GetIntFromObj(interp, objv[objIndex], &precision)
+ if (TclGetIntFromObj(interp, objv[objIndex], &precision)
!= TCL_OK) {
goto error;
}
- /* TODO: Check this truncation logic */
+
+ /*
+ * TODO: Check this truncation logic.
+ */
+
if (precision < 0) {
precision = 0;
}
@@ -1863,46 +1922,62 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
step = Tcl_UtfToUniChar(format, &ch);
}
- /* 5. Length modifier */
+ /*
+ * Step 5. Length modifier.
+ */
- useShort = useWide = 0;
+ useShort = useWide = useBig = 0;
if (ch == 'h') {
useShort = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == 'l') {
-#ifndef TCL_WIDE_INT_IS_LONG
- useWide = 1;
-#endif
format += step;
step = Tcl_UtfToUniChar(format, &ch);
+ if (ch == 'l') {
+ useBig = 1;
+ format += step;
+ step = Tcl_UtfToUniChar(format, &ch);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else {
+ useWide = 1;
+#endif
+ }
}
format += step;
span = format;
- /* 6. Conversion character */
+ /*
+ * Step 6. The actual conversion character.
+ */
+
segment = objv[objIndex];
+ numChars = -1;
if (ch == 'i') {
ch = 'd';
}
switch (ch) {
case '\0':
msg = "format string ended in middle of field specifier";
+ errCode = "INCOMPLETE";
goto errorMsg;
- case 's': {
- numChars = Tcl_GetCharLength(segment);
- if (gotPrecision && (precision < numChars)) {
- segment = Tcl_GetRange(segment, 0, precision - 1);
- Tcl_IncrRefCount(segment);
- allocSegment = 1;
+ case 's':
+ if (gotPrecision) {
+ numChars = Tcl_GetCharLength(segment);
+ if (precision < numChars) {
+ segment = Tcl_GetRange(segment, 0, precision - 1);
+ numChars = precision;
+ Tcl_IncrRefCount(segment);
+ allocSegment = 1;
+ }
}
break;
- }
case 'c': {
char buf[TCL_UTF_MAX];
int code, length;
- if (Tcl_GetIntFromObj(interp, segment, &code) != TCL_OK) {
+
+ if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
@@ -1911,60 +1986,98 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
allocSegment = 1;
break;
}
-
+
case 'u':
+ if (useBig) {
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ }
case 'd':
case 'o':
case 'x':
- case 'X': {
- short int s;
+ case 'X':
+ case 'b': {
+ short s = 0; /* Silence compiler warning; only defined and
+ * used when useShort is true. */
long l;
Tcl_WideInt w;
- int isNegative = 0;
+ mp_int big;
+ int toAppend, isNegative = 0;
- if (useWide) {
- if (Tcl_GetWideIntFromObj(interp, segment, &w) != TCL_OK) {
+ if (useBig) {
+ if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
- } else if (Tcl_GetLongFromObj(NULL, segment, &l) != TCL_OK) {
- if (Tcl_GetWideIntFromObj(interp, segment, &w) != TCL_OK) {
- goto error;
+ isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ } else if (useWide) {
+ if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ Tcl_Obj *objPtr;
+
+ if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
+ goto error;
+ }
+ mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
+ objPtr = Tcl_NewBignumObj(&big);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ Tcl_DecrRefCount(objPtr);
}
- l = Tcl_WideAsLong(w);
- }
+ isNegative = (w < (Tcl_WideInt) 0);
+ } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ Tcl_Obj *objPtr;
- if (useShort) {
- s = (short int) l;
- isNegative = (s < (short int)0);
- } else if (useWide) {
- isNegative = (w < (Tcl_WideInt)0);
+ if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
+ goto error;
+ }
+ mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+ objPtr = Tcl_NewBignumObj(&big);
+ Tcl_IncrRefCount(objPtr);
+ TclGetLongFromObj(NULL, objPtr, &l);
+ Tcl_DecrRefCount(objPtr);
+ } else {
+ l = Tcl_WideAsLong(w);
+ }
+ if (useShort) {
+ s = (short) l;
+ isNegative = (s < (short) 0);
+ } else {
+ isNegative = (l < (long) 0);
+ }
+ } else if (useShort) {
+ s = (short) l;
+ isNegative = (s < (short) 0);
} else {
- isNegative = (l < (long)0);
+ isNegative = (l < (long) 0);
}
segment = Tcl_NewObj();
allocSegment = 1;
+ segmentLimit = INT_MAX;
Tcl_IncrRefCount(segment);
- if (isNegative || gotPlus) {
- if (ch == 'd') {
- if (isNegative) {
- Tcl_AppendToObj(segment, "-", 1);
- } else {
- Tcl_AppendToObj(segment, "+", 1);
- }
- }
+ if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
+ Tcl_AppendToObj(segment,
+ (isNegative ? "-" : gotPlus ? "+" : " "), 1);
+ segmentLimit -= 1;
}
if (gotHash) {
switch (ch) {
case 'o':
Tcl_AppendToObj(segment, "0", 1);
+ segmentLimit -= 1;
precision--;
break;
case 'x':
case 'X':
Tcl_AppendToObj(segment, "0x", 2);
+ segmentLimit -= 2;
+ break;
+ case 'b':
+ Tcl_AppendToObj(segment, "0b", 2);
+ segmentLimit -= 2;
break;
}
}
@@ -1973,35 +2086,40 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
case 'd': {
int length;
Tcl_Obj *pure;
- CONST char *bytes;
+ const char *bytes;
- if (isNegative) {
- if (useShort) {
- pure = Tcl_NewIntObj((int)(-s));
- } else if (useWide) {
- pure = Tcl_NewWideIntObj(-w);
- } else {
- pure = Tcl_NewLongObj(-l);
- }
+ if (useShort) {
+ pure = Tcl_NewIntObj((int) s);
+ } else if (useWide) {
+ pure = Tcl_NewWideIntObj(w);
+ } else if (useBig) {
+ pure = Tcl_NewBignumObj(&big);
} else {
- if (useShort) {
- pure = Tcl_NewIntObj((int)(s));
- } else if (useWide) {
- pure = Tcl_NewWideIntObj(w);
- } else {
- pure = Tcl_NewLongObj(l);
- }
+ pure = Tcl_NewLongObj(l);
}
Tcl_IncrRefCount(pure);
- bytes = Tcl_GetStringFromObj(pure, &length);
- /* Handle things like -INT_MIN == INT_MIN */
+ bytes = TclGetStringFromObj(pure, &length);
+
+ /*
+ * Already did the sign above.
+ */
+
if (*bytes == '-') {
- length--; bytes++;
+ length--;
+ bytes++;
}
- /* Canonical decimal string reps for integers are composed
- * entirely of one-byte encoded characters, so "length" is
- * the number of chars */
+ toAppend = length;
+
+ /*
+ * Canonical decimal string reps for integers are composed
+ * entirely of one-byte encoded characters, so "length" is the
+ * number of chars.
+ */
+
if (gotPrecision) {
+ if (length < precision) {
+ segmentLimit -= precision - length;
+ }
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
@@ -2010,33 +2128,47 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
+ if (length < width) {
+ segmentLimit -= width - length;
+ }
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
- Tcl_AppendToObj(segment, bytes, -1);
+ if (toAppend > segmentLimit) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
+ Tcl_AppendToObj(segment, bytes, toAppend);
Tcl_DecrRefCount(pure);
break;
}
-
+
case 'u':
case 'o':
case 'x':
- case 'X': {
- Tcl_WideUInt bits;
- int length, numDigits = 0, base = 16;
+ case 'X':
+ case 'b': {
+ Tcl_WideUInt bits = (Tcl_WideUInt) 0;
+ Tcl_WideInt numDigits = (Tcl_WideInt) 0;
+ int length, numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
if (ch == 'u') {
base = 10;
- }
- if (ch == 'o') {
+ } else if (ch == 'o') {
base = 8;
+ numBits = 3;
+ } else if (ch == 'b') {
+ base = 2;
+ numBits = 1;
}
if (useShort) {
- unsigned short int us = (unsigned short int) s;
+ unsigned short us = (unsigned short) s;
+
bits = (Tcl_WideUInt) us;
while (us) {
numDigits++;
@@ -2044,29 +2176,60 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
+
bits = uw;
while (uw) {
numDigits++;
uw /= base;
}
- } else {
- unsigned long int ul = (unsigned long int) l;
+ } else if (useBig && big.used) {
+ int leftover = (big.used * DIGIT_BIT) % numBits;
+ mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
+
+ numDigits = 1 +
+ (((Tcl_WideInt) big.used * DIGIT_BIT) / numBits);
+ while ((mask & big.dp[big.used-1]) == 0) {
+ numDigits--;
+ mask >>= numBits;
+ }
+ if (numDigits > INT_MAX) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
+ } else if (!useBig) {
+ unsigned long ul = (unsigned long) l;
+
bits = (Tcl_WideUInt) ul;
while (ul) {
numDigits++;
ul /= base;
}
}
- /* Need to be sure zero becomes "0", not "" */
+
+ /*
+ * Need to be sure zero becomes "0", not "".
+ */
+
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
numDigits = 1;
}
pure = Tcl_NewObj();
- Tcl_SetObjLength(pure, numDigits);
- bytes = Tcl_GetString(pure);
- length = numDigits;
+ Tcl_SetObjLength(pure, (int) numDigits);
+ bytes = TclGetString(pure);
+ toAppend = length = (int) numDigits;
while (numDigits--) {
- int digitOffset = (int) (bits % base);
+ int digitOffset;
+
+ if (useBig && big.used) {
+ if (index < big.used && (size_t) shift <
+ CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
+ bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
+ shift += DIGIT_BIT;
+ }
+ shift -= numBits;
+ }
+ digitOffset = (int) (bits % base);
if (digitOffset > 9) {
bytes[numDigits] = 'a' + digitOffset - 10;
} else {
@@ -2074,7 +2237,13 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
bits /= base;
}
+ if (useBig) {
+ mp_clear(&big);
+ }
if (gotPrecision) {
+ if (length < precision) {
+ segmentLimit -= precision - length;
+ }
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
@@ -2083,11 +2252,19 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
+ if (length < width) {
+ segmentLimit -= width - length;
+ }
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
+ if (toAppend > segmentLimit) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
Tcl_AppendObjToObj(segment, pure);
Tcl_DecrRefCount(pure);
break;
@@ -2109,6 +2286,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
char *bytes;
if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) {
+ /* TODO: Figure out ACCEPT_NAN here */
goto error;
}
*p++ = '%';
@@ -2129,59 +2307,107 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
}
if (width) {
p += sprintf(p, "%d", width);
+ if (width > length) {
+ length = width;
+ }
}
if (gotPrecision) {
*p++ = '.';
p += sprintf(p, "%d", precision);
+ if (precision > INT_MAX - length) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
length += precision;
}
- /* Don't pass length modifiers ! */
+
+ /*
+ * Don't pass length modifiers!
+ */
+
*p++ = (char) ch;
*p = '\0';
segment = Tcl_NewObj();
allocSegment = 1;
- Tcl_SetObjLength(segment, length);
- bytes = Tcl_GetString(segment);
- Tcl_SetObjLength(segment, sprintf(bytes, spec, d));
+ 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;
}
- default: {
- char buf[40];
- sprintf(buf, "bad field specifier \"%c\"", ch);
- msg = buf;
- goto errorMsg;
- }
+ default:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
+ }
+ goto error;
}
switch (ch) {
case 'E':
case 'G':
case 'X': {
- Tcl_SetObjLength(segment, Tcl_UtfToUpper(Tcl_GetString(segment)));
+ Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
}
}
- numChars = Tcl_GetCharLength(segment);
- if (!gotMinus) {
+ if (width>0 && numChars<0) {
+ numChars = Tcl_GetCharLength(segment);
+ }
+ if (!gotMinus && width>0) {
+ if (numChars < width) {
+ limit -= width - numChars;
+ }
while (numChars < width) {
Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
numChars++;
}
}
+
+ Tcl_GetStringFromObj(segment, &segmentNumBytes);
+ if (segmentNumBytes > limit) {
+ if (allocSegment) {
+ Tcl_DecrRefCount(segment);
+ }
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
Tcl_AppendObjToObj(appendObj, segment);
+ limit -= segmentNumBytes;
if (allocSegment) {
Tcl_DecrRefCount(segment);
}
- while (numChars < width) {
- Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
- numChars++;
+ if (width > 0) {
+ if (numChars < width) {
+ limit -= width-numChars;
+ }
+ while (numChars < width) {
+ Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
+ numChars++;
+ }
}
objIndex += gotSequential;
}
if (numBytes) {
+ if (numBytes > limit) {
+ msg = overflow;
+ errCode = "OVERFLOW";
+ goto errorMsg;
+ }
Tcl_AppendToObj(appendObj, span, numBytes);
+ limit -= numBytes;
numBytes = 0;
}
@@ -2190,6 +2416,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
errorMsg:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
}
error:
Tcl_SetObjLength(appendObj, originalLength);
@@ -2199,71 +2426,39 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
/*
*---------------------------------------------------------------------------
*
- * FormatObjVA --
- *
- * Populate the Unicode internal rep with the Unicode form of its string
- * rep. The object must alread have a "String" internal rep.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Reallocates the String internal rep.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-FormatObjVA(Tcl_Interp *interp,
- Tcl_Obj *objPtr,
- CONST char *format,
- va_list argList)
-{
- int code, objc;
- Tcl_Obj **objv, *element, *list = Tcl_NewObj();
-
- Tcl_IncrRefCount(list);
- element = va_arg(argList, Tcl_Obj *);
- while (element != NULL) {
- Tcl_ListObjAppendElement(NULL, list, element);
- element = va_arg(argList, Tcl_Obj *);
- }
- Tcl_ListObjGetElements(NULL, list, &objc, &objv);
- code = TclAppendFormattedObjs(interp, objPtr, format, objc, objv);
- Tcl_DecrRefCount(list);
- return code;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFormatObj --
+ * Tcl_Format--
*
* Results:
- * A standard Tcl result.
+ * A refcount zero Tcl_Obj.
*
* Side effects:
- * None.
+ * None.
*
*---------------------------------------------------------------------------
*/
-int
-TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
+Tcl_Obj *
+Tcl_Format(
+ Tcl_Interp *interp,
+ const char *format,
+ int objc,
+ Tcl_Obj *const objv[])
{
- va_list argList;
int result;
+ Tcl_Obj *objPtr = Tcl_NewObj();
- va_start(argList, format);
- result = FormatObjVA(interp, objPtr, format, argList);
- va_end(argList);
- return result;
+ result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ return NULL;
+ }
+ return objPtr;
}
/*
*---------------------------------------------------------------------------
*
- * ObjPrintfVA --
+ * AppendPrintfToObjVA --
*
* Results:
*
@@ -2272,23 +2467,21 @@ TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
*---------------------------------------------------------------------------
*/
-static int
-ObjPrintfVA(
- Tcl_Interp *interp,
+static void
+AppendPrintfToObjVA(
Tcl_Obj *objPtr,
- CONST char *format,
+ const char *format,
va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
- CONST char *p;
- char *end;
+ const char *p;
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
int size = 0, seekingConversion = 1, gotPrecision = 0;
- int lastNum = -1, numBytes = -1;
+ int lastNum = -1;
if (*p++ != '%') {
continue;
@@ -2299,29 +2492,44 @@ ObjPrintfVA(
}
do {
switch (*p) {
-
case '\0':
seekingConversion = 0;
break;
case 's': {
- char *bytes = va_arg(argList, char *);
+ const char *q, *end, *bytes = va_arg(argList, char *);
seekingConversion = 0;
- if (gotPrecision) {
- char *end = bytes + lastNum;
- char *q = bytes;
- while ((q < end) && (*q != '\0')) {
- q++;
- }
- numBytes = (int)(q - bytes);
+
+ /*
+ * The buffer to copy characters from starts at bytes and ends
+ * at either the first NUL byte, or after lastNum bytes, when
+ * caller has indicated a limit.
+ */
+
+ end = bytes;
+ while ((!gotPrecision || lastNum--) && (*end != '\0')) {
+ end++;
}
- Tcl_ListObjAppendElement(NULL, list,
- Tcl_NewStringObj(bytes , numBytes));
- /* We took no more than numBytes bytes from the (char *).
- * In turn, [format] will take no more than numBytes
- * characters from the Tcl_Obj. Since numBytes characters
- * must be no less than numBytes bytes, the character limit
- * will have no effect and we can just pass it through.
+
+ /*
+ * Within that buffer, we trim both ends if needed so that we
+ * copy only whole characters, and avoid copying any partial
+ * multi-byte characters.
*/
+
+ q = Tcl_UtfPrev(end, bytes);
+ if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
+ end = q;
+ }
+
+ q = bytes + TCL_UTF_MAX;
+ while ((bytes < end) && (bytes < q)
+ && ((*bytes & 0xC0) == 0x80)) {
+ bytes++;
+ }
+
+ Tcl_ListObjAppendElement(NULL, list,
+ Tcl_NewStringObj(bytes , (int)(end - bytes)));
+
break;
}
case 'c':
@@ -2336,11 +2544,11 @@ ObjPrintfVA(
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;
@@ -2354,15 +2562,18 @@ ObjPrintfVA(
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;
case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
+ case '5': case '6': case '7': case '8': case '9': {
+ char *end;
+
lastNum = (int) strtoul(p, &end, 10);
p = end;
break;
+ }
case '.':
gotPrecision = 1;
p++;
@@ -2379,66 +2590,208 @@ ObjPrintfVA(
}
} while (seekingConversion);
}
- Tcl_ListObjGetElements(NULL, list, &objc, &objv);
- code = TclAppendFormattedObjs(interp, objPtr, format, objc, objv);
+ TclListObjGetElements(NULL, list, &objc, &objv);
+ code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
+ if (code != TCL_OK) {
+ Tcl_AppendPrintfToObj(objPtr,
+ "Unable to format \"%s\" with supplied arguments: %s",
+ format, Tcl_GetString(list));
+ }
Tcl_DecrRefCount(list);
- return code;
}
/*
*---------------------------------------------------------------------------
*
- * TclObjPrintf --
+ * Tcl_AppendPrintfToObj --
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*---------------------------------------------------------------------------
*/
-int
-TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
+void
+Tcl_AppendPrintfToObj(
+ Tcl_Obj *objPtr,
+ const char *format,
+ ...)
{
va_list argList;
- int result;
va_start(argList, format);
- result = ObjPrintfVA(interp, objPtr, format, argList);
+ AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
- return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclFormatToErrorInfo --
+ * Tcl_ObjPrintf --
*
* Results:
+ * A refcount zero Tcl_Obj.
*
* Side effects:
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-int
-TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
+Tcl_Obj *
+Tcl_ObjPrintf(
+ const char *format,
+ ...)
{
- int code;
va_list argList;
Tcl_Obj *objPtr = Tcl_NewObj();
va_start(argList, format);
- code = ObjPrintfVA(interp, objPtr, format, argList);
+ AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
- if (code != TCL_OK) {
- return code;
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringObjReverse --
+ *
+ * Implements the [string reverse] operation.
+ *
+ * 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.
+ *
+ * Side effects:
+ * May allocate a new Tcl_Obj.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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;
+ }
}
- TclAppendObjToErrorInfo(interp, objPtr);
- Tcl_DecrRefCount(objPtr);
- return TCL_OK;
+}
+
+Tcl_Obj *
+TclStringObjReverse(
+ Tcl_Obj *objPtr)
+{
+ String *stringPtr;
+ 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) {
+ 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;
+ }
+ } else {
+ /* Reversing in place */
+ while (--src > from) {
+ ch = *src;
+ *src = *from;
+ *from++ = ch;
+ }
+ }
+ }
+
+ if (objPtr->bytes) {
+ int numChars = stringPtr->numChars;
+ int numBytes = objPtr->length;
+ char *to, *from = objPtr->bytes;
+
+ if (Tcl_IsShared(objPtr)) {
+ objPtr = Tcl_NewObj();
+ Tcl_SetObjLength(objPtr, numBytes);
+ }
+ 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++;
+ }
+
+ from = to = objPtr->bytes;
+ stringPtr->numChars = charCount;
+ }
+ /* Pass 2. Reverse all the bytes. */
+ ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
+ }
+
+ return objPtr;
}
/*
@@ -2459,54 +2812,47 @@ TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
*/
static void
-FillUnicodeRep(objPtr)
- Tcl_Obj *objPtr; /* The object in which to fill the unicode
+FillUnicodeRep(
+ Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
- String *stringPtr;
- size_t uallocated;
- char *src, *srcEnd;
- Tcl_UniChar *dst;
- src = objPtr->bytes;
+ String *stringPtr = GET_STRING(objPtr);
- stringPtr = GET_STRING(objPtr);
- if (stringPtr->numChars == -1) {
- stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
- }
- stringPtr->hasUnicode = (stringPtr->numChars > 0);
+ ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
+ stringPtr->numChars);
+}
- uallocated = STRING_UALLOC(stringPtr->numChars);
- if (uallocated > stringPtr->uallocated) {
- /*
- * If not enough space has been allocated for the unicode rep,
- * reallocate the internal rep object.
- *
- * There isn't currently enough space in the Unicode representation so
- * allocate additional space. If the current Unicode representation
- * isn't empty (i.e. it looks like we've done some appends) then
- * overallocate the space so that we won't have to do as much
- * reallocation in the future.
- */
+static void
+ExtendUnicodeRepWithString(
+ Tcl_Obj *objPtr,
+ const char *bytes,
+ int numBytes,
+ int numAppendChars)
+{
+ String *stringPtr = GET_STRING(objPtr);
+ int needed, numOrigChars = 0;
+ Tcl_UniChar *dst;
- if (stringPtr->uallocated > 0) {
- uallocated *= 2;
- }
- stringPtr = (String *) ckrealloc((char*) stringPtr,
- STRING_SIZE(uallocated));
- stringPtr->uallocated = uallocated;
+ if (stringPtr->hasUnicode) {
+ numOrigChars = stringPtr->numChars;
+ }
+ if (numAppendChars == -1) {
+ TclNumUtfChars(numAppendChars, bytes, numBytes);
+ }
+ needed = numOrigChars + numAppendChars;
+ stringCheckLimits(needed);
+
+ if (needed > stringPtr->maxChars) {
+ GrowUnicodeBuffer(objPtr, needed);
+ stringPtr = GET_STRING(objPtr);
}
- /*
- * Convert src to Unicode and store the coverted data in "unicode".
- */
-
- srcEnd = src + objPtr->length;
- for (dst = stringPtr->unicode; src < srcEnd; dst++) {
- src += TclUtfToUniChar(src, dst);
+ stringPtr->hasUnicode = 1;
+ stringPtr->numChars = needed;
+ for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
+ bytes += TclUtfToUniChar(bytes, dst);
}
*dst = 0;
-
- SET_STRING(objPtr, stringPtr);
}
/*
@@ -2528,38 +2874,50 @@ FillUnicodeRep(objPtr)
*/
static void
-DupStringInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must have
+DupStringInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
* an internal rep of type "String". */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must not
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
- /*
- * 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
- * the new object. Otherwise, copy Unicode internal rep, and invalidate
- * the string rep of the new object.
- */
+#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.
+ */
- if (srcStringPtr->hasUnicode == 0) {
- copyStringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
- copyStringPtr->uallocated = STRING_UALLOC(0);
- } else {
- copyStringPtr = (String *) ckalloc(
- STRING_SIZE(srcStringPtr->uallocated));
- copyStringPtr->uallocated = srcStringPtr->uallocated;
+ return;
+ }
+
+ if (srcStringPtr->hasUnicode) {
+ int copyMaxChars;
- memcpy((VOID *) copyStringPtr->unicode,
- (VOID *) srcStringPtr->unicode,
- (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
+ if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
+ copyMaxChars = 2 * srcStringPtr->numChars;
+ } else {
+ copyMaxChars = srcStringPtr->maxChars;
+ }
+ 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));
copyStringPtr->unicode[srcStringPtr->numChars] = 0;
+ } else {
+ copyStringPtr = stringAlloc(0);
+ copyStringPtr->maxChars = 0;
+ copyStringPtr->unicode[0] = 0;
}
- copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
- copyStringPtr->allocated = srcStringPtr->allocated;
+ copyStringPtr->numChars = srcStringPtr->numChars;
/*
* Tricky point: the string value was copied by generic object management
@@ -2567,7 +2925,42 @@ DupStringInternalRep(srcPtr, copyPtr)
* source object.
*/
- copyStringPtr->allocated = copyPtr->length;
+ copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
+#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
+ * the new object. Otherwise, copy Unicode internal rep, and invalidate
+ * the string rep of the new object.
+ */
+
+ if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
+ /*
+ * Copy the full allocation for the Unicode buffer.
+ */
+
+ copyStringPtr = stringAlloc(srcStringPtr->maxChars);
+ copyStringPtr->maxChars = srcStringPtr->maxChars;
+ memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
+ srcStringPtr->numChars * sizeof(Tcl_UniChar));
+ copyStringPtr->unicode[srcStringPtr->numChars] = 0;
+ copyStringPtr->allocated = 0;
+ } else {
+ 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.
+ */
+
+ copyStringPtr->allocated = copyPtr->length;
+ }
+ copyStringPtr->numChars = srcStringPtr->numChars;
+ copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
+#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
@@ -2591,43 +2984,31 @@ DupStringInternalRep(srcPtr, copyPtr)
*/
static int
-SetStringFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetStringFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
- /*
- * The Unicode object is optimized for the case where each UTF char in a
- * string is only one byte. In this case, we store the value of numChars,
- * but we don't copy the bytes to the unicodeObj->unicode.
- */
-
if (objPtr->typePtr != &tclStringType) {
- String *stringPtr;
+ String *stringPtr = stringAlloc(0);
- if (objPtr->typePtr != NULL) {
- if (objPtr->bytes == NULL) {
- objPtr->typePtr->updateStringProc(objPtr);
- }
- TclFreeIntRep(objPtr);
- }
- objPtr->typePtr = &tclStringType;
+ /*
+ * Convert whatever we have into an untyped value. Just A String.
+ */
+
+ (void) TclGetString(objPtr);
+ TclFreeIntRep(objPtr);
/*
- * Allocate enough space for the basic String structure.
+ * Create a basic String intrep that just points to the UTF-8 string
+ * already in place at objPtr->bytes.
*/
- stringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
stringPtr->numChars = -1;
- stringPtr->uallocated = STRING_UALLOC(0);
+ stringPtr->allocated = objPtr->length;
+ stringPtr->maxChars = 0;
stringPtr->hasUnicode = 0;
-
- if (objPtr->bytes != NULL) {
- stringPtr->allocated = objPtr->length;
- objPtr->bytes[objPtr->length] = 0;
- } else {
- objPtr->length = 0;
- }
SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
}
return TCL_OK;
}
@@ -2651,51 +3032,78 @@ SetStringFromAny(interp, objPtr)
*/
static void
-UpdateStringOfString(objPtr)
- Tcl_Obj *objPtr; /* Object with string rep to update. */
+UpdateStringOfString(
+ Tcl_Obj *objPtr) /* Object with string rep to update. */
{
- int i, size;
- Tcl_UniChar *unicode;
- char dummy[TCL_UTF_MAX];
- char *dst;
- String *stringPtr;
+ String *stringPtr = GET_STRING(objPtr);
- stringPtr = GET_STRING(objPtr);
- if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
- if (stringPtr->numChars <= 0) {
- /*
- * If there is no Unicode rep, or the string has 0 chars, then set
- * the string rep to an empty string.
- */
+ if (stringPtr->numChars == 0) {
+ TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ } else {
+ (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
+ stringPtr->numChars);
+ }
+}
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
- return;
- }
+static int
+ExtendStringRepWithUnicode(
+ Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode,
+ int numChars)
+{
+ /*
+ * Pre-condition: this is the "string" Tcl_ObjType.
+ */
- unicode = stringPtr->unicode;
+ int i, origLength, size = 0;
+ char *dst, buf[TCL_UTF_MAX];
+ String *stringPtr = GET_STRING(objPtr);
- /*
- * Translate the Unicode string to UTF. "size" will hold the amount of
- * space the UTF string needs.
- */
+ if (numChars < 0) {
+ numChars = UnicodeLength(unicode);
+ }
- size = 0;
- for (i = 0; i < stringPtr->numChars; i++) {
- size += Tcl_UniCharToUtf((int) unicode[i], dummy);
- }
+ if (numChars == 0) {
+ return 0;
+ }
+
+ if (objPtr->bytes == NULL) {
+ objPtr->length = 0;
+ }
+ size = origLength = objPtr->length;
+
+ /*
+ * Quick cheap check in case we have more than enough room.
+ */
- dst = (char *) ckalloc((unsigned) (size + 1));
- objPtr->bytes = dst;
- objPtr->length = size;
- stringPtr->allocated = size;
+ if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
+ && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
+ goto copyBytes;
+ }
- for (i = 0; i < stringPtr->numChars; i++) {
- dst += Tcl_UniCharToUtf(unicode[i], dst);
- }
- *dst = '\0';
+ for (i = 0; i < numChars && size >= 0; i++) {
+ size += Tcl_UniCharToUtf((int) unicode[i], buf);
+ }
+ if (size < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ /*
+ * Grow space if needed.
+ */
+
+ if (size > stringPtr->allocated) {
+ GrowStringBuffer(objPtr, size, 1);
}
- return;
+
+ copyBytes:
+ dst = objPtr->bytes + origLength;
+ for (i = 0; i < numChars; i++) {
+ dst += Tcl_UniCharToUtf((int) unicode[i], dst);
+ }
+ *dst = '\0';
+ objPtr->length = dst - objPtr->bytes;
+ return numChars;
}
/*
@@ -2716,10 +3124,11 @@ UpdateStringOfString(objPtr)
*/
static void
-FreeStringInternalRep(objPtr)
- Tcl_Obj *objPtr; /* Object with internal rep to free. */
+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/tclStringTrim.h b/generic/tclStringTrim.h
new file mode 100644
index 0000000..030e4ec
--- /dev/null
+++ b/generic/tclStringTrim.h
@@ -0,0 +1,43 @@
+/*
+ * tclStringTrim.h --
+ *
+ * This file contains the definition of what characters are to be trimmed
+ * from a string by [string trim] by default. It's only needed by Tcl's
+ * implementation; it does not form a public or private API at all.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2003-2013 Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TCL_STRING_TRIM_H
+#define TCL_STRING_TRIM_H
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters. [TIP #413]
+ */
+
+MODULE_SCOPE const char tclDefaultTrimSet[];
+
+/*
+ * The whitespace trimming set used when [concat]enating. This is a subset of
+ * the above, and deliberately so.
+ */
+
+#define CONCAT_TRIM_SET " \f\v\r\t\n"
+
+#endif /* TCL_STRING_TRIM_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index b27ab3d..7a84cba 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclStubInit.c --
*
* This file contains the initializers for the Tcl stub vectors.
@@ -7,11 +7,16 @@
*
* 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.122 2005/08/24 17:56:23 andreas_kupries Exp $
*/
#include "tclInt.h"
+#include "tommath.h"
+
+#ifdef __GNUC__
+#pragma GCC dependency "tcl.decls"
+#pragma GCC dependency "tclInt.decls"
+#pragma GCC dependency "tclTomMath.decls"
+#endif
/*
* Remove macros that will interfere with the definitions below.
@@ -30,33 +35,264 @@
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-# undef Tcl_FindHashEntry
-# undef Tcl_CreateHashEntry
+#undef Tcl_FindHashEntry
+#undef Tcl_CreateHashEntry
+#undef Tcl_Panic
+#undef Tcl_FindExecutable
+#undef TclpGetPid
+#undef TclSockMinimumBuffers
+#define TclBackgroundException Tcl_BackgroundException
+#undef Tcl_SetIntObj
+#undef TclpInetNtoa
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
+
+/* 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
-/*
- * Keep a record of the original Notifier procedures, created in the
- * same compilation unit as the stub tables so we can later do reliable,
- * portable comparisons to see whether a Tcl_SetNotifier() call swapped
- * new routines into the stub table.
+#define TclSetStartupScriptPath setStartupScriptPath
+static void TclSetStartupScriptPath(Tcl_Obj *path)
+{
+ Tcl_SetStartupScript(path, NULL);
+}
+#define TclGetStartupScriptPath getStartupScriptPath
+static Tcl_Obj *TclGetStartupScriptPath(void)
+{
+ return Tcl_GetStartupScript(NULL);
+}
+#define TclSetStartupScriptFileName setStartupScriptFileName
+static void TclSetStartupScriptFileName(
+ const char *fileName)
+{
+ Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
+}
+#define TclGetStartupScriptFileName getStartupScriptFileName
+static const char *TclGetStartupScriptFileName(void)
+{
+ Tcl_Obj *path = Tcl_GetStartupScript(NULL);
+ if (path == NULL) {
+ return NULL;
+ }
+ return Tcl_GetStringFromObj(path, NULL);
+}
+
+#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);
+}
+
+#define TclWinGetPlatformId winGetPlatformId
+static 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;
+}
+
+#define TclWinSetSockOpt winSetSockOpt
+static int
+TclWinSetSockOpt(SOCKET s, int level, int optname,
+ const char *optval, int optlen)
+{
+ return setsockopt((int) s, level, optname, optval, optlen);
+}
+
+#define TclWinGetSockOpt winGetSockOpt
+static int
+TclWinGetSockOpt(SOCKET s, int level, int optname,
+ char *optval, int *optlen)
+{
+ return getsockopt((int) s, level, optname, optval, optlen);
+}
+
+#define TclWinGetServByName winGetServByName
+static struct servent *
+TclWinGetServByName(const char *name, const char *proto)
+{
+ return getservbyname(name, proto);
+}
+
+#define TclWinNoBackslash winNoBackslash
+static 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);
+}
+
+#if defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the Win64
+ * signature. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
*/
+#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
+static Tcl_Obj *dbNewLongObj(
+ int intValue,
+ const char *file,
+ int line
+) {
+#ifdef TCL_MEM_DEBUG
+ register Tcl_Obj *objPtr;
+
+ TclDbNewObj(objPtr, file, line);
+ objPtr->bytes = NULL;
-Tcl_NotifierProcs tclOriginalNotifier = {
- Tcl_SetTimer,
- Tcl_WaitForEvent,
-#if !defined(__WIN32__) /* UNIX */
- Tcl_CreateFileHandler,
- Tcl_DeleteFileHandler,
+ objPtr->internalRep.longValue = (long) intValue;
+ objPtr->typePtr = &tclIntType;
+ return objPtr;
#else
- NULL,
- NULL,
+ return Tcl_NewIntObj(intValue);
+#endif
+}
+#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
+#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
+#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
+static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLong(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent as non-long integer", -1));
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
+static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLongObj(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent as non-long integer", -1));
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
+static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp
+static int utfNcmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp
+static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
+static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
+static int formatInt(char *buffer, int n){
+ return TclFormatInt(buffer, (long)n);
+}
+#define TclFormatInt (int(*)(char *, long))formatInt
+
+#endif
+
+#else /* UNIX and MAC */
+# define TclpLocaltime_unix TclpLocaltime
+# define TclpGmtime_unix TclpGmtime
#endif
- NULL,
- NULL,
- NULL,
- NULL
-};
/*
* WARNING: The contents of this file is automatically generated by the
@@ -64,137 +300,125 @@ Tcl_NotifierProcs tclOriginalNotifier = {
* below should be made in the generic/tcl.decls script.
*/
+MODULE_SCOPE const TclStubs tclStubs;
+MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+
/* !BEGIN!: Do not edit below this line. */
-TclIntStubs tclIntStubs = {
+static const TclIntStubs tclIntStubs = {
TCL_STUB_MAGIC,
- NULL,
- NULL, /* 0 */
- TclAccessDeleteProc, /* 1 */
- TclAccessInsertProc, /* 2 */
+ 0,
+ 0, /* 0 */
+ 0, /* 1 */
+ 0, /* 2 */
TclAllocateFreeObjects, /* 3 */
- NULL, /* 4 */
-#if !defined(__WIN32__) /* UNIX */
- TclCleanupChildren, /* 5 */
-#endif /* UNIX */
-#ifdef __WIN32__
+ 0, /* 4 */
TclCleanupChildren, /* 5 */
-#endif /* __WIN32__ */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
- TclCopyChannel, /* 8 */
-#if !defined(__WIN32__) /* UNIX */
+ TclCopyChannelOld, /* 8 */
TclCreatePipeline, /* 9 */
-#endif /* UNIX */
-#ifdef __WIN32__
- TclCreatePipeline, /* 9 */
-#endif /* __WIN32__ */
TclCreateProc, /* 10 */
TclDeleteCompiledLocalVars, /* 11 */
TclDeleteVars, /* 12 */
- NULL, /* 13 */
+ 0, /* 13 */
TclDumpMemoryInfo, /* 14 */
- NULL, /* 15 */
+ 0, /* 15 */
TclExprFloatError, /* 16 */
- NULL, /* 17 */
- NULL, /* 18 */
- NULL, /* 19 */
- NULL, /* 20 */
- NULL, /* 21 */
+ 0, /* 17 */
+ 0, /* 18 */
+ 0, /* 19 */
+ 0, /* 20 */
+ 0, /* 21 */
TclFindElement, /* 22 */
TclFindProc, /* 23 */
- NULL, /* 24 */
+ TclFormatInt, /* 24 */
TclFreePackageInfo, /* 25 */
- NULL, /* 26 */
- NULL, /* 27 */
+ 0, /* 26 */
+ 0, /* 27 */
TclpGetDefaultStdChannel, /* 28 */
- NULL, /* 29 */
- NULL, /* 30 */
+ 0, /* 29 */
+ 0, /* 30 */
TclGetExtension, /* 31 */
TclGetFrame, /* 32 */
- NULL, /* 33 */
+ 0, /* 33 */
TclGetIntForIndex, /* 34 */
- NULL, /* 35 */
- TclGetLong, /* 36 */
+ 0, /* 35 */
+ 0, /* 36 */
TclGetLoadedPackages, /* 37 */
TclGetNamespaceForQualName, /* 38 */
TclGetObjInterpProc, /* 39 */
TclGetOpenMode, /* 40 */
TclGetOriginalCommand, /* 41 */
TclpGetUserHome, /* 42 */
- NULL, /* 43 */
+ 0, /* 43 */
TclGuessPackageName, /* 44 */
TclHideUnsafeCommands, /* 45 */
TclInExit, /* 46 */
- NULL, /* 47 */
- NULL, /* 48 */
- TclIncrVar2, /* 49 */
+ 0, /* 47 */
+ 0, /* 48 */
+ 0, /* 49 */
TclInitCompiledLocals, /* 50 */
TclInterpInit, /* 51 */
- NULL, /* 52 */
+ 0, /* 52 */
TclInvokeObjectCommand, /* 53 */
TclInvokeStringCommand, /* 54 */
TclIsProc, /* 55 */
- NULL, /* 56 */
- NULL, /* 57 */
+ 0, /* 56 */
+ 0, /* 57 */
TclLookupVar, /* 58 */
- NULL, /* 59 */
+ 0, /* 59 */
TclNeedSpace, /* 60 */
TclNewProcBodyObj, /* 61 */
TclObjCommandComplete, /* 62 */
TclObjInterpProc, /* 63 */
TclObjInvoke, /* 64 */
- NULL, /* 65 */
- TclOpenFileChannelDeleteProc, /* 66 */
- TclOpenFileChannelInsertProc, /* 67 */
- NULL, /* 68 */
+ 0, /* 65 */
+ 0, /* 66 */
+ 0, /* 67 */
+ 0, /* 68 */
TclpAlloc, /* 69 */
- NULL, /* 70 */
- NULL, /* 71 */
- NULL, /* 72 */
- NULL, /* 73 */
+ 0, /* 70 */
+ 0, /* 71 */
+ 0, /* 72 */
+ 0, /* 73 */
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
- TclpGetTimeZone, /* 78 */
- NULL, /* 79 */
- NULL, /* 80 */
+ 0, /* 78 */
+ 0, /* 79 */
+ 0, /* 80 */
TclpRealloc, /* 81 */
- NULL, /* 82 */
- NULL, /* 83 */
- NULL, /* 84 */
- NULL, /* 85 */
- NULL, /* 86 */
- NULL, /* 87 */
+ 0, /* 82 */
+ 0, /* 83 */
+ 0, /* 84 */
+ 0, /* 85 */
+ 0, /* 86 */
+ 0, /* 87 */
TclPrecTraceProc, /* 88 */
TclPreventAliasLoop, /* 89 */
- NULL, /* 90 */
+ 0, /* 90 */
TclProcCleanupProc, /* 91 */
TclProcCompileProc, /* 92 */
TclProcDeleteProc, /* 93 */
- NULL, /* 94 */
- NULL, /* 95 */
+ 0, /* 94 */
+ 0, /* 95 */
TclRenameCommand, /* 96 */
TclResetShadowedCmdRefs, /* 97 */
TclServiceIdle, /* 98 */
- NULL, /* 99 */
- NULL, /* 100 */
+ 0, /* 99 */
+ 0, /* 100 */
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
-#if !defined(__WIN32__) /* UNIX */
- TclSockMinimumBuffers, /* 104 */
-#endif /* UNIX */
-#ifdef __WIN32__
- TclSockMinimumBuffers, /* 104 */
-#endif /* __WIN32__ */
- NULL, /* 105 */
- TclStatDeleteProc, /* 106 */
- TclStatInsertProc, /* 107 */
+ TclSockMinimumBuffersOld, /* 104 */
+ 0, /* 105 */
+ 0, /* 106 */
+ 0, /* 107 */
TclTeardownNamespace, /* 108 */
TclUpdateReturnInfo, /* 109 */
- NULL, /* 110 */
+ TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
Tcl_AppendExportList, /* 112 */
Tcl_CreateNamespace, /* 113 */
@@ -218,13 +442,13 @@ TclIntStubs tclIntStubs = {
Tcl_SetNamespaceResolvers, /* 131 */
TclpHasSockets, /* 132 */
TclpGetDate, /* 133 */
- NULL, /* 134 */
- NULL, /* 135 */
- NULL, /* 136 */
- NULL, /* 137 */
+ 0, /* 134 */
+ 0, /* 135 */
+ 0, /* 136 */
+ 0, /* 137 */
TclGetEnv, /* 138 */
- NULL, /* 139 */
- TclLooksLikeInt, /* 140 */
+ 0, /* 139 */
+ 0, /* 140 */
TclpGetCwd, /* 141 */
TclSetByteCodeFromAny, /* 142 */
TclAddLiteralObj, /* 143 */
@@ -238,13 +462,13 @@ TclIntStubs tclIntStubs = {
TclRegExpRangeUniChar, /* 151 */
TclSetLibraryPath, /* 152 */
TclGetLibraryPath, /* 153 */
- NULL, /* 154 */
- NULL, /* 155 */
+ 0, /* 154 */
+ 0, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
- NULL, /* 160 */
+ 0, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
TclGetInstructionTable, /* 163 */
@@ -258,32 +482,32 @@ TclIntStubs tclIntStubs = {
TclCheckExecutionTraces, /* 171 */
TclInThreadExit, /* 172 */
TclUniCharMatch, /* 173 */
- TclIncrWideVar2, /* 174 */
+ 0, /* 174 */
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
Tcl_SetStartupScript, /* 178 */
Tcl_GetStartupScript, /* 179 */
- NULL, /* 180 */
- NULL, /* 181 */
+ 0, /* 180 */
+ 0, /* 181 */
TclpLocaltime, /* 182 */
TclpGmtime, /* 183 */
- NULL, /* 184 */
- NULL, /* 185 */
- NULL, /* 186 */
- NULL, /* 187 */
- NULL, /* 188 */
- NULL, /* 189 */
- NULL, /* 190 */
- NULL, /* 191 */
- NULL, /* 192 */
- NULL, /* 193 */
- NULL, /* 194 */
- NULL, /* 195 */
- NULL, /* 196 */
- TclCompEvalObj, /* 197 */
+ 0, /* 184 */
+ 0, /* 185 */
+ 0, /* 186 */
+ 0, /* 187 */
+ 0, /* 188 */
+ 0, /* 189 */
+ 0, /* 190 */
+ 0, /* 191 */
+ 0, /* 192 */
+ 0, /* 193 */
+ 0, /* 194 */
+ 0, /* 195 */
+ 0, /* 196 */
+ 0, /* 197 */
TclObjGetFrame, /* 198 */
- NULL, /* 199 */
+ 0, /* 199 */
TclpObjRemoveDirectory, /* 200 */
TclpObjCopyDirectory, /* 201 */
TclpObjCreateDirectory, /* 202 */
@@ -293,9 +517,9 @@ TclIntStubs tclIntStubs = {
TclpObjStat, /* 206 */
TclpObjAccess, /* 207 */
TclpOpenFileChannel, /* 208 */
- TclGetEncodingSearchPath, /* 209 */
- TclSetEncodingSearchPath, /* 210 */
- TclpGetEncodingNameFromEnvironment, /* 211 */
+ 0, /* 209 */
+ 0, /* 210 */
+ 0, /* 211 */
TclpFindExecutable, /* 212 */
TclGetObjNameOfExecutable, /* 213 */
TclSetObjNameOfExecutable, /* 214 */
@@ -303,25 +527,51 @@ TclIntStubs tclIntStubs = {
TclStackFree, /* 216 */
TclPushStackFrame, /* 217 */
TclPopStackFrame, /* 218 */
- TclBN_mp_div_d, /* 219 */
- TclBN_mp_mul_d, /* 220 */
- TclBN_mp_clear, /* 221 */
- TclBN_mp_init, /* 222 */
- TclBN_mp_read_radix, /* 223 */
+ 0, /* 219 */
+ 0, /* 220 */
+ 0, /* 221 */
+ 0, /* 222 */
+ 0, /* 223 */
TclGetPlatform, /* 224 */
TclTraceDictPath, /* 225 */
+ TclObjBeingDeleted, /* 226 */
+ TclSetNsPath, /* 227 */
+ 0, /* 228 */
+ TclPtrMakeUpvar, /* 229 */
+ TclObjLookupVar, /* 230 */
+ TclGetNamespaceFromObj, /* 231 */
+ TclEvalObjEx, /* 232 */
+ TclGetSrcInfoForPc, /* 233 */
+ TclVarHashCreateVar, /* 234 */
+ TclInitVarHashTable, /* 235 */
+ TclBackgroundException, /* 236 */
+ TclResetCancellation, /* 237 */
+ TclNRInterpProc, /* 238 */
+ TclNRInterpProcCore, /* 239 */
+ TclNRRunCallbacks, /* 240 */
+ TclNREvalObjEx, /* 241 */
+ TclNREvalObjv, /* 242 */
+ TclDbDumpActiveObjects, /* 243 */
+ TclGetNamespaceChildTable, /* 244 */
+ TclGetNamespaceCommandTable, /* 245 */
+ TclInitRewriteEnsemble, /* 246 */
+ TclResetRewriteEnsemble, /* 247 */
+ TclCopyChannel, /* 248 */
+ TclDoubleDigits, /* 249 */
+ TclSetSlaveCancelFlags, /* 250 */
+ TclRegisterLiteral, /* 251 */
};
-TclIntPlatStubs tclIntPlatStubs = {
+static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
- NULL,
-#if !defined(__WIN32__) /* UNIX */
+ 0,
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
- NULL, /* 5 */
+ 0, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
@@ -331,66 +581,180 @@ 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__
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
TclWinGetSockOpt, /* 3 */
TclWinGetTclInstance, /* 4 */
- NULL, /* 5 */
+ TclUnixWaitForFile, /* 5 */
TclWinNToHS, /* 6 */
TclWinSetSockOpt, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
- NULL, /* 10 */
+ TclpReaddir, /* 10 */
TclGetAndDetachPids, /* 11 */
TclpCloseFile, /* 12 */
TclpCreateCommandChannel, /* 13 */
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
- NULL, /* 16 */
- NULL, /* 17 */
+ TclpIsAtty, /* 16 */
+ TclUnixCopyFile, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
- NULL, /* 21 */
+ TclpInetNtoa, /* 21 */
TclpCreateTempFile, /* 22 */
- TclpGetTZName, /* 23 */
+ 0, /* 23 */
TclWinNoBackslash, /* 24 */
- NULL, /* 25 */
+ 0, /* 25 */
TclWinSetInterfaces, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
TclWinCPUID, /* 29 */
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
+ TclUnixOpenTemporaryFile, /* 30 */
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ TclGetAndDetachPids, /* 0 */
+ TclpCloseFile, /* 1 */
+ TclpCreateCommandChannel, /* 2 */
+ TclpCreatePipe, /* 3 */
+ TclpCreateProcess, /* 4 */
+ 0, /* 5 */
+ TclpMakeFile, /* 6 */
+ TclpOpenFile, /* 7 */
+ TclUnixWaitForFile, /* 8 */
+ TclpCreateTempFile, /* 9 */
+ TclpReaddir, /* 10 */
+ TclpLocaltime_unix, /* 11 */
+ TclpGmtime_unix, /* 12 */
+ TclpInetNtoa, /* 13 */
+ TclUnixCopyFile, /* 14 */
TclMacOSXGetFileAttribute, /* 15 */
TclMacOSXSetFileAttribute, /* 16 */
TclMacOSXCopyFileAttributes, /* 17 */
-#endif /* MAC_OSX_TCL */
+ 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 */
};
-TclPlatStubs tclPlatStubs = {
+static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
- NULL,
-#ifdef __WIN32__
+ 0,
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
-#endif /* __WIN32__ */
-#ifdef MAC_OSX_TCL
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_MacOSXOpenBundleResources, /* 0 */
Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
-#endif /* MAC_OSX_TCL */
+#endif /* MACOSX */
};
-static TclStubHooks tclStubHooks = {
+const TclTomMathStubs tclTomMathStubs = {
+ TCL_STUB_MAGIC,
+ 0,
+ TclBN_epoch, /* 0 */
+ TclBN_revision, /* 1 */
+ TclBN_mp_add, /* 2 */
+ TclBN_mp_add_d, /* 3 */
+ TclBN_mp_and, /* 4 */
+ TclBN_mp_clamp, /* 5 */
+ TclBN_mp_clear, /* 6 */
+ TclBN_mp_clear_multi, /* 7 */
+ TclBN_mp_cmp, /* 8 */
+ TclBN_mp_cmp_d, /* 9 */
+ TclBN_mp_cmp_mag, /* 10 */
+ TclBN_mp_copy, /* 11 */
+ TclBN_mp_count_bits, /* 12 */
+ TclBN_mp_div, /* 13 */
+ TclBN_mp_div_d, /* 14 */
+ TclBN_mp_div_2, /* 15 */
+ TclBN_mp_div_2d, /* 16 */
+ TclBN_mp_div_3, /* 17 */
+ TclBN_mp_exch, /* 18 */
+ TclBN_mp_expt_d, /* 19 */
+ TclBN_mp_grow, /* 20 */
+ TclBN_mp_init, /* 21 */
+ TclBN_mp_init_copy, /* 22 */
+ TclBN_mp_init_multi, /* 23 */
+ TclBN_mp_init_set, /* 24 */
+ TclBN_mp_init_size, /* 25 */
+ TclBN_mp_lshd, /* 26 */
+ TclBN_mp_mod, /* 27 */
+ TclBN_mp_mod_2d, /* 28 */
+ TclBN_mp_mul, /* 29 */
+ TclBN_mp_mul_d, /* 30 */
+ TclBN_mp_mul_2, /* 31 */
+ TclBN_mp_mul_2d, /* 32 */
+ TclBN_mp_neg, /* 33 */
+ TclBN_mp_or, /* 34 */
+ TclBN_mp_radix_size, /* 35 */
+ TclBN_mp_read_radix, /* 36 */
+ TclBN_mp_rshd, /* 37 */
+ TclBN_mp_shrink, /* 38 */
+ TclBN_mp_set, /* 39 */
+ TclBN_mp_sqr, /* 40 */
+ TclBN_mp_sqrt, /* 41 */
+ TclBN_mp_sub, /* 42 */
+ TclBN_mp_sub_d, /* 43 */
+ TclBN_mp_to_unsigned_bin, /* 44 */
+ TclBN_mp_to_unsigned_bin_n, /* 45 */
+ TclBN_mp_toradix_n, /* 46 */
+ TclBN_mp_unsigned_bin_size, /* 47 */
+ TclBN_mp_xor, /* 48 */
+ TclBN_mp_zero, /* 49 */
+ TclBN_reverse, /* 50 */
+ TclBN_fast_s_mp_mul_digs, /* 51 */
+ TclBN_fast_s_mp_sqr, /* 52 */
+ TclBN_mp_karatsuba_mul, /* 53 */
+ TclBN_mp_karatsuba_sqr, /* 54 */
+ TclBN_mp_toom_mul, /* 55 */
+ TclBN_mp_toom_sqr, /* 56 */
+ TclBN_s_mp_add, /* 57 */
+ 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 = {
&tclPlatStubs,
&tclIntStubs,
&tclIntPlatStubs
};
-TclStubs tclStubs = {
+const TclStubs tclStubs = {
TCL_STUB_MAGIC,
&tclStubHooks,
Tcl_PkgProvideEx, /* 0 */
@@ -402,18 +766,24 @@ TclStubs tclStubs = {
Tcl_DbCkalloc, /* 6 */
Tcl_DbCkfree, /* 7 */
Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
-#ifdef __WIN32__
- NULL, /* 9 */
-#endif /* __WIN32__ */
-#if !defined(__WIN32__) /* UNIX */
+#if defined(_WIN32) /* WIN */
+ 0, /* 9 */
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ Tcl_CreateFileHandler, /* 9 */
+#endif /* MACOSX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
-#ifdef __WIN32__
- NULL, /* 10 */
-#endif /* __WIN32__ */
+#if defined(_WIN32) /* WIN */
+ 0, /* 10 */
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ Tcl_DeleteFileHandler, /* 10 */
+#endif /* MACOSX */
Tcl_SetTimer, /* 11 */
Tcl_Sleep, /* 12 */
Tcl_WaitForEvent, /* 13 */
@@ -514,12 +884,7 @@ TclStubs tclStubs = {
Tcl_DeleteHashEntry, /* 108 */
Tcl_DeleteHashTable, /* 109 */
Tcl_DeleteInterp, /* 110 */
-#if !defined(__WIN32__) /* UNIX */
- Tcl_DetachPids, /* 111 */
-#endif /* UNIX */
-#ifdef __WIN32__
Tcl_DetachPids, /* 111 */
-#endif /* __WIN32__ */
Tcl_DeleteTimerHandler, /* 112 */
Tcl_DeleteTrace, /* 113 */
Tcl_DontCallWhenDeleted, /* 114 */
@@ -575,12 +940,15 @@ TclStubs tclStubs = {
Tcl_GetMaster, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
-#ifdef __WIN32__
- NULL, /* 167 */
-#endif /* __WIN32__ */
+#if defined(_WIN32) /* WIN */
+ 0, /* 167 */
+#endif /* WIN */
+#ifdef MAC_OSX_TCL /* MACOSX */
+ Tcl_GetOpenFile, /* 167 */
+#endif /* MACOSX */
Tcl_GetPathType, /* 168 */
Tcl_Gets, /* 169 */
Tcl_GetsObj, /* 170 */
@@ -601,7 +969,7 @@ TclStubs tclStubs = {
Tcl_IsSafe, /* 185 */
Tcl_JoinPath, /* 186 */
Tcl_LinkVar, /* 187 */
- NULL, /* 188 */
+ 0, /* 188 */
Tcl_MakeFileChannel, /* 189 */
Tcl_MakeSafe, /* 190 */
Tcl_MakeTcpClientChannel, /* 191 */
@@ -610,12 +978,7 @@ TclStubs tclStubs = {
Tcl_NotifyChannel, /* 194 */
Tcl_ObjGetVar2, /* 195 */
Tcl_ObjSetVar2, /* 196 */
-#if !defined(__WIN32__) /* UNIX */
Tcl_OpenCommandChannel, /* 197 */
-#endif /* UNIX */
-#ifdef __WIN32__
- Tcl_OpenCommandChannel, /* 197 */
-#endif /* __WIN32__ */
Tcl_OpenFileChannel, /* 198 */
Tcl_OpenTcpClient, /* 199 */
Tcl_OpenTcpServer, /* 200 */
@@ -625,12 +988,7 @@ TclStubs tclStubs = {
Tcl_PosixError, /* 204 */
Tcl_QueueEvent, /* 205 */
Tcl_Read, /* 206 */
-#if !defined(__WIN32__) /* UNIX */
- Tcl_ReapDetachedProcs, /* 207 */
-#endif /* UNIX */
-#ifdef __WIN32__
Tcl_ReapDetachedProcs, /* 207 */
-#endif /* __WIN32__ */
Tcl_RecordAndEval, /* 208 */
Tcl_RecordAndEvalObj, /* 209 */
Tcl_RegisterChannel, /* 210 */
@@ -708,7 +1066,7 @@ TclStubs tclStubs = {
Tcl_UnstackChannel, /* 282 */
Tcl_GetStackedChannel, /* 283 */
Tcl_SetMainLoop, /* 284 */
- NULL, /* 285 */
+ 0, /* 285 */
Tcl_AppendObjToObj, /* 286 */
Tcl_CreateEncoding, /* 287 */
Tcl_CreateThreadExitHandler, /* 288 */
@@ -982,12 +1340,78 @@ TclStubs tclStubs = {
Tcl_DbNewBignumObj, /* 556 */
Tcl_SetBignumObj, /* 557 */
Tcl_GetBignumFromObj, /* 558 */
- Tcl_TruncateChannel, /* 559 */
- Tcl_ChannelTruncateProc, /* 560 */
- Tcl_SetChannelErrorInterp, /* 561 */
- Tcl_GetChannelErrorInterp, /* 562 */
- Tcl_SetChannelError, /* 563 */
- Tcl_GetChannelError, /* 564 */
+ Tcl_TakeBignumFromObj, /* 559 */
+ Tcl_TruncateChannel, /* 560 */
+ Tcl_ChannelTruncateProc, /* 561 */
+ Tcl_SetChannelErrorInterp, /* 562 */
+ Tcl_GetChannelErrorInterp, /* 563 */
+ Tcl_SetChannelError, /* 564 */
+ Tcl_GetChannelError, /* 565 */
+ Tcl_InitBignumFromDouble, /* 566 */
+ Tcl_GetNamespaceUnknownHandler, /* 567 */
+ Tcl_SetNamespaceUnknownHandler, /* 568 */
+ Tcl_GetEncodingFromObj, /* 569 */
+ Tcl_GetEncodingSearchPath, /* 570 */
+ Tcl_SetEncodingSearchPath, /* 571 */
+ Tcl_GetEncodingNameFromEnvironment, /* 572 */
+ Tcl_PkgRequireProc, /* 573 */
+ Tcl_AppendObjToErrorInfo, /* 574 */
+ Tcl_AppendLimitedToObj, /* 575 */
+ Tcl_Format, /* 576 */
+ Tcl_AppendFormatToObj, /* 577 */
+ Tcl_ObjPrintf, /* 578 */
+ Tcl_AppendPrintfToObj, /* 579 */
+ Tcl_CancelEval, /* 580 */
+ Tcl_Canceled, /* 581 */
+ Tcl_CreatePipe, /* 582 */
+ Tcl_NRCreateCommand, /* 583 */
+ Tcl_NREvalObj, /* 584 */
+ Tcl_NREvalObjv, /* 585 */
+ Tcl_NRCmdSwap, /* 586 */
+ Tcl_NRAddCallback, /* 587 */
+ Tcl_NRCallObjProc, /* 588 */
+ Tcl_GetFSDeviceFromStat, /* 589 */
+ Tcl_GetFSInodeFromStat, /* 590 */
+ Tcl_GetModeFromStat, /* 591 */
+ Tcl_GetLinkCountFromStat, /* 592 */
+ Tcl_GetUserIdFromStat, /* 593 */
+ Tcl_GetGroupIdFromStat, /* 594 */
+ Tcl_GetDeviceTypeFromStat, /* 595 */
+ Tcl_GetAccessTimeFromStat, /* 596 */
+ Tcl_GetModificationTimeFromStat, /* 597 */
+ Tcl_GetChangeTimeFromStat, /* 598 */
+ Tcl_GetSizeFromStat, /* 599 */
+ Tcl_GetBlocksFromStat, /* 600 */
+ Tcl_GetBlockSizeFromStat, /* 601 */
+ Tcl_SetEnsembleParameterList, /* 602 */
+ Tcl_GetEnsembleParameterList, /* 603 */
+ Tcl_ParseArgsObjv, /* 604 */
+ Tcl_GetErrorLine, /* 605 */
+ Tcl_SetErrorLine, /* 606 */
+ Tcl_TransferResult, /* 607 */
+ Tcl_InterpActive, /* 608 */
+ Tcl_BackgroundException, /* 609 */
+ Tcl_ZlibDeflate, /* 610 */
+ Tcl_ZlibInflate, /* 611 */
+ Tcl_ZlibCRC32, /* 612 */
+ Tcl_ZlibAdler32, /* 613 */
+ Tcl_ZlibStreamInit, /* 614 */
+ Tcl_ZlibStreamGetCommandName, /* 615 */
+ Tcl_ZlibStreamEof, /* 616 */
+ Tcl_ZlibStreamChecksum, /* 617 */
+ Tcl_ZlibStreamPut, /* 618 */
+ Tcl_ZlibStreamGet, /* 619 */
+ Tcl_ZlibStreamClose, /* 620 */
+ Tcl_ZlibStreamReset, /* 621 */
+ Tcl_SetStartupScript, /* 622 */
+ Tcl_GetStartupScript, /* 623 */
+ Tcl_CloseEx, /* 624 */
+ Tcl_NRExprObj, /* 625 */
+ Tcl_NRSubstObj, /* 626 */
+ 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 f246f35..859cbf9 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -1,60 +1,35 @@
-/*
+/*
* tclStubLib.c --
*
- * Stub object that will be statically linked into extensions that wish
+ * Stub object that will be statically linked into extensions that want
* to access Tcl.
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1998 Paul Duffin.
*
- * 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.8 2004/04/06 22:25:55 dgp Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-/*
- * 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.
- */
+#include "tclInt.h"
-#ifndef USE_TCL_STUBS
-#define USE_TCL_STUBS
-#endif
-#undef USE_TCL_STUB_PROCS
+MODULE_SCOPE const TclStubs *tclStubsPtr;
+MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
+MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
+MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
-#include "tclInt.h"
+const TclStubs *tclStubsPtr = NULL;
+const TclPlatStubs *tclPlatStubsPtr = NULL;
+const TclIntStubs *tclIntStubsPtr = NULL;
+const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
/*
- * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub
- * functions should be built as non-exported symbols.
+ * Use our own isDigit to avoid linking to libc on windows
*/
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-TclStubs *tclStubsPtr = NULL;
-TclPlatStubs *tclPlatStubsPtr = NULL;
-TclIntStubs *tclIntStubsPtr = NULL;
-TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
-
-static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
-
-static TclStubs *
-HasStubSupport (interp)
- Tcl_Interp *interp;
+static int isDigit(const int c)
{
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
- return iPtr->stubTable;
- }
- interp->result = "This interpreter does not support stubs-enabled extensions.";
- interp->freeProc = TCL_STATIC;
-
- return NULL;
+ return (c >= '0' && c <= '9');
}
/*
@@ -62,52 +37,73 @@ HasStubSupport (interp)
*
* Tcl_InitStubs --
*
- * Tries to initialise the stub table pointers and ensures that
- * the correct version of Tcl is loaded.
+ * Tries to initialise the stub table pointers and ensures that the
+ * correct version of Tcl is loaded.
*
* Results:
- * The actual version of Tcl that satisfies the request, or
- * NULL to indicate that an error occurred.
+ * The actual version of Tcl that satisfies the request, or NULL to
+ * indicate that an error occurred.
*
* Side effects:
* Sets the stub table pointers.
*
*----------------------------------------------------------------------
*/
-
-#ifdef Tcl_InitStubs
#undef Tcl_InitStubs
-#endif
-
-CONST char *
-Tcl_InitStubs (interp, version, exact)
- Tcl_Interp *interp;
- CONST char *version;
- int exact;
+MODULE_SCOPE const char *
+Tcl_InitStubs(
+ Tcl_Interp *interp,
+ const char *version,
+ int exact)
{
- CONST char *actualVersion = NULL;
- TclStubs *tmp;
- TclStubs **tmpp;
+ Interp *iPtr = (Interp *) interp;
+ const char *actualVersion = NULL;
+ ClientData pkgData = NULL;
+ const TclStubs *stubsPtr = iPtr->stubTable;
/*
- * We can't optimize this check by caching tclStubsPtr because
- * that prevents apps from being able to load/unload Tcl dynamically
- * multiple times. [Bug 615304]
+ * We can't optimize this check by caching tclStubsPtr because that
+ * prevents apps from being able to load/unload Tcl dynamically multiple
+ * times. [Bug 615304]
*/
- tclStubsPtr = HasStubSupport(interp);
- if (!tclStubsPtr) {
+ if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
+ iPtr->result = "interpreter uses an incompatible stubs mechanism";
+ iPtr->freeProc = TCL_STATIC;
return NULL;
}
- /* This is needed to satisfy GCC 3.3's strict aliasing rules */
- tmpp = &tmp;
- actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact,
- (ClientData *) tmpp);
+ actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
if (actualVersion == NULL) {
- tclStubsPtr = NULL;
return NULL;
}
+ if (exact) {
+ const char *p = version;
+ int count = 0;
+
+ while (*p) {
+ count += !isDigit(*p++);
+ }
+ if (count == 1) {
+ const char *q = actualVersion;
+
+ p = version;
+ while (*p && (*p == *q)) {
+ p++; q++;
+ }
+ if (*p || isDigit(*q)) {
+ /* Construct error message */
+ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+ return NULL;
+ }
+ } else {
+ actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ }
+ }
+ tclStubsPtr = (TclStubs *)pkgData;
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
@@ -118,6 +114,14 @@ Tcl_InitStubs (interp, version, exact)
tclIntStubsPtr = NULL;
tclIntPlatStubsPtr = NULL;
}
-
+
return actualVersion;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c
new file mode 100644
index 0000000..0391502
--- /dev/null
+++ b/generic/tclStubLibTbl.c
@@ -0,0 +1,58 @@
+/*
+ * tclStubLibTbl.c --
+ *
+ * Stub object that will be statically linked into extensions that want
+ * to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStubTable --
+ *
+ * Initialize the stub table, using the structure pointed at
+ * by the "version" argument.
+ *
+ * Results:
+ * Outputs the value of the "version" argument.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE const char *
+TclInitStubTable(
+ const char *version) /* points to the version field of a
+ TclStubInfoType structure variable. */
+{
+ tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
+
+ if (tclStubsPtr->hooks) {
+ tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+ tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+ tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+ } else {
+ tclPlatStubsPtr = NULL;
+ tclIntStubsPtr = NULL;
+ tclIntPlatStubsPtr = NULL;
+ }
+
+ return version;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 8c0067f..a27c95a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1,24 +1,27 @@
-/*
+/*
* tclTest.c --
*
- * This file contains C command procedures for a bunch of additional
- * Tcl commands that are used for testing out Tcl's C interfaces.
- * These commands are not normally included in Tcl applications;
- * they're only used for testing.
+ * This file contains C command functions for a bunch of additional Tcl
+ * commands that are used for testing out Tcl's C interfaces. These
+ * commands are not normally included in Tcl applications; they're only
+ * used for testing.
*
* Copyright (c) 1993-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Ajuba Solutions.
* Copyright (c) 2003 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: tclTest.c,v 1.96 2005/09/08 14:10:55 dkf Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#define TCL_TEST
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
+#include "tclOO.h"
+#include <math.h>
/*
* Required for Testregexp*Cmd
@@ -40,56 +43,70 @@
*/
/*
- * Dynamic string shared by TestdcallCmd and DelCallbackProc; used
- * to collect the results of the various deletion callbacks.
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Tcltest_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+EXTERN int Tcltest_Init(Tcl_Interp *interp);
+EXTERN int Tcltest_SafeInit(Tcl_Interp *interp);
+
+/*
+ * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
+ * the results of the various deletion callbacks.
*/
static Tcl_DString delString;
static Tcl_Interp *delInterp;
/*
- * One of the following structures exists for each asynchronous
- * handler created by the "testasync" command".
+ * One of the following structures exists for each asynchronous handler
+ * created by the "testasync" command".
*/
typedef struct TestAsyncHandler {
- int id; /* Identifier for this handler. */
- Tcl_AsyncHandler handler; /* Tcl's token for the handler. */
- char *command; /* Command to invoke when the
- * handler is invoked. */
- struct TestAsyncHandler *nextPtr; /* Next is list of handlers. */
+ int id; /* Identifier for this handler. */
+ Tcl_AsyncHandler handler; /* Tcl's token for the handler. */
+ char *command; /* Command to invoke when the handler is
+ * invoked. */
+ struct TestAsyncHandler *nextPtr;
+ /* Next is list of handlers. */
} TestAsyncHandler;
+TCL_DECLARE_MUTEX(asyncTestMutex)
+
static TestAsyncHandler *firstHandler = NULL;
/*
- * The dynamic string below is used by the "testdstring" command
- * to test the dynamic string facilities.
+ * The dynamic string below is used by the "testdstring" command to test the
+ * dynamic string facilities.
*/
static Tcl_DString dstring;
/*
- * The command trace below is used by the "testcmdtraceCmd" command
- * to test the command tracing facilities.
+ * The command trace below is used by the "testcmdtraceCmd" command to test
+ * the command tracing facilities.
*/
static Tcl_Trace cmdTrace;
/*
- * One of the following structures exists for each command created
- * by TestdelCmd:
+ * One of the following structures exists for each command created by
+ * TestdelCmd:
*/
typedef struct DelCmd {
Tcl_Interp *interp; /* Interpreter in which command exists. */
- char *deleteCmd; /* Script to execute when command is
- * deleted. Malloc'ed. */
+ char *deleteCmd; /* Script to execute when command is deleted.
+ * Malloc'ed. */
} DelCmd;
/*
* The following is used to keep track of an encoding that invokes a Tcl
- * command.
+ * command.
*/
typedef struct TclEncoding {
@@ -99,400 +116,349 @@ typedef struct TclEncoding {
} TclEncoding;
/*
- * The counter below is used to determine if the TestsaveresultFree
- * routine was called for a result.
+ * The counter below is used to determine if the TestsaveresultFree routine
+ * was called for a result.
*/
static int freeCount;
/*
- * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
- * commands.
+ * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
*/
+
static int exitMainLoop = 0;
/*
* Event structure used in testing the event queue management procedures.
*/
+
typedef struct TestEvent {
Tcl_Event header; /* Header common to all events */
- Tcl_Interp* interp; /* Interpreter that will handle the event */
- Tcl_Obj* command; /* Command to evaluate when the event occurs */
- Tcl_Obj* tag; /* Tag for this event used to delete it */
+ Tcl_Interp *interp; /* Interpreter that will handle the event */
+ Tcl_Obj *command; /* Command to evaluate when the event occurs */
+ Tcl_Obj *tag; /* Tag for this event used to delete it */
} TestEvent;
-
/*
- * Simple detach/attach facility for testchannel cut|splice.
- * Allow testing of channel transfer in core testsuite.
+ * Simple detach/attach facility for testchannel cut|splice. Allow testing of
+ * channel transfer in core testsuite.
*/
typedef struct TestChannel {
- Tcl_Channel chan; /* Detached channel */
- struct TestChannel* nextPtr; /* Next in pool of detached channels */
+ Tcl_Channel chan; /* Detached channel */
+ struct TestChannel *nextPtr;/* Next in detached channel pool */
} TestChannel;
-static TestChannel* firstDetached;
-
+static TestChannel *firstDetached;
/*
* Forward declarations for procedures defined later in this file:
*/
-int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-static int AsyncHandlerProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int code));
+static int AsyncHandlerProc(ClientData clientData,
+ Tcl_Interp *interp, int code);
#ifdef TCL_THREADS
-static Tcl_ThreadCreateType AsyncThreadProc _ANSI_ARGS_((ClientData));
+static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
-static void CleanupTestSetassocdataTests _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
-static void CmdDelProc2 _ANSI_ARGS_((ClientData clientData));
-static int CmdProc1 _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int CmdProc2 _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static void CmdTraceDeleteProc _ANSI_ARGS_((
+static void CleanupTestSetassocdataTests(
+ ClientData clientData, Tcl_Interp *interp);
+static void CmdDelProc1(ClientData clientData);
+static void CmdDelProc2(ClientData clientData);
+static int CmdProc1(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int CmdProc2(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static void CmdTraceDeleteProc(
ClientData clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *cmdProc,
ClientData cmdClientData, int argc,
- char **argv));
-static void CmdTraceProc _ANSI_ARGS_((ClientData clientData,
+ const char *argv[]);
+static void CmdTraceProc(ClientData clientData,
Tcl_Interp *interp, int level, char *command,
Tcl_CmdProc *cmdProc, ClientData cmdClientData,
- int argc, char **argv));
-static int CreatedCommandProc _ANSI_ARGS_((
+ int argc, const char *argv[]);
+static int CreatedCommandProc(
ClientData clientData, Tcl_Interp *interp,
- int argc, CONST char **argv));
-static int CreatedCommandProc2 _ANSI_ARGS_((
+ int argc, const char **argv);
+static int CreatedCommandProc2(
ClientData clientData, Tcl_Interp *interp,
- int argc, CONST char **argv));
-static void DelCallbackProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-static int DelCmdProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static void DelDeleteProc _ANSI_ARGS_((ClientData clientData));
-static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData));
-static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int argc, const char **argv);
+static void DelCallbackProc(ClientData clientData,
+ Tcl_Interp *interp);
+static int DelCmdProc(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static void DelDeleteProc(ClientData clientData);
+static void EncodingFreeProc(ClientData clientData);
+static int EncodingToUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
- CONST char *src, int srcLen, int flags,
+ int *dstCharsPtr);
+static int EncodingFromUtfProc(ClientData clientData,
+ const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr, int *dstWrotePtr,
- int *dstCharsPtr));
-static void ExitProcEven _ANSI_ARGS_((ClientData clientData));
-static void ExitProcOdd _ANSI_ARGS_((ClientData clientData));
-static int GetTimesCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static void MainLoop _ANSI_ARGS_((void));
-static int NoopCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int NoopObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int ObjTraceProc _ANSI_ARGS_(( ClientData clientData,
- Tcl_Interp* interp,
- int level,
- CONST char* command,
- Tcl_Command commandToken,
- int objc,
- Tcl_Obj *CONST objv[] ));
-static void ObjTraceDeleteProc _ANSI_ARGS_(( ClientData ));
-static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Parse *parsePtr));
-static void SpecialFree _ANSI_ARGS_((char *blockPtr));
-static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
-static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int PretendTclpAccess _ANSI_ARGS_((CONST char *path,
- int mode));
-static int TestAccessProc1 _ANSI_ARGS_((CONST char *path,
- int mode));
-static int TestAccessProc2 _ANSI_ARGS_((CONST char *path,
- int mode));
-static int TestAccessProc3 _ANSI_ARGS_((CONST char *path,
- int mode));
-static int TestasyncCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestdcallCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestdelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestdstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestevalexObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TesteventObjCmd _ANSI_ARGS_((ClientData unused,
- Tcl_Interp* interp,
- int argc,
- Tcl_Obj *CONST objv[]));
-static int TesteventProc _ANSI_ARGS_((Tcl_Event* event,
- int flags));
-static int TesteventDeleteProc _ANSI_ARGS_((
- Tcl_Event* event,
- ClientData clientData));
-static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
+ int *dstCharsPtr);
+static void ExitProcEven(ClientData clientData);
+static void ExitProcOdd(ClientData clientData);
+static int GetTimesCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static void MainLoop(void);
+static int NoopCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int NoopObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ObjTraceProc(ClientData clientData,
+ Tcl_Interp *interp, int level, const char *command,
+ Tcl_Command commandToken, int objc,
+ Tcl_Obj *const objv[]);
+static void ObjTraceDeleteProc(ClientData clientData);
+static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
+static void SpecialFree(char *blockPtr);
+static int StaticInitProc(Tcl_Interp *interp);
+static int TestasyncCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestcmdinfoCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestcmdtokenCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestcmdtraceCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestconcatobjCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestcreatecommandCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestdcallCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+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,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestevalexObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestevalobjvObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TesteventObjCmd(ClientData unused,
+ Tcl_Interp *interp, int argc,
+ Tcl_Obj *const objv[]);
+static int TesteventProc(Tcl_Event *event, int flags);
+static int TesteventDeleteProc(Tcl_Event *event,
+ ClientData clientData);
+static int TestexithandlerCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestexprlongCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestexprlongobjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestfileCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int TestfilelinkCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int TestfeventCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestgetintCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestgetvarfullnameCmd _ANSI_ARGS_((
+ Tcl_Obj *const objv[]);
+static int TestexprdoubleCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestexprdoubleobjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestexprparserObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestexprstringCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestfileCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int TestfilelinkCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int TestfeventCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestgetassocdataCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestgetintCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestgetplatformCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestgetvarfullnameCmd(
ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
-static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestlinkCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
+ int objc, Tcl_Obj *const objv[]);
+static int TestinterpdeleteCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestlinkCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestlocaleCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestMathFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Obj *const objv[]);
+static int TestMathFunc(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
- Tcl_Value *resultPtr));
-static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
+ Tcl_Value *resultPtr);
+static int TestMathFunc2(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
- Tcl_Value *resultPtr));
-static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *fileName,
- CONST char *modeString, int permissions));
-static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *fileName,
- CONST char *modeString, int permissions));
-static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *fileName,
- CONST char *modeString, int permissions));
-static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_((
- Tcl_Interp *interp, CONST char *fileName,
- CONST char *modeString, int permissions));
-static int TestpanicCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Value *resultPtr);
+static int TestmainthreadCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestsetmainloopCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+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 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[]));
-static int TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static int TestparsevarObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static int TestparsevarnameObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static int TestregexpObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestreturnObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static int TestreturnObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void TestregexpXflags _ANSI_ARGS_((char *string,
- int length, int *cflagsPtr, int *eflagsPtr));
-static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *const objv[]);
+static void TestregexpXflags(const char *string,
+ int length, int *cflagsPtr, int *eflagsPtr);
+#ifndef TCL_NO_DEPRECATED
+static int TestsaveresultCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
-static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestsetCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestseterrorcodeCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestsetobjerrorcodeCmd _ANSI_ARGS_((
+ Tcl_Obj *const objv[]);
+static void TestsaveresultFree(char *blockPtr);
+#endif /* TCL_NO_DEPRECATED */
+static int TestsetassocdataCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestsetCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int Testset2Cmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestseterrorcodeCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestsetobjerrorcodeCmd(
ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
-static int TestopenfilechannelprocCmd _ANSI_ARGS_((
- ClientData dummy, Tcl_Interp *interp, int argc,
- CONST char **argv));
-static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int PretendTclpStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-static int TestStatProc1 _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-static int TestStatProc2 _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-static int TestStatProc3 _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestupvarCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestWrongNumArgsObjCmd _ANSI_ARGS_((
+ int objc, Tcl_Obj *const objv[]);
+static int TestsetplatformCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TeststaticpkgCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TesttranslatefilenameCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestupvarCmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestWrongNumArgsObjCmd(
ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
-static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
+ int objc, Tcl_Obj *const objv[]);
+static int TestGetIndexFromObjStructObjCmd(
ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
-static int TestChannelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-/* Filesystem testing */
-
-static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestSimpleFilesystemObjCmd _ANSI_ARGS_((
- ClientData dummy, Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-
-static void TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1,
- Tcl_Obj* arg2));
-
-static Tcl_Obj* TestReportGetNativePath _ANSI_ARGS_ ((
- Tcl_Obj* pathPtr));
-
-static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path,
- Tcl_StatBuf *buf));
-static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path,
- int mode));
-static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *fileName,
- int mode, int permissions));
-static int TestReportMatchInDirectory _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *resultPtr,
- Tcl_Obj *dirPtr, CONST char *pattern,
- Tcl_GlobTypeData *types));
-static int TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName));
-static int TestReportLstat _ANSI_ARGS_ ((Tcl_Obj *path,
- Tcl_StatBuf *buf));
-static int TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src,
- Tcl_Obj *dst));
-static int TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path));
-static int TestReportRenameFile _ANSI_ARGS_ ((Tcl_Obj *src,
- Tcl_Obj *dst));
-static int TestReportCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *path));
-static int TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src,
- Tcl_Obj *dst, Tcl_Obj **errorPtr));
-static int TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path,
- int recursive, Tcl_Obj **errorPtr));
-static int TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp,
- Tcl_Obj *fileName,
- Tcl_LoadHandle *handlePtr,
- Tcl_FSUnloadFileProc **unloadProcPtr));
-static Tcl_Obj * TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path,
- Tcl_Obj *to, int linkType));
-static CONST char** TestReportFileAttrStrings _ANSI_ARGS_ ((
- Tcl_Obj *fileName, Tcl_Obj **objPtrRef));
-static int TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp,
- int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef));
-static int TestReportFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp,
- int index, Tcl_Obj *fileName, Tcl_Obj *objPtr));
-static int TestReportUtime _ANSI_ARGS_ ((Tcl_Obj *fileName,
- struct utimbuf *tval));
-static int TestReportNormalizePath _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *pathPtr,
- int nextCheckpoint));
-static int TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *clientDataPtr));
-static void TestReportFreeInternalRep _ANSI_ARGS_ ((ClientData clientData));
-static ClientData TestReportDupInternalRep _ANSI_ARGS_ ((ClientData clientData));
-
-static int SimpleStat _ANSI_ARGS_ ((Tcl_Obj *path,
- Tcl_StatBuf *buf));
-static int SimpleAccess _ANSI_ARGS_ ((Tcl_Obj *path,
- int mode));
-static Tcl_Channel SimpleOpenFileChannel _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *fileName,
- int mode, int permissions));
-static Tcl_Obj* SimpleListVolumes _ANSI_ARGS_ ((void));
-static int SimplePathInFilesystem _ANSI_ARGS_ ((
- Tcl_Obj *pathPtr, ClientData *clientDataPtr));
-static Tcl_Obj* SimpleRedirect _ANSI_ARGS_ ((Tcl_Obj *pathPtr));
-static int SimpleMatchInDirectory _ANSI_ARGS_ ((
- Tcl_Interp *interp, Tcl_Obj *resultPtr,
- Tcl_Obj *dirPtr, CONST char *pattern,
- Tcl_GlobTypeData *types));
-static int TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestHashSystemHashCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-
-static Tcl_Filesystem testReportingFilesystem = {
+ int objc, Tcl_Obj *const objv[]);
+static int TestChannelCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestChannelEventCmd(ClientData clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestFilesystemObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestSimpleFilesystemObjCmd(
+ ClientData dummy, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void TestReport(const char *cmd, Tcl_Obj *arg1,
+ Tcl_Obj *arg2);
+static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr);
+static Tcl_FSStatProc TestReportStat;
+static Tcl_FSAccessProc TestReportAccess;
+static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
+static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
+static Tcl_FSChdirProc TestReportChdir;
+static Tcl_FSLstatProc TestReportLstat;
+static Tcl_FSCopyFileProc TestReportCopyFile;
+static Tcl_FSDeleteFileProc TestReportDeleteFile;
+static Tcl_FSRenameFileProc TestReportRenameFile;
+static Tcl_FSCreateDirectoryProc TestReportCreateDirectory;
+static Tcl_FSCopyDirectoryProc TestReportCopyDirectory;
+static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory;
+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;
+static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
+static Tcl_FSUtimeProc TestReportUtime;
+static Tcl_FSNormalizePathProc TestReportNormalizePath;
+static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
+static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
+static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
+
+static Tcl_FSStatProc SimpleStat;
+static Tcl_FSAccessProc SimpleAccess;
+static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
+static Tcl_FSListVolumesProc SimpleListVolumes;
+static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
+static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr);
+static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
+static int TestNumUtfCharsCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestHashSystemHashCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+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",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
- &TestReportInFilesystem, /* path in */
- &TestReportDupInternalRep,
- &TestReportFreeInternalRep,
+ TestReportInFilesystem, /* path in */
+ TestReportDupInternalRep,
+ TestReportFreeInternalRep,
NULL, /* native to norm */
NULL, /* convert to native */
- &TestReportNormalizePath,
+ TestReportNormalizePath,
NULL, /* path type */
NULL, /* separator */
- &TestReportStat,
- &TestReportAccess,
- &TestReportOpenFileChannel,
- &TestReportMatchInDirectory,
- &TestReportUtime,
- &TestReportLink,
+ TestReportStat,
+ TestReportAccess,
+ TestReportOpenFileChannel,
+ TestReportMatchInDirectory,
+ TestReportUtime,
+ TestReportLink,
NULL /* list volumes */,
- &TestReportFileAttrStrings,
- &TestReportFileAttrsGet,
- &TestReportFileAttrsSet,
- &TestReportCreateDirectory,
- &TestReportRemoveDirectory,
- &TestReportDeleteFile,
- &TestReportCopyFile,
- &TestReportRenameFile,
- &TestReportCopyDirectory,
- &TestReportLstat,
- &TestReportLoadFile,
+ TestReportFileAttrStrings,
+ TestReportFileAttrsGet,
+ TestReportFileAttrsSet,
+ TestReportCreateDirectory,
+ TestReportRemoveDirectory,
+ TestReportDeleteFile,
+ TestReportCopyFile,
+ TestReportRenameFile,
+ TestReportCopyDirectory,
+ TestReportLstat,
+ (Tcl_FSLoadFileProc *) TestReportLoadFile,
NULL /* cwd */,
- &TestReportChdir
+ TestReportChdir
};
-static Tcl_Filesystem simpleFilesystem = {
+static const Tcl_Filesystem simpleFilesystem = {
"simple",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
- &SimplePathInFilesystem,
+ SimplePathInFilesystem,
NULL,
NULL,
/* No internal to normalized, since we don't create any
@@ -506,26 +472,26 @@ static Tcl_Filesystem simpleFilesystem = {
NULL,
NULL,
NULL,
- &SimpleStat,
- &SimpleAccess,
- &SimpleOpenFileChannel,
- &SimpleMatchInDirectory,
+ SimpleStat,
+ SimpleAccess,
+ SimpleOpenFileChannel,
+ SimpleMatchInDirectory,
NULL,
/* We choose not to support symbolic links inside our vfs's */
NULL,
- &SimpleListVolumes,
+ SimpleListVolumes,
+ NULL,
NULL,
NULL,
NULL,
NULL,
- NULL,
NULL,
/* No copy file - fallback will occur at Tcl level */
NULL,
/* No rename file - fallback will occur at Tcl level */
NULL,
/* No copy directory - fallback will occur at Tcl level */
- NULL,
+ NULL,
/* Use stat for lstat */
NULL,
/* No load - fallback on core implementation */
@@ -537,26 +503,17 @@ static Tcl_Filesystem simpleFilesystem = {
/*
- * External (platform specific) initialization routine, these declarations
- * explicitly don't use EXTERN since this code does not get compiled
- * into the library:
- */
-
-extern int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
-extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
-
-/*
*----------------------------------------------------------------------
*
* Tcltest_Init --
*
- * This procedure performs application-specific initialization.
- * Most applications, especially those that incorporate additional
- * packages, will have their own version of this procedure.
+ * This procedure performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this procedure.
*
* Results:
- * Returns a standard Tcl completion code, and leaves an error
- * message in the interp's result if an error occurs.
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -565,166 +522,187 @@ extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
*/
int
-Tcltest_Init(interp)
- Tcl_Interp *interp; /* Interpreter for application. */
+Tcltest_Init(
+ Tcl_Interp *interp) /* Interpreter for application. */
{
+#ifndef TCL_NO_DEPRECATED
Tcl_ValueType t3ArgTypes[2];
+#endif /* TCL_NO_DEPRECATED */
Tcl_Obj *listPtr;
Tcl_Obj **objv;
int objc, index;
- static CONST char *specialOptions[] = {
+ static const char *const specialOptions[] = {
"-appinitprocerror", "-appinitprocdeleteinterp",
- "-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
+ "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
};
- if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
- return TCL_ERROR;
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_OOInitStubs(interp) == NULL) {
+ return TCL_ERROR;
+ }
+ /* TIP #268: Full patchlevel instead of just major.minor */
+
+ if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+ return TCL_ERROR;
}
/*
* Create additional commands and math functions for testing Tcl.
*/
- Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
- TestGetIndexFromObjStructObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ TestGetIndexFromObjStructObjCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
+ NULL);
+ Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
+ NULL);
Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
+ NULL, NULL);
Tcl_DStringInit(&dstring);
- Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
+ NULL);
+ Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL,
+ NULL);
Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand( interp, "testevent", TesteventObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd,
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL,
+ NULL);
+ Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testhashsystemhash",
- TestHashSystemHashCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ TestHashSystemHashCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetvarfullname",
- TestgetvarfullnameCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ TestgetvarfullnameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testopenfilechannelproc",
- TestopenfilechannelprocCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
+ NULL);
+ Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+#ifndef TCL_NO_DEPRECATED
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+#endif /* TCL_NO_DEPRECATED */
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
- (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL);
+ (ClientData) TCL_LEAVE_ERR_MSG, NULL);
+ Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
+ (ClientData) TCL_LEAVE_ERR_MSG, NULL);
Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
- TestsetobjerrorcodeCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
+ TestsetobjerrorcodeCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
- TestNumUtfCharsCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
- TesttranslatefilenameCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc,
- (ClientData) 123);
- Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc,
- (ClientData) 345);
- Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ TesttranslatefilenameCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
+#ifndef TCL_NO_DEPRECATED
+ Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
+ Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
+#endif /* TCL_NO_DEPRECATED */
+ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
+ NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
- (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
- (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+#if defined(HAVE_CPUID) || defined(_WIN32)
+ Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
+ (ClientData) 0, NULL);
+#endif
+#ifndef TCL_NO_DEPRECATED
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
- (ClientData) 0);
+ NULL);
+#endif /* TCL_NO_DEPRECATED */
+
+ Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
+ NULL, NULL);
+ if (TclObjTest_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Procbodytest_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
#ifdef TCL_THREADS
if (TclThread_Init(interp) != TCL_OK) {
return TCL_ERROR;
@@ -737,42 +715,68 @@ Tcltest_Init(interp)
listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
if (listPtr != NULL) {
- if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
- }
- if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
+ }
+ if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
TCL_EXACT, &index) == TCL_OK)) {
switch (index) {
- case 0: {
- return TCL_ERROR;
- }
- case 1: {
- Tcl_DeleteInterp(interp);
- return TCL_ERROR;
- }
- case 2: {
- int mode;
- Tcl_UnregisterChannel(interp,
- Tcl_GetChannel(interp, "stderr", &mode));
- return TCL_ERROR;
- }
- case 3: {
- if (objc-1) {
- Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL,
- objv[1], TCL_GLOBAL_ONLY);
- }
- return TCL_ERROR;
- }
+ case 0:
+ return TCL_ERROR;
+ case 1:
+ Tcl_DeleteInterp(interp);
+ return TCL_ERROR;
+ case 2: {
+ int mode;
+ Tcl_UnregisterChannel(interp,
+ Tcl_GetChannel(interp, "stderr", &mode));
+ return TCL_ERROR;
}
- }
+ case 3:
+ if (objc-1) {
+ Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1],
+ TCL_GLOBAL_ONLY);
+ }
+ return TCL_ERROR;
+ }
+ }
}
-
+
/*
* And finally add any platform specific test commands.
*/
-
+
return TclplatformtestInit(interp);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcltest_SafeInit --
+ *
+ * This procedure performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcltest_SafeInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ return Procbodytest_SafeInit(interp);
+}
/*
*----------------------------------------------------------------------
@@ -793,16 +797,15 @@ Tcltest_Init(interp)
/* ARGSUSED */
static int
-TestasyncCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestasyncCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
static int nextId = 1;
- char buf[TCL_INTEGER_SPACE];
if (argc < 2) {
wrongNumArgs:
@@ -813,26 +816,29 @@ TestasyncCmd(dummy, interp, argc, argv)
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;
- TclFormatInt(buf, asyncPtr->id);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ 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) {
@@ -841,6 +847,7 @@ TestasyncCmd(dummy, interp, argc, argv)
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) {
@@ -853,9 +860,10 @@ TestasyncCmd(dummy, interp, argc, argv)
}
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;
@@ -864,6 +872,7 @@ TestasyncCmd(dummy, interp, argc, argv)
|| (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) {
@@ -871,7 +880,8 @@ TestasyncCmd(dummy, interp, argc, argv)
break;
}
}
- Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
+ Tcl_MutexUnlock(&asyncTestMutex);
return code;
#ifdef TCL_THREADS
} else if (strcmp(argv[1], "marklater") == 0) {
@@ -881,29 +891,30 @@ TestasyncCmd(dummy, interp, argc, argv)
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",
- (char *) NULL);
+ "\": must be create, delete, int, mark, or marklater", NULL);
return TCL_ERROR;
#else /* !TCL_THREADS */
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create, delete, int, or mark",
- (char *) NULL);
+ "\": must be create, delete, int, or mark", NULL);
return TCL_ERROR;
#endif
}
@@ -911,16 +922,30 @@ TestasyncCmd(dummy, interp, argc, argv)
}
static int
-AsyncHandlerProc(clientData, interp, code)
- ClientData clientData; /* Pointer to TestAsyncHandler structure. */
- Tcl_Interp *interp; /* Interpreter in which command was
+AsyncHandlerProc(
+ 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. */
+ int code) /* Current return code from command. */
{
- TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
- CONST char *listArgv[4], *cmd;
+ 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));
@@ -931,12 +956,11 @@ AsyncHandlerProc(clientData, interp, code)
code = Tcl_Eval(interp, cmd);
} else {
/*
- * this should not happen, but by definition of how async
- * handlers are invoked, it's possible. Better error
- * checking is needed here.
+ * this should not happen, but by definition of how async handlers are
+ * invoked, it's possible. Better error checking is needed here.
*/
}
- ckfree((char *)cmd);
+ ckfree(cmd);
return code;
}
@@ -958,13 +982,23 @@ AsyncHandlerProc(clientData, interp, code)
#ifdef TCL_THREADS
static Tcl_ThreadCreateType
-AsyncThreadProc(clientData)
- ClientData clientData; /* Parameter is a pointer to a
+AsyncThreadProc(
+ 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;
}
@@ -975,9 +1009,9 @@ AsyncThreadProc(clientData)
*
* TestcmdinfoCmd --
*
- * This procedure implements the "testcmdinfo" command. It is used
- * to test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation
- * and deletion.
+ * This procedure implements the "testcmdinfo" command. It is used to
+ * test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
+ * deletion.
*
* Results:
* A standard Tcl result.
@@ -990,17 +1024,17 @@ AsyncThreadProc(clientData)
/* ARGSUSED */
static int
-TestcmdinfoCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestcmdinfoCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_CmdInfo info;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option cmdName\"", (char *) NULL);
+ " option cmdName\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
@@ -1017,45 +1051,43 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
}
if (info.proc == CmdProc1) {
Tcl_AppendResult(interp, "CmdProc1", " ",
- (char *) info.clientData, (char *) NULL);
+ (char *) info.clientData, NULL);
} else if (info.proc == CmdProc2) {
Tcl_AppendResult(interp, "CmdProc2", " ",
- (char *) info.clientData, (char *) NULL);
+ (char *) info.clientData, NULL);
} else {
- Tcl_AppendResult(interp, "unknown", (char *) NULL);
+ Tcl_AppendResult(interp, "unknown", NULL);
}
if (info.deleteProc == CmdDelProc1) {
Tcl_AppendResult(interp, " CmdDelProc1", " ",
- (char *) info.deleteData, (char *) NULL);
+ (char *) info.deleteData, NULL);
} else if (info.deleteProc == CmdDelProc2) {
Tcl_AppendResult(interp, " CmdDelProc2", " ",
- (char *) info.deleteData, (char *) NULL);
+ (char *) info.deleteData, NULL);
} else {
- Tcl_AppendResult(interp, " unknown", (char *) NULL);
+ Tcl_AppendResult(interp, " unknown", NULL);
}
- Tcl_AppendResult(interp, " ", info.namespacePtr->fullName,
- (char *) NULL);
+ Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
if (info.isNativeObjectProc) {
- Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL);
+ Tcl_AppendResult(interp, " nativeObjectProc", NULL);
} else {
- Tcl_AppendResult(interp, " stringProc", (char *) NULL);
+ Tcl_AppendResult(interp, " stringProc", NULL);
}
} else if (strcmp(argv[1], "modify") == 0) {
info.proc = CmdProc2;
info.clientData = (ClientData) "new_command_data";
info.objProc = NULL;
- info.objClientData = (ClientData) NULL;
+ info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (ClientData) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
- Tcl_SetResult(interp, "0", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
} else {
- Tcl_SetResult(interp, "1", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create, delete, get, or modify",
- (char *) NULL);
+ "\": must be create, delete, get, or modify", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1063,33 +1095,31 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
/*ARGSUSED*/
static int
-CmdProc1(clientData, interp, argc, argv)
- ClientData clientData; /* String to return. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
- (char *) NULL);
+CmdProc1(
+ ClientData clientData, /* String to return. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL);
return TCL_OK;
}
/*ARGSUSED*/
static int
-CmdProc2(clientData, interp, argc, argv)
- ClientData clientData; /* String to return. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
- (char *) NULL);
+CmdProc2(
+ ClientData clientData, /* String to return. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
return TCL_OK;
}
static void
-CmdDelProc1(clientData)
- ClientData clientData; /* String to save. */
+CmdDelProc1(
+ ClientData clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
@@ -1097,8 +1127,8 @@ CmdDelProc1(clientData)
}
static void
-CmdDelProc2(clientData)
- ClientData clientData; /* String to save. */
+CmdDelProc2(
+ ClientData clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
@@ -1110,9 +1140,8 @@ CmdDelProc2(clientData)
*
* TestcmdtokenCmd --
*
- * This procedure implements the "testcmdtoken" command. It is used
- * to test Tcl_Command tokens and procedures such as
- * Tcl_GetCommandFullName.
+ * This procedure implements the "testcmdtoken" command. It is used to
+ * test Tcl_Command tokens and procedures such as Tcl_GetCommandFullName.
*
* Results:
* A standard Tcl result.
@@ -1125,11 +1154,11 @@ CmdDelProc2(clientData)
/* ARGSUSED */
static int
-TestcmdtokenCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestcmdtokenCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_Command token;
int *l;
@@ -1137,20 +1166,20 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option arg\"", (char *) NULL);
+ " option arg\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
- (ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
- sprintf(buf, "%p", (VOID *)token);
+ (ClientData) "original", NULL);
+ sprintf(buf, "%p", (void *)token);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
if (sscanf(argv[2], "%p", &l) != 1) {
Tcl_AppendResult(interp, "bad command token \"", argv[2],
- "\"", (char *) NULL);
+ "\"", NULL);
return TCL_ERROR;
}
@@ -1158,12 +1187,12 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
Tcl_AppendElement(interp,
- Tcl_GetCommandName(interp, (Tcl_Command) l));
+ Tcl_GetCommandName(interp, (Tcl_Command) l));
Tcl_AppendElement(interp, Tcl_GetString(objPtr));
Tcl_DecrRefCount(objPtr);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create or name", (char *) NULL);
+ "\": must be create or name", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1189,25 +1218,24 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
/* ARGSUSED */
static int
-TestcmdtraceCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestcmdtraceCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_DString buffer;
int result;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option script\"", (char *) NULL);
+ " option script\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "tracetest") == 0) {
Tcl_DStringInit(&buffer);
- cmdTrace = Tcl_CreateTrace(interp, 50000,
- (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
result = Tcl_Eval(interp, argv[2]);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
@@ -1218,19 +1246,18 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
} else if (strcmp(argv[1], "deletetest") == 0) {
/*
* Create a command trace then eval a script to check whether it is
- * called. Note that this trace procedure removes itself as a
- * further check of the robustness of the trace proc calling code in
- * TclExecuteByteCode.
+ * called. Note that this trace procedure removes itself as a further
+ * check of the robustness of the trace proc calling code in
+ * TclNRExecuteByteCode.
*/
-
- cmdTrace = Tcl_CreateTrace(interp, 50000,
- (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
+
+ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
Tcl_Eval(interp, argv[2]);
} else if (strcmp(argv[1], "leveltest") == 0) {
Interp *iPtr = (Interp *) interp;
Tcl_DStringInit(&buffer);
- cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4,
- (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+ cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
+ &buffer);
result = Tcl_Eval(interp, argv[2]);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
@@ -1238,50 +1265,61 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
}
Tcl_DeleteTrace(interp, cmdTrace);
Tcl_DStringFree(&buffer);
- } else if ( strcmp(argv[1], "resulttest" ) == 0 ) {
+ } else if (strcmp(argv[1], "resulttest") == 0) {
/* Create an object-based trace, then eval a script. This is used
* to test return codes other than TCL_OK from the trace engine.
*/
+
static int deleteCalled;
+
deleteCalled = 0;
- cmdTrace = Tcl_CreateObjTrace( interp, 50000,
- TCL_ALLOW_INLINE_COMPILATION,
- ObjTraceProc,
- (ClientData) &deleteCalled,
- ObjTraceDeleteProc );
- result = Tcl_Eval( interp, argv[ 2 ] );
- Tcl_DeleteTrace( interp, cmdTrace );
- if ( !deleteCalled ) {
- Tcl_SetResult( interp, "Delete wasn't called", TCL_STATIC );
+ cmdTrace = Tcl_CreateObjTrace(interp, 50000,
+ TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
+ (ClientData) &deleteCalled, ObjTraceDeleteProc);
+ result = Tcl_Eval(interp, argv[2]);
+ Tcl_DeleteTrace(interp, cmdTrace);
+ if (!deleteCalled) {
+ Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
return TCL_ERROR;
} else {
return result;
}
-
+ } else if (strcmp(argv[1], "doubletest") == 0) {
+ Tcl_Trace t1, t2;
+
+ Tcl_DStringInit(&buffer);
+ t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
+ t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
+ result = Tcl_Eval(interp, argv[2]);
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
+ }
+ Tcl_DeleteTrace(interp, t2);
+ Tcl_DeleteTrace(interp, t1);
+ Tcl_DStringFree(&buffer);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be tracetest, deletetest or resulttest",
- (char *) NULL);
+ "\": must be tracetest, deletetest, doubletest or resulttest", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static void
-CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
- argc, argv)
- ClientData clientData; /* Pointer to buffer in which the
+CmdTraceProc(
+ ClientData clientData, /* Pointer to buffer in which the
* command and arguments are appended.
* Accumulates test result. */
- Tcl_Interp *interp; /* Current interpreter. */
- int level; /* Current trace level. */
- char *command; /* The command being traced (after
+ Tcl_Interp *interp, /* Current interpreter. */
+ int level, /* Current trace level. */
+ char *command, /* The command being traced (after
* substitutions). */
- Tcl_CmdProc *cmdProc; /* Points to command's command procedure. */
- ClientData cmdClientData; /* Client data associated with command
+ Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */
+ ClientData cmdClientData, /* Client data associated with command
* procedure. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int argc, /* Number of arguments. */
+ const char *argv[]) /* Argument strings. */
{
Tcl_DString *bufPtr = (Tcl_DString *) clientData;
int i;
@@ -1296,49 +1334,49 @@ CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
}
static void
-CmdTraceDeleteProc(clientData, interp, level, command, cmdProc,
- cmdClientData, argc, argv)
- ClientData clientData; /* Unused. */
- Tcl_Interp *interp; /* Current interpreter. */
- int level; /* Current trace level. */
- char *command; /* The command being traced (after
+CmdTraceDeleteProc(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int level, /* Current trace level. */
+ char *command, /* The command being traced (after
* substitutions). */
- Tcl_CmdProc *cmdProc; /* Points to command's command procedure. */
- ClientData cmdClientData; /* Client data associated with command
+ Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */
+ ClientData cmdClientData, /* Client data associated with command
* procedure. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int argc, /* Number of arguments. */
+ const char *argv[]) /* Argument strings. */
{
/*
- * Remove ourselves to test whether calling Tcl_DeleteTrace within
- * a trace callback causes the for loop in TclExecuteByteCode that
- * calls traces to reference freed memory.
+ * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
+ * callback causes the for loop in TclNRExecuteByteCode that calls traces to
+ * reference freed memory.
*/
-
+
Tcl_DeleteTrace(interp, cmdTrace);
}
static int
-ObjTraceProc( clientData, interp, level, command, token, objc, objv )
- ClientData clientData; /* unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int level; /* Execution level */
- CONST char* command; /* Command being executed */
- Tcl_Command token; /* Command information */
- int objc; /* Parameter count */
- Tcl_Obj *CONST objv[]; /* Parameter list */
-{
- CONST char* word = Tcl_GetString( objv[ 0 ] );
- if ( !strcmp( word, "Error" ) ) {
- Tcl_SetObjResult( interp, Tcl_NewStringObj( command, -1 ) );
+ObjTraceProc(
+ ClientData clientData, /* unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int level, /* Execution level */
+ const char *command, /* Command being executed */
+ Tcl_Command token, /* Command information */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter list */
+{
+ const char *word = Tcl_GetString(objv[0]);
+
+ if (!strcmp(word, "Error")) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
return TCL_ERROR;
- } else if ( !strcmp( word, "Break" ) ) {
+ } else if (!strcmp(word, "Break")) {
return TCL_BREAK;
- } else if ( !strcmp( word, "Continue" ) ) {
+ } else if (!strcmp(word, "Continue")) {
return TCL_CONTINUE;
- } else if ( !strcmp( word, "Return" ) ) {
+ } else if (!strcmp(word, "Return")) {
return TCL_RETURN;
- } else if ( !strcmp( word, "OtherStatus" ) ) {
+ } else if (!strcmp(word, "OtherStatus")) {
return 6;
} else {
return TCL_OK;
@@ -1346,10 +1384,10 @@ ObjTraceProc( clientData, interp, level, command, token, objc, objv )
}
static void
-ObjTraceDeleteProc( clientData )
- ClientData clientData;
+ObjTraceDeleteProc(
+ ClientData clientData)
{
- int * intPtr = (int *) clientData;
+ int *intPtr = (int *) clientData;
*intPtr = 1; /* Record that the trace was deleted */
}
@@ -1358,11 +1396,11 @@ ObjTraceDeleteProc( clientData )
*
* TestcreatecommandCmd --
*
- * This procedure implements the "testcreatecommand" command. It is
- * used to test that the Tcl_CreateCommand creates a new command in
- * the namespace specified as part of its name, if any. It also
- * checks that the namespace code ignore single ":"s in the middle
- * or end of a command name.
+ * This procedure implements the "testcreatecommand" command. It is used
+ * to test that the Tcl_CreateCommand creates a new command in the
+ * namespace specified as part of its name, if any. It also checks that
+ * the namespace code ignore single ":"s in the middle or end of a
+ * command name.
*
* Results:
* A standard Tcl result.
@@ -1375,44 +1413,41 @@ ObjTraceDeleteProc( clientData )
*/
static int
-TestcreatecommandCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestcreatecommandCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option\"", (char *) NULL);
+ " option\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
- CreatedCommandProc, (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
+ CreatedCommandProc, NULL, NULL);
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
} else if (strcmp(argv[1], "create2") == 0) {
Tcl_CreateCommand(interp, "value:at:",
- CreatedCommandProc2, (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
+ CreatedCommandProc2, NULL, NULL);
} else if (strcmp(argv[1], "delete2") == 0) {
Tcl_DeleteCommand(interp, "value:at:");
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create, delete, create2, or delete2",
- (char *) NULL);
+ "\": must be create, delete, create2, or delete2", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static int
-CreatedCommandProc(clientData, interp, argc, argv)
- ClientData clientData; /* String to return. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+CreatedCommandProc(
+ ClientData clientData, /* String to return. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -1421,20 +1456,20 @@ CreatedCommandProc(clientData, interp, argc, argv)
&info);
if (!found) {
Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
- (char *) NULL);
+ NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "CreatedCommandProc in ",
- info.namespacePtr->fullName, (char *) NULL);
+ info.namespacePtr->fullName, NULL);
return TCL_OK;
}
static int
-CreatedCommandProc2(clientData, interp, argc, argv)
- ClientData clientData; /* String to return. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+CreatedCommandProc2(
+ ClientData clientData, /* String to return. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -1442,11 +1477,11 @@ CreatedCommandProc2(clientData, interp, argc, argv)
found = Tcl_GetCommandInfo(interp, "value:at:", &info);
if (!found) {
Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
- (char *) NULL);
+ NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
- info.namespacePtr->fullName, (char *) NULL);
+ info.namespacePtr->fullName, NULL);
return TCL_OK;
}
@@ -1469,11 +1504,11 @@ CreatedCommandProc2(clientData, interp, argc, argv)
/* ARGSUSED */
static int
-TestdcallCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestdcallCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int i, id;
@@ -1485,10 +1520,10 @@ TestdcallCmd(dummy, interp, argc, argv)
}
if (id < 0) {
Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
- (ClientData) (-id));
+ (ClientData) INT2PTR(-id));
} else {
Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
- (ClientData) id);
+ (ClientData) INT2PTR(id));
}
}
Tcl_DeleteInterp(delInterp);
@@ -1501,12 +1536,11 @@ TestdcallCmd(dummy, interp, argc, argv)
*/
static void
-DelCallbackProc(clientData, interp)
- ClientData clientData; /* Numerical value to append to
- * delString. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+DelCallbackProc(
+ ClientData clientData, /* Numerical value to append to delString. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
- int id = (int) clientData;
+ int id = PTR2INT(clientData);
char buffer[TCL_INTEGER_SPACE];
TclFormatInt(buffer, id);
@@ -1521,25 +1555,25 @@ DelCallbackProc(clientData, interp)
*
* TestdelCmd --
*
- * This procedure implements the "testdcall" command. It is used
- * to test Tcl_CallWhenDeleted.
+ * This procedure implements the "testdel" command. It is used
+ * to test calling of command deletion callbacks.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Creates and deletes interpreters.
+ * Creates a command.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
-TestdelCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestdelCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
@@ -1554,9 +1588,9 @@ TestdelCmd(dummy, interp, argc, argv)
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,
@@ -1565,30 +1599,30 @@ TestdelCmd(dummy, interp, argc, argv)
}
static int
-DelCmdProc(clientData, interp, argc, argv)
- ClientData clientData; /* String result to return. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+DelCmdProc(
+ ClientData clientData, /* String result to return. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
DelCmd *dPtr = (DelCmd *) clientData;
- Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL);
+ Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
ckfree(dPtr->deleteCmd);
- ckfree((char *) dPtr);
+ ckfree(dPtr);
return TCL_OK;
}
static void
-DelDeleteProc(clientData)
- ClientData clientData; /* String command to evaluate. */
+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);
}
/*
@@ -1610,22 +1644,118 @@ DelDeleteProc(clientData)
*/
static int
-TestdelassocdataCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestdelassocdataCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " data_key\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " data_key\"", NULL);
+ return TCL_ERROR;
}
Tcl_DeleteAssocData(interp, argv[1]);
return TCL_OK;
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 --
@@ -1644,11 +1774,11 @@ TestdelassocdataCmd(clientData, interp, argc, argv)
/* ARGSUSED */
static int
-TestdstringCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestdstringCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int count;
@@ -1694,28 +1824,26 @@ TestdstringCmd(dummy, interp, argc, argv)
} 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) {
- Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
- strcpy(interp->result, "This is a malloc-ed string");
+ 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) {
- interp->result = (char *) ckalloc(100);
- interp->result += 4;
- interp->freeProc = SpecialFree;
- strcpy(interp->result, "This is a specially-allocated string");
+ char *s = (char*)ckalloc(100) + 16;
+ strcpy(s, "This is a specially-allocated string");
+ Tcl_SetResult(interp, s, SpecialFree);
} else {
Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
"\": must be staticsmall, staticlarge, free, or special",
- (char *) NULL);
+ NULL);
return TCL_ERROR;
}
Tcl_DStringGetResult(interp, &dstring);
} else if (strcmp(argv[1], "length") == 0) {
- char buf[TCL_INTEGER_SPACE];
-
+
if (argc != 2) {
goto wrongNumArgs;
}
- TclFormatInt(buf, Tcl_DStringLength(&dstring));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
@@ -1728,7 +1856,7 @@ TestdstringCmd(dummy, interp, argc, argv)
if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_DStringTrunc(&dstring, count);
+ Tcl_DStringSetLength(&dstring, count);
} else if (strcmp(argv[1], "start") == 0) {
if (argc != 2) {
goto wrongNumArgs;
@@ -1736,8 +1864,8 @@ TestdstringCmd(dummy, interp, argc, argv)
Tcl_DStringStartSublist(&dstring);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be append, element, end, free, get, length, ",
- "result, trunc, or start", (char *) NULL);
+ "\": must be append, element, end, free, get, length, "
+ "result, trunc, or start", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1751,7 +1879,7 @@ TestdstringCmd(dummy, interp, argc, argv)
static void SpecialFree(blockPtr)
char *blockPtr; /* Block to free. */
{
- ckfree(blockPtr - 4);
+ ckfree(blockPtr - 16);
}
/*
@@ -1773,92 +1901,82 @@ static void SpecialFree(blockPtr)
/* ARGSUSED */
static int
-TestencodingObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestencodingObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
int index, length;
- char *string;
+ const char *string;
TclEncoding *encodingPtr;
- static CONST char *optionStrings[] = {
- "create", "delete", "path",
- NULL
+ static const char *const optionStrings[] = {
+ "create", "delete", NULL
};
enum options {
- ENC_CREATE, ENC_DELETE, ENC_PATH
+ ENC_CREATE, ENC_DELETE
};
-
+
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
- case ENC_CREATE: {
- Tcl_EncodingType type;
+ case ENC_CREATE: {
+ Tcl_EncodingType type;
- if (objc != 5) {
- return TCL_ERROR;
- }
- encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
- encodingPtr->interp = interp;
+ if (objc != 5) {
+ return TCL_ERROR;
+ }
+ encodingPtr = ckalloc(sizeof(TclEncoding));
+ encodingPtr->interp = interp;
- string = Tcl_GetStringFromObj(objv[3], &length);
- encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
- memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
+ string = Tcl_GetStringFromObj(objv[3], &length);
+ 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));
- memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
+ string = Tcl_GetStringFromObj(objv[4], &length);
+ encodingPtr->fromUtfCmd = ckalloc(length + 1);
+ memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
- string = Tcl_GetStringFromObj(objv[2], &length);
+ string = Tcl_GetStringFromObj(objv[2], &length);
- type.encodingName = string;
- type.toUtfProc = EncodingToUtfProc;
- type.fromUtfProc = EncodingFromUtfProc;
- type.freeProc = EncodingFreeProc;
- type.clientData = (ClientData) encodingPtr;
- type.nullSize = 1;
+ type.encodingName = string;
+ type.toUtfProc = EncodingToUtfProc;
+ type.fromUtfProc = EncodingFromUtfProc;
+ type.freeProc = EncodingFreeProc;
+ type.clientData = (ClientData) encodingPtr;
+ type.nullSize = 1;
- Tcl_CreateEncoding(&type);
- break;
- }
- case ENC_DELETE: {
- if (objc != 3) {
- return TCL_ERROR;
- }
- encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
- Tcl_FreeEncoding(encoding);
- Tcl_FreeEncoding(encoding);
- break;
- }
- case ENC_PATH: {
- if (objc == 2) {
- Tcl_SetObjResult(interp, TclGetEncodingSearchPath());
- } else {
- TclSetEncodingSearchPath(objv[2]);
- }
- break;
+ Tcl_CreateEncoding(&type);
+ break;
+ }
+ case ENC_DELETE:
+ if (objc != 3) {
+ return TCL_ERROR;
}
+ encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
+ Tcl_FreeEncoding(encoding);
+ Tcl_FreeEncoding(encoding);
+ break;
}
return TCL_OK;
}
-static int
-EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* TclEncoding structure. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Current state. */
- char *dst; /* Output buffer. */
- int dstLen; /* The maximum length of output buffer. */
- int *srcReadPtr; /* Filled with number of bytes read. */
- int *dstWrotePtr; /* Filled with number of bytes stored. */
- int *dstCharsPtr; /* Filled with number of chars stored. */
+
+static int
+EncodingToUtfProc(
+ ClientData clientData, /* TclEncoding structure. */
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Current state. */
+ char *dst, /* Output buffer. */
+ int dstLen, /* The maximum length of output buffer. */
+ int *srcReadPtr, /* Filled with number of bytes read. */
+ int *dstWrotePtr, /* Filled with number of bytes stored. */
+ int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
@@ -1878,19 +1996,19 @@ EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*dstCharsPtr = len;
return TCL_OK;
}
-static int
-EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
- srcReadPtr, dstWrotePtr, dstCharsPtr)
- ClientData clientData; /* TclEncoding structure. */
- CONST char *src; /* Source string in specified encoding. */
- int srcLen; /* Source string length in bytes. */
- int flags; /* Conversion control flags. */
- Tcl_EncodingState *statePtr;/* Current state. */
- char *dst; /* Output buffer. */
- int dstLen; /* The maximum length of output buffer. */
- int *srcReadPtr; /* Filled with number of bytes read. */
- int *dstWrotePtr; /* Filled with number of bytes stored. */
- int *dstCharsPtr; /* Filled with number of chars stored. */
+
+static int
+EncodingFromUtfProc(
+ ClientData clientData, /* TclEncoding structure. */
+ const char *src, /* Source string in specified encoding. */
+ int srcLen, /* Source string length in bytes. */
+ int flags, /* Conversion control flags. */
+ Tcl_EncodingState *statePtr,/* Current state. */
+ char *dst, /* Output buffer. */
+ int dstLen, /* The maximum length of output buffer. */
+ int *srcReadPtr, /* Filled with number of bytes read. */
+ int *dstWrotePtr, /* Filled with number of bytes stored. */
+ int *dstCharsPtr) /* Filled with number of chars stored. */
{
int len;
TclEncoding *encodingPtr;
@@ -1910,16 +2028,16 @@ EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
*dstCharsPtr = len;
return TCL_OK;
}
+
static void
-EncodingFreeProc(clientData)
- ClientData clientData; /* ClientData associated with type. */
+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);
}
/*
@@ -1940,31 +2058,31 @@ EncodingFreeProc(clientData)
*/
static int
-TestevalexObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestevalexObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int length, flags;
- char *script;
+ const char *script;
flags = 0;
if (objc == 3) {
- char *global = Tcl_GetStringFromObj(objv[2], &length);
+ const char *global = Tcl_GetStringFromObj(objv[2], &length);
if (strcmp(global, "global") != 0) {
Tcl_AppendResult(interp, "bad value \"", global,
- "\": must be global", (char *) NULL);
+ "\": must be global", NULL);
return TCL_ERROR;
}
flags = TCL_EVAL_GLOBAL;
} else if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
script = Tcl_GetStringFromObj(objv[1], &length);
- return Tcl_EvalEx(interp, script, length, flags);
+ return Tcl_EvalEx(interp, script, length, flags);
}
/*
@@ -1985,17 +2103,17 @@ TestevalexObjCmd(dummy, interp, objc, objv)
*/
static int
-TestevalobjvObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestevalobjvObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int evalGlobal;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) {
return TCL_ERROR;
@@ -2034,74 +2152,67 @@ TestevalobjvObjCmd(dummy, interp, objc, objv)
*/
static int
-TesteventObjCmd( ClientData unused, /* Not used */
- Tcl_Interp* interp, /* Tcl interpreter */
- int objc, /* Parameter count */
- Tcl_Obj *CONST objv[] ) /* Parameter vector */
-{
-
- static CONST char* subcommands[] = { /* Possible subcommands */
- "queue",
- "delete",
- NULL
+TesteventObjCmd(
+ ClientData unused, /* Not used */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter vector */
+{
+ static const char *const subcommands[] = { /* Possible subcommands */
+ "queue", "delete", NULL
};
int subCmdIndex; /* Index of the chosen subcommand */
- static CONST char* positions[] = { /* Possible queue positions */
- "head",
- "tail",
- "mark",
- NULL
+ static const char *const positions[] = { /* Possible queue positions */
+ "head", "tail", "mark", NULL
};
int posIndex; /* Index of the chosen position */
- static CONST Tcl_QueuePosition posNum[] = {
+ static const Tcl_QueuePosition posNum[] = {
/* Interpretation of the chosen position */
TCL_QUEUE_HEAD,
TCL_QUEUE_TAIL,
TCL_QUEUE_MARK
};
- TestEvent* ev; /* Event to be queued */
+ TestEvent *ev; /* Event to be queued */
- if ( objc < 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "subcommand ?args?" );
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
return TCL_ERROR;
}
- if ( Tcl_GetIndexFromObj( interp, objv[1], subcommands, "subcommand",
- TCL_EXACT, &subCmdIndex ) != TCL_OK ) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
+ TCL_EXACT, &subCmdIndex) != TCL_OK) {
return TCL_ERROR;
}
- switch ( subCmdIndex ) {
+ switch (subCmdIndex) {
case 0: /* queue */
- if ( objc != 5 ) {
- Tcl_WrongNumArgs( interp, 2, objv, "name position script" );
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name position script");
return TCL_ERROR;
}
- if ( Tcl_GetIndexFromObj( interp, objv[3], positions,
- "position specifier", TCL_EXACT,
- &posIndex ) != TCL_OK ) {
+ if (Tcl_GetIndexFromObj(interp, objv[3], positions,
+ "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;
- ev->command = objv[ 4 ];
- Tcl_IncrRefCount( ev->command );
- ev->tag = objv[ 2 ];
- Tcl_IncrRefCount( ev->tag );
- Tcl_QueueEvent( (Tcl_Event*) ev, posNum[ posIndex ] );
+ ev->command = objv[4];
+ Tcl_IncrRefCount(ev->command);
+ ev->tag = objv[2];
+ Tcl_IncrRefCount(ev->tag);
+ Tcl_QueueEvent((Tcl_Event *) ev, posNum[posIndex]);
break;
case 1: /* delete */
- if ( objc != 3 ) {
- Tcl_WrongNumArgs( interp, 2, objv, "name" );
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
return TCL_ERROR;
}
- Tcl_DeleteEvents( TesteventDeleteProc, objv[ 2 ] );
+ Tcl_DeleteEvents(TesteventDeleteProc, objv[2]);
break;
}
return TCL_OK;
-
}
/*
@@ -2111,49 +2222,49 @@ TesteventObjCmd( ClientData unused, /* Not used */
*
* Delivers a test event to the Tcl interpreter as part of event
* queue testing.
- *
+ *
* Results:
* Returns 1 if the event has been serviced, 0 otherwise.
*
* Side effects:
- * Evaluates the event's callback script, so has whatever
- * side effects the callback has. The return value of the
- * callback script becomes the return value of this function.
- * If the callback script reports an error, it is reported as
- * a background error.
+ * Evaluates the event's callback script, so has whatever side effects
+ * the callback has. The return value of the callback script becomes the
+ * return value of this function. If the callback script reports an
+ * error, it is reported as a background error.
*
*----------------------------------------------------------------------
*/
static int
-TesteventProc( Tcl_Event* event, /* Event to deliver */
- int flags ) /* Current flags for Tcl_ServiceEvent */
-{
- TestEvent * ev = (TestEvent *) event;
- Tcl_Interp* interp = ev->interp;
- Tcl_Obj* command = ev->command;
- int result = Tcl_EvalObjEx( interp, command,
- TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT );
+TesteventProc(
+ Tcl_Event *event, /* Event to deliver */
+ int flags) /* Current flags for Tcl_ServiceEvent */
+{
+ TestEvent *ev = (TestEvent *) event;
+ Tcl_Interp *interp = ev->interp;
+ Tcl_Obj *command = ev->command;
+ int result = Tcl_EvalObjEx(interp, command,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
int retval;
- if ( result != TCL_OK ) {
- Tcl_AddErrorInfo( interp,
- " (command bound to \"testevent\" callback)" );
- Tcl_BackgroundError( interp );
+
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ " (command bound to \"testevent\" callback)");
+ Tcl_BackgroundError(interp);
return 1; /* Avoid looping on errors */
}
- if ( Tcl_GetBooleanFromObj( interp,
- Tcl_GetObjResult( interp ),
- &retval ) != TCL_OK ) {
- Tcl_AddErrorInfo( interp,
- " (return value from \"testevent\" callback)" );
- Tcl_BackgroundError( interp );
+ if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+ &retval) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ " (return value from \"testevent\" callback)");
+ Tcl_BackgroundError(interp);
return 1;
}
- if ( retval ) {
- Tcl_DecrRefCount( ev->tag );
- Tcl_DecrRefCount( ev->command );
+ if (retval) {
+ Tcl_DecrRefCount(ev->tag);
+ Tcl_DecrRefCount(ev->command);
}
-
+
return retval;
}
@@ -2176,25 +2287,26 @@ TesteventProc( Tcl_Event* event, /* Event to deliver */
*/
static int
-TesteventDeleteProc( Tcl_Event* event, /* Event to examine */
- ClientData clientData ) /* Tcl_Obj containing the name
- * of the event(s) to remove */
+TesteventDeleteProc(
+ Tcl_Event *event, /* Event to examine */
+ ClientData clientData) /* Tcl_Obj containing the name of the event(s)
+ * to remove */
{
- TestEvent* ev; /* Event to examine */
- char* evNameStr;
- Tcl_Obj* targetName; /* Name of the event(s) to delete */
- char* targetNameStr;
+ TestEvent *ev; /* Event to examine */
+ const char *evNameStr;
+ Tcl_Obj *targetName; /* Name of the event(s) to delete */
+ const char *targetNameStr;
- if ( event->proc != TesteventProc ) {
+ if (event->proc != TesteventProc) {
return 0;
}
- targetName = (Tcl_Obj*) clientData;
- targetNameStr = (char*) Tcl_GetStringFromObj( targetName, NULL );
- ev = (TestEvent*) event;
- evNameStr = Tcl_GetStringFromObj( ev->tag, NULL );
- if ( strcmp( evNameStr, targetNameStr ) == 0 ) {
- Tcl_DecrRefCount( ev->tag );
- Tcl_DecrRefCount( ev->command );
+ targetName = (Tcl_Obj *) clientData;
+ targetNameStr = (char *) Tcl_GetStringFromObj(targetName, NULL);
+ ev = (TestEvent *) event;
+ evNameStr = Tcl_GetStringFromObj(ev->tag, NULL);
+ if (strcmp(evNameStr, targetNameStr) == 0) {
+ Tcl_DecrRefCount(ev->tag);
+ Tcl_DecrRefCount(ev->command);
return 1;
} else {
return 0;
@@ -2219,54 +2331,62 @@ TesteventDeleteProc( Tcl_Event* event, /* Event to examine */
*/
static int
-TestexithandlerCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestexithandlerCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int value;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " create|delete value\"", (char *) NULL);
- return TCL_ERROR;
+ " create|delete value\"", NULL);
+ return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
- (ClientData) value);
+ (ClientData) INT2PTR(value));
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
- (ClientData) value);
+ (ClientData) INT2PTR(value));
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create or delete", (char *) NULL);
+ "\": must be create or delete", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static void
-ExitProcOdd(clientData)
- ClientData clientData; /* Integer value to print. */
+ExitProcOdd(
+ ClientData clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
+ size_t len;
- sprintf(buf, "odd %d\n", (int) clientData);
- write(1, buf, strlen(buf));
+ sprintf(buf, "odd %d\n", PTR2INT(clientData));
+ len = strlen(buf);
+ if (len != (size_t) write(1, buf, len)) {
+ Tcl_Panic("ExitProcOdd: unable to write to stdout");
+ }
}
static void
-ExitProcEven(clientData)
- ClientData clientData; /* Integer value to print. */
+ExitProcEven(
+ ClientData clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
+ size_t len;
- sprintf(buf, "even %d\n", (int) clientData);
- write(1, buf, strlen(buf));
+ sprintf(buf, "even %d\n", PTR2INT(clientData));
+ len = strlen(buf);
+ if (len != (size_t) write(1, buf, len)) {
+ Tcl_Panic("ExitProcEven: unable to write to stdout");
+ }
}
/*
@@ -2287,25 +2407,25 @@ ExitProcEven(clientData)
*/
static int
-TestexprlongCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestexprlongCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " expression\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " expression\"", NULL);
+ return TCL_ERROR;
}
Tcl_SetResult(interp, "This is a result", TCL_STATIC);
result = Tcl_ExprLong(interp, argv[1], &exprResult);
if (result != TCL_OK) {
- return result;
+ return result;
}
sprintf(buf, ": %ld", exprResult);
Tcl_AppendResult(interp, buf, NULL);
@@ -2315,6 +2435,135 @@ TestexprlongCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * TestexprlongobjCmd --
+ *
+ * This procedure verifies that Tcl_ExprLongObj does not modify the
+ * interpreter result if there is no error.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprlongobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Argument objects. */
+{
+ long exprResult;
+ char buf[4 + TCL_INTEGER_SPACE];
+ int result;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "expression");
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
+ if (result != TCL_OK) {
+ return result;
+ }
+ sprintf(buf, ": %ld", exprResult);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprdoubleCmd --
+ *
+ * This procedure verifies that Tcl_ExprDouble does not modify the
+ * interpreter result if there is no error.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprdoubleCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ double exprResult;
+ char buf[4 + TCL_DOUBLE_SPACE];
+ int result;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " expression\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ result = Tcl_ExprDouble(interp, argv[1], &exprResult);
+ if (result != TCL_OK) {
+ return result;
+ }
+ strcpy(buf, ": ");
+ Tcl_PrintDouble(interp, exprResult, buf+2);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprdoubleobjCmd --
+ *
+ * This procedure verifies that Tcl_ExprLongObj does not modify the
+ * interpreter result if there is no error.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprdoubleobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Argument objects. */
+{
+ double exprResult;
+ char buf[4 + TCL_DOUBLE_SPACE];
+ int result;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "expression");
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
+ if (result != TCL_OK) {
+ return result;
+ }
+ strcpy(buf, ": ");
+ Tcl_PrintDouble(interp, exprResult, buf+2);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestexprstringCmd --
*
* This procedure tests the basic operation of Tcl_ExprString.
@@ -2329,16 +2578,16 @@ TestexprlongCmd(clientData, interp, argc, argv)
*/
static int
-TestexprstringCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestexprstringCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " expression\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " expression\"", NULL);
+ return TCL_ERROR;
}
return Tcl_ExprString(interp, argv[1]);
}
@@ -2348,9 +2597,8 @@ TestexprstringCmd(clientData, interp, argc, argv)
*
* TestfilelinkCmd --
*
- * This procedure implements the "testfilelink" command. It is used
- * to test the effects of creating and manipulating filesystem links
- * in Tcl.
+ * This procedure implements the "testfilelink" command. It is used to
+ * test the effects of creating and manipulating filesystem links in Tcl.
*
* Results:
* A standard Tcl result.
@@ -2362,11 +2610,11 @@ TestexprstringCmd(clientData, interp, argc, argv)
*/
static int
-TestfilelinkCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestfilelinkCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *contents;
@@ -2374,35 +2622,35 @@ TestfilelinkCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
return TCL_ERROR;
}
-
+
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
-
+
if (objc == 3) {
/* Create link from source to target */
- contents = Tcl_FSLink(objv[1], objv[2],
- TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK);
+ contents = Tcl_FSLink(objv[1], objv[2],
+ TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK);
if (contents == NULL) {
- Tcl_AppendResult(interp, "could not create link from \"",
- Tcl_GetString(objv[1]), "\" to \"",
- Tcl_GetString(objv[2]), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "could not create link from \"",
+ Tcl_GetString(objv[1]), "\" to \"",
+ Tcl_GetString(objv[2]), "\": ",
+ Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
} else {
/* Read link */
contents = Tcl_FSLink(objv[1], NULL, 0);
if (contents == NULL) {
- Tcl_AppendResult(interp, "could not read link \"",
- Tcl_GetString(objv[1]), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "could not read link \"",
+ Tcl_GetString(objv[1]), "\": ",
+ Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, contents);
if (objc == 2) {
- /*
+ /*
* If we are creating a link, this will actually just
* be objv[3], and we don't own it
*/
@@ -2429,22 +2677,22 @@ TestfilelinkCmd(clientData, interp, objc, objv)
*/
static int
-TestgetassocdataCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestgetassocdataCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
char *res;
-
+
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " data_key\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " data_key\"", NULL);
+ return TCL_ERROR;
}
res = (char *) Tcl_GetAssocData(interp, argv[1], NULL);
if (res != NULL) {
- Tcl_AppendResult(interp, res, NULL);
+ Tcl_AppendResult(interp, res, NULL);
}
return TCL_OK;
}
@@ -2467,21 +2715,21 @@ TestgetassocdataCmd(clientData, interp, argc, argv)
*/
static int
-TestgetplatformCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestgetplatformCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
- static CONST char *platformStrings[] = { "unix", "mac", "windows" };
+ static const char *const platformStrings[] = { "unix", "mac", "windows" };
TclPlatformType *platform;
platform = TclGetPlatform();
-
+
if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ NULL);
+ return TCL_ERROR;
}
Tcl_AppendResult(interp, platformStrings[*platform], NULL);
@@ -2508,22 +2756,22 @@ TestgetplatformCmd(clientData, interp, argc, argv)
/* ARGSUSED */
static int
-TestinterpdeleteCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestinterpdeleteCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_Interp *slaveToDelete;
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " path\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " path\"", NULL);
+ return TCL_ERROR;
}
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
- if (slaveToDelete == (Tcl_Interp *) NULL) {
- return TCL_ERROR;
+ if (slaveToDelete == NULL) {
+ return TCL_ERROR;
}
Tcl_DeleteInterp(slaveToDelete);
return TCL_OK;
@@ -2549,11 +2797,11 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
/* ARGSUSED */
static int
-TestlinkCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestlinkCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
static int intVar = 43;
static int boolVar = 4;
@@ -2576,17 +2824,16 @@ TestlinkCmd(dummy, interp, argc, argv)
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg arg arg arg arg arg arg arg arg arg arg",
- " arg arg?\"", (char *) NULL);
+ " option ?arg arg arg arg arg arg arg arg arg arg arg arg"
+ " arg arg?\"", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
if (argc != 16) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ", argv[1],
- " intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO",
- " ushortRO uintRO longRO ulongRO floatRO uwideRO\"",
- (char *) NULL);
+ " intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO"
+ " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL);
return TCL_ERROR;
}
if (created) {
@@ -2738,7 +2985,7 @@ TestlinkCmd(dummy, interp, argc, argv)
} else if (strcmp(argv[1], "get") == 0) {
TclFormatInt(buffer, intVar);
Tcl_AppendElement(interp, buffer);
- Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
+ Tcl_PrintDouble(NULL, realVar, buffer);
Tcl_AppendElement(interp, buffer);
TclFormatInt(buffer, boolVar);
Tcl_AppendElement(interp, buffer);
@@ -2765,7 +3012,7 @@ TestlinkCmd(dummy, interp, argc, argv)
tmp = Tcl_NewLongObj((long)ulongVar);
Tcl_AppendElement(interp, Tcl_GetString(tmp));
Tcl_DecrRefCount(tmp);
- Tcl_PrintDouble((Tcl_Interp *) NULL, (double)floatVar, buffer);
+ Tcl_PrintDouble(NULL, (double)floatVar, buffer);
Tcl_AppendElement(interp, buffer);
tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar);
Tcl_AppendElement(interp, Tcl_GetString(tmp));
@@ -2776,10 +3023,9 @@ TestlinkCmd(dummy, interp, argc, argv)
if (argc != 16) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ", argv[1],
- " intValue realValue boolValue stringValue wideValue",
- " charValue ucharValue shortValue ushortValue uintValue",
- " longValue ulongValue floatValue uwideValue\"",
- (char *) NULL);
+ " intValue realValue boolValue stringValue wideValue"
+ " charValue ucharValue shortValue ushortValue uintValue"
+ " longValue ulongValue floatValue uwideValue\"", NULL);
return TCL_ERROR;
}
if (argv[2][0] != 0) {
@@ -2804,7 +3050,7 @@ TestlinkCmd(dummy, interp, argc, argv)
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]);
}
}
@@ -2881,10 +3127,9 @@ TestlinkCmd(dummy, interp, argc, argv)
if (argc != 16) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ", argv[1],
- " intValue realValue boolValue stringValue wideValue",
- " charValue ucharValue shortValue ushortValue uintValue",
- " longValue ulongValue floatValue uwideValue\"",
- (char *) NULL);
+ " intValue realValue boolValue stringValue wideValue"
+ " charValue ucharValue shortValue ushortValue uintValue"
+ " longValue ulongValue floatValue uwideValue\"", NULL);
return TCL_ERROR;
}
if (argv[2][0] != 0) {
@@ -2912,7 +3157,7 @@ TestlinkCmd(dummy, interp, argc, argv)
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");
@@ -2996,8 +3241,7 @@ TestlinkCmd(dummy, interp, argc, argv)
}
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be create, delete, get, set, or update",
- (char *) NULL);
+ "\": should be create, delete, get, set, or update", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -3021,20 +3265,20 @@ TestlinkCmd(dummy, interp, argc, argv)
*/
static int
-TestlocaleCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestlocaleCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
int index;
- char *locale;
+ const char *locale;
- static CONST char *optionStrings[] = {
- "ctype", "numeric", "time", "collate", "monetary",
+ static const char *const optionStrings[] = {
+ "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
};
@@ -3047,7 +3291,7 @@ TestlocaleCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
return TCL_ERROR;
}
-
+
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
@@ -3084,14 +3328,14 @@ TestlocaleCmd(clientData, interp, objc, objv)
/* ARGSUSED */
static int
-TestMathFunc(clientData, interp, args, resultPtr)
- ClientData clientData; /* Integer value to return. */
- Tcl_Interp *interp; /* Not used. */
- Tcl_Value *args; /* Not used. */
- Tcl_Value *resultPtr; /* Where to store result. */
+TestMathFunc(
+ ClientData clientData, /* Integer value to return. */
+ Tcl_Interp *interp, /* Not used. */
+ Tcl_Value *args, /* Not used. */
+ Tcl_Value *resultPtr) /* Where to store result. */
{
resultPtr->type = TCL_INT;
- resultPtr->intValue = (int) clientData;
+ resultPtr->intValue = PTR2INT(clientData);
return TCL_OK;
}
@@ -3114,26 +3358,25 @@ TestMathFunc(clientData, interp, args, resultPtr)
/* ARGSUSED */
static int
-TestMathFunc2(clientData, interp, args, resultPtr)
- ClientData clientData; /* Integer value to return. */
- Tcl_Interp *interp; /* Used to report errors. */
- Tcl_Value *args; /* Points to an array of two
- * Tcl_Value structs for the
- * two arguments. */
- Tcl_Value *resultPtr; /* Where to store the result. */
+TestMathFunc2(
+ ClientData clientData, /* Integer value to return. */
+ Tcl_Interp *interp, /* Used to report errors. */
+ Tcl_Value *args, /* Points to an array of two Tcl_Value structs
+ * for the two arguments. */
+ Tcl_Value *resultPtr) /* Where to store the result. */
{
int result = TCL_OK;
-
+
/*
* Return the maximum of the two arguments with the correct type.
*/
-
+
if (args[0].type == TCL_INT) {
int i0 = args[0].intValue;
-
+
if (args[1].type == TCL_INT) {
int i1 = args[1].intValue;
-
+
resultPtr->type = TCL_INT;
resultPtr->intValue = ((i0 > i1)? i0 : i1);
} else if (args[1].type == TCL_DOUBLE) {
@@ -3154,10 +3397,10 @@ TestMathFunc2(clientData, interp, args, resultPtr)
}
} else if (args[0].type == TCL_DOUBLE) {
double d0 = args[0].doubleValue;
-
+
if (args[1].type == TCL_INT) {
double d1 = args[1].intValue;
-
+
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else if (args[1].type == TCL_DOUBLE) {
@@ -3176,10 +3419,10 @@ TestMathFunc2(clientData, interp, args, resultPtr)
}
} else if (args[0].type == TCL_WIDE_INT) {
Tcl_WideInt w0 = args[0].wideValue;
-
+
if (args[1].type == TCL_INT) {
Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
-
+
resultPtr->type = TCL_WIDE_INT;
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
} else if (args[1].type == TCL_DOUBLE) {
@@ -3222,11 +3465,11 @@ TestMathFunc2(clientData, interp, args, resultPtr)
*/
/* ARGSUSED */
static void
-CleanupTestSetassocdataTests(clientData, interp)
- ClientData clientData; /* Data to be released. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+CleanupTestSetassocdataTests(
+ ClientData clientData, /* Data to be released. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
- ckfree((char *) clientData);
+ ckfree(clientData);
}
/*
@@ -3247,13 +3490,13 @@ CleanupTestSetassocdataTests(clientData, interp)
*/
static int
-TestparserObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestparserObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- char *script;
+ const char *script;
int length, dummy;
Tcl_Parse parse;
@@ -3303,13 +3546,13 @@ TestparserObjCmd(clientData, interp, objc, objv)
*/
static int
-TestexprparserObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestexprparserObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- char *script;
+ const char *script;
int length, dummy;
Tcl_Parse parse;
@@ -3364,71 +3607,70 @@ TestexprparserObjCmd(clientData, interp, objc, objv)
*/
static void
-PrintParse(interp, parsePtr)
- Tcl_Interp *interp; /* Interpreter whose result is to be set to
+PrintParse(
+ Tcl_Interp *interp, /* Interpreter whose result is to be set to
* the contents of a parse structure. */
- Tcl_Parse *parsePtr; /* Parse structure to print out. */
+ Tcl_Parse *parsePtr) /* Parse structure to print out. */
{
Tcl_Obj *objPtr;
- char *typeString;
+ const char *typeString;
Tcl_Token *tokenPtr;
int i;
objPtr = Tcl_GetObjResult(interp);
if (parsePtr->commentSize > 0) {
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commentStart,
parsePtr->commentSize));
} else {
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
- Tcl_NewStringObj("-", 1));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
}
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewIntObj(parsePtr->numWords));
for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
- case TCL_TOKEN_EXPAND_WORD:
- typeString = "expand";
- break;
- case TCL_TOKEN_WORD:
- typeString = "word";
- break;
- case TCL_TOKEN_SIMPLE_WORD:
- typeString = "simple";
- break;
- case TCL_TOKEN_TEXT:
- typeString = "text";
- break;
- case TCL_TOKEN_BS:
- typeString = "backslash";
- break;
- case TCL_TOKEN_COMMAND:
- typeString = "command";
- break;
- case TCL_TOKEN_VARIABLE:
- typeString = "variable";
- break;
- case TCL_TOKEN_SUB_EXPR:
- typeString = "subexpr";
- break;
- case TCL_TOKEN_OPERATOR:
- typeString = "operator";
- break;
- default:
- typeString = "??";
- break;
+ case TCL_TOKEN_EXPAND_WORD:
+ typeString = "expand";
+ break;
+ case TCL_TOKEN_WORD:
+ typeString = "word";
+ break;
+ case TCL_TOKEN_SIMPLE_WORD:
+ typeString = "simple";
+ break;
+ case TCL_TOKEN_TEXT:
+ typeString = "text";
+ break;
+ case TCL_TOKEN_BS:
+ typeString = "backslash";
+ break;
+ case TCL_TOKEN_COMMAND:
+ typeString = "command";
+ break;
+ case TCL_TOKEN_VARIABLE:
+ typeString = "variable";
+ break;
+ case TCL_TOKEN_SUB_EXPR:
+ typeString = "subexpr";
+ break;
+ case TCL_TOKEN_OPERATOR:
+ typeString = "operator";
+ break;
+ default:
+ typeString = "??";
+ break;
}
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(typeString, -1));
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewIntObj(tokenPtr->numComponents));
}
- Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
-1));
}
@@ -3451,14 +3693,13 @@ PrintParse(interp, parsePtr)
*/
static int
-TestparsevarObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestparsevarObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- CONST char *value;
- CONST char *name, *termPtr;
+ const char *value, *name, *termPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
@@ -3493,13 +3734,13 @@ TestparsevarObjCmd(clientData, interp, objc, objv)
*/
static int
-TestparsevarnameObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestparsevarnameObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- char *script;
+ const char *script;
int append, length, dummy;
Tcl_Parse parse;
@@ -3542,10 +3783,10 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv)
*
* TestregexpObjCmd --
*
- * This procedure implements the "testregexp" command. It is
- * used to give a direct interface for regexp flags. It's identical
- * to Tcl_RegexpObjCmd except for the -xflags option, and the
- * consequences thereof (including the REG_EXPECT kludge).
+ * This procedure implements the "testregexp" command. It is used to give
+ * a direct interface for regexp flags. It's identical to
+ * Tcl_RegexpObjCmd except for the -xflags option, and the consequences
+ * thereof (including the REG_EXPECT kludge).
*
* Results:
* A standard Tcl result.
@@ -3558,23 +3799,23 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
static int
-TestregexpObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestregexpObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int i, ii, indices, stringLength, match, about;
int hasxflags, cflags, eflags;
Tcl_RegExp regExpr;
- char *string;
+ const char *string;
Tcl_Obj *objPtr;
Tcl_RegExpInfo info;
- static CONST char *options[] = {
+ static const char *const options[] = {
"-indices", "-nocase", "-about", "-expanded",
"-line", "-linestop", "-lineanchor",
"-xflags",
- "--", (char *) NULL
+ "--", NULL
};
enum options {
REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED,
@@ -3588,9 +3829,9 @@ TestregexpObjCmd(dummy, interp, objc, objv)
cflags = REG_ADVANCED;
eflags = 0;
hasxflags = 0;
-
+
for (i = 1; i < objc; i++) {
- char *name;
+ const char *name;
int index;
name = Tcl_GetString(objv[i]);
@@ -3602,49 +3843,40 @@ TestregexpObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
switch ((enum options) index) {
- case REGEXP_INDICES: {
- indices = 1;
- break;
- }
- case REGEXP_NOCASE: {
- cflags |= REG_ICASE;
- break;
- }
- case REGEXP_ABOUT: {
- about = 1;
- break;
- }
- case REGEXP_EXPANDED: {
- cflags |= REG_EXPANDED;
- break;
- }
- case REGEXP_MULTI: {
- cflags |= REG_NEWLINE;
- break;
- }
- case REGEXP_NOCROSS: {
- cflags |= REG_NLSTOP;
- break;
- }
- case REGEXP_NEWL: {
- cflags |= REG_NLANCH;
- break;
- }
- case REGEXP_XFLAGS: {
- hasxflags = 1;
- break;
- }
- case REGEXP_LAST: {
- i++;
- goto endOfForLoop;
- }
+ case REGEXP_INDICES:
+ indices = 1;
+ break;
+ case REGEXP_NOCASE:
+ cflags |= REG_ICASE;
+ break;
+ case REGEXP_ABOUT:
+ about = 1;
+ break;
+ case REGEXP_EXPANDED:
+ cflags |= REG_EXPANDED;
+ break;
+ case REGEXP_MULTI:
+ cflags |= REG_NEWLINE;
+ break;
+ case REGEXP_NOCROSS:
+ cflags |= REG_NLSTOP;
+ break;
+ case REGEXP_NEWL:
+ cflags |= REG_NLANCH;
+ break;
+ case REGEXP_XFLAGS:
+ hasxflags = 1;
+ break;
+ case REGEXP_LAST:
+ i++;
+ goto endOfForLoop;
}
}
- endOfForLoop:
+ endOfForLoop:
if (objc - i < hasxflags + 2 - about) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+ "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
return TCL_ERROR;
}
objc -= i;
@@ -3661,7 +3893,6 @@ TestregexpObjCmd(dummy, interp, objc, objv)
if (regExpr == NULL) {
return TCL_ERROR;
}
- objPtr = objv[1];
if (about) {
if (TclRegAbout(interp, regExpr) < 0) {
@@ -3670,6 +3901,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
+ objPtr = objv[1];
match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */,
objc-2 /* nmatches */, eflags);
@@ -3679,13 +3911,13 @@ TestregexpObjCmd(dummy, interp, objc, objv)
if (match == 0) {
/*
* Set the interpreter's object result to an integer object w/
- * value 0.
+ * value 0.
*/
-
+
Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags&REG_EXPECT) && indices) {
- char *varName;
- CONST char *value;
+ const char *varName;
+ const char *value;
int start, end;
char resinfo[TCL_INTEGER_SPACE * 2];
@@ -3695,12 +3927,12 @@ TestregexpObjCmd(dummy, interp, objc, objv)
value = Tcl_SetVar(interp, varName, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
- varName, "\"", (char *) NULL);
+ varName, "\"", NULL);
return TCL_ERROR;
}
} else if (cflags & TCL_REG_CANMATCH) {
- char *varName;
- CONST char *value;
+ const char *varName;
+ const char *value;
char resinfo[TCL_INTEGER_SPACE * 2];
Tcl_RegExpGetInfo(regExpr, &info);
@@ -3709,7 +3941,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
value = Tcl_SetVar(interp, varName, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
- varName, "\"", (char *) NULL);
+ varName, "\"", NULL);
return TCL_ERROR;
}
}
@@ -3728,7 +3960,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
for (i = 0; i < objc; i++) {
int start, end;
Tcl_Obj *newPtr, *varPtr, *valuePtr;
-
+
varPtr = objv[i];
ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
if (indices) {
@@ -3745,10 +3977,10 @@ TestregexpObjCmd(dummy, interp, objc, objv)
}
/*
- * Adjust index so it refers to the last character in the
- * match instead of the first character after the match.
+ * Adjust index so it refers to the last character in the match
+ * instead of the first character after the match.
*/
-
+
if (end >= 0) {
end--;
}
@@ -3768,19 +4000,16 @@ TestregexpObjCmd(dummy, interp, objc, objv)
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_DecrRefCount(newPtr);
- Tcl_AppendResult(interp, "couldn't set variable \"",
- Tcl_GetString(varPtr), "\"", (char *) NULL);
return TCL_ERROR;
}
}
/*
- * Set the interpreter's object result to an integer object w/ value 1.
+ * Set the interpreter's object result to an integer object w/ value 1.
*/
-
+
Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
return TCL_OK;
}
@@ -3803,86 +4032,68 @@ TestregexpObjCmd(dummy, interp, objc, objv)
*/
static void
-TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
- char *string; /* The string of flags. */
- int length; /* The length of the string in bytes. */
- int *cflagsPtr; /* compile flags word */
- int *eflagsPtr; /* exec flags word */
+TestregexpXflags(
+ const char *string, /* The string of flags. */
+ int length, /* The length of the string in bytes. */
+ int *cflagsPtr, /* compile flags word */
+ int *eflagsPtr) /* exec flags word */
{
- int i;
- int cflags;
- int eflags;
+ int i, cflags, eflags;
cflags = *cflagsPtr;
eflags = *eflagsPtr;
for (i = 0; i < length; i++) {
switch (string[i]) {
- case 'a': {
- cflags |= REG_ADVF;
- break;
- }
- case 'b': {
- cflags &= ~REG_ADVANCED;
- break;
- }
- case 'c': {
- cflags |= TCL_REG_CANMATCH;
- break;
- }
- case 'e': {
- cflags &= ~REG_ADVANCED;
- cflags |= REG_EXTENDED;
- break;
- }
- case 'q': {
- cflags &= ~REG_ADVANCED;
- cflags |= REG_QUOTE;
- break;
- }
- case 'o': { /* o for opaque */
- cflags |= REG_NOSUB;
- break;
- }
- case 's': { /* s for start */
- cflags |= REG_BOSONLY;
- break;
- }
- case '+': {
- cflags |= REG_FAKE;
- break;
- }
- case ',': {
- cflags |= REG_PROGRESS;
- break;
- }
- case '.': {
- cflags |= REG_DUMP;
- break;
- }
- case ':': {
- eflags |= REG_MTRACE;
- break;
- }
- case ';': {
- eflags |= REG_FTRACE;
- break;
- }
- case '^': {
- eflags |= REG_NOTBOL;
- break;
- }
- case '$': {
- eflags |= REG_NOTEOL;
- break;
- }
- case 't': {
- cflags |= REG_EXPECT;
- break;
- }
- case '%': {
- eflags |= REG_SMALL;
- break;
- }
+ case 'a':
+ cflags |= REG_ADVF;
+ break;
+ case 'b':
+ cflags &= ~REG_ADVANCED;
+ break;
+ case 'c':
+ cflags |= TCL_REG_CANMATCH;
+ break;
+ case 'e':
+ cflags &= ~REG_ADVANCED;
+ cflags |= REG_EXTENDED;
+ break;
+ case 'q':
+ cflags &= ~REG_ADVANCED;
+ cflags |= REG_QUOTE;
+ break;
+ case 'o': /* o for opaque */
+ cflags |= REG_NOSUB;
+ break;
+ case 's': /* s for start */
+ cflags |= REG_BOSONLY;
+ break;
+ case '+':
+ cflags |= REG_FAKE;
+ break;
+ case ',':
+ cflags |= REG_PROGRESS;
+ break;
+ case '.':
+ cflags |= REG_DUMP;
+ break;
+ case ':':
+ eflags |= REG_MTRACE;
+ break;
+ case ';':
+ eflags |= REG_FTRACE;
+ break;
+ case '^':
+ eflags |= REG_NOTBOL;
+ break;
+ case '$':
+ eflags |= REG_NOTEOL;
+ break;
+ case 't':
+ cflags |= REG_EXPECT;
+ break;
+ case '%':
+ eflags |= REG_SMALL;
+ break;
}
}
@@ -3912,11 +4123,11 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
/* ARGSUSED */
static int
-TestreturnObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestreturnObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
return TCL_RETURN;
}
@@ -3940,23 +4151,22 @@ TestreturnObjCmd(dummy, interp, objc, objv)
*/
static int
-TestsetassocdataCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- char *buf;
- char *oldData;
+TestsetassocdataCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ char *buf, *oldData;
Tcl_InterpDeleteProc *procPtr;
-
+
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " data_key data_item\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " data_key data_item\"", NULL);
+ return TCL_ERROR;
}
- buf = ckalloc((unsigned) strlen(argv[2]) + 1);
+ buf = ckalloc(strlen(argv[2]) + 1);
strcpy(buf, argv[2]);
/*
@@ -3968,8 +4178,8 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
ckfree(oldData);
}
-
- Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
+
+ Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
(ClientData) buf);
return TCL_OK;
}
@@ -3993,21 +4203,21 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
*/
static int
-TestsetplatformCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestsetplatformCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
size_t length;
TclPlatformType *platform;
platform = TclGetPlatform();
-
+
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " platform\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " platform\"", NULL);
+ return TCL_ERROR;
}
length = strlen(argv[1]);
@@ -4016,8 +4226,8 @@ TestsetplatformCmd(clientData, interp, argc, argv)
} else if (strncmp(argv[1], "windows", length) == 0) {
*platform = TCL_PLATFORM_WINDOWS;
} else {
- Tcl_AppendResult(interp, "unsupported platform: should be one of ",
- "unix, or windows", (char *) NULL);
+ Tcl_AppendResult(interp, "unsupported platform: should be one of "
+ "unix, or windows", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -4042,17 +4252,17 @@ TestsetplatformCmd(clientData, interp, argc, argv)
*/
static int
-TeststaticpkgCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TeststaticpkgCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int safe, loaded;
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " pkgName safe loaded\"", (char *) NULL);
+ argv[0], " pkgName safe loaded\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
@@ -4061,15 +4271,15 @@ TeststaticpkgCmd(dummy, interp, argc, argv)
if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
- (safe) ? StaticInitProc : NULL);
+ tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
+ StaticInitProc, (safe) ? StaticInitProc : NULL);
return TCL_OK;
}
static int
-StaticInitProc(interp)
- Tcl_Interp *interp; /* Interpreter in which package
- * is supposedly being loaded. */
+StaticInitProc(
+ Tcl_Interp *interp) /* Interpreter in which package is supposedly
+ * being loaded. */
{
Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
return TCL_OK;
@@ -4093,18 +4303,18 @@ StaticInitProc(interp)
*/
static int
-TesttranslatefilenameCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TesttranslatefilenameCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_DString buffer;
- CONST char *result;
+ const char *result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " path\"", (char *) NULL);
+ argv[0], " path\"", NULL);
return TCL_ERROR;
}
result = Tcl_TranslateFileName(interp, argv[1], &buffer);
@@ -4135,17 +4345,17 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv)
/* ARGSUSED */
static int
-TestupvarCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestupvarCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
int flags = 0;
-
+
if ((argc != 5) && (argc != 6)) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " level name ?name2? dest global\"", (char *) NULL);
+ argv[0], " level name ?name2? dest global\"", NULL);
return TCL_ERROR;
}
@@ -4162,8 +4372,8 @@ TestupvarCmd(dummy, interp, argc, argv)
} else if (strcmp(argv[5], "namespace") == 0) {
flags = TCL_NAMESPACE_ONLY;
}
- return Tcl_UpVar2(interp, argv[1], argv[2],
- (argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4],
+ return Tcl_UpVar2(interp, argv[1], argv[2],
+ (argv[3][0] == 0) ? NULL : argv[3], argv[4],
flags);
}
}
@@ -4173,9 +4383,8 @@ TestupvarCmd(dummy, interp, argc, argv)
*
* TestseterrorcodeCmd --
*
- * This procedure implements the "testseterrorcodeCmd".
- * This tests up to five elements passed to the
- * Tcl_SetErrorCode command.
+ * This procedure implements the "testseterrorcodeCmd". This tests up to
+ * five elements passed to the Tcl_SetErrorCode command.
*
* Results:
* A standard Tcl result. Always returns TCL_ERROR so that
@@ -4189,18 +4398,36 @@ TestupvarCmd(dummy, interp, argc, argv)
/* ARGSUSED */
static int
-TestseterrorcodeCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestseterrorcodeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
if (argc > 6) {
Tcl_SetResult(interp, "too many args", TCL_STATIC);
return TCL_ERROR;
}
- Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
- argv[5], NULL);
+ switch (argc) {
+ case 1:
+ Tcl_SetErrorCode(interp, "NONE", NULL);
+ break;
+ case 2:
+ Tcl_SetErrorCode(interp, argv[1], NULL);
+ break;
+ case 3:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
+ break;
+ case 4:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
+ break;
+ case 5:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
+ break;
+ case 6:
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
+ argv[5], NULL);
+ }
return TCL_ERROR;
}
@@ -4224,11 +4451,11 @@ TestseterrorcodeCmd(dummy, interp, argc, argv)
/* ARGSUSED */
static int
-TestsetobjerrorcodeCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestsetobjerrorcodeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
return TCL_ERROR;
@@ -4253,11 +4480,11 @@ TestsetobjerrorcodeCmd(dummy, interp, objc, objv)
/* ARGSUSED */
static int
-TestfeventCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestfeventCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
static Tcl_Interp *interp2 = NULL;
int code;
@@ -4265,46 +4492,46 @@ TestfeventCmd(clientData, interp, argc, argv)
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg ...?", (char *) NULL);
+ " option ?arg ...?", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "cmd") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " cmd script", (char *) NULL);
+ " cmd script", NULL);
return TCL_ERROR;
}
- if (interp2 != (Tcl_Interp *) NULL) {
- code = Tcl_GlobalEval(interp2, argv[2]);
+ if (interp2 != NULL) {
+ code = Tcl_GlobalEval(interp2, argv[2]);
Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
- return code;
- } else {
- Tcl_AppendResult(interp,
- "called \"testfevent code\" before \"testfevent create\"",
- (char *) NULL);
- return TCL_ERROR;
- }
+ return code;
+ } else {
+ Tcl_AppendResult(interp,
+ "called \"testfevent code\" before \"testfevent create\"",
+ NULL);
+ return TCL_ERROR;
+ }
} else if (strcmp(argv[1], "create") == 0) {
if (interp2 != NULL) {
- Tcl_DeleteInterp(interp2);
+ Tcl_DeleteInterp(interp2);
}
- interp2 = Tcl_CreateInterp();
+ interp2 = Tcl_CreateInterp();
return Tcl_Init(interp2);
} else if (strcmp(argv[1], "delete") == 0) {
if (interp2 != NULL) {
- Tcl_DeleteInterp(interp2);
+ Tcl_DeleteInterp(interp2);
}
interp2 = NULL;
} else if (strcmp(argv[1], "share") == 0) {
- if (interp2 != NULL) {
- chan = Tcl_GetChannel(interp, argv[2], NULL);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(interp2, chan);
- }
+ if (interp2 != NULL) {
+ chan = Tcl_GetChannel(interp, argv[2], NULL);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_RegisterChannel(interp2, chan);
+ }
}
-
+
return TCL_OK;
}
@@ -4316,7 +4543,7 @@ TestfeventCmd(clientData, interp, argc, argv)
* Calls the panic routine.
*
* Results:
- * Always returns TCL_OK.
+ * Always returns TCL_OK.
*
* Side effects:
* May exit application.
@@ -4325,96 +4552,37 @@ TestfeventCmd(clientData, interp, argc, argv)
*/
static int
-TestpanicCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- CONST char *argString;
-
+TestpanicCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ const char *argString;
+
/*
* Put the arguments into a var args structure
* Append all of the arguments together separated by spaces
*/
argString = Tcl_Merge(argc-1, argv+1);
- Tcl_Panic(argString);
- ckfree((char *)argString);
-
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TestchmodCmd --
- *
- * Implements the "testchmod" cmd. Used when testing "file"
- * command. The only attribute used by the Windows platform
- * is the user write flag; if this is not set, the file is
- * made read-only. Otehrwise, the file is made read-write.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Changes permissions of specified files.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TestchmodCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- int i, mode;
- char *rest;
+ Tcl_Panic("%s", argString);
+ ckfree(argString);
- if (argc < 2) {
- usage:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " mode file ?file ...?", (char *) NULL);
- return TCL_ERROR;
- }
-
- mode = (int) strtol(argv[1], &rest, 8);
- if ((rest == argv[1]) || (*rest != '\0')) {
- goto usage;
- }
-
- for (i = 2; i < argc; i++) {
- Tcl_DString buffer;
- CONST char *translated;
-
- translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
- if (translated == NULL) {
- return TCL_ERROR;
- }
- if (chmod(translated, (unsigned) mode) != 0) {
- Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_DStringFree(&buffer);
- }
return TCL_OK;
}
-
+
static int
-TestfileCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- Tcl_Obj *CONST argv[]; /* The argument objects. */
+TestfileCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ Tcl_Obj *const argv[]) /* The argument objects. */
{
int force, i, j, result;
Tcl_Obj *error = NULL;
- char *subcmd;
-
+ const char *subcmd;
+
if (argc < 3) {
return TCL_ERROR;
}
@@ -4422,7 +4590,7 @@ TestfileCmd(dummy, interp, argc, argv)
force = 0;
i = 2;
if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
- force = 1;
+ force = 1;
i = 3;
}
@@ -4431,30 +4599,30 @@ TestfileCmd(dummy, interp, argc, argv)
}
for (j = i; j < argc; j++) {
- if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) {
+ if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) {
return TCL_ERROR;
}
}
subcmd = Tcl_GetString(argv[1]);
-
+
if (strcmp(subcmd, "mv") == 0) {
result = TclpObjRenameFile(argv[i], argv[i + 1]);
} else if (strcmp(subcmd, "cp") == 0) {
- result = TclpObjCopyFile(argv[i], argv[i + 1]);
+ result = TclpObjCopyFile(argv[i], argv[i + 1]);
} else if (strcmp(subcmd, "rm") == 0) {
- result = TclpObjDeleteFile(argv[i]);
+ result = TclpObjDeleteFile(argv[i]);
} else if (strcmp(subcmd, "mkdir") == 0) {
- result = TclpObjCreateDirectory(argv[i]);
+ result = TclpObjCreateDirectory(argv[i]);
} else if (strcmp(subcmd, "cpdir") == 0) {
- result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
+ result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
} else if (strcmp(subcmd, "rmdir") == 0) {
- result = TclpObjRemoveDirectory(argv[i], force, &error);
+ result = TclpObjRemoveDirectory(argv[i], force, &error);
} else {
- result = TCL_ERROR;
+ result = TCL_ERROR;
goto end;
}
-
+
if (result != TCL_OK) {
if (error != NULL) {
if (Tcl_GetString(error)[0] != '\0') {
@@ -4462,11 +4630,10 @@ TestfileCmd(dummy, interp, argc, argv)
}
Tcl_DecrRefCount(error);
}
- Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
+ Tcl_AppendResult(interp, Tcl_ErrnoId(), NULL);
}
- end:
-
+ end:
return result;
}
@@ -4488,13 +4655,13 @@ TestfileCmd(dummy, interp, argc, argv)
*/
static int
-TestgetvarfullnameCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestgetvarfullnameCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
- char *name, *arg;
+ const char *name, *arg;
int flags = 0;
Tcl_Namespace *namespacePtr;
Tcl_CallFrame *framePtr;
@@ -4503,9 +4670,9 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name scope");
- return TCL_ERROR;
+ return TCL_ERROR;
}
-
+
name = Tcl_GetString(objv[1]);
arg = Tcl_GetString(objv[2]);
@@ -4516,26 +4683,25 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
}
/*
- * This command, like any other created with Tcl_Create[Obj]Command,
- * runs in the global namespace. As a "namespace-aware" command that
- * needs to run in a particular namespace, it must activate that
- * namespace itself.
+ * This command, like any other created with Tcl_Create[Obj]Command, runs
+ * in the global namespace. As a "namespace-aware" command that needs to
+ * run in a particular namespace, it must activate that namespace itself.
*/
if (flags == TCL_NAMESPACE_ONLY) {
- namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
- (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
+ namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", NULL,
+ TCL_LEAVE_ERR_MSG);
if (namespacePtr == NULL) {
return TCL_ERROR;
}
result = TclPushStackFrame(interp, &framePtr, namespacePtr,
- /*isProcCallFrame*/ 0);
+ /*isProcCallFrame*/ 0);
if (result != TCL_OK) {
return result;
}
}
-
- variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
+
+ variable = Tcl_FindNamespaceVar(interp, name, NULL,
(flags | TCL_LEAVE_ERR_MSG));
if (flags == TCL_NAMESPACE_ONLY) {
@@ -4553,10 +4719,9 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
*
* GetTimesCmd --
*
- * This procedure implements the "gettimes" command. It is
- * used for computing the time needed for various basic operations
- * such as reading variables, allocating memory, sprintf, converting
- * variables, etc.
+ * This procedure implements the "gettimes" command. It is used for
+ * computing the time needed for various basic operations such as reading
+ * variables, allocating memory, sprintf, converting variables, etc.
*
* Results:
* A standard Tcl result.
@@ -4568,48 +4733,47 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
*/
static int
-GetTimesCmd(unused, interp, argc, argv)
- ClientData unused; /* Unused. */
- Tcl_Interp *interp; /* The current interpreter. */
- int argc; /* The number of arguments. */
- CONST char **argv; /* The argument strings. */
+GetTimesCmd(
+ ClientData unused, /* Unused. */
+ Tcl_Interp *interp, /* The current interpreter. */
+ int argc, /* The number of arguments. */
+ const char **argv) /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
int i, n;
double timePer;
Tcl_Time start, stop;
- Tcl_Obj *objPtr;
- Tcl_Obj **objv;
- CONST char *s;
+ Tcl_Obj *objPtr, **objv;
+ const char *s;
char newString[TCL_INTEGER_SPACE];
/* alloc & free 100000 times */
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);
fprintf(stderr, " %.3f usec per alloc+free\n", timePer/100000);
-
+
/* 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);
fprintf(stderr, " %.3f usec per alloc\n", timePer/5000);
-
+
/* free 5000 times */
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);
@@ -4624,7 +4788,7 @@ GetTimesCmd(unused, interp, argc, argv)
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_NewObj\n", timePer/5000);
-
+
/* Tcl_DecrRefCount 5000 times */
fprintf(stderr, "Tcl_DecrRefCount 5000 times\n");
Tcl_GetTime(&start);
@@ -4635,7 +4799,7 @@ GetTimesCmd(unused, interp, argc, argv)
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");
@@ -4662,7 +4826,7 @@ GetTimesCmd(unused, interp, argc, argv)
fprintf(stderr, " %.3f usec per Tcl_GetIntFromObj of \"12345\"\n",
timePer/100000);
Tcl_DecrRefCount(objPtr);
-
+
/* Tcl_GetInt 100000 times */
fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n");
Tcl_GetTime(&start);
@@ -4725,7 +4889,7 @@ GetTimesCmd(unused, interp, argc, argv)
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_GetVar of a==\"12345\"\n",
timePer/100000);
-
+
Tcl_ResetResult(interp);
return TCL_OK;
}
@@ -4748,11 +4912,11 @@ GetTimesCmd(unused, interp, argc, argv)
*/
static int
-NoopCmd(unused, interp, argc, argv)
- ClientData unused; /* Unused. */
- Tcl_Interp *interp; /* The current interpreter. */
- int argc; /* The number of arguments. */
- CONST char **argv; /* The argument strings. */
+NoopCmd(
+ ClientData unused, /* Unused. */
+ Tcl_Interp *interp, /* The current interpreter. */
+ int argc, /* The number of arguments. */
+ const char **argv) /* The argument strings. */
{
return TCL_OK;
}
@@ -4775,11 +4939,11 @@ NoopCmd(unused, interp, argc, argv)
*/
static int
-NoopObjCmd(unused, interp, objc, objv)
- ClientData unused; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+NoopObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
return TCL_OK;
}
@@ -4803,46 +4967,78 @@ NoopObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
static int
-TestsetCmd(data, interp, argc, argv)
- ClientData data; /* Additional flags for Get/SetVar2. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestsetCmd(
+ ClientData data, /* Additional flags for Get/SetVar2. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
- int flags = (int) data;
- CONST char *value;
+ int flags = PTR2INT(data);
+ const char *value;
if (argc == 2) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
- value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags);
- if (value == NULL) {
- return TCL_ERROR;
- }
+ Tcl_SetResult(interp, "before get", TCL_STATIC);
+ value = Tcl_GetVar2(interp, argv[1], NULL, flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
Tcl_AppendElement(interp, value);
- return TCL_OK;
+ return TCL_OK;
} else if (argc == 3) {
Tcl_SetResult(interp, "before set", TCL_STATIC);
- value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags);
- if (value == NULL) {
- return TCL_ERROR;
- }
+ value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " varName ?newValue?\"", NULL);
+ return TCL_ERROR;
+ }
+}
+static int
+Testset2Cmd(
+ ClientData data, /* Additional flags for Get/SetVar2. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ int flags = PTR2INT(data);
+ const char *value;
+
+ if (argc == 3) {
+ Tcl_SetResult(interp, "before get", TCL_STATIC);
+ value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
+ return TCL_OK;
+ } else if (argc == 4) {
+ Tcl_SetResult(interp, "before set", TCL_STATIC);
+ value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
Tcl_AppendElement(interp, value);
return TCL_OK;
} else {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " varName ?newValue?\"", (char *) NULL);
+ argv[0], " varName elemName ?newValue?\"", NULL);
return TCL_ERROR;
}
}
+#ifndef TCL_NO_DEPRECATED
/*
*----------------------------------------------------------------------
*
* TestsaveresultCmd --
*
- * Implements the "testsaveresult" cmd that is used when testing
- * the Tcl_SaveResult, Tcl_RestoreResult, and
- * Tcl_DiscardResult interfaces.
+ * Implements the "testsaveresult" cmd that is used when testing the
+ * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces.
*
* Results:
* A standard Tcl result.
@@ -4855,16 +5051,17 @@ TestsetCmd(data, interp, argc, argv)
/* ARGSUSED */
static int
-TestsaveresultCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
+TestsaveresultCmd(
+ ClientData dummy, /* Not used. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
{
+ Interp* iPtr = (Interp*) interp;
int discard, result, index;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
- static CONST char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"append", "dynamic", "free", "object", "small", NULL
};
enum options {
@@ -4877,7 +5074,7 @@ TestsaveresultCmd(dummy, interp, objc, objv)
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
@@ -4889,25 +5086,26 @@ TestsaveresultCmd(dummy, interp, objc, objv)
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
- case RESULT_SMALL:
- Tcl_SetResult(interp, "small result", TCL_VOLATILE);
- break;
- case RESULT_APPEND:
- Tcl_AppendResult(interp, "append result", NULL);
- break;
- case RESULT_FREE: {
- char *buf = ckalloc(200);
- strcpy(buf, "free result");
- Tcl_SetResult(interp, buf, TCL_DYNAMIC);
- break;
- }
- case RESULT_DYNAMIC:
- Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
- break;
- case RESULT_OBJECT:
- objPtr = Tcl_NewStringObj("object result", -1);
- Tcl_SetObjResult(interp, objPtr);
- break;
+ case RESULT_SMALL:
+ Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+ break;
+ case RESULT_APPEND:
+ Tcl_AppendResult(interp, "append result", NULL);
+ break;
+ case RESULT_FREE: {
+ char *buf = ckalloc(200);
+
+ strcpy(buf, "free result");
+ Tcl_SetResult(interp, buf, TCL_DYNAMIC);
+ break;
+ }
+ case RESULT_DYNAMIC:
+ Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
+ break;
+ case RESULT_OBJECT:
+ objPtr = Tcl_NewStringObj("object result", -1);
+ Tcl_SetObjResult(interp, objPtr);
+ break;
}
freeCount = 0;
@@ -4927,19 +5125,20 @@ TestsaveresultCmd(dummy, interp, objc, objv)
}
switch ((enum options) index) {
- case RESULT_DYNAMIC: {
- int present = interp->freeProc == TestsaveresultFree;
- int called = freeCount;
- Tcl_AppendElement(interp, called ? "called" : "notCalled");
- Tcl_AppendElement(interp, present ? "present" : "missing");
- break;
- }
- case RESULT_OBJECT:
- Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
- ? "same" : "different");
- break;
- default:
- break;
+ case RESULT_DYNAMIC: {
+ int present = iPtr->freeProc == TestsaveresultFree;
+ int called = freeCount;
+
+ Tcl_AppendElement(interp, called ? "called" : "notCalled");
+ Tcl_AppendElement(interp, present ? "present" : "missing");
+ break;
+ }
+ case RESULT_OBJECT:
+ Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
+ ? "same" : "different");
+ break;
+ default:
+ break;
}
return result;
}
@@ -4961,19 +5160,20 @@ TestsaveresultCmd(dummy, interp, objc, objv)
*/
static void
-TestsaveresultFree(blockPtr)
- char *blockPtr;
+TestsaveresultFree(
+ char *blockPtr)
{
freeCount++;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
- * TeststatprocCmd --
+ * TestmainthreadCmd --
*
- * Implements the "testTclStatProc" cmd that is used to test the
- * 'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
+ * Implements the "testmainthread" cmd that is used to test the
+ * 'Tcl_GetCurrentThread' API.
*
* Results:
* A standard Tcl result.
@@ -4985,203 +5185,21 @@ TestsaveresultFree(blockPtr)
*/
static int
-TeststatprocCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestmainthreadCmd(
+ ClientData dummy, /* Not used. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
- TclStatProc_ *proc;
- int retVal;
+ if (argc == 1) {
+ Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpStat") == 0) {
- proc = PretendTclpStat;
- } else if (strcmp(argv[2], "TestStatProc1") == 0) {
- proc = TestStatProc1;
- } else if (strcmp(argv[2], "TestStatProc2") == 0) {
- proc = TestStatProc2;
- } else if (strcmp(argv[2], "TestStatProc3") == 0) {
- proc = TestStatProc3;
- } else {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be TclpStat, ",
- "TestStatProc1, TestStatProc2, or TestStatProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpStat) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be ",
- "TestStatProc1, TestStatProc2, or TestStatProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
- retVal = TclStatInsertProc(proc);
- } else if (strcmp(argv[1], "delete") == 0) {
- retVal = TclStatDeleteProc(proc);
+ Tcl_SetObjResult(interp, idObj);
+ return TCL_OK;
} else {
- Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
- "must be insert or delete", (char *) NULL);
+ Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
return TCL_ERROR;
}
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": ",
- "could not be ", argv[1], "ed", (char *) NULL);
- }
-
- return retVal;
-}
-
-static int PretendTclpStat(path, buf)
- CONST char *path;
- struct stat *buf;
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
-#ifdef TCL_WIDE_INT_IS_LONG
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjStat(pathPtr, buf);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-#else /* TCL_WIDE_INT_IS_LONG */
- Tcl_StatBuf realBuf;
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjStat(pathPtr, &realBuf);
- Tcl_DecrRefCount(pathPtr);
- if (ret != -1) {
-# define OUT_OF_RANGE(x) \
- (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
- ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-# define OUT_OF_URANGE(x) \
- (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
-
- /*
- * Perform the result-buffer overflow check manually.
- *
- * Note that ino_t/ino64_t is unsigned...
- */
-
- if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
-# ifdef HAVE_ST_BLOCKS
- || OUT_OF_RANGE(realBuf.st_blocks)
-# endif
- ) {
-# ifdef EOVERFLOW
- errno = EOVERFLOW;
-# else
-# ifdef EFBIG
- errno = EFBIG;
-# else
-# error "what error should be returned for a value out of range?"
-# endif
-# endif
- return -1;
- }
-
-# undef OUT_OF_RANGE
-# undef OUT_OF_URANGE
-
- /*
- * Copy across all supported fields, with possible type
- * coercions on those fields that change between the normal
- * and lf64 versions of the stat structure (on Solaris at
- * least.) This is slow when the structure sizes coincide,
- * but that's what you get for mixing interfaces...
- */
-
- buf->st_mode = realBuf.st_mode;
- buf->st_ino = (ino_t) realBuf.st_ino;
- buf->st_dev = realBuf.st_dev;
- buf->st_rdev = realBuf.st_rdev;
- buf->st_nlink = realBuf.st_nlink;
- buf->st_uid = realBuf.st_uid;
- buf->st_gid = realBuf.st_gid;
- buf->st_size = (off_t) realBuf.st_size;
- buf->st_atime = realBuf.st_atime;
- buf->st_mtime = realBuf.st_mtime;
- buf->st_ctime = realBuf.st_ctime;
-# ifdef HAVE_ST_BLOCKS
- buf->st_blksize = realBuf.st_blksize;
- buf->st_blocks = (blkcnt_t) realBuf.st_blocks;
-# endif
- }
- return ret;
-#endif /* TCL_WIDE_INT_IS_LONG */
-}
-
-static int
-TestStatProc1(path, buf)
- CONST char *path;
- struct stat *buf;
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 1234;
- return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
-}
-
-
-static int
-TestStatProc2(path, buf)
- CONST char *path;
- struct stat *buf;
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 2345;
- return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
-}
-
-
-static int
-TestStatProc3(path, buf)
- CONST char *path;
- struct stat *buf;
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 3456;
- return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestmainthreadCmd --
- *
- * Implements the "testmainthread" cmd that is used to test the
- * 'Tcl_GetCurrentThread' API.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestmainthreadCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- if (argc == 1) {
- Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
- Tcl_SetObjResult(interp, idObj);
- return TCL_OK;
- } else {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
- return TCL_ERROR;
- }
}
/*
@@ -5192,7 +5210,7 @@ TestmainthreadCmd (dummy, interp, argc, argv)
* A main loop set by TestsetmainloopCmd below.
*
* Results:
- * None.
+ * None.
*
* Side effects:
* Event handlers could do anything.
@@ -5228,11 +5246,11 @@ MainLoop(void)
*/
static int
-TestsetmainloopCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestsetmainloopCmd(
+ ClientData dummy, /* Not used. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
exitMainLoop = 0;
Tcl_SetMainLoop(MainLoop);
@@ -5257,11 +5275,11 @@ TestsetmainloopCmd (dummy, interp, argc, argv)
*/
static int
-TestexitmainloopCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestexitmainloopCmd(
+ ClientData dummy, /* Not used. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
exitMainLoop = 1;
return TCL_OK;
@@ -5270,316 +5288,6 @@ TestexitmainloopCmd (dummy, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TestaccessprocCmd --
- *
- * Implements the "testTclAccessProc" cmd that is used to test the
- * 'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestaccessprocCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- TclAccessProc_ *proc;
- int retVal;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpAccess") == 0) {
- proc = PretendTclpAccess;
- } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
- proc = TestAccessProc1;
- } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
- proc = TestAccessProc2;
- } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
- proc = TestAccessProc3;
- } else {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be TclpAccess, ",
- "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpAccess) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be ",
- "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
- retVal = TclAccessInsertProc(proc);
- } else if (strcmp(argv[1], "delete") == 0) {
- retVal = TclAccessDeleteProc(proc);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
- "must be insert or delete", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": ",
- "could not be ", argv[1], "ed", (char *) NULL);
- }
-
- return retVal;
-}
-
-static int PretendTclpAccess(path, mode)
- CONST char *path;
- int mode;
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjAccess(pathPtr, mode);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-}
-
-static int
-TestAccessProc1(path, mode)
- CONST char *path;
- int mode;
-{
- return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
-}
-
-
-static int
-TestAccessProc2(path, mode)
- CONST char *path;
- int mode;
-{
- return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
-}
-
-
-static int
-TestAccessProc3(path, mode)
- CONST char *path;
- int mode;
-{
- return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestopenfilechannelprocCmd --
- *
- * Implements the "testTclOpenFileChannelProc" cmd that is used to test the
- * 'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C Apis.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestopenfilechannelprocCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
-{
- TclOpenFileChannelProc_ *proc;
- int retVal;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
- proc = PretendTclpOpenFileChannel;
- } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
- proc = TestOpenFileChannelProc1;
- } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
- proc = TestOpenFileChannelProc2;
- } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
- proc = TestOpenFileChannelProc3;
- } else {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be TclpOpenFileChannel, ",
- "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
- "TestOpenFileChannelProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpOpenFileChannel) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
- "must be ",
- "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
- "TestOpenFileChannelProc3",
- (char *) NULL);
- return TCL_ERROR;
- }
- retVal = TclOpenFileChannelInsertProc(proc);
- } else if (strcmp(argv[1], "delete") == 0) {
- retVal = TclOpenFileChannelDeleteProc(proc);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
- "must be insert or delete", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": ",
- "could not be ", argv[1], "ed", (char *) NULL);
- }
-
- return retVal;
-}
-
-static Tcl_Channel
-PretendTclpOpenFileChannel(interp, fileName, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- CONST char *fileName; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
-{
- Tcl_Channel ret;
- int mode, seekFlag;
- Tcl_Obj *pathPtr;
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
- pathPtr = Tcl_NewStringObj(fileName, -1);
- Tcl_IncrRefCount(pathPtr);
- ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions);
- Tcl_DecrRefCount(pathPtr);
- if (ret != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file while opening \"",
- fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- Tcl_Close(NULL, ret);
- return NULL;
- }
- }
- }
- return ret;
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc1(interp, fileName, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- CONST char *fileName; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
-{
- CONST char *expectname="testOpenFileChannel1%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return (NULL);
- }
-}
-
-
-static Tcl_Channel
-TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- CONST char *fileName; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
-{
- CONST char *expectname="testOpenFileChannel2%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return (NULL);
- }
-}
-
-
-static Tcl_Channel
-TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- CONST char *fileName; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
-{
- CONST char *expectname="testOpenFileChannel3%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return (NULL);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TestChannelCmd --
*
* Implements the Tcl "testchannel" debugging command and its
@@ -5596,13 +5304,13 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
/* ARGSUSED */
static int
-TestChannelCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for result. */
- int argc; /* Count of additional args. */
- CONST char **argv; /* Additional arg strings. */
+TestChannelCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter for result. */
+ int argc, /* Count of additional args. */
+ const char **argv) /* Additional arg strings. */
{
- CONST char *cmdName; /* Sub command. */
+ const char *cmdName; /* Sub command. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -5613,36 +5321,35 @@ TestChannelCmd(clientData, interp, argc, argv)
int IOQueued; /* How much IO is queued inside channel? */
char buf[TCL_INTEGER_SPACE];/* For sprintf. */
int mode; /* rw mode of the channel */
-
+
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " subcommand ?additional args..?\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " subcommand ?additional args..?\"", NULL);
+ return TCL_ERROR;
}
cmdName = argv[1];
len = strlen(cmdName);
- chanPtr = (Channel *) NULL;
+ chanPtr = NULL;
if (argc > 2) {
- if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
+ if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
/* For splice access the pool of detached channels.
* Locate channel, remove from the list.
*/
- TestChannel** nextPtrPtr;
- TestChannel* curPtr;
+ TestChannel **nextPtrPtr, *curPtr;
chan = (Tcl_Channel) NULL;
for (nextPtrPtr = &firstDetached, curPtr = firstDetached;
curPtr != NULL;
nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {
- if (strcmp (argv[2], Tcl_GetChannelName (curPtr->chan)) == 0) {
- *nextPtrPtr = curPtr->nextPtr;
+ if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) {
+ *nextPtrPtr = curPtr->nextPtr;
curPtr->nextPtr = NULL;
chan = curPtr->chan;
- ckfree ((char*) curPtr);
+ ckfree(curPtr);
break;
}
}
@@ -5652,9 +5359,9 @@ TestChannelCmd(clientData, interp, argc, argv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- chanPtr = (Channel *) chan;
+ chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
- chanPtr = statePtr->topChanPtr;
+ chanPtr = statePtr->topChanPtr;
chan = (Tcl_Channel) chanPtr;
} else {
/* lint */
@@ -5664,361 +5371,348 @@ TestChannelCmd(clientData, interp, argc, argv)
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {
- Tcl_Obj* msg = Tcl_NewStringObj (argv [3],-1);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
- Tcl_IncrRefCount (msg);
- Tcl_SetChannelError (chan, msg);
- Tcl_DecrRefCount (msg);
+ Tcl_IncrRefCount(msg);
+ Tcl_SetChannelError(chan, msg);
+ Tcl_DecrRefCount(msg);
- Tcl_GetChannelError (chan, &msg);
- Tcl_SetObjResult (interp, msg);
- Tcl_DecrRefCount (msg);
+ Tcl_GetChannelError(chan, &msg);
+ Tcl_SetObjResult(interp, msg);
+ Tcl_DecrRefCount(msg);
return TCL_OK;
}
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {
- Tcl_Obj* msg = Tcl_NewStringObj (argv [3],-1);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
- Tcl_IncrRefCount (msg);
- Tcl_SetChannelErrorInterp (interp, msg);
- Tcl_DecrRefCount (msg);
+ Tcl_IncrRefCount(msg);
+ Tcl_SetChannelErrorInterp(interp, msg);
+ Tcl_DecrRefCount(msg);
- Tcl_GetChannelErrorInterp (interp, &msg);
- Tcl_SetObjResult (interp, msg);
- Tcl_DecrRefCount (msg);
+ Tcl_GetChannelErrorInterp(interp, &msg);
+ Tcl_SetObjResult(interp, msg);
+ Tcl_DecrRefCount(msg);
return TCL_OK;
}
/*
- * "cut" is actually more a simplified detach facility as provided
- * by the Thread package. Without the safeguards of a regular
- * command (no checking that the command is truly cut'able, no
- * mutexes for thread-safety). Its complementary command is
- * "splice", see below.
+ * "cut" is actually more a simplified detach facility as provided by the
+ * Thread package. Without the safeguards of a regular command (no
+ * checking that the command is truly cut'able, no mutexes for
+ * thread-safety). Its complementary command is "splice", see below.
*/
if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
- TestChannel* det;
+ TestChannel *det;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " cut channelName\"", (char *) NULL);
- return TCL_ERROR;
- }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " cut channelName\"", NULL);
+ return TCL_ERROR;
+ }
- Tcl_RegisterChannel((Tcl_Interp *) NULL, chan); /* prevent closing */
+ Tcl_RegisterChannel(NULL, chan); /* prevent closing */
Tcl_UnregisterChannel(interp, chan);
- Tcl_CutChannel(chan);
+ Tcl_CutChannel(chan);
/* 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;
- return TCL_OK;
+ return TCL_OK;
}
if ((cmdName[0] == 'c') &&
(strncmp(cmdName, "clearchannelhandlers", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " clearchannelhandlers channelName\"", (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_ClearChannelHandlers(chan);
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clearchannelhandlers channelName\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_ClearChannelHandlers(chan);
+ return TCL_OK;
}
if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " info channelName\"", (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendElement(interp, argv[2]);
- Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
- if (statePtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (statePtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- Tcl_AppendElement(interp, "nonblocking");
- } else {
- Tcl_AppendElement(interp, "blocking");
- }
- if (statePtr->flags & CHANNEL_LINEBUFFERED) {
- Tcl_AppendElement(interp, "line");
- } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
- Tcl_AppendElement(interp, "none");
- } else {
- Tcl_AppendElement(interp, "full");
- }
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
- Tcl_AppendElement(interp, "async_flush");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (statePtr->flags & CHANNEL_EOF) {
- Tcl_AppendElement(interp, "eof");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (statePtr->flags & CHANNEL_BLOCKED) {
- Tcl_AppendElement(interp, "blocked");
- } else {
- Tcl_AppendElement(interp, "unblocked");
- }
- if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- if (statePtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "saw_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- Tcl_AppendElement(interp, "");
- } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- Tcl_AppendElement(interp, "");
- } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- if (statePtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "queued_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- }
- if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- }
- IOQueued = Tcl_InputBuffered(chan);
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- IOQueued = Tcl_OutputBuffered(chan);
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, (int)Tcl_Tell(chan));
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, statePtr->refCount);
- Tcl_AppendElement(interp, buf);
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " info channelName\"", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, argv[2]);
+ Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ Tcl_AppendElement(interp, "nonblocking");
+ } else {
+ Tcl_AppendElement(interp, "blocking");
+ }
+ if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+ Tcl_AppendElement(interp, "line");
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ Tcl_AppendElement(interp, "none");
+ } else {
+ Tcl_AppendElement(interp, "full");
+ }
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ Tcl_AppendElement(interp, "async_flush");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_EOF) {
+ Tcl_AppendElement(interp, "eof");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ Tcl_AppendElement(interp, "blocked");
+ } else {
+ Tcl_AppendElement(interp, "unblocked");
+ }
+ if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "saw_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "queued_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ }
+ if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ }
+ IOQueued = Tcl_InputBuffered(chan);
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
- return TCL_OK;
+ IOQueued = Tcl_OutputBuffered(chan);
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, (int)Tcl_Tell(chan));
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendElement(interp, buf);
+
+ return TCL_OK;
}
if ((cmdName[0] == 'i') &&
- (strncmp(cmdName, "inputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- IOQueued = Tcl_InputBuffered(chan);
- TclFormatInt(buf, IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
+ (strncmp(cmdName, "inputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+ IOQueued = Tcl_InputBuffered(chan);
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required", (char *) NULL);
- return TCL_ERROR;
- }
-
- TclFormatInt(buf, Tcl_IsChannelShared(chan));
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, Tcl_IsChannelShared(chan));
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+ Tcl_AppendResult(interp, "channel name required", NULL);
return TCL_ERROR;
}
-
+
TclFormatInt(buf, Tcl_IsStandardChannel(chan));
- Tcl_AppendResult(interp, buf, (char *) NULL);
+ Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
}
if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (statePtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (statePtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ return TCL_OK;
}
-
+
if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
- TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
+ TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL);
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, statePtr->channelName, NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- return TCL_OK;
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ return TCL_OK;
}
if ((cmdName[0] == 'o') &&
- (strncmp(cmdName, "outputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
+ (strncmp(cmdName, "outputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
- IOQueued = Tcl_OutputBuffered(chan);
- TclFormatInt(buf, IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
+ IOQueued = Tcl_OutputBuffered(chan);
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'q') &&
- (strncmp(cmdName, "queuedcr", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
+ (strncmp(cmdName, "queuedcr", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
- Tcl_AppendResult(interp,
- (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
- (char *) NULL);
- return TCL_OK;
+ Tcl_AppendResult(interp,
+ (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
- if (statePtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
}
if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- TclFormatInt(buf, statePtr->refCount);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
}
/*
- * "splice" is actually more a simplified attach facility as
- * provided by the Thread package. Without the safeguards of a
- * regular command (no checking that the command is truly
- * cut'able, no mutexes for thread-safety). Its complementary
- * command is "cut", see above.
+ * "splice" is actually more a simplified attach facility as provided by
+ * the Thread package. Without the safeguards of a regular command (no
+ * checking that the command is truly cut'able, no mutexes for
+ * thread-safety). Its complementary command is "cut", see above.
*/
if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required", (char *) NULL);
- return TCL_ERROR;
- }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
- Tcl_SpliceChannel(chan);
+ Tcl_SpliceChannel(chan);
Tcl_RegisterChannel(interp, chan);
- Tcl_UnregisterChannel((Tcl_Interp *)NULL, chan);
+ Tcl_UnregisterChannel(NULL, chan);
- return TCL_OK;
+ return TCL_OK;
}
if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr),
- (char *) NULL);
- return TCL_OK;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), NULL);
+ return TCL_OK;
}
if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
- if (statePtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
}
if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
@@ -6026,14 +5720,14 @@ TestChannelCmd(clientData, interp, argc, argv)
* Syntax: transform channel -command command
*/
- if (argc != 5) {
+ if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " transform channelId -command cmd\"", (char *) NULL);
- return TCL_ERROR;
- }
+ " transform channelId -command cmd\"", NULL);
+ return TCL_ERROR;
+ }
if (strcmp(argv[3], "-command") != 0) {
Tcl_AppendResult(interp, "bad argument \"", argv[3],
- "\": should be \"-command\"", (char *) NULL);
+ "\": should be \"-command\"", NULL);
return TCL_ERROR;
}
@@ -6046,18 +5740,17 @@ TestChannelCmd(clientData, interp, argc, argv)
* Syntax: unstack channel
*/
- if (argc != 3) {
+ if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " unstack channel\"", (char *) NULL);
- return TCL_ERROR;
- }
+ " unstack channel\"", NULL);
+ return TCL_ERROR;
+ }
return Tcl_UnstackChannel(interp, chan);
}
- Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
- "cut, clearchannelhandlers, info, isshared, mode, open, "
- "readable, splice, writable, transform, unstack",
- (char *) NULL);
+ Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be "
+ "cut, clearchannelhandlers, info, isshared, mode, open, "
+ "readable, splice, writable, transform, unstack", NULL);
return TCL_ERROR;
}
@@ -6066,8 +5759,8 @@ TestChannelCmd(clientData, interp, argc, argv)
*
* TestChannelEventCmd --
*
- * This procedure implements the "testchannelevent" command. It is
- * used to test the Tcl channel event mechanism.
+ * This procedure implements the "testchannelevent" command. It is used
+ * to test the Tcl channel event mechanism.
*
* Results:
* A standard Tcl result.
@@ -6080,198 +5773,197 @@ TestChannelCmd(clientData, interp, argc, argv)
/* ARGSUSED */
static int
-TestChannelEventCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- CONST char **argv; /* Argument strings. */
+TestChannelEventCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
{
Tcl_Obj *resultListPtr;
Channel *chanPtr;
ChannelState *statePtr; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
- CONST char *cmd;
+ const char *cmd;
int index, i, mask, len;
if ((argc < 3) || (argc > 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName cmd ?arg1? ?arg2?\"", NULL);
+ return TCL_ERROR;
}
chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
- if (chanPtr == (Channel *) NULL) {
- return TCL_ERROR;
+ if (chanPtr == NULL) {
+ return TCL_ERROR;
}
statePtr = chanPtr->state;
cmd = argv[2];
len = strlen(cmd);
if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName add eventSpec script\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (strcmp(argv[3], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[3], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[3], "none") == 0) {
- mask = 0;
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName add eventSpec script\"", NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[3], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[3], "none") == 0) {
+ mask = 0;
} else {
- Tcl_AppendResult(interp, "bad event name \"", argv[3],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
+ Tcl_AppendResult(interp, "bad event name \"", argv[3],
+ "\": must be readable, writable, or none", NULL);
+ return TCL_ERROR;
+ }
+
+ esPtr = ckalloc(sizeof(EventScriptRecord));
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
- esPtr = (EventScriptRecord *) ckalloc((unsigned)
- sizeof(EventScriptRecord));
- esPtr->nextPtr = statePtr->scriptRecordPtr;
- statePtr->scriptRecordPtr = esPtr;
-
- esPtr->chanPtr = chanPtr;
- esPtr->interp = interp;
- esPtr->mask = mask;
+ esPtr->chanPtr = chanPtr;
+ esPtr->interp = interp;
+ esPtr->mask = mask;
esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
Tcl_IncrRefCount(esPtr->scriptPtr);
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
-
- return TCL_OK;
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+
+ return TCL_OK;
}
if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = statePtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index\"", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != NULL);
i++, esPtr = esPtr->nextPtr) {
/* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
- if (esPtr == statePtr->scriptRecordPtr) {
- statePtr->scriptRecordPtr = esPtr->nextPtr;
- } else {
- for (prevEsPtr = statePtr->scriptRecordPtr;
- (prevEsPtr != (EventScriptRecord *) NULL) &&
+ }
+ if (esPtr == NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", NULL);
+ return TCL_ERROR;
+ }
+ if (esPtr == statePtr->scriptRecordPtr) {
+ statePtr->scriptRecordPtr = esPtr->nextPtr;
+ } else {
+ for (prevEsPtr = statePtr->scriptRecordPtr;
+ (prevEsPtr != NULL) &&
(prevEsPtr->nextPtr != esPtr);
prevEsPtr = prevEsPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (prevEsPtr == (EventScriptRecord *) NULL) {
- Tcl_Panic("TestChannelEventCmd: damaged event script list");
- }
- prevEsPtr->nextPtr = esPtr->nextPtr;
- }
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ /* Empty loop body. */
+ }
+ if (prevEsPtr == NULL) {
+ Tcl_Panic("TestChannelEventCmd: damaged event script list");
+ }
+ prevEsPtr->nextPtr = esPtr->nextPtr;
+ }
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
+ ckfree(esPtr);
- return TCL_OK;
+ return TCL_OK;
}
if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName list\"", (char *) NULL);
- return TCL_ERROR;
- }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName list\"", NULL);
+ return TCL_ERROR;
+ }
resultListPtr = Tcl_GetObjResult(interp);
- for (esPtr = statePtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != NULL;
esPtr = esPtr->nextPtr) {
if (esPtr->mask) {
- Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
(esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
- } else {
- Tcl_ListObjAppendElement(interp, resultListPtr,
+ } else {
+ Tcl_ListObjAppendElement(interp, resultListPtr,
Tcl_NewStringObj("none", -1));
}
- Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
- }
+ Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
+ }
Tcl_SetObjResult(interp, resultListPtr);
- return TCL_OK;
+ return TCL_OK;
}
if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName removeall\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (esPtr = statePtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName removeall\"", NULL);
+ return TCL_ERROR;
+ }
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != NULL;
esPtr = nextEsPtr) {
- nextEsPtr = esPtr->nextPtr;
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ nextEsPtr = esPtr->nextPtr;
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
- ckfree((char *) esPtr);
- }
- statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- return TCL_OK;
+ ckfree(esPtr);
+ }
+ statePtr->scriptRecordPtr = NULL;
+ return TCL_OK;
}
- if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index event\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = statePtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index event\"", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != NULL);
i++, esPtr = esPtr->nextPtr) {
/* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
+ }
+ if (esPtr == NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", NULL);
+ return TCL_ERROR;
+ }
- if (strcmp(argv[4], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[4], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[4], "none") == 0) {
- mask = 0;
+ if (strcmp(argv[4], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[4], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[4], "none") == 0) {
+ mask = 0;
} else {
- Tcl_AppendResult(interp, "bad event name \"", argv[4],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
+ Tcl_AppendResult(interp, "bad event name \"", argv[4],
+ "\": must be readable, writable, or none", NULL);
+ return TCL_ERROR;
+ }
esPtr->mask = mask;
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
return TCL_OK;
- }
- Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
- "add, delete, list, set, or removeall", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of "
+ "add, delete, list, set, or removeall", NULL);
return TCL_ERROR;
}
@@ -6292,14 +5984,14 @@ TestChannelEventCmd(dummy, interp, argc, argv)
*/
static int
-TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestWrongNumArgsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int i, length;
- char *msg;
+ const char *msg;
if (objc < 3) {
/*
@@ -6309,7 +6001,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
return TCL_ERROR;
}
-
+
if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
return TCL_ERROR;
}
@@ -6318,7 +6010,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
if (length == 0) {
msg = NULL;
}
-
+
if (i > objc - 3) {
/*
* Asked for more arguments than were given.
@@ -6348,14 +6040,14 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
*/
static int
-TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- char *ary[] = {
- "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL
+TestGetIndexFromObjStructObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *const ary[] = {
+ "a", "b", "c", "d", "e", "f", NULL, NULL
};
int idx,target;
@@ -6364,7 +6056,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
- "dummy", 0, &idx) != TCL_OK) {
+ "dummy", 0, &idx) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
@@ -6374,7 +6066,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
char buffer[64];
sprintf(buffer, "%d", idx);
Tcl_AppendResult(interp, "index value comparison failed: got ",
- buffer, NULL);
+ buffer, NULL);
sprintf(buffer, "%d", target);
Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
return TCL_ERROR;
@@ -6388,9 +6080,9 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
*
* TestFilesystemObjCmd --
*
- * This procedure implements the "testfilesystem" command. It is
- * used to test Tcl_FSRegister, Tcl_FSUnregister, and can be used
- * to test that the pluggable filesystem works.
+ * This procedure implements the "testfilesystem" command. It is used to
+ * test Tcl_FSRegister, Tcl_FSUnregister, and can be used to test that
+ * the pluggable filesystem works.
*
* Results:
* A standard Tcl result.
@@ -6402,15 +6094,15 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
*/
static int
-TestFilesystemObjCmd(dummy, interp, objc, objv)
- ClientData dummy;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+TestFilesystemObjCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
int res, boolVal;
- char *msg;
-
+ const char *msg;
+
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
return TCL_ERROR;
@@ -6425,82 +6117,94 @@ TestFilesystemObjCmd(dummy, interp, objc, objv)
res = Tcl_FSUnregister(&testReportingFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetResult(interp, msg, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
return res;
}
-static int
-TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
+static int
+TestReportInFilesystem(
+ Tcl_Obj *pathPtr,
+ ClientData *clientDataPtr)
{
- static Tcl_Obj* lastPathPtr = NULL;
-
+ static Tcl_Obj *lastPathPtr = NULL;
+ Tcl_Obj *newPathPtr;
+
if (pathPtr == lastPathPtr) {
/* Reject all files second time around */
- return -1;
- } else {
- Tcl_Obj * newPathPtr;
- /* Try to claim all files first time around */
-
- newPathPtr = Tcl_DuplicateObj(pathPtr);
- lastPathPtr = newPathPtr;
- Tcl_IncrRefCount(newPathPtr);
- if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
- /* Nothing claimed it. Therefore we don't either */
- Tcl_DecrRefCount(newPathPtr);
- lastPathPtr = NULL;
- return -1;
- } else {
- lastPathPtr = NULL;
- *clientDataPtr = (ClientData) newPathPtr;
- return TCL_OK;
- }
+ return -1;
+ }
+
+ /* Try to claim all files first time around */
+
+ newPathPtr = Tcl_DuplicateObj(pathPtr);
+ lastPathPtr = newPathPtr;
+ Tcl_IncrRefCount(newPathPtr);
+ if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
+ /* Nothing claimed it. Therefore we don't either */
+ Tcl_DecrRefCount(newPathPtr);
+ lastPathPtr = NULL;
+ return -1;
}
+ lastPathPtr = NULL;
+ *clientDataPtr = (ClientData) newPathPtr;
+ return TCL_OK;
}
-/*
- * Simple helper function to extract the native vfs representation of a
- * path object, or NULL if no such representation exists.
+/*
+ * Simple helper function to extract the native vfs representation of a path
+ * object, or NULL if no such representation exists.
*/
-static Tcl_Obj*
-TestReportGetNativePath(Tcl_Obj* pathPtr) {
+
+static Tcl_Obj *
+TestReportGetNativePath(
+ Tcl_Obj *pathPtr)
+{
return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem);
}
-static void
-TestReportFreeInternalRep(ClientData clientData) {
- Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
+static void
+TestReportFreeInternalRep(
+ ClientData clientData)
+{
+ Tcl_Obj *nativeRep = (Tcl_Obj *) clientData;
+
if (nativeRep != NULL) {
/* Free the path */
Tcl_DecrRefCount(nativeRep);
}
}
-static ClientData
-TestReportDupInternalRep(ClientData clientData) {
- Tcl_Obj *original = (Tcl_Obj*)clientData;
+static ClientData
+TestReportDupInternalRep(
+ ClientData clientData)
+{
+ Tcl_Obj *original = (Tcl_Obj *) clientData;
+
Tcl_IncrRefCount(original);
return clientData;
}
static void
-TestReport(cmd, path, arg2)
- CONST char* cmd;
- Tcl_Obj* path;
- Tcl_Obj* arg2;
+TestReport(
+ const char *cmd,
+ Tcl_Obj *path,
+ Tcl_Obj *arg2)
{
- Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
+ Tcl_Interp *interp = (Tcl_Interp *) Tcl_FSData(&testReportingFilesystem);
+
if (interp == NULL) {
/* This is bad, but not much we can do about it */
} else {
- /*
- * No idea why I decided to program this up using the
- * old string-based API, but there you go. We should
- * convert it to objects.
+ /*
+ * No idea why I decided to program this up using the old string-based
+ * API, but there you go. We should convert it to objects.
*/
- Tcl_SavedResult savedResult;
+
+ Tcl_Obj *savedResult;
Tcl_DString ds;
+
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "lappend filesystemReport ",-1);
+ Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
Tcl_DStringStartSublist(&ds);
Tcl_DStringAppendElement(&ds, cmd);
if (path != NULL) {
@@ -6510,251 +6214,271 @@ TestReport(cmd, path, arg2)
Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
}
Tcl_DStringEndSublist(&ds);
- Tcl_SaveResult(interp, &savedResult);
+ savedResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(savedResult);
+ Tcl_SetObjResult(interp, Tcl_NewObj());
Tcl_Eval(interp, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
- Tcl_RestoreResult(interp, &savedResult);
- }
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, savedResult);
+ Tcl_DecrRefCount(savedResult);
+ }
}
static int
-TestReportStat(path, buf)
- Tcl_Obj *path; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+TestReportStat(
+ Tcl_Obj *path, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
- TestReport("stat",path, NULL);
- return Tcl_FSStat(TestReportGetNativePath(path),buf);
+ TestReport("stat", path, NULL);
+ return Tcl_FSStat(TestReportGetNativePath(path), buf);
}
+
static int
-TestReportLstat(path, buf)
- Tcl_Obj *path; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+TestReportLstat(
+ Tcl_Obj *path, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
- TestReport("lstat",path, NULL);
- return Tcl_FSLstat(TestReportGetNativePath(path),buf);
+ TestReport("lstat", path, NULL);
+ return Tcl_FSLstat(TestReportGetNativePath(path), buf);
}
+
static int
-TestReportAccess(path, mode)
- Tcl_Obj *path; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+TestReportAccess(
+ Tcl_Obj *path, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
- TestReport("access",path,NULL);
- return Tcl_FSAccess(TestReportGetNativePath(path),mode);
+ TestReport("access", path, NULL);
+ return Tcl_FSAccess(TestReportGetNativePath(path), mode);
}
+
static Tcl_Channel
-TestReportOpenFileChannel(interp, fileName, mode, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- Tcl_Obj *fileName; /* Name of file to open. */
- int mode; /* POSIX open mode. */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
-{
- TestReport("open",fileName, NULL);
+TestReportOpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
+ * NULL. */
+ Tcl_Obj *fileName, /* Name of file to open. */
+ int mode, /* POSIX open mode. */
+ int permissions) /* If the open involves creating a file, with
+ * what modes to create it? */
+{
+ TestReport("open", fileName, NULL);
return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName),
- mode, permissions);
+ mode, permissions);
}
static int
-TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter for error
- * messages. */
- Tcl_Obj *resultPtr; /* Object to lappend results. */
- Tcl_Obj *dirPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+TestReportMatchInDirectory(
+ Tcl_Interp *interp, /* Interpreter for error messages. */
+ Tcl_Obj *resultPtr, /* Object to lappend results. */
+ Tcl_Obj *dirPtr, /* Contains path to directory to search. */
+ const char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. */
{
if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
- TestReport("matchmounts",dirPtr, NULL);
+ TestReport("matchmounts", dirPtr, NULL);
return TCL_OK;
} else {
- TestReport("matchindirectory",dirPtr, NULL);
- return Tcl_FSMatchInDirectory(interp, resultPtr,
- TestReportGetNativePath(dirPtr), pattern,
- types);
+ TestReport("matchindirectory", dirPtr, NULL);
+ return Tcl_FSMatchInDirectory(interp, resultPtr,
+ TestReportGetNativePath(dirPtr), pattern, types);
}
}
+
static int
-TestReportChdir(dirName)
- Tcl_Obj *dirName;
+TestReportChdir(
+ Tcl_Obj *dirName)
{
- TestReport("chdir",dirName,NULL);
+ TestReport("chdir", dirName, NULL);
return Tcl_FSChdir(TestReportGetNativePath(dirName));
}
+
static int
-TestReportLoadFile(interp, fileName,
- handlePtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *fileName; /* Name of the file containing the desired
+TestReportLoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *fileName, /* Name of the file containing the desired
* code. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ Tcl_LoadHandle *handlePtr, /* 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. */
{
- TestReport("loadfile",fileName,NULL);
- return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL, NULL,
- NULL, NULL, handlePtr, unloadProcPtr);
+ TestReport("loadfile", fileName, NULL);
+ return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL,
+ NULL, NULL, NULL, handlePtr, unloadProcPtr);
}
+
static Tcl_Obj *
-TestReportLink(path, to, linkType)
- Tcl_Obj *path; /* Path of file to readlink or link */
- Tcl_Obj *to; /* Path of file to link to, or NULL */
- int linkType;
+TestReportLink(
+ Tcl_Obj *path, /* Path of file to readlink or link */
+ Tcl_Obj *to, /* Path of file to link to, or NULL */
+ int linkType)
{
- TestReport("link",path,to);
+ TestReport("link", path, to);
return Tcl_FSLink(TestReportGetNativePath(path), to, linkType);
}
+
static int
-TestReportRenameFile(src, dst)
- Tcl_Obj *src; /* Pathname of file or dir to be renamed
+TestReportRenameFile(
+ Tcl_Obj *src, /* Pathname of file or dir to be renamed
* (UTF-8). */
- Tcl_Obj *dst; /* New pathname of file or directory
+ Tcl_Obj *dst) /* New pathname of file or directory
* (UTF-8). */
{
- TestReport("renamefile",src,dst);
- return Tcl_FSRenameFile(TestReportGetNativePath(src),
- TestReportGetNativePath(dst));
+ TestReport("renamefile", src, dst);
+ return Tcl_FSRenameFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
-static int
-TestReportCopyFile(src, dst)
- Tcl_Obj *src; /* Pathname of file to be copied (UTF-8). */
- Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */
+
+static int
+TestReportCopyFile(
+ Tcl_Obj *src, /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *dst) /* Pathname of file to copy to (UTF-8). */
{
- TestReport("copyfile",src,dst);
- return Tcl_FSCopyFile(TestReportGetNativePath(src),
- TestReportGetNativePath(dst));
+ TestReport("copyfile", src, dst);
+ return Tcl_FSCopyFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
+
static int
-TestReportDeleteFile(path)
- Tcl_Obj *path; /* Pathname of file to be removed (UTF-8). */
+TestReportDeleteFile(
+ Tcl_Obj *path) /* Pathname of file to be removed (UTF-8). */
{
- TestReport("deletefile",path,NULL);
+ TestReport("deletefile", path, NULL);
return Tcl_FSDeleteFile(TestReportGetNativePath(path));
}
+
static int
-TestReportCreateDirectory(path)
- Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */
+TestReportCreateDirectory(
+ Tcl_Obj *path) /* Pathname of directory to create (UTF-8). */
{
- TestReport("createdirectory",path,NULL);
+ TestReport("createdirectory", path, NULL);
return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
}
+
static int
-TestReportCopyDirectory(src, dst, errorPtr)
- Tcl_Obj *src; /* Pathname of directory to be copied
+TestReportCopyDirectory(
+ Tcl_Obj *src, /* Pathname of directory to be copied
* (UTF-8). */
- Tcl_Obj *dst; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
- * of file causing error. */
+ Tcl_Obj *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_Obj **errorPtr) /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
- TestReport("copydirectory",src,dst);
- return Tcl_FSCopyDirectory(TestReportGetNativePath(src),
- TestReportGetNativePath(dst), errorPtr);
+ TestReport("copydirectory", src, dst);
+ return Tcl_FSCopyDirectory(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst), errorPtr);
}
+
static int
-TestReportRemoveDirectory(path, recursive, errorPtr)
- Tcl_Obj *path; /* Pathname of directory to be removed
+TestReportRemoveDirectory(
+ Tcl_Obj *path, /* Pathname of directory to be removed
* (UTF-8). */
- int recursive; /* If non-zero, removes directories that
+ int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
- * of file causing error. */
+ Tcl_Obj **errorPtr) /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
- TestReport("removedirectory",path,NULL);
- return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
- errorPtr);
+ TestReport("removedirectory", path, NULL);
+ return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
+ errorPtr);
}
-static CONST char**
-TestReportFileAttrStrings(fileName, objPtrRef)
- Tcl_Obj* fileName;
- Tcl_Obj** objPtrRef;
+
+static const char *const *
+TestReportFileAttrStrings(
+ Tcl_Obj *fileName,
+ Tcl_Obj **objPtrRef)
{
- TestReport("fileattributestrings",fileName,NULL);
+ TestReport("fileattributestrings", fileName, NULL);
return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
}
+
static int
-TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *fileName; /* filename we are operating on. */
- Tcl_Obj **objPtrRef; /* for output. */
+TestReportFileAttrsGet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *fileName, /* filename we are operating on. */
+ Tcl_Obj **objPtrRef) /* for output. */
{
- TestReport("fileattributesget",fileName,NULL);
- return Tcl_FSFileAttrsGet(interp, index,
- TestReportGetNativePath(fileName), objPtrRef);
+ TestReport("fileattributesget", fileName, NULL);
+ return Tcl_FSFileAttrsGet(interp, index,
+ TestReportGetNativePath(fileName), objPtrRef);
}
+
static int
-TestReportFileAttrsSet(interp, index, fileName, objPtr)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *fileName; /* filename we are operating on. */
- Tcl_Obj *objPtr; /* for input. */
-{
- TestReport("fileattributesset",fileName,objPtr);
- return Tcl_FSFileAttrsSet(interp, index,
- TestReportGetNativePath(fileName), objPtr);
-}
-static int
-TestReportUtime (fileName, tval)
- Tcl_Obj* fileName;
- struct utimbuf *tval;
-{
- TestReport("utime",fileName,NULL);
+TestReportFileAttrsSet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *fileName, /* filename we are operating on. */
+ Tcl_Obj *objPtr) /* for input. */
+{
+ TestReport("fileattributesset", fileName, objPtr);
+ return Tcl_FSFileAttrsSet(interp, index,
+ TestReportGetNativePath(fileName), objPtr);
+}
+
+static int
+TestReportUtime(
+ Tcl_Obj *fileName,
+ struct utimbuf *tval)
+{
+ TestReport("utime", fileName, NULL);
return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
}
+
static int
-TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
- Tcl_Interp *interp;
- Tcl_Obj *pathPtr;
- int nextCheckpoint;
+TestReportNormalizePath(
+ Tcl_Interp *interp,
+ Tcl_Obj *pathPtr,
+ int nextCheckpoint)
{
- TestReport("normalizepath",pathPtr,NULL);
+ TestReport("normalizepath", pathPtr, NULL);
return nextCheckpoint;
}
-static int
-SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
- CONST char *str = Tcl_GetString(pathPtr);
- if (strncmp(str,"simplefs:/",10)) {
+static int
+SimplePathInFilesystem(
+ Tcl_Obj *pathPtr,
+ ClientData *clientDataPtr)
+{
+ const char *str = Tcl_GetString(pathPtr);
+
+ if (strncmp(str, "simplefs:/", 10)) {
return -1;
}
return TCL_OK;
}
-/*
- * This is a slightly 'hacky' filesystem which is used just to test a
- * few important features of the vfs code: (1) that you can load a
- * shared library from a vfs, (2) that when copying files from one fs to
- * another, the 'mtime' is preserved. (3) that recursive
- * cross-filesystem directory copies have the correct behaviour
- * with/without -force.
- *
- * It treats any file in 'simplefs:/' as a file, which it
- * routes to the current directory. The real file it uses is
- * whatever follows the trailing '/' (e.g. 'foo' in 'simplefs:/foo'),
- * and that file exists or not according to what is in the native
- * pwd.
- *
- * Please do not consider this filesystem a model of how
- * things are to be done. It is quite the opposite! But, it
- * does allow us to test some important features.
+/*
+ * This is a slightly 'hacky' filesystem which is used just to test a few
+ * important features of the vfs code: (1) that you can load a shared library
+ * from a vfs, (2) that when copying files from one fs to another, the 'mtime'
+ * is preserved. (3) that recursive cross-filesystem directory copies have the
+ * correct behaviour with/without -force.
+ *
+ * It treats any file in 'simplefs:/' as a file, which it routes to the
+ * current directory. The real file it uses is whatever follows the trailing
+ * '/' (e.g. 'foo' in 'simplefs:/foo'), and that file exists or not according
+ * to what is in the native pwd.
+ *
+ * Please do not consider this filesystem a model of how things are to be
+ * done. It is quite the opposite! But, it does allow us to test some
+ * important features.
*/
+
static int
-TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
- ClientData dummy;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+TestSimpleFilesystemObjCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
int res, boolVal;
- char *msg;
-
+ const char *msg;
+
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
return TCL_ERROR;
@@ -6769,44 +6493,46 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
res = Tcl_FSUnregister(&simpleFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetResult(interp, msg, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
return res;
}
-/*
- * Treats a file name 'simplefs:/foo' by using the file 'foo'
- * in the current (native) directory.
+/*
+ * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
+ * (native) directory.
*/
-static Tcl_Obj*
-SimpleRedirect(pathPtr)
- Tcl_Obj *pathPtr; /* Name of file to copy. */
+
+static Tcl_Obj *
+SimpleRedirect(
+ Tcl_Obj *pathPtr) /* Name of file to copy. */
{
int len;
- CONST char *str;
+ const char *str;
Tcl_Obj *origPtr;
- /*
+ /*
* We assume the same name in the current directory is ok.
*/
+
str = Tcl_GetStringFromObj(pathPtr, &len);
if (len < 10 || strncmp(str, "simplefs:/", 10)) {
/* Probably shouldn't ever reach here */
Tcl_IncrRefCount(pathPtr);
return pathPtr;
- }
+ }
origPtr = Tcl_NewStringObj(str+10,-1);
Tcl_IncrRefCount(origPtr);
return origPtr;
}
static int
-SimpleMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter for error
+SimpleMatchInDirectory(
+ Tcl_Interp *interp, /* Interpreter for error
* messages. */
- Tcl_Obj *resultPtr; /* Object to lappend results. */
- Tcl_Obj *dirPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ Tcl_Obj *resultPtr, /* Object to lappend results. */
+ Tcl_Obj *dirPtr, /* Contains path to directory to search. */
+ const char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. */
{
int res;
@@ -6817,14 +6543,13 @@ SimpleMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
return TCL_OK;
}
-
- /*
+
+ /*
* We assume the same name in the current directory is ok.
*/
resPtr = Tcl_NewObj();
Tcl_IncrRefCount(resPtr);
origPtr = SimpleRedirect(dirPtr);
- Tcl_IncrRefCount(origPtr);
res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
if (res == TCL_OK) {
int gLength, j;
@@ -6843,63 +6568,59 @@ SimpleMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
}
static Tcl_Channel
-SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- Tcl_Obj *pathPtr; /* Name of file to open. */
- int mode; /* POSIX open mode. */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
+SimpleOpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
+ * NULL. */
+ Tcl_Obj *pathPtr, /* Name of file to open. */
+ int mode, /* POSIX open mode. */
+ int permissions) /* If the open involves creating a file, with
+ * what modes to create it? */
{
Tcl_Obj *tempPtr;
Tcl_Channel chan;
-
+
if ((mode != 0) && !(mode & O_RDONLY)) {
- Tcl_AppendResult(interp, "read-only",
- (char *) NULL);
+ Tcl_AppendResult(interp, "read-only", NULL);
return NULL;
}
-
+
tempPtr = SimpleRedirect(pathPtr);
-
chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
-
Tcl_DecrRefCount(tempPtr);
return chan;
}
static int
-SimpleAccess(pathPtr, mode)
- Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+SimpleAccess(
+ Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
- int res;
Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
- res = Tcl_FSAccess(tempPtr, mode);
+ int res = Tcl_FSAccess(tempPtr, mode);
+
Tcl_DecrRefCount(tempPtr);
return res;
}
static int
-SimpleStat(pathPtr, bufPtr)
- Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
+SimpleStat(
+ Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */
{
- int res;
Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
- res = Tcl_FSStat(tempPtr, bufPtr);
+ int res = Tcl_FSStat(tempPtr, bufPtr);
+
Tcl_DecrRefCount(tempPtr);
return res;
}
-static Tcl_Obj*
+static Tcl_Obj *
SimpleListVolumes(void)
{
/* Add one new volume */
Tcl_Obj *retVal;
- retVal = Tcl_NewStringObj("simplefs:/",-1);
+ retVal = Tcl_NewStringObj("simplefs:/", -1);
Tcl_IncrRefCount(retVal);
return retVal;
}
@@ -6907,15 +6628,17 @@ SimpleListVolumes(void)
/*
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
+
static int
-TestNumUtfCharsCmd(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+TestNumUtfCharsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
+
if (objc > 2) {
(void) Tcl_GetStringFromObj(objv[1], &len);
}
@@ -6924,18 +6647,75 @@ TestNumUtfCharsCmd(clientData, interp, objc, objv)
}
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
*/
+
static int
-TestHashSystemHashCmd(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+TestHashSystemHashCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
- static Tcl_HashKeyType hkType = {
+ static const Tcl_HashKeyType hkType = {
TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
NULL, NULL, NULL, NULL
};
@@ -6956,14 +6736,14 @@ TestHashSystemHashCmd(clientData, interp, objc, objv)
}
for (i=0 ; i<limit ; i++) {
- hPtr = Tcl_CreateHashEntry(&hash, (char *)i, &isNew);
+ hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
- Tcl_SetHashValue(hPtr, (ClientData) (i+42));
+ Tcl_SetHashValue(hPtr, INT2PTR(i+42));
}
if (hash.numEntries != limit) {
@@ -6973,14 +6753,14 @@ TestHashSystemHashCmd(clientData, interp, objc, objv)
}
for (i=0 ; i<limit ; i++) {
- hPtr = Tcl_FindHashEntry(&hash, (char *)i);
+ hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
- if ((int)(Tcl_GetHashValue(hPtr)) != i+42) {
+ if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
Tcl_DeleteHashTable(&hash);
@@ -7005,18 +6785,17 @@ TestHashSystemHashCmd(clientData, interp, objc, objv)
* core very much.
*/
static int
-TestgetintCmd(dummy, interp, argc, argv)
- ClientData dummy;
- Tcl_Interp *interp;
- int argc;
- CONST char **argv;
+TestgetintCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int argc,
+ const char **argv)
{
if (argc < 2) {
Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
return TCL_ERROR;
} else {
- int val,i,total=0;
- char buf[TCL_INTEGER_SPACE];
+ int val, i, total=0;
for (i=1 ; i<argc ; i++) {
if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
@@ -7024,16 +6803,592 @@ TestgetintCmd(dummy, interp, argc, argv)
}
total += val;
}
- TclFormatInt(buf, total);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
return TCL_OK;
}
}
+static int
+TestNRELevels(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ static ptrdiff_t *refDepth = NULL;
+ ptrdiff_t depth;
+ Tcl_Obj *levels[6];
+ int i = 0;
+ NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
+
+ if (refDepth == NULL) {
+ refDepth = &depth;
+ }
+
+ depth = (refDepth - &depth);
+
+ levels[0] = Tcl_NewIntObj(depth);
+ 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);
+
+ while (cbPtr) {
+ i++;
+ cbPtr = cbPtr->nextPtr;
+ }
+ levels[5] = Tcl_NewIntObj(i);
+
+ Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestconcatobjCmd --
+ *
+ * This procedure implements the "testconcatobj" command. It is used
+ * to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
+ * cases and thet it never corrupts its arguments. In other words, that
+ * [Bug 1447328] was fixed properly.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestconcatobjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
+ int result = TCL_OK, len;
+ Tcl_Obj *objv[3];
+
+ /*
+ * Set the start of the error message as obj result; it will be cleared at
+ * the end if no errors were found.
+ */
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));
+
+ emptyPtr = Tcl_NewObj();
+
+ list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
+ Tcl_ListObjLength(NULL, list1Ptr, &len);
+ if (list1Ptr->bytes != NULL) {
+ ckfree(list1Ptr->bytes);
+ list1Ptr->bytes = NULL;
+ }
+
+ list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
+ Tcl_ListObjLength(NULL, list2Ptr, &len);
+ if (list2Ptr->bytes != NULL) {
+ ckfree(list2Ptr->bytes);
+ list2Ptr->bytes = NULL;
+ }
+
+ /*
+ * Verify that concat'ing a list obj with one or more empty strings does
+ * return a fresh Tcl_Obj (see also [Bug 2055782]).
+ */
+
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+
+ objv[0] = tmpPtr;
+ objv[1] = emptyPtr;
+ concatPtr = Tcl_ConcatObj(2, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (a) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ",
+ NULL);
+ switch (tmpPtr->refCount) {
+ case 0:
+ Tcl_AppendResult(interp, "(no new refCount)", NULL);
+ break;
+ case 1:
+ Tcl_AppendResult(interp, "(refCount added)", NULL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[0] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ Tcl_IncrRefCount(tmpPtr);
+ concatPtr = Tcl_ConcatObj(2, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (b) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ",
+ NULL);
+ switch (tmpPtr->refCount) {
+ case 0:
+ Tcl_AppendResult(interp, "(refCount removed?)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ break;
+ case 1:
+ Tcl_AppendResult(interp, "(no new refCount)", NULL);
+ break;
+ case 2:
+ Tcl_AppendResult(interp, "(refCount added)", NULL);
+ Tcl_DecrRefCount(tmpPtr);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[0] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ objv[0] = emptyPtr;
+ objv[1] = tmpPtr;
+ objv[2] = emptyPtr;
+ concatPtr = Tcl_ConcatObj(3, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (c) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ",
+ NULL);
+ switch (tmpPtr->refCount) {
+ case 0:
+ Tcl_AppendResult(interp, "(no new refCount)", NULL);
+ break;
+ case 1:
+ Tcl_AppendResult(interp, "(refCount added)", NULL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[1] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ Tcl_IncrRefCount(tmpPtr);
+ concatPtr = Tcl_ConcatObj(3, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (d) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ",
+ NULL);
+ switch (tmpPtr->refCount) {
+ case 0:
+ Tcl_AppendResult(interp, "(refCount removed?)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ break;
+ case 1:
+ Tcl_AppendResult(interp, "(no new refCount)", NULL);
+ break;
+ case 2:
+ Tcl_AppendResult(interp, "(refCount added)", NULL);
+ Tcl_DecrRefCount(tmpPtr);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+ Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[1] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ /*
+ * Verify that an unshared list is not corrupted when concat'ing things to
+ * it.
+ */
+
+ objv[0] = tmpPtr;
+ objv[1] = list2Ptr;
+ concatPtr = Tcl_ConcatObj(2, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (e) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ int len;
+
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ",
+ NULL);
+
+ (void) Tcl_ListObjLength(NULL, concatPtr, &len);
+ switch (tmpPtr->refCount) {
+ case 3:
+ Tcl_AppendResult(interp, "(failed to concat)", NULL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+ }
+ if (Tcl_IsShared(tmpPtr)) {
+ Tcl_DecrRefCount(tmpPtr);
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[0] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ objv[0] = tmpPtr;
+ objv[1] = list2Ptr;
+ Tcl_IncrRefCount(tmpPtr);
+ concatPtr = Tcl_ConcatObj(2, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (f) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ int len;
+
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
+ NULL);
+
+ (void) Tcl_ListObjLength(NULL, concatPtr, &len);
+ switch (tmpPtr->refCount) {
+ case 3:
+ Tcl_AppendResult(interp, "(failed to concat)", NULL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+ }
+ if (Tcl_IsShared(tmpPtr)) {
+ Tcl_DecrRefCount(tmpPtr);
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[0] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ objv[0] = tmpPtr;
+ objv[1] = list2Ptr;
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ concatPtr = Tcl_ConcatObj(2, objv);
+ if (concatPtr->refCount != 0) {
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\n\t* (g) concatObj does not have refCount 0", NULL);
+ }
+ if (concatPtr == tmpPtr) {
+ int len;
+
+ result = TCL_ERROR;
+ Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
+ NULL);
+
+ (void) Tcl_ListObjLength(NULL, concatPtr, &len);
+ switch (tmpPtr->refCount) {
+ case 3:
+ Tcl_AppendResult(interp, "(failed to concat)", NULL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+ }
+ Tcl_DecrRefCount(tmpPtr);
+ if (Tcl_IsShared(tmpPtr)) {
+ Tcl_DecrRefCount(tmpPtr);
+ }
+ tmpPtr = Tcl_DuplicateObj(list1Ptr);
+ objv[0] = tmpPtr;
+ }
+ Tcl_DecrRefCount(concatPtr);
+
+ /*
+ * Clean everything up. Note that we don't actually know how many
+ * references there are to tmpPtr here; in the no-error case, it should be
+ * five... [Bug 2895367]
+ */
+
+ Tcl_DecrRefCount(list1Ptr);
+ Tcl_DecrRefCount(list2Ptr);
+ Tcl_DecrRefCount(emptyPtr);
+ while (tmpPtr->refCount > 1) {
+ Tcl_DecrRefCount(tmpPtr);
+ }
+ Tcl_DecrRefCount(tmpPtr);
+
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 1a07b87..f36b07f 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1,83 +1,86 @@
-/*
+/*
* tclTestObj.c --
*
- * This file contains C command procedures for the additional Tcl
- * commands that are used for testing implementations of the Tcl object
- * types. These commands are not normally included in Tcl
- * applications; they're only used for testing.
+ * This file contains C command functions for the additional Tcl commands
+ * that are used for testing implementations of the Tcl object types.
+ * These commands are not normally included in Tcl applications; they're
+ * only used for testing.
*
* Copyright (c) 1995-1998 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
* Copyright (c) 2005 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: tclTestObj.c,v 1.14 2005/06/07 09:18:14 dkf 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
+# define USE_TCL_STUBS
+#endif
#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 procedures defined later in this file:
+ * Forward declarations for functions defined later in this file:
*/
-static int CheckIfVarUnset _ANSI_ARGS_((Tcl_Interp *interp,
- int varIndex));
-static int GetVariableIndex _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *indexPtr));
-static void SetVarToObj _ANSI_ARGS_((int varIndex,
- Tcl_Obj *objPtr));
-int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-static int TestbignumobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestbooleanobjCmd _ANSI_ARGS_((ClientData dummy,
+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(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,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestconvertobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestdoubleobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestindexobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestintobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TestobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
+ Tcl_Obj *const objv[]);
+static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
typedef struct TestString {
int numChars;
- size_t allocated;
- size_t uallocated;
+ int allocated;
+ int maxChars;
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);
+}
/*
*----------------------------------------------------------------------
*
* TclObjTest_Init --
*
- * This procedure creates additional commands that are used to test the
+ * This function creates additional commands that are used to test the
* Tcl object support.
*
* Results:
@@ -91,31 +94,41 @@ typedef struct TestString {
*/
int
-TclObjTest_Init(interp)
- Tcl_Interp *interp;
+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;
+ varPtr[i] = NULL;
}
-
- Tcl_CreateObjCommand( interp, "testbignumobj", TestbignumobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
+
+ Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
return TCL_OK;
}
@@ -124,7 +137,7 @@ TclObjTest_Init(interp)
*
* TestbignumobjCmd --
*
- * This procedure implmenets the "testbignumobj" command. It is used
+ * This function implmenets the "testbignumobj" command. It is used
* to exercise the bignum Tcl object type implementation.
*
* Results:
@@ -138,26 +151,25 @@ TclObjTest_Init(interp)
*/
static int
-TestbignumobjCmd( clientData, interp, objc, objv )
- ClientData clientData; /* unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Argument count */
- Tcl_Obj* CONST objv[]; /* Argument vector */
+TestbignumobjCmd(
+ ClientData clientData, /* unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Argument count */
+ Tcl_Obj *const objv[]) /* Argument vector */
{
- const char * subcmds[] = {
- "set", "get", "mult10", "div10",
- NULL
+ const char *const subcmds[] = {
+ "set", "get", "mult10", "div10", NULL
};
enum options {
- BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
+ BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
};
-
int index, varIndex;
- char* string;
+ const char *string;
mp_int bignumValue, newValue;
+ Tcl_Obj **varPtr;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?...");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
@@ -168,6 +180,7 @@ TestbignumobjCmd( clientData, interp, objc, objv )
if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
switch (index) {
case BIGNUM_SET:
@@ -189,27 +202,26 @@ TestbignumobjCmd( clientData, interp, objc, objv )
}
/*
- * If the object currently bound to the variable with index
- * varIndex has ref count 1 (i.e. the object is unshared) we can
- * modify that object directly. Otherwise, if RC>1 (i.e. the
- * object is shared), we must create a new object to modify/set and
- * decrement the old formerly-shared object's ref count. This is
- * "copy on write".
+ * If the object currently bound to the variable with index varIndex
+ * has ref count 1 (i.e. the object is unshared) we can modify that
+ * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+ * we must create a new object to modify/set and decrement the old
+ * formerly-shared object's ref count. This is "copy on write".
*/
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;
-
+
case BIGNUM_GET:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
break;
@@ -219,14 +231,14 @@ TestbignumobjCmd( clientData, interp, objc, objv )
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],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
- if (mp_init(&newValue) != MP_OKAY
+ if (mp_init(&newValue) != MP_OKAY
|| (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
mp_clear(&bignumValue);
mp_clear(&newValue);
@@ -238,7 +250,7 @@ TestbignumobjCmd( clientData, interp, objc, objv )
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
break;
@@ -247,14 +259,14 @@ TestbignumobjCmd( clientData, interp, objc, objv )
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],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
- if (mp_init(&newValue) != MP_OKAY
+ if (mp_init(&newValue) != MP_OKAY
|| (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) {
mp_clear(&bignumValue);
mp_clear(&newValue);
@@ -266,7 +278,7 @@ TestbignumobjCmd( clientData, interp, objc, objv )
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
}
@@ -279,8 +291,8 @@ TestbignumobjCmd( clientData, interp, objc, objv )
*
* TestbooleanobjCmd --
*
- * This procedure implements the "testbooleanobj" command. It is used
- * to test the boolean Tcl object type implementation.
+ * This function implements the "testbooleanobj" command. It is used to
+ * test the boolean Tcl object type implementation.
*
* Results:
* A standard Tcl object result.
@@ -293,14 +305,15 @@ TestbignumobjCmd( clientData, interp, objc, objv )
*/
static int
-TestbooleanobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestbooleanobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex, boolValue;
- char *index, *subCmd;
+ const char *index, *subCmd;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -313,6 +326,8 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
+
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
@@ -333,14 +348,14 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
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]);
@@ -348,7 +363,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
@@ -358,67 +373,13 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
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 {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
- "\": must be set, get, or not", (char *) NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestconvertobjCmd --
- *
- * This procedure implements the "testconvertobj" command. It is used
- * to test converting objects to new types.
- *
- * Results:
- * A standard Tcl object result.
- *
- * Side effects:
- * Converts objects to new types.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestconvertobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- char *subCmd;
- char buf[20];
-
- if (objc < 3) {
- wrongNumArgs:
- Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
- return TCL_ERROR;
- }
-
- subCmd = Tcl_GetString(objv[1]);
- if (strcmp(subCmd, "double") == 0) {
- double d;
-
- if (objc != 3) {
- goto wrongNumArgs;
- }
- if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
- return TCL_ERROR;
- }
- sprintf(buf, "%f", d);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
- } else {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", Tcl_GetString(objv[1]),
- "\": must be double", (char *) NULL);
+ "\": must be set, get, or not", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -429,8 +390,8 @@ TestconvertobjCmd(clientData, interp, objc, objv)
*
* TestdoubleobjCmd --
*
- * This procedure implements the "testdoubleobj" command. It is used
- * to test the double-precision floating point Tcl object type
+ * This function implements the "testdoubleobj" command. It is used to
+ * test the double-precision floating point Tcl object type
* implementation.
*
* Results:
@@ -444,22 +405,25 @@ TestconvertobjCmd(clientData, interp, objc, objv)
*/
static int
-TestdoubleobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestdoubleobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex;
double doubleValue;
- char *index, *subCmd, *string;
-
+ const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
+
if (objc < 3) {
wrongNumArgs:
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;
@@ -478,22 +442,22 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
- * object directly. Otherwise, if RC>1 (i.e. the object is shared),
- * we must create a new object to modify/set and decrement the old
+ * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
+ * must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
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]);
@@ -501,7 +465,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -509,32 +473,32 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
+ 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],
- &doubleValue) != TCL_OK) {
+ &doubleValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
+ 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 {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
- "\": must be set, get, mult10, or div10", (char *) NULL);
+ "\": must be set, get, mult10, or div10", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -545,7 +509,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
*
* TestindexobjCmd --
*
- * This procedure implements the "testindexobj" command. It is used to
+ * This function implements the "testindexobj" command. It is used to
* test the index Tcl object type implementation.
*
* Results:
@@ -559,42 +523,41 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
*/
static int
-TestindexobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestindexobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowAbbrev, index, index2, setError, i, result;
- CONST char **argv;
- static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL};
+ const char **argv;
+ static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
struct IndexRep {
- VOID *tablePtr; /* Pointer to the table of strings */
- int offset; /* Offset between table entries */
- int index; /* Selected index into table. */
+ void *tablePtr; /* Pointer to the table of strings. */
+ int offset; /* Offset between table entries. */
+ int index; /* Selected index into table. */
};
struct IndexRep *indexRep;
if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
/*
- * This code checks to be sure that the results of
- * Tcl_GetIndexFromObj are properly cached in the object and
- * returned on subsequent lookups.
+ * This code checks to be sure that the results of Tcl_GetIndexFromObj
+ * are properly cached in the object and returned on subsequent
+ * lookups.
*/
if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
- "token", 0, &index);
- indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
+ Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
+ indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
- result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
+ result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -614,31 +577,30 @@ TestindexobjCmd(clientData, interp, objc, objv)
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]);
}
argv[objc-4] = NULL;
-
+
/*
- * Tcl_GetIndexFromObj assumes that the table is statically-allocated
- * so that its address is different for each index object. If we
- * accidently allocate a table at the same address as that cached in
- * the index object, clear out the object's cached state.
+ * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
+ * that its address is different for each index object. If we accidently
+ * allocate a table at the same address as that cached in the index
+ * object, clear out the object's cached state.
*/
- if ( objv[3]->typePtr != NULL
- && !strcmp( "index", objv[3]->typePtr->name ) ) {
- indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
- if (indexRep->tablePtr == (VOID *) argv) {
- objv[3]->typePtr->freeIntRepProc(objv[3]);
- objv[3]->typePtr = NULL;
+ if (objv[3]->typePtr != NULL
+ && !strcmp("index", objv[3]->typePtr->name)) {
+ indexRep = objv[3]->internalRep.twoPtrValue.ptr1;
+ if (indexRep->tablePtr == (void *) argv) {
+ 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);
}
@@ -650,7 +612,7 @@ TestindexobjCmd(clientData, interp, objc, objv)
*
* TestintobjCmd --
*
- * This procedure implements the "testintobj" command. It is used to
+ * This function implements the "testintobj" command. It is used to
* test the int Tcl object type implementation.
*
* Results:
@@ -664,22 +626,24 @@ TestindexobjCmd(clientData, interp, objc, objv)
*/
static int
-TestintobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestintobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int intValue, varIndex, i;
long longValue;
- char *index, *subCmd, *string;
-
+ const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
+
if (objc < 3) {
wrongNumArgs:
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;
@@ -699,15 +663,15 @@ TestintobjCmd(clientData, interp, objc, objv)
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
- * object directly. Otherwise, if RC>1 (i.e. the object is shared),
- * we must create a new object to modify/set and decrement the old
+ * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
+ * must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
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 */
@@ -722,7 +686,7 @@ TestintobjCmd(clientData, interp, objc, objv)
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) {
@@ -736,7 +700,7 @@ TestintobjCmd(clientData, interp, objc, objv)
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) {
@@ -747,25 +711,25 @@ TestintobjCmd(clientData, interp, objc, objv)
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) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- ((longValue == LONG_MAX)? "1" : "0"), -1);
+ ((longValue == LONG_MAX)? "1" : "0"), -1);
} 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]);
@@ -773,29 +737,29 @@ TestintobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
} else if (strcmp(subCmd, "inttoobigtest") == 0) {
/*
- * If long ints have more bits than ints on this platform, verify
- * that Tcl_GetIntFromObj returns an error if the long int held
- * in an integer object's internal representation is too large
- * to fit in an int.
+ * If long ints have more bits than ints on this platform, verify that
+ * Tcl_GetIntFromObj returns an error if the long int held in an
+ * integer object's internal representation is too large to fit in an
+ * int.
*/
-
+
if (objc != 3) {
goto wrongNumArgs;
}
#if (INT_MAX == LONG_MAX) /* int is same size as long int */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
-#else
+#else
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);
@@ -808,52 +772,149 @@ TestintobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
- &intValue) != TCL_OK) {
+ &intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
+ 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],
- &intValue) != TCL_OK) {
+ &intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
+ 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 {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
- "\": must be set, get, get2, mult10, or div10",
- (char *) NULL);
+ "\": must be set, get, get2, mult10, or div10", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * TestlistobjCmd --
+ *
+ * This function implements the 'testlistobj' command. It is used to
+ * test a few possible corner cases in list object manipulation from
+ * C code that cannot occur at the Tcl level.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * Creates, manipulates and frees list objects.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestlistobjCmd(
+ ClientData clientData, /* Not used */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ /* Subcommands supported by this command */
+ const char* subcommands[] = {
+ "set",
+ "get",
+ "replace"
+ };
+ enum listobjCmdIndex {
+ LISTOBJ_SET,
+ LISTOBJ_GET,
+ LISTOBJ_REPLACE
+ };
+
+ const char* index; /* Argument giving the variable number */
+ int varIndex; /* Variable number converted to binary */
+ 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;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
+ 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch(cmdIndex) {
+ case LISTOBJ_SET:
+ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+ Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
+ } else {
+ SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_GET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_REPLACE:
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "varIndex start count ?element...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_IsShared(varPtr[varIndex])) {
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ }
+ Tcl_ResetResult(interp);
+ return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
+ objc-5, objv+5);
+ }
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* TestobjCmd --
*
- * This procedure implements the "testobj" command. It is used to test
+ * This function implements the "testobj" command. It is used to test
* the type-independent portions of the Tcl object type implementation.
*
* Results:
@@ -866,124 +927,138 @@ TestintobjCmd(clientData, interp, objc, objv)
*/
static int
-TestobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TestobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex, destIndex, i;
- char *index, *subCmd, *string;
- Tcl_ObjType *targetType;
-
+ const char *index, *subCmd, *string;
+ const Tcl_ObjType *targetType;
+ Tcl_Obj **varPtr;
+
if (objc < 2) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "assign") == 0) {
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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]);
+ if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
- } else if (strcmp(subCmd, "convert") == 0) {
- char *typeName;
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ } else if (strcmp(subCmd, "bug3598580") == 0) {
+ Tcl_Obj *listObjPtr, *elemObjPtr;
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
+ elemObjPtr = Tcl_NewIntObj(123);
+ listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
+ /* Replace the single list element through itself, nonsense but legal. */
+ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
+ } else if (strcmp(subCmd, "convert") == 0) {
+ const char *typeName;
+
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- typeName = Tcl_GetString(objv[3]);
- if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+ return TCL_ERROR;
+ }
+ typeName = Tcl_GetString(objv[3]);
+ if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "no type ", typeName, " found", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
- != TCL_OK) {
- return TCL_ERROR;
- }
+ "no type ", typeName, " found", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "duplicate") == 0) {
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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]));
+ if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "freeallvars") == 0) {
- if (objc != 2) {
- goto wrongNumArgs;
- }
- for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
- if (varPtr[i] != NULL) {
- Tcl_DecrRefCount(varPtr[i]);
- varPtr[i] = NULL;
- }
- }
- } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
- if ( objc != 3 ) {
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
+ for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
+ if (varPtr[i] != NULL) {
+ Tcl_DecrRefCount(varPtr[i]);
+ varPtr[i] = NULL;
+ }
+ }
+ } else if (strcmp(subCmd, "invalidateStringRep") == 0) {
+ if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetString( objv[2] );
- if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
+ index = Tcl_GetString(objv[2]);
+ 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] );
- Tcl_SetObjResult( interp, varPtr[varIndex] );
+ Tcl_InvalidateStringRep(varPtr[varIndex]);
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "newobj") == 0) {
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- SetVarToObj(varIndex, Tcl_NewObj());
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "objtype") == 0) {
- char *typeName;
+ const char *typeName;
/*
- * return an object containing the name of the argument's type
- * of internal rep. If none exists, return "none".
+ * Return an object containing the name of the argument's type of
+ * internal rep. If none exists, return "none".
*/
-
- if (objc != 3) {
- goto wrongNumArgs;
- }
+
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
if (objv[2]->typePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
@@ -991,52 +1066,47 @@ TestobjCmd(clientData, interp, objc, objv)
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
- char buf[TCL_INTEGER_SPACE];
-
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- TclFormatInt(buf, varPtr[varIndex]->refCount);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
+ if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- varPtr[varIndex]->typePtr->name, -1);
- }
+ } else {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ varPtr[varIndex]->typePtr->name, -1);
+ }
} else if (strcmp(subCmd, "types") == 0) {
- if (objc != 2) {
- goto wrongNumArgs;
- }
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
if (Tcl_AppendAllObjTypes(interp,
Tcl_GetObjResult(interp)) != TCL_OK) {
return TCL_ERROR;
}
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"",
- Tcl_GetString(objv[1]),
- "\": must be assign, convert, duplicate, freeallvars, ",
- "newobj, objcount, objtype, refcount, type, or types",
- (char *) NULL);
+ "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be assign, convert, duplicate, freeallvars, "
+ "newobj, objcount, objtype, refcount, type, or types", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1047,7 +1117,7 @@ TestobjCmd(clientData, interp, objc, objv)
*
* TeststringobjCmd --
*
- * This procedure implements the "teststringobj" command. It is used to
+ * This function implements the "teststringobj" command. It is used to
* test the string Tcl object type implementation.
*
* Results:
@@ -1061,20 +1131,22 @@ TestobjCmd(clientData, interp, objc, objv)
*/
static int
-TeststringobjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TeststringobjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_UniChar *unicode;
int varIndex, option, i, length;
#define MAX_STRINGS 11
- char *index, *string, *strings[MAX_STRINGS+1];
+ const char *index, *string, *strings[MAX_STRINGS+1];
TestString *strPtr;
- static CONST char *options[] = {
+ Tcl_Obj **varPtr;
+ static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
- "set", "set2", "setlength", "ualloc", "getunicode",
- (char *) NULL
+ "set", "set2", "setlength", "maxchars", "getunicode",
+ "appendself", "appendself2", NULL
};
if (objc < 3) {
@@ -1083,6 +1155,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -1101,16 +1174,16 @@ TeststringobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
-
+
/*
* If the object bound to variable "varIndex" is shared, we must
- * "copy on write" and append to a copy of the object.
+ * "copy on write" and append to a copy of the object.
*/
-
+
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);
@@ -1121,16 +1194,16 @@ TeststringobjCmd(clientData, interp, objc, objv)
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
* If the object bound to variable "varIndex" is shared, we must
- * "copy on write" and append to a copy of the object.
+ * "copy on write" and append to a copy of the object.
*/
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]);
@@ -1148,7 +1221,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1157,7 +1230,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
@@ -1175,8 +1248,9 @@ TeststringobjCmd(clientData, interp, objc, objv)
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = (int) strPtr->allocated;
} else {
length = -1;
@@ -1190,19 +1264,19 @@ TeststringobjCmd(clientData, interp, objc, objv)
/*
* If the object currently bound to the variable with index
- * varIndex has ref count 1 (i.e. the object is unshared) we
- * can modify that object directly. Otherwise, if RC>1 (i.e.
- * the object is shared), we must create a new object to
- * modify/set and decrement the old formerly-shared object's
- * ref count. This is "copy on write".
+ * varIndex has ref count 1 (i.e. the object is unshared) we can
+ * modify that object directly. Otherwise, if RC>1 (i.e. the
+ * object is shared), we must create a new object to modify/set
+ * and decrement the old formerly-shared object's ref count. This
+ * is "copy on write".
*/
-
+
string = Tcl_GetStringFromObj(objv[3], &length);
if ((varPtr[varIndex] != NULL)
&& !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;
@@ -1210,7 +1284,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
if (objc != 4) {
goto wrongNumArgs;
}
- SetVarToObj(varIndex, objv[3]);
+ SetVarToObj(varPtr, varIndex, objv[3]);
break;
case 8: /* setlength */
if (objc != 4) {
@@ -1223,14 +1297,15 @@ TeststringobjCmd(clientData, interp, objc, objv)
Tcl_SetObjLength(varPtr[varIndex], length);
}
break;
- case 9: /* ualloc */
+ case 9: /* maxchars */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
- length = (int) strPtr->uallocated;
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ length = strPtr->maxChars;
} else {
length = -1;
}
@@ -1242,6 +1317,68 @@ TeststringobjCmd(clientData, interp, objc, objv)
}
Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
break;
+ case 11: /* appendself */
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ if (varPtr[varIndex] == NULL) {
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+ }
+
+ /*
+ * If the object bound to variable "varIndex" is shared, we must
+ * "copy on write" and append to a copy of the object.
+ */
+
+ if (Tcl_IsShared(varPtr[varIndex])) {
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ }
+
+ string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((i < 0) || (i > length)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "index value out of range", -1));
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendToObj(varPtr[varIndex], string + i, length - i);
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+ case 12: /* appendself2 */
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ if (varPtr[varIndex] == NULL) {
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+ }
+
+ /*
+ * If the object bound to variable "varIndex" is shared, we must
+ * "copy on write" and append to a copy of the object.
+ */
+
+ if (Tcl_IsShared(varPtr[varIndex])) {
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ }
+
+ unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((i < 0) || (i > length)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "index value out of range", -1));
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
}
return TCL_OK;
@@ -1259,17 +1396,18 @@ TeststringobjCmd(clientData, interp, objc, objv)
* None.
*
* Side effects:
- * This routine handles ref counting details for assignment:
- * i.e. the old value's ref count must be decremented (if not NULL) and
- * the new one incremented (also if not NULL).
+ * This routine handles ref counting details for assignment: i.e. the old
+ * value's ref count must be decremented (if not NULL) and the new one
+ * incremented (also if not NULL).
*
*----------------------------------------------------------------------
*/
static void
-SetVarToObj(varIndex, objPtr)
- int varIndex; /* Designates the assignment variable. */
- Tcl_Obj *objPtr; /* Points to object to assign to var. */
+SetVarToObj(
+ Tcl_Obj **varPtr,
+ int varIndex, /* Designates the assignment variable. */
+ Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
if (varPtr[varIndex] != NULL) {
Tcl_DecrRefCount(varPtr[varIndex]);
@@ -1297,15 +1435,15 @@ SetVarToObj(varIndex, objPtr)
*/
static int
-GetVariableIndex(interp, string, indexPtr)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- char *string; /* String containing a variable index
- * specified as a nonnegative number less
- * than NUMBER_OF_OBJECT_VARS. */
- int *indexPtr; /* Place to store converted result. */
+GetVariableIndex(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ const char *string, /* String containing a variable index
+ * specified as a nonnegative number less than
+ * NUMBER_OF_OBJECT_VARS. */
+ int *indexPtr) /* Place to store converted result. */
{
int index;
-
+
if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1324,7 +1462,7 @@ GetVariableIndex(interp, string, indexPtr)
*
* CheckIfVarUnset --
*
- * Utility procedure that checks whether a test variable is readable:
+ * Utility function that checks whether a test variable is readable:
* i.e., that varPtr[varIndex] is non-NULL.
*
* Results:
@@ -1338,13 +1476,14 @@ GetVariableIndex(interp, string, indexPtr)
*/
static int
-CheckIfVarUnset(interp, varIndex)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- int varIndex; /* Index of the test variable to check. */
+CheckIfVarUnset(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tcl_Obj ** varPtr,
+ int varIndex) /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {
char buf[32 + TCL_INTEGER_SPACE];
-
+
sprintf(buf, "variable %d is unset (NULL)", varIndex);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
@@ -1352,3 +1491,11 @@ CheckIfVarUnset(interp, varIndex)
}
return 0;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 5d8084d..a3f89f6 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -1,41 +1,41 @@
-/*
+/*
* tclTestProcBodyObj.c --
*
- * Implements the "procbodytest" package, which contains commands
- * to test creation of Tcl procedures whose body argument is a
- * Tcl_Obj of type "procbody" rather than a string.
+ * Implements the "procbodytest" package, which contains commands to test
+ * creation of Tcl procedures whose body argument is a Tcl_Obj of type
+ * "procbody" rather than a string.
*
* 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: tclTestProcBodyObj.c,v 1.3 2004/08/25 01:11:20 dgp 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
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
* name and version of this package
*/
-static char packageName[] = "procbodytest";
-static char packageVersion[] = "1.0";
+static const char packageName[] = "procbodytest";
+static const char packageVersion[] = "1.0";
/*
* Name of the commands exported by this package
*/
-static char procCommand[] = "proc";
+static const char procCommand[] = "proc";
/*
* this struct describes an entry in the table of command names and command
* procs
*/
-typedef struct CmdTable
-{
- char *cmdName; /* command name */
+typedef struct CmdTable {
+ const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
@@ -44,31 +44,24 @@ typedef struct CmdTable
* Declarations for functions defined in this file.
*/
-static int ProcBodyTestProcObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
- int isSafe));
-static int RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
- char *namespace, CONST CmdTable *cmdTablePtr));
-int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp));
-int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+static int ProcBodyTestProcObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
+static int RegisterCommand(Tcl_Interp* interp,
+ const char *namespace, const CmdTable *cmdTablePtr);
/*
* List of commands to create when the package is loaded; must go after the
* declarations of the enable command procedure.
*/
-static CONST CmdTable commands[] =
-{
+static const CmdTable commands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
-
{ 0, 0, 0 }
};
-static CONST CmdTable safeCommands[] =
-{
+static const CmdTable safeCommands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
-
{ 0, 0, 0 }
};
@@ -77,21 +70,21 @@ static CONST CmdTable safeCommands[] =
*
* Procbodytest_Init --
*
- * This procedure initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-Procbodytest_Init(interp)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
- * is initialized */
+Procbodytest_Init(
+ Tcl_Interp *interp) /* the Tcl interpreter for which the package
+ * is initialized */
{
return ProcBodyTestInitInternal(interp, 0);
}
@@ -101,21 +94,21 @@ Procbodytest_Init(interp)
*
* Procbodytest_SafeInit --
*
- * This procedure initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-Procbodytest_SafeInit(interp)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
- * is initialized */
+Procbodytest_SafeInit(
+ Tcl_Interp *interp) /* the Tcl interpreter for which the package
+ * is initialized */
{
return ProcBodyTestInitInternal(interp, 1);
}
@@ -125,36 +118,38 @@ Procbodytest_SafeInit(interp)
*
* RegisterCommand --
*
- * This procedure registers a command in the context of the given namespace.
+ * This function registers a command in the context of the given
+ * namespace.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int RegisterCommand(interp, namespace, cmdTablePtr)
- Tcl_Interp* interp; /* the Tcl interpreter for which the
- * operation is performed */
- char *namespace; /* the namespace in which the command
- * is registered */
- CONST CmdTable *cmdTablePtr; /* the command to register */
+static int
+RegisterCommand(
+ Tcl_Interp* interp, /* the Tcl interpreter for which the operation
+ * is performed */
+ const char *namespace, /* the namespace in which the command is
+ * registered */
+ const CmdTable *cmdTablePtr)/* the command to register */
{
char buf[128];
if (cmdTablePtr->exportIt) {
- sprintf(buf, "namespace eval %s { namespace export %s }",
- namespace, cmdTablePtr->cmdName);
- if (Tcl_Eval(interp, buf) != TCL_OK)
- return TCL_ERROR;
+ sprintf(buf, "namespace eval %s { namespace export %s }",
+ namespace, cmdTablePtr->cmdName);
+ if (Tcl_Eval(interp, buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
-
+
sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
-
return TCL_OK;
}
@@ -163,7 +158,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
*
* ProcBodyTestInitInternal --
*
- * This procedure initializes the Loader package.
+ * This function initializes the Loader package.
* The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
*
* Results:
@@ -176,20 +171,20 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
*/
static int
-ProcBodyTestInitInternal(interp, isSafe)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
- * is initialized */
- int isSafe; /* 1 if this is a safe interpreter */
+ProcBodyTestInitInternal(
+ Tcl_Interp *interp, /* the Tcl interpreter for which the package
+ * is initialized */
+ int isSafe) /* 1 if this is a safe interpreter */
{
- CONST CmdTable *cmdTablePtr;
+ const CmdTable *cmdTablePtr;
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
- if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
-
+
return Tcl_PkgProvide(interp, packageName, packageVersion);
}
@@ -227,20 +222,20 @@ ProcBodyTestInitInternal(interp, isSafe)
*/
static int
-ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
- ClientData dummy; /* context; not used */
- Tcl_Interp *interp; /* the current interpreter */
- int objc; /* argument count */
- Tcl_Obj *CONST objv[]; /* arguments */
+ProcBodyTestProcObjCmd(
+ ClientData dummy, /* context; not used */
+ Tcl_Interp *interp, /* the current interpreter */
+ int objc, /* argument count */
+ Tcl_Obj *const objv[]) /* arguments */
{
- char *fullName;
+ const char *fullName;
Tcl_Command procCmd;
Command *cmdPtr;
- Proc *procPtr = (Proc *) NULL;
+ Proc *procPtr = NULL;
Tcl_Obj *bodyObjPtr;
Tcl_Obj *myobjv[5];
int result;
-
+
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
return TCL_ERROR;
@@ -249,50 +244,47 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
/*
* Find the Command pointer to this procedure
*/
-
- fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
- procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
- TCL_LEAVE_ERR_MSG);
+
+ fullName = Tcl_GetStringFromObj(objv[3], NULL);
+ procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
if (procCmd == NULL) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
cmdPtr = (Command *) procCmd;
/*
* check that this is a procedure and not a builtin command:
- * If a procedure, cmdPtr->objProc is TclObjInterpProc.
+ * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
*/
- if (cmdPtr->objProc != TclGetObjInterpProc()) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "command \"", fullName,
- "\" is not a Tcl procedure", (char *) NULL);
- return TCL_ERROR;
+ if (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "command \"", fullName, "\" is not a Tcl procedure", NULL);
+ return TCL_ERROR;
}
/*
* it is a Tcl procedure: the client data is the Proc structure
*/
-
+
procPtr = (Proc *) cmdPtr->objClientData;
if (procPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "procedure \"", fullName,
- "\" does not have a Proc struct!", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"",
+ fullName, "\" does not have a Proc struct!", NULL);
+ return TCL_ERROR;
}
-
+
/*
* create a new object, initialize our argument vector, call into Tcl
*/
bodyObjPtr = TclNewProcBodyObj(procPtr);
if (bodyObjPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"failed to create a procbody object for procedure \"",
- fullName, "\"", (char *) NULL);
- return TCL_ERROR;
+ fullName, "\"", NULL);
+ return TCL_ERROR;
}
Tcl_IncrRefCount(bodyObjPtr);
@@ -300,10 +292,18 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
myobjv[1] = objv[1];
myobjv[2] = objv[2];
myobjv[3] = bodyObjPtr;
- myobjv[4] = (Tcl_Obj *) NULL;
+ myobjv[4] = NULL;
- result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
+ result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
Tcl_DecrRefCount(bodyObjPtr);
return result;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 17dd0ad..8c972a8 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -1,15 +1,14 @@
-/*
+/*
* tclThread.c --
*
* This file implements Platform independent thread operations. Most of
* the real work is done in the platform dependent files.
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
+ * Copyright (c) 2008 by George Peter Staplin
*
* 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.13 2005/08/11 22:06:47 kennykb Exp $
*/
#include "tclInt.h"
@@ -26,7 +25,7 @@
typedef struct {
int num; /* Number of objects remembered */
int max; /* Max size of the array */
- char **list; /* List of pointers */
+ void **list; /* List of pointers */
} SyncObjRecord;
static SyncObjRecord keyRecord = {0, 0, NULL};
@@ -36,13 +35,12 @@ static SyncObjRecord condRecord = {0, 0, NULL};
/*
* Prototypes of functions used only in this file.
*/
-
-static void RememberSyncObject _ANSI_ARGS_((char *objPtr,
- SyncObjRecord *recPtr));
-static void ForgetSyncObject _ANSI_ARGS_((char *objPtr,
- SyncObjRecord *recPtr));
-/*
+static void ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
+static void RememberSyncObject(void *objPtr,
+ SyncObjRecord *recPtr);
+
+/*
* Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
* specified. Here we undo that so the functions are defined in the stubs
* table.
@@ -56,7 +54,6 @@ static void ForgetSyncObject _ANSI_ARGS_((char *objPtr,
#undef Tcl_ConditionWait
#undef Tcl_ConditionFinalize
#endif
-
/*
*----------------------------------------------------------------------
@@ -76,31 +73,33 @@ static void ForgetSyncObject _ANSI_ARGS_((char *objPtr,
*----------------------------------------------------------------------
*/
-VOID *
-Tcl_GetThreadData(keyPtr, size)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk */
- int size; /* Size of storage block */
+void *
+Tcl_GetThreadData(
+ Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */
+ int size) /* Size of storage block */
{
- VOID *result;
+ void *result;
#ifdef TCL_THREADS
/*
* Initialize the key for this thread.
*/
- result = TclpThreadDataKeyGet(keyPtr);
+
+ result = TclThreadStorageKeyGet(keyPtr);
if (result == NULL) {
- result = (VOID *)ckalloc((size_t)size);
- memset(result, 0, (size_t)size);
- TclpThreadDataKeySet(keyPtr, result);
+ result = ckalloc(size);
+ memset(result, 0, (size_t) size);
+ TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
- result = (VOID *)ckalloc((size_t)size);
- memset((char *)result, 0, (size_t)size);
- *keyPtr = (Tcl_ThreadDataKey)result;
- RememberSyncObject((char *)keyPtr, &keyRecord);
+ result = ckalloc(size);
+ memset(result, 0, (size_t)size);
+ *keyPtr = result;
+ RememberSyncObject(keyPtr, &keyRecord);
+ } else {
+ result = *keyPtr;
}
- result = *(VOID **)keyPtr;
#endif /* TCL_THREADS */
return result;
}
@@ -122,19 +121,17 @@ Tcl_GetThreadData(keyPtr, size)
*----------------------------------------------------------------------
*/
-VOID *
-TclThreadDataKeyGet(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
- * (pthread_key_t **) */
+void *
+TclThreadDataKeyGet(
+ Tcl_ThreadDataKey *keyPtr) /* Identifier for the data chunk. */
+
{
#ifdef TCL_THREADS
- return (VOID *)TclpThreadDataKeyGet(keyPtr);
+ return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
- char *result = *(char **)keyPtr;
- return (VOID *)result;
+ return *keyPtr;
#endif /* TCL_THREADS */
}
-
/*
*----------------------------------------------------------------------
@@ -144,6 +141,8 @@ TclThreadDataKeyGet(keyPtr)
* Keep a list of (mutexes/condition variable/data key) used during
* finalization.
*
+ * Assume master lock is held.
+ *
* Results:
* None.
*
@@ -154,33 +153,45 @@ TclThreadDataKeyGet(keyPtr)
*/
static void
-RememberSyncObject(objPtr, recPtr)
- char *objPtr; /* Pointer to sync object */
- SyncObjRecord *recPtr; /* Record of sync objects */
+RememberSyncObject(
+ void *objPtr, /* Pointer to sync object */
+ SyncObjRecord *recPtr) /* Record of sync objects */
{
- char **newList;
+ void **newList;
int i, j;
+
/*
- * Save the pointer to the allocated object so it can be finalized. Grow
- * the list of pointers if necessary, copying only non-NULL pointers to
- * the new list.
+ * Reuse any free slot in the list.
+ */
+
+ for (i=0 ; i < recPtr->num ; ++i) {
+ if (recPtr->list[i] == NULL) {
+ recPtr->list[i] = objPtr;
+ return;
+ }
+ }
+
+ /*
+ * Grow the list of pointers if necessary, copying only non-NULL
+ * pointers to the new list.
*/
if (recPtr->num >= recPtr->max) {
recPtr->max += 8;
- newList = (char **)ckalloc(recPtr->max * sizeof(char *));
+ 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;
}
+
recPtr->list[recPtr->num] = objPtr;
recPtr->num++;
}
@@ -191,6 +202,7 @@ RememberSyncObject(objPtr, recPtr)
* ForgetSyncObject
*
* Remove a single object from the list.
+ * Assume master lock is held.
*
* Results:
* None.
@@ -202,9 +214,9 @@ RememberSyncObject(objPtr, recPtr)
*/
static void
-ForgetSyncObject(objPtr, recPtr)
- char *objPtr; /* Pointer to sync object */
- SyncObjRecord *recPtr; /* Record of sync objects */
+ForgetSyncObject(
+ void *objPtr, /* Pointer to sync object */
+ SyncObjRecord *recPtr) /* Record of sync objects */
{
int i;
@@ -222,6 +234,7 @@ ForgetSyncObject(objPtr, recPtr)
* TclRememberMutex
*
* Keep a list of mutexes used during finalization.
+ * Assume master lock is held.
*
* Results:
* None.
@@ -233,10 +246,10 @@ ForgetSyncObject(objPtr, recPtr)
*/
void
-TclRememberMutex(mutexPtr)
- Tcl_Mutex *mutexPtr;
+TclRememberMutex(
+ Tcl_Mutex *mutexPtr)
{
- RememberSyncObject((char *)mutexPtr, &mutexRecord);
+ RememberSyncObject(mutexPtr, &mutexRecord);
}
/*
@@ -257,13 +270,15 @@ TclRememberMutex(mutexPtr)
*/
void
-Tcl_MutexFinalize(mutexPtr)
- Tcl_Mutex *mutexPtr;
+Tcl_MutexFinalize(
+ Tcl_Mutex *mutexPtr)
{
#ifdef TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
- ForgetSyncObject((char *)mutexPtr, &mutexRecord);
+ TclpMasterLock();
+ ForgetSyncObject(mutexPtr, &mutexRecord);
+ TclpMasterUnlock();
}
/*
@@ -272,6 +287,7 @@ Tcl_MutexFinalize(mutexPtr)
* TclRememberCondition
*
* Keep a list of condition variables used during finalization.
+ * Assume master lock is held.
*
* Results:
* None.
@@ -283,10 +299,10 @@ Tcl_MutexFinalize(mutexPtr)
*/
void
-TclRememberCondition(condPtr)
- Tcl_Condition *condPtr;
+TclRememberCondition(
+ Tcl_Condition *condPtr)
{
- RememberSyncObject((char *)condPtr, &condRecord);
+ RememberSyncObject(condPtr, &condRecord);
}
/*
@@ -307,13 +323,15 @@ TclRememberCondition(condPtr)
*/
void
-Tcl_ConditionFinalize(condPtr)
- Tcl_Condition *condPtr;
+Tcl_ConditionFinalize(
+ Tcl_Condition *condPtr)
{
#ifdef TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
- ForgetSyncObject((char *)condPtr, &condRecord);
+ TclpMasterLock();
+ ForgetSyncObject(condPtr, &condRecord);
+ TclpMasterUnlock();
}
/*
@@ -321,8 +339,9 @@ Tcl_ConditionFinalize(condPtr)
*
* TclFinalizeThreadData --
*
- * This function cleans up the thread-local storage. This is called once
- * for each thread.
+ * This function cleans up the thread-local storage. Secondary, it cleans
+ * thread alloc cache.
+ * This is called once for each thread before thread exits.
*
* Results:
* None.
@@ -334,9 +353,12 @@ Tcl_ConditionFinalize(condPtr)
*/
void
-TclFinalizeThreadData()
+TclFinalizeThreadData(void)
{
- TclpFinalizeThreadDataThread();
+ TclFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclFinalizeThreadAllocThread();
+#endif
}
/*
@@ -357,34 +379,36 @@ TclFinalizeThreadData()
*/
void
-TclFinalizeSynchronization()
+TclFinalizeSynchronization(void)
{
-#ifdef TCL_THREADS
- void* blockPtr;
+ int i;
+ void *blockPtr;
Tcl_ThreadDataKey *keyPtr;
+#ifdef TCL_THREADS
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
- int i;
TclpMasterLock();
+#endif
- /*
- * If we're running unthreaded, the TSD blocks are simply stored
- * inside their thread data keys. Free them here.
+ /*
+ * If we're running unthreaded, the TSD blocks are simply stored inside
+ * their thread data keys. Free them here.
*/
- for (i=0 ; i<keyRecord.num ; i++) {
- keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
- blockPtr = (void*) *keyPtr;
- ckfree(blockPtr);
- }
if (keyRecord.list != NULL) {
- ckfree((char *)keyRecord.list);
+ for (i=0 ; i<keyRecord.num ; i++) {
+ keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
+ blockPtr = *keyPtr;
+ ckfree(blockPtr);
+ }
+ ckfree(keyRecord.list);
keyRecord.list = NULL;
}
keyRecord.max = 0;
keyRecord.num = 0;
+#ifdef TCL_THREADS
/*
* Call thread storage master cleanup.
*/
@@ -398,36 +422,28 @@ TclFinalizeSynchronization()
}
}
if (mutexRecord.list != NULL) {
- ckfree((char *)mutexRecord.list);
+ ckfree(mutexRecord.list);
mutexRecord.list = NULL;
}
mutexRecord.max = 0;
mutexRecord.num = 0;
for (i=0 ; i<condRecord.num ; i++) {
- condPtr = (Tcl_Condition *)condRecord.list[i];
+ condPtr = (Tcl_Condition *) condRecord.list[i];
if (condPtr != NULL) {
TclpFinalizeCondition(condPtr);
}
}
if (condRecord.list != NULL) {
- ckfree((char *)condRecord.list);
+ ckfree(condRecord.list);
condRecord.list = NULL;
}
condRecord.max = 0;
condRecord.num = 0;
TclpMasterUnlock();
-#else /* TCL_THREADS */
- if (keyRecord.list != NULL) {
- ckfree((char *)keyRecord.list);
- keyRecord.list = NULL;
- }
- keyRecord.max = 0;
- keyRecord.num = 0;
#endif /* TCL_THREADS */
}
-
/*
*----------------------------------------------------------------------
@@ -448,8 +464,8 @@ TclFinalizeSynchronization()
*/
void
-Tcl_ExitThread(status)
- int status;
+Tcl_ExitThread(
+ int status)
{
Tcl_FinalizeThread();
#ifdef TCL_THREADS
@@ -479,31 +495,31 @@ Tcl_ExitThread(status)
#undef Tcl_ConditionWait
void
-Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
- Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
- Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
- Tcl_Time *timePtr; /* Timeout on waiting period */
+Tcl_ConditionWait(
+ Tcl_Condition *condPtr, /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr, /* Really (pthread_mutex_t **) */
+ const Tcl_Time *timePtr) /* Timeout on waiting period */
{
}
#undef Tcl_ConditionNotify
void
-Tcl_ConditionNotify(condPtr)
- Tcl_Condition *condPtr;
+Tcl_ConditionNotify(
+ Tcl_Condition *condPtr)
{
}
#undef Tcl_MutexLock
void
-Tcl_MutexLock(mutexPtr)
- Tcl_Mutex *mutexPtr;
+Tcl_MutexLock(
+ Tcl_Mutex *mutexPtr)
{
}
#undef Tcl_MutexUnlock
void
-Tcl_MutexUnlock(mutexPtr)
- Tcl_Mutex *mutexPtr;
+Tcl_MutexUnlock(
+ Tcl_Mutex *mutexPtr)
{
}
#endif /* !TCL_THREADS */
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index f36d0d7..ddf888a 100755..100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -10,13 +10,11 @@
*
* 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.17 2005/07/24 22:56:44 dkf Exp $
*/
#include "tclInt.h"
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-
+
/*
* If range checking is enabled, an additional byte will be allocated to store
* the magic number at the end of the requested memory.
@@ -37,15 +35,9 @@
*/
#define NOBJALLOC 800
-#define NOBJHIGH 1200
-
-/*
- * The following defines the number of buckets in the bucket cache and those
- * block sizes from (1<<4) to (1<<(3+NBUCKETS))
- */
-#define NBUCKETS 11
-#define MAXALLOC 16284
+/* Actual definition moved to tclInt.h */
+#define NOBJHIGH ALLOC_NOBJHIGH
/*
* The following union stores accounting information for each block including
@@ -54,23 +46,36 @@
* is also maintained.
*/
-typedef struct Block {
- union {
- struct Block *next; /* Next in free list. */
- struct {
- unsigned char magic1; /* First magic number. */
- unsigned char bucket; /* Bucket block allocated from. */
- unsigned char unused; /* Padding. */
- unsigned char magic2; /* Second magic number. */
- } s;
- } u;
- size_t reqSize; /* Requested allocation size. */
+typedef union Block {
+ struct {
+ union {
+ union Block *next; /* Next in free list. */
+ struct {
+ unsigned char magic1; /* First magic number. */
+ unsigned char bucket; /* Bucket block allocated from. */
+ unsigned char unused; /* Padding. */
+ unsigned char magic2; /* Second magic number. */
+ } s;
+ } u;
+ size_t reqSize; /* Requested allocation size. */
+ } b;
+ unsigned char padding[TCL_ALLOCALIGN];
} Block;
-#define nextBlock u.next
-#define sourceBucket u.s.bucket
-#define magicNum1 u.s.magic1
-#define magicNum2 u.s.magic2
+#define nextBlock b.u.next
+#define sourceBucket b.u.s.bucket
+#define magicNum1 b.u.s.magic1
+#define magicNum2 b.u.s.magic2
#define MAGIC 0xEF
+#define blockReqSize b.reqSize
+
+/*
+ * The following defines the minimum and and maximum block sizes and the number
+ * of buckets in the bucket cache.
+ */
+
+#define MINALLOC ((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
+#define NBUCKETS (11 - (MINALLOC >> 5))
+#define MAXALLOC (MINALLOC << (NBUCKETS - 1))
/*
* The following structure defines a bucket of blocks with various accounting
@@ -79,20 +84,22 @@ typedef struct Block {
typedef struct Bucket {
Block *firstPtr; /* First block available */
- int numFree; /* Number of blocks available */
+ long numFree; /* Number of blocks available */
/* All fields below for accounting only */
- int numRemoves; /* Number of removes from bucket */
- int numInserts; /* Number of inserts into bucket */
- int numWaits; /* Number of waits to acquire a lock */
- int numLocks; /* Number of locks acquired */
- int totalAssigned; /* Total space assigned to bucket */
+ long numRemoves; /* Number of removes from bucket */
+ long numInserts; /* Number of inserts into bucket */
+ long numWaits; /* Number of waits to acquire a lock */
+ long numLocks; /* Number of locks acquired */
+ long totalAssigned; /* Total space assigned to bucket */
} Bucket;
/*
* The following structure defines a cache of buckets and objs, of which there
- * will be (at most) one per thread.
+ * will be (at most) one per thread. Any changes need to be reflected in the
+ * struct AllocCache defined in tclInt.h, possibly also in the initialisation
+ * code in Tcl_CreateInterp().
*/
typedef struct Cache {
@@ -114,34 +121,20 @@ static struct {
int maxBlocks; /* Max blocks before move to share. */
int numMove; /* Num blocks to move to share. */
Tcl_Mutex *lockPtr; /* Share bucket lock. */
-} bucketInfo[NBUCKETS] = {
- { 16, 1024, 512, NULL},
- { 32, 512, 256, NULL},
- { 64, 256, 128, NULL},
- { 128, 128, 64, NULL},
- { 256, 64, 32, NULL},
- { 512, 32, 16, NULL},
- { 1024, 16, 8, NULL},
- { 2048, 8, 4, NULL},
- { 4096, 4, 2, NULL},
- { 8192, 2, 1, NULL},
- {16284, 1, 1, NULL},
-};
+} bucketInfo[NBUCKETS];
/*
* Static functions defined in this file.
*/
-static void LockBucket _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static void UnlockBucket _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static void PutBlocks _ANSI_ARGS_((Cache *cachePtr, int bucket,
- int numMove));
-static int GetBlocks _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static Block * Ptr2Block _ANSI_ARGS_((char *ptr));
-static char * Block2Ptr _ANSI_ARGS_((Block *blockPtr, int bucket,
- unsigned int reqSize));
-static void MoveObjs _ANSI_ARGS_((Cache *fromPtr, Cache *toPtr,
- int numMove));
+static Cache * GetCache(void);
+static void LockBucket(Cache *cachePtr, int bucket);
+static void UnlockBucket(Cache *cachePtr, int bucket);
+static void PutBlocks(Cache *cachePtr, int bucket, int numMove);
+static int GetBlocks(Cache *cachePtr, int bucket);
+static Block * Ptr2Block(char *ptr);
+static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
+static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
/*
* Local variables defined in this file and initialized at startup.
@@ -152,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
/*
*----------------------------------------------------------------------
@@ -180,7 +193,7 @@ GetCache(void)
if (listLockPtr == NULL) {
Tcl_Mutex *initLockPtr;
- int i;
+ unsigned int i;
initLockPtr = Tcl_GetAllocMutex();
Tcl_MutexLock(initLockPtr);
@@ -188,6 +201,10 @@ GetCache(void)
listLockPtr = TclpNewAllocMutex();
objLockPtr = TclpNewAllocMutex();
for (i = 0; i < NBUCKETS; ++i) {
+ bucketInfo[i].blockSize = MINALLOC << i;
+ bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
+ bucketInfo[i].numMove = i < NBUCKETS - 1 ?
+ 1 << (NBUCKETS - 2 - i) : 1;
bucketInfo[i].lockPtr = TclpNewAllocMutex();
}
}
@@ -231,12 +248,12 @@ GetCache(void)
*/
void
-TclFreeAllocCache(arg)
- void *arg;
+TclFreeAllocCache(
+ void *arg)
{
Cache *cachePtr = arg;
Cache **nextPtrPtr;
- register int bucket;
+ register unsigned int bucket;
/*
* Flush blocks.
@@ -290,17 +307,28 @@ TclFreeAllocCache(arg)
*/
char *
-TclpAlloc(reqSize)
- unsigned int reqSize;
+TclpAlloc(
+ unsigned int reqSize)
{
- Cache *cachePtr = TclpGetAllocCache();
+ Cache *cachePtr;
Block *blockPtr;
register int bucket;
size_t size;
- if (cachePtr == NULL) {
- cachePtr = GetCache();
+#ifndef __LP64__
+ if (sizeof(int) >= sizeof(size_t)) {
+ /* An unsigned int overflow can also be a size_t overflow */
+ const size_t zero = 0;
+ const size_t max = ~zero;
+
+ if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
+ /* Requested allocation exceeds memory */
+ return NULL;
+ }
}
+#endif
+
+ GETCACHE(cachePtr);
/*
* Increment the requested size to include room for the Block structure.
@@ -312,7 +340,7 @@ TclpAlloc(reqSize)
blockPtr = NULL;
size = reqSize + sizeof(Block);
#if RCHECK
- ++size;
+ size++;
#endif
if (size > MAXALLOC) {
bucket = NBUCKETS;
@@ -323,13 +351,13 @@ TclpAlloc(reqSize)
} else {
bucket = 0;
while (bucketInfo[bucket].blockSize < size) {
- ++bucket;
+ bucket++;
}
if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
blockPtr = cachePtr->buckets[bucket].firstPtr;
cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
- --cachePtr->buckets[bucket].numFree;
- ++cachePtr->buckets[bucket].numRemoves;
+ cachePtr->buckets[bucket].numFree--;
+ cachePtr->buckets[bucket].numRemoves++;
cachePtr->buckets[bucket].totalAssigned += reqSize;
}
}
@@ -356,8 +384,8 @@ TclpAlloc(reqSize)
*/
void
-TclpFree(ptr)
- char *ptr;
+TclpFree(
+ char *ptr)
{
Cache *cachePtr;
Block *blockPtr;
@@ -367,10 +395,7 @@ TclpFree(ptr)
return;
}
- cachePtr = TclpGetAllocCache();
- if (cachePtr == NULL) {
- cachePtr = GetCache();
- }
+ GETCACHE(cachePtr);
/*
* Get the block back from the user pointer and call system free directly
@@ -381,16 +406,16 @@ TclpFree(ptr)
blockPtr = Ptr2Block(ptr);
bucket = blockPtr->sourceBucket;
if (bucket == NBUCKETS) {
- cachePtr->totalAssigned -= blockPtr->reqSize;
+ cachePtr->totalAssigned -= blockPtr->blockReqSize;
free(blockPtr);
return;
}
- cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
+ cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
cachePtr->buckets[bucket].firstPtr = blockPtr;
- ++cachePtr->buckets[bucket].numFree;
- ++cachePtr->buckets[bucket].numInserts;
+ cachePtr->buckets[bucket].numFree++;
+ cachePtr->buckets[bucket].numInserts++;
if (cachePtr != sharedPtr &&
cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
@@ -415,13 +440,13 @@ TclpFree(ptr)
*/
char *
-TclpRealloc(ptr, reqSize)
- char *ptr;
- unsigned int reqSize;
+TclpRealloc(
+ char *ptr,
+ unsigned int reqSize)
{
- Cache *cachePtr = TclpGetAllocCache();
+ Cache *cachePtr;
Block *blockPtr;
- void *new;
+ void *newPtr;
size_t size, min;
int bucket;
@@ -429,9 +454,20 @@ TclpRealloc(ptr, reqSize)
return TclpAlloc(reqSize);
}
- if (cachePtr == NULL) {
- cachePtr = GetCache();
+#ifndef __LP64__
+ if (sizeof(int) >= sizeof(size_t)) {
+ /* An unsigned int overflow can also be a size_t overflow */
+ const size_t zero = 0;
+ const size_t max = ~zero;
+
+ if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
+ /* Requested allocation exceeds memory */
+ return NULL;
+ }
}
+#endif
+
+ GETCACHE(cachePtr);
/*
* If the block is not a system block and fits in place, simply return the
@@ -442,7 +478,7 @@ TclpRealloc(ptr, reqSize)
blockPtr = Ptr2Block(ptr);
size = reqSize + sizeof(Block);
#if RCHECK
- ++size;
+ size++;
#endif
bucket = blockPtr->sourceBucket;
if (bucket != NBUCKETS) {
@@ -452,12 +488,12 @@ TclpRealloc(ptr, reqSize)
min = 0;
}
if (size > min && size <= bucketInfo[bucket].blockSize) {
- cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
+ cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
cachePtr->buckets[bucket].totalAssigned += reqSize;
return Block2Ptr(blockPtr, bucket, reqSize);
}
} else if (size > MAXALLOC) {
- cachePtr->totalAssigned -= blockPtr->reqSize;
+ cachePtr->totalAssigned -= blockPtr->blockReqSize;
cachePtr->totalAssigned += reqSize;
blockPtr = realloc(blockPtr, size);
if (blockPtr == NULL) {
@@ -470,15 +506,15 @@ TclpRealloc(ptr, reqSize)
* Finally, perform an expensive malloc/copy/free.
*/
- new = TclpAlloc(reqSize);
- if (new != NULL) {
- if (reqSize > blockPtr->reqSize) {
- reqSize = blockPtr->reqSize;
+ newPtr = TclpAlloc(reqSize);
+ if (newPtr != NULL) {
+ if (reqSize > blockPtr->blockReqSize) {
+ reqSize = blockPtr->blockReqSize;
}
- memcpy(new, ptr, reqSize);
+ memcpy(newPtr, ptr, reqSize);
TclpFree(ptr);
}
- return new;
+ return newPtr;
}
/*
@@ -495,18 +531,20 @@ TclpRealloc(ptr, reqSize)
* May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
* list is empty.
*
+ * Note:
+ * If this code is updated, the changes need to be reflected in the macro
+ * TclAllocObjStorageEx() defined in tclInt.h
+ *
*----------------------------------------------------------------------
*/
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
@@ -535,7 +573,7 @@ TclThreadAllocObj(void)
}
while (--numMove >= 0) {
objPtr = &newObjsPtr[numMove];
- objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
}
}
@@ -546,8 +584,8 @@ TclThreadAllocObj(void)
*/
objPtr = cachePtr->firstObjPtr;
- cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
- --cachePtr->numObjects;
+ cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ cachePtr->numObjects--;
return objPtr;
}
@@ -564,26 +602,28 @@ TclThreadAllocObj(void)
* Side effects:
* May move free Tcl_Obj's to shared list upon hitting high water mark.
*
+ * Note:
+ * If this code is updated, the changes need to be reflected in the macro
+ * TclAllocObjStorageEx() defined in tclInt.h
+ *
*----------------------------------------------------------------------
*/
void
-TclThreadFreeObj(objPtr)
- Tcl_Obj *objPtr;
+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.
*/
- objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
- ++cachePtr->numObjects;
+ cachePtr->numObjects++;
/*
* If the number of free objects has exceeded the high water mark, move
@@ -614,12 +654,12 @@ TclThreadFreeObj(objPtr)
*/
void
-Tcl_GetMemoryInfo(dsPtr)
- Tcl_DString *dsPtr;
+Tcl_GetMemoryInfo(
+ Tcl_DString *dsPtr)
{
Cache *cachePtr;
char buf[200];
- int n;
+ unsigned int n;
Tcl_MutexLock(listLockPtr);
cachePtr = firstCachePtr;
@@ -632,8 +672,8 @@ Tcl_GetMemoryInfo(dsPtr)
Tcl_DStringAppendElement(dsPtr, buf);
}
for (n = 0; n < NBUCKETS; ++n) {
- sprintf(buf, "%d %d %d %d %d %d %d",
- (int) bucketInfo[n].blockSize,
+ sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
+ (unsigned long) bucketInfo[n].blockSize,
cachePtr->buckets[n].numFree,
cachePtr->buckets[n].numRemoves,
cachePtr->buckets[n].numInserts,
@@ -665,9 +705,10 @@ Tcl_GetMemoryInfo(dsPtr)
*/
static void
-MoveObjs(fromPtr, toPtr, numMove)
- Cache *fromPtr, *toPtr;
- int numMove;
+MoveObjs(
+ Cache *fromPtr,
+ Cache *toPtr,
+ int numMove)
{
register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
Tcl_Obj *fromFirstObjPtr = objPtr;
@@ -681,16 +722,16 @@ MoveObjs(fromPtr, toPtr, numMove)
*/
while (--numMove) {
- objPtr = objPtr->internalRep.otherValuePtr;
+ objPtr = objPtr->internalRep.twoPtrValue.ptr1;
}
- fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+ fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
/*
* Move all objects as a block - they are already linked to each other, we
* just have to update the first and last.
*/
- objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
toPtr->firstObjPtr = fromFirstObjPtr;
}
@@ -711,16 +752,16 @@ MoveObjs(fromPtr, toPtr, numMove)
*/
static char *
-Block2Ptr(blockPtr, bucket, reqSize)
- Block *blockPtr;
- int bucket;
- unsigned int reqSize;
+Block2Ptr(
+ Block *blockPtr,
+ int bucket,
+ unsigned int reqSize)
{
register void *ptr;
blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
blockPtr->sourceBucket = bucket;
- blockPtr->reqSize = reqSize;
+ blockPtr->blockReqSize = reqSize;
ptr = ((void *) (blockPtr + 1));
#if RCHECK
((unsigned char *)(ptr))[reqSize] = MAGIC;
@@ -729,21 +770,21 @@ Block2Ptr(blockPtr, bucket, reqSize)
}
static Block *
-Ptr2Block(ptr)
- char *ptr;
+Ptr2Block(
+ char *ptr)
{
register Block *blockPtr;
blockPtr = (((Block *) ptr) - 1);
if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
- Tcl_Panic("alloc: invalid block: %p: %x %x\n",
+ Tcl_Panic("alloc: invalid block: %p: %x %x",
blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
}
#if RCHECK
- if (((unsigned char *) ptr)[blockPtr->reqSize] != MAGIC) {
- Tcl_Panic("alloc: invalid block: %p: %x %x %x\n",
+ if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) {
+ Tcl_Panic("alloc: invalid block: %p: %x %x %x",
blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
- ((unsigned char *) ptr)[blockPtr->reqSize]);
+ ((unsigned char *) ptr)[blockPtr->blockReqSize]);
}
#endif
return blockPtr;
@@ -767,27 +808,19 @@ Ptr2Block(ptr)
*/
static void
-LockBucket(cachePtr, bucket)
- Cache *cachePtr;
- int bucket;
+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;
+ cachePtr->buckets[bucket].numLocks++;
+ sharedPtr->buckets[bucket].numLocks++;
}
static void
-UnlockBucket(cachePtr, bucket)
- Cache *cachePtr;
- int bucket;
+UnlockBucket(
+ Cache *cachePtr,
+ int bucket)
{
Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
}
@@ -809,9 +842,10 @@ UnlockBucket(cachePtr, bucket)
*/
static void
-PutBlocks(cachePtr, bucket, numMove)
- Cache *cachePtr;
- int bucket, numMove;
+PutBlocks(
+ Cache *cachePtr,
+ int bucket,
+ int numMove)
{
register Block *lastPtr, *firstPtr;
register int n = numMove;
@@ -857,9 +891,9 @@ PutBlocks(cachePtr, bucket, numMove)
*/
static int
-GetBlocks(cachePtr, bucket)
- Cache *cachePtr;
- int bucket;
+GetBlocks(
+ Cache *cachePtr,
+ int bucket)
{
register Block *blockPtr;
register int n;
@@ -919,7 +953,7 @@ GetBlocks(cachePtr, bucket)
size = bucketInfo[n].blockSize;
blockPtr = cachePtr->buckets[n].firstPtr;
cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
- --cachePtr->buckets[n].numFree;
+ cachePtr->buckets[n].numFree--;
break;
}
}
@@ -971,12 +1005,13 @@ GetBlocks(cachePtr, bucket)
*/
void
-TclFinalizeThreadAlloc()
+TclFinalizeThreadAlloc(void)
{
- int i;
+ unsigned int i;
+
for (i = 0; i < NBUCKETS; ++i) {
- TclpFreeAllocMutex(bucketInfo[i].lockPtr);
- bucketInfo[i].lockPtr = NULL;
+ TclpFreeAllocMutex(bucketInfo[i].lockPtr);
+ bucketInfo[i].lockPtr = NULL;
}
TclpFreeAllocMutex(objLockPtr);
@@ -988,7 +1023,57 @@ TclFinalizeThreadAlloc()
TclpFreeAllocCache(NULL);
}
-#else
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ * This procedure is used to destroy single thread private resources used
+ * in this file.
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ if (cachePtr != NULL) {
+ TclpFreeAllocCache(cachePtr);
+ }
+}
+
+#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetMemoryInfo --
+ *
+ * Return a list-of-lists of memory stats.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * List appended to given dstring.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetMemoryInfo(
+ Tcl_DString *dsPtr)
+{
+ Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
+}
+
/*
*----------------------------------------------------------------------
*
@@ -1007,11 +1092,11 @@ TclFinalizeThreadAlloc()
*/
void
-TclFinalizeThreadAlloc()
+TclFinalizeThreadAlloc(void)
{
- Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use.");
+ Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use");
}
-#endif /* TCL_THREADS */
+#endif /* TCL_THREADS && USE_THREAD_ALLOC */
/*
* Local Variables:
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 7abcfcc..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -10,13 +10,11 @@
*
* 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.6 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
-#ifdef WIN32
+#ifdef _WIN32
/*
* The information about each joinable thread is remembered in a structure as
@@ -54,7 +52,7 @@ typedef struct JoinableThread {
TCL_DECLARE_MUTEX(joinMutex)
-static JoinableThread* firstThreadPtr;
+static JoinableThread *firstThreadPtr;
/*
*----------------------------------------------------------------------
@@ -78,9 +76,9 @@ static JoinableThread* firstThreadPtr;
*/
int
-TclJoinThread(id, result)
- Tcl_ThreadId id; /* The id of the thread to wait upon. */
- int *result; /* Reference to a location for the result of
+TclJoinThread(
+ Tcl_ThreadId id, /* The id of the thread to wait upon. */
+ int *result) /* Reference to a location for the result of
* the thread we are waiting upon. */
{
JoinableThread *threadPtr;
@@ -203,7 +201,7 @@ TclJoinThread(id, result)
Tcl_ConditionFinalize(&threadPtr->cond);
Tcl_MutexFinalize(&threadPtr->threadMutex);
- ckfree((char *) threadPtr);
+ ckfree(threadPtr);
return TCL_OK;
}
@@ -226,13 +224,13 @@ TclJoinThread(id, result)
*----------------------------------------------------------------------
*/
-VOID
-TclRememberJoinableThread(id)
- Tcl_ThreadId id; /* The thread to remember as joinable */
+void
+TclRememberJoinableThread(
+ Tcl_ThreadId id) /* The thread to remember as joinable */
{
JoinableThread *threadPtr;
- threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
+ threadPtr = ckalloc(sizeof(JoinableThread));
threadPtr->id = id;
threadPtr->done = 0;
threadPtr->waitedUpon = 0;
@@ -265,10 +263,10 @@ TclRememberJoinableThread(id)
*----------------------------------------------------------------------
*/
-VOID
-TclSignalExitThread(id,result)
- Tcl_ThreadId id; /* Id of the thread signaling its exit. */
- int result; /* The result from the thread. */
+void
+TclSignalExitThread(
+ Tcl_ThreadId id, /* Id of the thread signaling its exit. */
+ int result) /* The result from the thread. */
{
JoinableThread *threadPtr;
@@ -307,7 +305,7 @@ TclSignalExitThread(id,result)
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
-#endif /* WIN32 */
+#endif /* _WIN32 */
/*
* Local Variables:
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 10093e4..f24e334 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -1,156 +1,183 @@
/*
* tclThreadStorage.c --
*
- * This file implements platform independent thread storage operations.
+ * This file implements platform independent thread storage operations to
+ * work around system limits on the number of thread-specific variables.
*
* Copyright (c) 2003-2004 by Joe Mistachkin
+ * Copyright (c) 2008 by George Peter Staplin
*
* 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.7 2005/08/11 22:06:47 kennykb Exp $
*/
#include "tclInt.h"
-#if defined(TCL_THREADS)
-
-/*
- * This is the thread storage cache array and it's accompanying mutex. The
- * elements are pairs of thread Id and an associated hash table pointer; the
- * hash table being pointed to contains the thread storage for it's associated
- * thread. The purpose of this cache is to minimize the number of hash table
- * lookups in the master thread storage hash table.
- */
-
-static Tcl_Mutex threadStorageLock;
+#ifdef TCL_THREADS
+#include <signal.h>
/*
- * This is the struct used for a thread storage cache slot. It contains the
- * owning thread Id and the associated hash table pointer.
+ * IMPLEMENTATION NOTES:
+ *
+ * The primary idea is that we create one platform-specific TSD slot, and use
+ * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into
+ * the table of TSD values. We don't use more than 1 platform-specific TSD
+ * slot, because there is a hard limit on the number of TSD slots. Valid key
+ * offsets are greater than 0; 0 is for the initialized Tcl_ThreadDataKey.
*/
-typedef struct ThreadStorage {
- Tcl_ThreadId id; /* the owning thread id */
- Tcl_HashTable *hashTablePtr;/* the hash table for the thread */
-} ThreadStorage;
-
/*
- * These are the prototypes for the custom hash table allocation functions
- * used by the thread storage subsystem.
+ * The master collection of information about TSDs. This is shared across the
+ * whole process, and includes the mutex used to protect it.
*/
-static Tcl_HashEntry * AllocThreadStorageEntry(Tcl_HashTable *tablePtr,
- void *keyPtr);
-static void FreeThreadStorageEntry(Tcl_HashEntry *hPtr);
-static Tcl_HashTable * ThreadStorageGetHashTable(Tcl_ThreadId id);
+static struct TSDMaster {
+ void *key; /* Key into the system TSD structure. The
+ * collection of Tcl TSD values for a
+ * particular thread will hang off the
+ * back-end of this. */
+ sig_atomic_t counter; /* The number of different Tcl TSDs used
+ * across *all* threads. This is a strictly
+ * increasing value. */
+ Tcl_Mutex mutex; /* Protection for the rest of this structure,
+ * which holds per-process data. */
+} tsdMaster = { NULL, 0, NULL };
/*
- * This is the hash key type for thread storage. We MUST use this in
- * combination with the new hash key type flag TCL_HASH_KEY_SYSTEM_HASH
- * because these hash tables MAY be used by the threaded memory allocator.
+ * The type of the data held per thread in a system TSD.
*/
-Tcl_HashKeyType tclThreadStorageHashKeyType = {
- TCL_HASH_KEY_TYPE_VERSION, /* version */
- TCL_HASH_KEY_SYSTEM_HASH | TCL_HASH_KEY_RANDOMIZE_HASH,
- /* flags */
- NULL, /* hashKeyProc */
- NULL, /* compareKeysProc */
- AllocThreadStorageEntry, /* allocEntryProc */
- FreeThreadStorageEntry /* freeEntryProc */
-};
+typedef struct TSDTable {
+ ClientData *tablePtr; /* The table of Tcl TSDs. */
+ sig_atomic_t allocated; /* The size of the table in the current
+ * thread. */
+} TSDTable;
/*
- * This is an invalid thread value.
+ * The actual type of Tcl_ThreadDataKey.
*/
-#define STORAGE_INVALID_THREAD (Tcl_ThreadId)0
+typedef union TSDUnion {
+ volatile sig_atomic_t offset;
+ /* The type is really an offset into the
+ * thread-local table of TSDs, which is this
+ * field. */
+ void *ptr; /* For alignment purposes only. Not actually
+ * accessed through this. */
+} TSDUnion;
/*
- * This is the value for an invalid thread storage key.
+ * Forward declarations of functions in this file.
*/
-#define STORAGE_INVALID_KEY 0
-
+static TSDTable * TSDTableCreate(void);
+static void TSDTableDelete(TSDTable *tsdTablePtr);
+static void TSDTableGrow(TSDTable *tsdTablePtr,
+ sig_atomic_t atLeast);
+
/*
- * This is the first valid key for use by external callers. All the values
- * below this are RESERVED for future use.
+ * Allocator and deallocator for a TSDTable structure.
*/
-#define STORAGE_FIRST_KEY 1
+static TSDTable *
+TSDTableCreate(void)
+{
+ TSDTable *tsdTablePtr;
+ sig_atomic_t i;
-/*
- * This is the default number of thread storage cache slots. This define may
- * need to be fine tuned for maximum performance.
- */
+ tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0);
+ if (tsdTablePtr == NULL) {
+ Tcl_Panic("unable to allocate TSDTable");
+ }
-#define STORAGE_CACHE_SLOTS 97
+ tsdTablePtr->allocated = 8;
+ tsdTablePtr->tablePtr =
+ TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
+ if (tsdTablePtr->tablePtr == NULL) {
+ Tcl_Panic("unable to allocate TSDTable");
+ }
-/*
- * This is the master thread storage hash table. It is keyed on thread Id and
- * contains values that are hash tables for each thread. The thread specific
- * hash tables contain the actual thread storage.
- */
+ for (i = 0; i < tsdTablePtr->allocated; ++i) {
+ tsdTablePtr->tablePtr[i] = NULL;
+ }
-static Tcl_HashTable threadStorageHashTable;
+ return tsdTablePtr;
+}
-/*
- * This is the next thread data key value to use. We increment this everytime
- * we "allocate" one. It is initially set to 1 in TclInitThreadStorage.
- */
+static void
+TSDTableDelete(
+ TSDTable *tsdTablePtr)
+{
+ sig_atomic_t i;
-static int nextThreadStorageKey = STORAGE_INVALID_KEY;
+ for (i=0 ; i<tsdTablePtr->allocated ; i++) {
+ if (tsdTablePtr->tablePtr[i] != NULL) {
+ /*
+ * These values were allocated in Tcl_GetThreadData in tclThread.c
+ * and must now be deallocated or they will leak.
+ */
-/*
- * This is the master thread storage cache. Per Kevin Kenny's idea, this
- * prevents unnecessary lookups for threads that use a lot of thread storage.
- */
+ ckfree(tsdTablePtr->tablePtr[i]);
+ }
+ }
-static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
+ TclpSysFree(tsdTablePtr->tablePtr);
+ TclpSysFree(tsdTablePtr);
+}
/*
*----------------------------------------------------------------------
*
- * AllocThreadStorageEntry --
+ * TSDTableGrow --
*
- * Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
- * We do this because the threaded memory allocator MAY use the thread
- * storage hash tables.
+ * This procedure makes the passed TSDTable grow to fit the atLeast
+ * value.
*
* Results:
- * The return value is a pointer to the created entry.
+ * None.
*
* Side effects:
- * None.
+ * The table is enlarged.
*
*----------------------------------------------------------------------
*/
-static Tcl_HashEntry *
-AllocThreadStorageEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- void *keyPtr; /* Key to store in the hash table entry. */
+static void
+TSDTableGrow(
+ TSDTable *tsdTablePtr,
+ sig_atomic_t atLeast)
{
- Tcl_HashEntry *hPtr;
+ sig_atomic_t newAllocated = tsdTablePtr->allocated * 2;
+ ClientData *newTablePtr;
+ sig_atomic_t i;
- hPtr = (Tcl_HashEntry *)TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
- hPtr->key.oneWordValue = (char *)keyPtr;
+ if (newAllocated <= atLeast) {
+ newAllocated = atLeast + 10;
+ }
+
+ newTablePtr = TclpSysRealloc(tsdTablePtr->tablePtr,
+ sizeof(ClientData) * newAllocated);
+ if (newTablePtr == NULL) {
+ Tcl_Panic("unable to reallocate TSDTable");
+ }
+
+ for (i = tsdTablePtr->allocated; i < newAllocated; ++i) {
+ newTablePtr[i] = NULL;
+ }
- return hPtr;
+ tsdTablePtr->allocated = newAllocated;
+ tsdTablePtr->tablePtr = newTablePtr;
}
/*
*----------------------------------------------------------------------
*
- * FreeThreadStorageEntry --
+ * TclThreadStorageKeyGet --
*
- * Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree). We do
- * this because the threaded memory allocator MAY use the thread storage
- * hash tables.
+ * This procedure gets the value associated with the passed key.
*
* Results:
- * None.
+ * A pointer value associated with the Tcl_ThreadDataKey or NULL.
*
* Side effects:
* None.
@@ -158,325 +185,138 @@ AllocThreadStorageEntry(tablePtr, keyPtr)
*----------------------------------------------------------------------
*/
-static void
-FreeThreadStorageEntry(hPtr)
- Tcl_HashEntry *hPtr; /* Hash entry to free. */
+void *
+TclThreadStorageKeyGet(
+ Tcl_ThreadDataKey *dataKeyPtr)
{
- TclpSysFree((char *)hPtr);
+ TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+ ClientData resultPtr = NULL;
+ TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
+ sig_atomic_t offset = keyPtr->offset;
+
+ if ((tsdTablePtr != NULL) && (offset > 0)
+ && (offset < tsdTablePtr->allocated)) {
+ resultPtr = tsdTablePtr->tablePtr[offset];
+ }
+ return resultPtr;
}
/*
*----------------------------------------------------------------------
*
- * ThreadStorageGetHashTable --
- *
- * This procedure returns a hash table pointer to be used for thread
- * storage for the specified thread.
- *
- * This assumes that thread storage lock is held.
+ * TclThreadStorageKeySet --
*
+ * This procedure set an association of value with the key passed. The
+ * associated value may be retrieved with TclThreadDataKeyGet().
+ *
* Results:
- * A hash table pointer for the specified thread, or NULL if the hash
- * table has not been created yet.
+ * None.
*
* Side effects:
- * May change an entry in the master thread storage cache to point to the
- * specified thread and it's associated hash table.
+ * The thread-specific table may be created or reallocated.
*
*----------------------------------------------------------------------
*/
-static Tcl_HashTable *
-ThreadStorageGetHashTable(id)
- Tcl_ThreadId id; /* Id of thread to get hash table for */
+void
+TclThreadStorageKeySet(
+ Tcl_ThreadDataKey *dataKeyPtr,
+ void *value)
{
- int index = (unsigned int)id % STORAGE_CACHE_SLOTS;
- Tcl_HashEntry *hPtr;
- int new;
+ TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
+
+ if (tsdTablePtr == NULL) {
+ tsdTablePtr = TSDTableCreate();
+ TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
+ }
/*
- * It's important that we pick up the hash table pointer BEFORE comparing
- * thread Id in case another thread is in the critical region changing
- * things out from under you.
+ * Get the lock while we check if this TSD is new or not. Note that this
+ * is the only place where Tcl_ThreadDataKey values are set. We use a
+ * double-checked lock to try to avoid having to grab this lock a lot,
+ * since it is on quite a few critical paths and will only get set once in
+ * each location.
*/
- Tcl_HashTable *hashTablePtr = threadStorageCache[index].hashTablePtr;
-
- if (threadStorageCache[index].id != id) {
- Tcl_MutexLock(&threadStorageLock);
-
- /*
- * It's not in the cache, so we look it up...
- */
-
- hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *)id);
-
- if (hPtr != NULL) {
- /*
- * We found it, extract the hash table pointer.
- */
-
- hashTablePtr = Tcl_GetHashValue(hPtr);
- } else {
+ if (keyPtr->offset == 0) {
+ Tcl_MutexLock(&tsdMaster.mutex);
+ if (keyPtr->offset == 0) {
/*
- * The thread specific hash table is not found.
+ * The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
*/
-
- hashTablePtr = NULL;
- }
- if (hashTablePtr == NULL) {
- hashTablePtr = (Tcl_HashTable *)
- TclpSysAlloc(sizeof(Tcl_HashTable), 0);
-
- if (hashTablePtr == NULL) {
- Tcl_Panic("could not allocate thread specific hash "
- "table, TclpSysAlloc failed from "
- "ThreadStorageGetHashTable!");
- }
- Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
- &tclThreadStorageHashKeyType);
-
- /*
- * Add new thread storage hash table to the master hash table.
- */
-
- hPtr = Tcl_CreateHashEntry(&threadStorageHashTable,
- (char *)id, &new);
-
- if (hPtr == NULL) {
- Tcl_Panic("Tcl_CreateHashEntry failed from "
- "ThreadStorageGetHashTable!");
- }
- Tcl_SetHashValue(hPtr, hashTablePtr);
+ keyPtr->offset = ++tsdMaster.counter;
}
-
- /*
- * Now, we put it in the cache since it is highly likely it will
- * be needed again shortly.
- */
-
- threadStorageCache[index].id = id;
- threadStorageCache[index].hashTablePtr = hashTablePtr;
-
- Tcl_MutexUnlock(&threadStorageLock);
+ Tcl_MutexUnlock(&tsdMaster.mutex);
}
- return hashTablePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitThreadStorage --
- *
- * Initializes the thread storage allocator.
- *
- * Results:
- * None.
- *
- * Side effects:
- * This procedure initializes the master hash table that maps
- * thread ID onto the individual index tables that map thread data
- * key to thread data. It also creates a cache that enables
- * fast lookup of the thread data block array for a recently
- * executing thread without using spinlocks.
- *
- * This procedure is called from an extremely early point in Tcl's
- * initialization. In particular, it may not use ckalloc/ckfree
- * because they may depend on thread-local storage (it uses TclpSysAlloc
- * and TclpSysFree instead). It may not depend on synchronization
- * primitives - but no threads other than the master thread have yet
- * been launched.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitThreadStorage()
-{
-
- Tcl_InitCustomHashTable(&threadStorageHashTable,
- TCL_CUSTOM_TYPE_KEYS, &tclThreadStorageHashKeyType);
-
/*
- * We also initialize the cache.
+ * Check if this is the first time this Tcl_ThreadDataKey has been used
+ * with the current thread. Note that we don't need to hold a lock when
+ * doing this, as we are *definitely* the only point accessing this
+ * tsdTablePtr right now; it's thread-local.
*/
-
- memset((ThreadStorage *)&threadStorageCache, 0,
- sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
-
+
+ if (keyPtr->offset >= tsdTablePtr->allocated) {
+ TSDTableGrow(tsdTablePtr, keyPtr->offset);
+ }
+
/*
- * Now, we set the first value to be used for a thread data key.
+ * Set the value in the Tcl thread-local variable.
*/
-
- nextThreadStorageKey = STORAGE_FIRST_KEY;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadDataKeyGet --
- *
- * This procedure returns a pointer to a block of thread local storage.
- *
- * Results:
- * A thread-specific pointer to the data structure, or NULL if the memory
- * has not been assigned to this key for this thread.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-void *
-TclpThreadDataKeyGet(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
- * (int**) */
-{
- Tcl_HashTable *hashTablePtr =
- ThreadStorageGetHashTable(Tcl_GetCurrentThread());
- Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(hashTablePtr, (char *) keyPtr);
- if (hPtr == NULL) {
- return NULL;
- }
- return (void *) Tcl_GetHashValue(hPtr);
+ tsdTablePtr->tablePtr[keyPtr->offset] = value;
}
/*
*----------------------------------------------------------------------
*
- * TclpThreadDataKeySet --
+ * TclFinalizeThreadDataThread --
*
- * This procedure sets the pointer to a block of thread local storage.
+ * This procedure finalizes the data for a single thread.
*
* Results:
* None.
*
* Side effects:
- * Sets up the thread so future calls to TclpThreadDataKeyGet with
- * this key will return the data pointer.
+ * The TSDTable is deleted/freed.
*
*----------------------------------------------------------------------
*/
-void
-TclpThreadDataKeySet(keyPtr, data)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
- * (pthread_key_t **) */
- void *data; /* Thread local storage */
+void
+TclFinalizeThreadDataThread(void)
{
- Tcl_HashTable *hashTablePtr;
- Tcl_HashEntry *hPtr;
+ TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
- hashTablePtr = ThreadStorageGetHashTable(Tcl_GetCurrentThread());
- hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)keyPtr);
-
- /*
- * Does the item need to be created?
- */
-
- if (hPtr == NULL) {
- int new;
- hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)keyPtr, &new);
+ if (tsdTablePtr != NULL) {
+ TSDTableDelete(tsdTablePtr);
+ TclpThreadSetMasterTSD(tsdMaster.key, NULL);
}
-
- Tcl_SetHashValue(hPtr, data);
}
/*
*----------------------------------------------------------------------
*
- * TclpFinalizeThreadDataThread --
+ * TclInitializeThreadStorage --
*
- * This procedure cleans up the thread storage hash table for the
- * current thread.
+ * This procedure initializes the TSD subsystem with per-platform code.
+ * This should be called before any Tcl threads are created.
*
* Results:
* None.
*
* Side effects:
- * Frees all associated thread storage, all hash table entries for
- * the thread's thread storage, and the hash table itself.
+ * Allocates a system TSD.
*
*----------------------------------------------------------------------
*/
void
-TclpFinalizeThreadDataThread()
+TclInitThreadStorage(void)
{
- Tcl_ThreadId id = Tcl_GetCurrentThread();
- /* Id of the thread to finalize. */
- int index = (unsigned int)id % STORAGE_CACHE_SLOTS;
- Tcl_HashEntry *hPtr; /* Hash entry for current thread in master
- * table. */
- Tcl_HashTable* hashTablePtr;
- /* Pointer to the hash table holding
- * TSD blocks for the current thread*/
- Tcl_HashSearch search; /* Search object to walk the TSD blocks
- * in the designated thread */
- Tcl_HashEntry *hPtr2; /* Hash entry for a TSD block in the
- * designated thread. */
-
- Tcl_MutexLock(&threadStorageLock);
- hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char*)id);
- if (hPtr == NULL) {
- hashTablePtr = NULL;
- } else {
- /*
- * We found it, extract the hash table pointer.
- */
-
- hashTablePtr = Tcl_GetHashValue(hPtr);
- Tcl_DeleteHashEntry(hPtr);
-
- /*
- * Make sure cache entry for this thread is NULL.
- */
-
- if (threadStorageCache[index].id == id) {
- /*
- * We do not step on another thread's cache entry. This is
- * especially important if we are creating and exiting a lot
- * of threads.
- */
- threadStorageCache[index].id = STORAGE_INVALID_THREAD;
- threadStorageCache[index].hashTablePtr = NULL;
- }
- }
- Tcl_MutexUnlock(&threadStorageLock);
-
- /*
- * The thread's hash table has been extracted and removed from the master
- * hash table. Now clean up the thread.
- */
-
- if (hashTablePtr != NULL) {
-
- /* Free all TSD */
-
- for (hPtr2 = Tcl_FirstHashEntry(hashTablePtr, &search);
- hPtr2 != NULL;
- hPtr2 = Tcl_NextHashEntry(&search)) {
- void* blockPtr = Tcl_GetHashValue(hPtr2);
- if (blockPtr != NULL) {
- /*
- * The block itself was allocated in Tcl_GetThreadData
- * using ckalloc; use ckfree to dispose of it.
- */
- ckfree(blockPtr);
- }
- }
-
- /*
- * Delete thread specific hash table and free the struct.
- */
-
- Tcl_DeleteHashTable(hashTablePtr);
- TclpSysFree((char *)hashTablePtr);
- }
+ tsdMaster.key = TclpThreadCreateKey();
}
/*
@@ -484,96 +324,45 @@ TclpFinalizeThreadDataThread()
*
* TclFinalizeThreadStorage --
*
- * This procedure cleans up the master thread storage hash table, all
- * thread specific hash tables, and the thread storage cache.
+ * This procedure cleans up the thread storage data key for all threads.
+ * IMPORTANT: All Tcl threads must be finalized before calling this!
*
* Results:
* None.
*
* Side effects:
- * The master thread storage hash table and thread storage cache are
- * reset to their initial (empty) state.
+ * Releases the thread data key.
*
*----------------------------------------------------------------------
*/
void
-TclFinalizeThreadStorage()
+TclFinalizeThreadStorage(void)
{
- Tcl_HashSearch search; /* We need to hit every thread with
- * this search. */
- Tcl_HashEntry *hPtr; /* Hash entry for current thread in
- * master table. */
- Tcl_MutexLock(&threadStorageLock);
-
- /*
- * We are going to delete the hash table for every thread now. This
- * hash table should be empty at this point, except for one entry for
- * the current thread.
- */
-
- for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);
-
- if (hashTablePtr != NULL) {
- /*
- * Delete thread specific hash table for the thread in
- * question and free the struct.
- */
-
- Tcl_DeleteHashTable(hashTablePtr);
- TclpSysFree((char *)hashTablePtr);
- }
-
- /*
- * Delete thread specific entry from master hash table.
- */
-
- Tcl_SetHashValue(hPtr, NULL);
- }
-
- Tcl_DeleteHashTable(&threadStorageHashTable);
-
- /*
- * Clear out the thread storage cache as well.
- */
-
- memset((ThreadStorage *)&threadStorageCache, 0,
- sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
-
- /*
- * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
- * storage subsystem gets reinitialized
- */
-
- nextThreadStorageKey = STORAGE_INVALID_KEY;
-
- Tcl_MutexUnlock(&threadStorageLock);
+ TclpThreadDeleteKey(tsdMaster.key);
+ tsdMaster.key = NULL;
}
-#else /* !defined(TCL_THREADS) */
-
+#else /* !TCL_THREADS */
/*
* Stub functions for non-threaded builds
*/
void
-TclInitThreadStorage()
+TclInitThreadStorage(void)
{
}
void
-TclpFinalizeThreadDataThread()
+TclFinalizeThreadDataThread(void)
{
}
void
-TclFinalizeThreadStorage()
+TclFinalizeThreadStorage(void)
{
}
-
-#endif /* defined(TCL_THREADS) && defined(USE_THREAD_STORAGE) */
+#endif /* TCL_THREADS */
/*
* Local Variables:
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index cca3c5f..02ee038 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -1,72 +1,79 @@
-/*
+/*
* tclThreadTest.c --
*
- * This file implements the testthread command. Eventually this
- * should be tclThreadCmd.c
+ * This file implements the testthread command. Eventually this should be
+ * tclThreadCmd.c
* Some of this code is based on work done by Richard Hipp on behalf of
* Conservation Through Innovation, Limited, with their permission.
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
+ * Copyright (c) 2006-2008 by Joe Mistachkin. 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: tclThreadTest.c,v 1.21 2005/08/26 22:11:16 andreas_kupries 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
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
#ifdef TCL_THREADS
/*
- * Each thread has an single instance of the following structure. There
- * is one instance of this structure per thread even if that thread contains
- * multiple interpreters. The interpreter identified by this structure is
- * the main interpreter for the thread.
- *
- * The main interpreter is the one that will process any messages
- * received by a thread. Any thread can send messages but only the
- * main interpreter can receive them.
+ * Each thread has an single instance of the following structure. There is one
+ * instance of this structure per thread even if that thread contains multiple
+ * interpreters. The interpreter identified by this structure is the main
+ * interpreter for the thread.
+ *
+ * The main interpreter is the one that will process any messages received by
+ * a thread. Any thread can send messages but only the main interpreter can
+ * receive them.
*/
typedef struct ThreadSpecificData {
- Tcl_ThreadId threadId; /* Tcl ID for this thread */
- Tcl_Interp *interp; /* Main interpreter for this thread */
- int flags; /* See the TP_ defines below... */
- struct ThreadSpecificData *nextPtr; /* List for "thread names" */
- struct ThreadSpecificData *prevPtr; /* List for "thread names" */
+ Tcl_ThreadId threadId; /* Tcl ID for this thread */
+ Tcl_Interp *interp; /* Main interpreter for this thread */
+ int flags; /* See the TP_ defines below... */
+ struct ThreadSpecificData *nextPtr;
+ /* List for "thread names" */
+ struct ThreadSpecificData *prevPtr;
+ /* List for "thread names" */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
- * This list is used to list all threads that have interpreters.
- * This is protected by threadMutex.
+ * This list is used to list all threads that have interpreters. This is
+ * protected by threadMutex.
*/
-static struct ThreadSpecificData *threadList;
+static ThreadSpecificData *threadList = NULL;
/*
* The following bit-values are legal for the "flags" field of the
* ThreadSpecificData structure.
*/
-#define TP_Dying 0x001 /* This thread is being cancelled */
+
+#define TP_Dying 0x001 /* This thread is being canceled */
/*
* An instance of the following structure contains all information that is
* passed into a new thread when the thread is created using either the
- * "thread create" Tcl command or the TclCreateThread() C function.
+ * "thread create" Tcl command or the ThreadCreate() C function.
*/
typedef struct ThreadCtrl {
- char *script; /* The TCL command this thread should execute */
- int flags; /* Initial value of the "flags" field in the
- * ThreadSpecificData structure for the new thread.
- * Might contain TP_Detached or TP_TclThread. */
- Tcl_Condition condWait;
- /* This condition variable is used to synchronize
- * the parent and child threads. The child won't run
- * until it acquires threadMutex, and the parent function
- * won't complete until signaled on this condition
- * variable. */
+ const char *script; /* The Tcl command this thread should
+ * execute */
+ int flags; /* Initial value of the "flags" field in the
+ * ThreadSpecificData structure for the new
+ * thread. Might contain TP_Detached or
+ * TP_TclThread. */
+ Tcl_Condition condWait; /* This condition variable is used to
+ * synchronize the parent and child threads.
+ * The child won't run until it acquires
+ * threadMutex, and the parent function won't
+ * complete until signaled on this condition
+ * variable. */
} ThreadCtrl;
/*
@@ -77,8 +84,8 @@ typedef struct ThreadEvent {
Tcl_Event event; /* Must be first */
char *script; /* The script to execute. */
struct ThreadEventResult *resultPtr;
- /* To communicate the result. This is
- * NULL if we don't care about it. */
+ /* To communicate the result. This is NULL if
+ * we don't care about it. */
} ThreadEvent;
typedef struct ThreadEventResult {
@@ -101,47 +108,38 @@ static ThreadEventResult *resultList;
* This is for simple error handling when a thread script exits badly.
*/
+static Tcl_ThreadId mainThreadId;
static Tcl_ThreadId errorThreadId;
static char *errorProcString;
-/*
- * Access to the list of threads and to the thread send results is
- * guarded by this mutex.
+/*
+ * Access to the list of threads and to the thread send results is guarded by
+ * this mutex.
*/
TCL_DECLARE_MUTEX(threadMutex)
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-EXTERN int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, int joinable));
-EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
- char *script, int wait));
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
-Tcl_ThreadCreateType NewTestThread _ANSI_ARGS_((ClientData clientData));
-static void ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
-static void ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
-static int ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask));
-static void ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp));
-static void ThreadFreeProc _ANSI_ARGS_((ClientData clientData));
-static int ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr,
- ClientData clientData));
-static void ThreadExitProc _ANSI_ARGS_((ClientData clientData));
-
-
-/* Forward declaration of function import from "tclTest.c".
- */
-
-int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-
+static int ThreadObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ThreadCreate(Tcl_Interp *interp, const char *script,
+ int joinable);
+static int ThreadList(Tcl_Interp *interp);
+static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
+ const char *script, int wait);
+static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id,
+ const char *result, int flags);
+
+static Tcl_ThreadCreateType NewTestThread(ClientData clientData);
+static void ListRemove(ThreadSpecificData *tsdPtr);
+static void ListUpdateInner(ThreadSpecificData *tsdPtr);
+static int ThreadEventProc(Tcl_Event *evPtr, int mask);
+static void ThreadErrorProc(Tcl_Interp *interp);
+static void ThreadFreeProc(ClientData clientData);
+static int ThreadDeleteEvent(Tcl_Event *eventPtr,
+ ClientData clientData);
+static void ThreadExitProc(ClientData clientData);
+extern int Tcltest_Init(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -151,7 +149,7 @@ int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
* Initialize the test thread command.
*
* Results:
- * TCL_OK if the package was properly initialized.
+ * TCL_OK if the package was properly initialized.
*
* Side effects:
* Add the "testthread" command to the interp.
@@ -160,12 +158,20 @@ int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
*/
int
-TclThread_Init(interp)
- Tcl_Interp *interp; /* The current Tcl interpreter */
+TclThread_Init(
+ Tcl_Interp *interp) /* The current Tcl interpreter */
{
-
- Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd,
- (ClientData)NULL ,NULL);
+ /*
+ * If the main thread Id has not been set, do it now.
+ */
+
+ Tcl_MutexLock(&threadMutex);
+ if (mainThreadId == 0) {
+ mainThreadId = Tcl_GetCurrentThread();
+ }
+ Tcl_MutexUnlock(&threadMutex);
+
+ Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
return TCL_OK;
}
@@ -173,15 +179,17 @@ TclThread_Init(interp)
/*
*----------------------------------------------------------------------
*
- * Tcl_ThreadObjCmd --
+ * ThreadObjCmd --
*
- * This procedure is invoked to process the "testthread" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "testthread" Tcl command. See
+ * the user documentation for details on what it does.
*
+ * thread cancel ?-unwind? id ?result?
* thread create ?-joinable? ?script?
- * thread send id ?-async? script
+ * thread send ?-async? id script
+ * thread event
* thread exit
- * thread info id
+ * thread id ?-main?
* thread names
* thread wait
* thread errorproc proc
@@ -197,31 +205,36 @@ TclThread_Init(interp)
*/
/* ARGSUSED */
-int
-Tcl_ThreadObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+ThreadObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
- static CONST char *threadOptions[] = {"create", "exit", "id", "join", "names",
- "send", "wait", "errorproc",
- (char *) NULL};
- enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN,
- THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
+ static const char *const threadOptions[] = {
+ "cancel", "create", "event", "exit", "id",
+ "join", "names", "send", "wait", "errorproc",
+ NULL
+ };
+ enum options {
+ THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
+ THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
+ THREAD_WAIT, THREAD_ERRORPROC
+ };
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions,
- "option", 0, &option) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
+ &option) != TCL_OK) {
return TCL_ERROR;
}
- /*
+ /*
* Make sure the initial thread is on the list before doing anything.
*/
@@ -234,166 +247,241 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
}
switch ((enum options)option) {
- case THREAD_CREATE: {
- char *script;
- int joinable, len;
+ case THREAD_CANCEL: {
+ long id;
+ const char *result;
+ int flags, arg;
+
+ if ((objc < 3) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
+ return TCL_ERROR;
+ }
+ flags = 0;
+ arg = 2;
+ if ((objc == 4) || (objc == 5)) {
+ if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) {
+ flags = TCL_CANCEL_UNWIND;
+ arg++;
+ }
+ }
+ if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arg++;
+ if (arg < objc) {
+ result = Tcl_GetString(objv[arg]);
+ } else {
+ result = NULL;
+ }
+ return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags);
+ }
+ case THREAD_CREATE: {
+ const char *script;
+ int joinable, len;
- if (objc == 2) {
- /* Neither joinable nor special script
- */
+ if (objc == 2) {
+ /*
+ * Neither joinable nor special script
+ */
- joinable = 0;
- script = "testthread wait"; /* Just enter the event loop */
+ joinable = 0;
+ script = "testthread wait"; /* Just enter event loop */
+ } else if (objc == 3) {
+ /*
+ * Possibly -joinable, then no special script, no joinable, then
+ * its a script.
+ */
- } else if (objc == 3) {
- /* Possibly -joinable, then no special script,
- * no joinable, then its a script.
- */
+ script = Tcl_GetStringFromObj(objv[2], &len);
- script = Tcl_GetString(objv[2]);
- len = strlen (script);
-
- if ((len > 1) &&
- (script [0] == '-') && (script [1] == 'j') &&
- (0 == strncmp (script, "-joinable", (size_t) len))) {
- joinable = 1;
- script = "testthread wait"; /* Just enter the event loop
- */
- } else {
- /* Remember the script */
- joinable = 0;
- }
- } else if (objc == 4) {
- /* Definitely a script available, but is the flag
- * -joinable ?
+ if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
+ (0 == strncmp(script, "-joinable", (size_t) len))) {
+ joinable = 1;
+ script = "testthread wait"; /* Just enter event loop */
+ } else {
+ /*
+ * Remember the script
*/
- script = Tcl_GetString(objv[2]);
- len = strlen (script);
-
- joinable = ((len > 1) &&
- (script [0] == '-') && (script [1] == 'j') &&
- (0 == strncmp (script, "-joinable", (size_t) len)));
-
- script = Tcl_GetString(objv[3]);
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
- return TCL_ERROR;
+ joinable = 0;
}
- return TclCreateThread(interp, script, joinable);
+ } else if (objc == 4) {
+ /*
+ * Definitely a script available, but is the flag -joinable?
+ */
+
+ script = Tcl_GetStringFromObj(objv[2], &len);
+ joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
+ && (0 == strncmp(script, "-joinable", (size_t) len)));
+ script = Tcl_GetString(objv[3]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
+ return TCL_ERROR;
}
- case THREAD_EXIT: {
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, NULL);
- return TCL_ERROR;
- }
- ListRemove(NULL);
- Tcl_ExitThread(0);
- return TCL_OK;
+ return ThreadCreate(interp, script, joinable);
+ }
+ case THREAD_EXIT:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
}
- case THREAD_ID:
+ ListRemove(NULL);
+ Tcl_ExitThread(0);
+ return TCL_OK;
+ case THREAD_ID:
+ if (objc == 2 || objc == 3) {
+ Tcl_Obj *idObj;
+
+ /*
+ * Check if they want the main thread id or the current thread id.
+ */
+
if (objc == 2) {
- Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
- Tcl_SetObjResult(interp, idObj);
- return TCL_OK;
+ idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
+ } else if (objc == 3
+ && strcmp("-main", Tcl_GetString(objv[2])) == 0) {
+ Tcl_MutexLock(&threadMutex);
+ idObj = Tcl_NewLongObj((long)(size_t)mainThreadId);
+ Tcl_MutexUnlock(&threadMutex);
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- case THREAD_JOIN: {
- long id;
- int result, status;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "join id");
- return TCL_ERROR;
- }
- if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
- return TCL_ERROR;
- }
+ Tcl_SetObjResult(interp, idObj);
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ case THREAD_JOIN: {
+ Tcl_WideInt id;
+ int result, status;
- result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
- if (result == TCL_OK) {
- Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
- } else {
- char buf [20];
- sprintf (buf, "%ld", id);
- Tcl_AppendResult (interp, "cannot join thread ", buf, NULL);
- }
- return result;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "id");
+ return TCL_ERROR;
}
- case THREAD_NAMES: {
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
- return TclThreadList(interp);
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
}
- case THREAD_SEND: {
- long id;
- char *script;
- int wait, arg;
- if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
- return TCL_ERROR;
- }
- if (objc == 5) {
- if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
- Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
- return TCL_ERROR;
- }
- wait = 0;
- arg = 3;
- } else {
- wait = 1;
- arg = 2;
- }
- if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+ 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, "%" TCL_LL_MODIFIER "d", id);
+ Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
+ }
+ return result;
+ }
+ case THREAD_NAMES:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return ThreadList(interp);
+ case THREAD_SEND: {
+ Tcl_WideInt id;
+ const char *script;
+ int wait, arg;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
- arg++;
- script = Tcl_GetString(objv[arg]);
- return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+ wait = 0;
+ arg = 3;
+ } else {
+ wait = 1;
+ arg = 2;
}
- case THREAD_WAIT: {
- while (1) {
- (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
- }
+ if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arg++;
+ script = Tcl_GetString(objv[arg]);
+ return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
+ }
+ case THREAD_EVENT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
+ return TCL_OK;
+ }
+ case THREAD_ERRORPROC: {
+ /*
+ * Arrange for this proc to handle thread death errors.
+ */
+
+ const char *proc;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "proc");
+ return TCL_ERROR;
+ }
+ Tcl_MutexLock(&threadMutex);
+ errorThreadId = Tcl_GetCurrentThread();
+ if (errorProcString) {
+ ckfree(errorProcString);
}
- case THREAD_ERRORPROC: {
+ proc = Tcl_GetString(objv[2]);
+ errorProcString = ckalloc(strlen(proc) + 1);
+ strcpy(errorProcString, proc);
+ Tcl_MutexUnlock(&threadMutex);
+ return TCL_OK;
+ }
+ case THREAD_WAIT:
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+ while (1) {
/*
- * Arrange for this proc to handle thread death errors.
+ * If the script has been unwound, bail out immediately. This does
+ * not follow the recommended guidelines for how extensions should
+ * handle the script cancellation functionality because this is
+ * not a "normal" extension. Most extensions do not have a command
+ * that simply enters an infinite Tcl event loop. Normal
+ * extensions should not specify the TCL_CANCEL_UNWIND when
+ * calling Tcl_Canceled to check if the command has been canceled.
*/
- char *proc;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc");
- return TCL_ERROR;
- }
- Tcl_MutexLock(&threadMutex);
- errorThreadId = Tcl_GetCurrentThread();
- if (errorProcString) {
- ckfree(errorProcString);
+ if (Tcl_Canceled(interp,
+ TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) {
+ break;
}
- proc = Tcl_GetString(objv[2]);
- errorProcString = ckalloc(strlen(proc)+1);
- strcpy(errorProcString, proc);
- Tcl_MutexUnlock(&threadMutex);
- return TCL_OK;
+ (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
}
+
+ /*
+ * If we get to this point, we have been canceled by another thread,
+ * which is considered to be an "error".
+ */
+
+ ThreadErrorProc(interp);
+ return TCL_OK;
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
- * TclCreateThread --
+ * ThreadCreate --
*
* This procedure is invoked to create a thread containing an interp to
- * run a script. This returns after the thread has started executing.
+ * run a script. This returns after the thread has started executing.
*
* Results:
* A standard Tcl result, which is the thread ID.
@@ -405,11 +493,11 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
*/
/* ARGSUSED */
-int
-TclCreateThread(interp, script, joinable)
- Tcl_Interp *interp; /* Current interpreter. */
- char *script; /* Script to execute */
- int joinable; /* Flag, joinable thread or not */
+static int
+ThreadCreate(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *script, /* Script to execute */
+ int joinable) /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
Tcl_ThreadId id;
@@ -422,10 +510,9 @@ TclCreateThread(interp, script, joinable)
Tcl_MutexLock(&threadMutex);
if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
- TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
+ TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
- Tcl_AppendResult(interp,"can't create a new thread",0);
- ckfree((void*)ctrl.script);
+ Tcl_AppendResult(interp, "can't create a new thread", NULL);
return TCL_ERROR;
}
@@ -436,7 +523,7 @@ TclCreateThread(interp, script, joinable)
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
Tcl_ConditionFinalize(&ctrl.condWait);
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id));
return TCL_OK;
}
@@ -445,51 +532,57 @@ TclCreateThread(interp, script, joinable)
*
* NewTestThread --
*
- * This routine is the "main()" for a new thread whose task is to
- * execute a single TCL script. The argument to this function is
- * a pointer to a structure that contains the text of the TCL script
- * to be executed.
- *
- * Space to hold the script field of the ThreadControl structure passed
- * in as the only argument was obtained from malloc() and must be freed
- * by this function before it exits. Space to hold the ThreadControl
- * structure itself is released by the calling function, and the
- * two condition variables in the ThreadControl structure are destroyed
- * by the calling function. The calling function will destroy the
- * ThreadControl structure and the condition variable as soon as
- * ctrlPtr->condWait is signaled, so this routine must make copies of
- * any data it might need after that point.
+ * This routine is the "main()" for a new thread whose task is to execute
+ * a single Tcl script. The argument to this function is a pointer to a
+ * structure that contains the text of the TCL script to be executed.
+ *
+ * Space to hold the script field of the ThreadControl structure passed
+ * in as the only argument was obtained from malloc() and must be freed
+ * by this function before it exits. Space to hold the ThreadControl
+ * structure itself is released by the calling function, and the two
+ * condition variables in the ThreadControl structure are destroyed by
+ * the calling function. The calling function will destroy the
+ * ThreadControl structure and the condition variable as soon as
+ * ctrlPtr->condWait is signaled, so this routine must make copies of any
+ * data it might need after that point.
*
* Results:
- * none
+ * None
*
* Side effects:
- * A TCL script is executed in a new thread.
+ * A Tcl script is executed in a new thread.
*
*------------------------------------------------------------------------
*/
+
Tcl_ThreadCreateType
-NewTestThread(clientData)
- ClientData clientData;
+NewTestThread(
+ ClientData clientData)
{
- ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
+ ThreadCtrl *ctrlPtr = clientData;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int result;
char *threadEvalScript;
/*
- * Initialize the interpreter. This should be more general.
+ * Initialize the interpreter. This should be more general.
*/
tsdPtr->interp = Tcl_CreateInterp();
result = Tcl_Init(tsdPtr->interp);
- result = TclThread_Init(tsdPtr->interp);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
- /* This is part of the test facility.
- * Initialize _ALL_ test commands for
+ /*
+ * This is part of the test facility. Initialize _ALL_ test commands for
* use by the new thread.
*/
+
result = Tcltest_Init(tsdPtr->interp);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
/*
* Update the list of threads.
@@ -497,14 +590,16 @@ NewTestThread(clientData)
Tcl_MutexLock(&threadMutex);
ListUpdateInner(tsdPtr);
+
/*
- * We need to keep a pointer to the alloc'ed mem of the script
- * we are eval'ing, for the case that we exit during evaluation
+ * We need to keep a pointer to the alloc'ed mem of the script we are
+ * eval'ing, for the case that we exit during evaluation
*/
- threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+
+ threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1);
strcpy(threadEvalScript, ctrlPtr->script);
- Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
+ Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
/*
* Notify the parent we are alive.
@@ -517,7 +612,7 @@ NewTestThread(clientData)
* Run the script.
*/
- Tcl_Preserve((ClientData) tsdPtr->interp);
+ Tcl_Preserve(tsdPtr->interp);
result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
@@ -527,9 +622,9 @@ NewTestThread(clientData)
* Clean up.
*/
- ListRemove(tsdPtr);
- Tcl_Release((ClientData) tsdPtr->interp);
Tcl_DeleteInterp(tsdPtr->interp);
+ Tcl_Release(tsdPtr->interp);
+ ListRemove(tsdPtr);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
@@ -540,25 +635,27 @@ NewTestThread(clientData)
*
* ThreadErrorProc --
*
- * Send a message to the thread willing to hear about errors.
+ * Send a message to the thread willing to hear about errors.
*
* Results:
- * none
+ * None
*
* Side effects:
- * Send an event.
+ * Send an event.
*
*------------------------------------------------------------------------
*/
+
static void
-ThreadErrorProc(interp)
- Tcl_Interp *interp; /* Interp that failed */
+ThreadErrorProc(
+ Tcl_Interp *interp) /* Interp that failed */
{
Tcl_Channel errChannel;
- CONST char *errorInfo, *argv[3];
+ const char *errorInfo, *argv[3];
char *script;
char buf[TCL_DOUBLE_SPACE+1];
- sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
+
+ sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
@@ -573,7 +670,7 @@ ThreadErrorProc(interp)
argv[1] = buf;
argv[2] = errorInfo;
script = Tcl_Merge(3, argv);
- TclThreadSend(interp, errorThreadId, script, 0);
+ ThreadSend(interp, errorThreadId, script, 0);
ckfree(script);
}
}
@@ -584,20 +681,21 @@ ThreadErrorProc(interp)
*
* ListUpdateInner --
*
- * Add the thread local storage to the list. This assumes
- * the caller has obtained the mutex.
+ * Add the thread local storage to the list. This assumes the caller has
+ * obtained the mutex.
*
* Results:
- * none
+ * None
*
* Side effects:
- * Add the thread local storage to its list.
+ * Add the thread local storage to its list.
*
*------------------------------------------------------------------------
*/
+
static void
-ListUpdateInner(tsdPtr)
- ThreadSpecificData *tsdPtr;
+ListUpdateInner(
+ ThreadSpecificData *tsdPtr)
{
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -616,20 +714,21 @@ ListUpdateInner(tsdPtr)
*
* ListRemove --
*
- * Remove the thread local storage from its list. This grabs the
- * mutex to protect the list.
+ * Remove the thread local storage from its list. This grabs the mutex to
+ * protect the list.
*
* Results:
- * none
+ * None
*
* Side effects:
- * Remove the thread local storage from its list.
+ * Remove the thread local storage from its list.
*
*------------------------------------------------------------------------
*/
+
static void
-ListRemove(tsdPtr)
- ThreadSpecificData *tsdPtr;
+ListRemove(
+ ThreadSpecificData *tsdPtr)
{
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -644,14 +743,14 @@ ListRemove(tsdPtr)
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
+ tsdPtr->interp = NULL;
Tcl_MutexUnlock(&threadMutex);
}
-
/*
*------------------------------------------------------------------------
*
- * TclThreadList --
+ * ThreadList --
*
* Return a list of threads running Tcl interpreters.
*
@@ -663,9 +762,9 @@ ListRemove(tsdPtr)
*
*------------------------------------------------------------------------
*/
-int
-TclThreadList(interp)
- Tcl_Interp *interp;
+static int
+ThreadList(
+ Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr;
Tcl_Obj *listPtr;
@@ -674,18 +773,17 @@ TclThreadList(interp)
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewLongObj((long)tsdPtr->threadId));
+ Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
-
/*
*------------------------------------------------------------------------
*
- * TclThreadSend --
+ * ThreadSend --
*
* Send a script to another thread.
*
@@ -697,12 +795,13 @@ TclThreadList(interp)
*
*------------------------------------------------------------------------
*/
-int
-TclThreadSend(interp, id, script, wait)
- Tcl_Interp *interp; /* The current interpreter. */
- Tcl_ThreadId id; /* Thread Id of other interpreter. */
- char *script; /* The script to evaluate. */
- int wait; /* If 1, we block for the result. */
+
+static int
+ThreadSend(
+ Tcl_Interp *interp, /* The current interpreter. */
+ Tcl_ThreadId id, /* Thread Id of other interpreter. */
+ const char *script, /* The script to evaluate. */
+ int wait) /* If 1, we block for the result. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadEvent *threadEventPtr;
@@ -710,7 +809,7 @@ TclThreadSend(interp, id, script, wait)
int found, code;
Tcl_ThreadId threadId = (Tcl_ThreadId) id;
- /*
+ /*
* Verify the thread exists.
*/
@@ -729,26 +828,26 @@ TclThreadSend(interp, id, script, wait)
}
/*
- * Short circut sends to ourself. Ought to do something with -async,
- * like run in an idle handler.
+ * Short circut sends to ourself. Ought to do something with -async, like
+ * run in an idle handler.
*/
if (threadId == Tcl_GetCurrentThread()) {
- Tcl_MutexUnlock(&threadMutex);
+ Tcl_MutexUnlock(&threadMutex);
return Tcl_GlobalEval(interp, script);
}
- /*
+ /*
* 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;
/*
@@ -761,7 +860,7 @@ TclThreadSend(interp, id, script, wait)
resultPtr->errorInfo = NULL;
resultPtr->errorCode = NULL;
- /*
+ /*
* Maintain the cleanup list.
*/
@@ -781,7 +880,7 @@ TclThreadSend(interp, id, script, wait)
*/
threadEventPtr->event.proc = ThreadEventProc;
- Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
+ Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
TCL_QUEUE_TAIL);
Tcl_ThreadAlert(threadId);
@@ -790,13 +889,13 @@ TclThreadSend(interp, id, script, wait)
return TCL_OK;
}
- /*
+ /*
* Block on the results and then get them.
*/
Tcl_ResetResult(interp);
while (resultPtr->result == NULL) {
- Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
+ Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
}
/*
@@ -827,15 +926,71 @@ TclThreadSend(interp, id, script, wait)
ckfree(resultPtr->errorInfo);
}
}
- Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+ Tcl_AppendResult(interp, resultPtr->result, NULL);
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
- ckfree((char *) resultPtr);
+ ckfree(resultPtr->result);
+ ckfree(resultPtr);
return code;
}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadCancel --
+ *
+ * Cancels a script in another thread.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static int
+ThreadCancel(
+ Tcl_Interp *interp, /* The current interpreter. */
+ Tcl_ThreadId id, /* Thread Id of other interpreter. */
+ const char *result, /* The result or NULL for default. */
+ int flags) /* Flags for Tcl_CancelEval. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int found;
+ Tcl_ThreadId threadId = (Tcl_ThreadId) id;
+
+ /*
+ * Verify the thread exists.
+ */
+ Tcl_MutexLock(&threadMutex);
+ found = 0;
+ for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
+ if (tsdPtr->threadId == threadId) {
+ found = 1;
+ break;
+ }
+ }
+ if (!found) {
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_AppendResult(interp, "invalid thread id", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Since Tcl_CancelEval can be safely called from any thread,
+ * we do it now.
+ */
+
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_ResetResult(interp);
+ return Tcl_CancelEval(tsdPtr->interp,
+ (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
+}
/*
*------------------------------------------------------------------------
@@ -852,17 +1007,18 @@ TclThreadSend(interp, id, script, wait)
*
*------------------------------------------------------------------------
*/
+
static int
-ThreadEventProc(evPtr, mask)
- Tcl_Event *evPtr; /* Really ThreadEvent */
- int mask;
+ThreadEventProc(
+ Tcl_Event *evPtr, /* Really ThreadEvent */
+ int mask)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
+ ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr;
ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
- CONST char *result, *errorCode, *errorInfo;
+ const char *result, *errorCode, *errorInfo;
if (interp == NULL) {
code = TCL_ERROR;
@@ -870,13 +1026,11 @@ ThreadEventProc(evPtr, mask)
errorCode = "THREAD";
errorInfo = "";
} else {
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
Tcl_ResetResult(interp);
- Tcl_CreateThreadExitHandler(ThreadFreeProc,
- (ClientData) threadEventPtr->script);
+ Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
code = Tcl_GlobalEval(interp, threadEventPtr->script);
- Tcl_DeleteThreadExitHandler(ThreadFreeProc,
- (ClientData) threadEventPtr->script);
+ Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
if (code != TCL_OK) {
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
@@ -903,7 +1057,7 @@ ThreadEventProc(evPtr, mask)
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
}
return 1;
}
@@ -924,13 +1078,14 @@ ThreadEventProc(evPtr, mask)
*
*------------------------------------------------------------------------
*/
+
/* ARGSUSED */
static void
-ThreadFreeProc(clientData)
- ClientData clientData;
+ThreadFreeProc(
+ ClientData clientData)
{
if (clientData) {
- ckfree((char *) clientData);
+ ckfree(clientData);
}
}
@@ -950,20 +1105,23 @@ ThreadFreeProc(clientData)
*
*------------------------------------------------------------------------
*/
+
/* ARGSUSED */
static int
-ThreadDeleteEvent(eventPtr, clientData)
- Tcl_Event *eventPtr; /* Really ThreadEvent */
- ClientData clientData; /* dummy */
+ThreadDeleteEvent(
+ Tcl_Event *eventPtr, /* Really ThreadEvent */
+ ClientData clientData) /* dummy */
{
if (eventPtr->proc == ThreadEventProc) {
- ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+ ckfree(((ThreadEvent *) eventPtr)->script);
return 1;
}
+
/*
- * If it was NULL, we were in the middle of servicing the event
- * and it should be removed
+ * If it was NULL, we were in the middle of servicing the event and it
+ * should be removed
*/
+
return (eventPtr->proc == NULL);
}
@@ -972,41 +1130,48 @@ ThreadDeleteEvent(eventPtr, clientData)
*
* ThreadExitProc --
*
- * This is called when the thread exits.
+ * This is called when the thread exits.
*
* Results:
* None.
*
* Side effects:
- * It unblocks anyone that is waiting on a send to this thread.
- * It cleans up any events in the event queue for this thread.
+ * It unblocks anyone that is waiting on a send to this thread. It cleans
+ * up any events in the event queue for this thread.
*
*------------------------------------------------------------------------
*/
+
/* ARGSUSED */
static void
-ThreadExitProc(clientData)
- ClientData clientData;
+ThreadExitProc(
+ ClientData clientData)
{
- char *threadEvalScript = (char *) clientData;
+ 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);
if (threadEvalScript) {
- ckfree((char *) threadEvalScript);
+ ckfree(threadEvalScript);
threadEvalScript = NULL;
}
- Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
+ Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
nextPtr = resultPtr->nextPtr;
if (resultPtr->srcThreadId == self) {
/*
- * We are going away. By freeing up the result we signal
- * to the other thread we don't care about the result.
+ * We are going away. By freeing up the result we signal to the
+ * other thread we don't care about the result.
*/
+
if (resultPtr->prevPtr) {
resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
} else {
@@ -1017,16 +1182,17 @@ ThreadExitProc(clientData)
}
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 string must be dynamically allocated because
- * the main thread is going to call free on it.
+ * Dang. The target is going away. Unblock the caller. The result
+ * string must be dynamically allocated because the main thread is
+ * going to call free on it.
*/
- char *msg = "target thread died";
- resultPtr->result = ckalloc(strlen(msg)+1);
+ const char *msg = "target thread died";
+
+ resultPtr->result = ckalloc(strlen(msg) + 1);
strcpy(resultPtr->result, msg);
resultPtr->code = TCL_ERROR;
Tcl_ConditionNotify(&resultPtr->done);
@@ -1034,5 +1200,12 @@ ThreadExitProc(clientData)
}
Tcl_MutexUnlock(&threadMutex);
}
-
#endif /* TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index e441867..c10986a 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.18 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -74,7 +72,7 @@ typedef struct AfterAssocData {
*/
typedef struct IdleHandler {
- Tcl_IdleProc (*proc); /* Function to call. */
+ Tcl_IdleProc *proc; /* Function to call. */
ClientData clientData; /* Value to pass to proc. */
int generation; /* Used to distinguish older handlers from
* recently-created ones. */
@@ -126,28 +124,44 @@ static Tcl_ThreadDataKey dataKey;
(((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
#define TCL_TIME_DIFF_MS(t1, t2) \
- (1000*((long)(t1).sec - (long)(t2).sec) + \
+ (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
+ * cancellation checks.
+ */
+
+#define TCL_TIME_MAXIMUM_SLICE 500
+
/*
* Prototypes for functions referenced only in this file:
*/
-static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-static int AfterDelay _ANSI_ARGS_((Tcl_Interp *interp, int ms));
-static void AfterProc _ANSI_ARGS_((ClientData clientData));
-static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
-static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
- Tcl_Obj *commandPtr));
-static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
-static void TimerExitProc _ANSI_ARGS_((ClientData clientData));
-static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
- int flags));
-static void TimerCheckProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static void TimerSetupProc _ANSI_ARGS_((ClientData clientData,
- int flags));
+static void AfterCleanupProc(ClientData clientData,
+ Tcl_Interp *interp);
+static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
+static void AfterProc(ClientData clientData);
+static void FreeAfterPtr(AfterInfo *afterPtr);
+static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr,
+ Tcl_Obj *commandPtr);
+static ThreadSpecificData *InitTimer(void);
+static void TimerExitProc(ClientData clientData);
+static int TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
+static void TimerCheckProc(ClientData clientData, int flags);
+static void TimerSetupProc(ClientData clientData, int flags);
/*
*----------------------------------------------------------------------
@@ -166,10 +180,9 @@ static void TimerSetupProc _ANSI_ARGS_((ClientData clientData,
*/
static ThreadSpecificData *
-InitTimer()
+InitTimer(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -197,11 +210,10 @@ InitTimer()
*/
static void
-TimerExitProc(clientData)
- ClientData clientData; /* Not used. */
+TimerExitProc(
+ ClientData clientData) /* Not used. */
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
if (tsdPtr != NULL) {
@@ -210,7 +222,7 @@ TimerExitProc(clientData)
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
while (timerHandlerPtr != NULL) {
tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
- ckfree((char *) timerHandlerPtr);
+ ckfree(timerHandlerPtr);
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
}
}
@@ -235,11 +247,11 @@ TimerExitProc(clientData)
*/
Tcl_TimerToken
-Tcl_CreateTimerHandler(milliseconds, proc, clientData)
- int milliseconds; /* How many milliseconds to wait before
+Tcl_CreateTimerHandler(
+ int milliseconds, /* How many milliseconds to wait before
* invoking proc. */
- Tcl_TimerProc *proc; /* Function to invoke. */
- ClientData clientData; /* Arbitrary data to pass to proc. */
+ Tcl_TimerProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
{
Tcl_Time time;
@@ -277,26 +289,25 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
*/
Tcl_TimerToken
-TclCreateAbsoluteTimerHandler(timePtr, proc, clientData)
- Tcl_Time *timePtr;
- Tcl_TimerProc *proc;
- ClientData clientData;
+TclCreateAbsoluteTimerHandler(
+ Tcl_Time *timePtr,
+ Tcl_TimerProc *proc,
+ 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.
*/
- memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
+ memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
timerHandlerPtr->proc = proc;
timerHandlerPtr->clientData = clientData;
tsdPtr->lastTimerId++;
- timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
+ timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
/*
* Add the event to the queue in the correct position
@@ -340,14 +351,17 @@ TclCreateAbsoluteTimerHandler(timePtr, proc, clientData)
*/
void
-Tcl_DeleteTimerHandler(token)
- Tcl_TimerToken token; /* Result previously returned by
+Tcl_DeleteTimerHandler(
+ Tcl_TimerToken token) /* Result previously returned by
* Tcl_DeleteTimerHandler. */
{
register TimerHandler *timerHandlerPtr, *prevPtr;
- ThreadSpecificData *tsdPtr;
+ ThreadSpecificData *tsdPtr = InitTimer();
+
+ if (token == NULL) {
+ return;
+ }
- tsdPtr = InitTimer();
for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
timerHandlerPtr = timerHandlerPtr->nextPtr) {
@@ -359,7 +373,7 @@ Tcl_DeleteTimerHandler(token)
} else {
prevPtr->nextPtr = timerHandlerPtr->nextPtr;
}
- ckfree((char *) timerHandlerPtr);
+ ckfree(timerHandlerPtr);
return;
}
}
@@ -383,9 +397,9 @@ Tcl_DeleteTimerHandler(token)
*/
static void
-TimerSetupProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+TimerSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
Tcl_Time blockTime;
ThreadSpecificData *tsdPtr = InitTimer();
@@ -398,7 +412,6 @@ TimerSetupProc(data, flags)
blockTime.sec = 0;
blockTime.usec = 0;
-
} else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
@@ -442,9 +455,9 @@ TimerSetupProc(data, flags)
*/
static void
-TimerCheckProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+TimerCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
Tcl_Event *timerEvPtr;
Tcl_Time blockTime;
@@ -475,7 +488,7 @@ TimerCheckProc(data, flags)
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);
}
@@ -504,9 +517,9 @@ TimerCheckProc(data, flags)
*/
static int
-TimerHandlerEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to handle,
+TimerHandlerEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
* such as TCL_FILE_EVENTS. */
{
TimerHandler *timerHandlerPtr, **nextPtrPtr;
@@ -567,7 +580,7 @@ TimerHandlerEventProc(evPtr, flags)
* Bail out if the next timer is of a newer generation.
*/
- if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
+ if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
break;
}
@@ -576,9 +589,9 @@ TimerHandlerEventProc(evPtr, flags)
* potential reentrancy problems.
*/
- (*nextPtrPtr) = timerHandlerPtr->nextPtr;
- (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
- ckfree((char *) timerHandlerPtr);
+ *nextPtrPtr = timerHandlerPtr->nextPtr;
+ timerHandlerPtr->proc(timerHandlerPtr->clientData);
+ ckfree(timerHandlerPtr);
}
TimerSetupProc(NULL, TCL_TIMER_EVENTS);
return 1;
@@ -604,15 +617,15 @@ TimerHandlerEventProc(evPtr, flags)
*/
void
-Tcl_DoWhenIdle(proc, clientData)
- Tcl_IdleProc *proc; /* Function to invoke. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_DoWhenIdle(
+ Tcl_IdleProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
register IdleHandler *idlePtr;
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;
@@ -648,9 +661,9 @@ Tcl_DoWhenIdle(proc, clientData)
*/
void
-Tcl_CancelIdleCall(proc, clientData)
- Tcl_IdleProc *proc; /* Function that was previously registered. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_CancelIdleCall(
+ Tcl_IdleProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
register IdleHandler *idlePtr, *prevPtr;
IdleHandler *nextPtr;
@@ -661,7 +674,7 @@ Tcl_CancelIdleCall(proc, clientData)
while ((idlePtr->proc == proc)
&& (idlePtr->clientData == clientData)) {
nextPtr = idlePtr->nextPtr;
- ckfree((char *) idlePtr);
+ ckfree(idlePtr);
idlePtr = nextPtr;
if (prevPtr == NULL) {
tsdPtr->idleList = idlePtr;
@@ -696,7 +709,7 @@ Tcl_CancelIdleCall(proc, clientData)
*/
int
-TclServiceIdle()
+TclServiceIdle(void)
{
IdleHandler *idlePtr;
int oldGeneration;
@@ -735,8 +748,8 @@ TclServiceIdle()
if (tsdPtr->idleList == NULL) {
tsdPtr->lastIdlePtr = NULL;
}
- (*idlePtr->proc)(idlePtr->clientData);
- ckfree((char *) idlePtr);
+ idlePtr->proc(idlePtr->clientData);
+ ckfree(idlePtr);
}
if (tsdPtr->idleList) {
blockTime.sec = 0;
@@ -765,28 +778,26 @@ TclServiceIdle()
/* ARGSUSED */
int
-Tcl_AfterObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Unused */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_AfterObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
- int ms;
+ Tcl_WideInt ms = 0; /* Number of milliseconds to wait */
+ Tcl_Time wakeup;
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
int length;
- char *argString;
int index;
- char buf[16 + TCL_INTEGER_SPACE];
- static CONST char *afterSubCmds[] = {
- "cancel", "idle", "info", (char *) NULL
+ static const char *const afterSubCmds[] = {
+ "cancel", "idle", "info", NULL
};
- Tcl_Obj *objPtr;
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
@@ -797,39 +808,55 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
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,
- (ClientData) assocPtr);
+ Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
}
/*
* First lets see if the command was passed a number as the first argument.
*/
- if (objv[1]->typePtr == &tclIntType) {
- ms = (int) objv[1]->internalRep.longValue;
- goto processInteger;
- }
- argString = Tcl_GetStringFromObj(objv[1], &length);
- if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */
- if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
+ if (objv[1]->typePtr == &tclIntType
+#ifndef TCL_WIDE_INT_IS_LONG
+ || objv[1]->typePtr == &tclWideIntType
+#endif
+ || objv[1]->typePtr == &tclBignumType
+ || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
+ &index) != TCL_OK)) {
+ index = -1;
+ if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+ 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;
}
- processInteger:
+ }
+
+ /*
+ * At this point, either index = -1 and ms contains the number of ms
+ * to wait, or else index is the index of a subcommand.
+ */
+
+ switch (index) {
+ case -1: {
if (ms < 0) {
ms = 0;
}
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];
} else {
- afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
+ afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
}
Tcl_IncrRefCount(afterPtr->commandPtr);
@@ -845,32 +872,23 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr->id = tsdPtr->afterId;
tsdPtr->afterId += 1;
- afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
- (ClientData) afterPtr);
+ Tcl_GetTime(&wakeup);
+ wakeup.sec += (long)(ms / 1000);
+ wakeup.usec += ((long)(ms % 1000)) * 1000;
+ if (wakeup.usec > 1000000) {
+ wakeup.sec++;
+ wakeup.usec -= 1000000;
+ }
+ afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
+ AfterProc, afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
return TCL_OK;
}
-
- /*
- * If it's not a number it must be a subcommand. Note that we're using a
- * custom error message here, so we do not pass an interpreter to T_GIFO.
- */
-
- if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument", 0,
- &index) != TCL_OK) {
- Tcl_AppendResult(interp, "bad argument \"", argString,
- "\": must be cancel, idle, info, or a number",
- (char *) NULL);
- return TCL_ERROR;
- }
- switch ((enum afterSubCmds) index) {
case AFTER_CANCEL: {
Tcl_Obj *commandPtr;
- char *command, *tempCommand;
+ const char *command, *tempCommand;
int tempLength;
if (objc < 3) {
@@ -888,8 +906,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
&tempLength);
if ((length == tempLength)
- && (memcmp((void*) command, (void*) tempCommand,
- (unsigned) length) == 0)) {
+ && !memcmp(command, tempCommand, (unsigned) length)) {
break;
}
}
@@ -903,7 +920,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
if (afterPtr->token != NULL) {
Tcl_DeleteTimerHandler(afterPtr->token);
} else {
- Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+ Tcl_CancelIdleCall(AfterProc, afterPtr);
}
FreeAfterPtr(afterPtr);
}
@@ -911,10 +928,10 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
}
case AFTER_IDLE:
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+ 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];
@@ -927,22 +944,21 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr->token = NULL;
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
- Tcl_SetObjResult(interp, objPtr);
+ 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) {
@@ -951,17 +967,22 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
}
afterPtr = GetAfterEvent(assocPtr, objv[2]);
if (afterPtr == NULL) {
- Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
- "\" doesn't exist", (char *) 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");
}
@@ -978,7 +999,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
*
* Results:
* Standard Tcl result code (with error set if an error occurred due to a
- * time limit being exceeded).
+ * time limit being exceeded or being canceled).
*
* Side effects:
* May adjust the time limit granularity marker.
@@ -987,44 +1008,83 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
*/
static int
-AfterDelay(interp, ms)
- Tcl_Interp *interp;
- int ms;
+AfterDelay(
+ Tcl_Interp *interp,
+ Tcl_WideInt ms)
{
Interp *iPtr = (Interp *) interp;
- if (iPtr->limit.timeEvent != NULL) {
- Tcl_Time endTime, now;
+ Tcl_Time endTime, now;
+ Tcl_WideInt diff;
- Tcl_GetTime(&endTime);
- endTime.sec += ms/1000;
- endTime.usec += (ms%1000)*1000;
- if (endTime.usec >= 1000000) {
- endTime.sec++;
- endTime.usec -= 1000000;
- }
+ Tcl_GetTime(&now);
+ endTime = now;
+ endTime.sec += (long)(ms/1000);
+ endTime.usec += ((int)(ms%1000))*1000;
+ if (endTime.usec >= 1000000) {
+ endTime.sec++;
+ endTime.usec -= 1000000;
+ }
- do {
- Tcl_GetTime(&now);
- if (TCL_TIME_BEFORE(iPtr->limit.time, now)) {
- iPtr->limit.granularityTicker = 0;
- if (Tcl_LimitCheck(interp) != TCL_OK) {
- return TCL_ERROR;
- }
+ do {
+ if (Tcl_AsyncReady()) {
+ if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
+ return TCL_ERROR;
}
- if (TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
- Tcl_Sleep(TCL_TIME_DIFF_MS(endTime, now));
- break;
- } else {
- Tcl_Sleep(TCL_TIME_DIFF_MS(iPtr->limit.time, now));
- if (Tcl_LimitCheck(interp) != TCL_OK) {
+ }
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (iPtr->limit.timeEvent != NULL
+ && TCL_TIME_BEFORE(iPtr->limit.time, now)) {
+ iPtr->limit.granularityTicker = 0;
+ if (Tcl_LimitCheck(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (iPtr->limit.timeEvent == NULL
+ || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
+ diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (diff > LONG_MAX) {
+ diff = LONG_MAX;
+ }
+#endif
+ 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
+ if (diff > LONG_MAX) {
+ diff = LONG_MAX;
+ }
+#endif
+ if (diff > TCL_TIME_MAXIMUM_SLICE) {
+ diff = TCL_TIME_MAXIMUM_SLICE;
+ }
+ if (diff > 0) {
+ Tcl_Sleep((long) diff);
+ }
+ if (Tcl_AsyncReady()) {
+ if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
return TCL_ERROR;
}
}
- } while (TCL_TIME_BEFORE(now, endTime));
- } else {
- Tcl_Sleep(ms);
- }
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tcl_LimitCheck(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_GetTime(&now);
+ } while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
@@ -1048,18 +1108,18 @@ AfterDelay(interp, ms)
*/
static AfterInfo *
-GetAfterEvent(assocPtr, commandPtr)
- AfterAssocData *assocPtr; /* Points to "after"-related information for
+GetAfterEvent(
+ AfterAssocData *assocPtr, /* Points to "after"-related information for
* this interpreter. */
- Tcl_Obj *commandPtr;
+ Tcl_Obj *commandPtr)
{
- char *cmdString; /* Textual identifier for after event, such as
+ const char *cmdString; /* Textual identifier for after event, such as
* "after#6". */
AfterInfo *afterPtr;
int id;
char *end;
- cmdString = Tcl_GetString(commandPtr);
+ cmdString = TclGetString(commandPtr);
if (strncmp(cmdString, "after#", 6) != 0) {
return NULL;
}
@@ -1097,16 +1157,14 @@ GetAfterEvent(assocPtr, commandPtr)
*/
static void
-AfterProc(clientData)
- ClientData clientData; /* Describes command to execute. */
+AfterProc(
+ ClientData clientData) /* Describes command to execute. */
{
- AfterInfo *afterPtr = (AfterInfo *) clientData;
+ AfterInfo *afterPtr = clientData;
AfterAssocData *assocPtr = afterPtr->assocPtr;
AfterInfo *prevPtr;
int result;
Tcl_Interp *interp;
- char *script;
- int numBytes;
/*
* First remove the callback from our list of callbacks; otherwise someone
@@ -1129,21 +1187,20 @@ AfterProc(clientData)
*/
interp = assocPtr->interp;
- Tcl_Preserve((ClientData) interp);
- script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
- result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
+ Tcl_Preserve(interp);
+ result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (\"after\" script)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, result);
}
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
/*
* Free the memory for the callback.
*/
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
/*
@@ -1165,8 +1222,8 @@ AfterProc(clientData)
*/
static void
-FreeAfterPtr(afterPtr)
- AfterInfo *afterPtr; /* Command to be deleted. */
+FreeAfterPtr(
+ AfterInfo *afterPtr) /* Command to be deleted. */
{
AfterInfo *prevPtr;
AfterAssocData *assocPtr = afterPtr->assocPtr;
@@ -1181,7 +1238,7 @@ FreeAfterPtr(afterPtr)
prevPtr->nextPtr = afterPtr->nextPtr;
}
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
/*
@@ -1203,12 +1260,12 @@ FreeAfterPtr(afterPtr)
/* ARGSUSED */
static void
-AfterCleanupProc(clientData, interp)
- ClientData clientData; /* Points to AfterAssocData for the
+AfterCleanupProc(
+ ClientData clientData, /* Points to AfterAssocData for the
* interpreter. */
- Tcl_Interp *interp; /* Interpreter that is being deleted. */
+ Tcl_Interp *interp) /* Interpreter that is being deleted. */
{
- AfterAssocData *assocPtr = (AfterAssocData *) clientData;
+ AfterAssocData *assocPtr = clientData;
AfterInfo *afterPtr;
while (assocPtr->firstAfterPtr != NULL) {
@@ -1217,12 +1274,12 @@ AfterCleanupProc(clientData, interp)
if (afterPtr->token != NULL) {
Tcl_DeleteTimerHandler(afterPtr->token);
} else {
- Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+ Tcl_CancelIdleCall(AfterProc, afterPtr);
}
Tcl_DecrRefCount(afterPtr->commandPtr);
- ckfree((char *) afterPtr);
+ ckfree(afterPtr);
}
- ckfree((char *) assocPtr);
+ ckfree(assocPtr);
}
/*
@@ -1230,5 +1287,7 @@ AfterCleanupProc(clientData, interp)
* 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
new file mode 100644
index 0000000..ea3abb1
--- /dev/null
+++ b/generic/tclTomMath.decls
@@ -0,0 +1,223 @@
+# tclTomMath.decls --
+#
+# This file contains the declarations for the functions in
+# 'libtommath' that are contained within the Tcl library.
+# This file is used to generate the 'tclTomMathDecls.h' and
+# 'tclTomMathStub.c' files.
+#
+# If you edit this file, advance the revision number (and the epoch
+# if the new stubs are not backward compatible) in tclTomMathDecls.h
+#
+# Copyright (c) 2005 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.
+
+library tcl
+
+# Define the unsupported generic interfaces.
+
+interface tclTomMath
+# hooks {tclTomMathInt}
+scspec EXTERN
+
+# Declare each of the functions in the Tcl tommath interface
+
+declare 0 {
+ int TclBN_epoch(void)
+}
+declare 1 {
+ int TclBN_revision(void)
+}
+
+declare 2 {
+ int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 3 {
+ int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 4 {
+ int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 5 {
+ void TclBN_mp_clamp(mp_int *a)
+}
+declare 6 {
+ void TclBN_mp_clear(mp_int *a)
+}
+declare 7 {
+ void TclBN_mp_clear_multi(mp_int *a, ...)
+}
+declare 8 {
+ int TclBN_mp_cmp(const mp_int *a, const mp_int *b)
+}
+declare 9 {
+ int TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
+}
+declare 10 {
+ int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
+}
+declare 11 {
+ int TclBN_mp_copy(const mp_int *a, mp_int *b)
+}
+declare 12 {
+ int TclBN_mp_count_bits(const mp_int *a)
+}
+declare 13 {
+ int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
+}
+declare 14 {
+ int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
+}
+declare 15 {
+ int TclBN_mp_div_2(mp_int *a, mp_int *q)
+}
+declare 16 {
+ int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
+}
+declare 17 {
+ int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
+}
+declare 18 {
+ void TclBN_mp_exch(mp_int *a, mp_int *b)
+}
+declare 19 {
+ int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 20 {
+ int TclBN_mp_grow(mp_int *a, int size)
+}
+declare 21 {
+ int TclBN_mp_init(mp_int *a)
+}
+declare 22 {
+ int TclBN_mp_init_copy(mp_int *a, mp_int *b)
+}
+declare 23 {
+ int TclBN_mp_init_multi(mp_int *a, ...)
+}
+declare 24 {
+ int TclBN_mp_init_set(mp_int *a, mp_digit b)
+}
+declare 25 {
+ int TclBN_mp_init_size(mp_int *a, int size)
+}
+declare 26 {
+ int TclBN_mp_lshd(mp_int *a, int shift)
+}
+declare 27 {
+ int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
+}
+declare 28 {
+ int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
+}
+declare 29 {
+ int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
+}
+declare 30 {
+ int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
+}
+declare 31 {
+ int TclBN_mp_mul_2(mp_int *a, mp_int *p)
+}
+declare 32 {
+ int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
+}
+declare 33 {
+ int TclBN_mp_neg(const mp_int *a, mp_int *b)
+}
+declare 34 {
+ int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 35 {
+ int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
+}
+declare 36 {
+ int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
+}
+declare 37 {
+ void TclBN_mp_rshd(mp_int *a, int shift)
+}
+declare 38 {
+ int TclBN_mp_shrink(mp_int *a)
+}
+declare 39 {
+ void TclBN_mp_set(mp_int *a, mp_digit b)
+}
+declare 40 {
+ int TclBN_mp_sqr(mp_int *a, mp_int *b)
+}
+declare 41 {
+ int TclBN_mp_sqrt(mp_int *a, mp_int *b)
+}
+declare 42 {
+ int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 43 {
+ int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 44 {
+ int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
+}
+declare 45 {
+ int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
+ unsigned long *outlen)
+}
+declare 46 {
+ int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
+}
+declare 47 {
+ int TclBN_mp_unsigned_bin_size(mp_int *a)
+}
+declare 48 {
+ int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 49 {
+ void TclBN_mp_zero(mp_int *a)
+}
+
+# internal routines to libtommath - should not be called but must be
+# exported to accommodate the "tommath" extension
+
+declare 50 {
+ void TclBN_reverse(unsigned char *s, int len)
+}
+declare 51 {
+ int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
+}
+declare 52 {
+ int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
+}
+declare 53 {
+ int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 54 {
+ int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
+}
+declare 55 {
+ int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 56 {
+ int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
+}
+declare 57 {
+ int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 58 {
+ int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
+}
+declare 59 {
+ int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
+}
+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 4ffbea2..dd9edaf 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -1,109 +1,832 @@
-/*
- * tclTomMath.h --
+/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
- * Interface information that comes in at the head of
- * <tommath.h> to adapt the API to Tcl's linkage conventions.
+ * LibTomMath is a library that provides multiple-precision
+ * integer arithmetic as well as number theoretic functionality.
*
- * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
+ * The library was designed directly after the MPI library by
+ * Michael Fromberger but has been written from scratch with
+ * additional optimizations in place.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * The library is free for all purposes without any express
+ * guarantee it works.
*
- * RCS: @(#) $Id: tclTomMath.h,v 1.2 2005/05/10 18:34:51 kennykb Exp $
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
+#ifndef BN_H_
+#define BN_H_
+
+#include "tclTomMathDecls.h"
+#ifndef MODULE_SCOPE
+#define MODULE_SCOPE extern
+#endif
+
+
-#ifndef TCLTOMMATH_H
-#define TCLTOMMATH_H 1
+#ifndef MIN
+# define MIN(x,y) ((x)<(y)?(x):(y))
+#endif
-#include <tcl.h>
-#include <stdlib.h>
+#ifndef MAX
+# define MAX(x,y) ((x)>(y)?(x):(y))
+#endif
+#ifdef __cplusplus
+extern "C" {
-/* Define TOMMATH_DLLIMPORT and TOMMATH_DLLEXPORT to suit the compiler */
+/* C++ compilers don't like assigning void * to mp_digit * */
+#define OPT_CAST(x) (x *)
-#ifdef STATIC_BUILD
-# define TOMMATH_DLLIMPORT
-# define TOMMATH_DLLEXPORT
#else
-# if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
-# define TOMMATH_DLLIMPORT __declspec(dllimport)
-# define TOMMATH_DLLEXPORT __declspec(dllexport)
-# else
-# define TOMMATH_DLLIMPORT
-# define TOMMATH_DLLEXPORT
+
+/* C on the other hand doesn't care */
+#define OPT_CAST(x)
+
+#endif
+
+
+/* detect 64-bit mode if possible */
+#if defined(NEVER) /* 128-bit ints fail in too many places */
+# if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
+# define MP_64BIT
# endif
#endif
-/* Define TOMMATH_STORAGE_CLASS according to the build options. */
+/* some default configurations.
+ *
+ * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
+ * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
+ *
+ * At the very least a mp_digit must be able to hold 7 bits
+ * [any size beyond that is ok provided it doesn't overflow the data type]
+ */
+#ifdef MP_8BIT
+#ifndef MP_DIGIT_DECLARED
+ typedef unsigned char mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+ typedef unsigned short mp_word;
+#elif defined(MP_16BIT)
+#ifndef MP_DIGIT_DECLARED
+ typedef unsigned short mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+ typedef unsigned long mp_word;
+#elif defined(MP_64BIT)
+ /* for GCC only on supported platforms */
+#ifndef CRYPT
+ typedef unsigned long long ulong64;
+ typedef signed long long long64;
+#endif
-#undef TOMMATH_STORAGE_CLASS
-#ifdef BUILD_tcl
-# define TOMMATH_STORAGE_CLASS TOMMATH_DLLEXPORT
+#ifndef MP_DIGIT_DECLARED
+ typedef unsigned long mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+ typedef unsigned long mp_word __attribute__ ((mode(TI)));
+
+# define DIGIT_BIT 60
#else
-# ifdef USE_TCL_STUBS
-# define TOMMATH_STORAGE_CLASS
-# else
-# define TOMMATH_STORAGE_CLASS TOMMATH_DLLIMPORT
-# endif
+ /* this is the default case, 28-bit digits */
+
+ /* this is to make porting into LibTomCrypt easier :-) */
+#ifndef CRYPT
+# if defined(_MSC_VER) || defined(__BORLANDC__)
+ typedef unsigned __int64 ulong64;
+ typedef signed __int64 long64;
+# else
+ typedef unsigned long long ulong64;
+ typedef signed long long long64;
+# endif
+#endif
+
+#ifndef MP_DIGIT_DECLARED
+ typedef unsigned int mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+ typedef ulong64 mp_word;
+
+#ifdef MP_31BIT
+ /* this is an extension that uses 31-bit digits */
+# define DIGIT_BIT 31
+#else
+ /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
+# define DIGIT_BIT 28
+# define MP_28BIT
+#endif
+#endif
+
+/* define heap macros */
+#if 0 /* these are macros in tclTomMathDecls.h */
+#ifndef CRYPT
+ /* default to libc stuff */
+# ifndef XMALLOC
+# define XMALLOC malloc
+# define XFREE free
+# define XREALLOC realloc
+# define XCALLOC calloc
+# else
+ /* prototypes for our heap functions */
+ extern void *XMALLOC(size_t n);
+ extern void *XREALLOC(void *p, size_t n);
+ extern void *XCALLOC(size_t n, size_t s);
+ extern void XFREE(void *p);
+# endif
#endif
+#endif
+
+
+/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
+#ifndef DIGIT_BIT
+# define DIGIT_BIT ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
+#endif
+
+#define MP_DIGIT_BIT DIGIT_BIT
+#define MP_MASK ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
+#define MP_DIGIT_MAX MP_MASK
+
+/* equalities */
+#define MP_LT -1 /* less than */
+#define MP_EQ 0 /* equal to */
+#define MP_GT 1 /* greater than */
+
+#define MP_ZPOS 0 /* positive integer */
+#define MP_NEG 1 /* negative */
+
+#define MP_OKAY 0 /* ok result */
+#define MP_MEM -2 /* out of mem */
+#define MP_VAL -3 /* invalid input */
+#define MP_RANGE MP_VAL
+
+#define MP_YES 1 /* yes response */
+#define MP_NO 0 /* no response */
+
+/* Primality generation flags */
+#define LTM_PRIME_BBS 0x0001 /* BBS style prime */
+#define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */
+#define LTM_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */
+
+typedef int mp_err;
+
+/* you'll have to tune these... */
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
+ KARATSUBA_SQR_CUTOFF,
+ TOOM_MUL_CUTOFF,
+ TOOM_SQR_CUTOFF;
+#endif
+
+/* define this to use lower memory usage routines (exptmods mostly) */
+/* #define MP_LOW_MEM */
+
+/* default precision */
+#ifndef MP_PREC
+# ifndef MP_LOW_MEM
+# define MP_PREC 32 /* default digits of precision */
+# else
+# define MP_PREC 8 /* default digits of precision */
+# endif
+#endif
+
+/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
+#define MP_WARRAY (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
+
+/* the infamous mp_int structure */
+#ifndef MP_INT_DECLARED
+#define MP_INT_DECLARED
+typedef struct mp_int mp_int;
+#endif
+struct mp_int {
+ int used, alloc, sign;
+ mp_digit *dp;
+};
+
+/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
+typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
+
+
+#define USED(m) ((m)->used)
+#define DIGIT(m,k) ((m)->dp[(k)])
+#define SIGN(m) ((m)->sign)
+
+/* error code to char* string */
+/*
+char *mp_error_to_string(int code);
+*/
+
+/* ---> init and deinit bignum functions <--- */
+/* init a bignum */
+/*
+int mp_init(mp_int *a);
+*/
+
+/* free a bignum */
+/*
+void mp_clear(mp_int *a);
+*/
+
+/* init a null terminated series of arguments */
+/*
+int mp_init_multi(mp_int *mp, ...);
+*/
+
+/* clear a null terminated series of arguments */
+/*
+void mp_clear_multi(mp_int *mp, ...);
+*/
+
+/* exchange two ints */
+/*
+void mp_exch(mp_int *a, mp_int *b);
+*/
+
+/* shrink ram required for a bignum */
+/*
+int mp_shrink(mp_int *a);
+*/
+
+/* grow an int to a given size */
+/*
+int mp_grow(mp_int *a, int size);
+*/
+
+/* init to a given number of digits */
+/*
+int mp_init_size(mp_int *a, int size);
+*/
+
+/* ---> Basic Manipulations <--- */
+#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
+#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
+#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
+
+/* set to zero */
+/*
+void mp_zero(mp_int *a);
+*/
+
+/* set to a digit */
+/*
+void mp_set(mp_int *a, mp_digit b);
+*/
+
+/* set a 32-bit const */
+/*
+int mp_set_int(mp_int *a, unsigned long b);
+*/
+
+/* get a 32-bit value */
+unsigned long mp_get_int(mp_int * a);
+
+/* initialize and set a digit */
+/*
+int mp_init_set (mp_int * a, mp_digit b);
+*/
+
+/* initialize and set 32-bit value */
+/*
+int mp_init_set_int (mp_int * a, unsigned long b);
+*/
+
+/* copy, b = a */
+/*
+int mp_copy(const mp_int *a, mp_int *b);
+*/
+
+/* inits and copies, a = b */
+/*
+int mp_init_copy(mp_int *a, mp_int *b);
+*/
+
+/* trim unused digits */
+/*
+void mp_clamp(mp_int *a);
+*/
+
+/* ---> digit manipulation <--- */
+
+/* right shift by "b" digits */
+/*
+void mp_rshd(mp_int *a, int b);
+*/
+
+/* left shift by "b" digits */
+/*
+int mp_lshd(mp_int *a, int b);
+*/
+
+/* c = a / 2**b */
+/*
+int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
+*/
+
+/* b = a/2 */
+/*
+int mp_div_2(mp_int *a, mp_int *b);
+*/
+
+/* c = a * 2**b */
+/*
+int mp_mul_2d(const mp_int *a, int b, mp_int *c);
+*/
+
+/* b = a*2 */
+/*
+int mp_mul_2(mp_int *a, mp_int *b);
+*/
+
+/* c = a mod 2**d */
+/*
+int mp_mod_2d(const mp_int *a, int b, mp_int *c);
+*/
+
+/* computes a = 2**b */
+/*
+int mp_2expt(mp_int *a, int b);
+*/
+
+/* Counts the number of lsbs which are zero before the first zero bit */
+/*
+int mp_cnt_lsb(mp_int *a);
+*/
+
+/* I Love Earth! */
+
+/* makes a pseudo-random int of a given size */
+/*
+int mp_rand(mp_int *a, int digits);
+*/
+
+/* ---> binary operations <--- */
+/* c = a XOR b */
+/*
+int mp_xor(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a OR b */
+/*
+int mp_or(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a AND b */
+/*
+int mp_and(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* ---> Basic arithmetic <--- */
+
+/* b = -a */
+/*
+int mp_neg(const mp_int *a, mp_int *b);
+*/
+
+/* b = |a| */
+/*
+int mp_abs(mp_int *a, mp_int *b);
+*/
+
+/* compare a to b */
+/*
+int mp_cmp(const mp_int *a, const mp_int *b);
+*/
+
+/* compare |a| to |b| */
+/*
+int mp_cmp_mag(const mp_int *a, const mp_int *b);
+*/
+
+/* c = a + b */
+/*
+int mp_add(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a - b */
+/*
+int mp_sub(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a * b */
+/*
+int mp_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* b = a*a */
+/*
+int mp_sqr(mp_int *a, mp_int *b);
+*/
+
+/* a/b => cb + d == a */
+/*
+int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* c = a mod b, 0 <= c < b */
+/*
+int mp_mod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* ---> single digit functions <--- */
+
+/* compare against a single digit */
+/*
+int mp_cmp_d(const mp_int *a, mp_digit b);
+*/
+
+/* c = a + b */
+/*
+int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a - b */
+/*
+int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a * b */
+/*
+int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* a/b => cb + d == a */
+/*
+int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
+*/
-/* Define custom memory allocation for libtommath */
-
-#define XMALLOC(x) TclBNAlloc(x)
-#define XFREE(x) TclBNFree(x)
-#define XREALLOC(x,n) TclBNRealloc(x,n)
-#define XCALLOC(n,x) TclBNCalloc(n,x)
-void* TclBNAlloc( size_t );
-void* TclBNRealloc( void*, size_t );
-void TclBNFree( void* );
-void* TclBNCalloc( size_t, size_t );
-
-/* Rename all global symboles in libtommath to avoid linkage conflicts */
-
-#define KARATSUBA_MUL_CUTOFF TclBNKaratsubaMulCutoff
-#define KARATSUBA_SQR_CUTOFF TclBNKaratsubaSqrCutoff
-#define TOOM_MUL_CUTOFF TclBNToomMulCutoff
-#define TOOM_SQR_CUTOFF TclBNToomSqrCutoff
-
-#define mp_s_rmap TclBNMpSRmap
-
-#define bn_reverse TclBN_reverse
-#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
-#define mp_add TclBN_mp_add
-#define mp_clamp TclBN_mp_clamp
-#define mp_clear TclBN_mp_clear
-#define mp_clear_multi TclBN_mp_clear_multi
-#define mp_cmp TclBN_mp_cmp
-#define mp_cmp_mag TclBN_mp_cmp_mag
-#define mp_copy TclBN_mp_copy
-#define mp_count_bits TclBN_mp_count_bits
-#define mp_div TclBN_mp_div
-#define mp_div_d TclBN_mp_div_d
-#define mp_div_2 TclBN_mp_div_2
-#define mp_div_2d TclBN_mp_div_2d
-#define mp_div_3 TclBN_mp_div_3
-#define mp_exch TclBN_mp_exch
-#define mp_grow TclBN_mp_grow
-#define mp_init TclBN_mp_init
-#define mp_init_copy TclBN_mp_init_copy
-#define mp_init_multi TclBN_mp_init_multi
-#define mp_init_size TclBN_mp_init_size
-#define mp_karatsuba_mul TclBN_mp_karatsuba_mul
-#define mp_lshd TclBN_mp_lshd
-#define mp_mod_2d TclBN_mp_mod_2d
-#define mp_mul TclBN_mp_mul
-#define mp_mul_2 TclBN_mp_mul_2
-#define mp_mul_2d TclBN_mp_mul_2d
-#define mp_mul_d TclBN_mp_mul_d
-#define mp_radix_size TclBN_mp_radix_size
-#define mp_read_radix TclBN_mp_read_radix
-#define mp_rshd TclBN_mp_rshd
-#define mp_sub TclBN_mp_sub
-#define mp_toom_mul TclBN_mp_toom_mul
-#define mp_toradix_n TclBN_mp_toradix_n
-#define mp_zero TclBN_mp_zero
-#define s_mp_add TclBN_s_mp_add
-#define s_mp_mul_digs TclBN_s_mp_mul_digs
-#define s_mp_sub TclBN_s_mp_sub
+/* a/3 => 3c + d == a */
+/*
+int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
+*/
+
+/* c = a**b */
+/*
+int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a mod b, 0 <= c < b */
+/*
+int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
+*/
+
+/* ---> number theory <--- */
+
+/* d = a + b (mod c) */
+/*
+int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* d = a - b (mod c) */
+/*
+int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* d = a * b (mod c) */
+/*
+int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* c = a * a (mod b) */
+/*
+int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = 1/a (mod b) */
+/*
+int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = (a, b) */
+/*
+int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* produces value such that U1*a + U2*b = U3 */
+/*
+int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
+*/
+
+/* c = [a, b] or (a*b)/(a, b) */
+/*
+int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* finds one of the b'th root of a, such that |c|**b <= |a|
+ *
+ * returns error if a < 0 and b is even
+ */
+/*
+int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* special sqrt algo */
+/*
+int mp_sqrt(mp_int *arg, mp_int *ret);
+*/
+
+/* is number a square? */
+/*
+int mp_is_square(mp_int *arg, int *ret);
+*/
+
+/* computes the jacobi c = (a | n) (or Legendre if b is prime) */
+/*
+int mp_jacobi(mp_int *a, mp_int *n, int *c);
+*/
+
+/* used to setup the Barrett reduction for a given modulus b */
+/*
+int mp_reduce_setup(mp_int *a, mp_int *b);
+*/
+
+/* Barrett Reduction, computes a (mod b) with a precomputed value c
+ *
+ * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
+ * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
+ */
+/*
+int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* setups the montgomery reduction */
+/*
+int mp_montgomery_setup(mp_int *a, mp_digit *mp);
+*/
+
+/* computes a = B**n mod b without division or multiplication useful for
+ * normalizing numbers in a Montgomery system.
+ */
+/*
+int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
+*/
+
+/* computes x/R == x (mod N) via Montgomery Reduction */
+/*
+int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
+*/
+
+/* returns 1 if a is a valid DR modulus */
+/*
+int mp_dr_is_modulus(mp_int *a);
+*/
+
+/* sets the value of "d" required for mp_dr_reduce */
+/*
+void mp_dr_setup(mp_int *a, mp_digit *d);
+*/
+
+/* reduces a modulo b using the Diminished Radix method */
+/*
+int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
+*/
+
+/* returns true if a can be reduced with mp_reduce_2k */
+/*
+int mp_reduce_is_2k(mp_int *a);
+*/
+
+/* determines k value for 2k reduction */
+/*
+int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
+*/
+
+/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
+/*
+int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
+*/
+
+/* returns true if a can be reduced with mp_reduce_2k_l */
+/*
+int mp_reduce_is_2k_l(mp_int *a);
+*/
+
+/* determines k value for 2k reduction */
+/*
+int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
+*/
+
+/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
+/*
+int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
+*/
+
+/* d = a**b (mod c) */
+/*
+int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* ---> Primes <--- */
+
+/* number of primes */
+#ifdef MP_8BIT
+# define PRIME_SIZE 31
+#else
+# define PRIME_SIZE 256
+#endif
+
+/* table of first PRIME_SIZE primes */
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE const mp_digit ltm_prime_tab[];
+#endif
+
+/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
+/*
+int mp_prime_is_divisible(mp_int *a, int *result);
+*/
+
+/* performs one Fermat test of "a" using base "b".
+ * Sets result to 0 if composite or 1 if probable prime
+ */
+/*
+int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
+*/
+
+/* performs one Miller-Rabin test of "a" using base "b".
+ * Sets result to 0 if composite or 1 if probable prime
+ */
+/*
+int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
+*/
+
+/* This gives [for a given bit size] the number of trials required
+ * such that Miller-Rabin gives a prob of failure lower than 2^-96
+ */
+/*
+int mp_prime_rabin_miller_trials(int size);
+*/
+
+/* performs t rounds of Miller-Rabin on "a" using the first
+ * t prime bases. Also performs an initial sieve of trial
+ * division. Determines if "a" is prime with probability
+ * of error no more than (1/4)**t.
+ *
+ * Sets result to 1 if probably prime, 0 otherwise
+ */
+/*
+int mp_prime_is_prime(mp_int *a, int t, int *result);
+*/
+
+/* finds the next prime after the number "a" using "t" trials
+ * of Miller-Rabin.
+ *
+ * bbs_style = 1 means the prime must be congruent to 3 mod 4
+ */
+/*
+int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
+*/
+
+/* makes a truly random prime of a given size (bytes),
+ * call with bbs = 1 if you want it to be congruent to 3 mod 4
+ *
+ * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
+ * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
+ * so it can be NULL
+ *
+ * The prime generated will be larger than 2^(8*size).
+ */
+#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)
+
+/* makes a truly random prime of a given size (bits),
+ *
+ * Flags are as follows:
+ *
+ * LTM_PRIME_BBS - make prime congruent to 3 mod 4
+ * LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
+ * LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
+ * LTM_PRIME_2MSB_ON - make the 2nd highest bit one
+ *
+ * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
+ * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
+ * so it can be NULL
+ *
+ */
+/*
+int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
+*/
+
+/* ---> radix conversion <--- */
+/*
+int mp_count_bits(const mp_int *a);
+*/
+
+/*
+int mp_unsigned_bin_size(mp_int *a);
+*/
+/*
+int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
+*/
+/*
+int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
+*/
+/*
+int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
+*/
+
+/*
+int mp_signed_bin_size(mp_int *a);
+*/
+/*
+int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
+*/
+/*
+int mp_to_signed_bin(mp_int *a, unsigned char *b);
+*/
+/*
+int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
+*/
+
+/*
+int mp_read_radix(mp_int *a, const char *str, int radix);
+*/
+/*
+int mp_toradix(mp_int *a, char *str, int radix);
+*/
+/*
+int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
+*/
+/*
+int mp_radix_size(mp_int *a, int radix, int *size);
+*/
+
+/*
+int mp_fread(mp_int *a, int radix, FILE *stream);
+*/
+/*
+int mp_fwrite(mp_int *a, int radix, FILE *stream);
+*/
+
+#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
+#define mp_raw_size(mp) mp_signed_bin_size(mp)
+#define mp_toraw(mp, str) mp_to_signed_bin((mp), (str))
+#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
+#define mp_mag_size(mp) mp_unsigned_bin_size(mp)
+#define mp_tomag(mp, str) mp_to_unsigned_bin((mp), (str))
+
+#define mp_tobinary(M, S) mp_toradix((M), (S), 2)
+#define mp_tooctal(M, S) mp_toradix((M), (S), 8)
+#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
+#define mp_tohex(M, S) mp_toradix((M), (S), 16)
+
+/* lowlevel functions, do not call! */
+/*
+int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+*/
+#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
+/*
+int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int fast_s_mp_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int s_mp_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_karatsuba_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int mp_toom_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
+*/
+/*
+int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
+*/
+/*
+int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
+*/
+/*
+int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
+*/
+/*
+void bn_reverse(unsigned char *s, int len);
+*/
+
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE const char *mp_s_rmap;
+#endif
+
+#ifdef __cplusplus
+}
+#endif
#endif
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
new file mode 100644
index 0000000..69b095c
--- /dev/null
+++ b/generic/tclTomMathDecls.h
@@ -0,0 +1,501 @@
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclTomMathDecls.h --
+ *
+ * This file contains the declarations for the 'libtommath'
+ * functions that are exported by the Tcl library.
+ *
+ * Copyright (c) 2005 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.
+ */
+
+#ifndef _TCLTOMMATHDECLS
+#define _TCLTOMMATHDECLS
+
+#include "tcl.h"
+
+/*
+ * Define the version of the Stubs table that's exported for tommath
+ */
+
+#define TCLTOMMATH_EPOCH 0
+#define TCLTOMMATH_REVISION 0
+
+#define Tcl_TomMath_InitStubs(interp,version) \
+ (TclTomMathInitializeStubs((interp),(version),\
+ TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))
+
+/* Define custom memory allocation for libtommath */
+
+/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
+#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
+/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
+#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
+/* MODULE_SCOPE void TclBNFree( void* ); */
+#define TclBNFree(x) (ckfree((char*)(x)))
+/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
+/* unused - no macro */
+
+#define XMALLOC(x) TclBNAlloc(x)
+#define XFREE(x) TclBNFree(x)
+#define XREALLOC(x,n) TclBNRealloc(x,n)
+#define XCALLOC(n,x) TclBNCalloc(n,x)
+
+/* Rename the global symbols in libtommath to avoid linkage conflicts */
+
+#define KARATSUBA_MUL_CUTOFF TclBNKaratsubaMulCutoff
+#define KARATSUBA_SQR_CUTOFF TclBNKaratsubaSqrCutoff
+#define TOOM_MUL_CUTOFF TclBNToomMulCutoff
+#define TOOM_SQR_CUTOFF TclBNToomSqrCutoff
+
+#define bn_reverse TclBN_reverse
+#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
+#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
+#define mp_add TclBN_mp_add
+#define mp_add_d TclBN_mp_add_d
+#define mp_and TclBN_mp_and
+#define mp_clamp TclBN_mp_clamp
+#define mp_clear TclBN_mp_clear
+#define mp_clear_multi TclBN_mp_clear_multi
+#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
+#define mp_div_2 TclBN_mp_div_2
+#define mp_div_2d TclBN_mp_div_2d
+#define mp_div_3 TclBN_mp_div_3
+#define mp_div_d TclBN_mp_div_d
+#define mp_exch TclBN_mp_exch
+#define mp_expt_d TclBN_mp_expt_d
+#define mp_grow TclBN_mp_grow
+#define mp_init TclBN_mp_init
+#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
+#define mp_lshd TclBN_mp_lshd
+#define mp_mod TclBN_mp_mod
+#define mp_mod_2d TclBN_mp_mod_2d
+#define mp_mul TclBN_mp_mul
+#define mp_mul_2 TclBN_mp_mul_2
+#define mp_mul_2d TclBN_mp_mul_2d
+#define mp_mul_d TclBN_mp_mul_d
+#define mp_neg TclBN_mp_neg
+#define mp_or TclBN_mp_or
+#define mp_radix_size TclBN_mp_radix_size
+#define mp_read_radix TclBN_mp_read_radix
+#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
+#define mp_sub TclBN_mp_sub
+#define mp_sub_d TclBN_mp_sub_d
+#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
+#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
+#define mp_toom_mul TclBN_mp_toom_mul
+#define mp_toom_sqr TclBN_mp_toom_sqr
+#define mp_toradix_n TclBN_mp_toradix_n
+#define mp_unsigned_bin_size TclBN_mp_unsigned_bin_size
+#define mp_xor TclBN_mp_xor
+#define mp_zero TclBN_mp_zero
+#define s_mp_add TclBN_s_mp_add
+#define s_mp_mul_digs TclBN_s_mp_mul_digs
+#define s_mp_sqr TclBN_s_mp_sqr
+#define s_mp_sub TclBN_s_mp_sub
+
+#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/tclInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN int TclBN_epoch(void);
+/* 1 */
+EXTERN int TclBN_revision(void);
+/* 2 */
+EXTERN int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
+/* 3 */
+EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
+/* 4 */
+EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
+/* 5 */
+EXTERN void TclBN_mp_clamp(mp_int *a);
+/* 6 */
+EXTERN void TclBN_mp_clear(mp_int *a);
+/* 7 */
+EXTERN void TclBN_mp_clear_multi(mp_int *a, ...);
+/* 8 */
+EXTERN int TclBN_mp_cmp(const mp_int *a, const mp_int *b);
+/* 9 */
+EXTERN int TclBN_mp_cmp_d(const mp_int *a, mp_digit b);
+/* 10 */
+EXTERN int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b);
+/* 11 */
+EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b);
+/* 12 */
+EXTERN int TclBN_mp_count_bits(const mp_int *a);
+/* 13 */
+EXTERN int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
+ mp_int *r);
+/* 14 */
+EXTERN int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
+ mp_digit *r);
+/* 15 */
+EXTERN int TclBN_mp_div_2(mp_int *a, mp_int *q);
+/* 16 */
+EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
+ mp_int *r);
+/* 17 */
+EXTERN int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
+/* 18 */
+EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b);
+/* 19 */
+EXTERN int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
+/* 20 */
+EXTERN int TclBN_mp_grow(mp_int *a, int size);
+/* 21 */
+EXTERN int TclBN_mp_init(mp_int *a);
+/* 22 */
+EXTERN int TclBN_mp_init_copy(mp_int *a, mp_int *b);
+/* 23 */
+EXTERN int TclBN_mp_init_multi(mp_int *a, ...);
+/* 24 */
+EXTERN int TclBN_mp_init_set(mp_int *a, mp_digit b);
+/* 25 */
+EXTERN int TclBN_mp_init_size(mp_int *a, int size);
+/* 26 */
+EXTERN int TclBN_mp_lshd(mp_int *a, int shift);
+/* 27 */
+EXTERN int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
+/* 28 */
+EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r);
+/* 29 */
+EXTERN int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
+/* 30 */
+EXTERN int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
+/* 31 */
+EXTERN int TclBN_mp_mul_2(mp_int *a, mp_int *p);
+/* 32 */
+EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
+/* 33 */
+EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b);
+/* 34 */
+EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
+/* 35 */
+EXTERN int TclBN_mp_radix_size(mp_int *a, int radix, int *size);
+/* 36 */
+EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str,
+ int radix);
+/* 37 */
+EXTERN void TclBN_mp_rshd(mp_int *a, int shift);
+/* 38 */
+EXTERN int TclBN_mp_shrink(mp_int *a);
+/* 39 */
+EXTERN void TclBN_mp_set(mp_int *a, mp_digit b);
+/* 40 */
+EXTERN int TclBN_mp_sqr(mp_int *a, mp_int *b);
+/* 41 */
+EXTERN int TclBN_mp_sqrt(mp_int *a, mp_int *b);
+/* 42 */
+EXTERN int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+/* 43 */
+EXTERN int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
+/* 44 */
+EXTERN int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
+/* 45 */
+EXTERN int TclBN_mp_to_unsigned_bin_n(mp_int *a,
+ unsigned char *b, unsigned long *outlen);
+/* 46 */
+EXTERN int TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
+ int maxlen);
+/* 47 */
+EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a);
+/* 48 */
+EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
+/* 49 */
+EXTERN void TclBN_mp_zero(mp_int *a);
+/* 50 */
+EXTERN void TclBN_reverse(unsigned char *s, int len);
+/* 51 */
+EXTERN int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
+ mp_int *c, int digs);
+/* 52 */
+EXTERN int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
+/* 53 */
+EXTERN int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
+ mp_int *c);
+/* 54 */
+EXTERN int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
+/* 55 */
+EXTERN int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
+/* 56 */
+EXTERN int TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
+/* 57 */
+EXTERN int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
+/* 58 */
+EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
+ int digs);
+/* 59 */
+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;
+ void *hooks;
+
+ int (*tclBN_epoch) (void); /* 0 */
+ int (*tclBN_revision) (void); /* 1 */
+ int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
+ int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
+ int (*tclBN_mp_and) (mp_int *a, mp_int *b, mp_int *c); /* 4 */
+ void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
+ void (*tclBN_mp_clear) (mp_int *a); /* 6 */
+ void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
+ int (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b); /* 8 */
+ int (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b); /* 9 */
+ int (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */
+ int (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */
+ int (*tclBN_mp_count_bits) (const mp_int *a); /* 12 */
+ int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
+ int (*tclBN_mp_div_d) (mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
+ int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
+ int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
+ int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
+ void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
+ int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
+ int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
+ int (*tclBN_mp_init) (mp_int *a); /* 21 */
+ int (*tclBN_mp_init_copy) (mp_int *a, mp_int *b); /* 22 */
+ int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
+ int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
+ int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
+ int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
+ int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
+ int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */
+ int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
+ int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
+ int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
+ int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */
+ int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */
+ int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
+ int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
+ int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
+ void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
+ int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
+ void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
+ int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
+ int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
+ int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
+ int (*tclBN_mp_sub_d) (mp_int *a, mp_digit b, mp_int *c); /* 43 */
+ int (*tclBN_mp_to_unsigned_bin) (mp_int *a, unsigned char *b); /* 44 */
+ int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
+ int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
+ int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
+ int (*tclBN_mp_xor) (mp_int *a, mp_int *b, mp_int *c); /* 48 */
+ void (*tclBN_mp_zero) (mp_int *a); /* 49 */
+ void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
+ int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
+ int (*tclBN_fast_s_mp_sqr) (mp_int *a, mp_int *b); /* 52 */
+ int (*tclBN_mp_karatsuba_mul) (mp_int *a, mp_int *b, mp_int *c); /* 53 */
+ int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
+ int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
+ int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
+ int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
+ 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;
+
+extern const TclTomMathStubs *tclTomMathStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define TclBN_epoch \
+ (tclTomMathStubsPtr->tclBN_epoch) /* 0 */
+#define TclBN_revision \
+ (tclTomMathStubsPtr->tclBN_revision) /* 1 */
+#define TclBN_mp_add \
+ (tclTomMathStubsPtr->tclBN_mp_add) /* 2 */
+#define TclBN_mp_add_d \
+ (tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */
+#define TclBN_mp_and \
+ (tclTomMathStubsPtr->tclBN_mp_and) /* 4 */
+#define TclBN_mp_clamp \
+ (tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */
+#define TclBN_mp_clear \
+ (tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */
+#define TclBN_mp_clear_multi \
+ (tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */
+#define TclBN_mp_cmp \
+ (tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */
+#define TclBN_mp_cmp_d \
+ (tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */
+#define TclBN_mp_cmp_mag \
+ (tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */
+#define TclBN_mp_copy \
+ (tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */
+#define TclBN_mp_count_bits \
+ (tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */
+#define TclBN_mp_div \
+ (tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
+#define TclBN_mp_div_d \
+ (tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
+#define TclBN_mp_div_2 \
+ (tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
+#define TclBN_mp_div_2d \
+ (tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
+#define TclBN_mp_div_3 \
+ (tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
+#define TclBN_mp_exch \
+ (tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
+#define TclBN_mp_expt_d \
+ (tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */
+#define TclBN_mp_grow \
+ (tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
+#define TclBN_mp_init \
+ (tclTomMathStubsPtr->tclBN_mp_init) /* 21 */
+#define TclBN_mp_init_copy \
+ (tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */
+#define TclBN_mp_init_multi \
+ (tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */
+#define TclBN_mp_init_set \
+ (tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */
+#define TclBN_mp_init_size \
+ (tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */
+#define TclBN_mp_lshd \
+ (tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */
+#define TclBN_mp_mod \
+ (tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */
+#define TclBN_mp_mod_2d \
+ (tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */
+#define TclBN_mp_mul \
+ (tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */
+#define TclBN_mp_mul_d \
+ (tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */
+#define TclBN_mp_mul_2 \
+ (tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */
+#define TclBN_mp_mul_2d \
+ (tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */
+#define TclBN_mp_neg \
+ (tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */
+#define TclBN_mp_or \
+ (tclTomMathStubsPtr->tclBN_mp_or) /* 34 */
+#define TclBN_mp_radix_size \
+ (tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
+#define TclBN_mp_read_radix \
+ (tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
+#define TclBN_mp_rshd \
+ (tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
+#define TclBN_mp_shrink \
+ (tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
+#define TclBN_mp_set \
+ (tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
+#define TclBN_mp_sqr \
+ (tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
+#define TclBN_mp_sqrt \
+ (tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
+#define TclBN_mp_sub \
+ (tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
+#define TclBN_mp_sub_d \
+ (tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
+#define TclBN_mp_to_unsigned_bin \
+ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
+#define TclBN_mp_to_unsigned_bin_n \
+ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
+#define TclBN_mp_toradix_n \
+ (tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
+#define TclBN_mp_unsigned_bin_size \
+ (tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */
+#define TclBN_mp_xor \
+ (tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
+#define TclBN_mp_zero \
+ (tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */
+#define TclBN_reverse \
+ (tclTomMathStubsPtr->tclBN_reverse) /* 50 */
+#define TclBN_fast_s_mp_mul_digs \
+ (tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */
+#define TclBN_fast_s_mp_sqr \
+ (tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */
+#define TclBN_mp_karatsuba_mul \
+ (tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
+#define TclBN_mp_karatsuba_sqr \
+ (tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
+#define TclBN_mp_toom_mul \
+ (tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
+#define TclBN_mp_toom_sqr \
+ (tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
+#define TclBN_s_mp_add \
+ (tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
+#define TclBN_s_mp_mul_digs \
+ (tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
+#define TclBN_s_mp_sqr \
+ (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) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLINTDECLS */
diff --git a/generic/tclTomMathInt.h b/generic/tclTomMathInt.h
new file mode 100644
index 0000000..831f13f
--- /dev/null
+++ b/generic/tclTomMathInt.h
@@ -0,0 +1,3 @@
+#include "tclInt.h"
+#include "tclTomMath.h"
+#include "tommath_class.h"
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 89537b9..48db8c3 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -3,20 +3,93 @@
*
* tclTomMathInterface.c --
*
- * This file contains procedures that are used as a 'glue'
- * layer between Tcl and libtommath.
+ * This file contains procedures that are used as a 'glue' layer between
+ * Tcl and libtommath.
*
* Copyright (c) 2005 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: tclTomMathInterface.c,v 1.2 2005/05/10 18:34:51 kennykb 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"
#include "tommath.h"
-#include <limits.h>
+
+MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTommath_Init --
+ *
+ * Initializes the TclTomMath 'package', which exists as a
+ * placeholder so that the package data can be used to hold
+ * a stub table pointer.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Installs the stub table for tommath.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTommath_Init(
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ /* TIP #268: Full patchlevel instead of just major.minor */
+
+ if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
+ &tclTomMathStubs) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_epoch --
+ *
+ * Return the epoch number of the TclTomMath stubs table
+ *
+ * Results:
+ * Returns an arbitrary integer that does not decrease with
+ * release. Stubs tables with different epochs are incompatible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_epoch(void)
+{
+ return TCLTOMMATH_EPOCH;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_revision --
+ *
+ * Returns the revision level of the TclTomMath stubs table
+ *
+ * Results:
+ * Returns an arbitrary integer that increases with revisions.
+ * If a client requires a given epoch and revision, any Stubs table
+ * with the same epoch and an equal or higher revision satisfies
+ * the request.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_revision(void)
+{
+ return TCLTOMMATH_REVISION;
+}
+#if 0
/*
*----------------------------------------------------------------------
@@ -28,38 +101,41 @@
* Results:
* Returns a pointer to the allocated block.
*
- * This procedure is a wrapper around Tcl_Alloc, needed because of
- * a mismatched type signature between Tcl_Alloc and malloc.
+ * This procedure is a wrapper around Tcl_Alloc, needed because of a
+ * mismatched type signature between Tcl_Alloc and malloc.
*
*----------------------------------------------------------------------
- */
+ */
extern void *
-TclBNAlloc( size_t x )
+TclBNAlloc(
+ size_t x)
{
- return (void*) Tcl_Alloc( (unsigned int) x );
+ return (void *) ckalloc((unsigned int) x);
}
/*
*----------------------------------------------------------------------
*
- * TclBNAlloc --
+ * TclBNRealloc --
*
* Change the size of an allocated block of memory in libtommath
*
* Results:
* Returns a pointer to the allocated block.
*
- * This procedure is a wrapper around Tcl_Realloc, needed because of
- * a mismatched type signature between Tcl_Realloc and realloc.
+ * This procedure is a wrapper around Tcl_Realloc, needed because of a
+ * mismatched type signature between Tcl_Realloc and realloc.
*
*----------------------------------------------------------------------
- */
+ */
-extern void *
-TclBNRealloc( void* p, size_t s )
+void *
+TclBNRealloc(
+ void *p,
+ size_t s)
{
- return (void*) Tcl_Realloc( (char*) p, (unsigned int) s );
+ return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
@@ -75,17 +151,19 @@ TclBNRealloc( void* p, size_t s )
* Side effects:
* Memory is freed.
*
- * This function is simply a wrapper around Tcl_Free, needed in
- * libtommath because of a type mismatch between free and Tcl_Free.
+ * This function is simply a wrapper around Tcl_Free, needed in libtommath
+ * because of a type mismatch between free and Tcl_Free.
*
*----------------------------------------------------------------------
*/
extern void
-TclBNFree( void* p )
+TclBNFree(
+ void *p)
{
- Tcl_Free( (char*) p);
+ ckree((char *) p);
}
+#endif
/*
*----------------------------------------------------------------------
@@ -104,26 +182,29 @@ TclBNFree( void* p )
*/
extern void
-TclBNInitBignumFromLong( mp_int* a, long initVal )
+TclBNInitBignumFromLong(
+ mp_int *a,
+ long initVal)
{
-
int status;
unsigned long v;
- mp_digit* p;
+ mp_digit *p;
/*
* Allocate enough memory to hold the largest possible long
*/
- status = mp_init_size( a, ( ( CHAR_BIT * sizeof( long ) + DIGIT_BIT - 1 )
- / DIGIT_BIT ) );
- if ( status != MP_OKAY ) {
- Tcl_Panic( "initialization failure in TclBNInitBignumFromLong" );
+ status = mp_init_size(a,
+ (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
+ if (status != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
}
-
- /* Convert arg to sign and magnitude */
- if ( initVal < 0 ) {
+ /*
+ * Convert arg to sign and magnitude.
+ */
+
+ if (initVal < 0) {
a->sign = MP_NEG;
v = -initVal;
} else {
@@ -131,13 +212,99 @@ TclBNInitBignumFromLong( mp_int* a, long initVal )
v = initVal;
}
- /* Store the magnitude in the bignum. */
+ /*
+ * Store the magnitude in the bignum.
+ */
p = a->dp;
- while ( v ) {
- *p++ = (mp_digit) ( v & MP_MASK );
+ while (v) {
+ *p++ = (mp_digit) (v & MP_MASK);
v >>= MP_DIGIT_BIT;
}
a->used = p - a->dp;
-
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideInt --
+ *
+ * Allocate and initialize a 'bignum' from a Tcl_WideInt
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideInt(
+ mp_int *a, /* Bignum to initialize */
+ Tcl_WideInt v) /* Initial value */
+{
+ if (v < (Tcl_WideInt)0) {
+ TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
+ mp_neg(a, a);
+ } else {
+ TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideUInt --
+ *
+ * Allocate and initialize a 'bignum' from a Tcl_WideUInt
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideUInt(
+ mp_int *a, /* Bignum to initialize */
+ Tcl_WideUInt v) /* Initial value */
+{
+ int status;
+ mp_digit *p;
+
+ /*
+ * Allocate enough memory to hold the largest possible Tcl_WideUInt.
+ */
+
+ status = mp_init_size(a,
+ (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
+ if (status != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
+ }
+
+ a->sign = MP_ZPOS;
+
+ /*
+ * Store the magnitude in the bignum.
+ */
+
+ p = a->dp;
+ while (v) {
+ *p++ = (mp_digit) (v & MP_MASK);
+ v >>= MP_DIGIT_BIT;
+ }
+ a->used = p - a->dp;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
new file mode 100644
index 0000000..324f2a3
--- /dev/null
+++ b/generic/tclTomMathStubLib.c
@@ -0,0 +1,79 @@
+/*
+ * tclTomMathStubLib.c --
+ *
+ * Stub object that will be statically linked into extensions that want
+ * to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;
+
+const TclTomMathStubs *tclTomMathStubsPtr = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTomMathInitStubs --
+ *
+ * Initializes the Stubs table for Tcl's subset of libtommath
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * This procedure should not be called directly, but rather through
+ * the TclTomMath_InitStubs macro, to insure that the Stubs table
+ * matches the header files used in compilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE const char *
+TclTomMathInitializeStubs(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ const char *version, /* Tcl version needed */
+ int epoch, /* Stubs table epoch from the header files */
+ int revision) /* Stubs table revision number from the
+ * header files */
+{
+ int exact = 0;
+ const char *packageName = "tcl::tommath";
+ const char *errMsg = NULL;
+ TclTomMathStubs *stubsPtr = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, exact, &stubsPtr);
+
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ if (stubsPtr == NULL) {
+ errMsg = "missing stub table pointer";
+ } else if(stubsPtr->tclBN_epoch() != epoch) {
+ errMsg = "epoch number mismatch";
+ } else if(stubsPtr->tclBN_revision() != revision) {
+ errMsg = "requires a later revision";
+ } else {
+ tclTomMathStubsPtr = stubsPtr;
+ return actualVersion;
+ }
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 9d7ab86..c0cde49 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -10,27 +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: tclTrace.c,v 1.26 2005/07/23 00:04:31 dkf Exp $
*/
#include "tclInt.h"
/*
- * Structure used to hold information about variable traces:
+ * Structures used to hold information about variable traces:
*/
typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
- size_t length; /* Number of non-NULL chars. in command. */
- char command[4]; /* Space for Tcl command to invoke. Actual
+ size_t length; /* Number of non-NUL chars. in command. */
+ 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 {
+ VarTrace traceInfo;
+ TraceVarInfo traceCmdInfo;
+} CombinedTraceVarInfo;
+
/*
* Structure used to hold information about command traces:
*/
@@ -38,7 +41,7 @@ typedef struct {
typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
- size_t length; /* Number of non-NULL chars. in command. */
+ size_t length; /* Number of non-NUL chars. in command. */
Tcl_Trace stepTrace; /* Used for execution traces, when tracing
* inside the given command */
int startLevel; /* Used for bookkeeping with step execution
@@ -53,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;
/*
@@ -90,12 +93,12 @@ typedef struct {
* Forward declarations for functions defined in this file:
*/
-typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
- int optionIndex, int objc, Tcl_Obj *CONST objv[]));
+typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
+ int objc, Tcl_Obj *const objv[]);
-Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
-Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
-Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
+static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
+static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
+static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;
/*
* Each subcommand has a number of 'types' to which it can apply. Currently
@@ -104,38 +107,36 @@ Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
* add to the list of supported trace types.
*/
-static CONST char *traceTypeOptions[] = {
- "execution", "command", "variable", (char*) NULL
+static const char *const traceTypeOptions[] = {
+ "execution", "command", "variable", NULL
};
-static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
- TclTraceExecutionObjCmd,
- TclTraceCommandObjCmd,
- TclTraceVariableObjCmd,
+static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
+ TraceExecutionObjCmd,
+ TraceCommandObjCmd,
+ TraceVariableObjCmd
};
/*
* Declarations for local functions to this file:
*/
-static int CallTraceFunction _ANSI_ARGS_((Tcl_Interp *interp,
- Trace *tracePtr, Command *cmdPtr,
- CONST char *command, int numChars,
- int objc, Tcl_Obj *CONST objv[]));
-static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
-static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *oldName,
- CONST char *newName, int flags));
+static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
+ Command *cmdPtr, const char *command, int numChars,
+ int objc, Tcl_Obj *const objv[]);
+static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp,
+ const char *name1, const char *name2, int flags);
+static void TraceCommandProc(ClientData clientData,
+ Tcl_Interp *interp, const char *oldName,
+ const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
-static int StringTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp, int level,
- CONST char* command, Tcl_Command commandInfo,
- int objc, Tcl_Obj *CONST objv[]));
-static void StringTraceDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-static void DisposeTraceResult _ANSI_ARGS_((int flags,
- char *result));
+static int StringTraceProc(ClientData clientData,
+ Tcl_Interp *interp, int level,
+ const char *command, Tcl_Command commandInfo,
+ int objc, Tcl_Obj *const objv[]);
+static void StringTraceDeleteProc(ClientData clientData);
+static void DisposeTraceResult(int flags, char *result);
+static int TraceVarEx(Tcl_Interp *interp, const char *part1,
+ const char *part2, register VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
@@ -144,8 +145,23 @@ static void DisposeTraceResult _ANSI_ARGS_((int flags,
typedef struct StringTraceData {
ClientData clientData; /* Client data from Tcl_CreateTrace */
- Tcl_CmdTraceProc* proc; /* Trace function from Tcl_CreateTrace */
+ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
+
+/*
+ * Convenience macros for iterating over the list of traces. Note that each of
+ * these *must* be treated as a command, and *must* have a block following it.
+ */
+
+#define FOREACH_VAR_TRACE(interp, name, clientData) \
+ (clientData) = NULL; \
+ while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
+ 0, TraceVarProc, (clientData))) != NULL)
+
+#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
+ (clientData) = NULL; \
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
+ TraceCommandProc, clientData)) != NULL)
/*
*----------------------------------------------------------------------
@@ -168,21 +184,22 @@ typedef struct StringTraceData {
/* ARGSUSED */
int
-Tcl_TraceObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_TraceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
- char *name, *flagOps, *p;
+ const char *name;
+ const char *flagOps, *p;
/* Main sub commands to 'trace' */
- static CONST char *traceOptions[] = {
+ static const char *const traceOptions[] = {
"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
"variable", "vdelete", "vinfo",
#endif
- (char *) NULL
+ NULL
};
/* 'OLD' options are pre-Tcl-8.4 style */
enum traceOptions {
@@ -193,12 +210,12 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
- "option", 0, &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
+ &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum traceOptions) optionIndex) {
@@ -213,14 +230,14 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
int typeIndex;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
0, &typeIndex) != TCL_OK) {
return TCL_ERROR;
}
- return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+ return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
}
case TRACE_INFO: {
/*
@@ -243,7 +260,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
0, &typeIndex) != TCL_OK) {
return TCL_ERROR;
}
- return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+ return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
break;
}
@@ -267,30 +284,29 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
goto badVarOps;
}
for (p = flagOps; *p != 0; p++) {
+ Tcl_Obj *opObj;
+
if (*p == 'r') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("read", -1));
+ TclNewLiteralStringObj(opObj, "read");
} else if (*p == 'w') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("write", -1));
+ TclNewLiteralStringObj(opObj, "write");
} else if (*p == 'u') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("unset", -1));
+ TclNewLiteralStringObj(opObj, "unset");
} else if (*p == 'a') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("array", -1));
+ TclNewLiteralStringObj(opObj, "array");
} else {
Tcl_DecrRefCount(opsList);
goto badVarOps;
}
+ Tcl_ListObjAppendElement(NULL, opsList, opObj);
}
copyObjv[0] = NULL;
memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
copyObjv[4] = opsList;
if (optionIndex == TRACE_OLD_VARIABLE) {
- code = (traceSubCmds[2])(interp,TRACE_ADD,objc+1,copyObjv);
+ code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv);
} else {
- code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
+ code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
}
Tcl_DecrRefCount(opsList);
return code;
@@ -305,32 +321,29 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
resultListPtr = Tcl_NewObj();
- clientData = 0;
name = Tcl_GetString(objv[2]);
- while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
- TraceVarProc, clientData)) != 0) {
-
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+ FOREACH_VAR_TRACE(interp, name, clientData) {
+ TraceVarInfo *tvarPtr = clientData;
+ char *q = ops;
- pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- p = ops;
+ pairObjPtr = Tcl_NewListObj(0, NULL);
if (tvarPtr->flags & TCL_TRACE_READS) {
- *p = 'r';
- p++;
+ *q = 'r';
+ q++;
}
if (tvarPtr->flags & TCL_TRACE_WRITES) {
- *p = 'w';
- p++;
+ *q = 'w';
+ q++;
}
if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- *p = 'u';
- p++;
+ *q = 'u';
+ q++;
}
if (tvarPtr->flags & TCL_TRACE_ARRAY) {
- *p = 'a';
- p++;
+ *q = 'a';
+ q++;
}
- *p = '\0';
+ *q = '\0';
/*
* Build a pair (2-item list) with the ops string as the first obj
@@ -353,15 +366,17 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
return TCL_OK;
badVarOps:
- Tcl_AppendResult(interp, "bad operations \"", flagOps,
- "\": should be one or more of rwua", (char *) 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;
}
/*
*----------------------------------------------------------------------
*
- * TclTraceExecutionObjCmd --
+ * TraceExecutionObjCmd --
*
* Helper function for Tcl_TraceObjCmd; implements the [trace
* {add|remove|info} execution ...] subcommands. See the user
@@ -377,21 +392,21 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-int
-TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+TraceExecutionObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
- char *name, *command;
+ const char *name, *command;
size_t length;
enum traceOptions {
TRACE_ADD, TRACE_INFO, TRACE_REMOVE
};
- static CONST char *opStrings[] = {
- "enter", "leave", "enterstep", "leavestep", (char *) NULL
+ static const char *const opStrings[] = {
+ "enter", "leave", "enterstep", "leavestep", NULL
};
enum operations {
TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
@@ -420,9 +435,11 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
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++) {
@@ -448,11 +465,9 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr;
+ TraceCommandInfo *tcmdPtr = ckalloc(
+ TclOffset(TraceCommandInfo, command) + 1 + length);
- tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
- (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
- + length + 1));
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
tcmdPtr->startLevel = 0;
@@ -464,11 +479,11 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
TCL_TRACE_LEAVE_DURING_EXEC)) {
flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
}
- strcpy(tcmdPtr->command, command);
+ memcpy(tcmdPtr->command, command, length+1);
name = Tcl_GetString(objv[3]);
if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
- (ClientData) tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
+ tcmdPtr) != TCL_OK) {
+ ckfree(tcmdPtr);
return TCL_ERROR;
}
} else {
@@ -478,19 +493,19 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
* first one that matches.
*/
- TraceCommandInfo *tcmdPtr;
- ClientData clientData = NULL;
- name = Tcl_GetString(objv[3]);
+ ClientData clientData;
+
+ /*
+ * First ensure the name given is valid.
+ */
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
- TraceCommandProc, clientData)) != NULL) {
- tcmdPtr = (TraceCommandInfo *) clientData;
+ FOREACH_COMMAND_TRACE(interp, name, clientData) {
+ TraceCommandInfo *tcmdPtr = clientData;
/*
* In checking the 'flags' field we must remove any extraneous
@@ -519,15 +534,18 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
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) {
- /* Postpone deletion */
+ /*
+ * Postpone deletion.
+ */
+
tcmdPtr->flags = 0;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree(tcmdPtr);
}
break;
}
@@ -537,27 +555,28 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
}
case TRACE_INFO: {
ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ Tcl_Obj *resultListPtr;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "name");
return TCL_ERROR;
}
- clientData = NULL;
name = Tcl_GetString(objv[3]);
- /* First ensure the name given is valid */
+ /*
+ * First ensure the name given is valid.
+ */
+
if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
- TraceCommandProc, clientData)) != NULL) {
+ resultListPtr = Tcl_NewListObj(0, NULL);
+ FOREACH_COMMAND_TRACE(interp, name, clientData) {
int numOps = 0;
-
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
+ TraceCommandInfo *tcmdPtr = clientData;
/*
* Build a list with the ops list as the first obj element and the
@@ -565,38 +584,37 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enter",5));
+ TclNewLiteralStringObj(opObj, "enter");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leave",5));
+ TclNewLiteralStringObj(opObj, "leave");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enterstep",9));
+ TclNewLiteralStringObj(opObj, "enterstep");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leavestep",9));
+ TclNewLiteralStringObj(opObj, "leavestep");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
elemObjPtr = NULL;
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
Tcl_NewStringObj(tcmdPtr->command, -1));
- Tcl_ListObjAppendElement(interp, resultListPtr,
- eachTraceObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
}
Tcl_SetObjResult(interp, resultListPtr);
break;
@@ -608,7 +626,7 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclTraceCommandObjCmd --
+ * TraceCommandObjCmd --
*
* Helper function for Tcl_TraceObjCmd; implements the [trace
* {add|info|remove} command ...] subcommands. See the user documentation
@@ -624,18 +642,18 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
*----------------------------------------------------------------------
*/
-int
-TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+TraceCommandObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
- char *name, *command;
+ const char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
+ static const char *const opStrings[] = { "delete", "rename", NULL };
enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
switch ((enum traceOptions) optionIndex) {
@@ -660,8 +678,11 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
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;
}
@@ -683,11 +704,9 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr;
+ TraceCommandInfo *tcmdPtr = ckalloc(
+ TclOffset(TraceCommandInfo, command) + 1 + length);
- tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
- (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
- + length + 1));
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
tcmdPtr->startLevel = 0;
@@ -695,11 +714,11 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
tcmdPtr->length = length;
tcmdPtr->refCount = 1;
flags |= TCL_TRACE_DELETE;
- strcpy(tcmdPtr->command, command);
+ memcpy(tcmdPtr->command, command, length+1);
name = Tcl_GetString(objv[3]);
if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
- (ClientData) tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
+ tcmdPtr) != TCL_OK) {
+ ckfree(tcmdPtr);
return TCL_ERROR;
}
} else {
@@ -709,28 +728,28 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
* first one that matches.
*/
- TraceCommandInfo *tcmdPtr;
- ClientData clientData = NULL;
- name = Tcl_GetString(objv[3]);
+ ClientData clientData;
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ /*
+ * First ensure the name given is valid.
+ */
+
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
- TraceCommandProc, clientData)) != NULL) {
- tcmdPtr = (TraceCommandInfo *) clientData;
- if ((tcmdPtr->length == length)
- && (tcmdPtr->flags == flags)
+ FOREACH_COMMAND_TRACE(interp, name, clientData) {
+ TraceCommandInfo *tcmdPtr = clientData;
+
+ if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
&& (strncmp(command, tcmdPtr->command,
(size_t) length) == 0)) {
Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
TraceCommandProc, clientData);
tcmdPtr->flags |= TCL_TRACE_DESTROYED;
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char *) tcmdPtr);
+ ckfree(tcmdPtr);
}
break;
}
@@ -740,27 +759,27 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
}
case TRACE_INFO: {
ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ Tcl_Obj *resultListPtr;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "name");
return TCL_ERROR;
}
- clientData = NULL;
- name = Tcl_GetString(objv[3]);
+ /*
+ * First ensure the name given is valid.
+ */
- /* First ensure the name given is valid */
+ name = Tcl_GetString(objv[3]);
if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
- TraceCommandProc, clientData)) != NULL) {
+ resultListPtr = Tcl_NewListObj(0, NULL);
+ FOREACH_COMMAND_TRACE(interp, name, clientData) {
int numOps = 0;
-
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
+ TraceCommandInfo *tcmdPtr = clientData;
/*
* Build a list with the ops list as the first obj element and the
@@ -768,22 +787,22 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_RENAME) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("rename",6));
+ TclNewLiteralStringObj(opObj, "rename");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_DELETE) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("delete",6));
+ TclNewLiteralStringObj(opObj, "delete");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
@@ -801,7 +820,7 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclTraceVariableObjCmd --
+ * TraceVariableObjCmd --
*
* Helper function for Tcl_TraceObjCmd; implements the [trace
* {add|info|remove} variable ...] subcommands. See the user
@@ -817,19 +836,20 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
*----------------------------------------------------------------------
*/
-int
-TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static int
+TraceVariableObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
- char *name, *command;
+ const char *name, *command;
size_t length;
+ ClientData clientData;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = {
- "array", "read", "unset", "write", (char *) NULL
+ static const char *const opStrings[] = {
+ "array", "read", "unset", "write", NULL
};
enum operations {
TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
@@ -857,8 +877,11 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
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++) {
@@ -884,21 +907,24 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceVarInfo *tvarPtr;
- tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
- (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
- + length + 1));
- tvarPtr->flags = flags;
+ CombinedTraceVarInfo *ctvarPtr = ckalloc(
+ TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
+ + 1 + length);
+
+ ctvarPtr->traceCmdInfo.flags = flags;
if (objv[0] == NULL) {
- tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
+ ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
}
- tvarPtr->length = length;
+ ctvarPtr->traceCmdInfo.length = length;
flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
- strcpy(tvarPtr->command, command);
+ memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
+ ctvarPtr->traceInfo.traceProc = TraceVarProc;
+ ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
+ ctvarPtr->traceInfo.flags = flags;
name = Tcl_GetString(objv[3]);
- if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
- (ClientData) tvarPtr) != TCL_OK) {
- ckfree((char *) tvarPtr);
+ if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
+ != TCL_OK) {
+ ckfree(ctvarPtr);
return TCL_ERROR;
}
} else {
@@ -908,12 +934,10 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
* first one that matches.
*/
- TraceVarInfo *tvarPtr;
- ClientData clientData = 0;
name = Tcl_GetString(objv[3]);
- while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
- TraceVarProc, clientData)) != 0) {
- tvarPtr = (TraceVarInfo *) clientData;
+ FOREACH_VAR_TRACE(interp, name, clientData) {
+ TraceVarInfo *tvarPtr = clientData;
+
if ((tvarPtr->length == length)
&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
&& (strncmp(command, tvarPtr->command,
@@ -921,7 +945,6 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
Tcl_UntraceVar2(interp, name, NULL,
flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
TraceVarProc, clientData);
- Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
break;
}
}
@@ -929,8 +952,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
break;
}
case TRACE_INFO: {
- ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ Tcl_Obj *resultListPtr;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "name");
@@ -938,12 +960,10 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
}
resultListPtr = Tcl_NewObj();
- clientData = 0;
name = Tcl_GetString(objv[3]);
- while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
- clientData)) != 0) {
-
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+ FOREACH_VAR_TRACE(interp, name, clientData) {
+ Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
+ TraceVarInfo *tvarPtr = clientData;
/*
* Build a list with the ops list as the first obj element and the
@@ -951,24 +971,24 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
if (tvarPtr->flags & TCL_TRACE_ARRAY) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("array", 5));
+ TclNewLiteralStringObj(opObjPtr, "array");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
}
if (tvarPtr->flags & TCL_TRACE_READS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("read", 4));
+ TclNewLiteralStringObj(opObjPtr, "read");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
}
if (tvarPtr->flags & TCL_TRACE_WRITES) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("write", 5));
+ TclNewLiteralStringObj(opObjPtr, "write");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
}
if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("unset", 5));
+ TclNewLiteralStringObj(opObjPtr, "unset");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
@@ -1009,13 +1029,13 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
*/
ClientData
-Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
+Tcl_CommandTraceInfo(
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ const char *cmdName, /* Name of command. */
+ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_CommandTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
@@ -1074,16 +1094,16 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
*/
int
-Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which command is to be
+Tcl_TraceCommand(
+ Tcl_Interp *interp, /* Interpreter in which command is to be
* traced. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed collection of bits, including any of
+ const char *cmdName, /* Name of command. */
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
- Tcl_CommandTraceProc *proc; /* Function to call when specified ops are
+ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are
* invoked upon cmdName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
@@ -1098,7 +1118,7 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
* Set up trace information.
*/
- tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+ tracePtr = ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags = flags &
@@ -1107,8 +1127,18 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
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;
}
@@ -1130,14 +1160,14 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
*/
void
-Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed collection of bits, including any of
+Tcl_UntraceCommand(
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ const char *cmdName, /* Name of command. */
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
- Tcl_CommandTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register CommandTrace *tracePtr;
CommandTrace *prevPtr;
@@ -1146,7 +1176,7 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
ActiveCommandTrace *activePtr;
int hasExecTraces = 0;
- cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, NULL,
+ cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
TCL_LEAVE_ERR_MSG);
if (cmdPtr == NULL) {
return;
@@ -1154,7 +1184,7 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
- for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
+ for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
return;
@@ -1194,7 +1224,7 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
tracePtr->flags = 0;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree(tracePtr);
}
if (hasExecTraces) {
@@ -1211,6 +1241,15 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
*/
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++;
+ }
}
}
@@ -1234,23 +1273,23 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
/* ARGSUSED */
static void
-TraceCommandProc(clientData, interp, oldName, newName, flags)
- ClientData clientData; /* Information about the command trace. */
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *oldName; /* Name of command being changed. */
- CONST char *newName; /* New name of command. Empty string or NULL
+TraceCommandProc(
+ ClientData clientData, /* Information about the command trace. */
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ const char *oldName, /* Name of command being changed. */
+ const char *newName, /* New name of command. Empty string or NULL
* means command is being deleted (renamed to
* ""). */
- int flags; /* OR-ed bits giving operation and other
+ int flags) /* OR-ed bits giving operation and other
* information. */
{
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ TraceCommandInfo *tcmdPtr = clientData;
int code;
Tcl_DString cmd;
tcmdPtr->refCount++;
- if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)
+ if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)
&& !Tcl_LimitExceeded(interp)) {
/*
* Generate a command to execute by appending list elements for the
@@ -1262,9 +1301,9 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
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");
}
/*
@@ -1283,7 +1322,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
Tcl_DStringLength(&cmd), 0);
if (code != TCL_OK) {
/* We ignore errors in these traced commands */
- /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+ /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
}
Tcl_DStringFree(&cmd);
}
@@ -1301,7 +1340,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
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) {
@@ -1340,13 +1379,12 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
state = Tcl_SaveInterpState(interp, TCL_OK);
Tcl_UntraceCommand(interp, oldName, untraceFlags,
TraceCommandProc, clientData);
- (void) Tcl_RestoreInterpState(interp, state);
+ Tcl_RestoreInterpState(interp, state);
tcmdPtr->refCount--;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree(tcmdPtr);
}
- return;
}
/*
@@ -1375,32 +1413,30 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
*/
int
-TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
- objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- CONST char *command; /* Pointer to beginning of the current command
+TclCheckExecutionTraces(
+ Tcl_Interp *interp, /* The current interpreter. */
+ const char *command, /* Pointer to beginning of the current command
* string. */
- int numChars; /* The number of characters in 'command' which
+ int numChars, /* The number of characters in 'command' which
* are part of the command string. */
- Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
- int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ int code, /* The current result code. */
+ int traceFlags, /* Current tracing situation. */
+ int objc, /* Number of arguments for the command. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
CommandTrace *tracePtr, *lastTracePtr;
ActiveCommandTrace active;
int curLevel;
int traceCode = TCL_OK;
- TraceCommandInfo* tcmdPtr;
Tcl_InterpState state = NULL;
- if (command == NULL || cmdPtr->tracePtr == NULL) {
+ if (cmdPtr->tracePtr == NULL) {
return traceCode;
}
- curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
+ curLevel = iPtr->varFramePtr->level;
active.nextPtr = iPtr->activeCmdTracePtr;
iPtr->activeCmdTracePtr = &active;
@@ -1426,18 +1462,21 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
active.reverseScan = 0;
active.nextTracePtr = tracePtr->nextPtr;
}
- tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
- if (tcmdPtr->flags != 0) {
- tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
- tcmdPtr->curCode = code;
- tcmdPtr->refCount++;
- if (state == NULL) {
- state = Tcl_SaveInterpState(interp, code);
- }
- traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp,
- curLevel, command, (Tcl_Command)cmdPtr, objc, objv);
- if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ if (tracePtr->traceProc == TraceCommandProc) {
+ TraceCommandInfo *tcmdPtr = tracePtr->clientData;
+
+ if (tcmdPtr->flags != 0) {
+ tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
+ tcmdPtr->curCode = code;
+ tcmdPtr->refCount++;
+ if (state == NULL) {
+ state = Tcl_SaveInterpState(interp, code);
+ }
+ traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
+ command, (Tcl_Command) cmdPtr, objc, objv);
+ if ((--tcmdPtr->refCount) <= 0) {
+ ckfree(tcmdPtr);
+ }
}
}
if (active.nextTracePtr) {
@@ -1446,9 +1485,14 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
}
iPtr->activeCmdTracePtr = active.nextPtr;
if (state) {
- (void) Tcl_RestoreInterpState(interp, state);
+ if (traceCode == TCL_OK) {
+ (void) Tcl_RestoreInterpState(interp, state);
+ } else {
+ Tcl_DiscardInterpState(state);
+ }
}
- return(traceCode);
+
+ return traceCode;
}
/*
@@ -1475,18 +1519,17 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
*/
int
-TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
- objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- CONST char *command; /* Pointer to beginning of the current command
+TclCheckInterpTraces(
+ Tcl_Interp *interp, /* The current interpreter. */
+ const char *command, /* Pointer to beginning of the current command
* string. */
- int numChars; /* The number of characters in 'command' which
+ int numChars, /* The number of characters in 'command' which
* are part of the command string. */
- Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
- int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ int code, /* The current result code. */
+ int traceFlags, /* Current tracing situation. */
+ int objc, /* Number of arguments for the command. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
Trace *tracePtr, *lastTracePtr;
@@ -1495,7 +1538,7 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
int traceCode = TCL_OK;
Tcl_InterpState state = NULL;
- if (command == NULL || iPtr->tracePtr == NULL
+ if ((iPtr->tracePtr == NULL)
|| (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
return(traceCode);
}
@@ -1526,6 +1569,9 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
active.nextTracePtr = tracePtr;
tracePtr = tracePtr->nextPtr;
}
+ if (active.nextTracePtr) {
+ lastTracePtr = active.nextTracePtr->nextPtr;
+ }
} else {
active.reverseScan = 0;
active.nextTracePtr = tracePtr->nextPtr;
@@ -1544,7 +1590,7 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
* it.
*/
- Tcl_Preserve((ClientData) tracePtr);
+ Tcl_Preserve(tracePtr);
tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
if (state == NULL) {
state = Tcl_SaveInterpState(interp, code);
@@ -1558,14 +1604,14 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
if (tracePtr->flags & traceFlags) {
if (tracePtr->proc == TraceExecutionProc) {
- TraceCommandInfo* tcmdPtr =
- (TraceCommandInfo *) tracePtr->clientData;
+ TraceCommandInfo *tcmdPtr = tracePtr->clientData;
+
tcmdPtr->curFlags = traceFlags;
- tcmdPtr->curCode = code;
+ tcmdPtr->curCode = code;
}
- traceCode = (tracePtr->proc)(tracePtr->clientData,
- interp, curLevel, command, (Tcl_Command) cmdPtr,
- objc, objv);
+ traceCode = tracePtr->proc(tracePtr->clientData, interp,
+ curLevel, command, (Tcl_Command) cmdPtr, objc,
+ objv);
}
} else {
/*
@@ -1583,21 +1629,19 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
}
}
tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
- Tcl_Release((ClientData) tracePtr);
- }
- if (active.nextTracePtr) {
- lastTracePtr = active.nextTracePtr->nextPtr;
+ Tcl_Release(tracePtr);
}
}
iPtr->activeInterpTracePtr = active.nextPtr;
if (state) {
if (traceCode == TCL_OK) {
- (void) Tcl_RestoreInterpState(interp, state);
+ Tcl_RestoreInterpState(interp, state);
} else {
Tcl_DiscardInterpState(state);
}
}
- return(traceCode);
+
+ return traceCode;
}
/*
@@ -1620,16 +1664,16 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
*/
static int
-CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- register Trace *tracePtr; /* Describes the trace function to call. */
- Command *cmdPtr; /* Points to command's Command struct. */
- CONST char *command; /* Points to the first character of the
+CallTraceFunction(
+ Tcl_Interp *interp, /* The current interpreter. */
+ register Trace *tracePtr, /* Describes the trace function to call. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ const char *command, /* Points to the first character of the
* command's source before substitutions. */
- int numChars; /* The number of characters in the command's
+ int numChars, /* The number of characters in the command's
* source. */
- register int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ register int objc, /* Number of arguments for the command. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
char *commandCopy;
@@ -1639,19 +1683,19 @@ CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
* Copy the command characters into a new string.
*/
- commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
- memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
+ commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
+ memcpy(commandCopy, command, (size_t) numChars);
commandCopy[numChars] = '\0';
/*
* Call the trace function then free allocated storage.
*/
- traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*) iPtr,
+ traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr,
iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
- ckfree((char *) commandCopy);
- return(traceCode);
+ TclStackFree(interp, commandCopy);
+ return traceCode;
}
/*
@@ -1672,10 +1716,13 @@ CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
*/
static void
-CommandObjTraceDeleted(ClientData clientData) {
- TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
+CommandObjTraceDeleted(
+ ClientData clientData)
+{
+ TraceCommandInfo *tcmdPtr = clientData;
+
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree(tcmdPtr);
}
}
@@ -1705,15 +1752,21 @@ CommandObjTraceDeleted(ClientData clientData) {
*/
static int
-TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
- CONST char* command, Tcl_Command cmdInfo, int objc,
- struct Tcl_Obj *CONST objv[]) {
+TraceExecutionProc(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int level,
+ const char *command,
+ Tcl_Command cmdInfo,
+ int objc,
+ struct Tcl_Obj *const objv[])
+{
int call = 0;
Interp *iPtr = (Interp *) interp;
- TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
+ TraceCommandInfo *tcmdPtr = clientData;
int flags = tcmdPtr->curFlags;
- int code = tcmdPtr->curCode;
- int traceCode = TCL_OK;
+ int code = tcmdPtr->curCode;
+ int traceCode = TCL_OK;
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
/*
@@ -1724,7 +1777,7 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
return traceCode;
}
- if (!(flags & TCL_INTERP_DESTROYED) && !Tcl_LimitExceeded(interp)) {
+ if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
/*
* Check whether the current call is going to eval arbitrary Tcl code
* with a generated trace, or whether we are only going to setup
@@ -1752,7 +1805,7 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
@@ -1761,9 +1814,8 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
*/
if (call) {
- Tcl_DString cmd;
- Tcl_DString sub;
- int i;
+ Tcl_DString cmd, sub;
+ int i, saveInterpFlags;
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
@@ -1790,8 +1842,8 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
Tcl_DStringAppendElement(&cmd, "enterstep");
}
} else if (flags & TCL_TRACE_LEAVE_EXEC) {
- Tcl_Obj* resultCode;
- char* resultCodeStr;
+ Tcl_Obj *resultCode;
+ const char *resultCodeStr;
/*
* Append result code.
@@ -1826,8 +1878,9 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
* returns.
*/
- tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+ saveInterpFlags = iPtr->flags;
iPtr->flags |= INTERP_TRACE_IN_PROGRESS;
+ tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
tcmdPtr->refCount++;
/*
@@ -1838,7 +1891,13 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
- iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS;
+
+ /*
+ * Restore the interp tracing flag to prevent cmd traces from
+ * affecting interp traces.
+ */
+
+ iPtr->flags = saveInterpFlags;
if (tcmdPtr->flags == 0) {
flags |= TCL_TRACE_DESTROYED;
}
@@ -1856,15 +1915,15 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
TCL_TRACE_LEAVE_DURING_EXEC))) {
+ register unsigned len = strlen(command) + 1;
+
tcmdPtr->startLevel = level;
- tcmdPtr->startCmd =
- (char *) ckalloc((unsigned) (strlen(command) + 1));
- strcpy(tcmdPtr->startCmd, command);
+ tcmdPtr->startCmd = ckalloc(len);
+ memcpy(tcmdPtr->startCmd, command, len);
tcmdPtr->refCount++;
tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
(tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
- TraceExecutionProc, (ClientData)tcmdPtr,
- CommandObjTraceDeleted);
+ TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
}
}
if (flags & TCL_TRACE_DESTROYED) {
@@ -1872,13 +1931,13 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
}
if (call) {
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree(tcmdPtr);
}
}
return traceCode;
@@ -1904,19 +1963,20 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
/* ARGSUSED */
static char *
-TraceVarProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Information about the variable trace. */
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *name1; /* Name of variable or array. */
- CONST char *name2; /* Name of element within array; NULL means
+TraceVarProc(
+ ClientData clientData, /* Information about the variable trace. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable or array. */
+ const char *name2, /* Name of element within array; NULL means
* scalar variable is being referenced. */
- int flags; /* OR-ed bits giving operation and other
+ int flags) /* OR-ed bits giving operation and other
* information. */
{
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+ TraceVarInfo *tvarPtr = clientData;
char *result;
- int code;
+ int code, destroy = 0;
Tcl_DString cmd;
+ int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
* We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
@@ -1925,10 +1985,8 @@ TraceVarProc(clientData, interp, name1, name2, flags)
* it is not freed while we still need it.
*/
- Tcl_Preserve((ClientData) tvarPtr);
-
result = NULL;
- if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)
+ if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)
&& !Tcl_LimitExceeded(interp)) {
if (tvarPtr->length != (size_t) 0) {
/*
@@ -1943,24 +2001,24 @@ TraceVarProc(clientData, interp, name1, name2, flags)
#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
}
@@ -1975,29 +2033,40 @@ TraceVarProc(clientData, interp, name1, name2, flags)
* double-free might occur depending on what the eval does.
*/
- if (flags & TCL_TRACE_DESTROYED) {
+ if ((flags & TCL_TRACE_DESTROYED)
+ && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
+ destroy = 1;
tvarPtr->flags |= TCL_TRACE_DESTROYED;
}
+
+ /*
+ * Make sure that unset traces are rune even if the execEnv is
+ * rewinding (coroutine deletion, [Bug 2093947]
+ */
+
+ if (rewind && (flags & TCL_TRACE_UNSETS)) {
+ ((Interp *)interp)->execEnvPtr->rewind = 0;
+ }
code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
Tcl_DStringLength(&cmd), 0);
+ if (rewind) {
+ ((Interp *)interp)->execEnvPtr->rewind = rewind;
+ }
if (code != TCL_OK) { /* copy error msg to result */
Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+
Tcl_IncrRefCount(errMsgObj);
result = (char *) errMsgObj;
}
Tcl_DStringFree(&cmd);
}
}
- if (flags & TCL_TRACE_DESTROYED) {
- if (result != NULL) {
- register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+ if (destroy && result != NULL) {
+ register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
- Tcl_DecrRefCount(errMsgObj);
- result = NULL;
- }
- Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
+ Tcl_DecrRefCount(errMsgObj);
+ result = NULL;
}
- Tcl_Release((ClientData) tvarPtr);
return result;
}
@@ -2018,12 +2087,12 @@ TraceVarProc(clientData, interp, name1, name2, flags)
* form:
*
* void proc(ClientData clientData,
- * Tcl_Interp* interp,
+ * Tcl_Interp * interp,
* int level,
- * CONST char* command,
+ * const char * command,
* Tcl_Command commandInfo,
* int objc,
- * Tcl_Obj *CONST objv[]);
+ * Tcl_Obj *const objv[]);
*
* The 'clientData' and 'interp' arguments to 'proc' will be the same as
* the arguments to Tcl_CreateObjTrace. The 'level' argument gives the
@@ -2061,13 +2130,13 @@ TraceVarProc(clientData, interp, name1, name2, flags)
*/
Tcl_Trace
-Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
- Tcl_Interp* interp; /* Tcl interpreter */
- int level; /* Maximum nesting level */
- int flags; /* Flags, see above */
- Tcl_CmdObjTraceProc* proc; /* Trace callback */
- ClientData clientData; /* Client data for the callback */
- Tcl_CmdObjTraceDeleteProc* delProc;
+Tcl_CreateObjTrace(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int level, /* Maximum nesting level */
+ int flags, /* Flags, see above */
+ Tcl_CmdObjTraceProc *proc, /* Trace callback */
+ ClientData clientData, /* Client data for the callback */
+ Tcl_CmdObjTraceDeleteProc *delProc)
/* Function to call when trace is deleted */
{
register Trace *tracePtr;
@@ -2095,7 +2164,7 @@ Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
iPtr->tracesForbiddingInline++;
}
- tracePtr = (Trace *) ckalloc(sizeof(Trace));
+ tracePtr = ckalloc(sizeof(Trace));
tracePtr->level = level;
tracePtr->proc = proc;
tracePtr->clientData = clientData;
@@ -2150,20 +2219,20 @@ Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
*/
Tcl_Trace
-Tcl_CreateTrace(interp, level, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which to create trace. */
- int level; /* Only call proc for commands at nesting
+Tcl_CreateTrace(
+ Tcl_Interp *interp, /* Interpreter in which to create trace. */
+ int level, /* Only call proc for commands at nesting
* level<=argument level (1=>top level). */
- Tcl_CmdTraceProc *proc; /* Function to call before executing each
+ Tcl_CmdTraceProc *proc, /* Function to call before executing each
* command. */
- ClientData clientData; /* Arbitrary value word to pass to proc. */
+ ClientData clientData) /* Arbitrary value word to pass to proc. */
{
- StringTraceData* data;
- data = (StringTraceData *) ckalloc(sizeof(*data));
+ StringTraceData *data = ckalloc(sizeof(StringTraceData));
+
data->clientData = clientData;
data->proc = proc;
return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
- (ClientData) data, StringTraceDeleteProc);
+ data, StringTraceDeleteProc);
}
/*
@@ -2183,18 +2252,18 @@ Tcl_CreateTrace(interp, level, proc, clientData)
*/
static int
-StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int level;
- CONST char* command;
- Tcl_Command commandInfo;
- int objc;
- Tcl_Obj *CONST *objv;
+StringTraceProc(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int level,
+ const char *command,
+ Tcl_Command commandInfo,
+ int objc,
+ Tcl_Obj *const *objv)
{
- StringTraceData* data = (StringTraceData*) clientData;
- Command* cmdPtr = (Command*) commandInfo;
- CONST char** argv; /* Args to pass to string trace proc */
+ StringTraceData *data = clientData;
+ Command *cmdPtr = (Command *) commandInfo;
+ const char **argv; /* Args to pass to string trace proc */
int i;
/*
@@ -2202,8 +2271,8 @@ StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
* which uses strings for everything.
*/
- argv = (CONST char **)
- ckalloc((unsigned) ((objc + 1) * sizeof(CONST char *)));
+ argv = (const char **) TclStackAlloc(interp,
+ (unsigned) ((objc + 1) * sizeof(const char *)));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
}
@@ -2215,9 +2284,9 @@ StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
* either command or argv.
*/
- (data->proc)(data->clientData, interp, level, (char *) command,
+ data->proc(data->clientData, interp, level, (char *) command,
cmdPtr->proc, cmdPtr->clientData, objc, argv);
- ckfree((char *) argv);
+ TclStackFree(interp, (void *) argv);
return TCL_OK;
}
@@ -2239,10 +2308,10 @@ StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
*/
static void
-StringTraceDeleteProc(clientData)
- ClientData clientData;
+StringTraceDeleteProc(
+ ClientData clientData)
{
- ckfree((char *) clientData);
+ ckfree(clientData);
}
/*
@@ -2263,14 +2332,14 @@ StringTraceDeleteProc(clientData)
*/
void
-Tcl_DeleteTrace(interp, trace)
- Tcl_Interp *interp; /* Interpreter that contains trace. */
- Tcl_Trace trace; /* Token for trace (returned previously by
+Tcl_DeleteTrace(
+ Tcl_Interp *interp, /* Interpreter that contains trace. */
+ Tcl_Trace trace) /* Token for trace (returned previously by
* Tcl_CreateTrace). */
{
Interp *iPtr = (Interp *) interp;
Trace *prevPtr, *tracePtr = (Trace *) trace;
- register Trace **tracePtr2 = &(iPtr->tracePtr);
+ register Trace **tracePtr2 = &iPtr->tracePtr;
ActiveInterpTrace *activePtr;
/*
@@ -2279,14 +2348,14 @@ Tcl_DeleteTrace(interp, trace)
*/
prevPtr = NULL;
- while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
+ while (*tracePtr2 != NULL && *tracePtr2 != tracePtr) {
prevPtr = *tracePtr2;
- tracePtr2 = &((*tracePtr2)->nextPtr);
+ tracePtr2 = &prevPtr->nextPtr;
}
if (*tracePtr2 == NULL) {
return;
}
- (*tracePtr2) = (*tracePtr2)->nextPtr;
+ *tracePtr2 = (*tracePtr2)->nextPtr;
/*
* The code below makes it possible to delete traces while traces are
@@ -2325,14 +2394,14 @@ Tcl_DeleteTrace(interp, trace)
*/
if (tracePtr->delProc != NULL) {
- (tracePtr->delProc)(tracePtr->clientData);
+ tracePtr->delProc(tracePtr->clientData);
}
/*
* Delete the trace object.
*/
- Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC);
}
/*
@@ -2354,12 +2423,11 @@ Tcl_DeleteTrace(interp, trace)
*/
Var *
-TclVarTraceExists(interp, varName)
- Tcl_Interp *interp; /* The interpreter */
- CONST char *varName; /* The variable name */
+TclVarTraceExists(
+ Tcl_Interp *interp, /* The interpreter */
+ const char *varName) /* The variable name */
{
- Var *varPtr;
- Var *arrayPtr;
+ Var *varPtr, *arrayPtr;
/*
* The choice of "create" flag values is delicate here, and matches the
@@ -2370,16 +2438,16 @@ TclVarTraceExists(interp, varName)
* is triggered. This matches Tcl 7.6 semantics.
*/
- varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, "access",
+ varPtr = TclLookupVar(interp, varName, NULL, 0, "access",
/*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return NULL;
}
- if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
+ if ((varPtr->flags & VAR_TRACED_READ)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
+ TclCallVarTraces((Interp *) interp, arrayPtr, varPtr, varName, NULL,
TCL_TRACE_READS, /* leaveErrMsg */ 0);
}
@@ -2420,32 +2488,63 @@ TclVarTraceExists(interp, varName)
*/
int
-TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
- Interp *iPtr; /* Interpreter containing variable. */
- register Var *arrayPtr; /* Pointer to array variable that contains the
+TclObjCallVarTraces(
+ Interp *iPtr, /* Interpreter containing variable. */
+ register Var *arrayPtr, /* Pointer to array variable that contains the
+ * variable, or NULL if the variable isn't an
+ * element of an array. */
+ Var *varPtr, /* Variable whose traces are to be invoked. */
+ Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, /* Variable's two-part name. */
+ int flags, /* Flags passed to trace functions: indicates
+ * what's happening to variable, plus maybe
+ * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
+ int leaveErrMsg, /* If true, and one of the traces indicates an
+ * error, then leave an error message and
+ * stack trace information in *iPTr. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
+{
+ const char *part1, *part2;
+
+ if (!part1Ptr) {
+ part1Ptr = localName(iPtr->varFramePtr, index);
+ }
+ part1 = TclGetString(part1Ptr);
+ part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
+
+ return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
+ leaveErrMsg);
+}
+
+int
+TclCallVarTraces(
+ Interp *iPtr, /* Interpreter containing variable. */
+ register Var *arrayPtr, /* Pointer to array variable that contains the
* variable, or NULL if the variable isn't an
* element of an array. */
- Var *varPtr; /* Variable whose traces are to be invoked. */
- CONST char *part1;
- CONST char *part2; /* Variable's two-part name. */
- int flags; /* Flags passed to trace functions: indicates
- * what's happening to variable, plus other
- * stuff like TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, and
- * TCL_INTERP_DESTROYED. */
- int leaveErrMsg; /* If true, and one of the traces indicates an
+ Var *varPtr, /* Variable whose traces are to be invoked. */
+ const char *part1,
+ const char *part2, /* Variable's two-part name. */
+ int flags, /* Flags passed to trace functions: indicates
+ * what's happening to variable, plus maybe
+ * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
+ int leaveErrMsg) /* If true, and one of the traces indicates an
* error, then leave an error message and
* stack trace information in *iPTr. */
{
register VarTrace *tracePtr;
ActiveVarTrace active;
char *result;
- CONST char *openParen, *p;
+ const char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
int disposeFlags = 0;
Tcl_InterpState state = NULL;
+ Tcl_HashEntry *hPtr;
+ int traceflags = flags & VAR_ALL_TRACES;
/*
* If there are already similar trace functions active for the variable,
@@ -2456,9 +2555,11 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
return code;
}
TclSetVarTraceActive(varPtr);
- varPtr->refCount++;
- if (arrayPtr != NULL) {
- arrayPtr->refCount++;
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)++;
}
/*
@@ -2483,7 +2584,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
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;
@@ -2496,26 +2597,38 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
}
/*
+ * Ignore any caller-provided TCL_INTERP_DESTROYED flag. Only we can
+ * set it correctly.
+ */
+
+ flags &= ~TCL_INTERP_DESTROYED;
+
+ /*
* Invoke traces on the array containing the variable, if relevant.
*/
result = NULL;
active.nextPtr = iPtr->activeVarTracePtr;
iPtr->activeVarTracePtr = &active;
- Tcl_Preserve((ClientData) iPtr);
- if (arrayPtr != NULL && !TclIsVarTraceActive(arrayPtr)) {
+ Tcl_Preserve(iPtr);
+ if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
+ && (arrayPtr->flags & traceflags)) {
+ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
active.varPtr = arrayPtr;
- for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
+ for (tracePtr = Tcl_GetHashValue(hPtr);
+ tracePtr != NULL; tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
if (!(tracePtr->flags & flags)) {
continue;
}
- Tcl_Preserve((ClientData) tracePtr);
+ Tcl_Preserve(tracePtr);
if (state == NULL) {
- state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+ state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
}
- result = (*tracePtr->traceProc)(tracePtr->clientData,
+ if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
+ flags |= TCL_INTERP_DESTROYED;
+ }
+ result = tracePtr->traceProc(tracePtr->clientData,
(Tcl_Interp *) iPtr, part1, part2, flags);
if (result != NULL) {
if (flags & TCL_TRACE_UNSETS) {
@@ -2529,7 +2642,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
code = TCL_ERROR;
}
}
- Tcl_Release((ClientData) tracePtr);
+ Tcl_Release(tracePtr);
if (code == TCL_ERROR) {
goto done;
}
@@ -2544,33 +2657,39 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
flags |= TCL_TRACE_DESTROYED;
}
active.varPtr = varPtr;
- for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
- active.nextTracePtr = tracePtr->nextPtr;
- if (!(tracePtr->flags & flags)) {
- continue;
- }
- Tcl_Preserve((ClientData) tracePtr);
- if (state == NULL) {
- state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
- }
- result = (*tracePtr->traceProc)(tracePtr->clientData,
- (Tcl_Interp *) iPtr, part1, part2, flags);
- if (result != NULL) {
- if (flags & TCL_TRACE_UNSETS) {
- /*
- * Ignore errors in unset traces.
- */
+ if (varPtr->flags & traceflags) {
+ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+ for (tracePtr = Tcl_GetHashValue(hPtr);
+ tracePtr != NULL; tracePtr = active.nextTracePtr) {
+ active.nextTracePtr = tracePtr->nextPtr;
+ if (!(tracePtr->flags & flags)) {
+ continue;
+ }
+ Tcl_Preserve(tracePtr);
+ if (state == NULL) {
+ state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
+ }
+ if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
+ flags |= TCL_INTERP_DESTROYED;
+ }
+ result = tracePtr->traceProc(tracePtr->clientData,
+ (Tcl_Interp *) iPtr, part1, part2, flags);
+ if (result != NULL) {
+ if (flags & TCL_TRACE_UNSETS) {
+ /*
+ * Ignore errors in unset traces.
+ */
- DisposeTraceResult(tracePtr->flags, result);
- } else {
- disposeFlags = tracePtr->flags;
- code = TCL_ERROR;
+ DisposeTraceResult(tracePtr->flags, result);
+ } else {
+ disposeFlags = tracePtr->flags;
+ code = TCL_ERROR;
+ }
+ }
+ Tcl_Release(tracePtr);
+ if (code == TCL_ERROR) {
+ goto done;
}
- }
- Tcl_Release((ClientData) tracePtr);
- if (code == TCL_ERROR) {
- goto done;
}
}
@@ -2582,77 +2701,68 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
done:
if (code == TCL_ERROR) {
if (leaveErrMsg) {
- CONST char *type = "";
- Tcl_Obj *options = Tcl_GetReturnOptions((Tcl_Interp *)iPtr, code);
- Tcl_Obj *errorInfoKey = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *errorInfo;
-
- Tcl_IncrRefCount(errorInfoKey);
- Tcl_DictObjGet(NULL, options, errorInfoKey, &errorInfo);
- Tcl_IncrRefCount(errorInfo);
- Tcl_DictObjRemove(NULL, options, errorInfoKey);
- if (Tcl_IsShared(errorInfo)) {
- Tcl_DecrRefCount(errorInfo);
- errorInfo = Tcl_DuplicateObj(errorInfo);
- Tcl_IncrRefCount(errorInfo);
- }
- Tcl_AppendToObj(errorInfo, "\n (", -1);
+ const char *verb = "";
+ const char *type = "";
+
switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
case TCL_TRACE_READS:
- type = "read";
- Tcl_AppendToObj(errorInfo, type, -1);
+ verb = "read";
+ type = verb;
break;
case TCL_TRACE_WRITES:
- type = "set";
- Tcl_AppendToObj(errorInfo, "write", -1);
+ verb = "set";
+ type = "write";
break;
case TCL_TRACE_ARRAY:
- type = "trace array";
- Tcl_AppendToObj(errorInfo, "array", -1);
+ verb = "trace array";
+ type = "array";
break;
}
+
if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
- TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
+ Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
+ } else {
+ Tcl_SetObjResult((Tcl_Interp *)iPtr,
+ Tcl_NewStringObj(result, -1));
+ }
+ Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
+
+ Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf(
+ "\n (%s trace on \"%s%s%s%s\")", type, part1,
+ (part2 ? "(" : ""), (part2 ? part2 : ""),
+ (part2 ? ")" : "") ));
+ if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
+ TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb,
Tcl_GetString((Tcl_Obj *) result));
} else {
- TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result);
- }
- Tcl_AppendToObj(errorInfo, " trace on \"", -1);
- Tcl_AppendToObj(errorInfo, part1, -1);
- if (part2 != NULL) {
- Tcl_AppendToObj(errorInfo, "(", -1);
- Tcl_AppendToObj(errorInfo, part1, -1);
- Tcl_AppendToObj(errorInfo, ")", -1);
- }
- Tcl_AppendToObj(errorInfo, "\")", -1);
- Tcl_DictObjPut(NULL, options, errorInfoKey, errorInfo);
- Tcl_DecrRefCount(errorInfoKey);
- Tcl_DecrRefCount(errorInfo);
- code = Tcl_SetReturnOptions((Tcl_Interp *)iPtr, options);
+ TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result);
+ }
iPtr->flags &= ~(ERR_ALREADY_LOGGED);
Tcl_DiscardInterpState(state);
} else {
- (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+ Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
}
DisposeTraceResult(disposeFlags,result);
} else if (state) {
if (code == TCL_OK) {
- code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+ code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
} else {
Tcl_DiscardInterpState(state);
}
}
- if (arrayPtr != NULL) {
- arrayPtr->refCount--;
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)--;
}
if (copiedName) {
Tcl_DStringFree(&nameCopy);
}
TclClearVarTraceActive(varPtr);
- varPtr->refCount--;
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
iPtr->activeVarTracePtr = active.nextPtr;
- Tcl_Release((ClientData) iPtr);
+ Tcl_Release(iPtr);
return code;
}
@@ -2675,10 +2785,10 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
*/
static void
-DisposeTraceResult(flags, result)
- int flags; /* Indicates type of result to determine
+DisposeTraceResult(
+ int flags, /* Indicates type of result to determine
* proper disposal method. */
- char *result; /* The result returned from a trace function
+ char *result) /* The result returned from a trace function
* to be disposed. */
{
if (flags & TCL_TRACE_RESULT_DYNAMIC) {
@@ -2705,19 +2815,20 @@ DisposeTraceResult(flags, result)
*----------------------------------------------------------------------
*/
+#undef Tcl_UntraceVar
void
-Tcl_UntraceVar(interp, varName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+Tcl_UntraceVar(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed collection of bits describing current
+ int flags, /* OR-ed collection of bits describing current
* trace, including any of TCL_TRACE_READS,
* TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
* TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
+ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
}
/*
@@ -2738,25 +2849,26 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
*/
void
-Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *part1; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+Tcl_UntraceVar2(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *part1, /* Name of variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed collection of bits describing current
+ int flags, /* OR-ed collection of bits describing current
* trace, including any of TCL_TRACE_READS,
* TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
* TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register VarTrace *tracePtr;
- VarTrace *prevPtr;
+ VarTrace *prevPtr, *nextPtr;
Var *varPtr, *arrayPtr;
Interp *iPtr = (Interp *) interp;
ActiveVarTrace *activePtr;
- int flagMask;
+ int flagMask, allFlags = 0;
+ Tcl_HashEntry *hPtr;
/*
* Set up a mask to mask out the parts of the flags that we are not
@@ -2764,10 +2876,9 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*/
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
- varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
- /*msg*/ (char *) NULL,
+ varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- if (varPtr == NULL) {
+ if (varPtr == NULL || !(varPtr->flags & VAR_ALL_TRACES & flags)) {
return;
}
@@ -2782,21 +2893,34 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
flagMask |= TCL_TRACE_OLD_STYLE;
#endif
flags &= flagMask;
- for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
+
+ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+ for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
- return;
+ goto updateFlags;
}
if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
&& (tracePtr->clientData == clientData)) {
break;
}
+ allFlags |= tracePtr->flags;
}
/*
* 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;
@@ -2805,20 +2929,35 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
activePtr->nextTracePtr = tracePtr->nextPtr;
}
}
+ nextPtr = tracePtr->nextPtr;
if (prevPtr == NULL) {
- varPtr->tracePtr = tracePtr->nextPtr;
+ if (nextPtr) {
+ Tcl_SetHashValue(hPtr, nextPtr);
+ } else {
+ Tcl_DeleteHashEntry(hPtr);
+ }
} else {
- prevPtr->nextPtr = tracePtr->nextPtr;
+ prevPtr->nextPtr = nextPtr;
}
- Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+ tracePtr->nextPtr = NULL;
+ Tcl_EventuallyFree(tracePtr, TCL_DYNAMIC);
- /*
- * If this is the last trace on the variable, and the variable is unset
- * and unused, then free up the variable.
- */
+ for (tracePtr = nextPtr; tracePtr != NULL;
+ tracePtr = tracePtr->nextPtr) {
+ allFlags |= tracePtr->flags;
+ }
- if (TclIsVarUndefined(varPtr)) {
- TclCleanupVar(varPtr, (Var *) NULL);
+ updateFlags:
+ varPtr->flags &= ~VAR_ALL_TRACES;
+ if (allFlags & VAR_ALL_TRACES) {
+ varPtr->flags |= (allFlags & VAR_ALL_TRACES);
+ } else if (TclIsVarUndefined(varPtr)) {
+ /*
+ * If this is the last trace on the variable, and the variable is
+ * unset and unused, then free up the variable.
+ */
+
+ TclCleanupVar(varPtr, NULL);
}
}
@@ -2845,21 +2984,22 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*----------------------------------------------------------------------
*/
+#undef Tcl_VarTraceInfo
ClientData
-Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+Tcl_VarTraceInfo(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
+ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
{
- return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
- flags, proc, prevClientData);
+ return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
+ prevClientData);
}
/*
@@ -2880,26 +3020,26 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
*/
ClientData
-Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *part1; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+Tcl_VarTraceInfo2(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *part1, /* Name of variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
{
- register VarTrace *tracePtr;
+ Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
+ Tcl_HashEntry *hPtr;
varPtr = TclLookupVar(interp, part1, part2,
- flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
- /*msg*/ (char *) NULL,
+ flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return NULL;
@@ -2909,19 +3049,24 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
* Find the relevant trace, if any, and return its clientData.
*/
- tracePtr = varPtr->tracePtr;
- if (prevClientData != NULL) {
- for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
- if ((tracePtr->clientData == prevClientData)
- && (tracePtr->traceProc == proc)) {
- tracePtr = tracePtr->nextPtr;
- break;
+ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+
+ if (hPtr) {
+ register VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
+
+ if (prevClientData != NULL) {
+ for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+ if ((tracePtr->clientData == prevClientData)
+ && (tracePtr->traceProc == proc)) {
+ tracePtr = tracePtr->nextPtr;
+ break;
+ }
}
}
- }
- for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
- if (tracePtr->traceProc == proc) {
- return tracePtr->clientData;
+ for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) {
+ if (tracePtr->traceProc == proc) {
+ return tracePtr->clientData;
+ }
}
}
return NULL;
@@ -2943,26 +3088,27 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
* A trace is set up on the variable given by varName, such that future
* references to the variable will be intermediated by proc. See the
* manual entry for complete details on the calling sequence for proc.
+ * The variable's flags are updated.
*
*----------------------------------------------------------------------
*/
+#undef Tcl_TraceVar
int
-Tcl_TraceVar(interp, varName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is to be
+Tcl_TraceVar(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed collection of bits, including any of
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function to call when specified ops are
+ Tcl_VarTraceProc *proc, /* Function to call when specified ops are
* invoked upon varName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- return Tcl_TraceVar2(interp, varName, (char *) NULL,
- flags, proc, clientData);
+ return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
}
/*
@@ -2981,30 +3127,83 @@ Tcl_TraceVar(interp, varName, flags, proc, clientData)
* A trace is set up on the variable given by part1 and part2, such that
* future references to the variable will be intermediated by proc. See
* the manual entry for complete details on the calling sequence for
- * proc.
+ * proc. The variable's flags are updated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is to be
+Tcl_TraceVar2(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *part1; /* Name of scalar variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+ const char *part1, /* Name of scalar variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed collection of bits, including any of
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function to call when specified ops are
+ Tcl_VarTraceProc *proc, /* Function to call when specified ops are
* invoked upon varName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- Var *varPtr, *arrayPtr;
register VarTrace *tracePtr;
- int flagMask;
+ int result;
+
+ tracePtr = ckalloc(sizeof(VarTrace));
+ tracePtr->traceProc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->flags = flags;
+
+ result = TraceVarEx(interp, part1, part2, tracePtr);
+
+ if (result != TCL_OK) {
+ ckfree(tracePtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarEx --
+ *
+ * Arrange for reads and/or writes to a variable to cause a function to
+ * be invoked, which can monitor the operations and/or change their
+ * actions.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * A trace is set up on the variable given by part1 and part2, such that
+ * future references to the variable will be intermediated by the
+ * traceProc listed in tracePtr. See the manual entry for complete
+ * details on the calling sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceVarEx(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
+ * traced. */
+ const char *part1, /* Name of scalar variable or array. */
+ const char *part2, /* Name of element within array; NULL means
+ * trace applies to scalar variable or array
+ * as-a-whole. */
+ register VarTrace *tracePtr)/* Structure containing flags, traceProc and
+ * clientData fields. Others should be left
+ * blank. Will be ckfree()d (eventually) if
+ * this function returns TCL_OK, and up to
+ * caller to free if this function returns
+ * TCL_ERROR. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ int flagMask, isNew;
+ Tcl_HashEntry *hPtr;
/*
* We strip 'flags' down to just the parts which are relevant to
@@ -3015,7 +3214,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
varPtr = TclLookupVar(interp, part1, part2,
- (flags & flagMask) | TCL_LEAVE_ERR_MSG,
+ (tracePtr->flags & flagMask) | TCL_LEAVE_ERR_MSG,
"trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return TCL_ERROR;
@@ -3026,7 +3225,8 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
* because there should be no code path that ever sets both flags.
*/
- if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
+ if ((tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC)
+ && (tracePtr->flags & TCL_TRACE_RESULT_OBJECT)) {
Tcl_Panic("bad result flag combination");
}
@@ -3039,13 +3239,22 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
#ifndef TCL_REMOVE_OBSOLETE_TRACES
flagMask |= TCL_TRACE_OLD_STYLE;
#endif
- tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
- tracePtr->traceProc = proc;
- tracePtr->clientData = clientData;
- tracePtr->flags = flags & flagMask;
- tracePtr->nextPtr = varPtr->tracePtr;
+ tracePtr->flags = tracePtr->flags & flagMask;
+
+ hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
+ if (isNew) {
+ tracePtr->nextPtr = NULL;
+ } else {
+ tracePtr->nextPtr = Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, tracePtr);
+
+ /*
+ * Mark the variable as traced so we know to call them.
+ */
+
+ varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);
- varPtr->tracePtr = tracePtr;
return TCL_OK;
}
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index cf3dbdb..a0d4ccc 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.4 2001/05/28 04:45:43 hobbs 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[] = {
- 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, 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,
- 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,
- 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,
- 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, 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,
- 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, 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,
- 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,
- 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, 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, 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, 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, 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, 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, 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,
- 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,
- 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, 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, 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,
- 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,
- 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, 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, 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,
- 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, 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
+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, 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, 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, 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, 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, 17,
+ 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,
+ 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, 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, 17, 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, 86, 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, 17, 17, 17, 17, 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, 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, 7, 7, 7, 7, 7, 14, 14,
+ 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 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, 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, 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, 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, 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, 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, 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, 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,
+ 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, 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, 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,
+ 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, 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, 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, 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,
+ 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
+#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -814,44 +1346,47 @@ static unsigned char groupMap[] = {
* Bits 5-7 Case delta type: 000 = identity
* 010 = add delta for lower
* 011 = add delta for lower, add 1 for title
- * 100 = sutract delta for title/upper
+ * 100 = subtract delta for title/upper
* 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 992a55f..15529c7 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.36 2005/09/07 15:31:10 dgp Exp $
*/
#include "tclInt.h"
@@ -23,46 +21,45 @@
* The following macros are used for fast character category tests. The x_BITS
* values are shifted right by the category value to determine whether the
* given category is included in the set.
- */
+ */
#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.
+ * Unicode characters less than this value are represented by themselves in
+ * UTF-8 strings.
*/
#define UNICODE_SELF 0x80
/*
- * The following structures are used when mapping between Unicode (UCS-2)
- * and UTF-8.
+ * The following structures are used when mapping between Unicode (UCS-2) and
+ * UTF-8.
*/
-static CONST unsigned char totalBytes[256] = {
+static const unsigned char totalBytes[256] = {
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,
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,
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,
@@ -89,10 +86,10 @@ static CONST unsigned char totalBytes[256] = {
};
/*
- * Procedures used only in this module.
+ * Functions used only in this module.
*/
-static int UtfCount _ANSI_ARGS_((int ch));
+static int UtfCount(int ch);
/*
*---------------------------------------------------------------------------
@@ -109,10 +106,10 @@ static int UtfCount _ANSI_ARGS_((int ch));
*
*---------------------------------------------------------------------------
*/
-
+
INLINE static int
-UtfCount(ch)
- int ch; /* The Tcl_UniChar whose size is returned. */
+UtfCount(
+ int ch) /* The Tcl_UniChar whose size is returned. */
{
if ((ch > 0) && (ch < UNICODE_SELF)) {
return 1;
@@ -154,12 +151,12 @@ UtfCount(ch)
*
*---------------------------------------------------------------------------
*/
-
+
INLINE int
-Tcl_UniCharToUtf(ch, buf)
- int ch; /* The Tcl_UniChar to be stored in the
+Tcl_UniCharToUtf(
+ int ch, /* The Tcl_UniChar to be stored in the
* buffer. */
- char *buf; /* Buffer in which the UTF-8 representation of
+ char *buf) /* Buffer in which the UTF-8 representation of
* the Tcl_UniChar is stored. Buffer must be
* large enough to hold the UTF-8 character
* (at most TCL_UTF_MAX bytes). */
@@ -231,16 +228,16 @@ Tcl_UniCharToUtf(ch, buf)
*
*---------------------------------------------------------------------------
*/
-
+
char *
-Tcl_UniCharToUtfDString(uniStr, uniLength, dsPtr)
- CONST Tcl_UniChar *uniStr; /* Unicode string to convert to UTF-8. */
- int uniLength; /* Length of Unicode string in Tcl_UniChars
+Tcl_UniCharToUtfDString(
+ const Tcl_UniChar *uniStr, /* Unicode string to convert to UTF-8. */
+ int uniLength, /* Length of Unicode string in Tcl_UniChars
* (must be >= 0). */
- Tcl_DString *dsPtr; /* UTF-8 representation of string is appended
+ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended
* to this previously initialized DString. */
{
- CONST Tcl_UniChar *w, *wEnd;
+ const Tcl_UniChar *w, *wEnd;
char *p, *string;
int oldLength;
@@ -289,15 +286,15 @@ Tcl_UniCharToUtfDString(uniStr, uniLength, dsPtr)
*
*---------------------------------------------------------------------------
*/
-
+
int
-Tcl_UtfToUniChar(src, chPtr)
- register CONST char *src; /* The UTF-8 string. */
- register Tcl_UniChar *chPtr; /* Filled with the Tcl_UniChar represented by
- * the UTF-8 string. */
+Tcl_UtfToUniChar(
+ register const char *src, /* The UTF-8 string. */
+ register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
+ * the UTF-8 string. */
{
register int byte;
-
+
/*
* Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
*/
@@ -335,7 +332,7 @@ Tcl_UtfToUniChar(src, chPtr)
* Three-byte-character lead byte followed by two trail bytes.
*/
- *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
+ *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
| ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
return 3;
}
@@ -349,7 +346,7 @@ Tcl_UtfToUniChar(src, chPtr)
return 1;
}
#if TCL_UTF_MAX > 3
- else {
+ {
int ch, total, trail;
total = totalBytes[byte];
@@ -395,16 +392,16 @@ Tcl_UtfToUniChar(src, chPtr)
*/
Tcl_UniChar *
-Tcl_UtfToUniCharDString(src, length, dsPtr)
- CONST char *src; /* UTF-8 string to convert to Unicode. */
- int length; /* Length of UTF-8 string in bytes, or -1 for
+Tcl_UtfToUniCharDString(
+ const char *src, /* UTF-8 string to convert to Unicode. */
+ int length, /* Length of UTF-8 string in bytes, or -1 for
* strlen(). */
- Tcl_DString *dsPtr; /* Unicode representation of string is
+ Tcl_DString *dsPtr) /* Unicode representation of string is
* appended to this previously initialized
* DString. */
{
Tcl_UniChar *w, *wString;
- CONST char *p, *end;
+ const char *p, *end;
int oldLength;
if (length < 0) {
@@ -417,6 +414,7 @@ Tcl_UtfToUniCharDString(src, length, dsPtr)
*/
oldLength = Tcl_DStringLength(dsPtr);
+/* TODO: fix overreach! */
Tcl_DStringSetLength(dsPtr,
(int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
@@ -454,10 +452,10 @@ Tcl_UtfToUniCharDString(src, length, dsPtr)
*/
int
-Tcl_UtfCharComplete(src, length)
- CONST char *src; /* String to check if first few bytes contain
+Tcl_UtfCharComplete(
+ const char *src, /* String to check if first few bytes contain
* a complete UTF-8 character. */
- int length; /* Length of above string in bytes. */
+ int length) /* Length of above string in bytes. */
{
int ch;
@@ -475,18 +473,18 @@ Tcl_UtfCharComplete(src, length)
* utflen() and utfnlen().
*
* Results:
- * As above.
+ * As above.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
-
-int
-Tcl_NumUtfChars(src, length)
- register CONST char *src; /* The UTF-8 string to measure. */
- int length; /* The length of the string in bytes, or -1
+
+int
+Tcl_NumUtfChars(
+ register const char *src, /* The UTF-8 string to measure. */
+ int length) /* The length of the string in bytes, or -1
* for strlen(string). */
{
Tcl_UniChar ch;
@@ -542,14 +540,15 @@ Tcl_NumUtfChars(src, length)
*
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_UtfFindFirst(src, ch)
- CONST char *src; /* The UTF-8 string to be searched. */
- int ch; /* The Tcl_UniChar to search for. */
+
+const char *
+Tcl_UtfFindFirst(
+ const char *src, /* The UTF-8 string to be searched. */
+ int ch) /* The Tcl_UniChar to search for. */
{
int len;
Tcl_UniChar find;
-
+
while (1) {
len = TclUtfToUniChar(src, &find);
if (find == ch) {
@@ -581,15 +580,15 @@ Tcl_UtfFindFirst(src, ch)
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_UtfFindLast(src, ch)
- CONST char *src; /* The UTF-8 string to be searched. */
- int ch; /* The Tcl_UniChar to search for. */
+const char *
+Tcl_UtfFindLast(
+ const char *src, /* The UTF-8 string to be searched. */
+ int ch) /* The Tcl_UniChar to search for. */
{
int len;
Tcl_UniChar find;
- CONST char *last;
-
+ const char *last;
+
last = NULL;
while (1) {
len = TclUtfToUniChar(src, &find);
@@ -622,10 +621,10 @@ Tcl_UtfFindLast(src, ch)
*
*---------------------------------------------------------------------------
*/
-
-CONST char *
-Tcl_UtfNext(src)
- CONST char *src; /* The current location in the string. */
+
+const char *
+Tcl_UtfNext(
+ const char *src) /* The current location in the string. */
{
Tcl_UniChar ch;
@@ -653,15 +652,15 @@ Tcl_UtfNext(src)
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_UtfPrev(src, start)
- CONST char *src; /* The current location in the string. */
- CONST char *start; /* Pointer to the beginning of the string, to
+const char *
+Tcl_UtfPrev(
+ const char *src, /* The current location in the string. */
+ const char *start) /* Pointer to the beginning of the string, to
* avoid going backwards too far. */
{
- CONST char *look;
+ const char *look;
int i, byte;
-
+
src--;
look = src;
for (i = 0; i < TCL_UTF_MAX; i++) {
@@ -682,7 +681,7 @@ Tcl_UtfPrev(src, start)
}
return src;
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -699,13 +698,13 @@ Tcl_UtfPrev(src, start)
*
*---------------------------------------------------------------------------
*/
-
+
Tcl_UniChar
-Tcl_UniCharAtIndex(src, index)
- register CONST char *src; /* The UTF-8 string to dereference. */
- register int index; /* The position of the desired character. */
+Tcl_UniCharAtIndex(
+ register const char *src, /* The UTF-8 string to dereference. */
+ register int index) /* The position of the desired character. */
{
- Tcl_UniChar ch;
+ Tcl_UniChar ch = 0;
while (index >= 0) {
index--;
@@ -731,13 +730,13 @@ Tcl_UniCharAtIndex(src, index)
*---------------------------------------------------------------------------
*/
-CONST char *
-Tcl_UtfAtIndex(src, index)
- register CONST char *src; /* The UTF-8 string. */
- register int index; /* The position of the desired character. */
+const char *
+Tcl_UtfAtIndex(
+ register const char *src, /* The UTF-8 string. */
+ register int index) /* The position of the desired character. */
{
Tcl_UniChar ch;
-
+
while (index > 0) {
index--;
src += TclUtfToUniChar(src, &ch);
@@ -772,12 +771,12 @@ Tcl_UtfAtIndex(src, index)
*/
int
-Tcl_UtfBackslash(src, readPtr, dst)
- CONST char *src; /* Points to the backslash character of a
+Tcl_UtfBackslash(
+ const char *src, /* Points to the backslash character of a
* backslash sequence. */
- int *readPtr; /* Fill in with number of characters read from
+ int *readPtr, /* Fill in with number of characters read from
* src, unless NULL. */
- char *dst; /* Filled with the bytes represented by the
+ char *dst) /* Filled with the bytes represented by the
* backslash sequence. */
{
#define LINE_LENGTH 128
@@ -786,7 +785,10 @@ Tcl_UtfBackslash(src, readPtr, dst)
result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
if (numRead == LINE_LENGTH) {
- /* We ate a whole line. Pay the price of a strlen() */
+ /*
+ * We ate a whole line. Pay the price of a strlen()
+ */
+
result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
}
if (readPtr != NULL) {
@@ -814,8 +816,8 @@ Tcl_UtfBackslash(src, readPtr, dst)
*/
int
-Tcl_UtfToUpper(str)
- char *str; /* String to convert in place. */
+Tcl_UtfToUpper(
+ char *str) /* String to convert in place. */
{
Tcl_UniChar ch, upChar;
char *src, *dst;
@@ -835,7 +837,7 @@ Tcl_UtfToUpper(str)
* conversion (thereby causing a segfault), only copy the upper case
* char to dst if its size is <= the original char.
*/
-
+
if (bytes < UtfCount(upChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
@@ -867,13 +869,13 @@ Tcl_UtfToUpper(str)
*/
int
-Tcl_UtfToLower(str)
- char *str; /* String to convert in place. */
+Tcl_UtfToLower(
+ char *str) /* String to convert in place. */
{
Tcl_UniChar ch, lowChar;
char *src, *dst;
int bytes;
-
+
/*
* Iterate over the string until we hit the terminating null.
*/
@@ -888,7 +890,7 @@ Tcl_UtfToLower(str)
* conversion (thereby causing a segfault), only copy the lower case
* char to dst if its size is <= the original char.
*/
-
+
if (bytes < UtfCount(lowChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
@@ -921,13 +923,13 @@ Tcl_UtfToLower(str)
*/
int
-Tcl_UtfToTitle(str)
- char *str; /* String to convert in place. */
+Tcl_UtfToTitle(
+ char *str) /* String to convert in place. */
{
Tcl_UniChar ch, titleChar, lowChar;
char *src, *dst;
int bytes;
-
+
/*
* Capitalize the first character and then lowercase the rest of the
* characters until we get to a null.
@@ -968,8 +970,8 @@ Tcl_UtfToTitle(str)
*
* TclpUtfNcmp2 --
*
- * Compare at most n bytes of utf-8 strings cs and ct. Both cs and ct are
- * assumed to be at least n bytes long.
+ * Compare at most numBytes bytes of utf-8 strings cs and ct. Both cs and
+ * ct are assumed to be at least numBytes bytes long.
*
* Results:
* Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -981,26 +983,26 @@ Tcl_UtfToTitle(str)
*/
int
-TclpUtfNcmp2(cs, ct, n)
- CONST char *cs; /* UTF string to compare to ct. */
- CONST char *ct; /* UTF string cs is compared to. */
- unsigned long n; /* Number of *bytes* to compare. */
+TclpUtfNcmp2(
+ const char *cs, /* UTF string to compare to ct. */
+ const char *ct, /* UTF string cs is compared to. */
+ unsigned long numBytes) /* Number of *bytes* to compare. */
{
/*
- * We can't simply call 'memcmp(cs, ct, n);' because we need to check for
- * Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes fine in
- * the strcmp manner.
+ * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
+ * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
+ * fine in the strcmp manner.
*/
register int result = 0;
- for ( ; n != 0; n--, cs++, ct++) {
+ for ( ; numBytes != 0; numBytes--, cs++, ct++) {
if (*cs != *ct) {
result = UCHAR(*cs) - UCHAR(*ct);
break;
}
}
- if (n && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
+ if (numBytes && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
unsigned char c1, c2;
c1 = ((UCHAR(*cs) == 0xC0) && (UCHAR(cs[1]) == 0x80)) ? 0 : UCHAR(*cs);
@@ -1028,10 +1030,10 @@ TclpUtfNcmp2(cs, ct, n)
*/
int
-Tcl_UtfNcmp(cs, ct, numChars)
- CONST char *cs; /* UTF string to compare to ct. */
- CONST char *ct; /* UTF string cs is compared to. */
- unsigned long numChars; /* Number of UTF chars to compare. */
+Tcl_UtfNcmp(
+ const char *cs, /* UTF string to compare to ct. */
+ const char *ct, /* UTF string cs is compared to. */
+ unsigned long numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
@@ -1063,8 +1065,8 @@ Tcl_UtfNcmp(cs, ct, numChars)
* Tcl_UtfNcasecmp --
*
* Compare at most numChars UTF chars of string cs to string ct case
- * insensitive. Both cs and ct are assumed to be at least numChars
- * UTF chars long.
+ * insensitive. Both cs and ct are assumed to be at least numChars UTF
+ * chars long.
*
* Results:
* Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -1076,10 +1078,10 @@ Tcl_UtfNcmp(cs, ct, numChars)
*/
int
-Tcl_UtfNcasecmp(cs, ct, numChars)
- CONST char *cs; /* UTF string to compare to ct. */
- CONST char *ct; /* UTF string cs is compared to. */
- unsigned long numChars; /* Number of UTF chars to compare. */
+Tcl_UtfNcasecmp(
+ const char *cs, /* UTF string to compare to ct. */
+ const char *ct, /* UTF string cs is compared to. */
+ unsigned long numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
while (numChars-- > 0) {
@@ -1104,6 +1106,46 @@ Tcl_UtfNcasecmp(cs, ct, numChars)
/*
*----------------------------------------------------------------------
*
+ * Tcl_UtfNcasecmp --
+ *
+ * Compare UTF chars of string cs to string ct case insensitively.
+ * Replacement for strcasecmp in Tcl core, in places where UTF-8 should
+ * be handled.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUtfCasecmp(
+ const char *cs, /* UTF string to compare to ct. */
+ const char *ct) /* UTF string cs is compared to. */
+{
+ while (*cs && *ct) {
+ Tcl_UniChar ch1, ch2;
+
+ cs += TclUtfToUniChar(cs, &ch1);
+ ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ ch2 = Tcl_UniCharToLower(ch2);
+ if (ch1 != ch2) {
+ return ch1 - ch2;
+ }
+ }
+ }
+ return UCHAR(*cs) - UCHAR(*ct);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_UniCharToUpper --
*
* Compute the uppercase equivalent of the given Unicode character.
@@ -1118,16 +1160,15 @@ Tcl_UtfNcasecmp(cs, ct, numChars)
*/
Tcl_UniChar
-Tcl_UniCharToUpper(ch)
- int ch; /* Unicode character to convert. */
+Tcl_UniCharToUpper(
+ int ch) /* Unicode character to convert. */
{
int info = GetUniCharInfo(ch);
if (GetCaseType(info) & 0x04) {
- return (Tcl_UniChar) (ch - GetDelta(info));
- } else {
- return ch;
+ ch -= GetDelta(info);
}
+ return (Tcl_UniChar) ch;
}
/*
@@ -1147,16 +1188,15 @@ Tcl_UniCharToUpper(ch)
*/
Tcl_UniChar
-Tcl_UniCharToLower(ch)
- int ch; /* Unicode character to convert. */
+Tcl_UniCharToLower(
+ int ch) /* Unicode character to convert. */
{
int info = GetUniCharInfo(ch);
if (GetCaseType(info) & 0x02) {
- return (Tcl_UniChar) (ch + GetDelta(info));
- } else {
- return ch;
+ ch += GetDelta(info);
}
+ return (Tcl_UniChar) ch;
}
/*
@@ -1176,8 +1216,8 @@ Tcl_UniCharToLower(ch)
*/
Tcl_UniChar
-Tcl_UniCharToTitle(ch)
- int ch; /* Unicode character to convert. */
+Tcl_UniCharToTitle(
+ int ch) /* Unicode character to convert. */
{
int info = GetUniCharInfo(ch);
int mode = GetCaseType(info);
@@ -1187,12 +1227,11 @@ Tcl_UniCharToTitle(ch)
* 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;
}
/*
@@ -1200,7 +1239,7 @@ Tcl_UniCharToTitle(ch)
*
* Tcl_UniCharLen --
*
- * Find the length of a UniChar string. The str input must be null
+ * Find the length of a UniChar string. The str input must be null
* terminated.
*
* Results:
@@ -1213,11 +1252,11 @@ Tcl_UniCharToTitle(ch)
*/
int
-Tcl_UniCharLen(uniStr)
- CONST Tcl_UniChar *uniStr; /* Unicode string to find length of. */
+Tcl_UniCharLen(
+ const Tcl_UniChar *uniStr) /* Unicode string to find length of. */
{
int len = 0;
-
+
while (*uniStr != '\0') {
len++;
uniStr++;
@@ -1243,10 +1282,10 @@ Tcl_UniCharLen(uniStr)
*/
int
-Tcl_UniCharNcmp(ucs, uct, numChars)
- CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */
- CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */
- unsigned long numChars; /* Number of unichars to compare. */
+Tcl_UniCharNcmp(
+ const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
+ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
+ unsigned long numChars) /* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
/*
@@ -1275,7 +1314,7 @@ Tcl_UniCharNcmp(ucs, uct, numChars)
* Tcl_UniCharNcasecmp --
*
* Compare at most numChars unichars of string ucs to string uct case
- * insensitive. Both ucs and uct are assumed to be at least numChars
+ * insensitive. Both ucs and uct are assumed to be at least numChars
* unichars long.
*
* Results:
@@ -1288,15 +1327,16 @@ Tcl_UniCharNcmp(ucs, uct, numChars)
*/
int
-Tcl_UniCharNcasecmp(ucs, uct, numChars)
- CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */
- CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */
- unsigned long numChars; /* Number of unichars to compare. */
+Tcl_UniCharNcasecmp(
+ const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
+ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
+ unsigned long numChars) /* Number of unichars to compare. */
{
for ( ; numChars != 0; numChars--, ucs++, uct++) {
if (*ucs != *uct) {
Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
+
if (lcs != lct) {
return (lcs - lct);
}
@@ -1322,12 +1362,10 @@ Tcl_UniCharNcasecmp(ucs, uct, numChars)
*/
int
-Tcl_UniCharIsAlnum(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1347,11 +1385,10 @@ Tcl_UniCharIsAlnum(ch)
*/
int
-Tcl_UniCharIsAlpha(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1371,10 +1408,10 @@ Tcl_UniCharIsAlpha(ch)
*/
int
-Tcl_UniCharIsControl(ch)
- int ch; /* Unicode character to test. */
+Tcl_UniCharIsControl(
+ int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL);
+ return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}
/*
@@ -1394,11 +1431,10 @@ Tcl_UniCharIsControl(ch)
*/
int
-Tcl_UniCharIsDigit(ch)
- int ch; /* Unicode character to test. */
+Tcl_UniCharIsDigit(
+ int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
- == DECIMAL_DIGIT_NUMBER);
+ return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}
/*
@@ -1418,11 +1454,10 @@ Tcl_UniCharIsDigit(ch)
*/
int
-Tcl_UniCharIsGraph(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1442,10 +1477,10 @@ Tcl_UniCharIsGraph(ch)
*/
int
-Tcl_UniCharIsLower(ch)
- int ch; /* Unicode character to test. */
+Tcl_UniCharIsLower(
+ int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
+ return (GetCategory(ch) == LOWERCASE_LETTER);
}
/*
@@ -1465,11 +1500,10 @@ Tcl_UniCharIsLower(ch)
*/
int
-Tcl_UniCharIsPrint(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1489,11 +1523,10 @@ Tcl_UniCharIsPrint(ch)
*/
int
-Tcl_UniCharIsPunct(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1513,21 +1546,22 @@ Tcl_UniCharIsPunct(ch)
*/
int
-Tcl_UniCharIsSpace(ch)
- int ch; /* Unicode character to test. */
+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) {
- return isspace(UCHAR(ch)); /* INTL: ISO space */
+ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
+ return TclIsSpaceProc((char) ch);
+ } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
+ || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
+ || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
+ return 1;
} else {
- category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
- return ((SPACE_BITS >> category) & 1);
+ return ((SPACE_BITS >> GetCategory(ch)) & 1);
}
}
@@ -1548,10 +1582,10 @@ Tcl_UniCharIsSpace(ch)
*/
int
-Tcl_UniCharIsUpper(ch)
- int ch; /* Unicode character to test. */
+Tcl_UniCharIsUpper(
+ int ch) /* Unicode character to test. */
{
- return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
+ return (GetCategory(ch) == UPPERCASE_LETTER);
}
/*
@@ -1571,12 +1605,10 @@ Tcl_UniCharIsUpper(ch)
*/
int
-Tcl_UniCharIsWordChar(ch)
- int ch; /* Unicode character to test. */
+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);
}
/*
@@ -1603,24 +1635,24 @@ Tcl_UniCharIsWordChar(ch)
*/
int
-Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)
- CONST Tcl_UniChar *uniStr; /* Unicode String. */
- CONST Tcl_UniChar *uniPattern;
+Tcl_UniCharCaseMatch(
+ const Tcl_UniChar *uniStr, /* Unicode String. */
+ const Tcl_UniChar *uniPattern,
/* Pattern, which may contain special
* characters. */
- int nocase; /* 0 for case sensitive, 1 for insensitive */
+ int nocase) /* 0 for case sensitive, 1 for insensitive */
{
Tcl_UniChar ch1, p;
-
+
while (1) {
p = *uniPattern;
-
+
/*
* See if we're at the end of both the pattern and the string. If so,
* we succeeded. If we're at the end of the pattern but not at the end
* of the string, we failed.
*/
-
+
if (p == 0) {
return (*uniStr == 0);
}
@@ -1635,7 +1667,7 @@ Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)
* recursively for each postfix of string, until either we match or we
* reach the end of the string.
*/
-
+
if (p == '*') {
/*
* Skip all successive *'s in the pattern
@@ -1696,7 +1728,7 @@ Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)
* list of characters that are acceptable, or by a range (two
* characters separated by "-").
*/
-
+
if (p == '[') {
Tcl_UniChar startChar, endChar;
@@ -1752,8 +1784,8 @@ Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)
}
/*
- * There's no special character. Just make sure that the next bytes
- * of each string match.
+ * There's no special character. Just make sure that the next bytes of
+ * each string match.
*/
if (nocase) {
@@ -1791,15 +1823,15 @@ Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)
*/
int
-TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
- CONST Tcl_UniChar *string; /* Unicode String. */
- int strLen; /* length of String */
- CONST Tcl_UniChar *pattern; /* Pattern, which may contain special
+TclUniCharMatch(
+ const Tcl_UniChar *string, /* Unicode String. */
+ int strLen, /* Length of String */
+ const Tcl_UniChar *pattern, /* Pattern, which may contain special
* characters. */
- int ptnLen; /* length of Pattern */
- int nocase; /* 0 for case sensitive, 1 for insensitive */
+ int ptnLen, /* Length of Pattern */
+ int nocase) /* 0 for case sensitive, 1 for insensitive */
{
- CONST Tcl_UniChar *stringEnd, *patternEnd;
+ const Tcl_UniChar *stringEnd, *patternEnd;
Tcl_UniChar p;
stringEnd = string + strLen;
@@ -1827,7 +1859,7 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
* recursively for each postfix of string, until either we match or we
* reach the end of the string.
*/
-
+
if (p == '*') {
/*
* Skip all successive *'s in the pattern.
@@ -1889,7 +1921,7 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
* list of characters that are acceptable, or by a range (two
* characters separated by "-").
*/
-
+
if (p == '[') {
Tcl_UniChar ch1, startChar, endChar;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 1dd6fcb..2d00adf 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -6,70 +6,92 @@
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 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: tclUtil.c,v 1.65 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
-#include <float.h>
+#include "tclParse.h"
+#include "tclStringTrim.h"
#include <math.h>
/*
- * Define test for NaN
- */
-
-#ifdef _MSC_VER
-#define IS_NAN(f) (_isnan((f)))
-#else
-#define IS_NAN(f) ((f) != (f))
-#endif
-
-/*
- * Define test for Inf
+ * The absolute pathname of the executable in which this Tcl library is
+ * running.
*/
-#ifdef _MSC_VER
-#define IS_INF(f) ( ! (_finite((f))))
-#else
-#define IS_INF(f) ( (f) > DBL_MAX || (f) < -DBL_MAX )
-#endif
-
-/*
- * The absolute pathname of the executable in which this Tcl library
- * is running.
- */
-static ProcessGlobalValue executableName = {0, 0, NULL, NULL, NULL, NULL, NULL};
+static ProcessGlobalValue executableName = {
+ 0, 0, NULL, NULL, NULL, NULL, NULL
+};
/*
- * 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.
+ * 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
@@ -82,14 +104,13 @@ static Tcl_ThreadDataKey precisionKey;
* Prototypes for functions defined later in this file.
*/
-static void ClearHash _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-static void FreeProcessGlobalValue _ANSI_ARGS_((
- ClientData clientData));
-static void FreeThreadHash _ANSI_ARGS_((ClientData clientData));
-static Tcl_HashTable * GetThreadHash _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr));
-static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj* objPtr));
-static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
+static void ClearHash(Tcl_HashTable *tablePtr);
+static void FreeProcessGlobalValue(ClientData clientData);
+static void FreeThreadHash(ClientData clientData);
+static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
+static int SetEndOffsetFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
/*
* The following is the Tcl object type definition for an object that
@@ -98,14 +119,329 @@ static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
* integer, so no memory management is required for it.
*/
-Tcl_ObjType tclEndOffsetType = {
+const Tcl_ObjType tclEndOffsetType = {
"end-offset", /* name */
- (Tcl_FreeInternalRepProc*) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc*) NULL, /* dupIntRepProc */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
UpdateStringOfEndOffset, /* updateStringProc */
SetEndOffsetFromAny
};
+
+/*
+ * * 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 interpretation 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 sequence 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;
+}
/*
*----------------------------------------------------------------------
@@ -127,13 +463,18 @@ 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.
@@ -142,33 +483,37 @@ Tcl_ObjType tclEndOffsetType = {
*/
int
-TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
- bracePtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. If
+TclFindElement(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
- CONST char *list; /* Points to the first byte of a string
+ const char *list, /* Points to the first byte of a string
* containing a Tcl list with zero or more
* elements (possibly in braces). */
- int listLength; /* Number of bytes in the list's string. */
- CONST char **elementPtr; /* Where to put address of first significant
+ int listLength, /* Number of bytes in the list's string. */
+ const char **elementPtr, /* Where to put address of first significant
* character in first element of list. */
- CONST char **nextPtr; /* Fill in with location of character just
+ const char **nextPtr, /* Fill in with location of character just
* after all white space following end of
* argument (next arg or end of list). */
- int *sizePtr; /* If non-zero, fill in with size of
+ 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. */
- CONST char *limit; /* Points just after list's last byte. */
+ const char *p = list;
+ const char *elemStart; /* Points to first byte of first element. */
+ const char *limit; /* Points just after list's last byte. */
int openBraces = 0; /* Brace nesting level during parse. */
int inQuotes = 0;
int size = 0; /* lint. */
int numChars;
- CONST char *p2;
+ int literal = 1;
+ const char *p2;
/*
* Skim off leading white space and check for an opening brace or quote.
@@ -177,7 +522,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
limit = (list + listLength);
- while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+ while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
if (p == limit) { /* no element found */
@@ -193,9 +538,6 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
p++;
}
elemStart = p;
- if (bracePtr != 0) {
- *bracePtr = openBraces;
- }
/*
* Find element's end (a space, close brace, or the end of the string).
@@ -225,8 +567,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
} else if (openBraces == 1) {
size = (p - elemStart);
p++;
- if ((p >= limit)
- || isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ if ((p >= limit) || TclIsSpaceProc(*p)) {
goto done;
}
@@ -235,17 +576,16 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
- while ((p2 < limit)
- && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
+ while ((p2 < limit) && (!TclIsSpaceProc(*p2))
&& (p2 < p+20)) {
p2++;
}
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list element in braces followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p);
- Tcl_SetObjResult(interp, objPtr);
+ "instead of space", (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ NULL);
}
return TCL_ERROR;
}
@@ -257,7 +597,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
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;
@@ -286,8 +636,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
if (inQuotes) {
size = (p - elemStart);
p++;
- if ((p >= limit)
- || isspace(UCHAR(*p))) { /* INTL: ISO space */
+ if ((p >= limit) || TclIsSpaceProc(*p)) {
goto done;
}
@@ -296,17 +645,16 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
- while ((p2 < limit)
- && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
+ while ((p2 < limit) && (!TclIsSpaceProc(*p2))
&& (p2 < p+20)) {
p2++;
}
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list element in quotes followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p);
- Tcl_SetObjResult(interp, objPtr);
+ "instead of space", (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ NULL);
}
return TCL_ERROR;
}
@@ -322,14 +670,18 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
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;
}
@@ -337,7 +689,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
}
done:
- while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+ while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
*elementPtr = elemStart;
@@ -345,6 +697,9 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
if (sizePtr != 0) {
*sizePtr = size;
}
+ if (literalPtr != 0) {
+ *literalPtr = literal;
+ }
return TCL_OK;
}
@@ -353,14 +708,13 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*
* 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.
@@ -369,27 +723,30 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
int
-TclCopyAndCollapse(count, src, dst)
- int count; /* Number of characters to copy from src. */
- CONST char *src; /* Copy from here... */
- char *dst; /* ... to here. */
+TclCopyAndCollapse(
+ 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;
@@ -425,68 +782,64 @@ TclCopyAndCollapse(count, src, dst)
*/
int
-Tcl_SplitList(interp, list, argcPtr, argvPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. If
+Tcl_SplitList(
+ 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. */
- int *argcPtr; /* Pointer to location to fill in with the
+ const char *list, /* Pointer to string with list structure. */
+ int *argcPtr, /* Pointer to location to fill in with the
* number of elements in the list. */
- CONST char ***argvPtr; /* Pointer to place to store pointer to array
+ const char ***argvPtr) /* Pointer to place to store pointer to array
* of pointers to list elements. */
{
- CONST char **argv;
- CONST char *l;
+ const char **argv, *end, *element;
char *p;
- int length, size, i, result, elSize, brace;
- CONST char *element;
+ 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 = 1, l = list; *l != 0; l++) {
- if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
- size++;
- }
- }
- size++; /* Leave space for final NULL pointer. */
- argv = (CONST char **) ckalloc((unsigned)
- ((size * sizeof(char *)) + (l - list) + 1));
- length = strlen(list);
+ size = TclMaxListLength(list, -1, &end) + 1;
+ length = end - list;
+ argv = ckalloc((size * sizeof(char *)) + length + 1);
+
for (i = 0, p = ((char *) argv) + size*sizeof(char *);
*list != 0; i++) {
- CONST char *prevList = list;
+ const char *prevList = list;
+ int literal;
- result = TclFindElement(interp, list, length, &element,
- &list, &elSize, &brace);
+ result = TclFindElement(interp, list, length, &element, &list,
+ &elSize, &literal);
length -= (list - prevList);
if (result != TCL_OK) {
- 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) {
- memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
+ 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);
}
}
@@ -506,9 +859,9 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
* enclosing braces) to make the string into a valid Tcl list element.
*
* 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
+ * 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:
@@ -518,12 +871,12 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
*/
int
-Tcl_ScanElement(string, flagPtr)
- register CONST char *string; /* String to convert to list element. */
- register int *flagPtr; /* Where to store information to guide
- * Tcl_ConvertCountedElement. */
+Tcl_ScanElement(
+ register const char *src, /* String to convert to list element. */
+ register int *flagPtr) /* Where to store information to guide
+ * Tcl_ConvertCountedElement. */
{
- return Tcl_ScanCountedElement(string, -1, flagPtr);
+ return Tcl_ScanCountedElement(src, -1, flagPtr);
}
/*
@@ -534,14 +887,14 @@ Tcl_ScanElement(string, flagPtr)
* 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.
+ * 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_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 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.
@@ -550,115 +903,313 @@ Tcl_ScanElement(string, flagPtr)
*/
int
-Tcl_ScanCountedElement(string, length, flagPtr)
- CONST char *string; /* String to convert to Tcl list element. */
- int length; /* Number of bytes in string, or -1. */
- int *flagPtr; /* Where to store information to guide
+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. */
{
- int flags, nestingLevel;
- register CONST char *p, *lastChar;
+ int flags = CONVERT_ANY;
+ int numBytes = TclScanElement(src, length, &flags);
- /*
- * 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.
- */
+ *flagPtr = flags;
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclScanElement --
+ *
+ * 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 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.
+ *
+ *----------------------------------------------------------------------
+ */
- nestingLevel = 0;
- flags = 0;
- if (string == NULL) {
- string = "";
- }
- if (length == -1) {
- length = strlen(string);
+int
+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. */
+{
+ 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.
+ */
+
+ *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.
+ */
- Tcl_UtfBackslash(p, &size, NULL);
- p += size-1;
- flags |= USE_BRACES;
+ requireEscape = 1;
+ break;
}
+ if (p[1] == '\n') {
+ extra++; /* Escape newline => '\n', one byte longer */
+
+ /*
+ * Backslash newline sequence. Brace quoting not permitted.
+ */
+
+ 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;
}
/*
@@ -683,10 +1234,10 @@ Tcl_ScanCountedElement(string, length, flagPtr)
*/
int
-Tcl_ConvertElement(src, dst, flags)
- register CONST char *src; /* Source information for list element. */
- register char *dst; /* Place to put list-ified element. */
- register int flags; /* Flags produced by Tcl_ScanElement. */
+Tcl_ConvertElement(
+ register const char *src, /* Source information for list element. */
+ register char *dst, /* Place to put list-ified element. */
+ register int flags) /* Flags produced by Tcl_ScanElement. */
{
return Tcl_ConvertCountedElement(src, -1, dst, flags);
}
@@ -713,131 +1264,197 @@ Tcl_ConvertElement(src, dst, flags)
*/
int
-Tcl_ConvertCountedElement(src, length, dst, flags)
- 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. */
+Tcl_ConvertCountedElement(
+ 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. */
{
- 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;
+ }
}
- if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
+
+ /*
+ * 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;
+ }
+ }
+
+ /*
+ * 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;
}
/*
@@ -861,16 +1478,26 @@ Tcl_ConvertCountedElement(src, length, dst, flags)
*/
char *
-Tcl_Merge(argc, argv)
- int argc; /* How many strings to merge. */
- CONST char * CONST *argv; /* Array of string values. */
+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.
@@ -878,35 +1505,51 @@ Tcl_Merge(argc, argv)
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;
}
@@ -931,10 +1574,10 @@ Tcl_Merge(argc, argv)
*/
char
-Tcl_Backslash(src, readPtr)
- CONST char *src; /* Points to the backslash character of a
+Tcl_Backslash(
+ const char *src, /* Points to the backslash character of a
* backslash sequence. */
- int *readPtr; /* Fill in with number of characters read from
+ int *readPtr) /* Fill in with number of characters read from
* src, unless NULL. */
{
char buf[TCL_UTF_MAX];
@@ -948,6 +1591,167 @@ Tcl_Backslash(src, readPtr)
/*
*----------------------------------------------------------------------
*
+ * 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.
@@ -964,56 +1768,98 @@ Tcl_Backslash(src, readPtr)
*----------------------------------------------------------------------
*/
+/* The whitespace characters trimmed during [concat] operations */
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
+
char *
-Tcl_Concat(argc, argv)
- int argc; /* Number of strings to concatenate. */
- CONST char * CONST *argv; /* Array of strings to concatenate. */
+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_TRIM_SET,
+ 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_TRIM_SET,
+ 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((VOID *) p, (VOID *) 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;
}
@@ -1036,132 +1882,119 @@ Tcl_Concat(argc, argv)
*/
Tcl_Obj *
-Tcl_ConcatObj(objc, objv)
- int objc; /* Number of objects to concatenate. */
- Tcl_Obj *CONST objv[]; /* Array of objects to concatenate. */
+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;
- char *element;
- char *concatStr;
- Tcl_Obj *objPtr;
+ int i, elemLength, needSpace = 0, bytesNeeded = 0;
+ const char *element;
+ Tcl_Obj *objPtr, *resPtr;
/*
- * Check first to see if all the items are of list type. 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.
+ * 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 are in canonical form.
*/
for (i = 0; i < objc; i++) {
- List *listRepPtr;
+ int length;
objPtr = objv[i];
- if (objPtr->typePtr != &tclListType) {
- break;
+ 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;
-
- objPtr = Tcl_NewListObj(0, NULL);
+ 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.
- */
-
- Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
- Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
+ objPtr = objv[i];
+ if (objPtr->bytes && objPtr->length == 0) {
+ continue;
+ }
+ if (resPtr) {
+ Tcl_ListObjAppendList(NULL, resPtr, objPtr);
+ } else {
+ resPtr = TclListObjCopy(NULL, objPtr);
+ }
}
- return objPtr;
+ if (!resPtr) {
+ resPtr = Tcl_NewObj();
+ }
+ return resPtr;
}
/*
* 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 = Tcl_GetStringFromObj(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 = (char *) 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 = Tcl_GetStringFromObj(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_TRIM_SET,
+ 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((VOID *) p, (VOID *) 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_TRIM_SET,
+ 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;
}
/*
@@ -1183,9 +2016,9 @@ Tcl_ConcatObj(objc, objv)
*/
int
-Tcl_StringMatch(str, pattern)
- CONST char *str; /* String. */
- CONST char *pattern; /* Pattern, which may contain special
+Tcl_StringMatch(
+ const char *str, /* String. */
+ const char *pattern) /* Pattern, which may contain special
* characters. */
{
return Tcl_StringCaseMatch(str, pattern, 0);
@@ -1211,14 +2044,14 @@ Tcl_StringMatch(str, pattern)
*/
int
-Tcl_StringCaseMatch(str, pattern, nocase)
- CONST char *str; /* String. */
- CONST char *pattern; /* Pattern, which may contain special
+Tcl_StringCaseMatch(
+ const char *str, /* String. */
+ const char *pattern, /* Pattern, which may contain special
* characters. */
- int nocase; /* 0 for case sensitive, 1 for insensitive */
+ int nocase) /* 0 for case sensitive, 1 for insensitive */
{
int p, charLen;
- CONST char *pstart = pattern;
+ const char *pstart = pattern;
Tcl_UniChar ch1, ch2;
while (1) {
@@ -1261,14 +2094,14 @@ Tcl_StringCaseMatch(str, pattern, nocase)
if (UCHAR(*pattern) < 0x80) {
ch2 = (Tcl_UniChar)
- (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
+ (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
} else {
Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
ch2 = Tcl_UniCharToLower(ch2);
}
-
}
+
while (1) {
/*
* Optimization for matching - cruise through the string
@@ -1334,7 +2167,7 @@ Tcl_StringCaseMatch(str, pattern, nocase)
pattern++;
if (UCHAR(*str) < 0x80) {
ch1 = (Tcl_UniChar)
- (nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
+ (nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
str++;
} else {
str += Tcl_UtfToUniChar(str, &ch1);
@@ -1347,8 +2180,8 @@ Tcl_StringCaseMatch(str, pattern, nocase)
return 0;
}
if (UCHAR(*pattern) < 0x80) {
- startChar = (Tcl_UniChar)
- (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
+ startChar = (Tcl_UniChar) (nocase
+ ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += Tcl_UtfToUniChar(pattern, &startChar);
@@ -1362,9 +2195,8 @@ Tcl_StringCaseMatch(str, pattern, nocase)
return 0;
}
if (UCHAR(*pattern) < 0x80) {
- endChar = (Tcl_UniChar)
- (nocase ? tolower(UCHAR(*pattern))
- : UCHAR(*pattern));
+ endChar = (Tcl_UniChar) (nocase
+ ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += Tcl_UtfToUniChar(pattern, &endChar);
@@ -1412,7 +2244,7 @@ Tcl_StringCaseMatch(str, pattern, nocase)
* each string match.
*/
- str += TclUtfToUniChar(str, &ch1);
+ str += TclUtfToUniChar(str, &ch1);
pattern += TclUtfToUniChar(pattern, &ch2);
if (nocase) {
if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
@@ -1427,6 +2259,238 @@ Tcl_StringCaseMatch(str, pattern, nocase)
/*
*----------------------------------------------------------------------
*
+ * TclByteArrayMatch --
+ *
+ * See if a particular string matches a particular pattern. Does not
+ * allow for case insensitivity.
+ * Parallels tclUtf.c:TclUniCharMatch, adjusted for char* and sans nocase.
+ *
+ * Results:
+ * The return value is 1 if string matches pattern, and 0 otherwise. The
+ * matching operation permits the following special characters in the
+ * pattern: *?\[] (see the manual entry for details on what these mean).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclByteArrayMatch(
+ const unsigned char *string,/* String. */
+ int strLen, /* Length of String */
+ const unsigned char *pattern,
+ /* Pattern, which may contain special
+ * characters. */
+ int ptnLen, /* Length of Pattern */
+ int flags)
+{
+ const unsigned char *stringEnd, *patternEnd;
+ unsigned char p;
+
+ stringEnd = string + strLen;
+ patternEnd = pattern + ptnLen;
+
+ while (1) {
+ /*
+ * See if we're at the end of both the pattern and the string. If so,
+ * we succeeded. If we're at the end of the pattern but not at the end
+ * of the string, we failed.
+ */
+
+ if (pattern == patternEnd) {
+ return (string == stringEnd);
+ }
+ p = *pattern;
+ if ((string == stringEnd) && (p != '*')) {
+ return 0;
+ }
+
+ /*
+ * Check for a "*" as the next pattern character. It matches any
+ * substring. We handle this by skipping all the characters up to the
+ * next matching one in the pattern, and then calling ourselves
+ * recursively for each postfix of string, until either we match or we
+ * reach the end of the string.
+ */
+
+ if (p == '*') {
+ /*
+ * Skip all successive *'s in the pattern.
+ */
+
+ while ((++pattern < patternEnd) && (*pattern == '*')) {
+ /* empty body */
+ }
+ if (pattern == patternEnd) {
+ return 1;
+ }
+ p = *pattern;
+ while (1) {
+ /*
+ * Optimization for matching - cruise through the string
+ * quickly if the next char in the pattern isn't a special
+ * character.
+ */
+
+ if ((p != '[') && (p != '?') && (p != '\\')) {
+ while ((string < stringEnd) && (p != *string)) {
+ string++;
+ }
+ }
+ if (TclByteArrayMatch(string, stringEnd - string,
+ pattern, patternEnd - pattern, 0)) {
+ return 1;
+ }
+ if (string == stringEnd) {
+ return 0;
+ }
+ string++;
+ }
+ }
+
+ /*
+ * Check for a "?" as the next pattern character. It matches any
+ * single character.
+ */
+
+ if (p == '?') {
+ pattern++;
+ string++;
+ continue;
+ }
+
+ /*
+ * Check for a "[" as the next pattern character. It is followed by a
+ * list of characters that are acceptable, or by a range (two
+ * characters separated by "-").
+ */
+
+ if (p == '[') {
+ unsigned char ch1, startChar, endChar;
+
+ pattern++;
+ ch1 = *string;
+ string++;
+ while (1) {
+ if ((*pattern == ']') || (pattern == patternEnd)) {
+ return 0;
+ }
+ startChar = *pattern;
+ pattern++;
+ if (*pattern == '-') {
+ pattern++;
+ if (pattern == patternEnd) {
+ return 0;
+ }
+ endChar = *pattern;
+ pattern++;
+ if (((startChar <= ch1) && (ch1 <= endChar))
+ || ((endChar <= ch1) && (ch1 <= startChar))) {
+ /*
+ * Matches ranges of form [a-z] or [z-a].
+ */
+
+ break;
+ }
+ } else if (startChar == ch1) {
+ break;
+ }
+ }
+ while (*pattern != ']') {
+ if (pattern == patternEnd) {
+ pattern--;
+ break;
+ }
+ pattern++;
+ }
+ pattern++;
+ continue;
+ }
+
+ /*
+ * If the next pattern character is '\', just strip off the '\' so we
+ * do exact matching on the character that follows.
+ */
+
+ if (p == '\\') {
+ if (++pattern == patternEnd) {
+ return 0;
+ }
+ }
+
+ /*
+ * There's no special character. Just make sure that the next bytes of
+ * each string match.
+ */
+
+ if (*string != *pattern) {
+ return 0;
+ }
+ string++;
+ pattern++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * The return value is 1 if string matches pattern, and 0 otherwise. The
+ * matching operation permits the following special characters in the
+ * pattern: *?\[] (see the manual entry for details on what these mean).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStringMatchObj(
+ Tcl_Obj *strObj, /* string object. */
+ Tcl_Obj *ptnObj, /* pattern object. */
+ int flags) /* Only TCL_MATCH_NOCASE should be passed, or
+ * 0. */
+{
+ int match, length, plen;
+
+ /*
+ * Promote based on the type of incoming object.
+ * XXX: Currently doesn't take advantage of exact-ness that
+ * XXX: TclReToGlob tells us about
+ trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
+ */
+
+ if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
+ Tcl_UniChar *udata, *uptn;
+
+ udata = Tcl_GetUnicodeFromObj(strObj, &length);
+ uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
+ match = TclUniCharMatch(udata, length, uptn, plen, flags);
+ } else if (TclIsPureByteArray(strObj) && !flags) {
+ unsigned char *data, *ptn;
+
+ data = Tcl_GetByteArrayFromObj(strObj, &length);
+ ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen);
+ match = TclByteArrayMatch(data, length, ptn, plen, 0);
+ } else {
+ match = Tcl_StringCaseMatch(TclGetString(strObj),
+ TclGetString(ptnObj), flags);
+ }
+ return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DStringInit --
*
* Initializes a dynamic string, discarding any previous contents of the
@@ -1443,8 +2507,8 @@ Tcl_StringCaseMatch(str, pattern, nocase)
*/
void
-Tcl_DStringInit(dsPtr)
- Tcl_DString *dsPtr; /* Pointer to structure for dynamic string. */
+Tcl_DStringInit(
+ Tcl_DString *dsPtr) /* Pointer to structure for dynamic string. */
{
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
@@ -1471,17 +2535,15 @@ Tcl_DStringInit(dsPtr)
*/
char *
-Tcl_DStringAppend(dsPtr, bytes, length)
- Tcl_DString *dsPtr; /* Structure describing dynamic string. */
- CONST char *bytes; /* String to append. If length is -1 then this
+Tcl_DStringAppend(
+ Tcl_DString *dsPtr, /* Structure describing dynamic string. */
+ const char *bytes, /* String to append. If length is -1 then this
* must be null-terminated. */
- int length; /* Number of bytes from "bytes" to append. If
+ int length) /* Number of bytes from "bytes" to append. If
* < 0, then append all of bytes, up to null
* at end. */
{
int newSize;
- char *dst;
- CONST char *end;
if (length < 0) {
length = strlen(bytes);
@@ -1497,15 +2559,12 @@ Tcl_DStringAppend(dsPtr, bytes, length)
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString;
+ char *newString = ckalloc(dsPtr->spaceAvl);
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
+ 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);
}
}
@@ -1513,18 +2572,46 @@ Tcl_DStringAppend(dsPtr, bytes, length)
* 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.
@@ -1541,17 +2628,16 @@ Tcl_DStringAppend(dsPtr, bytes, length)
*/
char *
-Tcl_DStringAppendElement(dsPtr, element)
- Tcl_DString *dsPtr; /* Structure describing dynamic string. */
- CONST char *element; /* String to append. Must be
+Tcl_DStringAppendElement(
+ Tcl_DString *dsPtr, /* Structure describing dynamic string. */
+ 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
@@ -1564,16 +2650,14 @@ Tcl_DStringAppendElement(dsPtr, element)
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString;
+ char *newString = ckalloc(dsPtr->spaceAvl);
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
+ 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;
}
/*
@@ -1581,8 +2665,7 @@ Tcl_DStringAppendElement(dsPtr, element)
* the end, with a space, if needed.
*/
- dst = dsPtr->string + dsPtr->length;
- if (TclNeedSpace(dsPtr->string, dst)) {
+ if (needSpace) {
*dst = ' ';
dst++;
dsPtr->length++;
@@ -1595,7 +2678,8 @@ Tcl_DStringAppendElement(dsPtr, element)
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;
}
@@ -1619,9 +2703,9 @@ Tcl_DStringAppendElement(dsPtr, element)
*/
void
-Tcl_DStringSetLength(dsPtr, length)
- Tcl_DString *dsPtr; /* Structure describing dynamic string. */
- int length; /* New length for dynamic string. */
+Tcl_DStringSetLength(
+ Tcl_DString *dsPtr, /* Structure describing dynamic string. */
+ int length) /* New length for dynamic string. */
{
int newsize;
@@ -1648,15 +2732,12 @@ Tcl_DStringSetLength(dsPtr, length)
dsPtr->spaceAvl = length + 1;
}
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString;
+ char *newString = ckalloc(dsPtr->spaceAvl);
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
+ 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;
@@ -1682,8 +2763,8 @@ Tcl_DStringSetLength(dsPtr, length)
*/
void
-Tcl_DStringFree(dsPtr)
- Tcl_DString *dsPtr; /* Structure describing dynamic string. */
+Tcl_DStringFree(
+ Tcl_DString *dsPtr) /* Structure describing dynamic string. */
{
if (dsPtr->string != dsPtr->staticSpace) {
ckfree(dsPtr->string);
@@ -1714,27 +2795,13 @@ Tcl_DStringFree(dsPtr)
*/
void
-Tcl_DStringResult(interp, dsPtr)
- Tcl_Interp *interp; /* Interpreter whose result is to be reset. */
- Tcl_DString *dsPtr; /* Dynamic string that is to become the
+Tcl_DStringResult(
+ Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
+ Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
Tcl_ResetResult(interp);
-
- if (dsPtr->string != dsPtr->staticSpace) {
- interp->result = dsPtr->string;
- interp->freeProc = TCL_DYNAMIC;
- } else if (dsPtr->length < TCL_RESULT_SIZE) {
- interp->result = ((Interp *) interp)->resultSpace;
- strcpy(interp->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));
}
/*
@@ -1758,9 +2825,9 @@ Tcl_DStringResult(interp, dsPtr)
*/
void
-Tcl_DStringGetResult(interp, dsPtr)
- Tcl_Interp *interp; /* Interpreter whose result is to be reset. */
- Tcl_DString *dsPtr; /* Dynamic string that is to become the result
+Tcl_DStringGetResult(
+ Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
+ Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
Interp *iPtr = (Interp *) interp;
@@ -1770,6 +2837,39 @@ Tcl_DStringGetResult(interp, dsPtr)
}
/*
+ * 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.
*/
@@ -1782,9 +2882,9 @@ Tcl_DStringGetResult(interp, dsPtr)
dsPtr->string = iPtr->result;
dsPtr->spaceAvl = dsPtr->length+1;
} else {
- dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
- strcpy(dsPtr->string, iPtr->result);
- (*iPtr->freeProc)(iPtr->result);
+ dsPtr->string = ckalloc(dsPtr->length+1);
+ memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+ iPtr->freeProc(iPtr->result);
}
dsPtr->spaceAvl = dsPtr->length+1;
iPtr->freeProc = NULL;
@@ -1793,10 +2893,10 @@ Tcl_DStringGetResult(interp, dsPtr)
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;
}
- strcpy(dsPtr->string, iPtr->result);
+ memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
}
iPtr->result = iPtr->resultSpace;
@@ -1806,6 +2906,66 @@ Tcl_DStringGetResult(interp, dsPtr)
/*
*----------------------------------------------------------------------
*
+ * 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->string == dsPtr->staticSpace) {
+ if (dsPtr->length == 0) {
+ TclNewObj(result);
+ } else {
+ /*
+ * 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
@@ -1822,13 +2982,13 @@ Tcl_DStringGetResult(interp, dsPtr)
*/
void
-Tcl_DStringStartSublist(dsPtr)
- Tcl_DString *dsPtr; /* Dynamic string. */
+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, "{");
}
}
@@ -1851,10 +3011,10 @@ Tcl_DStringStartSublist(dsPtr)
*/
void
-Tcl_DStringEndSublist(dsPtr)
- Tcl_DString *dsPtr; /* Dynamic string. */
+Tcl_DStringEndSublist(
+ Tcl_DString *dsPtr) /* Dynamic string. */
{
- Tcl_DStringAppend(dsPtr, "}", -1);
+ TclDStringAppendLiteral(dsPtr, "}");
}
/*
@@ -1878,138 +3038,159 @@ Tcl_DStringEndSublist(dsPtr)
*/
void
-Tcl_PrintDouble(interp, value, dst)
- Tcl_Interp *interp; /* Interpreter whose tcl_precision variable
+Tcl_PrintDouble(
+ Tcl_Interp *interp, /* Interpreter whose tcl_precision variable
* used to be used to control printing. It's
* ignored now. */
- double value; /* Value to print as string. */
- char *dst; /* Where to store converted value; must have
+ double value, /* Value to print as string. */
+ char *dst) /* Where to store converted value; must have
* at least TCL_DOUBLE_SPACE characters. */
{
char *p, c;
- int exp;
+ 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 (IS_NAN(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 (IS_INF(value)) {
- if (value < 0) {
- strcpy(dst, "-Inf");
- } else {
- strcpy(dst, "Inf");
- }
- return;
- }
-
+ 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) {
/*
- * Ordinary (normal and denormal) values.
+ * E format for numbers < 1e-3 or >= 1e17.
*/
-
- exp = TclDoubleDigits(buffer, value, &signum);
- if (signum) {
- *dst++ = '-';
- }
- p = buffer;
- if (exp < -3 || exp > 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", exp-1);
- } else {
- /*
- * F format for others.
- */
-
- if (exp <= 0) {
- *dst++ = '0';
- }
- c = *p;
- while (exp-- > 0) {
- if (c != '\0') {
- *dst++ = c;
- c = *++p;
- } else {
- *dst++ = '0';
- }
- }
+
+ *dst++ = *p++;
+ c = *p;
+ if (c != '\0') {
*dst++ = '.';
- if (c == '\0') {
- *dst++ = '0';
- } else {
- while (++exp < 0) {
- *dst++ = '0';
- }
- while (c != '\0') {
- *dst++ = c;
- c = *++p;
- }
+ while (c != '\0') {
+ *dst++ = c;
+ c = *++p;
}
- *dst++ = '\0';
}
- } else {
/*
- * tcl_precision is supplied, pass it to the native sprintf.
+ * Tcl 8.4 appears to format with at least a two-digit exponent;
+ * preserve that behaviour when tcl_precision != 0
*/
- sprintf(dst, "%.*g", *precisionPtr, value);
-
+ if (*precisionPtr == 0) {
+ sprintf(dst, "e%+d", exponent);
+ } else {
+ sprintf(dst, "e%+03d", exponent);
+ }
+ } else {
/*
- * 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.
+ * F format for others.
*/
-
- 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);
}
/*
@@ -2034,28 +3215,28 @@ Tcl_PrintDouble(interp, value, dst)
/* ARGSUSED */
char *
-TclPrecTraceProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *name1; /* Name of variable. */
- CONST char *name2; /* Second part of variable name. */
- int flags; /* Information about what happened. */
+TclPrecTraceProc(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
{
- Tcl_Obj* value;
+ Tcl_Obj *value;
int prec;
- int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
+ int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
/*
* If the variable is unset, then recreate the trace.
*/
if (flags & TCL_TRACE_UNSETS) {
- if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) {
Tcl_TraceVar2(interp, name1, name2,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
}
- return (char *) NULL;
+ return NULL;
}
/*
@@ -2068,7 +3249,7 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_READS) {
Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
flags & TCL_GLOBAL_ONLY);
- return (char *) NULL;
+ return NULL;
}
/*
@@ -2078,16 +3259,16 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
*/
if (Tcl_IsSafe(interp)) {
- return "can't modify precision from a safe interpreter";
+ return (char *) "can't modify precision from a safe interpreter";
}
value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
if (value == NULL
- || Tcl_GetIntFromObj((Tcl_Interp*) NULL, value, &prec) != TCL_OK
+ || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
|| prec < 0 || prec > TCL_MAX_PREC) {
- return "improper value for precision";
+ return (char *) "improper value for precision";
}
*precisionPtr = prec;
- return (char *) NULL;
+ return NULL;
}
/*
@@ -2108,9 +3289,9 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
*/
int
-TclNeedSpace(start, end)
- CONST char *start; /* First character in string. */
- CONST char *end; /* End of string (place where space will be
+TclNeedSpace(
+ const char *start, /* First character in string. */
+ const char *end) /* End of string (place where space will be
* added, if appropriate). */
{
/*
@@ -2160,6 +3341,7 @@ TclNeedSpace(start, end)
* NOTE: Remove this if other Unicode spaces ever get accepted as
* list-element separators.
*/
+
return 1;
}
switch (*end) {
@@ -2179,54 +3361,89 @@ TclNeedSpace(start, end)
/*
*----------------------------------------------------------------------
*
- * TclLooksLikeInt --
+ * TclFormatInt --
*
- * This function decides whether the leading characters of a string look
- * like an integer or something else (such as a floating-point number or
- * string).
+ * 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:
- * The return value is 1 if the leading characters of p look like a valid
- * Tcl integer. If they look like a floating-point number (e.g. "e01" or
- * "2.4"), or if they don't look like a number at all, then 0 is
- * returned.
+ * An integer representing the number of characters formatted, not
+ * including the terminating \0.
*
* Side effects:
- * None.
+ * The formatted characters are written into the storage pointer to by
+ * the "buffer" argument.
*
*----------------------------------------------------------------------
*/
int
-TclLooksLikeInt(bytes, length)
- register CONST char *bytes; /* Points to first byte of the string. */
- int length; /* Number of bytes in the string. If < 0 bytes
- * up to the first null byte are considered
- * (if they may appear in an integer). */
+TclFormatInt(
+ char *buffer, /* Points to the storage into which the
+ * formatted characters are written. */
+ long n) /* The integer to format. */
{
- register CONST char *p;
+ long intVal;
+ int i;
+ int numFormatted, j;
+ const char *digits = "0123456789";
- if ((bytes == NULL) && (length > 0)) {
- Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);
- }
+ /*
+ * Check first whether "n" is zero.
+ */
- if (length < 0) {
- length = (bytes? strlen(bytes) : 0);
+ if (n == 0) {
+ buffer[0] = '0';
+ buffer[1] = 0;
+ return 1;
}
- p = bytes;
- while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
- length--; p++;
- }
- if (length == 0) {
- return 0;
+ /*
+ * 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);
}
- if ((*p == '+') || (*p == '-')) {
- p++;
- length--;
+
+ /*
+ * 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;
- return (0 != TclParseInteger(p, length));
+ /*
+ * Now reverse the characters.
+ */
+
+ for (j = 0; j < i; j++, i--) {
+ char tmp = buffer[i];
+
+ buffer[i] = buffer[j];
+ buffer[j] = tmp;
+ }
+ return numFormatted;
}
/*
@@ -2254,18 +3471,22 @@ TclLooksLikeInt(bytes, length)
*/
int
-TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. If
+TclGetIntForIndex(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
- Tcl_Obj *objPtr; /* Points to an object containing either "end"
+ Tcl_Obj *objPtr, /* Points to an object containing either "end"
* or an integer. */
- int endValue; /* The value to be stored at "indexPtr" if
+ int endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
- int *indexPtr; /* Location filled in with an integer
+ int *indexPtr) /* Location filled in with an integer
* representing an index. */
{
- if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
+ int length;
+ char *opPtr;
+ const char *bytes;
+
+ if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
return TCL_OK;
}
@@ -2276,76 +3497,66 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
*/
*indexPtr = endValue + objPtr->internalRep.longValue;
+ return TCL_OK;
+ }
- } else {
- int opIdx, length;
- char *bytes = Tcl_GetStringFromObj(objPtr, &length);
- char *p = bytes;
+ bytes = TclGetStringFromObj(objPtr, &length);
+
+ /*
+ * Leading whitespace is acceptable in an index.
+ */
+
+ while (length && TclIsSpaceProc(*bytes)) {
+ bytes++;
+ length--;
+ }
- while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
- length--; p++;
+ if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
+ TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
+ int code, first, second;
+ char savedOp = *opPtr;
+
+ if ((savedOp != '+') && (savedOp != '-')) {
+ goto parseError;
}
- if (length == 0) {
+ if (TclIsSpaceProc(opPtr[1])) {
goto parseError;
}
- if ((*p == '+') || (*p == '-')) {
- p++; length--;
+ *opPtr = '\0';
+ code = Tcl_GetInt(interp, bytes, &first);
+ *opPtr = savedOp;
+ if (code == TCL_ERROR) {
+ goto parseError;
}
- opIdx = TclParseInteger(p, length) + (int) (p-bytes);
- if (opIdx) {
- int code, first, second;
- char savedOp = bytes[opIdx];
- if ((savedOp != '+') && (savedOp != '-')) {
- goto parseError;
- }
- if (isspace(UCHAR(bytes[opIdx+1]))) {
- goto parseError;
- }
- bytes[opIdx] = '\0';
- code = Tcl_GetInt(interp, bytes, &first);
- bytes[opIdx] = savedOp;
- if (code == TCL_ERROR) {
- goto parseError;
- }
- if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) {
- goto parseError;
- }
- if (savedOp == '+') {
- *indexPtr = first + second;
- } else {
- *indexPtr = first - second;
- }
- return TCL_OK;
+ if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
+ goto parseError;
}
+ if (savedOp == '+') {
+ *indexPtr = first + second;
+ } else {
+ *indexPtr = first - second;
+ }
+ return TCL_OK;
+ }
- /*
- * Report a parse error.
- */
-
- parseError:
- if (interp != NULL) {
- char *bytes = Tcl_GetString(objPtr);
-
- /*
- * 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.
- */
+ /*
+ * Report a parse error.
+ */
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be integer?[+-]integer? or end?[+-]integer?",
- (char *) NULL);
- if (!strncmp(bytes, "end-", 3)) {
- bytes += 3;
- }
- TclCheckBadOctal(interp, bytes);
+ parseError:
+ if (interp != NULL) {
+ bytes = Tcl_GetString(objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
+ if (!strncmp(bytes, "end-", 4)) {
+ bytes += 4;
}
-
- return TCL_ERROR;
+ TclCheckBadOctal(interp, bytes);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
- return TCL_OK;
+ return TCL_ERROR;
}
/*
@@ -2369,20 +3580,19 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
*/
static void
-UpdateStringOfEndOffset(objPtr)
- register Tcl_Obj* objPtr;
+UpdateStringOfEndOffset(
+ register Tcl_Obj *objPtr)
{
- char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
- register int len;
+ char buffer[TCL_INTEGER_SPACE + 5];
+ register int len = 3;
- strcpy(buffer, "end");
- len = sizeof("end") - 1;
+ memcpy(buffer, "end", 4);
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
}
- objPtr->bytes = ckalloc((unsigned) (len+1));
- strcpy(objPtr->bytes, buffer);
+ objPtr->bytes = ckalloc((unsigned) len+1);
+ memcpy(objPtr->bytes, buffer, (unsigned) len+1);
objPtr->length = len;
}
@@ -2405,12 +3615,12 @@ UpdateStringOfEndOffset(objPtr)
*/
static int
-SetEndOffsetFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Tcl interpreter or NULL */
- Tcl_Obj* objPtr; /* Pointer to the object to parse */
+SetEndOffsetFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter or NULL */
+ Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
- register char* bytes; /* String rep of the object */
+ register const char *bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
/*
@@ -2425,13 +3635,13 @@ SetEndOffsetFromAny(interp, objPtr)
* Check for a string rep of the right form.
*/
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
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?", (char*) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
@@ -2448,8 +3658,8 @@ SetEndOffsetFromAny(interp, objPtr)
* 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;
@@ -2462,10 +3672,11 @@ SetEndOffsetFromAny(interp, objPtr)
* Conversion failed. Report the error.
*/
+ badIndexFormat:
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be end?[+-]integer?", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
@@ -2500,30 +3711,33 @@ SetEndOffsetFromAny(interp, objPtr)
*/
int
-TclCheckBadOctal(interp, value)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. If
+TclCheckBadOctal(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
- CONST char *value; /* String to check. */
+ const char *value) /* String to check. */
{
- register CONST char *p = value;
+ register const char *p = value;
/*
* A frequent mistake is invalid octal values due to an unwanted leading
* zero. Try to generate a meaningful error message.
*/
- while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ while (TclIsSpaceProc(*p)) {
p++;
}
if (*p == '+' || *p == '-') {
p++;
}
if (*p == '0') {
+ if ((p[1] == 'o') || p[1] == 'O') {
+ p += 2;
+ }
while (isdigit(UCHAR(*p))) { /* INTL: digit. */
p++;
}
- while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ while (TclIsSpaceProc(*p)) {
p++;
}
if (*p == '\0') {
@@ -2536,8 +3750,9 @@ TclCheckBadOctal(interp, value)
* Don't reset the result here because we want this result to
* be added to an existing error message as extra info.
*/
- Tcl_AppendResult(interp, " (looks like invalid octal number)",
- (char *) NULL);
+
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ " (looks like invalid octal number)", -1);
}
return 1;
}
@@ -2550,21 +3765,22 @@ TclCheckBadOctal(interp, value)
*
* ClearHash --
*
- * Remove all the entries in the hash table *tablePtr.
+ * Remove all the entries in the hash table *tablePtr.
*
*----------------------------------------------------------------------
*/
static void
-ClearHash(tablePtr)
- Tcl_HashTable *tablePtr;
+ClearHash(
+ Tcl_HashTable *tablePtr)
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
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);
}
@@ -2589,14 +3805,15 @@ ClearHash(tablePtr)
*/
static Tcl_HashTable *
-GetThreadHash(keyPtr)
- Tcl_ThreadDataKey *keyPtr;
+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;
@@ -2617,13 +3834,14 @@ GetThreadHash(keyPtr)
*/
static void
-FreeThreadHash(clientData)
- ClientData clientData;
+FreeThreadHash(
+ ClientData clientData)
{
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
+ Tcl_HashTable *tablePtr = clientData;
+
ClearHash(tablePtr);
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
}
/*
@@ -2638,10 +3856,11 @@ FreeThreadHash(clientData)
*/
static void
-FreeProcessGlobalValue(clientData)
- ClientData clientData;
+FreeProcessGlobalValue(
+ ClientData clientData)
{
- ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;
+ ProcessGlobalValue *pgvPtr = clientData;
+
pgvPtr->epoch++;
pgvPtr->numBytes = 0;
ckfree(pgvPtr->value);
@@ -2665,12 +3884,12 @@ FreeProcessGlobalValue(clientData)
*/
void
-TclSetProcessGlobalValue(pgvPtr, newValue, encoding)
- ProcessGlobalValue *pgvPtr;
- Tcl_Obj *newValue;
- Tcl_Encoding encoding;
+TclSetProcessGlobalValue(
+ ProcessGlobalValue *pgvPtr,
+ Tcl_Obj *newValue,
+ Tcl_Encoding encoding)
{
- CONST char *bytes;
+ const char *bytes;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
int dummy;
@@ -2685,11 +3904,11 @@ TclSetProcessGlobalValue(pgvPtr, newValue, encoding)
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 int) pgvPtr->numBytes + 1);
- strcpy(pgvPtr->value, bytes);
+ pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
+ memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
@@ -2704,8 +3923,8 @@ TclSetProcessGlobalValue(pgvPtr, newValue, encoding)
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
- hPtr = Tcl_CreateHashEntry(cacheMap, (char *)pgvPtr->epoch, &dummy);
- Tcl_SetHashValue(hPtr, (ClientData) newValue);
+ hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
+ Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -2724,8 +3943,8 @@ TclSetProcessGlobalValue(pgvPtr, newValue, encoding)
*/
Tcl_Obj *
-TclGetProcessGlobalValue(pgvPtr)
- ProcessGlobalValue *pgvPtr;
+TclGetProcessGlobalValue(
+ ProcessGlobalValue *pgvPtr)
{
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
@@ -2753,9 +3972,8 @@ TclGetProcessGlobalValue(pgvPtr)
Tcl_DStringLength(&native), &newValue);
Tcl_DStringFree(&native);
ckfree(pgvPtr->value);
- pgvPtr->value = ckalloc((unsigned int)
- Tcl_DStringLength(&newValue) + 1);
- memcpy((VOID*) pgvPtr->value, (VOID*) Tcl_DStringValue(&newValue),
+ pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
+ memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
(size_t) Tcl_DStringLength(&newValue) + 1);
Tcl_DStringFree(&newValue);
Tcl_FreeEncoding(pgvPtr->encoding);
@@ -2766,7 +3984,7 @@ TclGetProcessGlobalValue(pgvPtr)
}
}
cacheMap = GetThreadHash(&pgvPtr->key);
- hPtr = Tcl_FindHashEntry(cacheMap, (char *)epoch);
+ hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
if (NULL == hPtr) {
int dummy;
@@ -2786,12 +4004,11 @@ TclGetProcessGlobalValue(pgvPtr)
Tcl_MutexLock(&pgvPtr->mutex);
if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
pgvPtr->epoch++;
- (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
- &pgvPtr->encoding);
+ pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding);
if (pgvPtr->value == NULL) {
- Tcl_Panic("PGV Initializer did not initialize.");
+ Tcl_Panic("PGV Initializer did not initialize");
}
- Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
+ Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
/*
@@ -2799,12 +4016,13 @@ TclGetProcessGlobalValue(pgvPtr)
*/
value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
- hPtr = Tcl_CreateHashEntry(cacheMap, (char *)pgvPtr->epoch, &dummy);
+ hPtr = Tcl_CreateHashEntry(cacheMap,
+ INT2PTR(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
- Tcl_SetHashValue(hPtr, (ClientData) value);
+ Tcl_SetHashValue(hPtr, value);
Tcl_IncrRefCount(value);
}
- return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
/*
@@ -2816,7 +4034,7 @@ TclGetProcessGlobalValue(pgvPtr)
* (normally as computed by TclpFindExecutable).
*
* Results:
- * None.
+ * None.
*
* Side effects:
* Stores the executable name.
@@ -2825,9 +4043,9 @@ TclGetProcessGlobalValue(pgvPtr)
*/
void
-TclSetObjNameOfExecutable(name, encoding)
- Tcl_Obj *name;
- Tcl_Encoding encoding;
+TclSetObjNameOfExecutable(
+ Tcl_Obj *name,
+ Tcl_Encoding encoding)
{
TclSetProcessGlobalValue(&executableName, name, encoding);
}
@@ -2847,13 +4065,13 @@ TclSetObjNameOfExecutable(name, encoding)
* pathname of the application is unknown.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-TclGetObjNameOfExecutable()
+TclGetObjNameOfExecutable(void)
{
return TclGetProcessGlobalValue(&executableName);
}
@@ -2866,25 +4084,26 @@ TclGetObjNameOfExecutable()
* This function retrieves the absolute pathname of the application in
* which the Tcl library is running, and returns it in string form.
*
- * The returned string belongs to Tcl and should be copied if the caller
- * plans to keep it, to guard against it becoming invalid.
+ * The returned string belongs to Tcl and should be copied if the caller
+ * plans to keep it, to guard against it becoming invalid.
*
* Results:
* A pointer to the internal string or NULL if the internal full path
* name has not been computed or unknown.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetNameOfExecutable()
+const char *
+Tcl_GetNameOfExecutable(void)
{
int numBytes;
- CONST char * bytes =
+ const char *bytes =
Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
+
if (numBytes == 0) {
return NULL;
}
@@ -2910,8 +4129,8 @@ Tcl_GetNameOfExecutable()
*/
void
-TclpGetTime(timePtr)
- Tcl_Time* timePtr;
+TclpGetTime(
+ Tcl_Time *timePtr)
{
Tcl_GetTime(timePtr);
}
@@ -2934,12 +4153,229 @@ TclpGetTime(timePtr)
*/
TclPlatformType *
-TclGetPlatform()
+TclGetPlatform(void)
{
return &tclPlatform;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclReToGlob --
+ *
+ * Attempt to convert a regular expression to an equivalent glob pattern.
+ *
+ * Results:
+ * Returns TCL_OK on success, TCL_ERROR on failure. If interp is not
+ * NULL, an error message is placed in the result. On success, the
+ * DString will contain an exact equivalent glob pattern. The caller is
+ * responsible for calling Tcl_DStringFree on success. If exactPtr is not
+ * NULL, it will be 1 if an exact match qualifies.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclReToGlob(
+ Tcl_Interp *interp,
+ const char *reStr,
+ int reStrLen,
+ Tcl_DString *dsPtr,
+ int *exactPtr)
+{
+ int anchorLeft, anchorRight, lastIsStar, numStars;
+ char *dsStr, *dsStrStart;
+ const char *msg, *p, *strEnd, *code;
+
+ strEnd = reStr + reStrLen;
+ Tcl_DStringInit(dsPtr);
+
+ /*
+ * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
+ */
+
+ 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.
+ */
+
+ Tcl_DStringSetLength(dsPtr, reStrLen + 2);
+ dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
+ *dsStr++ = '*';
+ for (p = reStr + 4; p < strEnd; p++) {
+ switch (*p) {
+ case '\\': case '*': case '[': case ']': case '?':
+ /* Only add \ where necessary for glob */
+ *dsStr++ = '\\';
+ /* fall through */
+ default:
+ *dsStr++ = *p;
+ break;
+ }
+ }
+ *dsStr++ = '*';
+ Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
+ if (exactPtr) {
+ *exactPtr = 0;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * At most, the glob pattern has length reStrLen + 2 to account for
+ * possible * at each end.
+ */
+
+ Tcl_DStringSetLength(dsPtr, reStrLen + 2);
+ dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
+
+ /*
+ * 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.
+ */
+
+ msg = NULL;
+ code = NULL;
+ p = reStr;
+ anchorRight = 0;
+ lastIsStar = 0;
+ numStars = 0;
+
+ if (*p == '^') {
+ anchorLeft = 1;
+ p++;
+ } else {
+ anchorLeft = 0;
+ *dsStr++ = '*';
+ lastIsStar = 1;
+ }
+
+ for ( ; p < strEnd; p++) {
+ switch (*p) {
+ case '\\':
+ p++;
+ switch (*p) {
+ case 'a':
+ *dsStr++ = '\a';
+ break;
+ case 'b':
+ *dsStr++ = '\b';
+ break;
+ case 'f':
+ *dsStr++ = '\f';
+ break;
+ case 'n':
+ *dsStr++ = '\n';
+ break;
+ case 'r':
+ *dsStr++ = '\r';
+ break;
+ case 't':
+ *dsStr++ = '\t';
+ break;
+ case 'v':
+ *dsStr++ = '\v';
+ break;
+ case 'B': case '\\':
+ *dsStr++ = '\\';
+ *dsStr++ = '\\';
+ anchorLeft = 0; /* prevent exact match */
+ break;
+ case '*': case '[': case ']': case '?':
+ /* Only add \ where necessary for glob */
+ *dsStr++ = '\\';
+ anchorLeft = 0; /* prevent exact match */
+ /* fall through */
+ case '{': case '}': case '(': case ')': case '+':
+ case '.': case '|': case '^': case '$':
+ *dsStr++ = *p;
+ break;
+ default:
+ msg = "invalid escape sequence";
+ code = "BADESCAPE";
+ goto invalidGlob;
+ }
+ break;
+ case '.':
+ anchorLeft = 0; /* prevent exact match */
+ if (p+1 < strEnd) {
+ if (p[1] == '*') {
+ p++;
+ if (!lastIsStar) {
+ *dsStr++ = '*';
+ lastIsStar = 1;
+ numStars++;
+ }
+ continue;
+ } else if (p[1] == '+') {
+ p++;
+ *dsStr++ = '?';
+ *dsStr++ = '*';
+ lastIsStar = 1;
+ numStars++;
+ continue;
+ }
+ }
+ *dsStr++ = '?';
+ break;
+ case '$':
+ if (p+1 != strEnd) {
+ msg = "$ not anchor";
+ code = "NONANCHOR";
+ goto invalidGlob;
+ }
+ anchorRight = 1;
+ break;
+ case '*': case '+': case '?': case '|': case '^':
+ case '{': case '}': case '(': case ')': case '[': case ']':
+ msg = "unhandled RE special char";
+ code = "UNHANDLED";
+ goto invalidGlob;
+ 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++ = '*';
+ }
+ Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
+
+ if (exactPtr) {
+ *exactPtr = (anchorLeft && anchorRight);
+ }
+
+ return TCL_OK;
+
+ invalidGlob:
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+ Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
+ }
+ Tcl_DStringFree(dsPtr);
+ return TCL_ERROR;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 5e196a7..4694cd8 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -10,76 +10,214 @@
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Miguel Sofer
*
* 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.109 2005/07/23 00:04:32 dkf Exp $
*/
#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Prototypes for the variable hash key methods.
+ */
+
+static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
+static void FreeVarEntry(Tcl_HashEntry *hPtr);
+static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+
+static const Tcl_HashKeyType tclVarHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ TclHashObjKey, /* hashKeyProc */
+ CompareVarKeys, /* compareKeysProc */
+ AllocVarEntry, /* allocEntryProc */
+ FreeVarEntry /* freeEntryProc */
+};
+
+static inline Var * VarHashCreateVar(TclVarHashTable *tablePtr,
+ Tcl_Obj *key, int *newPtr);
+static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr,
+ Tcl_HashSearch *searchPtr);
+static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr);
+static inline void CleanupVar(Var *varPtr, Var *arrayPtr);
+
+#define VarHashGetValue(hPtr) \
+ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in. This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
+static inline Var *
+VarHashCreateVar(
+ TclVarHashTable *tablePtr,
+ Tcl_Obj *key,
+ int *newPtr)
+{
+ Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
+ key, newPtr);
+
+ if (hPtr) {
+ return VarHashGetValue(hPtr);
+ } else {
+ return NULL;
+ }
+}
+
+#define VarHashFindVar(tablePtr, key) \
+ VarHashCreateVar((tablePtr), (key), NULL)
+
+#define VarHashInvalidateEntry(varPtr) \
+ ((varPtr)->flags |= VAR_DEAD_HASH)
+
+#define VarHashDeleteEntry(varPtr) \
+ Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))
+
+#define VarHashFirstEntry(tablePtr, searchPtr) \
+ Tcl_FirstHashEntry(&(tablePtr)->table, (searchPtr))
+
+#define VarHashNextEntry(searchPtr) \
+ Tcl_NextHashEntry((searchPtr))
+
+static inline Var *
+VarHashFirstVar(
+ TclVarHashTable *tablePtr,
+ Tcl_HashSearch *searchPtr)
+{
+ Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);
+
+ if (hPtr) {
+ return VarHashGetValue(hPtr);
+ } else {
+ return NULL;
+ }
+}
+
+static inline Var *
+VarHashNextVar(
+ Tcl_HashSearch *searchPtr)
+{
+ Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);
+
+ if (hPtr) {
+ return VarHashGetValue(hPtr);
+ } else {
+ return NULL;
+ }
+}
+
+#define VarHashGetKey(varPtr) \
+ (((VarInHash *)(varPtr))->entry.key.objPtr)
+
+#define VarHashDeleteTable(tablePtr) \
+ Tcl_DeleteHashTable(&(tablePtr)->table)
/*
* The strings below are used to indicate what went wrong when a variable
* access is denied.
*/
-static CONST char *noSuchVar = "no such variable";
-static CONST char *isArray = "variable is array";
-static CONST char *needArray = "variable isn't array";
-static CONST char *noSuchElement = "no such element in array";
-static CONST char *danglingElement =
+static const char *noSuchVar = "no such variable";
+static const char *isArray = "variable is array";
+static const char *needArray = "variable isn't array";
+static const char *noSuchElement = "no such element in array";
+static const char *danglingElement =
"upvar refers to element in deleted array";
-static CONST char *danglingVar =
+static const char *danglingVar =
"upvar refers to variable in deleted namespace";
-static CONST char *badNamespace = "parent namespace doesn't exist";
-static CONST char *missingName = "missing variable name";
-static CONST char *isArrayElement =
+static const char *badNamespace = "parent namespace doesn't exist";
+static const char *missingName = "missing variable name";
+static const char *isArrayElement =
"name refers to an element in an array";
/*
- * Forward references to procedures defined later in this file:
+ * A test to see if we are in a call frame that has local variables. This is
+ * true if we are inside a procedure body.
*/
-static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
-static void DeleteArray _ANSI_ARGS_((Interp *iPtr,
- CONST char *arrayName, Var *varPtr, int flags));
-static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp,
+#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
+
+/*
+ * The following structure describes an enumerative search in progress on an
+ * array variable; this are invoked with options to the "array" command.
+ */
+
+typedef struct ArraySearch {
+ int id; /* Integer id used to distinguish among
+ * multiple concurrent searches for the same
+ * array. */
+ struct Var *varPtr; /* Pointer to array variable that's being
+ * searched. */
+ Tcl_HashSearch search; /* Info kept by the hash module about progress
+ * through the array. */
+ Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
+ * be enumerated (it's leftover from the
+ * Tcl_FirstHashEntry call or from an "array
+ * anymore" command). NULL means must call
+ * Tcl_NextHashEntry to get value to
+ * return. */
+ struct ArraySearch *nextPtr;/* Next in list of all active searches for
+ * this variable, or NULL if this is the last
+ * one. */
+} ArraySearch;
+
+/*
+ * Forward references to functions defined later in this file:
+ */
+
+static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ Tcl_Obj *patternPtr, int includeLinks);
+static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
+static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
+ Var *varPtr, int flags, int index);
+static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
+ Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
+ int flags);
+static int ObjMakeUpvar(Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
- CONST char *otherP2, CONST int otherFlags,
- CONST char *myName, int myFlags, int index));
-static Var * NewVar _ANSI_ARGS_((void));
-static ArraySearch * ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
- CONST Var *varPtr, CONST char *varName,
- Tcl_Obj *handleObj));
-static int SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+ const char *otherP2, const int otherFlags,
+ Tcl_Obj *myNamePtr, int myFlags, int index);
+static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
+ Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
+static void UnsetVarStruct(Var *varPtr, Var *arrayPtr,
+ Interp *iPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, int flags, int index);
+static int SetArraySearchObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
/*
* Functions defined in this file that may be exported in the future for use
* by the bytecode compiler and engine or to the public interface.
*/
-Var * TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *varName, int flags, CONST int create,
- CONST char **errMsgPtr, int *indexPtr));
-int TclObjUnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, CONST char *part2, int flags));
+MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp,
+ Tcl_Obj *varNamePtr, int flags, const int create,
+ const char **errMsgPtr, int *indexPtr);
-static Tcl_DupInternalRepProc DupLocalVarName;
-static Tcl_FreeInternalRepProc FreeParsedVarName;
-static Tcl_DupInternalRepProc DupParsedVarName;
-static Tcl_UpdateStringProc UpdateParsedVarName;
+static Tcl_DupInternalRepProc DupLocalVarName;
+static Tcl_FreeInternalRepProc FreeLocalVarName;
+static Tcl_UpdateStringProc PanicOnUpdateVarName;
-static Tcl_UpdateStringProc PanicOnUpdateVarName;
-static Tcl_SetFromAnyProc PanicOnSetVarName;
+static Tcl_FreeInternalRepProc FreeParsedVarName;
+static Tcl_DupInternalRepProc DupParsedVarName;
+static Tcl_UpdateStringProc UpdateParsedVarName;
+
+static Tcl_UpdateStringProc PanicOnUpdateVarName;
+static Tcl_SetFromAnyProc PanicOnSetVarName;
/*
* Types of Tcl_Objs used to cache variable lookups.
*
* localVarName - INTERNALREP DEFINITION:
- * longValue: index into locals table
+ * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache
+ * or NULL if it is this same obj
+ * ptrAndLongRep.value: index into locals table
*
* nsVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the namespace containing the reference
@@ -92,9 +230,9 @@ static Tcl_SetFromAnyProc PanicOnSetVarName;
* Tcl_Obj), or NULL if it is a scalar variable
*/
-static Tcl_ObjType localVarNameType = {
+static const Tcl_ObjType localVarNameType = {
"localVarName",
- NULL, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
+ FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
};
/*
@@ -110,13 +248,13 @@ static Tcl_ObjType localVarNameType = {
static Tcl_FreeInternalRepProc FreeNsVarName;
static Tcl_DupInternalRepProc DupNsVarName;
-Tcl_ObjType tclNsVarNameType = {
+static const Tcl_ObjType tclNsVarNameType = {
"namespaceVarName",
FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
};
#endif
-Tcl_ObjType tclParsedVarNameType = {
+static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
};
@@ -125,28 +263,104 @@ Tcl_ObjType tclParsedVarNameType = {
* Type of Tcl_Objs used to speed up array searches.
*
* INTERNALREP DEFINITION:
- * twoPtrValue.ptr1: searchIdNumber as offset from (char*)NULL
- * twoPtrValue.ptr2: variableNameStartInString as offset from (char*)NULL
+ * twoPtrValue.ptr1: searchIdNumber (cast to pointer)
+ * twoPtrValue.ptr2: variableNameStartInString (cast to pointer)
*
* Note that the value stored in ptr2 is the offset into the string of the
* start of the variable name and not the address of the variable name itself,
* as this can be safely copied.
*/
-Tcl_ObjType tclArraySearchType = {
+const Tcl_ObjType tclArraySearchType = {
"array search",
NULL, NULL, NULL, SetArraySearchObj
};
+Var *
+TclVarHashCreateVar(
+ TclVarHashTable *tablePtr,
+ const char *key,
+ int *newPtr)
+{
+ Tcl_Obj *keyPtr;
+ Var *varPtr;
+
+ keyPtr = Tcl_NewStringObj(key, -1);
+ Tcl_IncrRefCount(keyPtr);
+ varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
+ Tcl_DecrRefCount(keyPtr);
+
+ return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupVar --
+ *
+ * This function is called when it looks like it may be OK to free up a
+ * variable's storage. If the variable is in a hashtable, its Var
+ * structure and hash table entry will be freed along with those of its
+ * containing array, if any. This function is called, for example, when
+ * a trace on a variable deletes a variable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the variable (or its containing array) really is dead and in a
+ * hashtable, then its Var structure, and possibly its hash table entry,
+ * is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+CleanupVar(
+ Var *varPtr, /* Pointer to variable that may be a candidate
+ * for being expunged. */
+ Var *arrayPtr) /* Array that contains the variable, or NULL
+ * if this variable isn't an array element. */
+{
+ if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
+ && !TclIsVarTraced(varPtr)
+ && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
+ if (VarHashRefCount(varPtr) == 0) {
+ ckfree(varPtr);
+ } else {
+ VarHashDeleteEntry(varPtr);
+ }
+ }
+ if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
+ TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
+ (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
+ if (VarHashRefCount(arrayPtr) == 0) {
+ ckfree(arrayPtr);
+ } else {
+ VarHashDeleteEntry(arrayPtr);
+ }
+ }
+}
+
+void
+TclCleanupVar(
+ Var *varPtr, /* Pointer to variable that may be a candidate
+ * for being expunged. */
+ Var *arrayPtr) /* Array that contains the variable, or NULL
+ * if this variable isn't an array element. */
+{
+ CleanupVar(varPtr, arrayPtr);
+}
+
/*
*----------------------------------------------------------------------
*
* TclLookupVar --
*
- * This procedure is used to locate a variable given its name(s). It has
+ * This function is used to locate a variable given its name(s). It has
* been mostly superseded by TclObjLookupVar, it is now only used by the
- * string-based interfaces. It is kept in tcl8.4 mainly because it is in
- * the internal stubs table, so that some extension may be calling it.
+ * trace code. It is kept in tcl8.5 mainly because it is in the internal
+ * stubs table, so that some extension may be calling it.
*
* Results:
* The return value is a pointer to the variable structure indicated by
@@ -177,121 +391,49 @@ Tcl_ObjType tclArraySearchType = {
*/
Var *
-TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
- arrayPtrPtr)
- Tcl_Interp *interp; /* Interpreter to use for lookup. */
- CONST char *part1; /* If part2 isn't NULL, this is the name of an
+TclLookupVar(
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ const char *part1, /* If part2 isn't NULL, this is the name of an
* array. Otherwise, this is a full variable
* name that could include a parenthesized
* array element. */
- CONST char *part2; /* Name of element within array, or NULL. */
- int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ const char *part2, /* Name of element within array, or NULL. */
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* and TCL_LEAVE_ERR_MSG bits matter. */
- CONST char *msg; /* Verb to use in error messages, e.g. "read"
+ const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- int createPart1; /* If 1, create hash table entry for part 1 of
+ int createPart1, /* If 1, create hash table entry for part 1 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- int createPart2; /* If 1, create hash table entry for part 2 of
+ int createPart2, /* If 1, create hash table entry for part 2 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- Var **arrayPtrPtr; /* If the name refers to an element of an
+ Var **arrayPtrPtr) /* If the name refers to an element of an
* array, *arrayPtrPtr gets filled in with
* address of array variable. Otherwise this
* is set to NULL. */
{
Var *varPtr;
- CONST char *elName; /* Name of array element or NULL; may be same
- * as part2, or may be openParen+1. */
- int openParen, closeParen; /* If this procedure parses a name into array
- * and index, these are the offsets to the
- * parens around the index. Otherwise they
- * are -1. */
- register CONST char *p;
- CONST char *errMsg = NULL;
- int index;
-#define VAR_NAME_BUF_SIZE 26
- char buffer[VAR_NAME_BUF_SIZE];
- char *newVarName = buffer;
+ Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
- varPtr = NULL;
- *arrayPtrPtr = NULL;
- openParen = closeParen = -1;
-
- /*
- * Parse part1 into array name and index.
- * Always check if part1 is an array element name and allow it only if
- * part2 is not given. (If one does not care about creating array elements
- * that can't be used from tcl, and prefer slightly better performance,
- * one can put the following in an if (part2 == NULL) { ... } block and
- * remove the part2's test and error reporting or move that code in array
- * set.)
- */
-
- elName = part2;
- for (p = part1; *p ; p++) {
- if (*p == '(') {
- openParen = p - part1;
- do {
- p++;
- } while (*p != '\0');
- p--;
- if (*p == ')') {
- if (part2 != NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, part1, part2, msg, needArray);
- }
- return NULL;
- }
- closeParen = p - part1;
- } else {
- openParen = -1;
- }
- break;
- }
- }
- if (openParen != -1) {
- if (closeParen >= VAR_NAME_BUF_SIZE) {
- newVarName = ckalloc((unsigned int) (closeParen+1));
- }
- memcpy(newVarName, part1, (unsigned int) closeParen);
- newVarName[openParen] = '\0';
- newVarName[closeParen] = '\0';
- part1 = newVarName;
- elName = newVarName + openParen + 1;
+ if (createPart1) {
+ Tcl_IncrRefCount(part1Ptr);
}
- varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1,
- &errMsg, &index);
- if (varPtr == NULL) {
- if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
- TclVarErrMsg(interp, part1, elName, msg, errMsg);
- }
- } else {
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- if (elName != NULL) {
- *arrayPtrPtr = varPtr;
- varPtr = TclLookupArrayElement(interp, part1, elName, flags,
- msg, createPart1, createPart2, varPtr);
- }
- }
- if (newVarName != buffer) {
- ckfree(newVarName);
- }
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
+ createPart1, createPart2, arrayPtrPtr);
+ TclDecrRefCount(part1Ptr);
return varPtr;
-#undef VAR_NAME_BUF_SIZE
}
/*
*----------------------------------------------------------------------
*
- * TclObjLookupVar --
+ * TclObjLookupVar, TclObjLookupVarEx --
*
- * This procedure is used by virtually all of the variable code to locate
+ * This function is used by virtually all of the variable code to locate
* a variable given its name(s). The parsing into array/element
* components and (if possible) the lookup results are cached in
* part1Ptr, which is converted to one of the varNameTypes.
@@ -322,31 +464,82 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
* are 1. The object part1Ptr is converted to one of localVarNameType,
* tclNsVarNameType or tclParsedVarNameType and caches as much of the
* lookup as it can.
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
*
*----------------------------------------------------------------------
*/
Var *
-TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
- arrayPtrPtr)
- Tcl_Interp *interp; /* Interpreter to use for lookup. */
- register Tcl_Obj *part1Ptr; /* If part2 isn't NULL, this is the name of an
+TclObjLookupVar(
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ register Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an
* array. Otherwise, this is a full variable
* name that could include a parenthesized
* array element. */
- CONST char *part2; /* Name of element within array, or NULL. */
- int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ const char *part2, /* Name of element within array, or NULL. */
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* and TCL_LEAVE_ERR_MSG bits matter. */
- CONST char *msg; /* Verb to use in error messages, e.g. "read"
+ const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- CONST int createPart1; /* If 1, create hash table entry for part 1 of
+ const int createPart1, /* If 1, create hash table entry for part 1 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- CONST int createPart2; /* If 1, create hash table entry for part 2 of
+ const int createPart2, /* If 1, create hash table entry for part 2 of
* name, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- Var **arrayPtrPtr; /* If the name refers to an element of an
+ Var **arrayPtrPtr) /* If the name refers to an element of an
+ * array, *arrayPtrPtr gets filled in with
+ * address of array variable. Otherwise this
+ * is set to NULL. */
+{
+ Tcl_Obj *part2Ptr = NULL;
+ Var *resPtr;
+
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
+ }
+
+ resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+ flags, msg, createPart1, createPart2, arrayPtrPtr);
+
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
+ }
+
+ return resPtr;
+}
+
+/*
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
+ * When createPart2 is 1, callers must IncrRefCount part2Ptr if they
+ * plan to DecrRefCount it.
+ */
+Var *
+TclObjLookupVarEx(
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ Tcl_Obj *part1Ptr, /* If part2Ptr isn't NULL, this is the name of
+ * an array. Otherwise, this is a full
+ * variable name that could include a
+ * parenthesized array element. */
+ Tcl_Obj *part2Ptr, /* Name of element within array, or NULL. */
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits matter. */
+ const char *msg, /* Verb to use in error messages, e.g. "read"
+ * or "set". Only needed if TCL_LEAVE_ERR_MSG
+ * is set in flags. */
+ const int createPart1, /* If 1, create hash table entry for part 1 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ const int createPart2, /* If 1, create hash table entry for part 2 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ Var **arrayPtrPtr) /* If the name refers to an element of an
* array, *arrayPtrPtr gets filled in with
* address of array variable. Otherwise this
* is set to NULL. */
@@ -354,61 +547,52 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
Interp *iPtr = (Interp *) interp;
register Var *varPtr; /* Points to the variable's in-frame Var
* structure. */
- char *part1;
+ const char *part1;
int index, len1, len2;
int parsed = 0;
Tcl_Obj *objPtr;
- Tcl_ObjType *typePtr = part1Ptr->typePtr;
- CONST char *errMsg = NULL;
+ const Tcl_ObjType *typePtr = part1Ptr->typePtr;
+ const char *errMsg = NULL;
CallFrame *varFramePtr = iPtr->varFramePtr;
+#if ENABLE_NS_VARNAME_CACHING
Namespace *nsPtr;
-
- /*
- * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
- * parts.
- */
+#endif
+ const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
+ char *newPart2 = NULL;
*arrayPtrPtr = NULL;
- if (typePtr == &tclParsedVarNameType) {
- if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
- if (part2 != NULL) {
- /*
- * ERROR: part1Ptr is already an array element, cannot specify
- * a part2.
- */
- if (flags & TCL_LEAVE_ERR_MSG) {
- part1 = TclGetString(part1Ptr);
- TclVarErrMsg(interp, part1, part2, msg, needArray);
- }
- return NULL;
- }
- part2 = (char *) part1Ptr->internalRep.twoPtrValue.ptr2;
- part1Ptr = (Tcl_Obj *) part1Ptr->internalRep.twoPtrValue.ptr1;
- typePtr = part1Ptr->typePtr;
- }
- parsed = 1;
- }
- part1 = Tcl_GetStringFromObj(part1Ptr, &len1);
+#if ENABLE_NS_VARNAME_CACHING
+ if (varFramePtr) {
+ nsPtr = varFramePtr->nsPtr;
+ } else {
+ /*
+ * Some variables in the global ns have to be initialized before the
+ * root call frame is in place.
+ */
- nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
- if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
- goto doParse;
+ nsPtr = NULL;
}
+#endif
if (typePtr == &localVarNameType) {
- int localIndex = (int) part1Ptr->internalRep.longValue;
+ int localIndex;
- if ((varFramePtr != NULL)
- && (varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+ localVarNameTypeHandling:
+ localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
+ if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
/*
- * use the cached index if the names coincide.
+ * Use the cached index if the names coincide.
*/
- varPtr = &(varFramePtr->compiledLocals[localIndex]);
- if ((varPtr->name != NULL) && (strcmp(part1, varPtr->name) == 0)) {
+ Tcl_Obj *namePtr = part1Ptr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
+
+ if ((!namePtr && (checkNamePtr == part1Ptr)) ||
+ (namePtr && (checkNamePtr == namePtr))) {
+ varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
goto donePart1;
}
}
@@ -416,34 +600,31 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
#if ENABLE_NS_VARNAME_CACHING
} else if (typePtr == &tclNsVarNameType) {
int useGlobal, useReference;
- Namespace *cachedNsPtr = (Namespace *)
- part1Ptr->internalRep.twoPtrValue.ptr1;
- varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2;
+ Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1;
+ varPtr = part1Ptr->internalRep.twoPtrValue.ptr2;
useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
(flags & TCL_GLOBAL_ONLY) ||
- (*part1==':' && *(part1+1)==':') ||
- (varFramePtr == NULL) ||
- (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
- && (nsPtr == iPtr->globalNsPtr)));
+ (part1[0]==':' && part1[1]==':') ||
+ (!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr)));
useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
(flags & TCL_NAMESPACE_ONLY) ||
- (varFramePtr &&
- !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) &&
- !(flags & TCL_GLOBAL_ONLY) &&
- /* Careful: an undefined ns variable could be hiding a valid
- * global reference. */
+ (!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) &&
+ /*
+ * Careful: an undefined ns variable could be hiding a valid
+ * global reference.
+ */
!TclIsVarUndefined(varPtr))));
- if (useReference && (varPtr->hPtr != NULL)) {
+ if (useReference && !TclIsVarDeadHash(varPtr)) {
/*
* A straight global or namespace reference, use it. It isn't so
* simple to deal with 'implicit' namespace references, i.e.,
* those where the reference could be to either a namespace or a
* global variable. Those we lookup again.
*
- * If (varPtr->hPtr == NULL), this might be a reference to a
+ * If TclIsVarDeadHash(varPtr), this might be a reference to a
* variable in a deleted namespace, kept alive by e.g. part1Ptr.
* We could conceivably be so unlucky that a new namespace was
* created at the same address as the deleted one, so to be safe
@@ -456,22 +637,61 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
#endif
}
- doParse:
+ /*
+ * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
+ * parts.
+ */
+
+ if (typePtr == &tclParsedVarNameType) {
+ if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
+ if (part2Ptr != NULL) {
+ /*
+ * ERROR: part1Ptr is already an array element, cannot specify
+ * a part2.
+ */
+
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+ noSuchVar, -1);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
+ }
+ return NULL;
+ }
+ part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
+ if (newPart2) {
+ part2Ptr = Tcl_NewStringObj(newPart2, -1);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
+ }
+ part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
+ typePtr = part1Ptr->typePtr;
+ if (typePtr == &localVarNameType) {
+ goto localVarNameTypeHandling;
+ }
+ }
+ parsed = 1;
+ }
+ part1 = TclGetStringFromObj(part1Ptr, &len1);
+
if (!parsed && (*(part1 + len1 - 1) == ')')) {
/*
* part1Ptr is possibly an unparsed array element.
*/
register int i;
- char *newPart2;
len2 = -1;
for (i = 0; i < len1; i++) {
if (*(part1 + i) == '(') {
- if (part2 != NULL) {
+ if (part2Ptr != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, part1, part2, msg, needArray);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+ needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
+ NULL);
}
+ return NULL;
}
/*
@@ -483,10 +703,14 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
len2 = len1 - i - 2;
len1 = i;
- newPart2 = ckalloc((unsigned int) (len2+1));
- memcpy(newPart2, part2, (unsigned int) len2);
+ newPart2 = ckalloc(len2 + 1);
+ memcpy(newPart2, part2, (unsigned) len2);
*(newPart2+len2) = '\0';
part2 = newPart2;
+ part2Ptr = Tcl_NewStringObj(newPart2, -1);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
/*
* Free the internal rep of the original part1Ptr, now renamed
@@ -507,8 +731,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
TclNewStringObj(part1Ptr, part1, len1);
Tcl_IncrRefCount(part1Ptr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;
+ objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
typePtr = part1Ptr->typePtr;
part1 = TclGetString(part1Ptr);
@@ -524,13 +748,17 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
*/
TclFreeIntRep(part1Ptr);
- part1Ptr->typePtr = NULL;
- varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1,
+ varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
&errMsg, &index);
if (varPtr == NULL) {
if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
- TclVarErrMsg(interp, part1, part2, msg, errMsg);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(part1Ptr), NULL);
+ }
+ if (newPart2) {
+ Tcl_DecrRefCount(part2Ptr);
}
return NULL;
}
@@ -545,7 +773,15 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
*/
part1Ptr->typePtr = &localVarNameType;
- part1Ptr->internalRep.longValue = (long) index;
+ if (part1Ptr != localName(iPtr->varFramePtr, index)) {
+ part1Ptr->internalRep.ptrAndLongRep.ptr =
+ localName(iPtr->varFramePtr, index);
+ Tcl_IncrRefCount((Tcl_Obj *)
+ part1Ptr->internalRep.ptrAndLongRep.ptr);
+ } else {
+ part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
+ }
+ part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
#if ENABLE_NS_VARNAME_CACHING
} else if (index > -3) {
/*
@@ -554,11 +790,11 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
Namespace *nsPtr;
- nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr);
+ nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
varPtr->refCount++;
part1Ptr->typePtr = &tclNsVarNameType;
- part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
- part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
+ part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
+ part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
#endif
} else {
/*
@@ -571,12 +807,14 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
}
donePart1:
-#if 0
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
if (varPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
part1 = TclGetString(part1Ptr);
- TclVarErrMsg(interp, part1, part2, msg,
- "Cached variable reference is NULL.");
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+ "cached variable reference is NULL.", -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(part1Ptr), NULL);
}
return NULL;
}
@@ -585,23 +823,26 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
varPtr = varPtr->value.linkPtr;
}
- if (part2 != NULL) {
+ if (part2Ptr != NULL) {
/*
* Array element sought: look it up.
*/
- part1 = TclGetString(part1Ptr);
*arrayPtrPtr = varPtr;
- varPtr = TclLookupArrayElement(interp, part1, part2, flags, msg,
- createPart1, createPart2, varPtr);
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
+ createPart1, createPart2, varPtr, -1);
+ if (newPart2) {
+ Tcl_DecrRefCount(part2Ptr);
+ }
}
return varPtr;
}
/*
- * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for
- * upvar (or similar) purposes, with slightly different rules:
+ * This flag bit should not interfere with TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
+ * lookup is performed for upvar (or similar) purposes, with slightly
+ * different rules:
* - Bug #696893 - variable is either proc-local or in the current
* namespace; never follow the second (global) resolution path
* - Bug #631741 - do not use special namespace or interp resolvers
@@ -610,14 +851,14 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
* (Bug #835020)
*/
-#define LOOKUP_FOR_UPVAR 0x40000
+#define AVOID_RESOLVERS 0x40000
/*
*----------------------------------------------------------------------
*
* TclLookupSimpleVar --
*
- * This procedure is used by to locate a simple variable (i.e., not an
+ * This function is used by to locate a simple variable (i.e., not an
* array element) given its name.
*
* Results:
@@ -650,23 +891,24 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
*
* Side effects:
* A new hashtable entry may be created if create is 1.
+ * Callers must Incr varNamePtr if they plan to Decr it if create is 1.
*
*----------------------------------------------------------------------
*/
Var *
-TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
- Tcl_Interp *interp; /* Interpreter to use for lookup. */
- CONST char *varName; /* This is a simple variable name that could
+TclLookupSimpleVar(
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ Tcl_Obj *varNamePtr, /* This is a simple variable name that could
* represent a scalar or an array. */
- int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
* matter. */
- CONST int create; /* If 1, create hash table entry for varname,
+ const int create, /* If 1, create hash table entry for varname,
* if it doesn't already exist. If 0, return
* error if it doesn't exist. */
- CONST char **errMsgPtr;
- int *indexPtr;
+ const char **errMsgPtr,
+ int *indexPtr)
{
Interp *iPtr = (Interp *) interp;
CallFrame *varFramePtr = iPtr->varFramePtr;
@@ -674,21 +916,21 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
* variables are currently in use. Same as the
* current procedure's frame, if any, unless
* an "uplevel" is executing. */
- Tcl_HashTable *tablePtr; /* Points to the hashtable, if any, in which
+ TclVarHashTable *tablePtr; /* Points to the hashtable, if any, in which
* to look up the variable. */
Tcl_Var var; /* Used to search for global names. */
Var *varPtr; /* Points to the Var structure returned for
* the variable. */
Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
ResolverScheme *resPtr;
- Tcl_HashEntry *hPtr;
- int new, i, result;
+ int isNew, i, result, varLen;
+ const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
varPtr = NULL;
- varNsPtr = NULL; /* set non-NULL if a nonlocal variable */
+ varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */
*indexPtr = -3;
- if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
+ if (flags & TCL_GLOBAL_ONLY) {
cxtNsPtr = iPtr->globalNsPtr;
} else {
cxtNsPtr = iPtr->varFramePtr->nsPtr;
@@ -696,15 +938,15 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
/*
* If this namespace has a variable resolver, then give it first crack at
- * the variable resolution. It may return a Tcl_Var value, it may signal
+ * the variable resolution. It may return a Tcl_Var value, it may signal
* to continue onward, or it may signal an error.
*/
if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
- && !(flags & LOOKUP_FOR_UPVAR)) {
+ && !(flags & AVOID_RESOLVERS)) {
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
- result = (*cxtNsPtr->varResProc)(interp, varName,
+ result = cxtNsPtr->varResProc(interp, varName,
(Tcl_Namespace *) cxtNsPtr, flags, &var);
} else {
result = TCL_CONTINUE;
@@ -712,7 +954,7 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
while (result == TCL_CONTINUE && resPtr) {
if (resPtr->varResProc) {
- result = (*resPtr->varResProc)(interp, varName,
+ result = resPtr->varResProc(interp, varName,
(Tcl_Namespace *) cxtNsPtr, flags, &var);
}
resPtr = resPtr->nextPtr;
@@ -727,7 +969,7 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
/*
* Look up varName. Look it up as either a namespace variable or as a
- * local variable in a procedure call frame (varFramePtr). Interpret
+ * local variable in a procedure call frame (varFramePtr). Interpret
* varName as a namespace variable if:
* 1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
* 2) there is no active frame (we're at the global :: scope),
@@ -743,22 +985,19 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
*/
if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
- || (varFramePtr == NULL)
- || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+ || !HasLocalVars(varFramePtr)
|| (strstr(varName, "::") != NULL)) {
- CONST char *tail;
- int lookGlobal;
-
- lookGlobal = (flags & TCL_GLOBAL_ONLY)
+ const char *tail;
+ int lookGlobal = (flags & TCL_GLOBAL_ONLY)
|| (cxtNsPtr == iPtr->globalNsPtr)
|| ((*varName == ':') && (*(varName+1) == ':'));
+
if (lookGlobal) {
*indexPtr = -1;
- flags = (flags | TCL_GLOBAL_ONLY) &
- ~(TCL_NAMESPACE_ONLY | LOOKUP_FOR_UPVAR);
+ flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
} else {
- if (flags & LOOKUP_FOR_UPVAR) {
- flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR;
+ if (flags & AVOID_RESOLVERS) {
+ flags = (flags | TCL_NAMESPACE_ONLY);
}
if (flags & TCL_NAMESPACE_ONLY) {
*indexPtr = -2;
@@ -770,30 +1009,29 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
* otherwise generate our own error!
*/
- var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
- flags & ~TCL_LEAVE_ERR_MSG);
-
- if (var != (Tcl_Var) NULL) {
- varPtr = (Var *) var;
- }
-
+ varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
+ (Tcl_Namespace *) cxtNsPtr,
+ (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
if (varPtr == NULL) {
- if (create) { /* var wasn't found so create it */
+ Tcl_Obj *tailPtr;
+
+ if (create) { /* Var wasn't found so create it. */
TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
if (varNsPtr == NULL) {
*errMsgPtr = badNamespace;
return NULL;
- }
- if (tail == NULL) {
+ } else if (tail == NULL) {
*errMsgPtr = missingName;
return NULL;
}
- hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = varNsPtr;
+ if (tail != varName) {
+ tailPtr = Tcl_NewStringObj(tail, -1);
+ } else {
+ tailPtr = varNamePtr;
+ }
+ varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
+ &isNew);
if (lookGlobal) {
/*
* The variable was created starting from the global
@@ -805,58 +1043,45 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
} else {
*indexPtr = -2;
}
- } else { /* var wasn't found and not to create it */
+ } else { /* Var wasn't found and not to create it. */
*errMsgPtr = noSuchVar;
return NULL;
}
}
- } else { /* local var: look in frame varFramePtr */
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
- Var *localVarPtr = varFramePtr->compiledLocals;
- int varNameLen = strlen(varName);
-
- for (i = 0; i < localCt; i++) {
- if (!TclIsVarTemporary(localPtr)) {
- register char *localName = localVarPtr->name;
- if ((varName[0] == localName[0])
- && (varNameLen == localPtr->nameLength)
- && (strcmp(varName, localName) == 0)) {
+ } else { /* Local var: look in frame varFramePtr. */
+ int localLen, localCt = varFramePtr->numCompiledLocals;
+ Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
+ const char *localNameStr;
+
+ for (i=0 ; i<localCt ; i++, objPtrPtr++) {
+ register Tcl_Obj *objPtr = *objPtrPtr;
+
+ if (objPtr) {
+ localNameStr = TclGetStringFromObj(objPtr, &localLen);
+
+ if ((varLen == localLen) && (varName[0] == localNameStr[0])
+ && !memcmp(varName, localNameStr, varLen)) {
*indexPtr = i;
- return localVarPtr;
+ return (Var *) &varFramePtr->compiledLocals[i];
}
}
- localVarPtr++;
- localPtr = localPtr->nextPtr;
}
tablePtr = varFramePtr->varTablePtr;
if (create) {
if (tablePtr == NULL) {
- tablePtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ tablePtr = ckalloc(sizeof(TclVarHashTable));
+ TclInitVarHashTable(tablePtr, NULL);
varFramePtr->varTablePtr = tablePtr;
}
- hPtr = Tcl_CreateHashEntry(tablePtr, varName, &new);
- if (new) {
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = NULL; /* a local variable */
- } else {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
- }
+ varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
} else {
- hPtr = NULL;
+ varPtr = NULL;
if (tablePtr != NULL) {
- hPtr = Tcl_FindHashEntry(tablePtr, varName);
+ varPtr = VarHashFindVar(tablePtr, varNamePtr);
}
- if (hPtr == NULL) {
+ if (varPtr == NULL) {
*errMsgPtr = noSuchVar;
- return NULL;
}
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
}
}
return varPtr;
@@ -867,7 +1092,7 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
*
* TclLookupArrayElement --
*
- * This procedure is used to locate a variable which is in an array's
+ * This function is used to locate a variable which is in an array's
* hashtable given a pointer to the array's Var structure and the
* element's name.
*
@@ -895,31 +1120,36 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
* The variable at arrayPtr may be converted to be an array if
* createPart1 is 1. A new hashtable entry may be created if createPart2
* is 1.
+ * When createElem is 1, callers must incr elNamePtr if they plan
+ * to decr it.
*
*----------------------------------------------------------------------
*/
Var *
-TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, createElem, arrayPtr)
- Tcl_Interp *interp; /* Interpreter to use for lookup. */
- CONST char *arrayName; /* This is the name of the array. */
- CONST char *elName; /* Name of element within array. */
- CONST int flags; /* Only TCL_LEAVE_ERR_MSG bit matters. */
- CONST char *msg; /* Verb to use in error messages, e.g. "read"
+TclLookupArrayElement(
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if
+ * index>= 0. */
+ Tcl_Obj *elNamePtr, /* Name of element within array. */
+ const int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */
+ const char *msg, /* Verb to use in error messages, e.g. "read"
* or "set". Only needed if TCL_LEAVE_ERR_MSG
* is set in flags. */
- CONST int createArray; /* If 1, transform arrayName to be an array if
+ const int createArray, /* If 1, transform arrayName to be an array if
* it isn't one yet and the transformation is
* possible. If 0, return error if it isn't
* already an array. */
- CONST int createElem; /* If 1, create hash table entry for the
+ const int createElem, /* If 1, create hash table entry for the
* element, if it doesn't already exist. If 0,
* return error if it doesn't exist. */
- Var *arrayPtr; /* Pointer to the array's Var structure. */
+ Var *arrayPtr, /* Pointer to the array's Var structure. */
+ int index) /* If >=0, the index of the local array. */
{
- Tcl_HashEntry *hPtr;
- int new;
+ int isNew;
Var *varPtr;
+ TclVarHashTable *tablePtr;
+ Namespace *nsPtr;
/*
* We're dealing with an array element. Make sure the variable is an array
@@ -929,7 +1159,10 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
if (!createArray) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, arrayName, elName, msg, noSuchVar);
+ TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+ noSuchVar, index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
}
return NULL;
}
@@ -939,47 +1172,57 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
* deleted namespace!
*/
- if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
+ if (TclIsVarDeadHash(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, arrayName, elName, msg, danglingVar);
+ TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+ danglingVar, index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
}
return NULL;
}
TclSetVarArray(arrayPtr);
- TclClearVarUndefined(arrayPtr);
- arrayPtr->value.tablePtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+ tablePtr = ckalloc(sizeof(TclVarHashTable));
+ arrayPtr->value.tablePtr = tablePtr;
+
+ if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
+ nsPtr = TclGetVarNsPtr(arrayPtr);
+ } else {
+ nsPtr = NULL;
+ }
+ TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
} else if (!TclIsVarArray(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, arrayName, elName, msg, needArray);
+ TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
+ index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
}
return NULL;
}
if (createElem) {
- hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
- if (new) {
- if (arrayPtr->searchPtr != NULL) {
- DeleteSearches(arrayPtr);
+ varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr,
+ &isNew);
+ if (isNew) {
+ if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
+ DeleteSearches((Interp *) interp, arrayPtr);
}
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = arrayPtr->nsPtr;
TclSetVarArrayElement(varPtr);
}
} else {
- hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
- if (hPtr == NULL) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
+ if (varPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, arrayName, elName, msg, noSuchElement);
+ TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+ noSuchElement, index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
+ TclGetString(elNamePtr), NULL);
}
- return NULL;
}
}
- return (Var *) Tcl_GetHashValue(hPtr);
+ return varPtr;
}
/*
@@ -1004,16 +1247,25 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetVar(interp, varName, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
+#undef Tcl_GetVar
+const char *
+Tcl_GetVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
- CONST char *varName; /* Name of a variable in interp. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ const char *varName, /* Name of a variable in interp. */
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
* bits. */
{
- return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
+ Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1);
+ Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
+
+ TclDecrRefCount(varNamePtr);
+
+ if (resultPtr == NULL) {
+ return NULL;
+ }
+ return TclGetString(resultPtr);
}
/*
@@ -1039,25 +1291,36 @@ Tcl_GetVar(interp, varName, flags)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_GetVar2(interp, part1, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+const char *
+Tcl_GetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- CONST char *part1; /* Name of an array (if part2 is non-NULL) or
+ const char *part1, /* Name of an array (if part2 is non-NULL) or
* the name of a variable. */
- CONST char *part2; /* If non-NULL, gives the name of an element
+ const char *part2, /* If non-NULL, gives the name of an element
* in the array part1. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
* bits. */
{
- Tcl_Obj *objPtr;
+ Tcl_Obj *resultPtr;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
+ Tcl_IncrRefCount(part2Ptr);
+ }
+
+ resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
- objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
- if (objPtr == NULL) {
+ Tcl_DecrRefCount(part1Ptr);
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
+ }
+ if (resultPtr == NULL) {
return NULL;
}
- return TclGetString(objPtr);
+ return TclGetString(resultPtr);
}
/*
@@ -1084,32 +1347,31 @@ Tcl_GetVar2(interp, part1, part2, flags)
*/
Tcl_Obj *
-Tcl_GetVar2Ex(interp, part1, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+Tcl_GetVar2Ex(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- CONST char *part1; /* Name of an array (if part2 is non-NULL) or
+ const char *part1, /* Name of an array (if part2 is non-NULL) or
* the name of a variable. */
- CONST char *part2; /* If non-NULL, gives the name of an element
+ const char *part2, /* If non-NULL, gives the name of an element
* in the array part1. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
- Var *varPtr, *arrayPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- /*
- * We need a special flag check to see if we want to create part 1,
- * because commands like lappend require read traces to trigger for
- * previously non-existent values.
- */
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
+ Tcl_IncrRefCount(part2Ptr);
+ }
- varPtr = TclLookupVar(interp, part1, part2, flags, "read",
- /*createPart1*/ (flags & TCL_TRACE_READS),
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- return NULL;
+ resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+
+ Tcl_DecrRefCount(part1Ptr);
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
}
- return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+ return resPtr;
}
/*
@@ -1132,42 +1394,39 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
* the returned reference; if you want to keep a reference to the object
* you must increment its ref count yourself.
*
+ * Callers must incr part2Ptr if they plan to decr it.
+ *
*----------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+Tcl_ObjGetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an
+ register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
- register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
+ register Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
* the name of an element in the array
* part1Ptr. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY and
+ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and
* TCL_LEAVE_ERR_MSG bits. */
{
Var *varPtr, *arrayPtr;
- char *part1, *part2;
-
- part1 = TclGetString(part1Ptr);
- part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr));
/*
- * We need a special flag check to see if we want to create part 1,
- * because commands like lappend require read traces to trigger for
- * previously non-existent values.
+ * Filter to pass through only the flags this interface supports.
*/
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
- /*createPart1*/ (flags & TCL_TRACE_READS),
- /*createPart2*/ 1, &arrayPtr);
+ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
+ /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return NULL;
}
- return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+ return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ flags, -1);
}
/*
@@ -1193,31 +1452,35 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
*/
Tcl_Obj *
-TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+TclPtrGetVar(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- register Var *varPtr; /* The variable to be read.*/
- Var *arrayPtr; /* NULL for scalar variables, pointer to the
+ register Var *varPtr, /* The variable to be read.*/
+ Var *arrayPtr, /* NULL for scalar variables, pointer to the
* containing array otherwise. */
- CONST char *part1; /* Name of an array (if part2 is non-NULL) or
+ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
* the name of a variable. */
- CONST char *part2; /* If non-NULL, gives the name of an element
+ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
- CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
Interp *iPtr = (Interp *) interp;
- CONST char *msg;
+ const char *msg;
/*
- * Invoke any traces that have been set for the variable.
+ * Invoke any read traces that have been set for the variable.
*/
- if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+ if ((varPtr->flags & VAR_TRACED_READ)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
+ if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+ part1Ptr, part2Ptr,
(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
- | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+ | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
goto errorReturn;
}
}
@@ -1231,7 +1494,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
}
if (flags & TCL_LEAVE_ERR_MSG) {
- if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+ if (TclIsVarUndefined(varPtr) && arrayPtr
&& !TclIsVarUndefined(arrayPtr)) {
msg = noSuchElement;
} else if (TclIsVarArray(varPtr)) {
@@ -1239,7 +1502,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
} else {
msg = noSuchVar;
}
- TclVarErrMsg(interp, part1, part2, "read", msg);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
}
/*
@@ -1248,6 +1511,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
*/
errorReturn:
+ Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
}
@@ -1259,7 +1523,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
*
* Tcl_SetObjCmd --
*
- * This procedure is invoked to process the "set" Tcl command. See the
+ * This function is invoked to process the "set" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1273,16 +1537,16 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
/* ARGSUSED */
int
-Tcl_SetObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- register Tcl_Interp *interp;/* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SetObjCmd(
+ ClientData dummy, /* Not used. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varValueObj;
if (objc == 2) {
- varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+ varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
if (varValueObj == NULL) {
return TCL_ERROR;
}
@@ -1311,12 +1575,12 @@ Tcl_SetObjCmd(dummy, interp, objc, objv)
*
* Results:
* Returns a pointer to the malloc'ed string which is the character
- * representation of the variable's new value. The caller must not
- * modify this string. If the write operation was disallowed then NULL
- * is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
- * explanatory message will be left in the interp's result. Note that the
- * returned string may not be the same as newValue; this is because
- * variable traces may modify the variable's value.
+ * representation of the variable's new value. The caller must not modify
+ * this string. If the write operation was disallowed then NULL is
+ * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
+ * message will be left in the interp's result. Note that the returned
+ * string may not be the same as newValue; this is because variable
+ * traces may modify the variable's value.
*
* Side effects:
* If varName is defined as a local or global variable in interp, its
@@ -1326,18 +1590,29 @@ Tcl_SetObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_SetVar(interp, varName, newValue, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
+#undef Tcl_SetVar
+const char *
+Tcl_SetVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
- CONST char *varName; /* Name of a variable in interp. */
- CONST char *newValue; /* New value for varName. */
- int flags; /* Various flags that tell how to set value:
+ const char *varName, /* Name of a variable in interp. */
+ const char *newValue, /* New value for varName. */
+ int flags) /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
{
- return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
+ Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1);
+
+ Tcl_IncrRefCount(varNamePtr);
+ varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+ Tcl_NewStringObj(newValue, -1), flags);
+ Tcl_DecrRefCount(varNamePtr);
+
+ if (varValuePtr == NULL) {
+ return NULL;
+ }
+ return TclGetString(varValuePtr);
}
/*
@@ -1366,34 +1641,23 @@ Tcl_SetVar(interp, varName, newValue, flags)
*----------------------------------------------------------------------
*/
-CONST char *
-Tcl_SetVar2(interp, part1, part2, newValue, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+const char *
+Tcl_SetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- CONST char *part1; /* If part2 is NULL, this is name of scalar
+ const char *part1, /* If part2 is NULL, this is name of scalar
* variable. Otherwise it is the name of an
* array. */
- CONST char *part2; /* Name of an element within an array, or
+ const char *part2, /* Name of an element within an array, or
* NULL. */
- CONST char *newValue; /* New value for variable. */
- int flags; /* Various flags that tell how to set value:
+ const char *newValue, /* New value for variable. */
+ int flags) /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
- * TCL_LEAVE_ERR_MSG */
+ * TCL_LEAVE_ERR_MSG. */
{
- register Tcl_Obj *valuePtr;
- Tcl_Obj *varValuePtr;
-
- /*
- * Create an object holding the variable's new value and use Tcl_SetVar2Ex
- * to actually set the variable.
- */
-
- valuePtr = Tcl_NewStringObj(newValue, -1);
- Tcl_IncrRefCount(valuePtr);
-
- varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
- TclDecrRefCount(valuePtr); /* done with the object */
+ Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+ Tcl_NewStringObj(newValue, -1), flags);
if (varValuePtr == NULL) {
return NULL;
@@ -1440,29 +1704,35 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
*/
Tcl_Obj *
-Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+Tcl_SetVar2Ex(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be found. */
- CONST char *part1; /* Name of an array (if part2 is non-NULL) or
+ const char *part1, /* Name of an array (if part2 is non-NULL) or
* the name of a variable. */
- CONST char *part2; /* If non-NULL, gives the name of an element
+ const char *part2, /* If non-NULL, gives the name of an element
* in the array part1. */
- Tcl_Obj *newValuePtr; /* New value for variable. */
- int flags; /* Various flags that tell how to set value:
+ Tcl_Obj *newValuePtr, /* New value for variable. */
+ int flags) /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
* TCL_LEAVE_ERR_MSG. */
{
- Var *varPtr, *arrayPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- varPtr = TclLookupVar(interp, part1, part2, flags, "set",
- /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- return NULL;
+ Tcl_IncrRefCount(part1Ptr);
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
+ Tcl_IncrRefCount(part2Ptr);
+ }
+
+ resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
+
+ Tcl_DecrRefCount(part1Ptr);
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
}
- return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
- newValuePtr, flags);
+ return resPtr;
}
/*
@@ -1485,40 +1755,47 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
* Side effects:
* The value of the given variable is set. If either the array or the
* entry didn't exist then a new variable is created.
+ * Callers must Incr part1Ptr if they plan to Decr it.
+ * Callers must Incr part2Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+Tcl_ObjSetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be found. */
- register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an
+ register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
- register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
+ register Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding
* the name of an element in the array
* part1Ptr. */
- Tcl_Obj *newValuePtr; /* New value for variable. */
- int flags; /* Various flags that tell how to set value:
+ Tcl_Obj *newValuePtr, /* New value for variable. */
+ int flags) /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
* TCL_LEAVE_ERR_MSG. */
{
Var *varPtr, *arrayPtr;
- char *part1, *part2;
- part1 = TclGetString(part1Ptr);
- part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr));
+ /*
+ * Filter to pass through only the flags this interface supports.
+ */
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
+ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
+ |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
+ if (newValuePtr->refCount == 0) {
+ Tcl_DecrRefCount(newValuePtr);
+ }
return NULL;
}
- return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
- newValuePtr, flags);
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ newValuePtr, flags, -1);
}
/*
@@ -1547,64 +1824,79 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
*/
Tcl_Obj *
-TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+TclPtrSetVar(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
- register Var *varPtr;
- Var *arrayPtr;
- CONST char *part1; /* Name of an array (if part2 is non-NULL) or
- * the name of a variable. */
- CONST char *part2; /* If non-NULL, gives the name of an element
+ register Var *varPtr, /* Reference to the variable to set. */
+ 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. */
- Tcl_Obj *newValuePtr; /* New value for variable. */
- CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and
+ Tcl_Obj *newValuePtr, /* New value for variable. */
+ const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
+ int index) /* Index of local var where part1 is to be
+ * found. */
{
Interp *iPtr = (Interp *) interp;
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
* may have an upvar to an array element where the array was deleted or an
- * upvar to a namespace variable whose namespace was deleted. Generate an
+ * upvar to a namespace variable whose namespace was deleted. Generate an
* error (allowing the variable to be reset would screw up our storage
* allocation and is meaningless anyway).
*/
- if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+ if (TclIsVarDeadHash(varPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
if (TclIsVarArrayElement(varPtr)) {
- TclVarErrMsg(interp, part1, part2, "set", danglingElement);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
+ danglingElement, index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
} else {
- TclVarErrMsg(interp, part1, part2, "set", danglingVar);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
+ danglingVar, index);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
}
}
- return NULL;
+ goto earlyError;
}
/*
* It's an error to try to set an array variable itself.
*/
- if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ if (TclIsVarArray(varPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, part1, part2, "set", isArray);
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
}
- return NULL;
+ goto earlyError;
}
/*
* Invoke any read traces that have been set for the variable if it is
- * requested; this is only done in the core when lappending.
+ * requested. This was done for INST_LAPPEND_* but that was inconsistent
+ * with the non-bc instruction, and would cause failures trying to
+ * lappend to any non-existing ::env var, which is inconsistent with
+ * documented behavior. [Bug #3057639].
*/
- if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
- if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
- TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
- return NULL;
+ if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) {
+ if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+ part1Ptr, part2Ptr,
+ TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
+ goto earlyError;
}
}
@@ -1615,33 +1907,39 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
* otherwise we must create a new copy to modify: this is "copy on write".
*/
+ oldValuePtr = varPtr->value.objPtr;
if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
- TclSetVarUndefined(varPtr);
+ varPtr->value.objPtr = NULL;
}
- oldValuePtr = varPtr->value.objPtr;
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
+ /*
+ * Can't happen now!
+ */
+
if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
- TclDecrRefCount(oldValuePtr); /* discard old value */
+ TclDecrRefCount(oldValuePtr); /* Discard old value. */
varPtr->value.objPtr = NULL;
oldValuePtr = NULL;
}
- if (flags & TCL_LIST_ELEMENT) { /* append list element */
+#endif
+ if (flags & TCL_LIST_ELEMENT) { /* Append list element. */
if (oldValuePtr == NULL) {
TclNewObj(oldValuePtr);
varPtr->value.objPtr = oldValuePtr;
- Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
} else if (Tcl_IsShared(oldValuePtr)) {
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
- Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
}
result = Tcl_ListObjAppendElement(interp, oldValuePtr,
newValuePtr);
if (result != TCL_OK) {
- return NULL;
+ goto earlyError;
}
- } else { /* append string */
+ } else { /* Append string. */
/*
* We append newValuePtr's bytes but don't change its ref count.
*/
@@ -1650,11 +1948,14 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
varPtr->value.objPtr = newValuePtr;
Tcl_IncrRefCount(newValuePtr);
} else {
- if (Tcl_IsShared(oldValuePtr)) { /* append to copy */
+ if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+ TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
+
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
- Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
}
Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
}
@@ -1666,26 +1967,21 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
*/
varPtr->value.objPtr = newValuePtr;
- Tcl_IncrRefCount(newValuePtr); /* var is another ref */
+ Tcl_IncrRefCount(newValuePtr); /* Var is another ref. */
if (oldValuePtr != NULL) {
- TclDecrRefCount(oldValuePtr); /* discard old value */
+ TclDecrRefCount(oldValuePtr); /* Discard old value. */
}
}
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
- if (arrayPtr != NULL) {
- TclClearVarUndefined(arrayPtr);
- }
/*
* Invoke any write traces for the variable.
*/
- if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
- | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
+ if ((varPtr->flags & VAR_TRACED_WRITE)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) {
+ if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
+ part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG), index)) {
goto cleanup;
}
}
@@ -1713,27 +2009,36 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
*/
cleanup:
+ if (resultPtr == NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
+ }
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
}
return resultPtr;
+
+ earlyError:
+ if (cleanupOnEarlyError) {
+ Tcl_DecrRefCount(newValuePtr);
+ }
+ goto cleanup;
}
/*
*----------------------------------------------------------------------
*
- * TclIncrVar2 --
+ * TclIncrObjVar2 --
*
* Given a two-part variable name, which may refer either to a scalar
* variable or an element of an array, increment the Tcl object value of
- * the variable by a specified amount.
+ * the variable by a specified Tcl_Obj increment value.
*
* Results:
* Returns a pointer to the Tcl_Obj holding the new value of the
- * variable. If the specified variable doesn't exist, or there is a
- * clash in array usage, or an error occurs while executing variable
- * traces, then NULL is returned and a message will be left in the
- * interpreter's result.
+ * variable. If the specified variable doesn't exist, or there is a clash
+ * in array usage, or an error occurs while executing variable traces,
+ * then NULL is returned and a message will be left in the interpreter's
+ * result.
*
* Side effects:
* The value of the given variable is incremented by the specified
@@ -1741,57 +2046,55 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
* variable is created. The ref count for the returned object is _not_
* incremented to reflect the returned reference; if you want to keep a
* reference to the object you must increment its ref count yourself.
+ * Callers must Incr part1Ptr if they plan to Decr it.
+ * Callers must Incr part2Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+TclIncrObjVar2(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be found. */
- Tcl_Obj *part1Ptr; /* Points to an object holding the name of an
+ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
- Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
+ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
* the name of an element in the array
* part1Ptr. */
- long incrAmount; /* Amount to be added to variable. */
- int flags; /* Various flags that tell how to incr value:
+ Tcl_Obj *incrPtr, /* Amount to be added to variable. */
+ int flags) /* Various flags that tell how to incr value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
{
Var *varPtr, *arrayPtr;
- char *part1, *part2;
-
- part1 = TclGetString(part1Ptr);
- part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
- 0, 1, &arrayPtr);
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
+ 1, 1, &arrayPtr);
if (varPtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
+ Tcl_AddErrorInfo(interp,
+ "\n (reading value of variable to increment)");
return NULL;
}
- return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,
- incrAmount, flags);
+ return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ incrPtr, flags, -1);
}
/*
*----------------------------------------------------------------------
*
- * TclPtrIncrVar --
+ * TclPtrIncrObjVar --
*
* Given the pointers to a variable and possible containing array,
- * increment the Tcl object value of the variable by a specified amount.
+ * increment the Tcl object value of the variable by a Tcl_Obj increment.
*
* Results:
* Returns a pointer to the Tcl_Obj holding the new value of the
- * variable. If the specified variable doesn't exist, or there is a
- * clash in array usage, or an error occurs while executing variable
- * traces, then NULL is returned and a message will be left in the
- * interpreter's result.
+ * variable. If the specified variable doesn't exist, or there is a clash
+ * in array usage, or an error occurs while executing variable traces,
+ * then NULL is returned and a message will be left in the interpreter's
+ * result.
*
* Side effects:
* The value of the given variable is incremented by the specified
@@ -1804,400 +2107,366 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
*/
Tcl_Obj *
-TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
+TclPtrIncrObjVar(
+ Tcl_Interp *interp, /* Command interpreter in which variable is to
* be found. */
- Var *varPtr;
- Var *arrayPtr;
- CONST char *part1; /* Points to an object holding the name of an
+ Var *varPtr, /* Reference to the variable to set. */
+ Var *arrayPtr, /* Reference to the array containing the
+ * variable, or NULL if the variable is a
+ * scalar. */
+ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
- CONST char *part2; /* If non-null, points to an object holding
+ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
* the name of an element in the array
* part1Ptr. */
- CONST long incrAmount; /* Amount to be added to variable. */
- CONST int flags; /* Various flags that tell how to incr value:
+ Tcl_Obj *incrPtr, /* Increment value. */
+/* TODO: Which of these flag values really make sense? */
+ const int flags, /* Various flags that tell how to incr value:
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
register Tcl_Obj *varValuePtr;
- int createdNewObj; /* Set 1 if var's value object is shared so we
- * must increment a copy (i.e. copy on
- * write). */
- long i;
-
- varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
+ varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ flags, index);
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
if (varValuePtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- return NULL;
+ varValuePtr = Tcl_NewIntObj(0);
}
-
- /*
- * Increment the variable's value. If the object is unshared we can modify
- * it directly, otherwise we must create a new copy to modify: this is
- * "copy on write". Then free the variable's old string representation, if
- * any, since it will no longer be valid.
- */
-
- createdNewObj = 0;
if (Tcl_IsShared(varValuePtr)) {
+ /* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
- createdNewObj = 1;
- }
- if (varValuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt wide;
- TclGetWide(wide,varValuePtr);
- TclSetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
- } else if (varValuePtr->typePtr == &tclIntType) {
- i = varValuePtr->internalRep.longValue;
- TclSetIntObj(varValuePtr, i + incrAmount);
- } else {
- /*
- * Not an integer or wide internal-rep...
- */
-
- Tcl_WideInt wide;
- if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
- if (createdNewObj) {
- TclDecrRefCount(varValuePtr); /* free unneeded copy */
- }
+
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ Tcl_DecrRefCount(varValuePtr);
return NULL;
}
- if (wide <= Tcl_LongAsWide(LONG_MAX)
- && wide >= Tcl_LongAsWide(LONG_MIN)) {
- TclSetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);
+ } else {
+ /* Unshared - can Incr in place */
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+
+ /*
+ * This seems dumb to write the incremeted value into the var
+ * after we just adjusted the value in place, but the spec for
+ * [incr] requires that write traces fire, and making this call
+ * is the way to make that happen.
+ */
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
} else {
- TclSetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
+ return NULL;
}
}
-
- /*
- * Store the variable's new value and run any write traces.
- */
-
- return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
- varValuePtr, flags);
}
/*
*----------------------------------------------------------------------
*
- * TclIncrWideVar2 --
+ * Tcl_UnsetVar --
*
- * Given a two-part variable name, which may refer either to a scalar
- * variable or an element of an array, increment the Tcl object value of
- * the variable by a specified amount.
+ * Delete a variable, so that it may not be accessed anymore.
*
* Results:
- * Returns a pointer to the Tcl_Obj holding the new value of the
- * variable. If the specified variable doesn't exist, or there is a
- * clash in array usage, or an error occurs while executing variable
- * traces, then NULL is returned and a message will be left in the
- * interpreter's result.
+ * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ * the variable can't be unset. In the event of an error, if the
+ * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ * interp's result.
*
* Side effects:
- * The value of the given variable is incremented by the specified
- * amount. If either the array or the entry didn't exist then a new
- * variable is created. The ref count for the returned object is _not_
- * incremented to reflect the returned reference; if you want to keep a
- * reference to the object you must increment its ref count yourself.
+ * If varName is defined as a local or global variable in interp, it is
+ * deleted.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj *
-TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
- * be found. */
- Tcl_Obj *part1Ptr; /* Points to an object holding the name of an
- * array (if part2 is non-NULL) or the name of
- * a variable. */
- Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
- * the name of an element in the array
- * part1Ptr. */
- Tcl_WideInt incrAmount; /* Amount to be added to variable. */
- int flags; /* Various flags that tell how to incr value:
- * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
+#undef Tcl_UnsetVar
+int
+Tcl_UnsetVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
+ * be looked up. */
+ const char *varName, /* Name of a variable in interp. May be either
+ * a scalar name or an array name or an
+ * element in an array. */
+ int flags) /* OR-ed combination of any of
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
* TCL_LEAVE_ERR_MSG. */
{
- Var *varPtr, *arrayPtr;
- char *part1, *part2;
+ int result;
+ Tcl_Obj *varNamePtr;
- part1 = TclGetString(part1Ptr);
- part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
+ varNamePtr = Tcl_NewStringObj(varName, -1);
+ Tcl_IncrRefCount(varNamePtr);
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
- 0, 1, &arrayPtr);
- if (varPtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- return NULL;
- }
- return TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2,
- incrAmount, flags);
+ /*
+ * Filter to pass through only the flags this interface supports.
+ */
+
+ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
+ result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags);
+
+ Tcl_DecrRefCount(varNamePtr);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * TclPtrIncrWideVar --
+ * Tcl_UnsetVar2 --
*
- * Given the pointers to a variable and possible containing array,
- * increment the Tcl object value of the variable by a specified amount.
+ * Delete a variable, given a 2-part name.
*
* Results:
- * Returns a pointer to the Tcl_Obj holding the new value of the
- * variable. If the specified variable doesn't exist, or there is a clash
- * in array usage, or an error occurs while executing variable traces,
- * then NULL is returned and a message will be left in the interpreter's
- * result.
+ * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ * the variable can't be unset. In the event of an error, if the
+ * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ * interp's result.
*
* Side effects:
- * The value of the given variable is incremented by the specified
- * amount. If either the array or the entry didn't exist then a new
- * variable is created. The ref count for the returned object is _not_
- * incremented to reflect the returned reference; if you want to keep a
- * reference to the object you must increment its ref count yourself.
+ * If part1 and part2 indicate a local or global variable in interp, it
+ * is deleted. If part1 is an array name and part2 is NULL, then the
+ * whole array is deleted.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj *
-TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
- Tcl_Interp *interp; /* Command interpreter in which variable is to
- * be found. */
- Var *varPtr;
- Var *arrayPtr;
- CONST char *part1; /* Points to an object holding the name of an
- * array (if part2 is non-NULL) or the name of
- * a variable. */
- CONST char *part2; /* If non-null, points to an object holding
- * the name of an element in the array
- * part1Ptr. */
- CONST Tcl_WideInt incrAmount;
- /* Amount to be added to variable. */
- CONST int flags; /* Various flags that tell how to incr value:
- * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
+int
+Tcl_UnsetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
+ * be looked up. */
+ const char *part1, /* Name of variable or array. */
+ const char *part2, /* Name of element within array or NULL. */
+ int flags) /* OR-ed combination of any of
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
{
- register Tcl_Obj *varValuePtr;
- int createdNewObj; /* Set 1 if var's value object is shared so we
- * must increment a copy (i.e. copy on
- * write). */
- Tcl_WideInt wide;
-
- varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+ int result;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- if (varValuePtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- return NULL;
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
}
/*
- * Increment the variable's value. If the object is unshared we can modify
- * it directly, otherwise we must create a new copy to modify: this is
- * "copy on write". Then free the variable's old string representation, if
- * any, since it will no longer be valid.
+ * Filter to pass through only the flags this interface supports.
*/
- createdNewObj = 0;
- if (Tcl_IsShared(varValuePtr)) {
- varValuePtr = Tcl_DuplicateObj(varValuePtr);
- createdNewObj = 1;
- }
- if (varValuePtr->typePtr == &tclWideIntType) {
- TclGetWide(wide, varValuePtr);
- TclSetWideIntObj(varValuePtr, wide + incrAmount);
- } else if (varValuePtr->typePtr == &tclIntType) {
- long i = varValuePtr->internalRep.longValue;
- TclSetWideIntObj(varValuePtr, Tcl_LongAsWide(i) + incrAmount);
- } else {
- /*
- * Not an integer or wide internal-rep...
- */
+ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
+ result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);
- if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
- if (createdNewObj) {
- TclDecrRefCount(varValuePtr); /* free unneeded copy */
- }
- return NULL;
- }
- TclSetWideIntObj(varValuePtr, wide + incrAmount);
+ Tcl_DecrRefCount(part1Ptr);
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
}
-
- /*
- * Store the variable's new value and run any write traces.
- */
-
- return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
- varValuePtr, flags);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_UnsetVar --
+ * TclObjUnsetVar2 --
*
- * Delete a variable, so that it may not be accessed anymore.
+ * Delete a variable, given a 2-object name.
*
* Results:
* Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
- * the variable can't be unset. In the event of an error, if the
+ * the variable can't be unset. In the event of an error, if the
* TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
* interp's result.
*
* Side effects:
- * If varName is defined as a local or global variable in interp, it is
- * deleted.
+ * If part1ptr and part2Ptr indicate a local or global variable in
+ * interp, it is deleted. If part1Ptr is an array name and part2Ptr is
+ * NULL, then the whole array is deleted.
*
*----------------------------------------------------------------------
*/
int
-Tcl_UnsetVar(interp, varName, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
+TclObjUnsetVar2(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
- CONST char *varName; /* Name of a variable in interp. May be either
- * a scalar name or an array name or an
- * element in an array. */
- int flags; /* OR-ed combination of any of
- * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
+ Tcl_Obj *part1Ptr, /* Name of variable or array. */
+ Tcl_Obj *part2Ptr, /* Name of element within array or NULL. */
+ int flags) /* OR-ed combination of any of
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
{
- return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
+ Var *varPtr, *arrayPtr;
+
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
+ /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ return TclPtrUnsetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags,
+ -1);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_UnsetVar2 --
+ * TclPtrUnsetVar --
*
- * Delete a variable, given a 2-part name.
+ * Delete a variable, given the pointers to the variable's (and possibly
+ * containing array's) VAR structure.
*
* Results:
* Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
- * the variable can't be unset. In the event of an error, if the
+ * the variable can't be unset. In the event of an error, if the
* TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
* interp's result.
*
* Side effects:
- * If part1 and part2 indicate a local or global variable in interp, it
- * is deleted. If part1 is an array name and part2 is NULL, then the
- * whole array is deleted.
+ * If varPtr and arrayPtr indicate a local or global variable in interp,
+ * it is deleted. If varPtr is an array reference and part2Ptr is NULL,
+ * then the whole array is deleted.
*
*----------------------------------------------------------------------
*/
int
-Tcl_UnsetVar2(interp, part1, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
+TclPtrUnsetVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
- CONST char *part1; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array or NULL. */
- int flags; /* OR-ed combination of any of
+ register Var *varPtr, /* The variable to be unset. */
+ Var *arrayPtr, /* NULL for scalar variables, pointer to the
+ * containing array otherwise. */
+ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
+ * the name of a variable. */
+ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ const int flags, /* OR-ed combination of any of
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
- int result;
- Tcl_Obj *part1Ptr;
+ Interp *iPtr = (Interp *) interp;
+ int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
- result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);
- TclDecrRefCount(part1Ptr);
+ /*
+ * Keep the variable alive until we're done with it. We used to
+ * increase/decrease the refCount for each operation, making it hard to
+ * find [Bug 735335] - caused by unsetting the variable whose value was
+ * the variable's name.
+ */
+
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
+
+ UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
+
+ /*
+ * It's an error to unset an undefined variable.
+ */
+
+ if (result != TCL_OK) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
+ ((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
+ Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
+ }
+ }
+
+#if ENABLE_NS_VARNAME_CACHING
+ /*
+ * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
+ * keeping a reference. This removes some additional exteriorisations of
+ * [Bug 736729], but may be a good thing independently of the bug.
+ */
+ if (part1Ptr->typePtr == &tclNsVarNameType) {
+ TclFreeIntRep(part1Ptr);
+ }
+#endif
+
+ /*
+ * Finally, if the variable is truly not in use then free up its Var
+ * structure and remove it from its hash table, if any. The ref count of
+ * its value object, if any, was decremented above.
+ */
+
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ CleanupVar(varPtr, arrayPtr);
+ }
return result;
}
/*
*----------------------------------------------------------------------
*
- * TclObjUnsetVar2 --
+ * UnsetVarStruct --
*
- * Delete a variable, given a 2-object name.
+ * Unset and delete a variable. This does the internal work for
+ * TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each
+ * variable to be unset and deleted.
*
* Results:
- * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
- * the variable can't be unset. In the event of an error, if the
- * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
- * interp's result.
+ * None.
*
* Side effects:
- * If part1ptr and part2Ptr indicate a local or global variable in
- * interp, it is deleted. If part1Ptr is an array name and part2Ptr is
- * NULL, then the whole array is deleted.
+ * If the arguments indicate a local or global variable in iPtr, it is
+ * unset and deleted.
*
*----------------------------------------------------------------------
*/
-int
-TclObjUnsetVar2(interp, part1Ptr, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
- * be looked up. */
- Tcl_Obj *part1Ptr; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array or NULL. */
- int flags; /* OR-ed combination of any of
- * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_LEAVE_ERR_MSG. */
+static void
+UnsetVarStruct(
+ Var *varPtr,
+ Var *arrayPtr,
+ Interp *iPtr,
+ Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr,
+ int flags,
+ int index)
{
Var dummyVar;
- Var *varPtr, *dummyVarPtr;
- Interp *iPtr = (Interp *) interp;
- Var *arrayPtr;
- ActiveVarTrace *activePtr;
- Tcl_Obj *objPtr;
- int result;
- char *part1;
-
- part1 = TclGetString(part1Ptr);
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
- /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- if (varPtr == NULL) {
- return TCL_ERROR;
- }
+ int traced = TclIsVarTraced(varPtr)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET));
- result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
-
- if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
- DeleteSearches(arrayPtr);
+ if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
+ DeleteSearches(iPtr, arrayPtr);
+ } else if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+ DeleteSearches(iPtr, varPtr);
}
/*
* The code below is tricky, because of the possibility that a trace
- * procedure might try to access a variable being deleted. To handle this
+ * function might try to access a variable being deleted. To handle this
* situation gracefully, do things in three steps:
* 1. Copy the contents of the variable to a dummy variable structure, and
* mark the original Var structure as undefined.
* 2. Invoke traces and clean up the variable, using the dummy copy.
* 3. If at the end of this the original variable is still undefined and
- * has no outstanding references, then delete * it (but it could have
+ * has no outstanding references, then delete it (but it could have
* gotten recreated by a trace).
*/
dummyVar = *varPtr;
+ dummyVar.flags &= ~VAR_ALL_HASH;
TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
- varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
-
- /*
- * Keep the variable alive until we're done with it. We used to
- * increase/decrease the refCount for each operation, making it hard to
- * find [Bug 735335] - caused by unsetting the variable whose value was
- * the variable's name.
- */
-
- varPtr->refCount++;
/*
- * Call trace procedures for the variable being deleted. Then delete its
+ * Call trace functions for the variable being deleted. Then delete its
* traces. Be sure to abort any other traces for the variable that are
* still pending. Special tricks:
* 1. We need to increment varPtr's refCount around this: TclCallVarTraces
@@ -2206,102 +2475,113 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
* unset traces even if other traces are pending.
*/
- if ((dummyVar.tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- dummyVar.flags &= ~VAR_TRACE_ACTIVE;
- TclCallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
- | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);
- while (dummyVar.tracePtr != NULL) {
- VarTrace *tracePtr = dummyVar.tracePtr;
- dummyVar.tracePtr = tracePtr->nextPtr;
- Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
- }
- for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
- if (activePtr->varPtr == varPtr) {
- activePtr->nextTracePtr = NULL;
+ if (traced) {
+ VarTrace *tracePtr = NULL;
+ Tcl_HashEntry *tPtr;
+
+ if (TclIsVarTraced(&dummyVar)) {
+ /*
+ * Transfer any existing traces on var, IF there are unset traces.
+ * Otherwise just delete them.
+ */
+
+ int isNew;
+
+ tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
+ tracePtr = Tcl_GetHashValue(tPtr);
+ varPtr->flags &= ~VAR_ALL_TRACES;
+ Tcl_DeleteHashEntry(tPtr);
+ if (dummyVar.flags & VAR_TRACED_UNSET) {
+ tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
+ &dummyVar, &isNew);
+ Tcl_SetHashValue(tPtr, tracePtr);
}
}
- }
-
- /*
- * If the variable is an array, delete all of its elements. This must be
- * done after calling the traces on the array, above (that's the way
- * traces are defined). If it is a scalar, "discard" its object (decrement
- * the ref count of its object, if any).
- */
- dummyVarPtr = &dummyVar;
- if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
- /*
- * Deleting the elements of the array may cause traces to be fired on
- * those elements. Before deleting them, bump the reference count of
- * the array, so that if those trace procs make a global or upvar link
- * to the array, the array is not deleted when the call stack gets
- * popped (we will delete the array ourselves later in this function).
- *
- * Bumping the count can lead to the odd situation that elements of
- * the array are being deleted when the array still exists, but since
- * the array is about to be removed anyway, that shouldn't really
- * matter.
- */
+ if ((dummyVar.flags & VAR_TRACED_UNSET)
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
+ dummyVar.flags &= ~VAR_TRACE_ACTIVE;
+ TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_UNSETS,
+ /* leaveErrMsg */ 0, index);
- DeleteArray(iPtr, part1, dummyVarPtr,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
- | TCL_TRACE_UNSETS);
- /* Decr ref count */
- }
- if (TclIsVarScalar(dummyVarPtr)
- && (dummyVarPtr->value.objPtr != NULL)) {
- objPtr = dummyVarPtr->value.objPtr;
- TclDecrRefCount(objPtr);
- dummyVarPtr->value.objPtr = NULL;
- }
+ /*
+ * The traces that we just called may have triggered a change in
+ * the set of traces. If so, reload the traces to manipulate.
+ */
- /*
- * If the variable was a namespace variable, decrement its reference
- * count.
- */
+ tracePtr = NULL;
+ if (TclIsVarTraced(&dummyVar)) {
+ tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
+ tracePtr = Tcl_GetHashValue(tPtr);
+ if (tPtr) {
+ Tcl_DeleteHashEntry(tPtr);
+ }
+ }
+ }
- if (TclIsVarNamespaceVar(varPtr)) {
- TclClearVarNamespaceVar(varPtr);
- varPtr->refCount--;
- }
+ if (tracePtr) {
+ ActiveVarTrace *activePtr;
- /*
- * It's an error to unset an undefined variable.
- */
+ while (tracePtr) {
+ VarTrace *prevPtr = tracePtr;
- if (result != TCL_OK) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, part1, part2, "unset",
- ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+ tracePtr = tracePtr->nextPtr;
+ prevPtr->nextPtr = NULL;
+ Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
+ }
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
+ activePtr = activePtr->nextPtr) {
+ if (activePtr->varPtr == varPtr) {
+ activePtr->nextTracePtr = NULL;
+ }
+ }
+ dummyVar.flags &= ~VAR_ALL_TRACES;
}
}
-#if ENABLE_NS_VARNAME_CACHING
- /*
- * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
- * keeping a reference. This removes some additional exteriorisations of
- * [Bug 736729], but may be a good thing independently of the bug.
- */
+ if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) {
+ /*
+ * Decrement the ref count of the var's value.
+ */
- if (part1Ptr->typePtr == &tclNsVarNameType) {
- TclFreeIntRep(part1Ptr);
- part1Ptr->typePtr = NULL;
+ Tcl_Obj *objPtr = dummyVar.value.objPtr;
+
+ TclDecrRefCount(objPtr);
+ } else if (TclIsVarArray(&dummyVar)) {
+ /*
+ * If the variable is an array, delete all of its elements. This must
+ * be done after calling and deleting the traces on the array, above
+ * (that's the way traces are defined). If the array name is not
+ * present and is required for a trace on some element, it will be
+ * computed at DeleteArray.
+ */
+
+ DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
+ & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
+ index);
+ } else if (TclIsVarLink(&dummyVar)) {
+ /*
+ * For global/upvar variables referenced in procedures, decrement the
+ * reference count on the variable referred to, and free the
+ * referenced variable if it's no longer needed.
+ */
+
+ Var *linkPtr = dummyVar.value.linkPtr;
+
+ if (TclIsVarInHash(linkPtr)) {
+ VarHashRefCount(linkPtr)--;
+ CleanupVar(linkPtr, NULL);
+ }
}
-#endif
/*
- * Finally, if the variable is truly not in use then free up its Var
- * structure and remove it from its hash table, if any. The ref count of
- * its value object, if any, was decremented above.
+ * If the variable was a namespace variable, decrement its reference
+ * count.
*/
- varPtr->refCount--;
- TclCleanupVar(varPtr, arrayPtr);
- return result;
+ TclClearVarNamespaceVar(varPtr);
}
/*
@@ -2309,7 +2589,7 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
*
* Tcl_UnsetObjCmd --
*
- * This object-based procedure is invoked to process the "unset" Tcl
+ * This object-based function is invoked to process the "unset" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -2323,20 +2603,16 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
/* ARGSUSED */
int
-Tcl_UnsetObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UnsetObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
register int i, flags = TCL_LEAVE_ERR_MSG;
- register char *name;
+ register const char *name;
- if (objc < 1) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "?-nocomplain? ?--? ?varName varName ...?");
- return TCL_ERROR;
- } else if (objc == 1) {
+ if (objc == 1) {
/*
* Do nothing if no arguments supplied, so as to match command
* documentation.
@@ -2346,7 +2622,7 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
}
/*
- * Simple, restrictive argument parsing. The only options are -- and
+ * Simple, restrictive argument parsing. The only options are -- and
* -nocomplain (which must come first and be given exactly to be an
* option).
*/
@@ -2354,20 +2630,20 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
i = 1;
name = TclGetString(objv[i]);
if (name[0] == '-') {
- if (strcmp("-nocomplain", name) == 0) {
+ if (strcmp("-nocomplain", name) == 0) {
i++;
- if (i == objc) {
+ if (i == objc) {
return TCL_OK;
}
- flags = 0;
- name = TclGetString(objv[i]);
- }
- if (strcmp("--", name) == 0) {
- i++;
- }
+ flags = 0;
+ name = TclGetString(objv[i]);
+ }
+ if (strcmp("--", name) == 0) {
+ i++;
+ }
}
- for (; i < objc; i++) {
+ for (; i < objc; i++) {
if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
&& (flags == TCL_LEAVE_ERR_MSG)) {
return TCL_ERROR;
@@ -2381,7 +2657,7 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
*
* Tcl_AppendObjCmd --
*
- * This object-based procedure is invoked to process the "append" Tcl
+ * This object-based function is invoked to process the "append" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -2395,48 +2671,45 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_AppendObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_AppendObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
- char *part1;
-
register Tcl_Obj *varValuePtr = NULL;
- /* Initialized to avoid compiler
- * warning. */
+ /* Initialized to avoid compiler warning. */
int i;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
return TCL_ERROR;
}
if (objc == 2) {
- varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+ varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
if (varValuePtr == NULL) {
return TCL_ERROR;
}
} else {
- varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+ varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- part1 = TclGetString(objv[1]);
if (varPtr == NULL) {
return TCL_ERROR;
}
- for (i = 2; i < objc; i++) {
+ for (i=2 ; i<objc ; i++) {
/*
* 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, part1, NULL,
- objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
- if (varValuePtr == NULL) {
+ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1],
+ NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1);
+ if ((varValuePtr == NULL) ||
+ (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
return TCL_ERROR;
}
}
@@ -2450,7 +2723,7 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
*
* Tcl_LappendObjCmd --
*
- * This object-based procedure is invoked to process the "lappend" Tcl
+ * This object-based function is invoked to process the "lappend" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -2464,24 +2737,23 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_LappendObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_LappendObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varValuePtr, *newValuePtr;
- int numElems, createdNewObj, createVar;
+ int numElems, createdNewObj;
Var *varPtr, *arrayPtr;
- char *part1;
int result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
return TCL_ERROR;
}
if (objc == 2) {
- newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0);
+ newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (newValuePtr == NULL) {
/*
* The variable doesn't exist yet. Just create it with an empty
@@ -2492,9 +2764,13 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
TCL_LEAVE_ERR_MSG);
if (newValuePtr == NULL) {
- TclDecrRefCount(varValuePtr); /* free unneeded object */
return TCL_ERROR;
}
+ } else {
+ result = TclListObjLength(interp, newValuePtr, &numElems);
+ if (result != TCL_OK) {
+ return result;
+ }
}
} else {
/*
@@ -2508,42 +2784,40 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
*/
createdNewObj = 0;
- createVar = 1;
/*
- * Use the TCL_TRACE_READS flag to ensure that if we have an array
- * with no elements set yet, but with a read trace on it, we will
- * create the variable and get read traces triggered. Note that you
- * have to protect the variable pointers around the TclPtrGetVar call
+ * Protect the variable pointers around the TclPtrGetVar call
* to insure that they remain valid even if the variable was undefined
* and unused.
*/
- varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+ varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return TCL_ERROR;
}
- varPtr->refCount++;
- if (arrayPtr != NULL) {
- arrayPtr->refCount++;
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
}
- part1 = TclGetString(objv[1]);
- varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL,
- (TCL_TRACE_READS | TCL_LEAVE_ERR_MSG));
- varPtr->refCount--;
- if (arrayPtr != NULL) {
- arrayPtr->refCount--;
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)++;
+ }
+ varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+ TCL_LEAVE_ERR_MSG, -1);
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)--;
}
if (varValuePtr == NULL) {
/*
* We couldn't read the old value: either the var doesn't yet
- * exist or it's an array element. If it's new, we will try to
+ * exist or it's an array element. If it's new, we will try to
* create it with Tcl_ObjSetVar2 below.
*/
- createVar = (TclIsVarUndefined(varPtr));
TclNewObj(varValuePtr);
createdNewObj = 1;
} else if (Tcl_IsShared(varValuePtr)) {
@@ -2551,14 +2825,14 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
createdNewObj = 1;
}
- result = Tcl_ListObjLength(interp, varValuePtr, &numElems);
+ result = TclListObjLength(interp, varValuePtr, &numElems);
if (result == TCL_OK) {
result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
(objc-2), (objv+2));
}
if (result != TCL_OK) {
if (createdNewObj) {
- TclDecrRefCount(varValuePtr); /* free unneeded obj. */
+ TclDecrRefCount(varValuePtr); /* Free unneeded obj. */
}
return result;
}
@@ -2569,12 +2843,9 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* and we didn't create the variable.
*/
- newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
- varValuePtr, TCL_LEAVE_ERR_MSG);
+ newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+ varValuePtr, TCL_LEAVE_ERR_MSG, -1);
if (newValuePtr == NULL) {
- if (createdNewObj && !createVar) {
- TclDecrRefCount(varValuePtr); /* free unneeded obj */
- }
return TCL_ERROR;
}
}
@@ -2591,66 +2862,314 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_ArrayObjCmd --
+ * TclArraySet --
*
- * This object-based procedure is invoked to process the "array" Tcl
- * command. See the user documentation for details on what it does.
+ * Set the elements of an array. If there are no elements to set, create
+ * an empty array. This routine is used by the Tcl_ArrayObjCmd and by the
+ * TclSetupEnv routine.
*
* Results:
* A standard Tcl result object.
*
* Side effects:
- * See the user documentation.
+ * A variable will be created if one does not already exist.
+ * Callers must Incr arrayNameObj if they pland to Decr it.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
-Tcl_ArrayObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclArraySet(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *arrayNameObj, /* The array name. */
+ Tcl_Obj *arrayElemObj) /* The array elements list or dict. If this is
+ * NULL, create an empty array. */
{
+ Var *varPtr, *arrayPtr;
+ int result, i;
+
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+ /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
+ /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (arrayPtr) {
+ CleanupVar(varPtr, arrayPtr);
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(arrayNameObj), NULL);
+ return TCL_ERROR;
+ }
+
+ if (arrayElemObj == NULL) {
+ goto ensureArray;
+ }
+
/*
- * The list of constants below should match the arrayOptions string array
- * below.
+ * Install the contents of the dictionary or list into the array.
*/
- enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
- ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
- ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET};
- static CONST char *arrayOptions[] = {
- "anymore", "donesearch", "exists", "get", "names", "nextelement",
- "set", "size", "startsearch", "statistics", "unset", (char *) NULL
- };
+ if (arrayElemObj->typePtr == &tclDictType) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_DictSearch search;
+ int done;
+
+ if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (done == 0) {
+ /*
+ * Empty, so we'll just force the array to be properly existing
+ * instead.
+ */
+
+ goto ensureArray;
+ }
+
+ /*
+ * Don't need to look at result of Tcl_DictObjFirst as we've just
+ * successfully used a dictionary operation on the same object.
+ */
+
+ for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
+ &keyPtr, &valuePtr, &done) ; !done ;
+ Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
+ /*
+ * At this point, it would be nice if the key was directly usable
+ * by the array. This isn't the case though.
+ */
+
+ Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+ keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+ if ((elemVarPtr == NULL) ||
+ (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+ keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
+ Tcl_DictObjDone(&search);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+ } else {
+ /*
+ * Not a dictionary, so assume (and convert to, for backward-
+ * -compatability reasons) a list.
+ */
+
+ int elemLen;
+ Tcl_Obj **elemPtrs, *copyListObj;
+ result = TclListObjGetElements(interp, arrayElemObj,
+ &elemLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (elemLen & 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "list must have an even number of elements", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ if (elemLen == 0) {
+ goto ensureArray;
+ }
+
+ /*
+ * We needn't worry about traces invalidating arrayPtr: should that be
+ * the case, TclPtrSetVar will return NULL so that we break out of the
+ * loop and return an error.
+ */
+
+ copyListObj = TclListObjCopy(NULL, arrayElemObj);
+ for (i=0 ; i<elemLen ; i+=2) {
+ Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+ elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+ if ((elemVarPtr == NULL) ||
+ (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+ elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ Tcl_DecrRefCount(copyListObj);
+ return result;
+ }
+
+ /*
+ * The list is empty make sure we have an array, or create one if
+ * necessary.
+ */
+
+ ensureArray:
+ if (varPtr != NULL) {
+ if (TclIsVarArray(varPtr)) {
+ /*
+ * Already an array, done.
+ */
+
+ return TCL_OK;
+ }
+ if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+ /*
+ * Either an array element, or a scalar: lose!
+ */
+
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
+ needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ return TCL_ERROR;
+ }
+ }
+ TclSetVarArray(varPtr);
+ varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+ TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayStartSearchCmd --
+ *
+ * This object-based function is invoked to process the "array
+ * startsearch" Tcl command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayStartSearchCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
- Tcl_Obj *varNamePtr;
- int notArray;
- char *varName;
- int index, result;
+ Tcl_Obj *varNameObj;
+ int isNew;
+ ArraySearch *searchPtr;
+ const char *varName;
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+ return TCL_ERROR;
+ }
+ varNameObj = objv[1];
+
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ varName = TclGetString(varNameObj);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", varName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * Make a new array search with a free name.
+ */
+
+ searchPtr = ckalloc(sizeof(ArraySearch));
+ hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
+ if (isNew) {
+ searchPtr->id = 1;
+ varPtr->flags |= VAR_SEARCH_ACTIVE;
+ searchPtr->nextPtr = NULL;
+ } else {
+ searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayAnyMoreCmd --
+ *
+ * This object-based function is invoked to process the "array anymore"
+ * Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayAnyMoreCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNameObj, *searchObj;
+ int gotValue;
+ ArraySearch *searchPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
+ return TCL_ERROR;
}
+ varNameObj = objv[1];
+ searchObj = objv[2];
/*
- * Locate the array variable
+ * Locate the array variable.
*/
- varNamePtr = objv[2];
- varName = TclGetString(varNamePtr);
- varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0,
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
/*
@@ -2658,11 +3177,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
* array get, etc.
*/
- if (varPtr != NULL && varPtr->tracePtr != NULL
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, varName,
- NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
@@ -2673,634 +3192,1139 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
* traces.
*/
- notArray = 0;
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- notArray = 1;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+ TclGetString(varNameObj), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the search.
+ */
+
+ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
+ if (searchPtr == NULL) {
+ return TCL_ERROR;
}
- switch (index) {
- case ARRAY_ANYMORE: {
- ArraySearch *searchPtr;
+ /*
+ * Scan forward to find if there are any further elements in the array
+ * that are defined.
+ */
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
- return TCL_ERROR;
+ while (1) {
+ if (searchPtr->nextEntry != NULL) {
+ varPtr = VarHashGetValue(searchPtr->nextEntry);
+ if (!TclIsVarUndefined(varPtr)) {
+ gotValue = 1;
+ break;
+ }
}
- if (notArray) {
- goto error;
+ searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
+ if (searchPtr->nextEntry == NULL) {
+ gotValue = 0;
+ break;
}
- searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
- if (searchPtr == NULL) {
+ }
+ Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayNextElementCmd --
+ *
+ * This object-based function is invoked to process the "array
+ * nextelement" Tcl command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayNextElementCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNameObj, *searchObj;
+ ArraySearch *searchPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
+ return TCL_ERROR;
+ }
+ varNameObj = objv[1];
+ searchObj = objv[2];
+
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- while (1) {
- Var *varPtr2;
+ }
- if (searchPtr->nextEntry != NULL) {
- varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
- if (!TclIsVarUndefined(varPtr2)) {
- break;
- }
- }
- searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
- if (searchPtr->nextEntry == NULL) {
- Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+ TclGetString(varNameObj), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the search.
+ */
+
+ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
+ if (searchPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the next element from the search, or the empty string on
+ * exhaustion. Note that the [array anymore] command may well have already
+ * pulled a value from the hash enumeration, so we have to check the cache
+ * there first.
+ */
+
+ while (1) {
+ Tcl_HashEntry *hPtr = searchPtr->nextEntry;
+
+ if (hPtr == NULL) {
+ hPtr = Tcl_NextHashEntry(&searchPtr->search);
+ if (hPtr == NULL) {
return TCL_OK;
}
+ } else {
+ searchPtr->nextEntry = NULL;
}
- Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]);
- break;
+ varPtr = VarHashGetValue(hPtr);
+ if (!TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, VarHashGetKey(varPtr));
+ return TCL_OK;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayDoneSearchCmd --
+ *
+ * This object-based function is invoked to process the "array
+ * donesearch" Tcl command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayDoneSearchCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *varNameObj, *searchObj;
+ ArraySearch *searchPtr, *prevPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
+ return TCL_ERROR;
}
- case ARRAY_DONESEARCH: {
- ArraySearch *searchPtr, *prevPtr;
+ varNameObj = objv[1];
+ searchObj = objv[2];
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
- return TCL_ERROR;
- }
- if (notArray) {
- goto error;
- }
- searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
- if (searchPtr == NULL) {
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- if (varPtr->searchPtr == searchPtr) {
- varPtr->searchPtr = searchPtr->nextPtr;
- } else {
- for (prevPtr=varPtr->searchPtr ;; prevPtr=prevPtr->nextPtr) {
- if (prevPtr->nextPtr == searchPtr) {
- prevPtr->nextPtr = searchPtr->nextPtr;
- break;
- }
- }
- }
- ckfree((char *) searchPtr);
- break;
}
- case ARRAY_NEXTELEMENT: {
- ArraySearch *searchPtr;
- Tcl_HashEntry *hPtr;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
- return TCL_ERROR;
- }
- if (notArray) {
- goto error;
- }
- searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
- if (searchPtr == NULL) {
- return TCL_ERROR;
- }
- while (1) {
- Var *varPtr2;
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces.
+ */
- hPtr = searchPtr->nextEntry;
- if (hPtr == NULL) {
- hPtr = Tcl_NextHashEntry(&searchPtr->search);
- if (hPtr == NULL) {
- return TCL_OK;
- }
- } else {
- searchPtr->nextEntry = NULL;
- }
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (!TclIsVarUndefined(varPtr2)) {
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+ TclGetString(varNameObj), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the search.
+ */
+
+ searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
+ if (searchPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Unhook the search from the list of searches associated with the
+ * variable.
+ */
+
+ hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
+ if (searchPtr == Tcl_GetHashValue(hPtr)) {
+ if (searchPtr->nextPtr) {
+ Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
+ } else {
+ varPtr->flags &= ~VAR_SEARCH_ACTIVE;
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ } else {
+ for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == searchPtr) {
+ prevPtr->nextPtr = searchPtr->nextPtr;
break;
}
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1));
- break;
}
- case ARRAY_STARTSEARCH: {
- ArraySearch *searchPtr;
+ ckfree(searchPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayExistsCmd --
+ *
+ * This object-based function is invoked to process the "array exists"
+ * Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayExistsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *arrayNameObj;
+ int notArray;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+ return TCL_ERROR;
+ }
+ arrayNameObj = objv[1];
+
+ /*
+ * Locate the array variable.
+ */
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- if (notArray) {
- goto error;
- }
- searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
- if (varPtr->searchPtr == NULL) {
- searchPtr->id = 1;
- Tcl_AppendResult(interp, "s-1-", varName, NULL);
- } else {
- char string[TCL_INTEGER_SPACE];
+ }
- searchPtr->id = varPtr->searchPtr->id + 1;
- TclFormatInt(string, searchPtr->id);
- Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
- }
- searchPtr->varPtr = varPtr;
- searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
- &searchPtr->search);
- searchPtr->nextPtr = varPtr->searchPtr;
- varPtr->searchPtr = searchPtr;
+ /*
+ * Check whether we've actually got an array variable.
+ */
+
+ notArray = ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr));
+ Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayGetCmd --
+ *
+ * This object-based function is invoked to process the "array get" Tcl
+ * command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayGetCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr, *varPtr2;
+ Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
+ Tcl_Obj **nameObjPtr, *patternObj;
+ Tcl_HashSearch search;
+ const char *pattern;
+ int i, count, result;
+
+ switch (objc) {
+ case 2:
+ varNameObj = objv[1];
+ patternObj = NULL;
break;
+ case 3:
+ varNameObj = objv[1];
+ patternObj = objv[2];
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
+ return TCL_ERROR;
}
- case ARRAY_EXISTS:
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
- break;
- case ARRAY_GET: {
- Tcl_HashSearch search;
- Var *varPtr2;
- char *pattern = NULL;
- char *name;
- Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
- int i, count;
-
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
- return TCL_ERROR;
+ }
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces. If not an array, it's an empty result.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ return TCL_OK;
+ }
+
+ pattern = (patternObj ? TclGetString(patternObj) : NULL);
+
+ /*
+ * Store the array names in a new object.
+ */
+
+ TclNewObj(nameLstObj);
+ Tcl_IncrRefCount(nameLstObj);
+ if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) {
+ varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
+ if (varPtr2 == NULL) {
+ goto searchDone;
}
- if (notArray) {
- return TCL_OK;
+ if (TclIsVarUndefined(varPtr2)) {
+ goto searchDone;
}
- if (objc == 4) {
- pattern = TclGetString(objv[3]);
+ result = Tcl_ListObjAppendElement(interp, nameLstObj,
+ VarHashGetKey(varPtr2));
+ if (result != TCL_OK) {
+ TclDecrRefCount(nameLstObj);
+ return result;
}
+ goto searchDone;
+ }
- /*
- * Store the array names in a new object.
- */
-
- TclNewObj(nameLstPtr);
- Tcl_IncrRefCount(nameLstPtr);
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
- if (hPtr == NULL) {
- goto searchDone;
- }
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (TclIsVarUndefined(varPtr2)) {
- goto searchDone;
- }
- result = Tcl_ListObjAppendElement(interp, nameLstPtr,
- Tcl_NewStringObj(pattern, -1));
- if (result != TCL_OK) {
- TclDecrRefCount(nameLstPtr);
- return result;
- }
- goto searchDone;
+ for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
+ varPtr2; varPtr2 = VarHashNextVar(&search)) {
+ if (TclIsVarUndefined(varPtr2)) {
+ continue;
+ }
+ nameObj = VarHashGetKey(varPtr2);
+ if (patternObj && !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
+ continue; /* Element name doesn't match pattern. */
}
- for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (TclIsVarUndefined(varPtr2)) {
- continue;
- }
- name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
- if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
- continue; /* element name doesn't match pattern */
- }
- namePtr = Tcl_NewStringObj(name, -1);
- result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr);
- if (result != TCL_OK) {
- TclDecrRefCount(namePtr); /* free unneeded name obj */
- TclDecrRefCount(nameLstPtr);
- return result;
- }
+ result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj);
+ if (result != TCL_OK) {
+ TclDecrRefCount(nameLstObj);
+ return result;
}
+ }
- searchDone:
- /*
- * Make sure the Var structure of the array is not removed by a trace
- * while we're working.
- */
+ /*
+ * Make sure the Var structure of the array is not removed by a trace
+ * while we're working.
+ */
- varPtr->refCount++;
+ searchDone:
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
- /*
- * Get the array values corresponding to each element name
- */
+ /*
+ * Get the array values corresponding to each element name.
+ */
- TclNewObj(tmpResPtr);
- result = Tcl_ListObjGetElements(interp, nameLstPtr,
- &count, &namePtrPtr);
- if (result != TCL_OK) {
- goto errorInArrayGet;
- }
+ TclNewObj(tmpResObj);
+ result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
+ if (result != TCL_OK) {
+ goto errorInArrayGet;
+ }
- for (i=0 ; i<count ; i++) {
- namePtr = *namePtrPtr++;
- valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
- TCL_LEAVE_ERR_MSG);
- if (valuePtr == NULL) {
+ for (i=0 ; i<count ; i++) {
+ nameObj = *nameObjPtr++;
+ valueObj = Tcl_ObjGetVar2(interp, varNameObj, nameObj,
+ TCL_LEAVE_ERR_MSG);
+ if (valueObj == NULL) {
+ /*
+ * Some trace played a trick on us; we need to diagnose to adapt
+ * our behaviour: was the array element unset, or did the
+ * modification modify the complete array?
+ */
+
+ if (TclIsVarArray(varPtr)) {
/*
- * Some trace played a trick on us; we need to diagnose to
- * adapt our behaviour: was the array element unset, or did
- * the modification modify the complete array?
+ * The array itself looks OK, the variable was undefined:
+ * forget it.
*/
- if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
- /*
- * The array itself looks OK, the variable was undefined:
- * forget it.
- */
-
- continue;
- } else {
- result = TCL_ERROR;
- goto errorInArrayGet;
- }
- }
- result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr);
- if (result != TCL_OK) {
- goto errorInArrayGet;
+ continue;
}
+ result = TCL_ERROR;
+ goto errorInArrayGet;
}
- varPtr->refCount--;
- Tcl_SetObjResult(interp, tmpResPtr);
- TclDecrRefCount(nameLstPtr);
- break;
+ result = Tcl_DictObjPut(interp, tmpResObj, nameObj, valueObj);
+ if (result != TCL_OK) {
+ goto errorInArrayGet;
+ }
+ }
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
+ Tcl_SetObjResult(interp, tmpResObj);
+ TclDecrRefCount(nameLstObj);
+ return TCL_OK;
- errorInArrayGet:
- varPtr->refCount--;
- TclDecrRefCount(nameLstPtr);
- TclDecrRefCount(tmpResPtr); /* free unneeded temp result */
- return result;
+ errorInArrayGet:
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
}
- case ARRAY_NAMES: {
- Tcl_HashSearch search;
- Var *varPtr2;
- char *pattern = NULL;
- char *name;
- Tcl_Obj *namePtr, *resultPtr;
- int mode, matched = 0;
- static CONST char *options[] = {
- "-exact", "-glob", "-regexp", (char *) NULL
- };
- enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
-
- mode = OPT_GLOB;
-
- if ((objc < 3) || (objc > 5)) {
- Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?");
+ TclDecrRefCount(nameLstObj);
+ TclDecrRefCount(tmpResObj); /* Free unneeded temp result. */
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayNamesCmd --
+ *
+ * This object-based function is invoked to process the "array names" Tcl
+ * command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayNamesCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *const options[] = {
+ "-exact", "-glob", "-regexp", NULL
+ };
+ enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr, *varPtr2;
+ Tcl_Obj *varNameObj, *nameObj, *resultObj, *patternObj;
+ Tcl_HashSearch search;
+ const char *pattern = NULL;
+ int mode = OPT_GLOB;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
+ return TCL_ERROR;
+ }
+ varNameObj = objv[1];
+ patternObj = (objc > 2 ? objv[objc-1] : NULL);
+
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- if (notArray) {
- return TCL_OK;
- }
- if (objc == 4) {
- pattern = TclGetString(objv[3]);
- } else if (objc == 5) {
- pattern = TclGetString(objv[4]);
- if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0,
- &mode) != TCL_OK) {
- return TCL_ERROR;
- }
+ }
+
+ /*
+ * Finish parsing the arguments.
+ */
+
+ if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option",
+ 0, &mode) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces. If not an array, the result is empty.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Check for the trivial cases where we can use a direct lookup.
+ */
+
+ TclNewObj(resultObj);
+ if (patternObj) {
+ pattern = TclGetString(patternObj);
+ }
+ if ((mode==OPT_GLOB && patternObj && TclMatchIsTrivial(pattern))
+ || (mode==OPT_EXACT)) {
+ varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
+ if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
+ /*
+ * This can't fail; lappending to an empty object always works.
+ */
+
+ Tcl_ListObjAppendElement(NULL, resultObj, VarHashGetKey(varPtr2));
}
- TclNewObj(resultPtr);
- if (((enum options) mode)==OPT_GLOB && pattern!=NULL &&
- TclMatchIsTrivial(pattern)) {
- hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
- if ((hPtr != NULL) &&
- !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))) {
- result = Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(pattern, -1));
- if (result != TCL_OK) {
- TclDecrRefCount(resultPtr);
- return result;
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ }
+
+ /*
+ * Must scan the array to select the elements.
+ */
+
+ for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+ varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+ if (TclIsVarUndefined(varPtr2)) {
+ continue;
+ }
+ nameObj = VarHashGetKey(varPtr2);
+ if (patternObj) {
+ const char *name = TclGetString(nameObj);
+ int matched = 0;
+
+ switch ((enum options) mode) {
+ case OPT_EXACT:
+ Tcl_Panic("exact matching shouldn't get here");
+ case OPT_GLOB:
+ matched = Tcl_StringMatch(name, pattern);
+ break;
+ case OPT_REGEXP:
+ matched = Tcl_RegExpMatchObj(interp, nameObj, patternObj);
+ if (matched < 0) {
+ TclDecrRefCount(resultObj);
+ return TCL_ERROR;
}
+ break;
}
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_OK;
- }
- for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (TclIsVarUndefined(varPtr2)) {
+ if (matched == 0) {
continue;
}
- name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
- if (objc > 3) {
- switch ((enum options) mode) {
- case OPT_EXACT:
- matched = (strcmp(name, pattern) == 0);
- break;
- case OPT_GLOB:
- matched = Tcl_StringMatch(name, pattern);
- break;
- case OPT_REGEXP:
- matched = Tcl_RegExpMatch(interp, name, pattern);
- if (matched < 0) {
- TclDecrRefCount(resultPtr);
- return TCL_ERROR;
- }
- break;
- }
- if (matched == 0) {
- continue;
- }
- }
-
- namePtr = Tcl_NewStringObj(name, -1);
- result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
- if (result != TCL_OK) {
- TclDecrRefCount(resultPtr);
- TclDecrRefCount(namePtr); /* free unneeded name obj */
- return result;
- }
}
- Tcl_SetObjResult(interp, resultPtr);
- break;
+
+ Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
}
- case ARRAY_SET:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindArrayPtrElements --
+ *
+ * Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
+ * for each existing element of the given array. The provided hash table
+ * is assumed to be initially empty.
+ *
+ * Result:
+ * none
+ *
+ * Side effects:
+ * The keys of the array gain an extra reference. The supplied hash table
+ * has elements added to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFindArrayPtrElements(
+ Var *arrayPtr,
+ Tcl_HashTable *tablePtr)
+{
+ Var *varPtr;
+ Tcl_HashSearch search;
+
+ if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
+ || TclIsVarUndefined(arrayPtr)) {
+ return;
+ }
+
+ for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
+ varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *nameObj;
+ int dummy;
+
+ if (TclIsVarUndefined(varPtr)) {
+ continue;
}
- return TclArraySet(interp, objv[2], objv[3]);
- case ARRAY_UNSET: {
- Tcl_HashSearch search;
- Var *varPtr2;
- char *pattern = NULL;
- char *name;
+ nameObj = VarHashGetKey(varPtr);
+ hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
+ Tcl_SetHashValue(hPtr, nameObj);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArraySetCmd --
+ *
+ * This object-based function is invoked to process the "array set" Tcl
+ * command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArraySetCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
+ return TCL_ERROR;
+ }
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, objv[1], NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, objv[1], NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- if (notArray) {
- return TCL_OK;
- }
- if (objc == 3) {
- /*
- * When no pattern is given, just unset the whole array.
- */
+ }
- if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- pattern = TclGetString(objv[3]);
- if (TclMatchIsTrivial(pattern)) {
- hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
- if (hPtr != NULL &&
- !TclIsVarUndefined((Var *)Tcl_GetHashValue(hPtr))){
- return TclObjUnsetVar2(interp, varNamePtr, pattern, 0);
- }
- return TCL_OK;
- }
- for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (TclIsVarUndefined(varPtr2)) {
- continue;
- }
- name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
- if (Tcl_StringMatch(name, pattern) &&
- TclObjUnsetVar2(interp, varNamePtr, name,
- 0) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- }
- break;
+ return TclArraySet(interp, objv[1], objv[2]);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArraySizeCmd --
+ *
+ * This object-based function is invoked to process the "array size" Tcl
+ * command. See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArraySizeCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNameObj;
+ Tcl_HashSearch search;
+ Var *varPtr2;
+ int size = 0;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+ return TCL_ERROR;
}
+ varNameObj = objv[1];
- case ARRAY_SIZE: {
- Tcl_HashSearch search;
- Var *varPtr2;
- int size;
+ /*
+ * Locate the array variable.
+ */
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- size = 0;
+ }
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces. We can only iterate over the array if it exists...
+ */
+ if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
/*
* Must iterate in order to get chance to check for present but
* "undefined" entries.
*/
- if (!notArray) {
- for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
- if (TclIsVarUndefined(varPtr2)) {
- continue;
- }
+ for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+ varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+ if (!TclIsVarUndefined(varPtr2)) {
size++;
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
- break;
}
- case ARRAY_STATISTICS: {
- CONST char *stats;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayStatsCmd --
+ *
+ * This object-based function is invoked to process the "array
+ * statistics" Tcl command. See the user documentation for details on
+ * what it does.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayStatsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNameObj;
+ char *stats;
- if (notArray) {
- goto error;
- }
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+ return TCL_ERROR;
+ }
+ varNameObj = objv[1];
- stats = Tcl_HashStats(varPtr->value.tablePtr);
- if (stats != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
- ckfree((void *)stats);
- } else {
- Tcl_SetResult(interp, "error reading array statistics",TCL_STATIC);
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- break;
}
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+ TclGetString(varNameObj), NULL);
+ return TCL_ERROR;
+ }
+
+ stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
+ if (stats == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading array statistics", -1));
+ return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
+ ckfree(stats);
return TCL_OK;
-
- error:
- Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
- return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * TclArraySet --
+ * ArrayUnsetCmd --
*
- * Set the elements of an array. If there are no elements to set, create
- * an empty array. This routine is used by the Tcl_ArrayObjCmd and by
- * the TclSetupEnv routine.
+ * This object-based function is invoked to process the "array unset" Tcl
+ * command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result object.
*
* Side effects:
- * A variable will be created if one does not already exist.
+ * See the user documentation.
*
*----------------------------------------------------------------------
*/
-int
-TclArraySet(interp, arrayNameObj, arrayElemObj)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Obj *arrayNameObj; /* The array name. */
- Tcl_Obj *arrayElemObj; /* The array elements list or dict. If this
- * is NULL, create an empty array. */
+ /* ARGSUSED */
+static int
+ArrayUnsetCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
{
- Var *varPtr, *arrayPtr;
- Tcl_Obj **elemPtrs;
- int result, elemLen, i, nameLen;
- char *varName, *p;
-
- varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen);
- p = varName + nameLen - 1;
- if (*p == ')') {
- while (--p >= varName) {
- if (*p == '(') {
- TclVarErrMsg(interp, varName, NULL, "set", needArray);
- return TCL_ERROR;
- }
- }
- }
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr, *arrayPtr, *varPtr2, *protectedVarPtr;
+ Tcl_Obj *varNameObj, *patternObj, *nameObj;
+ Tcl_HashSearch search;
+ const char *pattern;
+ const int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */
- varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
- /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
- /*createPart2*/ 0, &arrayPtr);
- if (varPtr == NULL) {
+ switch (objc) {
+ case 2:
+ varNameObj = objv[1];
+ patternObj = NULL;
+ break;
+ case 3:
+ varNameObj = objv[1];
+ patternObj = objv[2];
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
return TCL_ERROR;
}
- if (arrayElemObj == NULL) {
- goto ensureArray;
- }
-
/*
- * Install the contents of the dictionary or list into the array.
+ * Locate the array variable
*/
- if (arrayElemObj->typePtr == &tclDictType) {
- Tcl_Obj *keyPtr, *valuePtr;
- Tcl_DictSearch search;
- int done;
+ varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
- if (done == 0) {
- /*
- * Empty, so we'll just force the array to be properly existing
- * instead.
- */
+ }
- goto ensureArray;
- }
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces - the variable may actually become an array as an effect of said
+ * traces.
+ */
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ return TCL_OK;
+ }
+
+ if (!patternObj) {
/*
- * Don't need to look at result of Tcl_DictObjFirst as we've just
- * successfully used a dictionary operation on the same object.
+ * When no pattern is given, just unset the whole array.
*/
- for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
- &keyPtr, &valuePtr, &done) ; !done ;
- Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
- /*
- * At this point, it would be nice if the key was directly usable
- * by the array. This isn't the case though.
- */
+ return TclObjUnsetVar2(interp, varNameObj, NULL, 0);
+ }
- char *part2 = TclGetString(keyPtr);
- Var *elemVarPtr = TclLookupArrayElement(interp, varName,
- part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
+ /*
+ * With a trivial pattern, we can just unset.
+ */
- if ((elemVarPtr == NULL) ||
- (TclPtrSetVar(interp, elemVarPtr, varPtr, varName,
- part2, valuePtr, TCL_LEAVE_ERR_MSG) == NULL)) {
- Tcl_DictObjDone(&search);
- return TCL_ERROR;
- }
+ pattern = TclGetString(patternObj);
+ if (TclMatchIsTrivial(pattern)) {
+ varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
+ if (!varPtr2 || TclIsVarUndefined(varPtr2)) {
+ return TCL_OK;
}
- return TCL_OK;
- } else {
+ return TclPtrUnsetVar(interp, varPtr2, varPtr, varNameObj, patternObj,
+ unsetFlags, -1);
+ }
+
+ /*
+ * Non-trivial case (well, deeply tricky really). We peek inside the hash
+ * iterator in order to allow us to guarantee that the following element
+ * in the array will not be scrubbed until we have dealt with it. This
+ * stops the overall iterator from ending up pointing into deallocated
+ * memory. [Bug 2939073]
+ */
+
+ protectedVarPtr = NULL;
+ for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+ varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
/*
- * Not a dictionary, so assume (and convert to, for
- * backward-compatability reasons) a list.
+ * Drop the extra ref immediately. We don't need to free it at this
+ * point though; we'll be unsetting it if necessary soon.
*/
- result = Tcl_ListObjGetElements(interp, arrayElemObj,
- &elemLen, &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (elemLen & 1) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "list must have an even number of elements", -1));
- return TCL_ERROR;
- }
- if (elemLen == 0) {
- goto ensureArray;
+ if (varPtr2 == protectedVarPtr) {
+ VarHashRefCount(varPtr2)--;
}
/*
- * We needn't worry about traces invalidating arrayPtr: should that be
- * the case, TclPtrSetVar will return NULL so that we break out of the
- * loop and return an error.
+ * Guard the next (peeked) item in the search chain by incrementing
+ * its refcount. This guarantees that the hash table iterator won't be
+ * dangling on the next time through the loop.
*/
- for (i=0 ; i<elemLen ; i+=2) {
- char *part2 = TclGetString(elemPtrs[i]);
- Var *elemVarPtr = TclLookupArrayElement(interp, varName,
- part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
-
- if ((elemVarPtr == NULL) ||
- (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2,
- elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) {
- result = TCL_ERROR;
- break;
- }
+ if (search.nextEntryPtr != NULL) {
+ protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
+ VarHashRefCount(protectedVarPtr)++;
+ } else {
+ protectedVarPtr = NULL;
}
- return result;
- }
- /*
- * The list is empty make sure we have an array, or create one if
- * necessary.
- */
-
- ensureArray:
- if (varPtr != NULL) {
- if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
- /*
- * Already an array, done.
- */
+ /*
+ * If the variable is undefined, clean it out as it has been hit by
+ * something else (i.e., an unset trace).
+ */
- return TCL_OK;
+ if (TclIsVarUndefined(varPtr2)) {
+ CleanupVar(varPtr2, varPtr);
+ continue;
}
- if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+
+ nameObj = VarHashGetKey(varPtr2);
+ if (Tcl_StringMatch(TclGetString(nameObj), pattern)
+ && TclPtrUnsetVar(interp, varPtr2, varPtr, varNameObj,
+ nameObj, unsetFlags, -1) != TCL_OK) {
/*
- * Either an array element, or a scalar: lose!
+ * If we incremented a refcount, we must decrement it here as we
+ * will not be coming back properly due to the error.
*/
- TclVarErrMsg(interp, varName, (char*)NULL, "array set", needArray);
+ if (protectedVarPtr) {
+ VarHashRefCount(protectedVarPtr)--;
+ CleanupVar(protectedVarPtr, varPtr);
+ }
return TCL_ERROR;
}
}
- TclSetVarArray(varPtr);
- TclClearVarUndefined(varPtr);
- varPtr->value.tablePtr =
- (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclInitArrayCmd --
+ *
+ * This creates the ensemble for the "array" command.
+ *
+ * Results:
+ * The handle for the created ensemble.
+ *
+ * Side effects:
+ * Creates a command in the global namespace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+Tcl_Command
+TclInitArrayCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+ static const EnsembleImplMap arrayImplMap[] = {
+ {"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
+ {"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+ {"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+ {"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0},
+ {"size", ArraySizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"startsearch", ArrayStartSearchCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"statistics", ArrayStatsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+
+ return TclMakeEnsemble(interp, "array", arrayImplMap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ObjMakeUpvar --
*
- * This procedure does all of the work of the "global" and "upvar"
+ * This function does all of the work of the "global" and "upvar"
* commands.
*
* Results:
@@ -3311,33 +4335,32 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
* The variable given by myName is linked to the variable in framePtr
* given by otherP1 and otherP2, so that references to myName are
* redirected to the other variable like a symbolic link.
+ * Callers must Incr myNamePtr if they plan to Decr it.
+ * Callers must Incr otherP1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
static int
-ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
- myFlags, index)
- Tcl_Interp *interp; /* Interpreter containing variables. Used for
+ObjMakeUpvar(
+ Tcl_Interp *interp, /* Interpreter containing variables. Used for
* error messages, too. */
- CallFrame *framePtr; /* Call frame containing "other" variable.
+ CallFrame *framePtr, /* Call frame containing "other" variable.
* NULL means use global :: context. */
- Tcl_Obj *otherP1Ptr;
- CONST char *otherP2; /* Two-part name of variable in framePtr. */
- CONST int otherFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ Tcl_Obj *otherP1Ptr,
+ const char *otherP2, /* Two-part name of variable in framePtr. */
+ const int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of "other" variable. */
- CONST char *myName; /* Name of variable which will refer to
+ Tcl_Obj *myNamePtr, /* Name of variable which will refer to
* otherP1/otherP2. Must be a scalar. */
- int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of myName. */
- int index; /* If the variable to be linked is an indexed
+ int index) /* If the variable to be linked is an indexed
* scalar, this is its index. Otherwise, -1 */
{
Interp *iPtr = (Interp *) interp;
- Var *otherPtr, *varPtr, *arrayPtr;
+ Var *otherPtr, *arrayPtr;
CallFrame *varFramePtr;
- CONST char *errMsg;
- CONST char *p;
/*
* Find "other" in "framePtr". If not looking up other in just the current
@@ -3345,6 +4368,10 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
* interpreter in order to use TclObjLookupVar.
*/
+ if (framePtr == NULL) {
+ framePtr = iPtr->rootFramePtr;
+ }
+
varFramePtr = iPtr->varFramePtr;
if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
iPtr->varFramePtr = framePtr;
@@ -3359,37 +4386,114 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
return TCL_ERROR;
}
- if (index >= 0) {
- if (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
- Tcl_Panic("ObjMakeUpvar called with an index outside from a proc.\n");
- }
- varPtr = &(varFramePtr->compiledLocals[index]);
- } else {
- /*
- * Check that we are not trying to create a namespace var linked to a
- * local variable in a procedure. If we allowed this, the local
- * variable in the shorter-lived procedure frame could go away leaving
- * the namespace var's reference invalid.
- */
+ /*
+ * Check that we are not trying to create a namespace var linked to a
+ * local variable in a procedure. If we allowed this, the local
+ * variable in the shorter-lived procedure frame could go away leaving
+ * the namespace var's reference invalid.
+ */
- if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
- && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
- || (varFramePtr == NULL)
- || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
- || (strstr(myName, "::") != NULL))) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- myName, "\": upvar won't create namespace variable that ",
- "refers to procedure variable", (char *) NULL);
+ if (index < 0) {
+ if (!(arrayPtr != NULL
+ ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
+ : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
+ && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+ || (varFramePtr == NULL)
+ || !HasLocalVars(varFramePtr)
+ || (strstr(TclGetString(myNamePtr), "::") != NULL))) {
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "bad variable name \"%s\": upvar won't create "
+ "namespace variable that refers to procedure variable",
+ TclGetString(myNamePtr)));
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
}
+ }
+
+ return TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrMakeUpvar --
+ *
+ * This procedure does all of the work of the "global" and "upvar"
+ * commands.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs then an error
+ * message is left in iPtr->result.
+ *
+ * Side effects:
+ * The variable given by myName is linked to the variable in framePtr
+ * given by otherP1 and otherP2, so that references to myName are
+ * redirected to the other variable like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPtrMakeUpvar(
+ Tcl_Interp *interp, /* Interpreter containing variables. Used for
+ * error messages, too. */
+ Var *otherPtr, /* Pointer to the variable being linked-to. */
+ const char *myName, /* Name of variable which will refer to
+ * otherP1/otherP2. Must be a scalar. */
+ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ * indicates scope of myName. */
+ int index) /* If the variable to be linked is an indexed
+ * scalar, this is its index. Otherwise, -1 */
+{
+ Tcl_Obj *myNamePtr = NULL;
+ int result;
+
+ if (myName) {
+ myNamePtr = Tcl_NewStringObj(myName, -1);
+ Tcl_IncrRefCount(myNamePtr);
+ }
+ result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
+ if (myNamePtr) {
+ Tcl_DecrRefCount(myNamePtr);
+ }
+ return result;
+}
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+
+int
+TclPtrObjMakeUpvar(
+ Tcl_Interp *interp, /* Interpreter containing variables. Used for
+ * error messages, too. */
+ Var *otherPtr, /* Pointer to the variable being linked-to. */
+ Tcl_Obj *myNamePtr, /* Name of variable which will refer to
+ * otherP1/otherP2. Must be a scalar. */
+ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ * indicates scope of myName. */
+ int index) /* If the variable to be linked is an indexed
+ * scalar, this is its index. Otherwise, -1 */
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ const char *errMsg, *p, *myName;
+ Var *varPtr;
+
+ if (index >= 0) {
+ if (!HasLocalVars(varFramePtr)) {
+ Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
+ }
+ varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
+ myNamePtr = localName(iPtr->varFramePtr, index);
+ myName = myNamePtr? TclGetString(myNamePtr) : NULL;
+ } else {
/*
* Do not permit the new variable to look like an array reference, as
- * it will not be reachable in that case [Bug 600812, TIP 184]. The
+ * it will not be reachable in that case [Bug 600812, TIP 184]. The
* "definition" of what "looks like an array reference" is consistent
* (and must remain consistent) with the code in TclObjLookupVar().
*/
+ myName = TclGetString(myNamePtr);
p = strstr(myName, "(");
if (p != NULL) {
p += strlen(p)-1;
@@ -3398,41 +4502,50 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
* 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", (char *) 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;
}
}
/*
* Lookup and eventually create the new variable. Set the flag bit
- * LOOKUP_FOR_UPVAR to indicate the special resolution rules for upvar
+ * AVOID_RESOLVERS to indicate the special resolution rules for upvar
* purposes:
* - Bug #696893 - variable is either proc-local or in the current
* namespace; never follow the second (global) resolution path.
* - Bug #631741 - do not use special namespace or interp resolvers.
*/
- varPtr = TclLookupSimpleVar(interp, myName, (myFlags|LOOKUP_FOR_UPVAR),
- /* create */ 1, &errMsg, &index);
+ varPtr = TclLookupSimpleVar(interp, myNamePtr,
+ myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
if (varPtr == NULL) {
- TclVarErrMsg(interp, myName, NULL, "create", errMsg);
+ TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(myNamePtr), NULL);
return TCL_ERROR;
}
}
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 (varPtr->tracePtr != NULL) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" has traces: can't use for upvar", (char *) NULL);
+ if (TclIsVarTraced(varPtr)) {
+ 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)) {
+ Var *linkPtr;
+
/*
* The variable already existed. Make sure this variable "varPtr"
* isn't the same as "otherPtr" (avoid circular links). Also, if it's
@@ -3440,25 +4553,29 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
* disconnect it from the thing it currently refers to.
*/
- if (TclIsVarLink(varPtr)) {
- Var *linkPtr = varPtr->value.linkPtr;
- if (linkPtr == otherPtr) {
- return TCL_OK;
- }
- linkPtr->refCount--;
+ if (!TclIsVarLink(varPtr)) {
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "variable \"%s\" already exists", myName));
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
+ return TCL_ERROR;
+ }
+
+ linkPtr = varPtr->value.linkPtr;
+ if (linkPtr == otherPtr) {
+ return TCL_OK;
+ }
+ if (TclIsVarInHash(linkPtr)) {
+ VarHashRefCount(linkPtr)--;
if (TclIsVarUndefined(linkPtr)) {
- TclCleanupVar(linkPtr, (Var *) NULL);
+ CleanupVar(linkPtr, NULL);
}
- } else {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" already exists", (char *) NULL);
- return TCL_ERROR;
}
}
TclSetVarLink(varPtr);
- TclClearVarUndefined(varPtr);
varPtr->value.linkPtr = otherPtr;
- otherPtr->refCount++;
+ if (TclIsVarInHash(otherPtr)) {
+ VarHashRefCount(otherPtr)++;
+ }
return TCL_OK;
}
@@ -3467,35 +4584,54 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
*
* Tcl_UpVar --
*
- * This procedure links one variable to another, just like the "upvar"
+ * This function links one variable to another, just like the "upvar"
* command.
*
* Results:
- * A standard Tcl completion code. If an error occurs then an error
+ * A standard Tcl completion code. If an error occurs then an error
* message is left in the interp's result.
*
* Side effects:
* The variable in frameName whose name is given by varName becomes
- * accessible under the name localName, so that references to localName
- * are redirected to the other variable like a symbolic link.
+ * accessible under the name localNameStr, so that references to
+ * localNameStr are redirected to the other variable like a symbolic
+ * link.
*
*----------------------------------------------------------------------
*/
+#undef Tcl_UpVar
int
-Tcl_UpVar(interp, frameName, varName, localName, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is to
+Tcl_UpVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
- CONST char *frameName; /* Name of the frame containing the source
+ const char *frameName, /* Name of the frame containing the source
* variable, such as "1" or "#0". */
- CONST char *varName; /* Name of a variable in interp to link to.
+ const char *varName, /* Name of a variable in interp to link to.
* May be either a scalar name or an element
* in an array. */
- CONST char *localName; /* Name of link variable. */
- int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
- * indicates scope of localName. */
+ const char *localNameStr, /* Name of link variable. */
+ int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ * indicates scope of localNameStr. */
{
- return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
+ int result;
+ CallFrame *framePtr;
+ Tcl_Obj *varNamePtr, *localNamePtr;
+
+ if (TclGetFrame(interp, frameName, &framePtr) == -1) {
+ return TCL_ERROR;
+ }
+
+ varNamePtr = Tcl_NewStringObj(varName, -1);
+ Tcl_IncrRefCount(varNamePtr);
+ localNamePtr = Tcl_NewStringObj(localNameStr, -1);
+ Tcl_IncrRefCount(localNamePtr);
+
+ result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0,
+ localNamePtr, flags, -1);
+ Tcl_DecrRefCount(varNamePtr);
+ Tcl_DecrRefCount(localNamePtr);
+ return result;
}
/*
@@ -3503,37 +4639,38 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
*
* Tcl_UpVar2 --
*
- * This procedure links one variable to another, just like the "upvar"
+ * This function links one variable to another, just like the "upvar"
* command.
*
* Results:
- * A standard Tcl completion code. If an error occurs then an error
+ * A standard Tcl completion code. If an error occurs then an error
* message is left in the interp's result.
*
* Side effects:
* The variable in frameName whose name is given by part1 and part2
- * becomes accessible under the name localName, so that references to
- * localName are redirected to the other variable like a symbolic link.
+ * becomes accessible under the name localNameStr, so that references to
+ * localNameStr are redirected to the other variable like a symbolic
+ * link.
*
*----------------------------------------------------------------------
*/
int
-Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
- Tcl_Interp *interp; /* Interpreter containing variables. Used for
+Tcl_UpVar2(
+ Tcl_Interp *interp, /* Interpreter containing variables. Used for
* error messages too. */
- CONST char *frameName; /* Name of the frame containing the source
+ const char *frameName, /* Name of the frame containing the source
* variable, such as "1" or "#0". */
- CONST char *part1;
- CONST char *part2; /* Two parts of source variable name to link
+ const char *part1,
+ const char *part2, /* Two parts of source variable name to link
* to. */
- CONST char *localName; /* Name of link variable. */
- int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
- * indicates scope of localName. */
+ const char *localNameStr, /* Name of link variable. */
+ int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ * indicates scope of localNameStr. */
{
int result;
CallFrame *framePtr;
- Tcl_Obj *part1Ptr;
+ Tcl_Obj *part1Ptr, *localNamePtr;
if (TclGetFrame(interp, frameName, &framePtr) == -1) {
return TCL_ERROR;
@@ -3541,10 +4678,13 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
part1Ptr = Tcl_NewStringObj(part1, -1);
Tcl_IncrRefCount(part1Ptr);
- result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
- localName, flags, -1);
- TclDecrRefCount(part1Ptr);
+ localNamePtr = Tcl_NewStringObj(localNameStr, -1);
+ Tcl_IncrRefCount(localNamePtr);
+ result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
+ localNamePtr, flags, -1);
+ Tcl_DecrRefCount(part1Ptr);
+ Tcl_DecrRefCount(localNamePtr);
return result;
}
@@ -3553,7 +4693,7 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
*
* Tcl_GetVariableFullName --
*
- * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this procedure
+ * Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this function
* appends to an object the namespace variable's full name, qualified by
* a sequence of parent namespace names.
*
@@ -3568,36 +4708,45 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
*/
void
-Tcl_GetVariableFullName(interp, variable, objPtr)
- Tcl_Interp *interp; /* Interpreter containing the variable. */
- Tcl_Var variable; /* Token for the variable returned by a
+Tcl_GetVariableFullName(
+ Tcl_Interp *interp, /* Interpreter containing the variable. */
+ Tcl_Var variable, /* Token for the variable returned by a
* previous call to Tcl_FindNamespaceVar. */
- Tcl_Obj *objPtr; /* Points to the object onto which the
+ Tcl_Obj *objPtr) /* Points to the object onto which the
* variable's full name is appended. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr = (Var *) variable;
- char *name;
+ Tcl_Obj *namePtr;
+ Namespace *nsPtr;
+
+ if (!varPtr || TclIsVarArrayElement(varPtr)) {
+ return;
+ }
/*
* Add the full name of the containing namespace (if any), followed by the
* "::" separator, then the variable name.
*/
- if (varPtr != NULL) {
- if (!TclIsVarArrayElement(varPtr)) {
- if (varPtr->nsPtr != NULL) {
- Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
- if (varPtr->nsPtr != iPtr->globalNsPtr) {
- Tcl_AppendToObj(objPtr, "::", 2);
- }
- }
- if (varPtr->name != NULL) {
- Tcl_AppendToObj(objPtr, varPtr->name, -1);
- } else if (varPtr->hPtr != NULL) {
- name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
- Tcl_AppendToObj(objPtr, name, -1);
- }
+ nsPtr = TclGetVarNsPtr(varPtr);
+ if (nsPtr) {
+ Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
+ if (nsPtr != iPtr->globalNsPtr) {
+ Tcl_AppendToObj(objPtr, "::", 2);
+ }
+ }
+ if (TclIsVarInHash(varPtr)) {
+ if (!TclIsVarDeadHash(varPtr)) {
+ namePtr = VarHashGetKey(varPtr);
+ Tcl_AppendObjToObj(objPtr, namePtr);
+ }
+ } else if (iPtr->varFramePtr->procPtr) {
+ int index = varPtr - iPtr->varFramePtr->compiledLocals;
+
+ if (index < iPtr->varFramePtr->numCompiledLocals) {
+ namePtr = localName(iPtr->varFramePtr, index);
+ Tcl_AppendObjToObj(objPtr, namePtr);
}
}
}
@@ -3607,7 +4756,7 @@ Tcl_GetVariableFullName(interp, variable, objPtr)
*
* Tcl_GlobalObjCmd --
*
- * This object-based procedure is invoked to process the "global" Tcl
+ * This object-based function is invoked to process the "global" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -3620,33 +4769,27 @@ Tcl_GetVariableFullName(interp, variable, objPtr)
*/
int
-Tcl_GlobalObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_GlobalObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- register Tcl_Obj *objPtr;
- char *varName;
- register char *tail;
+ register Tcl_Obj *objPtr, *tailPtr;
+ const char *varName;
+ register const char *tail;
int result, i;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
- return TCL_ERROR;
- }
-
/*
* If we are not executing inside a Tcl procedure, just return.
*/
- if ((iPtr->varFramePtr == NULL)
- || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ if (!HasLocalVars(iPtr->varFramePtr)) {
return TCL_OK;
}
- for (i = 1; i < objc; i++) {
+ for (i=1 ; i<objc ; i++) {
/*
* Make a local variable linked to its counterpart in the global ::
* namespace.
@@ -3660,7 +4803,7 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
* the local "link" variable must be the simple name at the tail.
*/
- for (tail = varName; *tail != '\0'; tail++) {
+ for (tail=varName ; *tail!='\0' ; tail++) {
/* empty body */
}
while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
@@ -3670,13 +4813,24 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
tail++;
}
+ if (tail == varName) {
+ tailPtr = objPtr;
+ } else {
+ tailPtr = Tcl_NewStringObj(tail, -1);
+ Tcl_IncrRefCount(tailPtr);
+ }
+
/*
* Link to the variable "varName" in the global :: namespace.
*/
- result = ObjMakeUpvar(interp, (CallFrame *) NULL,
- objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
- /*myName*/ tail, /*myFlags*/ 0, -1);
+ result = ObjMakeUpvar(interp, NULL, objPtr, NULL,
+ TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+ if (tail != varName) {
+ Tcl_DecrRefCount(tailPtr);
+ }
+
if (result != TCL_OK) {
return result;
}
@@ -3712,32 +4866,27 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
* if anything goes wrong.
*
* Side effects:
- * If anything goes wrong, this procedure returns an error message as the
+ * If anything goes wrong, this function returns an error message as the
* result in the interpreter's result object.
*
*----------------------------------------------------------------------
*/
int
-Tcl_VariableObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_VariableObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- char *varName, *tail, *cp;
+ const char *varName, *tail, *cp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varValuePtr;
int i, result;
- Tcl_Obj *varNamePtr;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
- return TCL_ERROR;
- }
+ Tcl_Obj *varNamePtr, *tailPtr;
- for (i = 1; i < objc; i = i+2) {
+ for (i=1 ; i<objc ; i+=2) {
/*
* Look up each variable in the current namespace context, creating it
* if necessary.
@@ -3745,17 +4894,19 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
varNamePtr = objv[i];
varName = TclGetString(varNamePtr);
- varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
if (arrayPtr != NULL) {
/*
- * Variable cannot be an element in an array. If arrayPtr is
- * non-null, it is, so throw up an error and return.
+ * Variable cannot be an element in an array. If arrayPtr is
+ * non-NULL, it is, so throw up an error and return.
*/
- TclVarErrMsg(interp, varName, NULL, "define", isArrayElement);
+ TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
+ isArrayElement, -1);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
return TCL_ERROR;
}
@@ -3769,10 +4920,7 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* destroyed or until the variable is unset.
*/
- if (!TclIsVarNamespaceVar(varPtr)) {
- TclSetVarNamespaceVar(varPtr);
- varPtr->refCount++;
- }
+ TclSetVarNamespaceVar(varPtr);
/*
* If a value was specified, set the variable to that value.
@@ -3781,9 +4929,9 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* unchanged; just create the local link if we're in a Tcl procedure).
*/
- if (i+1 < objc) { /* a value was specified */
- varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL,
- objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+ if (i+1 < objc) { /* A value was specified. */
+ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varNamePtr,
+ NULL, objv[i+1], TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG,-1);
if (varValuePtr == NULL) {
return TCL_ERROR;
}
@@ -3794,8 +4942,7 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* linked to the new namespace variable "varName".
*/
- if ((iPtr->varFramePtr != NULL)
- && (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ if (HasLocalVars(iPtr->varFramePtr)) {
/*
* varName might have a scope qualifier, but the name for the
* local "link" variable must be the simple name at the tail.
@@ -3817,10 +4964,21 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* current namespace.
*/
- result = ObjMakeUpvar(interp, (CallFrame *) NULL,
- /*otherP1*/ varNamePtr, /*otherP2*/ NULL,
+ if (tail == varName) {
+ tailPtr = varNamePtr;
+ } else {
+ tailPtr = Tcl_NewStringObj(tail, -1);
+ Tcl_IncrRefCount(tailPtr);
+ }
+
+ result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL,
/*otherFlags*/ TCL_NAMESPACE_ONLY,
- /*myName*/ tail, /*myFlags*/ 0, -1);
+ /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+ if (tail != varName) {
+ Tcl_DecrRefCount(tailPtr);
+ }
+
if (result != TCL_OK) {
return result;
}
@@ -3834,7 +4992,7 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
*
* Tcl_UpvarObjCmd --
*
- * This object-based procedure is invoked to process the "upvar" Tcl
+ * This object-based function is invoked to process the "upvar" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -3848,48 +5006,76 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_UpvarObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UpvarObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
CallFrame *framePtr;
- char *localName;
- int result;
+ int result, hasLevel;
+ Tcl_Obj *levelObj;
if (objc < 3) {
- upvarSyntax:
Tcl_WrongNumArgs(interp, 1, objv,
"?level? otherVar localVar ?otherVar localVar ...?");
return TCL_ERROR;
}
+ if (objc & 1) {
+ /*
+ * Even number of arguments, so use the default level of "1" by
+ * passing NULL to TclObjGetFrame.
+ */
+
+ levelObj = NULL;
+ hasLevel = 0;
+ } else {
+ /*
+ * Odd number of arguments, so objv[1] must contain the level.
+ */
+
+ levelObj = objv[1];
+ hasLevel = 1;
+ }
+
/*
* Find the call frame containing each of the "other variables" to be
* linked to.
*/
- result = TclObjGetFrame(interp, objv[1], &framePtr);
+ result = TclObjGetFrame(interp, levelObj, &framePtr);
if (result == -1) {
return TCL_ERROR;
}
- objc -= result+1;
- if ((objc & 1) != 0) {
- goto upvarSyntax;
+ if ((result == 0) && hasLevel) {
+ /*
+ * Synthesize an error message since TclObjGetFrame doesn't do this
+ * for this particular case.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(levelObj)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
+ return TCL_ERROR;
}
- objv += result+1;
/*
- * Iterate over each (other variable, local variable) pair. Divide the
+ * We've now finished with parsing levels; skip to the variable names.
+ */
+
+ objc -= hasLevel + 1;
+ objv += hasLevel + 1;
+
+ /*
+ * Iterate over each (other variable, local variable) pair. Divide the
* other variable name into two parts, then call MakeUpvar to do all the
* work of linking it to the local variable.
*/
for (; objc>0 ; objc-=2, objv+=2) {
- localName = TclGetString(objv[1]);
result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
- NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
+ NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -3900,44 +5086,6 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * NewVar --
- *
- * Create a new heap-allocated variable that will eventually be entered
- * into a hashtable.
- *
- * Results:
- * The return value is a pointer to the new variable structure. It is
- * marked as a scalar variable (and not a link or array variable). Its
- * value initially is NULL. The variable is not part of any hash table
- * yet. Since it will be in a hashtable and not in a call frame, its name
- * field is set NULL. It is initially marked as undefined.
- *
- * Side effects:
- * Storage gets allocated.
- *
- *----------------------------------------------------------------------
- */
-
-static Var *
-NewVar()
-{
- register Var *varPtr;
-
- varPtr = (Var *) ckalloc(sizeof(Var));
- varPtr->value.objPtr = NULL;
- varPtr->name = NULL;
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
- return varPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetArraySearchObj --
*
* This function converts the given tcl object into one that has the
@@ -3949,19 +5097,19 @@ NewVar()
*
* Side effects:
* Updates the internal type and representation of the object to make
- * this an array-search object. See the tclArraySearchType declaration
+ * this an array-search object. See the tclArraySearchType declaration
* above for details of the internal representation.
*
*----------------------------------------------------------------------
*/
static int
-SetArraySearchObj(interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
+SetArraySearchObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
- char *string;
- char *end;
+ const char *string;
+ char *end; /* Can't be const due to strtoul defn. */
int id;
size_t offset;
@@ -3993,13 +5141,14 @@ SetArraySearchObj(interp, objPtr)
TclFreeIntRep(objPtr);
objPtr->typePtr = &tclArraySearchType;
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL) + id);
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL) + offset);
+ objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
+ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
return TCL_OK;
syntax:
- Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal search identifier \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return TCL_ERROR;
}
@@ -4008,12 +5157,12 @@ SetArraySearchObj(interp, objPtr)
*
* ParseSearchId --
*
- * This procedure translates from a tcl object to a pointer to an active
+ * This function translates from a tcl object to a pointer to an active
* array search (if there is one that matches the string).
*
* Results:
* The return value is a pointer to the array search indicated by string,
- * or NULL if there isn't one. If NULL is returned, the interp's result
+ * or NULL if there isn't one. If NULL is returned, the interp's result
* contains an error message.
*
* Side effects:
@@ -4024,38 +5173,39 @@ SetArraySearchObj(interp, objPtr)
*/
static ArraySearch *
-ParseSearchId(interp, varPtr, varName, handleObj)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST Var *varPtr; /* Array variable search is for. */
- CONST char *varName; /* Name of array variable that search is
+ParseSearchId(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ const Var *varPtr, /* Array variable search is for. */
+ Tcl_Obj *varNamePtr, /* Name of array variable that search is
* supposed to be for. */
- Tcl_Obj *handleObj; /* Object containing id of search. Must have
+ Tcl_Obj *handleObj) /* Object containing id of search. Must have
* form "search-num-var" where "num" is a
* decimal number and "var" is a variable
* name. */
{
- register char *string;
+ Interp *iPtr = (Interp *) interp;
+ register const char *string;
register size_t offset;
int id;
ArraySearch *searchPtr;
+ const char *varName = TclGetString(varNamePtr);
/*
* Parse the id.
*/
- if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
+ if ((handleObj->typePtr != &tclArraySearchType)
+ && (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
return NULL;
}
/*
- * Cast is safe, since always came from an int in the first place.
+ * Extract the information out of the Tcl_Obj.
*/
- id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
- ((char*)NULL));
+ id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
string = TclGetString(handleObj);
- offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
- ((char*)NULL));
+ offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
/*
* This test cannot be placed inside the Tcl_Obj machinery, since it is
@@ -4063,9 +5213,10 @@ ParseSearchId(interp, varPtr, varName, handleObj)
*/
if (strcmp(string+offset, varName) != 0) {
- Tcl_AppendResult(interp, "search identifier \"", string,
- "\" isn't for variable \"", varName, "\"", (char *) NULL);
- return NULL;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "search identifier \"%s\" isn't for variable \"%s\"",
+ string, varName));
+ goto badLookup;
}
/*
@@ -4077,14 +5228,21 @@ ParseSearchId(interp, varPtr, varName, handleObj)
* this list every time.
*/
- for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
- searchPtr = searchPtr->nextPtr) {
- if (searchPtr->id == id) {
- return searchPtr;
+ if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
+
+ for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+ searchPtr = searchPtr->nextPtr) {
+ if (searchPtr->id == id) {
+ return searchPtr;
+ }
}
}
- Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find search \"%s\"", string));
+ badLookup:
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
}
@@ -4093,7 +5251,7 @@ ParseSearchId(interp, varPtr, varName, handleObj)
*
* DeleteSearches --
*
- * This procedure is called to free up all of the searches associated
+ * This function is called to free up all of the searches associated
* with an array variable.
*
* Results:
@@ -4106,119 +5264,94 @@ ParseSearchId(interp, varPtr, varName, handleObj)
*/
static void
-DeleteSearches(arrayVarPtr)
- register Var *arrayVarPtr; /* Variable whose searches are to be
+DeleteSearches(
+ Interp *iPtr,
+ register Var *arrayVarPtr) /* Variable whose searches are to be
* deleted. */
{
- ArraySearch *searchPtr;
-
- while (arrayVarPtr->searchPtr != NULL) {
- searchPtr = arrayVarPtr->searchPtr;
- arrayVarPtr->searchPtr = searchPtr->nextPtr;
- ckfree((char *) searchPtr);
+ ArraySearch *searchPtr, *nextPtr;
+ Tcl_HashEntry *sPtr;
+
+ if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
+ sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
+ for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
+ searchPtr = nextPtr) {
+ nextPtr = searchPtr->nextPtr;
+ ckfree(searchPtr);
+ }
+ arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
+ Tcl_DeleteHashEntry(sPtr);
}
}
/*
*----------------------------------------------------------------------
*
- * TclDeleteVars --
+ * TclDeleteNamespaceVars --
*
- * This procedure is called to recycle all the storage space associated
- * with a table of variables. For this procedure to work correctly, it
- * must not be possible for any of the variables in the table to be
- * accessed from Tcl commands (e.g. from trace procedures).
+ * This function is called to recycle all the storage space associated
+ * with a namespace's table of variables.
*
* Results:
* None.
*
* Side effects:
- * Variables are deleted and trace procedures are invoked, if any are
+ * Variables are deleted and trace functions are invoked, if any are
* declared.
*
*----------------------------------------------------------------------
*/
void
-TclDeleteVars(iPtr, tablePtr)
- Interp *iPtr; /* Interpreter to which variables belong. */
- Tcl_HashTable *tablePtr; /* Hash table containing variables to
- * delete. */
+TclDeleteNamespaceVars(
+ Namespace *nsPtr)
{
- Tcl_Interp *interp = (Tcl_Interp *) iPtr;
+ TclVarHashTable *tablePtr = &nsPtr->varTable;
+ Tcl_Interp *interp = nsPtr->interp;
+ Interp *iPtr = (Interp *)interp;
Tcl_HashSearch search;
- Tcl_HashEntry *hPtr;
- register Var *varPtr;
- Var *linkPtr;
- int flags;
- ActiveVarTrace *activePtr;
- Tcl_Obj *objPtr;
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ int flags = 0;
+ Var *varPtr;
/*
- * Determine what flags to pass to the trace callback procedures.
+ * Determine what flags to pass to the trace callback functions.
*/
- flags = TCL_TRACE_UNSETS;
- if (tablePtr == &iPtr->globalNsPtr->varTable) {
- flags |= TCL_GLOBAL_ONLY;
- } else if (tablePtr == &currNsPtr->varTable) {
- flags |= TCL_NAMESPACE_ONLY;
- }
- if (Tcl_InterpDeleted(interp)) {
- flags |= TCL_INTERP_DESTROYED;
+ if (nsPtr == iPtr->globalNsPtr) {
+ flags = TCL_GLOBAL_ONLY;
+ } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) {
+ flags = TCL_NAMESPACE_ONLY;
}
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
+ for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
+ varPtr = VarHashFirstVar(tablePtr, &search)) {
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ VarHashRefCount(varPtr)++; /* Make sure we get to remove from
+ * hash. */
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
+ UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags,
+ -1);
+ Tcl_DecrRefCount(objPtr); /* Free no longer needed obj */
/*
- * For global/upvar variables referenced in procedures, decrement the
- * reference count on the variable referred to, and free the
- * referenced variable if it's no longer needed. Don't delete the hash
- * entry for the other variable if it's in the same table as us: this
- * will happen automatically later on.
+ * Remove the variable from the table and force it undefined in case
+ * an unset trace brought it back from the dead.
*/
- if (TclIsVarLink(varPtr)) {
- linkPtr = varPtr->value.linkPtr;
- linkPtr->refCount--;
- if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
- && (linkPtr->tracePtr == NULL)
- && (linkPtr->flags & VAR_IN_HASHTABLE)) {
- if (linkPtr->hPtr == NULL) {
- ckfree((char *) linkPtr);
- } else if (linkPtr->hPtr->tablePtr != tablePtr) {
- Tcl_DeleteHashEntry(linkPtr->hPtr);
- ckfree((char *) linkPtr);
- }
- }
- }
+ if (TclIsVarTraced(varPtr)) {
+ Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
+ VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
+ ActiveVarTrace *activePtr;
- /*
- * Invoke traces on the variable that is being deleted, then free up
- * the variable's space (no need to free the hash entry here, unless
- * we're dealing with a global variable: the hash entries will be
- * deleted automatically when the whole table is deleted). Note that
- * we give TclCallVarTraces the variable's fully-qualified name so
- * that any called trace procedures can refer to these variables being
- * deleted.
- */
+ while (tracePtr) {
+ VarTrace *prevPtr = tracePtr;
- if (varPtr->tracePtr != NULL) {
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr); /* until done with traces */
- Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
- TclCallVarTraces(iPtr, (Var *) NULL, varPtr, TclGetString(objPtr),
- NULL, flags, /* leaveErrMsg */ 0);
- TclDecrRefCount(objPtr); /* free no longer needed obj */
-
- while (varPtr->tracePtr != NULL) {
- VarTrace *tracePtr = varPtr->tracePtr;
- varPtr->tracePtr = tracePtr->nextPtr;
- Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+ tracePtr = tracePtr->nextPtr;
+ prevPtr->nextPtr = NULL;
+ Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
}
+ Tcl_DeleteHashEntry(tPtr);
+ varPtr->flags &= ~VAR_ALL_TRACES;
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
@@ -4226,43 +5359,62 @@ TclDeleteVars(iPtr, tablePtr)
}
}
}
+ VarHashRefCount(varPtr)--;
+ VarHashDeleteEntry(varPtr);
+ }
+ VarHashDeleteTable(tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteVars --
+ *
+ * This function is called to recycle all the storage space associated
+ * with a table of variables. For this function to work correctly, it
+ * must not be possible for any of the variables in the table to be
+ * accessed from Tcl commands (e.g. from trace functions).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Variables are deleted and trace functions are invoked, if any are
+ * declared.
+ *
+ *----------------------------------------------------------------------
+ */
- if (TclIsVarArray(varPtr)) {
- DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr, flags);
- varPtr->value.tablePtr = NULL;
- }
- if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
- objPtr = varPtr->value.objPtr;
- TclDecrRefCount(objPtr);
- varPtr->value.objPtr = NULL;
- }
- varPtr->hPtr = NULL;
- varPtr->tracePtr = NULL;
- TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
-
- /*
- * If the variable was a namespace variable, decrement its reference
- * count. We are in the process of destroying its namespace so that
- * namespace will no longer "refer" to the variable.
- */
+void
+TclDeleteVars(
+ Interp *iPtr, /* Interpreter to which variables belong. */
+ TclVarHashTable *tablePtr) /* Hash table containing variables to
+ * delete. */
+{
+ Tcl_Interp *interp = (Tcl_Interp *) iPtr;
+ Tcl_HashSearch search;
+ register Var *varPtr;
+ int flags;
+ Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- if (TclIsVarNamespaceVar(varPtr)) {
- TclClearVarNamespaceVar(varPtr);
- varPtr->refCount--;
- }
+ /*
+ * Determine what flags to pass to the trace callback functions.
+ */
- /*
- * Recycle the variable's memory space if there aren't any upvar's
- * pointing to it. If there are upvars to this variable, then the
- * variable will get freed when the last upvar goes away.
- */
+ flags = TCL_TRACE_UNSETS;
+ if (tablePtr == &iPtr->globalNsPtr->varTable) {
+ flags |= TCL_GLOBAL_ONLY;
+ } else if (tablePtr == &currNsPtr->varTable) {
+ flags |= TCL_NAMESPACE_ONLY;
+ }
- if (varPtr->refCount == 0) {
- ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
- }
+ for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
+ varPtr = VarHashFirstVar(tablePtr, &search)) {
+ UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
+ -1);
+ VarHashDeleteEntry(varPtr);
}
- Tcl_DeleteHashTable(tablePtr);
+ VarHashDeleteTable(tablePtr);
}
/*
@@ -4270,102 +5422,41 @@ TclDeleteVars(iPtr, tablePtr)
*
* TclDeleteCompiledLocalVars --
*
- * This procedure is called to recycle storage space associated with the
+ * This function is called to recycle storage space associated with the
* compiler-allocated array of local variables in a procedure call frame.
- * This procedure resembles TclDeleteVars above except that each variable
- * is stored in a call frame and not a hash table. For this procedure to
+ * This function resembles TclDeleteVars above except that each variable
+ * is stored in a call frame and not a hash table. For this function to
* work correctly, it must not be possible for any of the variable in the
- * table to be accessed from Tcl commands (e.g. from trace procedures).
+ * table to be accessed from Tcl commands (e.g. from trace functions).
*
* Results:
* None.
*
* Side effects:
- * Variables are deleted and trace procedures are invoked, if any are
+ * Variables are deleted and trace functions are invoked, if any are
* declared.
*
*----------------------------------------------------------------------
*/
void
-TclDeleteCompiledLocalVars(iPtr, framePtr)
- Interp *iPtr; /* Interpreter to which variables belong. */
- CallFrame *framePtr; /* Procedure call frame containing compiler-
+TclDeleteCompiledLocalVars(
+ Interp *iPtr, /* Interpreter to which variables belong. */
+ CallFrame *framePtr) /* Procedure call frame containing compiler-
* assigned local variables to delete. */
{
register Var *varPtr;
- int flags; /* Flags passed to trace procedures. */
- Var *linkPtr;
- ActiveVarTrace *activePtr;
int numLocals, i;
+ Tcl_Obj **namePtrPtr;
- flags = TCL_TRACE_UNSETS;
numLocals = framePtr->numCompiledLocals;
varPtr = framePtr->compiledLocals;
- for (i = 0; i < numLocals; i++) {
- /*
- * For global/upvar variables referenced in procedures, decrement the
- * reference count on the variable referred to, and free the
- * referenced variable if it's no longer needed. Don't delete the hash
- * entry for the other variable if it's in the same table as us: this
- * will happen automatically later on.
- */
-
- if (TclIsVarLink(varPtr)) {
- linkPtr = varPtr->value.linkPtr;
- linkPtr->refCount--;
- if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
- && (linkPtr->tracePtr == NULL)
- && (linkPtr->flags & VAR_IN_HASHTABLE)) {
- if (linkPtr->hPtr == NULL) {
- ckfree((char *) linkPtr);
- } else {
- Tcl_DeleteHashEntry(linkPtr->hPtr);
- ckfree((char *) linkPtr);
- }
- }
- }
-
- /*
- * Invoke traces on the variable that is being deleted. Then delete
- * the variable's trace records.
- */
-
- if (varPtr->tracePtr != NULL) {
- TclCallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL,
- flags, /* leaveErrMsg */ 0);
- while (varPtr->tracePtr != NULL) {
- VarTrace *tracePtr = varPtr->tracePtr;
- varPtr->tracePtr = tracePtr->nextPtr;
- Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
- }
- for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
- if (activePtr->varPtr == varPtr) {
- activePtr->nextTracePtr = NULL;
- }
- }
- }
-
- /*
- * Now if the variable is an array, delete its element hash table.
- * Otherwise, if it's a scalar variable, decrement the ref count of
- * its value.
- */
-
- if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) {
- DeleteArray(iPtr, varPtr->name, varPtr, flags);
- }
- if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
- TclDecrRefCount(varPtr->value.objPtr);
- varPtr->value.objPtr = NULL;
- }
- varPtr->hPtr = NULL;
- varPtr->tracePtr = NULL;
- TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
- varPtr++;
+ namePtrPtr = &localName(framePtr, 0);
+ for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
+ UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
+ TCL_TRACE_UNSETS, i);
}
+ framePtr->numCompiledLocals = 0;
}
/*
@@ -4373,16 +5464,16 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
*
* DeleteArray --
*
- * This procedure is called to free up everything in an array variable.
+ * This function is called to free up everything in an array variable.
* It's the caller's responsibility to make sure that the array is no
- * longer accessible before this procedure is called.
+ * longer accessible before this function is called.
*
* Results:
* None.
*
* Side effects:
* All storage associated with varPtr's array elements is deleted
- * (including the array's hash table). Deletion trace procedures for
+ * (including the array's hash table). Deletion trace functions for
* array elements are invoked, then deleted. Any pending traces for array
* elements are also deleted.
*
@@ -4390,43 +5481,64 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
*/
static void
-DeleteArray(iPtr, arrayName, varPtr, flags)
- Interp *iPtr; /* Interpreter containing array. */
- CONST char *arrayName; /* Name of array (used for trace
- * callbacks). */
- Var *varPtr; /* Pointer to variable structure. */
- int flags; /* Flags to pass to TclCallVarTraces:
+DeleteArray(
+ Interp *iPtr, /* Interpreter containing array. */
+ Tcl_Obj *arrayNamePtr, /* Name of array (used for trace callbacks),
+ * or NULL if it is to be computed on
+ * demand. */
+ Var *varPtr, /* Pointer to variable structure. */
+ int flags, /* Flags to pass to TclCallVarTraces:
* TCL_TRACE_UNSETS and sometimes
- * TCL_INTERP_DESTROYED, TCL_NAMESPACE_ONLY,
- * or TCL_GLOBAL_ONLY. */
+ * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */
+ int index)
{
Tcl_HashSearch search;
- register Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *tPtr;
register Var *elPtr;
ActiveVarTrace *activePtr;
Tcl_Obj *objPtr;
+ VarTrace *tracePtr;
- DeleteSearches(varPtr);
- for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- elPtr = (Var *) Tcl_GetHashValue(hPtr);
+ if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+ DeleteSearches(iPtr, varPtr);
+ }
+ for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
+ elPtr != NULL; elPtr = VarHashNextVar(&search)) {
if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
objPtr = elPtr->value.objPtr;
TclDecrRefCount(objPtr);
elPtr->value.objPtr = NULL;
}
- elPtr->hPtr = NULL;
- if (elPtr->tracePtr != NULL) {
- elPtr->flags &= ~VAR_TRACE_ACTIVE;
- TclCallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName,
- Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags,
- /* leaveErrMsg */ 0);
- while (elPtr->tracePtr != NULL) {
- VarTrace *tracePtr = elPtr->tracePtr;
-
- elPtr->tracePtr = tracePtr->nextPtr;
- Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+
+ /*
+ * Lie about the validity of the hashtable entry. In this way the
+ * variables will be deleted by VarHashDeleteTable.
+ */
+
+ VarHashInvalidateEntry(elPtr);
+ if (TclIsVarTraced(elPtr)) {
+ /*
+ * Compute the array name if it was not supplied.
+ */
+
+ if (elPtr->flags & VAR_TRACED_UNSET) {
+ Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);
+
+ elPtr->flags &= ~VAR_TRACE_ACTIVE;
+ TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
+ elNamePtr, flags,/* leaveErrMsg */ 0, index);
+ }
+ tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
+ tracePtr = Tcl_GetHashValue(tPtr);
+ while (tracePtr) {
+ VarTrace *prevPtr = tracePtr;
+
+ tracePtr = tracePtr->nextPtr;
+ prevPtr->nextPtr = NULL;
+ Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
}
+ Tcl_DeleteHashEntry(tPtr);
+ elPtr->flags &= ~VAR_ALL_TRACES;
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == elPtr) {
@@ -4435,7 +5547,6 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
}
}
TclSetVarUndefined(elPtr);
- TclSetVarScalar(elPtr);
/*
* Even though array elements are not supposed to be namespace
@@ -4444,101 +5555,76 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
* the corresponding Var struct, and is otherwise harmless.
*/
- if (TclIsVarNamespaceVar(elPtr)) {
- TclClearVarNamespaceVar(elPtr);
- elPtr->refCount--;
- }
- if (elPtr->refCount == 0) {
- ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
- }
+ TclClearVarNamespaceVar(elPtr);
}
- Tcl_DeleteHashTable(varPtr->value.tablePtr);
- ckfree((char *) varPtr->value.tablePtr);
+ VarHashDeleteTable(varPtr->value.tablePtr);
+ ckfree(varPtr->value.tablePtr);
}
/*
*----------------------------------------------------------------------
*
- * TclCleanupVar --
+ * TclObjVarErrMsg --
*
- * This procedure is called when it looks like it may be OK to free up a
- * variable's storage. If the variable is in a hashtable, its Var
- * structure and hash table entry will be freed along with those of its
- * containing array, if any. This procedure is called, for example, when
- * a trace on a variable deletes a variable.
+ * Generate a reasonable error message describing why a variable
+ * operation failed.
*
* Results:
* None.
*
* Side effects:
- * If the variable (or its containing array) really is dead and in a
- * hashtable, then its Var structure, and possibly its hash table entry,
- * is freed up.
+ * The interp's result is set to hold a message identifying the variable
+ * given by part1 and part2 and describing why the variable operation
+ * failed.
*
*----------------------------------------------------------------------
*/
void
-TclCleanupVar(varPtr, arrayPtr)
- Var *varPtr; /* Pointer to variable that may be a candidate
- * for being expunged. */
- Var *arrayPtr; /* Array that contains the variable, or NULL
- * if this variable isn't an array element. */
+TclVarErrMsg(
+ Tcl_Interp *interp, /* Interpreter in which to record message. */
+ const char *part1,
+ const char *part2, /* Variable's two-part name. */
+ const char *operation, /* String describing operation that failed,
+ * e.g. "read", "set", or "unset". */
+ const char *reason) /* String describing why operation failed. */
{
- if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
- && (varPtr->tracePtr == NULL)
- && (varPtr->flags & VAR_IN_HASHTABLE)) {
- if (varPtr->hPtr != NULL) {
- Tcl_DeleteHashEntry(varPtr->hPtr);
- }
- ckfree((char *) varPtr);
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+
+ if (part2) {
+ part2Ptr = Tcl_NewStringObj(part2, -1);
}
- if (arrayPtr != NULL) {
- if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
- && (arrayPtr->tracePtr == NULL)
- && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
- if (arrayPtr->hPtr != NULL) {
- Tcl_DeleteHashEntry(arrayPtr->hPtr);
- }
- ckfree((char *) arrayPtr);
- }
+
+ TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
+
+ Tcl_DecrRefCount(part1Ptr);
+ if (part2Ptr) {
+ Tcl_DecrRefCount(part2Ptr);
}
}
-/*
- *----------------------------------------------------------------------
- *
- * TclVarErrMsg --
- *
- * Generate a reasonable error message describing why a variable
- * operation failed.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The interp's result is set to hold a message identifying the variable
- * given by part1 and part2 and describing why the variable operation
- * failed.
- *
- *----------------------------------------------------------------------
- */
void
-TclVarErrMsg(interp, part1, part2, operation, reason)
- Tcl_Interp *interp; /* Interpreter in which to record message. */
- CONST char *part1;
- CONST char *part2; /* Variable's two-part name. */
- CONST char *operation; /* String describing operation that failed,
+TclObjVarErrMsg(
+ Tcl_Interp *interp, /* Interpreter in which to record message. */
+ Tcl_Obj *part1Ptr, /* (may be NULL, if index >= 0) */
+ Tcl_Obj *part2Ptr, /* Variable's two-part name. */
+ const char *operation, /* String describing operation that failed,
* e.g. "read", "set", or "unset". */
- CONST char *reason; /* String describing why operation failed. */
+ const char *reason, /* String describing why operation failed. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
- (char *) NULL);
- if (part2 != NULL) {
- Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
+ if (!part1Ptr) {
+ if (index == -1) {
+ Tcl_Panic("invalid part1Ptr and invalid index together");
+ }
+ part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
}
- Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
+ operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
+ (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
+ reason));
}
/*
@@ -4554,19 +5640,19 @@ TclVarErrMsg(interp, part1, part2, operation, reason)
*/
static void
-PanicOnUpdateVarName(objPtr)
- Tcl_Obj *objPtr;
+PanicOnUpdateVarName(
+ Tcl_Obj *objPtr)
{
- Tcl_Panic("ERROR: updateStringProc of type %s should not be called.",
+ Tcl_Panic("%s of type %s should not be called", "updateStringProc",
objPtr->typePtr->name);
}
static int
-PanicOnSetVarName(interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
+PanicOnSetVarName(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
- Tcl_Panic("ERROR: setFromAnyProc of type %s should not be called.",
+ Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
objPtr->typePtr->name);
return TCL_ERROR;
}
@@ -4575,15 +5661,38 @@ PanicOnSetVarName(interp, objPtr)
* localVarName -
*
* INTERNALREP DEFINITION:
- * longValue = index into locals table
+ * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache
+ * or NULL if it is this same obj
+ * ptrAndLongRep.value: index into locals table
*/
static void
-DupLocalVarName(srcPtr, dupPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *dupPtr;
+FreeLocalVarName(
+ Tcl_Obj *objPtr)
{
- dupPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+ Tcl_Obj *namePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+
+ if (namePtr) {
+ Tcl_DecrRefCount(namePtr);
+ }
+ objPtr->typePtr = NULL;
+}
+
+static void
+DupLocalVarName(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
+{
+ Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
+
+ if (!namePtr) {
+ namePtr = srcPtr;
+ }
+ dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
+ Tcl_IncrRefCount(namePtr);
+
+ dupPtr->internalRep.ptrAndLongRep.value =
+ srcPtr->internalRep.ptrAndLongRep.value;
dupPtr->typePtr = &localVarNameType;
}
@@ -4597,28 +5706,33 @@ DupLocalVarName(srcPtr, dupPtr)
*/
static void
-FreeNsVarName(objPtr)
- Tcl_Obj *objPtr;
+FreeNsVarName(
+ Tcl_Obj *objPtr)
{
- register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2;
+ register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
- varPtr->refCount--;
- if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
- TclCleanupVar(varPtr, NULL);
+ if (TclIsVarInHash(varPtr)) {
+ varPtr->refCount--;
+ if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
+ CleanupVar(varPtr, NULL);
+ }
}
+ objPtr->typePtr = NULL;
}
static void
-DupNsVarName(srcPtr, dupPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *dupPtr;
+DupNsVarName(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
{
- Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1;
- register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2;
+ Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;
- dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
- dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
- varPtr->refCount++;
+ dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
+ dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
+ if (TclIsVarInHash(varPtr)) {
+ varPtr->refCount++;
+ }
dupPtr->typePtr = &tclNsVarNameType;
}
#endif
@@ -4633,51 +5747,51 @@ DupNsVarName(srcPtr, dupPtr)
*/
static void
-FreeParsedVarName(objPtr)
- Tcl_Obj *objPtr;
+FreeParsedVarName(
+ Tcl_Obj *objPtr)
{
- register Tcl_Obj *arrayPtr = (Tcl_Obj *)
- objPtr->internalRep.twoPtrValue.ptr1;
- register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+ register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
ckfree(elem);
}
+ objPtr->typePtr = NULL;
}
static void
-DupParsedVarName(srcPtr, dupPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *dupPtr;
+DupParsedVarName(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
{
- register Tcl_Obj *arrayPtr = (Tcl_Obj *)
- srcPtr->internalRep.twoPtrValue.ptr1;
- register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2;
+ register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
char *elemCopy;
- unsigned int elemLen;
+ unsigned elemLen;
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;
}
- dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arrayPtr;
- dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) elem;
+ dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
+ dupPtr->internalRep.twoPtrValue.ptr2 = elem;
dupPtr->typePtr = &tclParsedVarNameType;
}
static void
-UpdateParsedVarName(objPtr)
- Tcl_Obj *objPtr;
+UpdateParsedVarName(
+ Tcl_Obj *objPtr)
{
- Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
- char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2;
- char *part1, *p;
+ Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
+ const char *part1;
+ char *p;
int len1, len2, totalLen;
if (arrayPtr == NULL) {
@@ -4685,24 +5799,754 @@ UpdateParsedVarName(objPtr)
* This is a parsed scalar name: what is it doing here?
*/
- Tcl_Panic("ERROR: scalar parsedVarName without a string rep.\n");
+ Tcl_Panic("scalar parsedVarName without a string rep");
}
- part1 = Tcl_GetStringFromObj(arrayPtr, &len1);
+ part1 = TclGetStringFromObj(arrayPtr, &len1);
len2 = strlen(part2);
totalLen = len1 + len2 + 2;
- p = ckalloc((unsigned int) totalLen + 1);
+ p = ckalloc(totalLen + 1);
objPtr->bytes = p;
objPtr->length = totalLen;
- memcpy(p, part1, (unsigned int) len1);
+ memcpy(p, part1, (unsigned) len1);
p += len1;
*p++ = '(';
- memcpy(p, part2, (unsigned int) len2);
+ memcpy(p, part2, (unsigned) len2);
p += len2;
*p++ = ')';
- *p = '\0';
+ *p = '\0';
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
+ *
+ * Searches for a namespace variable, a variable not local to a
+ * procedure. The variable can be either a scalar or an array, but may
+ * not be an element of an array.
+ *
+ * Results:
+ * Returns a token for the variable if it is found. Otherwise, if it
+ * can't be found or there is an error, returns NULL and leaves an error
+ * message in the interpreter's result object if "flags" contains
+ * TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Var
+Tcl_FindNamespaceVar(
+ Tcl_Interp *interp, /* The interpreter in which to find the
+ * variable. */
+ const char *name, /* Variable's name. If it starts with "::",
+ * will be looked up in global namespace.
+ * Else, looked up first in contextNsPtr
+ * (current namespace if contextNsPtr is
+ * NULL), then in global namespace. */
+ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+ * Otherwise, points to namespace in which to
+ * resolve name. If NULL, look up name in the
+ * current namespace. */
+ int flags) /* An OR'd combination of: AVOID_RESOLVERS,
+ * TCL_GLOBAL_ONLY (look up name only in
+ * global namespace), TCL_NAMESPACE_ONLY (look
+ * up only in contextNsPtr, or the current
+ * namespace if contextNsPtr is NULL), and
+ * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+ * and TCL_NAMESPACE_ONLY are given,
+ * TCL_GLOBAL_ONLY is ignored. */
+{
+ Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
+ Tcl_Var var;
+
+ var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
+ Tcl_DecrRefCount(namePtr);
+ return var;
+}
+
+static Tcl_Var
+ObjFindNamespaceVar(
+ Tcl_Interp *interp, /* The interpreter in which to find the
+ * variable. */
+ Tcl_Obj *namePtr, /* Variable's name. If it starts with "::",
+ * will be looked up in global namespace.
+ * Else, looked up first in contextNsPtr
+ * (current namespace if contextNsPtr is
+ * NULL), then in global namespace. */
+ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+ * Otherwise, points to namespace in which to
+ * resolve name. If NULL, look up name in the
+ * current namespace. */
+ int flags) /* An OR'd combination of: AVOID_RESOLVERS,
+ * TCL_GLOBAL_ONLY (look up name only in
+ * global namespace), TCL_NAMESPACE_ONLY (look
+ * up only in contextNsPtr, or the current
+ * namespace if contextNsPtr is NULL), and
+ * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+ * and TCL_NAMESPACE_ONLY are given,
+ * TCL_GLOBAL_ONLY is ignored. */
+{
+ Interp *iPtr = (Interp *) interp;
+ ResolverScheme *resPtr;
+ Namespace *nsPtr[2], *cxtNsPtr;
+ const char *simpleName;
+ Var *varPtr;
+ register int search;
+ int result;
+ Tcl_Var var;
+ Tcl_Obj *simpleNamePtr;
+ const char *name = TclGetString(namePtr);
+
+ /*
+ * If this namespace has a variable resolver, then give it first crack at
+ * the variable resolution. It may return a Tcl_Var value, it may signal
+ * to continue onward, or it may signal an error.
+ */
+
+ if ((flags & TCL_GLOBAL_ONLY) != 0) {
+ cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
+ } else if (contextNsPtr != NULL) {
+ cxtNsPtr = (Namespace *) contextNsPtr;
+ } else {
+ cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ }
+
+ if (!(flags & AVOID_RESOLVERS) &&
+ (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
+ resPtr = iPtr->resolverPtr;
+
+ if (cxtNsPtr->varResProc) {
+ result = cxtNsPtr->varResProc(interp, name,
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ } else {
+ result = TCL_CONTINUE;
+ }
+
+ while (result == TCL_CONTINUE && resPtr) {
+ if (resPtr->varResProc) {
+ result = resPtr->varResProc(interp, name,
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ }
+ resPtr = resPtr->nextPtr;
+ }
+
+ if (result == TCL_OK) {
+ return var;
+ } else if (result != TCL_CONTINUE) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Find the namespace(s) that contain the variable.
+ */
+
+ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+ flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+
+ /*
+ * Look for the variable in the variable table of its namespace. Be sure
+ * to check both possible search paths: from the specified namespace
+ * context and from the global namespace.
+ */
+
+ varPtr = NULL;
+ if (simpleName != name) {
+ simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
+ } else {
+ simpleNamePtr = namePtr;
+ }
+
+ for (search = 0; (search < 2) && (varPtr == NULL); search++) {
+ if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+ varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
+ }
+ }
+ if (simpleName != name) {
+ Tcl_DecrRefCount(simpleNamePtr);
+ }
+ if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown variable \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
+ }
+ return (Tcl_Var) varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoVarsCmd -- (moved over from tclCmdIL.c)
+ *
+ * Called to implement the "info vars" command that returns the list of
+ * variables in the interpreter that match an optional pattern. The
+ * pattern, if any, consists of an optional sequence of namespace names
+ * separated by "::" qualifiers, which is followed by a glob-style
+ * pattern that restricts which variables are returned. Handles the
+ * following syntax:
+ *
+ * info vars ?pattern?
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If there is an
+ * error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoVarsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ const char *varName, *pattern, *simplePattern;
+ Tcl_HashSearch search;
+ Var *varPtr;
+ Namespace *nsPtr;
+ Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
+ int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
+ Tcl_Obj *simplePatternPtr = NULL;
+
+ /*
+ * Get the pattern and find the "effective namespace" in which to list
+ * variables. We only use this effective namespace if there's no active
+ * Tcl procedure frame.
+ */
+
+ if (objc == 1) {
+ simplePattern = NULL;
+ nsPtr = currNsPtr;
+ specificNsInPattern = 0;
+ } else if (objc == 2) {
+ /*
+ * From the pattern, get the effective namespace and the simple
+ * pattern (no namespace qualifiers or ::'s) at the end. If an error
+ * was found while parsing the pattern, return it. Otherwise, if the
+ * namespace wasn't found, just leave nsPtr NULL: we will return an
+ * empty list since no variables there can be found.
+ */
+
+ Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+ pattern = TclGetString(objv[1]);
+ TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
+ &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
+ specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+ if (simplePattern == pattern) {
+ simplePatternPtr = objv[1];
+ } else {
+ simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
+ }
+ Tcl_IncrRefCount(simplePatternPtr);
+ }
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the namespace specified in the pattern wasn't found, just return.
+ */
+
+ if (nsPtr == NULL) {
+ return TCL_OK;
+ }
+
+ listPtr = Tcl_NewListObj(0, NULL);
+
+ if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
+ /*
+ * There is no frame pointer, the frame pointer was pushed only to
+ * activate a namespace, or we are in a procedure call frame but a
+ * specific namespace was specified. Create a list containing only the
+ * variables in the effective namespace's variable table.
+ */
+
+ if (simplePattern && TclMatchIsTrivial(simplePattern)) {
+ /*
+ * If we can just do hash lookups, that simplifies things a lot.
+ */
+
+ varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
+ if (varPtr) {
+ if (!TclIsVarUndefined(varPtr)
+ || TclIsVarNamespaceVar(varPtr)) {
+ if (specificNsInPattern) {
+ elemObjPtr = Tcl_NewObj();
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+ elemObjPtr);
+ } else {
+ elemObjPtr = VarHashGetKey(varPtr);
+ }
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ }
+ } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+ varPtr = VarHashFindVar(&globalNsPtr->varTable,
+ simplePatternPtr);
+ if (varPtr) {
+ if (!TclIsVarUndefined(varPtr)
+ || TclIsVarNamespaceVar(varPtr)) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ VarHashGetKey(varPtr));
+ }
+ }
+ }
+ } else {
+ /*
+ * Have to scan the tables of variables.
+ */
+
+ varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
+ while (varPtr) {
+ if (!TclIsVarUndefined(varPtr)
+ || TclIsVarNamespaceVar(varPtr)) {
+ varNamePtr = VarHashGetKey(varPtr);
+ varName = TclGetString(varNamePtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(varName, simplePattern)) {
+ if (specificNsInPattern) {
+ elemObjPtr = Tcl_NewObj();
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+ elemObjPtr);
+ } else {
+ elemObjPtr = varNamePtr;
+ }
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ }
+ }
+ varPtr = VarHashNextVar(&search);
+ }
+
+ /*
+ * If the effective namespace isn't the global :: namespace, and a
+ * specific namespace wasn't requested in the pattern (i.e., the
+ * pattern only specifies variable names), then add in all global
+ * :: variables that match the simple pattern. Of course, add in
+ * only those variables that aren't hidden by a variable in the
+ * effective namespace.
+ */
+
+ if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+ varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
+ while (varPtr) {
+ if (!TclIsVarUndefined(varPtr)
+ || TclIsVarNamespaceVar(varPtr)) {
+ varNamePtr = VarHashGetKey(varPtr);
+ varName = TclGetString(varNamePtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(varName, simplePattern)) {
+ if (VarHashFindVar(&nsPtr->varTable,
+ varNamePtr) == NULL) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ varNamePtr);
+ }
+ }
+ }
+ varPtr = VarHashNextVar(&search);
+ }
+ }
+ }
+ } else if (iPtr->varFramePtr->procPtr != NULL) {
+ AppendLocals(interp, listPtr, simplePatternPtr, 1);
+ }
+
+ if (simplePatternPtr) {
+ Tcl_DecrRefCount(simplePatternPtr);
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoGlobalsCmd -- (moved over from tclCmdIL.c)
+ *
+ * Called to implement the "info globals" command that returns the list
+ * of global variables matching an optional pattern. Handles the
+ * following syntax:
+ *
+ * info globals ?pattern?
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If there is an
+ * error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoGlobalsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *varName, *pattern;
+ Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+ Tcl_HashSearch search;
+ Var *varPtr;
+ Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
+
+ if (objc == 1) {
+ pattern = NULL;
+ } else if (objc == 2) {
+ pattern = TclGetString(objv[1]);
+
+ /*
+ * Strip leading global-namespace qualifiers. [Bug 1057461]
+ */
+
+ if (pattern[0] == ':' && pattern[1] == ':') {
+ while (*pattern == ':') {
+ pattern++;
+ }
+ }
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through the global :: namespace's variable table and create a list
+ * of all global variables that match the pattern.
+ */
+
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (pattern != NULL && TclMatchIsTrivial(pattern)) {
+ if (pattern == TclGetString(objv[1])) {
+ patternPtr = objv[1];
+ } else {
+ patternPtr = Tcl_NewStringObj(pattern, -1);
+ }
+ Tcl_IncrRefCount(patternPtr);
+
+ varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr);
+ if (varPtr) {
+ if (!TclIsVarUndefined(varPtr)) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ VarHashGetKey(varPtr));
+ }
+ }
+ Tcl_DecrRefCount(patternPtr);
+ } else {
+ for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
+ varPtr != NULL;
+ varPtr = VarHashNextVar(&search)) {
+ if (TclIsVarUndefined(varPtr)) {
+ continue;
+ }
+ varNamePtr = VarHashGetKey(varPtr);
+ varName = TclGetString(varNamePtr);
+ if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+ Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
+ }
+ }
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoLocalsCmd -- (moved over from tclCmdIl.c)
+ *
+ * Called to implement the "info locals" command to return a list of
+ * local variables that match an optional pattern. Handles the following
+ * syntax:
+ *
+ * info locals ?pattern?
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a result in the interpreter's result object. If there is an
+ * error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoLocalsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *patternPtr, *listPtr;
+
+ if (objc == 1) {
+ patternPtr = NULL;
+ } else if (objc == 2) {
+ patternPtr = objv[1];
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ if (!HasLocalVars(iPtr->varFramePtr)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Return a list containing names of first the compiled locals (i.e. the
+ * ones stored in the call frame), then the variables in the local hash
+ * table (if one exists).
+ */
+
+ listPtr = Tcl_NewListObj(0, NULL);
+ AppendLocals(interp, listPtr, patternPtr, 0);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendLocals --
+ *
+ * Append the local variables for the current frame to the specified list
+ * object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendLocals(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *listPtr, /* List object to append names to. */
+ Tcl_Obj *patternPtr, /* Pattern to match against. */
+ int includeLinks) /* 1 if upvars should be included, else 0. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Var *varPtr;
+ 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++) {
+ /*
+ * Skip nameless (temporary) variables and undefined variables.
+ */
+
+ if (*varNamePtr && !TclIsVarUndefined(varPtr)
+ && (includeLinks || !TclIsVarLink(varPtr))) {
+ varName = TclGetString(*varNamePtr);
+ if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+ Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+ }
+ }
+ }
+ varPtr++;
+ }
+
+ /*
+ * Do nothing if no local variables.
+ */
+
+ if (localVarTablePtr == NULL) {
+ goto objectVars;
+ }
+
+ /*
+ * Check for the simple and fast case.
+ */
+
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
+ if (varPtr != NULL) {
+ if (!TclIsVarUndefined(varPtr)
+ && (includeLinks || !TclIsVarLink(varPtr))) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ VarHashGetKey(varPtr));
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
+ &added);
+ }
+ }
+ }
+ goto objectVars;
+ }
+
+ /*
+ * Scan over and process all local variables.
+ */
+
+ for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
+ varPtr != NULL;
+ varPtr = VarHashNextVar(&search)) {
+ if (!TclIsVarUndefined(varPtr)
+ && (includeLinks || !TclIsVarLink(varPtr))) {
+ objNamePtr = VarHashGetKey(varPtr);
+ 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);
+}
+
+/*
+ * Hash table implementation - first, just copy and adapt the obj key stuff
+ */
+
+void
+TclInitVarHashTable(
+ TclVarHashTable *tablePtr,
+ Namespace *nsPtr)
+{
+ Tcl_InitCustomHashTable(&tablePtr->table,
+ TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType);
+ tablePtr->nsPtr = nsPtr;
+}
+
+static Tcl_HashEntry *
+AllocVarEntry(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key to store in the hash table entry. */
+{
+ Tcl_Obj *objPtr = keyPtr;
+ Tcl_HashEntry *hPtr;
+ Var *varPtr;
+
+ varPtr = ckalloc(sizeof(VarInHash));
+ varPtr->flags = VAR_IN_HASHTABLE;
+ varPtr->value.objPtr = NULL;
+ VarHashRefCount(varPtr) = 1;
+
+ hPtr = &(((VarInHash *) varPtr)->entry);
+ Tcl_SetHashValue(hPtr, varPtr);
+ hPtr->key.objPtr = objPtr;
+ Tcl_IncrRefCount(objPtr);
+
+ return hPtr;
+}
+
+static void
+FreeVarEntry(
+ Tcl_HashEntry *hPtr)
+{
+ Var *varPtr = VarHashGetValue(hPtr);
+ Tcl_Obj *objPtr = hPtr->key.objPtr;
+
+ if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
+ && (VarHashRefCount(varPtr) == 1)) {
+ ckfree(varPtr);
+ } else {
+ VarHashInvalidateEntry(varPtr);
+ TclSetVarUndefined(varPtr);
+ VarHashRefCount(varPtr)--;
+ }
+ Tcl_DecrRefCount(objPtr);
+}
+
+static int
+CompareVarKeys(
+ void *keyPtr, /* New key to compare. */
+ Tcl_HashEntry *hPtr) /* Existing key to compare. */
+{
+ Tcl_Obj *objPtr1 = keyPtr;
+ Tcl_Obj *objPtr2 = hPtr->key.objPtr;
+ register const char *p1, *p2;
+ register int l1, l2;
+
+ /*
+ * If the object pointers are the same then they match.
+ */
+
+ if (objPtr1 == objPtr2) {
+ return 1;
+ }
+
+ /*
+ * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
+ * register.
+ */
+
+ p1 = TclGetString(objPtr1);
+ l1 = objPtr1->length;
+ p2 = TclGetString(objPtr2);
+ l2 = objPtr2->length;
+
+ /*
+ * Only compare string representations of the same length.
+ */
+
+ return ((l1 == l2) && !memcmp(p1, p2, l1));
}
/*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
new file mode 100644
index 0000000..9bceb4c
--- /dev/null
+++ b/generic/tclZlib.c
@@ -0,0 +1,4017 @@
+/*
+ * tclZlib.c --
+ *
+ * This file provides the interface to the Zlib library.
+ *
+ * Copyright (C) 2004-2005 Pascal Scheffers <pascal@scheffers.net>
+ * Copyright (C) 2005 Unitas Software B.V.
+ * 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.
+ */
+
+#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
+ * format or automatic detection of format. Putting it here is slightly less
+ * gross!
+ */
+
+#define WBITS_RAW (-MAX_WBITS)
+#define WBITS_ZLIB (MAX_WBITS)
+#define WBITS_GZIP (MAX_WBITS | 16)
+#define WBITS_AUTODETECT (MAX_WBITS | 32)
+
+/*
+ * Structure used for handling gzip headers that are generated from a
+ * dictionary. It comprises the header structure itself plus some working
+ * space that it is very convenient to have attached.
+ */
+
+#define MAX_COMMENT_LEN 256
+
+typedef struct {
+ gz_header header;
+ char nativeFilenameBuf[MAXPATHLEN];
+ char nativeCommentBuf[MAX_COMMENT_LEN];
+} GzipHeader;
+
+/*
+ * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...]
+ */
+
+typedef struct {
+ Tcl_Interp *interp;
+ z_stream stream; /* The interface to the zlib library. */
+ int streamEnd; /* If we've got to end-of-stream. */
+ Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */
+ Tcl_Obj *currentInput; /* Pointer to what is currently being
+ * inflated. */
+ int outPos;
+ int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or
+ * TCL_ZLIB_STREAM_INFLATE. */
+ int format; /* Flags from the TCL_ZLIB_FORMAT_* */
+ int level; /* Default 5, 0-9 */
+ int flush; /* Stores the flush param for deferred the
+ * decompression. */
+ 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.
+ */
+
+typedef struct {
+ Tcl_Channel chan; /* Reference to the channel itself. */
+ Tcl_Channel parent; /* The underlying source and sink of bytes. */
+ int flags; /* General flag bits, see below... */
+ int mode; /* Either the value TCL_ZLIB_STREAM_DEFLATE
+ * 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
+ * output. */
+ char *inBuffer, *outBuffer; /* Working buffers. */
+ int inAllocated, outAllocated;
+ /* Sizes of working buffers. */
+ GzipHeader inHeader; /* Header read from input stream, when
+ * decompressing a gzip stream. */
+ 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;
+
+/*
+ * Value bits for the flags field. Definitions are:
+ * ASYNC - Whether this is an asynchronous channel.
+ * IN_HEADER - Whether the inHeader field has been registered with
+ * the input compressor.
+ * OUT_HEADER - Whether the outputHeader field has been registered
+ * with the output decompressor.
+ */
+
+#define ASYNC 0x1
+#define IN_HEADER 0x2
+#define OUT_HEADER 0x4
+
+/*
+ * 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
+#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 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.
+ */
+
+static const Tcl_ChannelType zlibChannelType = {
+ "zlib",
+ TCL_CHANNEL_VERSION_3,
+ ZlibTransformClose,
+ ZlibTransformInput,
+ ZlibTransformOutput,
+ NULL, /* seekProc */
+ ZlibTransformSetOption,
+ ZlibTransformGetOption,
+ ZlibTransformWatch,
+ ZlibTransformGetHandle,
+ NULL, /* close2Proc */
+ ZlibTransformBlockMode,
+ NULL, /* flushProc */
+ ZlibTransformEventHandler,
+ NULL, /* wideSeekProc */
+ NULL,
+ NULL
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertError --
+ *
+ * Utility function for converting a zlib error into a Tcl error.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the interpreter result and errorcode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+ uLong adler) /* The checksum expected (for Z_NEED_DICT) */
+{
+ const char *codeStr, *codeStr2 = NULL;
+ char codeStrBuf[TCL_INTEGER_SPACE];
+
+ if (interp == NULL) {
+ return;
+ }
+
+ 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));
+ return;
+
+ /*
+ * 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.)
+ */
+
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateHeader --
+ *
+ * Function for creating a gzip header from the contents of a dictionary
+ * (as described in the documentation). GetValue is a helper function.
+ *
+ * Results:
+ * A Tcl result code.
+ *
+ * Side effects:
+ * Updates the fields of the given gz_header structure. Adds amount of
+ * extra space required for the header to the variable referenced by the
+ * extraSizePtr argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetValue(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictObj,
+ const char *nameStr,
+ Tcl_Obj **valuePtrPtr)
+{
+ Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
+ int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);
+
+ TclDecrRefCount(name);
+ return result;
+}
+
+static int
+GenerateHeader(
+ Tcl_Interp *interp, /* Where to put error messages. */
+ Tcl_Obj *dictObj, /* The dictionary whose contents are to be
+ * parsed. */
+ GzipHeader *headerPtr, /* Where to store the parsed-out values. */
+ int *extraSizePtr) /* Variable to add the length of header
+ * strings (filename, comment) to. */
+{
+ Tcl_Obj *value;
+ int len, result = TCL_ERROR;
+ const char *valueStr;
+ Tcl_Encoding latin1enc;
+ static const char *const types[] = {
+ "binary", "text"
+ };
+
+ /*
+ * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
+ */
+
+ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
+ if (latin1enc == NULL) {
+ Tcl_Panic("no latin-1 encoding");
+ }
+
+ if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL) {
+ valueStr = Tcl_GetStringFromObj(value, &len);
+ Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
+ headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
+ NULL);
+ headerPtr->nativeCommentBuf[len] = '\0';
+ headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
+ if (extraSizePtr != NULL) {
+ *extraSizePtr += len;
+ }
+ }
+
+ if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL &&
+ Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
+ goto error;
+ }
+
+ if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL) {
+ valueStr = Tcl_GetStringFromObj(value, &len);
+ Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
+ headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
+ headerPtr->nativeFilenameBuf[len] = '\0';
+ headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
+ if (extraSizePtr != NULL) {
+ *extraSizePtr += len;
+ }
+ }
+
+ if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL && Tcl_GetIntFromObj(interp, value,
+ &headerPtr->header.os) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Ignore the 'size' field, since that is controlled by the size of the
+ * input data.
+ */
+
+ if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
+ (long *) &headerPtr->header.time) != TCL_OK) {
+ goto error;
+ }
+
+ if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
+ goto error;
+ } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
+ "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
+ goto error;
+ }
+
+ result = TCL_OK;
+ error:
+ Tcl_FreeEncoding(latin1enc);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExtractHeader --
+ *
+ * Take the values out of a gzip header and store them in a dictionary.
+ * SetValue is a helper macro.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the dictionary, which must be writable (i.e. refCount < 2).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define SetValue(dictObj, key, value) \
+ Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
+
+static void
+ExtractHeader(
+ gz_header *headerPtr, /* The gzip header to extract from. */
+ Tcl_Obj *dictObj) /* The dictionary to store in. */
+{
+ Tcl_Encoding latin1enc = NULL;
+ Tcl_DString tmp;
+
+ if (headerPtr->comment != Z_NULL) {
+ if (latin1enc == NULL) {
+ /*
+ * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
+ */
+
+ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
+ if (latin1enc == NULL) {
+ Tcl_Panic("no latin-1 encoding");
+ }
+ }
+
+ Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
+ &tmp);
+ SetValue(dictObj, "comment", TclDStringToObj(&tmp));
+ }
+ SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
+ if (headerPtr->name != Z_NULL) {
+ if (latin1enc == NULL) {
+ /*
+ * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
+ */
+
+ latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
+ if (latin1enc == NULL) {
+ Tcl_Panic("no latin-1 encoding");
+ }
+ }
+
+ Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
+ &tmp);
+ SetValue(dictObj, "filename", TclDStringToObj(&tmp));
+ }
+ if (headerPtr->os != 255) {
+ SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ }
+ if (headerPtr->time != 0 /* magic - no time */) {
+ SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
+ }
+ if (headerPtr->text != Z_UNKNOWN) {
+ SetValue(dictObj, "type",
+ Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
+ }
+
+ if (latin1enc != NULL) {
+ Tcl_FreeEncoding(latin1enc);
+ }
+}
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamInit --
+ *
+ * This command initializes a (de)compression context/handle for
+ * (de)compressing data in chunks.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The variable pointed to by zshandlePtr is initialised and memory
+ * allocated for internal state. Additionally, if interp is not null, a
+ * Tcl command is created and its name placed in the interp result obj.
+ *
+ * Note:
+ * At least one of interp and zshandlePtr should be non-NULL or the
+ * reference to the stream will be completely lost.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamInit(
+ Tcl_Interp *interp,
+ int mode, /* Either TCL_ZLIB_STREAM_INFLATE or
+ * TCL_ZLIB_STREAM_DEFLATE. */
+ int format, /* Flags from the TCL_ZLIB_FORMAT_* set. */
+ int level, /* 0-9 or TCL_ZLIB_COMPRESS_DEFAULT. */
+ Tcl_Obj *dictObj, /* Dictionary containing headers for gzip. */
+ Tcl_ZlibStream *zshandlePtr)
+{
+ int wbits = 0;
+ int e;
+ ZlibStreamHandle *zshPtr = NULL;
+ Tcl_DString cmdname;
+ Tcl_CmdInfo cmdinfo;
+ GzipHeader *gzHeaderPtr = NULL;
+
+ switch (mode) {
+ case TCL_ZLIB_STREAM_DEFLATE:
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h
+ * for details.
+ */
+
+ switch (format) {
+ case TCL_ZLIB_FORMAT_RAW:
+ wbits = WBITS_RAW;
+ 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;
+ break;
+ default:
+ Tcl_Panic("incorrect zlib data format, must be "
+ "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or "
+ "TCL_ZLIB_FORMAT_RAW");
+ }
+ if (level < -1 || level > 9) {
+ Tcl_Panic("compression level should be between 0 (no compression)"
+ " and 9 (best compression) or -1 for default compression "
+ "level");
+ }
+ break;
+ case TCL_ZLIB_STREAM_INFLATE:
+ /*
+ * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too.
+ */
+
+ switch (format) {
+ case TCL_ZLIB_FORMAT_RAW:
+ wbits = WBITS_RAW;
+ 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;
+ break;
+ case TCL_ZLIB_FORMAT_AUTO:
+ wbits = WBITS_AUTODETECT;
+ break;
+ default:
+ Tcl_Panic("incorrect zlib data format, must be "
+ "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP, "
+ "TCL_ZLIB_FORMAT_RAW or TCL_ZLIB_FORMAT_AUTO");
+ }
+ break;
+ default:
+ Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
+ " TCL_ZLIB_STREAM_INFLATE");
+ }
+
+ zshPtr = ckalloc(sizeof(ZlibStreamHandle));
+ zshPtr->interp = interp;
+ zshPtr->mode = mode;
+ zshPtr->format = format;
+ zshPtr->level = level;
+ 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
+ */
+
+ 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, zshPtr->stream.adler);
+ goto error;
+ }
+
+ /*
+ * I could do all this in C, but this is easier.
+ */
+
+ if (interp != NULL) {
+ if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
+ goto error;
+ }
+ Tcl_DStringInit(&cmdname);
+ TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
+ TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
+ if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
+ &cmdinfo) == 1) {
+ 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;
+ }
+ Tcl_ResetResult(interp);
+
+ /*
+ * Create the command.
+ */
+
+ zshPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname),
+ ZlibStreamCmd, zshPtr, ZlibStreamCmdDelete);
+ Tcl_DStringFree(&cmdname);
+ if (zshPtr->cmd == NULL) {
+ goto error;
+ }
+ } else {
+ zshPtr->cmd = NULL;
+ }
+
+ /*
+ * Prepare the buffers for use.
+ */
+
+ zshPtr->inData = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(zshPtr->inData);
+ zshPtr->outData = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(zshPtr->outData);
+
+ zshPtr->outPos = 0;
+
+ /*
+ * Now set the variable pointed to by *zshandlePtr to the pointer to the
+ * zsh struct.
+ */
+
+ if (zshandlePtr) {
+ *zshandlePtr = (Tcl_ZlibStream) zshPtr;
+ }
+
+ return TCL_OK;
+
+ error:
+ if (zshPtr->compDictObj) {
+ Tcl_DecrRefCount(zshPtr->compDictObj);
+ }
+ if (zshPtr->gzHeaderPtr) {
+ ckfree(zshPtr->gzHeaderPtr);
+ }
+ ckfree(zshPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamCmdDelete --
+ *
+ * This is the delete command which Tcl invokes when a zlibstream command
+ * is deleted from the interpreter (on stream close, usually).
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ZlibStreamCmdDelete(
+ ClientData cd)
+{
+ ZlibStreamHandle *zshPtr = cd;
+
+ zshPtr->cmd = NULL;
+ ZlibStreamCleanup(zshPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamClose --
+ *
+ * This procedure must be called after (de)compression is done to ensure
+ * memory is freed and the command is deleted from the interpreter (if
+ * any).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamClose(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit. */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+
+ /*
+ * If the interp is set, deleting the command will trigger
+ * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call
+ * ZlibStreamCleanup directly.
+ */
+
+ if (zshPtr->interp && zshPtr->cmd) {
+ Tcl_DeleteCommandFromToken(zshPtr->interp, zshPtr->cmd);
+ } else {
+ ZlibStreamCleanup(zshPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamCleanup --
+ *
+ * This procedure is called by either Tcl_ZlibStreamClose or
+ * ZlibStreamCmdDelete to cleanup the stream context.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ZlibStreamCleanup(
+ ZlibStreamHandle *zshPtr)
+{
+ if (!zshPtr->streamEnd) {
+ if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ deflateEnd(&zshPtr->stream);
+ } else {
+ inflateEnd(&zshPtr->stream);
+ }
+ }
+
+ if (zshPtr->inData) {
+ Tcl_DecrRefCount(zshPtr->inData);
+ }
+ if (zshPtr->outData) {
+ Tcl_DecrRefCount(zshPtr->outData);
+ }
+ if (zshPtr->currentInput) {
+ Tcl_DecrRefCount(zshPtr->currentInput);
+ }
+ if (zshPtr->compDictObj) {
+ Tcl_DecrRefCount(zshPtr->compDictObj);
+ }
+ if (zshPtr->gzHeaderPtr) {
+ ckfree(zshPtr->gzHeaderPtr);
+ }
+
+ ckfree(zshPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamReset --
+ *
+ * This procedure will reinitialize an existing stream handle.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Any data left in the (de)compression buffer is lost.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamReset(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+ int e;
+
+ if (!zshPtr->streamEnd) {
+ if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ deflateEnd(&zshPtr->stream);
+ } else {
+ inflateEnd(&zshPtr->stream);
+ }
+ }
+ Tcl_SetByteArrayLength(zshPtr->inData, 0);
+ Tcl_SetByteArrayLength(zshPtr->outData, 0);
+ if (zshPtr->currentInput) {
+ Tcl_DecrRefCount(zshPtr->currentInput);
+ zshPtr->currentInput = NULL;
+ }
+
+ zshPtr->outPos = 0;
+ zshPtr->streamEnd = 0;
+ memset(&zshPtr->stream, 0, sizeof(z_stream));
+
+ /*
+ * No output buffer available yet.
+ */
+
+ 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, zshPtr->stream.adler);
+ /* TODO:cleanup */
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamGetCommandName --
+ *
+ * This procedure will return the command name associated with the
+ * stream.
+ *
+ * Results:
+ * A Tcl_Obj with the name of the Tcl command or NULL if no command is
+ * associated with the stream.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ZlibStreamGetCommandName(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+ Tcl_Obj *objPtr;
+
+ if (!zshPtr->interp) {
+ return NULL;
+ }
+
+ TclNewObj(objPtr);
+ Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr);
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamEof --
+ *
+ * This procedure This function returns 0 or 1 depending on the state of
+ * the (de)compressor. For decompression, eof is reached when the entire
+ * compressed stream has been decompressed. For compression, eof is
+ * reached when the stream has been flushed with TCL_ZLIB_FINALIZE.
+ *
+ * Results:
+ * Integer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamEof(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+
+ return zshPtr->streamEnd;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamChecksum --
+ *
+ * Return the checksum of the uncompressed data seen so far by the
+ * stream.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamChecksum(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+
+ return zshPtr->stream.adler;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * bytearray Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamPut(
+ Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
+ Tcl_Obj *data, /* Data to compress/decompress */
+ int flush) /* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
+ * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+ char *dataTmp = NULL;
+ int e, size, outSize;
+ Tcl_Obj *obj;
+
+ if (zshPtr->streamEnd) {
+ if (zshPtr->interp) {
+ Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+ "already past compressed stream end", -1));
+ Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ 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.
+ */
+
+ outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
+ zshPtr->stream.avail_out = outSize;
+ dataTmp = ckalloc(zshPtr->stream.avail_out);
+ zshPtr->stream.next_out = (Bytef *) dataTmp;
+
+ e = deflate(&zshPtr->stream, flush);
+ if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) {
+ if (outSize - zshPtr->stream.avail_out > 0) {
+ /*
+ * Output buffer too small.
+ */
+
+ obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
+ outSize - zshPtr->stream.avail_out);
+
+ /*
+ * Now append the compressed data to the outData list.
+ */
+
+ Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
+ }
+ if (outSize < 0xFFFF) {
+ outSize = 0xFFFF; /* There may be *lots* of data left to
+ * output... */
+ ckfree(dataTmp);
+ dataTmp = ckalloc(outSize);
+ }
+ zshPtr->stream.avail_out = outSize;
+ zshPtr->stream.next_out = (Bytef *) dataTmp;
+
+ 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.
+ */
+
+ if (outSize - zshPtr->stream.avail_out > 0) {
+ obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
+ outSize - zshPtr->stream.avail_out);
+
+ /*
+ * Now append the compressed data to the outData list.
+ */
+
+ Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
+ }
+
+ if (dataTmp) {
+ ckfree(dataTmp);
+ }
+ } else {
+ /*
+ * This is easy. Just append to the inData list.
+ */
+
+ Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);
+
+ /*
+ * and we'll need the flush parameter for the Inflate call.
+ */
+
+ zshPtr->flush = flush;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamGet --
+ *
+ * Retrieve data (now compressed or decompressed) from the stream into a
+ * bytearray Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamGet(
+ Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
+ Tcl_Obj *data, /* A place to append the data. */
+ int count) /* Number of bytes to grab as a maximum, you
+ * may get less! */
+{
+ ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+ int e, i, listLen, itemLen, dataPos = 0;
+ Tcl_Obj *itemObj;
+ unsigned char *dataPtr, *itemPtr;
+ int existing;
+
+ /*
+ * Getting beyond the of stream, just return empty string.
+ */
+
+ if (zshPtr->streamEnd) {
+ return TCL_OK;
+ }
+
+ (void) Tcl_GetByteArrayFromObj(data, &existing);
+
+ if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
+ if (count == -1) {
+ /*
+ * The only safe thing to do is restict to 65k. We might cause a
+ * panic for out of memory if we just kept growing the buffer.
+ */
+
+ count = MAX_BUFFER_SIZE;
+ }
+
+ /*
+ * Prepare the place to store the data.
+ */
+
+ dataPtr = Tcl_SetByteArrayLength(data, existing+count);
+ dataPtr += existing;
+
+ zshPtr->stream.next_out = dataPtr;
+ zshPtr->stream.avail_out = count;
+ if (zshPtr->stream.avail_in == 0) {
+ /*
+ * zlib will probably need more data to decompress.
+ */
+
+ if (zshPtr->currentInput) {
+ Tcl_DecrRefCount(zshPtr->currentInput);
+ zshPtr->currentInput = NULL;
+ }
+ Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
+ if (listLen > 0) {
+ /*
+ * There is more input available, get it from the list and
+ * 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;
+ zshPtr->stream.next_in = itemPtr;
+ zshPtr->stream.avail_in = itemLen;
+
+ /*
+ * And remove it from the list
+ */
+
+ Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
+ }
+ }
+
+ /*
+ * 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)
+ && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
+ /*
+ * State: We have not satisfied the request yet and there may be
+ * more to inflate.
+ */
+
+ if (zshPtr->stream.avail_in > 0) {
+ if (zshPtr->interp) {
+ 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;
+ }
+
+ if (zshPtr->currentInput) {
+ Tcl_DecrRefCount(zshPtr->currentInput);
+ zshPtr->currentInput = 0;
+ }
+
+ /*
+ * 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;
+ zshPtr->stream.next_in = itemPtr;
+ zshPtr->stream.avail_in = itemLen;
+
+ /*
+ * Remove it from the list.
+ */
+
+ Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
+ listLen--;
+
+ /*
+ * And call inflate again.
+ */
+
+ 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,
+ existing + count - zshPtr->stream.avail_out);
+ }
+ if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
+ Tcl_SetByteArrayLength(data, existing);
+ ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+ return TCL_ERROR;
+ }
+ if (e == Z_STREAM_END) {
+ zshPtr->streamEnd = 1;
+ if (zshPtr->currentInput) {
+ Tcl_DecrRefCount(zshPtr->currentInput);
+ zshPtr->currentInput = 0;
+ }
+ inflateEnd(&zshPtr->stream);
+ }
+ } else {
+ Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
+ if (count == -1) {
+ count = 0;
+ for (i=0; i<listLen; i++) {
+ Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
+ itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
+ if (i == 0) {
+ count += itemLen - zshPtr->outPos;
+ } else {
+ count += itemLen;
+ }
+ }
+ }
+
+ /*
+ * Prepare the place to store the data.
+ */
+
+ dataPtr = Tcl_SetByteArrayLength(data, existing + count);
+ dataPtr += existing;
+
+ while ((count > dataPos) &&
+ (Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
+ && (listLen > 0)) {
+ /*
+ * Get the next chunk off our list of chunks and grab the data out
+ * of it.
+ */
+
+ Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
+ itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
+ if (itemLen-zshPtr->outPos >= count-dataPos) {
+ unsigned len = count - dataPos;
+
+ memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
+ zshPtr->outPos += len;
+ dataPos += len;
+ if (zshPtr->outPos == itemLen) {
+ zshPtr->outPos = 0;
+ }
+ } else {
+ unsigned len = itemLen - zshPtr->outPos;
+
+ memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
+ dataPos += len;
+ zshPtr->outPos = 0;
+ }
+ if (zshPtr->outPos == 0) {
+ Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
+ listLen--;
+ }
+ }
+ Tcl_SetByteArrayLength(data, existing + dataPos);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibDeflate --
+ *
+ * Compress the contents of Tcl_Obj *data with compression level in
+ * output format, producing the compressed data in the interpreter
+ * result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibDeflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int level,
+ Tcl_Obj *gzipHeaderDictObj)
+{
+ int wbits = 0, inLen = 0, e = 0, extraSize = 0;
+ Byte *inData = NULL;
+ z_stream stream;
+ GzipHeader header;
+ gz_header *headerPtr = NULL;
+ Tcl_Obj *obj;
+
+ if (!interp) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h for
+ * details.
+ */
+
+ if (format == TCL_ZLIB_FORMAT_RAW) {
+ wbits = WBITS_RAW;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = WBITS_GZIP;
+
+ /*
+ * Need to allocate extra space for the gzip header and footer. The
+ * amount of space is (a bit less than) 32 bytes, plus a byte for each
+ * byte of string that we add. Note that over-allocation is not a
+ * problem. [Bug 2419061]
+ */
+
+ extraSize = 32;
+ if (gzipHeaderDictObj) {
+ headerPtr = &header.header;
+ memset(headerPtr, 0, sizeof(gz_header));
+ if (GenerateHeader(interp, gzipHeaderDictObj, &header,
+ &extraSize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
+ wbits = WBITS_ZLIB;
+ } else {
+ Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
+ "TCL_ZLIB_FORMAT_GZIP or TCL_ZLIB_FORMAT_ZLIB");
+ }
+
+ if (level < -1 || level > 9) {
+ Tcl_Panic("compression level should be between 0 (uncompressed) and "
+ "9 (best compression) or -1 for default compression level");
+ }
+
+ /*
+ * 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.
+ */
+
+ inData = Tcl_GetByteArrayFromObj(data, &inLen);
+ memset(&stream, 0, sizeof(z_stream));
+ stream.avail_in = (uInt) inLen;
+ stream.next_in = inData;
+
+ /*
+ * No output buffer available yet, will alloc after deflateInit2.
+ */
+
+ e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
+ Z_DEFAULT_STRATEGY);
+ if (e != Z_OK) {
+ goto error;
+ }
+
+ if (headerPtr != NULL) {
+ e = deflateSetHeader(&stream, headerPtr);
+ if (e != Z_OK) {
+ goto error;
+ }
+ }
+
+ /*
+ * Allocate the output buffer from the value of deflateBound(). This is
+ * probably too much space. Before returning to the caller, we will reduce
+ * it back to the actual compressed size.
+ */
+
+ stream.avail_out = deflateBound(&stream, inLen) + extraSize;
+ stream.next_out = Tcl_SetByteArrayLength(obj, stream.avail_out);
+
+ /*
+ * Perform the compression, Z_FINISH means do it in one go.
+ */
+
+ e = deflate(&stream, Z_FINISH);
+
+ if (e != Z_STREAM_END) {
+ e = deflateEnd(&stream);
+
+ /*
+ * deflateEnd() returns Z_OK when there are bytes left to compress, at
+ * this point we consider that an error, although we could continue by
+ * allocating more memory and calling deflate() again.
+ */
+
+ if (e == Z_OK) {
+ e = Z_BUF_ERROR;
+ }
+ } else {
+ e = deflateEnd(&stream);
+ }
+
+ if (e != Z_OK) {
+ goto error;
+ }
+
+ /*
+ * Reduce the bytearray length to the actual data length produced by
+ * deflate.
+ */
+
+ Tcl_SetByteArrayLength(obj, stream.total_out);
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+
+ error:
+ ConvertError(interp, e, stream.adler);
+ TclDecrRefCount(obj);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibInflate --
+ *
+ * Decompress data in an object into the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibInflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int bufferSize,
+ Tcl_Obj *gzipHeaderDictObj)
+{
+ int wbits = 0, inLen = 0, e = 0, newBufferSize;
+ Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
+ z_stream stream;
+ gz_header header, *headerPtr = NULL;
+ Tcl_Obj *obj;
+ char *nameBuf = NULL, *commentBuf = NULL;
+
+ if (!interp) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h for
+ * details.
+ */
+
+ switch (format) {
+ case TCL_ZLIB_FORMAT_RAW:
+ wbits = WBITS_RAW;
+ gzipHeaderDictObj = NULL;
+ break;
+ case TCL_ZLIB_FORMAT_ZLIB:
+ wbits = WBITS_ZLIB;
+ gzipHeaderDictObj = NULL;
+ break;
+ case TCL_ZLIB_FORMAT_GZIP:
+ wbits = WBITS_GZIP;
+ break;
+ case TCL_ZLIB_FORMAT_AUTO:
+ wbits = WBITS_AUTODETECT;
+ break;
+ default:
+ Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
+ "TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
+ "TCL_ZLIB_FORMAT_AUTO");
+ }
+
+ if (gzipHeaderDictObj) {
+ headerPtr = &header;
+ memset(headerPtr, 0, sizeof(gz_header));
+ nameBuf = ckalloc(MAXPATHLEN);
+ header.name = (Bytef *) nameBuf;
+ header.name_max = MAXPATHLEN - 1;
+ commentBuf = ckalloc(MAX_COMMENT_LEN);
+ header.comment = (Bytef *) commentBuf;
+ header.comm_max = MAX_COMMENT_LEN - 1;
+ }
+
+ inData = Tcl_GetByteArrayFromObj(data, &inLen);
+ if (bufferSize < 1) {
+ /*
+ * Start with a buffer (up to) 3 times the size of the input data.
+ */
+
+ if (inLen < 32*1024*1024) {
+ bufferSize = 3*inLen;
+ } else if (inLen < 256*1024*1024) {
+ bufferSize = 2*inLen;
+ } else {
+ bufferSize = inLen;
+ }
+ }
+
+ 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"
+ * input (but ignore it!) */
+ stream.next_in = inData;
+ stream.avail_out = bufferSize;
+ stream.next_out = outData;
+
+ /*
+ * Initialize zlib for decompression.
+ */
+
+ e = inflateInit2(&stream, wbits);
+ if (e != Z_OK) {
+ goto error;
+ }
+ if (headerPtr) {
+ e = inflateGetHeader(&stream, headerPtr);
+ if (e != Z_OK) {
+ goto error;
+ }
+ }
+
+ /*
+ * Start the decompression cycle.
+ */
+
+ while (1) {
+ e = inflate(&stream, Z_FINISH);
+ if (e != Z_BUF_ERROR) {
+ break;
+ }
+
+ /*
+ * Not enough room in the output buffer. Increase it by five times the
+ * bytes still in the input buffer. (Because 3 times didn't do the
+ * trick before, 5 times is what we do next.) Further optimization
+ * should be done by the user, specify the decompressed size!
+ */
+
+ if ((stream.avail_in == 0) && (stream.avail_out > 0)) {
+ e = Z_STREAM_ERROR;
+ goto error;
+ }
+ newBufferSize = bufferSize + 5 * stream.avail_in;
+ if (newBufferSize == bufferSize) {
+ newBufferSize = bufferSize+1000;
+ }
+ newOutData = Tcl_SetByteArrayLength(obj, newBufferSize);
+
+ /*
+ * Set next out to the same offset in the new location.
+ */
+
+ stream.next_out = newOutData + stream.total_out;
+
+ /*
+ * And increase avail_out with the number of new bytes allocated.
+ */
+
+ stream.avail_out += newBufferSize - bufferSize;
+ outData = newOutData;
+ bufferSize = newBufferSize;
+ }
+
+ if (e != Z_STREAM_END) {
+ inflateEnd(&stream);
+ goto error;
+ }
+
+ e = inflateEnd(&stream);
+ if (e != Z_OK) {
+ goto error;
+ }
+
+ /*
+ * Reduce the BA length to the actual data length produced by deflate.
+ */
+
+ Tcl_SetByteArrayLength(obj, stream.total_out);
+ if (headerPtr != NULL) {
+ ExtractHeader(&header, gzipHeaderDictObj);
+ SetValue(gzipHeaderDictObj, "size",
+ Tcl_NewLongObj((long) stream.total_out));
+ ckfree(nameBuf);
+ ckfree(commentBuf);
+ }
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+
+ error:
+ TclDecrRefCount(obj);
+ ConvertError(interp, e, stream.adler);
+ if (nameBuf) {
+ ckfree(nameBuf);
+ }
+ if (commentBuf) {
+ ckfree(commentBuf);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
+ *
+ * Access to the checksumming engines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned int
+Tcl_ZlibCRC32(
+ unsigned int crc,
+ const unsigned char *buf,
+ int len)
+{
+ /* Nothing much to do, just wrap the crc32(). */
+ return crc32(crc, (Bytef *) buf, (unsigned) len);
+}
+
+unsigned int
+Tcl_ZlibAdler32(
+ unsigned int adler,
+ const unsigned char *buf,
+ int len)
+{
+ return adler32(adler, (Bytef *) buf, (unsigned) len);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibCmd --
+ *
+ * Implementation of the [zlib] command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibCmd(
+ ClientData notUsed,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int command, dlen, i, option, level = -1;
+ unsigned start, buffersize = 0;
+ Byte *data;
+ Tcl_Obj *headerDictObj;
+ const char *extraInfoStr = NULL;
+ static const char *const commands[] = {
+ "adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
+ "gzip", "inflate", "push", "stream",
+ NULL
+ };
+ enum zlibCommands {
+ CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
+ CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
+ &command) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum zlibCommands) command) {
+ case CMD_ADLER: /* adler32 str ?startvalue?
+ * -> checksum */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
+ return TCL_ERROR;
+ }
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc < 4) {
+ start = Tcl_ZlibAdler32(0, NULL, 0);
+ }
+ data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibAdler32(start, data, dlen)));
+ return TCL_OK;
+ case CMD_CRC: /* crc32 str ?startvalue?
+ * -> checksum */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
+ return TCL_ERROR;
+ }
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc < 4) {
+ start = Tcl_ZlibCRC32(0, NULL, 0);
+ }
+ data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibCRC32(start, data, dlen)));
+ return TCL_OK;
+ case CMD_DEFLATE: /* deflate data ?level?
+ * -> rawCompressedData */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
+ return TCL_ERROR;
+ }
+ if (objc > 3) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (level < 0 || level > 9) {
+ goto badLevel;
+ }
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level,
+ NULL);
+ case CMD_COMPRESS: /* compress data ?level?
+ * -> zlibCompressedData */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
+ return TCL_ERROR;
+ }
+ if (objc > 3) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (level < 0 || level > 9) {
+ goto badLevel;
+ }
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level,
+ 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;
+ }
+ for (i=3 ; i<objc ; i+=2) {
+ static const char *const gzipopts[] = {
+ "-header", "-level", NULL
+ };
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], gzipopts, "option", 0,
+ &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (option) {
+ case 0:
+ headerDictObj = objv[i+1];
+ break;
+ case 1:
+ if (Tcl_GetIntFromObj(interp, objv[i+1],
+ &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (level < 0 || level > 9) {
+ extraInfoStr = "\n (in -level option)";
+ goto badLevel;
+ }
+ break;
+ }
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level,
+ headerDictObj);
+ case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize?
+ * -> decompressedData */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
+ return TCL_ERROR;
+ }
+ if (objc > 3) {
+ if (Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
+ || buffersize > MAX_BUFFER_SIZE) {
+ goto badBuffer;
+ }
+ }
+ return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
+ buffersize, NULL);
+ case CMD_DECOMPRESS: /* decompress zlibcomprdata \
+ * ?bufferSize?
+ * -> decompressedData */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
+ return TCL_ERROR;
+ }
+ if (objc > 3) {
+ if (Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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?
+ * -> decompressedData */
+ Tcl_Obj *headerVarObj;
+
+ if (objc < 3 || objc > 5 || ((objc & 1) == 0)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?");
+ return TCL_ERROR;
+ }
+ headerDictObj = headerVarObj = NULL;
+ for (i=3 ; i<objc ; i+=2) {
+ static const char *const gunzipopts[] = {
+ "-buffersize", "-headerVar", NULL
+ };
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
+ &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (option) {
+ case 0:
+ if (Tcl_GetIntFromObj(interp, objv[i+1],
+ (int *) &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
+ || buffersize > MAX_BUFFER_SIZE) {
+ goto badBuffer;
+ }
+ break;
+ case 1:
+ headerVarObj = objv[i+1];
+ headerDictObj = Tcl_NewObj();
+ break;
+ }
+ }
+ if (Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
+ buffersize, headerDictObj) != TCL_OK) {
+ if (headerDictObj) {
+ TclDecrRefCount(headerDictObj);
+ }
+ return TCL_ERROR;
+ }
+ if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL,
+ headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+ case CMD_STREAM: /* stream deflate/inflate/...gunzip \
+ * ?options...?
+ * -> handleCmd */
+ return ZlibStreamSubcmd(interp, objc, objv);
+ case CMD_PUSH: /* push mode channel options...
+ * -> channel */
+ return ZlibPushSubcmd(interp, objc, objv);
+ };
+
+ 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.
+ */
+
+ 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];
+ }
+
+ /*
+ * 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 (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 (++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;
+ }
+ switch ((enum pushOptions) option) {
+ case poHeader:
+ headerObj = objv[i];
+ if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
+ goto genericOptionError;
+ }
+ 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, limit, chan,
+ headerObj, compDictObj) == NULL) {
+ return TCL_ERROR;
+ }
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamCmd --
+ *
+ * Implementation of the commands returned by [zlib stream].
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibStreamCmd(
+ ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_ZlibStream zstream = cd;
+ int command, count, code;
+ Tcl_Obj *obj;
+ static const char *const cmds[] = {
+ "add", "checksum", "close", "eof", "finalize", "flush",
+ "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_header, zs_put, zs_reset
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0,
+ &command) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum zlibStreamCommands) command) {
+ case zs_add: /* $strm add ?$flushopt? $data */
+ return ZlibStreamAddCmd(zstream, interp, objc, objv);
+ case zs_header: /* $strm header */
+ return ZlibStreamHeaderCmd(zstream, interp, objc, objv);
+ case zs_put: /* $strm put ?$flushopt? $data */
+ return ZlibStreamPutCmd(zstream, interp, objc, objv);
+
+ case zs_get: /* $strm get ?count? */
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?count?");
+ return TCL_ERROR;
+ }
+
+ count = -1;
+ if (objc >= 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ 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;
+ }
+ 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;
+ }
+ 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.
+ */
+
+ 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);
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibStreamClose(zstream);
+ case zs_eof: /* $strm eof */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ 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_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ (uLong) Tcl_ZlibStreamChecksum(zstream)));
+ return TCL_OK;
+ case zs_reset: /* $strm reset */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibStreamReset(zstream);
+ }
+
+ 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
+ZlibTransformClose(
+ ClientData instanceData,
+ Tcl_Interp *interp)
+{
+ ZlibChannelData *cd = instanceData;
+ int e, result = TCL_OK;
+
+ /*
+ * 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 {
+ cd->outStream.next_out = (Bytef *) cd->outBuffer;
+ cd->outStream.avail_out = (unsigned) cd->outAllocated;
+ e = deflate(&cd->outStream, Z_FINISH);
+ if (e != Z_OK && e != Z_STREAM_END) {
+ /* TODO: is this the right way to do errors on close? */
+ if (!TclInThreadExit()) {
+ ConvertError(interp, e, cd->outStream.adler);
+ }
+ result = TCL_ERROR;
+ break;
+ }
+ if (cd->outStream.avail_out != (unsigned) cd->outAllocated) {
+ if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
+ cd->outAllocated - cd->outStream.avail_out) < 0) {
+ /* 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() && 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->outStream);
+ } else {
+ e = inflateEnd(&cd->inStream);
+ }
+
+ /*
+ * Release all memory.
+ */
+
+ Tcl_DStringFree(&cd->decompressed);
+
+ if (cd->inBuffer) {
+ ckfree(cd->inBuffer);
+ cd->inBuffer = NULL;
+ }
+ if (cd->outBuffer) {
+ ckfree(cd->outBuffer);
+ cd->outBuffer = NULL;
+ }
+ ckfree(cd);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformInput --
+ *
+ * Reader filter that does decompression.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformInput(
+ ClientData instanceData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
+{
+ ZlibChannelData *cd = instanceData;
+ Tcl_DriverInputProc *inProc =
+ Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
+ int readBytes, gotBytes, copied;
+
+ if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
+ errorCodePtr);
+ }
+
+ gotBytes = 0;
+ while (toRead > 0) {
+ /*
+ * Loop until the request is satisfied (or no data available from
+ * below, possibly EOF).
+ */
+
+ copied = ResultCopy(cd, buf, toRead);
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
+
+ if (toRead == 0) {
+ return gotBytes;
+ }
+
+ /*
+ * The buffer is exhausted, but the caller wants even more. We now
+ * have to go to the underlying channel, get more bytes and then
+ * transform them for delivery. We may not get what we want (full EOF
+ * or temporarily out of data).
+ *
+ * Length (cd->decompressed) == 0, toRead > 0 here.
+ *
+ * The zlib transform allows us to read at most one character from the
+ * underlying channel to properly identify Z_STREAM_END without
+ * reading over the border.
+ */
+
+ readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);
+
+ /*
+ * 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.
+ */
+
+ 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) {
+ /*
+ * 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.
+ */
+
+ 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(
+ ClientData instanceData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
+{
+ ZlibChannelData *cd = instanceData;
+ 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,
+ errorCodePtr);
+ }
+
+ cd->outStream.next_in = (Bytef *) buf;
+ cd->outStream.avail_in = toWrite;
+ do {
+ cd->outStream.next_out = (Bytef *) cd->outBuffer;
+ cd->outStream.avail_out = cd->outAllocated;
+
+ e = deflate(&cd->outStream, Z_NO_FLUSH);
+ produced = cd->outAllocated - cd->outStream.avail_out;
+
+ if (e == Z_OK && produced > 0) {
+ if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
+ *errorCodePtr = Tcl_GetErrno();
+ return -1;
+ }
+ }
+ } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
+
+ if (e == Z_OK) {
+ return toWrite - cd->outStream.avail_in;
+ }
+
+ 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 */
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ const char *value)
+{
+ ZlibChannelData *cd = instanceData;
+ Tcl_DriverSetOptionProc *setOptionProc =
+ Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
+ 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 (optionName && (strcmp(optionName, "-dictionary") == 0)
+ && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
+ Tcl_Obj *compDictObj;
+ int code;
+
+ TclNewStringObj(compDictObj, value, strlen(value));
+ Tcl_IncrRefCount(compDictObj);
+ (void) Tcl_GetByteArrayFromObj(compDictObj, NULL);
+ if (cd->compDictObj) {
+ TclDecrRefCount(cd->compDictObj);
+ }
+ 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;
+ }
+ }
+ return TCL_OK;
+ }
+
+ if (haveFlushOpt) {
+ if (optionName && strcmp(optionName, "-flush") == 0) {
+ int flushType;
+
+ 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;
+ }
+
+ /*
+ * 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,
+ cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "problem flushing channel: %s",
+ Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ }
+ 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) {
+ 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(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ Tcl_DString *dsPtr)
+{
+ ZlibChannelData *cd = instanceData;
+ Tcl_DriverGetOptionProc *getOptionProc =
+ Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
+ 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
+ * or CRC32 algorithm according to the format) given the data that has
+ * been processed so far.
+ */
+
+ if (optionName == NULL || strcmp(optionName, "-checksum") == 0) {
+ uLong crc;
+ char buf[12];
+
+ if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ crc = cd->outStream.adler;
+ } else {
+ crc = cd->inStream.adler;
+ }
+
+ sprintf(buf, "%lu", crc);
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-checksum");
+ Tcl_DStringAppendElement(dsPtr, buf);
+ } else {
+ Tcl_DStringAppend(dsPtr, buf, -1);
+ return TCL_OK;
+ }
+ }
+
+ 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.
+ */
+
+ if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
+ (strcmp(optionName, "-header") == 0))) {
+ Tcl_Obj *tmpObj = Tcl_NewObj();
+
+ ExtractHeader(&cd->inHeader.header, tmpObj);
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-header");
+ Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
+ Tcl_DecrRefCount(tmpObj);
+ } else {
+ TclDStringAppendObj(dsPtr, tmpObj);
+ Tcl_DecrRefCount(tmpObj);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Now we do the standard processing of the stream we wrapped.
+ */
+
+ if (getOptionProc) {
+ return getOptionProc(Tcl_GetChannelInstanceData(cd->parent),
+ interp, optionName, dsPtr);
+ }
+ if (optionName == NULL) {
+ return TCL_OK;
+ }
+ 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(
+ ClientData instanceData,
+ int mask)
+{
+ ZlibChannelData *cd = instanceData;
+ Tcl_DriverWatchProc *watchProc;
+
+ /*
+ * This code is based on the code in tclIORTrans.c
+ */
+
+ watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
+ watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
+
+ 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);
+ }
+}
+
+static int
+ZlibTransformEventHandler(
+ ClientData instanceData,
+ int interestMask)
+{
+ ZlibChannelData *cd = instanceData;
+
+ ZlibTransformEventTimerKill(cd);
+ return interestMask;
+}
+
+static inline void
+ZlibTransformEventTimerKill(
+ ZlibChannelData *cd)
+{
+ if (cd->timer != NULL) {
+ Tcl_DeleteTimerHandler(cd->timer);
+ cd->timer = NULL;
+ }
+}
+
+static void
+ZlibTransformTimerRun(
+ ClientData clientData)
+{
+ ZlibChannelData *cd = clientData;
+
+ cd->timer = NULL;
+ Tcl_NotifyChannel(cd->chan, TCL_READABLE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * The stacked channel, or NULL if there was an error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+ZlibStackChannelTransform(
+ Tcl_Interp *interp, /* Where to write error messages. */
+ int mode, /* Whether this is a compressing transform
+ * (TCL_ZLIB_STREAM_DEFLATE) or a
+ * decompressing transform
+ * (TCL_ZLIB_STREAM_INFLATE). Note that
+ * compressing transforms require that the
+ * channel is writable, and decompressing
+ * transforms require that the channel is
+ * readable. */
+ int format, /* One of the TCL_ZLIB_FORMAT_* values that
+ * indicates what compressed format to allow.
+ * TCL_ZLIB_FORMAT_AUTO is only supported for
+ * 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
+ * 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 = ckalloc(sizeof(ZlibChannelData));
+ Tcl_Channel chan;
+ int wbits = 0;
+ int e;
+
+ if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
+ Tcl_Panic("unknown mode: %d", mode);
+ }
+
+ 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) {
+ cd->flags |= OUT_HEADER;
+ if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
+ NULL) != TCL_OK) {
+ goto error;
+ }
+ }
+ } else {
+ cd->flags |= IN_HEADER;
+ cd->inHeader.header.name = (Bytef *)
+ &cd->inHeader.nativeFilenameBuf;
+ cd->inHeader.header.name_max = MAXPATHLEN - 1;
+ cd->inHeader.header.comment = (Bytef *)
+ &cd->inHeader.nativeCommentBuf;
+ cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1;
+ }
+ }
+
+ 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) {
+ wbits = WBITS_ZLIB;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = WBITS_GZIP;
+ } else if (format == TCL_ZLIB_FORMAT_AUTO) {
+ wbits = WBITS_AUTODETECT;
+ } else {
+ Tcl_Panic("bad format: %d", format);
+ }
+
+ /*
+ * Initialize input inflater or the output deflater.
+ */
+
+ if (mode == TCL_ZLIB_STREAM_INFLATE) {
+ e = inflateInit2(&cd->inStream, wbits);
+ if (e != Z_OK) {
+ goto error;
+ }
+ cd->inAllocated = DEFAULT_BUFFER_SIZE;
+ cd->inBuffer = ckalloc(cd->inAllocated);
+ if (cd->flags & IN_HEADER) {
+ e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
+ if (e != Z_OK) {
+ 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);
+ if (e != Z_OK) {
+ goto error;
+ }
+ cd->outAllocated = DEFAULT_BUFFER_SIZE;
+ cd->outBuffer = ckalloc(cd->outAllocated);
+ if (cd->flags & OUT_HEADER) {
+ e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
+ if (e != Z_OK) {
+ 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) {
+ goto error;
+ }
+ cd->chan = chan;
+ cd->parent = Tcl_GetStackedChannel(chan);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
+ return chan;
+
+ error:
+ if (cd->inBuffer) {
+ ckfree(cd->inBuffer);
+ inflateEnd(&cd->inStream);
+ }
+ if (cd->outBuffer) {
+ ckfree(cd->outBuffer);
+ deflateEnd(&cd->outStream);
+ }
+ 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.
+ *----------------------------------------------------------------------
+ */
+
+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
+ * commands.
+ */
+
+ Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}");
+
+ /*
+ * Create the public scripted interface to this file's functionality.
+ */
+
+ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
+
+ /*
+ * 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, "iso8859-1");
+
+ /*
+ * Formally provide the package as a Tcl built-in.
+ */
+
+ return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Stubs used when a suitable zlib installation was not found during
+ * configure.
+ *----------------------------------------------------------------------
+ */
+
+#else /* !HAVE_ZLIB */
+int
+Tcl_ZlibStreamInit(
+ Tcl_Interp *interp,
+ int mode,
+ int format,
+ int level,
+ Tcl_Obj *dictObj,
+ Tcl_ZlibStream *zshandle)
+{
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
+ return TCL_ERROR;
+}
+
+int
+Tcl_ZlibStreamClose(
+ Tcl_ZlibStream zshandle)
+{
+ return TCL_OK;
+}
+
+int
+Tcl_ZlibStreamReset(
+ Tcl_ZlibStream zshandle)
+{
+ return TCL_OK;
+}
+
+Tcl_Obj *
+Tcl_ZlibStreamGetCommandName(
+ Tcl_ZlibStream zshandle)
+{
+ return NULL;
+}
+
+int
+Tcl_ZlibStreamEof(
+ Tcl_ZlibStream zshandle)
+{
+ return 1;
+}
+
+int
+Tcl_ZlibStreamChecksum(
+ Tcl_ZlibStream zshandle)
+{
+ return 0;
+}
+
+int
+Tcl_ZlibStreamPut(
+ Tcl_ZlibStream zshandle,
+ Tcl_Obj *data,
+ int flush)
+{
+ return TCL_OK;
+}
+
+int
+Tcl_ZlibStreamGet(
+ Tcl_ZlibStream zshandle,
+ Tcl_Obj *data,
+ int count)
+{
+ return TCL_OK;
+}
+
+int
+Tcl_ZlibDeflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int level,
+ Tcl_Obj *gzipHeaderDictObj)
+{
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
+ return TCL_ERROR;
+}
+
+int
+Tcl_ZlibInflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int bufferSize,
+ Tcl_Obj *gzipHeaderDictObj)
+{
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
+ return TCL_ERROR;
+}
+
+unsigned int
+Tcl_ZlibCRC32(
+ unsigned int crc,
+ const char *buf,
+ int len)
+{
+ return 0;
+}
+
+unsigned int
+Tcl_ZlibAdler32(
+ unsigned int adler,
+ const char *buf,
+ int len)
+{
+ return 0;
+}
+
+void
+Tcl_ZlibStreamSetCompressionDictionary(
+ Tcl_ZlibStream zshandle,
+ Tcl_Obj *compressionDictionaryObj)
+{
+ /* Do nothing. */
+}
+#endif /* HAVE_ZLIB */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tommath.h b/generic/tommath.h
index 1eabf11..028a84d 100644
--- a/generic/tommath.h
+++ b/generic/tommath.h
@@ -1,608 +1 @@
-/* LibTomMath, multiple-precision integer library -- Tom St Denis
- *
- * LibTomMath is a library that provides multiple-precision
- * integer arithmetic as well as number theoretic functionality.
- *
- * The library was designed directly after the MPI library by
- * Michael Fromberger but has been written from scratch with
- * additional optimizations in place.
- *
- * The library is free for all purposes without any express
- * guarantee it works.
- *
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
- */
-#ifndef BN_H_
-#define BN_H_
-
-#ifdef TCL_TOMMATH
-#include <tclTomMath.h>
-#endif
-#ifndef TOMMATH_STORAGE_CLASS
-#define TOMMATH_STORAGE_CLASS extern
-#endif
-
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <limits.h>
-
-#include <tommath_class.h>
-
-#ifndef MIN
- #define MIN(x,y) ((x)<(y)?(x):(y))
-#endif
-
-#ifndef MAX
- #define MAX(x,y) ((x)>(y)?(x):(y))
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-
-/* C++ compilers don't like assigning void * to mp_digit * */
-#define OPT_CAST(x) (x *)
-
-#else
-
-/* C on the other hand doesn't care */
-#define OPT_CAST(x)
-
-#endif
-
-
-/* detect 64-bit mode if possible */
-#if defined(__x86_64__)
- #if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
- #define MP_64BIT
- #endif
-#endif
-
-/* some default configurations.
- *
- * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
- * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
- *
- * At the very least a mp_digit must be able to hold 7 bits
- * [any size beyond that is ok provided it doesn't overflow the data type]
- */
-#ifdef MP_8BIT
-#ifndef MP_DIGIT_DECLARED
- typedef unsigned char mp_digit;
-#define MP_DIGIT_DECLARED
-#endif
- typedef unsigned short mp_word;
-#elif defined(MP_16BIT)
-#ifndef MP_DIGIT_DECLARED
- typedef unsigned short mp_digit;
-#define MP_DIGIT_DECLARED
-#endif
- typedef unsigned long mp_word;
-#elif defined(MP_64BIT)
- /* for GCC only on supported platforms */
-#ifndef CRYPT
- typedef unsigned long long ulong64;
- typedef signed long long long64;
-#endif
-
-#ifndef MP_DIGIT_DECLARED
- typedef unsigned long mp_digit;
-#define MP_DIGIT_DECLARED
-#endif
- typedef unsigned long mp_word __attribute__ ((mode(TI)));
-
- #define DIGIT_BIT 60
-#else
- /* this is the default case, 28-bit digits */
-
- /* this is to make porting into LibTomCrypt easier :-) */
-#ifndef CRYPT
- #if defined(_MSC_VER) || defined(__BORLANDC__)
- typedef unsigned __int64 ulong64;
- typedef signed __int64 long64;
- #else
- typedef unsigned long long ulong64;
- typedef signed long long long64;
- #endif
-#endif
-
-#ifndef MP_DIGIT_DECLARED
- typedef unsigned long mp_digit;
-#define MP_DIGIT_DECLARED
-#endif
- typedef ulong64 mp_word;
-
-#ifdef MP_31BIT
- /* this is an extension that uses 31-bit digits */
- #define DIGIT_BIT 31
-#else
- /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
- #define DIGIT_BIT 28
- #define MP_28BIT
-#endif
-#endif
-
-/* define heap macros */
-#ifndef CRYPT
- /* default to libc stuff */
- #ifndef XMALLOC
- #define XMALLOC malloc
- #define XFREE free
- #define XREALLOC realloc
- #define XCALLOC calloc
- #else
- /* prototypes for our heap functions */
- extern void *XMALLOC(size_t n);
- extern void *XREALLOC(void *p, size_t n);
- extern void *XCALLOC(size_t n, size_t s);
- extern void XFREE(void *p);
- #endif
-#endif
-
-
-/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
-#ifndef DIGIT_BIT
- #define DIGIT_BIT ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
-#endif
-
-#define MP_DIGIT_BIT DIGIT_BIT
-#define MP_MASK ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
-#define MP_DIGIT_MAX MP_MASK
-
-/* equalities */
-#define MP_LT -1 /* less than */
-#define MP_EQ 0 /* equal to */
-#define MP_GT 1 /* greater than */
-
-#define MP_ZPOS 0 /* positive integer */
-#define MP_NEG 1 /* negative */
-
-#define MP_OKAY 0 /* ok result */
-#define MP_MEM -2 /* out of mem */
-#define MP_VAL -3 /* invalid input */
-#define MP_RANGE MP_VAL
-
-#define MP_YES 1 /* yes response */
-#define MP_NO 0 /* no response */
-
-/* Primality generation flags */
-#define LTM_PRIME_BBS 0x0001 /* BBS style prime */
-#define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */
-#define LTM_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */
-
-typedef int mp_err;
-
-/* you'll have to tune these... */
-extern int KARATSUBA_MUL_CUTOFF,
- KARATSUBA_SQR_CUTOFF,
- TOOM_MUL_CUTOFF,
- TOOM_SQR_CUTOFF;
-
-/* define this to use lower memory usage routines (exptmods mostly) */
-/* #define MP_LOW_MEM */
-
-/* default precision */
-#ifndef MP_PREC
- #ifndef MP_LOW_MEM
- #define MP_PREC 32 /* default digits of precision */
- #else
- #define MP_PREC 8 /* default digits of precision */
- #endif
-#endif
-
-/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
-#define MP_WARRAY (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
-
-/* the infamous mp_int structure */
-#ifndef MP_INT_DECLARED
-#define MP_INT_DECLARED
-typedef struct mp_int mp_int;
-#endif
-struct mp_int {
- int used, alloc, sign;
- mp_digit *dp;
-};
-
-/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
-typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
-
-
-#define USED(m) ((m)->used)
-#define DIGIT(m,k) ((m)->dp[(k)])
-#define SIGN(m) ((m)->sign)
-
-/* error code to char* string */
-TOMMATH_STORAGE_CLASS char *mp_error_to_string(int code);
-
-/* ---> init and deinit bignum functions <--- */
-/* init a bignum */
-TOMMATH_STORAGE_CLASS int mp_init(mp_int *a);
-
-/* free a bignum */
-TOMMATH_STORAGE_CLASS void mp_clear(mp_int *a);
-
-/* init a null terminated series of arguments */
-TOMMATH_STORAGE_CLASS int mp_init_multi(mp_int *mp, ...);
-
-/* clear a null terminated series of arguments */
-TOMMATH_STORAGE_CLASS void mp_clear_multi(mp_int *mp, ...);
-
-/* exchange two ints */
-TOMMATH_STORAGE_CLASS void mp_exch(mp_int *a, mp_int *b);
-
-/* shrink ram required for a bignum */
-TOMMATH_STORAGE_CLASS int mp_shrink(mp_int *a);
-
-/* grow an int to a given size */
-TOMMATH_STORAGE_CLASS int mp_grow(mp_int *a, int size);
-
-/* init to a given number of digits */
-TOMMATH_STORAGE_CLASS int mp_init_size(mp_int *a, int size);
-
-/* ---> Basic Manipulations <--- */
-#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
-#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
-#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
-
-/* set to zero */
-TOMMATH_STORAGE_CLASS void mp_zero(mp_int *a);
-
-/* set to a digit */
-TOMMATH_STORAGE_CLASS void mp_set(mp_int *a, mp_digit b);
-
-/* set a 32-bit const */
-TOMMATH_STORAGE_CLASS int mp_set_int(mp_int *a, unsigned long b);
-
-/* get a 32-bit value */
-unsigned long mp_get_int(mp_int * a);
-
-/* initialize and set a digit */
-TOMMATH_STORAGE_CLASS int mp_init_set (mp_int * a, mp_digit b);
-
-/* initialize and set 32-bit value */
-TOMMATH_STORAGE_CLASS int mp_init_set_int (mp_int * a, unsigned long b);
-
-/* copy, b = a */
-TOMMATH_STORAGE_CLASS int mp_copy(mp_int *a, mp_int *b);
-
-/* inits and copies, a = b */
-TOMMATH_STORAGE_CLASS int mp_init_copy(mp_int *a, mp_int *b);
-
-/* trim unused digits */
-TOMMATH_STORAGE_CLASS void mp_clamp(mp_int *a);
-
-/* ---> digit manipulation <--- */
-
-/* right shift by "b" digits */
-TOMMATH_STORAGE_CLASS void mp_rshd(mp_int *a, int b);
-
-/* left shift by "b" digits */
-TOMMATH_STORAGE_CLASS int mp_lshd(mp_int *a, int b);
-
-/* c = a / 2**b */
-TOMMATH_STORAGE_CLASS int mp_div_2d(mp_int *a, int b, mp_int *c, mp_int *d);
-
-/* b = a/2 */
-TOMMATH_STORAGE_CLASS int mp_div_2(mp_int *a, mp_int *b);
-
-/* c = a * 2**b */
-TOMMATH_STORAGE_CLASS int mp_mul_2d(mp_int *a, int b, mp_int *c);
-
-/* b = a*2 */
-TOMMATH_STORAGE_CLASS int mp_mul_2(mp_int *a, mp_int *b);
-
-/* c = a mod 2**d */
-TOMMATH_STORAGE_CLASS int mp_mod_2d(mp_int *a, int b, mp_int *c);
-
-/* computes a = 2**b */
-TOMMATH_STORAGE_CLASS int mp_2expt(mp_int *a, int b);
-
-/* Counts the number of lsbs which are zero before the first zero bit */
-TOMMATH_STORAGE_CLASS int mp_cnt_lsb(mp_int *a);
-
-/* I Love Earth! */
-
-/* makes a pseudo-random int of a given size */
-TOMMATH_STORAGE_CLASS int mp_rand(mp_int *a, int digits);
-
-/* ---> binary operations <--- */
-/* c = a XOR b */
-TOMMATH_STORAGE_CLASS int mp_xor(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = a OR b */
-TOMMATH_STORAGE_CLASS int mp_or(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = a AND b */
-TOMMATH_STORAGE_CLASS int mp_and(mp_int *a, mp_int *b, mp_int *c);
-
-/* ---> Basic arithmetic <--- */
-
-/* b = -a */
-TOMMATH_STORAGE_CLASS int mp_neg(mp_int *a, mp_int *b);
-
-/* b = |a| */
-TOMMATH_STORAGE_CLASS int mp_abs(mp_int *a, mp_int *b);
-
-/* compare a to b */
-TOMMATH_STORAGE_CLASS int mp_cmp(mp_int *a, mp_int *b);
-
-/* compare |a| to |b| */
-TOMMATH_STORAGE_CLASS int mp_cmp_mag(mp_int *a, mp_int *b);
-
-/* c = a + b */
-TOMMATH_STORAGE_CLASS int mp_add(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = a - b */
-TOMMATH_STORAGE_CLASS int mp_sub(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = a * b */
-TOMMATH_STORAGE_CLASS int mp_mul(mp_int *a, mp_int *b, mp_int *c);
-
-/* b = a*a */
-TOMMATH_STORAGE_CLASS int mp_sqr(mp_int *a, mp_int *b);
-
-/* a/b => cb + d == a */
-TOMMATH_STORAGE_CLASS int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
-
-/* c = a mod b, 0 <= c < b */
-TOMMATH_STORAGE_CLASS int mp_mod(mp_int *a, mp_int *b, mp_int *c);
-
-/* ---> single digit functions <--- */
-
-/* compare against a single digit */
-TOMMATH_STORAGE_CLASS int mp_cmp_d(mp_int *a, mp_digit b);
-
-/* c = a + b */
-TOMMATH_STORAGE_CLASS int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
-
-/* c = a - b */
-TOMMATH_STORAGE_CLASS int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
-
-/* c = a * b */
-TOMMATH_STORAGE_CLASS int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
-
-/* a/b => cb + d == a */
-TOMMATH_STORAGE_CLASS int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
-
-/* a/3 => 3c + d == a */
-TOMMATH_STORAGE_CLASS int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
-
-/* c = a**b */
-TOMMATH_STORAGE_CLASS int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
-
-/* c = a mod b, 0 <= c < b */
-TOMMATH_STORAGE_CLASS int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
-
-/* ---> number theory <--- */
-
-/* d = a + b (mod c) */
-TOMMATH_STORAGE_CLASS int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
-
-/* d = a - b (mod c) */
-TOMMATH_STORAGE_CLASS int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
-
-/* d = a * b (mod c) */
-TOMMATH_STORAGE_CLASS int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
-
-/* c = a * a (mod b) */
-TOMMATH_STORAGE_CLASS int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = 1/a (mod b) */
-TOMMATH_STORAGE_CLASS int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
-
-/* c = (a, b) */
-TOMMATH_STORAGE_CLASS int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
-
-/* produces value such that U1*a + U2*b = U3 */
-TOMMATH_STORAGE_CLASS int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
-
-/* c = [a, b] or (a*b)/(a, b) */
-TOMMATH_STORAGE_CLASS int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
-
-/* finds one of the b'th root of a, such that |c|**b <= |a|
- *
- * returns error if a < 0 and b is even
- */
-TOMMATH_STORAGE_CLASS int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
-
-/* special sqrt algo */
-TOMMATH_STORAGE_CLASS int mp_sqrt(mp_int *arg, mp_int *ret);
-
-/* is number a square? */
-TOMMATH_STORAGE_CLASS int mp_is_square(mp_int *arg, int *ret);
-
-/* computes the jacobi c = (a | n) (or Legendre if b is prime) */
-TOMMATH_STORAGE_CLASS int mp_jacobi(mp_int *a, mp_int *n, int *c);
-
-/* used to setup the Barrett reduction for a given modulus b */
-TOMMATH_STORAGE_CLASS int mp_reduce_setup(mp_int *a, mp_int *b);
-
-/* Barrett Reduction, computes a (mod b) with a precomputed value c
- *
- * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
- * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
- */
-TOMMATH_STORAGE_CLASS int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
-
-/* setups the montgomery reduction */
-TOMMATH_STORAGE_CLASS int mp_montgomery_setup(mp_int *a, mp_digit *mp);
-
-/* computes a = B**n mod b without division or multiplication useful for
- * normalizing numbers in a Montgomery system.
- */
-TOMMATH_STORAGE_CLASS int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
-
-/* computes x/R == x (mod N) via Montgomery Reduction */
-TOMMATH_STORAGE_CLASS int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
-
-/* returns 1 if a is a valid DR modulus */
-TOMMATH_STORAGE_CLASS int mp_dr_is_modulus(mp_int *a);
-
-/* sets the value of "d" required for mp_dr_reduce */
-TOMMATH_STORAGE_CLASS void mp_dr_setup(mp_int *a, mp_digit *d);
-
-/* reduces a modulo b using the Diminished Radix method */
-TOMMATH_STORAGE_CLASS int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
-
-/* returns true if a can be reduced with mp_reduce_2k */
-TOMMATH_STORAGE_CLASS int mp_reduce_is_2k(mp_int *a);
-
-/* determines k value for 2k reduction */
-TOMMATH_STORAGE_CLASS int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
-
-/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-TOMMATH_STORAGE_CLASS int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
-
-/* returns true if a can be reduced with mp_reduce_2k_l */
-TOMMATH_STORAGE_CLASS int mp_reduce_is_2k_l(mp_int *a);
-
-/* determines k value for 2k reduction */
-TOMMATH_STORAGE_CLASS int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
-
-/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-TOMMATH_STORAGE_CLASS int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
-
-/* d = a**b (mod c) */
-TOMMATH_STORAGE_CLASS int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
-
-/* ---> Primes <--- */
-
-/* number of primes */
-#ifdef MP_8BIT
- #define PRIME_SIZE 31
-#else
- #define PRIME_SIZE 256
-#endif
-
-/* table of first PRIME_SIZE primes */
-extern const mp_digit ltm_prime_tab[];
-
-/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
-TOMMATH_STORAGE_CLASS int mp_prime_is_divisible(mp_int *a, int *result);
-
-/* performs one Fermat test of "a" using base "b".
- * Sets result to 0 if composite or 1 if probable prime
- */
-TOMMATH_STORAGE_CLASS int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
-
-/* performs one Miller-Rabin test of "a" using base "b".
- * Sets result to 0 if composite or 1 if probable prime
- */
-TOMMATH_STORAGE_CLASS int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
-
-/* This gives [for a given bit size] the number of trials required
- * such that Miller-Rabin gives a prob of failure lower than 2^-96
- */
-TOMMATH_STORAGE_CLASS int mp_prime_rabin_miller_trials(int size);
-
-/* performs t rounds of Miller-Rabin on "a" using the first
- * t prime bases. Also performs an initial sieve of trial
- * division. Determines if "a" is prime with probability
- * of error no more than (1/4)**t.
- *
- * Sets result to 1 if probably prime, 0 otherwise
- */
-TOMMATH_STORAGE_CLASS int mp_prime_is_prime(mp_int *a, int t, int *result);
-
-/* finds the next prime after the number "a" using "t" trials
- * of Miller-Rabin.
- *
- * bbs_style = 1 means the prime must be congruent to 3 mod 4
- */
-TOMMATH_STORAGE_CLASS int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
-
-/* makes a truly random prime of a given size (bytes),
- * call with bbs = 1 if you want it to be congruent to 3 mod 4
- *
- * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
- * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
- * so it can be NULL
- *
- * The prime generated will be larger than 2^(8*size).
- */
-#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)
-
-/* makes a truly random prime of a given size (bits),
- *
- * Flags are as follows:
- *
- * LTM_PRIME_BBS - make prime congruent to 3 mod 4
- * LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
- * LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
- * LTM_PRIME_2MSB_ON - make the 2nd highest bit one
- *
- * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
- * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
- * so it can be NULL
- *
- */
-TOMMATH_STORAGE_CLASS int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
-
-/* ---> radix conversion <--- */
-TOMMATH_STORAGE_CLASS int mp_count_bits(mp_int *a);
-
-TOMMATH_STORAGE_CLASS int mp_unsigned_bin_size(mp_int *a);
-TOMMATH_STORAGE_CLASS int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
-TOMMATH_STORAGE_CLASS int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
-TOMMATH_STORAGE_CLASS int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
-
-TOMMATH_STORAGE_CLASS int mp_signed_bin_size(mp_int *a);
-TOMMATH_STORAGE_CLASS int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
-TOMMATH_STORAGE_CLASS int mp_to_signed_bin(mp_int *a, unsigned char *b);
-TOMMATH_STORAGE_CLASS int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
-
-TOMMATH_STORAGE_CLASS int mp_read_radix(mp_int *a, const char *str, int radix);
-TOMMATH_STORAGE_CLASS int mp_toradix(mp_int *a, char *str, int radix);
-TOMMATH_STORAGE_CLASS int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
-TOMMATH_STORAGE_CLASS int mp_radix_size(mp_int *a, int radix, int *size);
-
-TOMMATH_STORAGE_CLASS int mp_fread(mp_int *a, int radix, FILE *stream);
-TOMMATH_STORAGE_CLASS int mp_fwrite(mp_int *a, int radix, FILE *stream);
-
-#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
-#define mp_raw_size(mp) mp_signed_bin_size(mp)
-#define mp_toraw(mp, str) mp_to_signed_bin((mp), (str))
-#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
-#define mp_mag_size(mp) mp_unsigned_bin_size(mp)
-#define mp_tomag(mp, str) mp_to_unsigned_bin((mp), (str))
-
-#define mp_tobinary(M, S) mp_toradix((M), (S), 2)
-#define mp_tooctal(M, S) mp_toradix((M), (S), 8)
-#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
-#define mp_tohex(M, S) mp_toradix((M), (S), 16)
-
-/* lowlevel functions, do not call! */
-TOMMATH_STORAGE_CLASS int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
-TOMMATH_STORAGE_CLASS int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
-#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
-TOMMATH_STORAGE_CLASS int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
-TOMMATH_STORAGE_CLASS int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
-TOMMATH_STORAGE_CLASS int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
-TOMMATH_STORAGE_CLASS int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
-TOMMATH_STORAGE_CLASS int fast_s_mp_sqr(mp_int *a, mp_int *b);
-TOMMATH_STORAGE_CLASS int s_mp_sqr(mp_int *a, mp_int *b);
-TOMMATH_STORAGE_CLASS int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
-TOMMATH_STORAGE_CLASS int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
-TOMMATH_STORAGE_CLASS int mp_karatsuba_sqr(mp_int *a, mp_int *b);
-TOMMATH_STORAGE_CLASS int mp_toom_sqr(mp_int *a, mp_int *b);
-TOMMATH_STORAGE_CLASS int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
-TOMMATH_STORAGE_CLASS int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
-TOMMATH_STORAGE_CLASS int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
-TOMMATH_STORAGE_CLASS int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
-TOMMATH_STORAGE_CLASS int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
-TOMMATH_STORAGE_CLASS void bn_reverse(unsigned char *s, int len);
-
-extern const char *mp_s_rmap;
-
-#ifdef __cplusplus
- }
-#endif
-
-#endif
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/generic/tommath.h,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2005/09/26 18:44:06 $ */
-
+#include "tclTomMathInt.h"
diff --git a/library/auto.tcl b/library/auto.tcl
index 63260e7..02edcc4 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -1,49 +1,48 @@
# auto.tcl --
#
-# utility procs formerly in init.tcl dealing with auto execution
-# of commands and can be auto loaded themselves.
-#
-# RCS: @(#) $Id: auto.tcl,v 1.27 2005/07/23 04:12:48 dgp Exp $
+# utility procs formerly in init.tcl dealing with auto execution of commands
+# and can be auto loaded themselves.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# auto_reset --
#
-# Destroy all cached information for auto-loading and auto-execution,
-# so that the information gets recomputed the next time it's needed.
-# Also delete any commands that are listed in the auto-load index.
+# Destroy all cached information for auto-loading and auto-execution, so that
+# the information gets recomputed the next time it's needed. Also delete any
+# commands that are listed in the auto-load index.
#
-# Arguments:
+# Arguments:
# None.
proc auto_reset {} {
- if {[array exists ::auto_index]} {
- foreach cmdName [array names ::auto_index] {
+ global auto_execs auto_index auto_path
+ if {[array exists auto_index]} {
+ foreach cmdName [array names auto_index] {
set fqcn [namespace which $cmdName]
- if {$fqcn eq ""} {continue}
+ if {$fqcn eq ""} {
+ continue
+ }
rename $fqcn {}
}
}
- unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath
- if {[catch {llength $::auto_path}]} {
- set ::auto_path [list [info library]]
- } else {
- if {[info library] ni $::auto_path} {
- lappend ::auto_path [info library]
- }
+ unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath
+ if {[catch {llength $auto_path}]} {
+ set auto_path [list [info library]]
+ } elseif {[info library] ni $auto_path} {
+ lappend auto_path [info library]
}
}
# tcl_findLibrary --
#
# This is a utility for extensions that searches for a library directory
-# using a canonical searching algorithm. A side effect is to source
-# the initialization script and set a global library variable.
+# using a canonical searching algorithm. A side effect is to source the
+# initialization script and set a global library variable.
#
# Arguments:
# basename Prefix of the directory name, (e.g., "tk")
@@ -55,7 +54,7 @@ proc auto_reset {} {
proc tcl_findLibrary {basename version patch initScript enVarName varName} {
upvar #0 $varName the_library
- global env
+ global auto_path env tcl_platform
set dirs {}
set errors {}
@@ -65,33 +64,30 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
if {[info exists the_library] && $the_library ne ""} {
lappend dirs $the_library
} else {
-
# Do the canonical search
- # 1. From an environment variable, if it exists.
- # Placing this first gives the end-user ultimate control
- # to work-around any bugs, or to customize.
+ # 1. From an environment variable, if it exists. Placing this first
+ # gives the end-user ultimate control to work-around any bugs, or
+ # to customize.
if {[info exists env($enVarName)]} {
lappend dirs $env($enVarName)
}
- # 2. In the package script directory registered within
- # the configuration of the package itself.
+ # 2. In the package script directory registered within the
+ # configuration of the package itself.
- if {[catch {
- ::${basename}::pkgconfig get scriptdir,runtime
- } value] == 0} {
- lappend dirs $value
+ catch {
+ lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
}
# 3. Relative to auto_path directories. This checks relative to the
# Tcl library as well as allowing loading of libraries added to the
# auto_path that is not relative to the core library or binary paths.
- foreach d $::auto_path {
+ foreach d $auto_path {
lappend dirs [file join $d $basename$version]
- if {$::tcl_platform(platform) eq "unix"
- && $::tcl_platform(os) eq "Darwin"} {
+ if {$tcl_platform(platform) eq "unix"
+ && $tcl_platform(os) eq "Darwin"} {
# 4. On MacOSX, check the Resources/Scripts subdir too
lappend dirs [file join $d $basename$version Resources Scripts]
}
@@ -102,8 +98,8 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
# ../library (From unix directory in build hierarchy)
#
- # Remaining locations are out of date (when relevant, they ought
- # to be covered by the $::auto_path seach above) and disabled.
+ # Remaining locations are out of date (when relevant, they ought to be
+ # covered by the $::auto_path seach above) and disabled.
#
# ../../library (From unix/arch directory in build hierarchy)
# ../../foo1.0.1/library
@@ -126,17 +122,19 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# uniquify $dirs in order
array set seen {}
foreach i $dirs {
- # Take note that the [file normalize] below has been noted to
- # cause difficulties for the freewrap utility. See Bug 1072136.
- # Until freewrap resolves the matter, one might work around the
- # problem by disabling that branch.
+ # Take note that the [file normalize] below has been noted to cause
+ # difficulties for the freewrap utility. See Bug 1072136. Until
+ # freewrap resolves the matter, one might work around the problem by
+ # disabling that branch.
if {[interp issafe]} {
set norm $i
} else {
set norm [file normalize $i]
}
- if {[info exists seen($norm)]} { continue }
- set seen($norm) ""
+ if {[info exists seen($norm)]} {
+ continue
+ }
+ set seen($norm) {}
lappend uniqdirs $i
}
set dirs $uniqdirs
@@ -144,16 +142,15 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
set the_library $i
set file [file join $i $initScript]
- # source everything when in a safe interpreter because
- # we have a source command, but no file exists command
+ # source everything when in a safe interpreter because we have a
+ # source command, but no file exists command
if {[interp issafe] || [file exists $file]} {
if {![catch {uplevel #0 [list source $file]} msg opts]} {
return
- } else {
- append errors "$file: $msg\n"
- append errors [dict get $opts -errorinfo]\n
}
+ append errors "$file: $msg\n"
+ append errors [dict get $opts -errorinfo]\n
}
}
unset -nocomplain the_library
@@ -168,28 +165,28 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
-# The following procedures are used to generate the tclIndex file
-# from Tcl source files. They use a special safe interpreter to
-# parse Tcl source files, writing out index entries as "proc"
-# commands are encountered. This implementation won't work in a
-# safe interpreter, since a safe interpreter can't create the
-# special parser and mess with its commands.
+# The following procedures are used to generate the tclIndex file from Tcl
+# source files. They use a special safe interpreter to parse Tcl source
+# files, writing out index entries as "proc" commands are encountered. This
+# implementation won't work in a safe interpreter, since a safe interpreter
+# can't create the special parser and mess with its commands.
if {[interp issafe]} {
return ;# Stop sourcing the file here
}
# auto_mkindex --
-# Regenerate a tclIndex file from Tcl source files. Takes as argument
-# the name of the directory in which the tclIndex file is to be placed,
-# followed by any number of glob patterns to use in that directory to
-# locate all of the relevant files.
+# Regenerate a tclIndex file from Tcl source files. Takes as argument the
+# name of the directory in which the tclIndex file is to be placed, followed
+# by any number of glob patterns to use in that directory to locate all of the
+# relevant files.
#
-# Arguments:
+# Arguments:
# dir - Name of the directory in which to create an index.
-# args - Any number of additional arguments giving the
-# names of files within dir. If no additional
-# are given auto_mkindex will look for *.tcl.
+
+# args - Any number of additional arguments giving the names of files
+# within dir. If no additional are given auto_mkindex will look
+# for *.tcl.
proc auto_mkindex {dir args} {
if {[interp issafe]} {
@@ -198,7 +195,6 @@ proc auto_mkindex {dir args} {
set oldDir [pwd]
cd $dir
- set dir [pwd]
append index "# Tcl autoload index file, version 2.0\n"
append index "# This file is generated by the \"auto_mkindex\" command\n"
@@ -207,18 +203,18 @@ proc auto_mkindex {dir args} {
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
- if {[llength $args] == 0} {
+ if {![llength $args]} {
set args *.tcl
}
auto_mkindex_parser::init
- foreach file [glob -- {expand}$args] {
- if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
- append index $msg
- } else {
- cd $oldDir
+ foreach file [glob -- {*}$args] {
+ try {
+ append index [auto_mkindex_parser::mkindex $file]
+ } on error {msg opts} {
+ cd $oldDir
return -options $opts $msg
- }
+ }
}
auto_mkindex_parser::cleanup
@@ -228,8 +224,8 @@ proc auto_mkindex {dir args} {
cd $oldDir
}
-# Original version of auto_mkindex that just searches the source
-# code for "proc" at the beginning of the line.
+# Original version of auto_mkindex that just searches the source code for
+# "proc" at the beginning of the line.
proc auto_mkindex_old {dir args} {
set oldDir [pwd]
@@ -242,10 +238,10 @@ proc auto_mkindex_old {dir args} {
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
- if {[llength $args] == 0} {
+ if {![llength $args]} {
set args *.tcl
}
- foreach file [glob -- {expand}$args] {
+ foreach file [glob -- {*}$args] {
set f ""
set error [catch {
set f [open $file]
@@ -280,9 +276,9 @@ proc auto_mkindex_old {dir args} {
}
# Create a safe interpreter that can be used to parse Tcl source files
-# generate a tclIndex file for autoloading. This interp contains
-# commands for things that need index entries. Each time a command
-# is executed, it writes an entry out to the index file.
+# generate a tclIndex file for autoloading. This interp contains commands for
+# things that need index entries. Each time a command is executed, it writes
+# an entry out to the index file.
namespace eval auto_mkindex_parser {
variable parser "" ;# parser used to build index
@@ -307,7 +303,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
@@ -334,12 +337,12 @@ namespace eval auto_mkindex_parser {
# auto_mkindex_parser::mkindex --
#
-# Used by the "auto_mkindex" command to create a "tclIndex" file for
-# the given Tcl source file. Executes the commands in the file, and
-# handles things like the "proc" command by adding an entry for the
-# index file. Returns a string that represents the index file.
+# Used by the "auto_mkindex" command to create a "tclIndex" file for the given
+# Tcl source file. Executes the commands in the file, and handles things like
+# the "proc" command by adding an entry for the index file. Returns a string
+# that represents the index file.
#
-# Arguments:
+# Arguments:
# file Name of Tcl source file to be indexed.
proc auto_mkindex_parser::mkindex {file} {
@@ -355,14 +358,13 @@ proc auto_mkindex_parser::mkindex {file} {
set contents [read $fid]
close $fid
- # There is one problem with sourcing files into the safe
- # interpreter: references like "$x" will fail since code is not
- # really being executed and variables do not really exist.
- # To avoid this, we replace all $ with \0 (literally, the null char)
- # later, when getting proc names we will have to reverse this replacement,
- # in case there were any $ in the proc name. This will cause a problem
- # if somebody actually tries to have a \0 in their proc name. Too bad
- # for them.
+ # There is one problem with sourcing files into the safe interpreter:
+ # references like "$x" will fail since code is not really being executed
+ # and variables do not really exist. To avoid this, we replace all $ with
+ # \0 (literally, the null char) later, when getting proc names we will
+ # have to reverse this replacement, in case there were any $ in the proc
+ # name. This will cause a problem if somebody actually tries to have a \0
+ # in their proc name. Too bad for them.
set contents [string map [list \$ \0] $contents]
set index ""
@@ -379,10 +381,10 @@ proc auto_mkindex_parser::mkindex {file} {
# auto_mkindex_parser::hook command
#
-# Registers a Tcl command to evaluate when initializing the
-# slave interpreter used by the mkindex parser.
-# The command is evaluated in the master interpreter, and can
-# use the variable auto_mkindex_parser::parser to get to the slave
+# Registers a Tcl command to evaluate when initializing the slave interpreter
+# used by the mkindex parser. The command is evaluated in the master
+# interpreter, and can use the variable auto_mkindex_parser::parser to get to
+# the slave
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
@@ -392,30 +394,30 @@ proc auto_mkindex_parser::hook {cmd} {
# auto_mkindex_parser::slavehook command
#
-# Registers a Tcl command to evaluate when initializing the
-# slave interpreter used by the mkindex parser.
-# The command is evaluated in the slave interpreter.
+# Registers a Tcl command to evaluate when initializing the slave interpreter
+# used by the mkindex parser. The command is evaluated in the slave
+# interpreter.
proc auto_mkindex_parser::slavehook {cmd} {
variable initCommands
- # The $parser variable is defined to be the name of the
- # slave interpreter when this command is used later.
+ # The $parser variable is defined to be the name of the slave interpreter
+ # when this command is used later.
lappend initCommands "\$parser eval [list $cmd]"
}
# auto_mkindex_parser::command --
#
-# Registers a new command with the "auto_mkindex_parser" interpreter
-# that parses Tcl files. These commands are fake versions of things
-# like the "proc" command. When you execute them, they simply write
-# out an entry to a "tclIndex" file for auto-loading.
+# Registers a new command with the "auto_mkindex_parser" interpreter that
+# parses Tcl files. These commands are fake versions of things like the
+# "proc" command. When you execute them, they simply write out an entry to a
+# "tclIndex" file for auto-loading.
#
-# This procedure allows extensions to register their own commands
-# with the auto_mkindex facility. For example, a package like
-# [incr Tcl] might register a "class" command so that class definitions
-# could be added to a "tclIndex" file for auto-loading.
+# This procedure allows extensions to register their own commands with the
+# auto_mkindex facility. For example, a package like [incr Tcl] might
+# register a "class" command so that class definitions could be added to a
+# "tclIndex" file for auto-loading.
#
# Arguments:
# name Name of command recognized in Tcl files.
@@ -428,8 +430,8 @@ proc auto_mkindex_parser::command {name arglist body} {
# auto_mkindex_parser::commandInit --
#
-# This does the actual work set up by auto_mkindex_parser::command
-# This is called when the interpreter used by the parser is created.
+# This does the actual work set up by auto_mkindex_parser::command. This is
+# called when the interpreter used by the parser is created.
#
# Arguments:
# name Name of command recognized in Tcl files.
@@ -448,25 +450,23 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
}
proc $fakeName $arglist $body
- # YUK! Tcl won't let us alias fully qualified command names,
- # so we can't handle names like "::itcl::class". Instead,
- # we have to build procs with the fully qualified names, and
- # have the procs point to the aliases.
+ # YUK! Tcl won't let us alias fully qualified command names, so we can't
+ # handle names like "::itcl::class". Instead, we have to build procs with
+ # the fully qualified names, and have the procs point to the aliases.
if {[string match *::* $name]} {
set exportCmd [list _%@namespace export [namespace tail $name]]
$parser eval [list _%@namespace eval $ns $exportCmd]
-
- # The following proc definition does not work if you
- # want to tolerate space or something else diabolical
- # in the procedure name, (i.e., space in $alias)
- # The following does not work:
+
+ # The following proc definition does not work if you want to tolerate
+ # space or something else diabolical in the procedure name, (i.e.,
+ # space in $alias). The following does not work:
# "_%@eval {$alias} \$args"
- # because $alias gets concat'ed to $args.
- # The following does not work because $cmd is somehow undefined
+ # because $alias gets concat'ed to $args. The following does not work
+ # because $cmd is somehow undefined
# "set cmd {$alias} \; _%@eval {\$cmd} \$args"
- # A gold star to someone that can make test
- # autoMkindex-3.3 work properly
+ # A gold star to someone that can make test autoMkindex-3.3 work
+ # properly
set alias [namespace tail $fakeName]
$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
@@ -478,15 +478,14 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
}
# auto_mkindex_parser::fullname --
-# Used by commands like "proc" within the auto_mkindex parser.
-# Returns the qualified namespace name for the "name" argument.
-# If the "name" does not start with "::", elements are added from
-# the current namespace stack to produce a qualified name. Then,
-# the name is examined to see whether or not it should really be
-# qualified. If the name has more than the leading "::", it is
-# returned as a fully qualified name. Otherwise, it is returned
-# as a simple name. That way, the Tcl autoloader will recognize
-# it properly.
+#
+# Used by commands like "proc" within the auto_mkindex parser. Returns the
+# qualified namespace name for the "name" argument. If the "name" does not
+# start with "::", elements are added from the current namespace stack to
+# produce a qualified name. Then, the name is examined to see whether or not
+# it should really be qualified. If the name has more than the leading "::",
+# it is returned as a fully qualified name. Otherwise, it is returned as a
+# simple name. That way, the Tcl autoloader will recognize it properly.
#
# Arguments:
# name - Name that is being added to index.
@@ -509,44 +508,65 @@ proc auto_mkindex_parser::fullname {name} {
set name "::$name"
}
- # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
- # that replacement.
+ # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse that
+ # replacement.
return [string map [list \0 \$] $name]
}
+# auto_mkindex_parser::indexEntry --
+#
+# Used by commands like "proc" within the auto_mkindex parser to add a
+# correctly-quoted entry to the index. This is shared code so it is done
+# *right*, in one place.
+#
+# Arguments:
+# name - Name that is being added to index.
+
+proc auto_mkindex_parser::indexEntry {name} {
+ variable index
+ variable scriptFile
+
+ # We convert all metacharacters to their backslashed form, and pre-split
+ # the file name that we know about (which will be a proper list, and so
+ # correctly quoted).
+
+ set name [string range [list \}[fullname $name]] 2 end]
+ set filenameParts [file split $scriptFile]
+
+ append index [format \
+ {set auto_index(%s) [list source [file join $dir %s]]%s} \
+ $name $filenameParts \n]
+ return
+}
+
if {[llength $::auto_mkindex_parser::initCommands]} {
return
}
-# Register all of the procedures for the auto_mkindex parser that
-# will build the "tclIndex" file.
+# Register all of the procedures for the auto_mkindex parser that will build
+# the "tclIndex" file.
# AUTO MKINDEX: proc name arglist body
# Adds an entry to the auto index list for the given procedure name.
auto_mkindex_parser::command proc {name args} {
- variable index
- variable scriptFile
- # Do some fancy reformatting on the "source" call to handle platform
- # differences with respect to pathnames. Use format just so that the
- # command is a little easier to read (otherwise it'd be full of
- # backslashed dollar signs, etc.
- append index [list set auto_index([fullname $name])] \
- [format { [list source [file join $dir %s]]} \
- [file split $scriptFile]] "\n"
+ indexEntry $name
}
-# Conditionally add support for Tcl byte code files. There are some
-# tricky details here. First, we need to get the tbcload library
-# initialized in the current interpreter. We cannot load tbcload into the
-# slave until we have done so because it needs access to the tcl_patchLevel
-# variable. Second, because the package index file may defer loading the
-# library until we invoke a command, we need to explicitly invoke auto_load
-# to force it to be loaded. This should be a noop if the package has
-# already been loaded
+# Conditionally add support for Tcl byte code files. There are some tricky
+# details here. First, we need to get the tbcload library initialized in the
+# current interpreter. We cannot load tbcload into the slave until we have
+# done so because it needs access to the tcl_patchLevel variable. Second,
+# because the package index file may defer loading the library until we invoke
+# a command, we need to explicitly invoke auto_load to force it to be loaded.
+# This should be a noop if the package has already been loaded
auto_mkindex_parser::hook {
- if {![catch {package require tbcload}]} {
+ try {
+ package require tbcload
+ } on error {} {
+ # OK, don't have it so do nothing
+ } on ok {} {
if {[namespace which -command tbcload::bcproc] eq ""} {
auto_load tbcload::bcproc
}
@@ -554,32 +574,24 @@ auto_mkindex_parser::hook {
# AUTO MKINDEX: tbcload::bcproc name arglist body
# Adds an entry to the auto index list for the given pre-compiled
- # procedure name.
+ # procedure name.
auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
- variable index
- variable scriptFile
- # Do some nice reformatting of the "source" call, to get around
- # path differences on different platforms. We use the format
- # command just so that the code is a little easier to read.
- append index [list set auto_index([fullname $name])] \
- [format { [list source [file join $dir %s]]} \
- [file split $scriptFile]] "\n"
+ indexEntry $name
}
}
}
# AUTO MKINDEX: namespace eval name command ?arg arg...?
-# Adds the namespace name onto the context stack and evaluates the
-# associated body of commands.
+# Adds the namespace name onto the context stack and evaluates the associated
+# body of commands.
#
# AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
-# Performs the "import" action in the parser interpreter. This is
-# important for any commands contained in a namespace that affect
-# the index. For example, a script may say "itcl::class ...",
-# or it may import "itcl::*" and then say "class ...". This
-# procedure does the import operation, but keeps track of imported
-# patterns so we can remove the imports later.
+# Performs the "import" action in the parser interpreter. This is important
+# for any commands contained in a namespace that affect the index. For
+# example, a script may say "itcl::class ...", or it may import "itcl::*" and
+# then say "class ...". This procedure does the import operation, but keeps
+# track of imported patterns so we can remove the imports later.
auto_mkindex_parser::command namespace {op args} {
switch -- $op {
@@ -604,6 +616,35 @@ auto_mkindex_parser::command namespace {op args} {
}
catch {$parser eval "_%@namespace import $args"}
}
+ ensemble {
+ variable parser
+ variable contextStack
+ if {[lindex $args 0] eq "create"} {
+ set name ::[join [lreverse $contextStack] ::]
+ catch {
+ set name [dict get [lrange $args 1 end] -command]
+ if {![string match ::* $name]} {
+ set name ::[join [lreverse $contextStack] ::]$name
+ }
+ regsub -all ::+ $name :: name
+ }
+ # create artifical proc to force an entry in the tclIndex
+ $parser eval [list ::proc $name {} {}]
+ }
+ }
+ }
+}
+
+# AUTO MKINDEX: oo::class create name ?definition?
+# Adds an entry to the auto index list for the given class name.
+auto_mkindex_parser::command oo::class {op name {body ""}} {
+ if {$op eq "create"} {
+ indexEntry $name
+ }
+}
+auto_mkindex_parser::command class {op name {body ""}} {
+ if {$op eq "create"} {
+ indexEntry $name
}
}
diff --git a/library/clock.tcl b/library/clock.tcl
index 1f2558b..1e652b4 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -2,54 +2,33 @@
#
# clock.tcl --
#
-# This file implements the portions of the [clock] ensemble that
-# are coded in Tcl. Refer to the users' manual to see the description
-# of the [clock] command and its subcommands.
+# This file implements the portions of the [clock] ensemble that are
+# coded in Tcl. Refer to the users' manual to see the description of
+# the [clock] command and its subcommands.
#
#
#----------------------------------------------------------------------
#
-# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
+# Copyright (c) 2004,2005,2006,2007 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.
#
-# RCS: @(#) $Id: clock.tcl,v 1.19 2005/08/12 23:59:07 kennykb Exp $
-#
#----------------------------------------------------------------------
-# We must have message catalogs that support the root locale, and
-# we need access to the Registry on Windows systems. We also need
-# Tcl 8.5 dictionaries.
+# We must have message catalogs that support the root locale, and we need
+# access to the Registry on Windows systems.
uplevel \#0 {
package require msgcat 1.4
if { $::tcl_platform(platform) eq {windows} } {
if { [catch { package require registry 1.1 }] } {
-
- # HIDEOUS KLUDGE: [package require registry 1.1] has failed.
- # This failure likely means that we're running in Tcl's build
- # directory instead of the install directory. We recover by
- # trying to load tclreg*.dll directly.
-
- if { [catch {
- load [lindex \
- [glob -directory \
- [file join \
- [pwd] \
- [file dirname [info nameofexecutable]]] \
- tclReg*.dll] \
- 0] registry
- }] } {
- # Still no registry!
- namespace eval ::tcl::clock [list variable NoRegistry {}]
- }
+ namespace eval ::tcl::clock [list variable NoRegistry {}]
}
}
}
-# Put the library directory into the namespace for the ensemble
-# so that the library code can find message catalogs and time zone
-# definition files.
+# Put the library directory into the namespace for the ensemble so that the
+# library code can find message catalogs and time zone definition files.
namespace eval ::tcl::clock \
[list variable LibDir [file dirname [info script]]]
@@ -60,10 +39,10 @@ namespace eval ::tcl::clock \
#
# Manipulate times.
#
-# The 'clock' command manipulates time. Refer to the user documentation
-# for the available subcommands and what they do.
+# The 'clock' command manipulates time. Refer to the user documentation for
+# the available subcommands and what they do.
#
-#----------------------------------------------------------------------
+#----------------------------------------------------------------------
namespace eval ::tcl::clock {
@@ -96,11 +75,11 @@ namespace eval ::tcl::clock {
# Side effects:
# Namespace variable in the 'clock' subsystem are initialized.
#
-# The '::tcl::clock::Initialize' procedure initializes the namespace
-# variables and root locale message catalog for the 'clock' subsystem.
-# It is broken into a procedure rather than simply evaluated as a script
-# so that it will be able to use local variables, avoiding the dangers
-# of 'creative writing' as in Bug 1185933.
+# The '::tcl::clock::Initialize' procedure initializes the namespace variables
+# and root locale message catalog for the 'clock' subsystem. It is broken
+# into a procedure rather than simply evaluated as a script so that it will be
+# able to use local variables, avoiding the dangers of 'creative writing' as
+# in Bug 1185933.
#
#----------------------------------------------------------------------
@@ -123,6 +102,7 @@ proc ::tcl::clock::Initialize {} {
{-9223372036854775808 0 0 UTC}
}
set TZData(:UTC) $TZData(:Etc/UTC)
+ set TZData(:localtime) {}
}
InitTZData
@@ -191,8 +171,8 @@ proc ::tcl::clock::Initialize {} {
::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227
- # For Belgium, we follow Southern Netherlands; Liege Diocese
- # changed several weeks later.
+ # For Belgium, we follow Southern Netherlands; Liege Diocese changed
+ # several weeks later.
::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238
@@ -208,13 +188,13 @@ proc ::tcl::clock::Initialize {} {
# Germany, Norway, Denmark (Catholic Germany changed earlier)
::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
+ ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032
- # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed
- # at various times)
+ # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
+ # various times)
::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165
@@ -236,23 +216,23 @@ proc ::tcl::clock::Initialize {} {
::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639
- # Romania (Transylvania changed earler - perhaps de_RO should show
- # the earlier date?)
+ # Romania (Transylvania changed earler - perhaps de_RO should show the
+ # earlier date?)
::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063
# Greece
::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
-
+
#------------------------------------------------------------------
#
# CONSTANTS
#
#------------------------------------------------------------------
- # Paths at which binary time zone data for the Olson libraries
- # are known to reside on various operating systems
+ # Paths at which binary time zone data for the Olson libraries are known
+ # to reside on various operating systems
variable ZoneinfoPaths {}
foreach path {
@@ -260,7 +240,6 @@ proc ::tcl::clock::Initialize {} {
/usr/share/lib/zoneinfo
/usr/lib/zoneinfo
/usr/local/etc/zoneinfo
- C:/Progra~1/cygwin/usr/local/etc/zoneinfo
} {
if { [file isdirectory $path] } {
lappend ZoneinfoPaths $path
@@ -302,10 +281,10 @@ proc ::tcl::clock::Initialize {} {
variable FEB_28 58
- # Translation table to map Windows TZI onto cities, so that
- # the Olson rules can apply. In some cases the mapping is ambiguous,
- # so it's wise to specify $::env(TCL_TZ) rather than simply depending
- # on the system time zone.
+ # Translation table to map Windows TZI onto cities, so that the Olson
+ # rules can apply. In some cases the mapping is ambiguous, so it's wise
+ # to specify $::env(TCL_TZ) rather than simply depending on the system
+ # time zone.
# The keys are long lists of values obtained from the time zone
# information in the Registry. In order, the list elements are:
@@ -316,77 +295,92 @@ proc ::tcl::clock::Initialize {} {
# DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
# DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
# DaylightDate.wSecond DaylightDate.wMilliseconds
- # The values are the names of time zones where those rules apply.
- # There is considerable ambiguity in certain zones; an attempt has
- # been made to make a reasonable guess, but this table needs to be
- # taken with a grain of salt.
-
- variable WinZoneInfo [dict create \
- {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein \
- {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway \
- {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu \
- {-32400 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Anchorage \
- {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Los_Angeles \
- {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Denver \
- {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix \
- {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina \
- {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chicago \
- {-18000 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/New_York \
- {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis \
- {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas \
- {-14400 0 3600 0 3 6 2 0 0 0 0 0 10 6 2 0 0 0 0} :America/Santiago \
- {-14400 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Halifax \
- {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns \
- {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo \
- {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab \
- {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires \
- {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha \
- {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores \
- {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde \
- {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC \
- {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London \
- {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa \
- {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET \
- {7200 0 3600 0 9 3 5 2 0 0 0 0 5 5 1 2 0 0 0} :Africa/Cairo \
- {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki \
- {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Jerusalem \
- {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest \
- {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens \
- {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh \
- {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad \
- {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow \
- {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran \
- {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat \
- {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi \
- {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul \
- {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi \
- {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg \
- {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta \
- {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu \
- {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka \
- {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk \
- {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon \
- {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok \
- {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk \
- {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing \
- {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk \
- {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo \
- {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk \
- {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide \
- {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin \
- {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane \
- {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok \
- {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart \
- {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney \
- {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea \
- {43200 0 3600 0 3 0 3 2 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland \
- {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji \
- {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu]
-
- # Groups of fields that specify the date, priorities, and
- # code bursts that determine Julian Day Number given those groups.
- # The code in [clock scan] will choose the highest priority
- # (lowest numbered) set of fields that determines the date.
+ # The values are the names of time zones where those rules apply. There
+ # is considerable ambiguity in certain zones; an attempt has been made to
+ # make a reasonable guess, but this table needs to be taken with a grain
+ # of salt.
+
+ variable WinZoneInfo [dict create {*}{
+ {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein
+ {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway
+ {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu
+ {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
+ {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
+ {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
+ {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
+ {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
+ {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix
+ {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina
+ {-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
+ {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
+ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
+ {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis
+ {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas
+ {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
+ :America/Santiago
+ {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
+ {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
+ {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
+ {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
+ {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
+ {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires
+ {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
+ {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
+ {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha
+ {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores
+ {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde
+ {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC
+ {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London
+ {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa
+ {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET
+ {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Harare
+ {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
+ :Africa/Cairo
+ {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki
+ {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0} :Asia/Jerusalem
+ {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest
+ {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens
+ {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0} :Asia/Amman
+ {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
+ :Asia/Beirut
+ {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0} :Africa/Windhoek
+ {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh
+ {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad
+ {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow
+ {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran
+ {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0} :Asia/Baku
+ {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat
+ {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi
+ {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul
+ {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi
+ {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg
+ {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta
+ {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu
+ {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka
+ {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk
+ {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon
+ {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok
+ {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk
+ {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing
+ {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk
+ {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo
+ {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk
+ {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide
+ {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin
+ {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane
+ {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok
+ {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart
+ {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
+ {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
+ {43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
+ {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
+ {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
+ }]
+
+ # Groups of fields that specify the date, priorities, and code bursts that
+ # determine Julian Day Number given those groups. The code in [clock
+ # scan] will choose the highest priority (lowest numbered) set of fields
+ # that determines the date.
variable DateParseActions {
@@ -394,80 +388,104 @@ proc ::tcl::clock::Initialize {} {
{ julianDay } 1 {}
- { century yearOfCentury month dayOfMonth } 2 {
+ { era century yearOfCentury month dayOfMonth } 2 {
+ dict set date year [expr { 100 * [dict get $date century]
+ + [dict get $date yearOfCentury] }]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
+ }
+ { era century yearOfCentury dayOfYear } 2 {
+ dict set date year [expr { 100 * [dict get $date century]
+ + [dict get $date yearOfCentury] }]
+ set date [GetJulianDayFromEraYearDay $date[set date {}] \
+ $changeover]
+ }
+
+ { century yearOfCentury month dayOfMonth } 3 {
dict set date era CE
dict set date year [expr { 100 * [dict get $date century]
+ [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
- { century yearOfCentury dayOfYear } 2 {
+ { century yearOfCentury dayOfYear } 3 {
dict set date era CE
dict set date year [expr { 100 * [dict get $date century]
+ [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearDay $date[set date {}] \
+ $changeover]
}
- { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 2 {
+ { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
dict set date era CE
dict set date iso8601Year \
[expr { 100 * [dict get $date iso8601Century]
+ [dict get $date iso8601YearOfCentury] }]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
- { yearOfCentury month dayOfMonth } 3 {
+ { yearOfCentury month dayOfMonth } 4 {
set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
dict set date era CE
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
- { yearOfCentury dayOfYear } 3 {
+ { yearOfCentury dayOfYear } 4 {
set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
dict set date era CE
- set date [GetJulianDayFromEraYearDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearDay $date[set date {}] \
+ $changeover]
}
- { iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
+ { iso8601YearOfCentury iso8601Week dayOfWeek } 4 {
set date [InterpretTwoDigitYear \
$date[set date {}] $baseTime \
iso8601YearOfCentury iso8601Year]
dict set date era CE
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
- { month dayOfMonth } 4 {
+ { month dayOfMonth } 5 {
set date [AssignBaseYear $date[set date {}] \
- $baseTime $timeZone]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ $baseTime $timeZone $changeover]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
- { dayOfYear } 4 {
+ { dayOfYear } 5 {
set date [AssignBaseYear $date[set date {}] \
- $baseTime $timeZone]
- set date [GetJulianDayFromEraYearDay $date[set date {}]]
+ $baseTime $timeZone $changeover]
+ set date [GetJulianDayFromEraYearDay $date[set date {}] \
+ $changeover]
}
- { iso8601Week dayOfWeek } 4 {
+ { iso8601Week dayOfWeek } 5 {
set date [AssignBaseIso8601Year $date[set date {}] \
- $baseTime $timeZone]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ $baseTime $timeZone $changeover]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
- { dayOfMonth } 5 {
+ { dayOfMonth } 6 {
set date [AssignBaseMonth $date[set date {}] \
- $baseTime $timeZone]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ $baseTime $timeZone $changeover]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
+ $changeover]
}
- { dayOfWeek } 6 {
+ { dayOfWeek } 7 {
set date [AssignBaseWeek $date[set date {}] \
- $baseTime $timeZone]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}]]
+ $baseTime $timeZone $changeover]
+ set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
+ $changeover]
}
- {} 7 {
+ {} 8 {
set date [AssignBaseJulianDay $date[set date {}] \
- $baseTime $timeZone]
+ $baseTime $timeZone $changeover]
}
}
- # Groups of fields that specify time of day, priorities,
- # and code that processes them
+ # Groups of fields that specify time of day, priorities, and code that
+ # processes them
variable TimeParseActions {
@@ -558,7 +576,10 @@ proc ::tcl::clock::Initialize {} {
jt +0730 \
cct +0800 \
jst +0900 \
+ kst +0900 \
cast +0930 \
+ jdt +1000 \
+ kdt +1000 \
cadt +1030 \
east +1000 \
eadt +1030 \
@@ -620,6 +641,9 @@ proc ::tcl::clock::Initialize {} {
# comprising start time, UTC offset,
# Daylight Saving Time indicator, and
# time zone abbreviation.
+ variable FormatProc; # Array mapping format group
+ # and locale to the name of a procedure
+ # that renders the given format
}
::tcl::clock::Initialize
@@ -627,482 +651,546 @@ proc ::tcl::clock::Initialize {} {
#
# clock format --
#
-# Formats a count of seconds since the Posix Epoch as a time
-# of day.
+# Formats a count of seconds since the Posix Epoch as a time of day.
#
-# The 'clock format' command formats times of day for output.
-# Refer to the user documentation to see what it does.
+# The 'clock format' command formats times of day for output. Refer to the
+# user documentation to see what it does.
#
#----------------------------------------------------------------------
proc ::tcl::clock::format { args } {
+ variable FormatProc
+ variable TZData
- set format {}
-
- # Check the count of args
-
- if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
- return -code error \
- -errorcode [list CLOCK wrongNumArgs] \
- "wrong \# args: should be\
- \"[lindex [info level 0] 0] clockval\
- ?-format string? ?-gmt boolean?\
- ?-locale LOCALE? ?-timezone ZONE?\""
- }
-
- # Set defaults
-
+ lassign [ParseFormatArgs {*}$args] format locale timezone
+ set locale [string tolower $locale]
set clockval [lindex $args 0]
- set format {%a %b %d %H:%M:%S %z %Y}
- set gmt 0
- set locale C
- set timezone [GetSystemTimeZone]
- # Pick up command line options.
+ # Get the data for time changes in the given zone
- foreach { flag value } [lreplace $args 0 0] {
- set saw($flag) {}
- switch -exact -- $flag {
- -format {
- set format $value
- }
- -gmt {
- set gmt $value
- }
- -locale {
- set locale $value
- }
- -timezone {
- set timezone $value
- }
- default {
- return -code error \
- -errorcode [list CLOCK badSwitch $flag] \
- "bad switch \"$flag\",\
- must be -format, -gmt, -locale or -timezone"
- }
+ if {$timezone eq ""} {
+ set timezone [GetSystemTimeZone]
+ }
+ if {![info exists TZData($timezone)]} {
+ if {[catch {SetupTimeZone $timezone} retval opts]} {
+ dict unset opts -errorinfo
+ return -options $opts $retval
}
}
- # Check options for validity
+ # Build a procedure to format the result. Cache the built procedure's name
+ # in the 'FormatProc' array to avoid losing its internal representation,
+ # which contains the name resolution.
- if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
- return -code error \
- -errorcode [list CLOCK gmtWithTimezone] \
- "cannot use -gmt and -timezone in same call"
- }
- if { [catch { expr { wide($clockval) } } result] } {
- return -code error \
- "expected integer but got \"$clockval\""
- }
- if { ![string is boolean $gmt] } {
- return -code error \
- "expected boolean value but got \"$gmt\""
+ set procName formatproc'$format'$locale
+ set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
+ if {[info exists FormatProc($procName)]} {
+ set procName $FormatProc($procName)
} else {
- if { $gmt } {
- set timezone :GMT
- }
+ set FormatProc($procName) \
+ [ParseClockFormatFormat $procName $format $locale]
}
+ return [$procName $clockval $timezone]
+}
+
+#----------------------------------------------------------------------
+#
+# ParseClockFormatFormat --
+#
+# Builds and caches a procedure that formats a time value.
+#
+# Parameters:
+# format -- Format string to use
+# locale -- Locale in which the format string is to be interpreted
+#
+# Results:
+# Returns the name of the newly-built procedure.
+#
+#----------------------------------------------------------------------
+
+proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
+ if {[namespace which $procName] ne {}} {
+ return $procName
+ }
+
+ # Map away the locale-dependent composite format groups
+
EnterLocale $locale oldLocale
# Change locale if a fresh locale has been given on the command line.
- set status [catch {
+ try {
+ return [ParseClockFormatFormat2 $format $locale $procName]
+ } trap CLOCK {result opts} {
+ dict unset opts -errorinfo
+ return -options $opts $result
+ } finally {
+ # Restore the locale
- # Map away the locale-dependent composite format groups
+ if { [info exists oldLocale] } {
+ mclocale $oldLocale
+ }
+ }
+}
- set format [LocalizeFormat $locale $format]
-
- # Convert the given time to local time.
-
- set date [dict create seconds $clockval]
- set date [ConvertUTCToLocal $date[set date {}] $timezone]
-
- # Extract the fields of the date.
-
- set date [GetJulianDay $date[set date {}]]
- set date [GetGregorianEraYearDay $date[set date {}]]
- set date [GetMonthDay $date[set date {}]]
- set date [GetYearWeekDay $date[set date {}]]
-
- # Format the result
-
- set state {}
- set retval {}
- foreach char [split $format {}] {
- switch -exact -- $state {
- {} {
- if { [string equal % $char] } {
- set state percent
- } else {
- append retval $char
- }
+proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
+ set didLocaleEra 0
+ set didLocaleNumerals 0
+ set preFormatCode \
+ [string map [list @GREGORIAN_CHANGE_DATE@ \
+ [mc GREGORIAN_CHANGE_DATE]] \
+ {
+ variable TZData
+ set date [GetDateFields $clockval \
+ $TZData($timezone) \
+ @GREGORIAN_CHANGE_DATE@]
+ }]
+ set formatString {}
+ set substituents {}
+ set state {}
+
+ set format [LocalizeFormat $locale $format]
+
+ foreach char [split $format {}] {
+ switch -exact -- $state {
+ {} {
+ if { [string equal % $char] } {
+ set state percent
+ } else {
+ append formatString $char
}
- percent { # Character following a '%' character
- set state {}
- switch -exact -- $char {
- % { # A literal character, '%'
- append retval %
- }
- a { # Day of week, abbreviated
- set dow [expr { [dict get $date dayOfWeek] % 7 }]
- append retval \
- [lindex [mc DAYS_OF_WEEK_ABBREV] $dow]
- }
- A { # Day of week, spelt out.
- set dow [expr { [dict get $date dayOfWeek] % 7 }]
- append retval [lindex [mc DAYS_OF_WEEK_FULL] $dow]
- }
- b - h { # Name of month, abbreviated.
- set month [expr { [dict get $date month] - 1 }]
- append retval [lindex [mc MONTHS_ABBREV] $month]
- }
- B { # Name of month, spelt out
- set month [expr { [dict get $date month] - 1 }]
- append retval [lindex [mc MONTHS_FULL] $month]
- }
- C { # Century number
- set cent [expr { [dict get $date year] / 100 }]
- append retval [::format %02d $cent]
- }
- d { # Day of month, with leading zero
- append retval [::format %02d \
- [dict get $date dayOfMonth]]
- }
- e { # Day of month, without leading zero
- append retval [::format %2d \
- [dict get $date dayOfMonth]]
- }
- E { # Format group in a locale-dependent
+ }
+ percent { # Character following a '%' character
+ set state {}
+ switch -exact -- $char {
+ % { # A literal character, '%'
+ append formatString %%
+ }
+ a { # Day of week, abbreviated
+ append formatString %s
+ append substituents \
+ [string map \
+ [list @DAYS_OF_WEEK_ABBREV@ \
+ [list [mc DAYS_OF_WEEK_ABBREV]]] \
+ { [lindex @DAYS_OF_WEEK_ABBREV@ \
+ [expr {[dict get $date dayOfWeek] \
+ % 7}]]}]
+ }
+ A { # Day of week, spelt out.
+ append formatString %s
+ append substituents \
+ [string map \
+ [list @DAYS_OF_WEEK_FULL@ \
+ [list [mc DAYS_OF_WEEK_FULL]]] \
+ { [lindex @DAYS_OF_WEEK_FULL@ \
+ [expr {[dict get $date dayOfWeek] \
+ % 7}]]}]
+ }
+ b - h { # Name of month, abbreviated.
+ append formatString %s
+ append substituents \
+ [string map \
+ [list @MONTHS_ABBREV@ \
+ [list [mc MONTHS_ABBREV]]] \
+ { [lindex @MONTHS_ABBREV@ \
+ [expr {[dict get $date month]-1}]]}]
+ }
+ B { # Name of month, spelt out
+ append formatString %s
+ append substituents \
+ [string map \
+ [list @MONTHS_FULL@ \
+ [list [mc MONTHS_FULL]]] \
+ { [lindex @MONTHS_FULL@ \
+ [expr {[dict get $date month]-1}]]}]
+ }
+ C { # Century number
+ append formatString %02d
+ append substituents \
+ { [expr {[dict get $date year] / 100}]}
+ }
+ d { # Day of month, with leading zero
+ append formatString %02d
+ append substituents { [dict get $date dayOfMonth]}
+ }
+ e { # Day of month, without leading zero
+ append formatString %2d
+ append substituents { [dict get $date dayOfMonth]}
+ }
+ E { # Format group in a locale-dependent
# alternative era
- set state percentE
- if { ![dict exists $date localeEra] } {
- set date [GetLocaleEra $date[set date {}]]
- }
+ set state percentE
+ if {!$didLocaleEra} {
+ append preFormatCode \
+ [string map \
+ [list @LOCALE_ERAS@ \
+ [list [mc LOCALE_ERAS]]] \
+ {
+ set date [GetLocaleEra \
+ $date[set date {}] \
+ @LOCALE_ERAS@]}] \n
+ set didLocaleEra 1
}
- g { # Two-digit year relative to ISO8601
- # week number
- set year \
- [expr { [dict get $date iso8601Year] % 100 }]
- append retval [::format %02d $year]
+ if {!$didLocaleNumerals} {
+ append preFormatCode \
+ [list set localeNumerals \
+ [mc LOCALE_NUMERALS]] \n
+ set didLocaleNumerals 1
}
- G { # Four-digit year relative to ISO8601
+ }
+ g { # Two-digit year relative to ISO8601
# week number
- append retval [::format %04d \
- [dict get $date iso8601Year]]
- }
- H { # Hour in the 24-hour day, leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]]
- }
- I { # Hour AM/PM, with leading zero
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [::format %02d $hour12]
- }
- j { # Day of year (001-366)
- append retval [::format %03d \
- [dict get $date dayOfYear]]
- }
- J { # Julian Day Number
- append retval [::format %07ld \
- [dict get $date julianDay]]
- }
- k { # Hour (0-23), no leading zero
- append retval \
- [::format %2d \
- [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]]
- }
- l { # Hour (12-11), no leading zero
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [::format %2d $hour12]
- }
- m { # Month number, leading zero
- append retval [::format %02d \
- [dict get $date month]]
- }
- M { # Minute of the hour, leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- / 60
- % 60 }]]
- }
- n { # A literal newline
- append retval \n
- }
- N { # Month number, no leading zero
- append retval [::format %2d \
- [dict get $date month]]
- }
- O { # A format group in the locale's
+ append formatString %02d
+ append substituents \
+ { [expr { [dict get $date iso8601Year] % 100 }]}
+ }
+ G { # Four-digit year relative to ISO8601
+ # week number
+ append formatString %02d
+ append substituents { [dict get $date iso8601Year]}
+ }
+ H { # Hour in the 24-hour day, leading zero
+ append formatString %02d
+ append substituents \
+ { [expr { [dict get $date localSeconds] \
+ / 3600 % 24}]}
+ }
+ I { # Hour AM/PM, with leading zero
+ append formatString %02d
+ append substituents \
+ { [expr { ( ( ( [dict get $date localSeconds] \
+ % 86400 ) \
+ + 86400 \
+ - 3600 ) \
+ / 3600 ) \
+ % 12 + 1 }] }
+ }
+ j { # Day of year (001-366)
+ append formatString %03d
+ append substituents { [dict get $date dayOfYear]}
+ }
+ J { # Julian Day Number
+ append formatString %07ld
+ append substituents { [dict get $date julianDay]}
+ }
+ k { # Hour (0-23), no leading zero
+ append formatString %2d
+ append substituents \
+ { [expr { [dict get $date localSeconds]
+ / 3600
+ % 24 }]}
+ }
+ l { # Hour (12-11), no leading zero
+ append formatString %2d
+ append substituents \
+ { [expr { ( ( ( [dict get $date localSeconds]
+ % 86400 )
+ + 86400
+ - 3600 )
+ / 3600 )
+ % 12 + 1 }]}
+ }
+ m { # Month number, leading zero
+ append formatString %02d
+ append substituents { [dict get $date month]}
+ }
+ M { # Minute of the hour, leading zero
+ append formatString %02d
+ append substituents \
+ { [expr { [dict get $date localSeconds]
+ / 60
+ % 60 }]}
+ }
+ n { # A literal newline
+ append formatString \n
+ }
+ N { # Month number, no leading zero
+ append formatString %2d
+ append substituents { [dict get $date month]}
+ }
+ O { # A format group in the locale's
# alternative numerals
- set state percentO
+ set state percentO
+ if {!$didLocaleNumerals} {
+ append preFormatCode \
+ [list set localeNumerals \
+ [mc LOCALE_NUMERALS]] \n
+ set didLocaleNumerals 1
}
- p { # Localized 'AM' or 'PM' indicator
+ }
+ p { # Localized 'AM' or 'PM' indicator
# converted to uppercase
- set tod [expr { [dict get $date localSeconds]
- % 86400 }]
- if { $tod >= ( 86400 / 2 ) } {
- append retval [string toupper [mc PM]]
- } else {
- append retval [string toupper [mc AM]]
- }
- }
- P { # Localized 'AM' or 'PM' indicator
- set tod [expr { [dict get $date localSeconds]
- % 86400 }]
- if { $tod >= ( 86400 / 2 ) } {
- append retval [mc PM]
- } else {
- append retval [mc AM]
- }
- }
- Q { # Hi, Jeff!
- append retval [FormatStarDate $date]
- }
- s { # Seconds from the Posix Epoch
- append retval $clockval
- }
- S { # Second of the minute, with
- # leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- % 60 }]]
- }
- t { # A literal tab character
- append retval \t
- }
- u { # Day of the week (1-Monday, 7-Sunday)
- append retval [dict get $date dayOfWeek]
- }
- U { # Week of the year (00-53). The
+ append formatString %s
+ append preFormatCode \
+ [list set AM [string toupper [mc AM]]] \n \
+ [list set PM [string toupper [mc PM]]] \n
+ append substituents \
+ { [expr {(([dict get $date localSeconds]
+ % 86400) < 43200) ?
+ $AM : $PM}]}
+ }
+ P { # Localized 'AM' or 'PM' indicator
+ append formatString %s
+ append preFormatCode \
+ [list set am [mc AM]] \n \
+ [list set pm [mc PM]] \n
+ append substituents \
+ { [expr {(([dict get $date localSeconds]
+ % 86400) < 43200) ?
+ $am : $pm}]}
+
+ }
+ Q { # Hi, Jeff!
+ append formatString %s
+ append substituents { [FormatStarDate $date]}
+ }
+ s { # Seconds from the Posix Epoch
+ append formatString %s
+ append substituents { [dict get $date seconds]}
+ }
+ S { # Second of the minute, with
+ # leading zero
+ append formatString %02d
+ append substituents \
+ { [expr { [dict get $date localSeconds]
+ % 60 }]}
+ }
+ t { # A literal tab character
+ append formatString \t
+ }
+ u { # Day of the week (1-Monday, 7-Sunday)
+ append formatString %1d
+ append substituents { [dict get $date dayOfWeek]}
+ }
+ U { # Week of the year (00-53). The
# first Sunday of the year is the
# first day of week 01
+ append formatString %02d
+ append preFormatCode {
set dow [dict get $date dayOfWeek]
if { $dow == 7 } {
set dow 0
}
incr dow
- set weekNumber \
- [expr { ( [dict get $date dayOfYear]
+ set UweekNumber \
+ [expr { ( [dict get $date dayOfYear]
- $dow + 7 )
/ 7 }]
- append retval [::format %02d $weekNumber]
}
- V { # The ISO8601 week number
- append retval [::format %02d \
- [dict get $date iso8601Week]]
- }
- w { # Day of the week (0-Sunday,
+ append substituents { $UweekNumber}
+ }
+ V { # The ISO8601 week number
+ append formatString %02d
+ append substituents { [dict get $date iso8601Week]}
+ }
+ w { # Day of the week (0-Sunday,
# 6-Saturday)
- append retval \
- [expr { [dict get $date dayOfWeek] % 7 }]
- }
- W { # Week of the year (00-53). The first
+ append formatString %1d
+ append substituents \
+ { [expr { [dict get $date dayOfWeek] % 7 }]}
+ }
+ W { # Week of the year (00-53). The first
# Monday of the year is the first day
# of week 01.
- set weekNumber \
+ append preFormatCode {
+ set WweekNumber \
[expr { ( [dict get $date dayOfYear]
- [dict get $date dayOfWeek]
- + 7 )
+ + 7 )
/ 7 }]
- append retval [::format %02d $weekNumber]
}
- y { # The two-digit year of the century
- append retval \
- [::format %02d \
- [expr { [dict get $date year] % 100 }]]
- }
- Y { # The four-digit year
- append retval [::format %04d \
- [dict get $date year]]
- }
- z { # The time zone as hours and minutes
+ append formatString %02d
+ append substituents { $WweekNumber}
+ }
+ y { # The two-digit year of the century
+ append formatString %02d
+ append substituents \
+ { [expr { [dict get $date year] % 100 }]}
+ }
+ Y { # The four-digit year
+ append formatString %04d
+ append substituents { [dict get $date year]}
+ }
+ z { # The time zone as hours and minutes
# east (+) or west (-) of Greenwich
- append retval [FormatNumericTimeZone \
- [dict get $date tzOffset]]
- }
- Z { # The name of the time zone
- append retval [dict get $date tzName]
- }
- % { # A literal percent character
- append retval %
- }
- default { # An unknown escape sequence
- append retval % $char
- }
+ append formatString %s
+ append substituents { [FormatNumericTimeZone \
+ [dict get $date tzOffset]]}
+ }
+ Z { # The name of the time zone
+ append formatString %s
+ append substituents { [dict get $date tzName]}
+ }
+ % { # A literal percent character
+ append formatString %%
+ }
+ default { # An unknown escape sequence
+ append formatString %% $char
}
}
- percentE { # Character following %E
- set state {}
- switch -exact -- $char {
- C { # Locale-dependent era
- append retval [dict get $date localeEra]
- }
- y { # Locale-dependent year of the era
+ }
+ percentE { # Character following %E
+ set state {}
+ switch -exact -- $char {
+ E {
+ append formatString %s
+ append substituents { } \
+ [string map \
+ [list @BCE@ [list [mc BCE]] \
+ @CE@ [list [mc CE]]] \
+ {[dict get {BCE @BCE@ CE @CE@} \
+ [dict get $date era]]}]
+ }
+ C { # Locale-dependent era
+ append formatString %s
+ append substituents { [dict get $date localeEra]}
+ }
+ y { # Locale-dependent year of the era
+ append preFormatCode {
set y [dict get $date localeYear]
if { $y >= 0 && $y < 100 } {
- append retval [lindex [mc LOCALE_NUMERALS] $y]
+ set Eyear [lindex $localeNumerals $y]
} else {
- append retval $y
+ set Eyear $y
}
}
- default { # Unknown format group
- append retval %E $char
- }
+ append formatString %s
+ append substituents { $Eyear}
+ }
+ default { # Unknown %E format group
+ append formatString %%E $char
}
}
- percentO { # Character following %O
- set state {}
- switch -exact -- $char {
- d - e { # Day of the month in alternative
- # numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date dayOfMonth]]
- }
- H - k { # Hour of the day in alternative
+ }
+ percentO { # Character following %O
+ set state {}
+ switch -exact -- $char {
+ d - e { # Day of the month in alternative
+ # numerals
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [dict get $date dayOfMonth]]}
+ }
+ H - k { # Hour of the day in alternative
# numerals
- set hour [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]
- append retval [lindex [mc LOCALE_NUMERALS] $hour]
- }
- I - l { # Hour (12-11) AM/PM in alternative
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { [dict get $date localSeconds]
+ / 3600
+ % 24 }]]}
+ }
+ I - l { # Hour (12-11) AM/PM in alternative
# numerals
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [lindex [mc LOCALE_NUMERALS] $hour12]
- }
- m { # Month number in alternative numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date month]]
- }
- M { # Minute of the hour in alternative
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { ( ( ( [dict get $date localSeconds]
+ % 86400 )
+ + 86400
+ - 3600 )
+ / 3600 )
+ % 12 + 1 }]]}
+ }
+ m { # Month number in alternative numerals
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals [dict get $date month]]}
+ }
+ M { # Minute of the hour in alternative
# numerals
- set minute [expr { [dict get $date localSeconds]
- / 60
- % 60 }]
- append retval [lindex [mc LOCALE_NUMERALS] $minute]
- }
- S { # Second of the minute in alternative
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { [dict get $date localSeconds]
+ / 60
+ % 60 }]]}
+ }
+ S { # Second of the minute in alternative
# numerals
- set second [expr { [dict get $date localSeconds]
- % 60 }]
- append retval [lindex [mc LOCALE_NUMERALS] $second]
- }
- u { # Day of the week (Monday=1,Sunday=7)
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { [dict get $date localSeconds]
+ % 60 }]]}
+ }
+ u { # Day of the week (Monday=1,Sunday=7)
# in alternative numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date dayOfWeek]]
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [dict get $date dayOfWeek]]}
}
- w { # Day of the week (Sunday=0,Saturday=6)
+ w { # Day of the week (Sunday=0,Saturday=6)
# in alternative numerals
- append retval \
- [lindex \
- [mc LOCALE_NUMERALS] \
- [expr { [dict get $date dayOfWeek] % 7 }]]
- }
- y { # Year of the century in alternative
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { [dict get $date dayOfWeek] % 7 }]]}
+ }
+ y { # Year of the century in alternative
# numerals
- append retval \
- [lindex \
- [mc LOCALE_NUMERALS] \
- [expr { [dict get $date year] % 100 }]]
- }
- default { # Unknown format group
- append retval %O $char
- }
+ append formatString %s
+ append substituents \
+ { [lindex $localeNumerals \
+ [expr { [dict get $date year] % 100 }]]}
+ }
+ default { # Unknown format group
+ append formatString %%O $char
}
}
}
}
-
- # Clean up any improperly terminated groups
-
- switch -exact -- $state {
- percent {
- append retval %
- }
- percentE {
- append retval %E
- }
- percentO {
- append retval %O
- }
- }
-
- set retval
-
- } result opts]
-
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
}
- if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
- return -code error $result
- } else {
- return -options $opts $result
+ # Clean up any improperly terminated groups
+
+ switch -exact -- $state {
+ percent {
+ append formatString %%
+ }
+ percentE {
+ append retval %%E
+ }
+ percentO {
+ append retval %%O
}
- } else {
- return $result
}
+ proc $procName {clockval timezone} "
+ $preFormatCode
+ return \[::format [list $formatString] $substituents\]
+ "
+
+ # puts [list $procName [info args $procName] [info body $procName]]
+
+ return $procName
}
#----------------------------------------------------------------------
#
# clock scan --
#
-# Inputs a count of seconds since the Posix Epoch as a time
-# of day.
+# Inputs a count of seconds since the Posix Epoch as a time of day.
#
-# The 'clock format' command scans times of day on input.
-# Refer to the user documentation to see what it does.
+# The 'clock format' command scans times of day on input. Refer to the user
+# documentation to see what it does.
#
#----------------------------------------------------------------------
proc ::tcl::clock::scan { args } {
-
set format {}
# Check the count of args
if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
+ set cmdName "clock scan"
return -code error \
-errorcode [list CLOCK wrongNumArgs] \
"wrong \# args: should be\
- \"[lindex [info level 0] 0] string\
+ \"$cmdName string\
?-base seconds?\
?-format string? ?-gmt boolean?\
?-locale LOCALE? ?-timezone ZONE?\""
@@ -1114,7 +1202,7 @@ proc ::tcl::clock::scan { args } {
set string [lindex $args 0]
set format {}
set gmt 0
- set locale C
+ set locale c
set timezone [GetSystemTimeZone]
# Pick up command line options.
@@ -1122,19 +1210,19 @@ proc ::tcl::clock::scan { args } {
foreach { flag value } [lreplace $args 0 0] {
set saw($flag) {}
switch -exact -- $flag {
- -base {
+ -b - -ba - -bas - -base {
set base $value
}
- -format {
+ -f - -fo - -for - -form - -forma - -format {
set format $value
}
- -gmt {
+ -g - -gm - -gmt {
set gmt $value
}
- -locale {
- set locale $value
+ -l - -lo - -loc - -loca - -local - -locale {
+ set locale [string tolower $value]
}
- -timezone {
+ -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
set timezone $value
}
default {
@@ -1154,21 +1242,17 @@ proc ::tcl::clock::scan { args } {
"cannot use -gmt and -timezone in same call"
}
if { [catch { expr { wide($base) } } result] } {
- return -code error \
- "expected integer but got \"$base\""
+ return -code error "expected integer but got \"$base\""
}
- if { ![string is boolean $gmt] } {
- return -code error \
- "expected boolean value but got \"$gmt\""
- } else {
- if { $gmt } {
- set timezone :GMT
- }
+ if { ![string is boolean -strict $gmt] } {
+ return -code error "expected boolean value but got \"$gmt\""
+ } elseif { $gmt } {
+ set timezone :GMT
}
if { ![info exists saw(-format)] } {
- # Perhaps someday we'll localize the legacy code. Right now,
- # it's not localized.
+ # Perhaps someday we'll localize the legacy code. Right now, it's not
+ # localized.
if { [info exists saw(-locale)] } {
return -code error \
-errorcode [list CLOCK flagWithLegacyFormat] \
@@ -1182,32 +1266,23 @@ proc ::tcl::clock::scan { args } {
EnterLocale $locale oldLocale
- set status [catch {
-
+ try {
# Map away the locale-dependent composite format groups
- set format [LocalizeFormat $locale $format]
- set scanner [ParseClockScanFormat $format]
- $scanner $string $base $timezone
-
- } result opts]
+ set scanner [ParseClockScanFormat $format $locale]
+ return [$scanner $string $base $timezone]
+ } trap CLOCK {result opts} {
+ # Conceal location of generation of expected errors
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
- }
+ dict unset opts -errorinfo
+ return -options $opts $result
+ } finally {
+ # Restore the locale
- if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
- return -code error $result
- } else {
- return -options $opts $result
+ if { [info exists oldLocale] } {
+ mclocale $oldLocale
}
- } else {
- return $result
}
-
}
#----------------------------------------------------------------------
@@ -1223,48 +1298,53 @@ proc ::tcl::clock::scan { args } {
# locale - (Unused) Name of the locale where the time will be scanned.
#
# Results:
-# Returns the date and time extracted from the string in seconds
-# from the epoch
+# Returns the date and time extracted from the string in seconds from
+# the epoch
#
#----------------------------------------------------------------------
proc ::tcl::clock::FreeScan { string base timezone locale } {
+ variable TZData
- # Extract year, month and day from the base time for the
- # parser to use as defaults
+ # Get the data for time changes in the given zone
- set date [GetMonthDay \
- [GetGregorianEraYearDay \
- [GetJulianDay \
- [ConvertUTCToLocal \
- [dict create seconds $base] \
- $timezone]]]]
- dict set date secondOfDay [expr { [dict get $date localSeconds]
- % 86400 }]
+ try {
+ SetupTimeZone $timezone
+ } on error {retval opts} {
+ dict unset opts -errorinfo
+ return -options $opts $retval
+ }
- # Parse the date. The parser will return a list comprising
- # date, time, time zone, relative month/day/seconds, relative
- # weekday, ordinal month.
+ # Extract year, month and day from the base time for the parser to use as
+ # defaults
- set status [catch {
- Oldscan $string \
- [dict get $date year] \
- [dict get $date month] \
- [dict get $date dayOfMonth]
- } result]
- if { $status != 0 } {
- return -code error "unable to convert date-time string \"$string\""
- }
+ set date [GetDateFields $base $TZData($timezone) 2361222]
+ dict set date secondOfDay [expr {
+ [dict get $date localSeconds] % 86400
+ }]
+
+ # Parse the date. The parser will return a list comprising date, time,
+ # time zone, relative month/day/seconds, relative weekday, ordinal month.
- foreach { parseDate parseTime parseZone parseRel
- parseWeekday parseOrdinalMonth } $result break
+ try {
+ set scanned [Oldscan $string \
+ [dict get $date year] \
+ [dict get $date month] \
+ [dict get $date dayOfMonth]]
+ lassign $scanned \
+ parseDate parseTime parseZone parseRel \
+ parseWeekday parseOrdinalMonth
+ } on error message {
+ return -code error \
+ "unable to convert date-time string \"$string\": $message"
+ }
- # If the caller supplied a date in the string, update the 'date' dict
- # with the value. If the caller didn't specify a time with the date,
- # default to midnight.
+ # If the caller supplied a date in the string, update the 'date' dict with
+ # the value. If the caller didn't specify a time with the date, default to
+ # midnight.
if { [llength $parseDate] > 0 } {
- foreach { y m d } $parseDate break
+ lassign $parseDate y m d
if { $y < 100 } {
if { $y >= 39 } {
incr y 1900
@@ -1281,62 +1361,60 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
}
}
- # If the caller supplied a time zone in the string, it comes back
- # as a two-element list; the first element is the number of minutes
- # east of Greenwich, and the second is a Daylight Saving Time
- # indicator ( 1 == yes, 0 == no, -1 == unknown ). We make it into
- # a time zone indicator of +-hhmm.
-
+ # If the caller supplied a time zone in the string, it comes back as a
+ # two-element list; the first element is the number of minutes east of
+ # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes,
+ # 0 == no, -1 == unknown). We make it into a time zone indicator of
+ # +-hhmm.
+
if { [llength $parseZone] > 0 } {
- foreach { minEast dstFlag } $parseZone break
+ lassign $parseZone minEast dstFlag
set timezone [FormatNumericTimeZone \
[expr { 60 * $minEast + 3600 * $dstFlag }]]
+ SetupTimeZone $timezone
}
dict set date tzName $timezone
# Assemble date, time, zone into seconds-from-epoch
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
if { $parseTime ne {} } {
dict set date secondOfDay $parseTime
- } elseif { [llength $parseWeekday] != 0
- || [llength $parseOrdinalMonth] != 0
- || ( [llength $parseRel] != 0
+ } elseif { [llength $parseWeekday] != 0
+ || [llength $parseOrdinalMonth] != 0
+ || ( [llength $parseRel] != 0
&& ( [lindex $parseRel 0] != 0
|| [lindex $parseRel 1] != 0 ) ) } {
dict set date secondOfDay 0
}
- dict set date localSeconds \
- [expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
+ dict set date localSeconds [expr {
+ -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay]
+ }]
dict set date tzName $timezone
- set date [ConvertLocalToUTC $date[set date {}]]
+ set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
set seconds [dict get $date seconds]
# Do relative times
if { [llength $parseRel] > 0 } {
- foreach { relMonth relDay relSecond } $parseRel break
+ lassign $parseRel relMonth relDay relSecond
set seconds [add $seconds \
$relMonth months $relDay days $relSecond seconds \
-timezone $timezone -locale $locale]
- }
+ }
# Do relative weekday
-
- if { [llength $parseWeekday] > 0 } {
- foreach {dayOrdinal dayOfWeek} $parseWeekday break
- set date2 [GetJulianDay \
- [ConvertUTCToLocal \
- [dict create seconds $seconds] \
- $timezone]]
+ if { [llength $parseWeekday] > 0 } {
+ lassign $parseWeekday dayOrdinal dayOfWeek
+ set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
dict set date2 era CE
- set jdwkday [WeekdayOnOrBefore $dayOfWeek \
- [expr { [dict get $date2 julianDay]
- + 6 }]]
+ set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr {
+ [dict get $date2 julianDay] + 6
+ }]]
incr jdwkday [expr { 7 * $dayOrdinal }]
if { $dayOrdinal > 0 } {
incr jdwkday -7
@@ -1344,21 +1422,21 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
dict set date2 secondOfDay \
[expr { [dict get $date2 localSeconds] % 86400 }]
dict set date2 julianDay $jdwkday
- dict set date2 localSeconds \
- [expr { -210866803200
- + ( 86400 * wide([dict get $date2 julianDay]) )
- + [dict get $date secondOfDay] }]
+ dict set date2 localSeconds [expr {
+ -210866803200
+ + ( 86400 * wide([dict get $date2 julianDay]) )
+ + [dict get $date secondOfDay]
+ }]
dict set date2 tzName $timezone
- set date2 [ConvertLocalToUTC $date2[set date2 {}]]
+ set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
+ 2361222]
set seconds [dict get $date2 seconds]
-
}
# Do relative month
if { [llength $parseOrdinalMonth] > 0 } {
-
- foreach {monthOrdinal monthNumber} $parseOrdinalMonth break
+ lassign $parseOrdinalMonth monthOrdinal monthNumber
if { $monthOrdinal > 0 } {
set monthDiff [expr { $monthNumber - [dict get $date month] }]
if { $monthDiff <= 0 } {
@@ -1374,7 +1452,6 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
}
set seconds [add $seconds $monthOrdinal years $monthDiff months \
-timezone $timezone -locale $locale]
-
}
return $seconds
@@ -1388,45 +1465,48 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# Parses a format string given to [clock scan -format]
#
# Parameters:
-# None.
+# formatString - The format being parsed
+# locale - The current locale
#
# Results:
-# Constructs and returns a procedure that accepts the
-# string being scanned, the base time, and the time zone.
-# The procedure will either return the scanned time or
-# else throw an error that should be rethrown to the caller
-# of [clock scan]
+# Constructs and returns a procedure that accepts the string being
+# scanned, the base time, and the time zone. The procedure will either
+# return the scanned time or else throw an error that should be rethrown
+# to the caller of [clock scan]
#
# Side effects:
-# The given procedure is defined in the ::tcl::clock
-# namespace. Scan procedures are not deleted once installed.
-#
-# Why do we parse dates by defining a procedure to parse them?
-# The reason is that by doing so, we have one convenient place to
-# cache all the information: the regular expressions that match the
-# patterns (which will be compiled), the code that assembles the
-# date information, everything lands in one place. In this way,
-# when a given format is reused at run time, all the information
+# The given procedure is defined in the ::tcl::clock namespace. Scan
+# procedures are not deleted once installed.
+#
+# Why do we parse dates by defining a procedure to parse them? The reason is
+# that by doing so, we have one convenient place to cache all the information:
+# the regular expressions that match the patterns (which will be compiled),
+# the code that assembles the date information, everything lands in one place.
+# In this way, when a given format is reused at run time, all the information
# of how to apply it is available in a single place.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::ParseClockScanFormat { formatString } {
+proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
+ # Check whether the format has been parsed previously, and return the
+ # existing recognizer if it has.
+
+ set procName scanproc'$formatString'$locale
+ set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
+ if { [namespace which $procName] != {} } {
+ return $procName
+ }
variable DateParseActions
variable TimeParseActions
- # Condense whitespace
+ # Localize the %x, %X, etc. groups
- regsub -all {[[:space:]]+} $formatString { } formatString
+ set formatString [LocalizeFormat $locale $formatString]
- # Check whether the format has been parsed previously, and return
- # the existing recognizer if it has.
+ # Condense whitespace
- set procName [namespace current]::scanproc'$formatString'[mclocale]
- if { [info procs $procName] != {} } {
- return $procName
- }
+ regsub -all {[[:space:]]+} $formatString { } formatString
# Walk through the groups of the format string. In this loop, we
# accumulate:
@@ -1453,8 +1533,8 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
append re {[[:space:]]+}
} else {
if { ! [string is alnum $c] } {
- append re \\
- }
+ append re "\\"
+ }
append re $c
}
}
@@ -1473,16 +1553,16 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
i {7 1 2 3 4 5 6} \
abr [mc DAYS_OF_WEEK_ABBREV] \
full [mc DAYS_OF_WEEK_FULL] {
- dict set l $abr $i
- dict set l $full $i
+ dict set l [string tolower $abr] $i
+ dict set l [string tolower $full] $i
incr i
}
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet dayOfWeek [incr fieldCount]
append postcode "dict set date dayOfWeek \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
+ "dict get " [list $lookup] " " \
+ \[ {string tolower $field} [incr captureCount] \] \
"\]\n"
}
b - B - h { # Name of month
@@ -1492,15 +1572,16 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
abr [mc MONTHS_ABBREV] \
full [mc MONTHS_FULL] {
incr i
- dict set l $abr $i
- dict set l $full $i
+ dict set l [string tolower $abr] $i
+ dict set l [string tolower $full] $i
}
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
+ "dict get " [list $lookup] \
+ " " \[ {string tolower $field} \
+ [incr captureCount] \] \
"\]\n"
}
C { # Gregorian century
@@ -1570,7 +1651,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"::scan \$field" [incr captureCount] " %ld" \
"\]\n"
}
- m - N { # Month number
+ m - N { # Month number
append re \\s*(\\d\\d?)
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
@@ -1591,8 +1672,9 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
set state %O
}
p - P { # AM/PM indicator
- set l [list [mc AM] 0 [mc PM] 1]
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ set l [list [string tolower [mc AM]] 0 \
+ [string tolower [mc PM]] 1]
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet amPmIndicator [incr fieldCount]
append postcode "dict set date amPmIndicator \[" \
@@ -1612,10 +1694,9 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
\] \n
}
s { # Seconds from Posix Epoch
- # This next case is insanely difficult,
- # because it's problematic to determine
- # whether the field is actually within
- # the range of a wide integer.
+ # This next case is insanely difficult, because it's
+ # problematic to determine whether the field is
+ # actually within the range of a wide integer.
append re {\s*([-+]?\d+)}
dict set fieldSet seconds [incr fieldCount]
append postcode {dict set date seconds } \[ \
@@ -1648,14 +1729,13 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
dict set date dayOfWeek $dow
}
}
- U { # Week of year. The
- # first Sunday of the year is the
- # first day of week 01. No scan rule
- # uses this group.
+ U { # Week of year. The first Sunday of
+ # the year is the first day of week
+ # 01. No scan rule uses this group.
append re \\s*\\d\\d?
}
V { # Week of ISO8601 year
-
+
append re \\s*(\\d\\d?)
dict set fieldSet iso8601Week [incr fieldCount]
append postcode "dict set date iso8601Week \[" \
@@ -1718,17 +1798,33 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
C { # Locale-dependent era
set d {}
foreach triple [mc LOCALE_ERAS] {
- foreach {t symbol year} $triple break
- dict set d $symbol $year
+ lassign $triple t symbol year
+ dict set d [string tolower $symbol] $year
}
- foreach { regex lookup } [UniquePrefixRegexp $d] break
+ lassign [UniquePrefixRegexp $d] regex lookup
append re (?: $regex )
-
+ }
+ E {
+ set l {}
+ dict set l [string tolower [mc BCE]] BCE
+ dict set l [string tolower [mc CE]] CE
+ dict set l b.c.e. BCE
+ dict set l c.e. CE
+ dict set l b.c. BCE
+ dict set l a.d. CE
+ lassign [UniquePrefixRegexp $l] regex lookup
+ append re ( $regex )
+ dict set fieldSet era [incr fieldCount]
+ append postcode "dict set date era \["\
+ "dict get " [list $lookup] \
+ { } \[ {string tolower $field} \
+ [incr captureCount] \] \
+ "\]\n"
}
y { # Locale-dependent year of the era
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
- incr fieldCount
+ incr captureCount
}
default {
append re %E
@@ -1743,7 +1839,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
%O {
switch -exact -- $c {
d - e {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet dayOfMonth [incr fieldCount]
append postcode "dict set date dayOfMonth \[" \
@@ -1752,7 +1848,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
H - k {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet hour [incr fieldCount]
append postcode "dict set date hour \[" \
@@ -1761,7 +1857,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
I - l {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet hourAMPM [incr fieldCount]
append postcode "dict set date hourAMPM \[" \
@@ -1770,7 +1866,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
m {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
@@ -1779,7 +1875,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
M {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet minute [incr fieldCount]
append postcode "dict set date minute \[" \
@@ -1788,7 +1884,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
S {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet second [incr fieldCount]
append postcode "dict set date second \[" \
@@ -1797,7 +1893,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"\]\n"
}
u - w {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet dayOfWeek [incr fieldCount]
append postcode "set dow \[dict get " [list $lookup] \
@@ -1811,10 +1907,10 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
"day of week is greater than 7"
}
dict set date dayOfWeek $dow
- }
+ }
}
y {
- foreach {regex lookup} [LocaleNumeralMatcher] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet yearOfCentury [incr fieldCount]
append postcode {dict set date yearOfCentury } \[ \
@@ -1841,6 +1937,7 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
# Build the procedure
set procBody {}
+ append procBody "variable ::tcl::clock::TZData" \n
append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->"
for { set i 1 } { $i <= $captureCount } { incr i } {
append procBody " " field $i
@@ -1854,6 +1951,22 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
append procBody "set date \[dict create\]" \n
append procBody {dict set date tzName $timeZone} \n
append procBody $postcode
+ append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
+
+ # Set up the time zone before doing anything with a default base date
+ # that might need a timezone to interpret it.
+
+ if { ![dict exists $fieldSet seconds]
+ && ![dict exists $fieldSet starDate] } {
+ if { [dict exists $fieldSet tzName] } {
+ append procBody {
+ set timeZone [dict get $date tzName]
+ }
+ }
+ append procBody {
+ ::tcl::clock::SetupTimeZone $timeZone
+ }
+ }
# Add code that gets Julian Day Number from the fields.
@@ -1863,26 +1976,29 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]
- # Assemble seconds, and convert local nominal time to UTC.
+ # Assemble seconds from the Julian day and second of the day.
+ # Convert to local time unless epoch seconds or stardate are
+ # being processed - they're always absolute
- if { ![dict exists $fieldSet seconds]
+ if { ![dict exists $fieldSet seconds]
&& ![dict exists $fieldSet starDate] } {
append procBody {
if { [dict get $date julianDay] > 5373484 } {
return -code error -errorcode [list CLOCK dateTooLarge] \
"requested date too large to represent"
}
- dict set date localSeconds \
- [expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
+ dict set date localSeconds [expr {
+ -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay]
+ }]
}
- }
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
+ # Finally, convert the date to local time
+
append procBody {
- set date [::tcl::clock::ConvertLocalToUTC $date[set date {}]]
+ set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
+ $TZData($timeZone) $changeover]
}
}
@@ -1896,31 +2012,28 @@ proc ::tcl::clock::ParseClockScanFormat { formatString } {
return $procName
}
-
+
#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
#
-# Composes a regexp that captures the numerals in the given
-# locale, and a dictionary to map them to conventional numerals.
+# Composes a regexp that captures the numerals in the given locale, and
+# a dictionary to map them to conventional numerals.
#
# Parameters:
-# none.
+# locale - Name of the current locale
#
# Results:
-# Returns a two-element list comprising the regexp and the
-# dictionary.
+# Returns a two-element list comprising the regexp and the dictionary.
#
# Side effects:
# Caches the result.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::LocaleNumeralMatcher {} {
-
+proc ::tcl::clock::LocaleNumeralMatcher {l} {
variable LocaleNumeralCache
- set l [mclocale]
if { ![dict exists $LocaleNumeralCache $l] } {
set d {}
set i 0
@@ -1937,16 +2050,16 @@ proc ::tcl::clock::LocaleNumeralMatcher {} {
}
return [dict get $LocaleNumeralCache $l]
}
-
+
#----------------------------------------------------------------------
#
# UniquePrefixRegexp --
#
-# Composes a regexp that performs unique-prefix matching. The
-# RE matches one of a supplied set of strings, or any unique
-# prefix thereof.
+# Composes a regexp that performs unique-prefix matching. The RE
+# matches one of a supplied set of strings, or any unique prefix
+# thereof.
#
# Parameters:
# data - List of alternating match-strings and values.
@@ -1954,10 +2067,10 @@ proc ::tcl::clock::LocaleNumeralMatcher {} {
# distinct.
#
# Results:
-# Returns a two-element list. The first is a regexp that
-# matches any unique prefix of any of the strings. The second
-# is a dictionary whose keys are match values from the regexp
-# and whose values are the corresponding values from 'data'.
+# Returns a two-element list. The first is a regexp that matches any
+# unique prefix of any of the strings. The second is a dictionary whose
+# keys are match values from the regexp and whose values are the
+# corresponding values from 'data'.
#
# Side effects:
# None.
@@ -1965,11 +2078,10 @@ proc ::tcl::clock::LocaleNumeralMatcher {} {
#----------------------------------------------------------------------
proc ::tcl::clock::UniquePrefixRegexp { data } {
-
- # The 'successors' dictionary will contain, for each string that
- # is a prefix of any key, all characters that may follow that
- # prefix. The 'prefixMapping' dictionary will have keys that
- # are prefixes of keys and values that correspond to the keys.
+ # The 'successors' dictionary will contain, for each string that is a
+ # prefix of any key, all characters that may follow that prefix. The
+ # 'prefixMapping' dictionary will have keys that are prefixes of keys and
+ # values that correspond to the keys.
set prefixMapping [dict create]
set successors [dict create {} {}]
@@ -1977,8 +2089,7 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
# Walk the key-value pairs
foreach { key value } $data {
-
- # Construct all prefixes of the key;
+ # Construct all prefixes of the key;
set prefix {}
foreach char [split $key {}] {
@@ -1996,8 +2107,8 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
}
}
- # Identify those prefixes that designate unique values, and
- # those that are the full keys
+ # Identify those prefixes that designate unique values, and those that are
+ # the full keys
set uniquePrefixMapping {}
dict for { key valueList } $prefixMapping {
@@ -2020,8 +2131,8 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
#
# MakeUniquePrefixRegexp --
#
-# Service procedure for 'UniquePrefixRegexp' that constructs
-# a regular expresison that matches the unique prefixes.
+# Service procedure for 'UniquePrefixRegexp' that constructs a regular
+# expresison that matches the unique prefixes.
#
# Parameters:
# successors - Dictionary whose keys are all prefixes
@@ -2033,18 +2144,17 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
# prefixString - Current prefix being processed.
#
# Results:
-# Returns a constructed regular expression that matches the set
-# of unique prefixes beginning with the 'prefixString'.
+# Returns a constructed regular expression that matches the set of
+# unique prefixes beginning with the 'prefixString'.
#
# Side effects:
# None.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::MakeUniquePrefixRegexp { successors
+proc ::tcl::clock::MakeUniquePrefixRegexp { successors
uniquePrefixMapping
prefixString } {
-
# Get the characters that may follow the current prefix string
set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
@@ -2052,13 +2162,15 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
return {}
}
- # If there is more than one successor character, or if the current
- # prefix is a unique prefix, surround the generated re with non-capturing
+ # If there is more than one successor character, or if the current prefix
+ # is a unique prefix, surround the generated re with non-capturing
# parentheses.
set re {}
- if { [dict exists $uniquePrefixMapping $prefixString]
- || [llength $schars] > 1 } {
+ if {
+ [dict exists $uniquePrefixMapping $prefixString]
+ || [llength $schars] > 1
+ } then {
append re "(?:"
}
@@ -2080,7 +2192,7 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
if { [dict exists $uniquePrefixMapping $prefixString] } {
append re ")?"
- } elseif { [llength $schars] > 1 } {
+ } elseif { [llength $schars] > 1 } {
append re ")"
}
@@ -2091,8 +2203,8 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
#
# MakeParseCodeFromFields --
#
-# Composes Tcl code to extract the Julian Day Number from a
-# dictionary containing date fields.
+# Composes Tcl code to extract the Julian Day Number from a dictionary
+# containing date fields.
#
# Parameters:
# dateFields -- Dictionary whose keys are fields of the date,
@@ -2103,8 +2215,8 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
# the list must be in ascending order by priority
#
# Results:
-# Returns a burst of code that extracts the day number from the
-# given date.
+# Returns a burst of code that extracts the day number from the given
+# date.
#
# Side effects:
# None.
@@ -2112,7 +2224,6 @@ proc ::tcl::clock::MakeUniquePrefixRegexp { successors
#----------------------------------------------------------------------
proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
-
set currPrio 999
set currFieldPos [list]
set currCodeBurst {
@@ -2120,16 +2231,15 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
}
foreach { fieldSet prio parseAction } $parseActions {
-
- # If we've found an answer that's better than any that follow,
- # quit now.
+ # If we've found an answer that's better than any that follow, quit
+ # now.
if { $prio > $currPrio } {
break
}
- # Accumulate the field positions that are used in the current
- # field grouping.
+ # Accumulate the field positions that are used in the current field
+ # grouping.
set fieldPos [list]
set ok true
@@ -2152,9 +2262,11 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
if { $prio == $currPrio } {
foreach currPos $currFieldPos newPos $fPos {
- if { ![string is integer $newPos]
- || ![string is integer $currPos]
- || $newPos > $currPos } {
+ if {
+ ![string is integer $newPos]
+ || ![string is integer $currPos]
+ || $newPos > $currPos
+ } then {
break
}
if { $newPos < $currPos } {
@@ -2172,11 +2284,9 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
set currPrio $prio
set currFieldPos $fPos
set currCodeBurst $parseAction
-
}
return $currCodeBurst
-
}
#----------------------------------------------------------------------
@@ -2194,14 +2304,13 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
# Returns the locale that was previously current.
#
# Side effects:
-# Does [mclocale]. If necessary, uses [mcload] to load the
-# designated locale's files, and tracks that it has done so
-# in the 'McLoaded' variable.
+# Does [mclocale]. If necessary, uses [mcload] to load the designated
+# locale's files, and tracks that it has done so in the 'McLoaded'
+# variable.
#
#----------------------------------------------------------------------
proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
-
upvar 1 $oldLocaleVar oldLocale
variable MsgDir
@@ -2209,32 +2318,29 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
set oldLocale [mclocale]
if { $locale eq {system} } {
-
if { $::tcl_platform(platform) ne {windows} } {
-
- # On a non-windows platform, the 'system' locale is
- # the same as the 'current' locale
+ # On a non-windows platform, the 'system' locale is the same as
+ # the 'current' locale
set locale current
} else {
-
- # On a windows platform, the 'system' locale is
- # adapted from the 'current' locale by applying the
- # date and time formats from the Control Panel.
- # First, load the 'current' locale if it's not yet loaded
+ # On a windows platform, the 'system' locale is adapted from the
+ # 'current' locale by applying the date and time formats from the
+ # Control Panel. First, load the 'current' locale if it's not yet
+ # loaded
if {![dict exists $McLoaded $oldLocale] } {
mcload $MsgDir
dict set McLoaded $oldLocale {}
}
- # Make a new locale string for the system locale, and
- # get the Control Panel information
+ # Make a new locale string for the system locale, and get the
+ # Control Panel information
set locale ${oldLocale}_windows
if { ![dict exists $McLoaded $locale] } {
LoadWindowsDateTimeFormats $locale
- dict set mcloaded $locale {}
+ dict set McLoaded $locale {}
}
}
}
@@ -2250,15 +2356,14 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
mcload $MsgDir
dict set McLoaded $locale {}
}
-
-}
+}
#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
-# Load the date/time formats from the Control Panel in Windows
-# and convert them so that they're usable by Tcl.
+# Load the date/time formats from the Control Panel in Windows and
+# convert them so that they're usable by Tcl.
#
# Parameters:
# locale - Name of the locale in whose message catalog
@@ -2270,14 +2375,12 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
# Side effects:
# Updates the given message catalog with the locale strings.
#
-# Presumes that on entry, [mclocale] is set to the current locale,
-# so that default strings can be obtained if the Registry query
-# fails.
+# Presumes that on entry, [mclocale] is set to the current locale, so that
+# default strings can be obtained if the Registry query fails.
#
#----------------------------------------------------------------------
proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
-
# Bail out if we can't find the Registry
variable NoRegistry
@@ -2379,7 +2482,6 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
}
return
-
}
#----------------------------------------------------------------------
@@ -2394,8 +2496,8 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
# format -- Format supplied to [clock scan] or [clock format]
#
# Results:
-# Returns the string with locale-dependent composite format
-# groups substituted out.
+# Returns the string with locale-dependent composite format groups
+# substituted out.
#
# Side effects:
# None.
@@ -2403,7 +2505,6 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
#----------------------------------------------------------------------
proc ::tcl::clock::LocalizeFormat { locale format } {
-
variable McLoaded
if { [dict exists $McLoaded $locale FORMAT $format] } {
@@ -2411,26 +2512,29 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
}
set inFormat $format
- # Handle locale-dependent format groups by mapping them out of
- # the input string. Note that the order of the [string map]
- # operations is significant because earlier formats can refer
- # to later ones; for example %c can refer to %X, which in turn
- # can refer to %T.
-
- set format [string map [list %c [mc DATE_TIME_FORMAT] \
- %Ec [mc LOCALE_DATE_TIME_FORMAT]] $format]
- set format [string map [list %x [mc DATE_FORMAT] \
- %Ex [mc LOCALE_DATE_FORMAT] \
- %X [mc TIME_FORMAT] \
- %EX [mc LOCALE_TIME_FORMAT]] $format]
- set format [string map [list %r [mc TIME_FORMAT_12] \
- %R [mc TIME_FORMAT_24] \
- %T [mc TIME_FORMAT_24_SECS]] $format]
- set format [string map [list %D %m/%d/%Y \
- %EY [mc LOCALE_YEAR_FORMAT]\
- %+ {%a %b %e %H:%M:%S %Z %Y}] $format]
-
- dict set McLoaded $locale FORMAT $format $inFormat
+ # Handle locale-dependent format groups by mapping them out of the format
+ # string. Note that the order of the [string map] operations is
+ # significant because later formats can refer to later ones; for example
+ # %c can refer to %X, which in turn can refer to %T.
+
+ set list {
+ %% %%
+ %D %m/%d/%Y
+ %+ {%a %b %e %H:%M:%S %Z %Y}
+ }
+ lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]]
+ lappend list %T [string map $list [mc TIME_FORMAT_24_SECS]]
+ lappend list %R [string map $list [mc TIME_FORMAT_24]]
+ lappend list %r [string map $list [mc TIME_FORMAT_12]]
+ lappend list %X [string map $list [mc TIME_FORMAT]]
+ lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
+ lappend list %x [string map $list [mc DATE_FORMAT]]
+ lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
+ lappend list %c [string map $list [mc DATE_TIME_FORMAT]]
+ lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
+ set format [string map $list $format]
+
+ dict set McLoaded $locale FORMAT $inFormat $format
return $format
}
@@ -2452,7 +2556,6 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
#----------------------------------------------------------------------
proc ::tcl::clock::FormatNumericTimeZone { z } {
-
if { $z < 0 } {
set z [expr { - $z }]
set retval -
@@ -2467,10 +2570,8 @@ proc ::tcl::clock::FormatNumericTimeZone { z } {
append retval [::format %02d $z]
}
return $retval
-
}
-
#----------------------------------------------------------------------
#
# FormatStarDate --
@@ -2493,7 +2594,6 @@ proc ::tcl::clock::FormatNumericTimeZone { z } {
#----------------------------------------------------------------------
proc ::tcl::clock::FormatStarDate { date } {
-
variable Roddenberry
# Get day of year, zero based
@@ -2502,11 +2602,7 @@ proc ::tcl::clock::FormatStarDate { date } {
# Determine whether the year is a leap year
- if { [dict get $date gregorian] } {
- set lp [IsGregorianLeapYear $date]
- } else {
- set lp [expr { [dict get $date year] % 4 == 0 }]
- }
+ set lp [IsGregorianLeapYear $date]
# Convert day of year to a fractional year
@@ -2548,12 +2644,12 @@ proc ::tcl::clock::FormatStarDate { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
-
variable Roddenberry
# Build a tentative date from year and fraction.
set date [dict create \
+ gregorian 1 \
era CE \
year [expr { $year + $Roddenberry }] \
dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
@@ -2561,14 +2657,10 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
# Determine whether the given year is a leap year
- if { [dict get $date gregorian] } {
- set lp [IsGregorianLeapYear $date]
- } else {
- set lp [expr { [dict get $date year] % 4 == 0 }]
- }
+ set lp [IsGregorianLeapYear $date]
- # Reconvert the fractional year according to whether the given
- # year is a leap year
+ # Reconvert the fractional year according to whether the given year is a
+ # leap year
if { $lp } {
dict set date dayOfYear \
@@ -2581,10 +2673,11 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
dict unset date gregorian
set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
- return [expr { 86400 * [dict get $date julianDay]
- - 210866803200
- + ( 86400 / 10 ) * $fractDay }]
-
+ return [expr {
+ 86400 * [dict get $date julianDay]
+ - 210866803200
+ + ( 86400 / 10 ) * $fractDay
+ }]
}
#----------------------------------------------------------------------
@@ -2597,8 +2690,8 @@ proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
# str - String containing a decimal wide integer
#
# Results:
-# Returns the string as a pure wide integer. Throws an error if
-# the string is misformatted or out of range.
+# Returns the string as a pure wide integer. Throws an error if the
+# string is misformatted or out of range.
#
#----------------------------------------------------------------------
@@ -2619,8 +2712,8 @@ proc ::tcl::clock::ScanWide { str } {
#
# InterpretTwoDigitYear --
#
-# Given a date that contains only the year of the century,
-# determines the target value of a two-digit year.
+# Given a date that contains only the year of the century, determines
+# the target value of a two-digit year.
#
# Parameters:
# date - Dictionary containing fields of the date.
@@ -2637,18 +2730,17 @@ proc ::tcl::clock::ScanWide { str } {
# Side effects:
# None.
#
-# The current rule for interpreting a two-digit year is that the year
-# shall be between 1937 and 2037, thus staying within the range of a
-# 32-bit signed value for time. This rule may change to a sliding
-# window in future versions, so the 'baseTime' parameter (which is
-# currently ignored) is provided in the procedure signature.
+# The current rule for interpreting a two-digit year is that the year shall be
+# between 1937 and 2037, thus staying within the range of a 32-bit signed
+# value for time. This rule may change to a sliding window in future
+# versions, so the 'baseTime' parameter (which is currently ignored) is
+# provided in the procedure signature.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
+proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
{ twoDigitField yearOfCentury }
{ fourDigitField year } } {
-
set yr [dict get $date $twoDigitField]
if { $yr <= 37 } {
dict set date $fourDigitField [expr { $yr + 2000 }]
@@ -2656,7 +2748,6 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
dict set date $fourDigitField [expr { $yr + 1900 }]
}
return $date
-
}
#----------------------------------------------------------------------
@@ -2669,6 +2760,9 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
# date - Dictionary value to update
# baseTime - Base time from which to extract the year, expressed
# in seconds from the Posix epoch
+# timezone - the time zone in which the date is being scanned
+# changeover - the Julian Day on which the Gregorian calendar
+# was adopted in the target locale.
#
# Results:
# Returns the dictionary with the current year assigned.
@@ -2678,15 +2772,13 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } {
+proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
+ variable TZData
# Find the Julian Day Number corresponding to the base time, and
# find the Gregorian year corresponding to that Julian Day.
- set date2 [dict create seconds $baseTime]
- set date2 [ConvertUTCToLocal $date2[set date2 {}] $timeZone]
- set date2 [GetJulianDay $date2[set date2 {}]]
- set date2 [GetGregorianEraYearDay $date2[set date2 {}]]
+ set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
# Store the converted year
@@ -2694,7 +2786,6 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } {
dict set date year [dict get $date2 year]
return $date
-
}
#----------------------------------------------------------------------
@@ -2707,6 +2798,9 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } {
# date - Dictionary containing the fields of the date that
# is to be augmented with the base year.
# baseTime - Base time expressed in seconds from the Posix epoch.
+# timeZone - Target time zone
+# changeover - Julian Day of adoption of the Gregorian calendar in
+# the target locale.
#
# Results:
# Returns the given date with "iso8601Year" set to the
@@ -2717,17 +2811,15 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timeZone } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AssignBaseIso8601Year { date baseTime timeZone } {
+proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
+ variable TZData
# Find the Julian Day Number corresponding to the base time
- set date2 [dict create seconds $baseTime]
- set date2 [ConvertUTCToLocal $date2[set date2 {}] $timeZone]
- set date2 [GetJulianDay $date2[set date2 {}]]
+ set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
# Calculate the ISO8601 date and transfer the year
- set date2 [GetYearWeekDay $date2[set date2 {}]]
dict set date era CE
dict set date iso8601Year [dict get $date2 iso8601Year]
return $date
@@ -2737,13 +2829,15 @@ proc ::tcl::clock::AssignBaseIso8601Year { date baseTime timeZone } {
#
# AssignBaseMonth --
#
-# Places the number of the current year and month into a
+# Places the number of the current year and month into a
# dictionary.
#
# Parameters:
# date - Dictionary value to update
# baseTime - Time from which the year and month are to be
# obtained, expressed in seconds from the Posix epoch.
+# timezone - Name of the desired time zone
+# changeover - Julian Day on which the Gregorian calendar was adopted.
#
# Results:
# Returns the dictionary with the base year and month assigned.
@@ -2753,23 +2847,16 @@ proc ::tcl::clock::AssignBaseIso8601Year { date baseTime timeZone } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AssignBaseMonth { date baseTime timeZone } {
-
- # Find the Julian Day Number corresponding to the base time
-
- set date2 [dict create seconds $baseTime]
- set date2 [ConvertUTCToLocal $date2[set date2 {}] $timeZone]
- set date2 [GetJulianDay $date2[set date2 {}]]
+proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
+ variable TZData
- # Find the Gregorian year corresponding to that Julian Day
+ # Find the year and month corresponding to the base time
- set date2 [GetGregorianEraYearDay $date2[set date2 {}]]
- set date2 [GetMonthDay $date2[set date2 {}]]
+ set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
dict set date era [dict get $date2 era]
dict set date year [dict get $date2 year]
dict set date month [dict get $date2 month]
return $date
-
}
#----------------------------------------------------------------------
@@ -2782,6 +2869,8 @@ proc ::tcl::clock::AssignBaseMonth { date baseTime timeZone } {
# date - Dictionary containing the fields of the date that
# is to be augmented with the base year and week.
# baseTime - Base time expressed in seconds from the Posix epoch.
+# changeover - Julian Day on which the Gregorian calendar was adopted
+# in the target locale.
#
# Results:
# Returns the given date with "iso8601Year" set to the
@@ -2792,17 +2881,15 @@ proc ::tcl::clock::AssignBaseMonth { date baseTime timeZone } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AssignBaseWeek { date baseTime timeZone } {
+proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {
+ variable TZData
# Find the Julian Day Number corresponding to the base time
- set date2 [dict create seconds $baseTime]
- set date2 [ConvertUTCToLocal $date2[set date2 {}] $timeZone]
- set date2 [GetJulianDay $date2[set date2 {}]]
+ set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
# Calculate the ISO8601 date and transfer the year
- set date2 [GetYearWeekDay $date2[set date2 {}]]
dict set date era CE
dict set date iso8601Year [dict get $date2 iso8601Year]
dict set date iso8601Week [dict get $date2 iso8601Week]
@@ -2818,6 +2905,8 @@ proc ::tcl::clock::AssignBaseWeek { date baseTime timeZone } {
# Parameters:
# date - Dictionary that is to get the base day
# baseTime - Base time expressed in seconds from the Posix epoch
+# changeover - Julian day on which the Gregorian calendar was
+# adpoted in the target locale.
#
# Results:
# Returns the given dictionary augmented with a 'julianDay' field
@@ -2828,13 +2917,12 @@ proc ::tcl::clock::AssignBaseWeek { date baseTime timeZone } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone } {
+proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
+ variable TZData
# Find the Julian Day Number corresponding to the base time
- set date2 [dict create seconds $baseTime]
- set date2 [ConvertUTCToLocal $date2[set date2 {}] $timeZone]
- set date2 [GetJulianDay $date2[set date2 {}]]
+ set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
dict set date julianDay [dict get $date2 julianDay]
return $date
@@ -2859,7 +2947,6 @@ proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone } {
#----------------------------------------------------------------------
proc ::tcl::clock::InterpretHMSP { date } {
-
set hr [dict get $date hourAMPM]
if { $hr == 12 } {
set hr 0
@@ -2869,7 +2956,6 @@ proc ::tcl::clock::InterpretHMSP { date } {
}
dict set date hour $hr
return [InterpretHMS $date[set date {}]]
-
}
#----------------------------------------------------------------------
@@ -2892,11 +2978,11 @@ proc ::tcl::clock::InterpretHMSP { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::InterpretHMS { date } {
-
- return [expr { ( [dict get $date hour] * 60
- + [dict get $date minute] ) * 60
- + [dict get $date second] }]
-
+ return [expr {
+ ( [dict get $date hour] * 60
+ + [dict get $date minute] ) * 60
+ + [dict get $date second]
+ }]
}
#----------------------------------------------------------------------
@@ -2919,26 +3005,30 @@ proc ::tcl::clock::InterpretHMS { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
-
variable CachedSystemTimeZone
variable TimeZoneBad
- if { ![catch {getenv TCL_TZ} result] } {
+ if {[set result [getenv TCL_TZ]] ne {}} {
set timezone $result
- } elseif { ![catch {getenv TZ} 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}]
}
@@ -2947,319 +3037,69 @@ proc ::tcl::clock::GetSystemTimeZone {} {
} else {
return $timezone
}
-
}
#----------------------------------------------------------------------
#
# ConvertLegacyTimeZone --
#
-# Given an alphanumeric time zone identifier and the system
-# time zone, convert the alphanumeric identifier to an
-# unambiguous time zone.
+# Given an alphanumeric time zone identifier and the system time zone,
+# convert the alphanumeric identifier to an unambiguous time zone.
#
# Parameters:
# tzname - Name of the time zone to convert
#
# Results:
-# Returns a time zone name corresponding to tzname, but
-# in an unambiguous form, generally +hhmm.
+# Returns a time zone name corresponding to tzname, but in an
+# unambiguous form, generally +hhmm.
#
-# This procedure is implemented primarily to allow the parsing of
-# RFC822 date/time strings. Processing a time zone name on input
-# is not recommended practice, because there is considerable room
-# for ambiguity; for instance, is BST Brazilian Standard Time, or
-# British Summer Time?
+# This procedure is implemented primarily to allow the parsing of RFC822
+# date/time strings. Processing a time zone name on input is not recommended
+# practice, because there is considerable room for ambiguity; for instance, is
+# BST Brazilian Standard Time, or British Summer Time?
#
#----------------------------------------------------------------------
proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
-
variable LegacyTimeZone
set tzname [string tolower $tzname]
if { ![dict exists $LegacyTimeZone $tzname] } {
return -code error -errorcode [list CLOCK badTZName $tzname] \
"time zone \"$tzname\" not found"
- } else {
- return [dict get $LegacyTimeZone $tzname]
}
-
-}
-
-#----------------------------------------------------------------------
-#
-# ConvertLocalToUTC --
-#
-# Given a time zone and nominal local seconds, compute seconds
-# of UTC time from the Posix epoch.
-#
-# Parameters:
-# date - Dictionary populated with the 'localSeconds' and
-# 'tzName' fields
-#
-# Results:
-# Returns the given dictionary augmented with a 'seconds' field.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ConvertLocalToUTC { date } {
-
- variable TZData
-
- set timezone [dict get $date tzName]
- if { $timezone eq ":localtime" } {
-
- # Convert using the mktime function if possible
-
- if { [catch {
- ConvertLocalToUTCViaC [dict get $date localSeconds]
- } result opts] } {
- dict unset opts -errorinfo
- return -options $opts $result
- }
- dict set date seconds $result
- return $date
-
- } else {
-
- # Get the time zone data
-
- if { [catch { SetupTimeZone $timezone } retval opts] } {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
-
- # Initially assume that local == UTC, and locate the last time
- # conversion prior to that time. Get the offset from that,
- # and look up again. If that lookup finds a different offset,
- # continue looking until we find an offset that we found
- # before. The check for "any offset previously found" rather
- # than "the same offset" avoids an endless loop if we try to
- # convert a non-existent time, for example 2:30am during the
- # US spring DST change.
-
- set localseconds [dict get $date localSeconds]
- set utcseconds(0) $localseconds
- set seconds $localseconds
- while { 1 } {
- set i [BSearch $TZData($timezone) $seconds]
- set offset [lindex $TZData($timezone) $i 1]
- if { [info exists utcseconds($offset)] } {
- dict set date seconds $utcseconds($offset)
- return $date
- } else {
- set seconds [expr { $localseconds - $offset }]
- set utcseconds($offset) $seconds
- }
- }
-
- # In the absolute worst case, the loop above can visit each tzdata
- # row only once, so it's guaranteed to terminate.
-
- error "in ConvertLocalToUTC, can't happen"
- }
-
-}
-
-#----------------------------------------------------------------------
-#
-# ConvertLocalToUTCViaC --
-#
-# Given seconds of nominal local time, compute seconds from the
-# Posix epoch.
-#
-# Parameters:
-# localSeconds - Seconds of nominal local time
-#
-# Results:
-# Returns the seconds from the epoch. May throw an error if
-# the time is to large/small to represent, or if 'mktime' is
-# not present in the C library.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ConvertLocalToUTCViaC { localSeconds } {
-
- set date [dict create localSeconds $localSeconds]
- set date [GetJulianDay $date[set date {}]]
- set date [GetGregorianEraYearDay $date[set date {}]]
- set date [GetMonthDay $date[set date {}]]
- set retval \
- [Mktime \
- [dict get $date year] \
- [dict get $date month] \
- [dict get $date dayOfMonth] \
- [expr { $localSeconds / 3600 % 24 }] \
- [expr { $localSeconds / 60 % 60 }] \
- [expr { $localSeconds % 60 }]]
- return $retval
-}
-
-#----------------------------------------------------------------------
-#
-# ConvertUTCToLocal --
-#
-# Given the seconds from the Posix epoch, compute seconds of
-# nominal local time.
-#
-# Parameters:
-# date - Dictionary populated on entry with the 'seconds' field
-#
-# Results:
-# The given dictionary is returned, augmented with 'localSeconds',
-# 'tzOffset', and 'tzName' fields.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ConvertUTCToLocal { date timezone } {
-
- variable TZData
-
- # Get the data for time changes in the given zone
-
- if { [catch { SetupTimeZone $timezone } retval opts] } {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
-
- if { $timezone eq {:localtime} } {
-
- # Convert using the localtime function
-
- if { [catch {
- ConvertUTCToLocalViaC $date
- } retval opts] } {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
- return $retval
- }
-
- # Find the most recent transition in the time zone data
-
- set i [BSearch $TZData($timezone) [dict get $date seconds]]
- set row [lindex $TZData($timezone) $i]
- foreach { junk1 offset junk2 name } $row break
-
- # Add appropriate offset to convert Greenwich to local, and return
- # the local time
-
- dict set date localSeconds [expr { [dict get $date seconds] + $offset }]
- dict set date tzOffset $offset
- dict set date tzName $name
-
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
-# ConvertUTCToLocalViaC --
-#
-# Convert local time using the C localtime function
-#
-# Parameters:
-# date - Dictionary populated on entry with the 'seconds'
-# and 'timeZone' fields.
-#
-# Results:
-# The given dictionary is returned, augmented with 'localSeconds',
-# 'tzOffset', and 'tzName' fields.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ConvertUTCToLocalViaC { date } {
-
- # Get y-m-d-h-m-s from the C library
-
- set gmtSeconds [dict get $date seconds]
- set localFields [Localtime $gmtSeconds]
- set date2 [dict create]
- foreach key {
- year month dayOfMonth hour minute second
- } value $localFields {
- dict set date2 $key $value
- }
- dict set date2 era CE
-
- # Convert to Julian Day
-
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]]
-
- # Reconvert to seconds from the epoch in local time.
-
- set localSeconds [expr { ( ( ( wide([dict get $date2 julianDay])
- * 24
- + wide([dict get $date2 hour]) )
- * 60
- + wide([dict get $date2 minute]) )
- * 60
- + wide([dict get $date2 second]) )
- - 210866803200 }]
-
- # Determine the name and offset of the timezone
-
- set diff [expr { $localSeconds - $gmtSeconds }]
- if { $diff <= 0 } {
- set signum -
- set delta [expr { - $diff }]
- } else {
- set signum +
- set delta $diff
- }
- set hh [::format %02d [expr { $delta / 3600 }]]
- set mm [::format %02d [expr { ($delta / 60 )
- % 60 }]]
- set ss [::format %02d [expr { $delta % 60 }]]
-
- set zoneName $signum$hh$mm
- if { $ss ne {00} } {
- append zoneName $ss
- }
-
- # Fix the dictionary
-
- dict set date localSeconds $localSeconds
- dict set date tzOffset $diff
- dict set date tzName $zoneName
- return $date
-
+ return [dict get $LegacyTimeZone $tzname]
}
#----------------------------------------------------------------------
#
# SetupTimeZone --
#
-# Given the name or specification of a time zone, sets up
-# its in-memory data.
+# Given the name or specification of a time zone, sets up its in-memory
+# data.
#
# Parameters:
# tzname - Name of a time zone
#
# Results:
-# Unless the time zone is ':localtime', sets the TZData array
-# to contain the lookup table for local<->UTC conversion.
-# Returns an error if the time zone cannot be parsed.
+# Unless the time zone is ':localtime', sets the TZData array to contain
+# the lookup table for local<->UTC conversion. Returns an error if the
+# time zone cannot be parsed.
#
#----------------------------------------------------------------------
proc ::tcl::clock::SetupTimeZone { timezone } {
-
variable TZData
if {! [info exists TZData($timezone)] } {
variable MINWIDE
if { $timezone eq {:localtime} } {
-
# Nothing to do, we'll convert using the localtime function
- } elseif { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
- -> s hh mm ss] } {
-
+ } elseif {
+ [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
+ -> s hh mm ss]
+ } then {
# Make a fixed offset
::scan $hh %d hh
@@ -3280,24 +3120,21 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
} elseif { [string index $timezone 0] eq {:} } {
-
# Convert using a time zone file
- if {
+ if {
[catch {
LoadTimeZoneFile [string range $timezone 1 end]
- }]
- && [catch {
+ }] && [catch {
LoadZoneinfoFile [string range $timezone 1 end]
}]
- } {
+ } then {
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
-
+
} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
-
# This looks like a POSIX time zone - try to process it
if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
@@ -3310,12 +3147,11 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
}
} else {
-
- # We couldn't parse this as a POSIX time zone. Try
- # again with a time zone file - this time without a colon
+ # We couldn't parse this as a POSIX time zone. Try again with a
+ # time zone file - this time without a colon
if { [catch { LoadTimeZoneFile $timezone }]
- && [catch { ZoneinfoFile $timezone } - opts] } {
+ && [catch { LoadZoneinfoFile $timezone } - opts] } {
dict unset opts -errorinfo
return -options $opts "time zone $timezone not found"
}
@@ -3336,25 +3172,22 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
# None.
#
# Results:
-# Returns a time zone specifier that corresponds to the system
-# time zone information found in the Registry.
+# Returns a time zone specifier that corresponds to the system time zone
+# information found in the Registry.
#
# Bugs:
-# Fixed dates for DST change are unimplemented at present, because
-# no time zone information supplied with Windows actually uses
-# them!
+# Fixed dates for DST change are unimplemented at present, because no
+# time zone information supplied with Windows actually uses them!
#
-# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is
-# specified, GuessWindowsTimeZone looks in the Registry for the
-# system time zone information. It then attempts to find an entry
-# in WinZoneInfo for a time zone that uses the same rules. If
-# it finds one, it returns it; otherwise, it constructs a Posix-style
-# time zone string and returns that.
+# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
+# GuessWindowsTimeZone looks in the Registry for the system time zone
+# information. It then attempts to find an entry in WinZoneInfo for a time
+# zone that uses the same rules. If it finds one, it returns it; otherwise,
+# it constructs a Posix-style time zone string and returns that.
#
#----------------------------------------------------------------------
proc ::tcl::clock::GuessWindowsTimeZone {} {
-
variable WinZoneInfo
variable NoRegistry
variable TimeZoneBad
@@ -3385,16 +3218,14 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
lappend data $val
}
}] } {
-
# Missing values in the Registry - bail out
return :localtime
}
- # Make up a Posix time zone specifier if we can't find one.
- # Check here that the tzdata file exists, in case we're running
- # in an environment (e.g. starpack) where tzdata is incomplete.
- # (Bug 1237907)
+ # Make up a Posix time zone specifier if we can't find one. Check here
+ # that the tzdata file exists, in case we're running in an environment
+ # (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
if { [dict exists $WinZoneInfo $data] } {
set tzname [dict get $WinZoneInfo $data]
@@ -3405,13 +3236,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
set tzname {}
}
if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
- foreach {
- bias stdBias dstBias
- stdYear stdMonth stdDayOfWeek stdDayOfMonth
- stdHour stdMinute stdSecond stdMillisec
- dstYear dstMonth dstDayOfWeek dstDayOfMonth
+ lassign $data \
+ bias stdBias dstBias \
+ stdYear stdMonth stdDayOfWeek stdDayOfMonth \
+ stdHour stdMinute stdSecond stdMillisec \
+ dstYear dstMonth dstDayOfWeek dstDayOfMonth \
dstHour dstMinute dstSecond dstMillisec
- } $data break
set stdDelta [expr { $bias + $stdBias }]
set dstDelta [expr { $bias + $dstBias }]
if { $stdDelta <= 0 } {
@@ -3443,11 +3273,11 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
if { $dstYear == 0 } {
append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
} else {
- # I have not been able to find any locale on which
- # Windows converts time zone on a fixed day of the year,
- # hence don't know how to interpret the fields.
- # If someone can inform me, I'd be glad to code it up.
- # For right now, we bail out in such a case.
+ # I have not been able to find any locale on which Windows
+ # converts time zone on a fixed day of the year, hence don't
+ # know how to interpret the fields. If someone can inform me,
+ # I'd be glad to code it up. For right now, we bail out in
+ # such a case.
return :localtime
}
append tzname / [::format %02d $dstHour] \
@@ -3456,11 +3286,11 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
if { $stdYear == 0 } {
append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
} else {
- # I have not been able to find any locale on which
- # Windows converts time zone on a fixed day of the year,
- # hence don't know how to interpret the fields.
- # If someone can inform me, I'd be glad to code it up.
- # For right now, we bail out in such a case.
+ # I have not been able to find any locale on which Windows
+ # converts time zone on a fixed day of the year, hence don't
+ # know how to interpret the fields. If someone can inform me,
+ # I'd be glad to code it up. For right now, we bail out in
+ # such a case.
return :localtime
}
append tzname / [::format %02d $stdHour] \
@@ -3468,10 +3298,9 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
: [::format %02d $stdSecond]
}
dict set WinZoneInfo $data $tzname
- }
+ }
return [dict get $WinZoneInfo $data]
-
}
#----------------------------------------------------------------------
@@ -3500,18 +3329,18 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
return
}
- # Since an unsafe interp uses the [clock] command in the master,
- # this code is security sensitive. Make sure that the path name
- # cannot escape the given directory.
+ # Since an unsafe interp uses the [clock] command in the master, this code
+ # is security sensitive. Make sure that the path name cannot escape the
+ # given directory.
if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
return -code error \
-errorcode [list CLOCK badTimeZone $:fileName] \
"time zone \":$fileName\" not valid"
}
- if { [catch {
+ try {
source -encoding utf-8 [file join $DataDir $fileName]
- }] } {
+ } on error {} {
return -code error \
-errorcode [list CLOCK badTimeZone :$fileName] \
"time zone \":$fileName\" not found"
@@ -3529,8 +3358,8 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
# fileName - Relative path name of the file to load.
#
# Results:
-# Returns an empty result normally; returns an error if no
-# Olson file was found or the file was malformed in some way.
+# Returns an empty result normally; returns an error if no Olson file
+# was found or the file was malformed in some way.
#
# Side effects:
# TZData(:fileName) contains the time zone data
@@ -3538,12 +3367,11 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
#----------------------------------------------------------------------
proc ::tcl::clock::LoadZoneinfoFile { fileName } {
-
variable ZoneinfoPaths
- # Since an unsafe interp uses the [clock] command in the master,
- # this code is security sensitive. Make sure that the path name
- # cannot escape the given directory.
+ # Since an unsafe interp uses the [clock] command in the master, this code
+ # is security sensitive. Make sure that the path name cannot escape the
+ # given directory.
if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
return -code error \
@@ -3562,7 +3390,7 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } {
#----------------------------------------------------------------------
#
-# LoadZoneinfoFile --
+# ReadZoneinfoFile --
#
# Loads a binary time zone information file in Olson format.
#
@@ -3572,19 +3400,18 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } {
# fname - Absolute path name of the file.
#
# Results:
-# Returns an empty result normally; returns an error if no
-# Olson file was found or the file was malformed in some way.
+# Returns an empty result normally; returns an error if no Olson file
+# was found or the file was malformed in some way.
#
# Side effects:
# TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------
-
-proc ReadZoneinfoFile {fileName fname} {
+proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
variable MINWIDE
variable TZData
- if { ![info exists fname] } {
+ if { ![file exists $fname] } {
return -code error "$fileName not found"
}
@@ -3599,27 +3426,54 @@ proc ReadZoneinfoFile {fileName fname} {
set d [read $f]
close $f
- # The file begins with a magic number, sixteen reserved bytes,
- # and then six 4-byte integers giving counts of fileds in the file.
+ # The file begins with a magic number, sixteen reserved bytes, and then
+ # six 4-byte integers giving counts of fileds in the file.
- binary scan $d a4x16IIIIII magic nIsGMT mIsStd nLeap nTime nType nChar
+ binary scan $d a4a1x15IIIIII \
+ magic version nIsGMT nIsStd nLeap nTime nType nChar
set seek 44
+ set ilen 4
+ set iformat I
if { $magic != {TZif} } {
return -code error "$fileName not a time zone information file"
}
if { $nType > 255 } {
return -code error "$fileName contains too many time types"
}
+ # Accept only Posix-style zoneinfo. Sorry, 'leaps' bigots.
if { $nLeap != 0 } {
return -code error "$fileName contains leap seconds"
}
+ # In a version 2 file, we use the second part of the file, which contains
+ # 64-bit transition times.
+
+ if {$version eq "2"} {
+ set seek [expr {
+ 44
+ + 5 * $nTime
+ + 6 * $nType
+ + 4 * $nLeap
+ + $nIsStd
+ + $nIsGMT
+ + $nChar
+ }]
+ binary scan $d @${seek}a4a1x15IIIIII \
+ magic version nIsGMT nIsStd nLeap nTime nType nChar
+ if {$magic ne {TZif}} {
+ return -code error "seek address $seek miscomputed, magic = $magic"
+ }
+ set iformat W
+ set ilen 8
+ incr seek 44
+ }
+
# Next come ${nTime} transition times, followed by ${nTime} time type
# codes. The type codes are unsigned 1-byte quantities. We insert an
# arbitrary start time in front of the transitions.
- binary scan $d @${seek}I${nTime}c${nTime} times tempCodes
- incr seek [expr { 5 * $nTime }]
+ binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes
+ incr seek [expr { ($ilen + 1) * $nTime }]
set times [linsert $times 0 $MINWIDE]
set codes {}
foreach c $tempCodes {
@@ -3627,9 +3481,9 @@ proc ReadZoneinfoFile {fileName fname} {
}
set codes [linsert $codes 0 0]
- # Next come ${nType} time type descriptions, each of which has an
- # offset (seconds east of GMT), a DST indicator, and an index into
- # the abbreviation text.
+ # Next come ${nType} time type descriptions, each of which has an offset
+ # (seconds east of GMT), a DST indicator, and an index into the
+ # abbreviation text.
for { set i 0 } { $i < $nType } { incr i } {
binary scan $d @${seek}Icc gmtOff isDst abbrInd
@@ -3637,10 +3491,10 @@ proc ReadZoneinfoFile {fileName fname} {
incr seek 6
}
- # Next come $nChar characters of time zone name abbreviations,
- # which are null-terminated.
- # We build them up into a dictionary indexed by character index,
- # because that's what's in the indices above.
+ # Next come $nChar characters of time zone name abbreviations, which are
+ # null-terminated.
+ # We build them up into a dictionary indexed by character index, because
+ # that's what's in the indices above.
binary scan $d @${seek}a${nChar} abbrs
incr seek ${nChar}
@@ -3648,11 +3502,12 @@ proc 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
+ }
}
- # The rest of the data in the file are not used at present.
# Package up a list of tuples, each of which contains transition time,
# seconds east of Greenwich, DST flag and time zone abbreviation.
@@ -3663,12 +3518,33 @@ proc ReadZoneinfoFile {fileName fname} {
return -code error "$fileName has times out of order"
}
set lastTime $t
- foreach { gmtoff isDst abbrInd } [lindex $types $c] break
+ lassign [lindex $types $c] gmtoff isDst abbrInd
set abbrev [dict get $abbrevs $abbrInd]
lappend r [list $t $gmtoff $isDst $abbrev]
}
+ # In a version 2 file, there is also a POSIX-style time zone description
+ # at the very end of the file. To get to it, skip over nLeap leap second
+ # values (8 bytes each),
+ # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.
+
+ if {$version eq {2}} {
+ set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
+ set last [string first \n $d $seek]
+ set posix [string range $d $seek [expr {$last-1}]]
+ if {[llength $posix] > 0} {
+ set posixFields [ParsePosixTimeZone $posix]
+ foreach tuple [ProcessPosixTimeZone $posixFields] {
+ lassign $tuple t gmtoff isDst abbrev
+ if {$t > $lastTime} {
+ lappend r $tuple
+ }
+ }
+ }
+ }
+
set TZData(:$fileName) $r
+
return
}
@@ -3682,8 +3558,8 @@ proc ReadZoneinfoFile {fileName fname} {
# tz Time zone specifier to be interpreted
#
# Results:
-# Returns a dictionary whose values contain the various pieces of
-# the time zone specification.
+# Returns a dictionary whose values contain the various pieces of the
+# time zone specification.
#
# Side effects:
# None.
@@ -3694,7 +3570,7 @@ proc ReadZoneinfoFile {fileName fname} {
# The following keys are present in the dictionary:
# stdName - Name of the time zone when Daylight Saving Time
# is not in effect.
-# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
+# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
# to the given (non-DST) time zone. + and the empty
# string denote zones west of Greenwich, - denotes east
# of Greenwich; this is contrary to the ISO convention
@@ -3739,14 +3615,13 @@ proc ReadZoneinfoFile {fileName fname} {
# endHours, endMinutes, endSeconds -
# Specify the end of DST in the same way that the start* fields
# specify the beginning of DST.
-#
-# This procedure serves only to break the time specifier into fields.
-# No attempt is made to canonicalize the fields or supply default values.
+#
+# This procedure serves only to break the time specifier into fields. No
+# attempt is made to canonicalize the fields or supply default values.
#
#----------------------------------------------------------------------
proc ::tcl::clock::ParsePosixTimeZone { tz } {
-
if {[regexp -expanded -nocase -- {
^
# 1 - Standard time zone name
@@ -3757,8 +3632,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 4 - Standard time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
+ : ([[:digit:]]{1,2})
+ (?:
# 5 - Standard time zone offset, seconds
: ([[:digit:]]{1,2} )
)?
@@ -3774,8 +3649,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 9 - DST time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
+ : ([[:digit:]]{1,2})
+ (?:
# 10 - DST time zone offset, seconds
: ([[:digit:]]{1,2})
)?
@@ -3788,8 +3663,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 13 - Month number 14 - Week of month 15 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
+ ( [[:digit:]] + )
+ [.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3810,8 +3685,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 21 - Month number 22 - Week of month 23 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
+ ( [[:digit:]] + )
+ [.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3838,27 +3713,21 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
x(endJ) x(endDayOfYear) \
x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
x(endHours) x(endMinutes) x(endSeconds)] } {
-
# it's a good timezone
return [array get x]
-
- } else {
-
- return -code error\
- -errorcode [list CLOCK badTimeZone $tz] \
- "unable to parse time zone specification \"$tz\""
-
}
+ return -code error\
+ -errorcode [list CLOCK badTimeZone $tz] \
+ "unable to parse time zone specification \"$tz\""
}
#----------------------------------------------------------------------
#
# ProcessPosixTimeZone --
#
-# Handle a Posix time zone after it's been broken out into
-# fields.
+# Handle a Posix time zone after it's been broken out into fields.
#
# Parameters:
# z - Dictionary returned from 'ParsePosixTimeZone'
@@ -3872,7 +3741,6 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
#----------------------------------------------------------------------
proc ::tcl::clock::ProcessPosixTimeZone { z } {
-
variable MINWIDE
variable TZData
@@ -3887,20 +3755,20 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
} else {
set stdSignum -1
}
- set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
+ set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
if { [dict get $z stdMinutes] ne {} } {
- set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
+ set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
} else {
set stdMinutes 0
}
if { [dict get $z stdSeconds] ne {} } {
- set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
+ set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
} else {
set stdSeconds 0
}
- set stdOffset [expr { ( ( $stdHours * 60 + $stdMinutes )
- * 60 + $stdSeconds )
- * $stdSignum }]
+ set stdOffset [expr {
+ (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
+ }]
set data [list [list $MINWIDE $stdOffset 0 $stdName]]
# If there's no daylight zone, we're done
@@ -3923,46 +3791,77 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
if { [dict get $z dstHours] eq {} } {
set dstOffset [expr { 3600 + $stdOffset }]
} else {
- set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
+ set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
if { [dict get $z dstMinutes] ne {} } {
- set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
+ set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
} else {
set dstMinutes 0
}
if { [dict get $z dstSeconds] ne {} } {
- set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
+ set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
} else {
set dstSeconds 0
}
- set dstOffset [expr { ( ( $dstHours * 60 + $dstMinutes )
- * 60 + $dstSeconds )
- * $dstSignum }]
- }
-
- # Fill in defaults for US DST rules
-
- if { [dict get $z startDayOfYear] eq {}
- && [dict get $z startMonth] eq {} } {
- dict set z startMonth 4
- dict set z startWeekOfMonth 1
+ set dstOffset [expr {
+ (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
+ }]
+ }
+
+ # Fill in defaults for European or US DST rules
+ # US start time is the second Sunday in March
+ # EU start time is the last Sunday in March
+ # US end time is the first Sunday in November.
+ # EU end time is the last Sunday in October
+
+ if {
+ [dict get $z startDayOfYear] eq {}
+ && [dict get $z startMonth] eq {}
+ } then {
+ if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
+ # EU
+ dict set z startWeekOfMonth 5
+ if {$stdHours>2} {
+ dict set z startHours 2
+ } else {
+ dict set z startHours [expr {$stdHours+1}]
+ }
+ } else {
+ # US
+ dict set z startWeekOfMonth 2
+ dict set z startHours 2
+ }
+ dict set z startMonth 3
dict set z startDayOfWeek 0
- dict set z startHours 2
dict set z startMinutes 0
dict set z startSeconds 0
}
- if { [dict get $z endDayOfYear] eq {}
- && [dict get $z endMonth] eq {} } {
- dict set z endMonth 10
- dict set z endWeekOfMonth 5
+ if {
+ [dict get $z endDayOfYear] eq {}
+ && [dict get $z endMonth] eq {}
+ } then {
+ if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
+ # EU
+ dict set z endMonth 10
+ dict set z endWeekOfMonth 5
+ if {$stdHours>2} {
+ dict set z endHours 3
+ } else {
+ dict set z endHours [expr {$stdHours+2}]
+ }
+ } else {
+ # US
+ dict set z endMonth 11
+ dict set z endWeekOfMonth 1
+ dict set z endHours 2
+ }
dict set z endDayOfWeek 0
- dict set z endHours 2
dict set z endMinutes 0
dict set z endSeconds 0
}
# Put DST in effect in all years from 1916 to 2099.
- for { set y 1916 } { $y < 2099 } { incr y } {
+ for { set y 1916 } { $y < 2100 } { incr y } {
set startTime [DeterminePosixDSTTime $z start $y]
incr startTime [expr { - wide($stdOffset) }]
set endTime [DeterminePosixDSTTime $z end $y]
@@ -3979,15 +3878,14 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
}
return $data
-
-}
+}
#----------------------------------------------------------------------
#
# DeterminePosixDSTTime --
#
-# Determines the time that Daylight Saving Time starts or ends
-# from a Posix time zone specification.
+# Determines the time that Daylight Saving Time starts or ends from a
+# Posix time zone specification.
#
# Parameters:
# z - Time zone data returned from ParsePosixTimeZone.
@@ -3997,13 +3895,12 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
# y - The year for which the transition time is to be determined.
#
# Results:
-# Returns the transition time as a count of seconds from
-# the epoch. The time is relative to the wall clock, not UTC.
+# Returns the transition time as a count of seconds from the epoch. The
+# time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------
proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
-
variable FEB_28
# Determine the start or end day of DST
@@ -4011,34 +3908,33 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
set date [dict create era CE year $y]
set doy [dict get $z ${bound}DayOfYear]
if { $doy ne {} } {
-
# Time was specified as a day of the year
if { [dict get $z ${bound}J] ne {}
- && [IsGregorianLeapYear $y]
+ && [IsGregorianLeapYear $y]
&& ( $doy > $FEB_28 ) } {
incr doy
}
dict set date dayOfYear $doy
- set date [GetJulianDayFromEraYearDay $date[set date {}]]
+ set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
} else {
-
# Time was specified as a day of the week within a month
dict set date month [dict get $z ${bound}Month]
- dict set date dayOfWeekInMonth [dict get $z ${bound}WeekOfMonth]
- set dow [dict get $z ${bound}DayOfWeek]
- if { $dow >= 5 } {
- set dow -1
+ dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
+ set dowim [dict get $z ${bound}WeekOfMonth]
+ if { $dowim >= 5 } {
+ set dowim -1
}
- dict set date dayOfWeek $dow
- set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}]]
+ dict set date dayOfWeekInMonth $dowim
+ set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]
}
set jd [dict get $date julianDay]
- set seconds [expr { wide($jd) * wide(86400)
- - wide(210866803200) }]
+ set seconds [expr {
+ wide($jd) * wide(86400) - wide(210866803200)
+ }]
set h [dict get $z ${bound}Hours]
if { $h eq {} } {
@@ -4060,7 +3956,6 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
}
set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
return [expr { $seconds + $tod }]
-
}
#----------------------------------------------------------------------
@@ -4074,457 +3969,30 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
# date - Dictionary that must contain the keys, 'localSeconds',
# whose value is expressed as the appropriate local time;
# and 'year', whose value is the Gregorian year.
+# etable - Value of the LOCALE_ERAS key in the message catalogue
+# for the target locale.
#
# Results:
-# Returns the dictionary, augmented with the keys, 'localeEra'
-# and 'localeYear'.
+# Returns the dictionary, augmented with the keys, 'localeEra' and
+# 'localeYear'.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::GetLocaleEra { date } {
-
- set etable [mc LOCALE_ERAS]
+proc ::tcl::clock::GetLocaleEra { date etable } {
set index [BSearch $etable [dict get $date localSeconds]]
- if { $index < 0 } {
+ if { $index < 0} {
dict set date localeEra \
[::format %02d [expr { [dict get $date year] / 100 }]]
- dict set date localeYear \
- [expr { [dict get $date year] % 100 }]
+ dict set date localeYear [expr {
+ [dict get $date year] % 100
+ }]
} else {
dict set date localeEra [lindex $etable $index 1]
- dict set date localeYear [expr { [dict get $date year]
- - [lindex $etable $index 2] }]
+ dict set date localeYear [expr {
+ [dict get $date year] - [lindex $etable $index 2]
+ }]
}
return $date
-
-}
-#----------------------------------------------------------------------
-#
-# GetJulianDay --
-#
-# Given the seconds from the Posix epoch, derives the Julian
-# day number.
-#
-# Parameters:
-# date - Dictionary containing the date fields. On input,
-# populated with a 'localSeconds' field that gives the
-# nominal seconds from the epoch (in the local time zone,
-# rather than UTC).
-#
-# Results:
-# Returns the given dictionary, augmented by a 'julianDay'
-# field that gives the Julian Day Number at noon of the current
-# date.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetJulianDay { date } {
-
- set secs [dict get $date localSeconds]
-
- return [dict set date julianDay \
- [expr { ( $secs + 210866803200 )
- / 86400 }]]
-
-}
-
-#----------------------------------------------------------------------
-#
-# GetGregorianEraYearDay --
-#
-# Given the time from the Posix epoch and the current time zone,
-# develops the era, year, and day of year in the Gregorian calendar.
-#
-# Parameters:
-# date - Dictionary containing the date fields. On input, populated
-# with the 'julianDay' key whose value is the Julian Day Number.
-#
-# Results:
-# Returns the given dictionary with the 'gregorian', 'era',
-# 'year', and 'dayOfYear' populated.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetGregorianEraYearDay { date } {
-
- set jday [dict get $date julianDay]
-
- set changeover [mc GREGORIAN_CHANGE_DATE]
-
- if { $jday >= $changeover } {
-
- # Gregorian date
-
- dict set date gregorian 1
-
- # Calculate number of days since 1 January, 1 CE
-
- set day [expr { $jday - 1721425 - 1 }]
-
- # Calculate number of 400 year cycles
-
- set year 1
- set n [expr { $day / 146097 }]
- incr year [expr { 400 * $n }]
- set day [expr { $day % 146097 }]
-
- # Calculate number of centuries in the current cycle
-
- set n [expr { $day / 36524 }]
- set day [expr { $day % 36524 }]
- if { $n > 3 } {
- set n 3 ; # 31 December 2000, for instance
- incr day 36524 ; # is last day of 400 year cycle
- }
- incr year [expr { 100 * $n }]
-
- } else {
-
- # Julian date
-
- dict set date gregorian 0
-
- # Calculate days since 0 January, 1 CE Julian
-
- set day [expr { $jday - 1721423 - 1 }]
- set year 1
-
- }
-
- # Calculate number of 4-year cycles in current century (or in
- # the Common Era, if the calendar is Julian)
-
- set n [expr { $day / 1461 }]
- set day [expr { $day % 1461 }]
- incr year [expr { 4 * $n }]
-
- # Calculate number of years in current 4-year cycle
-
- set n [expr { $day / 365 }]
- set day [expr { $day % 365 }]
- if { $n > 3 } {
- set n 3 ;# 31 December in a leap year
- incr day 365
- }
- incr year $n
-
- # Calculate the era
-
- if { $year <= 0 } {
- dict set date year [expr { 1 - $year }]
- dict set date era BCE
- } else {
- dict set date year $year
- dict set date era CE
- }
-
- # Return day of the year
-
- dict set date dayOfYear [expr { $day + 1 }]
-
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
-# GetMonthDay --
-#
-# Given the ordinal number of the day within the year, determines
-# month and day of month in the Gregorian calendar.
-#
-# Parameters:
-# date - Dictionary containing the date fields. On input, populated
-# with the 'era', 'gregorian', 'year' and 'dayOfYear' fields.
-#
-# Results:
-# Returns the given dictionary with the 'month' and 'dayOfMonth'
-# fields populated.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetMonthDay { date } {
-
- variable DaysInRomanMonthInCommonYear
- variable DaysInRomanMonthInLeapYear
-
- set day [dict get $date dayOfYear]
- if { [IsGregorianLeapYear $date] } {
- set hath $DaysInRomanMonthInLeapYear
- } else {
- set hath $DaysInRomanMonthInCommonYear
- }
- set month 1
- foreach n $hath {
- if { $day <= $n } {
- break
- }
- incr month
- incr day [expr { -$n }]
- }
- dict set date month $month
- dict set date dayOfMonth $day
-
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
-# GetYearWeekDay
-#
-# Given a julian day number, fiscal year, fiscal week,
-# and day of week in the ISO8601 calendar.
-#
-# Parameters:
-#
-# date - Dictionary where the 'julianDay' field is populated.
-# daysInFirstWeek - (Optional) Parameter giving the minimum number
-# of days in the first week of a year. Default is 4.
-#
-# Results:
-# Returns the given dictionary with values filled in for the
-# three given keys.
-#
-# Side effects:
-# None.
-#
-# Bugs:
-# Since ISO8601 week numbering is defined only for the Gregorian
-# calendar, dates on the Julian calendar or before the Common
-# Era may yield unexpected results. In particular, the year of
-# the Julian-to-Gregorian change may be up to three weeks short.
-# The era is not managed separately, so if the Common Era begins
-# (or the period Before the Common Era ends) with a partial week,
-# the few days at the beginning or end of the era may show up
-# as incorrectly belonging to the year zero.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetYearWeekDay { date
- { keys { iso8601Year iso8601Week dayOfWeek } } } {
-
- set daysInFirstWeek 4
- set firstDayOfWeek 1
-
- # Determine the calendar year of $j - $daysInFirstWeek + 1.
- # Compute an upper bound of the fiscal year as being one year
- # past the day on which the current week begins. Find the start
- # of that year.
-
- set j [dict get $date julianDay]
- set jd [expr { $j - $daysInFirstWeek + 1 }]
- set date1 [GetGregorianEraYearDay [dict create julianDay $jd]]
- switch -exact -- [dict get $date1 era] {
- BCE {
- dict set date1 fiscalYear [expr { [dict get $date1 year] - 1}]
- }
- CE {
- dict set date1 fiscalYear [expr { [dict get $date1 year] + 1}]
- }
- }
- dict unset date1 year
- dict unset date1 dayOfYear
- dict set date1 weekOfFiscalYear 1
- dict set date1 dayOfWeek $firstDayOfWeek
-
- set date1 [GetJulianDayFromEraYearWeekDay \
- $date1[set date1 {}] \
- $daysInFirstWeek \
- $firstDayOfWeek \
- { fiscalYear weekOfFiscalYear dayOfWeek }]
- set startOfFiscalYear [dict get $date1 julianDay]
-
- # If we guessed high, move one year earlier.
-
- if { $j < $startOfFiscalYear } {
- switch -exact -- [dict get $date1 era] {
- BCE {
- dict incr date1 fiscalYear
- }
- CE {
- dict incr date1 fiscalYear -1
- }
- }
- set date1 [GetJulianDayFromEraYearWeekDay \
- $date1[set date1 {}] \
- $daysInFirstWeek \
- $firstDayOfWeek \
- {fiscalYear weekOfFiscalYear dayOfWeek }]
- set startOfFiscalYear [dict get $date1 julianDay]
- }
-
- # Get the week number and the day within the week
-
- set fiscalYear [dict get $date1 fiscalYear]
- set dayOfFiscalYear [expr { $j - $startOfFiscalYear }]
- set weekOfFiscalYear [expr { ( $dayOfFiscalYear / 7 ) + 1 }]
- set dayOfWeek [expr { ( $dayOfFiscalYear + 1 ) % 7 }]
- if { $dayOfWeek < $firstDayOfWeek } {
- incr dayOfWeek 7
- }
-
- # Store the fiscal year, week, and day in the given slots in the
- # given dictionary.
-
- foreach key $keys \
- value [list $fiscalYear $weekOfFiscalYear $dayOfWeek] {
- dict set date $key $value
- }
-
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# GetJulianDayFromEraYearWeekDay --
-#
-# Finds the Julian Day Number corresponding to the given era,
-# year, week and day.
-#
-# Parameters:
-# date -- A dictionary populated with fields whose keys are given
-# by the 'keys' parameter below, plus the 'era' field.
-# daysInFirstWeek -- (Optional) The minimum number of days in
-# the first week of the year. Default is 4.
-# firstDayOfWeek -- (Optional) The ordinal number of the first
-# day of the week. Default is 1 (Monday);
-# 0 (Sunday) is an alternative.
-# keys -- (Optional) Keys in the dictionary for looking up the
-# fiscal year, fiscal week, and day of week. The
-# default is { iso8601Year iso8601Week dayOfWeek }.
-#
-# Results:
-# Returns the dictionary augmented with a 'julianDay' field
-# that gives the Julian Day Number corresponding to the given
-# date.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetJulianDayFromEraYearWeekDay {
- date
- { daysInFirstWeek 4 }
- { firstDayOfWeek 1 }
- { keys { iso8601Year iso8601Week dayOfWeek } }
-} {
-
- foreach var { fiscalYear fiscalWeek dayOfWeek } key $keys {
- set $var [dict get $date $key]
- }
-
- # Find a day of the first week of the year.
-
- set date2 [dict create \
- era [dict get $date era] \
- year $fiscalYear \
- month 1 \
- dayOfMonth $daysInFirstWeek]
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]]
-
- # Find the Julian Day Number of the start of that week.
-
- set jd [WeekdayOnOrBefore $firstDayOfWeek [dict get $date2 julianDay]]
-
- # Add the required number of weeks and days
-
- dict set date julianDay \
- [expr { $jd
- + ( 7 * ( $fiscalWeek - 1 ) )
- + $dayOfWeek - $firstDayOfWeek }]
-
- return $date
-
-}
-
-#----------------------------------------------------------------------
-#
-# GetJulianDayFromEraYearMonthDay --
-#
-# Given a year, month and day on the Gregorian calendar, determines
-# the Julian Day Number beginning at noon on that date.
-#
-# Parameters:
-# date -- A dictionary in which the 'era', 'year', 'month', and
-# 'dayOfMonth' slots are populated. The calendar in use
-# is determined by the date itself relative to
-# [mc GREGORIAN_CHANGE_DATE] in the current locale.
-#
-# Results:
-# Returns the given dictionary augmented with a 'julianDay' key
-# whose value is the desired Julian Day Number, and a 'gregorian'
-# key that specifies whether the calendar is Gregorian (1) or
-# Julian (0).
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } {
-
- variable DaysInPriorMonthsInCommonYear
- variable DaysInPriorMonthsInLeapYear
-
- # Get absolute year number from the civil year
-
- switch -exact -- [dict get $date era] {
- BCE {
- set year [expr { 1 - [dict get $date year] }]
- }
- CE {
- set year [dict get $date year]
- }
- }
-
- # If month is out of range, reduce modulo 12 and adjust year accordingly.
-
- set month [expr { [dict get $date month] - 1 }]
- incr year [expr { $month / 12 }]
- set month [expr { ( $month % 12 ) + 1 }]
- dict set date era CE; dict set date year $year; dict set date month $month
-
- set ym1 [expr { $year - 1 }]
-
- # Try the Gregorian calendar first.
-
- dict set date gregorian 1
- set jd [expr { 1721425
- + [dict get $date dayOfMonth]
- + ( [IsGregorianLeapYear $date] ?
- [lindex $DaysInPriorMonthsInLeapYear \
- [expr { $month - 1}]]
- : [lindex $DaysInPriorMonthsInCommonYear \
- [expr { $month - 1}]] )
- + ( 365 * $ym1 )
- + ( $ym1 / 4 )
- - ( $ym1 / 100 )
- + ( $ym1 / 400 ) }]
-
- # If the date is before the Gregorian change, use the Julian calendar.
-
- if { $jd < [mc GREGORIAN_CHANGE_DATE] } {
-
- dict set date gregorian 0
- set jd [expr { 1721423
- + [dict get $date dayOfMonth]
- + ( ( $year % 4 == 0 ) ?
- [lindex $DaysInPriorMonthsInLeapYear \
- [expr { $month - 1}]]
- : [lindex $DaysInPriorMonthsInCommonYear \
- [expr { $month - 1}]] )
- + ( 365 * $ym1 )
- + ( $ym1 / 4 ) }]
- }
-
- dict set date julianDay $jd
- return $date
-
}
#----------------------------------------------------------------------
@@ -4537,22 +4005,24 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } {
# Parameters:
# date -- A dictionary in which the 'era', 'year', and
# 'dayOfYear' slots are populated. The calendar in use
-# is determined by the date itself relative to
-# [mc GREGORIAN_CHANGE_DATE] in the current locale.
+# is determined by the date itself relative to:
+# changeover -- Julian day on which the Gregorian calendar was
+# adopted in the current locale.
#
# Results:
-# Returns the given dictionary augmented with a 'julianDay' key
-# whose value is the desired Julian Day Number, and a 'gregorian'
-# key that specifies whether the calendar is Gregorian (1) or
-# Julian (0).
+# Returns the given dictionary augmented with a 'julianDay' key whose
+# value is the desired Julian Day Number, and a 'gregorian' key that
+# specifies whether the calendar is Gregorian (1) or Julian (0).
#
# Side effects:
# None.
#
+# Bugs:
+# This code needs to be moved to the C layer.
+#
#----------------------------------------------------------------------
-proc ::tcl::clock::GetJulianDayFromEraYearDay { date } {
-
+proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
# Get absolute year number from the civil year
switch -exact -- [dict get $date era] {
@@ -4568,21 +4038,25 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } {
# Try the Gregorian calendar first.
dict set date gregorian 1
- set jd [expr { 1721425
- + [dict get $date dayOfYear]
- + ( 365 * $ym1 )
- + ( $ym1 / 4 )
- - ( $ym1 / 100 )
- + ( $ym1 / 400 ) }]
-
+ set jd [expr {
+ 1721425
+ + [dict get $date dayOfYear]
+ + ( 365 * $ym1 )
+ + ( $ym1 / 4 )
+ - ( $ym1 / 100 )
+ + ( $ym1 / 400 )
+ }]
+
# If the date is before the Gregorian change, use the Julian calendar.
- if { $jd < [mc GREGORIAN_CHANGE_DATE] } {
+ if { $jd < $changeover } {
dict set date gregorian 0
- set jd [expr { 1721423
- + [dict get $date dayOfYear]
- + ( 365 * $ym1 )
- + ( $ym1 / 4 ) }]
+ set jd [expr {
+ 1721423
+ + [dict get $date dayOfYear]
+ + ( 365 * $ym1 )
+ + ( $ym1 / 4 )
+ }]
}
dict set date julianDay $jd
@@ -4593,12 +4067,13 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } {
#
# GetJulianDayFromEraYearMonthWeekDay --
#
-# Determines the Julian Day number corresponding to the nth
-# given day-of-the-week in a given month.
+# Determines the Julian Day number corresponding to the nth given
+# day-of-the-week in a given month.
#
# Parameters:
# date - Dictionary containing the keys, 'era', 'year', 'month'
# 'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
+# changeover - Julian Day of adoption of the Gregorian calendar
#
# Results:
# Returns the given dictionary, augmented with a 'julianDay' key.
@@ -4606,13 +4081,15 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } {
# Side effects:
# None.
#
+# Bugs:
+# This code needs to be moved to the C layer.
+#
#----------------------------------------------------------------------
-proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } {
-
- # Come up with a reference day; either the zeroeth day of the
- # given month (dayOfWeekInMonth >= 0) or the seventh day of the
- # following month (dayOfWeekInMonth < 0)
+proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
+ # Come up with a reference day; either the zeroeth day of the given month
+ # (dayOfWeekInMonth >= 0) or the seventh day of the following month
+ # (dayOfWeekInMonth < 0)
set date2 $date
set week [dict get $date dayOfWeekInMonth]
@@ -4622,12 +4099,12 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } {
dict incr date2 month
dict set date2 dayOfMonth 7
}
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}]]
+ set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
+ $changeover]
set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
[dict get $date2 julianDay]]
dict set date julianDay [expr { $wd0 + 7 * $week }]
return $date
-
}
#----------------------------------------------------------------------
@@ -4650,9 +4127,8 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::IsGregorianLeapYear { date } {
-
switch -exact -- [dict get $date era] {
- BCE {
+ BCE {
set year [expr { 1 - [dict get $date year]}]
}
CE {
@@ -4670,15 +4146,14 @@ proc ::tcl::clock::IsGregorianLeapYear { date } {
} else {
return 1
}
-
}
#----------------------------------------------------------------------
#
# WeekdayOnOrBefore --
#
-# Determine the nearest day of week (given by the 'weekday'
-# parameter, Sunday==0) on or before a given Julian Day.
+# Determine the nearest day of week (given by the 'weekday' parameter,
+# Sunday==0) on or before a given Julian Day.
#
# Parameters:
# weekday -- Day of the week
@@ -4693,18 +4168,16 @@ proc ::tcl::clock::IsGregorianLeapYear { date } {
#----------------------------------------------------------------------
proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
-
set k [expr { ( $weekday + 6 ) % 7 }]
return [expr { $j - ( $j - $k ) % 7 }]
-
}
#----------------------------------------------------------------------
#
# BSearch --
#
-# Service procedure that does binary search in several places
-# inside the 'clock' command.
+# Service procedure that does binary search in several places inside the
+# 'clock' command.
#
# Parameters:
# list - List of lists, sorted in ascending order by the
@@ -4712,8 +4185,8 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
# key - Value to search for
#
# Results:
-# Returns the index of the greatest element in $list that is less
-# than or equal to $key.
+# Returns the index of the greatest element in $list that is less than
+# or equal to $key.
#
# Side effects:
# None.
@@ -4721,7 +4194,9 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
#----------------------------------------------------------------------
proc ::tcl::clock::BSearch { list key } {
-
+ if {[llength $list] == 0} {
+ return -1
+ }
if { $key < [lindex $list 0 0] } {
return -1
}
@@ -4730,13 +4205,12 @@ proc ::tcl::clock::BSearch { list key } {
set u [expr { [llength $list] - 1 }]
while { $l < $u } {
-
# At this point, we know that
# $k >= [lindex $list $l 0]
# Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
# We find the midpoint of the interval {l,u} rounded UP, compare
- # against it, and set l or u to maintain the invariant. Note
- # that the interval shrinks at each step, guaranteeing convergence.
+ # against it, and set l or u to maintain the invariant. Note that the
+ # interval shrinks at each step, guaranteeing convergence.
set m [expr { ( $l + $u + 1 ) / 2 }]
if { $key >= [lindex $list $m 0] } {
@@ -4780,55 +4254,49 @@ proc ::tcl::clock::BSearch { list key } {
# order.
#
# Notes:
-# It is possible that adding a number of months or years will adjust
-# the day of the month as well. For instance, the time at
-# one month after 31 January is either 28 or 29 February, because
-# February has fewer than 31 days.
+# It is possible that adding a number of months or years will adjust the
+# day of the month as well. For instance, the time at one month after
+# 31 January is either 28 or 29 February, because February has fewer
+# than 31 days.
#
#----------------------------------------------------------------------
proc ::tcl::clock::add { clockval args } {
-
if { [llength $args] % 2 != 0 } {
+ set cmdName "clock add"
return -code error \
-errorcode [list CLOCK wrongNumArgs] \
"wrong \# args: should be\
- \"[lindex [info level 0] 0] clockval\
- ?number units?...\
+ \"$cmdName clockval ?number units?...\
?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
}
- if { [catch { expr wide($clockval) } result] } {
+ if { [catch { expr {wide($clockval)} } result] } {
return -code error $result
}
set offsets {}
set gmt 0
- set locale C
+ set locale c
set timezone [GetSystemTimeZone]
foreach { a b } $args {
-
if { [string is integer -strict $a] } {
-
lappend offsets $a $b
-
} else {
-
switch -exact -- $a {
-
- -gmt {
+ -g - -gm - -gmt {
set gmt $b
}
- -locale {
- set locale $b
+ -l - -lo - -loc - -loca - -local - -locale {
+ set locale [string tolower $b]
}
+ -t - -ti - -tim - -time - -timez - -timezo - -timezon -
-timezone {
set timezone $b
}
default {
- return -code error \
- -errorcode [list CLOCK badSwitch $flag] \
- "bad switch \"$flag\",\
+ throw [list CLOCK badSwitch $a] \
+ "bad switch \"$a\",\
must be -gmt, -locale or -timezone"
}
}
@@ -4843,41 +4311,42 @@ proc ::tcl::clock::add { clockval args } {
"cannot use -gmt and -timezone in same call"
}
if { [catch { expr { wide($clockval) } } result] } {
- return -code error \
- "expected integer but got \"$clockval\""
+ return -code error "expected integer but got \"$clockval\""
}
- if { ![string is boolean $gmt] } {
- return -code error \
- "expected boolean value but got \"$gmt\""
- } else {
- if { $gmt } {
- set timezone :GMT
- }
+ if { ![string is boolean -strict $gmt] } {
+ return -code error "expected boolean value but got \"$gmt\""
+ } elseif { $gmt } {
+ set timezone :GMT
}
EnterLocale $locale oldLocale
- set status [catch {
+ set changeover [mc GREGORIAN_CHANGE_DATE]
- foreach { quantity unit } $offsets {
+ if {[catch {SetupTimeZone $timezone} retval opts]} {
+ dict unset opts -errorinfo
+ return -options $opts $retval
+ }
+ try {
+ foreach { quantity unit } $offsets {
switch -exact -- $unit {
-
years - year {
- set clockval \
- [AddMonths [expr { 12 * $quantity }] \
- $clockval $timezone]
+ set clockval [AddMonths [expr { 12 * $quantity }] \
+ $clockval $timezone $changeover]
}
months - month {
- set clockval [AddMonths $quantity $clockval $timezone]
+ set clockval [AddMonths $quantity $clockval $timezone \
+ $changeover]
}
weeks - week {
set clockval [AddDays [expr { 7 * $quantity }] \
- $clockval $timezone]
+ $clockval $timezone $changeover]
}
days - day {
- set clockval [AddDays $quantity $clockval $timezone]
+ set clockval [AddDays $quantity $clockval $timezone \
+ $changeover]
}
hours - hour {
@@ -4891,31 +4360,24 @@ proc ::tcl::clock::add { clockval args } {
}
default {
- error "unknown unit \"$unit\", must be \
- years, months, weeks, days, hours, minutes or seconds" \
- "unknown unit \"$unit\", must be \
- years, months, weeks, days, hours, minutes or seconds" \
- [list CLOCK badUnit $unit]
+ throw [list CLOCK badUnit $unit] \
+ "unknown unit \"$unit\", must be \
+ years, months, weeks, days, hours, minutes or seconds"
}
}
}
- } result opts]
-
- # Restore the locale
-
- if { [info exists oldLocale] } {
- mclocale $oldLocale
- }
+ return $clockval
+ } trap CLOCK {result opts} {
+ # Conceal the innards of [clock] when it's an expected error
+ dict unset opts -errorinfo
+ return -options $opts $result
+ } finally {
+ # Restore the locale
- if { $status == 1 } {
- if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
- dict unset opts -errorinfo
+ if { [info exists oldLocale] } {
+ mclocale $oldLocale
}
- return -options $opts $result
- } else {
- return $clockval
}
-
}
#----------------------------------------------------------------------
@@ -4939,21 +4401,17 @@ proc ::tcl::clock::add { clockval args } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AddMonths { months clockval timezone } {
-
+proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
variable DaysInRomanMonthInCommonYear
variable DaysInRomanMonthInLeapYear
+ variable TZData
# Convert the time to year, month, day, and fraction of day.
- set date [GetMonthDay \
- [GetGregorianEraYearDay \
- [GetJulianDay \
- [ConvertUTCToLocal \
- [dict create seconds $clockval] \
- $timezone]]]]
- dict set date secondOfDay [expr { [dict get $date localSeconds]
- % 86400 }]
+ set date [GetDateFields $clockval $TZData($timezone) $changeover]
+ dict set date secondOfDay [expr {
+ [dict get $date localSeconds] % 86400
+ }]
dict set date tzName $timezone
# Add the requisite number of months
@@ -4980,48 +4438,50 @@ proc ::tcl::clock::AddMonths { months clockval timezone } {
# Reconvert to a number of seconds
set date [GetJulianDayFromEraYearMonthDay \
- $date[set date {}]]
- dict set date localSeconds \
- [expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
- set date [ConvertLocalToUTC $date[set date {}]]
+ $date[set date {}]\
+ $changeover]
+ dict set date localSeconds [expr {
+ -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay]
+ }]
+ set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
+ $changeover]
return [dict get $date seconds]
-
}
#----------------------------------------------------------------------
#
# AddDays --
#
-# Add a given number of days to a given clock value in a given
-# time zone.
+# Add a given number of days to a given clock value in a given time
+# zone.
#
# Parameters:
# days - Number of days to add (may be negative)
# clockval - Seconds since the epoch before the operation
# timezone - Time zone in which the operation is to be performed
+# changeover - Julian Day on which the Gregorian calendar was adopted
+# in the target locale.
#
# Results:
-# Returns the new clock value as a number of seconds since
-# the epoch.
+# Returns the new clock value as a number of seconds since the epoch.
#
# Side effects:
# None.
#
#----------------------------------------------------------------------
-proc ::tcl::clock::AddDays { days clockval timezone } {
+proc ::tcl::clock::AddDays { days clockval timezone changeover } {
+ variable TZData
# Convert the time to Julian Day
- set date [GetJulianDay \
- [ConvertUTCToLocal \
- [dict create seconds $clockval] \
- $timezone]]
- dict set date secondOfDay [expr { [dict get $date localSeconds]
- % 86400 }]
+ set date [GetDateFields $clockval $TZData($timezone) $changeover]
+ dict set date secondOfDay [expr {
+ [dict get $date localSeconds] % 86400
+ }]
dict set date tzName $timezone
# Add the requisite number of days
@@ -5030,22 +4490,23 @@ proc ::tcl::clock::AddDays { days clockval timezone } {
# Reconvert to a number of seconds
- dict set date localSeconds \
- [expr { -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay] }]
- set date [ConvertLocalToUTC $date[set date {}]]
+ dict set date localSeconds [expr {
+ -210866803200
+ + ( 86400 * wide([dict get $date julianDay]) )
+ + [dict get $date secondOfDay]
+ }]
+ set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
+ $changeover]
return [dict get $date seconds]
-
}
#----------------------------------------------------------------------
#
# mc --
#
-# Wrapper around ::msgcat::mc that caches the result according
-# to the locale.
+# Wrapper around ::msgcat::mc that caches the result according to the
+# locale.
#
# Parameters:
# Accepts the name of the message to retrieve.
@@ -5066,11 +4527,10 @@ proc ::tcl::clock::mc { name } {
set Locale [mclocale]
if { [dict exists $McLoaded $Locale $name] } {
return [dict get $McLoaded $Locale $name]
- } else {
- set val [::msgcat::mc $name]
- dict set McLoaded $Locale $name $val
- return $val
}
+ set val [::msgcat::mc $name]
+ dict set McLoaded $Locale $name $val
+ return $val
}
#----------------------------------------------------------------------
@@ -5091,7 +4551,7 @@ proc ::tcl::clock::mc { name } {
#----------------------------------------------------------------------
proc ::tcl::clock::ClearCaches {} {
-
+ variable FormatProc
variable LocaleNumeralCache
variable McLoaded
variable CachedSystemTimeZone
@@ -5100,11 +4560,14 @@ proc ::tcl::clock::ClearCaches {} {
foreach p [info procs [namespace current]::scanproc'*] {
rename $p {}
}
+ foreach p [info procs [namespace current]::formatproc'*] {
+ rename $p {}
+ }
+ catch {unset FormatProc}
set LocaleNumeralCache {}
set McLoaded {}
catch {unset CachedSystemTimeZone}
set TimeZoneBad {}
InitTZData
-
}
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index d069046..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.1 [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.1 [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/encoding/tis-620.enc b/library/encoding/tis-620.enc
index c233be5..c233be5 100755..100644
--- a/library/encoding/tis-620.enc
+++ b/library/encoding/tis-620.enc
diff --git a/library/history.tcl b/library/history.tcl
index 3a3f16a..51d2404 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -2,22 +2,20 @@
#
# Implementation of the history command.
#
-# RCS: @(#) $Id: history.tcl,v 1.7 2005/07/23 04:12:49 dgp Exp $
-#
# Copyright (c) 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-
-# The tcl::history array holds the history list and
-# some additional bookkeeping variables.
+
+# The tcl::history array holds the history list and some additional
+# bookkeeping variables.
#
# nextid the index used for the next history list item.
# keep the max size of the history list
# oldest the index of the oldest item in the history.
-namespace eval tcl {
+namespace eval ::tcl {
variable history
if {![info exists history]} {
array set history {
@@ -26,163 +24,78 @@ namespace eval tcl {
oldest -20
}
}
-}
+ namespace ensemble create -command ::tcl::history -map {
+ add ::tcl::HistAdd
+ change ::tcl::HistChange
+ clear ::tcl::HistClear
+ event ::tcl::HistEvent
+ info ::tcl::HistInfo
+ keep ::tcl::HistKeep
+ nextid ::tcl::HistNextID
+ redo ::tcl::HistRedo
+ }
+}
+
# history --
#
# This is the main history command. See the man page for its interface.
-# This does argument checking and calls helper procedures in the
-# history namespace.
+# This does some argument checking and calls the helper ensemble in the
+# tcl namespace.
-proc history {args} {
- set len [llength $args]
- if {$len == 0} {
- return [tcl::HistInfo]
- }
- set key [lindex $args 0]
- set options "add, change, clear, event, info, keep, nextid, or redo"
- switch -glob -- $key {
- a* { # history add
+proc ::history {args} {
+ # If no command given, we're doing 'history info'. Can't be done with an
+ # ensemble unknown handler, as those don't fire when no subcommand is
+ # given at all.
- if {$len > 3} {
- return -code error "wrong # args: should be \"history add event ?exec?\""
- }
- if {![string match $key* add]} {
- return -code error "bad option \"$key\": must be $options"
- }
- if {$len == 3} {
- set arg [lindex $args 2]
- if {! ([string match e* $arg] && [string match $arg* exec])} {
- return -code error "bad argument \"$arg\": should be \"exec\""
- }
- }
- return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
- }
- ch* { # history change
-
- if {($len > 3) || ($len < 2)} {
- return -code error "wrong # args: should be \"history change newValue ?event?\""
- }
- if {![string match $key* change]} {
- return -code error "bad option \"$key\": must be $options"
- }
- if {$len == 2} {
- set event 0
- } else {
- set event [lindex $args 2]
- }
-
- return [tcl::HistChange [lindex $args 1] $event]
- }
- cl* { # history clear
-
- if {($len > 1)} {
- return -code error "wrong # args: should be \"history clear\""
- }
- if {![string match $key* clear]} {
- return -code error "bad option \"$key\": must be $options"
- }
- return [tcl::HistClear]
- }
- e* { # history event
-
- if {$len > 2} {
- return -code error "wrong # args: should be \"history event ?event?\""
- }
- if {![string match $key* event]} {
- return -code error "bad option \"$key\": must be $options"
- }
- if {$len == 1} {
- set event -1
- } else {
- set event [lindex $args 1]
- }
- return [tcl::HistEvent $event]
- }
- i* { # history info
-
- if {$len > 2} {
- return -code error "wrong # args: should be \"history info ?count?\""
- }
- if {![string match $key* info]} {
- return -code error "bad option \"$key\": must be $options"
- }
- return [tcl::HistInfo [lindex $args 1]]
- }
- k* { # history keep
-
- if {$len > 2} {
- return -code error "wrong # args: should be \"history keep ?count?\""
- }
- if {$len == 1} {
- return [tcl::HistKeep]
- } else {
- set limit [lindex $args 1]
- if {[catch {expr {~$limit}}] || ($limit < 0)} {
- return -code error "illegal keep count \"$limit\""
- }
- return [tcl::HistKeep $limit]
- }
- }
- n* { # history nextid
-
- if {$len > 1} {
- return -code error "wrong # args: should be \"history nextid\""
- }
- if {![string match $key* nextid]} {
- return -code error "bad option \"$key\": must be $options"
- }
- return [expr {$tcl::history(nextid) + 1}]
- }
- r* { # history redo
-
- if {$len > 2} {
- return -code error "wrong # args: should be \"history redo ?event?\""
- }
- if {![string match $key* redo]} {
- return -code error "bad option \"$key\": must be $options"
- }
- return [tcl::HistRedo [lindex $args 1]]
- }
- default {
- return -code error "bad option \"$key\": must be $options"
- }
+ if {![llength $args]} {
+ set args info
}
-}
+ # Tricky stuff needed to make stack and errors come out right!
+ tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
+}
+
# tcl::HistAdd --
#
# Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
-# command the command to add
-# exec (optional) a substring of "exec" causes the
-# command to be evaled.
+# event the command to add
+# exec (optional) a substring of "exec" causes the command to
+# be evaled.
# Results:
# If executing, then the results of the command are returned
#
# Side Effects:
# Adds to the history list
- proc tcl::HistAdd {command {exec {}}} {
+proc ::tcl::HistAdd {event {exec {}}} {
variable history
+ if {
+ [prefix longest {exec {}} $exec] eq ""
+ && [llength [info level 0]] == 3
+ } then {
+ return -code error "bad argument \"$exec\": should be \"exec\""
+ }
+
# Do not add empty commands to the history
- if {[string trim $command] eq ""} {
+ if {[string trim $event] eq ""} {
return ""
}
- set i [incr history(nextid)]
- set history($i) $command
- set j [incr history(oldest)]
- unset -nocomplain history($j)
- if {[string match e* $exec]} {
- return [uplevel #0 $command]
- } else {
- return {}
+ # Maintain the history
+ set history([incr history(nextid)]) $event
+ unset -nocomplain history([incr history(oldest)])
+
+ # Only execute if 'exec' (or non-empty prefix of it) given
+ if {$exec eq ""} {
+ return ""
}
+ tailcall eval $event
}
-
+
# tcl::HistKeep --
#
# Set or query the limit on the length of the history list
@@ -196,20 +109,22 @@ proc history {args} {
# Side Effects:
# Updates history(keep) if a limit is specified
- proc tcl::HistKeep {{limit {}}} {
+proc ::tcl::HistKeep {{count {}}} {
variable history
- if {$limit eq ""} {
+ if {[llength [info level 0]] == 1} {
return $history(keep)
- } else {
- set oldold $history(oldest)
- set history(oldest) [expr {$history(nextid) - $limit}]
- for {} {$oldold <= $history(oldest)} {incr oldold} {
- unset -nocomplain history($oldold)
- }
- set history(keep) $limit
}
+ if {![string is integer -strict $count] || ($count < 0)} {
+ return -code error "illegal keep count \"$count\""
+ }
+ set oldold $history(oldest)
+ set history(oldest) [expr {$history(nextid) - $count}]
+ for {} {$oldold <= $history(oldest)} {incr oldold} {
+ unset -nocomplain history($oldold)
+ }
+ set history(keep) $count
}
-
+
# tcl::HistClear --
#
# Erase the history list
@@ -223,7 +138,7 @@ proc history {args} {
# Side Effects:
# Resets the history array, except for the keep limit
- proc tcl::HistClear {} {
+proc ::tcl::HistClear {} {
variable history
set keep $history(keep)
unset history
@@ -233,7 +148,7 @@ proc history {args} {
oldest -$keep \
]
}
-
+
# tcl::HistInfo --
#
# Return a pretty-printed version of the history list
@@ -244,14 +159,16 @@ proc history {args} {
# Results:
# A formatted history list
- proc tcl::HistInfo {{num {}}} {
+proc ::tcl::HistInfo {{count {}}} {
variable history
- if {$num eq ""} {
- set num [expr {$history(keep) + 1}]
+ if {[llength [info level 0]] == 1} {
+ set count [expr {$history(keep) + 1}]
+ } elseif {![string is integer -strict $count]} {
+ return -code error "bad integer \"$count\""
}
set result {}
set newline ""
- for {set i [expr {$history(nextid) - $num + 1}]} \
+ for {set i [expr {$history(nextid) - $count + 1}]} \
{$i <= $history(nextid)} {incr i} {
if {![info exists history($i)]} {
continue
@@ -262,11 +179,11 @@ proc history {args} {
}
return $result
}
-
+
# tcl::HistRedo --
#
-# Fetch the previous or specified event, execute it, and then
-# replace the current history item with that event.
+# Fetch the previous or specified event, execute it, and then replace
+# the current history item with that event.
#
# Parameters:
# event (optional) index of history item to redo. Defaults to -1,
@@ -278,20 +195,18 @@ proc history {args} {
# Side Effects:
# Replaces the current history list item with the one being redone.
- proc tcl::HistRedo {{event -1}} {
+proc ::tcl::HistRedo {{event -1}} {
variable history
- if {$event eq ""} {
- set event -1
- }
+
set i [HistIndex $event]
if {$i == $history(nextid)} {
return -code error "cannot redo the current event"
}
set cmd $history($i)
HistChange $cmd 0
- uplevel #0 $cmd
+ tailcall eval $cmd
}
-
+
# tcl::HistIndex --
#
# Map from an event specifier to an index in the history list.
@@ -301,22 +216,22 @@ proc history {args} {
# If this is a positive number, it is used directly.
# If it is a negative number, then it counts back to a previous
# event, where -1 is the most recent event.
-# A string can be matched, either by being the prefix of
-# a command or by matching a command with string match.
+# A string can be matched, either by being the prefix of a
+# command or by matching a command with string match.
#
# Results:
# The index into history, or an error if the index didn't match.
- proc tcl::HistIndex {event} {
+proc ::tcl::HistIndex {event} {
variable history
- if {[catch {expr {~$event}}]} {
+ if {![string is integer -strict $event]} {
for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
{incr i -1} {
if {[string match $event* $history($i)]} {
- return $i;
+ return $i
}
if {[string match $event $history($i)]} {
- return $i;
+ return $i
}
}
return -code error "no event matches \"$event\""
@@ -333,43 +248,64 @@ proc history {args} {
}
return $i
}
-
+
# tcl::HistEvent --
#
# Map from an event specifier to the value in the history list.
#
# Parameters:
-# event index of history item to redo. See index for a
-# description of possible event patterns.
+# event index of history item to redo. See index for a description of
+# possible event patterns.
#
# Results:
# The value from the history list.
- proc tcl::HistEvent {event} {
+proc ::tcl::HistEvent {{event -1}} {
variable history
set i [HistIndex $event]
- if {[info exists history($i)]} {
- return [string trimright $history($i) \ \n]
- } else {
- return "";
+ if {![info exists history($i)]} {
+ return ""
}
+ return [string trimright $history($i) \ \n]
}
-
+
# tcl::HistChange --
#
# Replace a value in the history list.
#
# Parameters:
-# cmd The new value to put into the history list.
-# event (optional) index of history item to redo. See index for a
-# description of possible event patterns. This defaults
-# to 0, which specifies the current event.
+# newValue The new value to put into the history list.
+# event (optional) index of history item to redo. See index for a
+# description of possible event patterns. This defaults to 0,
+# which specifies the current event.
#
# Side Effects:
# Changes the history list.
- proc tcl::HistChange {cmd {event 0}} {
+proc ::tcl::HistChange {newValue {event 0}} {
variable history
set i [HistIndex $event]
- set history($i) $cmd
+ set history($i) $newValue
}
+
+# tcl::HistNextID --
+#
+# Returns the number of the next history event.
+#
+# Parameters:
+# None.
+#
+# Side Effects:
+# None.
+
+proc ::tcl::HistNextID {} {
+ variable history
+ return [expr {$history(nextid) + 1}]
+}
+
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/library/http/http.tcl b/library/http/http.tcl
index c3454c4..a6b2bfd 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1,85 +1,119 @@
# http.tcl --
#
-# Client-side HTTP for GET, POST, and HEAD commands.
-# These routines can be used in untrusted code that uses
-# the Safesock security policy. These procedures use a
-# callback interface to avoid using vwait, which is not
-# defined in the safe base.
-#
-# 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.51 2005/05/10 18:34:54 kennykb Exp $
-
-# Rough version history:
-# 1.0 Old http_get interface
-# 2.0 http:: namespace and http::geturl
-# 2.1 Added callbacks to handle arriving data, and timeouts
-# 2.2 Added ability to fetch into a channel
-# 2.3 Added SSL support, and ability to post from a channel
-# This version also cleans up error cases and eliminates the
-# "ioerror" status in favor of raising an error
-# 2.4 Added -binary option to http::geturl and charset element
-# to the state array.
-
-package require Tcl 8.4
-# keep this in sync with pkgIndex.tcl
-# and with the install directories in Makefiles
-package provide http 2.5.1
+# Client-side HTTP for GET, POST, and HEAD commands. These routines can
+# be used in untrusted code that uses the Safesock security policy.
+# These procedures use a callback interface to avoid using vwait, which
+# is not defined in the safe base.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.6
+# Keep this in sync with pkgIndex.tcl and with the install directories in
+# Makefiles
+package provide http 2.8.8
namespace eval http {
+ # Allow resourcing to not clobber existing data
+
variable http
- array set http {
- -accept */*
- -proxyhost {}
- -proxyport {}
- -proxyfilter http::ProxyRequired
- -urlencoding utf-8
+ if {![info exists http]} {
+ array set http {
+ -accept */*
+ -proxyhost {}
+ -proxyport {}
+ -proxyfilter http::ProxyRequired
+ -urlencoding utf-8
+ }
+ # We need a useragent string of this style or various servers will refuse to
+ # send us compressed content even when we ask for it. This follows the
+ # de-facto layout of user-agent strings in current browsers.
+ set http(-useragent) "Mozilla/5.0\
+ ([string totitle $::tcl_platform(platform)]; U;\
+ $::tcl_platform(os) $::tcl_platform(osVersion))\
+ http/[package provide http] Tcl/[package provide Tcl]"
}
- set http(-useragent) "Tcl http client package [package provide http]"
proc init {} {
- # Set up the map for quoting chars
- # The spec says: "non-alphanumeric characters are replaced by '%HH'"
- for {set i 0} {$i < 256} {incr i} {
+ # Set up the map for quoting chars. RFC3986 Section 2.3 say percent
+ # encode all except: "... percent-encoded octets in the ranges of
+ # ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
+ # (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
+ # producers ..."
+ 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]
+ if {![string match {[-._~a-zA-Z0-9]} $c]} {
+ set map($c) %[format %.2X $i]
}
}
# These are handled specially
- array set map { " " + \n %0d%0a }
+ set map(\n) %0D%0A
variable formMap [array get map]
+
+ # Create a map for HTTP/1.1 open sockets
+ variable socketmap
+ if {[info exists socketmap]} {
+ # Close but don't remove open sockets on re-init
+ foreach {url sock} [array get socketmap] {
+ catch {close $sock}
+ }
+ }
+ array set socketmap {}
}
init
variable urlTypes
- array set urlTypes {
- http {80 ::socket}
+ if {![info exists urlTypes]} {
+ set urlTypes(http) [list 80 ::socket]
}
variable encodings [string tolower [encoding names]]
# This can be changed, but iso8859-1 is the RFC standard.
- variable defaultCharset "iso8859-1"
+ variable defaultCharset
+ if {![info exists defaultCharset]} {
+ set defaultCharset "iso8859-1"
+ }
+
+ # Force RFC 3986 strictness in geturl url verification?
+ variable strict
+ if {![info exists strict]} {
+ set strict 1
+ }
+
+ # Let user control default keepalive for compatibility
+ variable defaultKeepalive
+ if {![info exists defaultKeepalive]} {
+ set defaultKeepalive 0
+ }
namespace export geturl config reset wait formatQuery register unregister
# Useful, but not exported: data size status code
}
+# http::Log --
+#
+# Debugging output -- define this to observe HTTP/1.1 socket usage.
+# Should echo any args received.
+#
+# Arguments:
+# msg Message to output
+#
+if {[info command http::Log] eq {}} {proc http::Log {args} {}}
+
# http::register --
#
-# See documentaion for details.
+# See documentation for details.
#
# Arguments:
-# proto URL protocol prefix, e.g. https
-# port Default port for protocol
-# command Command to use to create socket
+# proto URL protocol prefix, e.g. https
+# port Default port for protocol
+# command Command to use to create socket
# Results:
# list of port and command that was registered.
proc http::register {proto port command} {
variable urlTypes
- set urlTypes($proto) [list $port $command]
+ set urlTypes([string tolower $proto]) [list $port $command]
}
# http::unregister --
@@ -87,23 +121,24 @@ proc http::register {proto port command} {
# Unregisters URL protocol handler
#
# Arguments:
-# proto URL protocol prefix, e.g. https
+# proto URL protocol prefix, e.g. https
# Results:
# list of port and command that was unregistered.
proc http::unregister {proto} {
variable urlTypes
- if {![info exists urlTypes($proto)]} {
+ set lower [string tolower $proto]
+ if {![info exists urlTypes($lower)]} {
return -code error "unsupported url type \"$proto\""
}
- set old $urlTypes($proto)
- unset urlTypes($proto)
+ set old $urlTypes($lower)
+ unset urlTypes($lower)
return $old
}
# http::config --
#
-# See documentaion for details.
+# See documentation for details.
#
# Arguments:
# args Options parsed by the procedure.
@@ -122,21 +157,19 @@ proc http::config {args} {
return $result
}
set options [string map {- ""} $options]
- set pat ^-([join $options |])$
+ set pat ^-(?:[join $options |])$
if {[llength $args] == 1} {
set flag [lindex $args 0]
- if {[regexp -- $pat $flag]} {
- return $http($flag)
- } else {
+ if {![regexp -- $pat $flag]} {
return -code error "Unknown option $flag, must be: $usage"
}
+ return $http($flag)
} else {
foreach {flag value} $args {
- if {[regexp -- $pat $flag]} {
- set http($flag) $value
- } else {
+ if {![regexp -- $pat $flag]} {
return -code error "Unknown option $flag, must be: $usage"
}
+ set http($flag) $value
}
}
}
@@ -148,41 +181,87 @@ proc http::config {args} {
# Arguments:
# token Connection token.
# errormsg (optional) If set, forces status to error.
-# skipCB (optional) If set, don't call the -command callback. This
-# is useful when geturl wants to throw an exception instead
-# of calling the callback. That way, the same error isn't
-# reported to two places.
+# skipCB (optional) If set, don't call the -command callback. This
+# is useful when geturl wants to throw an exception instead
+# of calling the callback. That way, the same error isn't
+# reported to two places.
#
# Side Effects:
# Closes the socket
-proc http::Finish { token {errormsg ""} {skipCB 0}} {
+proc http::Finish {token {errormsg ""} {skipCB 0}} {
variable $token
upvar 0 $token state
global errorInfo errorCode
- if {[string length $errormsg] != 0} {
+ if {$errormsg ne ""} {
set state(error) [list $errormsg $errorInfo $errorCode]
- set state(status) error
+ set state(status) "error"
}
- catch {close $state(sock)}
- catch {after cancel $state(after)}
- if {[info exists state(-command)] && !$skipCB} {
- if {[catch {eval $state(-command) {$token}} err]} {
- if {[string length $errormsg] == 0} {
- set state(error) [list $err $errorInfo $errorCode]
- set state(status) error
- }
+ if {
+ ($state(status) eq "timeout") || ($state(status) eq "error") ||
+ ([info exists state(connection)] && ($state(connection) eq "close"))
+ } {
+ CloseSocket $state(sock) $token
+ }
+ if {[info exists state(after)]} {
+ after cancel $state(after)
+ }
+ 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
+ }
+ }
+}
+
+# http::CloseSocket -
+#
+# Close a socket and remove it from the persistent sockets table. If
+# possible an http token is included here but when we are called from a
+# fileevent on remote closure we need to find the correct entry - hence
+# the second section.
+
+proc ::http::CloseSocket {s {token {}}} {
+ variable socketmap
+ catch {fileevent $s readable {}}
+ set conn_id {}
+ if {$token ne ""} {
+ variable $token
+ upvar 0 $token state
+ if {[info exists state(socketinfo)]} {
+ set conn_id $state(socketinfo)
+ }
+ } else {
+ set map [array get socketmap]
+ set ndx [lsearch -exact $map $s]
+ if {$ndx != -1} {
+ incr ndx -1
+ set conn_id [lindex $map $ndx]
+ }
+ }
+ if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {
+ Log "Closing socket $s (no connection info)"
+ if {[catch {close $s} err]} {
+ Log "Error: $err"
}
- if {[info exists state(-command)]} {
- # Command callback may already have unset our state
- unset state(-command)
+ } else {
+ if {[info exists socketmap($conn_id)]} {
+ Log "Closing connection $conn_id (sock $socketmap($conn_id))"
+ if {[catch {close $socketmap($conn_id)} err]} {
+ Log "Error: $err"
+ }
+ unset socketmap($conn_id)
+ } else {
+ Log "Cannot close connection $conn_id - no socket in socket map"
}
}
}
# http::reset --
#
-# See documentaion for details.
+# See documentation for details.
#
# Arguments:
# token Connection token.
@@ -191,7 +270,7 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} {
# Side Effects:
# See Finish
-proc http::reset { token {why reset} } {
+proc http::reset {token {why reset}} {
variable $token
upvar 0 $token state
set state(status) $why
@@ -214,17 +293,18 @@ proc http::reset { token {why reset} } {
# args Option value pairs. Valid options include:
# -blocksize, -validate, -headers, -timeout
# Results:
-# Returns a token for this connection.
-# This token is the name of an array that the caller should
-# unset to garbage collect the state.
+# Returns a token for this connection. This token is the name of an
+# array that the caller should unset to garbage collect the state.
-proc http::geturl { url args } {
+proc http::geturl {url args} {
variable http
variable urlTypes
variable defaultCharset
+ variable defaultKeepalive
+ variable strict
- # Initialize the state variable, an array. We'll return the
- # name of this array as the token for the transaction.
+ # Initialize the state variable, an array. We'll return the name of this
+ # array as the token for the transaction.
if {![info exists http(uid)]} {
set http(uid) 0
@@ -238,47 +318,58 @@ proc http::geturl { url args } {
array set state {
-binary false
- -blocksize 8192
+ -blocksize 8192
-queryblocksize 8192
- -validate 0
- -headers {}
- -timeout 0
- -type application/x-www-form-urlencoded
+ -validate 0
+ -headers {}
+ -timeout 0
+ -type application/x-www-form-urlencoded
-queryprogress {}
- state header
+ -protocol 1.1
+ binary 0
+ state connecting
meta {}
coding {}
currentsize 0
totalsize 0
querylength 0
queryoffset 0
- type text/html
- body {}
+ type text/html
+ body {}
status ""
- http ""
+ http ""
+ connection close
}
+ set state(-keepalive) $defaultKeepalive
+ set state(-strict) $strict
# These flags have their types verified [Bug 811170]
array set type {
-binary boolean
-blocksize integer
-queryblocksize integer
- -validate boolean
+ -strict boolean
-timeout integer
+ -validate boolean
}
set state(charset) $defaultCharset
- set options {-binary -blocksize -channel -command -handler -headers \
- -progress -query -queryblocksize -querychannel -queryprogress\
- -validate -timeout -type}
- set usage [join $options ", "]
+ set options {
+ -binary -blocksize -channel -command -handler -headers -keepalive
+ -method -myaddr -progress -protocol -query -queryblocksize
+ -querychannel -queryprogress -strict -timeout -type -validate
+ }
+ set usage [join [lsort $options] ", "]
set options [string map {- ""} $options]
- set pat ^-([join $options |])$
+ set pat ^-(?:[join $options |])$
foreach {flag value} $args {
- if {[regexp $pat $flag]} {
+ if {[regexp -- $pat $flag]} {
# Validate numbers
- if {[info exists type($flag)] && \
- ![string is $type($flag) -strict $value]} {
+ if {
+ [info exists type($flag)] &&
+ ![string is $type($flag) -strict $value]
+ } {
unset $token
- return -code error "Bad value for $flag ($value), must be $type($flag)"
+ return -code error \
+ "Bad value for $flag ($value), must be $type($flag)"
}
set state($flag) $value
} else {
@@ -297,101 +388,281 @@ proc http::geturl { url args } {
}
# Validate URL, determine the server host and port, and check proxy case
- # Recognize user:pass@host URLs also, although we do not do anything
- # with that info yet.
+ # Recognize user:pass@host URLs also, although we do not do anything with
+ # that info yet.
+
+ # URLs have basically four parts.
+ # First, before the colon, is the protocol scheme (e.g. http)
+ # Second, for HTTP-like protocols, is the authority
+ # The authority is preceded by // and lasts up to (but not including)
+ # the following / or ? and it identifies up to four parts, of which
+ # only one, the host, is required (if an authority is present at all).
+ # All other parts of the authority (user name, password, port number)
+ # are optional.
+ # Third is the resource name, which is split into two parts at a ?
+ # The first part (from the single "/" up to "?") is the path, and the
+ # second part (from that "?" up to "#") is the query. *HOWEVER*, we do
+ # not need to separate them; we send the whole lot to the server.
+ # Both, path and query are allowed to be missing, including their
+ # delimiting character.
+ # Fourth is the fragment identifier, which is everything after the first
+ # "#" in the URL. The fragment identifier MUST NOT be sent to the server
+ # and indeed, we don't bother to validate it (it could be an error to
+ # pass it in here, but it's cheap to strip).
+ #
+ # An example of a URL that has all the parts:
+ #
+ # http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes
+ #
+ # The "http" is the protocol, the user is "jschmoe", the password is
+ # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
+ # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
+ #
+ # 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.
+ #
+ # 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
+ # done if $state(-strict) is true (inherited from $::http::strict).
+
+ set URLmatcher {(?x) # this is _expanded_ syntax
+ ^
+ (?: (\w+) : ) ? # <protocol scheme>
+ (?: //
+ (?:
+ (
+ [^@/\#?]+ # <userinfo 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)
+ (?: \# (.*) )? # <fragment>
+ $
+ }
- set exp {^(([^:]*)://)?([^@]+@)?([^/:]+)(:([0-9]+))?(/.*)?$}
- if {![regexp -nocase $exp $url x prefix proto user host y port srvurl]} {
+ # Phase one: parse
+ if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
unset $token
return -code error "Unsupported URL: $url"
}
- if {[string length $proto] == 0} {
+ # 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.
+ unset $token
+ return -code error "Missing host part: $url"
+ # Note that we don't check the hostname for validity here; if it's
+ # invalid, we'll simply fail to resolve it later on.
+ }
+ if {$port ne "" && $port > 65535} {
+ unset $token
+ return -code error "Invalid port number: $port"
+ }
+ # The user identification and resource identification parts of the URL can
+ # have encoded characters in them; take care!
+ if {$user ne ""} {
+ # Check for validity according to RFC 3986, Appendix A
+ set validityRE {(?xi)
+ ^
+ (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
+ $
+ }
+ if {$state(-strict) && ![regexp -- $validityRE $user]} {
+ unset $token
+ # Provide a better error message in this error case
+ if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} {
+ return -code error \
+ "Illegal encoding character usage \"$bad\" in URL user"
+ }
+ return -code error "Illegal characters in URL user"
+ }
+ }
+ if {$srvurl ne ""} {
+ # RFC 3986 allows empty paths (not even a /), but servers
+ # return 400 if the path in the HTTP request doesn't start
+ # with / , so add it here if needed.
+ if {[string index $srvurl 0] ne "/"} {
+ set srvurl /$srvurl
+ }
+ # Check for validity according to RFC 3986, Appendix A
+ set validityRE {(?xi)
+ ^
+ # Path part (already must start with / character)
+ (?: [-\w.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )*
+ # Query part (optional, permits ? characters)
+ (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
+ $
+ }
+ if {$state(-strict) && ![regexp -- $validityRE $srvurl]} {
+ unset $token
+ # Provide a better error message in this error case
+ if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
+ return -code error \
+ "Illegal encoding character usage \"$bad\" in URL path"
+ }
+ return -code error "Illegal characters in URL path"
+ }
+ } else {
+ set srvurl /
+ }
+ if {$proto eq ""} {
set proto http
- set url ${proto}://$url
}
- if {![info exists urlTypes($proto)]} {
+ set lower [string tolower $proto]
+ if {![info exists urlTypes($lower)]} {
unset $token
return -code error "Unsupported URL type \"$proto\""
}
- set defport [lindex $urlTypes($proto) 0]
- set defcmd [lindex $urlTypes($proto) 1]
+ set defport [lindex $urlTypes($lower) 0]
+ set defcmd [lindex $urlTypes($lower) 1]
- if {[string length $port] == 0} {
+ if {$port eq ""} {
set port $defport
}
- if {[string length $srvurl] == 0} {
- set srvurl /
- }
- if {[string length $proto] == 0} {
- set url http://$url
- }
- set state(url) $url
if {![catch {$http(-proxyfilter) $host} proxy]} {
set phost [lindex $proxy 0]
set pport [lindex $proxy 1]
}
- # If a timeout is specified we set up the after event
- # and arrange for an asynchronous socket connection.
+ # OK, now reassemble into a full URL
+ set url ${proto}://
+ if {$user ne ""} {
+ append url $user
+ append url @
+ }
+ append url $host
+ if {$port != $defport} {
+ append url : $port
+ }
+ append url $srvurl
+ # Don't append the fragment!
+ set state(url) $url
+
+ # If a timeout is specified we set up the after event and arrange for an
+ # asynchronous socket connection.
+ set sockopts [list -async]
if {$state(-timeout) > 0} {
set state(after) [after $state(-timeout) \
[list http::reset $token timeout]]
- set async -async
- } else {
- set async ""
}
- # If we are using the proxy, we must pass in the full URL that
- # includes the server name.
+ # If we are using the proxy, we must pass in the full URL that includes
+ # the server name.
- if {[info exists phost] && [string length $phost]} {
+ if {[info exists phost] && ($phost ne "")} {
set srvurl $url
- set conStat [catch {eval $defcmd $async {$phost $pport}} s]
+ set targetAddr [list $phost $pport]
} else {
- set conStat [catch {eval $defcmd $async {$host $port}} s]
+ set targetAddr [list $host $port]
}
- if {$conStat} {
+ # Proxy connections aren't shared among different hosts.
+ set state(socketinfo) $host:$port
+
+ # See if we are supposed to use a previously opened channel.
+ if {$state(-keepalive)} {
+ variable socketmap
+ if {[info exists socketmap($state(socketinfo))]} {
+ if {[catch {fconfigure $socketmap($state(socketinfo))}]} {
+ Log "WARNING: socket for $state(socketinfo) was closed"
+ unset socketmap($state(socketinfo))
+ } else {
+ set sock $socketmap($state(socketinfo))
+ Log "reusing socket $sock for $state(socketinfo)"
+ catch {fileevent $sock writable {}}
+ catch {fileevent $sock readable {}}
+ }
+ }
+ # don't automatically close this connection socket
+ set state(connection) {}
+ }
+ if {![info exists sock]} {
+ # Pass -myaddr directly to the socket command
+ if {[info exists state(-myaddr)]} {
+ lappend sockopts -myaddr $state(-myaddr)
+ }
+ if {[catch {eval $defcmd $sockopts $targetAddr} sock]} {
+ # something went wrong while trying to establish the connection.
+ # Clean up after events and such, but DON'T call the command
+ # callback (if available) because we're going to throw an
+ # exception from here instead.
- # something went wrong while trying to establish the connection
- # Clean up after events and such, but DON'T call the command callback
- # (if available) because we're going to throw an exception from here
- # instead.
- Finish $token "" 1
- cleanup $token
- return -code error $s
+ set state(sock) $sock
+ Finish $token "" 1
+ cleanup $token
+ return -code error $sock
+ }
+ }
+ set state(sock) $sock
+ Log "Using $sock for $state(socketinfo)" \
+ [expr {$state(-keepalive)?"keepalive":""}]
+ if {$state(-keepalive)} {
+ set socketmap($state(socketinfo)) $sock
}
- set state(sock) $s
- # Wait for the connection to complete
+ if {![info exists phost]} {
+ set phost ""
+ }
+ fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
- if {$state(-timeout) > 0} {
- fileevent $s writable [list http::Connect $token]
+ # Wait for the connection to complete.
+ if {![info exists state(-command)]} {
+ # geturl does EVERYTHING asynchronously, so if the user
+ # calls it synchronously, we just do a wait here.
http::wait $token
- if {$state(status) eq "error"} {
- # something went wrong while trying to establish the connection
+ if {![info exists state]} {
+ # If we timed out then Finish has been called and the users
+ # command callback may have cleaned up the token. If so we end up
+ # here with nothing left to do.
+ return $token
+ } elseif {$state(status) eq "error"} {
+ # Something went wrong while trying to establish the connection.
# Clean up after events and such, but DON'T call the command
- # callback (if available) because we're going to throw an
+ # callback (if available) because we're going to throw an
# exception from here instead.
set err [lindex $state(error) 0]
cleanup $token
return -code error $err
- } elseif {$state(status) ne "connect"} {
- # Likely to be connection timeout
- return $token
}
- set state(status) ""
}
+ return $token
+}
+
+
+proc http::Connected { token proto phost srvurl} {
+ variable http
+ variable urlTypes
+
+ variable $token
+ upvar 0 $token state
+
+ # Set back the variables needed here
+ set sock $state(sock)
+ set isQueryChannel [info exists state(-querychannel)]
+ set isQuery [info exists state(-query)]
+ set host [lindex [split $state(socketinfo) :] 0]
+ set port [lindex [split $state(socketinfo) :] 1]
+
+ set lower [string tolower $proto]
+ set defport [lindex $urlTypes($lower) 0]
+
# Send data in cr-lf format, but accept any line terminators
- fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
+ fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
- # The following is disallowed in safe interpreters, but the socket
- # is already in non-blocking mode in that case.
+ # The following is disallowed in safe interpreters, but the socket is
+ # already in non-blocking mode in that case.
- catch {fconfigure $s -blocking off}
+ catch {fconfigure $sock -blocking off}
set how GET
if {$isQuery} {
set state(querylength) [string length $state(-query)]
@@ -399,7 +670,7 @@ proc http::geturl { url args } {
set how POST
set contDone 0
} else {
- # there's no query data
+ # There's no query data.
unset state(-query)
set isQuery 0
}
@@ -412,32 +683,67 @@ proc http::geturl { url args } {
fconfigure $state(-querychannel) -blocking 1 -translation binary
set contDone 0
}
-
+ if {[info exists state(-method)] && $state(-method) ne ""} {
+ set how $state(-method)
+ }
+ # We cannot handle chunked encodings with -handler, so force HTTP/1.0
+ # until we can manage this.
+ if {[info exists state(-handler)]} {
+ set state(-protocol) 1.0
+ }
if {[catch {
- puts $s "$how $srvurl HTTP/1.0"
- puts $s "Accept: $http(-accept)"
- if {$port == $defport} {
- # Don't add port in this case, to handle broken servers.
- # [Bug #504508]
- puts $s "Host: $host"
+ puts $sock "$how $srvurl HTTP/$state(-protocol)"
+ puts $sock "Accept: $http(-accept)"
+ array set hdrs $state(-headers)
+ if {[info exists hdrs(Host)]} {
+ # Allow Host spoofing. [Bug 928154]
+ puts $sock "Host: $hdrs(Host)"
+ } elseif {$port == $defport} {
+ # Don't add port in this case, to handle broken servers. [Bug
+ # #504508]
+ puts $sock "Host: $host"
} else {
- puts $s "Host: $host:$port"
+ puts $sock "Host: $host:$port"
}
- puts $s "User-Agent: $http(-useragent)"
+ unset hdrs
+ puts $sock "User-Agent: $http(-useragent)"
+ if {$state(-protocol) == 1.0 && $state(-keepalive)} {
+ puts $sock "Connection: keep-alive"
+ }
+ if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
+ puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
+ }
+ if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
+ puts $sock "Proxy-Connection: Keep-Alive"
+ }
+ set accept_encoding_seen 0
+ set content_type_seen 0
foreach {key value} $state(-headers) {
+ if {[string equal -nocase $key "host"]} {
+ continue
+ }
+ 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 {$key eq "Content-Length"} {
+ if {[string equal -nocase $key "content-length"]} {
set contDone 1
set state(querylength) $value
}
if {[string length $key]} {
- puts $s "$key: $value"
+ puts $sock "$key: $value"
}
}
+ if {!$accept_encoding_seen && ![info exists state(-handler)]} {
+ puts $sock "Accept-Encoding: deflate,gzip,compress"
+ }
if {$isQueryChannel && $state(querylength) == 0} {
- # Try to determine size of data in channel
- # If we cannot seek, the surrounding catch will trap us
+ # Try to determine size of data in channel. If we cannot seek, the
+ # surrounding catch will trap us
set start [tell $state(-querychannel)]
seek $state(-querychannel) 0 end
@@ -446,67 +752,50 @@ proc http::geturl { url args } {
seek $state(-querychannel) $start
}
- # Flush the request header and set up the fileevent that will
- # either push the POST data or read the response.
+ # Flush the request header and set up the fileevent that will either
+ # push the POST data or read the response.
#
# fileevent note:
#
- # It is possible to have both the read and write fileevents active
- # at this point. The only scenario it seems to affect is a server
- # that closes the connection without reading the POST data.
- # (e.g., early versions TclHttpd in various error cases).
- # Depending on the platform, the client may or may not be able to
- # get the response from the server because of the error it will
- # get trying to write the post data. Having both fileevents active
- # changes the timing and the behavior, but no two platforms
- # (among Solaris, Linux, and NT) behave the same, and none
- # behave all that well in any case. Servers should always read thier
- # POST data if they expect the client to read their response.
+ # It is possible to have both the read and write fileevents active at
+ # this point. The only scenario it seems to affect is a server that
+ # closes the connection without reading the POST data. (e.g., early
+ # versions TclHttpd in various error cases). Depending on the
+ # platform, the client may or may not be able to get the response from
+ # the server because of the error it will get trying to write the post
+ # data. Having both fileevents active changes the timing and the
+ # behavior, but no two platforms (among Solaris, Linux, and NT) behave
+ # the same, and none behave all that well in any case. Servers should
+ # always read their POST data if they expect the client to read their
+ # response.
if {$isQuery || $isQueryChannel} {
- puts $s "Content-Type: $state(-type)"
+ if {!$content_type_seen} {
+ puts $sock "Content-Type: $state(-type)"
+ }
if {!$contDone} {
- puts $s "Content-Length: $state(querylength)"
+ puts $sock "Content-Length: $state(querylength)"
}
- puts $s ""
- fconfigure $s -translation {auto binary}
- fileevent $s writable [list http::Write $token]
+ puts $sock ""
+ fconfigure $sock -translation {auto binary}
+ fileevent $sock writable [list http::Write $token]
} else {
- puts $s ""
- flush $s
- fileevent $s readable [list http::Event $token]
+ puts $sock ""
+ flush $sock
+ fileevent $sock readable [list http::Event $sock $token]
}
- if {! [info exists state(-command)]} {
-
- # geturl does EVERYTHING asynchronously, so if the user
- # calls it synchronously, we just do a wait here.
-
- wait $token
- if {$state(status) eq "error"} {
- # Something went wrong, so throw the exception, and the
- # enclosing catch will do cleanup.
- return -code error [lindex $state(error) 0]
- }
- }
} err]} {
- # The socket probably was never connected,
- # or the connection dropped later.
-
- # Clean up after events and such, but DON'T call the command callback
- # (if available) because we're going to throw an exception from here
- # instead.
+ # The socket probably was never connected, or the connection dropped
+ # later.
# if state(status) is error, it means someone's already called Finish
# to do the above-described clean up.
- if {$state(status) eq "error"} {
- Finish $token $err 1
+ if {$state(status) ne "error"} {
+ Finish $token $err
}
- cleanup $token
- return -code error $err
}
- return $token
}
# Data access functions:
@@ -521,6 +810,9 @@ proc http::data {token} {
return $state(body)
}
proc http::status {token} {
+ if {![info exists $token]} {
+ return "error"
+ }
variable $token
upvar 0 $token state
return $state(status)
@@ -544,7 +836,11 @@ proc http::size {token} {
upvar 0 $token state
return $state(currentsize)
}
-
+proc http::meta {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(meta)
+}
proc http::error {token} {
variable $token
upvar 0 $token state
@@ -583,16 +879,18 @@ proc http::cleanup {token} {
# Sets the status of the connection, which unblocks
# the waiting geturl call
-proc http::Connect {token} {
+proc http::Connect {token proto phost srvurl} {
variable $token
upvar 0 $token state
- global errorInfo errorCode
- if {[eof $state(sock)] ||
- [string length [fconfigure $state(sock) -error]]} {
- Finish $token "connect failed [fconfigure $state(sock) -error]" 1
+ set err "due to unexpected EOF"
+ if {
+ [eof $state(sock)] ||
+ [set err [fconfigure $state(sock) -error]] ne ""
+ } {
+ Finish $token "connect failed $err"
} else {
- set state(status) connect
fileevent $state(sock) writable {}
+ ::http::Connected $token $proto $phost $srvurl
}
return
}
@@ -610,7 +908,7 @@ proc http::Connect {token} {
proc http::Write {token} {
variable $token
upvar 0 $token state
- set s $state(sock)
+ set sock $state(sock)
# Output a block. Tcl will buffer this if the socket blocks
set done 0
@@ -618,12 +916,12 @@ proc http::Write {token} {
# Catch I/O errors on dead sockets
if {[info exists state(-query)]} {
- # Chop up large query strings so queryprogress callback
- # can give smooth feedback
+ # Chop up large query strings so queryprogress callback can give
+ # smooth feedback.
- puts -nonewline $s \
- [string range $state(-query) $state(queryoffset) \
- [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
+ puts -nonewline $sock \
+ [string range $state(-query) $state(queryoffset) \
+ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
incr state(queryoffset) $state(-queryblocksize)
if {$state(queryoffset) >= $state(querylength)} {
set state(queryoffset) $state(querylength)
@@ -633,30 +931,30 @@ proc http::Write {token} {
# Copy blocks from the query channel
set outStr [read $state(-querychannel) $state(-queryblocksize)]
- puts -nonewline $s $outStr
+ puts -nonewline $sock $outStr
incr state(queryoffset) [string length $outStr]
if {[eof $state(-querychannel)]} {
set done 1
}
}
} err]} {
- # Do not call Finish here, but instead let the read half of
- # the socket process whatever server reply there is to get.
+ # Do not call Finish here, but instead let the read half of the socket
+ # process whatever server reply there is to get.
set state(posterror) $err
set done 1
}
if {$done} {
- catch {flush $s}
- fileevent $s writable {}
- fileevent $s readable [list http::Event $token]
+ catch {flush $sock}
+ fileevent $sock writable {}
+ fileevent $sock readable [list http::Event $sock $token]
}
- # Callback to the client after we've completely handled everything
+ # Callback to the client after we've completely handled everything.
if {[string length $state(-queryprogress)]} {
- eval $state(-queryprogress) [list $token $state(querylength)\
- $state(queryoffset)]
+ eval $state(-queryprogress) \
+ [list $token $state(querylength) $state(queryoffset)]
}
}
@@ -665,92 +963,222 @@ proc http::Write {token} {
# Handle input on the socket
#
# Arguments
+# sock The socket receiving input.
# token The token returned from http::geturl
#
# Side Effects
# Read the socket and handle callbacks.
-proc http::Event {token} {
+proc http::Event {sock token} {
variable $token
upvar 0 $token state
- set s $state(sock)
- if {[eof $s]} {
- Eof $token
+ if {![info exists state]} {
+ Log "Event $sock with invalid token '$token' - remote close?"
+ if {![eof $sock]} {
+ if {[set d [read $sock]] ne ""} {
+ Log "WARNING: additional data left on closed socket"
+ }
+ }
+ CloseSocket $sock
return
}
- if {$state(state) eq "header"} {
- if {[catch {gets $s line} n]} {
- Finish $token $n
+ if {$state(state) eq "connecting"} {
+ if {[catch {gets $sock state(http)} n]} {
+ return [Finish $token $n]
+ } elseif {$n >= 0} {
+ set state(state) "header"
+ }
+ } elseif {$state(state) eq "header"} {
+ if {[catch {gets $sock line} n]} {
+ return [Finish $token $n]
} elseif {$n == 0} {
- variable encodings
+ # We have now read all headers
+ # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
+ if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
+ return
+ }
+
set state(state) body
- if {$state(-binary) || ![string match -nocase text* $state(type)]
- || [string match *gzip* $state(coding)]
- || [string match *compress* $state(coding)]} {
+
+ # If doing a HEAD, then we won't get any body
+ if {$state(-validate)} {
+ Eof $token
+ return
+ }
+
+ # For non-chunked transfer we may have no body - in this case we
+ # may get no further file event if the connection doesn't close
+ # and no more data is sent. We can tell and must finish up now -
+ # not later.
+ if {
+ !(([info exists state(connection)]
+ && ($state(connection) eq "close"))
+ || [info exists state(transfer)])
+ && ($state(totalsize) == 0)
+ } {
+ Log "body size is 0 and no events likely - complete."
+ Eof $token
+ return
+ }
+
+ # We have to use binary translation to count bytes properly.
+ fconfigure $sock -translation binary
+
+ if {
+ $state(-binary) || ![string match -nocase text* $state(type)]
+ } {
# Turn off conversions for non-text data
- fconfigure $s -translation binary
- if {[info exists state(-channel)]} {
+ set state(binary) 1
+ }
+ if {[info exists state(-channel)]} {
+ if {$state(binary) || [llength [ContentEncoding $token]]} {
fconfigure $state(-channel) -translation binary
}
- } else {
- # If we are getting text, set the incoming channel's
- # encoding correctly. iso8859-1 is the RFC default, but
- # this could be any IANA charset. However, we only know
- # how to convert what we have encodings for.
- set idx [lsearch -exact $encodings \
- [string tolower $state(charset)]]
- if {$idx >= 0} {
- fconfigure $s -encoding [lindex $encodings $idx]
+ if {![info exists state(-handler)]} {
+ # Initiate a sequence of background fcopies
+ fileevent $sock readable {}
+ CopyStart $sock $token
+ return
}
}
- if {[info exists state(-channel)] && \
- ![info exists state(-handler)]} {
- # Initiate a sequence of background fcopies
- fileevent $s readable {}
- CopyStart $s $token
- }
} elseif {$n > 0} {
- if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
- set state(type) [string trim $type]
- # grab the optional charset information
- regexp -nocase {charset\s*=\s*(\S+)} $type x state(charset)
- }
- if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
- set state(totalsize) [string trim $length]
- }
- if {[regexp -nocase {^content-encoding:(.+)$} $line x coding]} {
- set state(coding) [string trim $coding]
- }
+ # Process header lines
if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
+ switch -- [string tolower $key] {
+ content-type {
+ set state(type) [string trim [string tolower $value]]
+ # grab the optional charset information
+ if {[regexp -nocase \
+ {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
+ $state(type) -> cs]} {
+ set state(charset) [string map {{\"} \"} $cs]
+ } else {
+ regexp -nocase {charset\s*=\s*(\S+?);?} \
+ $state(type) -> state(charset)
+ }
+ }
+ content-length {
+ set state(totalsize) [string trim $value]
+ }
+ content-encoding {
+ set state(coding) [string trim $value]
+ }
+ transfer-encoding {
+ set state(transfer) \
+ [string trim [string tolower $value]]
+ }
+ proxy-connection -
+ connection {
+ set state(connection) \
+ [string trim [string tolower $value]]
+ }
+ }
lappend state(meta) $key [string trim $value]
- } elseif {[string match HTTP* $line]} {
- set state(http) $line
}
}
} else {
+ # Now reading body
if {[catch {
if {[info exists state(-handler)]} {
- set n [eval $state(-handler) {$s $token}]
+ set n [eval $state(-handler) [list $sock $token]]
+ } elseif {[info exists state(transfer_final)]} {
+ set line [getTextLine $sock]
+ set n [string length $line]
+ if {$n > 0} {
+ Log "found $n bytes following final chunk"
+ append state(transfer_final) $line
+ } else {
+ Log "final chunk part"
+ Eof $token
+ }
+ } elseif {
+ [info exists state(transfer)]
+ && $state(transfer) eq "chunked"
+ } {
+ set size 0
+ set chunk [getTextLine $sock]
+ set n [string length $chunk]
+ if {[string trim $chunk] ne ""} {
+ scan $chunk %x size
+ if {$size != 0} {
+ set bl [fconfigure $sock -blocking]
+ fconfigure $sock -blocking 1
+ set chunk [read $sock $size]
+ fconfigure $sock -blocking $bl
+ set n [string length $chunk]
+ if {$n >= 0} {
+ append state(body) $chunk
+ }
+ if {$size != [string length $chunk]} {
+ Log "WARNING: mis-sized chunk:\
+ was [string length $chunk], should be $size"
+ }
+ getTextLine $sock
+ } else {
+ set state(transfer_final) {}
+ }
+ }
} else {
- set block [read $s $state(-blocksize)]
+ #Log "read non-chunk $state(currentsize) of $state(totalsize)"
+ set block [read $sock $state(-blocksize)]
set n [string length $block]
if {$n >= 0} {
append state(body) $block
}
}
- if {$n >= 0} {
- incr state(currentsize) $n
+ if {[info exists state]} {
+ if {$n >= 0} {
+ incr state(currentsize) $n
+ }
+ # If Content-Length - check for end of data.
+ if {
+ ($state(totalsize) > 0)
+ && ($state(currentsize) >= $state(totalsize))
+ } {
+ Eof $token
+ }
}
} err]} {
- Finish $token $err
+ return [Finish $token $err]
} else {
if {[info exists state(-progress)]} {
eval $state(-progress) \
- {$token $state(totalsize) $state(currentsize)}
+ [list $token $state(totalsize) $state(currentsize)]
}
}
}
+
+ # catch as an Eof above may have closed the socket already
+ if {![catch {eof $sock} eof] && $eof} {
+ if {[info exists $token]} {
+ set state(connection) close
+ Eof $token
+ } else {
+ # open connection closed on a token that has been cleaned up.
+ CloseSocket $sock
+ }
+ return
+ }
+}
+
+# http::getTextLine --
+#
+# Get one line with the stream in blocking crlf mode
+#
+# Arguments
+# sock The socket receiving input.
+#
+# Results:
+# The line of text, without trailing newline
+
+proc http::getTextLine {sock} {
+ set tr [fconfigure $sock -translation]
+ set bl [fconfigure $sock -blocking]
+ fconfigure $sock -translation crlf -blocking 1
+ set r [gets $sock]
+ fconfigure $sock -translation $tr -blocking $bl
+ return $r
}
# http::CopyStart
@@ -758,20 +1186,60 @@ proc http::Event {token} {
# Error handling wrapper around fcopy
#
# Arguments
-# s The socket to copy from
+# sock The socket to copy from
# token The token returned from http::geturl
#
# Side Effects
# This closes the connection upon error
-proc http::CopyStart {s token} {
- variable $token
+proc http::CopyStart {sock token {initial 1}} {
+ upvar #0 $token state
+ if {[info exists state(transfer)] && $state(transfer) eq "chunked"} {
+ foreach coding [ContentEncoding $token] {
+ lappend state(zlib) [zlib stream $coding]
+ }
+ make-transformation-chunked $sock [namespace code [list CopyChunk $token]]
+ } else {
+ if {$initial} {
+ foreach coding [ContentEncoding $token] {
+ zlib push $coding $sock
+ }
+ }
+ if {[catch {
+ fcopy $sock $state(-channel) -size $state(-blocksize) -command \
+ [list http::CopyDone $token]
+ } err]} {
+ Finish $token $err
+ }
+ }
+}
+
+proc http::CopyChunk {token chunk} {
upvar 0 $token state
- if {[catch {
- fcopy $s $state(-channel) -size $state(-blocksize) -command \
- [list http::CopyDone $token]
- } err]} {
- Finish $token $err
+ if {[set count [string length $chunk]]} {
+ incr state(currentsize) $count
+ if {[info exists state(zlib)]} {
+ foreach stream $state(zlib) {
+ set chunk [$stream add $chunk]
+ }
+ }
+ puts -nonewline $state(-channel) $chunk
+ if {[info exists state(-progress)]} {
+ eval [linsert $state(-progress) end \
+ $token $state(totalsize) $state(currentsize)]
+ }
+ } else {
+ Log "CopyChunk Finish $token"
+ if {[info exists state(zlib)]} {
+ set excess ""
+ foreach stream $state(zlib) {
+ catch {set excess [$stream add -finalize $excess]}
+ }
+ puts -nonewline $state(-channel) $excess
+ foreach stream $state(zlib) { $stream close }
+ unset state(zlib)
+ }
+ Eof $token ;# FIX ME: pipelining.
}
}
@@ -789,18 +1257,19 @@ proc http::CopyStart {s token} {
proc http::CopyDone {token count {error {}}} {
variable $token
upvar 0 $token state
- set s $state(sock)
+ set sock $state(sock)
incr state(currentsize) $count
if {[info exists state(-progress)]} {
- eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
+ eval $state(-progress) \
+ [list $token $state(totalsize) $state(currentsize)]
}
# At this point the token may have been reset
if {[string length $error]} {
Finish $token $error
- } elseif {[catch {eof $s} iseof] || $iseof} {
+ } elseif {[catch {eof $sock} iseof] || $iseof} {
Eof $token
} else {
- CopyStart $s $token
+ CopyStart $sock $token 0
}
}
@@ -814,7 +1283,7 @@ proc http::CopyDone {token count {error {}}} {
# Side Effects
# Clean up the socket
-proc http::Eof {token} {
+proc http::Eof {token {force 0}} {
variable $token
upvar 0 $token state
if {$state(state) eq "header"} {
@@ -823,13 +1292,38 @@ proc http::Eof {token} {
} else {
set state(status) ok
}
- set state(state) eof
+
+ if {[string length $state(body)] > 0} {
+ if {[catch {
+ foreach coding [ContentEncoding $token] {
+ set state(body) [zlib $coding $state(body)]
+ }
+ } err]} {
+ Log "error doing $coding '$state(body)'"
+ return [Finish $token $err]
+ }
+
+ if {!$state(binary)} {
+ # If we are getting text, set the incoming channel's encoding
+ # correctly. iso8859-1 is the RFC default, but this could be any IANA
+ # charset. However, we only know how to convert what we have
+ # encodings for.
+
+ set enc [CharsetToEncoding $state(charset)]
+ if {$enc ne "binary"} {
+ set state(body) [encoding convertfrom $enc $state(body)]
+ }
+
+ # Translate text line endings.
+ set state(body) [string map {\r\n \n \r \n} $state(body)]
+ }
+ }
Finish $token
}
# http::wait --
#
-# See documentaion for details.
+# See documentation for details.
#
# Arguments:
# token Connection token.
@@ -841,26 +1335,25 @@ proc http::wait {token} {
variable $token
upvar 0 $token state
- if {![info exists state(status)] || [string length $state(status)] == 0} {
+ if {![info exists state(status)] || $state(status) eq ""} {
# We must wait on the original variable name, not the upvar alias
- vwait $token\(status)
+ vwait ${token}(status)
}
- return $state(status)
+ return [status $token]
}
# http::formatQuery --
#
-# See documentaion for details.
-# Call http::formatQuery with an even number of arguments, where
-# the first is a name, the second is a value, the third is another
-# name, and so on.
+# See documentation for details. Call http::formatQuery with an even
+# number of arguments, where the first is a name, the second is a value,
+# the third is another name, and so on.
#
# Arguments:
# args A list of name-value pairs.
#
# Results:
-# TODO
+# TODO
proc http::formatQuery {args} {
set result ""
@@ -890,9 +1383,9 @@ proc http::mapReply {string} {
variable http
variable formMap
- # The spec says: "non-alphanumeric characters are replaced by '%HH'"
- # Use a pre-computed map and [string map] to do the conversion
- # (much faster than [regsub]/[subst]). [Bug 1020491]
+ # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
+ # a pre-computed map and [string map] to do the conversion (much faster
+ # than [regsub]/[subst]). [Bug 1020491]
if {$http(-urlencoding) ne ""} {
set string [encoding convertto $http(-urlencoding) $string]
@@ -900,7 +1393,7 @@ proc http::mapReply {string} {
}
set converted [string map $formMap $string]
if {[string match "*\[\u0100-\uffff\]*" $converted]} {
- regexp {[\u0100-\uffff]} $converted badChar
+ regexp "\[\u0100-\uffff\]" $converted badChar
# Return this error message for maximum compatability... :^/
return -code error \
"can't read \"formMap($badChar)\": no such element in array"
@@ -909,7 +1402,7 @@ proc http::mapReply {string} {
}
# http::ProxyRequired --
-# Default proxy filter.
+# Default proxy filter.
#
# Arguments:
# host The destination host
@@ -920,10 +1413,108 @@ proc http::mapReply {string} {
proc http::ProxyRequired {host} {
variable http
if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
- if {![info exists http(-proxyport)] || \
- ![string length $http(-proxyport)]} {
+ if {
+ ![info exists http(-proxyport)] ||
+ ![string length $http(-proxyport)]
+ } {
set http(-proxyport) 8080
}
return [list $http(-proxyhost) $http(-proxyport)]
}
}
+
+# http::CharsetToEncoding --
+#
+# Tries to map a given IANA charset to a tcl encoding. If no encoding
+# can be found, returns binary.
+#
+
+proc http::CharsetToEncoding {charset} {
+ variable encodings
+
+ set charset [string tolower $charset]
+ if {[regexp {iso-?8859-([0-9]+)} $charset -> num]} {
+ set encoding "iso8859-$num"
+ } elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} {
+ set encoding "iso2022-$ext"
+ } elseif {[regexp {shift[-_]?js} $charset]} {
+ set encoding "shiftjis"
+ } elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} {
+ set encoding "cp$num"
+ } elseif {$charset eq "us-ascii"} {
+ set encoding "ascii"
+ } elseif {[regexp {(?:iso-?)?lat(?:in)?-?([0-9]+)} $charset -> num]} {
+ switch -- $num {
+ 5 {set encoding "iso8859-9"}
+ 1 - 2 - 3 {
+ set encoding "iso8859-$num"
+ }
+ }
+ } else {
+ # other charset, like euc-xx, utf-8,... may directly map to encoding
+ set encoding $charset
+ }
+ set idx [lsearch -exact $encodings $encoding]
+ if {$idx >= 0} {
+ return $encoding
+ } else {
+ return "binary"
+ }
+}
+
+# Return the list of content-encoding transformations we need to do in order.
+proc http::ContentEncoding {token} {
+ upvar 0 $token state
+ set r {}
+ if {[info exists state(coding)]} {
+ foreach coding [split $state(coding) ,] {
+ switch -exact -- $coding {
+ deflate { lappend r inflate }
+ gzip - x-gzip { lappend r gunzip }
+ compress - x-compress { lappend r decompress }
+ identity {}
+ default {
+ return -code error "unsupported content-encoding \"$coding\""
+ }
+ }
+ }
+ }
+ return $r
+}
+
+proc http::make-transformation-chunked {chan command} {
+ set lambda {{chan command} {
+ set data ""
+ set size -1
+ yield
+ while {1} {
+ chan configure $chan -translation {crlf binary}
+ while {[gets $chan line] < 1} { yield }
+ chan configure $chan -translation {binary binary}
+ if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" }
+ set chunk ""
+ while {$size && ![chan eof $chan]} {
+ set part [chan read $chan $size]
+ incr size -[string length $part]
+ append chunk $part
+ }
+ if {[catch {
+ uplevel #0 [linsert $command end $chunk]
+ }]} {
+ http::Log "Error in callback: $::errorInfo"
+ }
+ if {[string length $chunk] == 0} {
+ # channel might have been closed in the callback
+ catch {chan event $chan readable {}}
+ return
+ }
+ }
+ }}
+ coroutine dechunk$chan ::apply $lambda $chan $command
+ chan event $chan readable [namespace origin dechunk$chan]
+ return
+}
+
+# Local variables:
+# indent-tabs-mode: t
+# End:
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index c937b60..27ba795 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,12 +1,2 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.5.1 [list tclPkgSetup $dir http 2.5.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
+if {![package vsatisfies [package provide Tcl] 8.6]} {return}
+package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{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 2c548bb..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.4 2000/02/01 11:48:30 hobbs Exp $
-#
# See the http.n man page for documentation
package provide http 1.0
@@ -341,12 +339,12 @@ proc http_formatQuery {args} {
# 2 Convert every other character to an array lookup
# 3 Escape constructs that are "special" to the tcl parser
# 4 "subst" the result, doing all the array substitutions
-
+
proc httpMapReply {string} {
global httpFormMap
set alphanumeric a-zA-Z0-9
if {![info exists httpFormMap]} {
-
+
for {set i 1} {$i <= 256} {incr i} {
set c [format %c $i]
if {![string match \[$alphanumeric\] $c]} {
@@ -365,7 +363,7 @@ proc http_formatQuery {args} {
return [subst $string]
}
-# Default proxy filter.
+# Default proxy filter.
proc httpProxyRequired {host} {
global http
if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
diff --git a/library/init.tcl b/library/init.tcl
index bd04e08..f63eedf 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.81 2005/09/14 17:13:18 dgp 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.
@@ -14,10 +12,11 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
+# This test intentionally written in pre-7.5 Tcl
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.5
+package require -exact Tcl 8.6.1
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -66,35 +65,51 @@ namespace eval tcl {
}
}
- variable Path [unsupported::EncodingDirs]
- set Dir [file join $::tcl_library encoding]
- if {$Dir ni $Path} {
- lappend Path $Dir
- unsupported::EncodingDirs $Path
- }
-
- # Set up the 'chan' ensemble (TIP #208).
- namespace eval chan {
- # TIP #219. Added methods: create, postevent.
- namespace ensemble create -command ::chan -map {
- blocked ::fblocked
- close ::close
- configure ::fconfigure
- copy ::fcopy
- create ::tcl::chan::rCreate
- eof ::eof
- event ::fileevent
- flush ::flush
- gets ::gets
- names {::file channels}
- postevent ::tcl::chan::rPostevent
- puts ::puts
- read ::read
- seek ::seek
- tell ::tell
- truncate ::tcl::chan::Truncate
+ if {![interp issafe]} {
+ variable Path [encoding dirs]
+ set Dir [file join $::tcl_library encoding]
+ if {$Dir ni $Path} {
+ lappend Path $Dir
+ encoding dirs $Path
}
}
+
+ # TIP #255 min and max functions
+ namespace eval mathfunc {
+ proc min {args} {
+ if {![llength $args]} {
+ return -code error \
+ "too few arguments to math function \"min\""
+ }
+ set val Inf
+ foreach arg $args {
+ # This will handle forcing the numeric value without
+ # ruining the internal type of a numeric object
+ if {[catch {expr {double($arg)}} err]} {
+ return -code error $err
+ }
+ if {$arg < $val} {set val $arg}
+ }
+ return $val
+ }
+ proc max {args} {
+ if {![llength $args]} {
+ return -code error \
+ "too few arguments to math function \"max\""
+ }
+ set val -Inf
+ foreach arg $args {
+ # This will handle forcing the numeric value without
+ # ruining the internal type of a numeric object
+ if {[catch {expr {double($arg)}} err]} {
+ return -code error $err
+ }
+ if {$arg > $val} {set val $arg}
+ }
+ return $val
+ }
+ namespace export min max
+ }
}
# Windows specific end of initialization
@@ -102,9 +117,10 @@ namespace eval tcl {
if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
namespace eval tcl {
proc EnvTraceProc {lo n1 n2 op} {
- set x $::env($n2)
- set ::env($lo) $x
- set ::env([string toupper $lo]) $x
+ global env
+ set x $env($n2)
+ set env($lo) $x
+ set env([string toupper $lo]) $x
}
proc InitWinEnv {} {
global env tcl_platform
@@ -114,9 +130,9 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
switch -- $u {
COMSPEC -
PATH {
- if {![info exists env($u)]} {
- set env($u) $env($p)
- }
+ set temp $env($p)
+ unset env($p)
+ set env($u) $temp
trace add variable env($p) write \
[namespace code [list EnvTraceProc $p]]
trace add variable env($u) write \
@@ -126,11 +142,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
}
}
if {![info exists env(COMSPEC)]} {
- if {$tcl_platform(os) eq "Windows NT"} {
- set env(COMSPEC) cmd.exe
- } else {
- set env(COMSPEC) command.com
- }
+ set env(COMSPEC) cmd.exe
}
}
InitWinEnv
@@ -141,12 +153,12 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
if {[interp issafe]} {
- package unknown ::tclPkgUnknown
+ package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
- if {$::tcl_platform(os) eq "Darwin"
- && $::tcl_platform(platform) eq "unix"} {
+ if {$tcl_platform(os) eq "Darwin"
+ && $tcl_platform(platform) eq "unix"} {
package unknown {::tcl::tm::UnknownHandler \
{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
} else {
@@ -163,9 +175,9 @@ if {[interp issafe]} {
-subcommands {
add clicks format microseconds milliseconds scan seconds
}]
-
+
# Auto-loading stubs for 'clock.tcl'
-
+
foreach cmd {add format scan} {
proc ::tcl::clock::$cmd args {
variable TclLibDir
@@ -202,11 +214,9 @@ if {[namespace which -command tclLog] eq ""} {
# exist in the interpreter. It takes the following steps to make the
# command available:
#
-# 1. See if the command has the form "namespace inscope ns cmd" and
-# if so, concatenate its arguments onto the end and evaluate it.
-# 2. See if the autoload facility can locate the command in a
+# 1. See if the autoload facility can locate the command in a
# Tcl script file. If so, load it and execute it.
-# 3. If the command was invoked interactively at top-level:
+# 2. If the command was invoked interactively at top-level:
# (a) see if the command exists as an executable UNIX program.
# If so, "exec" the command.
# (b) see if the command requests csh-like history substitution
@@ -221,37 +231,29 @@ if {[namespace which -command tclLog] eq ""} {
proc unknown args {
variable ::tcl::UnknownPending
- global auto_noexec auto_noload env tcl_interactive
-
- # If the command word has the form "namespace inscope ns cmd"
- # then concatenate its arguments onto the end and evaluate it.
+ global auto_noexec auto_noload env tcl_interactive errorInfo errorCode
- set cmd [lindex $args 0]
- if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
- #return -code error "You need an {expand}"
- set arglist [lrange $args 1 end]
- set ret [catch {uplevel 1 ::$cmd $arglist} result opts]
- dict unset opts -errorinfo
- dict incr opts -level
- return -options $opts $result
+ if {[info exists errorInfo]} {
+ set savedErrorInfo $errorInfo
+ }
+ if {[info exists errorCode]} {
+ set savedErrorCode $errorCode
}
- catch {set savedErrorInfo $::errorInfo}
- catch {set savedErrorCode $::errorCode}
- set name $cmd
+ set name [lindex $args 0]
if {![info exists auto_noload]} {
#
# Make sure we're not trying to load the same proc twice.
#
if {[info exists UnknownPending($name)]} {
return -code error "self-referential recursion\
- in \"unknown\" for command \"$name\"";
+ in \"unknown\" for command \"$name\""
}
- set UnknownPending($name) pending;
+ set UnknownPending($name) pending
set ret [catch {
auto_load $name [uplevel 1 {::namespace current}]
} msg opts]
- unset UnknownPending($name);
+ unset UnknownPending($name)
if {$ret != 0} {
dict append opts -errorinfo "\n (autoloading \"$name\")"
return -options $opts $msg
@@ -260,17 +262,25 @@ proc unknown args {
unset UnknownPending
}
if {$msg} {
- catch {set ::errorCode $savedErrorCode}
- catch {set ::errorInfo $savedErrorInfo}
+ if {[info exists savedErrorCode]} {
+ set ::errorCode $savedErrorCode
+ } else {
+ unset -nocomplain ::errorCode
+ }
+ if {[info exists savedErrorInfo]} {
+ set errorInfo $savedErrorInfo
+ } else {
+ unset -nocomplain errorInfo
+ }
set code [catch {uplevel 1 $args} msg opts]
if {$code == 1} {
#
# Compute stack trace contribution from the [uplevel].
- # Note the dependence on how Tcl_AddErrorInfo, etc.
+ # Note the dependence on how Tcl_AddErrorInfo, etc.
# construct the stack trace.
#
- set errorInfo [dict get $opts -errorinfo]
- set errorCode [dict get $opts -errorcode]
+ set errInfo [dict get $opts -errorinfo]
+ set errCode [dict get $opts -errorcode]
set cinfo $args
if {[string bytelength $cinfo] > 150} {
set cinfo [string range $cinfo 0 150]
@@ -287,7 +297,7 @@ proc unknown args {
# and trim the extra contribution from the matching case
#
set expect "$msg\n while executing\n\"$cinfo"
- if {$errorInfo eq $expect} {
+ if {$errInfo eq $expect} {
#
# The stack has only the eval from the expanded command
# Do not generate any stack trace here.
@@ -302,18 +312,18 @@ proc unknown args {
#
set expect "\n invoked from within\n\"$cinfo"
set exlen [string length $expect]
- set eilen [string length $errorInfo]
+ set eilen [string length $errInfo]
set i [expr {$eilen - $exlen - 1}]
- set einfo [string range $errorInfo 0 $i]
+ set einfo [string range $errInfo 0 $i]
#
- # For now verify that $errorInfo consists of what we are about
+ # For now verify that $errInfo consists of what we are about
# to return plus what we expected to trim off.
#
- if {$errorInfo ne "$einfo$expect"} {
+ if {$errInfo ne "$einfo$expect"} {
error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
- [list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo]
+ [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo]
}
- return -code error -errorcode $errorCode \
+ return -code error -errorcode $errCode \
-errorinfo $einfo $msg
} else {
dict incr opts -level
@@ -322,7 +332,7 @@ proc unknown args {
}
}
- if {([info level] == 1) && ([info script] eq "") \
+ if {([info level] == 1) && ([info script] eq "")
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
@@ -364,20 +374,18 @@ proc unknown args {
"\n (expanding command prefix \"$name\" in unknown)"
return -options $opts $msg
}
- # Handle empty $name separately due to strangeness in [string first]
- if {$name eq ""} {
- if {[llength $candidates] != 1} {
- return -code error "empty command name \"\""
- }
- # It's not really possible to reach here.
- return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]
- }
# Filter out bogus matches when $name contained
# a glob-special char [Bug 946952]
- set cmds [list]
- foreach x $candidates {
- if {[string first $name $x] == 0} {
- lappend cmds $x
+ if {$name eq ""} {
+ # Handle empty $name separately due to strangeness
+ # in [string first] (See RFE 1243354)
+ set cmds $candidates
+ } else {
+ set cmds [list]
+ foreach x $candidates {
+ if {[string first $name $x] == 0} {
+ lappend cmds $x
+ }
}
}
if {[llength $cmds] == 1} {
@@ -399,7 +407,7 @@ proc unknown args {
# library file to create the procedure. Returns 1 if it successfully
# loaded the procedure, 0 otherwise.
#
-# Arguments:
+# Arguments:
# cmd - Name of the command to find and load.
# namespace (optional) The namespace where the command is being used - must be
# a canonical namespace as returned [namespace current]
@@ -423,7 +431,7 @@ proc auto_load {cmd {namespace {}}} {
# info commands $name
# Unfortunately, if the name has glob-magic chars in it like *
# or [], it may not match. For our purposes here, a better
- # route is to use
+ # route is to use
# namespace which -command $name
if {[namespace which -command $name] ne ""} {
return 1
@@ -454,7 +462,7 @@ proc auto_load {cmd {namespace {}}} {
# of available commands. Returns 1 if the index is loaded, and 0 if
# the index is already loaded and up to date.
#
-# Arguments:
+# Arguments:
# None.
proc auto_load_index {} {
@@ -482,7 +490,7 @@ proc auto_load_index {} {
set id [gets $f]
if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
- } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"]} {
+ } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
while {[gets $f line] >= 0} {
if {([string index $line 0] eq "#") \
|| ([llength $line] != 2)} {
@@ -533,34 +541,34 @@ proc auto_qualify {cmd namespace} {
# Before each return case we give an example of which category it is
# with the following form :
- # ( inputCmd, inputNameSpace) -> output
+ # (inputCmd, inputNameSpace) -> output
if {[string match ::* $cmd]} {
if {$n > 1} {
- # ( ::foo::bar , * ) -> ::foo::bar
+ # (::foo::bar , *) -> ::foo::bar
return [list $cmd]
} else {
- # ( ::global , * ) -> global
+ # (::global , *) -> global
return [list [string range $cmd 2 end]]
}
}
-
+
# Potentially returning 2 elements to try :
# (if the current namespace is not the global one)
if {$n == 0} {
if {$namespace eq "::"} {
- # ( nocolons , :: ) -> nocolons
+ # (nocolons , ::) -> nocolons
return [list $cmd]
} else {
- # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
+ # (nocolons , ::sub) -> ::sub::nocolons nocolons
return [list ${namespace}::$cmd $cmd]
}
} elseif {$namespace eq "::"} {
- # ( foo::bar , :: ) -> ::foo::bar
+ # (foo::bar , ::) -> ::foo::bar
return [list ::$cmd]
} else {
- # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
+ # (foo::bar , ::sub) -> ::sub::foo::bar ::foo::bar
return [list ${namespace}::$cmd ::$cmd]
}
}
@@ -602,13 +610,13 @@ proc auto_import {pattern} {
# auto_execok --
#
-# Returns string that indicates name of program to execute if
+# Returns string that indicates name of program to execute if
# name corresponds to a shell builtin or an executable in the
-# Windows search path, or "" otherwise. Builds an associative
-# array auto_execs that caches information about previous checks,
+# Windows search path, or "" otherwise. Builds an associative
+# array auto_execs that caches information about previous checks,
# for speed.
#
-# Arguments:
+# Arguments:
# name - Name of a command.
if {$tcl_platform(platform) eq "windows"} {
@@ -637,10 +645,10 @@ proc auto_execok name {
# Add an initial ; to have the {} extension check first.
set execExtensions [split ";$env(PATHEXT)" ";"]
} else {
- set execExtensions [list {} .com .exe .bat]
+ 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.
@@ -663,7 +671,7 @@ proc auto_execok name {
set path "[file dirname [info nameof]];.;"
if {[info exists env(WINDIR)]} {
- set windir $env(WINDIR)
+ set windir $env(WINDIR)
}
if {[info exists windir]} {
if {$tcl_platform(os) eq "Windows NT"} {
@@ -678,11 +686,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]]
@@ -728,13 +739,13 @@ proc auto_execok name {
# This procedure is called by Tcl's core when attempts to call the
# filesystem's copydirectory function fail. The semantics of the call
# are that 'dest' does not yet exist, i.e. dest should become the exact
-# image of src. If dest does exist, we throw an error.
-#
+# image of src. If dest does exist, we throw an error.
+#
# Note that making changes to this procedure can change the results
# of running Tcl's tests.
#
-# Arguments:
-# action - "renaming" or "copying"
+# Arguments:
+# action - "renaming" or "copying"
# src - source directory
# dest - destination directory
proc tcl::CopyDirectory {action src dest} {
@@ -762,7 +773,7 @@ proc tcl::CopyDirectory {action src dest} {
# exists, then we should only call this function if -force
# is true, which means we just want to over-write. So,
# the following code is now commented out.
- #
+ #
# return -code error "error $action \"$src\" to\
# \"$dest\": file already exists"
} else {
@@ -771,10 +782,10 @@ proc tcl::CopyDirectory {action src dest} {
# can be returned in various combinations. Anyway,
# if any other file is returned, we must signal an error.
set existing [glob -nocomplain -directory $dest * .*]
- lappend existing {expand}[glob -nocomplain -directory $dest \
+ lappend existing {*}[glob -nocomplain -directory $dest \
-type hidden * .*]
foreach s $existing {
- if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
+ if {[file tail $s] ni {. ..}} {
return -code error "error $action \"$src\" to\
\"$dest\": file already exists"
}
@@ -782,7 +793,7 @@ proc tcl::CopyDirectory {action src dest} {
}
} else {
if {[string first $nsrc $ndest] != -1} {
- set srclen [expr {[llength [file split $nsrc]] -1}]
+ set srclen [expr {[llength [file split $nsrc]] - 1}]
set ndest [lindex [file split $ndest] $srclen]
if {$ndest eq [file tail $nsrc]} {
return -code error "error $action \"$src\" to\
@@ -795,15 +806,15 @@ proc tcl::CopyDirectory {action src dest} {
# Have to be careful to capture both visible and hidden files.
# We will also be more generous to the file system and not
# assume the hidden and non-hidden lists are non-overlapping.
- #
+ #
# On Unix 'hidden' files begin with '.'. On other platforms
# or filesystems hidden files may have other interpretations.
set filelist [concat [glob -nocomplain -directory $src *] \
[glob -nocomplain -directory $src -types hidden *]]
foreach s [lsort -unique $filelist] {
- if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
- file copy -force $s [file join $dest [file tail $s]]
+ if {[file tail $s] ni {. ..}} {
+ file copy -force -- $s [file join $dest [file tail $s]]
}
}
return
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index a4cf23e..cf3b9d7 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.22 2004/08/13 21:39:24 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.1
+package provide msgcat 1.5.2
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,132 +35,135 @@ namespace eval msgcat {
variable Msgs [dict create]
# Map of language codes used in Windows registry to those of ISO-639
- variable WinRegToISO639 [dict create {expand}{
- 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
- 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
- 4001 ar_QA
- 02 bg 0402 bg_BG
- 03 ca 0403 ca_ES
- 04 zh 0404 zh_TW 0804 zh_CN 0c04 zh_HK 1004 zh_SG 1404 zh_MO
- 05 cs 0405 cs_CZ
- 06 da 0406 da_DK
- 07 de 0407 de_DE 0807 de_CH 0c07 de_AT 1007 de_LU 1407 de_LI
- 08 el 0408 el_GR
- 09 en 0409 en_US 0809 en_GB 0c09 en_AU 1009 en_CA 1409 en_NZ
- 1809 en_IE 1c09 en_ZA 2009 en_JM 2409 en_GD 2809 en_BZ
- 2c09 en_TT 3009 en_ZW 3409 en_PH
- 0a es 040a es_ES 080a es_MX 0c0a es_ES@modern 100a es_GT 140a es_CR
- 180a es_PA 1c0a es_DO 200a es_VE 240a es_CO 280a es_PE
- 2c0a es_AR 300a es_EC 340a es_CL 380a es_UY 3c0a es_PY
- 400a es_BO 440a es_SV 480a es_HN 4c0a es_NI 500a es_PR
- 0b fi 040b fi_FI
- 0c fr 040c fr_FR 080c fr_BE 0c0c fr_CA 100c fr_CH 140c fr_LU
- 180c fr_MC
- 0d he 040d he_IL
- 0e hu 040e hu_HU
- 0f is 040f is_IS
- 10 it 0410 it_IT 0810 it_CH
- 11 ja 0411 ja_JP
- 12 ko 0412 ko_KR
- 13 nl 0413 nl_NL 0813 nl_BE
- 14 no 0414 no_NO 0814 nn_NO
- 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
- 1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
- 1b sk 041b sk_SK
- 1c sq 041c sq_AL
- 1d sv 041d sv_SE 081d sv_FI
- 1e th 041e th_TH
- 1f tr 041f tr_TR
- 20 ur 0420 ur_PK 0820 ur_IN
- 21 id 0421 id_ID
- 22 uk 0422 uk_UA
- 23 be 0423 be_BY
- 24 sl 0424 sl_SI
- 25 et 0425 et_EE
- 26 lv 0426 lv_LV
- 27 lt 0427 lt_LT
- 28 tg 0428 tg_TJ
- 29 fa 0429 fa_IR
- 2a vi 042a vi_VN
- 2b hy 042b hy_AM
- 2c az 042c az_AZ@latin 082c az_AZ@cyrillic
- 2d eu
- 2e wen 042e wen_DE
- 2f mk 042f mk_MK
- 30 bnt 0430 bnt_TZ
- 31 ts 0431 ts_ZA
- 33 ven 0433 ven_ZA
- 34 xh 0434 xh_ZA
- 35 zu 0435 zu_ZA
- 36 af 0436 af_ZA
- 37 ka 0437 ka_GE
- 38 fo 0438 fo_FO
- 39 hi 0439 hi_IN
- 3a mt 043a mt_MT
- 3b se 043b se_NO
- 043c gd_UK 083c ga_IE
- 3d yi 043d yi_IL
- 3e ms 043e ms_MY 083e ms_BN
- 3f kk 043f kk_KZ
- 40 ky 0440 ky_KG
- 41 sw 0441 sw_KE
- 42 tk 0442 tk_TM
- 43 uz 0443 uz_UZ@latin 0843 uz_UZ@cyrillic
- 44 tt 0444 tt_RU
- 45 bn 0445 bn_IN
- 46 pa 0446 pa_IN
- 47 gu 0447 gu_IN
- 48 or 0448 or_IN
- 49 ta
- 4a te 044a te_IN
- 4b kn 044b kn_IN
- 4c ml 044c ml_IN
- 4d as 044d as_IN
- 4e mr 044e mr_IN
- 4f sa 044f sa_IN
- 50 mn
- 51 bo 0451 bo_CN
- 52 cy 0452 cy_GB
- 53 km 0453 km_KH
- 54 lo 0454 lo_LA
- 55 my 0455 my_MM
- 56 gl 0456 gl_ES
- 57 kok 0457 kok_IN
- 58 mni 0458 mni_IN
- 59 sd
- 5a syr 045a syr_TR
- 5b si 045b si_LK
- 5c chr 045c chr_US
- 5d iu 045d iu_CA
- 5e am 045e am_ET
- 5f ber 045f ber_MA
- 60 ks 0460 ks_PK 0860 ks_IN
- 61 ne 0461 ne_NP 0861 ne_IN
- 62 fy 0462 fy_NL
- 63 ps
- 64 tl 0464 tl_PH
- 65 div 0465 div_MV
- 66 bin 0466 bin_NG
- 67 ful 0467 ful_NG
- 68 ha 0468 ha_NG
- 69 nic 0469 nic_NG
- 6a yo 046a yo_NG
- 70 ibo 0470 ibo_NG
- 71 kau 0471 kau_NG
- 72 om 0472 om_ET
- 73 ti 0473 ti_ET
- 74 gn 0474 gn_PY
- 75 cpe 0475 cpe_US
- 76 la 0476 la_VA
- 77 so 0477 so_SO
- 78 sit 0478 sit_CN
- 79 pap 0479 pap_AN
- }]
+ 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
+ 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
+ 4001 ar_QA
+ 02 bg 0402 bg_BG
+ 03 ca 0403 ca_ES
+ 04 zh 0404 zh_TW 0804 zh_CN 0c04 zh_HK 1004 zh_SG 1404 zh_MO
+ 05 cs 0405 cs_CZ
+ 06 da 0406 da_DK
+ 07 de 0407 de_DE 0807 de_CH 0c07 de_AT 1007 de_LU 1407 de_LI
+ 08 el 0408 el_GR
+ 09 en 0409 en_US 0809 en_GB 0c09 en_AU 1009 en_CA 1409 en_NZ
+ 1809 en_IE 1c09 en_ZA 2009 en_JM 2409 en_GD 2809 en_BZ
+ 2c09 en_TT 3009 en_ZW 3409 en_PH
+ 0a es 040a es_ES 080a es_MX 0c0a es_ES@modern 100a es_GT 140a es_CR
+ 180a es_PA 1c0a es_DO 200a es_VE 240a es_CO 280a es_PE
+ 2c0a es_AR 300a es_EC 340a es_CL 380a es_UY 3c0a es_PY
+ 400a es_BO 440a es_SV 480a es_HN 4c0a es_NI 500a es_PR
+ 0b fi 040b fi_FI
+ 0c fr 040c fr_FR 080c fr_BE 0c0c fr_CA 100c fr_CH 140c fr_LU
+ 180c fr_MC
+ 0d he 040d he_IL
+ 0e hu 040e hu_HU
+ 0f is 040f is_IS
+ 10 it 0410 it_IT 0810 it_CH
+ 11 ja 0411 ja_JP
+ 12 ko 0412 ko_KR
+ 13 nl 0413 nl_NL 0813 nl_BE
+ 14 no 0414 no_NO 0814 nn_NO
+ 15 pl 0415 pl_PL
+ 16 pt 0416 pt_BR 0816 pt_PT
+ 17 rm 0417 rm_CH
+ 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
+ 1d sv 041d sv_SE 081d sv_FI
+ 1e th 041e th_TH
+ 1f tr 041f tr_TR
+ 20 ur 0420 ur_PK 0820 ur_IN
+ 21 id 0421 id_ID
+ 22 uk 0422 uk_UA
+ 23 be 0423 be_BY
+ 24 sl 0424 sl_SI
+ 25 et 0425 et_EE
+ 26 lv 0426 lv_LV
+ 27 lt 0427 lt_LT
+ 28 tg 0428 tg_TJ
+ 29 fa 0429 fa_IR
+ 2a vi 042a vi_VN
+ 2b hy 042b hy_AM
+ 2c az 042c az_AZ@latin 082c az_AZ@cyrillic
+ 2d eu
+ 2e wen 042e wen_DE
+ 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
+ 36 af 0436 af_ZA
+ 37 ka 0437 ka_GE
+ 38 fo 0438 fo_FO
+ 39 hi 0439 hi_IN
+ 3a mt 043a mt_MT
+ 3b se 043b se_NO
+ 043c gd_UK 083c ga_IE
+ 3d yi 043d yi_IL
+ 3e ms 043e ms_MY 083e ms_BN
+ 3f kk 043f kk_KZ
+ 40 ky 0440 ky_KG
+ 41 sw 0441 sw_KE
+ 42 tk 0442 tk_TM
+ 43 uz 0443 uz_UZ@latin 0843 uz_UZ@cyrillic
+ 44 tt 0444 tt_RU
+ 45 bn 0445 bn_IN
+ 46 pa 0446 pa_IN
+ 47 gu 0447 gu_IN
+ 48 or 0448 or_IN
+ 49 ta
+ 4a te 044a te_IN
+ 4b kn 044b kn_IN
+ 4c ml 044c ml_IN
+ 4d as 044d as_IN
+ 4e mr 044e mr_IN
+ 4f sa 044f sa_IN
+ 50 mn
+ 51 bo 0451 bo_CN
+ 52 cy 0452 cy_GB
+ 53 km 0453 km_KH
+ 54 lo 0454 lo_LA
+ 55 my 0455 my_MM
+ 56 gl 0456 gl_ES
+ 57 kok 0457 kok_IN
+ 58 mni 0458 mni_IN
+ 59 sd
+ 5a syr 045a syr_TR
+ 5b si 045b si_LK
+ 5c chr 045c chr_US
+ 5d iu 045d iu_CA
+ 5e am 045e am_ET
+ 5f ber 045f ber_MA
+ 60 ks 0460 ks_PK 0860 ks_IN
+ 61 ne 0461 ne_NP 0861 ne_IN
+ 62 fy 0462 fy_NL
+ 63 ps
+ 64 tl 0464 tl_PH
+ 65 div 0465 div_MV
+ 66 bin 0466 bin_NG
+ 67 ful 0467 ful_NG
+ 68 ha 0468 ha_NG
+ 69 nic 0469 nic_NG
+ 6a yo 046a yo_NG
+ 70 ibo 0470 ibo_NG
+ 71 kau 0471 kau_NG
+ 72 om 0472 om_ET
+ 73 ti 0473 ti_ET
+ 74 gn 0474 gn_PY
+ 75 cpe 0475 cpe_US
+ 76 la 0476 la_VA
+ 77 so 0477 so_SO
+ 78 sit 0478 sit_CN
+ 79 pap 0479 pap_AN
+ }]
+ }
}
# msgcat::mc --
@@ -175,7 +179,7 @@ namespace eval msgcat {
# args Args to pass to the format command
#
# Results:
-# Returns the translated string. Propagates errors thrown by the
+# Returns the translated string. Propagates errors thrown by the
# format command.
proc msgcat::mc {src args} {
@@ -187,23 +191,22 @@ proc msgcat::mc {src args} {
variable Locale
set ns [uplevel 1 [list ::namespace current]]
-
+
while {$ns != ""} {
foreach loc $Loclist {
if {[dict exists $Msgs $loc $ns $src]} {
if {[llength $args] == 0} {
return [dict get $Msgs $loc $ns $src]
} else {
- return [uplevel 1 [list ::format \
- [dict get $Msgs $loc $ns $src] {expand}$args]]
+ return [format [dict get $Msgs $loc $ns $src] {*}$args]
}
}
}
set ns [namespace parent $ns]
}
# we have not found the translation
- return [uplevel 1 [list [::namespace origin mcunknown] \
- $Locale $src {expand}$args]]
+ return [uplevel 1 [list [namespace origin mcunknown] \
+ $Locale $src {*}$args]]
}
# msgcat::mclocale --
@@ -277,17 +280,30 @@ 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 {} } {
+ if {$p eq {}} {
set p ROOT
}
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
}
@@ -311,17 +327,39 @@ proc msgcat::mcset {locale src {dest ""}} {
}
set ns [uplevel 1 [list ::namespace current]]
-
+
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
}
@@ -336,7 +374,7 @@ proc msgcat::mcset {locale src {dest ""}} {
# Results:
# Returns the number of pairs processed
-proc msgcat::mcmset {locale pairs } {
+proc msgcat::mcmset {locale pairs} {
variable Msgs
set length [llength $pairs]
@@ -344,22 +382,46 @@ proc msgcat::mcmset {locale pairs } {
return -code error "bad translation list:\
should be \"[lindex [info level 0] 0] locale {src dest ...}\""
}
-
+
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]
- }
- if {![dict exists $Msgs $locale $ns]} {
- dict set Msgs $locale $ns [dict create]
- }
foreach {src dest} $pairs {
- dict set Msgs $locale $ns $src $dest
+ dict set Msgs $locale $ns $src $dest
}
- return $length
+ 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"
+ }
+ 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 $FileLocale $ns $src $dest
+ }
+ return [expr {$length / 2}]
}
# msgcat::mcunknown --
@@ -367,7 +429,7 @@ proc msgcat::mcmset {locale pairs } {
# This routine is called by msgcat::mc if a translation cannot
# be found for a string. This routine is intended to be replaced
# by an application specific routine for error reporting
-# purposes. The default behavior is to return the source string.
+# purposes. The default behavior is to return the source string.
# If additional args are specified, the format command will be used
# to work them into the traslated string.
#
@@ -381,7 +443,7 @@ proc msgcat::mcmset {locale pairs } {
proc msgcat::mcunknown {locale src args} {
if {[llength $args]} {
- return [uplevel 1 [list ::format $src {expand}$args]]
+ return [format $src {*}$args]
} else {
return $src
}
@@ -389,7 +451,7 @@ proc msgcat::mcunknown {locale src args} {
# msgcat::mcmax --
#
-# Calculates the maximum length of the translated strings of the given
+# Calculates the maximum length of the translated strings of the given
# list.
#
# Arguments:
@@ -402,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
}
@@ -441,34 +503,79 @@ proc msgcat::ConvertLocale {value} {
# Initialize the default locale
proc msgcat::Init {} {
+ global env
+
#
# set default locale, try to get from environment
#
foreach varName {LC_ALL LC_MESSAGES LANG} {
- if {[info exists ::env($varName)] && ("" ne $::env($varName))} {
+ if {[info exists env($varName)] && ("" ne $env($varName))} {
if {![catch {
- mclocale [ConvertLocale $::env($varName)]
+ mclocale [ConvertLocale $env($varName)]
}]} {
return
}
}
}
#
- # The rest of this routine is special processing for Windows;
- # all other platforms, get out now.
+ # On Darwin, fallback to current CFLocale identifier if available.
#
- if { $::tcl_platform(platform) ne "windows" } {
+ if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} {
+ if {![catch {
+ mclocale [ConvertLocale $::tcl::mac::locale]
+ }]} {
+ return
+ }
+ }
+ #
+ # The rest of this routine is special processing for Windows or
+ # Cygwin. All other platforms, get out now.
+ #
+ 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".
+ #
+
+ # On Vista and later:
+ # HCU/Control Panel/Desktop : PreferredUILanguages is for language packs,
+ # HCU/Control Pannel/International : localName is the default locale.
+ #
+ # They contain 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 {[catch {package require registry}] \
- || [catch {registry get $key "locale"} locale]} {
- mclocale C
+ foreach key {{HKEY_CURRENT_USER\Control Panel\Desktop} {HKEY_CURRENT_USER\Control Panel\International}}\
+ value {PreferredUILanguages localeName} {
+ if {![catch {registry get $key $value} localeName]
+ && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
+ [string tolower $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 value locale which contains a numerical language ID
+ if {[catch {
+ set locale [registry get $key "locale"]
+ }]} {
+ mclocale C
return
}
#
@@ -484,7 +591,7 @@ proc msgcat::Init {} {
set locale [string tolower $locale]
while {[string length $locale]} {
if {![catch {
- mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
+ mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
}]} {
return
}
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 26063fc..5fabfe3 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.1 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]]
diff --git a/library/msgs/af.msg b/library/msgs/af.msg
index 0892615..0892615 100755..100644
--- a/library/msgs/af.msg
+++ b/library/msgs/af.msg
diff --git a/library/msgs/af_za.msg b/library/msgs/af_za.msg
index fef48ad..fef48ad 100755..100644
--- a/library/msgs/af_za.msg
+++ b/library/msgs/af_za.msg
diff --git a/library/msgs/ar.msg b/library/msgs/ar.msg
index 257157f..257157f 100755..100644
--- a/library/msgs/ar.msg
+++ b/library/msgs/ar.msg
diff --git a/library/msgs/ar_in.msg b/library/msgs/ar_in.msg
index 185e49c..185e49c 100755..100644
--- a/library/msgs/ar_in.msg
+++ b/library/msgs/ar_in.msg
diff --git a/library/msgs/ar_jo.msg b/library/msgs/ar_jo.msg
index 0f5e269..0f5e269 100755..100644
--- a/library/msgs/ar_jo.msg
+++ b/library/msgs/ar_jo.msg
diff --git a/library/msgs/ar_lb.msg b/library/msgs/ar_lb.msg
index e62acd3..e62acd3 100755..100644
--- a/library/msgs/ar_lb.msg
+++ b/library/msgs/ar_lb.msg
diff --git a/library/msgs/ar_sy.msg b/library/msgs/ar_sy.msg
index d5e1c87..d5e1c87 100755..100644
--- a/library/msgs/ar_sy.msg
+++ b/library/msgs/ar_sy.msg
diff --git a/library/msgs/be.msg b/library/msgs/be.msg
index 379a1d7..379a1d7 100755..100644
--- a/library/msgs/be.msg
+++ b/library/msgs/be.msg
diff --git a/library/msgs/bg.msg b/library/msgs/bg.msg
index ff17759..ff17759 100755..100644
--- a/library/msgs/bg.msg
+++ b/library/msgs/bg.msg
diff --git a/library/msgs/bn.msg b/library/msgs/bn.msg
index 664b9d8..664b9d8 100755..100644
--- a/library/msgs/bn.msg
+++ b/library/msgs/bn.msg
diff --git a/library/msgs/bn_in.msg b/library/msgs/bn_in.msg
index 28c000f..28c000f 100755..100644
--- a/library/msgs/bn_in.msg
+++ b/library/msgs/bn_in.msg
diff --git a/library/msgs/ca.msg b/library/msgs/ca.msg
index 36c9772..36c9772 100755..100644
--- a/library/msgs/ca.msg
+++ b/library/msgs/ca.msg
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index 8db8bdd..8db8bdd 100755..100644
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index e4fec7f..e4fec7f 100755..100644
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 9eb3145..9eb3145 100755..100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
diff --git a/library/msgs/de_at.msg b/library/msgs/de_at.msg
index 61bc266..61bc266 100755..100644
--- a/library/msgs/de_at.msg
+++ b/library/msgs/de_at.msg
diff --git a/library/msgs/de_be.msg b/library/msgs/de_be.msg
index 3614763..3614763 100755..100644
--- a/library/msgs/de_be.msg
+++ b/library/msgs/de_be.msg
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index ac19f62..ac19f62 100755..100644
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
diff --git a/library/msgs/en_au.msg b/library/msgs/en_au.msg
index 7f9870c..7f9870c 100755..100644
--- a/library/msgs/en_au.msg
+++ b/library/msgs/en_au.msg
diff --git a/library/msgs/en_be.msg b/library/msgs/en_be.msg
index 5072986..5072986 100755..100644
--- a/library/msgs/en_be.msg
+++ b/library/msgs/en_be.msg
diff --git a/library/msgs/en_bw.msg b/library/msgs/en_bw.msg
index 8fd20c7..8fd20c7 100755..100644
--- a/library/msgs/en_bw.msg
+++ b/library/msgs/en_bw.msg
diff --git a/library/msgs/en_ca.msg b/library/msgs/en_ca.msg
index 278efe7..278efe7 100755..100644
--- a/library/msgs/en_ca.msg
+++ b/library/msgs/en_ca.msg
diff --git a/library/msgs/en_gb.msg b/library/msgs/en_gb.msg
index 5c61c43..5c61c43 100755..100644
--- a/library/msgs/en_gb.msg
+++ b/library/msgs/en_gb.msg
diff --git a/library/msgs/en_hk.msg b/library/msgs/en_hk.msg
index 8b33bc0..8b33bc0 100755..100644
--- a/library/msgs/en_hk.msg
+++ b/library/msgs/en_hk.msg
diff --git a/library/msgs/en_ie.msg b/library/msgs/en_ie.msg
index ba621cf..ba621cf 100755..100644
--- a/library/msgs/en_ie.msg
+++ b/library/msgs/en_ie.msg
diff --git a/library/msgs/en_in.msg b/library/msgs/en_in.msg
index a1f155d..a1f155d 100755..100644
--- a/library/msgs/en_in.msg
+++ b/library/msgs/en_in.msg
diff --git a/library/msgs/en_nz.msg b/library/msgs/en_nz.msg
index b419017..b419017 100755..100644
--- a/library/msgs/en_nz.msg
+++ b/library/msgs/en_nz.msg
diff --git a/library/msgs/en_ph.msg b/library/msgs/en_ph.msg
index 682666d..682666d 100755..100644
--- a/library/msgs/en_ph.msg
+++ b/library/msgs/en_ph.msg
diff --git a/library/msgs/en_sg.msg b/library/msgs/en_sg.msg
index 4dc5b1d..4dc5b1d 100755..100644
--- a/library/msgs/en_sg.msg
+++ b/library/msgs/en_sg.msg
diff --git a/library/msgs/en_za.msg b/library/msgs/en_za.msg
index fe43797..fe43797 100755..100644
--- a/library/msgs/en_za.msg
+++ b/library/msgs/en_za.msg
diff --git a/library/msgs/en_zw.msg b/library/msgs/en_zw.msg
index 2a5804f..2a5804f 100755..100644
--- a/library/msgs/en_zw.msg
+++ b/library/msgs/en_zw.msg
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index 1d2a24f..1d2a24f 100755..100644
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index a24f0a1..a24f0a1 100755..100644
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
diff --git a/library/msgs/es_ar.msg b/library/msgs/es_ar.msg
index 7d35027..7d35027 100755..100644
--- a/library/msgs/es_ar.msg
+++ b/library/msgs/es_ar.msg
diff --git a/library/msgs/es_bo.msg b/library/msgs/es_bo.msg
index 498ad0d..498ad0d 100755..100644
--- a/library/msgs/es_bo.msg
+++ b/library/msgs/es_bo.msg
diff --git a/library/msgs/es_cl.msg b/library/msgs/es_cl.msg
index 31d465c..31d465c 100755..100644
--- a/library/msgs/es_cl.msg
+++ b/library/msgs/es_cl.msg
diff --git a/library/msgs/es_co.msg b/library/msgs/es_co.msg
index 77e57f0..77e57f0 100755..100644
--- a/library/msgs/es_co.msg
+++ b/library/msgs/es_co.msg
diff --git a/library/msgs/es_cr.msg b/library/msgs/es_cr.msg
index 7a652fa..7a652fa 100755..100644
--- a/library/msgs/es_cr.msg
+++ b/library/msgs/es_cr.msg
diff --git a/library/msgs/es_do.msg b/library/msgs/es_do.msg
index 0e283da..0e283da 100755..100644
--- a/library/msgs/es_do.msg
+++ b/library/msgs/es_do.msg
diff --git a/library/msgs/es_ec.msg b/library/msgs/es_ec.msg
index 9e921e0..9e921e0 100755..100644
--- a/library/msgs/es_ec.msg
+++ b/library/msgs/es_ec.msg
diff --git a/library/msgs/es_gt.msg b/library/msgs/es_gt.msg
index ecd6faf..ecd6faf 100755..100644
--- a/library/msgs/es_gt.msg
+++ b/library/msgs/es_gt.msg
diff --git a/library/msgs/es_hn.msg b/library/msgs/es_hn.msg
index a758ca2..a758ca2 100755..100644
--- a/library/msgs/es_hn.msg
+++ b/library/msgs/es_hn.msg
diff --git a/library/msgs/es_mx.msg b/library/msgs/es_mx.msg
index 7cfb545..7cfb545 100755..100644
--- a/library/msgs/es_mx.msg
+++ b/library/msgs/es_mx.msg
diff --git a/library/msgs/es_ni.msg b/library/msgs/es_ni.msg
index 7c39495..7c39495 100755..100644
--- a/library/msgs/es_ni.msg
+++ b/library/msgs/es_ni.msg
diff --git a/library/msgs/es_pa.msg b/library/msgs/es_pa.msg
index cecacdc..cecacdc 100755..100644
--- a/library/msgs/es_pa.msg
+++ b/library/msgs/es_pa.msg
diff --git a/library/msgs/es_pe.msg b/library/msgs/es_pe.msg
index 9f90595..9f90595 100755..100644
--- a/library/msgs/es_pe.msg
+++ b/library/msgs/es_pe.msg
diff --git a/library/msgs/es_pr.msg b/library/msgs/es_pr.msg
index 8511b12..8511b12 100755..100644
--- a/library/msgs/es_pr.msg
+++ b/library/msgs/es_pr.msg
diff --git a/library/msgs/es_py.msg b/library/msgs/es_py.msg
index aa93d36..aa93d36 100755..100644
--- a/library/msgs/es_py.msg
+++ b/library/msgs/es_py.msg
diff --git a/library/msgs/es_sv.msg b/library/msgs/es_sv.msg
index fc7954d..fc7954d 100755..100644
--- a/library/msgs/es_sv.msg
+++ b/library/msgs/es_sv.msg
diff --git a/library/msgs/es_uy.msg b/library/msgs/es_uy.msg
index b33525c..b33525c 100755..100644
--- a/library/msgs/es_uy.msg
+++ b/library/msgs/es_uy.msg
diff --git a/library/msgs/es_ve.msg b/library/msgs/es_ve.msg
index 7c2a7b0..7c2a7b0 100755..100644
--- a/library/msgs/es_ve.msg
+++ b/library/msgs/es_ve.msg
diff --git a/library/msgs/et.msg b/library/msgs/et.msg
index 8d32e9e..8d32e9e 100755..100644
--- a/library/msgs/et.msg
+++ b/library/msgs/et.msg
diff --git a/library/msgs/eu.msg b/library/msgs/eu.msg
index cf708b6..cf708b6 100755..100644
--- a/library/msgs/eu.msg
+++ b/library/msgs/eu.msg
diff --git a/library/msgs/eu_es.msg b/library/msgs/eu_es.msg
index 2694418..2694418 100755..100644
--- a/library/msgs/eu_es.msg
+++ b/library/msgs/eu_es.msg
diff --git a/library/msgs/fa.msg b/library/msgs/fa.msg
index 89b2f90..89b2f90 100755..100644
--- a/library/msgs/fa.msg
+++ b/library/msgs/fa.msg
diff --git a/library/msgs/fa_in.msg b/library/msgs/fa_in.msg
index adc9e91..adc9e91 100755..100644
--- a/library/msgs/fa_in.msg
+++ b/library/msgs/fa_in.msg
diff --git a/library/msgs/fa_ir.msg b/library/msgs/fa_ir.msg
index 597ce9d..597ce9d 100755..100644
--- a/library/msgs/fa_ir.msg
+++ b/library/msgs/fa_ir.msg
diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg
index acabba0..acabba0 100755..100644
--- a/library/msgs/fi.msg
+++ b/library/msgs/fi.msg
diff --git a/library/msgs/fo.msg b/library/msgs/fo.msg
index 4696e62..4696e62 100755..100644
--- a/library/msgs/fo.msg
+++ b/library/msgs/fo.msg
diff --git a/library/msgs/fo_fo.msg b/library/msgs/fo_fo.msg
index 2392b8e..2392b8e 100755..100644
--- a/library/msgs/fo_fo.msg
+++ b/library/msgs/fo_fo.msg
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index 55b19bf..55b19bf 100755..100644
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
diff --git a/library/msgs/fr_be.msg b/library/msgs/fr_be.msg
index cdb13bd..cdb13bd 100755..100644
--- a/library/msgs/fr_be.msg
+++ b/library/msgs/fr_be.msg
diff --git a/library/msgs/fr_ca.msg b/library/msgs/fr_ca.msg
index 00ccfff..00ccfff 100755..100644
--- a/library/msgs/fr_ca.msg
+++ b/library/msgs/fr_ca.msg
diff --git a/library/msgs/fr_ch.msg b/library/msgs/fr_ch.msg
index 7e2bac7..7e2bac7 100755..100644
--- a/library/msgs/fr_ch.msg
+++ b/library/msgs/fr_ch.msg
diff --git a/library/msgs/ga.msg b/library/msgs/ga.msg
index 6edf13a..6edf13a 100755..100644
--- a/library/msgs/ga.msg
+++ b/library/msgs/ga.msg
diff --git a/library/msgs/ga_ie.msg b/library/msgs/ga_ie.msg
index b6acbbc..b6acbbc 100755..100644
--- a/library/msgs/ga_ie.msg
+++ b/library/msgs/ga_ie.msg
diff --git a/library/msgs/gl.msg b/library/msgs/gl.msg
index 4b869e8..4b869e8 100755..100644
--- a/library/msgs/gl.msg
+++ b/library/msgs/gl.msg
diff --git a/library/msgs/gl_es.msg b/library/msgs/gl_es.msg
index d4ed270..d4ed270 100755..100644
--- a/library/msgs/gl_es.msg
+++ b/library/msgs/gl_es.msg
diff --git a/library/msgs/gv.msg b/library/msgs/gv.msg
index 7d332ad..7d332ad 100755..100644
--- a/library/msgs/gv.msg
+++ b/library/msgs/gv.msg
diff --git a/library/msgs/gv_gb.msg b/library/msgs/gv_gb.msg
index 5e96e6f..5e96e6f 100755..100644
--- a/library/msgs/gv_gb.msg
+++ b/library/msgs/gv_gb.msg
diff --git a/library/msgs/he.msg b/library/msgs/he.msg
index 52a94e2..4fd921d 100755..100644
--- a/library/msgs/he.msg
+++ b/library/msgs/he.msg
@@ -44,8 +44,8 @@ namespace eval ::tcl::clock {
"\u05e0\u05d5\u05d1\u05de\u05d1\u05e8"\
"\u05d3\u05e6\u05de\u05d1\u05e8"\
""]
- ::msgcat::mcset he BCE "\u05dc\u05e1\u05d4"\u05e0"
- ::msgcat::mcset he CE "\u05dc\u05e4\u05e1\u05d4"\u05e0"
+ ::msgcat::mcset he BCE "\u05dc\u05e1\u05d4\u0022\u05e0"
+ ::msgcat::mcset he CE "\u05dc\u05e4\u05e1\u05d4\u0022\u05e0"
::msgcat::mcset he DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset he TIME_FORMAT "%H:%M:%S"
::msgcat::mcset he DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
diff --git a/library/msgs/hi.msg b/library/msgs/hi.msg
index 50c9fb8..50c9fb8 100755..100644
--- a/library/msgs/hi.msg
+++ b/library/msgs/hi.msg
diff --git a/library/msgs/hi_in.msg b/library/msgs/hi_in.msg
index 239793f..239793f 100755..100644
--- a/library/msgs/hi_in.msg
+++ b/library/msgs/hi_in.msg
diff --git a/library/msgs/hr.msg b/library/msgs/hr.msg
index cec145b..cec145b 100755..100644
--- a/library/msgs/hr.msg
+++ b/library/msgs/hr.msg
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index e5e68d9..e5e68d9 100755..100644
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
diff --git a/library/msgs/id.msg b/library/msgs/id.msg
index 17c6bb5..17c6bb5 100755..100644
--- a/library/msgs/id.msg
+++ b/library/msgs/id.msg
diff --git a/library/msgs/id_id.msg b/library/msgs/id_id.msg
index bb672c1..bb672c1 100755..100644
--- a/library/msgs/id_id.msg
+++ b/library/msgs/id_id.msg
diff --git a/library/msgs/is.msg b/library/msgs/is.msg
index adc2d2a..adc2d2a 100755..100644
--- a/library/msgs/is.msg
+++ b/library/msgs/is.msg
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index b641cde..b641cde 100755..100644
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
diff --git a/library/msgs/it_ch.msg b/library/msgs/it_ch.msg
index b36ed36..b36ed36 100755..100644
--- a/library/msgs/it_ch.msg
+++ b/library/msgs/it_ch.msg
diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg
index 7bab236..2767665 100755..100644
--- a/library/msgs/ja.msg
+++ b/library/msgs/ja.msg
@@ -16,20 +16,6 @@ namespace eval ::tcl::clock {
"\u6728\u66dc\u65e5"\
"\u91d1\u66dc\u65e5"\
"\u571f\u66dc\u65e5"]
- ::msgcat::mcset ja MONTHS_ABBREV [list \
- "1"\
- "2"\
- "3"\
- "4"\
- "5"\
- "6"\
- "7"\
- "8"\
- "9"\
- "10"\
- "11"\
- "12"\
- ""]
::msgcat::mcset ja MONTHS_FULL [list \
"1\u6708"\
"2\u6708"\
@@ -42,18 +28,17 @@ namespace eval ::tcl::clock {
"9\u6708"\
"10\u6708"\
"11\u6708"\
- "12\u6708"\
- ""]
+ "12\u6708"]
::msgcat::mcset ja BCE "\u7d00\u5143\u524d"
::msgcat::mcset ja CE "\u897f\u66a6"
::msgcat::mcset ja AM "\u5348\u524d"
::msgcat::mcset ja PM "\u5348\u5f8c"
::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
+ ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"
- ::msgcat::mcset ja LOCALE_NUMERALS "\u3007 \u4e00 \u4e8c \u4e09 \u56db \u4e94 \u516d \u4e03 \u516b \u4e5d \u5341 \u5341\u4e00 \u5341\u4e8c \u5341\u4e09 \u5341\u56db \u5341\u4e94 \u5341\u516d \u5341\u4e03 \u5341\u516b \u5341\u4e5d \u4e8c\u5341 \u5eff\u4e00 \u5eff\u4e8c \u5eff\u4e09 \u5eff\u56db \u5eff\u4e94 \u5eff\u516d \u5eff\u4e03 \u5eff\u516b \u5eff\u4e5d \u4e09\u5341 \u5345\u4e00 \u5345\u4e8c \u5345\u4e09 \u5345\u56db \u5345\u4e94 \u5345\u516d \u5345\u4e03 \u5345\u516b \u5345\u4e5d \u56db\u5341 \u56db\u5341\u4e00 \u56db\u5341\u4e8c \u56db\u5341\u4e09 \u56db\u5341\u56db \u56db\u5341\u4e94 \u56db\u5341\u516d \u56db\u5341\u4e03 \u56db\u5341\u516b \u56db\u5341\u4e5d \u4e94\u5341 \u4e94\u5341\u4e00 \u4e94\u5341\u4e8c \u4e94\u5341\u4e09 \u4e94\u5341\u56db \u4e94\u5341\u4e94 \u4e94\u5341\u516d \u4e94\u5341\u4e03 \u4e94\u5341\u516b \u4e94\u5341\u4e5d \u516d\u5341 \u516d\u5341\u4e00 \u516d\u5341\u4e8c \u516d\u5341\u4e09 \u516d\u5341\u56db \u516d\u5341\u4e94 \u516d\u5341\u516d \u516d\u5341\u4e03 \u516d\u5341\u516b \u516d\u5341\u4e5d \u4e03\u5341 \u4e03\u5341\u4e00 \u4e03\u5341\u4e8c \u4e03\u5341\u4e09 \u4e03\u5341\u56db \u4e03\u5341\u4e94 \u4e03\u5341\u516d \u4e03\u5341\u4e03 \u4e03\u5341\u516b \u4e03\u5341\u4e5d \u516b\u5341 \u516b\u5341\u4e00 \u516b\u5341\u4e8c \u516b\u5341\u4e09 \u516b\u5341\u56db \u516b\u5341\u4e94 \u516b\u5341\u516d \u516b\u5341\u4e03 \u516b\u5341\u516b \u516b\u5341\u4e5d \u4e5d\u5341 \u4e5d\u5341\u4e00 \u4e5d\u5341\u4e8c \u4e5d\u5341\u4e09 \u4e5d\u5341\u56db \u4e5d\u5341\u4e94 \u4e5d\u5341\u516d \u4e5d\u5341\u4e03 \u4e5d\u5341\u516b \u4e5d\u5341\u4e5d"
- ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%B%Od\u65e5"
- ::msgcat::mcset ja LOCALE_TIME_FORMAT "%OH\u6642%OM\u5206%OS\u79d2"
- ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%A %EY\u5e74%B%Od\u65e5%OH\u6642%OM\u5206%OS\u79d2 %z"
- ::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3060979200 \u660e\u6cbb 1867\u007d \u007b-1812153600 \u5927\u6b63 1911\u007d \u007b-1357603200 \u662d\u548c 1925\u007d \u007b568512000 \u5e73\u6210 1987\u007d"
+ ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5"
+ ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2"
+ ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
+ ::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3061011600 \u660e\u6cbb 1867\u007d \u007b-1812186000 \u5927\u6b63 1911\u007d \u007b-1357635600 \u662d\u548c 1925\u007d \u007b600220800 \u5e73\u6210 1988\u007d"
}
diff --git a/library/msgs/kl.msg b/library/msgs/kl.msg
index d877bfe..d877bfe 100755..100644
--- a/library/msgs/kl.msg
+++ b/library/msgs/kl.msg
diff --git a/library/msgs/kl_gl.msg b/library/msgs/kl_gl.msg
index 403aa10..403aa10 100755..100644
--- a/library/msgs/kl_gl.msg
+++ b/library/msgs/kl_gl.msg
diff --git a/library/msgs/ko.msg b/library/msgs/ko.msg
index 0cd17a1..0cd17a1 100755..100644
--- a/library/msgs/ko.msg
+++ b/library/msgs/ko.msg
diff --git a/library/msgs/ko_kr.msg b/library/msgs/ko_kr.msg
index ea5bbd7..ea5bbd7 100755..100644
--- a/library/msgs/ko_kr.msg
+++ b/library/msgs/ko_kr.msg
diff --git a/library/msgs/kok.msg b/library/msgs/kok.msg
index 0869f20..0869f20 100755..100644
--- a/library/msgs/kok.msg
+++ b/library/msgs/kok.msg
diff --git a/library/msgs/kok_in.msg b/library/msgs/kok_in.msg
index abcb1ff..abcb1ff 100755..100644
--- a/library/msgs/kok_in.msg
+++ b/library/msgs/kok_in.msg
diff --git a/library/msgs/kw.msg b/library/msgs/kw.msg
index aaf79b3..aaf79b3 100755..100644
--- a/library/msgs/kw.msg
+++ b/library/msgs/kw.msg
diff --git a/library/msgs/kw_gb.msg b/library/msgs/kw_gb.msg
index 2967680..2967680 100755..100644
--- a/library/msgs/kw_gb.msg
+++ b/library/msgs/kw_gb.msg
diff --git a/library/msgs/lt.msg b/library/msgs/lt.msg
index 27b0985..27b0985 100755..100644
--- a/library/msgs/lt.msg
+++ b/library/msgs/lt.msg
diff --git a/library/msgs/lv.msg b/library/msgs/lv.msg
index a037b15..a037b15 100755..100644
--- a/library/msgs/lv.msg
+++ b/library/msgs/lv.msg
diff --git a/library/msgs/mk.msg b/library/msgs/mk.msg
index 41cf60d..41cf60d 100755..100644
--- a/library/msgs/mk.msg
+++ b/library/msgs/mk.msg
diff --git a/library/msgs/mr.msg b/library/msgs/mr.msg
index cea427a..cea427a 100755..100644
--- a/library/msgs/mr.msg
+++ b/library/msgs/mr.msg
diff --git a/library/msgs/mr_in.msg b/library/msgs/mr_in.msg
index 1889da5..1889da5 100755..100644
--- a/library/msgs/mr_in.msg
+++ b/library/msgs/mr_in.msg
diff --git a/library/msgs/ms.msg b/library/msgs/ms.msg
index e954431..e954431 100755..100644
--- a/library/msgs/ms.msg
+++ b/library/msgs/ms.msg
diff --git a/library/msgs/ms_my.msg b/library/msgs/ms_my.msg
index c1f93d4..c1f93d4 100755..100644
--- a/library/msgs/ms_my.msg
+++ b/library/msgs/ms_my.msg
diff --git a/library/msgs/mt.msg b/library/msgs/mt.msg
index ddd5446..ddd5446 100755..100644
--- a/library/msgs/mt.msg
+++ b/library/msgs/mt.msg
diff --git a/library/msgs/nb.msg b/library/msgs/nb.msg
index 90d49a3..90d49a3 100755..100644
--- a/library/msgs/nb.msg
+++ b/library/msgs/nb.msg
diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg
index 4c5c675..4c5c675 100755..100644
--- a/library/msgs/nl.msg
+++ b/library/msgs/nl.msg
diff --git a/library/msgs/nl_be.msg b/library/msgs/nl_be.msg
index 4b19670..4b19670 100755..100644
--- a/library/msgs/nl_be.msg
+++ b/library/msgs/nl_be.msg
diff --git a/library/msgs/nn.msg b/library/msgs/nn.msg
index bd61ac9..bd61ac9 100755..100644
--- a/library/msgs/nn.msg
+++ b/library/msgs/nn.msg
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index d206f4b..d206f4b 100755..100644
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 96fdb35..96fdb35 100755..100644
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
diff --git a/library/msgs/pt_br.msg b/library/msgs/pt_br.msg
index 8684327..8684327 100755..100644
--- a/library/msgs/pt_br.msg
+++ b/library/msgs/pt_br.msg
diff --git a/library/msgs/ro.msg b/library/msgs/ro.msg
index bdd7c61..bdd7c61 100755..100644
--- a/library/msgs/ro.msg
+++ b/library/msgs/ro.msg
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 65b075d..65b075d 100755..100644
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
diff --git a/library/msgs/ru_ua.msg b/library/msgs/ru_ua.msg
index 6e1f8a8..6e1f8a8 100755..100644
--- a/library/msgs/ru_ua.msg
+++ b/library/msgs/ru_ua.msg
diff --git a/library/msgs/sh.msg b/library/msgs/sh.msg
index 6ee0fc7..6ee0fc7 100755..100644
--- a/library/msgs/sh.msg
+++ b/library/msgs/sh.msg
diff --git a/library/msgs/sk.msg b/library/msgs/sk.msg
index 9b2f0aa..9b2f0aa 100755..100644
--- a/library/msgs/sk.msg
+++ b/library/msgs/sk.msg
diff --git a/library/msgs/sl.msg b/library/msgs/sl.msg
index 42bc509..42bc509 100755..100644
--- a/library/msgs/sl.msg
+++ b/library/msgs/sl.msg
diff --git a/library/msgs/sq.msg b/library/msgs/sq.msg
index 8fb1fce..8fb1fce 100755..100644
--- a/library/msgs/sq.msg
+++ b/library/msgs/sq.msg
diff --git a/library/msgs/sr.msg b/library/msgs/sr.msg
index 7576668..7576668 100755..100644
--- a/library/msgs/sr.msg
+++ b/library/msgs/sr.msg
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index f7a67c6..f7a67c6 100755..100644
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
diff --git a/library/msgs/sw.msg b/library/msgs/sw.msg
index b888b43..b888b43 100755..100644
--- a/library/msgs/sw.msg
+++ b/library/msgs/sw.msg
diff --git a/library/msgs/ta.msg b/library/msgs/ta.msg
index 4abb90c..4abb90c 100755..100644
--- a/library/msgs/ta.msg
+++ b/library/msgs/ta.msg
diff --git a/library/msgs/ta_in.msg b/library/msgs/ta_in.msg
index 24590ac..24590ac 100755..100644
--- a/library/msgs/ta_in.msg
+++ b/library/msgs/ta_in.msg
diff --git a/library/msgs/te.msg b/library/msgs/te.msg
index 6111473..6111473 100755..100644
--- a/library/msgs/te.msg
+++ b/library/msgs/te.msg
diff --git a/library/msgs/te_in.msg b/library/msgs/te_in.msg
index 61638b5..61638b5 100755..100644
--- a/library/msgs/te_in.msg
+++ b/library/msgs/te_in.msg
diff --git a/library/msgs/th.msg b/library/msgs/th.msg
index 7486c35..7486c35 100755..100644
--- a/library/msgs/th.msg
+++ b/library/msgs/th.msg
diff --git a/library/msgs/tr.msg b/library/msgs/tr.msg
index 7b2ecf9..7b2ecf9 100755..100644
--- a/library/msgs/tr.msg
+++ b/library/msgs/tr.msg
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 3e24f86..7d4c64a 100755..100644
--- 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/msgs/vi.msg b/library/msgs/vi.msg
index c98b2a6..c98b2a6 100755..100644
--- a/library/msgs/vi.msg
+++ b/library/msgs/vi.msg
diff --git a/library/msgs/zh.msg b/library/msgs/zh.msg
index b799a32..b799a32 100755..100644
--- a/library/msgs/zh.msg
+++ b/library/msgs/zh.msg
diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg
index d62ce77..d62ce77 100755..100644
--- a/library/msgs/zh_cn.msg
+++ b/library/msgs/zh_cn.msg
diff --git a/library/msgs/zh_hk.msg b/library/msgs/zh_hk.msg
index badb1dd..badb1dd 100755..100644
--- a/library/msgs/zh_hk.msg
+++ b/library/msgs/zh_hk.msg
diff --git a/library/msgs/zh_sg.msg b/library/msgs/zh_sg.msg
index a2f3e39..a2f3e39 100755..100644
--- a/library/msgs/zh_sg.msg
+++ b/library/msgs/zh_sg.msg
diff --git a/library/msgs/zh_tw.msg b/library/msgs/zh_tw.msg
index e0796b1..e0796b1 100755..100644
--- a/library/msgs/zh_tw.msg
+++ b/library/msgs/zh_tw.msg
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 4622bde..fc77fa1 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -7,13 +7,11 @@
# 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.10 2003/09/10 20:27:30 dgp Exp $
package require Tcl 8.2
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
-package provide opt 0.4.5
+package provide opt 0.4.6
namespace eval ::tcl {
@@ -35,7 +33,7 @@ namespace eval ::tcl {
# Every OptProc give usage information on "procname -help".
# Try "tcl::OptParseTest -help" and "tcl::OptParseTest -a" and
# then other arguments.
- #
+ #
# example of 'valid' call:
# ::tcl::OptParseTest save -4 -pr 23 -libsok SybTcl\
# -nostatics false ch1
@@ -71,10 +69,10 @@ namespace eval ::tcl {
################### No User serviceable part below ! ###############
# Array storing the parsed descriptions
- variable OptDesc;
- array set OptDesc {};
+ variable OptDesc
+ array set OptDesc {}
# Next potentially free key id (numeric)
- variable OptDescN 0;
+ variable OptDescN 0
# Inside algorithm/mechanism description:
# (not for the faint hearted ;-)
@@ -86,8 +84,8 @@ namespace eval ::tcl {
#
# The general structure of a "program" is
# notation (pseudo bnf like)
-# name :== definition defines "name" as being "definition"
-# { x y z } means list of x, y, and z
+# name :== definition defines "name" as being "definition"
+# { x y z } means list of x, y, and z
# x* means x repeated 0 or more time
# x+ means "x x*"
# x? means optionally x
@@ -112,7 +110,7 @@ namespace eval ::tcl {
#
# And for this application:
#
-# singleStep :== { instruction varname {hasBeenSet currentValue} type
+# singleStep :== { instruction varname {hasBeenSet currentValue} type
# typeArgs help }
# instruction :== "flags" | "value"
# type :== knowType | anyword
@@ -145,54 +143,54 @@ namespace eval ::tcl {
# generate a unused keyid if not given
#
proc ::tcl::OptKeyRegister {desc {key ""}} {
- variable OptDesc;
- variable OptDescN;
+ variable OptDesc
+ variable OptDescN
if {[string equal $key ""]} {
# in case a key given to us as a parameter was a number
while {[info exists OptDesc($OptDescN)]} {incr OptDescN}
- set key $OptDescN;
- incr OptDescN;
+ set key $OptDescN
+ incr OptDescN
}
# program counter
- set program [list [list "P" 1]];
+ set program [list [list "P" 1]]
# are we processing flags (which makes a single program step)
- set inflags 0;
+ set inflags 0
- set state {};
+ set state {}
# flag used to detect that we just have a single (flags set) subprogram.
- set empty 1;
+ set empty 1
foreach item $desc {
if {$state == "args"} {
# more items after 'args'...
- return -code error "'args' special argument must be the last one";
+ return -code error "'args' special argument must be the last one"
}
- set res [OptNormalizeOne $item];
- set state [lindex $res 0];
+ set res [OptNormalizeOne $item]
+ set state [lindex $res 0]
if {$inflags} {
if {$state == "flags"} {
# add to 'subprogram'
- lappend flagsprg $res;
+ lappend flagsprg $res
} else {
# put in the flags
# structure for flag programs items is a list of
# {subprgcounter {prg flag 1} {prg flag 2} {...}}
- lappend program $flagsprg;
+ lappend program $flagsprg
# put the other regular stuff
- lappend program $res;
- set inflags 0;
- set empty 0;
+ lappend program $res
+ set inflags 0
+ set empty 0
}
} else {
if {$state == "flags"} {
- set inflags 1;
+ set inflags 1
# sub program counter + first sub program
- set flagsprg [list [list "P" 1] $res];
+ set flagsprg [list [list "P" 1] $res]
} else {
- lappend program $res;
- set empty 0;
+ lappend program $res
+ set empty 0
}
}
}
@@ -200,32 +198,32 @@ proc ::tcl::OptKeyRegister {desc {key ""}} {
if {$empty} {
# We just have the subprogram, optimize and remove
# unneeded level:
- set program $flagsprg;
+ set program $flagsprg
} else {
- lappend program $flagsprg;
+ lappend program $flagsprg
}
}
- set OptDesc($key) $program;
+ set OptDesc($key) $program
- return $key;
+ return $key
}
#
# Free the storage for that given key
#
proc ::tcl::OptKeyDelete {key} {
- variable OptDesc;
- unset OptDesc($key);
+ variable OptDesc
+ unset OptDesc($key)
}
# Get the parsed description stored under the given key.
proc OptKeyGetDesc {descKey} {
- variable OptDesc;
+ variable OptDesc
if {![info exists OptDesc($descKey)]} {
- return -code error "Unknown option description key \"$descKey\"";
+ return -code error "Unknown option description key \"$descKey\""
}
- set OptDesc($descKey);
+ set OptDesc($descKey)
}
# Parse entry point for ppl who don't want to register with a key,
@@ -234,10 +232,10 @@ proc ::tcl::OptKeyDelete {key} {
# as it is way faster or simply OptProc which does it all)
# Assign a temporary key, call OptKeyParse and then free the storage
proc ::tcl::OptParse {desc arglist} {
- set tempkey [OptKeyRegister $desc];
- set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res];
- OptKeyDelete $tempkey;
- return -code $ret $res;
+ set tempkey [OptKeyRegister $desc]
+ set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res]
+ OptKeyDelete $tempkey
+ return -code $ret $res
}
# Helper function, replacement for proc that both
@@ -248,22 +246,22 @@ proc ::tcl::OptParse {desc arglist} {
# (the other will be sets to their default value)
# into local variable named "Args".
proc ::tcl::OptProc {name desc body} {
- set namespace [uplevel 1 [list ::namespace current]];
+ set namespace [uplevel 1 [list ::namespace current]]
if {[string match "::*" $name] || [string equal $namespace "::"]} {
# absolute name or global namespace, name is the key
- set key $name;
+ set key $name
} else {
# we are relative to some non top level namespace:
- set key "${namespace}::${name}";
+ set key "${namespace}::${name}"
}
- OptKeyRegister $desc $key;
- uplevel 1 [list ::proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
- return $key;
+ OptKeyRegister $desc $key
+ uplevel 1 [list ::proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"]
+ return $key
}
# Check that a argument has been given
# assumes that "OptProc" has been used as it will check in "Args" list
proc ::tcl::OptProcArgGiven {argname} {
- upvar Args alist;
+ upvar Args alist
expr {[lsearch $alist $argname] >=0}
}
@@ -272,7 +270,7 @@ proc ::tcl::OptProcArgGiven {argname} {
# Return the instruction word/list of a given step/(sub)program
proc OptInstr {lst} {
- lindex $lst 0;
+ lindex $lst 0
}
# Is a (sub) program or a plain instruction ?
proc OptIsPrg {lst} {
@@ -288,56 +286,56 @@ proc ::tcl::OptProcArgGiven {argname} {
}
# Current program counter (2nd word of first word)
proc OptSetPrgCounter {lstName newValue} {
- upvar $lstName lst;
- set lst [lreplace $lst 0 0 [concat "P" $newValue]];
+ upvar $lstName lst
+ set lst [lreplace $lst 0 0 [concat "P" $newValue]]
}
# returns a list of currently selected items.
proc OptSelection {lst} {
- set res {};
+ set res {}
foreach idx [lrange [lindex $lst 0] 1 end] {
- lappend res [Lget $lst $idx];
+ lappend res [Lget $lst $idx]
}
- return $res;
+ return $res
}
# Advance to next description
proc OptNextDesc {descName} {
- uplevel 1 [list Lvarincr $descName {0 1}];
+ uplevel 1 [list Lvarincr $descName {0 1}]
}
# Get the current description, eventually descend
proc OptCurDesc {descriptions} {
- lindex $descriptions [OptGetPrgCounter $descriptions];
+ lindex $descriptions [OptGetPrgCounter $descriptions]
}
# get the current description, eventually descend
# through sub programs as needed.
proc OptCurDescFinal {descriptions} {
- set item [OptCurDesc $descriptions];
+ set item [OptCurDesc $descriptions]
# Descend untill we get the actual item and not a sub program
while {[OptIsPrg $item]} {
- set item [OptCurDesc $item];
+ set item [OptCurDesc $item]
}
- return $item;
+ return $item
}
# Current final instruction adress
proc OptCurAddr {descriptions {start {}}} {
- set adress [OptGetPrgCounter $descriptions];
- lappend start $adress;
- set item [lindex $descriptions $adress];
+ set adress [OptGetPrgCounter $descriptions]
+ lappend start $adress
+ set item [lindex $descriptions $adress]
if {[OptIsPrg $item]} {
- return [OptCurAddr $item $start];
+ return [OptCurAddr $item $start]
} else {
- return $start;
+ return $start
}
}
# Set the value field of the current instruction
proc OptCurSetValue {descriptionsName value} {
upvar $descriptionsName descriptions
# get the current item full adress
- set adress [OptCurAddr $descriptions];
+ set adress [OptCurAddr $descriptions]
# use the 3th field of the item (see OptValue / OptNewInst)
lappend adress 2
- Lvarset descriptions $adress [list 1 $value];
+ Lvarset descriptions $adress [list 1 $value]
# ^hasBeenSet flag
}
@@ -345,10 +343,10 @@ proc ::tcl::OptProcArgGiven {argname} {
proc OptState {item} {
lindex $item 0
}
-
+
# current state
proc OptCurState {descriptions} {
- OptState [OptCurDesc $descriptions];
+ OptState [OptCurDesc $descriptions]
}
#######
@@ -356,11 +354,11 @@ proc ::tcl::OptProcArgGiven {argname} {
# Returns the argument that has to be processed now
proc OptCurrentArg {lst} {
- lindex $lst 0;
+ lindex $lst 0
}
# Advance to next argument
proc OptNextArg {argsName} {
- uplevel 1 [list Lvarpop1 $argsName];
+ uplevel 1 [list Lvarpop1 $argsName]
}
#######
@@ -372,49 +370,49 @@ proc ::tcl::OptProcArgGiven {argname} {
# eventually eat all the arguments.
proc OptDoAll {descriptionsName argumentsName} {
upvar $descriptionsName descriptions
- upvar $argumentsName arguments;
-# puts "entered DoAll";
+ upvar $argumentsName arguments
+# puts "entered DoAll"
# Nb: the places where "state" can be set are tricky to figure
# because DoOne sets the state to flagsValue and return -continue
# when needed...
- set state [OptCurState $descriptions];
+ set state [OptCurState $descriptions]
# We'll exit the loop in "OptDoOne" or when state is empty.
while 1 {
- set curitem [OptCurDesc $descriptions];
+ set curitem [OptCurDesc $descriptions]
# Do subprograms if needed, call ourselves on the sub branch
while {[OptIsPrg $curitem]} {
OptDoAll curitem arguments
-# puts "done DoAll sub";
- # Insert back the results in current tree;
+# puts "done DoAll sub"
+ # Insert back the results in current tree
Lvarset1nc descriptions [OptGetPrgCounter $descriptions]\
- $curitem;
- OptNextDesc descriptions;
- set curitem [OptCurDesc $descriptions];
- set state [OptCurState $descriptions];
+ $curitem
+ OptNextDesc descriptions
+ set curitem [OptCurDesc $descriptions]
+ set state [OptCurState $descriptions]
}
-# puts "state = \"$state\" - arguments=($arguments)";
+# puts "state = \"$state\" - arguments=($arguments)"
if {[Lempty $state]} {
# Nothing left to do, we are done in this branch:
- break;
+ break
}
# The following statement can make us terminate/continue
# as it use return -code {break, continue, return and error}
# codes
- OptDoOne descriptions state arguments;
+ OptDoOne descriptions state arguments
# If we are here, no special return code where issued,
# we'll step to next instruction :
-# puts "new state = \"$state\"";
- OptNextDesc descriptions;
- set state [OptCurState $descriptions];
+# puts "new state = \"$state\""
+ OptNextDesc descriptions
+ set state [OptCurState $descriptions]
}
}
# Process one step for the state machine,
# eventually consuming the current argument.
proc OptDoOne {descriptionsName stateName argumentsName} {
- upvar $argumentsName arguments;
- upvar $descriptionsName descriptions;
- upvar $stateName state;
+ upvar $argumentsName arguments
+ upvar $descriptionsName descriptions
+ upvar $stateName state
# the special state/instruction "args" eats all
# the remaining args (if any)
@@ -422,27 +420,27 @@ proc ::tcl::OptProcArgGiven {argname} {
if {![Lempty $arguments]} {
# If there is no additional arguments, leave the default value
# in.
- OptCurSetValue descriptions $arguments;
- set arguments {};
+ OptCurSetValue descriptions $arguments
+ set arguments {}
}
# puts "breaking out ('args' state: consuming every reminding args)"
- return -code break;
+ return -code break
}
if {[Lempty $arguments]} {
if {$state == "flags"} {
# no argument and no flags : we're done
-# puts "returning to previous (sub)prg (no more args)";
- return -code return;
+# puts "returning to previous (sub)prg (no more args)"
+ return -code return
} elseif {$state == "optValue"} {
set state next; # not used, for debug only
# go to next state
- return ;
+ return
} else {
- return -code error [OptMissingValue $descriptions];
+ return -code error [OptMissingValue $descriptions]
}
} else {
- set arg [OptCurrentArg $arguments];
+ set arg [OptCurrentArg $arguments]
}
switch $state {
@@ -452,62 +450,62 @@ proc ::tcl::OptProcArgGiven {argname} {
# Still a flag ?
if {![OptIsFlag $arg]} {
# don't consume the argument, return to previous prg
- return -code return;
+ return -code return
}
# consume the flag
- OptNextArg arguments;
+ OptNextArg arguments
if {[string equal "--" $arg]} {
# return from 'flags' state
- return -code return;
+ return -code return
}
- set hits [OptHits descriptions $arg];
+ set hits [OptHits descriptions $arg]
if {$hits > 1} {
return -code error [OptAmbigous $descriptions $arg]
} elseif {$hits == 0} {
return -code error [OptFlagUsage $descriptions $arg]
}
- set item [OptCurDesc $descriptions];
+ set item [OptCurDesc $descriptions]
if {[OptNeedValue $item]} {
# we need a value, next state is
- set state flagValue;
+ set state flagValue
} else {
- OptCurSetValue descriptions 1;
+ OptCurSetValue descriptions 1
}
# continue
- return -code continue;
+ return -code continue
}
flagValue -
value {
- set item [OptCurDesc $descriptions];
+ set item [OptCurDesc $descriptions]
# Test the values against their required type
if {[catch {OptCheckType $arg\
[OptType $item] [OptTypeArgs $item]} val]} {
return -code error [OptBadValue $item $arg $val]
}
# consume the value
- OptNextArg arguments;
+ OptNextArg arguments
# set the value
- OptCurSetValue descriptions $val;
+ OptCurSetValue descriptions $val
# go to next state
if {$state == "flagValue"} {
set state flags
- return -code continue;
+ return -code continue
} else {
set state next; # not used, for debug only
return ; # will go on next step
}
}
optValue {
- set item [OptCurDesc $descriptions];
+ set item [OptCurDesc $descriptions]
# Test the values against their required type
if {![catch {OptCheckType $arg\
[OptType $item] [OptTypeArgs $item]} val]} {
# right type, so :
# consume the value
- OptNextArg arguments;
+ OptNextArg arguments
# set the value
- OptCurSetValue descriptions $val;
+ OptCurSetValue descriptions $val
}
# go to next state
set state next; # not used, for debug only
@@ -518,39 +516,39 @@ proc ::tcl::OptProcArgGiven {argname} {
# state as been entered !
return -code error "Bug! unknown state in DoOne \"$state\"\
(prg counter [OptGetPrgCounter $descriptions]:\
- [OptCurDesc $descriptions])";
+ [OptCurDesc $descriptions])"
}
# Parse the options given the key to previously registered description
# and arguments list
proc ::tcl::OptKeyParse {descKey arglist} {
- set desc [OptKeyGetDesc $descKey];
+ set desc [OptKeyGetDesc $descKey]
# make sure -help always give usage
if {[string equal -nocase "-help" $arglist]} {
- return -code error [OptError "Usage information:" $desc 1];
+ return -code error [OptError "Usage information:" $desc 1]
}
- OptDoAll desc arglist;
+ OptDoAll desc arglist
if {![Lempty $arglist]} {
- return -code error [OptTooManyArgs $desc $arglist];
+ return -code error [OptTooManyArgs $desc $arglist]
}
-
+
# Analyse the result
# Walk through the tree:
- OptTreeVars $desc "#[expr {[info level]-1}]" ;
+ OptTreeVars $desc "#[expr {[info level]-1}]"
}
# determine string length for nice tabulated output
proc OptTreeVars {desc level {vnamesLst {}}} {
foreach item $desc {
- if {[OptIsCounter $item]} continue;
+ if {[OptIsCounter $item]} continue
if {[OptIsPrg $item]} {
- set vnamesLst [OptTreeVars $item $level $vnamesLst];
+ set vnamesLst [OptTreeVars $item $level $vnamesLst]
} else {
- set vname [OptVarName $item];
+ set vname [OptVarName $item]
upvar $level $vname var
if {[OptHasBeenSet $item]} {
# puts "adding $vname"
@@ -558,10 +556,10 @@ proc ::tcl::OptKeyParse {descKey arglist} {
# it is more usefull, for instance you can check that
# no flags at all was given with expr
# {![string match "*-*" $Args]}
- lappend vnamesLst [OptName $item];
- set var [OptValue $item];
+ lappend vnamesLst [OptName $item]
+ set var [OptValue $item]
} else {
- set var [OptDefaultValue $item];
+ set var [OptDefaultValue $item]
}
}
}
@@ -573,7 +571,7 @@ proc ::tcl::OptKeyParse {descKey arglist} {
# and emit an error if arg is not of the correct type
# otherwise returns the canonical value of that arg (ie 0/1 for booleans)
proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
-# puts "checking '$arg' against '$type' ($typeArgs)";
+# puts "checking '$arg' against '$type' ($typeArgs)"
# only types "any", "choice", and numbers can have leading "-"
@@ -582,7 +580,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
if {![string is integer -strict $arg]} {
error "not an integer"
}
- return $arg;
+ return $arg
}
float {
return [expr {double($arg)}]
@@ -593,7 +591,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
if {[llength $arg]==0 && [OptIsFlag $arg]} {
error "no values with leading -"
}
- return $arg;
+ return $arg
}
boolean {
if {![string is boolean -strict $arg]} {
@@ -606,10 +604,10 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
if {[lsearch -exact $typeArgs $arg] < 0} {
error "invalid choice"
}
- return $arg;
+ return $arg
}
any {
- return $arg;
+ return $arg
}
string -
default {
@@ -619,7 +617,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
return $arg
}
}
- return neverReached;
+ return neverReached
}
# internal utilities
@@ -627,34 +625,34 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# returns the number of flags matching the given arg
# sets the (local) prg counter to the list of matches
proc OptHits {descName arg} {
- upvar $descName desc;
+ upvar $descName desc
set hits 0
set hitems {}
- set i 1;
+ set i 1
- set larg [string tolower $arg];
- set len [string length $larg];
- set last [expr {$len-1}];
+ set larg [string tolower $arg]
+ set len [string length $larg]
+ set last [expr {$len-1}]
foreach item [lrange $desc 1 end] {
set flag [OptName $item]
# lets try to match case insensitively
# (string length ought to be cheap)
- set lflag [string tolower $flag];
+ set lflag [string tolower $flag]
if {$len == [string length $lflag]} {
if {[string equal $larg $lflag]} {
# Exact match case
- OptSetPrgCounter desc $i;
- return 1;
+ OptSetPrgCounter desc $i
+ return 1
}
} elseif {[string equal $larg [string range $lflag 0 $last]]} {
- lappend hitems $i;
- incr hits;
+ lappend hitems $i
+ incr hits
}
- incr i;
+ incr i
}
if {$hits} {
- OptSetPrgCounter desc $hitems;
+ OptSetPrgCounter desc $hitems
}
return $hits
}
@@ -662,29 +660,29 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# Extract fields from the list structure:
proc OptName {item} {
- lindex $item 1;
+ lindex $item 1
}
proc OptHasBeenSet {item} {
- Lget $item {2 0};
+ Lget $item {2 0}
}
proc OptValue {item} {
- Lget $item {2 1};
+ Lget $item {2 1}
}
proc OptIsFlag {name} {
- string match "-*" $name;
+ string match "-*" $name
}
proc OptIsOpt {name} {
- string match {\?*} $name;
+ string match {\?*} $name
}
proc OptVarName {item} {
- set name [OptName $item];
+ set name [OptName $item]
if {[OptIsFlag $name]} {
- return [string range $name 1 end];
+ return [string range $name 1 end]
} elseif {[OptIsOpt $name]} {
- return [string trim $name "?"];
+ return [string trim $name "?"]
} else {
- return $name;
+ return $name
}
}
proc OptType {item} {
@@ -721,13 +719,13 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
proc OptOptUsage {item {what ""}} {
return -code error "invalid description format$what: $item\n\
should be a list of {varname|-flagname ?-type? ?defaultvalue?\
- ?helpstring?}";
+ ?helpstring?}"
}
# Generate a canonical form single instruction
proc OptNewInst {state varname type typeArgs help} {
- list $state $varname [list 0 {}] $type $typeArgs $help;
+ list $state $varname [list 0 {}] $type $typeArgs $help
# ^ ^
# | |
# hasBeenSet=+ +=currentValue
@@ -735,18 +733,18 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
# Translate one item to canonical form
proc OptNormalizeOne {item} {
- set lg [Lassign $item varname arg1 arg2 arg3];
-# puts "called optnormalizeone '$item' v=($varname), lg=$lg";
- set isflag [OptIsFlag $varname];
- set isopt [OptIsOpt $varname];
+ set lg [Lassign $item varname arg1 arg2 arg3]
+# puts "called optnormalizeone '$item' v=($varname), lg=$lg"
+ set isflag [OptIsFlag $varname]
+ set isopt [OptIsOpt $varname]
if {$isflag} {
- set state "flags";
+ set state "flags"
} elseif {$isopt} {
- set state "optValue";
+ set state "optValue"
} elseif {![string equal $varname "args"]} {
- set state "value";
+ set state "value"
} else {
- set state "args";
+ set state "args"
}
# apply 'smart' 'fuzzy' logic to try to make
@@ -756,9 +754,9 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
switch $lg {
1 {
if {$isflag} {
- return [OptNewInst $state $varname boolflag false ""];
+ return [OptNewInst $state $varname boolflag false ""]
} else {
- return [OptNewInst $state $varname any "" ""];
+ return [OptNewInst $state $varname any "" ""]
}
}
2 {
@@ -778,20 +776,20 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
set help ""
set def $arg1
}
- return [OptNewInst $state $varname $type $def $help];
+ return [OptNewInst $state $varname $type $def $help]
}
3 {
# varname type value
# varname value comment
-
+
if {[regexp {^-(.+)$} $arg1 x type]} {
# flags/optValue as they are optional, need a "value",
# on the contrary, for a variable (non optional),
# default value is pointless, 'cept for choices :
if {$isflag || $isopt || ($type == "choice")} {
- return [OptNewInst $state $varname $type $arg2 ""];
+ return [OptNewInst $state $varname $type $arg2 ""]
} else {
- return [OptNewInst $state $varname $type "" $arg2];
+ return [OptNewInst $state $varname $type "" $arg2]
}
} else {
return [OptNewInst $state $varname\
@@ -800,13 +798,13 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
}
4 {
if {[regexp {^-(.+)$} $arg1 x type]} {
- return [OptNewInst $state $varname $type $arg2 $arg3];
+ return [OptNewInst $state $varname $type $arg2 $arg3]
} else {
- return -code error [OptOptUsage $item];
+ return -code error [OptOptUsage $item]
}
}
default {
- return -code error [OptOptUsage $item];
+ return -code error [OptOptUsage $item]
}
}
}
@@ -831,7 +829,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
OptError "ambigous option \"$arg\", choose from:" [OptSelection $desc]
}
proc OptFlagUsage {desc arg} {
- OptError "bad flag \"$arg\", must be one of" $desc;
+ OptError "bad flag \"$arg\", must be one of" $desc
}
proc OptTooManyArgs {desc arguments} {
OptError "too many arguments (unexpected argument(s): $arguments),\
@@ -840,45 +838,45 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
}
proc OptParamType {item} {
if {[OptIsFlag $item]} {
- return "flag";
+ return "flag"
} else {
- return "parameter";
+ return "parameter"
}
}
proc OptBadValue {item arg {err {}}} {
-# puts "bad val err = \"$err\"";
+# puts "bad val err = \"$err\""
OptError "bad value \"$arg\" for [OptParamType $item]"\
[list $item]
}
proc OptMissingValue {descriptions} {
-# set item [OptCurDescFinal $descriptions];
- set item [OptCurDesc $descriptions];
+# set item [OptCurDescFinal $descriptions]
+ set item [OptCurDesc $descriptions]
OptError "no value given for [OptParamType $item] \"[OptName $item]\"\
(use -help for full usage) :"\
[list $item]
}
proc ::tcl::OptKeyError {prefix descKey {header 0}} {
- OptError $prefix [OptKeyGetDesc $descKey] $header;
+ OptError $prefix [OptKeyGetDesc $descKey] $header
}
# determine string length for nice tabulated output
proc OptLengths {desc nlName tlName dlName} {
- upvar $nlName nl;
- upvar $tlName tl;
- upvar $dlName dl;
+ upvar $nlName nl
+ upvar $tlName tl
+ upvar $dlName dl
foreach item $desc {
- if {[OptIsCounter $item]} continue;
+ if {[OptIsCounter $item]} continue
if {[OptIsPrg $item]} {
OptLengths $item nl tl dl
} else {
SetMax nl [string length [OptName $item]]
SetMax tl [string length [OptType $item]]
- set dv [OptTypeArgs $item];
+ set dv [OptTypeArgs $item]
if {[OptState $item] != "header"} {
- set dv "($dv)";
+ set dv "($dv)"
}
- set l [string length $dv];
+ set l [string length $dv]
# limit the space allocated to potentially big "choices"
if {([OptType $item] != "choice") || ($l<=12)} {
SetMax dl $l
@@ -892,22 +890,22 @@ proc ::tcl::OptKeyError {prefix descKey {header 0}} {
}
# output the tree
proc OptTree {desc nl tl dl} {
- set res "";
+ set res ""
foreach item $desc {
- if {[OptIsCounter $item]} continue;
+ if {[OptIsCounter $item]} continue
if {[OptIsPrg $item]} {
- append res [OptTree $item $nl $tl $dl];
+ append res [OptTree $item $nl $tl $dl]
} else {
- set dv [OptTypeArgs $item];
+ set dv [OptTypeArgs $item]
if {[OptState $item] != "header"} {
- set dv "($dv)";
+ set dv "($dv)"
}
- append res [format "\n %-*s %-*s %-*s %s" \
+ append res [string trimright [format "\n %-*s %-*s %-*s %s" \
$nl [OptName $item] $tl [OptType $item] \
- $dl $dv [OptHelp $item]]
+ $dl $dv [OptHelp $item]]]
}
}
- return $res;
+ return $res
}
# Give nice usage string
@@ -915,13 +913,13 @@ proc ::tcl::OptError {prefix desc {header 0}} {
# determine length
if {$header} {
# add faked instruction
- set h [list [OptNewInst header Var/FlagName Type Value Help]];
- lappend h [OptNewInst header ------------ ---- ----- ----];
- lappend h [OptNewInst header {( -help} "" "" {gives this help )}]
+ set h [list [OptNewInst header Var/FlagName Type Value Help]]
+ lappend h [OptNewInst header ------------ ---- ----- ----]
+ lappend h [OptNewInst header {(-help} "" "" {gives this help)}]
set desc [concat $h $desc]
}
OptLengths $desc nl tl dl
- # actually output
+ # actually output
return "$prefix[OptTree $desc $nl $tl $dl]"
}
@@ -945,105 +943,105 @@ proc ::tcl::Lempty {list} {
# Gets the value of one leaf of a lists tree
proc ::tcl::Lget {list indexLst} {
if {[llength $indexLst] <= 1} {
- return [lindex $list $indexLst];
+ return [lindex $list $indexLst]
}
- Lget [lindex $list [lindex $indexLst 0]] [lrange $indexLst 1 end];
+ Lget [lindex $list [lindex $indexLst 0]] [lrange $indexLst 1 end]
}
# Sets the value of one leaf of a lists tree
# (we use the version that does not create the elements because
# it would be even slower... needs to be written in C !)
# (nb: there is a non trivial recursive problem with indexes 0,
# which appear because there is no difference between a list
-# of 1 element and 1 element alone : [list "a"] == "a" while
+# of 1 element and 1 element alone : [list "a"] == "a" while
# it should be {a} and [listp a] should be 0 while [listp {a b}] would be 1
# and [listp "a b"] maybe 0. listp does not exist either...)
proc ::tcl::Lvarset {listName indexLst newValue} {
- upvar $listName list;
+ upvar $listName list
if {[llength $indexLst] <= 1} {
- Lvarset1nc list $indexLst $newValue;
+ Lvarset1nc list $indexLst $newValue
} else {
- set idx [lindex $indexLst 0];
- set targetList [lindex $list $idx];
+ set idx [lindex $indexLst 0]
+ set targetList [lindex $list $idx]
# reduce refcount on targetList (not really usefull now,
# could be with optimizing compiler)
-# Lvarset1 list $idx {};
+# Lvarset1 list $idx {}
# recursively replace in targetList
- Lvarset targetList [lrange $indexLst 1 end] $newValue;
+ Lvarset targetList [lrange $indexLst 1 end] $newValue
# put updated sub list back in the tree
- Lvarset1nc list $idx $targetList;
+ Lvarset1nc list $idx $targetList
}
}
# Set one cell to a value, eventually create all the needed elements
# (on level-1 of lists)
variable emptyList {}
proc ::tcl::Lvarset1 {listName index newValue} {
- upvar $listName list;
+ upvar $listName list
if {$index < 0} {return -code error "invalid negative index"}
- set lg [llength $list];
+ set lg [llength $list]
if {$index >= $lg} {
- variable emptyList;
+ variable emptyList
for {set i $lg} {$i<$index} {incr i} {
- lappend list $emptyList;
+ lappend list $emptyList
}
- lappend list $newValue;
+ lappend list $newValue
} else {
- set list [lreplace $list $index $index $newValue];
+ set list [lreplace $list $index $index $newValue]
}
}
# same as Lvarset1 but no bound checking / creation
proc ::tcl::Lvarset1nc {listName index newValue} {
- upvar $listName list;
- set list [lreplace $list $index $index $newValue];
+ upvar $listName list
+ set list [lreplace $list $index $index $newValue]
}
# Increments the value of one leaf of a lists tree
# (which must exists)
proc ::tcl::Lvarincr {listName indexLst {howMuch 1}} {
- upvar $listName list;
+ upvar $listName list
if {[llength $indexLst] <= 1} {
- Lvarincr1 list $indexLst $howMuch;
+ Lvarincr1 list $indexLst $howMuch
} else {
- set idx [lindex $indexLst 0];
- set targetList [lindex $list $idx];
+ set idx [lindex $indexLst 0]
+ set targetList [lindex $list $idx]
# reduce refcount on targetList
- Lvarset1nc list $idx {};
+ Lvarset1nc list $idx {}
# recursively replace in targetList
- Lvarincr targetList [lrange $indexLst 1 end] $howMuch;
+ Lvarincr targetList [lrange $indexLst 1 end] $howMuch
# put updated sub list back in the tree
- Lvarset1nc list $idx $targetList;
+ Lvarset1nc list $idx $targetList
}
}
# Increments the value of one cell of a list
proc ::tcl::Lvarincr1 {listName index {howMuch 1}} {
- upvar $listName list;
- set newValue [expr {[lindex $list $index]+$howMuch}];
- set list [lreplace $list $index $index $newValue];
- return $newValue;
+ upvar $listName list
+ set newValue [expr {[lindex $list $index]+$howMuch}]
+ set list [lreplace $list $index $index $newValue]
+ return $newValue
}
# Removes the first element of a list
# and returns the new list value
proc ::tcl::Lvarpop1 {listName} {
- upvar $listName list;
- set list [lrange $list 1 end];
+ upvar $listName list
+ set list [lrange $list 1 end]
}
# Same but returns the removed element
# (Like the tclX version)
proc ::tcl::Lvarpop {listName} {
- upvar $listName list;
- set el [lindex $list 0];
- set list [lrange $list 1 end];
- return $el;
+ upvar $listName list
+ set el [lindex $list 0]
+ set list [lrange $list 1 end]
+ return $el
}
# Assign list elements to variables and return the length of the list
proc ::tcl::Lassign {list args} {
# faster than direct blown foreach (which does not byte compile)
- set i 0;
- set lg [llength $list];
+ set i 0
+ set lg [llength $list]
foreach vname $args {
if {$i>=$lg} break
- uplevel 1 [list ::set $vname [lindex $list $i]];
- incr i;
+ uplevel 1 [list ::set $vname [lindex $list $i]]
+ incr i
}
- return $lg;
+ return $lg
}
# Misc utilities
diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl
index c5d3635..107d4c6 100644
--- a/library/opt/pkgIndex.tcl
+++ b/library/opt/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded opt 0.4.5 [list source [file join $dir optparse.tcl]]
+package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]]
diff --git a/library/package.tcl b/library/package.tcl
index 9d9e0a9..52daa0e 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.33 2005/07/23 04:12:49 dgp Exp $
-#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -16,9 +14,9 @@ namespace eval tcl::Pkg {}
# ::tcl::Pkg::CompareExtension --
#
-# Used internally by pkg_mkIndex to compare the extension of a file to
-# a given extension. On Windows, it uses a case-insensitive comparison
-# because the file system can be file insensitive.
+# Used internally by pkg_mkIndex to compare the extension of a file to a given
+# extension. On Windows, it uses a case-insensitive comparison because the
+# file system can be file insensitive.
#
# Arguments:
# fileName name of a file whose extension is compared
@@ -29,7 +27,7 @@ namespace eval tcl::Pkg {}
# Results:
# Returns 1 if the extension matches, 0 otherwise
-proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
+proc tcl::Pkg::CompareExtension {fileName {ext {}}} {
global tcl_platform
if {$ext eq ""} {set ext [info sharedlibextension]}
if {$tcl_platform(platform) eq "windows"} {
@@ -42,7 +40,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
set currExt [file extension $root]
if {$currExt eq $ext} {
return 1
- }
+ }
# The current extension does not match; if it is not a numeric
# value, quit, as we are only looking to ignore version number
@@ -50,7 +48,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
# tcl::Pkg::CompareExtension foo.so.bar .so
# which should not match.
- if { ![string is integer -strict [string range $currExt 1 end]] } {
+ if {![string is integer -strict [string range $currExt 1 end]]} {
return 0
}
set root [file rootname $root]
@@ -59,11 +57,10 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
}
# pkg_mkIndex --
-# This procedure creates a package index in a given directory. The
-# package index consists of a "pkgIndex.tcl" file whose contents are
-# a Tcl script that sets up package information with "package require"
-# commands. The commands describe all of the packages defined by the
-# files given as arguments.
+# This procedure creates a package index in a given directory. The package
+# index consists of a "pkgIndex.tcl" file whose contents are a Tcl script that
+# sets up package information with "package require" commands. The commands
+# describe all of the packages defined by the files given as arguments.
#
# Arguments:
# -direct (optional) If this flag is present, the generated
@@ -84,7 +81,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
# dir.
proc pkg_mkIndex {args} {
- set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};
+ set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"}
set argCount [llength $args]
if {$argCount < 1} {
@@ -130,20 +127,21 @@ proc pkg_mkIndex {args} {
set dir [lindex $args $idx]
set patternList [lrange $args [expr {$idx + 1}] end]
- if {[llength $patternList] == 0} {
+ if {![llength $patternList]} {
set patternList [list "*.tcl" "*[info sharedlibextension]"]
}
- if {[catch {
- glob -directory $dir -tails -types {r f} -- {expand}$patternList
- } fileList o]} {
- return -options $o $fileList
+ try {
+ set fileList [glob -directory $dir -tails -types {r f} -- \
+ {*}$patternList]
+ } on error {msg opt} {
+ return -options $opt $msg
}
foreach file $fileList {
# For each file, figure out what commands and packages it provides.
# To do this, create a child interpreter, load the file into the
- # interpreter, and get a list of the new commands and packages
- # that are defined.
+ # interpreter, and get a list of the new commands and packages that
+ # are defined.
if {$file eq "pkgIndex.tcl"} {
continue
@@ -165,20 +163,23 @@ proc pkg_mkIndex {args} {
}
}
foreach pkg [info loaded] {
- if {! [string match -nocase $loadPat [lindex $pkg 1]]} {
+ if {![string match -nocase $loadPat [lindex $pkg 1]]} {
continue
}
if {$doVerbose} {
tclLog "package [lindex $pkg 1] matches '$loadPat'"
}
- if {[catch {
+ try {
load [lindex $pkg 0] [lindex $pkg 1] $c
- } err]} {
+ } on error err {
+ if {$doVerbose} {
+ tclLog "warning: load [lindex $pkg 0]\
+ [lindex $pkg 1]\nfailed with: $err"
+ }
+ } on ok {} {
if {$doVerbose} {
- tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
+ tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
}
- } elseif {$doVerbose} {
- tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
}
if {[lindex $pkg 1] eq "Tk"} {
# Withdraw . if Tk was loaded, to avoid showing a window.
@@ -187,21 +188,25 @@ proc pkg_mkIndex {args} {
}
$c eval {
- # Stub out the package command so packages can
- # require other packages.
+ # Stub out the package command so packages can require other
+ # packages.
rename package __package_orig
proc package {what args} {
switch -- $what {
- require { return ; # ignore transitive requires }
- default { __package_orig $what {expand}$args }
+ require {
+ return; # Ignore transitive requires
+ }
+ default {
+ __package_orig $what {*}$args
+ }
}
}
proc tclPkgUnknown args {}
package unknown tclPkgUnknown
- # Stub out the unknown command so package can call
- # into each other during their initialilzation.
+ # Stub out the unknown command so package can call into each other
+ # during their initialilzation.
proc unknown {args} {}
@@ -209,9 +214,9 @@ proc pkg_mkIndex {args} {
proc auto_import {args} {}
- # reserve the ::tcl namespace for support procs
- # and temporary variables. This might make it awkward
- # to generate a pkgIndex.tcl file for the ::tcl namespace.
+ # reserve the ::tcl namespace for support procs and temporary
+ # variables. This might make it awkward to generate a
+ # pkgIndex.tcl file for the ::tcl namespace.
namespace eval ::tcl {
variable dir ;# Current directory being processed
@@ -232,27 +237,27 @@ proc pkg_mkIndex {args} {
$c eval [list set ::tcl::file $file]
$c eval [list set ::tcl::direct $direct]
- # Download needed procedures into the slave because we've
- # just deleted the unknown procedure. This doesn't handle
- # procedures with default arguments.
+ # Download needed procedures into the slave because we've just deleted
+ # the unknown procedure. This doesn't handle procedures with default
+ # arguments.
foreach p {::tcl::Pkg::CompareExtension} {
$c eval [list namespace eval [namespace qualifiers $p] {}]
$c eval [list proc $p [info args $p] [info body $p]]
}
- if {[catch {
+ try {
$c eval {
set ::tcl::debug "loading or sourcing"
- # we need to track command defined by each package even in
- # the -direct case, because they are needed internally by
- # the "partial pkgIndex.tcl" step above.
+ # we need to track command defined by each package even in the
+ # -direct case, because they are needed internally by the
+ # "partial pkgIndex.tcl" step above.
proc ::tcl::GetAllNamespaces {{root ::}} {
set list $root
foreach ns [namespace children $root] {
- lappend list {expand}[::tcl::GetAllNamespaces $ns]
+ lappend list {*}[::tcl::GetAllNamespaces $ns]
}
return $list
}
@@ -269,18 +274,17 @@ proc pkg_mkIndex {args} {
}
set ::tcl::origCmds [info commands]
- # Try to load the file if it has the shared library
- # extension, otherwise source it. It's important not to
- # try to load files that aren't shared libraries, because
- # on some systems (like SunOS) the loader will abort the
- # whole application when it gets an error.
+ # Try to load the file if it has the shared library extension,
+ # otherwise source it. It's important not to try to load
+ # files that aren't shared libraries, because on some systems
+ # (like SunOS) the loader will abort the whole application
+ # when it gets an error.
if {[::tcl::Pkg::CompareExtension $::tcl::file [info sharedlibextension]]} {
- # The "file join ." command below is necessary.
- # Without it, if the file name has no \'s and we're
- # on UNIX, the load command will invoke the
- # LD_LIBRARY_PATH search mechanism, which could cause
- # the wrong file to be used.
+ # The "file join ." command below is necessary. Without
+ # it, if the file name has no \'s and we're on UNIX, the
+ # load command will invoke the LD_LIBRARY_PATH search
+ # mechanism, which could cause the wrong file to be used.
set ::tcl::debug loading
load [file join $::tcl::dir $::tcl::file]
@@ -291,22 +295,21 @@ proc pkg_mkIndex {args} {
set ::tcl::type source
}
- # As a performance optimization, if we are creating
- # direct load packages, don't bother figuring out the
- # set of commands created by the new packages. We
- # only need that list for setting up the autoloading
- # used in the non-direct case.
- if { !$::tcl::direct } {
+ # As a performance optimization, if we are creating direct
+ # load packages, don't bother figuring out the set of commands
+ # created by the new packages. We only need that list for
+ # setting up the autoloading used in the non-direct case.
+ if {!$::tcl::direct} {
# See what new namespaces appeared, and import commands
# from them. Only exported commands go into the index.
-
+
foreach ::tcl::x [::tcl::GetAllNamespaces] {
- if {! [info exists ::tcl::namespaces($::tcl::x)]} {
+ if {![info exists ::tcl::namespaces($::tcl::x)]} {
namespace import -force ${::tcl::x}::*
}
# Figure out what commands appeared
-
+
foreach ::tcl::x [info commands] {
set ::tcl::newCmds($::tcl::x) 1
}
@@ -315,18 +318,19 @@ proc pkg_mkIndex {args} {
}
foreach ::tcl::x [array names ::tcl::newCmds] {
# determine which namespace a command comes from
-
+
set ::tcl::abs [namespace origin $::tcl::x]
-
- # special case so that global names have no leading
- # ::, this is required by the unknown command
-
+
+ # special case so that global names have no
+ # leading ::, this is required by the unknown
+ # command
+
set ::tcl::abs \
[lindex [auto_qualify $::tcl::abs ::] 0]
-
+
if {$::tcl::x ne $::tcl::abs} {
# Name changed during qualification
-
+
set ::tcl::newCmds($::tcl::abs) 1
unset ::tcl::newCmds($::tcl::x)
}
@@ -334,8 +338,8 @@ proc pkg_mkIndex {args} {
}
}
- # Look through the packages that appeared, and if there is
- # a version provided, then record it
+ # Look through the packages that appeared, and if there is a
+ # version provided, then record it
foreach ::tcl::x [package names] {
if {[package provide $::tcl::x] ne ""
@@ -345,12 +349,12 @@ proc pkg_mkIndex {args} {
}
}
}
- } msg] == 1} {
+ } on error msg {
set what [$c eval set ::tcl::debug]
if {$doVerbose} {
tclLog "warning: error while $what $file: $msg"
}
- } else {
+ } on ok {} {
set what [$c eval set ::tcl::debug]
if {$doVerbose} {
tclLog "successful $what of $file"
@@ -359,7 +363,7 @@ proc pkg_mkIndex {args} {
set cmds [lsort [$c eval array names ::tcl::newCmds]]
set pkgs [$c eval set ::tcl::newPkgs]
if {$doVerbose} {
- if { !$direct } {
+ if {!$direct} {
tclLog "commands provided were $cmds"
}
tclLog "packages provided were $pkgs"
@@ -391,13 +395,11 @@ proc pkg_mkIndex {args} {
foreach pkg [lsort [array names files]] {
set cmd {}
- foreach {name version} $pkg {
- break
- }
+ lassign $pkg name version
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 } {
+ if {$direct} {
set procs {}
}
lappend cmd "-$type" [list $file $procs]
@@ -412,11 +414,10 @@ proc pkg_mkIndex {args} {
}
# tclPkgSetup --
-# This is a utility procedure use by pkgIndex.tcl files. It is invoked
-# as part of a "package ifneeded" script. It calls "package provide"
-# to indicate that a package is available, then sets entries in the
-# auto_index array so that the package's files will be auto-loaded when
-# the commands are used.
+# This is a utility procedure use by pkgIndex.tcl files. It is invoked as
+# part of a "package ifneeded" script. It calls "package provide" to indicate
+# that a package is available, then sets entries in the auto_index array so
+# that the package's files will be auto-loaded when the commands are used.
#
# Arguments:
# dir - Directory containing all the files for this package.
@@ -441,36 +442,36 @@ proc tclPkgSetup {dir pkg version files} {
set auto_index($cmd) [list load [file join $dir $f] $pkg]
} else {
set auto_index($cmd) [list source [file join $dir $f]]
- }
+ }
}
}
}
# tclPkgUnknown --
-# This procedure provides the default for the "package unknown" function.
-# It is invoked when a package that's needed can't be found. It scans
-# the auto_path directories and their immediate children looking for
-# pkgIndex.tcl files and sources any such files that are found to setup
-# the package database. As it searches, it will recognize changes
-# to the auto_path and scan any new directories.
+# This procedure provides the default for the "package unknown" function. It
+# is invoked when a package that's needed can't be found. It scans the
+# auto_path directories and their immediate children looking for pkgIndex.tcl
+# files and sources any such files that are found to setup the package
+# database. As it searches, it will recognize changes to the auto_path and
+# scan any new directories.
#
# Arguments:
# name - Name of desired package. Not used.
# version - Version of desired package. Not used.
# exact - Either "-exact" or omitted. Not used.
-proc tclPkgUnknown {name version {exact {}}} {
+proc tclPkgUnknown {name args} {
global auto_path env
if {![info exists auto_path]} {
return
}
- # Cache the auto_path, because it may change while we run through
- # the first set of pkgIndex.tcl files
+ # Cache the auto_path, because it may change while we run through the
+ # first set of pkgIndex.tcl files
set old_path [set use_path $auto_path]
while {[llength $use_path]} {
set dir [lindex $use_path end]
-
+
# Make sure we only scan each directory one time.
if {[info exists tclSeenPath($dir)]} {
set use_path [lrange $use_path 0 end-1]
@@ -478,17 +479,22 @@ proc tclPkgUnknown {name version {exact {}}} {
}
set tclSeenPath($dir) 1
- # we can't use glob in safe interps, so enclose the following
- # in a catch statement, where we get the pkgIndex files out
- # of the subdirectories
+ # we can't use glob in safe interps, so enclose the following in a
+ # catch statement, where we get the pkgIndex files out of the
+ # subdirectories
catch {
foreach file [glob -directory $dir -join -nocomplain \
* pkgIndex.tcl] {
set dir [file dirname $file]
- if {![info exists procdDirs($dir)] && [file readable $file]} {
- if {[catch {source $file} msg]} {
+ if {![info exists procdDirs($dir)]} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
tclLog "error reading package index file $file: $msg"
- } else {
+ } on ok {} {
set procdDirs($dir) 1
}
}
@@ -497,12 +503,16 @@ proc tclPkgUnknown {name version {exact {}}} {
set dir [lindex $use_path end]
if {![info exists procdDirs($dir)]} {
set file [file join $dir pkgIndex.tcl]
- # safe interps usually don't have "file readable",
- # nor stderr channel
- if {([interp issafe] || [file readable $file])} {
- if {[catch {source $file} msg] && ![interp issafe]} {
+ # safe interps usually don't have "file exists",
+ if {([interp issafe] || [file exists $file])} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
tclLog "error reading package index file $file: $msg"
- } else {
+ } on ok {} {
set procdDirs($dir) 1
}
}
@@ -510,12 +520,11 @@ proc tclPkgUnknown {name version {exact {}}} {
set use_path [lrange $use_path 0 end-1]
- # Check whether any of the index scripts we [source]d above
- # set a new value for $::auto_path. If so, then find any
- # new directories on the $::auto_path, and lappend them to
- # the $use_path we are working from. This gives index scripts
- # the (arguably unwise) power to expand the index script search
- # path while the search is in progress.
+ # Check whether any of the index scripts we [source]d above set a new
+ # value for $::auto_path. If so, then find any new directories on the
+ # $::auto_path, and lappend them to the $use_path we are working from.
+ # This gives index scripts the (arguably unwise) power to expand the
+ # index script search path while the search is in progress.
set index 0
if {[llength $old_path] == [llength $auto_path]} {
foreach dir $auto_path old $old_path {
@@ -527,14 +536,13 @@ proc tclPkgUnknown {name version {exact {}}} {
}
}
- # $index now points to the first element of $auto_path that
- # has changed, or the beginning if $auto_path has changed length
- # Scan the new elements of $auto_path for directories to add to
- # $use_path. Don't add directories we've already seen, or ones
- # already on the $use_path.
+ # $index now points to the first element of $auto_path that has
+ # changed, or the beginning if $auto_path has changed length Scan the
+ # new elements of $auto_path for directories to add to $use_path.
+ # Don't add directories we've already seen, or ones already on the
+ # $use_path.
foreach dir [lrange $auto_path $index end] {
- if {![info exists tclSeenPath($dir)]
- && ([lsearch -exact $use_path $dir] == -1) } {
+ if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
lappend use_path $dir
}
}
@@ -543,11 +551,9 @@ proc tclPkgUnknown {name version {exact {}}} {
}
# tcl::MacOSXPkgUnknown --
-# This procedure extends the "package unknown" function for MacOSX.
-# It scans the Resources/Scripts directories of the immediate children
-# of the auto_path directories for pkgIndex files.
-# Only installed in interps that are not safe so we don't check
-# for [interp issafe] as in tclPkgUnknown.
+# This procedure extends the "package unknown" function for MacOSX. It scans
+# the Resources/Scripts directories of the immediate children of the auto_path
+# directories for pkgIndex files.
#
# Arguments:
# original - original [package unknown] procedure
@@ -555,10 +561,9 @@ proc tclPkgUnknown {name version {exact {}}} {
# version - Version of desired package. Not used.
# exact - Either "-exact" or omitted. Not used.
-proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
-
+proc tcl::MacOSXPkgUnknown {original name args} {
# First do the cross-platform default search
- uplevel 1 $original [list $name $version $exact]
+ uplevel 1 $original [linsert $args 0 $name]
# Now do MacOSX specific searching
global auto_path
@@ -566,8 +571,8 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
if {![info exists auto_path]} {
return
}
- # Cache the auto_path, because it may change while we run through
- # the first set of pkgIndex.tcl files
+ # Cache the auto_path, because it may change while we run through the
+ # first set of pkgIndex.tcl files
set old_path [set use_path $auto_path]
while {[llength $use_path]} {
set dir [lindex $use_path end]
@@ -583,22 +588,26 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
foreach file [glob -directory $dir -join -nocomplain \
* Resources Scripts pkgIndex.tcl] {
set dir [file dirname $file]
- if {![info exists procdDirs($dir)] && [file readable $file]} {
- if {[catch {source $file} msg]} {
+ if {![info exists procdDirs($dir)]} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
tclLog "error reading package index file $file: $msg"
- } else {
+ } on ok {} {
set procdDirs($dir) 1
}
}
}
set use_path [lrange $use_path 0 end-1]
- # Check whether any of the index scripts we [source]d above
- # set a new value for $::auto_path. If so, then find any
- # new directories on the $::auto_path, and lappend them to
- # the $use_path we are working from. This gives index scripts
- # the (arguably unwise) power to expand the index script search
- # path while the search is in progress.
+ # Check whether any of the index scripts we [source]d above set a new
+ # value for $::auto_path. If so, then find any new directories on the
+ # $::auto_path, and lappend them to the $use_path we are working from.
+ # This gives index scripts the (arguably unwise) power to expand the
+ # index script search path while the search is in progress.
set index 0
if {[llength $old_path] == [llength $auto_path]} {
foreach dir $auto_path old $old_path {
@@ -610,14 +619,13 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
}
}
- # $index now points to the first element of $auto_path that
- # has changed, or the beginning if $auto_path has changed length
- # Scan the new elements of $auto_path for directories to add to
- # $use_path. Don't add directories we've already seen, or ones
- # already on the $use_path.
+ # $index now points to the first element of $auto_path that has
+ # changed, or the beginning if $auto_path has changed length Scan the
+ # new elements of $auto_path for directories to add to $use_path.
+ # Don't add directories we've already seen, or ones already on the
+ # $use_path.
foreach dir [lrange $auto_path $index end] {
- if {![info exists tclSeenPath($dir)]
- && ([lsearch -exact $use_path $dir] == -1) } {
+ if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
lappend use_path $dir
}
}
@@ -641,12 +649,12 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
#
# Any number of -load and -source parameters may be
# specified, so long as there is at least one -load or
-# -source parameter. If the procs component of a
-# module specifier is left off, that module will be
-# set up for direct loading; otherwise, it will be
-# set up for lazy loading. If both -source and -load
-# are specified, the -load'ed files will be loaded
-# first, followed by the -source'd files.
+# -source parameter. If the procs component of a module
+# specifier is left off, that module will be set up for
+# direct loading; otherwise, it will be set up for lazy
+# loading. If both -source and -load are specified, the
+# -load'ed files will be loaded first, followed by the
+# -source'd files.
#
# Results:
# An appropriate "package ifneeded" statement for the package.
@@ -664,15 +672,12 @@ proc ::tcl::Pkg::Create {args} {
# process arguments
set len [llength $args]
- if { $len < 6 } {
+ if {$len < 6} {
error $err(wrongNumArgs)
}
-
+
# Initialize parameters
- set opts(-name) {}
- set opts(-version) {}
- set opts(-source) {}
- set opts(-load) {}
+ array set opts {-name {} -version {} -source {} -load {}}
# process parameters
for {set i 0} {$i < $len} {incr i} {
@@ -681,14 +686,14 @@ proc ::tcl::Pkg::Create {args} {
switch -glob -- $flag {
"-name" -
"-version" {
- if { $i >= $len } {
+ if {$i >= $len} {
error [format $err(valueMissing) $flag]
}
set opts($flag) [lindex $args $i]
}
"-source" -
"-load" {
- if { $i >= $len } {
+ if {$i >= $len} {
error [format $err(valueMissing) $flag]
}
lappend opts($flag) [lindex $args $i]
@@ -700,32 +705,27 @@ proc ::tcl::Pkg::Create {args} {
}
# Validate the parameters
- if { [llength $opts(-name)] == 0 } {
+ if {![llength $opts(-name)]} {
error [format $err(valueMissing) "-name"]
}
- if { [llength $opts(-version)] == 0 } {
+ if {![llength $opts(-version)]} {
error [format $err(valueMissing) "-version"]
}
-
- if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
+
+ if {!([llength $opts(-source)] || [llength $opts(-load)])} {
error $err(noLoadOrSource)
}
# OK, now everything is good. Generate the package ifneeded statment.
set cmdline "package ifneeded $opts(-name) $opts(-version) "
-
+
set cmdList {}
set lazyFileList {}
# Handle -load and -source specs
foreach key {load source} {
foreach filespec $opts(-$key) {
- foreach {filename proclist} {{} {}} {
- break
- }
- foreach {filename proclist} $filespec {
- break
- }
+ lassign $filespec filename proclist
if { [llength $proclist] == 0 } {
set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
@@ -736,7 +736,7 @@ proc ::tcl::Pkg::Create {args} {
}
}
- if { [llength $lazyFileList] > 0 } {
+ if {[llength $lazyFileList]} {
lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
$opts(-version) [list $lazyFileList]\]"
}
@@ -744,4 +744,4 @@ proc ::tcl::Pkg::Create {args} {
return $cmdline
}
-interp alias {} ::pkg::create {} ::tcl::Pkg::Create
+interp alias {} ::pkg::create {} ::tcl::Pkg::Create
diff --git a/library/parray.tcl b/library/parray.tcl
index e331d4d..a9c2cb1 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.
#
@@ -13,7 +11,7 @@
proc parray {a {pattern *}} {
upvar 1 $a array
if {![array exists array]} {
- error "\"$a\" isn't an array"
+ return -code error "\"$a\" isn't an array"
}
set maxl 0
set names [lsort [array names array $pattern]]
diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl
new file mode 100644
index 0000000..23a3408
--- /dev/null
+++ b/library/platform/pkgIndex.tcl
@@ -0,0 +1,3 @@
+package ifneeded platform 1.0.12 [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
new file mode 100644
index 0000000..5698425
--- /dev/null
+++ b/library/platform/platform.tcl
@@ -0,0 +1,387 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Overview
+
+# Heuristics to assemble a platform identifier from publicly available
+# information. The identifier describes the platform of the currently
+# running tcl shell. This is a mixture of the runtime environment and
+# of build-time properties of the executable itself.
+#
+# Examples:
+# <1> A tcl shell executing on a x86_64 processor, but having a
+# wordsize of 4 was compiled for the x86 environment, i.e. 32
+# bit, and loaded packages have to match that, and not the
+# actual cpu.
+#
+# <2> The hp/solaris 32/64 bit builds of the core cannot be
+# distinguished by looking at tcl_platform. As packages have to
+# match the 32/64 information we have to look in more places. In
+# this case we inspect the executable itself (magic numbers,
+# i.e. fileutil::magic::filetype).
+#
+# The basic information used comes out of the 'os' and 'machine'
+# entries of the 'tcl_platform' array. A number of general and
+# os/machine specific transformation are applied to get a canonical
+# result.
+#
+# General
+# Only the first element of 'os' is used - we don't care whether we
+# are on "Windows NT" or "Windows XP" or whatever.
+#
+# Machine specific
+# % arm* -> arm
+# % sun4* -> sparc
+# % intel -> ix86
+# % i*86* -> ix86
+# % Power* -> powerpc
+# % x86_64 + wordSize 4 => x86 code
+#
+# OS specific
+# % AIX are always powerpc machines
+# % HP-UX 9000/800 etc means parisc
+# % linux has to take glibc version into account
+# % sunos -> solaris, and keep version number
+#
+# NOTE: A platform like linux glibc 2.3, which can use glibc 2.2 stuff
+# has to provide all possible allowed platform identifiers when
+# searching search. Ditto a solaris 2.8 platform can use solaris 2.6
+# packages. Etc. This is handled by the other procedure, see below.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::platform {}
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+# -- platform::generic
+#
+# Assembles an identifier for the generic platform. It leaves out
+# details like kernel version, libc version, etc.
+
+proc ::platform::generic {} {
+ global tcl_platform
+
+ set plat [string tolower [lindex $tcl_platform(os) 0]]
+ set cpu $tcl_platform(machine)
+
+ switch -glob -- $cpu {
+ sun4* {
+ set cpu sparc
+ }
+ intel -
+ i*86* {
+ set cpu ix86
+ }
+ x86_64 {
+ if {$tcl_platform(wordSize) == 4} {
+ # See Example <1> at the top of this file.
+ set cpu ix86
+ }
+ }
+ "Power*" {
+ set cpu powerpc
+ }
+ "arm*" {
+ set cpu arm
+ }
+ ia64 {
+ if {$tcl_platform(wordSize) == 4} {
+ append cpu _32
+ }
+ }
+ }
+
+ switch -- $plat {
+ windows {
+ set plat win32
+ if {$cpu eq "amd64"} {
+ # Do not check wordSize, win32-x64 is an IL32P64 platform.
+ set cpu x86_64
+ }
+ }
+ sunos {
+ set plat solaris
+ if {[string match "ix86" $cpu]} {
+ if {$tcl_platform(wordSize) == 8} {
+ set cpu x86_64
+ }
+ } elseif {![string match "ia64*" $cpu]} {
+ # sparc
+ if {$tcl_platform(wordSize) == 8} {
+ append cpu 64
+ }
+ }
+ }
+ darwin {
+ set plat macosx
+ # Correctly identify the cpu when running as a 64bit
+ # process on a machine with a 32bit kernel
+ if {$cpu eq "ix86"} {
+ if {$tcl_platform(wordSize) == 8} {
+ set cpu x86_64
+ }
+ }
+ }
+ aix {
+ set cpu powerpc
+ if {$tcl_platform(wordSize) == 8} {
+ append cpu 64
+ }
+ }
+ hp-ux {
+ set plat hpux
+ if {![string match "ia64*" $cpu]} {
+ set cpu parisc
+ if {$tcl_platform(wordSize) == 8} {
+ append cpu 64
+ }
+ }
+ }
+ osf1 {
+ set plat tru64
+ }
+ }
+
+ return "${plat}-${cpu}"
+}
+
+# -- platform::identify
+#
+# Assembles an identifier for the exact platform, by extending the
+# generic identifier. I.e. it adds in details like kernel version,
+# libc version, etc., if they are relevant for the loading of
+# packages on the platform.
+
+proc ::platform::identify {} {
+ global tcl_platform
+
+ set id [generic]
+ regexp {^([^-]+)-([^-]+)$} $id -> plat cpu
+
+ switch -- $plat {
+ solaris {
+ regsub {^5} $tcl_platform(osVersion) 2 text
+ append plat $text
+ return "${plat}-${cpu}"
+ }
+ macosx {
+ set major [lindex [split $tcl_platform(osVersion) .] 0]
+ if {$major > 8} {
+ incr major -4
+ append plat 10.$major
+ return "${plat}-${cpu}"
+ }
+ }
+ linux {
+ # Look for the libc*.so and determine its version
+ # (libc5/6, libc6 further glibc 2.X)
+
+ set v unknown
+
+ # Determine in which directory to look. /lib, or /lib64.
+ # For that we use the tcl_platform(wordSize).
+ #
+ # We could use the 'cpu' info, per the equivalence below,
+ # that however would be restricted to intel. And this may
+ # be a arm, mips, etc. system. The wordsize is more
+ # fundamental.
+ #
+ # ix86 <=> (wordSize == 4) <=> 32 bit ==> /lib
+ # x86_64 <=> (wordSize == 8) <=> 64 bit ==> /lib64
+ #
+ # 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 {
+ 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 {
+ 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"
+ }
+ }
+
+ foreach base $bases {
+ if {[LibcVersion $base -> v]} break
+ }
+
+ append plat -$v
+ return "${plat}-${cpu}"
+ }
+ }
+
+ 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 {version ([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
+# identifier it assembles a list of exact platform identifier
+# describing platform which should be compatible with the
+# input.
+#
+# I.e. packages for all platforms in the result list should be
+# loadable on the specified platform.
+
+# << Should we add the generic identifier to the list as well ? In
+# general it is not compatible I believe. So better not. In many
+# cases the exact identifier is identical to the generic one
+# anyway.
+# >>
+
+proc ::platform::patterns {id} {
+ set res [list $id]
+ if {$id eq "tcl"} {return $res}
+
+ switch -glob -- $id {
+ solaris*-* {
+ if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {
+ if {$v eq ""} {return $id}
+ foreach {major minor} [split $v .] break
+ incr minor -1
+ for {set j $minor} {$j >= 6} {incr j -1} {
+ lappend res solaris${major}.${j}-${cpu}
+ }
+ }
+ }
+ linux*-* {
+ if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {
+ foreach {major minor} [split $v .] break
+ incr minor -1
+ for {set j $minor} {$j >= 0} {incr j -1} {
+ lappend res linux-glibc${major}.${j}-${cpu}
+ }
+ }
+ }
+ macosx*-* {
+ # 10.5+
+ if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
+
+ switch -exact -- $cpu {
+ ix86 -
+ x86_64 { set alt i386-x86_64 }
+ default { set alt {} }
+ }
+
+ if {$v ne ""} {
+ foreach {major minor} [split $v .] break
+
+ # Add 10.5 to 10.minor to patterns.
+ set res {}
+ for {set j $minor} {$j >= 5} {incr j -1} {
+ lappend res macosx${major}.${j}-${cpu}
+ lappend res macosx${major}.${j}-universal
+ if {$alt ne {}} {
+ lappend res macosx${major}.${j}-$alt
+ }
+ }
+
+ # Add unversioned patterns for 10.3/10.4 builds.
+ lappend res macosx-${cpu}
+ lappend res macosx-universal
+ if {$alt ne {}} {
+ lappend res macosx-$alt
+ }
+ } else {
+ lappend res macosx-universal
+ if {$alt ne {}} {
+ lappend res macosx-$alt
+ }
+ }
+ } else {
+ lappend res macosx-universal
+ }
+ }
+ macosx-powerpc {
+ lappend res macosx-universal
+ }
+ macosx-x86_64 -
+ macosx-ix86 {
+ lappend res macosx-universal macosx-i386-x86_64
+ }
+ }
+ lappend res tcl ; # Pure tcl packages are always compatible.
+ return $res
+}
+
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide platform 1.0.12
+
+# ### ### ### ######### ######### #########
+## Demo application
+
+if {[info exists argv0] && ($argv0 eq [info script])} {
+ puts ====================================
+ parray tcl_platform
+ puts ====================================
+ puts Generic\ identification:\ [::platform::generic]
+ puts Exact\ identification:\ \ \ [::platform::identify]
+ puts ====================================
+ puts Search\ patterns:
+ puts *\ [join [::platform::patterns [::platform::identify]] \n*\ ]
+ puts ====================================
+ exit 0
+}
diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl
new file mode 100644
index 0000000..d37cdcd
--- /dev/null
+++ b/library/platform/shell.tcl
@@ -0,0 +1,241 @@
+
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Overview
+
+# Higher-level commands which invoke the functionality of this package
+# for an arbitrary tcl shell (tclsh, wish, ...). This is required by a
+# repository as while the tcl shell executing packages uses the same
+# platform in general as a repository application there can be
+# differences in detail (i.e. 32/64 bit builds).
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require platform
+namespace eval ::platform::shell {}
+
+# ### ### ### ######### ######### #########
+## Implementation
+
+# -- platform::shell::generic
+
+proc ::platform::shell::generic {shell} {
+ # Argument is the path to a tcl shell.
+
+ CHECK $shell
+ LOCATE base out
+
+ set code {}
+ # Forget any pre-existing platform package, it might be in
+ # conflict with this one.
+ lappend code {package forget platform}
+ # Inject our platform package
+ lappend code [list source $base]
+ # Query and print the architecture
+ lappend code {puts [platform::generic]}
+ # And done
+ lappend code {exit 0}
+
+ set arch [RUN $shell [join $code \n]]
+
+ if {$out} {file delete -force $base}
+ return $arch
+}
+
+# -- platform::shell::identify
+
+proc ::platform::shell::identify {shell} {
+ # Argument is the path to a tcl shell.
+
+ CHECK $shell
+ LOCATE base out
+
+ set code {}
+ # Forget any pre-existing platform package, it might be in
+ # conflict with this one.
+ lappend code {package forget platform}
+ # Inject our platform package
+ lappend code [list source $base]
+ # Query and print the architecture
+ lappend code {puts [platform::identify]}
+ # And done
+ lappend code {exit 0}
+
+ set arch [RUN $shell [join $code \n]]
+
+ if {$out} {file delete -force $base}
+ return $arch
+}
+
+# -- platform::shell::platform
+
+proc ::platform::shell::platform {shell} {
+ # Argument is the path to a tcl shell.
+
+ CHECK $shell
+
+ set code {}
+ lappend code {puts $tcl_platform(platform)}
+ lappend code {exit 0}
+
+ return [RUN $shell [join $code \n]]
+}
+
+# ### ### ### ######### ######### #########
+## Internal helper commands.
+
+proc ::platform::shell::CHECK {shell} {
+ if {![file exists $shell]} {
+ return -code error "Shell \"$shell\" does not exist"
+ }
+ if {![file executable $shell]} {
+ return -code error "Shell \"$shell\" is not executable (permissions)"
+ }
+ return
+}
+
+proc ::platform::shell::LOCATE {bv ov} {
+ upvar 1 $bv base $ov out
+
+ # Locate the platform package for injection into the specified
+ # shell. We are using package management to find it, whereever it
+ # is, instead of using hardwired relative paths. This allows us to
+ # install the two packages as TMs without breaking the code
+ # here. If the found package is wrapped we copy the code somewhere
+ # where the spawned shell will be able to read it.
+
+ # This code is brittle, it needs has to adapt to whatever changes
+ # are made to the TM code, i.e. the provide statement generated by
+ # tm.tcl
+
+ set pl [package ifneeded platform [package require platform]]
+ set base [lindex $pl end]
+
+ set out 0
+ if {[lindex [file system $base]] ne "native"} {
+ set temp [TEMP]
+ file copy -force $base $temp
+ set base $temp
+ set out 1
+ }
+ return
+}
+
+proc ::platform::shell::RUN {shell code} {
+ set c [TEMP]
+ set cc [open $c w]
+ puts $cc $code
+ close $cc
+
+ set e [TEMP]
+
+ set code [catch {
+ exec $shell $c 2> $e
+ } res]
+
+ file delete $c
+
+ if {$code} {
+ append res \n[read [set chan [open $e r]]][close $chan]
+ file delete $e
+ return -code error "Shell \"$shell\" is not executable ($res)"
+ }
+
+ file delete $e
+ return $res
+}
+
+proc ::platform::shell::TEMP {} {
+ set prefix platform
+
+ # This code is copied out of Tcllib's fileutil package.
+ # (TempFile/tempfile)
+
+ set tmpdir [DIR]
+
+ set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
+ set nrand_chars 10
+ set maxtries 10
+ set access [list RDWR CREAT EXCL TRUNC]
+ set permission 0600
+ set channel ""
+ set checked_dir_writable 0
+ set mypid [pid]
+ for {set i 0} {$i < $maxtries} {incr i} {
+ set newname $prefix
+ for {set j 0} {$j < $nrand_chars} {incr j} {
+ append newname [string index $chars \
+ [expr {int(rand()*62)}]]
+ }
+ set newname [file join $tmpdir $newname]
+ if {[file exists $newname]} {
+ after 1
+ } else {
+ if {[catch {open $newname $access $permission} channel]} {
+ if {!$checked_dir_writable} {
+ set dirname [file dirname $newname]
+ if {![file writable $dirname]} {
+ return -code error "Directory $dirname is not writable"
+ }
+ set checked_dir_writable 1
+ }
+ } else {
+ # Success
+ close $channel
+ return [file normalize $newname]
+ }
+ }
+ }
+ if {$channel != ""} {
+ return -code error "Failed to open a temporary file: $channel"
+ } else {
+ return -code error "Failed to find an unused temporary file name"
+ }
+}
+
+proc ::platform::shell::DIR {} {
+ # This code is copied out of Tcllib's fileutil package.
+ # (TempDir/tempdir)
+
+ global tcl_platform env
+
+ set attempdirs [list]
+
+ foreach tmp {TMPDIR TEMP TMP} {
+ if { [info exists env($tmp)] } {
+ lappend attempdirs $env($tmp)
+ }
+ }
+
+ switch $tcl_platform(platform) {
+ windows {
+ lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
+ }
+ macintosh {
+ set tmpdir $env(TRASH_FOLDER) ;# a better place?
+ }
+ default {
+ lappend attempdirs \
+ [file join / tmp] \
+ [file join / var tmp] \
+ [file join / usr tmp]
+ }
+ }
+
+ lappend attempdirs [pwd]
+
+ foreach tmp $attempdirs {
+ if { [file isdirectory $tmp] && [file writable $tmp] } {
+ return [file normalize $tmp]
+ }
+ }
+
+ # Fail if nothing worked.
+ return -code error "Unable to determine a proper directory for temporary files"
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide platform::shell 1.1.4
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 3aed06f..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.1.5 \
- [list load [file join $dir tclreg11g.dll] registry]
+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.1.5 \
- [list load [file join $dir tclreg11.dll] registry]
+ 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 61246e8..394aa97 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -4,906 +4,1130 @@
# It implements a virtual path mecanism to hide the real pathnames from the
# slave. It runs in a master interpreter and sets up data structure and
# aliases that will be invoked when used from a slave interpreter.
-#
+#
# See the safe.n man page for details.
#
# Copyright (c) 1996-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: safe.tcl,v 1.15 2005/07/23 04:12:49 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# The implementation is based on namespaces. These naming conventions
-# are followed:
+# The implementation is based on namespaces. These naming conventions are
+# followed:
# Private procs starts with uppercase.
# Public procs are exported and starts with lowercase
#
# Needed utilities package
-package require opt 0.4.1;
+package require opt 0.4.1
# Create the safe namespace
namespace eval ::safe {
-
# Exported API:
namespace export interpCreate interpInit interpConfigure interpDelete \
- interpAddToAccessPath interpFindInAccessPath setLogCmd
-
- ####
- #
- # Setup the arguments parsing
- #
- ####
-
- # Make sure that our temporary variable is local to this
- # namespace. [Bug 981733]
- variable temp
-
- # Share the descriptions
- set temp [::tcl::OptKeyRegister {
- {-accessPath -list {} "access path for the slave"}
- {-noStatics "prevent loading of statically linked pkgs"}
- {-statics true "loading of statically linked pkgs"}
- {-nestedLoadOk "allow nested loading"}
- {-nested false "nested loading"}
- {-deleteHook -script {} "delete hook"}
- }]
-
- # create case (slave is optional)
- ::tcl::OptKeyRegister {
- {?slave? -name {} "name of the slave (optional)"}
- } ::safe::interpCreate
- # adding the flags sub programs to the command program
- # (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
-
- # init and configure (slave is needed)
- ::tcl::OptKeyRegister {
- {slave -name {} "name of the slave"}
- } ::safe::interpIC
- # adding the flags sub programs to the command program
- # (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)
- # temp not needed anymore
- ::tcl::OptKeyDelete $temp
-
+ interpAddToAccessPath interpFindInAccessPath setLogCmd
+}
- # Helper function to resolve the dual way of specifying staticsok
- # (either by -noStatics or -statics 0)
- proc InterpStatics {} {
- foreach v {Args statics noStatics} {
- upvar $v $v
- }
- set flag [::tcl::OptProcArgGiven -noStatics];
- if {$flag && (!$noStatics == !$statics)
- && ([::tcl::OptProcArgGiven -statics])} {
- return -code error\
- "conflicting values given for -statics and -noStatics"
- }
- if {$flag} {
- return [expr {!$noStatics}]
- } else {
- return $statics
- }
+# Helper function to resolve the dual way of specifying staticsok (either
+# by -noStatics or -statics 0)
+proc ::safe::InterpStatics {} {
+ foreach v {Args statics noStatics} {
+ upvar $v $v
+ }
+ set flag [::tcl::OptProcArgGiven -noStatics]
+ if {$flag && (!$noStatics == !$statics)
+ && ([::tcl::OptProcArgGiven -statics])} {
+ return -code error\
+ "conflicting values given for -statics and -noStatics"
}
+ if {$flag} {
+ return [expr {!$noStatics}]
+ } else {
+ return $statics
+ }
+}
- # Helper function to resolve the dual way of specifying nested loading
- # (either by -nestedLoadOk or -nested 1)
- proc InterpNested {} {
- foreach v {Args nested nestedLoadOk} {
- upvar $v $v
- }
- set flag [::tcl::OptProcArgGiven -nestedLoadOk];
- # note that the test here is the opposite of the "InterpStatics"
- # one (it is not -noNested... because of the wanted default value)
- if {$flag && (!$nestedLoadOk != !$nested)
- && ([::tcl::OptProcArgGiven -nested])} {
- return -code error\
- "conflicting values given for -nested and -nestedLoadOk"
- }
- if {$flag} {
- # another difference with "InterpStatics"
- return $nestedLoadOk
- } else {
- return $nested
- }
+# Helper function to resolve the dual way of specifying nested loading
+# (either by -nestedLoadOk or -nested 1)
+proc ::safe::InterpNested {} {
+ foreach v {Args nested nestedLoadOk} {
+ upvar $v $v
+ }
+ set flag [::tcl::OptProcArgGiven -nestedLoadOk]
+ # note that the test here is the opposite of the "InterpStatics" one
+ # (it is not -noNested... because of the wanted default value)
+ if {$flag && (!$nestedLoadOk != !$nested)
+ && ([::tcl::OptProcArgGiven -nested])} {
+ return -code error\
+ "conflicting values given for -nested and -nestedLoadOk"
+ }
+ if {$flag} {
+ # another difference with "InterpStatics"
+ return $nestedLoadOk
+ } else {
+ return $nested
}
+}
- ####
- #
- # API entry points that needs argument parsing :
- #
- ####
+####
+#
+# API entry points that needs argument parsing :
+#
+####
+# Interface/entry point function and front end for "Create"
+proc ::safe::interpCreate {args} {
+ set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
+ InterpCreate $slave $accessPath \
+ [InterpStatics] [InterpNested] $deleteHook
+}
- # Interface/entry point function and front end for "Create"
- proc interpCreate {args} {
- set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
- InterpCreate $slave $accessPath \
- [InterpStatics] [InterpNested] $deleteHook
+proc ::safe::interpInit {args} {
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ if {![::interp exists $slave]} {
+ return -code error "\"$slave\" is not an interpreter"
}
+ InterpInit $slave $accessPath \
+ [InterpStatics] [InterpNested] $deleteHook
+}
- proc interpInit {args} {
- set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- if {![::interp exists $slave]} {
- return -code error "\"$slave\" is not an interpreter"
- }
- InterpInit $slave $accessPath \
- [InterpStatics] [InterpNested] $deleteHook;
+# Check that the given slave is "one of us"
+proc ::safe::CheckInterp {slave} {
+ namespace upvar ::safe S$slave state
+ if {![info exists state] || ![::interp exists $slave]} {
+ return -code error \
+ "\"$slave\" is not an interpreter managed by ::safe::"
}
+}
- proc CheckInterp {slave} {
- if {![IsInterp $slave]} {
- return -code error \
- "\"$slave\" is not an interpreter managed by ::safe::"
+# Interface/entry point function and front end for "Configure". This code
+# is awfully pedestrian because it would need more coupling and support
+# between the way we store the configuration values in safe::interp's and
+# the Opt package. Obviously we would like an OptConfigure to avoid
+# duplicating all this code everywhere.
+# -> TODO (the app should share or access easily the program/value stored
+# by opt)
+
+# This is even more complicated by the boolean flags with no values that
+# we had the bad idea to support for the sake of user simplicity in
+# create/init but which makes life hard in configure...
+# So this will be hopefully written and some integrated with opt1.0
+# (hopefully for tcl8.1 ?)
+proc ::safe::interpConfigure {args} {
+ switch [llength $args] {
+ 1 {
+ # If we have exactly 1 argument the semantic is to return all
+ # the current configuration. We still call OptKeyParse though
+ # we know that "slave" is our given argument because it also
+ # checks for the "-help" option.
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
+ namespace upvar ::safe S$slave state
+
+ return [join [list \
+ [list -accessPath $state(access_path)] \
+ [list -statics $state(staticsok)] \
+ [list -nested $state(nestedok)] \
+ [list -deleteHook $state(cleanupHook)]]]
}
- }
-
- # Interface/entry point function and front end for "Configure"
- # This code is awfully pedestrian because it would need
- # more coupling and support between the way we store the
- # configuration values in safe::interp's and the Opt package
- # Obviously we would like an OptConfigure
- # to avoid duplicating all this code everywhere. -> TODO
- # (the app should share or access easily the program/value
- # stored by opt)
- # This is even more complicated by the boolean flags with no values
- # that we had the bad idea to support for the sake of user simplicity
- # in create/init but which makes life hard in configure...
- # So this will be hopefully written and some integrated with opt1.0
- # (hopefully for tcl8.1 ?)
- proc interpConfigure {args} {
- switch [llength $args] {
- 1 {
- # If we have exactly 1 argument
- # the semantic is to return all the current configuration
- # We still call OptKeyParse though we know that "slave"
- # is our given argument because it also checks
- # for the "-help" option.
- set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- CheckInterp $slave
- set res {}
- lappend res [list -accessPath [Set [PathListName $slave]]]
- lappend res [list -statics [Set [StaticsOkName $slave]]]
- lappend res [list -nested [Set [NestedOkName $slave]]]
- lappend res [list -deleteHook [Set [DeleteHookName $slave]]]
- join $res
+ 2 {
+ # If we have exactly 2 arguments the semantic is a "configure
+ # get"
+ lassign $args slave arg
+
+ # get the flag sub program (we 'know' about Opt's internal
+ # representation of data)
+ set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
+ set hits [::tcl::OptHits desc $arg]
+ if {$hits > 1} {
+ return -code error [::tcl::OptAmbigous $desc $arg]
+ } elseif {$hits == 0} {
+ return -code error [::tcl::OptFlagUsage $desc $arg]
}
- 2 {
- # If we have exactly 2 arguments
- # the semantic is a "configure get"
- ::tcl::Lassign $args slave arg
- # get the flag sub program (we 'know' about Opt's internal
- # representation of data)
- set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
- set hits [::tcl::OptHits desc $arg]
- if {$hits > 1} {
- return -code error [::tcl::OptAmbigous $desc $arg]
- } elseif {$hits == 0} {
- return -code error [::tcl::OptFlagUsage $desc $arg]
- }
- CheckInterp $slave
- set item [::tcl::OptCurDesc $desc]
- set name [::tcl::OptName $item]
- switch -exact -- $name {
- -accessPath {
- return [list -accessPath [Set [PathListName $slave]]]
- }
- -statics {
- return [list -statics [Set [StaticsOkName $slave]]]
- }
- -nested {
- return [list -nested [Set [NestedOkName $slave]]]
- }
- -deleteHook {
- return [list -deleteHook [Set [DeleteHookName $slave]]]
- }
- -noStatics {
- # it is most probably a set in fact
- # but we would need then to jump to the set part
- # and it is not *sure* that it is a set action
- # that the user want, so force it to use the
- # unambigous -statics ?value? instead:
- return -code error\
- "ambigous query (get or set -noStatics ?)\
- use -statics instead"
- }
- -nestedLoadOk {
- return -code error\
- "ambigous query (get or set -nestedLoadOk ?)\
- use -nested instead"
- }
- default {
- return -code error "unknown flag $name (bug)"
- }
+ CheckInterp $slave
+ namespace upvar ::safe S$slave state
+
+ set item [::tcl::OptCurDesc $desc]
+ set name [::tcl::OptName $item]
+ switch -exact -- $name {
+ -accessPath {
+ return [list -accessPath $state(access_path)]
}
- }
- default {
- # Otherwise we want to parse the arguments like init and create
- # did
- set Args [::tcl::OptKeyParse ::safe::interpIC $args]
- CheckInterp $slave
- # Get the current (and not the default) values of
- # whatever has not been given:
- if {![::tcl::OptProcArgGiven -accessPath]} {
- set doreset 1
- set accessPath [Set [PathListName $slave]]
- } else {
- set doreset 0
+ -statics {
+ return [list -statics $state(staticsok)]
}
- if {(![::tcl::OptProcArgGiven -statics]) \
- && (![::tcl::OptProcArgGiven -noStatics]) } {
- set statics [Set [StaticsOkName $slave]]
- } else {
- set statics [InterpStatics]
+ -nested {
+ return [list -nested $state(nestedok)]
}
- if {([::tcl::OptProcArgGiven -nested]) \
- || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
- set nested [InterpNested]
- } else {
- set nested [Set [NestedOkName $slave]]
+ -deleteHook {
+ return [list -deleteHook $state(cleanupHook)]
}
- if {![::tcl::OptProcArgGiven -deleteHook]} {
- set deleteHook [Set [DeleteHookName $slave]]
+ -noStatics {
+ # it is most probably a set in fact but we would need
+ # then to jump to the set part and it is not *sure*
+ # that it is a set action that the user want, so force
+ # it to use the unambigous -statics ?value? instead:
+ return -code error\
+ "ambigous query (get or set -noStatics ?)\
+ use -statics instead"
}
- # we can now reconfigure :
- InterpSetConfig $slave $accessPath $statics $nested $deleteHook
- # auto_reset the slave (to completly synch the new access_path)
- if {$doreset} {
- if {[catch {::interp eval $slave {auto_reset}} msg]} {
- Log $slave "auto_reset failed: $msg"
- } else {
- Log $slave "successful auto_reset" NOTICE
- }
+ -nestedLoadOk {
+ return -code error\
+ "ambigous query (get or set -nestedLoadOk ?)\
+ use -nested instead"
+ }
+ default {
+ return -code error "unknown flag $name (bug)"
+ }
+ }
+ }
+ default {
+ # Otherwise we want to parse the arguments like init and
+ # create did
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
+ namespace upvar ::safe S$slave state
+
+ # Get the current (and not the default) values of whatever has
+ # not been given:
+ if {![::tcl::OptProcArgGiven -accessPath]} {
+ set doreset 1
+ set accessPath $state(access_path)
+ } else {
+ set doreset 0
+ }
+ if {
+ ![::tcl::OptProcArgGiven -statics]
+ && ![::tcl::OptProcArgGiven -noStatics]
+ } then {
+ set statics $state(staticsok)
+ } else {
+ set statics [InterpStatics]
+ }
+ if {
+ [::tcl::OptProcArgGiven -nested] ||
+ [::tcl::OptProcArgGiven -nestedLoadOk]
+ } then {
+ set nested [InterpNested]
+ } else {
+ set nested $state(nestedok)
+ }
+ if {![::tcl::OptProcArgGiven -deleteHook]} {
+ set deleteHook $state(cleanupHook)
+ }
+ # we can now reconfigure :
+ InterpSetConfig $slave $accessPath $statics $nested $deleteHook
+ # auto_reset the slave (to completly synch the new access_path)
+ if {$doreset} {
+ if {[catch {::interp eval $slave {auto_reset}} msg]} {
+ Log $slave "auto_reset failed: $msg"
+ } else {
+ Log $slave "successful auto_reset" NOTICE
}
}
}
}
+}
+####
+#
+# Functions that actually implements the exported APIs
+#
+####
- ####
- #
- # Functions that actually implements the exported APIs
- #
- ####
-
-
- #
- # safe::InterpCreate : doing the real job
- #
- # This procedure creates a safe slave and initializes it with the
- # safe base aliases.
- # NB: slave name must be simple alphanumeric string, no spaces,
- # no (), no {},... {because the state array is stored as part of the name}
- #
- # Returns the slave name.
- #
- # Optional Arguments :
- # + slave name : if empty, generated name will be used
- # + access_path: path list controlling where load/source can occur,
- # if empty: the master auto_path will be used.
- # + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx)
- # if 1 :static packages are ok.
- # + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
- # if 1 : multiple levels are ok.
-
- # use the full name and no indent so auto_mkIndex can find us
- proc ::safe::InterpCreate {
- slave
- access_path
- staticsok
- nestedok
- deletehook
- } {
- # Create the slave.
- if {$slave ne ""} {
- ::interp create -safe $slave
- } else {
- # empty argument: generate slave name
- set slave [::interp create -safe]
- }
- Log $slave "Created" NOTICE
-
- # Initialize it. (returns slave name)
- InterpInit $slave $access_path $staticsok $nestedok $deletehook
+#
+# safe::InterpCreate : doing the real job
+#
+# This procedure creates a safe slave and initializes it with the safe
+# base aliases.
+# NB: slave name must be simple alphanumeric string, no spaces, no (), no
+# {},... {because the state array is stored as part of the name}
+#
+# Returns the slave name.
+#
+# Optional Arguments :
+# + slave name : if empty, generated name will be used
+# + access_path: path list controlling where load/source can occur,
+# if empty: the master auto_path will be used.
+# + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx)
+# if 1 :static packages are ok.
+# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
+# if 1 : multiple levels are ok.
+
+# use the full name and no indent so auto_mkIndex can find us
+proc ::safe::InterpCreate {
+ slave
+ access_path
+ staticsok
+ nestedok
+ deletehook
+ } {
+ # Create the slave.
+ if {$slave ne ""} {
+ ::interp create -safe $slave
+ } else {
+ # empty argument: generate slave name
+ set slave [::interp create -safe]
}
+ Log $slave "Created" NOTICE
+ # Initialize it. (returns slave name)
+ InterpInit $slave $access_path $staticsok $nestedok $deletehook
+}
- #
- # InterpSetConfig (was setAccessPath) :
- # Sets up slave virtual auto_path and corresponding structure
- # within the master. Also sets the tcl_library in the slave
- # to be the first directory in the path.
- # Nb: If you change the path after the slave has been initialized
- # you probably need to call "auto_reset" in the slave in order that it
- # gets the right auto_index() array values.
-
- proc ::safe::InterpSetConfig {slave access_path staticsok\
- nestedok deletehook} {
-
- # determine and store the access path if empty
- if {$access_path eq ""} {
- set access_path [uplevel \#0 set auto_path]
- # Make sure that tcl_library is in auto_path
- # and at the first position (needed by setAccessPath)
- set where [lsearch -exact $access_path [info library]]
- if {$where == -1} {
- # not found, add it.
- set access_path [concat [list [info library]] $access_path]
- Log $slave "tcl_library was not in auto_path,\
+#
+# InterpSetConfig (was setAccessPath) :
+# Sets up slave virtual auto_path and corresponding structure within
+# the master. Also sets the tcl_library in the slave to be the first
+# directory in the path.
+# NB: If you change the path after the slave has been initialized you
+# probably need to call "auto_reset" in the slave in order that it gets
+# the right auto_index() array values.
+
+proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
+ global auto_path
+
+ # determine and store the access path if empty
+ if {$access_path eq ""} {
+ set access_path $auto_path
+
+ # Make sure that tcl_library is in auto_path and at the first
+ # position (needed by setAccessPath)
+ set where [lsearch -exact $access_path [info library]]
+ if {$where == -1} {
+ # not found, add it.
+ set access_path [linsert $access_path 0 [info library]]
+ Log $slave "tcl_library was not in auto_path,\
added it to slave's access_path" NOTICE
- } elseif {$where != 0} {
- # not first, move it first
- set access_path [concat [list [info library]]\
- [lreplace $access_path $where $where]]
- Log $slave "tcl_libray was not in first in auto_path,\
+ } elseif {$where != 0} {
+ # not first, move it first
+ set access_path [linsert \
+ [lreplace $access_path $where $where] \
+ 0 [info library]]
+ Log $slave "tcl_libray was not in first in auto_path,\
moved it to front of slave's access_path" NOTICE
-
- }
-
- # Add 1st level sub dirs (will searched by auto loading from tcl
- # code in the slave using glob and thus fail, so we add them
- # here so by default it works the same).
- set access_path [AddSubDirs $access_path]
}
- Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
+ # Add 1st level sub dirs (will searched by auto loading from tcl
+ # code in the slave using glob and thus fail, so we add them here
+ # so by default it works the same).
+ set access_path [AddSubDirs $access_path]
+ }
+
+ Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
nestedok=$nestedok deletehook=($deletehook)" NOTICE
- # clear old autopath if it existed
- set nname [PathNumberName $slave]
- if {[Exists $nname]} {
- set n [Set $nname]
- for {set i 0} {$i<$n} {incr i} {
- Unset [PathToken $i $slave]
- }
- }
+ namespace upvar ::safe S$slave state
+
+ # clear old autopath if it existed
+ # build new one
+ # Extend the access list with the paths used to look for Tcl Modules.
+ # We save the virtual form separately as well, as syncing it with the
+ # slave has to be defered until the necessary commands are present for
+ # setup.
+
+ set norm_access_path {}
+ set slave_access_path {}
+ set map_access_path {}
+ set remap_access_path {}
+ set slave_tm_path {}
+
+ set i 0
+ foreach dir $access_path {
+ set token [PathToken $i]
+ lappend slave_access_path $token
+ lappend map_access_path $token $dir
+ lappend remap_access_path $dir $token
+ lappend norm_access_path [file normalize $dir]
+ incr i
+ }
- # build new one
- set slave_auto_path {}
- set i 0
- foreach dir $access_path {
- Set [PathToken $i $slave] $dir
- lappend slave_auto_path "\$[PathToken $i]"
- incr i
- }
- Set $nname $i
- Set [PathListName $slave] $access_path
- Set [VirtualPathListName $slave] $slave_auto_path
+ set morepaths [::tcl::tm::list]
+ while {[llength $morepaths]} {
+ set addpaths $morepaths
+ set morepaths {}
- Set [StaticsOkName $slave] $staticsok
- Set [NestedOkName $slave] $nestedok
- Set [DeleteHookName $slave] $deletehook
+ foreach dir $addpaths {
+ # Prevent the addition of dirs on the tm list to the
+ # result if they are already known.
+ if {[dict exists $remap_access_path $dir]} {
+ continue
+ }
- SyncAccessPath $slave
- }
+ set token [PathToken $i]
+ lappend access_path $dir
+ lappend slave_access_path $token
+ lappend map_access_path $token $dir
+ lappend remap_access_path $dir $token
+ lappend norm_access_path [file normalize $dir]
+ lappend slave_tm_path $token
+ incr i
- #
- #
- # FindInAccessPath:
- # Search for a real directory and returns its virtual Id
- # (including the "$")
-proc ::safe::interpFindInAccessPath {slave path} {
- set access_path [GetAccessPath $slave]
- set where [lsearch -exact $access_path $path]
- if {$where == -1} {
- return -code error "$path not found in access path $access_path"
+ # [Bug 2854929]
+ # Recursively find deeper paths which may contain
+ # modules. Required to handle modules with names like
+ # 'platform::shell', which translate into
+ # 'platform/shell-X.tm', i.e arbitrarily deep
+ # subdirectories.
+ lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
}
- return "\$[PathToken $where]"
}
- #
- # addToAccessPath:
- # add (if needed) a real directory to access path
- # and return its virtual token (including the "$").
-proc ::safe::interpAddToAccessPath {slave path} {
- # first check if the directory is already in there
- if {![catch {interpFindInAccessPath $slave $path} res]} {
- return $res
- }
- # new one, add it:
- set nname [PathNumberName $slave]
- set n [Set $nname]
- Set [PathToken $n $slave] $path
-
- set token "\$[PathToken $n]"
-
- Lappend [VirtualPathListName $slave] $token
- Lappend [PathListName $slave] $path
- Set $nname [expr {$n+1}]
+ set state(access_path) $access_path
+ set state(access_path,map) $map_access_path
+ set state(access_path,remap) $remap_access_path
+ set state(access_path,norm) $norm_access_path
+ set state(access_path,slave) $slave_access_path
+ set state(tm_path_slave) $slave_tm_path
+ set state(staticsok) $staticsok
+ set state(nestedok) $nestedok
+ set state(cleanupHook) $deletehook
+
+ SyncAccessPath $slave
+}
- SyncAccessPath $slave
+#
+#
+# FindInAccessPath:
+# Search for a real directory and returns its virtual Id (including the
+# "$")
+proc ::safe::interpFindInAccessPath {slave path} {
+ namespace upvar ::safe S$slave state
- return $token
+ if {![dict exists $state(access_path,remap) $path]} {
+ return -code error "$path not found in access path $access_path"
}
- # This procedure applies the initializations to an already existing
- # interpreter. It is useful when you want to install the safe base
- # aliases into a preexisting safe interpreter.
- proc ::safe::InterpInit {
- slave
- access_path
- staticsok
- nestedok
- deletehook
- } {
-
- # Configure will generate an access_path when access_path is
- # empty.
- InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
+ return [dict get $state(access_path,remap) $path]
+}
- # These aliases let the slave load files to define new commands
+#
+# addToAccessPath:
+# add (if needed) a real directory to access path and return its
+# virtual token (including the "$").
+proc ::safe::interpAddToAccessPath {slave path} {
+ # first check if the directory is already in there
+ # (inlined interpFindInAccessPath).
+ namespace upvar ::safe S$slave state
- # NB we need to add [namespace current], aliases are always
- # absolute paths.
- ::interp alias $slave source {} [namespace current]::AliasSource $slave
- ::interp alias $slave load {} [namespace current]::AliasLoad $slave
+ if {[dict exists $state(access_path,remap) $path]} {
+ return [dict get $state(access_path,remap) $path]
+ }
- # This alias lets the slave use the encoding names, convertfrom,
- # convertto, and system, but not "encoding system <name>" to set
- # the system encoding.
+ # new one, add it:
+ set token [PathToken [llength $state(access_path)]]
- ::interp alias $slave encoding {} [namespace current]::AliasEncoding \
- $slave
+ lappend state(access_path) $path
+ lappend state(access_path,slave) $token
+ lappend state(access_path,map) $token $path
+ lappend state(access_path,remap) $path $token
+ lappend state(access_path,norm) [file normalize $path]
- # This alias lets the slave have access to a subset of the 'file'
- # command functionality.
+ SyncAccessPath $slave
+ return $token
+}
- AliasSubset $slave file file dir.* join root.* ext.* tail \
- path.* split
+# This procedure applies the initializations to an already existing
+# interpreter. It is useful when you want to install the safe base aliases
+# into a preexisting safe interpreter.
+proc ::safe::InterpInit {
+ slave
+ access_path
+ staticsok
+ nestedok
+ deletehook
+ } {
+ # Configure will generate an access_path when access_path is empty.
+ InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
+
+ # NB we need to add [namespace current], aliases are always absolute
+ # paths.
+
+ # These aliases let the slave load files to define new commands
+ # This alias lets the slave use the encoding names, convertfrom,
+ # convertto, and system, but not "encoding system <name>" to set the
+ # system encoding.
+ # Handling Tcl Modules, we need a restricted form of Glob.
+ # This alias interposes on the 'exit' command and cleanly terminates
+ # the slave.
+
+ foreach {command alias} {
+ source AliasSource
+ load AliasLoad
+ encoding AliasEncoding
+ exit interpDelete
+ glob AliasGlob
+ } {
+ ::interp alias $slave $command {} [namespace current]::$alias $slave
+ }
- # This alias interposes on the 'exit' command and cleanly terminates
- # the slave.
+ # This alias lets the slave have access to a subset of the 'file'
+ # command functionality.
- ::interp alias $slave exit {} [namespace current]::interpDelete $slave
+ ::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
+ }
- # The allowed slave variables already have been set
- # by Tcl_MakeSafe(3)
+ # Subcommands of info
+ foreach {subcommand alias} {
+ nameofexecutable AliasExeName
+ } {
+ ::interp alias $slave ::tcl::info::$subcommand \
+ {} [namespace current]::$alias $slave
+ }
+ # The allowed slave variables already have been set by Tcl_MakeSafe(3)
- # Source init.tcl into the slave, to get auto_load and other
- # procedures defined:
+ # Source init.tcl and tm.tcl into the slave, to get auto_load and
+ # other procedures defined:
- if {[catch {::interp eval $slave\
- {source [file join $tcl_library init.tcl]}} msg]} {
- Log $slave "can't source init.tcl ($msg)"
- error "can't source init.tcl into slave $slave ($msg)"
- }
+ if {[catch {::interp eval $slave {
+ source [file join $tcl_library init.tcl]
+ }} msg opt]} {
+ Log $slave "can't source init.tcl ($msg)"
+ return -options $opt "can't source init.tcl into slave $slave ($msg)"
+ }
- return $slave
+ if {[catch {::interp eval $slave {
+ source [file join $tcl_library tm.tcl]
+ }} msg opt]} {
+ Log $slave "can't source tm.tcl ($msg)"
+ return -options $opt "can't source tm.tcl into slave $slave ($msg)"
}
+ # Sync the paths used to search for Tcl modules. This can be done only
+ # now, after tm.tcl was loaded.
+ namespace upvar ::safe S$slave state
+ if {[llength $state(tm_path_slave)] > 0} {
+ ::interp eval $slave [list \
+ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
+ }
+ return $slave
+}
- # Add (only if needed, avoid duplicates) 1 level of
- # sub directories to an existing path list.
- # Also removes non directories from the returned list.
- proc AddSubDirs {pathList} {
- set res {}
- foreach dir $pathList {
- if {[file isdirectory $dir]} {
- # check that we don't have it yet as a children
- # of a previous dir
- if {[lsearch -exact $res $dir]<0} {
- lappend res $dir
- }
- foreach sub [glob -directory $dir -nocomplain *] {
- if {([file isdirectory $sub]) \
- && ([lsearch -exact $res $sub]<0) } {
- # new sub dir, add it !
- lappend res $sub
- }
+# Add (only if needed, avoid duplicates) 1 level of sub directories to an
+# existing path list. Also removes non directories from the returned
+# list.
+proc ::safe::AddSubDirs {pathList} {
+ set res {}
+ foreach dir $pathList {
+ if {[file isdirectory $dir]} {
+ # check that we don't have it yet as a children of a previous
+ # dir
+ if {$dir ni $res} {
+ lappend res $dir
+ }
+ foreach sub [glob -directory $dir -nocomplain *] {
+ if {[file isdirectory $sub] && ($sub ni $res)} {
+ # new sub dir, add it !
+ lappend res $sub
}
}
}
- return $res
}
+ return $res
+}
- # This procedure deletes a safe slave managed by Safe Tcl and
- # cleans up associated state:
+# This procedure deletes a safe slave managed by Safe Tcl and cleans up
+# associated state:
proc ::safe::interpDelete {slave} {
-
- Log $slave "About to delete" NOTICE
-
- # If the slave has a cleanup hook registered, call it.
- # check the existance because we might be called to delete an interp
- # which has not been registered with us at all
- set hookname [DeleteHookName $slave]
- if {[Exists $hookname]} {
- set hook [Set $hookname]
- if {![::tcl::Lempty $hook]} {
- # remove the hook now, otherwise if the hook
- # calls us somehow, we'll loop
- Unset $hookname
- if {[catch {{expand}$hook $slave} err]} {
- Log $slave "Delete hook error ($err)"
- }
+ Log $slave "About to delete" NOTICE
+
+ namespace upvar ::safe S$slave state
+
+ # If the slave has a cleanup hook registered, call it. Check the
+ # existance because we might be called to delete an interp which has
+ # not been registered with us at all
+
+ if {[info exists state(cleanupHook)]} {
+ set hook $state(cleanupHook)
+ if {[llength $hook]} {
+ # remove the hook now, otherwise if the hook calls us somehow,
+ # we'll loop
+ unset state(cleanupHook)
+ try {
+ {*}$hook $slave
+ } on error err {
+ Log $slave "Delete hook error ($err)"
}
}
+ }
- # Discard the global array of state associated with the slave, and
- # delete the interpreter.
-
- set statename [InterpStateName $slave]
- if {[Exists $statename]} {
- Unset $statename
- }
+ # Discard the global array of state associated with the slave, and
+ # delete the interpreter.
- # if we have been called twice, the interp might have been deleted
- # already
- if {[::interp exists $slave]} {
- ::interp delete $slave
- Log $slave "Deleted" NOTICE
- }
+ if {[info exists state]} {
+ unset state
+ }
- return
+ # if we have been called twice, the interp might have been deleted
+ # already
+ if {[::interp exists $slave]} {
+ ::interp delete $slave
+ Log $slave "Deleted" NOTICE
}
- # Set (or get) the loging mecanism
+ return
+}
+
+# Set (or get) the logging mecanism
proc ::safe::setLogCmd {args} {
variable Log
- if {[llength $args] == 0} {
+ set la [llength $args]
+ if {$la == 0} {
return $Log
+ } elseif {$la == 1} {
+ set Log [lindex $args 0]
+ } else {
+ set Log $args
+ }
+
+ if {$Log eq ""} {
+ # Disable logging completely. Calls to it will be compiled out
+ # of all users.
+ proc ::safe::Log {args} {}
} else {
- if {[llength $args] == 1} {
- set Log [lindex $args 0]
- } else {
- set Log $args
+ # Activate logging, define proper command.
+
+ proc ::safe::Log {slave msg {type ERROR}} {
+ variable Log
+ {*}$Log "$type for slave $slave : $msg"
+ return
}
}
}
- # internal variable
- variable Log {}
+# ------------------- END OF PUBLIC METHODS ------------
- # ------------------- END OF PUBLIC METHODS ------------
+#
+# Sets the slave auto_path to the master recorded value. Also sets
+# tcl_library to the first token of the virtual path.
+#
+proc ::safe::SyncAccessPath {slave} {
+ namespace upvar ::safe S$slave state
+ set slave_access_path $state(access_path,slave)
+ ::interp eval $slave [list set auto_path $slave_access_path]
- #
- # sets the slave auto_path to the master recorded value.
- # also sets tcl_library to the first token of the virtual path.
- #
- proc SyncAccessPath {slave} {
- set slave_auto_path [Set [VirtualPathListName $slave]]
- ::interp eval $slave [list set auto_path $slave_auto_path]
- Log $slave "auto_path in $slave has been set to $slave_auto_path"\
- NOTICE
- ::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]
- }
-
- # base name for storing all the slave states
- # the array variable name for slave foo is thus "Sfoo"
- # and for sub slave {foo bar} "Sfoo bar" (spaces are handled
- # ok everywhere (or should))
- # We add the S prefix to avoid that a slave interp called "Log"
- # would smash our "Log" variable.
- proc InterpStateName {slave} {
- return "S$slave"
- }
-
- # Check that the given slave is "one of us"
- proc IsInterp {slave} {
- expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}
- }
-
- # returns the virtual token for directory number N
- # if the slave argument is given,
- # it will return the corresponding master global variable name
- proc PathToken {n {slave ""}} {
- if {$slave ne ""} {
- return "[InterpStateName $slave](access_path,$n)"
- } else {
- # We need to have a ":" in the token string so
- # [file join] on the mac won't turn it into a relative
- # path.
- return "p(:$n:)"
- }
- }
- # returns the variable name of the complete path list
- proc PathListName {slave} {
- return "[InterpStateName $slave](access_path)"
- }
- # returns the variable name of the complete path list
- proc VirtualPathListName {slave} {
- return "[InterpStateName $slave](access_path_slave)"
- }
- # returns the variable name of the number of items
- proc PathNumberName {slave} {
- return "[InterpStateName $slave](access_path,n)"
+ Log $slave "auto_path in $slave has been set to $slave_access_path"\
+ NOTICE
+
+ # This code assumes that info library is the first element in the
+ # list of auto_path's. See -> InterpSetConfig for the code which
+ # ensures this condition.
+
+ ::interp eval $slave [list \
+ set tcl_library [lindex $slave_access_path 0]]
+}
+
+# Returns the virtual token for directory number N.
+proc ::safe::PathToken {n} {
+ # We need to have a ":" in the token string so [file join] on the
+ # mac won't turn it into a relative path.
+ return "\$p(:$n:)" ;# Form tested by case 7.2
+}
+
+#
+# translate virtual path into real path
+#
+proc ::safe::TranslatePath {slave path} {
+ namespace upvar ::safe S$slave state
+
+ # somehow strip the namespaces 'functionality' out (the danger is that
+ # we would strip valid macintosh "../" queries... :
+ if {[string match "*::*" $path] || [string match "*..*" $path]} {
+ return -code error "invalid characters in path $path"
}
- # returns the staticsok flag var name
- proc StaticsOkName {slave} {
- return "[InterpStateName $slave](staticsok)"
+
+ # Use a cached map instead of computed local vars and subst.
+
+ return [string map $state(access_path,map) $path]
+}
+
+# file name control (limit access to files/resources that should be a
+# valid tcl source file)
+proc ::safe::CheckFileName {slave file} {
+ # This used to limit what can be sourced to ".tcl" and forbid files
+ # with more than 1 dot and longer than 14 chars, but I changed that
+ # for 8.4 as a safe interp has enough internal protection already to
+ # allow sourcing anything. - hobbs
+
+ if {![file exists $file]} {
+ # don't tell the file path
+ return -code error "no such file or directory"
}
- # returns the nestedok flag var name
- proc NestedOkName {slave} {
- return "[InterpStateName $slave](nestedok)"
+
+ if {![file readable $file]} {
+ # don't tell the file path
+ return -code error "not readable"
}
- # Run some code at the namespace toplevel
- proc Toplevel {args} {
- namespace eval [namespace current] $args
+}
+
+# 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
}
- # set/get values
- proc Set {args} {
- Toplevel set {expand}$args
+ tailcall ::interp invokehidden $slave tcl:file:$subcommand $name
+}
+
+# AliasGlob is the target of the "glob" alias in safe interpreters.
+
+proc ::safe::AliasGlob {slave args} {
+ Log $slave "GLOB ! $args" NOTICE
+ set cmd {}
+ set at 0
+ array set got {
+ -directory 0
+ -nocomplain 0
+ -join 0
+ -tails 0
+ -- 0
}
- # lappend on toplevel vars
- proc Lappend {args} {
- Toplevel lappend {expand}$args
+
+ if {$::tcl_platform(platform) eq "windows"} {
+ set dirPartRE {^(.*)[\\/]([^\\/]*)$}
+ } else {
+ set dirPartRE {^(.*)/([^/]*)$}
}
- # unset a var/token (currently just an global level eval)
- proc Unset {args} {
- Toplevel unset {expand}$args
+
+ set dir {}
+ set virtualdir {}
+
+ while {$at < [llength $args]} {
+ switch -glob -- [set opt [lindex $args $at]] {
+ -nocomplain - -- - -join - -tails {
+ lappend cmd $opt
+ set got($opt) 1
+ incr at
+ }
+ -types - -type {
+ lappend cmd -types [lindex $args [incr at]]
+ incr at
+ }
+ -directory {
+ if {$got($opt)} {
+ return -code error \
+ {"-directory" cannot be used with "-path"}
+ }
+ set got($opt) 1
+ set virtualdir [lindex $args [incr at]]
+ incr at
+ }
+ pkgIndex.tcl {
+ # Oops, this is globbing a subdirectory in regular package
+ # search. That is not wanted. Abort, handler does catch
+ # already (because glob was not defined before). See
+ # package.tcl, lines 484ff in tclPkgUnknown.
+ return -code error "unknown command glob"
+ }
+ -* {
+ Log $slave "Safe base rejecting glob option '$opt'"
+ return -code error "Safe base rejecting glob option '$opt'"
+ }
+ default {
+ break
+ }
+ }
+ if {$got(--)} break
}
- # test existance
- proc Exists {varname} {
- Toplevel info exists $varname
+
+ # Get the real path from the virtual one and check that the path is in the
+ # access path of that slave. Done after basic argument processing so that
+ # we know if -nocomplain is set.
+ if {$got(-directory)} {
+ try {
+ set dir [TranslatePath $slave $virtualdir]
+ DirInAccessPath $slave $dir
+ } on error msg {
+ Log $slave $msg
+ if {$got(-nocomplain)} return
+ return -code error "permission denied"
+ }
+ lappend cmd -directory $dir
}
- # short cut for access path getting
- proc GetAccessPath {slave} {
- Set [PathListName $slave]
+
+ # Apply the -join semantics ourselves
+ if {$got(-join)} {
+ set args [lreplace $args $at end [join [lrange $args $at end] "/"]]
}
- # short cut for statics ok flag getting
- proc StaticsOk {slave} {
- Set [StaticsOkName $slave]
+
+ # Process remaining pattern arguments
+ set firstPattern [llength $cmd]
+ foreach opt [lrange $args $at end] {
+ if {![regexp $dirPartRE $opt -> thedir thefile]} {
+ set thedir .
+ } elseif {[string match ~* $thedir]} {
+ set thedir ./$thedir
+ }
+ 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
+ }
+ }
+ 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
}
- # short cut for getting the multiples interps sub loading ok flag
- proc NestedOk {slave} {
- Set [NestedOkName $slave]
+
+ Log $slave "GLOB = $cmd" NOTICE
+
+ if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
+ return
}
- # interp deletion storing hook name
- proc DeleteHookName {slave} {
- return [InterpStateName $slave](cleanupHook)
+ try {
+ set entries [::interp invokehidden $slave glob {*}$cmd]
+ } on error msg {
+ Log $slave $msg
+ return -code error "script error"
}
- #
- # translate virtual path into real path
- #
- proc TranslatePath {slave path} {
- # somehow strip the namespaces 'functionality' out (the danger
- # is that we would strip valid macintosh "../" queries... :
- if {[string match "*::*" $path] || [string match "*..*" $path]} {
- error "invalid characters in path $path"
- }
- set n [expr {[Set [PathNumberName $slave]]-1}]
- for {} {$n>=0} {incr n -1} {
- # fill the token virtual names with their real value
- set [PathToken $n] [Set [PathToken $n $slave]]
+ Log $slave "GLOB < $entries" NOTICE
+
+ # Translate path back to what the slave should see.
+ set res {}
+ set l [string length $dir]
+ foreach p $entries {
+ if {[string equal -length $l $dir $p]} {
+ set p [string replace $p 0 [expr {$l-1}] $virtualdir]
}
- # replaces the token by their value
- subst -nobackslashes -nocommands $path
+ lappend res $p
}
+ Log $slave "GLOB > $res" NOTICE
+ return $res
+}
- # Log eventually log an error
- # to enable error logging, set Log to {puts stderr} for instance
- proc Log {slave msg {type ERROR}} {
- variable Log
- if {[info exists Log] && [llength $Log]} {
- {expand}$Log "$type for slave $slave : $msg"
+# AliasSource is the target of the "source" alias in safe interpreters.
+
+proc ::safe::AliasSource {slave args} {
+ set argc [llength $args]
+ # Extended for handling of Tcl Modules to allow not only "source
+ # filename", but "source -encoding E filename" as well.
+ if {[lindex $args 0] eq "-encoding"} {
+ incr argc -2
+ set encoding [lindex $args 1]
+ set at 2
+ if {$encoding eq "identity"} {
+ Log $slave "attempt to use the identity encoding"
+ return -code error "permission denied"
}
+ } else {
+ set at 0
+ set encoding {}
+ }
+ if {$argc != 1} {
+ set msg "wrong # args: should be \"source ?-encoding E? fileName\""
+ Log $slave "$msg ($args)"
+ return -code error $msg
+ }
+ set file [lindex $args $at]
+
+ # get the real path from the virtual one.
+ if {[catch {
+ set realfile [TranslatePath $slave $file]
+ } msg]} {
+ Log $slave $msg
+ return -code error "permission denied"
+ }
+
+ # check that the path is in the access path of that slave
+ if {[catch {
+ FileInAccessPath $slave $realfile
+ } msg]} {
+ Log $slave $msg
+ return -code error "permission denied"
}
+ # do the checks on the filename :
+ if {[catch {
+ CheckFileName $slave $realfile
+ } msg]} {
+ Log $slave "$realfile:$msg"
+ return -code error $msg
+ }
- # file name control (limit access to files/ressources that should be
- # a valid tcl source file)
- proc CheckFileName {slave file} {
- # This used to limit what can be sourced to ".tcl" and forbid files
- # with more than 1 dot and longer than 14 chars, but I changed that
- # for 8.4 as a safe interp has enough internal protection already
- # to allow sourcing anything. - hobbs
-
- if {![file exists $file]} {
- # don't tell the file path
- error "no such file or directory"
+ # Passed all the tests, lets source it. Note that we do this all manually
+ # because we want to control [info script] in the slave so information
+ # 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
+ if {$encoding ne ""} {
+ fconfigure $f -encoding $encoding
}
+ set contents [read $f]
+ close $f
+ ::interp eval $slave [list info script $file]
+ } 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 $replacementMsg
+ }
+ return -code $code -options $opt $msg
+}
- if {![file readable $file]} {
- # don't tell the file path
- error "not readable"
- }
+# AliasLoad is the target of the "load" alias in safe interpreters.
+
+proc ::safe::AliasLoad {slave file args} {
+ set argc [llength $args]
+ if {$argc > 2} {
+ set msg "load error: too many arguments"
+ Log $slave "$msg ($argc) {$file $args}"
+ return -code error $msg
}
+ # package name (can be empty if file is not).
+ set package [lindex $args 0]
- # AliasSource is the target of the "source" alias in safe interpreters.
+ namespace upvar ::safe S$slave state
- proc AliasSource {slave args} {
+ # Determine where to load. load use a relative interp path and {}
+ # means self, so we can directly and safely use passed arg.
+ set target [lindex $args 1]
+ if {$target ne ""} {
+ # we will try to load into a sub sub interp; check that we want to
+ # authorize that.
+ if {!$state(nestedok)} {
+ Log $slave "loading to a sub interp (nestedok)\
+ disabled (trying to load $package to $target)"
+ return -code error "permission denied (nested load)"
+ }
+ }
- set argc [llength $args]
- # Allow only "source filename"
- if {$argc != 1} {
- set msg "wrong # args: should be \"source fileName\""
- Log $slave "$msg ($args)"
+ # Determine what kind of load is requested
+ if {$file eq ""} {
+ # static package loading
+ if {$package eq ""} {
+ set msg "load error: empty filename and no package name"
+ Log $slave $msg
return -code error $msg
}
- set file [lindex $args 0]
-
- # get the real path from the virtual one.
- if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg
- return -code error "permission denied"
+ if {!$state(staticsok)} {
+ Log $slave "static packages loading disabled\
+ (trying to load $package to $target)"
+ return -code error "permission denied (static package)"
}
-
- # check that the path is in the access path of that slave
- if {[catch {FileInAccessPath $slave $file} msg]} {
+ } else {
+ # file loading
+
+ # get the real path from the virtual one.
+ try {
+ set file [TranslatePath $slave $file]
+ } on error msg {
Log $slave $msg
return -code error "permission denied"
}
- # do the checks on the filename :
- if {[catch {CheckFileName $slave $file} msg]} {
- Log $slave "$file:$msg"
- return -code error $msg
- }
-
- # passed all the tests , lets source it:
- if {[catch {::interp invokehidden $slave source $file} msg]} {
+ # check the translated path
+ try {
+ FileInAccessPath $slave $file
+ } on error msg {
Log $slave $msg
- return -code error "script error"
+ return -code error "permission denied (path)"
}
- return $msg
}
- # AliasLoad is the target of the "load" alias in safe interpreters.
-
- proc AliasLoad {slave file args} {
+ try {
+ return [::interp invokehidden $slave load $file $package $target]
+ } on error msg {
+ Log $slave $msg
+ return -code error $msg
+ }
+}
- set argc [llength $args]
- if {$argc > 2} {
- set msg "load error: too many arguments"
- Log $slave "$msg ($argc) {$file $args}"
- return -code error $msg
- }
+# FileInAccessPath raises an error if the file is not found in the list of
+# directories contained in the (master side recorded) slave's access path.
- # package name (can be empty if file is not).
- set package [lindex $args 0]
-
- # Determine where to load. load use a relative interp path
- # and {} means self, so we can directly and safely use passed arg.
- set target [lindex $args 1]
- if {$target ne ""} {
- # we will try to load into a sub sub interp
- # check that we want to authorize that.
- if {![NestedOk $slave]} {
- Log $slave "loading to a sub interp (nestedok)\
- disabled (trying to load $package to $target)"
- return -code error "permission denied (nested load)"
- }
-
- }
+# the security here relies on "file dirname" answering the proper
+# result... needs checking ?
+proc ::safe::FileInAccessPath {slave file} {
+ namespace upvar ::safe S$slave state
+ set access_path $state(access_path)
- # Determine what kind of load is requested
- if {$file eq ""} {
- # static package loading
- if {$package eq ""} {
- set msg "load error: empty filename and no package name"
- Log $slave $msg
- return -code error $msg
- }
- if {![StaticsOk $slave]} {
- Log $slave "static packages loading disabled\
- (trying to load $package to $target)"
- return -code error "permission denied (static package)"
- }
- } else {
- # file loading
+ if {[file isdirectory $file]} {
+ return -code error "\"$file\": is a directory"
+ }
+ set parent [file dirname $file]
- # get the real path from the virtual one.
- if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg
- return -code error "permission denied"
- }
+ # Normalize paths for comparison since lsearch knows nothing of
+ # potential pathname anomalies.
+ set norm_parent [file normalize $parent]
- # check the translated path
- if {[catch {FileInAccessPath $slave $file} msg]} {
- Log $slave $msg
- return -code error "permission denied (path)"
- }
- }
+ namespace upvar ::safe S$slave state
+ if {$norm_parent ni $state(access_path,norm)} {
+ return -code error "\"$file\": not in access_path"
+ }
+}
- if {[catch {::interp invokehidden\
- $slave load $file $package $target} msg]} {
- Log $slave $msg
- return -code error $msg
- }
+proc ::safe::DirInAccessPath {slave dir} {
+ namespace upvar ::safe S$slave state
+ set access_path $state(access_path)
- return $msg
+ if {[file isfile $dir]} {
+ return -code error "\"$dir\": is a file"
}
- # FileInAccessPath raises an error if the file is not found in
- # the list of directories contained in the (master side recorded) slave's
- # access path.
-
- # the security here relies on "file dirname" answering the proper
- # result.... needs checking ?
- proc FileInAccessPath {slave file} {
+ # Normalize paths for comparison since lsearch knows nothing of
+ # potential pathname anomalies.
+ set norm_dir [file normalize $dir]
- set access_path [GetAccessPath $slave]
+ namespace upvar ::safe S$slave state
+ if {$norm_dir ni $state(access_path,norm)} {
+ return -code error "\"$dir\": not in access_path"
+ }
+}
- if {[file isdirectory $file]} {
- error "\"$file\": is a directory"
- }
- set parent [file dirname $file]
+# This procedure is used to report an attempt to use an unsafe member of an
+# ensemble command.
- # Normalize paths for comparison since lsearch knows nothing of
- # potential pathname anomalies.
- set norm_parent [file normalize $parent]
- foreach path $access_path {
- lappend norm_access_path [file normalize $path]
- }
+proc ::safe::BadSubcommand {slave command subcommand args} {
+ set msg "not allowed to invoke subcommand $subcommand of $command"
+ Log $slave $msg
+ return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
+}
- if {[lsearch -exact $norm_access_path $norm_parent] == -1} {
- error "\"$file\": not in access_path"
+# AliasEncoding is the target of the "encoding" alias in safe interpreters.
+
+proc ::safe::AliasEncoding {slave option args} {
+ # 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\""
}
+ } on error {msg options} {
+ Log $slave $msg
+ return -options $options $msg
}
+ tailcall ::interp invokehidden $slave encoding $option {*}$args
+}
- # This procedure enables access from a safe interpreter to only a subset of
- # the subcommands of a command:
+# Various minor hiding of platform features. [Bug 2913625]
- proc Subset {slave command okpat args} {
- set subcommand [lindex $args 0]
- if {[regexp $okpat $subcommand]} {
- return [$command {expand}$args]
- }
- set msg "not allowed to invoke subcommand $subcommand of $command"
- Log $slave $msg
- error $msg
- }
+proc ::safe::AliasExeName {slave} {
+ return ""
+}
- # 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.
+proc ::safe::Setup {} {
+ ####
+ #
+ # Setup the arguments parsing
#
- # Syntax is: AliasSubset slave alias target subcommand1 subcommand2...
+ ####
- proc AliasSubset {slave alias target args} {
- set pat ^(; set sep ""
- foreach sub $args {
- append pat $sep$sub
- set sep |
- }
- append pat )\$
- ::interp alias $slave $alias {}\
- [namespace current]::Subset $slave $target $pat
- }
+ # Share the descriptions
+ set temp [::tcl::OptKeyRegister {
+ {-accessPath -list {} "access path for the slave"}
+ {-noStatics "prevent loading of statically linked pkgs"}
+ {-statics true "loading of statically linked pkgs"}
+ {-nestedLoadOk "allow nested loading"}
+ {-nested false "nested loading"}
+ {-deleteHook -script {} "delete hook"}
+ }]
- # AliasEncoding is the target of the "encoding" alias in safe interpreters.
+ # create case (slave is optional)
+ ::tcl::OptKeyRegister {
+ {?slave? -name {} "name of the slave (optional)"}
+ } ::safe::interpCreate
- proc AliasEncoding {slave args} {
+ # adding the flags sub programs to the command program (relying on Opt's
+ # internal implementation details)
+ lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
- set argc [llength $args]
+ # init and configure (slave is needed)
+ ::tcl::OptKeyRegister {
+ {slave -name {} "name of the slave"}
+ } ::safe::interpIC
- set okpat "^(name.*|convert.*)\$"
- set subcommand [lindex $args 0]
+ # adding the flags sub programs to the command program (relying on Opt's
+ # internal implementation details)
+ lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)
- if {[regexp $okpat $subcommand]} {
- return [::interp invokehidden $slave encoding {expand}$args]
- }
+ # temp not needed anymore
+ ::tcl::OptKeyDelete $temp
- if {[string first $subcommand system] == 0} {
- if {$argc == 1} {
- # passed all the tests , lets source it:
- if {[catch {::interp invokehidden \
- $slave encoding system} msg]} {
- Log $slave $msg
- return -code error "script error"
- }
- } else {
- set msg "wrong # args: should be \"encoding system\""
- Log $slave $msg
- error $msg
- }
- } else {
- set msg "wrong # args: should be \"encoding option ?arg ...?\""
- Log $slave $msg
- error $msg
- }
+ ####
+ #
+ # Default: No logging.
+ #
+ ####
- return $msg
- }
+ setLogCmd {}
+
+ # Log eventually.
+ # To enable error logging, set Log to {puts stderr} for instance,
+ # via setLogCmd.
+ return
+}
+
+namespace eval ::safe {
+ # internal variables
+ # Log command, set via 'setLogCmd'. Logging is disabled when empty.
+ variable Log {}
+
+ # The package maintains a state array per slave interp under its
+ # control. The name of this array is S<interp-name>. This array is
+ # brought into scope where needed, using 'namespace upvar'. The S
+ # prefix is used to avoid that a slave interp called "Log" smashes
+ # the "Log" variable.
+ #
+ # The array's elements are:
+ #
+ # access_path : List of paths accessible to the slave.
+ # access_path,norm : Ditto, in normalized form.
+ # access_path,slave : Ditto, as the path tokens as seen by the slave.
+ # access_path,map : dict ( token -> path )
+ # access_path,remap : dict ( path -> token )
+ # tm_path_slave : List of TM root directories, as tokens seen by the slave.
+ # staticsok : Value of option -statics
+ # nestedok : Value of option -nested
+ # cleanupHook : Value of option -deleteHook
}
+
+::safe::Setup
diff --git a/library/tclIndex b/library/tclIndex
index 3a435d1..26603c1 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -1,4 +1,5 @@
# Tcl autoload index file, version 2.0
+# -*- tcl -*-
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands. Typically each line is a command that
@@ -27,7 +28,6 @@ set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]
-set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
@@ -49,29 +49,15 @@ set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]
set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]
set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]
set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]
set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]]
@@ -83,5 +69,7 @@ set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]
set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]]
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 1aa4a46..c99ad2a 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -8,5 +8,5 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded tcltest 2.2.8 [list source [file join $dir tcltest.tcl]]
+if {![package vsatisfies [package provide Tcl] 8.5]} {return}
+package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 0e7f549..4b94312 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -15,16 +15,14 @@
# 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.95 2005/05/10 18:34:54 kennykb Exp $
-package require Tcl 8.3 ;# uses [glob -directory]
+package require Tcl 8.5 ;# -verbose line uses [info frame]
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.2.8
+ variable Version 2.3.7
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -86,7 +84,7 @@ namespace eval tcltest {
# None.
#
proc normalizePath {pathVar} {
- upvar $pathVar path
+ upvar 1 $pathVar path
set oldpwd [pwd]
catch {cd $path}
set path [pwd]
@@ -249,15 +247,15 @@ namespace eval tcltest {
# Kept only for compatibility
Default constraintsSpecified {} AcceptList
- trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \
- [array names ::tcltest::testConstraints] ;# }
+ trace add variable constraintsSpecified read [namespace code {
+ set constraintsSpecified [array names testConstraints] ;#}]
# tests that use threads need to know which is the main thread
Default mainThread 1
variable mainThread
- if {[info commands thread::id] != {}} {
+ if {[info commands thread::id] ne {}} {
set mainThread [thread::id]
- } elseif {[info commands testthread] != {}} {
+ } elseif {[info commands testthread] ne {}} {
set mainThread [testthread id]
}
@@ -265,7 +263,7 @@ namespace eval tcltest {
# Tcl tests is the working directory. Whenever this value changes
# change to that directory.
variable workingDirectory
- trace variable workingDirectory w \
+ trace add variable workingDirectory write \
[namespace code {cd $workingDirectory ;#}]
Default workingDirectory [pwd] AcceptAbsolutePath
@@ -279,7 +277,7 @@ namespace eval tcltest {
# Set the location of the execuatble
Default tcltest [info nameofexecutable]
- trace variable tcltest w [namespace code {testConstraint stdio \
+ trace add variable tcltest write [namespace code {testConstraint stdio \
[eval [ConstraintInitializer stdio]] ;#}]
# save the platform information so it can be restored later
@@ -406,11 +404,11 @@ namespace eval tcltest {
# already there.
set outdir [normalizePath [file dirname \
[file join [pwd] $filename]]]
- if {[string equal $outdir [temporaryDirectory]]} {
+ if {$outdir eq [temporaryDirectory]} {
variable filesExisted
FillFilesExisted
set filename [file tail $filename]
- if {[lsearch -exact $filesExisted $filename] == -1} {
+ if {$filename ni $filesExisted} {
lappend filesExisted $filename
}
}
@@ -450,11 +448,11 @@ namespace eval tcltest {
# already there.
set outdir [normalizePath [file dirname \
[file join [pwd] $filename]]]
- if {[string equal $outdir [temporaryDirectory]]} {
+ if {$outdir eq [temporaryDirectory]} {
variable filesExisted
FillFilesExisted
set filename [file tail $filename]
- if {[lsearch -exact $filesExisted $filename] == -1} {
+ if {$filename ni $filesExisted} {
lappend filesExisted $filename
}
}
@@ -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 {
@@ -534,7 +534,7 @@ namespace eval tcltest {
}
default {
# Exact match trumps ambiguity
- if {[lsearch -exact $match $option] >= 0} {
+ if {$option in $match} {
return $option
}
set values [join [lrange $match 0 end-1] ", "]
@@ -549,7 +549,8 @@ namespace eval tcltest {
variable OptionControlledVariables
foreach varName [concat $OptionControlledVariables Option] {
variable $varName
- trace variable $varName r [namespace code {ProcessCmdLineArgs ;#}]
+ trace add variable $varName read [namespace code {
+ ProcessCmdLineArgs ;#}]
}
}
@@ -557,11 +558,11 @@ namespace eval tcltest {
variable OptionControlledVariables
foreach varName [concat $OptionControlledVariables Option] {
variable $varName
- foreach pair [trace vinfo $varName] {
- foreach {op cmd} $pair break
- if {[string equal r $op]
- && [string match *ProcessCmdLineArgs* $cmd]} {
- trace vdelete $varName $op $cmd
+ foreach pair [trace info variable $varName] {
+ lassign $pair op cmd
+ if {($op eq "read") &&
+ [string match *ProcessCmdLineArgs* $cmd]} {
+ trace remove variable $varName $op $cmd
}
}
}
@@ -601,23 +602,25 @@ namespace eval tcltest {
}
}
proc configure args {
- RemoveAutoConfigureTraces
- set code [catch {eval Configure $args} msg]
+ if {[llength $args] > 1} {
+ RemoveAutoConfigureTraces
+ }
+ set code [catch {Configure {*}$args} msg]
return -code $code $msg
}
proc AcceptVerbose { level } {
set level [AcceptList $level]
if {[llength $level] == 1} {
- if {![regexp {^(pass|body|skip|start|error)$} $level]} {
+ if {![regexp {^(pass|body|skip|start|error|line)$} $level]} {
# translate single characters abbreviations to expanded list
- set level [string map {p pass b body s skip t start e error} \
+ set level [string map {p pass b body s skip t start e error l line} \
[split $level {}]]
}
}
set valid [list]
foreach v $level {
- if {[regexp {^(pass|body|skip|start|error)$} $v]} {
+ if {[regexp {^(pass|body|skip|start|error|line)$} $v]} {
lappend valid $v
}
}
@@ -631,11 +634,12 @@ namespace eval tcltest {
# Default verbosity is to show bodies of failed tests
Option -verbose {body error} {
- Takes any combination of the values 'p', 's', 'b', 't' and 'e'.
+ Takes any combination of the values 'p', 's', 'b', 't', 'e' and 'l'.
Test suite will display all passed tests if 'p' is specified, all
skipped tests if 's' is specified, the bodies of failed tests if
'b' is specified, and when tests start if 't' is specified.
- ErrorInfo is displayed if 'e' is specified.
+ ErrorInfo is displayed if 'e' is specified. Source file line
+ information of failed tests is displayed if 'l' is specified.
} AcceptVerbose verbose
# Match and skip patterns default to the empty list, except for
@@ -695,7 +699,7 @@ namespace eval tcltest {
Option -constraints {} {
Do not skip the listed constraints listed in -constraints.
} AcceptList
- trace variable Option(-constraints) w \
+ trace add variable Option(-constraints) write \
[namespace code {SetSelectedConstraints ;#}]
# Don't run only the "-constraint" specified tests by default
@@ -704,15 +708,15 @@ namespace eval tcltest {
variable testConstraints
if {!$Option(-limitconstraints)} {return}
foreach c [array names testConstraints] {
- if {[lsearch -exact $Option(-constraints) $c] == -1} {
+ if {$c ni $Option(-constraints)} {
testConstraint $c 0
}
}
}
- Option -limitconstraints false {
+ Option -limitconstraints 0 {
whether to run only tests with the constraints
} AcceptBoolean limitConstraints
- trace variable Option(-limitconstraints) w \
+ trace add variable Option(-limitconstraints) write \
[namespace code {ClearUnselectedConstraints ;#}]
# A test application has to know how to load the tested commands
@@ -733,7 +737,7 @@ namespace eval tcltest {
}
set directory [AcceptDirectory $directory]
if {![file writable $directory]} {
- if {[string equal [workingDirectory] $directory]} {
+ if {[workingDirectory] eq $directory} {
# Special exception: accept the default value
# even if the directory is not writable
return $directory
@@ -747,7 +751,7 @@ namespace eval tcltest {
Option -tmpdir [workingDirectory] {
Save temporary files in the specified directory.
} AcceptTemporaryDirectory temporaryDirectory
- trace variable Option(-tmpdir) w \
+ trace add variable Option(-tmpdir) write \
[namespace code {normalizePath Option(-tmpdir) ;#}]
# Tests should not rely on the current working directory.
@@ -756,17 +760,17 @@ namespace eval tcltest {
Option -testdir [workingDirectory] {
Search tests in the specified directory.
} AcceptDirectory testsDirectory
- trace variable Option(-testdir) w \
+ trace add variable Option(-testdir) write \
[namespace code {normalizePath Option(-testdir) ;#}]
proc AcceptLoadFile { file } {
- if {[string equal "" $file]} {return $file}
+ if {$file eq {}} {return $file}
set file [file join [temporaryDirectory] $file]
return [AcceptReadable $file]
}
proc ReadLoadScript {args} {
variable Option
- if {[string equal "" $Option(-loadfile)]} {return}
+ if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
loadScript [read $tmp]
close $tmp
@@ -774,7 +778,7 @@ namespace eval tcltest {
Option -loadfile {} {
Read the script to load the tested commands from the specified file.
} AcceptLoadFile loadFile
- trace variable Option(-loadfile) w [namespace code ReadLoadScript]
+ trace add variable Option(-loadfile) write [namespace code ReadLoadScript]
proc AcceptOutFile { file } {
if {[string equal stderr $file]} {return $file}
@@ -786,16 +790,39 @@ namespace eval tcltest {
Option -outfile stdout {
Send output from test runs to the specified file.
} AcceptOutFile outputFile
- trace variable Option(-outfile) w \
+ trace add variable Option(-outfile) write \
[namespace code {outputChannel $Option(-outfile) ;#}]
# errors go to stderr by default
Option -errfile stderr {
Send errors from test runs to the specified file.
} AcceptOutFile errorFile
- trace variable Option(-errfile) w \
+ trace add variable Option(-errfile) write \
[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
+ }
}
#####################################################################
@@ -851,7 +878,7 @@ proc tcltest::DebugPArray {level arrayvar} {
variable debug
if {$debug >= $level} {
- catch {upvar $arrayvar $arrayvar}
+ catch {upvar 1 $arrayvar $arrayvar}
parray $arrayvar
}
return
@@ -935,8 +962,7 @@ proc tcltest::testConstraint {constraint {value ""}} {
if {[catch {expr {$value && $value}} msg]} {
return -code error $msg
}
- if {[limitConstraints]
- && [lsearch -exact $Option(-constraints) $constraint] == -1} {
+ if {[limitConstraints] && ($constraint ni $Option(-constraints))} {
set value 0
}
set testConstraints($constraint) $value
@@ -960,11 +986,7 @@ proc tcltest::interpreter { {interp ""} } {
if {[llength [info level 0]] == 1} {
return $tcltest
}
- if {[string equal {} $interp]} {
- set tcltest {}
- } else {
- set tcltest $interp
- }
+ set tcltest $interp
}
#####################################################################
@@ -1029,7 +1051,7 @@ proc tcltest::PrintError {errorMsg} {
[expr {80 - $InitialMsgLen}]]]
puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
- while {![string equal end $beginningIndex]} {
+ while {$beginningIndex ne "end"} {
puts -nonewline [errorChannel] \
[string repeat " " $InitialMsgLen]
if {($endingIndex - $beginningIndex)
@@ -1082,7 +1104,7 @@ proc tcltest::PrintError {errorMsg} {
proc tcltest::SafeFetch {n1 n2 op} {
variable testConstraints
DebugPuts 3 "entering SafeFetch $n1 $n2 $op"
- if {[string equal {} $n2]} {return}
+ if {$n2 eq {}} {return}
if {![info exists testConstraints($n2)]} {
if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
testConstraint $n2 0
@@ -1227,9 +1249,8 @@ proc tcltest::DefineConstraintInitializers {} {
# are running as root on Unix.
ConstraintInitializer root {expr \
- {[string equal unix $::tcl_platform(platform)]
- && ([string equal root $::tcl_platform(user)]
- || [string equal "" $::tcl_platform(user)])}}
+ {($::tcl_platform(platform) eq "unix") &&
+ ($::tcl_platform(user) in {root {}})}}
ConstraintInitializer notRoot {expr {![testConstraint root]}}
# Set nonBlockFiles constraint: 1 means this platform supports
@@ -1237,7 +1258,7 @@ proc tcltest::DefineConstraintInitializers {} {
ConstraintInitializer nonBlockFiles {
set code [expr {[catch {set f [open defs r]}]
- || [catch {fconfigure $f -blocking off}]}]
+ || [catch {chan configure $f -blocking off}]}]
catch {close $f}
set code
}
@@ -1263,10 +1284,10 @@ proc tcltest::DefineConstraintInitializers {} {
ConstraintInitializer unixExecs {
set code 1
- if {[string equal macintosh $::tcl_platform(platform)]} {
+ if {$::tcl_platform(platform) eq "macintosh"} {
set code 0
}
- if {[string equal windows $::tcl_platform(platform)]} {
+ if {$::tcl_platform(platform) eq "windows"} {
if {[catch {
set file _tcl_test_remove_me.txt
makeFile {hello} $file
@@ -1360,7 +1381,7 @@ proc tcltest::Usage { {option ""} } {
set allOpts [concat -help [Configure]]
foreach opt $allOpts {
set foo [Usage $opt]
- foreach [list x type($opt) usage($opt)] $foo break
+ lassign $foo x type($opt) usage($opt)
set line($opt) " $opt $type($opt) "
set length($opt) [string length $line($opt)]
if {$length($opt) > $max} {set max $length($opt)}
@@ -1384,7 +1405,7 @@ proc tcltest::Usage { {option ""} } {
append msg $u
}
return $msg\n
- } elseif {[string equal -help $option]} {
+ } elseif {$option eq "-help"} {
return [list -help "" "Display this usage information."]
} else {
set type [lindex [info args $Verify($option)] 0]
@@ -1410,7 +1431,7 @@ proc tcltest::Usage { {option ""} } {
proc tcltest::ProcessFlags {flagArray} {
# Process -help first
- if {[lsearch -exact $flagArray {-help}] != -1} {
+ if {"-help" in $flagArray} {
PrintUsageInfo
exit 1
}
@@ -1419,14 +1440,14 @@ proc tcltest::ProcessFlags {flagArray} {
RemoveAutoConfigureTraces
} else {
set args $flagArray
- while {[llength $args]>1 && [catch {eval configure $args} msg]} {
+ while {[llength $args] > 1 && [catch {configure {*}$args} msg]} {
# Something went wrong parsing $args for tcltest options
# Check whether the problem is "unknown option"
if {[regexp {^unknown option (\S+):} $msg -> option]} {
# Could be this is an option the Hook knows about
set moreOptions [processCmdLineArgsAddFlagsHook]
- if {[lsearch -exact $moreOptions $option] == -1} {
+ if {$option ni $moreOptions} {
# Nope. Report the error, including additional options,
# but keep going
if {[llength $moreOptions]} {
@@ -1445,7 +1466,7 @@ proc tcltest::ProcessFlags {flagArray} {
# To recover, find that unknown option and remove up to it.
# then retry
- while {![string equal [lindex $args 0] $option]} {
+ while {[lindex $args 0] ne $option} {
set args [lrange $args 2 end]
}
set args [lrange $args 2 end]
@@ -1551,7 +1572,7 @@ proc tcltest::Replace::puts {args} {
}
2 {
# Either -nonewline or channelId has been specified
- if {[string equal -nonewline [lindex $args 0]]} {
+ if {[lindex $args 0] eq "-nonewline"} {
append outData [lindex $args end]
return
# return [Puts -nonewline [lindex $args end]]
@@ -1561,7 +1582,7 @@ proc tcltest::Replace::puts {args} {
}
}
3 {
- if {[string equal -nonewline [lindex $args 0]]} {
+ if {[lindex $args 0] eq "-nonewline"} {
# Both -nonewline and channelId are specified, unless
# it's an error. -nonewline is supposed to be argv[0].
set channel [lindex $args 1]
@@ -1571,12 +1592,10 @@ proc tcltest::Replace::puts {args} {
}
if {[info exists channel]} {
- if {[string equal $channel [[namespace parent]::outputChannel]]
- || [string equal $channel stdout]} {
+ if {$channel in [list [[namespace parent]::outputChannel] stdout]} {
append outData [lindex $args end]$newline
return
- } elseif {[string equal $channel [[namespace parent]::errorChannel]]
- || [string equal $channel stderr]} {
+ } elseif {$channel in [list [[namespace parent]::errorChannel] stderr]} {
append errData [lindex $args end]$newline
return
}
@@ -1584,7 +1603,7 @@ proc tcltest::Replace::puts {args} {
# If we haven't returned by now, we don't know how to handle the
# input. Let puts handle it.
- return [eval Puts $args]
+ return [Puts {*}$args]
}
# tcltest::Eval --
@@ -1613,8 +1632,7 @@ proc tcltest::Eval {script {ignoreOutput 1}} {
set outData {}
set errData {}
rename ::puts [namespace current]::Replace::Puts
- namespace eval :: \
- [list namespace import [namespace origin Replace::puts]]
+ namespace eval :: [list namespace import [namespace origin Replace::puts]]
namespace import Replace::puts
}
set result [uplevel 1 $script]
@@ -1746,7 +1764,7 @@ proc tcltest::SubstArguments {argList} {
set argList {}
}
- if {$token != {}} {
+ if {$token ne {}} {
# If we saw a word with quote before, then there is a
# multi-word token starting with that word. In this case,
# add the text and the current word to this token.
@@ -1853,10 +1871,7 @@ proc tcltest::test {name description args} {
# Pre-define everything to null except output and errorOutput. We
# determine whether or not to trap output based on whether or not
# these variables (output & errorOutput) are defined.
- foreach item {constraints setup cleanup body result returnCodes
- match} {
- set $item {}
- }
+ lassign {} constraints setup cleanup body result returnCodes match
# Set the default match mode
set match exact
@@ -1868,8 +1883,7 @@ proc tcltest::test {name description args} {
# The old test format can't have a 3rd argument (constraints or
# script) that starts with '-'.
- if {[string match -* [lindex $args 0]]
- || ([llength $args] <= 1)} {
+ if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
if {[llength $args] == 1} {
set list [SubstArguments [lindex $args 0]]
foreach {element value} $list {
@@ -1890,7 +1904,7 @@ proc tcltest::test {name description args} {
-match -output -errorOutput -constraints}
foreach flag [array names testAttributes] {
- if {[lsearch -exact $validFlags $flag] == -1} {
+ if {$flag ni $validFlags} {
incr testLevel -1
set sorted [lsort $validFlags]
set options [join [lrange $sorted 0 end-1] ", "]
@@ -1906,7 +1920,7 @@ proc tcltest::test {name description args} {
# Check the values supplied for -match
variable CustomMatch
- if {[lsearch [array names CustomMatch] $match] == -1} {
+ if {$match ni [array names CustomMatch]} {
incr testLevel -1
set sorted [lsort [array names CustomMatch]]
set values [join [lrange $sorted 0 end-1] ", "]
@@ -1970,7 +1984,7 @@ proc tcltest::test {name description args} {
} else {
set testResult [uplevel 1 [list [namespace origin Eval] $command 1]]
}
- foreach {actualAnswer returnCode} $testResult break
+ lassign $testResult actualAnswer returnCode
if {$returnCode == 1} {
set errorInfo(body) $::errorInfo
set errorCode(body) $::errorCode
@@ -2006,11 +2020,11 @@ proc tcltest::test {name description args} {
if {([preserveCore] > 1) && ($coreFailure)} {
append coreMsg "\nMoving file to:\
[file join [temporaryDirectory] core-$name]"
- catch {file rename -force \
+ catch {file rename -force -- \
[file join [workingDirectory] core] \
[file join [temporaryDirectory] core-$name]
} msg
- if {[string length $msg] > 0} {
+ if {$msg ne {}} {
append coreMsg "\nError:\
Problem renaming core file: $msg"
}
@@ -2020,7 +2034,7 @@ proc tcltest::test {name description args} {
# check if the return code matched the expected return code
set codeFailure 0
- if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} {
+ if {!$setupFailure && ($returnCode ni $returnCodes)} {
set codeFailure 1
}
@@ -2087,7 +2101,28 @@ proc tcltest::test {name description args} {
if {![IsVerbose body]} {
set body ""
}
- puts [outputChannel] "\n==== $name\
+ puts [outputChannel] "\n"
+ if {[IsVerbose line]} {
+ if {![catch {set testFrame [info frame -1]}] &&
+ [dict get $testFrame type] eq "source"} {
+ set testFile [dict get $testFrame file]
+ set testLine [dict get $testFrame line]
+ } else {
+ set testFile [file normalize [uplevel 1 {info script}]]
+ if {[file readable $testFile]} {
+ set testFd [open $testFile r]
+ set testLine [expr {[lsearch -regexp \
+ [split [read $testFd] "\n"] \
+ "^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
+ close $testFd
+ }
+ }
+ if {[info exists testLine]} {
+ puts [outputChannel] "$testFile:$testLine: error: test failed:\
+ $name [string trim $description]"
+ }
+ }
+ puts [outputChannel] "==== $name\
[string trim $description] FAILED"
if {[string length $body]} {
puts [outputChannel] "==== Contents of test case:"
@@ -2123,7 +2158,7 @@ proc tcltest::test {name description args} {
puts [outputChannel] "---- Return code should have been\
one of: $returnCodes"
if {[IsVerbose error]} {
- if {[info exists errorInfo(body)] && ([lsearch $returnCodes 1]<0)} {
+ if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
puts [outputChannel] "---- errorInfo: $errorInfo(body)"
puts [outputChannel] "---- errorCode: $errorCode(body)"
}
@@ -2204,7 +2239,7 @@ proc tcltest::Skipped {name constraints} {
}
return 1
}
- if {[string equal {} $constraints]} {
+ if {$constraints eq {}} {
# If we're limited to the listed constraints and there aren't
# any listed, then we shouldn't run the test.
if {[limitConstraints]} {
@@ -2221,12 +2256,12 @@ proc tcltest::Skipped {name constraints} {
set doTest 0
if {[string match {*[$\[]*} $constraints] != 0} {
# full expression, e.g. {$foo > [info tclversion]}
- catch {set doTest [uplevel #0 expr $constraints]}
- } elseif {[regexp {[^.a-zA-Z0-9 \n\r\t]+} $constraints] != 0} {
+ catch {set doTest [uplevel #0 [list expr $constraints]]}
+ } elseif {[regexp {[^.:_a-zA-Z0-9 \n\r\t]+} $constraints] != 0} {
# something like {a || b} should be turned into
# $testConstraints(a) || $testConstraints(b).
regsub -all {[.\w]+} $constraints {$testConstraints(&)} c
- catch {set doTest [eval expr $c]}
+ catch {set doTest [eval [list expr $c]]}
} elseif {![catch {llength $constraints}]} {
# just simple constraints such as {unixOnly fonts}.
set doTest 1
@@ -2243,7 +2278,7 @@ proc tcltest::Skipped {name constraints} {
}
}
- if {$doTest == 0} {
+ if {!$doTest} {
if {[IsVerbose skip]} {
puts [outputChannel] "++++ $name SKIPPED: $constraints"
}
@@ -2335,6 +2370,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
@@ -2347,7 +2390,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
foreach file $filesMade {
if {[file exists $file]} {
DebugDo 1 {Warn "cleanupTests deleting $file..."}
- catch {file delete -force $file}
+ catch {file delete -force -- $file}
}
}
set currentFiles {}
@@ -2357,7 +2400,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
}
set newFiles {}
foreach file $currentFiles {
- if {[lsearch -exact $filesExisted $file] == -1} {
+ if {$file ni $filesExisted} {
lappend newFiles $file
}
}
@@ -2440,8 +2483,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
# then add current file to failFile list if any tests in this
# file failed
- if {$currentFailure \
- && ([lsearch -exact $failFiles $testFileName] == -1)} {
+ if {$currentFailure && ($testFileName ni $failFiles)} {
lappend failFiles $testFileName
}
set currentFailure false
@@ -2456,17 +2498,15 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
if {![info exists originalEnv($index)]} {
lappend newEnv $index
unset ::env($index)
- } else {
- if {$::env($index) != $originalEnv($index)} {
- lappend changedEnv $index
- set ::env($index) $originalEnv($index)
- }
}
}
foreach index [array names originalEnv] {
if {![info exists ::env($index)]} {
lappend removedEnv $index
set ::env($index) $originalEnv($index)
+ } elseif {$::env($index) ne $originalEnv($index)} {
+ lappend changedEnv $index
+ set ::env($index) $originalEnv($index)
}
}
if {[llength $newEnv] > 0} {
@@ -2501,11 +2541,11 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
puts [outputChannel] "produced core file! \
Moving file to: \
[file join [temporaryDirectory] core-$testFileName]"
- catch {file rename -force \
+ catch {file rename -force -- \
[file join [workingDirectory] core] \
[file join [temporaryDirectory] core-$testFileName]
} msg
- if {[string length $msg] > 0} {
+ if {$msg ne {}} {
PrintError "Problem renaming file: $msg"
}
} else {
@@ -2550,7 +2590,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
# None
# a lower case version is needed for compatibility with tcltest 1.0
-proc tcltest::getMatchingFiles args {eval GetMatchingFiles $args}
+proc tcltest::getMatchingFiles args {GetMatchingFiles {*}$args}
proc tcltest::GetMatchingFiles { args } {
if {[llength $args]} {
@@ -2583,7 +2623,7 @@ proc tcltest::GetMatchingFiles { args } {
# Add to result list all files in match list and not in skip list
foreach file $matchFileList {
- if {[lsearch -exact $skipFileList $file] == -1} {
+ if {$file ni $skipFileList} {
lappend matchingFiles $file
}
}
@@ -2630,7 +2670,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
foreach pattern [matchDirectories] {
foreach path [glob -directory $rootdir -types d -nocomplain -- \
$pattern] {
- if {[lsearch -exact $skipDirs $path] == -1} {
+ if {$path ni $skipDirs} {
set matchDirs [concat $matchDirs [GetMatchingDirectories $path]]
if {[file exists [file join $path all.tcl]]} {
lappend matchDirs $path
@@ -2666,6 +2706,7 @@ proc tcltest::runAllTests { {shell ""} } {
variable numTestFiles
variable numTests
variable failFiles
+ variable DefaultValue
FillFilesExisted
if {[llength [info level 0]] == 1} {
@@ -2682,7 +2723,7 @@ proc tcltest::runAllTests { {shell ""} } {
# [file system] first available in Tcl 8.4
if {![catch {file system [testsDirectory]} result]
- && ![string equal native [lindex $result 0]]} {
+ && ([lindex $result 0] ne "native")} {
# If we aren't running in the native filesystem, then we must
# run the tests in a single process (via 'source'), because
# trying to run then via a pipe will fail since the files don't
@@ -2729,8 +2770,13 @@ proc tcltest::runAllTests { {shell ""} } {
# needs to read and process output of children.
set childargv [list]
foreach opt [Configure] {
- if {[string equal $opt -outfile]} {continue}
- lappend childargv $opt [Configure $opt]
+ if {$opt eq "-outfile"} {continue}
+ set value [Configure $opt]
+ # Don't bother passing default configuration options
+ if {$value eq $DefaultValue($opt)} {
+ continue
+ }
+ lappend childargv $opt $value
}
set cmd [linsert $childargv 0 | $shell $file]
if {[catch {
@@ -2820,11 +2866,6 @@ proc tcltest::runAllTests { {shell ""} } {
# none.
proc tcltest::loadTestedCommands {} {
- variable l
- if {[string equal {} [loadScript]]} {
- return
- }
-
return [uplevel 1 [loadScript]]
}
@@ -2867,16 +2908,15 @@ proc tcltest::saveState {} {
proc tcltest::restoreState {} {
variable saveState
foreach p [uplevel 1 {::info procs}] {
- if {([lsearch [lindex $saveState 0] $p] < 0)
- && ![string equal [namespace current]::$p \
- [uplevel 1 [list ::namespace origin $p]]]} {
+ if {($p ni [lindex $saveState 0]) && ("[namespace current]::$p" ne
+ [uplevel 1 [list ::namespace origin $p]])} {
DebugPuts 2 "[lindex [info level 0] 0]: Removing proc $p"
uplevel 1 [list ::catch [list ::rename $p {}]]
}
}
foreach p [uplevel 1 {::info vars}] {
- if {[lsearch [lindex $saveState 1] $p] < 0} {
+ if {$p ni [lindex $saveState 1]} {
DebugPuts 2 "[lindex [info level 0] 0]:\
Removing variable $p"
uplevel 1 [list ::catch [list ::unset $p]]
@@ -2937,15 +2977,15 @@ proc tcltest::makeFile {contents name {directory ""}} {
putting ``$contents'' into $fullName"
set fd [open $fullName w]
- fconfigure $fd -translation lf
- if {[string equal [string index $contents end] \n]} {
+ chan configure $fd -translation lf
+ if {[string index $contents end] eq "\n"} {
puts -nonewline $fd $contents
} else {
puts $fd $contents
}
close $fd
- if {[lsearch -exact $filesMade $fullName] == -1} {
+ if {$fullName ni $filesMade} {
lappend filesMade $fullName
}
return $fullName
@@ -2985,7 +3025,7 @@ proc tcltest::removeFile {name {directory ""}} {
Warn "removeFile removing \"$fullName\":\n not a file"
}
}
- return [file delete $fullName]
+ return [file delete -- $fullName]
}
# tcltest::makeDirectory --
@@ -3015,7 +3055,7 @@ proc tcltest::makeDirectory {name {directory ""}} {
set fullName [file join $directory $name]
DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName"
file mkdir $fullName
- if {[lsearch -exact $filesMade $fullName] == -1} {
+ if {$fullName ni $filesMade} {
lappend filesMade $fullName
}
return $fullName
@@ -3056,7 +3096,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
Warn "removeDirectory removing \"$fullName\":\n not a directory"
}
}
- return [file delete -force $fullName]
+ return [file delete -force -- $fullName]
}
# tcltest::viewFile --
@@ -3153,7 +3193,7 @@ proc tcltest::LeakFiles {old} {
}
set leak {}
foreach p $new {
- if {[lsearch $old $p] < 0} {
+ if {$p ni $old} {
lappend leak $p
}
}
@@ -3224,7 +3264,7 @@ proc tcltest::RestoreLocale {} {
#
proc tcltest::threadReap {} {
- if {[info commands testthread] != {}} {
+ if {[info commands testthread] ne {}} {
# testthread built into tcltest
@@ -3244,7 +3284,7 @@ proc tcltest::threadReap {} {
}
testthread errorproc ThreadError
return [llength [testthread names]]
- } elseif {[info commands thread::id] != {}} {
+ } elseif {[info commands thread::id] ne {}} {
# Thread extension
@@ -3276,15 +3316,15 @@ namespace eval tcltest {
# Set up the constraints in the testConstraints array to be lazily
# initialized by a registered initializer, or by "false" if no
# initializer is registered.
- trace variable testConstraints r [namespace code SafeFetch]
+ trace add variable testConstraints read [namespace code SafeFetch]
# Only initialize constraints at package load time if an
# [initConstraintsHook] has been pre-defined. This is only
# for compatibility support. The modern way to add a custom
# test constraint is to just call the [testConstraint] command
# straight away, without all this "hook" nonsense.
- if {[string equal [namespace current] \
- [namespace qualifiers [namespace which initConstraintsHook]]]} {
+ if {[namespace current] eq
+ [namespace qualifiers [namespace which initConstraintsHook]]} {
InitConstraints
} else {
proc initConstraintsHook {} {}
@@ -3305,12 +3345,12 @@ namespace eval tcltest {
Tcl list: $msg"
return
}
- if {[llength $::env(TCLTEST_OPTIONS)] % 2} {
+ if {[llength $options] % 2} {
Warn "invalid TCLTEST_OPTIONS: \"$options\":\n should be\
-option value ?-option value ...?"
return
}
- if {[catch {eval Configure $::env(TCLTEST_OPTIONS)} msg]} {
+ if {[catch {Configure {*}$options} msg]} {
Warn "invalid TCLTEST_OPTIONS: \"$options\":\n $msg"
return
}
@@ -3321,15 +3361,15 @@ namespace eval tcltest {
proc LoadTimeCmdLineArgParsingRequired {} {
set required false
- if {[info exists ::argv] && [lsearch -exact $::argv -help] != -1} {
+ if {[info exists ::argv] && ("-help" in $::argv)} {
# The command line asks for -help, so give it (and exit)
# right now. ([configure] does not process -help)
set required true
}
foreach hook { PrintUsageInfoHook processCmdLineArgsHook
processCmdLineArgsAddFlagsHook } {
- if {[string equal [namespace current] [namespace qualifiers \
- [namespace which $hook]]]} {
+ if {[namespace current] eq
+ [namespace qualifiers [namespace which $hook]]} {
set required true
} else {
proc $hook args {}
diff --git a/library/tm.tcl b/library/tm.tcl
index 2830ea6..55efda6 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -1,48 +1,44 @@
# -*- tcl -*-
#
-# Searching for Tcl Modules. Defines a procedure, declares it as the
-# primary command for finding packages, however also uses the former
-# 'package unknown' command as a fallback.
+# Searching for Tcl Modules. Defines a procedure, declares it as the primary
+# command for finding packages, however also uses the former 'package unknown'
+# command as a fallback.
#
-# Locates all possible packages in a directory via a less restricted
-# glob. The targeted directory is derived from the name of the
-# requested package. I.e. the TM scan will look only at directories
-# which can contain the requested package. It will register all
-# packages it found in the directory so that future requests have a
-# higher chance of being fulfilled by the ifneeded database without
-# having to come to us again.
+# Locates all possible packages in a directory via a less restricted glob. The
+# targeted directory is derived from the name of the requested package, i.e.
+# the TM scan will look only at directories which can contain the requested
+# package. It will register all packages it found in the directory so that
+# future requests have a higher chance of being fulfilled by the ifneeded
+# database without having to come to us again.
#
-# We do not remember where we have been and simply rescan targeted
-# directories when invoked again. The reasoning is this:
+# We do not remember where we have been and simply rescan targeted directories
+# when invoked again. The reasoning is this:
#
-# - The only way we get back to the same directory is if someone is
-# trying to [package require] something that wasn't there on the
-# first scan.
+# - The only way we get back to the same directory is if someone is trying to
+# [package require] something that wasn't there on the first scan.
#
# Either
# 1) It is there now: If we rescan, you get it; if not you don't.
#
-# This covers the possibility that the application asked for a
-# package late, and the package was actually added to the
-# installation after the application was started. It shoukld
-# still be able to find it.
+# This covers the possibility that the application asked for a package
+# late, and the package was actually added to the installation after the
+# application was started. It shoukld still be able to find it.
#
-# 2) It still is not there: Either way, you don't get it, but the
-# rescan takes time. This is however an error case and we dont't
-# care that much about it
+# 2) It still is not there: Either way, you don't get it, but the rescan
+# takes time. This is however an error case and we dont't care that much
+# about it
#
-# 3) It was there the first time; but for some reason a "package
-# forget" has been run, and "package" doesn't know about it
-# anymore.
+# 3) It was there the first time; but for some reason a "package forget" has
+# been run, and "package" doesn't know about it anymore.
#
-# This can be an indication that the application wishes to reload
-# some functionality. And should work as well.
+# This can be an indication that the application wishes to reload some
+# functionality. And should work as well.
#
-# Note that this also strikes a balance between doing a glob targeting
-# a single package, and thus most likely requiring multiple globs of
-# the same directory when the application is asking for many packages,
-# and trying to glob for _everything_ in all subdirectories when
-# looking for a package, which comes with a heavy startup cost.
+# Note that this also strikes a balance between doing a glob targeting a
+# single package, and thus most likely requiring multiple globs of the same
+# directory when the application is asking for many packages, and trying to
+# glob for _everything_ in all subdirectories when looking for a package,
+# which comes with a heavy startup cost.
#
# We scan for regular packages only if no satisfying module was found.
@@ -53,12 +49,12 @@ namespace eval ::tcl::tm {
# The regex pattern a file name has to match to make it a Tcl Module.
- set pkgpattern {^([[:alpha:]][:[:alnum:]]*)-([[:digit:]].*)[.]tm$}
+ set pkgpattern {^([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)[.]tm$}
# Export the public API
namespace export path
- namespace ensemble create -command path -subcommand {add remove list}
+ namespace ensemble create -command path -subcommands {add remove list}
}
# ::tcl::tm::path implementations --
@@ -71,46 +67,43 @@ namespace eval ::tcl::tm {
# path with 'list'.
#
# Results
-# No result for subcommands 'add' and 'remove'. A list of paths
-# for 'list'.
+# No result for subcommands 'add' and 'remove'. A list of paths for
+# 'list'.
#
# Sideeffects
-# The subcommands 'add' and 'remove' manipulate the list of
-# paths to search for Tcl Modules. The subcommand 'list' has no
-# sideeffects.
+# The subcommands 'add' and 'remove' manipulate the list of paths to
+# search for Tcl Modules. The subcommand 'list' has no sideeffects.
-proc ::tcl::tm::add {path args} {
+proc ::tcl::tm::add {args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
# The path is added at the head to the list of module paths.
#
- # The command enforces the restriction that no path may be an
- # ancestor directory of any other path on the list. If the new
- # path violates this restriction an error wil be raised.
+ # The command enforces the restriction that no path may be an ancestor
+ # directory of any other path on the list. If the new path violates this
+ # restriction an error wil be raised.
#
- # If the path is already present as is no error will be raised and
- # no action will be taken.
+ # If the path is already present as is no error will be raised and no
+ # action will be taken.
variable paths
- # We use a copy of the path as source during validation, and
- # extend it as well. Because we not only have to detect if the new
- # paths are bogus with respect to the existing paths, but also
- # between themselves. Otherwise we can still add bogus paths, by
- # specifying them in a single call. This makes the use of the new
- # paths simpler as well, a trivial assignment of the collected
- # paths to the official state var.
+ # We use a copy of the path as source during validation, and extend it as
+ # well. Because we not only have to detect if the new paths are bogus with
+ # respect to the existing paths, but also between themselves. Otherwise we
+ # can still add bogus paths, by specifying them in a single call. This
+ # makes the use of the new paths simpler as well, a trivial assignment of
+ # the collected paths to the official state var.
set newpaths $paths
- foreach p [linsert $args 0 $path] {
+ foreach p $args {
if {$p in $newpaths} {
# Ignore a path already on the list.
continue
}
- # Search for paths which are subdirectories of the new one. If
- # there are any then the new path violates the restriction
- # about ancestors.
+ # Search for paths which are subdirectories of the new one. If there
+ # are any then the new path violates the restriction about ancestors.
set pos [lsearch -glob $newpaths ${p}/*]
# Cannot use "in", we need the position for the message.
@@ -119,10 +112,9 @@ proc ::tcl::tm::add {path args} {
"$p is ancestor of existing module path [lindex $newpaths $pos]."
}
- # Now look for existing paths which are ancestors of the new
- # one. This reverse question forces us to loop over the
- # existing paths, as each element is the pattern, not the new
- # path :(
+ # Now look for existing paths which are ancestors of the new one. This
+ # reverse question forces us to loop over the existing paths, as each
+ # element is the pattern, not the new path :(
foreach ep $newpaths {
if {[string match ${ep}/* $p]} {
@@ -134,24 +126,23 @@ proc ::tcl::tm::add {path args} {
set newpaths [linsert $newpaths 0 $p]
}
- # The validation of the input is complete and successful, and
- # everything in newpaths is either an old path, or added. We can
- # now extend the official list of paths, a simple assignment is
- # sufficient.
+ # The validation of the input is complete and successful, and everything
+ # in newpaths is either an old path, or added. We can now extend the
+ # official list of paths, a simple assignment is sufficient.
set paths $newpaths
return
}
-proc ::tcl::tm::remove {path args} {
+proc ::tcl::tm::remove {args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
- # Removes the path from the list of module paths. The command is
- # silently ignored if the path is not on the list.
+ # Removes the path from the list of module paths. The command is silently
+ # ignored if the path is not on the list.
variable paths
- foreach p [linsert $args 0 $path] {
+ foreach p $args {
set pos [lsearch -exact $paths $p]
if {$pos >= 0} {
set paths [lreplace $paths $pos $pos]
@@ -177,27 +168,26 @@ proc ::tcl::tm::list {} {
# empty string.
# exact - Either -exact or ommitted.
#
-# Name, version, and exact are used to determine
-# satisfaction. The original is called iff no satisfaction was
-# achieved. The name is also used to compute the directory to
-# target in the search.
+# Name, version, and exact are used to determine satisfaction. The
+# original is called iff no satisfaction was achieved. The name is also
+# used to compute the directory to target in the search.
#
# Results
# None.
#
# Sideeffects
-# May populate the package ifneeded database with additional
-# provide scripts.
+# May populate the package ifneeded database with additional provide
+# scripts.
-proc ::tcl::tm::UnknownHandler {original name version {exact {}}} {
+proc ::tcl::tm::UnknownHandler {original name args} {
# Import the list of paths to search for packages in module form.
- # Import the pattern used to check package names in detail.
+ # Import the pattern used to check package names in detail.
variable paths
variable pkgpattern
- # Without paths to search we can do nothing. (Except falling back
- # to the regular search).
+ # Without paths to search we can do nothing. (Except falling back to the
+ # regular search).
if {[llength $paths]} {
set pkgpath [string map {:: /} $name]
@@ -206,29 +196,27 @@ proc ::tcl::tm::UnknownHandler {original name version {exact {}}} {
set pkgroot ""
}
- # We don't remember a copy of the paths while looping. Tcl
- # Modules are unable to change the list while we are searching
- # for them. This also simplifies the loop, as we cannot get
- # additional directories while iterating over the list. A
- # simple foreach is sufficient.
+ # We don't remember a copy of the paths while looping. Tcl Modules are
+ # unable to change the list while we are searching for them. This also
+ # simplifies the loop, as we cannot get additional directories while
+ # iterating over the list. A simple foreach is sufficient.
set satisfied 0
foreach path $paths {
- if {![file exists $path]} {
+ if {![interp issafe] && ![file exists $path]} {
continue
}
set currentsearchpath [file join $path $pkgroot]
- if {![file exists $currentsearchpath]} {
+ if {![interp issafe] && ![file exists $currentsearchpath]} {
continue
}
set strip [llength [file split $path]]
- # We can't use glob in safe interps, so enclose the following
- # in a catch statement, where we get the module files out
- # of the subdirectories. In other words, Tcl Modules are
- # not-functional in such an interpreter. This is the same
- # as for the command "tclPkgUnknown", i.e. the search for
- # regular packages.
+ # We can't use glob in safe interps, so enclose the following in a
+ # catch statement, where we get the module files out of the
+ # subdirectories. In other words, Tcl Modules are not-functional
+ # in such an interpreter. This is the same as for the command
+ # "tclPkgUnknown", i.e. the search for regular packages.
catch {
# We always look for _all_ possible modules in the current
@@ -238,41 +226,57 @@ proc ::tcl::tm::UnknownHandler {original name version {exact {}}} {
set pkgfilename [join [lrange [file split $file] $strip end] ::]
if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} {
- # Ignore everything not matching our pattern
- # for package names.
+ # Ignore everything not matching our pattern for
+ # package names.
continue
}
- if {[catch {package vcompare $pkgversion 0}]} {
- # Ignore everything where the version part is
- # not acceptable to "package vcompare".
+ try {
+ package vcompare $pkgversion 0
+ } on error {} {
+ # Ignore everything where the version part is not
+ # acceptable to "package vcompare".
continue
}
- # We have found a candidate, generate a "provide
- # script" for it, and remember it. Note that we
- # are using ::list to do this; locally [list]
- # means something else without the namespace
- # specifier.
-
- package ifneeded $pkgname $pkgversion [::list source $file]
-
- # We abort in this unknown handler only if we got
- # a satisfying candidate for the requested
- # package. Otherwise we still have to fallback to
- # the regular package search to complete the
- # processing.
-
- if {
- $pkgname eq $name && (
- ($exact eq "-exact" && ![package vcompare $pkgversion $version]) ||
- ($version ne "" && [package vsatisfies $pkgversion $version]) ||
- ($version eq ""))
- } then {
+ if {[package ifneeded $pkgname $pkgversion] ne {}} {
+ # There's already a provide script registered for
+ # this version of this package. Since all units of
+ # code claiming to be the same version of the same
+ # package ought to be identical, just stick with
+ # the one we already have.
+ continue
+ }
+
+ # We have found a candidate, generate a "provide script"
+ # for it, and remember it. Note that we are using ::list
+ # to do this; locally [list] means something else without
+ # the namespace specifier.
+
+ # NOTE. When making changes to the format of the provide
+ # command generated below CHECK that the 'LOCATE'
+ # procedure in core file 'platform/shell.tcl' still
+ # understands it, or, if not, update its implementation
+ # appropriately.
+ #
+ # Right now LOCATE's implementation assumes that the path
+ # of the package file is the last element in the list.
+
+ package ifneeded $pkgname $pkgversion \
+ "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]"
+
+ # We abort in this unknown handler only if we got a
+ # satisfying candidate for the requested package.
+ # Otherwise we still have to fallback to the regular
+ # package search to complete the processing.
+
+ if {($pkgname eq $name)
+ && [package vsatisfies $pkgversion {*}$args]} {
set satisfied 1
- # We do not abort the loop, and keep adding
- # provide scripts for every candidate in the
- # directory, just remember to not fall back to
- # the regular search anymore.
+
+ # We do not abort the loop, and keep adding provide
+ # scripts for every candidate in the directory, just
+ # remember to not fall back to the regular search
+ # anymore.
}
}
}
@@ -283,11 +287,11 @@ proc ::tcl::tm::UnknownHandler {original name version {exact {}}} {
}
}
- # Fallback to previous command, if existing. See comment above
- # about ::list...
+ # Fallback to previous command, if existing. See comment above about
+ # ::list...
if {[llength $original]} {
- uplevel 1 $original [::list $name $version $exact]
+ uplevel 1 $original [::linsert $args 0 $name]
}
}
@@ -323,8 +327,11 @@ proc ::tcl::tm::Defaults {} {
set sep ":"
}
for {set n $minor} {$n >= 0} {incr n -1} {
- set ev TCL${major}.{$n}_TM_PATH
- if {[info exists env($ev)]} {
+ foreach ev [::list \
+ TCL${major}.${n}_TM_PATH \
+ TCL${major}_${n}_TM_PATH \
+ ] {
+ if {![info exists env($ev)]} continue
foreach p [split $env($ev) $sep] {
path add $p
}
@@ -347,18 +354,22 @@ proc ::tcl::tm::Defaults {} {
# Calls 'path add' to paths to the list of module search paths.
proc ::tcl::tm::roots {paths} {
- foreach {major minor} [split [info tclversion] .] break
+ lassign [split [package present Tcl] .] major minor
foreach pa $paths {
set p [file join $pa tcl$major]
for {set n $minor} {$n >= 0} {incr n -1} {
- path add [file normalize [file join $p ${major}.${n}]]
+ set px [file join $p ${major}.${n}]
+ if {![interp issafe]} {set px [file normalize $px]}
+ path add $px
}
- path add [file normalize [file join $p site-tcl]]
+ set px [file join $p site-tcl]
+ if {![interp issafe]} {set px [file normalize $px]}
+ path add $px
}
return
}
-# Initialization. Set up the default paths, then insert the new
-# handler into the chain.
+# Initialization. Set up the default paths, then insert the new handler into
+# the chain.
-::tcl::tm::Defaults
+if {![interp issafe]} {::tcl::tm::Defaults}
diff --git a/library/tzdata/Africa/Abidjan b/library/tzdata/Africa/Abidjan
index ebe617d..4b4f5b2 100644
--- a/library/tzdata/Africa/Abidjan
+++ b/library/tzdata/Africa/Abidjan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Abidjan) {
{-9223372036854775808 -968 0 LMT}
diff --git a/library/tzdata/Africa/Accra b/library/tzdata/Africa/Accra
index 7e323e5..faf58fb 100644
--- a/library/tzdata/Africa/Accra
+++ b/library/tzdata/Africa/Accra
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Accra) {
{-9223372036854775808 -52 0 LMT}
diff --git a/library/tzdata/Africa/Addis_Ababa b/library/tzdata/Africa/Addis_Ababa
index fc45012..4b92483 100644
--- a/library/tzdata/Africa/Addis_Ababa
+++ b/library/tzdata/Africa/Addis_Ababa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Addis_Ababa) {
{-9223372036854775808 9288 0 LMT}
diff --git a/library/tzdata/Africa/Algiers b/library/tzdata/Africa/Algiers
index 730eb02..fe4de22 100644
--- a/library/tzdata/Africa/Algiers
+++ b/library/tzdata/Africa/Algiers
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Algiers) {
{-9223372036854775808 732 0 LMT}
diff --git a/library/tzdata/Africa/Asmara b/library/tzdata/Africa/Asmara
new file mode 100644
index 0000000..1f0f13e
--- /dev/null
+++ b/library/tzdata/Africa/Asmara
@@ -0,0 +1,8 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Africa/Asmara) {
+ {-9223372036854775808 9332 0 LMT}
+ {-3155682932 9332 0 AMT}
+ {-2524530932 9320 0 ADMT}
+ {-1062210920 10800 0 EAT}
+}
diff --git a/library/tzdata/Africa/Asmera b/library/tzdata/Africa/Asmera
index 4457839..931c36d 100644
--- a/library/tzdata/Africa/Asmera
+++ b/library/tzdata/Africa/Asmera
@@ -1,8 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Africa/Asmera) {
- {-9223372036854775808 9332 0 LMT}
- {-3155682932 9332 0 AMT}
- {-2524530932 9320 0 ADMT}
- {-1062210920 10800 0 EAT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Africa/Asmara)]} {
+ LoadTimeZoneFile Africa/Asmara
}
+set TZData(:Africa/Asmera) $TZData(:Africa/Asmara)
diff --git a/library/tzdata/Africa/Bamako b/library/tzdata/Africa/Bamako
index 15debdd..7ed62e0 100644
--- a/library/tzdata/Africa/Bamako
+++ b/library/tzdata/Africa/Bamako
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Bamako) {
{-9223372036854775808 -1920 0 LMT}
diff --git a/library/tzdata/Africa/Bangui b/library/tzdata/Africa/Bangui
index 11838a3..94f5058 100644
--- a/library/tzdata/Africa/Bangui
+++ b/library/tzdata/Africa/Bangui
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Bangui) {
{-9223372036854775808 4460 0 LMT}
diff --git a/library/tzdata/Africa/Banjul b/library/tzdata/Africa/Banjul
index a935e1b..a7f0168 100644
--- a/library/tzdata/Africa/Banjul
+++ b/library/tzdata/Africa/Banjul
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Banjul) {
{-9223372036854775808 -3996 0 LMT}
diff --git a/library/tzdata/Africa/Bissau b/library/tzdata/Africa/Bissau
index bab316a..d51cb9f 100644
--- a/library/tzdata/Africa/Bissau
+++ b/library/tzdata/Africa/Bissau
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Bissau) {
{-9223372036854775808 -3740 0 LMT}
diff --git a/library/tzdata/Africa/Blantyre b/library/tzdata/Africa/Blantyre
index b5d3b75..17b58f4 100644
--- a/library/tzdata/Africa/Blantyre
+++ b/library/tzdata/Africa/Blantyre
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Blantyre) {
{-9223372036854775808 8400 0 LMT}
diff --git a/library/tzdata/Africa/Brazzaville b/library/tzdata/Africa/Brazzaville
index 44910a6..b4e0923 100644
--- a/library/tzdata/Africa/Brazzaville
+++ b/library/tzdata/Africa/Brazzaville
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Brazzaville) {
{-9223372036854775808 3668 0 LMT}
diff --git a/library/tzdata/Africa/Bujumbura b/library/tzdata/Africa/Bujumbura
index 12a2660..c26d053 100644
--- a/library/tzdata/Africa/Bujumbura
+++ b/library/tzdata/Africa/Bujumbura
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Bujumbura) {
{-9223372036854775808 7048 0 LMT}
diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo
index 124db3c..842b7b2 100644
--- a/library/tzdata/Africa/Cairo
+++ b/library/tzdata/Africa/Cairo
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Cairo) {
- {-9223372036854775808 7500 0 LMT}
- {-2185409100 7200 0 EET}
+ {-9223372036854775808 7509 0 LMT}
+ {-2185409109 7200 0 EET}
{-929844000 10800 1 EEST}
{-923108400 7200 0 EET}
{-906170400 10800 1 EEST}
@@ -91,214 +91,38 @@ set TZData(:Africa/Cairo) {
{749433600 7200 0 EET}
{767746800 10800 1 EEST}
{780969600 7200 0 EET}
- {799027200 10800 1 EEST}
- {812329200 7200 0 EET}
- {830476800 10800 1 EEST}
- {843778800 7200 0 EET}
- {861926400 10800 1 EEST}
- {875228400 7200 0 EET}
- {893376000 10800 1 EEST}
- {906678000 7200 0 EET}
- {925430400 10800 1 EEST}
- {938732400 7200 0 EET}
- {956880000 10800 1 EEST}
- {970182000 7200 0 EET}
- {988329600 10800 1 EEST}
- {1001631600 7200 0 EET}
- {1019779200 10800 1 EEST}
- {1033081200 7200 0 EET}
- {1051228800 10800 1 EEST}
- {1064530800 7200 0 EET}
- {1083283200 10800 1 EEST}
- {1096585200 7200 0 EET}
- {1114732800 10800 1 EEST}
- {1128034800 7200 0 EET}
- {1146182400 10800 1 EEST}
- {1159484400 7200 0 EET}
- {1177632000 10800 1 EEST}
- {1190934000 7200 0 EET}
- {1209081600 10800 1 EEST}
- {1222383600 7200 0 EET}
- {1240531200 10800 1 EEST}
- {1253833200 7200 0 EET}
- {1272585600 10800 1 EEST}
- {1285887600 7200 0 EET}
- {1304035200 10800 1 EEST}
- {1317337200 7200 0 EET}
- {1335484800 10800 1 EEST}
- {1348786800 7200 0 EET}
- {1366934400 10800 1 EEST}
- {1380236400 7200 0 EET}
- {1398384000 10800 1 EEST}
- {1411686000 7200 0 EET}
- {1429833600 10800 1 EEST}
- {1443135600 7200 0 EET}
- {1461888000 10800 1 EEST}
- {1475190000 7200 0 EET}
- {1493337600 10800 1 EEST}
- {1506639600 7200 0 EET}
- {1524787200 10800 1 EEST}
- {1538089200 7200 0 EET}
- {1556236800 10800 1 EEST}
- {1569538800 7200 0 EET}
- {1587686400 10800 1 EEST}
- {1600988400 7200 0 EET}
- {1619740800 10800 1 EEST}
- {1633042800 7200 0 EET}
- {1651190400 10800 1 EEST}
- {1664492400 7200 0 EET}
- {1682640000 10800 1 EEST}
- {1695942000 7200 0 EET}
- {1714089600 10800 1 EEST}
- {1727391600 7200 0 EET}
- {1745539200 10800 1 EEST}
- {1758841200 7200 0 EET}
- {1776988800 10800 1 EEST}
- {1790290800 7200 0 EET}
- {1809043200 10800 1 EEST}
- {1822345200 7200 0 EET}
- {1840492800 10800 1 EEST}
- {1853794800 7200 0 EET}
- {1871942400 10800 1 EEST}
- {1885244400 7200 0 EET}
- {1903392000 10800 1 EEST}
- {1916694000 7200 0 EET}
- {1934841600 10800 1 EEST}
- {1948143600 7200 0 EET}
- {1966896000 10800 1 EEST}
- {1980198000 7200 0 EET}
- {1998345600 10800 1 EEST}
- {2011647600 7200 0 EET}
- {2029795200 10800 1 EEST}
- {2043097200 7200 0 EET}
- {2061244800 10800 1 EEST}
- {2074546800 7200 0 EET}
- {2092694400 10800 1 EEST}
- {2105996400 7200 0 EET}
- {2124144000 10800 1 EEST}
- {2137446000 7200 0 EET}
- {2156198400 10800 1 EEST}
- {2169500400 7200 0 EET}
- {2187648000 10800 1 EEST}
- {2200950000 7200 0 EET}
- {2219097600 10800 1 EEST}
- {2232399600 7200 0 EET}
- {2250547200 10800 1 EEST}
- {2263849200 7200 0 EET}
- {2281996800 10800 1 EEST}
- {2295298800 7200 0 EET}
- {2313446400 10800 1 EEST}
- {2326748400 7200 0 EET}
- {2345500800 10800 1 EEST}
- {2358802800 7200 0 EET}
- {2376950400 10800 1 EEST}
- {2390252400 7200 0 EET}
- {2408400000 10800 1 EEST}
- {2421702000 7200 0 EET}
- {2439849600 10800 1 EEST}
- {2453151600 7200 0 EET}
- {2471299200 10800 1 EEST}
- {2484601200 7200 0 EET}
- {2503353600 10800 1 EEST}
- {2516655600 7200 0 EET}
- {2534803200 10800 1 EEST}
- {2548105200 7200 0 EET}
- {2566252800 10800 1 EEST}
- {2579554800 7200 0 EET}
- {2597702400 10800 1 EEST}
- {2611004400 7200 0 EET}
- {2629152000 10800 1 EEST}
- {2642454000 7200 0 EET}
- {2660601600 10800 1 EEST}
- {2673903600 7200 0 EET}
- {2692656000 10800 1 EEST}
- {2705958000 7200 0 EET}
- {2724105600 10800 1 EEST}
- {2737407600 7200 0 EET}
- {2755555200 10800 1 EEST}
- {2768857200 7200 0 EET}
- {2787004800 10800 1 EEST}
- {2800306800 7200 0 EET}
- {2818454400 10800 1 EEST}
- {2831756400 7200 0 EET}
- {2850508800 10800 1 EEST}
- {2863810800 7200 0 EET}
- {2881958400 10800 1 EEST}
- {2895260400 7200 0 EET}
- {2913408000 10800 1 EEST}
- {2926710000 7200 0 EET}
- {2944857600 10800 1 EEST}
- {2958159600 7200 0 EET}
- {2976307200 10800 1 EEST}
- {2989609200 7200 0 EET}
- {3007756800 10800 1 EEST}
- {3021058800 7200 0 EET}
- {3039811200 10800 1 EEST}
- {3053113200 7200 0 EET}
- {3071260800 10800 1 EEST}
- {3084562800 7200 0 EET}
- {3102710400 10800 1 EEST}
- {3116012400 7200 0 EET}
- {3134160000 10800 1 EEST}
- {3147462000 7200 0 EET}
- {3165609600 10800 1 EEST}
- {3178911600 7200 0 EET}
- {3197059200 10800 1 EEST}
- {3210361200 7200 0 EET}
- {3229113600 10800 1 EEST}
- {3242415600 7200 0 EET}
- {3260563200 10800 1 EEST}
- {3273865200 7200 0 EET}
- {3292012800 10800 1 EEST}
- {3305314800 7200 0 EET}
- {3323462400 10800 1 EEST}
- {3336764400 7200 0 EET}
- {3354912000 10800 1 EEST}
- {3368214000 7200 0 EET}
- {3386966400 10800 1 EEST}
- {3400268400 7200 0 EET}
- {3418416000 10800 1 EEST}
- {3431718000 7200 0 EET}
- {3449865600 10800 1 EEST}
- {3463167600 7200 0 EET}
- {3481315200 10800 1 EEST}
- {3494617200 7200 0 EET}
- {3512764800 10800 1 EEST}
- {3526066800 7200 0 EET}
- {3544214400 10800 1 EEST}
- {3557516400 7200 0 EET}
- {3576268800 10800 1 EEST}
- {3589570800 7200 0 EET}
- {3607718400 10800 1 EEST}
- {3621020400 7200 0 EET}
- {3639168000 10800 1 EEST}
- {3652470000 7200 0 EET}
- {3670617600 10800 1 EEST}
- {3683919600 7200 0 EET}
- {3702067200 10800 1 EEST}
- {3715369200 7200 0 EET}
- {3734121600 10800 1 EEST}
- {3747423600 7200 0 EET}
- {3765571200 10800 1 EEST}
- {3778873200 7200 0 EET}
- {3797020800 10800 1 EEST}
- {3810322800 7200 0 EET}
- {3828470400 10800 1 EEST}
- {3841772400 7200 0 EET}
- {3859920000 10800 1 EEST}
- {3873222000 7200 0 EET}
- {3891369600 10800 1 EEST}
- {3904671600 7200 0 EET}
- {3923424000 10800 1 EEST}
- {3936726000 7200 0 EET}
- {3954873600 10800 1 EEST}
- {3968175600 7200 0 EET}
- {3986323200 10800 1 EEST}
- {3999625200 7200 0 EET}
- {4017772800 10800 1 EEST}
- {4031074800 7200 0 EET}
- {4049222400 10800 1 EEST}
- {4062524400 7200 0 EET}
- {4080672000 10800 1 EEST}
- {4093974000 7200 0 EET}
+ {799020000 10800 1 EEST}
+ {812322000 7200 0 EET}
+ {830469600 10800 1 EEST}
+ {843771600 7200 0 EET}
+ {861919200 10800 1 EEST}
+ {875221200 7200 0 EET}
+ {893368800 10800 1 EEST}
+ {906670800 7200 0 EET}
+ {925423200 10800 1 EEST}
+ {938725200 7200 0 EET}
+ {956872800 10800 1 EEST}
+ {970174800 7200 0 EET}
+ {988322400 10800 1 EEST}
+ {1001624400 7200 0 EET}
+ {1019772000 10800 1 EEST}
+ {1033074000 7200 0 EET}
+ {1051221600 10800 1 EEST}
+ {1064523600 7200 0 EET}
+ {1083276000 10800 1 EEST}
+ {1096578000 7200 0 EET}
+ {1114725600 10800 1 EEST}
+ {1128027600 7200 0 EET}
+ {1146175200 10800 1 EEST}
+ {1158872400 7200 0 EET}
+ {1177624800 10800 1 EEST}
+ {1189112400 7200 0 EET}
+ {1209074400 10800 1 EEST}
+ {1219957200 7200 0 EET}
+ {1240524000 10800 1 EEST}
+ {1250802000 7200 0 EET}
+ {1272578400 10800 1 EEST}
+ {1281474000 7200 0 EET}
+ {1284069600 10800 1 EEST}
+ {1285880400 7200 0 EET}
}
diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca
index 112aa19..dec2778 100644
--- a/library/tzdata/Africa/Casablanca
+++ b/library/tzdata/Africa/Casablanca
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Casablanca) {
{-9223372036854775808 -1820 0 LMT}
@@ -21,4 +21,148 @@ set TZData(:Africa/Casablanca) {
{271033200 0 0 WET}
{448243200 3600 0 CET}
{504918000 0 0 WET}
+ {1212278400 3600 1 WEST}
+ {1220223600 0 0 WET}
+ {1243814400 3600 1 WEST}
+ {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}
+ {1373162400 0 0 WET}
+ {1376100000 3600 1 WEST}
+ {1382839200 0 0 WET}
+ {1396144800 3600 1 WEST}
+ {1404007200 0 0 WET}
+ {1406599200 3600 1 WEST}
+ {1414288800 0 0 WET}
+ {1427594400 3600 1 WEST}
+ {1434592800 0 0 WET}
+ {1437184800 3600 1 WEST}
+ {1445738400 0 0 WET}
+ {1459044000 3600 1 WEST}
+ {1465264800 0 0 WET}
+ {1467856800 3600 1 WEST}
+ {1477792800 0 0 WET}
+ {1490493600 3600 1 WEST}
+ {1495850400 0 0 WET}
+ {1498442400 3600 1 WEST}
+ {1509242400 0 0 WET}
+ {1521943200 3600 1 WEST}
+ {1526436000 0 0 WET}
+ {1529028000 3600 1 WEST}
+ {1540692000 0 0 WET}
+ {1553997600 3600 1 WEST}
+ {1557108000 0 0 WET}
+ {1559700000 3600 1 WEST}
+ {1572141600 0 0 WET}
+ {1585447200 3600 1 WEST}
+ {1587693600 0 0 WET}
+ {1590285600 3600 1 WEST}
+ {1603591200 0 0 WET}
+ {1616896800 3600 1 WEST}
+ {1618279200 0 0 WET}
+ {1620871200 3600 1 WEST}
+ {1635645600 0 0 WET}
+ {1648346400 3600 1 WEST}
+ {1648951200 0 0 WET}
+ {1651543200 3600 1 WEST}
+ {1667095200 0 0 WET}
+ {1682128800 3600 1 WEST}
+ {1698544800 0 0 WET}
+ {1712714400 3600 1 WEST}
+ {1729994400 0 0 WET}
+ {1743386400 3600 1 WEST}
+ {1761444000 0 0 WET}
+ {1774749600 3600 1 WEST}
+ {1792893600 0 0 WET}
+ {1806199200 3600 1 WEST}
+ {1824948000 0 0 WET}
+ {1837648800 3600 1 WEST}
+ {1856397600 0 0 WET}
+ {1869098400 3600 1 WEST}
+ {1887847200 0 0 WET}
+ {1901152800 3600 1 WEST}
+ {1919296800 0 0 WET}
+ {1932602400 3600 1 WEST}
+ {1950746400 0 0 WET}
+ {1964052000 3600 1 WEST}
+ {1982800800 0 0 WET}
+ {1995501600 3600 1 WEST}
+ {2014250400 0 0 WET}
+ {2026951200 3600 1 WEST}
+ {2045700000 0 0 WET}
+ {2058400800 3600 1 WEST}
+ {2077149600 0 0 WET}
+ {2090455200 3600 1 WEST}
+ {2108167200 0 0 WET}
+ {2121904800 3600 1 WEST}
+ {2138839200 0 0 WET}
+ {2153354400 3600 1 WEST}
+ {2184800400 3600 1 WEST}
+ {2216250000 3600 1 WEST}
+ {2248304400 3600 1 WEST}
+ {2279754000 3600 1 WEST}
+ {2311203600 3600 1 WEST}
+ {2342653200 3600 1 WEST}
+ {2374102800 3600 1 WEST}
+ {2405552400 3600 1 WEST}
+ {2437606800 3600 1 WEST}
+ {2469056400 3600 1 WEST}
+ {2500506000 3600 1 WEST}
+ {2531955600 3600 1 WEST}
+ {2563405200 3600 1 WEST}
+ {2595459600 3600 1 WEST}
+ {2626909200 3600 1 WEST}
+ {2658358800 3600 1 WEST}
+ {2689808400 3600 1 WEST}
+ {2721258000 3600 1 WEST}
+ {2752707600 3600 1 WEST}
+ {2784762000 3600 1 WEST}
+ {2816211600 3600 1 WEST}
+ {2847661200 3600 1 WEST}
+ {2879110800 3600 1 WEST}
+ {2910560400 3600 1 WEST}
+ {2942010000 3600 1 WEST}
+ {2974064400 3600 1 WEST}
+ {3005514000 3600 1 WEST}
+ {3036963600 3600 1 WEST}
+ {3068413200 3600 1 WEST}
+ {3099862800 3600 1 WEST}
+ {3131917200 3600 1 WEST}
+ {3163366800 3600 1 WEST}
+ {3194816400 3600 1 WEST}
+ {3226266000 3600 1 WEST}
+ {3257715600 3600 1 WEST}
+ {3289165200 3600 1 WEST}
+ {3321219600 3600 1 WEST}
+ {3352669200 3600 1 WEST}
+ {3384118800 3600 1 WEST}
+ {3415568400 3600 1 WEST}
+ {3447018000 3600 1 WEST}
+ {3479072400 3600 1 WEST}
+ {3510522000 3600 1 WEST}
+ {3541971600 3600 1 WEST}
+ {3573421200 3600 1 WEST}
+ {3604870800 3600 1 WEST}
+ {3636320400 3600 1 WEST}
+ {3668374800 3600 1 WEST}
+ {3699824400 3600 1 WEST}
+ {3731274000 3600 1 WEST}
+ {3762723600 3600 1 WEST}
+ {3794173200 3600 1 WEST}
+ {3825622800 3600 1 WEST}
+ {3857677200 3600 1 WEST}
+ {3889126800 3600 1 WEST}
+ {3920576400 3600 1 WEST}
+ {3952026000 3600 1 WEST}
+ {3983475600 3600 1 WEST}
+ {4015530000 3600 1 WEST}
+ {4046979600 3600 1 WEST}
+ {4078429200 3600 1 WEST}
}
diff --git a/library/tzdata/Africa/Ceuta b/library/tzdata/Africa/Ceuta
index bcbbd8c..882c13d 100644
--- a/library/tzdata/Africa/Ceuta
+++ b/library/tzdata/Africa/Ceuta
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Ceuta) {
{-9223372036854775808 -1276 0 LMT}
diff --git a/library/tzdata/Africa/Conakry b/library/tzdata/Africa/Conakry
index 5616f15..d17ce4b 100644
--- a/library/tzdata/Africa/Conakry
+++ b/library/tzdata/Africa/Conakry
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Conakry) {
{-9223372036854775808 -3292 0 LMT}
diff --git a/library/tzdata/Africa/Dakar b/library/tzdata/Africa/Dakar
index 7ac0d9e..487dc62 100644
--- a/library/tzdata/Africa/Dakar
+++ b/library/tzdata/Africa/Dakar
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Dakar) {
{-9223372036854775808 -4184 0 LMT}
diff --git a/library/tzdata/Africa/Dar_es_Salaam b/library/tzdata/Africa/Dar_es_Salaam
index 7241049..98151ec 100644
--- a/library/tzdata/Africa/Dar_es_Salaam
+++ b/library/tzdata/Africa/Dar_es_Salaam
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/Djibouti b/library/tzdata/Africa/Djibouti
index 557ef33..0ec510c 100644
--- a/library/tzdata/Africa/Djibouti
+++ b/library/tzdata/Africa/Djibouti
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Djibouti) {
{-9223372036854775808 10356 0 LMT}
diff --git a/library/tzdata/Africa/Douala b/library/tzdata/Africa/Douala
index 8285f19..301a530 100644
--- a/library/tzdata/Africa/Douala
+++ b/library/tzdata/Africa/Douala
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Douala) {
{-9223372036854775808 2328 0 LMT}
diff --git a/library/tzdata/Africa/El_Aaiun b/library/tzdata/Africa/El_Aaiun
index 8e19ea7..a8b9d34 100644
--- a/library/tzdata/Africa/El_Aaiun
+++ b/library/tzdata/Africa/El_Aaiun
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/El_Aaiun) {
{-9223372036854775808 -3168 0 LMT}
diff --git a/library/tzdata/Africa/Freetown b/library/tzdata/Africa/Freetown
index 023593a..c3f2d2e 100644
--- a/library/tzdata/Africa/Freetown
+++ b/library/tzdata/Africa/Freetown
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Freetown) {
{-9223372036854775808 -3180 0 LMT}
diff --git a/library/tzdata/Africa/Gaborone b/library/tzdata/Africa/Gaborone
index 8a7c211..bd38673 100644
--- a/library/tzdata/Africa/Gaborone
+++ b/library/tzdata/Africa/Gaborone
@@ -1,8 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Gaborone) {
{-9223372036854775808 6220 0 LMT}
- {-2682294220 7200 0 CAT}
+ {-2682294220 5400 0 SAST}
+ {-2109288600 7200 0 CAT}
{-829526400 10800 1 CAST}
{-813805200 7200 0 CAT}
}
diff --git a/library/tzdata/Africa/Harare b/library/tzdata/Africa/Harare
index 14b348e..7482b15 100644
--- a/library/tzdata/Africa/Harare
+++ b/library/tzdata/Africa/Harare
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Harare) {
{-9223372036854775808 7452 0 LMT}
diff --git a/library/tzdata/Africa/Johannesburg b/library/tzdata/Africa/Johannesburg
index c1bfa32..b9a8348 100644
--- a/library/tzdata/Africa/Johannesburg
+++ b/library/tzdata/Africa/Johannesburg
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Johannesburg) {
{-9223372036854775808 6720 0 LMT}
diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba
new file mode 100644
index 0000000..40551f2
--- /dev/null
+++ b/library/tzdata/Africa/Juba
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Africa/Khartoum)]} {
+ LoadTimeZoneFile Africa/Khartoum
+}
+set TZData(:Africa/Juba) $TZData(:Africa/Khartoum)
diff --git a/library/tzdata/Africa/Kampala b/library/tzdata/Africa/Kampala
index e60b1ef..4cc9be1 100644
--- a/library/tzdata/Africa/Kampala
+++ b/library/tzdata/Africa/Kampala
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/Khartoum b/library/tzdata/Africa/Khartoum
index ca16638..dfcac82 100644
--- a/library/tzdata/Africa/Khartoum
+++ b/library/tzdata/Africa/Khartoum
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Khartoum) {
{-9223372036854775808 7808 0 LMT}
diff --git a/library/tzdata/Africa/Kigali b/library/tzdata/Africa/Kigali
index 3797e98..f723bcd 100644
--- a/library/tzdata/Africa/Kigali
+++ b/library/tzdata/Africa/Kigali
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Kigali) {
{-9223372036854775808 7216 0 LMT}
diff --git a/library/tzdata/Africa/Kinshasa b/library/tzdata/Africa/Kinshasa
index 30a3257..050c1fa 100644
--- a/library/tzdata/Africa/Kinshasa
+++ b/library/tzdata/Africa/Kinshasa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Kinshasa) {
{-9223372036854775808 3672 0 LMT}
diff --git a/library/tzdata/Africa/Lagos b/library/tzdata/Africa/Lagos
index 11f5718..079572f 100644
--- a/library/tzdata/Africa/Lagos
+++ b/library/tzdata/Africa/Lagos
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Lagos) {
{-9223372036854775808 816 0 LMT}
diff --git a/library/tzdata/Africa/Libreville b/library/tzdata/Africa/Libreville
index 6ea75d9..8427551 100644
--- a/library/tzdata/Africa/Libreville
+++ b/library/tzdata/Africa/Libreville
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Libreville) {
{-9223372036854775808 2268 0 LMT}
diff --git a/library/tzdata/Africa/Lome b/library/tzdata/Africa/Lome
index e9a0c79..606625c 100644
--- a/library/tzdata/Africa/Lome
+++ b/library/tzdata/Africa/Lome
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Lome) {
{-9223372036854775808 292 0 LMT}
diff --git a/library/tzdata/Africa/Luanda b/library/tzdata/Africa/Luanda
index 4a2e1fe..cd1b29e 100644
--- a/library/tzdata/Africa/Luanda
+++ b/library/tzdata/Africa/Luanda
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Luanda) {
{-9223372036854775808 3176 0 LMT}
diff --git a/library/tzdata/Africa/Lubumbashi b/library/tzdata/Africa/Lubumbashi
index 4550406..bd67221 100644
--- a/library/tzdata/Africa/Lubumbashi
+++ b/library/tzdata/Africa/Lubumbashi
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Lubumbashi) {
{-9223372036854775808 6592 0 LMT}
diff --git a/library/tzdata/Africa/Lusaka b/library/tzdata/Africa/Lusaka
index c508d5c..ed9c30d 100644
--- a/library/tzdata/Africa/Lusaka
+++ b/library/tzdata/Africa/Lusaka
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Lusaka) {
{-9223372036854775808 6788 0 LMT}
diff --git a/library/tzdata/Africa/Malabo b/library/tzdata/Africa/Malabo
index f395c19..bec0524 100644
--- a/library/tzdata/Africa/Malabo
+++ b/library/tzdata/Africa/Malabo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Malabo) {
{-9223372036854775808 2108 0 LMT}
diff --git a/library/tzdata/Africa/Maputo b/library/tzdata/Africa/Maputo
index 9568fd9..6ee208c 100644
--- a/library/tzdata/Africa/Maputo
+++ b/library/tzdata/Africa/Maputo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Maputo) {
{-9223372036854775808 7820 0 LMT}
diff --git a/library/tzdata/Africa/Maseru b/library/tzdata/Africa/Maseru
index b580c60..21ca968 100644
--- a/library/tzdata/Africa/Maseru
+++ b/library/tzdata/Africa/Maseru
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Maseru) {
{-9223372036854775808 6600 0 LMT}
diff --git a/library/tzdata/Africa/Mbabane b/library/tzdata/Africa/Mbabane
index 016ba4c..4d174d5 100644
--- a/library/tzdata/Africa/Mbabane
+++ b/library/tzdata/Africa/Mbabane
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Mbabane) {
{-9223372036854775808 7464 0 LMT}
diff --git a/library/tzdata/Africa/Mogadishu b/library/tzdata/Africa/Mogadishu
index fa6ffd8..570d3ea 100644
--- a/library/tzdata/Africa/Mogadishu
+++ b/library/tzdata/Africa/Mogadishu
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Mogadishu) {
{-9223372036854775808 10888 0 LMT}
diff --git a/library/tzdata/Africa/Monrovia b/library/tzdata/Africa/Monrovia
index b2a95a1..1cfff58 100644
--- a/library/tzdata/Africa/Monrovia
+++ b/library/tzdata/Africa/Monrovia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Monrovia) {
{-9223372036854775808 -2588 0 LMT}
diff --git a/library/tzdata/Africa/Nairobi b/library/tzdata/Africa/Nairobi
index 72347b4..6846069 100644
--- a/library/tzdata/Africa/Nairobi
+++ b/library/tzdata/Africa/Nairobi
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/Africa/Ndjamena b/library/tzdata/Africa/Ndjamena
index 708e170..af4daaa 100644
--- a/library/tzdata/Africa/Ndjamena
+++ b/library/tzdata/Africa/Ndjamena
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Ndjamena) {
{-9223372036854775808 3612 0 LMT}
diff --git a/library/tzdata/Africa/Niamey b/library/tzdata/Africa/Niamey
index d24669e..40ded06b 100644
--- a/library/tzdata/Africa/Niamey
+++ b/library/tzdata/Africa/Niamey
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Niamey) {
{-9223372036854775808 508 0 LMT}
diff --git a/library/tzdata/Africa/Nouakchott b/library/tzdata/Africa/Nouakchott
index c371851..f7369d0 100644
--- a/library/tzdata/Africa/Nouakchott
+++ b/library/tzdata/Africa/Nouakchott
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Nouakchott) {
{-9223372036854775808 -3828 0 LMT}
diff --git a/library/tzdata/Africa/Ouagadougou b/library/tzdata/Africa/Ouagadougou
index 7a11628..88a7145 100644
--- a/library/tzdata/Africa/Ouagadougou
+++ b/library/tzdata/Africa/Ouagadougou
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Ouagadougou) {
{-9223372036854775808 -364 0 LMT}
diff --git a/library/tzdata/Africa/Porto-Novo b/library/tzdata/Africa/Porto-Novo
index 4a4b800..b89cf1b 100644
--- a/library/tzdata/Africa/Porto-Novo
+++ b/library/tzdata/Africa/Porto-Novo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Porto-Novo) {
{-9223372036854775808 628 0 LMT}
diff --git a/library/tzdata/Africa/Sao_Tome b/library/tzdata/Africa/Sao_Tome
index dc2ea51..ab1590d 100644
--- a/library/tzdata/Africa/Sao_Tome
+++ b/library/tzdata/Africa/Sao_Tome
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Sao_Tome) {
{-9223372036854775808 1616 0 LMT}
diff --git a/library/tzdata/Africa/Timbuktu b/library/tzdata/Africa/Timbuktu
index 2afdf6f..8057eed 100644
--- a/library/tzdata/Africa/Timbuktu
+++ b/library/tzdata/Africa/Timbuktu
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Africa/Timbuktu) {
- {-9223372036854775808 -724 0 LMT}
- {-1830383276 0 0 GMT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Africa/Bamako)]} {
+ LoadTimeZoneFile Africa/Bamako
}
+set TZData(:Africa/Timbuktu) $TZData(:Africa/Bamako)
diff --git a/library/tzdata/Africa/Tripoli b/library/tzdata/Africa/Tripoli
index 4b53eee..ac78218 100644
--- a/library/tzdata/Africa/Tripoli
+++ b/library/tzdata/Africa/Tripoli
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Tripoli) {
{-9223372036854775808 3164 0 LMT}
@@ -27,5 +27,180 @@ set TZData(:Africa/Tripoli) {
{641775600 7200 0 EET}
{844034400 3600 0 CET}
{860108400 7200 1 CEST}
- {875916000 7200 0 EET}
+ {875919600 7200 0 EET}
+ {1352505600 3600 0 CET}
+ {1364515200 7200 1 CEST}
+ {1382659200 3600 0 CET}
+ {1395964800 7200 1 CEST}
+ {1414713600 3600 0 CET}
+ {1427414400 7200 1 CEST}
+ {1446163200 3600 0 CET}
+ {1458864000 7200 1 CEST}
+ {1477612800 3600 0 CET}
+ {1490918400 7200 1 CEST}
+ {1509062400 3600 0 CET}
+ {1522368000 7200 1 CEST}
+ {1540512000 3600 0 CET}
+ {1553817600 7200 1 CEST}
+ {1571961600 3600 0 CET}
+ {1585267200 7200 1 CEST}
+ {1604016000 3600 0 CET}
+ {1616716800 7200 1 CEST}
+ {1635465600 3600 0 CET}
+ {1648166400 7200 1 CEST}
+ {1666915200 3600 0 CET}
+ {1680220800 7200 1 CEST}
+ {1698364800 3600 0 CET}
+ {1711670400 7200 1 CEST}
+ {1729814400 3600 0 CET}
+ {1743120000 7200 1 CEST}
+ {1761868800 3600 0 CET}
+ {1774569600 7200 1 CEST}
+ {1793318400 3600 0 CET}
+ {1806019200 7200 1 CEST}
+ {1824768000 3600 0 CET}
+ {1838073600 7200 1 CEST}
+ {1856217600 3600 0 CET}
+ {1869523200 7200 1 CEST}
+ {1887667200 3600 0 CET}
+ {1900972800 7200 1 CEST}
+ {1919116800 3600 0 CET}
+ {1932422400 7200 1 CEST}
+ {1951171200 3600 0 CET}
+ {1963872000 7200 1 CEST}
+ {1982620800 3600 0 CET}
+ {1995321600 7200 1 CEST}
+ {2014070400 3600 0 CET}
+ {2027376000 7200 1 CEST}
+ {2045520000 3600 0 CET}
+ {2058825600 7200 1 CEST}
+ {2076969600 3600 0 CET}
+ {2090275200 7200 1 CEST}
+ {2109024000 3600 0 CET}
+ {2121724800 7200 1 CEST}
+ {2140473600 3600 0 CET}
+ {2153174400 7200 1 CEST}
+ {2171923200 3600 0 CET}
+ {2184624000 7200 1 CEST}
+ {2203372800 3600 0 CET}
+ {2216678400 7200 1 CEST}
+ {2234822400 3600 0 CET}
+ {2248128000 7200 1 CEST}
+ {2266272000 3600 0 CET}
+ {2279577600 7200 1 CEST}
+ {2298326400 3600 0 CET}
+ {2311027200 7200 1 CEST}
+ {2329776000 3600 0 CET}
+ {2342476800 7200 1 CEST}
+ {2361225600 3600 0 CET}
+ {2374531200 7200 1 CEST}
+ {2392675200 3600 0 CET}
+ {2405980800 7200 1 CEST}
+ {2424124800 3600 0 CET}
+ {2437430400 7200 1 CEST}
+ {2455574400 3600 0 CET}
+ {2468880000 7200 1 CEST}
+ {2487628800 3600 0 CET}
+ {2500329600 7200 1 CEST}
+ {2519078400 3600 0 CET}
+ {2531779200 7200 1 CEST}
+ {2550528000 3600 0 CET}
+ {2563833600 7200 1 CEST}
+ {2581977600 3600 0 CET}
+ {2595283200 7200 1 CEST}
+ {2613427200 3600 0 CET}
+ {2626732800 7200 1 CEST}
+ {2645481600 3600 0 CET}
+ {2658182400 7200 1 CEST}
+ {2676931200 3600 0 CET}
+ {2689632000 7200 1 CEST}
+ {2708380800 3600 0 CET}
+ {2721686400 7200 1 CEST}
+ {2739830400 3600 0 CET}
+ {2753136000 7200 1 CEST}
+ {2771280000 3600 0 CET}
+ {2784585600 7200 1 CEST}
+ {2802729600 3600 0 CET}
+ {2816035200 7200 1 CEST}
+ {2834784000 3600 0 CET}
+ {2847484800 7200 1 CEST}
+ {2866233600 3600 0 CET}
+ {2878934400 7200 1 CEST}
+ {2897683200 3600 0 CET}
+ {2910988800 7200 1 CEST}
+ {2929132800 3600 0 CET}
+ {2942438400 7200 1 CEST}
+ {2960582400 3600 0 CET}
+ {2973888000 7200 1 CEST}
+ {2992636800 3600 0 CET}
+ {3005337600 7200 1 CEST}
+ {3024086400 3600 0 CET}
+ {3036787200 7200 1 CEST}
+ {3055536000 3600 0 CET}
+ {3068236800 7200 1 CEST}
+ {3086985600 3600 0 CET}
+ {3100291200 7200 1 CEST}
+ {3118435200 3600 0 CET}
+ {3131740800 7200 1 CEST}
+ {3149884800 3600 0 CET}
+ {3163190400 7200 1 CEST}
+ {3181939200 3600 0 CET}
+ {3194640000 7200 1 CEST}
+ {3213388800 3600 0 CET}
+ {3226089600 7200 1 CEST}
+ {3244838400 3600 0 CET}
+ {3258144000 7200 1 CEST}
+ {3276288000 3600 0 CET}
+ {3289593600 7200 1 CEST}
+ {3307737600 3600 0 CET}
+ {3321043200 7200 1 CEST}
+ {3339187200 3600 0 CET}
+ {3352492800 7200 1 CEST}
+ {3371241600 3600 0 CET}
+ {3383942400 7200 1 CEST}
+ {3402691200 3600 0 CET}
+ {3415392000 7200 1 CEST}
+ {3434140800 3600 0 CET}
+ {3447446400 7200 1 CEST}
+ {3465590400 3600 0 CET}
+ {3478896000 7200 1 CEST}
+ {3497040000 3600 0 CET}
+ {3510345600 7200 1 CEST}
+ {3529094400 3600 0 CET}
+ {3541795200 7200 1 CEST}
+ {3560544000 3600 0 CET}
+ {3573244800 7200 1 CEST}
+ {3591993600 3600 0 CET}
+ {3605299200 7200 1 CEST}
+ {3623443200 3600 0 CET}
+ {3636748800 7200 1 CEST}
+ {3654892800 3600 0 CET}
+ {3668198400 7200 1 CEST}
+ {3686342400 3600 0 CET}
+ {3699648000 7200 1 CEST}
+ {3718396800 3600 0 CET}
+ {3731097600 7200 1 CEST}
+ {3749846400 3600 0 CET}
+ {3762547200 7200 1 CEST}
+ {3781296000 3600 0 CET}
+ {3794601600 7200 1 CEST}
+ {3812745600 3600 0 CET}
+ {3826051200 7200 1 CEST}
+ {3844195200 3600 0 CET}
+ {3857500800 7200 1 CEST}
+ {3876249600 3600 0 CET}
+ {3888950400 7200 1 CEST}
+ {3907699200 3600 0 CET}
+ {3920400000 7200 1 CEST}
+ {3939148800 3600 0 CET}
+ {3951849600 7200 1 CEST}
+ {3970598400 3600 0 CET}
+ {3983904000 7200 1 CEST}
+ {4002048000 3600 0 CET}
+ {4015353600 7200 1 CEST}
+ {4033497600 3600 0 CET}
+ {4046803200 7200 1 CEST}
+ {4065552000 3600 0 CET}
+ {4078252800 7200 1 CEST}
+ {4097001600 3600 0 CET}
}
diff --git a/library/tzdata/Africa/Tunis b/library/tzdata/Africa/Tunis
index cc1740d..0c1db4d 100644
--- a/library/tzdata/Africa/Tunis
+++ b/library/tzdata/Africa/Tunis
@@ -1,12 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Tunis) {
{-9223372036854775808 2444 0 LMT}
{-2797202444 561 0 PMT}
{-1855958961 3600 0 CET}
- {-969238800 7200 1 CEST}
- {-950490000 3600 0 CET}
- {-941936400 7200 1 CEST}
+ {-969242400 7200 1 CEST}
+ {-950493600 3600 0 CET}
+ {-941940000 7200 1 CEST}
{-891136800 3600 0 CET}
{-877827600 7200 1 CEST}
{-857257200 3600 0 CET}
@@ -18,14 +18,22 @@ set TZData(:Africa/Tunis) {
{-796269600 3600 0 CET}
{-781052400 7200 1 CEST}
{-766634400 3600 0 CET}
- {231206400 7200 1 CEST}
- {243907200 3600 0 CET}
- {262828800 7200 1 CEST}
- {276048000 3600 0 CET}
- {581126400 7200 1 CEST}
- {591148800 3600 0 CET}
- {606873600 7200 1 CEST}
- {622598400 3600 0 CET}
- {641520000 7200 1 CEST}
- {654652800 3600 0 CET}
+ {231202800 7200 1 CEST}
+ {243903600 3600 0 CET}
+ {262825200 7200 1 CEST}
+ {276044400 3600 0 CET}
+ {581122800 7200 1 CEST}
+ {591145200 3600 0 CET}
+ {606870000 7200 1 CEST}
+ {622594800 3600 0 CET}
+ {641516400 7200 1 CEST}
+ {654649200 3600 0 CET}
+ {1114902000 7200 1 CEST}
+ {1128038400 3600 0 CET}
+ {1143334800 7200 1 CEST}
+ {1162083600 3600 0 CET}
+ {1174784400 7200 1 CEST}
+ {1193533200 3600 0 CET}
+ {1206838800 7200 1 CEST}
+ {1224982800 3600 0 CET}
}
diff --git a/library/tzdata/Africa/Windhoek b/library/tzdata/Africa/Windhoek
index a5dcd4b..a655f2e 100644
--- a/library/tzdata/Africa/Windhoek
+++ b/library/tzdata/Africa/Windhoek
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Africa/Windhoek) {
{-9223372036854775808 4104 0 LMT}
diff --git a/library/tzdata/America/Adak b/library/tzdata/America/Adak
index 1852c32..f3c5e5c 100644
--- a/library/tzdata/America/Adak
+++ b/library/tzdata/America/Adak
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Adak) {
{-9223372036854775808 44001 0 LMT}
@@ -87,190 +87,190 @@ set TZData(:America/Adak) {
{1130670000 -36000 0 HAST}
{1143979200 -32400 1 HADT}
{1162119600 -36000 0 HAST}
- {1175428800 -32400 1 HADT}
- {1193569200 -36000 0 HAST}
- {1207483200 -32400 1 HADT}
- {1225018800 -36000 0 HAST}
- {1238932800 -32400 1 HADT}
- {1256468400 -36000 0 HAST}
- {1270382400 -32400 1 HADT}
- {1288522800 -36000 0 HAST}
- {1301832000 -32400 1 HADT}
- {1319972400 -36000 0 HAST}
- {1333281600 -32400 1 HADT}
- {1351422000 -36000 0 HAST}
- {1365336000 -32400 1 HADT}
- {1382871600 -36000 0 HAST}
- {1396785600 -32400 1 HADT}
- {1414321200 -36000 0 HAST}
- {1428235200 -32400 1 HADT}
- {1445770800 -36000 0 HAST}
- {1459684800 -32400 1 HADT}
- {1477825200 -36000 0 HAST}
- {1491134400 -32400 1 HADT}
- {1509274800 -36000 0 HAST}
- {1522584000 -32400 1 HADT}
- {1540724400 -36000 0 HAST}
- {1554638400 -32400 1 HADT}
- {1572174000 -36000 0 HAST}
- {1586088000 -32400 1 HADT}
- {1603623600 -36000 0 HAST}
- {1617537600 -32400 1 HADT}
- {1635678000 -36000 0 HAST}
- {1648987200 -32400 1 HADT}
- {1667127600 -36000 0 HAST}
- {1680436800 -32400 1 HADT}
- {1698577200 -36000 0 HAST}
- {1712491200 -32400 1 HADT}
- {1730026800 -36000 0 HAST}
- {1743940800 -32400 1 HADT}
- {1761476400 -36000 0 HAST}
- {1775390400 -32400 1 HADT}
- {1792926000 -36000 0 HAST}
- {1806840000 -32400 1 HADT}
- {1824980400 -36000 0 HAST}
- {1838289600 -32400 1 HADT}
- {1856430000 -36000 0 HAST}
- {1869739200 -32400 1 HADT}
- {1887879600 -36000 0 HAST}
- {1901793600 -32400 1 HADT}
- {1919329200 -36000 0 HAST}
- {1933243200 -32400 1 HADT}
- {1950778800 -36000 0 HAST}
- {1964692800 -32400 1 HADT}
- {1982833200 -36000 0 HAST}
- {1996142400 -32400 1 HADT}
- {2014282800 -36000 0 HAST}
- {2027592000 -32400 1 HADT}
- {2045732400 -36000 0 HAST}
- {2059041600 -32400 1 HADT}
- {2077182000 -36000 0 HAST}
- {2091096000 -32400 1 HADT}
- {2108631600 -36000 0 HAST}
- {2122545600 -32400 1 HADT}
- {2140081200 -36000 0 HAST}
- {2153995200 -32400 1 HADT}
- {2172135600 -36000 0 HAST}
- {2185444800 -32400 1 HADT}
- {2203585200 -36000 0 HAST}
- {2216894400 -32400 1 HADT}
- {2235034800 -36000 0 HAST}
- {2248948800 -32400 1 HADT}
- {2266484400 -36000 0 HAST}
- {2280398400 -32400 1 HADT}
- {2297934000 -36000 0 HAST}
- {2311848000 -32400 1 HADT}
- {2329383600 -36000 0 HAST}
- {2343297600 -32400 1 HADT}
- {2361438000 -36000 0 HAST}
- {2374747200 -32400 1 HADT}
- {2392887600 -36000 0 HAST}
- {2406196800 -32400 1 HADT}
- {2424337200 -36000 0 HAST}
- {2438251200 -32400 1 HADT}
- {2455786800 -36000 0 HAST}
- {2469700800 -32400 1 HADT}
- {2487236400 -36000 0 HAST}
- {2501150400 -32400 1 HADT}
- {2519290800 -36000 0 HAST}
- {2532600000 -32400 1 HADT}
- {2550740400 -36000 0 HAST}
- {2564049600 -32400 1 HADT}
- {2582190000 -36000 0 HAST}
- {2596104000 -32400 1 HADT}
- {2613639600 -36000 0 HAST}
- {2627553600 -32400 1 HADT}
- {2645089200 -36000 0 HAST}
- {2659003200 -32400 1 HADT}
- {2676538800 -36000 0 HAST}
- {2690452800 -32400 1 HADT}
- {2708593200 -36000 0 HAST}
- {2721902400 -32400 1 HADT}
- {2740042800 -36000 0 HAST}
- {2753352000 -32400 1 HADT}
- {2771492400 -36000 0 HAST}
- {2785406400 -32400 1 HADT}
- {2802942000 -36000 0 HAST}
- {2816856000 -32400 1 HADT}
- {2834391600 -36000 0 HAST}
- {2848305600 -32400 1 HADT}
- {2866446000 -36000 0 HAST}
- {2879755200 -32400 1 HADT}
- {2897895600 -36000 0 HAST}
- {2911204800 -32400 1 HADT}
- {2929345200 -36000 0 HAST}
- {2942654400 -32400 1 HADT}
- {2960794800 -36000 0 HAST}
- {2974708800 -32400 1 HADT}
- {2992244400 -36000 0 HAST}
- {3006158400 -32400 1 HADT}
- {3023694000 -36000 0 HAST}
- {3037608000 -32400 1 HADT}
- {3055748400 -36000 0 HAST}
- {3069057600 -32400 1 HADT}
- {3087198000 -36000 0 HAST}
- {3100507200 -32400 1 HADT}
- {3118647600 -36000 0 HAST}
- {3132561600 -32400 1 HADT}
- {3150097200 -36000 0 HAST}
- {3164011200 -32400 1 HADT}
- {3181546800 -36000 0 HAST}
- {3195460800 -32400 1 HADT}
- {3212996400 -36000 0 HAST}
- {3226910400 -32400 1 HADT}
- {3245050800 -36000 0 HAST}
- {3258360000 -32400 1 HADT}
- {3276500400 -36000 0 HAST}
- {3289809600 -32400 1 HADT}
- {3307950000 -36000 0 HAST}
- {3321864000 -32400 1 HADT}
- {3339399600 -36000 0 HAST}
- {3353313600 -32400 1 HADT}
- {3370849200 -36000 0 HAST}
- {3384763200 -32400 1 HADT}
- {3402903600 -36000 0 HAST}
- {3416212800 -32400 1 HADT}
- {3434353200 -36000 0 HAST}
- {3447662400 -32400 1 HADT}
- {3465802800 -36000 0 HAST}
- {3479716800 -32400 1 HADT}
- {3497252400 -36000 0 HAST}
- {3511166400 -32400 1 HADT}
- {3528702000 -36000 0 HAST}
- {3542616000 -32400 1 HADT}
- {3560151600 -36000 0 HAST}
- {3574065600 -32400 1 HADT}
- {3592206000 -36000 0 HAST}
- {3605515200 -32400 1 HADT}
- {3623655600 -36000 0 HAST}
- {3636964800 -32400 1 HADT}
- {3655105200 -36000 0 HAST}
- {3669019200 -32400 1 HADT}
- {3686554800 -36000 0 HAST}
- {3700468800 -32400 1 HADT}
- {3718004400 -36000 0 HAST}
- {3731918400 -32400 1 HADT}
- {3750058800 -36000 0 HAST}
- {3763368000 -32400 1 HADT}
- {3781508400 -36000 0 HAST}
- {3794817600 -32400 1 HADT}
- {3812958000 -36000 0 HAST}
- {3826267200 -32400 1 HADT}
- {3844407600 -36000 0 HAST}
- {3858321600 -32400 1 HADT}
- {3875857200 -36000 0 HAST}
- {3889771200 -32400 1 HADT}
- {3907306800 -36000 0 HAST}
- {3921220800 -32400 1 HADT}
- {3939361200 -36000 0 HAST}
- {3952670400 -32400 1 HADT}
- {3970810800 -36000 0 HAST}
- {3984120000 -32400 1 HADT}
- {4002260400 -36000 0 HAST}
- {4016174400 -32400 1 HADT}
- {4033710000 -36000 0 HAST}
- {4047624000 -32400 1 HADT}
- {4065159600 -36000 0 HAST}
- {4079073600 -32400 1 HADT}
- {4096609200 -36000 0 HAST}
+ {1173614400 -32400 1 HADT}
+ {1194174000 -36000 0 HAST}
+ {1205064000 -32400 1 HADT}
+ {1225623600 -36000 0 HAST}
+ {1236513600 -32400 1 HADT}
+ {1257073200 -36000 0 HAST}
+ {1268568000 -32400 1 HADT}
+ {1289127600 -36000 0 HAST}
+ {1300017600 -32400 1 HADT}
+ {1320577200 -36000 0 HAST}
+ {1331467200 -32400 1 HADT}
+ {1352026800 -36000 0 HAST}
+ {1362916800 -32400 1 HADT}
+ {1383476400 -36000 0 HAST}
+ {1394366400 -32400 1 HADT}
+ {1414926000 -36000 0 HAST}
+ {1425816000 -32400 1 HADT}
+ {1446375600 -36000 0 HAST}
+ {1457870400 -32400 1 HADT}
+ {1478430000 -36000 0 HAST}
+ {1489320000 -32400 1 HADT}
+ {1509879600 -36000 0 HAST}
+ {1520769600 -32400 1 HADT}
+ {1541329200 -36000 0 HAST}
+ {1552219200 -32400 1 HADT}
+ {1572778800 -36000 0 HAST}
+ {1583668800 -32400 1 HADT}
+ {1604228400 -36000 0 HAST}
+ {1615723200 -32400 1 HADT}
+ {1636282800 -36000 0 HAST}
+ {1647172800 -32400 1 HADT}
+ {1667732400 -36000 0 HAST}
+ {1678622400 -32400 1 HADT}
+ {1699182000 -36000 0 HAST}
+ {1710072000 -32400 1 HADT}
+ {1730631600 -36000 0 HAST}
+ {1741521600 -32400 1 HADT}
+ {1762081200 -36000 0 HAST}
+ {1772971200 -32400 1 HADT}
+ {1793530800 -36000 0 HAST}
+ {1805025600 -32400 1 HADT}
+ {1825585200 -36000 0 HAST}
+ {1836475200 -32400 1 HADT}
+ {1857034800 -36000 0 HAST}
+ {1867924800 -32400 1 HADT}
+ {1888484400 -36000 0 HAST}
+ {1899374400 -32400 1 HADT}
+ {1919934000 -36000 0 HAST}
+ {1930824000 -32400 1 HADT}
+ {1951383600 -36000 0 HAST}
+ {1962878400 -32400 1 HADT}
+ {1983438000 -36000 0 HAST}
+ {1994328000 -32400 1 HADT}
+ {2014887600 -36000 0 HAST}
+ {2025777600 -32400 1 HADT}
+ {2046337200 -36000 0 HAST}
+ {2057227200 -32400 1 HADT}
+ {2077786800 -36000 0 HAST}
+ {2088676800 -32400 1 HADT}
+ {2109236400 -36000 0 HAST}
+ {2120126400 -32400 1 HADT}
+ {2140686000 -36000 0 HAST}
+ {2152180800 -32400 1 HADT}
+ {2172740400 -36000 0 HAST}
+ {2183630400 -32400 1 HADT}
+ {2204190000 -36000 0 HAST}
+ {2215080000 -32400 1 HADT}
+ {2235639600 -36000 0 HAST}
+ {2246529600 -32400 1 HADT}
+ {2267089200 -36000 0 HAST}
+ {2277979200 -32400 1 HADT}
+ {2298538800 -36000 0 HAST}
+ {2309428800 -32400 1 HADT}
+ {2329988400 -36000 0 HAST}
+ {2341483200 -32400 1 HADT}
+ {2362042800 -36000 0 HAST}
+ {2372932800 -32400 1 HADT}
+ {2393492400 -36000 0 HAST}
+ {2404382400 -32400 1 HADT}
+ {2424942000 -36000 0 HAST}
+ {2435832000 -32400 1 HADT}
+ {2456391600 -36000 0 HAST}
+ {2467281600 -32400 1 HADT}
+ {2487841200 -36000 0 HAST}
+ {2499336000 -32400 1 HADT}
+ {2519895600 -36000 0 HAST}
+ {2530785600 -32400 1 HADT}
+ {2551345200 -36000 0 HAST}
+ {2562235200 -32400 1 HADT}
+ {2582794800 -36000 0 HAST}
+ {2593684800 -32400 1 HADT}
+ {2614244400 -36000 0 HAST}
+ {2625134400 -32400 1 HADT}
+ {2645694000 -36000 0 HAST}
+ {2656584000 -32400 1 HADT}
+ {2677143600 -36000 0 HAST}
+ {2688638400 -32400 1 HADT}
+ {2709198000 -36000 0 HAST}
+ {2720088000 -32400 1 HADT}
+ {2740647600 -36000 0 HAST}
+ {2751537600 -32400 1 HADT}
+ {2772097200 -36000 0 HAST}
+ {2782987200 -32400 1 HADT}
+ {2803546800 -36000 0 HAST}
+ {2814436800 -32400 1 HADT}
+ {2834996400 -36000 0 HAST}
+ {2846491200 -32400 1 HADT}
+ {2867050800 -36000 0 HAST}
+ {2877940800 -32400 1 HADT}
+ {2898500400 -36000 0 HAST}
+ {2909390400 -32400 1 HADT}
+ {2929950000 -36000 0 HAST}
+ {2940840000 -32400 1 HADT}
+ {2961399600 -36000 0 HAST}
+ {2972289600 -32400 1 HADT}
+ {2992849200 -36000 0 HAST}
+ {3003739200 -32400 1 HADT}
+ {3024298800 -36000 0 HAST}
+ {3035793600 -32400 1 HADT}
+ {3056353200 -36000 0 HAST}
+ {3067243200 -32400 1 HADT}
+ {3087802800 -36000 0 HAST}
+ {3098692800 -32400 1 HADT}
+ {3119252400 -36000 0 HAST}
+ {3130142400 -32400 1 HADT}
+ {3150702000 -36000 0 HAST}
+ {3161592000 -32400 1 HADT}
+ {3182151600 -36000 0 HAST}
+ {3193041600 -32400 1 HADT}
+ {3213601200 -36000 0 HAST}
+ {3225096000 -32400 1 HADT}
+ {3245655600 -36000 0 HAST}
+ {3256545600 -32400 1 HADT}
+ {3277105200 -36000 0 HAST}
+ {3287995200 -32400 1 HADT}
+ {3308554800 -36000 0 HAST}
+ {3319444800 -32400 1 HADT}
+ {3340004400 -36000 0 HAST}
+ {3350894400 -32400 1 HADT}
+ {3371454000 -36000 0 HAST}
+ {3382948800 -32400 1 HADT}
+ {3403508400 -36000 0 HAST}
+ {3414398400 -32400 1 HADT}
+ {3434958000 -36000 0 HAST}
+ {3445848000 -32400 1 HADT}
+ {3466407600 -36000 0 HAST}
+ {3477297600 -32400 1 HADT}
+ {3497857200 -36000 0 HAST}
+ {3508747200 -32400 1 HADT}
+ {3529306800 -36000 0 HAST}
+ {3540196800 -32400 1 HADT}
+ {3560756400 -36000 0 HAST}
+ {3572251200 -32400 1 HADT}
+ {3592810800 -36000 0 HAST}
+ {3603700800 -32400 1 HADT}
+ {3624260400 -36000 0 HAST}
+ {3635150400 -32400 1 HADT}
+ {3655710000 -36000 0 HAST}
+ {3666600000 -32400 1 HADT}
+ {3687159600 -36000 0 HAST}
+ {3698049600 -32400 1 HADT}
+ {3718609200 -36000 0 HAST}
+ {3730104000 -32400 1 HADT}
+ {3750663600 -36000 0 HAST}
+ {3761553600 -32400 1 HADT}
+ {3782113200 -36000 0 HAST}
+ {3793003200 -32400 1 HADT}
+ {3813562800 -36000 0 HAST}
+ {3824452800 -32400 1 HADT}
+ {3845012400 -36000 0 HAST}
+ {3855902400 -32400 1 HADT}
+ {3876462000 -36000 0 HAST}
+ {3887352000 -32400 1 HADT}
+ {3907911600 -36000 0 HAST}
+ {3919406400 -32400 1 HADT}
+ {3939966000 -36000 0 HAST}
+ {3950856000 -32400 1 HADT}
+ {3971415600 -36000 0 HAST}
+ {3982305600 -32400 1 HADT}
+ {4002865200 -36000 0 HAST}
+ {4013755200 -32400 1 HADT}
+ {4034314800 -36000 0 HAST}
+ {4045204800 -32400 1 HADT}
+ {4065764400 -36000 0 HAST}
+ {4076654400 -32400 1 HADT}
+ {4097214000 -36000 0 HAST}
}
diff --git a/library/tzdata/America/Anchorage b/library/tzdata/America/Anchorage
index a6e6803..e02dd01 100644
--- a/library/tzdata/America/Anchorage
+++ b/library/tzdata/America/Anchorage
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Anchorage) {
{-9223372036854775808 50424 0 LMT}
@@ -6,8 +6,8 @@ set TZData(:America/Anchorage) {
{-2188951224 -36000 0 CAT}
{-883576800 -36000 0 CAWT}
{-880200000 -32400 1 CAWT}
- {-769395600 -32400 1 CAWT}
- {-765378000 -36000 0 CAWT}
+ {-769395600 -32400 0 CAPT}
+ {-765378000 -36000 0 CAPT}
{-757346400 -36000 0 CAT}
{-86882400 -36000 0 AHST}
{-31500000 -36000 0 AHST}
@@ -87,190 +87,190 @@ set TZData(:America/Anchorage) {
{1130666400 -32400 0 AKST}
{1143975600 -28800 1 AKDT}
{1162116000 -32400 0 AKST}
- {1175425200 -28800 1 AKDT}
- {1193565600 -32400 0 AKST}
- {1207479600 -28800 1 AKDT}
- {1225015200 -32400 0 AKST}
- {1238929200 -28800 1 AKDT}
- {1256464800 -32400 0 AKST}
- {1270378800 -28800 1 AKDT}
- {1288519200 -32400 0 AKST}
- {1301828400 -28800 1 AKDT}
- {1319968800 -32400 0 AKST}
- {1333278000 -28800 1 AKDT}
- {1351418400 -32400 0 AKST}
- {1365332400 -28800 1 AKDT}
- {1382868000 -32400 0 AKST}
- {1396782000 -28800 1 AKDT}
- {1414317600 -32400 0 AKST}
- {1428231600 -28800 1 AKDT}
- {1445767200 -32400 0 AKST}
- {1459681200 -28800 1 AKDT}
- {1477821600 -32400 0 AKST}
- {1491130800 -28800 1 AKDT}
- {1509271200 -32400 0 AKST}
- {1522580400 -28800 1 AKDT}
- {1540720800 -32400 0 AKST}
- {1554634800 -28800 1 AKDT}
- {1572170400 -32400 0 AKST}
- {1586084400 -28800 1 AKDT}
- {1603620000 -32400 0 AKST}
- {1617534000 -28800 1 AKDT}
- {1635674400 -32400 0 AKST}
- {1648983600 -28800 1 AKDT}
- {1667124000 -32400 0 AKST}
- {1680433200 -28800 1 AKDT}
- {1698573600 -32400 0 AKST}
- {1712487600 -28800 1 AKDT}
- {1730023200 -32400 0 AKST}
- {1743937200 -28800 1 AKDT}
- {1761472800 -32400 0 AKST}
- {1775386800 -28800 1 AKDT}
- {1792922400 -32400 0 AKST}
- {1806836400 -28800 1 AKDT}
- {1824976800 -32400 0 AKST}
- {1838286000 -28800 1 AKDT}
- {1856426400 -32400 0 AKST}
- {1869735600 -28800 1 AKDT}
- {1887876000 -32400 0 AKST}
- {1901790000 -28800 1 AKDT}
- {1919325600 -32400 0 AKST}
- {1933239600 -28800 1 AKDT}
- {1950775200 -32400 0 AKST}
- {1964689200 -28800 1 AKDT}
- {1982829600 -32400 0 AKST}
- {1996138800 -28800 1 AKDT}
- {2014279200 -32400 0 AKST}
- {2027588400 -28800 1 AKDT}
- {2045728800 -32400 0 AKST}
- {2059038000 -28800 1 AKDT}
- {2077178400 -32400 0 AKST}
- {2091092400 -28800 1 AKDT}
- {2108628000 -32400 0 AKST}
- {2122542000 -28800 1 AKDT}
- {2140077600 -32400 0 AKST}
- {2153991600 -28800 1 AKDT}
- {2172132000 -32400 0 AKST}
- {2185441200 -28800 1 AKDT}
- {2203581600 -32400 0 AKST}
- {2216890800 -28800 1 AKDT}
- {2235031200 -32400 0 AKST}
- {2248945200 -28800 1 AKDT}
- {2266480800 -32400 0 AKST}
- {2280394800 -28800 1 AKDT}
- {2297930400 -32400 0 AKST}
- {2311844400 -28800 1 AKDT}
- {2329380000 -32400 0 AKST}
- {2343294000 -28800 1 AKDT}
- {2361434400 -32400 0 AKST}
- {2374743600 -28800 1 AKDT}
- {2392884000 -32400 0 AKST}
- {2406193200 -28800 1 AKDT}
- {2424333600 -32400 0 AKST}
- {2438247600 -28800 1 AKDT}
- {2455783200 -32400 0 AKST}
- {2469697200 -28800 1 AKDT}
- {2487232800 -32400 0 AKST}
- {2501146800 -28800 1 AKDT}
- {2519287200 -32400 0 AKST}
- {2532596400 -28800 1 AKDT}
- {2550736800 -32400 0 AKST}
- {2564046000 -28800 1 AKDT}
- {2582186400 -32400 0 AKST}
- {2596100400 -28800 1 AKDT}
- {2613636000 -32400 0 AKST}
- {2627550000 -28800 1 AKDT}
- {2645085600 -32400 0 AKST}
- {2658999600 -28800 1 AKDT}
- {2676535200 -32400 0 AKST}
- {2690449200 -28800 1 AKDT}
- {2708589600 -32400 0 AKST}
- {2721898800 -28800 1 AKDT}
- {2740039200 -32400 0 AKST}
- {2753348400 -28800 1 AKDT}
- {2771488800 -32400 0 AKST}
- {2785402800 -28800 1 AKDT}
- {2802938400 -32400 0 AKST}
- {2816852400 -28800 1 AKDT}
- {2834388000 -32400 0 AKST}
- {2848302000 -28800 1 AKDT}
- {2866442400 -32400 0 AKST}
- {2879751600 -28800 1 AKDT}
- {2897892000 -32400 0 AKST}
- {2911201200 -28800 1 AKDT}
- {2929341600 -32400 0 AKST}
- {2942650800 -28800 1 AKDT}
- {2960791200 -32400 0 AKST}
- {2974705200 -28800 1 AKDT}
- {2992240800 -32400 0 AKST}
- {3006154800 -28800 1 AKDT}
- {3023690400 -32400 0 AKST}
- {3037604400 -28800 1 AKDT}
- {3055744800 -32400 0 AKST}
- {3069054000 -28800 1 AKDT}
- {3087194400 -32400 0 AKST}
- {3100503600 -28800 1 AKDT}
- {3118644000 -32400 0 AKST}
- {3132558000 -28800 1 AKDT}
- {3150093600 -32400 0 AKST}
- {3164007600 -28800 1 AKDT}
- {3181543200 -32400 0 AKST}
- {3195457200 -28800 1 AKDT}
- {3212992800 -32400 0 AKST}
- {3226906800 -28800 1 AKDT}
- {3245047200 -32400 0 AKST}
- {3258356400 -28800 1 AKDT}
- {3276496800 -32400 0 AKST}
- {3289806000 -28800 1 AKDT}
- {3307946400 -32400 0 AKST}
- {3321860400 -28800 1 AKDT}
- {3339396000 -32400 0 AKST}
- {3353310000 -28800 1 AKDT}
- {3370845600 -32400 0 AKST}
- {3384759600 -28800 1 AKDT}
- {3402900000 -32400 0 AKST}
- {3416209200 -28800 1 AKDT}
- {3434349600 -32400 0 AKST}
- {3447658800 -28800 1 AKDT}
- {3465799200 -32400 0 AKST}
- {3479713200 -28800 1 AKDT}
- {3497248800 -32400 0 AKST}
- {3511162800 -28800 1 AKDT}
- {3528698400 -32400 0 AKST}
- {3542612400 -28800 1 AKDT}
- {3560148000 -32400 0 AKST}
- {3574062000 -28800 1 AKDT}
- {3592202400 -32400 0 AKST}
- {3605511600 -28800 1 AKDT}
- {3623652000 -32400 0 AKST}
- {3636961200 -28800 1 AKDT}
- {3655101600 -32400 0 AKST}
- {3669015600 -28800 1 AKDT}
- {3686551200 -32400 0 AKST}
- {3700465200 -28800 1 AKDT}
- {3718000800 -32400 0 AKST}
- {3731914800 -28800 1 AKDT}
- {3750055200 -32400 0 AKST}
- {3763364400 -28800 1 AKDT}
- {3781504800 -32400 0 AKST}
- {3794814000 -28800 1 AKDT}
- {3812954400 -32400 0 AKST}
- {3826263600 -28800 1 AKDT}
- {3844404000 -32400 0 AKST}
- {3858318000 -28800 1 AKDT}
- {3875853600 -32400 0 AKST}
- {3889767600 -28800 1 AKDT}
- {3907303200 -32400 0 AKST}
- {3921217200 -28800 1 AKDT}
- {3939357600 -32400 0 AKST}
- {3952666800 -28800 1 AKDT}
- {3970807200 -32400 0 AKST}
- {3984116400 -28800 1 AKDT}
- {4002256800 -32400 0 AKST}
- {4016170800 -28800 1 AKDT}
- {4033706400 -32400 0 AKST}
- {4047620400 -28800 1 AKDT}
- {4065156000 -32400 0 AKST}
- {4079070000 -28800 1 AKDT}
- {4096605600 -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/Anguilla b/library/tzdata/America/Anguilla
index a8e85e6..39a0d18 100644
--- a/library/tzdata/America/Anguilla
+++ b/library/tzdata/America/Anguilla
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Anguilla) {
- {-9223372036854775808 -15136 0 LMT}
- {-1825098464 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Anguilla) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Antigua b/library/tzdata/America/Antigua
index f911e74..5433e9b 100644
--- a/library/tzdata/America/Antigua
+++ b/library/tzdata/America/Antigua
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Antigua) {
{-9223372036854775808 -14832 0 LMT}
diff --git a/library/tzdata/America/Araguaina b/library/tzdata/America/Araguaina
index b00333a..e4a0d52 100644
--- a/library/tzdata/America/Araguaina
+++ b/library/tzdata/America/Araguaina
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Araguaina) {
{-9223372036854775808 -11568 0 LMT}
@@ -54,4 +54,7 @@ set TZData(:America/Araguaina) {
{1036292400 -7200 1 BRST}
{1045360800 -10800 0 BRT}
{1064368800 -10800 0 BRT}
+ {1350788400 -7200 0 BRST}
+ {1361066400 -10800 0 BRT}
+ {1378000800 -10800 0 BRT}
}
diff --git a/library/tzdata/America/Argentina/Buenos_Aires b/library/tzdata/America/Argentina/Buenos_Aires
index face914..73cc8e9 100644
--- a/library/tzdata/America/Argentina/Buenos_Aires
+++ b/library/tzdata/America/Argentina/Buenos_Aires
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Buenos_Aires) {
{-9223372036854775808 -14028 0 LMT}
@@ -60,4 +60,8 @@ set TZData(:America/Argentina/Buenos_Aires) {
{938916000 -10800 0 ART}
{938919600 -10800 1 ARST}
{952056000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224385200 -7200 1 ARST}
+ {1237082400 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Catamarca b/library/tzdata/America/Argentina/Catamarca
index b42fded..7739203 100644
--- a/library/tzdata/America/Argentina/Catamarca
+++ b/library/tzdata/America/Argentina/Catamarca
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Catamarca) {
{-9223372036854775808 -15788 0 LMT}
@@ -62,4 +62,7 @@ set TZData(:America/Argentina/Catamarca) {
{952056000 -10800 0 ART}
{1086058800 -14400 0 WART}
{1087704000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/ComodRivadavia b/library/tzdata/America/Argentina/ComodRivadavia
index 5ba130e..2611a3d 100644
--- a/library/tzdata/America/Argentina/ComodRivadavia
+++ b/library/tzdata/America/Argentina/ComodRivadavia
@@ -1,65 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Argentina/ComodRivadavia) {
- {-9223372036854775808 -16200 0 LMT}
- {-2372095800 -15408 0 CMT}
- {-1567453392 -14400 0 ART}
- {-1233432000 -10800 0 ARST}
- {-1222981200 -14400 0 ART}
- {-1205956800 -10800 1 ARST}
- {-1194037200 -14400 0 ART}
- {-1172865600 -10800 1 ARST}
- {-1162501200 -14400 0 ART}
- {-1141329600 -10800 1 ARST}
- {-1130965200 -14400 0 ART}
- {-1109793600 -10800 1 ARST}
- {-1099429200 -14400 0 ART}
- {-1078257600 -10800 1 ARST}
- {-1067806800 -14400 0 ART}
- {-1046635200 -10800 1 ARST}
- {-1036270800 -14400 0 ART}
- {-1015099200 -10800 1 ARST}
- {-1004734800 -14400 0 ART}
- {-983563200 -10800 1 ARST}
- {-973198800 -14400 0 ART}
- {-952027200 -10800 1 ARST}
- {-941576400 -14400 0 ART}
- {-931032000 -10800 1 ARST}
- {-900882000 -14400 0 ART}
- {-890337600 -10800 1 ARST}
- {-833749200 -14400 0 ART}
- {-827265600 -10800 1 ARST}
- {-752274000 -14400 0 ART}
- {-733780800 -10800 1 ARST}
- {-197326800 -14400 0 ART}
- {-190843200 -10800 1 ARST}
- {-184194000 -14400 0 ART}
- {-164491200 -10800 1 ARST}
- {-152658000 -14400 0 ART}
- {-132955200 -10800 1 ARST}
- {-121122000 -14400 0 ART}
- {-101419200 -10800 1 ARST}
- {-86821200 -14400 0 ART}
- {-71092800 -10800 1 ARST}
- {-54766800 -14400 0 ART}
- {-39038400 -10800 1 ARST}
- {-23317200 -14400 0 ART}
- {-7588800 -10800 0 ART}
- {128142000 -7200 1 ARST}
- {136605600 -10800 0 ART}
- {596948400 -7200 1 ARST}
- {605066400 -10800 0 ART}
- {624423600 -7200 1 ARST}
- {636516000 -10800 0 ART}
- {656478000 -7200 1 ARST}
- {667965600 -14400 0 WART}
- {687931200 -7200 0 ARST}
- {699415200 -10800 0 ART}
- {719377200 -7200 1 ARST}
- {731469600 -10800 0 ART}
- {938916000 -10800 0 ART}
- {938919600 -10800 1 ARST}
- {952056000 -10800 0 ART}
- {1086058800 -14400 0 WART}
- {1087704000 -10800 0 ART}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Argentina/Catamarca)]} {
+ LoadTimeZoneFile America/Argentina/Catamarca
}
+set TZData(:America/Argentina/ComodRivadavia) $TZData(:America/Argentina/Catamarca)
diff --git a/library/tzdata/America/Argentina/Cordoba b/library/tzdata/America/Argentina/Cordoba
index 098a62b..b08539e 100644
--- a/library/tzdata/America/Argentina/Cordoba
+++ b/library/tzdata/America/Argentina/Cordoba
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Cordoba) {
{-9223372036854775808 -15408 0 LMT}
@@ -60,4 +60,8 @@ set TZData(:America/Argentina/Cordoba) {
{938916000 -10800 0 ART}
{938919600 -10800 1 ARST}
{952056000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224385200 -7200 1 ARST}
+ {1237082400 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Jujuy b/library/tzdata/America/Argentina/Jujuy
index 73b2f51..4f95f8a 100644
--- a/library/tzdata/America/Argentina/Jujuy
+++ b/library/tzdata/America/Argentina/Jujuy
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Jujuy) {
{-9223372036854775808 -15672 0 LMT}
@@ -61,4 +61,7 @@ set TZData(:America/Argentina/Jujuy) {
{938916000 -10800 0 ART}
{938919600 -10800 1 ARST}
{952056000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/La_Rioja b/library/tzdata/America/Argentina/La_Rioja
index 42731a4..835e29d 100644
--- a/library/tzdata/America/Argentina/La_Rioja
+++ b/library/tzdata/America/Argentina/La_Rioja
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/La_Rioja) {
{-9223372036854775808 -16044 0 LMT}
@@ -63,4 +63,7 @@ set TZData(:America/Argentina/La_Rioja) {
{952056000 -10800 0 ART}
{1086058800 -14400 0 WART}
{1087704000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Mendoza b/library/tzdata/America/Argentina/Mendoza
index d7f5466..2c6fb58 100644
--- a/library/tzdata/America/Argentina/Mendoza
+++ b/library/tzdata/America/Argentina/Mendoza
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Mendoza) {
{-9223372036854775808 -16516 0 LMT}
@@ -62,4 +62,7 @@ set TZData(:America/Argentina/Mendoza) {
{952056000 -10800 0 ART}
{1085281200 -14400 0 WART}
{1096171200 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Rio_Gallegos b/library/tzdata/America/Argentina/Rio_Gallegos
index fbbe004..91d37dd 100644
--- a/library/tzdata/America/Argentina/Rio_Gallegos
+++ b/library/tzdata/America/Argentina/Rio_Gallegos
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Rio_Gallegos) {
{-9223372036854775808 -16612 0 LMT}
@@ -62,4 +62,7 @@ set TZData(:America/Argentina/Rio_Gallegos) {
{952056000 -10800 0 ART}
{1086058800 -14400 0 WART}
{1087704000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Salta b/library/tzdata/America/Argentina/Salta
new file mode 100644
index 0000000..a5a7010
--- /dev/null
+++ b/library/tzdata/America/Argentina/Salta
@@ -0,0 +1,66 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Argentina/Salta) {
+ {-9223372036854775808 -15700 0 LMT}
+ {-2372096300 -15408 0 CMT}
+ {-1567453392 -14400 0 ART}
+ {-1233432000 -10800 0 ARST}
+ {-1222981200 -14400 0 ART}
+ {-1205956800 -10800 1 ARST}
+ {-1194037200 -14400 0 ART}
+ {-1172865600 -10800 1 ARST}
+ {-1162501200 -14400 0 ART}
+ {-1141329600 -10800 1 ARST}
+ {-1130965200 -14400 0 ART}
+ {-1109793600 -10800 1 ARST}
+ {-1099429200 -14400 0 ART}
+ {-1078257600 -10800 1 ARST}
+ {-1067806800 -14400 0 ART}
+ {-1046635200 -10800 1 ARST}
+ {-1036270800 -14400 0 ART}
+ {-1015099200 -10800 1 ARST}
+ {-1004734800 -14400 0 ART}
+ {-983563200 -10800 1 ARST}
+ {-973198800 -14400 0 ART}
+ {-952027200 -10800 1 ARST}
+ {-941576400 -14400 0 ART}
+ {-931032000 -10800 1 ARST}
+ {-900882000 -14400 0 ART}
+ {-890337600 -10800 1 ARST}
+ {-833749200 -14400 0 ART}
+ {-827265600 -10800 1 ARST}
+ {-752274000 -14400 0 ART}
+ {-733780800 -10800 1 ARST}
+ {-197326800 -14400 0 ART}
+ {-190843200 -10800 1 ARST}
+ {-184194000 -14400 0 ART}
+ {-164491200 -10800 1 ARST}
+ {-152658000 -14400 0 ART}
+ {-132955200 -10800 1 ARST}
+ {-121122000 -14400 0 ART}
+ {-101419200 -10800 1 ARST}
+ {-86821200 -14400 0 ART}
+ {-71092800 -10800 1 ARST}
+ {-54766800 -14400 0 ART}
+ {-39038400 -10800 1 ARST}
+ {-23317200 -14400 0 ART}
+ {-7588800 -10800 0 ART}
+ {128142000 -7200 1 ARST}
+ {136605600 -10800 0 ART}
+ {596948400 -7200 1 ARST}
+ {605066400 -10800 0 ART}
+ {624423600 -7200 1 ARST}
+ {636516000 -10800 0 ART}
+ {656478000 -7200 1 ARST}
+ {667965600 -14400 0 WART}
+ {687931200 -7200 0 ARST}
+ {699415200 -10800 0 ART}
+ {719377200 -7200 1 ARST}
+ {731469600 -10800 0 ART}
+ {938916000 -10800 0 ART}
+ {938919600 -10800 1 ARST}
+ {952056000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
+}
diff --git a/library/tzdata/America/Argentina/San_Juan b/library/tzdata/America/Argentina/San_Juan
index a7282cf..417e234 100644
--- a/library/tzdata/America/Argentina/San_Juan
+++ b/library/tzdata/America/Argentina/San_Juan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/San_Juan) {
{-9223372036854775808 -16444 0 LMT}
@@ -63,4 +63,7 @@ set TZData(:America/Argentina/San_Juan) {
{952056000 -10800 0 ART}
{1085972400 -14400 0 WART}
{1090728000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/San_Luis b/library/tzdata/America/Argentina/San_Luis
new file mode 100644
index 0000000..8ca55d7
--- /dev/null
+++ b/library/tzdata/America/Argentina/San_Luis
@@ -0,0 +1,68 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Argentina/San_Luis) {
+ {-9223372036854775808 -15924 0 LMT}
+ {-2372096076 -15408 0 CMT}
+ {-1567453392 -14400 0 ART}
+ {-1233432000 -10800 0 ARST}
+ {-1222981200 -14400 0 ART}
+ {-1205956800 -10800 1 ARST}
+ {-1194037200 -14400 0 ART}
+ {-1172865600 -10800 1 ARST}
+ {-1162501200 -14400 0 ART}
+ {-1141329600 -10800 1 ARST}
+ {-1130965200 -14400 0 ART}
+ {-1109793600 -10800 1 ARST}
+ {-1099429200 -14400 0 ART}
+ {-1078257600 -10800 1 ARST}
+ {-1067806800 -14400 0 ART}
+ {-1046635200 -10800 1 ARST}
+ {-1036270800 -14400 0 ART}
+ {-1015099200 -10800 1 ARST}
+ {-1004734800 -14400 0 ART}
+ {-983563200 -10800 1 ARST}
+ {-973198800 -14400 0 ART}
+ {-952027200 -10800 1 ARST}
+ {-941576400 -14400 0 ART}
+ {-931032000 -10800 1 ARST}
+ {-900882000 -14400 0 ART}
+ {-890337600 -10800 1 ARST}
+ {-833749200 -14400 0 ART}
+ {-827265600 -10800 1 ARST}
+ {-752274000 -14400 0 ART}
+ {-733780800 -10800 1 ARST}
+ {-197326800 -14400 0 ART}
+ {-190843200 -10800 1 ARST}
+ {-184194000 -14400 0 ART}
+ {-164491200 -10800 1 ARST}
+ {-152658000 -14400 0 ART}
+ {-132955200 -10800 1 ARST}
+ {-121122000 -14400 0 ART}
+ {-101419200 -10800 1 ARST}
+ {-86821200 -14400 0 ART}
+ {-71092800 -10800 1 ARST}
+ {-54766800 -14400 0 ART}
+ {-39038400 -10800 1 ARST}
+ {-23317200 -14400 0 ART}
+ {-7588800 -10800 0 ART}
+ {128142000 -7200 1 ARST}
+ {136605600 -10800 0 ART}
+ {596948400 -7200 1 ARST}
+ {605066400 -10800 0 ART}
+ {624423600 -7200 1 ARST}
+ {631159200 -7200 1 ARST}
+ {637380000 -14400 0 WART}
+ {655963200 -10800 1 WARST}
+ {667796400 -14400 0 WART}
+ {675748800 -10800 0 ART}
+ {938919600 -10800 1 WARST}
+ {952052400 -10800 0 ART}
+ {1085972400 -14400 0 WART}
+ {1090728000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1200880800 -10800 0 WART}
+ {1205031600 -14400 0 WART}
+ {1223784000 -10800 1 WARST}
+ {1236481200 -14400 0 WART}
+ {1255233600 -10800 0 ART}
+}
diff --git a/library/tzdata/America/Argentina/Tucuman b/library/tzdata/America/Argentina/Tucuman
index 07efd08..3500986 100644
--- a/library/tzdata/America/Argentina/Tucuman
+++ b/library/tzdata/America/Argentina/Tucuman
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Tucuman) {
{-9223372036854775808 -15652 0 LMT}
@@ -62,4 +62,8 @@ set TZData(:America/Argentina/Tucuman) {
{952056000 -10800 0 ART}
{1086058800 -14400 0 WART}
{1087099200 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224385200 -7200 1 ARST}
+ {1237082400 -10800 0 ART}
}
diff --git a/library/tzdata/America/Argentina/Ushuaia b/library/tzdata/America/Argentina/Ushuaia
index e935511..4fcf92d 100644
--- a/library/tzdata/America/Argentina/Ushuaia
+++ b/library/tzdata/America/Argentina/Ushuaia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Argentina/Ushuaia) {
{-9223372036854775808 -16392 0 LMT}
@@ -62,4 +62,7 @@ set TZData(:America/Argentina/Ushuaia) {
{952056000 -10800 0 ART}
{1085886000 -14400 0 WART}
{1087704000 -10800 0 ART}
+ {1198983600 -7200 1 ARST}
+ {1205632800 -10800 0 ART}
+ {1224295200 -10800 0 ART}
}
diff --git a/library/tzdata/America/Aruba b/library/tzdata/America/Aruba
index 0c06f84..e02d5fc 100644
--- a/library/tzdata/America/Aruba
+++ b/library/tzdata/America/Aruba
@@ -1,7 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Aruba) {
- {-9223372036854775808 -16824 0 LMT}
- {-1826738376 -16200 0 ANT}
- {-157750200 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Curacao)]} {
+ LoadTimeZoneFile America/Curacao
}
+set TZData(:America/Aruba) $TZData(:America/Curacao)
diff --git a/library/tzdata/America/Asuncion b/library/tzdata/America/Asuncion
index b85c7e0..9ea30da 100644
--- a/library/tzdata/America/Asuncion
+++ b/library/tzdata/America/Asuncion
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Asuncion) {
{-9223372036854775808 -13840 0 LMT}
@@ -76,184 +76,184 @@ set TZData(:America/Asuncion) {
{1224388800 -10800 1 PYST}
{1236481200 -14400 0 PYT}
{1255838400 -10800 1 PYST}
- {1268535600 -14400 0 PYT}
- {1287288000 -10800 1 PYST}
- {1299985200 -14400 0 PYT}
- {1318737600 -10800 1 PYST}
- {1331434800 -14400 0 PYT}
- {1350792000 -10800 1 PYST}
- {1362884400 -14400 0 PYT}
- {1382241600 -10800 1 PYST}
- {1394334000 -14400 0 PYT}
- {1413691200 -10800 1 PYST}
- {1425783600 -14400 0 PYT}
- {1445140800 -10800 1 PYST}
- {1457838000 -14400 0 PYT}
- {1476590400 -10800 1 PYST}
- {1489287600 -14400 0 PYT}
- {1508040000 -10800 1 PYST}
- {1520737200 -14400 0 PYT}
- {1540094400 -10800 1 PYST}
- {1552186800 -14400 0 PYT}
- {1571544000 -10800 1 PYST}
- {1583636400 -14400 0 PYT}
- {1602993600 -10800 1 PYST}
- {1615690800 -14400 0 PYT}
- {1634443200 -10800 1 PYST}
- {1647140400 -14400 0 PYT}
- {1665892800 -10800 1 PYST}
- {1678590000 -14400 0 PYT}
- {1697342400 -10800 1 PYST}
- {1710039600 -14400 0 PYT}
- {1729396800 -10800 1 PYST}
- {1741489200 -14400 0 PYT}
- {1760846400 -10800 1 PYST}
- {1772938800 -14400 0 PYT}
- {1792296000 -10800 1 PYST}
- {1804993200 -14400 0 PYT}
- {1823745600 -10800 1 PYST}
- {1836442800 -14400 0 PYT}
- {1855195200 -10800 1 PYST}
- {1867892400 -14400 0 PYT}
- {1887249600 -10800 1 PYST}
- {1899342000 -14400 0 PYT}
- {1918699200 -10800 1 PYST}
- {1930791600 -14400 0 PYT}
- {1950148800 -10800 1 PYST}
- {1962846000 -14400 0 PYT}
- {1981598400 -10800 1 PYST}
- {1994295600 -14400 0 PYT}
- {2013048000 -10800 1 PYST}
- {2025745200 -14400 0 PYT}
- {2044497600 -10800 1 PYST}
- {2057194800 -14400 0 PYT}
- {2076552000 -10800 1 PYST}
- {2088644400 -14400 0 PYT}
- {2108001600 -10800 1 PYST}
- {2120094000 -14400 0 PYT}
- {2139451200 -10800 1 PYST}
- {2152148400 -14400 0 PYT}
- {2170900800 -10800 1 PYST}
- {2183598000 -14400 0 PYT}
- {2202350400 -10800 1 PYST}
- {2215047600 -14400 0 PYT}
- {2234404800 -10800 1 PYST}
- {2246497200 -14400 0 PYT}
- {2265854400 -10800 1 PYST}
- {2277946800 -14400 0 PYT}
- {2297304000 -10800 1 PYST}
- {2309396400 -14400 0 PYT}
- {2328753600 -10800 1 PYST}
- {2341450800 -14400 0 PYT}
- {2360203200 -10800 1 PYST}
- {2372900400 -14400 0 PYT}
- {2391652800 -10800 1 PYST}
- {2404350000 -14400 0 PYT}
- {2423707200 -10800 1 PYST}
- {2435799600 -14400 0 PYT}
- {2455156800 -10800 1 PYST}
- {2467249200 -14400 0 PYT}
- {2486606400 -10800 1 PYST}
- {2499303600 -14400 0 PYT}
- {2518056000 -10800 1 PYST}
- {2530753200 -14400 0 PYT}
- {2549505600 -10800 1 PYST}
- {2562202800 -14400 0 PYT}
- {2580955200 -10800 1 PYST}
- {2593652400 -14400 0 PYT}
- {2613009600 -10800 1 PYST}
- {2625102000 -14400 0 PYT}
- {2644459200 -10800 1 PYST}
- {2656551600 -14400 0 PYT}
- {2675908800 -10800 1 PYST}
- {2688606000 -14400 0 PYT}
- {2707358400 -10800 1 PYST}
- {2720055600 -14400 0 PYT}
- {2738808000 -10800 1 PYST}
- {2751505200 -14400 0 PYT}
- {2770862400 -10800 1 PYST}
- {2782954800 -14400 0 PYT}
- {2802312000 -10800 1 PYST}
- {2814404400 -14400 0 PYT}
- {2833761600 -10800 1 PYST}
- {2846458800 -14400 0 PYT}
- {2865211200 -10800 1 PYST}
- {2877908400 -14400 0 PYT}
- {2896660800 -10800 1 PYST}
- {2909358000 -14400 0 PYT}
- {2928110400 -10800 1 PYST}
- {2940807600 -14400 0 PYT}
- {2960164800 -10800 1 PYST}
- {2972257200 -14400 0 PYT}
- {2991614400 -10800 1 PYST}
- {3003706800 -14400 0 PYT}
- {3023064000 -10800 1 PYST}
- {3035761200 -14400 0 PYT}
- {3054513600 -10800 1 PYST}
- {3067210800 -14400 0 PYT}
- {3085963200 -10800 1 PYST}
- {3098660400 -14400 0 PYT}
- {3118017600 -10800 1 PYST}
- {3130110000 -14400 0 PYT}
- {3149467200 -10800 1 PYST}
- {3161559600 -14400 0 PYT}
- {3180916800 -10800 1 PYST}
- {3193009200 -14400 0 PYT}
- {3212366400 -10800 1 PYST}
- {3225063600 -14400 0 PYT}
- {3243816000 -10800 1 PYST}
- {3256513200 -14400 0 PYT}
- {3275265600 -10800 1 PYST}
- {3287962800 -14400 0 PYT}
- {3307320000 -10800 1 PYST}
- {3319412400 -14400 0 PYT}
- {3338769600 -10800 1 PYST}
- {3350862000 -14400 0 PYT}
- {3370219200 -10800 1 PYST}
- {3382916400 -14400 0 PYT}
- {3401668800 -10800 1 PYST}
- {3414366000 -14400 0 PYT}
- {3433118400 -10800 1 PYST}
- {3445815600 -14400 0 PYT}
- {3464568000 -10800 1 PYST}
- {3477265200 -14400 0 PYT}
- {3496622400 -10800 1 PYST}
- {3508714800 -14400 0 PYT}
- {3528072000 -10800 1 PYST}
- {3540164400 -14400 0 PYT}
- {3559521600 -10800 1 PYST}
- {3572218800 -14400 0 PYT}
- {3590971200 -10800 1 PYST}
- {3603668400 -14400 0 PYT}
- {3622420800 -10800 1 PYST}
- {3635118000 -14400 0 PYT}
- {3654475200 -10800 1 PYST}
- {3666567600 -14400 0 PYT}
- {3685924800 -10800 1 PYST}
- {3698017200 -14400 0 PYT}
- {3717374400 -10800 1 PYST}
- {3730071600 -14400 0 PYT}
- {3748824000 -10800 1 PYST}
- {3761521200 -14400 0 PYT}
- {3780273600 -10800 1 PYST}
- {3792970800 -14400 0 PYT}
- {3811723200 -10800 1 PYST}
- {3824420400 -14400 0 PYT}
- {3843777600 -10800 1 PYST}
- {3855870000 -14400 0 PYT}
- {3875227200 -10800 1 PYST}
- {3887319600 -14400 0 PYT}
- {3906676800 -10800 1 PYST}
- {3919374000 -14400 0 PYT}
- {3938126400 -10800 1 PYST}
- {3950823600 -14400 0 PYT}
- {3969576000 -10800 1 PYST}
- {3982273200 -14400 0 PYT}
- {4001630400 -10800 1 PYST}
- {4013722800 -14400 0 PYT}
- {4033080000 -10800 1 PYST}
- {4045172400 -14400 0 PYT}
- {4064529600 -10800 1 PYST}
- {4076622000 -14400 0 PYT}
- {4095979200 -10800 1 PYST}
+ {1270954800 -14400 0 PYT}
+ {1286078400 -10800 1 PYST}
+ {1302404400 -14400 0 PYT}
+ {1317528000 -10800 1 PYST}
+ {1333854000 -14400 0 PYT}
+ {1349582400 -10800 1 PYST}
+ {1364094000 -14400 0 PYT}
+ {1381032000 -10800 1 PYST}
+ {1395543600 -14400 0 PYT}
+ {1412481600 -10800 1 PYST}
+ {1426993200 -14400 0 PYT}
+ {1443931200 -10800 1 PYST}
+ {1459047600 -14400 0 PYT}
+ {1475380800 -10800 1 PYST}
+ {1490497200 -14400 0 PYT}
+ {1506830400 -10800 1 PYST}
+ {1521946800 -14400 0 PYT}
+ {1538884800 -10800 1 PYST}
+ {1553396400 -14400 0 PYT}
+ {1570334400 -10800 1 PYST}
+ {1584846000 -14400 0 PYT}
+ {1601784000 -10800 1 PYST}
+ {1616900400 -14400 0 PYT}
+ {1633233600 -10800 1 PYST}
+ {1648350000 -14400 0 PYT}
+ {1664683200 -10800 1 PYST}
+ {1679799600 -14400 0 PYT}
+ {1696132800 -10800 1 PYST}
+ {1711249200 -14400 0 PYT}
+ {1728187200 -10800 1 PYST}
+ {1742698800 -14400 0 PYT}
+ {1759636800 -10800 1 PYST}
+ {1774148400 -14400 0 PYT}
+ {1791086400 -10800 1 PYST}
+ {1806202800 -14400 0 PYT}
+ {1822536000 -10800 1 PYST}
+ {1837652400 -14400 0 PYT}
+ {1853985600 -10800 1 PYST}
+ {1869102000 -14400 0 PYT}
+ {1886040000 -10800 1 PYST}
+ {1900551600 -14400 0 PYT}
+ {1917489600 -10800 1 PYST}
+ {1932001200 -14400 0 PYT}
+ {1948939200 -10800 1 PYST}
+ {1964055600 -14400 0 PYT}
+ {1980388800 -10800 1 PYST}
+ {1995505200 -14400 0 PYT}
+ {2011838400 -10800 1 PYST}
+ {2026954800 -14400 0 PYT}
+ {2043288000 -10800 1 PYST}
+ {2058404400 -14400 0 PYT}
+ {2075342400 -10800 1 PYST}
+ {2089854000 -14400 0 PYT}
+ {2106792000 -10800 1 PYST}
+ {2121303600 -14400 0 PYT}
+ {2138241600 -10800 1 PYST}
+ {2153358000 -14400 0 PYT}
+ {2169691200 -10800 1 PYST}
+ {2184807600 -14400 0 PYT}
+ {2201140800 -10800 1 PYST}
+ {2216257200 -14400 0 PYT}
+ {2233195200 -10800 1 PYST}
+ {2247706800 -14400 0 PYT}
+ {2264644800 -10800 1 PYST}
+ {2279156400 -14400 0 PYT}
+ {2296094400 -10800 1 PYST}
+ {2310606000 -14400 0 PYT}
+ {2327544000 -10800 1 PYST}
+ {2342660400 -14400 0 PYT}
+ {2358993600 -10800 1 PYST}
+ {2374110000 -14400 0 PYT}
+ {2390443200 -10800 1 PYST}
+ {2405559600 -14400 0 PYT}
+ {2422497600 -10800 1 PYST}
+ {2437009200 -14400 0 PYT}
+ {2453947200 -10800 1 PYST}
+ {2468458800 -14400 0 PYT}
+ {2485396800 -10800 1 PYST}
+ {2500513200 -14400 0 PYT}
+ {2516846400 -10800 1 PYST}
+ {2531962800 -14400 0 PYT}
+ {2548296000 -10800 1 PYST}
+ {2563412400 -14400 0 PYT}
+ {2579745600 -10800 1 PYST}
+ {2594862000 -14400 0 PYT}
+ {2611800000 -10800 1 PYST}
+ {2626311600 -14400 0 PYT}
+ {2643249600 -10800 1 PYST}
+ {2657761200 -14400 0 PYT}
+ {2674699200 -10800 1 PYST}
+ {2689815600 -14400 0 PYT}
+ {2706148800 -10800 1 PYST}
+ {2721265200 -14400 0 PYT}
+ {2737598400 -10800 1 PYST}
+ {2752714800 -14400 0 PYT}
+ {2769652800 -10800 1 PYST}
+ {2784164400 -14400 0 PYT}
+ {2801102400 -10800 1 PYST}
+ {2815614000 -14400 0 PYT}
+ {2832552000 -10800 1 PYST}
+ {2847668400 -14400 0 PYT}
+ {2864001600 -10800 1 PYST}
+ {2879118000 -14400 0 PYT}
+ {2895451200 -10800 1 PYST}
+ {2910567600 -14400 0 PYT}
+ {2926900800 -10800 1 PYST}
+ {2942017200 -14400 0 PYT}
+ {2958955200 -10800 1 PYST}
+ {2973466800 -14400 0 PYT}
+ {2990404800 -10800 1 PYST}
+ {3004916400 -14400 0 PYT}
+ {3021854400 -10800 1 PYST}
+ {3036970800 -14400 0 PYT}
+ {3053304000 -10800 1 PYST}
+ {3068420400 -14400 0 PYT}
+ {3084753600 -10800 1 PYST}
+ {3099870000 -14400 0 PYT}
+ {3116808000 -10800 1 PYST}
+ {3131319600 -14400 0 PYT}
+ {3148257600 -10800 1 PYST}
+ {3162769200 -14400 0 PYT}
+ {3179707200 -10800 1 PYST}
+ {3194218800 -14400 0 PYT}
+ {3211156800 -10800 1 PYST}
+ {3226273200 -14400 0 PYT}
+ {3242606400 -10800 1 PYST}
+ {3257722800 -14400 0 PYT}
+ {3274056000 -10800 1 PYST}
+ {3289172400 -14400 0 PYT}
+ {3306110400 -10800 1 PYST}
+ {3320622000 -14400 0 PYT}
+ {3337560000 -10800 1 PYST}
+ {3352071600 -14400 0 PYT}
+ {3369009600 -10800 1 PYST}
+ {3384126000 -14400 0 PYT}
+ {3400459200 -10800 1 PYST}
+ {3415575600 -14400 0 PYT}
+ {3431908800 -10800 1 PYST}
+ {3447025200 -14400 0 PYT}
+ {3463358400 -10800 1 PYST}
+ {3478474800 -14400 0 PYT}
+ {3495412800 -10800 1 PYST}
+ {3509924400 -14400 0 PYT}
+ {3526862400 -10800 1 PYST}
+ {3541374000 -14400 0 PYT}
+ {3558312000 -10800 1 PYST}
+ {3573428400 -14400 0 PYT}
+ {3589761600 -10800 1 PYST}
+ {3604878000 -14400 0 PYT}
+ {3621211200 -10800 1 PYST}
+ {3636327600 -14400 0 PYT}
+ {3653265600 -10800 1 PYST}
+ {3667777200 -14400 0 PYT}
+ {3684715200 -10800 1 PYST}
+ {3699226800 -14400 0 PYT}
+ {3716164800 -10800 1 PYST}
+ {3731281200 -14400 0 PYT}
+ {3747614400 -10800 1 PYST}
+ {3762730800 -14400 0 PYT}
+ {3779064000 -10800 1 PYST}
+ {3794180400 -14400 0 PYT}
+ {3810513600 -10800 1 PYST}
+ {3825630000 -14400 0 PYT}
+ {3842568000 -10800 1 PYST}
+ {3857079600 -14400 0 PYT}
+ {3874017600 -10800 1 PYST}
+ {3888529200 -14400 0 PYT}
+ {3905467200 -10800 1 PYST}
+ {3920583600 -14400 0 PYT}
+ {3936916800 -10800 1 PYST}
+ {3952033200 -14400 0 PYT}
+ {3968366400 -10800 1 PYST}
+ {3983482800 -14400 0 PYT}
+ {4000420800 -10800 1 PYST}
+ {4014932400 -14400 0 PYT}
+ {4031870400 -10800 1 PYST}
+ {4046382000 -14400 0 PYT}
+ {4063320000 -10800 1 PYST}
+ {4077831600 -14400 0 PYT}
+ {4094769600 -10800 1 PYST}
}
diff --git a/library/tzdata/America/Atikokan b/library/tzdata/America/Atikokan
new file mode 100644
index 0000000..e72b04f
--- /dev/null
+++ b/library/tzdata/America/Atikokan
@@ -0,0 +1,12 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Atikokan) {
+ {-9223372036854775808 -21988 0 LMT}
+ {-2366733212 -21600 0 CST}
+ {-1632067200 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-923248800 -18000 1 CDT}
+ {-880214400 -18000 0 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765388800 -18000 0 EST}
+}
diff --git a/library/tzdata/America/Atka b/library/tzdata/America/Atka
index 935f4ec..8da3302 100644
--- a/library/tzdata/America/Atka
+++ b/library/tzdata/America/Atka
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Adak)]} {
LoadTimeZoneFile America/Adak
}
diff --git a/library/tzdata/America/Bahia b/library/tzdata/America/Bahia
index f3ba278..ac67b71 100644
--- a/library/tzdata/America/Bahia
+++ b/library/tzdata/America/Bahia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Bahia) {
{-9223372036854775808 -9244 0 LMT}
@@ -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/Bahia_Banderas b/library/tzdata/America/Bahia_Banderas
new file mode 100644
index 0000000..8c40a0e
--- /dev/null
+++ b/library/tzdata/America/Bahia_Banderas
@@ -0,0 +1,222 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Bahia_Banderas) {
+ {-9223372036854775808 -25260 0 LMT}
+ {-1514739600 -25200 0 MST}
+ {-1343066400 -21600 0 CST}
+ {-1234807200 -25200 0 MST}
+ {-1220292000 -21600 0 CST}
+ {-1207159200 -25200 0 MST}
+ {-1191344400 -21600 0 CST}
+ {-873828000 -25200 0 MST}
+ {-661539600 -28800 0 PST}
+ {28800 -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}
+ {989139600 -21600 1 MDT}
+ {1001836800 -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}
+ {1175418000 -21600 1 MDT}
+ {1193558400 -25200 0 MST}
+ {1207472400 -21600 1 MDT}
+ {1225008000 -25200 0 MST}
+ {1238922000 -21600 1 MDT}
+ {1256457600 -25200 0 MST}
+ {1270371600 -18000 0 CDT}
+ {1288508400 -21600 0 CST}
+ {1301817600 -18000 1 CDT}
+ {1319958000 -21600 0 CST}
+ {1333267200 -18000 1 CDT}
+ {1351407600 -21600 0 CST}
+ {1365321600 -18000 1 CDT}
+ {1382857200 -21600 0 CST}
+ {1396771200 -18000 1 CDT}
+ {1414306800 -21600 0 CST}
+ {1428220800 -18000 1 CDT}
+ {1445756400 -21600 0 CST}
+ {1459670400 -18000 1 CDT}
+ {1477810800 -21600 0 CST}
+ {1491120000 -18000 1 CDT}
+ {1509260400 -21600 0 CST}
+ {1522569600 -18000 1 CDT}
+ {1540710000 -21600 0 CST}
+ {1554624000 -18000 1 CDT}
+ {1572159600 -21600 0 CST}
+ {1586073600 -18000 1 CDT}
+ {1603609200 -21600 0 CST}
+ {1617523200 -18000 1 CDT}
+ {1635663600 -21600 0 CST}
+ {1648972800 -18000 1 CDT}
+ {1667113200 -21600 0 CST}
+ {1680422400 -18000 1 CDT}
+ {1698562800 -21600 0 CST}
+ {1712476800 -18000 1 CDT}
+ {1730012400 -21600 0 CST}
+ {1743926400 -18000 1 CDT}
+ {1761462000 -21600 0 CST}
+ {1775376000 -18000 1 CDT}
+ {1792911600 -21600 0 CST}
+ {1806825600 -18000 1 CDT}
+ {1824966000 -21600 0 CST}
+ {1838275200 -18000 1 CDT}
+ {1856415600 -21600 0 CST}
+ {1869724800 -18000 1 CDT}
+ {1887865200 -21600 0 CST}
+ {1901779200 -18000 1 CDT}
+ {1919314800 -21600 0 CST}
+ {1933228800 -18000 1 CDT}
+ {1950764400 -21600 0 CST}
+ {1964678400 -18000 1 CDT}
+ {1982818800 -21600 0 CST}
+ {1996128000 -18000 1 CDT}
+ {2014268400 -21600 0 CST}
+ {2027577600 -18000 1 CDT}
+ {2045718000 -21600 0 CST}
+ {2059027200 -18000 1 CDT}
+ {2077167600 -21600 0 CST}
+ {2091081600 -18000 1 CDT}
+ {2108617200 -21600 0 CST}
+ {2122531200 -18000 1 CDT}
+ {2140066800 -21600 0 CST}
+ {2153980800 -18000 1 CDT}
+ {2172121200 -21600 0 CST}
+ {2185430400 -18000 1 CDT}
+ {2203570800 -21600 0 CST}
+ {2216880000 -18000 1 CDT}
+ {2235020400 -21600 0 CST}
+ {2248934400 -18000 1 CDT}
+ {2266470000 -21600 0 CST}
+ {2280384000 -18000 1 CDT}
+ {2297919600 -21600 0 CST}
+ {2311833600 -18000 1 CDT}
+ {2329369200 -21600 0 CST}
+ {2343283200 -18000 1 CDT}
+ {2361423600 -21600 0 CST}
+ {2374732800 -18000 1 CDT}
+ {2392873200 -21600 0 CST}
+ {2406182400 -18000 1 CDT}
+ {2424322800 -21600 0 CST}
+ {2438236800 -18000 1 CDT}
+ {2455772400 -21600 0 CST}
+ {2469686400 -18000 1 CDT}
+ {2487222000 -21600 0 CST}
+ {2501136000 -18000 1 CDT}
+ {2519276400 -21600 0 CST}
+ {2532585600 -18000 1 CDT}
+ {2550726000 -21600 0 CST}
+ {2564035200 -18000 1 CDT}
+ {2582175600 -21600 0 CST}
+ {2596089600 -18000 1 CDT}
+ {2613625200 -21600 0 CST}
+ {2627539200 -18000 1 CDT}
+ {2645074800 -21600 0 CST}
+ {2658988800 -18000 1 CDT}
+ {2676524400 -21600 0 CST}
+ {2690438400 -18000 1 CDT}
+ {2708578800 -21600 0 CST}
+ {2721888000 -18000 1 CDT}
+ {2740028400 -21600 0 CST}
+ {2753337600 -18000 1 CDT}
+ {2771478000 -21600 0 CST}
+ {2785392000 -18000 1 CDT}
+ {2802927600 -21600 0 CST}
+ {2816841600 -18000 1 CDT}
+ {2834377200 -21600 0 CST}
+ {2848291200 -18000 1 CDT}
+ {2866431600 -21600 0 CST}
+ {2879740800 -18000 1 CDT}
+ {2897881200 -21600 0 CST}
+ {2911190400 -18000 1 CDT}
+ {2929330800 -21600 0 CST}
+ {2942640000 -18000 1 CDT}
+ {2960780400 -21600 0 CST}
+ {2974694400 -18000 1 CDT}
+ {2992230000 -21600 0 CST}
+ {3006144000 -18000 1 CDT}
+ {3023679600 -21600 0 CST}
+ {3037593600 -18000 1 CDT}
+ {3055734000 -21600 0 CST}
+ {3069043200 -18000 1 CDT}
+ {3087183600 -21600 0 CST}
+ {3100492800 -18000 1 CDT}
+ {3118633200 -21600 0 CST}
+ {3132547200 -18000 1 CDT}
+ {3150082800 -21600 0 CST}
+ {3163996800 -18000 1 CDT}
+ {3181532400 -21600 0 CST}
+ {3195446400 -18000 1 CDT}
+ {3212982000 -21600 0 CST}
+ {3226896000 -18000 1 CDT}
+ {3245036400 -21600 0 CST}
+ {3258345600 -18000 1 CDT}
+ {3276486000 -21600 0 CST}
+ {3289795200 -18000 1 CDT}
+ {3307935600 -21600 0 CST}
+ {3321849600 -18000 1 CDT}
+ {3339385200 -21600 0 CST}
+ {3353299200 -18000 1 CDT}
+ {3370834800 -21600 0 CST}
+ {3384748800 -18000 1 CDT}
+ {3402889200 -21600 0 CST}
+ {3416198400 -18000 1 CDT}
+ {3434338800 -21600 0 CST}
+ {3447648000 -18000 1 CDT}
+ {3465788400 -21600 0 CST}
+ {3479702400 -18000 1 CDT}
+ {3497238000 -21600 0 CST}
+ {3511152000 -18000 1 CDT}
+ {3528687600 -21600 0 CST}
+ {3542601600 -18000 1 CDT}
+ {3560137200 -21600 0 CST}
+ {3574051200 -18000 1 CDT}
+ {3592191600 -21600 0 CST}
+ {3605500800 -18000 1 CDT}
+ {3623641200 -21600 0 CST}
+ {3636950400 -18000 1 CDT}
+ {3655090800 -21600 0 CST}
+ {3669004800 -18000 1 CDT}
+ {3686540400 -21600 0 CST}
+ {3700454400 -18000 1 CDT}
+ {3717990000 -21600 0 CST}
+ {3731904000 -18000 1 CDT}
+ {3750044400 -21600 0 CST}
+ {3763353600 -18000 1 CDT}
+ {3781494000 -21600 0 CST}
+ {3794803200 -18000 1 CDT}
+ {3812943600 -21600 0 CST}
+ {3826252800 -18000 1 CDT}
+ {3844393200 -21600 0 CST}
+ {3858307200 -18000 1 CDT}
+ {3875842800 -21600 0 CST}
+ {3889756800 -18000 1 CDT}
+ {3907292400 -21600 0 CST}
+ {3921206400 -18000 1 CDT}
+ {3939346800 -21600 0 CST}
+ {3952656000 -18000 1 CDT}
+ {3970796400 -21600 0 CST}
+ {3984105600 -18000 1 CDT}
+ {4002246000 -21600 0 CST}
+ {4016160000 -18000 1 CDT}
+ {4033695600 -21600 0 CST}
+ {4047609600 -18000 1 CDT}
+ {4065145200 -21600 0 CST}
+ {4079059200 -18000 1 CDT}
+ {4096594800 -21600 0 CST}
+}
diff --git a/library/tzdata/America/Barbados b/library/tzdata/America/Barbados
index 13b4356..ea17073 100644
--- a/library/tzdata/America/Barbados
+++ b/library/tzdata/America/Barbados
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Barbados) {
- {-9223372036854775808 -14308 0 LMT}
- {-1451678492 -14308 0 BMT}
- {-1199217692 -14400 0 AST}
+ {-9223372036854775808 -14309 0 LMT}
+ {-1451678491 -14309 0 BMT}
+ {-1199217691 -14400 0 AST}
{234943200 -10800 1 ADT}
{244616400 -14400 0 AST}
{261554400 -10800 1 ADT}
diff --git a/library/tzdata/America/Belem b/library/tzdata/America/Belem
index 979c01f..ed92fd1 100644
--- a/library/tzdata/America/Belem
+++ b/library/tzdata/America/Belem
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Belem) {
{-9223372036854775808 -11636 0 LMT}
diff --git a/library/tzdata/America/Belize b/library/tzdata/America/Belize
index 067e2c8..547fd72 100644
--- a/library/tzdata/America/Belize
+++ b/library/tzdata/America/Belize
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Belize) {
{-9223372036854775808 -21168 0 LMT}
diff --git a/library/tzdata/America/Blanc-Sablon b/library/tzdata/America/Blanc-Sablon
new file mode 100644
index 0000000..d5485e8
--- /dev/null
+++ b/library/tzdata/America/Blanc-Sablon
@@ -0,0 +1,12 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Blanc-Sablon) {
+ {-9223372036854775808 -13708 0 LMT}
+ {-2713896692 -14400 0 AST}
+ {-1632074400 -10800 1 ADT}
+ {-1615143600 -14400 0 AST}
+ {-880221600 -10800 1 AWT}
+ {-769395600 -10800 1 APT}
+ {-765399600 -14400 0 AST}
+ {14400 -14400 0 AST}
+}
diff --git a/library/tzdata/America/Boa_Vista b/library/tzdata/America/Boa_Vista
index 5f2d89a..c85bc27 100644
--- a/library/tzdata/America/Boa_Vista
+++ b/library/tzdata/America/Boa_Vista
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Boa_Vista) {
{-9223372036854775808 -14560 0 LMT}
diff --git a/library/tzdata/America/Bogota b/library/tzdata/America/Bogota
index 6c1da7d..b28abc1 100644
--- a/library/tzdata/America/Bogota
+++ b/library/tzdata/America/Bogota
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Bogota) {
- {-9223372036854775808 -17780 0 LMT}
- {-2707671820 -17780 0 BMT}
- {-1739041420 -18000 0 COT}
- {704782800 -14400 1 COST}
- {725774400 -18000 0 COT}
+ {-9223372036854775808 -17776 0 LMT}
+ {-2707671824 -17776 0 BMT}
+ {-1739041424 -18000 0 COT}
+ {704869200 -14400 1 COST}
+ {733896000 -18000 0 COT}
}
diff --git a/library/tzdata/America/Boise b/library/tzdata/America/Boise
index 4a75f3a..62b22a0 100644
--- a/library/tzdata/America/Boise
+++ b/library/tzdata/America/Boise
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Boise) {
{-9223372036854775808 -27889 0 LMT}
@@ -92,190 +92,190 @@ set TZData(:America/Boise) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/America/Buenos_Aires b/library/tzdata/America/Buenos_Aires
index 039cb36..1389195 100644
--- a/library/tzdata/America/Buenos_Aires
+++ b/library/tzdata/America/Buenos_Aires
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Buenos_Aires)]} {
LoadTimeZoneFile America/Argentina/Buenos_Aires
}
diff --git a/library/tzdata/America/Cambridge_Bay b/library/tzdata/America/Cambridge_Bay
index 06486db..23004bb 100644
--- a/library/tzdata/America/Cambridge_Bay
+++ b/library/tzdata/America/Cambridge_Bay
@@ -1,12 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cambridge_Bay) {
- {-9223372036854775808 -25220 0 LMT}
- {-2713885180 -25200 0 MST}
- {-1632063600 -21600 1 MDT}
- {-1615132800 -25200 0 MST}
- {-1596985200 -21600 1 MDT}
- {-1583172000 -25200 0 MST}
+ {-9223372036854775808 0 0 zzz}
+ {-1577923200 -25200 0 MST}
{-880210800 -21600 1 MWT}
{-769395600 -21600 1 MPT}
{-765388800 -25200 0 MST}
@@ -67,190 +63,190 @@ set TZData(:America/Cambridge_Bay) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/America/Campo_Grande b/library/tzdata/America/Campo_Grande
index 9150aef..2cafe14 100644
--- a/library/tzdata/America/Campo_Grande
+++ b/library/tzdata/America/Campo_Grande
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Campo_Grande) {
{-9223372036854775808 -13108 0 LMT}
@@ -67,9 +67,9 @@ set TZData(:America/Campo_Grande) {
{1108868400 -14400 0 AMT}
{1129435200 -10800 1 AMST}
{1140318000 -14400 0 AMT}
- {1160884800 -10800 1 AMST}
- {1171767600 -14400 0 AMT}
- {1192939200 -10800 1 AMST}
+ {1162699200 -10800 1 AMST}
+ {1172372400 -14400 0 AMT}
+ {1192334400 -10800 1 AMST}
{1203217200 -14400 0 AMT}
{1224388800 -10800 1 AMST}
{1234666800 -14400 0 AMT}
@@ -78,13 +78,13 @@ set TZData(:America/Campo_Grande) {
{1287288000 -10800 1 AMST}
{1298170800 -14400 0 AMT}
{1318737600 -10800 1 AMST}
- {1329620400 -14400 0 AMT}
+ {1330225200 -14400 0 AMT}
{1350792000 -10800 1 AMST}
{1361070000 -14400 0 AMT}
{1382241600 -10800 1 AMST}
{1392519600 -14400 0 AMT}
{1413691200 -10800 1 AMST}
- {1423969200 -14400 0 AMT}
+ {1424574000 -14400 0 AMT}
{1445140800 -10800 1 AMST}
{1456023600 -14400 0 AMT}
{1476590400 -10800 1 AMST}
@@ -100,13 +100,13 @@ set TZData(:America/Campo_Grande) {
{1634443200 -10800 1 AMST}
{1645326000 -14400 0 AMT}
{1665892800 -10800 1 AMST}
- {1676775600 -14400 0 AMT}
+ {1677380400 -14400 0 AMT}
{1697342400 -10800 1 AMST}
{1708225200 -14400 0 AMT}
{1729396800 -10800 1 AMST}
{1739674800 -14400 0 AMT}
{1760846400 -10800 1 AMST}
- {1771124400 -14400 0 AMT}
+ {1771729200 -14400 0 AMT}
{1792296000 -10800 1 AMST}
{1803178800 -14400 0 AMT}
{1823745600 -10800 1 AMST}
@@ -122,13 +122,13 @@ set TZData(:America/Campo_Grande) {
{1981598400 -10800 1 AMST}
{1992481200 -14400 0 AMT}
{2013048000 -10800 1 AMST}
- {2023930800 -14400 0 AMT}
+ {2024535600 -14400 0 AMT}
{2044497600 -10800 1 AMST}
{2055380400 -14400 0 AMT}
{2076552000 -10800 1 AMST}
{2086830000 -14400 0 AMT}
{2108001600 -10800 1 AMST}
- {2118279600 -14400 0 AMT}
+ {2118884400 -14400 0 AMT}
{2139451200 -10800 1 AMST}
{2150334000 -14400 0 AMT}
{2170900800 -10800 1 AMST}
diff --git a/library/tzdata/America/Cancun b/library/tzdata/America/Cancun
index 8ecde30..1620b15 100644
--- a/library/tzdata/America/Cancun
+++ b/library/tzdata/America/Cancun
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cancun) {
{-9223372036854775808 -20824 0 LMT}
diff --git a/library/tzdata/America/Caracas b/library/tzdata/America/Caracas
index 259662d..2ba87ae 100644
--- a/library/tzdata/America/Caracas
+++ b/library/tzdata/America/Caracas
@@ -1,8 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Caracas) {
{-9223372036854775808 -16064 0 LMT}
{-2524505536 -16060 0 CMT}
{-1826739140 -16200 0 VET}
{-157750200 -14400 0 VET}
+ {1197183600 -16200 0 VET}
}
diff --git a/library/tzdata/America/Catamarca b/library/tzdata/America/Catamarca
index 0ba0ef9..01c8ab6 100644
--- a/library/tzdata/America/Catamarca
+++ b/library/tzdata/America/Catamarca
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Catamarca)]} {
LoadTimeZoneFile America/Argentina/Catamarca
}
diff --git a/library/tzdata/America/Cayenne b/library/tzdata/America/Cayenne
index 24f9d58..de3d65b 100644
--- a/library/tzdata/America/Cayenne
+++ b/library/tzdata/America/Cayenne
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cayenne) {
{-9223372036854775808 -12560 0 LMT}
diff --git a/library/tzdata/America/Cayman b/library/tzdata/America/Cayman
index 635bcdd..3e2e3cc 100644
--- a/library/tzdata/America/Cayman
+++ b/library/tzdata/America/Cayman
@@ -1,7 +1,7 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cayman) {
{-9223372036854775808 -19532 0 LMT}
- {-2524502068 -18432 0 KMT}
- {-1827687168 -18000 0 EST}
+ {-2524502068 -18431 0 KMT}
+ {-1827687169 -18000 0 EST}
}
diff --git a/library/tzdata/America/Chicago b/library/tzdata/America/Chicago
index 63b5b95..545aedb 100644
--- a/library/tzdata/America/Chicago
+++ b/library/tzdata/America/Chicago
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Chicago) {
{-9223372036854775808 -21036 0 LMT}
@@ -180,190 +180,190 @@ set TZData(:America/Chicago) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162105200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193554800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1225004400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256454000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288508400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319958000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351407600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382857200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414306800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445756400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477810800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509260400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540710000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572159600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603609200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635663600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667113200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698562800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1730012400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761462000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792911600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824966000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856415600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887865200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919314800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950764400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982818800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014268400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045718000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077167600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108617200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140066800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172121200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203570800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235020400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266470000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297919600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329369200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361423600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392873200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424322800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455772400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487222000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519276400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550726000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582175600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613625200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645074800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676524400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708578800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740028400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771478000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802927600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834377200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866431600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897881200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929330800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960780400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992230000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023679600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055734000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087183600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118633200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150082800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181532400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212982000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245036400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276486000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307935600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339385200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370834800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402889200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434338800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465788400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497238000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528687600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560137200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592191600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623641200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655090800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686540400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717990000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750044400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781494000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812943600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844393200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875842800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907292400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939346800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970796400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002246000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033695600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065145200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096594800 -21600 0 CST}
+ {1173600000 -18000 1 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/Chihuahua b/library/tzdata/America/Chihuahua
index 085a379..5444930 100644
--- a/library/tzdata/America/Chihuahua
+++ b/library/tzdata/America/Chihuahua
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Chihuahua) {
{-9223372036854775808 -25460 0 LMT}
diff --git a/library/tzdata/America/Coral_Harbour b/library/tzdata/America/Coral_Harbour
new file mode 100644
index 0000000..a27dc03
--- /dev/null
+++ b/library/tzdata/America/Coral_Harbour
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Atikokan)]} {
+ LoadTimeZoneFile America/Atikokan
+}
+set TZData(:America/Coral_Harbour) $TZData(:America/Atikokan)
diff --git a/library/tzdata/America/Cordoba b/library/tzdata/America/Cordoba
index e0160ae..c881558 100644
--- a/library/tzdata/America/Cordoba
+++ b/library/tzdata/America/Cordoba
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Cordoba)]} {
LoadTimeZoneFile America/Argentina/Cordoba
}
diff --git a/library/tzdata/America/Costa_Rica b/library/tzdata/America/Costa_Rica
index 82dc632..8fc9343 100644
--- a/library/tzdata/America/Costa_Rica
+++ b/library/tzdata/America/Costa_Rica
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Costa_Rica) {
- {-9223372036854775808 -20180 0 LMT}
- {-2524501420 -20180 0 SJMT}
- {-1545071020 -21600 0 CST}
+ {-9223372036854775808 -20173 0 LMT}
+ {-2524501427 -20173 0 SJMT}
+ {-1545071027 -21600 0 CST}
{288770400 -18000 1 CDT}
{297234000 -21600 0 CST}
{320220000 -18000 1 CDT}
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/Cuiaba b/library/tzdata/America/Cuiaba
index ce667ba..0301862 100644
--- a/library/tzdata/America/Cuiaba
+++ b/library/tzdata/America/Cuiaba
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cuiaba) {
{-9223372036854775808 -13460 0 LMT}
@@ -67,9 +67,9 @@ set TZData(:America/Cuiaba) {
{1108868400 -14400 0 AMT}
{1129435200 -10800 1 AMST}
{1140318000 -14400 0 AMT}
- {1160884800 -10800 1 AMST}
- {1171767600 -14400 0 AMT}
- {1192939200 -10800 1 AMST}
+ {1162699200 -10800 1 AMST}
+ {1172372400 -14400 0 AMT}
+ {1192334400 -10800 1 AMST}
{1203217200 -14400 0 AMT}
{1224388800 -10800 1 AMST}
{1234666800 -14400 0 AMT}
@@ -78,13 +78,13 @@ set TZData(:America/Cuiaba) {
{1287288000 -10800 1 AMST}
{1298170800 -14400 0 AMT}
{1318737600 -10800 1 AMST}
- {1329620400 -14400 0 AMT}
+ {1330225200 -14400 0 AMT}
{1350792000 -10800 1 AMST}
{1361070000 -14400 0 AMT}
{1382241600 -10800 1 AMST}
{1392519600 -14400 0 AMT}
{1413691200 -10800 1 AMST}
- {1423969200 -14400 0 AMT}
+ {1424574000 -14400 0 AMT}
{1445140800 -10800 1 AMST}
{1456023600 -14400 0 AMT}
{1476590400 -10800 1 AMST}
@@ -100,13 +100,13 @@ set TZData(:America/Cuiaba) {
{1634443200 -10800 1 AMST}
{1645326000 -14400 0 AMT}
{1665892800 -10800 1 AMST}
- {1676775600 -14400 0 AMT}
+ {1677380400 -14400 0 AMT}
{1697342400 -10800 1 AMST}
{1708225200 -14400 0 AMT}
{1729396800 -10800 1 AMST}
{1739674800 -14400 0 AMT}
{1760846400 -10800 1 AMST}
- {1771124400 -14400 0 AMT}
+ {1771729200 -14400 0 AMT}
{1792296000 -10800 1 AMST}
{1803178800 -14400 0 AMT}
{1823745600 -10800 1 AMST}
@@ -122,13 +122,13 @@ set TZData(:America/Cuiaba) {
{1981598400 -10800 1 AMST}
{1992481200 -14400 0 AMT}
{2013048000 -10800 1 AMST}
- {2023930800 -14400 0 AMT}
+ {2024535600 -14400 0 AMT}
{2044497600 -10800 1 AMST}
{2055380400 -14400 0 AMT}
{2076552000 -10800 1 AMST}
{2086830000 -14400 0 AMT}
{2108001600 -10800 1 AMST}
- {2118279600 -14400 0 AMT}
+ {2118884400 -14400 0 AMT}
{2139451200 -10800 1 AMST}
{2150334000 -14400 0 AMT}
{2170900800 -10800 1 AMST}
diff --git a/library/tzdata/America/Curacao b/library/tzdata/America/Curacao
index f2fa292..5189e9c 100644
--- a/library/tzdata/America/Curacao
+++ b/library/tzdata/America/Curacao
@@ -1,7 +1,7 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Curacao) {
- {-9223372036854775808 -16544 0 LMT}
- {-1826738656 -16200 0 ANT}
+ {-9223372036854775808 -16547 0 LMT}
+ {-1826738653 -16200 0 ANT}
{-157750200 -14400 0 AST}
}
diff --git a/library/tzdata/America/Danmarkshavn b/library/tzdata/America/Danmarkshavn
index 7738045..8d66d3a 100644
--- a/library/tzdata/America/Danmarkshavn
+++ b/library/tzdata/America/Danmarkshavn
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Danmarkshavn) {
{-9223372036854775808 -4480 0 LMT}
diff --git a/library/tzdata/America/Dawson b/library/tzdata/America/Dawson
index c5f5fd2..8d2b641 100644
--- a/library/tzdata/America/Dawson
+++ b/library/tzdata/America/Dawson
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Dawson) {
{-9223372036854775808 -33460 0 LMT}
@@ -12,7 +12,7 @@ set TZData(:America/Dawson) {
{-765381600 -32400 0 YST}
{-147884400 -25200 1 YDDT}
{-131554800 -32400 0 YST}
- {120646800 -28800 0 PST}
+ {315561600 -28800 0 PST}
{325677600 -25200 1 PDT}
{341398800 -28800 0 PST}
{357127200 -25200 1 PDT}
@@ -67,190 +67,190 @@ set TZData(:America/Dawson) {
{1130662800 -28800 0 PST}
{1143972000 -25200 1 PDT}
{1162112400 -28800 0 PST}
- {1175421600 -25200 1 PDT}
- {1193562000 -28800 0 PST}
- {1207476000 -25200 1 PDT}
- {1225011600 -28800 0 PST}
- {1238925600 -25200 1 PDT}
- {1256461200 -28800 0 PST}
- {1270375200 -25200 1 PDT}
- {1288515600 -28800 0 PST}
- {1301824800 -25200 1 PDT}
- {1319965200 -28800 0 PST}
- {1333274400 -25200 1 PDT}
- {1351414800 -28800 0 PST}
- {1365328800 -25200 1 PDT}
- {1382864400 -28800 0 PST}
- {1396778400 -25200 1 PDT}
- {1414314000 -28800 0 PST}
- {1428228000 -25200 1 PDT}
- {1445763600 -28800 0 PST}
- {1459677600 -25200 1 PDT}
- {1477818000 -28800 0 PST}
- {1491127200 -25200 1 PDT}
- {1509267600 -28800 0 PST}
- {1522576800 -25200 1 PDT}
- {1540717200 -28800 0 PST}
- {1554631200 -25200 1 PDT}
- {1572166800 -28800 0 PST}
- {1586080800 -25200 1 PDT}
- {1603616400 -28800 0 PST}
- {1617530400 -25200 1 PDT}
- {1635670800 -28800 0 PST}
- {1648980000 -25200 1 PDT}
- {1667120400 -28800 0 PST}
- {1680429600 -25200 1 PDT}
- {1698570000 -28800 0 PST}
- {1712484000 -25200 1 PDT}
- {1730019600 -28800 0 PST}
- {1743933600 -25200 1 PDT}
- {1761469200 -28800 0 PST}
- {1775383200 -25200 1 PDT}
- {1792918800 -28800 0 PST}
- {1806832800 -25200 1 PDT}
- {1824973200 -28800 0 PST}
- {1838282400 -25200 1 PDT}
- {1856422800 -28800 0 PST}
- {1869732000 -25200 1 PDT}
- {1887872400 -28800 0 PST}
- {1901786400 -25200 1 PDT}
- {1919322000 -28800 0 PST}
- {1933236000 -25200 1 PDT}
- {1950771600 -28800 0 PST}
- {1964685600 -25200 1 PDT}
- {1982826000 -28800 0 PST}
- {1996135200 -25200 1 PDT}
- {2014275600 -28800 0 PST}
- {2027584800 -25200 1 PDT}
- {2045725200 -28800 0 PST}
- {2059034400 -25200 1 PDT}
- {2077174800 -28800 0 PST}
- {2091088800 -25200 1 PDT}
- {2108624400 -28800 0 PST}
- {2122538400 -25200 1 PDT}
- {2140074000 -28800 0 PST}
- {2153988000 -25200 1 PDT}
- {2172128400 -28800 0 PST}
- {2185437600 -25200 1 PDT}
- {2203578000 -28800 0 PST}
- {2216887200 -25200 1 PDT}
- {2235027600 -28800 0 PST}
- {2248941600 -25200 1 PDT}
- {2266477200 -28800 0 PST}
- {2280391200 -25200 1 PDT}
- {2297926800 -28800 0 PST}
- {2311840800 -25200 1 PDT}
- {2329376400 -28800 0 PST}
- {2343290400 -25200 1 PDT}
- {2361430800 -28800 0 PST}
- {2374740000 -25200 1 PDT}
- {2392880400 -28800 0 PST}
- {2406189600 -25200 1 PDT}
- {2424330000 -28800 0 PST}
- {2438244000 -25200 1 PDT}
- {2455779600 -28800 0 PST}
- {2469693600 -25200 1 PDT}
- {2487229200 -28800 0 PST}
- {2501143200 -25200 1 PDT}
- {2519283600 -28800 0 PST}
- {2532592800 -25200 1 PDT}
- {2550733200 -28800 0 PST}
- {2564042400 -25200 1 PDT}
- {2582182800 -28800 0 PST}
- {2596096800 -25200 1 PDT}
- {2613632400 -28800 0 PST}
- {2627546400 -25200 1 PDT}
- {2645082000 -28800 0 PST}
- {2658996000 -25200 1 PDT}
- {2676531600 -28800 0 PST}
- {2690445600 -25200 1 PDT}
- {2708586000 -28800 0 PST}
- {2721895200 -25200 1 PDT}
- {2740035600 -28800 0 PST}
- {2753344800 -25200 1 PDT}
- {2771485200 -28800 0 PST}
- {2785399200 -25200 1 PDT}
- {2802934800 -28800 0 PST}
- {2816848800 -25200 1 PDT}
- {2834384400 -28800 0 PST}
- {2848298400 -25200 1 PDT}
- {2866438800 -28800 0 PST}
- {2879748000 -25200 1 PDT}
- {2897888400 -28800 0 PST}
- {2911197600 -25200 1 PDT}
- {2929338000 -28800 0 PST}
- {2942647200 -25200 1 PDT}
- {2960787600 -28800 0 PST}
- {2974701600 -25200 1 PDT}
- {2992237200 -28800 0 PST}
- {3006151200 -25200 1 PDT}
- {3023686800 -28800 0 PST}
- {3037600800 -25200 1 PDT}
- {3055741200 -28800 0 PST}
- {3069050400 -25200 1 PDT}
- {3087190800 -28800 0 PST}
- {3100500000 -25200 1 PDT}
- {3118640400 -28800 0 PST}
- {3132554400 -25200 1 PDT}
- {3150090000 -28800 0 PST}
- {3164004000 -25200 1 PDT}
- {3181539600 -28800 0 PST}
- {3195453600 -25200 1 PDT}
- {3212989200 -28800 0 PST}
- {3226903200 -25200 1 PDT}
- {3245043600 -28800 0 PST}
- {3258352800 -25200 1 PDT}
- {3276493200 -28800 0 PST}
- {3289802400 -25200 1 PDT}
- {3307942800 -28800 0 PST}
- {3321856800 -25200 1 PDT}
- {3339392400 -28800 0 PST}
- {3353306400 -25200 1 PDT}
- {3370842000 -28800 0 PST}
- {3384756000 -25200 1 PDT}
- {3402896400 -28800 0 PST}
- {3416205600 -25200 1 PDT}
- {3434346000 -28800 0 PST}
- {3447655200 -25200 1 PDT}
- {3465795600 -28800 0 PST}
- {3479709600 -25200 1 PDT}
- {3497245200 -28800 0 PST}
- {3511159200 -25200 1 PDT}
- {3528694800 -28800 0 PST}
- {3542608800 -25200 1 PDT}
- {3560144400 -28800 0 PST}
- {3574058400 -25200 1 PDT}
- {3592198800 -28800 0 PST}
- {3605508000 -25200 1 PDT}
- {3623648400 -28800 0 PST}
- {3636957600 -25200 1 PDT}
- {3655098000 -28800 0 PST}
- {3669012000 -25200 1 PDT}
- {3686547600 -28800 0 PST}
- {3700461600 -25200 1 PDT}
- {3717997200 -28800 0 PST}
- {3731911200 -25200 1 PDT}
- {3750051600 -28800 0 PST}
- {3763360800 -25200 1 PDT}
- {3781501200 -28800 0 PST}
- {3794810400 -25200 1 PDT}
- {3812950800 -28800 0 PST}
- {3826260000 -25200 1 PDT}
- {3844400400 -28800 0 PST}
- {3858314400 -25200 1 PDT}
- {3875850000 -28800 0 PST}
- {3889764000 -25200 1 PDT}
- {3907299600 -28800 0 PST}
- {3921213600 -25200 1 PDT}
- {3939354000 -28800 0 PST}
- {3952663200 -25200 1 PDT}
- {3970803600 -28800 0 PST}
- {3984112800 -25200 1 PDT}
- {4002253200 -28800 0 PST}
- {4016167200 -25200 1 PDT}
- {4033702800 -28800 0 PST}
- {4047616800 -25200 1 PDT}
- {4065152400 -28800 0 PST}
- {4079066400 -25200 1 PDT}
- {4096602000 -28800 0 PST}
+ {1173607200 -25200 1 PDT}
+ {1194166800 -28800 0 PST}
+ {1205056800 -25200 1 PDT}
+ {1225616400 -28800 0 PST}
+ {1236506400 -25200 1 PDT}
+ {1257066000 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
diff --git a/library/tzdata/America/Dawson_Creek b/library/tzdata/America/Dawson_Creek
index 36a3f93..a0b5c44 100644
--- a/library/tzdata/America/Dawson_Creek
+++ b/library/tzdata/America/Dawson_Creek
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/Denver b/library/tzdata/America/Denver
index 11337b3..06bc80d 100644
--- a/library/tzdata/America/Denver
+++ b/library/tzdata/America/Denver
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Denver) {
{-9223372036854775808 -25196 0 LMT}
@@ -102,190 +102,190 @@ set TZData(:America/Denver) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/America/Detroit b/library/tzdata/America/Detroit
index b109fdb..696a663 100644
--- a/library/tzdata/America/Detroit
+++ b/library/tzdata/America/Detroit
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Detroit) {
{-9223372036854775808 -19931 0 LMT}
@@ -83,190 +83,190 @@ set TZData(:America/Detroit) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Dominica b/library/tzdata/America/Dominica
index 32d8c06..b97cb0e 100644
--- a/library/tzdata/America/Dominica
+++ b/library/tzdata/America/Dominica
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Dominica) {
- {-9223372036854775808 -14736 0 LMT}
- {-1846266804 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Dominica) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Edmonton b/library/tzdata/America/Edmonton
index a13133e..1ed38be 100644
--- a/library/tzdata/America/Edmonton
+++ b/library/tzdata/America/Edmonton
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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}
@@ -54,6 +54,7 @@ set TZData(:America/Edmonton) {
{499248000 -25200 0 MST}
{514976400 -21600 1 MDT}
{530697600 -25200 0 MST}
+ {536482800 -25200 0 MST}
{544611600 -21600 1 MDT}
{562147200 -25200 0 MST}
{576061200 -21600 1 MDT}
@@ -94,190 +95,190 @@ set TZData(:America/Edmonton) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/America/Eirunepe b/library/tzdata/America/Eirunepe
index 45a5a5d..86dcd8f 100644
--- a/library/tzdata/America/Eirunepe
+++ b/library/tzdata/America/Eirunepe
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Eirunepe) {
{-9223372036854775808 -16768 0 LMT}
@@ -36,4 +36,5 @@ set TZData(:America/Eirunepe) {
{750834000 -14400 1 ACST}
{761716800 -18000 0 ACT}
{780206400 -18000 0 ACT}
+ {1214283600 -14400 0 AMT}
}
diff --git a/library/tzdata/America/El_Salvador b/library/tzdata/America/El_Salvador
index a427a47..75d8129 100644
--- a/library/tzdata/America/El_Salvador
+++ b/library/tzdata/America/El_Salvador
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/El_Salvador) {
{-9223372036854775808 -21408 0 LMT}
diff --git a/library/tzdata/America/Ensenada b/library/tzdata/America/Ensenada
index 0ad1024..f600305 100644
--- a/library/tzdata/America/Ensenada
+++ b/library/tzdata/America/Ensenada
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Tijuana)]} {
LoadTimeZoneFile America/Tijuana
}
diff --git a/library/tzdata/America/Fort_Wayne b/library/tzdata/America/Fort_Wayne
index a19a4dd..9514d57 100644
--- a/library/tzdata/America/Fort_Wayne
+++ b/library/tzdata/America/Fort_Wayne
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Indianapolis)]} {
- LoadTimeZoneFile America/Indianapolis
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Indiana/Indianapolis)]} {
+ LoadTimeZoneFile America/Indiana/Indianapolis
}
-set TZData(:America/Fort_Wayne) $TZData(:America/Indianapolis)
+set TZData(:America/Fort_Wayne) $TZData(:America/Indiana/Indianapolis)
diff --git a/library/tzdata/America/Fortaleza b/library/tzdata/America/Fortaleza
index 3866604..581faa5 100644
--- a/library/tzdata/America/Fortaleza
+++ b/library/tzdata/America/Fortaleza
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Fortaleza) {
{-9223372036854775808 -9240 0 LMT}
diff --git a/library/tzdata/America/Glace_Bay b/library/tzdata/America/Glace_Bay
index 4252949..8ee9eec 100644
--- a/library/tzdata/America/Glace_Bay
+++ b/library/tzdata/America/Glace_Bay
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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}
@@ -84,190 +84,190 @@ set TZData(:America/Glace_Bay) {
{1130648400 -14400 0 AST}
{1143957600 -10800 1 ADT}
{1162098000 -14400 0 AST}
- {1175407200 -10800 1 ADT}
- {1193547600 -14400 0 AST}
- {1207461600 -10800 1 ADT}
- {1224997200 -14400 0 AST}
- {1238911200 -10800 1 ADT}
- {1256446800 -14400 0 AST}
- {1270360800 -10800 1 ADT}
- {1288501200 -14400 0 AST}
- {1301810400 -10800 1 ADT}
- {1319950800 -14400 0 AST}
- {1333260000 -10800 1 ADT}
- {1351400400 -14400 0 AST}
- {1365314400 -10800 1 ADT}
- {1382850000 -14400 0 AST}
- {1396764000 -10800 1 ADT}
- {1414299600 -14400 0 AST}
- {1428213600 -10800 1 ADT}
- {1445749200 -14400 0 AST}
- {1459663200 -10800 1 ADT}
- {1477803600 -14400 0 AST}
- {1491112800 -10800 1 ADT}
- {1509253200 -14400 0 AST}
- {1522562400 -10800 1 ADT}
- {1540702800 -14400 0 AST}
- {1554616800 -10800 1 ADT}
- {1572152400 -14400 0 AST}
- {1586066400 -10800 1 ADT}
- {1603602000 -14400 0 AST}
- {1617516000 -10800 1 ADT}
- {1635656400 -14400 0 AST}
- {1648965600 -10800 1 ADT}
- {1667106000 -14400 0 AST}
- {1680415200 -10800 1 ADT}
- {1698555600 -14400 0 AST}
- {1712469600 -10800 1 ADT}
- {1730005200 -14400 0 AST}
- {1743919200 -10800 1 ADT}
- {1761454800 -14400 0 AST}
- {1775368800 -10800 1 ADT}
- {1792904400 -14400 0 AST}
- {1806818400 -10800 1 ADT}
- {1824958800 -14400 0 AST}
- {1838268000 -10800 1 ADT}
- {1856408400 -14400 0 AST}
- {1869717600 -10800 1 ADT}
- {1887858000 -14400 0 AST}
- {1901772000 -10800 1 ADT}
- {1919307600 -14400 0 AST}
- {1933221600 -10800 1 ADT}
- {1950757200 -14400 0 AST}
- {1964671200 -10800 1 ADT}
- {1982811600 -14400 0 AST}
- {1996120800 -10800 1 ADT}
- {2014261200 -14400 0 AST}
- {2027570400 -10800 1 ADT}
- {2045710800 -14400 0 AST}
- {2059020000 -10800 1 ADT}
- {2077160400 -14400 0 AST}
- {2091074400 -10800 1 ADT}
- {2108610000 -14400 0 AST}
- {2122524000 -10800 1 ADT}
- {2140059600 -14400 0 AST}
- {2153973600 -10800 1 ADT}
- {2172114000 -14400 0 AST}
- {2185423200 -10800 1 ADT}
- {2203563600 -14400 0 AST}
- {2216872800 -10800 1 ADT}
- {2235013200 -14400 0 AST}
- {2248927200 -10800 1 ADT}
- {2266462800 -14400 0 AST}
- {2280376800 -10800 1 ADT}
- {2297912400 -14400 0 AST}
- {2311826400 -10800 1 ADT}
- {2329362000 -14400 0 AST}
- {2343276000 -10800 1 ADT}
- {2361416400 -14400 0 AST}
- {2374725600 -10800 1 ADT}
- {2392866000 -14400 0 AST}
- {2406175200 -10800 1 ADT}
- {2424315600 -14400 0 AST}
- {2438229600 -10800 1 ADT}
- {2455765200 -14400 0 AST}
- {2469679200 -10800 1 ADT}
- {2487214800 -14400 0 AST}
- {2501128800 -10800 1 ADT}
- {2519269200 -14400 0 AST}
- {2532578400 -10800 1 ADT}
- {2550718800 -14400 0 AST}
- {2564028000 -10800 1 ADT}
- {2582168400 -14400 0 AST}
- {2596082400 -10800 1 ADT}
- {2613618000 -14400 0 AST}
- {2627532000 -10800 1 ADT}
- {2645067600 -14400 0 AST}
- {2658981600 -10800 1 ADT}
- {2676517200 -14400 0 AST}
- {2690431200 -10800 1 ADT}
- {2708571600 -14400 0 AST}
- {2721880800 -10800 1 ADT}
- {2740021200 -14400 0 AST}
- {2753330400 -10800 1 ADT}
- {2771470800 -14400 0 AST}
- {2785384800 -10800 1 ADT}
- {2802920400 -14400 0 AST}
- {2816834400 -10800 1 ADT}
- {2834370000 -14400 0 AST}
- {2848284000 -10800 1 ADT}
- {2866424400 -14400 0 AST}
- {2879733600 -10800 1 ADT}
- {2897874000 -14400 0 AST}
- {2911183200 -10800 1 ADT}
- {2929323600 -14400 0 AST}
- {2942632800 -10800 1 ADT}
- {2960773200 -14400 0 AST}
- {2974687200 -10800 1 ADT}
- {2992222800 -14400 0 AST}
- {3006136800 -10800 1 ADT}
- {3023672400 -14400 0 AST}
- {3037586400 -10800 1 ADT}
- {3055726800 -14400 0 AST}
- {3069036000 -10800 1 ADT}
- {3087176400 -14400 0 AST}
- {3100485600 -10800 1 ADT}
- {3118626000 -14400 0 AST}
- {3132540000 -10800 1 ADT}
- {3150075600 -14400 0 AST}
- {3163989600 -10800 1 ADT}
- {3181525200 -14400 0 AST}
- {3195439200 -10800 1 ADT}
- {3212974800 -14400 0 AST}
- {3226888800 -10800 1 ADT}
- {3245029200 -14400 0 AST}
- {3258338400 -10800 1 ADT}
- {3276478800 -14400 0 AST}
- {3289788000 -10800 1 ADT}
- {3307928400 -14400 0 AST}
- {3321842400 -10800 1 ADT}
- {3339378000 -14400 0 AST}
- {3353292000 -10800 1 ADT}
- {3370827600 -14400 0 AST}
- {3384741600 -10800 1 ADT}
- {3402882000 -14400 0 AST}
- {3416191200 -10800 1 ADT}
- {3434331600 -14400 0 AST}
- {3447640800 -10800 1 ADT}
- {3465781200 -14400 0 AST}
- {3479695200 -10800 1 ADT}
- {3497230800 -14400 0 AST}
- {3511144800 -10800 1 ADT}
- {3528680400 -14400 0 AST}
- {3542594400 -10800 1 ADT}
- {3560130000 -14400 0 AST}
- {3574044000 -10800 1 ADT}
- {3592184400 -14400 0 AST}
- {3605493600 -10800 1 ADT}
- {3623634000 -14400 0 AST}
- {3636943200 -10800 1 ADT}
- {3655083600 -14400 0 AST}
- {3668997600 -10800 1 ADT}
- {3686533200 -14400 0 AST}
- {3700447200 -10800 1 ADT}
- {3717982800 -14400 0 AST}
- {3731896800 -10800 1 ADT}
- {3750037200 -14400 0 AST}
- {3763346400 -10800 1 ADT}
- {3781486800 -14400 0 AST}
- {3794796000 -10800 1 ADT}
- {3812936400 -14400 0 AST}
- {3826245600 -10800 1 ADT}
- {3844386000 -14400 0 AST}
- {3858300000 -10800 1 ADT}
- {3875835600 -14400 0 AST}
- {3889749600 -10800 1 ADT}
- {3907285200 -14400 0 AST}
- {3921199200 -10800 1 ADT}
- {3939339600 -14400 0 AST}
- {3952648800 -10800 1 ADT}
- {3970789200 -14400 0 AST}
- {3984098400 -10800 1 ADT}
- {4002238800 -14400 0 AST}
- {4016152800 -10800 1 ADT}
- {4033688400 -14400 0 AST}
- {4047602400 -10800 1 ADT}
- {4065138000 -14400 0 AST}
- {4079052000 -10800 1 ADT}
- {4096587600 -14400 0 AST}
+ {1173592800 -10800 1 ADT}
+ {1194152400 -14400 0 AST}
+ {1205042400 -10800 1 ADT}
+ {1225602000 -14400 0 AST}
+ {1236492000 -10800 1 ADT}
+ {1257051600 -14400 0 AST}
+ {1268546400 -10800 1 ADT}
+ {1289106000 -14400 0 AST}
+ {1299996000 -10800 1 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/Godthab b/library/tzdata/America/Godthab
index 25140e8..3c003cc 100644
--- a/library/tzdata/America/Godthab
+++ b/library/tzdata/America/Godthab
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Godthab) {
{-9223372036854775808 -12416 0 LMT}
diff --git a/library/tzdata/America/Goose_Bay b/library/tzdata/America/Goose_Bay
index a2b9c45..7b7b3d8 100644
--- a/library/tzdata/America/Goose_Bay
+++ b/library/tzdata/America/Goose_Bay
@@ -1,11 +1,11 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Goose_Bay) {
{-9223372036854775808 -14500 0 LMT}
{-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}
@@ -148,190 +148,191 @@ set TZData(:America/Goose_Bay) {
{1130641260 -14400 0 AST}
{1143950460 -10800 1 ADT}
{1162090860 -14400 0 AST}
- {1175400060 -10800 1 ADT}
- {1193540460 -14400 0 AST}
- {1207454460 -10800 1 ADT}
- {1224990060 -14400 0 AST}
- {1238904060 -10800 1 ADT}
- {1256439660 -14400 0 AST}
- {1270353660 -10800 1 ADT}
- {1288494060 -14400 0 AST}
- {1301803260 -10800 1 ADT}
- {1319943660 -14400 0 AST}
- {1333252860 -10800 1 ADT}
- {1351393260 -14400 0 AST}
- {1365307260 -10800 1 ADT}
- {1382842860 -14400 0 AST}
- {1396756860 -10800 1 ADT}
- {1414292460 -14400 0 AST}
- {1428206460 -10800 1 ADT}
- {1445742060 -14400 0 AST}
- {1459656060 -10800 1 ADT}
- {1477796460 -14400 0 AST}
- {1491105660 -10800 1 ADT}
- {1509246060 -14400 0 AST}
- {1522555260 -10800 1 ADT}
- {1540695660 -14400 0 AST}
- {1554609660 -10800 1 ADT}
- {1572145260 -14400 0 AST}
- {1586059260 -10800 1 ADT}
- {1603594860 -14400 0 AST}
- {1617508860 -10800 1 ADT}
- {1635649260 -14400 0 AST}
- {1648958460 -10800 1 ADT}
- {1667098860 -14400 0 AST}
- {1680408060 -10800 1 ADT}
- {1698548460 -14400 0 AST}
- {1712462460 -10800 1 ADT}
- {1729998060 -14400 0 AST}
- {1743912060 -10800 1 ADT}
- {1761447660 -14400 0 AST}
- {1775361660 -10800 1 ADT}
- {1792897260 -14400 0 AST}
- {1806811260 -10800 1 ADT}
- {1824951660 -14400 0 AST}
- {1838260860 -10800 1 ADT}
- {1856401260 -14400 0 AST}
- {1869710460 -10800 1 ADT}
- {1887850860 -14400 0 AST}
- {1901764860 -10800 1 ADT}
- {1919300460 -14400 0 AST}
- {1933214460 -10800 1 ADT}
- {1950750060 -14400 0 AST}
- {1964664060 -10800 1 ADT}
- {1982804460 -14400 0 AST}
- {1996113660 -10800 1 ADT}
- {2014254060 -14400 0 AST}
- {2027563260 -10800 1 ADT}
- {2045703660 -14400 0 AST}
- {2059012860 -10800 1 ADT}
- {2077153260 -14400 0 AST}
- {2091067260 -10800 1 ADT}
- {2108602860 -14400 0 AST}
- {2122516860 -10800 1 ADT}
- {2140052460 -14400 0 AST}
- {2153966460 -10800 1 ADT}
- {2172106860 -14400 0 AST}
- {2185416060 -10800 1 ADT}
- {2203556460 -14400 0 AST}
- {2216865660 -10800 1 ADT}
- {2235006060 -14400 0 AST}
- {2248920060 -10800 1 ADT}
- {2266455660 -14400 0 AST}
- {2280369660 -10800 1 ADT}
- {2297905260 -14400 0 AST}
- {2311819260 -10800 1 ADT}
- {2329354860 -14400 0 AST}
- {2343268860 -10800 1 ADT}
- {2361409260 -14400 0 AST}
- {2374718460 -10800 1 ADT}
- {2392858860 -14400 0 AST}
- {2406168060 -10800 1 ADT}
- {2424308460 -14400 0 AST}
- {2438222460 -10800 1 ADT}
- {2455758060 -14400 0 AST}
- {2469672060 -10800 1 ADT}
- {2487207660 -14400 0 AST}
- {2501121660 -10800 1 ADT}
- {2519262060 -14400 0 AST}
- {2532571260 -10800 1 ADT}
- {2550711660 -14400 0 AST}
- {2564020860 -10800 1 ADT}
- {2582161260 -14400 0 AST}
- {2596075260 -10800 1 ADT}
- {2613610860 -14400 0 AST}
- {2627524860 -10800 1 ADT}
- {2645060460 -14400 0 AST}
- {2658974460 -10800 1 ADT}
- {2676510060 -14400 0 AST}
- {2690424060 -10800 1 ADT}
- {2708564460 -14400 0 AST}
- {2721873660 -10800 1 ADT}
- {2740014060 -14400 0 AST}
- {2753323260 -10800 1 ADT}
- {2771463660 -14400 0 AST}
- {2785377660 -10800 1 ADT}
- {2802913260 -14400 0 AST}
- {2816827260 -10800 1 ADT}
- {2834362860 -14400 0 AST}
- {2848276860 -10800 1 ADT}
- {2866417260 -14400 0 AST}
- {2879726460 -10800 1 ADT}
- {2897866860 -14400 0 AST}
- {2911176060 -10800 1 ADT}
- {2929316460 -14400 0 AST}
- {2942625660 -10800 1 ADT}
- {2960766060 -14400 0 AST}
- {2974680060 -10800 1 ADT}
- {2992215660 -14400 0 AST}
- {3006129660 -10800 1 ADT}
- {3023665260 -14400 0 AST}
- {3037579260 -10800 1 ADT}
- {3055719660 -14400 0 AST}
- {3069028860 -10800 1 ADT}
- {3087169260 -14400 0 AST}
- {3100478460 -10800 1 ADT}
- {3118618860 -14400 0 AST}
- {3132532860 -10800 1 ADT}
- {3150068460 -14400 0 AST}
- {3163982460 -10800 1 ADT}
- {3181518060 -14400 0 AST}
- {3195432060 -10800 1 ADT}
- {3212967660 -14400 0 AST}
- {3226881660 -10800 1 ADT}
- {3245022060 -14400 0 AST}
- {3258331260 -10800 1 ADT}
- {3276471660 -14400 0 AST}
- {3289780860 -10800 1 ADT}
- {3307921260 -14400 0 AST}
- {3321835260 -10800 1 ADT}
- {3339370860 -14400 0 AST}
- {3353284860 -10800 1 ADT}
- {3370820460 -14400 0 AST}
- {3384734460 -10800 1 ADT}
- {3402874860 -14400 0 AST}
- {3416184060 -10800 1 ADT}
- {3434324460 -14400 0 AST}
- {3447633660 -10800 1 ADT}
- {3465774060 -14400 0 AST}
- {3479688060 -10800 1 ADT}
- {3497223660 -14400 0 AST}
- {3511137660 -10800 1 ADT}
- {3528673260 -14400 0 AST}
- {3542587260 -10800 1 ADT}
- {3560122860 -14400 0 AST}
- {3574036860 -10800 1 ADT}
- {3592177260 -14400 0 AST}
- {3605486460 -10800 1 ADT}
- {3623626860 -14400 0 AST}
- {3636936060 -10800 1 ADT}
- {3655076460 -14400 0 AST}
- {3668990460 -10800 1 ADT}
- {3686526060 -14400 0 AST}
- {3700440060 -10800 1 ADT}
- {3717975660 -14400 0 AST}
- {3731889660 -10800 1 ADT}
- {3750030060 -14400 0 AST}
- {3763339260 -10800 1 ADT}
- {3781479660 -14400 0 AST}
- {3794788860 -10800 1 ADT}
- {3812929260 -14400 0 AST}
- {3826238460 -10800 1 ADT}
- {3844378860 -14400 0 AST}
- {3858292860 -10800 1 ADT}
- {3875828460 -14400 0 AST}
- {3889742460 -10800 1 ADT}
- {3907278060 -14400 0 AST}
- {3921192060 -10800 1 ADT}
- {3939332460 -14400 0 AST}
- {3952641660 -10800 1 ADT}
- {3970782060 -14400 0 AST}
- {3984091260 -10800 1 ADT}
- {4002231660 -14400 0 AST}
- {4016145660 -10800 1 ADT}
- {4033681260 -14400 0 AST}
- {4047595260 -10800 1 ADT}
- {4065130860 -14400 0 AST}
- {4079044860 -10800 1 ADT}
- {4096580460 -14400 0 AST}
+ {1173585660 -10800 1 ADT}
+ {1194145260 -14400 0 AST}
+ {1205035260 -10800 1 ADT}
+ {1225594860 -14400 0 AST}
+ {1236484860 -10800 1 ADT}
+ {1257044460 -14400 0 AST}
+ {1268539260 -10800 1 ADT}
+ {1289098860 -14400 0 AST}
+ {1299988860 -10800 1 ADT}
+ {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/Grand_Turk b/library/tzdata/America/Grand_Turk
index 48857e0..6c8ea4a 100644
--- a/library/tzdata/America/Grand_Turk
+++ b/library/tzdata/America/Grand_Turk
@@ -1,249 +1,249 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Grand_Turk) {
{-9223372036854775808 -17072 0 LMT}
- {-2524504528 -18432 0 KMT}
- {-1827687168 -18000 0 EST}
- {294210000 -14400 1 EDT}
- {309931200 -18000 0 EST}
- {325659600 -14400 1 EDT}
- {341380800 -18000 0 EST}
- {357109200 -14400 1 EDT}
- {372830400 -18000 0 EST}
- {388558800 -14400 1 EDT}
- {404884800 -18000 0 EST}
- {420008400 -14400 1 EDT}
- {436334400 -18000 0 EST}
- {452062800 -14400 1 EDT}
- {467784000 -18000 0 EST}
- {483512400 -14400 1 EDT}
- {499233600 -18000 0 EST}
- {514962000 -14400 1 EDT}
- {530683200 -18000 0 EST}
- {544597200 -14400 1 EDT}
- {562132800 -18000 0 EST}
- {576046800 -14400 1 EDT}
- {594187200 -18000 0 EST}
- {607496400 -14400 1 EDT}
- {625636800 -18000 0 EST}
- {638946000 -14400 1 EDT}
- {657086400 -18000 0 EST}
- {671000400 -14400 1 EDT}
- {688536000 -18000 0 EST}
- {702450000 -14400 1 EDT}
- {719985600 -18000 0 EST}
- {733899600 -14400 1 EDT}
- {752040000 -18000 0 EST}
- {765349200 -14400 1 EDT}
- {783489600 -18000 0 EST}
- {796798800 -14400 1 EDT}
- {814939200 -18000 0 EST}
- {828853200 -14400 1 EDT}
- {846388800 -18000 0 EST}
- {860302800 -14400 1 EDT}
- {877838400 -18000 0 EST}
- {891752400 -14400 1 EDT}
- {909288000 -18000 0 EST}
- {923202000 -14400 1 EDT}
- {941342400 -18000 0 EST}
- {954651600 -14400 1 EDT}
- {972792000 -18000 0 EST}
- {986101200 -14400 1 EDT}
- {1004241600 -18000 0 EST}
- {1018155600 -14400 1 EDT}
- {1035691200 -18000 0 EST}
- {1049605200 -14400 1 EDT}
- {1067140800 -18000 0 EST}
- {1081054800 -14400 1 EDT}
- {1099195200 -18000 0 EST}
- {1112504400 -14400 1 EDT}
- {1130644800 -18000 0 EST}
- {1143954000 -14400 1 EDT}
- {1162094400 -18000 0 EST}
- {1175403600 -14400 1 EDT}
- {1193544000 -18000 0 EST}
- {1207458000 -14400 1 EDT}
- {1224993600 -18000 0 EST}
- {1238907600 -14400 1 EDT}
- {1256443200 -18000 0 EST}
- {1270357200 -14400 1 EDT}
- {1288497600 -18000 0 EST}
- {1301806800 -14400 1 EDT}
- {1319947200 -18000 0 EST}
- {1333256400 -14400 1 EDT}
- {1351396800 -18000 0 EST}
- {1365310800 -14400 1 EDT}
- {1382846400 -18000 0 EST}
- {1396760400 -14400 1 EDT}
- {1414296000 -18000 0 EST}
- {1428210000 -14400 1 EDT}
- {1445745600 -18000 0 EST}
- {1459659600 -14400 1 EDT}
- {1477800000 -18000 0 EST}
- {1491109200 -14400 1 EDT}
- {1509249600 -18000 0 EST}
- {1522558800 -14400 1 EDT}
- {1540699200 -18000 0 EST}
- {1554613200 -14400 1 EDT}
- {1572148800 -18000 0 EST}
- {1586062800 -14400 1 EDT}
- {1603598400 -18000 0 EST}
- {1617512400 -14400 1 EDT}
- {1635652800 -18000 0 EST}
- {1648962000 -14400 1 EDT}
- {1667102400 -18000 0 EST}
- {1680411600 -14400 1 EDT}
- {1698552000 -18000 0 EST}
- {1712466000 -14400 1 EDT}
- {1730001600 -18000 0 EST}
- {1743915600 -14400 1 EDT}
- {1761451200 -18000 0 EST}
- {1775365200 -14400 1 EDT}
- {1792900800 -18000 0 EST}
- {1806814800 -14400 1 EDT}
- {1824955200 -18000 0 EST}
- {1838264400 -14400 1 EDT}
- {1856404800 -18000 0 EST}
- {1869714000 -14400 1 EDT}
- {1887854400 -18000 0 EST}
- {1901768400 -14400 1 EDT}
- {1919304000 -18000 0 EST}
- {1933218000 -14400 1 EDT}
- {1950753600 -18000 0 EST}
- {1964667600 -14400 1 EDT}
- {1982808000 -18000 0 EST}
- {1996117200 -14400 1 EDT}
- {2014257600 -18000 0 EST}
- {2027566800 -14400 1 EDT}
- {2045707200 -18000 0 EST}
- {2059016400 -14400 1 EDT}
- {2077156800 -18000 0 EST}
- {2091070800 -14400 1 EDT}
- {2108606400 -18000 0 EST}
- {2122520400 -14400 1 EDT}
- {2140056000 -18000 0 EST}
- {2153970000 -14400 1 EDT}
- {2172110400 -18000 0 EST}
- {2185419600 -14400 1 EDT}
- {2203560000 -18000 0 EST}
- {2216869200 -14400 1 EDT}
- {2235009600 -18000 0 EST}
- {2248923600 -14400 1 EDT}
- {2266459200 -18000 0 EST}
- {2280373200 -14400 1 EDT}
- {2297908800 -18000 0 EST}
- {2311822800 -14400 1 EDT}
- {2329358400 -18000 0 EST}
- {2343272400 -14400 1 EDT}
- {2361412800 -18000 0 EST}
- {2374722000 -14400 1 EDT}
- {2392862400 -18000 0 EST}
- {2406171600 -14400 1 EDT}
- {2424312000 -18000 0 EST}
- {2438226000 -14400 1 EDT}
- {2455761600 -18000 0 EST}
- {2469675600 -14400 1 EDT}
- {2487211200 -18000 0 EST}
- {2501125200 -14400 1 EDT}
- {2519265600 -18000 0 EST}
- {2532574800 -14400 1 EDT}
- {2550715200 -18000 0 EST}
- {2564024400 -14400 1 EDT}
- {2582164800 -18000 0 EST}
- {2596078800 -14400 1 EDT}
- {2613614400 -18000 0 EST}
- {2627528400 -14400 1 EDT}
- {2645064000 -18000 0 EST}
- {2658978000 -14400 1 EDT}
- {2676513600 -18000 0 EST}
- {2690427600 -14400 1 EDT}
- {2708568000 -18000 0 EST}
- {2721877200 -14400 1 EDT}
- {2740017600 -18000 0 EST}
- {2753326800 -14400 1 EDT}
- {2771467200 -18000 0 EST}
- {2785381200 -14400 1 EDT}
- {2802916800 -18000 0 EST}
- {2816830800 -14400 1 EDT}
- {2834366400 -18000 0 EST}
- {2848280400 -14400 1 EDT}
- {2866420800 -18000 0 EST}
- {2879730000 -14400 1 EDT}
- {2897870400 -18000 0 EST}
- {2911179600 -14400 1 EDT}
- {2929320000 -18000 0 EST}
- {2942629200 -14400 1 EDT}
- {2960769600 -18000 0 EST}
- {2974683600 -14400 1 EDT}
- {2992219200 -18000 0 EST}
- {3006133200 -14400 1 EDT}
- {3023668800 -18000 0 EST}
- {3037582800 -14400 1 EDT}
- {3055723200 -18000 0 EST}
- {3069032400 -14400 1 EDT}
- {3087172800 -18000 0 EST}
- {3100482000 -14400 1 EDT}
- {3118622400 -18000 0 EST}
- {3132536400 -14400 1 EDT}
- {3150072000 -18000 0 EST}
- {3163986000 -14400 1 EDT}
- {3181521600 -18000 0 EST}
- {3195435600 -14400 1 EDT}
- {3212971200 -18000 0 EST}
- {3226885200 -14400 1 EDT}
- {3245025600 -18000 0 EST}
- {3258334800 -14400 1 EDT}
- {3276475200 -18000 0 EST}
- {3289784400 -14400 1 EDT}
- {3307924800 -18000 0 EST}
- {3321838800 -14400 1 EDT}
- {3339374400 -18000 0 EST}
- {3353288400 -14400 1 EDT}
- {3370824000 -18000 0 EST}
- {3384738000 -14400 1 EDT}
- {3402878400 -18000 0 EST}
- {3416187600 -14400 1 EDT}
- {3434328000 -18000 0 EST}
- {3447637200 -14400 1 EDT}
- {3465777600 -18000 0 EST}
- {3479691600 -14400 1 EDT}
- {3497227200 -18000 0 EST}
- {3511141200 -14400 1 EDT}
- {3528676800 -18000 0 EST}
- {3542590800 -14400 1 EDT}
- {3560126400 -18000 0 EST}
- {3574040400 -14400 1 EDT}
- {3592180800 -18000 0 EST}
- {3605490000 -14400 1 EDT}
- {3623630400 -18000 0 EST}
- {3636939600 -14400 1 EDT}
- {3655080000 -18000 0 EST}
- {3668994000 -14400 1 EDT}
- {3686529600 -18000 0 EST}
- {3700443600 -14400 1 EDT}
- {3717979200 -18000 0 EST}
- {3731893200 -14400 1 EDT}
- {3750033600 -18000 0 EST}
- {3763342800 -14400 1 EDT}
- {3781483200 -18000 0 EST}
- {3794792400 -14400 1 EDT}
- {3812932800 -18000 0 EST}
- {3826242000 -14400 1 EDT}
- {3844382400 -18000 0 EST}
- {3858296400 -14400 1 EDT}
- {3875832000 -18000 0 EST}
- {3889746000 -14400 1 EDT}
- {3907281600 -18000 0 EST}
- {3921195600 -14400 1 EDT}
- {3939336000 -18000 0 EST}
- {3952645200 -14400 1 EDT}
- {3970785600 -18000 0 EST}
- {3984094800 -14400 1 EDT}
- {4002235200 -18000 0 EST}
- {4016149200 -14400 1 EDT}
- {4033684800 -18000 0 EST}
- {4047598800 -14400 1 EDT}
- {4065134400 -18000 0 EST}
- {4079048400 -14400 1 EDT}
- {4096584000 -18000 0 EST}
+ {-2524504528 -18431 0 KMT}
+ {-1827687169 -18000 0 EST}
+ {294217200 -14400 1 EDT}
+ {309938400 -18000 0 EST}
+ {325666800 -14400 1 EDT}
+ {341388000 -18000 0 EST}
+ {357116400 -14400 1 EDT}
+ {372837600 -18000 0 EST}
+ {388566000 -14400 1 EDT}
+ {404892000 -18000 0 EST}
+ {420015600 -14400 1 EDT}
+ {436341600 -18000 0 EST}
+ {452070000 -14400 1 EDT}
+ {467791200 -18000 0 EST}
+ {483519600 -14400 1 EDT}
+ {499240800 -18000 0 EST}
+ {514969200 -14400 1 EDT}
+ {530690400 -18000 0 EST}
+ {544604400 -14400 1 EDT}
+ {562140000 -18000 0 EST}
+ {576054000 -14400 1 EDT}
+ {594194400 -18000 0 EST}
+ {607503600 -14400 1 EDT}
+ {625644000 -18000 0 EST}
+ {638953200 -14400 1 EDT}
+ {657093600 -18000 0 EST}
+ {671007600 -14400 1 EDT}
+ {688543200 -18000 0 EST}
+ {702457200 -14400 1 EDT}
+ {719992800 -18000 0 EST}
+ {733906800 -14400 1 EDT}
+ {752047200 -18000 0 EST}
+ {765356400 -14400 1 EDT}
+ {783496800 -18000 0 EST}
+ {796806000 -14400 1 EDT}
+ {814946400 -18000 0 EST}
+ {828860400 -14400 1 EDT}
+ {846396000 -18000 0 EST}
+ {860310000 -14400 1 EDT}
+ {877845600 -18000 0 EST}
+ {891759600 -14400 1 EDT}
+ {909295200 -18000 0 EST}
+ {923209200 -14400 1 EDT}
+ {941349600 -18000 0 EST}
+ {954658800 -14400 1 EDT}
+ {972799200 -18000 0 EST}
+ {986108400 -14400 1 EDT}
+ {1004248800 -18000 0 EST}
+ {1018162800 -14400 1 EDT}
+ {1035698400 -18000 0 EST}
+ {1049612400 -14400 1 EDT}
+ {1067148000 -18000 0 EST}
+ {1081062000 -14400 1 EDT}
+ {1099202400 -18000 0 EST}
+ {1112511600 -14400 1 EDT}
+ {1130652000 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Grenada b/library/tzdata/America/Grenada
index 2459221..92300c3 100644
--- a/library/tzdata/America/Grenada
+++ b/library/tzdata/America/Grenada
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Grenada) {
- {-9223372036854775808 -14820 0 LMT}
- {-1846266780 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Grenada) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Guadeloupe b/library/tzdata/America/Guadeloupe
index 2a6c74a..aba6bd7 100644
--- a/library/tzdata/America/Guadeloupe
+++ b/library/tzdata/America/Guadeloupe
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Guadeloupe) {
- {-9223372036854775808 -14768 0 LMT}
- {-1848254032 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Guadeloupe) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Guatemala b/library/tzdata/America/Guatemala
index 2e340cd..e4db5ac 100644
--- a/library/tzdata/America/Guatemala
+++ b/library/tzdata/America/Guatemala
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Guatemala) {
{-9223372036854775808 -21724 0 LMT}
@@ -9,4 +9,6 @@ set TZData(:America/Guatemala) {
{433054800 -21600 0 CST}
{669708000 -18000 1 CDT}
{684219600 -21600 0 CST}
+ {1146376800 -18000 1 CDT}
+ {1159678800 -21600 0 CST}
}
diff --git a/library/tzdata/America/Guayaquil b/library/tzdata/America/Guayaquil
index 7595ea6..e940a5b 100644
--- a/library/tzdata/America/Guayaquil
+++ b/library/tzdata/America/Guayaquil
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Guayaquil) {
{-9223372036854775808 -19160 0 LMT}
diff --git a/library/tzdata/America/Guyana b/library/tzdata/America/Guyana
index a91252d..c58a989 100644
--- a/library/tzdata/America/Guyana
+++ b/library/tzdata/America/Guyana
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Guyana) {
{-9223372036854775808 -13960 0 LMT}
diff --git a/library/tzdata/America/Halifax b/library/tzdata/America/Halifax
index fb3a290..08e3754 100644
--- a/library/tzdata/America/Halifax
+++ b/library/tzdata/America/Halifax
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Halifax) {
{-9223372036854775808 -15264 0 LMT}
@@ -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}
@@ -53,8 +53,7 @@ set TZData(:America/Halifax) {
{-923173200 -14400 0 AST}
{-904507200 -10800 1 ADT}
{-891723600 -14400 0 AST}
- {-880236000 -14400 0 AST}
- {-880221600 -10800 1 AWT}
+ {-880221600 -10800 0 AWT}
{-769395600 -10800 1 APT}
{-765399600 -14400 0 AST}
{-757368000 -14400 0 AST}
@@ -173,190 +172,190 @@ set TZData(:America/Halifax) {
{1130648400 -14400 0 AST}
{1143957600 -10800 1 ADT}
{1162098000 -14400 0 AST}
- {1175407200 -10800 1 ADT}
- {1193547600 -14400 0 AST}
- {1207461600 -10800 1 ADT}
- {1224997200 -14400 0 AST}
- {1238911200 -10800 1 ADT}
- {1256446800 -14400 0 AST}
- {1270360800 -10800 1 ADT}
- {1288501200 -14400 0 AST}
- {1301810400 -10800 1 ADT}
- {1319950800 -14400 0 AST}
- {1333260000 -10800 1 ADT}
- {1351400400 -14400 0 AST}
- {1365314400 -10800 1 ADT}
- {1382850000 -14400 0 AST}
- {1396764000 -10800 1 ADT}
- {1414299600 -14400 0 AST}
- {1428213600 -10800 1 ADT}
- {1445749200 -14400 0 AST}
- {1459663200 -10800 1 ADT}
- {1477803600 -14400 0 AST}
- {1491112800 -10800 1 ADT}
- {1509253200 -14400 0 AST}
- {1522562400 -10800 1 ADT}
- {1540702800 -14400 0 AST}
- {1554616800 -10800 1 ADT}
- {1572152400 -14400 0 AST}
- {1586066400 -10800 1 ADT}
- {1603602000 -14400 0 AST}
- {1617516000 -10800 1 ADT}
- {1635656400 -14400 0 AST}
- {1648965600 -10800 1 ADT}
- {1667106000 -14400 0 AST}
- {1680415200 -10800 1 ADT}
- {1698555600 -14400 0 AST}
- {1712469600 -10800 1 ADT}
- {1730005200 -14400 0 AST}
- {1743919200 -10800 1 ADT}
- {1761454800 -14400 0 AST}
- {1775368800 -10800 1 ADT}
- {1792904400 -14400 0 AST}
- {1806818400 -10800 1 ADT}
- {1824958800 -14400 0 AST}
- {1838268000 -10800 1 ADT}
- {1856408400 -14400 0 AST}
- {1869717600 -10800 1 ADT}
- {1887858000 -14400 0 AST}
- {1901772000 -10800 1 ADT}
- {1919307600 -14400 0 AST}
- {1933221600 -10800 1 ADT}
- {1950757200 -14400 0 AST}
- {1964671200 -10800 1 ADT}
- {1982811600 -14400 0 AST}
- {1996120800 -10800 1 ADT}
- {2014261200 -14400 0 AST}
- {2027570400 -10800 1 ADT}
- {2045710800 -14400 0 AST}
- {2059020000 -10800 1 ADT}
- {2077160400 -14400 0 AST}
- {2091074400 -10800 1 ADT}
- {2108610000 -14400 0 AST}
- {2122524000 -10800 1 ADT}
- {2140059600 -14400 0 AST}
- {2153973600 -10800 1 ADT}
- {2172114000 -14400 0 AST}
- {2185423200 -10800 1 ADT}
- {2203563600 -14400 0 AST}
- {2216872800 -10800 1 ADT}
- {2235013200 -14400 0 AST}
- {2248927200 -10800 1 ADT}
- {2266462800 -14400 0 AST}
- {2280376800 -10800 1 ADT}
- {2297912400 -14400 0 AST}
- {2311826400 -10800 1 ADT}
- {2329362000 -14400 0 AST}
- {2343276000 -10800 1 ADT}
- {2361416400 -14400 0 AST}
- {2374725600 -10800 1 ADT}
- {2392866000 -14400 0 AST}
- {2406175200 -10800 1 ADT}
- {2424315600 -14400 0 AST}
- {2438229600 -10800 1 ADT}
- {2455765200 -14400 0 AST}
- {2469679200 -10800 1 ADT}
- {2487214800 -14400 0 AST}
- {2501128800 -10800 1 ADT}
- {2519269200 -14400 0 AST}
- {2532578400 -10800 1 ADT}
- {2550718800 -14400 0 AST}
- {2564028000 -10800 1 ADT}
- {2582168400 -14400 0 AST}
- {2596082400 -10800 1 ADT}
- {2613618000 -14400 0 AST}
- {2627532000 -10800 1 ADT}
- {2645067600 -14400 0 AST}
- {2658981600 -10800 1 ADT}
- {2676517200 -14400 0 AST}
- {2690431200 -10800 1 ADT}
- {2708571600 -14400 0 AST}
- {2721880800 -10800 1 ADT}
- {2740021200 -14400 0 AST}
- {2753330400 -10800 1 ADT}
- {2771470800 -14400 0 AST}
- {2785384800 -10800 1 ADT}
- {2802920400 -14400 0 AST}
- {2816834400 -10800 1 ADT}
- {2834370000 -14400 0 AST}
- {2848284000 -10800 1 ADT}
- {2866424400 -14400 0 AST}
- {2879733600 -10800 1 ADT}
- {2897874000 -14400 0 AST}
- {2911183200 -10800 1 ADT}
- {2929323600 -14400 0 AST}
- {2942632800 -10800 1 ADT}
- {2960773200 -14400 0 AST}
- {2974687200 -10800 1 ADT}
- {2992222800 -14400 0 AST}
- {3006136800 -10800 1 ADT}
- {3023672400 -14400 0 AST}
- {3037586400 -10800 1 ADT}
- {3055726800 -14400 0 AST}
- {3069036000 -10800 1 ADT}
- {3087176400 -14400 0 AST}
- {3100485600 -10800 1 ADT}
- {3118626000 -14400 0 AST}
- {3132540000 -10800 1 ADT}
- {3150075600 -14400 0 AST}
- {3163989600 -10800 1 ADT}
- {3181525200 -14400 0 AST}
- {3195439200 -10800 1 ADT}
- {3212974800 -14400 0 AST}
- {3226888800 -10800 1 ADT}
- {3245029200 -14400 0 AST}
- {3258338400 -10800 1 ADT}
- {3276478800 -14400 0 AST}
- {3289788000 -10800 1 ADT}
- {3307928400 -14400 0 AST}
- {3321842400 -10800 1 ADT}
- {3339378000 -14400 0 AST}
- {3353292000 -10800 1 ADT}
- {3370827600 -14400 0 AST}
- {3384741600 -10800 1 ADT}
- {3402882000 -14400 0 AST}
- {3416191200 -10800 1 ADT}
- {3434331600 -14400 0 AST}
- {3447640800 -10800 1 ADT}
- {3465781200 -14400 0 AST}
- {3479695200 -10800 1 ADT}
- {3497230800 -14400 0 AST}
- {3511144800 -10800 1 ADT}
- {3528680400 -14400 0 AST}
- {3542594400 -10800 1 ADT}
- {3560130000 -14400 0 AST}
- {3574044000 -10800 1 ADT}
- {3592184400 -14400 0 AST}
- {3605493600 -10800 1 ADT}
- {3623634000 -14400 0 AST}
- {3636943200 -10800 1 ADT}
- {3655083600 -14400 0 AST}
- {3668997600 -10800 1 ADT}
- {3686533200 -14400 0 AST}
- {3700447200 -10800 1 ADT}
- {3717982800 -14400 0 AST}
- {3731896800 -10800 1 ADT}
- {3750037200 -14400 0 AST}
- {3763346400 -10800 1 ADT}
- {3781486800 -14400 0 AST}
- {3794796000 -10800 1 ADT}
- {3812936400 -14400 0 AST}
- {3826245600 -10800 1 ADT}
- {3844386000 -14400 0 AST}
- {3858300000 -10800 1 ADT}
- {3875835600 -14400 0 AST}
- {3889749600 -10800 1 ADT}
- {3907285200 -14400 0 AST}
- {3921199200 -10800 1 ADT}
- {3939339600 -14400 0 AST}
- {3952648800 -10800 1 ADT}
- {3970789200 -14400 0 AST}
- {3984098400 -10800 1 ADT}
- {4002238800 -14400 0 AST}
- {4016152800 -10800 1 ADT}
- {4033688400 -14400 0 AST}
- {4047602400 -10800 1 ADT}
- {4065138000 -14400 0 AST}
- {4079052000 -10800 1 ADT}
- {4096587600 -14400 0 AST}
+ {1173592800 -10800 1 ADT}
+ {1194152400 -14400 0 AST}
+ {1205042400 -10800 1 ADT}
+ {1225602000 -14400 0 AST}
+ {1236492000 -10800 1 ADT}
+ {1257051600 -14400 0 AST}
+ {1268546400 -10800 1 ADT}
+ {1289106000 -14400 0 AST}
+ {1299996000 -10800 1 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/Havana b/library/tzdata/America/Havana
index 888afff..89cbc9a 100644
--- a/library/tzdata/America/Havana
+++ b/library/tzdata/America/Havana
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Havana) {
{-9223372036854775808 -19768 0 LMT}
@@ -69,220 +69,217 @@ set TZData(:America/Havana) {
{638946000 -14400 1 CDT}
{655876800 -18000 0 CST}
{671000400 -14400 1 CDT}
- {687312000 -18000 0 CST}
+ {687330000 -18000 0 CST}
{702450000 -14400 1 CDT}
- {718761600 -18000 0 CST}
+ {718779600 -18000 0 CST}
{733899600 -14400 1 CDT}
- {750211200 -18000 0 CST}
+ {750229200 -18000 0 CST}
{765349200 -14400 1 CDT}
- {781660800 -18000 0 CST}
+ {781678800 -18000 0 CST}
{796798800 -14400 1 CDT}
- {813110400 -18000 0 CST}
+ {813128400 -18000 0 CST}
{828853200 -14400 1 CDT}
- {844560000 -18000 0 CST}
+ {844578000 -18000 0 CST}
{860302800 -14400 1 CDT}
- {876614400 -18000 0 CST}
- {891129600 -14400 1 CDT}
- {909273600 -18000 0 CST}
- {922579200 -14400 1 CDT}
- {941328000 -18000 0 CST}
- {954633600 -14400 1 CDT}
- {972777600 -18000 0 CST}
- {986083200 -14400 1 CDT}
- {1004227200 -18000 0 CST}
- {1018137600 -14400 1 CDT}
- {1035676800 -18000 0 CST}
- {1049587200 -14400 1 CDT}
- {1067126400 -18000 0 CST}
- {1081036800 -14400 1 CDT}
- {1112486400 -14400 1 CDT}
- {1130630400 -18000 0 CST}
- {1143936000 -14400 1 CDT}
- {1162080000 -18000 0 CST}
- {1175385600 -14400 1 CDT}
- {1193529600 -18000 0 CST}
- {1207440000 -14400 1 CDT}
- {1224979200 -18000 0 CST}
- {1238889600 -14400 1 CDT}
- {1256428800 -18000 0 CST}
- {1270339200 -14400 1 CDT}
- {1288483200 -18000 0 CST}
- {1301788800 -14400 1 CDT}
- {1319932800 -18000 0 CST}
- {1333238400 -14400 1 CDT}
- {1351382400 -18000 0 CST}
- {1365292800 -14400 1 CDT}
- {1382832000 -18000 0 CST}
- {1396742400 -14400 1 CDT}
- {1414281600 -18000 0 CST}
- {1428192000 -14400 1 CDT}
- {1445731200 -18000 0 CST}
- {1459641600 -14400 1 CDT}
- {1477785600 -18000 0 CST}
- {1491091200 -14400 1 CDT}
- {1509235200 -18000 0 CST}
- {1522540800 -14400 1 CDT}
- {1540684800 -18000 0 CST}
- {1554595200 -14400 1 CDT}
- {1572134400 -18000 0 CST}
- {1586044800 -14400 1 CDT}
- {1603584000 -18000 0 CST}
- {1617494400 -14400 1 CDT}
- {1635638400 -18000 0 CST}
- {1648944000 -14400 1 CDT}
- {1667088000 -18000 0 CST}
- {1680393600 -14400 1 CDT}
- {1698537600 -18000 0 CST}
- {1712448000 -14400 1 CDT}
- {1729987200 -18000 0 CST}
- {1743897600 -14400 1 CDT}
- {1761436800 -18000 0 CST}
- {1775347200 -14400 1 CDT}
- {1792886400 -18000 0 CST}
- {1806796800 -14400 1 CDT}
- {1824940800 -18000 0 CST}
- {1838246400 -14400 1 CDT}
- {1856390400 -18000 0 CST}
- {1869696000 -14400 1 CDT}
- {1887840000 -18000 0 CST}
- {1901750400 -14400 1 CDT}
- {1919289600 -18000 0 CST}
- {1933200000 -14400 1 CDT}
- {1950739200 -18000 0 CST}
- {1964649600 -14400 1 CDT}
- {1982793600 -18000 0 CST}
- {1996099200 -14400 1 CDT}
- {2014243200 -18000 0 CST}
- {2027548800 -14400 1 CDT}
- {2045692800 -18000 0 CST}
- {2058998400 -14400 1 CDT}
- {2077142400 -18000 0 CST}
- {2091052800 -14400 1 CDT}
- {2108592000 -18000 0 CST}
- {2122502400 -14400 1 CDT}
- {2140041600 -18000 0 CST}
- {2153952000 -14400 1 CDT}
- {2172096000 -18000 0 CST}
- {2185401600 -14400 1 CDT}
- {2203545600 -18000 0 CST}
- {2216851200 -14400 1 CDT}
- {2234995200 -18000 0 CST}
- {2248905600 -14400 1 CDT}
- {2266444800 -18000 0 CST}
- {2280355200 -14400 1 CDT}
- {2297894400 -18000 0 CST}
- {2311804800 -14400 1 CDT}
- {2329344000 -18000 0 CST}
- {2343254400 -14400 1 CDT}
- {2361398400 -18000 0 CST}
- {2374704000 -14400 1 CDT}
- {2392848000 -18000 0 CST}
- {2406153600 -14400 1 CDT}
- {2424297600 -18000 0 CST}
- {2438208000 -14400 1 CDT}
- {2455747200 -18000 0 CST}
- {2469657600 -14400 1 CDT}
- {2487196800 -18000 0 CST}
- {2501107200 -14400 1 CDT}
- {2519251200 -18000 0 CST}
- {2532556800 -14400 1 CDT}
- {2550700800 -18000 0 CST}
- {2564006400 -14400 1 CDT}
- {2582150400 -18000 0 CST}
- {2596060800 -14400 1 CDT}
- {2613600000 -18000 0 CST}
- {2627510400 -14400 1 CDT}
- {2645049600 -18000 0 CST}
- {2658960000 -14400 1 CDT}
- {2676499200 -18000 0 CST}
- {2690409600 -14400 1 CDT}
- {2708553600 -18000 0 CST}
- {2721859200 -14400 1 CDT}
- {2740003200 -18000 0 CST}
- {2753308800 -14400 1 CDT}
- {2771452800 -18000 0 CST}
- {2785363200 -14400 1 CDT}
- {2802902400 -18000 0 CST}
- {2816812800 -14400 1 CDT}
- {2834352000 -18000 0 CST}
- {2848262400 -14400 1 CDT}
- {2866406400 -18000 0 CST}
- {2879712000 -14400 1 CDT}
- {2897856000 -18000 0 CST}
- {2911161600 -14400 1 CDT}
- {2929305600 -18000 0 CST}
- {2942611200 -14400 1 CDT}
- {2960755200 -18000 0 CST}
- {2974665600 -14400 1 CDT}
- {2992204800 -18000 0 CST}
- {3006115200 -14400 1 CDT}
- {3023654400 -18000 0 CST}
- {3037564800 -14400 1 CDT}
- {3055708800 -18000 0 CST}
- {3069014400 -14400 1 CDT}
- {3087158400 -18000 0 CST}
- {3100464000 -14400 1 CDT}
- {3118608000 -18000 0 CST}
- {3132518400 -14400 1 CDT}
- {3150057600 -18000 0 CST}
- {3163968000 -14400 1 CDT}
- {3181507200 -18000 0 CST}
- {3195417600 -14400 1 CDT}
- {3212956800 -18000 0 CST}
- {3226867200 -14400 1 CDT}
- {3245011200 -18000 0 CST}
- {3258316800 -14400 1 CDT}
- {3276460800 -18000 0 CST}
- {3289766400 -14400 1 CDT}
- {3307910400 -18000 0 CST}
- {3321820800 -14400 1 CDT}
- {3339360000 -18000 0 CST}
- {3353270400 -14400 1 CDT}
- {3370809600 -18000 0 CST}
- {3384720000 -14400 1 CDT}
- {3402864000 -18000 0 CST}
- {3416169600 -14400 1 CDT}
- {3434313600 -18000 0 CST}
- {3447619200 -14400 1 CDT}
- {3465763200 -18000 0 CST}
- {3479673600 -14400 1 CDT}
- {3497212800 -18000 0 CST}
- {3511123200 -14400 1 CDT}
- {3528662400 -18000 0 CST}
- {3542572800 -14400 1 CDT}
- {3560112000 -18000 0 CST}
- {3574022400 -14400 1 CDT}
- {3592166400 -18000 0 CST}
- {3605472000 -14400 1 CDT}
- {3623616000 -18000 0 CST}
- {3636921600 -14400 1 CDT}
- {3655065600 -18000 0 CST}
- {3668976000 -14400 1 CDT}
- {3686515200 -18000 0 CST}
- {3700425600 -14400 1 CDT}
- {3717964800 -18000 0 CST}
- {3731875200 -14400 1 CDT}
- {3750019200 -18000 0 CST}
- {3763324800 -14400 1 CDT}
- {3781468800 -18000 0 CST}
- {3794774400 -14400 1 CDT}
- {3812918400 -18000 0 CST}
- {3826224000 -14400 1 CDT}
- {3844368000 -18000 0 CST}
- {3858278400 -14400 1 CDT}
- {3875817600 -18000 0 CST}
- {3889728000 -14400 1 CDT}
- {3907267200 -18000 0 CST}
- {3921177600 -14400 1 CDT}
- {3939321600 -18000 0 CST}
- {3952627200 -14400 1 CDT}
- {3970771200 -18000 0 CST}
- {3984076800 -14400 1 CDT}
- {4002220800 -18000 0 CST}
- {4016131200 -14400 1 CDT}
- {4033670400 -18000 0 CST}
- {4047580800 -14400 1 CDT}
- {4065120000 -18000 0 CST}
- {4079030400 -14400 1 CDT}
- {4096569600 -18000 0 CST}
+ {876632400 -18000 0 CST}
+ {891147600 -14400 1 CDT}
+ {909291600 -18000 0 CST}
+ {922597200 -14400 1 CDT}
+ {941346000 -18000 0 CST}
+ {954651600 -14400 1 CDT}
+ {972795600 -18000 0 CST}
+ {986101200 -14400 1 CDT}
+ {1004245200 -18000 0 CST}
+ {1018155600 -14400 1 CDT}
+ {1035694800 -18000 0 CST}
+ {1049605200 -14400 1 CDT}
+ {1067144400 -18000 0 CST}
+ {1081054800 -14400 1 CDT}
+ {1162098000 -18000 0 CST}
+ {1173589200 -14400 1 CDT}
+ {1193547600 -18000 0 CST}
+ {1205643600 -14400 1 CDT}
+ {1224997200 -18000 0 CST}
+ {1236488400 -14400 1 CDT}
+ {1256446800 -18000 0 CST}
+ {1268542800 -14400 1 CDT}
+ {1288501200 -18000 0 CST}
+ {1300597200 -14400 1 CDT}
+ {1321160400 -18000 0 CST}
+ {1333256400 -14400 1 CDT}
+ {1352005200 -18000 0 CST}
+ {1362891600 -14400 1 CDT}
+ {1383454800 -18000 0 CST}
+ {1394341200 -14400 1 CDT}
+ {1414904400 -18000 0 CST}
+ {1425790800 -14400 1 CDT}
+ {1446354000 -18000 0 CST}
+ {1457845200 -14400 1 CDT}
+ {1478408400 -18000 0 CST}
+ {1489294800 -14400 1 CDT}
+ {1509858000 -18000 0 CST}
+ {1520744400 -14400 1 CDT}
+ {1541307600 -18000 0 CST}
+ {1552194000 -14400 1 CDT}
+ {1572757200 -18000 0 CST}
+ {1583643600 -14400 1 CDT}
+ {1604206800 -18000 0 CST}
+ {1615698000 -14400 1 CDT}
+ {1636261200 -18000 0 CST}
+ {1647147600 -14400 1 CDT}
+ {1667710800 -18000 0 CST}
+ {1678597200 -14400 1 CDT}
+ {1699160400 -18000 0 CST}
+ {1710046800 -14400 1 CDT}
+ {1730610000 -18000 0 CST}
+ {1741496400 -14400 1 CDT}
+ {1762059600 -18000 0 CST}
+ {1772946000 -14400 1 CDT}
+ {1793509200 -18000 0 CST}
+ {1805000400 -14400 1 CDT}
+ {1825563600 -18000 0 CST}
+ {1836450000 -14400 1 CDT}
+ {1857013200 -18000 0 CST}
+ {1867899600 -14400 1 CDT}
+ {1888462800 -18000 0 CST}
+ {1899349200 -14400 1 CDT}
+ {1919912400 -18000 0 CST}
+ {1930798800 -14400 1 CDT}
+ {1951362000 -18000 0 CST}
+ {1962853200 -14400 1 CDT}
+ {1983416400 -18000 0 CST}
+ {1994302800 -14400 1 CDT}
+ {2014866000 -18000 0 CST}
+ {2025752400 -14400 1 CDT}
+ {2046315600 -18000 0 CST}
+ {2057202000 -14400 1 CDT}
+ {2077765200 -18000 0 CST}
+ {2088651600 -14400 1 CDT}
+ {2109214800 -18000 0 CST}
+ {2120101200 -14400 1 CDT}
+ {2140664400 -18000 0 CST}
+ {2152155600 -14400 1 CDT}
+ {2172718800 -18000 0 CST}
+ {2183605200 -14400 1 CDT}
+ {2204168400 -18000 0 CST}
+ {2215054800 -14400 1 CDT}
+ {2235618000 -18000 0 CST}
+ {2246504400 -14400 1 CDT}
+ {2267067600 -18000 0 CST}
+ {2277954000 -14400 1 CDT}
+ {2298517200 -18000 0 CST}
+ {2309403600 -14400 1 CDT}
+ {2329966800 -18000 0 CST}
+ {2341458000 -14400 1 CDT}
+ {2362021200 -18000 0 CST}
+ {2372907600 -14400 1 CDT}
+ {2393470800 -18000 0 CST}
+ {2404357200 -14400 1 CDT}
+ {2424920400 -18000 0 CST}
+ {2435806800 -14400 1 CDT}
+ {2456370000 -18000 0 CST}
+ {2467256400 -14400 1 CDT}
+ {2487819600 -18000 0 CST}
+ {2499310800 -14400 1 CDT}
+ {2519874000 -18000 0 CST}
+ {2530760400 -14400 1 CDT}
+ {2551323600 -18000 0 CST}
+ {2562210000 -14400 1 CDT}
+ {2582773200 -18000 0 CST}
+ {2593659600 -14400 1 CDT}
+ {2614222800 -18000 0 CST}
+ {2625109200 -14400 1 CDT}
+ {2645672400 -18000 0 CST}
+ {2656558800 -14400 1 CDT}
+ {2677122000 -18000 0 CST}
+ {2688613200 -14400 1 CDT}
+ {2709176400 -18000 0 CST}
+ {2720062800 -14400 1 CDT}
+ {2740626000 -18000 0 CST}
+ {2751512400 -14400 1 CDT}
+ {2772075600 -18000 0 CST}
+ {2782962000 -14400 1 CDT}
+ {2803525200 -18000 0 CST}
+ {2814411600 -14400 1 CDT}
+ {2834974800 -18000 0 CST}
+ {2846466000 -14400 1 CDT}
+ {2867029200 -18000 0 CST}
+ {2877915600 -14400 1 CDT}
+ {2898478800 -18000 0 CST}
+ {2909365200 -14400 1 CDT}
+ {2929928400 -18000 0 CST}
+ {2940814800 -14400 1 CDT}
+ {2961378000 -18000 0 CST}
+ {2972264400 -14400 1 CDT}
+ {2992827600 -18000 0 CST}
+ {3003714000 -14400 1 CDT}
+ {3024277200 -18000 0 CST}
+ {3035768400 -14400 1 CDT}
+ {3056331600 -18000 0 CST}
+ {3067218000 -14400 1 CDT}
+ {3087781200 -18000 0 CST}
+ {3098667600 -14400 1 CDT}
+ {3119230800 -18000 0 CST}
+ {3130117200 -14400 1 CDT}
+ {3150680400 -18000 0 CST}
+ {3161566800 -14400 1 CDT}
+ {3182130000 -18000 0 CST}
+ {3193016400 -14400 1 CDT}
+ {3213579600 -18000 0 CST}
+ {3225070800 -14400 1 CDT}
+ {3245634000 -18000 0 CST}
+ {3256520400 -14400 1 CDT}
+ {3277083600 -18000 0 CST}
+ {3287970000 -14400 1 CDT}
+ {3308533200 -18000 0 CST}
+ {3319419600 -14400 1 CDT}
+ {3339982800 -18000 0 CST}
+ {3350869200 -14400 1 CDT}
+ {3371432400 -18000 0 CST}
+ {3382923600 -14400 1 CDT}
+ {3403486800 -18000 0 CST}
+ {3414373200 -14400 1 CDT}
+ {3434936400 -18000 0 CST}
+ {3445822800 -14400 1 CDT}
+ {3466386000 -18000 0 CST}
+ {3477272400 -14400 1 CDT}
+ {3497835600 -18000 0 CST}
+ {3508722000 -14400 1 CDT}
+ {3529285200 -18000 0 CST}
+ {3540171600 -14400 1 CDT}
+ {3560734800 -18000 0 CST}
+ {3572226000 -14400 1 CDT}
+ {3592789200 -18000 0 CST}
+ {3603675600 -14400 1 CDT}
+ {3624238800 -18000 0 CST}
+ {3635125200 -14400 1 CDT}
+ {3655688400 -18000 0 CST}
+ {3666574800 -14400 1 CDT}
+ {3687138000 -18000 0 CST}
+ {3698024400 -14400 1 CDT}
+ {3718587600 -18000 0 CST}
+ {3730078800 -14400 1 CDT}
+ {3750642000 -18000 0 CST}
+ {3761528400 -14400 1 CDT}
+ {3782091600 -18000 0 CST}
+ {3792978000 -14400 1 CDT}
+ {3813541200 -18000 0 CST}
+ {3824427600 -14400 1 CDT}
+ {3844990800 -18000 0 CST}
+ {3855877200 -14400 1 CDT}
+ {3876440400 -18000 0 CST}
+ {3887326800 -14400 1 CDT}
+ {3907890000 -18000 0 CST}
+ {3919381200 -14400 1 CDT}
+ {3939944400 -18000 0 CST}
+ {3950830800 -14400 1 CDT}
+ {3971394000 -18000 0 CST}
+ {3982280400 -14400 1 CDT}
+ {4002843600 -18000 0 CST}
+ {4013730000 -14400 1 CDT}
+ {4034293200 -18000 0 CST}
+ {4045179600 -14400 1 CDT}
+ {4065742800 -18000 0 CST}
+ {4076629200 -14400 1 CDT}
+ {4097192400 -18000 0 CST}
}
diff --git a/library/tzdata/America/Hermosillo b/library/tzdata/America/Hermosillo
index 6134a47..779020e 100644
--- a/library/tzdata/America/Hermosillo
+++ b/library/tzdata/America/Hermosillo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Hermosillo) {
{-9223372036854775808 -26632 0 LMT}
diff --git a/library/tzdata/America/Indiana/Indianapolis b/library/tzdata/America/Indiana/Indianapolis
index 85da57e..63c410c 100644
--- a/library/tzdata/America/Indiana/Indianapolis
+++ b/library/tzdata/America/Indiana/Indianapolis
@@ -1,5 +1,234 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Indianapolis)]} {
- LoadTimeZoneFile America/Indianapolis
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Indiana/Indianapolis) {
+ {-9223372036854775808 -20678 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-1577901600 -21600 0 CST}
+ {-900259200 -18000 1 CDT}
+ {-891795600 -21600 0 CST}
+ {-883591200 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-757360800 -21600 0 CST}
+ {-747244800 -18000 1 CDT}
+ {-733942800 -21600 0 CST}
+ {-715795200 -18000 1 CDT}
+ {-702493200 -21600 0 CST}
+ {-684345600 -18000 1 CDT}
+ {-671043600 -21600 0 CST}
+ {-652896000 -18000 1 CDT}
+ {-639594000 -21600 0 CST}
+ {-620841600 -18000 1 CDT}
+ {-608144400 -21600 0 CST}
+ {-589392000 -18000 1 CDT}
+ {-576090000 -21600 0 CST}
+ {-557942400 -18000 1 CDT}
+ {-544640400 -21600 0 CST}
+ {-526492800 -18000 1 CDT}
+ {-513190800 -21600 0 CST}
+ {-495043200 -18000 1 CDT}
+ {-481741200 -21600 0 CST}
+ {-463593600 -18000 0 EST}
+ {-386787600 -21600 0 CST}
+ {-368640000 -18000 0 EST}
+ {-31518000 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {31554000 -18000 0 EST}
+ {1136091600 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
-set TZData(:America/Indiana/Indianapolis) $TZData(:America/Indianapolis)
diff --git a/library/tzdata/America/Indiana/Knox b/library/tzdata/America/Indiana/Knox
index 65786e7..eee3ff4 100644
--- a/library/tzdata/America/Indiana/Knox
+++ b/library/tzdata/America/Indiana/Knox
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Indiana/Knox) {
{-9223372036854775808 -20790 0 LMT}
@@ -93,4 +93,193 @@ set TZData(:America/Indiana/Knox) {
{657097200 -21600 0 CST}
{671011200 -18000 1 CDT}
{688550400 -18000 0 EST}
+ {1143961200 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 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/Indiana/Marengo b/library/tzdata/America/Indiana/Marengo
index 6ca72ba..3f1d578 100644
--- a/library/tzdata/America/Indiana/Marengo
+++ b/library/tzdata/America/Indiana/Marengo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Indiana/Marengo) {
{-9223372036854775808 -20723 0 LMT}
@@ -44,4 +44,193 @@ set TZData(:America/Indiana/Marengo) {
{162370800 -14400 1 EDT}
{183535200 -18000 0 EST}
{189320400 -18000 0 EST}
+ {1136091600 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Indiana/Petersburg b/library/tzdata/America/Indiana/Petersburg
new file mode 100644
index 0000000..6992bfc
--- /dev/null
+++ b/library/tzdata/America/Indiana/Petersburg
@@ -0,0 +1,247 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Indiana/Petersburg) {
+ {-9223372036854775808 -20947 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-473364000 -21600 0 CST}
+ {-462996000 -18000 1 CDT}
+ {-450291600 -21600 0 CST}
+ {-431539200 -18000 1 CDT}
+ {-418237200 -21600 0 CST}
+ {-400089600 -18000 1 CDT}
+ {-386787600 -21600 0 CST}
+ {-368640000 -18000 1 CDT}
+ {-355338000 -21600 0 CST}
+ {-337190400 -18000 1 CDT}
+ {-323888400 -21600 0 CST}
+ {-305740800 -18000 1 CDT}
+ {-292438800 -21600 0 CST}
+ {-273686400 -18000 1 CDT}
+ {-257965200 -21600 0 CST}
+ {-242236800 -18000 1 CDT}
+ {-226515600 -21600 0 CST}
+ {-210787200 -18000 1 CDT}
+ {-195066000 -21600 0 CST}
+ {-179337600 -18000 1 CDT}
+ {-163616400 -21600 0 CST}
+ {-147888000 -18000 0 EST}
+ {-100112400 -21600 0 CST}
+ {-84384000 -18000 1 CDT}
+ {-68662800 -21600 0 CST}
+ {-52934400 -18000 1 CDT}
+ {-37213200 -21600 0 CST}
+ {-21484800 -18000 1 CDT}
+ {-5763600 -21600 0 CST}
+ {9964800 -18000 1 CDT}
+ {25686000 -21600 0 CST}
+ {41414400 -18000 1 CDT}
+ {57740400 -21600 0 CST}
+ {73468800 -18000 1 CDT}
+ {89190000 -21600 0 CST}
+ {104918400 -18000 1 CDT}
+ {120639600 -21600 0 CST}
+ {126691200 -18000 1 CDT}
+ {152089200 -21600 0 CST}
+ {162374400 -18000 1 CDT}
+ {183538800 -21600 0 CST}
+ {199267200 -18000 1 CDT}
+ {215593200 -21600 0 CST}
+ {230716800 -18000 1 CDT}
+ {247046400 -18000 0 EST}
+ {1143961200 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 CDT}
+ {1194163200 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
+}
diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City
new file mode 100644
index 0000000..9eebcf7
--- /dev/null
+++ b/library/tzdata/America/Indiana/Tell_City
@@ -0,0 +1,234 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Indiana/Tell_City) {
+ {-9223372036854775808 -20823 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-757360800 -21600 0 CST}
+ {-747244800 -18000 1 CDT}
+ {-733942800 -21600 0 CST}
+ {-526492800 -18000 1 CDT}
+ {-513190800 -21600 0 CST}
+ {-495043200 -18000 1 CDT}
+ {-481741200 -21600 0 CST}
+ {-462996000 -18000 1 CDT}
+ {-450291600 -21600 0 CST}
+ {-431539200 -18000 1 CDT}
+ {-418237200 -21600 0 CST}
+ {-400089600 -18000 1 CDT}
+ {-386787600 -21600 0 CST}
+ {-368640000 -18000 1 CDT}
+ {-355338000 -21600 0 CST}
+ {-337190400 -18000 1 CDT}
+ {-323888400 -21600 0 CST}
+ {-305740800 -18000 1 CDT}
+ {-289414800 -21600 0 CST}
+ {-273686400 -18000 1 CDT}
+ {-260989200 -21600 0 CST}
+ {-242236800 -18000 1 CDT}
+ {-226515600 -21600 0 CST}
+ {-210787200 -18000 1 CDT}
+ {-195066000 -21600 0 CST}
+ {-179337600 -18000 0 EST}
+ {-31518000 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {31554000 -18000 0 EST}
+ {1143961200 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 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/Indiana/Vevay b/library/tzdata/America/Indiana/Vevay
index aac8975..8d4157f 100644
--- a/library/tzdata/America/Indiana/Vevay
+++ b/library/tzdata/America/Indiana/Vevay
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Indiana/Vevay) {
{-9223372036854775808 -20416 0 LMT}
@@ -21,4 +21,193 @@ set TZData(:America/Indiana/Vevay) {
{73465200 -14400 1 EDT}
{89186400 -18000 0 EST}
{94712400 -18000 0 EST}
+ {1136091600 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Indiana/Vincennes b/library/tzdata/America/Indiana/Vincennes
new file mode 100644
index 0000000..1af7fc9
--- /dev/null
+++ b/library/tzdata/America/Indiana/Vincennes
@@ -0,0 +1,234 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Indiana/Vincennes) {
+ {-9223372036854775808 -21007 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-757360800 -21600 0 CST}
+ {-747244800 -18000 1 CDT}
+ {-733942800 -21600 0 CST}
+ {-526492800 -18000 1 CDT}
+ {-513190800 -21600 0 CST}
+ {-495043200 -18000 1 CDT}
+ {-481741200 -21600 0 CST}
+ {-462996000 -18000 1 CDT}
+ {-450291600 -21600 0 CST}
+ {-431539200 -18000 1 CDT}
+ {-418237200 -21600 0 CST}
+ {-400089600 -18000 1 CDT}
+ {-386787600 -21600 0 CST}
+ {-368640000 -18000 1 CDT}
+ {-355338000 -21600 0 CST}
+ {-337190400 -18000 1 CDT}
+ {-323888400 -21600 0 CST}
+ {-305740800 -18000 1 CDT}
+ {-289414800 -21600 0 CST}
+ {-273686400 -18000 1 CDT}
+ {-260989200 -21600 0 CST}
+ {-242236800 -18000 1 CDT}
+ {-226515600 -21600 0 CST}
+ {-210787200 -18000 1 CDT}
+ {-195066000 -21600 0 CST}
+ {-179337600 -18000 0 EST}
+ {-31518000 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {31554000 -18000 0 EST}
+ {1143961200 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 CDT}
+ {1194163200 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
+}
diff --git a/library/tzdata/America/Indiana/Winamac b/library/tzdata/America/Indiana/Winamac
new file mode 100644
index 0000000..fb6cd37
--- /dev/null
+++ b/library/tzdata/America/Indiana/Winamac
@@ -0,0 +1,240 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Indiana/Winamac) {
+ {-9223372036854775808 -20785 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-757360800 -21600 0 CST}
+ {-747244800 -18000 1 CDT}
+ {-733942800 -21600 0 CST}
+ {-715795200 -18000 1 CDT}
+ {-702493200 -21600 0 CST}
+ {-684345600 -18000 1 CDT}
+ {-671043600 -21600 0 CST}
+ {-652896000 -18000 1 CDT}
+ {-639594000 -21600 0 CST}
+ {-620841600 -18000 1 CDT}
+ {-608144400 -21600 0 CST}
+ {-589392000 -18000 1 CDT}
+ {-576090000 -21600 0 CST}
+ {-557942400 -18000 1 CDT}
+ {-544640400 -21600 0 CST}
+ {-526492800 -18000 1 CDT}
+ {-513190800 -21600 0 CST}
+ {-495043200 -18000 1 CDT}
+ {-481741200 -21600 0 CST}
+ {-463593600 -18000 1 CDT}
+ {-447267600 -21600 0 CST}
+ {-431539200 -18000 1 CDT}
+ {-415818000 -21600 0 CST}
+ {-400089600 -18000 1 CDT}
+ {-386787600 -21600 0 CST}
+ {-368640000 -18000 1 CDT}
+ {-355338000 -21600 0 CST}
+ {-337190400 -18000 1 CDT}
+ {-323888400 -21600 0 CST}
+ {-305740800 -18000 1 CDT}
+ {-292438800 -21600 0 CST}
+ {-273686400 -18000 0 EST}
+ {-31518000 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {31554000 -18000 0 EST}
+ {1143961200 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -14400 0 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
+}
diff --git a/library/tzdata/America/Indianapolis b/library/tzdata/America/Indianapolis
index 0834d47..7398545 100644
--- a/library/tzdata/America/Indianapolis
+++ b/library/tzdata/America/Indianapolis
@@ -1,45 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Indianapolis) {
- {-9223372036854775808 -20678 0 LMT}
- {-2717647200 -21600 0 CST}
- {-1633276800 -18000 1 CDT}
- {-1615136400 -21600 0 CST}
- {-1601827200 -18000 1 CDT}
- {-1583686800 -21600 0 CST}
- {-1577901600 -21600 0 CST}
- {-900259200 -18000 1 CDT}
- {-891795600 -21600 0 CST}
- {-883591200 -21600 0 CST}
- {-880214400 -18000 1 CWT}
- {-769395600 -18000 1 CPT}
- {-765392400 -21600 0 CST}
- {-757360800 -21600 0 CST}
- {-747244800 -18000 1 CDT}
- {-733942800 -21600 0 CST}
- {-715795200 -18000 1 CDT}
- {-702493200 -21600 0 CST}
- {-684345600 -18000 1 CDT}
- {-671043600 -21600 0 CST}
- {-652896000 -18000 1 CDT}
- {-639594000 -21600 0 CST}
- {-620841600 -18000 1 CDT}
- {-608144400 -21600 0 CST}
- {-589392000 -18000 1 CDT}
- {-576090000 -21600 0 CST}
- {-557942400 -18000 1 CDT}
- {-544640400 -21600 0 CST}
- {-526492800 -18000 1 CDT}
- {-513190800 -21600 0 CST}
- {-495043200 -18000 1 CDT}
- {-481741200 -21600 0 CST}
- {-463593600 -18000 0 EST}
- {-386787600 -21600 0 CST}
- {-368640000 -18000 0 EST}
- {-31518000 -18000 0 EST}
- {-21488400 -14400 1 EDT}
- {-5767200 -18000 0 EST}
- {9961200 -14400 1 EDT}
- {25682400 -18000 0 EST}
- {31554000 -18000 0 EST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Indiana/Indianapolis)]} {
+ LoadTimeZoneFile America/Indiana/Indianapolis
}
+set TZData(:America/Indianapolis) $TZData(:America/Indiana/Indianapolis)
diff --git a/library/tzdata/America/Inuvik b/library/tzdata/America/Inuvik
index fe57dd8..dd0d151 100644
--- a/library/tzdata/America/Inuvik
+++ b/library/tzdata/America/Inuvik
@@ -1,18 +1,11 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Inuvik) {
- {-9223372036854775808 -32040 0 LMT}
- {-2713878360 -28800 0 PST}
- {-1632060000 -25200 1 PDT}
- {-1615129200 -28800 0 PST}
- {-1596981600 -25200 1 PDT}
- {-1583168400 -28800 0 PST}
- {-880207200 -25200 1 PWT}
- {-769395600 -25200 1 PPT}
- {-765385200 -28800 0 PST}
+ {-9223372036854775808 0 0 zzz}
+ {-536457600 -28800 0 PST}
{-147888000 -21600 1 PDDT}
{-131558400 -28800 0 PST}
- {294228000 -25200 0 MST}
+ {315558000 -25200 0 MST}
{325674000 -21600 1 MDT}
{341395200 -25200 0 MST}
{357123600 -21600 1 MDT}
@@ -67,190 +60,190 @@ set TZData(:America/Inuvik) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/America/Iqaluit b/library/tzdata/America/Iqaluit
index 88fb481..2a2e9fe 100644
--- a/library/tzdata/America/Iqaluit
+++ b/library/tzdata/America/Iqaluit
@@ -1,13 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Iqaluit) {
- {-9223372036854775808 -16432 0 LMT}
- {-2713893968 -18000 0 EST}
- {-1632070800 -14400 1 EDT}
- {-1615140000 -18000 0 EST}
- {-1596992400 -14400 1 EDT}
- {-1583179200 -18000 0 EST}
- {-880218000 -14400 1 EWT}
+ {-9223372036854775808 0 0 zzz}
+ {-865296000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
{-765396000 -18000 0 EST}
{-147898800 -10800 1 EDDT}
@@ -66,190 +61,190 @@ set TZData(:America/Iqaluit) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Jamaica b/library/tzdata/America/Jamaica
index 12dc6c3..682e47c 100644
--- a/library/tzdata/America/Jamaica
+++ b/library/tzdata/America/Jamaica
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Jamaica) {
- {-9223372036854775808 -18432 0 LMT}
- {-2524503168 -18432 0 KMT}
- {-1827687168 -18000 0 EST}
+ {-9223372036854775808 -18431 0 LMT}
+ {-2524503169 -18431 0 KMT}
+ {-1827687169 -18000 0 EST}
{136364400 -14400 0 EDT}
{152085600 -18000 0 EST}
{162370800 -14400 1 EDT}
diff --git a/library/tzdata/America/Jujuy b/library/tzdata/America/Jujuy
index f5d5e2d..b4c5da3 100644
--- a/library/tzdata/America/Jujuy
+++ b/library/tzdata/America/Jujuy
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Jujuy)]} {
LoadTimeZoneFile America/Argentina/Jujuy
}
diff --git a/library/tzdata/America/Juneau b/library/tzdata/America/Juneau
index 266ad12..fead810 100644
--- a/library/tzdata/America/Juneau
+++ b/library/tzdata/America/Juneau
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Juneau) {
{-9223372036854775808 54139 0 LMT}
@@ -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}
@@ -86,190 +87,190 @@ set TZData(:America/Juneau) {
{1130666400 -32400 0 AKST}
{1143975600 -28800 1 AKDT}
{1162116000 -32400 0 AKST}
- {1175425200 -28800 1 AKDT}
- {1193565600 -32400 0 AKST}
- {1207479600 -28800 1 AKDT}
- {1225015200 -32400 0 AKST}
- {1238929200 -28800 1 AKDT}
- {1256464800 -32400 0 AKST}
- {1270378800 -28800 1 AKDT}
- {1288519200 -32400 0 AKST}
- {1301828400 -28800 1 AKDT}
- {1319968800 -32400 0 AKST}
- {1333278000 -28800 1 AKDT}
- {1351418400 -32400 0 AKST}
- {1365332400 -28800 1 AKDT}
- {1382868000 -32400 0 AKST}
- {1396782000 -28800 1 AKDT}
- {1414317600 -32400 0 AKST}
- {1428231600 -28800 1 AKDT}
- {1445767200 -32400 0 AKST}
- {1459681200 -28800 1 AKDT}
- {1477821600 -32400 0 AKST}
- {1491130800 -28800 1 AKDT}
- {1509271200 -32400 0 AKST}
- {1522580400 -28800 1 AKDT}
- {1540720800 -32400 0 AKST}
- {1554634800 -28800 1 AKDT}
- {1572170400 -32400 0 AKST}
- {1586084400 -28800 1 AKDT}
- {1603620000 -32400 0 AKST}
- {1617534000 -28800 1 AKDT}
- {1635674400 -32400 0 AKST}
- {1648983600 -28800 1 AKDT}
- {1667124000 -32400 0 AKST}
- {1680433200 -28800 1 AKDT}
- {1698573600 -32400 0 AKST}
- {1712487600 -28800 1 AKDT}
- {1730023200 -32400 0 AKST}
- {1743937200 -28800 1 AKDT}
- {1761472800 -32400 0 AKST}
- {1775386800 -28800 1 AKDT}
- {1792922400 -32400 0 AKST}
- {1806836400 -28800 1 AKDT}
- {1824976800 -32400 0 AKST}
- {1838286000 -28800 1 AKDT}
- {1856426400 -32400 0 AKST}
- {1869735600 -28800 1 AKDT}
- {1887876000 -32400 0 AKST}
- {1901790000 -28800 1 AKDT}
- {1919325600 -32400 0 AKST}
- {1933239600 -28800 1 AKDT}
- {1950775200 -32400 0 AKST}
- {1964689200 -28800 1 AKDT}
- {1982829600 -32400 0 AKST}
- {1996138800 -28800 1 AKDT}
- {2014279200 -32400 0 AKST}
- {2027588400 -28800 1 AKDT}
- {2045728800 -32400 0 AKST}
- {2059038000 -28800 1 AKDT}
- {2077178400 -32400 0 AKST}
- {2091092400 -28800 1 AKDT}
- {2108628000 -32400 0 AKST}
- {2122542000 -28800 1 AKDT}
- {2140077600 -32400 0 AKST}
- {2153991600 -28800 1 AKDT}
- {2172132000 -32400 0 AKST}
- {2185441200 -28800 1 AKDT}
- {2203581600 -32400 0 AKST}
- {2216890800 -28800 1 AKDT}
- {2235031200 -32400 0 AKST}
- {2248945200 -28800 1 AKDT}
- {2266480800 -32400 0 AKST}
- {2280394800 -28800 1 AKDT}
- {2297930400 -32400 0 AKST}
- {2311844400 -28800 1 AKDT}
- {2329380000 -32400 0 AKST}
- {2343294000 -28800 1 AKDT}
- {2361434400 -32400 0 AKST}
- {2374743600 -28800 1 AKDT}
- {2392884000 -32400 0 AKST}
- {2406193200 -28800 1 AKDT}
- {2424333600 -32400 0 AKST}
- {2438247600 -28800 1 AKDT}
- {2455783200 -32400 0 AKST}
- {2469697200 -28800 1 AKDT}
- {2487232800 -32400 0 AKST}
- {2501146800 -28800 1 AKDT}
- {2519287200 -32400 0 AKST}
- {2532596400 -28800 1 AKDT}
- {2550736800 -32400 0 AKST}
- {2564046000 -28800 1 AKDT}
- {2582186400 -32400 0 AKST}
- {2596100400 -28800 1 AKDT}
- {2613636000 -32400 0 AKST}
- {2627550000 -28800 1 AKDT}
- {2645085600 -32400 0 AKST}
- {2658999600 -28800 1 AKDT}
- {2676535200 -32400 0 AKST}
- {2690449200 -28800 1 AKDT}
- {2708589600 -32400 0 AKST}
- {2721898800 -28800 1 AKDT}
- {2740039200 -32400 0 AKST}
- {2753348400 -28800 1 AKDT}
- {2771488800 -32400 0 AKST}
- {2785402800 -28800 1 AKDT}
- {2802938400 -32400 0 AKST}
- {2816852400 -28800 1 AKDT}
- {2834388000 -32400 0 AKST}
- {2848302000 -28800 1 AKDT}
- {2866442400 -32400 0 AKST}
- {2879751600 -28800 1 AKDT}
- {2897892000 -32400 0 AKST}
- {2911201200 -28800 1 AKDT}
- {2929341600 -32400 0 AKST}
- {2942650800 -28800 1 AKDT}
- {2960791200 -32400 0 AKST}
- {2974705200 -28800 1 AKDT}
- {2992240800 -32400 0 AKST}
- {3006154800 -28800 1 AKDT}
- {3023690400 -32400 0 AKST}
- {3037604400 -28800 1 AKDT}
- {3055744800 -32400 0 AKST}
- {3069054000 -28800 1 AKDT}
- {3087194400 -32400 0 AKST}
- {3100503600 -28800 1 AKDT}
- {3118644000 -32400 0 AKST}
- {3132558000 -28800 1 AKDT}
- {3150093600 -32400 0 AKST}
- {3164007600 -28800 1 AKDT}
- {3181543200 -32400 0 AKST}
- {3195457200 -28800 1 AKDT}
- {3212992800 -32400 0 AKST}
- {3226906800 -28800 1 AKDT}
- {3245047200 -32400 0 AKST}
- {3258356400 -28800 1 AKDT}
- {3276496800 -32400 0 AKST}
- {3289806000 -28800 1 AKDT}
- {3307946400 -32400 0 AKST}
- {3321860400 -28800 1 AKDT}
- {3339396000 -32400 0 AKST}
- {3353310000 -28800 1 AKDT}
- {3370845600 -32400 0 AKST}
- {3384759600 -28800 1 AKDT}
- {3402900000 -32400 0 AKST}
- {3416209200 -28800 1 AKDT}
- {3434349600 -32400 0 AKST}
- {3447658800 -28800 1 AKDT}
- {3465799200 -32400 0 AKST}
- {3479713200 -28800 1 AKDT}
- {3497248800 -32400 0 AKST}
- {3511162800 -28800 1 AKDT}
- {3528698400 -32400 0 AKST}
- {3542612400 -28800 1 AKDT}
- {3560148000 -32400 0 AKST}
- {3574062000 -28800 1 AKDT}
- {3592202400 -32400 0 AKST}
- {3605511600 -28800 1 AKDT}
- {3623652000 -32400 0 AKST}
- {3636961200 -28800 1 AKDT}
- {3655101600 -32400 0 AKST}
- {3669015600 -28800 1 AKDT}
- {3686551200 -32400 0 AKST}
- {3700465200 -28800 1 AKDT}
- {3718000800 -32400 0 AKST}
- {3731914800 -28800 1 AKDT}
- {3750055200 -32400 0 AKST}
- {3763364400 -28800 1 AKDT}
- {3781504800 -32400 0 AKST}
- {3794814000 -28800 1 AKDT}
- {3812954400 -32400 0 AKST}
- {3826263600 -28800 1 AKDT}
- {3844404000 -32400 0 AKST}
- {3858318000 -28800 1 AKDT}
- {3875853600 -32400 0 AKST}
- {3889767600 -28800 1 AKDT}
- {3907303200 -32400 0 AKST}
- {3921217200 -28800 1 AKDT}
- {3939357600 -32400 0 AKST}
- {3952666800 -28800 1 AKDT}
- {3970807200 -32400 0 AKST}
- {3984116400 -28800 1 AKDT}
- {4002256800 -32400 0 AKST}
- {4016170800 -28800 1 AKDT}
- {4033706400 -32400 0 AKST}
- {4047620400 -28800 1 AKDT}
- {4065156000 -32400 0 AKST}
- {4079070000 -28800 1 AKDT}
- {4096605600 -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/Kentucky/Louisville b/library/tzdata/America/Kentucky/Louisville
index 41731ca..c2aa10c 100644
--- a/library/tzdata/America/Kentucky/Louisville
+++ b/library/tzdata/America/Kentucky/Louisville
@@ -1,5 +1,314 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Louisville)]} {
- LoadTimeZoneFile America/Louisville
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Kentucky/Louisville) {
+ {-9223372036854775808 -20582 0 LMT}
+ {-2717647200 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-1546279200 -21600 0 CST}
+ {-1535904000 -18000 1 CDT}
+ {-1525280400 -21600 0 CST}
+ {-905097600 -18000 1 CDT}
+ {-891795600 -21600 0 CST}
+ {-883591200 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-757360800 -21600 0 CST}
+ {-747244800 -18000 1 CDT}
+ {-744224400 -21600 0 CST}
+ {-715795200 -18000 1 CDT}
+ {-684349200 -18000 1 CDT}
+ {-652899600 -18000 1 CDT}
+ {-620845200 -18000 1 CDT}
+ {-608144400 -21600 0 CST}
+ {-589392000 -18000 1 CDT}
+ {-576090000 -21600 0 CST}
+ {-557942400 -18000 1 CDT}
+ {-544640400 -21600 0 CST}
+ {-526492800 -18000 1 CDT}
+ {-513190800 -21600 0 CST}
+ {-495043200 -18000 1 CDT}
+ {-481741200 -21600 0 CST}
+ {-463593600 -18000 1 CDT}
+ {-450291600 -21600 0 CST}
+ {-431539200 -18000 1 CDT}
+ {-415818000 -21600 0 CST}
+ {-400089600 -18000 1 CDT}
+ {-384368400 -21600 0 CST}
+ {-368640000 -18000 1 CDT}
+ {-352918800 -21600 0 CST}
+ {-337190400 -18000 1 CDT}
+ {-321469200 -21600 0 CST}
+ {-305740800 -18000 1 CDT}
+ {-289414800 -21600 0 CST}
+ {-273686400 -18000 1 CDT}
+ {-266432400 -18000 0 EST}
+ {-63140400 -18000 0 EST}
+ {-52938000 -14400 1 EDT}
+ {-37216800 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {41410800 -14400 1 EDT}
+ {57736800 -18000 0 EST}
+ {73465200 -14400 1 EDT}
+ {89186400 -18000 0 EST}
+ {104914800 -14400 1 EDT}
+ {120636000 -18000 0 EST}
+ {126687600 -18000 1 CDT}
+ {152089200 -18000 0 EST}
+ {162370800 -14400 1 EDT}
+ {183535200 -18000 0 EST}
+ {199263600 -14400 1 EDT}
+ {215589600 -18000 0 EST}
+ {230713200 -14400 1 EDT}
+ {247039200 -18000 0 EST}
+ {262767600 -14400 1 EDT}
+ {278488800 -18000 0 EST}
+ {294217200 -14400 1 EDT}
+ {309938400 -18000 0 EST}
+ {325666800 -14400 1 EDT}
+ {341388000 -18000 0 EST}
+ {357116400 -14400 1 EDT}
+ {372837600 -18000 0 EST}
+ {388566000 -14400 1 EDT}
+ {404892000 -18000 0 EST}
+ {420015600 -14400 1 EDT}
+ {436341600 -18000 0 EST}
+ {452070000 -14400 1 EDT}
+ {467791200 -18000 0 EST}
+ {483519600 -14400 1 EDT}
+ {499240800 -18000 0 EST}
+ {514969200 -14400 1 EDT}
+ {530690400 -18000 0 EST}
+ {544604400 -14400 1 EDT}
+ {562140000 -18000 0 EST}
+ {576054000 -14400 1 EDT}
+ {594194400 -18000 0 EST}
+ {607503600 -14400 1 EDT}
+ {625644000 -18000 0 EST}
+ {638953200 -14400 1 EDT}
+ {657093600 -18000 0 EST}
+ {671007600 -14400 1 EDT}
+ {688543200 -18000 0 EST}
+ {702457200 -14400 1 EDT}
+ {719992800 -18000 0 EST}
+ {733906800 -14400 1 EDT}
+ {752047200 -18000 0 EST}
+ {765356400 -14400 1 EDT}
+ {783496800 -18000 0 EST}
+ {796806000 -14400 1 EDT}
+ {814946400 -18000 0 EST}
+ {828860400 -14400 1 EDT}
+ {846396000 -18000 0 EST}
+ {860310000 -14400 1 EDT}
+ {877845600 -18000 0 EST}
+ {891759600 -14400 1 EDT}
+ {909295200 -18000 0 EST}
+ {923209200 -14400 1 EDT}
+ {941349600 -18000 0 EST}
+ {954658800 -14400 1 EDT}
+ {972799200 -18000 0 EST}
+ {986108400 -14400 1 EDT}
+ {1004248800 -18000 0 EST}
+ {1018162800 -14400 1 EDT}
+ {1035698400 -18000 0 EST}
+ {1049612400 -14400 1 EDT}
+ {1067148000 -18000 0 EST}
+ {1081062000 -14400 1 EDT}
+ {1099202400 -18000 0 EST}
+ {1112511600 -14400 1 EDT}
+ {1130652000 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
-set TZData(:America/Kentucky/Louisville) $TZData(:America/Louisville)
diff --git a/library/tzdata/America/Kentucky/Monticello b/library/tzdata/America/Kentucky/Monticello
index 5602f61..e523ecb 100644
--- a/library/tzdata/America/Kentucky/Monticello
+++ b/library/tzdata/America/Kentucky/Monticello
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Kentucky/Monticello) {
{-9223372036854775808 -20364 0 LMT}
@@ -90,190 +90,190 @@ set TZData(:America/Kentucky/Monticello) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Knox_IN b/library/tzdata/America/Knox_IN
index ed51a1b..00d21c0 100644
--- a/library/tzdata/America/Knox_IN
+++ b/library/tzdata/America/Knox_IN
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Indiana/Knox)]} {
LoadTimeZoneFile America/Indiana/Knox
}
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/La_Paz b/library/tzdata/America/La_Paz
index c1ae276..38ffbb0 100644
--- a/library/tzdata/America/La_Paz
+++ b/library/tzdata/America/La_Paz
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/La_Paz) {
{-9223372036854775808 -16356 0 LMT}
diff --git a/library/tzdata/America/Lima b/library/tzdata/America/Lima
index c899c10..c6e6ac1 100644
--- a/library/tzdata/America/Lima
+++ b/library/tzdata/America/Lima
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Lima) {
{-9223372036854775808 -18492 0 LMT}
diff --git a/library/tzdata/America/Los_Angeles b/library/tzdata/America/Los_Angeles
index 7d0e4ed..da6ca99 100644
--- a/library/tzdata/America/Los_Angeles
+++ b/library/tzdata/America/Los_Angeles
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Los_Angeles) {
{-9223372036854775808 -28378 0 LMT}
@@ -128,190 +128,190 @@ set TZData(:America/Los_Angeles) {
{1130662800 -28800 0 PST}
{1143972000 -25200 1 PDT}
{1162112400 -28800 0 PST}
- {1175421600 -25200 1 PDT}
- {1193562000 -28800 0 PST}
- {1207476000 -25200 1 PDT}
- {1225011600 -28800 0 PST}
- {1238925600 -25200 1 PDT}
- {1256461200 -28800 0 PST}
- {1270375200 -25200 1 PDT}
- {1288515600 -28800 0 PST}
- {1301824800 -25200 1 PDT}
- {1319965200 -28800 0 PST}
- {1333274400 -25200 1 PDT}
- {1351414800 -28800 0 PST}
- {1365328800 -25200 1 PDT}
- {1382864400 -28800 0 PST}
- {1396778400 -25200 1 PDT}
- {1414314000 -28800 0 PST}
- {1428228000 -25200 1 PDT}
- {1445763600 -28800 0 PST}
- {1459677600 -25200 1 PDT}
- {1477818000 -28800 0 PST}
- {1491127200 -25200 1 PDT}
- {1509267600 -28800 0 PST}
- {1522576800 -25200 1 PDT}
- {1540717200 -28800 0 PST}
- {1554631200 -25200 1 PDT}
- {1572166800 -28800 0 PST}
- {1586080800 -25200 1 PDT}
- {1603616400 -28800 0 PST}
- {1617530400 -25200 1 PDT}
- {1635670800 -28800 0 PST}
- {1648980000 -25200 1 PDT}
- {1667120400 -28800 0 PST}
- {1680429600 -25200 1 PDT}
- {1698570000 -28800 0 PST}
- {1712484000 -25200 1 PDT}
- {1730019600 -28800 0 PST}
- {1743933600 -25200 1 PDT}
- {1761469200 -28800 0 PST}
- {1775383200 -25200 1 PDT}
- {1792918800 -28800 0 PST}
- {1806832800 -25200 1 PDT}
- {1824973200 -28800 0 PST}
- {1838282400 -25200 1 PDT}
- {1856422800 -28800 0 PST}
- {1869732000 -25200 1 PDT}
- {1887872400 -28800 0 PST}
- {1901786400 -25200 1 PDT}
- {1919322000 -28800 0 PST}
- {1933236000 -25200 1 PDT}
- {1950771600 -28800 0 PST}
- {1964685600 -25200 1 PDT}
- {1982826000 -28800 0 PST}
- {1996135200 -25200 1 PDT}
- {2014275600 -28800 0 PST}
- {2027584800 -25200 1 PDT}
- {2045725200 -28800 0 PST}
- {2059034400 -25200 1 PDT}
- {2077174800 -28800 0 PST}
- {2091088800 -25200 1 PDT}
- {2108624400 -28800 0 PST}
- {2122538400 -25200 1 PDT}
- {2140074000 -28800 0 PST}
- {2153988000 -25200 1 PDT}
- {2172128400 -28800 0 PST}
- {2185437600 -25200 1 PDT}
- {2203578000 -28800 0 PST}
- {2216887200 -25200 1 PDT}
- {2235027600 -28800 0 PST}
- {2248941600 -25200 1 PDT}
- {2266477200 -28800 0 PST}
- {2280391200 -25200 1 PDT}
- {2297926800 -28800 0 PST}
- {2311840800 -25200 1 PDT}
- {2329376400 -28800 0 PST}
- {2343290400 -25200 1 PDT}
- {2361430800 -28800 0 PST}
- {2374740000 -25200 1 PDT}
- {2392880400 -28800 0 PST}
- {2406189600 -25200 1 PDT}
- {2424330000 -28800 0 PST}
- {2438244000 -25200 1 PDT}
- {2455779600 -28800 0 PST}
- {2469693600 -25200 1 PDT}
- {2487229200 -28800 0 PST}
- {2501143200 -25200 1 PDT}
- {2519283600 -28800 0 PST}
- {2532592800 -25200 1 PDT}
- {2550733200 -28800 0 PST}
- {2564042400 -25200 1 PDT}
- {2582182800 -28800 0 PST}
- {2596096800 -25200 1 PDT}
- {2613632400 -28800 0 PST}
- {2627546400 -25200 1 PDT}
- {2645082000 -28800 0 PST}
- {2658996000 -25200 1 PDT}
- {2676531600 -28800 0 PST}
- {2690445600 -25200 1 PDT}
- {2708586000 -28800 0 PST}
- {2721895200 -25200 1 PDT}
- {2740035600 -28800 0 PST}
- {2753344800 -25200 1 PDT}
- {2771485200 -28800 0 PST}
- {2785399200 -25200 1 PDT}
- {2802934800 -28800 0 PST}
- {2816848800 -25200 1 PDT}
- {2834384400 -28800 0 PST}
- {2848298400 -25200 1 PDT}
- {2866438800 -28800 0 PST}
- {2879748000 -25200 1 PDT}
- {2897888400 -28800 0 PST}
- {2911197600 -25200 1 PDT}
- {2929338000 -28800 0 PST}
- {2942647200 -25200 1 PDT}
- {2960787600 -28800 0 PST}
- {2974701600 -25200 1 PDT}
- {2992237200 -28800 0 PST}
- {3006151200 -25200 1 PDT}
- {3023686800 -28800 0 PST}
- {3037600800 -25200 1 PDT}
- {3055741200 -28800 0 PST}
- {3069050400 -25200 1 PDT}
- {3087190800 -28800 0 PST}
- {3100500000 -25200 1 PDT}
- {3118640400 -28800 0 PST}
- {3132554400 -25200 1 PDT}
- {3150090000 -28800 0 PST}
- {3164004000 -25200 1 PDT}
- {3181539600 -28800 0 PST}
- {3195453600 -25200 1 PDT}
- {3212989200 -28800 0 PST}
- {3226903200 -25200 1 PDT}
- {3245043600 -28800 0 PST}
- {3258352800 -25200 1 PDT}
- {3276493200 -28800 0 PST}
- {3289802400 -25200 1 PDT}
- {3307942800 -28800 0 PST}
- {3321856800 -25200 1 PDT}
- {3339392400 -28800 0 PST}
- {3353306400 -25200 1 PDT}
- {3370842000 -28800 0 PST}
- {3384756000 -25200 1 PDT}
- {3402896400 -28800 0 PST}
- {3416205600 -25200 1 PDT}
- {3434346000 -28800 0 PST}
- {3447655200 -25200 1 PDT}
- {3465795600 -28800 0 PST}
- {3479709600 -25200 1 PDT}
- {3497245200 -28800 0 PST}
- {3511159200 -25200 1 PDT}
- {3528694800 -28800 0 PST}
- {3542608800 -25200 1 PDT}
- {3560144400 -28800 0 PST}
- {3574058400 -25200 1 PDT}
- {3592198800 -28800 0 PST}
- {3605508000 -25200 1 PDT}
- {3623648400 -28800 0 PST}
- {3636957600 -25200 1 PDT}
- {3655098000 -28800 0 PST}
- {3669012000 -25200 1 PDT}
- {3686547600 -28800 0 PST}
- {3700461600 -25200 1 PDT}
- {3717997200 -28800 0 PST}
- {3731911200 -25200 1 PDT}
- {3750051600 -28800 0 PST}
- {3763360800 -25200 1 PDT}
- {3781501200 -28800 0 PST}
- {3794810400 -25200 1 PDT}
- {3812950800 -28800 0 PST}
- {3826260000 -25200 1 PDT}
- {3844400400 -28800 0 PST}
- {3858314400 -25200 1 PDT}
- {3875850000 -28800 0 PST}
- {3889764000 -25200 1 PDT}
- {3907299600 -28800 0 PST}
- {3921213600 -25200 1 PDT}
- {3939354000 -28800 0 PST}
- {3952663200 -25200 1 PDT}
- {3970803600 -28800 0 PST}
- {3984112800 -25200 1 PDT}
- {4002253200 -28800 0 PST}
- {4016167200 -25200 1 PDT}
- {4033702800 -28800 0 PST}
- {4047616800 -25200 1 PDT}
- {4065152400 -28800 0 PST}
- {4079066400 -25200 1 PDT}
- {4096602000 -28800 0 PST}
+ {1173607200 -25200 1 PDT}
+ {1194166800 -28800 0 PST}
+ {1205056800 -25200 1 PDT}
+ {1225616400 -28800 0 PST}
+ {1236506400 -25200 1 PDT}
+ {1257066000 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
diff --git a/library/tzdata/America/Louisville b/library/tzdata/America/Louisville
index 2b430e4..c5a3e1c 100644
--- a/library/tzdata/America/Louisville
+++ b/library/tzdata/America/Louisville
@@ -1,314 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Louisville) {
- {-9223372036854775808 -20582 0 LMT}
- {-2717647200 -21600 0 CST}
- {-1633276800 -18000 1 CDT}
- {-1615136400 -21600 0 CST}
- {-1601827200 -18000 1 CDT}
- {-1583686800 -21600 0 CST}
- {-1546279200 -21600 0 CST}
- {-1535904000 -18000 1 CDT}
- {-1525280400 -21600 0 CST}
- {-905097600 -18000 1 CDT}
- {-891795600 -21600 0 CST}
- {-883591200 -21600 0 CST}
- {-880214400 -18000 1 CWT}
- {-769395600 -18000 1 CPT}
- {-765392400 -21600 0 CST}
- {-757360800 -21600 0 CST}
- {-747244800 -18000 1 CDT}
- {-744224400 -21600 0 CST}
- {-715795200 -18000 1 CDT}
- {-684349200 -18000 1 CDT}
- {-652899600 -18000 1 CDT}
- {-620845200 -18000 1 CDT}
- {-608144400 -21600 0 CST}
- {-589392000 -18000 1 CDT}
- {-576090000 -21600 0 CST}
- {-557942400 -18000 1 CDT}
- {-544640400 -21600 0 CST}
- {-526492800 -18000 1 CDT}
- {-513190800 -21600 0 CST}
- {-495043200 -18000 1 CDT}
- {-481741200 -21600 0 CST}
- {-463593600 -18000 1 CDT}
- {-450291600 -21600 0 CST}
- {-431539200 -18000 1 CDT}
- {-415818000 -21600 0 CST}
- {-400089600 -18000 1 CDT}
- {-384368400 -21600 0 CST}
- {-368640000 -18000 1 CDT}
- {-352918800 -21600 0 CST}
- {-337190400 -18000 1 CDT}
- {-321469200 -21600 0 CST}
- {-305740800 -18000 1 CDT}
- {-289414800 -21600 0 CST}
- {-273686400 -18000 1 CDT}
- {-266432400 -18000 0 EST}
- {-63140400 -18000 0 EST}
- {-52938000 -14400 1 EDT}
- {-37216800 -18000 0 EST}
- {-21488400 -14400 1 EDT}
- {-5767200 -18000 0 EST}
- {9961200 -14400 1 EDT}
- {25682400 -18000 0 EST}
- {41410800 -14400 1 EDT}
- {57736800 -18000 0 EST}
- {73465200 -14400 1 EDT}
- {89186400 -18000 0 EST}
- {104914800 -14400 1 EDT}
- {120636000 -18000 0 EST}
- {126687600 -18000 1 CDT}
- {152089200 -18000 0 EST}
- {162370800 -14400 1 EDT}
- {183535200 -18000 0 EST}
- {199263600 -14400 1 EDT}
- {215589600 -18000 0 EST}
- {230713200 -14400 1 EDT}
- {247039200 -18000 0 EST}
- {262767600 -14400 1 EDT}
- {278488800 -18000 0 EST}
- {294217200 -14400 1 EDT}
- {309938400 -18000 0 EST}
- {325666800 -14400 1 EDT}
- {341388000 -18000 0 EST}
- {357116400 -14400 1 EDT}
- {372837600 -18000 0 EST}
- {388566000 -14400 1 EDT}
- {404892000 -18000 0 EST}
- {420015600 -14400 1 EDT}
- {436341600 -18000 0 EST}
- {452070000 -14400 1 EDT}
- {467791200 -18000 0 EST}
- {483519600 -14400 1 EDT}
- {499240800 -18000 0 EST}
- {514969200 -14400 1 EDT}
- {530690400 -18000 0 EST}
- {544604400 -14400 1 EDT}
- {562140000 -18000 0 EST}
- {576054000 -14400 1 EDT}
- {594194400 -18000 0 EST}
- {607503600 -14400 1 EDT}
- {625644000 -18000 0 EST}
- {638953200 -14400 1 EDT}
- {657093600 -18000 0 EST}
- {671007600 -14400 1 EDT}
- {688543200 -18000 0 EST}
- {702457200 -14400 1 EDT}
- {719992800 -18000 0 EST}
- {733906800 -14400 1 EDT}
- {752047200 -18000 0 EST}
- {765356400 -14400 1 EDT}
- {783496800 -18000 0 EST}
- {796806000 -14400 1 EDT}
- {814946400 -18000 0 EST}
- {828860400 -14400 1 EDT}
- {846396000 -18000 0 EST}
- {860310000 -14400 1 EDT}
- {877845600 -18000 0 EST}
- {891759600 -14400 1 EDT}
- {909295200 -18000 0 EST}
- {923209200 -14400 1 EDT}
- {941349600 -18000 0 EST}
- {954658800 -14400 1 EDT}
- {972799200 -18000 0 EST}
- {986108400 -14400 1 EDT}
- {1004248800 -18000 0 EST}
- {1018162800 -14400 1 EDT}
- {1035698400 -18000 0 EST}
- {1049612400 -14400 1 EDT}
- {1067148000 -18000 0 EST}
- {1081062000 -14400 1 EDT}
- {1099202400 -18000 0 EST}
- {1112511600 -14400 1 EDT}
- {1130652000 -18000 0 EST}
- {1143961200 -14400 1 EDT}
- {1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Kentucky/Louisville)]} {
+ LoadTimeZoneFile America/Kentucky/Louisville
}
+set TZData(:America/Louisville) $TZData(:America/Kentucky/Louisville)
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/Maceio b/library/tzdata/America/Maceio
index 248dff5..333b878 100644
--- a/library/tzdata/America/Maceio
+++ b/library/tzdata/America/Maceio
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Maceio) {
{-9223372036854775808 -8572 0 LMT}
diff --git a/library/tzdata/America/Managua b/library/tzdata/America/Managua
index ad066d1..f729b8a 100644
--- a/library/tzdata/America/Managua
+++ b/library/tzdata/America/Managua
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Managua) {
{-9223372036854775808 -20708 0 LMT}
@@ -10,10 +10,12 @@ set TZData(:America/Managua) {
{299134800 -21600 0 CST}
{322034400 -18000 1 CDT}
{330584400 -21600 0 CST}
- {694260000 -18000 1 CDT}
+ {694260000 -18000 0 EST}
{717310800 -21600 0 CST}
- {725882400 -18000 0 EST}
- {912488400 -21600 0 CST}
+ {725868000 -18000 0 EST}
+ {852094800 -21600 0 CST}
{1113112800 -18000 1 CDT}
- {1126414800 -21600 0 CST}
+ {1128229200 -21600 0 CST}
+ {1146384000 -18000 1 CDT}
+ {1159682400 -21600 0 CST}
}
diff --git a/library/tzdata/America/Manaus b/library/tzdata/America/Manaus
index ebc4783..058e0f7 100644
--- a/library/tzdata/America/Manaus
+++ b/library/tzdata/America/Manaus
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Manaus) {
{-9223372036854775808 -14404 0 LMT}
diff --git a/library/tzdata/America/Marigot b/library/tzdata/America/Marigot
new file mode 100644
index 0000000..c2b3873
--- /dev/null
+++ b/library/tzdata/America/Marigot
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
+}
+set TZData(:America/Marigot) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Martinique b/library/tzdata/America/Martinique
index 59d901b..1f1b491 100644
--- a/library/tzdata/America/Martinique
+++ b/library/tzdata/America/Martinique
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Martinique) {
{-9223372036854775808 -14660 0 LMT}
diff --git a/library/tzdata/America/Matamoros b/library/tzdata/America/Matamoros
new file mode 100644
index 0000000..2b98652
--- /dev/null
+++ b/library/tzdata/America/Matamoros
@@ -0,0 +1,219 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Matamoros) {
+ {-9223372036854775808 -24000 0 LMT}
+ {-1514743200 -21600 0 CST}
+ {568015200 -21600 0 CST}
+ {576057600 -18000 1 CDT}
+ {594198000 -21600 0 CST}
+ {599637600 -21600 0 CST}
+ {828864000 -18000 1 CDT}
+ {846399600 -21600 0 CST}
+ {860313600 -18000 1 CDT}
+ {877849200 -21600 0 CST}
+ {891763200 -18000 1 CDT}
+ {909298800 -21600 0 CST}
+ {923212800 -18000 1 CDT}
+ {941353200 -21600 0 CST}
+ {954662400 -18000 1 CDT}
+ {972802800 -21600 0 CST}
+ {989136000 -18000 1 CDT}
+ {1001833200 -21600 0 CST}
+ {1018166400 -18000 1 CDT}
+ {1035702000 -21600 0 CST}
+ {1049616000 -18000 1 CDT}
+ {1067151600 -21600 0 CST}
+ {1081065600 -18000 1 CDT}
+ {1099206000 -21600 0 CST}
+ {1112515200 -18000 1 CDT}
+ {1130655600 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1175414400 -18000 1 CDT}
+ {1193554800 -21600 0 CST}
+ {1207468800 -18000 1 CDT}
+ {1225004400 -21600 0 CST}
+ {1238918400 -18000 1 CDT}
+ {1256454000 -21600 0 CST}
+ {1262325600 -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/Mazatlan b/library/tzdata/America/Mazatlan
index 0a23ce8..e56d7d0 100644
--- a/library/tzdata/America/Mazatlan
+++ b/library/tzdata/America/Mazatlan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Mazatlan) {
{-9223372036854775808 -25540 0 LMT}
diff --git a/library/tzdata/America/Mendoza b/library/tzdata/America/Mendoza
index bc65496..511d83e 100644
--- a/library/tzdata/America/Mendoza
+++ b/library/tzdata/America/Mendoza
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Mendoza)]} {
LoadTimeZoneFile America/Argentina/Mendoza
}
diff --git a/library/tzdata/America/Menominee b/library/tzdata/America/Menominee
index 4dc5360..382aeda 100644
--- a/library/tzdata/America/Menominee
+++ b/library/tzdata/America/Menominee
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Menominee) {
{-9223372036854775808 -21027 0 LMT}
@@ -85,190 +85,190 @@ set TZData(:America/Menominee) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162105200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193554800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1225004400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256454000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288508400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319958000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351407600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382857200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414306800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445756400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477810800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509260400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540710000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572159600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603609200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635663600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667113200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698562800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1730012400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761462000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792911600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824966000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856415600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887865200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919314800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950764400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982818800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014268400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045718000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077167600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108617200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140066800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172121200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203570800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235020400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266470000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297919600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329369200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361423600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392873200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424322800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455772400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487222000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519276400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550726000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582175600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613625200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645074800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676524400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708578800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740028400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771478000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802927600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834377200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866431600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897881200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929330800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960780400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992230000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023679600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055734000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087183600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118633200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150082800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181532400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212982000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245036400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276486000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307935600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339385200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370834800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402889200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434338800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465788400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497238000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528687600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560137200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592191600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623641200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655090800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686540400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717990000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750044400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781494000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812943600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844393200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875842800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907292400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939346800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970796400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002246000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033695600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065145200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096594800 -21600 0 CST}
+ {1173600000 -18000 1 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/Merida b/library/tzdata/America/Merida
index a6dcbe7..ebf5927 100644
--- a/library/tzdata/America/Merida
+++ b/library/tzdata/America/Merida
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Merida) {
{-9223372036854775808 -21508 0 LMT}
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/Mexico_City b/library/tzdata/America/Mexico_City
index e0a2016..48462e4 100644
--- a/library/tzdata/America/Mexico_City
+++ b/library/tzdata/America/Mexico_City
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Mexico_City) {
{-9223372036854775808 -23796 0 LMT}
diff --git a/library/tzdata/America/Miquelon b/library/tzdata/America/Miquelon
index 8180d11..a7410f1 100644
--- a/library/tzdata/America/Miquelon
+++ b/library/tzdata/America/Miquelon
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Miquelon) {
{-9223372036854775808 -13480 0 LMT}
@@ -45,190 +45,190 @@ set TZData(:America/Miquelon) {
{1130644800 -10800 0 PMST}
{1143954000 -7200 1 PMDT}
{1162094400 -10800 0 PMST}
- {1175403600 -7200 1 PMDT}
- {1193544000 -10800 0 PMST}
- {1207458000 -7200 1 PMDT}
- {1224993600 -10800 0 PMST}
- {1238907600 -7200 1 PMDT}
- {1256443200 -10800 0 PMST}
- {1270357200 -7200 1 PMDT}
- {1288497600 -10800 0 PMST}
- {1301806800 -7200 1 PMDT}
- {1319947200 -10800 0 PMST}
- {1333256400 -7200 1 PMDT}
- {1351396800 -10800 0 PMST}
- {1365310800 -7200 1 PMDT}
- {1382846400 -10800 0 PMST}
- {1396760400 -7200 1 PMDT}
- {1414296000 -10800 0 PMST}
- {1428210000 -7200 1 PMDT}
- {1445745600 -10800 0 PMST}
- {1459659600 -7200 1 PMDT}
- {1477800000 -10800 0 PMST}
- {1491109200 -7200 1 PMDT}
- {1509249600 -10800 0 PMST}
- {1522558800 -7200 1 PMDT}
- {1540699200 -10800 0 PMST}
- {1554613200 -7200 1 PMDT}
- {1572148800 -10800 0 PMST}
- {1586062800 -7200 1 PMDT}
- {1603598400 -10800 0 PMST}
- {1617512400 -7200 1 PMDT}
- {1635652800 -10800 0 PMST}
- {1648962000 -7200 1 PMDT}
- {1667102400 -10800 0 PMST}
- {1680411600 -7200 1 PMDT}
- {1698552000 -10800 0 PMST}
- {1712466000 -7200 1 PMDT}
- {1730001600 -10800 0 PMST}
- {1743915600 -7200 1 PMDT}
- {1761451200 -10800 0 PMST}
- {1775365200 -7200 1 PMDT}
- {1792900800 -10800 0 PMST}
- {1806814800 -7200 1 PMDT}
- {1824955200 -10800 0 PMST}
- {1838264400 -7200 1 PMDT}
- {1856404800 -10800 0 PMST}
- {1869714000 -7200 1 PMDT}
- {1887854400 -10800 0 PMST}
- {1901768400 -7200 1 PMDT}
- {1919304000 -10800 0 PMST}
- {1933218000 -7200 1 PMDT}
- {1950753600 -10800 0 PMST}
- {1964667600 -7200 1 PMDT}
- {1982808000 -10800 0 PMST}
- {1996117200 -7200 1 PMDT}
- {2014257600 -10800 0 PMST}
- {2027566800 -7200 1 PMDT}
- {2045707200 -10800 0 PMST}
- {2059016400 -7200 1 PMDT}
- {2077156800 -10800 0 PMST}
- {2091070800 -7200 1 PMDT}
- {2108606400 -10800 0 PMST}
- {2122520400 -7200 1 PMDT}
- {2140056000 -10800 0 PMST}
- {2153970000 -7200 1 PMDT}
- {2172110400 -10800 0 PMST}
- {2185419600 -7200 1 PMDT}
- {2203560000 -10800 0 PMST}
- {2216869200 -7200 1 PMDT}
- {2235009600 -10800 0 PMST}
- {2248923600 -7200 1 PMDT}
- {2266459200 -10800 0 PMST}
- {2280373200 -7200 1 PMDT}
- {2297908800 -10800 0 PMST}
- {2311822800 -7200 1 PMDT}
- {2329358400 -10800 0 PMST}
- {2343272400 -7200 1 PMDT}
- {2361412800 -10800 0 PMST}
- {2374722000 -7200 1 PMDT}
- {2392862400 -10800 0 PMST}
- {2406171600 -7200 1 PMDT}
- {2424312000 -10800 0 PMST}
- {2438226000 -7200 1 PMDT}
- {2455761600 -10800 0 PMST}
- {2469675600 -7200 1 PMDT}
- {2487211200 -10800 0 PMST}
- {2501125200 -7200 1 PMDT}
- {2519265600 -10800 0 PMST}
- {2532574800 -7200 1 PMDT}
- {2550715200 -10800 0 PMST}
- {2564024400 -7200 1 PMDT}
- {2582164800 -10800 0 PMST}
- {2596078800 -7200 1 PMDT}
- {2613614400 -10800 0 PMST}
- {2627528400 -7200 1 PMDT}
- {2645064000 -10800 0 PMST}
- {2658978000 -7200 1 PMDT}
- {2676513600 -10800 0 PMST}
- {2690427600 -7200 1 PMDT}
- {2708568000 -10800 0 PMST}
- {2721877200 -7200 1 PMDT}
- {2740017600 -10800 0 PMST}
- {2753326800 -7200 1 PMDT}
- {2771467200 -10800 0 PMST}
- {2785381200 -7200 1 PMDT}
- {2802916800 -10800 0 PMST}
- {2816830800 -7200 1 PMDT}
- {2834366400 -10800 0 PMST}
- {2848280400 -7200 1 PMDT}
- {2866420800 -10800 0 PMST}
- {2879730000 -7200 1 PMDT}
- {2897870400 -10800 0 PMST}
- {2911179600 -7200 1 PMDT}
- {2929320000 -10800 0 PMST}
- {2942629200 -7200 1 PMDT}
- {2960769600 -10800 0 PMST}
- {2974683600 -7200 1 PMDT}
- {2992219200 -10800 0 PMST}
- {3006133200 -7200 1 PMDT}
- {3023668800 -10800 0 PMST}
- {3037582800 -7200 1 PMDT}
- {3055723200 -10800 0 PMST}
- {3069032400 -7200 1 PMDT}
- {3087172800 -10800 0 PMST}
- {3100482000 -7200 1 PMDT}
- {3118622400 -10800 0 PMST}
- {3132536400 -7200 1 PMDT}
- {3150072000 -10800 0 PMST}
- {3163986000 -7200 1 PMDT}
- {3181521600 -10800 0 PMST}
- {3195435600 -7200 1 PMDT}
- {3212971200 -10800 0 PMST}
- {3226885200 -7200 1 PMDT}
- {3245025600 -10800 0 PMST}
- {3258334800 -7200 1 PMDT}
- {3276475200 -10800 0 PMST}
- {3289784400 -7200 1 PMDT}
- {3307924800 -10800 0 PMST}
- {3321838800 -7200 1 PMDT}
- {3339374400 -10800 0 PMST}
- {3353288400 -7200 1 PMDT}
- {3370824000 -10800 0 PMST}
- {3384738000 -7200 1 PMDT}
- {3402878400 -10800 0 PMST}
- {3416187600 -7200 1 PMDT}
- {3434328000 -10800 0 PMST}
- {3447637200 -7200 1 PMDT}
- {3465777600 -10800 0 PMST}
- {3479691600 -7200 1 PMDT}
- {3497227200 -10800 0 PMST}
- {3511141200 -7200 1 PMDT}
- {3528676800 -10800 0 PMST}
- {3542590800 -7200 1 PMDT}
- {3560126400 -10800 0 PMST}
- {3574040400 -7200 1 PMDT}
- {3592180800 -10800 0 PMST}
- {3605490000 -7200 1 PMDT}
- {3623630400 -10800 0 PMST}
- {3636939600 -7200 1 PMDT}
- {3655080000 -10800 0 PMST}
- {3668994000 -7200 1 PMDT}
- {3686529600 -10800 0 PMST}
- {3700443600 -7200 1 PMDT}
- {3717979200 -10800 0 PMST}
- {3731893200 -7200 1 PMDT}
- {3750033600 -10800 0 PMST}
- {3763342800 -7200 1 PMDT}
- {3781483200 -10800 0 PMST}
- {3794792400 -7200 1 PMDT}
- {3812932800 -10800 0 PMST}
- {3826242000 -7200 1 PMDT}
- {3844382400 -10800 0 PMST}
- {3858296400 -7200 1 PMDT}
- {3875832000 -10800 0 PMST}
- {3889746000 -7200 1 PMDT}
- {3907281600 -10800 0 PMST}
- {3921195600 -7200 1 PMDT}
- {3939336000 -10800 0 PMST}
- {3952645200 -7200 1 PMDT}
- {3970785600 -10800 0 PMST}
- {3984094800 -7200 1 PMDT}
- {4002235200 -10800 0 PMST}
- {4016149200 -7200 1 PMDT}
- {4033684800 -10800 0 PMST}
- {4047598800 -7200 1 PMDT}
- {4065134400 -10800 0 PMST}
- {4079048400 -7200 1 PMDT}
- {4096584000 -10800 0 PMST}
+ {1173589200 -7200 1 PMDT}
+ {1194148800 -10800 0 PMST}
+ {1205038800 -7200 1 PMDT}
+ {1225598400 -10800 0 PMST}
+ {1236488400 -7200 1 PMDT}
+ {1257048000 -10800 0 PMST}
+ {1268542800 -7200 1 PMDT}
+ {1289102400 -10800 0 PMST}
+ {1299992400 -7200 1 PMDT}
+ {1320552000 -10800 0 PMST}
+ {1331442000 -7200 1 PMDT}
+ {1352001600 -10800 0 PMST}
+ {1362891600 -7200 1 PMDT}
+ {1383451200 -10800 0 PMST}
+ {1394341200 -7200 1 PMDT}
+ {1414900800 -10800 0 PMST}
+ {1425790800 -7200 1 PMDT}
+ {1446350400 -10800 0 PMST}
+ {1457845200 -7200 1 PMDT}
+ {1478404800 -10800 0 PMST}
+ {1489294800 -7200 1 PMDT}
+ {1509854400 -10800 0 PMST}
+ {1520744400 -7200 1 PMDT}
+ {1541304000 -10800 0 PMST}
+ {1552194000 -7200 1 PMDT}
+ {1572753600 -10800 0 PMST}
+ {1583643600 -7200 1 PMDT}
+ {1604203200 -10800 0 PMST}
+ {1615698000 -7200 1 PMDT}
+ {1636257600 -10800 0 PMST}
+ {1647147600 -7200 1 PMDT}
+ {1667707200 -10800 0 PMST}
+ {1678597200 -7200 1 PMDT}
+ {1699156800 -10800 0 PMST}
+ {1710046800 -7200 1 PMDT}
+ {1730606400 -10800 0 PMST}
+ {1741496400 -7200 1 PMDT}
+ {1762056000 -10800 0 PMST}
+ {1772946000 -7200 1 PMDT}
+ {1793505600 -10800 0 PMST}
+ {1805000400 -7200 1 PMDT}
+ {1825560000 -10800 0 PMST}
+ {1836450000 -7200 1 PMDT}
+ {1857009600 -10800 0 PMST}
+ {1867899600 -7200 1 PMDT}
+ {1888459200 -10800 0 PMST}
+ {1899349200 -7200 1 PMDT}
+ {1919908800 -10800 0 PMST}
+ {1930798800 -7200 1 PMDT}
+ {1951358400 -10800 0 PMST}
+ {1962853200 -7200 1 PMDT}
+ {1983412800 -10800 0 PMST}
+ {1994302800 -7200 1 PMDT}
+ {2014862400 -10800 0 PMST}
+ {2025752400 -7200 1 PMDT}
+ {2046312000 -10800 0 PMST}
+ {2057202000 -7200 1 PMDT}
+ {2077761600 -10800 0 PMST}
+ {2088651600 -7200 1 PMDT}
+ {2109211200 -10800 0 PMST}
+ {2120101200 -7200 1 PMDT}
+ {2140660800 -10800 0 PMST}
+ {2152155600 -7200 1 PMDT}
+ {2172715200 -10800 0 PMST}
+ {2183605200 -7200 1 PMDT}
+ {2204164800 -10800 0 PMST}
+ {2215054800 -7200 1 PMDT}
+ {2235614400 -10800 0 PMST}
+ {2246504400 -7200 1 PMDT}
+ {2267064000 -10800 0 PMST}
+ {2277954000 -7200 1 PMDT}
+ {2298513600 -10800 0 PMST}
+ {2309403600 -7200 1 PMDT}
+ {2329963200 -10800 0 PMST}
+ {2341458000 -7200 1 PMDT}
+ {2362017600 -10800 0 PMST}
+ {2372907600 -7200 1 PMDT}
+ {2393467200 -10800 0 PMST}
+ {2404357200 -7200 1 PMDT}
+ {2424916800 -10800 0 PMST}
+ {2435806800 -7200 1 PMDT}
+ {2456366400 -10800 0 PMST}
+ {2467256400 -7200 1 PMDT}
+ {2487816000 -10800 0 PMST}
+ {2499310800 -7200 1 PMDT}
+ {2519870400 -10800 0 PMST}
+ {2530760400 -7200 1 PMDT}
+ {2551320000 -10800 0 PMST}
+ {2562210000 -7200 1 PMDT}
+ {2582769600 -10800 0 PMST}
+ {2593659600 -7200 1 PMDT}
+ {2614219200 -10800 0 PMST}
+ {2625109200 -7200 1 PMDT}
+ {2645668800 -10800 0 PMST}
+ {2656558800 -7200 1 PMDT}
+ {2677118400 -10800 0 PMST}
+ {2688613200 -7200 1 PMDT}
+ {2709172800 -10800 0 PMST}
+ {2720062800 -7200 1 PMDT}
+ {2740622400 -10800 0 PMST}
+ {2751512400 -7200 1 PMDT}
+ {2772072000 -10800 0 PMST}
+ {2782962000 -7200 1 PMDT}
+ {2803521600 -10800 0 PMST}
+ {2814411600 -7200 1 PMDT}
+ {2834971200 -10800 0 PMST}
+ {2846466000 -7200 1 PMDT}
+ {2867025600 -10800 0 PMST}
+ {2877915600 -7200 1 PMDT}
+ {2898475200 -10800 0 PMST}
+ {2909365200 -7200 1 PMDT}
+ {2929924800 -10800 0 PMST}
+ {2940814800 -7200 1 PMDT}
+ {2961374400 -10800 0 PMST}
+ {2972264400 -7200 1 PMDT}
+ {2992824000 -10800 0 PMST}
+ {3003714000 -7200 1 PMDT}
+ {3024273600 -10800 0 PMST}
+ {3035768400 -7200 1 PMDT}
+ {3056328000 -10800 0 PMST}
+ {3067218000 -7200 1 PMDT}
+ {3087777600 -10800 0 PMST}
+ {3098667600 -7200 1 PMDT}
+ {3119227200 -10800 0 PMST}
+ {3130117200 -7200 1 PMDT}
+ {3150676800 -10800 0 PMST}
+ {3161566800 -7200 1 PMDT}
+ {3182126400 -10800 0 PMST}
+ {3193016400 -7200 1 PMDT}
+ {3213576000 -10800 0 PMST}
+ {3225070800 -7200 1 PMDT}
+ {3245630400 -10800 0 PMST}
+ {3256520400 -7200 1 PMDT}
+ {3277080000 -10800 0 PMST}
+ {3287970000 -7200 1 PMDT}
+ {3308529600 -10800 0 PMST}
+ {3319419600 -7200 1 PMDT}
+ {3339979200 -10800 0 PMST}
+ {3350869200 -7200 1 PMDT}
+ {3371428800 -10800 0 PMST}
+ {3382923600 -7200 1 PMDT}
+ {3403483200 -10800 0 PMST}
+ {3414373200 -7200 1 PMDT}
+ {3434932800 -10800 0 PMST}
+ {3445822800 -7200 1 PMDT}
+ {3466382400 -10800 0 PMST}
+ {3477272400 -7200 1 PMDT}
+ {3497832000 -10800 0 PMST}
+ {3508722000 -7200 1 PMDT}
+ {3529281600 -10800 0 PMST}
+ {3540171600 -7200 1 PMDT}
+ {3560731200 -10800 0 PMST}
+ {3572226000 -7200 1 PMDT}
+ {3592785600 -10800 0 PMST}
+ {3603675600 -7200 1 PMDT}
+ {3624235200 -10800 0 PMST}
+ {3635125200 -7200 1 PMDT}
+ {3655684800 -10800 0 PMST}
+ {3666574800 -7200 1 PMDT}
+ {3687134400 -10800 0 PMST}
+ {3698024400 -7200 1 PMDT}
+ {3718584000 -10800 0 PMST}
+ {3730078800 -7200 1 PMDT}
+ {3750638400 -10800 0 PMST}
+ {3761528400 -7200 1 PMDT}
+ {3782088000 -10800 0 PMST}
+ {3792978000 -7200 1 PMDT}
+ {3813537600 -10800 0 PMST}
+ {3824427600 -7200 1 PMDT}
+ {3844987200 -10800 0 PMST}
+ {3855877200 -7200 1 PMDT}
+ {3876436800 -10800 0 PMST}
+ {3887326800 -7200 1 PMDT}
+ {3907886400 -10800 0 PMST}
+ {3919381200 -7200 1 PMDT}
+ {3939940800 -10800 0 PMST}
+ {3950830800 -7200 1 PMDT}
+ {3971390400 -10800 0 PMST}
+ {3982280400 -7200 1 PMDT}
+ {4002840000 -10800 0 PMST}
+ {4013730000 -7200 1 PMDT}
+ {4034289600 -10800 0 PMST}
+ {4045179600 -7200 1 PMDT}
+ {4065739200 -10800 0 PMST}
+ {4076629200 -7200 1 PMDT}
+ {4097188800 -10800 0 PMST}
}
diff --git a/library/tzdata/America/Moncton b/library/tzdata/America/Moncton
new file mode 100644
index 0000000..d286c88
--- /dev/null
+++ b/library/tzdata/America/Moncton
@@ -0,0 +1,342 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Moncton) {
+ {-9223372036854775808 -15548 0 LMT}
+ {-2715882052 -18000 0 EST}
+ {-2131642800 -14400 0 AST}
+ {-1632074400 -10800 1 ADT}
+ {-1615143600 -14400 0 AST}
+ {-1167595200 -14400 0 AST}
+ {-1153681200 -10800 1 ADT}
+ {-1145822400 -14400 0 AST}
+ {-1122231600 -10800 1 ADT}
+ {-1114372800 -14400 0 AST}
+ {-1090782000 -10800 1 ADT}
+ {-1082923200 -14400 0 AST}
+ {-1059332400 -10800 1 ADT}
+ {-1051473600 -14400 0 AST}
+ {-1027882800 -10800 1 ADT}
+ {-1020024000 -14400 0 AST}
+ {-996433200 -10800 1 ADT}
+ {-988574400 -14400 0 AST}
+ {-965674800 -10800 1 ADT}
+ {-955396800 -14400 0 AST}
+ {-934743600 -10800 1 ADT}
+ {-923947200 -14400 0 AST}
+ {-904503600 -10800 1 ADT}
+ {-891892800 -14400 0 AST}
+ {-883598400 -14400 0 AST}
+ {-880221600 -10800 1 AWT}
+ {-769395600 -10800 1 APT}
+ {-765399600 -14400 0 AST}
+ {-757368000 -14400 0 AST}
+ {-747252000 -10800 1 ADT}
+ {-733950000 -14400 0 AST}
+ {-715802400 -10800 1 ADT}
+ {-702500400 -14400 0 AST}
+ {-684352800 -10800 1 ADT}
+ {-671050800 -14400 0 AST}
+ {-652903200 -10800 1 ADT}
+ {-639601200 -14400 0 AST}
+ {-620848800 -10800 1 ADT}
+ {-608151600 -14400 0 AST}
+ {-589399200 -10800 1 ADT}
+ {-576097200 -14400 0 AST}
+ {-557949600 -10800 1 ADT}
+ {-544647600 -14400 0 AST}
+ {-526500000 -10800 1 ADT}
+ {-513198000 -14400 0 AST}
+ {-495050400 -10800 1 ADT}
+ {-481748400 -14400 0 AST}
+ {-463600800 -10800 1 ADT}
+ {-450298800 -14400 0 AST}
+ {-431546400 -10800 1 ADT}
+ {-418244400 -14400 0 AST}
+ {-400096800 -10800 1 ADT}
+ {-384375600 -14400 0 AST}
+ {-368647200 -10800 1 ADT}
+ {-352926000 -14400 0 AST}
+ {-337197600 -10800 1 ADT}
+ {-321476400 -14400 0 AST}
+ {-305748000 -10800 1 ADT}
+ {-289422000 -14400 0 AST}
+ {-273693600 -10800 1 ADT}
+ {-257972400 -14400 0 AST}
+ {-242244000 -10800 1 ADT}
+ {-226522800 -14400 0 AST}
+ {-210794400 -10800 1 ADT}
+ {-195073200 -14400 0 AST}
+ {-179344800 -10800 1 ADT}
+ {-163623600 -14400 0 AST}
+ {-147895200 -10800 1 ADT}
+ {-131569200 -14400 0 AST}
+ {-116445600 -10800 1 ADT}
+ {-100119600 -14400 0 AST}
+ {-84391200 -10800 1 ADT}
+ {-68670000 -14400 0 AST}
+ {-52941600 -10800 1 ADT}
+ {-37220400 -14400 0 AST}
+ {-21492000 -10800 1 ADT}
+ {-5770800 -14400 0 AST}
+ {9957600 -10800 1 ADT}
+ {25678800 -14400 0 AST}
+ {41407200 -10800 1 ADT}
+ {57733200 -14400 0 AST}
+ {73461600 -10800 1 ADT}
+ {89182800 -14400 0 AST}
+ {94708800 -14400 0 AST}
+ {136360800 -10800 1 ADT}
+ {152082000 -14400 0 AST}
+ {167810400 -10800 1 ADT}
+ {183531600 -14400 0 AST}
+ {199260000 -10800 1 ADT}
+ {215586000 -14400 0 AST}
+ {230709600 -10800 1 ADT}
+ {247035600 -14400 0 AST}
+ {262764000 -10800 1 ADT}
+ {278485200 -14400 0 AST}
+ {294213600 -10800 1 ADT}
+ {309934800 -14400 0 AST}
+ {325663200 -10800 1 ADT}
+ {341384400 -14400 0 AST}
+ {357112800 -10800 1 ADT}
+ {372834000 -14400 0 AST}
+ {388562400 -10800 1 ADT}
+ {404888400 -14400 0 AST}
+ {420012000 -10800 1 ADT}
+ {436338000 -14400 0 AST}
+ {452066400 -10800 1 ADT}
+ {467787600 -14400 0 AST}
+ {483516000 -10800 1 ADT}
+ {499237200 -14400 0 AST}
+ {514965600 -10800 1 ADT}
+ {530686800 -14400 0 AST}
+ {544600800 -10800 1 ADT}
+ {562136400 -14400 0 AST}
+ {576050400 -10800 1 ADT}
+ {594190800 -14400 0 AST}
+ {607500000 -10800 1 ADT}
+ {625640400 -14400 0 AST}
+ {638949600 -10800 1 ADT}
+ {657090000 -14400 0 AST}
+ {671004000 -10800 1 ADT}
+ {688539600 -14400 0 AST}
+ {702453600 -10800 1 ADT}
+ {719989200 -14400 0 AST}
+ {725860800 -14400 0 AST}
+ {733896060 -10800 1 ADT}
+ {752036460 -14400 0 AST}
+ {765345660 -10800 1 ADT}
+ {783486060 -14400 0 AST}
+ {796795260 -10800 1 ADT}
+ {814935660 -14400 0 AST}
+ {828849660 -10800 1 ADT}
+ {846385260 -14400 0 AST}
+ {860299260 -10800 1 ADT}
+ {877834860 -14400 0 AST}
+ {891748860 -10800 1 ADT}
+ {909284460 -14400 0 AST}
+ {923198460 -10800 1 ADT}
+ {941338860 -14400 0 AST}
+ {954648060 -10800 1 ADT}
+ {972788460 -14400 0 AST}
+ {986097660 -10800 1 ADT}
+ {1004238060 -14400 0 AST}
+ {1018152060 -10800 1 ADT}
+ {1035687660 -14400 0 AST}
+ {1049601660 -10800 1 ADT}
+ {1067137260 -14400 0 AST}
+ {1081051260 -10800 1 ADT}
+ {1099191660 -14400 0 AST}
+ {1112500860 -10800 1 ADT}
+ {1130641260 -14400 0 AST}
+ {1143950460 -10800 1 ADT}
+ {1162090860 -14400 0 AST}
+ {1167624000 -14400 0 AST}
+ {1173592800 -10800 1 ADT}
+ {1194152400 -14400 0 AST}
+ {1205042400 -10800 1 ADT}
+ {1225602000 -14400 0 AST}
+ {1236492000 -10800 1 ADT}
+ {1257051600 -14400 0 AST}
+ {1268546400 -10800 1 ADT}
+ {1289106000 -14400 0 AST}
+ {1299996000 -10800 1 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/Monterrey b/library/tzdata/America/Monterrey
index ee2983e..4135884 100644
--- a/library/tzdata/America/Monterrey
+++ b/library/tzdata/America/Monterrey
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Monterrey) {
{-9223372036854775808 -24076 0 LMT}
diff --git a/library/tzdata/America/Montevideo b/library/tzdata/America/Montevideo
index c93aaa3..aa469b9 100644
--- a/library/tzdata/America/Montevideo
+++ b/library/tzdata/America/Montevideo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Montevideo) {
{-9223372036854775808 -13484 0 LMT}
@@ -11,11 +11,11 @@ set TZData(:America/Montevideo) {
{-1396470600 -10800 1 UYHST}
{-1380747600 -12600 0 UYT}
{-1141590600 -10800 1 UYHST}
- {-1128299400 -12600 0 UYT}
+ {-1128286800 -12600 0 UYT}
{-1110141000 -10800 1 UYHST}
- {-1096849800 -12600 0 UYT}
+ {-1096837200 -12600 0 UYT}
{-1078691400 -10800 1 UYHST}
- {-1065400200 -12600 0 UYT}
+ {-1065387600 -12600 0 UYT}
{-1046637000 -10800 1 UYHST}
{-1033938000 -12600 0 UYT}
{-1015187400 -10800 1 UYHST}
@@ -26,8 +26,9 @@ set TZData(:America/Montevideo) {
{-938984400 -12600 0 UYT}
{-920838600 -10800 1 UYHST}
{-907534800 -12600 0 UYT}
- {-896819400 -12600 0 UYT}
- {-853623000 -7200 0 UYST}
+ {-896819400 -10800 1 UYHST}
+ {-853623000 -10800 0 UYT}
+ {-853621200 -7200 1 UYST}
{-845848800 -10800 0 UYT}
{-334789200 -7200 1 UYST}
{-319672800 -10800 0 UYT}
@@ -68,4 +69,193 @@ set TZData(:America/Montevideo) {
{730864800 -10800 0 UYT}
{1095562800 -7200 1 UYST}
{1111896000 -10800 0 UYT}
+ {1128834000 -7200 1 UYST}
+ {1142136000 -10800 0 UYT}
+ {1159678800 -7200 1 UYST}
+ {1173585600 -10800 0 UYT}
+ {1191733200 -7200 1 UYST}
+ {1205035200 -10800 0 UYT}
+ {1223182800 -7200 1 UYST}
+ {1236484800 -10800 0 UYT}
+ {1254632400 -7200 1 UYST}
+ {1268539200 -10800 0 UYT}
+ {1286082000 -7200 1 UYST}
+ {1299988800 -10800 0 UYT}
+ {1317531600 -7200 1 UYST}
+ {1331438400 -10800 0 UYT}
+ {1349586000 -7200 1 UYST}
+ {1362888000 -10800 0 UYT}
+ {1381035600 -7200 1 UYST}
+ {1394337600 -10800 0 UYT}
+ {1412485200 -7200 1 UYST}
+ {1425787200 -10800 0 UYT}
+ {1443934800 -7200 1 UYST}
+ {1457841600 -10800 0 UYT}
+ {1475384400 -7200 1 UYST}
+ {1489291200 -10800 0 UYT}
+ {1506834000 -7200 1 UYST}
+ {1520740800 -10800 0 UYT}
+ {1538888400 -7200 1 UYST}
+ {1552190400 -10800 0 UYT}
+ {1570338000 -7200 1 UYST}
+ {1583640000 -10800 0 UYT}
+ {1601787600 -7200 1 UYST}
+ {1615694400 -10800 0 UYT}
+ {1633237200 -7200 1 UYST}
+ {1647144000 -10800 0 UYT}
+ {1664686800 -7200 1 UYST}
+ {1678593600 -10800 0 UYT}
+ {1696136400 -7200 1 UYST}
+ {1710043200 -10800 0 UYT}
+ {1728190800 -7200 1 UYST}
+ {1741492800 -10800 0 UYT}
+ {1759640400 -7200 1 UYST}
+ {1772942400 -10800 0 UYT}
+ {1791090000 -7200 1 UYST}
+ {1804996800 -10800 0 UYT}
+ {1822539600 -7200 1 UYST}
+ {1836446400 -10800 0 UYT}
+ {1853989200 -7200 1 UYST}
+ {1867896000 -10800 0 UYT}
+ {1886043600 -7200 1 UYST}
+ {1899345600 -10800 0 UYT}
+ {1917493200 -7200 1 UYST}
+ {1930795200 -10800 0 UYT}
+ {1948942800 -7200 1 UYST}
+ {1962849600 -10800 0 UYT}
+ {1980392400 -7200 1 UYST}
+ {1994299200 -10800 0 UYT}
+ {2011842000 -7200 1 UYST}
+ {2025748800 -10800 0 UYT}
+ {2043291600 -7200 1 UYST}
+ {2057198400 -10800 0 UYT}
+ {2075346000 -7200 1 UYST}
+ {2088648000 -10800 0 UYT}
+ {2106795600 -7200 1 UYST}
+ {2120097600 -10800 0 UYT}
+ {2138245200 -7200 1 UYST}
+ {2152152000 -10800 0 UYT}
+ {2169694800 -7200 1 UYST}
+ {2183601600 -10800 0 UYT}
+ {2201144400 -7200 1 UYST}
+ {2215051200 -10800 0 UYT}
+ {2233198800 -7200 1 UYST}
+ {2246500800 -10800 0 UYT}
+ {2264648400 -7200 1 UYST}
+ {2277950400 -10800 0 UYT}
+ {2296098000 -7200 1 UYST}
+ {2309400000 -10800 0 UYT}
+ {2327547600 -7200 1 UYST}
+ {2341454400 -10800 0 UYT}
+ {2358997200 -7200 1 UYST}
+ {2372904000 -10800 0 UYT}
+ {2390446800 -7200 1 UYST}
+ {2404353600 -10800 0 UYT}
+ {2422501200 -7200 1 UYST}
+ {2435803200 -10800 0 UYT}
+ {2453950800 -7200 1 UYST}
+ {2467252800 -10800 0 UYT}
+ {2485400400 -7200 1 UYST}
+ {2499307200 -10800 0 UYT}
+ {2516850000 -7200 1 UYST}
+ {2530756800 -10800 0 UYT}
+ {2548299600 -7200 1 UYST}
+ {2562206400 -10800 0 UYT}
+ {2579749200 -7200 1 UYST}
+ {2593656000 -10800 0 UYT}
+ {2611803600 -7200 1 UYST}
+ {2625105600 -10800 0 UYT}
+ {2643253200 -7200 1 UYST}
+ {2656555200 -10800 0 UYT}
+ {2674702800 -7200 1 UYST}
+ {2688609600 -10800 0 UYT}
+ {2706152400 -7200 1 UYST}
+ {2720059200 -10800 0 UYT}
+ {2737602000 -7200 1 UYST}
+ {2751508800 -10800 0 UYT}
+ {2769656400 -7200 1 UYST}
+ {2782958400 -10800 0 UYT}
+ {2801106000 -7200 1 UYST}
+ {2814408000 -10800 0 UYT}
+ {2832555600 -7200 1 UYST}
+ {2846462400 -10800 0 UYT}
+ {2864005200 -7200 1 UYST}
+ {2877912000 -10800 0 UYT}
+ {2895454800 -7200 1 UYST}
+ {2909361600 -10800 0 UYT}
+ {2926904400 -7200 1 UYST}
+ {2940811200 -10800 0 UYT}
+ {2958958800 -7200 1 UYST}
+ {2972260800 -10800 0 UYT}
+ {2990408400 -7200 1 UYST}
+ {3003710400 -10800 0 UYT}
+ {3021858000 -7200 1 UYST}
+ {3035764800 -10800 0 UYT}
+ {3053307600 -7200 1 UYST}
+ {3067214400 -10800 0 UYT}
+ {3084757200 -7200 1 UYST}
+ {3098664000 -10800 0 UYT}
+ {3116811600 -7200 1 UYST}
+ {3130113600 -10800 0 UYT}
+ {3148261200 -7200 1 UYST}
+ {3161563200 -10800 0 UYT}
+ {3179710800 -7200 1 UYST}
+ {3193012800 -10800 0 UYT}
+ {3211160400 -7200 1 UYST}
+ {3225067200 -10800 0 UYT}
+ {3242610000 -7200 1 UYST}
+ {3256516800 -10800 0 UYT}
+ {3274059600 -7200 1 UYST}
+ {3287966400 -10800 0 UYT}
+ {3306114000 -7200 1 UYST}
+ {3319416000 -10800 0 UYT}
+ {3337563600 -7200 1 UYST}
+ {3350865600 -10800 0 UYT}
+ {3369013200 -7200 1 UYST}
+ {3382920000 -10800 0 UYT}
+ {3400462800 -7200 1 UYST}
+ {3414369600 -10800 0 UYT}
+ {3431912400 -7200 1 UYST}
+ {3445819200 -10800 0 UYT}
+ {3463362000 -7200 1 UYST}
+ {3477268800 -10800 0 UYT}
+ {3495416400 -7200 1 UYST}
+ {3508718400 -10800 0 UYT}
+ {3526866000 -7200 1 UYST}
+ {3540168000 -10800 0 UYT}
+ {3558315600 -7200 1 UYST}
+ {3572222400 -10800 0 UYT}
+ {3589765200 -7200 1 UYST}
+ {3603672000 -10800 0 UYT}
+ {3621214800 -7200 1 UYST}
+ {3635121600 -10800 0 UYT}
+ {3653269200 -7200 1 UYST}
+ {3666571200 -10800 0 UYT}
+ {3684718800 -7200 1 UYST}
+ {3698020800 -10800 0 UYT}
+ {3716168400 -7200 1 UYST}
+ {3730075200 -10800 0 UYT}
+ {3747618000 -7200 1 UYST}
+ {3761524800 -10800 0 UYT}
+ {3779067600 -7200 1 UYST}
+ {3792974400 -10800 0 UYT}
+ {3810517200 -7200 1 UYST}
+ {3824424000 -10800 0 UYT}
+ {3842571600 -7200 1 UYST}
+ {3855873600 -10800 0 UYT}
+ {3874021200 -7200 1 UYST}
+ {3887323200 -10800 0 UYT}
+ {3905470800 -7200 1 UYST}
+ {3919377600 -10800 0 UYT}
+ {3936920400 -7200 1 UYST}
+ {3950827200 -10800 0 UYT}
+ {3968370000 -7200 1 UYST}
+ {3982276800 -10800 0 UYT}
+ {4000424400 -7200 1 UYST}
+ {4013726400 -10800 0 UYT}
+ {4031874000 -7200 1 UYST}
+ {4045176000 -10800 0 UYT}
+ {4063323600 -7200 1 UYST}
+ {4076625600 -10800 0 UYT}
+ {4094773200 -7200 1 UYST}
}
diff --git a/library/tzdata/America/Montreal b/library/tzdata/America/Montreal
index 4ee92a2..bebe7dc 100644
--- a/library/tzdata/America/Montreal
+++ b/library/tzdata/America/Montreal
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Montreal) {
{-9223372036854775808 -17656 0 LMT}
@@ -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}
@@ -50,8 +50,7 @@ set TZData(:America/Montreal) {
{-968007600 -14400 1 EDT}
{-955310400 -18000 0 EST}
{-936558000 -14400 1 EDT}
- {-880236000 -14400 0 EST}
- {-880221600 -14400 1 EWT}
+ {-880218000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
{-765396000 -18000 0 EST}
{-757364400 -18000 0 EST}
@@ -178,190 +177,190 @@ set TZData(:America/Montreal) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Montserrat b/library/tzdata/America/Montserrat
index 7a183b0..0a656d3 100644
--- a/library/tzdata/America/Montserrat
+++ b/library/tzdata/America/Montserrat
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Montserrat) {
- {-9223372036854775808 -14932 0 LMT}
- {-1846266608 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Montserrat) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Nassau b/library/tzdata/America/Nassau
index 4a7423d..1c35e93 100644
--- a/library/tzdata/America/Nassau
+++ b/library/tzdata/America/Nassau
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Nassau) {
- {-9223372036854775808 -18564 0 LMT}
- {-1825095036 -18000 0 EST}
+ {-9223372036854775808 -18570 0 LMT}
+ {-1825095030 -18000 0 EST}
{-179341200 -14400 1 EDT}
{-163620000 -18000 0 EST}
{-147891600 -14400 1 EDT}
@@ -27,6 +27,7 @@ set TZData(:America/Nassau) {
{152085600 -18000 0 EST}
{167814000 -14400 1 EDT}
{183535200 -18000 0 EST}
+ {189320400 -18000 0 EST}
{199263600 -14400 1 EDT}
{215589600 -18000 0 EST}
{230713200 -14400 1 EDT}
@@ -89,190 +90,190 @@ set TZData(:America/Nassau) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/New_York b/library/tzdata/America/New_York
index 2f7c8df..72f2c96 100644
--- a/library/tzdata/America/New_York
+++ b/library/tzdata/America/New_York
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/New_York) {
{-9223372036854775808 -17762 0 LMT}
@@ -180,190 +180,190 @@ set TZData(:America/New_York) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Nipigon b/library/tzdata/America/Nipigon
index 341530a..30690aa 100644
--- a/library/tzdata/America/Nipigon
+++ b/library/tzdata/America/Nipigon
@@ -1,13 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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}
- {-880236000 -14400 0 EST}
- {-880221600 -14400 1 EWT}
+ {-880218000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
{-765396000 -18000 0 EST}
{136364400 -14400 1 EDT}
@@ -76,190 +75,190 @@ set TZData(:America/Nipigon) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Nome b/library/tzdata/America/Nome
index bfd0632..c095b79 100644
--- a/library/tzdata/America/Nome
+++ b/library/tzdata/America/Nome
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Nome) {
{-9223372036854775808 46701 0 LMT}
@@ -87,190 +87,190 @@ set TZData(:America/Nome) {
{1130666400 -32400 0 AKST}
{1143975600 -28800 1 AKDT}
{1162116000 -32400 0 AKST}
- {1175425200 -28800 1 AKDT}
- {1193565600 -32400 0 AKST}
- {1207479600 -28800 1 AKDT}
- {1225015200 -32400 0 AKST}
- {1238929200 -28800 1 AKDT}
- {1256464800 -32400 0 AKST}
- {1270378800 -28800 1 AKDT}
- {1288519200 -32400 0 AKST}
- {1301828400 -28800 1 AKDT}
- {1319968800 -32400 0 AKST}
- {1333278000 -28800 1 AKDT}
- {1351418400 -32400 0 AKST}
- {1365332400 -28800 1 AKDT}
- {1382868000 -32400 0 AKST}
- {1396782000 -28800 1 AKDT}
- {1414317600 -32400 0 AKST}
- {1428231600 -28800 1 AKDT}
- {1445767200 -32400 0 AKST}
- {1459681200 -28800 1 AKDT}
- {1477821600 -32400 0 AKST}
- {1491130800 -28800 1 AKDT}
- {1509271200 -32400 0 AKST}
- {1522580400 -28800 1 AKDT}
- {1540720800 -32400 0 AKST}
- {1554634800 -28800 1 AKDT}
- {1572170400 -32400 0 AKST}
- {1586084400 -28800 1 AKDT}
- {1603620000 -32400 0 AKST}
- {1617534000 -28800 1 AKDT}
- {1635674400 -32400 0 AKST}
- {1648983600 -28800 1 AKDT}
- {1667124000 -32400 0 AKST}
- {1680433200 -28800 1 AKDT}
- {1698573600 -32400 0 AKST}
- {1712487600 -28800 1 AKDT}
- {1730023200 -32400 0 AKST}
- {1743937200 -28800 1 AKDT}
- {1761472800 -32400 0 AKST}
- {1775386800 -28800 1 AKDT}
- {1792922400 -32400 0 AKST}
- {1806836400 -28800 1 AKDT}
- {1824976800 -32400 0 AKST}
- {1838286000 -28800 1 AKDT}
- {1856426400 -32400 0 AKST}
- {1869735600 -28800 1 AKDT}
- {1887876000 -32400 0 AKST}
- {1901790000 -28800 1 AKDT}
- {1919325600 -32400 0 AKST}
- {1933239600 -28800 1 AKDT}
- {1950775200 -32400 0 AKST}
- {1964689200 -28800 1 AKDT}
- {1982829600 -32400 0 AKST}
- {1996138800 -28800 1 AKDT}
- {2014279200 -32400 0 AKST}
- {2027588400 -28800 1 AKDT}
- {2045728800 -32400 0 AKST}
- {2059038000 -28800 1 AKDT}
- {2077178400 -32400 0 AKST}
- {2091092400 -28800 1 AKDT}
- {2108628000 -32400 0 AKST}
- {2122542000 -28800 1 AKDT}
- {2140077600 -32400 0 AKST}
- {2153991600 -28800 1 AKDT}
- {2172132000 -32400 0 AKST}
- {2185441200 -28800 1 AKDT}
- {2203581600 -32400 0 AKST}
- {2216890800 -28800 1 AKDT}
- {2235031200 -32400 0 AKST}
- {2248945200 -28800 1 AKDT}
- {2266480800 -32400 0 AKST}
- {2280394800 -28800 1 AKDT}
- {2297930400 -32400 0 AKST}
- {2311844400 -28800 1 AKDT}
- {2329380000 -32400 0 AKST}
- {2343294000 -28800 1 AKDT}
- {2361434400 -32400 0 AKST}
- {2374743600 -28800 1 AKDT}
- {2392884000 -32400 0 AKST}
- {2406193200 -28800 1 AKDT}
- {2424333600 -32400 0 AKST}
- {2438247600 -28800 1 AKDT}
- {2455783200 -32400 0 AKST}
- {2469697200 -28800 1 AKDT}
- {2487232800 -32400 0 AKST}
- {2501146800 -28800 1 AKDT}
- {2519287200 -32400 0 AKST}
- {2532596400 -28800 1 AKDT}
- {2550736800 -32400 0 AKST}
- {2564046000 -28800 1 AKDT}
- {2582186400 -32400 0 AKST}
- {2596100400 -28800 1 AKDT}
- {2613636000 -32400 0 AKST}
- {2627550000 -28800 1 AKDT}
- {2645085600 -32400 0 AKST}
- {2658999600 -28800 1 AKDT}
- {2676535200 -32400 0 AKST}
- {2690449200 -28800 1 AKDT}
- {2708589600 -32400 0 AKST}
- {2721898800 -28800 1 AKDT}
- {2740039200 -32400 0 AKST}
- {2753348400 -28800 1 AKDT}
- {2771488800 -32400 0 AKST}
- {2785402800 -28800 1 AKDT}
- {2802938400 -32400 0 AKST}
- {2816852400 -28800 1 AKDT}
- {2834388000 -32400 0 AKST}
- {2848302000 -28800 1 AKDT}
- {2866442400 -32400 0 AKST}
- {2879751600 -28800 1 AKDT}
- {2897892000 -32400 0 AKST}
- {2911201200 -28800 1 AKDT}
- {2929341600 -32400 0 AKST}
- {2942650800 -28800 1 AKDT}
- {2960791200 -32400 0 AKST}
- {2974705200 -28800 1 AKDT}
- {2992240800 -32400 0 AKST}
- {3006154800 -28800 1 AKDT}
- {3023690400 -32400 0 AKST}
- {3037604400 -28800 1 AKDT}
- {3055744800 -32400 0 AKST}
- {3069054000 -28800 1 AKDT}
- {3087194400 -32400 0 AKST}
- {3100503600 -28800 1 AKDT}
- {3118644000 -32400 0 AKST}
- {3132558000 -28800 1 AKDT}
- {3150093600 -32400 0 AKST}
- {3164007600 -28800 1 AKDT}
- {3181543200 -32400 0 AKST}
- {3195457200 -28800 1 AKDT}
- {3212992800 -32400 0 AKST}
- {3226906800 -28800 1 AKDT}
- {3245047200 -32400 0 AKST}
- {3258356400 -28800 1 AKDT}
- {3276496800 -32400 0 AKST}
- {3289806000 -28800 1 AKDT}
- {3307946400 -32400 0 AKST}
- {3321860400 -28800 1 AKDT}
- {3339396000 -32400 0 AKST}
- {3353310000 -28800 1 AKDT}
- {3370845600 -32400 0 AKST}
- {3384759600 -28800 1 AKDT}
- {3402900000 -32400 0 AKST}
- {3416209200 -28800 1 AKDT}
- {3434349600 -32400 0 AKST}
- {3447658800 -28800 1 AKDT}
- {3465799200 -32400 0 AKST}
- {3479713200 -28800 1 AKDT}
- {3497248800 -32400 0 AKST}
- {3511162800 -28800 1 AKDT}
- {3528698400 -32400 0 AKST}
- {3542612400 -28800 1 AKDT}
- {3560148000 -32400 0 AKST}
- {3574062000 -28800 1 AKDT}
- {3592202400 -32400 0 AKST}
- {3605511600 -28800 1 AKDT}
- {3623652000 -32400 0 AKST}
- {3636961200 -28800 1 AKDT}
- {3655101600 -32400 0 AKST}
- {3669015600 -28800 1 AKDT}
- {3686551200 -32400 0 AKST}
- {3700465200 -28800 1 AKDT}
- {3718000800 -32400 0 AKST}
- {3731914800 -28800 1 AKDT}
- {3750055200 -32400 0 AKST}
- {3763364400 -28800 1 AKDT}
- {3781504800 -32400 0 AKST}
- {3794814000 -28800 1 AKDT}
- {3812954400 -32400 0 AKST}
- {3826263600 -28800 1 AKDT}
- {3844404000 -32400 0 AKST}
- {3858318000 -28800 1 AKDT}
- {3875853600 -32400 0 AKST}
- {3889767600 -28800 1 AKDT}
- {3907303200 -32400 0 AKST}
- {3921217200 -28800 1 AKDT}
- {3939357600 -32400 0 AKST}
- {3952666800 -28800 1 AKDT}
- {3970807200 -32400 0 AKST}
- {3984116400 -28800 1 AKDT}
- {4002256800 -32400 0 AKST}
- {4016170800 -28800 1 AKDT}
- {4033706400 -32400 0 AKST}
- {4047620400 -28800 1 AKDT}
- {4065156000 -32400 0 AKST}
- {4079070000 -28800 1 AKDT}
- {4096605600 -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/Noronha b/library/tzdata/America/Noronha
index 64809cf..94d6f42 100644
--- a/library/tzdata/America/Noronha
+++ b/library/tzdata/America/Noronha
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Noronha) {
{-9223372036854775808 -7780 0 LMT}
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/North_Dakota/Center b/library/tzdata/America/North_Dakota/Center
index 6903b52..30782f7 100644
--- a/library/tzdata/America/North_Dakota/Center
+++ b/library/tzdata/America/North_Dakota/Center
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/North_Dakota/Center) {
{-9223372036854775808 -24312 0 LMT}
@@ -90,190 +90,190 @@ set TZData(:America/North_Dakota/Center) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162105200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193554800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1225004400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256454000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288508400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319958000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351407600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382857200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414306800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445756400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477810800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509260400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540710000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572159600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603609200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635663600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667113200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698562800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1730012400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761462000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792911600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824966000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856415600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887865200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919314800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950764400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982818800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014268400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045718000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077167600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108617200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140066800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172121200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203570800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235020400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266470000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297919600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329369200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361423600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392873200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424322800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455772400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487222000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519276400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550726000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582175600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613625200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645074800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676524400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708578800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740028400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771478000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802927600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834377200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866431600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897881200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929330800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960780400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992230000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023679600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055734000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087183600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118633200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150082800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181532400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212982000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245036400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276486000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307935600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339385200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370834800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402889200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434338800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465788400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497238000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528687600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560137200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592191600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623641200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655090800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686540400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717990000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750044400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781494000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812943600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844393200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875842800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907292400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939346800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970796400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002246000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033695600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065145200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096594800 -21600 0 CST}
+ {1173600000 -18000 1 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/North_Dakota/New_Salem b/library/tzdata/America/North_Dakota/New_Salem
new file mode 100644
index 0000000..5a9d229
--- /dev/null
+++ b/library/tzdata/America/North_Dakota/New_Salem
@@ -0,0 +1,279 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/North_Dakota/New_Salem) {
+ {-9223372036854775808 -24339 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}
+ {1067158800 -21600 0 CST}
+ {1081065600 -18000 1 CDT}
+ {1099206000 -21600 0 CST}
+ {1112515200 -18000 1 CDT}
+ {1130655600 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 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/Ojinaga b/library/tzdata/America/Ojinaga
new file mode 100644
index 0000000..1172708
--- /dev/null
+++ b/library/tzdata/America/Ojinaga
@@ -0,0 +1,222 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Ojinaga) {
+ {-9223372036854775808 -25060 0 LMT}
+ {-1514739600 -25200 0 MST}
+ {-1343066400 -21600 0 CST}
+ {-1234807200 -25200 0 MST}
+ {-1220292000 -21600 0 CST}
+ {-1207159200 -25200 0 MST}
+ {-1191344400 -21600 0 CST}
+ {820476000 -21600 0 CST}
+ {828864000 -18000 1 CDT}
+ {846399600 -21600 0 CST}
+ {860313600 -18000 1 CDT}
+ {877849200 -21600 0 CST}
+ {883634400 -21600 0 CST}
+ {891766800 -21600 0 MDT}
+ {909302400 -25200 0 MST}
+ {923216400 -21600 1 MDT}
+ {941356800 -25200 0 MST}
+ {954666000 -21600 1 MDT}
+ {972806400 -25200 0 MST}
+ {989139600 -21600 1 MDT}
+ {1001836800 -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}
+ {1175418000 -21600 1 MDT}
+ {1193558400 -25200 0 MST}
+ {1207472400 -21600 1 MDT}
+ {1225008000 -25200 0 MST}
+ {1238922000 -21600 1 MDT}
+ {1256457600 -25200 0 MST}
+ {1262329200 -25200 0 MST}
+ {1268557200 -21600 1 MDT}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
+}
diff --git a/library/tzdata/America/Panama b/library/tzdata/America/Panama
index a5f4a4a..3006785 100644
--- a/library/tzdata/America/Panama
+++ b/library/tzdata/America/Panama
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Panama) {
{-9223372036854775808 -19088 0 LMT}
diff --git a/library/tzdata/America/Pangnirtung b/library/tzdata/America/Pangnirtung
index d153067..640808e 100644
--- a/library/tzdata/America/Pangnirtung
+++ b/library/tzdata/America/Pangnirtung
@@ -1,12 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Pangnirtung) {
- {-9223372036854775808 -15776 0 LMT}
- {-2713894624 -14400 0 AST}
- {-1632074400 -10800 1 ADT}
- {-1615143600 -14400 0 AST}
- {-1596996000 -10800 1 ADT}
- {-1583182800 -14400 0 AST}
+ {-9223372036854775808 0 0 zzz}
+ {-1546300800 -14400 0 AST}
{-880221600 -10800 1 AWT}
{-769395600 -10800 1 APT}
{-765399600 -14400 0 AST}
@@ -67,190 +63,190 @@ set TZData(:America/Pangnirtung) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Paramaribo b/library/tzdata/America/Paramaribo
index db316d6..d15f5c7 100644
--- a/library/tzdata/America/Paramaribo
+++ b/library/tzdata/America/Paramaribo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Paramaribo) {
{-9223372036854775808 -13240 0 LMT}
diff --git a/library/tzdata/America/Phoenix b/library/tzdata/America/Phoenix
index 9f1d2d5..3d37bb4 100644
--- a/library/tzdata/America/Phoenix
+++ b/library/tzdata/America/Phoenix
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Phoenix) {
{-9223372036854775808 -26898 0 LMT}
diff --git a/library/tzdata/America/Port-au-Prince b/library/tzdata/America/Port-au-Prince
index 3d93098..f1d7fc4 100644
--- a/library/tzdata/America/Port-au-Prince
+++ b/library/tzdata/America/Port-au-Prince
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Port-au-Prince) {
{-9223372036854775808 -17360 0 LMT}
@@ -14,26 +14,204 @@ set TZData(:America/Port-au-Prince) {
{530683200 -18000 0 EST}
{546411600 -14400 1 EDT}
{562132800 -18000 0 EST}
- {576032400 -14400 1 EDT}
- {594176400 -18000 0 EST}
- {607482000 -14400 1 EDT}
- {625626000 -18000 0 EST}
- {638931600 -14400 1 EDT}
- {657075600 -18000 0 EST}
- {670986000 -14400 1 EDT}
- {688525200 -18000 0 EST}
- {702435600 -14400 1 EDT}
- {719974800 -18000 0 EST}
- {733885200 -14400 1 EDT}
- {752029200 -18000 0 EST}
- {765334800 -14400 1 EDT}
- {783478800 -18000 0 EST}
- {796784400 -14400 1 EDT}
- {814928400 -18000 0 EST}
- {828838800 -14400 1 EDT}
- {846378000 -18000 0 EST}
- {860288400 -14400 1 EDT}
- {877827600 -18000 0 EST}
+ {576050400 -14400 1 EDT}
+ {594194400 -18000 0 EST}
+ {607500000 -14400 1 EDT}
+ {625644000 -18000 0 EST}
+ {638949600 -14400 1 EDT}
+ {657093600 -18000 0 EST}
+ {671004000 -14400 1 EDT}
+ {688543200 -18000 0 EST}
+ {702453600 -14400 1 EDT}
+ {719992800 -18000 0 EST}
+ {733903200 -14400 1 EDT}
+ {752047200 -18000 0 EST}
+ {765352800 -14400 1 EDT}
+ {783496800 -18000 0 EST}
+ {796802400 -14400 1 EDT}
+ {814946400 -18000 0 EST}
+ {828856800 -14400 1 EDT}
+ {846396000 -18000 0 EST}
+ {860306400 -14400 1 EDT}
+ {877845600 -18000 0 EST}
{1112504400 -14400 1 EDT}
{1130644800 -18000 0 EST}
+ {1143954000 -14400 1 EDT}
+ {1162094400 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Port_of_Spain b/library/tzdata/America/Port_of_Spain
index 1676561..c360c87 100644
--- a/library/tzdata/America/Port_of_Spain
+++ b/library/tzdata/America/Port_of_Spain
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Port_of_Spain) {
{-9223372036854775808 -14764 0 LMT}
diff --git a/library/tzdata/America/Porto_Acre b/library/tzdata/America/Porto_Acre
index 4df709b..0626001 100644
--- a/library/tzdata/America/Porto_Acre
+++ b/library/tzdata/America/Porto_Acre
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Rio_Branco)]} {
LoadTimeZoneFile America/Rio_Branco
}
diff --git a/library/tzdata/America/Porto_Velho b/library/tzdata/America/Porto_Velho
index dbaa0f4..ce611d2 100644
--- a/library/tzdata/America/Porto_Velho
+++ b/library/tzdata/America/Porto_Velho
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Porto_Velho) {
{-9223372036854775808 -15336 0 LMT}
diff --git a/library/tzdata/America/Puerto_Rico b/library/tzdata/America/Puerto_Rico
index 639426a..0d5c9b4 100644
--- a/library/tzdata/America/Puerto_Rico
+++ b/library/tzdata/America/Puerto_Rico
@@ -1,8 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Puerto_Rico) {
{-9223372036854775808 -15865 0 LMT}
{-2233035335 -14400 0 AST}
- {-873057600 -10800 1 AWT}
+ {-873057600 -10800 0 AWT}
+ {-769395600 -10800 1 APT}
{-765399600 -14400 0 AST}
+ {-757368000 -14400 0 AST}
}
diff --git a/library/tzdata/America/Rainy_River b/library/tzdata/America/Rainy_River
index d73de11..a2b11aa 100644
--- a/library/tzdata/America/Rainy_River
+++ b/library/tzdata/America/Rainy_River
@@ -1,13 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Rainy_River) {
- {-9223372036854775808 -22676 0 LMT}
- {-2366732524 -21600 0 CST}
+ {-9223372036854775808 -22696 0 LMT}
+ {-2366732504 -21600 0 CST}
{-1632067200 -18000 1 CDT}
- {-1614790800 -21600 0 CST}
+ {-1615136400 -21600 0 CST}
{-923248800 -18000 1 CDT}
- {-880236000 -18000 0 CST}
- {-880218000 -18000 1 CWT}
+ {-880214400 -18000 0 CWT}
{-769395600 -18000 1 CPT}
{-765392400 -21600 0 CST}
{136368000 -18000 1 CDT}
@@ -76,190 +75,190 @@ set TZData(:America/Rainy_River) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162105200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193554800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1225004400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256454000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288508400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319958000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351407600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382857200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414306800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445756400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477810800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509260400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540710000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572159600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603609200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635663600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667113200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698562800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1730012400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761462000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792911600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824966000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856415600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887865200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919314800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950764400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982818800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014268400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045718000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077167600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108617200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140066800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172121200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203570800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235020400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266470000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297919600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329369200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361423600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392873200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424322800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455772400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487222000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519276400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550726000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582175600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613625200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645074800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676524400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708578800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740028400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771478000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802927600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834377200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866431600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897881200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929330800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960780400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992230000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023679600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055734000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087183600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118633200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150082800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181532400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212982000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245036400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276486000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307935600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339385200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370834800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402889200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434338800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465788400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497238000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528687600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560137200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592191600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623641200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655090800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686540400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717990000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750044400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781494000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812943600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844393200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875842800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907292400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939346800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970796400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002246000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033695600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065145200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096594800 -21600 0 CST}
+ {1173600000 -18000 1 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/Rankin_Inlet b/library/tzdata/America/Rankin_Inlet
index b563cc7..770ec5d 100644
--- a/library/tzdata/America/Rankin_Inlet
+++ b/library/tzdata/America/Rankin_Inlet
@@ -1,15 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Rankin_Inlet) {
- {-9223372036854775808 -22120 0 LMT}
- {-2713888280 -21600 0 CST}
- {-1632067200 -18000 1 CDT}
- {-1615136400 -21600 0 CST}
- {-1596988800 -18000 1 CDT}
- {-1583175600 -21600 0 CST}
- {-880214400 -18000 1 CWT}
- {-769395600 -18000 1 CPT}
- {-765392400 -21600 0 CST}
+ {-9223372036854775808 0 0 zzz}
+ {-410227200 -21600 0 CST}
{-147895200 -14400 1 CDDT}
{-131565600 -21600 0 CST}
{325670400 -18000 1 CDT}
@@ -66,190 +59,190 @@ set TZData(:America/Rankin_Inlet) {
{1130655600 -21600 0 CST}
{1143964800 -18000 1 CDT}
{1162105200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193554800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1225004400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256454000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288508400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319958000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351407600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382857200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414306800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445756400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477810800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509260400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540710000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572159600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603609200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635663600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667113200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698562800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1730012400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761462000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792911600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824966000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856415600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887865200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919314800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950764400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982818800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014268400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045718000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077167600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108617200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140066800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172121200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203570800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235020400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266470000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297919600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329369200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361423600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392873200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424322800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455772400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487222000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519276400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550726000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582175600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613625200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645074800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676524400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708578800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740028400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771478000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802927600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834377200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866431600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897881200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929330800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960780400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992230000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023679600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055734000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087183600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118633200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150082800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181532400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212982000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245036400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276486000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307935600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339385200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370834800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402889200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434338800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465788400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497238000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528687600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560137200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592191600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623641200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655090800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686540400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717990000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750044400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781494000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812943600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844393200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875842800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907292400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939346800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970796400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002246000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033695600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065145200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096594800 -21600 0 CST}
+ {1173600000 -18000 1 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/Recife b/library/tzdata/America/Recife
index 7520ee3..f6ae00e 100644
--- a/library/tzdata/America/Recife
+++ b/library/tzdata/America/Recife
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Recife) {
{-9223372036854775808 -8376 0 LMT}
diff --git a/library/tzdata/America/Regina b/library/tzdata/America/Regina
index fb76bee..e42b5be 100644
--- a/library/tzdata/America/Regina
+++ b/library/tzdata/America/Regina
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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
new file mode 100644
index 0000000..b4c0bab
--- /dev/null
+++ b/library/tzdata/America/Resolute
@@ -0,0 +1,248 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Resolute) {
+ {-9223372036854775808 0 0 zzz}
+ {-704937600 -21600 0 CST}
+ {-147895200 -14400 1 CDDT}
+ {-131565600 -21600 0 CST}
+ {325670400 -18000 1 CDT}
+ {341391600 -21600 0 CST}
+ {357120000 -18000 1 CDT}
+ {372841200 -21600 0 CST}
+ {388569600 -18000 1 CDT}
+ {404895600 -21600 0 CST}
+ {420019200 -18000 1 CDT}
+ {436345200 -21600 0 CST}
+ {452073600 -18000 1 CDT}
+ {467794800 -21600 0 CST}
+ {483523200 -18000 1 CDT}
+ {499244400 -21600 0 CST}
+ {514972800 -18000 1 CDT}
+ {530694000 -21600 0 CST}
+ {544608000 -18000 1 CDT}
+ {562143600 -21600 0 CST}
+ {576057600 -18000 1 CDT}
+ {594198000 -21600 0 CST}
+ {607507200 -18000 1 CDT}
+ {625647600 -21600 0 CST}
+ {638956800 -18000 1 CDT}
+ {657097200 -21600 0 CST}
+ {671011200 -18000 1 CDT}
+ {688546800 -21600 0 CST}
+ {702460800 -18000 1 CDT}
+ {719996400 -21600 0 CST}
+ {733910400 -18000 1 CDT}
+ {752050800 -21600 0 CST}
+ {765360000 -18000 1 CDT}
+ {783500400 -21600 0 CST}
+ {796809600 -18000 1 CDT}
+ {814950000 -21600 0 CST}
+ {828864000 -18000 1 CDT}
+ {846399600 -21600 0 CST}
+ {860313600 -18000 1 CDT}
+ {877849200 -21600 0 CST}
+ {891763200 -18000 1 CDT}
+ {909298800 -21600 0 CST}
+ {923212800 -18000 1 CDT}
+ {941353200 -21600 0 CST}
+ {954662400 -18000 1 CDT}
+ {972806400 -18000 0 EST}
+ {986112000 -18000 0 CDT}
+ {1004252400 -21600 0 CST}
+ {1018166400 -18000 1 CDT}
+ {1035702000 -21600 0 CST}
+ {1049616000 -18000 1 CDT}
+ {1067151600 -21600 0 CST}
+ {1081065600 -18000 1 CDT}
+ {1099206000 -21600 0 CST}
+ {1112515200 -18000 1 CDT}
+ {1130655600 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162108800 -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/Rio_Branco b/library/tzdata/America/Rio_Branco
index b1d7e75..20889cb 100644
--- a/library/tzdata/America/Rio_Branco
+++ b/library/tzdata/America/Rio_Branco
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Rio_Branco) {
{-9223372036854775808 -16272 0 LMT}
@@ -32,4 +32,5 @@ set TZData(:America/Rio_Branco) {
{562136400 -14400 1 ACST}
{571204800 -18000 0 ACT}
{590040000 -18000 0 ACT}
+ {1214283600 -14400 0 AMT}
}
diff --git a/library/tzdata/America/Rosario b/library/tzdata/America/Rosario
index 7040613..6687f88 100644
--- a/library/tzdata/America/Rosario
+++ b/library/tzdata/America/Rosario
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Argentina/Cordoba)]} {
LoadTimeZoneFile America/Argentina/Cordoba
}
diff --git a/library/tzdata/America/Santa_Isabel b/library/tzdata/America/Santa_Isabel
new file mode 100644
index 0000000..87cb5a8
--- /dev/null
+++ b/library/tzdata/America/Santa_Isabel
@@ -0,0 +1,284 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Santa_Isabel) {
+ {-9223372036854775808 -27568 0 LMT}
+ {-1514736000 -25200 0 MST}
+ {-1451667600 -28800 0 PST}
+ {-1343062800 -25200 0 MST}
+ {-1234803600 -28800 0 PST}
+ {-1222963200 -25200 1 PDT}
+ {-1207242000 -28800 0 PST}
+ {-873820800 -25200 1 PWT}
+ {-769395600 -25200 1 PPT}
+ {-761677200 -28800 0 PST}
+ {-686073600 -25200 1 PDT}
+ {-661539600 -28800 0 PST}
+ {-504892800 -28800 0 PST}
+ {-495036000 -25200 1 PDT}
+ {-481734000 -28800 0 PST}
+ {-463586400 -25200 1 PDT}
+ {-450284400 -28800 0 PST}
+ {-431532000 -25200 1 PDT}
+ {-418230000 -28800 0 PST}
+ {-400082400 -25200 1 PDT}
+ {-386780400 -28800 0 PST}
+ {-368632800 -25200 1 PDT}
+ {-355330800 -28800 0 PST}
+ {-337183200 -25200 1 PDT}
+ {-323881200 -28800 0 PST}
+ {-305733600 -25200 1 PDT}
+ {-292431600 -28800 0 PST}
+ {-283968000 -28800 0 PST}
+ {189331200 -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}
+ {436352400 -28800 0 PST}
+ {452080800 -25200 1 PDT}
+ {467802000 -28800 0 PST}
+ {483530400 -25200 1 PDT}
+ {499251600 -28800 0 PST}
+ {514980000 -25200 1 PDT}
+ {530701200 -28800 0 PST}
+ {544615200 -25200 1 PDT}
+ {562150800 -28800 0 PST}
+ {576064800 -25200 1 PDT}
+ {594205200 -28800 0 PST}
+ {607514400 -25200 1 PDT}
+ {625654800 -28800 0 PST}
+ {638964000 -25200 1 PDT}
+ {657104400 -28800 0 PST}
+ {671018400 -25200 1 PDT}
+ {688554000 -28800 0 PST}
+ {702468000 -25200 1 PDT}
+ {720003600 -28800 0 PST}
+ {733917600 -25200 1 PDT}
+ {752058000 -28800 0 PST}
+ {765367200 -25200 1 PDT}
+ {783507600 -28800 0 PST}
+ {796816800 -25200 1 PDT}
+ {814957200 -28800 0 PST}
+ {820483200 -28800 0 PST}
+ {828871200 -25200 1 PDT}
+ {846406800 -28800 0 PST}
+ {860320800 -25200 1 PDT}
+ {877856400 -28800 0 PST}
+ {891770400 -25200 1 PDT}
+ {909306000 -28800 0 PST}
+ {923220000 -25200 1 PDT}
+ {941360400 -28800 0 PST}
+ {954669600 -25200 1 PDT}
+ {972810000 -28800 0 PST}
+ {978336000 -28800 0 PST}
+ {986119200 -25200 1 PDT}
+ {1004259600 -28800 0 PST}
+ {1014192000 -28800 0 PST}
+ {1018173600 -25200 1 PDT}
+ {1035709200 -28800 0 PST}
+ {1049623200 -25200 1 PDT}
+ {1067158800 -28800 0 PST}
+ {1081072800 -25200 1 PDT}
+ {1099213200 -28800 0 PST}
+ {1112522400 -25200 1 PDT}
+ {1130662800 -28800 0 PST}
+ {1143972000 -25200 1 PDT}
+ {1162112400 -28800 0 PST}
+ {1175421600 -25200 1 PDT}
+ {1193562000 -28800 0 PST}
+ {1207476000 -25200 1 PDT}
+ {1225011600 -28800 0 PST}
+ {1238925600 -25200 1 PDT}
+ {1256461200 -28800 0 PST}
+ {1270375200 -25200 1 PDT}
+ {1288515600 -28800 0 PST}
+ {1301824800 -25200 1 PDT}
+ {1319965200 -28800 0 PST}
+ {1333274400 -25200 1 PDT}
+ {1351414800 -28800 0 PST}
+ {1365328800 -25200 1 PDT}
+ {1382864400 -28800 0 PST}
+ {1396778400 -25200 1 PDT}
+ {1414314000 -28800 0 PST}
+ {1428228000 -25200 1 PDT}
+ {1445763600 -28800 0 PST}
+ {1459677600 -25200 1 PDT}
+ {1477818000 -28800 0 PST}
+ {1491127200 -25200 1 PDT}
+ {1509267600 -28800 0 PST}
+ {1522576800 -25200 1 PDT}
+ {1540717200 -28800 0 PST}
+ {1554631200 -25200 1 PDT}
+ {1572166800 -28800 0 PST}
+ {1586080800 -25200 1 PDT}
+ {1603616400 -28800 0 PST}
+ {1617530400 -25200 1 PDT}
+ {1635670800 -28800 0 PST}
+ {1648980000 -25200 1 PDT}
+ {1667120400 -28800 0 PST}
+ {1680429600 -25200 1 PDT}
+ {1698570000 -28800 0 PST}
+ {1712484000 -25200 1 PDT}
+ {1730019600 -28800 0 PST}
+ {1743933600 -25200 1 PDT}
+ {1761469200 -28800 0 PST}
+ {1775383200 -25200 1 PDT}
+ {1792918800 -28800 0 PST}
+ {1806832800 -25200 1 PDT}
+ {1824973200 -28800 0 PST}
+ {1838282400 -25200 1 PDT}
+ {1856422800 -28800 0 PST}
+ {1869732000 -25200 1 PDT}
+ {1887872400 -28800 0 PST}
+ {1901786400 -25200 1 PDT}
+ {1919322000 -28800 0 PST}
+ {1933236000 -25200 1 PDT}
+ {1950771600 -28800 0 PST}
+ {1964685600 -25200 1 PDT}
+ {1982826000 -28800 0 PST}
+ {1996135200 -25200 1 PDT}
+ {2014275600 -28800 0 PST}
+ {2027584800 -25200 1 PDT}
+ {2045725200 -28800 0 PST}
+ {2059034400 -25200 1 PDT}
+ {2077174800 -28800 0 PST}
+ {2091088800 -25200 1 PDT}
+ {2108624400 -28800 0 PST}
+ {2122538400 -25200 1 PDT}
+ {2140074000 -28800 0 PST}
+ {2153988000 -25200 1 PDT}
+ {2172128400 -28800 0 PST}
+ {2185437600 -25200 1 PDT}
+ {2203578000 -28800 0 PST}
+ {2216887200 -25200 1 PDT}
+ {2235027600 -28800 0 PST}
+ {2248941600 -25200 1 PDT}
+ {2266477200 -28800 0 PST}
+ {2280391200 -25200 1 PDT}
+ {2297926800 -28800 0 PST}
+ {2311840800 -25200 1 PDT}
+ {2329376400 -28800 0 PST}
+ {2343290400 -25200 1 PDT}
+ {2361430800 -28800 0 PST}
+ {2374740000 -25200 1 PDT}
+ {2392880400 -28800 0 PST}
+ {2406189600 -25200 1 PDT}
+ {2424330000 -28800 0 PST}
+ {2438244000 -25200 1 PDT}
+ {2455779600 -28800 0 PST}
+ {2469693600 -25200 1 PDT}
+ {2487229200 -28800 0 PST}
+ {2501143200 -25200 1 PDT}
+ {2519283600 -28800 0 PST}
+ {2532592800 -25200 1 PDT}
+ {2550733200 -28800 0 PST}
+ {2564042400 -25200 1 PDT}
+ {2582182800 -28800 0 PST}
+ {2596096800 -25200 1 PDT}
+ {2613632400 -28800 0 PST}
+ {2627546400 -25200 1 PDT}
+ {2645082000 -28800 0 PST}
+ {2658996000 -25200 1 PDT}
+ {2676531600 -28800 0 PST}
+ {2690445600 -25200 1 PDT}
+ {2708586000 -28800 0 PST}
+ {2721895200 -25200 1 PDT}
+ {2740035600 -28800 0 PST}
+ {2753344800 -25200 1 PDT}
+ {2771485200 -28800 0 PST}
+ {2785399200 -25200 1 PDT}
+ {2802934800 -28800 0 PST}
+ {2816848800 -25200 1 PDT}
+ {2834384400 -28800 0 PST}
+ {2848298400 -25200 1 PDT}
+ {2866438800 -28800 0 PST}
+ {2879748000 -25200 1 PDT}
+ {2897888400 -28800 0 PST}
+ {2911197600 -25200 1 PDT}
+ {2929338000 -28800 0 PST}
+ {2942647200 -25200 1 PDT}
+ {2960787600 -28800 0 PST}
+ {2974701600 -25200 1 PDT}
+ {2992237200 -28800 0 PST}
+ {3006151200 -25200 1 PDT}
+ {3023686800 -28800 0 PST}
+ {3037600800 -25200 1 PDT}
+ {3055741200 -28800 0 PST}
+ {3069050400 -25200 1 PDT}
+ {3087190800 -28800 0 PST}
+ {3100500000 -25200 1 PDT}
+ {3118640400 -28800 0 PST}
+ {3132554400 -25200 1 PDT}
+ {3150090000 -28800 0 PST}
+ {3164004000 -25200 1 PDT}
+ {3181539600 -28800 0 PST}
+ {3195453600 -25200 1 PDT}
+ {3212989200 -28800 0 PST}
+ {3226903200 -25200 1 PDT}
+ {3245043600 -28800 0 PST}
+ {3258352800 -25200 1 PDT}
+ {3276493200 -28800 0 PST}
+ {3289802400 -25200 1 PDT}
+ {3307942800 -28800 0 PST}
+ {3321856800 -25200 1 PDT}
+ {3339392400 -28800 0 PST}
+ {3353306400 -25200 1 PDT}
+ {3370842000 -28800 0 PST}
+ {3384756000 -25200 1 PDT}
+ {3402896400 -28800 0 PST}
+ {3416205600 -25200 1 PDT}
+ {3434346000 -28800 0 PST}
+ {3447655200 -25200 1 PDT}
+ {3465795600 -28800 0 PST}
+ {3479709600 -25200 1 PDT}
+ {3497245200 -28800 0 PST}
+ {3511159200 -25200 1 PDT}
+ {3528694800 -28800 0 PST}
+ {3542608800 -25200 1 PDT}
+ {3560144400 -28800 0 PST}
+ {3574058400 -25200 1 PDT}
+ {3592198800 -28800 0 PST}
+ {3605508000 -25200 1 PDT}
+ {3623648400 -28800 0 PST}
+ {3636957600 -25200 1 PDT}
+ {3655098000 -28800 0 PST}
+ {3669012000 -25200 1 PDT}
+ {3686547600 -28800 0 PST}
+ {3700461600 -25200 1 PDT}
+ {3717997200 -28800 0 PST}
+ {3731911200 -25200 1 PDT}
+ {3750051600 -28800 0 PST}
+ {3763360800 -25200 1 PDT}
+ {3781501200 -28800 0 PST}
+ {3794810400 -25200 1 PDT}
+ {3812950800 -28800 0 PST}
+ {3826260000 -25200 1 PDT}
+ {3844400400 -28800 0 PST}
+ {3858314400 -25200 1 PDT}
+ {3875850000 -28800 0 PST}
+ {3889764000 -25200 1 PDT}
+ {3907299600 -28800 0 PST}
+ {3921213600 -25200 1 PDT}
+ {3939354000 -28800 0 PST}
+ {3952663200 -25200 1 PDT}
+ {3970803600 -28800 0 PST}
+ {3984112800 -25200 1 PDT}
+ {4002253200 -28800 0 PST}
+ {4016167200 -25200 1 PDT}
+ {4033702800 -28800 0 PST}
+ {4047616800 -25200 1 PDT}
+ {4065152400 -28800 0 PST}
+ {4079066400 -25200 1 PDT}
+ {4096602000 -28800 0 PST}
+}
diff --git a/library/tzdata/America/Santarem b/library/tzdata/America/Santarem
new file mode 100644
index 0000000..b6e9264
--- /dev/null
+++ b/library/tzdata/America/Santarem
@@ -0,0 +1,36 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:America/Santarem) {
+ {-9223372036854775808 -13128 0 LMT}
+ {-1767212472 -14400 0 AMT}
+ {-1206954000 -10800 1 AMST}
+ {-1191358800 -14400 0 AMT}
+ {-1175371200 -10800 1 AMST}
+ {-1159822800 -14400 0 AMT}
+ {-633816000 -10800 1 AMST}
+ {-622065600 -14400 0 AMT}
+ {-602280000 -10800 1 AMST}
+ {-591829200 -14400 0 AMT}
+ {-570744000 -10800 1 AMST}
+ {-560206800 -14400 0 AMT}
+ {-539121600 -10800 1 AMST}
+ {-531349200 -14400 0 AMT}
+ {-191361600 -10800 1 AMST}
+ {-184194000 -14400 0 AMT}
+ {-155160000 -10800 1 AMST}
+ {-150066000 -14400 0 AMT}
+ {-128894400 -10800 1 AMST}
+ {-121122000 -14400 0 AMT}
+ {-99950400 -10800 1 AMST}
+ {-89586000 -14400 0 AMT}
+ {-68414400 -10800 1 AMST}
+ {-57963600 -14400 0 AMT}
+ {499752000 -10800 1 AMST}
+ {511239600 -14400 0 AMT}
+ {530596800 -10800 1 AMST}
+ {540270000 -14400 0 AMT}
+ {562132800 -10800 1 AMST}
+ {571201200 -14400 0 AMT}
+ {590036400 -14400 0 AMT}
+ {1214280000 -10800 0 BRT}
+}
diff --git a/library/tzdata/America/Santiago b/library/tzdata/America/Santiago
index b2443b5..44be9f8 100644
--- a/library/tzdata/America/Santiago
+++ b/library/tzdata/America/Santiago
@@ -1,11 +1,13 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Santiago) {
- {-9223372036854775808 -16960 0 LMT}
- {-2524504640 -16960 0 SMT}
- {-1893439040 -18000 0 CLT}
- {-1619982000 -14400 1 CLST}
- {-1593720000 -18000 0 CLT}
+ {-9223372036854775808 -16966 0 LMT}
+ {-2524504634 -16966 0 SMT}
+ {-1893439034 -18000 0 CLT}
+ {-1688410800 -16966 0 SMT}
+ {-1619983034 -14400 0 CLT}
+ {-1593806400 -16966 0 SMT}
+ {-1335986234 -18000 0 CLT}
{-1335985200 -14400 1 CLST}
{-1317585600 -18000 0 CLT}
{-1304362800 -14400 1 CLST}
@@ -16,22 +18,24 @@ set TZData(:America/Santiago) {
{-1222977600 -18000 0 CLT}
{-1209754800 -14400 1 CLST}
{-1191355200 -18000 0 CLT}
- {-1178132400 -14400 0 CLT}
- {-101937600 -10800 1 CLST}
- {-88635600 -14400 0 CLT}
- {-69883200 -10800 1 CLST}
- {-57186000 -14400 0 CLT}
- {-38433600 -10800 1 CLST}
- {-25736400 -14400 0 CLT}
- {-6984000 -10800 1 CLST}
- {6318000 -14400 0 CLT}
+ {-1178132400 -14400 1 CLST}
+ {-870552000 -18000 0 CLT}
+ {-865278000 -14400 1 CLST}
+ {-740520000 -14400 1 CLST}
+ {-736376400 -18000 0 CLT}
+ {-718056000 -18000 0 CLT}
+ {-713646000 -14400 0 CLT}
+ {-36619200 -10800 1 CLST}
+ {-23922000 -14400 0 CLT}
+ {-3355200 -10800 1 CLST}
+ {7527600 -14400 0 CLT}
{24465600 -10800 1 CLST}
{37767600 -14400 0 CLT}
{55915200 -10800 1 CLST}
{69217200 -14400 0 CLT}
{87969600 -10800 1 CLST}
{100666800 -14400 0 CLT}
- {119419200 -10800 1 CLST}
+ {118209600 -10800 1 CLST}
{132116400 -14400 0 CLT}
{150868800 -10800 1 CLST}
{163566000 -14400 0 CLT}
@@ -58,14 +62,14 @@ set TZData(:America/Santiago) {
{498024000 -10800 1 CLST}
{510721200 -14400 0 CLT}
{529473600 -10800 1 CLST}
- {542775600 -14400 0 CLT}
+ {545194800 -14400 0 CLT}
{560923200 -10800 1 CLST}
{574225200 -14400 0 CLT}
- {592372800 -10800 1 CLST}
+ {591768000 -10800 1 CLST}
{605674800 -14400 0 CLT}
{624427200 -10800 1 CLST}
- {637124400 -14400 0 CLT}
- {655876800 -10800 1 CLST}
+ {637729200 -14400 0 CLT}
+ {653457600 -10800 1 CLST}
{668574000 -14400 0 CLT}
{687326400 -10800 1 CLST}
{700628400 -14400 0 CLT}
@@ -78,7 +82,7 @@ set TZData(:America/Santiago) {
{813729600 -10800 1 CLST}
{826426800 -14400 0 CLT}
{845179200 -10800 1 CLST}
- {857876400 -14400 0 CLT}
+ {859690800 -14400 0 CLT}
{876628800 -10800 1 CLST}
{889930800 -14400 0 CLT}
{906868800 -10800 1 CLST}
@@ -100,188 +104,188 @@ set TZData(:America/Santiago) {
{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}
- {1362884400 -14400 0 CLT}
- {1381636800 -10800 1 CLST}
- {1394334000 -14400 0 CLT}
- {1413086400 -10800 1 CLST}
- {1426388400 -14400 0 CLT}
- {1444536000 -10800 1 CLST}
- {1457838000 -14400 0 CLT}
- {1475985600 -10800 1 CLST}
- {1489287600 -14400 0 CLT}
- {1508040000 -10800 1 CLST}
- {1520737200 -14400 0 CLT}
- {1539489600 -10800 1 CLST}
- {1552186800 -14400 0 CLT}
- {1570939200 -10800 1 CLST}
- {1584241200 -14400 0 CLT}
- {1602388800 -10800 1 CLST}
- {1615690800 -14400 0 CLT}
- {1633838400 -10800 1 CLST}
- {1647140400 -14400 0 CLT}
- {1665288000 -10800 1 CLST}
- {1678590000 -14400 0 CLT}
- {1697342400 -10800 1 CLST}
- {1710039600 -14400 0 CLT}
- {1728792000 -10800 1 CLST}
- {1741489200 -14400 0 CLT}
- {1760241600 -10800 1 CLST}
- {1773543600 -14400 0 CLT}
- {1791691200 -10800 1 CLST}
- {1804993200 -14400 0 CLT}
- {1823140800 -10800 1 CLST}
- {1836442800 -14400 0 CLT}
- {1855195200 -10800 1 CLST}
- {1867892400 -14400 0 CLT}
- {1886644800 -10800 1 CLST}
- {1899342000 -14400 0 CLT}
- {1918094400 -10800 1 CLST}
- {1930791600 -14400 0 CLT}
- {1949544000 -10800 1 CLST}
- {1962846000 -14400 0 CLT}
- {1980993600 -10800 1 CLST}
- {1994295600 -14400 0 CLT}
- {2012443200 -10800 1 CLST}
- {2025745200 -14400 0 CLT}
- {2044497600 -10800 1 CLST}
- {2057194800 -14400 0 CLT}
- {2075947200 -10800 1 CLST}
- {2088644400 -14400 0 CLT}
- {2107396800 -10800 1 CLST}
- {2120698800 -14400 0 CLT}
- {2138846400 -10800 1 CLST}
- {2152148400 -14400 0 CLT}
- {2170296000 -10800 1 CLST}
- {2183598000 -14400 0 CLT}
- {2201745600 -10800 1 CLST}
- {2215047600 -14400 0 CLT}
- {2233800000 -10800 1 CLST}
- {2246497200 -14400 0 CLT}
- {2265249600 -10800 1 CLST}
- {2277946800 -14400 0 CLT}
- {2296699200 -10800 1 CLST}
- {2310001200 -14400 0 CLT}
- {2328148800 -10800 1 CLST}
- {2341450800 -14400 0 CLT}
- {2359598400 -10800 1 CLST}
- {2372900400 -14400 0 CLT}
- {2391652800 -10800 1 CLST}
- {2404350000 -14400 0 CLT}
- {2423102400 -10800 1 CLST}
- {2435799600 -14400 0 CLT}
- {2454552000 -10800 1 CLST}
- {2467854000 -14400 0 CLT}
- {2486001600 -10800 1 CLST}
- {2499303600 -14400 0 CLT}
- {2517451200 -10800 1 CLST}
- {2530753200 -14400 0 CLT}
- {2548900800 -10800 1 CLST}
- {2562202800 -14400 0 CLT}
- {2580955200 -10800 1 CLST}
- {2593652400 -14400 0 CLT}
- {2612404800 -10800 1 CLST}
- {2625102000 -14400 0 CLT}
- {2643854400 -10800 1 CLST}
- {2657156400 -14400 0 CLT}
- {2675304000 -10800 1 CLST}
- {2688606000 -14400 0 CLT}
- {2706753600 -10800 1 CLST}
- {2720055600 -14400 0 CLT}
- {2738808000 -10800 1 CLST}
- {2751505200 -14400 0 CLT}
- {2770257600 -10800 1 CLST}
- {2782954800 -14400 0 CLT}
- {2801707200 -10800 1 CLST}
- {2814404400 -14400 0 CLT}
- {2833156800 -10800 1 CLST}
- {2846458800 -14400 0 CLT}
- {2864606400 -10800 1 CLST}
- {2877908400 -14400 0 CLT}
- {2896056000 -10800 1 CLST}
- {2909358000 -14400 0 CLT}
- {2928110400 -10800 1 CLST}
- {2940807600 -14400 0 CLT}
- {2959560000 -10800 1 CLST}
- {2972257200 -14400 0 CLT}
- {2991009600 -10800 1 CLST}
- {3004311600 -14400 0 CLT}
- {3022459200 -10800 1 CLST}
- {3035761200 -14400 0 CLT}
- {3053908800 -10800 1 CLST}
- {3067210800 -14400 0 CLT}
- {3085358400 -10800 1 CLST}
- {3098660400 -14400 0 CLT}
- {3117412800 -10800 1 CLST}
- {3130110000 -14400 0 CLT}
- {3148862400 -10800 1 CLST}
- {3161559600 -14400 0 CLT}
- {3180312000 -10800 1 CLST}
- {3193614000 -14400 0 CLT}
- {3211761600 -10800 1 CLST}
- {3225063600 -14400 0 CLT}
- {3243211200 -10800 1 CLST}
- {3256513200 -14400 0 CLT}
- {3275265600 -10800 1 CLST}
- {3287962800 -14400 0 CLT}
- {3306715200 -10800 1 CLST}
- {3319412400 -14400 0 CLT}
- {3338164800 -10800 1 CLST}
- {3351466800 -14400 0 CLT}
- {3369614400 -10800 1 CLST}
- {3382916400 -14400 0 CLT}
- {3401064000 -10800 1 CLST}
- {3414366000 -14400 0 CLT}
- {3432513600 -10800 1 CLST}
- {3445815600 -14400 0 CLT}
- {3464568000 -10800 1 CLST}
- {3477265200 -14400 0 CLT}
- {3496017600 -10800 1 CLST}
- {3508714800 -14400 0 CLT}
- {3527467200 -10800 1 CLST}
- {3540769200 -14400 0 CLT}
- {3558916800 -10800 1 CLST}
- {3572218800 -14400 0 CLT}
- {3590366400 -10800 1 CLST}
- {3603668400 -14400 0 CLT}
- {3622420800 -10800 1 CLST}
- {3635118000 -14400 0 CLT}
- {3653870400 -10800 1 CLST}
- {3666567600 -14400 0 CLT}
- {3685320000 -10800 1 CLST}
- {3698017200 -14400 0 CLT}
- {3716769600 -10800 1 CLST}
- {3730071600 -14400 0 CLT}
- {3748219200 -10800 1 CLST}
- {3761521200 -14400 0 CLT}
- {3779668800 -10800 1 CLST}
- {3792970800 -14400 0 CLT}
- {3811723200 -10800 1 CLST}
- {3824420400 -14400 0 CLT}
- {3843172800 -10800 1 CLST}
- {3855870000 -14400 0 CLT}
- {3874622400 -10800 1 CLST}
- {3887924400 -14400 0 CLT}
- {3906072000 -10800 1 CLST}
- {3919374000 -14400 0 CLT}
- {3937521600 -10800 1 CLST}
- {3950823600 -14400 0 CLT}
- {3968971200 -10800 1 CLST}
- {3982273200 -14400 0 CLT}
- {4001025600 -10800 1 CLST}
- {4013722800 -14400 0 CLT}
- {4032475200 -10800 1 CLST}
- {4045172400 -14400 0 CLT}
- {4063924800 -10800 1 CLST}
- {4077226800 -14400 0 CLT}
- {4095374400 -10800 1 CLST}
+ {1304823600 -14400 0 CLT}
+ {1313899200 -10800 1 CLST}
+ {1335668400 -14400 0 CLT}
+ {1346558400 -10800 1 CLST}
+ {1367118000 -14400 0 CLT}
+ {1378612800 -10800 1 CLST}
+ {1398567600 -14400 0 CLT}
+ {1410062400 -10800 1 CLST}
+ {1430017200 -14400 0 CLT}
+ {1441512000 -10800 1 CLST}
+ {1461466800 -14400 0 CLT}
+ {1472961600 -10800 1 CLST}
+ {1492916400 -14400 0 CLT}
+ {1504411200 -10800 1 CLST}
+ {1524970800 -14400 0 CLT}
+ {1535860800 -10800 1 CLST}
+ {1556420400 -14400 0 CLT}
+ {1567915200 -10800 1 CLST}
+ {1587870000 -14400 0 CLT}
+ {1599364800 -10800 1 CLST}
+ {1619319600 -14400 0 CLT}
+ {1630814400 -10800 1 CLST}
+ {1650769200 -14400 0 CLT}
+ {1662264000 -10800 1 CLST}
+ {1682218800 -14400 0 CLT}
+ {1693713600 -10800 1 CLST}
+ {1714273200 -14400 0 CLT}
+ {1725768000 -10800 1 CLST}
+ {1745722800 -14400 0 CLT}
+ {1757217600 -10800 1 CLST}
+ {1777172400 -14400 0 CLT}
+ {1788667200 -10800 1 CLST}
+ {1808622000 -14400 0 CLT}
+ {1820116800 -10800 1 CLST}
+ {1840071600 -14400 0 CLT}
+ {1851566400 -10800 1 CLST}
+ {1872126000 -14400 0 CLT}
+ {1883016000 -10800 1 CLST}
+ {1903575600 -14400 0 CLT}
+ {1915070400 -10800 1 CLST}
+ {1935025200 -14400 0 CLT}
+ {1946520000 -10800 1 CLST}
+ {1966474800 -14400 0 CLT}
+ {1977969600 -10800 1 CLST}
+ {1997924400 -14400 0 CLT}
+ {2009419200 -10800 1 CLST}
+ {2029374000 -14400 0 CLT}
+ {2040868800 -10800 1 CLST}
+ {2061428400 -14400 0 CLT}
+ {2072318400 -10800 1 CLST}
+ {2092878000 -14400 0 CLT}
+ {2104372800 -10800 1 CLST}
+ {2124327600 -14400 0 CLT}
+ {2135822400 -10800 1 CLST}
+ {2155777200 -14400 0 CLT}
+ {2167272000 -10800 1 CLST}
+ {2187226800 -14400 0 CLT}
+ {2198721600 -10800 1 CLST}
+ {2219281200 -14400 0 CLT}
+ {2230171200 -10800 1 CLST}
+ {2250730800 -14400 0 CLT}
+ {2262225600 -10800 1 CLST}
+ {2282180400 -14400 0 CLT}
+ {2293675200 -10800 1 CLST}
+ {2313630000 -14400 0 CLT}
+ {2325124800 -10800 1 CLST}
+ {2345079600 -14400 0 CLT}
+ {2356574400 -10800 1 CLST}
+ {2376529200 -14400 0 CLT}
+ {2388024000 -10800 1 CLST}
+ {2408583600 -14400 0 CLT}
+ {2419473600 -10800 1 CLST}
+ {2440033200 -14400 0 CLT}
+ {2451528000 -10800 1 CLST}
+ {2471482800 -14400 0 CLT}
+ {2482977600 -10800 1 CLST}
+ {2502932400 -14400 0 CLT}
+ {2514427200 -10800 1 CLST}
+ {2534382000 -14400 0 CLT}
+ {2545876800 -10800 1 CLST}
+ {2565831600 -14400 0 CLT}
+ {2577326400 -10800 1 CLST}
+ {2597886000 -14400 0 CLT}
+ {2609380800 -10800 1 CLST}
+ {2629335600 -14400 0 CLT}
+ {2640830400 -10800 1 CLST}
+ {2660785200 -14400 0 CLT}
+ {2672280000 -10800 1 CLST}
+ {2692234800 -14400 0 CLT}
+ {2703729600 -10800 1 CLST}
+ {2723684400 -14400 0 CLT}
+ {2735179200 -10800 1 CLST}
+ {2755738800 -14400 0 CLT}
+ {2766628800 -10800 1 CLST}
+ {2787188400 -14400 0 CLT}
+ {2798683200 -10800 1 CLST}
+ {2818638000 -14400 0 CLT}
+ {2830132800 -10800 1 CLST}
+ {2850087600 -14400 0 CLT}
+ {2861582400 -10800 1 CLST}
+ {2881537200 -14400 0 CLT}
+ {2893032000 -10800 1 CLST}
+ {2912986800 -14400 0 CLT}
+ {2924481600 -10800 1 CLST}
+ {2945041200 -14400 0 CLT}
+ {2955931200 -10800 1 CLST}
+ {2976490800 -14400 0 CLT}
+ {2987985600 -10800 1 CLST}
+ {3007940400 -14400 0 CLT}
+ {3019435200 -10800 1 CLST}
+ {3039390000 -14400 0 CLT}
+ {3050884800 -10800 1 CLST}
+ {3070839600 -14400 0 CLT}
+ {3082334400 -10800 1 CLST}
+ {3102894000 -14400 0 CLT}
+ {3113784000 -10800 1 CLST}
+ {3134343600 -14400 0 CLT}
+ {3145838400 -10800 1 CLST}
+ {3165793200 -14400 0 CLT}
+ {3177288000 -10800 1 CLST}
+ {3197242800 -14400 0 CLT}
+ {3208737600 -10800 1 CLST}
+ {3228692400 -14400 0 CLT}
+ {3240187200 -10800 1 CLST}
+ {3260142000 -14400 0 CLT}
+ {3271636800 -10800 1 CLST}
+ {3292196400 -14400 0 CLT}
+ {3303086400 -10800 1 CLST}
+ {3323646000 -14400 0 CLT}
+ {3335140800 -10800 1 CLST}
+ {3355095600 -14400 0 CLT}
+ {3366590400 -10800 1 CLST}
+ {3386545200 -14400 0 CLT}
+ {3398040000 -10800 1 CLST}
+ {3417994800 -14400 0 CLT}
+ {3429489600 -10800 1 CLST}
+ {3449444400 -14400 0 CLT}
+ {3460939200 -10800 1 CLST}
+ {3481498800 -14400 0 CLT}
+ {3492993600 -10800 1 CLST}
+ {3512948400 -14400 0 CLT}
+ {3524443200 -10800 1 CLST}
+ {3544398000 -14400 0 CLT}
+ {3555892800 -10800 1 CLST}
+ {3575847600 -14400 0 CLT}
+ {3587342400 -10800 1 CLST}
+ {3607297200 -14400 0 CLT}
+ {3618792000 -10800 1 CLST}
+ {3639351600 -14400 0 CLT}
+ {3650241600 -10800 1 CLST}
+ {3670801200 -14400 0 CLT}
+ {3682296000 -10800 1 CLST}
+ {3702250800 -14400 0 CLT}
+ {3713745600 -10800 1 CLST}
+ {3733700400 -14400 0 CLT}
+ {3745195200 -10800 1 CLST}
+ {3765150000 -14400 0 CLT}
+ {3776644800 -10800 1 CLST}
+ {3796599600 -14400 0 CLT}
+ {3808094400 -10800 1 CLST}
+ {3828654000 -14400 0 CLT}
+ {3839544000 -10800 1 CLST}
+ {3860103600 -14400 0 CLT}
+ {3871598400 -10800 1 CLST}
+ {3891553200 -14400 0 CLT}
+ {3903048000 -10800 1 CLST}
+ {3923002800 -14400 0 CLT}
+ {3934497600 -10800 1 CLST}
+ {3954452400 -14400 0 CLT}
+ {3965947200 -10800 1 CLST}
+ {3986506800 -14400 0 CLT}
+ {3997396800 -10800 1 CLST}
+ {4017956400 -14400 0 CLT}
+ {4029451200 -10800 1 CLST}
+ {4049406000 -14400 0 CLT}
+ {4060900800 -10800 1 CLST}
+ {4080855600 -14400 0 CLT}
+ {4092350400 -10800 1 CLST}
}
diff --git a/library/tzdata/America/Santo_Domingo b/library/tzdata/America/Santo_Domingo
index 970f0fc..7706918 100644
--- a/library/tzdata/America/Santo_Domingo
+++ b/library/tzdata/America/Santo_Domingo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Santo_Domingo) {
{-9223372036854775808 -16776 0 LMT}
diff --git a/library/tzdata/America/Sao_Paulo b/library/tzdata/America/Sao_Paulo
index ad7cdc8..8d70063 100644
--- a/library/tzdata/America/Sao_Paulo
+++ b/library/tzdata/America/Sao_Paulo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Sao_Paulo) {
{-9223372036854775808 -11188 0 LMT}
@@ -68,9 +68,9 @@ set TZData(:America/Sao_Paulo) {
{1108864800 -10800 0 BRT}
{1129431600 -7200 1 BRST}
{1140314400 -10800 0 BRT}
- {1160881200 -7200 1 BRST}
- {1171764000 -10800 0 BRT}
- {1192935600 -7200 1 BRST}
+ {1162695600 -7200 1 BRST}
+ {1172368800 -10800 0 BRT}
+ {1192330800 -7200 1 BRST}
{1203213600 -10800 0 BRT}
{1224385200 -7200 1 BRST}
{1234663200 -10800 0 BRT}
@@ -79,13 +79,13 @@ set TZData(:America/Sao_Paulo) {
{1287284400 -7200 1 BRST}
{1298167200 -10800 0 BRT}
{1318734000 -7200 1 BRST}
- {1329616800 -10800 0 BRT}
+ {1330221600 -10800 0 BRT}
{1350788400 -7200 1 BRST}
{1361066400 -10800 0 BRT}
{1382238000 -7200 1 BRST}
{1392516000 -10800 0 BRT}
{1413687600 -7200 1 BRST}
- {1423965600 -10800 0 BRT}
+ {1424570400 -10800 0 BRT}
{1445137200 -7200 1 BRST}
{1456020000 -10800 0 BRT}
{1476586800 -7200 1 BRST}
@@ -101,13 +101,13 @@ set TZData(:America/Sao_Paulo) {
{1634439600 -7200 1 BRST}
{1645322400 -10800 0 BRT}
{1665889200 -7200 1 BRST}
- {1676772000 -10800 0 BRT}
+ {1677376800 -10800 0 BRT}
{1697338800 -7200 1 BRST}
{1708221600 -10800 0 BRT}
{1729393200 -7200 1 BRST}
{1739671200 -10800 0 BRT}
{1760842800 -7200 1 BRST}
- {1771120800 -10800 0 BRT}
+ {1771725600 -10800 0 BRT}
{1792292400 -7200 1 BRST}
{1803175200 -10800 0 BRT}
{1823742000 -7200 1 BRST}
@@ -123,13 +123,13 @@ set TZData(:America/Sao_Paulo) {
{1981594800 -7200 1 BRST}
{1992477600 -10800 0 BRT}
{2013044400 -7200 1 BRST}
- {2023927200 -10800 0 BRT}
+ {2024532000 -10800 0 BRT}
{2044494000 -7200 1 BRST}
{2055376800 -10800 0 BRT}
{2076548400 -7200 1 BRST}
{2086826400 -10800 0 BRT}
{2107998000 -7200 1 BRST}
- {2118276000 -10800 0 BRT}
+ {2118880800 -10800 0 BRT}
{2139447600 -7200 1 BRST}
{2150330400 -10800 0 BRT}
{2170897200 -7200 1 BRST}
diff --git a/library/tzdata/America/Scoresbysund b/library/tzdata/America/Scoresbysund
index b295b9e..74a332c 100644
--- a/library/tzdata/America/Scoresbysund
+++ b/library/tzdata/America/Scoresbysund
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Scoresbysund) {
- {-9223372036854775808 -5340 0 LMT}
- {-1686090660 -7200 0 CGT}
+ {-9223372036854775808 -5272 0 LMT}
+ {-1686090728 -7200 0 CGT}
{323841600 -3600 0 CGST}
- {338954400 -7200 0 CGT}
+ {338961600 -7200 0 CGT}
{354679200 0 0 EGST}
{370400400 -3600 0 EGT}
{386125200 0 1 EGST}
diff --git a/library/tzdata/America/Shiprock b/library/tzdata/America/Shiprock
index 9fb1aaf..995d25d 100644
--- a/library/tzdata/America/Shiprock
+++ b/library/tzdata/America/Shiprock
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Denver)]} {
LoadTimeZoneFile America/Denver
}
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_Barthelemy b/library/tzdata/America/St_Barthelemy
new file mode 100644
index 0000000..46bc287
--- /dev/null
+++ b/library/tzdata/America/St_Barthelemy
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
+}
+set TZData(:America/St_Barthelemy) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Johns b/library/tzdata/America/St_Johns
index a477b24..1492961 100644
--- a/library/tzdata/America/St_Johns
+++ b/library/tzdata/America/St_Johns
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/St_Johns) {
{-9223372036854775808 -12652 0 LMT}
@@ -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}
@@ -182,190 +182,191 @@ set TZData(:America/St_Johns) {
{1130639460 -12600 0 NST}
{1143948660 -9000 1 NDT}
{1162089060 -12600 0 NST}
- {1175398260 -9000 1 NDT}
- {1193538660 -12600 0 NST}
- {1207452660 -9000 1 NDT}
- {1224988260 -12600 0 NST}
- {1238902260 -9000 1 NDT}
- {1256437860 -12600 0 NST}
- {1270351860 -9000 1 NDT}
- {1288492260 -12600 0 NST}
- {1301801460 -9000 1 NDT}
- {1319941860 -12600 0 NST}
- {1333251060 -9000 1 NDT}
- {1351391460 -12600 0 NST}
- {1365305460 -9000 1 NDT}
- {1382841060 -12600 0 NST}
- {1396755060 -9000 1 NDT}
- {1414290660 -12600 0 NST}
- {1428204660 -9000 1 NDT}
- {1445740260 -12600 0 NST}
- {1459654260 -9000 1 NDT}
- {1477794660 -12600 0 NST}
- {1491103860 -9000 1 NDT}
- {1509244260 -12600 0 NST}
- {1522553460 -9000 1 NDT}
- {1540693860 -12600 0 NST}
- {1554607860 -9000 1 NDT}
- {1572143460 -12600 0 NST}
- {1586057460 -9000 1 NDT}
- {1603593060 -12600 0 NST}
- {1617507060 -9000 1 NDT}
- {1635647460 -12600 0 NST}
- {1648956660 -9000 1 NDT}
- {1667097060 -12600 0 NST}
- {1680406260 -9000 1 NDT}
- {1698546660 -12600 0 NST}
- {1712460660 -9000 1 NDT}
- {1729996260 -12600 0 NST}
- {1743910260 -9000 1 NDT}
- {1761445860 -12600 0 NST}
- {1775359860 -9000 1 NDT}
- {1792895460 -12600 0 NST}
- {1806809460 -9000 1 NDT}
- {1824949860 -12600 0 NST}
- {1838259060 -9000 1 NDT}
- {1856399460 -12600 0 NST}
- {1869708660 -9000 1 NDT}
- {1887849060 -12600 0 NST}
- {1901763060 -9000 1 NDT}
- {1919298660 -12600 0 NST}
- {1933212660 -9000 1 NDT}
- {1950748260 -12600 0 NST}
- {1964662260 -9000 1 NDT}
- {1982802660 -12600 0 NST}
- {1996111860 -9000 1 NDT}
- {2014252260 -12600 0 NST}
- {2027561460 -9000 1 NDT}
- {2045701860 -12600 0 NST}
- {2059011060 -9000 1 NDT}
- {2077151460 -12600 0 NST}
- {2091065460 -9000 1 NDT}
- {2108601060 -12600 0 NST}
- {2122515060 -9000 1 NDT}
- {2140050660 -12600 0 NST}
- {2153964660 -9000 1 NDT}
- {2172105060 -12600 0 NST}
- {2185414260 -9000 1 NDT}
- {2203554660 -12600 0 NST}
- {2216863860 -9000 1 NDT}
- {2235004260 -12600 0 NST}
- {2248918260 -9000 1 NDT}
- {2266453860 -12600 0 NST}
- {2280367860 -9000 1 NDT}
- {2297903460 -12600 0 NST}
- {2311817460 -9000 1 NDT}
- {2329353060 -12600 0 NST}
- {2343267060 -9000 1 NDT}
- {2361407460 -12600 0 NST}
- {2374716660 -9000 1 NDT}
- {2392857060 -12600 0 NST}
- {2406166260 -9000 1 NDT}
- {2424306660 -12600 0 NST}
- {2438220660 -9000 1 NDT}
- {2455756260 -12600 0 NST}
- {2469670260 -9000 1 NDT}
- {2487205860 -12600 0 NST}
- {2501119860 -9000 1 NDT}
- {2519260260 -12600 0 NST}
- {2532569460 -9000 1 NDT}
- {2550709860 -12600 0 NST}
- {2564019060 -9000 1 NDT}
- {2582159460 -12600 0 NST}
- {2596073460 -9000 1 NDT}
- {2613609060 -12600 0 NST}
- {2627523060 -9000 1 NDT}
- {2645058660 -12600 0 NST}
- {2658972660 -9000 1 NDT}
- {2676508260 -12600 0 NST}
- {2690422260 -9000 1 NDT}
- {2708562660 -12600 0 NST}
- {2721871860 -9000 1 NDT}
- {2740012260 -12600 0 NST}
- {2753321460 -9000 1 NDT}
- {2771461860 -12600 0 NST}
- {2785375860 -9000 1 NDT}
- {2802911460 -12600 0 NST}
- {2816825460 -9000 1 NDT}
- {2834361060 -12600 0 NST}
- {2848275060 -9000 1 NDT}
- {2866415460 -12600 0 NST}
- {2879724660 -9000 1 NDT}
- {2897865060 -12600 0 NST}
- {2911174260 -9000 1 NDT}
- {2929314660 -12600 0 NST}
- {2942623860 -9000 1 NDT}
- {2960764260 -12600 0 NST}
- {2974678260 -9000 1 NDT}
- {2992213860 -12600 0 NST}
- {3006127860 -9000 1 NDT}
- {3023663460 -12600 0 NST}
- {3037577460 -9000 1 NDT}
- {3055717860 -12600 0 NST}
- {3069027060 -9000 1 NDT}
- {3087167460 -12600 0 NST}
- {3100476660 -9000 1 NDT}
- {3118617060 -12600 0 NST}
- {3132531060 -9000 1 NDT}
- {3150066660 -12600 0 NST}
- {3163980660 -9000 1 NDT}
- {3181516260 -12600 0 NST}
- {3195430260 -9000 1 NDT}
- {3212965860 -12600 0 NST}
- {3226879860 -9000 1 NDT}
- {3245020260 -12600 0 NST}
- {3258329460 -9000 1 NDT}
- {3276469860 -12600 0 NST}
- {3289779060 -9000 1 NDT}
- {3307919460 -12600 0 NST}
- {3321833460 -9000 1 NDT}
- {3339369060 -12600 0 NST}
- {3353283060 -9000 1 NDT}
- {3370818660 -12600 0 NST}
- {3384732660 -9000 1 NDT}
- {3402873060 -12600 0 NST}
- {3416182260 -9000 1 NDT}
- {3434322660 -12600 0 NST}
- {3447631860 -9000 1 NDT}
- {3465772260 -12600 0 NST}
- {3479686260 -9000 1 NDT}
- {3497221860 -12600 0 NST}
- {3511135860 -9000 1 NDT}
- {3528671460 -12600 0 NST}
- {3542585460 -9000 1 NDT}
- {3560121060 -12600 0 NST}
- {3574035060 -9000 1 NDT}
- {3592175460 -12600 0 NST}
- {3605484660 -9000 1 NDT}
- {3623625060 -12600 0 NST}
- {3636934260 -9000 1 NDT}
- {3655074660 -12600 0 NST}
- {3668988660 -9000 1 NDT}
- {3686524260 -12600 0 NST}
- {3700438260 -9000 1 NDT}
- {3717973860 -12600 0 NST}
- {3731887860 -9000 1 NDT}
- {3750028260 -12600 0 NST}
- {3763337460 -9000 1 NDT}
- {3781477860 -12600 0 NST}
- {3794787060 -9000 1 NDT}
- {3812927460 -12600 0 NST}
- {3826236660 -9000 1 NDT}
- {3844377060 -12600 0 NST}
- {3858291060 -9000 1 NDT}
- {3875826660 -12600 0 NST}
- {3889740660 -9000 1 NDT}
- {3907276260 -12600 0 NST}
- {3921190260 -9000 1 NDT}
- {3939330660 -12600 0 NST}
- {3952639860 -9000 1 NDT}
- {3970780260 -12600 0 NST}
- {3984089460 -9000 1 NDT}
- {4002229860 -12600 0 NST}
- {4016143860 -9000 1 NDT}
- {4033679460 -12600 0 NST}
- {4047593460 -9000 1 NDT}
- {4065129060 -12600 0 NST}
- {4079043060 -9000 1 NDT}
- {4096578660 -12600 0 NST}
+ {1173583860 -9000 1 NDT}
+ {1194143460 -12600 0 NST}
+ {1205033460 -9000 1 NDT}
+ {1225593060 -12600 0 NST}
+ {1236483060 -9000 1 NDT}
+ {1257042660 -12600 0 NST}
+ {1268537460 -9000 1 NDT}
+ {1289097060 -12600 0 NST}
+ {1299987060 -9000 1 NDT}
+ {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/St_Kitts b/library/tzdata/America/St_Kitts
index 3648b00..6ad7f04 100644
--- a/library/tzdata/America/St_Kitts
+++ b/library/tzdata/America/St_Kitts
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Kitts) {
- {-9223372036854775808 -15052 0 LMT}
- {-1825098548 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/St_Kitts) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Lucia b/library/tzdata/America/St_Lucia
index 5e63f0c..e479b31 100644
--- a/library/tzdata/America/St_Lucia
+++ b/library/tzdata/America/St_Lucia
@@ -1,7 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Lucia) {
- {-9223372036854775808 -14640 0 LMT}
- {-2524506960 -14640 0 CMT}
- {-1830369360 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/St_Lucia) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Thomas b/library/tzdata/America/St_Thomas
index d6874ea..24698b8 100644
--- a/library/tzdata/America/St_Thomas
+++ b/library/tzdata/America/St_Thomas
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Thomas) {
- {-9223372036854775808 -15584 0 LMT}
- {-1846266016 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/St_Thomas) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Vincent b/library/tzdata/America/St_Vincent
index 4e5fde3..e3b32fb 100644
--- a/library/tzdata/America/St_Vincent
+++ b/library/tzdata/America/St_Vincent
@@ -1,7 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Vincent) {
- {-9223372036854775808 -14696 0 LMT}
- {-2524506904 -14696 0 KMT}
- {-1830369304 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/St_Vincent) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Swift_Current b/library/tzdata/America/Swift_Current
index 8918a4b..ad07762 100644
--- a/library/tzdata/America/Swift_Current
+++ b/library/tzdata/America/Swift_Current
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/Tegucigalpa b/library/tzdata/America/Tegucigalpa
index 92eef95..050661e 100644
--- a/library/tzdata/America/Tegucigalpa
+++ b/library/tzdata/America/Tegucigalpa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Tegucigalpa) {
{-9223372036854775808 -20932 0 LMT}
@@ -7,4 +7,6 @@ set TZData(:America/Tegucigalpa) {
{559717200 -21600 0 CST}
{578469600 -18000 1 CDT}
{591166800 -21600 0 CST}
+ {1146981600 -18000 1 CDT}
+ {1154926800 -21600 0 CST}
}
diff --git a/library/tzdata/America/Thule b/library/tzdata/America/Thule
index a71eb27..0aaf9a1 100644
--- a/library/tzdata/America/Thule
+++ b/library/tzdata/America/Thule
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Thule) {
{-9223372036854775808 -16508 0 LMT}
@@ -35,190 +35,190 @@ set TZData(:America/Thule) {
{1130648400 -14400 0 AST}
{1143957600 -10800 1 ADT}
{1162098000 -14400 0 AST}
- {1175407200 -10800 1 ADT}
- {1193547600 -14400 0 AST}
- {1207461600 -10800 1 ADT}
- {1224997200 -14400 0 AST}
- {1238911200 -10800 1 ADT}
- {1256446800 -14400 0 AST}
- {1270360800 -10800 1 ADT}
- {1288501200 -14400 0 AST}
- {1301810400 -10800 1 ADT}
- {1319950800 -14400 0 AST}
- {1333260000 -10800 1 ADT}
- {1351400400 -14400 0 AST}
- {1365314400 -10800 1 ADT}
- {1382850000 -14400 0 AST}
- {1396764000 -10800 1 ADT}
- {1414299600 -14400 0 AST}
- {1428213600 -10800 1 ADT}
- {1445749200 -14400 0 AST}
- {1459663200 -10800 1 ADT}
- {1477803600 -14400 0 AST}
- {1491112800 -10800 1 ADT}
- {1509253200 -14400 0 AST}
- {1522562400 -10800 1 ADT}
- {1540702800 -14400 0 AST}
- {1554616800 -10800 1 ADT}
- {1572152400 -14400 0 AST}
- {1586066400 -10800 1 ADT}
- {1603602000 -14400 0 AST}
- {1617516000 -10800 1 ADT}
- {1635656400 -14400 0 AST}
- {1648965600 -10800 1 ADT}
- {1667106000 -14400 0 AST}
- {1680415200 -10800 1 ADT}
- {1698555600 -14400 0 AST}
- {1712469600 -10800 1 ADT}
- {1730005200 -14400 0 AST}
- {1743919200 -10800 1 ADT}
- {1761454800 -14400 0 AST}
- {1775368800 -10800 1 ADT}
- {1792904400 -14400 0 AST}
- {1806818400 -10800 1 ADT}
- {1824958800 -14400 0 AST}
- {1838268000 -10800 1 ADT}
- {1856408400 -14400 0 AST}
- {1869717600 -10800 1 ADT}
- {1887858000 -14400 0 AST}
- {1901772000 -10800 1 ADT}
- {1919307600 -14400 0 AST}
- {1933221600 -10800 1 ADT}
- {1950757200 -14400 0 AST}
- {1964671200 -10800 1 ADT}
- {1982811600 -14400 0 AST}
- {1996120800 -10800 1 ADT}
- {2014261200 -14400 0 AST}
- {2027570400 -10800 1 ADT}
- {2045710800 -14400 0 AST}
- {2059020000 -10800 1 ADT}
- {2077160400 -14400 0 AST}
- {2091074400 -10800 1 ADT}
- {2108610000 -14400 0 AST}
- {2122524000 -10800 1 ADT}
- {2140059600 -14400 0 AST}
- {2153973600 -10800 1 ADT}
- {2172114000 -14400 0 AST}
- {2185423200 -10800 1 ADT}
- {2203563600 -14400 0 AST}
- {2216872800 -10800 1 ADT}
- {2235013200 -14400 0 AST}
- {2248927200 -10800 1 ADT}
- {2266462800 -14400 0 AST}
- {2280376800 -10800 1 ADT}
- {2297912400 -14400 0 AST}
- {2311826400 -10800 1 ADT}
- {2329362000 -14400 0 AST}
- {2343276000 -10800 1 ADT}
- {2361416400 -14400 0 AST}
- {2374725600 -10800 1 ADT}
- {2392866000 -14400 0 AST}
- {2406175200 -10800 1 ADT}
- {2424315600 -14400 0 AST}
- {2438229600 -10800 1 ADT}
- {2455765200 -14400 0 AST}
- {2469679200 -10800 1 ADT}
- {2487214800 -14400 0 AST}
- {2501128800 -10800 1 ADT}
- {2519269200 -14400 0 AST}
- {2532578400 -10800 1 ADT}
- {2550718800 -14400 0 AST}
- {2564028000 -10800 1 ADT}
- {2582168400 -14400 0 AST}
- {2596082400 -10800 1 ADT}
- {2613618000 -14400 0 AST}
- {2627532000 -10800 1 ADT}
- {2645067600 -14400 0 AST}
- {2658981600 -10800 1 ADT}
- {2676517200 -14400 0 AST}
- {2690431200 -10800 1 ADT}
- {2708571600 -14400 0 AST}
- {2721880800 -10800 1 ADT}
- {2740021200 -14400 0 AST}
- {2753330400 -10800 1 ADT}
- {2771470800 -14400 0 AST}
- {2785384800 -10800 1 ADT}
- {2802920400 -14400 0 AST}
- {2816834400 -10800 1 ADT}
- {2834370000 -14400 0 AST}
- {2848284000 -10800 1 ADT}
- {2866424400 -14400 0 AST}
- {2879733600 -10800 1 ADT}
- {2897874000 -14400 0 AST}
- {2911183200 -10800 1 ADT}
- {2929323600 -14400 0 AST}
- {2942632800 -10800 1 ADT}
- {2960773200 -14400 0 AST}
- {2974687200 -10800 1 ADT}
- {2992222800 -14400 0 AST}
- {3006136800 -10800 1 ADT}
- {3023672400 -14400 0 AST}
- {3037586400 -10800 1 ADT}
- {3055726800 -14400 0 AST}
- {3069036000 -10800 1 ADT}
- {3087176400 -14400 0 AST}
- {3100485600 -10800 1 ADT}
- {3118626000 -14400 0 AST}
- {3132540000 -10800 1 ADT}
- {3150075600 -14400 0 AST}
- {3163989600 -10800 1 ADT}
- {3181525200 -14400 0 AST}
- {3195439200 -10800 1 ADT}
- {3212974800 -14400 0 AST}
- {3226888800 -10800 1 ADT}
- {3245029200 -14400 0 AST}
- {3258338400 -10800 1 ADT}
- {3276478800 -14400 0 AST}
- {3289788000 -10800 1 ADT}
- {3307928400 -14400 0 AST}
- {3321842400 -10800 1 ADT}
- {3339378000 -14400 0 AST}
- {3353292000 -10800 1 ADT}
- {3370827600 -14400 0 AST}
- {3384741600 -10800 1 ADT}
- {3402882000 -14400 0 AST}
- {3416191200 -10800 1 ADT}
- {3434331600 -14400 0 AST}
- {3447640800 -10800 1 ADT}
- {3465781200 -14400 0 AST}
- {3479695200 -10800 1 ADT}
- {3497230800 -14400 0 AST}
- {3511144800 -10800 1 ADT}
- {3528680400 -14400 0 AST}
- {3542594400 -10800 1 ADT}
- {3560130000 -14400 0 AST}
- {3574044000 -10800 1 ADT}
- {3592184400 -14400 0 AST}
- {3605493600 -10800 1 ADT}
- {3623634000 -14400 0 AST}
- {3636943200 -10800 1 ADT}
- {3655083600 -14400 0 AST}
- {3668997600 -10800 1 ADT}
- {3686533200 -14400 0 AST}
- {3700447200 -10800 1 ADT}
- {3717982800 -14400 0 AST}
- {3731896800 -10800 1 ADT}
- {3750037200 -14400 0 AST}
- {3763346400 -10800 1 ADT}
- {3781486800 -14400 0 AST}
- {3794796000 -10800 1 ADT}
- {3812936400 -14400 0 AST}
- {3826245600 -10800 1 ADT}
- {3844386000 -14400 0 AST}
- {3858300000 -10800 1 ADT}
- {3875835600 -14400 0 AST}
- {3889749600 -10800 1 ADT}
- {3907285200 -14400 0 AST}
- {3921199200 -10800 1 ADT}
- {3939339600 -14400 0 AST}
- {3952648800 -10800 1 ADT}
- {3970789200 -14400 0 AST}
- {3984098400 -10800 1 ADT}
- {4002238800 -14400 0 AST}
- {4016152800 -10800 1 ADT}
- {4033688400 -14400 0 AST}
- {4047602400 -10800 1 ADT}
- {4065138000 -14400 0 AST}
- {4079052000 -10800 1 ADT}
- {4096587600 -14400 0 AST}
+ {1173592800 -10800 1 ADT}
+ {1194152400 -14400 0 AST}
+ {1205042400 -10800 1 ADT}
+ {1225602000 -14400 0 AST}
+ {1236492000 -10800 1 ADT}
+ {1257051600 -14400 0 AST}
+ {1268546400 -10800 1 ADT}
+ {1289106000 -14400 0 AST}
+ {1299996000 -10800 1 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/Thunder_Bay b/library/tzdata/America/Thunder_Bay
index 2611434..8a454be 100644
--- a/library/tzdata/America/Thunder_Bay
+++ b/library/tzdata/America/Thunder_Bay
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Thunder_Bay) {
{-9223372036854775808 -21420 0 LMT}
@@ -83,190 +83,190 @@ set TZData(:America/Thunder_Bay) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Tijuana b/library/tzdata/America/Tijuana
index ff394e2..6118cde 100644
--- a/library/tzdata/America/Tijuana
+++ b/library/tzdata/America/Tijuana
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Tijuana) {
{-9223372036854775808 -28084 0 LMT}
@@ -9,6 +9,7 @@ set TZData(:America/Tijuana) {
{-1222963200 -25200 1 PDT}
{-1207242000 -28800 0 PST}
{-873820800 -25200 1 PWT}
+ {-769395600 -25200 1 PPT}
{-761677200 -28800 0 PST}
{-686073600 -25200 1 PDT}
{-661539600 -28800 0 PST}
@@ -100,184 +101,185 @@ set TZData(:America/Tijuana) {
{1225011600 -28800 0 PST}
{1238925600 -25200 1 PDT}
{1256461200 -28800 0 PST}
- {1270375200 -25200 1 PDT}
- {1288515600 -28800 0 PST}
- {1301824800 -25200 1 PDT}
- {1319965200 -28800 0 PST}
- {1333274400 -25200 1 PDT}
- {1351414800 -28800 0 PST}
- {1365328800 -25200 1 PDT}
- {1382864400 -28800 0 PST}
- {1396778400 -25200 1 PDT}
- {1414314000 -28800 0 PST}
- {1428228000 -25200 1 PDT}
- {1445763600 -28800 0 PST}
- {1459677600 -25200 1 PDT}
- {1477818000 -28800 0 PST}
- {1491127200 -25200 1 PDT}
- {1509267600 -28800 0 PST}
- {1522576800 -25200 1 PDT}
- {1540717200 -28800 0 PST}
- {1554631200 -25200 1 PDT}
- {1572166800 -28800 0 PST}
- {1586080800 -25200 1 PDT}
- {1603616400 -28800 0 PST}
- {1617530400 -25200 1 PDT}
- {1635670800 -28800 0 PST}
- {1648980000 -25200 1 PDT}
- {1667120400 -28800 0 PST}
- {1680429600 -25200 1 PDT}
- {1698570000 -28800 0 PST}
- {1712484000 -25200 1 PDT}
- {1730019600 -28800 0 PST}
- {1743933600 -25200 1 PDT}
- {1761469200 -28800 0 PST}
- {1775383200 -25200 1 PDT}
- {1792918800 -28800 0 PST}
- {1806832800 -25200 1 PDT}
- {1824973200 -28800 0 PST}
- {1838282400 -25200 1 PDT}
- {1856422800 -28800 0 PST}
- {1869732000 -25200 1 PDT}
- {1887872400 -28800 0 PST}
- {1901786400 -25200 1 PDT}
- {1919322000 -28800 0 PST}
- {1933236000 -25200 1 PDT}
- {1950771600 -28800 0 PST}
- {1964685600 -25200 1 PDT}
- {1982826000 -28800 0 PST}
- {1996135200 -25200 1 PDT}
- {2014275600 -28800 0 PST}
- {2027584800 -25200 1 PDT}
- {2045725200 -28800 0 PST}
- {2059034400 -25200 1 PDT}
- {2077174800 -28800 0 PST}
- {2091088800 -25200 1 PDT}
- {2108624400 -28800 0 PST}
- {2122538400 -25200 1 PDT}
- {2140074000 -28800 0 PST}
- {2153988000 -25200 1 PDT}
- {2172128400 -28800 0 PST}
- {2185437600 -25200 1 PDT}
- {2203578000 -28800 0 PST}
- {2216887200 -25200 1 PDT}
- {2235027600 -28800 0 PST}
- {2248941600 -25200 1 PDT}
- {2266477200 -28800 0 PST}
- {2280391200 -25200 1 PDT}
- {2297926800 -28800 0 PST}
- {2311840800 -25200 1 PDT}
- {2329376400 -28800 0 PST}
- {2343290400 -25200 1 PDT}
- {2361430800 -28800 0 PST}
- {2374740000 -25200 1 PDT}
- {2392880400 -28800 0 PST}
- {2406189600 -25200 1 PDT}
- {2424330000 -28800 0 PST}
- {2438244000 -25200 1 PDT}
- {2455779600 -28800 0 PST}
- {2469693600 -25200 1 PDT}
- {2487229200 -28800 0 PST}
- {2501143200 -25200 1 PDT}
- {2519283600 -28800 0 PST}
- {2532592800 -25200 1 PDT}
- {2550733200 -28800 0 PST}
- {2564042400 -25200 1 PDT}
- {2582182800 -28800 0 PST}
- {2596096800 -25200 1 PDT}
- {2613632400 -28800 0 PST}
- {2627546400 -25200 1 PDT}
- {2645082000 -28800 0 PST}
- {2658996000 -25200 1 PDT}
- {2676531600 -28800 0 PST}
- {2690445600 -25200 1 PDT}
- {2708586000 -28800 0 PST}
- {2721895200 -25200 1 PDT}
- {2740035600 -28800 0 PST}
- {2753344800 -25200 1 PDT}
- {2771485200 -28800 0 PST}
- {2785399200 -25200 1 PDT}
- {2802934800 -28800 0 PST}
- {2816848800 -25200 1 PDT}
- {2834384400 -28800 0 PST}
- {2848298400 -25200 1 PDT}
- {2866438800 -28800 0 PST}
- {2879748000 -25200 1 PDT}
- {2897888400 -28800 0 PST}
- {2911197600 -25200 1 PDT}
- {2929338000 -28800 0 PST}
- {2942647200 -25200 1 PDT}
- {2960787600 -28800 0 PST}
- {2974701600 -25200 1 PDT}
- {2992237200 -28800 0 PST}
- {3006151200 -25200 1 PDT}
- {3023686800 -28800 0 PST}
- {3037600800 -25200 1 PDT}
- {3055741200 -28800 0 PST}
- {3069050400 -25200 1 PDT}
- {3087190800 -28800 0 PST}
- {3100500000 -25200 1 PDT}
- {3118640400 -28800 0 PST}
- {3132554400 -25200 1 PDT}
- {3150090000 -28800 0 PST}
- {3164004000 -25200 1 PDT}
- {3181539600 -28800 0 PST}
- {3195453600 -25200 1 PDT}
- {3212989200 -28800 0 PST}
- {3226903200 -25200 1 PDT}
- {3245043600 -28800 0 PST}
- {3258352800 -25200 1 PDT}
- {3276493200 -28800 0 PST}
- {3289802400 -25200 1 PDT}
- {3307942800 -28800 0 PST}
- {3321856800 -25200 1 PDT}
- {3339392400 -28800 0 PST}
- {3353306400 -25200 1 PDT}
- {3370842000 -28800 0 PST}
- {3384756000 -25200 1 PDT}
- {3402896400 -28800 0 PST}
- {3416205600 -25200 1 PDT}
- {3434346000 -28800 0 PST}
- {3447655200 -25200 1 PDT}
- {3465795600 -28800 0 PST}
- {3479709600 -25200 1 PDT}
- {3497245200 -28800 0 PST}
- {3511159200 -25200 1 PDT}
- {3528694800 -28800 0 PST}
- {3542608800 -25200 1 PDT}
- {3560144400 -28800 0 PST}
- {3574058400 -25200 1 PDT}
- {3592198800 -28800 0 PST}
- {3605508000 -25200 1 PDT}
- {3623648400 -28800 0 PST}
- {3636957600 -25200 1 PDT}
- {3655098000 -28800 0 PST}
- {3669012000 -25200 1 PDT}
- {3686547600 -28800 0 PST}
- {3700461600 -25200 1 PDT}
- {3717997200 -28800 0 PST}
- {3731911200 -25200 1 PDT}
- {3750051600 -28800 0 PST}
- {3763360800 -25200 1 PDT}
- {3781501200 -28800 0 PST}
- {3794810400 -25200 1 PDT}
- {3812950800 -28800 0 PST}
- {3826260000 -25200 1 PDT}
- {3844400400 -28800 0 PST}
- {3858314400 -25200 1 PDT}
- {3875850000 -28800 0 PST}
- {3889764000 -25200 1 PDT}
- {3907299600 -28800 0 PST}
- {3921213600 -25200 1 PDT}
- {3939354000 -28800 0 PST}
- {3952663200 -25200 1 PDT}
- {3970803600 -28800 0 PST}
- {3984112800 -25200 1 PDT}
- {4002253200 -28800 0 PST}
- {4016167200 -25200 1 PDT}
- {4033702800 -28800 0 PST}
- {4047616800 -25200 1 PDT}
- {4065152400 -28800 0 PST}
- {4079066400 -25200 1 PDT}
- {4096602000 -28800 0 PST}
+ {1262332800 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
diff --git a/library/tzdata/America/Toronto b/library/tzdata/America/Toronto
index b67e25f..09bf786 100644
--- a/library/tzdata/America/Toronto
+++ b/library/tzdata/America/Toronto
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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}
@@ -49,8 +49,7 @@ set TZData(:America/Toronto) {
{-968000400 -14400 1 EDT}
{-955303200 -18000 0 EST}
{-936550800 -14400 1 EDT}
- {-880236000 -14400 0 EST}
- {-880221600 -14400 1 EWT}
+ {-880218000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
{-765396000 -18000 0 EST}
{-757364400 -18000 0 EST}
@@ -177,190 +176,190 @@ set TZData(:America/Toronto) {
{1130652000 -18000 0 EST}
{1143961200 -14400 1 EDT}
{1162101600 -18000 0 EST}
- {1175410800 -14400 1 EDT}
- {1193551200 -18000 0 EST}
- {1207465200 -14400 1 EDT}
- {1225000800 -18000 0 EST}
- {1238914800 -14400 1 EDT}
- {1256450400 -18000 0 EST}
- {1270364400 -14400 1 EDT}
- {1288504800 -18000 0 EST}
- {1301814000 -14400 1 EDT}
- {1319954400 -18000 0 EST}
- {1333263600 -14400 1 EDT}
- {1351404000 -18000 0 EST}
- {1365318000 -14400 1 EDT}
- {1382853600 -18000 0 EST}
- {1396767600 -14400 1 EDT}
- {1414303200 -18000 0 EST}
- {1428217200 -14400 1 EDT}
- {1445752800 -18000 0 EST}
- {1459666800 -14400 1 EDT}
- {1477807200 -18000 0 EST}
- {1491116400 -14400 1 EDT}
- {1509256800 -18000 0 EST}
- {1522566000 -14400 1 EDT}
- {1540706400 -18000 0 EST}
- {1554620400 -14400 1 EDT}
- {1572156000 -18000 0 EST}
- {1586070000 -14400 1 EDT}
- {1603605600 -18000 0 EST}
- {1617519600 -14400 1 EDT}
- {1635660000 -18000 0 EST}
- {1648969200 -14400 1 EDT}
- {1667109600 -18000 0 EST}
- {1680418800 -14400 1 EDT}
- {1698559200 -18000 0 EST}
- {1712473200 -14400 1 EDT}
- {1730008800 -18000 0 EST}
- {1743922800 -14400 1 EDT}
- {1761458400 -18000 0 EST}
- {1775372400 -14400 1 EDT}
- {1792908000 -18000 0 EST}
- {1806822000 -14400 1 EDT}
- {1824962400 -18000 0 EST}
- {1838271600 -14400 1 EDT}
- {1856412000 -18000 0 EST}
- {1869721200 -14400 1 EDT}
- {1887861600 -18000 0 EST}
- {1901775600 -14400 1 EDT}
- {1919311200 -18000 0 EST}
- {1933225200 -14400 1 EDT}
- {1950760800 -18000 0 EST}
- {1964674800 -14400 1 EDT}
- {1982815200 -18000 0 EST}
- {1996124400 -14400 1 EDT}
- {2014264800 -18000 0 EST}
- {2027574000 -14400 1 EDT}
- {2045714400 -18000 0 EST}
- {2059023600 -14400 1 EDT}
- {2077164000 -18000 0 EST}
- {2091078000 -14400 1 EDT}
- {2108613600 -18000 0 EST}
- {2122527600 -14400 1 EDT}
- {2140063200 -18000 0 EST}
- {2153977200 -14400 1 EDT}
- {2172117600 -18000 0 EST}
- {2185426800 -14400 1 EDT}
- {2203567200 -18000 0 EST}
- {2216876400 -14400 1 EDT}
- {2235016800 -18000 0 EST}
- {2248930800 -14400 1 EDT}
- {2266466400 -18000 0 EST}
- {2280380400 -14400 1 EDT}
- {2297916000 -18000 0 EST}
- {2311830000 -14400 1 EDT}
- {2329365600 -18000 0 EST}
- {2343279600 -14400 1 EDT}
- {2361420000 -18000 0 EST}
- {2374729200 -14400 1 EDT}
- {2392869600 -18000 0 EST}
- {2406178800 -14400 1 EDT}
- {2424319200 -18000 0 EST}
- {2438233200 -14400 1 EDT}
- {2455768800 -18000 0 EST}
- {2469682800 -14400 1 EDT}
- {2487218400 -18000 0 EST}
- {2501132400 -14400 1 EDT}
- {2519272800 -18000 0 EST}
- {2532582000 -14400 1 EDT}
- {2550722400 -18000 0 EST}
- {2564031600 -14400 1 EDT}
- {2582172000 -18000 0 EST}
- {2596086000 -14400 1 EDT}
- {2613621600 -18000 0 EST}
- {2627535600 -14400 1 EDT}
- {2645071200 -18000 0 EST}
- {2658985200 -14400 1 EDT}
- {2676520800 -18000 0 EST}
- {2690434800 -14400 1 EDT}
- {2708575200 -18000 0 EST}
- {2721884400 -14400 1 EDT}
- {2740024800 -18000 0 EST}
- {2753334000 -14400 1 EDT}
- {2771474400 -18000 0 EST}
- {2785388400 -14400 1 EDT}
- {2802924000 -18000 0 EST}
- {2816838000 -14400 1 EDT}
- {2834373600 -18000 0 EST}
- {2848287600 -14400 1 EDT}
- {2866428000 -18000 0 EST}
- {2879737200 -14400 1 EDT}
- {2897877600 -18000 0 EST}
- {2911186800 -14400 1 EDT}
- {2929327200 -18000 0 EST}
- {2942636400 -14400 1 EDT}
- {2960776800 -18000 0 EST}
- {2974690800 -14400 1 EDT}
- {2992226400 -18000 0 EST}
- {3006140400 -14400 1 EDT}
- {3023676000 -18000 0 EST}
- {3037590000 -14400 1 EDT}
- {3055730400 -18000 0 EST}
- {3069039600 -14400 1 EDT}
- {3087180000 -18000 0 EST}
- {3100489200 -14400 1 EDT}
- {3118629600 -18000 0 EST}
- {3132543600 -14400 1 EDT}
- {3150079200 -18000 0 EST}
- {3163993200 -14400 1 EDT}
- {3181528800 -18000 0 EST}
- {3195442800 -14400 1 EDT}
- {3212978400 -18000 0 EST}
- {3226892400 -14400 1 EDT}
- {3245032800 -18000 0 EST}
- {3258342000 -14400 1 EDT}
- {3276482400 -18000 0 EST}
- {3289791600 -14400 1 EDT}
- {3307932000 -18000 0 EST}
- {3321846000 -14400 1 EDT}
- {3339381600 -18000 0 EST}
- {3353295600 -14400 1 EDT}
- {3370831200 -18000 0 EST}
- {3384745200 -14400 1 EDT}
- {3402885600 -18000 0 EST}
- {3416194800 -14400 1 EDT}
- {3434335200 -18000 0 EST}
- {3447644400 -14400 1 EDT}
- {3465784800 -18000 0 EST}
- {3479698800 -14400 1 EDT}
- {3497234400 -18000 0 EST}
- {3511148400 -14400 1 EDT}
- {3528684000 -18000 0 EST}
- {3542598000 -14400 1 EDT}
- {3560133600 -18000 0 EST}
- {3574047600 -14400 1 EDT}
- {3592188000 -18000 0 EST}
- {3605497200 -14400 1 EDT}
- {3623637600 -18000 0 EST}
- {3636946800 -14400 1 EDT}
- {3655087200 -18000 0 EST}
- {3669001200 -14400 1 EDT}
- {3686536800 -18000 0 EST}
- {3700450800 -14400 1 EDT}
- {3717986400 -18000 0 EST}
- {3731900400 -14400 1 EDT}
- {3750040800 -18000 0 EST}
- {3763350000 -14400 1 EDT}
- {3781490400 -18000 0 EST}
- {3794799600 -14400 1 EDT}
- {3812940000 -18000 0 EST}
- {3826249200 -14400 1 EDT}
- {3844389600 -18000 0 EST}
- {3858303600 -14400 1 EDT}
- {3875839200 -18000 0 EST}
- {3889753200 -14400 1 EDT}
- {3907288800 -18000 0 EST}
- {3921202800 -14400 1 EDT}
- {3939343200 -18000 0 EST}
- {3952652400 -14400 1 EDT}
- {3970792800 -18000 0 EST}
- {3984102000 -14400 1 EDT}
- {4002242400 -18000 0 EST}
- {4016156400 -14400 1 EDT}
- {4033692000 -18000 0 EST}
- {4047606000 -14400 1 EDT}
- {4065141600 -18000 0 EST}
- {4079055600 -14400 1 EDT}
- {4096591200 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
diff --git a/library/tzdata/America/Tortola b/library/tzdata/America/Tortola
index 940909f..aa6f655 100644
--- a/library/tzdata/America/Tortola
+++ b/library/tzdata/America/Tortola
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Tortola) {
- {-9223372036854775808 -15508 0 LMT}
- {-1846266092 -14400 0 AST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
+set TZData(:America/Tortola) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Vancouver b/library/tzdata/America/Vancouver
index c55c1c2..aef639a 100644
--- a/library/tzdata/America/Vancouver
+++ b/library/tzdata/America/Vancouver
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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}
@@ -90,6 +90,7 @@ set TZData(:America/Vancouver) {
{499251600 -28800 0 PST}
{514980000 -25200 1 PDT}
{530701200 -28800 0 PST}
+ {536486400 -28800 0 PST}
{544615200 -25200 1 PDT}
{562150800 -28800 0 PST}
{576064800 -25200 1 PDT}
@@ -130,190 +131,190 @@ set TZData(:America/Vancouver) {
{1130662800 -28800 0 PST}
{1143972000 -25200 1 PDT}
{1162112400 -28800 0 PST}
- {1175421600 -25200 1 PDT}
- {1193562000 -28800 0 PST}
- {1207476000 -25200 1 PDT}
- {1225011600 -28800 0 PST}
- {1238925600 -25200 1 PDT}
- {1256461200 -28800 0 PST}
- {1270375200 -25200 1 PDT}
- {1288515600 -28800 0 PST}
- {1301824800 -25200 1 PDT}
- {1319965200 -28800 0 PST}
- {1333274400 -25200 1 PDT}
- {1351414800 -28800 0 PST}
- {1365328800 -25200 1 PDT}
- {1382864400 -28800 0 PST}
- {1396778400 -25200 1 PDT}
- {1414314000 -28800 0 PST}
- {1428228000 -25200 1 PDT}
- {1445763600 -28800 0 PST}
- {1459677600 -25200 1 PDT}
- {1477818000 -28800 0 PST}
- {1491127200 -25200 1 PDT}
- {1509267600 -28800 0 PST}
- {1522576800 -25200 1 PDT}
- {1540717200 -28800 0 PST}
- {1554631200 -25200 1 PDT}
- {1572166800 -28800 0 PST}
- {1586080800 -25200 1 PDT}
- {1603616400 -28800 0 PST}
- {1617530400 -25200 1 PDT}
- {1635670800 -28800 0 PST}
- {1648980000 -25200 1 PDT}
- {1667120400 -28800 0 PST}
- {1680429600 -25200 1 PDT}
- {1698570000 -28800 0 PST}
- {1712484000 -25200 1 PDT}
- {1730019600 -28800 0 PST}
- {1743933600 -25200 1 PDT}
- {1761469200 -28800 0 PST}
- {1775383200 -25200 1 PDT}
- {1792918800 -28800 0 PST}
- {1806832800 -25200 1 PDT}
- {1824973200 -28800 0 PST}
- {1838282400 -25200 1 PDT}
- {1856422800 -28800 0 PST}
- {1869732000 -25200 1 PDT}
- {1887872400 -28800 0 PST}
- {1901786400 -25200 1 PDT}
- {1919322000 -28800 0 PST}
- {1933236000 -25200 1 PDT}
- {1950771600 -28800 0 PST}
- {1964685600 -25200 1 PDT}
- {1982826000 -28800 0 PST}
- {1996135200 -25200 1 PDT}
- {2014275600 -28800 0 PST}
- {2027584800 -25200 1 PDT}
- {2045725200 -28800 0 PST}
- {2059034400 -25200 1 PDT}
- {2077174800 -28800 0 PST}
- {2091088800 -25200 1 PDT}
- {2108624400 -28800 0 PST}
- {2122538400 -25200 1 PDT}
- {2140074000 -28800 0 PST}
- {2153988000 -25200 1 PDT}
- {2172128400 -28800 0 PST}
- {2185437600 -25200 1 PDT}
- {2203578000 -28800 0 PST}
- {2216887200 -25200 1 PDT}
- {2235027600 -28800 0 PST}
- {2248941600 -25200 1 PDT}
- {2266477200 -28800 0 PST}
- {2280391200 -25200 1 PDT}
- {2297926800 -28800 0 PST}
- {2311840800 -25200 1 PDT}
- {2329376400 -28800 0 PST}
- {2343290400 -25200 1 PDT}
- {2361430800 -28800 0 PST}
- {2374740000 -25200 1 PDT}
- {2392880400 -28800 0 PST}
- {2406189600 -25200 1 PDT}
- {2424330000 -28800 0 PST}
- {2438244000 -25200 1 PDT}
- {2455779600 -28800 0 PST}
- {2469693600 -25200 1 PDT}
- {2487229200 -28800 0 PST}
- {2501143200 -25200 1 PDT}
- {2519283600 -28800 0 PST}
- {2532592800 -25200 1 PDT}
- {2550733200 -28800 0 PST}
- {2564042400 -25200 1 PDT}
- {2582182800 -28800 0 PST}
- {2596096800 -25200 1 PDT}
- {2613632400 -28800 0 PST}
- {2627546400 -25200 1 PDT}
- {2645082000 -28800 0 PST}
- {2658996000 -25200 1 PDT}
- {2676531600 -28800 0 PST}
- {2690445600 -25200 1 PDT}
- {2708586000 -28800 0 PST}
- {2721895200 -25200 1 PDT}
- {2740035600 -28800 0 PST}
- {2753344800 -25200 1 PDT}
- {2771485200 -28800 0 PST}
- {2785399200 -25200 1 PDT}
- {2802934800 -28800 0 PST}
- {2816848800 -25200 1 PDT}
- {2834384400 -28800 0 PST}
- {2848298400 -25200 1 PDT}
- {2866438800 -28800 0 PST}
- {2879748000 -25200 1 PDT}
- {2897888400 -28800 0 PST}
- {2911197600 -25200 1 PDT}
- {2929338000 -28800 0 PST}
- {2942647200 -25200 1 PDT}
- {2960787600 -28800 0 PST}
- {2974701600 -25200 1 PDT}
- {2992237200 -28800 0 PST}
- {3006151200 -25200 1 PDT}
- {3023686800 -28800 0 PST}
- {3037600800 -25200 1 PDT}
- {3055741200 -28800 0 PST}
- {3069050400 -25200 1 PDT}
- {3087190800 -28800 0 PST}
- {3100500000 -25200 1 PDT}
- {3118640400 -28800 0 PST}
- {3132554400 -25200 1 PDT}
- {3150090000 -28800 0 PST}
- {3164004000 -25200 1 PDT}
- {3181539600 -28800 0 PST}
- {3195453600 -25200 1 PDT}
- {3212989200 -28800 0 PST}
- {3226903200 -25200 1 PDT}
- {3245043600 -28800 0 PST}
- {3258352800 -25200 1 PDT}
- {3276493200 -28800 0 PST}
- {3289802400 -25200 1 PDT}
- {3307942800 -28800 0 PST}
- {3321856800 -25200 1 PDT}
- {3339392400 -28800 0 PST}
- {3353306400 -25200 1 PDT}
- {3370842000 -28800 0 PST}
- {3384756000 -25200 1 PDT}
- {3402896400 -28800 0 PST}
- {3416205600 -25200 1 PDT}
- {3434346000 -28800 0 PST}
- {3447655200 -25200 1 PDT}
- {3465795600 -28800 0 PST}
- {3479709600 -25200 1 PDT}
- {3497245200 -28800 0 PST}
- {3511159200 -25200 1 PDT}
- {3528694800 -28800 0 PST}
- {3542608800 -25200 1 PDT}
- {3560144400 -28800 0 PST}
- {3574058400 -25200 1 PDT}
- {3592198800 -28800 0 PST}
- {3605508000 -25200 1 PDT}
- {3623648400 -28800 0 PST}
- {3636957600 -25200 1 PDT}
- {3655098000 -28800 0 PST}
- {3669012000 -25200 1 PDT}
- {3686547600 -28800 0 PST}
- {3700461600 -25200 1 PDT}
- {3717997200 -28800 0 PST}
- {3731911200 -25200 1 PDT}
- {3750051600 -28800 0 PST}
- {3763360800 -25200 1 PDT}
- {3781501200 -28800 0 PST}
- {3794810400 -25200 1 PDT}
- {3812950800 -28800 0 PST}
- {3826260000 -25200 1 PDT}
- {3844400400 -28800 0 PST}
- {3858314400 -25200 1 PDT}
- {3875850000 -28800 0 PST}
- {3889764000 -25200 1 PDT}
- {3907299600 -28800 0 PST}
- {3921213600 -25200 1 PDT}
- {3939354000 -28800 0 PST}
- {3952663200 -25200 1 PDT}
- {3970803600 -28800 0 PST}
- {3984112800 -25200 1 PDT}
- {4002253200 -28800 0 PST}
- {4016167200 -25200 1 PDT}
- {4033702800 -28800 0 PST}
- {4047616800 -25200 1 PDT}
- {4065152400 -28800 0 PST}
- {4079066400 -25200 1 PDT}
- {4096602000 -28800 0 PST}
+ {1173607200 -25200 1 PDT}
+ {1194166800 -28800 0 PST}
+ {1205056800 -25200 1 PDT}
+ {1225616400 -28800 0 PST}
+ {1236506400 -25200 1 PDT}
+ {1257066000 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
diff --git a/library/tzdata/America/Virgin b/library/tzdata/America/Virgin
index 60325c6..c267e5b 100644
--- a/library/tzdata/America/Virgin
+++ b/library/tzdata/America/Virgin
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/St_Thomas)]} {
- LoadTimeZoneFile America/St_Thomas
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Port_of_Spain)]} {
+ LoadTimeZoneFile America/Port_of_Spain
}
-set TZData(:America/Virgin) $TZData(:America/St_Thomas)
+set TZData(:America/Virgin) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Whitehorse b/library/tzdata/America/Whitehorse
index 1bb839d..1d61093 100644
--- a/library/tzdata/America/Whitehorse
+++ b/library/tzdata/America/Whitehorse
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Whitehorse) {
{-9223372036854775808 -32412 0 LMT}
@@ -12,7 +12,7 @@ set TZData(:America/Whitehorse) {
{-765381600 -32400 0 YST}
{-147884400 -25200 1 YDDT}
{-131554800 -32400 0 YST}
- {-110552400 -28800 0 PST}
+ {315561600 -28800 0 PST}
{325677600 -25200 1 PDT}
{341398800 -28800 0 PST}
{357127200 -25200 1 PDT}
@@ -67,190 +67,190 @@ set TZData(:America/Whitehorse) {
{1130662800 -28800 0 PST}
{1143972000 -25200 1 PDT}
{1162112400 -28800 0 PST}
- {1175421600 -25200 1 PDT}
- {1193562000 -28800 0 PST}
- {1207476000 -25200 1 PDT}
- {1225011600 -28800 0 PST}
- {1238925600 -25200 1 PDT}
- {1256461200 -28800 0 PST}
- {1270375200 -25200 1 PDT}
- {1288515600 -28800 0 PST}
- {1301824800 -25200 1 PDT}
- {1319965200 -28800 0 PST}
- {1333274400 -25200 1 PDT}
- {1351414800 -28800 0 PST}
- {1365328800 -25200 1 PDT}
- {1382864400 -28800 0 PST}
- {1396778400 -25200 1 PDT}
- {1414314000 -28800 0 PST}
- {1428228000 -25200 1 PDT}
- {1445763600 -28800 0 PST}
- {1459677600 -25200 1 PDT}
- {1477818000 -28800 0 PST}
- {1491127200 -25200 1 PDT}
- {1509267600 -28800 0 PST}
- {1522576800 -25200 1 PDT}
- {1540717200 -28800 0 PST}
- {1554631200 -25200 1 PDT}
- {1572166800 -28800 0 PST}
- {1586080800 -25200 1 PDT}
- {1603616400 -28800 0 PST}
- {1617530400 -25200 1 PDT}
- {1635670800 -28800 0 PST}
- {1648980000 -25200 1 PDT}
- {1667120400 -28800 0 PST}
- {1680429600 -25200 1 PDT}
- {1698570000 -28800 0 PST}
- {1712484000 -25200 1 PDT}
- {1730019600 -28800 0 PST}
- {1743933600 -25200 1 PDT}
- {1761469200 -28800 0 PST}
- {1775383200 -25200 1 PDT}
- {1792918800 -28800 0 PST}
- {1806832800 -25200 1 PDT}
- {1824973200 -28800 0 PST}
- {1838282400 -25200 1 PDT}
- {1856422800 -28800 0 PST}
- {1869732000 -25200 1 PDT}
- {1887872400 -28800 0 PST}
- {1901786400 -25200 1 PDT}
- {1919322000 -28800 0 PST}
- {1933236000 -25200 1 PDT}
- {1950771600 -28800 0 PST}
- {1964685600 -25200 1 PDT}
- {1982826000 -28800 0 PST}
- {1996135200 -25200 1 PDT}
- {2014275600 -28800 0 PST}
- {2027584800 -25200 1 PDT}
- {2045725200 -28800 0 PST}
- {2059034400 -25200 1 PDT}
- {2077174800 -28800 0 PST}
- {2091088800 -25200 1 PDT}
- {2108624400 -28800 0 PST}
- {2122538400 -25200 1 PDT}
- {2140074000 -28800 0 PST}
- {2153988000 -25200 1 PDT}
- {2172128400 -28800 0 PST}
- {2185437600 -25200 1 PDT}
- {2203578000 -28800 0 PST}
- {2216887200 -25200 1 PDT}
- {2235027600 -28800 0 PST}
- {2248941600 -25200 1 PDT}
- {2266477200 -28800 0 PST}
- {2280391200 -25200 1 PDT}
- {2297926800 -28800 0 PST}
- {2311840800 -25200 1 PDT}
- {2329376400 -28800 0 PST}
- {2343290400 -25200 1 PDT}
- {2361430800 -28800 0 PST}
- {2374740000 -25200 1 PDT}
- {2392880400 -28800 0 PST}
- {2406189600 -25200 1 PDT}
- {2424330000 -28800 0 PST}
- {2438244000 -25200 1 PDT}
- {2455779600 -28800 0 PST}
- {2469693600 -25200 1 PDT}
- {2487229200 -28800 0 PST}
- {2501143200 -25200 1 PDT}
- {2519283600 -28800 0 PST}
- {2532592800 -25200 1 PDT}
- {2550733200 -28800 0 PST}
- {2564042400 -25200 1 PDT}
- {2582182800 -28800 0 PST}
- {2596096800 -25200 1 PDT}
- {2613632400 -28800 0 PST}
- {2627546400 -25200 1 PDT}
- {2645082000 -28800 0 PST}
- {2658996000 -25200 1 PDT}
- {2676531600 -28800 0 PST}
- {2690445600 -25200 1 PDT}
- {2708586000 -28800 0 PST}
- {2721895200 -25200 1 PDT}
- {2740035600 -28800 0 PST}
- {2753344800 -25200 1 PDT}
- {2771485200 -28800 0 PST}
- {2785399200 -25200 1 PDT}
- {2802934800 -28800 0 PST}
- {2816848800 -25200 1 PDT}
- {2834384400 -28800 0 PST}
- {2848298400 -25200 1 PDT}
- {2866438800 -28800 0 PST}
- {2879748000 -25200 1 PDT}
- {2897888400 -28800 0 PST}
- {2911197600 -25200 1 PDT}
- {2929338000 -28800 0 PST}
- {2942647200 -25200 1 PDT}
- {2960787600 -28800 0 PST}
- {2974701600 -25200 1 PDT}
- {2992237200 -28800 0 PST}
- {3006151200 -25200 1 PDT}
- {3023686800 -28800 0 PST}
- {3037600800 -25200 1 PDT}
- {3055741200 -28800 0 PST}
- {3069050400 -25200 1 PDT}
- {3087190800 -28800 0 PST}
- {3100500000 -25200 1 PDT}
- {3118640400 -28800 0 PST}
- {3132554400 -25200 1 PDT}
- {3150090000 -28800 0 PST}
- {3164004000 -25200 1 PDT}
- {3181539600 -28800 0 PST}
- {3195453600 -25200 1 PDT}
- {3212989200 -28800 0 PST}
- {3226903200 -25200 1 PDT}
- {3245043600 -28800 0 PST}
- {3258352800 -25200 1 PDT}
- {3276493200 -28800 0 PST}
- {3289802400 -25200 1 PDT}
- {3307942800 -28800 0 PST}
- {3321856800 -25200 1 PDT}
- {3339392400 -28800 0 PST}
- {3353306400 -25200 1 PDT}
- {3370842000 -28800 0 PST}
- {3384756000 -25200 1 PDT}
- {3402896400 -28800 0 PST}
- {3416205600 -25200 1 PDT}
- {3434346000 -28800 0 PST}
- {3447655200 -25200 1 PDT}
- {3465795600 -28800 0 PST}
- {3479709600 -25200 1 PDT}
- {3497245200 -28800 0 PST}
- {3511159200 -25200 1 PDT}
- {3528694800 -28800 0 PST}
- {3542608800 -25200 1 PDT}
- {3560144400 -28800 0 PST}
- {3574058400 -25200 1 PDT}
- {3592198800 -28800 0 PST}
- {3605508000 -25200 1 PDT}
- {3623648400 -28800 0 PST}
- {3636957600 -25200 1 PDT}
- {3655098000 -28800 0 PST}
- {3669012000 -25200 1 PDT}
- {3686547600 -28800 0 PST}
- {3700461600 -25200 1 PDT}
- {3717997200 -28800 0 PST}
- {3731911200 -25200 1 PDT}
- {3750051600 -28800 0 PST}
- {3763360800 -25200 1 PDT}
- {3781501200 -28800 0 PST}
- {3794810400 -25200 1 PDT}
- {3812950800 -28800 0 PST}
- {3826260000 -25200 1 PDT}
- {3844400400 -28800 0 PST}
- {3858314400 -25200 1 PDT}
- {3875850000 -28800 0 PST}
- {3889764000 -25200 1 PDT}
- {3907299600 -28800 0 PST}
- {3921213600 -25200 1 PDT}
- {3939354000 -28800 0 PST}
- {3952663200 -25200 1 PDT}
- {3970803600 -28800 0 PST}
- {3984112800 -25200 1 PDT}
- {4002253200 -28800 0 PST}
- {4016167200 -25200 1 PDT}
- {4033702800 -28800 0 PST}
- {4047616800 -25200 1 PDT}
- {4065152400 -28800 0 PST}
- {4079066400 -25200 1 PDT}
- {4096602000 -28800 0 PST}
+ {1173607200 -25200 1 PDT}
+ {1194166800 -28800 0 PST}
+ {1205056800 -25200 1 PDT}
+ {1225616400 -28800 0 PST}
+ {1236506400 -25200 1 PDT}
+ {1257066000 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
diff --git a/library/tzdata/America/Winnipeg b/library/tzdata/America/Winnipeg
index bc52ac4..e6efe47 100644
--- a/library/tzdata/America/Winnipeg
+++ b/library/tzdata/America/Winnipeg
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Winnipeg) {
{-9223372036854775808 -23316 0 LMT}
@@ -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}
@@ -45,271 +45,272 @@ set TZData(:America/Winnipeg) {
{-210787200 -18000 1 CDT}
{-198090000 -21600 0 CST}
{-116438400 -18000 1 CDT}
- {-100112400 -21600 0 CST}
+ {-100108800 -21600 0 CST}
{-84384000 -18000 1 CDT}
- {-68662800 -21600 0 CST}
+ {-68659200 -21600 0 CST}
{-52934400 -18000 1 CDT}
- {-37213200 -21600 0 CST}
+ {-37209600 -21600 0 CST}
{-21484800 -18000 1 CDT}
- {-5763600 -21600 0 CST}
+ {-5760000 -21600 0 CST}
{9964800 -18000 1 CDT}
- {25686000 -21600 0 CST}
+ {25689600 -21600 0 CST}
{41414400 -18000 1 CDT}
- {57740400 -21600 0 CST}
+ {57744000 -21600 0 CST}
{73468800 -18000 1 CDT}
- {89190000 -21600 0 CST}
+ {89193600 -21600 0 CST}
{104918400 -18000 1 CDT}
- {120639600 -21600 0 CST}
+ {120643200 -21600 0 CST}
{136368000 -18000 1 CDT}
- {152089200 -21600 0 CST}
+ {152092800 -21600 0 CST}
{167817600 -18000 1 CDT}
- {183538800 -21600 0 CST}
+ {183542400 -21600 0 CST}
{199267200 -18000 1 CDT}
- {215593200 -21600 0 CST}
+ {215596800 -21600 0 CST}
{230716800 -18000 1 CDT}
- {247042800 -21600 0 CST}
+ {247046400 -21600 0 CST}
{262771200 -18000 1 CDT}
- {278492400 -21600 0 CST}
+ {278496000 -21600 0 CST}
{294220800 -18000 1 CDT}
- {309942000 -21600 0 CST}
+ {309945600 -21600 0 CST}
{325670400 -18000 1 CDT}
- {341391600 -21600 0 CST}
+ {341395200 -21600 0 CST}
{357120000 -18000 1 CDT}
- {372841200 -21600 0 CST}
+ {372844800 -21600 0 CST}
{388569600 -18000 1 CDT}
- {404895600 -21600 0 CST}
+ {404899200 -21600 0 CST}
{420019200 -18000 1 CDT}
- {436345200 -21600 0 CST}
+ {436348800 -21600 0 CST}
{452073600 -18000 1 CDT}
- {467794800 -21600 0 CST}
+ {467798400 -21600 0 CST}
{483523200 -18000 1 CDT}
- {499244400 -21600 0 CST}
+ {499248000 -21600 0 CST}
{514972800 -18000 1 CDT}
- {530694000 -21600 0 CST}
+ {530697600 -21600 0 CST}
{544608000 -18000 1 CDT}
- {562125600 -21600 0 CST}
+ {562147200 -21600 0 CST}
{576057600 -18000 1 CDT}
- {594180000 -21600 0 CST}
+ {594201600 -21600 0 CST}
{607507200 -18000 1 CDT}
- {625629600 -21600 0 CST}
+ {625651200 -21600 0 CST}
{638956800 -18000 1 CDT}
- {657079200 -21600 0 CST}
+ {657100800 -21600 0 CST}
{671011200 -18000 1 CDT}
- {688528800 -21600 0 CST}
+ {688550400 -21600 0 CST}
{702460800 -18000 1 CDT}
- {719978400 -21600 0 CST}
+ {720000000 -21600 0 CST}
{733910400 -18000 1 CDT}
- {752032800 -21600 0 CST}
+ {752054400 -21600 0 CST}
{765360000 -18000 1 CDT}
- {783482400 -21600 0 CST}
+ {783504000 -21600 0 CST}
{796809600 -18000 1 CDT}
- {814932000 -21600 0 CST}
+ {814953600 -21600 0 CST}
{828864000 -18000 1 CDT}
- {846381600 -21600 0 CST}
+ {846403200 -21600 0 CST}
{860313600 -18000 1 CDT}
- {877831200 -21600 0 CST}
+ {877852800 -21600 0 CST}
{891763200 -18000 1 CDT}
- {909280800 -21600 0 CST}
+ {909302400 -21600 0 CST}
{923212800 -18000 1 CDT}
- {941335200 -21600 0 CST}
+ {941356800 -21600 0 CST}
{954662400 -18000 1 CDT}
- {972784800 -21600 0 CST}
+ {972806400 -21600 0 CST}
{986112000 -18000 1 CDT}
- {1004234400 -21600 0 CST}
+ {1004256000 -21600 0 CST}
{1018166400 -18000 1 CDT}
- {1035684000 -21600 0 CST}
+ {1035705600 -21600 0 CST}
{1049616000 -18000 1 CDT}
- {1067133600 -21600 0 CST}
+ {1067155200 -21600 0 CST}
{1081065600 -18000 1 CDT}
- {1099188000 -21600 0 CST}
+ {1099209600 -21600 0 CST}
{1112515200 -18000 1 CDT}
- {1130637600 -21600 0 CST}
+ {1130659200 -21600 0 CST}
+ {1136095200 -21600 0 CST}
{1143964800 -18000 1 CDT}
- {1162087200 -21600 0 CST}
- {1175414400 -18000 1 CDT}
- {1193536800 -21600 0 CST}
- {1207468800 -18000 1 CDT}
- {1224986400 -21600 0 CST}
- {1238918400 -18000 1 CDT}
- {1256436000 -21600 0 CST}
- {1270368000 -18000 1 CDT}
- {1288490400 -21600 0 CST}
- {1301817600 -18000 1 CDT}
- {1319940000 -21600 0 CST}
- {1333267200 -18000 1 CDT}
- {1351389600 -21600 0 CST}
- {1365321600 -18000 1 CDT}
- {1382839200 -21600 0 CST}
- {1396771200 -18000 1 CDT}
- {1414288800 -21600 0 CST}
- {1428220800 -18000 1 CDT}
- {1445738400 -21600 0 CST}
- {1459670400 -18000 1 CDT}
- {1477792800 -21600 0 CST}
- {1491120000 -18000 1 CDT}
- {1509242400 -21600 0 CST}
- {1522569600 -18000 1 CDT}
- {1540692000 -21600 0 CST}
- {1554624000 -18000 1 CDT}
- {1572141600 -21600 0 CST}
- {1586073600 -18000 1 CDT}
- {1603591200 -21600 0 CST}
- {1617523200 -18000 1 CDT}
- {1635645600 -21600 0 CST}
- {1648972800 -18000 1 CDT}
- {1667095200 -21600 0 CST}
- {1680422400 -18000 1 CDT}
- {1698544800 -21600 0 CST}
- {1712476800 -18000 1 CDT}
- {1729994400 -21600 0 CST}
- {1743926400 -18000 1 CDT}
- {1761444000 -21600 0 CST}
- {1775376000 -18000 1 CDT}
- {1792893600 -21600 0 CST}
- {1806825600 -18000 1 CDT}
- {1824948000 -21600 0 CST}
- {1838275200 -18000 1 CDT}
- {1856397600 -21600 0 CST}
- {1869724800 -18000 1 CDT}
- {1887847200 -21600 0 CST}
- {1901779200 -18000 1 CDT}
- {1919296800 -21600 0 CST}
- {1933228800 -18000 1 CDT}
- {1950746400 -21600 0 CST}
- {1964678400 -18000 1 CDT}
- {1982800800 -21600 0 CST}
- {1996128000 -18000 1 CDT}
- {2014250400 -21600 0 CST}
- {2027577600 -18000 1 CDT}
- {2045700000 -21600 0 CST}
- {2059027200 -18000 1 CDT}
- {2077149600 -21600 0 CST}
- {2091081600 -18000 1 CDT}
- {2108599200 -21600 0 CST}
- {2122531200 -18000 1 CDT}
- {2140048800 -21600 0 CST}
- {2153980800 -18000 1 CDT}
- {2172103200 -21600 0 CST}
- {2185430400 -18000 1 CDT}
- {2203552800 -21600 0 CST}
- {2216880000 -18000 1 CDT}
- {2235002400 -21600 0 CST}
- {2248934400 -18000 1 CDT}
- {2266452000 -21600 0 CST}
- {2280384000 -18000 1 CDT}
- {2297901600 -21600 0 CST}
- {2311833600 -18000 1 CDT}
- {2329351200 -21600 0 CST}
- {2343283200 -18000 1 CDT}
- {2361405600 -21600 0 CST}
- {2374732800 -18000 1 CDT}
- {2392855200 -21600 0 CST}
- {2406182400 -18000 1 CDT}
- {2424304800 -21600 0 CST}
- {2438236800 -18000 1 CDT}
- {2455754400 -21600 0 CST}
- {2469686400 -18000 1 CDT}
- {2487204000 -21600 0 CST}
- {2501136000 -18000 1 CDT}
- {2519258400 -21600 0 CST}
- {2532585600 -18000 1 CDT}
- {2550708000 -21600 0 CST}
- {2564035200 -18000 1 CDT}
- {2582157600 -21600 0 CST}
- {2596089600 -18000 1 CDT}
- {2613607200 -21600 0 CST}
- {2627539200 -18000 1 CDT}
- {2645056800 -21600 0 CST}
- {2658988800 -18000 1 CDT}
- {2676506400 -21600 0 CST}
- {2690438400 -18000 1 CDT}
- {2708560800 -21600 0 CST}
- {2721888000 -18000 1 CDT}
- {2740010400 -21600 0 CST}
- {2753337600 -18000 1 CDT}
- {2771460000 -21600 0 CST}
- {2785392000 -18000 1 CDT}
- {2802909600 -21600 0 CST}
- {2816841600 -18000 1 CDT}
- {2834359200 -21600 0 CST}
- {2848291200 -18000 1 CDT}
- {2866413600 -21600 0 CST}
- {2879740800 -18000 1 CDT}
- {2897863200 -21600 0 CST}
- {2911190400 -18000 1 CDT}
- {2929312800 -21600 0 CST}
- {2942640000 -18000 1 CDT}
- {2960762400 -21600 0 CST}
- {2974694400 -18000 1 CDT}
- {2992212000 -21600 0 CST}
- {3006144000 -18000 1 CDT}
- {3023661600 -21600 0 CST}
- {3037593600 -18000 1 CDT}
- {3055716000 -21600 0 CST}
- {3069043200 -18000 1 CDT}
- {3087165600 -21600 0 CST}
- {3100492800 -18000 1 CDT}
- {3118615200 -21600 0 CST}
- {3132547200 -18000 1 CDT}
- {3150064800 -21600 0 CST}
- {3163996800 -18000 1 CDT}
- {3181514400 -21600 0 CST}
- {3195446400 -18000 1 CDT}
- {3212964000 -21600 0 CST}
- {3226896000 -18000 1 CDT}
- {3245018400 -21600 0 CST}
- {3258345600 -18000 1 CDT}
- {3276468000 -21600 0 CST}
- {3289795200 -18000 1 CDT}
- {3307917600 -21600 0 CST}
- {3321849600 -18000 1 CDT}
- {3339367200 -21600 0 CST}
- {3353299200 -18000 1 CDT}
- {3370816800 -21600 0 CST}
- {3384748800 -18000 1 CDT}
- {3402871200 -21600 0 CST}
- {3416198400 -18000 1 CDT}
- {3434320800 -21600 0 CST}
- {3447648000 -18000 1 CDT}
- {3465770400 -21600 0 CST}
- {3479702400 -18000 1 CDT}
- {3497220000 -21600 0 CST}
- {3511152000 -18000 1 CDT}
- {3528669600 -21600 0 CST}
- {3542601600 -18000 1 CDT}
- {3560119200 -21600 0 CST}
- {3574051200 -18000 1 CDT}
- {3592173600 -21600 0 CST}
- {3605500800 -18000 1 CDT}
- {3623623200 -21600 0 CST}
- {3636950400 -18000 1 CDT}
- {3655072800 -21600 0 CST}
- {3669004800 -18000 1 CDT}
- {3686522400 -21600 0 CST}
- {3700454400 -18000 1 CDT}
- {3717972000 -21600 0 CST}
- {3731904000 -18000 1 CDT}
- {3750026400 -21600 0 CST}
- {3763353600 -18000 1 CDT}
- {3781476000 -21600 0 CST}
- {3794803200 -18000 1 CDT}
- {3812925600 -21600 0 CST}
- {3826252800 -18000 1 CDT}
- {3844375200 -21600 0 CST}
- {3858307200 -18000 1 CDT}
- {3875824800 -21600 0 CST}
- {3889756800 -18000 1 CDT}
- {3907274400 -21600 0 CST}
- {3921206400 -18000 1 CDT}
- {3939328800 -21600 0 CST}
- {3952656000 -18000 1 CDT}
- {3970778400 -21600 0 CST}
- {3984105600 -18000 1 CDT}
- {4002228000 -21600 0 CST}
- {4016160000 -18000 1 CDT}
- {4033677600 -21600 0 CST}
- {4047609600 -18000 1 CDT}
- {4065127200 -21600 0 CST}
- {4079059200 -18000 1 CDT}
- {4096576800 -21600 0 CST}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 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/Yakutat b/library/tzdata/America/Yakutat
index c583af4..a0420c5 100644
--- a/library/tzdata/America/Yakutat
+++ b/library/tzdata/America/Yakutat
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Yakutat) {
{-9223372036854775808 52865 0 LMT}
@@ -87,190 +87,190 @@ set TZData(:America/Yakutat) {
{1130666400 -32400 0 AKST}
{1143975600 -28800 1 AKDT}
{1162116000 -32400 0 AKST}
- {1175425200 -28800 1 AKDT}
- {1193565600 -32400 0 AKST}
- {1207479600 -28800 1 AKDT}
- {1225015200 -32400 0 AKST}
- {1238929200 -28800 1 AKDT}
- {1256464800 -32400 0 AKST}
- {1270378800 -28800 1 AKDT}
- {1288519200 -32400 0 AKST}
- {1301828400 -28800 1 AKDT}
- {1319968800 -32400 0 AKST}
- {1333278000 -28800 1 AKDT}
- {1351418400 -32400 0 AKST}
- {1365332400 -28800 1 AKDT}
- {1382868000 -32400 0 AKST}
- {1396782000 -28800 1 AKDT}
- {1414317600 -32400 0 AKST}
- {1428231600 -28800 1 AKDT}
- {1445767200 -32400 0 AKST}
- {1459681200 -28800 1 AKDT}
- {1477821600 -32400 0 AKST}
- {1491130800 -28800 1 AKDT}
- {1509271200 -32400 0 AKST}
- {1522580400 -28800 1 AKDT}
- {1540720800 -32400 0 AKST}
- {1554634800 -28800 1 AKDT}
- {1572170400 -32400 0 AKST}
- {1586084400 -28800 1 AKDT}
- {1603620000 -32400 0 AKST}
- {1617534000 -28800 1 AKDT}
- {1635674400 -32400 0 AKST}
- {1648983600 -28800 1 AKDT}
- {1667124000 -32400 0 AKST}
- {1680433200 -28800 1 AKDT}
- {1698573600 -32400 0 AKST}
- {1712487600 -28800 1 AKDT}
- {1730023200 -32400 0 AKST}
- {1743937200 -28800 1 AKDT}
- {1761472800 -32400 0 AKST}
- {1775386800 -28800 1 AKDT}
- {1792922400 -32400 0 AKST}
- {1806836400 -28800 1 AKDT}
- {1824976800 -32400 0 AKST}
- {1838286000 -28800 1 AKDT}
- {1856426400 -32400 0 AKST}
- {1869735600 -28800 1 AKDT}
- {1887876000 -32400 0 AKST}
- {1901790000 -28800 1 AKDT}
- {1919325600 -32400 0 AKST}
- {1933239600 -28800 1 AKDT}
- {1950775200 -32400 0 AKST}
- {1964689200 -28800 1 AKDT}
- {1982829600 -32400 0 AKST}
- {1996138800 -28800 1 AKDT}
- {2014279200 -32400 0 AKST}
- {2027588400 -28800 1 AKDT}
- {2045728800 -32400 0 AKST}
- {2059038000 -28800 1 AKDT}
- {2077178400 -32400 0 AKST}
- {2091092400 -28800 1 AKDT}
- {2108628000 -32400 0 AKST}
- {2122542000 -28800 1 AKDT}
- {2140077600 -32400 0 AKST}
- {2153991600 -28800 1 AKDT}
- {2172132000 -32400 0 AKST}
- {2185441200 -28800 1 AKDT}
- {2203581600 -32400 0 AKST}
- {2216890800 -28800 1 AKDT}
- {2235031200 -32400 0 AKST}
- {2248945200 -28800 1 AKDT}
- {2266480800 -32400 0 AKST}
- {2280394800 -28800 1 AKDT}
- {2297930400 -32400 0 AKST}
- {2311844400 -28800 1 AKDT}
- {2329380000 -32400 0 AKST}
- {2343294000 -28800 1 AKDT}
- {2361434400 -32400 0 AKST}
- {2374743600 -28800 1 AKDT}
- {2392884000 -32400 0 AKST}
- {2406193200 -28800 1 AKDT}
- {2424333600 -32400 0 AKST}
- {2438247600 -28800 1 AKDT}
- {2455783200 -32400 0 AKST}
- {2469697200 -28800 1 AKDT}
- {2487232800 -32400 0 AKST}
- {2501146800 -28800 1 AKDT}
- {2519287200 -32400 0 AKST}
- {2532596400 -28800 1 AKDT}
- {2550736800 -32400 0 AKST}
- {2564046000 -28800 1 AKDT}
- {2582186400 -32400 0 AKST}
- {2596100400 -28800 1 AKDT}
- {2613636000 -32400 0 AKST}
- {2627550000 -28800 1 AKDT}
- {2645085600 -32400 0 AKST}
- {2658999600 -28800 1 AKDT}
- {2676535200 -32400 0 AKST}
- {2690449200 -28800 1 AKDT}
- {2708589600 -32400 0 AKST}
- {2721898800 -28800 1 AKDT}
- {2740039200 -32400 0 AKST}
- {2753348400 -28800 1 AKDT}
- {2771488800 -32400 0 AKST}
- {2785402800 -28800 1 AKDT}
- {2802938400 -32400 0 AKST}
- {2816852400 -28800 1 AKDT}
- {2834388000 -32400 0 AKST}
- {2848302000 -28800 1 AKDT}
- {2866442400 -32400 0 AKST}
- {2879751600 -28800 1 AKDT}
- {2897892000 -32400 0 AKST}
- {2911201200 -28800 1 AKDT}
- {2929341600 -32400 0 AKST}
- {2942650800 -28800 1 AKDT}
- {2960791200 -32400 0 AKST}
- {2974705200 -28800 1 AKDT}
- {2992240800 -32400 0 AKST}
- {3006154800 -28800 1 AKDT}
- {3023690400 -32400 0 AKST}
- {3037604400 -28800 1 AKDT}
- {3055744800 -32400 0 AKST}
- {3069054000 -28800 1 AKDT}
- {3087194400 -32400 0 AKST}
- {3100503600 -28800 1 AKDT}
- {3118644000 -32400 0 AKST}
- {3132558000 -28800 1 AKDT}
- {3150093600 -32400 0 AKST}
- {3164007600 -28800 1 AKDT}
- {3181543200 -32400 0 AKST}
- {3195457200 -28800 1 AKDT}
- {3212992800 -32400 0 AKST}
- {3226906800 -28800 1 AKDT}
- {3245047200 -32400 0 AKST}
- {3258356400 -28800 1 AKDT}
- {3276496800 -32400 0 AKST}
- {3289806000 -28800 1 AKDT}
- {3307946400 -32400 0 AKST}
- {3321860400 -28800 1 AKDT}
- {3339396000 -32400 0 AKST}
- {3353310000 -28800 1 AKDT}
- {3370845600 -32400 0 AKST}
- {3384759600 -28800 1 AKDT}
- {3402900000 -32400 0 AKST}
- {3416209200 -28800 1 AKDT}
- {3434349600 -32400 0 AKST}
- {3447658800 -28800 1 AKDT}
- {3465799200 -32400 0 AKST}
- {3479713200 -28800 1 AKDT}
- {3497248800 -32400 0 AKST}
- {3511162800 -28800 1 AKDT}
- {3528698400 -32400 0 AKST}
- {3542612400 -28800 1 AKDT}
- {3560148000 -32400 0 AKST}
- {3574062000 -28800 1 AKDT}
- {3592202400 -32400 0 AKST}
- {3605511600 -28800 1 AKDT}
- {3623652000 -32400 0 AKST}
- {3636961200 -28800 1 AKDT}
- {3655101600 -32400 0 AKST}
- {3669015600 -28800 1 AKDT}
- {3686551200 -32400 0 AKST}
- {3700465200 -28800 1 AKDT}
- {3718000800 -32400 0 AKST}
- {3731914800 -28800 1 AKDT}
- {3750055200 -32400 0 AKST}
- {3763364400 -28800 1 AKDT}
- {3781504800 -32400 0 AKST}
- {3794814000 -28800 1 AKDT}
- {3812954400 -32400 0 AKST}
- {3826263600 -28800 1 AKDT}
- {3844404000 -32400 0 AKST}
- {3858318000 -28800 1 AKDT}
- {3875853600 -32400 0 AKST}
- {3889767600 -28800 1 AKDT}
- {3907303200 -32400 0 AKST}
- {3921217200 -28800 1 AKDT}
- {3939357600 -32400 0 AKST}
- {3952666800 -28800 1 AKDT}
- {3970807200 -32400 0 AKST}
- {3984116400 -28800 1 AKDT}
- {4002256800 -32400 0 AKST}
- {4016170800 -28800 1 AKDT}
- {4033706400 -32400 0 AKST}
- {4047620400 -28800 1 AKDT}
- {4065156000 -32400 0 AKST}
- {4079070000 -28800 1 AKDT}
- {4096605600 -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/Yellowknife b/library/tzdata/America/Yellowknife
index 75ad1de..44ca658 100644
--- a/library/tzdata/America/Yellowknife
+++ b/library/tzdata/America/Yellowknife
@@ -1,17 +1,14 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Yellowknife) {
- {-9223372036854775808 -27444 0 LMT}
- {-2713882956 -25200 0 MST}
- {-1632063600 -21600 1 MDT}
- {-1615132800 -25200 0 MST}
- {-1596985200 -21600 1 MDT}
- {-1583172000 -25200 0 MST}
+ {-9223372036854775808 0 0 zzz}
+ {-1104537600 -25200 0 MST}
{-880210800 -21600 1 MWT}
{-769395600 -21600 1 MPT}
{-765388800 -25200 0 MST}
{-147891600 -18000 1 MDDT}
{-131562000 -25200 0 MST}
+ {315558000 -25200 0 MST}
{325674000 -21600 1 MDT}
{341395200 -25200 0 MST}
{357123600 -21600 1 MDT}
@@ -66,190 +63,190 @@ set TZData(:America/Yellowknife) {
{1130659200 -25200 0 MST}
{1143968400 -21600 1 MDT}
{1162108800 -25200 0 MST}
- {1175418000 -21600 1 MDT}
- {1193558400 -25200 0 MST}
- {1207472400 -21600 1 MDT}
- {1225008000 -25200 0 MST}
- {1238922000 -21600 1 MDT}
- {1256457600 -25200 0 MST}
- {1270371600 -21600 1 MDT}
- {1288512000 -25200 0 MST}
- {1301821200 -21600 1 MDT}
- {1319961600 -25200 0 MST}
- {1333270800 -21600 1 MDT}
- {1351411200 -25200 0 MST}
- {1365325200 -21600 1 MDT}
- {1382860800 -25200 0 MST}
- {1396774800 -21600 1 MDT}
- {1414310400 -25200 0 MST}
- {1428224400 -21600 1 MDT}
- {1445760000 -25200 0 MST}
- {1459674000 -21600 1 MDT}
- {1477814400 -25200 0 MST}
- {1491123600 -21600 1 MDT}
- {1509264000 -25200 0 MST}
- {1522573200 -21600 1 MDT}
- {1540713600 -25200 0 MST}
- {1554627600 -21600 1 MDT}
- {1572163200 -25200 0 MST}
- {1586077200 -21600 1 MDT}
- {1603612800 -25200 0 MST}
- {1617526800 -21600 1 MDT}
- {1635667200 -25200 0 MST}
- {1648976400 -21600 1 MDT}
- {1667116800 -25200 0 MST}
- {1680426000 -21600 1 MDT}
- {1698566400 -25200 0 MST}
- {1712480400 -21600 1 MDT}
- {1730016000 -25200 0 MST}
- {1743930000 -21600 1 MDT}
- {1761465600 -25200 0 MST}
- {1775379600 -21600 1 MDT}
- {1792915200 -25200 0 MST}
- {1806829200 -21600 1 MDT}
- {1824969600 -25200 0 MST}
- {1838278800 -21600 1 MDT}
- {1856419200 -25200 0 MST}
- {1869728400 -21600 1 MDT}
- {1887868800 -25200 0 MST}
- {1901782800 -21600 1 MDT}
- {1919318400 -25200 0 MST}
- {1933232400 -21600 1 MDT}
- {1950768000 -25200 0 MST}
- {1964682000 -21600 1 MDT}
- {1982822400 -25200 0 MST}
- {1996131600 -21600 1 MDT}
- {2014272000 -25200 0 MST}
- {2027581200 -21600 1 MDT}
- {2045721600 -25200 0 MST}
- {2059030800 -21600 1 MDT}
- {2077171200 -25200 0 MST}
- {2091085200 -21600 1 MDT}
- {2108620800 -25200 0 MST}
- {2122534800 -21600 1 MDT}
- {2140070400 -25200 0 MST}
- {2153984400 -21600 1 MDT}
- {2172124800 -25200 0 MST}
- {2185434000 -21600 1 MDT}
- {2203574400 -25200 0 MST}
- {2216883600 -21600 1 MDT}
- {2235024000 -25200 0 MST}
- {2248938000 -21600 1 MDT}
- {2266473600 -25200 0 MST}
- {2280387600 -21600 1 MDT}
- {2297923200 -25200 0 MST}
- {2311837200 -21600 1 MDT}
- {2329372800 -25200 0 MST}
- {2343286800 -21600 1 MDT}
- {2361427200 -25200 0 MST}
- {2374736400 -21600 1 MDT}
- {2392876800 -25200 0 MST}
- {2406186000 -21600 1 MDT}
- {2424326400 -25200 0 MST}
- {2438240400 -21600 1 MDT}
- {2455776000 -25200 0 MST}
- {2469690000 -21600 1 MDT}
- {2487225600 -25200 0 MST}
- {2501139600 -21600 1 MDT}
- {2519280000 -25200 0 MST}
- {2532589200 -21600 1 MDT}
- {2550729600 -25200 0 MST}
- {2564038800 -21600 1 MDT}
- {2582179200 -25200 0 MST}
- {2596093200 -21600 1 MDT}
- {2613628800 -25200 0 MST}
- {2627542800 -21600 1 MDT}
- {2645078400 -25200 0 MST}
- {2658992400 -21600 1 MDT}
- {2676528000 -25200 0 MST}
- {2690442000 -21600 1 MDT}
- {2708582400 -25200 0 MST}
- {2721891600 -21600 1 MDT}
- {2740032000 -25200 0 MST}
- {2753341200 -21600 1 MDT}
- {2771481600 -25200 0 MST}
- {2785395600 -21600 1 MDT}
- {2802931200 -25200 0 MST}
- {2816845200 -21600 1 MDT}
- {2834380800 -25200 0 MST}
- {2848294800 -21600 1 MDT}
- {2866435200 -25200 0 MST}
- {2879744400 -21600 1 MDT}
- {2897884800 -25200 0 MST}
- {2911194000 -21600 1 MDT}
- {2929334400 -25200 0 MST}
- {2942643600 -21600 1 MDT}
- {2960784000 -25200 0 MST}
- {2974698000 -21600 1 MDT}
- {2992233600 -25200 0 MST}
- {3006147600 -21600 1 MDT}
- {3023683200 -25200 0 MST}
- {3037597200 -21600 1 MDT}
- {3055737600 -25200 0 MST}
- {3069046800 -21600 1 MDT}
- {3087187200 -25200 0 MST}
- {3100496400 -21600 1 MDT}
- {3118636800 -25200 0 MST}
- {3132550800 -21600 1 MDT}
- {3150086400 -25200 0 MST}
- {3164000400 -21600 1 MDT}
- {3181536000 -25200 0 MST}
- {3195450000 -21600 1 MDT}
- {3212985600 -25200 0 MST}
- {3226899600 -21600 1 MDT}
- {3245040000 -25200 0 MST}
- {3258349200 -21600 1 MDT}
- {3276489600 -25200 0 MST}
- {3289798800 -21600 1 MDT}
- {3307939200 -25200 0 MST}
- {3321853200 -21600 1 MDT}
- {3339388800 -25200 0 MST}
- {3353302800 -21600 1 MDT}
- {3370838400 -25200 0 MST}
- {3384752400 -21600 1 MDT}
- {3402892800 -25200 0 MST}
- {3416202000 -21600 1 MDT}
- {3434342400 -25200 0 MST}
- {3447651600 -21600 1 MDT}
- {3465792000 -25200 0 MST}
- {3479706000 -21600 1 MDT}
- {3497241600 -25200 0 MST}
- {3511155600 -21600 1 MDT}
- {3528691200 -25200 0 MST}
- {3542605200 -21600 1 MDT}
- {3560140800 -25200 0 MST}
- {3574054800 -21600 1 MDT}
- {3592195200 -25200 0 MST}
- {3605504400 -21600 1 MDT}
- {3623644800 -25200 0 MST}
- {3636954000 -21600 1 MDT}
- {3655094400 -25200 0 MST}
- {3669008400 -21600 1 MDT}
- {3686544000 -25200 0 MST}
- {3700458000 -21600 1 MDT}
- {3717993600 -25200 0 MST}
- {3731907600 -21600 1 MDT}
- {3750048000 -25200 0 MST}
- {3763357200 -21600 1 MDT}
- {3781497600 -25200 0 MST}
- {3794806800 -21600 1 MDT}
- {3812947200 -25200 0 MST}
- {3826256400 -21600 1 MDT}
- {3844396800 -25200 0 MST}
- {3858310800 -21600 1 MDT}
- {3875846400 -25200 0 MST}
- {3889760400 -21600 1 MDT}
- {3907296000 -25200 0 MST}
- {3921210000 -21600 1 MDT}
- {3939350400 -25200 0 MST}
- {3952659600 -21600 1 MDT}
- {3970800000 -25200 0 MST}
- {3984109200 -21600 1 MDT}
- {4002249600 -25200 0 MST}
- {4016163600 -21600 1 MDT}
- {4033699200 -25200 0 MST}
- {4047613200 -21600 1 MDT}
- {4065148800 -25200 0 MST}
- {4079062800 -21600 1 MDT}
- {4096598400 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
diff --git a/library/tzdata/Antarctica/Casey b/library/tzdata/Antarctica/Casey
index 7ac80f5..cbe3e3c 100644
--- a/library/tzdata/Antarctica/Casey
+++ b/library/tzdata/Antarctica/Casey
@@ -1,6 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Casey) {
{-9223372036854775808 0 0 zzz}
{-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 3126eac..2762d2f 100644
--- a/library/tzdata/Antarctica/Davis
+++ b/library/tzdata/Antarctica/Davis
@@ -1,8 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Davis) {
{-9223372036854775808 0 0 zzz}
{-409190400 25200 0 DAVT}
{-163062000 0 0 zzz}
{-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/DumontDUrville b/library/tzdata/Antarctica/DumontDUrville
index bfdb47e..41dc1e3 100644
--- a/library/tzdata/Antarctica/DumontDUrville
+++ b/library/tzdata/Antarctica/DumontDUrville
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/DumontDUrville) {
{-9223372036854775808 0 0 zzz}
diff --git a/library/tzdata/Antarctica/Macquarie b/library/tzdata/Antarctica/Macquarie
new file mode 100644
index 0000000..bd5cf8a
--- /dev/null
+++ b/library/tzdata/Antarctica/Macquarie
@@ -0,0 +1,97 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Antarctica/Macquarie) {
+ {-9223372036854775808 0 0 zzz}
+ {-2214259200 36000 0 EST}
+ {-1680508800 39600 1 EST}
+ {-1669892400 39600 0 EST}
+ {-1665392400 36000 0 EST}
+ {-1601719200 0 0 zzz}
+ {-94730400 36000 0 EST}
+ {-71136000 39600 1 EST}
+ {-55411200 36000 0 EST}
+ {-37267200 39600 1 EST}
+ {-25776000 36000 0 EST}
+ {-5817600 39600 1 EST}
+ {5673600 36000 0 EST}
+ {25632000 39600 1 EST}
+ {37728000 36000 0 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {89136000 39600 1 EST}
+ {100022400 36000 0 EST}
+ {120585600 39600 1 EST}
+ {131472000 36000 0 EST}
+ {152035200 39600 1 EST}
+ {162921600 36000 0 EST}
+ {183484800 39600 1 EST}
+ {194976000 36000 0 EST}
+ {215539200 39600 1 EST}
+ {226425600 36000 0 EST}
+ {246988800 39600 1 EST}
+ {257875200 36000 0 EST}
+ {278438400 39600 1 EST}
+ {289324800 36000 0 EST}
+ {309888000 39600 1 EST}
+ {320774400 36000 0 EST}
+ {341337600 39600 1 EST}
+ {352224000 36000 0 EST}
+ {372787200 39600 1 EST}
+ {386092800 36000 0 EST}
+ {404841600 39600 1 EST}
+ {417542400 36000 0 EST}
+ {436291200 39600 1 EST}
+ {447177600 36000 0 EST}
+ {467740800 39600 1 EST}
+ {478627200 36000 0 EST}
+ {499190400 39600 1 EST}
+ {510076800 36000 0 EST}
+ {530035200 39600 1 EST}
+ {542736000 36000 0 EST}
+ {562089600 39600 1 EST}
+ {574790400 36000 0 EST}
+ {594144000 39600 1 EST}
+ {606240000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {637689600 36000 0 EST}
+ {657043200 39600 1 EST}
+ {670348800 36000 0 EST}
+ {686678400 39600 1 EST}
+ {701798400 36000 0 EST}
+ {718128000 39600 1 EST}
+ {733248000 36000 0 EST}
+ {749577600 39600 1 EST}
+ {764697600 36000 0 EST}
+ {781027200 39600 1 EST}
+ {796147200 36000 0 EST}
+ {812476800 39600 1 EST}
+ {828201600 36000 0 EST}
+ {844531200 39600 1 EST}
+ {859651200 36000 0 EST}
+ {875980800 39600 1 EST}
+ {891100800 36000 0 EST}
+ {907430400 39600 1 EST}
+ {922550400 36000 0 EST}
+ {938880000 39600 1 EST}
+ {954000000 36000 0 EST}
+ {967305600 39600 1 EST}
+ {985449600 36000 0 EST}
+ {1002384000 39600 1 EST}
+ {1017504000 36000 0 EST}
+ {1033833600 39600 1 EST}
+ {1048953600 36000 0 EST}
+ {1065283200 39600 1 EST}
+ {1080403200 36000 0 EST}
+ {1096732800 39600 1 EST}
+ {1111852800 36000 0 EST}
+ {1128182400 39600 1 EST}
+ {1143907200 36000 0 EST}
+ {1159632000 39600 1 EST}
+ {1174752000 36000 0 EST}
+ {1191686400 39600 1 EST}
+ {1207411200 36000 0 EST}
+ {1223136000 39600 1 EST}
+ {1238860800 36000 0 EST}
+ {1254585600 39600 1 EST}
+ {1270310400 39600 0 MIST}
+}
diff --git a/library/tzdata/Antarctica/Mawson b/library/tzdata/Antarctica/Mawson
index ce04d98..ba03ba1 100644
--- a/library/tzdata/Antarctica/Mawson
+++ b/library/tzdata/Antarctica/Mawson
@@ -1,6 +1,7 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Mawson) {
{-9223372036854775808 0 0 zzz}
{-501206400 21600 0 MAWT}
+ {1255809600 18000 0 MAWT}
}
diff --git a/library/tzdata/Antarctica/McMurdo b/library/tzdata/Antarctica/McMurdo
index bbc81b2..3b29ba1 100644
--- a/library/tzdata/Antarctica/McMurdo
+++ b/library/tzdata/Antarctica/McMurdo
@@ -1,257 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Antarctica/McMurdo) {
- {-9223372036854775808 0 0 zzz}
- {-441849600 43200 0 NZST}
- {152676000 46800 1 NZDT}
- {162352800 43200 0 NZST}
- {183520800 46800 1 NZDT}
- {195012000 43200 0 NZST}
- {215575200 46800 1 NZDT}
- {226461600 43200 0 NZST}
- {247024800 46800 1 NZDT}
- {257911200 43200 0 NZST}
- {278474400 46800 1 NZDT}
- {289360800 43200 0 NZST}
- {309924000 46800 1 NZDT}
- {320810400 43200 0 NZST}
- {341373600 46800 1 NZDT}
- {352260000 43200 0 NZST}
- {372823200 46800 1 NZDT}
- {384314400 43200 0 NZST}
- {404877600 46800 1 NZDT}
- {415764000 43200 0 NZST}
- {436327200 46800 1 NZDT}
- {447213600 43200 0 NZST}
- {467776800 46800 1 NZDT}
- {478663200 43200 0 NZST}
- {499226400 46800 1 NZDT}
- {510112800 43200 0 NZST}
- {530676000 46800 1 NZDT}
- {541562400 43200 0 NZST}
- {562125600 46800 1 NZDT}
- {573616800 43200 0 NZST}
- {594180000 46800 1 NZDT}
- {605066400 43200 0 NZST}
- {623815200 46800 1 NZDT}
- {637725600 43200 0 NZST}
- {655264800 46800 1 NZDT}
- {669175200 43200 0 NZST}
- {686714400 46800 1 NZDT}
- {700624800 43200 0 NZST}
- {718164000 46800 1 NZDT}
- {732679200 43200 0 NZST}
- {749613600 46800 1 NZDT}
- {764128800 43200 0 NZST}
- {781063200 46800 1 NZDT}
- {795578400 43200 0 NZST}
- {812512800 46800 1 NZDT}
- {827028000 43200 0 NZST}
- {844567200 46800 1 NZDT}
- {858477600 43200 0 NZST}
- {876016800 46800 1 NZDT}
- {889927200 43200 0 NZST}
- {907466400 46800 1 NZDT}
- {921981600 43200 0 NZST}
- {938916000 46800 1 NZDT}
- {953431200 43200 0 NZST}
- {970365600 46800 1 NZDT}
- {984880800 43200 0 NZST}
- {1002420000 46800 1 NZDT}
- {1016330400 43200 0 NZST}
- {1033869600 46800 1 NZDT}
- {1047780000 43200 0 NZST}
- {1065319200 46800 1 NZDT}
- {1079834400 43200 0 NZST}
- {1096768800 46800 1 NZDT}
- {1111284000 43200 0 NZST}
- {1128218400 46800 1 NZDT}
- {1142733600 43200 0 NZST}
- {1159668000 46800 1 NZDT}
- {1174183200 43200 0 NZST}
- {1191722400 46800 1 NZDT}
- {1205632800 43200 0 NZST}
- {1223172000 46800 1 NZDT}
- {1237082400 43200 0 NZST}
- {1254621600 46800 1 NZDT}
- {1269136800 43200 0 NZST}
- {1286071200 46800 1 NZDT}
- {1300586400 43200 0 NZST}
- {1317520800 46800 1 NZDT}
- {1332036000 43200 0 NZST}
- {1349575200 46800 1 NZDT}
- {1363485600 43200 0 NZST}
- {1381024800 46800 1 NZDT}
- {1394935200 43200 0 NZST}
- {1412474400 46800 1 NZDT}
- {1426384800 43200 0 NZST}
- {1443924000 46800 1 NZDT}
- {1458439200 43200 0 NZST}
- {1475373600 46800 1 NZDT}
- {1489888800 43200 0 NZST}
- {1506823200 46800 1 NZDT}
- {1521338400 43200 0 NZST}
- {1538877600 46800 1 NZDT}
- {1552788000 43200 0 NZST}
- {1570327200 46800 1 NZDT}
- {1584237600 43200 0 NZST}
- {1601776800 46800 1 NZDT}
- {1616292000 43200 0 NZST}
- {1633226400 46800 1 NZDT}
- {1647741600 43200 0 NZST}
- {1664676000 46800 1 NZDT}
- {1679191200 43200 0 NZST}
- {1696125600 46800 1 NZDT}
- {1710640800 43200 0 NZST}
- {1728180000 46800 1 NZDT}
- {1742090400 43200 0 NZST}
- {1759629600 46800 1 NZDT}
- {1773540000 43200 0 NZST}
- {1791079200 46800 1 NZDT}
- {1805594400 43200 0 NZST}
- {1822528800 46800 1 NZDT}
- {1837044000 43200 0 NZST}
- {1853978400 46800 1 NZDT}
- {1868493600 43200 0 NZST}
- {1886032800 46800 1 NZDT}
- {1899943200 43200 0 NZST}
- {1917482400 46800 1 NZDT}
- {1931392800 43200 0 NZST}
- {1948932000 46800 1 NZDT}
- {1963447200 43200 0 NZST}
- {1980381600 46800 1 NZDT}
- {1994896800 43200 0 NZST}
- {2011831200 46800 1 NZDT}
- {2026346400 43200 0 NZST}
- {2043280800 46800 1 NZDT}
- {2057796000 43200 0 NZST}
- {2075335200 46800 1 NZDT}
- {2089245600 43200 0 NZST}
- {2106784800 46800 1 NZDT}
- {2120695200 43200 0 NZST}
- {2138234400 46800 1 NZDT}
- {2152749600 43200 0 NZST}
- {2169684000 46800 1 NZDT}
- {2184199200 43200 0 NZST}
- {2201133600 46800 1 NZDT}
- {2215648800 43200 0 NZST}
- {2233188000 46800 1 NZDT}
- {2247098400 43200 0 NZST}
- {2264637600 46800 1 NZDT}
- {2278548000 43200 0 NZST}
- {2296087200 46800 1 NZDT}
- {2309997600 43200 0 NZST}
- {2327536800 46800 1 NZDT}
- {2342052000 43200 0 NZST}
- {2358986400 46800 1 NZDT}
- {2373501600 43200 0 NZST}
- {2390436000 46800 1 NZDT}
- {2404951200 43200 0 NZST}
- {2422490400 46800 1 NZDT}
- {2436400800 43200 0 NZST}
- {2453940000 46800 1 NZDT}
- {2467850400 43200 0 NZST}
- {2485389600 46800 1 NZDT}
- {2499904800 43200 0 NZST}
- {2516839200 46800 1 NZDT}
- {2531354400 43200 0 NZST}
- {2548288800 46800 1 NZDT}
- {2562804000 43200 0 NZST}
- {2579738400 46800 1 NZDT}
- {2594253600 43200 0 NZST}
- {2611792800 46800 1 NZDT}
- {2625703200 43200 0 NZST}
- {2643242400 46800 1 NZDT}
- {2657152800 43200 0 NZST}
- {2674692000 46800 1 NZDT}
- {2689207200 43200 0 NZST}
- {2706141600 46800 1 NZDT}
- {2720656800 43200 0 NZST}
- {2737591200 46800 1 NZDT}
- {2752106400 43200 0 NZST}
- {2769645600 46800 1 NZDT}
- {2783556000 43200 0 NZST}
- {2801095200 46800 1 NZDT}
- {2815005600 43200 0 NZST}
- {2832544800 46800 1 NZDT}
- {2847060000 43200 0 NZST}
- {2863994400 46800 1 NZDT}
- {2878509600 43200 0 NZST}
- {2895444000 46800 1 NZDT}
- {2909959200 43200 0 NZST}
- {2926893600 46800 1 NZDT}
- {2941408800 43200 0 NZST}
- {2958948000 46800 1 NZDT}
- {2972858400 43200 0 NZST}
- {2990397600 46800 1 NZDT}
- {3004308000 43200 0 NZST}
- {3021847200 46800 1 NZDT}
- {3036362400 43200 0 NZST}
- {3053296800 46800 1 NZDT}
- {3067812000 43200 0 NZST}
- {3084746400 46800 1 NZDT}
- {3099261600 43200 0 NZST}
- {3116800800 46800 1 NZDT}
- {3130711200 43200 0 NZST}
- {3148250400 46800 1 NZDT}
- {3162160800 43200 0 NZST}
- {3179700000 46800 1 NZDT}
- {3193610400 43200 0 NZST}
- {3211149600 46800 1 NZDT}
- {3225664800 43200 0 NZST}
- {3242599200 46800 1 NZDT}
- {3257114400 43200 0 NZST}
- {3274048800 46800 1 NZDT}
- {3288564000 43200 0 NZST}
- {3306103200 46800 1 NZDT}
- {3320013600 43200 0 NZST}
- {3337552800 46800 1 NZDT}
- {3351463200 43200 0 NZST}
- {3369002400 46800 1 NZDT}
- {3383517600 43200 0 NZST}
- {3400452000 46800 1 NZDT}
- {3414967200 43200 0 NZST}
- {3431901600 46800 1 NZDT}
- {3446416800 43200 0 NZST}
- {3463351200 46800 1 NZDT}
- {3477866400 43200 0 NZST}
- {3495405600 46800 1 NZDT}
- {3509316000 43200 0 NZST}
- {3526855200 46800 1 NZDT}
- {3540765600 43200 0 NZST}
- {3558304800 46800 1 NZDT}
- {3572820000 43200 0 NZST}
- {3589754400 46800 1 NZDT}
- {3604269600 43200 0 NZST}
- {3621204000 46800 1 NZDT}
- {3635719200 43200 0 NZST}
- {3653258400 46800 1 NZDT}
- {3667168800 43200 0 NZST}
- {3684708000 46800 1 NZDT}
- {3698618400 43200 0 NZST}
- {3716157600 46800 1 NZDT}
- {3730672800 43200 0 NZST}
- {3747607200 46800 1 NZDT}
- {3762122400 43200 0 NZST}
- {3779056800 46800 1 NZDT}
- {3793572000 43200 0 NZST}
- {3810506400 46800 1 NZDT}
- {3825021600 43200 0 NZST}
- {3842560800 46800 1 NZDT}
- {3856471200 43200 0 NZST}
- {3874010400 46800 1 NZDT}
- {3887920800 43200 0 NZST}
- {3905460000 46800 1 NZDT}
- {3919975200 43200 0 NZST}
- {3936909600 46800 1 NZDT}
- {3951424800 43200 0 NZST}
- {3968359200 46800 1 NZDT}
- {3982874400 43200 0 NZST}
- {4000413600 46800 1 NZDT}
- {4014324000 43200 0 NZST}
- {4031863200 46800 1 NZDT}
- {4045773600 43200 0 NZST}
- {4063312800 46800 1 NZDT}
- {4077223200 43200 0 NZST}
- {4094762400 46800 1 NZDT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Auckland)]} {
+ LoadTimeZoneFile Pacific/Auckland
}
+set TZData(:Antarctica/McMurdo) $TZData(:Pacific/Auckland)
diff --git a/library/tzdata/Antarctica/Palmer b/library/tzdata/Antarctica/Palmer
index aae0519..e87b171 100644
--- a/library/tzdata/Antarctica/Palmer
+++ b/library/tzdata/Antarctica/Palmer
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Palmer) {
{-9223372036854775808 0 0 zzz}
@@ -7,7 +7,7 @@ set TZData(:Antarctica/Palmer) {
{-132955200 -10800 1 ARST}
{-121122000 -14400 0 ART}
{-101419200 -10800 1 ARST}
- {-86907600 -14400 0 ART}
+ {-86821200 -14400 0 ART}
{-71092800 -10800 1 ARST}
{-54766800 -14400 0 ART}
{-39038400 -10800 1 ARST}
@@ -15,12 +15,6 @@ set TZData(:Antarctica/Palmer) {
{-7588800 -10800 0 ART}
{128142000 -7200 1 ARST}
{136605600 -10800 0 ART}
- {150260400 -7200 1 ARST}
- {165981600 -10800 0 ART}
- {181710000 -7200 1 ARST}
- {197431200 -10800 0 ART}
- {213159600 -7200 1 ARST}
- {228880800 -10800 0 ART}
{389070000 -14400 0 CLT}
{403070400 -10800 1 CLST}
{416372400 -14400 0 CLT}
@@ -31,14 +25,14 @@ set TZData(:Antarctica/Palmer) {
{498024000 -10800 1 CLST}
{510721200 -14400 0 CLT}
{529473600 -10800 1 CLST}
- {542775600 -14400 0 CLT}
+ {545194800 -14400 0 CLT}
{560923200 -10800 1 CLST}
{574225200 -14400 0 CLT}
- {592372800 -10800 1 CLST}
+ {591768000 -10800 1 CLST}
{605674800 -14400 0 CLT}
{624427200 -10800 1 CLST}
- {637124400 -14400 0 CLT}
- {655876800 -10800 1 CLST}
+ {637729200 -14400 0 CLT}
+ {653457600 -10800 1 CLST}
{668574000 -14400 0 CLT}
{687326400 -10800 1 CLST}
{700628400 -14400 0 CLT}
@@ -51,7 +45,7 @@ set TZData(:Antarctica/Palmer) {
{813729600 -10800 1 CLST}
{826426800 -14400 0 CLT}
{845179200 -10800 1 CLST}
- {857876400 -14400 0 CLT}
+ {859690800 -14400 0 CLT}
{876628800 -10800 1 CLST}
{889930800 -14400 0 CLT}
{906868800 -10800 1 CLST}
@@ -73,188 +67,188 @@ 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}
- {1362884400 -14400 0 CLT}
- {1381636800 -10800 1 CLST}
- {1394334000 -14400 0 CLT}
- {1413086400 -10800 1 CLST}
- {1426388400 -14400 0 CLT}
- {1444536000 -10800 1 CLST}
- {1457838000 -14400 0 CLT}
- {1475985600 -10800 1 CLST}
- {1489287600 -14400 0 CLT}
- {1508040000 -10800 1 CLST}
- {1520737200 -14400 0 CLT}
- {1539489600 -10800 1 CLST}
- {1552186800 -14400 0 CLT}
- {1570939200 -10800 1 CLST}
- {1584241200 -14400 0 CLT}
- {1602388800 -10800 1 CLST}
- {1615690800 -14400 0 CLT}
- {1633838400 -10800 1 CLST}
- {1647140400 -14400 0 CLT}
- {1665288000 -10800 1 CLST}
- {1678590000 -14400 0 CLT}
- {1697342400 -10800 1 CLST}
- {1710039600 -14400 0 CLT}
- {1728792000 -10800 1 CLST}
- {1741489200 -14400 0 CLT}
- {1760241600 -10800 1 CLST}
- {1773543600 -14400 0 CLT}
- {1791691200 -10800 1 CLST}
- {1804993200 -14400 0 CLT}
- {1823140800 -10800 1 CLST}
- {1836442800 -14400 0 CLT}
- {1855195200 -10800 1 CLST}
- {1867892400 -14400 0 CLT}
- {1886644800 -10800 1 CLST}
- {1899342000 -14400 0 CLT}
- {1918094400 -10800 1 CLST}
- {1930791600 -14400 0 CLT}
- {1949544000 -10800 1 CLST}
- {1962846000 -14400 0 CLT}
- {1980993600 -10800 1 CLST}
- {1994295600 -14400 0 CLT}
- {2012443200 -10800 1 CLST}
- {2025745200 -14400 0 CLT}
- {2044497600 -10800 1 CLST}
- {2057194800 -14400 0 CLT}
- {2075947200 -10800 1 CLST}
- {2088644400 -14400 0 CLT}
- {2107396800 -10800 1 CLST}
- {2120698800 -14400 0 CLT}
- {2138846400 -10800 1 CLST}
- {2152148400 -14400 0 CLT}
- {2170296000 -10800 1 CLST}
- {2183598000 -14400 0 CLT}
- {2201745600 -10800 1 CLST}
- {2215047600 -14400 0 CLT}
- {2233800000 -10800 1 CLST}
- {2246497200 -14400 0 CLT}
- {2265249600 -10800 1 CLST}
- {2277946800 -14400 0 CLT}
- {2296699200 -10800 1 CLST}
- {2310001200 -14400 0 CLT}
- {2328148800 -10800 1 CLST}
- {2341450800 -14400 0 CLT}
- {2359598400 -10800 1 CLST}
- {2372900400 -14400 0 CLT}
- {2391652800 -10800 1 CLST}
- {2404350000 -14400 0 CLT}
- {2423102400 -10800 1 CLST}
- {2435799600 -14400 0 CLT}
- {2454552000 -10800 1 CLST}
- {2467854000 -14400 0 CLT}
- {2486001600 -10800 1 CLST}
- {2499303600 -14400 0 CLT}
- {2517451200 -10800 1 CLST}
- {2530753200 -14400 0 CLT}
- {2548900800 -10800 1 CLST}
- {2562202800 -14400 0 CLT}
- {2580955200 -10800 1 CLST}
- {2593652400 -14400 0 CLT}
- {2612404800 -10800 1 CLST}
- {2625102000 -14400 0 CLT}
- {2643854400 -10800 1 CLST}
- {2657156400 -14400 0 CLT}
- {2675304000 -10800 1 CLST}
- {2688606000 -14400 0 CLT}
- {2706753600 -10800 1 CLST}
- {2720055600 -14400 0 CLT}
- {2738808000 -10800 1 CLST}
- {2751505200 -14400 0 CLT}
- {2770257600 -10800 1 CLST}
- {2782954800 -14400 0 CLT}
- {2801707200 -10800 1 CLST}
- {2814404400 -14400 0 CLT}
- {2833156800 -10800 1 CLST}
- {2846458800 -14400 0 CLT}
- {2864606400 -10800 1 CLST}
- {2877908400 -14400 0 CLT}
- {2896056000 -10800 1 CLST}
- {2909358000 -14400 0 CLT}
- {2928110400 -10800 1 CLST}
- {2940807600 -14400 0 CLT}
- {2959560000 -10800 1 CLST}
- {2972257200 -14400 0 CLT}
- {2991009600 -10800 1 CLST}
- {3004311600 -14400 0 CLT}
- {3022459200 -10800 1 CLST}
- {3035761200 -14400 0 CLT}
- {3053908800 -10800 1 CLST}
- {3067210800 -14400 0 CLT}
- {3085358400 -10800 1 CLST}
- {3098660400 -14400 0 CLT}
- {3117412800 -10800 1 CLST}
- {3130110000 -14400 0 CLT}
- {3148862400 -10800 1 CLST}
- {3161559600 -14400 0 CLT}
- {3180312000 -10800 1 CLST}
- {3193614000 -14400 0 CLT}
- {3211761600 -10800 1 CLST}
- {3225063600 -14400 0 CLT}
- {3243211200 -10800 1 CLST}
- {3256513200 -14400 0 CLT}
- {3275265600 -10800 1 CLST}
- {3287962800 -14400 0 CLT}
- {3306715200 -10800 1 CLST}
- {3319412400 -14400 0 CLT}
- {3338164800 -10800 1 CLST}
- {3351466800 -14400 0 CLT}
- {3369614400 -10800 1 CLST}
- {3382916400 -14400 0 CLT}
- {3401064000 -10800 1 CLST}
- {3414366000 -14400 0 CLT}
- {3432513600 -10800 1 CLST}
- {3445815600 -14400 0 CLT}
- {3464568000 -10800 1 CLST}
- {3477265200 -14400 0 CLT}
- {3496017600 -10800 1 CLST}
- {3508714800 -14400 0 CLT}
- {3527467200 -10800 1 CLST}
- {3540769200 -14400 0 CLT}
- {3558916800 -10800 1 CLST}
- {3572218800 -14400 0 CLT}
- {3590366400 -10800 1 CLST}
- {3603668400 -14400 0 CLT}
- {3622420800 -10800 1 CLST}
- {3635118000 -14400 0 CLT}
- {3653870400 -10800 1 CLST}
- {3666567600 -14400 0 CLT}
- {3685320000 -10800 1 CLST}
- {3698017200 -14400 0 CLT}
- {3716769600 -10800 1 CLST}
- {3730071600 -14400 0 CLT}
- {3748219200 -10800 1 CLST}
- {3761521200 -14400 0 CLT}
- {3779668800 -10800 1 CLST}
- {3792970800 -14400 0 CLT}
- {3811723200 -10800 1 CLST}
- {3824420400 -14400 0 CLT}
- {3843172800 -10800 1 CLST}
- {3855870000 -14400 0 CLT}
- {3874622400 -10800 1 CLST}
- {3887924400 -14400 0 CLT}
- {3906072000 -10800 1 CLST}
- {3919374000 -14400 0 CLT}
- {3937521600 -10800 1 CLST}
- {3950823600 -14400 0 CLT}
- {3968971200 -10800 1 CLST}
- {3982273200 -14400 0 CLT}
- {4001025600 -10800 1 CLST}
- {4013722800 -14400 0 CLT}
- {4032475200 -10800 1 CLST}
- {4045172400 -14400 0 CLT}
- {4063924800 -10800 1 CLST}
- {4077226800 -14400 0 CLT}
- {4095374400 -10800 1 CLST}
+ {1304823600 -14400 0 CLT}
+ {1313899200 -10800 1 CLST}
+ {1335668400 -14400 0 CLT}
+ {1346558400 -10800 1 CLST}
+ {1367118000 -14400 0 CLT}
+ {1378612800 -10800 1 CLST}
+ {1398567600 -14400 0 CLT}
+ {1410062400 -10800 1 CLST}
+ {1430017200 -14400 0 CLT}
+ {1441512000 -10800 1 CLST}
+ {1461466800 -14400 0 CLT}
+ {1472961600 -10800 1 CLST}
+ {1492916400 -14400 0 CLT}
+ {1504411200 -10800 1 CLST}
+ {1524970800 -14400 0 CLT}
+ {1535860800 -10800 1 CLST}
+ {1556420400 -14400 0 CLT}
+ {1567915200 -10800 1 CLST}
+ {1587870000 -14400 0 CLT}
+ {1599364800 -10800 1 CLST}
+ {1619319600 -14400 0 CLT}
+ {1630814400 -10800 1 CLST}
+ {1650769200 -14400 0 CLT}
+ {1662264000 -10800 1 CLST}
+ {1682218800 -14400 0 CLT}
+ {1693713600 -10800 1 CLST}
+ {1714273200 -14400 0 CLT}
+ {1725768000 -10800 1 CLST}
+ {1745722800 -14400 0 CLT}
+ {1757217600 -10800 1 CLST}
+ {1777172400 -14400 0 CLT}
+ {1788667200 -10800 1 CLST}
+ {1808622000 -14400 0 CLT}
+ {1820116800 -10800 1 CLST}
+ {1840071600 -14400 0 CLT}
+ {1851566400 -10800 1 CLST}
+ {1872126000 -14400 0 CLT}
+ {1883016000 -10800 1 CLST}
+ {1903575600 -14400 0 CLT}
+ {1915070400 -10800 1 CLST}
+ {1935025200 -14400 0 CLT}
+ {1946520000 -10800 1 CLST}
+ {1966474800 -14400 0 CLT}
+ {1977969600 -10800 1 CLST}
+ {1997924400 -14400 0 CLT}
+ {2009419200 -10800 1 CLST}
+ {2029374000 -14400 0 CLT}
+ {2040868800 -10800 1 CLST}
+ {2061428400 -14400 0 CLT}
+ {2072318400 -10800 1 CLST}
+ {2092878000 -14400 0 CLT}
+ {2104372800 -10800 1 CLST}
+ {2124327600 -14400 0 CLT}
+ {2135822400 -10800 1 CLST}
+ {2155777200 -14400 0 CLT}
+ {2167272000 -10800 1 CLST}
+ {2187226800 -14400 0 CLT}
+ {2198721600 -10800 1 CLST}
+ {2219281200 -14400 0 CLT}
+ {2230171200 -10800 1 CLST}
+ {2250730800 -14400 0 CLT}
+ {2262225600 -10800 1 CLST}
+ {2282180400 -14400 0 CLT}
+ {2293675200 -10800 1 CLST}
+ {2313630000 -14400 0 CLT}
+ {2325124800 -10800 1 CLST}
+ {2345079600 -14400 0 CLT}
+ {2356574400 -10800 1 CLST}
+ {2376529200 -14400 0 CLT}
+ {2388024000 -10800 1 CLST}
+ {2408583600 -14400 0 CLT}
+ {2419473600 -10800 1 CLST}
+ {2440033200 -14400 0 CLT}
+ {2451528000 -10800 1 CLST}
+ {2471482800 -14400 0 CLT}
+ {2482977600 -10800 1 CLST}
+ {2502932400 -14400 0 CLT}
+ {2514427200 -10800 1 CLST}
+ {2534382000 -14400 0 CLT}
+ {2545876800 -10800 1 CLST}
+ {2565831600 -14400 0 CLT}
+ {2577326400 -10800 1 CLST}
+ {2597886000 -14400 0 CLT}
+ {2609380800 -10800 1 CLST}
+ {2629335600 -14400 0 CLT}
+ {2640830400 -10800 1 CLST}
+ {2660785200 -14400 0 CLT}
+ {2672280000 -10800 1 CLST}
+ {2692234800 -14400 0 CLT}
+ {2703729600 -10800 1 CLST}
+ {2723684400 -14400 0 CLT}
+ {2735179200 -10800 1 CLST}
+ {2755738800 -14400 0 CLT}
+ {2766628800 -10800 1 CLST}
+ {2787188400 -14400 0 CLT}
+ {2798683200 -10800 1 CLST}
+ {2818638000 -14400 0 CLT}
+ {2830132800 -10800 1 CLST}
+ {2850087600 -14400 0 CLT}
+ {2861582400 -10800 1 CLST}
+ {2881537200 -14400 0 CLT}
+ {2893032000 -10800 1 CLST}
+ {2912986800 -14400 0 CLT}
+ {2924481600 -10800 1 CLST}
+ {2945041200 -14400 0 CLT}
+ {2955931200 -10800 1 CLST}
+ {2976490800 -14400 0 CLT}
+ {2987985600 -10800 1 CLST}
+ {3007940400 -14400 0 CLT}
+ {3019435200 -10800 1 CLST}
+ {3039390000 -14400 0 CLT}
+ {3050884800 -10800 1 CLST}
+ {3070839600 -14400 0 CLT}
+ {3082334400 -10800 1 CLST}
+ {3102894000 -14400 0 CLT}
+ {3113784000 -10800 1 CLST}
+ {3134343600 -14400 0 CLT}
+ {3145838400 -10800 1 CLST}
+ {3165793200 -14400 0 CLT}
+ {3177288000 -10800 1 CLST}
+ {3197242800 -14400 0 CLT}
+ {3208737600 -10800 1 CLST}
+ {3228692400 -14400 0 CLT}
+ {3240187200 -10800 1 CLST}
+ {3260142000 -14400 0 CLT}
+ {3271636800 -10800 1 CLST}
+ {3292196400 -14400 0 CLT}
+ {3303086400 -10800 1 CLST}
+ {3323646000 -14400 0 CLT}
+ {3335140800 -10800 1 CLST}
+ {3355095600 -14400 0 CLT}
+ {3366590400 -10800 1 CLST}
+ {3386545200 -14400 0 CLT}
+ {3398040000 -10800 1 CLST}
+ {3417994800 -14400 0 CLT}
+ {3429489600 -10800 1 CLST}
+ {3449444400 -14400 0 CLT}
+ {3460939200 -10800 1 CLST}
+ {3481498800 -14400 0 CLT}
+ {3492993600 -10800 1 CLST}
+ {3512948400 -14400 0 CLT}
+ {3524443200 -10800 1 CLST}
+ {3544398000 -14400 0 CLT}
+ {3555892800 -10800 1 CLST}
+ {3575847600 -14400 0 CLT}
+ {3587342400 -10800 1 CLST}
+ {3607297200 -14400 0 CLT}
+ {3618792000 -10800 1 CLST}
+ {3639351600 -14400 0 CLT}
+ {3650241600 -10800 1 CLST}
+ {3670801200 -14400 0 CLT}
+ {3682296000 -10800 1 CLST}
+ {3702250800 -14400 0 CLT}
+ {3713745600 -10800 1 CLST}
+ {3733700400 -14400 0 CLT}
+ {3745195200 -10800 1 CLST}
+ {3765150000 -14400 0 CLT}
+ {3776644800 -10800 1 CLST}
+ {3796599600 -14400 0 CLT}
+ {3808094400 -10800 1 CLST}
+ {3828654000 -14400 0 CLT}
+ {3839544000 -10800 1 CLST}
+ {3860103600 -14400 0 CLT}
+ {3871598400 -10800 1 CLST}
+ {3891553200 -14400 0 CLT}
+ {3903048000 -10800 1 CLST}
+ {3923002800 -14400 0 CLT}
+ {3934497600 -10800 1 CLST}
+ {3954452400 -14400 0 CLT}
+ {3965947200 -10800 1 CLST}
+ {3986506800 -14400 0 CLT}
+ {3997396800 -10800 1 CLST}
+ {4017956400 -14400 0 CLT}
+ {4029451200 -10800 1 CLST}
+ {4049406000 -14400 0 CLT}
+ {4060900800 -10800 1 CLST}
+ {4080855600 -14400 0 CLT}
+ {4092350400 -10800 1 CLST}
}
diff --git a/library/tzdata/Antarctica/Rothera b/library/tzdata/Antarctica/Rothera
index d32a426..24d7f3e 100644
--- a/library/tzdata/Antarctica/Rothera
+++ b/library/tzdata/Antarctica/Rothera
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Rothera) {
{-9223372036854775808 0 0 zzz}
diff --git a/library/tzdata/Antarctica/South_Pole b/library/tzdata/Antarctica/South_Pole
index 08d94b7..544bde4 100644
--- a/library/tzdata/Antarctica/South_Pole
+++ b/library/tzdata/Antarctica/South_Pole
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(Antarctica/McMurdo)]} {
- LoadTimeZoneFile Antarctica/McMurdo
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Auckland)]} {
+ LoadTimeZoneFile Pacific/Auckland
}
-set TZData(:Antarctica/South_Pole) $TZData(:Antarctica/McMurdo)
+set TZData(:Antarctica/South_Pole) $TZData(:Pacific/Auckland)
diff --git a/library/tzdata/Antarctica/Syowa b/library/tzdata/Antarctica/Syowa
index 19050a8..4d046b5 100644
--- a/library/tzdata/Antarctica/Syowa
+++ b/library/tzdata/Antarctica/Syowa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Syowa) {
{-9223372036854775808 0 0 zzz}
diff --git a/library/tzdata/Antarctica/Vostok b/library/tzdata/Antarctica/Vostok
index 6ba97b6..f846f65 100644
--- a/library/tzdata/Antarctica/Vostok
+++ b/library/tzdata/Antarctica/Vostok
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Vostok) {
{-9223372036854775808 0 0 zzz}
diff --git a/library/tzdata/Arctic/Longyearbyen b/library/tzdata/Arctic/Longyearbyen
index bf39e47..51f83dc 100644
--- a/library/tzdata/Arctic/Longyearbyen
+++ b/library/tzdata/Arctic/Longyearbyen
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
LoadTimeZoneFile Europe/Oslo
}
diff --git a/library/tzdata/Asia/Aden b/library/tzdata/Asia/Aden
index e7280dd..399d9f0 100644
--- a/library/tzdata/Asia/Aden
+++ b/library/tzdata/Asia/Aden
@@ -1,6 +1,6 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Aden) {
- {-9223372036854775808 10848 0 LMT}
- {-631162848 10800 0 AST}
+ {-9223372036854775808 10794 0 LMT}
+ {-631162794 10800 0 AST}
}
diff --git a/library/tzdata/Asia/Almaty b/library/tzdata/Asia/Almaty
index 3a29b3e..68dee29 100644
--- a/library/tzdata/Asia/Almaty
+++ b/library/tzdata/Asia/Almaty
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Almaty) {
{-9223372036854775808 18468 0 LMT}
@@ -11,46 +11,46 @@ set TZData(:Asia/Almaty) {
{417981600 25200 1 ALMST}
{433789200 21600 0 ALMT}
{449604000 25200 1 ALMST}
- {465357600 21600 0 ALMT}
- {481082400 25200 1 ALMST}
- {496807200 21600 0 ALMT}
- {512532000 25200 1 ALMST}
- {528256800 21600 0 ALMT}
- {543981600 25200 1 ALMST}
- {559706400 21600 0 ALMT}
- {575431200 25200 1 ALMST}
- {591156000 21600 0 ALMT}
- {606880800 25200 1 ALMST}
- {622605600 21600 0 ALMT}
- {638330400 25200 1 ALMST}
- {654660000 21600 0 ALMT}
+ {465336000 21600 0 ALMT}
+ {481060800 25200 1 ALMST}
+ {496785600 21600 0 ALMT}
+ {512510400 25200 1 ALMST}
+ {528235200 21600 0 ALMT}
+ {543960000 25200 1 ALMST}
+ {559684800 21600 0 ALMT}
+ {575409600 25200 1 ALMST}
+ {591134400 21600 0 ALMT}
+ {606859200 25200 1 ALMST}
+ {622584000 21600 0 ALMT}
+ {638308800 25200 1 ALMST}
+ {654638400 21600 0 ALMT}
{662666400 21600 0 ALMT}
{694202400 21600 0 ALMT}
{701802000 25200 1 ALMST}
{717523200 21600 0 ALMT}
- {733284000 25200 1 ALMST}
- {749008800 21600 0 ALMT}
- {764733600 25200 1 ALMST}
- {780458400 21600 0 ALMT}
- {796183200 25200 1 ALMST}
- {811908000 21600 0 ALMT}
- {828237600 25200 1 ALMST}
- {846381600 21600 0 ALMT}
- {859687200 25200 1 ALMST}
- {877831200 21600 0 ALMT}
- {891136800 25200 1 ALMST}
- {909280800 21600 0 ALMT}
- {922586400 25200 1 ALMST}
- {941335200 21600 0 ALMT}
- {954036000 25200 1 ALMST}
- {972784800 21600 0 ALMT}
- {985485600 25200 1 ALMST}
- {1004234400 21600 0 ALMT}
- {1017540000 25200 1 ALMST}
- {1035684000 21600 0 ALMT}
- {1048989600 25200 1 ALMST}
- {1067133600 21600 0 ALMT}
- {1080439200 25200 1 ALMST}
- {1099188000 21600 0 ALMT}
+ {733262400 25200 1 ALMST}
+ {748987200 21600 0 ALMT}
+ {764712000 25200 1 ALMST}
+ {780436800 21600 0 ALMT}
+ {796161600 25200 1 ALMST}
+ {811886400 21600 0 ALMT}
+ {828216000 25200 1 ALMST}
+ {846360000 21600 0 ALMT}
+ {859665600 25200 1 ALMST}
+ {877809600 21600 0 ALMT}
+ {891115200 25200 1 ALMST}
+ {909259200 21600 0 ALMT}
+ {922564800 25200 1 ALMST}
+ {941313600 21600 0 ALMT}
+ {954014400 25200 1 ALMST}
+ {972763200 21600 0 ALMT}
+ {985464000 25200 1 ALMST}
+ {1004212800 21600 0 ALMT}
+ {1017518400 25200 1 ALMST}
+ {1035662400 21600 0 ALMT}
+ {1048968000 25200 1 ALMST}
+ {1067112000 21600 0 ALMT}
+ {1080417600 25200 1 ALMST}
+ {1099166400 21600 0 ALMT}
{1110823200 21600 0 ALMT}
}
diff --git a/library/tzdata/Asia/Amman b/library/tzdata/Asia/Amman
index 48c3782..d5e8616 100644
--- a/library/tzdata/Asia/Amman
+++ b/library/tzdata/Asia/Amman
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Amman) {
{-9223372036854775808 8624 0 LMT}
@@ -36,213 +36,39 @@ set TZData(:Asia/Amman) {
{765151200 10800 1 EEST}
{779662800 7200 0 EET}
{797205600 10800 1 EEST}
- {811123200 7200 0 EET}
+ {811116000 7200 0 EET}
{828655200 10800 1 EEST}
- {843177600 7200 0 EET}
+ {843170400 7200 0 EET}
{860104800 10800 1 EEST}
- {874627200 7200 0 EET}
+ {874620000 7200 0 EET}
{891554400 10800 1 EEST}
- {906076800 7200 0 EET}
- {930787200 10800 1 EEST}
- {938649600 7200 0 EET}
- {954374400 10800 1 EEST}
- {970099200 7200 0 EET}
- {985824000 10800 1 EEST}
- {1001548800 7200 0 EET}
- {1017273600 10800 1 EEST}
- {1032998400 7200 0 EET}
- {1048723200 10800 1 EEST}
- {1064448000 7200 0 EET}
- {1080172800 10800 1 EEST}
- {1096502400 7200 0 EET}
- {1112227200 10800 1 EEST}
- {1127952000 7200 0 EET}
- {1143676800 10800 1 EEST}
- {1159401600 7200 0 EET}
- {1175126400 10800 1 EEST}
- {1190851200 7200 0 EET}
- {1206576000 10800 1 EEST}
- {1222300800 7200 0 EET}
- {1238025600 10800 1 EEST}
- {1253750400 7200 0 EET}
- {1269475200 10800 1 EEST}
- {1285804800 7200 0 EET}
- {1301529600 10800 1 EEST}
- {1317254400 7200 0 EET}
- {1332979200 10800 1 EEST}
- {1348704000 7200 0 EET}
- {1364428800 10800 1 EEST}
- {1380153600 7200 0 EET}
- {1395878400 10800 1 EEST}
- {1411603200 7200 0 EET}
- {1427328000 10800 1 EEST}
- {1443052800 7200 0 EET}
- {1459382400 10800 1 EEST}
- {1475107200 7200 0 EET}
- {1490832000 10800 1 EEST}
- {1506556800 7200 0 EET}
- {1522281600 10800 1 EEST}
- {1538006400 7200 0 EET}
- {1553731200 10800 1 EEST}
- {1569456000 7200 0 EET}
- {1585180800 10800 1 EEST}
- {1600905600 7200 0 EET}
- {1616630400 10800 1 EEST}
- {1632960000 7200 0 EET}
- {1648684800 10800 1 EEST}
- {1664409600 7200 0 EET}
- {1680134400 10800 1 EEST}
- {1695859200 7200 0 EET}
- {1711584000 10800 1 EEST}
- {1727308800 7200 0 EET}
- {1743033600 10800 1 EEST}
- {1758758400 7200 0 EET}
- {1774483200 10800 1 EEST}
- {1790208000 7200 0 EET}
- {1805932800 10800 1 EEST}
- {1822262400 7200 0 EET}
- {1837987200 10800 1 EEST}
- {1853712000 7200 0 EET}
- {1869436800 10800 1 EEST}
- {1885161600 7200 0 EET}
- {1900886400 10800 1 EEST}
- {1916611200 7200 0 EET}
- {1932336000 10800 1 EEST}
- {1948060800 7200 0 EET}
- {1963785600 10800 1 EEST}
- {1980115200 7200 0 EET}
- {1995840000 10800 1 EEST}
- {2011564800 7200 0 EET}
- {2027289600 10800 1 EEST}
- {2043014400 7200 0 EET}
- {2058739200 10800 1 EEST}
- {2074464000 7200 0 EET}
- {2090188800 10800 1 EEST}
- {2105913600 7200 0 EET}
- {2121638400 10800 1 EEST}
- {2137363200 7200 0 EET}
- {2153088000 10800 1 EEST}
- {2169417600 7200 0 EET}
- {2185142400 10800 1 EEST}
- {2200867200 7200 0 EET}
- {2216592000 10800 1 EEST}
- {2232316800 7200 0 EET}
- {2248041600 10800 1 EEST}
- {2263766400 7200 0 EET}
- {2279491200 10800 1 EEST}
- {2295216000 7200 0 EET}
- {2310940800 10800 1 EEST}
- {2326665600 7200 0 EET}
- {2342995200 10800 1 EEST}
- {2358720000 7200 0 EET}
- {2374444800 10800 1 EEST}
- {2390169600 7200 0 EET}
- {2405894400 10800 1 EEST}
- {2421619200 7200 0 EET}
- {2437344000 10800 1 EEST}
- {2453068800 7200 0 EET}
- {2468793600 10800 1 EEST}
- {2484518400 7200 0 EET}
- {2500243200 10800 1 EEST}
- {2516572800 7200 0 EET}
- {2532297600 10800 1 EEST}
- {2548022400 7200 0 EET}
- {2563747200 10800 1 EEST}
- {2579472000 7200 0 EET}
- {2595196800 10800 1 EEST}
- {2610921600 7200 0 EET}
- {2626646400 10800 1 EEST}
- {2642371200 7200 0 EET}
- {2658096000 10800 1 EEST}
- {2673820800 7200 0 EET}
- {2689545600 10800 1 EEST}
- {2705875200 7200 0 EET}
- {2721600000 10800 1 EEST}
- {2737324800 7200 0 EET}
- {2753049600 10800 1 EEST}
- {2768774400 7200 0 EET}
- {2784499200 10800 1 EEST}
- {2800224000 7200 0 EET}
- {2815948800 10800 1 EEST}
- {2831673600 7200 0 EET}
- {2847398400 10800 1 EEST}
- {2863728000 7200 0 EET}
- {2879452800 10800 1 EEST}
- {2895177600 7200 0 EET}
- {2910902400 10800 1 EEST}
- {2926627200 7200 0 EET}
- {2942352000 10800 1 EEST}
- {2958076800 7200 0 EET}
- {2973801600 10800 1 EEST}
- {2989526400 7200 0 EET}
- {3005251200 10800 1 EEST}
- {3020976000 7200 0 EET}
- {3036700800 10800 1 EEST}
- {3053030400 7200 0 EET}
- {3068755200 10800 1 EEST}
- {3084480000 7200 0 EET}
- {3100204800 10800 1 EEST}
- {3115929600 7200 0 EET}
- {3131654400 10800 1 EEST}
- {3147379200 7200 0 EET}
- {3163104000 10800 1 EEST}
- {3178828800 7200 0 EET}
- {3194553600 10800 1 EEST}
- {3210278400 7200 0 EET}
- {3226608000 10800 1 EEST}
- {3242332800 7200 0 EET}
- {3258057600 10800 1 EEST}
- {3273782400 7200 0 EET}
- {3289507200 10800 1 EEST}
- {3305232000 7200 0 EET}
- {3320956800 10800 1 EEST}
- {3336681600 7200 0 EET}
- {3352406400 10800 1 EEST}
- {3368131200 7200 0 EET}
- {3383856000 10800 1 EEST}
- {3400185600 7200 0 EET}
- {3415910400 10800 1 EEST}
- {3431635200 7200 0 EET}
- {3447360000 10800 1 EEST}
- {3463084800 7200 0 EET}
- {3478809600 10800 1 EEST}
- {3494534400 7200 0 EET}
- {3510259200 10800 1 EEST}
- {3525984000 7200 0 EET}
- {3541708800 10800 1 EEST}
- {3557433600 7200 0 EET}
- {3573158400 10800 1 EEST}
- {3589488000 7200 0 EET}
- {3605212800 10800 1 EEST}
- {3620937600 7200 0 EET}
- {3636662400 10800 1 EEST}
- {3652387200 7200 0 EET}
- {3668112000 10800 1 EEST}
- {3683836800 7200 0 EET}
- {3699561600 10800 1 EEST}
- {3715286400 7200 0 EET}
- {3731011200 10800 1 EEST}
- {3747340800 7200 0 EET}
- {3763065600 10800 1 EEST}
- {3778790400 7200 0 EET}
- {3794515200 10800 1 EEST}
- {3810240000 7200 0 EET}
- {3825964800 10800 1 EEST}
- {3841689600 7200 0 EET}
- {3857414400 10800 1 EEST}
- {3873139200 7200 0 EET}
- {3888864000 10800 1 EEST}
- {3904588800 7200 0 EET}
- {3920313600 10800 1 EEST}
- {3936643200 7200 0 EET}
- {3952368000 10800 1 EEST}
- {3968092800 7200 0 EET}
- {3983817600 10800 1 EEST}
- {3999542400 7200 0 EET}
- {4015267200 10800 1 EEST}
- {4030992000 7200 0 EET}
- {4046716800 10800 1 EEST}
- {4062441600 7200 0 EET}
- {4078166400 10800 1 EEST}
- {4093891200 7200 0 EET}
+ {906069600 7200 0 EET}
+ {930780000 10800 1 EEST}
+ {938124000 7200 0 EET}
+ {954367200 10800 1 EEST}
+ {970178400 7200 0 EET}
+ {985816800 10800 1 EEST}
+ {1001628000 7200 0 EET}
+ {1017352800 10800 1 EEST}
+ {1033077600 7200 0 EET}
+ {1048802400 10800 1 EEST}
+ {1066946400 7200 0 EET}
+ {1080252000 10800 1 EEST}
+ {1097791200 7200 0 EET}
+ {1112306400 10800 1 EEST}
+ {1128031200 7200 0 EET}
+ {1143756000 10800 1 EEST}
+ {1161900000 7200 0 EET}
+ {1175205600 10800 1 EEST}
+ {1193349600 7200 0 EET}
+ {1206655200 10800 1 EEST}
+ {1225404000 7200 0 EET}
+ {1238104800 10800 1 EEST}
+ {1256853600 7200 0 EET}
+ {1269554400 10800 1 EEST}
+ {1288303200 7200 0 EET}
+ {1301608800 10800 1 EEST}
+ {1319752800 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1351202400 10800 0 AST}
}
diff --git a/library/tzdata/Asia/Anadyr b/library/tzdata/Asia/Anadyr
index bebb3c0..50ace50 100644
--- a/library/tzdata/Asia/Anadyr
+++ b/library/tzdata/Asia/Anadyr
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Anadyr) {
{-9223372036854775808 42596 0 LMT}
@@ -6,242 +6,67 @@ set TZData(:Asia/Anadyr) {
{-1247572800 46800 0 ANAMMTT}
{354884400 50400 1 ANAST}
{370692000 46800 0 ANAT}
- {386420400 50400 1 ANAST}
- {386467200 46800 0 ANAST}
+ {386420400 43200 0 ANAMMTT}
+ {386424000 46800 1 ANAST}
{402231600 43200 0 ANAT}
{417960000 46800 1 ANAST}
{433767600 43200 0 ANAT}
{449582400 46800 1 ANAST}
- {465357600 43200 0 ANAT}
- {481082400 46800 1 ANAST}
- {496807200 43200 0 ANAT}
- {512532000 46800 1 ANAST}
- {528256800 43200 0 ANAT}
- {543981600 46800 1 ANAST}
- {559706400 43200 0 ANAT}
- {575431200 46800 1 ANAST}
- {591156000 43200 0 ANAT}
- {606880800 46800 1 ANAST}
- {622605600 43200 0 ANAT}
- {638330400 46800 1 ANAST}
- {654660000 43200 0 ANAT}
- {670384800 43200 0 ANAST}
- {686109600 39600 0 ANAT}
- {695786400 43200 0 ANAMMTT}
+ {465314400 43200 0 ANAT}
+ {481039200 46800 1 ANAST}
+ {496764000 43200 0 ANAT}
+ {512488800 46800 1 ANAST}
+ {528213600 43200 0 ANAT}
+ {543938400 46800 1 ANAST}
+ {559663200 43200 0 ANAT}
+ {575388000 46800 1 ANAST}
+ {591112800 43200 0 ANAT}
+ {606837600 46800 1 ANAST}
+ {622562400 43200 0 ANAT}
+ {638287200 46800 1 ANAST}
+ {654616800 43200 0 ANAT}
+ {670341600 39600 0 ANAMMTT}
+ {670345200 43200 1 ANAST}
+ {686070000 39600 0 ANAT}
+ {695746800 43200 0 ANAMMTT}
{701780400 46800 1 ANAST}
{717501600 43200 0 ANAT}
- {733284000 46800 1 ANAST}
- {749008800 43200 0 ANAT}
- {764733600 46800 1 ANAST}
- {780458400 43200 0 ANAT}
- {796183200 46800 1 ANAST}
- {811908000 43200 0 ANAT}
- {828237600 46800 1 ANAST}
- {846381600 43200 0 ANAT}
- {859687200 46800 1 ANAST}
- {877831200 43200 0 ANAT}
- {891136800 46800 1 ANAST}
- {909280800 43200 0 ANAT}
- {922586400 46800 1 ANAST}
- {941335200 43200 0 ANAT}
- {954036000 46800 1 ANAST}
- {972784800 43200 0 ANAT}
- {985485600 46800 1 ANAST}
- {1004234400 43200 0 ANAT}
- {1017540000 46800 1 ANAST}
- {1035684000 43200 0 ANAT}
- {1048989600 46800 1 ANAST}
- {1067133600 43200 0 ANAT}
- {1080439200 46800 1 ANAST}
- {1099188000 43200 0 ANAT}
- {1111888800 46800 1 ANAST}
- {1130637600 43200 0 ANAT}
- {1143338400 46800 1 ANAST}
- {1162087200 43200 0 ANAT}
- {1174788000 46800 1 ANAST}
- {1193536800 43200 0 ANAT}
- {1206842400 46800 1 ANAST}
- {1224986400 43200 0 ANAT}
- {1238292000 46800 1 ANAST}
- {1256436000 43200 0 ANAT}
- {1269741600 46800 1 ANAST}
- {1288490400 43200 0 ANAT}
- {1301191200 46800 1 ANAST}
- {1319940000 43200 0 ANAT}
- {1332640800 46800 1 ANAST}
- {1351389600 43200 0 ANAT}
- {1364695200 46800 1 ANAST}
- {1382839200 43200 0 ANAT}
- {1396144800 46800 1 ANAST}
- {1414288800 43200 0 ANAT}
- {1427594400 46800 1 ANAST}
- {1445738400 43200 0 ANAT}
- {1459044000 46800 1 ANAST}
- {1477792800 43200 0 ANAT}
- {1490493600 46800 1 ANAST}
- {1509242400 43200 0 ANAT}
- {1521943200 46800 1 ANAST}
- {1540692000 43200 0 ANAT}
- {1553997600 46800 1 ANAST}
- {1572141600 43200 0 ANAT}
- {1585447200 46800 1 ANAST}
- {1603591200 43200 0 ANAT}
- {1616896800 46800 1 ANAST}
- {1635645600 43200 0 ANAT}
- {1648346400 46800 1 ANAST}
- {1667095200 43200 0 ANAT}
- {1679796000 46800 1 ANAST}
- {1698544800 43200 0 ANAT}
- {1711850400 46800 1 ANAST}
- {1729994400 43200 0 ANAT}
- {1743300000 46800 1 ANAST}
- {1761444000 43200 0 ANAT}
- {1774749600 46800 1 ANAST}
- {1792893600 43200 0 ANAT}
- {1806199200 46800 1 ANAST}
- {1824948000 43200 0 ANAT}
- {1837648800 46800 1 ANAST}
- {1856397600 43200 0 ANAT}
- {1869098400 46800 1 ANAST}
- {1887847200 43200 0 ANAT}
- {1901152800 46800 1 ANAST}
- {1919296800 43200 0 ANAT}
- {1932602400 46800 1 ANAST}
- {1950746400 43200 0 ANAT}
- {1964052000 46800 1 ANAST}
- {1982800800 43200 0 ANAT}
- {1995501600 46800 1 ANAST}
- {2014250400 43200 0 ANAT}
- {2026951200 46800 1 ANAST}
- {2045700000 43200 0 ANAT}
- {2058400800 46800 1 ANAST}
- {2077149600 43200 0 ANAT}
- {2090455200 46800 1 ANAST}
- {2108599200 43200 0 ANAT}
- {2121904800 46800 1 ANAST}
- {2140048800 43200 0 ANAT}
- {2153354400 46800 1 ANAST}
- {2172103200 43200 0 ANAT}
- {2184804000 46800 1 ANAST}
- {2203552800 43200 0 ANAT}
- {2216253600 46800 1 ANAST}
- {2235002400 43200 0 ANAT}
- {2248308000 46800 1 ANAST}
- {2266452000 43200 0 ANAT}
- {2279757600 46800 1 ANAST}
- {2297901600 43200 0 ANAT}
- {2311207200 46800 1 ANAST}
- {2329351200 43200 0 ANAT}
- {2342656800 46800 1 ANAST}
- {2361405600 43200 0 ANAT}
- {2374106400 46800 1 ANAST}
- {2392855200 43200 0 ANAT}
- {2405556000 46800 1 ANAST}
- {2424304800 43200 0 ANAT}
- {2437610400 46800 1 ANAST}
- {2455754400 43200 0 ANAT}
- {2469060000 46800 1 ANAST}
- {2487204000 43200 0 ANAT}
- {2500509600 46800 1 ANAST}
- {2519258400 43200 0 ANAT}
- {2531959200 46800 1 ANAST}
- {2550708000 43200 0 ANAT}
- {2563408800 46800 1 ANAST}
- {2582157600 43200 0 ANAT}
- {2595463200 46800 1 ANAST}
- {2613607200 43200 0 ANAT}
- {2626912800 46800 1 ANAST}
- {2645056800 43200 0 ANAT}
- {2658362400 46800 1 ANAST}
- {2676506400 43200 0 ANAT}
- {2689812000 46800 1 ANAST}
- {2708560800 43200 0 ANAT}
- {2721261600 46800 1 ANAST}
- {2740010400 43200 0 ANAT}
- {2752711200 46800 1 ANAST}
- {2771460000 43200 0 ANAT}
- {2784765600 46800 1 ANAST}
- {2802909600 43200 0 ANAT}
- {2816215200 46800 1 ANAST}
- {2834359200 43200 0 ANAT}
- {2847664800 46800 1 ANAST}
- {2866413600 43200 0 ANAT}
- {2879114400 46800 1 ANAST}
- {2897863200 43200 0 ANAT}
- {2910564000 46800 1 ANAST}
- {2929312800 43200 0 ANAT}
- {2942013600 46800 1 ANAST}
- {2960762400 43200 0 ANAT}
- {2974068000 46800 1 ANAST}
- {2992212000 43200 0 ANAT}
- {3005517600 46800 1 ANAST}
- {3023661600 43200 0 ANAT}
- {3036967200 46800 1 ANAST}
- {3055716000 43200 0 ANAT}
- {3068416800 46800 1 ANAST}
- {3087165600 43200 0 ANAT}
- {3099866400 46800 1 ANAST}
- {3118615200 43200 0 ANAT}
- {3131920800 46800 1 ANAST}
- {3150064800 43200 0 ANAT}
- {3163370400 46800 1 ANAST}
- {3181514400 43200 0 ANAT}
- {3194820000 46800 1 ANAST}
- {3212964000 43200 0 ANAT}
- {3226269600 46800 1 ANAST}
- {3245018400 43200 0 ANAT}
- {3257719200 46800 1 ANAST}
- {3276468000 43200 0 ANAT}
- {3289168800 46800 1 ANAST}
- {3307917600 43200 0 ANAT}
- {3321223200 46800 1 ANAST}
- {3339367200 43200 0 ANAT}
- {3352672800 46800 1 ANAST}
- {3370816800 43200 0 ANAT}
- {3384122400 46800 1 ANAST}
- {3402871200 43200 0 ANAT}
- {3415572000 46800 1 ANAST}
- {3434320800 43200 0 ANAT}
- {3447021600 46800 1 ANAST}
- {3465770400 43200 0 ANAT}
- {3479076000 46800 1 ANAST}
- {3497220000 43200 0 ANAT}
- {3510525600 46800 1 ANAST}
- {3528669600 43200 0 ANAT}
- {3541975200 46800 1 ANAST}
- {3560119200 43200 0 ANAT}
- {3573424800 46800 1 ANAST}
- {3592173600 43200 0 ANAT}
- {3604874400 46800 1 ANAST}
- {3623623200 43200 0 ANAT}
- {3636324000 46800 1 ANAST}
- {3655072800 43200 0 ANAT}
- {3668378400 46800 1 ANAST}
- {3686522400 43200 0 ANAT}
- {3699828000 46800 1 ANAST}
- {3717972000 43200 0 ANAT}
- {3731277600 46800 1 ANAST}
- {3750026400 43200 0 ANAT}
- {3762727200 46800 1 ANAST}
- {3781476000 43200 0 ANAT}
- {3794176800 46800 1 ANAST}
- {3812925600 43200 0 ANAT}
- {3825626400 46800 1 ANAST}
- {3844375200 43200 0 ANAT}
- {3857680800 46800 1 ANAST}
- {3875824800 43200 0 ANAT}
- {3889130400 46800 1 ANAST}
- {3907274400 43200 0 ANAT}
- {3920580000 46800 1 ANAST}
- {3939328800 43200 0 ANAT}
- {3952029600 46800 1 ANAST}
- {3970778400 43200 0 ANAT}
- {3983479200 46800 1 ANAST}
- {4002228000 43200 0 ANAT}
- {4015533600 46800 1 ANAST}
- {4033677600 43200 0 ANAT}
- {4046983200 46800 1 ANAST}
- {4065127200 43200 0 ANAT}
- {4078432800 46800 1 ANAST}
- {4096576800 43200 0 ANAT}
+ {733240800 46800 1 ANAST}
+ {748965600 43200 0 ANAT}
+ {764690400 46800 1 ANAST}
+ {780415200 43200 0 ANAT}
+ {796140000 46800 1 ANAST}
+ {811864800 43200 0 ANAT}
+ {828194400 46800 1 ANAST}
+ {846338400 43200 0 ANAT}
+ {859644000 46800 1 ANAST}
+ {877788000 43200 0 ANAT}
+ {891093600 46800 1 ANAST}
+ {909237600 43200 0 ANAT}
+ {922543200 46800 1 ANAST}
+ {941292000 43200 0 ANAT}
+ {953992800 46800 1 ANAST}
+ {972741600 43200 0 ANAT}
+ {985442400 46800 1 ANAST}
+ {1004191200 43200 0 ANAT}
+ {1017496800 46800 1 ANAST}
+ {1035640800 43200 0 ANAT}
+ {1048946400 46800 1 ANAST}
+ {1067090400 43200 0 ANAT}
+ {1080396000 46800 1 ANAST}
+ {1099144800 43200 0 ANAT}
+ {1111845600 46800 1 ANAST}
+ {1130594400 43200 0 ANAT}
+ {1143295200 46800 1 ANAST}
+ {1162044000 43200 0 ANAT}
+ {1174744800 46800 1 ANAST}
+ {1193493600 43200 0 ANAT}
+ {1206799200 46800 1 ANAST}
+ {1224943200 43200 0 ANAT}
+ {1238248800 46800 1 ANAST}
+ {1256392800 43200 0 ANAT}
+ {1269698400 39600 0 ANAMMTT}
+ {1269702000 43200 1 ANAST}
+ {1288450800 39600 0 ANAT}
+ {1301151600 43200 0 ANAT}
}
diff --git a/library/tzdata/Asia/Aqtau b/library/tzdata/Asia/Aqtau
index 240242e..11e89a2 100644
--- a/library/tzdata/Asia/Aqtau
+++ b/library/tzdata/Asia/Aqtau
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Aqtau) {
{-9223372036854775808 12064 0 LMT}
@@ -12,47 +12,47 @@ set TZData(:Asia/Aqtau) {
{417985200 21600 1 SHEST}
{433792800 18000 0 SHET}
{449607600 21600 1 SHEST}
- {465357600 18000 0 SHET}
- {481082400 21600 1 SHEST}
- {496807200 18000 0 SHET}
- {512532000 21600 1 SHEST}
- {528256800 18000 0 SHET}
- {543981600 21600 1 SHEST}
- {559706400 18000 0 SHET}
- {575431200 21600 1 SHEST}
- {591156000 18000 0 SHET}
- {606880800 21600 1 SHEST}
- {622605600 18000 0 SHET}
- {638330400 21600 1 SHEST}
- {654660000 18000 0 SHET}
+ {465339600 18000 0 SHET}
+ {481064400 21600 1 SHEST}
+ {496789200 18000 0 SHET}
+ {512514000 21600 1 SHEST}
+ {528238800 18000 0 SHET}
+ {543963600 21600 1 SHEST}
+ {559688400 18000 0 SHET}
+ {575413200 21600 1 SHEST}
+ {591138000 18000 0 SHET}
+ {606862800 21600 1 SHEST}
+ {622587600 18000 0 SHET}
+ {638312400 21600 1 SHEST}
+ {654642000 18000 0 SHET}
{662670000 18000 0 SHET}
{692823600 18000 0 AQTT}
{701805600 21600 1 AQTST}
{717526800 18000 0 AQTT}
- {733284000 21600 1 AQTST}
- {749008800 18000 0 AQTT}
- {764733600 21600 1 AQTST}
- {780458400 18000 0 AQTT}
+ {733266000 21600 1 AQTST}
+ {748990800 18000 0 AQTT}
+ {764715600 21600 1 AQTST}
+ {780440400 18000 0 AQTT}
{796165200 14400 0 AQTT}
- {796183200 18000 1 AQTST}
- {811908000 14400 0 AQTT}
- {828237600 18000 1 AQTST}
- {846381600 14400 0 AQTT}
- {859687200 18000 1 AQTST}
- {877831200 14400 0 AQTT}
- {891136800 18000 1 AQTST}
- {909280800 14400 0 AQTT}
- {922586400 18000 1 AQTST}
- {941335200 14400 0 AQTT}
- {954036000 18000 1 AQTST}
- {972784800 14400 0 AQTT}
- {985485600 18000 1 AQTST}
- {1004234400 14400 0 AQTT}
- {1017540000 18000 1 AQTST}
- {1035684000 14400 0 AQTT}
- {1048989600 18000 1 AQTST}
- {1067133600 14400 0 AQTT}
- {1080439200 18000 1 AQTST}
- {1099188000 14400 0 AQTT}
- {1110830400 14400 0 AQTT}
+ {796168800 18000 1 AQTST}
+ {811893600 14400 0 AQTT}
+ {828223200 18000 1 AQTST}
+ {846367200 14400 0 AQTT}
+ {859672800 18000 1 AQTST}
+ {877816800 14400 0 AQTT}
+ {891122400 18000 1 AQTST}
+ {909266400 14400 0 AQTT}
+ {922572000 18000 1 AQTST}
+ {941320800 14400 0 AQTT}
+ {954021600 18000 1 AQTST}
+ {972770400 14400 0 AQTT}
+ {985471200 18000 1 AQTST}
+ {1004220000 14400 0 AQTT}
+ {1017525600 18000 1 AQTST}
+ {1035669600 14400 0 AQTT}
+ {1048975200 18000 1 AQTST}
+ {1067119200 14400 0 AQTT}
+ {1080424800 18000 1 AQTST}
+ {1099173600 14400 0 AQTT}
+ {1110830400 18000 0 AQTT}
}
diff --git a/library/tzdata/Asia/Aqtobe b/library/tzdata/Asia/Aqtobe
index 9829e04..c857491 100644
--- a/library/tzdata/Asia/Aqtobe
+++ b/library/tzdata/Asia/Aqtobe
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Aqtobe) {
{-9223372036854775808 13720 0 LMT}
@@ -12,46 +12,46 @@ set TZData(:Asia/Aqtobe) {
{417985200 21600 1 AKTST}
{433792800 18000 0 AKTT}
{449607600 21600 1 AKTST}
- {465357600 18000 0 AKTT}
- {481082400 21600 1 AKTST}
- {496807200 18000 0 AKTT}
- {512532000 21600 1 AKTST}
- {528256800 18000 0 AKTT}
- {543981600 21600 1 AKTST}
- {559706400 18000 0 AKTT}
- {575431200 21600 1 AKTST}
- {591156000 18000 0 AKTT}
- {606880800 21600 1 AKTST}
- {622605600 18000 0 AKTT}
- {638330400 21600 1 AKTST}
- {654660000 18000 0 AKTT}
+ {465339600 18000 0 AKTT}
+ {481064400 21600 1 AKTST}
+ {496789200 18000 0 AKTT}
+ {512514000 21600 1 AKTST}
+ {528238800 18000 0 AKTT}
+ {543963600 21600 1 AKTST}
+ {559688400 18000 0 AKTT}
+ {575413200 21600 1 AKTST}
+ {591138000 18000 0 AKTT}
+ {606862800 21600 1 AKTST}
+ {622587600 18000 0 AKTT}
+ {638312400 21600 1 AKTST}
+ {654642000 18000 0 AKTT}
{662670000 18000 0 AKTT}
{692823600 18000 0 AQTT}
{701805600 21600 1 AQTST}
{717526800 18000 0 AQTT}
- {733284000 21600 1 AQTST}
- {749008800 18000 0 AQTT}
- {764733600 21600 1 AQTST}
- {780458400 18000 0 AQTT}
- {796183200 21600 1 AQTST}
- {811908000 18000 0 AQTT}
- {828237600 21600 1 AQTST}
- {846381600 18000 0 AQTT}
- {859687200 21600 1 AQTST}
- {877831200 18000 0 AQTT}
- {891136800 21600 1 AQTST}
- {909280800 18000 0 AQTT}
- {922586400 21600 1 AQTST}
- {941335200 18000 0 AQTT}
- {954036000 21600 1 AQTST}
- {972784800 18000 0 AQTT}
- {985485600 21600 1 AQTST}
- {1004234400 18000 0 AQTT}
- {1017540000 21600 1 AQTST}
- {1035684000 18000 0 AQTT}
- {1048989600 21600 1 AQTST}
- {1067133600 18000 0 AQTT}
- {1080439200 21600 1 AQTST}
- {1099188000 18000 0 AQTT}
+ {733266000 21600 1 AQTST}
+ {748990800 18000 0 AQTT}
+ {764715600 21600 1 AQTST}
+ {780440400 18000 0 AQTT}
+ {796165200 21600 1 AQTST}
+ {811890000 18000 0 AQTT}
+ {828219600 21600 1 AQTST}
+ {846363600 18000 0 AQTT}
+ {859669200 21600 1 AQTST}
+ {877813200 18000 0 AQTT}
+ {891118800 21600 1 AQTST}
+ {909262800 18000 0 AQTT}
+ {922568400 21600 1 AQTST}
+ {941317200 18000 0 AQTT}
+ {954018000 21600 1 AQTST}
+ {972766800 18000 0 AQTT}
+ {985467600 21600 1 AQTST}
+ {1004216400 18000 0 AQTT}
+ {1017522000 21600 1 AQTST}
+ {1035666000 18000 0 AQTT}
+ {1048971600 21600 1 AQTST}
+ {1067115600 18000 0 AQTT}
+ {1080421200 21600 1 AQTST}
+ {1099170000 18000 0 AQTT}
{1110826800 18000 0 AQTT}
}
diff --git a/library/tzdata/Asia/Ashgabat b/library/tzdata/Asia/Ashgabat
index cf8f98d..64bdb3a 100644
--- a/library/tzdata/Asia/Ashgabat
+++ b/library/tzdata/Asia/Ashgabat
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Ashgabat) {
{-9223372036854775808 14012 0 LMT}
@@ -11,21 +11,21 @@ set TZData(:Asia/Ashgabat) {
{417985200 21600 1 ASHST}
{433792800 18000 0 ASHT}
{449607600 21600 1 ASHST}
- {465357600 18000 0 ASHT}
- {481082400 21600 1 ASHST}
- {496807200 18000 0 ASHT}
- {512532000 21600 1 ASHST}
- {528256800 18000 0 ASHT}
- {543981600 21600 1 ASHST}
- {559706400 18000 0 ASHT}
- {575431200 21600 1 ASHST}
- {591156000 18000 0 ASHT}
- {606880800 21600 1 ASHST}
- {622605600 18000 0 ASHT}
- {638330400 21600 1 ASHST}
- {654660000 18000 0 ASHT}
+ {465339600 18000 0 ASHT}
+ {481064400 21600 1 ASHST}
+ {496789200 18000 0 ASHT}
+ {512514000 21600 1 ASHST}
+ {528238800 18000 0 ASHT}
+ {543963600 21600 1 ASHST}
+ {559688400 18000 0 ASHT}
+ {575413200 21600 1 ASHST}
+ {591138000 18000 0 ASHT}
+ {606862800 21600 1 ASHST}
+ {622587600 18000 0 ASHT}
+ {638312400 21600 1 ASHST}
+ {654642000 18000 0 ASHT}
{670366800 14400 0 ASHT}
- {670384800 18000 1 ASHST}
- {686109600 14400 0 ASHT}
+ {670370400 18000 1 ASHST}
+ {686095200 14400 0 ASHT}
{695772000 18000 0 TMT}
}
diff --git a/library/tzdata/Asia/Ashkhabad b/library/tzdata/Asia/Ashkhabad
index 0ac4bb1..3000c94 100644
--- a/library/tzdata/Asia/Ashkhabad
+++ b/library/tzdata/Asia/Ashkhabad
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Ashgabat)]} {
LoadTimeZoneFile Asia/Ashgabat
}
diff --git a/library/tzdata/Asia/Baghdad b/library/tzdata/Asia/Baghdad
index ae569db..c1058cb 100644
--- a/library/tzdata/Asia/Baghdad
+++ b/library/tzdata/Asia/Baghdad
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Baghdad) {
{-9223372036854775808 10660 0 LMT}
@@ -11,233 +11,49 @@ set TZData(:Asia/Baghdad) {
{449614800 14400 1 ADT}
{465422400 10800 0 AST}
{481150800 14400 1 ADT}
- {496803600 10800 0 AST}
- {512528400 14400 1 ADT}
- {528253200 10800 0 AST}
- {543978000 14400 1 ADT}
- {559702800 10800 0 AST}
- {575427600 14400 1 ADT}
- {591152400 10800 0 AST}
- {606877200 14400 1 ADT}
- {622602000 10800 0 AST}
- {638326800 14400 1 ADT}
- {654656400 10800 0 AST}
- {670474800 14400 1 ADT}
- {686286000 10800 0 AST}
- {702097200 14400 1 ADT}
- {717908400 10800 0 AST}
- {733633200 14400 1 ADT}
- {749444400 10800 0 AST}
- {765169200 14400 1 ADT}
- {780980400 10800 0 AST}
- {796705200 14400 1 ADT}
- {812516400 10800 0 AST}
- {828327600 14400 1 ADT}
- {844138800 10800 0 AST}
- {859863600 14400 1 ADT}
- {875674800 10800 0 AST}
- {891399600 14400 1 ADT}
- {907210800 10800 0 AST}
- {922935600 14400 1 ADT}
- {938746800 10800 0 AST}
- {954558000 14400 1 ADT}
- {970369200 10800 0 AST}
- {986094000 14400 1 ADT}
- {1001905200 10800 0 AST}
- {1017630000 14400 1 ADT}
- {1033441200 10800 0 AST}
- {1049166000 14400 1 ADT}
- {1064977200 10800 0 AST}
- {1080788400 14400 1 ADT}
- {1096599600 10800 0 AST}
- {1112324400 14400 1 ADT}
- {1128135600 10800 0 AST}
- {1143860400 14400 1 ADT}
- {1159671600 10800 0 AST}
- {1175396400 14400 1 ADT}
- {1191207600 10800 0 AST}
- {1207018800 14400 1 ADT}
- {1222830000 10800 0 AST}
- {1238554800 14400 1 ADT}
- {1254366000 10800 0 AST}
- {1270090800 14400 1 ADT}
- {1285902000 10800 0 AST}
- {1301626800 14400 1 ADT}
- {1317438000 10800 0 AST}
- {1333249200 14400 1 ADT}
- {1349060400 10800 0 AST}
- {1364785200 14400 1 ADT}
- {1380596400 10800 0 AST}
- {1396321200 14400 1 ADT}
- {1412132400 10800 0 AST}
- {1427857200 14400 1 ADT}
- {1443668400 10800 0 AST}
- {1459479600 14400 1 ADT}
- {1475290800 10800 0 AST}
- {1491015600 14400 1 ADT}
- {1506826800 10800 0 AST}
- {1522551600 14400 1 ADT}
- {1538362800 10800 0 AST}
- {1554087600 14400 1 ADT}
- {1569898800 10800 0 AST}
- {1585710000 14400 1 ADT}
- {1601521200 10800 0 AST}
- {1617246000 14400 1 ADT}
- {1633057200 10800 0 AST}
- {1648782000 14400 1 ADT}
- {1664593200 10800 0 AST}
- {1680318000 14400 1 ADT}
- {1696129200 10800 0 AST}
- {1711940400 14400 1 ADT}
- {1727751600 10800 0 AST}
- {1743476400 14400 1 ADT}
- {1759287600 10800 0 AST}
- {1775012400 14400 1 ADT}
- {1790823600 10800 0 AST}
- {1806548400 14400 1 ADT}
- {1822359600 10800 0 AST}
- {1838170800 14400 1 ADT}
- {1853982000 10800 0 AST}
- {1869706800 14400 1 ADT}
- {1885518000 10800 0 AST}
- {1901242800 14400 1 ADT}
- {1917054000 10800 0 AST}
- {1932778800 14400 1 ADT}
- {1948590000 10800 0 AST}
- {1964401200 14400 1 ADT}
- {1980212400 10800 0 AST}
- {1995937200 14400 1 ADT}
- {2011748400 10800 0 AST}
- {2027473200 14400 1 ADT}
- {2043284400 10800 0 AST}
- {2059009200 14400 1 ADT}
- {2074820400 10800 0 AST}
- {2090631600 14400 1 ADT}
- {2106442800 10800 0 AST}
- {2122167600 14400 1 ADT}
- {2137978800 10800 0 AST}
- {2153703600 14400 1 ADT}
- {2169514800 10800 0 AST}
- {2185239600 14400 1 ADT}
- {2201050800 10800 0 AST}
- {2216862000 14400 1 ADT}
- {2232673200 10800 0 AST}
- {2248398000 14400 1 ADT}
- {2264209200 10800 0 AST}
- {2279934000 14400 1 ADT}
- {2295745200 10800 0 AST}
- {2311470000 14400 1 ADT}
- {2327281200 10800 0 AST}
- {2343092400 14400 1 ADT}
- {2358903600 10800 0 AST}
- {2374628400 14400 1 ADT}
- {2390439600 10800 0 AST}
- {2406164400 14400 1 ADT}
- {2421975600 10800 0 AST}
- {2437700400 14400 1 ADT}
- {2453511600 10800 0 AST}
- {2469322800 14400 1 ADT}
- {2485134000 10800 0 AST}
- {2500858800 14400 1 ADT}
- {2516670000 10800 0 AST}
- {2532394800 14400 1 ADT}
- {2548206000 10800 0 AST}
- {2563930800 14400 1 ADT}
- {2579742000 10800 0 AST}
- {2595553200 14400 1 ADT}
- {2611364400 10800 0 AST}
- {2627089200 14400 1 ADT}
- {2642900400 10800 0 AST}
- {2658625200 14400 1 ADT}
- {2674436400 10800 0 AST}
- {2690161200 14400 1 ADT}
- {2705972400 10800 0 AST}
- {2721783600 14400 1 ADT}
- {2737594800 10800 0 AST}
- {2753319600 14400 1 ADT}
- {2769130800 10800 0 AST}
- {2784855600 14400 1 ADT}
- {2800666800 10800 0 AST}
- {2816391600 14400 1 ADT}
- {2832202800 10800 0 AST}
- {2848014000 14400 1 ADT}
- {2863825200 10800 0 AST}
- {2879550000 14400 1 ADT}
- {2895361200 10800 0 AST}
- {2911086000 14400 1 ADT}
- {2926897200 10800 0 AST}
- {2942622000 14400 1 ADT}
- {2958433200 10800 0 AST}
- {2974244400 14400 1 ADT}
- {2990055600 10800 0 AST}
- {3005780400 14400 1 ADT}
- {3021591600 10800 0 AST}
- {3037316400 14400 1 ADT}
- {3053127600 10800 0 AST}
- {3068852400 14400 1 ADT}
- {3084663600 10800 0 AST}
- {3100474800 14400 1 ADT}
- {3116286000 10800 0 AST}
- {3132010800 14400 1 ADT}
- {3147822000 10800 0 AST}
- {3163546800 14400 1 ADT}
- {3179358000 10800 0 AST}
- {3195082800 14400 1 ADT}
- {3210894000 10800 0 AST}
- {3226705200 14400 1 ADT}
- {3242516400 10800 0 AST}
- {3258241200 14400 1 ADT}
- {3274052400 10800 0 AST}
- {3289777200 14400 1 ADT}
- {3305588400 10800 0 AST}
- {3321313200 14400 1 ADT}
- {3337124400 10800 0 AST}
- {3352935600 14400 1 ADT}
- {3368746800 10800 0 AST}
- {3384471600 14400 1 ADT}
- {3400282800 10800 0 AST}
- {3416007600 14400 1 ADT}
- {3431818800 10800 0 AST}
- {3447543600 14400 1 ADT}
- {3463354800 10800 0 AST}
- {3479166000 14400 1 ADT}
- {3494977200 10800 0 AST}
- {3510702000 14400 1 ADT}
- {3526513200 10800 0 AST}
- {3542238000 14400 1 ADT}
- {3558049200 10800 0 AST}
- {3573774000 14400 1 ADT}
- {3589585200 10800 0 AST}
- {3605396400 14400 1 ADT}
- {3621207600 10800 0 AST}
- {3636932400 14400 1 ADT}
- {3652743600 10800 0 AST}
- {3668468400 14400 1 ADT}
- {3684279600 10800 0 AST}
- {3700004400 14400 1 ADT}
- {3715815600 10800 0 AST}
- {3731626800 14400 1 ADT}
- {3747438000 10800 0 AST}
- {3763162800 14400 1 ADT}
- {3778974000 10800 0 AST}
- {3794698800 14400 1 ADT}
- {3810510000 10800 0 AST}
- {3826234800 14400 1 ADT}
- {3842046000 10800 0 AST}
- {3857857200 14400 1 ADT}
- {3873668400 10800 0 AST}
- {3889393200 14400 1 ADT}
- {3905204400 10800 0 AST}
- {3920929200 14400 1 ADT}
- {3936740400 10800 0 AST}
- {3952465200 14400 1 ADT}
- {3968276400 10800 0 AST}
- {3984087600 14400 1 ADT}
- {3999898800 10800 0 AST}
- {4015623600 14400 1 ADT}
- {4031434800 10800 0 AST}
- {4047159600 14400 1 ADT}
- {4062970800 10800 0 AST}
- {4078695600 14400 1 ADT}
- {4094506800 10800 0 AST}
+ {496792800 10800 0 AST}
+ {512517600 14400 1 ADT}
+ {528242400 10800 0 AST}
+ {543967200 14400 1 ADT}
+ {559692000 10800 0 AST}
+ {575416800 14400 1 ADT}
+ {591141600 10800 0 AST}
+ {606866400 14400 1 ADT}
+ {622591200 10800 0 AST}
+ {638316000 14400 1 ADT}
+ {654645600 10800 0 AST}
+ {670464000 14400 1 ADT}
+ {686275200 10800 0 AST}
+ {702086400 14400 1 ADT}
+ {717897600 10800 0 AST}
+ {733622400 14400 1 ADT}
+ {749433600 10800 0 AST}
+ {765158400 14400 1 ADT}
+ {780969600 10800 0 AST}
+ {796694400 14400 1 ADT}
+ {812505600 10800 0 AST}
+ {828316800 14400 1 ADT}
+ {844128000 10800 0 AST}
+ {859852800 14400 1 ADT}
+ {875664000 10800 0 AST}
+ {891388800 14400 1 ADT}
+ {907200000 10800 0 AST}
+ {922924800 14400 1 ADT}
+ {938736000 10800 0 AST}
+ {954547200 14400 1 ADT}
+ {970358400 10800 0 AST}
+ {986083200 14400 1 ADT}
+ {1001894400 10800 0 AST}
+ {1017619200 14400 1 ADT}
+ {1033430400 10800 0 AST}
+ {1049155200 14400 1 ADT}
+ {1064966400 10800 0 AST}
+ {1080777600 14400 1 ADT}
+ {1096588800 10800 0 AST}
+ {1112313600 14400 1 ADT}
+ {1128124800 10800 0 AST}
+ {1143849600 14400 1 ADT}
+ {1159660800 10800 0 AST}
+ {1175385600 14400 1 ADT}
+ {1191196800 10800 0 AST}
}
diff --git a/library/tzdata/Asia/Bahrain b/library/tzdata/Asia/Bahrain
index cfabc53..d4b7d2c 100644
--- a/library/tzdata/Asia/Bahrain
+++ b/library/tzdata/Asia/Bahrain
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Bahrain) {
{-9223372036854775808 12140 0 LMT}
diff --git a/library/tzdata/Asia/Baku b/library/tzdata/Asia/Baku
index bbe5789..e50071b 100644
--- a/library/tzdata/Asia/Baku
+++ b/library/tzdata/Asia/Baku
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Baku) {
{-9223372036854775808 11964 0 LMT}
@@ -11,232 +11,232 @@ set TZData(:Asia/Baku) {
{417988800 18000 1 BAKST}
{433796400 14400 0 BAKT}
{449611200 18000 1 BAKST}
- {465357600 14400 0 BAKT}
- {481082400 18000 1 BAKST}
- {496807200 14400 0 BAKT}
- {512532000 18000 1 BAKST}
- {528256800 14400 0 BAKT}
- {543981600 18000 1 BAKST}
- {559706400 14400 0 BAKT}
- {575431200 18000 1 BAKST}
- {591156000 14400 0 BAKT}
- {606880800 18000 1 BAKST}
- {622605600 14400 0 BAKT}
- {638330400 18000 1 BAKST}
- {654660000 14400 0 BAKT}
- {670384800 14400 1 BAKST}
+ {465343200 14400 0 BAKT}
+ {481068000 18000 1 BAKST}
+ {496792800 14400 0 BAKT}
+ {512517600 18000 1 BAKST}
+ {528242400 14400 0 BAKT}
+ {543967200 18000 1 BAKST}
+ {559692000 14400 0 BAKT}
+ {575416800 18000 1 BAKST}
+ {591141600 14400 0 BAKT}
+ {606866400 18000 1 BAKST}
+ {622591200 14400 0 BAKT}
+ {638316000 18000 1 BAKST}
+ {654645600 14400 0 BAKT}
+ {670370400 14400 1 BAKST}
{683496000 14400 0 AZST}
- {686109600 10800 0 AZT}
+ {686098800 10800 0 AZT}
{701812800 14400 1 AZST}
{717537600 14400 0 AZT}
{820440000 14400 0 AZT}
{828234000 18000 1 AZST}
{846378000 14400 0 AZT}
{852062400 14400 0 AZT}
- {859669200 18000 1 AZST}
- {877809600 14400 0 AZT}
- {891118800 18000 1 AZST}
- {909259200 14400 0 AZT}
- {922568400 18000 1 AZST}
- {941313600 14400 0 AZT}
- {954018000 18000 1 AZST}
- {972763200 14400 0 AZT}
- {985467600 18000 1 AZST}
- {1004212800 14400 0 AZT}
- {1017522000 18000 1 AZST}
- {1035662400 14400 0 AZT}
- {1048971600 18000 1 AZST}
- {1067112000 14400 0 AZT}
- {1080421200 18000 1 AZST}
- {1099166400 14400 0 AZT}
- {1111870800 18000 1 AZST}
- {1130616000 14400 0 AZT}
- {1143320400 18000 1 AZST}
- {1162065600 14400 0 AZT}
- {1174770000 18000 1 AZST}
- {1193515200 14400 0 AZT}
- {1206824400 18000 1 AZST}
- {1224964800 14400 0 AZT}
- {1238274000 18000 1 AZST}
- {1256414400 14400 0 AZT}
- {1269723600 18000 1 AZST}
- {1288468800 14400 0 AZT}
- {1301173200 18000 1 AZST}
- {1319918400 14400 0 AZT}
- {1332622800 18000 1 AZST}
- {1351368000 14400 0 AZT}
- {1364677200 18000 1 AZST}
- {1382817600 14400 0 AZT}
- {1396126800 18000 1 AZST}
- {1414267200 14400 0 AZT}
- {1427576400 18000 1 AZST}
- {1445716800 14400 0 AZT}
- {1459026000 18000 1 AZST}
- {1477771200 14400 0 AZT}
- {1490475600 18000 1 AZST}
- {1509220800 14400 0 AZT}
- {1521925200 18000 1 AZST}
- {1540670400 14400 0 AZT}
- {1553979600 18000 1 AZST}
- {1572120000 14400 0 AZT}
- {1585429200 18000 1 AZST}
- {1603569600 14400 0 AZT}
- {1616878800 18000 1 AZST}
- {1635624000 14400 0 AZT}
- {1648328400 18000 1 AZST}
- {1667073600 14400 0 AZT}
- {1679778000 18000 1 AZST}
- {1698523200 14400 0 AZT}
- {1711832400 18000 1 AZST}
- {1729972800 14400 0 AZT}
- {1743282000 18000 1 AZST}
- {1761422400 14400 0 AZT}
- {1774731600 18000 1 AZST}
- {1792872000 14400 0 AZT}
- {1806181200 18000 1 AZST}
- {1824926400 14400 0 AZT}
- {1837630800 18000 1 AZST}
- {1856376000 14400 0 AZT}
- {1869080400 18000 1 AZST}
- {1887825600 14400 0 AZT}
- {1901134800 18000 1 AZST}
- {1919275200 14400 0 AZT}
- {1932584400 18000 1 AZST}
- {1950724800 14400 0 AZT}
- {1964034000 18000 1 AZST}
- {1982779200 14400 0 AZT}
- {1995483600 18000 1 AZST}
- {2014228800 14400 0 AZT}
- {2026933200 18000 1 AZST}
- {2045678400 14400 0 AZT}
- {2058382800 18000 1 AZST}
- {2077128000 14400 0 AZT}
- {2090437200 18000 1 AZST}
- {2108577600 14400 0 AZT}
- {2121886800 18000 1 AZST}
- {2140027200 14400 0 AZT}
- {2153336400 18000 1 AZST}
- {2172081600 14400 0 AZT}
- {2184786000 18000 1 AZST}
- {2203531200 14400 0 AZT}
- {2216235600 18000 1 AZST}
- {2234980800 14400 0 AZT}
- {2248290000 18000 1 AZST}
- {2266430400 14400 0 AZT}
- {2279739600 18000 1 AZST}
- {2297880000 14400 0 AZT}
- {2311189200 18000 1 AZST}
- {2329329600 14400 0 AZT}
- {2342638800 18000 1 AZST}
- {2361384000 14400 0 AZT}
- {2374088400 18000 1 AZST}
- {2392833600 14400 0 AZT}
- {2405538000 18000 1 AZST}
- {2424283200 14400 0 AZT}
- {2437592400 18000 1 AZST}
- {2455732800 14400 0 AZT}
- {2469042000 18000 1 AZST}
- {2487182400 14400 0 AZT}
- {2500491600 18000 1 AZST}
- {2519236800 14400 0 AZT}
- {2531941200 18000 1 AZST}
- {2550686400 14400 0 AZT}
- {2563390800 18000 1 AZST}
- {2582136000 14400 0 AZT}
- {2595445200 18000 1 AZST}
- {2613585600 14400 0 AZT}
- {2626894800 18000 1 AZST}
- {2645035200 14400 0 AZT}
- {2658344400 18000 1 AZST}
- {2676484800 14400 0 AZT}
- {2689794000 18000 1 AZST}
- {2708539200 14400 0 AZT}
- {2721243600 18000 1 AZST}
- {2739988800 14400 0 AZT}
- {2752693200 18000 1 AZST}
- {2771438400 14400 0 AZT}
- {2784747600 18000 1 AZST}
- {2802888000 14400 0 AZT}
- {2816197200 18000 1 AZST}
- {2834337600 14400 0 AZT}
- {2847646800 18000 1 AZST}
- {2866392000 14400 0 AZT}
- {2879096400 18000 1 AZST}
- {2897841600 14400 0 AZT}
- {2910546000 18000 1 AZST}
- {2929291200 14400 0 AZT}
- {2941995600 18000 1 AZST}
- {2960740800 14400 0 AZT}
- {2974050000 18000 1 AZST}
- {2992190400 14400 0 AZT}
- {3005499600 18000 1 AZST}
- {3023640000 14400 0 AZT}
- {3036949200 18000 1 AZST}
- {3055694400 14400 0 AZT}
- {3068398800 18000 1 AZST}
- {3087144000 14400 0 AZT}
- {3099848400 18000 1 AZST}
- {3118593600 14400 0 AZT}
- {3131902800 18000 1 AZST}
- {3150043200 14400 0 AZT}
- {3163352400 18000 1 AZST}
- {3181492800 14400 0 AZT}
- {3194802000 18000 1 AZST}
- {3212942400 14400 0 AZT}
- {3226251600 18000 1 AZST}
- {3244996800 14400 0 AZT}
- {3257701200 18000 1 AZST}
- {3276446400 14400 0 AZT}
- {3289150800 18000 1 AZST}
- {3307896000 14400 0 AZT}
- {3321205200 18000 1 AZST}
- {3339345600 14400 0 AZT}
- {3352654800 18000 1 AZST}
- {3370795200 14400 0 AZT}
- {3384104400 18000 1 AZST}
- {3402849600 14400 0 AZT}
- {3415554000 18000 1 AZST}
- {3434299200 14400 0 AZT}
- {3447003600 18000 1 AZST}
- {3465748800 14400 0 AZT}
- {3479058000 18000 1 AZST}
- {3497198400 14400 0 AZT}
- {3510507600 18000 1 AZST}
- {3528648000 14400 0 AZT}
- {3541957200 18000 1 AZST}
- {3560097600 14400 0 AZT}
- {3573406800 18000 1 AZST}
- {3592152000 14400 0 AZT}
- {3604856400 18000 1 AZST}
- {3623601600 14400 0 AZT}
- {3636306000 18000 1 AZST}
- {3655051200 14400 0 AZT}
- {3668360400 18000 1 AZST}
- {3686500800 14400 0 AZT}
- {3699810000 18000 1 AZST}
- {3717950400 14400 0 AZT}
- {3731259600 18000 1 AZST}
- {3750004800 14400 0 AZT}
- {3762709200 18000 1 AZST}
- {3781454400 14400 0 AZT}
- {3794158800 18000 1 AZST}
- {3812904000 14400 0 AZT}
- {3825608400 18000 1 AZST}
- {3844353600 14400 0 AZT}
- {3857662800 18000 1 AZST}
- {3875803200 14400 0 AZT}
- {3889112400 18000 1 AZST}
- {3907252800 14400 0 AZT}
- {3920562000 18000 1 AZST}
- {3939307200 14400 0 AZT}
- {3952011600 18000 1 AZST}
- {3970756800 14400 0 AZT}
- {3983461200 18000 1 AZST}
- {4002206400 14400 0 AZT}
- {4015515600 18000 1 AZST}
- {4033656000 14400 0 AZT}
- {4046965200 18000 1 AZST}
- {4065105600 14400 0 AZT}
- {4078414800 18000 1 AZST}
- {4096555200 14400 0 AZT}
+ {859680000 18000 1 AZST}
+ {877824000 14400 0 AZT}
+ {891129600 18000 1 AZST}
+ {909273600 14400 0 AZT}
+ {922579200 18000 1 AZST}
+ {941328000 14400 0 AZT}
+ {954028800 18000 1 AZST}
+ {972777600 14400 0 AZT}
+ {985478400 18000 1 AZST}
+ {1004227200 14400 0 AZT}
+ {1017532800 18000 1 AZST}
+ {1035676800 14400 0 AZT}
+ {1048982400 18000 1 AZST}
+ {1067126400 14400 0 AZT}
+ {1080432000 18000 1 AZST}
+ {1099180800 14400 0 AZT}
+ {1111881600 18000 1 AZST}
+ {1130630400 14400 0 AZT}
+ {1143331200 18000 1 AZST}
+ {1162080000 14400 0 AZT}
+ {1174780800 18000 1 AZST}
+ {1193529600 14400 0 AZT}
+ {1206835200 18000 1 AZST}
+ {1224979200 14400 0 AZT}
+ {1238284800 18000 1 AZST}
+ {1256428800 14400 0 AZT}
+ {1269734400 18000 1 AZST}
+ {1288483200 14400 0 AZT}
+ {1301184000 18000 1 AZST}
+ {1319932800 14400 0 AZT}
+ {1332633600 18000 1 AZST}
+ {1351382400 14400 0 AZT}
+ {1364688000 18000 1 AZST}
+ {1382832000 14400 0 AZT}
+ {1396137600 18000 1 AZST}
+ {1414281600 14400 0 AZT}
+ {1427587200 18000 1 AZST}
+ {1445731200 14400 0 AZT}
+ {1459036800 18000 1 AZST}
+ {1477785600 14400 0 AZT}
+ {1490486400 18000 1 AZST}
+ {1509235200 14400 0 AZT}
+ {1521936000 18000 1 AZST}
+ {1540684800 14400 0 AZT}
+ {1553990400 18000 1 AZST}
+ {1572134400 14400 0 AZT}
+ {1585440000 18000 1 AZST}
+ {1603584000 14400 0 AZT}
+ {1616889600 18000 1 AZST}
+ {1635638400 14400 0 AZT}
+ {1648339200 18000 1 AZST}
+ {1667088000 14400 0 AZT}
+ {1679788800 18000 1 AZST}
+ {1698537600 14400 0 AZT}
+ {1711843200 18000 1 AZST}
+ {1729987200 14400 0 AZT}
+ {1743292800 18000 1 AZST}
+ {1761436800 14400 0 AZT}
+ {1774742400 18000 1 AZST}
+ {1792886400 14400 0 AZT}
+ {1806192000 18000 1 AZST}
+ {1824940800 14400 0 AZT}
+ {1837641600 18000 1 AZST}
+ {1856390400 14400 0 AZT}
+ {1869091200 18000 1 AZST}
+ {1887840000 14400 0 AZT}
+ {1901145600 18000 1 AZST}
+ {1919289600 14400 0 AZT}
+ {1932595200 18000 1 AZST}
+ {1950739200 14400 0 AZT}
+ {1964044800 18000 1 AZST}
+ {1982793600 14400 0 AZT}
+ {1995494400 18000 1 AZST}
+ {2014243200 14400 0 AZT}
+ {2026944000 18000 1 AZST}
+ {2045692800 14400 0 AZT}
+ {2058393600 18000 1 AZST}
+ {2077142400 14400 0 AZT}
+ {2090448000 18000 1 AZST}
+ {2108592000 14400 0 AZT}
+ {2121897600 18000 1 AZST}
+ {2140041600 14400 0 AZT}
+ {2153347200 18000 1 AZST}
+ {2172096000 14400 0 AZT}
+ {2184796800 18000 1 AZST}
+ {2203545600 14400 0 AZT}
+ {2216246400 18000 1 AZST}
+ {2234995200 14400 0 AZT}
+ {2248300800 18000 1 AZST}
+ {2266444800 14400 0 AZT}
+ {2279750400 18000 1 AZST}
+ {2297894400 14400 0 AZT}
+ {2311200000 18000 1 AZST}
+ {2329344000 14400 0 AZT}
+ {2342649600 18000 1 AZST}
+ {2361398400 14400 0 AZT}
+ {2374099200 18000 1 AZST}
+ {2392848000 14400 0 AZT}
+ {2405548800 18000 1 AZST}
+ {2424297600 14400 0 AZT}
+ {2437603200 18000 1 AZST}
+ {2455747200 14400 0 AZT}
+ {2469052800 18000 1 AZST}
+ {2487196800 14400 0 AZT}
+ {2500502400 18000 1 AZST}
+ {2519251200 14400 0 AZT}
+ {2531952000 18000 1 AZST}
+ {2550700800 14400 0 AZT}
+ {2563401600 18000 1 AZST}
+ {2582150400 14400 0 AZT}
+ {2595456000 18000 1 AZST}
+ {2613600000 14400 0 AZT}
+ {2626905600 18000 1 AZST}
+ {2645049600 14400 0 AZT}
+ {2658355200 18000 1 AZST}
+ {2676499200 14400 0 AZT}
+ {2689804800 18000 1 AZST}
+ {2708553600 14400 0 AZT}
+ {2721254400 18000 1 AZST}
+ {2740003200 14400 0 AZT}
+ {2752704000 18000 1 AZST}
+ {2771452800 14400 0 AZT}
+ {2784758400 18000 1 AZST}
+ {2802902400 14400 0 AZT}
+ {2816208000 18000 1 AZST}
+ {2834352000 14400 0 AZT}
+ {2847657600 18000 1 AZST}
+ {2866406400 14400 0 AZT}
+ {2879107200 18000 1 AZST}
+ {2897856000 14400 0 AZT}
+ {2910556800 18000 1 AZST}
+ {2929305600 14400 0 AZT}
+ {2942006400 18000 1 AZST}
+ {2960755200 14400 0 AZT}
+ {2974060800 18000 1 AZST}
+ {2992204800 14400 0 AZT}
+ {3005510400 18000 1 AZST}
+ {3023654400 14400 0 AZT}
+ {3036960000 18000 1 AZST}
+ {3055708800 14400 0 AZT}
+ {3068409600 18000 1 AZST}
+ {3087158400 14400 0 AZT}
+ {3099859200 18000 1 AZST}
+ {3118608000 14400 0 AZT}
+ {3131913600 18000 1 AZST}
+ {3150057600 14400 0 AZT}
+ {3163363200 18000 1 AZST}
+ {3181507200 14400 0 AZT}
+ {3194812800 18000 1 AZST}
+ {3212956800 14400 0 AZT}
+ {3226262400 18000 1 AZST}
+ {3245011200 14400 0 AZT}
+ {3257712000 18000 1 AZST}
+ {3276460800 14400 0 AZT}
+ {3289161600 18000 1 AZST}
+ {3307910400 14400 0 AZT}
+ {3321216000 18000 1 AZST}
+ {3339360000 14400 0 AZT}
+ {3352665600 18000 1 AZST}
+ {3370809600 14400 0 AZT}
+ {3384115200 18000 1 AZST}
+ {3402864000 14400 0 AZT}
+ {3415564800 18000 1 AZST}
+ {3434313600 14400 0 AZT}
+ {3447014400 18000 1 AZST}
+ {3465763200 14400 0 AZT}
+ {3479068800 18000 1 AZST}
+ {3497212800 14400 0 AZT}
+ {3510518400 18000 1 AZST}
+ {3528662400 14400 0 AZT}
+ {3541968000 18000 1 AZST}
+ {3560112000 14400 0 AZT}
+ {3573417600 18000 1 AZST}
+ {3592166400 14400 0 AZT}
+ {3604867200 18000 1 AZST}
+ {3623616000 14400 0 AZT}
+ {3636316800 18000 1 AZST}
+ {3655065600 14400 0 AZT}
+ {3668371200 18000 1 AZST}
+ {3686515200 14400 0 AZT}
+ {3699820800 18000 1 AZST}
+ {3717964800 14400 0 AZT}
+ {3731270400 18000 1 AZST}
+ {3750019200 14400 0 AZT}
+ {3762720000 18000 1 AZST}
+ {3781468800 14400 0 AZT}
+ {3794169600 18000 1 AZST}
+ {3812918400 14400 0 AZT}
+ {3825619200 18000 1 AZST}
+ {3844368000 14400 0 AZT}
+ {3857673600 18000 1 AZST}
+ {3875817600 14400 0 AZT}
+ {3889123200 18000 1 AZST}
+ {3907267200 14400 0 AZT}
+ {3920572800 18000 1 AZST}
+ {3939321600 14400 0 AZT}
+ {3952022400 18000 1 AZST}
+ {3970771200 14400 0 AZT}
+ {3983472000 18000 1 AZST}
+ {4002220800 14400 0 AZT}
+ {4015526400 18000 1 AZST}
+ {4033670400 14400 0 AZT}
+ {4046976000 18000 1 AZST}
+ {4065120000 14400 0 AZT}
+ {4078425600 18000 1 AZST}
+ {4096569600 14400 0 AZT}
}
diff --git a/library/tzdata/Asia/Bangkok b/library/tzdata/Asia/Bangkok
index f837ef9..6df7680 100644
--- a/library/tzdata/Asia/Bangkok
+++ b/library/tzdata/Asia/Bangkok
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Bangkok) {
{-9223372036854775808 24124 0 LMT}
diff --git a/library/tzdata/Asia/Beirut b/library/tzdata/Asia/Beirut
index 46259c5..ac0a64e 100644
--- a/library/tzdata/Asia/Beirut
+++ b/library/tzdata/Asia/Beirut
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Beirut) {
{-9223372036854775808 8520 0 LMT}
diff --git a/library/tzdata/Asia/Bishkek b/library/tzdata/Asia/Bishkek
index c612f76..6ba3896 100644
--- a/library/tzdata/Asia/Bishkek
+++ b/library/tzdata/Asia/Bishkek
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Bishkek) {
{-9223372036854775808 17904 0 LMT}
@@ -11,30 +11,30 @@ set TZData(:Asia/Bishkek) {
{417981600 25200 1 FRUST}
{433789200 21600 0 FRUT}
{449604000 25200 1 FRUST}
- {465357600 21600 0 FRUT}
- {481082400 25200 1 FRUST}
- {496807200 21600 0 FRUT}
- {512532000 25200 1 FRUST}
- {528256800 21600 0 FRUT}
- {543981600 25200 1 FRUST}
- {559706400 21600 0 FRUT}
- {575431200 25200 1 FRUST}
- {591156000 21600 0 FRUT}
- {606880800 25200 1 FRUST}
- {622605600 21600 0 FRUT}
- {638330400 25200 1 FRUST}
- {654660000 21600 0 FRUT}
- {670384800 21600 1 FRUST}
+ {465336000 21600 0 FRUT}
+ {481060800 25200 1 FRUST}
+ {496785600 21600 0 FRUT}
+ {512510400 25200 1 FRUST}
+ {528235200 21600 0 FRUT}
+ {543960000 25200 1 FRUST}
+ {559684800 21600 0 FRUT}
+ {575409600 25200 1 FRUST}
+ {591134400 21600 0 FRUT}
+ {606859200 25200 1 FRUST}
+ {622584000 21600 0 FRUT}
+ {638308800 25200 1 FRUST}
+ {654638400 21600 0 FRUT}
+ {670363200 21600 1 FRUST}
{683582400 21600 0 KGT}
- {703036800 21600 1 KGST}
+ {703018800 21600 1 KGST}
{717530400 18000 0 KGT}
- {734486400 21600 1 KGST}
+ {734468400 21600 1 KGST}
{748980000 18000 0 KGT}
- {765936000 21600 1 KGST}
+ {765918000 21600 1 KGST}
{780429600 18000 0 KGT}
- {797385600 21600 1 KGST}
+ {797367600 21600 1 KGST}
{811879200 18000 0 KGT}
- {828835200 21600 1 KGST}
+ {828817200 21600 1 KGST}
{843933600 18000 0 KGT}
{859671000 21600 1 KGST}
{877811400 18000 0 KGT}
@@ -53,193 +53,5 @@ set TZData(:Asia/Bishkek) {
{1080423000 21600 1 KGST}
{1099168200 18000 0 KGT}
{1111872600 21600 1 KGST}
- {1130617800 18000 0 KGT}
- {1143322200 21600 1 KGST}
- {1162067400 18000 0 KGT}
- {1174771800 21600 1 KGST}
- {1193517000 18000 0 KGT}
- {1206826200 21600 1 KGST}
- {1224966600 18000 0 KGT}
- {1238275800 21600 1 KGST}
- {1256416200 18000 0 KGT}
- {1269725400 21600 1 KGST}
- {1288470600 18000 0 KGT}
- {1301175000 21600 1 KGST}
- {1319920200 18000 0 KGT}
- {1332624600 21600 1 KGST}
- {1351369800 18000 0 KGT}
- {1364679000 21600 1 KGST}
- {1382819400 18000 0 KGT}
- {1396128600 21600 1 KGST}
- {1414269000 18000 0 KGT}
- {1427578200 21600 1 KGST}
- {1445718600 18000 0 KGT}
- {1459027800 21600 1 KGST}
- {1477773000 18000 0 KGT}
- {1490477400 21600 1 KGST}
- {1509222600 18000 0 KGT}
- {1521927000 21600 1 KGST}
- {1540672200 18000 0 KGT}
- {1553981400 21600 1 KGST}
- {1572121800 18000 0 KGT}
- {1585431000 21600 1 KGST}
- {1603571400 18000 0 KGT}
- {1616880600 21600 1 KGST}
- {1635625800 18000 0 KGT}
- {1648330200 21600 1 KGST}
- {1667075400 18000 0 KGT}
- {1679779800 21600 1 KGST}
- {1698525000 18000 0 KGT}
- {1711834200 21600 1 KGST}
- {1729974600 18000 0 KGT}
- {1743283800 21600 1 KGST}
- {1761424200 18000 0 KGT}
- {1774733400 21600 1 KGST}
- {1792873800 18000 0 KGT}
- {1806183000 21600 1 KGST}
- {1824928200 18000 0 KGT}
- {1837632600 21600 1 KGST}
- {1856377800 18000 0 KGT}
- {1869082200 21600 1 KGST}
- {1887827400 18000 0 KGT}
- {1901136600 21600 1 KGST}
- {1919277000 18000 0 KGT}
- {1932586200 21600 1 KGST}
- {1950726600 18000 0 KGT}
- {1964035800 21600 1 KGST}
- {1982781000 18000 0 KGT}
- {1995485400 21600 1 KGST}
- {2014230600 18000 0 KGT}
- {2026935000 21600 1 KGST}
- {2045680200 18000 0 KGT}
- {2058384600 21600 1 KGST}
- {2077129800 18000 0 KGT}
- {2090439000 21600 1 KGST}
- {2108579400 18000 0 KGT}
- {2121888600 21600 1 KGST}
- {2140029000 18000 0 KGT}
- {2153338200 21600 1 KGST}
- {2172083400 18000 0 KGT}
- {2184787800 21600 1 KGST}
- {2203533000 18000 0 KGT}
- {2216237400 21600 1 KGST}
- {2234982600 18000 0 KGT}
- {2248291800 21600 1 KGST}
- {2266432200 18000 0 KGT}
- {2279741400 21600 1 KGST}
- {2297881800 18000 0 KGT}
- {2311191000 21600 1 KGST}
- {2329331400 18000 0 KGT}
- {2342640600 21600 1 KGST}
- {2361385800 18000 0 KGT}
- {2374090200 21600 1 KGST}
- {2392835400 18000 0 KGT}
- {2405539800 21600 1 KGST}
- {2424285000 18000 0 KGT}
- {2437594200 21600 1 KGST}
- {2455734600 18000 0 KGT}
- {2469043800 21600 1 KGST}
- {2487184200 18000 0 KGT}
- {2500493400 21600 1 KGST}
- {2519238600 18000 0 KGT}
- {2531943000 21600 1 KGST}
- {2550688200 18000 0 KGT}
- {2563392600 21600 1 KGST}
- {2582137800 18000 0 KGT}
- {2595447000 21600 1 KGST}
- {2613587400 18000 0 KGT}
- {2626896600 21600 1 KGST}
- {2645037000 18000 0 KGT}
- {2658346200 21600 1 KGST}
- {2676486600 18000 0 KGT}
- {2689795800 21600 1 KGST}
- {2708541000 18000 0 KGT}
- {2721245400 21600 1 KGST}
- {2739990600 18000 0 KGT}
- {2752695000 21600 1 KGST}
- {2771440200 18000 0 KGT}
- {2784749400 21600 1 KGST}
- {2802889800 18000 0 KGT}
- {2816199000 21600 1 KGST}
- {2834339400 18000 0 KGT}
- {2847648600 21600 1 KGST}
- {2866393800 18000 0 KGT}
- {2879098200 21600 1 KGST}
- {2897843400 18000 0 KGT}
- {2910547800 21600 1 KGST}
- {2929293000 18000 0 KGT}
- {2941997400 21600 1 KGST}
- {2960742600 18000 0 KGT}
- {2974051800 21600 1 KGST}
- {2992192200 18000 0 KGT}
- {3005501400 21600 1 KGST}
- {3023641800 18000 0 KGT}
- {3036951000 21600 1 KGST}
- {3055696200 18000 0 KGT}
- {3068400600 21600 1 KGST}
- {3087145800 18000 0 KGT}
- {3099850200 21600 1 KGST}
- {3118595400 18000 0 KGT}
- {3131904600 21600 1 KGST}
- {3150045000 18000 0 KGT}
- {3163354200 21600 1 KGST}
- {3181494600 18000 0 KGT}
- {3194803800 21600 1 KGST}
- {3212944200 18000 0 KGT}
- {3226253400 21600 1 KGST}
- {3244998600 18000 0 KGT}
- {3257703000 21600 1 KGST}
- {3276448200 18000 0 KGT}
- {3289152600 21600 1 KGST}
- {3307897800 18000 0 KGT}
- {3321207000 21600 1 KGST}
- {3339347400 18000 0 KGT}
- {3352656600 21600 1 KGST}
- {3370797000 18000 0 KGT}
- {3384106200 21600 1 KGST}
- {3402851400 18000 0 KGT}
- {3415555800 21600 1 KGST}
- {3434301000 18000 0 KGT}
- {3447005400 21600 1 KGST}
- {3465750600 18000 0 KGT}
- {3479059800 21600 1 KGST}
- {3497200200 18000 0 KGT}
- {3510509400 21600 1 KGST}
- {3528649800 18000 0 KGT}
- {3541959000 21600 1 KGST}
- {3560099400 18000 0 KGT}
- {3573408600 21600 1 KGST}
- {3592153800 18000 0 KGT}
- {3604858200 21600 1 KGST}
- {3623603400 18000 0 KGT}
- {3636307800 21600 1 KGST}
- {3655053000 18000 0 KGT}
- {3668362200 21600 1 KGST}
- {3686502600 18000 0 KGT}
- {3699811800 21600 1 KGST}
- {3717952200 18000 0 KGT}
- {3731261400 21600 1 KGST}
- {3750006600 18000 0 KGT}
- {3762711000 21600 1 KGST}
- {3781456200 18000 0 KGT}
- {3794160600 21600 1 KGST}
- {3812905800 18000 0 KGT}
- {3825610200 21600 1 KGST}
- {3844355400 18000 0 KGT}
- {3857664600 21600 1 KGST}
- {3875805000 18000 0 KGT}
- {3889114200 21600 1 KGST}
- {3907254600 18000 0 KGT}
- {3920563800 21600 1 KGST}
- {3939309000 18000 0 KGT}
- {3952013400 21600 1 KGST}
- {3970758600 18000 0 KGT}
- {3983463000 21600 1 KGST}
- {4002208200 18000 0 KGT}
- {4015517400 21600 1 KGST}
- {4033657800 18000 0 KGT}
- {4046967000 21600 1 KGST}
- {4065107400 18000 0 KGT}
- {4078416600 21600 1 KGST}
- {4096557000 18000 0 KGT}
+ {1123783200 21600 0 KGT}
}
diff --git a/library/tzdata/Asia/Brunei b/library/tzdata/Asia/Brunei
index bbd2852..63d380b 100644
--- a/library/tzdata/Asia/Brunei
+++ b/library/tzdata/Asia/Brunei
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Brunei) {
{-9223372036854775808 27580 0 LMT}
diff --git a/library/tzdata/Asia/Calcutta b/library/tzdata/Asia/Calcutta
index a1f2c97..7243ef8 100644
--- a/library/tzdata/Asia/Calcutta
+++ b/library/tzdata/Asia/Calcutta
@@ -1,10 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Asia/Calcutta) {
- {-9223372036854775808 21208 0 LMT}
- {-2840162008 21200 0 HMT}
- {-891582800 23400 0 BURT}
- {-872058600 19800 0 IST}
- {-862637400 23400 1 IST}
- {-764145000 19800 0 IST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Asia/Kolkata)]} {
+ LoadTimeZoneFile Asia/Kolkata
}
+set TZData(:Asia/Calcutta) $TZData(:Asia/Kolkata)
diff --git a/library/tzdata/Asia/Choibalsan b/library/tzdata/Asia/Choibalsan
index d14da64..3d42617 100644
--- a/library/tzdata/Asia/Choibalsan
+++ b/library/tzdata/Asia/Choibalsan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Choibalsan) {
{-9223372036854775808 27480 0 LMT}
@@ -7,35 +7,35 @@ set TZData(:Asia/Choibalsan) {
{417974400 36000 0 CHOST}
{433778400 32400 0 CHOT}
{449593200 36000 1 CHOST}
- {465357600 32400 0 CHOT}
- {481082400 36000 1 CHOST}
- {496807200 32400 0 CHOT}
- {512532000 36000 1 CHOST}
- {528256800 32400 0 CHOT}
- {543981600 36000 1 CHOST}
- {559706400 32400 0 CHOT}
- {575431200 36000 1 CHOST}
- {591156000 32400 0 CHOT}
- {606880800 36000 1 CHOST}
- {622605600 32400 0 CHOT}
- {638330400 36000 1 CHOST}
- {654660000 32400 0 CHOT}
- {670384800 36000 1 CHOST}
- {686109600 32400 0 CHOT}
- {701834400 36000 1 CHOST}
- {717559200 32400 0 CHOT}
- {733284000 36000 1 CHOST}
- {749008800 32400 0 CHOT}
- {764733600 36000 1 CHOST}
- {780458400 32400 0 CHOT}
- {796183200 36000 1 CHOST}
- {811908000 32400 0 CHOT}
- {828237600 36000 1 CHOST}
- {843962400 32400 0 CHOT}
- {859687200 36000 1 CHOST}
- {875412000 32400 0 CHOT}
- {891136800 36000 1 CHOST}
- {906861600 32400 0 CHOT}
+ {465314400 32400 0 CHOT}
+ {481042800 36000 1 CHOST}
+ {496764000 32400 0 CHOT}
+ {512492400 36000 1 CHOST}
+ {528213600 32400 0 CHOT}
+ {543942000 36000 1 CHOST}
+ {559663200 32400 0 CHOT}
+ {575391600 36000 1 CHOST}
+ {591112800 32400 0 CHOT}
+ {606841200 36000 1 CHOST}
+ {622562400 32400 0 CHOT}
+ {638290800 36000 1 CHOST}
+ {654616800 32400 0 CHOT}
+ {670345200 36000 1 CHOST}
+ {686066400 32400 0 CHOT}
+ {701794800 36000 1 CHOST}
+ {717516000 32400 0 CHOT}
+ {733244400 36000 1 CHOST}
+ {748965600 32400 0 CHOT}
+ {764694000 36000 1 CHOST}
+ {780415200 32400 0 CHOT}
+ {796143600 36000 1 CHOST}
+ {811864800 32400 0 CHOT}
+ {828198000 36000 1 CHOST}
+ {843919200 32400 0 CHOT}
+ {859647600 36000 1 CHOST}
+ {875368800 32400 0 CHOT}
+ {891097200 36000 1 CHOST}
+ {906818400 32400 0 CHOT}
{988390800 36000 1 CHOST}
{1001692800 32400 0 CHOT}
{1017421200 36000 1 CHOST}
@@ -48,190 +48,4 @@ set TZData(:Asia/Choibalsan) {
{1127491200 32400 0 CHOT}
{1143219600 36000 1 CHOST}
{1159545600 32400 0 CHOT}
- {1175274000 36000 1 CHOST}
- {1190995200 32400 0 CHOT}
- {1206723600 36000 1 CHOST}
- {1222444800 32400 0 CHOT}
- {1238173200 36000 1 CHOST}
- {1253894400 32400 0 CHOT}
- {1269622800 36000 1 CHOST}
- {1285344000 32400 0 CHOT}
- {1301072400 36000 1 CHOST}
- {1316793600 32400 0 CHOT}
- {1333126800 36000 1 CHOST}
- {1348848000 32400 0 CHOT}
- {1364576400 36000 1 CHOST}
- {1380297600 32400 0 CHOT}
- {1396026000 36000 1 CHOST}
- {1411747200 32400 0 CHOT}
- {1427475600 36000 1 CHOST}
- {1443196800 32400 0 CHOT}
- {1458925200 36000 1 CHOST}
- {1474646400 32400 0 CHOT}
- {1490374800 36000 1 CHOST}
- {1506700800 32400 0 CHOT}
- {1522429200 36000 1 CHOST}
- {1538150400 32400 0 CHOT}
- {1553878800 36000 1 CHOST}
- {1569600000 32400 0 CHOT}
- {1585328400 36000 1 CHOST}
- {1601049600 32400 0 CHOT}
- {1616778000 36000 1 CHOST}
- {1632499200 32400 0 CHOT}
- {1648227600 36000 1 CHOST}
- {1663948800 32400 0 CHOT}
- {1679677200 36000 1 CHOST}
- {1696003200 32400 0 CHOT}
- {1711731600 36000 1 CHOST}
- {1727452800 32400 0 CHOT}
- {1743181200 36000 1 CHOST}
- {1758902400 32400 0 CHOT}
- {1774630800 36000 1 CHOST}
- {1790352000 32400 0 CHOT}
- {1806080400 36000 1 CHOST}
- {1821801600 32400 0 CHOT}
- {1837530000 36000 1 CHOST}
- {1853856000 32400 0 CHOT}
- {1869584400 36000 1 CHOST}
- {1885305600 32400 0 CHOT}
- {1901034000 36000 1 CHOST}
- {1916755200 32400 0 CHOT}
- {1932483600 36000 1 CHOST}
- {1948204800 32400 0 CHOT}
- {1963933200 36000 1 CHOST}
- {1979654400 32400 0 CHOT}
- {1995382800 36000 1 CHOST}
- {2011104000 32400 0 CHOT}
- {2026832400 36000 1 CHOST}
- {2043158400 32400 0 CHOT}
- {2058886800 36000 1 CHOST}
- {2074608000 32400 0 CHOT}
- {2090336400 36000 1 CHOST}
- {2106057600 32400 0 CHOT}
- {2121786000 36000 1 CHOST}
- {2137507200 32400 0 CHOT}
- {2153235600 36000 1 CHOST}
- {2168956800 32400 0 CHOT}
- {2184685200 36000 1 CHOST}
- {2200406400 32400 0 CHOT}
- {2216739600 36000 1 CHOST}
- {2232460800 32400 0 CHOT}
- {2248189200 36000 1 CHOST}
- {2263910400 32400 0 CHOT}
- {2279638800 36000 1 CHOST}
- {2295360000 32400 0 CHOT}
- {2311088400 36000 1 CHOST}
- {2326809600 32400 0 CHOT}
- {2342538000 36000 1 CHOST}
- {2358259200 32400 0 CHOT}
- {2373987600 36000 1 CHOST}
- {2390313600 32400 0 CHOT}
- {2406042000 36000 1 CHOST}
- {2421763200 32400 0 CHOT}
- {2437491600 36000 1 CHOST}
- {2453212800 32400 0 CHOT}
- {2468941200 36000 1 CHOST}
- {2484662400 32400 0 CHOT}
- {2500390800 36000 1 CHOST}
- {2516112000 32400 0 CHOT}
- {2531840400 36000 1 CHOST}
- {2547561600 32400 0 CHOT}
- {2563290000 36000 1 CHOST}
- {2579616000 32400 0 CHOT}
- {2595344400 36000 1 CHOST}
- {2611065600 32400 0 CHOT}
- {2626794000 36000 1 CHOST}
- {2642515200 32400 0 CHOT}
- {2658243600 36000 1 CHOST}
- {2673964800 32400 0 CHOT}
- {2689693200 36000 1 CHOST}
- {2705414400 32400 0 CHOT}
- {2721142800 36000 1 CHOST}
- {2737468800 32400 0 CHOT}
- {2753197200 36000 1 CHOST}
- {2768918400 32400 0 CHOT}
- {2784646800 36000 1 CHOST}
- {2800368000 32400 0 CHOT}
- {2816096400 36000 1 CHOST}
- {2831817600 32400 0 CHOT}
- {2847546000 36000 1 CHOST}
- {2863267200 32400 0 CHOT}
- {2878995600 36000 1 CHOST}
- {2894716800 32400 0 CHOT}
- {2910445200 36000 1 CHOST}
- {2926771200 32400 0 CHOT}
- {2942499600 36000 1 CHOST}
- {2958220800 32400 0 CHOT}
- {2973949200 36000 1 CHOST}
- {2989670400 32400 0 CHOT}
- {3005398800 36000 1 CHOST}
- {3021120000 32400 0 CHOT}
- {3036848400 36000 1 CHOST}
- {3052569600 32400 0 CHOT}
- {3068298000 36000 1 CHOST}
- {3084019200 32400 0 CHOT}
- {3100352400 36000 1 CHOST}
- {3116073600 32400 0 CHOT}
- {3131802000 36000 1 CHOST}
- {3147523200 32400 0 CHOT}
- {3163251600 36000 1 CHOST}
- {3178972800 32400 0 CHOT}
- {3194701200 36000 1 CHOST}
- {3210422400 32400 0 CHOT}
- {3226150800 36000 1 CHOST}
- {3241872000 32400 0 CHOT}
- {3257600400 36000 1 CHOST}
- {3273926400 32400 0 CHOT}
- {3289654800 36000 1 CHOST}
- {3305376000 32400 0 CHOT}
- {3321104400 36000 1 CHOST}
- {3336825600 32400 0 CHOT}
- {3352554000 36000 1 CHOST}
- {3368275200 32400 0 CHOT}
- {3384003600 36000 1 CHOST}
- {3399724800 32400 0 CHOT}
- {3415453200 36000 1 CHOST}
- {3431174400 32400 0 CHOT}
- {3446902800 36000 1 CHOST}
- {3463228800 32400 0 CHOT}
- {3478957200 36000 1 CHOST}
- {3494678400 32400 0 CHOT}
- {3510406800 36000 1 CHOST}
- {3526128000 32400 0 CHOT}
- {3541856400 36000 1 CHOST}
- {3557577600 32400 0 CHOT}
- {3573306000 36000 1 CHOST}
- {3589027200 32400 0 CHOT}
- {3604755600 36000 1 CHOST}
- {3621081600 32400 0 CHOT}
- {3636810000 36000 1 CHOST}
- {3652531200 32400 0 CHOT}
- {3668259600 36000 1 CHOST}
- {3683980800 32400 0 CHOT}
- {3699709200 36000 1 CHOST}
- {3715430400 32400 0 CHOT}
- {3731158800 36000 1 CHOST}
- {3746880000 32400 0 CHOT}
- {3762608400 36000 1 CHOST}
- {3778329600 32400 0 CHOT}
- {3794058000 36000 1 CHOST}
- {3810384000 32400 0 CHOT}
- {3826112400 36000 1 CHOST}
- {3841833600 32400 0 CHOT}
- {3857562000 36000 1 CHOST}
- {3873283200 32400 0 CHOT}
- {3889011600 36000 1 CHOST}
- {3904732800 32400 0 CHOT}
- {3920461200 36000 1 CHOST}
- {3936182400 32400 0 CHOT}
- {3951910800 36000 1 CHOST}
- {3967632000 32400 0 CHOT}
- {3983965200 36000 1 CHOST}
- {3999686400 32400 0 CHOT}
- {4015414800 36000 1 CHOST}
- {4031136000 32400 0 CHOT}
- {4046864400 36000 1 CHOST}
- {4062585600 32400 0 CHOT}
- {4078314000 36000 1 CHOST}
- {4094035200 32400 0 CHOT}
}
diff --git a/library/tzdata/Asia/Chongqing b/library/tzdata/Asia/Chongqing
index 0105051..eff3536 100644
--- a/library/tzdata/Asia/Chongqing
+++ b/library/tzdata/Asia/Chongqing
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Chongqing) {
{-9223372036854775808 25580 0 LMT}
diff --git a/library/tzdata/Asia/Chungking b/library/tzdata/Asia/Chungking
index 5b87fdd..f10d8a1 100644
--- a/library/tzdata/Asia/Chungking
+++ b/library/tzdata/Asia/Chungking
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Chongqing)]} {
LoadTimeZoneFile Asia/Chongqing
}
diff --git a/library/tzdata/Asia/Colombo b/library/tzdata/Asia/Colombo
index 5d9ddc4..ca7bffc 100644
--- a/library/tzdata/Asia/Colombo
+++ b/library/tzdata/Asia/Colombo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Colombo) {
{-9223372036854775808 19164 0 LMT}
@@ -9,4 +9,5 @@ set TZData(:Asia/Colombo) {
{-764051400 19800 0 IST}
{832962600 23400 0 LKT}
{846266400 21600 0 LKT}
+ {1145039400 19800 0 IST}
}
diff --git a/library/tzdata/Asia/Dacca b/library/tzdata/Asia/Dacca
index 5fa5491..b91d7fa 100644
--- a/library/tzdata/Asia/Dacca
+++ b/library/tzdata/Asia/Dacca
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Dhaka)]} {
LoadTimeZoneFile Asia/Dhaka
}
diff --git a/library/tzdata/Asia/Damascus b/library/tzdata/Asia/Damascus
index d1cea66..fafef49 100644
--- a/library/tzdata/Asia/Damascus
+++ b/library/tzdata/Asia/Damascus
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Damascus) {
{-9223372036854775808 8712 0 LMT}
@@ -90,191 +90,191 @@ set TZData(:Asia/Damascus) {
{1112306400 10800 1 EEST}
{1128114000 7200 0 EET}
{1143842400 10800 1 EEST}
- {1159650000 7200 0 EET}
- {1175378400 10800 1 EEST}
- {1191186000 7200 0 EET}
- {1207000800 10800 1 EEST}
- {1222808400 7200 0 EET}
- {1238536800 10800 1 EEST}
- {1254344400 7200 0 EET}
- {1270072800 10800 1 EEST}
- {1285880400 7200 0 EET}
+ {1158872400 7200 0 EET}
+ {1175205600 10800 1 EEST}
+ {1193950800 7200 0 EET}
+ {1207260000 10800 1 EEST}
+ {1225486800 7200 0 EET}
+ {1238104800 10800 1 EEST}
+ {1256850000 7200 0 EET}
+ {1270159200 10800 1 EEST}
+ {1288299600 7200 0 EET}
{1301608800 10800 1 EEST}
- {1317416400 7200 0 EET}
- {1333231200 10800 1 EEST}
- {1349038800 7200 0 EET}
- {1364767200 10800 1 EEST}
- {1380574800 7200 0 EET}
- {1396303200 10800 1 EEST}
- {1412110800 7200 0 EET}
- {1427839200 10800 1 EEST}
- {1443646800 7200 0 EET}
- {1459461600 10800 1 EEST}
- {1475269200 7200 0 EET}
- {1490997600 10800 1 EEST}
- {1506805200 7200 0 EET}
- {1522533600 10800 1 EEST}
- {1538341200 7200 0 EET}
- {1554069600 10800 1 EEST}
- {1569877200 7200 0 EET}
- {1585692000 10800 1 EEST}
- {1601499600 7200 0 EET}
- {1617228000 10800 1 EEST}
- {1633035600 7200 0 EET}
- {1648764000 10800 1 EEST}
- {1664571600 7200 0 EET}
- {1680300000 10800 1 EEST}
- {1696107600 7200 0 EET}
- {1711922400 10800 1 EEST}
- {1727730000 7200 0 EET}
- {1743458400 10800 1 EEST}
- {1759266000 7200 0 EET}
- {1774994400 10800 1 EEST}
- {1790802000 7200 0 EET}
- {1806530400 10800 1 EEST}
- {1822338000 7200 0 EET}
- {1838152800 10800 1 EEST}
- {1853960400 7200 0 EET}
- {1869688800 10800 1 EEST}
- {1885496400 7200 0 EET}
- {1901224800 10800 1 EEST}
- {1917032400 7200 0 EET}
- {1932760800 10800 1 EEST}
- {1948568400 7200 0 EET}
- {1964383200 10800 1 EEST}
- {1980190800 7200 0 EET}
- {1995919200 10800 1 EEST}
- {2011726800 7200 0 EET}
- {2027455200 10800 1 EEST}
- {2043262800 7200 0 EET}
- {2058991200 10800 1 EEST}
- {2074798800 7200 0 EET}
- {2090613600 10800 1 EEST}
- {2106421200 7200 0 EET}
- {2122149600 10800 1 EEST}
- {2137957200 7200 0 EET}
- {2153685600 10800 1 EEST}
- {2169493200 7200 0 EET}
- {2185221600 10800 1 EEST}
- {2201029200 7200 0 EET}
- {2216844000 10800 1 EEST}
- {2232651600 7200 0 EET}
- {2248380000 10800 1 EEST}
- {2264187600 7200 0 EET}
- {2279916000 10800 1 EEST}
- {2295723600 7200 0 EET}
- {2311452000 10800 1 EEST}
- {2327259600 7200 0 EET}
- {2343074400 10800 1 EEST}
- {2358882000 7200 0 EET}
- {2374610400 10800 1 EEST}
- {2390418000 7200 0 EET}
- {2406146400 10800 1 EEST}
- {2421954000 7200 0 EET}
- {2437682400 10800 1 EEST}
- {2453490000 7200 0 EET}
- {2469304800 10800 1 EEST}
- {2485112400 7200 0 EET}
- {2500840800 10800 1 EEST}
- {2516648400 7200 0 EET}
- {2532376800 10800 1 EEST}
- {2548184400 7200 0 EET}
- {2563912800 10800 1 EEST}
- {2579720400 7200 0 EET}
- {2595535200 10800 1 EEST}
- {2611342800 7200 0 EET}
- {2627071200 10800 1 EEST}
- {2642878800 7200 0 EET}
- {2658607200 10800 1 EEST}
- {2674414800 7200 0 EET}
- {2690143200 10800 1 EEST}
- {2705950800 7200 0 EET}
- {2721765600 10800 1 EEST}
- {2737573200 7200 0 EET}
- {2753301600 10800 1 EEST}
- {2769109200 7200 0 EET}
- {2784837600 10800 1 EEST}
- {2800645200 7200 0 EET}
- {2816373600 10800 1 EEST}
- {2832181200 7200 0 EET}
- {2847996000 10800 1 EEST}
- {2863803600 7200 0 EET}
- {2879532000 10800 1 EEST}
- {2895339600 7200 0 EET}
- {2911068000 10800 1 EEST}
- {2926875600 7200 0 EET}
- {2942604000 10800 1 EEST}
- {2958411600 7200 0 EET}
- {2974226400 10800 1 EEST}
- {2990034000 7200 0 EET}
- {3005762400 10800 1 EEST}
- {3021570000 7200 0 EET}
- {3037298400 10800 1 EEST}
- {3053106000 7200 0 EET}
- {3068834400 10800 1 EEST}
- {3084642000 7200 0 EET}
- {3100456800 10800 1 EEST}
- {3116264400 7200 0 EET}
- {3131992800 10800 1 EEST}
- {3147800400 7200 0 EET}
- {3163528800 10800 1 EEST}
- {3179336400 7200 0 EET}
- {3195064800 10800 1 EEST}
- {3210872400 7200 0 EET}
- {3226687200 10800 1 EEST}
- {3242494800 7200 0 EET}
- {3258223200 10800 1 EEST}
- {3274030800 7200 0 EET}
- {3289759200 10800 1 EEST}
- {3305566800 7200 0 EET}
- {3321295200 10800 1 EEST}
- {3337102800 7200 0 EET}
- {3352917600 10800 1 EEST}
- {3368725200 7200 0 EET}
- {3384453600 10800 1 EEST}
- {3400261200 7200 0 EET}
- {3415989600 10800 1 EEST}
- {3431797200 7200 0 EET}
- {3447525600 10800 1 EEST}
- {3463333200 7200 0 EET}
- {3479148000 10800 1 EEST}
- {3494955600 7200 0 EET}
- {3510684000 10800 1 EEST}
- {3526491600 7200 0 EET}
- {3542220000 10800 1 EEST}
- {3558027600 7200 0 EET}
- {3573756000 10800 1 EEST}
- {3589563600 7200 0 EET}
- {3605378400 10800 1 EEST}
- {3621186000 7200 0 EET}
- {3636914400 10800 1 EEST}
- {3652722000 7200 0 EET}
- {3668450400 10800 1 EEST}
- {3684258000 7200 0 EET}
- {3699986400 10800 1 EEST}
- {3715794000 7200 0 EET}
- {3731608800 10800 1 EEST}
- {3747416400 7200 0 EET}
- {3763144800 10800 1 EEST}
- {3778952400 7200 0 EET}
- {3794680800 10800 1 EEST}
- {3810488400 7200 0 EET}
- {3826216800 10800 1 EEST}
- {3842024400 7200 0 EET}
- {3857839200 10800 1 EEST}
- {3873646800 7200 0 EET}
- {3889375200 10800 1 EEST}
- {3905182800 7200 0 EET}
- {3920911200 10800 1 EEST}
- {3936718800 7200 0 EET}
- {3952447200 10800 1 EEST}
- {3968254800 7200 0 EET}
- {3984069600 10800 1 EEST}
- {3999877200 7200 0 EET}
- {4015605600 10800 1 EEST}
- {4031413200 7200 0 EET}
- {4047141600 10800 1 EEST}
- {4062949200 7200 0 EET}
- {4078677600 10800 1 EEST}
- {4094485200 7200 0 EET}
+ {1319749200 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1351198800 7200 0 EET}
+ {1364508000 10800 1 EEST}
+ {1382648400 7200 0 EET}
+ {1395957600 10800 1 EEST}
+ {1414702800 7200 0 EET}
+ {1427407200 10800 1 EEST}
+ {1446152400 7200 0 EET}
+ {1458856800 10800 1 EEST}
+ {1477602000 7200 0 EET}
+ {1490911200 10800 1 EEST}
+ {1509051600 7200 0 EET}
+ {1522360800 10800 1 EEST}
+ {1540501200 7200 0 EET}
+ {1553810400 10800 1 EEST}
+ {1571950800 7200 0 EET}
+ {1585260000 10800 1 EEST}
+ {1604005200 7200 0 EET}
+ {1616709600 10800 1 EEST}
+ {1635454800 7200 0 EET}
+ {1648159200 10800 1 EEST}
+ {1666904400 7200 0 EET}
+ {1680213600 10800 1 EEST}
+ {1698354000 7200 0 EET}
+ {1711663200 10800 1 EEST}
+ {1729803600 7200 0 EET}
+ {1743112800 10800 1 EEST}
+ {1761858000 7200 0 EET}
+ {1774562400 10800 1 EEST}
+ {1793307600 7200 0 EET}
+ {1806012000 10800 1 EEST}
+ {1824757200 7200 0 EET}
+ {1838066400 10800 1 EEST}
+ {1856206800 7200 0 EET}
+ {1869516000 10800 1 EEST}
+ {1887656400 7200 0 EET}
+ {1900965600 10800 1 EEST}
+ {1919106000 7200 0 EET}
+ {1932415200 10800 1 EEST}
+ {1951160400 7200 0 EET}
+ {1963864800 10800 1 EEST}
+ {1982610000 7200 0 EET}
+ {1995314400 10800 1 EEST}
+ {2014059600 7200 0 EET}
+ {2027368800 10800 1 EEST}
+ {2045509200 7200 0 EET}
+ {2058818400 10800 1 EEST}
+ {2076958800 7200 0 EET}
+ {2090268000 10800 1 EEST}
+ {2109013200 7200 0 EET}
+ {2121717600 10800 1 EEST}
+ {2140462800 7200 0 EET}
+ {2153167200 10800 1 EEST}
+ {2171912400 7200 0 EET}
+ {2184616800 10800 1 EEST}
+ {2203362000 7200 0 EET}
+ {2216671200 10800 1 EEST}
+ {2234811600 7200 0 EET}
+ {2248120800 10800 1 EEST}
+ {2266261200 7200 0 EET}
+ {2279570400 10800 1 EEST}
+ {2298315600 7200 0 EET}
+ {2311020000 10800 1 EEST}
+ {2329765200 7200 0 EET}
+ {2342469600 10800 1 EEST}
+ {2361214800 7200 0 EET}
+ {2374524000 10800 1 EEST}
+ {2392664400 7200 0 EET}
+ {2405973600 10800 1 EEST}
+ {2424114000 7200 0 EET}
+ {2437423200 10800 1 EEST}
+ {2455563600 7200 0 EET}
+ {2468872800 10800 1 EEST}
+ {2487618000 7200 0 EET}
+ {2500322400 10800 1 EEST}
+ {2519067600 7200 0 EET}
+ {2531772000 10800 1 EEST}
+ {2550517200 7200 0 EET}
+ {2563826400 10800 1 EEST}
+ {2581966800 7200 0 EET}
+ {2595276000 10800 1 EEST}
+ {2613416400 7200 0 EET}
+ {2626725600 10800 1 EEST}
+ {2645470800 7200 0 EET}
+ {2658175200 10800 1 EEST}
+ {2676920400 7200 0 EET}
+ {2689624800 10800 1 EEST}
+ {2708370000 7200 0 EET}
+ {2721679200 10800 1 EEST}
+ {2739819600 7200 0 EET}
+ {2753128800 10800 1 EEST}
+ {2771269200 7200 0 EET}
+ {2784578400 10800 1 EEST}
+ {2802718800 7200 0 EET}
+ {2816028000 10800 1 EEST}
+ {2834773200 7200 0 EET}
+ {2847477600 10800 1 EEST}
+ {2866222800 7200 0 EET}
+ {2878927200 10800 1 EEST}
+ {2897672400 7200 0 EET}
+ {2910981600 10800 1 EEST}
+ {2929122000 7200 0 EET}
+ {2942431200 10800 1 EEST}
+ {2960571600 7200 0 EET}
+ {2973880800 10800 1 EEST}
+ {2992626000 7200 0 EET}
+ {3005330400 10800 1 EEST}
+ {3024075600 7200 0 EET}
+ {3036780000 10800 1 EEST}
+ {3055525200 7200 0 EET}
+ {3068229600 10800 1 EEST}
+ {3086974800 7200 0 EET}
+ {3100284000 10800 1 EEST}
+ {3118424400 7200 0 EET}
+ {3131733600 10800 1 EEST}
+ {3149874000 7200 0 EET}
+ {3163183200 10800 1 EEST}
+ {3181928400 7200 0 EET}
+ {3194632800 10800 1 EEST}
+ {3213378000 7200 0 EET}
+ {3226082400 10800 1 EEST}
+ {3244827600 7200 0 EET}
+ {3258136800 10800 1 EEST}
+ {3276277200 7200 0 EET}
+ {3289586400 10800 1 EEST}
+ {3307726800 7200 0 EET}
+ {3321036000 10800 1 EEST}
+ {3339176400 7200 0 EET}
+ {3352485600 10800 1 EEST}
+ {3371230800 7200 0 EET}
+ {3383935200 10800 1 EEST}
+ {3402680400 7200 0 EET}
+ {3415384800 10800 1 EEST}
+ {3434130000 7200 0 EET}
+ {3447439200 10800 1 EEST}
+ {3465579600 7200 0 EET}
+ {3478888800 10800 1 EEST}
+ {3497029200 7200 0 EET}
+ {3510338400 10800 1 EEST}
+ {3529083600 7200 0 EET}
+ {3541788000 10800 1 EEST}
+ {3560533200 7200 0 EET}
+ {3573237600 10800 1 EEST}
+ {3591982800 7200 0 EET}
+ {3605292000 10800 1 EEST}
+ {3623432400 7200 0 EET}
+ {3636741600 10800 1 EEST}
+ {3654882000 7200 0 EET}
+ {3668191200 10800 1 EEST}
+ {3686331600 7200 0 EET}
+ {3699640800 10800 1 EEST}
+ {3718386000 7200 0 EET}
+ {3731090400 10800 1 EEST}
+ {3749835600 7200 0 EET}
+ {3762540000 10800 1 EEST}
+ {3781285200 7200 0 EET}
+ {3794594400 10800 1 EEST}
+ {3812734800 7200 0 EET}
+ {3826044000 10800 1 EEST}
+ {3844184400 7200 0 EET}
+ {3857493600 10800 1 EEST}
+ {3876238800 7200 0 EET}
+ {3888943200 10800 1 EEST}
+ {3907688400 7200 0 EET}
+ {3920392800 10800 1 EEST}
+ {3939138000 7200 0 EET}
+ {3951842400 10800 1 EEST}
+ {3970587600 7200 0 EET}
+ {3983896800 10800 1 EEST}
+ {4002037200 7200 0 EET}
+ {4015346400 10800 1 EEST}
+ {4033486800 7200 0 EET}
+ {4046796000 10800 1 EEST}
+ {4065541200 7200 0 EET}
+ {4078245600 10800 1 EEST}
+ {4096990800 7200 0 EET}
}
diff --git a/library/tzdata/Asia/Dhaka b/library/tzdata/Asia/Dhaka
index f01466e..e0c270d 100644
--- a/library/tzdata/Asia/Dhaka
+++ b/library/tzdata/Asia/Dhaka
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Dhaka) {
{-9223372036854775808 21700 0 LMT}
@@ -8,4 +8,7 @@ set TZData(:Asia/Dhaka) {
{-862637400 23400 0 BURT}
{-576138600 21600 0 DACT}
{38772000 21600 0 BDT}
+ {1230746400 21600 0 BDT}
+ {1245430800 25200 1 BDST}
+ {1262278740 21600 0 BDT}
}
diff --git a/library/tzdata/Asia/Dili b/library/tzdata/Asia/Dili
index 7269e81..f783557 100644
--- a/library/tzdata/Asia/Dili
+++ b/library/tzdata/Asia/Dili
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Dili) {
{-9223372036854775808 30140 0 LMT}
- {-1830414140 28800 0 TPT}
+ {-1830414140 28800 0 TLT}
{-879152400 32400 0 JST}
- {-770634000 32400 0 TPT}
- {199897200 28800 0 CIT}
- {969120000 32400 0 TPT}
+ {-766054800 32400 0 TLT}
+ {199897200 28800 0 WITA}
+ {969120000 32400 0 TLT}
}
diff --git a/library/tzdata/Asia/Dubai b/library/tzdata/Asia/Dubai
index 5c0a31f..b8730e5 100644
--- a/library/tzdata/Asia/Dubai
+++ b/library/tzdata/Asia/Dubai
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Dubai) {
{-9223372036854775808 13272 0 LMT}
diff --git a/library/tzdata/Asia/Dushanbe b/library/tzdata/Asia/Dushanbe
index bd570e9..59f8cb6 100644
--- a/library/tzdata/Asia/Dushanbe
+++ b/library/tzdata/Asia/Dushanbe
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Dushanbe) {
{-9223372036854775808 16512 0 LMT}
@@ -11,19 +11,19 @@ set TZData(:Asia/Dushanbe) {
{417981600 25200 1 DUSST}
{433789200 21600 0 DUST}
{449604000 25200 1 DUSST}
- {465357600 21600 0 DUST}
- {481082400 25200 1 DUSST}
- {496807200 21600 0 DUST}
- {512532000 25200 1 DUSST}
- {528256800 21600 0 DUST}
- {543981600 25200 1 DUSST}
- {559706400 21600 0 DUST}
- {575431200 25200 1 DUSST}
- {591156000 21600 0 DUST}
- {606880800 25200 1 DUSST}
- {622605600 21600 0 DUST}
- {638330400 25200 1 DUSST}
- {654660000 21600 0 DUST}
- {670384800 21600 1 DUSST}
- {684381600 18000 0 TJT}
+ {465336000 21600 0 DUST}
+ {481060800 25200 1 DUSST}
+ {496785600 21600 0 DUST}
+ {512510400 25200 1 DUSST}
+ {528235200 21600 0 DUST}
+ {543960000 25200 1 DUSST}
+ {559684800 21600 0 DUST}
+ {575409600 25200 1 DUSST}
+ {591134400 21600 0 DUST}
+ {606859200 25200 1 DUSST}
+ {622584000 21600 0 DUST}
+ {638308800 25200 1 DUSST}
+ {654638400 21600 0 DUST}
+ {670363200 21600 1 DUSST}
+ {684363600 18000 0 TJT}
}
diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza
index b5aecc8..7d62a96 100644
--- a/library/tzdata/Asia/Gaza
+++ b/library/tzdata/Asia/Gaza
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Gaza) {
{-9223372036854775808 8272 0 LMT}
@@ -64,11 +64,11 @@ set TZData(:Asia/Gaza) {
{810075600 7200 0 IST}
{820447200 7200 0 EET}
{828655200 10800 1 EEST}
- {843177600 7200 0 EET}
+ {843170400 7200 0 EET}
{860104800 10800 1 EEST}
- {874627200 7200 0 EET}
+ {874620000 7200 0 EET}
{891554400 10800 1 EEST}
- {906076800 7200 0 EET}
+ {906069600 7200 0 EET}
{915141600 7200 0 EET}
{924213600 10800 1 EEST}
{939934800 7200 0 EET}
@@ -81,195 +81,198 @@ set TZData(:Asia/Gaza) {
{1050616800 10800 1 EEST}
{1066338000 7200 0 EET}
{1082066400 10800 1 EEST}
- {1097787600 7200 0 EET}
+ {1096581600 7200 0 EET}
{1113516000 10800 1 EEST}
- {1129842000 7200 0 EET}
- {1145570400 10800 1 EEST}
- {1161291600 7200 0 EET}
- {1177020000 10800 1 EEST}
- {1192741200 7200 0 EET}
- {1208469600 10800 1 EEST}
- {1224190800 7200 0 EET}
- {1239919200 10800 1 EEST}
- {1255640400 7200 0 EET}
- {1271368800 10800 1 EEST}
- {1287090000 7200 0 EET}
- {1302818400 10800 1 EEST}
- {1319144400 7200 0 EET}
- {1334872800 10800 1 EEST}
- {1350594000 7200 0 EET}
- {1366322400 10800 1 EEST}
- {1382043600 7200 0 EET}
- {1397772000 10800 1 EEST}
- {1413493200 7200 0 EET}
- {1429221600 10800 1 EEST}
- {1444942800 7200 0 EET}
- {1460671200 10800 1 EEST}
- {1476997200 7200 0 EET}
- {1492725600 10800 1 EEST}
- {1508446800 7200 0 EET}
- {1524175200 10800 1 EEST}
- {1539896400 7200 0 EET}
- {1555624800 10800 1 EEST}
- {1571346000 7200 0 EET}
- {1587074400 10800 1 EEST}
- {1602795600 7200 0 EET}
- {1618524000 10800 1 EEST}
- {1634245200 7200 0 EET}
- {1649973600 10800 1 EEST}
- {1666299600 7200 0 EET}
- {1682028000 10800 1 EEST}
- {1697749200 7200 0 EET}
- {1713477600 10800 1 EEST}
- {1729198800 7200 0 EET}
- {1744927200 10800 1 EEST}
- {1760648400 7200 0 EET}
- {1776376800 10800 1 EEST}
- {1792098000 7200 0 EET}
- {1807826400 10800 1 EEST}
- {1823547600 7200 0 EET}
- {1839880800 10800 1 EEST}
- {1855602000 7200 0 EET}
- {1871330400 10800 1 EEST}
- {1887051600 7200 0 EET}
- {1902780000 10800 1 EEST}
- {1918501200 7200 0 EET}
- {1934229600 10800 1 EEST}
- {1949950800 7200 0 EET}
- {1965679200 10800 1 EEST}
- {1981400400 7200 0 EET}
- {1997128800 10800 1 EEST}
- {2013454800 7200 0 EET}
- {2029183200 10800 1 EEST}
- {2044904400 7200 0 EET}
- {2060632800 10800 1 EEST}
- {2076354000 7200 0 EET}
- {2092082400 10800 1 EEST}
- {2107803600 7200 0 EET}
- {2123532000 10800 1 EEST}
- {2139253200 7200 0 EET}
- {2154981600 10800 1 EEST}
- {2170702800 7200 0 EET}
- {2186431200 10800 1 EEST}
- {2202757200 7200 0 EET}
- {2218485600 10800 1 EEST}
- {2234206800 7200 0 EET}
- {2249935200 10800 1 EEST}
- {2265656400 7200 0 EET}
- {2281384800 10800 1 EEST}
- {2297106000 7200 0 EET}
- {2312834400 10800 1 EEST}
- {2328555600 7200 0 EET}
- {2344284000 10800 1 EEST}
- {2360610000 7200 0 EET}
- {2376338400 10800 1 EEST}
- {2392059600 7200 0 EET}
- {2407788000 10800 1 EEST}
- {2423509200 7200 0 EET}
- {2439237600 10800 1 EEST}
- {2454958800 7200 0 EET}
- {2470687200 10800 1 EEST}
- {2486408400 7200 0 EET}
- {2502136800 10800 1 EEST}
- {2517858000 7200 0 EET}
- {2533586400 10800 1 EEST}
- {2549912400 7200 0 EET}
- {2565640800 10800 1 EEST}
- {2581362000 7200 0 EET}
- {2597090400 10800 1 EEST}
- {2612811600 7200 0 EET}
- {2628540000 10800 1 EEST}
- {2644261200 7200 0 EET}
- {2659989600 10800 1 EEST}
- {2675710800 7200 0 EET}
- {2691439200 10800 1 EEST}
- {2707160400 7200 0 EET}
- {2723493600 10800 1 EEST}
- {2739214800 7200 0 EET}
- {2754943200 10800 1 EEST}
- {2770664400 7200 0 EET}
- {2786392800 10800 1 EEST}
- {2802114000 7200 0 EET}
- {2817842400 10800 1 EEST}
- {2833563600 7200 0 EET}
- {2849292000 10800 1 EEST}
- {2865013200 7200 0 EET}
- {2880741600 10800 1 EEST}
- {2897067600 7200 0 EET}
- {2912796000 10800 1 EEST}
- {2928517200 7200 0 EET}
- {2944245600 10800 1 EEST}
- {2959966800 7200 0 EET}
- {2975695200 10800 1 EEST}
- {2991416400 7200 0 EET}
- {3007144800 10800 1 EEST}
- {3022866000 7200 0 EET}
- {3038594400 10800 1 EEST}
- {3054315600 7200 0 EET}
- {3070044000 10800 1 EEST}
- {3086370000 7200 0 EET}
- {3102098400 10800 1 EEST}
- {3117819600 7200 0 EET}
- {3133548000 10800 1 EEST}
- {3149269200 7200 0 EET}
- {3164997600 10800 1 EEST}
- {3180718800 7200 0 EET}
- {3196447200 10800 1 EEST}
- {3212168400 7200 0 EET}
- {3227896800 10800 1 EEST}
- {3244222800 7200 0 EET}
- {3259951200 10800 1 EEST}
- {3275672400 7200 0 EET}
- {3291400800 10800 1 EEST}
- {3307122000 7200 0 EET}
- {3322850400 10800 1 EEST}
- {3338571600 7200 0 EET}
- {3354300000 10800 1 EEST}
- {3370021200 7200 0 EET}
- {3385749600 10800 1 EEST}
- {3401470800 7200 0 EET}
- {3417199200 10800 1 EEST}
- {3433525200 7200 0 EET}
- {3449253600 10800 1 EEST}
- {3464974800 7200 0 EET}
- {3480703200 10800 1 EEST}
- {3496424400 7200 0 EET}
- {3512152800 10800 1 EEST}
- {3527874000 7200 0 EET}
- {3543602400 10800 1 EEST}
- {3559323600 7200 0 EET}
- {3575052000 10800 1 EEST}
- {3590773200 7200 0 EET}
- {3607106400 10800 1 EEST}
- {3622827600 7200 0 EET}
- {3638556000 10800 1 EEST}
- {3654277200 7200 0 EET}
- {3670005600 10800 1 EEST}
- {3685726800 7200 0 EET}
- {3701455200 10800 1 EEST}
- {3717176400 7200 0 EET}
- {3732904800 10800 1 EEST}
- {3748626000 7200 0 EET}
- {3764354400 10800 1 EEST}
- {3780680400 7200 0 EET}
- {3796408800 10800 1 EEST}
- {3812130000 7200 0 EET}
- {3827858400 10800 1 EEST}
- {3843579600 7200 0 EET}
- {3859308000 10800 1 EEST}
- {3875029200 7200 0 EET}
- {3890757600 10800 1 EEST}
- {3906478800 7200 0 EET}
- {3922207200 10800 1 EEST}
- {3937928400 7200 0 EET}
- {3953656800 10800 1 EEST}
- {3969982800 7200 0 EET}
- {3985711200 10800 1 EEST}
- {4001432400 7200 0 EET}
- {4017160800 10800 1 EEST}
- {4032882000 7200 0 EET}
- {4048610400 10800 1 EEST}
- {4064331600 7200 0 EET}
- {4080060000 10800 1 EEST}
- {4095781200 7200 0 EET}
+ {1128380400 7200 0 EET}
+ {1143842400 10800 1 EEST}
+ {1158872400 7200 0 EET}
+ {1175378400 10800 1 EEST}
+ {1189638000 7200 0 EET}
+ {1206655200 10800 1 EEST}
+ {1219960800 7200 0 EET}
+ {1220220000 7200 0 EET}
+ {1238104800 10800 1 EEST}
+ {1252015200 7200 0 EET}
+ {1262296800 7200 0 EET}
+ {1269640860 10800 0 EEST}
+ {1281474000 7200 0 EET}
+ {1301608860 10800 1 EEST}
+ {1312149600 7200 0 EET}
+ {1325368800 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1348178400 7200 0 EET}
+ {1364508000 10800 1 EEST}
+ {1380229200 7200 0 EET}
+ {1395957600 10800 1 EEST}
+ {1411678800 7200 0 EET}
+ {1427407200 10800 1 EEST}
+ {1443128400 7200 0 EET}
+ {1459461600 10800 1 EEST}
+ {1474578000 7200 0 EET}
+ {1490911200 10800 1 EEST}
+ {1506027600 7200 0 EET}
+ {1522360800 10800 1 EEST}
+ {1537477200 7200 0 EET}
+ {1553810400 10800 1 EEST}
+ {1569531600 7200 0 EET}
+ {1585260000 10800 1 EEST}
+ {1600981200 7200 0 EET}
+ {1616709600 10800 1 EEST}
+ {1632430800 7200 0 EET}
+ {1648764000 10800 1 EEST}
+ {1663880400 7200 0 EET}
+ {1680213600 10800 1 EEST}
+ {1695330000 7200 0 EET}
+ {1711663200 10800 1 EEST}
+ {1727384400 7200 0 EET}
+ {1743112800 10800 1 EEST}
+ {1758834000 7200 0 EET}
+ {1774562400 10800 1 EEST}
+ {1790283600 7200 0 EET}
+ {1806012000 10800 1 EEST}
+ {1821733200 7200 0 EET}
+ {1838066400 10800 1 EEST}
+ {1853182800 7200 0 EET}
+ {1869516000 10800 1 EEST}
+ {1884632400 7200 0 EET}
+ {1900965600 10800 1 EEST}
+ {1916686800 7200 0 EET}
+ {1932415200 10800 1 EEST}
+ {1948136400 7200 0 EET}
+ {1963864800 10800 1 EEST}
+ {1979586000 7200 0 EET}
+ {1995919200 10800 1 EEST}
+ {2011035600 7200 0 EET}
+ {2027368800 10800 1 EEST}
+ {2042485200 7200 0 EET}
+ {2058818400 10800 1 EEST}
+ {2073934800 7200 0 EET}
+ {2090268000 10800 1 EEST}
+ {2105989200 7200 0 EET}
+ {2121717600 10800 1 EEST}
+ {2137438800 7200 0 EET}
+ {2153167200 10800 1 EEST}
+ {2168888400 7200 0 EET}
+ {2185221600 10800 1 EEST}
+ {2200338000 7200 0 EET}
+ {2216671200 10800 1 EEST}
+ {2231787600 7200 0 EET}
+ {2248120800 10800 1 EEST}
+ {2263842000 7200 0 EET}
+ {2279570400 10800 1 EEST}
+ {2295291600 7200 0 EET}
+ {2311020000 10800 1 EEST}
+ {2326741200 7200 0 EET}
+ {2343074400 10800 1 EEST}
+ {2358190800 7200 0 EET}
+ {2374524000 10800 1 EEST}
+ {2389640400 7200 0 EET}
+ {2405973600 10800 1 EEST}
+ {2421090000 7200 0 EET}
+ {2437423200 10800 1 EEST}
+ {2453144400 7200 0 EET}
+ {2468872800 10800 1 EEST}
+ {2484594000 7200 0 EET}
+ {2500322400 10800 1 EEST}
+ {2516043600 7200 0 EET}
+ {2532376800 10800 1 EEST}
+ {2547493200 7200 0 EET}
+ {2563826400 10800 1 EEST}
+ {2578942800 7200 0 EET}
+ {2595276000 10800 1 EEST}
+ {2610997200 7200 0 EET}
+ {2626725600 10800 1 EEST}
+ {2642446800 7200 0 EET}
+ {2658175200 10800 1 EEST}
+ {2673896400 7200 0 EET}
+ {2689624800 10800 1 EEST}
+ {2705346000 7200 0 EET}
+ {2721679200 10800 1 EEST}
+ {2736795600 7200 0 EET}
+ {2753128800 10800 1 EEST}
+ {2768245200 7200 0 EET}
+ {2784578400 10800 1 EEST}
+ {2800299600 7200 0 EET}
+ {2816028000 10800 1 EEST}
+ {2831749200 7200 0 EET}
+ {2847477600 10800 1 EEST}
+ {2863198800 7200 0 EET}
+ {2879532000 10800 1 EEST}
+ {2894648400 7200 0 EET}
+ {2910981600 10800 1 EEST}
+ {2926098000 7200 0 EET}
+ {2942431200 10800 1 EEST}
+ {2957547600 7200 0 EET}
+ {2973880800 10800 1 EEST}
+ {2989602000 7200 0 EET}
+ {3005330400 10800 1 EEST}
+ {3021051600 7200 0 EET}
+ {3036780000 10800 1 EEST}
+ {3052501200 7200 0 EET}
+ {3068834400 10800 1 EEST}
+ {3083950800 7200 0 EET}
+ {3100284000 10800 1 EEST}
+ {3115400400 7200 0 EET}
+ {3131733600 10800 1 EEST}
+ {3147454800 7200 0 EET}
+ {3163183200 10800 1 EEST}
+ {3178904400 7200 0 EET}
+ {3194632800 10800 1 EEST}
+ {3210354000 7200 0 EET}
+ {3226687200 10800 1 EEST}
+ {3241803600 7200 0 EET}
+ {3258136800 10800 1 EEST}
+ {3273253200 7200 0 EET}
+ {3289586400 10800 1 EEST}
+ {3304702800 7200 0 EET}
+ {3321036000 10800 1 EEST}
+ {3336757200 7200 0 EET}
+ {3352485600 10800 1 EEST}
+ {3368206800 7200 0 EET}
+ {3383935200 10800 1 EEST}
+ {3399656400 7200 0 EET}
+ {3415989600 10800 1 EEST}
+ {3431106000 7200 0 EET}
+ {3447439200 10800 1 EEST}
+ {3462555600 7200 0 EET}
+ {3478888800 10800 1 EEST}
+ {3494610000 7200 0 EET}
+ {3510338400 10800 1 EEST}
+ {3526059600 7200 0 EET}
+ {3541788000 10800 1 EEST}
+ {3557509200 7200 0 EET}
+ {3573237600 10800 1 EEST}
+ {3588958800 7200 0 EET}
+ {3605292000 10800 1 EEST}
+ {3620408400 7200 0 EET}
+ {3636741600 10800 1 EEST}
+ {3651858000 7200 0 EET}
+ {3668191200 10800 1 EEST}
+ {3683912400 7200 0 EET}
+ {3699640800 10800 1 EEST}
+ {3715362000 7200 0 EET}
+ {3731090400 10800 1 EEST}
+ {3746811600 7200 0 EET}
+ {3763144800 10800 1 EEST}
+ {3778261200 7200 0 EET}
+ {3794594400 10800 1 EEST}
+ {3809710800 7200 0 EET}
+ {3826044000 10800 1 EEST}
+ {3841160400 7200 0 EET}
+ {3857493600 10800 1 EEST}
+ {3873214800 7200 0 EET}
+ {3888943200 10800 1 EEST}
+ {3904664400 7200 0 EET}
+ {3920392800 10800 1 EEST}
+ {3936114000 7200 0 EET}
+ {3952447200 10800 1 EEST}
+ {3967563600 7200 0 EET}
+ {3983896800 10800 1 EEST}
+ {3999013200 7200 0 EET}
+ {4015346400 10800 1 EEST}
+ {4031067600 7200 0 EET}
+ {4046796000 10800 1 EEST}
+ {4062517200 7200 0 EET}
+ {4078245600 10800 1 EEST}
+ {4093966800 7200 0 EET}
}
diff --git a/library/tzdata/Asia/Harbin b/library/tzdata/Asia/Harbin
index bbc8d27..0eb0c12 100644
--- a/library/tzdata/Asia/Harbin
+++ b/library/tzdata/Asia/Harbin
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Harbin) {
{-9223372036854775808 30404 0 LMT}
diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron
new file mode 100644
index 0000000..1333d5a
--- /dev/null
+++ b/library/tzdata/Asia/Hebron
@@ -0,0 +1,277 @@
+# 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}
+ {1206655200 10800 1 EEST}
+ {1220216400 7200 0 EET}
+ {1238104800 10800 1 EEST}
+ {1252015200 7200 0 EET}
+ {1269554400 10800 1 EEST}
+ {1281474000 7200 0 EET}
+ {1301608860 10800 1 EEST}
+ {1312146000 7200 0 EET}
+ {1314655200 10800 1 EEST}
+ {1317330000 7200 0 EET}
+ {1333058400 10800 1 EEST}
+ {1348178400 7200 0 EET}
+ {1364508000 10800 1 EEST}
+ {1380229200 7200 0 EET}
+ {1395957600 10800 1 EEST}
+ {1411678800 7200 0 EET}
+ {1427407200 10800 1 EEST}
+ {1443128400 7200 0 EET}
+ {1459461600 10800 1 EEST}
+ {1474578000 7200 0 EET}
+ {1490911200 10800 1 EEST}
+ {1506027600 7200 0 EET}
+ {1522360800 10800 1 EEST}
+ {1537477200 7200 0 EET}
+ {1553810400 10800 1 EEST}
+ {1569531600 7200 0 EET}
+ {1585260000 10800 1 EEST}
+ {1600981200 7200 0 EET}
+ {1616709600 10800 1 EEST}
+ {1632430800 7200 0 EET}
+ {1648764000 10800 1 EEST}
+ {1663880400 7200 0 EET}
+ {1680213600 10800 1 EEST}
+ {1695330000 7200 0 EET}
+ {1711663200 10800 1 EEST}
+ {1727384400 7200 0 EET}
+ {1743112800 10800 1 EEST}
+ {1758834000 7200 0 EET}
+ {1774562400 10800 1 EEST}
+ {1790283600 7200 0 EET}
+ {1806012000 10800 1 EEST}
+ {1821733200 7200 0 EET}
+ {1838066400 10800 1 EEST}
+ {1853182800 7200 0 EET}
+ {1869516000 10800 1 EEST}
+ {1884632400 7200 0 EET}
+ {1900965600 10800 1 EEST}
+ {1916686800 7200 0 EET}
+ {1932415200 10800 1 EEST}
+ {1948136400 7200 0 EET}
+ {1963864800 10800 1 EEST}
+ {1979586000 7200 0 EET}
+ {1995919200 10800 1 EEST}
+ {2011035600 7200 0 EET}
+ {2027368800 10800 1 EEST}
+ {2042485200 7200 0 EET}
+ {2058818400 10800 1 EEST}
+ {2073934800 7200 0 EET}
+ {2090268000 10800 1 EEST}
+ {2105989200 7200 0 EET}
+ {2121717600 10800 1 EEST}
+ {2137438800 7200 0 EET}
+ {2153167200 10800 1 EEST}
+ {2168888400 7200 0 EET}
+ {2185221600 10800 1 EEST}
+ {2200338000 7200 0 EET}
+ {2216671200 10800 1 EEST}
+ {2231787600 7200 0 EET}
+ {2248120800 10800 1 EEST}
+ {2263842000 7200 0 EET}
+ {2279570400 10800 1 EEST}
+ {2295291600 7200 0 EET}
+ {2311020000 10800 1 EEST}
+ {2326741200 7200 0 EET}
+ {2343074400 10800 1 EEST}
+ {2358190800 7200 0 EET}
+ {2374524000 10800 1 EEST}
+ {2389640400 7200 0 EET}
+ {2405973600 10800 1 EEST}
+ {2421090000 7200 0 EET}
+ {2437423200 10800 1 EEST}
+ {2453144400 7200 0 EET}
+ {2468872800 10800 1 EEST}
+ {2484594000 7200 0 EET}
+ {2500322400 10800 1 EEST}
+ {2516043600 7200 0 EET}
+ {2532376800 10800 1 EEST}
+ {2547493200 7200 0 EET}
+ {2563826400 10800 1 EEST}
+ {2578942800 7200 0 EET}
+ {2595276000 10800 1 EEST}
+ {2610997200 7200 0 EET}
+ {2626725600 10800 1 EEST}
+ {2642446800 7200 0 EET}
+ {2658175200 10800 1 EEST}
+ {2673896400 7200 0 EET}
+ {2689624800 10800 1 EEST}
+ {2705346000 7200 0 EET}
+ {2721679200 10800 1 EEST}
+ {2736795600 7200 0 EET}
+ {2753128800 10800 1 EEST}
+ {2768245200 7200 0 EET}
+ {2784578400 10800 1 EEST}
+ {2800299600 7200 0 EET}
+ {2816028000 10800 1 EEST}
+ {2831749200 7200 0 EET}
+ {2847477600 10800 1 EEST}
+ {2863198800 7200 0 EET}
+ {2879532000 10800 1 EEST}
+ {2894648400 7200 0 EET}
+ {2910981600 10800 1 EEST}
+ {2926098000 7200 0 EET}
+ {2942431200 10800 1 EEST}
+ {2957547600 7200 0 EET}
+ {2973880800 10800 1 EEST}
+ {2989602000 7200 0 EET}
+ {3005330400 10800 1 EEST}
+ {3021051600 7200 0 EET}
+ {3036780000 10800 1 EEST}
+ {3052501200 7200 0 EET}
+ {3068834400 10800 1 EEST}
+ {3083950800 7200 0 EET}
+ {3100284000 10800 1 EEST}
+ {3115400400 7200 0 EET}
+ {3131733600 10800 1 EEST}
+ {3147454800 7200 0 EET}
+ {3163183200 10800 1 EEST}
+ {3178904400 7200 0 EET}
+ {3194632800 10800 1 EEST}
+ {3210354000 7200 0 EET}
+ {3226687200 10800 1 EEST}
+ {3241803600 7200 0 EET}
+ {3258136800 10800 1 EEST}
+ {3273253200 7200 0 EET}
+ {3289586400 10800 1 EEST}
+ {3304702800 7200 0 EET}
+ {3321036000 10800 1 EEST}
+ {3336757200 7200 0 EET}
+ {3352485600 10800 1 EEST}
+ {3368206800 7200 0 EET}
+ {3383935200 10800 1 EEST}
+ {3399656400 7200 0 EET}
+ {3415989600 10800 1 EEST}
+ {3431106000 7200 0 EET}
+ {3447439200 10800 1 EEST}
+ {3462555600 7200 0 EET}
+ {3478888800 10800 1 EEST}
+ {3494610000 7200 0 EET}
+ {3510338400 10800 1 EEST}
+ {3526059600 7200 0 EET}
+ {3541788000 10800 1 EEST}
+ {3557509200 7200 0 EET}
+ {3573237600 10800 1 EEST}
+ {3588958800 7200 0 EET}
+ {3605292000 10800 1 EEST}
+ {3620408400 7200 0 EET}
+ {3636741600 10800 1 EEST}
+ {3651858000 7200 0 EET}
+ {3668191200 10800 1 EEST}
+ {3683912400 7200 0 EET}
+ {3699640800 10800 1 EEST}
+ {3715362000 7200 0 EET}
+ {3731090400 10800 1 EEST}
+ {3746811600 7200 0 EET}
+ {3763144800 10800 1 EEST}
+ {3778261200 7200 0 EET}
+ {3794594400 10800 1 EEST}
+ {3809710800 7200 0 EET}
+ {3826044000 10800 1 EEST}
+ {3841160400 7200 0 EET}
+ {3857493600 10800 1 EEST}
+ {3873214800 7200 0 EET}
+ {3888943200 10800 1 EEST}
+ {3904664400 7200 0 EET}
+ {3920392800 10800 1 EEST}
+ {3936114000 7200 0 EET}
+ {3952447200 10800 1 EEST}
+ {3967563600 7200 0 EET}
+ {3983896800 10800 1 EEST}
+ {3999013200 7200 0 EET}
+ {4015346400 10800 1 EEST}
+ {4031067600 7200 0 EET}
+ {4046796000 10800 1 EEST}
+ {4062517200 7200 0 EET}
+ {4078245600 10800 1 EEST}
+ {4093966800 7200 0 EET}
+}
diff --git a/library/tzdata/Asia/Ho_Chi_Minh b/library/tzdata/Asia/Ho_Chi_Minh
new file mode 100644
index 0000000..777c8db
--- /dev/null
+++ b/library/tzdata/Asia/Ho_Chi_Minh
@@ -0,0 +1,9 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Ho_Chi_Minh) {
+ {-9223372036854775808 25600 0 LMT}
+ {-2005974400 25580 0 SMT}
+ {-1855983920 25200 0 ICT}
+ {-1819954800 28800 0 ICT}
+ {-1220428800 25200 0 ICT}
+}
diff --git a/library/tzdata/Asia/Hong_Kong b/library/tzdata/Asia/Hong_Kong
index 807d859..fcf98a6 100644
--- a/library/tzdata/Asia/Hong_Kong
+++ b/library/tzdata/Asia/Hong_Kong
@@ -1,8 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Hong_Kong) {
- {-9223372036854775808 27396 0 LMT}
- {-2056692996 28800 0 HKT}
+ {-9223372036854775808 27402 0 LMT}
+ {-2056693002 28800 0 HKT}
+ {-907389000 32400 1 HKST}
+ {-891667800 28800 0 HKT}
+ {-884246400 32400 0 JST}
+ {-766746000 28800 0 HKT}
{-747981000 32400 1 HKST}
{-728544600 28800 0 HKT}
{-717049800 32400 1 HKST}
@@ -16,7 +20,7 @@ set TZData(:Asia/Hong_Kong) {
{-591856200 32400 1 HKST}
{-573715800 28800 0 HKT}
{-559801800 32400 1 HKST}
- {-542266200 28800 0 HKT}
+ {-542352600 28800 0 HKT}
{-528352200 32400 1 HKST}
{-510211800 28800 0 HKT}
{-498112200 32400 1 HKST}
@@ -59,16 +63,13 @@ set TZData(:Asia/Hong_Kong) {
{88540200 28800 0 HKT}
{104268600 32400 1 HKST}
{119989800 28800 0 HKT}
- {135718200 32400 1 HKST}
+ {126041400 32400 1 HKST}
+ {135714600 32400 1 HKST}
{151439400 28800 0 HKT}
{167167800 32400 1 HKST}
{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}
- {326835000 32400 1 HKST}
- {340741800 28800 0 HKT}
}
diff --git a/library/tzdata/Asia/Hovd b/library/tzdata/Asia/Hovd
index 4812aa1..2a87dab 100644
--- a/library/tzdata/Asia/Hovd
+++ b/library/tzdata/Asia/Hovd
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Hovd) {
{-9223372036854775808 21996 0 LMT}
@@ -7,35 +7,35 @@ set TZData(:Asia/Hovd) {
{417978000 28800 1 HOVST}
{433785600 25200 0 HOVT}
{449600400 28800 1 HOVST}
- {465357600 25200 0 HOVT}
- {481082400 28800 1 HOVST}
- {496807200 25200 0 HOVT}
- {512532000 28800 1 HOVST}
- {528256800 25200 0 HOVT}
- {543981600 28800 1 HOVST}
- {559706400 25200 0 HOVT}
- {575431200 28800 1 HOVST}
- {591156000 25200 0 HOVT}
- {606880800 28800 1 HOVST}
- {622605600 25200 0 HOVT}
- {638330400 28800 1 HOVST}
- {654660000 25200 0 HOVT}
- {670384800 28800 1 HOVST}
- {686109600 25200 0 HOVT}
- {701834400 28800 1 HOVST}
- {717559200 25200 0 HOVT}
- {733284000 28800 1 HOVST}
- {749008800 25200 0 HOVT}
- {764733600 28800 1 HOVST}
- {780458400 25200 0 HOVT}
- {796183200 28800 1 HOVST}
- {811908000 25200 0 HOVT}
- {828237600 28800 1 HOVST}
- {843962400 25200 0 HOVT}
- {859687200 28800 1 HOVST}
- {875412000 25200 0 HOVT}
- {891136800 28800 1 HOVST}
- {906861600 25200 0 HOVT}
+ {465321600 25200 0 HOVT}
+ {481050000 28800 1 HOVST}
+ {496771200 25200 0 HOVT}
+ {512499600 28800 1 HOVST}
+ {528220800 25200 0 HOVT}
+ {543949200 28800 1 HOVST}
+ {559670400 25200 0 HOVT}
+ {575398800 28800 1 HOVST}
+ {591120000 25200 0 HOVT}
+ {606848400 28800 1 HOVST}
+ {622569600 25200 0 HOVT}
+ {638298000 28800 1 HOVST}
+ {654624000 25200 0 HOVT}
+ {670352400 28800 1 HOVST}
+ {686073600 25200 0 HOVT}
+ {701802000 28800 1 HOVST}
+ {717523200 25200 0 HOVT}
+ {733251600 28800 1 HOVST}
+ {748972800 25200 0 HOVT}
+ {764701200 28800 1 HOVST}
+ {780422400 25200 0 HOVT}
+ {796150800 28800 1 HOVST}
+ {811872000 25200 0 HOVT}
+ {828205200 28800 1 HOVST}
+ {843926400 25200 0 HOVT}
+ {859654800 28800 1 HOVST}
+ {875376000 25200 0 HOVT}
+ {891104400 28800 1 HOVST}
+ {906825600 25200 0 HOVT}
{988398000 28800 1 HOVST}
{1001700000 25200 0 HOVT}
{1017428400 28800 1 HOVST}
@@ -48,190 +48,4 @@ set TZData(:Asia/Hovd) {
{1127498400 25200 0 HOVT}
{1143226800 28800 1 HOVST}
{1159552800 25200 0 HOVT}
- {1175281200 28800 1 HOVST}
- {1191002400 25200 0 HOVT}
- {1206730800 28800 1 HOVST}
- {1222452000 25200 0 HOVT}
- {1238180400 28800 1 HOVST}
- {1253901600 25200 0 HOVT}
- {1269630000 28800 1 HOVST}
- {1285351200 25200 0 HOVT}
- {1301079600 28800 1 HOVST}
- {1316800800 25200 0 HOVT}
- {1333134000 28800 1 HOVST}
- {1348855200 25200 0 HOVT}
- {1364583600 28800 1 HOVST}
- {1380304800 25200 0 HOVT}
- {1396033200 28800 1 HOVST}
- {1411754400 25200 0 HOVT}
- {1427482800 28800 1 HOVST}
- {1443204000 25200 0 HOVT}
- {1458932400 28800 1 HOVST}
- {1474653600 25200 0 HOVT}
- {1490382000 28800 1 HOVST}
- {1506708000 25200 0 HOVT}
- {1522436400 28800 1 HOVST}
- {1538157600 25200 0 HOVT}
- {1553886000 28800 1 HOVST}
- {1569607200 25200 0 HOVT}
- {1585335600 28800 1 HOVST}
- {1601056800 25200 0 HOVT}
- {1616785200 28800 1 HOVST}
- {1632506400 25200 0 HOVT}
- {1648234800 28800 1 HOVST}
- {1663956000 25200 0 HOVT}
- {1679684400 28800 1 HOVST}
- {1696010400 25200 0 HOVT}
- {1711738800 28800 1 HOVST}
- {1727460000 25200 0 HOVT}
- {1743188400 28800 1 HOVST}
- {1758909600 25200 0 HOVT}
- {1774638000 28800 1 HOVST}
- {1790359200 25200 0 HOVT}
- {1806087600 28800 1 HOVST}
- {1821808800 25200 0 HOVT}
- {1837537200 28800 1 HOVST}
- {1853863200 25200 0 HOVT}
- {1869591600 28800 1 HOVST}
- {1885312800 25200 0 HOVT}
- {1901041200 28800 1 HOVST}
- {1916762400 25200 0 HOVT}
- {1932490800 28800 1 HOVST}
- {1948212000 25200 0 HOVT}
- {1963940400 28800 1 HOVST}
- {1979661600 25200 0 HOVT}
- {1995390000 28800 1 HOVST}
- {2011111200 25200 0 HOVT}
- {2026839600 28800 1 HOVST}
- {2043165600 25200 0 HOVT}
- {2058894000 28800 1 HOVST}
- {2074615200 25200 0 HOVT}
- {2090343600 28800 1 HOVST}
- {2106064800 25200 0 HOVT}
- {2121793200 28800 1 HOVST}
- {2137514400 25200 0 HOVT}
- {2153242800 28800 1 HOVST}
- {2168964000 25200 0 HOVT}
- {2184692400 28800 1 HOVST}
- {2200413600 25200 0 HOVT}
- {2216746800 28800 1 HOVST}
- {2232468000 25200 0 HOVT}
- {2248196400 28800 1 HOVST}
- {2263917600 25200 0 HOVT}
- {2279646000 28800 1 HOVST}
- {2295367200 25200 0 HOVT}
- {2311095600 28800 1 HOVST}
- {2326816800 25200 0 HOVT}
- {2342545200 28800 1 HOVST}
- {2358266400 25200 0 HOVT}
- {2373994800 28800 1 HOVST}
- {2390320800 25200 0 HOVT}
- {2406049200 28800 1 HOVST}
- {2421770400 25200 0 HOVT}
- {2437498800 28800 1 HOVST}
- {2453220000 25200 0 HOVT}
- {2468948400 28800 1 HOVST}
- {2484669600 25200 0 HOVT}
- {2500398000 28800 1 HOVST}
- {2516119200 25200 0 HOVT}
- {2531847600 28800 1 HOVST}
- {2547568800 25200 0 HOVT}
- {2563297200 28800 1 HOVST}
- {2579623200 25200 0 HOVT}
- {2595351600 28800 1 HOVST}
- {2611072800 25200 0 HOVT}
- {2626801200 28800 1 HOVST}
- {2642522400 25200 0 HOVT}
- {2658250800 28800 1 HOVST}
- {2673972000 25200 0 HOVT}
- {2689700400 28800 1 HOVST}
- {2705421600 25200 0 HOVT}
- {2721150000 28800 1 HOVST}
- {2737476000 25200 0 HOVT}
- {2753204400 28800 1 HOVST}
- {2768925600 25200 0 HOVT}
- {2784654000 28800 1 HOVST}
- {2800375200 25200 0 HOVT}
- {2816103600 28800 1 HOVST}
- {2831824800 25200 0 HOVT}
- {2847553200 28800 1 HOVST}
- {2863274400 25200 0 HOVT}
- {2879002800 28800 1 HOVST}
- {2894724000 25200 0 HOVT}
- {2910452400 28800 1 HOVST}
- {2926778400 25200 0 HOVT}
- {2942506800 28800 1 HOVST}
- {2958228000 25200 0 HOVT}
- {2973956400 28800 1 HOVST}
- {2989677600 25200 0 HOVT}
- {3005406000 28800 1 HOVST}
- {3021127200 25200 0 HOVT}
- {3036855600 28800 1 HOVST}
- {3052576800 25200 0 HOVT}
- {3068305200 28800 1 HOVST}
- {3084026400 25200 0 HOVT}
- {3100359600 28800 1 HOVST}
- {3116080800 25200 0 HOVT}
- {3131809200 28800 1 HOVST}
- {3147530400 25200 0 HOVT}
- {3163258800 28800 1 HOVST}
- {3178980000 25200 0 HOVT}
- {3194708400 28800 1 HOVST}
- {3210429600 25200 0 HOVT}
- {3226158000 28800 1 HOVST}
- {3241879200 25200 0 HOVT}
- {3257607600 28800 1 HOVST}
- {3273933600 25200 0 HOVT}
- {3289662000 28800 1 HOVST}
- {3305383200 25200 0 HOVT}
- {3321111600 28800 1 HOVST}
- {3336832800 25200 0 HOVT}
- {3352561200 28800 1 HOVST}
- {3368282400 25200 0 HOVT}
- {3384010800 28800 1 HOVST}
- {3399732000 25200 0 HOVT}
- {3415460400 28800 1 HOVST}
- {3431181600 25200 0 HOVT}
- {3446910000 28800 1 HOVST}
- {3463236000 25200 0 HOVT}
- {3478964400 28800 1 HOVST}
- {3494685600 25200 0 HOVT}
- {3510414000 28800 1 HOVST}
- {3526135200 25200 0 HOVT}
- {3541863600 28800 1 HOVST}
- {3557584800 25200 0 HOVT}
- {3573313200 28800 1 HOVST}
- {3589034400 25200 0 HOVT}
- {3604762800 28800 1 HOVST}
- {3621088800 25200 0 HOVT}
- {3636817200 28800 1 HOVST}
- {3652538400 25200 0 HOVT}
- {3668266800 28800 1 HOVST}
- {3683988000 25200 0 HOVT}
- {3699716400 28800 1 HOVST}
- {3715437600 25200 0 HOVT}
- {3731166000 28800 1 HOVST}
- {3746887200 25200 0 HOVT}
- {3762615600 28800 1 HOVST}
- {3778336800 25200 0 HOVT}
- {3794065200 28800 1 HOVST}
- {3810391200 25200 0 HOVT}
- {3826119600 28800 1 HOVST}
- {3841840800 25200 0 HOVT}
- {3857569200 28800 1 HOVST}
- {3873290400 25200 0 HOVT}
- {3889018800 28800 1 HOVST}
- {3904740000 25200 0 HOVT}
- {3920468400 28800 1 HOVST}
- {3936189600 25200 0 HOVT}
- {3951918000 28800 1 HOVST}
- {3967639200 25200 0 HOVT}
- {3983972400 28800 1 HOVST}
- {3999693600 25200 0 HOVT}
- {4015422000 28800 1 HOVST}
- {4031143200 25200 0 HOVT}
- {4046871600 28800 1 HOVST}
- {4062592800 25200 0 HOVT}
- {4078321200 28800 1 HOVST}
- {4094042400 25200 0 HOVT}
}
diff --git a/library/tzdata/Asia/Irkutsk b/library/tzdata/Asia/Irkutsk
index fb12522..bca1dcc 100644
--- a/library/tzdata/Asia/Irkutsk
+++ b/library/tzdata/Asia/Irkutsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Irkutsk) {
{-9223372036854775808 25040 0 LMT}
@@ -12,236 +12,60 @@ set TZData(:Asia/Irkutsk) {
{417974400 32400 1 IRKST}
{433782000 28800 0 IRKT}
{449596800 32400 1 IRKST}
- {465357600 28800 0 IRKT}
- {481082400 32400 1 IRKST}
- {496807200 28800 0 IRKT}
- {512532000 32400 1 IRKST}
- {528256800 28800 0 IRKT}
- {543981600 32400 1 IRKST}
- {559706400 28800 0 IRKT}
- {575431200 32400 1 IRKST}
- {591156000 28800 0 IRKT}
- {606880800 32400 1 IRKST}
- {622605600 28800 0 IRKT}
- {638330400 32400 1 IRKST}
- {654660000 28800 0 IRKT}
- {670384800 28800 0 IRKST}
- {686109600 25200 0 IRKT}
- {695786400 28800 0 IRKMMTT}
+ {465328800 28800 0 IRKT}
+ {481053600 32400 1 IRKST}
+ {496778400 28800 0 IRKT}
+ {512503200 32400 1 IRKST}
+ {528228000 28800 0 IRKT}
+ {543952800 32400 1 IRKST}
+ {559677600 28800 0 IRKT}
+ {575402400 32400 1 IRKST}
+ {591127200 28800 0 IRKT}
+ {606852000 32400 1 IRKST}
+ {622576800 28800 0 IRKT}
+ {638301600 32400 1 IRKST}
+ {654631200 28800 0 IRKT}
+ {670356000 25200 0 IRKMMTT}
+ {670359600 28800 1 IRKST}
+ {686084400 25200 0 IRKT}
+ {695761200 28800 0 IRKMMTT}
{701794800 32400 1 IRKST}
{717516000 28800 0 IRKT}
- {733284000 32400 1 IRKST}
- {749008800 28800 0 IRKT}
- {764733600 32400 1 IRKST}
- {780458400 28800 0 IRKT}
- {796183200 32400 1 IRKST}
- {811908000 28800 0 IRKT}
- {828237600 32400 1 IRKST}
- {846381600 28800 0 IRKT}
- {859687200 32400 1 IRKST}
- {877831200 28800 0 IRKT}
- {891136800 32400 1 IRKST}
- {909280800 28800 0 IRKT}
- {922586400 32400 1 IRKST}
- {941335200 28800 0 IRKT}
- {954036000 32400 1 IRKST}
- {972784800 28800 0 IRKT}
- {985485600 32400 1 IRKST}
- {1004234400 28800 0 IRKT}
- {1017540000 32400 1 IRKST}
- {1035684000 28800 0 IRKT}
- {1048989600 32400 1 IRKST}
- {1067133600 28800 0 IRKT}
- {1080439200 32400 1 IRKST}
- {1099188000 28800 0 IRKT}
- {1111888800 32400 1 IRKST}
- {1130637600 28800 0 IRKT}
- {1143338400 32400 1 IRKST}
- {1162087200 28800 0 IRKT}
- {1174788000 32400 1 IRKST}
- {1193536800 28800 0 IRKT}
- {1206842400 32400 1 IRKST}
- {1224986400 28800 0 IRKT}
- {1238292000 32400 1 IRKST}
- {1256436000 28800 0 IRKT}
- {1269741600 32400 1 IRKST}
- {1288490400 28800 0 IRKT}
- {1301191200 32400 1 IRKST}
- {1319940000 28800 0 IRKT}
- {1332640800 32400 1 IRKST}
- {1351389600 28800 0 IRKT}
- {1364695200 32400 1 IRKST}
- {1382839200 28800 0 IRKT}
- {1396144800 32400 1 IRKST}
- {1414288800 28800 0 IRKT}
- {1427594400 32400 1 IRKST}
- {1445738400 28800 0 IRKT}
- {1459044000 32400 1 IRKST}
- {1477792800 28800 0 IRKT}
- {1490493600 32400 1 IRKST}
- {1509242400 28800 0 IRKT}
- {1521943200 32400 1 IRKST}
- {1540692000 28800 0 IRKT}
- {1553997600 32400 1 IRKST}
- {1572141600 28800 0 IRKT}
- {1585447200 32400 1 IRKST}
- {1603591200 28800 0 IRKT}
- {1616896800 32400 1 IRKST}
- {1635645600 28800 0 IRKT}
- {1648346400 32400 1 IRKST}
- {1667095200 28800 0 IRKT}
- {1679796000 32400 1 IRKST}
- {1698544800 28800 0 IRKT}
- {1711850400 32400 1 IRKST}
- {1729994400 28800 0 IRKT}
- {1743300000 32400 1 IRKST}
- {1761444000 28800 0 IRKT}
- {1774749600 32400 1 IRKST}
- {1792893600 28800 0 IRKT}
- {1806199200 32400 1 IRKST}
- {1824948000 28800 0 IRKT}
- {1837648800 32400 1 IRKST}
- {1856397600 28800 0 IRKT}
- {1869098400 32400 1 IRKST}
- {1887847200 28800 0 IRKT}
- {1901152800 32400 1 IRKST}
- {1919296800 28800 0 IRKT}
- {1932602400 32400 1 IRKST}
- {1950746400 28800 0 IRKT}
- {1964052000 32400 1 IRKST}
- {1982800800 28800 0 IRKT}
- {1995501600 32400 1 IRKST}
- {2014250400 28800 0 IRKT}
- {2026951200 32400 1 IRKST}
- {2045700000 28800 0 IRKT}
- {2058400800 32400 1 IRKST}
- {2077149600 28800 0 IRKT}
- {2090455200 32400 1 IRKST}
- {2108599200 28800 0 IRKT}
- {2121904800 32400 1 IRKST}
- {2140048800 28800 0 IRKT}
- {2153354400 32400 1 IRKST}
- {2172103200 28800 0 IRKT}
- {2184804000 32400 1 IRKST}
- {2203552800 28800 0 IRKT}
- {2216253600 32400 1 IRKST}
- {2235002400 28800 0 IRKT}
- {2248308000 32400 1 IRKST}
- {2266452000 28800 0 IRKT}
- {2279757600 32400 1 IRKST}
- {2297901600 28800 0 IRKT}
- {2311207200 32400 1 IRKST}
- {2329351200 28800 0 IRKT}
- {2342656800 32400 1 IRKST}
- {2361405600 28800 0 IRKT}
- {2374106400 32400 1 IRKST}
- {2392855200 28800 0 IRKT}
- {2405556000 32400 1 IRKST}
- {2424304800 28800 0 IRKT}
- {2437610400 32400 1 IRKST}
- {2455754400 28800 0 IRKT}
- {2469060000 32400 1 IRKST}
- {2487204000 28800 0 IRKT}
- {2500509600 32400 1 IRKST}
- {2519258400 28800 0 IRKT}
- {2531959200 32400 1 IRKST}
- {2550708000 28800 0 IRKT}
- {2563408800 32400 1 IRKST}
- {2582157600 28800 0 IRKT}
- {2595463200 32400 1 IRKST}
- {2613607200 28800 0 IRKT}
- {2626912800 32400 1 IRKST}
- {2645056800 28800 0 IRKT}
- {2658362400 32400 1 IRKST}
- {2676506400 28800 0 IRKT}
- {2689812000 32400 1 IRKST}
- {2708560800 28800 0 IRKT}
- {2721261600 32400 1 IRKST}
- {2740010400 28800 0 IRKT}
- {2752711200 32400 1 IRKST}
- {2771460000 28800 0 IRKT}
- {2784765600 32400 1 IRKST}
- {2802909600 28800 0 IRKT}
- {2816215200 32400 1 IRKST}
- {2834359200 28800 0 IRKT}
- {2847664800 32400 1 IRKST}
- {2866413600 28800 0 IRKT}
- {2879114400 32400 1 IRKST}
- {2897863200 28800 0 IRKT}
- {2910564000 32400 1 IRKST}
- {2929312800 28800 0 IRKT}
- {2942013600 32400 1 IRKST}
- {2960762400 28800 0 IRKT}
- {2974068000 32400 1 IRKST}
- {2992212000 28800 0 IRKT}
- {3005517600 32400 1 IRKST}
- {3023661600 28800 0 IRKT}
- {3036967200 32400 1 IRKST}
- {3055716000 28800 0 IRKT}
- {3068416800 32400 1 IRKST}
- {3087165600 28800 0 IRKT}
- {3099866400 32400 1 IRKST}
- {3118615200 28800 0 IRKT}
- {3131920800 32400 1 IRKST}
- {3150064800 28800 0 IRKT}
- {3163370400 32400 1 IRKST}
- {3181514400 28800 0 IRKT}
- {3194820000 32400 1 IRKST}
- {3212964000 28800 0 IRKT}
- {3226269600 32400 1 IRKST}
- {3245018400 28800 0 IRKT}
- {3257719200 32400 1 IRKST}
- {3276468000 28800 0 IRKT}
- {3289168800 32400 1 IRKST}
- {3307917600 28800 0 IRKT}
- {3321223200 32400 1 IRKST}
- {3339367200 28800 0 IRKT}
- {3352672800 32400 1 IRKST}
- {3370816800 28800 0 IRKT}
- {3384122400 32400 1 IRKST}
- {3402871200 28800 0 IRKT}
- {3415572000 32400 1 IRKST}
- {3434320800 28800 0 IRKT}
- {3447021600 32400 1 IRKST}
- {3465770400 28800 0 IRKT}
- {3479076000 32400 1 IRKST}
- {3497220000 28800 0 IRKT}
- {3510525600 32400 1 IRKST}
- {3528669600 28800 0 IRKT}
- {3541975200 32400 1 IRKST}
- {3560119200 28800 0 IRKT}
- {3573424800 32400 1 IRKST}
- {3592173600 28800 0 IRKT}
- {3604874400 32400 1 IRKST}
- {3623623200 28800 0 IRKT}
- {3636324000 32400 1 IRKST}
- {3655072800 28800 0 IRKT}
- {3668378400 32400 1 IRKST}
- {3686522400 28800 0 IRKT}
- {3699828000 32400 1 IRKST}
- {3717972000 28800 0 IRKT}
- {3731277600 32400 1 IRKST}
- {3750026400 28800 0 IRKT}
- {3762727200 32400 1 IRKST}
- {3781476000 28800 0 IRKT}
- {3794176800 32400 1 IRKST}
- {3812925600 28800 0 IRKT}
- {3825626400 32400 1 IRKST}
- {3844375200 28800 0 IRKT}
- {3857680800 32400 1 IRKST}
- {3875824800 28800 0 IRKT}
- {3889130400 32400 1 IRKST}
- {3907274400 28800 0 IRKT}
- {3920580000 32400 1 IRKST}
- {3939328800 28800 0 IRKT}
- {3952029600 32400 1 IRKST}
- {3970778400 28800 0 IRKT}
- {3983479200 32400 1 IRKST}
- {4002228000 28800 0 IRKT}
- {4015533600 32400 1 IRKST}
- {4033677600 28800 0 IRKT}
- {4046983200 32400 1 IRKST}
- {4065127200 28800 0 IRKT}
- {4078432800 32400 1 IRKST}
- {4096576800 28800 0 IRKT}
+ {733255200 32400 1 IRKST}
+ {748980000 28800 0 IRKT}
+ {764704800 32400 1 IRKST}
+ {780429600 28800 0 IRKT}
+ {796154400 32400 1 IRKST}
+ {811879200 28800 0 IRKT}
+ {828208800 32400 1 IRKST}
+ {846352800 28800 0 IRKT}
+ {859658400 32400 1 IRKST}
+ {877802400 28800 0 IRKT}
+ {891108000 32400 1 IRKST}
+ {909252000 28800 0 IRKT}
+ {922557600 32400 1 IRKST}
+ {941306400 28800 0 IRKT}
+ {954007200 32400 1 IRKST}
+ {972756000 28800 0 IRKT}
+ {985456800 32400 1 IRKST}
+ {1004205600 28800 0 IRKT}
+ {1017511200 32400 1 IRKST}
+ {1035655200 28800 0 IRKT}
+ {1048960800 32400 1 IRKST}
+ {1067104800 28800 0 IRKT}
+ {1080410400 32400 1 IRKST}
+ {1099159200 28800 0 IRKT}
+ {1111860000 32400 1 IRKST}
+ {1130608800 28800 0 IRKT}
+ {1143309600 32400 1 IRKST}
+ {1162058400 28800 0 IRKT}
+ {1174759200 32400 1 IRKST}
+ {1193508000 28800 0 IRKT}
+ {1206813600 32400 1 IRKST}
+ {1224957600 28800 0 IRKT}
+ {1238263200 32400 1 IRKST}
+ {1256407200 28800 0 IRKT}
+ {1269712800 32400 1 IRKST}
+ {1288461600 28800 0 IRKT}
+ {1301162400 32400 0 IRKT}
}
diff --git a/library/tzdata/Asia/Istanbul b/library/tzdata/Asia/Istanbul
index b949b20..85b3fc2 100644
--- a/library/tzdata/Asia/Istanbul
+++ b/library/tzdata/Asia/Istanbul
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Istanbul)]} {
LoadTimeZoneFile Europe/Istanbul
}
diff --git a/library/tzdata/Asia/Jakarta b/library/tzdata/Asia/Jakarta
index 5454ff0..75cd659 100644
--- a/library/tzdata/Asia/Jakarta
+++ b/library/tzdata/Asia/Jakarta
@@ -1,13 +1,13 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Jakarta) {
{-9223372036854775808 25632 0 LMT}
- {-3231299232 25632 0 JMT}
+ {-3231299232 25632 0 BMT}
{-1451719200 26400 0 JAVT}
- {-1172906400 27000 0 WIT}
+ {-1172906400 27000 0 WIB}
{-876641400 32400 0 JST}
- {-770634000 27000 0 WIT}
- {-683883000 28800 0 WIT}
- {-620812800 27000 0 WIT}
- {-189415800 25200 0 WIT}
+ {-766054800 27000 0 WIB}
+ {-683883000 28800 0 WIB}
+ {-620812800 27000 0 WIB}
+ {-189415800 25200 0 WIB}
}
diff --git a/library/tzdata/Asia/Jayapura b/library/tzdata/Asia/Jayapura
index faa5d18..a71228f 100644
--- a/library/tzdata/Asia/Jayapura
+++ b/library/tzdata/Asia/Jayapura
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Jayapura) {
{-9223372036854775808 33768 0 LMT}
- {-1172913768 32400 0 EIT}
- {-820573200 34200 0 CST}
- {-189423000 32400 0 EIT}
+ {-1172913768 32400 0 WIT}
+ {-799491600 34200 0 CST}
+ {-189423000 32400 0 WIT}
}
diff --git a/library/tzdata/Asia/Jerusalem b/library/tzdata/Asia/Jerusalem
index 3423a7a..7662680 100644
--- a/library/tzdata/Asia/Jerusalem
+++ b/library/tzdata/Asia/Jerusalem
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Jerusalem) {
- {-9223372036854775808 8456 0 LMT}
- {-2840149256 8440 0 JMT}
+ {-9223372036854775808 8454 0 LMT}
+ {-2840149254 8440 0 JMT}
{-1641003640 7200 0 IST}
{-933645600 10800 1 IDT}
{-857358000 7200 0 IST}
@@ -96,53 +96,177 @@ set TZData(:Asia/Jerusalem) {
{1333065600 10800 1 IDT}
{1348354800 7200 0 IST}
{1364515200 10800 1 IDT}
- {1378594800 7200 0 IST}
+ {1382828400 7200 0 IST}
{1395964800 10800 1 IDT}
- {1411858800 7200 0 IST}
+ {1414278000 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}
+ {1445727600 7200 0 IST}
+ {1458864000 10800 1 IDT}
+ {1477782000 7200 0 IST}
+ {1490313600 10800 1 IDT}
+ {1509231600 7200 0 IST}
+ {1521763200 10800 1 IDT}
+ {1540681200 7200 0 IST}
{1553817600 10800 1 IDT}
- {1570316400 7200 0 IST}
+ {1572130800 7200 0 IST}
{1585267200 10800 1 IDT}
- {1601161200 7200 0 IST}
+ {1603580400 7200 0 IST}
{1616716800 10800 1 IDT}
- {1631401200 7200 0 IST}
- {1648771200 10800 1 IDT}
- {1664665200 7200 0 IST}
- {1680220800 10800 1 IDT}
- {1695510000 7200 0 IST}
+ {1635634800 7200 0 IST}
+ {1648166400 10800 1 IDT}
+ {1667084400 7200 0 IST}
+ {1679616000 10800 1 IDT}
+ {1698534000 7200 0 IST}
{1711670400 10800 1 IDT}
- {1728169200 7200 0 IST}
+ {1729983600 7200 0 IST}
{1743120000 10800 1 IDT}
- {1759014000 7200 0 IST}
+ {1761433200 7200 0 IST}
{1774569600 10800 1 IDT}
- {1789858800 7200 0 IST}
+ {1792882800 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}
+ {1824937200 7200 0 IST}
+ {1837468800 10800 1 IDT}
+ {1856386800 7200 0 IST}
+ {1868918400 10800 1 IDT}
+ {1887836400 7200 0 IST}
{1900972800 10800 1 IDT}
- {1917471600 7200 0 IST}
+ {1919286000 7200 0 IST}
{1932422400 10800 1 IDT}
- {1947711600 7200 0 IST}
+ {1950735600 7200 0 IST}
{1963872000 10800 1 IDT}
- {1978556400 7200 0 IST}
- {1995926400 10800 1 IDT}
- {2011820400 7200 0 IST}
- {2027376000 10800 1 IDT}
- {2042060400 7200 0 IST}
- {2058825600 10800 1 IDT}
- {2075324400 7200 0 IST}
+ {1982790000 7200 0 IST}
+ {1995321600 10800 1 IDT}
+ {2014239600 7200 0 IST}
+ {2026771200 10800 1 IDT}
+ {2045689200 7200 0 IST}
+ {2058220800 10800 1 IDT}
+ {2077138800 7200 0 IST}
{2090275200 10800 1 IDT}
- {2106169200 7200 0 IST}
+ {2108588400 7200 0 IST}
{2121724800 10800 1 IDT}
- {2136409200 7200 0 IST}
+ {2140038000 7200 0 IST}
+ {2153174400 10800 1 IDT}
+ {2172092400 7200 0 IST}
+ {2184624000 10800 1 IDT}
+ {2203542000 7200 0 IST}
+ {2216073600 10800 1 IDT}
+ {2234991600 7200 0 IST}
+ {2248128000 10800 1 IDT}
+ {2266441200 7200 0 IST}
+ {2279577600 10800 1 IDT}
+ {2297890800 7200 0 IST}
+ {2311027200 10800 1 IDT}
+ {2329340400 7200 0 IST}
+ {2342476800 10800 1 IDT}
+ {2361394800 7200 0 IST}
+ {2373926400 10800 1 IDT}
+ {2392844400 7200 0 IST}
+ {2405376000 10800 1 IDT}
+ {2424294000 7200 0 IST}
+ {2437430400 10800 1 IDT}
+ {2455743600 7200 0 IST}
+ {2468880000 10800 1 IDT}
+ {2487193200 7200 0 IST}
+ {2500329600 10800 1 IDT}
+ {2519247600 7200 0 IST}
+ {2531779200 10800 1 IDT}
+ {2550697200 7200 0 IST}
+ {2563228800 10800 1 IDT}
+ {2582146800 7200 0 IST}
+ {2595283200 10800 1 IDT}
+ {2613596400 7200 0 IST}
+ {2626732800 10800 1 IDT}
+ {2645046000 7200 0 IST}
+ {2658182400 10800 1 IDT}
+ {2676495600 7200 0 IST}
+ {2689632000 10800 1 IDT}
+ {2708550000 7200 0 IST}
+ {2721081600 10800 1 IDT}
+ {2739999600 7200 0 IST}
+ {2752531200 10800 1 IDT}
+ {2771449200 7200 0 IST}
+ {2784585600 10800 1 IDT}
+ {2802898800 7200 0 IST}
+ {2816035200 10800 1 IDT}
+ {2834348400 7200 0 IST}
+ {2847484800 10800 1 IDT}
+ {2866402800 7200 0 IST}
+ {2878934400 10800 1 IDT}
+ {2897852400 7200 0 IST}
+ {2910384000 10800 1 IDT}
+ {2929302000 7200 0 IST}
+ {2941833600 10800 1 IDT}
+ {2960751600 7200 0 IST}
+ {2973888000 10800 1 IDT}
+ {2992201200 7200 0 IST}
+ {3005337600 10800 1 IDT}
+ {3023650800 7200 0 IST}
+ {3036787200 10800 1 IDT}
+ {3055705200 7200 0 IST}
+ {3068236800 10800 1 IDT}
+ {3087154800 7200 0 IST}
+ {3099686400 10800 1 IDT}
+ {3118604400 7200 0 IST}
+ {3131740800 10800 1 IDT}
+ {3150054000 7200 0 IST}
+ {3163190400 10800 1 IDT}
+ {3181503600 7200 0 IST}
+ {3194640000 10800 1 IDT}
+ {3212953200 7200 0 IST}
+ {3226089600 10800 1 IDT}
+ {3245007600 7200 0 IST}
+ {3257539200 10800 1 IDT}
+ {3276457200 7200 0 IST}
+ {3288988800 10800 1 IDT}
+ {3307906800 7200 0 IST}
+ {3321043200 10800 1 IDT}
+ {3339356400 7200 0 IST}
+ {3352492800 10800 1 IDT}
+ {3370806000 7200 0 IST}
+ {3383942400 10800 1 IDT}
+ {3402860400 7200 0 IST}
+ {3415392000 10800 1 IDT}
+ {3434310000 7200 0 IST}
+ {3446841600 10800 1 IDT}
+ {3465759600 7200 0 IST}
+ {3478896000 10800 1 IDT}
+ {3497209200 7200 0 IST}
+ {3510345600 10800 1 IDT}
+ {3528658800 7200 0 IST}
+ {3541795200 10800 1 IDT}
+ {3560108400 7200 0 IST}
+ {3573244800 10800 1 IDT}
+ {3592162800 7200 0 IST}
+ {3604694400 10800 1 IDT}
+ {3623612400 7200 0 IST}
+ {3636144000 10800 1 IDT}
+ {3655062000 7200 0 IST}
+ {3668198400 10800 1 IDT}
+ {3686511600 7200 0 IST}
+ {3699648000 10800 1 IDT}
+ {3717961200 7200 0 IST}
+ {3731097600 10800 1 IDT}
+ {3750015600 7200 0 IST}
+ {3762547200 10800 1 IDT}
+ {3781465200 7200 0 IST}
+ {3793996800 10800 1 IDT}
+ {3812914800 7200 0 IST}
+ {3825446400 10800 1 IDT}
+ {3844364400 7200 0 IST}
+ {3857500800 10800 1 IDT}
+ {3875814000 7200 0 IST}
+ {3888950400 10800 1 IDT}
+ {3907263600 7200 0 IST}
+ {3920400000 10800 1 IDT}
+ {3939318000 7200 0 IST}
+ {3951849600 10800 1 IDT}
+ {3970767600 7200 0 IST}
+ {3983299200 10800 1 IDT}
+ {4002217200 7200 0 IST}
+ {4015353600 10800 1 IDT}
+ {4033666800 7200 0 IST}
+ {4046803200 10800 1 IDT}
+ {4065116400 7200 0 IST}
+ {4078252800 10800 1 IDT}
+ {4096566000 7200 0 IST}
}
diff --git a/library/tzdata/Asia/Kabul b/library/tzdata/Asia/Kabul
index a8f5626..33d7282 100644
--- a/library/tzdata/Asia/Kabul
+++ b/library/tzdata/Asia/Kabul
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kabul) {
{-9223372036854775808 16608 0 LMT}
diff --git a/library/tzdata/Asia/Kamchatka b/library/tzdata/Asia/Kamchatka
index b47efab..82abcfa 100644
--- a/library/tzdata/Asia/Kamchatka
+++ b/library/tzdata/Asia/Kamchatka
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kamchatka) {
{-9223372036854775808 38076 0 LMT}
@@ -11,236 +11,61 @@ set TZData(:Asia/Kamchatka) {
{417960000 46800 1 PETST}
{433767600 43200 0 PETT}
{449582400 46800 1 PETST}
- {465357600 43200 0 PETT}
- {481082400 46800 1 PETST}
- {496807200 43200 0 PETT}
- {512532000 46800 1 PETST}
- {528256800 43200 0 PETT}
- {543981600 46800 1 PETST}
- {559706400 43200 0 PETT}
- {575431200 46800 1 PETST}
- {591156000 43200 0 PETT}
- {606880800 46800 1 PETST}
- {622605600 43200 0 PETT}
- {638330400 46800 1 PETST}
- {654660000 43200 0 PETT}
- {670384800 43200 0 PETST}
- {686109600 39600 0 PETT}
- {695786400 43200 0 PETMMTT}
+ {465314400 43200 0 PETT}
+ {481039200 46800 1 PETST}
+ {496764000 43200 0 PETT}
+ {512488800 46800 1 PETST}
+ {528213600 43200 0 PETT}
+ {543938400 46800 1 PETST}
+ {559663200 43200 0 PETT}
+ {575388000 46800 1 PETST}
+ {591112800 43200 0 PETT}
+ {606837600 46800 1 PETST}
+ {622562400 43200 0 PETT}
+ {638287200 46800 1 PETST}
+ {654616800 43200 0 PETT}
+ {670341600 39600 0 PETMMTT}
+ {670345200 43200 1 PETST}
+ {686070000 39600 0 PETT}
+ {695746800 43200 0 PETMMTT}
{701780400 46800 1 PETST}
{717501600 43200 0 PETT}
- {733284000 46800 1 PETST}
- {749008800 43200 0 PETT}
- {764733600 46800 1 PETST}
- {780458400 43200 0 PETT}
- {796183200 46800 1 PETST}
- {811908000 43200 0 PETT}
- {828237600 46800 1 PETST}
- {846381600 43200 0 PETT}
- {859687200 46800 1 PETST}
- {877831200 43200 0 PETT}
- {891136800 46800 1 PETST}
- {909280800 43200 0 PETT}
- {922586400 46800 1 PETST}
- {941335200 43200 0 PETT}
- {954036000 46800 1 PETST}
- {972784800 43200 0 PETT}
- {985485600 46800 1 PETST}
- {1004234400 43200 0 PETT}
- {1017540000 46800 1 PETST}
- {1035684000 43200 0 PETT}
- {1048989600 46800 1 PETST}
- {1067133600 43200 0 PETT}
- {1080439200 46800 1 PETST}
- {1099188000 43200 0 PETT}
- {1111888800 46800 1 PETST}
- {1130637600 43200 0 PETT}
- {1143338400 46800 1 PETST}
- {1162087200 43200 0 PETT}
- {1174788000 46800 1 PETST}
- {1193536800 43200 0 PETT}
- {1206842400 46800 1 PETST}
- {1224986400 43200 0 PETT}
- {1238292000 46800 1 PETST}
- {1256436000 43200 0 PETT}
- {1269741600 46800 1 PETST}
- {1288490400 43200 0 PETT}
- {1301191200 46800 1 PETST}
- {1319940000 43200 0 PETT}
- {1332640800 46800 1 PETST}
- {1351389600 43200 0 PETT}
- {1364695200 46800 1 PETST}
- {1382839200 43200 0 PETT}
- {1396144800 46800 1 PETST}
- {1414288800 43200 0 PETT}
- {1427594400 46800 1 PETST}
- {1445738400 43200 0 PETT}
- {1459044000 46800 1 PETST}
- {1477792800 43200 0 PETT}
- {1490493600 46800 1 PETST}
- {1509242400 43200 0 PETT}
- {1521943200 46800 1 PETST}
- {1540692000 43200 0 PETT}
- {1553997600 46800 1 PETST}
- {1572141600 43200 0 PETT}
- {1585447200 46800 1 PETST}
- {1603591200 43200 0 PETT}
- {1616896800 46800 1 PETST}
- {1635645600 43200 0 PETT}
- {1648346400 46800 1 PETST}
- {1667095200 43200 0 PETT}
- {1679796000 46800 1 PETST}
- {1698544800 43200 0 PETT}
- {1711850400 46800 1 PETST}
- {1729994400 43200 0 PETT}
- {1743300000 46800 1 PETST}
- {1761444000 43200 0 PETT}
- {1774749600 46800 1 PETST}
- {1792893600 43200 0 PETT}
- {1806199200 46800 1 PETST}
- {1824948000 43200 0 PETT}
- {1837648800 46800 1 PETST}
- {1856397600 43200 0 PETT}
- {1869098400 46800 1 PETST}
- {1887847200 43200 0 PETT}
- {1901152800 46800 1 PETST}
- {1919296800 43200 0 PETT}
- {1932602400 46800 1 PETST}
- {1950746400 43200 0 PETT}
- {1964052000 46800 1 PETST}
- {1982800800 43200 0 PETT}
- {1995501600 46800 1 PETST}
- {2014250400 43200 0 PETT}
- {2026951200 46800 1 PETST}
- {2045700000 43200 0 PETT}
- {2058400800 46800 1 PETST}
- {2077149600 43200 0 PETT}
- {2090455200 46800 1 PETST}
- {2108599200 43200 0 PETT}
- {2121904800 46800 1 PETST}
- {2140048800 43200 0 PETT}
- {2153354400 46800 1 PETST}
- {2172103200 43200 0 PETT}
- {2184804000 46800 1 PETST}
- {2203552800 43200 0 PETT}
- {2216253600 46800 1 PETST}
- {2235002400 43200 0 PETT}
- {2248308000 46800 1 PETST}
- {2266452000 43200 0 PETT}
- {2279757600 46800 1 PETST}
- {2297901600 43200 0 PETT}
- {2311207200 46800 1 PETST}
- {2329351200 43200 0 PETT}
- {2342656800 46800 1 PETST}
- {2361405600 43200 0 PETT}
- {2374106400 46800 1 PETST}
- {2392855200 43200 0 PETT}
- {2405556000 46800 1 PETST}
- {2424304800 43200 0 PETT}
- {2437610400 46800 1 PETST}
- {2455754400 43200 0 PETT}
- {2469060000 46800 1 PETST}
- {2487204000 43200 0 PETT}
- {2500509600 46800 1 PETST}
- {2519258400 43200 0 PETT}
- {2531959200 46800 1 PETST}
- {2550708000 43200 0 PETT}
- {2563408800 46800 1 PETST}
- {2582157600 43200 0 PETT}
- {2595463200 46800 1 PETST}
- {2613607200 43200 0 PETT}
- {2626912800 46800 1 PETST}
- {2645056800 43200 0 PETT}
- {2658362400 46800 1 PETST}
- {2676506400 43200 0 PETT}
- {2689812000 46800 1 PETST}
- {2708560800 43200 0 PETT}
- {2721261600 46800 1 PETST}
- {2740010400 43200 0 PETT}
- {2752711200 46800 1 PETST}
- {2771460000 43200 0 PETT}
- {2784765600 46800 1 PETST}
- {2802909600 43200 0 PETT}
- {2816215200 46800 1 PETST}
- {2834359200 43200 0 PETT}
- {2847664800 46800 1 PETST}
- {2866413600 43200 0 PETT}
- {2879114400 46800 1 PETST}
- {2897863200 43200 0 PETT}
- {2910564000 46800 1 PETST}
- {2929312800 43200 0 PETT}
- {2942013600 46800 1 PETST}
- {2960762400 43200 0 PETT}
- {2974068000 46800 1 PETST}
- {2992212000 43200 0 PETT}
- {3005517600 46800 1 PETST}
- {3023661600 43200 0 PETT}
- {3036967200 46800 1 PETST}
- {3055716000 43200 0 PETT}
- {3068416800 46800 1 PETST}
- {3087165600 43200 0 PETT}
- {3099866400 46800 1 PETST}
- {3118615200 43200 0 PETT}
- {3131920800 46800 1 PETST}
- {3150064800 43200 0 PETT}
- {3163370400 46800 1 PETST}
- {3181514400 43200 0 PETT}
- {3194820000 46800 1 PETST}
- {3212964000 43200 0 PETT}
- {3226269600 46800 1 PETST}
- {3245018400 43200 0 PETT}
- {3257719200 46800 1 PETST}
- {3276468000 43200 0 PETT}
- {3289168800 46800 1 PETST}
- {3307917600 43200 0 PETT}
- {3321223200 46800 1 PETST}
- {3339367200 43200 0 PETT}
- {3352672800 46800 1 PETST}
- {3370816800 43200 0 PETT}
- {3384122400 46800 1 PETST}
- {3402871200 43200 0 PETT}
- {3415572000 46800 1 PETST}
- {3434320800 43200 0 PETT}
- {3447021600 46800 1 PETST}
- {3465770400 43200 0 PETT}
- {3479076000 46800 1 PETST}
- {3497220000 43200 0 PETT}
- {3510525600 46800 1 PETST}
- {3528669600 43200 0 PETT}
- {3541975200 46800 1 PETST}
- {3560119200 43200 0 PETT}
- {3573424800 46800 1 PETST}
- {3592173600 43200 0 PETT}
- {3604874400 46800 1 PETST}
- {3623623200 43200 0 PETT}
- {3636324000 46800 1 PETST}
- {3655072800 43200 0 PETT}
- {3668378400 46800 1 PETST}
- {3686522400 43200 0 PETT}
- {3699828000 46800 1 PETST}
- {3717972000 43200 0 PETT}
- {3731277600 46800 1 PETST}
- {3750026400 43200 0 PETT}
- {3762727200 46800 1 PETST}
- {3781476000 43200 0 PETT}
- {3794176800 46800 1 PETST}
- {3812925600 43200 0 PETT}
- {3825626400 46800 1 PETST}
- {3844375200 43200 0 PETT}
- {3857680800 46800 1 PETST}
- {3875824800 43200 0 PETT}
- {3889130400 46800 1 PETST}
- {3907274400 43200 0 PETT}
- {3920580000 46800 1 PETST}
- {3939328800 43200 0 PETT}
- {3952029600 46800 1 PETST}
- {3970778400 43200 0 PETT}
- {3983479200 46800 1 PETST}
- {4002228000 43200 0 PETT}
- {4015533600 46800 1 PETST}
- {4033677600 43200 0 PETT}
- {4046983200 46800 1 PETST}
- {4065127200 43200 0 PETT}
- {4078432800 46800 1 PETST}
- {4096576800 43200 0 PETT}
+ {733240800 46800 1 PETST}
+ {748965600 43200 0 PETT}
+ {764690400 46800 1 PETST}
+ {780415200 43200 0 PETT}
+ {796140000 46800 1 PETST}
+ {811864800 43200 0 PETT}
+ {828194400 46800 1 PETST}
+ {846338400 43200 0 PETT}
+ {859644000 46800 1 PETST}
+ {877788000 43200 0 PETT}
+ {891093600 46800 1 PETST}
+ {909237600 43200 0 PETT}
+ {922543200 46800 1 PETST}
+ {941292000 43200 0 PETT}
+ {953992800 46800 1 PETST}
+ {972741600 43200 0 PETT}
+ {985442400 46800 1 PETST}
+ {1004191200 43200 0 PETT}
+ {1017496800 46800 1 PETST}
+ {1035640800 43200 0 PETT}
+ {1048946400 46800 1 PETST}
+ {1067090400 43200 0 PETT}
+ {1080396000 46800 1 PETST}
+ {1099144800 43200 0 PETT}
+ {1111845600 46800 1 PETST}
+ {1130594400 43200 0 PETT}
+ {1143295200 46800 1 PETST}
+ {1162044000 43200 0 PETT}
+ {1174744800 46800 1 PETST}
+ {1193493600 43200 0 PETT}
+ {1206799200 46800 1 PETST}
+ {1224943200 43200 0 PETT}
+ {1238248800 46800 1 PETST}
+ {1256392800 43200 0 PETT}
+ {1269698400 39600 0 PETMMTT}
+ {1269702000 43200 1 PETST}
+ {1288450800 39600 0 PETT}
+ {1301151600 43200 0 PETT}
}
diff --git a/library/tzdata/Asia/Karachi b/library/tzdata/Asia/Karachi
index c5144d0..3faa31e 100644
--- a/library/tzdata/Asia/Karachi
+++ b/library/tzdata/Asia/Karachi
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Karachi) {
{-9223372036854775808 16092 0 LMT}
@@ -9,4 +9,8 @@ set TZData(:Asia/Karachi) {
{38775600 18000 0 PKT}
{1018119660 21600 1 PKST}
{1033840860 18000 0 PKT}
+ {1212260400 21600 1 PKST}
+ {1225476000 18000 0 PKT}
+ {1239735600 21600 1 PKST}
+ {1257012000 18000 0 PKT}
}
diff --git a/library/tzdata/Asia/Kashgar b/library/tzdata/Asia/Kashgar
index f918956..2f64f42 100644
--- a/library/tzdata/Asia/Kashgar
+++ b/library/tzdata/Asia/Kashgar
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kashgar) {
{-9223372036854775808 18236 0 LMT}
diff --git a/library/tzdata/Asia/Kathmandu b/library/tzdata/Asia/Kathmandu
new file mode 100644
index 0000000..dbec1f0
--- /dev/null
+++ b/library/tzdata/Asia/Kathmandu
@@ -0,0 +1,7 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Kathmandu) {
+ {-9223372036854775808 20476 0 LMT}
+ {-1577943676 19800 0 IST}
+ {504901800 20700 0 NPT}
+}
diff --git a/library/tzdata/Asia/Katmandu b/library/tzdata/Asia/Katmandu
index 3a5e4b5..2d6d060 100644
--- a/library/tzdata/Asia/Katmandu
+++ b/library/tzdata/Asia/Katmandu
@@ -1,7 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Asia/Katmandu) {
- {-9223372036854775808 20476 0 LMT}
- {-1577943676 19800 0 IST}
- {504901800 20700 0 NPT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Asia/Kathmandu)]} {
+ LoadTimeZoneFile Asia/Kathmandu
}
+set TZData(:Asia/Katmandu) $TZData(:Asia/Kathmandu)
diff --git a/library/tzdata/Asia/Khandyga b/library/tzdata/Asia/Khandyga
new file mode 100644
index 0000000..2464b9f
--- /dev/null
+++ b/library/tzdata/Asia/Khandyga
@@ -0,0 +1,72 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Khandyga) {
+ {-9223372036854775808 32533 0 LMT}
+ {-1579424533 28800 0 YAKT}
+ {-1247558400 32400 0 YAKMMTT}
+ {354898800 36000 1 YAKST}
+ {370706400 32400 0 YAKT}
+ {386434800 36000 1 YAKST}
+ {402242400 32400 0 YAKT}
+ {417970800 36000 1 YAKST}
+ {433778400 32400 0 YAKT}
+ {449593200 36000 1 YAKST}
+ {465325200 32400 0 YAKT}
+ {481050000 36000 1 YAKST}
+ {496774800 32400 0 YAKT}
+ {512499600 36000 1 YAKST}
+ {528224400 32400 0 YAKT}
+ {543949200 36000 1 YAKST}
+ {559674000 32400 0 YAKT}
+ {575398800 36000 1 YAKST}
+ {591123600 32400 0 YAKT}
+ {606848400 36000 1 YAKST}
+ {622573200 32400 0 YAKT}
+ {638298000 36000 1 YAKST}
+ {654627600 32400 0 YAKT}
+ {670352400 28800 0 YAKMMTT}
+ {670356000 32400 1 YAKST}
+ {686080800 28800 0 YAKT}
+ {695757600 32400 0 YAKMMTT}
+ {701791200 36000 1 YAKST}
+ {717512400 32400 0 YAKT}
+ {733251600 36000 1 YAKST}
+ {748976400 32400 0 YAKT}
+ {764701200 36000 1 YAKST}
+ {780426000 32400 0 YAKT}
+ {796150800 36000 1 YAKST}
+ {811875600 32400 0 YAKT}
+ {828205200 36000 1 YAKST}
+ {846349200 32400 0 YAKT}
+ {859654800 36000 1 YAKST}
+ {877798800 32400 0 YAKT}
+ {891104400 36000 1 YAKST}
+ {909248400 32400 0 YAKT}
+ {922554000 36000 1 YAKST}
+ {941302800 32400 0 YAKT}
+ {954003600 36000 1 YAKST}
+ {972752400 32400 0 YAKT}
+ {985453200 36000 1 YAKST}
+ {1004202000 32400 0 YAKT}
+ {1017507600 36000 1 YAKST}
+ {1035651600 32400 0 YAKT}
+ {1048957200 36000 1 YAKST}
+ {1067101200 32400 0 YAKT}
+ {1072882800 36000 0 VLAMMTT}
+ {1080403200 39600 1 VLAST}
+ {1099152000 36000 0 VLAT}
+ {1111852800 39600 1 VLAST}
+ {1130601600 36000 0 VLAT}
+ {1143302400 39600 1 VLAST}
+ {1162051200 36000 0 VLAT}
+ {1174752000 39600 1 VLAST}
+ {1193500800 36000 0 VLAT}
+ {1206806400 39600 1 VLAST}
+ {1224950400 36000 0 VLAT}
+ {1238256000 39600 1 VLAST}
+ {1256400000 36000 0 VLAT}
+ {1269705600 39600 1 VLAST}
+ {1288454400 36000 0 VLAT}
+ {1301155200 39600 0 VLAT}
+ {1315832400 36000 0 YAKT}
+}
diff --git a/library/tzdata/Asia/Kolkata b/library/tzdata/Asia/Kolkata
new file mode 100644
index 0000000..a87bf31
--- /dev/null
+++ b/library/tzdata/Asia/Kolkata
@@ -0,0 +1,10 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Kolkata) {
+ {-9223372036854775808 21208 0 LMT}
+ {-2840162008 21200 0 HMT}
+ {-891582800 23400 0 BURT}
+ {-872058600 19800 0 IST}
+ {-862637400 23400 1 IST}
+ {-764145000 19800 0 IST}
+}
diff --git a/library/tzdata/Asia/Krasnoyarsk b/library/tzdata/Asia/Krasnoyarsk
index dfdb4b8..13dfeb5 100644
--- a/library/tzdata/Asia/Krasnoyarsk
+++ b/library/tzdata/Asia/Krasnoyarsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Krasnoyarsk) {
{-9223372036854775808 22280 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Krasnoyarsk) {
{417978000 28800 1 KRAST}
{433785600 25200 0 KRAT}
{449600400 28800 1 KRAST}
- {465357600 25200 0 KRAT}
- {481082400 28800 1 KRAST}
- {496807200 25200 0 KRAT}
- {512532000 28800 1 KRAST}
- {528256800 25200 0 KRAT}
- {543981600 28800 1 KRAST}
- {559706400 25200 0 KRAT}
- {575431200 28800 1 KRAST}
- {591156000 25200 0 KRAT}
- {606880800 28800 1 KRAST}
- {622605600 25200 0 KRAT}
- {638330400 28800 1 KRAST}
- {654660000 25200 0 KRAT}
- {670384800 25200 0 KRAST}
- {686109600 21600 0 KRAT}
- {695786400 25200 0 KRAMMTT}
+ {465332400 25200 0 KRAT}
+ {481057200 28800 1 KRAST}
+ {496782000 25200 0 KRAT}
+ {512506800 28800 1 KRAST}
+ {528231600 25200 0 KRAT}
+ {543956400 28800 1 KRAST}
+ {559681200 25200 0 KRAT}
+ {575406000 28800 1 KRAST}
+ {591130800 25200 0 KRAT}
+ {606855600 28800 1 KRAST}
+ {622580400 25200 0 KRAT}
+ {638305200 28800 1 KRAST}
+ {654634800 25200 0 KRAT}
+ {670359600 21600 0 KRAMMTT}
+ {670363200 25200 1 KRAST}
+ {686088000 21600 0 KRAT}
+ {695764800 25200 0 KRAMMTT}
{701798400 28800 1 KRAST}
{717519600 25200 0 KRAT}
- {733284000 28800 1 KRAST}
- {749008800 25200 0 KRAT}
- {764733600 28800 1 KRAST}
- {780458400 25200 0 KRAT}
- {796183200 28800 1 KRAST}
- {811908000 25200 0 KRAT}
- {828237600 28800 1 KRAST}
- {846381600 25200 0 KRAT}
- {859687200 28800 1 KRAST}
- {877831200 25200 0 KRAT}
- {891136800 28800 1 KRAST}
- {909280800 25200 0 KRAT}
- {922586400 28800 1 KRAST}
- {941335200 25200 0 KRAT}
- {954036000 28800 1 KRAST}
- {972784800 25200 0 KRAT}
- {985485600 28800 1 KRAST}
- {1004234400 25200 0 KRAT}
- {1017540000 28800 1 KRAST}
- {1035684000 25200 0 KRAT}
- {1048989600 28800 1 KRAST}
- {1067133600 25200 0 KRAT}
- {1080439200 28800 1 KRAST}
- {1099188000 25200 0 KRAT}
- {1111888800 28800 1 KRAST}
- {1130637600 25200 0 KRAT}
- {1143338400 28800 1 KRAST}
- {1162087200 25200 0 KRAT}
- {1174788000 28800 1 KRAST}
- {1193536800 25200 0 KRAT}
- {1206842400 28800 1 KRAST}
- {1224986400 25200 0 KRAT}
- {1238292000 28800 1 KRAST}
- {1256436000 25200 0 KRAT}
- {1269741600 28800 1 KRAST}
- {1288490400 25200 0 KRAT}
- {1301191200 28800 1 KRAST}
- {1319940000 25200 0 KRAT}
- {1332640800 28800 1 KRAST}
- {1351389600 25200 0 KRAT}
- {1364695200 28800 1 KRAST}
- {1382839200 25200 0 KRAT}
- {1396144800 28800 1 KRAST}
- {1414288800 25200 0 KRAT}
- {1427594400 28800 1 KRAST}
- {1445738400 25200 0 KRAT}
- {1459044000 28800 1 KRAST}
- {1477792800 25200 0 KRAT}
- {1490493600 28800 1 KRAST}
- {1509242400 25200 0 KRAT}
- {1521943200 28800 1 KRAST}
- {1540692000 25200 0 KRAT}
- {1553997600 28800 1 KRAST}
- {1572141600 25200 0 KRAT}
- {1585447200 28800 1 KRAST}
- {1603591200 25200 0 KRAT}
- {1616896800 28800 1 KRAST}
- {1635645600 25200 0 KRAT}
- {1648346400 28800 1 KRAST}
- {1667095200 25200 0 KRAT}
- {1679796000 28800 1 KRAST}
- {1698544800 25200 0 KRAT}
- {1711850400 28800 1 KRAST}
- {1729994400 25200 0 KRAT}
- {1743300000 28800 1 KRAST}
- {1761444000 25200 0 KRAT}
- {1774749600 28800 1 KRAST}
- {1792893600 25200 0 KRAT}
- {1806199200 28800 1 KRAST}
- {1824948000 25200 0 KRAT}
- {1837648800 28800 1 KRAST}
- {1856397600 25200 0 KRAT}
- {1869098400 28800 1 KRAST}
- {1887847200 25200 0 KRAT}
- {1901152800 28800 1 KRAST}
- {1919296800 25200 0 KRAT}
- {1932602400 28800 1 KRAST}
- {1950746400 25200 0 KRAT}
- {1964052000 28800 1 KRAST}
- {1982800800 25200 0 KRAT}
- {1995501600 28800 1 KRAST}
- {2014250400 25200 0 KRAT}
- {2026951200 28800 1 KRAST}
- {2045700000 25200 0 KRAT}
- {2058400800 28800 1 KRAST}
- {2077149600 25200 0 KRAT}
- {2090455200 28800 1 KRAST}
- {2108599200 25200 0 KRAT}
- {2121904800 28800 1 KRAST}
- {2140048800 25200 0 KRAT}
- {2153354400 28800 1 KRAST}
- {2172103200 25200 0 KRAT}
- {2184804000 28800 1 KRAST}
- {2203552800 25200 0 KRAT}
- {2216253600 28800 1 KRAST}
- {2235002400 25200 0 KRAT}
- {2248308000 28800 1 KRAST}
- {2266452000 25200 0 KRAT}
- {2279757600 28800 1 KRAST}
- {2297901600 25200 0 KRAT}
- {2311207200 28800 1 KRAST}
- {2329351200 25200 0 KRAT}
- {2342656800 28800 1 KRAST}
- {2361405600 25200 0 KRAT}
- {2374106400 28800 1 KRAST}
- {2392855200 25200 0 KRAT}
- {2405556000 28800 1 KRAST}
- {2424304800 25200 0 KRAT}
- {2437610400 28800 1 KRAST}
- {2455754400 25200 0 KRAT}
- {2469060000 28800 1 KRAST}
- {2487204000 25200 0 KRAT}
- {2500509600 28800 1 KRAST}
- {2519258400 25200 0 KRAT}
- {2531959200 28800 1 KRAST}
- {2550708000 25200 0 KRAT}
- {2563408800 28800 1 KRAST}
- {2582157600 25200 0 KRAT}
- {2595463200 28800 1 KRAST}
- {2613607200 25200 0 KRAT}
- {2626912800 28800 1 KRAST}
- {2645056800 25200 0 KRAT}
- {2658362400 28800 1 KRAST}
- {2676506400 25200 0 KRAT}
- {2689812000 28800 1 KRAST}
- {2708560800 25200 0 KRAT}
- {2721261600 28800 1 KRAST}
- {2740010400 25200 0 KRAT}
- {2752711200 28800 1 KRAST}
- {2771460000 25200 0 KRAT}
- {2784765600 28800 1 KRAST}
- {2802909600 25200 0 KRAT}
- {2816215200 28800 1 KRAST}
- {2834359200 25200 0 KRAT}
- {2847664800 28800 1 KRAST}
- {2866413600 25200 0 KRAT}
- {2879114400 28800 1 KRAST}
- {2897863200 25200 0 KRAT}
- {2910564000 28800 1 KRAST}
- {2929312800 25200 0 KRAT}
- {2942013600 28800 1 KRAST}
- {2960762400 25200 0 KRAT}
- {2974068000 28800 1 KRAST}
- {2992212000 25200 0 KRAT}
- {3005517600 28800 1 KRAST}
- {3023661600 25200 0 KRAT}
- {3036967200 28800 1 KRAST}
- {3055716000 25200 0 KRAT}
- {3068416800 28800 1 KRAST}
- {3087165600 25200 0 KRAT}
- {3099866400 28800 1 KRAST}
- {3118615200 25200 0 KRAT}
- {3131920800 28800 1 KRAST}
- {3150064800 25200 0 KRAT}
- {3163370400 28800 1 KRAST}
- {3181514400 25200 0 KRAT}
- {3194820000 28800 1 KRAST}
- {3212964000 25200 0 KRAT}
- {3226269600 28800 1 KRAST}
- {3245018400 25200 0 KRAT}
- {3257719200 28800 1 KRAST}
- {3276468000 25200 0 KRAT}
- {3289168800 28800 1 KRAST}
- {3307917600 25200 0 KRAT}
- {3321223200 28800 1 KRAST}
- {3339367200 25200 0 KRAT}
- {3352672800 28800 1 KRAST}
- {3370816800 25200 0 KRAT}
- {3384122400 28800 1 KRAST}
- {3402871200 25200 0 KRAT}
- {3415572000 28800 1 KRAST}
- {3434320800 25200 0 KRAT}
- {3447021600 28800 1 KRAST}
- {3465770400 25200 0 KRAT}
- {3479076000 28800 1 KRAST}
- {3497220000 25200 0 KRAT}
- {3510525600 28800 1 KRAST}
- {3528669600 25200 0 KRAT}
- {3541975200 28800 1 KRAST}
- {3560119200 25200 0 KRAT}
- {3573424800 28800 1 KRAST}
- {3592173600 25200 0 KRAT}
- {3604874400 28800 1 KRAST}
- {3623623200 25200 0 KRAT}
- {3636324000 28800 1 KRAST}
- {3655072800 25200 0 KRAT}
- {3668378400 28800 1 KRAST}
- {3686522400 25200 0 KRAT}
- {3699828000 28800 1 KRAST}
- {3717972000 25200 0 KRAT}
- {3731277600 28800 1 KRAST}
- {3750026400 25200 0 KRAT}
- {3762727200 28800 1 KRAST}
- {3781476000 25200 0 KRAT}
- {3794176800 28800 1 KRAST}
- {3812925600 25200 0 KRAT}
- {3825626400 28800 1 KRAST}
- {3844375200 25200 0 KRAT}
- {3857680800 28800 1 KRAST}
- {3875824800 25200 0 KRAT}
- {3889130400 28800 1 KRAST}
- {3907274400 25200 0 KRAT}
- {3920580000 28800 1 KRAST}
- {3939328800 25200 0 KRAT}
- {3952029600 28800 1 KRAST}
- {3970778400 25200 0 KRAT}
- {3983479200 28800 1 KRAST}
- {4002228000 25200 0 KRAT}
- {4015533600 28800 1 KRAST}
- {4033677600 25200 0 KRAT}
- {4046983200 28800 1 KRAST}
- {4065127200 25200 0 KRAT}
- {4078432800 28800 1 KRAST}
- {4096576800 25200 0 KRAT}
+ {733258800 28800 1 KRAST}
+ {748983600 25200 0 KRAT}
+ {764708400 28800 1 KRAST}
+ {780433200 25200 0 KRAT}
+ {796158000 28800 1 KRAST}
+ {811882800 25200 0 KRAT}
+ {828212400 28800 1 KRAST}
+ {846356400 25200 0 KRAT}
+ {859662000 28800 1 KRAST}
+ {877806000 25200 0 KRAT}
+ {891111600 28800 1 KRAST}
+ {909255600 25200 0 KRAT}
+ {922561200 28800 1 KRAST}
+ {941310000 25200 0 KRAT}
+ {954010800 28800 1 KRAST}
+ {972759600 25200 0 KRAT}
+ {985460400 28800 1 KRAST}
+ {1004209200 25200 0 KRAT}
+ {1017514800 28800 1 KRAST}
+ {1035658800 25200 0 KRAT}
+ {1048964400 28800 1 KRAST}
+ {1067108400 25200 0 KRAT}
+ {1080414000 28800 1 KRAST}
+ {1099162800 25200 0 KRAT}
+ {1111863600 28800 1 KRAST}
+ {1130612400 25200 0 KRAT}
+ {1143313200 28800 1 KRAST}
+ {1162062000 25200 0 KRAT}
+ {1174762800 28800 1 KRAST}
+ {1193511600 25200 0 KRAT}
+ {1206817200 28800 1 KRAST}
+ {1224961200 25200 0 KRAT}
+ {1238266800 28800 1 KRAST}
+ {1256410800 25200 0 KRAT}
+ {1269716400 28800 1 KRAST}
+ {1288465200 25200 0 KRAT}
+ {1301166000 28800 0 KRAT}
}
diff --git a/library/tzdata/Asia/Kuala_Lumpur b/library/tzdata/Asia/Kuala_Lumpur
index 79ee986..7a54bd6 100644
--- a/library/tzdata/Asia/Kuala_Lumpur
+++ b/library/tzdata/Asia/Kuala_Lumpur
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kuala_Lumpur) {
{-9223372036854775808 24406 0 LMT}
diff --git a/library/tzdata/Asia/Kuching b/library/tzdata/Asia/Kuching
index 790f947..0f9110c 100644
--- a/library/tzdata/Asia/Kuching
+++ b/library/tzdata/Asia/Kuching
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kuching) {
{-9223372036854775808 26480 0 LMT}
diff --git a/library/tzdata/Asia/Kuwait b/library/tzdata/Asia/Kuwait
index afc1b13..15d26db 100644
--- a/library/tzdata/Asia/Kuwait
+++ b/library/tzdata/Asia/Kuwait
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Kuwait) {
{-9223372036854775808 11516 0 LMT}
diff --git a/library/tzdata/Asia/Macao b/library/tzdata/Asia/Macao
index 3147125..6e972ff 100644
--- a/library/tzdata/Asia/Macao
+++ b/library/tzdata/Asia/Macao
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Macau)]} {
LoadTimeZoneFile Asia/Macau
}
diff --git a/library/tzdata/Asia/Macau b/library/tzdata/Asia/Macau
index b54922d..9d4abfe 100644
--- a/library/tzdata/Asia/Macau
+++ b/library/tzdata/Asia/Macau
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Macau) {
{-9223372036854775808 27260 0 LMT}
diff --git a/library/tzdata/Asia/Magadan b/library/tzdata/Asia/Magadan
index c351faa..62e01c5 100644
--- a/library/tzdata/Asia/Magadan
+++ b/library/tzdata/Asia/Magadan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Magadan) {
{-9223372036854775808 36192 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Magadan) {
{417963600 43200 1 MAGST}
{433771200 39600 0 MAGT}
{449586000 43200 1 MAGST}
- {465357600 39600 0 MAGT}
- {481082400 43200 1 MAGST}
- {496807200 39600 0 MAGT}
- {512532000 43200 1 MAGST}
- {528256800 39600 0 MAGT}
- {543981600 43200 1 MAGST}
- {559706400 39600 0 MAGT}
- {575431200 43200 1 MAGST}
- {591156000 39600 0 MAGT}
- {606880800 43200 1 MAGST}
- {622605600 39600 0 MAGT}
- {638330400 43200 1 MAGST}
- {654660000 39600 0 MAGT}
- {670384800 39600 0 MAGST}
- {686109600 36000 0 MAGT}
- {695786400 39600 0 MAGMMTT}
+ {465318000 39600 0 MAGT}
+ {481042800 43200 1 MAGST}
+ {496767600 39600 0 MAGT}
+ {512492400 43200 1 MAGST}
+ {528217200 39600 0 MAGT}
+ {543942000 43200 1 MAGST}
+ {559666800 39600 0 MAGT}
+ {575391600 43200 1 MAGST}
+ {591116400 39600 0 MAGT}
+ {606841200 43200 1 MAGST}
+ {622566000 39600 0 MAGT}
+ {638290800 43200 1 MAGST}
+ {654620400 39600 0 MAGT}
+ {670345200 36000 0 MAGMMTT}
+ {670348800 39600 1 MAGST}
+ {686073600 36000 0 MAGT}
+ {695750400 39600 0 MAGMMTT}
{701784000 43200 1 MAGST}
{717505200 39600 0 MAGT}
- {733284000 43200 1 MAGST}
- {749008800 39600 0 MAGT}
- {764733600 43200 1 MAGST}
- {780458400 39600 0 MAGT}
- {796183200 43200 1 MAGST}
- {811908000 39600 0 MAGT}
- {828237600 43200 1 MAGST}
- {846381600 39600 0 MAGT}
- {859687200 43200 1 MAGST}
- {877831200 39600 0 MAGT}
- {891136800 43200 1 MAGST}
- {909280800 39600 0 MAGT}
- {922586400 43200 1 MAGST}
- {941335200 39600 0 MAGT}
- {954036000 43200 1 MAGST}
- {972784800 39600 0 MAGT}
- {985485600 43200 1 MAGST}
- {1004234400 39600 0 MAGT}
- {1017540000 43200 1 MAGST}
- {1035684000 39600 0 MAGT}
- {1048989600 43200 1 MAGST}
- {1067133600 39600 0 MAGT}
- {1080439200 43200 1 MAGST}
- {1099188000 39600 0 MAGT}
- {1111888800 43200 1 MAGST}
- {1130637600 39600 0 MAGT}
- {1143338400 43200 1 MAGST}
- {1162087200 39600 0 MAGT}
- {1174788000 43200 1 MAGST}
- {1193536800 39600 0 MAGT}
- {1206842400 43200 1 MAGST}
- {1224986400 39600 0 MAGT}
- {1238292000 43200 1 MAGST}
- {1256436000 39600 0 MAGT}
- {1269741600 43200 1 MAGST}
- {1288490400 39600 0 MAGT}
- {1301191200 43200 1 MAGST}
- {1319940000 39600 0 MAGT}
- {1332640800 43200 1 MAGST}
- {1351389600 39600 0 MAGT}
- {1364695200 43200 1 MAGST}
- {1382839200 39600 0 MAGT}
- {1396144800 43200 1 MAGST}
- {1414288800 39600 0 MAGT}
- {1427594400 43200 1 MAGST}
- {1445738400 39600 0 MAGT}
- {1459044000 43200 1 MAGST}
- {1477792800 39600 0 MAGT}
- {1490493600 43200 1 MAGST}
- {1509242400 39600 0 MAGT}
- {1521943200 43200 1 MAGST}
- {1540692000 39600 0 MAGT}
- {1553997600 43200 1 MAGST}
- {1572141600 39600 0 MAGT}
- {1585447200 43200 1 MAGST}
- {1603591200 39600 0 MAGT}
- {1616896800 43200 1 MAGST}
- {1635645600 39600 0 MAGT}
- {1648346400 43200 1 MAGST}
- {1667095200 39600 0 MAGT}
- {1679796000 43200 1 MAGST}
- {1698544800 39600 0 MAGT}
- {1711850400 43200 1 MAGST}
- {1729994400 39600 0 MAGT}
- {1743300000 43200 1 MAGST}
- {1761444000 39600 0 MAGT}
- {1774749600 43200 1 MAGST}
- {1792893600 39600 0 MAGT}
- {1806199200 43200 1 MAGST}
- {1824948000 39600 0 MAGT}
- {1837648800 43200 1 MAGST}
- {1856397600 39600 0 MAGT}
- {1869098400 43200 1 MAGST}
- {1887847200 39600 0 MAGT}
- {1901152800 43200 1 MAGST}
- {1919296800 39600 0 MAGT}
- {1932602400 43200 1 MAGST}
- {1950746400 39600 0 MAGT}
- {1964052000 43200 1 MAGST}
- {1982800800 39600 0 MAGT}
- {1995501600 43200 1 MAGST}
- {2014250400 39600 0 MAGT}
- {2026951200 43200 1 MAGST}
- {2045700000 39600 0 MAGT}
- {2058400800 43200 1 MAGST}
- {2077149600 39600 0 MAGT}
- {2090455200 43200 1 MAGST}
- {2108599200 39600 0 MAGT}
- {2121904800 43200 1 MAGST}
- {2140048800 39600 0 MAGT}
- {2153354400 43200 1 MAGST}
- {2172103200 39600 0 MAGT}
- {2184804000 43200 1 MAGST}
- {2203552800 39600 0 MAGT}
- {2216253600 43200 1 MAGST}
- {2235002400 39600 0 MAGT}
- {2248308000 43200 1 MAGST}
- {2266452000 39600 0 MAGT}
- {2279757600 43200 1 MAGST}
- {2297901600 39600 0 MAGT}
- {2311207200 43200 1 MAGST}
- {2329351200 39600 0 MAGT}
- {2342656800 43200 1 MAGST}
- {2361405600 39600 0 MAGT}
- {2374106400 43200 1 MAGST}
- {2392855200 39600 0 MAGT}
- {2405556000 43200 1 MAGST}
- {2424304800 39600 0 MAGT}
- {2437610400 43200 1 MAGST}
- {2455754400 39600 0 MAGT}
- {2469060000 43200 1 MAGST}
- {2487204000 39600 0 MAGT}
- {2500509600 43200 1 MAGST}
- {2519258400 39600 0 MAGT}
- {2531959200 43200 1 MAGST}
- {2550708000 39600 0 MAGT}
- {2563408800 43200 1 MAGST}
- {2582157600 39600 0 MAGT}
- {2595463200 43200 1 MAGST}
- {2613607200 39600 0 MAGT}
- {2626912800 43200 1 MAGST}
- {2645056800 39600 0 MAGT}
- {2658362400 43200 1 MAGST}
- {2676506400 39600 0 MAGT}
- {2689812000 43200 1 MAGST}
- {2708560800 39600 0 MAGT}
- {2721261600 43200 1 MAGST}
- {2740010400 39600 0 MAGT}
- {2752711200 43200 1 MAGST}
- {2771460000 39600 0 MAGT}
- {2784765600 43200 1 MAGST}
- {2802909600 39600 0 MAGT}
- {2816215200 43200 1 MAGST}
- {2834359200 39600 0 MAGT}
- {2847664800 43200 1 MAGST}
- {2866413600 39600 0 MAGT}
- {2879114400 43200 1 MAGST}
- {2897863200 39600 0 MAGT}
- {2910564000 43200 1 MAGST}
- {2929312800 39600 0 MAGT}
- {2942013600 43200 1 MAGST}
- {2960762400 39600 0 MAGT}
- {2974068000 43200 1 MAGST}
- {2992212000 39600 0 MAGT}
- {3005517600 43200 1 MAGST}
- {3023661600 39600 0 MAGT}
- {3036967200 43200 1 MAGST}
- {3055716000 39600 0 MAGT}
- {3068416800 43200 1 MAGST}
- {3087165600 39600 0 MAGT}
- {3099866400 43200 1 MAGST}
- {3118615200 39600 0 MAGT}
- {3131920800 43200 1 MAGST}
- {3150064800 39600 0 MAGT}
- {3163370400 43200 1 MAGST}
- {3181514400 39600 0 MAGT}
- {3194820000 43200 1 MAGST}
- {3212964000 39600 0 MAGT}
- {3226269600 43200 1 MAGST}
- {3245018400 39600 0 MAGT}
- {3257719200 43200 1 MAGST}
- {3276468000 39600 0 MAGT}
- {3289168800 43200 1 MAGST}
- {3307917600 39600 0 MAGT}
- {3321223200 43200 1 MAGST}
- {3339367200 39600 0 MAGT}
- {3352672800 43200 1 MAGST}
- {3370816800 39600 0 MAGT}
- {3384122400 43200 1 MAGST}
- {3402871200 39600 0 MAGT}
- {3415572000 43200 1 MAGST}
- {3434320800 39600 0 MAGT}
- {3447021600 43200 1 MAGST}
- {3465770400 39600 0 MAGT}
- {3479076000 43200 1 MAGST}
- {3497220000 39600 0 MAGT}
- {3510525600 43200 1 MAGST}
- {3528669600 39600 0 MAGT}
- {3541975200 43200 1 MAGST}
- {3560119200 39600 0 MAGT}
- {3573424800 43200 1 MAGST}
- {3592173600 39600 0 MAGT}
- {3604874400 43200 1 MAGST}
- {3623623200 39600 0 MAGT}
- {3636324000 43200 1 MAGST}
- {3655072800 39600 0 MAGT}
- {3668378400 43200 1 MAGST}
- {3686522400 39600 0 MAGT}
- {3699828000 43200 1 MAGST}
- {3717972000 39600 0 MAGT}
- {3731277600 43200 1 MAGST}
- {3750026400 39600 0 MAGT}
- {3762727200 43200 1 MAGST}
- {3781476000 39600 0 MAGT}
- {3794176800 43200 1 MAGST}
- {3812925600 39600 0 MAGT}
- {3825626400 43200 1 MAGST}
- {3844375200 39600 0 MAGT}
- {3857680800 43200 1 MAGST}
- {3875824800 39600 0 MAGT}
- {3889130400 43200 1 MAGST}
- {3907274400 39600 0 MAGT}
- {3920580000 43200 1 MAGST}
- {3939328800 39600 0 MAGT}
- {3952029600 43200 1 MAGST}
- {3970778400 39600 0 MAGT}
- {3983479200 43200 1 MAGST}
- {4002228000 39600 0 MAGT}
- {4015533600 43200 1 MAGST}
- {4033677600 39600 0 MAGT}
- {4046983200 43200 1 MAGST}
- {4065127200 39600 0 MAGT}
- {4078432800 43200 1 MAGST}
- {4096576800 39600 0 MAGT}
+ {733244400 43200 1 MAGST}
+ {748969200 39600 0 MAGT}
+ {764694000 43200 1 MAGST}
+ {780418800 39600 0 MAGT}
+ {796143600 43200 1 MAGST}
+ {811868400 39600 0 MAGT}
+ {828198000 43200 1 MAGST}
+ {846342000 39600 0 MAGT}
+ {859647600 43200 1 MAGST}
+ {877791600 39600 0 MAGT}
+ {891097200 43200 1 MAGST}
+ {909241200 39600 0 MAGT}
+ {922546800 43200 1 MAGST}
+ {941295600 39600 0 MAGT}
+ {953996400 43200 1 MAGST}
+ {972745200 39600 0 MAGT}
+ {985446000 43200 1 MAGST}
+ {1004194800 39600 0 MAGT}
+ {1017500400 43200 1 MAGST}
+ {1035644400 39600 0 MAGT}
+ {1048950000 43200 1 MAGST}
+ {1067094000 39600 0 MAGT}
+ {1080399600 43200 1 MAGST}
+ {1099148400 39600 0 MAGT}
+ {1111849200 43200 1 MAGST}
+ {1130598000 39600 0 MAGT}
+ {1143298800 43200 1 MAGST}
+ {1162047600 39600 0 MAGT}
+ {1174748400 43200 1 MAGST}
+ {1193497200 39600 0 MAGT}
+ {1206802800 43200 1 MAGST}
+ {1224946800 39600 0 MAGT}
+ {1238252400 43200 1 MAGST}
+ {1256396400 39600 0 MAGT}
+ {1269702000 43200 1 MAGST}
+ {1288450800 39600 0 MAGT}
+ {1301151600 43200 0 MAGT}
}
diff --git a/library/tzdata/Asia/Makassar b/library/tzdata/Asia/Makassar
index 1c81328..be947f3 100644
--- a/library/tzdata/Asia/Makassar
+++ b/library/tzdata/Asia/Makassar
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Makassar) {
{-9223372036854775808 28656 0 LMT}
{-1577951856 28656 0 MMT}
- {-1172908656 28800 0 CIT}
+ {-1172908656 28800 0 WITA}
{-880272000 32400 0 JST}
- {-770634000 28800 0 CIT}
+ {-766054800 28800 0 WITA}
}
diff --git a/library/tzdata/Asia/Manila b/library/tzdata/Asia/Manila
index 12f9ac5..9cc25e8 100644
--- a/library/tzdata/Asia/Manila
+++ b/library/tzdata/Asia/Manila
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Manila) {
{-9223372036854775808 -57360 0 LMT}
diff --git a/library/tzdata/Asia/Muscat b/library/tzdata/Asia/Muscat
index cecd83c..a69b880 100644
--- a/library/tzdata/Asia/Muscat
+++ b/library/tzdata/Asia/Muscat
@@ -1,6 +1,6 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Muscat) {
- {-9223372036854775808 14060 0 LMT}
- {-1577937260 14400 0 GST}
+ {-9223372036854775808 14064 0 LMT}
+ {-1577937264 14400 0 GST}
}
diff --git a/library/tzdata/Asia/Nicosia b/library/tzdata/Asia/Nicosia
index 33374a3..73a7b4c 100644
--- a/library/tzdata/Asia/Nicosia
+++ b/library/tzdata/Asia/Nicosia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Nicosia) {
{-9223372036854775808 8008 0 LMT}
diff --git a/library/tzdata/Asia/Novokuznetsk b/library/tzdata/Asia/Novokuznetsk
new file mode 100644
index 0000000..9cd45c0
--- /dev/null
+++ b/library/tzdata/Asia/Novokuznetsk
@@ -0,0 +1,71 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Novokuznetsk) {
+ {-9223372036854775808 20928 0 NMT}
+ {-1577512128 21600 0 KRAT}
+ {-1247551200 25200 0 KRAMMTT}
+ {354906000 28800 1 KRAST}
+ {370713600 25200 0 KRAT}
+ {386442000 28800 1 KRAST}
+ {402249600 25200 0 KRAT}
+ {417978000 28800 1 KRAST}
+ {433785600 25200 0 KRAT}
+ {449600400 28800 1 KRAST}
+ {465332400 25200 0 KRAT}
+ {481057200 28800 1 KRAST}
+ {496782000 25200 0 KRAT}
+ {512506800 28800 1 KRAST}
+ {528231600 25200 0 KRAT}
+ {543956400 28800 1 KRAST}
+ {559681200 25200 0 KRAT}
+ {575406000 28800 1 KRAST}
+ {591130800 25200 0 KRAT}
+ {606855600 28800 1 KRAST}
+ {622580400 25200 0 KRAT}
+ {638305200 28800 1 KRAST}
+ {654634800 25200 0 KRAT}
+ {670359600 21600 0 KRAMMTT}
+ {670363200 25200 1 KRAST}
+ {686088000 21600 0 KRAT}
+ {695764800 25200 0 KRAMMTT}
+ {701798400 28800 1 KRAST}
+ {717519600 25200 0 KRAT}
+ {733258800 28800 1 KRAST}
+ {748983600 25200 0 KRAT}
+ {764708400 28800 1 KRAST}
+ {780433200 25200 0 KRAT}
+ {796158000 28800 1 KRAST}
+ {811882800 25200 0 KRAT}
+ {828212400 28800 1 KRAST}
+ {846356400 25200 0 KRAT}
+ {859662000 28800 1 KRAST}
+ {877806000 25200 0 KRAT}
+ {891111600 28800 1 KRAST}
+ {909255600 25200 0 KRAT}
+ {922561200 28800 1 KRAST}
+ {941310000 25200 0 KRAT}
+ {954010800 28800 1 KRAST}
+ {972759600 25200 0 KRAT}
+ {985460400 28800 1 KRAST}
+ {1004209200 25200 0 KRAT}
+ {1017514800 28800 1 KRAST}
+ {1035658800 25200 0 KRAT}
+ {1048964400 28800 1 KRAST}
+ {1067108400 25200 0 KRAT}
+ {1080414000 28800 1 KRAST}
+ {1099162800 25200 0 KRAT}
+ {1111863600 28800 1 KRAST}
+ {1130612400 25200 0 KRAT}
+ {1143313200 28800 1 KRAST}
+ {1162062000 25200 0 KRAT}
+ {1174762800 28800 1 KRAST}
+ {1193511600 25200 0 KRAT}
+ {1206817200 28800 1 KRAST}
+ {1224961200 25200 0 KRAT}
+ {1238266800 28800 1 KRAST}
+ {1256410800 25200 0 KRAT}
+ {1269716400 21600 0 NOVMMTT}
+ {1269720000 25200 1 NOVST}
+ {1288468800 21600 0 NOVT}
+ {1301169600 25200 0 NOVT}
+}
diff --git a/library/tzdata/Asia/Novosibirsk b/library/tzdata/Asia/Novosibirsk
index 3a92d89..5032eec 100644
--- a/library/tzdata/Asia/Novosibirsk
+++ b/library/tzdata/Asia/Novosibirsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Novosibirsk) {
{-9223372036854775808 19900 0 LMT}
@@ -11,237 +11,61 @@ set TZData(:Asia/Novosibirsk) {
{417978000 28800 1 NOVST}
{433785600 25200 0 NOVT}
{449600400 28800 1 NOVST}
- {465357600 25200 0 NOVT}
- {481082400 28800 1 NOVST}
- {496807200 25200 0 NOVT}
- {512532000 28800 1 NOVST}
- {528256800 25200 0 NOVT}
- {543981600 28800 1 NOVST}
- {559706400 25200 0 NOVT}
- {575431200 28800 1 NOVST}
- {591156000 25200 0 NOVT}
- {606880800 28800 1 NOVST}
- {622605600 25200 0 NOVT}
- {638330400 28800 1 NOVST}
- {654660000 25200 0 NOVT}
- {670384800 25200 0 NOVST}
- {686109600 21600 0 NOVT}
- {695786400 25200 0 NOVMMTT}
+ {465332400 25200 0 NOVT}
+ {481057200 28800 1 NOVST}
+ {496782000 25200 0 NOVT}
+ {512506800 28800 1 NOVST}
+ {528231600 25200 0 NOVT}
+ {543956400 28800 1 NOVST}
+ {559681200 25200 0 NOVT}
+ {575406000 28800 1 NOVST}
+ {591130800 25200 0 NOVT}
+ {606855600 28800 1 NOVST}
+ {622580400 25200 0 NOVT}
+ {638305200 28800 1 NOVST}
+ {654634800 25200 0 NOVT}
+ {670359600 21600 0 NOVMMTT}
+ {670363200 25200 1 NOVST}
+ {686088000 21600 0 NOVT}
+ {695764800 25200 0 NOVMMTT}
{701798400 28800 1 NOVST}
{717519600 25200 0 NOVT}
- {733284000 28800 1 NOVST}
+ {733258800 28800 1 NOVST}
{738090000 25200 0 NOVST}
- {749008800 21600 0 NOVT}
- {764733600 25200 1 NOVST}
- {780458400 21600 0 NOVT}
- {796183200 25200 1 NOVST}
- {811908000 21600 0 NOVT}
- {828237600 25200 1 NOVST}
- {846381600 21600 0 NOVT}
- {859687200 25200 1 NOVST}
- {877831200 21600 0 NOVT}
- {891136800 25200 1 NOVST}
- {909280800 21600 0 NOVT}
- {922586400 25200 1 NOVST}
- {941335200 21600 0 NOVT}
- {954036000 25200 1 NOVST}
- {972784800 21600 0 NOVT}
- {985485600 25200 1 NOVST}
- {1004234400 21600 0 NOVT}
- {1017540000 25200 1 NOVST}
- {1035684000 21600 0 NOVT}
- {1048989600 25200 1 NOVST}
- {1067133600 21600 0 NOVT}
- {1080439200 25200 1 NOVST}
- {1099188000 21600 0 NOVT}
- {1111888800 25200 1 NOVST}
- {1130637600 21600 0 NOVT}
- {1143338400 25200 1 NOVST}
- {1162087200 21600 0 NOVT}
- {1174788000 25200 1 NOVST}
- {1193536800 21600 0 NOVT}
- {1206842400 25200 1 NOVST}
- {1224986400 21600 0 NOVT}
- {1238292000 25200 1 NOVST}
- {1256436000 21600 0 NOVT}
- {1269741600 25200 1 NOVST}
- {1288490400 21600 0 NOVT}
- {1301191200 25200 1 NOVST}
- {1319940000 21600 0 NOVT}
- {1332640800 25200 1 NOVST}
- {1351389600 21600 0 NOVT}
- {1364695200 25200 1 NOVST}
- {1382839200 21600 0 NOVT}
- {1396144800 25200 1 NOVST}
- {1414288800 21600 0 NOVT}
- {1427594400 25200 1 NOVST}
- {1445738400 21600 0 NOVT}
- {1459044000 25200 1 NOVST}
- {1477792800 21600 0 NOVT}
- {1490493600 25200 1 NOVST}
- {1509242400 21600 0 NOVT}
- {1521943200 25200 1 NOVST}
- {1540692000 21600 0 NOVT}
- {1553997600 25200 1 NOVST}
- {1572141600 21600 0 NOVT}
- {1585447200 25200 1 NOVST}
- {1603591200 21600 0 NOVT}
- {1616896800 25200 1 NOVST}
- {1635645600 21600 0 NOVT}
- {1648346400 25200 1 NOVST}
- {1667095200 21600 0 NOVT}
- {1679796000 25200 1 NOVST}
- {1698544800 21600 0 NOVT}
- {1711850400 25200 1 NOVST}
- {1729994400 21600 0 NOVT}
- {1743300000 25200 1 NOVST}
- {1761444000 21600 0 NOVT}
- {1774749600 25200 1 NOVST}
- {1792893600 21600 0 NOVT}
- {1806199200 25200 1 NOVST}
- {1824948000 21600 0 NOVT}
- {1837648800 25200 1 NOVST}
- {1856397600 21600 0 NOVT}
- {1869098400 25200 1 NOVST}
- {1887847200 21600 0 NOVT}
- {1901152800 25200 1 NOVST}
- {1919296800 21600 0 NOVT}
- {1932602400 25200 1 NOVST}
- {1950746400 21600 0 NOVT}
- {1964052000 25200 1 NOVST}
- {1982800800 21600 0 NOVT}
- {1995501600 25200 1 NOVST}
- {2014250400 21600 0 NOVT}
- {2026951200 25200 1 NOVST}
- {2045700000 21600 0 NOVT}
- {2058400800 25200 1 NOVST}
- {2077149600 21600 0 NOVT}
- {2090455200 25200 1 NOVST}
- {2108599200 21600 0 NOVT}
- {2121904800 25200 1 NOVST}
- {2140048800 21600 0 NOVT}
- {2153354400 25200 1 NOVST}
- {2172103200 21600 0 NOVT}
- {2184804000 25200 1 NOVST}
- {2203552800 21600 0 NOVT}
- {2216253600 25200 1 NOVST}
- {2235002400 21600 0 NOVT}
- {2248308000 25200 1 NOVST}
- {2266452000 21600 0 NOVT}
- {2279757600 25200 1 NOVST}
- {2297901600 21600 0 NOVT}
- {2311207200 25200 1 NOVST}
- {2329351200 21600 0 NOVT}
- {2342656800 25200 1 NOVST}
- {2361405600 21600 0 NOVT}
- {2374106400 25200 1 NOVST}
- {2392855200 21600 0 NOVT}
- {2405556000 25200 1 NOVST}
- {2424304800 21600 0 NOVT}
- {2437610400 25200 1 NOVST}
- {2455754400 21600 0 NOVT}
- {2469060000 25200 1 NOVST}
- {2487204000 21600 0 NOVT}
- {2500509600 25200 1 NOVST}
- {2519258400 21600 0 NOVT}
- {2531959200 25200 1 NOVST}
- {2550708000 21600 0 NOVT}
- {2563408800 25200 1 NOVST}
- {2582157600 21600 0 NOVT}
- {2595463200 25200 1 NOVST}
- {2613607200 21600 0 NOVT}
- {2626912800 25200 1 NOVST}
- {2645056800 21600 0 NOVT}
- {2658362400 25200 1 NOVST}
- {2676506400 21600 0 NOVT}
- {2689812000 25200 1 NOVST}
- {2708560800 21600 0 NOVT}
- {2721261600 25200 1 NOVST}
- {2740010400 21600 0 NOVT}
- {2752711200 25200 1 NOVST}
- {2771460000 21600 0 NOVT}
- {2784765600 25200 1 NOVST}
- {2802909600 21600 0 NOVT}
- {2816215200 25200 1 NOVST}
- {2834359200 21600 0 NOVT}
- {2847664800 25200 1 NOVST}
- {2866413600 21600 0 NOVT}
- {2879114400 25200 1 NOVST}
- {2897863200 21600 0 NOVT}
- {2910564000 25200 1 NOVST}
- {2929312800 21600 0 NOVT}
- {2942013600 25200 1 NOVST}
- {2960762400 21600 0 NOVT}
- {2974068000 25200 1 NOVST}
- {2992212000 21600 0 NOVT}
- {3005517600 25200 1 NOVST}
- {3023661600 21600 0 NOVT}
- {3036967200 25200 1 NOVST}
- {3055716000 21600 0 NOVT}
- {3068416800 25200 1 NOVST}
- {3087165600 21600 0 NOVT}
- {3099866400 25200 1 NOVST}
- {3118615200 21600 0 NOVT}
- {3131920800 25200 1 NOVST}
- {3150064800 21600 0 NOVT}
- {3163370400 25200 1 NOVST}
- {3181514400 21600 0 NOVT}
- {3194820000 25200 1 NOVST}
- {3212964000 21600 0 NOVT}
- {3226269600 25200 1 NOVST}
- {3245018400 21600 0 NOVT}
- {3257719200 25200 1 NOVST}
- {3276468000 21600 0 NOVT}
- {3289168800 25200 1 NOVST}
- {3307917600 21600 0 NOVT}
- {3321223200 25200 1 NOVST}
- {3339367200 21600 0 NOVT}
- {3352672800 25200 1 NOVST}
- {3370816800 21600 0 NOVT}
- {3384122400 25200 1 NOVST}
- {3402871200 21600 0 NOVT}
- {3415572000 25200 1 NOVST}
- {3434320800 21600 0 NOVT}
- {3447021600 25200 1 NOVST}
- {3465770400 21600 0 NOVT}
- {3479076000 25200 1 NOVST}
- {3497220000 21600 0 NOVT}
- {3510525600 25200 1 NOVST}
- {3528669600 21600 0 NOVT}
- {3541975200 25200 1 NOVST}
- {3560119200 21600 0 NOVT}
- {3573424800 25200 1 NOVST}
- {3592173600 21600 0 NOVT}
- {3604874400 25200 1 NOVST}
- {3623623200 21600 0 NOVT}
- {3636324000 25200 1 NOVST}
- {3655072800 21600 0 NOVT}
- {3668378400 25200 1 NOVST}
- {3686522400 21600 0 NOVT}
- {3699828000 25200 1 NOVST}
- {3717972000 21600 0 NOVT}
- {3731277600 25200 1 NOVST}
- {3750026400 21600 0 NOVT}
- {3762727200 25200 1 NOVST}
- {3781476000 21600 0 NOVT}
- {3794176800 25200 1 NOVST}
- {3812925600 21600 0 NOVT}
- {3825626400 25200 1 NOVST}
- {3844375200 21600 0 NOVT}
- {3857680800 25200 1 NOVST}
- {3875824800 21600 0 NOVT}
- {3889130400 25200 1 NOVST}
- {3907274400 21600 0 NOVT}
- {3920580000 25200 1 NOVST}
- {3939328800 21600 0 NOVT}
- {3952029600 25200 1 NOVST}
- {3970778400 21600 0 NOVT}
- {3983479200 25200 1 NOVST}
- {4002228000 21600 0 NOVT}
- {4015533600 25200 1 NOVST}
- {4033677600 21600 0 NOVT}
- {4046983200 25200 1 NOVST}
- {4065127200 21600 0 NOVT}
- {4078432800 25200 1 NOVST}
- {4096576800 21600 0 NOVT}
+ {748987200 21600 0 NOVT}
+ {764712000 25200 1 NOVST}
+ {780436800 21600 0 NOVT}
+ {796161600 25200 1 NOVST}
+ {811886400 21600 0 NOVT}
+ {828216000 25200 1 NOVST}
+ {846360000 21600 0 NOVT}
+ {859665600 25200 1 NOVST}
+ {877809600 21600 0 NOVT}
+ {891115200 25200 1 NOVST}
+ {909259200 21600 0 NOVT}
+ {922564800 25200 1 NOVST}
+ {941313600 21600 0 NOVT}
+ {954014400 25200 1 NOVST}
+ {972763200 21600 0 NOVT}
+ {985464000 25200 1 NOVST}
+ {1004212800 21600 0 NOVT}
+ {1017518400 25200 1 NOVST}
+ {1035662400 21600 0 NOVT}
+ {1048968000 25200 1 NOVST}
+ {1067112000 21600 0 NOVT}
+ {1080417600 25200 1 NOVST}
+ {1099166400 21600 0 NOVT}
+ {1111867200 25200 1 NOVST}
+ {1130616000 21600 0 NOVT}
+ {1143316800 25200 1 NOVST}
+ {1162065600 21600 0 NOVT}
+ {1174766400 25200 1 NOVST}
+ {1193515200 21600 0 NOVT}
+ {1206820800 25200 1 NOVST}
+ {1224964800 21600 0 NOVT}
+ {1238270400 25200 1 NOVST}
+ {1256414400 21600 0 NOVT}
+ {1269720000 25200 1 NOVST}
+ {1288468800 21600 0 NOVT}
+ {1301169600 25200 0 NOVT}
}
diff --git a/library/tzdata/Asia/Omsk b/library/tzdata/Asia/Omsk
index 0b7b567..ca90d2e 100644
--- a/library/tzdata/Asia/Omsk
+++ b/library/tzdata/Asia/Omsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Omsk) {
{-9223372036854775808 17616 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Omsk) {
{417981600 25200 1 OMSST}
{433789200 21600 0 OMST}
{449604000 25200 1 OMSST}
- {465357600 21600 0 OMST}
- {481082400 25200 1 OMSST}
- {496807200 21600 0 OMST}
- {512532000 25200 1 OMSST}
- {528256800 21600 0 OMST}
- {543981600 25200 1 OMSST}
- {559706400 21600 0 OMST}
- {575431200 25200 1 OMSST}
- {591156000 21600 0 OMST}
- {606880800 25200 1 OMSST}
- {622605600 21600 0 OMST}
- {638330400 25200 1 OMSST}
- {654660000 21600 0 OMST}
- {670384800 21600 0 OMSST}
- {686109600 18000 0 OMST}
- {695786400 21600 0 OMSMMTT}
+ {465336000 21600 0 OMST}
+ {481060800 25200 1 OMSST}
+ {496785600 21600 0 OMST}
+ {512510400 25200 1 OMSST}
+ {528235200 21600 0 OMST}
+ {543960000 25200 1 OMSST}
+ {559684800 21600 0 OMST}
+ {575409600 25200 1 OMSST}
+ {591134400 21600 0 OMST}
+ {606859200 25200 1 OMSST}
+ {622584000 21600 0 OMST}
+ {638308800 25200 1 OMSST}
+ {654638400 21600 0 OMST}
+ {670363200 18000 0 OMSMMTT}
+ {670366800 21600 1 OMSST}
+ {686091600 18000 0 OMST}
+ {695768400 21600 0 OMSMMTT}
{701802000 25200 1 OMSST}
{717523200 21600 0 OMST}
- {733284000 25200 1 OMSST}
- {749008800 21600 0 OMST}
- {764733600 25200 1 OMSST}
- {780458400 21600 0 OMST}
- {796183200 25200 1 OMSST}
- {811908000 21600 0 OMST}
- {828237600 25200 1 OMSST}
- {846381600 21600 0 OMST}
- {859687200 25200 1 OMSST}
- {877831200 21600 0 OMST}
- {891136800 25200 1 OMSST}
- {909280800 21600 0 OMST}
- {922586400 25200 1 OMSST}
- {941335200 21600 0 OMST}
- {954036000 25200 1 OMSST}
- {972784800 21600 0 OMST}
- {985485600 25200 1 OMSST}
- {1004234400 21600 0 OMST}
- {1017540000 25200 1 OMSST}
- {1035684000 21600 0 OMST}
- {1048989600 25200 1 OMSST}
- {1067133600 21600 0 OMST}
- {1080439200 25200 1 OMSST}
- {1099188000 21600 0 OMST}
- {1111888800 25200 1 OMSST}
- {1130637600 21600 0 OMST}
- {1143338400 25200 1 OMSST}
- {1162087200 21600 0 OMST}
- {1174788000 25200 1 OMSST}
- {1193536800 21600 0 OMST}
- {1206842400 25200 1 OMSST}
- {1224986400 21600 0 OMST}
- {1238292000 25200 1 OMSST}
- {1256436000 21600 0 OMST}
- {1269741600 25200 1 OMSST}
- {1288490400 21600 0 OMST}
- {1301191200 25200 1 OMSST}
- {1319940000 21600 0 OMST}
- {1332640800 25200 1 OMSST}
- {1351389600 21600 0 OMST}
- {1364695200 25200 1 OMSST}
- {1382839200 21600 0 OMST}
- {1396144800 25200 1 OMSST}
- {1414288800 21600 0 OMST}
- {1427594400 25200 1 OMSST}
- {1445738400 21600 0 OMST}
- {1459044000 25200 1 OMSST}
- {1477792800 21600 0 OMST}
- {1490493600 25200 1 OMSST}
- {1509242400 21600 0 OMST}
- {1521943200 25200 1 OMSST}
- {1540692000 21600 0 OMST}
- {1553997600 25200 1 OMSST}
- {1572141600 21600 0 OMST}
- {1585447200 25200 1 OMSST}
- {1603591200 21600 0 OMST}
- {1616896800 25200 1 OMSST}
- {1635645600 21600 0 OMST}
- {1648346400 25200 1 OMSST}
- {1667095200 21600 0 OMST}
- {1679796000 25200 1 OMSST}
- {1698544800 21600 0 OMST}
- {1711850400 25200 1 OMSST}
- {1729994400 21600 0 OMST}
- {1743300000 25200 1 OMSST}
- {1761444000 21600 0 OMST}
- {1774749600 25200 1 OMSST}
- {1792893600 21600 0 OMST}
- {1806199200 25200 1 OMSST}
- {1824948000 21600 0 OMST}
- {1837648800 25200 1 OMSST}
- {1856397600 21600 0 OMST}
- {1869098400 25200 1 OMSST}
- {1887847200 21600 0 OMST}
- {1901152800 25200 1 OMSST}
- {1919296800 21600 0 OMST}
- {1932602400 25200 1 OMSST}
- {1950746400 21600 0 OMST}
- {1964052000 25200 1 OMSST}
- {1982800800 21600 0 OMST}
- {1995501600 25200 1 OMSST}
- {2014250400 21600 0 OMST}
- {2026951200 25200 1 OMSST}
- {2045700000 21600 0 OMST}
- {2058400800 25200 1 OMSST}
- {2077149600 21600 0 OMST}
- {2090455200 25200 1 OMSST}
- {2108599200 21600 0 OMST}
- {2121904800 25200 1 OMSST}
- {2140048800 21600 0 OMST}
- {2153354400 25200 1 OMSST}
- {2172103200 21600 0 OMST}
- {2184804000 25200 1 OMSST}
- {2203552800 21600 0 OMST}
- {2216253600 25200 1 OMSST}
- {2235002400 21600 0 OMST}
- {2248308000 25200 1 OMSST}
- {2266452000 21600 0 OMST}
- {2279757600 25200 1 OMSST}
- {2297901600 21600 0 OMST}
- {2311207200 25200 1 OMSST}
- {2329351200 21600 0 OMST}
- {2342656800 25200 1 OMSST}
- {2361405600 21600 0 OMST}
- {2374106400 25200 1 OMSST}
- {2392855200 21600 0 OMST}
- {2405556000 25200 1 OMSST}
- {2424304800 21600 0 OMST}
- {2437610400 25200 1 OMSST}
- {2455754400 21600 0 OMST}
- {2469060000 25200 1 OMSST}
- {2487204000 21600 0 OMST}
- {2500509600 25200 1 OMSST}
- {2519258400 21600 0 OMST}
- {2531959200 25200 1 OMSST}
- {2550708000 21600 0 OMST}
- {2563408800 25200 1 OMSST}
- {2582157600 21600 0 OMST}
- {2595463200 25200 1 OMSST}
- {2613607200 21600 0 OMST}
- {2626912800 25200 1 OMSST}
- {2645056800 21600 0 OMST}
- {2658362400 25200 1 OMSST}
- {2676506400 21600 0 OMST}
- {2689812000 25200 1 OMSST}
- {2708560800 21600 0 OMST}
- {2721261600 25200 1 OMSST}
- {2740010400 21600 0 OMST}
- {2752711200 25200 1 OMSST}
- {2771460000 21600 0 OMST}
- {2784765600 25200 1 OMSST}
- {2802909600 21600 0 OMST}
- {2816215200 25200 1 OMSST}
- {2834359200 21600 0 OMST}
- {2847664800 25200 1 OMSST}
- {2866413600 21600 0 OMST}
- {2879114400 25200 1 OMSST}
- {2897863200 21600 0 OMST}
- {2910564000 25200 1 OMSST}
- {2929312800 21600 0 OMST}
- {2942013600 25200 1 OMSST}
- {2960762400 21600 0 OMST}
- {2974068000 25200 1 OMSST}
- {2992212000 21600 0 OMST}
- {3005517600 25200 1 OMSST}
- {3023661600 21600 0 OMST}
- {3036967200 25200 1 OMSST}
- {3055716000 21600 0 OMST}
- {3068416800 25200 1 OMSST}
- {3087165600 21600 0 OMST}
- {3099866400 25200 1 OMSST}
- {3118615200 21600 0 OMST}
- {3131920800 25200 1 OMSST}
- {3150064800 21600 0 OMST}
- {3163370400 25200 1 OMSST}
- {3181514400 21600 0 OMST}
- {3194820000 25200 1 OMSST}
- {3212964000 21600 0 OMST}
- {3226269600 25200 1 OMSST}
- {3245018400 21600 0 OMST}
- {3257719200 25200 1 OMSST}
- {3276468000 21600 0 OMST}
- {3289168800 25200 1 OMSST}
- {3307917600 21600 0 OMST}
- {3321223200 25200 1 OMSST}
- {3339367200 21600 0 OMST}
- {3352672800 25200 1 OMSST}
- {3370816800 21600 0 OMST}
- {3384122400 25200 1 OMSST}
- {3402871200 21600 0 OMST}
- {3415572000 25200 1 OMSST}
- {3434320800 21600 0 OMST}
- {3447021600 25200 1 OMSST}
- {3465770400 21600 0 OMST}
- {3479076000 25200 1 OMSST}
- {3497220000 21600 0 OMST}
- {3510525600 25200 1 OMSST}
- {3528669600 21600 0 OMST}
- {3541975200 25200 1 OMSST}
- {3560119200 21600 0 OMST}
- {3573424800 25200 1 OMSST}
- {3592173600 21600 0 OMST}
- {3604874400 25200 1 OMSST}
- {3623623200 21600 0 OMST}
- {3636324000 25200 1 OMSST}
- {3655072800 21600 0 OMST}
- {3668378400 25200 1 OMSST}
- {3686522400 21600 0 OMST}
- {3699828000 25200 1 OMSST}
- {3717972000 21600 0 OMST}
- {3731277600 25200 1 OMSST}
- {3750026400 21600 0 OMST}
- {3762727200 25200 1 OMSST}
- {3781476000 21600 0 OMST}
- {3794176800 25200 1 OMSST}
- {3812925600 21600 0 OMST}
- {3825626400 25200 1 OMSST}
- {3844375200 21600 0 OMST}
- {3857680800 25200 1 OMSST}
- {3875824800 21600 0 OMST}
- {3889130400 25200 1 OMSST}
- {3907274400 21600 0 OMST}
- {3920580000 25200 1 OMSST}
- {3939328800 21600 0 OMST}
- {3952029600 25200 1 OMSST}
- {3970778400 21600 0 OMST}
- {3983479200 25200 1 OMSST}
- {4002228000 21600 0 OMST}
- {4015533600 25200 1 OMSST}
- {4033677600 21600 0 OMST}
- {4046983200 25200 1 OMSST}
- {4065127200 21600 0 OMST}
- {4078432800 25200 1 OMSST}
- {4096576800 21600 0 OMST}
+ {733262400 25200 1 OMSST}
+ {748987200 21600 0 OMST}
+ {764712000 25200 1 OMSST}
+ {780436800 21600 0 OMST}
+ {796161600 25200 1 OMSST}
+ {811886400 21600 0 OMST}
+ {828216000 25200 1 OMSST}
+ {846360000 21600 0 OMST}
+ {859665600 25200 1 OMSST}
+ {877809600 21600 0 OMST}
+ {891115200 25200 1 OMSST}
+ {909259200 21600 0 OMST}
+ {922564800 25200 1 OMSST}
+ {941313600 21600 0 OMST}
+ {954014400 25200 1 OMSST}
+ {972763200 21600 0 OMST}
+ {985464000 25200 1 OMSST}
+ {1004212800 21600 0 OMST}
+ {1017518400 25200 1 OMSST}
+ {1035662400 21600 0 OMST}
+ {1048968000 25200 1 OMSST}
+ {1067112000 21600 0 OMST}
+ {1080417600 25200 1 OMSST}
+ {1099166400 21600 0 OMST}
+ {1111867200 25200 1 OMSST}
+ {1130616000 21600 0 OMST}
+ {1143316800 25200 1 OMSST}
+ {1162065600 21600 0 OMST}
+ {1174766400 25200 1 OMSST}
+ {1193515200 21600 0 OMST}
+ {1206820800 25200 1 OMSST}
+ {1224964800 21600 0 OMST}
+ {1238270400 25200 1 OMSST}
+ {1256414400 21600 0 OMST}
+ {1269720000 25200 1 OMSST}
+ {1288468800 21600 0 OMST}
+ {1301169600 25200 0 OMST}
}
diff --git a/library/tzdata/Asia/Oral b/library/tzdata/Asia/Oral
index bcdcd44..88b9a29 100644
--- a/library/tzdata/Asia/Oral
+++ b/library/tzdata/Asia/Oral
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Oral) {
{-9223372036854775808 12324 0 LMT}
@@ -12,47 +12,47 @@ set TZData(:Asia/Oral) {
{417985200 21600 1 URAST}
{433792800 18000 0 URAT}
{449607600 21600 1 URAST}
- {465357600 18000 0 URAT}
- {481082400 21600 1 URAST}
- {496807200 18000 0 URAT}
- {512532000 21600 1 URAST}
- {528256800 18000 0 URAT}
- {543981600 21600 1 URAST}
- {559706400 18000 0 URAT}
- {575431200 21600 1 URAST}
- {591156000 18000 0 URAT}
+ {465339600 18000 0 URAT}
+ {481064400 21600 1 URAST}
+ {496789200 18000 0 URAT}
+ {512514000 21600 1 URAST}
+ {528238800 18000 0 URAT}
+ {543963600 21600 1 URAST}
+ {559688400 18000 0 URAT}
+ {575413200 21600 1 URAST}
+ {591138000 18000 0 URAT}
{606862800 14400 0 URAT}
- {606880800 18000 1 URAST}
- {622605600 14400 0 URAT}
- {638330400 18000 1 URAST}
- {654660000 14400 0 URAT}
+ {606866400 18000 1 URAST}
+ {622591200 14400 0 URAT}
+ {638316000 18000 1 URAST}
+ {654645600 14400 0 URAT}
{662673600 14400 0 URAT}
{692827200 14400 0 ORAT}
{701809200 18000 1 ORAST}
{717530400 14400 0 ORAT}
- {733284000 18000 1 ORAST}
- {749008800 14400 0 ORAT}
- {764733600 18000 1 ORAST}
- {780458400 14400 0 ORAT}
- {796183200 18000 1 ORAST}
- {811908000 14400 0 ORAT}
- {828237600 18000 1 ORAST}
- {846381600 14400 0 ORAT}
- {859687200 18000 1 ORAST}
- {877831200 14400 0 ORAT}
- {891136800 18000 1 ORAST}
- {909280800 14400 0 ORAT}
- {922586400 18000 1 ORAST}
- {941335200 14400 0 ORAT}
- {954036000 18000 1 ORAST}
- {972784800 14400 0 ORAT}
- {985485600 18000 1 ORAST}
- {1004234400 14400 0 ORAT}
- {1017540000 18000 1 ORAST}
- {1035684000 14400 0 ORAT}
- {1048989600 18000 1 ORAST}
- {1067133600 14400 0 ORAT}
- {1080439200 18000 1 ORAST}
- {1099188000 14400 0 ORAT}
- {1110830400 14400 0 ORAT}
+ {733269600 18000 1 ORAST}
+ {748994400 14400 0 ORAT}
+ {764719200 18000 1 ORAST}
+ {780444000 14400 0 ORAT}
+ {796168800 18000 1 ORAST}
+ {811893600 14400 0 ORAT}
+ {828223200 18000 1 ORAST}
+ {846367200 14400 0 ORAT}
+ {859672800 18000 1 ORAST}
+ {877816800 14400 0 ORAT}
+ {891122400 18000 1 ORAST}
+ {909266400 14400 0 ORAT}
+ {922572000 18000 1 ORAST}
+ {941320800 14400 0 ORAT}
+ {954021600 18000 1 ORAST}
+ {972770400 14400 0 ORAT}
+ {985471200 18000 1 ORAST}
+ {1004220000 14400 0 ORAT}
+ {1017525600 18000 1 ORAST}
+ {1035669600 14400 0 ORAT}
+ {1048975200 18000 1 ORAST}
+ {1067119200 14400 0 ORAT}
+ {1080424800 18000 1 ORAST}
+ {1099173600 14400 0 ORAT}
+ {1110830400 18000 0 ORAT}
}
diff --git a/library/tzdata/Asia/Phnom_Penh b/library/tzdata/Asia/Phnom_Penh
index ec8dcbb..4f28420 100644
--- a/library/tzdata/Asia/Phnom_Penh
+++ b/library/tzdata/Asia/Phnom_Penh
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Phnom_Penh) {
{-9223372036854775808 25180 0 LMT}
diff --git a/library/tzdata/Asia/Pontianak b/library/tzdata/Asia/Pontianak
index f6bfdc1..728b552 100644
--- a/library/tzdata/Asia/Pontianak
+++ b/library/tzdata/Asia/Pontianak
@@ -1,13 +1,13 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Pontianak) {
{-9223372036854775808 26240 0 LMT}
{-1946186240 26240 0 PMT}
- {-1172906240 27000 0 WIT}
+ {-1172906240 27000 0 WIB}
{-881220600 32400 0 JST}
- {-770634000 27000 0 WIT}
- {-683883000 28800 0 WIT}
- {-620812800 27000 0 WIT}
- {-189415800 28800 0 CIT}
- {567964800 25200 0 WIT}
+ {-766054800 27000 0 WIB}
+ {-683883000 28800 0 WIB}
+ {-620812800 27000 0 WIB}
+ {-189415800 28800 0 WITA}
+ {567964800 25200 0 WIB}
}
diff --git a/library/tzdata/Asia/Pyongyang b/library/tzdata/Asia/Pyongyang
index 63643f9..21c9a68 100644
--- a/library/tzdata/Asia/Pyongyang
+++ b/library/tzdata/Asia/Pyongyang
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Pyongyang) {
{-9223372036854775808 30180 0 LMT}
diff --git a/library/tzdata/Asia/Qatar b/library/tzdata/Asia/Qatar
index c7a9786..bfb4eb4 100644
--- a/library/tzdata/Asia/Qatar
+++ b/library/tzdata/Asia/Qatar
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Qatar) {
{-9223372036854775808 12368 0 LMT}
diff --git a/library/tzdata/Asia/Qyzylorda b/library/tzdata/Asia/Qyzylorda
index 271495e..16da574 100644
--- a/library/tzdata/Asia/Qyzylorda
+++ b/library/tzdata/Asia/Qyzylorda
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Qyzylorda) {
{-9223372036854775808 15712 0 LMT}
@@ -12,47 +12,47 @@ set TZData(:Asia/Qyzylorda) {
{417985200 21600 1 KIZST}
{433792800 18000 0 KIZT}
{449607600 21600 1 KIZST}
- {465357600 18000 0 KIZT}
- {481082400 21600 1 KIZST}
- {496807200 18000 0 KIZT}
- {512532000 21600 1 KIZST}
- {528256800 18000 0 KIZT}
- {543981600 21600 1 KIZST}
- {559706400 18000 0 KIZT}
- {575431200 21600 1 KIZST}
- {591156000 18000 0 KIZT}
- {606880800 21600 1 KIZST}
- {622605600 18000 0 KIZT}
- {638330400 21600 1 KIZST}
- {654660000 18000 0 KIZT}
+ {465339600 18000 0 KIZT}
+ {481064400 21600 1 KIZST}
+ {496789200 18000 0 KIZT}
+ {512514000 21600 1 KIZST}
+ {528238800 18000 0 KIZT}
+ {543963600 21600 1 KIZST}
+ {559688400 18000 0 KIZT}
+ {575413200 21600 1 KIZST}
+ {591138000 18000 0 KIZT}
+ {606862800 21600 1 KIZST}
+ {622587600 18000 0 KIZT}
+ {638312400 21600 1 KIZST}
+ {654642000 18000 0 KIZT}
{662670000 18000 0 KIZT}
{692823600 18000 0 QYZT}
{695768400 21600 0 QYZT}
{701802000 25200 1 QYZST}
{717523200 21600 0 QYZT}
- {733284000 25200 1 QYZST}
- {749008800 21600 0 QYZT}
- {764733600 25200 1 QYZST}
- {780458400 21600 0 QYZT}
- {796183200 25200 1 QYZST}
- {811908000 21600 0 QYZT}
- {828237600 25200 1 QYZST}
- {846381600 21600 0 QYZT}
- {859687200 25200 1 QYZST}
- {877831200 21600 0 QYZT}
- {891136800 25200 1 QYZST}
- {909280800 21600 0 QYZT}
- {922586400 25200 1 QYZST}
- {941335200 21600 0 QYZT}
- {954036000 25200 1 QYZST}
- {972784800 21600 0 QYZT}
- {985485600 25200 1 QYZST}
- {1004234400 21600 0 QYZT}
- {1017540000 25200 1 QYZST}
- {1035684000 21600 0 QYZT}
- {1048989600 25200 1 QYZST}
- {1067133600 21600 0 QYZT}
- {1080439200 25200 1 QYZST}
- {1099188000 21600 0 QYZT}
+ {733262400 25200 1 QYZST}
+ {748987200 21600 0 QYZT}
+ {764712000 25200 1 QYZST}
+ {780436800 21600 0 QYZT}
+ {796161600 25200 1 QYZST}
+ {811886400 21600 0 QYZT}
+ {828216000 25200 1 QYZST}
+ {846360000 21600 0 QYZT}
+ {859665600 25200 1 QYZST}
+ {877809600 21600 0 QYZT}
+ {891115200 25200 1 QYZST}
+ {909259200 21600 0 QYZT}
+ {922564800 25200 1 QYZST}
+ {941313600 21600 0 QYZT}
+ {954014400 25200 1 QYZST}
+ {972763200 21600 0 QYZT}
+ {985464000 25200 1 QYZST}
+ {1004212800 21600 0 QYZT}
+ {1017518400 25200 1 QYZST}
+ {1035662400 21600 0 QYZT}
+ {1048968000 25200 1 QYZST}
+ {1067112000 21600 0 QYZT}
+ {1080417600 25200 1 QYZST}
+ {1099166400 21600 0 QYZT}
{1110823200 21600 0 QYZT}
}
diff --git a/library/tzdata/Asia/Rangoon b/library/tzdata/Asia/Rangoon
index b0aced1..4f3ac02 100644
--- a/library/tzdata/Asia/Rangoon
+++ b/library/tzdata/Asia/Rangoon
@@ -1,9 +1,9 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Rangoon) {
{-9223372036854775808 23080 0 LMT}
- {-2840163880 23076 0 RMT}
- {-1577946276 23400 0 BURT}
+ {-2840163880 23080 0 RMT}
+ {-1577946280 23400 0 BURT}
{-873268200 32400 0 JST}
{-778410000 23400 0 MMT}
}
diff --git a/library/tzdata/Asia/Riyadh b/library/tzdata/Asia/Riyadh
index 295853e..0ef28a9 100644
--- a/library/tzdata/Asia/Riyadh
+++ b/library/tzdata/Asia/Riyadh
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Riyadh) {
{-9223372036854775808 11212 0 LMT}
diff --git a/library/tzdata/Asia/Saigon b/library/tzdata/Asia/Saigon
index 2278d7a..1e42eed 100644
--- a/library/tzdata/Asia/Saigon
+++ b/library/tzdata/Asia/Saigon
@@ -1,9 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Asia/Saigon) {
- {-9223372036854775808 25600 0 LMT}
- {-2005974400 25580 0 SMT}
- {-1855983920 25200 0 ICT}
- {-1819954800 28800 0 ICT}
- {-1220428800 25200 0 ICT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Asia/Ho_Chi_Minh)]} {
+ LoadTimeZoneFile Asia/Ho_Chi_Minh
}
+set TZData(:Asia/Saigon) $TZData(:Asia/Ho_Chi_Minh)
diff --git a/library/tzdata/Asia/Sakhalin b/library/tzdata/Asia/Sakhalin
index bbbcdf6..0b29e82 100644
--- a/library/tzdata/Asia/Sakhalin
+++ b/library/tzdata/Asia/Sakhalin
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Sakhalin) {
{-9223372036854775808 34248 0 LMT}
@@ -12,236 +12,61 @@ set TZData(:Asia/Sakhalin) {
{417963600 43200 1 SAKST}
{433771200 39600 0 SAKT}
{449586000 43200 1 SAKST}
- {465357600 39600 0 SAKT}
- {481082400 43200 1 SAKST}
- {496807200 39600 0 SAKT}
- {512532000 43200 1 SAKST}
- {528256800 39600 0 SAKT}
- {543981600 43200 1 SAKST}
- {559706400 39600 0 SAKT}
- {575431200 43200 1 SAKST}
- {591156000 39600 0 SAKT}
- {606880800 43200 1 SAKST}
- {622605600 39600 0 SAKT}
- {638330400 43200 1 SAKST}
- {654660000 39600 0 SAKT}
- {670384800 39600 0 SAKST}
- {686109600 36000 0 SAKT}
- {695786400 39600 0 SAKMMTT}
+ {465318000 39600 0 SAKT}
+ {481042800 43200 1 SAKST}
+ {496767600 39600 0 SAKT}
+ {512492400 43200 1 SAKST}
+ {528217200 39600 0 SAKT}
+ {543942000 43200 1 SAKST}
+ {559666800 39600 0 SAKT}
+ {575391600 43200 1 SAKST}
+ {591116400 39600 0 SAKT}
+ {606841200 43200 1 SAKST}
+ {622566000 39600 0 SAKT}
+ {638290800 43200 1 SAKST}
+ {654620400 39600 0 SAKT}
+ {670345200 36000 0 SAKMMTT}
+ {670348800 39600 1 SAKST}
+ {686073600 36000 0 SAKT}
+ {695750400 39600 0 SAKMMTT}
{701784000 43200 1 SAKST}
{717505200 39600 0 SAKT}
- {733284000 43200 1 SAKST}
- {749008800 39600 0 SAKT}
- {764733600 43200 1 SAKST}
- {780458400 39600 0 SAKT}
- {796183200 43200 1 SAKST}
- {811908000 39600 0 SAKT}
- {828237600 43200 1 SAKST}
- {846381600 39600 0 SAKT}
- {859687200 39600 0 SAKST}
- {877831200 36000 0 SAKT}
- {891136800 39600 1 SAKST}
- {909280800 36000 0 SAKT}
- {922586400 39600 1 SAKST}
- {941335200 36000 0 SAKT}
- {954036000 39600 1 SAKST}
- {972784800 36000 0 SAKT}
- {985485600 39600 1 SAKST}
- {1004234400 36000 0 SAKT}
- {1017540000 39600 1 SAKST}
- {1035684000 36000 0 SAKT}
- {1048989600 39600 1 SAKST}
- {1067133600 36000 0 SAKT}
- {1080439200 39600 1 SAKST}
- {1099188000 36000 0 SAKT}
- {1111888800 39600 1 SAKST}
- {1130637600 36000 0 SAKT}
- {1143338400 39600 1 SAKST}
- {1162087200 36000 0 SAKT}
- {1174788000 39600 1 SAKST}
- {1193536800 36000 0 SAKT}
- {1206842400 39600 1 SAKST}
- {1224986400 36000 0 SAKT}
- {1238292000 39600 1 SAKST}
- {1256436000 36000 0 SAKT}
- {1269741600 39600 1 SAKST}
- {1288490400 36000 0 SAKT}
- {1301191200 39600 1 SAKST}
- {1319940000 36000 0 SAKT}
- {1332640800 39600 1 SAKST}
- {1351389600 36000 0 SAKT}
- {1364695200 39600 1 SAKST}
- {1382839200 36000 0 SAKT}
- {1396144800 39600 1 SAKST}
- {1414288800 36000 0 SAKT}
- {1427594400 39600 1 SAKST}
- {1445738400 36000 0 SAKT}
- {1459044000 39600 1 SAKST}
- {1477792800 36000 0 SAKT}
- {1490493600 39600 1 SAKST}
- {1509242400 36000 0 SAKT}
- {1521943200 39600 1 SAKST}
- {1540692000 36000 0 SAKT}
- {1553997600 39600 1 SAKST}
- {1572141600 36000 0 SAKT}
- {1585447200 39600 1 SAKST}
- {1603591200 36000 0 SAKT}
- {1616896800 39600 1 SAKST}
- {1635645600 36000 0 SAKT}
- {1648346400 39600 1 SAKST}
- {1667095200 36000 0 SAKT}
- {1679796000 39600 1 SAKST}
- {1698544800 36000 0 SAKT}
- {1711850400 39600 1 SAKST}
- {1729994400 36000 0 SAKT}
- {1743300000 39600 1 SAKST}
- {1761444000 36000 0 SAKT}
- {1774749600 39600 1 SAKST}
- {1792893600 36000 0 SAKT}
- {1806199200 39600 1 SAKST}
- {1824948000 36000 0 SAKT}
- {1837648800 39600 1 SAKST}
- {1856397600 36000 0 SAKT}
- {1869098400 39600 1 SAKST}
- {1887847200 36000 0 SAKT}
- {1901152800 39600 1 SAKST}
- {1919296800 36000 0 SAKT}
- {1932602400 39600 1 SAKST}
- {1950746400 36000 0 SAKT}
- {1964052000 39600 1 SAKST}
- {1982800800 36000 0 SAKT}
- {1995501600 39600 1 SAKST}
- {2014250400 36000 0 SAKT}
- {2026951200 39600 1 SAKST}
- {2045700000 36000 0 SAKT}
- {2058400800 39600 1 SAKST}
- {2077149600 36000 0 SAKT}
- {2090455200 39600 1 SAKST}
- {2108599200 36000 0 SAKT}
- {2121904800 39600 1 SAKST}
- {2140048800 36000 0 SAKT}
- {2153354400 39600 1 SAKST}
- {2172103200 36000 0 SAKT}
- {2184804000 39600 1 SAKST}
- {2203552800 36000 0 SAKT}
- {2216253600 39600 1 SAKST}
- {2235002400 36000 0 SAKT}
- {2248308000 39600 1 SAKST}
- {2266452000 36000 0 SAKT}
- {2279757600 39600 1 SAKST}
- {2297901600 36000 0 SAKT}
- {2311207200 39600 1 SAKST}
- {2329351200 36000 0 SAKT}
- {2342656800 39600 1 SAKST}
- {2361405600 36000 0 SAKT}
- {2374106400 39600 1 SAKST}
- {2392855200 36000 0 SAKT}
- {2405556000 39600 1 SAKST}
- {2424304800 36000 0 SAKT}
- {2437610400 39600 1 SAKST}
- {2455754400 36000 0 SAKT}
- {2469060000 39600 1 SAKST}
- {2487204000 36000 0 SAKT}
- {2500509600 39600 1 SAKST}
- {2519258400 36000 0 SAKT}
- {2531959200 39600 1 SAKST}
- {2550708000 36000 0 SAKT}
- {2563408800 39600 1 SAKST}
- {2582157600 36000 0 SAKT}
- {2595463200 39600 1 SAKST}
- {2613607200 36000 0 SAKT}
- {2626912800 39600 1 SAKST}
- {2645056800 36000 0 SAKT}
- {2658362400 39600 1 SAKST}
- {2676506400 36000 0 SAKT}
- {2689812000 39600 1 SAKST}
- {2708560800 36000 0 SAKT}
- {2721261600 39600 1 SAKST}
- {2740010400 36000 0 SAKT}
- {2752711200 39600 1 SAKST}
- {2771460000 36000 0 SAKT}
- {2784765600 39600 1 SAKST}
- {2802909600 36000 0 SAKT}
- {2816215200 39600 1 SAKST}
- {2834359200 36000 0 SAKT}
- {2847664800 39600 1 SAKST}
- {2866413600 36000 0 SAKT}
- {2879114400 39600 1 SAKST}
- {2897863200 36000 0 SAKT}
- {2910564000 39600 1 SAKST}
- {2929312800 36000 0 SAKT}
- {2942013600 39600 1 SAKST}
- {2960762400 36000 0 SAKT}
- {2974068000 39600 1 SAKST}
- {2992212000 36000 0 SAKT}
- {3005517600 39600 1 SAKST}
- {3023661600 36000 0 SAKT}
- {3036967200 39600 1 SAKST}
- {3055716000 36000 0 SAKT}
- {3068416800 39600 1 SAKST}
- {3087165600 36000 0 SAKT}
- {3099866400 39600 1 SAKST}
- {3118615200 36000 0 SAKT}
- {3131920800 39600 1 SAKST}
- {3150064800 36000 0 SAKT}
- {3163370400 39600 1 SAKST}
- {3181514400 36000 0 SAKT}
- {3194820000 39600 1 SAKST}
- {3212964000 36000 0 SAKT}
- {3226269600 39600 1 SAKST}
- {3245018400 36000 0 SAKT}
- {3257719200 39600 1 SAKST}
- {3276468000 36000 0 SAKT}
- {3289168800 39600 1 SAKST}
- {3307917600 36000 0 SAKT}
- {3321223200 39600 1 SAKST}
- {3339367200 36000 0 SAKT}
- {3352672800 39600 1 SAKST}
- {3370816800 36000 0 SAKT}
- {3384122400 39600 1 SAKST}
- {3402871200 36000 0 SAKT}
- {3415572000 39600 1 SAKST}
- {3434320800 36000 0 SAKT}
- {3447021600 39600 1 SAKST}
- {3465770400 36000 0 SAKT}
- {3479076000 39600 1 SAKST}
- {3497220000 36000 0 SAKT}
- {3510525600 39600 1 SAKST}
- {3528669600 36000 0 SAKT}
- {3541975200 39600 1 SAKST}
- {3560119200 36000 0 SAKT}
- {3573424800 39600 1 SAKST}
- {3592173600 36000 0 SAKT}
- {3604874400 39600 1 SAKST}
- {3623623200 36000 0 SAKT}
- {3636324000 39600 1 SAKST}
- {3655072800 36000 0 SAKT}
- {3668378400 39600 1 SAKST}
- {3686522400 36000 0 SAKT}
- {3699828000 39600 1 SAKST}
- {3717972000 36000 0 SAKT}
- {3731277600 39600 1 SAKST}
- {3750026400 36000 0 SAKT}
- {3762727200 39600 1 SAKST}
- {3781476000 36000 0 SAKT}
- {3794176800 39600 1 SAKST}
- {3812925600 36000 0 SAKT}
- {3825626400 39600 1 SAKST}
- {3844375200 36000 0 SAKT}
- {3857680800 39600 1 SAKST}
- {3875824800 36000 0 SAKT}
- {3889130400 39600 1 SAKST}
- {3907274400 36000 0 SAKT}
- {3920580000 39600 1 SAKST}
- {3939328800 36000 0 SAKT}
- {3952029600 39600 1 SAKST}
- {3970778400 36000 0 SAKT}
- {3983479200 39600 1 SAKST}
- {4002228000 36000 0 SAKT}
- {4015533600 39600 1 SAKST}
- {4033677600 36000 0 SAKT}
- {4046983200 39600 1 SAKST}
- {4065127200 36000 0 SAKT}
- {4078432800 39600 1 SAKST}
- {4096576800 36000 0 SAKT}
+ {733244400 43200 1 SAKST}
+ {748969200 39600 0 SAKT}
+ {764694000 43200 1 SAKST}
+ {780418800 39600 0 SAKT}
+ {796143600 43200 1 SAKST}
+ {811868400 39600 0 SAKT}
+ {828198000 43200 1 SAKST}
+ {846342000 39600 0 SAKT}
+ {859647600 36000 0 SAKMMTT}
+ {859651200 39600 1 SAKST}
+ {877795200 36000 0 SAKT}
+ {891100800 39600 1 SAKST}
+ {909244800 36000 0 SAKT}
+ {922550400 39600 1 SAKST}
+ {941299200 36000 0 SAKT}
+ {954000000 39600 1 SAKST}
+ {972748800 36000 0 SAKT}
+ {985449600 39600 1 SAKST}
+ {1004198400 36000 0 SAKT}
+ {1017504000 39600 1 SAKST}
+ {1035648000 36000 0 SAKT}
+ {1048953600 39600 1 SAKST}
+ {1067097600 36000 0 SAKT}
+ {1080403200 39600 1 SAKST}
+ {1099152000 36000 0 SAKT}
+ {1111852800 39600 1 SAKST}
+ {1130601600 36000 0 SAKT}
+ {1143302400 39600 1 SAKST}
+ {1162051200 36000 0 SAKT}
+ {1174752000 39600 1 SAKST}
+ {1193500800 36000 0 SAKT}
+ {1206806400 39600 1 SAKST}
+ {1224950400 36000 0 SAKT}
+ {1238256000 39600 1 SAKST}
+ {1256400000 36000 0 SAKT}
+ {1269705600 39600 1 SAKST}
+ {1288454400 36000 0 SAKT}
+ {1301155200 39600 0 SAKT}
}
diff --git a/library/tzdata/Asia/Samarkand b/library/tzdata/Asia/Samarkand
index 47a3a3b..6a1be11 100644
--- a/library/tzdata/Asia/Samarkand
+++ b/library/tzdata/Asia/Samarkand
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Samarkand) {
{-9223372036854775808 16032 0 LMT}
@@ -6,30 +6,27 @@ set TZData(:Asia/Samarkand) {
{-1247544000 18000 0 SAMT}
{354913200 21600 1 SAMST}
{370720800 21600 0 TAST}
- {386445600 25200 1 TASST}
- {402253200 21600 0 TAST}
- {417981600 25200 1 TASST}
- {433789200 21600 0 TAST}
- {449604000 25200 1 TASST}
- {465357600 21600 0 TAST}
- {481082400 25200 1 TASST}
- {496807200 21600 0 TAST}
- {512532000 25200 1 TASST}
- {528256800 21600 0 TAST}
- {543981600 25200 1 TASST}
- {559706400 21600 0 TAST}
- {575431200 25200 1 TASST}
- {591156000 21600 0 TAST}
- {606880800 25200 1 TASST}
- {622605600 21600 0 TAST}
- {638330400 25200 1 TASST}
- {654660000 21600 0 TAST}
- {670363200 18000 0 TAST}
- {670384800 21600 1 TASST}
+ {386445600 18000 0 SAMT}
+ {386449200 21600 1 SAMST}
+ {402256800 18000 0 SAMT}
+ {417985200 21600 1 SAMST}
+ {433792800 18000 0 SAMT}
+ {449607600 21600 1 SAMST}
+ {465339600 18000 0 SAMT}
+ {481064400 21600 1 SAMST}
+ {496789200 18000 0 SAMT}
+ {512514000 21600 1 SAMST}
+ {528238800 18000 0 SAMT}
+ {543963600 21600 1 SAMST}
+ {559688400 18000 0 SAMT}
+ {575413200 21600 1 SAMST}
+ {591138000 18000 0 SAMT}
+ {606862800 21600 1 SAMST}
+ {622587600 18000 0 SAMT}
+ {638312400 21600 1 SAMST}
+ {654642000 18000 0 SAMT}
+ {670366800 21600 1 SAMST}
{683665200 21600 0 UZST}
- {686109600 18000 0 UZT}
+ {686091600 18000 0 UZT}
{694206000 18000 0 UZT}
- {701805600 21600 1 UZST}
- {717526800 18000 0 UZT}
- {725828400 18000 0 UZT}
}
diff --git a/library/tzdata/Asia/Seoul b/library/tzdata/Asia/Seoul
index d1e1de7..9c83e30 100644
--- a/library/tzdata/Asia/Seoul
+++ b/library/tzdata/Asia/Seoul
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Seoul) {
{-9223372036854775808 30472 0 LMT}
diff --git a/library/tzdata/Asia/Shanghai b/library/tzdata/Asia/Shanghai
index 6faac9f..4b3cc3b 100644
--- a/library/tzdata/Asia/Shanghai
+++ b/library/tzdata/Asia/Shanghai
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Shanghai) {
- {-9223372036854775808 29152 0 LMT}
- {-1325491552 28800 0 CST}
+ {-9223372036854775808 29157 0 LMT}
+ {-1325491557 28800 0 CST}
{-933494400 32400 1 CDT}
{-923130000 28800 0 CST}
{-908784000 32400 1 CDT}
diff --git a/library/tzdata/Asia/Singapore b/library/tzdata/Asia/Singapore
index 2f8931d..e2f226e 100644
--- a/library/tzdata/Asia/Singapore
+++ b/library/tzdata/Asia/Singapore
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Singapore) {
{-9223372036854775808 24925 0 LMT}
diff --git a/library/tzdata/Asia/Taipei b/library/tzdata/Asia/Taipei
index 862538a..a3c7ecf 100644
--- a/library/tzdata/Asia/Taipei
+++ b/library/tzdata/Asia/Taipei
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Taipei) {
{-9223372036854775808 29160 0 LMT}
@@ -41,6 +41,6 @@ set TZData(:Asia/Taipei) {
{149785200 28800 0 CST}
{165513600 32400 1 CDT}
{181321200 28800 0 CST}
- {331142400 32400 1 CDT}
- {339087600 28800 0 CST}
+ {299520000 32400 1 CDT}
+ {307465200 28800 0 CST}
}
diff --git a/library/tzdata/Asia/Tashkent b/library/tzdata/Asia/Tashkent
index d412ee8..fcee755 100644
--- a/library/tzdata/Asia/Tashkent
+++ b/library/tzdata/Asia/Tashkent
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Tashkent) {
{-9223372036854775808 16632 0 LMT}
@@ -11,23 +11,22 @@ set TZData(:Asia/Tashkent) {
{417981600 25200 1 TASST}
{433789200 21600 0 TAST}
{449604000 25200 1 TASST}
- {465357600 21600 0 TAST}
- {481082400 25200 1 TASST}
- {496807200 21600 0 TAST}
- {512532000 25200 1 TASST}
- {528256800 21600 0 TAST}
- {543981600 25200 1 TASST}
- {559706400 21600 0 TAST}
- {575431200 25200 1 TASST}
- {591156000 21600 0 TAST}
- {606880800 25200 1 TASST}
- {622605600 21600 0 TAST}
- {638330400 25200 1 TASST}
- {654660000 21600 0 TAST}
+ {465336000 21600 0 TAST}
+ {481060800 25200 1 TASST}
+ {496785600 21600 0 TAST}
+ {512510400 25200 1 TASST}
+ {528235200 21600 0 TAST}
+ {543960000 25200 1 TASST}
+ {559684800 21600 0 TAST}
+ {575409600 25200 1 TASST}
+ {591134400 21600 0 TAST}
+ {606859200 25200 1 TASST}
+ {622584000 21600 0 TAST}
+ {638308800 25200 1 TASST}
+ {654638400 21600 0 TAST}
+ {670363200 18000 0 TAST}
+ {670366800 21600 1 TASST}
{683665200 21600 0 UZST}
- {686109600 18000 0 UZT}
+ {686091600 18000 0 UZT}
{694206000 18000 0 UZT}
- {701805600 21600 1 UZST}
- {717526800 18000 0 UZT}
- {725828400 18000 0 UZT}
}
diff --git a/library/tzdata/Asia/Tbilisi b/library/tzdata/Asia/Tbilisi
index 89ad3c4..a716917 100644
--- a/library/tzdata/Asia/Tbilisi
+++ b/library/tzdata/Asia/Tbilisi
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Tbilisi) {
{-9223372036854775808 10756 0 LMT}
@@ -12,22 +12,22 @@ set TZData(:Asia/Tbilisi) {
{417988800 18000 1 TBIST}
{433796400 14400 0 TBIT}
{449611200 18000 1 TBIST}
- {465357600 14400 0 TBIT}
- {481082400 18000 1 TBIST}
- {496807200 14400 0 TBIT}
- {512532000 18000 1 TBIST}
- {528256800 14400 0 TBIT}
- {543981600 18000 1 TBIST}
- {559706400 14400 0 TBIT}
- {575431200 18000 1 TBIST}
- {591156000 14400 0 TBIT}
- {606880800 18000 1 TBIST}
- {622605600 14400 0 TBIT}
- {638330400 18000 1 TBIST}
- {654660000 14400 0 TBIT}
- {670384800 14400 1 TBIST}
+ {465343200 14400 0 TBIT}
+ {481068000 18000 1 TBIST}
+ {496792800 14400 0 TBIT}
+ {512517600 18000 1 TBIST}
+ {528242400 14400 0 TBIT}
+ {543967200 18000 1 TBIST}
+ {559692000 14400 0 TBIT}
+ {575416800 18000 1 TBIST}
+ {591141600 14400 0 TBIT}
+ {606866400 18000 1 TBIST}
+ {622591200 14400 0 TBIT}
+ {638316000 18000 1 TBIST}
+ {654645600 14400 0 TBIT}
+ {670370400 14400 1 TBIST}
{671140800 14400 0 GEST}
- {686109600 10800 0 GET}
+ {686098800 10800 0 GET}
{694213200 10800 0 GET}
{701816400 14400 1 GEST}
{717537600 10800 0 GET}
@@ -55,195 +55,6 @@ set TZData(:Asia/Tbilisi) {
{1067108400 14400 0 GET}
{1080417600 18000 1 GEST}
{1088280000 14400 0 GEST}
- {1099188000 10800 0 GET}
- {1111888800 14400 1 GEST}
- {1130637600 10800 0 GET}
- {1143338400 14400 1 GEST}
- {1162087200 10800 0 GET}
- {1174788000 14400 1 GEST}
- {1193536800 10800 0 GET}
- {1206842400 14400 1 GEST}
- {1224986400 10800 0 GET}
- {1238292000 14400 1 GEST}
- {1256436000 10800 0 GET}
- {1269741600 14400 1 GEST}
- {1288490400 10800 0 GET}
- {1301191200 14400 1 GEST}
- {1319940000 10800 0 GET}
- {1332640800 14400 1 GEST}
- {1351389600 10800 0 GET}
- {1364695200 14400 1 GEST}
- {1382839200 10800 0 GET}
- {1396144800 14400 1 GEST}
- {1414288800 10800 0 GET}
- {1427594400 14400 1 GEST}
- {1445738400 10800 0 GET}
- {1459044000 14400 1 GEST}
- {1477792800 10800 0 GET}
- {1490493600 14400 1 GEST}
- {1509242400 10800 0 GET}
- {1521943200 14400 1 GEST}
- {1540692000 10800 0 GET}
- {1553997600 14400 1 GEST}
- {1572141600 10800 0 GET}
- {1585447200 14400 1 GEST}
- {1603591200 10800 0 GET}
- {1616896800 14400 1 GEST}
- {1635645600 10800 0 GET}
- {1648346400 14400 1 GEST}
- {1667095200 10800 0 GET}
- {1679796000 14400 1 GEST}
- {1698544800 10800 0 GET}
- {1711850400 14400 1 GEST}
- {1729994400 10800 0 GET}
- {1743300000 14400 1 GEST}
- {1761444000 10800 0 GET}
- {1774749600 14400 1 GEST}
- {1792893600 10800 0 GET}
- {1806199200 14400 1 GEST}
- {1824948000 10800 0 GET}
- {1837648800 14400 1 GEST}
- {1856397600 10800 0 GET}
- {1869098400 14400 1 GEST}
- {1887847200 10800 0 GET}
- {1901152800 14400 1 GEST}
- {1919296800 10800 0 GET}
- {1932602400 14400 1 GEST}
- {1950746400 10800 0 GET}
- {1964052000 14400 1 GEST}
- {1982800800 10800 0 GET}
- {1995501600 14400 1 GEST}
- {2014250400 10800 0 GET}
- {2026951200 14400 1 GEST}
- {2045700000 10800 0 GET}
- {2058400800 14400 1 GEST}
- {2077149600 10800 0 GET}
- {2090455200 14400 1 GEST}
- {2108599200 10800 0 GET}
- {2121904800 14400 1 GEST}
- {2140048800 10800 0 GET}
- {2153354400 14400 1 GEST}
- {2172103200 10800 0 GET}
- {2184804000 14400 1 GEST}
- {2203552800 10800 0 GET}
- {2216253600 14400 1 GEST}
- {2235002400 10800 0 GET}
- {2248308000 14400 1 GEST}
- {2266452000 10800 0 GET}
- {2279757600 14400 1 GEST}
- {2297901600 10800 0 GET}
- {2311207200 14400 1 GEST}
- {2329351200 10800 0 GET}
- {2342656800 14400 1 GEST}
- {2361405600 10800 0 GET}
- {2374106400 14400 1 GEST}
- {2392855200 10800 0 GET}
- {2405556000 14400 1 GEST}
- {2424304800 10800 0 GET}
- {2437610400 14400 1 GEST}
- {2455754400 10800 0 GET}
- {2469060000 14400 1 GEST}
- {2487204000 10800 0 GET}
- {2500509600 14400 1 GEST}
- {2519258400 10800 0 GET}
- {2531959200 14400 1 GEST}
- {2550708000 10800 0 GET}
- {2563408800 14400 1 GEST}
- {2582157600 10800 0 GET}
- {2595463200 14400 1 GEST}
- {2613607200 10800 0 GET}
- {2626912800 14400 1 GEST}
- {2645056800 10800 0 GET}
- {2658362400 14400 1 GEST}
- {2676506400 10800 0 GET}
- {2689812000 14400 1 GEST}
- {2708560800 10800 0 GET}
- {2721261600 14400 1 GEST}
- {2740010400 10800 0 GET}
- {2752711200 14400 1 GEST}
- {2771460000 10800 0 GET}
- {2784765600 14400 1 GEST}
- {2802909600 10800 0 GET}
- {2816215200 14400 1 GEST}
- {2834359200 10800 0 GET}
- {2847664800 14400 1 GEST}
- {2866413600 10800 0 GET}
- {2879114400 14400 1 GEST}
- {2897863200 10800 0 GET}
- {2910564000 14400 1 GEST}
- {2929312800 10800 0 GET}
- {2942013600 14400 1 GEST}
- {2960762400 10800 0 GET}
- {2974068000 14400 1 GEST}
- {2992212000 10800 0 GET}
- {3005517600 14400 1 GEST}
- {3023661600 10800 0 GET}
- {3036967200 14400 1 GEST}
- {3055716000 10800 0 GET}
- {3068416800 14400 1 GEST}
- {3087165600 10800 0 GET}
- {3099866400 14400 1 GEST}
- {3118615200 10800 0 GET}
- {3131920800 14400 1 GEST}
- {3150064800 10800 0 GET}
- {3163370400 14400 1 GEST}
- {3181514400 10800 0 GET}
- {3194820000 14400 1 GEST}
- {3212964000 10800 0 GET}
- {3226269600 14400 1 GEST}
- {3245018400 10800 0 GET}
- {3257719200 14400 1 GEST}
- {3276468000 10800 0 GET}
- {3289168800 14400 1 GEST}
- {3307917600 10800 0 GET}
- {3321223200 14400 1 GEST}
- {3339367200 10800 0 GET}
- {3352672800 14400 1 GEST}
- {3370816800 10800 0 GET}
- {3384122400 14400 1 GEST}
- {3402871200 10800 0 GET}
- {3415572000 14400 1 GEST}
- {3434320800 10800 0 GET}
- {3447021600 14400 1 GEST}
- {3465770400 10800 0 GET}
- {3479076000 14400 1 GEST}
- {3497220000 10800 0 GET}
- {3510525600 14400 1 GEST}
- {3528669600 10800 0 GET}
- {3541975200 14400 1 GEST}
- {3560119200 10800 0 GET}
- {3573424800 14400 1 GEST}
- {3592173600 10800 0 GET}
- {3604874400 14400 1 GEST}
- {3623623200 10800 0 GET}
- {3636324000 14400 1 GEST}
- {3655072800 10800 0 GET}
- {3668378400 14400 1 GEST}
- {3686522400 10800 0 GET}
- {3699828000 14400 1 GEST}
- {3717972000 10800 0 GET}
- {3731277600 14400 1 GEST}
- {3750026400 10800 0 GET}
- {3762727200 14400 1 GEST}
- {3781476000 10800 0 GET}
- {3794176800 14400 1 GEST}
- {3812925600 10800 0 GET}
- {3825626400 14400 1 GEST}
- {3844375200 10800 0 GET}
- {3857680800 14400 1 GEST}
- {3875824800 10800 0 GET}
- {3889130400 14400 1 GEST}
- {3907274400 10800 0 GET}
- {3920580000 14400 1 GEST}
- {3939328800 10800 0 GET}
- {3952029600 14400 1 GEST}
- {3970778400 10800 0 GET}
- {3983479200 14400 1 GEST}
- {4002228000 10800 0 GET}
- {4015533600 14400 1 GEST}
- {4033677600 10800 0 GET}
- {4046983200 14400 1 GEST}
- {4065127200 10800 0 GET}
- {4078432800 14400 1 GEST}
- {4096576800 10800 0 GET}
+ {1099177200 10800 0 GET}
+ {1111878000 14400 0 GET}
}
diff --git a/library/tzdata/Asia/Tehran b/library/tzdata/Asia/Tehran
index 8523379..7dca0ae 100644
--- a/library/tzdata/Asia/Tehran
+++ b/library/tzdata/Asia/Tehran
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Tehran) {
{-9223372036854775808 12344 0 LMT}
@@ -42,10 +42,6 @@ set TZData(:Asia/Tehran) {
{1095708600 12600 0 IRST}
{1111437000 16200 1 IRDT}
{1127331000 12600 0 IRST}
- {1142973000 16200 1 IRDT}
- {1158867000 12600 0 IRST}
- {1174509000 16200 1 IRDT}
- {1190403000 12600 0 IRST}
{1206045000 16200 1 IRDT}
{1221939000 12600 0 IRST}
{1237667400 16200 1 IRDT}
diff --git a/library/tzdata/Asia/Tel_Aviv b/library/tzdata/Asia/Tel_Aviv
index 6dc3efa..3e7278d 100644
--- a/library/tzdata/Asia/Tel_Aviv
+++ b/library/tzdata/Asia/Tel_Aviv
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Jerusalem)]} {
LoadTimeZoneFile Asia/Jerusalem
}
diff --git a/library/tzdata/Asia/Thimbu b/library/tzdata/Asia/Thimbu
index 3155865..94b0846 100644
--- a/library/tzdata/Asia/Thimbu
+++ b/library/tzdata/Asia/Thimbu
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Thimphu)]} {
LoadTimeZoneFile Asia/Thimphu
}
diff --git a/library/tzdata/Asia/Thimphu b/library/tzdata/Asia/Thimphu
index 569e835..8c981de 100644
--- a/library/tzdata/Asia/Thimphu
+++ b/library/tzdata/Asia/Thimphu
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Thimphu) {
{-9223372036854775808 21516 0 LMT}
diff --git a/library/tzdata/Asia/Tokyo b/library/tzdata/Asia/Tokyo
index aa12b1a..8d1ce11 100644
--- a/library/tzdata/Asia/Tokyo
+++ b/library/tzdata/Asia/Tokyo
@@ -1,8 +1,16 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Tokyo) {
{-9223372036854775808 33539 0 LMT}
{-2587712400 32400 0 JST}
{-2335251600 32400 0 CJT}
{-1009875600 32400 0 JST}
+ {-683794800 36000 1 JDT}
+ {-672393600 32400 0 JST}
+ {-654764400 36000 1 JDT}
+ {-640944000 32400 0 JST}
+ {-620290800 36000 1 JDT}
+ {-609494400 32400 0 JST}
+ {-588841200 36000 1 JDT}
+ {-578044800 32400 0 JST}
}
diff --git a/library/tzdata/Asia/Ujung_Pandang b/library/tzdata/Asia/Ujung_Pandang
index e44970c..abe142e 100644
--- a/library/tzdata/Asia/Ujung_Pandang
+++ b/library/tzdata/Asia/Ujung_Pandang
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Makassar)]} {
LoadTimeZoneFile Asia/Makassar
}
diff --git a/library/tzdata/Asia/Ulaanbaatar b/library/tzdata/Asia/Ulaanbaatar
index 9bf988f..fef76ec 100644
--- a/library/tzdata/Asia/Ulaanbaatar
+++ b/library/tzdata/Asia/Ulaanbaatar
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Ulaanbaatar) {
{-9223372036854775808 25652 0 LMT}
@@ -7,35 +7,35 @@ set TZData(:Asia/Ulaanbaatar) {
{417974400 32400 1 ULAST}
{433782000 28800 0 ULAT}
{449596800 32400 1 ULAST}
- {465357600 28800 0 ULAT}
- {481082400 32400 1 ULAST}
- {496807200 28800 0 ULAT}
- {512532000 32400 1 ULAST}
- {528256800 28800 0 ULAT}
- {543981600 32400 1 ULAST}
- {559706400 28800 0 ULAT}
- {575431200 32400 1 ULAST}
- {591156000 28800 0 ULAT}
- {606880800 32400 1 ULAST}
- {622605600 28800 0 ULAT}
- {638330400 32400 1 ULAST}
- {654660000 28800 0 ULAT}
- {670384800 32400 1 ULAST}
- {686109600 28800 0 ULAT}
- {701834400 32400 1 ULAST}
- {717559200 28800 0 ULAT}
- {733284000 32400 1 ULAST}
- {749008800 28800 0 ULAT}
- {764733600 32400 1 ULAST}
- {780458400 28800 0 ULAT}
- {796183200 32400 1 ULAST}
- {811908000 28800 0 ULAT}
- {828237600 32400 1 ULAST}
- {843962400 28800 0 ULAT}
- {859687200 32400 1 ULAST}
- {875412000 28800 0 ULAT}
- {891136800 32400 1 ULAST}
- {906861600 28800 0 ULAT}
+ {465318000 28800 0 ULAT}
+ {481046400 32400 1 ULAST}
+ {496767600 28800 0 ULAT}
+ {512496000 32400 1 ULAST}
+ {528217200 28800 0 ULAT}
+ {543945600 32400 1 ULAST}
+ {559666800 28800 0 ULAT}
+ {575395200 32400 1 ULAST}
+ {591116400 28800 0 ULAT}
+ {606844800 32400 1 ULAST}
+ {622566000 28800 0 ULAT}
+ {638294400 32400 1 ULAST}
+ {654620400 28800 0 ULAT}
+ {670348800 32400 1 ULAST}
+ {686070000 28800 0 ULAT}
+ {701798400 32400 1 ULAST}
+ {717519600 28800 0 ULAT}
+ {733248000 32400 1 ULAST}
+ {748969200 28800 0 ULAT}
+ {764697600 32400 1 ULAST}
+ {780418800 28800 0 ULAT}
+ {796147200 32400 1 ULAST}
+ {811868400 28800 0 ULAT}
+ {828201600 32400 1 ULAST}
+ {843922800 28800 0 ULAT}
+ {859651200 32400 1 ULAST}
+ {875372400 28800 0 ULAT}
+ {891100800 32400 1 ULAST}
+ {906822000 28800 0 ULAT}
{988394400 32400 1 ULAST}
{1001696400 28800 0 ULAT}
{1017424800 32400 1 ULAST}
@@ -48,190 +48,4 @@ set TZData(:Asia/Ulaanbaatar) {
{1127494800 28800 0 ULAT}
{1143223200 32400 1 ULAST}
{1159549200 28800 0 ULAT}
- {1175277600 32400 1 ULAST}
- {1190998800 28800 0 ULAT}
- {1206727200 32400 1 ULAST}
- {1222448400 28800 0 ULAT}
- {1238176800 32400 1 ULAST}
- {1253898000 28800 0 ULAT}
- {1269626400 32400 1 ULAST}
- {1285347600 28800 0 ULAT}
- {1301076000 32400 1 ULAST}
- {1316797200 28800 0 ULAT}
- {1333130400 32400 1 ULAST}
- {1348851600 28800 0 ULAT}
- {1364580000 32400 1 ULAST}
- {1380301200 28800 0 ULAT}
- {1396029600 32400 1 ULAST}
- {1411750800 28800 0 ULAT}
- {1427479200 32400 1 ULAST}
- {1443200400 28800 0 ULAT}
- {1458928800 32400 1 ULAST}
- {1474650000 28800 0 ULAT}
- {1490378400 32400 1 ULAST}
- {1506704400 28800 0 ULAT}
- {1522432800 32400 1 ULAST}
- {1538154000 28800 0 ULAT}
- {1553882400 32400 1 ULAST}
- {1569603600 28800 0 ULAT}
- {1585332000 32400 1 ULAST}
- {1601053200 28800 0 ULAT}
- {1616781600 32400 1 ULAST}
- {1632502800 28800 0 ULAT}
- {1648231200 32400 1 ULAST}
- {1663952400 28800 0 ULAT}
- {1679680800 32400 1 ULAST}
- {1696006800 28800 0 ULAT}
- {1711735200 32400 1 ULAST}
- {1727456400 28800 0 ULAT}
- {1743184800 32400 1 ULAST}
- {1758906000 28800 0 ULAT}
- {1774634400 32400 1 ULAST}
- {1790355600 28800 0 ULAT}
- {1806084000 32400 1 ULAST}
- {1821805200 28800 0 ULAT}
- {1837533600 32400 1 ULAST}
- {1853859600 28800 0 ULAT}
- {1869588000 32400 1 ULAST}
- {1885309200 28800 0 ULAT}
- {1901037600 32400 1 ULAST}
- {1916758800 28800 0 ULAT}
- {1932487200 32400 1 ULAST}
- {1948208400 28800 0 ULAT}
- {1963936800 32400 1 ULAST}
- {1979658000 28800 0 ULAT}
- {1995386400 32400 1 ULAST}
- {2011107600 28800 0 ULAT}
- {2026836000 32400 1 ULAST}
- {2043162000 28800 0 ULAT}
- {2058890400 32400 1 ULAST}
- {2074611600 28800 0 ULAT}
- {2090340000 32400 1 ULAST}
- {2106061200 28800 0 ULAT}
- {2121789600 32400 1 ULAST}
- {2137510800 28800 0 ULAT}
- {2153239200 32400 1 ULAST}
- {2168960400 28800 0 ULAT}
- {2184688800 32400 1 ULAST}
- {2200410000 28800 0 ULAT}
- {2216743200 32400 1 ULAST}
- {2232464400 28800 0 ULAT}
- {2248192800 32400 1 ULAST}
- {2263914000 28800 0 ULAT}
- {2279642400 32400 1 ULAST}
- {2295363600 28800 0 ULAT}
- {2311092000 32400 1 ULAST}
- {2326813200 28800 0 ULAT}
- {2342541600 32400 1 ULAST}
- {2358262800 28800 0 ULAT}
- {2373991200 32400 1 ULAST}
- {2390317200 28800 0 ULAT}
- {2406045600 32400 1 ULAST}
- {2421766800 28800 0 ULAT}
- {2437495200 32400 1 ULAST}
- {2453216400 28800 0 ULAT}
- {2468944800 32400 1 ULAST}
- {2484666000 28800 0 ULAT}
- {2500394400 32400 1 ULAST}
- {2516115600 28800 0 ULAT}
- {2531844000 32400 1 ULAST}
- {2547565200 28800 0 ULAT}
- {2563293600 32400 1 ULAST}
- {2579619600 28800 0 ULAT}
- {2595348000 32400 1 ULAST}
- {2611069200 28800 0 ULAT}
- {2626797600 32400 1 ULAST}
- {2642518800 28800 0 ULAT}
- {2658247200 32400 1 ULAST}
- {2673968400 28800 0 ULAT}
- {2689696800 32400 1 ULAST}
- {2705418000 28800 0 ULAT}
- {2721146400 32400 1 ULAST}
- {2737472400 28800 0 ULAT}
- {2753200800 32400 1 ULAST}
- {2768922000 28800 0 ULAT}
- {2784650400 32400 1 ULAST}
- {2800371600 28800 0 ULAT}
- {2816100000 32400 1 ULAST}
- {2831821200 28800 0 ULAT}
- {2847549600 32400 1 ULAST}
- {2863270800 28800 0 ULAT}
- {2878999200 32400 1 ULAST}
- {2894720400 28800 0 ULAT}
- {2910448800 32400 1 ULAST}
- {2926774800 28800 0 ULAT}
- {2942503200 32400 1 ULAST}
- {2958224400 28800 0 ULAT}
- {2973952800 32400 1 ULAST}
- {2989674000 28800 0 ULAT}
- {3005402400 32400 1 ULAST}
- {3021123600 28800 0 ULAT}
- {3036852000 32400 1 ULAST}
- {3052573200 28800 0 ULAT}
- {3068301600 32400 1 ULAST}
- {3084022800 28800 0 ULAT}
- {3100356000 32400 1 ULAST}
- {3116077200 28800 0 ULAT}
- {3131805600 32400 1 ULAST}
- {3147526800 28800 0 ULAT}
- {3163255200 32400 1 ULAST}
- {3178976400 28800 0 ULAT}
- {3194704800 32400 1 ULAST}
- {3210426000 28800 0 ULAT}
- {3226154400 32400 1 ULAST}
- {3241875600 28800 0 ULAT}
- {3257604000 32400 1 ULAST}
- {3273930000 28800 0 ULAT}
- {3289658400 32400 1 ULAST}
- {3305379600 28800 0 ULAT}
- {3321108000 32400 1 ULAST}
- {3336829200 28800 0 ULAT}
- {3352557600 32400 1 ULAST}
- {3368278800 28800 0 ULAT}
- {3384007200 32400 1 ULAST}
- {3399728400 28800 0 ULAT}
- {3415456800 32400 1 ULAST}
- {3431178000 28800 0 ULAT}
- {3446906400 32400 1 ULAST}
- {3463232400 28800 0 ULAT}
- {3478960800 32400 1 ULAST}
- {3494682000 28800 0 ULAT}
- {3510410400 32400 1 ULAST}
- {3526131600 28800 0 ULAT}
- {3541860000 32400 1 ULAST}
- {3557581200 28800 0 ULAT}
- {3573309600 32400 1 ULAST}
- {3589030800 28800 0 ULAT}
- {3604759200 32400 1 ULAST}
- {3621085200 28800 0 ULAT}
- {3636813600 32400 1 ULAST}
- {3652534800 28800 0 ULAT}
- {3668263200 32400 1 ULAST}
- {3683984400 28800 0 ULAT}
- {3699712800 32400 1 ULAST}
- {3715434000 28800 0 ULAT}
- {3731162400 32400 1 ULAST}
- {3746883600 28800 0 ULAT}
- {3762612000 32400 1 ULAST}
- {3778333200 28800 0 ULAT}
- {3794061600 32400 1 ULAST}
- {3810387600 28800 0 ULAT}
- {3826116000 32400 1 ULAST}
- {3841837200 28800 0 ULAT}
- {3857565600 32400 1 ULAST}
- {3873286800 28800 0 ULAT}
- {3889015200 32400 1 ULAST}
- {3904736400 28800 0 ULAT}
- {3920464800 32400 1 ULAST}
- {3936186000 28800 0 ULAT}
- {3951914400 32400 1 ULAST}
- {3967635600 28800 0 ULAT}
- {3983968800 32400 1 ULAST}
- {3999690000 28800 0 ULAT}
- {4015418400 32400 1 ULAST}
- {4031139600 28800 0 ULAT}
- {4046868000 32400 1 ULAST}
- {4062589200 28800 0 ULAT}
- {4078317600 32400 1 ULAST}
- {4094038800 28800 0 ULAT}
}
diff --git a/library/tzdata/Asia/Ulan_Bator b/library/tzdata/Asia/Ulan_Bator
index 1eee921..3215ee7 100644
--- a/library/tzdata/Asia/Ulan_Bator
+++ b/library/tzdata/Asia/Ulan_Bator
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Ulaanbaatar)]} {
LoadTimeZoneFile Asia/Ulaanbaatar
}
diff --git a/library/tzdata/Asia/Urumqi b/library/tzdata/Asia/Urumqi
index d5c0cb5..93fc909 100644
--- a/library/tzdata/Asia/Urumqi
+++ b/library/tzdata/Asia/Urumqi
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Urumqi) {
{-9223372036854775808 21020 0 LMT}
diff --git a/library/tzdata/Asia/Ust-Nera b/library/tzdata/Asia/Ust-Nera
new file mode 100644
index 0000000..c8de7a5
--- /dev/null
+++ b/library/tzdata/Asia/Ust-Nera
@@ -0,0 +1,70 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Asia/Ust-Nera) {
+ {-9223372036854775808 34374 0 LMT}
+ {-1579426374 28800 0 YAKT}
+ {354898800 43200 0 MAGST}
+ {370699200 39600 0 MAGT}
+ {386427600 43200 1 MAGST}
+ {402235200 39600 0 MAGT}
+ {417963600 43200 1 MAGST}
+ {433771200 39600 0 MAGT}
+ {449586000 43200 1 MAGST}
+ {465318000 39600 0 MAGT}
+ {481042800 43200 1 MAGST}
+ {496767600 39600 0 MAGT}
+ {512492400 43200 1 MAGST}
+ {528217200 39600 0 MAGT}
+ {543942000 43200 1 MAGST}
+ {559666800 39600 0 MAGT}
+ {575391600 43200 1 MAGST}
+ {591116400 39600 0 MAGT}
+ {606841200 43200 1 MAGST}
+ {622566000 39600 0 MAGT}
+ {638290800 43200 1 MAGST}
+ {654620400 39600 0 MAGT}
+ {670345200 36000 0 MAGMMTT}
+ {670348800 39600 1 MAGST}
+ {686073600 36000 0 MAGT}
+ {695750400 39600 0 MAGMMTT}
+ {701784000 43200 1 MAGST}
+ {717505200 39600 0 MAGT}
+ {733244400 43200 1 MAGST}
+ {748969200 39600 0 MAGT}
+ {764694000 43200 1 MAGST}
+ {780418800 39600 0 MAGT}
+ {796143600 43200 1 MAGST}
+ {811868400 39600 0 MAGT}
+ {828198000 43200 1 MAGST}
+ {846342000 39600 0 MAGT}
+ {859647600 43200 1 MAGST}
+ {877791600 39600 0 MAGT}
+ {891097200 43200 1 MAGST}
+ {909241200 39600 0 MAGT}
+ {922546800 43200 1 MAGST}
+ {941295600 39600 0 MAGT}
+ {953996400 43200 1 MAGST}
+ {972745200 39600 0 MAGT}
+ {985446000 43200 1 MAGST}
+ {1004194800 39600 0 MAGT}
+ {1017500400 43200 1 MAGST}
+ {1035644400 39600 0 MAGT}
+ {1048950000 43200 1 MAGST}
+ {1067094000 39600 0 MAGT}
+ {1080399600 43200 1 MAGST}
+ {1099148400 39600 0 MAGT}
+ {1111849200 43200 1 MAGST}
+ {1130598000 39600 0 MAGT}
+ {1143298800 43200 1 MAGST}
+ {1162047600 39600 0 MAGT}
+ {1174748400 43200 1 MAGST}
+ {1193497200 39600 0 MAGT}
+ {1206802800 43200 1 MAGST}
+ {1224946800 39600 0 MAGT}
+ {1238252400 43200 1 MAGST}
+ {1256396400 39600 0 MAGT}
+ {1269702000 43200 1 MAGST}
+ {1288450800 39600 0 MAGT}
+ {1301151600 43200 0 MAGT}
+ {1315828800 39600 0 VLAT}
+}
diff --git a/library/tzdata/Asia/Vientiane b/library/tzdata/Asia/Vientiane
index 289fdfa..18ade4d 100644
--- a/library/tzdata/Asia/Vientiane
+++ b/library/tzdata/Asia/Vientiane
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Vientiane) {
{-9223372036854775808 24624 0 LMT}
diff --git a/library/tzdata/Asia/Vladivostok b/library/tzdata/Asia/Vladivostok
index d52c16c..54101a5 100644
--- a/library/tzdata/Asia/Vladivostok
+++ b/library/tzdata/Asia/Vladivostok
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Vladivostok) {
{-9223372036854775808 31664 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Vladivostok) {
{417967200 39600 1 VLAST}
{433774800 36000 0 VLAT}
{449589600 39600 1 VLAST}
- {465357600 36000 0 VLAT}
- {481082400 39600 1 VLAST}
- {496807200 36000 0 VLAT}
- {512532000 39600 1 VLAST}
- {528256800 36000 0 VLAT}
- {543981600 39600 1 VLAST}
- {559706400 36000 0 VLAT}
- {575431200 39600 1 VLAST}
- {591156000 36000 0 VLAT}
- {606880800 39600 1 VLAST}
- {622605600 36000 0 VLAT}
- {638330400 39600 1 VLAST}
- {654660000 36000 0 VLAT}
- {670384800 36000 0 VLASST}
- {686109600 32400 0 VLAST}
- {695786400 36000 0 VLAMMTT}
+ {465321600 36000 0 VLAT}
+ {481046400 39600 1 VLAST}
+ {496771200 36000 0 VLAT}
+ {512496000 39600 1 VLAST}
+ {528220800 36000 0 VLAT}
+ {543945600 39600 1 VLAST}
+ {559670400 36000 0 VLAT}
+ {575395200 39600 1 VLAST}
+ {591120000 36000 0 VLAT}
+ {606844800 39600 1 VLAST}
+ {622569600 36000 0 VLAT}
+ {638294400 39600 1 VLAST}
+ {654624000 36000 0 VLAT}
+ {670348800 32400 0 VLAMMTST}
+ {670352400 36000 1 VLASST}
+ {686077200 32400 0 VLAST}
+ {695754000 36000 0 VLAMMTT}
{701787600 39600 1 VLAST}
{717508800 36000 0 VLAT}
- {733284000 39600 1 VLAST}
- {749008800 36000 0 VLAT}
- {764733600 39600 1 VLAST}
- {780458400 36000 0 VLAT}
- {796183200 39600 1 VLAST}
- {811908000 36000 0 VLAT}
- {828237600 39600 1 VLAST}
- {846381600 36000 0 VLAT}
- {859687200 39600 1 VLAST}
- {877831200 36000 0 VLAT}
- {891136800 39600 1 VLAST}
- {909280800 36000 0 VLAT}
- {922586400 39600 1 VLAST}
- {941335200 36000 0 VLAT}
- {954036000 39600 1 VLAST}
- {972784800 36000 0 VLAT}
- {985485600 39600 1 VLAST}
- {1004234400 36000 0 VLAT}
- {1017540000 39600 1 VLAST}
- {1035684000 36000 0 VLAT}
- {1048989600 39600 1 VLAST}
- {1067133600 36000 0 VLAT}
- {1080439200 39600 1 VLAST}
- {1099188000 36000 0 VLAT}
- {1111888800 39600 1 VLAST}
- {1130637600 36000 0 VLAT}
- {1143338400 39600 1 VLAST}
- {1162087200 36000 0 VLAT}
- {1174788000 39600 1 VLAST}
- {1193536800 36000 0 VLAT}
- {1206842400 39600 1 VLAST}
- {1224986400 36000 0 VLAT}
- {1238292000 39600 1 VLAST}
- {1256436000 36000 0 VLAT}
- {1269741600 39600 1 VLAST}
- {1288490400 36000 0 VLAT}
- {1301191200 39600 1 VLAST}
- {1319940000 36000 0 VLAT}
- {1332640800 39600 1 VLAST}
- {1351389600 36000 0 VLAT}
- {1364695200 39600 1 VLAST}
- {1382839200 36000 0 VLAT}
- {1396144800 39600 1 VLAST}
- {1414288800 36000 0 VLAT}
- {1427594400 39600 1 VLAST}
- {1445738400 36000 0 VLAT}
- {1459044000 39600 1 VLAST}
- {1477792800 36000 0 VLAT}
- {1490493600 39600 1 VLAST}
- {1509242400 36000 0 VLAT}
- {1521943200 39600 1 VLAST}
- {1540692000 36000 0 VLAT}
- {1553997600 39600 1 VLAST}
- {1572141600 36000 0 VLAT}
- {1585447200 39600 1 VLAST}
- {1603591200 36000 0 VLAT}
- {1616896800 39600 1 VLAST}
- {1635645600 36000 0 VLAT}
- {1648346400 39600 1 VLAST}
- {1667095200 36000 0 VLAT}
- {1679796000 39600 1 VLAST}
- {1698544800 36000 0 VLAT}
- {1711850400 39600 1 VLAST}
- {1729994400 36000 0 VLAT}
- {1743300000 39600 1 VLAST}
- {1761444000 36000 0 VLAT}
- {1774749600 39600 1 VLAST}
- {1792893600 36000 0 VLAT}
- {1806199200 39600 1 VLAST}
- {1824948000 36000 0 VLAT}
- {1837648800 39600 1 VLAST}
- {1856397600 36000 0 VLAT}
- {1869098400 39600 1 VLAST}
- {1887847200 36000 0 VLAT}
- {1901152800 39600 1 VLAST}
- {1919296800 36000 0 VLAT}
- {1932602400 39600 1 VLAST}
- {1950746400 36000 0 VLAT}
- {1964052000 39600 1 VLAST}
- {1982800800 36000 0 VLAT}
- {1995501600 39600 1 VLAST}
- {2014250400 36000 0 VLAT}
- {2026951200 39600 1 VLAST}
- {2045700000 36000 0 VLAT}
- {2058400800 39600 1 VLAST}
- {2077149600 36000 0 VLAT}
- {2090455200 39600 1 VLAST}
- {2108599200 36000 0 VLAT}
- {2121904800 39600 1 VLAST}
- {2140048800 36000 0 VLAT}
- {2153354400 39600 1 VLAST}
- {2172103200 36000 0 VLAT}
- {2184804000 39600 1 VLAST}
- {2203552800 36000 0 VLAT}
- {2216253600 39600 1 VLAST}
- {2235002400 36000 0 VLAT}
- {2248308000 39600 1 VLAST}
- {2266452000 36000 0 VLAT}
- {2279757600 39600 1 VLAST}
- {2297901600 36000 0 VLAT}
- {2311207200 39600 1 VLAST}
- {2329351200 36000 0 VLAT}
- {2342656800 39600 1 VLAST}
- {2361405600 36000 0 VLAT}
- {2374106400 39600 1 VLAST}
- {2392855200 36000 0 VLAT}
- {2405556000 39600 1 VLAST}
- {2424304800 36000 0 VLAT}
- {2437610400 39600 1 VLAST}
- {2455754400 36000 0 VLAT}
- {2469060000 39600 1 VLAST}
- {2487204000 36000 0 VLAT}
- {2500509600 39600 1 VLAST}
- {2519258400 36000 0 VLAT}
- {2531959200 39600 1 VLAST}
- {2550708000 36000 0 VLAT}
- {2563408800 39600 1 VLAST}
- {2582157600 36000 0 VLAT}
- {2595463200 39600 1 VLAST}
- {2613607200 36000 0 VLAT}
- {2626912800 39600 1 VLAST}
- {2645056800 36000 0 VLAT}
- {2658362400 39600 1 VLAST}
- {2676506400 36000 0 VLAT}
- {2689812000 39600 1 VLAST}
- {2708560800 36000 0 VLAT}
- {2721261600 39600 1 VLAST}
- {2740010400 36000 0 VLAT}
- {2752711200 39600 1 VLAST}
- {2771460000 36000 0 VLAT}
- {2784765600 39600 1 VLAST}
- {2802909600 36000 0 VLAT}
- {2816215200 39600 1 VLAST}
- {2834359200 36000 0 VLAT}
- {2847664800 39600 1 VLAST}
- {2866413600 36000 0 VLAT}
- {2879114400 39600 1 VLAST}
- {2897863200 36000 0 VLAT}
- {2910564000 39600 1 VLAST}
- {2929312800 36000 0 VLAT}
- {2942013600 39600 1 VLAST}
- {2960762400 36000 0 VLAT}
- {2974068000 39600 1 VLAST}
- {2992212000 36000 0 VLAT}
- {3005517600 39600 1 VLAST}
- {3023661600 36000 0 VLAT}
- {3036967200 39600 1 VLAST}
- {3055716000 36000 0 VLAT}
- {3068416800 39600 1 VLAST}
- {3087165600 36000 0 VLAT}
- {3099866400 39600 1 VLAST}
- {3118615200 36000 0 VLAT}
- {3131920800 39600 1 VLAST}
- {3150064800 36000 0 VLAT}
- {3163370400 39600 1 VLAST}
- {3181514400 36000 0 VLAT}
- {3194820000 39600 1 VLAST}
- {3212964000 36000 0 VLAT}
- {3226269600 39600 1 VLAST}
- {3245018400 36000 0 VLAT}
- {3257719200 39600 1 VLAST}
- {3276468000 36000 0 VLAT}
- {3289168800 39600 1 VLAST}
- {3307917600 36000 0 VLAT}
- {3321223200 39600 1 VLAST}
- {3339367200 36000 0 VLAT}
- {3352672800 39600 1 VLAST}
- {3370816800 36000 0 VLAT}
- {3384122400 39600 1 VLAST}
- {3402871200 36000 0 VLAT}
- {3415572000 39600 1 VLAST}
- {3434320800 36000 0 VLAT}
- {3447021600 39600 1 VLAST}
- {3465770400 36000 0 VLAT}
- {3479076000 39600 1 VLAST}
- {3497220000 36000 0 VLAT}
- {3510525600 39600 1 VLAST}
- {3528669600 36000 0 VLAT}
- {3541975200 39600 1 VLAST}
- {3560119200 36000 0 VLAT}
- {3573424800 39600 1 VLAST}
- {3592173600 36000 0 VLAT}
- {3604874400 39600 1 VLAST}
- {3623623200 36000 0 VLAT}
- {3636324000 39600 1 VLAST}
- {3655072800 36000 0 VLAT}
- {3668378400 39600 1 VLAST}
- {3686522400 36000 0 VLAT}
- {3699828000 39600 1 VLAST}
- {3717972000 36000 0 VLAT}
- {3731277600 39600 1 VLAST}
- {3750026400 36000 0 VLAT}
- {3762727200 39600 1 VLAST}
- {3781476000 36000 0 VLAT}
- {3794176800 39600 1 VLAST}
- {3812925600 36000 0 VLAT}
- {3825626400 39600 1 VLAST}
- {3844375200 36000 0 VLAT}
- {3857680800 39600 1 VLAST}
- {3875824800 36000 0 VLAT}
- {3889130400 39600 1 VLAST}
- {3907274400 36000 0 VLAT}
- {3920580000 39600 1 VLAST}
- {3939328800 36000 0 VLAT}
- {3952029600 39600 1 VLAST}
- {3970778400 36000 0 VLAT}
- {3983479200 39600 1 VLAST}
- {4002228000 36000 0 VLAT}
- {4015533600 39600 1 VLAST}
- {4033677600 36000 0 VLAT}
- {4046983200 39600 1 VLAST}
- {4065127200 36000 0 VLAT}
- {4078432800 39600 1 VLAST}
- {4096576800 36000 0 VLAT}
+ {733248000 39600 1 VLAST}
+ {748972800 36000 0 VLAT}
+ {764697600 39600 1 VLAST}
+ {780422400 36000 0 VLAT}
+ {796147200 39600 1 VLAST}
+ {811872000 36000 0 VLAT}
+ {828201600 39600 1 VLAST}
+ {846345600 36000 0 VLAT}
+ {859651200 39600 1 VLAST}
+ {877795200 36000 0 VLAT}
+ {891100800 39600 1 VLAST}
+ {909244800 36000 0 VLAT}
+ {922550400 39600 1 VLAST}
+ {941299200 36000 0 VLAT}
+ {954000000 39600 1 VLAST}
+ {972748800 36000 0 VLAT}
+ {985449600 39600 1 VLAST}
+ {1004198400 36000 0 VLAT}
+ {1017504000 39600 1 VLAST}
+ {1035648000 36000 0 VLAT}
+ {1048953600 39600 1 VLAST}
+ {1067097600 36000 0 VLAT}
+ {1080403200 39600 1 VLAST}
+ {1099152000 36000 0 VLAT}
+ {1111852800 39600 1 VLAST}
+ {1130601600 36000 0 VLAT}
+ {1143302400 39600 1 VLAST}
+ {1162051200 36000 0 VLAT}
+ {1174752000 39600 1 VLAST}
+ {1193500800 36000 0 VLAT}
+ {1206806400 39600 1 VLAST}
+ {1224950400 36000 0 VLAT}
+ {1238256000 39600 1 VLAST}
+ {1256400000 36000 0 VLAT}
+ {1269705600 39600 1 VLAST}
+ {1288454400 36000 0 VLAT}
+ {1301155200 39600 0 VLAT}
}
diff --git a/library/tzdata/Asia/Yakutsk b/library/tzdata/Asia/Yakutsk
index 38ea44e..5c32cc9 100644
--- a/library/tzdata/Asia/Yakutsk
+++ b/library/tzdata/Asia/Yakutsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Yakutsk) {
{-9223372036854775808 31120 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Yakutsk) {
{417970800 36000 1 YAKST}
{433778400 32400 0 YAKT}
{449593200 36000 1 YAKST}
- {465357600 32400 0 YAKT}
- {481082400 36000 1 YAKST}
- {496807200 32400 0 YAKT}
- {512532000 36000 1 YAKST}
- {528256800 32400 0 YAKT}
- {543981600 36000 1 YAKST}
- {559706400 32400 0 YAKT}
- {575431200 36000 1 YAKST}
- {591156000 32400 0 YAKT}
- {606880800 36000 1 YAKST}
- {622605600 32400 0 YAKT}
- {638330400 36000 1 YAKST}
- {654660000 32400 0 YAKT}
- {670384800 32400 0 YAKST}
- {686109600 28800 0 YAKT}
- {695786400 32400 0 YAKMMTT}
+ {465325200 32400 0 YAKT}
+ {481050000 36000 1 YAKST}
+ {496774800 32400 0 YAKT}
+ {512499600 36000 1 YAKST}
+ {528224400 32400 0 YAKT}
+ {543949200 36000 1 YAKST}
+ {559674000 32400 0 YAKT}
+ {575398800 36000 1 YAKST}
+ {591123600 32400 0 YAKT}
+ {606848400 36000 1 YAKST}
+ {622573200 32400 0 YAKT}
+ {638298000 36000 1 YAKST}
+ {654627600 32400 0 YAKT}
+ {670352400 28800 0 YAKMMTT}
+ {670356000 32400 1 YAKST}
+ {686080800 28800 0 YAKT}
+ {695757600 32400 0 YAKMMTT}
{701791200 36000 1 YAKST}
{717512400 32400 0 YAKT}
- {733284000 36000 1 YAKST}
- {749008800 32400 0 YAKT}
- {764733600 36000 1 YAKST}
- {780458400 32400 0 YAKT}
- {796183200 36000 1 YAKST}
- {811908000 32400 0 YAKT}
- {828237600 36000 1 YAKST}
- {846381600 32400 0 YAKT}
- {859687200 36000 1 YAKST}
- {877831200 32400 0 YAKT}
- {891136800 36000 1 YAKST}
- {909280800 32400 0 YAKT}
- {922586400 36000 1 YAKST}
- {941335200 32400 0 YAKT}
- {954036000 36000 1 YAKST}
- {972784800 32400 0 YAKT}
- {985485600 36000 1 YAKST}
- {1004234400 32400 0 YAKT}
- {1017540000 36000 1 YAKST}
- {1035684000 32400 0 YAKT}
- {1048989600 36000 1 YAKST}
- {1067133600 32400 0 YAKT}
- {1080439200 36000 1 YAKST}
- {1099188000 32400 0 YAKT}
- {1111888800 36000 1 YAKST}
- {1130637600 32400 0 YAKT}
- {1143338400 36000 1 YAKST}
- {1162087200 32400 0 YAKT}
- {1174788000 36000 1 YAKST}
- {1193536800 32400 0 YAKT}
- {1206842400 36000 1 YAKST}
- {1224986400 32400 0 YAKT}
- {1238292000 36000 1 YAKST}
- {1256436000 32400 0 YAKT}
- {1269741600 36000 1 YAKST}
- {1288490400 32400 0 YAKT}
- {1301191200 36000 1 YAKST}
- {1319940000 32400 0 YAKT}
- {1332640800 36000 1 YAKST}
- {1351389600 32400 0 YAKT}
- {1364695200 36000 1 YAKST}
- {1382839200 32400 0 YAKT}
- {1396144800 36000 1 YAKST}
- {1414288800 32400 0 YAKT}
- {1427594400 36000 1 YAKST}
- {1445738400 32400 0 YAKT}
- {1459044000 36000 1 YAKST}
- {1477792800 32400 0 YAKT}
- {1490493600 36000 1 YAKST}
- {1509242400 32400 0 YAKT}
- {1521943200 36000 1 YAKST}
- {1540692000 32400 0 YAKT}
- {1553997600 36000 1 YAKST}
- {1572141600 32400 0 YAKT}
- {1585447200 36000 1 YAKST}
- {1603591200 32400 0 YAKT}
- {1616896800 36000 1 YAKST}
- {1635645600 32400 0 YAKT}
- {1648346400 36000 1 YAKST}
- {1667095200 32400 0 YAKT}
- {1679796000 36000 1 YAKST}
- {1698544800 32400 0 YAKT}
- {1711850400 36000 1 YAKST}
- {1729994400 32400 0 YAKT}
- {1743300000 36000 1 YAKST}
- {1761444000 32400 0 YAKT}
- {1774749600 36000 1 YAKST}
- {1792893600 32400 0 YAKT}
- {1806199200 36000 1 YAKST}
- {1824948000 32400 0 YAKT}
- {1837648800 36000 1 YAKST}
- {1856397600 32400 0 YAKT}
- {1869098400 36000 1 YAKST}
- {1887847200 32400 0 YAKT}
- {1901152800 36000 1 YAKST}
- {1919296800 32400 0 YAKT}
- {1932602400 36000 1 YAKST}
- {1950746400 32400 0 YAKT}
- {1964052000 36000 1 YAKST}
- {1982800800 32400 0 YAKT}
- {1995501600 36000 1 YAKST}
- {2014250400 32400 0 YAKT}
- {2026951200 36000 1 YAKST}
- {2045700000 32400 0 YAKT}
- {2058400800 36000 1 YAKST}
- {2077149600 32400 0 YAKT}
- {2090455200 36000 1 YAKST}
- {2108599200 32400 0 YAKT}
- {2121904800 36000 1 YAKST}
- {2140048800 32400 0 YAKT}
- {2153354400 36000 1 YAKST}
- {2172103200 32400 0 YAKT}
- {2184804000 36000 1 YAKST}
- {2203552800 32400 0 YAKT}
- {2216253600 36000 1 YAKST}
- {2235002400 32400 0 YAKT}
- {2248308000 36000 1 YAKST}
- {2266452000 32400 0 YAKT}
- {2279757600 36000 1 YAKST}
- {2297901600 32400 0 YAKT}
- {2311207200 36000 1 YAKST}
- {2329351200 32400 0 YAKT}
- {2342656800 36000 1 YAKST}
- {2361405600 32400 0 YAKT}
- {2374106400 36000 1 YAKST}
- {2392855200 32400 0 YAKT}
- {2405556000 36000 1 YAKST}
- {2424304800 32400 0 YAKT}
- {2437610400 36000 1 YAKST}
- {2455754400 32400 0 YAKT}
- {2469060000 36000 1 YAKST}
- {2487204000 32400 0 YAKT}
- {2500509600 36000 1 YAKST}
- {2519258400 32400 0 YAKT}
- {2531959200 36000 1 YAKST}
- {2550708000 32400 0 YAKT}
- {2563408800 36000 1 YAKST}
- {2582157600 32400 0 YAKT}
- {2595463200 36000 1 YAKST}
- {2613607200 32400 0 YAKT}
- {2626912800 36000 1 YAKST}
- {2645056800 32400 0 YAKT}
- {2658362400 36000 1 YAKST}
- {2676506400 32400 0 YAKT}
- {2689812000 36000 1 YAKST}
- {2708560800 32400 0 YAKT}
- {2721261600 36000 1 YAKST}
- {2740010400 32400 0 YAKT}
- {2752711200 36000 1 YAKST}
- {2771460000 32400 0 YAKT}
- {2784765600 36000 1 YAKST}
- {2802909600 32400 0 YAKT}
- {2816215200 36000 1 YAKST}
- {2834359200 32400 0 YAKT}
- {2847664800 36000 1 YAKST}
- {2866413600 32400 0 YAKT}
- {2879114400 36000 1 YAKST}
- {2897863200 32400 0 YAKT}
- {2910564000 36000 1 YAKST}
- {2929312800 32400 0 YAKT}
- {2942013600 36000 1 YAKST}
- {2960762400 32400 0 YAKT}
- {2974068000 36000 1 YAKST}
- {2992212000 32400 0 YAKT}
- {3005517600 36000 1 YAKST}
- {3023661600 32400 0 YAKT}
- {3036967200 36000 1 YAKST}
- {3055716000 32400 0 YAKT}
- {3068416800 36000 1 YAKST}
- {3087165600 32400 0 YAKT}
- {3099866400 36000 1 YAKST}
- {3118615200 32400 0 YAKT}
- {3131920800 36000 1 YAKST}
- {3150064800 32400 0 YAKT}
- {3163370400 36000 1 YAKST}
- {3181514400 32400 0 YAKT}
- {3194820000 36000 1 YAKST}
- {3212964000 32400 0 YAKT}
- {3226269600 36000 1 YAKST}
- {3245018400 32400 0 YAKT}
- {3257719200 36000 1 YAKST}
- {3276468000 32400 0 YAKT}
- {3289168800 36000 1 YAKST}
- {3307917600 32400 0 YAKT}
- {3321223200 36000 1 YAKST}
- {3339367200 32400 0 YAKT}
- {3352672800 36000 1 YAKST}
- {3370816800 32400 0 YAKT}
- {3384122400 36000 1 YAKST}
- {3402871200 32400 0 YAKT}
- {3415572000 36000 1 YAKST}
- {3434320800 32400 0 YAKT}
- {3447021600 36000 1 YAKST}
- {3465770400 32400 0 YAKT}
- {3479076000 36000 1 YAKST}
- {3497220000 32400 0 YAKT}
- {3510525600 36000 1 YAKST}
- {3528669600 32400 0 YAKT}
- {3541975200 36000 1 YAKST}
- {3560119200 32400 0 YAKT}
- {3573424800 36000 1 YAKST}
- {3592173600 32400 0 YAKT}
- {3604874400 36000 1 YAKST}
- {3623623200 32400 0 YAKT}
- {3636324000 36000 1 YAKST}
- {3655072800 32400 0 YAKT}
- {3668378400 36000 1 YAKST}
- {3686522400 32400 0 YAKT}
- {3699828000 36000 1 YAKST}
- {3717972000 32400 0 YAKT}
- {3731277600 36000 1 YAKST}
- {3750026400 32400 0 YAKT}
- {3762727200 36000 1 YAKST}
- {3781476000 32400 0 YAKT}
- {3794176800 36000 1 YAKST}
- {3812925600 32400 0 YAKT}
- {3825626400 36000 1 YAKST}
- {3844375200 32400 0 YAKT}
- {3857680800 36000 1 YAKST}
- {3875824800 32400 0 YAKT}
- {3889130400 36000 1 YAKST}
- {3907274400 32400 0 YAKT}
- {3920580000 36000 1 YAKST}
- {3939328800 32400 0 YAKT}
- {3952029600 36000 1 YAKST}
- {3970778400 32400 0 YAKT}
- {3983479200 36000 1 YAKST}
- {4002228000 32400 0 YAKT}
- {4015533600 36000 1 YAKST}
- {4033677600 32400 0 YAKT}
- {4046983200 36000 1 YAKST}
- {4065127200 32400 0 YAKT}
- {4078432800 36000 1 YAKST}
- {4096576800 32400 0 YAKT}
+ {733251600 36000 1 YAKST}
+ {748976400 32400 0 YAKT}
+ {764701200 36000 1 YAKST}
+ {780426000 32400 0 YAKT}
+ {796150800 36000 1 YAKST}
+ {811875600 32400 0 YAKT}
+ {828205200 36000 1 YAKST}
+ {846349200 32400 0 YAKT}
+ {859654800 36000 1 YAKST}
+ {877798800 32400 0 YAKT}
+ {891104400 36000 1 YAKST}
+ {909248400 32400 0 YAKT}
+ {922554000 36000 1 YAKST}
+ {941302800 32400 0 YAKT}
+ {954003600 36000 1 YAKST}
+ {972752400 32400 0 YAKT}
+ {985453200 36000 1 YAKST}
+ {1004202000 32400 0 YAKT}
+ {1017507600 36000 1 YAKST}
+ {1035651600 32400 0 YAKT}
+ {1048957200 36000 1 YAKST}
+ {1067101200 32400 0 YAKT}
+ {1080406800 36000 1 YAKST}
+ {1099155600 32400 0 YAKT}
+ {1111856400 36000 1 YAKST}
+ {1130605200 32400 0 YAKT}
+ {1143306000 36000 1 YAKST}
+ {1162054800 32400 0 YAKT}
+ {1174755600 36000 1 YAKST}
+ {1193504400 32400 0 YAKT}
+ {1206810000 36000 1 YAKST}
+ {1224954000 32400 0 YAKT}
+ {1238259600 36000 1 YAKST}
+ {1256403600 32400 0 YAKT}
+ {1269709200 36000 1 YAKST}
+ {1288458000 32400 0 YAKT}
+ {1301158800 36000 0 YAKT}
}
diff --git a/library/tzdata/Asia/Yekaterinburg b/library/tzdata/Asia/Yekaterinburg
index 756a854..2045496 100644
--- a/library/tzdata/Asia/Yekaterinburg
+++ b/library/tzdata/Asia/Yekaterinburg
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Yekaterinburg) {
{-9223372036854775808 14544 0 LMT}
@@ -11,236 +11,60 @@ set TZData(:Asia/Yekaterinburg) {
{417985200 21600 1 SVEST}
{433792800 18000 0 SVET}
{449607600 21600 1 SVEST}
- {465357600 18000 0 SVET}
- {481082400 21600 1 SVEST}
- {496807200 18000 0 SVET}
- {512532000 21600 1 SVEST}
- {528256800 18000 0 SVET}
- {543981600 21600 1 SVEST}
- {559706400 18000 0 SVET}
- {575431200 21600 1 SVEST}
- {591156000 18000 0 SVET}
- {606880800 21600 1 SVEST}
- {622605600 18000 0 SVET}
- {638330400 21600 1 SVEST}
- {654660000 18000 0 SVET}
- {670384800 18000 0 SVEST}
- {686109600 14400 0 SVET}
- {695786400 18000 0 YEKMMTT}
+ {465339600 18000 0 SVET}
+ {481064400 21600 1 SVEST}
+ {496789200 18000 0 SVET}
+ {512514000 21600 1 SVEST}
+ {528238800 18000 0 SVET}
+ {543963600 21600 1 SVEST}
+ {559688400 18000 0 SVET}
+ {575413200 21600 1 SVEST}
+ {591138000 18000 0 SVET}
+ {606862800 21600 1 SVEST}
+ {622587600 18000 0 SVET}
+ {638312400 21600 1 SVEST}
+ {654642000 18000 0 SVET}
+ {670366800 14400 0 SVEMMTT}
+ {670370400 18000 1 SVEST}
+ {686095200 14400 0 SVET}
+ {695772000 18000 0 YEKMMTT}
{701805600 21600 1 YEKST}
{717526800 18000 0 YEKT}
- {733284000 21600 1 YEKST}
- {749008800 18000 0 YEKT}
- {764733600 21600 1 YEKST}
- {780458400 18000 0 YEKT}
- {796183200 21600 1 YEKST}
- {811908000 18000 0 YEKT}
- {828237600 21600 1 YEKST}
- {846381600 18000 0 YEKT}
- {859687200 21600 1 YEKST}
- {877831200 18000 0 YEKT}
- {891136800 21600 1 YEKST}
- {909280800 18000 0 YEKT}
- {922586400 21600 1 YEKST}
- {941335200 18000 0 YEKT}
- {954036000 21600 1 YEKST}
- {972784800 18000 0 YEKT}
- {985485600 21600 1 YEKST}
- {1004234400 18000 0 YEKT}
- {1017540000 21600 1 YEKST}
- {1035684000 18000 0 YEKT}
- {1048989600 21600 1 YEKST}
- {1067133600 18000 0 YEKT}
- {1080439200 21600 1 YEKST}
- {1099188000 18000 0 YEKT}
- {1111888800 21600 1 YEKST}
- {1130637600 18000 0 YEKT}
- {1143338400 21600 1 YEKST}
- {1162087200 18000 0 YEKT}
- {1174788000 21600 1 YEKST}
- {1193536800 18000 0 YEKT}
- {1206842400 21600 1 YEKST}
- {1224986400 18000 0 YEKT}
- {1238292000 21600 1 YEKST}
- {1256436000 18000 0 YEKT}
- {1269741600 21600 1 YEKST}
- {1288490400 18000 0 YEKT}
- {1301191200 21600 1 YEKST}
- {1319940000 18000 0 YEKT}
- {1332640800 21600 1 YEKST}
- {1351389600 18000 0 YEKT}
- {1364695200 21600 1 YEKST}
- {1382839200 18000 0 YEKT}
- {1396144800 21600 1 YEKST}
- {1414288800 18000 0 YEKT}
- {1427594400 21600 1 YEKST}
- {1445738400 18000 0 YEKT}
- {1459044000 21600 1 YEKST}
- {1477792800 18000 0 YEKT}
- {1490493600 21600 1 YEKST}
- {1509242400 18000 0 YEKT}
- {1521943200 21600 1 YEKST}
- {1540692000 18000 0 YEKT}
- {1553997600 21600 1 YEKST}
- {1572141600 18000 0 YEKT}
- {1585447200 21600 1 YEKST}
- {1603591200 18000 0 YEKT}
- {1616896800 21600 1 YEKST}
- {1635645600 18000 0 YEKT}
- {1648346400 21600 1 YEKST}
- {1667095200 18000 0 YEKT}
- {1679796000 21600 1 YEKST}
- {1698544800 18000 0 YEKT}
- {1711850400 21600 1 YEKST}
- {1729994400 18000 0 YEKT}
- {1743300000 21600 1 YEKST}
- {1761444000 18000 0 YEKT}
- {1774749600 21600 1 YEKST}
- {1792893600 18000 0 YEKT}
- {1806199200 21600 1 YEKST}
- {1824948000 18000 0 YEKT}
- {1837648800 21600 1 YEKST}
- {1856397600 18000 0 YEKT}
- {1869098400 21600 1 YEKST}
- {1887847200 18000 0 YEKT}
- {1901152800 21600 1 YEKST}
- {1919296800 18000 0 YEKT}
- {1932602400 21600 1 YEKST}
- {1950746400 18000 0 YEKT}
- {1964052000 21600 1 YEKST}
- {1982800800 18000 0 YEKT}
- {1995501600 21600 1 YEKST}
- {2014250400 18000 0 YEKT}
- {2026951200 21600 1 YEKST}
- {2045700000 18000 0 YEKT}
- {2058400800 21600 1 YEKST}
- {2077149600 18000 0 YEKT}
- {2090455200 21600 1 YEKST}
- {2108599200 18000 0 YEKT}
- {2121904800 21600 1 YEKST}
- {2140048800 18000 0 YEKT}
- {2153354400 21600 1 YEKST}
- {2172103200 18000 0 YEKT}
- {2184804000 21600 1 YEKST}
- {2203552800 18000 0 YEKT}
- {2216253600 21600 1 YEKST}
- {2235002400 18000 0 YEKT}
- {2248308000 21600 1 YEKST}
- {2266452000 18000 0 YEKT}
- {2279757600 21600 1 YEKST}
- {2297901600 18000 0 YEKT}
- {2311207200 21600 1 YEKST}
- {2329351200 18000 0 YEKT}
- {2342656800 21600 1 YEKST}
- {2361405600 18000 0 YEKT}
- {2374106400 21600 1 YEKST}
- {2392855200 18000 0 YEKT}
- {2405556000 21600 1 YEKST}
- {2424304800 18000 0 YEKT}
- {2437610400 21600 1 YEKST}
- {2455754400 18000 0 YEKT}
- {2469060000 21600 1 YEKST}
- {2487204000 18000 0 YEKT}
- {2500509600 21600 1 YEKST}
- {2519258400 18000 0 YEKT}
- {2531959200 21600 1 YEKST}
- {2550708000 18000 0 YEKT}
- {2563408800 21600 1 YEKST}
- {2582157600 18000 0 YEKT}
- {2595463200 21600 1 YEKST}
- {2613607200 18000 0 YEKT}
- {2626912800 21600 1 YEKST}
- {2645056800 18000 0 YEKT}
- {2658362400 21600 1 YEKST}
- {2676506400 18000 0 YEKT}
- {2689812000 21600 1 YEKST}
- {2708560800 18000 0 YEKT}
- {2721261600 21600 1 YEKST}
- {2740010400 18000 0 YEKT}
- {2752711200 21600 1 YEKST}
- {2771460000 18000 0 YEKT}
- {2784765600 21600 1 YEKST}
- {2802909600 18000 0 YEKT}
- {2816215200 21600 1 YEKST}
- {2834359200 18000 0 YEKT}
- {2847664800 21600 1 YEKST}
- {2866413600 18000 0 YEKT}
- {2879114400 21600 1 YEKST}
- {2897863200 18000 0 YEKT}
- {2910564000 21600 1 YEKST}
- {2929312800 18000 0 YEKT}
- {2942013600 21600 1 YEKST}
- {2960762400 18000 0 YEKT}
- {2974068000 21600 1 YEKST}
- {2992212000 18000 0 YEKT}
- {3005517600 21600 1 YEKST}
- {3023661600 18000 0 YEKT}
- {3036967200 21600 1 YEKST}
- {3055716000 18000 0 YEKT}
- {3068416800 21600 1 YEKST}
- {3087165600 18000 0 YEKT}
- {3099866400 21600 1 YEKST}
- {3118615200 18000 0 YEKT}
- {3131920800 21600 1 YEKST}
- {3150064800 18000 0 YEKT}
- {3163370400 21600 1 YEKST}
- {3181514400 18000 0 YEKT}
- {3194820000 21600 1 YEKST}
- {3212964000 18000 0 YEKT}
- {3226269600 21600 1 YEKST}
- {3245018400 18000 0 YEKT}
- {3257719200 21600 1 YEKST}
- {3276468000 18000 0 YEKT}
- {3289168800 21600 1 YEKST}
- {3307917600 18000 0 YEKT}
- {3321223200 21600 1 YEKST}
- {3339367200 18000 0 YEKT}
- {3352672800 21600 1 YEKST}
- {3370816800 18000 0 YEKT}
- {3384122400 21600 1 YEKST}
- {3402871200 18000 0 YEKT}
- {3415572000 21600 1 YEKST}
- {3434320800 18000 0 YEKT}
- {3447021600 21600 1 YEKST}
- {3465770400 18000 0 YEKT}
- {3479076000 21600 1 YEKST}
- {3497220000 18000 0 YEKT}
- {3510525600 21600 1 YEKST}
- {3528669600 18000 0 YEKT}
- {3541975200 21600 1 YEKST}
- {3560119200 18000 0 YEKT}
- {3573424800 21600 1 YEKST}
- {3592173600 18000 0 YEKT}
- {3604874400 21600 1 YEKST}
- {3623623200 18000 0 YEKT}
- {3636324000 21600 1 YEKST}
- {3655072800 18000 0 YEKT}
- {3668378400 21600 1 YEKST}
- {3686522400 18000 0 YEKT}
- {3699828000 21600 1 YEKST}
- {3717972000 18000 0 YEKT}
- {3731277600 21600 1 YEKST}
- {3750026400 18000 0 YEKT}
- {3762727200 21600 1 YEKST}
- {3781476000 18000 0 YEKT}
- {3794176800 21600 1 YEKST}
- {3812925600 18000 0 YEKT}
- {3825626400 21600 1 YEKST}
- {3844375200 18000 0 YEKT}
- {3857680800 21600 1 YEKST}
- {3875824800 18000 0 YEKT}
- {3889130400 21600 1 YEKST}
- {3907274400 18000 0 YEKT}
- {3920580000 21600 1 YEKST}
- {3939328800 18000 0 YEKT}
- {3952029600 21600 1 YEKST}
- {3970778400 18000 0 YEKT}
- {3983479200 21600 1 YEKST}
- {4002228000 18000 0 YEKT}
- {4015533600 21600 1 YEKST}
- {4033677600 18000 0 YEKT}
- {4046983200 21600 1 YEKST}
- {4065127200 18000 0 YEKT}
- {4078432800 21600 1 YEKST}
- {4096576800 18000 0 YEKT}
+ {733266000 21600 1 YEKST}
+ {748990800 18000 0 YEKT}
+ {764715600 21600 1 YEKST}
+ {780440400 18000 0 YEKT}
+ {796165200 21600 1 YEKST}
+ {811890000 18000 0 YEKT}
+ {828219600 21600 1 YEKST}
+ {846363600 18000 0 YEKT}
+ {859669200 21600 1 YEKST}
+ {877813200 18000 0 YEKT}
+ {891118800 21600 1 YEKST}
+ {909262800 18000 0 YEKT}
+ {922568400 21600 1 YEKST}
+ {941317200 18000 0 YEKT}
+ {954018000 21600 1 YEKST}
+ {972766800 18000 0 YEKT}
+ {985467600 21600 1 YEKST}
+ {1004216400 18000 0 YEKT}
+ {1017522000 21600 1 YEKST}
+ {1035666000 18000 0 YEKT}
+ {1048971600 21600 1 YEKST}
+ {1067115600 18000 0 YEKT}
+ {1080421200 21600 1 YEKST}
+ {1099170000 18000 0 YEKT}
+ {1111870800 21600 1 YEKST}
+ {1130619600 18000 0 YEKT}
+ {1143320400 21600 1 YEKST}
+ {1162069200 18000 0 YEKT}
+ {1174770000 21600 1 YEKST}
+ {1193518800 18000 0 YEKT}
+ {1206824400 21600 1 YEKST}
+ {1224968400 18000 0 YEKT}
+ {1238274000 21600 1 YEKST}
+ {1256418000 18000 0 YEKT}
+ {1269723600 21600 1 YEKST}
+ {1288472400 18000 0 YEKT}
+ {1301173200 21600 0 YEKT}
}
diff --git a/library/tzdata/Asia/Yerevan b/library/tzdata/Asia/Yerevan
index 81316ff..22008ef 100644
--- a/library/tzdata/Asia/Yerevan
+++ b/library/tzdata/Asia/Yerevan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Yerevan) {
{-9223372036854775808 10680 0 LMT}
@@ -11,235 +11,60 @@ set TZData(:Asia/Yerevan) {
{417988800 18000 1 YERST}
{433796400 14400 0 YERT}
{449611200 18000 1 YERST}
- {465357600 14400 0 YERT}
- {481082400 18000 1 YERST}
- {496807200 14400 0 YERT}
- {512532000 18000 1 YERST}
- {528256800 14400 0 YERT}
- {543981600 18000 1 YERST}
- {559706400 14400 0 YERT}
- {575431200 18000 1 YERST}
- {591156000 14400 0 YERT}
- {606880800 18000 1 YERST}
- {622605600 14400 0 YERT}
- {638330400 18000 1 YERST}
- {654660000 14400 0 YERT}
- {670384800 14400 1 YERST}
+ {465343200 14400 0 YERT}
+ {481068000 18000 1 YERST}
+ {496792800 14400 0 YERT}
+ {512517600 18000 1 YERST}
+ {528242400 14400 0 YERT}
+ {543967200 18000 1 YERST}
+ {559692000 14400 0 YERT}
+ {575416800 18000 1 YERST}
+ {591141600 14400 0 YERT}
+ {606866400 18000 1 YERST}
+ {622591200 14400 0 YERT}
+ {638316000 18000 1 YERST}
+ {654645600 14400 0 YERT}
+ {670370400 14400 1 YERST}
{685569600 14400 0 AMST}
- {686109600 10800 0 AMT}
+ {686098800 10800 0 AMT}
{701812800 14400 1 AMST}
{717534000 10800 0 AMT}
- {733284000 14400 1 AMST}
- {749008800 10800 0 AMT}
- {764733600 14400 1 AMST}
- {780458400 10800 0 AMT}
- {796183200 14400 1 AMST}
- {811908000 14400 0 AMT}
+ {733273200 14400 1 AMST}
+ {748998000 10800 0 AMT}
+ {764722800 14400 1 AMST}
+ {780447600 10800 0 AMT}
+ {796172400 14400 1 AMST}
+ {811897200 14400 0 AMT}
{852062400 14400 0 AMT}
- {859687200 18000 1 AMST}
- {877831200 14400 0 AMT}
- {891136800 18000 1 AMST}
- {909280800 14400 0 AMT}
- {922586400 18000 1 AMST}
- {941335200 14400 0 AMT}
- {954036000 18000 1 AMST}
- {972784800 14400 0 AMT}
- {985485600 18000 1 AMST}
- {1004234400 14400 0 AMT}
- {1017540000 18000 1 AMST}
- {1035684000 14400 0 AMT}
- {1048989600 18000 1 AMST}
- {1067133600 14400 0 AMT}
- {1080439200 18000 1 AMST}
- {1099188000 14400 0 AMT}
- {1111888800 18000 1 AMST}
- {1130637600 14400 0 AMT}
- {1143338400 18000 1 AMST}
- {1162087200 14400 0 AMT}
- {1174788000 18000 1 AMST}
- {1193536800 14400 0 AMT}
- {1206842400 18000 1 AMST}
- {1224986400 14400 0 AMT}
- {1238292000 18000 1 AMST}
- {1256436000 14400 0 AMT}
- {1269741600 18000 1 AMST}
- {1288490400 14400 0 AMT}
- {1301191200 18000 1 AMST}
- {1319940000 14400 0 AMT}
- {1332640800 18000 1 AMST}
- {1351389600 14400 0 AMT}
- {1364695200 18000 1 AMST}
- {1382839200 14400 0 AMT}
- {1396144800 18000 1 AMST}
- {1414288800 14400 0 AMT}
- {1427594400 18000 1 AMST}
- {1445738400 14400 0 AMT}
- {1459044000 18000 1 AMST}
- {1477792800 14400 0 AMT}
- {1490493600 18000 1 AMST}
- {1509242400 14400 0 AMT}
- {1521943200 18000 1 AMST}
- {1540692000 14400 0 AMT}
- {1553997600 18000 1 AMST}
- {1572141600 14400 0 AMT}
- {1585447200 18000 1 AMST}
- {1603591200 14400 0 AMT}
- {1616896800 18000 1 AMST}
- {1635645600 14400 0 AMT}
- {1648346400 18000 1 AMST}
- {1667095200 14400 0 AMT}
- {1679796000 18000 1 AMST}
- {1698544800 14400 0 AMT}
- {1711850400 18000 1 AMST}
- {1729994400 14400 0 AMT}
- {1743300000 18000 1 AMST}
- {1761444000 14400 0 AMT}
- {1774749600 18000 1 AMST}
- {1792893600 14400 0 AMT}
- {1806199200 18000 1 AMST}
- {1824948000 14400 0 AMT}
- {1837648800 18000 1 AMST}
- {1856397600 14400 0 AMT}
- {1869098400 18000 1 AMST}
- {1887847200 14400 0 AMT}
- {1901152800 18000 1 AMST}
- {1919296800 14400 0 AMT}
- {1932602400 18000 1 AMST}
- {1950746400 14400 0 AMT}
- {1964052000 18000 1 AMST}
- {1982800800 14400 0 AMT}
- {1995501600 18000 1 AMST}
- {2014250400 14400 0 AMT}
- {2026951200 18000 1 AMST}
- {2045700000 14400 0 AMT}
- {2058400800 18000 1 AMST}
- {2077149600 14400 0 AMT}
- {2090455200 18000 1 AMST}
- {2108599200 14400 0 AMT}
- {2121904800 18000 1 AMST}
- {2140048800 14400 0 AMT}
- {2153354400 18000 1 AMST}
- {2172103200 14400 0 AMT}
- {2184804000 18000 1 AMST}
- {2203552800 14400 0 AMT}
- {2216253600 18000 1 AMST}
- {2235002400 14400 0 AMT}
- {2248308000 18000 1 AMST}
- {2266452000 14400 0 AMT}
- {2279757600 18000 1 AMST}
- {2297901600 14400 0 AMT}
- {2311207200 18000 1 AMST}
- {2329351200 14400 0 AMT}
- {2342656800 18000 1 AMST}
- {2361405600 14400 0 AMT}
- {2374106400 18000 1 AMST}
- {2392855200 14400 0 AMT}
- {2405556000 18000 1 AMST}
- {2424304800 14400 0 AMT}
- {2437610400 18000 1 AMST}
- {2455754400 14400 0 AMT}
- {2469060000 18000 1 AMST}
- {2487204000 14400 0 AMT}
- {2500509600 18000 1 AMST}
- {2519258400 14400 0 AMT}
- {2531959200 18000 1 AMST}
- {2550708000 14400 0 AMT}
- {2563408800 18000 1 AMST}
- {2582157600 14400 0 AMT}
- {2595463200 18000 1 AMST}
- {2613607200 14400 0 AMT}
- {2626912800 18000 1 AMST}
- {2645056800 14400 0 AMT}
- {2658362400 18000 1 AMST}
- {2676506400 14400 0 AMT}
- {2689812000 18000 1 AMST}
- {2708560800 14400 0 AMT}
- {2721261600 18000 1 AMST}
- {2740010400 14400 0 AMT}
- {2752711200 18000 1 AMST}
- {2771460000 14400 0 AMT}
- {2784765600 18000 1 AMST}
- {2802909600 14400 0 AMT}
- {2816215200 18000 1 AMST}
- {2834359200 14400 0 AMT}
- {2847664800 18000 1 AMST}
- {2866413600 14400 0 AMT}
- {2879114400 18000 1 AMST}
- {2897863200 14400 0 AMT}
- {2910564000 18000 1 AMST}
- {2929312800 14400 0 AMT}
- {2942013600 18000 1 AMST}
- {2960762400 14400 0 AMT}
- {2974068000 18000 1 AMST}
- {2992212000 14400 0 AMT}
- {3005517600 18000 1 AMST}
- {3023661600 14400 0 AMT}
- {3036967200 18000 1 AMST}
- {3055716000 14400 0 AMT}
- {3068416800 18000 1 AMST}
- {3087165600 14400 0 AMT}
- {3099866400 18000 1 AMST}
- {3118615200 14400 0 AMT}
- {3131920800 18000 1 AMST}
- {3150064800 14400 0 AMT}
- {3163370400 18000 1 AMST}
- {3181514400 14400 0 AMT}
- {3194820000 18000 1 AMST}
- {3212964000 14400 0 AMT}
- {3226269600 18000 1 AMST}
- {3245018400 14400 0 AMT}
- {3257719200 18000 1 AMST}
- {3276468000 14400 0 AMT}
- {3289168800 18000 1 AMST}
- {3307917600 14400 0 AMT}
- {3321223200 18000 1 AMST}
- {3339367200 14400 0 AMT}
- {3352672800 18000 1 AMST}
- {3370816800 14400 0 AMT}
- {3384122400 18000 1 AMST}
- {3402871200 14400 0 AMT}
- {3415572000 18000 1 AMST}
- {3434320800 14400 0 AMT}
- {3447021600 18000 1 AMST}
- {3465770400 14400 0 AMT}
- {3479076000 18000 1 AMST}
- {3497220000 14400 0 AMT}
- {3510525600 18000 1 AMST}
- {3528669600 14400 0 AMT}
- {3541975200 18000 1 AMST}
- {3560119200 14400 0 AMT}
- {3573424800 18000 1 AMST}
- {3592173600 14400 0 AMT}
- {3604874400 18000 1 AMST}
- {3623623200 14400 0 AMT}
- {3636324000 18000 1 AMST}
- {3655072800 14400 0 AMT}
- {3668378400 18000 1 AMST}
- {3686522400 14400 0 AMT}
- {3699828000 18000 1 AMST}
- {3717972000 14400 0 AMT}
- {3731277600 18000 1 AMST}
- {3750026400 14400 0 AMT}
- {3762727200 18000 1 AMST}
- {3781476000 14400 0 AMT}
- {3794176800 18000 1 AMST}
- {3812925600 14400 0 AMT}
- {3825626400 18000 1 AMST}
- {3844375200 14400 0 AMT}
- {3857680800 18000 1 AMST}
- {3875824800 14400 0 AMT}
- {3889130400 18000 1 AMST}
- {3907274400 14400 0 AMT}
- {3920580000 18000 1 AMST}
- {3939328800 14400 0 AMT}
- {3952029600 18000 1 AMST}
- {3970778400 14400 0 AMT}
- {3983479200 18000 1 AMST}
- {4002228000 14400 0 AMT}
- {4015533600 18000 1 AMST}
- {4033677600 14400 0 AMT}
- {4046983200 18000 1 AMST}
- {4065127200 14400 0 AMT}
- {4078432800 18000 1 AMST}
- {4096576800 14400 0 AMT}
+ {859672800 18000 1 AMST}
+ {877816800 14400 0 AMT}
+ {891122400 18000 1 AMST}
+ {909266400 14400 0 AMT}
+ {922572000 18000 1 AMST}
+ {941320800 14400 0 AMT}
+ {954021600 18000 1 AMST}
+ {972770400 14400 0 AMT}
+ {985471200 18000 1 AMST}
+ {1004220000 14400 0 AMT}
+ {1017525600 18000 1 AMST}
+ {1035669600 14400 0 AMT}
+ {1048975200 18000 1 AMST}
+ {1067119200 14400 0 AMT}
+ {1080424800 18000 1 AMST}
+ {1099173600 14400 0 AMT}
+ {1111874400 18000 1 AMST}
+ {1130623200 14400 0 AMT}
+ {1143324000 18000 1 AMST}
+ {1162072800 14400 0 AMT}
+ {1174773600 18000 1 AMST}
+ {1193522400 14400 0 AMT}
+ {1206828000 18000 1 AMST}
+ {1224972000 14400 0 AMT}
+ {1238277600 18000 1 AMST}
+ {1256421600 14400 0 AMT}
+ {1269727200 18000 1 AMST}
+ {1288476000 14400 0 AMT}
+ {1301176800 18000 1 AMST}
+ {1319925600 14400 0 AMT}
+ {1332626400 14400 0 AMT}
}
diff --git a/library/tzdata/Atlantic/Azores b/library/tzdata/Atlantic/Azores
index 6468e5c..c476191 100644
--- a/library/tzdata/Atlantic/Azores
+++ b/library/tzdata/Atlantic/Azores
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Azores) {
{-9223372036854775808 -6160 0 LMT}
@@ -6,132 +6,132 @@ set TZData(:Atlantic/Azores) {
{-1849557928 -7200 0 AZOT}
{-1689548400 -3600 1 AZOST}
{-1677794400 -7200 0 AZOT}
- {-1667437200 -3600 1 AZOST}
- {-1647738000 -7200 0 AZOT}
- {-1635814800 -3600 1 AZOST}
- {-1616202000 -7200 0 AZOT}
- {-1604365200 -3600 1 AZOST}
- {-1584666000 -7200 0 AZOT}
- {-1572742800 -3600 1 AZOST}
- {-1553043600 -7200 0 AZOT}
- {-1541206800 -3600 1 AZOST}
- {-1521507600 -7200 0 AZOT}
- {-1442451600 -3600 1 AZOST}
- {-1426813200 -7200 0 AZOT}
- {-1379293200 -3600 1 AZOST}
- {-1364778000 -7200 0 AZOT}
- {-1348448400 -3600 1 AZOST}
- {-1333328400 -7200 0 AZOT}
- {-1316394000 -3600 1 AZOST}
- {-1301274000 -7200 0 AZOT}
- {-1284339600 -3600 1 AZOST}
- {-1269824400 -7200 0 AZOT}
- {-1221440400 -3600 1 AZOST}
- {-1206925200 -7200 0 AZOT}
- {-1191200400 -3600 1 AZOST}
- {-1175475600 -7200 0 AZOT}
- {-1127696400 -3600 1 AZOST}
- {-1111971600 -7200 0 AZOT}
- {-1096851600 -3600 1 AZOST}
- {-1080522000 -7200 0 AZOT}
- {-1063587600 -3600 1 AZOST}
- {-1049072400 -7200 0 AZOT}
- {-1033347600 -3600 1 AZOST}
- {-1017622800 -7200 0 AZOT}
- {-1002502800 -3600 1 AZOST}
- {-986173200 -7200 0 AZOT}
- {-969238800 -3600 1 AZOST}
- {-950490000 -7200 0 AZOT}
- {-942022800 -3600 1 AZOST}
- {-922669200 -7200 0 AZOT}
- {-906944400 -3600 1 AZOST}
- {-891133200 -7200 0 AZOT}
- {-877309200 -3600 1 AZOST}
- {-873684000 0 1 AZOMT}
- {-864007200 -3600 1 AZOST}
- {-857955600 -7200 0 AZOT}
- {-845859600 -3600 1 AZOST}
- {-842839200 0 1 AZOMT}
- {-831348000 -3600 1 AZOST}
- {-825901200 -7200 0 AZOT}
- {-814410000 -3600 1 AZOST}
- {-810784800 0 1 AZOMT}
- {-799898400 -3600 1 AZOST}
- {-794451600 -7200 0 AZOT}
- {-782960400 -3600 1 AZOST}
- {-779335200 0 1 AZOMT}
- {-768448800 -3600 1 AZOST}
- {-763002000 -7200 0 AZOT}
- {-749091600 -3600 1 AZOST}
- {-733366800 -7200 0 AZOT}
- {-717631200 -3600 1 AZOST}
- {-701906400 -7200 0 AZOT}
- {-686181600 -3600 1 AZOST}
- {-670456800 -7200 0 AZOT}
- {-654732000 -3600 1 AZOST}
- {-639007200 -7200 0 AZOT}
- {-591832800 -3600 1 AZOST}
- {-575503200 -7200 0 AZOT}
- {-559778400 -3600 1 AZOST}
- {-544053600 -7200 0 AZOT}
- {-528328800 -3600 1 AZOST}
- {-512604000 -7200 0 AZOT}
- {-496879200 -3600 1 AZOST}
- {-481154400 -7200 0 AZOT}
- {-465429600 -3600 1 AZOST}
- {-449704800 -7200 0 AZOT}
- {-433980000 -3600 1 AZOST}
- {-417650400 -7200 0 AZOT}
- {-401925600 -3600 1 AZOST}
- {-386200800 -7200 0 AZOT}
- {-370476000 -3600 1 AZOST}
- {-354751200 -7200 0 AZOT}
- {-339026400 -3600 1 AZOST}
- {-323301600 -7200 0 AZOT}
- {-307576800 -3600 1 AZOST}
- {-291852000 -7200 0 AZOT}
- {-276127200 -3600 1 AZOST}
- {-260402400 -7200 0 AZOT}
- {-244677600 -3600 1 AZOST}
- {-228348000 -7200 0 AZOT}
- {-212623200 -3600 1 AZOST}
- {-196898400 -7200 0 AZOT}
- {-181173600 -3600 1 AZOST}
- {-165448800 -7200 0 AZOT}
- {-149724000 -3600 1 AZOST}
- {-133999200 -7200 0 AZOT}
+ {-1667430000 -3600 1 AZOST}
+ {-1647730800 -7200 0 AZOT}
+ {-1635807600 -3600 1 AZOST}
+ {-1616194800 -7200 0 AZOT}
+ {-1604358000 -3600 1 AZOST}
+ {-1584658800 -7200 0 AZOT}
+ {-1572735600 -3600 1 AZOST}
+ {-1553036400 -7200 0 AZOT}
+ {-1541199600 -3600 1 AZOST}
+ {-1521500400 -7200 0 AZOT}
+ {-1442444400 -3600 1 AZOST}
+ {-1426806000 -7200 0 AZOT}
+ {-1379286000 -3600 1 AZOST}
+ {-1364770800 -7200 0 AZOT}
+ {-1348441200 -3600 1 AZOST}
+ {-1333321200 -7200 0 AZOT}
+ {-1316386800 -3600 1 AZOST}
+ {-1301266800 -7200 0 AZOT}
+ {-1284332400 -3600 1 AZOST}
+ {-1269817200 -7200 0 AZOT}
+ {-1221433200 -3600 1 AZOST}
+ {-1206918000 -7200 0 AZOT}
+ {-1191193200 -3600 1 AZOST}
+ {-1175468400 -7200 0 AZOT}
+ {-1127689200 -3600 1 AZOST}
+ {-1111964400 -7200 0 AZOT}
+ {-1096844400 -3600 1 AZOST}
+ {-1080514800 -7200 0 AZOT}
+ {-1063580400 -3600 1 AZOST}
+ {-1049065200 -7200 0 AZOT}
+ {-1033340400 -3600 1 AZOST}
+ {-1017615600 -7200 0 AZOT}
+ {-1002495600 -3600 1 AZOST}
+ {-986166000 -7200 0 AZOT}
+ {-969231600 -3600 1 AZOST}
+ {-950482800 -7200 0 AZOT}
+ {-942015600 -3600 1 AZOST}
+ {-922662000 -7200 0 AZOT}
+ {-906937200 -3600 1 AZOST}
+ {-891126000 -7200 0 AZOT}
+ {-877302000 -3600 1 AZOST}
+ {-873676800 0 1 AZOMT}
+ {-864000000 -3600 1 AZOST}
+ {-857948400 -7200 0 AZOT}
+ {-845852400 -3600 1 AZOST}
+ {-842832000 0 1 AZOMT}
+ {-831340800 -3600 1 AZOST}
+ {-825894000 -7200 0 AZOT}
+ {-814402800 -3600 1 AZOST}
+ {-810777600 0 1 AZOMT}
+ {-799891200 -3600 1 AZOST}
+ {-794444400 -7200 0 AZOT}
+ {-782953200 -3600 1 AZOST}
+ {-779328000 0 1 AZOMT}
+ {-768441600 -3600 1 AZOST}
+ {-762994800 -7200 0 AZOT}
+ {-749084400 -3600 1 AZOST}
+ {-733359600 -7200 0 AZOT}
+ {-717624000 -3600 1 AZOST}
+ {-701899200 -7200 0 AZOT}
+ {-686174400 -3600 1 AZOST}
+ {-670449600 -7200 0 AZOT}
+ {-654724800 -3600 1 AZOST}
+ {-639000000 -7200 0 AZOT}
+ {-591825600 -3600 1 AZOST}
+ {-575496000 -7200 0 AZOT}
+ {-559771200 -3600 1 AZOST}
+ {-544046400 -7200 0 AZOT}
+ {-528321600 -3600 1 AZOST}
+ {-512596800 -7200 0 AZOT}
+ {-496872000 -3600 1 AZOST}
+ {-481147200 -7200 0 AZOT}
+ {-465422400 -3600 1 AZOST}
+ {-449697600 -7200 0 AZOT}
+ {-433972800 -3600 1 AZOST}
+ {-417643200 -7200 0 AZOT}
+ {-401918400 -3600 1 AZOST}
+ {-386193600 -7200 0 AZOT}
+ {-370468800 -3600 1 AZOST}
+ {-354744000 -7200 0 AZOT}
+ {-339019200 -3600 1 AZOST}
+ {-323294400 -7200 0 AZOT}
+ {-307569600 -3600 1 AZOST}
+ {-291844800 -7200 0 AZOT}
+ {-276120000 -3600 1 AZOST}
+ {-260395200 -7200 0 AZOT}
+ {-244670400 -3600 1 AZOST}
+ {-228340800 -7200 0 AZOT}
+ {-212616000 -3600 1 AZOST}
+ {-196891200 -7200 0 AZOT}
+ {-181166400 -3600 1 AZOST}
+ {-165441600 -7200 0 AZOT}
+ {-149716800 -3600 1 AZOST}
+ {-133992000 -7200 0 AZOT}
{-118267200 -3600 0 AZOT}
- {228268800 0 1 AZOST}
- {243993600 -3600 0 AZOT}
- {260323200 0 1 AZOST}
- {276048000 -3600 0 AZOT}
- {291772800 0 1 AZOST}
- {307501200 -3600 0 AZOT}
- {323222400 0 1 AZOST}
- {338950800 -3600 0 AZOT}
- {354675600 0 1 AZOST}
- {370400400 -3600 0 AZOT}
- {386125200 0 1 AZOST}
- {401850000 -3600 0 AZOT}
- {417578400 0 1 AZOST}
- {433299600 -3600 0 AZOT}
- {449024400 0 1 AZOST}
- {465354000 -3600 0 AZOT}
- {481078800 0 1 AZOST}
- {496803600 -3600 0 AZOT}
- {512528400 0 1 AZOST}
- {528253200 -3600 0 AZOT}
- {543978000 0 1 AZOST}
- {559702800 -3600 0 AZOT}
- {575427600 0 1 AZOST}
- {591152400 -3600 0 AZOT}
- {606877200 0 1 AZOST}
- {622602000 -3600 0 AZOT}
- {638326800 0 1 AZOST}
- {654656400 -3600 0 AZOT}
- {670381200 0 1 AZOST}
- {686106000 -3600 0 AZOT}
- {701830800 0 1 AZOST}
+ {228272400 0 1 AZOST}
+ {243997200 -3600 0 AZOT}
+ {260326800 0 1 AZOST}
+ {276051600 -3600 0 AZOT}
+ {291776400 0 1 AZOST}
+ {307504800 -3600 0 AZOT}
+ {323226000 0 1 AZOST}
+ {338954400 -3600 0 AZOT}
+ {354679200 0 1 AZOST}
+ {370404000 -3600 0 AZOT}
+ {386128800 0 1 AZOST}
+ {401853600 -3600 0 AZOT}
+ {417582000 0 1 AZOST}
+ {433303200 -3600 0 AZOT}
+ {449028000 0 1 AZOST}
+ {465357600 -3600 0 AZOT}
+ {481082400 0 1 AZOST}
+ {496807200 -3600 0 AZOT}
+ {512532000 0 1 AZOST}
+ {528256800 -3600 0 AZOT}
+ {543981600 0 1 AZOST}
+ {559706400 -3600 0 AZOT}
+ {575431200 0 1 AZOST}
+ {591156000 -3600 0 AZOT}
+ {606880800 0 1 AZOST}
+ {622605600 -3600 0 AZOT}
+ {638330400 0 1 AZOST}
+ {654660000 -3600 0 AZOT}
+ {670384800 0 1 AZOST}
+ {686109600 -3600 0 AZOT}
+ {701834400 0 1 AZOST}
{733280400 0 0 AZOST}
{749005200 -3600 0 AZOT}
{764730000 0 1 AZOST}
diff --git a/library/tzdata/Atlantic/Bermuda b/library/tzdata/Atlantic/Bermuda
index 9f340e4..2d4d983 100644
--- a/library/tzdata/Atlantic/Bermuda
+++ b/library/tzdata/Atlantic/Bermuda
@@ -1,12 +1,13 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Bermuda) {
- {-9223372036854775808 -15544 0 LMT}
- {-1262281256 -14400 0 AST}
+ {-9223372036854775808 -15558 0 LMT}
+ {-1262281242 -14400 0 AST}
{136360800 -10800 0 ADT}
{152082000 -14400 0 AST}
{167810400 -10800 1 ADT}
{183531600 -14400 0 AST}
+ {189316800 -14400 0 AST}
{199260000 -10800 1 ADT}
{215586000 -14400 0 AST}
{230709600 -10800 1 ADT}
@@ -69,190 +70,190 @@ set TZData(:Atlantic/Bermuda) {
{1130648400 -14400 0 AST}
{1143957600 -10800 1 ADT}
{1162098000 -14400 0 AST}
- {1175407200 -10800 1 ADT}
- {1193547600 -14400 0 AST}
- {1207461600 -10800 1 ADT}
- {1224997200 -14400 0 AST}
- {1238911200 -10800 1 ADT}
- {1256446800 -14400 0 AST}
- {1270360800 -10800 1 ADT}
- {1288501200 -14400 0 AST}
- {1301810400 -10800 1 ADT}
- {1319950800 -14400 0 AST}
- {1333260000 -10800 1 ADT}
- {1351400400 -14400 0 AST}
- {1365314400 -10800 1 ADT}
- {1382850000 -14400 0 AST}
- {1396764000 -10800 1 ADT}
- {1414299600 -14400 0 AST}
- {1428213600 -10800 1 ADT}
- {1445749200 -14400 0 AST}
- {1459663200 -10800 1 ADT}
- {1477803600 -14400 0 AST}
- {1491112800 -10800 1 ADT}
- {1509253200 -14400 0 AST}
- {1522562400 -10800 1 ADT}
- {1540702800 -14400 0 AST}
- {1554616800 -10800 1 ADT}
- {1572152400 -14400 0 AST}
- {1586066400 -10800 1 ADT}
- {1603602000 -14400 0 AST}
- {1617516000 -10800 1 ADT}
- {1635656400 -14400 0 AST}
- {1648965600 -10800 1 ADT}
- {1667106000 -14400 0 AST}
- {1680415200 -10800 1 ADT}
- {1698555600 -14400 0 AST}
- {1712469600 -10800 1 ADT}
- {1730005200 -14400 0 AST}
- {1743919200 -10800 1 ADT}
- {1761454800 -14400 0 AST}
- {1775368800 -10800 1 ADT}
- {1792904400 -14400 0 AST}
- {1806818400 -10800 1 ADT}
- {1824958800 -14400 0 AST}
- {1838268000 -10800 1 ADT}
- {1856408400 -14400 0 AST}
- {1869717600 -10800 1 ADT}
- {1887858000 -14400 0 AST}
- {1901772000 -10800 1 ADT}
- {1919307600 -14400 0 AST}
- {1933221600 -10800 1 ADT}
- {1950757200 -14400 0 AST}
- {1964671200 -10800 1 ADT}
- {1982811600 -14400 0 AST}
- {1996120800 -10800 1 ADT}
- {2014261200 -14400 0 AST}
- {2027570400 -10800 1 ADT}
- {2045710800 -14400 0 AST}
- {2059020000 -10800 1 ADT}
- {2077160400 -14400 0 AST}
- {2091074400 -10800 1 ADT}
- {2108610000 -14400 0 AST}
- {2122524000 -10800 1 ADT}
- {2140059600 -14400 0 AST}
- {2153973600 -10800 1 ADT}
- {2172114000 -14400 0 AST}
- {2185423200 -10800 1 ADT}
- {2203563600 -14400 0 AST}
- {2216872800 -10800 1 ADT}
- {2235013200 -14400 0 AST}
- {2248927200 -10800 1 ADT}
- {2266462800 -14400 0 AST}
- {2280376800 -10800 1 ADT}
- {2297912400 -14400 0 AST}
- {2311826400 -10800 1 ADT}
- {2329362000 -14400 0 AST}
- {2343276000 -10800 1 ADT}
- {2361416400 -14400 0 AST}
- {2374725600 -10800 1 ADT}
- {2392866000 -14400 0 AST}
- {2406175200 -10800 1 ADT}
- {2424315600 -14400 0 AST}
- {2438229600 -10800 1 ADT}
- {2455765200 -14400 0 AST}
- {2469679200 -10800 1 ADT}
- {2487214800 -14400 0 AST}
- {2501128800 -10800 1 ADT}
- {2519269200 -14400 0 AST}
- {2532578400 -10800 1 ADT}
- {2550718800 -14400 0 AST}
- {2564028000 -10800 1 ADT}
- {2582168400 -14400 0 AST}
- {2596082400 -10800 1 ADT}
- {2613618000 -14400 0 AST}
- {2627532000 -10800 1 ADT}
- {2645067600 -14400 0 AST}
- {2658981600 -10800 1 ADT}
- {2676517200 -14400 0 AST}
- {2690431200 -10800 1 ADT}
- {2708571600 -14400 0 AST}
- {2721880800 -10800 1 ADT}
- {2740021200 -14400 0 AST}
- {2753330400 -10800 1 ADT}
- {2771470800 -14400 0 AST}
- {2785384800 -10800 1 ADT}
- {2802920400 -14400 0 AST}
- {2816834400 -10800 1 ADT}
- {2834370000 -14400 0 AST}
- {2848284000 -10800 1 ADT}
- {2866424400 -14400 0 AST}
- {2879733600 -10800 1 ADT}
- {2897874000 -14400 0 AST}
- {2911183200 -10800 1 ADT}
- {2929323600 -14400 0 AST}
- {2942632800 -10800 1 ADT}
- {2960773200 -14400 0 AST}
- {2974687200 -10800 1 ADT}
- {2992222800 -14400 0 AST}
- {3006136800 -10800 1 ADT}
- {3023672400 -14400 0 AST}
- {3037586400 -10800 1 ADT}
- {3055726800 -14400 0 AST}
- {3069036000 -10800 1 ADT}
- {3087176400 -14400 0 AST}
- {3100485600 -10800 1 ADT}
- {3118626000 -14400 0 AST}
- {3132540000 -10800 1 ADT}
- {3150075600 -14400 0 AST}
- {3163989600 -10800 1 ADT}
- {3181525200 -14400 0 AST}
- {3195439200 -10800 1 ADT}
- {3212974800 -14400 0 AST}
- {3226888800 -10800 1 ADT}
- {3245029200 -14400 0 AST}
- {3258338400 -10800 1 ADT}
- {3276478800 -14400 0 AST}
- {3289788000 -10800 1 ADT}
- {3307928400 -14400 0 AST}
- {3321842400 -10800 1 ADT}
- {3339378000 -14400 0 AST}
- {3353292000 -10800 1 ADT}
- {3370827600 -14400 0 AST}
- {3384741600 -10800 1 ADT}
- {3402882000 -14400 0 AST}
- {3416191200 -10800 1 ADT}
- {3434331600 -14400 0 AST}
- {3447640800 -10800 1 ADT}
- {3465781200 -14400 0 AST}
- {3479695200 -10800 1 ADT}
- {3497230800 -14400 0 AST}
- {3511144800 -10800 1 ADT}
- {3528680400 -14400 0 AST}
- {3542594400 -10800 1 ADT}
- {3560130000 -14400 0 AST}
- {3574044000 -10800 1 ADT}
- {3592184400 -14400 0 AST}
- {3605493600 -10800 1 ADT}
- {3623634000 -14400 0 AST}
- {3636943200 -10800 1 ADT}
- {3655083600 -14400 0 AST}
- {3668997600 -10800 1 ADT}
- {3686533200 -14400 0 AST}
- {3700447200 -10800 1 ADT}
- {3717982800 -14400 0 AST}
- {3731896800 -10800 1 ADT}
- {3750037200 -14400 0 AST}
- {3763346400 -10800 1 ADT}
- {3781486800 -14400 0 AST}
- {3794796000 -10800 1 ADT}
- {3812936400 -14400 0 AST}
- {3826245600 -10800 1 ADT}
- {3844386000 -14400 0 AST}
- {3858300000 -10800 1 ADT}
- {3875835600 -14400 0 AST}
- {3889749600 -10800 1 ADT}
- {3907285200 -14400 0 AST}
- {3921199200 -10800 1 ADT}
- {3939339600 -14400 0 AST}
- {3952648800 -10800 1 ADT}
- {3970789200 -14400 0 AST}
- {3984098400 -10800 1 ADT}
- {4002238800 -14400 0 AST}
- {4016152800 -10800 1 ADT}
- {4033688400 -14400 0 AST}
- {4047602400 -10800 1 ADT}
- {4065138000 -14400 0 AST}
- {4079052000 -10800 1 ADT}
- {4096587600 -14400 0 AST}
+ {1173592800 -10800 1 ADT}
+ {1194152400 -14400 0 AST}
+ {1205042400 -10800 1 ADT}
+ {1225602000 -14400 0 AST}
+ {1236492000 -10800 1 ADT}
+ {1257051600 -14400 0 AST}
+ {1268546400 -10800 1 ADT}
+ {1289106000 -14400 0 AST}
+ {1299996000 -10800 1 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/Atlantic/Canary b/library/tzdata/Atlantic/Canary
index 4549ef3..4b802c7 100644
--- a/library/tzdata/Atlantic/Canary
+++ b/library/tzdata/Atlantic/Canary
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Canary) {
{-9223372036854775808 -3696 0 LMT}
diff --git a/library/tzdata/Atlantic/Cape_Verde b/library/tzdata/Atlantic/Cape_Verde
index 59103d4..f0bb79f 100644
--- a/library/tzdata/Atlantic/Cape_Verde
+++ b/library/tzdata/Atlantic/Cape_Verde
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Cape_Verde) {
{-9223372036854775808 -5644 0 LMT}
diff --git a/library/tzdata/Atlantic/Faeroe b/library/tzdata/Atlantic/Faeroe
index a8751fd..4cafc34 100644
--- a/library/tzdata/Atlantic/Faeroe
+++ b/library/tzdata/Atlantic/Faeroe
@@ -1,245 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Atlantic/Faeroe) {
- {-9223372036854775808 -1624 0 LMT}
- {-1955748776 0 0 WET}
- {347155200 0 0 WET}
- {354675600 3600 1 WEST}
- {370400400 0 0 WET}
- {386125200 3600 1 WEST}
- {401850000 0 0 WET}
- {417574800 3600 1 WEST}
- {433299600 0 0 WET}
- {449024400 3600 1 WEST}
- {465354000 0 0 WET}
- {481078800 3600 1 WEST}
- {496803600 0 0 WET}
- {512528400 3600 1 WEST}
- {528253200 0 0 WET}
- {543978000 3600 1 WEST}
- {559702800 0 0 WET}
- {575427600 3600 1 WEST}
- {591152400 0 0 WET}
- {606877200 3600 1 WEST}
- {622602000 0 0 WET}
- {638326800 3600 1 WEST}
- {654656400 0 0 WET}
- {670381200 3600 1 WEST}
- {686106000 0 0 WET}
- {701830800 3600 1 WEST}
- {717555600 0 0 WET}
- {733280400 3600 1 WEST}
- {749005200 0 0 WET}
- {764730000 3600 1 WEST}
- {780454800 0 0 WET}
- {796179600 3600 1 WEST}
- {811904400 0 0 WET}
- {828234000 3600 1 WEST}
- {846378000 0 0 WET}
- {859683600 3600 1 WEST}
- {877827600 0 0 WET}
- {891133200 3600 1 WEST}
- {909277200 0 0 WET}
- {922582800 3600 1 WEST}
- {941331600 0 0 WET}
- {954032400 3600 1 WEST}
- {972781200 0 0 WET}
- {985482000 3600 1 WEST}
- {1004230800 0 0 WET}
- {1017536400 3600 1 WEST}
- {1035680400 0 0 WET}
- {1048986000 3600 1 WEST}
- {1067130000 0 0 WET}
- {1080435600 3600 1 WEST}
- {1099184400 0 0 WET}
- {1111885200 3600 1 WEST}
- {1130634000 0 0 WET}
- {1143334800 3600 1 WEST}
- {1162083600 0 0 WET}
- {1174784400 3600 1 WEST}
- {1193533200 0 0 WET}
- {1206838800 3600 1 WEST}
- {1224982800 0 0 WET}
- {1238288400 3600 1 WEST}
- {1256432400 0 0 WET}
- {1269738000 3600 1 WEST}
- {1288486800 0 0 WET}
- {1301187600 3600 1 WEST}
- {1319936400 0 0 WET}
- {1332637200 3600 1 WEST}
- {1351386000 0 0 WET}
- {1364691600 3600 1 WEST}
- {1382835600 0 0 WET}
- {1396141200 3600 1 WEST}
- {1414285200 0 0 WET}
- {1427590800 3600 1 WEST}
- {1445734800 0 0 WET}
- {1459040400 3600 1 WEST}
- {1477789200 0 0 WET}
- {1490490000 3600 1 WEST}
- {1509238800 0 0 WET}
- {1521939600 3600 1 WEST}
- {1540688400 0 0 WET}
- {1553994000 3600 1 WEST}
- {1572138000 0 0 WET}
- {1585443600 3600 1 WEST}
- {1603587600 0 0 WET}
- {1616893200 3600 1 WEST}
- {1635642000 0 0 WET}
- {1648342800 3600 1 WEST}
- {1667091600 0 0 WET}
- {1679792400 3600 1 WEST}
- {1698541200 0 0 WET}
- {1711846800 3600 1 WEST}
- {1729990800 0 0 WET}
- {1743296400 3600 1 WEST}
- {1761440400 0 0 WET}
- {1774746000 3600 1 WEST}
- {1792890000 0 0 WET}
- {1806195600 3600 1 WEST}
- {1824944400 0 0 WET}
- {1837645200 3600 1 WEST}
- {1856394000 0 0 WET}
- {1869094800 3600 1 WEST}
- {1887843600 0 0 WET}
- {1901149200 3600 1 WEST}
- {1919293200 0 0 WET}
- {1932598800 3600 1 WEST}
- {1950742800 0 0 WET}
- {1964048400 3600 1 WEST}
- {1982797200 0 0 WET}
- {1995498000 3600 1 WEST}
- {2014246800 0 0 WET}
- {2026947600 3600 1 WEST}
- {2045696400 0 0 WET}
- {2058397200 3600 1 WEST}
- {2077146000 0 0 WET}
- {2090451600 3600 1 WEST}
- {2108595600 0 0 WET}
- {2121901200 3600 1 WEST}
- {2140045200 0 0 WET}
- {2153350800 3600 1 WEST}
- {2172099600 0 0 WET}
- {2184800400 3600 1 WEST}
- {2203549200 0 0 WET}
- {2216250000 3600 1 WEST}
- {2234998800 0 0 WET}
- {2248304400 3600 1 WEST}
- {2266448400 0 0 WET}
- {2279754000 3600 1 WEST}
- {2297898000 0 0 WET}
- {2311203600 3600 1 WEST}
- {2329347600 0 0 WET}
- {2342653200 3600 1 WEST}
- {2361402000 0 0 WET}
- {2374102800 3600 1 WEST}
- {2392851600 0 0 WET}
- {2405552400 3600 1 WEST}
- {2424301200 0 0 WET}
- {2437606800 3600 1 WEST}
- {2455750800 0 0 WET}
- {2469056400 3600 1 WEST}
- {2487200400 0 0 WET}
- {2500506000 3600 1 WEST}
- {2519254800 0 0 WET}
- {2531955600 3600 1 WEST}
- {2550704400 0 0 WET}
- {2563405200 3600 1 WEST}
- {2582154000 0 0 WET}
- {2595459600 3600 1 WEST}
- {2613603600 0 0 WET}
- {2626909200 3600 1 WEST}
- {2645053200 0 0 WET}
- {2658358800 3600 1 WEST}
- {2676502800 0 0 WET}
- {2689808400 3600 1 WEST}
- {2708557200 0 0 WET}
- {2721258000 3600 1 WEST}
- {2740006800 0 0 WET}
- {2752707600 3600 1 WEST}
- {2771456400 0 0 WET}
- {2784762000 3600 1 WEST}
- {2802906000 0 0 WET}
- {2816211600 3600 1 WEST}
- {2834355600 0 0 WET}
- {2847661200 3600 1 WEST}
- {2866410000 0 0 WET}
- {2879110800 3600 1 WEST}
- {2897859600 0 0 WET}
- {2910560400 3600 1 WEST}
- {2929309200 0 0 WET}
- {2942010000 3600 1 WEST}
- {2960758800 0 0 WET}
- {2974064400 3600 1 WEST}
- {2992208400 0 0 WET}
- {3005514000 3600 1 WEST}
- {3023658000 0 0 WET}
- {3036963600 3600 1 WEST}
- {3055712400 0 0 WET}
- {3068413200 3600 1 WEST}
- {3087162000 0 0 WET}
- {3099862800 3600 1 WEST}
- {3118611600 0 0 WET}
- {3131917200 3600 1 WEST}
- {3150061200 0 0 WET}
- {3163366800 3600 1 WEST}
- {3181510800 0 0 WET}
- {3194816400 3600 1 WEST}
- {3212960400 0 0 WET}
- {3226266000 3600 1 WEST}
- {3245014800 0 0 WET}
- {3257715600 3600 1 WEST}
- {3276464400 0 0 WET}
- {3289165200 3600 1 WEST}
- {3307914000 0 0 WET}
- {3321219600 3600 1 WEST}
- {3339363600 0 0 WET}
- {3352669200 3600 1 WEST}
- {3370813200 0 0 WET}
- {3384118800 3600 1 WEST}
- {3402867600 0 0 WET}
- {3415568400 3600 1 WEST}
- {3434317200 0 0 WET}
- {3447018000 3600 1 WEST}
- {3465766800 0 0 WET}
- {3479072400 3600 1 WEST}
- {3497216400 0 0 WET}
- {3510522000 3600 1 WEST}
- {3528666000 0 0 WET}
- {3541971600 3600 1 WEST}
- {3560115600 0 0 WET}
- {3573421200 3600 1 WEST}
- {3592170000 0 0 WET}
- {3604870800 3600 1 WEST}
- {3623619600 0 0 WET}
- {3636320400 3600 1 WEST}
- {3655069200 0 0 WET}
- {3668374800 3600 1 WEST}
- {3686518800 0 0 WET}
- {3699824400 3600 1 WEST}
- {3717968400 0 0 WET}
- {3731274000 3600 1 WEST}
- {3750022800 0 0 WET}
- {3762723600 3600 1 WEST}
- {3781472400 0 0 WET}
- {3794173200 3600 1 WEST}
- {3812922000 0 0 WET}
- {3825622800 3600 1 WEST}
- {3844371600 0 0 WET}
- {3857677200 3600 1 WEST}
- {3875821200 0 0 WET}
- {3889126800 3600 1 WEST}
- {3907270800 0 0 WET}
- {3920576400 3600 1 WEST}
- {3939325200 0 0 WET}
- {3952026000 3600 1 WEST}
- {3970774800 0 0 WET}
- {3983475600 3600 1 WEST}
- {4002224400 0 0 WET}
- {4015530000 3600 1 WEST}
- {4033674000 0 0 WET}
- {4046979600 3600 1 WEST}
- {4065123600 0 0 WET}
- {4078429200 3600 1 WEST}
- {4096573200 0 0 WET}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Atlantic/Faroe)]} {
+ LoadTimeZoneFile Atlantic/Faroe
}
+set TZData(:Atlantic/Faeroe) $TZData(:Atlantic/Faroe)
diff --git a/library/tzdata/Atlantic/Faroe b/library/tzdata/Atlantic/Faroe
new file mode 100644
index 0000000..d2c314a
--- /dev/null
+++ b/library/tzdata/Atlantic/Faroe
@@ -0,0 +1,245 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Atlantic/Faroe) {
+ {-9223372036854775808 -1624 0 LMT}
+ {-1955748776 0 0 WET}
+ {347155200 0 0 WET}
+ {354675600 3600 1 WEST}
+ {370400400 0 0 WET}
+ {386125200 3600 1 WEST}
+ {401850000 0 0 WET}
+ {417574800 3600 1 WEST}
+ {433299600 0 0 WET}
+ {449024400 3600 1 WEST}
+ {465354000 0 0 WET}
+ {481078800 3600 1 WEST}
+ {496803600 0 0 WET}
+ {512528400 3600 1 WEST}
+ {528253200 0 0 WET}
+ {543978000 3600 1 WEST}
+ {559702800 0 0 WET}
+ {575427600 3600 1 WEST}
+ {591152400 0 0 WET}
+ {606877200 3600 1 WEST}
+ {622602000 0 0 WET}
+ {638326800 3600 1 WEST}
+ {654656400 0 0 WET}
+ {670381200 3600 1 WEST}
+ {686106000 0 0 WET}
+ {701830800 3600 1 WEST}
+ {717555600 0 0 WET}
+ {733280400 3600 1 WEST}
+ {749005200 0 0 WET}
+ {764730000 3600 1 WEST}
+ {780454800 0 0 WET}
+ {796179600 3600 1 WEST}
+ {811904400 0 0 WET}
+ {828234000 3600 1 WEST}
+ {846378000 0 0 WET}
+ {859683600 3600 1 WEST}
+ {877827600 0 0 WET}
+ {891133200 3600 1 WEST}
+ {909277200 0 0 WET}
+ {922582800 3600 1 WEST}
+ {941331600 0 0 WET}
+ {954032400 3600 1 WEST}
+ {972781200 0 0 WET}
+ {985482000 3600 1 WEST}
+ {1004230800 0 0 WET}
+ {1017536400 3600 1 WEST}
+ {1035680400 0 0 WET}
+ {1048986000 3600 1 WEST}
+ {1067130000 0 0 WET}
+ {1080435600 3600 1 WEST}
+ {1099184400 0 0 WET}
+ {1111885200 3600 1 WEST}
+ {1130634000 0 0 WET}
+ {1143334800 3600 1 WEST}
+ {1162083600 0 0 WET}
+ {1174784400 3600 1 WEST}
+ {1193533200 0 0 WET}
+ {1206838800 3600 1 WEST}
+ {1224982800 0 0 WET}
+ {1238288400 3600 1 WEST}
+ {1256432400 0 0 WET}
+ {1269738000 3600 1 WEST}
+ {1288486800 0 0 WET}
+ {1301187600 3600 1 WEST}
+ {1319936400 0 0 WET}
+ {1332637200 3600 1 WEST}
+ {1351386000 0 0 WET}
+ {1364691600 3600 1 WEST}
+ {1382835600 0 0 WET}
+ {1396141200 3600 1 WEST}
+ {1414285200 0 0 WET}
+ {1427590800 3600 1 WEST}
+ {1445734800 0 0 WET}
+ {1459040400 3600 1 WEST}
+ {1477789200 0 0 WET}
+ {1490490000 3600 1 WEST}
+ {1509238800 0 0 WET}
+ {1521939600 3600 1 WEST}
+ {1540688400 0 0 WET}
+ {1553994000 3600 1 WEST}
+ {1572138000 0 0 WET}
+ {1585443600 3600 1 WEST}
+ {1603587600 0 0 WET}
+ {1616893200 3600 1 WEST}
+ {1635642000 0 0 WET}
+ {1648342800 3600 1 WEST}
+ {1667091600 0 0 WET}
+ {1679792400 3600 1 WEST}
+ {1698541200 0 0 WET}
+ {1711846800 3600 1 WEST}
+ {1729990800 0 0 WET}
+ {1743296400 3600 1 WEST}
+ {1761440400 0 0 WET}
+ {1774746000 3600 1 WEST}
+ {1792890000 0 0 WET}
+ {1806195600 3600 1 WEST}
+ {1824944400 0 0 WET}
+ {1837645200 3600 1 WEST}
+ {1856394000 0 0 WET}
+ {1869094800 3600 1 WEST}
+ {1887843600 0 0 WET}
+ {1901149200 3600 1 WEST}
+ {1919293200 0 0 WET}
+ {1932598800 3600 1 WEST}
+ {1950742800 0 0 WET}
+ {1964048400 3600 1 WEST}
+ {1982797200 0 0 WET}
+ {1995498000 3600 1 WEST}
+ {2014246800 0 0 WET}
+ {2026947600 3600 1 WEST}
+ {2045696400 0 0 WET}
+ {2058397200 3600 1 WEST}
+ {2077146000 0 0 WET}
+ {2090451600 3600 1 WEST}
+ {2108595600 0 0 WET}
+ {2121901200 3600 1 WEST}
+ {2140045200 0 0 WET}
+ {2153350800 3600 1 WEST}
+ {2172099600 0 0 WET}
+ {2184800400 3600 1 WEST}
+ {2203549200 0 0 WET}
+ {2216250000 3600 1 WEST}
+ {2234998800 0 0 WET}
+ {2248304400 3600 1 WEST}
+ {2266448400 0 0 WET}
+ {2279754000 3600 1 WEST}
+ {2297898000 0 0 WET}
+ {2311203600 3600 1 WEST}
+ {2329347600 0 0 WET}
+ {2342653200 3600 1 WEST}
+ {2361402000 0 0 WET}
+ {2374102800 3600 1 WEST}
+ {2392851600 0 0 WET}
+ {2405552400 3600 1 WEST}
+ {2424301200 0 0 WET}
+ {2437606800 3600 1 WEST}
+ {2455750800 0 0 WET}
+ {2469056400 3600 1 WEST}
+ {2487200400 0 0 WET}
+ {2500506000 3600 1 WEST}
+ {2519254800 0 0 WET}
+ {2531955600 3600 1 WEST}
+ {2550704400 0 0 WET}
+ {2563405200 3600 1 WEST}
+ {2582154000 0 0 WET}
+ {2595459600 3600 1 WEST}
+ {2613603600 0 0 WET}
+ {2626909200 3600 1 WEST}
+ {2645053200 0 0 WET}
+ {2658358800 3600 1 WEST}
+ {2676502800 0 0 WET}
+ {2689808400 3600 1 WEST}
+ {2708557200 0 0 WET}
+ {2721258000 3600 1 WEST}
+ {2740006800 0 0 WET}
+ {2752707600 3600 1 WEST}
+ {2771456400 0 0 WET}
+ {2784762000 3600 1 WEST}
+ {2802906000 0 0 WET}
+ {2816211600 3600 1 WEST}
+ {2834355600 0 0 WET}
+ {2847661200 3600 1 WEST}
+ {2866410000 0 0 WET}
+ {2879110800 3600 1 WEST}
+ {2897859600 0 0 WET}
+ {2910560400 3600 1 WEST}
+ {2929309200 0 0 WET}
+ {2942010000 3600 1 WEST}
+ {2960758800 0 0 WET}
+ {2974064400 3600 1 WEST}
+ {2992208400 0 0 WET}
+ {3005514000 3600 1 WEST}
+ {3023658000 0 0 WET}
+ {3036963600 3600 1 WEST}
+ {3055712400 0 0 WET}
+ {3068413200 3600 1 WEST}
+ {3087162000 0 0 WET}
+ {3099862800 3600 1 WEST}
+ {3118611600 0 0 WET}
+ {3131917200 3600 1 WEST}
+ {3150061200 0 0 WET}
+ {3163366800 3600 1 WEST}
+ {3181510800 0 0 WET}
+ {3194816400 3600 1 WEST}
+ {3212960400 0 0 WET}
+ {3226266000 3600 1 WEST}
+ {3245014800 0 0 WET}
+ {3257715600 3600 1 WEST}
+ {3276464400 0 0 WET}
+ {3289165200 3600 1 WEST}
+ {3307914000 0 0 WET}
+ {3321219600 3600 1 WEST}
+ {3339363600 0 0 WET}
+ {3352669200 3600 1 WEST}
+ {3370813200 0 0 WET}
+ {3384118800 3600 1 WEST}
+ {3402867600 0 0 WET}
+ {3415568400 3600 1 WEST}
+ {3434317200 0 0 WET}
+ {3447018000 3600 1 WEST}
+ {3465766800 0 0 WET}
+ {3479072400 3600 1 WEST}
+ {3497216400 0 0 WET}
+ {3510522000 3600 1 WEST}
+ {3528666000 0 0 WET}
+ {3541971600 3600 1 WEST}
+ {3560115600 0 0 WET}
+ {3573421200 3600 1 WEST}
+ {3592170000 0 0 WET}
+ {3604870800 3600 1 WEST}
+ {3623619600 0 0 WET}
+ {3636320400 3600 1 WEST}
+ {3655069200 0 0 WET}
+ {3668374800 3600 1 WEST}
+ {3686518800 0 0 WET}
+ {3699824400 3600 1 WEST}
+ {3717968400 0 0 WET}
+ {3731274000 3600 1 WEST}
+ {3750022800 0 0 WET}
+ {3762723600 3600 1 WEST}
+ {3781472400 0 0 WET}
+ {3794173200 3600 1 WEST}
+ {3812922000 0 0 WET}
+ {3825622800 3600 1 WEST}
+ {3844371600 0 0 WET}
+ {3857677200 3600 1 WEST}
+ {3875821200 0 0 WET}
+ {3889126800 3600 1 WEST}
+ {3907270800 0 0 WET}
+ {3920576400 3600 1 WEST}
+ {3939325200 0 0 WET}
+ {3952026000 3600 1 WEST}
+ {3970774800 0 0 WET}
+ {3983475600 3600 1 WEST}
+ {4002224400 0 0 WET}
+ {4015530000 3600 1 WEST}
+ {4033674000 0 0 WET}
+ {4046979600 3600 1 WEST}
+ {4065123600 0 0 WET}
+ {4078429200 3600 1 WEST}
+ {4096573200 0 0 WET}
+}
diff --git a/library/tzdata/Atlantic/Jan_Mayen b/library/tzdata/Atlantic/Jan_Mayen
index 2f49f66..e592187 100644
--- a/library/tzdata/Atlantic/Jan_Mayen
+++ b/library/tzdata/Atlantic/Jan_Mayen
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
LoadTimeZoneFile Europe/Oslo
}
diff --git a/library/tzdata/Atlantic/Madeira b/library/tzdata/Atlantic/Madeira
index 0a59565..4960eeb 100644
--- a/library/tzdata/Atlantic/Madeira
+++ b/library/tzdata/Atlantic/Madeira
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Madeira) {
{-9223372036854775808 -4056 0 LMT}
@@ -6,100 +6,100 @@ set TZData(:Atlantic/Madeira) {
{-1849560744 -3600 0 MADT}
{-1689552000 0 1 MADST}
{-1677798000 -3600 0 MADT}
- {-1667437200 0 1 MADST}
- {-1647738000 -3600 0 MADT}
- {-1635814800 0 1 MADST}
- {-1616202000 -3600 0 MADT}
- {-1604365200 0 1 MADST}
- {-1584666000 -3600 0 MADT}
- {-1572742800 0 1 MADST}
- {-1553043600 -3600 0 MADT}
- {-1541206800 0 1 MADST}
- {-1521507600 -3600 0 MADT}
- {-1442451600 0 1 MADST}
- {-1426813200 -3600 0 MADT}
- {-1379293200 0 1 MADST}
- {-1364778000 -3600 0 MADT}
- {-1348448400 0 1 MADST}
- {-1333328400 -3600 0 MADT}
- {-1316394000 0 1 MADST}
- {-1301274000 -3600 0 MADT}
- {-1284339600 0 1 MADST}
- {-1269824400 -3600 0 MADT}
- {-1221440400 0 1 MADST}
- {-1206925200 -3600 0 MADT}
- {-1191200400 0 1 MADST}
- {-1175475600 -3600 0 MADT}
- {-1127696400 0 1 MADST}
- {-1111971600 -3600 0 MADT}
- {-1096851600 0 1 MADST}
- {-1080522000 -3600 0 MADT}
- {-1063587600 0 1 MADST}
- {-1049072400 -3600 0 MADT}
- {-1033347600 0 1 MADST}
- {-1017622800 -3600 0 MADT}
- {-1002502800 0 1 MADST}
- {-986173200 -3600 0 MADT}
- {-969238800 0 1 MADST}
- {-950490000 -3600 0 MADT}
- {-942022800 0 1 MADST}
- {-922669200 -3600 0 MADT}
- {-906944400 0 1 MADST}
- {-891133200 -3600 0 MADT}
- {-877309200 0 1 MADST}
- {-873684000 3600 1 MADMT}
- {-864007200 0 1 MADST}
- {-857955600 -3600 0 MADT}
- {-845859600 0 1 MADST}
- {-842839200 3600 1 MADMT}
- {-831348000 0 1 MADST}
- {-825901200 -3600 0 MADT}
- {-814410000 0 1 MADST}
- {-810784800 3600 1 MADMT}
- {-799898400 0 1 MADST}
- {-794451600 -3600 0 MADT}
- {-782960400 0 1 MADST}
- {-779335200 3600 1 MADMT}
- {-768448800 0 1 MADST}
- {-763002000 -3600 0 MADT}
- {-749091600 0 1 MADST}
- {-733366800 -3600 0 MADT}
- {-717631200 0 1 MADST}
- {-701906400 -3600 0 MADT}
- {-686181600 0 1 MADST}
- {-670456800 -3600 0 MADT}
- {-654732000 0 1 MADST}
- {-639007200 -3600 0 MADT}
- {-591832800 0 1 MADST}
- {-575503200 -3600 0 MADT}
- {-559778400 0 1 MADST}
- {-544053600 -3600 0 MADT}
- {-528328800 0 1 MADST}
- {-512604000 -3600 0 MADT}
- {-496879200 0 1 MADST}
- {-481154400 -3600 0 MADT}
- {-465429600 0 1 MADST}
- {-449704800 -3600 0 MADT}
- {-433980000 0 1 MADST}
- {-417650400 -3600 0 MADT}
- {-401925600 0 1 MADST}
- {-386200800 -3600 0 MADT}
- {-370476000 0 1 MADST}
- {-354751200 -3600 0 MADT}
- {-339026400 0 1 MADST}
- {-323301600 -3600 0 MADT}
- {-307576800 0 1 MADST}
- {-291852000 -3600 0 MADT}
- {-276127200 0 1 MADST}
- {-260402400 -3600 0 MADT}
- {-244677600 0 1 MADST}
- {-228348000 -3600 0 MADT}
- {-212623200 0 1 MADST}
- {-196898400 -3600 0 MADT}
- {-181173600 0 1 MADST}
- {-165448800 -3600 0 MADT}
- {-149724000 0 1 MADST}
- {-133999200 -3600 0 MADT}
+ {-1667433600 0 1 MADST}
+ {-1647734400 -3600 0 MADT}
+ {-1635811200 0 1 MADST}
+ {-1616198400 -3600 0 MADT}
+ {-1604361600 0 1 MADST}
+ {-1584662400 -3600 0 MADT}
+ {-1572739200 0 1 MADST}
+ {-1553040000 -3600 0 MADT}
+ {-1541203200 0 1 MADST}
+ {-1521504000 -3600 0 MADT}
+ {-1442448000 0 1 MADST}
+ {-1426809600 -3600 0 MADT}
+ {-1379289600 0 1 MADST}
+ {-1364774400 -3600 0 MADT}
+ {-1348444800 0 1 MADST}
+ {-1333324800 -3600 0 MADT}
+ {-1316390400 0 1 MADST}
+ {-1301270400 -3600 0 MADT}
+ {-1284336000 0 1 MADST}
+ {-1269820800 -3600 0 MADT}
+ {-1221436800 0 1 MADST}
+ {-1206921600 -3600 0 MADT}
+ {-1191196800 0 1 MADST}
+ {-1175472000 -3600 0 MADT}
+ {-1127692800 0 1 MADST}
+ {-1111968000 -3600 0 MADT}
+ {-1096848000 0 1 MADST}
+ {-1080518400 -3600 0 MADT}
+ {-1063584000 0 1 MADST}
+ {-1049068800 -3600 0 MADT}
+ {-1033344000 0 1 MADST}
+ {-1017619200 -3600 0 MADT}
+ {-1002499200 0 1 MADST}
+ {-986169600 -3600 0 MADT}
+ {-969235200 0 1 MADST}
+ {-950486400 -3600 0 MADT}
+ {-942019200 0 1 MADST}
+ {-922665600 -3600 0 MADT}
+ {-906940800 0 1 MADST}
+ {-891129600 -3600 0 MADT}
+ {-877305600 0 1 MADST}
+ {-873680400 3600 1 MADMT}
+ {-864003600 0 1 MADST}
+ {-857952000 -3600 0 MADT}
+ {-845856000 0 1 MADST}
+ {-842835600 3600 1 MADMT}
+ {-831344400 0 1 MADST}
+ {-825897600 -3600 0 MADT}
+ {-814406400 0 1 MADST}
+ {-810781200 3600 1 MADMT}
+ {-799894800 0 1 MADST}
+ {-794448000 -3600 0 MADT}
+ {-782956800 0 1 MADST}
+ {-779331600 3600 1 MADMT}
+ {-768445200 0 1 MADST}
+ {-762998400 -3600 0 MADT}
+ {-749088000 0 1 MADST}
+ {-733363200 -3600 0 MADT}
+ {-717627600 0 1 MADST}
+ {-701902800 -3600 0 MADT}
+ {-686178000 0 1 MADST}
+ {-670453200 -3600 0 MADT}
+ {-654728400 0 1 MADST}
+ {-639003600 -3600 0 MADT}
+ {-591829200 0 1 MADST}
+ {-575499600 -3600 0 MADT}
+ {-559774800 0 1 MADST}
+ {-544050000 -3600 0 MADT}
+ {-528325200 0 1 MADST}
+ {-512600400 -3600 0 MADT}
+ {-496875600 0 1 MADST}
+ {-481150800 -3600 0 MADT}
+ {-465426000 0 1 MADST}
+ {-449701200 -3600 0 MADT}
+ {-433976400 0 1 MADST}
+ {-417646800 -3600 0 MADT}
+ {-401922000 0 1 MADST}
+ {-386197200 -3600 0 MADT}
+ {-370472400 0 1 MADST}
+ {-354747600 -3600 0 MADT}
+ {-339022800 0 1 MADST}
+ {-323298000 -3600 0 MADT}
+ {-307573200 0 1 MADST}
+ {-291848400 -3600 0 MADT}
+ {-276123600 0 1 MADST}
+ {-260398800 -3600 0 MADT}
+ {-244674000 0 1 MADST}
+ {-228344400 -3600 0 MADT}
+ {-212619600 0 1 MADST}
+ {-196894800 -3600 0 MADT}
+ {-181170000 0 1 MADST}
+ {-165445200 -3600 0 MADT}
+ {-149720400 0 1 MADST}
+ {-133995600 -3600 0 MADT}
{-118270800 0 0 WET}
{228268800 3600 1 WEST}
{243993600 0 0 WET}
diff --git a/library/tzdata/Atlantic/Reykjavik b/library/tzdata/Atlantic/Reykjavik
index 8508037..f0248ad 100644
--- a/library/tzdata/Atlantic/Reykjavik
+++ b/library/tzdata/Atlantic/Reykjavik
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Reykjavik) {
{-9223372036854775808 -5244 0 LMT}
@@ -12,59 +12,59 @@ set TZData(:Atlantic/Reykjavik) {
{-949615200 -3600 0 IST}
{-942008400 0 1 ISST}
{-920239200 -3600 0 IST}
- {-909961200 0 1 ISST}
- {-888793200 -3600 0 IST}
- {-877906800 0 1 ISST}
- {-857948400 -3600 0 IST}
- {-846457200 0 1 ISST}
- {-826498800 -3600 0 IST}
- {-815007600 0 1 ISST}
- {-795049200 -3600 0 IST}
- {-783558000 0 1 ISST}
- {-762994800 -3600 0 IST}
- {-752108400 0 1 ISST}
- {-731545200 -3600 0 IST}
- {-717634800 0 1 ISST}
- {-700095600 -3600 0 IST}
- {-686185200 0 1 ISST}
- {-668646000 -3600 0 IST}
- {-654735600 0 1 ISST}
- {-636591600 -3600 0 IST}
- {-623286000 0 1 ISST}
- {-605746800 -3600 0 IST}
- {-591836400 0 1 ISST}
- {-573692400 -3600 0 IST}
- {-559782000 0 1 ISST}
- {-542242800 -3600 0 IST}
- {-528332400 0 1 ISST}
- {-510793200 -3600 0 IST}
- {-496882800 0 1 ISST}
- {-479343600 -3600 0 IST}
- {-465433200 0 1 ISST}
- {-447894000 -3600 0 IST}
- {-433983600 0 1 ISST}
- {-415839600 -3600 0 IST}
- {-401929200 0 1 ISST}
- {-384390000 -3600 0 IST}
- {-370479600 0 1 ISST}
- {-352940400 -3600 0 IST}
- {-339030000 0 1 ISST}
- {-321490800 -3600 0 IST}
- {-307580400 0 1 ISST}
- {-290041200 -3600 0 IST}
- {-276130800 0 1 ISST}
- {-258591600 -3600 0 IST}
- {-244681200 0 1 ISST}
- {-226537200 -3600 0 IST}
- {-212626800 0 1 ISST}
- {-195087600 -3600 0 IST}
- {-181177200 0 1 ISST}
- {-163638000 -3600 0 IST}
- {-149727600 0 1 ISST}
- {-132188400 -3600 0 IST}
- {-118278000 0 1 ISST}
- {-100738800 -3600 0 IST}
- {-86828400 0 1 ISST}
- {-68684400 -3600 0 IST}
- {-54774000 0 0 GMT}
+ {-909957600 0 1 ISST}
+ {-888789600 -3600 0 IST}
+ {-877903200 0 1 ISST}
+ {-857944800 -3600 0 IST}
+ {-846453600 0 1 ISST}
+ {-826495200 -3600 0 IST}
+ {-815004000 0 1 ISST}
+ {-795045600 -3600 0 IST}
+ {-783554400 0 1 ISST}
+ {-762991200 -3600 0 IST}
+ {-752104800 0 1 ISST}
+ {-731541600 -3600 0 IST}
+ {-717631200 0 1 ISST}
+ {-700092000 -3600 0 IST}
+ {-686181600 0 1 ISST}
+ {-668642400 -3600 0 IST}
+ {-654732000 0 1 ISST}
+ {-636588000 -3600 0 IST}
+ {-623282400 0 1 ISST}
+ {-605743200 -3600 0 IST}
+ {-591832800 0 1 ISST}
+ {-573688800 -3600 0 IST}
+ {-559778400 0 1 ISST}
+ {-542239200 -3600 0 IST}
+ {-528328800 0 1 ISST}
+ {-510789600 -3600 0 IST}
+ {-496879200 0 1 ISST}
+ {-479340000 -3600 0 IST}
+ {-465429600 0 1 ISST}
+ {-447890400 -3600 0 IST}
+ {-433980000 0 1 ISST}
+ {-415836000 -3600 0 IST}
+ {-401925600 0 1 ISST}
+ {-384386400 -3600 0 IST}
+ {-370476000 0 1 ISST}
+ {-352936800 -3600 0 IST}
+ {-339026400 0 1 ISST}
+ {-321487200 -3600 0 IST}
+ {-307576800 0 1 ISST}
+ {-290037600 -3600 0 IST}
+ {-276127200 0 1 ISST}
+ {-258588000 -3600 0 IST}
+ {-244677600 0 1 ISST}
+ {-226533600 -3600 0 IST}
+ {-212623200 0 1 ISST}
+ {-195084000 -3600 0 IST}
+ {-181173600 0 1 ISST}
+ {-163634400 -3600 0 IST}
+ {-149724000 0 1 ISST}
+ {-132184800 -3600 0 IST}
+ {-118274400 0 1 ISST}
+ {-100735200 -3600 0 IST}
+ {-86824800 0 1 ISST}
+ {-68680800 -3600 0 IST}
+ {-54770400 0 0 GMT}
}
diff --git a/library/tzdata/Atlantic/South_Georgia b/library/tzdata/Atlantic/South_Georgia
index 954a298..cbfc826 100644
--- a/library/tzdata/Atlantic/South_Georgia
+++ b/library/tzdata/Atlantic/South_Georgia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/South_Georgia) {
{-9223372036854775808 -8768 0 LMT}
diff --git a/library/tzdata/Atlantic/St_Helena b/library/tzdata/Atlantic/St_Helena
index cdabc47..6d0c00d 100644
--- a/library/tzdata/Atlantic/St_Helena
+++ b/library/tzdata/Atlantic/St_Helena
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/St_Helena) {
{-9223372036854775808 -1368 0 LMT}
diff --git a/library/tzdata/Atlantic/Stanley b/library/tzdata/Atlantic/Stanley
index def6400..c287238 100644
--- a/library/tzdata/Atlantic/Stanley
+++ b/library/tzdata/Atlantic/Stanley
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Atlantic/Stanley) {
{-9223372036854775808 -13884 0 LMT}
@@ -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/Australia/ACT b/library/tzdata/Australia/ACT
index fc1ff90..f7da281 100644
--- a/library/tzdata/Australia/ACT
+++ b/library/tzdata/Australia/ACT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Sydney)]} {
LoadTimeZoneFile Australia/Sydney
}
diff --git a/library/tzdata/Australia/Adelaide b/library/tzdata/Australia/Adelaide
index 60d48e5..9abe192 100644
--- a/library/tzdata/Australia/Adelaide
+++ b/library/tzdata/Australia/Adelaide
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Adelaide) {
{-9223372036854775808 33260 0 LMT}
@@ -13,261 +13,261 @@ set TZData(:Australia/Adelaide) {
{-828343800 37800 1 CST}
{-813227400 34200 0 CST}
{31501800 34200 0 CST}
- {57722400 37800 1 CST}
- {68004000 34200 0 CST}
- {89172000 37800 1 CST}
- {100058400 34200 0 CST}
- {120621600 37800 1 CST}
- {131508000 34200 0 CST}
- {152071200 37800 1 CST}
- {162957600 34200 0 CST}
- {183520800 37800 1 CST}
- {195012000 34200 0 CST}
- {215575200 37800 1 CST}
- {226461600 34200 0 CST}
- {247024800 37800 1 CST}
- {257911200 34200 0 CST}
- {278474400 37800 1 CST}
- {289360800 34200 0 CST}
- {309924000 37800 1 CST}
- {320810400 34200 0 CST}
- {341373600 37800 1 CST}
- {352260000 34200 0 CST}
- {372823200 37800 1 CST}
- {384314400 34200 0 CST}
- {404877600 37800 1 CST}
- {415764000 34200 0 CST}
- {436327200 37800 1 CST}
- {447213600 34200 0 CST}
- {467776800 37800 1 CST}
- {478663200 34200 0 CST}
- {499226400 37800 1 CST}
- {511322400 34200 0 CST}
- {530071200 37800 1 CST}
- {542772000 34200 0 CST}
- {562125600 37800 1 CST}
- {574826400 34200 0 CST}
- {594180000 37800 1 CST}
- {606276000 34200 0 CST}
- {625629600 37800 1 CST}
- {637725600 34200 0 CST}
- {657079200 37800 1 CST}
- {667965600 34200 0 CST}
- {688528800 37800 1 CST}
- {701229600 34200 0 CST}
- {719978400 37800 1 CST}
- {731469600 34200 0 CST}
- {752032800 37800 1 CST}
- {764128800 34200 0 CST}
- {783482400 37800 1 CST}
- {796183200 34200 0 CST}
- {814932000 37800 1 CST}
- {828237600 34200 0 CST}
- {846381600 37800 1 CST}
- {859687200 34200 0 CST}
- {877831200 37800 1 CST}
- {891136800 34200 0 CST}
- {909280800 37800 1 CST}
- {922586400 34200 0 CST}
- {941335200 37800 1 CST}
- {954036000 34200 0 CST}
- {972784800 37800 1 CST}
- {985485600 34200 0 CST}
- {1004234400 37800 1 CST}
- {1017540000 34200 0 CST}
- {1035684000 37800 1 CST}
- {1048989600 34200 0 CST}
- {1067133600 37800 1 CST}
- {1080439200 34200 0 CST}
- {1099188000 37800 1 CST}
- {1111888800 34200 0 CST}
- {1130637600 37800 1 CST}
- {1143338400 34200 0 CST}
- {1162087200 37800 1 CST}
- {1174788000 34200 0 CST}
- {1193536800 37800 1 CST}
- {1206842400 34200 0 CST}
- {1224986400 37800 1 CST}
- {1238292000 34200 0 CST}
- {1256436000 37800 1 CST}
- {1269741600 34200 0 CST}
- {1288490400 37800 1 CST}
- {1301191200 34200 0 CST}
- {1319940000 37800 1 CST}
- {1332640800 34200 0 CST}
- {1351389600 37800 1 CST}
- {1364695200 34200 0 CST}
- {1382839200 37800 1 CST}
- {1396144800 34200 0 CST}
- {1414288800 37800 1 CST}
- {1427594400 34200 0 CST}
- {1445738400 37800 1 CST}
- {1459044000 34200 0 CST}
- {1477792800 37800 1 CST}
- {1490493600 34200 0 CST}
- {1509242400 37800 1 CST}
- {1521943200 34200 0 CST}
- {1540692000 37800 1 CST}
- {1553997600 34200 0 CST}
- {1572141600 37800 1 CST}
- {1585447200 34200 0 CST}
- {1603591200 37800 1 CST}
- {1616896800 34200 0 CST}
- {1635645600 37800 1 CST}
- {1648346400 34200 0 CST}
- {1667095200 37800 1 CST}
- {1679796000 34200 0 CST}
- {1698544800 37800 1 CST}
- {1711850400 34200 0 CST}
- {1729994400 37800 1 CST}
- {1743300000 34200 0 CST}
- {1761444000 37800 1 CST}
- {1774749600 34200 0 CST}
- {1792893600 37800 1 CST}
- {1806199200 34200 0 CST}
- {1824948000 37800 1 CST}
- {1837648800 34200 0 CST}
- {1856397600 37800 1 CST}
- {1869098400 34200 0 CST}
- {1887847200 37800 1 CST}
- {1901152800 34200 0 CST}
- {1919296800 37800 1 CST}
- {1932602400 34200 0 CST}
- {1950746400 37800 1 CST}
- {1964052000 34200 0 CST}
- {1982800800 37800 1 CST}
- {1995501600 34200 0 CST}
- {2014250400 37800 1 CST}
- {2026951200 34200 0 CST}
- {2045700000 37800 1 CST}
- {2058400800 34200 0 CST}
- {2077149600 37800 1 CST}
- {2090455200 34200 0 CST}
- {2108599200 37800 1 CST}
- {2121904800 34200 0 CST}
- {2140048800 37800 1 CST}
- {2153354400 34200 0 CST}
- {2172103200 37800 1 CST}
- {2184804000 34200 0 CST}
- {2203552800 37800 1 CST}
- {2216253600 34200 0 CST}
- {2235002400 37800 1 CST}
- {2248308000 34200 0 CST}
- {2266452000 37800 1 CST}
- {2279757600 34200 0 CST}
- {2297901600 37800 1 CST}
- {2311207200 34200 0 CST}
- {2329351200 37800 1 CST}
- {2342656800 34200 0 CST}
- {2361405600 37800 1 CST}
- {2374106400 34200 0 CST}
- {2392855200 37800 1 CST}
- {2405556000 34200 0 CST}
- {2424304800 37800 1 CST}
- {2437610400 34200 0 CST}
- {2455754400 37800 1 CST}
- {2469060000 34200 0 CST}
- {2487204000 37800 1 CST}
- {2500509600 34200 0 CST}
- {2519258400 37800 1 CST}
- {2531959200 34200 0 CST}
- {2550708000 37800 1 CST}
- {2563408800 34200 0 CST}
- {2582157600 37800 1 CST}
- {2595463200 34200 0 CST}
- {2613607200 37800 1 CST}
- {2626912800 34200 0 CST}
- {2645056800 37800 1 CST}
- {2658362400 34200 0 CST}
- {2676506400 37800 1 CST}
- {2689812000 34200 0 CST}
- {2708560800 37800 1 CST}
- {2721261600 34200 0 CST}
- {2740010400 37800 1 CST}
- {2752711200 34200 0 CST}
- {2771460000 37800 1 CST}
- {2784765600 34200 0 CST}
- {2802909600 37800 1 CST}
- {2816215200 34200 0 CST}
- {2834359200 37800 1 CST}
- {2847664800 34200 0 CST}
- {2866413600 37800 1 CST}
- {2879114400 34200 0 CST}
- {2897863200 37800 1 CST}
- {2910564000 34200 0 CST}
- {2929312800 37800 1 CST}
- {2942013600 34200 0 CST}
- {2960762400 37800 1 CST}
- {2974068000 34200 0 CST}
- {2992212000 37800 1 CST}
- {3005517600 34200 0 CST}
- {3023661600 37800 1 CST}
- {3036967200 34200 0 CST}
- {3055716000 37800 1 CST}
- {3068416800 34200 0 CST}
- {3087165600 37800 1 CST}
- {3099866400 34200 0 CST}
- {3118615200 37800 1 CST}
- {3131920800 34200 0 CST}
- {3150064800 37800 1 CST}
- {3163370400 34200 0 CST}
- {3181514400 37800 1 CST}
- {3194820000 34200 0 CST}
- {3212964000 37800 1 CST}
- {3226269600 34200 0 CST}
- {3245018400 37800 1 CST}
- {3257719200 34200 0 CST}
- {3276468000 37800 1 CST}
- {3289168800 34200 0 CST}
- {3307917600 37800 1 CST}
- {3321223200 34200 0 CST}
- {3339367200 37800 1 CST}
- {3352672800 34200 0 CST}
- {3370816800 37800 1 CST}
- {3384122400 34200 0 CST}
- {3402871200 37800 1 CST}
- {3415572000 34200 0 CST}
- {3434320800 37800 1 CST}
- {3447021600 34200 0 CST}
- {3465770400 37800 1 CST}
- {3479076000 34200 0 CST}
- {3497220000 37800 1 CST}
- {3510525600 34200 0 CST}
- {3528669600 37800 1 CST}
- {3541975200 34200 0 CST}
- {3560119200 37800 1 CST}
- {3573424800 34200 0 CST}
- {3592173600 37800 1 CST}
- {3604874400 34200 0 CST}
- {3623623200 37800 1 CST}
- {3636324000 34200 0 CST}
- {3655072800 37800 1 CST}
- {3668378400 34200 0 CST}
- {3686522400 37800 1 CST}
- {3699828000 34200 0 CST}
- {3717972000 37800 1 CST}
- {3731277600 34200 0 CST}
- {3750026400 37800 1 CST}
- {3762727200 34200 0 CST}
- {3781476000 37800 1 CST}
- {3794176800 34200 0 CST}
- {3812925600 37800 1 CST}
- {3825626400 34200 0 CST}
- {3844375200 37800 1 CST}
- {3857680800 34200 0 CST}
- {3875824800 37800 1 CST}
- {3889130400 34200 0 CST}
- {3907274400 37800 1 CST}
- {3920580000 34200 0 CST}
- {3939328800 37800 1 CST}
- {3952029600 34200 0 CST}
- {3970778400 37800 1 CST}
- {3983479200 34200 0 CST}
- {4002228000 37800 1 CST}
- {4015533600 34200 0 CST}
- {4033677600 37800 1 CST}
- {4046983200 34200 0 CST}
- {4065127200 37800 1 CST}
- {4078432800 34200 0 CST}
- {4096576800 37800 1 CST}
+ {57688200 37800 1 CST}
+ {67969800 34200 0 CST}
+ {89137800 37800 1 CST}
+ {100024200 34200 0 CST}
+ {120587400 37800 1 CST}
+ {131473800 34200 0 CST}
+ {152037000 37800 1 CST}
+ {162923400 34200 0 CST}
+ {183486600 37800 1 CST}
+ {194977800 34200 0 CST}
+ {215541000 37800 1 CST}
+ {226427400 34200 0 CST}
+ {246990600 37800 1 CST}
+ {257877000 34200 0 CST}
+ {278440200 37800 1 CST}
+ {289326600 34200 0 CST}
+ {309889800 37800 1 CST}
+ {320776200 34200 0 CST}
+ {341339400 37800 1 CST}
+ {352225800 34200 0 CST}
+ {372789000 37800 1 CST}
+ {384280200 34200 0 CST}
+ {404843400 37800 1 CST}
+ {415729800 34200 0 CST}
+ {436293000 37800 1 CST}
+ {447179400 34200 0 CST}
+ {467742600 37800 1 CST}
+ {478629000 34200 0 CST}
+ {499192200 37800 1 CST}
+ {511288200 34200 0 CST}
+ {530037000 37800 1 CST}
+ {542737800 34200 0 CST}
+ {562091400 37800 1 CST}
+ {574792200 34200 0 CST}
+ {594145800 37800 1 CST}
+ {606241800 34200 0 CST}
+ {625595400 37800 1 CST}
+ {637691400 34200 0 CST}
+ {657045000 37800 1 CST}
+ {667931400 34200 0 CST}
+ {688494600 37800 1 CST}
+ {701195400 34200 0 CST}
+ {719944200 37800 1 CST}
+ {731435400 34200 0 CST}
+ {751998600 37800 1 CST}
+ {764094600 34200 0 CST}
+ {783448200 37800 1 CST}
+ {796149000 34200 0 CST}
+ {814897800 37800 1 CST}
+ {828203400 34200 0 CST}
+ {846347400 37800 1 CST}
+ {859653000 34200 0 CST}
+ {877797000 37800 1 CST}
+ {891102600 34200 0 CST}
+ {909246600 37800 1 CST}
+ {922552200 34200 0 CST}
+ {941301000 37800 1 CST}
+ {954001800 34200 0 CST}
+ {972750600 37800 1 CST}
+ {985451400 34200 0 CST}
+ {1004200200 37800 1 CST}
+ {1017505800 34200 0 CST}
+ {1035649800 37800 1 CST}
+ {1048955400 34200 0 CST}
+ {1067099400 37800 1 CST}
+ {1080405000 34200 0 CST}
+ {1099153800 37800 1 CST}
+ {1111854600 34200 0 CST}
+ {1130603400 37800 1 CST}
+ {1143909000 34200 0 CST}
+ {1162053000 37800 1 CST}
+ {1174753800 34200 0 CST}
+ {1193502600 37800 1 CST}
+ {1207413000 34200 0 CST}
+ {1223137800 37800 1 CST}
+ {1238862600 34200 0 CST}
+ {1254587400 37800 1 CST}
+ {1270312200 34200 0 CST}
+ {1286037000 37800 1 CST}
+ {1301761800 34200 0 CST}
+ {1317486600 37800 1 CST}
+ {1333211400 34200 0 CST}
+ {1349541000 37800 1 CST}
+ {1365265800 34200 0 CST}
+ {1380990600 37800 1 CST}
+ {1396715400 34200 0 CST}
+ {1412440200 37800 1 CST}
+ {1428165000 34200 0 CST}
+ {1443889800 37800 1 CST}
+ {1459614600 34200 0 CST}
+ {1475339400 37800 1 CST}
+ {1491064200 34200 0 CST}
+ {1506789000 37800 1 CST}
+ {1522513800 34200 0 CST}
+ {1538843400 37800 1 CST}
+ {1554568200 34200 0 CST}
+ {1570293000 37800 1 CST}
+ {1586017800 34200 0 CST}
+ {1601742600 37800 1 CST}
+ {1617467400 34200 0 CST}
+ {1633192200 37800 1 CST}
+ {1648917000 34200 0 CST}
+ {1664641800 37800 1 CST}
+ {1680366600 34200 0 CST}
+ {1696091400 37800 1 CST}
+ {1712421000 34200 0 CST}
+ {1728145800 37800 1 CST}
+ {1743870600 34200 0 CST}
+ {1759595400 37800 1 CST}
+ {1775320200 34200 0 CST}
+ {1791045000 37800 1 CST}
+ {1806769800 34200 0 CST}
+ {1822494600 37800 1 CST}
+ {1838219400 34200 0 CST}
+ {1853944200 37800 1 CST}
+ {1869669000 34200 0 CST}
+ {1885998600 37800 1 CST}
+ {1901723400 34200 0 CST}
+ {1917448200 37800 1 CST}
+ {1933173000 34200 0 CST}
+ {1948897800 37800 1 CST}
+ {1964622600 34200 0 CST}
+ {1980347400 37800 1 CST}
+ {1996072200 34200 0 CST}
+ {2011797000 37800 1 CST}
+ {2027521800 34200 0 CST}
+ {2043246600 37800 1 CST}
+ {2058971400 34200 0 CST}
+ {2075301000 37800 1 CST}
+ {2091025800 34200 0 CST}
+ {2106750600 37800 1 CST}
+ {2122475400 34200 0 CST}
+ {2138200200 37800 1 CST}
+ {2153925000 34200 0 CST}
+ {2169649800 37800 1 CST}
+ {2185374600 34200 0 CST}
+ {2201099400 37800 1 CST}
+ {2216824200 34200 0 CST}
+ {2233153800 37800 1 CST}
+ {2248878600 34200 0 CST}
+ {2264603400 37800 1 CST}
+ {2280328200 34200 0 CST}
+ {2296053000 37800 1 CST}
+ {2311777800 34200 0 CST}
+ {2327502600 37800 1 CST}
+ {2343227400 34200 0 CST}
+ {2358952200 37800 1 CST}
+ {2374677000 34200 0 CST}
+ {2390401800 37800 1 CST}
+ {2406126600 34200 0 CST}
+ {2422456200 37800 1 CST}
+ {2438181000 34200 0 CST}
+ {2453905800 37800 1 CST}
+ {2469630600 34200 0 CST}
+ {2485355400 37800 1 CST}
+ {2501080200 34200 0 CST}
+ {2516805000 37800 1 CST}
+ {2532529800 34200 0 CST}
+ {2548254600 37800 1 CST}
+ {2563979400 34200 0 CST}
+ {2579704200 37800 1 CST}
+ {2596033800 34200 0 CST}
+ {2611758600 37800 1 CST}
+ {2627483400 34200 0 CST}
+ {2643208200 37800 1 CST}
+ {2658933000 34200 0 CST}
+ {2674657800 37800 1 CST}
+ {2690382600 34200 0 CST}
+ {2706107400 37800 1 CST}
+ {2721832200 34200 0 CST}
+ {2737557000 37800 1 CST}
+ {2753281800 34200 0 CST}
+ {2769611400 37800 1 CST}
+ {2785336200 34200 0 CST}
+ {2801061000 37800 1 CST}
+ {2816785800 34200 0 CST}
+ {2832510600 37800 1 CST}
+ {2848235400 34200 0 CST}
+ {2863960200 37800 1 CST}
+ {2879685000 34200 0 CST}
+ {2895409800 37800 1 CST}
+ {2911134600 34200 0 CST}
+ {2926859400 37800 1 CST}
+ {2942584200 34200 0 CST}
+ {2958913800 37800 1 CST}
+ {2974638600 34200 0 CST}
+ {2990363400 37800 1 CST}
+ {3006088200 34200 0 CST}
+ {3021813000 37800 1 CST}
+ {3037537800 34200 0 CST}
+ {3053262600 37800 1 CST}
+ {3068987400 34200 0 CST}
+ {3084712200 37800 1 CST}
+ {3100437000 34200 0 CST}
+ {3116766600 37800 1 CST}
+ {3132491400 34200 0 CST}
+ {3148216200 37800 1 CST}
+ {3163941000 34200 0 CST}
+ {3179665800 37800 1 CST}
+ {3195390600 34200 0 CST}
+ {3211115400 37800 1 CST}
+ {3226840200 34200 0 CST}
+ {3242565000 37800 1 CST}
+ {3258289800 34200 0 CST}
+ {3274014600 37800 1 CST}
+ {3289739400 34200 0 CST}
+ {3306069000 37800 1 CST}
+ {3321793800 34200 0 CST}
+ {3337518600 37800 1 CST}
+ {3353243400 34200 0 CST}
+ {3368968200 37800 1 CST}
+ {3384693000 34200 0 CST}
+ {3400417800 37800 1 CST}
+ {3416142600 34200 0 CST}
+ {3431867400 37800 1 CST}
+ {3447592200 34200 0 CST}
+ {3463317000 37800 1 CST}
+ {3479646600 34200 0 CST}
+ {3495371400 37800 1 CST}
+ {3511096200 34200 0 CST}
+ {3526821000 37800 1 CST}
+ {3542545800 34200 0 CST}
+ {3558270600 37800 1 CST}
+ {3573995400 34200 0 CST}
+ {3589720200 37800 1 CST}
+ {3605445000 34200 0 CST}
+ {3621169800 37800 1 CST}
+ {3636894600 34200 0 CST}
+ {3653224200 37800 1 CST}
+ {3668949000 34200 0 CST}
+ {3684673800 37800 1 CST}
+ {3700398600 34200 0 CST}
+ {3716123400 37800 1 CST}
+ {3731848200 34200 0 CST}
+ {3747573000 37800 1 CST}
+ {3763297800 34200 0 CST}
+ {3779022600 37800 1 CST}
+ {3794747400 34200 0 CST}
+ {3810472200 37800 1 CST}
+ {3826197000 34200 0 CST}
+ {3842526600 37800 1 CST}
+ {3858251400 34200 0 CST}
+ {3873976200 37800 1 CST}
+ {3889701000 34200 0 CST}
+ {3905425800 37800 1 CST}
+ {3921150600 34200 0 CST}
+ {3936875400 37800 1 CST}
+ {3952600200 34200 0 CST}
+ {3968325000 37800 1 CST}
+ {3984049800 34200 0 CST}
+ {4000379400 37800 1 CST}
+ {4016104200 34200 0 CST}
+ {4031829000 37800 1 CST}
+ {4047553800 34200 0 CST}
+ {4063278600 37800 1 CST}
+ {4079003400 34200 0 CST}
+ {4094728200 37800 1 CST}
}
diff --git a/library/tzdata/Australia/Brisbane b/library/tzdata/Australia/Brisbane
index b8008ba..fe6d154 100644
--- a/library/tzdata/Australia/Brisbane
+++ b/library/tzdata/Australia/Brisbane
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Brisbane) {
{-9223372036854775808 36728 0 LMT}
@@ -12,12 +12,12 @@ set TZData(:Australia/Brisbane) {
{-828345600 39600 1 EST}
{-813229200 36000 0 EST}
{31500000 36000 0 EST}
- {57722400 39600 1 EST}
- {68004000 36000 0 EST}
- {625629600 39600 1 EST}
- {636516000 36000 0 EST}
- {657079200 39600 1 EST}
- {667965600 36000 0 EST}
- {688528800 39600 1 EST}
- {699415200 36000 0 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {636480000 36000 0 EST}
+ {657043200 39600 1 EST}
+ {667929600 36000 0 EST}
+ {688492800 39600 1 EST}
+ {699379200 36000 0 EST}
}
diff --git a/library/tzdata/Australia/Broken_Hill b/library/tzdata/Australia/Broken_Hill
index 9045ba2..35cbb7e 100644
--- a/library/tzdata/Australia/Broken_Hill
+++ b/library/tzdata/Australia/Broken_Hill
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Broken_Hill) {
{-9223372036854775808 33948 0 LMT}
@@ -14,262 +14,262 @@ set TZData(:Australia/Broken_Hill) {
{-828343800 37800 1 CST}
{-813227400 34200 0 CST}
{31501800 34200 0 CST}
- {57722400 37800 1 CST}
- {68004000 34200 0 CST}
- {89172000 37800 1 CST}
- {100058400 34200 0 CST}
- {120621600 37800 1 CST}
- {131508000 34200 0 CST}
- {152071200 37800 1 CST}
- {162957600 34200 0 CST}
- {183520800 37800 1 CST}
- {195012000 34200 0 CST}
- {215575200 37800 1 CST}
- {226461600 34200 0 CST}
- {247024800 37800 1 CST}
- {257911200 34200 0 CST}
- {278474400 37800 1 CST}
- {289360800 34200 0 CST}
- {309924000 37800 1 CST}
- {320810400 34200 0 CST}
- {341373600 37800 1 CST}
- {352260000 34200 0 CST}
- {372823200 37800 1 CST}
- {386733600 34200 0 CST}
- {404877600 37800 1 CST}
- {415764000 34200 0 CST}
- {436327200 37800 1 CST}
- {447213600 34200 0 CST}
- {467776800 37800 1 CST}
- {478663200 34200 0 CST}
- {499226400 37800 1 CST}
- {511322400 34200 0 CST}
- {530071200 37800 1 CST}
- {542772000 34200 0 CST}
- {562125600 37800 1 CST}
- {574826400 34200 0 CST}
- {594180000 37800 1 CST}
- {606276000 34200 0 CST}
- {625629600 37800 1 CST}
- {636516000 34200 0 CST}
- {657079200 37800 1 CST}
- {667965600 34200 0 CST}
- {688528800 37800 1 CST}
- {699415200 34200 0 CST}
- {719978400 37800 1 CST}
- {731469600 34200 0 CST}
- {752032800 37800 1 CST}
- {762919200 34200 0 CST}
- {783482400 37800 1 CST}
- {794368800 34200 0 CST}
- {814932000 37800 1 CST}
- {828237600 34200 0 CST}
- {846381600 37800 1 CST}
- {859687200 34200 0 CST}
- {877831200 37800 1 CST}
- {891136800 34200 0 CST}
- {909280800 37800 1 CST}
- {922586400 34200 0 CST}
- {941335200 37800 1 CST}
+ {57688200 37800 1 CST}
+ {67969800 34200 0 CST}
+ {89137800 37800 1 CST}
+ {100024200 34200 0 CST}
+ {120587400 37800 1 CST}
+ {131473800 34200 0 CST}
+ {152037000 37800 1 CST}
+ {162923400 34200 0 CST}
+ {183486600 37800 1 CST}
+ {194977800 34200 0 CST}
+ {215541000 37800 1 CST}
+ {226427400 34200 0 CST}
+ {246990600 37800 1 CST}
+ {257877000 34200 0 CST}
+ {278440200 37800 1 CST}
+ {289326600 34200 0 CST}
+ {309889800 37800 1 CST}
+ {320776200 34200 0 CST}
+ {341339400 37800 1 CST}
+ {352225800 34200 0 CST}
+ {372789000 37800 1 CST}
+ {386699400 34200 0 CST}
+ {404843400 37800 1 CST}
+ {415729800 34200 0 CST}
+ {436293000 37800 1 CST}
+ {447179400 34200 0 CST}
+ {467742600 37800 1 CST}
+ {478629000 34200 0 CST}
+ {499192200 37800 1 CST}
+ {511288200 34200 0 CST}
+ {530037000 37800 1 CST}
+ {542737800 34200 0 CST}
+ {562091400 37800 1 CST}
+ {574792200 34200 0 CST}
+ {594145800 37800 1 CST}
+ {606241800 34200 0 CST}
+ {625595400 37800 1 CST}
+ {636481800 34200 0 CST}
+ {657045000 37800 1 CST}
+ {667931400 34200 0 CST}
+ {688494600 37800 1 CST}
+ {699381000 34200 0 CST}
+ {719944200 37800 1 CST}
+ {731435400 34200 0 CST}
+ {751998600 37800 1 CST}
+ {762885000 34200 0 CST}
+ {783448200 37800 1 CST}
+ {794334600 34200 0 CST}
+ {814897800 37800 1 CST}
+ {828203400 34200 0 CST}
+ {846347400 37800 1 CST}
+ {859653000 34200 0 CST}
+ {877797000 37800 1 CST}
+ {891102600 34200 0 CST}
+ {909246600 37800 1 CST}
+ {922552200 34200 0 CST}
+ {941301000 37800 1 CST}
{946647000 37800 0 CST}
- {954036000 34200 0 CST}
- {972784800 37800 1 CST}
- {985485600 34200 0 CST}
- {1004234400 37800 1 CST}
- {1017540000 34200 0 CST}
- {1035684000 37800 1 CST}
- {1048989600 34200 0 CST}
- {1067133600 37800 1 CST}
- {1080439200 34200 0 CST}
- {1099188000 37800 1 CST}
- {1111888800 34200 0 CST}
- {1130637600 37800 1 CST}
- {1143338400 34200 0 CST}
- {1162087200 37800 1 CST}
- {1174788000 34200 0 CST}
- {1193536800 37800 1 CST}
- {1206842400 34200 0 CST}
- {1224986400 37800 1 CST}
- {1238292000 34200 0 CST}
- {1256436000 37800 1 CST}
- {1269741600 34200 0 CST}
- {1288490400 37800 1 CST}
- {1301191200 34200 0 CST}
- {1319940000 37800 1 CST}
- {1332640800 34200 0 CST}
- {1351389600 37800 1 CST}
- {1364695200 34200 0 CST}
- {1382839200 37800 1 CST}
- {1396144800 34200 0 CST}
- {1414288800 37800 1 CST}
- {1427594400 34200 0 CST}
- {1445738400 37800 1 CST}
- {1459044000 34200 0 CST}
- {1477792800 37800 1 CST}
- {1490493600 34200 0 CST}
- {1509242400 37800 1 CST}
- {1521943200 34200 0 CST}
- {1540692000 37800 1 CST}
- {1553997600 34200 0 CST}
- {1572141600 37800 1 CST}
- {1585447200 34200 0 CST}
- {1603591200 37800 1 CST}
- {1616896800 34200 0 CST}
- {1635645600 37800 1 CST}
- {1648346400 34200 0 CST}
- {1667095200 37800 1 CST}
- {1679796000 34200 0 CST}
- {1698544800 37800 1 CST}
- {1711850400 34200 0 CST}
- {1729994400 37800 1 CST}
- {1743300000 34200 0 CST}
- {1761444000 37800 1 CST}
- {1774749600 34200 0 CST}
- {1792893600 37800 1 CST}
- {1806199200 34200 0 CST}
- {1824948000 37800 1 CST}
- {1837648800 34200 0 CST}
- {1856397600 37800 1 CST}
- {1869098400 34200 0 CST}
- {1887847200 37800 1 CST}
- {1901152800 34200 0 CST}
- {1919296800 37800 1 CST}
- {1932602400 34200 0 CST}
- {1950746400 37800 1 CST}
- {1964052000 34200 0 CST}
- {1982800800 37800 1 CST}
- {1995501600 34200 0 CST}
- {2014250400 37800 1 CST}
- {2026951200 34200 0 CST}
- {2045700000 37800 1 CST}
- {2058400800 34200 0 CST}
- {2077149600 37800 1 CST}
- {2090455200 34200 0 CST}
- {2108599200 37800 1 CST}
- {2121904800 34200 0 CST}
- {2140048800 37800 1 CST}
- {2153354400 34200 0 CST}
- {2172103200 37800 1 CST}
- {2184804000 34200 0 CST}
- {2203552800 37800 1 CST}
- {2216253600 34200 0 CST}
- {2235002400 37800 1 CST}
- {2248308000 34200 0 CST}
- {2266452000 37800 1 CST}
- {2279757600 34200 0 CST}
- {2297901600 37800 1 CST}
- {2311207200 34200 0 CST}
- {2329351200 37800 1 CST}
- {2342656800 34200 0 CST}
- {2361405600 37800 1 CST}
- {2374106400 34200 0 CST}
- {2392855200 37800 1 CST}
- {2405556000 34200 0 CST}
- {2424304800 37800 1 CST}
- {2437610400 34200 0 CST}
- {2455754400 37800 1 CST}
- {2469060000 34200 0 CST}
- {2487204000 37800 1 CST}
- {2500509600 34200 0 CST}
- {2519258400 37800 1 CST}
- {2531959200 34200 0 CST}
- {2550708000 37800 1 CST}
- {2563408800 34200 0 CST}
- {2582157600 37800 1 CST}
- {2595463200 34200 0 CST}
- {2613607200 37800 1 CST}
- {2626912800 34200 0 CST}
- {2645056800 37800 1 CST}
- {2658362400 34200 0 CST}
- {2676506400 37800 1 CST}
- {2689812000 34200 0 CST}
- {2708560800 37800 1 CST}
- {2721261600 34200 0 CST}
- {2740010400 37800 1 CST}
- {2752711200 34200 0 CST}
- {2771460000 37800 1 CST}
- {2784765600 34200 0 CST}
- {2802909600 37800 1 CST}
- {2816215200 34200 0 CST}
- {2834359200 37800 1 CST}
- {2847664800 34200 0 CST}
- {2866413600 37800 1 CST}
- {2879114400 34200 0 CST}
- {2897863200 37800 1 CST}
- {2910564000 34200 0 CST}
- {2929312800 37800 1 CST}
- {2942013600 34200 0 CST}
- {2960762400 37800 1 CST}
- {2974068000 34200 0 CST}
- {2992212000 37800 1 CST}
- {3005517600 34200 0 CST}
- {3023661600 37800 1 CST}
- {3036967200 34200 0 CST}
- {3055716000 37800 1 CST}
- {3068416800 34200 0 CST}
- {3087165600 37800 1 CST}
- {3099866400 34200 0 CST}
- {3118615200 37800 1 CST}
- {3131920800 34200 0 CST}
- {3150064800 37800 1 CST}
- {3163370400 34200 0 CST}
- {3181514400 37800 1 CST}
- {3194820000 34200 0 CST}
- {3212964000 37800 1 CST}
- {3226269600 34200 0 CST}
- {3245018400 37800 1 CST}
- {3257719200 34200 0 CST}
- {3276468000 37800 1 CST}
- {3289168800 34200 0 CST}
- {3307917600 37800 1 CST}
- {3321223200 34200 0 CST}
- {3339367200 37800 1 CST}
- {3352672800 34200 0 CST}
- {3370816800 37800 1 CST}
- {3384122400 34200 0 CST}
- {3402871200 37800 1 CST}
- {3415572000 34200 0 CST}
- {3434320800 37800 1 CST}
- {3447021600 34200 0 CST}
- {3465770400 37800 1 CST}
- {3479076000 34200 0 CST}
- {3497220000 37800 1 CST}
- {3510525600 34200 0 CST}
- {3528669600 37800 1 CST}
- {3541975200 34200 0 CST}
- {3560119200 37800 1 CST}
- {3573424800 34200 0 CST}
- {3592173600 37800 1 CST}
- {3604874400 34200 0 CST}
- {3623623200 37800 1 CST}
- {3636324000 34200 0 CST}
- {3655072800 37800 1 CST}
- {3668378400 34200 0 CST}
- {3686522400 37800 1 CST}
- {3699828000 34200 0 CST}
- {3717972000 37800 1 CST}
- {3731277600 34200 0 CST}
- {3750026400 37800 1 CST}
- {3762727200 34200 0 CST}
- {3781476000 37800 1 CST}
- {3794176800 34200 0 CST}
- {3812925600 37800 1 CST}
- {3825626400 34200 0 CST}
- {3844375200 37800 1 CST}
- {3857680800 34200 0 CST}
- {3875824800 37800 1 CST}
- {3889130400 34200 0 CST}
- {3907274400 37800 1 CST}
- {3920580000 34200 0 CST}
- {3939328800 37800 1 CST}
- {3952029600 34200 0 CST}
- {3970778400 37800 1 CST}
- {3983479200 34200 0 CST}
- {4002228000 37800 1 CST}
- {4015533600 34200 0 CST}
- {4033677600 37800 1 CST}
- {4046983200 34200 0 CST}
- {4065127200 37800 1 CST}
- {4078432800 34200 0 CST}
- {4096576800 37800 1 CST}
+ {954001800 34200 0 CST}
+ {972750600 37800 1 CST}
+ {985451400 34200 0 CST}
+ {1004200200 37800 1 CST}
+ {1017505800 34200 0 CST}
+ {1035649800 37800 1 CST}
+ {1048955400 34200 0 CST}
+ {1067099400 37800 1 CST}
+ {1080405000 34200 0 CST}
+ {1099153800 37800 1 CST}
+ {1111854600 34200 0 CST}
+ {1130603400 37800 1 CST}
+ {1143909000 34200 0 CST}
+ {1162053000 37800 1 CST}
+ {1174753800 34200 0 CST}
+ {1193502600 37800 1 CST}
+ {1207413000 34200 0 CST}
+ {1223137800 37800 1 CST}
+ {1238862600 34200 0 CST}
+ {1254587400 37800 1 CST}
+ {1270312200 34200 0 CST}
+ {1286037000 37800 1 CST}
+ {1301761800 34200 0 CST}
+ {1317486600 37800 1 CST}
+ {1333211400 34200 0 CST}
+ {1349541000 37800 1 CST}
+ {1365265800 34200 0 CST}
+ {1380990600 37800 1 CST}
+ {1396715400 34200 0 CST}
+ {1412440200 37800 1 CST}
+ {1428165000 34200 0 CST}
+ {1443889800 37800 1 CST}
+ {1459614600 34200 0 CST}
+ {1475339400 37800 1 CST}
+ {1491064200 34200 0 CST}
+ {1506789000 37800 1 CST}
+ {1522513800 34200 0 CST}
+ {1538843400 37800 1 CST}
+ {1554568200 34200 0 CST}
+ {1570293000 37800 1 CST}
+ {1586017800 34200 0 CST}
+ {1601742600 37800 1 CST}
+ {1617467400 34200 0 CST}
+ {1633192200 37800 1 CST}
+ {1648917000 34200 0 CST}
+ {1664641800 37800 1 CST}
+ {1680366600 34200 0 CST}
+ {1696091400 37800 1 CST}
+ {1712421000 34200 0 CST}
+ {1728145800 37800 1 CST}
+ {1743870600 34200 0 CST}
+ {1759595400 37800 1 CST}
+ {1775320200 34200 0 CST}
+ {1791045000 37800 1 CST}
+ {1806769800 34200 0 CST}
+ {1822494600 37800 1 CST}
+ {1838219400 34200 0 CST}
+ {1853944200 37800 1 CST}
+ {1869669000 34200 0 CST}
+ {1885998600 37800 1 CST}
+ {1901723400 34200 0 CST}
+ {1917448200 37800 1 CST}
+ {1933173000 34200 0 CST}
+ {1948897800 37800 1 CST}
+ {1964622600 34200 0 CST}
+ {1980347400 37800 1 CST}
+ {1996072200 34200 0 CST}
+ {2011797000 37800 1 CST}
+ {2027521800 34200 0 CST}
+ {2043246600 37800 1 CST}
+ {2058971400 34200 0 CST}
+ {2075301000 37800 1 CST}
+ {2091025800 34200 0 CST}
+ {2106750600 37800 1 CST}
+ {2122475400 34200 0 CST}
+ {2138200200 37800 1 CST}
+ {2153925000 34200 0 CST}
+ {2169649800 37800 1 CST}
+ {2185374600 34200 0 CST}
+ {2201099400 37800 1 CST}
+ {2216824200 34200 0 CST}
+ {2233153800 37800 1 CST}
+ {2248878600 34200 0 CST}
+ {2264603400 37800 1 CST}
+ {2280328200 34200 0 CST}
+ {2296053000 37800 1 CST}
+ {2311777800 34200 0 CST}
+ {2327502600 37800 1 CST}
+ {2343227400 34200 0 CST}
+ {2358952200 37800 1 CST}
+ {2374677000 34200 0 CST}
+ {2390401800 37800 1 CST}
+ {2406126600 34200 0 CST}
+ {2422456200 37800 1 CST}
+ {2438181000 34200 0 CST}
+ {2453905800 37800 1 CST}
+ {2469630600 34200 0 CST}
+ {2485355400 37800 1 CST}
+ {2501080200 34200 0 CST}
+ {2516805000 37800 1 CST}
+ {2532529800 34200 0 CST}
+ {2548254600 37800 1 CST}
+ {2563979400 34200 0 CST}
+ {2579704200 37800 1 CST}
+ {2596033800 34200 0 CST}
+ {2611758600 37800 1 CST}
+ {2627483400 34200 0 CST}
+ {2643208200 37800 1 CST}
+ {2658933000 34200 0 CST}
+ {2674657800 37800 1 CST}
+ {2690382600 34200 0 CST}
+ {2706107400 37800 1 CST}
+ {2721832200 34200 0 CST}
+ {2737557000 37800 1 CST}
+ {2753281800 34200 0 CST}
+ {2769611400 37800 1 CST}
+ {2785336200 34200 0 CST}
+ {2801061000 37800 1 CST}
+ {2816785800 34200 0 CST}
+ {2832510600 37800 1 CST}
+ {2848235400 34200 0 CST}
+ {2863960200 37800 1 CST}
+ {2879685000 34200 0 CST}
+ {2895409800 37800 1 CST}
+ {2911134600 34200 0 CST}
+ {2926859400 37800 1 CST}
+ {2942584200 34200 0 CST}
+ {2958913800 37800 1 CST}
+ {2974638600 34200 0 CST}
+ {2990363400 37800 1 CST}
+ {3006088200 34200 0 CST}
+ {3021813000 37800 1 CST}
+ {3037537800 34200 0 CST}
+ {3053262600 37800 1 CST}
+ {3068987400 34200 0 CST}
+ {3084712200 37800 1 CST}
+ {3100437000 34200 0 CST}
+ {3116766600 37800 1 CST}
+ {3132491400 34200 0 CST}
+ {3148216200 37800 1 CST}
+ {3163941000 34200 0 CST}
+ {3179665800 37800 1 CST}
+ {3195390600 34200 0 CST}
+ {3211115400 37800 1 CST}
+ {3226840200 34200 0 CST}
+ {3242565000 37800 1 CST}
+ {3258289800 34200 0 CST}
+ {3274014600 37800 1 CST}
+ {3289739400 34200 0 CST}
+ {3306069000 37800 1 CST}
+ {3321793800 34200 0 CST}
+ {3337518600 37800 1 CST}
+ {3353243400 34200 0 CST}
+ {3368968200 37800 1 CST}
+ {3384693000 34200 0 CST}
+ {3400417800 37800 1 CST}
+ {3416142600 34200 0 CST}
+ {3431867400 37800 1 CST}
+ {3447592200 34200 0 CST}
+ {3463317000 37800 1 CST}
+ {3479646600 34200 0 CST}
+ {3495371400 37800 1 CST}
+ {3511096200 34200 0 CST}
+ {3526821000 37800 1 CST}
+ {3542545800 34200 0 CST}
+ {3558270600 37800 1 CST}
+ {3573995400 34200 0 CST}
+ {3589720200 37800 1 CST}
+ {3605445000 34200 0 CST}
+ {3621169800 37800 1 CST}
+ {3636894600 34200 0 CST}
+ {3653224200 37800 1 CST}
+ {3668949000 34200 0 CST}
+ {3684673800 37800 1 CST}
+ {3700398600 34200 0 CST}
+ {3716123400 37800 1 CST}
+ {3731848200 34200 0 CST}
+ {3747573000 37800 1 CST}
+ {3763297800 34200 0 CST}
+ {3779022600 37800 1 CST}
+ {3794747400 34200 0 CST}
+ {3810472200 37800 1 CST}
+ {3826197000 34200 0 CST}
+ {3842526600 37800 1 CST}
+ {3858251400 34200 0 CST}
+ {3873976200 37800 1 CST}
+ {3889701000 34200 0 CST}
+ {3905425800 37800 1 CST}
+ {3921150600 34200 0 CST}
+ {3936875400 37800 1 CST}
+ {3952600200 34200 0 CST}
+ {3968325000 37800 1 CST}
+ {3984049800 34200 0 CST}
+ {4000379400 37800 1 CST}
+ {4016104200 34200 0 CST}
+ {4031829000 37800 1 CST}
+ {4047553800 34200 0 CST}
+ {4063278600 37800 1 CST}
+ {4079003400 34200 0 CST}
+ {4094728200 37800 1 CST}
}
diff --git a/library/tzdata/Australia/Canberra b/library/tzdata/Australia/Canberra
index e285d29..0b7b9ca 100644
--- a/library/tzdata/Australia/Canberra
+++ b/library/tzdata/Australia/Canberra
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Sydney)]} {
LoadTimeZoneFile Australia/Sydney
}
diff --git a/library/tzdata/Australia/Currie b/library/tzdata/Australia/Currie
new file mode 100644
index 0000000..ae6d1f0
--- /dev/null
+++ b/library/tzdata/Australia/Currie
@@ -0,0 +1,273 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Australia/Currie) {
+ {-9223372036854775808 34528 0 LMT}
+ {-2345794528 36000 0 EST}
+ {-1680508800 39600 1 EST}
+ {-1669892400 39600 0 EST}
+ {-1665392400 36000 0 EST}
+ {-883641600 39600 1 EST}
+ {-876128400 36000 0 EST}
+ {-860400000 39600 1 EST}
+ {-844678800 36000 0 EST}
+ {-828345600 39600 1 EST}
+ {-813229200 36000 0 EST}
+ {47138400 36000 0 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {89136000 39600 1 EST}
+ {100022400 36000 0 EST}
+ {120585600 39600 1 EST}
+ {131472000 36000 0 EST}
+ {152035200 39600 1 EST}
+ {162921600 36000 0 EST}
+ {183484800 39600 1 EST}
+ {194976000 36000 0 EST}
+ {215539200 39600 1 EST}
+ {226425600 36000 0 EST}
+ {246988800 39600 1 EST}
+ {257875200 36000 0 EST}
+ {278438400 39600 1 EST}
+ {289324800 36000 0 EST}
+ {309888000 39600 1 EST}
+ {320774400 36000 0 EST}
+ {341337600 39600 1 EST}
+ {352224000 36000 0 EST}
+ {372787200 39600 1 EST}
+ {386092800 36000 0 EST}
+ {404841600 39600 1 EST}
+ {417542400 36000 0 EST}
+ {436291200 39600 1 EST}
+ {447177600 36000 0 EST}
+ {467740800 39600 1 EST}
+ {478627200 36000 0 EST}
+ {499190400 39600 1 EST}
+ {510076800 36000 0 EST}
+ {530035200 39600 1 EST}
+ {542736000 36000 0 EST}
+ {562089600 39600 1 EST}
+ {574790400 36000 0 EST}
+ {594144000 39600 1 EST}
+ {606240000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {637689600 36000 0 EST}
+ {657043200 39600 1 EST}
+ {670348800 36000 0 EST}
+ {686678400 39600 1 EST}
+ {701798400 36000 0 EST}
+ {718128000 39600 1 EST}
+ {733248000 36000 0 EST}
+ {749577600 39600 1 EST}
+ {764697600 36000 0 EST}
+ {781027200 39600 1 EST}
+ {796147200 36000 0 EST}
+ {812476800 39600 1 EST}
+ {828201600 36000 0 EST}
+ {844531200 39600 1 EST}
+ {859651200 36000 0 EST}
+ {875980800 39600 1 EST}
+ {891100800 36000 0 EST}
+ {907430400 39600 1 EST}
+ {922550400 36000 0 EST}
+ {938880000 39600 1 EST}
+ {954000000 36000 0 EST}
+ {967305600 39600 1 EST}
+ {985449600 36000 0 EST}
+ {1002384000 39600 1 EST}
+ {1017504000 36000 0 EST}
+ {1033833600 39600 1 EST}
+ {1048953600 36000 0 EST}
+ {1065283200 39600 1 EST}
+ {1080403200 36000 0 EST}
+ {1096732800 39600 1 EST}
+ {1111852800 36000 0 EST}
+ {1128182400 39600 1 EST}
+ {1143907200 36000 0 EST}
+ {1159632000 39600 1 EST}
+ {1174752000 36000 0 EST}
+ {1191686400 39600 1 EST}
+ {1207411200 36000 0 EST}
+ {1223136000 39600 1 EST}
+ {1238860800 36000 0 EST}
+ {1254585600 39600 1 EST}
+ {1270310400 36000 0 EST}
+ {1286035200 39600 1 EST}
+ {1301760000 36000 0 EST}
+ {1317484800 39600 1 EST}
+ {1333209600 36000 0 EST}
+ {1349539200 39600 1 EST}
+ {1365264000 36000 0 EST}
+ {1380988800 39600 1 EST}
+ {1396713600 36000 0 EST}
+ {1412438400 39600 1 EST}
+ {1428163200 36000 0 EST}
+ {1443888000 39600 1 EST}
+ {1459612800 36000 0 EST}
+ {1475337600 39600 1 EST}
+ {1491062400 36000 0 EST}
+ {1506787200 39600 1 EST}
+ {1522512000 36000 0 EST}
+ {1538841600 39600 1 EST}
+ {1554566400 36000 0 EST}
+ {1570291200 39600 1 EST}
+ {1586016000 36000 0 EST}
+ {1601740800 39600 1 EST}
+ {1617465600 36000 0 EST}
+ {1633190400 39600 1 EST}
+ {1648915200 36000 0 EST}
+ {1664640000 39600 1 EST}
+ {1680364800 36000 0 EST}
+ {1696089600 39600 1 EST}
+ {1712419200 36000 0 EST}
+ {1728144000 39600 1 EST}
+ {1743868800 36000 0 EST}
+ {1759593600 39600 1 EST}
+ {1775318400 36000 0 EST}
+ {1791043200 39600 1 EST}
+ {1806768000 36000 0 EST}
+ {1822492800 39600 1 EST}
+ {1838217600 36000 0 EST}
+ {1853942400 39600 1 EST}
+ {1869667200 36000 0 EST}
+ {1885996800 39600 1 EST}
+ {1901721600 36000 0 EST}
+ {1917446400 39600 1 EST}
+ {1933171200 36000 0 EST}
+ {1948896000 39600 1 EST}
+ {1964620800 36000 0 EST}
+ {1980345600 39600 1 EST}
+ {1996070400 36000 0 EST}
+ {2011795200 39600 1 EST}
+ {2027520000 36000 0 EST}
+ {2043244800 39600 1 EST}
+ {2058969600 36000 0 EST}
+ {2075299200 39600 1 EST}
+ {2091024000 36000 0 EST}
+ {2106748800 39600 1 EST}
+ {2122473600 36000 0 EST}
+ {2138198400 39600 1 EST}
+ {2153923200 36000 0 EST}
+ {2169648000 39600 1 EST}
+ {2185372800 36000 0 EST}
+ {2201097600 39600 1 EST}
+ {2216822400 36000 0 EST}
+ {2233152000 39600 1 EST}
+ {2248876800 36000 0 EST}
+ {2264601600 39600 1 EST}
+ {2280326400 36000 0 EST}
+ {2296051200 39600 1 EST}
+ {2311776000 36000 0 EST}
+ {2327500800 39600 1 EST}
+ {2343225600 36000 0 EST}
+ {2358950400 39600 1 EST}
+ {2374675200 36000 0 EST}
+ {2390400000 39600 1 EST}
+ {2406124800 36000 0 EST}
+ {2422454400 39600 1 EST}
+ {2438179200 36000 0 EST}
+ {2453904000 39600 1 EST}
+ {2469628800 36000 0 EST}
+ {2485353600 39600 1 EST}
+ {2501078400 36000 0 EST}
+ {2516803200 39600 1 EST}
+ {2532528000 36000 0 EST}
+ {2548252800 39600 1 EST}
+ {2563977600 36000 0 EST}
+ {2579702400 39600 1 EST}
+ {2596032000 36000 0 EST}
+ {2611756800 39600 1 EST}
+ {2627481600 36000 0 EST}
+ {2643206400 39600 1 EST}
+ {2658931200 36000 0 EST}
+ {2674656000 39600 1 EST}
+ {2690380800 36000 0 EST}
+ {2706105600 39600 1 EST}
+ {2721830400 36000 0 EST}
+ {2737555200 39600 1 EST}
+ {2753280000 36000 0 EST}
+ {2769609600 39600 1 EST}
+ {2785334400 36000 0 EST}
+ {2801059200 39600 1 EST}
+ {2816784000 36000 0 EST}
+ {2832508800 39600 1 EST}
+ {2848233600 36000 0 EST}
+ {2863958400 39600 1 EST}
+ {2879683200 36000 0 EST}
+ {2895408000 39600 1 EST}
+ {2911132800 36000 0 EST}
+ {2926857600 39600 1 EST}
+ {2942582400 36000 0 EST}
+ {2958912000 39600 1 EST}
+ {2974636800 36000 0 EST}
+ {2990361600 39600 1 EST}
+ {3006086400 36000 0 EST}
+ {3021811200 39600 1 EST}
+ {3037536000 36000 0 EST}
+ {3053260800 39600 1 EST}
+ {3068985600 36000 0 EST}
+ {3084710400 39600 1 EST}
+ {3100435200 36000 0 EST}
+ {3116764800 39600 1 EST}
+ {3132489600 36000 0 EST}
+ {3148214400 39600 1 EST}
+ {3163939200 36000 0 EST}
+ {3179664000 39600 1 EST}
+ {3195388800 36000 0 EST}
+ {3211113600 39600 1 EST}
+ {3226838400 36000 0 EST}
+ {3242563200 39600 1 EST}
+ {3258288000 36000 0 EST}
+ {3274012800 39600 1 EST}
+ {3289737600 36000 0 EST}
+ {3306067200 39600 1 EST}
+ {3321792000 36000 0 EST}
+ {3337516800 39600 1 EST}
+ {3353241600 36000 0 EST}
+ {3368966400 39600 1 EST}
+ {3384691200 36000 0 EST}
+ {3400416000 39600 1 EST}
+ {3416140800 36000 0 EST}
+ {3431865600 39600 1 EST}
+ {3447590400 36000 0 EST}
+ {3463315200 39600 1 EST}
+ {3479644800 36000 0 EST}
+ {3495369600 39600 1 EST}
+ {3511094400 36000 0 EST}
+ {3526819200 39600 1 EST}
+ {3542544000 36000 0 EST}
+ {3558268800 39600 1 EST}
+ {3573993600 36000 0 EST}
+ {3589718400 39600 1 EST}
+ {3605443200 36000 0 EST}
+ {3621168000 39600 1 EST}
+ {3636892800 36000 0 EST}
+ {3653222400 39600 1 EST}
+ {3668947200 36000 0 EST}
+ {3684672000 39600 1 EST}
+ {3700396800 36000 0 EST}
+ {3716121600 39600 1 EST}
+ {3731846400 36000 0 EST}
+ {3747571200 39600 1 EST}
+ {3763296000 36000 0 EST}
+ {3779020800 39600 1 EST}
+ {3794745600 36000 0 EST}
+ {3810470400 39600 1 EST}
+ {3826195200 36000 0 EST}
+ {3842524800 39600 1 EST}
+ {3858249600 36000 0 EST}
+ {3873974400 39600 1 EST}
+ {3889699200 36000 0 EST}
+ {3905424000 39600 1 EST}
+ {3921148800 36000 0 EST}
+ {3936873600 39600 1 EST}
+ {3952598400 36000 0 EST}
+ {3968323200 39600 1 EST}
+ {3984048000 36000 0 EST}
+ {4000377600 39600 1 EST}
+ {4016102400 36000 0 EST}
+ {4031827200 39600 1 EST}
+ {4047552000 36000 0 EST}
+ {4063276800 39600 1 EST}
+ {4079001600 36000 0 EST}
+ {4094726400 39600 1 EST}
+}
diff --git a/library/tzdata/Australia/Darwin b/library/tzdata/Australia/Darwin
index 20c532b..9be372d 100644
--- a/library/tzdata/Australia/Darwin
+++ b/library/tzdata/Australia/Darwin
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Darwin) {
{-9223372036854775808 31400 0 LMT}
diff --git a/library/tzdata/Australia/Eucla b/library/tzdata/Australia/Eucla
new file mode 100644
index 0000000..0f8ed4d
--- /dev/null
+++ b/library/tzdata/Australia/Eucla
@@ -0,0 +1,25 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Australia/Eucla) {
+ {-9223372036854775808 30928 0 LMT}
+ {-2337928528 31500 0 CWST}
+ {-1672562640 35100 1 CWST}
+ {-1665387900 31500 0 CWST}
+ {-883637100 35100 1 CWST}
+ {-876123900 31500 0 CWST}
+ {-860395500 35100 1 CWST}
+ {-844674300 31500 0 CWST}
+ {-836473500 35100 0 CWST}
+ {152039700 35100 1 CWST}
+ {162926100 31500 0 CWST}
+ {436295700 35100 1 CWST}
+ {447182100 31500 0 CWST}
+ {690311700 35100 1 CWST}
+ {699383700 31500 0 CWST}
+ {1165079700 35100 1 CWST}
+ {1174756500 31500 0 CWST}
+ {1193505300 35100 1 CWST}
+ {1206810900 31500 0 CWST}
+ {1224954900 35100 1 CWST}
+ {1238260500 31500 0 CWST}
+}
diff --git a/library/tzdata/Australia/Hobart b/library/tzdata/Australia/Hobart
index 7a6cc85..8f27110 100644
--- a/library/tzdata/Australia/Hobart
+++ b/library/tzdata/Australia/Hobart
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Hobart) {
{-9223372036854775808 35356 0 LMT}
@@ -13,269 +13,269 @@ set TZData(:Australia/Hobart) {
{-828345600 39600 1 EST}
{-813229200 36000 0 EST}
{-94730400 36000 0 EST}
- {-71100000 39600 1 EST}
- {-55375200 36000 0 EST}
- {-37231200 39600 1 EST}
- {-25740000 36000 0 EST}
- {-5781600 39600 1 EST}
- {5709600 36000 0 EST}
- {25668000 39600 1 EST}
- {37764000 36000 0 EST}
- {57722400 39600 1 EST}
- {68004000 36000 0 EST}
- {89172000 39600 1 EST}
- {100058400 36000 0 EST}
- {120621600 39600 1 EST}
- {131508000 36000 0 EST}
- {152071200 39600 1 EST}
- {162957600 36000 0 EST}
- {183520800 39600 1 EST}
- {195012000 36000 0 EST}
- {215575200 39600 1 EST}
- {226461600 36000 0 EST}
- {247024800 39600 1 EST}
- {257911200 36000 0 EST}
- {278474400 39600 1 EST}
- {289360800 36000 0 EST}
- {309924000 39600 1 EST}
- {320810400 36000 0 EST}
- {341373600 39600 1 EST}
- {352260000 36000 0 EST}
- {372823200 39600 1 EST}
- {386128800 36000 0 EST}
- {404877600 39600 1 EST}
- {417578400 36000 0 EST}
- {436327200 39600 1 EST}
- {447213600 36000 0 EST}
- {467776800 39600 1 EST}
- {478663200 36000 0 EST}
- {499226400 39600 1 EST}
- {510112800 36000 0 EST}
- {530071200 39600 1 EST}
- {542772000 36000 0 EST}
- {562125600 39600 1 EST}
- {574826400 36000 0 EST}
- {594180000 39600 1 EST}
- {606276000 36000 0 EST}
- {625629600 39600 1 EST}
- {637725600 36000 0 EST}
- {657079200 39600 1 EST}
- {670384800 36000 0 EST}
- {686714400 39600 1 EST}
- {701834400 36000 0 EST}
- {718164000 39600 1 EST}
- {733284000 36000 0 EST}
- {749613600 39600 1 EST}
- {764733600 36000 0 EST}
- {781063200 39600 1 EST}
- {796183200 36000 0 EST}
- {812512800 39600 1 EST}
- {828237600 36000 0 EST}
- {844567200 39600 1 EST}
- {859687200 36000 0 EST}
- {876016800 39600 1 EST}
- {891136800 36000 0 EST}
- {907466400 39600 1 EST}
- {922586400 36000 0 EST}
- {938916000 39600 1 EST}
- {954036000 36000 0 EST}
- {967341600 39600 1 EST}
- {985485600 36000 0 EST}
- {1002420000 39600 1 EST}
- {1017540000 36000 0 EST}
- {1033869600 39600 1 EST}
- {1048989600 36000 0 EST}
- {1065319200 39600 1 EST}
- {1080439200 36000 0 EST}
- {1096768800 39600 1 EST}
- {1111888800 36000 0 EST}
- {1128218400 39600 1 EST}
- {1143338400 36000 0 EST}
- {1159668000 39600 1 EST}
- {1174788000 36000 0 EST}
- {1191722400 39600 1 EST}
- {1206842400 36000 0 EST}
- {1223172000 39600 1 EST}
- {1238292000 36000 0 EST}
- {1254621600 39600 1 EST}
- {1269741600 36000 0 EST}
- {1286071200 39600 1 EST}
- {1301191200 36000 0 EST}
- {1317520800 39600 1 EST}
- {1332640800 36000 0 EST}
- {1349575200 39600 1 EST}
- {1364695200 36000 0 EST}
- {1381024800 39600 1 EST}
- {1396144800 36000 0 EST}
- {1412474400 39600 1 EST}
- {1427594400 36000 0 EST}
- {1443924000 39600 1 EST}
- {1459044000 36000 0 EST}
- {1475373600 39600 1 EST}
- {1490493600 36000 0 EST}
- {1506823200 39600 1 EST}
- {1521943200 36000 0 EST}
- {1538877600 39600 1 EST}
- {1553997600 36000 0 EST}
- {1570327200 39600 1 EST}
- {1585447200 36000 0 EST}
- {1601776800 39600 1 EST}
- {1616896800 36000 0 EST}
- {1633226400 39600 1 EST}
- {1648346400 36000 0 EST}
- {1664676000 39600 1 EST}
- {1679796000 36000 0 EST}
- {1696125600 39600 1 EST}
- {1711850400 36000 0 EST}
- {1728180000 39600 1 EST}
- {1743300000 36000 0 EST}
- {1759629600 39600 1 EST}
- {1774749600 36000 0 EST}
- {1791079200 39600 1 EST}
- {1806199200 36000 0 EST}
- {1822528800 39600 1 EST}
- {1837648800 36000 0 EST}
- {1853978400 39600 1 EST}
- {1869098400 36000 0 EST}
- {1886032800 39600 1 EST}
- {1901152800 36000 0 EST}
- {1917482400 39600 1 EST}
- {1932602400 36000 0 EST}
- {1948932000 39600 1 EST}
- {1964052000 36000 0 EST}
- {1980381600 39600 1 EST}
- {1995501600 36000 0 EST}
- {2011831200 39600 1 EST}
- {2026951200 36000 0 EST}
- {2043280800 39600 1 EST}
- {2058400800 36000 0 EST}
- {2075335200 39600 1 EST}
- {2090455200 36000 0 EST}
- {2106784800 39600 1 EST}
- {2121904800 36000 0 EST}
- {2138234400 39600 1 EST}
- {2153354400 36000 0 EST}
- {2169684000 39600 1 EST}
- {2184804000 36000 0 EST}
- {2201133600 39600 1 EST}
- {2216253600 36000 0 EST}
- {2233188000 39600 1 EST}
- {2248308000 36000 0 EST}
- {2264637600 39600 1 EST}
- {2279757600 36000 0 EST}
- {2296087200 39600 1 EST}
- {2311207200 36000 0 EST}
- {2327536800 39600 1 EST}
- {2342656800 36000 0 EST}
- {2358986400 39600 1 EST}
- {2374106400 36000 0 EST}
- {2390436000 39600 1 EST}
- {2405556000 36000 0 EST}
- {2422490400 39600 1 EST}
- {2437610400 36000 0 EST}
- {2453940000 39600 1 EST}
- {2469060000 36000 0 EST}
- {2485389600 39600 1 EST}
- {2500509600 36000 0 EST}
- {2516839200 39600 1 EST}
- {2531959200 36000 0 EST}
- {2548288800 39600 1 EST}
- {2563408800 36000 0 EST}
- {2579738400 39600 1 EST}
- {2595463200 36000 0 EST}
- {2611792800 39600 1 EST}
- {2626912800 36000 0 EST}
- {2643242400 39600 1 EST}
- {2658362400 36000 0 EST}
- {2674692000 39600 1 EST}
- {2689812000 36000 0 EST}
- {2706141600 39600 1 EST}
- {2721261600 36000 0 EST}
- {2737591200 39600 1 EST}
- {2752711200 36000 0 EST}
- {2769645600 39600 1 EST}
- {2784765600 36000 0 EST}
- {2801095200 39600 1 EST}
- {2816215200 36000 0 EST}
- {2832544800 39600 1 EST}
- {2847664800 36000 0 EST}
- {2863994400 39600 1 EST}
- {2879114400 36000 0 EST}
- {2895444000 39600 1 EST}
- {2910564000 36000 0 EST}
- {2926893600 39600 1 EST}
- {2942013600 36000 0 EST}
- {2958948000 39600 1 EST}
- {2974068000 36000 0 EST}
- {2990397600 39600 1 EST}
- {3005517600 36000 0 EST}
- {3021847200 39600 1 EST}
- {3036967200 36000 0 EST}
- {3053296800 39600 1 EST}
- {3068416800 36000 0 EST}
- {3084746400 39600 1 EST}
- {3099866400 36000 0 EST}
- {3116800800 39600 1 EST}
- {3131920800 36000 0 EST}
- {3148250400 39600 1 EST}
- {3163370400 36000 0 EST}
- {3179700000 39600 1 EST}
- {3194820000 36000 0 EST}
- {3211149600 39600 1 EST}
- {3226269600 36000 0 EST}
- {3242599200 39600 1 EST}
- {3257719200 36000 0 EST}
- {3274048800 39600 1 EST}
- {3289168800 36000 0 EST}
- {3306103200 39600 1 EST}
- {3321223200 36000 0 EST}
- {3337552800 39600 1 EST}
- {3352672800 36000 0 EST}
- {3369002400 39600 1 EST}
- {3384122400 36000 0 EST}
- {3400452000 39600 1 EST}
- {3415572000 36000 0 EST}
- {3431901600 39600 1 EST}
- {3447021600 36000 0 EST}
- {3463351200 39600 1 EST}
- {3479076000 36000 0 EST}
- {3495405600 39600 1 EST}
- {3510525600 36000 0 EST}
- {3526855200 39600 1 EST}
- {3541975200 36000 0 EST}
- {3558304800 39600 1 EST}
- {3573424800 36000 0 EST}
- {3589754400 39600 1 EST}
- {3604874400 36000 0 EST}
- {3621204000 39600 1 EST}
- {3636324000 36000 0 EST}
- {3653258400 39600 1 EST}
- {3668378400 36000 0 EST}
- {3684708000 39600 1 EST}
- {3699828000 36000 0 EST}
- {3716157600 39600 1 EST}
- {3731277600 36000 0 EST}
- {3747607200 39600 1 EST}
- {3762727200 36000 0 EST}
- {3779056800 39600 1 EST}
- {3794176800 36000 0 EST}
- {3810506400 39600 1 EST}
- {3825626400 36000 0 EST}
- {3842560800 39600 1 EST}
- {3857680800 36000 0 EST}
- {3874010400 39600 1 EST}
- {3889130400 36000 0 EST}
- {3905460000 39600 1 EST}
- {3920580000 36000 0 EST}
- {3936909600 39600 1 EST}
- {3952029600 36000 0 EST}
- {3968359200 39600 1 EST}
- {3983479200 36000 0 EST}
- {4000413600 39600 1 EST}
- {4015533600 36000 0 EST}
- {4031863200 39600 1 EST}
- {4046983200 36000 0 EST}
- {4063312800 39600 1 EST}
- {4078432800 36000 0 EST}
- {4094762400 39600 1 EST}
+ {-71136000 39600 1 EST}
+ {-55411200 36000 0 EST}
+ {-37267200 39600 1 EST}
+ {-25776000 36000 0 EST}
+ {-5817600 39600 1 EST}
+ {5673600 36000 0 EST}
+ {25632000 39600 1 EST}
+ {37728000 36000 0 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {89136000 39600 1 EST}
+ {100022400 36000 0 EST}
+ {120585600 39600 1 EST}
+ {131472000 36000 0 EST}
+ {152035200 39600 1 EST}
+ {162921600 36000 0 EST}
+ {183484800 39600 1 EST}
+ {194976000 36000 0 EST}
+ {215539200 39600 1 EST}
+ {226425600 36000 0 EST}
+ {246988800 39600 1 EST}
+ {257875200 36000 0 EST}
+ {278438400 39600 1 EST}
+ {289324800 36000 0 EST}
+ {309888000 39600 1 EST}
+ {320774400 36000 0 EST}
+ {341337600 39600 1 EST}
+ {352224000 36000 0 EST}
+ {372787200 39600 1 EST}
+ {386092800 36000 0 EST}
+ {404841600 39600 1 EST}
+ {417542400 36000 0 EST}
+ {436291200 39600 1 EST}
+ {447177600 36000 0 EST}
+ {467740800 39600 1 EST}
+ {478627200 36000 0 EST}
+ {499190400 39600 1 EST}
+ {510076800 36000 0 EST}
+ {530035200 39600 1 EST}
+ {542736000 36000 0 EST}
+ {562089600 39600 1 EST}
+ {574790400 36000 0 EST}
+ {594144000 39600 1 EST}
+ {606240000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {637689600 36000 0 EST}
+ {657043200 39600 1 EST}
+ {670348800 36000 0 EST}
+ {686678400 39600 1 EST}
+ {701798400 36000 0 EST}
+ {718128000 39600 1 EST}
+ {733248000 36000 0 EST}
+ {749577600 39600 1 EST}
+ {764697600 36000 0 EST}
+ {781027200 39600 1 EST}
+ {796147200 36000 0 EST}
+ {812476800 39600 1 EST}
+ {828201600 36000 0 EST}
+ {844531200 39600 1 EST}
+ {859651200 36000 0 EST}
+ {875980800 39600 1 EST}
+ {891100800 36000 0 EST}
+ {907430400 39600 1 EST}
+ {922550400 36000 0 EST}
+ {938880000 39600 1 EST}
+ {954000000 36000 0 EST}
+ {967305600 39600 1 EST}
+ {985449600 36000 0 EST}
+ {1002384000 39600 1 EST}
+ {1017504000 36000 0 EST}
+ {1033833600 39600 1 EST}
+ {1048953600 36000 0 EST}
+ {1065283200 39600 1 EST}
+ {1080403200 36000 0 EST}
+ {1096732800 39600 1 EST}
+ {1111852800 36000 0 EST}
+ {1128182400 39600 1 EST}
+ {1143907200 36000 0 EST}
+ {1159632000 39600 1 EST}
+ {1174752000 36000 0 EST}
+ {1191686400 39600 1 EST}
+ {1207411200 36000 0 EST}
+ {1223136000 39600 1 EST}
+ {1238860800 36000 0 EST}
+ {1254585600 39600 1 EST}
+ {1270310400 36000 0 EST}
+ {1286035200 39600 1 EST}
+ {1301760000 36000 0 EST}
+ {1317484800 39600 1 EST}
+ {1333209600 36000 0 EST}
+ {1349539200 39600 1 EST}
+ {1365264000 36000 0 EST}
+ {1380988800 39600 1 EST}
+ {1396713600 36000 0 EST}
+ {1412438400 39600 1 EST}
+ {1428163200 36000 0 EST}
+ {1443888000 39600 1 EST}
+ {1459612800 36000 0 EST}
+ {1475337600 39600 1 EST}
+ {1491062400 36000 0 EST}
+ {1506787200 39600 1 EST}
+ {1522512000 36000 0 EST}
+ {1538841600 39600 1 EST}
+ {1554566400 36000 0 EST}
+ {1570291200 39600 1 EST}
+ {1586016000 36000 0 EST}
+ {1601740800 39600 1 EST}
+ {1617465600 36000 0 EST}
+ {1633190400 39600 1 EST}
+ {1648915200 36000 0 EST}
+ {1664640000 39600 1 EST}
+ {1680364800 36000 0 EST}
+ {1696089600 39600 1 EST}
+ {1712419200 36000 0 EST}
+ {1728144000 39600 1 EST}
+ {1743868800 36000 0 EST}
+ {1759593600 39600 1 EST}
+ {1775318400 36000 0 EST}
+ {1791043200 39600 1 EST}
+ {1806768000 36000 0 EST}
+ {1822492800 39600 1 EST}
+ {1838217600 36000 0 EST}
+ {1853942400 39600 1 EST}
+ {1869667200 36000 0 EST}
+ {1885996800 39600 1 EST}
+ {1901721600 36000 0 EST}
+ {1917446400 39600 1 EST}
+ {1933171200 36000 0 EST}
+ {1948896000 39600 1 EST}
+ {1964620800 36000 0 EST}
+ {1980345600 39600 1 EST}
+ {1996070400 36000 0 EST}
+ {2011795200 39600 1 EST}
+ {2027520000 36000 0 EST}
+ {2043244800 39600 1 EST}
+ {2058969600 36000 0 EST}
+ {2075299200 39600 1 EST}
+ {2091024000 36000 0 EST}
+ {2106748800 39600 1 EST}
+ {2122473600 36000 0 EST}
+ {2138198400 39600 1 EST}
+ {2153923200 36000 0 EST}
+ {2169648000 39600 1 EST}
+ {2185372800 36000 0 EST}
+ {2201097600 39600 1 EST}
+ {2216822400 36000 0 EST}
+ {2233152000 39600 1 EST}
+ {2248876800 36000 0 EST}
+ {2264601600 39600 1 EST}
+ {2280326400 36000 0 EST}
+ {2296051200 39600 1 EST}
+ {2311776000 36000 0 EST}
+ {2327500800 39600 1 EST}
+ {2343225600 36000 0 EST}
+ {2358950400 39600 1 EST}
+ {2374675200 36000 0 EST}
+ {2390400000 39600 1 EST}
+ {2406124800 36000 0 EST}
+ {2422454400 39600 1 EST}
+ {2438179200 36000 0 EST}
+ {2453904000 39600 1 EST}
+ {2469628800 36000 0 EST}
+ {2485353600 39600 1 EST}
+ {2501078400 36000 0 EST}
+ {2516803200 39600 1 EST}
+ {2532528000 36000 0 EST}
+ {2548252800 39600 1 EST}
+ {2563977600 36000 0 EST}
+ {2579702400 39600 1 EST}
+ {2596032000 36000 0 EST}
+ {2611756800 39600 1 EST}
+ {2627481600 36000 0 EST}
+ {2643206400 39600 1 EST}
+ {2658931200 36000 0 EST}
+ {2674656000 39600 1 EST}
+ {2690380800 36000 0 EST}
+ {2706105600 39600 1 EST}
+ {2721830400 36000 0 EST}
+ {2737555200 39600 1 EST}
+ {2753280000 36000 0 EST}
+ {2769609600 39600 1 EST}
+ {2785334400 36000 0 EST}
+ {2801059200 39600 1 EST}
+ {2816784000 36000 0 EST}
+ {2832508800 39600 1 EST}
+ {2848233600 36000 0 EST}
+ {2863958400 39600 1 EST}
+ {2879683200 36000 0 EST}
+ {2895408000 39600 1 EST}
+ {2911132800 36000 0 EST}
+ {2926857600 39600 1 EST}
+ {2942582400 36000 0 EST}
+ {2958912000 39600 1 EST}
+ {2974636800 36000 0 EST}
+ {2990361600 39600 1 EST}
+ {3006086400 36000 0 EST}
+ {3021811200 39600 1 EST}
+ {3037536000 36000 0 EST}
+ {3053260800 39600 1 EST}
+ {3068985600 36000 0 EST}
+ {3084710400 39600 1 EST}
+ {3100435200 36000 0 EST}
+ {3116764800 39600 1 EST}
+ {3132489600 36000 0 EST}
+ {3148214400 39600 1 EST}
+ {3163939200 36000 0 EST}
+ {3179664000 39600 1 EST}
+ {3195388800 36000 0 EST}
+ {3211113600 39600 1 EST}
+ {3226838400 36000 0 EST}
+ {3242563200 39600 1 EST}
+ {3258288000 36000 0 EST}
+ {3274012800 39600 1 EST}
+ {3289737600 36000 0 EST}
+ {3306067200 39600 1 EST}
+ {3321792000 36000 0 EST}
+ {3337516800 39600 1 EST}
+ {3353241600 36000 0 EST}
+ {3368966400 39600 1 EST}
+ {3384691200 36000 0 EST}
+ {3400416000 39600 1 EST}
+ {3416140800 36000 0 EST}
+ {3431865600 39600 1 EST}
+ {3447590400 36000 0 EST}
+ {3463315200 39600 1 EST}
+ {3479644800 36000 0 EST}
+ {3495369600 39600 1 EST}
+ {3511094400 36000 0 EST}
+ {3526819200 39600 1 EST}
+ {3542544000 36000 0 EST}
+ {3558268800 39600 1 EST}
+ {3573993600 36000 0 EST}
+ {3589718400 39600 1 EST}
+ {3605443200 36000 0 EST}
+ {3621168000 39600 1 EST}
+ {3636892800 36000 0 EST}
+ {3653222400 39600 1 EST}
+ {3668947200 36000 0 EST}
+ {3684672000 39600 1 EST}
+ {3700396800 36000 0 EST}
+ {3716121600 39600 1 EST}
+ {3731846400 36000 0 EST}
+ {3747571200 39600 1 EST}
+ {3763296000 36000 0 EST}
+ {3779020800 39600 1 EST}
+ {3794745600 36000 0 EST}
+ {3810470400 39600 1 EST}
+ {3826195200 36000 0 EST}
+ {3842524800 39600 1 EST}
+ {3858249600 36000 0 EST}
+ {3873974400 39600 1 EST}
+ {3889699200 36000 0 EST}
+ {3905424000 39600 1 EST}
+ {3921148800 36000 0 EST}
+ {3936873600 39600 1 EST}
+ {3952598400 36000 0 EST}
+ {3968323200 39600 1 EST}
+ {3984048000 36000 0 EST}
+ {4000377600 39600 1 EST}
+ {4016102400 36000 0 EST}
+ {4031827200 39600 1 EST}
+ {4047552000 36000 0 EST}
+ {4063276800 39600 1 EST}
+ {4079001600 36000 0 EST}
+ {4094726400 39600 1 EST}
}
diff --git a/library/tzdata/Australia/LHI b/library/tzdata/Australia/LHI
index 46fbef8..ddc79ce 100644
--- a/library/tzdata/Australia/LHI
+++ b/library/tzdata/Australia/LHI
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Lord_Howe)]} {
LoadTimeZoneFile Australia/Lord_Howe
}
diff --git a/library/tzdata/Australia/Lindeman b/library/tzdata/Australia/Lindeman
index 5e0e6a1..de11c35 100644
--- a/library/tzdata/Australia/Lindeman
+++ b/library/tzdata/Australia/Lindeman
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Lindeman) {
{-9223372036854775808 35756 0 LMT}
@@ -12,17 +12,17 @@ set TZData(:Australia/Lindeman) {
{-828345600 39600 1 EST}
{-813229200 36000 0 EST}
{31500000 36000 0 EST}
- {57722400 39600 1 EST}
- {68004000 36000 0 EST}
- {625629600 39600 1 EST}
- {636516000 36000 0 EST}
- {657079200 39600 1 EST}
- {667965600 36000 0 EST}
- {688528800 39600 1 EST}
- {699415200 36000 0 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {636480000 36000 0 EST}
+ {657043200 39600 1 EST}
+ {667929600 36000 0 EST}
+ {688492800 39600 1 EST}
+ {699379200 36000 0 EST}
{709912800 36000 0 EST}
- {719978400 39600 1 EST}
- {731469600 36000 0 EST}
- {752032800 39600 1 EST}
- {762919200 36000 0 EST}
+ {719942400 39600 1 EST}
+ {731433600 36000 0 EST}
+ {751996800 39600 1 EST}
+ {762883200 36000 0 EST}
}
diff --git a/library/tzdata/Australia/Lord_Howe b/library/tzdata/Australia/Lord_Howe
index da561a3..da094e5 100644
--- a/library/tzdata/Australia/Lord_Howe
+++ b/library/tzdata/Australia/Lord_Howe
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Lord_Howe) {
{-9223372036854775808 38180 0 LMT}
@@ -53,192 +53,192 @@ set TZData(:Australia/Lord_Howe) {
{1099150200 39600 1 LHST}
{1111849200 37800 0 LHST}
{1130599800 39600 1 LHST}
- {1143298800 37800 0 LHST}
+ {1143903600 37800 0 LHST}
{1162049400 39600 1 LHST}
{1174748400 37800 0 LHST}
{1193499000 39600 1 LHST}
- {1206802800 37800 0 LHST}
- {1224948600 39600 1 LHST}
- {1238252400 37800 0 LHST}
- {1256398200 39600 1 LHST}
- {1269702000 37800 0 LHST}
- {1288452600 39600 1 LHST}
- {1301151600 37800 0 LHST}
- {1319902200 39600 1 LHST}
- {1332601200 37800 0 LHST}
- {1351351800 39600 1 LHST}
- {1364655600 37800 0 LHST}
- {1382801400 39600 1 LHST}
- {1396105200 37800 0 LHST}
- {1414251000 39600 1 LHST}
- {1427554800 37800 0 LHST}
- {1445700600 39600 1 LHST}
- {1459004400 37800 0 LHST}
- {1477755000 39600 1 LHST}
- {1490454000 37800 0 LHST}
- {1509204600 39600 1 LHST}
- {1521903600 37800 0 LHST}
- {1540654200 39600 1 LHST}
- {1553958000 37800 0 LHST}
- {1572103800 39600 1 LHST}
- {1585407600 37800 0 LHST}
- {1603553400 39600 1 LHST}
- {1616857200 37800 0 LHST}
- {1635607800 39600 1 LHST}
- {1648306800 37800 0 LHST}
- {1667057400 39600 1 LHST}
- {1679756400 37800 0 LHST}
- {1698507000 39600 1 LHST}
- {1711810800 37800 0 LHST}
- {1729956600 39600 1 LHST}
- {1743260400 37800 0 LHST}
- {1761406200 39600 1 LHST}
- {1774710000 37800 0 LHST}
- {1792855800 39600 1 LHST}
- {1806159600 37800 0 LHST}
- {1824910200 39600 1 LHST}
- {1837609200 37800 0 LHST}
- {1856359800 39600 1 LHST}
- {1869058800 37800 0 LHST}
- {1887809400 39600 1 LHST}
- {1901113200 37800 0 LHST}
- {1919259000 39600 1 LHST}
- {1932562800 37800 0 LHST}
- {1950708600 39600 1 LHST}
- {1964012400 37800 0 LHST}
- {1982763000 39600 1 LHST}
- {1995462000 37800 0 LHST}
- {2014212600 39600 1 LHST}
- {2026911600 37800 0 LHST}
- {2045662200 39600 1 LHST}
- {2058361200 37800 0 LHST}
- {2077111800 39600 1 LHST}
- {2090415600 37800 0 LHST}
- {2108561400 39600 1 LHST}
- {2121865200 37800 0 LHST}
- {2140011000 39600 1 LHST}
- {2153314800 37800 0 LHST}
- {2172065400 39600 1 LHST}
- {2184764400 37800 0 LHST}
- {2203515000 39600 1 LHST}
- {2216214000 37800 0 LHST}
- {2234964600 39600 1 LHST}
- {2248268400 37800 0 LHST}
- {2266414200 39600 1 LHST}
- {2279718000 37800 0 LHST}
- {2297863800 39600 1 LHST}
- {2311167600 37800 0 LHST}
- {2329313400 39600 1 LHST}
- {2342617200 37800 0 LHST}
- {2361367800 39600 1 LHST}
- {2374066800 37800 0 LHST}
- {2392817400 39600 1 LHST}
- {2405516400 37800 0 LHST}
- {2424267000 39600 1 LHST}
- {2437570800 37800 0 LHST}
- {2455716600 39600 1 LHST}
- {2469020400 37800 0 LHST}
- {2487166200 39600 1 LHST}
- {2500470000 37800 0 LHST}
- {2519220600 39600 1 LHST}
- {2531919600 37800 0 LHST}
- {2550670200 39600 1 LHST}
- {2563369200 37800 0 LHST}
- {2582119800 39600 1 LHST}
- {2595423600 37800 0 LHST}
- {2613569400 39600 1 LHST}
- {2626873200 37800 0 LHST}
- {2645019000 39600 1 LHST}
- {2658322800 37800 0 LHST}
- {2676468600 39600 1 LHST}
- {2689772400 37800 0 LHST}
- {2708523000 39600 1 LHST}
- {2721222000 37800 0 LHST}
- {2739972600 39600 1 LHST}
- {2752671600 37800 0 LHST}
- {2771422200 39600 1 LHST}
- {2784726000 37800 0 LHST}
- {2802871800 39600 1 LHST}
- {2816175600 37800 0 LHST}
- {2834321400 39600 1 LHST}
- {2847625200 37800 0 LHST}
- {2866375800 39600 1 LHST}
- {2879074800 37800 0 LHST}
- {2897825400 39600 1 LHST}
- {2910524400 37800 0 LHST}
- {2929275000 39600 1 LHST}
- {2941974000 37800 0 LHST}
- {2960724600 39600 1 LHST}
- {2974028400 37800 0 LHST}
- {2992174200 39600 1 LHST}
- {3005478000 37800 0 LHST}
- {3023623800 39600 1 LHST}
- {3036927600 37800 0 LHST}
- {3055678200 39600 1 LHST}
- {3068377200 37800 0 LHST}
- {3087127800 39600 1 LHST}
- {3099826800 37800 0 LHST}
- {3118577400 39600 1 LHST}
- {3131881200 37800 0 LHST}
- {3150027000 39600 1 LHST}
- {3163330800 37800 0 LHST}
- {3181476600 39600 1 LHST}
- {3194780400 37800 0 LHST}
- {3212926200 39600 1 LHST}
- {3226230000 37800 0 LHST}
- {3244980600 39600 1 LHST}
- {3257679600 37800 0 LHST}
- {3276430200 39600 1 LHST}
- {3289129200 37800 0 LHST}
- {3307879800 39600 1 LHST}
- {3321183600 37800 0 LHST}
- {3339329400 39600 1 LHST}
- {3352633200 37800 0 LHST}
- {3370779000 39600 1 LHST}
- {3384082800 37800 0 LHST}
- {3402833400 39600 1 LHST}
- {3415532400 37800 0 LHST}
- {3434283000 39600 1 LHST}
- {3446982000 37800 0 LHST}
- {3465732600 39600 1 LHST}
- {3479036400 37800 0 LHST}
- {3497182200 39600 1 LHST}
- {3510486000 37800 0 LHST}
- {3528631800 39600 1 LHST}
- {3541935600 37800 0 LHST}
- {3560081400 39600 1 LHST}
- {3573385200 37800 0 LHST}
- {3592135800 39600 1 LHST}
- {3604834800 37800 0 LHST}
- {3623585400 39600 1 LHST}
- {3636284400 37800 0 LHST}
- {3655035000 39600 1 LHST}
- {3668338800 37800 0 LHST}
- {3686484600 39600 1 LHST}
- {3699788400 37800 0 LHST}
- {3717934200 39600 1 LHST}
- {3731238000 37800 0 LHST}
- {3749988600 39600 1 LHST}
- {3762687600 37800 0 LHST}
- {3781438200 39600 1 LHST}
- {3794137200 37800 0 LHST}
- {3812887800 39600 1 LHST}
- {3825586800 37800 0 LHST}
- {3844337400 39600 1 LHST}
- {3857641200 37800 0 LHST}
- {3875787000 39600 1 LHST}
- {3889090800 37800 0 LHST}
- {3907236600 39600 1 LHST}
- {3920540400 37800 0 LHST}
- {3939291000 39600 1 LHST}
- {3951990000 37800 0 LHST}
- {3970740600 39600 1 LHST}
- {3983439600 37800 0 LHST}
- {4002190200 39600 1 LHST}
- {4015494000 37800 0 LHST}
- {4033639800 39600 1 LHST}
- {4046943600 37800 0 LHST}
- {4065089400 39600 1 LHST}
- {4078393200 37800 0 LHST}
- {4096539000 39600 1 LHST}
+ {1207407600 37800 0 LHST}
+ {1223134200 39600 1 LHST}
+ {1238857200 37800 0 LHST}
+ {1254583800 39600 1 LHST}
+ {1270306800 37800 0 LHST}
+ {1286033400 39600 1 LHST}
+ {1301756400 37800 0 LHST}
+ {1317483000 39600 1 LHST}
+ {1333206000 37800 0 LHST}
+ {1349537400 39600 1 LHST}
+ {1365260400 37800 0 LHST}
+ {1380987000 39600 1 LHST}
+ {1396710000 37800 0 LHST}
+ {1412436600 39600 1 LHST}
+ {1428159600 37800 0 LHST}
+ {1443886200 39600 1 LHST}
+ {1459609200 37800 0 LHST}
+ {1475335800 39600 1 LHST}
+ {1491058800 37800 0 LHST}
+ {1506785400 39600 1 LHST}
+ {1522508400 37800 0 LHST}
+ {1538839800 39600 1 LHST}
+ {1554562800 37800 0 LHST}
+ {1570289400 39600 1 LHST}
+ {1586012400 37800 0 LHST}
+ {1601739000 39600 1 LHST}
+ {1617462000 37800 0 LHST}
+ {1633188600 39600 1 LHST}
+ {1648911600 37800 0 LHST}
+ {1664638200 39600 1 LHST}
+ {1680361200 37800 0 LHST}
+ {1696087800 39600 1 LHST}
+ {1712415600 37800 0 LHST}
+ {1728142200 39600 1 LHST}
+ {1743865200 37800 0 LHST}
+ {1759591800 39600 1 LHST}
+ {1775314800 37800 0 LHST}
+ {1791041400 39600 1 LHST}
+ {1806764400 37800 0 LHST}
+ {1822491000 39600 1 LHST}
+ {1838214000 37800 0 LHST}
+ {1853940600 39600 1 LHST}
+ {1869663600 37800 0 LHST}
+ {1885995000 39600 1 LHST}
+ {1901718000 37800 0 LHST}
+ {1917444600 39600 1 LHST}
+ {1933167600 37800 0 LHST}
+ {1948894200 39600 1 LHST}
+ {1964617200 37800 0 LHST}
+ {1980343800 39600 1 LHST}
+ {1996066800 37800 0 LHST}
+ {2011793400 39600 1 LHST}
+ {2027516400 37800 0 LHST}
+ {2043243000 39600 1 LHST}
+ {2058966000 37800 0 LHST}
+ {2075297400 39600 1 LHST}
+ {2091020400 37800 0 LHST}
+ {2106747000 39600 1 LHST}
+ {2122470000 37800 0 LHST}
+ {2138196600 39600 1 LHST}
+ {2153919600 37800 0 LHST}
+ {2169646200 39600 1 LHST}
+ {2185369200 37800 0 LHST}
+ {2201095800 39600 1 LHST}
+ {2216818800 37800 0 LHST}
+ {2233150200 39600 1 LHST}
+ {2248873200 37800 0 LHST}
+ {2264599800 39600 1 LHST}
+ {2280322800 37800 0 LHST}
+ {2296049400 39600 1 LHST}
+ {2311772400 37800 0 LHST}
+ {2327499000 39600 1 LHST}
+ {2343222000 37800 0 LHST}
+ {2358948600 39600 1 LHST}
+ {2374671600 37800 0 LHST}
+ {2390398200 39600 1 LHST}
+ {2406121200 37800 0 LHST}
+ {2422452600 39600 1 LHST}
+ {2438175600 37800 0 LHST}
+ {2453902200 39600 1 LHST}
+ {2469625200 37800 0 LHST}
+ {2485351800 39600 1 LHST}
+ {2501074800 37800 0 LHST}
+ {2516801400 39600 1 LHST}
+ {2532524400 37800 0 LHST}
+ {2548251000 39600 1 LHST}
+ {2563974000 37800 0 LHST}
+ {2579700600 39600 1 LHST}
+ {2596028400 37800 0 LHST}
+ {2611755000 39600 1 LHST}
+ {2627478000 37800 0 LHST}
+ {2643204600 39600 1 LHST}
+ {2658927600 37800 0 LHST}
+ {2674654200 39600 1 LHST}
+ {2690377200 37800 0 LHST}
+ {2706103800 39600 1 LHST}
+ {2721826800 37800 0 LHST}
+ {2737553400 39600 1 LHST}
+ {2753276400 37800 0 LHST}
+ {2769607800 39600 1 LHST}
+ {2785330800 37800 0 LHST}
+ {2801057400 39600 1 LHST}
+ {2816780400 37800 0 LHST}
+ {2832507000 39600 1 LHST}
+ {2848230000 37800 0 LHST}
+ {2863956600 39600 1 LHST}
+ {2879679600 37800 0 LHST}
+ {2895406200 39600 1 LHST}
+ {2911129200 37800 0 LHST}
+ {2926855800 39600 1 LHST}
+ {2942578800 37800 0 LHST}
+ {2958910200 39600 1 LHST}
+ {2974633200 37800 0 LHST}
+ {2990359800 39600 1 LHST}
+ {3006082800 37800 0 LHST}
+ {3021809400 39600 1 LHST}
+ {3037532400 37800 0 LHST}
+ {3053259000 39600 1 LHST}
+ {3068982000 37800 0 LHST}
+ {3084708600 39600 1 LHST}
+ {3100431600 37800 0 LHST}
+ {3116763000 39600 1 LHST}
+ {3132486000 37800 0 LHST}
+ {3148212600 39600 1 LHST}
+ {3163935600 37800 0 LHST}
+ {3179662200 39600 1 LHST}
+ {3195385200 37800 0 LHST}
+ {3211111800 39600 1 LHST}
+ {3226834800 37800 0 LHST}
+ {3242561400 39600 1 LHST}
+ {3258284400 37800 0 LHST}
+ {3274011000 39600 1 LHST}
+ {3289734000 37800 0 LHST}
+ {3306065400 39600 1 LHST}
+ {3321788400 37800 0 LHST}
+ {3337515000 39600 1 LHST}
+ {3353238000 37800 0 LHST}
+ {3368964600 39600 1 LHST}
+ {3384687600 37800 0 LHST}
+ {3400414200 39600 1 LHST}
+ {3416137200 37800 0 LHST}
+ {3431863800 39600 1 LHST}
+ {3447586800 37800 0 LHST}
+ {3463313400 39600 1 LHST}
+ {3479641200 37800 0 LHST}
+ {3495367800 39600 1 LHST}
+ {3511090800 37800 0 LHST}
+ {3526817400 39600 1 LHST}
+ {3542540400 37800 0 LHST}
+ {3558267000 39600 1 LHST}
+ {3573990000 37800 0 LHST}
+ {3589716600 39600 1 LHST}
+ {3605439600 37800 0 LHST}
+ {3621166200 39600 1 LHST}
+ {3636889200 37800 0 LHST}
+ {3653220600 39600 1 LHST}
+ {3668943600 37800 0 LHST}
+ {3684670200 39600 1 LHST}
+ {3700393200 37800 0 LHST}
+ {3716119800 39600 1 LHST}
+ {3731842800 37800 0 LHST}
+ {3747569400 39600 1 LHST}
+ {3763292400 37800 0 LHST}
+ {3779019000 39600 1 LHST}
+ {3794742000 37800 0 LHST}
+ {3810468600 39600 1 LHST}
+ {3826191600 37800 0 LHST}
+ {3842523000 39600 1 LHST}
+ {3858246000 37800 0 LHST}
+ {3873972600 39600 1 LHST}
+ {3889695600 37800 0 LHST}
+ {3905422200 39600 1 LHST}
+ {3921145200 37800 0 LHST}
+ {3936871800 39600 1 LHST}
+ {3952594800 37800 0 LHST}
+ {3968321400 39600 1 LHST}
+ {3984044400 37800 0 LHST}
+ {4000375800 39600 1 LHST}
+ {4016098800 37800 0 LHST}
+ {4031825400 39600 1 LHST}
+ {4047548400 37800 0 LHST}
+ {4063275000 39600 1 LHST}
+ {4078998000 37800 0 LHST}
+ {4094724600 39600 1 LHST}
}
diff --git a/library/tzdata/Australia/Melbourne b/library/tzdata/Australia/Melbourne
index 332eb18..907b8b9 100644
--- a/library/tzdata/Australia/Melbourne
+++ b/library/tzdata/Australia/Melbourne
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Melbourne) {
{-9223372036854775808 34792 0 LMT}
@@ -12,261 +12,261 @@ set TZData(:Australia/Melbourne) {
{-828345600 39600 1 EST}
{-813229200 36000 0 EST}
{31500000 36000 0 EST}
- {57722400 39600 1 EST}
- {68004000 36000 0 EST}
- {89172000 39600 1 EST}
- {100058400 36000 0 EST}
- {120621600 39600 1 EST}
- {131508000 36000 0 EST}
- {152071200 39600 1 EST}
- {162957600 36000 0 EST}
- {183520800 39600 1 EST}
- {195012000 36000 0 EST}
- {215575200 39600 1 EST}
- {226461600 36000 0 EST}
- {247024800 39600 1 EST}
- {257911200 36000 0 EST}
- {278474400 39600 1 EST}
- {289360800 36000 0 EST}
- {309924000 39600 1 EST}
- {320810400 36000 0 EST}
- {341373600 39600 1 EST}
- {352260000 36000 0 EST}
- {372823200 39600 1 EST}
- {384314400 36000 0 EST}
- {404877600 39600 1 EST}
- {415764000 36000 0 EST}
- {436327200 39600 1 EST}
- {447213600 36000 0 EST}
- {467776800 39600 1 EST}
- {478663200 36000 0 EST}
- {499226400 39600 1 EST}
- {511322400 36000 0 EST}
- {530071200 39600 1 EST}
- {542772000 36000 0 EST}
- {561520800 39600 1 EST}
- {574826400 36000 0 EST}
- {594180000 39600 1 EST}
- {606276000 36000 0 EST}
- {625629600 39600 1 EST}
- {637725600 36000 0 EST}
- {657079200 39600 1 EST}
- {667965600 36000 0 EST}
- {688528800 39600 1 EST}
- {699415200 36000 0 EST}
- {719978400 39600 1 EST}
- {731469600 36000 0 EST}
- {752032800 39600 1 EST}
- {762919200 36000 0 EST}
- {783482400 39600 1 EST}
- {796183200 36000 0 EST}
- {814932000 39600 1 EST}
- {828237600 36000 0 EST}
- {846381600 39600 1 EST}
- {859687200 36000 0 EST}
- {877831200 39600 1 EST}
- {891136800 36000 0 EST}
- {909280800 39600 1 EST}
- {922586400 36000 0 EST}
- {941335200 39600 1 EST}
- {954036000 36000 0 EST}
- {967341600 39600 1 EST}
- {985485600 36000 0 EST}
- {1004234400 39600 1 EST}
- {1017540000 36000 0 EST}
- {1035684000 39600 1 EST}
- {1048989600 36000 0 EST}
- {1067133600 39600 1 EST}
- {1080439200 36000 0 EST}
- {1099188000 39600 1 EST}
- {1111888800 36000 0 EST}
- {1130637600 39600 1 EST}
- {1143338400 36000 0 EST}
- {1162087200 39600 1 EST}
- {1174788000 36000 0 EST}
- {1193536800 39600 1 EST}
- {1206842400 36000 0 EST}
- {1224986400 39600 1 EST}
- {1238292000 36000 0 EST}
- {1256436000 39600 1 EST}
- {1269741600 36000 0 EST}
- {1288490400 39600 1 EST}
- {1301191200 36000 0 EST}
- {1319940000 39600 1 EST}
- {1332640800 36000 0 EST}
- {1351389600 39600 1 EST}
- {1364695200 36000 0 EST}
- {1382839200 39600 1 EST}
- {1396144800 36000 0 EST}
- {1414288800 39600 1 EST}
- {1427594400 36000 0 EST}
- {1445738400 39600 1 EST}
- {1459044000 36000 0 EST}
- {1477792800 39600 1 EST}
- {1490493600 36000 0 EST}
- {1509242400 39600 1 EST}
- {1521943200 36000 0 EST}
- {1540692000 39600 1 EST}
- {1553997600 36000 0 EST}
- {1572141600 39600 1 EST}
- {1585447200 36000 0 EST}
- {1603591200 39600 1 EST}
- {1616896800 36000 0 EST}
- {1635645600 39600 1 EST}
- {1648346400 36000 0 EST}
- {1667095200 39600 1 EST}
- {1679796000 36000 0 EST}
- {1698544800 39600 1 EST}
- {1711850400 36000 0 EST}
- {1729994400 39600 1 EST}
- {1743300000 36000 0 EST}
- {1761444000 39600 1 EST}
- {1774749600 36000 0 EST}
- {1792893600 39600 1 EST}
- {1806199200 36000 0 EST}
- {1824948000 39600 1 EST}
- {1837648800 36000 0 EST}
- {1856397600 39600 1 EST}
- {1869098400 36000 0 EST}
- {1887847200 39600 1 EST}
- {1901152800 36000 0 EST}
- {1919296800 39600 1 EST}
- {1932602400 36000 0 EST}
- {1950746400 39600 1 EST}
- {1964052000 36000 0 EST}
- {1982800800 39600 1 EST}
- {1995501600 36000 0 EST}
- {2014250400 39600 1 EST}
- {2026951200 36000 0 EST}
- {2045700000 39600 1 EST}
- {2058400800 36000 0 EST}
- {2077149600 39600 1 EST}
- {2090455200 36000 0 EST}
- {2108599200 39600 1 EST}
- {2121904800 36000 0 EST}
- {2140048800 39600 1 EST}
- {2153354400 36000 0 EST}
- {2172103200 39600 1 EST}
- {2184804000 36000 0 EST}
- {2203552800 39600 1 EST}
- {2216253600 36000 0 EST}
- {2235002400 39600 1 EST}
- {2248308000 36000 0 EST}
- {2266452000 39600 1 EST}
- {2279757600 36000 0 EST}
- {2297901600 39600 1 EST}
- {2311207200 36000 0 EST}
- {2329351200 39600 1 EST}
- {2342656800 36000 0 EST}
- {2361405600 39600 1 EST}
- {2374106400 36000 0 EST}
- {2392855200 39600 1 EST}
- {2405556000 36000 0 EST}
- {2424304800 39600 1 EST}
- {2437610400 36000 0 EST}
- {2455754400 39600 1 EST}
- {2469060000 36000 0 EST}
- {2487204000 39600 1 EST}
- {2500509600 36000 0 EST}
- {2519258400 39600 1 EST}
- {2531959200 36000 0 EST}
- {2550708000 39600 1 EST}
- {2563408800 36000 0 EST}
- {2582157600 39600 1 EST}
- {2595463200 36000 0 EST}
- {2613607200 39600 1 EST}
- {2626912800 36000 0 EST}
- {2645056800 39600 1 EST}
- {2658362400 36000 0 EST}
- {2676506400 39600 1 EST}
- {2689812000 36000 0 EST}
- {2708560800 39600 1 EST}
- {2721261600 36000 0 EST}
- {2740010400 39600 1 EST}
- {2752711200 36000 0 EST}
- {2771460000 39600 1 EST}
- {2784765600 36000 0 EST}
- {2802909600 39600 1 EST}
- {2816215200 36000 0 EST}
- {2834359200 39600 1 EST}
- {2847664800 36000 0 EST}
- {2866413600 39600 1 EST}
- {2879114400 36000 0 EST}
- {2897863200 39600 1 EST}
- {2910564000 36000 0 EST}
- {2929312800 39600 1 EST}
- {2942013600 36000 0 EST}
- {2960762400 39600 1 EST}
- {2974068000 36000 0 EST}
- {2992212000 39600 1 EST}
- {3005517600 36000 0 EST}
- {3023661600 39600 1 EST}
- {3036967200 36000 0 EST}
- {3055716000 39600 1 EST}
- {3068416800 36000 0 EST}
- {3087165600 39600 1 EST}
- {3099866400 36000 0 EST}
- {3118615200 39600 1 EST}
- {3131920800 36000 0 EST}
- {3150064800 39600 1 EST}
- {3163370400 36000 0 EST}
- {3181514400 39600 1 EST}
- {3194820000 36000 0 EST}
- {3212964000 39600 1 EST}
- {3226269600 36000 0 EST}
- {3245018400 39600 1 EST}
- {3257719200 36000 0 EST}
- {3276468000 39600 1 EST}
- {3289168800 36000 0 EST}
- {3307917600 39600 1 EST}
- {3321223200 36000 0 EST}
- {3339367200 39600 1 EST}
- {3352672800 36000 0 EST}
- {3370816800 39600 1 EST}
- {3384122400 36000 0 EST}
- {3402871200 39600 1 EST}
- {3415572000 36000 0 EST}
- {3434320800 39600 1 EST}
- {3447021600 36000 0 EST}
- {3465770400 39600 1 EST}
- {3479076000 36000 0 EST}
- {3497220000 39600 1 EST}
- {3510525600 36000 0 EST}
- {3528669600 39600 1 EST}
- {3541975200 36000 0 EST}
- {3560119200 39600 1 EST}
- {3573424800 36000 0 EST}
- {3592173600 39600 1 EST}
- {3604874400 36000 0 EST}
- {3623623200 39600 1 EST}
- {3636324000 36000 0 EST}
- {3655072800 39600 1 EST}
- {3668378400 36000 0 EST}
- {3686522400 39600 1 EST}
- {3699828000 36000 0 EST}
- {3717972000 39600 1 EST}
- {3731277600 36000 0 EST}
- {3750026400 39600 1 EST}
- {3762727200 36000 0 EST}
- {3781476000 39600 1 EST}
- {3794176800 36000 0 EST}
- {3812925600 39600 1 EST}
- {3825626400 36000 0 EST}
- {3844375200 39600 1 EST}
- {3857680800 36000 0 EST}
- {3875824800 39600 1 EST}
- {3889130400 36000 0 EST}
- {3907274400 39600 1 EST}
- {3920580000 36000 0 EST}
- {3939328800 39600 1 EST}
- {3952029600 36000 0 EST}
- {3970778400 39600 1 EST}
- {3983479200 36000 0 EST}
- {4002228000 39600 1 EST}
- {4015533600 36000 0 EST}
- {4033677600 39600 1 EST}
- {4046983200 36000 0 EST}
- {4065127200 39600 1 EST}
- {4078432800 36000 0 EST}
- {4096576800 39600 1 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {89136000 39600 1 EST}
+ {100022400 36000 0 EST}
+ {120585600 39600 1 EST}
+ {131472000 36000 0 EST}
+ {152035200 39600 1 EST}
+ {162921600 36000 0 EST}
+ {183484800 39600 1 EST}
+ {194976000 36000 0 EST}
+ {215539200 39600 1 EST}
+ {226425600 36000 0 EST}
+ {246988800 39600 1 EST}
+ {257875200 36000 0 EST}
+ {278438400 39600 1 EST}
+ {289324800 36000 0 EST}
+ {309888000 39600 1 EST}
+ {320774400 36000 0 EST}
+ {341337600 39600 1 EST}
+ {352224000 36000 0 EST}
+ {372787200 39600 1 EST}
+ {384278400 36000 0 EST}
+ {404841600 39600 1 EST}
+ {415728000 36000 0 EST}
+ {436291200 39600 1 EST}
+ {447177600 36000 0 EST}
+ {467740800 39600 1 EST}
+ {478627200 36000 0 EST}
+ {499190400 39600 1 EST}
+ {511286400 36000 0 EST}
+ {530035200 39600 1 EST}
+ {542736000 36000 0 EST}
+ {561484800 39600 1 EST}
+ {574790400 36000 0 EST}
+ {594144000 39600 1 EST}
+ {606240000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {637689600 36000 0 EST}
+ {657043200 39600 1 EST}
+ {667929600 36000 0 EST}
+ {688492800 39600 1 EST}
+ {699379200 36000 0 EST}
+ {719942400 39600 1 EST}
+ {731433600 36000 0 EST}
+ {751996800 39600 1 EST}
+ {762883200 36000 0 EST}
+ {783446400 39600 1 EST}
+ {796147200 36000 0 EST}
+ {814896000 39600 1 EST}
+ {828201600 36000 0 EST}
+ {846345600 39600 1 EST}
+ {859651200 36000 0 EST}
+ {877795200 39600 1 EST}
+ {891100800 36000 0 EST}
+ {909244800 39600 1 EST}
+ {922550400 36000 0 EST}
+ {941299200 39600 1 EST}
+ {954000000 36000 0 EST}
+ {967305600 39600 1 EST}
+ {985449600 36000 0 EST}
+ {1004198400 39600 1 EST}
+ {1017504000 36000 0 EST}
+ {1035648000 39600 1 EST}
+ {1048953600 36000 0 EST}
+ {1067097600 39600 1 EST}
+ {1080403200 36000 0 EST}
+ {1099152000 39600 1 EST}
+ {1111852800 36000 0 EST}
+ {1130601600 39600 1 EST}
+ {1143907200 36000 0 EST}
+ {1162051200 39600 1 EST}
+ {1174752000 36000 0 EST}
+ {1193500800 39600 1 EST}
+ {1207411200 36000 0 EST}
+ {1223136000 39600 1 EST}
+ {1238860800 36000 0 EST}
+ {1254585600 39600 1 EST}
+ {1270310400 36000 0 EST}
+ {1286035200 39600 1 EST}
+ {1301760000 36000 0 EST}
+ {1317484800 39600 1 EST}
+ {1333209600 36000 0 EST}
+ {1349539200 39600 1 EST}
+ {1365264000 36000 0 EST}
+ {1380988800 39600 1 EST}
+ {1396713600 36000 0 EST}
+ {1412438400 39600 1 EST}
+ {1428163200 36000 0 EST}
+ {1443888000 39600 1 EST}
+ {1459612800 36000 0 EST}
+ {1475337600 39600 1 EST}
+ {1491062400 36000 0 EST}
+ {1506787200 39600 1 EST}
+ {1522512000 36000 0 EST}
+ {1538841600 39600 1 EST}
+ {1554566400 36000 0 EST}
+ {1570291200 39600 1 EST}
+ {1586016000 36000 0 EST}
+ {1601740800 39600 1 EST}
+ {1617465600 36000 0 EST}
+ {1633190400 39600 1 EST}
+ {1648915200 36000 0 EST}
+ {1664640000 39600 1 EST}
+ {1680364800 36000 0 EST}
+ {1696089600 39600 1 EST}
+ {1712419200 36000 0 EST}
+ {1728144000 39600 1 EST}
+ {1743868800 36000 0 EST}
+ {1759593600 39600 1 EST}
+ {1775318400 36000 0 EST}
+ {1791043200 39600 1 EST}
+ {1806768000 36000 0 EST}
+ {1822492800 39600 1 EST}
+ {1838217600 36000 0 EST}
+ {1853942400 39600 1 EST}
+ {1869667200 36000 0 EST}
+ {1885996800 39600 1 EST}
+ {1901721600 36000 0 EST}
+ {1917446400 39600 1 EST}
+ {1933171200 36000 0 EST}
+ {1948896000 39600 1 EST}
+ {1964620800 36000 0 EST}
+ {1980345600 39600 1 EST}
+ {1996070400 36000 0 EST}
+ {2011795200 39600 1 EST}
+ {2027520000 36000 0 EST}
+ {2043244800 39600 1 EST}
+ {2058969600 36000 0 EST}
+ {2075299200 39600 1 EST}
+ {2091024000 36000 0 EST}
+ {2106748800 39600 1 EST}
+ {2122473600 36000 0 EST}
+ {2138198400 39600 1 EST}
+ {2153923200 36000 0 EST}
+ {2169648000 39600 1 EST}
+ {2185372800 36000 0 EST}
+ {2201097600 39600 1 EST}
+ {2216822400 36000 0 EST}
+ {2233152000 39600 1 EST}
+ {2248876800 36000 0 EST}
+ {2264601600 39600 1 EST}
+ {2280326400 36000 0 EST}
+ {2296051200 39600 1 EST}
+ {2311776000 36000 0 EST}
+ {2327500800 39600 1 EST}
+ {2343225600 36000 0 EST}
+ {2358950400 39600 1 EST}
+ {2374675200 36000 0 EST}
+ {2390400000 39600 1 EST}
+ {2406124800 36000 0 EST}
+ {2422454400 39600 1 EST}
+ {2438179200 36000 0 EST}
+ {2453904000 39600 1 EST}
+ {2469628800 36000 0 EST}
+ {2485353600 39600 1 EST}
+ {2501078400 36000 0 EST}
+ {2516803200 39600 1 EST}
+ {2532528000 36000 0 EST}
+ {2548252800 39600 1 EST}
+ {2563977600 36000 0 EST}
+ {2579702400 39600 1 EST}
+ {2596032000 36000 0 EST}
+ {2611756800 39600 1 EST}
+ {2627481600 36000 0 EST}
+ {2643206400 39600 1 EST}
+ {2658931200 36000 0 EST}
+ {2674656000 39600 1 EST}
+ {2690380800 36000 0 EST}
+ {2706105600 39600 1 EST}
+ {2721830400 36000 0 EST}
+ {2737555200 39600 1 EST}
+ {2753280000 36000 0 EST}
+ {2769609600 39600 1 EST}
+ {2785334400 36000 0 EST}
+ {2801059200 39600 1 EST}
+ {2816784000 36000 0 EST}
+ {2832508800 39600 1 EST}
+ {2848233600 36000 0 EST}
+ {2863958400 39600 1 EST}
+ {2879683200 36000 0 EST}
+ {2895408000 39600 1 EST}
+ {2911132800 36000 0 EST}
+ {2926857600 39600 1 EST}
+ {2942582400 36000 0 EST}
+ {2958912000 39600 1 EST}
+ {2974636800 36000 0 EST}
+ {2990361600 39600 1 EST}
+ {3006086400 36000 0 EST}
+ {3021811200 39600 1 EST}
+ {3037536000 36000 0 EST}
+ {3053260800 39600 1 EST}
+ {3068985600 36000 0 EST}
+ {3084710400 39600 1 EST}
+ {3100435200 36000 0 EST}
+ {3116764800 39600 1 EST}
+ {3132489600 36000 0 EST}
+ {3148214400 39600 1 EST}
+ {3163939200 36000 0 EST}
+ {3179664000 39600 1 EST}
+ {3195388800 36000 0 EST}
+ {3211113600 39600 1 EST}
+ {3226838400 36000 0 EST}
+ {3242563200 39600 1 EST}
+ {3258288000 36000 0 EST}
+ {3274012800 39600 1 EST}
+ {3289737600 36000 0 EST}
+ {3306067200 39600 1 EST}
+ {3321792000 36000 0 EST}
+ {3337516800 39600 1 EST}
+ {3353241600 36000 0 EST}
+ {3368966400 39600 1 EST}
+ {3384691200 36000 0 EST}
+ {3400416000 39600 1 EST}
+ {3416140800 36000 0 EST}
+ {3431865600 39600 1 EST}
+ {3447590400 36000 0 EST}
+ {3463315200 39600 1 EST}
+ {3479644800 36000 0 EST}
+ {3495369600 39600 1 EST}
+ {3511094400 36000 0 EST}
+ {3526819200 39600 1 EST}
+ {3542544000 36000 0 EST}
+ {3558268800 39600 1 EST}
+ {3573993600 36000 0 EST}
+ {3589718400 39600 1 EST}
+ {3605443200 36000 0 EST}
+ {3621168000 39600 1 EST}
+ {3636892800 36000 0 EST}
+ {3653222400 39600 1 EST}
+ {3668947200 36000 0 EST}
+ {3684672000 39600 1 EST}
+ {3700396800 36000 0 EST}
+ {3716121600 39600 1 EST}
+ {3731846400 36000 0 EST}
+ {3747571200 39600 1 EST}
+ {3763296000 36000 0 EST}
+ {3779020800 39600 1 EST}
+ {3794745600 36000 0 EST}
+ {3810470400 39600 1 EST}
+ {3826195200 36000 0 EST}
+ {3842524800 39600 1 EST}
+ {3858249600 36000 0 EST}
+ {3873974400 39600 1 EST}
+ {3889699200 36000 0 EST}
+ {3905424000 39600 1 EST}
+ {3921148800 36000 0 EST}
+ {3936873600 39600 1 EST}
+ {3952598400 36000 0 EST}
+ {3968323200 39600 1 EST}
+ {3984048000 36000 0 EST}
+ {4000377600 39600 1 EST}
+ {4016102400 36000 0 EST}
+ {4031827200 39600 1 EST}
+ {4047552000 36000 0 EST}
+ {4063276800 39600 1 EST}
+ {4079001600 36000 0 EST}
+ {4094726400 39600 1 EST}
}
diff --git a/library/tzdata/Australia/NSW b/library/tzdata/Australia/NSW
index f5b6d1c..905bdfe 100644
--- a/library/tzdata/Australia/NSW
+++ b/library/tzdata/Australia/NSW
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Sydney)]} {
LoadTimeZoneFile Australia/Sydney
}
diff --git a/library/tzdata/Australia/North b/library/tzdata/Australia/North
index 1559bfaa..950c88c 100644
--- a/library/tzdata/Australia/North
+++ b/library/tzdata/Australia/North
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Darwin)]} {
LoadTimeZoneFile Australia/Darwin
}
diff --git a/library/tzdata/Australia/Perth b/library/tzdata/Australia/Perth
index 557490d..5d8f116 100644
--- a/library/tzdata/Australia/Perth
+++ b/library/tzdata/Australia/Perth
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Perth) {
{-9223372036854775808 27804 0 LMT}
@@ -9,11 +9,17 @@ set TZData(:Australia/Perth) {
{-876121200 28800 0 WST}
{-860392800 32400 1 WST}
{-844671600 28800 0 WST}
- {-836470800 28800 0 WST}
- {152071200 32400 1 WST}
- {162957600 28800 0 WST}
- {436327200 32400 1 WST}
- {447213600 28800 0 WST}
- {690343200 32400 1 WST}
- {699415200 28800 0 WST}
+ {-836470800 32400 0 WST}
+ {152042400 32400 1 WST}
+ {162928800 28800 0 WST}
+ {436298400 32400 1 WST}
+ {447184800 28800 0 WST}
+ {690314400 32400 1 WST}
+ {699386400 28800 0 WST}
+ {1165082400 32400 1 WST}
+ {1174759200 28800 0 WST}
+ {1193508000 32400 1 WST}
+ {1206813600 28800 0 WST}
+ {1224957600 32400 1 WST}
+ {1238263200 28800 0 WST}
}
diff --git a/library/tzdata/Australia/Queensland b/library/tzdata/Australia/Queensland
index 4055cc3..6246e92 100644
--- a/library/tzdata/Australia/Queensland
+++ b/library/tzdata/Australia/Queensland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Brisbane)]} {
LoadTimeZoneFile Australia/Brisbane
}
diff --git a/library/tzdata/Australia/South b/library/tzdata/Australia/South
index 576a888..9c7dd95 100644
--- a/library/tzdata/Australia/South
+++ b/library/tzdata/Australia/South
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Adelaide)]} {
LoadTimeZoneFile Australia/Adelaide
}
diff --git a/library/tzdata/Australia/Sydney b/library/tzdata/Australia/Sydney
index a15b384..84b1d14 100644
--- a/library/tzdata/Australia/Sydney
+++ b/library/tzdata/Australia/Sydney
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Australia/Sydney) {
{-9223372036854775808 36292 0 LMT}
@@ -12,261 +12,261 @@ set TZData(:Australia/Sydney) {
{-828345600 39600 1 EST}
{-813229200 36000 0 EST}
{31500000 36000 0 EST}
- {57722400 39600 1 EST}
- {68004000 36000 0 EST}
- {89172000 39600 1 EST}
- {100058400 36000 0 EST}
- {120621600 39600 1 EST}
- {131508000 36000 0 EST}
- {152071200 39600 1 EST}
- {162957600 36000 0 EST}
- {183520800 39600 1 EST}
- {195012000 36000 0 EST}
- {215575200 39600 1 EST}
- {226461600 36000 0 EST}
- {247024800 39600 1 EST}
- {257911200 36000 0 EST}
- {278474400 39600 1 EST}
- {289360800 36000 0 EST}
- {309924000 39600 1 EST}
- {320810400 36000 0 EST}
- {341373600 39600 1 EST}
- {352260000 36000 0 EST}
- {372823200 39600 1 EST}
- {386733600 36000 0 EST}
- {404877600 39600 1 EST}
- {415764000 36000 0 EST}
- {436327200 39600 1 EST}
- {447213600 36000 0 EST}
- {467776800 39600 1 EST}
- {478663200 36000 0 EST}
- {499226400 39600 1 EST}
- {511322400 36000 0 EST}
- {530071200 39600 1 EST}
- {542772000 36000 0 EST}
- {562125600 39600 1 EST}
- {574826400 36000 0 EST}
- {594180000 39600 1 EST}
- {606276000 36000 0 EST}
- {625629600 39600 1 EST}
- {636516000 36000 0 EST}
- {657079200 39600 1 EST}
- {667965600 36000 0 EST}
- {688528800 39600 1 EST}
- {699415200 36000 0 EST}
- {719978400 39600 1 EST}
- {731469600 36000 0 EST}
- {752032800 39600 1 EST}
- {762919200 36000 0 EST}
- {783482400 39600 1 EST}
- {794368800 36000 0 EST}
- {814932000 39600 1 EST}
- {828237600 36000 0 EST}
- {846381600 39600 1 EST}
- {859687200 36000 0 EST}
- {877831200 39600 1 EST}
- {891136800 36000 0 EST}
- {909280800 39600 1 EST}
- {922586400 36000 0 EST}
- {941335200 39600 1 EST}
- {954036000 36000 0 EST}
- {967341600 39600 1 EST}
- {985485600 36000 0 EST}
- {1004234400 39600 1 EST}
- {1017540000 36000 0 EST}
- {1035684000 39600 1 EST}
- {1048989600 36000 0 EST}
- {1067133600 39600 1 EST}
- {1080439200 36000 0 EST}
- {1099188000 39600 1 EST}
- {1111888800 36000 0 EST}
- {1130637600 39600 1 EST}
- {1143338400 36000 0 EST}
- {1162087200 39600 1 EST}
- {1174788000 36000 0 EST}
- {1193536800 39600 1 EST}
- {1206842400 36000 0 EST}
- {1224986400 39600 1 EST}
- {1238292000 36000 0 EST}
- {1256436000 39600 1 EST}
- {1269741600 36000 0 EST}
- {1288490400 39600 1 EST}
- {1301191200 36000 0 EST}
- {1319940000 39600 1 EST}
- {1332640800 36000 0 EST}
- {1351389600 39600 1 EST}
- {1364695200 36000 0 EST}
- {1382839200 39600 1 EST}
- {1396144800 36000 0 EST}
- {1414288800 39600 1 EST}
- {1427594400 36000 0 EST}
- {1445738400 39600 1 EST}
- {1459044000 36000 0 EST}
- {1477792800 39600 1 EST}
- {1490493600 36000 0 EST}
- {1509242400 39600 1 EST}
- {1521943200 36000 0 EST}
- {1540692000 39600 1 EST}
- {1553997600 36000 0 EST}
- {1572141600 39600 1 EST}
- {1585447200 36000 0 EST}
- {1603591200 39600 1 EST}
- {1616896800 36000 0 EST}
- {1635645600 39600 1 EST}
- {1648346400 36000 0 EST}
- {1667095200 39600 1 EST}
- {1679796000 36000 0 EST}
- {1698544800 39600 1 EST}
- {1711850400 36000 0 EST}
- {1729994400 39600 1 EST}
- {1743300000 36000 0 EST}
- {1761444000 39600 1 EST}
- {1774749600 36000 0 EST}
- {1792893600 39600 1 EST}
- {1806199200 36000 0 EST}
- {1824948000 39600 1 EST}
- {1837648800 36000 0 EST}
- {1856397600 39600 1 EST}
- {1869098400 36000 0 EST}
- {1887847200 39600 1 EST}
- {1901152800 36000 0 EST}
- {1919296800 39600 1 EST}
- {1932602400 36000 0 EST}
- {1950746400 39600 1 EST}
- {1964052000 36000 0 EST}
- {1982800800 39600 1 EST}
- {1995501600 36000 0 EST}
- {2014250400 39600 1 EST}
- {2026951200 36000 0 EST}
- {2045700000 39600 1 EST}
- {2058400800 36000 0 EST}
- {2077149600 39600 1 EST}
- {2090455200 36000 0 EST}
- {2108599200 39600 1 EST}
- {2121904800 36000 0 EST}
- {2140048800 39600 1 EST}
- {2153354400 36000 0 EST}
- {2172103200 39600 1 EST}
- {2184804000 36000 0 EST}
- {2203552800 39600 1 EST}
- {2216253600 36000 0 EST}
- {2235002400 39600 1 EST}
- {2248308000 36000 0 EST}
- {2266452000 39600 1 EST}
- {2279757600 36000 0 EST}
- {2297901600 39600 1 EST}
- {2311207200 36000 0 EST}
- {2329351200 39600 1 EST}
- {2342656800 36000 0 EST}
- {2361405600 39600 1 EST}
- {2374106400 36000 0 EST}
- {2392855200 39600 1 EST}
- {2405556000 36000 0 EST}
- {2424304800 39600 1 EST}
- {2437610400 36000 0 EST}
- {2455754400 39600 1 EST}
- {2469060000 36000 0 EST}
- {2487204000 39600 1 EST}
- {2500509600 36000 0 EST}
- {2519258400 39600 1 EST}
- {2531959200 36000 0 EST}
- {2550708000 39600 1 EST}
- {2563408800 36000 0 EST}
- {2582157600 39600 1 EST}
- {2595463200 36000 0 EST}
- {2613607200 39600 1 EST}
- {2626912800 36000 0 EST}
- {2645056800 39600 1 EST}
- {2658362400 36000 0 EST}
- {2676506400 39600 1 EST}
- {2689812000 36000 0 EST}
- {2708560800 39600 1 EST}
- {2721261600 36000 0 EST}
- {2740010400 39600 1 EST}
- {2752711200 36000 0 EST}
- {2771460000 39600 1 EST}
- {2784765600 36000 0 EST}
- {2802909600 39600 1 EST}
- {2816215200 36000 0 EST}
- {2834359200 39600 1 EST}
- {2847664800 36000 0 EST}
- {2866413600 39600 1 EST}
- {2879114400 36000 0 EST}
- {2897863200 39600 1 EST}
- {2910564000 36000 0 EST}
- {2929312800 39600 1 EST}
- {2942013600 36000 0 EST}
- {2960762400 39600 1 EST}
- {2974068000 36000 0 EST}
- {2992212000 39600 1 EST}
- {3005517600 36000 0 EST}
- {3023661600 39600 1 EST}
- {3036967200 36000 0 EST}
- {3055716000 39600 1 EST}
- {3068416800 36000 0 EST}
- {3087165600 39600 1 EST}
- {3099866400 36000 0 EST}
- {3118615200 39600 1 EST}
- {3131920800 36000 0 EST}
- {3150064800 39600 1 EST}
- {3163370400 36000 0 EST}
- {3181514400 39600 1 EST}
- {3194820000 36000 0 EST}
- {3212964000 39600 1 EST}
- {3226269600 36000 0 EST}
- {3245018400 39600 1 EST}
- {3257719200 36000 0 EST}
- {3276468000 39600 1 EST}
- {3289168800 36000 0 EST}
- {3307917600 39600 1 EST}
- {3321223200 36000 0 EST}
- {3339367200 39600 1 EST}
- {3352672800 36000 0 EST}
- {3370816800 39600 1 EST}
- {3384122400 36000 0 EST}
- {3402871200 39600 1 EST}
- {3415572000 36000 0 EST}
- {3434320800 39600 1 EST}
- {3447021600 36000 0 EST}
- {3465770400 39600 1 EST}
- {3479076000 36000 0 EST}
- {3497220000 39600 1 EST}
- {3510525600 36000 0 EST}
- {3528669600 39600 1 EST}
- {3541975200 36000 0 EST}
- {3560119200 39600 1 EST}
- {3573424800 36000 0 EST}
- {3592173600 39600 1 EST}
- {3604874400 36000 0 EST}
- {3623623200 39600 1 EST}
- {3636324000 36000 0 EST}
- {3655072800 39600 1 EST}
- {3668378400 36000 0 EST}
- {3686522400 39600 1 EST}
- {3699828000 36000 0 EST}
- {3717972000 39600 1 EST}
- {3731277600 36000 0 EST}
- {3750026400 39600 1 EST}
- {3762727200 36000 0 EST}
- {3781476000 39600 1 EST}
- {3794176800 36000 0 EST}
- {3812925600 39600 1 EST}
- {3825626400 36000 0 EST}
- {3844375200 39600 1 EST}
- {3857680800 36000 0 EST}
- {3875824800 39600 1 EST}
- {3889130400 36000 0 EST}
- {3907274400 39600 1 EST}
- {3920580000 36000 0 EST}
- {3939328800 39600 1 EST}
- {3952029600 36000 0 EST}
- {3970778400 39600 1 EST}
- {3983479200 36000 0 EST}
- {4002228000 39600 1 EST}
- {4015533600 36000 0 EST}
- {4033677600 39600 1 EST}
- {4046983200 36000 0 EST}
- {4065127200 39600 1 EST}
- {4078432800 36000 0 EST}
- {4096576800 39600 1 EST}
+ {57686400 39600 1 EST}
+ {67968000 36000 0 EST}
+ {89136000 39600 1 EST}
+ {100022400 36000 0 EST}
+ {120585600 39600 1 EST}
+ {131472000 36000 0 EST}
+ {152035200 39600 1 EST}
+ {162921600 36000 0 EST}
+ {183484800 39600 1 EST}
+ {194976000 36000 0 EST}
+ {215539200 39600 1 EST}
+ {226425600 36000 0 EST}
+ {246988800 39600 1 EST}
+ {257875200 36000 0 EST}
+ {278438400 39600 1 EST}
+ {289324800 36000 0 EST}
+ {309888000 39600 1 EST}
+ {320774400 36000 0 EST}
+ {341337600 39600 1 EST}
+ {352224000 36000 0 EST}
+ {372787200 39600 1 EST}
+ {386697600 36000 0 EST}
+ {404841600 39600 1 EST}
+ {415728000 36000 0 EST}
+ {436291200 39600 1 EST}
+ {447177600 36000 0 EST}
+ {467740800 39600 1 EST}
+ {478627200 36000 0 EST}
+ {499190400 39600 1 EST}
+ {511286400 36000 0 EST}
+ {530035200 39600 1 EST}
+ {542736000 36000 0 EST}
+ {562089600 39600 1 EST}
+ {574790400 36000 0 EST}
+ {594144000 39600 1 EST}
+ {606240000 36000 0 EST}
+ {625593600 39600 1 EST}
+ {636480000 36000 0 EST}
+ {657043200 39600 1 EST}
+ {667929600 36000 0 EST}
+ {688492800 39600 1 EST}
+ {699379200 36000 0 EST}
+ {719942400 39600 1 EST}
+ {731433600 36000 0 EST}
+ {751996800 39600 1 EST}
+ {762883200 36000 0 EST}
+ {783446400 39600 1 EST}
+ {794332800 36000 0 EST}
+ {814896000 39600 1 EST}
+ {828201600 36000 0 EST}
+ {846345600 39600 1 EST}
+ {859651200 36000 0 EST}
+ {877795200 39600 1 EST}
+ {891100800 36000 0 EST}
+ {909244800 39600 1 EST}
+ {922550400 36000 0 EST}
+ {941299200 39600 1 EST}
+ {954000000 36000 0 EST}
+ {967305600 39600 1 EST}
+ {985449600 36000 0 EST}
+ {1004198400 39600 1 EST}
+ {1017504000 36000 0 EST}
+ {1035648000 39600 1 EST}
+ {1048953600 36000 0 EST}
+ {1067097600 39600 1 EST}
+ {1080403200 36000 0 EST}
+ {1099152000 39600 1 EST}
+ {1111852800 36000 0 EST}
+ {1130601600 39600 1 EST}
+ {1143907200 36000 0 EST}
+ {1162051200 39600 1 EST}
+ {1174752000 36000 0 EST}
+ {1193500800 39600 1 EST}
+ {1207411200 36000 0 EST}
+ {1223136000 39600 1 EST}
+ {1238860800 36000 0 EST}
+ {1254585600 39600 1 EST}
+ {1270310400 36000 0 EST}
+ {1286035200 39600 1 EST}
+ {1301760000 36000 0 EST}
+ {1317484800 39600 1 EST}
+ {1333209600 36000 0 EST}
+ {1349539200 39600 1 EST}
+ {1365264000 36000 0 EST}
+ {1380988800 39600 1 EST}
+ {1396713600 36000 0 EST}
+ {1412438400 39600 1 EST}
+ {1428163200 36000 0 EST}
+ {1443888000 39600 1 EST}
+ {1459612800 36000 0 EST}
+ {1475337600 39600 1 EST}
+ {1491062400 36000 0 EST}
+ {1506787200 39600 1 EST}
+ {1522512000 36000 0 EST}
+ {1538841600 39600 1 EST}
+ {1554566400 36000 0 EST}
+ {1570291200 39600 1 EST}
+ {1586016000 36000 0 EST}
+ {1601740800 39600 1 EST}
+ {1617465600 36000 0 EST}
+ {1633190400 39600 1 EST}
+ {1648915200 36000 0 EST}
+ {1664640000 39600 1 EST}
+ {1680364800 36000 0 EST}
+ {1696089600 39600 1 EST}
+ {1712419200 36000 0 EST}
+ {1728144000 39600 1 EST}
+ {1743868800 36000 0 EST}
+ {1759593600 39600 1 EST}
+ {1775318400 36000 0 EST}
+ {1791043200 39600 1 EST}
+ {1806768000 36000 0 EST}
+ {1822492800 39600 1 EST}
+ {1838217600 36000 0 EST}
+ {1853942400 39600 1 EST}
+ {1869667200 36000 0 EST}
+ {1885996800 39600 1 EST}
+ {1901721600 36000 0 EST}
+ {1917446400 39600 1 EST}
+ {1933171200 36000 0 EST}
+ {1948896000 39600 1 EST}
+ {1964620800 36000 0 EST}
+ {1980345600 39600 1 EST}
+ {1996070400 36000 0 EST}
+ {2011795200 39600 1 EST}
+ {2027520000 36000 0 EST}
+ {2043244800 39600 1 EST}
+ {2058969600 36000 0 EST}
+ {2075299200 39600 1 EST}
+ {2091024000 36000 0 EST}
+ {2106748800 39600 1 EST}
+ {2122473600 36000 0 EST}
+ {2138198400 39600 1 EST}
+ {2153923200 36000 0 EST}
+ {2169648000 39600 1 EST}
+ {2185372800 36000 0 EST}
+ {2201097600 39600 1 EST}
+ {2216822400 36000 0 EST}
+ {2233152000 39600 1 EST}
+ {2248876800 36000 0 EST}
+ {2264601600 39600 1 EST}
+ {2280326400 36000 0 EST}
+ {2296051200 39600 1 EST}
+ {2311776000 36000 0 EST}
+ {2327500800 39600 1 EST}
+ {2343225600 36000 0 EST}
+ {2358950400 39600 1 EST}
+ {2374675200 36000 0 EST}
+ {2390400000 39600 1 EST}
+ {2406124800 36000 0 EST}
+ {2422454400 39600 1 EST}
+ {2438179200 36000 0 EST}
+ {2453904000 39600 1 EST}
+ {2469628800 36000 0 EST}
+ {2485353600 39600 1 EST}
+ {2501078400 36000 0 EST}
+ {2516803200 39600 1 EST}
+ {2532528000 36000 0 EST}
+ {2548252800 39600 1 EST}
+ {2563977600 36000 0 EST}
+ {2579702400 39600 1 EST}
+ {2596032000 36000 0 EST}
+ {2611756800 39600 1 EST}
+ {2627481600 36000 0 EST}
+ {2643206400 39600 1 EST}
+ {2658931200 36000 0 EST}
+ {2674656000 39600 1 EST}
+ {2690380800 36000 0 EST}
+ {2706105600 39600 1 EST}
+ {2721830400 36000 0 EST}
+ {2737555200 39600 1 EST}
+ {2753280000 36000 0 EST}
+ {2769609600 39600 1 EST}
+ {2785334400 36000 0 EST}
+ {2801059200 39600 1 EST}
+ {2816784000 36000 0 EST}
+ {2832508800 39600 1 EST}
+ {2848233600 36000 0 EST}
+ {2863958400 39600 1 EST}
+ {2879683200 36000 0 EST}
+ {2895408000 39600 1 EST}
+ {2911132800 36000 0 EST}
+ {2926857600 39600 1 EST}
+ {2942582400 36000 0 EST}
+ {2958912000 39600 1 EST}
+ {2974636800 36000 0 EST}
+ {2990361600 39600 1 EST}
+ {3006086400 36000 0 EST}
+ {3021811200 39600 1 EST}
+ {3037536000 36000 0 EST}
+ {3053260800 39600 1 EST}
+ {3068985600 36000 0 EST}
+ {3084710400 39600 1 EST}
+ {3100435200 36000 0 EST}
+ {3116764800 39600 1 EST}
+ {3132489600 36000 0 EST}
+ {3148214400 39600 1 EST}
+ {3163939200 36000 0 EST}
+ {3179664000 39600 1 EST}
+ {3195388800 36000 0 EST}
+ {3211113600 39600 1 EST}
+ {3226838400 36000 0 EST}
+ {3242563200 39600 1 EST}
+ {3258288000 36000 0 EST}
+ {3274012800 39600 1 EST}
+ {3289737600 36000 0 EST}
+ {3306067200 39600 1 EST}
+ {3321792000 36000 0 EST}
+ {3337516800 39600 1 EST}
+ {3353241600 36000 0 EST}
+ {3368966400 39600 1 EST}
+ {3384691200 36000 0 EST}
+ {3400416000 39600 1 EST}
+ {3416140800 36000 0 EST}
+ {3431865600 39600 1 EST}
+ {3447590400 36000 0 EST}
+ {3463315200 39600 1 EST}
+ {3479644800 36000 0 EST}
+ {3495369600 39600 1 EST}
+ {3511094400 36000 0 EST}
+ {3526819200 39600 1 EST}
+ {3542544000 36000 0 EST}
+ {3558268800 39600 1 EST}
+ {3573993600 36000 0 EST}
+ {3589718400 39600 1 EST}
+ {3605443200 36000 0 EST}
+ {3621168000 39600 1 EST}
+ {3636892800 36000 0 EST}
+ {3653222400 39600 1 EST}
+ {3668947200 36000 0 EST}
+ {3684672000 39600 1 EST}
+ {3700396800 36000 0 EST}
+ {3716121600 39600 1 EST}
+ {3731846400 36000 0 EST}
+ {3747571200 39600 1 EST}
+ {3763296000 36000 0 EST}
+ {3779020800 39600 1 EST}
+ {3794745600 36000 0 EST}
+ {3810470400 39600 1 EST}
+ {3826195200 36000 0 EST}
+ {3842524800 39600 1 EST}
+ {3858249600 36000 0 EST}
+ {3873974400 39600 1 EST}
+ {3889699200 36000 0 EST}
+ {3905424000 39600 1 EST}
+ {3921148800 36000 0 EST}
+ {3936873600 39600 1 EST}
+ {3952598400 36000 0 EST}
+ {3968323200 39600 1 EST}
+ {3984048000 36000 0 EST}
+ {4000377600 39600 1 EST}
+ {4016102400 36000 0 EST}
+ {4031827200 39600 1 EST}
+ {4047552000 36000 0 EST}
+ {4063276800 39600 1 EST}
+ {4079001600 36000 0 EST}
+ {4094726400 39600 1 EST}
}
diff --git a/library/tzdata/Australia/Tasmania b/library/tzdata/Australia/Tasmania
index e5c686e..1849bde 100644
--- a/library/tzdata/Australia/Tasmania
+++ b/library/tzdata/Australia/Tasmania
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Hobart)]} {
LoadTimeZoneFile Australia/Hobart
}
diff --git a/library/tzdata/Australia/Victoria b/library/tzdata/Australia/Victoria
index cabe455..037bfeb 100644
--- a/library/tzdata/Australia/Victoria
+++ b/library/tzdata/Australia/Victoria
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Melbourne)]} {
LoadTimeZoneFile Australia/Melbourne
}
diff --git a/library/tzdata/Australia/West b/library/tzdata/Australia/West
index 2c4e736..4689f7e 100644
--- a/library/tzdata/Australia/West
+++ b/library/tzdata/Australia/West
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Perth)]} {
LoadTimeZoneFile Australia/Perth
}
diff --git a/library/tzdata/Australia/Yancowinna b/library/tzdata/Australia/Yancowinna
index 38f8952..b7d668d 100644
--- a/library/tzdata/Australia/Yancowinna
+++ b/library/tzdata/Australia/Yancowinna
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Broken_Hill)]} {
LoadTimeZoneFile Australia/Broken_Hill
}
diff --git a/library/tzdata/Brazil/Acre b/library/tzdata/Brazil/Acre
index 791e175..abb0b98 100644
--- a/library/tzdata/Brazil/Acre
+++ b/library/tzdata/Brazil/Acre
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Rio_Branco)]} {
LoadTimeZoneFile America/Rio_Branco
}
diff --git a/library/tzdata/Brazil/DeNoronha b/library/tzdata/Brazil/DeNoronha
index f900656..53accb4 100644
--- a/library/tzdata/Brazil/DeNoronha
+++ b/library/tzdata/Brazil/DeNoronha
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Noronha)]} {
LoadTimeZoneFile America/Noronha
}
diff --git a/library/tzdata/Brazil/East b/library/tzdata/Brazil/East
index f49e447..f684633 100644
--- a/library/tzdata/Brazil/East
+++ b/library/tzdata/Brazil/East
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Sao_Paulo)]} {
LoadTimeZoneFile America/Sao_Paulo
}
diff --git a/library/tzdata/Brazil/West b/library/tzdata/Brazil/West
index 8d3386d..67676d9 100644
--- a/library/tzdata/Brazil/West
+++ b/library/tzdata/Brazil/West
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Manaus)]} {
LoadTimeZoneFile America/Manaus
}
diff --git a/library/tzdata/CET b/library/tzdata/CET
index a41388f..b08750a 100644
--- a/library/tzdata/CET
+++ b/library/tzdata/CET
@@ -1,263 +1,265 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:CET) {
{-9223372036854775808 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
- {-938901600 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {228880800 7200 1 CEST}
- {244000800 3600 0 CET}
- {260330400 7200 1 CEST}
- {276055200 3600 0 CET}
- {291780000 7200 1 CEST}
- {307504800 3600 0 CET}
- {323834400 7200 1 CEST}
- {338954400 3600 0 CET}
- {354679200 7200 1 CEST}
- {370404000 3600 0 CET}
- {386128800 7200 1 CEST}
- {401853600 3600 0 CET}
- {417578400 7200 1 CEST}
- {433303200 3600 0 CET}
- {449028000 7200 1 CEST}
- {465357600 3600 0 CET}
- {481082400 7200 1 CEST}
- {496807200 3600 0 CET}
- {512532000 7200 1 CEST}
- {528256800 3600 0 CET}
- {543981600 7200 1 CEST}
- {559706400 3600 0 CET}
- {575431200 7200 1 CEST}
- {591156000 3600 0 CET}
- {606880800 7200 1 CEST}
- {622605600 3600 0 CET}
- {638330400 7200 1 CEST}
- {654660000 3600 0 CET}
- {670384800 7200 1 CEST}
- {686109600 3600 0 CET}
- {701834400 7200 1 CEST}
- {717559200 3600 0 CET}
- {733284000 7200 1 CEST}
- {749008800 3600 0 CET}
- {764733600 7200 1 CEST}
- {780458400 3600 0 CET}
- {796183200 7200 1 CEST}
- {811908000 3600 0 CET}
- {828237600 7200 1 CEST}
- {846381600 3600 0 CET}
- {859687200 7200 1 CEST}
- {877831200 3600 0 CET}
- {891136800 7200 1 CEST}
- {909280800 3600 0 CET}
- {922586400 7200 1 CEST}
- {941335200 3600 0 CET}
- {954036000 7200 1 CEST}
- {972784800 3600 0 CET}
- {985485600 7200 1 CEST}
- {1004234400 3600 0 CET}
- {1017540000 7200 1 CEST}
- {1035684000 3600 0 CET}
- {1048989600 7200 1 CEST}
- {1067133600 3600 0 CET}
- {1080439200 7200 1 CEST}
- {1099188000 3600 0 CET}
- {1111888800 7200 1 CEST}
- {1130637600 3600 0 CET}
- {1143338400 7200 1 CEST}
- {1162087200 3600 0 CET}
- {1174788000 7200 1 CEST}
- {1193536800 3600 0 CET}
- {1206842400 7200 1 CEST}
- {1224986400 3600 0 CET}
- {1238292000 7200 1 CEST}
- {1256436000 3600 0 CET}
- {1269741600 7200 1 CEST}
- {1288490400 3600 0 CET}
- {1301191200 7200 1 CEST}
- {1319940000 3600 0 CET}
- {1332640800 7200 1 CEST}
- {1351389600 3600 0 CET}
- {1364695200 7200 1 CEST}
- {1382839200 3600 0 CET}
- {1396144800 7200 1 CEST}
- {1414288800 3600 0 CET}
- {1427594400 7200 1 CEST}
- {1445738400 3600 0 CET}
- {1459044000 7200 1 CEST}
- {1477792800 3600 0 CET}
- {1490493600 7200 1 CEST}
- {1509242400 3600 0 CET}
- {1521943200 7200 1 CEST}
- {1540692000 3600 0 CET}
- {1553997600 7200 1 CEST}
- {1572141600 3600 0 CET}
- {1585447200 7200 1 CEST}
- {1603591200 3600 0 CET}
- {1616896800 7200 1 CEST}
- {1635645600 3600 0 CET}
- {1648346400 7200 1 CEST}
- {1667095200 3600 0 CET}
- {1679796000 7200 1 CEST}
- {1698544800 3600 0 CET}
- {1711850400 7200 1 CEST}
- {1729994400 3600 0 CET}
- {1743300000 7200 1 CEST}
- {1761444000 3600 0 CET}
- {1774749600 7200 1 CEST}
- {1792893600 3600 0 CET}
- {1806199200 7200 1 CEST}
- {1824948000 3600 0 CET}
- {1837648800 7200 1 CEST}
- {1856397600 3600 0 CET}
- {1869098400 7200 1 CEST}
- {1887847200 3600 0 CET}
- {1901152800 7200 1 CEST}
- {1919296800 3600 0 CET}
- {1932602400 7200 1 CEST}
- {1950746400 3600 0 CET}
- {1964052000 7200 1 CEST}
- {1982800800 3600 0 CET}
- {1995501600 7200 1 CEST}
- {2014250400 3600 0 CET}
- {2026951200 7200 1 CEST}
- {2045700000 3600 0 CET}
- {2058400800 7200 1 CEST}
- {2077149600 3600 0 CET}
- {2090455200 7200 1 CEST}
- {2108599200 3600 0 CET}
- {2121904800 7200 1 CEST}
- {2140048800 3600 0 CET}
- {2153354400 7200 1 CEST}
- {2172103200 3600 0 CET}
- {2184804000 7200 1 CEST}
- {2203552800 3600 0 CET}
- {2216253600 7200 1 CEST}
- {2235002400 3600 0 CET}
- {2248308000 7200 1 CEST}
- {2266452000 3600 0 CET}
- {2279757600 7200 1 CEST}
- {2297901600 3600 0 CET}
- {2311207200 7200 1 CEST}
- {2329351200 3600 0 CET}
- {2342656800 7200 1 CEST}
- {2361405600 3600 0 CET}
- {2374106400 7200 1 CEST}
- {2392855200 3600 0 CET}
- {2405556000 7200 1 CEST}
- {2424304800 3600 0 CET}
- {2437610400 7200 1 CEST}
- {2455754400 3600 0 CET}
- {2469060000 7200 1 CEST}
- {2487204000 3600 0 CET}
- {2500509600 7200 1 CEST}
- {2519258400 3600 0 CET}
- {2531959200 7200 1 CEST}
- {2550708000 3600 0 CET}
- {2563408800 7200 1 CEST}
- {2582157600 3600 0 CET}
- {2595463200 7200 1 CEST}
- {2613607200 3600 0 CET}
- {2626912800 7200 1 CEST}
- {2645056800 3600 0 CET}
- {2658362400 7200 1 CEST}
- {2676506400 3600 0 CET}
- {2689812000 7200 1 CEST}
- {2708560800 3600 0 CET}
- {2721261600 7200 1 CEST}
- {2740010400 3600 0 CET}
- {2752711200 7200 1 CEST}
- {2771460000 3600 0 CET}
- {2784765600 7200 1 CEST}
- {2802909600 3600 0 CET}
- {2816215200 7200 1 CEST}
- {2834359200 3600 0 CET}
- {2847664800 7200 1 CEST}
- {2866413600 3600 0 CET}
- {2879114400 7200 1 CEST}
- {2897863200 3600 0 CET}
- {2910564000 7200 1 CEST}
- {2929312800 3600 0 CET}
- {2942013600 7200 1 CEST}
- {2960762400 3600 0 CET}
- {2974068000 7200 1 CEST}
- {2992212000 3600 0 CET}
- {3005517600 7200 1 CEST}
- {3023661600 3600 0 CET}
- {3036967200 7200 1 CEST}
- {3055716000 3600 0 CET}
- {3068416800 7200 1 CEST}
- {3087165600 3600 0 CET}
- {3099866400 7200 1 CEST}
- {3118615200 3600 0 CET}
- {3131920800 7200 1 CEST}
- {3150064800 3600 0 CET}
- {3163370400 7200 1 CEST}
- {3181514400 3600 0 CET}
- {3194820000 7200 1 CEST}
- {3212964000 3600 0 CET}
- {3226269600 7200 1 CEST}
- {3245018400 3600 0 CET}
- {3257719200 7200 1 CEST}
- {3276468000 3600 0 CET}
- {3289168800 7200 1 CEST}
- {3307917600 3600 0 CET}
- {3321223200 7200 1 CEST}
- {3339367200 3600 0 CET}
- {3352672800 7200 1 CEST}
- {3370816800 3600 0 CET}
- {3384122400 7200 1 CEST}
- {3402871200 3600 0 CET}
- {3415572000 7200 1 CEST}
- {3434320800 3600 0 CET}
- {3447021600 7200 1 CEST}
- {3465770400 3600 0 CET}
- {3479076000 7200 1 CEST}
- {3497220000 3600 0 CET}
- {3510525600 7200 1 CEST}
- {3528669600 3600 0 CET}
- {3541975200 7200 1 CEST}
- {3560119200 3600 0 CET}
- {3573424800 7200 1 CEST}
- {3592173600 3600 0 CET}
- {3604874400 7200 1 CEST}
- {3623623200 3600 0 CET}
- {3636324000 7200 1 CEST}
- {3655072800 3600 0 CET}
- {3668378400 7200 1 CEST}
- {3686522400 3600 0 CET}
- {3699828000 7200 1 CEST}
- {3717972000 3600 0 CET}
- {3731277600 7200 1 CEST}
- {3750026400 3600 0 CET}
- {3762727200 7200 1 CEST}
- {3781476000 3600 0 CET}
- {3794176800 7200 1 CEST}
- {3812925600 3600 0 CET}
- {3825626400 7200 1 CEST}
- {3844375200 3600 0 CET}
- {3857680800 7200 1 CEST}
- {3875824800 3600 0 CET}
- {3889130400 7200 1 CEST}
- {3907274400 3600 0 CET}
- {3920580000 7200 1 CEST}
- {3939328800 3600 0 CET}
- {3952029600 7200 1 CEST}
- {3970778400 3600 0 CET}
- {3983479200 7200 1 CEST}
- {4002228000 3600 0 CET}
- {4015533600 7200 1 CEST}
- {4033677600 3600 0 CET}
- {4046983200 7200 1 CEST}
- {4065127200 3600 0 CET}
- {4078432800 7200 1 CEST}
- {4096576800 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
+ {-938905200 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 1 CEST}
+ {-766623600 3600 0 CET}
+ {228877200 7200 1 CEST}
+ {243997200 3600 0 CET}
+ {260326800 7200 1 CEST}
+ {276051600 3600 0 CET}
+ {291776400 7200 1 CEST}
+ {307501200 3600 0 CET}
+ {323830800 7200 1 CEST}
+ {338950800 3600 0 CET}
+ {354675600 7200 1 CEST}
+ {370400400 3600 0 CET}
+ {386125200 7200 1 CEST}
+ {401850000 3600 0 CET}
+ {417574800 7200 1 CEST}
+ {433299600 3600 0 CET}
+ {449024400 7200 1 CEST}
+ {465354000 3600 0 CET}
+ {481078800 7200 1 CEST}
+ {496803600 3600 0 CET}
+ {512528400 7200 1 CEST}
+ {528253200 3600 0 CET}
+ {543978000 7200 1 CEST}
+ {559702800 3600 0 CET}
+ {575427600 7200 1 CEST}
+ {591152400 3600 0 CET}
+ {606877200 7200 1 CEST}
+ {622602000 3600 0 CET}
+ {638326800 7200 1 CEST}
+ {654656400 3600 0 CET}
+ {670381200 7200 1 CEST}
+ {686106000 3600 0 CET}
+ {701830800 7200 1 CEST}
+ {717555600 3600 0 CET}
+ {733280400 7200 1 CEST}
+ {749005200 3600 0 CET}
+ {764730000 7200 1 CEST}
+ {780454800 3600 0 CET}
+ {796179600 7200 1 CEST}
+ {811904400 3600 0 CET}
+ {828234000 7200 1 CEST}
+ {846378000 3600 0 CET}
+ {859683600 7200 1 CEST}
+ {877827600 3600 0 CET}
+ {891133200 7200 1 CEST}
+ {909277200 3600 0 CET}
+ {922582800 7200 1 CEST}
+ {941331600 3600 0 CET}
+ {954032400 7200 1 CEST}
+ {972781200 3600 0 CET}
+ {985482000 7200 1 CEST}
+ {1004230800 3600 0 CET}
+ {1017536400 7200 1 CEST}
+ {1035680400 3600 0 CET}
+ {1048986000 7200 1 CEST}
+ {1067130000 3600 0 CET}
+ {1080435600 7200 1 CEST}
+ {1099184400 3600 0 CET}
+ {1111885200 7200 1 CEST}
+ {1130634000 3600 0 CET}
+ {1143334800 7200 1 CEST}
+ {1162083600 3600 0 CET}
+ {1174784400 7200 1 CEST}
+ {1193533200 3600 0 CET}
+ {1206838800 7200 1 CEST}
+ {1224982800 3600 0 CET}
+ {1238288400 7200 1 CEST}
+ {1256432400 3600 0 CET}
+ {1269738000 7200 1 CEST}
+ {1288486800 3600 0 CET}
+ {1301187600 7200 1 CEST}
+ {1319936400 3600 0 CET}
+ {1332637200 7200 1 CEST}
+ {1351386000 3600 0 CET}
+ {1364691600 7200 1 CEST}
+ {1382835600 3600 0 CET}
+ {1396141200 7200 1 CEST}
+ {1414285200 3600 0 CET}
+ {1427590800 7200 1 CEST}
+ {1445734800 3600 0 CET}
+ {1459040400 7200 1 CEST}
+ {1477789200 3600 0 CET}
+ {1490490000 7200 1 CEST}
+ {1509238800 3600 0 CET}
+ {1521939600 7200 1 CEST}
+ {1540688400 3600 0 CET}
+ {1553994000 7200 1 CEST}
+ {1572138000 3600 0 CET}
+ {1585443600 7200 1 CEST}
+ {1603587600 3600 0 CET}
+ {1616893200 7200 1 CEST}
+ {1635642000 3600 0 CET}
+ {1648342800 7200 1 CEST}
+ {1667091600 3600 0 CET}
+ {1679792400 7200 1 CEST}
+ {1698541200 3600 0 CET}
+ {1711846800 7200 1 CEST}
+ {1729990800 3600 0 CET}
+ {1743296400 7200 1 CEST}
+ {1761440400 3600 0 CET}
+ {1774746000 7200 1 CEST}
+ {1792890000 3600 0 CET}
+ {1806195600 7200 1 CEST}
+ {1824944400 3600 0 CET}
+ {1837645200 7200 1 CEST}
+ {1856394000 3600 0 CET}
+ {1869094800 7200 1 CEST}
+ {1887843600 3600 0 CET}
+ {1901149200 7200 1 CEST}
+ {1919293200 3600 0 CET}
+ {1932598800 7200 1 CEST}
+ {1950742800 3600 0 CET}
+ {1964048400 7200 1 CEST}
+ {1982797200 3600 0 CET}
+ {1995498000 7200 1 CEST}
+ {2014246800 3600 0 CET}
+ {2026947600 7200 1 CEST}
+ {2045696400 3600 0 CET}
+ {2058397200 7200 1 CEST}
+ {2077146000 3600 0 CET}
+ {2090451600 7200 1 CEST}
+ {2108595600 3600 0 CET}
+ {2121901200 7200 1 CEST}
+ {2140045200 3600 0 CET}
+ {2153350800 7200 1 CEST}
+ {2172099600 3600 0 CET}
+ {2184800400 7200 1 CEST}
+ {2203549200 3600 0 CET}
+ {2216250000 7200 1 CEST}
+ {2234998800 3600 0 CET}
+ {2248304400 7200 1 CEST}
+ {2266448400 3600 0 CET}
+ {2279754000 7200 1 CEST}
+ {2297898000 3600 0 CET}
+ {2311203600 7200 1 CEST}
+ {2329347600 3600 0 CET}
+ {2342653200 7200 1 CEST}
+ {2361402000 3600 0 CET}
+ {2374102800 7200 1 CEST}
+ {2392851600 3600 0 CET}
+ {2405552400 7200 1 CEST}
+ {2424301200 3600 0 CET}
+ {2437606800 7200 1 CEST}
+ {2455750800 3600 0 CET}
+ {2469056400 7200 1 CEST}
+ {2487200400 3600 0 CET}
+ {2500506000 7200 1 CEST}
+ {2519254800 3600 0 CET}
+ {2531955600 7200 1 CEST}
+ {2550704400 3600 0 CET}
+ {2563405200 7200 1 CEST}
+ {2582154000 3600 0 CET}
+ {2595459600 7200 1 CEST}
+ {2613603600 3600 0 CET}
+ {2626909200 7200 1 CEST}
+ {2645053200 3600 0 CET}
+ {2658358800 7200 1 CEST}
+ {2676502800 3600 0 CET}
+ {2689808400 7200 1 CEST}
+ {2708557200 3600 0 CET}
+ {2721258000 7200 1 CEST}
+ {2740006800 3600 0 CET}
+ {2752707600 7200 1 CEST}
+ {2771456400 3600 0 CET}
+ {2784762000 7200 1 CEST}
+ {2802906000 3600 0 CET}
+ {2816211600 7200 1 CEST}
+ {2834355600 3600 0 CET}
+ {2847661200 7200 1 CEST}
+ {2866410000 3600 0 CET}
+ {2879110800 7200 1 CEST}
+ {2897859600 3600 0 CET}
+ {2910560400 7200 1 CEST}
+ {2929309200 3600 0 CET}
+ {2942010000 7200 1 CEST}
+ {2960758800 3600 0 CET}
+ {2974064400 7200 1 CEST}
+ {2992208400 3600 0 CET}
+ {3005514000 7200 1 CEST}
+ {3023658000 3600 0 CET}
+ {3036963600 7200 1 CEST}
+ {3055712400 3600 0 CET}
+ {3068413200 7200 1 CEST}
+ {3087162000 3600 0 CET}
+ {3099862800 7200 1 CEST}
+ {3118611600 3600 0 CET}
+ {3131917200 7200 1 CEST}
+ {3150061200 3600 0 CET}
+ {3163366800 7200 1 CEST}
+ {3181510800 3600 0 CET}
+ {3194816400 7200 1 CEST}
+ {3212960400 3600 0 CET}
+ {3226266000 7200 1 CEST}
+ {3245014800 3600 0 CET}
+ {3257715600 7200 1 CEST}
+ {3276464400 3600 0 CET}
+ {3289165200 7200 1 CEST}
+ {3307914000 3600 0 CET}
+ {3321219600 7200 1 CEST}
+ {3339363600 3600 0 CET}
+ {3352669200 7200 1 CEST}
+ {3370813200 3600 0 CET}
+ {3384118800 7200 1 CEST}
+ {3402867600 3600 0 CET}
+ {3415568400 7200 1 CEST}
+ {3434317200 3600 0 CET}
+ {3447018000 7200 1 CEST}
+ {3465766800 3600 0 CET}
+ {3479072400 7200 1 CEST}
+ {3497216400 3600 0 CET}
+ {3510522000 7200 1 CEST}
+ {3528666000 3600 0 CET}
+ {3541971600 7200 1 CEST}
+ {3560115600 3600 0 CET}
+ {3573421200 7200 1 CEST}
+ {3592170000 3600 0 CET}
+ {3604870800 7200 1 CEST}
+ {3623619600 3600 0 CET}
+ {3636320400 7200 1 CEST}
+ {3655069200 3600 0 CET}
+ {3668374800 7200 1 CEST}
+ {3686518800 3600 0 CET}
+ {3699824400 7200 1 CEST}
+ {3717968400 3600 0 CET}
+ {3731274000 7200 1 CEST}
+ {3750022800 3600 0 CET}
+ {3762723600 7200 1 CEST}
+ {3781472400 3600 0 CET}
+ {3794173200 7200 1 CEST}
+ {3812922000 3600 0 CET}
+ {3825622800 7200 1 CEST}
+ {3844371600 3600 0 CET}
+ {3857677200 7200 1 CEST}
+ {3875821200 3600 0 CET}
+ {3889126800 7200 1 CEST}
+ {3907270800 3600 0 CET}
+ {3920576400 7200 1 CEST}
+ {3939325200 3600 0 CET}
+ {3952026000 7200 1 CEST}
+ {3970774800 3600 0 CET}
+ {3983475600 7200 1 CEST}
+ {4002224400 3600 0 CET}
+ {4015530000 7200 1 CEST}
+ {4033674000 3600 0 CET}
+ {4046979600 7200 1 CEST}
+ {4065123600 3600 0 CET}
+ {4078429200 7200 1 CEST}
+ {4096573200 3600 0 CET}
}
diff --git a/library/tzdata/CST6CDT b/library/tzdata/CST6CDT
index 4289205..11e45f0 100644
--- a/library/tzdata/CST6CDT
+++ b/library/tzdata/CST6CDT
@@ -1,5 +1,278 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Chicago)]} {
- LoadTimeZoneFile America/Chicago
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:CST6CDT) {
+ {-9223372036854775808 -21600 0 CST}
+ {-1633276800 -18000 1 CDT}
+ {-1615136400 -21600 0 CST}
+ {-1601827200 -18000 1 CDT}
+ {-1583686800 -21600 0 CST}
+ {-880214400 -18000 1 CWT}
+ {-769395600 -18000 1 CPT}
+ {-765392400 -21600 0 CST}
+ {-84384000 -18000 1 CDT}
+ {-68662800 -21600 0 CST}
+ {-52934400 -18000 1 CDT}
+ {-37213200 -21600 0 CST}
+ {-21484800 -18000 1 CDT}
+ {-5763600 -21600 0 CST}
+ {9964800 -18000 1 CDT}
+ {25686000 -21600 0 CST}
+ {41414400 -18000 1 CDT}
+ {57740400 -21600 0 CST}
+ {73468800 -18000 1 CDT}
+ {89190000 -21600 0 CST}
+ {104918400 -18000 1 CDT}
+ {120639600 -21600 0 CST}
+ {126691200 -18000 1 CDT}
+ {152089200 -21600 0 CST}
+ {162374400 -18000 1 CDT}
+ {183538800 -21600 0 CST}
+ {199267200 -18000 1 CDT}
+ {215593200 -21600 0 CST}
+ {230716800 -18000 1 CDT}
+ {247042800 -21600 0 CST}
+ {262771200 -18000 1 CDT}
+ {278492400 -21600 0 CST}
+ {294220800 -18000 1 CDT}
+ {309942000 -21600 0 CST}
+ {325670400 -18000 1 CDT}
+ {341391600 -21600 0 CST}
+ {357120000 -18000 1 CDT}
+ {372841200 -21600 0 CST}
+ {388569600 -18000 1 CDT}
+ {404895600 -21600 0 CST}
+ {420019200 -18000 1 CDT}
+ {436345200 -21600 0 CST}
+ {452073600 -18000 1 CDT}
+ {467794800 -21600 0 CST}
+ {483523200 -18000 1 CDT}
+ {499244400 -21600 0 CST}
+ {514972800 -18000 1 CDT}
+ {530694000 -21600 0 CST}
+ {544608000 -18000 1 CDT}
+ {562143600 -21600 0 CST}
+ {576057600 -18000 1 CDT}
+ {594198000 -21600 0 CST}
+ {607507200 -18000 1 CDT}
+ {625647600 -21600 0 CST}
+ {638956800 -18000 1 CDT}
+ {657097200 -21600 0 CST}
+ {671011200 -18000 1 CDT}
+ {688546800 -21600 0 CST}
+ {702460800 -18000 1 CDT}
+ {719996400 -21600 0 CST}
+ {733910400 -18000 1 CDT}
+ {752050800 -21600 0 CST}
+ {765360000 -18000 1 CDT}
+ {783500400 -21600 0 CST}
+ {796809600 -18000 1 CDT}
+ {814950000 -21600 0 CST}
+ {828864000 -18000 1 CDT}
+ {846399600 -21600 0 CST}
+ {860313600 -18000 1 CDT}
+ {877849200 -21600 0 CST}
+ {891763200 -18000 1 CDT}
+ {909298800 -21600 0 CST}
+ {923212800 -18000 1 CDT}
+ {941353200 -21600 0 CST}
+ {954662400 -18000 1 CDT}
+ {972802800 -21600 0 CST}
+ {986112000 -18000 1 CDT}
+ {1004252400 -21600 0 CST}
+ {1018166400 -18000 1 CDT}
+ {1035702000 -21600 0 CST}
+ {1049616000 -18000 1 CDT}
+ {1067151600 -21600 0 CST}
+ {1081065600 -18000 1 CDT}
+ {1099206000 -21600 0 CST}
+ {1112515200 -18000 1 CDT}
+ {1130655600 -21600 0 CST}
+ {1143964800 -18000 1 CDT}
+ {1162105200 -21600 0 CST}
+ {1173600000 -18000 1 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}
}
-set TZData(:CST6CDT) $TZData(:America/Chicago)
diff --git a/library/tzdata/Canada/Atlantic b/library/tzdata/Canada/Atlantic
index 62f7758..d1478d9 100644
--- a/library/tzdata/Canada/Atlantic
+++ b/library/tzdata/Canada/Atlantic
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Halifax)]} {
LoadTimeZoneFile America/Halifax
}
diff --git a/library/tzdata/Canada/Central b/library/tzdata/Canada/Central
index 50cdc1e..b04bef9 100644
--- a/library/tzdata/Canada/Central
+++ b/library/tzdata/Canada/Central
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Winnipeg)]} {
LoadTimeZoneFile America/Winnipeg
}
diff --git a/library/tzdata/Canada/East-Saskatchewan b/library/tzdata/Canada/East-Saskatchewan
index 06bab20..f7e500c 100644
--- a/library/tzdata/Canada/East-Saskatchewan
+++ b/library/tzdata/Canada/East-Saskatchewan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Regina)]} {
LoadTimeZoneFile America/Regina
}
diff --git a/library/tzdata/Canada/Eastern b/library/tzdata/Canada/Eastern
index 5dfa611..74528eb 100644
--- a/library/tzdata/Canada/Eastern
+++ b/library/tzdata/Canada/Eastern
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Toronto)]} {
LoadTimeZoneFile America/Toronto
}
diff --git a/library/tzdata/Canada/Mountain b/library/tzdata/Canada/Mountain
index 68e1961..8c6458d 100644
--- a/library/tzdata/Canada/Mountain
+++ b/library/tzdata/Canada/Mountain
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Edmonton)]} {
LoadTimeZoneFile America/Edmonton
}
diff --git a/library/tzdata/Canada/Newfoundland b/library/tzdata/Canada/Newfoundland
index 99395f2..6904cde 100644
--- a/library/tzdata/Canada/Newfoundland
+++ b/library/tzdata/Canada/Newfoundland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/St_Johns)]} {
LoadTimeZoneFile America/St_Johns
}
diff --git a/library/tzdata/Canada/Pacific b/library/tzdata/Canada/Pacific
index 1677dc0..4d70342 100644
--- a/library/tzdata/Canada/Pacific
+++ b/library/tzdata/Canada/Pacific
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Vancouver)]} {
LoadTimeZoneFile America/Vancouver
}
diff --git a/library/tzdata/Canada/Saskatchewan b/library/tzdata/Canada/Saskatchewan
index 20b82de..cd56446 100644
--- a/library/tzdata/Canada/Saskatchewan
+++ b/library/tzdata/Canada/Saskatchewan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Regina)]} {
LoadTimeZoneFile America/Regina
}
diff --git a/library/tzdata/Canada/Yukon b/library/tzdata/Canada/Yukon
index d806367..04b8368 100644
--- a/library/tzdata/Canada/Yukon
+++ b/library/tzdata/Canada/Yukon
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Whitehorse)]} {
LoadTimeZoneFile America/Whitehorse
}
diff --git a/library/tzdata/Chile/Continental b/library/tzdata/Chile/Continental
index 4c1b512..0f858a3 100644
--- a/library/tzdata/Chile/Continental
+++ b/library/tzdata/Chile/Continental
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Santiago)]} {
LoadTimeZoneFile America/Santiago
}
diff --git a/library/tzdata/Chile/EasterIsland b/library/tzdata/Chile/EasterIsland
index ee4cc00..4edc034 100644
--- a/library/tzdata/Chile/EasterIsland
+++ b/library/tzdata/Chile/EasterIsland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Easter)]} {
LoadTimeZoneFile Pacific/Easter
}
diff --git a/library/tzdata/Cuba b/library/tzdata/Cuba
index 698d87e..17f7b45 100644
--- a/library/tzdata/Cuba
+++ b/library/tzdata/Cuba
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Havana)]} {
LoadTimeZoneFile America/Havana
}
diff --git a/library/tzdata/EET b/library/tzdata/EET
index 1709714..e7c102a 100644
--- a/library/tzdata/EET
+++ b/library/tzdata/EET
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:EET) {
{-9223372036854775808 7200 0 EET}
diff --git a/library/tzdata/EST b/library/tzdata/EST
index db3ad99..72c5b17 100644
--- a/library/tzdata/EST
+++ b/library/tzdata/EST
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Indianapolis)]} {
- LoadTimeZoneFile America/Indianapolis
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:EST) {
+ {-9223372036854775808 -18000 0 EST}
}
-set TZData(:EST) $TZData(:America/Indianapolis)
diff --git a/library/tzdata/EST5EDT b/library/tzdata/EST5EDT
index 3e258c7..968833e 100644
--- a/library/tzdata/EST5EDT
+++ b/library/tzdata/EST5EDT
@@ -1,5 +1,278 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/New_York)]} {
- LoadTimeZoneFile America/New_York
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:EST5EDT) {
+ {-9223372036854775808 -18000 0 EST}
+ {-1633280400 -14400 1 EDT}
+ {-1615140000 -18000 0 EST}
+ {-1601830800 -14400 1 EDT}
+ {-1583690400 -18000 0 EST}
+ {-880218000 -14400 1 EWT}
+ {-769395600 -14400 1 EPT}
+ {-765396000 -18000 0 EST}
+ {-84387600 -14400 1 EDT}
+ {-68666400 -18000 0 EST}
+ {-52938000 -14400 1 EDT}
+ {-37216800 -18000 0 EST}
+ {-21488400 -14400 1 EDT}
+ {-5767200 -18000 0 EST}
+ {9961200 -14400 1 EDT}
+ {25682400 -18000 0 EST}
+ {41410800 -14400 1 EDT}
+ {57736800 -18000 0 EST}
+ {73465200 -14400 1 EDT}
+ {89186400 -18000 0 EST}
+ {104914800 -14400 1 EDT}
+ {120636000 -18000 0 EST}
+ {126687600 -14400 1 EDT}
+ {152085600 -18000 0 EST}
+ {162370800 -14400 1 EDT}
+ {183535200 -18000 0 EST}
+ {199263600 -14400 1 EDT}
+ {215589600 -18000 0 EST}
+ {230713200 -14400 1 EDT}
+ {247039200 -18000 0 EST}
+ {262767600 -14400 1 EDT}
+ {278488800 -18000 0 EST}
+ {294217200 -14400 1 EDT}
+ {309938400 -18000 0 EST}
+ {325666800 -14400 1 EDT}
+ {341388000 -18000 0 EST}
+ {357116400 -14400 1 EDT}
+ {372837600 -18000 0 EST}
+ {388566000 -14400 1 EDT}
+ {404892000 -18000 0 EST}
+ {420015600 -14400 1 EDT}
+ {436341600 -18000 0 EST}
+ {452070000 -14400 1 EDT}
+ {467791200 -18000 0 EST}
+ {483519600 -14400 1 EDT}
+ {499240800 -18000 0 EST}
+ {514969200 -14400 1 EDT}
+ {530690400 -18000 0 EST}
+ {544604400 -14400 1 EDT}
+ {562140000 -18000 0 EST}
+ {576054000 -14400 1 EDT}
+ {594194400 -18000 0 EST}
+ {607503600 -14400 1 EDT}
+ {625644000 -18000 0 EST}
+ {638953200 -14400 1 EDT}
+ {657093600 -18000 0 EST}
+ {671007600 -14400 1 EDT}
+ {688543200 -18000 0 EST}
+ {702457200 -14400 1 EDT}
+ {719992800 -18000 0 EST}
+ {733906800 -14400 1 EDT}
+ {752047200 -18000 0 EST}
+ {765356400 -14400 1 EDT}
+ {783496800 -18000 0 EST}
+ {796806000 -14400 1 EDT}
+ {814946400 -18000 0 EST}
+ {828860400 -14400 1 EDT}
+ {846396000 -18000 0 EST}
+ {860310000 -14400 1 EDT}
+ {877845600 -18000 0 EST}
+ {891759600 -14400 1 EDT}
+ {909295200 -18000 0 EST}
+ {923209200 -14400 1 EDT}
+ {941349600 -18000 0 EST}
+ {954658800 -14400 1 EDT}
+ {972799200 -18000 0 EST}
+ {986108400 -14400 1 EDT}
+ {1004248800 -18000 0 EST}
+ {1018162800 -14400 1 EDT}
+ {1035698400 -18000 0 EST}
+ {1049612400 -14400 1 EDT}
+ {1067148000 -18000 0 EST}
+ {1081062000 -14400 1 EDT}
+ {1099202400 -18000 0 EST}
+ {1112511600 -14400 1 EDT}
+ {1130652000 -18000 0 EST}
+ {1143961200 -14400 1 EDT}
+ {1162101600 -18000 0 EST}
+ {1173596400 -14400 1 EDT}
+ {1194156000 -18000 0 EST}
+ {1205046000 -14400 1 EDT}
+ {1225605600 -18000 0 EST}
+ {1236495600 -14400 1 EDT}
+ {1257055200 -18000 0 EST}
+ {1268550000 -14400 1 EDT}
+ {1289109600 -18000 0 EST}
+ {1299999600 -14400 1 EDT}
+ {1320559200 -18000 0 EST}
+ {1331449200 -14400 1 EDT}
+ {1352008800 -18000 0 EST}
+ {1362898800 -14400 1 EDT}
+ {1383458400 -18000 0 EST}
+ {1394348400 -14400 1 EDT}
+ {1414908000 -18000 0 EST}
+ {1425798000 -14400 1 EDT}
+ {1446357600 -18000 0 EST}
+ {1457852400 -14400 1 EDT}
+ {1478412000 -18000 0 EST}
+ {1489302000 -14400 1 EDT}
+ {1509861600 -18000 0 EST}
+ {1520751600 -14400 1 EDT}
+ {1541311200 -18000 0 EST}
+ {1552201200 -14400 1 EDT}
+ {1572760800 -18000 0 EST}
+ {1583650800 -14400 1 EDT}
+ {1604210400 -18000 0 EST}
+ {1615705200 -14400 1 EDT}
+ {1636264800 -18000 0 EST}
+ {1647154800 -14400 1 EDT}
+ {1667714400 -18000 0 EST}
+ {1678604400 -14400 1 EDT}
+ {1699164000 -18000 0 EST}
+ {1710054000 -14400 1 EDT}
+ {1730613600 -18000 0 EST}
+ {1741503600 -14400 1 EDT}
+ {1762063200 -18000 0 EST}
+ {1772953200 -14400 1 EDT}
+ {1793512800 -18000 0 EST}
+ {1805007600 -14400 1 EDT}
+ {1825567200 -18000 0 EST}
+ {1836457200 -14400 1 EDT}
+ {1857016800 -18000 0 EST}
+ {1867906800 -14400 1 EDT}
+ {1888466400 -18000 0 EST}
+ {1899356400 -14400 1 EDT}
+ {1919916000 -18000 0 EST}
+ {1930806000 -14400 1 EDT}
+ {1951365600 -18000 0 EST}
+ {1962860400 -14400 1 EDT}
+ {1983420000 -18000 0 EST}
+ {1994310000 -14400 1 EDT}
+ {2014869600 -18000 0 EST}
+ {2025759600 -14400 1 EDT}
+ {2046319200 -18000 0 EST}
+ {2057209200 -14400 1 EDT}
+ {2077768800 -18000 0 EST}
+ {2088658800 -14400 1 EDT}
+ {2109218400 -18000 0 EST}
+ {2120108400 -14400 1 EDT}
+ {2140668000 -18000 0 EST}
+ {2152162800 -14400 1 EDT}
+ {2172722400 -18000 0 EST}
+ {2183612400 -14400 1 EDT}
+ {2204172000 -18000 0 EST}
+ {2215062000 -14400 1 EDT}
+ {2235621600 -18000 0 EST}
+ {2246511600 -14400 1 EDT}
+ {2267071200 -18000 0 EST}
+ {2277961200 -14400 1 EDT}
+ {2298520800 -18000 0 EST}
+ {2309410800 -14400 1 EDT}
+ {2329970400 -18000 0 EST}
+ {2341465200 -14400 1 EDT}
+ {2362024800 -18000 0 EST}
+ {2372914800 -14400 1 EDT}
+ {2393474400 -18000 0 EST}
+ {2404364400 -14400 1 EDT}
+ {2424924000 -18000 0 EST}
+ {2435814000 -14400 1 EDT}
+ {2456373600 -18000 0 EST}
+ {2467263600 -14400 1 EDT}
+ {2487823200 -18000 0 EST}
+ {2499318000 -14400 1 EDT}
+ {2519877600 -18000 0 EST}
+ {2530767600 -14400 1 EDT}
+ {2551327200 -18000 0 EST}
+ {2562217200 -14400 1 EDT}
+ {2582776800 -18000 0 EST}
+ {2593666800 -14400 1 EDT}
+ {2614226400 -18000 0 EST}
+ {2625116400 -14400 1 EDT}
+ {2645676000 -18000 0 EST}
+ {2656566000 -14400 1 EDT}
+ {2677125600 -18000 0 EST}
+ {2688620400 -14400 1 EDT}
+ {2709180000 -18000 0 EST}
+ {2720070000 -14400 1 EDT}
+ {2740629600 -18000 0 EST}
+ {2751519600 -14400 1 EDT}
+ {2772079200 -18000 0 EST}
+ {2782969200 -14400 1 EDT}
+ {2803528800 -18000 0 EST}
+ {2814418800 -14400 1 EDT}
+ {2834978400 -18000 0 EST}
+ {2846473200 -14400 1 EDT}
+ {2867032800 -18000 0 EST}
+ {2877922800 -14400 1 EDT}
+ {2898482400 -18000 0 EST}
+ {2909372400 -14400 1 EDT}
+ {2929932000 -18000 0 EST}
+ {2940822000 -14400 1 EDT}
+ {2961381600 -18000 0 EST}
+ {2972271600 -14400 1 EDT}
+ {2992831200 -18000 0 EST}
+ {3003721200 -14400 1 EDT}
+ {3024280800 -18000 0 EST}
+ {3035775600 -14400 1 EDT}
+ {3056335200 -18000 0 EST}
+ {3067225200 -14400 1 EDT}
+ {3087784800 -18000 0 EST}
+ {3098674800 -14400 1 EDT}
+ {3119234400 -18000 0 EST}
+ {3130124400 -14400 1 EDT}
+ {3150684000 -18000 0 EST}
+ {3161574000 -14400 1 EDT}
+ {3182133600 -18000 0 EST}
+ {3193023600 -14400 1 EDT}
+ {3213583200 -18000 0 EST}
+ {3225078000 -14400 1 EDT}
+ {3245637600 -18000 0 EST}
+ {3256527600 -14400 1 EDT}
+ {3277087200 -18000 0 EST}
+ {3287977200 -14400 1 EDT}
+ {3308536800 -18000 0 EST}
+ {3319426800 -14400 1 EDT}
+ {3339986400 -18000 0 EST}
+ {3350876400 -14400 1 EDT}
+ {3371436000 -18000 0 EST}
+ {3382930800 -14400 1 EDT}
+ {3403490400 -18000 0 EST}
+ {3414380400 -14400 1 EDT}
+ {3434940000 -18000 0 EST}
+ {3445830000 -14400 1 EDT}
+ {3466389600 -18000 0 EST}
+ {3477279600 -14400 1 EDT}
+ {3497839200 -18000 0 EST}
+ {3508729200 -14400 1 EDT}
+ {3529288800 -18000 0 EST}
+ {3540178800 -14400 1 EDT}
+ {3560738400 -18000 0 EST}
+ {3572233200 -14400 1 EDT}
+ {3592792800 -18000 0 EST}
+ {3603682800 -14400 1 EDT}
+ {3624242400 -18000 0 EST}
+ {3635132400 -14400 1 EDT}
+ {3655692000 -18000 0 EST}
+ {3666582000 -14400 1 EDT}
+ {3687141600 -18000 0 EST}
+ {3698031600 -14400 1 EDT}
+ {3718591200 -18000 0 EST}
+ {3730086000 -14400 1 EDT}
+ {3750645600 -18000 0 EST}
+ {3761535600 -14400 1 EDT}
+ {3782095200 -18000 0 EST}
+ {3792985200 -14400 1 EDT}
+ {3813544800 -18000 0 EST}
+ {3824434800 -14400 1 EDT}
+ {3844994400 -18000 0 EST}
+ {3855884400 -14400 1 EDT}
+ {3876444000 -18000 0 EST}
+ {3887334000 -14400 1 EDT}
+ {3907893600 -18000 0 EST}
+ {3919388400 -14400 1 EDT}
+ {3939948000 -18000 0 EST}
+ {3950838000 -14400 1 EDT}
+ {3971397600 -18000 0 EST}
+ {3982287600 -14400 1 EDT}
+ {4002847200 -18000 0 EST}
+ {4013737200 -14400 1 EDT}
+ {4034296800 -18000 0 EST}
+ {4045186800 -14400 1 EDT}
+ {4065746400 -18000 0 EST}
+ {4076636400 -14400 1 EDT}
+ {4097196000 -18000 0 EST}
}
-set TZData(:EST5EDT) $TZData(:America/New_York)
diff --git a/library/tzdata/Egypt b/library/tzdata/Egypt
index 450e31c..63341bc 100644
--- a/library/tzdata/Egypt
+++ b/library/tzdata/Egypt
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Cairo)]} {
LoadTimeZoneFile Africa/Cairo
}
diff --git a/library/tzdata/Eire b/library/tzdata/Eire
index a8e9b27..c86c91c 100644
--- a/library/tzdata/Eire
+++ b/library/tzdata/Eire
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Dublin)]} {
LoadTimeZoneFile Europe/Dublin
}
diff --git a/library/tzdata/Etc/GMT b/library/tzdata/Etc/GMT
index f6c919f..7454fd5 100644
--- a/library/tzdata/Etc/GMT
+++ b/library/tzdata/Etc/GMT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT) {
{-9223372036854775808 0 0 GMT}
diff --git a/library/tzdata/Etc/GMT+0 b/library/tzdata/Etc/GMT+0
index 9da66e8..017dee1 100644
--- a/library/tzdata/Etc/GMT+0
+++ b/library/tzdata/Etc/GMT+0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/Etc/GMT+1 b/library/tzdata/Etc/GMT+1
index adc16af..12f97ba 100644
--- a/library/tzdata/Etc/GMT+1
+++ b/library/tzdata/Etc/GMT+1
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+1) {
{-9223372036854775808 -3600 0 GMT+1}
diff --git a/library/tzdata/Etc/GMT+10 b/library/tzdata/Etc/GMT+10
index 2ff7910..6ea50bb 100644
--- a/library/tzdata/Etc/GMT+10
+++ b/library/tzdata/Etc/GMT+10
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+10) {
{-9223372036854775808 -36000 0 GMT+10}
diff --git a/library/tzdata/Etc/GMT+11 b/library/tzdata/Etc/GMT+11
index af71a7a..c91b169 100644
--- a/library/tzdata/Etc/GMT+11
+++ b/library/tzdata/Etc/GMT+11
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+11) {
{-9223372036854775808 -39600 0 GMT+11}
diff --git a/library/tzdata/Etc/GMT+12 b/library/tzdata/Etc/GMT+12
index 30ce089..29a4cee 100644
--- a/library/tzdata/Etc/GMT+12
+++ b/library/tzdata/Etc/GMT+12
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+12) {
{-9223372036854775808 -43200 0 GMT+12}
diff --git a/library/tzdata/Etc/GMT+2 b/library/tzdata/Etc/GMT+2
index 649333f..8c6b526 100644
--- a/library/tzdata/Etc/GMT+2
+++ b/library/tzdata/Etc/GMT+2
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+2) {
{-9223372036854775808 -7200 0 GMT+2}
diff --git a/library/tzdata/Etc/GMT+3 b/library/tzdata/Etc/GMT+3
index af359b0..862571d 100644
--- a/library/tzdata/Etc/GMT+3
+++ b/library/tzdata/Etc/GMT+3
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+3) {
{-9223372036854775808 -10800 0 GMT+3}
diff --git a/library/tzdata/Etc/GMT+4 b/library/tzdata/Etc/GMT+4
index 741372f..a933bbc 100644
--- a/library/tzdata/Etc/GMT+4
+++ b/library/tzdata/Etc/GMT+4
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+4) {
{-9223372036854775808 -14400 0 GMT+4}
diff --git a/library/tzdata/Etc/GMT+5 b/library/tzdata/Etc/GMT+5
index 28dd2a2..80cc25c 100644
--- a/library/tzdata/Etc/GMT+5
+++ b/library/tzdata/Etc/GMT+5
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+5) {
{-9223372036854775808 -18000 0 GMT+5}
diff --git a/library/tzdata/Etc/GMT+6 b/library/tzdata/Etc/GMT+6
index c5bf5db..bc57bd6 100644
--- a/library/tzdata/Etc/GMT+6
+++ b/library/tzdata/Etc/GMT+6
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+6) {
{-9223372036854775808 -21600 0 GMT+6}
diff --git a/library/tzdata/Etc/GMT+7 b/library/tzdata/Etc/GMT+7
index fa4af1e..d419eb9 100644
--- a/library/tzdata/Etc/GMT+7
+++ b/library/tzdata/Etc/GMT+7
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+7) {
{-9223372036854775808 -25200 0 GMT+7}
diff --git a/library/tzdata/Etc/GMT+8 b/library/tzdata/Etc/GMT+8
index 6814da4..705ad40 100644
--- a/library/tzdata/Etc/GMT+8
+++ b/library/tzdata/Etc/GMT+8
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+8) {
{-9223372036854775808 -28800 0 GMT+8}
diff --git a/library/tzdata/Etc/GMT+9 b/library/tzdata/Etc/GMT+9
index 02157d4..4086639 100644
--- a/library/tzdata/Etc/GMT+9
+++ b/library/tzdata/Etc/GMT+9
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT+9) {
{-9223372036854775808 -32400 0 GMT+9}
diff --git a/library/tzdata/Etc/GMT-0 b/library/tzdata/Etc/GMT-0
index d048999..d8913d5 100644
--- a/library/tzdata/Etc/GMT-0
+++ b/library/tzdata/Etc/GMT-0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/Etc/GMT-1 b/library/tzdata/Etc/GMT-1
index 95f320a..a44dd1f 100644
--- a/library/tzdata/Etc/GMT-1
+++ b/library/tzdata/Etc/GMT-1
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-1) {
{-9223372036854775808 3600 0 GMT-1}
diff --git a/library/tzdata/Etc/GMT-10 b/library/tzdata/Etc/GMT-10
index 1fd7692..1c50d01 100644
--- a/library/tzdata/Etc/GMT-10
+++ b/library/tzdata/Etc/GMT-10
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-10) {
{-9223372036854775808 36000 0 GMT-10}
diff --git a/library/tzdata/Etc/GMT-11 b/library/tzdata/Etc/GMT-11
index 86b9462..d07710f 100644
--- a/library/tzdata/Etc/GMT-11
+++ b/library/tzdata/Etc/GMT-11
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-11) {
{-9223372036854775808 39600 0 GMT-11}
diff --git a/library/tzdata/Etc/GMT-12 b/library/tzdata/Etc/GMT-12
index 8a71ccf..a23b98d 100644
--- a/library/tzdata/Etc/GMT-12
+++ b/library/tzdata/Etc/GMT-12
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-12) {
{-9223372036854775808 43200 0 GMT-12}
diff --git a/library/tzdata/Etc/GMT-13 b/library/tzdata/Etc/GMT-13
index e5dec03..1a6700a 100644
--- a/library/tzdata/Etc/GMT-13
+++ b/library/tzdata/Etc/GMT-13
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-13) {
{-9223372036854775808 46800 0 GMT-13}
diff --git a/library/tzdata/Etc/GMT-14 b/library/tzdata/Etc/GMT-14
index 38089d0..3707e21 100644
--- a/library/tzdata/Etc/GMT-14
+++ b/library/tzdata/Etc/GMT-14
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-14) {
{-9223372036854775808 50400 0 GMT-14}
diff --git a/library/tzdata/Etc/GMT-2 b/library/tzdata/Etc/GMT-2
index 7ab1e56..f9dea16 100644
--- a/library/tzdata/Etc/GMT-2
+++ b/library/tzdata/Etc/GMT-2
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-2) {
{-9223372036854775808 7200 0 GMT-2}
diff --git a/library/tzdata/Etc/GMT-3 b/library/tzdata/Etc/GMT-3
index ed56212..99145b8 100644
--- a/library/tzdata/Etc/GMT-3
+++ b/library/tzdata/Etc/GMT-3
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-3) {
{-9223372036854775808 10800 0 GMT-3}
diff --git a/library/tzdata/Etc/GMT-4 b/library/tzdata/Etc/GMT-4
index 79b9429..27b4fec 100644
--- a/library/tzdata/Etc/GMT-4
+++ b/library/tzdata/Etc/GMT-4
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-4) {
{-9223372036854775808 14400 0 GMT-4}
diff --git a/library/tzdata/Etc/GMT-5 b/library/tzdata/Etc/GMT-5
index 834806d..dbe3df7 100644
--- a/library/tzdata/Etc/GMT-5
+++ b/library/tzdata/Etc/GMT-5
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-5) {
{-9223372036854775808 18000 0 GMT-5}
diff --git a/library/tzdata/Etc/GMT-6 b/library/tzdata/Etc/GMT-6
index 2297bf5..414dbfa 100644
--- a/library/tzdata/Etc/GMT-6
+++ b/library/tzdata/Etc/GMT-6
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-6) {
{-9223372036854775808 21600 0 GMT-6}
diff --git a/library/tzdata/Etc/GMT-7 b/library/tzdata/Etc/GMT-7
index ed58c58..2bd59db 100644
--- a/library/tzdata/Etc/GMT-7
+++ b/library/tzdata/Etc/GMT-7
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-7) {
{-9223372036854775808 25200 0 GMT-7}
diff --git a/library/tzdata/Etc/GMT-8 b/library/tzdata/Etc/GMT-8
index 87db42d..7303721 100644
--- a/library/tzdata/Etc/GMT-8
+++ b/library/tzdata/Etc/GMT-8
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-8) {
{-9223372036854775808 28800 0 GMT-8}
diff --git a/library/tzdata/Etc/GMT-9 b/library/tzdata/Etc/GMT-9
index 4d1ea32..46e6878 100644
--- a/library/tzdata/Etc/GMT-9
+++ b/library/tzdata/Etc/GMT-9
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/GMT-9) {
{-9223372036854775808 32400 0 GMT-9}
diff --git a/library/tzdata/Etc/GMT0 b/library/tzdata/Etc/GMT0
index 151327b..dba1fe9 100644
--- a/library/tzdata/Etc/GMT0
+++ b/library/tzdata/Etc/GMT0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/Etc/Greenwich b/library/tzdata/Etc/Greenwich
index a729073..53acea0 100644
--- a/library/tzdata/Etc/Greenwich
+++ b/library/tzdata/Etc/Greenwich
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/Etc/UCT b/library/tzdata/Etc/UCT
index 3ce66ef..f7d795e 100644
--- a/library/tzdata/Etc/UCT
+++ b/library/tzdata/Etc/UCT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/UCT) {
{-9223372036854775808 0 0 UCT}
diff --git a/library/tzdata/Etc/UTC b/library/tzdata/Etc/UTC
index c6656a8..db5954b 100644
--- a/library/tzdata/Etc/UTC
+++ b/library/tzdata/Etc/UTC
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/UTC) {
{-9223372036854775808 0 0 UTC}
diff --git a/library/tzdata/Etc/Universal b/library/tzdata/Etc/Universal
index cf2fa3a..a3b7547 100644
--- a/library/tzdata/Etc/Universal
+++ b/library/tzdata/Etc/Universal
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
diff --git a/library/tzdata/Etc/Zulu b/library/tzdata/Etc/Zulu
index a4b35da..f643db9 100644
--- a/library/tzdata/Etc/Zulu
+++ b/library/tzdata/Etc/Zulu
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
diff --git a/library/tzdata/Europe/Amsterdam b/library/tzdata/Europe/Amsterdam
index 4e8bcad..bd89127 100644
--- a/library/tzdata/Europe/Amsterdam
+++ b/library/tzdata/Europe/Amsterdam
@@ -1,66 +1,65 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Amsterdam) {
{-9223372036854775808 1172 0 LMT}
{-4260212372 1172 0 AMT}
{-1693700372 4772 1 NST}
{-1680484772 1172 0 AMT}
- {-1663452000 4772 1 NST}
- {-1650146400 1172 0 AMT}
- {-1633212000 4772 1 NST}
- {-1617487200 1172 0 AMT}
- {-1601157600 4772 1 NST}
- {-1586037600 1172 0 AMT}
- {-1569708000 4772 1 NST}
- {-1554588000 1172 0 AMT}
- {-1538258400 4772 1 NST}
- {-1523138400 1172 0 AMT}
- {-1507500000 4772 1 NST}
- {-1490565600 1172 0 AMT}
- {-1470175200 4772 1 NST}
- {-1459116000 1172 0 AMT}
- {-1443996000 4772 1 NST}
- {-1427666400 1172 0 AMT}
- {-1406671200 4772 1 NST}
- {-1396216800 1172 0 AMT}
- {-1376949600 4772 1 NST}
- {-1364767200 1172 0 AMT}
- {-1345413600 4772 1 NST}
- {-1333317600 1172 0 AMT}
- {-1313791200 4772 1 NST}
- {-1301263200 1172 0 AMT}
- {-1282255200 4772 1 NST}
- {-1269813600 1172 0 AMT}
- {-1250719200 4772 1 NST}
- {-1238364000 1172 0 AMT}
- {-1219183200 4772 1 NST}
- {-1206914400 1172 0 AMT}
- {-1186956000 4772 1 NST}
- {-1175464800 1172 0 AMT}
- {-1156024800 4772 1 NST}
- {-1143410400 1172 0 AMT}
- {-1124488800 4772 1 NST}
- {-1111960800 1172 0 AMT}
- {-1092952800 4772 1 NST}
- {-1080511200 1172 0 AMT}
- {-1061330400 4772 1 NST}
- {-1049061600 1172 0 AMT}
- {-1029189600 4772 1 NST}
+ {-1663453172 4772 1 NST}
+ {-1650147572 1172 0 AMT}
+ {-1633213172 4772 1 NST}
+ {-1617488372 1172 0 AMT}
+ {-1601158772 4772 1 NST}
+ {-1586038772 1172 0 AMT}
+ {-1569709172 4772 1 NST}
+ {-1554589172 1172 0 AMT}
+ {-1538259572 4772 1 NST}
+ {-1523139572 1172 0 AMT}
+ {-1507501172 4772 1 NST}
+ {-1490566772 1172 0 AMT}
+ {-1470176372 4772 1 NST}
+ {-1459117172 1172 0 AMT}
+ {-1443997172 4772 1 NST}
+ {-1427667572 1172 0 AMT}
+ {-1406672372 4772 1 NST}
+ {-1396217972 1172 0 AMT}
+ {-1376950772 4772 1 NST}
+ {-1364768372 1172 0 AMT}
+ {-1345414772 4772 1 NST}
+ {-1333318772 1172 0 AMT}
+ {-1313792372 4772 1 NST}
+ {-1301264372 1172 0 AMT}
+ {-1282256372 4772 1 NST}
+ {-1269814772 1172 0 AMT}
+ {-1250720372 4772 1 NST}
+ {-1238365172 1172 0 AMT}
+ {-1219184372 4772 1 NST}
+ {-1206915572 1172 0 AMT}
+ {-1186957172 4772 1 NST}
+ {-1175465972 1172 0 AMT}
+ {-1156025972 4772 1 NST}
+ {-1143411572 1172 0 AMT}
+ {-1124489972 4772 1 NST}
+ {-1111961972 1172 0 AMT}
+ {-1092953972 4772 1 NST}
+ {-1080512372 1172 0 AMT}
+ {-1061331572 4772 1 NST}
+ {-1049062772 1172 0 AMT}
+ {-1029190772 4772 1 NST}
{-1025741972 4800 0 NEST}
- {-1017612000 1200 0 NET}
- {-998258400 4800 1 NEST}
- {-986162400 1200 0 NET}
- {-966722400 4800 1 NEST}
- {-954108000 1200 0 NET}
+ {-1017613200 1200 0 NET}
+ {-998259600 4800 1 NEST}
+ {-986163600 1200 0 NET}
+ {-966723600 4800 1 NEST}
+ {-954109200 1200 0 NET}
{-935022000 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781052400 3600 0 CEAMTT}
- {-781048800 7200 1 CEST}
- {-766620000 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 0 CEST}
+ {-766623600 3600 0 CET}
{220921200 3600 0 CET}
{228877200 7200 1 CEST}
{243997200 3600 0 CET}
diff --git a/library/tzdata/Europe/Andorra b/library/tzdata/Europe/Andorra
index 2a2f74c..89233fe 100644
--- a/library/tzdata/Europe/Andorra
+++ b/library/tzdata/Europe/Andorra
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Andorra) {
{-9223372036854775808 364 0 LMT}
diff --git a/library/tzdata/Europe/Athens b/library/tzdata/Europe/Athens
index 50a621b..f8df408 100644
--- a/library/tzdata/Europe/Athens
+++ b/library/tzdata/Europe/Athens
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Athens) {
{-9223372036854775808 5692 0 LMT}
@@ -14,13 +14,13 @@ set TZData(:Europe/Athens) {
{-812422800 7200 0 EET}
{-552362400 10800 1 EEST}
{-541652400 7200 0 EET}
- {166492800 10800 1 EEST}
- {186192000 7200 0 EET}
- {198036000 10800 1 EEST}
- {213760800 7200 0 EET}
- {228880800 10800 1 EEST}
- {244087200 7200 0 EET}
- {260330400 10800 1 EEST}
+ {166485600 10800 1 EEST}
+ {186184800 7200 0 EET}
+ {198028800 10800 1 EEST}
+ {213753600 7200 0 EET}
+ {228873600 10800 1 EEST}
+ {244080000 7200 0 EET}
+ {260323200 10800 1 EEST}
{275446800 7200 0 EET}
{291798000 10800 1 EEST}
{307407600 7200 0 EET}
diff --git a/library/tzdata/Europe/Belfast b/library/tzdata/Europe/Belfast
index a23f43f..51cd3ce 100644
--- a/library/tzdata/Europe/Belfast
+++ b/library/tzdata/Europe/Belfast
@@ -1,372 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Europe/Belfast) {
- {-9223372036854775808 -1420 0 LMT}
- {-2821649780 -1521 0 DMT}
- {-1691962479 2079 1 IST}
- {-1680472800 0 0 GMT}
- {-1664143200 3600 1 BST}
- {-1650146400 0 0 GMT}
- {-1633903200 3600 1 BST}
- {-1617487200 0 0 GMT}
- {-1601848800 3600 1 BST}
- {-1586037600 0 0 GMT}
- {-1570399200 3600 1 BST}
- {-1552168800 0 0 GMT}
- {-1538344800 3600 1 BST}
- {-1522533600 0 0 GMT}
- {-1507500000 3600 1 BST}
- {-1490565600 0 0 GMT}
- {-1473631200 3600 1 BST}
- {-1460930400 0 0 GMT}
- {-1442786400 3600 1 BST}
- {-1428876000 0 0 GMT}
- {-1410732000 3600 1 BST}
- {-1396216800 0 0 GMT}
- {-1379282400 3600 1 BST}
- {-1364767200 0 0 GMT}
- {-1348437600 3600 1 BST}
- {-1333317600 0 0 GMT}
- {-1315778400 3600 1 BST}
- {-1301263200 0 0 GMT}
- {-1284328800 3600 1 BST}
- {-1269813600 0 0 GMT}
- {-1253484000 3600 1 BST}
- {-1238364000 0 0 GMT}
- {-1221429600 3600 1 BST}
- {-1206914400 0 0 GMT}
- {-1189980000 3600 1 BST}
- {-1175464800 0 0 GMT}
- {-1159135200 3600 1 BST}
- {-1143410400 0 0 GMT}
- {-1126476000 3600 1 BST}
- {-1111960800 0 0 GMT}
- {-1095631200 3600 1 BST}
- {-1080511200 0 0 GMT}
- {-1063576800 3600 1 BST}
- {-1049061600 0 0 GMT}
- {-1032127200 3600 1 BST}
- {-1017612000 0 0 GMT}
- {-1001282400 3600 1 BST}
- {-986162400 0 0 GMT}
- {-969228000 3600 1 BST}
- {-950479200 0 0 GMT}
- {-942012000 3600 1 BST}
- {-904518000 7200 1 BDST}
- {-896050800 3600 1 BST}
- {-875487600 7200 1 BDST}
- {-864601200 3600 1 BST}
- {-844038000 7200 1 BDST}
- {-832546800 3600 1 BST}
- {-812588400 7200 1 BDST}
- {-798073200 3600 1 BST}
- {-781052400 7200 1 BDST}
- {-772066800 3600 1 BST}
- {-764805600 0 0 GMT}
- {-748476000 3600 1 BST}
- {-733356000 0 0 GMT}
- {-719445600 3600 1 BST}
- {-717030000 7200 1 BDST}
- {-706748400 3600 1 BST}
- {-699487200 0 0 GMT}
- {-687996000 3600 1 BST}
- {-668037600 0 0 GMT}
- {-654732000 3600 1 BST}
- {-636588000 0 0 GMT}
- {-622072800 3600 1 BST}
- {-605743200 0 0 GMT}
- {-590623200 3600 1 BST}
- {-574293600 0 0 GMT}
- {-558568800 3600 1 BST}
- {-542239200 0 0 GMT}
- {-527119200 3600 1 BST}
- {-512604000 0 0 GMT}
- {-496274400 3600 1 BST}
- {-481154400 0 0 GMT}
- {-464220000 3600 1 BST}
- {-449704800 0 0 GMT}
- {-432165600 3600 1 BST}
- {-417650400 0 0 GMT}
- {-401320800 3600 1 BST}
- {-386200800 0 0 GMT}
- {-369266400 3600 1 BST}
- {-354751200 0 0 GMT}
- {-337816800 3600 1 BST}
- {-323301600 0 0 GMT}
- {-306972000 3600 1 BST}
- {-291852000 0 0 GMT}
- {-276732000 3600 1 BST}
- {-257983200 0 0 GMT}
- {-245282400 3600 1 BST}
- {-226533600 0 0 GMT}
- {-213228000 3600 1 BST}
- {-195084000 0 0 GMT}
- {-182383200 3600 1 BST}
- {-163634400 0 0 GMT}
- {-150933600 3600 1 BST}
- {-132184800 0 0 GMT}
- {-119484000 3600 1 BST}
- {-100735200 0 0 GMT}
- {-88034400 3600 1 BST}
- {-68680800 0 0 GMT}
- {-59004000 3600 1 BST}
- {-37238400 3600 0 BST}
- {57722400 0 0 GMT}
- {69818400 3600 1 BST}
- {89172000 0 0 GMT}
- {101268000 3600 1 BST}
- {120621600 0 0 GMT}
- {132717600 3600 1 BST}
- {152071200 0 0 GMT}
- {164167200 3600 1 BST}
- {183520800 0 0 GMT}
- {196221600 3600 1 BST}
- {214970400 0 0 GMT}
- {227671200 3600 1 BST}
- {246420000 0 0 GMT}
- {259120800 3600 1 BST}
- {278474400 0 0 GMT}
- {290570400 3600 1 BST}
- {309924000 0 0 GMT}
- {322020000 3600 1 BST}
- {341373600 0 0 GMT}
- {354675600 3600 1 BST}
- {372819600 0 0 GMT}
- {386125200 3600 1 BST}
- {404269200 0 0 GMT}
- {417574800 3600 1 BST}
- {435718800 0 0 GMT}
- {449024400 3600 1 BST}
- {467773200 0 0 GMT}
- {481078800 3600 1 BST}
- {499222800 0 0 GMT}
- {512528400 3600 1 BST}
- {530672400 0 0 GMT}
- {543978000 3600 1 BST}
- {562122000 0 0 GMT}
- {575427600 3600 1 BST}
- {593571600 0 0 GMT}
- {606877200 3600 1 BST}
- {625626000 0 0 GMT}
- {638326800 3600 1 BST}
- {657075600 0 0 GMT}
- {670381200 3600 1 BST}
- {688525200 0 0 GMT}
- {701830800 3600 1 BST}
- {719974800 0 0 GMT}
- {733280400 3600 1 BST}
- {751424400 0 0 GMT}
- {764730000 3600 1 BST}
- {782874000 0 0 GMT}
- {796179600 3600 1 BST}
- {814323600 0 0 GMT}
- {820454400 0 0 GMT}
- {828234000 3600 1 BST}
- {846378000 0 0 GMT}
- {859683600 3600 1 BST}
- {877827600 0 0 GMT}
- {891133200 3600 1 BST}
- {909277200 0 0 GMT}
- {922582800 3600 1 BST}
- {941331600 0 0 GMT}
- {954032400 3600 1 BST}
- {972781200 0 0 GMT}
- {985482000 3600 1 BST}
- {1004230800 0 0 GMT}
- {1017536400 3600 1 BST}
- {1035680400 0 0 GMT}
- {1048986000 3600 1 BST}
- {1067130000 0 0 GMT}
- {1080435600 3600 1 BST}
- {1099184400 0 0 GMT}
- {1111885200 3600 1 BST}
- {1130634000 0 0 GMT}
- {1143334800 3600 1 BST}
- {1162083600 0 0 GMT}
- {1174784400 3600 1 BST}
- {1193533200 0 0 GMT}
- {1206838800 3600 1 BST}
- {1224982800 0 0 GMT}
- {1238288400 3600 1 BST}
- {1256432400 0 0 GMT}
- {1269738000 3600 1 BST}
- {1288486800 0 0 GMT}
- {1301187600 3600 1 BST}
- {1319936400 0 0 GMT}
- {1332637200 3600 1 BST}
- {1351386000 0 0 GMT}
- {1364691600 3600 1 BST}
- {1382835600 0 0 GMT}
- {1396141200 3600 1 BST}
- {1414285200 0 0 GMT}
- {1427590800 3600 1 BST}
- {1445734800 0 0 GMT}
- {1459040400 3600 1 BST}
- {1477789200 0 0 GMT}
- {1490490000 3600 1 BST}
- {1509238800 0 0 GMT}
- {1521939600 3600 1 BST}
- {1540688400 0 0 GMT}
- {1553994000 3600 1 BST}
- {1572138000 0 0 GMT}
- {1585443600 3600 1 BST}
- {1603587600 0 0 GMT}
- {1616893200 3600 1 BST}
- {1635642000 0 0 GMT}
- {1648342800 3600 1 BST}
- {1667091600 0 0 GMT}
- {1679792400 3600 1 BST}
- {1698541200 0 0 GMT}
- {1711846800 3600 1 BST}
- {1729990800 0 0 GMT}
- {1743296400 3600 1 BST}
- {1761440400 0 0 GMT}
- {1774746000 3600 1 BST}
- {1792890000 0 0 GMT}
- {1806195600 3600 1 BST}
- {1824944400 0 0 GMT}
- {1837645200 3600 1 BST}
- {1856394000 0 0 GMT}
- {1869094800 3600 1 BST}
- {1887843600 0 0 GMT}
- {1901149200 3600 1 BST}
- {1919293200 0 0 GMT}
- {1932598800 3600 1 BST}
- {1950742800 0 0 GMT}
- {1964048400 3600 1 BST}
- {1982797200 0 0 GMT}
- {1995498000 3600 1 BST}
- {2014246800 0 0 GMT}
- {2026947600 3600 1 BST}
- {2045696400 0 0 GMT}
- {2058397200 3600 1 BST}
- {2077146000 0 0 GMT}
- {2090451600 3600 1 BST}
- {2108595600 0 0 GMT}
- {2121901200 3600 1 BST}
- {2140045200 0 0 GMT}
- {2153350800 3600 1 BST}
- {2172099600 0 0 GMT}
- {2184800400 3600 1 BST}
- {2203549200 0 0 GMT}
- {2216250000 3600 1 BST}
- {2234998800 0 0 GMT}
- {2248304400 3600 1 BST}
- {2266448400 0 0 GMT}
- {2279754000 3600 1 BST}
- {2297898000 0 0 GMT}
- {2311203600 3600 1 BST}
- {2329347600 0 0 GMT}
- {2342653200 3600 1 BST}
- {2361402000 0 0 GMT}
- {2374102800 3600 1 BST}
- {2392851600 0 0 GMT}
- {2405552400 3600 1 BST}
- {2424301200 0 0 GMT}
- {2437606800 3600 1 BST}
- {2455750800 0 0 GMT}
- {2469056400 3600 1 BST}
- {2487200400 0 0 GMT}
- {2500506000 3600 1 BST}
- {2519254800 0 0 GMT}
- {2531955600 3600 1 BST}
- {2550704400 0 0 GMT}
- {2563405200 3600 1 BST}
- {2582154000 0 0 GMT}
- {2595459600 3600 1 BST}
- {2613603600 0 0 GMT}
- {2626909200 3600 1 BST}
- {2645053200 0 0 GMT}
- {2658358800 3600 1 BST}
- {2676502800 0 0 GMT}
- {2689808400 3600 1 BST}
- {2708557200 0 0 GMT}
- {2721258000 3600 1 BST}
- {2740006800 0 0 GMT}
- {2752707600 3600 1 BST}
- {2771456400 0 0 GMT}
- {2784762000 3600 1 BST}
- {2802906000 0 0 GMT}
- {2816211600 3600 1 BST}
- {2834355600 0 0 GMT}
- {2847661200 3600 1 BST}
- {2866410000 0 0 GMT}
- {2879110800 3600 1 BST}
- {2897859600 0 0 GMT}
- {2910560400 3600 1 BST}
- {2929309200 0 0 GMT}
- {2942010000 3600 1 BST}
- {2960758800 0 0 GMT}
- {2974064400 3600 1 BST}
- {2992208400 0 0 GMT}
- {3005514000 3600 1 BST}
- {3023658000 0 0 GMT}
- {3036963600 3600 1 BST}
- {3055712400 0 0 GMT}
- {3068413200 3600 1 BST}
- {3087162000 0 0 GMT}
- {3099862800 3600 1 BST}
- {3118611600 0 0 GMT}
- {3131917200 3600 1 BST}
- {3150061200 0 0 GMT}
- {3163366800 3600 1 BST}
- {3181510800 0 0 GMT}
- {3194816400 3600 1 BST}
- {3212960400 0 0 GMT}
- {3226266000 3600 1 BST}
- {3245014800 0 0 GMT}
- {3257715600 3600 1 BST}
- {3276464400 0 0 GMT}
- {3289165200 3600 1 BST}
- {3307914000 0 0 GMT}
- {3321219600 3600 1 BST}
- {3339363600 0 0 GMT}
- {3352669200 3600 1 BST}
- {3370813200 0 0 GMT}
- {3384118800 3600 1 BST}
- {3402867600 0 0 GMT}
- {3415568400 3600 1 BST}
- {3434317200 0 0 GMT}
- {3447018000 3600 1 BST}
- {3465766800 0 0 GMT}
- {3479072400 3600 1 BST}
- {3497216400 0 0 GMT}
- {3510522000 3600 1 BST}
- {3528666000 0 0 GMT}
- {3541971600 3600 1 BST}
- {3560115600 0 0 GMT}
- {3573421200 3600 1 BST}
- {3592170000 0 0 GMT}
- {3604870800 3600 1 BST}
- {3623619600 0 0 GMT}
- {3636320400 3600 1 BST}
- {3655069200 0 0 GMT}
- {3668374800 3600 1 BST}
- {3686518800 0 0 GMT}
- {3699824400 3600 1 BST}
- {3717968400 0 0 GMT}
- {3731274000 3600 1 BST}
- {3750022800 0 0 GMT}
- {3762723600 3600 1 BST}
- {3781472400 0 0 GMT}
- {3794173200 3600 1 BST}
- {3812922000 0 0 GMT}
- {3825622800 3600 1 BST}
- {3844371600 0 0 GMT}
- {3857677200 3600 1 BST}
- {3875821200 0 0 GMT}
- {3889126800 3600 1 BST}
- {3907270800 0 0 GMT}
- {3920576400 3600 1 BST}
- {3939325200 0 0 GMT}
- {3952026000 3600 1 BST}
- {3970774800 0 0 GMT}
- {3983475600 3600 1 BST}
- {4002224400 0 0 GMT}
- {4015530000 3600 1 BST}
- {4033674000 0 0 GMT}
- {4046979600 3600 1 BST}
- {4065123600 0 0 GMT}
- {4078429200 3600 1 BST}
- {4096573200 0 0 GMT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/London)]} {
+ LoadTimeZoneFile Europe/London
}
+set TZData(:Europe/Belfast) $TZData(:Europe/London)
diff --git a/library/tzdata/Europe/Belgrade b/library/tzdata/Europe/Belgrade
index d990fd5..b11f7b3 100644
--- a/library/tzdata/Europe/Belgrade
+++ b/library/tzdata/Europe/Belgrade
@@ -1,16 +1,17 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Belgrade) {
{-9223372036854775808 4920 0 LMT}
{-2713915320 3600 0 CET}
{-905824800 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-777938400 7200 1 CEST}
- {-766620000 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-788922000 3600 0 CET}
+ {-777942000 7200 1 CEST}
+ {-766623600 3600 0 CET}
{407199600 3600 0 CET}
{417574800 7200 1 CEST}
{433299600 3600 0 CET}
diff --git a/library/tzdata/Europe/Berlin b/library/tzdata/Europe/Berlin
index 8768f7e..5469cf6 100644
--- a/library/tzdata/Europe/Berlin
+++ b/library/tzdata/Europe/Berlin
@@ -1,35 +1,35 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Berlin) {
{-9223372036854775808 3208 0 LMT}
{-2422054408 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
- {-938901600 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781052400 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-776563200 10800 1 CEMT}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
+ {-938905200 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 1 CEST}
+ {-776559600 10800 0 CEMT}
{-765936000 7200 1 CEST}
- {-761176800 3600 0 CET}
- {-748476000 7200 1 CEST}
- {-733269600 3600 0 CET}
+ {-761180400 3600 0 CET}
+ {-757386000 3600 0 CET}
+ {-748479600 7200 1 CEST}
+ {-733273200 3600 0 CET}
{-717631200 7200 1 CEST}
- {-714607200 10800 1 CEMT}
+ {-714610800 10800 1 CEMT}
{-710380800 7200 1 CEST}
- {-701906400 3600 0 CET}
- {-684972000 7200 1 CEST}
- {-670456800 3600 0 CET}
- {-654127200 7200 1 CEST}
- {-639007200 3600 0 CET}
+ {-701910000 3600 0 CET}
+ {-684975600 7200 1 CEST}
+ {-670460400 3600 0 CET}
+ {-654130800 7200 1 CEST}
+ {-639010800 3600 0 CET}
{315529200 3600 0 CET}
{323830800 7200 1 CEST}
{338950800 3600 0 CET}
diff --git a/library/tzdata/Europe/Bratislava b/library/tzdata/Europe/Bratislava
index 3c9754d..d65ea5a 100644
--- a/library/tzdata/Europe/Bratislava
+++ b/library/tzdata/Europe/Bratislava
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Prague)]} {
LoadTimeZoneFile Europe/Prague
}
diff --git a/library/tzdata/Europe/Brussels b/library/tzdata/Europe/Brussels
index d82ed03..3cb9b14 100644
--- a/library/tzdata/Europe/Brussels
+++ b/library/tzdata/Europe/Brussels
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Brussels) {
{-9223372036854775808 1050 0 LMT}
@@ -7,10 +7,10 @@ set TZData(:Europe/Brussels) {
{-1740355200 3600 0 CET}
{-1693702800 7200 0 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
{-1613826000 0 0 WET}
{-1604278800 3600 1 WEST}
{-1585530000 0 0 WET}
@@ -56,16 +56,16 @@ set TZData(:Europe/Brussels) {
{-950479200 0 0 WET}
{-942012000 3600 1 WEST}
{-934668000 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-799290000 3600 0 CET}
- {-798069600 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-766620000 3600 0 CET}
- {-745452000 7200 1 CEST}
- {-733269600 3600 0 CET}
+ {-798073200 3600 0 CET}
+ {-781052400 7200 1 CEST}
+ {-766623600 3600 0 CET}
+ {-745455600 7200 1 CEST}
+ {-733273200 3600 0 CET}
{220921200 3600 0 CET}
{228877200 7200 1 CEST}
{243997200 3600 0 CET}
diff --git a/library/tzdata/Europe/Bucharest b/library/tzdata/Europe/Bucharest
index 4ad1ffa..7b3bed4 100644
--- a/library/tzdata/Europe/Bucharest
+++ b/library/tzdata/Europe/Bucharest
@@ -1,56 +1,56 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Bucharest) {
{-9223372036854775808 6264 0 LMT}
{-2469404664 6264 0 BMT}
{-1213148664 7200 0 EET}
- {-1187049600 10800 1 EEST}
- {-1175472000 7200 0 EET}
- {-1159747200 10800 1 EEST}
- {-1144022400 7200 0 EET}
- {-1127692800 10800 1 EEST}
- {-1111968000 7200 0 EET}
- {-1096243200 10800 1 EEST}
- {-1080518400 7200 0 EET}
- {-1064793600 10800 1 EEST}
- {-1049068800 7200 0 EET}
- {-1033344000 10800 1 EEST}
- {-1017619200 7200 0 EET}
- {-1001894400 10800 1 EEST}
- {-986169600 7200 0 EET}
- {-970444800 10800 1 EEST}
- {-954720000 7200 0 EET}
+ {-1187056800 10800 1 EEST}
+ {-1175479200 7200 0 EET}
+ {-1159754400 10800 1 EEST}
+ {-1144029600 7200 0 EET}
+ {-1127700000 10800 1 EEST}
+ {-1111975200 7200 0 EET}
+ {-1096250400 10800 1 EEST}
+ {-1080525600 7200 0 EET}
+ {-1064800800 10800 1 EEST}
+ {-1049076000 7200 0 EET}
+ {-1033351200 10800 1 EEST}
+ {-1017626400 7200 0 EET}
+ {-1001901600 10800 1 EEST}
+ {-986176800 7200 0 EET}
+ {-970452000 10800 1 EEST}
+ {-954727200 7200 0 EET}
{296604000 10800 1 EEST}
{307486800 7200 0 EET}
{323816400 10800 1 EEST}
{338940000 7200 0 EET}
- {354679200 10800 0 EEST}
- {370404000 7200 0 EET}
- {386128800 10800 1 EEST}
- {401853600 7200 0 EET}
- {417578400 10800 1 EEST}
- {433303200 7200 0 EET}
- {449028000 10800 1 EEST}
- {465357600 7200 0 EET}
- {481082400 10800 1 EEST}
- {496807200 7200 0 EET}
- {512532000 10800 1 EEST}
- {528256800 7200 0 EET}
- {543981600 10800 1 EEST}
- {559706400 7200 0 EET}
- {575431200 10800 1 EEST}
- {591156000 7200 0 EET}
- {606880800 10800 1 EEST}
- {622605600 7200 0 EET}
- {638330400 10800 1 EEST}
- {654660000 7200 0 EET}
+ {354672000 10800 0 EEST}
+ {370396800 7200 0 EET}
+ {386121600 10800 1 EEST}
+ {401846400 7200 0 EET}
+ {417571200 10800 1 EEST}
+ {433296000 7200 0 EET}
+ {449020800 10800 1 EEST}
+ {465350400 7200 0 EET}
+ {481075200 10800 1 EEST}
+ {496800000 7200 0 EET}
+ {512524800 10800 1 EEST}
+ {528249600 7200 0 EET}
+ {543974400 10800 1 EEST}
+ {559699200 7200 0 EET}
+ {575424000 10800 1 EEST}
+ {591148800 7200 0 EET}
+ {606873600 10800 1 EEST}
+ {622598400 7200 0 EET}
+ {638323200 10800 1 EEST}
+ {654652800 7200 0 EET}
{662680800 7200 0 EET}
- {670377600 10800 1 EEST}
- {686102400 7200 0 EET}
- {701827200 10800 1 EEST}
- {717552000 7200 0 EET}
- {733276800 10800 1 EEST}
- {749001600 7200 0 EET}
+ {670370400 10800 1 EEST}
+ {686095200 7200 0 EET}
+ {701820000 10800 1 EEST}
+ {717544800 7200 0 EET}
+ {733269600 10800 1 EEST}
+ {748994400 7200 0 EET}
{757375200 7200 0 EET}
{764719200 10800 1 EEST}
{780440400 7200 0 EET}
diff --git a/library/tzdata/Europe/Budapest b/library/tzdata/Europe/Budapest
index a65d091..fd41acc 100644
--- a/library/tzdata/Europe/Budapest
+++ b/library/tzdata/Europe/Budapest
@@ -1,12 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Budapest) {
{-9223372036854775808 4580 0 LMT}
{-2500938980 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
{-1640998800 3600 0 CET}
{-1633212000 7200 1 CEST}
{-1617577200 3600 0 CET}
@@ -15,23 +15,24 @@ set TZData(:Europe/Budapest) {
{-1569708000 7200 1 CEST}
{-1554332400 3600 0 CET}
{-906937200 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-778471200 7200 0 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-788922000 3600 0 CET}
+ {-778471200 7200 1 CEST}
{-762487200 3600 0 CET}
- {-749685600 7200 1 CEST}
- {-733356000 3600 0 CET}
- {-717631200 7200 1 CEST}
- {-701906400 3600 0 CET}
- {-686181600 7200 1 CEST}
- {-670456800 3600 0 CET}
- {-654127200 7200 1 CEST}
- {-639007200 3600 0 CET}
- {-621986400 7200 1 CEST}
- {-605656800 3600 0 CET}
+ {-749689200 7200 1 CEST}
+ {-733359600 3600 0 CET}
+ {-717634800 7200 1 CEST}
+ {-701910000 3600 0 CET}
+ {-686185200 7200 1 CEST}
+ {-670460400 3600 0 CET}
+ {-654130800 7200 1 CEST}
+ {-639010800 3600 0 CET}
+ {-621990000 7200 1 CEST}
+ {-605660400 3600 0 CET}
{-492656400 7200 1 CEST}
{-481168800 3600 0 CET}
{-461120400 7200 1 CEST}
@@ -41,7 +42,7 @@ set TZData(:Europe/Budapest) {
{-397094400 7200 1 CEST}
{-386809200 3600 0 CET}
{323827200 7200 1 CEST}
- {338954400 3600 0 CET}
+ {338950800 3600 0 CET}
{354675600 7200 1 CEST}
{370400400 3600 0 CET}
{386125200 7200 1 CEST}
diff --git a/library/tzdata/Europe/Busingen b/library/tzdata/Europe/Busingen
new file mode 100644
index 0000000..62abc29
--- /dev/null
+++ b/library/tzdata/Europe/Busingen
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/Zurich)]} {
+ LoadTimeZoneFile Europe/Zurich
+}
+set TZData(:Europe/Busingen) $TZData(:Europe/Zurich)
diff --git a/library/tzdata/Europe/Chisinau b/library/tzdata/Europe/Chisinau
index 95ebcba..4ef466b 100644
--- a/library/tzdata/Europe/Chisinau
+++ b/library/tzdata/Europe/Chisinau
@@ -1,32 +1,32 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Chisinau) {
{-9223372036854775808 6920 0 LMT}
{-2840147720 6900 0 CMT}
{-1637114100 6264 0 BMT}
{-1213148664 7200 0 EET}
- {-1187049600 10800 1 EEST}
- {-1175472000 7200 0 EET}
- {-1159747200 10800 1 EEST}
- {-1144022400 7200 0 EET}
- {-1127692800 10800 1 EEST}
- {-1111968000 7200 0 EET}
- {-1096243200 10800 1 EEST}
- {-1080518400 7200 0 EET}
- {-1064793600 10800 1 EEST}
- {-1049068800 7200 0 EET}
- {-1033344000 10800 1 EEST}
- {-1017619200 7200 0 EET}
- {-1001894400 10800 1 EEST}
- {-986169600 7200 0 EET}
- {-970444800 10800 1 EEST}
- {-954720000 7200 0 EET}
+ {-1187056800 10800 1 EEST}
+ {-1175479200 7200 0 EET}
+ {-1159754400 10800 1 EEST}
+ {-1144029600 7200 0 EET}
+ {-1127700000 10800 1 EEST}
+ {-1111975200 7200 0 EET}
+ {-1096250400 10800 1 EEST}
+ {-1080525600 7200 0 EET}
+ {-1064800800 10800 1 EEST}
+ {-1049076000 7200 0 EET}
+ {-1033351200 10800 1 EEST}
+ {-1017626400 7200 0 EET}
+ {-1001901600 10800 1 EEST}
+ {-986176800 7200 0 EET}
+ {-970452000 10800 1 EEST}
+ {-954727200 7200 0 EET}
{-927165600 10800 1 EEST}
{-898138800 7200 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-800154000 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -35,22 +35,22 @@ set TZData(:Europe/Chisinau) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
{631141200 10800 0 MSK}
{641941200 7200 0 EET}
{662680800 7200 0 EEMMTT}
- {670384800 10800 1 EEST}
- {686109600 7200 0 EET}
+ {670377600 10800 1 EEST}
+ {686102400 7200 0 EET}
{694216800 7200 0 EET}
{701820000 10800 1 EEST}
{717541200 7200 0 EET}
diff --git a/library/tzdata/Europe/Copenhagen b/library/tzdata/Europe/Copenhagen
index deb57e0..c747e58 100644
--- a/library/tzdata/Europe/Copenhagen
+++ b/library/tzdata/Europe/Copenhagen
@@ -1,26 +1,25 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Copenhagen) {
{-9223372036854775808 3020 0 LMT}
{-2524524620 3020 0 CMT}
- {-2390518220 3600 0 CET}
+ {-2398294220 3600 0 CET}
{-1692496800 7200 1 CEST}
{-1680490800 3600 0 CET}
{-935110800 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781052400 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-769384800 3600 0 CET}
- {-747007200 7200 1 CEST}
- {-736380000 3600 0 CET}
- {-715212000 7200 1 CEST}
- {-706744800 3600 0 CET}
- {-683157600 7200 1 CEST}
- {-675295200 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 0 CEST}
+ {-769388400 3600 0 CET}
+ {-747010800 7200 1 CEST}
+ {-736383600 3600 0 CET}
+ {-715215600 7200 1 CEST}
+ {-706748400 3600 0 CET}
+ {-683161200 7200 1 CEST}
+ {-675298800 3600 0 CET}
{315529200 3600 0 CET}
{323830800 7200 1 CEST}
{338950800 3600 0 CET}
diff --git a/library/tzdata/Europe/Dublin b/library/tzdata/Europe/Dublin
index 4359026..4b43bc0 100644
--- a/library/tzdata/Europe/Dublin
+++ b/library/tzdata/Europe/Dublin
@@ -1,10 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Dublin) {
{-9223372036854775808 -1500 0 LMT}
{-2821649700 -1521 0 DMT}
{-1691962479 2079 1 IST}
- {-1680472800 0 0 GMT}
+ {-1680471279 0 0 GMT}
{-1664143200 3600 1 BST}
{-1650146400 0 0 GMT}
{-1633903200 3600 1 BST}
diff --git a/library/tzdata/Europe/Gibraltar b/library/tzdata/Europe/Gibraltar
index cb66a38..de29c03 100644
--- a/library/tzdata/Europe/Gibraltar
+++ b/library/tzdata/Europe/Gibraltar
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Gibraltar) {
{-9223372036854775808 -1284 0 LMT}
diff --git a/library/tzdata/Europe/Guernsey b/library/tzdata/Europe/Guernsey
new file mode 100644
index 0000000..4372c64
--- /dev/null
+++ b/library/tzdata/Europe/Guernsey
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/London)]} {
+ LoadTimeZoneFile Europe/London
+}
+set TZData(:Europe/Guernsey) $TZData(:Europe/London)
diff --git a/library/tzdata/Europe/Helsinki b/library/tzdata/Europe/Helsinki
index 292e468..3abf790 100644
--- a/library/tzdata/Europe/Helsinki
+++ b/library/tzdata/Europe/Helsinki
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Helsinki) {
{-9223372036854775808 5992 0 LMT}
@@ -6,11 +6,11 @@ set TZData(:Europe/Helsinki) {
{-1535938792 7200 0 EET}
{-875671200 10800 1 EEST}
{-859863600 7200 0 EET}
- {354672000 7200 0 EET}
- {354675600 10800 1 EEST}
- {370400400 7200 0 EET}
- {386125200 10800 1 EEST}
- {401850000 7200 0 EET}
+ {354672000 10800 1 EEST}
+ {370396800 7200 0 EET}
+ {386121600 10800 1 EEST}
+ {401846400 7200 0 EET}
+ {410220000 7200 0 EET}
{417574800 10800 1 EEST}
{433299600 7200 0 EET}
{449024400 10800 1 EEST}
diff --git a/library/tzdata/Europe/Isle_of_Man b/library/tzdata/Europe/Isle_of_Man
new file mode 100644
index 0000000..870ac45
--- /dev/null
+++ b/library/tzdata/Europe/Isle_of_Man
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/London)]} {
+ LoadTimeZoneFile Europe/London
+}
+set TZData(:Europe/Isle_of_Man) $TZData(:Europe/London)
diff --git a/library/tzdata/Europe/Istanbul b/library/tzdata/Europe/Istanbul
index 8151ee0..7737d75 100644
--- a/library/tzdata/Europe/Istanbul
+++ b/library/tzdata/Europe/Istanbul
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Istanbul) {
{-9223372036854775808 6952 0 LMT}
@@ -71,50 +71,49 @@ set TZData(:Europe/Istanbul) {
{482792400 7200 0 EET}
{482796000 10800 1 EEST}
{496702800 7200 0 EET}
- {504914400 7200 0 EET}
- {512532000 10800 1 EEST}
- {528256800 7200 0 EET}
- {543981600 10800 1 EEST}
- {559706400 7200 0 EET}
- {575431200 10800 1 EEST}
- {591156000 7200 0 EET}
- {606880800 10800 1 EEST}
- {622605600 7200 0 EET}
- {638330400 10800 1 EEST}
- {654660000 7200 0 EET}
- {662680800 7200 0 EET}
- {670381200 10800 1 EEST}
- {686106000 7200 0 EET}
- {701830800 10800 1 EEST}
- {717555600 7200 0 EET}
- {733280400 10800 1 EEST}
- {749005200 7200 0 EET}
- {764730000 10800 1 EEST}
- {780454800 7200 0 EET}
- {796179600 10800 1 EEST}
- {811904400 7200 0 EET}
- {828234000 10800 1 EEST}
- {846378000 7200 0 EET}
- {859683600 10800 1 EEST}
- {877827600 7200 0 EET}
- {891133200 10800 1 EEST}
- {909277200 7200 0 EET}
- {922582800 10800 1 EEST}
- {941331600 7200 0 EET}
- {954032400 10800 1 EEST}
- {972781200 7200 0 EET}
- {985482000 10800 1 EEST}
- {1004230800 7200 0 EET}
- {1017536400 10800 1 EEST}
- {1035680400 7200 0 EET}
- {1048986000 10800 1 EEST}
- {1067130000 7200 0 EET}
- {1080435600 10800 1 EEST}
- {1099184400 7200 0 EET}
- {1111885200 10800 1 EEST}
- {1130634000 7200 0 EET}
- {1143334800 10800 1 EEST}
- {1162083600 7200 0 EET}
+ {512524800 10800 1 EEST}
+ {528249600 7200 0 EET}
+ {543974400 10800 1 EEST}
+ {559699200 7200 0 EET}
+ {575424000 10800 1 EEST}
+ {591148800 7200 0 EET}
+ {606873600 10800 1 EEST}
+ {622598400 7200 0 EET}
+ {638323200 10800 1 EEST}
+ {654652800 7200 0 EET}
+ {670374000 10800 1 EEST}
+ {686098800 7200 0 EET}
+ {701823600 10800 1 EEST}
+ {717548400 7200 0 EET}
+ {733273200 10800 1 EEST}
+ {748998000 7200 0 EET}
+ {764722800 10800 1 EEST}
+ {780447600 7200 0 EET}
+ {796172400 10800 1 EEST}
+ {811897200 7200 0 EET}
+ {828226800 10800 1 EEST}
+ {846370800 7200 0 EET}
+ {859676400 10800 1 EEST}
+ {877820400 7200 0 EET}
+ {891126000 10800 1 EEST}
+ {909270000 7200 0 EET}
+ {922575600 10800 1 EEST}
+ {941324400 7200 0 EET}
+ {954025200 10800 1 EEST}
+ {972774000 7200 0 EET}
+ {985474800 10800 1 EEST}
+ {1004223600 7200 0 EET}
+ {1017529200 10800 1 EEST}
+ {1035673200 7200 0 EET}
+ {1048978800 10800 1 EEST}
+ {1067122800 7200 0 EET}
+ {1080428400 10800 1 EEST}
+ {1099177200 7200 0 EET}
+ {1111878000 10800 1 EEST}
+ {1130626800 7200 0 EET}
+ {1143327600 10800 1 EEST}
+ {1162076400 7200 0 EET}
+ {1167602400 7200 0 EET}
{1174784400 10800 1 EEST}
{1193533200 7200 0 EET}
{1206838800 10800 1 EEST}
@@ -123,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/Jersey b/library/tzdata/Europe/Jersey
new file mode 100644
index 0000000..e4da512
--- /dev/null
+++ b/library/tzdata/Europe/Jersey
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/London)]} {
+ LoadTimeZoneFile Europe/London
+}
+set TZData(:Europe/Jersey) $TZData(:Europe/London)
diff --git a/library/tzdata/Europe/Kaliningrad b/library/tzdata/Europe/Kaliningrad
index 650c526..d5be459 100644
--- a/library/tzdata/Europe/Kaliningrad
+++ b/library/tzdata/Europe/Kaliningrad
@@ -1,20 +1,20 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Kaliningrad) {
{-9223372036854775808 4920 0 LMT}
{-2422056120 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
- {-938901600 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
+ {-938905200 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
{-788922000 7200 0 CET}
{-778730400 10800 1 CEST}
{-762663600 7200 0 CET}
@@ -26,235 +26,59 @@ set TZData(:Europe/Kaliningrad) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
- {638330400 14400 1 MSD}
- {654660000 10800 0 MSK}
- {670384800 10800 0 EEST}
- {686109600 7200 0 EET}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
+ {638319600 14400 1 MSD}
+ {654649200 10800 0 MSK}
+ {670374000 7200 0 EEMMTT}
+ {670377600 10800 1 EEST}
+ {686102400 7200 0 EET}
{701816400 10800 1 EEST}
{717537600 7200 0 EET}
- {733284000 10800 1 EEST}
- {749008800 7200 0 EET}
- {764733600 10800 1 EEST}
- {780458400 7200 0 EET}
- {796183200 10800 1 EEST}
- {811908000 7200 0 EET}
- {828237600 10800 1 EEST}
- {846381600 7200 0 EET}
- {859687200 10800 1 EEST}
- {877831200 7200 0 EET}
- {891136800 10800 1 EEST}
- {909280800 7200 0 EET}
- {922586400 10800 1 EEST}
- {941335200 7200 0 EET}
- {954036000 10800 1 EEST}
- {972784800 7200 0 EET}
- {985485600 10800 1 EEST}
- {1004234400 7200 0 EET}
- {1017540000 10800 1 EEST}
- {1035684000 7200 0 EET}
- {1048989600 10800 1 EEST}
- {1067133600 7200 0 EET}
- {1080439200 10800 1 EEST}
- {1099188000 7200 0 EET}
- {1111888800 10800 1 EEST}
- {1130637600 7200 0 EET}
- {1143338400 10800 1 EEST}
- {1162087200 7200 0 EET}
- {1174788000 10800 1 EEST}
- {1193536800 7200 0 EET}
- {1206842400 10800 1 EEST}
- {1224986400 7200 0 EET}
- {1238292000 10800 1 EEST}
- {1256436000 7200 0 EET}
- {1269741600 10800 1 EEST}
- {1288490400 7200 0 EET}
- {1301191200 10800 1 EEST}
- {1319940000 7200 0 EET}
- {1332640800 10800 1 EEST}
- {1351389600 7200 0 EET}
- {1364695200 10800 1 EEST}
- {1382839200 7200 0 EET}
- {1396144800 10800 1 EEST}
- {1414288800 7200 0 EET}
- {1427594400 10800 1 EEST}
- {1445738400 7200 0 EET}
- {1459044000 10800 1 EEST}
- {1477792800 7200 0 EET}
- {1490493600 10800 1 EEST}
- {1509242400 7200 0 EET}
- {1521943200 10800 1 EEST}
- {1540692000 7200 0 EET}
- {1553997600 10800 1 EEST}
- {1572141600 7200 0 EET}
- {1585447200 10800 1 EEST}
- {1603591200 7200 0 EET}
- {1616896800 10800 1 EEST}
- {1635645600 7200 0 EET}
- {1648346400 10800 1 EEST}
- {1667095200 7200 0 EET}
- {1679796000 10800 1 EEST}
- {1698544800 7200 0 EET}
- {1711850400 10800 1 EEST}
- {1729994400 7200 0 EET}
- {1743300000 10800 1 EEST}
- {1761444000 7200 0 EET}
- {1774749600 10800 1 EEST}
- {1792893600 7200 0 EET}
- {1806199200 10800 1 EEST}
- {1824948000 7200 0 EET}
- {1837648800 10800 1 EEST}
- {1856397600 7200 0 EET}
- {1869098400 10800 1 EEST}
- {1887847200 7200 0 EET}
- {1901152800 10800 1 EEST}
- {1919296800 7200 0 EET}
- {1932602400 10800 1 EEST}
- {1950746400 7200 0 EET}
- {1964052000 10800 1 EEST}
- {1982800800 7200 0 EET}
- {1995501600 10800 1 EEST}
- {2014250400 7200 0 EET}
- {2026951200 10800 1 EEST}
- {2045700000 7200 0 EET}
- {2058400800 10800 1 EEST}
- {2077149600 7200 0 EET}
- {2090455200 10800 1 EEST}
- {2108599200 7200 0 EET}
- {2121904800 10800 1 EEST}
- {2140048800 7200 0 EET}
- {2153354400 10800 1 EEST}
- {2172103200 7200 0 EET}
- {2184804000 10800 1 EEST}
- {2203552800 7200 0 EET}
- {2216253600 10800 1 EEST}
- {2235002400 7200 0 EET}
- {2248308000 10800 1 EEST}
- {2266452000 7200 0 EET}
- {2279757600 10800 1 EEST}
- {2297901600 7200 0 EET}
- {2311207200 10800 1 EEST}
- {2329351200 7200 0 EET}
- {2342656800 10800 1 EEST}
- {2361405600 7200 0 EET}
- {2374106400 10800 1 EEST}
- {2392855200 7200 0 EET}
- {2405556000 10800 1 EEST}
- {2424304800 7200 0 EET}
- {2437610400 10800 1 EEST}
- {2455754400 7200 0 EET}
- {2469060000 10800 1 EEST}
- {2487204000 7200 0 EET}
- {2500509600 10800 1 EEST}
- {2519258400 7200 0 EET}
- {2531959200 10800 1 EEST}
- {2550708000 7200 0 EET}
- {2563408800 10800 1 EEST}
- {2582157600 7200 0 EET}
- {2595463200 10800 1 EEST}
- {2613607200 7200 0 EET}
- {2626912800 10800 1 EEST}
- {2645056800 7200 0 EET}
- {2658362400 10800 1 EEST}
- {2676506400 7200 0 EET}
- {2689812000 10800 1 EEST}
- {2708560800 7200 0 EET}
- {2721261600 10800 1 EEST}
- {2740010400 7200 0 EET}
- {2752711200 10800 1 EEST}
- {2771460000 7200 0 EET}
- {2784765600 10800 1 EEST}
- {2802909600 7200 0 EET}
- {2816215200 10800 1 EEST}
- {2834359200 7200 0 EET}
- {2847664800 10800 1 EEST}
- {2866413600 7200 0 EET}
- {2879114400 10800 1 EEST}
- {2897863200 7200 0 EET}
- {2910564000 10800 1 EEST}
- {2929312800 7200 0 EET}
- {2942013600 10800 1 EEST}
- {2960762400 7200 0 EET}
- {2974068000 10800 1 EEST}
- {2992212000 7200 0 EET}
- {3005517600 10800 1 EEST}
- {3023661600 7200 0 EET}
- {3036967200 10800 1 EEST}
- {3055716000 7200 0 EET}
- {3068416800 10800 1 EEST}
- {3087165600 7200 0 EET}
- {3099866400 10800 1 EEST}
- {3118615200 7200 0 EET}
- {3131920800 10800 1 EEST}
- {3150064800 7200 0 EET}
- {3163370400 10800 1 EEST}
- {3181514400 7200 0 EET}
- {3194820000 10800 1 EEST}
- {3212964000 7200 0 EET}
- {3226269600 10800 1 EEST}
- {3245018400 7200 0 EET}
- {3257719200 10800 1 EEST}
- {3276468000 7200 0 EET}
- {3289168800 10800 1 EEST}
- {3307917600 7200 0 EET}
- {3321223200 10800 1 EEST}
- {3339367200 7200 0 EET}
- {3352672800 10800 1 EEST}
- {3370816800 7200 0 EET}
- {3384122400 10800 1 EEST}
- {3402871200 7200 0 EET}
- {3415572000 10800 1 EEST}
- {3434320800 7200 0 EET}
- {3447021600 10800 1 EEST}
- {3465770400 7200 0 EET}
- {3479076000 10800 1 EEST}
- {3497220000 7200 0 EET}
- {3510525600 10800 1 EEST}
- {3528669600 7200 0 EET}
- {3541975200 10800 1 EEST}
- {3560119200 7200 0 EET}
- {3573424800 10800 1 EEST}
- {3592173600 7200 0 EET}
- {3604874400 10800 1 EEST}
- {3623623200 7200 0 EET}
- {3636324000 10800 1 EEST}
- {3655072800 7200 0 EET}
- {3668378400 10800 1 EEST}
- {3686522400 7200 0 EET}
- {3699828000 10800 1 EEST}
- {3717972000 7200 0 EET}
- {3731277600 10800 1 EEST}
- {3750026400 7200 0 EET}
- {3762727200 10800 1 EEST}
- {3781476000 7200 0 EET}
- {3794176800 10800 1 EEST}
- {3812925600 7200 0 EET}
- {3825626400 10800 1 EEST}
- {3844375200 7200 0 EET}
- {3857680800 10800 1 EEST}
- {3875824800 7200 0 EET}
- {3889130400 10800 1 EEST}
- {3907274400 7200 0 EET}
- {3920580000 10800 1 EEST}
- {3939328800 7200 0 EET}
- {3952029600 10800 1 EEST}
- {3970778400 7200 0 EET}
- {3983479200 10800 1 EEST}
- {4002228000 7200 0 EET}
- {4015533600 10800 1 EEST}
- {4033677600 7200 0 EET}
- {4046983200 10800 1 EEST}
- {4065127200 7200 0 EET}
- {4078432800 10800 1 EEST}
- {4096576800 7200 0 EET}
+ {733276800 10800 1 EEST}
+ {749001600 7200 0 EET}
+ {764726400 10800 1 EEST}
+ {780451200 7200 0 EET}
+ {796176000 10800 1 EEST}
+ {811900800 7200 0 EET}
+ {828230400 10800 1 EEST}
+ {846374400 7200 0 EET}
+ {859680000 10800 1 EEST}
+ {877824000 7200 0 EET}
+ {891129600 10800 1 EEST}
+ {909273600 7200 0 EET}
+ {922579200 10800 1 EEST}
+ {941328000 7200 0 EET}
+ {954028800 10800 1 EEST}
+ {972777600 7200 0 EET}
+ {985478400 10800 1 EEST}
+ {1004227200 7200 0 EET}
+ {1017532800 10800 1 EEST}
+ {1035676800 7200 0 EET}
+ {1048982400 10800 1 EEST}
+ {1067126400 7200 0 EET}
+ {1080432000 10800 1 EEST}
+ {1099180800 7200 0 EET}
+ {1111881600 10800 1 EEST}
+ {1130630400 7200 0 EET}
+ {1143331200 10800 1 EEST}
+ {1162080000 7200 0 EET}
+ {1174780800 10800 1 EEST}
+ {1193529600 7200 0 EET}
+ {1206835200 10800 1 EEST}
+ {1224979200 7200 0 EET}
+ {1238284800 10800 1 EEST}
+ {1256428800 7200 0 EET}
+ {1269734400 10800 1 EEST}
+ {1288483200 7200 0 EET}
+ {1301184000 10800 0 FET}
}
diff --git a/library/tzdata/Europe/Kiev b/library/tzdata/Europe/Kiev
index a4e4826..0206be7 100644
--- a/library/tzdata/Europe/Kiev
+++ b/library/tzdata/Europe/Kiev
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Kiev) {
{-9223372036854775808 7324 0 LMT}
@@ -6,9 +6,9 @@ set TZData(:Europe/Kiev) {
{-1441159324 7200 0 EET}
{-1247536800 10800 0 MSK}
{-892522800 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
{-825382800 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -17,17 +17,17 @@ set TZData(:Europe/Kiev) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
{631141200 10800 0 MSK}
{646786800 7200 0 EET}
{694216800 7200 0 EET}
diff --git a/library/tzdata/Europe/Lisbon b/library/tzdata/Europe/Lisbon
index fcf6903..79c688a 100644
--- a/library/tzdata/Europe/Lisbon
+++ b/library/tzdata/Europe/Lisbon
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Lisbon) {
{-9223372036854775808 -2192 0 LMT}
diff --git a/library/tzdata/Europe/Ljubljana b/library/tzdata/Europe/Ljubljana
index 9861926..42c7df4 100644
--- a/library/tzdata/Europe/Ljubljana
+++ b/library/tzdata/Europe/Ljubljana
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Belgrade)]} {
LoadTimeZoneFile Europe/Belgrade
}
diff --git a/library/tzdata/Europe/London b/library/tzdata/Europe/London
index 70edb91..2014e00 100644
--- a/library/tzdata/Europe/London
+++ b/library/tzdata/Europe/London
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/London) {
{-9223372036854775808 -75 0 LMT}
diff --git a/library/tzdata/Europe/Luxembourg b/library/tzdata/Europe/Luxembourg
index ac9fc75..2a88c4b 100644
--- a/library/tzdata/Europe/Luxembourg
+++ b/library/tzdata/Europe/Luxembourg
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Luxembourg) {
{-9223372036854775808 1476 0 LMT}
@@ -7,8 +7,8 @@ set TZData(:Europe/Luxembourg) {
{-1680483600 3600 0 CET}
{-1662343200 7200 1 CEST}
{-1650157200 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
{-1612659600 0 0 WET}
{-1604278800 3600 1 WEST}
{-1585519200 0 0 WET}
@@ -54,15 +54,15 @@ set TZData(:Europe/Luxembourg) {
{-950479200 0 0 WET}
{-942012000 3600 1 WEST}
{-935186400 7200 0 WEST}
- {-857253600 3600 0 WET}
- {-844552800 7200 1 WEST}
- {-828223200 3600 0 WET}
- {-812498400 7200 1 WEST}
+ {-857257200 3600 0 WET}
+ {-844556400 7200 1 WEST}
+ {-828226800 3600 0 WET}
+ {-812502000 7200 1 WEST}
{-797983200 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-766620000 3600 0 CET}
- {-745452000 7200 1 CEST}
- {-733269600 3600 0 CET}
+ {-781052400 7200 1 CEST}
+ {-766623600 3600 0 CET}
+ {-745455600 7200 1 CEST}
+ {-733273200 3600 0 CET}
{220921200 3600 0 CET}
{228877200 7200 1 CEST}
{243997200 3600 0 CET}
diff --git a/library/tzdata/Europe/Madrid b/library/tzdata/Europe/Madrid
index 98337ce..50de14f 100644
--- a/library/tzdata/Europe/Madrid
+++ b/library/tzdata/Europe/Madrid
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Madrid) {
{-9223372036854775808 -884 0 LMT}
diff --git a/library/tzdata/Europe/Malta b/library/tzdata/Europe/Malta
index 5bcde77..b84f68e 100644
--- a/library/tzdata/Europe/Malta
+++ b/library/tzdata/Europe/Malta
@@ -1,32 +1,32 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Malta) {
{-9223372036854775808 3484 0 LMT}
{-2403478684 3600 0 CET}
- {-1690848000 7200 1 CEST}
- {-1680480000 3600 0 CET}
- {-1664755200 7200 1 CEST}
- {-1649030400 3600 0 CET}
- {-1635120000 7200 1 CEST}
- {-1616976000 3600 0 CET}
- {-1604275200 7200 1 CEST}
- {-1585526400 3600 0 CET}
- {-1571011200 7200 1 CEST}
- {-1555286400 3600 0 CET}
- {-932428800 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781048800 7200 0 CEST}
- {-766713600 3600 0 CET}
- {-750895200 7200 1 CEST}
- {-733356000 3600 0 CET}
- {-719452800 7200 1 CEST}
- {-701913600 3600 0 CET}
- {-689205600 7200 1 CEST}
- {-670456800 3600 0 CET}
+ {-1690851600 7200 1 CEST}
+ {-1680483600 3600 0 CET}
+ {-1664758800 7200 1 CEST}
+ {-1649034000 3600 0 CET}
+ {-1635123600 7200 1 CEST}
+ {-1616979600 3600 0 CET}
+ {-1604278800 7200 1 CEST}
+ {-1585530000 3600 0 CET}
+ {-1571014800 7200 1 CEST}
+ {-1555290000 3600 0 CET}
+ {-932432400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 0 CEST}
+ {-766717200 3600 0 CET}
+ {-750898800 7200 1 CEST}
+ {-733359600 3600 0 CET}
+ {-719456400 7200 1 CEST}
+ {-701917200 3600 0 CET}
+ {-689209200 7200 1 CEST}
+ {-670460400 3600 0 CET}
{-114051600 7200 1 CEST}
{-103168800 3600 0 CET}
{-81997200 7200 1 CEST}
@@ -41,11 +41,10 @@ set TZData(:Europe/Malta) {
{54687600 3600 0 CET}
{75855600 7200 1 CEST}
{86738400 3600 0 CET}
- {102380400 3600 0 CET}
- {102384000 7200 1 CEST}
- {118108800 3600 0 CET}
- {135734400 7200 1 CEST}
- {148521600 3600 0 CET}
+ {102380400 7200 0 CEST}
+ {118105200 3600 0 CET}
+ {135730800 7200 1 CEST}
+ {148518000 3600 0 CET}
{167187600 7200 1 CEST}
{180489600 3600 0 CET}
{198637200 7200 1 CEST}
diff --git a/library/tzdata/Europe/Mariehamn b/library/tzdata/Europe/Mariehamn
index 9eed274..26d9177 100644
--- a/library/tzdata/Europe/Mariehamn
+++ b/library/tzdata/Europe/Mariehamn
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Helsinki)]} {
LoadTimeZoneFile Europe/Helsinki
}
diff --git a/library/tzdata/Europe/Minsk b/library/tzdata/Europe/Minsk
index ee7e546..1adcff8 100644
--- a/library/tzdata/Europe/Minsk
+++ b/library/tzdata/Europe/Minsk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Minsk) {
{-9223372036854775808 6616 0 LMT}
@@ -6,10 +6,10 @@ set TZData(:Europe/Minsk) {
{-1441158600 7200 0 EET}
{-1247536800 10800 0 MSK}
{-899780400 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-804646800 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -18,234 +18,57 @@ set TZData(:Europe/Minsk) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
{631141200 10800 0 MSK}
- {670384800 10800 1 EEST}
- {686109600 7200 0 EET}
- {701827200 10800 1 EEST}
- {717552000 7200 0 EET}
- {733284000 10800 1 EEST}
- {749008800 7200 0 EET}
- {764733600 10800 1 EEST}
- {780458400 7200 0 EET}
- {796183200 10800 1 EEST}
- {811908000 7200 0 EET}
- {828237600 10800 1 EEST}
- {846381600 7200 0 EET}
- {859687200 10800 1 EEST}
- {877831200 7200 0 EET}
- {891136800 10800 1 EEST}
- {909280800 7200 0 EET}
- {922586400 10800 1 EEST}
- {941335200 7200 0 EET}
- {954036000 10800 1 EEST}
- {972784800 7200 0 EET}
- {985485600 10800 1 EEST}
- {1004234400 7200 0 EET}
- {1017540000 10800 1 EEST}
- {1035684000 7200 0 EET}
- {1048989600 10800 1 EEST}
- {1067133600 7200 0 EET}
- {1080439200 10800 1 EEST}
- {1099188000 7200 0 EET}
- {1111888800 10800 1 EEST}
- {1130637600 7200 0 EET}
- {1143338400 10800 1 EEST}
- {1162087200 7200 0 EET}
- {1174788000 10800 1 EEST}
- {1193536800 7200 0 EET}
- {1206842400 10800 1 EEST}
- {1224986400 7200 0 EET}
- {1238292000 10800 1 EEST}
- {1256436000 7200 0 EET}
- {1269741600 10800 1 EEST}
- {1288490400 7200 0 EET}
- {1301191200 10800 1 EEST}
- {1319940000 7200 0 EET}
- {1332640800 10800 1 EEST}
- {1351389600 7200 0 EET}
- {1364695200 10800 1 EEST}
- {1382839200 7200 0 EET}
- {1396144800 10800 1 EEST}
- {1414288800 7200 0 EET}
- {1427594400 10800 1 EEST}
- {1445738400 7200 0 EET}
- {1459044000 10800 1 EEST}
- {1477792800 7200 0 EET}
- {1490493600 10800 1 EEST}
- {1509242400 7200 0 EET}
- {1521943200 10800 1 EEST}
- {1540692000 7200 0 EET}
- {1553997600 10800 1 EEST}
- {1572141600 7200 0 EET}
- {1585447200 10800 1 EEST}
- {1603591200 7200 0 EET}
- {1616896800 10800 1 EEST}
- {1635645600 7200 0 EET}
- {1648346400 10800 1 EEST}
- {1667095200 7200 0 EET}
- {1679796000 10800 1 EEST}
- {1698544800 7200 0 EET}
- {1711850400 10800 1 EEST}
- {1729994400 7200 0 EET}
- {1743300000 10800 1 EEST}
- {1761444000 7200 0 EET}
- {1774749600 10800 1 EEST}
- {1792893600 7200 0 EET}
- {1806199200 10800 1 EEST}
- {1824948000 7200 0 EET}
- {1837648800 10800 1 EEST}
- {1856397600 7200 0 EET}
- {1869098400 10800 1 EEST}
- {1887847200 7200 0 EET}
- {1901152800 10800 1 EEST}
- {1919296800 7200 0 EET}
- {1932602400 10800 1 EEST}
- {1950746400 7200 0 EET}
- {1964052000 10800 1 EEST}
- {1982800800 7200 0 EET}
- {1995501600 10800 1 EEST}
- {2014250400 7200 0 EET}
- {2026951200 10800 1 EEST}
- {2045700000 7200 0 EET}
- {2058400800 10800 1 EEST}
- {2077149600 7200 0 EET}
- {2090455200 10800 1 EEST}
- {2108599200 7200 0 EET}
- {2121904800 10800 1 EEST}
- {2140048800 7200 0 EET}
- {2153354400 10800 1 EEST}
- {2172103200 7200 0 EET}
- {2184804000 10800 1 EEST}
- {2203552800 7200 0 EET}
- {2216253600 10800 1 EEST}
- {2235002400 7200 0 EET}
- {2248308000 10800 1 EEST}
- {2266452000 7200 0 EET}
- {2279757600 10800 1 EEST}
- {2297901600 7200 0 EET}
- {2311207200 10800 1 EEST}
- {2329351200 7200 0 EET}
- {2342656800 10800 1 EEST}
- {2361405600 7200 0 EET}
- {2374106400 10800 1 EEST}
- {2392855200 7200 0 EET}
- {2405556000 10800 1 EEST}
- {2424304800 7200 0 EET}
- {2437610400 10800 1 EEST}
- {2455754400 7200 0 EET}
- {2469060000 10800 1 EEST}
- {2487204000 7200 0 EET}
- {2500509600 10800 1 EEST}
- {2519258400 7200 0 EET}
- {2531959200 10800 1 EEST}
- {2550708000 7200 0 EET}
- {2563408800 10800 1 EEST}
- {2582157600 7200 0 EET}
- {2595463200 10800 1 EEST}
- {2613607200 7200 0 EET}
- {2626912800 10800 1 EEST}
- {2645056800 7200 0 EET}
- {2658362400 10800 1 EEST}
- {2676506400 7200 0 EET}
- {2689812000 10800 1 EEST}
- {2708560800 7200 0 EET}
- {2721261600 10800 1 EEST}
- {2740010400 7200 0 EET}
- {2752711200 10800 1 EEST}
- {2771460000 7200 0 EET}
- {2784765600 10800 1 EEST}
- {2802909600 7200 0 EET}
- {2816215200 10800 1 EEST}
- {2834359200 7200 0 EET}
- {2847664800 10800 1 EEST}
- {2866413600 7200 0 EET}
- {2879114400 10800 1 EEST}
- {2897863200 7200 0 EET}
- {2910564000 10800 1 EEST}
- {2929312800 7200 0 EET}
- {2942013600 10800 1 EEST}
- {2960762400 7200 0 EET}
- {2974068000 10800 1 EEST}
- {2992212000 7200 0 EET}
- {3005517600 10800 1 EEST}
- {3023661600 7200 0 EET}
- {3036967200 10800 1 EEST}
- {3055716000 7200 0 EET}
- {3068416800 10800 1 EEST}
- {3087165600 7200 0 EET}
- {3099866400 10800 1 EEST}
- {3118615200 7200 0 EET}
- {3131920800 10800 1 EEST}
- {3150064800 7200 0 EET}
- {3163370400 10800 1 EEST}
- {3181514400 7200 0 EET}
- {3194820000 10800 1 EEST}
- {3212964000 7200 0 EET}
- {3226269600 10800 1 EEST}
- {3245018400 7200 0 EET}
- {3257719200 10800 1 EEST}
- {3276468000 7200 0 EET}
- {3289168800 10800 1 EEST}
- {3307917600 7200 0 EET}
- {3321223200 10800 1 EEST}
- {3339367200 7200 0 EET}
- {3352672800 10800 1 EEST}
- {3370816800 7200 0 EET}
- {3384122400 10800 1 EEST}
- {3402871200 7200 0 EET}
- {3415572000 10800 1 EEST}
- {3434320800 7200 0 EET}
- {3447021600 10800 1 EEST}
- {3465770400 7200 0 EET}
- {3479076000 10800 1 EEST}
- {3497220000 7200 0 EET}
- {3510525600 10800 1 EEST}
- {3528669600 7200 0 EET}
- {3541975200 10800 1 EEST}
- {3560119200 7200 0 EET}
- {3573424800 10800 1 EEST}
- {3592173600 7200 0 EET}
- {3604874400 10800 1 EEST}
- {3623623200 7200 0 EET}
- {3636324000 10800 1 EEST}
- {3655072800 7200 0 EET}
- {3668378400 10800 1 EEST}
- {3686522400 7200 0 EET}
- {3699828000 10800 1 EEST}
- {3717972000 7200 0 EET}
- {3731277600 10800 1 EEST}
- {3750026400 7200 0 EET}
- {3762727200 10800 1 EEST}
- {3781476000 7200 0 EET}
- {3794176800 10800 1 EEST}
- {3812925600 7200 0 EET}
- {3825626400 10800 1 EEST}
- {3844375200 7200 0 EET}
- {3857680800 10800 1 EEST}
- {3875824800 7200 0 EET}
- {3889130400 10800 1 EEST}
- {3907274400 7200 0 EET}
- {3920580000 10800 1 EEST}
- {3939328800 7200 0 EET}
- {3952029600 10800 1 EEST}
- {3970778400 7200 0 EET}
- {3983479200 10800 1 EEST}
- {4002228000 7200 0 EET}
- {4015533600 10800 1 EEST}
- {4033677600 7200 0 EET}
- {4046983200 10800 1 EEST}
- {4065127200 7200 0 EET}
- {4078432800 10800 1 EEST}
- {4096576800 7200 0 EET}
+ {670374000 10800 1 EEST}
+ {686102400 7200 0 EET}
+ {701820000 10800 1 EEST}
+ {717544800 7200 0 EET}
+ {733276800 10800 1 EEST}
+ {749001600 7200 0 EET}
+ {764726400 10800 1 EEST}
+ {780451200 7200 0 EET}
+ {796176000 10800 1 EEST}
+ {811900800 7200 0 EET}
+ {828230400 10800 1 EEST}
+ {846374400 7200 0 EET}
+ {859680000 10800 1 EEST}
+ {877824000 7200 0 EET}
+ {891129600 10800 1 EEST}
+ {909273600 7200 0 EET}
+ {922579200 10800 1 EEST}
+ {941328000 7200 0 EET}
+ {954028800 10800 1 EEST}
+ {972777600 7200 0 EET}
+ {985478400 10800 1 EEST}
+ {1004227200 7200 0 EET}
+ {1017532800 10800 1 EEST}
+ {1035676800 7200 0 EET}
+ {1048982400 10800 1 EEST}
+ {1067126400 7200 0 EET}
+ {1080432000 10800 1 EEST}
+ {1099180800 7200 0 EET}
+ {1111881600 10800 1 EEST}
+ {1130630400 7200 0 EET}
+ {1143331200 10800 1 EEST}
+ {1162080000 7200 0 EET}
+ {1174780800 10800 1 EEST}
+ {1193529600 7200 0 EET}
+ {1206835200 10800 1 EEST}
+ {1224979200 7200 0 EET}
+ {1238284800 10800 1 EEST}
+ {1256428800 7200 0 EET}
+ {1269734400 10800 1 EEST}
+ {1288483200 7200 0 EET}
+ {1301184000 10800 0 FET}
}
diff --git a/library/tzdata/Europe/Monaco b/library/tzdata/Europe/Monaco
index 1e0a6fa..f887b0b 100644
--- a/library/tzdata/Europe/Monaco
+++ b/library/tzdata/Europe/Monaco
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Monaco) {
{-9223372036854775808 1772 0 LMT}
diff --git a/library/tzdata/Europe/Moscow b/library/tzdata/Europe/Moscow
index 6847a15..8f40741 100644
--- a/library/tzdata/Europe/Moscow
+++ b/library/tzdata/Europe/Moscow
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Moscow) {
{-9223372036854775808 9020 0 LMT}
@@ -24,236 +24,60 @@ set TZData(:Europe/Moscow) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
- {638330400 14400 1 MSD}
- {654660000 10800 0 MSK}
- {670384800 10800 0 EEST}
- {686109600 7200 0 EET}
- {695786400 10800 0 MSD}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
+ {638319600 14400 1 MSD}
+ {654649200 10800 0 MSK}
+ {670374000 7200 0 EEMMTT}
+ {670377600 10800 1 EEST}
+ {686102400 7200 0 EET}
+ {695779200 10800 0 MSD}
{701812800 14400 1 MSD}
{717534000 10800 0 MSK}
- {733284000 14400 1 MSD}
- {749008800 10800 0 MSK}
- {764733600 14400 1 MSD}
- {780458400 10800 0 MSK}
- {796183200 14400 1 MSD}
- {811908000 10800 0 MSK}
- {828237600 14400 1 MSD}
- {846381600 10800 0 MSK}
- {859687200 14400 1 MSD}
- {877831200 10800 0 MSK}
- {891136800 14400 1 MSD}
- {909280800 10800 0 MSK}
- {922586400 14400 1 MSD}
- {941335200 10800 0 MSK}
- {954036000 14400 1 MSD}
- {972784800 10800 0 MSK}
- {985485600 14400 1 MSD}
- {1004234400 10800 0 MSK}
- {1017540000 14400 1 MSD}
- {1035684000 10800 0 MSK}
- {1048989600 14400 1 MSD}
- {1067133600 10800 0 MSK}
- {1080439200 14400 1 MSD}
- {1099188000 10800 0 MSK}
- {1111888800 14400 1 MSD}
- {1130637600 10800 0 MSK}
- {1143338400 14400 1 MSD}
- {1162087200 10800 0 MSK}
- {1174788000 14400 1 MSD}
- {1193536800 10800 0 MSK}
- {1206842400 14400 1 MSD}
- {1224986400 10800 0 MSK}
- {1238292000 14400 1 MSD}
- {1256436000 10800 0 MSK}
- {1269741600 14400 1 MSD}
- {1288490400 10800 0 MSK}
- {1301191200 14400 1 MSD}
- {1319940000 10800 0 MSK}
- {1332640800 14400 1 MSD}
- {1351389600 10800 0 MSK}
- {1364695200 14400 1 MSD}
- {1382839200 10800 0 MSK}
- {1396144800 14400 1 MSD}
- {1414288800 10800 0 MSK}
- {1427594400 14400 1 MSD}
- {1445738400 10800 0 MSK}
- {1459044000 14400 1 MSD}
- {1477792800 10800 0 MSK}
- {1490493600 14400 1 MSD}
- {1509242400 10800 0 MSK}
- {1521943200 14400 1 MSD}
- {1540692000 10800 0 MSK}
- {1553997600 14400 1 MSD}
- {1572141600 10800 0 MSK}
- {1585447200 14400 1 MSD}
- {1603591200 10800 0 MSK}
- {1616896800 14400 1 MSD}
- {1635645600 10800 0 MSK}
- {1648346400 14400 1 MSD}
- {1667095200 10800 0 MSK}
- {1679796000 14400 1 MSD}
- {1698544800 10800 0 MSK}
- {1711850400 14400 1 MSD}
- {1729994400 10800 0 MSK}
- {1743300000 14400 1 MSD}
- {1761444000 10800 0 MSK}
- {1774749600 14400 1 MSD}
- {1792893600 10800 0 MSK}
- {1806199200 14400 1 MSD}
- {1824948000 10800 0 MSK}
- {1837648800 14400 1 MSD}
- {1856397600 10800 0 MSK}
- {1869098400 14400 1 MSD}
- {1887847200 10800 0 MSK}
- {1901152800 14400 1 MSD}
- {1919296800 10800 0 MSK}
- {1932602400 14400 1 MSD}
- {1950746400 10800 0 MSK}
- {1964052000 14400 1 MSD}
- {1982800800 10800 0 MSK}
- {1995501600 14400 1 MSD}
- {2014250400 10800 0 MSK}
- {2026951200 14400 1 MSD}
- {2045700000 10800 0 MSK}
- {2058400800 14400 1 MSD}
- {2077149600 10800 0 MSK}
- {2090455200 14400 1 MSD}
- {2108599200 10800 0 MSK}
- {2121904800 14400 1 MSD}
- {2140048800 10800 0 MSK}
- {2153354400 14400 1 MSD}
- {2172103200 10800 0 MSK}
- {2184804000 14400 1 MSD}
- {2203552800 10800 0 MSK}
- {2216253600 14400 1 MSD}
- {2235002400 10800 0 MSK}
- {2248308000 14400 1 MSD}
- {2266452000 10800 0 MSK}
- {2279757600 14400 1 MSD}
- {2297901600 10800 0 MSK}
- {2311207200 14400 1 MSD}
- {2329351200 10800 0 MSK}
- {2342656800 14400 1 MSD}
- {2361405600 10800 0 MSK}
- {2374106400 14400 1 MSD}
- {2392855200 10800 0 MSK}
- {2405556000 14400 1 MSD}
- {2424304800 10800 0 MSK}
- {2437610400 14400 1 MSD}
- {2455754400 10800 0 MSK}
- {2469060000 14400 1 MSD}
- {2487204000 10800 0 MSK}
- {2500509600 14400 1 MSD}
- {2519258400 10800 0 MSK}
- {2531959200 14400 1 MSD}
- {2550708000 10800 0 MSK}
- {2563408800 14400 1 MSD}
- {2582157600 10800 0 MSK}
- {2595463200 14400 1 MSD}
- {2613607200 10800 0 MSK}
- {2626912800 14400 1 MSD}
- {2645056800 10800 0 MSK}
- {2658362400 14400 1 MSD}
- {2676506400 10800 0 MSK}
- {2689812000 14400 1 MSD}
- {2708560800 10800 0 MSK}
- {2721261600 14400 1 MSD}
- {2740010400 10800 0 MSK}
- {2752711200 14400 1 MSD}
- {2771460000 10800 0 MSK}
- {2784765600 14400 1 MSD}
- {2802909600 10800 0 MSK}
- {2816215200 14400 1 MSD}
- {2834359200 10800 0 MSK}
- {2847664800 14400 1 MSD}
- {2866413600 10800 0 MSK}
- {2879114400 14400 1 MSD}
- {2897863200 10800 0 MSK}
- {2910564000 14400 1 MSD}
- {2929312800 10800 0 MSK}
- {2942013600 14400 1 MSD}
- {2960762400 10800 0 MSK}
- {2974068000 14400 1 MSD}
- {2992212000 10800 0 MSK}
- {3005517600 14400 1 MSD}
- {3023661600 10800 0 MSK}
- {3036967200 14400 1 MSD}
- {3055716000 10800 0 MSK}
- {3068416800 14400 1 MSD}
- {3087165600 10800 0 MSK}
- {3099866400 14400 1 MSD}
- {3118615200 10800 0 MSK}
- {3131920800 14400 1 MSD}
- {3150064800 10800 0 MSK}
- {3163370400 14400 1 MSD}
- {3181514400 10800 0 MSK}
- {3194820000 14400 1 MSD}
- {3212964000 10800 0 MSK}
- {3226269600 14400 1 MSD}
- {3245018400 10800 0 MSK}
- {3257719200 14400 1 MSD}
- {3276468000 10800 0 MSK}
- {3289168800 14400 1 MSD}
- {3307917600 10800 0 MSK}
- {3321223200 14400 1 MSD}
- {3339367200 10800 0 MSK}
- {3352672800 14400 1 MSD}
- {3370816800 10800 0 MSK}
- {3384122400 14400 1 MSD}
- {3402871200 10800 0 MSK}
- {3415572000 14400 1 MSD}
- {3434320800 10800 0 MSK}
- {3447021600 14400 1 MSD}
- {3465770400 10800 0 MSK}
- {3479076000 14400 1 MSD}
- {3497220000 10800 0 MSK}
- {3510525600 14400 1 MSD}
- {3528669600 10800 0 MSK}
- {3541975200 14400 1 MSD}
- {3560119200 10800 0 MSK}
- {3573424800 14400 1 MSD}
- {3592173600 10800 0 MSK}
- {3604874400 14400 1 MSD}
- {3623623200 10800 0 MSK}
- {3636324000 14400 1 MSD}
- {3655072800 10800 0 MSK}
- {3668378400 14400 1 MSD}
- {3686522400 10800 0 MSK}
- {3699828000 14400 1 MSD}
- {3717972000 10800 0 MSK}
- {3731277600 14400 1 MSD}
- {3750026400 10800 0 MSK}
- {3762727200 14400 1 MSD}
- {3781476000 10800 0 MSK}
- {3794176800 14400 1 MSD}
- {3812925600 10800 0 MSK}
- {3825626400 14400 1 MSD}
- {3844375200 10800 0 MSK}
- {3857680800 14400 1 MSD}
- {3875824800 10800 0 MSK}
- {3889130400 14400 1 MSD}
- {3907274400 10800 0 MSK}
- {3920580000 14400 1 MSD}
- {3939328800 10800 0 MSK}
- {3952029600 14400 1 MSD}
- {3970778400 10800 0 MSK}
- {3983479200 14400 1 MSD}
- {4002228000 10800 0 MSK}
- {4015533600 14400 1 MSD}
- {4033677600 10800 0 MSK}
- {4046983200 14400 1 MSD}
- {4065127200 10800 0 MSK}
- {4078432800 14400 1 MSD}
- {4096576800 10800 0 MSK}
+ {733273200 14400 1 MSD}
+ {748998000 10800 0 MSK}
+ {764722800 14400 1 MSD}
+ {780447600 10800 0 MSK}
+ {796172400 14400 1 MSD}
+ {811897200 10800 0 MSK}
+ {828226800 14400 1 MSD}
+ {846370800 10800 0 MSK}
+ {859676400 14400 1 MSD}
+ {877820400 10800 0 MSK}
+ {891126000 14400 1 MSD}
+ {909270000 10800 0 MSK}
+ {922575600 14400 1 MSD}
+ {941324400 10800 0 MSK}
+ {954025200 14400 1 MSD}
+ {972774000 10800 0 MSK}
+ {985474800 14400 1 MSD}
+ {1004223600 10800 0 MSK}
+ {1017529200 14400 1 MSD}
+ {1035673200 10800 0 MSK}
+ {1048978800 14400 1 MSD}
+ {1067122800 10800 0 MSK}
+ {1080428400 14400 1 MSD}
+ {1099177200 10800 0 MSK}
+ {1111878000 14400 1 MSD}
+ {1130626800 10800 0 MSK}
+ {1143327600 14400 1 MSD}
+ {1162076400 10800 0 MSK}
+ {1174777200 14400 1 MSD}
+ {1193526000 10800 0 MSK}
+ {1206831600 14400 1 MSD}
+ {1224975600 10800 0 MSK}
+ {1238281200 14400 1 MSD}
+ {1256425200 10800 0 MSK}
+ {1269730800 14400 1 MSD}
+ {1288479600 10800 0 MSK}
+ {1301180400 14400 0 MSK}
}
diff --git a/library/tzdata/Europe/Nicosia b/library/tzdata/Europe/Nicosia
index 6d6de81..2d58355 100644
--- a/library/tzdata/Europe/Nicosia
+++ b/library/tzdata/Europe/Nicosia
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Nicosia)]} {
LoadTimeZoneFile Asia/Nicosia
}
diff --git a/library/tzdata/Europe/Oslo b/library/tzdata/Europe/Oslo
index 931a6e0..6787c1e 100644
--- a/library/tzdata/Europe/Oslo
+++ b/library/tzdata/Europe/Oslo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Oslo) {
{-9223372036854775808 2580 0 LMT}
@@ -6,28 +6,27 @@ set TZData(:Europe/Oslo) {
{-1691884800 7200 1 CEST}
{-1680573600 3600 0 CET}
{-927511200 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781052400 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-765324000 3600 0 CET}
- {-340840800 7200 1 CEST}
- {-324511200 3600 0 CET}
- {-308786400 7200 1 CEST}
- {-293061600 3600 0 CET}
- {-277336800 7200 1 CEST}
- {-261612000 3600 0 CET}
- {-245887200 7200 1 CEST}
- {-230162400 3600 0 CET}
- {-214437600 7200 1 CEST}
- {-198712800 3600 0 CET}
- {-182988000 7200 1 CEST}
- {-166658400 3600 0 CET}
- {-147909600 7200 1 CEST}
- {-135208800 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 0 CEST}
+ {-765327600 3600 0 CET}
+ {-340844400 7200 1 CEST}
+ {-324514800 3600 0 CET}
+ {-308790000 7200 1 CEST}
+ {-293065200 3600 0 CET}
+ {-277340400 7200 1 CEST}
+ {-261615600 3600 0 CET}
+ {-245890800 7200 1 CEST}
+ {-230166000 3600 0 CET}
+ {-214441200 7200 1 CEST}
+ {-198716400 3600 0 CET}
+ {-182991600 7200 1 CEST}
+ {-166662000 3600 0 CET}
+ {-147913200 7200 1 CEST}
+ {-135212400 3600 0 CET}
{315529200 3600 0 CET}
{323830800 7200 1 CEST}
{338950800 3600 0 CET}
diff --git a/library/tzdata/Europe/Paris b/library/tzdata/Europe/Paris
index 8c443b9..4b22a09 100644
--- a/library/tzdata/Europe/Paris
+++ b/library/tzdata/Europe/Paris
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Paris) {
{-9223372036854775808 561 0 LMT}
@@ -54,10 +54,10 @@ set TZData(:Europe/Paris) {
{-950490000 0 0 WET}
{-942012000 3600 1 WEST}
{-932436000 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-800067600 7200 0 WEMT}
{-796266000 3600 1 WEST}
{-781052400 7200 1 WEMT}
diff --git a/library/tzdata/Europe/Podgorica b/library/tzdata/Europe/Podgorica
new file mode 100644
index 0000000..f4f9066
--- /dev/null
+++ b/library/tzdata/Europe/Podgorica
@@ -0,0 +1,5 @@
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/Belgrade)]} {
+ LoadTimeZoneFile Europe/Belgrade
+}
+set TZData(:Europe/Podgorica) $TZData(:Europe/Belgrade)
diff --git a/library/tzdata/Europe/Prague b/library/tzdata/Europe/Prague
index e3b5e08..222b1ae 100644
--- a/library/tzdata/Europe/Prague
+++ b/library/tzdata/Europe/Prague
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Prague) {
{-9223372036854775808 3464 0 LMT}
@@ -6,26 +6,26 @@ set TZData(:Europe/Prague) {
{-2469401864 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
- {-938901600 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-798069600 3600 0 CET}
- {-780530400 7200 1 CEST}
- {-761176800 3600 0 CET}
- {-746575200 7200 1 CEST}
- {-733356000 3600 0 CET}
- {-716421600 7200 1 CEST}
- {-701906400 3600 0 CET}
- {-684972000 7200 1 CEST}
- {-670456800 3600 0 CET}
- {-654213600 7200 1 CEST}
- {-639007200 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
+ {-938905200 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-798073200 3600 0 CET}
+ {-780534000 7200 1 CEST}
+ {-761180400 3600 0 CET}
+ {-746578800 7200 1 CEST}
+ {-733359600 3600 0 CET}
+ {-716425200 7200 1 CEST}
+ {-701910000 3600 0 CET}
+ {-684975600 7200 1 CEST}
+ {-670460400 3600 0 CET}
+ {-654217200 7200 1 CEST}
+ {-639010800 3600 0 CET}
{283993200 3600 0 CET}
{291776400 7200 1 CEST}
{307501200 3600 0 CET}
diff --git a/library/tzdata/Europe/Riga b/library/tzdata/Europe/Riga
index 9d75785..9fad0f8 100644
--- a/library/tzdata/Europe/Riga
+++ b/library/tzdata/Europe/Riga
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Riga) {
{-9223372036854775808 5784 0 LMT}
@@ -10,11 +10,11 @@ set TZData(:Europe/Riga) {
{-1377308184 7200 0 EET}
{-928029600 10800 0 MSK}
{-899521200 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
{-795834000 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -23,31 +23,31 @@ set TZData(:Europe/Riga) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 10800 1 EEST}
- {622605600 7200 0 EET}
- {638330400 10800 1 EEST}
- {654660000 7200 0 EET}
- {670384800 10800 1 EEST}
- {686109600 7200 0 EET}
- {701834400 10800 1 EEST}
- {717559200 7200 0 EET}
- {733284000 10800 1 EEST}
- {749008800 7200 0 EET}
- {764733600 10800 1 EEST}
- {780458400 7200 0 EET}
- {796183200 10800 1 EEST}
- {811908000 7200 0 EET}
- {828237600 10800 1 EEST}
- {843962400 7200 0 EET}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 10800 1 EEST}
+ {622598400 7200 0 EET}
+ {638323200 10800 1 EEST}
+ {654652800 7200 0 EET}
+ {670377600 10800 1 EEST}
+ {686102400 7200 0 EET}
+ {701827200 10800 1 EEST}
+ {717552000 7200 0 EET}
+ {733276800 10800 1 EEST}
+ {749001600 7200 0 EET}
+ {764726400 10800 1 EEST}
+ {780451200 7200 0 EET}
+ {796176000 10800 1 EEST}
+ {811900800 7200 0 EET}
+ {828230400 10800 1 EEST}
+ {843955200 7200 0 EET}
{853797600 7200 0 EET}
{859683600 10800 1 EEST}
{877827600 7200 0 EET}
diff --git a/library/tzdata/Europe/Rome b/library/tzdata/Europe/Rome
index 6ad0438..64948b8 100644
--- a/library/tzdata/Europe/Rome
+++ b/library/tzdata/Europe/Rome
@@ -1,34 +1,34 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Rome) {
{-9223372036854775808 2996 0 LMT}
{-3259097396 2996 0 RMT}
{-2403564596 3600 0 CET}
- {-1690848000 7200 1 CEST}
- {-1680480000 3600 0 CET}
- {-1664755200 7200 1 CEST}
- {-1649030400 3600 0 CET}
- {-1635120000 7200 1 CEST}
- {-1616976000 3600 0 CET}
- {-1604275200 7200 1 CEST}
- {-1585526400 3600 0 CET}
- {-1571011200 7200 1 CEST}
- {-1555286400 3600 0 CET}
- {-932428800 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-1690851600 7200 1 CEST}
+ {-1680483600 3600 0 CET}
+ {-1664758800 7200 1 CEST}
+ {-1649034000 3600 0 CET}
+ {-1635123600 7200 1 CEST}
+ {-1616979600 3600 0 CET}
+ {-1604278800 7200 1 CEST}
+ {-1585530000 3600 0 CET}
+ {-1571014800 7200 1 CEST}
+ {-1555290000 3600 0 CET}
+ {-932432400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-804819600 3600 0 CET}
- {-798076800 3600 0 CET}
+ {-798080400 3600 0 CET}
{-781052400 7200 1 CEST}
- {-766713600 3600 0 CET}
- {-750895200 7200 1 CEST}
- {-733356000 3600 0 CET}
- {-719452800 7200 1 CEST}
- {-701913600 3600 0 CET}
- {-689205600 7200 1 CEST}
- {-670456800 3600 0 CET}
+ {-766717200 3600 0 CET}
+ {-750898800 7200 1 CEST}
+ {-733359600 3600 0 CET}
+ {-719456400 7200 1 CEST}
+ {-701917200 3600 0 CET}
+ {-689209200 7200 1 CEST}
+ {-670460400 3600 0 CET}
{-114051600 7200 1 CEST}
{-103168800 3600 0 CET}
{-81997200 7200 1 CEST}
@@ -47,16 +47,16 @@ set TZData(:Europe/Rome) {
{118188000 3600 0 CET}
{138754800 7200 1 CEST}
{149637600 3600 0 CET}
- {170812800 7200 1 CEST}
- {181094400 3600 0 CET}
- {202262400 7200 1 CEST}
- {212544000 3600 0 CET}
- {233107200 7200 1 CEST}
- {243993600 3600 0 CET}
- {265161600 7200 1 CEST}
- {276048000 3600 0 CET}
- {296611200 7200 1 CEST}
- {307497600 3600 0 CET}
+ {170809200 7200 1 CEST}
+ {181090800 3600 0 CET}
+ {202258800 7200 1 CEST}
+ {212540400 3600 0 CET}
+ {233103600 7200 1 CEST}
+ {243990000 3600 0 CET}
+ {265158000 7200 1 CEST}
+ {276044400 3600 0 CET}
+ {296607600 7200 1 CEST}
+ {307494000 3600 0 CET}
{315529200 3600 0 CET}
{323830800 7200 1 CEST}
{338950800 3600 0 CET}
diff --git a/library/tzdata/Europe/Samara b/library/tzdata/Europe/Samara
index 9cb9b19..f2ac911 100644
--- a/library/tzdata/Europe/Samara
+++ b/library/tzdata/Europe/Samara
@@ -1,9 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Samara) {
{-9223372036854775808 12036 0 LMT}
- {-1593825636 10800 0 KUYT}
- {-1247540400 14400 0 KUYMMTT}
+ {-1593825636 10800 0 SAMT}
+ {-1247540400 14400 0 SAMT}
+ {-1102305600 14400 0 KUYMMTT}
{354916800 18000 1 KUYST}
{370724400 14400 0 KUYT}
{386452800 18000 1 KUYST}
@@ -11,235 +12,62 @@ set TZData(:Europe/Samara) {
{417988800 18000 1 KUYST}
{433796400 14400 0 KUYT}
{449611200 18000 1 KUYST}
- {465357600 14400 0 KUYT}
- {481082400 18000 1 KUYST}
- {496807200 14400 0 KUYT}
- {512532000 18000 1 KUYST}
- {528256800 14400 0 KUYT}
- {543981600 18000 1 KUYST}
- {559706400 14400 0 KUYT}
- {575431200 18000 1 KUYST}
- {591156000 14400 0 KUYT}
- {606880800 14400 0 KUYST}
- {622605600 10800 0 KUYT}
- {638330400 14400 1 KUYST}
- {654660000 10800 0 KUYT}
- {686109600 10800 0 KUYT}
+ {465343200 14400 0 KUYT}
+ {481068000 18000 1 KUYST}
+ {496792800 14400 0 KUYT}
+ {512517600 18000 1 KUYST}
+ {528242400 14400 0 KUYT}
+ {543967200 18000 1 KUYST}
+ {559692000 14400 0 KUYT}
+ {575416800 18000 1 KUYST}
+ {591141600 14400 0 KUYT}
+ {606866400 10800 0 KUYMMTT}
+ {606870000 14400 1 KUYST}
+ {622594800 10800 0 KUYT}
+ {638319600 14400 1 KUYST}
+ {654649200 10800 0 KUYT}
+ {670374000 7200 0 KUYMMTT}
+ {670377600 10800 1 KUYST}
+ {686102400 10800 0 KUYT}
{687916800 14400 0 SAMT}
{701809200 18000 1 SAMST}
{717530400 14400 0 SAMT}
- {733284000 18000 1 SAMST}
- {749008800 14400 0 SAMT}
- {764733600 18000 1 SAMST}
- {780458400 14400 0 SAMT}
- {796183200 18000 1 SAMST}
- {811908000 14400 0 SAMT}
- {828237600 18000 1 SAMST}
- {846381600 14400 0 SAMT}
- {859687200 18000 1 SAMST}
- {877831200 14400 0 SAMT}
- {891136800 18000 1 SAMST}
- {909280800 14400 0 SAMT}
- {922586400 18000 1 SAMST}
- {941335200 14400 0 SAMT}
- {954036000 18000 1 SAMST}
- {972784800 14400 0 SAMT}
- {985485600 18000 1 SAMST}
- {1004234400 14400 0 SAMT}
- {1017540000 18000 1 SAMST}
- {1035684000 14400 0 SAMT}
- {1048989600 18000 1 SAMST}
- {1067133600 14400 0 SAMT}
- {1080439200 18000 1 SAMST}
- {1099188000 14400 0 SAMT}
- {1111888800 18000 1 SAMST}
- {1130637600 14400 0 SAMT}
- {1143338400 18000 1 SAMST}
- {1162087200 14400 0 SAMT}
- {1174788000 18000 1 SAMST}
- {1193536800 14400 0 SAMT}
- {1206842400 18000 1 SAMST}
- {1224986400 14400 0 SAMT}
- {1238292000 18000 1 SAMST}
- {1256436000 14400 0 SAMT}
- {1269741600 18000 1 SAMST}
- {1288490400 14400 0 SAMT}
- {1301191200 18000 1 SAMST}
- {1319940000 14400 0 SAMT}
- {1332640800 18000 1 SAMST}
- {1351389600 14400 0 SAMT}
- {1364695200 18000 1 SAMST}
- {1382839200 14400 0 SAMT}
- {1396144800 18000 1 SAMST}
- {1414288800 14400 0 SAMT}
- {1427594400 18000 1 SAMST}
- {1445738400 14400 0 SAMT}
- {1459044000 18000 1 SAMST}
- {1477792800 14400 0 SAMT}
- {1490493600 18000 1 SAMST}
- {1509242400 14400 0 SAMT}
- {1521943200 18000 1 SAMST}
- {1540692000 14400 0 SAMT}
- {1553997600 18000 1 SAMST}
- {1572141600 14400 0 SAMT}
- {1585447200 18000 1 SAMST}
- {1603591200 14400 0 SAMT}
- {1616896800 18000 1 SAMST}
- {1635645600 14400 0 SAMT}
- {1648346400 18000 1 SAMST}
- {1667095200 14400 0 SAMT}
- {1679796000 18000 1 SAMST}
- {1698544800 14400 0 SAMT}
- {1711850400 18000 1 SAMST}
- {1729994400 14400 0 SAMT}
- {1743300000 18000 1 SAMST}
- {1761444000 14400 0 SAMT}
- {1774749600 18000 1 SAMST}
- {1792893600 14400 0 SAMT}
- {1806199200 18000 1 SAMST}
- {1824948000 14400 0 SAMT}
- {1837648800 18000 1 SAMST}
- {1856397600 14400 0 SAMT}
- {1869098400 18000 1 SAMST}
- {1887847200 14400 0 SAMT}
- {1901152800 18000 1 SAMST}
- {1919296800 14400 0 SAMT}
- {1932602400 18000 1 SAMST}
- {1950746400 14400 0 SAMT}
- {1964052000 18000 1 SAMST}
- {1982800800 14400 0 SAMT}
- {1995501600 18000 1 SAMST}
- {2014250400 14400 0 SAMT}
- {2026951200 18000 1 SAMST}
- {2045700000 14400 0 SAMT}
- {2058400800 18000 1 SAMST}
- {2077149600 14400 0 SAMT}
- {2090455200 18000 1 SAMST}
- {2108599200 14400 0 SAMT}
- {2121904800 18000 1 SAMST}
- {2140048800 14400 0 SAMT}
- {2153354400 18000 1 SAMST}
- {2172103200 14400 0 SAMT}
- {2184804000 18000 1 SAMST}
- {2203552800 14400 0 SAMT}
- {2216253600 18000 1 SAMST}
- {2235002400 14400 0 SAMT}
- {2248308000 18000 1 SAMST}
- {2266452000 14400 0 SAMT}
- {2279757600 18000 1 SAMST}
- {2297901600 14400 0 SAMT}
- {2311207200 18000 1 SAMST}
- {2329351200 14400 0 SAMT}
- {2342656800 18000 1 SAMST}
- {2361405600 14400 0 SAMT}
- {2374106400 18000 1 SAMST}
- {2392855200 14400 0 SAMT}
- {2405556000 18000 1 SAMST}
- {2424304800 14400 0 SAMT}
- {2437610400 18000 1 SAMST}
- {2455754400 14400 0 SAMT}
- {2469060000 18000 1 SAMST}
- {2487204000 14400 0 SAMT}
- {2500509600 18000 1 SAMST}
- {2519258400 14400 0 SAMT}
- {2531959200 18000 1 SAMST}
- {2550708000 14400 0 SAMT}
- {2563408800 18000 1 SAMST}
- {2582157600 14400 0 SAMT}
- {2595463200 18000 1 SAMST}
- {2613607200 14400 0 SAMT}
- {2626912800 18000 1 SAMST}
- {2645056800 14400 0 SAMT}
- {2658362400 18000 1 SAMST}
- {2676506400 14400 0 SAMT}
- {2689812000 18000 1 SAMST}
- {2708560800 14400 0 SAMT}
- {2721261600 18000 1 SAMST}
- {2740010400 14400 0 SAMT}
- {2752711200 18000 1 SAMST}
- {2771460000 14400 0 SAMT}
- {2784765600 18000 1 SAMST}
- {2802909600 14400 0 SAMT}
- {2816215200 18000 1 SAMST}
- {2834359200 14400 0 SAMT}
- {2847664800 18000 1 SAMST}
- {2866413600 14400 0 SAMT}
- {2879114400 18000 1 SAMST}
- {2897863200 14400 0 SAMT}
- {2910564000 18000 1 SAMST}
- {2929312800 14400 0 SAMT}
- {2942013600 18000 1 SAMST}
- {2960762400 14400 0 SAMT}
- {2974068000 18000 1 SAMST}
- {2992212000 14400 0 SAMT}
- {3005517600 18000 1 SAMST}
- {3023661600 14400 0 SAMT}
- {3036967200 18000 1 SAMST}
- {3055716000 14400 0 SAMT}
- {3068416800 18000 1 SAMST}
- {3087165600 14400 0 SAMT}
- {3099866400 18000 1 SAMST}
- {3118615200 14400 0 SAMT}
- {3131920800 18000 1 SAMST}
- {3150064800 14400 0 SAMT}
- {3163370400 18000 1 SAMST}
- {3181514400 14400 0 SAMT}
- {3194820000 18000 1 SAMST}
- {3212964000 14400 0 SAMT}
- {3226269600 18000 1 SAMST}
- {3245018400 14400 0 SAMT}
- {3257719200 18000 1 SAMST}
- {3276468000 14400 0 SAMT}
- {3289168800 18000 1 SAMST}
- {3307917600 14400 0 SAMT}
- {3321223200 18000 1 SAMST}
- {3339367200 14400 0 SAMT}
- {3352672800 18000 1 SAMST}
- {3370816800 14400 0 SAMT}
- {3384122400 18000 1 SAMST}
- {3402871200 14400 0 SAMT}
- {3415572000 18000 1 SAMST}
- {3434320800 14400 0 SAMT}
- {3447021600 18000 1 SAMST}
- {3465770400 14400 0 SAMT}
- {3479076000 18000 1 SAMST}
- {3497220000 14400 0 SAMT}
- {3510525600 18000 1 SAMST}
- {3528669600 14400 0 SAMT}
- {3541975200 18000 1 SAMST}
- {3560119200 14400 0 SAMT}
- {3573424800 18000 1 SAMST}
- {3592173600 14400 0 SAMT}
- {3604874400 18000 1 SAMST}
- {3623623200 14400 0 SAMT}
- {3636324000 18000 1 SAMST}
- {3655072800 14400 0 SAMT}
- {3668378400 18000 1 SAMST}
- {3686522400 14400 0 SAMT}
- {3699828000 18000 1 SAMST}
- {3717972000 14400 0 SAMT}
- {3731277600 18000 1 SAMST}
- {3750026400 14400 0 SAMT}
- {3762727200 18000 1 SAMST}
- {3781476000 14400 0 SAMT}
- {3794176800 18000 1 SAMST}
- {3812925600 14400 0 SAMT}
- {3825626400 18000 1 SAMST}
- {3844375200 14400 0 SAMT}
- {3857680800 18000 1 SAMST}
- {3875824800 14400 0 SAMT}
- {3889130400 18000 1 SAMST}
- {3907274400 14400 0 SAMT}
- {3920580000 18000 1 SAMST}
- {3939328800 14400 0 SAMT}
- {3952029600 18000 1 SAMST}
- {3970778400 14400 0 SAMT}
- {3983479200 18000 1 SAMST}
- {4002228000 14400 0 SAMT}
- {4015533600 18000 1 SAMST}
- {4033677600 14400 0 SAMT}
- {4046983200 18000 1 SAMST}
- {4065127200 14400 0 SAMT}
- {4078432800 18000 1 SAMST}
- {4096576800 14400 0 SAMT}
+ {733269600 18000 1 SAMST}
+ {748994400 14400 0 SAMT}
+ {764719200 18000 1 SAMST}
+ {780444000 14400 0 SAMT}
+ {796168800 18000 1 SAMST}
+ {811893600 14400 0 SAMT}
+ {828223200 18000 1 SAMST}
+ {846367200 14400 0 SAMT}
+ {859672800 18000 1 SAMST}
+ {877816800 14400 0 SAMT}
+ {891122400 18000 1 SAMST}
+ {909266400 14400 0 SAMT}
+ {922572000 18000 1 SAMST}
+ {941320800 14400 0 SAMT}
+ {954021600 18000 1 SAMST}
+ {972770400 14400 0 SAMT}
+ {985471200 18000 1 SAMST}
+ {1004220000 14400 0 SAMT}
+ {1017525600 18000 1 SAMST}
+ {1035669600 14400 0 SAMT}
+ {1048975200 18000 1 SAMST}
+ {1067119200 14400 0 SAMT}
+ {1080424800 18000 1 SAMST}
+ {1099173600 14400 0 SAMT}
+ {1111874400 18000 1 SAMST}
+ {1130623200 14400 0 SAMT}
+ {1143324000 18000 1 SAMST}
+ {1162072800 14400 0 SAMT}
+ {1174773600 18000 1 SAMST}
+ {1193522400 14400 0 SAMT}
+ {1206828000 18000 1 SAMST}
+ {1224972000 14400 0 SAMT}
+ {1238277600 18000 1 SAMST}
+ {1256421600 14400 0 SAMT}
+ {1269727200 10800 0 SAMMMTT}
+ {1269730800 14400 1 SAMST}
+ {1288479600 10800 0 SAMT}
+ {1301180400 14400 0 SAMT}
}
diff --git a/library/tzdata/Europe/San_Marino b/library/tzdata/Europe/San_Marino
index 704c8ea..927ad29 100644
--- a/library/tzdata/Europe/San_Marino
+++ b/library/tzdata/Europe/San_Marino
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Rome)]} {
LoadTimeZoneFile Europe/Rome
}
diff --git a/library/tzdata/Europe/Sarajevo b/library/tzdata/Europe/Sarajevo
index a76d730..1b14286 100644
--- a/library/tzdata/Europe/Sarajevo
+++ b/library/tzdata/Europe/Sarajevo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Belgrade)]} {
LoadTimeZoneFile Europe/Belgrade
}
diff --git a/library/tzdata/Europe/Simferopol b/library/tzdata/Europe/Simferopol
index 9846ce0..9836560 100644
--- a/library/tzdata/Europe/Simferopol
+++ b/library/tzdata/Europe/Simferopol
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Simferopol) {
{-9223372036854775808 8184 0 LMT}
@@ -6,10 +6,10 @@ set TZData(:Europe/Simferopol) {
{-1441160160 7200 0 EET}
{-1247536800 10800 0 MSK}
{-888894000 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-811645200 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -18,17 +18,17 @@ set TZData(:Europe/Simferopol) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
{631141200 10800 0 MSK}
{646786800 7200 0 EET}
{694216800 7200 0 EET}
@@ -42,7 +42,7 @@ set TZData(:Europe/Simferopol) {
{796165200 14400 1 MSD}
{811886400 10800 0 MSK}
{828219600 14400 1 MSD}
- {828241200 14400 1 MSD}
+ {828230400 14400 1 MSD}
{852066000 10800 0 MSK}
{859683600 10800 0 EEST}
{877827600 7200 0 EET}
diff --git a/library/tzdata/Europe/Skopje b/library/tzdata/Europe/Skopje
index c3fd3a3..07eedbe 100644
--- a/library/tzdata/Europe/Skopje
+++ b/library/tzdata/Europe/Skopje
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Belgrade)]} {
LoadTimeZoneFile Europe/Belgrade
}
diff --git a/library/tzdata/Europe/Sofia b/library/tzdata/Europe/Sofia
index e64b106..8fd55f6 100644
--- a/library/tzdata/Europe/Sofia
+++ b/library/tzdata/Europe/Sofia
@@ -1,15 +1,15 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Sofia) {
{-9223372036854775808 5596 0 LMT}
{-2840146396 7016 0 IMT}
{-2369527016 7200 0 EET}
{-857257200 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-788922000 3600 0 CET}
{-781048800 7200 0 EET}
{291762000 10800 0 EEST}
{307576800 7200 0 EET}
@@ -19,23 +19,23 @@ set TZData(:Europe/Sofia) {
{370393200 7200 0 EET}
{386715600 10800 1 EEST}
{401842800 10800 0 EEST}
- {401853600 7200 0 EET}
- {417578400 10800 1 EEST}
- {433303200 7200 0 EET}
- {449028000 10800 1 EEST}
- {465357600 7200 0 EET}
- {481082400 10800 1 EEST}
- {496807200 7200 0 EET}
- {512532000 10800 1 EEST}
- {528256800 7200 0 EET}
- {543981600 10800 1 EEST}
- {559706400 7200 0 EET}
- {575431200 10800 1 EEST}
- {591156000 7200 0 EET}
- {606880800 10800 1 EEST}
- {622605600 7200 0 EET}
- {638330400 10800 1 EEST}
- {654660000 7200 0 EET}
+ {401846400 7200 0 EET}
+ {417571200 10800 1 EEST}
+ {433296000 7200 0 EET}
+ {449020800 10800 1 EEST}
+ {465350400 7200 0 EET}
+ {481075200 10800 1 EEST}
+ {496800000 7200 0 EET}
+ {512524800 10800 1 EEST}
+ {528249600 7200 0 EET}
+ {543974400 10800 1 EEST}
+ {559699200 7200 0 EET}
+ {575424000 10800 1 EEST}
+ {591148800 7200 0 EET}
+ {606873600 10800 1 EEST}
+ {622598400 7200 0 EET}
+ {638323200 10800 1 EEST}
+ {654652800 7200 0 EET}
{662680800 7200 0 EET}
{670370400 10800 1 EEST}
{686091600 7200 0 EET}
diff --git a/library/tzdata/Europe/Stockholm b/library/tzdata/Europe/Stockholm
index 1a6ed8c..b74d327 100644
--- a/library/tzdata/Europe/Stockholm
+++ b/library/tzdata/Europe/Stockholm
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Stockholm) {
{-9223372036854775808 4332 0 LMT}
diff --git a/library/tzdata/Europe/Tallinn b/library/tzdata/Europe/Tallinn
index 66e3829..17f14e6 100644
--- a/library/tzdata/Europe/Tallinn
+++ b/library/tzdata/Europe/Tallinn
@@ -1,19 +1,19 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Tallinn) {
{-9223372036854775808 5940 0 LMT}
{-2840146740 5940 0 TMT}
{-1638322740 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
{-1593824400 5940 0 TMT}
{-1535938740 7200 0 EET}
{-927943200 10800 0 MSK}
{-892954800 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-797648400 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -22,34 +22,34 @@ set TZData(:Europe/Tallinn) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 10800 1 EEST}
- {622605600 7200 0 EET}
- {638330400 10800 1 EEST}
- {654660000 7200 0 EET}
- {670384800 10800 1 EEST}
- {686109600 7200 0 EET}
- {701834400 10800 1 EEST}
- {717559200 7200 0 EET}
- {733284000 10800 1 EEST}
- {749008800 7200 0 EET}
- {764733600 10800 1 EEST}
- {780458400 7200 0 EET}
- {796183200 10800 1 EEST}
- {811908000 7200 0 EET}
- {828237600 10800 1 EEST}
- {846381600 7200 0 EET}
- {859687200 10800 1 EEST}
- {877831200 7200 0 EET}
- {891136800 10800 1 EEST}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 10800 1 EEST}
+ {622598400 7200 0 EET}
+ {638323200 10800 1 EEST}
+ {654652800 7200 0 EET}
+ {670377600 10800 1 EEST}
+ {686102400 7200 0 EET}
+ {701827200 10800 1 EEST}
+ {717552000 7200 0 EET}
+ {733276800 10800 1 EEST}
+ {749001600 7200 0 EET}
+ {764726400 10800 1 EEST}
+ {780451200 7200 0 EET}
+ {796176000 10800 1 EEST}
+ {811900800 7200 0 EET}
+ {828230400 10800 1 EEST}
+ {846374400 7200 0 EET}
+ {859680000 10800 1 EEST}
+ {877824000 7200 0 EET}
+ {891129600 10800 1 EEST}
{906415200 10800 0 EEST}
{909277200 7200 0 EET}
{922582800 10800 1 EEST}
diff --git a/library/tzdata/Europe/Tirane b/library/tzdata/Europe/Tirane
index 46480bf..14ace2e 100644
--- a/library/tzdata/Europe/Tirane
+++ b/library/tzdata/Europe/Tirane
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Tirane) {
{-9223372036854775808 4760 0 LMT}
diff --git a/library/tzdata/Europe/Tiraspol b/library/tzdata/Europe/Tiraspol
index 4c8b21b..ea8f671 100644
--- a/library/tzdata/Europe/Tiraspol
+++ b/library/tzdata/Europe/Tiraspol
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Chisinau)]} {
LoadTimeZoneFile Europe/Chisinau
}
diff --git a/library/tzdata/Europe/Uzhgorod b/library/tzdata/Europe/Uzhgorod
index 40e3773..f6e580b 100644
--- a/library/tzdata/Europe/Uzhgorod
+++ b/library/tzdata/Europe/Uzhgorod
@@ -1,14 +1,14 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Uzhgorod) {
{-9223372036854775808 5352 0 LMT}
{-2500939752 3600 0 CET}
{-946774800 3600 0 CET}
- {-938901600 7200 1 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-938905200 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-796870800 7200 1 CEST}
{-794714400 3600 0 CET}
{-773456400 10800 0 MSD}
@@ -19,17 +19,17 @@ set TZData(:Europe/Uzhgorod) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
{631141200 10800 0 MSK}
{646786800 3600 0 CET}
{670384800 7200 0 EET}
diff --git a/library/tzdata/Europe/Vaduz b/library/tzdata/Europe/Vaduz
index f8a55dc..095e018 100644
--- a/library/tzdata/Europe/Vaduz
+++ b/library/tzdata/Europe/Vaduz
@@ -1,245 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Europe/Vaduz) {
- {-9223372036854775808 2284 0 LMT}
- {-2385247084 3600 0 CET}
- {347151600 3600 0 CET}
- {354675600 7200 1 CEST}
- {370400400 3600 0 CET}
- {386125200 7200 1 CEST}
- {401850000 3600 0 CET}
- {417574800 7200 1 CEST}
- {433299600 3600 0 CET}
- {449024400 7200 1 CEST}
- {465354000 3600 0 CET}
- {481078800 7200 1 CEST}
- {496803600 3600 0 CET}
- {512528400 7200 1 CEST}
- {528253200 3600 0 CET}
- {543978000 7200 1 CEST}
- {559702800 3600 0 CET}
- {575427600 7200 1 CEST}
- {591152400 3600 0 CET}
- {606877200 7200 1 CEST}
- {622602000 3600 0 CET}
- {638326800 7200 1 CEST}
- {654656400 3600 0 CET}
- {670381200 7200 1 CEST}
- {686106000 3600 0 CET}
- {701830800 7200 1 CEST}
- {717555600 3600 0 CET}
- {733280400 7200 1 CEST}
- {749005200 3600 0 CET}
- {764730000 7200 1 CEST}
- {780454800 3600 0 CET}
- {796179600 7200 1 CEST}
- {811904400 3600 0 CET}
- {828234000 7200 1 CEST}
- {846378000 3600 0 CET}
- {859683600 7200 1 CEST}
- {877827600 3600 0 CET}
- {891133200 7200 1 CEST}
- {909277200 3600 0 CET}
- {922582800 7200 1 CEST}
- {941331600 3600 0 CET}
- {954032400 7200 1 CEST}
- {972781200 3600 0 CET}
- {985482000 7200 1 CEST}
- {1004230800 3600 0 CET}
- {1017536400 7200 1 CEST}
- {1035680400 3600 0 CET}
- {1048986000 7200 1 CEST}
- {1067130000 3600 0 CET}
- {1080435600 7200 1 CEST}
- {1099184400 3600 0 CET}
- {1111885200 7200 1 CEST}
- {1130634000 3600 0 CET}
- {1143334800 7200 1 CEST}
- {1162083600 3600 0 CET}
- {1174784400 7200 1 CEST}
- {1193533200 3600 0 CET}
- {1206838800 7200 1 CEST}
- {1224982800 3600 0 CET}
- {1238288400 7200 1 CEST}
- {1256432400 3600 0 CET}
- {1269738000 7200 1 CEST}
- {1288486800 3600 0 CET}
- {1301187600 7200 1 CEST}
- {1319936400 3600 0 CET}
- {1332637200 7200 1 CEST}
- {1351386000 3600 0 CET}
- {1364691600 7200 1 CEST}
- {1382835600 3600 0 CET}
- {1396141200 7200 1 CEST}
- {1414285200 3600 0 CET}
- {1427590800 7200 1 CEST}
- {1445734800 3600 0 CET}
- {1459040400 7200 1 CEST}
- {1477789200 3600 0 CET}
- {1490490000 7200 1 CEST}
- {1509238800 3600 0 CET}
- {1521939600 7200 1 CEST}
- {1540688400 3600 0 CET}
- {1553994000 7200 1 CEST}
- {1572138000 3600 0 CET}
- {1585443600 7200 1 CEST}
- {1603587600 3600 0 CET}
- {1616893200 7200 1 CEST}
- {1635642000 3600 0 CET}
- {1648342800 7200 1 CEST}
- {1667091600 3600 0 CET}
- {1679792400 7200 1 CEST}
- {1698541200 3600 0 CET}
- {1711846800 7200 1 CEST}
- {1729990800 3600 0 CET}
- {1743296400 7200 1 CEST}
- {1761440400 3600 0 CET}
- {1774746000 7200 1 CEST}
- {1792890000 3600 0 CET}
- {1806195600 7200 1 CEST}
- {1824944400 3600 0 CET}
- {1837645200 7200 1 CEST}
- {1856394000 3600 0 CET}
- {1869094800 7200 1 CEST}
- {1887843600 3600 0 CET}
- {1901149200 7200 1 CEST}
- {1919293200 3600 0 CET}
- {1932598800 7200 1 CEST}
- {1950742800 3600 0 CET}
- {1964048400 7200 1 CEST}
- {1982797200 3600 0 CET}
- {1995498000 7200 1 CEST}
- {2014246800 3600 0 CET}
- {2026947600 7200 1 CEST}
- {2045696400 3600 0 CET}
- {2058397200 7200 1 CEST}
- {2077146000 3600 0 CET}
- {2090451600 7200 1 CEST}
- {2108595600 3600 0 CET}
- {2121901200 7200 1 CEST}
- {2140045200 3600 0 CET}
- {2153350800 7200 1 CEST}
- {2172099600 3600 0 CET}
- {2184800400 7200 1 CEST}
- {2203549200 3600 0 CET}
- {2216250000 7200 1 CEST}
- {2234998800 3600 0 CET}
- {2248304400 7200 1 CEST}
- {2266448400 3600 0 CET}
- {2279754000 7200 1 CEST}
- {2297898000 3600 0 CET}
- {2311203600 7200 1 CEST}
- {2329347600 3600 0 CET}
- {2342653200 7200 1 CEST}
- {2361402000 3600 0 CET}
- {2374102800 7200 1 CEST}
- {2392851600 3600 0 CET}
- {2405552400 7200 1 CEST}
- {2424301200 3600 0 CET}
- {2437606800 7200 1 CEST}
- {2455750800 3600 0 CET}
- {2469056400 7200 1 CEST}
- {2487200400 3600 0 CET}
- {2500506000 7200 1 CEST}
- {2519254800 3600 0 CET}
- {2531955600 7200 1 CEST}
- {2550704400 3600 0 CET}
- {2563405200 7200 1 CEST}
- {2582154000 3600 0 CET}
- {2595459600 7200 1 CEST}
- {2613603600 3600 0 CET}
- {2626909200 7200 1 CEST}
- {2645053200 3600 0 CET}
- {2658358800 7200 1 CEST}
- {2676502800 3600 0 CET}
- {2689808400 7200 1 CEST}
- {2708557200 3600 0 CET}
- {2721258000 7200 1 CEST}
- {2740006800 3600 0 CET}
- {2752707600 7200 1 CEST}
- {2771456400 3600 0 CET}
- {2784762000 7200 1 CEST}
- {2802906000 3600 0 CET}
- {2816211600 7200 1 CEST}
- {2834355600 3600 0 CET}
- {2847661200 7200 1 CEST}
- {2866410000 3600 0 CET}
- {2879110800 7200 1 CEST}
- {2897859600 3600 0 CET}
- {2910560400 7200 1 CEST}
- {2929309200 3600 0 CET}
- {2942010000 7200 1 CEST}
- {2960758800 3600 0 CET}
- {2974064400 7200 1 CEST}
- {2992208400 3600 0 CET}
- {3005514000 7200 1 CEST}
- {3023658000 3600 0 CET}
- {3036963600 7200 1 CEST}
- {3055712400 3600 0 CET}
- {3068413200 7200 1 CEST}
- {3087162000 3600 0 CET}
- {3099862800 7200 1 CEST}
- {3118611600 3600 0 CET}
- {3131917200 7200 1 CEST}
- {3150061200 3600 0 CET}
- {3163366800 7200 1 CEST}
- {3181510800 3600 0 CET}
- {3194816400 7200 1 CEST}
- {3212960400 3600 0 CET}
- {3226266000 7200 1 CEST}
- {3245014800 3600 0 CET}
- {3257715600 7200 1 CEST}
- {3276464400 3600 0 CET}
- {3289165200 7200 1 CEST}
- {3307914000 3600 0 CET}
- {3321219600 7200 1 CEST}
- {3339363600 3600 0 CET}
- {3352669200 7200 1 CEST}
- {3370813200 3600 0 CET}
- {3384118800 7200 1 CEST}
- {3402867600 3600 0 CET}
- {3415568400 7200 1 CEST}
- {3434317200 3600 0 CET}
- {3447018000 7200 1 CEST}
- {3465766800 3600 0 CET}
- {3479072400 7200 1 CEST}
- {3497216400 3600 0 CET}
- {3510522000 7200 1 CEST}
- {3528666000 3600 0 CET}
- {3541971600 7200 1 CEST}
- {3560115600 3600 0 CET}
- {3573421200 7200 1 CEST}
- {3592170000 3600 0 CET}
- {3604870800 7200 1 CEST}
- {3623619600 3600 0 CET}
- {3636320400 7200 1 CEST}
- {3655069200 3600 0 CET}
- {3668374800 7200 1 CEST}
- {3686518800 3600 0 CET}
- {3699824400 7200 1 CEST}
- {3717968400 3600 0 CET}
- {3731274000 7200 1 CEST}
- {3750022800 3600 0 CET}
- {3762723600 7200 1 CEST}
- {3781472400 3600 0 CET}
- {3794173200 7200 1 CEST}
- {3812922000 3600 0 CET}
- {3825622800 7200 1 CEST}
- {3844371600 3600 0 CET}
- {3857677200 7200 1 CEST}
- {3875821200 3600 0 CET}
- {3889126800 7200 1 CEST}
- {3907270800 3600 0 CET}
- {3920576400 7200 1 CEST}
- {3939325200 3600 0 CET}
- {3952026000 7200 1 CEST}
- {3970774800 3600 0 CET}
- {3983475600 7200 1 CEST}
- {4002224400 3600 0 CET}
- {4015530000 7200 1 CEST}
- {4033674000 3600 0 CET}
- {4046979600 7200 1 CEST}
- {4065123600 3600 0 CET}
- {4078429200 7200 1 CEST}
- {4096573200 3600 0 CET}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Europe/Zurich)]} {
+ LoadTimeZoneFile Europe/Zurich
}
+set TZData(:Europe/Vaduz) $TZData(:Europe/Zurich)
diff --git a/library/tzdata/Europe/Vatican b/library/tzdata/Europe/Vatican
index 1c0bc07..fe50765 100644
--- a/library/tzdata/Europe/Vatican
+++ b/library/tzdata/Europe/Vatican
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Rome)]} {
LoadTimeZoneFile Europe/Rome
}
diff --git a/library/tzdata/Europe/Vienna b/library/tzdata/Europe/Vienna
index 0e4f03a..95283eb 100644
--- a/library/tzdata/Europe/Vienna
+++ b/library/tzdata/Europe/Vienna
@@ -1,32 +1,32 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Vienna) {
- {-9223372036854775808 3920 0 LMT}
- {-2422055120 3600 0 CET}
+ {-9223372036854775808 3921 0 LMT}
+ {-2422055121 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
- {-1618696800 3600 0 CET}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
+ {-1618700400 3600 0 CET}
{-1577926800 3600 0 CET}
- {-1569708000 7200 1 CEST}
- {-1555797600 3600 0 CET}
- {-938901600 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796773600 3600 0 CET}
- {-781048800 7200 1 CEST}
- {-780184800 3600 0 CET}
+ {-1569711600 7200 1 CEST}
+ {-1555801200 3600 0 CET}
+ {-938905200 7200 0 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796777200 3600 0 CET}
+ {-781052400 7200 1 CEST}
+ {-780188400 3600 0 CET}
{-757386000 3600 0 CET}
- {-748476000 7200 1 CEST}
- {-733356000 3600 0 CET}
- {-717631200 7200 1 CEST}
- {-701906400 3600 0 CET}
- {-684972000 7200 1 CEST}
- {-670456800 3600 0 CET}
+ {-748479600 7200 1 CEST}
+ {-733359600 3600 0 CET}
+ {-717634800 7200 1 CEST}
+ {-701910000 3600 0 CET}
+ {-684975600 7200 1 CEST}
+ {-670460400 3600 0 CET}
{323823600 7200 1 CEST}
{338940000 3600 0 CET}
{347151600 3600 0 CET}
diff --git a/library/tzdata/Europe/Vilnius b/library/tzdata/Europe/Vilnius
index 8bdf4e5..62d5d87 100644
--- a/library/tzdata/Europe/Vilnius
+++ b/library/tzdata/Europe/Vilnius
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Vilnius) {
{-9223372036854775808 6076 0 LMT}
@@ -9,10 +9,10 @@ set TZData(:Europe/Vilnius) {
{-1553565600 3600 0 CET}
{-928198800 10800 0 MSK}
{-900126000 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
{-802141200 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -21,33 +21,33 @@ set TZData(:Europe/Vilnius) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
- {638330400 14400 1 MSD}
- {654660000 10800 0 MSK}
- {670384800 10800 1 EEST}
- {686109600 7200 0 EET}
- {701834400 10800 1 EEST}
- {717559200 7200 0 EET}
- {733284000 10800 1 EEST}
- {749008800 7200 0 EET}
- {764733600 10800 1 EEST}
- {780458400 7200 0 EET}
- {796183200 10800 1 EEST}
- {811908000 7200 0 EET}
- {828237600 10800 1 EEST}
- {846381600 7200 0 EET}
- {859687200 10800 1 EEST}
- {877831200 7200 0 EET}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
+ {638319600 14400 1 MSD}
+ {654649200 10800 0 MSK}
+ {670374000 10800 1 EEST}
+ {686102400 7200 0 EET}
+ {701827200 10800 1 EEST}
+ {717552000 7200 0 EET}
+ {733276800 10800 1 EEST}
+ {749001600 7200 0 EET}
+ {764726400 10800 1 EEST}
+ {780451200 7200 0 EET}
+ {796176000 10800 1 EEST}
+ {811900800 7200 0 EET}
+ {828230400 10800 1 EEST}
+ {846374400 7200 0 EET}
+ {859680000 10800 1 EEST}
+ {877824000 7200 0 EET}
{883605600 7200 0 EET}
{891133200 7200 0 CEST}
{909277200 3600 0 CET}
diff --git a/library/tzdata/Europe/Volgograd b/library/tzdata/Europe/Volgograd
new file mode 100644
index 0000000..c3f148f
--- /dev/null
+++ b/library/tzdata/Europe/Volgograd
@@ -0,0 +1,70 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Europe/Volgograd) {
+ {-9223372036854775808 10660 0 LMT}
+ {-1577761060 10800 0 TSAT}
+ {-1411873200 10800 0 STAT}
+ {-1247540400 14400 0 STAT}
+ {-256881600 14400 0 VOLMMTT}
+ {354916800 18000 1 VOLST}
+ {370724400 14400 0 VOLT}
+ {386452800 18000 1 VOLST}
+ {402260400 14400 0 VOLT}
+ {417988800 18000 1 VOLST}
+ {433796400 14400 0 VOLT}
+ {449611200 18000 1 VOLST}
+ {465343200 14400 0 VOLT}
+ {481068000 18000 1 VOLST}
+ {496792800 14400 0 VOLT}
+ {512517600 18000 1 VOLST}
+ {528242400 14400 0 VOLT}
+ {543967200 18000 1 VOLST}
+ {559692000 14400 0 VOLT}
+ {575416800 18000 1 VOLST}
+ {591141600 14400 0 VOLT}
+ {606866400 10800 0 VOLMMTT}
+ {606870000 14400 1 VOLST}
+ {622594800 10800 0 VOLT}
+ {638319600 14400 1 VOLST}
+ {654649200 10800 0 VOLT}
+ {670374000 14400 0 VOLT}
+ {701820000 14400 0 VOLST}
+ {717534000 10800 0 VOLT}
+ {733273200 14400 1 VOLST}
+ {748998000 10800 0 VOLT}
+ {764722800 14400 1 VOLST}
+ {780447600 10800 0 VOLT}
+ {796172400 14400 1 VOLST}
+ {811897200 10800 0 VOLT}
+ {828226800 14400 1 VOLST}
+ {846370800 10800 0 VOLT}
+ {859676400 14400 1 VOLST}
+ {877820400 10800 0 VOLT}
+ {891126000 14400 1 VOLST}
+ {909270000 10800 0 VOLT}
+ {922575600 14400 1 VOLST}
+ {941324400 10800 0 VOLT}
+ {954025200 14400 1 VOLST}
+ {972774000 10800 0 VOLT}
+ {985474800 14400 1 VOLST}
+ {1004223600 10800 0 VOLT}
+ {1017529200 14400 1 VOLST}
+ {1035673200 10800 0 VOLT}
+ {1048978800 14400 1 VOLST}
+ {1067122800 10800 0 VOLT}
+ {1080428400 14400 1 VOLST}
+ {1099177200 10800 0 VOLT}
+ {1111878000 14400 1 VOLST}
+ {1130626800 10800 0 VOLT}
+ {1143327600 14400 1 VOLST}
+ {1162076400 10800 0 VOLT}
+ {1174777200 14400 1 VOLST}
+ {1193526000 10800 0 VOLT}
+ {1206831600 14400 1 VOLST}
+ {1224975600 10800 0 VOLT}
+ {1238281200 14400 1 VOLST}
+ {1256425200 10800 0 VOLT}
+ {1269730800 14400 1 VOLST}
+ {1288479600 10800 0 VOLT}
+ {1301180400 14400 0 VOLT}
+}
diff --git a/library/tzdata/Europe/Warsaw b/library/tzdata/Europe/Warsaw
index 8285b9a..6288a8a 100644
--- a/library/tzdata/Europe/Warsaw
+++ b/library/tzdata/Europe/Warsaw
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Warsaw) {
{-9223372036854775808 5040 0 LMT}
@@ -6,66 +6,69 @@ set TZData(:Europe/Warsaw) {
{-1717032240 3600 0 CET}
{-1693706400 7200 1 CEST}
{-1680483600 3600 0 CET}
- {-1663452000 7200 1 CEST}
- {-1650146400 3600 0 CET}
- {-1632002400 7200 1 CEST}
+ {-1663455600 7200 1 CEST}
+ {-1650150000 3600 0 CET}
+ {-1632006000 7200 1 CEST}
{-1618696800 7200 0 EET}
- {-1600466400 10800 1 EEST}
- {-1587160800 7200 0 EET}
+ {-1600473600 10800 1 EEST}
+ {-1587168000 7200 0 EET}
{-931734000 7200 0 CEST}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
- {-812498400 7200 1 CEST}
- {-796870800 3600 0 CET}
- {-796604400 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
+ {-812502000 7200 1 CEST}
+ {-796870800 7200 0 CEST}
+ {-796608000 3600 0 CET}
{-778726800 7200 1 CEST}
{-762660000 3600 0 CET}
{-748486800 7200 1 CEST}
- {-735876000 3600 0 CET}
- {-715222800 7200 1 CEST}
- {-701920800 3600 0 CET}
- {-684982800 7200 1 CEST}
- {-670471200 3600 0 CET}
- {-397090800 7200 1 CEST}
- {-386809200 3600 0 CET}
- {-371084400 7200 1 CEST}
- {-355359600 3600 0 CET}
- {-334191600 7200 1 CEST}
- {-323305200 3600 0 CET}
- {-307580400 7200 1 CEST}
- {-291855600 3600 0 CET}
- {-271292400 7200 1 CEST}
- {-260406000 3600 0 CET}
- {-239842800 7200 1 CEST}
- {-228956400 3600 0 CET}
- {-208393200 7200 1 CEST}
- {-197506800 3600 0 CET}
- {-176338800 7200 1 CEST}
- {-166057200 3600 0 CET}
- {228873600 3600 0 CET}
- {228877200 7200 1 CEST}
- {243997200 3600 0 CET}
- {260326800 7200 1 CEST}
- {276051600 3600 0 CET}
- {291776400 7200 1 CEST}
- {307501200 3600 0 CET}
- {323830800 7200 1 CEST}
- {338950800 3600 0 CET}
- {354675600 7200 1 CEST}
- {370400400 3600 0 CET}
- {386125200 7200 1 CEST}
- {401850000 3600 0 CET}
- {417574800 7200 1 CEST}
- {433299600 3600 0 CET}
- {449024400 7200 1 CEST}
- {465354000 3600 0 CET}
- {481078800 7200 1 CEST}
- {496803600 3600 0 CET}
- {512528400 7200 1 CEST}
- {528253200 3600 0 CET}
- {543978000 7200 1 CEST}
- {559702800 3600 0 CET}
+ {-733273200 3600 0 CET}
+ {-715215600 7200 1 CEST}
+ {-701910000 3600 0 CET}
+ {-684975600 7200 1 CEST}
+ {-670460400 3600 0 CET}
+ {-654130800 7200 1 CEST}
+ {-639010800 3600 0 CET}
+ {-397094400 7200 1 CEST}
+ {-386812800 3600 0 CET}
+ {-371088000 7200 1 CEST}
+ {-355363200 3600 0 CET}
+ {-334195200 7200 1 CEST}
+ {-323308800 3600 0 CET}
+ {-307584000 7200 1 CEST}
+ {-291859200 3600 0 CET}
+ {-271296000 7200 1 CEST}
+ {-260409600 3600 0 CET}
+ {-239846400 7200 1 CEST}
+ {-228960000 3600 0 CET}
+ {-208396800 7200 1 CEST}
+ {-197510400 3600 0 CET}
+ {-176342400 7200 1 CEST}
+ {-166060800 3600 0 CET}
+ {220921200 3600 0 CET}
+ {228873600 7200 1 CEST}
+ {243993600 3600 0 CET}
+ {260323200 7200 1 CEST}
+ {276048000 3600 0 CET}
+ {291772800 7200 1 CEST}
+ {307497600 3600 0 CET}
+ {323827200 7200 1 CEST}
+ {338947200 3600 0 CET}
+ {354672000 7200 1 CEST}
+ {370396800 3600 0 CET}
+ {386121600 7200 1 CEST}
+ {401846400 3600 0 CET}
+ {417571200 7200 1 CEST}
+ {433296000 3600 0 CET}
+ {449020800 7200 1 CEST}
+ {465350400 3600 0 CET}
+ {481075200 7200 1 CEST}
+ {496800000 3600 0 CET}
+ {512524800 7200 1 CEST}
+ {528249600 3600 0 CET}
+ {543974400 7200 1 CEST}
+ {559699200 3600 0 CET}
+ {567990000 3600 0 CET}
{575427600 7200 1 CEST}
{591152400 3600 0 CET}
{606877200 7200 1 CEST}
@@ -88,7 +91,6 @@ set TZData(:Europe/Warsaw) {
{877827600 3600 0 CET}
{891133200 7200 1 CEST}
{909277200 3600 0 CET}
- {915145200 3600 0 CET}
{922582800 7200 1 CEST}
{941331600 3600 0 CET}
{954032400 7200 1 CEST}
diff --git a/library/tzdata/Europe/Zagreb b/library/tzdata/Europe/Zagreb
index a1d3fe6..46319a4 100644
--- a/library/tzdata/Europe/Zagreb
+++ b/library/tzdata/Europe/Zagreb
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Belgrade)]} {
LoadTimeZoneFile Europe/Belgrade
}
diff --git a/library/tzdata/Europe/Zaporozhye b/library/tzdata/Europe/Zaporozhye
index cde98a6..01418cd 100644
--- a/library/tzdata/Europe/Zaporozhye
+++ b/library/tzdata/Europe/Zaporozhye
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Zaporozhye) {
{-9223372036854775808 8440 0 LMT}
@@ -6,9 +6,9 @@ set TZData(:Europe/Zaporozhye) {
{-1441160400 7200 0 EET}
{-1247536800 10800 0 MSK}
{-894769200 3600 0 CET}
- {-857253600 3600 0 CET}
- {-844552800 7200 1 CEST}
- {-828223200 3600 0 CET}
+ {-857257200 3600 0 CET}
+ {-844556400 7200 1 CEST}
+ {-828226800 3600 0 CET}
{-826419600 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
@@ -17,19 +17,19 @@ set TZData(:Europe/Zaporozhye) {
{417992400 14400 1 MSD}
{433800000 10800 0 MSK}
{449614800 14400 1 MSD}
- {465357600 10800 0 MSK}
- {481082400 14400 1 MSD}
- {496807200 10800 0 MSK}
- {512532000 14400 1 MSD}
- {528256800 10800 0 MSK}
- {543981600 14400 1 MSD}
- {559706400 10800 0 MSK}
- {575431200 14400 1 MSD}
- {591156000 10800 0 MSK}
- {606880800 14400 1 MSD}
- {622605600 10800 0 MSK}
- {638330400 14400 1 MSD}
- {654660000 10800 0 MSK}
+ {465346800 10800 0 MSK}
+ {481071600 14400 1 MSD}
+ {496796400 10800 0 MSK}
+ {512521200 14400 1 MSD}
+ {528246000 10800 0 MSK}
+ {543970800 14400 1 MSD}
+ {559695600 10800 0 MSK}
+ {575420400 14400 1 MSD}
+ {591145200 10800 0 MSK}
+ {606870000 14400 1 MSD}
+ {622594800 10800 0 MSK}
+ {638319600 14400 1 MSD}
+ {654649200 10800 0 MSK}
{670374000 10800 0 EEST}
{686091600 7200 0 EET}
{701820000 10800 1 EEST}
diff --git a/library/tzdata/Europe/Zurich b/library/tzdata/Europe/Zurich
index faa576a..87a20db 100644
--- a/library/tzdata/Europe/Zurich
+++ b/library/tzdata/Europe/Zurich
@@ -1,15 +1,13 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Europe/Zurich) {
{-9223372036854775808 2048 0 LMT}
- {-3827954048 1784 0 BMT}
- {-2385246584 3600 0 CET}
- {-920336400 7200 1 CEST}
- {-915242400 3600 0 CET}
- {-904518000 7200 1 CEST}
- {-891223200 3600 0 CET}
- {-873068400 7200 1 CEST}
- {-859773600 3600 0 CET}
+ {-3675198848 1786 0 BMT}
+ {-2385246586 3600 0 CET}
+ {-904435200 7200 1 CEST}
+ {-891129600 3600 0 CET}
+ {-872985600 7200 1 CEST}
+ {-859680000 3600 0 CET}
{347151600 3600 0 CET}
{354675600 7200 1 CEST}
{370400400 3600 0 CET}
diff --git a/library/tzdata/GB b/library/tzdata/GB
index 1b439d4..72d77ee 100644
--- a/library/tzdata/GB
+++ b/library/tzdata/GB
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/London)]} {
LoadTimeZoneFile Europe/London
}
diff --git a/library/tzdata/GB-Eire b/library/tzdata/GB-Eire
index c02060f..1622417 100644
--- a/library/tzdata/GB-Eire
+++ b/library/tzdata/GB-Eire
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/London)]} {
LoadTimeZoneFile Europe/London
}
diff --git a/library/tzdata/GMT b/library/tzdata/GMT
index bab25c1..4258564 100644
--- a/library/tzdata/GMT
+++ b/library/tzdata/GMT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/GMT+0 b/library/tzdata/GMT+0
index f80e0df..a1e8126 100644
--- a/library/tzdata/GMT+0
+++ b/library/tzdata/GMT+0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/GMT-0 b/library/tzdata/GMT-0
index 56dc64c..04ccafe 100644
--- a/library/tzdata/GMT-0
+++ b/library/tzdata/GMT-0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/GMT0 b/library/tzdata/GMT0
index 88b9f3b..92e95a3 100644
--- a/library/tzdata/GMT0
+++ b/library/tzdata/GMT0
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/Greenwich b/library/tzdata/Greenwich
index 3b2639b..6115233 100644
--- a/library/tzdata/Greenwich
+++ b/library/tzdata/Greenwich
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/GMT)]} {
LoadTimeZoneFile Etc/GMT
}
diff --git a/library/tzdata/HST b/library/tzdata/HST
index a80218e..fea7f14 100644
--- a/library/tzdata/HST
+++ b/library/tzdata/HST
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(Pacific/Honolulu)]} {
- LoadTimeZoneFile Pacific/Honolulu
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:HST) {
+ {-9223372036854775808 -36000 0 HST}
}
-set TZData(:HST) $TZData(:Pacific/Honolulu)
diff --git a/library/tzdata/Hongkong b/library/tzdata/Hongkong
index b0bae23..f9d4dac 100644
--- a/library/tzdata/Hongkong
+++ b/library/tzdata/Hongkong
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Hong_Kong)]} {
LoadTimeZoneFile Asia/Hong_Kong
}
diff --git a/library/tzdata/Iceland b/library/tzdata/Iceland
index 9e4665a..eb3f3eb 100644
--- a/library/tzdata/Iceland
+++ b/library/tzdata/Iceland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Atlantic/Reykjavik)]} {
LoadTimeZoneFile Atlantic/Reykjavik
}
diff --git a/library/tzdata/Indian/Antananarivo b/library/tzdata/Indian/Antananarivo
index 0829892..217715e 100644
--- a/library/tzdata/Indian/Antananarivo
+++ b/library/tzdata/Indian/Antananarivo
@@ -1,8 +1,8 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Antananarivo) {
{-9223372036854775808 11404 0 LMT}
{-1846293004 10800 0 EAT}
- {-499914000 14400 1 EAST}
- {-492051600 10800 0 EAT}
+ {-499924800 14400 1 EAST}
+ {-492062400 10800 0 EAT}
}
diff --git a/library/tzdata/Indian/Chagos b/library/tzdata/Indian/Chagos
index 98bbcd3..a5cec61 100644
--- a/library/tzdata/Indian/Chagos
+++ b/library/tzdata/Indian/Chagos
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Chagos) {
{-9223372036854775808 17380 0 LMT}
diff --git a/library/tzdata/Indian/Christmas b/library/tzdata/Indian/Christmas
index 727d896..c36e973 100644
--- a/library/tzdata/Indian/Christmas
+++ b/library/tzdata/Indian/Christmas
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Christmas) {
{-9223372036854775808 25372 0 LMT}
diff --git a/library/tzdata/Indian/Cocos b/library/tzdata/Indian/Cocos
index d237dfa..a63ae68 100644
--- a/library/tzdata/Indian/Cocos
+++ b/library/tzdata/Indian/Cocos
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Cocos) {
{-9223372036854775808 23260 0 LMT}
diff --git a/library/tzdata/Indian/Comoro b/library/tzdata/Indian/Comoro
index f3f6f87..0b3c33a 100644
--- a/library/tzdata/Indian/Comoro
+++ b/library/tzdata/Indian/Comoro
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Comoro) {
{-9223372036854775808 10384 0 LMT}
diff --git a/library/tzdata/Indian/Kerguelen b/library/tzdata/Indian/Kerguelen
index 964eb94..b41b85a 100644
--- a/library/tzdata/Indian/Kerguelen
+++ b/library/tzdata/Indian/Kerguelen
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Kerguelen) {
{-9223372036854775808 0 0 zzz}
diff --git a/library/tzdata/Indian/Mahe b/library/tzdata/Indian/Mahe
index 2c5c30d..c88a24b 100644
--- a/library/tzdata/Indian/Mahe
+++ b/library/tzdata/Indian/Mahe
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Mahe) {
{-9223372036854775808 13308 0 LMT}
diff --git a/library/tzdata/Indian/Maldives b/library/tzdata/Indian/Maldives
index 5fcf442..2c2c739 100644
--- a/library/tzdata/Indian/Maldives
+++ b/library/tzdata/Indian/Maldives
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Maldives) {
{-9223372036854775808 17640 0 LMT}
diff --git a/library/tzdata/Indian/Mauritius b/library/tzdata/Indian/Mauritius
index 9f2ca7d..a9c07eb 100644
--- a/library/tzdata/Indian/Mauritius
+++ b/library/tzdata/Indian/Mauritius
@@ -1,6 +1,10 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Mauritius) {
{-9223372036854775808 13800 0 LMT}
{-1988164200 14400 0 MUT}
+ {403041600 18000 1 MUST}
+ {417034800 14400 0 MUT}
+ {1224972000 18000 1 MUST}
+ {1238274000 14400 0 MUT}
}
diff --git a/library/tzdata/Indian/Mayotte b/library/tzdata/Indian/Mayotte
index e7c8b4d..0fe5f56 100644
--- a/library/tzdata/Indian/Mayotte
+++ b/library/tzdata/Indian/Mayotte
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Mayotte) {
{-9223372036854775808 10856 0 LMT}
diff --git a/library/tzdata/Indian/Reunion b/library/tzdata/Indian/Reunion
index dbeedc7..de2dd60 100644
--- a/library/tzdata/Indian/Reunion
+++ b/library/tzdata/Indian/Reunion
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Reunion) {
{-9223372036854775808 13312 0 LMT}
diff --git a/library/tzdata/Iran b/library/tzdata/Iran
index 5ddaec3..e200b4d 100644
--- a/library/tzdata/Iran
+++ b/library/tzdata/Iran
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Tehran)]} {
LoadTimeZoneFile Asia/Tehran
}
diff --git a/library/tzdata/Israel b/library/tzdata/Israel
index 80b4a87..af521f5 100644
--- a/library/tzdata/Israel
+++ b/library/tzdata/Israel
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Jerusalem)]} {
LoadTimeZoneFile Asia/Jerusalem
}
diff --git a/library/tzdata/Jamaica b/library/tzdata/Jamaica
index b1d450a..ddb5d45 100644
--- a/library/tzdata/Jamaica
+++ b/library/tzdata/Jamaica
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Jamaica)]} {
LoadTimeZoneFile America/Jamaica
}
diff --git a/library/tzdata/Japan b/library/tzdata/Japan
index 5c7651e..428a79f 100644
--- a/library/tzdata/Japan
+++ b/library/tzdata/Japan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Tokyo)]} {
LoadTimeZoneFile Asia/Tokyo
}
diff --git a/library/tzdata/Kwajalein b/library/tzdata/Kwajalein
index 7dc2e0a..586db6d 100644
--- a/library/tzdata/Kwajalein
+++ b/library/tzdata/Kwajalein
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Kwajalein)]} {
LoadTimeZoneFile Pacific/Kwajalein
}
diff --git a/library/tzdata/Libya b/library/tzdata/Libya
index b125101..6cd77e1 100644
--- a/library/tzdata/Libya
+++ b/library/tzdata/Libya
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Tripoli)]} {
LoadTimeZoneFile Africa/Tripoli
}
diff --git a/library/tzdata/MET b/library/tzdata/MET
index 04bf664..8789c97 100644
--- a/library/tzdata/MET
+++ b/library/tzdata/MET
@@ -1,263 +1,265 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:MET) {
{-9223372036854775808 3600 0 MET}
{-1693706400 7200 1 MEST}
{-1680483600 3600 0 MET}
- {-1663452000 7200 1 MEST}
- {-1650146400 3600 0 MET}
- {-1632002400 7200 1 MEST}
- {-1618696800 3600 0 MET}
- {-938901600 7200 1 MEST}
- {-857253600 3600 0 MET}
- {-844552800 7200 1 MEST}
- {-828223200 3600 0 MET}
- {-812498400 7200 1 MEST}
- {-796773600 3600 0 MET}
- {228880800 7200 1 MEST}
- {244000800 3600 0 MET}
- {260330400 7200 1 MEST}
- {276055200 3600 0 MET}
- {291780000 7200 1 MEST}
- {307504800 3600 0 MET}
- {323834400 7200 1 MEST}
- {338954400 3600 0 MET}
- {354679200 7200 1 MEST}
- {370404000 3600 0 MET}
- {386128800 7200 1 MEST}
- {401853600 3600 0 MET}
- {417578400 7200 1 MEST}
- {433303200 3600 0 MET}
- {449028000 7200 1 MEST}
- {465357600 3600 0 MET}
- {481082400 7200 1 MEST}
- {496807200 3600 0 MET}
- {512532000 7200 1 MEST}
- {528256800 3600 0 MET}
- {543981600 7200 1 MEST}
- {559706400 3600 0 MET}
- {575431200 7200 1 MEST}
- {591156000 3600 0 MET}
- {606880800 7200 1 MEST}
- {622605600 3600 0 MET}
- {638330400 7200 1 MEST}
- {654660000 3600 0 MET}
- {670384800 7200 1 MEST}
- {686109600 3600 0 MET}
- {701834400 7200 1 MEST}
- {717559200 3600 0 MET}
- {733284000 7200 1 MEST}
- {749008800 3600 0 MET}
- {764733600 7200 1 MEST}
- {780458400 3600 0 MET}
- {796183200 7200 1 MEST}
- {811908000 3600 0 MET}
- {828237600 7200 1 MEST}
- {846381600 3600 0 MET}
- {859687200 7200 1 MEST}
- {877831200 3600 0 MET}
- {891136800 7200 1 MEST}
- {909280800 3600 0 MET}
- {922586400 7200 1 MEST}
- {941335200 3600 0 MET}
- {954036000 7200 1 MEST}
- {972784800 3600 0 MET}
- {985485600 7200 1 MEST}
- {1004234400 3600 0 MET}
- {1017540000 7200 1 MEST}
- {1035684000 3600 0 MET}
- {1048989600 7200 1 MEST}
- {1067133600 3600 0 MET}
- {1080439200 7200 1 MEST}
- {1099188000 3600 0 MET}
- {1111888800 7200 1 MEST}
- {1130637600 3600 0 MET}
- {1143338400 7200 1 MEST}
- {1162087200 3600 0 MET}
- {1174788000 7200 1 MEST}
- {1193536800 3600 0 MET}
- {1206842400 7200 1 MEST}
- {1224986400 3600 0 MET}
- {1238292000 7200 1 MEST}
- {1256436000 3600 0 MET}
- {1269741600 7200 1 MEST}
- {1288490400 3600 0 MET}
- {1301191200 7200 1 MEST}
- {1319940000 3600 0 MET}
- {1332640800 7200 1 MEST}
- {1351389600 3600 0 MET}
- {1364695200 7200 1 MEST}
- {1382839200 3600 0 MET}
- {1396144800 7200 1 MEST}
- {1414288800 3600 0 MET}
- {1427594400 7200 1 MEST}
- {1445738400 3600 0 MET}
- {1459044000 7200 1 MEST}
- {1477792800 3600 0 MET}
- {1490493600 7200 1 MEST}
- {1509242400 3600 0 MET}
- {1521943200 7200 1 MEST}
- {1540692000 3600 0 MET}
- {1553997600 7200 1 MEST}
- {1572141600 3600 0 MET}
- {1585447200 7200 1 MEST}
- {1603591200 3600 0 MET}
- {1616896800 7200 1 MEST}
- {1635645600 3600 0 MET}
- {1648346400 7200 1 MEST}
- {1667095200 3600 0 MET}
- {1679796000 7200 1 MEST}
- {1698544800 3600 0 MET}
- {1711850400 7200 1 MEST}
- {1729994400 3600 0 MET}
- {1743300000 7200 1 MEST}
- {1761444000 3600 0 MET}
- {1774749600 7200 1 MEST}
- {1792893600 3600 0 MET}
- {1806199200 7200 1 MEST}
- {1824948000 3600 0 MET}
- {1837648800 7200 1 MEST}
- {1856397600 3600 0 MET}
- {1869098400 7200 1 MEST}
- {1887847200 3600 0 MET}
- {1901152800 7200 1 MEST}
- {1919296800 3600 0 MET}
- {1932602400 7200 1 MEST}
- {1950746400 3600 0 MET}
- {1964052000 7200 1 MEST}
- {1982800800 3600 0 MET}
- {1995501600 7200 1 MEST}
- {2014250400 3600 0 MET}
- {2026951200 7200 1 MEST}
- {2045700000 3600 0 MET}
- {2058400800 7200 1 MEST}
- {2077149600 3600 0 MET}
- {2090455200 7200 1 MEST}
- {2108599200 3600 0 MET}
- {2121904800 7200 1 MEST}
- {2140048800 3600 0 MET}
- {2153354400 7200 1 MEST}
- {2172103200 3600 0 MET}
- {2184804000 7200 1 MEST}
- {2203552800 3600 0 MET}
- {2216253600 7200 1 MEST}
- {2235002400 3600 0 MET}
- {2248308000 7200 1 MEST}
- {2266452000 3600 0 MET}
- {2279757600 7200 1 MEST}
- {2297901600 3600 0 MET}
- {2311207200 7200 1 MEST}
- {2329351200 3600 0 MET}
- {2342656800 7200 1 MEST}
- {2361405600 3600 0 MET}
- {2374106400 7200 1 MEST}
- {2392855200 3600 0 MET}
- {2405556000 7200 1 MEST}
- {2424304800 3600 0 MET}
- {2437610400 7200 1 MEST}
- {2455754400 3600 0 MET}
- {2469060000 7200 1 MEST}
- {2487204000 3600 0 MET}
- {2500509600 7200 1 MEST}
- {2519258400 3600 0 MET}
- {2531959200 7200 1 MEST}
- {2550708000 3600 0 MET}
- {2563408800 7200 1 MEST}
- {2582157600 3600 0 MET}
- {2595463200 7200 1 MEST}
- {2613607200 3600 0 MET}
- {2626912800 7200 1 MEST}
- {2645056800 3600 0 MET}
- {2658362400 7200 1 MEST}
- {2676506400 3600 0 MET}
- {2689812000 7200 1 MEST}
- {2708560800 3600 0 MET}
- {2721261600 7200 1 MEST}
- {2740010400 3600 0 MET}
- {2752711200 7200 1 MEST}
- {2771460000 3600 0 MET}
- {2784765600 7200 1 MEST}
- {2802909600 3600 0 MET}
- {2816215200 7200 1 MEST}
- {2834359200 3600 0 MET}
- {2847664800 7200 1 MEST}
- {2866413600 3600 0 MET}
- {2879114400 7200 1 MEST}
- {2897863200 3600 0 MET}
- {2910564000 7200 1 MEST}
- {2929312800 3600 0 MET}
- {2942013600 7200 1 MEST}
- {2960762400 3600 0 MET}
- {2974068000 7200 1 MEST}
- {2992212000 3600 0 MET}
- {3005517600 7200 1 MEST}
- {3023661600 3600 0 MET}
- {3036967200 7200 1 MEST}
- {3055716000 3600 0 MET}
- {3068416800 7200 1 MEST}
- {3087165600 3600 0 MET}
- {3099866400 7200 1 MEST}
- {3118615200 3600 0 MET}
- {3131920800 7200 1 MEST}
- {3150064800 3600 0 MET}
- {3163370400 7200 1 MEST}
- {3181514400 3600 0 MET}
- {3194820000 7200 1 MEST}
- {3212964000 3600 0 MET}
- {3226269600 7200 1 MEST}
- {3245018400 3600 0 MET}
- {3257719200 7200 1 MEST}
- {3276468000 3600 0 MET}
- {3289168800 7200 1 MEST}
- {3307917600 3600 0 MET}
- {3321223200 7200 1 MEST}
- {3339367200 3600 0 MET}
- {3352672800 7200 1 MEST}
- {3370816800 3600 0 MET}
- {3384122400 7200 1 MEST}
- {3402871200 3600 0 MET}
- {3415572000 7200 1 MEST}
- {3434320800 3600 0 MET}
- {3447021600 7200 1 MEST}
- {3465770400 3600 0 MET}
- {3479076000 7200 1 MEST}
- {3497220000 3600 0 MET}
- {3510525600 7200 1 MEST}
- {3528669600 3600 0 MET}
- {3541975200 7200 1 MEST}
- {3560119200 3600 0 MET}
- {3573424800 7200 1 MEST}
- {3592173600 3600 0 MET}
- {3604874400 7200 1 MEST}
- {3623623200 3600 0 MET}
- {3636324000 7200 1 MEST}
- {3655072800 3600 0 MET}
- {3668378400 7200 1 MEST}
- {3686522400 3600 0 MET}
- {3699828000 7200 1 MEST}
- {3717972000 3600 0 MET}
- {3731277600 7200 1 MEST}
- {3750026400 3600 0 MET}
- {3762727200 7200 1 MEST}
- {3781476000 3600 0 MET}
- {3794176800 7200 1 MEST}
- {3812925600 3600 0 MET}
- {3825626400 7200 1 MEST}
- {3844375200 3600 0 MET}
- {3857680800 7200 1 MEST}
- {3875824800 3600 0 MET}
- {3889130400 7200 1 MEST}
- {3907274400 3600 0 MET}
- {3920580000 7200 1 MEST}
- {3939328800 3600 0 MET}
- {3952029600 7200 1 MEST}
- {3970778400 3600 0 MET}
- {3983479200 7200 1 MEST}
- {4002228000 3600 0 MET}
- {4015533600 7200 1 MEST}
- {4033677600 3600 0 MET}
- {4046983200 7200 1 MEST}
- {4065127200 3600 0 MET}
- {4078432800 7200 1 MEST}
- {4096576800 3600 0 MET}
+ {-1663455600 7200 1 MEST}
+ {-1650150000 3600 0 MET}
+ {-1632006000 7200 1 MEST}
+ {-1618700400 3600 0 MET}
+ {-938905200 7200 1 MEST}
+ {-857257200 3600 0 MET}
+ {-844556400 7200 1 MEST}
+ {-828226800 3600 0 MET}
+ {-812502000 7200 1 MEST}
+ {-796777200 3600 0 MET}
+ {-781052400 7200 1 MEST}
+ {-766623600 3600 0 MET}
+ {228877200 7200 1 MEST}
+ {243997200 3600 0 MET}
+ {260326800 7200 1 MEST}
+ {276051600 3600 0 MET}
+ {291776400 7200 1 MEST}
+ {307501200 3600 0 MET}
+ {323830800 7200 1 MEST}
+ {338950800 3600 0 MET}
+ {354675600 7200 1 MEST}
+ {370400400 3600 0 MET}
+ {386125200 7200 1 MEST}
+ {401850000 3600 0 MET}
+ {417574800 7200 1 MEST}
+ {433299600 3600 0 MET}
+ {449024400 7200 1 MEST}
+ {465354000 3600 0 MET}
+ {481078800 7200 1 MEST}
+ {496803600 3600 0 MET}
+ {512528400 7200 1 MEST}
+ {528253200 3600 0 MET}
+ {543978000 7200 1 MEST}
+ {559702800 3600 0 MET}
+ {575427600 7200 1 MEST}
+ {591152400 3600 0 MET}
+ {606877200 7200 1 MEST}
+ {622602000 3600 0 MET}
+ {638326800 7200 1 MEST}
+ {654656400 3600 0 MET}
+ {670381200 7200 1 MEST}
+ {686106000 3600 0 MET}
+ {701830800 7200 1 MEST}
+ {717555600 3600 0 MET}
+ {733280400 7200 1 MEST}
+ {749005200 3600 0 MET}
+ {764730000 7200 1 MEST}
+ {780454800 3600 0 MET}
+ {796179600 7200 1 MEST}
+ {811904400 3600 0 MET}
+ {828234000 7200 1 MEST}
+ {846378000 3600 0 MET}
+ {859683600 7200 1 MEST}
+ {877827600 3600 0 MET}
+ {891133200 7200 1 MEST}
+ {909277200 3600 0 MET}
+ {922582800 7200 1 MEST}
+ {941331600 3600 0 MET}
+ {954032400 7200 1 MEST}
+ {972781200 3600 0 MET}
+ {985482000 7200 1 MEST}
+ {1004230800 3600 0 MET}
+ {1017536400 7200 1 MEST}
+ {1035680400 3600 0 MET}
+ {1048986000 7200 1 MEST}
+ {1067130000 3600 0 MET}
+ {1080435600 7200 1 MEST}
+ {1099184400 3600 0 MET}
+ {1111885200 7200 1 MEST}
+ {1130634000 3600 0 MET}
+ {1143334800 7200 1 MEST}
+ {1162083600 3600 0 MET}
+ {1174784400 7200 1 MEST}
+ {1193533200 3600 0 MET}
+ {1206838800 7200 1 MEST}
+ {1224982800 3600 0 MET}
+ {1238288400 7200 1 MEST}
+ {1256432400 3600 0 MET}
+ {1269738000 7200 1 MEST}
+ {1288486800 3600 0 MET}
+ {1301187600 7200 1 MEST}
+ {1319936400 3600 0 MET}
+ {1332637200 7200 1 MEST}
+ {1351386000 3600 0 MET}
+ {1364691600 7200 1 MEST}
+ {1382835600 3600 0 MET}
+ {1396141200 7200 1 MEST}
+ {1414285200 3600 0 MET}
+ {1427590800 7200 1 MEST}
+ {1445734800 3600 0 MET}
+ {1459040400 7200 1 MEST}
+ {1477789200 3600 0 MET}
+ {1490490000 7200 1 MEST}
+ {1509238800 3600 0 MET}
+ {1521939600 7200 1 MEST}
+ {1540688400 3600 0 MET}
+ {1553994000 7200 1 MEST}
+ {1572138000 3600 0 MET}
+ {1585443600 7200 1 MEST}
+ {1603587600 3600 0 MET}
+ {1616893200 7200 1 MEST}
+ {1635642000 3600 0 MET}
+ {1648342800 7200 1 MEST}
+ {1667091600 3600 0 MET}
+ {1679792400 7200 1 MEST}
+ {1698541200 3600 0 MET}
+ {1711846800 7200 1 MEST}
+ {1729990800 3600 0 MET}
+ {1743296400 7200 1 MEST}
+ {1761440400 3600 0 MET}
+ {1774746000 7200 1 MEST}
+ {1792890000 3600 0 MET}
+ {1806195600 7200 1 MEST}
+ {1824944400 3600 0 MET}
+ {1837645200 7200 1 MEST}
+ {1856394000 3600 0 MET}
+ {1869094800 7200 1 MEST}
+ {1887843600 3600 0 MET}
+ {1901149200 7200 1 MEST}
+ {1919293200 3600 0 MET}
+ {1932598800 7200 1 MEST}
+ {1950742800 3600 0 MET}
+ {1964048400 7200 1 MEST}
+ {1982797200 3600 0 MET}
+ {1995498000 7200 1 MEST}
+ {2014246800 3600 0 MET}
+ {2026947600 7200 1 MEST}
+ {2045696400 3600 0 MET}
+ {2058397200 7200 1 MEST}
+ {2077146000 3600 0 MET}
+ {2090451600 7200 1 MEST}
+ {2108595600 3600 0 MET}
+ {2121901200 7200 1 MEST}
+ {2140045200 3600 0 MET}
+ {2153350800 7200 1 MEST}
+ {2172099600 3600 0 MET}
+ {2184800400 7200 1 MEST}
+ {2203549200 3600 0 MET}
+ {2216250000 7200 1 MEST}
+ {2234998800 3600 0 MET}
+ {2248304400 7200 1 MEST}
+ {2266448400 3600 0 MET}
+ {2279754000 7200 1 MEST}
+ {2297898000 3600 0 MET}
+ {2311203600 7200 1 MEST}
+ {2329347600 3600 0 MET}
+ {2342653200 7200 1 MEST}
+ {2361402000 3600 0 MET}
+ {2374102800 7200 1 MEST}
+ {2392851600 3600 0 MET}
+ {2405552400 7200 1 MEST}
+ {2424301200 3600 0 MET}
+ {2437606800 7200 1 MEST}
+ {2455750800 3600 0 MET}
+ {2469056400 7200 1 MEST}
+ {2487200400 3600 0 MET}
+ {2500506000 7200 1 MEST}
+ {2519254800 3600 0 MET}
+ {2531955600 7200 1 MEST}
+ {2550704400 3600 0 MET}
+ {2563405200 7200 1 MEST}
+ {2582154000 3600 0 MET}
+ {2595459600 7200 1 MEST}
+ {2613603600 3600 0 MET}
+ {2626909200 7200 1 MEST}
+ {2645053200 3600 0 MET}
+ {2658358800 7200 1 MEST}
+ {2676502800 3600 0 MET}
+ {2689808400 7200 1 MEST}
+ {2708557200 3600 0 MET}
+ {2721258000 7200 1 MEST}
+ {2740006800 3600 0 MET}
+ {2752707600 7200 1 MEST}
+ {2771456400 3600 0 MET}
+ {2784762000 7200 1 MEST}
+ {2802906000 3600 0 MET}
+ {2816211600 7200 1 MEST}
+ {2834355600 3600 0 MET}
+ {2847661200 7200 1 MEST}
+ {2866410000 3600 0 MET}
+ {2879110800 7200 1 MEST}
+ {2897859600 3600 0 MET}
+ {2910560400 7200 1 MEST}
+ {2929309200 3600 0 MET}
+ {2942010000 7200 1 MEST}
+ {2960758800 3600 0 MET}
+ {2974064400 7200 1 MEST}
+ {2992208400 3600 0 MET}
+ {3005514000 7200 1 MEST}
+ {3023658000 3600 0 MET}
+ {3036963600 7200 1 MEST}
+ {3055712400 3600 0 MET}
+ {3068413200 7200 1 MEST}
+ {3087162000 3600 0 MET}
+ {3099862800 7200 1 MEST}
+ {3118611600 3600 0 MET}
+ {3131917200 7200 1 MEST}
+ {3150061200 3600 0 MET}
+ {3163366800 7200 1 MEST}
+ {3181510800 3600 0 MET}
+ {3194816400 7200 1 MEST}
+ {3212960400 3600 0 MET}
+ {3226266000 7200 1 MEST}
+ {3245014800 3600 0 MET}
+ {3257715600 7200 1 MEST}
+ {3276464400 3600 0 MET}
+ {3289165200 7200 1 MEST}
+ {3307914000 3600 0 MET}
+ {3321219600 7200 1 MEST}
+ {3339363600 3600 0 MET}
+ {3352669200 7200 1 MEST}
+ {3370813200 3600 0 MET}
+ {3384118800 7200 1 MEST}
+ {3402867600 3600 0 MET}
+ {3415568400 7200 1 MEST}
+ {3434317200 3600 0 MET}
+ {3447018000 7200 1 MEST}
+ {3465766800 3600 0 MET}
+ {3479072400 7200 1 MEST}
+ {3497216400 3600 0 MET}
+ {3510522000 7200 1 MEST}
+ {3528666000 3600 0 MET}
+ {3541971600 7200 1 MEST}
+ {3560115600 3600 0 MET}
+ {3573421200 7200 1 MEST}
+ {3592170000 3600 0 MET}
+ {3604870800 7200 1 MEST}
+ {3623619600 3600 0 MET}
+ {3636320400 7200 1 MEST}
+ {3655069200 3600 0 MET}
+ {3668374800 7200 1 MEST}
+ {3686518800 3600 0 MET}
+ {3699824400 7200 1 MEST}
+ {3717968400 3600 0 MET}
+ {3731274000 7200 1 MEST}
+ {3750022800 3600 0 MET}
+ {3762723600 7200 1 MEST}
+ {3781472400 3600 0 MET}
+ {3794173200 7200 1 MEST}
+ {3812922000 3600 0 MET}
+ {3825622800 7200 1 MEST}
+ {3844371600 3600 0 MET}
+ {3857677200 7200 1 MEST}
+ {3875821200 3600 0 MET}
+ {3889126800 7200 1 MEST}
+ {3907270800 3600 0 MET}
+ {3920576400 7200 1 MEST}
+ {3939325200 3600 0 MET}
+ {3952026000 7200 1 MEST}
+ {3970774800 3600 0 MET}
+ {3983475600 7200 1 MEST}
+ {4002224400 3600 0 MET}
+ {4015530000 7200 1 MEST}
+ {4033674000 3600 0 MET}
+ {4046979600 7200 1 MEST}
+ {4065123600 3600 0 MET}
+ {4078429200 7200 1 MEST}
+ {4096573200 3600 0 MET}
}
diff --git a/library/tzdata/MST b/library/tzdata/MST
index fbaf29c..8c967ab 100644
--- a/library/tzdata/MST
+++ b/library/tzdata/MST
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Phoenix)]} {
- LoadTimeZoneFile America/Phoenix
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:MST) {
+ {-9223372036854775808 -25200 0 MST}
}
-set TZData(:MST) $TZData(:America/Phoenix)
diff --git a/library/tzdata/MST7MDT b/library/tzdata/MST7MDT
index c14a860..ff52048 100644
--- a/library/tzdata/MST7MDT
+++ b/library/tzdata/MST7MDT
@@ -1,5 +1,278 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Denver)]} {
- LoadTimeZoneFile America/Denver
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:MST7MDT) {
+ {-9223372036854775808 -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}
+ {1289116800 -25200 0 MST}
+ {1300006800 -21600 1 MDT}
+ {1320566400 -25200 0 MST}
+ {1331456400 -21600 1 MDT}
+ {1352016000 -25200 0 MST}
+ {1362906000 -21600 1 MDT}
+ {1383465600 -25200 0 MST}
+ {1394355600 -21600 1 MDT}
+ {1414915200 -25200 0 MST}
+ {1425805200 -21600 1 MDT}
+ {1446364800 -25200 0 MST}
+ {1457859600 -21600 1 MDT}
+ {1478419200 -25200 0 MST}
+ {1489309200 -21600 1 MDT}
+ {1509868800 -25200 0 MST}
+ {1520758800 -21600 1 MDT}
+ {1541318400 -25200 0 MST}
+ {1552208400 -21600 1 MDT}
+ {1572768000 -25200 0 MST}
+ {1583658000 -21600 1 MDT}
+ {1604217600 -25200 0 MST}
+ {1615712400 -21600 1 MDT}
+ {1636272000 -25200 0 MST}
+ {1647162000 -21600 1 MDT}
+ {1667721600 -25200 0 MST}
+ {1678611600 -21600 1 MDT}
+ {1699171200 -25200 0 MST}
+ {1710061200 -21600 1 MDT}
+ {1730620800 -25200 0 MST}
+ {1741510800 -21600 1 MDT}
+ {1762070400 -25200 0 MST}
+ {1772960400 -21600 1 MDT}
+ {1793520000 -25200 0 MST}
+ {1805014800 -21600 1 MDT}
+ {1825574400 -25200 0 MST}
+ {1836464400 -21600 1 MDT}
+ {1857024000 -25200 0 MST}
+ {1867914000 -21600 1 MDT}
+ {1888473600 -25200 0 MST}
+ {1899363600 -21600 1 MDT}
+ {1919923200 -25200 0 MST}
+ {1930813200 -21600 1 MDT}
+ {1951372800 -25200 0 MST}
+ {1962867600 -21600 1 MDT}
+ {1983427200 -25200 0 MST}
+ {1994317200 -21600 1 MDT}
+ {2014876800 -25200 0 MST}
+ {2025766800 -21600 1 MDT}
+ {2046326400 -25200 0 MST}
+ {2057216400 -21600 1 MDT}
+ {2077776000 -25200 0 MST}
+ {2088666000 -21600 1 MDT}
+ {2109225600 -25200 0 MST}
+ {2120115600 -21600 1 MDT}
+ {2140675200 -25200 0 MST}
+ {2152170000 -21600 1 MDT}
+ {2172729600 -25200 0 MST}
+ {2183619600 -21600 1 MDT}
+ {2204179200 -25200 0 MST}
+ {2215069200 -21600 1 MDT}
+ {2235628800 -25200 0 MST}
+ {2246518800 -21600 1 MDT}
+ {2267078400 -25200 0 MST}
+ {2277968400 -21600 1 MDT}
+ {2298528000 -25200 0 MST}
+ {2309418000 -21600 1 MDT}
+ {2329977600 -25200 0 MST}
+ {2341472400 -21600 1 MDT}
+ {2362032000 -25200 0 MST}
+ {2372922000 -21600 1 MDT}
+ {2393481600 -25200 0 MST}
+ {2404371600 -21600 1 MDT}
+ {2424931200 -25200 0 MST}
+ {2435821200 -21600 1 MDT}
+ {2456380800 -25200 0 MST}
+ {2467270800 -21600 1 MDT}
+ {2487830400 -25200 0 MST}
+ {2499325200 -21600 1 MDT}
+ {2519884800 -25200 0 MST}
+ {2530774800 -21600 1 MDT}
+ {2551334400 -25200 0 MST}
+ {2562224400 -21600 1 MDT}
+ {2582784000 -25200 0 MST}
+ {2593674000 -21600 1 MDT}
+ {2614233600 -25200 0 MST}
+ {2625123600 -21600 1 MDT}
+ {2645683200 -25200 0 MST}
+ {2656573200 -21600 1 MDT}
+ {2677132800 -25200 0 MST}
+ {2688627600 -21600 1 MDT}
+ {2709187200 -25200 0 MST}
+ {2720077200 -21600 1 MDT}
+ {2740636800 -25200 0 MST}
+ {2751526800 -21600 1 MDT}
+ {2772086400 -25200 0 MST}
+ {2782976400 -21600 1 MDT}
+ {2803536000 -25200 0 MST}
+ {2814426000 -21600 1 MDT}
+ {2834985600 -25200 0 MST}
+ {2846480400 -21600 1 MDT}
+ {2867040000 -25200 0 MST}
+ {2877930000 -21600 1 MDT}
+ {2898489600 -25200 0 MST}
+ {2909379600 -21600 1 MDT}
+ {2929939200 -25200 0 MST}
+ {2940829200 -21600 1 MDT}
+ {2961388800 -25200 0 MST}
+ {2972278800 -21600 1 MDT}
+ {2992838400 -25200 0 MST}
+ {3003728400 -21600 1 MDT}
+ {3024288000 -25200 0 MST}
+ {3035782800 -21600 1 MDT}
+ {3056342400 -25200 0 MST}
+ {3067232400 -21600 1 MDT}
+ {3087792000 -25200 0 MST}
+ {3098682000 -21600 1 MDT}
+ {3119241600 -25200 0 MST}
+ {3130131600 -21600 1 MDT}
+ {3150691200 -25200 0 MST}
+ {3161581200 -21600 1 MDT}
+ {3182140800 -25200 0 MST}
+ {3193030800 -21600 1 MDT}
+ {3213590400 -25200 0 MST}
+ {3225085200 -21600 1 MDT}
+ {3245644800 -25200 0 MST}
+ {3256534800 -21600 1 MDT}
+ {3277094400 -25200 0 MST}
+ {3287984400 -21600 1 MDT}
+ {3308544000 -25200 0 MST}
+ {3319434000 -21600 1 MDT}
+ {3339993600 -25200 0 MST}
+ {3350883600 -21600 1 MDT}
+ {3371443200 -25200 0 MST}
+ {3382938000 -21600 1 MDT}
+ {3403497600 -25200 0 MST}
+ {3414387600 -21600 1 MDT}
+ {3434947200 -25200 0 MST}
+ {3445837200 -21600 1 MDT}
+ {3466396800 -25200 0 MST}
+ {3477286800 -21600 1 MDT}
+ {3497846400 -25200 0 MST}
+ {3508736400 -21600 1 MDT}
+ {3529296000 -25200 0 MST}
+ {3540186000 -21600 1 MDT}
+ {3560745600 -25200 0 MST}
+ {3572240400 -21600 1 MDT}
+ {3592800000 -25200 0 MST}
+ {3603690000 -21600 1 MDT}
+ {3624249600 -25200 0 MST}
+ {3635139600 -21600 1 MDT}
+ {3655699200 -25200 0 MST}
+ {3666589200 -21600 1 MDT}
+ {3687148800 -25200 0 MST}
+ {3698038800 -21600 1 MDT}
+ {3718598400 -25200 0 MST}
+ {3730093200 -21600 1 MDT}
+ {3750652800 -25200 0 MST}
+ {3761542800 -21600 1 MDT}
+ {3782102400 -25200 0 MST}
+ {3792992400 -21600 1 MDT}
+ {3813552000 -25200 0 MST}
+ {3824442000 -21600 1 MDT}
+ {3845001600 -25200 0 MST}
+ {3855891600 -21600 1 MDT}
+ {3876451200 -25200 0 MST}
+ {3887341200 -21600 1 MDT}
+ {3907900800 -25200 0 MST}
+ {3919395600 -21600 1 MDT}
+ {3939955200 -25200 0 MST}
+ {3950845200 -21600 1 MDT}
+ {3971404800 -25200 0 MST}
+ {3982294800 -21600 1 MDT}
+ {4002854400 -25200 0 MST}
+ {4013744400 -21600 1 MDT}
+ {4034304000 -25200 0 MST}
+ {4045194000 -21600 1 MDT}
+ {4065753600 -25200 0 MST}
+ {4076643600 -21600 1 MDT}
+ {4097203200 -25200 0 MST}
}
-set TZData(:MST7MDT) $TZData(:America/Denver)
diff --git a/library/tzdata/Mexico/BajaNorte b/library/tzdata/Mexico/BajaNorte
index ca7724d..8f6f459 100644
--- a/library/tzdata/Mexico/BajaNorte
+++ b/library/tzdata/Mexico/BajaNorte
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Tijuana)]} {
LoadTimeZoneFile America/Tijuana
}
diff --git a/library/tzdata/Mexico/BajaSur b/library/tzdata/Mexico/BajaSur
index 7dedbc6..6d335a1 100644
--- a/library/tzdata/Mexico/BajaSur
+++ b/library/tzdata/Mexico/BajaSur
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Mazatlan)]} {
LoadTimeZoneFile America/Mazatlan
}
diff --git a/library/tzdata/Mexico/General b/library/tzdata/Mexico/General
index 3d07654..0cac92f 100644
--- a/library/tzdata/Mexico/General
+++ b/library/tzdata/Mexico/General
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Mexico_City)]} {
LoadTimeZoneFile America/Mexico_City
}
diff --git a/library/tzdata/NZ b/library/tzdata/NZ
index 03963e3..36d22a7 100644
--- a/library/tzdata/NZ
+++ b/library/tzdata/NZ
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Auckland)]} {
LoadTimeZoneFile Pacific/Auckland
}
diff --git a/library/tzdata/NZ-CHAT b/library/tzdata/NZ-CHAT
index 842c028..7f7c918 100644
--- a/library/tzdata/NZ-CHAT
+++ b/library/tzdata/NZ-CHAT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Chatham)]} {
LoadTimeZoneFile Pacific/Chatham
}
diff --git a/library/tzdata/Navajo b/library/tzdata/Navajo
index 594f177..78cc2e2 100644
--- a/library/tzdata/Navajo
+++ b/library/tzdata/Navajo
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Denver)]} {
LoadTimeZoneFile America/Denver
}
diff --git a/library/tzdata/PRC b/library/tzdata/PRC
index c9ebc77..1d8bb7c 100644
--- a/library/tzdata/PRC
+++ b/library/tzdata/PRC
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Shanghai)]} {
LoadTimeZoneFile Asia/Shanghai
}
diff --git a/library/tzdata/PST8PDT b/library/tzdata/PST8PDT
index cc5b487..87a94da 100644
--- a/library/tzdata/PST8PDT
+++ b/library/tzdata/PST8PDT
@@ -1,5 +1,278 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Los_Angeles)]} {
- LoadTimeZoneFile America/Los_Angeles
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:PST8PDT) {
+ {-9223372036854775808 -28800 0 PST}
+ {-1633269600 -25200 1 PDT}
+ {-1615129200 -28800 0 PST}
+ {-1601820000 -25200 1 PDT}
+ {-1583679600 -28800 0 PST}
+ {-880207200 -25200 1 PWT}
+ {-769395600 -25200 1 PPT}
+ {-765385200 -28800 0 PST}
+ {-84376800 -25200 1 PDT}
+ {-68655600 -28800 0 PST}
+ {-52927200 -25200 1 PDT}
+ {-37206000 -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}
+ {436352400 -28800 0 PST}
+ {452080800 -25200 1 PDT}
+ {467802000 -28800 0 PST}
+ {483530400 -25200 1 PDT}
+ {499251600 -28800 0 PST}
+ {514980000 -25200 1 PDT}
+ {530701200 -28800 0 PST}
+ {544615200 -25200 1 PDT}
+ {562150800 -28800 0 PST}
+ {576064800 -25200 1 PDT}
+ {594205200 -28800 0 PST}
+ {607514400 -25200 1 PDT}
+ {625654800 -28800 0 PST}
+ {638964000 -25200 1 PDT}
+ {657104400 -28800 0 PST}
+ {671018400 -25200 1 PDT}
+ {688554000 -28800 0 PST}
+ {702468000 -25200 1 PDT}
+ {720003600 -28800 0 PST}
+ {733917600 -25200 1 PDT}
+ {752058000 -28800 0 PST}
+ {765367200 -25200 1 PDT}
+ {783507600 -28800 0 PST}
+ {796816800 -25200 1 PDT}
+ {814957200 -28800 0 PST}
+ {828871200 -25200 1 PDT}
+ {846406800 -28800 0 PST}
+ {860320800 -25200 1 PDT}
+ {877856400 -28800 0 PST}
+ {891770400 -25200 1 PDT}
+ {909306000 -28800 0 PST}
+ {923220000 -25200 1 PDT}
+ {941360400 -28800 0 PST}
+ {954669600 -25200 1 PDT}
+ {972810000 -28800 0 PST}
+ {986119200 -25200 1 PDT}
+ {1004259600 -28800 0 PST}
+ {1018173600 -25200 1 PDT}
+ {1035709200 -28800 0 PST}
+ {1049623200 -25200 1 PDT}
+ {1067158800 -28800 0 PST}
+ {1081072800 -25200 1 PDT}
+ {1099213200 -28800 0 PST}
+ {1112522400 -25200 1 PDT}
+ {1130662800 -28800 0 PST}
+ {1143972000 -25200 1 PDT}
+ {1162112400 -28800 0 PST}
+ {1173607200 -25200 1 PDT}
+ {1194166800 -28800 0 PST}
+ {1205056800 -25200 1 PDT}
+ {1225616400 -28800 0 PST}
+ {1236506400 -25200 1 PDT}
+ {1257066000 -28800 0 PST}
+ {1268560800 -25200 1 PDT}
+ {1289120400 -28800 0 PST}
+ {1300010400 -25200 1 PDT}
+ {1320570000 -28800 0 PST}
+ {1331460000 -25200 1 PDT}
+ {1352019600 -28800 0 PST}
+ {1362909600 -25200 1 PDT}
+ {1383469200 -28800 0 PST}
+ {1394359200 -25200 1 PDT}
+ {1414918800 -28800 0 PST}
+ {1425808800 -25200 1 PDT}
+ {1446368400 -28800 0 PST}
+ {1457863200 -25200 1 PDT}
+ {1478422800 -28800 0 PST}
+ {1489312800 -25200 1 PDT}
+ {1509872400 -28800 0 PST}
+ {1520762400 -25200 1 PDT}
+ {1541322000 -28800 0 PST}
+ {1552212000 -25200 1 PDT}
+ {1572771600 -28800 0 PST}
+ {1583661600 -25200 1 PDT}
+ {1604221200 -28800 0 PST}
+ {1615716000 -25200 1 PDT}
+ {1636275600 -28800 0 PST}
+ {1647165600 -25200 1 PDT}
+ {1667725200 -28800 0 PST}
+ {1678615200 -25200 1 PDT}
+ {1699174800 -28800 0 PST}
+ {1710064800 -25200 1 PDT}
+ {1730624400 -28800 0 PST}
+ {1741514400 -25200 1 PDT}
+ {1762074000 -28800 0 PST}
+ {1772964000 -25200 1 PDT}
+ {1793523600 -28800 0 PST}
+ {1805018400 -25200 1 PDT}
+ {1825578000 -28800 0 PST}
+ {1836468000 -25200 1 PDT}
+ {1857027600 -28800 0 PST}
+ {1867917600 -25200 1 PDT}
+ {1888477200 -28800 0 PST}
+ {1899367200 -25200 1 PDT}
+ {1919926800 -28800 0 PST}
+ {1930816800 -25200 1 PDT}
+ {1951376400 -28800 0 PST}
+ {1962871200 -25200 1 PDT}
+ {1983430800 -28800 0 PST}
+ {1994320800 -25200 1 PDT}
+ {2014880400 -28800 0 PST}
+ {2025770400 -25200 1 PDT}
+ {2046330000 -28800 0 PST}
+ {2057220000 -25200 1 PDT}
+ {2077779600 -28800 0 PST}
+ {2088669600 -25200 1 PDT}
+ {2109229200 -28800 0 PST}
+ {2120119200 -25200 1 PDT}
+ {2140678800 -28800 0 PST}
+ {2152173600 -25200 1 PDT}
+ {2172733200 -28800 0 PST}
+ {2183623200 -25200 1 PDT}
+ {2204182800 -28800 0 PST}
+ {2215072800 -25200 1 PDT}
+ {2235632400 -28800 0 PST}
+ {2246522400 -25200 1 PDT}
+ {2267082000 -28800 0 PST}
+ {2277972000 -25200 1 PDT}
+ {2298531600 -28800 0 PST}
+ {2309421600 -25200 1 PDT}
+ {2329981200 -28800 0 PST}
+ {2341476000 -25200 1 PDT}
+ {2362035600 -28800 0 PST}
+ {2372925600 -25200 1 PDT}
+ {2393485200 -28800 0 PST}
+ {2404375200 -25200 1 PDT}
+ {2424934800 -28800 0 PST}
+ {2435824800 -25200 1 PDT}
+ {2456384400 -28800 0 PST}
+ {2467274400 -25200 1 PDT}
+ {2487834000 -28800 0 PST}
+ {2499328800 -25200 1 PDT}
+ {2519888400 -28800 0 PST}
+ {2530778400 -25200 1 PDT}
+ {2551338000 -28800 0 PST}
+ {2562228000 -25200 1 PDT}
+ {2582787600 -28800 0 PST}
+ {2593677600 -25200 1 PDT}
+ {2614237200 -28800 0 PST}
+ {2625127200 -25200 1 PDT}
+ {2645686800 -28800 0 PST}
+ {2656576800 -25200 1 PDT}
+ {2677136400 -28800 0 PST}
+ {2688631200 -25200 1 PDT}
+ {2709190800 -28800 0 PST}
+ {2720080800 -25200 1 PDT}
+ {2740640400 -28800 0 PST}
+ {2751530400 -25200 1 PDT}
+ {2772090000 -28800 0 PST}
+ {2782980000 -25200 1 PDT}
+ {2803539600 -28800 0 PST}
+ {2814429600 -25200 1 PDT}
+ {2834989200 -28800 0 PST}
+ {2846484000 -25200 1 PDT}
+ {2867043600 -28800 0 PST}
+ {2877933600 -25200 1 PDT}
+ {2898493200 -28800 0 PST}
+ {2909383200 -25200 1 PDT}
+ {2929942800 -28800 0 PST}
+ {2940832800 -25200 1 PDT}
+ {2961392400 -28800 0 PST}
+ {2972282400 -25200 1 PDT}
+ {2992842000 -28800 0 PST}
+ {3003732000 -25200 1 PDT}
+ {3024291600 -28800 0 PST}
+ {3035786400 -25200 1 PDT}
+ {3056346000 -28800 0 PST}
+ {3067236000 -25200 1 PDT}
+ {3087795600 -28800 0 PST}
+ {3098685600 -25200 1 PDT}
+ {3119245200 -28800 0 PST}
+ {3130135200 -25200 1 PDT}
+ {3150694800 -28800 0 PST}
+ {3161584800 -25200 1 PDT}
+ {3182144400 -28800 0 PST}
+ {3193034400 -25200 1 PDT}
+ {3213594000 -28800 0 PST}
+ {3225088800 -25200 1 PDT}
+ {3245648400 -28800 0 PST}
+ {3256538400 -25200 1 PDT}
+ {3277098000 -28800 0 PST}
+ {3287988000 -25200 1 PDT}
+ {3308547600 -28800 0 PST}
+ {3319437600 -25200 1 PDT}
+ {3339997200 -28800 0 PST}
+ {3350887200 -25200 1 PDT}
+ {3371446800 -28800 0 PST}
+ {3382941600 -25200 1 PDT}
+ {3403501200 -28800 0 PST}
+ {3414391200 -25200 1 PDT}
+ {3434950800 -28800 0 PST}
+ {3445840800 -25200 1 PDT}
+ {3466400400 -28800 0 PST}
+ {3477290400 -25200 1 PDT}
+ {3497850000 -28800 0 PST}
+ {3508740000 -25200 1 PDT}
+ {3529299600 -28800 0 PST}
+ {3540189600 -25200 1 PDT}
+ {3560749200 -28800 0 PST}
+ {3572244000 -25200 1 PDT}
+ {3592803600 -28800 0 PST}
+ {3603693600 -25200 1 PDT}
+ {3624253200 -28800 0 PST}
+ {3635143200 -25200 1 PDT}
+ {3655702800 -28800 0 PST}
+ {3666592800 -25200 1 PDT}
+ {3687152400 -28800 0 PST}
+ {3698042400 -25200 1 PDT}
+ {3718602000 -28800 0 PST}
+ {3730096800 -25200 1 PDT}
+ {3750656400 -28800 0 PST}
+ {3761546400 -25200 1 PDT}
+ {3782106000 -28800 0 PST}
+ {3792996000 -25200 1 PDT}
+ {3813555600 -28800 0 PST}
+ {3824445600 -25200 1 PDT}
+ {3845005200 -28800 0 PST}
+ {3855895200 -25200 1 PDT}
+ {3876454800 -28800 0 PST}
+ {3887344800 -25200 1 PDT}
+ {3907904400 -28800 0 PST}
+ {3919399200 -25200 1 PDT}
+ {3939958800 -28800 0 PST}
+ {3950848800 -25200 1 PDT}
+ {3971408400 -28800 0 PST}
+ {3982298400 -25200 1 PDT}
+ {4002858000 -28800 0 PST}
+ {4013748000 -25200 1 PDT}
+ {4034307600 -28800 0 PST}
+ {4045197600 -25200 1 PDT}
+ {4065757200 -28800 0 PST}
+ {4076647200 -25200 1 PDT}
+ {4097206800 -28800 0 PST}
}
-set TZData(:PST8PDT) $TZData(:America/Los_Angeles)
diff --git a/library/tzdata/Pacific/Apia b/library/tzdata/Pacific/Apia
index fb37f68..e6f33ad 100644
--- a/library/tzdata/Pacific/Apia
+++ b/library/tzdata/Pacific/Apia
@@ -1,8 +1,188 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Apia) {
{-9223372036854775808 45184 0 LMT}
{-2855737984 -41216 0 LMT}
{-1861878784 -41400 0 SAMT}
{-631110600 -39600 0 WST}
+ {1285498800 -36000 1 WSDT}
+ {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/Auckland b/library/tzdata/Pacific/Auckland
index 290fd5c..5f7e238 100644
--- a/library/tzdata/Pacific/Auckland
+++ b/library/tzdata/Pacific/Auckland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Auckland) {
{-9223372036854775808 41944 0 LMT}
@@ -31,255 +31,255 @@ set TZData(:Pacific/Auckland) {
{-936612000 41400 0 NZMT}
{-923304600 43200 1 NZST}
{-757425600 43200 0 NZST}
- {152676000 46800 1 NZDT}
- {162352800 43200 0 NZST}
- {183520800 46800 1 NZDT}
- {195012000 43200 0 NZST}
- {215575200 46800 1 NZDT}
- {226461600 43200 0 NZST}
- {247024800 46800 1 NZDT}
- {257911200 43200 0 NZST}
- {278474400 46800 1 NZDT}
- {289360800 43200 0 NZST}
- {309924000 46800 1 NZDT}
- {320810400 43200 0 NZST}
- {341373600 46800 1 NZDT}
- {352260000 43200 0 NZST}
- {372823200 46800 1 NZDT}
- {384314400 43200 0 NZST}
- {404877600 46800 1 NZDT}
- {415764000 43200 0 NZST}
- {436327200 46800 1 NZDT}
- {447213600 43200 0 NZST}
- {467776800 46800 1 NZDT}
- {478663200 43200 0 NZST}
- {499226400 46800 1 NZDT}
- {510112800 43200 0 NZST}
- {530676000 46800 1 NZDT}
- {541562400 43200 0 NZST}
- {562125600 46800 1 NZDT}
- {573616800 43200 0 NZST}
- {594180000 46800 1 NZDT}
- {605066400 43200 0 NZST}
- {623815200 46800 1 NZDT}
- {637725600 43200 0 NZST}
- {655264800 46800 1 NZDT}
- {669175200 43200 0 NZST}
- {686714400 46800 1 NZDT}
- {700624800 43200 0 NZST}
- {718164000 46800 1 NZDT}
- {732679200 43200 0 NZST}
- {749613600 46800 1 NZDT}
- {764128800 43200 0 NZST}
- {781063200 46800 1 NZDT}
- {795578400 43200 0 NZST}
- {812512800 46800 1 NZDT}
- {827028000 43200 0 NZST}
- {844567200 46800 1 NZDT}
- {858477600 43200 0 NZST}
- {876016800 46800 1 NZDT}
- {889927200 43200 0 NZST}
- {907466400 46800 1 NZDT}
- {921981600 43200 0 NZST}
- {938916000 46800 1 NZDT}
- {953431200 43200 0 NZST}
- {970365600 46800 1 NZDT}
- {984880800 43200 0 NZST}
- {1002420000 46800 1 NZDT}
- {1016330400 43200 0 NZST}
- {1033869600 46800 1 NZDT}
- {1047780000 43200 0 NZST}
- {1065319200 46800 1 NZDT}
- {1079834400 43200 0 NZST}
- {1096768800 46800 1 NZDT}
- {1111284000 43200 0 NZST}
- {1128218400 46800 1 NZDT}
- {1142733600 43200 0 NZST}
- {1159668000 46800 1 NZDT}
- {1174183200 43200 0 NZST}
- {1191722400 46800 1 NZDT}
- {1205632800 43200 0 NZST}
- {1223172000 46800 1 NZDT}
- {1237082400 43200 0 NZST}
- {1254621600 46800 1 NZDT}
- {1269136800 43200 0 NZST}
- {1286071200 46800 1 NZDT}
- {1300586400 43200 0 NZST}
- {1317520800 46800 1 NZDT}
- {1332036000 43200 0 NZST}
- {1349575200 46800 1 NZDT}
- {1363485600 43200 0 NZST}
- {1381024800 46800 1 NZDT}
- {1394935200 43200 0 NZST}
- {1412474400 46800 1 NZDT}
- {1426384800 43200 0 NZST}
- {1443924000 46800 1 NZDT}
- {1458439200 43200 0 NZST}
- {1475373600 46800 1 NZDT}
- {1489888800 43200 0 NZST}
- {1506823200 46800 1 NZDT}
- {1521338400 43200 0 NZST}
- {1538877600 46800 1 NZDT}
- {1552788000 43200 0 NZST}
- {1570327200 46800 1 NZDT}
- {1584237600 43200 0 NZST}
- {1601776800 46800 1 NZDT}
- {1616292000 43200 0 NZST}
- {1633226400 46800 1 NZDT}
- {1647741600 43200 0 NZST}
- {1664676000 46800 1 NZDT}
- {1679191200 43200 0 NZST}
- {1696125600 46800 1 NZDT}
- {1710640800 43200 0 NZST}
- {1728180000 46800 1 NZDT}
- {1742090400 43200 0 NZST}
- {1759629600 46800 1 NZDT}
- {1773540000 43200 0 NZST}
- {1791079200 46800 1 NZDT}
- {1805594400 43200 0 NZST}
- {1822528800 46800 1 NZDT}
- {1837044000 43200 0 NZST}
- {1853978400 46800 1 NZDT}
- {1868493600 43200 0 NZST}
- {1886032800 46800 1 NZDT}
- {1899943200 43200 0 NZST}
- {1917482400 46800 1 NZDT}
- {1931392800 43200 0 NZST}
- {1948932000 46800 1 NZDT}
- {1963447200 43200 0 NZST}
- {1980381600 46800 1 NZDT}
- {1994896800 43200 0 NZST}
- {2011831200 46800 1 NZDT}
- {2026346400 43200 0 NZST}
- {2043280800 46800 1 NZDT}
- {2057796000 43200 0 NZST}
- {2075335200 46800 1 NZDT}
- {2089245600 43200 0 NZST}
- {2106784800 46800 1 NZDT}
- {2120695200 43200 0 NZST}
- {2138234400 46800 1 NZDT}
- {2152749600 43200 0 NZST}
- {2169684000 46800 1 NZDT}
- {2184199200 43200 0 NZST}
- {2201133600 46800 1 NZDT}
- {2215648800 43200 0 NZST}
- {2233188000 46800 1 NZDT}
- {2247098400 43200 0 NZST}
- {2264637600 46800 1 NZDT}
- {2278548000 43200 0 NZST}
- {2296087200 46800 1 NZDT}
- {2309997600 43200 0 NZST}
- {2327536800 46800 1 NZDT}
- {2342052000 43200 0 NZST}
- {2358986400 46800 1 NZDT}
- {2373501600 43200 0 NZST}
- {2390436000 46800 1 NZDT}
- {2404951200 43200 0 NZST}
- {2422490400 46800 1 NZDT}
- {2436400800 43200 0 NZST}
- {2453940000 46800 1 NZDT}
- {2467850400 43200 0 NZST}
- {2485389600 46800 1 NZDT}
- {2499904800 43200 0 NZST}
- {2516839200 46800 1 NZDT}
- {2531354400 43200 0 NZST}
- {2548288800 46800 1 NZDT}
- {2562804000 43200 0 NZST}
- {2579738400 46800 1 NZDT}
- {2594253600 43200 0 NZST}
- {2611792800 46800 1 NZDT}
- {2625703200 43200 0 NZST}
- {2643242400 46800 1 NZDT}
- {2657152800 43200 0 NZST}
- {2674692000 46800 1 NZDT}
- {2689207200 43200 0 NZST}
- {2706141600 46800 1 NZDT}
- {2720656800 43200 0 NZST}
- {2737591200 46800 1 NZDT}
- {2752106400 43200 0 NZST}
- {2769645600 46800 1 NZDT}
- {2783556000 43200 0 NZST}
- {2801095200 46800 1 NZDT}
- {2815005600 43200 0 NZST}
- {2832544800 46800 1 NZDT}
- {2847060000 43200 0 NZST}
- {2863994400 46800 1 NZDT}
- {2878509600 43200 0 NZST}
- {2895444000 46800 1 NZDT}
- {2909959200 43200 0 NZST}
- {2926893600 46800 1 NZDT}
- {2941408800 43200 0 NZST}
- {2958948000 46800 1 NZDT}
- {2972858400 43200 0 NZST}
- {2990397600 46800 1 NZDT}
- {3004308000 43200 0 NZST}
- {3021847200 46800 1 NZDT}
- {3036362400 43200 0 NZST}
- {3053296800 46800 1 NZDT}
- {3067812000 43200 0 NZST}
- {3084746400 46800 1 NZDT}
- {3099261600 43200 0 NZST}
- {3116800800 46800 1 NZDT}
- {3130711200 43200 0 NZST}
- {3148250400 46800 1 NZDT}
- {3162160800 43200 0 NZST}
- {3179700000 46800 1 NZDT}
- {3193610400 43200 0 NZST}
- {3211149600 46800 1 NZDT}
- {3225664800 43200 0 NZST}
- {3242599200 46800 1 NZDT}
- {3257114400 43200 0 NZST}
- {3274048800 46800 1 NZDT}
- {3288564000 43200 0 NZST}
- {3306103200 46800 1 NZDT}
- {3320013600 43200 0 NZST}
- {3337552800 46800 1 NZDT}
- {3351463200 43200 0 NZST}
- {3369002400 46800 1 NZDT}
- {3383517600 43200 0 NZST}
- {3400452000 46800 1 NZDT}
- {3414967200 43200 0 NZST}
- {3431901600 46800 1 NZDT}
- {3446416800 43200 0 NZST}
- {3463351200 46800 1 NZDT}
- {3477866400 43200 0 NZST}
- {3495405600 46800 1 NZDT}
- {3509316000 43200 0 NZST}
- {3526855200 46800 1 NZDT}
- {3540765600 43200 0 NZST}
- {3558304800 46800 1 NZDT}
- {3572820000 43200 0 NZST}
- {3589754400 46800 1 NZDT}
- {3604269600 43200 0 NZST}
- {3621204000 46800 1 NZDT}
- {3635719200 43200 0 NZST}
- {3653258400 46800 1 NZDT}
- {3667168800 43200 0 NZST}
- {3684708000 46800 1 NZDT}
- {3698618400 43200 0 NZST}
- {3716157600 46800 1 NZDT}
- {3730672800 43200 0 NZST}
- {3747607200 46800 1 NZDT}
- {3762122400 43200 0 NZST}
- {3779056800 46800 1 NZDT}
- {3793572000 43200 0 NZST}
- {3810506400 46800 1 NZDT}
- {3825021600 43200 0 NZST}
- {3842560800 46800 1 NZDT}
- {3856471200 43200 0 NZST}
- {3874010400 46800 1 NZDT}
- {3887920800 43200 0 NZST}
- {3905460000 46800 1 NZDT}
- {3919975200 43200 0 NZST}
- {3936909600 46800 1 NZDT}
- {3951424800 43200 0 NZST}
- {3968359200 46800 1 NZDT}
- {3982874400 43200 0 NZST}
- {4000413600 46800 1 NZDT}
- {4014324000 43200 0 NZST}
- {4031863200 46800 1 NZDT}
- {4045773600 43200 0 NZST}
- {4063312800 46800 1 NZDT}
- {4077223200 43200 0 NZST}
- {4094762400 46800 1 NZDT}
+ {152632800 46800 1 NZDT}
+ {162309600 43200 0 NZST}
+ {183477600 46800 1 NZDT}
+ {194968800 43200 0 NZST}
+ {215532000 46800 1 NZDT}
+ {226418400 43200 0 NZST}
+ {246981600 46800 1 NZDT}
+ {257868000 43200 0 NZST}
+ {278431200 46800 1 NZDT}
+ {289317600 43200 0 NZST}
+ {309880800 46800 1 NZDT}
+ {320767200 43200 0 NZST}
+ {341330400 46800 1 NZDT}
+ {352216800 43200 0 NZST}
+ {372780000 46800 1 NZDT}
+ {384271200 43200 0 NZST}
+ {404834400 46800 1 NZDT}
+ {415720800 43200 0 NZST}
+ {436284000 46800 1 NZDT}
+ {447170400 43200 0 NZST}
+ {467733600 46800 1 NZDT}
+ {478620000 43200 0 NZST}
+ {499183200 46800 1 NZDT}
+ {510069600 43200 0 NZST}
+ {530632800 46800 1 NZDT}
+ {541519200 43200 0 NZST}
+ {562082400 46800 1 NZDT}
+ {573573600 43200 0 NZST}
+ {594136800 46800 1 NZDT}
+ {605023200 43200 0 NZST}
+ {623772000 46800 1 NZDT}
+ {637682400 43200 0 NZST}
+ {655221600 46800 1 NZDT}
+ {669132000 43200 0 NZST}
+ {686671200 46800 1 NZDT}
+ {700581600 43200 0 NZST}
+ {718120800 46800 1 NZDT}
+ {732636000 43200 0 NZST}
+ {749570400 46800 1 NZDT}
+ {764085600 43200 0 NZST}
+ {781020000 46800 1 NZDT}
+ {795535200 43200 0 NZST}
+ {812469600 46800 1 NZDT}
+ {826984800 43200 0 NZST}
+ {844524000 46800 1 NZDT}
+ {858434400 43200 0 NZST}
+ {875973600 46800 1 NZDT}
+ {889884000 43200 0 NZST}
+ {907423200 46800 1 NZDT}
+ {921938400 43200 0 NZST}
+ {938872800 46800 1 NZDT}
+ {953388000 43200 0 NZST}
+ {970322400 46800 1 NZDT}
+ {984837600 43200 0 NZST}
+ {1002376800 46800 1 NZDT}
+ {1016287200 43200 0 NZST}
+ {1033826400 46800 1 NZDT}
+ {1047736800 43200 0 NZST}
+ {1065276000 46800 1 NZDT}
+ {1079791200 43200 0 NZST}
+ {1096725600 46800 1 NZDT}
+ {1111240800 43200 0 NZST}
+ {1128175200 46800 1 NZDT}
+ {1142690400 43200 0 NZST}
+ {1159624800 46800 1 NZDT}
+ {1174140000 43200 0 NZST}
+ {1191074400 46800 1 NZDT}
+ {1207404000 43200 0 NZST}
+ {1222524000 46800 1 NZDT}
+ {1238853600 43200 0 NZST}
+ {1253973600 46800 1 NZDT}
+ {1270303200 43200 0 NZST}
+ {1285423200 46800 1 NZDT}
+ {1301752800 43200 0 NZST}
+ {1316872800 46800 1 NZDT}
+ {1333202400 43200 0 NZST}
+ {1348927200 46800 1 NZDT}
+ {1365256800 43200 0 NZST}
+ {1380376800 46800 1 NZDT}
+ {1396706400 43200 0 NZST}
+ {1411826400 46800 1 NZDT}
+ {1428156000 43200 0 NZST}
+ {1443276000 46800 1 NZDT}
+ {1459605600 43200 0 NZST}
+ {1474725600 46800 1 NZDT}
+ {1491055200 43200 0 NZST}
+ {1506175200 46800 1 NZDT}
+ {1522504800 43200 0 NZST}
+ {1538229600 46800 1 NZDT}
+ {1554559200 43200 0 NZST}
+ {1569679200 46800 1 NZDT}
+ {1586008800 43200 0 NZST}
+ {1601128800 46800 1 NZDT}
+ {1617458400 43200 0 NZST}
+ {1632578400 46800 1 NZDT}
+ {1648908000 43200 0 NZST}
+ {1664028000 46800 1 NZDT}
+ {1680357600 43200 0 NZST}
+ {1695477600 46800 1 NZDT}
+ {1712412000 43200 0 NZST}
+ {1727532000 46800 1 NZDT}
+ {1743861600 43200 0 NZST}
+ {1758981600 46800 1 NZDT}
+ {1775311200 43200 0 NZST}
+ {1790431200 46800 1 NZDT}
+ {1806760800 43200 0 NZST}
+ {1821880800 46800 1 NZDT}
+ {1838210400 43200 0 NZST}
+ {1853330400 46800 1 NZDT}
+ {1869660000 43200 0 NZST}
+ {1885384800 46800 1 NZDT}
+ {1901714400 43200 0 NZST}
+ {1916834400 46800 1 NZDT}
+ {1933164000 43200 0 NZST}
+ {1948284000 46800 1 NZDT}
+ {1964613600 43200 0 NZST}
+ {1979733600 46800 1 NZDT}
+ {1996063200 43200 0 NZST}
+ {2011183200 46800 1 NZDT}
+ {2027512800 43200 0 NZST}
+ {2042632800 46800 1 NZDT}
+ {2058962400 43200 0 NZST}
+ {2074687200 46800 1 NZDT}
+ {2091016800 43200 0 NZST}
+ {2106136800 46800 1 NZDT}
+ {2122466400 43200 0 NZST}
+ {2137586400 46800 1 NZDT}
+ {2153916000 43200 0 NZST}
+ {2169036000 46800 1 NZDT}
+ {2185365600 43200 0 NZST}
+ {2200485600 46800 1 NZDT}
+ {2216815200 43200 0 NZST}
+ {2232540000 46800 1 NZDT}
+ {2248869600 43200 0 NZST}
+ {2263989600 46800 1 NZDT}
+ {2280319200 43200 0 NZST}
+ {2295439200 46800 1 NZDT}
+ {2311768800 43200 0 NZST}
+ {2326888800 46800 1 NZDT}
+ {2343218400 43200 0 NZST}
+ {2358338400 46800 1 NZDT}
+ {2374668000 43200 0 NZST}
+ {2389788000 46800 1 NZDT}
+ {2406117600 43200 0 NZST}
+ {2421842400 46800 1 NZDT}
+ {2438172000 43200 0 NZST}
+ {2453292000 46800 1 NZDT}
+ {2469621600 43200 0 NZST}
+ {2484741600 46800 1 NZDT}
+ {2501071200 43200 0 NZST}
+ {2516191200 46800 1 NZDT}
+ {2532520800 43200 0 NZST}
+ {2547640800 46800 1 NZDT}
+ {2563970400 43200 0 NZST}
+ {2579090400 46800 1 NZDT}
+ {2596024800 43200 0 NZST}
+ {2611144800 46800 1 NZDT}
+ {2627474400 43200 0 NZST}
+ {2642594400 46800 1 NZDT}
+ {2658924000 43200 0 NZST}
+ {2674044000 46800 1 NZDT}
+ {2690373600 43200 0 NZST}
+ {2705493600 46800 1 NZDT}
+ {2721823200 43200 0 NZST}
+ {2736943200 46800 1 NZDT}
+ {2753272800 43200 0 NZST}
+ {2768997600 46800 1 NZDT}
+ {2785327200 43200 0 NZST}
+ {2800447200 46800 1 NZDT}
+ {2816776800 43200 0 NZST}
+ {2831896800 46800 1 NZDT}
+ {2848226400 43200 0 NZST}
+ {2863346400 46800 1 NZDT}
+ {2879676000 43200 0 NZST}
+ {2894796000 46800 1 NZDT}
+ {2911125600 43200 0 NZST}
+ {2926245600 46800 1 NZDT}
+ {2942575200 43200 0 NZST}
+ {2958300000 46800 1 NZDT}
+ {2974629600 43200 0 NZST}
+ {2989749600 46800 1 NZDT}
+ {3006079200 43200 0 NZST}
+ {3021199200 46800 1 NZDT}
+ {3037528800 43200 0 NZST}
+ {3052648800 46800 1 NZDT}
+ {3068978400 43200 0 NZST}
+ {3084098400 46800 1 NZDT}
+ {3100428000 43200 0 NZST}
+ {3116152800 46800 1 NZDT}
+ {3132482400 43200 0 NZST}
+ {3147602400 46800 1 NZDT}
+ {3163932000 43200 0 NZST}
+ {3179052000 46800 1 NZDT}
+ {3195381600 43200 0 NZST}
+ {3210501600 46800 1 NZDT}
+ {3226831200 43200 0 NZST}
+ {3241951200 46800 1 NZDT}
+ {3258280800 43200 0 NZST}
+ {3273400800 46800 1 NZDT}
+ {3289730400 43200 0 NZST}
+ {3305455200 46800 1 NZDT}
+ {3321784800 43200 0 NZST}
+ {3336904800 46800 1 NZDT}
+ {3353234400 43200 0 NZST}
+ {3368354400 46800 1 NZDT}
+ {3384684000 43200 0 NZST}
+ {3399804000 46800 1 NZDT}
+ {3416133600 43200 0 NZST}
+ {3431253600 46800 1 NZDT}
+ {3447583200 43200 0 NZST}
+ {3462703200 46800 1 NZDT}
+ {3479637600 43200 0 NZST}
+ {3494757600 46800 1 NZDT}
+ {3511087200 43200 0 NZST}
+ {3526207200 46800 1 NZDT}
+ {3542536800 43200 0 NZST}
+ {3557656800 46800 1 NZDT}
+ {3573986400 43200 0 NZST}
+ {3589106400 46800 1 NZDT}
+ {3605436000 43200 0 NZST}
+ {3620556000 46800 1 NZDT}
+ {3636885600 43200 0 NZST}
+ {3652610400 46800 1 NZDT}
+ {3668940000 43200 0 NZST}
+ {3684060000 46800 1 NZDT}
+ {3700389600 43200 0 NZST}
+ {3715509600 46800 1 NZDT}
+ {3731839200 43200 0 NZST}
+ {3746959200 46800 1 NZDT}
+ {3763288800 43200 0 NZST}
+ {3778408800 46800 1 NZDT}
+ {3794738400 43200 0 NZST}
+ {3809858400 46800 1 NZDT}
+ {3826188000 43200 0 NZST}
+ {3841912800 46800 1 NZDT}
+ {3858242400 43200 0 NZST}
+ {3873362400 46800 1 NZDT}
+ {3889692000 43200 0 NZST}
+ {3904812000 46800 1 NZDT}
+ {3921141600 43200 0 NZST}
+ {3936261600 46800 1 NZDT}
+ {3952591200 43200 0 NZST}
+ {3967711200 46800 1 NZDT}
+ {3984040800 43200 0 NZST}
+ {3999765600 46800 1 NZDT}
+ {4016095200 43200 0 NZST}
+ {4031215200 46800 1 NZDT}
+ {4047544800 43200 0 NZST}
+ {4062664800 46800 1 NZDT}
+ {4078994400 43200 0 NZST}
+ {4094114400 46800 1 NZDT}
}
diff --git a/library/tzdata/Pacific/Chatham b/library/tzdata/Pacific/Chatham
index 01cab6d..0ed2260 100644
--- a/library/tzdata/Pacific/Chatham
+++ b/library/tzdata/Pacific/Chatham
@@ -1,257 +1,257 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Chatham) {
{-9223372036854775808 44028 0 LMT}
{-410271228 45900 0 CHAST}
- {152678700 49500 1 CHADT}
- {162355500 45900 0 CHAST}
- {183523500 49500 1 CHADT}
- {195014700 45900 0 CHAST}
- {215577900 49500 1 CHADT}
- {226464300 45900 0 CHAST}
- {247027500 49500 1 CHADT}
- {257913900 45900 0 CHAST}
- {278477100 49500 1 CHADT}
- {289363500 45900 0 CHAST}
- {309926700 49500 1 CHADT}
- {320813100 45900 0 CHAST}
- {341376300 49500 1 CHADT}
- {352262700 45900 0 CHAST}
- {372825900 49500 1 CHADT}
- {384317100 45900 0 CHAST}
- {404880300 49500 1 CHADT}
- {415766700 45900 0 CHAST}
- {436329900 49500 1 CHADT}
- {447216300 45900 0 CHAST}
- {467779500 49500 1 CHADT}
- {478665900 45900 0 CHAST}
- {499229100 49500 1 CHADT}
- {510115500 45900 0 CHAST}
- {530678700 49500 1 CHADT}
- {541565100 45900 0 CHAST}
- {562128300 49500 1 CHADT}
- {573619500 45900 0 CHAST}
- {594182700 49500 1 CHADT}
- {605069100 45900 0 CHAST}
- {623817900 49500 1 CHADT}
- {637728300 45900 0 CHAST}
- {655267500 49500 1 CHADT}
- {669177900 45900 0 CHAST}
- {686717100 49500 1 CHADT}
- {700627500 45900 0 CHAST}
- {718166700 49500 1 CHADT}
- {732681900 45900 0 CHAST}
- {749616300 49500 1 CHADT}
- {764131500 45900 0 CHAST}
- {781065900 49500 1 CHADT}
- {795581100 45900 0 CHAST}
- {812515500 49500 1 CHADT}
- {827030700 45900 0 CHAST}
- {844569900 49500 1 CHADT}
- {858480300 45900 0 CHAST}
- {876019500 49500 1 CHADT}
- {889929900 45900 0 CHAST}
- {907469100 49500 1 CHADT}
- {921984300 45900 0 CHAST}
- {938918700 49500 1 CHADT}
- {953433900 45900 0 CHAST}
- {970368300 49500 1 CHADT}
- {984883500 45900 0 CHAST}
- {1002422700 49500 1 CHADT}
- {1016333100 45900 0 CHAST}
- {1033872300 49500 1 CHADT}
- {1047782700 45900 0 CHAST}
- {1065321900 49500 1 CHADT}
- {1079837100 45900 0 CHAST}
- {1096771500 49500 1 CHADT}
- {1111286700 45900 0 CHAST}
- {1128221100 49500 1 CHADT}
- {1142736300 45900 0 CHAST}
- {1159670700 49500 1 CHADT}
- {1174185900 45900 0 CHAST}
- {1191725100 49500 1 CHADT}
- {1205635500 45900 0 CHAST}
- {1223174700 49500 1 CHADT}
- {1237085100 45900 0 CHAST}
- {1254624300 49500 1 CHADT}
- {1269139500 45900 0 CHAST}
- {1286073900 49500 1 CHADT}
- {1300589100 45900 0 CHAST}
- {1317523500 49500 1 CHADT}
- {1332038700 45900 0 CHAST}
- {1349577900 49500 1 CHADT}
- {1363488300 45900 0 CHAST}
- {1381027500 49500 1 CHADT}
- {1394937900 45900 0 CHAST}
- {1412477100 49500 1 CHADT}
- {1426387500 45900 0 CHAST}
- {1443926700 49500 1 CHADT}
- {1458441900 45900 0 CHAST}
- {1475376300 49500 1 CHADT}
- {1489891500 45900 0 CHAST}
- {1506825900 49500 1 CHADT}
- {1521341100 45900 0 CHAST}
- {1538880300 49500 1 CHADT}
- {1552790700 45900 0 CHAST}
- {1570329900 49500 1 CHADT}
- {1584240300 45900 0 CHAST}
- {1601779500 49500 1 CHADT}
- {1616294700 45900 0 CHAST}
- {1633229100 49500 1 CHADT}
- {1647744300 45900 0 CHAST}
- {1664678700 49500 1 CHADT}
- {1679193900 45900 0 CHAST}
- {1696128300 49500 1 CHADT}
- {1710643500 45900 0 CHAST}
- {1728182700 49500 1 CHADT}
- {1742093100 45900 0 CHAST}
- {1759632300 49500 1 CHADT}
- {1773542700 45900 0 CHAST}
- {1791081900 49500 1 CHADT}
- {1805597100 45900 0 CHAST}
- {1822531500 49500 1 CHADT}
- {1837046700 45900 0 CHAST}
- {1853981100 49500 1 CHADT}
- {1868496300 45900 0 CHAST}
- {1886035500 49500 1 CHADT}
- {1899945900 45900 0 CHAST}
- {1917485100 49500 1 CHADT}
- {1931395500 45900 0 CHAST}
- {1948934700 49500 1 CHADT}
- {1963449900 45900 0 CHAST}
- {1980384300 49500 1 CHADT}
- {1994899500 45900 0 CHAST}
- {2011833900 49500 1 CHADT}
- {2026349100 45900 0 CHAST}
- {2043283500 49500 1 CHADT}
- {2057798700 45900 0 CHAST}
- {2075337900 49500 1 CHADT}
- {2089248300 45900 0 CHAST}
- {2106787500 49500 1 CHADT}
- {2120697900 45900 0 CHAST}
- {2138237100 49500 1 CHADT}
- {2152752300 45900 0 CHAST}
- {2169686700 49500 1 CHADT}
- {2184201900 45900 0 CHAST}
- {2201136300 49500 1 CHADT}
- {2215651500 45900 0 CHAST}
- {2233190700 49500 1 CHADT}
- {2247101100 45900 0 CHAST}
- {2264640300 49500 1 CHADT}
- {2278550700 45900 0 CHAST}
- {2296089900 49500 1 CHADT}
- {2310000300 45900 0 CHAST}
- {2327539500 49500 1 CHADT}
- {2342054700 45900 0 CHAST}
- {2358989100 49500 1 CHADT}
- {2373504300 45900 0 CHAST}
- {2390438700 49500 1 CHADT}
- {2404953900 45900 0 CHAST}
- {2422493100 49500 1 CHADT}
- {2436403500 45900 0 CHAST}
- {2453942700 49500 1 CHADT}
- {2467853100 45900 0 CHAST}
- {2485392300 49500 1 CHADT}
- {2499907500 45900 0 CHAST}
- {2516841900 49500 1 CHADT}
- {2531357100 45900 0 CHAST}
- {2548291500 49500 1 CHADT}
- {2562806700 45900 0 CHAST}
- {2579741100 49500 1 CHADT}
- {2594256300 45900 0 CHAST}
- {2611795500 49500 1 CHADT}
- {2625705900 45900 0 CHAST}
- {2643245100 49500 1 CHADT}
- {2657155500 45900 0 CHAST}
- {2674694700 49500 1 CHADT}
- {2689209900 45900 0 CHAST}
- {2706144300 49500 1 CHADT}
- {2720659500 45900 0 CHAST}
- {2737593900 49500 1 CHADT}
- {2752109100 45900 0 CHAST}
- {2769648300 49500 1 CHADT}
- {2783558700 45900 0 CHAST}
- {2801097900 49500 1 CHADT}
- {2815008300 45900 0 CHAST}
- {2832547500 49500 1 CHADT}
- {2847062700 45900 0 CHAST}
- {2863997100 49500 1 CHADT}
- {2878512300 45900 0 CHAST}
- {2895446700 49500 1 CHADT}
- {2909961900 45900 0 CHAST}
- {2926896300 49500 1 CHADT}
- {2941411500 45900 0 CHAST}
- {2958950700 49500 1 CHADT}
- {2972861100 45900 0 CHAST}
- {2990400300 49500 1 CHADT}
- {3004310700 45900 0 CHAST}
- {3021849900 49500 1 CHADT}
- {3036365100 45900 0 CHAST}
- {3053299500 49500 1 CHADT}
- {3067814700 45900 0 CHAST}
- {3084749100 49500 1 CHADT}
- {3099264300 45900 0 CHAST}
- {3116803500 49500 1 CHADT}
- {3130713900 45900 0 CHAST}
- {3148253100 49500 1 CHADT}
- {3162163500 45900 0 CHAST}
- {3179702700 49500 1 CHADT}
- {3193613100 45900 0 CHAST}
- {3211152300 49500 1 CHADT}
- {3225667500 45900 0 CHAST}
- {3242601900 49500 1 CHADT}
- {3257117100 45900 0 CHAST}
- {3274051500 49500 1 CHADT}
- {3288566700 45900 0 CHAST}
- {3306105900 49500 1 CHADT}
- {3320016300 45900 0 CHAST}
- {3337555500 49500 1 CHADT}
- {3351465900 45900 0 CHAST}
- {3369005100 49500 1 CHADT}
- {3383520300 45900 0 CHAST}
- {3400454700 49500 1 CHADT}
- {3414969900 45900 0 CHAST}
- {3431904300 49500 1 CHADT}
- {3446419500 45900 0 CHAST}
- {3463353900 49500 1 CHADT}
- {3477869100 45900 0 CHAST}
- {3495408300 49500 1 CHADT}
- {3509318700 45900 0 CHAST}
- {3526857900 49500 1 CHADT}
- {3540768300 45900 0 CHAST}
- {3558307500 49500 1 CHADT}
- {3572822700 45900 0 CHAST}
- {3589757100 49500 1 CHADT}
- {3604272300 45900 0 CHAST}
- {3621206700 49500 1 CHADT}
- {3635721900 45900 0 CHAST}
- {3653261100 49500 1 CHADT}
- {3667171500 45900 0 CHAST}
- {3684710700 49500 1 CHADT}
- {3698621100 45900 0 CHAST}
- {3716160300 49500 1 CHADT}
- {3730675500 45900 0 CHAST}
- {3747609900 49500 1 CHADT}
- {3762125100 45900 0 CHAST}
- {3779059500 49500 1 CHADT}
- {3793574700 45900 0 CHAST}
- {3810509100 49500 1 CHADT}
- {3825024300 45900 0 CHAST}
- {3842563500 49500 1 CHADT}
- {3856473900 45900 0 CHAST}
- {3874013100 49500 1 CHADT}
- {3887923500 45900 0 CHAST}
- {3905462700 49500 1 CHADT}
- {3919977900 45900 0 CHAST}
- {3936912300 49500 1 CHADT}
- {3951427500 45900 0 CHAST}
- {3968361900 49500 1 CHADT}
- {3982877100 45900 0 CHAST}
- {4000416300 49500 1 CHADT}
- {4014326700 45900 0 CHAST}
- {4031865900 49500 1 CHADT}
- {4045776300 45900 0 CHAST}
- {4063315500 49500 1 CHADT}
- {4077225900 45900 0 CHAST}
- {4094765100 49500 1 CHADT}
+ {152632800 49500 1 CHADT}
+ {162309600 45900 0 CHAST}
+ {183477600 49500 1 CHADT}
+ {194968800 45900 0 CHAST}
+ {215532000 49500 1 CHADT}
+ {226418400 45900 0 CHAST}
+ {246981600 49500 1 CHADT}
+ {257868000 45900 0 CHAST}
+ {278431200 49500 1 CHADT}
+ {289317600 45900 0 CHAST}
+ {309880800 49500 1 CHADT}
+ {320767200 45900 0 CHAST}
+ {341330400 49500 1 CHADT}
+ {352216800 45900 0 CHAST}
+ {372780000 49500 1 CHADT}
+ {384271200 45900 0 CHAST}
+ {404834400 49500 1 CHADT}
+ {415720800 45900 0 CHAST}
+ {436284000 49500 1 CHADT}
+ {447170400 45900 0 CHAST}
+ {467733600 49500 1 CHADT}
+ {478620000 45900 0 CHAST}
+ {499183200 49500 1 CHADT}
+ {510069600 45900 0 CHAST}
+ {530632800 49500 1 CHADT}
+ {541519200 45900 0 CHAST}
+ {562082400 49500 1 CHADT}
+ {573573600 45900 0 CHAST}
+ {594136800 49500 1 CHADT}
+ {605023200 45900 0 CHAST}
+ {623772000 49500 1 CHADT}
+ {637682400 45900 0 CHAST}
+ {655221600 49500 1 CHADT}
+ {669132000 45900 0 CHAST}
+ {686671200 49500 1 CHADT}
+ {700581600 45900 0 CHAST}
+ {718120800 49500 1 CHADT}
+ {732636000 45900 0 CHAST}
+ {749570400 49500 1 CHADT}
+ {764085600 45900 0 CHAST}
+ {781020000 49500 1 CHADT}
+ {795535200 45900 0 CHAST}
+ {812469600 49500 1 CHADT}
+ {826984800 45900 0 CHAST}
+ {844524000 49500 1 CHADT}
+ {858434400 45900 0 CHAST}
+ {875973600 49500 1 CHADT}
+ {889884000 45900 0 CHAST}
+ {907423200 49500 1 CHADT}
+ {921938400 45900 0 CHAST}
+ {938872800 49500 1 CHADT}
+ {953388000 45900 0 CHAST}
+ {970322400 49500 1 CHADT}
+ {984837600 45900 0 CHAST}
+ {1002376800 49500 1 CHADT}
+ {1016287200 45900 0 CHAST}
+ {1033826400 49500 1 CHADT}
+ {1047736800 45900 0 CHAST}
+ {1065276000 49500 1 CHADT}
+ {1079791200 45900 0 CHAST}
+ {1096725600 49500 1 CHADT}
+ {1111240800 45900 0 CHAST}
+ {1128175200 49500 1 CHADT}
+ {1142690400 45900 0 CHAST}
+ {1159624800 49500 1 CHADT}
+ {1174140000 45900 0 CHAST}
+ {1191074400 49500 1 CHADT}
+ {1207404000 45900 0 CHAST}
+ {1222524000 49500 1 CHADT}
+ {1238853600 45900 0 CHAST}
+ {1253973600 49500 1 CHADT}
+ {1270303200 45900 0 CHAST}
+ {1285423200 49500 1 CHADT}
+ {1301752800 45900 0 CHAST}
+ {1316872800 49500 1 CHADT}
+ {1333202400 45900 0 CHAST}
+ {1348927200 49500 1 CHADT}
+ {1365256800 45900 0 CHAST}
+ {1380376800 49500 1 CHADT}
+ {1396706400 45900 0 CHAST}
+ {1411826400 49500 1 CHADT}
+ {1428156000 45900 0 CHAST}
+ {1443276000 49500 1 CHADT}
+ {1459605600 45900 0 CHAST}
+ {1474725600 49500 1 CHADT}
+ {1491055200 45900 0 CHAST}
+ {1506175200 49500 1 CHADT}
+ {1522504800 45900 0 CHAST}
+ {1538229600 49500 1 CHADT}
+ {1554559200 45900 0 CHAST}
+ {1569679200 49500 1 CHADT}
+ {1586008800 45900 0 CHAST}
+ {1601128800 49500 1 CHADT}
+ {1617458400 45900 0 CHAST}
+ {1632578400 49500 1 CHADT}
+ {1648908000 45900 0 CHAST}
+ {1664028000 49500 1 CHADT}
+ {1680357600 45900 0 CHAST}
+ {1695477600 49500 1 CHADT}
+ {1712412000 45900 0 CHAST}
+ {1727532000 49500 1 CHADT}
+ {1743861600 45900 0 CHAST}
+ {1758981600 49500 1 CHADT}
+ {1775311200 45900 0 CHAST}
+ {1790431200 49500 1 CHADT}
+ {1806760800 45900 0 CHAST}
+ {1821880800 49500 1 CHADT}
+ {1838210400 45900 0 CHAST}
+ {1853330400 49500 1 CHADT}
+ {1869660000 45900 0 CHAST}
+ {1885384800 49500 1 CHADT}
+ {1901714400 45900 0 CHAST}
+ {1916834400 49500 1 CHADT}
+ {1933164000 45900 0 CHAST}
+ {1948284000 49500 1 CHADT}
+ {1964613600 45900 0 CHAST}
+ {1979733600 49500 1 CHADT}
+ {1996063200 45900 0 CHAST}
+ {2011183200 49500 1 CHADT}
+ {2027512800 45900 0 CHAST}
+ {2042632800 49500 1 CHADT}
+ {2058962400 45900 0 CHAST}
+ {2074687200 49500 1 CHADT}
+ {2091016800 45900 0 CHAST}
+ {2106136800 49500 1 CHADT}
+ {2122466400 45900 0 CHAST}
+ {2137586400 49500 1 CHADT}
+ {2153916000 45900 0 CHAST}
+ {2169036000 49500 1 CHADT}
+ {2185365600 45900 0 CHAST}
+ {2200485600 49500 1 CHADT}
+ {2216815200 45900 0 CHAST}
+ {2232540000 49500 1 CHADT}
+ {2248869600 45900 0 CHAST}
+ {2263989600 49500 1 CHADT}
+ {2280319200 45900 0 CHAST}
+ {2295439200 49500 1 CHADT}
+ {2311768800 45900 0 CHAST}
+ {2326888800 49500 1 CHADT}
+ {2343218400 45900 0 CHAST}
+ {2358338400 49500 1 CHADT}
+ {2374668000 45900 0 CHAST}
+ {2389788000 49500 1 CHADT}
+ {2406117600 45900 0 CHAST}
+ {2421842400 49500 1 CHADT}
+ {2438172000 45900 0 CHAST}
+ {2453292000 49500 1 CHADT}
+ {2469621600 45900 0 CHAST}
+ {2484741600 49500 1 CHADT}
+ {2501071200 45900 0 CHAST}
+ {2516191200 49500 1 CHADT}
+ {2532520800 45900 0 CHAST}
+ {2547640800 49500 1 CHADT}
+ {2563970400 45900 0 CHAST}
+ {2579090400 49500 1 CHADT}
+ {2596024800 45900 0 CHAST}
+ {2611144800 49500 1 CHADT}
+ {2627474400 45900 0 CHAST}
+ {2642594400 49500 1 CHADT}
+ {2658924000 45900 0 CHAST}
+ {2674044000 49500 1 CHADT}
+ {2690373600 45900 0 CHAST}
+ {2705493600 49500 1 CHADT}
+ {2721823200 45900 0 CHAST}
+ {2736943200 49500 1 CHADT}
+ {2753272800 45900 0 CHAST}
+ {2768997600 49500 1 CHADT}
+ {2785327200 45900 0 CHAST}
+ {2800447200 49500 1 CHADT}
+ {2816776800 45900 0 CHAST}
+ {2831896800 49500 1 CHADT}
+ {2848226400 45900 0 CHAST}
+ {2863346400 49500 1 CHADT}
+ {2879676000 45900 0 CHAST}
+ {2894796000 49500 1 CHADT}
+ {2911125600 45900 0 CHAST}
+ {2926245600 49500 1 CHADT}
+ {2942575200 45900 0 CHAST}
+ {2958300000 49500 1 CHADT}
+ {2974629600 45900 0 CHAST}
+ {2989749600 49500 1 CHADT}
+ {3006079200 45900 0 CHAST}
+ {3021199200 49500 1 CHADT}
+ {3037528800 45900 0 CHAST}
+ {3052648800 49500 1 CHADT}
+ {3068978400 45900 0 CHAST}
+ {3084098400 49500 1 CHADT}
+ {3100428000 45900 0 CHAST}
+ {3116152800 49500 1 CHADT}
+ {3132482400 45900 0 CHAST}
+ {3147602400 49500 1 CHADT}
+ {3163932000 45900 0 CHAST}
+ {3179052000 49500 1 CHADT}
+ {3195381600 45900 0 CHAST}
+ {3210501600 49500 1 CHADT}
+ {3226831200 45900 0 CHAST}
+ {3241951200 49500 1 CHADT}
+ {3258280800 45900 0 CHAST}
+ {3273400800 49500 1 CHADT}
+ {3289730400 45900 0 CHAST}
+ {3305455200 49500 1 CHADT}
+ {3321784800 45900 0 CHAST}
+ {3336904800 49500 1 CHADT}
+ {3353234400 45900 0 CHAST}
+ {3368354400 49500 1 CHADT}
+ {3384684000 45900 0 CHAST}
+ {3399804000 49500 1 CHADT}
+ {3416133600 45900 0 CHAST}
+ {3431253600 49500 1 CHADT}
+ {3447583200 45900 0 CHAST}
+ {3462703200 49500 1 CHADT}
+ {3479637600 45900 0 CHAST}
+ {3494757600 49500 1 CHADT}
+ {3511087200 45900 0 CHAST}
+ {3526207200 49500 1 CHADT}
+ {3542536800 45900 0 CHAST}
+ {3557656800 49500 1 CHADT}
+ {3573986400 45900 0 CHAST}
+ {3589106400 49500 1 CHADT}
+ {3605436000 45900 0 CHAST}
+ {3620556000 49500 1 CHADT}
+ {3636885600 45900 0 CHAST}
+ {3652610400 49500 1 CHADT}
+ {3668940000 45900 0 CHAST}
+ {3684060000 49500 1 CHADT}
+ {3700389600 45900 0 CHAST}
+ {3715509600 49500 1 CHADT}
+ {3731839200 45900 0 CHAST}
+ {3746959200 49500 1 CHADT}
+ {3763288800 45900 0 CHAST}
+ {3778408800 49500 1 CHADT}
+ {3794738400 45900 0 CHAST}
+ {3809858400 49500 1 CHADT}
+ {3826188000 45900 0 CHAST}
+ {3841912800 49500 1 CHADT}
+ {3858242400 45900 0 CHAST}
+ {3873362400 49500 1 CHADT}
+ {3889692000 45900 0 CHAST}
+ {3904812000 49500 1 CHADT}
+ {3921141600 45900 0 CHAST}
+ {3936261600 49500 1 CHADT}
+ {3952591200 45900 0 CHAST}
+ {3967711200 49500 1 CHADT}
+ {3984040800 45900 0 CHAST}
+ {3999765600 49500 1 CHADT}
+ {4016095200 45900 0 CHAST}
+ {4031215200 49500 1 CHADT}
+ {4047544800 45900 0 CHAST}
+ {4062664800 49500 1 CHADT}
+ {4078994400 45900 0 CHAST}
+ {4094114400 49500 1 CHADT}
}
diff --git a/library/tzdata/Pacific/Chuuk b/library/tzdata/Pacific/Chuuk
new file mode 100644
index 0000000..70b14b2
--- /dev/null
+++ b/library/tzdata/Pacific/Chuuk
@@ -0,0 +1,6 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Pacific/Chuuk) {
+ {-9223372036854775808 36428 0 LMT}
+ {-2177489228 36000 0 CHUT}
+}
diff --git a/library/tzdata/Pacific/Easter b/library/tzdata/Pacific/Easter
index e21ff50..000c6d1 100644
--- a/library/tzdata/Pacific/Easter
+++ b/library/tzdata/Pacific/Easter
@@ -1,24 +1,25 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Easter) {
- {-9223372036854775808 -26248 0 LMT}
- {-2524495352 -26248 0 MMT}
- {-1178124152 -25200 0 EAST}
- {-101937600 -21600 1 EASST}
- {-88635600 -25200 0 EAST}
- {-69883200 -21600 1 EASST}
- {-57186000 -25200 0 EAST}
- {-38433600 -21600 1 EASST}
- {-25736400 -25200 0 EAST}
- {-6984000 -21600 1 EASST}
- {6318000 -25200 0 EAST}
+ {-9223372036854775808 -26264 0 LMT}
+ {-2524495336 -26248 0 EMT}
+ {-1178124152 -21600 0 EASST}
+ {-870552000 -25200 0 EAST}
+ {-865278000 -21600 1 EASST}
+ {-740520000 -21600 1 EASST}
+ {-736376400 -25200 0 EAST}
+ {-718056000 -25200 0 EAST}
+ {-36619200 -21600 1 EASST}
+ {-23922000 -25200 0 EAST}
+ {-3355200 -21600 1 EASST}
+ {7527600 -25200 0 EAST}
{24465600 -21600 1 EASST}
{37767600 -25200 0 EAST}
{55915200 -21600 1 EASST}
{69217200 -25200 0 EAST}
{87969600 -21600 1 EASST}
{100666800 -25200 0 EAST}
- {119419200 -21600 1 EASST}
+ {118209600 -21600 1 EASST}
{132116400 -25200 0 EAST}
{150868800 -21600 1 EASST}
{163566000 -25200 0 EAST}
@@ -35,8 +36,7 @@ set TZData(:Pacific/Easter) {
{340171200 -21600 1 EASST}
{353473200 -25200 0 EAST}
{371620800 -21600 1 EASST}
- {384922800 -25200 0 EAST}
- {384933600 -21600 0 EAST}
+ {384922800 -21600 0 EAST}
{403070400 -18000 1 EASST}
{416372400 -21600 0 EAST}
{434520000 -18000 1 EASST}
@@ -46,14 +46,14 @@ set TZData(:Pacific/Easter) {
{498024000 -18000 1 EASST}
{510721200 -21600 0 EAST}
{529473600 -18000 1 EASST}
- {542775600 -21600 0 EAST}
+ {545194800 -21600 0 EAST}
{560923200 -18000 1 EASST}
{574225200 -21600 0 EAST}
- {592372800 -18000 1 EASST}
+ {591768000 -18000 1 EASST}
{605674800 -21600 0 EAST}
{624427200 -18000 1 EASST}
- {637124400 -21600 0 EAST}
- {655876800 -18000 1 EASST}
+ {637729200 -21600 0 EAST}
+ {653457600 -18000 1 EASST}
{668574000 -21600 0 EAST}
{687326400 -18000 1 EASST}
{700628400 -21600 0 EAST}
@@ -66,7 +66,7 @@ set TZData(:Pacific/Easter) {
{813729600 -18000 1 EASST}
{826426800 -21600 0 EAST}
{845179200 -18000 1 EASST}
- {857876400 -21600 0 EAST}
+ {859690800 -21600 0 EAST}
{876628800 -18000 1 EASST}
{889930800 -21600 0 EAST}
{906868800 -18000 1 EASST}
@@ -88,188 +88,188 @@ set TZData(:Pacific/Easter) {
{1160884800 -18000 1 EASST}
{1173582000 -21600 0 EAST}
{1192334400 -18000 1 EASST}
- {1205031600 -21600 0 EAST}
+ {1206846000 -21600 0 EAST}
{1223784000 -18000 1 EASST}
{1237086000 -21600 0 EAST}
{1255233600 -18000 1 EASST}
- {1268535600 -21600 0 EAST}
+ {1270350000 -21600 0 EAST}
{1286683200 -18000 1 EASST}
- {1299985200 -21600 0 EAST}
- {1318132800 -18000 1 EASST}
- {1331434800 -21600 0 EAST}
- {1350187200 -18000 1 EASST}
- {1362884400 -21600 0 EAST}
- {1381636800 -18000 1 EASST}
- {1394334000 -21600 0 EAST}
- {1413086400 -18000 1 EASST}
- {1426388400 -21600 0 EAST}
- {1444536000 -18000 1 EASST}
- {1457838000 -21600 0 EAST}
- {1475985600 -18000 1 EASST}
- {1489287600 -21600 0 EAST}
- {1508040000 -18000 1 EASST}
- {1520737200 -21600 0 EAST}
- {1539489600 -18000 1 EASST}
- {1552186800 -21600 0 EAST}
- {1570939200 -18000 1 EASST}
- {1584241200 -21600 0 EAST}
- {1602388800 -18000 1 EASST}
- {1615690800 -21600 0 EAST}
- {1633838400 -18000 1 EASST}
- {1647140400 -21600 0 EAST}
- {1665288000 -18000 1 EASST}
- {1678590000 -21600 0 EAST}
- {1697342400 -18000 1 EASST}
- {1710039600 -21600 0 EAST}
- {1728792000 -18000 1 EASST}
- {1741489200 -21600 0 EAST}
- {1760241600 -18000 1 EASST}
- {1773543600 -21600 0 EAST}
- {1791691200 -18000 1 EASST}
- {1804993200 -21600 0 EAST}
- {1823140800 -18000 1 EASST}
- {1836442800 -21600 0 EAST}
- {1855195200 -18000 1 EASST}
- {1867892400 -21600 0 EAST}
- {1886644800 -18000 1 EASST}
- {1899342000 -21600 0 EAST}
- {1918094400 -18000 1 EASST}
- {1930791600 -21600 0 EAST}
- {1949544000 -18000 1 EASST}
- {1962846000 -21600 0 EAST}
- {1980993600 -18000 1 EASST}
- {1994295600 -21600 0 EAST}
- {2012443200 -18000 1 EASST}
- {2025745200 -21600 0 EAST}
- {2044497600 -18000 1 EASST}
- {2057194800 -21600 0 EAST}
- {2075947200 -18000 1 EASST}
- {2088644400 -21600 0 EAST}
- {2107396800 -18000 1 EASST}
- {2120698800 -21600 0 EAST}
- {2138846400 -18000 1 EASST}
- {2152148400 -21600 0 EAST}
- {2170296000 -18000 1 EASST}
- {2183598000 -21600 0 EAST}
- {2201745600 -18000 1 EASST}
- {2215047600 -21600 0 EAST}
- {2233800000 -18000 1 EASST}
- {2246497200 -21600 0 EAST}
- {2265249600 -18000 1 EASST}
- {2277946800 -21600 0 EAST}
- {2296699200 -18000 1 EASST}
- {2310001200 -21600 0 EAST}
- {2328148800 -18000 1 EASST}
- {2341450800 -21600 0 EAST}
- {2359598400 -18000 1 EASST}
- {2372900400 -21600 0 EAST}
- {2391652800 -18000 1 EASST}
- {2404350000 -21600 0 EAST}
- {2423102400 -18000 1 EASST}
- {2435799600 -21600 0 EAST}
- {2454552000 -18000 1 EASST}
- {2467854000 -21600 0 EAST}
- {2486001600 -18000 1 EASST}
- {2499303600 -21600 0 EAST}
- {2517451200 -18000 1 EASST}
- {2530753200 -21600 0 EAST}
- {2548900800 -18000 1 EASST}
- {2562202800 -21600 0 EAST}
- {2580955200 -18000 1 EASST}
- {2593652400 -21600 0 EAST}
- {2612404800 -18000 1 EASST}
- {2625102000 -21600 0 EAST}
- {2643854400 -18000 1 EASST}
- {2657156400 -21600 0 EAST}
- {2675304000 -18000 1 EASST}
- {2688606000 -21600 0 EAST}
- {2706753600 -18000 1 EASST}
- {2720055600 -21600 0 EAST}
- {2738808000 -18000 1 EASST}
- {2751505200 -21600 0 EAST}
- {2770257600 -18000 1 EASST}
- {2782954800 -21600 0 EAST}
- {2801707200 -18000 1 EASST}
- {2814404400 -21600 0 EAST}
- {2833156800 -18000 1 EASST}
- {2846458800 -21600 0 EAST}
- {2864606400 -18000 1 EASST}
- {2877908400 -21600 0 EAST}
- {2896056000 -18000 1 EASST}
- {2909358000 -21600 0 EAST}
- {2928110400 -18000 1 EASST}
- {2940807600 -21600 0 EAST}
- {2959560000 -18000 1 EASST}
- {2972257200 -21600 0 EAST}
- {2991009600 -18000 1 EASST}
- {3004311600 -21600 0 EAST}
- {3022459200 -18000 1 EASST}
- {3035761200 -21600 0 EAST}
- {3053908800 -18000 1 EASST}
- {3067210800 -21600 0 EAST}
- {3085358400 -18000 1 EASST}
- {3098660400 -21600 0 EAST}
- {3117412800 -18000 1 EASST}
- {3130110000 -21600 0 EAST}
- {3148862400 -18000 1 EASST}
- {3161559600 -21600 0 EAST}
- {3180312000 -18000 1 EASST}
- {3193614000 -21600 0 EAST}
- {3211761600 -18000 1 EASST}
- {3225063600 -21600 0 EAST}
- {3243211200 -18000 1 EASST}
- {3256513200 -21600 0 EAST}
- {3275265600 -18000 1 EASST}
- {3287962800 -21600 0 EAST}
- {3306715200 -18000 1 EASST}
- {3319412400 -21600 0 EAST}
- {3338164800 -18000 1 EASST}
- {3351466800 -21600 0 EAST}
- {3369614400 -18000 1 EASST}
- {3382916400 -21600 0 EAST}
- {3401064000 -18000 1 EASST}
- {3414366000 -21600 0 EAST}
- {3432513600 -18000 1 EASST}
- {3445815600 -21600 0 EAST}
- {3464568000 -18000 1 EASST}
- {3477265200 -21600 0 EAST}
- {3496017600 -18000 1 EASST}
- {3508714800 -21600 0 EAST}
- {3527467200 -18000 1 EASST}
- {3540769200 -21600 0 EAST}
- {3558916800 -18000 1 EASST}
- {3572218800 -21600 0 EAST}
- {3590366400 -18000 1 EASST}
- {3603668400 -21600 0 EAST}
- {3622420800 -18000 1 EASST}
- {3635118000 -21600 0 EAST}
- {3653870400 -18000 1 EASST}
- {3666567600 -21600 0 EAST}
- {3685320000 -18000 1 EASST}
- {3698017200 -21600 0 EAST}
- {3716769600 -18000 1 EASST}
- {3730071600 -21600 0 EAST}
- {3748219200 -18000 1 EASST}
- {3761521200 -21600 0 EAST}
- {3779668800 -18000 1 EASST}
- {3792970800 -21600 0 EAST}
- {3811723200 -18000 1 EASST}
- {3824420400 -21600 0 EAST}
- {3843172800 -18000 1 EASST}
- {3855870000 -21600 0 EAST}
- {3874622400 -18000 1 EASST}
- {3887924400 -21600 0 EAST}
- {3906072000 -18000 1 EASST}
- {3919374000 -21600 0 EAST}
- {3937521600 -18000 1 EASST}
- {3950823600 -21600 0 EAST}
- {3968971200 -18000 1 EASST}
- {3982273200 -21600 0 EAST}
- {4001025600 -18000 1 EASST}
- {4013722800 -21600 0 EAST}
- {4032475200 -18000 1 EASST}
- {4045172400 -21600 0 EAST}
- {4063924800 -18000 1 EASST}
- {4077226800 -21600 0 EAST}
- {4095374400 -18000 1 EASST}
+ {1304823600 -21600 0 EAST}
+ {1313899200 -18000 1 EASST}
+ {1335668400 -21600 0 EAST}
+ {1346558400 -18000 1 EASST}
+ {1367118000 -21600 0 EAST}
+ {1378612800 -18000 1 EASST}
+ {1398567600 -21600 0 EAST}
+ {1410062400 -18000 1 EASST}
+ {1430017200 -21600 0 EAST}
+ {1441512000 -18000 1 EASST}
+ {1461466800 -21600 0 EAST}
+ {1472961600 -18000 1 EASST}
+ {1492916400 -21600 0 EAST}
+ {1504411200 -18000 1 EASST}
+ {1524970800 -21600 0 EAST}
+ {1535860800 -18000 1 EASST}
+ {1556420400 -21600 0 EAST}
+ {1567915200 -18000 1 EASST}
+ {1587870000 -21600 0 EAST}
+ {1599364800 -18000 1 EASST}
+ {1619319600 -21600 0 EAST}
+ {1630814400 -18000 1 EASST}
+ {1650769200 -21600 0 EAST}
+ {1662264000 -18000 1 EASST}
+ {1682218800 -21600 0 EAST}
+ {1693713600 -18000 1 EASST}
+ {1714273200 -21600 0 EAST}
+ {1725768000 -18000 1 EASST}
+ {1745722800 -21600 0 EAST}
+ {1757217600 -18000 1 EASST}
+ {1777172400 -21600 0 EAST}
+ {1788667200 -18000 1 EASST}
+ {1808622000 -21600 0 EAST}
+ {1820116800 -18000 1 EASST}
+ {1840071600 -21600 0 EAST}
+ {1851566400 -18000 1 EASST}
+ {1872126000 -21600 0 EAST}
+ {1883016000 -18000 1 EASST}
+ {1903575600 -21600 0 EAST}
+ {1915070400 -18000 1 EASST}
+ {1935025200 -21600 0 EAST}
+ {1946520000 -18000 1 EASST}
+ {1966474800 -21600 0 EAST}
+ {1977969600 -18000 1 EASST}
+ {1997924400 -21600 0 EAST}
+ {2009419200 -18000 1 EASST}
+ {2029374000 -21600 0 EAST}
+ {2040868800 -18000 1 EASST}
+ {2061428400 -21600 0 EAST}
+ {2072318400 -18000 1 EASST}
+ {2092878000 -21600 0 EAST}
+ {2104372800 -18000 1 EASST}
+ {2124327600 -21600 0 EAST}
+ {2135822400 -18000 1 EASST}
+ {2155777200 -21600 0 EAST}
+ {2167272000 -18000 1 EASST}
+ {2187226800 -21600 0 EAST}
+ {2198721600 -18000 1 EASST}
+ {2219281200 -21600 0 EAST}
+ {2230171200 -18000 1 EASST}
+ {2250730800 -21600 0 EAST}
+ {2262225600 -18000 1 EASST}
+ {2282180400 -21600 0 EAST}
+ {2293675200 -18000 1 EASST}
+ {2313630000 -21600 0 EAST}
+ {2325124800 -18000 1 EASST}
+ {2345079600 -21600 0 EAST}
+ {2356574400 -18000 1 EASST}
+ {2376529200 -21600 0 EAST}
+ {2388024000 -18000 1 EASST}
+ {2408583600 -21600 0 EAST}
+ {2419473600 -18000 1 EASST}
+ {2440033200 -21600 0 EAST}
+ {2451528000 -18000 1 EASST}
+ {2471482800 -21600 0 EAST}
+ {2482977600 -18000 1 EASST}
+ {2502932400 -21600 0 EAST}
+ {2514427200 -18000 1 EASST}
+ {2534382000 -21600 0 EAST}
+ {2545876800 -18000 1 EASST}
+ {2565831600 -21600 0 EAST}
+ {2577326400 -18000 1 EASST}
+ {2597886000 -21600 0 EAST}
+ {2609380800 -18000 1 EASST}
+ {2629335600 -21600 0 EAST}
+ {2640830400 -18000 1 EASST}
+ {2660785200 -21600 0 EAST}
+ {2672280000 -18000 1 EASST}
+ {2692234800 -21600 0 EAST}
+ {2703729600 -18000 1 EASST}
+ {2723684400 -21600 0 EAST}
+ {2735179200 -18000 1 EASST}
+ {2755738800 -21600 0 EAST}
+ {2766628800 -18000 1 EASST}
+ {2787188400 -21600 0 EAST}
+ {2798683200 -18000 1 EASST}
+ {2818638000 -21600 0 EAST}
+ {2830132800 -18000 1 EASST}
+ {2850087600 -21600 0 EAST}
+ {2861582400 -18000 1 EASST}
+ {2881537200 -21600 0 EAST}
+ {2893032000 -18000 1 EASST}
+ {2912986800 -21600 0 EAST}
+ {2924481600 -18000 1 EASST}
+ {2945041200 -21600 0 EAST}
+ {2955931200 -18000 1 EASST}
+ {2976490800 -21600 0 EAST}
+ {2987985600 -18000 1 EASST}
+ {3007940400 -21600 0 EAST}
+ {3019435200 -18000 1 EASST}
+ {3039390000 -21600 0 EAST}
+ {3050884800 -18000 1 EASST}
+ {3070839600 -21600 0 EAST}
+ {3082334400 -18000 1 EASST}
+ {3102894000 -21600 0 EAST}
+ {3113784000 -18000 1 EASST}
+ {3134343600 -21600 0 EAST}
+ {3145838400 -18000 1 EASST}
+ {3165793200 -21600 0 EAST}
+ {3177288000 -18000 1 EASST}
+ {3197242800 -21600 0 EAST}
+ {3208737600 -18000 1 EASST}
+ {3228692400 -21600 0 EAST}
+ {3240187200 -18000 1 EASST}
+ {3260142000 -21600 0 EAST}
+ {3271636800 -18000 1 EASST}
+ {3292196400 -21600 0 EAST}
+ {3303086400 -18000 1 EASST}
+ {3323646000 -21600 0 EAST}
+ {3335140800 -18000 1 EASST}
+ {3355095600 -21600 0 EAST}
+ {3366590400 -18000 1 EASST}
+ {3386545200 -21600 0 EAST}
+ {3398040000 -18000 1 EASST}
+ {3417994800 -21600 0 EAST}
+ {3429489600 -18000 1 EASST}
+ {3449444400 -21600 0 EAST}
+ {3460939200 -18000 1 EASST}
+ {3481498800 -21600 0 EAST}
+ {3492993600 -18000 1 EASST}
+ {3512948400 -21600 0 EAST}
+ {3524443200 -18000 1 EASST}
+ {3544398000 -21600 0 EAST}
+ {3555892800 -18000 1 EASST}
+ {3575847600 -21600 0 EAST}
+ {3587342400 -18000 1 EASST}
+ {3607297200 -21600 0 EAST}
+ {3618792000 -18000 1 EASST}
+ {3639351600 -21600 0 EAST}
+ {3650241600 -18000 1 EASST}
+ {3670801200 -21600 0 EAST}
+ {3682296000 -18000 1 EASST}
+ {3702250800 -21600 0 EAST}
+ {3713745600 -18000 1 EASST}
+ {3733700400 -21600 0 EAST}
+ {3745195200 -18000 1 EASST}
+ {3765150000 -21600 0 EAST}
+ {3776644800 -18000 1 EASST}
+ {3796599600 -21600 0 EAST}
+ {3808094400 -18000 1 EASST}
+ {3828654000 -21600 0 EAST}
+ {3839544000 -18000 1 EASST}
+ {3860103600 -21600 0 EAST}
+ {3871598400 -18000 1 EASST}
+ {3891553200 -21600 0 EAST}
+ {3903048000 -18000 1 EASST}
+ {3923002800 -21600 0 EAST}
+ {3934497600 -18000 1 EASST}
+ {3954452400 -21600 0 EAST}
+ {3965947200 -18000 1 EASST}
+ {3986506800 -21600 0 EAST}
+ {3997396800 -18000 1 EASST}
+ {4017956400 -21600 0 EAST}
+ {4029451200 -18000 1 EASST}
+ {4049406000 -21600 0 EAST}
+ {4060900800 -18000 1 EASST}
+ {4080855600 -21600 0 EAST}
+ {4092350400 -18000 1 EASST}
}
diff --git a/library/tzdata/Pacific/Efate b/library/tzdata/Pacific/Efate
index b586bc3..18db6de 100644
--- a/library/tzdata/Pacific/Efate
+++ b/library/tzdata/Pacific/Efate
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Efate) {
{-9223372036854775808 40396 0 LMT}
diff --git a/library/tzdata/Pacific/Enderbury b/library/tzdata/Pacific/Enderbury
index c184560..55784c4 100644
--- a/library/tzdata/Pacific/Enderbury
+++ b/library/tzdata/Pacific/Enderbury
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Enderbury) {
{-9223372036854775808 -41060 0 LMT}
diff --git a/library/tzdata/Pacific/Fakaofo b/library/tzdata/Pacific/Fakaofo
index 83b0ef7..6ec98eb 100644
--- a/library/tzdata/Pacific/Fakaofo
+++ b/library/tzdata/Pacific/Fakaofo
@@ -1,6 +1,7 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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 5f6e02f..454ee87 100644
--- a/library/tzdata/Pacific/Fiji
+++ b/library/tzdata/Pacific/Fiji
@@ -1,10 +1,191 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Fiji) {
- {-9223372036854775808 42820 0 LMT}
- {-1709985220 43200 0 FJT}
+ {-9223372036854775808 42944 0 LMT}
+ {-1709985344 43200 0 FJT}
{909842400 46800 1 FJST}
{920124000 43200 0 FJT}
{941896800 46800 1 FJST}
{951573600 43200 0 FJT}
+ {1259416800 46800 1 FJST}
+ {1269698400 43200 0 FJT}
+ {1287842400 46800 1 FJST}
+ {1299333600 43200 0 FJT}
+ {1319292000 46800 1 FJST}
+ {1327154400 43200 0 FJT}
+ {1350741600 46800 1 FJST}
+ {1358604000 43200 0 FJT}
+ {1382796000 46800 1 FJST}
+ {1390053600 43200 0 FJT}
+ {1414245600 46800 1 FJST}
+ {1421503200 43200 0 FJT}
+ {1445695200 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}
+ {1572098400 46800 1 FJST}
+ {1579356000 43200 0 FJT}
+ {1603548000 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}
+ {1729951200 46800 1 FJST}
+ {1737208800 43200 0 FJT}
+ {1761400800 46800 1 FJST}
+ {1768658400 43200 0 FJT}
+ {1792850400 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}
+ {1919253600 46800 1 FJST}
+ {1926511200 43200 0 FJT}
+ {1950703200 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}
+ {2108556000 46800 1 FJST}
+ {2115813600 43200 0 FJT}
+ {2140005600 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}
+ {2266408800 46800 1 FJST}
+ {2273666400 43200 0 FJT}
+ {2297858400 46800 1 FJST}
+ {2305116000 43200 0 FJT}
+ {2329308000 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}
+ {2455711200 46800 1 FJST}
+ {2462968800 43200 0 FJT}
+ {2487160800 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}
+ {2613564000 46800 1 FJST}
+ {2620821600 43200 0 FJT}
+ {2645013600 46800 1 FJST}
+ {2652271200 43200 0 FJT}
+ {2676463200 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}
+ {2802866400 46800 1 FJST}
+ {2810124000 43200 0 FJT}
+ {2834316000 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}
+ {2992168800 46800 1 FJST}
+ {2999426400 43200 0 FJT}
+ {3023618400 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}
+ {3150021600 46800 1 FJST}
+ {3157279200 43200 0 FJT}
+ {3181471200 46800 1 FJST}
+ {3188728800 43200 0 FJT}
+ {3212920800 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}
+ {3339324000 46800 1 FJST}
+ {3346581600 43200 0 FJT}
+ {3370773600 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}
+ {3497176800 46800 1 FJST}
+ {3504434400 43200 0 FJT}
+ {3528626400 46800 1 FJST}
+ {3535884000 43200 0 FJT}
+ {3560076000 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}
+ {3686479200 46800 1 FJST}
+ {3693736800 43200 0 FJT}
+ {3717928800 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}
+ {3875781600 46800 1 FJST}
+ {3883039200 43200 0 FJT}
+ {3907231200 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}
+ {4033634400 46800 1 FJST}
+ {4040892000 43200 0 FJT}
+ {4065084000 46800 1 FJST}
+ {4072341600 43200 0 FJT}
+ {4096533600 46800 1 FJST}
}
diff --git a/library/tzdata/Pacific/Funafuti b/library/tzdata/Pacific/Funafuti
index 6e14d0e..b94e4fb 100644
--- a/library/tzdata/Pacific/Funafuti
+++ b/library/tzdata/Pacific/Funafuti
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Funafuti) {
{-9223372036854775808 43012 0 LMT}
diff --git a/library/tzdata/Pacific/Galapagos b/library/tzdata/Pacific/Galapagos
index 357c26e..d8c80e8 100644
--- a/library/tzdata/Pacific/Galapagos
+++ b/library/tzdata/Pacific/Galapagos
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Galapagos) {
{-9223372036854775808 -21504 0 LMT}
diff --git a/library/tzdata/Pacific/Gambier b/library/tzdata/Pacific/Gambier
index 88e5b4f..d69f99a 100644
--- a/library/tzdata/Pacific/Gambier
+++ b/library/tzdata/Pacific/Gambier
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Gambier) {
{-9223372036854775808 -32388 0 LMT}
diff --git a/library/tzdata/Pacific/Guadalcanal b/library/tzdata/Pacific/Guadalcanal
index 2823890..09a67dd 100644
--- a/library/tzdata/Pacific/Guadalcanal
+++ b/library/tzdata/Pacific/Guadalcanal
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Guadalcanal) {
{-9223372036854775808 38388 0 LMT}
diff --git a/library/tzdata/Pacific/Guam b/library/tzdata/Pacific/Guam
index 6aceb20..79cca80 100644
--- a/library/tzdata/Pacific/Guam
+++ b/library/tzdata/Pacific/Guam
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Guam) {
{-9223372036854775808 -51660 0 LMT}
diff --git a/library/tzdata/Pacific/Honolulu b/library/tzdata/Pacific/Honolulu
index dbbaaaa..5e70598 100644
--- a/library/tzdata/Pacific/Honolulu
+++ b/library/tzdata/Pacific/Honolulu
@@ -1,12 +1,11 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
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/tzdata/Pacific/Johnston b/library/tzdata/Pacific/Johnston
index 94a1a15..21ab39a 100644
--- a/library/tzdata/Pacific/Johnston
+++ b/library/tzdata/Pacific/Johnston
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Pacific/Johnston) {
- {-9223372036854775808 -36000 0 HST}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Honolulu)]} {
+ LoadTimeZoneFile Pacific/Honolulu
}
+set TZData(:Pacific/Johnston) $TZData(:Pacific/Honolulu)
diff --git a/library/tzdata/Pacific/Kiritimati b/library/tzdata/Pacific/Kiritimati
index dda035a..06b695b 100644
--- a/library/tzdata/Pacific/Kiritimati
+++ b/library/tzdata/Pacific/Kiritimati
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kiritimati) {
{-9223372036854775808 -37760 0 LMT}
diff --git a/library/tzdata/Pacific/Kosrae b/library/tzdata/Pacific/Kosrae
index db8a6ed..a16b19d 100644
--- a/library/tzdata/Pacific/Kosrae
+++ b/library/tzdata/Pacific/Kosrae
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kosrae) {
{-9223372036854775808 39116 0 LMT}
diff --git a/library/tzdata/Pacific/Kwajalein b/library/tzdata/Pacific/Kwajalein
index 1583b52..8600b3b 100644
--- a/library/tzdata/Pacific/Kwajalein
+++ b/library/tzdata/Pacific/Kwajalein
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kwajalein) {
{-9223372036854775808 40160 0 LMT}
diff --git a/library/tzdata/Pacific/Majuro b/library/tzdata/Pacific/Majuro
index 71fa222..468baab 100644
--- a/library/tzdata/Pacific/Majuro
+++ b/library/tzdata/Pacific/Majuro
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Majuro) {
{-9223372036854775808 41088 0 LMT}
diff --git a/library/tzdata/Pacific/Marquesas b/library/tzdata/Pacific/Marquesas
index f8e618c..9bb508f 100644
--- a/library/tzdata/Pacific/Marquesas
+++ b/library/tzdata/Pacific/Marquesas
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Marquesas) {
{-9223372036854775808 -33480 0 LMT}
diff --git a/library/tzdata/Pacific/Midway b/library/tzdata/Pacific/Midway
index 4d49e70..c07b030 100644
--- a/library/tzdata/Pacific/Midway
+++ b/library/tzdata/Pacific/Midway
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Midway) {
{-9223372036854775808 -42568 0 LMT}
diff --git a/library/tzdata/Pacific/Nauru b/library/tzdata/Pacific/Nauru
index be30e5b..2da1e25 100644
--- a/library/tzdata/Pacific/Nauru
+++ b/library/tzdata/Pacific/Nauru
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Nauru) {
{-9223372036854775808 40060 0 LMT}
diff --git a/library/tzdata/Pacific/Niue b/library/tzdata/Pacific/Niue
index 529529a..cf149fc 100644
--- a/library/tzdata/Pacific/Niue
+++ b/library/tzdata/Pacific/Niue
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Niue) {
{-9223372036854775808 -40780 0 LMT}
diff --git a/library/tzdata/Pacific/Norfolk b/library/tzdata/Pacific/Norfolk
index f6d5638..a8fac15 100644
--- a/library/tzdata/Pacific/Norfolk
+++ b/library/tzdata/Pacific/Norfolk
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Norfolk) {
{-9223372036854775808 40312 0 LMT}
diff --git a/library/tzdata/Pacific/Noumea b/library/tzdata/Pacific/Noumea
index 8b5b086..db1eeae 100644
--- a/library/tzdata/Pacific/Noumea
+++ b/library/tzdata/Pacific/Noumea
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Noumea) {
{-9223372036854775808 39948 0 LMT}
@@ -7,6 +7,6 @@ set TZData(:Pacific/Noumea) {
{257342400 39600 0 NCT}
{281451600 43200 1 NCST}
{288878400 39600 0 NCT}
- {849405600 43200 1 NCST}
- {857268000 39600 0 NCT}
+ {849366000 43200 1 NCST}
+ {857228400 39600 0 NCT}
}
diff --git a/library/tzdata/Pacific/Pago_Pago b/library/tzdata/Pacific/Pago_Pago
index a23a4a2..830f9ee 100644
--- a/library/tzdata/Pacific/Pago_Pago
+++ b/library/tzdata/Pacific/Pago_Pago
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Pago_Pago) {
{-9223372036854775808 45432 0 LMT}
diff --git a/library/tzdata/Pacific/Palau b/library/tzdata/Pacific/Palau
index 23fb850..ee0606d 100644
--- a/library/tzdata/Pacific/Palau
+++ b/library/tzdata/Pacific/Palau
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Palau) {
{-9223372036854775808 32276 0 LMT}
diff --git a/library/tzdata/Pacific/Pitcairn b/library/tzdata/Pacific/Pitcairn
index c78c3ee..d62644e 100644
--- a/library/tzdata/Pacific/Pitcairn
+++ b/library/tzdata/Pacific/Pitcairn
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Pitcairn) {
{-9223372036854775808 -31220 0 LMT}
diff --git a/library/tzdata/Pacific/Pohnpei b/library/tzdata/Pacific/Pohnpei
new file mode 100644
index 0000000..58978da
--- /dev/null
+++ b/library/tzdata/Pacific/Pohnpei
@@ -0,0 +1,6 @@
+# created by tools/tclZIC.tcl - do not edit
+
+set TZData(:Pacific/Pohnpei) {
+ {-9223372036854775808 37972 0 LMT}
+ {-2177490772 39600 0 PONT}
+}
diff --git a/library/tzdata/Pacific/Ponape b/library/tzdata/Pacific/Ponape
index 58d5dac..89644f7 100644
--- a/library/tzdata/Pacific/Ponape
+++ b/library/tzdata/Pacific/Ponape
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Pacific/Ponape) {
- {-9223372036854775808 37972 0 LMT}
- {-2177490772 39600 0 PONT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Pohnpei)]} {
+ LoadTimeZoneFile Pacific/Pohnpei
}
+set TZData(:Pacific/Ponape) $TZData(:Pacific/Pohnpei)
diff --git a/library/tzdata/Pacific/Port_Moresby b/library/tzdata/Pacific/Port_Moresby
index 8b90e04..65eb533 100644
--- a/library/tzdata/Pacific/Port_Moresby
+++ b/library/tzdata/Pacific/Port_Moresby
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Port_Moresby) {
{-9223372036854775808 35320 0 LMT}
diff --git a/library/tzdata/Pacific/Rarotonga b/library/tzdata/Pacific/Rarotonga
index d7aae35..a4ecf8d 100644
--- a/library/tzdata/Pacific/Rarotonga
+++ b/library/tzdata/Pacific/Rarotonga
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Rarotonga) {
{-9223372036854775808 -38344 0 LMT}
diff --git a/library/tzdata/Pacific/Saipan b/library/tzdata/Pacific/Saipan
index 460ecf9..b799298 100644
--- a/library/tzdata/Pacific/Saipan
+++ b/library/tzdata/Pacific/Saipan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Saipan) {
{-9223372036854775808 -51420 0 LMT}
diff --git a/library/tzdata/Pacific/Samoa b/library/tzdata/Pacific/Samoa
index 1863e5e..686eb34 100644
--- a/library/tzdata/Pacific/Samoa
+++ b/library/tzdata/Pacific/Samoa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Pago_Pago)]} {
LoadTimeZoneFile Pacific/Pago_Pago
}
diff --git a/library/tzdata/Pacific/Tahiti b/library/tzdata/Pacific/Tahiti
index 055d631..f739223 100644
--- a/library/tzdata/Pacific/Tahiti
+++ b/library/tzdata/Pacific/Tahiti
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Tahiti) {
{-9223372036854775808 -35896 0 LMT}
diff --git a/library/tzdata/Pacific/Tarawa b/library/tzdata/Pacific/Tarawa
index 03a8dcd..2dab5a2 100644
--- a/library/tzdata/Pacific/Tarawa
+++ b/library/tzdata/Pacific/Tarawa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Tarawa) {
{-9223372036854775808 41524 0 LMT}
diff --git a/library/tzdata/Pacific/Tongatapu b/library/tzdata/Pacific/Tongatapu
index 4ba096b..da9f857 100644
--- a/library/tzdata/Pacific/Tongatapu
+++ b/library/tzdata/Pacific/Tongatapu
@@ -1,12 +1,12 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Tongatapu) {
{-9223372036854775808 44360 0 LMT}
{-2177497160 44400 0 TOT}
{-915193200 46800 0 TOT}
{915102000 46800 0 TOT}
- {939261600 50400 1 TOST}
- {953431200 46800 0 TOT}
+ {939214800 50400 1 TOST}
+ {953384400 46800 0 TOT}
{973342800 50400 1 TOST}
{980596800 46800 0 TOT}
{1004792400 50400 1 TOST}
diff --git a/library/tzdata/Pacific/Truk b/library/tzdata/Pacific/Truk
index 19dad5f..c9b1894 100644
--- a/library/tzdata/Pacific/Truk
+++ b/library/tzdata/Pacific/Truk
@@ -1,6 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Pacific/Truk) {
- {-9223372036854775808 36428 0 LMT}
- {-2177489228 36000 0 TRUT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Chuuk)]} {
+ LoadTimeZoneFile Pacific/Chuuk
}
+set TZData(:Pacific/Truk) $TZData(:Pacific/Chuuk)
diff --git a/library/tzdata/Pacific/Wake b/library/tzdata/Pacific/Wake
index 71d7ea4..5afedf5 100644
--- a/library/tzdata/Pacific/Wake
+++ b/library/tzdata/Pacific/Wake
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Wake) {
{-9223372036854775808 39988 0 LMT}
diff --git a/library/tzdata/Pacific/Wallis b/library/tzdata/Pacific/Wallis
index 5f02993..7bdd964 100644
--- a/library/tzdata/Pacific/Wallis
+++ b/library/tzdata/Pacific/Wallis
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Wallis) {
{-9223372036854775808 44120 0 LMT}
diff --git a/library/tzdata/Pacific/Yap b/library/tzdata/Pacific/Yap
index 78d9677..4931030 100644
--- a/library/tzdata/Pacific/Yap
+++ b/library/tzdata/Pacific/Yap
@@ -1,7 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-
-set TZData(:Pacific/Yap) {
- {-9223372036854775808 33152 0 LMT}
- {-2177485952 32400 0 YAPT}
- {-7981200 36000 0 YAPT}
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(Pacific/Chuuk)]} {
+ LoadTimeZoneFile Pacific/Chuuk
}
+set TZData(:Pacific/Yap) $TZData(:Pacific/Chuuk)
diff --git a/library/tzdata/Poland b/library/tzdata/Poland
index 8352200..bd24028 100644
--- a/library/tzdata/Poland
+++ b/library/tzdata/Poland
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Warsaw)]} {
LoadTimeZoneFile Europe/Warsaw
}
diff --git a/library/tzdata/Portugal b/library/tzdata/Portugal
index 607b287..d1ffd9f 100644
--- a/library/tzdata/Portugal
+++ b/library/tzdata/Portugal
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Lisbon)]} {
LoadTimeZoneFile Europe/Lisbon
}
diff --git a/library/tzdata/ROC b/library/tzdata/ROC
index bbbd899..5dd196d 100644
--- a/library/tzdata/ROC
+++ b/library/tzdata/ROC
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Taipei)]} {
LoadTimeZoneFile Asia/Taipei
}
diff --git a/library/tzdata/ROK b/library/tzdata/ROK
index ffeb05a..1162ce4 100644
--- a/library/tzdata/ROK
+++ b/library/tzdata/ROK
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Seoul)]} {
LoadTimeZoneFile Asia/Seoul
}
diff --git a/library/tzdata/Singapore b/library/tzdata/Singapore
index c9d3748..1584b35 100644
--- a/library/tzdata/Singapore
+++ b/library/tzdata/Singapore
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Singapore)]} {
LoadTimeZoneFile Asia/Singapore
}
diff --git a/library/tzdata/Turkey b/library/tzdata/Turkey
index 42c21aa..e20a7a5 100644
--- a/library/tzdata/Turkey
+++ b/library/tzdata/Turkey
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Istanbul)]} {
LoadTimeZoneFile Europe/Istanbul
}
diff --git a/library/tzdata/UCT b/library/tzdata/UCT
index 93613f8..8449328 100644
--- a/library/tzdata/UCT
+++ b/library/tzdata/UCT
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UCT)]} {
LoadTimeZoneFile Etc/UCT
}
diff --git a/library/tzdata/US/Alaska b/library/tzdata/US/Alaska
index 3d5f3f1..69a3899 100644
--- a/library/tzdata/US/Alaska
+++ b/library/tzdata/US/Alaska
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Anchorage)]} {
LoadTimeZoneFile America/Anchorage
}
diff --git a/library/tzdata/US/Aleutian b/library/tzdata/US/Aleutian
index edd69ab..024e70b 100644
--- a/library/tzdata/US/Aleutian
+++ b/library/tzdata/US/Aleutian
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Adak)]} {
LoadTimeZoneFile America/Adak
}
diff --git a/library/tzdata/US/Arizona b/library/tzdata/US/Arizona
index ac79efb..8eaa961 100644
--- a/library/tzdata/US/Arizona
+++ b/library/tzdata/US/Arizona
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Phoenix)]} {
LoadTimeZoneFile America/Phoenix
}
diff --git a/library/tzdata/US/Central b/library/tzdata/US/Central
index 8aed5de..2aab66e 100644
--- a/library/tzdata/US/Central
+++ b/library/tzdata/US/Central
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Chicago)]} {
LoadTimeZoneFile America/Chicago
}
diff --git a/library/tzdata/US/East-Indiana b/library/tzdata/US/East-Indiana
index 3a14fc8..2035a06 100644
--- a/library/tzdata/US/East-Indiana
+++ b/library/tzdata/US/East-Indiana
@@ -1,5 +1,5 @@
-# created by ../tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Indianapolis)]} {
- LoadTimeZoneFile America/Indianapolis
+# created by tools/tclZIC.tcl - do not edit
+if {![info exists TZData(America/Indiana/Indianapolis)]} {
+ LoadTimeZoneFile America/Indiana/Indianapolis
}
-set TZData(:US/East-Indiana) $TZData(:America/Indianapolis)
+set TZData(:US/East-Indiana) $TZData(:America/Indiana/Indianapolis)
diff --git a/library/tzdata/US/Eastern b/library/tzdata/US/Eastern
index c891b87..3cf2651 100644
--- a/library/tzdata/US/Eastern
+++ b/library/tzdata/US/Eastern
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/New_York)]} {
LoadTimeZoneFile America/New_York
}
diff --git a/library/tzdata/US/Hawaii b/library/tzdata/US/Hawaii
index c326e28..6d1af65 100644
--- a/library/tzdata/US/Hawaii
+++ b/library/tzdata/US/Hawaii
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Honolulu)]} {
LoadTimeZoneFile Pacific/Honolulu
}
diff --git a/library/tzdata/US/Indiana-Starke b/library/tzdata/US/Indiana-Starke
index 3a784a3..6ffe0e2 100644
--- a/library/tzdata/US/Indiana-Starke
+++ b/library/tzdata/US/Indiana-Starke
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Indiana/Knox)]} {
LoadTimeZoneFile America/Indiana/Knox
}
diff --git a/library/tzdata/US/Michigan b/library/tzdata/US/Michigan
index 9137090..b15035c 100644
--- a/library/tzdata/US/Michigan
+++ b/library/tzdata/US/Michigan
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Detroit)]} {
LoadTimeZoneFile America/Detroit
}
diff --git a/library/tzdata/US/Mountain b/library/tzdata/US/Mountain
index b965c02..b54235f 100644
--- a/library/tzdata/US/Mountain
+++ b/library/tzdata/US/Mountain
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Denver)]} {
LoadTimeZoneFile America/Denver
}
diff --git a/library/tzdata/US/Pacific b/library/tzdata/US/Pacific
index 28db81d..7232215 100644
--- a/library/tzdata/US/Pacific
+++ b/library/tzdata/US/Pacific
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Los_Angeles)]} {
LoadTimeZoneFile America/Los_Angeles
}
diff --git a/library/tzdata/US/Pacific-New b/library/tzdata/US/Pacific-New
index e4c1397..2eb30f8 100644
--- a/library/tzdata/US/Pacific-New
+++ b/library/tzdata/US/Pacific-New
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Los_Angeles)]} {
LoadTimeZoneFile America/Los_Angeles
}
diff --git a/library/tzdata/US/Samoa b/library/tzdata/US/Samoa
index e58c5d4..ad86b4f 100644
--- a/library/tzdata/US/Samoa
+++ b/library/tzdata/US/Samoa
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Pago_Pago)]} {
LoadTimeZoneFile Pacific/Pago_Pago
}
diff --git a/library/tzdata/UTC b/library/tzdata/UTC
index b7da512..6d04d96 100644
--- a/library/tzdata/UTC
+++ b/library/tzdata/UTC
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
diff --git a/library/tzdata/Universal b/library/tzdata/Universal
index 9d0ccb3..4a9ed5e 100644
--- a/library/tzdata/Universal
+++ b/library/tzdata/Universal
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
diff --git a/library/tzdata/W-SU b/library/tzdata/W-SU
index 98fa96b..7e1f613 100644
--- a/library/tzdata/W-SU
+++ b/library/tzdata/W-SU
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Moscow)]} {
LoadTimeZoneFile Europe/Moscow
}
diff --git a/library/tzdata/WET b/library/tzdata/WET
index 0d2eeb6..60366a3 100644
--- a/library/tzdata/WET
+++ b/library/tzdata/WET
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
set TZData(:WET) {
{-9223372036854775808 0 0 WET}
diff --git a/library/tzdata/Zulu b/library/tzdata/Zulu
index 81bab4e..e9748e4 100644
--- a/library/tzdata/Zulu
+++ b/library/tzdata/Zulu
@@ -1,4 +1,4 @@
-# created by ../tools/tclZIC.tcl - do not edit
+# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
diff --git a/library/word.tcl b/library/word.tcl
index 05c3bab..b8f34a5 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -1,132 +1,144 @@
# word.tcl --
#
-# This file defines various procedures for computing word boundaries
-# in strings. This file is primarily needed so Tk text and entry
-# widgets behave properly for different platforms.
+# This file defines various procedures for computing word boundaries in
+# strings. This file is primarily needed so Tk text and entry widgets behave
+# properly for different platforms.
#
# 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.8 2005/07/23 04:12:49 dgp Exp $
# The following variables are used to determine which characters are
-# interpreted as white space.
+# interpreted as white space.
if {$::tcl_platform(platform) eq "windows"} {
# Windows style - any but a unicode space char
- set tcl_wordchars "\\S"
- set tcl_nonwordchars "\\s"
+ set ::tcl_wordchars {\S}
+ set ::tcl_nonwordchars {\s}
} else {
# Motif style - any unicode word char (number, letter, or underscore)
- set tcl_wordchars "\\w"
- set tcl_nonwordchars "\\W"
+ set ::tcl_wordchars {\w}
+ set ::tcl_nonwordchars {\W}
+}
+
+# Arrange for caches of the real matcher REs to be kept, which enables the REs
+# themselves to be cached for greater performance (and somewhat greater
+# clarity too).
+
+namespace eval ::tcl {
+ variable WordBreakRE
+ array set WordBreakRE {}
+
+ proc UpdateWordBreakREs args {
+ # Ignores the arguments
+ global tcl_wordchars tcl_nonwordchars
+ variable WordBreakRE
+
+ # To keep the RE strings short...
+ set letter $tcl_wordchars
+ set space $tcl_nonwordchars
+
+ set WordBreakRE(after) "$letter$space|$space$letter"
+ set WordBreakRE(before) "^.*($letter$space|$space$letter)"
+ set WordBreakRE(end) "$space*$letter+$space"
+ set WordBreakRE(next) "$letter*$space+$letter"
+ set WordBreakRE(previous) "$space*($letter+)$space*\$"
+ }
+
+ # Initialize the cache
+ UpdateWordBreakREs
+ trace add variable ::tcl_wordchars write ::tcl::UpdateWordBreakREs
+ trace add variable ::tcl_nonwordchars write ::tcl::UpdateWordBreakREs
}
# tcl_wordBreakAfter --
#
-# This procedure returns the index of the first word boundary
-# after the starting point in the given string, or -1 if there
-# are no more boundaries in the given string. The index returned refers
-# to the first character of the pair that comprises a boundary.
+# This procedure returns the index of the first word boundary after the
+# starting point in the given string, or -1 if there are no more boundaries in
+# the given string. The index returned refers to the first character of the
+# pair that comprises a boundary.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_wordBreakAfter {str start} {
- global tcl_nonwordchars tcl_wordchars
- set str [string range $str $start end]
- if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} {
- return [expr {[lindex $result 1] + $start}]
- }
- return -1
+ variable ::tcl::WordBreakRE
+ set result {-1 -1}
+ regexp -indices -start $start -- $WordBreakRE(after) $str result
+ return [lindex $result 1]
}
# tcl_wordBreakBefore --
#
-# This procedure returns the index of the first word boundary
-# before the starting point in the given string, or -1 if there
-# are no more boundaries in the given string. The index returned
-# refers to the second character of the pair that comprises a boundary.
+# This procedure returns the index of the first word boundary before the
+# starting point in the given string, or -1 if there are no more boundaries in
+# the given string. The index returned refers to the second character of the
+# pair that comprises a boundary.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_wordBreakBefore {str start} {
- global tcl_nonwordchars tcl_wordchars
- if {$start eq "end"} {
- set start [string length $str]
- }
- if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
- return [lindex $result 1]
- }
- return -1
+ variable ::tcl::WordBreakRE
+ set result {-1 -1}
+ regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
+ return [lindex $result 1]
}
# tcl_endOfWord --
#
-# This procedure returns the index of the first end-of-word location
-# after a starting index in the given string. An end-of-word location
-# is defined to be the first whitespace character following the first
-# non-whitespace character after the starting point. Returns -1 if
-# there are no more words after the starting point.
+# This procedure returns the index of the first end-of-word location after a
+# starting index in the given string. An end-of-word location is defined to be
+# the first whitespace character following the first non-whitespace character
+# after the starting point. Returns -1 if there are no more words after the
+# starting point.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_endOfWord {str start} {
- global tcl_nonwordchars tcl_wordchars
- if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
- [string range $str $start end] result]} {
- return [expr {[lindex $result 1] + $start}]
- }
- return -1
+ variable ::tcl::WordBreakRE
+ set result {-1 -1}
+ regexp -indices -start $start -- $WordBreakRE(end) $str result
+ return [lindex $result 1]
}
# tcl_startOfNextWord --
#
-# This procedure returns the index of the first start-of-word location
-# after a starting index in the given string. A start-of-word
-# location is defined to be a non-whitespace character following a
-# whitespace character. Returns -1 if there are no more start-of-word
-# locations after the starting point.
+# This procedure returns the index of the first start-of-word location after a
+# starting index in the given string. A start-of-word location is defined to
+# be a non-whitespace character following a whitespace character. Returns -1
+# if there are no more start-of-word locations after the starting point.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_startOfNextWord {str start} {
- global tcl_nonwordchars tcl_wordchars
- if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
- [string range $str $start end] result]} {
- return [expr {[lindex $result 1] + $start}]
- }
- return -1
+ variable ::tcl::WordBreakRE
+ set result {-1 -1}
+ regexp -indices -start $start -- $WordBreakRE(next) $str result
+ return [lindex $result 1]
}
# tcl_startOfPreviousWord --
#
-# This procedure returns the index of the first start-of-word location
-# before a starting index in the given string.
+# This procedure returns the index of the first start-of-word location before
+# a starting index in the given string.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_startOfPreviousWord {str start} {
- global tcl_nonwordchars tcl_wordchars
- if {$start eq "end"} {
- set start [string length $str]
- }
- if {[regexp -indices \
- "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
- [string range $str 0 [expr {$start - 1}]] result word]} {
- return [lindex $word 0]
- }
- return -1
+ variable ::tcl::WordBreakRE
+ set word {-1 -1}
+ regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
+ result word
+ return [lindex $word 0]
}
diff --git a/libtommath/bn.pdf b/libtommath/bn.pdf
index 0124c71..392b649 100644
--- a/libtommath/bn.pdf
+++ b/libtommath/bn.pdf
Binary files differ
diff --git a/libtommath/bn.tex b/libtommath/bn.tex
index 8b37766..e8eb994 100644
--- a/libtommath/bn.tex
+++ b/libtommath/bn.tex
@@ -49,7 +49,7 @@
\begin{document}
\frontmatter
\pagestyle{empty}
-\title{LibTomMath User Manual \\ v0.36}
+\title{LibTomMath User Manual \\ v0.39}
\author{Tom St Denis \\ tomstdenis@iahu.ca}
\maketitle
This text, the library and the accompanying textbook are all hereby placed in the public domain. This book has been
diff --git a/libtommath/bn_error.c b/libtommath/bn_error.c
index e260763..6393bb0 100644
--- a/libtommath/bn_error.c
+++ b/libtommath/bn_error.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
static const struct {
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_fast_mp_invmod.c b/libtommath/bn_fast_mp_invmod.c
index 9f4a4da..fafd9dc 100644
--- a/libtommath/bn_fast_mp_invmod.c
+++ b/libtommath/bn_fast_mp_invmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes the modular inverse via binary extended euclidean algorithm,
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_fast_mp_montgomery_reduce.c b/libtommath/bn_fast_mp_montgomery_reduce.c
index e676c6e..e941dc2 100644
--- a/libtommath/bn_fast_mp_montgomery_reduce.c
+++ b/libtommath/bn_fast_mp_montgomery_reduce.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes xR**-1 == x (mod N) via Montgomery Reduction
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_fast_s_mp_mul_digs.c b/libtommath/bn_fast_s_mp_mul_digs.c
index 0c715be..ab157b9 100644
--- a/libtommath/bn_fast_s_mp_mul_digs.c
+++ b/libtommath/bn_fast_s_mp_mul_digs.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Fast (comba) multiplier
@@ -78,10 +78,7 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
/* make next carry */
_W = _W >> ((mp_word)DIGIT_BIT);
- }
-
- /* store final carry */
- W[ix] = (mp_digit)(_W & MP_MASK);
+ }
/* setup dest */
olduse = c->used;
@@ -104,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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_fast_s_mp_mul_high_digs.c b/libtommath/bn_fast_s_mp_mul_high_digs.c
index 7c10ce4..ec9f58a 100644
--- a/libtommath/bn_fast_s_mp_mul_high_digs.c
+++ b/libtommath/bn_fast_s_mp_mul_high_digs.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* this is a modified version of fast_s_mul_digs that only produces
@@ -70,9 +70,6 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
_W = _W >> ((mp_word)DIGIT_BIT);
}
- /* store final carry */
- W[ix] = (mp_digit)(_W & MP_MASK);
-
/* setup dest */
olduse = c->used;
c->used = pa;
@@ -81,7 +78,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];
}
@@ -95,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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_fast_s_mp_sqr.c b/libtommath/bn_fast_s_mp_sqr.c
index c8f0dc6..1abf24b 100644
--- a/libtommath/bn_fast_s_mp_sqr.c
+++ b/libtommath/bn_fast_s_mp_sqr.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* the jist of squaring...
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_2expt.c b/libtommath/bn_mp_2expt.c
index d859623..a32572d 100644
--- a/libtommath/bn_mp_2expt.c
+++ b/libtommath/bn_mp_2expt.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes a = 2**b
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_abs.c b/libtommath/bn_mp_abs.c
index 7231a27..dc51884 100644
--- a/libtommath/bn_mp_abs.c
+++ b/libtommath/bn_mp_abs.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = |a|
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_add.c b/libtommath/bn_mp_add.c
index 74dcb48..d9b8fa5 100644
--- a/libtommath/bn_mp_add.c
+++ b/libtommath/bn_mp_add.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level addition (handles signs) */
@@ -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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_add_d.c b/libtommath/bn_mp_add_d.c
index fde3cee..5281ad4 100644
--- a/libtommath/bn_mp_add_d.c
+++ b/libtommath/bn_mp_add_d.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* single digit addition */
@@ -37,8 +37,12 @@ mp_add_d (mp_int * a, mp_digit b, mp_int * c)
/* c = |a| - b */
res = mp_sub_d(a, b, c);
- /* fix sign */
- a->sign = c->sign = MP_NEG;
+ /* fix signs */
+ a->sign = MP_NEG;
+ c->sign = (c->used) ? MP_NEG : MP_ZPOS;
+
+ /* clamp */
+ mp_clamp(c);
return res;
}
@@ -103,7 +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 $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_addmod.c b/libtommath/bn_mp_addmod.c
index 5cf1604..bff193f 100644
--- a/libtommath/bn_mp_addmod.c
+++ b/libtommath/bn_mp_addmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a + b (mod 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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_and.c b/libtommath/bn_mp_and.c
index 9715308..02bef18 100644
--- a/libtommath/bn_mp_and.c
+++ b/libtommath/bn_mp_and.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* AND two ints together */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_clamp.c b/libtommath/bn_mp_clamp.c
index 56a6362..74887bb 100644
--- a/libtommath/bn_mp_clamp.c
+++ b/libtommath/bn_mp_clamp.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* trim unused digits
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_clear.c b/libtommath/bn_mp_clear.c
index 7564fff..bd07e76 100644
--- a/libtommath/bn_mp_clear.c
+++ b/libtommath/bn_mp_clear.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* clear one (frees) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_clear_multi.c b/libtommath/bn_mp_clear_multi.c
index 2766907..c3ad7a8 100644
--- a/libtommath/bn_mp_clear_multi.c
+++ b/libtommath/bn_mp_clear_multi.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#include <stdarg.h>
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_cmp.c b/libtommath/bn_mp_cmp.c
index ce82baf..943249d 100644
--- a/libtommath/bn_mp_cmp.c
+++ b/libtommath/bn_mp_cmp.c
@@ -12,12 +12,12 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare two ints (signed)*/
int
-mp_cmp (mp_int * a, mp_int * b)
+mp_cmp (const mp_int * a, const mp_int * b)
{
/* compare based on sign */
if (a->sign != b->sign) {
@@ -37,7 +37,3 @@ mp_cmp (mp_int * a, mp_int * b)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_cmp_d.c b/libtommath/bn_mp_cmp_d.c
index 2d98647..ecec091 100644
--- a/libtommath/bn_mp_cmp_d.c
+++ b/libtommath/bn_mp_cmp_d.c
@@ -12,11 +12,11 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare a digit */
-int mp_cmp_d(mp_int * a, mp_digit b)
+int mp_cmp_d(const mp_int * a, mp_digit b)
{
/* compare based on sign */
if (a->sign == MP_NEG) {
@@ -38,7 +38,3 @@ int mp_cmp_d(mp_int * a, mp_digit b)
}
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp_d.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_cmp_mag.c b/libtommath/bn_mp_cmp_mag.c
index 3ade54f..b23a191 100644
--- a/libtommath/bn_mp_cmp_mag.c
+++ b/libtommath/bn_mp_cmp_mag.c
@@ -12,11 +12,11 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare maginitude of two ints (unsigned) */
-int mp_cmp_mag (mp_int * a, mp_int * b)
+int mp_cmp_mag (const mp_int * a, const mp_int * b)
{
int n;
mp_digit *tmpa, *tmpb;
@@ -49,7 +49,3 @@ int mp_cmp_mag (mp_int * a, mp_int * b)
return MP_EQ;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_cmp_mag.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_cnt_lsb.c b/libtommath/bn_mp_cnt_lsb.c
index 6ff212d..f205e8c 100644
--- a/libtommath/bn_mp_cnt_lsb.c
+++ b/libtommath/bn_mp_cnt_lsb.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
static const int lnz[16] = {
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_copy.c b/libtommath/bn_mp_copy.c
index f2de108..ffbc0d4 100644
--- a/libtommath/bn_mp_copy.c
+++ b/libtommath/bn_mp_copy.c
@@ -12,12 +12,12 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* copy, b = a */
int
-mp_copy (mp_int * a, mp_int * b)
+mp_copy (const mp_int * a, mp_int * b)
{
int res, n;
@@ -62,7 +62,3 @@ mp_copy (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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_count_bits.c b/libtommath/bn_mp_count_bits.c
index cfab837..00d364e 100644
--- a/libtommath/bn_mp_count_bits.c
+++ b/libtommath/bn_mp_count_bits.c
@@ -12,12 +12,12 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* returns the number of bits in an int */
int
-mp_count_bits (mp_int * a)
+mp_count_bits (const mp_int * a)
{
int r;
mp_digit q;
@@ -39,7 +39,3 @@ mp_count_bits (mp_int * a)
return r;
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_count_bits.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_div.c b/libtommath/bn_mp_div.c
index a0a9d7c..de4ca04 100644
--- a/libtommath/bn_mp_div.c
+++ b/libtommath/bn_mp_div.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifdef BN_MP_DIV_SMALL
@@ -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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_div_2.c b/libtommath/bn_mp_div_2.c
index 23cd43a..186a959 100644
--- a/libtommath/bn_mp_div_2.c
+++ b/libtommath/bn_mp_div_2.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = a/2 */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_div_2d.c b/libtommath/bn_mp_div_2d.c
index 305eeaa..d7b7e05 100644
--- a/libtommath/bn_mp_div_2d.c
+++ b/libtommath/bn_mp_div_2d.c
@@ -12,11 +12,11 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift right by a certain bit count (store quotient in c, optional remainder in d) */
-int mp_div_2d (mp_int * a, int b, mp_int * c, mp_int * d)
+int mp_div_2d (const mp_int * a, int b, mp_int * c, mp_int * d)
{
mp_digit D, r, rr;
int x, res;
@@ -91,7 +91,3 @@ int mp_div_2d (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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_div_3.c b/libtommath/bn_mp_div_3.c
index 69d25cf..79a9816 100644
--- a/libtommath/bn_mp_div_3.c
+++ b/libtommath/bn_mp_div_3.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* divide by three (based on routine from MPI and the GMP manual) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_div_d.c b/libtommath/bn_mp_div_d.c
index c3afceb..af18d0a 100644
--- a/libtommath/bn_mp_div_d.c
+++ b/libtommath/bn_mp_div_d.c
@@ -12,13 +12,17 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
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==0) || (b & (b-1))) {
+ return 0;
+ }
for (x = 1; x < DIGIT_BIT; x++) {
if (b == (((mp_digit)1)<<x)) {
*p = x;
@@ -104,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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_dr_is_modulus.c b/libtommath/bn_mp_dr_is_modulus.c
index b11bc0c..8ad31dc 100644
--- a/libtommath/bn_mp_dr_is_modulus.c
+++ b/libtommath/bn_mp_dr_is_modulus.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if a number is a valid DR modulus */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_dr_reduce.c b/libtommath/bn_mp_dr_reduce.c
index c7119a1..8337591 100644
--- a/libtommath/bn_mp_dr_reduce.c
+++ b/libtommath/bn_mp_dr_reduce.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduce "x" in place modulo "n" using the Diminished Radix algorithm.
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_dr_setup.c b/libtommath/bn_mp_dr_setup.c
index c177199..de00e2d 100644
--- a/libtommath/bn_mp_dr_setup.c
+++ b/libtommath/bn_mp_dr_setup.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_exch.c b/libtommath/bn_mp_exch.c
index 7bb1169..b7bd186 100644
--- a/libtommath/bn_mp_exch.c
+++ b/libtommath/bn_mp_exch.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* swap the elements of two integers, for cases where you can't simply swap the
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_expt_d.c b/libtommath/bn_mp_expt_d.c
index d5067ab..132f480 100644
--- a/libtommath/bn_mp_expt_d.c
+++ b/libtommath/bn_mp_expt_d.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* calculate c = a**b using a square-multiply algorithm */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_exptmod.c b/libtommath/bn_mp_exptmod.c
index f0b205b..b7d9fb7 100644
--- a/libtommath/bn_mp_exptmod.c
+++ b/libtommath/bn_mp_exptmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_exptmod_fast.c b/libtommath/bn_mp_exptmod_fast.c
index e4f25df..1902e79 100644
--- a/libtommath/bn_mp_exptmod_fast.c
+++ b/libtommath/bn_mp_exptmod_fast.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_exteuclid.c b/libtommath/bn_mp_exteuclid.c
index f0ae8e5..2e69ce1 100644
--- a/libtommath/bn_mp_exteuclid.c
+++ b/libtommath/bn_mp_exteuclid.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Extended euclidean algorithm of (a, b) produces
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_fread.c b/libtommath/bn_mp_fread.c
index f1c72fd..44e1ea8 100644
--- a/libtommath/bn_mp_fread.c
+++ b/libtommath/bn_mp_fread.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read a bigint from a file stream in ASCII */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_fwrite.c b/libtommath/bn_mp_fwrite.c
index 29c0a2b..b0ec29e 100644
--- a/libtommath/bn_mp_fwrite.c
+++ b/libtommath/bn_mp_fwrite.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
int mp_fwrite(mp_int *a, int radix, FILE *stream)
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_gcd.c b/libtommath/bn_mp_gcd.c
index f0141ac..68cfa03 100644
--- a/libtommath/bn_mp_gcd.c
+++ b/libtommath/bn_mp_gcd.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Greatest Common Divisor using the binary method */
@@ -22,21 +22,13 @@ int mp_gcd (mp_int * a, mp_int * b, mp_int * c)
int k, u_lsb, v_lsb, res;
/* either zero than gcd is the largest */
- if (mp_iszero (a) == 1 && mp_iszero (b) == 0) {
+ if (mp_iszero (a) == MP_YES) {
return mp_abs (b, c);
}
- if (mp_iszero (a) == 0 && mp_iszero (b) == 1) {
+ if (mp_iszero (b) == MP_YES) {
return mp_abs (a, c);
}
- /* optimized. At this point if a == 0 then
- * b must equal zero too
- */
- if (mp_iszero (a) == 1) {
- mp_zero(c);
- return MP_OKAY;
- }
-
/* get copies of a and b we can modify */
if ((res = mp_init_copy (&u, a)) != MP_OKAY) {
return res;
@@ -107,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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_get_int.c b/libtommath/bn_mp_get_int.c
index e9282aa..762cb23 100644
--- a/libtommath/bn_mp_get_int.c
+++ b/libtommath/bn_mp_get_int.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the lower 32-bits of an mp_int */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_grow.c b/libtommath/bn_mp_grow.c
index 047c6af..b5b2407 100644
--- a/libtommath/bn_mp_grow.c
+++ b/libtommath/bn_mp_grow.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* grow as required */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init.c b/libtommath/bn_mp_init.c
index 7a59a39..ddb2d07 100644
--- a/libtommath/bn_mp_init.c
+++ b/libtommath/bn_mp_init.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* init a new mp_int */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init_copy.c b/libtommath/bn_mp_init_copy.c
index 2b3248d..2410a9f 100644
--- a/libtommath/bn_mp_init_copy.c
+++ b/libtommath/bn_mp_init_copy.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* creates "a" then copies b into it */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init_multi.c b/libtommath/bn_mp_init_multi.c
index 5af771f..44e3fe6 100644
--- a/libtommath/bn_mp_init_multi.c
+++ b/libtommath/bn_mp_init_multi.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#include <stdarg.h>
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init_set.c b/libtommath/bn_mp_init_set.c
index ded8617..dc08867 100644
--- a/libtommath/bn_mp_init_set.c
+++ b/libtommath/bn_mp_init_set.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* initialize and set a digit */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init_set_int.c b/libtommath/bn_mp_init_set_int.c
index 45341fe..56b27e0 100644
--- a/libtommath/bn_mp_init_set_int.c
+++ b/libtommath/bn_mp_init_set_int.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* initialize and set a digit */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_init_size.c b/libtommath/bn_mp_init_size.c
index 74afbf9..8ed2c2a 100644
--- a/libtommath/bn_mp_init_size.c
+++ b/libtommath/bn_mp_init_size.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* init an mp_init for a given size */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_invmod.c b/libtommath/bn_mp_invmod.c
index bf35b0a..fdb6c88 100644
--- a/libtommath/bn_mp_invmod.c
+++ b/libtommath/bn_mp_invmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* hac 14.61, pp608 */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_invmod_slow.c b/libtommath/bn_mp_invmod_slow.c
index 50a9b6f..e079819 100644
--- a/libtommath/bn_mp_invmod_slow.c
+++ b/libtommath/bn_mp_invmod_slow.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* hac 14.61, pp608 */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_is_square.c b/libtommath/bn_mp_is_square.c
index 8ee84c7..926b449 100644
--- a/libtommath/bn_mp_is_square.c
+++ b/libtommath/bn_mp_is_square.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Check if remainders are possible squares - fast exclude non-squares */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_jacobi.c b/libtommath/bn_mp_jacobi.c
index 8178454..1644698 100644
--- a/libtommath/bn_mp_jacobi.c
+++ b/libtommath/bn_mp_jacobi.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes the jacobi c = (a | n) (or Legendre if n is prime)
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_karatsuba_mul.c b/libtommath/bn_mp_karatsuba_mul.c
index a1ff713..0d62b9b 100644
--- a/libtommath/bn_mp_karatsuba_mul.c
+++ b/libtommath/bn_mp_karatsuba_mul.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = |a| * |b| using Karatsuba Multiplication using
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_karatsuba_sqr.c b/libtommath/bn_mp_karatsuba_sqr.c
index 3bfe157..829405a 100644
--- a/libtommath/bn_mp_karatsuba_sqr.c
+++ b/libtommath/bn_mp_karatsuba_sqr.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Karatsuba squaring, computes b = a*a using three
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_lcm.c b/libtommath/bn_mp_lcm.c
index 7bdaa43..1d53921 100644
--- a/libtommath/bn_mp_lcm.c
+++ b/libtommath/bn_mp_lcm.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes least common multiple as |a*b|/(a, b) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_lshd.c b/libtommath/bn_mp_lshd.c
index 5ddeb62..ce1e63b 100644
--- a/libtommath/bn_mp_lshd.c
+++ b/libtommath/bn_mp_lshd.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift left a certain amount of digits */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mod.c b/libtommath/bn_mp_mod.c
index 22cb069..98e155e 100644
--- a/libtommath/bn_mp_mod.c
+++ b/libtommath/bn_mp_mod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = a mod b, 0 <= c < b */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mod_2d.c b/libtommath/bn_mp_mod_2d.c
index 935d97d..0170f65 100644
--- a/libtommath/bn_mp_mod_2d.c
+++ b/libtommath/bn_mp_mod_2d.c
@@ -12,12 +12,12 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* calc a value mod 2**b */
int
-mp_mod_2d (mp_int * a, int b, mp_int * c)
+mp_mod_2d (const mp_int * a, int b, mp_int * c)
{
int x, res;
@@ -49,7 +49,3 @@ mp_mod_2d (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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mod_d.c b/libtommath/bn_mp_mod_d.c
index 329594a..f642ee8 100644
--- a/libtommath/bn_mp_mod_d.c
+++ b/libtommath/bn_mp_mod_d.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
int
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_montgomery_calc_normalization.c b/libtommath/bn_mp_montgomery_calc_normalization.c
index 0da933f..0748762 100644
--- a/libtommath/bn_mp_montgomery_calc_normalization.c
+++ b/libtommath/bn_mp_montgomery_calc_normalization.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/*
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_montgomery_reduce.c b/libtommath/bn_mp_montgomery_reduce.c
index d556332..bc6abb8 100644
--- a/libtommath/bn_mp_montgomery_reduce.c
+++ b/libtommath/bn_mp_montgomery_reduce.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes xR**-1 == x (mod N) via Montgomery Reduction */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_montgomery_setup.c b/libtommath/bn_mp_montgomery_setup.c
index e55e974..b8e1887 100644
--- a/libtommath/bn_mp_montgomery_setup.c
+++ b/libtommath/bn_mp_montgomery_setup.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* setups the montgomery reduction stuff */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mul.c b/libtommath/bn_mp_mul.c
index 8fd3872..fc024be 100644
--- a/libtommath/bn_mp_mul.c
+++ b/libtommath/bn_mp_mul.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level multiplication (handles sign) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mul_2.c b/libtommath/bn_mp_mul_2.c
index 7409f1c..2ca6022 100644
--- a/libtommath/bn_mp_mul_2.c
+++ b/libtommath/bn_mp_mul_2.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = a*2 */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mul_2d.c b/libtommath/bn_mp_mul_2d.c
index 800646d..4ac2e4e 100644
--- a/libtommath/bn_mp_mul_2d.c
+++ b/libtommath/bn_mp_mul_2d.c
@@ -12,11 +12,11 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift left by a certain bit count */
-int mp_mul_2d (mp_int * a, int b, mp_int * c)
+int mp_mul_2d (const mp_int * a, int b, mp_int * c)
{
mp_digit d;
int res;
@@ -79,7 +79,3 @@ int mp_mul_2d (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.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mul_d.c b/libtommath/bn_mp_mul_d.c
index 061199f..ba45a0c 100644
--- a/libtommath/bn_mp_mul_d.c
+++ b/libtommath/bn_mp_mul_d.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiply by a digit */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_mulmod.c b/libtommath/bn_mp_mulmod.c
index cb605ed..649b717 100644
--- a/libtommath/bn_mp_mulmod.c
+++ b/libtommath/bn_mp_mulmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a * b (mod 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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_n_root.c b/libtommath/bn_mp_n_root.c
index 2fadc6c..b2700a8 100644
--- a/libtommath/bn_mp_n_root.c
+++ b/libtommath/bn_mp_n_root.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* find the n'th root of an integer
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_neg.c b/libtommath/bn_mp_neg.c
index 9cc654a..07fb148 100644
--- a/libtommath/bn_mp_neg.c
+++ b/libtommath/bn_mp_neg.c
@@ -12,11 +12,11 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = -a */
-int mp_neg (mp_int * a, mp_int * b)
+int mp_neg (const mp_int * a, mp_int * b)
{
int res;
if (a != b) {
@@ -34,7 +34,3 @@ int mp_neg (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.1.1.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_or.c b/libtommath/bn_mp_or.c
index 14c0f19..aa5b1bd 100644
--- a/libtommath/bn_mp_or.c
+++ b/libtommath/bn_mp_or.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* OR two ints together */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_fermat.c b/libtommath/bn_mp_prime_fermat.c
index 9b647cb..7b9b12e 100644
--- a/libtommath/bn_mp_prime_fermat.c
+++ b/libtommath/bn_mp_prime_fermat.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* performs one Fermat test.
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_is_divisible.c b/libtommath/bn_mp_prime_is_divisible.c
index 11a2f27..710c967 100644
--- a/libtommath/bn_mp_prime_is_divisible.c
+++ b/libtommath/bn_mp_prime_is_divisible.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if an integers is divisible by one
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_is_prime.c b/libtommath/bn_mp_prime_is_prime.c
index 3e0e36b..ce225a3 100644
--- a/libtommath/bn_mp_prime_is_prime.c
+++ b/libtommath/bn_mp_prime_is_prime.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* performs a variable number of rounds of Miller-Rabin
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_miller_rabin.c b/libtommath/bn_mp_prime_miller_rabin.c
index 712f20d..c5185b8 100644
--- a/libtommath/bn_mp_prime_miller_rabin.c
+++ b/libtommath/bn_mp_prime_miller_rabin.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Miller-Rabin test of "a" to the base of "b" as described in
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_next_prime.c b/libtommath/bn_mp_prime_next_prime.c
index 48b8f02..2433e8c 100644
--- a/libtommath/bn_mp_prime_next_prime.c
+++ b/libtommath/bn_mp_prime_next_prime.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* finds the next prime after the number "a" using "t" trials
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_rabin_miller_trials.c b/libtommath/bn_mp_prime_rabin_miller_trials.c
index c4c9f5e..e57a43c 100644
--- a/libtommath/bn_mp_prime_rabin_miller_trials.c
+++ b/libtommath/bn_mp_prime_rabin_miller_trials.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_prime_random_ex.c b/libtommath/bn_mp_prime_random_ex.c
index daca61c..a37477e 100644
--- a/libtommath/bn_mp_prime_random_ex.c
+++ b/libtommath/bn_mp_prime_random_ex.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* makes a truly random prime of a given size (bits),
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_radix_size.c b/libtommath/bn_mp_radix_size.c
index 3381a6c..40c4d04 100644
--- a/libtommath/bn_mp_radix_size.c
+++ b/libtommath/bn_mp_radix_size.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* returns size of ASCII reprensentation */
@@ -36,7 +36,7 @@ int mp_radix_size (mp_int * a, int radix, int *size)
}
if (mp_iszero(a) == MP_YES) {
- *size = 2;
+ *size = 2;
return MP_OKAY;
}
@@ -81,7 +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 $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2005/09/26 18:27:14 $ */
diff --git a/libtommath/bn_mp_radix_smap.c b/libtommath/bn_mp_radix_smap.c
index b9b88f9..7aeb375 100644
--- a/libtommath/bn_mp_radix_smap.c
+++ b/libtommath/bn_mp_radix_smap.c
@@ -12,13 +12,9 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* 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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_rand.c b/libtommath/bn_mp_rand.c
index 94b0e7f..17c1fbe 100644
--- a/libtommath/bn_mp_rand.c
+++ b/libtommath/bn_mp_rand.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* makes a pseudo-random int of a given size */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_read_radix.c b/libtommath/bn_mp_read_radix.c
index 2a11a36..4b92589 100644
--- a/libtommath/bn_mp_read_radix.c
+++ b/libtommath/bn_mp_read_radix.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read a string [ASCII] in a given radix */
@@ -21,6 +21,9 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
int y, res, neg;
char ch;
+ /* zero the digit bignum */
+ mp_zero(a);
+
/* make sure the radix is ok */
if (radix < 2 || radix > 64) {
return MP_VAL;
@@ -45,7 +48,7 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
* this allows numbers like 1AB and 1ab to represent the same value
* [e.g. in hex]
*/
- ch = (char) ((radix < 36) ? toupper (*str) : *str);
+ ch = (char) ((radix < 36) ? toupper ((unsigned char) *str) : *str);
for (y = 0; y < 64; y++) {
if (ch == mp_s_rmap[y]) {
break;
@@ -83,7 +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 $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2005/09/26 18:27:14 $ */
diff --git a/libtommath/bn_mp_read_signed_bin.c b/libtommath/bn_mp_read_signed_bin.c
index 05b1c9c..3ee8556 100644
--- a/libtommath/bn_mp_read_signed_bin.c
+++ b/libtommath/bn_mp_read_signed_bin.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read signed bin, big endian, first byte is 0==positive or 1==negative */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_read_unsigned_bin.c b/libtommath/bn_mp_read_unsigned_bin.c
index 655415a..caf5be0 100644
--- a/libtommath/bn_mp_read_unsigned_bin.c
+++ b/libtommath/bn_mp_read_unsigned_bin.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reads a unsigned char array, assumes the msb is stored first [big endian] */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce.c b/libtommath/bn_mp_reduce.c
index dbc38c8..4375e4e 100644
--- a/libtommath/bn_mp_reduce.c
+++ b/libtommath/bn_mp_reduce.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces x mod m, assumes 0 < x < m**2, mu is
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_2k.c b/libtommath/bn_mp_reduce_2k.c
index 790ac3c..428f2ff 100644
--- a/libtommath/bn_mp_reduce_2k.c
+++ b/libtommath/bn_mp_reduce_2k.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces a modulo n where n is of the form 2**p - d */
@@ -55,7 +55,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_reduce_2k.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_2k_l.c b/libtommath/bn_mp_reduce_2k_l.c
index 6a013cf..8e52efa 100644
--- a/libtommath/bn_mp_reduce_2k_l.c
+++ b/libtommath/bn_mp_reduce_2k_l.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces a modulo n where n is of the form 2**p - d
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_2k_setup.c b/libtommath/bn_mp_reduce_2k_setup.c
index 17c54c5..ac043f6 100644
--- a/libtommath/bn_mp_reduce_2k_setup.c
+++ b/libtommath/bn_mp_reduce_2k_setup.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_2k_setup_l.c b/libtommath/bn_mp_reduce_2k_setup_l.c
index 2913162..b59a1ed 100644
--- a/libtommath/bn_mp_reduce_2k_setup_l.c
+++ b/libtommath/bn_mp_reduce_2k_setup_l.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_is_2k.c b/libtommath/bn_mp_reduce_is_2k.c
index ad14107..4655fcf 100644
--- a/libtommath/bn_mp_reduce_is_2k.c
+++ b/libtommath/bn_mp_reduce_is_2k.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if mp_reduce_2k can be used */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_is_2k_l.c b/libtommath/bn_mp_reduce_is_2k_l.c
index 160b2ce..7b57865 100644
--- a/libtommath/bn_mp_reduce_is_2k_l.c
+++ b/libtommath/bn_mp_reduce_is_2k_l.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if reduce_2k_l can be used */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_reduce_setup.c b/libtommath/bn_mp_reduce_setup.c
index 4d2d99f..d8cefd9 100644
--- a/libtommath/bn_mp_reduce_setup.c
+++ b/libtommath/bn_mp_reduce_setup.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* pre-calculate the value required for Barrett reduction
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_rshd.c b/libtommath/bn_mp_rshd.c
index d5a75c6..e6095b3 100644
--- a/libtommath/bn_mp_rshd.c
+++ b/libtommath/bn_mp_rshd.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift right a certain amount of digits */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_set.c b/libtommath/bn_mp_set.c
index af01b3c..c32fc42 100644
--- a/libtommath/bn_mp_set.c
+++ b/libtommath/bn_mp_set.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set to a digit */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_set_int.c b/libtommath/bn_mp_set_int.c
index c7ddb79..b0fc344 100644
--- a/libtommath/bn_mp_set_int.c
+++ b/libtommath/bn_mp_set_int.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set a 32-bit const */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_shrink.c b/libtommath/bn_mp_shrink.c
index a40b65c..bfdf93a 100644
--- a/libtommath/bn_mp_shrink.c
+++ b/libtommath/bn_mp_shrink.c
@@ -12,24 +12,25 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shrink a bignum */
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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_signed_bin_size.c b/libtommath/bn_mp_signed_bin_size.c
index 4dbbeb8..8f88e76 100644
--- a/libtommath/bn_mp_signed_bin_size.c
+++ b/libtommath/bn_mp_signed_bin_size.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the size for an signed equivalent */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_sqr.c b/libtommath/bn_mp_sqr.c
index ac926e9..3938537 100644
--- a/libtommath/bn_mp_sqr.c
+++ b/libtommath/bn_mp_sqr.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes b = a*a */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_sqrmod.c b/libtommath/bn_mp_sqrmod.c
index fe5f4bb..6f90772 100644
--- a/libtommath/bn_mp_sqrmod.c
+++ b/libtommath/bn_mp_sqrmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = a * a (mod b) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_sqrt.c b/libtommath/bn_mp_sqrt.c
index ac8c2b8..016b8ba 100644
--- a/libtommath/bn_mp_sqrt.c
+++ b/libtommath/bn_mp_sqrt.c
@@ -1,4 +1,5 @@
#include <tommath.h>
+
#ifdef BN_MP_SQRT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,14 +13,23 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
+#ifndef NO_FLOATING_POINT
+#include <math.h>
+#endif
+
/* this function is less generic than mp_n_root, simpler and faster */
int mp_sqrt(mp_int *arg, mp_int *ret)
{
int res;
mp_int t1,t2;
+ int i, j, k;
+#ifndef NO_FLOATING_POINT
+ volatile double d;
+ mp_digit dig;
+#endif
/* must be positive */
if (arg->sign == MP_NEG) {
@@ -31,17 +41,72 @@ int mp_sqrt(mp_int *arg, mp_int *ret)
mp_zero(ret);
return MP_OKAY;
}
-
- if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) {
- return res;
+
+ i = (arg->used / 2) - 1;
+ j = 2 * i;
+ if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
+ return res;
}
-
+
if ((res = mp_init(&t2)) != MP_OKAY) {
goto E2;
}
- /* First approx. (not very bad for large arg) */
- mp_rshd (&t1,t1.used/2);
+ for (k = 0; k < i; ++k) {
+ t1.dp[k] = (mp_digit) 0;
+ }
+
+#ifndef NO_FLOATING_POINT
+
+ /* Estimate the square root using the hardware floating point unit. */
+
+ d = 0.0;
+ for (k = arg->used-1; k >= j; --k) {
+ d = ldexp(d, DIGIT_BIT) + (double) (arg->dp[k]);
+ }
+
+ /*
+ * At this point, d is the nearest floating point number to the most
+ * significant 1 or 2 mp_digits of arg. Extract its square root.
+ */
+
+ d = sqrt(d);
+
+ /* dig is the most significant mp_digit of the square root */
+
+ dig = (mp_digit) ldexp(d, -DIGIT_BIT);
+
+ /*
+ * If the most significant digit is nonzero, find the next digit down
+ * by subtracting DIGIT_BIT times thie most significant digit.
+ * Subtract one from the result so that our initial estimate is always
+ * low.
+ */
+
+ if (dig) {
+ t1.used = i+2;
+ d -= ldexp((double) dig, DIGIT_BIT);
+ if (d >= 1.0) {
+ t1.dp[i+1] = dig;
+ t1.dp[i] = ((mp_digit) d) - 1;
+ } else {
+ t1.dp[i+1] = dig-1;
+ t1.dp[i] = MP_DIGIT_MAX;
+ }
+ } else {
+ t1.used = i+1;
+ t1.dp[i] = ((mp_digit) d) - 1;
+ }
+
+#else
+
+ /* Estimate the square root as having 1 in the most significant place. */
+
+ t1.used = i + 2;
+ t1.dp[i+1] = (mp_digit) 1;
+ t1.dp[i] = (mp_digit) 0;
+
+#endif
/* t1 > 0 */
if ((res = mp_div(arg,&t1,&t2,NULL)) != MP_OKAY) {
@@ -75,7 +140,3 @@ E2: mp_clear(&t1);
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_sqrt.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_sub.c b/libtommath/bn_mp_sub.c
index 52e1e43..13cb43e 100644
--- a/libtommath/bn_mp_sub.c
+++ b/libtommath/bn_mp_sub.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level subtraction (handles signs) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_sub_d.c b/libtommath/bn_mp_sub_d.c
index 0b31cbe..b1e4e3f 100644
--- a/libtommath/bn_mp_sub_d.c
+++ b/libtommath/bn_mp_sub_d.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* single digit subtraction */
@@ -36,6 +36,10 @@ mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
a->sign = MP_ZPOS;
res = mp_add_d(a, b, c);
a->sign = c->sign = MP_NEG;
+
+ /* clamp */
+ mp_clamp(c);
+
return res;
}
@@ -83,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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_submod.c b/libtommath/bn_mp_submod.c
index f735e9e..7461678 100644
--- a/libtommath/bn_mp_submod.c
+++ b/libtommath/bn_mp_submod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a - b (mod 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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_to_signed_bin.c b/libtommath/bn_mp_to_signed_bin.c
index bc07d1e..7871921 100644
--- a/libtommath/bn_mp_to_signed_bin.c
+++ b/libtommath/bn_mp_to_signed_bin.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in signed [big endian] format */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_to_signed_bin_n.c b/libtommath/bn_mp_to_signed_bin_n.c
index ff2a768..8da9961 100644
--- a/libtommath/bn_mp_to_signed_bin_n.c
+++ b/libtommath/bn_mp_to_signed_bin_n.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in signed [big endian] format */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_to_unsigned_bin.c b/libtommath/bn_mp_to_unsigned_bin.c
index 29b8d36..9496398 100644
--- a/libtommath/bn_mp_to_unsigned_bin.c
+++ b/libtommath/bn_mp_to_unsigned_bin.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in unsigned [big endian] format */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_to_unsigned_bin_n.c b/libtommath/bn_mp_to_unsigned_bin_n.c
index 415e87d..4f2a31d 100644
--- a/libtommath/bn_mp_to_unsigned_bin_n.c
+++ b/libtommath/bn_mp_to_unsigned_bin_n.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in unsigned [big endian] format */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_toom_mul.c b/libtommath/bn_mp_toom_mul.c
index e6fb523..9daefbd 100644
--- a/libtommath/bn_mp_toom_mul.c
+++ b/libtommath/bn_mp_toom_mul.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplication using the Toom-Cook 3-way algorithm
@@ -278,7 +278,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toom_mul.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_toom_sqr.c b/libtommath/bn_mp_toom_sqr.c
index ba800a0..9e3f79c 100644
--- a/libtommath/bn_mp_toom_sqr.c
+++ b/libtommath/bn_mp_toom_sqr.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* squaring using Toom-Cook 3-way algorithm */
@@ -220,7 +220,3 @@ ERR:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_toom_sqr.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_toradix.c b/libtommath/bn_mp_toradix.c
index 96ac736..132743e 100644
--- a/libtommath/bn_mp_toradix.c
+++ b/libtommath/bn_mp_toradix.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* stores a bignum as a ASCII string in a given radix (2..64) */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_toradix_n.c b/libtommath/bn_mp_toradix_n.c
index d07ba95..dedce71 100644
--- a/libtommath/bn_mp_toradix_n.c
+++ b/libtommath/bn_mp_toradix_n.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* stores a bignum as a ASCII string in a given radix (2..64)
@@ -27,12 +27,12 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
char *_s = str;
/* check range of the maxlen, radix */
- if (maxlen < 3 || radix < 2 || radix > 64) {
+ if (maxlen < 2 || radix < 2 || radix > 64) {
return MP_VAL;
}
/* quick out if its zero */
- if (mp_iszero(a) == 1) {
+ if (mp_iszero(a) == MP_YES) {
*str++ = '0';
*str = '\0';
return MP_OKAY;
@@ -57,21 +57,20 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
digs = 0;
while (mp_iszero (&t) == 0) {
+ if (--maxlen < 1) {
+ /* no more room */
+ break;
+ }
if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) {
mp_clear (&t);
return res;
}
*str++ = mp_s_rmap[d];
++digs;
-
- if (--maxlen == 1) {
- /* no more room */
- break;
- }
}
/* reverse the digits of the string. In this case _s points
- * to the first digit [exluding the sign] of the number]
+ * to the first digit [exluding the sign] of the number
*/
bn_reverse ((unsigned char *)_s, digs);
@@ -83,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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_unsigned_bin_size.c b/libtommath/bn_mp_unsigned_bin_size.c
index 9622dbf..58c18fb 100644
--- a/libtommath/bn_mp_unsigned_bin_size.c
+++ b/libtommath/bn_mp_unsigned_bin_size.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the size for an unsigned equivalent */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_xor.c b/libtommath/bn_mp_xor.c
index ae9f29b..432f42e 100644
--- a/libtommath/bn_mp_xor.c
+++ b/libtommath/bn_mp_xor.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* XOR two ints together */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_mp_zero.c b/libtommath/bn_mp_zero.c
index 6f7469c..d697a60 100644
--- a/libtommath/bn_mp_zero.c
+++ b/libtommath/bn_mp_zero.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set to zero */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_prime_tab.c b/libtommath/bn_prime_tab.c
index 9ec6d7a..c47c8bd 100644
--- a/libtommath/bn_prime_tab.c
+++ b/libtommath/bn_prime_tab.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
const mp_digit ltm_prime_tab[] = {
0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_reverse.c b/libtommath/bn_reverse.c
index ad119ff..9d7fd29 100644
--- a/libtommath/bn_reverse.c
+++ b/libtommath/bn_reverse.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reverse an array, used for radix code */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_add.c b/libtommath/bn_s_mp_add.c
index f196f3e..7527bf8 100644
--- a/libtommath/bn_s_mp_add.c
+++ b/libtommath/bn_s_mp_add.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level addition, based on HAC pp.594, Algorithm 14.7 */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_exptmod.c b/libtommath/bn_s_mp_exptmod.c
index d33558a..ff6bd54 100644
--- a/libtommath/bn_s_mp_exptmod.c
+++ b/libtommath/bn_s_mp_exptmod.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifdef MP_LOW_MEM
#define TAB_SIZE 32
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_mul_digs.c b/libtommath/bn_s_mp_mul_digs.c
index e296640..401f32e 100644
--- a/libtommath/bn_s_mp_mul_digs.c
+++ b/libtommath/bn_s_mp_mul_digs.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplies |a| * |b| and only computes upto digs digits of result
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_mul_high_digs.c b/libtommath/bn_s_mp_mul_high_digs.c
index 972918f..f4dca76 100644
--- a/libtommath/bn_s_mp_mul_high_digs.c
+++ b/libtommath/bn_s_mp_mul_high_digs.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplies |a| * |b| and does not compute the lower digs digits
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_sqr.c b/libtommath/bn_s_mp_sqr.c
index 1b1e0b4..464663f 100644
--- a/libtommath/bn_s_mp_sqr.c
+++ b/libtommath/bn_s_mp_sqr.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bn_s_mp_sub.c b/libtommath/bn_s_mp_sub.c
index fb2ea21..328c9e5 100644
--- a/libtommath/bn_s_mp_sub.c
+++ b/libtommath/bn_s_mp_sub.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */
@@ -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.2 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/bncore.c b/libtommath/bncore.c
index fad10d2..eb95a2e 100644
--- a/libtommath/bncore.c
+++ b/libtommath/bncore.c
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Known optimal configurations
@@ -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.1.1.3 $ */
-/* $Date: 2005/09/26 16:31:56 $ */
diff --git a/libtommath/booker.pl b/libtommath/booker.pl
index f419ab4..df8b30d 100644
--- a/libtommath/booker.pl
+++ b/libtommath/booker.pl
@@ -221,7 +221,7 @@ while (<IN>) {
$str = "chapter eight";
} elsif ($a == 9) {
$str = "chapter nine";
- } elsif ($a == 2) {
+ } elsif ($a == 10) {
$str = "chapter ten";
}
} else {
diff --git a/libtommath/changes.txt b/libtommath/changes.txt
index 4f27d63..4fc0913 100644
--- a/libtommath/changes.txt
+++ b/libtommath/changes.txt
@@ -1,3 +1,34 @@
+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++.
+ -- "mm" from sci.crypt pointed out that my mp_gcd was sub-optimal (I also updated and corrected the book)
+ -- updated some of the @@ tags in tommath.src to reflect source changes.
+ -- updated email and url info in all source files
+
+Jan 26th, 2006
+v0.38 -- broken makefile.shared fixed
+ -- removed some carry stores that were not required [updated text]
+
+November 18th, 2005
+v0.37 -- [Don Porter] reported on a TCL list [HEY SEND ME BUGREPORTS ALREADY!!!] that mp_add_d() would compute -0 with some inputs. Fixed.
+ -- [rinick@gmail.com] reported the makefile.bcc was messed up. Fixed.
+ -- [Kevin Kenny] reported some issues with mp_toradix_n(). Now it doesn't require a min of 3 chars of output.
+ -- Made the make command renamable. Wee
+
August 1st, 2005
v0.36 -- LTM_PRIME_2MSB_ON was fixed and the "OFF" flag was removed.
-- [Peter LaDow] found a typo in the XREALLOC macro
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 939616f..28ac834 100644
--- a/libtommath/etc/mersenne.c
+++ b/libtommath/etc/mersenne.c
@@ -1,6 +1,6 @@
/* Finds Mersenne primes using the Lucas-Lehmer test
*
- * Tom St Denis, tomstdenis@iahu.ca
+ * Tom St Denis, tomstdenis@gmail.com
*/
#include <time.h>
#include <tommath.h>
@@ -138,7 +138,3 @@ main (void)
}
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/mersenne.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
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 a922b64..955f19e 100644
--- a/libtommath/etc/pprime.c
+++ b/libtommath/etc/pprime.c
@@ -1,8 +1,8 @@
/* Generates provable primes
*
- * See http://iahu.ca:8080/papers/pp.pdf for more info.
+ * See http://gmail.com:8080/papers/pp.pdf for more info.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://tom.iahu.ca
+ * Tom St Denis, tomstdenis@gmail.com, http://tom.gmail.com
*/
#include <time.h>
#include "tommath.h"
@@ -394,7 +394,3 @@ main (void)
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/pprime.c,v $ */
-/* $Revision: 1.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
diff --git a/libtommath/etc/tune.c b/libtommath/etc/tune.c
index b09c7d9..acb146f 100644
--- a/libtommath/etc/tune.c
+++ b/libtommath/etc/tune.c
@@ -1,6 +1,6 @@
/* Tune the Karatsuba parameters
*
- * Tom St Denis, tomstdenis@iahu.ca
+ * Tom St Denis, tomstdenis@gmail.com
*/
#include <tommath.h>
#include <time.h>
@@ -136,7 +136,3 @@ main (void)
return 0;
}
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/etc/tune.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
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 a4697d4..70de306 100644
--- a/libtommath/makefile
+++ b/libtommath/makefile
@@ -3,10 +3,14 @@
#Tom St Denis
#version of library
-VERSION=0.36
+VERSION=0.42.0
CFLAGS += -I./ -Wall -W -Wshadow -Wsign-compare
+ifndef MAKE
+ MAKE=make
+endif
+
ifndef IGNORE_SPEED
#for speed
@@ -36,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.
@@ -124,7 +129,7 @@ timing: $(LIBNAME)
# makes the LTM book DVI file, requires tetex, perl and makeindex [part of tetex I think]
docdvi: tommath.src
- cd pics ; make
+ cd pics ; MAKE=${MAKE} ${MAKE}
echo "hello" > tommath.ind
perl booker.pl
latex tommath > /dev/null
@@ -141,7 +146,7 @@ poster: poster.tex
docs: docdvi
dvipdf tommath
rm -f tommath.log tommath.aux tommath.dvi tommath.idx tommath.toc tommath.lof tommath.ind tommath.ilg
- cd pics ; make clean
+ cd pics ; MAKE=${MAKE} ${MAKE} clean
#LTM user manual
mandvi: bn.tex
@@ -161,10 +166,10 @@ pretty:
clean:
rm -f *.bat *.pdf *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test ltmtest mpitest mtest/mtest mtest/mtest.exe \
- *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.da *.dyn *.dpi tommath.tex `find -type f | grep [~] | xargs` *.lo *.la
+ *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la
rm -rf .libs
- cd etc ; make clean
- cd pics ; make clean
+ cd etc ; MAKE=${MAKE} ${MAKE} clean
+ cd pics ; MAKE=${MAKE} ${MAKE} clean
#zipup the project (take that!)
no_oops: clean
@@ -177,4 +182,5 @@ zipup: clean manual poster docs
cd .. ; rm -rf ltm* libtommath-$(VERSION) ; mkdir libtommath-$(VERSION) ; \
cp -R ./libtommath/* ./libtommath-$(VERSION)/ ; \
tar -c libtommath-$(VERSION)/* | bzip2 -9vvc > ltm-$(VERSION).tar.bz2 ; \
- zip -9 -r ltm-$(VERSION).zip libtommath-$(VERSION)/*
+ zip -9 -r ltm-$(VERSION).zip libtommath-$(VERSION)/* ; \
+ mv -f ltm* ~ ; rm -rf libtommath-$(VERSION)
diff --git a/libtommath/makefile.bcc b/libtommath/makefile.bcc
index 647c69a..67743d9 100644
--- a/libtommath/makefile.bcc
+++ b/libtommath/makefile.bcc
@@ -39,6 +39,6 @@ TARGET = libtommath.lib
$(TARGET): $(OBJECTS)
-.c.objbjbjbj:
+.c.obj:
$(CC) $(CFLAGS) $<
$(LIB) $(TARGET) -+$@
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 821558c..f17bbbd 100644
--- a/libtommath/makefile.shared
+++ b/libtommath/makefile.shared
@@ -1,9 +1,9 @@
#Makefile for GCC
#
#Tom St Denis
-VERSION=0:36
+VERSION=0:41
-CC = libtool --mode=compile gcc
+CC = libtool --mode=compile --tag=CC gcc
CFLAGS += -I./ -Wall -W -Wshadow -Wsign-compare
@@ -80,11 +80,14 @@ bn_mp_prime_random_ex.o bn_mp_get_int.o bn_mp_sqrt.o bn_mp_is_square.o bn_mp_ini
bn_mp_init_set_int.o bn_mp_invmod_slow.o bn_mp_prime_rabin_miller_trials.o \
bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin_n.o
+objs: $(OBJECTS)
+
$(LIBNAME): $(OBJECTS)
libtool --mode=link gcc *.lo -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION)
- libtool --mode=link gcc *.o -o $(LIBNAME_S)
- ranlib $(LIBNAME_S)
- libtool --mode=install install -c $(LIBNAME) $(LIBPATH)/$@
+
+install: $(LIBNAME)
+ install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(LIBPATH)
+ libtool --mode=install install -c $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(INCPATH)
install -g $(GROUP) -o $(USER) $(HEADERS) $(DESTDIR)$(INCPATH)
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 1b6f114..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.1.1.2 2005/09/26 16:32:17 kennykb Exp $
*/
#include "mpi.h"
@@ -91,7 +89,7 @@ static unsigned int s_mp_defprec = MP_DEFPREC;
/* {{{ Constant strings */
/* Constant strings returned by mp_strerror() */
-static const char *mp_err_string[] = {
+static const char *const mp_err_string[] = {
"unknown result code", /* say what? */
"boolean true", /* MP_OKAY, MP_YES */
"boolean false", /* MP_NO */
@@ -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.1.1.2 $ */
-/* $Date: 2005/09/26 16:32:17 $ */
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/poster.pdf b/libtommath/poster.pdf
index 5a39a04..1f705cf 100644
--- a/libtommath/poster.pdf
+++ b/libtommath/poster.pdf
Binary files differ
diff --git a/libtommath/pre_gen/mpi.c b/libtommath/pre_gen/mpi.c
index 78945ac..d2224c0 100644
--- a/libtommath/pre_gen/mpi.c
+++ b/libtommath/pre_gen/mpi.c
@@ -13,7 +13,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
static const struct {
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_error.c */
/* Start: bn_fast_mp_invmod.c */
@@ -64,7 +60,7 @@ char *mp_error_to_string(int code)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes the modular inverse via binary extended euclidean algorithm,
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_fast_mp_invmod.c */
/* Start: bn_fast_mp_montgomery_reduce.c */
@@ -216,7 +208,7 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &B, &D, NULL);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes xR**-1 == x (mod N) via Montgomery Reduction
@@ -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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_fast_mp_montgomery_reduce.c */
/* Start: bn_fast_s_mp_mul_digs.c */
@@ -392,7 +380,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Fast (comba) multiplier
@@ -458,10 +446,7 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
/* make next carry */
_W = _W >> ((mp_word)DIGIT_BIT);
- }
-
- /* store final carry */
- W[ix] = (mp_digit)(_W & MP_MASK);
+ }
/* setup dest */
olduse = c->used;
@@ -485,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_fast_s_mp_mul_digs.c */
/* Start: bn_fast_s_mp_mul_high_digs.c */
@@ -506,7 +487,7 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* this is a modified version of fast_s_mul_digs that only produces
@@ -564,9 +545,6 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
_W = _W >> ((mp_word)DIGIT_BIT);
}
- /* store final carry */
- W[ix] = (mp_digit)(_W & MP_MASK);
-
/* setup dest */
olduse = c->used;
c->used = pa;
@@ -575,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];
}
@@ -590,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_fast_s_mp_mul_high_digs.c */
/* Start: bn_fast_s_mp_sqr.c */
@@ -611,7 +585,7 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* the jist of squaring...
@@ -708,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_fast_s_mp_sqr.c */
/* Start: bn_mp_2expt.c */
@@ -729,7 +699,7 @@ int fast_s_mp_sqr (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes a = 2**b
@@ -760,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_2expt.c */
/* Start: bn_mp_abs.c */
@@ -781,7 +747,7 @@ mp_2expt (mp_int * a, int b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = |a|
@@ -807,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_abs.c */
/* Start: bn_mp_add.c */
@@ -828,7 +790,7 @@ mp_abs (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level addition (handles signs) */
@@ -864,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_add.c */
/* Start: bn_mp_add_d.c */
@@ -885,7 +843,7 @@ int mp_add (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* single digit addition */
@@ -913,6 +871,9 @@ mp_add_d (mp_int * a, mp_digit b, mp_int * c)
/* fix sign */
a->sign = c->sign = MP_NEG;
+ /* clamp */
+ mp_clamp(c);
+
return res;
}
@@ -977,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_add_d.c */
/* Start: bn_mp_addmod.c */
@@ -998,7 +955,7 @@ mp_add_d (mp_int * a, mp_digit b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a + b (mod c) */
@@ -1022,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_addmod.c */
/* Start: bn_mp_and.c */
@@ -1043,7 +996,7 @@ mp_addmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* AND two ints together */
@@ -1083,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_and.c */
/* Start: bn_mp_clamp.c */
@@ -1104,7 +1053,7 @@ mp_and (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* trim unused digits
@@ -1131,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_clamp.c */
/* Start: bn_mp_clear.c */
@@ -1152,7 +1097,7 @@ mp_clamp (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* clear one (frees) */
@@ -1179,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_clear.c */
/* Start: bn_mp_clear_multi.c */
@@ -1200,7 +1141,7 @@ mp_clear (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#include <stdarg.h>
@@ -1217,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_clear_multi.c */
/* Start: bn_mp_cmp.c */
@@ -1238,7 +1175,7 @@ void mp_clear_multi(mp_int *mp, ...)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare two ints (signed)*/
@@ -1264,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_cmp.c */
/* Start: bn_mp_cmp_d.c */
@@ -1285,7 +1218,7 @@ mp_cmp (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare a digit */
@@ -1312,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_cmp_d.c */
/* Start: bn_mp_cmp_mag.c */
@@ -1333,7 +1262,7 @@ int mp_cmp_d(mp_int * a, mp_digit b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* compare maginitude of two ints (unsigned) */
@@ -1371,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_cmp_mag.c */
/* Start: bn_mp_cnt_lsb.c */
@@ -1392,7 +1317,7 @@ int mp_cmp_mag (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
static const int lnz[16] = {
@@ -1428,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_cnt_lsb.c */
/* Start: bn_mp_copy.c */
@@ -1449,7 +1370,7 @@ int mp_cnt_lsb(mp_int *a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* copy, b = a */
@@ -1500,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_copy.c */
/* Start: bn_mp_count_bits.c */
@@ -1521,7 +1438,7 @@ mp_copy (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* returns the number of bits in an int */
@@ -1549,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_count_bits.c */
/* Start: bn_mp_div.c */
@@ -1570,7 +1483,7 @@ mp_count_bits (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifdef BN_MP_DIV_SMALL
@@ -1845,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_div.c */
/* Start: bn_mp_div_2.c */
@@ -1866,7 +1775,7 @@ LBL_Q:mp_clear (&q);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = a/2 */
@@ -1917,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_div_2.c */
/* Start: bn_mp_div_2d.c */
@@ -1938,7 +1843,7 @@ int mp_div_2(mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift right by a certain bit count (store quotient in c, optional remainder in d) */
@@ -2018,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_div_2d.c */
/* Start: bn_mp_div_3.c */
@@ -2039,7 +1940,7 @@ int mp_div_2d (mp_int * a, int b, mp_int * c, mp_int * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* divide by three (based on routine from MPI and the GMP manual) */
@@ -2101,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_div_3.c */
/* Start: bn_mp_div_d.c */
@@ -2122,14 +2019,19 @@ mp_div_3 (mp_int * a, mp_int *c, mp_digit * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
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;
@@ -2215,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_div_d.c */
/* Start: bn_mp_dr_is_modulus.c */
@@ -2236,7 +2134,7 @@ int mp_div_d (mp_int * a, mp_digit b, mp_int * c, mp_digit * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if a number is a valid DR modulus */
@@ -2262,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_dr_is_modulus.c */
/* Start: bn_mp_dr_reduce.c */
@@ -2283,7 +2177,7 @@ int mp_dr_is_modulus(mp_int *a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduce "x" in place modulo "n" using the Diminished Radix algorithm.
@@ -2360,10 +2254,6 @@ top:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_dr_reduce.c */
/* Start: bn_mp_dr_setup.c */
@@ -2381,7 +2271,7 @@ top:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -2396,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_dr_setup.c */
/* Start: bn_mp_exch.c */
@@ -2417,7 +2303,7 @@ void mp_dr_setup(mp_int *a, mp_digit *d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* swap the elements of two integers, for cases where you can't simply swap the
@@ -2434,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_exch.c */
/* Start: bn_mp_expt_d.c */
@@ -2455,7 +2337,7 @@ mp_exch (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* calculate c = a**b using a square-multiply algorithm */
@@ -2495,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_expt_d.c */
/* Start: bn_mp_exptmod.c */
@@ -2516,7 +2394,7 @@ int mp_expt_d (mp_int * a, mp_digit b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
@@ -2611,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_exptmod.c */
/* Start: bn_mp_exptmod_fast.c */
@@ -2632,7 +2506,7 @@ int mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85
@@ -2935,11 +2809,6 @@ LBL_M:
}
#endif
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_exptmod_fast.c */
/* Start: bn_mp_exteuclid.c */
@@ -2957,7 +2826,7 @@ LBL_M:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Extended euclidean algorithm of (a, b) produces
@@ -3022,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_exteuclid.c */
/* Start: bn_mp_fread.c */
@@ -3043,7 +2908,7 @@ _ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read a bigint from a file stream in ASCII */
@@ -3093,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_fread.c */
/* Start: bn_mp_fwrite.c */
@@ -3114,7 +2975,7 @@ int mp_fread(mp_int *a, int radix, FILE *stream)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
int mp_fwrite(mp_int *a, int radix, FILE *stream)
@@ -3149,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_fwrite.c */
/* Start: bn_mp_gcd.c */
@@ -3170,7 +3027,7 @@ int mp_fwrite(mp_int *a, int radix, FILE *stream)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Greatest Common Divisor using the binary method */
@@ -3180,21 +3037,13 @@ int mp_gcd (mp_int * a, mp_int * b, mp_int * c)
int k, u_lsb, v_lsb, res;
/* either zero than gcd is the largest */
- if (mp_iszero (a) == 1 && mp_iszero (b) == 0) {
+ if (mp_iszero (a) == MP_YES) {
return mp_abs (b, c);
}
- if (mp_iszero (a) == 0 && mp_iszero (b) == 1) {
+ if (mp_iszero (b) == MP_YES) {
return mp_abs (a, c);
}
- /* optimized. At this point if a == 0 then
- * b must equal zero too
- */
- if (mp_iszero (a) == 1) {
- mp_zero(c);
- return MP_OKAY;
- }
-
/* get copies of a and b we can modify */
if ((res = mp_init_copy (&u, a)) != MP_OKAY) {
return res;
@@ -3266,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_gcd.c */
/* Start: bn_mp_get_int.c */
@@ -3287,7 +3132,7 @@ LBL_U:mp_clear (&v);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the lower 32-bits of an mp_int */
@@ -3315,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_get_int.c */
/* Start: bn_mp_grow.c */
@@ -3336,7 +3177,7 @@ unsigned long mp_get_int(mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* grow as required */
@@ -3376,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_grow.c */
/* Start: bn_mp_init.c */
@@ -3397,7 +3234,7 @@ int mp_grow (mp_int * a, int size)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* init a new mp_int */
@@ -3426,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init.c */
/* Start: bn_mp_init_copy.c */
@@ -3447,7 +3280,7 @@ int mp_init (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* creates "a" then copies b into it */
@@ -3462,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init_copy.c */
/* Start: bn_mp_init_multi.c */
@@ -3483,7 +3312,7 @@ int mp_init_copy (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#include <stdarg.h>
@@ -3525,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init_multi.c */
/* Start: bn_mp_init_set.c */
@@ -3546,7 +3371,7 @@ int mp_init_multi(mp_int *mp, ...)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* initialize and set a digit */
@@ -3561,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init_set.c */
/* Start: bn_mp_init_set_int.c */
@@ -3582,7 +3403,7 @@ int mp_init_set (mp_int * a, mp_digit b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* initialize and set a digit */
@@ -3596,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init_set_int.c */
/* Start: bn_mp_init_size.c */
@@ -3617,7 +3434,7 @@ int mp_init_set_int (mp_int * a, unsigned long b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* init an mp_init for a given size */
@@ -3648,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_init_size.c */
/* Start: bn_mp_invmod.c */
@@ -3669,7 +3482,7 @@ int mp_init_size (mp_int * a, int size)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* hac 14.61, pp608 */
@@ -3695,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_invmod.c */
/* Start: bn_mp_invmod_slow.c */
@@ -3716,7 +3525,7 @@ int mp_invmod (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* hac 14.61, pp608 */
@@ -3874,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_invmod_slow.c */
/* Start: bn_mp_is_square.c */
@@ -3895,7 +3700,7 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &A, &B, &C, &D, NULL);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Check if remainders are possible squares - fast exclude non-squares */
@@ -3987,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_is_square.c */
/* Start: bn_mp_jacobi.c */
@@ -4008,7 +3809,7 @@ ERR:mp_clear(&t);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes the jacobi c = (a | n) (or Legendre if n is prime)
@@ -4096,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_jacobi.c */
/* Start: bn_mp_karatsuba_mul.c */
@@ -4117,7 +3914,7 @@ LBL_A1:mp_clear (&a1);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = |a| * |b| using Karatsuba Multiplication using
@@ -4267,10 +4064,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_karatsuba_mul.c */
/* Start: bn_mp_karatsuba_sqr.c */
@@ -4288,7 +4081,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Karatsuba squaring, computes b = a*a using three
@@ -4392,10 +4185,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_karatsuba_sqr.c */
/* Start: bn_mp_lcm.c */
@@ -4413,7 +4202,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes least common multiple as |a*b|/(a, b) */
@@ -4456,10 +4245,6 @@ LBL_T:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_lcm.c */
/* Start: bn_mp_lshd.c */
@@ -4477,7 +4262,7 @@ LBL_T:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift left a certain amount of digits */
@@ -4527,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_lshd.c */
/* Start: bn_mp_mod.c */
@@ -4548,7 +4329,7 @@ int mp_lshd (mp_int * a, int b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = a mod b, 0 <= c < b */
@@ -4579,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mod.c */
/* Start: bn_mp_mod_2d.c */
@@ -4600,7 +4377,7 @@ mp_mod (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* calc a value mod 2**b */
@@ -4638,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mod_2d.c */
/* Start: bn_mp_mod_d.c */
@@ -4659,7 +4432,7 @@ mp_mod_2d (mp_int * a, int b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
int
@@ -4669,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mod_d.c */
/* Start: bn_mp_montgomery_calc_normalization.c */
@@ -4690,7 +4459,7 @@ mp_mod_d (mp_int * a, mp_digit b, mp_digit * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/*
@@ -4732,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_montgomery_calc_normalization.c */
/* Start: bn_mp_montgomery_reduce.c */
@@ -4753,7 +4518,7 @@ int mp_montgomery_calc_normalization (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes xR**-1 == x (mod N) via Montgomery Reduction */
@@ -4854,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_montgomery_reduce.c */
/* Start: bn_mp_montgomery_setup.c */
@@ -4875,7 +4636,7 @@ mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* setups the montgomery reduction stuff */
@@ -4911,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_montgomery_setup.c */
/* Start: bn_mp_mul.c */
@@ -4938,7 +4695,7 @@ mp_montgomery_setup (mp_int * n, mp_digit * rho)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level multiplication (handles sign) */
@@ -4987,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mul.c */
/* Start: bn_mp_mul_2.c */
@@ -5008,7 +4761,7 @@ int mp_mul (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = a*2 */
@@ -5073,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mul_2.c */
/* Start: bn_mp_mul_2d.c */
@@ -5094,7 +4843,7 @@ int mp_mul_2(mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift left by a certain bit count */
@@ -5162,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mul_2d.c */
/* Start: bn_mp_mul_d.c */
@@ -5183,7 +4928,7 @@ int mp_mul_2d (mp_int * a, int b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiply by a digit */
@@ -5245,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mul_d.c */
/* Start: bn_mp_mulmod.c */
@@ -5266,7 +5007,7 @@ mp_mul_d (mp_int * a, mp_digit b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a * b (mod c) */
@@ -5289,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_mulmod.c */
/* Start: bn_mp_n_root.c */
@@ -5310,7 +5047,7 @@ int mp_mulmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* find the n'th root of an integer
@@ -5425,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_n_root.c */
/* Start: bn_mp_neg.c */
@@ -5446,7 +5179,7 @@ LBL_T1:mp_clear (&t1);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* b = -a */
@@ -5469,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_neg.c */
/* Start: bn_mp_or.c */
@@ -5490,7 +5219,7 @@ int mp_neg (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* OR two ints together */
@@ -5523,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_or.c */
/* Start: bn_mp_prime_fermat.c */
@@ -5544,7 +5269,7 @@ int mp_or (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* performs one Fermat test.
@@ -5589,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_fermat.c */
/* Start: bn_mp_prime_is_divisible.c */
@@ -5610,7 +5331,7 @@ LBL_T:mp_clear (&t);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if an integers is divisible by one
@@ -5643,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_is_divisible.c */
/* Start: bn_mp_prime_is_prime.c */
@@ -5664,7 +5381,7 @@ int mp_prime_is_divisible (mp_int * a, int *result)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* performs a variable number of rounds of Miller-Rabin
@@ -5730,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_is_prime.c */
/* Start: bn_mp_prime_miller_rabin.c */
@@ -5751,7 +5464,7 @@ LBL_B:mp_clear (&b);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Miller-Rabin test of "a" to the base of "b" as described in
@@ -5837,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_miller_rabin.c */
/* Start: bn_mp_prime_next_prime.c */
@@ -5858,7 +5567,7 @@ LBL_N1:mp_clear (&n1);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* finds the next prime after the number "a" using "t" trials
@@ -5989,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;
}
@@ -6011,10 +5720,6 @@ LBL_ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_next_prime.c */
/* Start: bn_mp_prime_rabin_miller_trials.c */
@@ -6032,7 +5737,7 @@ LBL_ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
@@ -6067,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_rabin_miller_trials.c */
/* Start: bn_mp_prime_random_ex.c */
@@ -6088,7 +5789,7 @@ int mp_prime_rabin_miller_trials(int size)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* makes a truly random prime of a given size (bits),
@@ -6196,10 +5897,6 @@ error:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_prime_random_ex.c */
/* Start: bn_mp_radix_size.c */
@@ -6217,7 +5914,7 @@ error:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* returns size of ASCII reprensentation */
@@ -6241,7 +5938,7 @@ int mp_radix_size (mp_int * a, int radix, int *size)
}
if (mp_iszero(a) == MP_YES) {
- *size = 2;
+ *size = 2;
return MP_OKAY;
}
@@ -6278,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_radix_size.c */
/* Start: bn_mp_radix_smap.c */
@@ -6299,17 +5992,13 @@ int mp_radix_size (mp_int * a, int radix, int *size)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* chars used in radix conversions */
const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_radix_smap.c */
/* Start: bn_mp_rand.c */
@@ -6327,7 +6016,7 @@ const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrs
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* makes a pseudo-random int of a given size */
@@ -6365,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_rand.c */
/* Start: bn_mp_read_radix.c */
@@ -6386,7 +6071,7 @@ mp_rand (mp_int * a, int digits)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read a string [ASCII] in a given radix */
@@ -6395,6 +6080,9 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
int y, res, neg;
char ch;
+ /* zero the digit bignum */
+ mp_zero(a);
+
/* make sure the radix is ok */
if (radix < 2 || radix > 64) {
return MP_VAL;
@@ -6451,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_read_radix.c */
/* Start: bn_mp_read_signed_bin.c */
@@ -6472,7 +6156,7 @@ int mp_read_radix (mp_int * a, const char *str, int radix)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* read signed bin, big endian, first byte is 0==positive or 1==negative */
@@ -6496,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_read_signed_bin.c */
/* Start: bn_mp_read_unsigned_bin.c */
@@ -6517,7 +6197,7 @@ int mp_read_signed_bin (mp_int * a, const unsigned char *b, int c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reads a unsigned char array, assumes the msb is stored first [big endian] */
@@ -6555,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_read_unsigned_bin.c */
/* Start: bn_mp_reduce.c */
@@ -6576,7 +6252,7 @@ int mp_read_unsigned_bin (mp_int * a, const unsigned char *b, int c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces x mod m, assumes 0 < x < m**2, mu is
@@ -6659,10 +6335,6 @@ CLEANUP:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce.c */
/* Start: bn_mp_reduce_2k.c */
@@ -6680,7 +6352,7 @@ CLEANUP:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces a modulo n where n is of the form 2**p - d */
@@ -6724,10 +6396,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_2k.c */
/* Start: bn_mp_reduce_2k_l.c */
@@ -6745,7 +6413,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reduces a modulo n where n is of the form 2**p - d
@@ -6790,10 +6458,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_2k_l.c */
/* Start: bn_mp_reduce_2k_setup.c */
@@ -6811,7 +6475,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -6841,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_2k_setup.c */
/* Start: bn_mp_reduce_2k_setup_l.c */
@@ -6862,7 +6522,7 @@ int mp_reduce_2k_setup(mp_int *a, mp_digit *d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines the setup value */
@@ -6889,10 +6549,6 @@ ERR:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_2k_setup_l.c */
/* Start: bn_mp_reduce_is_2k.c */
@@ -6910,7 +6566,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if mp_reduce_2k can be used */
@@ -6945,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_is_2k.c */
/* Start: bn_mp_reduce_is_2k_l.c */
@@ -6966,7 +6618,7 @@ int mp_reduce_is_2k(mp_int *a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* determines if reduce_2k_l can be used */
@@ -6993,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_is_2k_l.c */
/* Start: bn_mp_reduce_setup.c */
@@ -7014,7 +6662,7 @@ int mp_reduce_is_2k_l(mp_int *a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* pre-calculate the value required for Barrett reduction
@@ -7031,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_reduce_setup.c */
/* Start: bn_mp_rshd.c */
@@ -7052,7 +6696,7 @@ int mp_reduce_setup (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shift right a certain amount of digits */
@@ -7107,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_rshd.c */
/* Start: bn_mp_set.c */
@@ -7128,7 +6768,7 @@ void mp_rshd (mp_int * a, int b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set to a digit */
@@ -7140,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_set.c */
/* Start: bn_mp_set_int.c */
@@ -7161,7 +6797,7 @@ void mp_set (mp_int * a, mp_digit b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set a 32-bit const */
@@ -7192,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_set_int.c */
/* Start: bn_mp_shrink.c */
@@ -7213,28 +6845,29 @@ int mp_set_int (mp_int * a, unsigned long b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* shrink a bignum */
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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_shrink.c */
/* Start: bn_mp_signed_bin_size.c */
@@ -7252,7 +6885,7 @@ int mp_shrink (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the size for an signed equivalent */
@@ -7262,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_signed_bin_size.c */
/* Start: bn_mp_sqr.c */
@@ -7283,7 +6912,7 @@ int mp_signed_bin_size (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* computes b = a*a */
@@ -7324,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_sqr.c */
/* Start: bn_mp_sqrmod.c */
@@ -7345,7 +6970,7 @@ if (a->used >= KARATSUBA_SQR_CUTOFF) {
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* c = a * a (mod b) */
@@ -7369,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* 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
*
@@ -7390,7 +7012,7 @@ mp_sqrmod (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* this function is less generic than mp_n_root, simpler and faster */
@@ -7454,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_sqrt.c */
/* Start: bn_mp_sub.c */
@@ -7475,7 +7093,7 @@ E2: mp_clear(&t1);
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* high level subtraction (handles signs) */
@@ -7517,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_sub.c */
/* Start: bn_mp_sub_d.c */
@@ -7538,7 +7152,7 @@ mp_sub (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* single digit subtraction */
@@ -7562,6 +7176,10 @@ mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
a->sign = MP_ZPOS;
res = mp_add_d(a, b, c);
a->sign = c->sign = MP_NEG;
+
+ /* clamp */
+ mp_clamp(c);
+
return res;
}
@@ -7610,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_sub_d.c */
/* Start: bn_mp_submod.c */
@@ -7631,7 +7245,7 @@ mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* d = a - b (mod c) */
@@ -7656,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_submod.c */
/* Start: bn_mp_to_signed_bin.c */
@@ -7677,7 +7287,7 @@ mp_submod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in signed [big endian] format */
@@ -7693,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_to_signed_bin.c */
/* Start: bn_mp_to_signed_bin_n.c */
@@ -7714,7 +7320,7 @@ int mp_to_signed_bin (mp_int * a, unsigned char *b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in signed [big endian] format */
@@ -7728,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_to_signed_bin_n.c */
/* Start: bn_mp_to_unsigned_bin.c */
@@ -7749,7 +7351,7 @@ int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in unsigned [big endian] format */
@@ -7780,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_to_unsigned_bin.c */
/* Start: bn_mp_to_unsigned_bin_n.c */
@@ -7801,7 +7399,7 @@ int mp_to_unsigned_bin (mp_int * a, unsigned char *b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* store in unsigned [big endian] format */
@@ -7815,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_to_unsigned_bin_n.c */
/* Start: bn_mp_toom_mul.c */
@@ -7836,7 +7430,7 @@ int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplication using the Toom-Cook 3-way algorithm
@@ -8103,10 +7697,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_toom_mul.c */
/* Start: bn_mp_toom_sqr.c */
@@ -8124,7 +7714,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* squaring using Toom-Cook 3-way algorithm */
@@ -8333,10 +7923,6 @@ ERR:
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_toom_sqr.c */
/* Start: bn_mp_toradix.c */
@@ -8354,7 +7940,7 @@ ERR:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* stores a bignum as a ASCII string in a given radix (2..64) */
@@ -8412,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_toradix.c */
/* Start: bn_mp_toradix_n.c */
@@ -8433,7 +8015,7 @@ int mp_toradix (mp_int * a, char *str, int radix)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* stores a bignum as a ASCII string in a given radix (2..64)
@@ -8448,12 +8030,12 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
char *_s = str;
/* check range of the maxlen, radix */
- if (maxlen < 3 || radix < 2 || radix > 64) {
+ if (maxlen < 2 || radix < 2 || radix > 64) {
return MP_VAL;
}
/* quick out if its zero */
- if (mp_iszero(a) == 1) {
+ if (mp_iszero(a) == MP_YES) {
*str++ = '0';
*str = '\0';
return MP_OKAY;
@@ -8478,21 +8060,20 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
digs = 0;
while (mp_iszero (&t) == 0) {
+ if (--maxlen < 1) {
+ /* no more room */
+ break;
+ }
if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) {
mp_clear (&t);
return res;
}
*str++ = mp_s_rmap[d];
++digs;
-
- if (--maxlen == 1) {
- /* no more room */
- break;
- }
}
/* reverse the digits of the string. In this case _s points
- * to the first digit [exluding the sign] of the number]
+ * to the first digit [exluding the sign] of the number
*/
bn_reverse ((unsigned char *)_s, digs);
@@ -8505,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_toradix_n.c */
/* Start: bn_mp_unsigned_bin_size.c */
@@ -8526,7 +8103,7 @@ int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* get the size for an unsigned equivalent */
@@ -8537,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_unsigned_bin_size.c */
/* Start: bn_mp_xor.c */
@@ -8558,7 +8131,7 @@ int mp_unsigned_bin_size (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* XOR two ints together */
@@ -8592,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_xor.c */
/* Start: bn_mp_zero.c */
@@ -8613,7 +8182,7 @@ mp_xor (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* set to zero */
@@ -8632,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_mp_zero.c */
/* Start: bn_prime_tab.c */
@@ -8653,7 +8218,7 @@ void mp_zero (mp_int * a)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
const mp_digit ltm_prime_tab[] = {
0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
@@ -8697,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_prime_tab.c */
/* Start: bn_reverse.c */
@@ -8718,7 +8279,7 @@ const mp_digit ltm_prime_tab[] = {
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* reverse an array, used for radix code */
@@ -8740,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_reverse.c */
/* Start: bn_s_mp_add.c */
@@ -8761,7 +8318,7 @@ bn_reverse (unsigned char *s, int len)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level addition, based on HAC pp.594, Algorithm 14.7 */
@@ -8853,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_add.c */
/* Start: bn_s_mp_exptmod.c */
@@ -8874,7 +8427,7 @@ s_mp_add (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifdef MP_LOW_MEM
#define TAB_SIZE 32
@@ -9109,10 +8662,6 @@ LBL_M:
}
#endif
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/pre_gen/mpi.c,v $ */
-/* $Revision: 1.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_exptmod.c */
/* Start: bn_s_mp_mul_digs.c */
@@ -9130,7 +8679,7 @@ LBL_M:
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplies |a| * |b| and only computes upto digs digits of result
@@ -9203,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_mul_digs.c */
/* Start: bn_s_mp_mul_high_digs.c */
@@ -9224,7 +8769,7 @@ int s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* multiplies |a| * |b| and does not compute the lower digs digits
@@ -9288,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_mul_high_digs.c */
/* Start: bn_s_mp_sqr.c */
@@ -9309,7 +8850,7 @@ s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */
@@ -9376,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_sqr.c */
/* Start: bn_s_mp_sub.c */
@@ -9397,7 +8934,7 @@ int s_mp_sqr (mp_int * a, mp_int * b)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */
@@ -9469,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bn_s_mp_sub.c */
/* Start: bncore.c */
@@ -9490,7 +9023,7 @@ s_mp_sub (mp_int * a, mp_int * b, mp_int * c)
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
/* Known optimal configurations
@@ -9509,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.3 $ */
-/* $Date: 2005/09/26 16:32:22 $ */
-
/* End: bncore.c */
diff --git a/libtommath/tommath.h b/libtommath/tommath.h
index bae09ce..4b3a76f 100644
--- a/libtommath/tommath.h
+++ b/libtommath/tommath.h
@@ -10,7 +10,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
- * Tom St Denis, tomstdenis@iahu.ca, http://math.libtomcrypt.org
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifndef BN_H_
#define BN_H_
@@ -24,11 +24,11 @@
#include <tommath_class.h>
#ifndef MIN
- #define MIN(x,y) ((x)<(y)?(x):(y))
+# define MIN(x,y) ((x)<(y)?(x):(y))
#endif
#ifndef MAX
- #define MAX(x,y) ((x)>(y)?(x):(y))
+# define MAX(x,y) ((x)>(y)?(x):(y))
#endif
#ifdef __cplusplus
@@ -47,9 +47,9 @@ extern "C" {
/* detect 64-bit mode if possible */
#if defined(__x86_64__)
- #if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
- #define MP_64BIT
- #endif
+# if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
+# define MP_64BIT
+# endif
#endif
/* some default configurations.
@@ -76,19 +76,19 @@ extern "C" {
typedef unsigned long mp_digit;
typedef unsigned long mp_word __attribute__ ((mode(TI)));
- #define DIGIT_BIT 60
+# define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */
/* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
- #if defined(_MSC_VER) || defined(__BORLANDC__)
+# if defined(_MSC_VER) || defined(__BORLANDC__)
typedef unsigned __int64 ulong64;
typedef signed __int64 long64;
- #else
+# else
typedef unsigned long long ulong64;
typedef signed long long long64;
- #endif
+# endif
#endif
typedef unsigned long mp_digit;
@@ -96,35 +96,35 @@ extern "C" {
#ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
- #define DIGIT_BIT 31
+# define DIGIT_BIT 31
#else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
- #define DIGIT_BIT 28
- #define MP_28BIT
+# define DIGIT_BIT 28
+# define MP_28BIT
#endif
#endif
/* define heap macros */
#ifndef CRYPT
/* default to libc stuff */
- #ifndef XMALLOC
- #define XMALLOC malloc
- #define XFREE free
- #define XREALLOC realloc
- #define XCALLOC calloc
- #else
+# ifndef XMALLOC
+# define XMALLOC malloc
+# define XFREE free
+# define XREALLOC realloc
+# define XCALLOC calloc
+# else
/* prototypes for our heap functions */
extern void *XMALLOC(size_t n);
extern void *XREALLOC(void *p, size_t n);
extern void *XCALLOC(size_t n, size_t s);
extern void XFREE(void *p);
- #endif
+# endif
#endif
/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
- #define DIGIT_BIT ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
+# define DIGIT_BIT ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
#endif
#define MP_DIGIT_BIT DIGIT_BIT
@@ -165,11 +165,11 @@ extern int KARATSUBA_MUL_CUTOFF,
/* default precision */
#ifndef MP_PREC
- #ifndef MP_LOW_MEM
- #define MP_PREC 32 /* default digits of precision */
- #else
- #define MP_PREC 8 /* default digits of precision */
- #endif
+# ifndef MP_LOW_MEM
+# define MP_PREC 32 /* default digits of precision */
+# else
+# define MP_PREC 8 /* default digits of precision */
+# endif
#endif
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
@@ -241,7 +241,7 @@ int mp_init_set (mp_int * a, mp_digit b);
int mp_init_set_int (mp_int * a, unsigned long b);
/* copy, b = a */
-int mp_copy(mp_int *a, mp_int *b);
+int mp_copy(const mp_int *a, mp_int *b);
/* inits and copies, a = b */
int mp_init_copy(mp_int *a, mp_int *b);
@@ -258,19 +258,19 @@ void mp_rshd(mp_int *a, int b);
int mp_lshd(mp_int *a, int b);
/* c = a / 2**b */
-int mp_div_2d(mp_int *a, int b, mp_int *c, mp_int *d);
+int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
/* b = a/2 */
int mp_div_2(mp_int *a, mp_int *b);
/* c = a * 2**b */
-int mp_mul_2d(mp_int *a, int b, mp_int *c);
+int mp_mul_2d(const mp_int *a, int b, mp_int *c);
/* b = a*2 */
int mp_mul_2(mp_int *a, mp_int *b);
/* c = a mod 2**d */
-int mp_mod_2d(mp_int *a, int b, mp_int *c);
+int mp_mod_2d(const mp_int *a, int b, mp_int *c);
/* computes a = 2**b */
int mp_2expt(mp_int *a, int b);
@@ -296,16 +296,16 @@ int mp_and(mp_int *a, mp_int *b, mp_int *c);
/* ---> Basic arithmetic <--- */
/* b = -a */
-int mp_neg(mp_int *a, mp_int *b);
+int mp_neg(const mp_int *a, mp_int *b);
/* b = |a| */
int mp_abs(mp_int *a, mp_int *b);
/* compare a to b */
-int mp_cmp(mp_int *a, mp_int *b);
+int mp_cmp(const mp_int *a, const mp_int *b);
/* compare |a| to |b| */
-int mp_cmp_mag(mp_int *a, mp_int *b);
+int mp_cmp_mag(const mp_int *a, const mp_int *b);
/* c = a + b */
int mp_add(mp_int *a, mp_int *b, mp_int *c);
@@ -328,7 +328,7 @@ int mp_mod(mp_int *a, mp_int *b, mp_int *c);
/* ---> single digit functions <--- */
/* compare against a single digit */
-int mp_cmp_d(mp_int *a, mp_digit b);
+int mp_cmp_d(const mp_int *a, mp_digit b);
/* c = a + b */
int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
@@ -447,9 +447,9 @@ int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
/* number of primes */
#ifdef MP_8BIT
- #define PRIME_SIZE 31
+# define PRIME_SIZE 31
#else
- #define PRIME_SIZE 256
+# define PRIME_SIZE 256
#endif
/* table of first PRIME_SIZE primes */
@@ -517,7 +517,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
/* ---> radix conversion <--- */
-int mp_count_bits(mp_int *a);
+int mp_count_bits(const mp_int *a);
int mp_unsigned_bin_size(mp_int *a);
int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
@@ -573,12 +573,7 @@ void bn_reverse(unsigned char *s, int len);
extern const char *mp_s_rmap;
#ifdef __cplusplus
- }
+}
#endif
#endif
-
-
-/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/tommath.h,v $ */
-/* $Revision: 1.3 $ */
-/* $Date: 2005/09/26 18:27:14 $ */
diff --git a/libtommath/tommath.pdf b/libtommath/tommath.pdf
index 71ddffe..c9571d8 100644
--- a/libtommath/tommath.pdf
+++ b/libtommath/tommath.pdf
Binary files differ
diff --git a/libtommath/tommath.src b/libtommath/tommath.src
index b392ead..4065822 100644
--- a/libtommath/tommath.src
+++ b/libtommath/tommath.src
@@ -66,7 +66,7 @@ QUALCOMM Australia \\
}
}
\maketitle
-This text has been placed in the public domain. This text corresponds to the v0.36 release of the
+This text has been placed in the public domain. This text corresponds to the v0.39 release of the
LibTomMath project.
\begin{alltt}
@@ -77,7 +77,7 @@ K2L 1C3
Canada
Phone: 1-613-836-3160
-Email: tomstdenis@iahu.ca
+Email: tomstdenis@gmail.com
\end{alltt}
This text is formatted to the international B5 paper size of 176mm wide by 250mm tall using the \LaTeX{}
@@ -268,7 +268,7 @@ and fast modular inversion, which we consider practical oversights. These optim
any form of useful performance in non-trivial applications.
To solve this problem the focus of this text is on the practical aspects of implementing a multiple precision integer
-package. As a case study the ``LibTomMath''\footnote{Available at \url{http://math.libtomcrypt.org}} package is used
+package. As a case study the ``LibTomMath''\footnote{Available at \url{http://math.libtomcrypt.com}} package is used
to demonstrate algorithms with real implementations\footnote{In the ISO C programming language.} that have been field
tested and work very well. The LibTomMath library is freely available on the Internet for all uses and this text
discusses a very large portion of the inner workings of the library.
@@ -2190,7 +2190,7 @@ left.
After the digits have been shifted appropriately at most $lg(\beta) - 1$ shifts are left to perform. Step 5 calculates the number of remaining shifts
required. If it is non-zero a modified shift loop is used to calculate the remaining product.
-Essentially the loop is a generic version of algorith mp\_mul2 designed to handle any shift count in the range $1 \le x < lg(\beta)$. The $mask$
+Essentially the loop is a generic version of algorithm mp\_mul\_2 designed to handle any shift count in the range $1 \le x < lg(\beta)$. The $mask$
variable is used to extract the upper $d$ bits to form the carry for the next iteration.
This algorithm is loosely measured as a $O(2n)$ algorithm which means that if the input is $n$-digits that it takes $2n$ ``time'' to
@@ -2611,17 +2611,16 @@ Place an array of \textbf{MP\_WARRAY} single precision digits named $W$ on the s
\hspace{6mm}5.4.1 $\_ \hat W \leftarrow \_ \hat W + a_{tx+iy}b_{ty-iy}$ \\
\hspace{3mm}5.5 $W_{ix} \leftarrow \_ \hat W (\mbox{mod }\beta)$\\
\hspace{3mm}5.6 $\_ \hat W \leftarrow \lfloor \_ \hat W / \beta \rfloor$ \\
-6. $W_{pa} \leftarrow \_ \hat W (\mbox{mod }\beta)$ \\
\\
-7. $oldused \leftarrow c.used$ \\
-8. $c.used \leftarrow digs$ \\
-9. for $ix$ from $0$ to $pa$ do \\
-\hspace{3mm}9.1 $c_{ix} \leftarrow W_{ix}$ \\
-10. for $ix$ from $pa + 1$ to $oldused - 1$ do \\
-\hspace{3mm}10.1 $c_{ix} \leftarrow 0$ \\
+6. $oldused \leftarrow c.used$ \\
+7. $c.used \leftarrow digs$ \\
+8. for $ix$ from $0$ to $pa$ do \\
+\hspace{3mm}8.1 $c_{ix} \leftarrow W_{ix}$ \\
+9. for $ix$ from $pa + 1$ to $oldused - 1$ do \\
+\hspace{3mm}9.1 $c_{ix} \leftarrow 0$ \\
\\
-11. Clamp $c$. \\
-12. Return MP\_OKAY. \\
+10. Clamp $c$. \\
+11. Return MP\_OKAY. \\
\hline
\end{tabular}
\end{center}
@@ -3731,6 +3730,7 @@ $0 \le r < \lfloor x/2^k \rfloor + n$. As a result at most a single subtraction
\hline $6$ & $x/2 = 139$ \\
\hline $7$ & $x + n = 396$, $x/2 = 198$ \\
\hline $8$ & $x/2 = 99$ \\
+\hline $9$ & $x + n = 356$, $x/2 = 178$ \\
\hline
\end{tabular}
\end{center}
@@ -3739,8 +3739,8 @@ $0 \le r < \lfloor x/2^k \rfloor + n$. As a result at most a single subtraction
\label{fig:MONT1}
\end{figure}
-Consider the example in figure~\ref{fig:MONT1} which reduces $x = 5555$ modulo $n = 257$ when $k = 8$. The result of the algorithm $r = 99$ is
-congruent to the value of $2^{-8} \cdot 5555 \mbox{ (mod }257\mbox{)}$. When $r$ is multiplied by $2^8$ modulo $257$ the correct residue
+Consider the example in figure~\ref{fig:MONT1} which reduces $x = 5555$ modulo $n = 257$ when $k = 9$ (note $\beta^k = 512$ which is larger than $n$). The result of
+the algorithm $r = 178$ is congruent to the value of $2^{-9} \cdot 5555 \mbox{ (mod }257\mbox{)}$. When $r$ is multiplied by $2^9$ modulo $257$ the correct residue
$r \equiv 158$ is produced.
Let $k = \lfloor lg(n) \rfloor + 1$ represent the number of bits in $n$. The current algorithm requires $2k^2$ single precision shifts
@@ -3752,10 +3752,10 @@ Fortunately there exists an alternative representation of the algorithm.
\begin{center}
\begin{tabular}{l}
\hline Algorithm \textbf{Montgomery Reduction} (modified I). \\
-\textbf{Input}. Integer $x$, $n$ and $k$ \\
+\textbf{Input}. Integer $x$, $n$ and $k$ ($2^k > n$) \\
\textbf{Output}. $2^{-k}x \mbox{ (mod }n\mbox{)}$ \\
\hline \\
-1. for $t$ from $0$ to $k - 1$ do \\
+1. for $t$ from $1$ to $k$ do \\
\hspace{3mm}1.1 If the $t$'th bit of $x$ is one then \\
\hspace{6mm}1.1.1 $x \leftarrow x + 2^tn$ \\
2. Return $x/2^k$. \\
@@ -3783,7 +3783,8 @@ precision shifts has now been reduced from $2k^2$ to $k^2 + k$ which is only a s
\hline $6$ & $8896$ & $10001011000000$ \\
\hline $7$ & $x + 2^{6}n = 25344$ & $110001100000000$ \\
\hline $8$ & $25344$ & $110001100000000$ \\
-\hline -- & $x/2^k = 99$ & \\
+\hline $9$ & $x + 2^{7}n = 91136$ & $10110010000000000$ \\
+\hline -- & $x/2^k = 178$ & \\
\hline
\end{tabular}
\end{center}
@@ -3792,7 +3793,7 @@ precision shifts has now been reduced from $2k^2$ to $k^2 + k$ which is only a s
\label{fig:MONT2}
\end{figure}
-Figure~\ref{fig:MONT2} demonstrates the modified algorithm reducing $x = 5555$ modulo $n = 257$ with $k = 8$.
+Figure~\ref{fig:MONT2} demonstrates the modified algorithm reducing $x = 5555$ modulo $n = 257$ with $k = 9$.
With this algorithm a single shift right at the end is the only right shift required to reduce the input instead of $k$ right shifts inside the
loop. Note that for the iterations $t = 2, 5, 6$ and $8$ where the result $x$ is not changed. In those iterations the $t$'th bit of $x$ is
zero and the appropriate multiple of $n$ does not need to be added to force the $t$'th bit of the result to zero.
@@ -3806,7 +3807,7 @@ previous algorithm re-written to compute the Montgomery reduction in this new fa
\begin{center}
\begin{tabular}{l}
\hline Algorithm \textbf{Montgomery Reduction} (modified II). \\
-\textbf{Input}. Integer $x$, $n$ and $k$ \\
+\textbf{Input}. Integer $x$, $n$ and $k$ ($\beta^k > n$) \\
\textbf{Output}. $\beta^{-k}x \mbox{ (mod }n\mbox{)}$ \\
\hline \\
1. for $t$ from $0$ to $k - 1$ do \\
@@ -4938,15 +4939,15 @@ a Left-to-Right algorithm is used to process the remaining few bits.
EXAM,bn_s_mp_exptmod.c
-Lines @26,if@ through @40,}@ determine the optimal window size based on the length of the exponent in bits. The window divisions are sorted
+Lines @31,if@ through @45,}@ determine the optimal window size based on the length of the exponent in bits. The window divisions are sorted
from smallest to greatest so that in each \textbf{if} statement only one condition must be tested. For example, by the \textbf{if} statement
-on line @32,if@ the value of $x$ is already known to be greater than $140$.
+on line @37,if@ the value of $x$ is already known to be greater than $140$.
The conditional piece of code beginning on line @42,ifdef@ allows the window size to be restricted to five bits. This logic is used to ensure
the table of precomputed powers of $G$ remains relatively small.
-The for loop on line @49,for@ initializes the $M$ array while lines @59,mp_init@ and @62,mp_reduce@ compute the value of $\mu$ required for
-Barrett reduction.
+The for loop on line @60,for@ initializes the $M$ array while lines @71,mp_init@ and @75,mp_reduce@ through @85,}@ initialize the reduction
+function that will be used for this modulus.
-- More later.
@@ -5229,23 +5230,23 @@ algorithm with only the quotient is
mp_div(&a, &b, &c, NULL); /* c = [a/b] */
\end{verbatim}
-Lines @37,if@ and @42,if@ handle the two trivial cases of inputs which are division by zero and dividend smaller than the divisor
-respectively. After the two trivial cases all of the temporary variables are initialized. Line @76,neg@ determines the sign of
-the quotient and line @77,sign@ ensures that both $x$ and $y$ are positive.
+Lines @108,if@ and @113,if@ handle the two trivial cases of inputs which are division by zero and dividend smaller than the divisor
+respectively. After the two trivial cases all of the temporary variables are initialized. Line @147,neg@ determines the sign of
+the quotient and line @148,sign@ ensures that both $x$ and $y$ are positive.
-The number of bits in the leading digit is calculated on line @80,norm@. Implictly an mp\_int with $r$ digits will require $lg(\beta)(r-1) + k$ bits
+The number of bits in the leading digit is calculated on line @151,norm@. Implictly an mp\_int with $r$ digits will require $lg(\beta)(r-1) + k$ bits
of precision which when reduced modulo $lg(\beta)$ produces the value of $k$. In this case $k$ is the number of bits in the leading digit which is
exactly what is required. For the algorithm to operate $k$ must equal $lg(\beta) - 1$ and when it does not the inputs must be normalized by shifting
them to the left by $lg(\beta) - 1 - k$ bits.
Throughout the variables $n$ and $t$ will represent the highest digit of $x$ and $y$ respectively. These are first used to produce the
-leading digit of the quotient. The loop beginning on line @113,for@ will produce the remainder of the quotient digits.
+leading digit of the quotient. The loop beginning on line @184,for@ will produce the remainder of the quotient digits.
-The conditional ``continue'' on line @114,if@ is used to prevent the algorithm from reading past the leading edge of $x$ which can occur when the
+The conditional ``continue'' on line @186,continue@ is used to prevent the algorithm from reading past the leading edge of $x$ which can occur when the
algorithm eliminates multiple non-zero digits in a single iteration. This ensures that $x_i$ is always non-zero since by definition the digits
above the $i$'th position $x$ must be zero in order for the quotient to be precise\footnote{Precise as far as integer division is concerned.}.
-Lines @142,t1@, @143,t1@ and @150,t2@ through @152,t2@ manually construct the high accuracy estimations by setting the digits of the two mp\_int
+Lines @214,t1@, @216,t1@ and @222,t2@ through @225,t2@ manually construct the high accuracy estimations by setting the digits of the two mp\_int
variables directly.
\section{Single Digit Helpers}
@@ -5743,33 +5744,30 @@ and will produce the greatest common divisor.
\textbf{Input}. mp\_int $a$ and $b$ \\
\textbf{Output}. The greatest common divisor $c = (a, b)$. \\
\hline \\
-1. If $a = 0$ and $b \ne 0$ then \\
-\hspace{3mm}1.1 $c \leftarrow b$ \\
+1. If $a = 0$ then \\
+\hspace{3mm}1.1 $c \leftarrow \vert b \vert $ \\
\hspace{3mm}1.2 Return(\textit{MP\_OKAY}). \\
-2. If $a \ne 0$ and $b = 0$ then \\
-\hspace{3mm}2.1 $c \leftarrow a$ \\
+2. If $b = 0$ then \\
+\hspace{3mm}2.1 $c \leftarrow \vert a \vert $ \\
\hspace{3mm}2.2 Return(\textit{MP\_OKAY}). \\
-3. If $a = b = 0$ then \\
-\hspace{3mm}3.1 $c \leftarrow 1$ \\
-\hspace{3mm}3.2 Return(\textit{MP\_OKAY}). \\
-4. $u \leftarrow \vert a \vert, v \leftarrow \vert b \vert$ \\
-5. $k \leftarrow 0$ \\
-6. While $u.used > 0$ and $v.used > 0$ and $u_0 \equiv v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}6.1 $k \leftarrow k + 1$ \\
-\hspace{3mm}6.2 $u \leftarrow \lfloor u / 2 \rfloor$ \\
-\hspace{3mm}6.3 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-7. While $u.used > 0$ and $u_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}7.1 $u \leftarrow \lfloor u / 2 \rfloor$ \\
-8. While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}8.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-9. While $v.used > 0$ \\
-\hspace{3mm}9.1 If $\vert u \vert > \vert v \vert$ then \\
-\hspace{6mm}9.1.1 Swap $u$ and $v$. \\
-\hspace{3mm}9.2 $v \leftarrow \vert v \vert - \vert u \vert$ \\
-\hspace{3mm}9.3 While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{6mm}9.3.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-10. $c \leftarrow u \cdot 2^k$ \\
-11. Return(\textit{MP\_OKAY}). \\
+3. $u \leftarrow \vert a \vert, v \leftarrow \vert b \vert$ \\
+4. $k \leftarrow 0$ \\
+5. While $u.used > 0$ and $v.used > 0$ and $u_0 \equiv v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}5.1 $k \leftarrow k + 1$ \\
+\hspace{3mm}5.2 $u \leftarrow \lfloor u / 2 \rfloor$ \\
+\hspace{3mm}5.3 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+6. While $u.used > 0$ and $u_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}6.1 $u \leftarrow \lfloor u / 2 \rfloor$ \\
+7. While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}7.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+8. While $v.used > 0$ \\
+\hspace{3mm}8.1 If $\vert u \vert > \vert v \vert$ then \\
+\hspace{6mm}8.1.1 Swap $u$ and $v$. \\
+\hspace{3mm}8.2 $v \leftarrow \vert v \vert - \vert u \vert$ \\
+\hspace{3mm}8.3 While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{6mm}8.3.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+9. $c \leftarrow u \cdot 2^k$ \\
+10. Return(\textit{MP\_OKAY}). \\
\hline
\end{tabular}
\end{center}
@@ -5781,17 +5779,17 @@ This algorithm will produce the greatest common divisor of two mp\_ints $a$ and
Knuth \cite[pp. 338]{TAOCPV2} but has been modified to be simpler to explain. In theory it achieves the same asymptotic working time as
Algorithm B and in practice this appears to be true.
-The first three steps handle the cases where either one of or both inputs are zero. If either input is zero the greatest common divisor is the
+The first two steps handle the cases where either one of or both inputs are zero. If either input is zero the greatest common divisor is the
largest input or zero if they are both zero. If the inputs are not trivial than $u$ and $v$ are assigned the absolute values of
$a$ and $b$ respectively and the algorithm will proceed to reduce the pair.
-Step six will divide out any common factors of two and keep track of the count in the variable $k$. After this step two is no longer a
+Step five will divide out any common factors of two and keep track of the count in the variable $k$. After this step, two is no longer a
factor of the remaining greatest common divisor between $u$ and $v$ and can be safely evenly divided out of either whenever they are even. Step
-seven and eight ensure that the $u$ and $v$ respectively have no more factors of two. At most only one of the while loops will iterate since
+six and seven ensure that the $u$ and $v$ respectively have no more factors of two. At most only one of the while--loops will iterate since
they cannot both be even.
-By step nine both of $u$ and $v$ are odd which is required for the inner logic. First the pair are swapped such that $v$ is equal to
-or greater than $u$. This ensures that the subtraction on step 9.2 will always produce a positive and even result. Step 9.3 removes any
+By step eight both of $u$ and $v$ are odd which is required for the inner logic. First the pair are swapped such that $v$ is equal to
+or greater than $u$. This ensures that the subtraction on step 8.2 will always produce a positive and even result. Step 8.3 removes any
factors of two from the difference $u$ to ensure that in the next iteration of the loop both are once again odd.
After $v = 0$ occurs the variable $u$ has the greatest common divisor of the pair $\left < u, v \right >$ just after step six. The result
@@ -5802,17 +5800,17 @@ EXAM,bn_mp_gcd.c
This function makes use of the macros mp\_iszero and mp\_iseven. The former evaluates to $1$ if the input mp\_int is equivalent to the
integer zero otherwise it evaluates to $0$. The latter evaluates to $1$ if the input mp\_int represents a non-zero even integer otherwise
it evaluates to $0$. Note that just because mp\_iseven may evaluate to $0$ does not mean the input is odd, it could also be zero. The three
-trivial cases of inputs are handled on lines @25,zero@ through @34,}@. After those lines the inputs are assumed to be non-zero.
+trivial cases of inputs are handled on lines @23,zero@ through @29,}@. After those lines the inputs are assumed to be non-zero.
-Lines @36,if@ and @40,if@ make local copies $u$ and $v$ of the inputs $a$ and $b$ respectively. At this point the common factors of two
-must be divided out of the two inputs. The while loop on line @49,while@ iterates so long as both are even. The local integer $k$ is used to
-keep track of how many factors of $2$ are pulled out of both values. It is assumed that the number of factors will not exceed the maximum
-value of a C ``int'' data type\footnote{Strictly speaking no array in C may have more than entries than are accessible by an ``int'' so this is not
-a limitation.}.
+Lines @32,if@ and @36,if@ make local copies $u$ and $v$ of the inputs $a$ and $b$ respectively. At this point the common factors of two
+must be divided out of the two inputs. The block starting at line @43,common@ removes common factors of two by first counting the number of trailing
+zero bits in both. The local integer $k$ is used to keep track of how many factors of $2$ are pulled out of both values. It is assumed that
+the number of factors will not exceed the maximum value of a C ``int'' data type\footnote{Strictly speaking no array in C may have more than
+entries than are accessible by an ``int'' so this is not a limitation.}.
-At this point there are no more common factors of two in the two values. The while loops on lines @60,while@ and @65,while@ remove any independent
-factors of two such that both $u$ and $v$ are guaranteed to be an odd integer before hitting the main body of the algorithm. The while loop
-on line @71, while@ performs the reduction of the pair until $v$ is equal to zero. The unsigned comparison and subtraction algorithms are used in
+At this point there are no more common factors of two in the two values. The divisions by a power of two on lines @60,div_2d@ and @67,div_2d@ remove
+any independent factors of two such that both $u$ and $v$ are guaranteed to be an odd integer before hitting the main body of the algorithm. The while loop
+on line @72, while@ performs the reduction of the pair until $v$ is equal to zero. The unsigned comparison and subtraction algorithms are used in
place of the full signed routines since both values are guaranteed to be positive and the result of the subtraction is guaranteed to be non-negative.
\section{Least Common Multiple}
diff --git a/libtommath/tommath.tex b/libtommath/tommath.tex
index b69421b..c79a537 100644
--- a/libtommath/tommath.tex
+++ b/libtommath/tommath.tex
@@ -66,7 +66,7 @@ QUALCOMM Australia \\
}
}
\maketitle
-This text has been placed in the public domain. This text corresponds to the v0.36 release of the
+This text has been placed in the public domain. This text corresponds to the v0.39 release of the
LibTomMath project.
\begin{alltt}
@@ -77,7 +77,7 @@ K2L 1C3
Canada
Phone: 1-613-836-3160
-Email: tomstdenis@iahu.ca
+Email: tomstdenis@gmail.com
\end{alltt}
This text is formatted to the international B5 paper size of 176mm wide by 250mm tall using the \LaTeX{}
@@ -268,7 +268,7 @@ and fast modular inversion, which we consider practical oversights. These optim
any form of useful performance in non-trivial applications.
To solve this problem the focus of this text is on the practical aspects of implementing a multiple precision integer
-package. As a case study the ``LibTomMath''\footnote{Available at \url{http://math.libtomcrypt.org}} package is used
+package. As a case study the ``LibTomMath''\footnote{Available at \url{http://math.libtomcrypt.com}} package is used
to demonstrate algorithms with real implementations\footnote{In the ISO C programming language.} that have been field
tested and work very well. The LibTomMath library is freely available on the Internet for all uses and this text
discusses a very large portion of the inner workings of the library.
@@ -788,33 +788,6 @@ decrementally.
\hspace{-5.1mm}{\bf File}: bn\_mp\_init.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* init a new mp_int */
-018 int mp_init (mp_int * a)
-019 \{
-020 int i;
-021
-022 /* allocate memory required and clear it */
-023 a->dp = OPT_CAST(mp_digit) XMALLOC (sizeof (mp_digit) * MP_PREC);
-024 if (a->dp == NULL) \{
-025 return MP_MEM;
-026 \}
-027
-028 /* set the digits to zero */
-029 for (i = 0; i < MP_PREC; i++) \{
-030 a->dp[i] = 0;
-031 \}
-032
-033 /* set the used to zero, allocated digits to the default precision
-034 * and sign to positive */
-035 a->used = 0;
-036 a->alloc = MP_PREC;
-037 a->sign = MP_ZPOS;
-038
-039 return MP_OKAY;
-040 \}
-041 #endif
-042
\end{alltt}
\end{small}
@@ -822,7 +795,7 @@ One immediate observation of this initializtion function is that it does not ret
is assumed that the caller has already allocated memory for the mp\_int structure, typically on the application stack. The
call to mp\_init() is used only to initialize the members of the structure to a known default state.
-Here we see (line 23) the memory allocation is performed first. This allows us to exit cleanly and quickly
+Here we see (line 24) the memory allocation is performed first. This allows us to exit cleanly and quickly
if there is an error. If the allocation fails the routine will return \textbf{MP\_MEM} to the caller to indicate there
was a memory error. The function XMALLOC is what actually allocates the memory. Technically XMALLOC is not a function
but a macro defined in ``tommath.h``. By default, XMALLOC will evaluate to malloc() which is the C library's built--in
@@ -830,11 +803,11 @@ memory allocation routine.
In order to assure the mp\_int is in a known state the digits must be set to zero. On most platforms this could have been
accomplished by using calloc() instead of malloc(). However, to correctly initialize a integer type to a given value in a
-portable fashion you have to actually assign the value. The for loop (line 29) performs this required
+portable fashion you have to actually assign the value. The for loop (line 30) performs this required
operation.
After the memory has been successfully initialized the remainder of the members are initialized
-(lines 33 through 34) to their respective default states. At this point the algorithm has succeeded and
+(lines 34 through 35) to their respective default states. At this point the algorithm has succeeded and
a success code is returned to the calling function. If this function returns \textbf{MP\_OKAY} it is safe to assume the
mp\_int structure has been properly initialized and is safe to use with other functions within the library.
@@ -879,46 +852,21 @@ with the exception of algorithms mp\_init, mp\_init\_copy, mp\_init\_size and mp
\hspace{-5.1mm}{\bf File}: bn\_mp\_clear.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* clear one (frees) */
-018 void
-019 mp_clear (mp_int * a)
-020 \{
-021 int i;
-022
-023 /* only do anything if a hasn't been freed previously */
-024 if (a->dp != NULL) \{
-025 /* first zero the digits */
-026 for (i = 0; i < a->used; i++) \{
-027 a->dp[i] = 0;
-028 \}
-029
-030 /* free ram */
-031 XFREE(a->dp);
-032
-033 /* reset members to make debugging easier */
-034 a->dp = NULL;
-035 a->alloc = a->used = 0;
-036 a->sign = MP_ZPOS;
-037 \}
-038 \}
-039 #endif
-040
\end{alltt}
\end{small}
-The algorithm only operates on the mp\_int if it hasn't been previously cleared. The if statement (line 24)
+The algorithm only operates on the mp\_int if it hasn't been previously cleared. The if statement (line 25)
checks to see if the \textbf{dp} member is not \textbf{NULL}. If the mp\_int is a valid mp\_int then \textbf{dp} cannot be
\textbf{NULL} in which case the if statement will evaluate to true.
-The digits of the mp\_int are cleared by the for loop (line 26) which assigns a zero to every digit. Similar to mp\_init()
+The digits of the mp\_int are cleared by the for loop (line 27) which assigns a zero to every digit. Similar to mp\_init()
the digits are assigned zero instead of using block memory operations (such as memset()) since this is more portable.
The digits are deallocated off the heap via the XFREE macro. Similar to XMALLOC the XFREE macro actually evaluates to
a standard C library function. In this case the free() function. Since free() only deallocates the memory the pointer
-still has to be reset to \textbf{NULL} manually (line 34).
+still has to be reset to \textbf{NULL} manually (line 35).
-Now that the digits have been cleared and deallocated the other members are set to their final values (lines 35 and 36).
+Now that the digits have been cleared and deallocated the other members are set to their final values (lines 36 and 37).
\section{Maintenance Algorithms}
@@ -973,44 +921,6 @@ assumed to contain undefined values they are initially set to zero.
\hspace{-5.1mm}{\bf File}: bn\_mp\_grow.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* grow as required */
-018 int mp_grow (mp_int * a, int size)
-019 \{
-020 int i;
-021 mp_digit *tmp;
-022
-023 /* if the alloc size is smaller alloc more ram */
-024 if (a->alloc < size) \{
-025 /* ensure there are always at least MP_PREC digits extra on top */
-026 size += (MP_PREC * 2) - (size % MP_PREC);
-027
-028 /* reallocate the array a->dp
-029 *
-030 * We store the return in a temporary variable
-031 * in case the operation failed we don't want
-032 * to overwrite the dp member of a.
-033 */
-034 tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * size);
-035 if (tmp == NULL) \{
-036 /* reallocation failed but "a" is still valid [can be freed] */
-037 return MP_MEM;
-038 \}
-039
-040 /* reallocation succeeded so set a->dp */
-041 a->dp = tmp;
-042
-043 /* zero excess digits */
-044 i = a->alloc;
-045 a->alloc = size;
-046 for (; i < a->alloc; i++) \{
-047 a->dp[i] = 0;
-048 \}
-049 \}
-050 return MP_OKAY;
-051 \}
-052 #endif
-053
\end{alltt}
\end{small}
@@ -1019,7 +929,7 @@ if the \textbf{alloc} member of the mp\_int is smaller than the requested digit
the function skips the re-allocation part thus saving time.
When a re-allocation is performed it is turned into an optimal request to save time in the future. The requested digit count is
-padded upwards to 2nd multiple of \textbf{MP\_PREC} larger than \textbf{alloc} (line 26). The XREALLOC function is used
+padded upwards to 2nd multiple of \textbf{MP\_PREC} larger than \textbf{alloc} (line 25). The XREALLOC function is used
to re-allocate the memory. As per the other functions XREALLOC is actually a macro which evaluates to realloc by default. The realloc
function leaves the base of the allocation intact which means the first \textbf{alloc} digits of the mp\_int are the same as before
the re-allocation. All that is left is to clear the newly allocated digits and return.
@@ -1071,46 +981,17 @@ correct no further memory re-allocations are required to work with the mp\_int.
\hspace{-5.1mm}{\bf File}: bn\_mp\_init\_size.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* init an mp_init for a given size */
-018 int mp_init_size (mp_int * a, int size)
-019 \{
-020 int x;
-021
-022 /* pad size so there are always extra digits */
-023 size += (MP_PREC * 2) - (size % MP_PREC);
-024
-025 /* alloc mem */
-026 a->dp = OPT_CAST(mp_digit) XMALLOC (sizeof (mp_digit) * size);
-027 if (a->dp == NULL) \{
-028 return MP_MEM;
-029 \}
-030
-031 /* set the members */
-032 a->used = 0;
-033 a->alloc = size;
-034 a->sign = MP_ZPOS;
-035
-036 /* zero the digits */
-037 for (x = 0; x < size; x++) \{
-038 a->dp[x] = 0;
-039 \}
-040
-041 return MP_OKAY;
-042 \}
-043 #endif
-044
\end{alltt}
\end{small}
-The number of digits $b$ requested is padded (line 23) by first augmenting it to the next multiple of
+The number of digits $b$ requested is padded (line 24) by first augmenting it to the next multiple of
\textbf{MP\_PREC} and then adding \textbf{MP\_PREC} to the result. If the memory can be successfully allocated the
mp\_int is placed in a default state representing the integer zero. Otherwise, the error code \textbf{MP\_MEM} will be
-returned (line 28).
+returned (line 29).
The digits are allocated and set to zero at the same time with the calloc() function (line @25,XCALLOC@). The
\textbf{used} count is set to zero, the \textbf{alloc} count set to the padded digit count and the \textbf{sign} flag set
-to \textbf{MP\_ZPOS} to achieve a default valid mp\_int state (lines 32, 33 and 34). If the function
+to \textbf{MP\_ZPOS} to achieve a default valid mp\_int state (lines 33, 34 and 35). If the function
returns succesfully then it is correct to assume that the mp\_int structure is in a valid state for the remainder of the
functions to work with.
@@ -1148,46 +1029,6 @@ initialization which allows for quick recovery from runtime errors.
\hspace{-5.1mm}{\bf File}: bn\_mp\_init\_multi.c
\vspace{-3mm}
\begin{alltt}
-016 #include <stdarg.h>
-017
-018 int mp_init_multi(mp_int *mp, ...)
-019 \{
-020 mp_err res = MP_OKAY; /* Assume ok until proven otherwise */
-021 int n = 0; /* Number of ok inits */
-022 mp_int* cur_arg = mp;
-023 va_list args;
-024
-025 va_start(args, mp); /* init args to next argument from caller */
-026 while (cur_arg != NULL) \{
-027 if (mp_init(cur_arg) != MP_OKAY) \{
-028 /* Oops - error! Back-track and mp_clear what we already
-029 succeeded in init-ing, then return error.
-030 */
-031 va_list clean_args;
-032
-033 /* end the current list */
-034 va_end(args);
-035
-036 /* now start cleaning up */
-037 cur_arg = mp;
-038 va_start(clean_args, mp);
-039 while (n--) \{
-040 mp_clear(cur_arg);
-041 cur_arg = va_arg(clean_args, mp_int*);
-042 \}
-043 va_end(clean_args);
-044 res = MP_MEM;
-045 break;
-046 \}
-047 n++;
-048 cur_arg = va_arg(args, mp_int*);
-049 \}
-050 va_end(args);
-051 return res; /* Assumed ok, if error flagged above. */
-052 \}
-053
-054 #endif
-055
\end{alltt}
\end{small}
@@ -1197,8 +1038,8 @@ structures in an actual C array they are simply passed as arguments to the funct
appended on the right.
The function uses the ``stdarg.h'' \textit{va} functions to step portably through the arguments to the function. A count
-$n$ of succesfully initialized mp\_int structures is maintained (line 47) such that if a failure does occur,
-the algorithm can backtrack and free the previously initialized structures (lines 27 to 46).
+$n$ of succesfully initialized mp\_int structures is maintained (line 48) such that if a failure does occur,
+the algorithm can backtrack and free the previously initialized structures (lines 28 to 47).
\subsection{Clamping Excess Digits}
@@ -1249,38 +1090,13 @@ when all of the digits are zero to ensure that the mp\_int is valid at all times
\hspace{-5.1mm}{\bf File}: bn\_mp\_clamp.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* trim unused digits
-018 *
-019 * This is used to ensure that leading zero digits are
-020 * trimed and the leading "used" digit will be non-zero
-021 * Typically very fast. Also fixes the sign if there
-022 * are no more leading digits
-023 */
-024 void
-025 mp_clamp (mp_int * a)
-026 \{
-027 /* decrease used while the most significant digit is
-028 * zero.
-029 */
-030 while (a->used > 0 && a->dp[a->used - 1] == 0) \{
-031 --(a->used);
-032 \}
-033
-034 /* reset the sign flag if used == 0 */
-035 if (a->used == 0) \{
-036 a->sign = MP_ZPOS;
-037 \}
-038 \}
-039 #endif
-040
\end{alltt}
\end{small}
-Note on line 27 how to test for the \textbf{used} count is made on the left of the \&\& operator. In the C programming
+Note on line 28 how to test for the \textbf{used} count is made on the left of the \&\& operator. In the C programming
language the terms to \&\& are evaluated left to right with a boolean short-circuit if any condition fails. This is
important since if the \textbf{used} is zero the test on the right would fetch below the array. That is obviously
-undesirable. The parenthesis on line 30 is used to make sure the \textbf{used} count is decremented and not
+undesirable. The parenthesis on line 31 is used to make sure the \textbf{used} count is decremented and not
the pointer ``a''.
\section*{Exercises}
@@ -1363,70 +1179,21 @@ implement the pseudo-code.
\hspace{-5.1mm}{\bf File}: bn\_mp\_copy.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* copy, b = a */
-018 int
-019 mp_copy (mp_int * a, mp_int * b)
-020 \{
-021 int res, n;
-022
-023 /* if dst == src do nothing */
-024 if (a == b) \{
-025 return MP_OKAY;
-026 \}
-027
-028 /* grow dest */
-029 if (b->alloc < a->used) \{
-030 if ((res = mp_grow (b, a->used)) != MP_OKAY) \{
-031 return res;
-032 \}
-033 \}
-034
-035 /* zero b and copy the parameters over */
-036 \{
-037 register mp_digit *tmpa, *tmpb;
-038
-039 /* pointer aliases */
-040
-041 /* source */
-042 tmpa = a->dp;
-043
-044 /* destination */
-045 tmpb = b->dp;
-046
-047 /* copy all the digits */
-048 for (n = 0; n < a->used; n++) \{
-049 *tmpb++ = *tmpa++;
-050 \}
-051
-052 /* clear high digits */
-053 for (; n < b->used; n++) \{
-054 *tmpb++ = 0;
-055 \}
-056 \}
-057
-058 /* copy used count and sign */
-059 b->used = a->used;
-060 b->sign = a->sign;
-061 return MP_OKAY;
-062 \}
-063 #endif
-064
\end{alltt}
\end{small}
Occasionally a dependent algorithm may copy an mp\_int effectively into itself such as when the input and output
mp\_int structures passed to a function are one and the same. For this case it is optimal to return immediately without
-copying digits (line 24).
+copying digits (line 25).
The mp\_int $b$ must have enough digits to accomodate the used digits of the mp\_int $a$. If $b.alloc$ is less than
-$a.used$ the algorithm mp\_grow is used to augment the precision of $b$ (lines 29 to 33). In order to
+$a.used$ the algorithm mp\_grow is used to augment the precision of $b$ (lines 30 to 33). In order to
simplify the inner loop that copies the digits from $a$ to $b$, two aliases $tmpa$ and $tmpb$ point directly at the digits
-of the mp\_ints $a$ and $b$ respectively. These aliases (lines 42 and 45) allow the compiler to access the digits without first dereferencing the
+of the mp\_ints $a$ and $b$ respectively. These aliases (lines 43 and 46) allow the compiler to access the digits without first dereferencing the
mp\_int pointers and then subsequently the pointer to the digits.
-After the aliases are established the digits from $a$ are copied into $b$ (lines 48 to 50) and then the excess
-digits of $b$ are set to zero (lines 53 to 55). Both ``for'' loops make use of the pointer aliases and in
+After the aliases are established the digits from $a$ are copied into $b$ (lines 49 to 51) and then the excess
+digits of $b$ are set to zero (lines 54 to 56). Both ``for'' loops make use of the pointer aliases and in
fact the alias for $b$ is carried through into the second ``for'' loop to clear the excess digits. This optimization
allows the alias to stay in a machine register fairly easy between the two loops.
@@ -1514,19 +1281,6 @@ such this algorithm will perform two operations in one step.
\hspace{-5.1mm}{\bf File}: bn\_mp\_init\_copy.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* creates "a" then copies b into it */
-018 int mp_init_copy (mp_int * a, mp_int * b)
-019 \{
-020 int res;
-021
-022 if ((res = mp_init (a)) != MP_OKAY) \{
-023 return res;
-024 \}
-025 return mp_copy (b, a);
-026 \}
-027 #endif
-028
\end{alltt}
\end{small}
@@ -1562,23 +1316,6 @@ This algorithm simply resets a mp\_int to the default state.
\hspace{-5.1mm}{\bf File}: bn\_mp\_zero.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* set to zero */
-018 void mp_zero (mp_int * a)
-019 \{
-020 int n;
-021 mp_digit *tmp;
-022
-023 a->sign = MP_ZPOS;
-024 a->used = 0;
-025
-026 tmp = a->dp;
-027 for (n = 0; n < a->alloc; n++) \{
-028 *tmp++ = 0;
-029 \}
-030 \}
-031 #endif
-032
\end{alltt}
\end{small}
@@ -1617,34 +1354,10 @@ logic to handle it.
\hspace{-5.1mm}{\bf File}: bn\_mp\_abs.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* b = |a|
-018 *
-019 * Simple function copies the input and fixes the sign to positive
-020 */
-021 int
-022 mp_abs (mp_int * a, mp_int * b)
-023 \{
-024 int res;
-025
-026 /* copy a to b */
-027 if (a != b) \{
-028 if ((res = mp_copy (a, b)) != MP_OKAY) \{
-029 return res;
-030 \}
-031 \}
-032
-033 /* force the sign of b to positive */
-034 b->sign = MP_ZPOS;
-035
-036 return MP_OKAY;
-037 \}
-038 #endif
-039
\end{alltt}
\end{small}
-This fairly trivial algorithm first eliminates non--required duplications (line 27) and then sets the
+This fairly trivial algorithm first eliminates non--required duplications (line 28) and then sets the
\textbf{sign} flag to \textbf{MP\_ZPOS}.
\subsection{Integer Negation}
@@ -1682,31 +1395,10 @@ zero as negative.
\hspace{-5.1mm}{\bf File}: bn\_mp\_neg.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* b = -a */
-018 int mp_neg (mp_int * a, mp_int * b)
-019 \{
-020 int res;
-021 if (a != b) \{
-022 if ((res = mp_copy (a, b)) != MP_OKAY) \{
-023 return res;
-024 \}
-025 \}
-026
-027 if (mp_iszero(b) != MP_YES) \{
-028 b->sign = (a->sign == MP_ZPOS) ? MP_NEG : MP_ZPOS;
-029 \} else \{
-030 b->sign = MP_ZPOS;
-031 \}
-032
-033 return MP_OKAY;
-034 \}
-035 #endif
-036
\end{alltt}
\end{small}
-Like mp\_abs() this function avoids non--required duplications (line 21) and then sets the sign. We
+Like mp\_abs() this function avoids non--required duplications (line 22) and then sets the sign. We
have to make sure that only non--zero values get a \textbf{sign} of \textbf{MP\_NEG}. If the mp\_int is zero
than the \textbf{sign} is hard--coded to \textbf{MP\_ZPOS}.
@@ -1741,22 +1433,12 @@ single digit is set (\textit{modulo $\beta$}) and the \textbf{used} count is adj
\hspace{-5.1mm}{\bf File}: bn\_mp\_set.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* set to a digit */
-018 void mp_set (mp_int * a, mp_digit b)
-019 \{
-020 mp_zero (a);
-021 a->dp[0] = b & MP_MASK;
-022 a->used = (a->dp[0] != 0) ? 1 : 0;
-023 \}
-024 #endif
-025
\end{alltt}
\end{small}
-First we zero (line 20) the mp\_int to make sure that the other members are initialized for a
+First we zero (line 21) the mp\_int to make sure that the other members are initialized for a
small positive constant. mp\_zero() ensures that the \textbf{sign} is positive and the \textbf{used} count
-is zero. Next we set the digit and reduce it modulo $\beta$ (line 21). After this step we have to
+is zero. Next we set the digit and reduce it modulo $\beta$ (line 22). After this step we have to
check if the resulting digit is zero or not. If it is not then we set the \textbf{used} count to one, otherwise
to zero.
@@ -1803,42 +1485,13 @@ Excess zero digits are trimmed in steps 2.1 and 3 by using higher level algorith
\hspace{-5.1mm}{\bf File}: bn\_mp\_set\_int.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* set a 32-bit const */
-018 int mp_set_int (mp_int * a, unsigned long b)
-019 \{
-020 int x, res;
-021
-022 mp_zero (a);
-023
-024 /* set four bits at a time */
-025 for (x = 0; x < 8; x++) \{
-026 /* shift the number up four bits */
-027 if ((res = mp_mul_2d (a, 4, a)) != MP_OKAY) \{
-028 return res;
-029 \}
-030
-031 /* OR in the top four bits of the source */
-032 a->dp[0] |= (b >> 28) & 15;
-033
-034 /* shift the source up to the next four bits */
-035 b <<= 4;
-036
-037 /* ensure that digits are not clamped off */
-038 a->used += 1;
-039 \}
-040 mp_clamp (a);
-041 return MP_OKAY;
-042 \}
-043 #endif
-044
\end{alltt}
\end{small}
This function sets four bits of the number at a time to handle all practical \textbf{DIGIT\_BIT} sizes. The weird
-addition on line 38 ensures that the newly added in bits are added to the number of digits. While it may not
-seem obvious as to why the digit counter does not grow exceedingly large it is because of the shift on line 27
-as well as the call to mp\_clamp() on line 40. Both functions will clamp excess leading digits which keeps
+addition on line 39 ensures that the newly added in bits are added to the number of digits. While it may not
+seem obvious as to why the digit counter does not grow exceedingly large it is because of the shift on line 28
+as well as the call to mp\_clamp() on line 41. Both functions will clamp excess leading digits which keeps
the number of used digits low.
\section{Comparisons}
@@ -1899,46 +1552,10 @@ the zero'th digit. If after all of the digits have been compared, no difference
\hspace{-5.1mm}{\bf File}: bn\_mp\_cmp\_mag.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* compare maginitude of two ints (unsigned) */
-018 int mp_cmp_mag (mp_int * a, mp_int * b)
-019 \{
-020 int n;
-021 mp_digit *tmpa, *tmpb;
-022
-023 /* compare based on # of non-zero digits */
-024 if (a->used > b->used) \{
-025 return MP_GT;
-026 \}
-027
-028 if (a->used < b->used) \{
-029 return MP_LT;
-030 \}
-031
-032 /* alias for a */
-033 tmpa = a->dp + (a->used - 1);
-034
-035 /* alias for b */
-036 tmpb = b->dp + (a->used - 1);
-037
-038 /* compare based on digits */
-039 for (n = 0; n < a->used; ++n, --tmpa, --tmpb) \{
-040 if (*tmpa > *tmpb) \{
-041 return MP_GT;
-042 \}
-043
-044 if (*tmpa < *tmpb) \{
-045 return MP_LT;
-046 \}
-047 \}
-048 return MP_EQ;
-049 \}
-050 #endif
-051
\end{alltt}
\end{small}
-The two if statements (lines 24 and 28) compare the number of digits in the two inputs. These two are
+The two if statements (lines 25 and 29) compare the number of digits in the two inputs. These two are
performed before all of the digits are compared since it is a very cheap test to perform and can potentially save
considerable time. The implementation given is also not valid without those two statements. $b.alloc$ may be
smaller than $a.used$, meaning that undefined values will be read from $b$ past the end of the array of digits.
@@ -1978,36 +1595,12 @@ $\vert a \vert < \vert b \vert$. Step number four will compare the two when the
\hspace{-5.1mm}{\bf File}: bn\_mp\_cmp.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* compare two ints (signed)*/
-018 int
-019 mp_cmp (mp_int * a, mp_int * b)
-020 \{
-021 /* compare based on sign */
-022 if (a->sign != b->sign) \{
-023 if (a->sign == MP_NEG) \{
-024 return MP_LT;
-025 \} else \{
-026 return MP_GT;
-027 \}
-028 \}
-029
-030 /* compare digits */
-031 if (a->sign == MP_NEG) \{
-032 /* if negative compare opposite direction */
-033 return mp_cmp_mag(b, a);
-034 \} else \{
-035 return mp_cmp_mag(a, b);
-036 \}
-037 \}
-038 #endif
-039
\end{alltt}
\end{small}
-The two if statements (lines 22 and 23) perform the initial sign comparison. If the signs are not the equal then which ever
-has the positive sign is larger. The inputs are compared (line 31) based on magnitudes. If the signs were both
-negative then the unsigned comparison is performed in the opposite direction (line 33). Otherwise, the signs are assumed to
+The two if statements (lines 23 and 24) perform the initial sign comparison. If the signs are not the equal then which ever
+has the positive sign is larger. The inputs are compared (line 32) based on magnitudes. If the signs were both
+negative then the unsigned comparison is performed in the opposite direction (line 34). Otherwise, the signs are assumed to
be both positive and a forward direction unsigned comparison is performed.
\section*{Exercises}
@@ -2131,114 +1724,24 @@ The final carry is stored in $c_{max}$ and digits above $max$ upto $oldused$ are
\hspace{-5.1mm}{\bf File}: bn\_s\_mp\_add.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* low level addition, based on HAC pp.594, Algorithm 14.7 */
-018 int
-019 s_mp_add (mp_int * a, mp_int * b, mp_int * c)
-020 \{
-021 mp_int *x;
-022 int olduse, res, min, max;
-023
-024 /* find sizes, we let |a| <= |b| which means we have to sort
-025 * them. "x" will point to the input with the most digits
-026 */
-027 if (a->used > b->used) \{
-028 min = b->used;
-029 max = a->used;
-030 x = a;
-031 \} else \{
-032 min = a->used;
-033 max = b->used;
-034 x = b;
-035 \}
-036
-037 /* init result */
-038 if (c->alloc < max + 1) \{
-039 if ((res = mp_grow (c, max + 1)) != MP_OKAY) \{
-040 return res;
-041 \}
-042 \}
-043
-044 /* get old used digit count and set new one */
-045 olduse = c->used;
-046 c->used = max + 1;
-047
-048 \{
-049 register mp_digit u, *tmpa, *tmpb, *tmpc;
-050 register int i;
-051
-052 /* alias for digit pointers */
-053
-054 /* first input */
-055 tmpa = a->dp;
-056
-057 /* second input */
-058 tmpb = b->dp;
-059
-060 /* destination */
-061 tmpc = c->dp;
-062
-063 /* zero the carry */
-064 u = 0;
-065 for (i = 0; i < min; i++) \{
-066 /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */
-067 *tmpc = *tmpa++ + *tmpb++ + u;
-068
-069 /* U = carry bit of T[i] */
-070 u = *tmpc >> ((mp_digit)DIGIT_BIT);
-071
-072 /* take away carry bit from T[i] */
-073 *tmpc++ &= MP_MASK;
-074 \}
-075
-076 /* now copy higher words if any, that is in A+B
-077 * if A or B has more digits add those in
-078 */
-079 if (min != max) \{
-080 for (; i < max; i++) \{
-081 /* T[i] = X[i] + U */
-082 *tmpc = x->dp[i] + u;
-083
-084 /* U = carry bit of T[i] */
-085 u = *tmpc >> ((mp_digit)DIGIT_BIT);
-086
-087 /* take away carry bit from T[i] */
-088 *tmpc++ &= MP_MASK;
-089 \}
-090 \}
-091
-092 /* add carry */
-093 *tmpc++ = u;
-094
-095 /* clear digits above oldused */
-096 for (i = c->used; i < olduse; i++) \{
-097 *tmpc++ = 0;
-098 \}
-099 \}
-100
-101 mp_clamp (c);
-102 return MP_OKAY;
-103 \}
-104 #endif
-105
\end{alltt}
\end{small}
-We first sort (lines 27 to 35) the inputs based on magnitude and determine the $min$ and $max$ variables.
+We first sort (lines 28 to 36) the inputs based on magnitude and determine the $min$ and $max$ variables.
Note that $x$ is a pointer to an mp\_int assigned to the largest input, in effect it is a local alias. Next we
-grow the destination (37 to 42) ensure that it can accomodate the result of the addition.
+grow the destination (38 to 42) ensure that it can accomodate the result of the addition.
Similar to the implementation of mp\_copy this function uses the braced code and local aliases coding style. The three aliases that are on
-lines 55, 58 and 61 represent the two inputs and destination variables respectively. These aliases are used to ensure the
+lines 56, 59 and 62 represent the two inputs and destination variables respectively. These aliases are used to ensure the
compiler does not have to dereference $a$, $b$ or $c$ (respectively) to access the digits of the respective mp\_int.
-The initial carry $u$ will be cleared (line 64), note that $u$ is of type mp\_digit which ensures type
-compatibility within the implementation. The initial addition (line 65 to 74) adds digits from
+The initial carry $u$ will be cleared (line 65), note that $u$ is of type mp\_digit which ensures type
+compatibility within the implementation. The initial addition (line 66 to 75) adds digits from
both inputs until the smallest input runs out of digits. Similarly the conditional addition loop
-(line 80 to 90) adds the remaining digits from the larger of the two inputs. The addition is finished
-with the final carry being stored in $tmpc$ (line 93). Note the ``++'' operator within the same expression.
-After line 93, $tmpc$ will point to the $c.used$'th digit of the mp\_int $c$. This is useful
-for the next loop (line 96 to 99) which set any old upper digits to zero.
+(line 81 to 90) adds the remaining digits from the larger of the two inputs. The addition is finished
+with the final carry being stored in $tmpc$ (line 94). Note the ``++'' operator within the same expression.
+After line 94, $tmpc$ will point to the $c.used$'th digit of the mp\_int $c$. This is useful
+for the next loop (line 97 to 99) which set any old upper digits to zero.
\subsection{Low Level Subtraction}
The low level unsigned subtraction algorithm is very similar to the low level unsigned addition algorithm. The principle difference is that the
@@ -2322,96 +1825,25 @@ If $b$ has a smaller magnitude than $a$ then step 9 will force the carry and cop
\hspace{-5.1mm}{\bf File}: bn\_s\_mp\_sub.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */
-018 int
-019 s_mp_sub (mp_int * a, mp_int * b, mp_int * c)
-020 \{
-021 int olduse, res, min, max;
-022
-023 /* find sizes */
-024 min = b->used;
-025 max = a->used;
-026
-027 /* init result */
-028 if (c->alloc < max) \{
-029 if ((res = mp_grow (c, max)) != MP_OKAY) \{
-030 return res;
-031 \}
-032 \}
-033 olduse = c->used;
-034 c->used = max;
-035
-036 \{
-037 register mp_digit u, *tmpa, *tmpb, *tmpc;
-038 register int i;
-039
-040 /* alias for digit pointers */
-041 tmpa = a->dp;
-042 tmpb = b->dp;
-043 tmpc = c->dp;
-044
-045 /* set carry to zero */
-046 u = 0;
-047 for (i = 0; i < min; i++) \{
-048 /* T[i] = A[i] - B[i] - U */
-049 *tmpc = *tmpa++ - *tmpb++ - u;
-050
-051 /* U = carry bit of T[i]
-052 * Note this saves performing an AND operation since
-053 * if a carry does occur it will propagate all the way to the
-054 * MSB. As a result a single shift is enough to get the carry
-055 */
-056 u = *tmpc >> ((mp_digit)(CHAR_BIT * sizeof (mp_digit) - 1));
-057
-058 /* Clear carry from T[i] */
-059 *tmpc++ &= MP_MASK;
-060 \}
-061
-062 /* now copy higher words if any, e.g. if A has more digits than B */
-063 for (; i < max; i++) \{
-064 /* T[i] = A[i] - U */
-065 *tmpc = *tmpa++ - u;
-066
-067 /* U = carry bit of T[i] */
-068 u = *tmpc >> ((mp_digit)(CHAR_BIT * sizeof (mp_digit) - 1));
-069
-070 /* Clear carry from T[i] */
-071 *tmpc++ &= MP_MASK;
-072 \}
-073
-074 /* clear digits above used (since we may not have grown result above) */
-
-075 for (i = c->used; i < olduse; i++) \{
-076 *tmpc++ = 0;
-077 \}
-078 \}
-079
-080 mp_clamp (c);
-081 return MP_OKAY;
-082 \}
-083
-084 #endif
-085
\end{alltt}
\end{small}
Like low level addition we ``sort'' the inputs. Except in this case the sorting is hardcoded
-(lines 24 and 25). In reality the $min$ and $max$ variables are only aliases and are only
+(lines 25 and 26). In reality the $min$ and $max$ variables are only aliases and are only
used to make the source code easier to read. Again the pointer alias optimization is used
within this algorithm. The aliases $tmpa$, $tmpb$ and $tmpc$ are initialized
-(lines 41, 42 and 43) for $a$, $b$ and $c$ respectively.
+(lines 42, 43 and 44) for $a$, $b$ and $c$ respectively.
-The first subtraction loop (lines 46 through 60) subtract digits from both inputs until the smaller of
+The first subtraction loop (lines 47 through 61) subtract digits from both inputs until the smaller of
the two inputs has been exhausted. As remarked earlier there is an implementation reason for using the ``awkward''
-method of extracting the carry (line 56). The traditional method for extracting the carry would be to shift
+method of extracting the carry (line 57). The traditional method for extracting the carry would be to shift
by $lg(\beta)$ positions and logically AND the least significant bit. The AND operation is required because all of
the bits above the $\lg(\beta)$'th bit will be set to one after a carry occurs from subtraction. This carry
extraction requires two relatively cheap operations to extract the carry. The other method is to simply shift the
most significant bit to the least significant bit thus extracting the carry with a single cheap operation. This
optimization only works on twos compliment machines which is a safe assumption to make.
-If $a$ has a larger magnitude than $b$ an additional loop (lines 63 through 72) is required to propagate
+If $a$ has a larger magnitude than $b$ an additional loop (lines 64 through 73) is required to propagate
the carry through $a$ and copy the result to $c$.
\subsection{High Level Addition}
@@ -2495,40 +1927,6 @@ within algorithm s\_mp\_add will force $-0$ to become $0$.
\hspace{-5.1mm}{\bf File}: bn\_mp\_add.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* high level addition (handles signs) */
-018 int mp_add (mp_int * a, mp_int * b, mp_int * c)
-019 \{
-020 int sa, sb, res;
-021
-022 /* get sign of both inputs */
-023 sa = a->sign;
-024 sb = b->sign;
-025
-026 /* handle two cases, not four */
-027 if (sa == sb) \{
-028 /* both positive or both negative */
-029 /* add their magnitudes, copy the sign */
-030 c->sign = sa;
-031 res = s_mp_add (a, b, c);
-032 \} else \{
-033 /* one positive, the other negative */
-034 /* subtract the one with the greater magnitude from */
-035 /* the one of the lesser magnitude. The result gets */
-036 /* the sign of the one with the greater magnitude. */
-037 if (mp_cmp_mag (a, b) == MP_LT) \{
-038 c->sign = sb;
-039 res = s_mp_sub (b, a, c);
-040 \} else \{
-041 c->sign = sa;
-042 res = s_mp_sub (a, b, c);
-043 \}
-044 \}
-045 return res;
-046 \}
-047
-048 #endif
-049
\end{alltt}
\end{small}
@@ -2602,51 +2000,11 @@ algorithm from producing $-a - -a = -0$ as a result.
\hspace{-5.1mm}{\bf File}: bn\_mp\_sub.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* high level subtraction (handles signs) */
-018 int
-019 mp_sub (mp_int * a, mp_int * b, mp_int * c)
-020 \{
-021 int sa, sb, res;
-022
-023 sa = a->sign;
-024 sb = b->sign;
-025
-026 if (sa != sb) \{
-027 /* subtract a negative from a positive, OR */
-028 /* subtract a positive from a negative. */
-029 /* In either case, ADD their magnitudes, */
-030 /* and use the sign of the first number. */
-031 c->sign = sa;
-032 res = s_mp_add (a, b, c);
-033 \} else \{
-034 /* subtract a positive from a positive, OR */
-035 /* subtract a negative from a negative. */
-036 /* First, take the difference between their */
-037 /* magnitudes, then... */
-038 if (mp_cmp_mag (a, b) != MP_LT) \{
-039 /* Copy the sign from the first */
-040 c->sign = sa;
-041 /* The first has a larger or equal magnitude */
-042 res = s_mp_sub (a, b, c);
-043 \} else \{
-044 /* The result has the *opposite* sign from */
-045 /* the first number. */
-046 c->sign = (sa == MP_ZPOS) ? MP_NEG : MP_ZPOS;
-047 /* The second has a larger magnitude */
-048 res = s_mp_sub (b, a, c);
-049 \}
-050 \}
-051 return res;
-052 \}
-053
-054 #endif
-055
\end{alltt}
\end{small}
Much like the implementation of algorithm mp\_add the variable $res$ is used to catch the return code of the unsigned addition or subtraction operations
-and forward it to the end of the function. On line 38 the ``not equal to'' \textbf{MP\_LT} expression is used to emulate a
+and forward it to the end of the function. On line 39 the ``not equal to'' \textbf{MP\_LT} expression is used to emulate a
``greater than or equal to'' comparison.
\section{Bit and Digit Shifting}
@@ -2714,74 +2072,11 @@ Step 8 clears any leading digits of $b$ in case it originally had a larger magni
\hspace{-5.1mm}{\bf File}: bn\_mp\_mul\_2.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* b = a*2 */
-018 int mp_mul_2(mp_int * a, mp_int * b)
-019 \{
-020 int x, res, oldused;
-021
-022 /* grow to accomodate result */
-023 if (b->alloc < a->used + 1) \{
-024 if ((res = mp_grow (b, a->used + 1)) != MP_OKAY) \{
-025 return res;
-026 \}
-027 \}
-028
-029 oldused = b->used;
-030 b->used = a->used;
-031
-032 \{
-033 register mp_digit r, rr, *tmpa, *tmpb;
-034
-035 /* alias for source */
-036 tmpa = a->dp;
-037
-038 /* alias for dest */
-039 tmpb = b->dp;
-040
-041 /* carry */
-042 r = 0;
-043 for (x = 0; x < a->used; x++) \{
-044
-045 /* get what will be the *next* carry bit from the
-046 * MSB of the current digit
-047 */
-048 rr = *tmpa >> ((mp_digit)(DIGIT_BIT - 1));
-049
-050 /* now shift up this digit, add in the carry [from the previous] */
-051 *tmpb++ = ((*tmpa++ << ((mp_digit)1)) | r) & MP_MASK;
-052
-053 /* copy the carry that would be from the source
-054 * digit into the next iteration
-055 */
-056 r = rr;
-057 \}
-058
-059 /* new leading digit? */
-060 if (r != 0) \{
-061 /* add a MSB which is always 1 at this point */
-062 *tmpb = 1;
-063 ++(b->used);
-064 \}
-065
-066 /* now zero any excess digits on the destination
-067 * that we didn't write to
-068 */
-069 tmpb = b->dp + b->used;
-070 for (x = b->used; x < oldused; x++) \{
-071 *tmpb++ = 0;
-072 \}
-073 \}
-074 b->sign = a->sign;
-075 return MP_OKAY;
-076 \}
-077 #endif
-078
\end{alltt}
\end{small}
This implementation is essentially an optimized implementation of s\_mp\_add for the case of doubling an input. The only noteworthy difference
-is the use of the logical shift operator on line 51 to perform a single precision doubling.
+is the use of the logical shift operator on line 52 to perform a single precision doubling.
\subsection{Division by Two}
A division by two can just as easily be accomplished with a logical shift right as multiplication by two can be with a logical shift left.
@@ -2829,55 +2124,6 @@ least significant bit not the most significant bit.
\hspace{-5.1mm}{\bf File}: bn\_mp\_div\_2.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* b = a/2 */
-018 int mp_div_2(mp_int * a, mp_int * b)
-019 \{
-020 int x, res, oldused;
-021
-022 /* copy */
-023 if (b->alloc < a->used) \{
-024 if ((res = mp_grow (b, a->used)) != MP_OKAY) \{
-025 return res;
-026 \}
-027 \}
-028
-029 oldused = b->used;
-030 b->used = a->used;
-031 \{
-032 register mp_digit r, rr, *tmpa, *tmpb;
-033
-034 /* source alias */
-035 tmpa = a->dp + b->used - 1;
-036
-037 /* dest alias */
-038 tmpb = b->dp + b->used - 1;
-039
-040 /* carry */
-041 r = 0;
-042 for (x = b->used - 1; x >= 0; x--) \{
-043 /* get the carry for the next iteration */
-044 rr = *tmpa & 1;
-045
-046 /* shift the current digit, add in carry and store */
-047 *tmpb-- = (*tmpa-- >> 1) | (r << (DIGIT_BIT - 1));
-048
-049 /* forward carry to next iteration */
-050 r = rr;
-051 \}
-052
-053 /* zero excess digits */
-054 tmpb = b->dp + b->used;
-055 for (x = b->used; x < oldused; x++) \{
-056 *tmpb++ = 0;
-057 \}
-058 \}
-059 b->sign = a->sign;
-060 mp_clamp (b);
-061 return MP_OKAY;
-062 \}
-063 #endif
-064
\end{alltt}
\end{small}
@@ -2951,61 +2197,13 @@ step 8 sets the lower $b$ digits to zero.
\hspace{-5.1mm}{\bf File}: bn\_mp\_lshd.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* shift left a certain amount of digits */
-018 int mp_lshd (mp_int * a, int b)
-019 \{
-020 int x, res;
-021
-022 /* if its less than zero return */
-023 if (b <= 0) \{
-024 return MP_OKAY;
-025 \}
-026
-027 /* grow to fit the new digits */
-028 if (a->alloc < a->used + b) \{
-029 if ((res = mp_grow (a, a->used + b)) != MP_OKAY) \{
-030 return res;
-031 \}
-032 \}
-033
-034 \{
-035 register mp_digit *top, *bottom;
-036
-037 /* increment the used by the shift amount then copy upwards */
-038 a->used += b;
-039
-040 /* top */
-041 top = a->dp + a->used - 1;
-042
-043 /* base */
-044 bottom = a->dp + a->used - 1 - b;
-045
-046 /* much like mp_rshd this is implemented using a sliding window
-047 * except the window goes the otherway around. Copying from
-048 * the bottom to the top. see bn_mp_rshd.c for more info.
-049 */
-050 for (x = a->used - 1; x >= b; x--) \{
-051 *top-- = *bottom--;
-052 \}
-053
-054 /* zero the lower digits */
-055 top = a->dp;
-056 for (x = 0; x < b; x++) \{
-057 *top++ = 0;
-058 \}
-059 \}
-060 return MP_OKAY;
-061 \}
-062 #endif
-063
\end{alltt}
\end{small}
-The if statement (line 23) ensures that the $b$ variable is greater than zero since we do not interpret negative
+The if statement (line 24) ensures that the $b$ variable is greater than zero since we do not interpret negative
shift counts properly. The \textbf{used} count is incremented by $b$ before the copy loop begins. This elminates
-the need for an additional variable in the for loop. The variable $top$ (line 41) is an alias
-for the leading digit while $bottom$ (line 44) is an alias for the trailing edge. The aliases form a
+the need for an additional variable in the for loop. The variable $top$ (line 42) is an alias
+for the leading digit while $bottom$ (line 45) is an alias for the trailing edge. The aliases form a
window of exactly $b$ digits over the input.
\subsection{Division by $x$}
@@ -3058,64 +2256,11 @@ Once the window copy is complete the upper digits must be zeroed and the \textbf
\hspace{-5.1mm}{\bf File}: bn\_mp\_rshd.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* shift right a certain amount of digits */
-018 void mp_rshd (mp_int * a, int b)
-019 \{
-020 int x;
-021
-022 /* if b <= 0 then ignore it */
-023 if (b <= 0) \{
-024 return;
-025 \}
-026
-027 /* if b > used then simply zero it and return */
-028 if (a->used <= b) \{
-029 mp_zero (a);
-030 return;
-031 \}
-032
-033 \{
-034 register mp_digit *bottom, *top;
-035
-036 /* shift the digits down */
-037
-038 /* bottom */
-039 bottom = a->dp;
-040
-041 /* top [offset into digits] */
-042 top = a->dp + b;
-043
-044 /* this is implemented as a sliding window where
-045 * the window is b-digits long and digits from
-046 * the top of the window are copied to the bottom
-047 *
-048 * e.g.
-049
-050 b-2 | b-1 | b0 | b1 | b2 | ... | bb | ---->
-051 /\symbol{92} | ---->
-052 \symbol{92}-------------------/ ---->
-053 */
-054 for (x = 0; x < (a->used - b); x++) \{
-055 *bottom++ = *top++;
-056 \}
-057
-058 /* zero the top digits */
-059 for (; x < a->used; x++) \{
-060 *bottom++ = 0;
-061 \}
-062 \}
-063
-064 /* remove excess digits */
-065 a->used -= b;
-066 \}
-067 #endif
-068
\end{alltt}
\end{small}
The only noteworthy element of this routine is the lack of a return type since it cannot fail. Like mp\_lshd() we
-form a sliding window except we copy in the other direction. After the window (line 59) we then zero
+form a sliding window except we copy in the other direction. After the window (line 60) we then zero
the upper digits of the input to make sure the result is correct.
\section{Powers of Two}
@@ -3169,7 +2314,7 @@ left.
After the digits have been shifted appropriately at most $lg(\beta) - 1$ shifts are left to perform. Step 5 calculates the number of remaining shifts
required. If it is non-zero a modified shift loop is used to calculate the remaining product.
-Essentially the loop is a generic version of algorith mp\_mul2 designed to handle any shift count in the range $1 \le x < lg(\beta)$. The $mask$
+Essentially the loop is a generic version of algorithm mp\_mul\_2 designed to handle any shift count in the range $1 \le x < lg(\beta)$. The $mask$
variable is used to extract the upper $d$ bits to form the carry for the next iteration.
This algorithm is loosely measured as a $O(2n)$ algorithm which means that if the input is $n$-digits that it takes $2n$ ``time'' to
@@ -3179,82 +2324,16 @@ complete. It is possible to optimize this algorithm down to a $O(n)$ algorithm
\hspace{-5.1mm}{\bf File}: bn\_mp\_mul\_2d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* shift left by a certain bit count */
-018 int mp_mul_2d (mp_int * a, int b, mp_int * c)
-019 \{
-020 mp_digit d;
-021 int res;
-022
-023 /* copy */
-024 if (a != c) \{
-025 if ((res = mp_copy (a, c)) != MP_OKAY) \{
-026 return res;
-027 \}
-028 \}
-029
-030 if (c->alloc < (int)(c->used + b/DIGIT_BIT + 1)) \{
-031 if ((res = mp_grow (c, c->used + b / DIGIT_BIT + 1)) != MP_OKAY) \{
-032 return res;
-033 \}
-034 \}
-035
-036 /* shift by as many digits in the bit count */
-037 if (b >= (int)DIGIT_BIT) \{
-038 if ((res = mp_lshd (c, b / DIGIT_BIT)) != MP_OKAY) \{
-039 return res;
-040 \}
-041 \}
-042
-043 /* shift any bit count < DIGIT_BIT */
-044 d = (mp_digit) (b % DIGIT_BIT);
-045 if (d != 0) \{
-046 register mp_digit *tmpc, shift, mask, r, rr;
-047 register int x;
-048
-049 /* bitmask for carries */
-050 mask = (((mp_digit)1) << d) - 1;
-051
-052 /* shift for msbs */
-053 shift = DIGIT_BIT - d;
-054
-055 /* alias */
-056 tmpc = c->dp;
-057
-058 /* carry */
-059 r = 0;
-060 for (x = 0; x < c->used; x++) \{
-061 /* get the higher bits of the current word */
-062 rr = (*tmpc >> shift) & mask;
-063
-064 /* shift the current word and OR in the carry */
-065 *tmpc = ((*tmpc << d) | r) & MP_MASK;
-066 ++tmpc;
-067
-068 /* set the carry to the carry bits of the current word */
-069 r = rr;
-070 \}
-071
-072 /* set final carry */
-073 if (r != 0) \{
-074 c->dp[(c->used)++] = r;
-075 \}
-076 \}
-077 mp_clamp (c);
-078 return MP_OKAY;
-079 \}
-080 #endif
-081
\end{alltt}
\end{small}
-The shifting is performed in--place which means the first step (line 24) is to copy the input to the
+The shifting is performed in--place which means the first step (line 25) is to copy the input to the
destination. We avoid calling mp\_copy() by making sure the mp\_ints are different. The destination then
-has to be grown (line 31) to accomodate the result.
+has to be grown (line 32) to accomodate the result.
If the shift count $b$ is larger than $lg(\beta)$ then a call to mp\_lshd() is used to handle all of the multiples
of $lg(\beta)$. Leaving only a remaining shift of $lg(\beta) - 1$ or fewer bits left. Inside the actual shift
-loop (lines 45 to 76) we make use of pre--computed values $shift$ and $mask$. These are used to
+loop (lines 46 to 76) we make use of pre--computed values $shift$ and $mask$. These are used to
extract the carry bit(s) to pass into the next iteration of the loop. The $r$ and $rr$ variables form a
chain between consecutive iterations to propagate the carry.
@@ -3302,86 +2381,6 @@ by using algorithm mp\_mod\_2d.
\hspace{-5.1mm}{\bf File}: bn\_mp\_div\_2d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* shift right by a certain bit count (store quotient in c, optional remaind
- er in d) */
-018 int mp_div_2d (mp_int * a, int b, mp_int * c, mp_int * d)
-019 \{
-020 mp_digit D, r, rr;
-021 int x, res;
-022 mp_int t;
-023
-024
-025 /* if the shift count is <= 0 then we do no work */
-026 if (b <= 0) \{
-027 res = mp_copy (a, c);
-028 if (d != NULL) \{
-029 mp_zero (d);
-030 \}
-031 return res;
-032 \}
-033
-034 if ((res = mp_init (&t)) != MP_OKAY) \{
-035 return res;
-036 \}
-037
-038 /* get the remainder */
-039 if (d != NULL) \{
-040 if ((res = mp_mod_2d (a, b, &t)) != MP_OKAY) \{
-041 mp_clear (&t);
-042 return res;
-043 \}
-044 \}
-045
-046 /* copy */
-047 if ((res = mp_copy (a, c)) != MP_OKAY) \{
-048 mp_clear (&t);
-049 return res;
-050 \}
-051
-052 /* shift by as many digits in the bit count */
-053 if (b >= (int)DIGIT_BIT) \{
-054 mp_rshd (c, b / DIGIT_BIT);
-055 \}
-056
-057 /* shift any bit count < DIGIT_BIT */
-058 D = (mp_digit) (b % DIGIT_BIT);
-059 if (D != 0) \{
-060 register mp_digit *tmpc, mask, shift;
-061
-062 /* mask */
-063 mask = (((mp_digit)1) << D) - 1;
-064
-065 /* shift for lsb */
-066 shift = DIGIT_BIT - D;
-067
-068 /* alias */
-069 tmpc = c->dp + (c->used - 1);
-070
-071 /* carry */
-072 r = 0;
-073 for (x = c->used - 1; x >= 0; x--) \{
-074 /* get the lower bits of this word in a temp */
-075 rr = *tmpc & mask;
-076
-077 /* shift the current word and mix in the carry bits from the previous
- word */
-078 *tmpc = (*tmpc >> D) | (r << shift);
-079 --tmpc;
-080
-081 /* set the carry to the carry bits of the current word found above */
-082 r = rr;
-083 \}
-084 \}
-085 mp_clamp (c);
-086 if (d != NULL) \{
-087 mp_exch (&t, d);
-088 \}
-089 mp_clear (&t);
-090 return MP_OKAY;
-091 \}
-092 #endif
-093
\end{alltt}
\end{small}
@@ -3436,44 +2435,6 @@ is copied to $b$, leading digits are removed and the remaining leading digit is
\hspace{-5.1mm}{\bf File}: bn\_mp\_mod\_2d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* calc a value mod 2**b */
-018 int
-019 mp_mod_2d (mp_int * a, int b, mp_int * c)
-020 \{
-021 int x, res;
-022
-023 /* if b is <= 0 then zero the int */
-024 if (b <= 0) \{
-025 mp_zero (c);
-026 return MP_OKAY;
-027 \}
-028
-029 /* if the modulus is larger than the value than return */
-030 if (b >= (int) (a->used * DIGIT_BIT)) \{
-031 res = mp_copy (a, c);
-032 return res;
-033 \}
-034
-035 /* copy */
-036 if ((res = mp_copy (a, c)) != MP_OKAY) \{
-037 return res;
-038 \}
-039
-040 /* zero digits above the last digit of the modulus */
-041 for (x = (b / DIGIT_BIT) + ((b % DIGIT_BIT) == 0 ? 0 : 1); x < c->used; x+
- +) \{
-042 c->dp[x] = 0;
-043 \}
-044 /* clear the digit that is not completely outside/inside the modulus */
-045 c->dp[b / DIGIT_BIT] &=
-046 (mp_digit) ((((mp_digit) 1) << (((mp_digit) b) % DIGIT_BIT)) - ((mp_digi
- t) 1));
-047 mp_clamp (c);
-048 return MP_OKAY;
-049 \}
-050 #endif
-051
\end{alltt}
\end{small}
@@ -3482,8 +2443,8 @@ than the input we just mp\_copy() the input and return right away. After this p
perform some work to produce the remainder.
Recalling that reducing modulo $2^k$ and a binary ``and'' with $2^k - 1$ are numerically equivalent we can quickly reduce
-the number. First we zero any digits above the last digit in $2^b$ (line 41). Next we reduce the
-leading digit of both (line 45) and then mp\_clamp().
+the number. First we zero any digits above the last digit in $2^b$ (line 42). Next we reduce the
+leading digit of both (line 46) and then mp\_clamp().
\section*{Exercises}
\begin{tabular}{cl}
@@ -3643,91 +2604,20 @@ exceed the precision requested.
\hspace{-5.1mm}{\bf File}: bn\_s\_mp\_mul\_digs.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* multiplies |a| * |b| and only computes upto digs digits of result
-018 * HAC pp. 595, Algorithm 14.12 Modified so you can control how
-019 * many digits of output are created.
-020 */
-021 int s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
-022 \{
-023 mp_int t;
-024 int res, pa, pb, ix, iy;
-025 mp_digit u;
-026 mp_word r;
-027 mp_digit tmpx, *tmpt, *tmpy;
-028
-029 /* can we use the fast multiplier? */
-030 if (((digs) < MP_WARRAY) &&
-031 MIN (a->used, b->used) <
-032 (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) \{
-033 return fast_s_mp_mul_digs (a, b, c, digs);
-034 \}
-035
-036 if ((res = mp_init_size (&t, digs)) != MP_OKAY) \{
-037 return res;
-038 \}
-039 t.used = digs;
-040
-041 /* compute the digits of the product directly */
-042 pa = a->used;
-043 for (ix = 0; ix < pa; ix++) \{
-044 /* set the carry to zero */
-045 u = 0;
-046
-047 /* limit ourselves to making digs digits of output */
-048 pb = MIN (b->used, digs - ix);
-049
-050 /* setup some aliases */
-051 /* copy of the digit from a used within the nested loop */
-052 tmpx = a->dp[ix];
-053
-054 /* an alias for the destination shifted ix places */
-055 tmpt = t.dp + ix;
-056
-057 /* an alias for the digits of b */
-058 tmpy = b->dp;
-059
-060 /* compute the columns of the output and propagate the carry */
-061 for (iy = 0; iy < pb; iy++) \{
-062 /* compute the column as a mp_word */
-063 r = ((mp_word)*tmpt) +
-064 ((mp_word)tmpx) * ((mp_word)*tmpy++) +
-065 ((mp_word) u);
-066
-067 /* the new column is the lower part of the result */
-068 *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));
-069
-070 /* get the carry word from the result */
-071 u = (mp_digit) (r >> ((mp_word) DIGIT_BIT));
-072 \}
-073 /* set carry if it is placed below digs */
-074 if (ix + iy < digs) \{
-075 *tmpt = u;
-076 \}
-077 \}
-078
-079 mp_clamp (&t);
-080 mp_exch (&t, c);
-081
-082 mp_clear (&t);
-083 return MP_OKAY;
-084 \}
-085 #endif
-086
\end{alltt}
\end{small}
-First we determine (line 30) if the Comba method can be used first since it's faster. The conditions for
+First we determine (line 31) if the Comba method can be used first since it's faster. The conditions for
sing the Comba routine are that min$(a.used, b.used) < \delta$ and the number of digits of output is less than
\textbf{MP\_WARRAY}. This new constant is used to control the stack usage in the Comba routines. By default it is
set to $\delta$ but can be reduced when memory is at a premium.
If we cannot use the Comba method we proceed to setup the baseline routine. We allocate the the destination mp\_int
-$t$ (line 36) to the exact size of the output to avoid further re--allocations. At this point we now
+$t$ (line 37) to the exact size of the output to avoid further re--allocations. At this point we now
begin the $O(n^2)$ loop.
This implementation of multiplication has the caveat that it can be trimmed to only produce a variable number of
-digits as output. In each iteration of the outer loop the $pb$ variable is set (line 48) to the maximum
+digits as output. In each iteration of the outer loop the $pb$ variable is set (line 49) to the maximum
number of inner loop iterations.
Inside the inner loop we calculate $\hat r$ as the mp\_word product of the two mp\_digits and the addition of the
@@ -3735,7 +2625,7 @@ carry from the previous iteration. A particularly important observation is that
C compilers (GCC for instance) can recognize that a $N \times N \rightarrow 2N$ multiplication is all that
is required for the product. In x86 terms for example, this means using the MUL instruction.
-Each digit of the product is stored in turn (line 68) and the carry propagated (line 71) to the
+Each digit of the product is stored in turn (line 69) and the carry propagated (line 72) to the
next iteration.
\subsection{Faster Multiplication by the ``Comba'' Method}
@@ -3864,17 +2754,16 @@ Place an array of \textbf{MP\_WARRAY} single precision digits named $W$ on the s
\hspace{6mm}5.4.1 $\_ \hat W \leftarrow \_ \hat W + a_{tx+iy}b_{ty-iy}$ \\
\hspace{3mm}5.5 $W_{ix} \leftarrow \_ \hat W (\mbox{mod }\beta)$\\
\hspace{3mm}5.6 $\_ \hat W \leftarrow \lfloor \_ \hat W / \beta \rfloor$ \\
-6. $W_{pa} \leftarrow \_ \hat W (\mbox{mod }\beta)$ \\
\\
-7. $oldused \leftarrow c.used$ \\
-8. $c.used \leftarrow digs$ \\
-9. for $ix$ from $0$ to $pa$ do \\
-\hspace{3mm}9.1 $c_{ix} \leftarrow W_{ix}$ \\
-10. for $ix$ from $pa + 1$ to $oldused - 1$ do \\
-\hspace{3mm}10.1 $c_{ix} \leftarrow 0$ \\
+6. $oldused \leftarrow c.used$ \\
+7. $c.used \leftarrow digs$ \\
+8. for $ix$ from $0$ to $pa$ do \\
+\hspace{3mm}8.1 $c_{ix} \leftarrow W_{ix}$ \\
+9. for $ix$ from $pa + 1$ to $oldused - 1$ do \\
+\hspace{3mm}9.1 $c_{ix} \leftarrow 0$ \\
\\
-11. Clamp $c$. \\
-12. Return MP\_OKAY. \\
+10. Clamp $c$. \\
+11. Return MP\_OKAY. \\
\hline
\end{tabular}
\end{center}
@@ -3913,105 +2802,14 @@ and addition operations in the nested loop in parallel.
\hspace{-5.1mm}{\bf File}: bn\_fast\_s\_mp\_mul\_digs.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* Fast (comba) multiplier
-018 *
-019 * This is the fast column-array [comba] multiplier. It is
-020 * designed to compute the columns of the product first
-021 * then handle the carries afterwards. This has the effect
-022 * of making the nested loops that compute the columns very
-023 * simple and schedulable on super-scalar processors.
-024 *
-025 * This has been modified to produce a variable number of
-026 * digits of output so if say only a half-product is required
-027 * you don't have to compute the upper half (a feature
-028 * required for fast Barrett reduction).
-029 *
-030 * Based on Algorithm 14.12 on pp.595 of HAC.
-031 *
-032 */
-033 int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
-034 \{
-035 int olduse, res, pa, ix, iz;
-036 mp_digit W[MP_WARRAY];
-037 register mp_word _W;
-038
-039 /* grow the destination as required */
-040 if (c->alloc < digs) \{
-041 if ((res = mp_grow (c, digs)) != MP_OKAY) \{
-042 return res;
-043 \}
-044 \}
-045
-046 /* number of output digits to produce */
-047 pa = MIN(digs, a->used + b->used);
-048
-049 /* clear the carry */
-050 _W = 0;
-051 for (ix = 0; ix < pa; ix++) \{
-052 int tx, ty;
-053 int iy;
-054 mp_digit *tmpx, *tmpy;
-055
-056 /* get offsets into the two bignums */
-057 ty = MIN(b->used-1, ix);
-058 tx = ix - ty;
-059
-060 /* setup temp aliases */
-061 tmpx = a->dp + tx;
-062 tmpy = b->dp + ty;
-063
-064 /* this is the number of times the loop will iterrate, essentially
-065 while (tx++ < a->used && ty-- >= 0) \{ ... \}
-066 */
-067 iy = MIN(a->used-tx, ty+1);
-068
-069 /* execute loop */
-070 for (iz = 0; iz < iy; ++iz) \{
-071 _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
-072
-073 \}
-074
-075 /* store term */
-076 W[ix] = ((mp_digit)_W) & MP_MASK;
-077
-078 /* make next carry */
-079 _W = _W >> ((mp_word)DIGIT_BIT);
-080 \}
-081
-082 /* store final carry */
-083 W[ix] = (mp_digit)(_W & MP_MASK);
-084
-085 /* setup dest */
-086 olduse = c->used;
-087 c->used = pa;
-088
-089 \{
-090 register mp_digit *tmpc;
-091 tmpc = c->dp;
-092 for (ix = 0; ix < pa+1; ix++) \{
-093 /* now extract the previous digit [below the carry] */
-094 *tmpc++ = W[ix];
-095 \}
-096
-097 /* clear unused digits [that existed in the old copy of c] */
-098 for (; ix < olduse; ix++) \{
-099 *tmpc++ = 0;
-100 \}
-101 \}
-102 mp_clamp (c);
-103 return MP_OKAY;
-104 \}
-105 #endif
-106
\end{alltt}
\end{small}
-As per the pseudo--code we first calculate $pa$ (line 47) as the number of digits to output. Next we begin the outer loop
-to produce the individual columns of the product. We use the two aliases $tmpx$ and $tmpy$ (lines 61, 62) to point
+As per the pseudo--code we first calculate $pa$ (line 48) as the number of digits to output. Next we begin the outer loop
+to produce the individual columns of the product. We use the two aliases $tmpx$ and $tmpy$ (lines 62, 63) to point
inside the two multiplicands quickly.
-The inner loop (lines 70 to 73) of this implementation is where the tradeoff come into play. Originally this comba
+The inner loop (lines 71 to 74) of this implementation is where the tradeoff come into play. Originally this comba
implementation was ``row--major'' which means it adds to each of the columns in each pass. After the outer loop it would then fix
the carries. This was very fast except it had an annoying drawback. You had to read a mp\_word and two mp\_digits and write
one mp\_word per iteration. On processors such as the Athlon XP and P4 this did not matter much since the cache bandwidth
@@ -4019,8 +2817,8 @@ is very high and it can keep the ALU fed with data. It did, however, matter on
slower and also often doesn't exist. This new algorithm only performs two reads per iteration under the assumption that the
compiler has aliased $\_ \hat W$ to a CPU register.
-After the inner loop we store the current accumulator in $W$ and shift $\_ \hat W$ (lines 76, 79) to forward it as
-a carry for the next pass. After the outer loop we use the final carry (line 83) as the last digit of the product.
+After the inner loop we store the current accumulator in $W$ and shift $\_ \hat W$ (lines 77, 80) to forward it as
+a carry for the next pass. After the outer loop we use the final carry (line 77) as the last digit of the product.
\subsection{Polynomial Basis Multiplication}
To break the $O(n^2)$ barrier in multiplication requires a completely different look at integer multiplication. In the following algorithms
@@ -4207,160 +3005,12 @@ The remaining steps 13 through 18 compute the Karatsuba polynomial through a var
\hspace{-5.1mm}{\bf File}: bn\_mp\_karatsuba\_mul.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* c = |a| * |b| using Karatsuba Multiplication using
-018 * three half size multiplications
-019 *
-020 * Let B represent the radix [e.g. 2**DIGIT_BIT] and
-021 * let n represent half of the number of digits in
-022 * the min(a,b)
-023 *
-024 * a = a1 * B**n + a0
-025 * b = b1 * B**n + b0
-026 *
-027 * Then, a * b =>
-028 a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0
-029 *
-030 * Note that a1b1 and a0b0 are used twice and only need to be
-031 * computed once. So in total three half size (half # of
-032 * digit) multiplications are performed, a0b0, a1b1 and
-033 * (a1+b1)(a0+b0)
-034 *
-035 * Note that a multiplication of half the digits requires
-036 * 1/4th the number of single precision multiplications so in
-037 * total after one call 25% of the single precision multiplications
-038 * are saved. Note also that the call to mp_mul can end up back
-039 * in this function if the a0, a1, b0, or b1 are above the threshold.
-040 * This is known as divide-and-conquer and leads to the famous
-041 * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than
-042 * the standard O(N**2) that the baseline/comba methods use.
-043 * Generally though the overhead of this method doesn't pay off
-044 * until a certain size (N ~ 80) is reached.
-045 */
-046 int mp_karatsuba_mul (mp_int * a, mp_int * b, mp_int * c)
-047 \{
-048 mp_int x0, x1, y0, y1, t1, x0y0, x1y1;
-049 int B, err;
-050
-051 /* default the return code to an error */
-052 err = MP_MEM;
-053
-054 /* min # of digits */
-055 B = MIN (a->used, b->used);
-056
-057 /* now divide in two */
-058 B = B >> 1;
-059
-060 /* init copy all the temps */
-061 if (mp_init_size (&x0, B) != MP_OKAY)
-062 goto ERR;
-063 if (mp_init_size (&x1, a->used - B) != MP_OKAY)
-064 goto X0;
-065 if (mp_init_size (&y0, B) != MP_OKAY)
-066 goto X1;
-067 if (mp_init_size (&y1, b->used - B) != MP_OKAY)
-068 goto Y0;
-069
-070 /* init temps */
-071 if (mp_init_size (&t1, B * 2) != MP_OKAY)
-072 goto Y1;
-073 if (mp_init_size (&x0y0, B * 2) != MP_OKAY)
-074 goto T1;
-075 if (mp_init_size (&x1y1, B * 2) != MP_OKAY)
-076 goto X0Y0;
-077
-078 /* now shift the digits */
-079 x0.used = y0.used = B;
-080 x1.used = a->used - B;
-081 y1.used = b->used - B;
-082
-083 \{
-084 register int x;
-085 register mp_digit *tmpa, *tmpb, *tmpx, *tmpy;
-086
-087 /* we copy the digits directly instead of using higher level functions
-088 * since we also need to shift the digits
-089 */
-090 tmpa = a->dp;
-091 tmpb = b->dp;
-092
-093 tmpx = x0.dp;
-094 tmpy = y0.dp;
-095 for (x = 0; x < B; x++) \{
-096 *tmpx++ = *tmpa++;
-097 *tmpy++ = *tmpb++;
-098 \}
-099
-100 tmpx = x1.dp;
-101 for (x = B; x < a->used; x++) \{
-102 *tmpx++ = *tmpa++;
-103 \}
-104
-105 tmpy = y1.dp;
-106 for (x = B; x < b->used; x++) \{
-107 *tmpy++ = *tmpb++;
-108 \}
-109 \}
-110
-111 /* only need to clamp the lower words since by definition the
-112 * upper words x1/y1 must have a known number of digits
-113 */
-114 mp_clamp (&x0);
-115 mp_clamp (&y0);
-116
-117 /* now calc the products x0y0 and x1y1 */
-118 /* after this x0 is no longer required, free temp [x0==t2]! */
-119 if (mp_mul (&x0, &y0, &x0y0) != MP_OKAY)
-120 goto X1Y1; /* x0y0 = x0*y0 */
-121 if (mp_mul (&x1, &y1, &x1y1) != MP_OKAY)
-122 goto X1Y1; /* x1y1 = x1*y1 */
-123
-124 /* now calc x1+x0 and y1+y0 */
-125 if (s_mp_add (&x1, &x0, &t1) != MP_OKAY)
-126 goto X1Y1; /* t1 = x1 - x0 */
-127 if (s_mp_add (&y1, &y0, &x0) != MP_OKAY)
-128 goto X1Y1; /* t2 = y1 - y0 */
-129 if (mp_mul (&t1, &x0, &t1) != MP_OKAY)
-130 goto X1Y1; /* t1 = (x1 + x0) * (y1 + y0) */
-131
-132 /* add x0y0 */
-133 if (mp_add (&x0y0, &x1y1, &x0) != MP_OKAY)
-134 goto X1Y1; /* t2 = x0y0 + x1y1 */
-135 if (s_mp_sub (&t1, &x0, &t1) != MP_OKAY)
-136 goto X1Y1; /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */
-137
-138 /* shift by B */
-139 if (mp_lshd (&t1, B) != MP_OKAY)
-140 goto X1Y1; /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<<B */
-141 if (mp_lshd (&x1y1, B * 2) != MP_OKAY)
-142 goto X1Y1; /* x1y1 = x1y1 << 2*B */
-143
-144 if (mp_add (&x0y0, &t1, &t1) != MP_OKAY)
-145 goto X1Y1; /* t1 = x0y0 + t1 */
-146 if (mp_add (&t1, &x1y1, c) != MP_OKAY)
-147 goto X1Y1; /* t1 = x0y0 + t1 + x1y1 */
-148
-149 /* Algorithm succeeded set the return code to MP_OKAY */
-150 err = MP_OKAY;
-151
-152 X1Y1:mp_clear (&x1y1);
-153 X0Y0:mp_clear (&x0y0);
-154 T1:mp_clear (&t1);
-155 Y1:mp_clear (&y1);
-156 Y0:mp_clear (&y0);
-157 X1:mp_clear (&x1);
-158 X0:mp_clear (&x0);
-159 ERR:
-160 return err;
-161 \}
-162 #endif
-163
\end{alltt}
\end{small}
The new coding element in this routine, not seen in previous routines, is the usage of goto statements. The conventional
wisdom is that goto statements should be avoided. This is generally true, however when every single function call can fail, it makes sense
-to handle error recovery with a single piece of code. Lines 61 to 75 handle initializing all of the temporary variables
+to handle error recovery with a single piece of code. Lines 62 to 76 handle initializing all of the temporary variables
required. Note how each of the if statements goes to a different label in case of failure. This allows the routine to correctly free only
the temporaries that have been successfully allocated so far.
@@ -4370,13 +3020,13 @@ number of digits for the next section of code.
The first algebraic portion of the algorithm is to split the two inputs into their halves. However, instead of using mp\_mod\_2d and mp\_rshd
to extract the halves, the respective code has been placed inline within the body of the function. To initialize the halves, the \textbf{used} and
-\textbf{sign} members are copied first. The first for loop on line 101 copies the lower halves. Since they are both the same magnitude it
-is simpler to calculate both lower halves in a single loop. The for loop on lines 106 and 106 calculate the upper halves $x1$ and
+\textbf{sign} members are copied first. The first for loop on line 96 copies the lower halves. Since they are both the same magnitude it
+is simpler to calculate both lower halves in a single loop. The for loop on lines 102 and 107 calculate the upper halves $x1$ and
$y1$ respectively.
By inlining the calculation of the halves, the Karatsuba multiplier has a slightly lower overhead and can be used for smaller magnitude inputs.
-When line 150 is reached, the algorithm has completed succesfully. The ``error status'' variable $err$ is set to \textbf{MP\_OKAY} so that
+When line 151 is reached, the algorithm has completed succesfully. The ``error status'' variable $err$ is set to \textbf{MP\_OKAY} so that
the same code that handles errors can be used to clear the temporary variables and return.
\subsection{Toom-Cook $3$-Way Multiplication}
@@ -4494,271 +3144,6 @@ result $a \cdot b$ is produced.
\hspace{-5.1mm}{\bf File}: bn\_mp\_toom\_mul.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* multiplication using the Toom-Cook 3-way algorithm
-018 *
-019 * Much more complicated than Karatsuba but has a lower
-020 * asymptotic running time of O(N**1.464). This algorithm is
-021 * only particularly useful on VERY large inputs
-022 * (we're talking 1000s of digits here...).
-023 */
-024 int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
-025 \{
-026 mp_int w0, w1, w2, w3, w4, tmp1, tmp2, a0, a1, a2, b0, b1, b2;
-027 int res, B;
-028
-029 /* init temps */
-030 if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4,
-031 &a0, &a1, &a2, &b0, &b1,
-032 &b2, &tmp1, &tmp2, NULL)) != MP_OKAY) \{
-033 return res;
-034 \}
-035
-036 /* B */
-037 B = MIN(a->used, b->used) / 3;
-038
-039 /* a = a2 * B**2 + a1 * B + a0 */
-040 if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) \{
-041 goto ERR;
-042 \}
-043
-044 if ((res = mp_copy(a, &a1)) != MP_OKAY) \{
-045 goto ERR;
-046 \}
-047 mp_rshd(&a1, B);
-048 mp_mod_2d(&a1, DIGIT_BIT * B, &a1);
-049
-050 if ((res = mp_copy(a, &a2)) != MP_OKAY) \{
-051 goto ERR;
-052 \}
-053 mp_rshd(&a2, B*2);
-054
-055 /* b = b2 * B**2 + b1 * B + b0 */
-056 if ((res = mp_mod_2d(b, DIGIT_BIT * B, &b0)) != MP_OKAY) \{
-057 goto ERR;
-058 \}
-059
-060 if ((res = mp_copy(b, &b1)) != MP_OKAY) \{
-061 goto ERR;
-062 \}
-063 mp_rshd(&b1, B);
-064 mp_mod_2d(&b1, DIGIT_BIT * B, &b1);
-065
-066 if ((res = mp_copy(b, &b2)) != MP_OKAY) \{
-067 goto ERR;
-068 \}
-069 mp_rshd(&b2, B*2);
-070
-071 /* w0 = a0*b0 */
-072 if ((res = mp_mul(&a0, &b0, &w0)) != MP_OKAY) \{
-073 goto ERR;
-074 \}
-075
-076 /* w4 = a2 * b2 */
-077 if ((res = mp_mul(&a2, &b2, &w4)) != MP_OKAY) \{
-078 goto ERR;
-079 \}
-080
-081 /* w1 = (a2 + 2(a1 + 2a0))(b2 + 2(b1 + 2b0)) */
-082 if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) \{
-083 goto ERR;
-084 \}
-085 if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) \{
-086 goto ERR;
-087 \}
-088 if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) \{
-089 goto ERR;
-090 \}
-091 if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) \{
-092 goto ERR;
-093 \}
-094
-095 if ((res = mp_mul_2(&b0, &tmp2)) != MP_OKAY) \{
-096 goto ERR;
-097 \}
-098 if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) \{
-099 goto ERR;
-100 \}
-101 if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) \{
-102 goto ERR;
-103 \}
-104 if ((res = mp_add(&tmp2, &b2, &tmp2)) != MP_OKAY) \{
-105 goto ERR;
-106 \}
-107
-108 if ((res = mp_mul(&tmp1, &tmp2, &w1)) != MP_OKAY) \{
-109 goto ERR;
-110 \}
-111
-112 /* w3 = (a0 + 2(a1 + 2a2))(b0 + 2(b1 + 2b2)) */
-113 if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) \{
-114 goto ERR;
-115 \}
-116 if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) \{
-117 goto ERR;
-118 \}
-119 if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) \{
-120 goto ERR;
-121 \}
-122 if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) \{
-123 goto ERR;
-124 \}
-125
-126 if ((res = mp_mul_2(&b2, &tmp2)) != MP_OKAY) \{
-127 goto ERR;
-128 \}
-129 if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) \{
-130 goto ERR;
-131 \}
-132 if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) \{
-133 goto ERR;
-134 \}
-135 if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) \{
-136 goto ERR;
-137 \}
-138
-139 if ((res = mp_mul(&tmp1, &tmp2, &w3)) != MP_OKAY) \{
-140 goto ERR;
-141 \}
-142
-143
-144 /* w2 = (a2 + a1 + a0)(b2 + b1 + b0) */
-145 if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) \{
-146 goto ERR;
-147 \}
-148 if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) \{
-149 goto ERR;
-150 \}
-151 if ((res = mp_add(&b2, &b1, &tmp2)) != MP_OKAY) \{
-152 goto ERR;
-153 \}
-154 if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) \{
-155 goto ERR;
-156 \}
-157 if ((res = mp_mul(&tmp1, &tmp2, &w2)) != MP_OKAY) \{
-158 goto ERR;
-159 \}
-160
-161 /* now solve the matrix
-162
-163 0 0 0 0 1
-164 1 2 4 8 16
-165 1 1 1 1 1
-166 16 8 4 2 1
-167 1 0 0 0 0
-168
-169 using 12 subtractions, 4 shifts,
-170 2 small divisions and 1 small multiplication
-171 */
-172
-173 /* r1 - r4 */
-174 if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) \{
-175 goto ERR;
-176 \}
-177 /* r3 - r0 */
-178 if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) \{
-179 goto ERR;
-180 \}
-181 /* r1/2 */
-182 if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) \{
-183 goto ERR;
-184 \}
-185 /* r3/2 */
-186 if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) \{
-187 goto ERR;
-188 \}
-189 /* r2 - r0 - r4 */
-190 if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) \{
-191 goto ERR;
-192 \}
-193 if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) \{
-194 goto ERR;
-195 \}
-196 /* r1 - r2 */
-197 if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) \{
-198 goto ERR;
-199 \}
-200 /* r3 - r2 */
-201 if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) \{
-202 goto ERR;
-203 \}
-204 /* r1 - 8r0 */
-205 if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) \{
-206 goto ERR;
-207 \}
-208 if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) \{
-209 goto ERR;
-210 \}
-211 /* r3 - 8r4 */
-212 if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) \{
-213 goto ERR;
-214 \}
-215 if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) \{
-216 goto ERR;
-217 \}
-218 /* 3r2 - r1 - r3 */
-219 if ((res = mp_mul_d(&w2, 3, &w2)) != MP_OKAY) \{
-220 goto ERR;
-221 \}
-222 if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) \{
-223 goto ERR;
-224 \}
-225 if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) \{
-226 goto ERR;
-227 \}
-228 /* r1 - r2 */
-229 if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) \{
-230 goto ERR;
-231 \}
-232 /* r3 - r2 */
-233 if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) \{
-234 goto ERR;
-235 \}
-236 /* r1/3 */
-237 if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) \{
-238 goto ERR;
-239 \}
-240 /* r3/3 */
-241 if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) \{
-242 goto ERR;
-243 \}
-244
-245 /* at this point shift W[n] by B*n */
-246 if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) \{
-247 goto ERR;
-248 \}
-249 if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) \{
-250 goto ERR;
-251 \}
-252 if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) \{
-253 goto ERR;
-254 \}
-255 if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) \{
-256 goto ERR;
-257 \}
-258
-259 if ((res = mp_add(&w0, &w1, c)) != MP_OKAY) \{
-260 goto ERR;
-261 \}
-262 if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) \{
-263 goto ERR;
-264 \}
-265 if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) \{
-266 goto ERR;
-267 \}
-268 if ((res = mp_add(&tmp1, c, c)) != MP_OKAY) \{
-269 goto ERR;
-270 \}
-271
-272 ERR:
-273 mp_clear_multi(&w0, &w1, &w2, &w3, &w4,
-274 &a0, &a1, &a2, &b0, &b1,
-275 &b2, &tmp1, &tmp2, NULL);
-276 return res;
-277 \}
-278
-279 #endif
-280
\end{alltt}
\end{small}
@@ -4767,12 +3152,12 @@ large numbers. For example, a 10,000 digit multiplication takes approximaly 99,
Toom--Cook than a Comba or baseline approach (this is a savings of more than 99$\%$). For most ``crypto'' sized numbers this
algorithm is not practical as Karatsuba has a much lower cutoff point.
-First we split $a$ and $b$ into three roughly equal portions. This has been accomplished (lines 40 to 69) with
+First we split $a$ and $b$ into three roughly equal portions. This has been accomplished (lines 41 to 70) with
combinations of mp\_rshd() and mp\_mod\_2d() function calls. At this point $a = a2 \cdot \beta^2 + a1 \cdot \beta + a0$ and similiarly
for $b$.
Next we compute the five points $w0, w1, w2, w3$ and $w4$. Recall that $w0$ and $w4$ can be computed directly from the portions so
-we get those out of the way first (lines 72 and 77). Next we compute $w1, w2$ and $w3$ using Horners method.
+we get those out of the way first (lines 73 and 78). Next we compute $w1, w2$ and $w3$ using Horners method.
After this point we solve for the actual values of $w1, w2$ and $w3$ by reducing the $5 \times 5$ system which is relatively
straight forward.
@@ -4821,58 +3206,11 @@ s\_mp\_mul\_digs will clear it.
\hspace{-5.1mm}{\bf File}: bn\_mp\_mul.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* high level multiplication (handles sign) */
-018 int mp_mul (mp_int * a, mp_int * b, mp_int * c)
-019 \{
-020 int res, neg;
-021 neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
-022
-023 /* use Toom-Cook? */
-024 #ifdef BN_MP_TOOM_MUL_C
-025 if (MIN (a->used, b->used) >= TOOM_MUL_CUTOFF) \{
-026 res = mp_toom_mul(a, b, c);
-027 \} else
-028 #endif
-029 #ifdef BN_MP_KARATSUBA_MUL_C
-030 /* use Karatsuba? */
-031 if (MIN (a->used, b->used) >= KARATSUBA_MUL_CUTOFF) \{
-032 res = mp_karatsuba_mul (a, b, c);
-033 \} else
-034 #endif
-035 \{
-036 /* can we use the fast multiplier?
-037 *
-038 * The fast multiplier can be used if the output will
-039 * have less than MP_WARRAY digits and the number of
-040 * digits won't affect carry propagation
-041 */
-042 int digs = a->used + b->used + 1;
-043
-044 #ifdef BN_FAST_S_MP_MUL_DIGS_C
-045 if ((digs < MP_WARRAY) &&
-046 MIN(a->used, b->used) <=
-047 (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) \{
-048 res = fast_s_mp_mul_digs (a, b, c, digs);
-049 \} else
-050 #endif
-051 #ifdef BN_S_MP_MUL_DIGS_C
-052 res = s_mp_mul (a, b, c); /* uses s_mp_mul_digs */
-053 #else
-054 res = MP_VAL;
-055 #endif
-056
-057 \}
-058 c->sign = (c->used > 0) ? neg : MP_ZPOS;
-059 return res;
-060 \}
-061 #endif
-062
\end{alltt}
\end{small}
-The implementation is rather simplistic and is not particularly noteworthy. Line 23 computes the sign of the result using the ``?''
-operator from the C programming language. Line 47 computes $\delta$ using the fact that $1 << k$ is equal to $2^k$.
+The implementation is rather simplistic and is not particularly noteworthy. Line 22 computes the sign of the result using the ``?''
+operator from the C programming language. Line 48 computes $\delta$ using the fact that $1 << k$ is equal to $2^k$.
\section{Squaring}
\label{sec:basesquare}
@@ -4973,78 +3311,13 @@ results calculated so far. This involves expensive carry propagation which will
\hspace{-5.1mm}{\bf File}: bn\_s\_mp\_sqr.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */
-018 int s_mp_sqr (mp_int * a, mp_int * b)
-019 \{
-020 mp_int t;
-021 int res, ix, iy, pa;
-022 mp_word r;
-023 mp_digit u, tmpx, *tmpt;
-024
-025 pa = a->used;
-026 if ((res = mp_init_size (&t, 2*pa + 1)) != MP_OKAY) \{
-027 return res;
-028 \}
-029
-030 /* default used is maximum possible size */
-031 t.used = 2*pa + 1;
-032
-033 for (ix = 0; ix < pa; ix++) \{
-034 /* first calculate the digit at 2*ix */
-035 /* calculate double precision result */
-036 r = ((mp_word) t.dp[2*ix]) +
-037 ((mp_word)a->dp[ix])*((mp_word)a->dp[ix]);
-038
-039 /* store lower part in result */
-040 t.dp[ix+ix] = (mp_digit) (r & ((mp_word) MP_MASK));
-041
-042 /* get the carry */
-043 u = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
-044
-045 /* left hand side of A[ix] * A[iy] */
-046 tmpx = a->dp[ix];
-047
-048 /* alias for where to store the results */
-049 tmpt = t.dp + (2*ix + 1);
-050
-051 for (iy = ix + 1; iy < pa; iy++) \{
-052 /* first calculate the product */
-053 r = ((mp_word)tmpx) * ((mp_word)a->dp[iy]);
-054
-055 /* now calculate the double precision result, note we use
-056 * addition instead of *2 since it's easier to optimize
-057 */
-058 r = ((mp_word) *tmpt) + r + r + ((mp_word) u);
-059
-060 /* store lower part */
-061 *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));
-062
-063 /* get carry */
-064 u = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
-065 \}
-066 /* propagate upwards */
-067 while (u != ((mp_digit) 0)) \{
-068 r = ((mp_word) *tmpt) + ((mp_word) u);
-069 *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));
-070 u = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
-071 \}
-072 \}
-073
-074 mp_clamp (&t);
-075 mp_exch (&t, b);
-076 mp_clear (&t);
-077 return MP_OKAY;
-078 \}
-079 #endif
-080
\end{alltt}
\end{small}
-Inside the outer loop (line 33) the square term is calculated on line 36. The carry (line 43) has been
+Inside the outer loop (line 34) the square term is calculated on line 37. The carry (line 44) has been
extracted from the mp\_word accumulator using a right shift. Aliases for $a_{ix}$ and $t_{ix+iy}$ are initialized
-(lines 46 and 49) to simplify the inner loop. The doubling is performed using two
-additions (line 58) since it is usually faster than shifting, if not at least as fast.
+(lines 47 and 50) to simplify the inner loop. The doubling is performed using two
+additions (line 59) since it is usually faster than shifting, if not at least as fast.
The important observation is that the inner loop does not begin at $iy = 0$ like for multiplication. As such the inner loops
get progressively shorter as the algorithm proceeds. This is what leads to the savings compared to using a multiplication to
@@ -5126,101 +3399,6 @@ only to even outputs and it is the square of the term at the $\lfloor ix / 2 \rf
\hspace{-5.1mm}{\bf File}: bn\_fast\_s\_mp\_sqr.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* the jist of squaring...
-018 * you do like mult except the offset of the tmpx [one that
-019 * starts closer to zero] can't equal the offset of tmpy.
-020 * So basically you set up iy like before then you min it with
-021 * (ty-tx) so that it never happens. You double all those
-022 * you add in the inner loop
-023
-024 After that loop you do the squares and add them in.
-025 */
-026
-027 int fast_s_mp_sqr (mp_int * a, mp_int * b)
-028 \{
-029 int olduse, res, pa, ix, iz;
-030 mp_digit W[MP_WARRAY], *tmpx;
-031 mp_word W1;
-032
-033 /* grow the destination as required */
-034 pa = a->used + a->used;
-035 if (b->alloc < pa) \{
-036 if ((res = mp_grow (b, pa)) != MP_OKAY) \{
-037 return res;
-038 \}
-039 \}
-040
-041 /* number of output digits to produce */
-042 W1 = 0;
-043 for (ix = 0; ix < pa; ix++) \{
-044 int tx, ty, iy;
-045 mp_word _W;
-046 mp_digit *tmpy;
-047
-048 /* clear counter */
-049 _W = 0;
-050
-051 /* get offsets into the two bignums */
-052 ty = MIN(a->used-1, ix);
-053 tx = ix - ty;
-054
-055 /* setup temp aliases */
-056 tmpx = a->dp + tx;
-057 tmpy = a->dp + ty;
-058
-059 /* this is the number of times the loop will iterrate, essentially
-060 while (tx++ < a->used && ty-- >= 0) \{ ... \}
-061 */
-062 iy = MIN(a->used-tx, ty+1);
-063
-064 /* now for squaring tx can never equal ty
-065 * we halve the distance since they approach at a rate of 2x
-066 * and we have to round because odd cases need to be executed
-067 */
-068 iy = MIN(iy, (ty-tx+1)>>1);
-069
-070 /* execute loop */
-071 for (iz = 0; iz < iy; iz++) \{
-072 _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
-073 \}
-074
-075 /* double the inner product and add carry */
-076 _W = _W + _W + W1;
-077
-078 /* even columns have the square term in them */
-079 if ((ix&1) == 0) \{
-080 _W += ((mp_word)a->dp[ix>>1])*((mp_word)a->dp[ix>>1]);
-081 \}
-082
-083 /* store it */
-084 W[ix] = (mp_digit)(_W & MP_MASK);
-085
-086 /* make next carry */
-087 W1 = _W >> ((mp_word)DIGIT_BIT);
-088 \}
-089
-090 /* setup dest */
-091 olduse = b->used;
-092 b->used = a->used+a->used;
-093
-094 \{
-095 mp_digit *tmpb;
-096 tmpb = b->dp;
-097 for (ix = 0; ix < pa; ix++) \{
-098 *tmpb++ = W[ix] & MP_MASK;
-099 \}
-100
-101 /* clear unused digits [that existed in the old copy of c] */
-102 for (; ix < olduse; ix++) \{
-103 *tmpb++ = 0;
-104 \}
-105 \}
-106 mp_clamp (b);
-107 return MP_OKAY;
-108 \}
-109 #endif
-110
\end{alltt}
\end{small}
@@ -5330,113 +3508,11 @@ ratio of 1:7. } than simpler operations such as addition.
\hspace{-5.1mm}{\bf File}: bn\_mp\_karatsuba\_sqr.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* Karatsuba squaring, computes b = a*a using three
-018 * half size squarings
-019 *
-020 * See comments of karatsuba_mul for details. It
-021 * is essentially the same algorithm but merely
-022 * tuned to perform recursive squarings.
-023 */
-024 int mp_karatsuba_sqr (mp_int * a, mp_int * b)
-025 \{
-026 mp_int x0, x1, t1, t2, x0x0, x1x1;
-027 int B, err;
-028
-029 err = MP_MEM;
-030
-031 /* min # of digits */
-032 B = a->used;
-033
-034 /* now divide in two */
-035 B = B >> 1;
-036
-037 /* init copy all the temps */
-038 if (mp_init_size (&x0, B) != MP_OKAY)
-039 goto ERR;
-040 if (mp_init_size (&x1, a->used - B) != MP_OKAY)
-041 goto X0;
-042
-043 /* init temps */
-044 if (mp_init_size (&t1, a->used * 2) != MP_OKAY)
-045 goto X1;
-046 if (mp_init_size (&t2, a->used * 2) != MP_OKAY)
-047 goto T1;
-048 if (mp_init_size (&x0x0, B * 2) != MP_OKAY)
-049 goto T2;
-050 if (mp_init_size (&x1x1, (a->used - B) * 2) != MP_OKAY)
-051 goto X0X0;
-052
-053 \{
-054 register int x;
-055 register mp_digit *dst, *src;
-056
-057 src = a->dp;
-058
-059 /* now shift the digits */
-060 dst = x0.dp;
-061 for (x = 0; x < B; x++) \{
-062 *dst++ = *src++;
-063 \}
-064
-065 dst = x1.dp;
-066 for (x = B; x < a->used; x++) \{
-067 *dst++ = *src++;
-068 \}
-069 \}
-070
-071 x0.used = B;
-072 x1.used = a->used - B;
-073
-074 mp_clamp (&x0);
-075
-076 /* now calc the products x0*x0 and x1*x1 */
-077 if (mp_sqr (&x0, &x0x0) != MP_OKAY)
-078 goto X1X1; /* x0x0 = x0*x0 */
-079 if (mp_sqr (&x1, &x1x1) != MP_OKAY)
-080 goto X1X1; /* x1x1 = x1*x1 */
-081
-082 /* now calc (x1+x0)**2 */
-083 if (s_mp_add (&x1, &x0, &t1) != MP_OKAY)
-084 goto X1X1; /* t1 = x1 - x0 */
-085 if (mp_sqr (&t1, &t1) != MP_OKAY)
-086 goto X1X1; /* t1 = (x1 - x0) * (x1 - x0) */
-087
-088 /* add x0y0 */
-089 if (s_mp_add (&x0x0, &x1x1, &t2) != MP_OKAY)
-090 goto X1X1; /* t2 = x0x0 + x1x1 */
-091 if (s_mp_sub (&t1, &t2, &t1) != MP_OKAY)
-092 goto X1X1; /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */
-093
-094 /* shift by B */
-095 if (mp_lshd (&t1, B) != MP_OKAY)
-096 goto X1X1; /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<<B */
-097 if (mp_lshd (&x1x1, B * 2) != MP_OKAY)
-098 goto X1X1; /* x1x1 = x1x1 << 2*B */
-099
-100 if (mp_add (&x0x0, &t1, &t1) != MP_OKAY)
-101 goto X1X1; /* t1 = x0x0 + t1 */
-102 if (mp_add (&t1, &x1x1, b) != MP_OKAY)
-103 goto X1X1; /* t1 = x0x0 + t1 + x1x1 */
-104
-105 err = MP_OKAY;
-106
-107 X1X1:mp_clear (&x1x1);
-108 X0X0:mp_clear (&x0x0);
-109 T2:mp_clear (&t2);
-110 T1:mp_clear (&t1);
-111 X1:mp_clear (&x1);
-112 X0:mp_clear (&x0);
-113 ERR:
-114 return err;
-115 \}
-116 #endif
-117
\end{alltt}
\end{small}
This implementation is largely based on the implementation of algorithm mp\_karatsuba\_mul. It uses the same inline style to copy and
-shift the input into the two halves. The loop from line 53 to line 69 has been modified since only one input exists. The \textbf{used}
+shift the input into the two halves. The loop from line 54 to line 70 has been modified since only one input exists. The \textbf{used}
count of both $x0$ and $x1$ is fixed up and $x0$ is clamped before the calculations begin. At this point $x1$ and $x0$ are valid equivalents
to the respective halves as if mp\_rshd and mp\_mod\_2d had been used.
@@ -5490,45 +3566,6 @@ neither of the polynomial basis algorithms should be used then either the Comba
\hspace{-5.1mm}{\bf File}: bn\_mp\_sqr.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes b = a*a */
-018 int
-019 mp_sqr (mp_int * a, mp_int * b)
-020 \{
-021 int res;
-022
-023 #ifdef BN_MP_TOOM_SQR_C
-024 /* use Toom-Cook? */
-025 if (a->used >= TOOM_SQR_CUTOFF) \{
-026 res = mp_toom_sqr(a, b);
-027 /* Karatsuba? */
-028 \} else
-029 #endif
-030 #ifdef BN_MP_KARATSUBA_SQR_C
-031 if (a->used >= KARATSUBA_SQR_CUTOFF) \{
-032 res = mp_karatsuba_sqr (a, b);
-033 \} else
-034 #endif
-035 \{
-036 #ifdef BN_FAST_S_MP_SQR_C
-037 /* can we use the fast comba multiplier? */
-038 if ((a->used * 2 + 1) < MP_WARRAY &&
-039 a->used <
-040 (1 << (sizeof(mp_word) * CHAR_BIT - 2*DIGIT_BIT - 1))) \{
-041 res = fast_s_mp_sqr (a, b);
-042 \} else
-043 #endif
-044 #ifdef BN_S_MP_SQR_C
-045 res = s_mp_sqr (a, b);
-046 #else
-047 res = MP_VAL;
-048 #endif
-049 \}
-050 b->sign = MP_ZPOS;
-051 return res;
-052 \}
-053 #endif
-054
\end{alltt}
\end{small}
@@ -5782,93 +3819,12 @@ performed at most twice, and on average once. However, if $a \ge b^2$ than it wi
\hspace{-5.1mm}{\bf File}: bn\_mp\_reduce.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* reduces x mod m, assumes 0 < x < m**2, mu is
-018 * precomputed via mp_reduce_setup.
-019 * From HAC pp.604 Algorithm 14.42
-020 */
-021 int mp_reduce (mp_int * x, mp_int * m, mp_int * mu)
-022 \{
-023 mp_int q;
-024 int res, um = m->used;
-025
-026 /* q = x */
-027 if ((res = mp_init_copy (&q, x)) != MP_OKAY) \{
-028 return res;
-029 \}
-030
-031 /* q1 = x / b**(k-1) */
-032 mp_rshd (&q, um - 1);
-033
-034 /* according to HAC this optimization is ok */
-035 if (((unsigned long) um) > (((mp_digit)1) << (DIGIT_BIT - 1))) \{
-036 if ((res = mp_mul (&q, mu, &q)) != MP_OKAY) \{
-037 goto CLEANUP;
-038 \}
-039 \} else \{
-040 #ifdef BN_S_MP_MUL_HIGH_DIGS_C
-041 if ((res = s_mp_mul_high_digs (&q, mu, &q, um)) != MP_OKAY) \{
-042 goto CLEANUP;
-043 \}
-044 #elif defined(BN_FAST_S_MP_MUL_HIGH_DIGS_C)
-045 if ((res = fast_s_mp_mul_high_digs (&q, mu, &q, um)) != MP_OKAY) \{
-046 goto CLEANUP;
-047 \}
-048 #else
-049 \{
-050 res = MP_VAL;
-051 goto CLEANUP;
-052 \}
-053 #endif
-054 \}
-055
-056 /* q3 = q2 / b**(k+1) */
-057 mp_rshd (&q, um + 1);
-058
-059 /* x = x mod b**(k+1), quick (no division) */
-060 if ((res = mp_mod_2d (x, DIGIT_BIT * (um + 1), x)) != MP_OKAY) \{
-061 goto CLEANUP;
-062 \}
-063
-064 /* q = q * m mod b**(k+1), quick (no division) */
-065 if ((res = s_mp_mul_digs (&q, m, &q, um + 1)) != MP_OKAY) \{
-066 goto CLEANUP;
-067 \}
-068
-069 /* x = x - q */
-070 if ((res = mp_sub (x, &q, x)) != MP_OKAY) \{
-071 goto CLEANUP;
-072 \}
-073
-074 /* If x < 0, add b**(k+1) to it */
-075 if (mp_cmp_d (x, 0) == MP_LT) \{
-076 mp_set (&q, 1);
-077 if ((res = mp_lshd (&q, um + 1)) != MP_OKAY)
-078 goto CLEANUP;
-079 if ((res = mp_add (x, &q, x)) != MP_OKAY)
-080 goto CLEANUP;
-081 \}
-082
-083 /* Back off if it's too big */
-084 while (mp_cmp (x, m) != MP_LT) \{
-085 if ((res = s_mp_sub (x, m, x)) != MP_OKAY) \{
-086 goto CLEANUP;
-087 \}
-088 \}
-089
-090 CLEANUP:
-091 mp_clear (&q);
-092
-093 return res;
-094 \}
-095 #endif
-096
\end{alltt}
\end{small}
The first multiplication that determines the quotient can be performed by only producing the digits from $m - 1$ and up. This essentially halves
the number of single precision multiplications required. However, the optimization is only safe if $\beta$ is much larger than the number of digits
-in the modulus. In the source code this is evaluated on lines 36 to 43 where algorithm s\_mp\_mul\_high\_digs is used when it is
+in the modulus. In the source code this is evaluated on lines 36 to 44 where algorithm s\_mp\_mul\_high\_digs is used when it is
safe to do so.
\subsection{The Barrett Setup Algorithm}
@@ -5901,21 +3857,6 @@ is equivalent and much faster. The final value is computed by taking the intege
\hspace{-5.1mm}{\bf File}: bn\_mp\_reduce\_setup.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* pre-calculate the value required for Barrett reduction
-018 * For a given modulus "b" it calulates the value required in "a"
-019 */
-020 int mp_reduce_setup (mp_int * a, mp_int * b)
-021 \{
-022 int res;
-023
-024 if ((res = mp_2expt (a, b->used * 2 * DIGIT_BIT)) != MP_OKAY) \{
-025 return res;
-026 \}
-027 return mp_div (a, b, a, NULL);
-028 \}
-029 #endif
-030
\end{alltt}
\end{small}
@@ -5980,6 +3921,7 @@ $0 \le r < \lfloor x/2^k \rfloor + n$. As a result at most a single subtraction
\hline $6$ & $x/2 = 139$ \\
\hline $7$ & $x + n = 396$, $x/2 = 198$ \\
\hline $8$ & $x/2 = 99$ \\
+\hline $9$ & $x + n = 356$, $x/2 = 178$ \\
\hline
\end{tabular}
\end{center}
@@ -5988,8 +3930,8 @@ $0 \le r < \lfloor x/2^k \rfloor + n$. As a result at most a single subtraction
\label{fig:MONT1}
\end{figure}
-Consider the example in figure~\ref{fig:MONT1} which reduces $x = 5555$ modulo $n = 257$ when $k = 8$. The result of the algorithm $r = 99$ is
-congruent to the value of $2^{-8} \cdot 5555 \mbox{ (mod }257\mbox{)}$. When $r$ is multiplied by $2^8$ modulo $257$ the correct residue
+Consider the example in figure~\ref{fig:MONT1} which reduces $x = 5555$ modulo $n = 257$ when $k = 9$ (note $\beta^k = 512$ which is larger than $n$). The result of
+the algorithm $r = 178$ is congruent to the value of $2^{-9} \cdot 5555 \mbox{ (mod }257\mbox{)}$. When $r$ is multiplied by $2^9$ modulo $257$ the correct residue
$r \equiv 158$ is produced.
Let $k = \lfloor lg(n) \rfloor + 1$ represent the number of bits in $n$. The current algorithm requires $2k^2$ single precision shifts
@@ -6001,10 +3943,10 @@ Fortunately there exists an alternative representation of the algorithm.
\begin{center}
\begin{tabular}{l}
\hline Algorithm \textbf{Montgomery Reduction} (modified I). \\
-\textbf{Input}. Integer $x$, $n$ and $k$ \\
+\textbf{Input}. Integer $x$, $n$ and $k$ ($2^k > n$) \\
\textbf{Output}. $2^{-k}x \mbox{ (mod }n\mbox{)}$ \\
\hline \\
-1. for $t$ from $0$ to $k - 1$ do \\
+1. for $t$ from $1$ to $k$ do \\
\hspace{3mm}1.1 If the $t$'th bit of $x$ is one then \\
\hspace{6mm}1.1.1 $x \leftarrow x + 2^tn$ \\
2. Return $x/2^k$. \\
@@ -6032,7 +3974,8 @@ precision shifts has now been reduced from $2k^2$ to $k^2 + k$ which is only a s
\hline $6$ & $8896$ & $10001011000000$ \\
\hline $7$ & $x + 2^{6}n = 25344$ & $110001100000000$ \\
\hline $8$ & $25344$ & $110001100000000$ \\
-\hline -- & $x/2^k = 99$ & \\
+\hline $9$ & $x + 2^{7}n = 91136$ & $10110010000000000$ \\
+\hline -- & $x/2^k = 178$ & \\
\hline
\end{tabular}
\end{center}
@@ -6041,7 +3984,7 @@ precision shifts has now been reduced from $2k^2$ to $k^2 + k$ which is only a s
\label{fig:MONT2}
\end{figure}
-Figure~\ref{fig:MONT2} demonstrates the modified algorithm reducing $x = 5555$ modulo $n = 257$ with $k = 8$.
+Figure~\ref{fig:MONT2} demonstrates the modified algorithm reducing $x = 5555$ modulo $n = 257$ with $k = 9$.
With this algorithm a single shift right at the end is the only right shift required to reduce the input instead of $k$ right shifts inside the
loop. Note that for the iterations $t = 2, 5, 6$ and $8$ where the result $x$ is not changed. In those iterations the $t$'th bit of $x$ is
zero and the appropriate multiple of $n$ does not need to be added to force the $t$'th bit of the result to zero.
@@ -6055,7 +3998,7 @@ previous algorithm re-written to compute the Montgomery reduction in this new fa
\begin{center}
\begin{tabular}{l}
\hline Algorithm \textbf{Montgomery Reduction} (modified II). \\
-\textbf{Input}. Integer $x$, $n$ and $k$ \\
+\textbf{Input}. Integer $x$, $n$ and $k$ ($\beta^k > n$) \\
\textbf{Output}. $\beta^{-k}x \mbox{ (mod }n\mbox{)}$ \\
\hline \\
1. for $t$ from $0$ to $k - 1$ do \\
@@ -6173,110 +4116,11 @@ multiplications.
\hspace{-5.1mm}{\bf File}: bn\_mp\_montgomery\_reduce.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes xR**-1 == x (mod N) via Montgomery Reduction */
-018 int
-019 mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
-020 \{
-021 int ix, res, digs;
-022 mp_digit mu;
-023
-024 /* can the fast reduction [comba] method be used?
-025 *
-026 * Note that unlike in mul you're safely allowed *less*
-027 * than the available columns [255 per default] since carries
-028 * are fixed up in the inner loop.
-029 */
-030 digs = n->used * 2 + 1;
-031 if ((digs < MP_WARRAY) &&
-032 n->used <
-033 (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) \{
-034 return fast_mp_montgomery_reduce (x, n, rho);
-035 \}
-036
-037 /* grow the input as required */
-038 if (x->alloc < digs) \{
-039 if ((res = mp_grow (x, digs)) != MP_OKAY) \{
-040 return res;
-041 \}
-042 \}
-043 x->used = digs;
-044
-045 for (ix = 0; ix < n->used; ix++) \{
-046 /* mu = ai * rho mod b
-047 *
-048 * The value of rho must be precalculated via
-049 * montgomery_setup() such that
-050 * it equals -1/n0 mod b this allows the
-051 * following inner loop to reduce the
-052 * input one digit at a time
-053 */
-054 mu = (mp_digit) (((mp_word)x->dp[ix]) * ((mp_word)rho) & MP_MASK);
-055
-056 /* a = a + mu * m * b**i */
-057 \{
-058 register int iy;
-059 register mp_digit *tmpn, *tmpx, u;
-060 register mp_word r;
-061
-062 /* alias for digits of the modulus */
-063 tmpn = n->dp;
-064
-065 /* alias for the digits of x [the input] */
-066 tmpx = x->dp + ix;
-067
-068 /* set the carry to zero */
-069 u = 0;
-070
-071 /* Multiply and add in place */
-072 for (iy = 0; iy < n->used; iy++) \{
-073 /* compute product and sum */
-074 r = ((mp_word)mu) * ((mp_word)*tmpn++) +
-075 ((mp_word) u) + ((mp_word) * tmpx);
-076
-077 /* get carry */
-078 u = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
-079
-080 /* fix digit */
-081 *tmpx++ = (mp_digit)(r & ((mp_word) MP_MASK));
-082 \}
-083 /* At this point the ix'th digit of x should be zero */
-084
-085
-086 /* propagate carries upwards as required*/
-087 while (u) \{
-088 *tmpx += u;
-089 u = *tmpx >> DIGIT_BIT;
-090 *tmpx++ &= MP_MASK;
-091 \}
-092 \}
-093 \}
-094
-095 /* at this point the n.used'th least
-096 * significant digits of x are all zero
-097 * which means we can shift x to the
-098 * right by n.used digits and the
-099 * residue is unchanged.
-100 */
-101
-102 /* x = x/b**n.used */
-103 mp_clamp(x);
-104 mp_rshd (x, n->used);
-105
-106 /* if x >= n then x = x - n */
-107 if (mp_cmp_mag (x, n) != MP_LT) \{
-108 return s_mp_sub (x, n, x);
-109 \}
-110
-111 return MP_OKAY;
-112 \}
-113 #endif
-114
\end{alltt}
\end{small}
-This is the baseline implementation of the Montgomery reduction algorithm. Lines 30 to 35 determine if the Comba based
-routine can be used instead. Line 48 computes the value of $\mu$ for that particular iteration of the outer loop.
+This is the baseline implementation of the Montgomery reduction algorithm. Lines 31 to 36 determine if the Comba based
+routine can be used instead. Line 47 computes the value of $\mu$ for that particular iteration of the outer loop.
The multiplication $\mu n \beta^{ix}$ is performed in one step in the inner loop. The alias $tmpx$ refers to the $ix$'th digit of $x$ and
the alias $tmpn$ refers to the modulus $n$.
@@ -6364,170 +4208,17 @@ stored in the destination $x$.
\hspace{-5.1mm}{\bf File}: bn\_fast\_mp\_montgomery\_reduce.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes xR**-1 == x (mod N) via Montgomery Reduction
-018 *
-019 * This is an optimized implementation of montgomery_reduce
-020 * which uses the comba method to quickly calculate the columns of the
-021 * reduction.
-022 *
-023 * Based on Algorithm 14.32 on pp.601 of HAC.
-024 */
-025 int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
-026 \{
-027 int ix, res, olduse;
-028 mp_word W[MP_WARRAY];
-029
-030 /* get old used count */
-031 olduse = x->used;
-032
-033 /* grow a as required */
-034 if (x->alloc < n->used + 1) \{
-035 if ((res = mp_grow (x, n->used + 1)) != MP_OKAY) \{
-036 return res;
-037 \}
-038 \}
-039
-040 /* first we have to get the digits of the input into
-041 * an array of double precision words W[...]
-042 */
-043 \{
-044 register mp_word *_W;
-045 register mp_digit *tmpx;
-046
-047 /* alias for the W[] array */
-048 _W = W;
-049
-050 /* alias for the digits of x*/
-051 tmpx = x->dp;
-052
-053 /* copy the digits of a into W[0..a->used-1] */
-054 for (ix = 0; ix < x->used; ix++) \{
-055 *_W++ = *tmpx++;
-056 \}
-057
-058 /* zero the high words of W[a->used..m->used*2] */
-059 for (; ix < n->used * 2 + 1; ix++) \{
-060 *_W++ = 0;
-061 \}
-062 \}
-063
-064 /* now we proceed to zero successive digits
-065 * from the least significant upwards
-066 */
-067 for (ix = 0; ix < n->used; ix++) \{
-068 /* mu = ai * m' mod b
-069 *
-070 * We avoid a double precision multiplication (which isn't required)
-071 * by casting the value down to a mp_digit. Note this requires
-072 * that W[ix-1] have the carry cleared (see after the inner loop)
-073 */
-074 register mp_digit mu;
-075 mu = (mp_digit) (((W[ix] & MP_MASK) * rho) & MP_MASK);
-076
-077 /* a = a + mu * m * b**i
-078 *
-079 * This is computed in place and on the fly. The multiplication
-080 * by b**i is handled by offseting which columns the results
-081 * are added to.
-082 *
-083 * Note the comba method normally doesn't handle carries in the
-084 * inner loop In this case we fix the carry from the previous
-085 * column since the Montgomery reduction requires digits of the
-086 * result (so far) [see above] to work. This is
-087 * handled by fixing up one carry after the inner loop. The
-088 * carry fixups are done in order so after these loops the
-089 * first m->used words of W[] have the carries fixed
-090 */
-091 \{
-092 register int iy;
-093 register mp_digit *tmpn;
-094 register mp_word *_W;
-095
-096 /* alias for the digits of the modulus */
-097 tmpn = n->dp;
-098
-099 /* Alias for the columns set by an offset of ix */
-100 _W = W + ix;
-101
-102 /* inner loop */
-103 for (iy = 0; iy < n->used; iy++) \{
-104 *_W++ += ((mp_word)mu) * ((mp_word)*tmpn++);
-105 \}
-106 \}
-107
-108 /* now fix carry for next digit, W[ix+1] */
-109 W[ix + 1] += W[ix] >> ((mp_word) DIGIT_BIT);
-110 \}
-111
-112 /* now we have to propagate the carries and
-113 * shift the words downward [all those least
-114 * significant digits we zeroed].
-115 */
-116 \{
-117 register mp_digit *tmpx;
-118 register mp_word *_W, *_W1;
-119
-120 /* nox fix rest of carries */
-121
-122 /* alias for current word */
-123 _W1 = W + ix;
-124
-125 /* alias for next word, where the carry goes */
-126 _W = W + ++ix;
-127
-128 for (; ix <= n->used * 2 + 1; ix++) \{
-129 *_W++ += *_W1++ >> ((mp_word) DIGIT_BIT);
-130 \}
-131
-132 /* copy out, A = A/b**n
-133 *
-134 * The result is A/b**n but instead of converting from an
-135 * array of mp_word to mp_digit than calling mp_rshd
-136 * we just copy them in the right order
-137 */
-138
-139 /* alias for destination word */
-140 tmpx = x->dp;
-141
-142 /* alias for shifted double precision result */
-143 _W = W + n->used;
-144
-145 for (ix = 0; ix < n->used + 1; ix++) \{
-146 *tmpx++ = (mp_digit)(*_W++ & ((mp_word) MP_MASK));
-147 \}
-148
-149 /* zero oldused digits, if the input a was larger than
-150 * m->used+1 we'll have to clear the digits
-151 */
-152 for (; ix < olduse; ix++) \{
-153 *tmpx++ = 0;
-154 \}
-155 \}
-156
-157 /* set the max used and clamp */
-158 x->used = n->used + 1;
-159 mp_clamp (x);
-160
-161 /* if A >= m then A = A - m */
-162 if (mp_cmp_mag (x, n) != MP_LT) \{
-163 return s_mp_sub (x, n, x);
-164 \}
-165 return MP_OKAY;
-166 \}
-167 #endif
-168
\end{alltt}
\end{small}
-The $\hat W$ array is first filled with digits of $x$ on line 50 then the rest of the digits are zeroed on line 54. Both loops share
+The $\hat W$ array is first filled with digits of $x$ on line 48 then the rest of the digits are zeroed on line 55. Both loops share
the same alias variables to make the code easier to read.
The value of $\mu$ is calculated in an interesting fashion. First the value $\hat W_{ix}$ is reduced modulo $\beta$ and cast to a mp\_digit. This
-forces the compiler to use a single precision multiplication and prevents any concerns about loss of precision. Line 109 fixes the carry
+forces the compiler to use a single precision multiplication and prevents any concerns about loss of precision. Line 110 fixes the carry
for the next iteration of the loop by propagating the carry from $\hat W_{ix}$ to $\hat W_{ix+1}$.
-The for loop on line 108 propagates the rest of the carries upwards through the columns. The for loop on line 125 reduces the columns
+The for loop on line 109 propagates the rest of the carries upwards through the columns. The for loop on line 126 reduces the columns
modulo $\beta$ and shifts them $k$ places at the same time. The alias $\_ \hat W$ actually refers to the array $\hat W$ starting at the $n.used$'th
digit, that is $\_ \hat W_{t} = \hat W_{n.used + t}$.
@@ -6564,46 +4255,6 @@ to calculate $1/n_0$ when $\beta$ is a power of two.
\hspace{-5.1mm}{\bf File}: bn\_mp\_montgomery\_setup.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* setups the montgomery reduction stuff */
-018 int
-019 mp_montgomery_setup (mp_int * n, mp_digit * rho)
-020 \{
-021 mp_digit x, b;
-022
-023 /* fast inversion mod 2**k
-024 *
-025 * Based on the fact that
-026 *
-027 * XA = 1 (mod 2**n) => (X(2-XA)) A = 1 (mod 2**2n)
-028 * => 2*X*A - X*X*A*A = 1
-029 * => 2*(1) - (1) = 1
-030 */
-031 b = n->dp[0];
-032
-033 if ((b & 1) == 0) \{
-034 return MP_VAL;
-035 \}
-036
-037 x = (((b + 2) & 4) << 1) + b; /* here x*a==1 mod 2**4 */
-038 x *= 2 - b * x; /* here x*a==1 mod 2**8 */
-039 #if !defined(MP_8BIT)
-040 x *= 2 - b * x; /* here x*a==1 mod 2**16 */
-041 #endif
-042 #if defined(MP_64BIT) || !(defined(MP_8BIT) || defined(MP_16BIT))
-043 x *= 2 - b * x; /* here x*a==1 mod 2**32 */
-044 #endif
-045 #ifdef MP_64BIT
-046 x *= 2 - b * x; /* here x*a==1 mod 2**64 */
-047 #endif
-048
-049 /* rho = -1/m mod b */
-050 *rho = (((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;
-051
-052 return MP_OKAY;
-053 \}
-054 #endif
-055
\end{alltt}
\end{small}
@@ -6796,97 +4447,22 @@ at step 3.
\hspace{-5.1mm}{\bf File}: bn\_mp\_dr\_reduce.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* reduce "x" in place modulo "n" using the Diminished Radix algorithm.
-018 *
-019 * Based on algorithm from the paper
-020 *
-021 * "Generating Efficient Primes for Discrete Log Cryptosystems"
-022 * Chae Hoon Lim, Pil Joong Lee,
-023 * POSTECH Information Research Laboratories
-024 *
-025 * The modulus must be of a special format [see manual]
-026 *
-027 * Has been modified to use algorithm 7.10 from the LTM book instead
-028 *
-029 * Input x must be in the range 0 <= x <= (n-1)**2
-030 */
-031 int
-032 mp_dr_reduce (mp_int * x, mp_int * n, mp_digit k)
-033 \{
-034 int err, i, m;
-035 mp_word r;
-036 mp_digit mu, *tmpx1, *tmpx2;
-037
-038 /* m = digits in modulus */
-039 m = n->used;
-040
-041 /* ensure that "x" has at least 2m digits */
-042 if (x->alloc < m + m) \{
-043 if ((err = mp_grow (x, m + m)) != MP_OKAY) \{
-044 return err;
-045 \}
-046 \}
-047
-048 /* top of loop, this is where the code resumes if
-049 * another reduction pass is required.
-050 */
-051 top:
-052 /* aliases for digits */
-053 /* alias for lower half of x */
-054 tmpx1 = x->dp;
-055
-056 /* alias for upper half of x, or x/B**m */
-057 tmpx2 = x->dp + m;
-058
-059 /* set carry to zero */
-060 mu = 0;
-061
-062 /* compute (x mod B**m) + k * [x/B**m] inline and inplace */
-063 for (i = 0; i < m; i++) \{
-064 r = ((mp_word)*tmpx2++) * ((mp_word)k) + *tmpx1 + mu;
-065 *tmpx1++ = (mp_digit)(r & MP_MASK);
-066 mu = (mp_digit)(r >> ((mp_word)DIGIT_BIT));
-067 \}
-068
-069 /* set final carry */
-070 *tmpx1++ = mu;
-071
-072 /* zero words above m */
-073 for (i = m + 1; i < x->used; i++) \{
-074 *tmpx1++ = 0;
-075 \}
-076
-077 /* clamp, sub and return */
-078 mp_clamp (x);
-079
-080 /* if x >= n then subtract and reduce again
-081 * Each successive "recursion" makes the input smaller and smaller.
-082 */
-083 if (mp_cmp_mag (x, n) != MP_LT) \{
-084 s_mp_sub(x, n, x);
-085 goto top;
-086 \}
-087 return MP_OKAY;
-088 \}
-089 #endif
-090
\end{alltt}
\end{small}
-The first step is to grow $x$ as required to $2m$ digits since the reduction is performed in place on $x$. The label on line 51 is where
+The first step is to grow $x$ as required to $2m$ digits since the reduction is performed in place on $x$. The label on line 52 is where
the algorithm will resume if further reduction passes are required. In theory it could be placed at the top of the function however, the size of
the modulus and question of whether $x$ is large enough are invariant after the first pass meaning that it would be a waste of time.
The aliases $tmpx1$ and $tmpx2$ refer to the digits of $x$ where the latter is offset by $m$ digits. By reading digits from $x$ offset by $m$ digits
-a division by $\beta^m$ can be simulated virtually for free. The loop on line 63 performs the bulk of the work (\textit{corresponds to step 4 of algorithm 7.11})
+a division by $\beta^m$ can be simulated virtually for free. The loop on line 64 performs the bulk of the work (\textit{corresponds to step 4 of algorithm 7.11})
in this algorithm.
-By line 70 the pointer $tmpx1$ points to the $m$'th digit of $x$ which is where the final carry will be placed. Similarly by line 73 the
+By line 67 the pointer $tmpx1$ points to the $m$'th digit of $x$ which is where the final carry will be placed. Similarly by line 74 the
same pointer will point to the $m+1$'th digit where the zeroes will be placed.
Since the algorithm is only valid if both $x$ and $n$ are greater than zero an unsigned comparison suffices to determine if another pass is required.
-With the same logic at line 84 the value of $x$ is known to be greater than or equal to $n$ meaning that an unsigned subtraction can be used
+With the same logic at line 81 the value of $x$ is known to be greater than or equal to $n$ meaning that an unsigned subtraction can be used
as well. Since the destination of the subtraction is the larger of the inputs the call to algorithm s\_mp\_sub cannot fail and the return code
does not need to be checked.
@@ -6914,19 +4490,6 @@ completeness.
\hspace{-5.1mm}{\bf File}: bn\_mp\_dr\_setup.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* determines the setup value */
-018 void mp_dr_setup(mp_int *a, mp_digit *d)
-019 \{
-020 /* the casts are required if DIGIT_BIT is one less than
-021 * the number of bits in a mp_digit [e.g. DIGIT_BIT==31]
-022 */
-023 *d = (mp_digit)((((mp_word)1) << ((mp_word)DIGIT_BIT)) -
-024 ((mp_word)a->dp[0]));
-025 \}
-026
-027 #endif
-028
\end{alltt}
\end{small}
@@ -6962,30 +4525,6 @@ step 3 then $n$ must be of Diminished Radix form.
\hspace{-5.1mm}{\bf File}: bn\_mp\_dr\_is\_modulus.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* determines if a number is a valid DR modulus */
-018 int mp_dr_is_modulus(mp_int *a)
-019 \{
-020 int ix;
-021
-022 /* must be at least two digits */
-023 if (a->used < 2) \{
-024 return 0;
-025 \}
-026
-027 /* must be of the form b**k - a [a <= b] so all
-028 * but the first digit must be equal to -1 (mod b).
-029 */
-030 for (ix = 1; ix < a->used; ix++) \{
-031 if (a->dp[ix] != MP_MASK) \{
-032 return 0;
-033 \}
-034 \}
-035 return 1;
-036 \}
-037
-038 #endif
-039
\end{alltt}
\end{small}
@@ -7029,53 +4568,11 @@ shift which makes the algorithm fairly inexpensive to use.
\hspace{-5.1mm}{\bf File}: bn\_mp\_reduce\_2k.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* reduces a modulo n where n is of the form 2**p - d */
-018 int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d)
-019 \{
-020 mp_int q;
-021 int p, res;
-022
-023 if ((res = mp_init(&q)) != MP_OKAY) \{
-024 return res;
-025 \}
-026
-027 p = mp_count_bits(n);
-028 top:
-029 /* q = a/2**p, a = a mod 2**p */
-030 if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) \{
-031 goto ERR;
-032 \}
-033
-034 if (d != 1) \{
-035 /* q = q * d */
-036 if ((res = mp_mul_d(&q, d, &q)) != MP_OKAY) \{
-037 goto ERR;
-038 \}
-039 \}
-040
-041 /* a = a + q */
-042 if ((res = s_mp_add(a, &q, a)) != MP_OKAY) \{
-043 goto ERR;
-044 \}
-045
-046 if (mp_cmp_mag(a, n) != MP_LT) \{
-047 s_mp_sub(a, n, a);
-048 goto top;
-049 \}
-050
-051 ERR:
-052 mp_clear(&q);
-053 return res;
-054 \}
-055
-056 #endif
-057
\end{alltt}
\end{small}
The algorithm mp\_count\_bits calculates the number of bits in an mp\_int which is used to find the initial value of $p$. The call to mp\_div\_2d
-on line 30 calculates both the quotient $q$ and the remainder $a$ required. By doing both in a single function call the code size
+on line 31 calculates both the quotient $q$ and the remainder $a$ required. By doing both in a single function call the code size
is kept fairly small. The multiplication by $k$ is only performed if $k > 1$. This allows reductions modulo $2^p - 1$ to be performed without
any multiplications.
@@ -7113,34 +4610,6 @@ is sufficient to solve for $k$. Alternatively if $n$ has more than one digit th
\hspace{-5.1mm}{\bf File}: bn\_mp\_reduce\_2k\_setup.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* determines the setup value */
-018 int mp_reduce_2k_setup(mp_int *a, mp_digit *d)
-019 \{
-020 int res, p;
-021 mp_int tmp;
-022
-023 if ((res = mp_init(&tmp)) != MP_OKAY) \{
-024 return res;
-025 \}
-026
-027 p = mp_count_bits(a);
-028 if ((res = mp_2expt(&tmp, p)) != MP_OKAY) \{
-029 mp_clear(&tmp);
-030 return res;
-031 \}
-032
-033 if ((res = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) \{
-034 mp_clear(&tmp);
-035 return res;
-036 \}
-037
-038 *d = tmp.dp[0];
-039 mp_clear(&tmp);
-040 return MP_OKAY;
-041 \}
-042 #endif
-043
\end{alltt}
\end{small}
@@ -7185,39 +4654,6 @@ This algorithm quickly determines if a modulus is of the form required for algor
\hspace{-5.1mm}{\bf File}: bn\_mp\_reduce\_is\_2k.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* determines if mp_reduce_2k can be used */
-018 int mp_reduce_is_2k(mp_int *a)
-019 \{
-020 int ix, iy, iw;
-021 mp_digit iz;
-022
-023 if (a->used == 0) \{
-024 return MP_NO;
-025 \} else if (a->used == 1) \{
-026 return MP_YES;
-027 \} else if (a->used > 1) \{
-028 iy = mp_count_bits(a);
-029 iz = 1;
-030 iw = 1;
-031
-032 /* Test every bit from the second digit up, must be 1 */
-033 for (ix = DIGIT_BIT; ix < iy; ix++) \{
-034 if ((a->dp[iw] & iz) == 0) \{
-035 return MP_NO;
-036 \}
-037 iz <<= 1;
-038 if (iz > (mp_digit)MP_MASK) \{
-039 ++iw;
-040 iz = 1;
-041 \}
-042 \}
-043 \}
-044 return MP_YES;
-045 \}
-046
-047 #endif
-048
\end{alltt}
\end{small}
@@ -7390,51 +4826,13 @@ iteration of the loop moves the bits of the exponent $b$ upwards to the most sig
\hspace{-5.1mm}{\bf File}: bn\_mp\_expt\_d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* calculate c = a**b using a square-multiply algorithm */
-018 int mp_expt_d (mp_int * a, mp_digit b, mp_int * c)
-019 \{
-020 int res, x;
-021 mp_int g;
-022
-023 if ((res = mp_init_copy (&g, a)) != MP_OKAY) \{
-024 return res;
-025 \}
-026
-027 /* set initial result */
-028 mp_set (c, 1);
-029
-030 for (x = 0; x < (int) DIGIT_BIT; x++) \{
-031 /* square */
-032 if ((res = mp_sqr (c, c)) != MP_OKAY) \{
-033 mp_clear (&g);
-034 return res;
-035 \}
-036
-037 /* if the bit is set multiply */
-038 if ((b & (mp_digit) (((mp_digit)1) << (DIGIT_BIT - 1))) != 0) \{
-039 if ((res = mp_mul (c, &g, c)) != MP_OKAY) \{
-040 mp_clear (&g);
-041 return res;
-042 \}
-043 \}
-044
-045 /* shift to next bit */
-046 b <<= 1;
-047 \}
-048
-049 mp_clear (&g);
-050 return MP_OKAY;
-051 \}
-052 #endif
-053
\end{alltt}
\end{small}
-Line 28 sets the initial value of the result to $1$. Next the loop on line 30 steps through each bit of the exponent starting from
-the most significant down towards the least significant. The invariant squaring operation placed on line 32 is performed first. After
+Line 29 sets the initial value of the result to $1$. Next the loop on line 31 steps through each bit of the exponent starting from
+the most significant down towards the least significant. The invariant squaring operation placed on line 33 is performed first. After
the squaring the result $c$ is multiplied by the base $g$ if and only if the most significant bit of the exponent is set. The shift on line
-46 moves all of the bits of the exponent upwards towards the most significant location.
+47 moves all of the bits of the exponent upwards towards the most significant location.
\section{$k$-ary Exponentiation}
When calculating an exponentiation the most time consuming bottleneck is the multiplications which are in general a small factor
@@ -7615,110 +5013,16 @@ algorithm since their arguments are essentially the same (\textit{two mp\_ints a
\hspace{-5.1mm}{\bf File}: bn\_mp\_exptmod.c
\vspace{-3mm}
\begin{alltt}
-016
-017
-018 /* this is a shell function that calls either the normal or Montgomery
-019 * exptmod functions. Originally the call to the montgomery code was
-020 * embedded in the normal function but that wasted alot of stack space
-021 * for nothing (since 99% of the time the Montgomery code would be called)
-022 */
-023 int mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y)
-024 \{
-025 int dr;
-026
-027 /* modulus P must be positive */
-028 if (P->sign == MP_NEG) \{
-029 return MP_VAL;
-030 \}
-031
-032 /* if exponent X is negative we have to recurse */
-033 if (X->sign == MP_NEG) \{
-034 #ifdef BN_MP_INVMOD_C
-035 mp_int tmpG, tmpX;
-036 int err;
-037
-038 /* first compute 1/G mod P */
-039 if ((err = mp_init(&tmpG)) != MP_OKAY) \{
-040 return err;
-041 \}
-042 if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) \{
-043 mp_clear(&tmpG);
-044 return err;
-045 \}
-046
-047 /* now get |X| */
-048 if ((err = mp_init(&tmpX)) != MP_OKAY) \{
-049 mp_clear(&tmpG);
-050 return err;
-051 \}
-052 if ((err = mp_abs(X, &tmpX)) != MP_OKAY) \{
-053 mp_clear_multi(&tmpG, &tmpX, NULL);
-054 return err;
-055 \}
-056
-057 /* and now compute (1/G)**|X| instead of G**X [X < 0] */
-058 err = mp_exptmod(&tmpG, &tmpX, P, Y);
-059 mp_clear_multi(&tmpG, &tmpX, NULL);
-060 return err;
-061 #else
-062 /* no invmod */
-063 return MP_VAL;
-064 #endif
-065 \}
-066
-067 /* modified diminished radix reduction */
-068 #if defined(BN_MP_REDUCE_IS_2K_L_C) && defined(BN_MP_REDUCE_2K_L_C) && defin
- ed(BN_S_MP_EXPTMOD_C)
-069 if (mp_reduce_is_2k_l(P) == MP_YES) \{
-070 return s_mp_exptmod(G, X, P, Y, 1);
-071 \}
-072 #endif
-073
-074 #ifdef BN_MP_DR_IS_MODULUS_C
-075 /* is it a DR modulus? */
-076 dr = mp_dr_is_modulus(P);
-077 #else
-078 /* default to no */
-079 dr = 0;
-080 #endif
-081
-082 #ifdef BN_MP_REDUCE_IS_2K_C
-083 /* if not, is it a unrestricted DR modulus? */
-084 if (dr == 0) \{
-085 dr = mp_reduce_is_2k(P) << 1;
-086 \}
-087 #endif
-088
-089 /* if the modulus is odd or dr != 0 use the montgomery method */
-090 #ifdef BN_MP_EXPTMOD_FAST_C
-091 if (mp_isodd (P) == 1 || dr != 0) \{
-092 return mp_exptmod_fast (G, X, P, Y, dr);
-093 \} else \{
-094 #endif
-095 #ifdef BN_S_MP_EXPTMOD_C
-096 /* otherwise use the generic Barrett reduction technique */
-097 return s_mp_exptmod (G, X, P, Y, 0);
-098 #else
-099 /* no exptmod for evens */
-100 return MP_VAL;
-101 #endif
-102 #ifdef BN_MP_EXPTMOD_FAST_C
-103 \}
-104 #endif
-105 \}
-106
-107 #endif
-108
\end{alltt}
\end{small}
-In order to keep the algorithms in a known state the first step on line 28 is to reject any negative modulus as input. If the exponent is
+In order to keep the algorithms in a known state the first step on line 29 is to reject any negative modulus as input. If the exponent is
negative the algorithm tries to perform a modular exponentiation with the modular inverse of the base $G$. The temporary variable $tmpG$ is assigned
the modular inverse of $G$ and $tmpX$ is assigned the absolute value of $X$. The algorithm will recuse with these new values with a positive
exponent.
-If the exponent is positive the algorithm resumes the exponentiation. Line 76 determines if the modulus is of the restricted Diminished Radix
-form. If it is not line 69 attempts to determine if it is of a unrestricted Diminished Radix form. The integer $dr$ will take on one
+If the exponent is positive the algorithm resumes the exponentiation. Line 77 determines if the modulus is of the restricted Diminished Radix
+form. If it is not line 70 attempts to determine if it is of a unrestricted Diminished Radix form. The integer $dr$ will take on one
of three values.
\begin{enumerate}
@@ -7888,252 +5192,18 @@ a Left-to-Right algorithm is used to process the remaining few bits.
\hspace{-5.1mm}{\bf File}: bn\_s\_mp\_exptmod.c
\vspace{-3mm}
\begin{alltt}
-016 #ifdef MP_LOW_MEM
-017 #define TAB_SIZE 32
-018 #else
-019 #define TAB_SIZE 256
-020 #endif
-021
-022 int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int redmod
- e)
-023 \{
-024 mp_int M[TAB_SIZE], res, mu;
-025 mp_digit buf;
-026 int err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;
-027 int (*redux)(mp_int*,mp_int*,mp_int*);
-028
-029 /* find window size */
-030 x = mp_count_bits (X);
-031 if (x <= 7) \{
-032 winsize = 2;
-033 \} else if (x <= 36) \{
-034 winsize = 3;
-035 \} else if (x <= 140) \{
-036 winsize = 4;
-037 \} else if (x <= 450) \{
-038 winsize = 5;
-039 \} else if (x <= 1303) \{
-040 winsize = 6;
-041 \} else if (x <= 3529) \{
-042 winsize = 7;
-043 \} else \{
-044 winsize = 8;
-045 \}
-046
-047 #ifdef MP_LOW_MEM
-048 if (winsize > 5) \{
-049 winsize = 5;
-050 \}
-051 #endif
-052
-053 /* init M array */
-054 /* init first cell */
-055 if ((err = mp_init(&M[1])) != MP_OKAY) \{
-056 return err;
-057 \}
-058
-059 /* now init the second half of the array */
-060 for (x = 1<<(winsize-1); x < (1 << winsize); x++) \{
-061 if ((err = mp_init(&M[x])) != MP_OKAY) \{
-062 for (y = 1<<(winsize-1); y < x; y++) \{
-063 mp_clear (&M[y]);
-064 \}
-065 mp_clear(&M[1]);
-066 return err;
-067 \}
-068 \}
-069
-070 /* create mu, used for Barrett reduction */
-071 if ((err = mp_init (&mu)) != MP_OKAY) \{
-072 goto LBL_M;
-073 \}
-074
-075 if (redmode == 0) \{
-076 if ((err = mp_reduce_setup (&mu, P)) != MP_OKAY) \{
-077 goto LBL_MU;
-078 \}
-079 redux = mp_reduce;
-080 \} else \{
-081 if ((err = mp_reduce_2k_setup_l (P, &mu)) != MP_OKAY) \{
-082 goto LBL_MU;
-083 \}
-084 redux = mp_reduce_2k_l;
-085 \}
-086
-087 /* create M table
-088 *
-089 * The M table contains powers of the base,
-090 * e.g. M[x] = G**x mod P
-091 *
-092 * The first half of the table is not
-093 * computed though accept for M[0] and M[1]
-094 */
-095 if ((err = mp_mod (G, P, &M[1])) != MP_OKAY) \{
-096 goto LBL_MU;
-097 \}
-098
-099 /* compute the value at M[1<<(winsize-1)] by squaring
-100 * M[1] (winsize-1) times
-101 */
-102 if ((err = mp_copy (&M[1], &M[1 << (winsize - 1)])) != MP_OKAY) \{
-103 goto LBL_MU;
-104 \}
-105
-106 for (x = 0; x < (winsize - 1); x++) \{
-107 /* square it */
-108 if ((err = mp_sqr (&M[1 << (winsize - 1)],
-109 &M[1 << (winsize - 1)])) != MP_OKAY) \{
-110 goto LBL_MU;
-111 \}
-112
-113 /* reduce modulo P */
-114 if ((err = redux (&M[1 << (winsize - 1)], P, &mu)) != MP_OKAY) \{
-115 goto LBL_MU;
-116 \}
-117 \}
-118
-119 /* create upper table, that is M[x] = M[x-1] * M[1] (mod P)
-120 * for x = (2**(winsize - 1) + 1) to (2**winsize - 1)
-121 */
-122 for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) \{
-123 if ((err = mp_mul (&M[x - 1], &M[1], &M[x])) != MP_OKAY) \{
-124 goto LBL_MU;
-125 \}
-126 if ((err = redux (&M[x], P, &mu)) != MP_OKAY) \{
-127 goto LBL_MU;
-128 \}
-129 \}
-130
-131 /* setup result */
-132 if ((err = mp_init (&res)) != MP_OKAY) \{
-133 goto LBL_MU;
-134 \}
-135 mp_set (&res, 1);
-136
-137 /* set initial mode and bit cnt */
-138 mode = 0;
-139 bitcnt = 1;
-140 buf = 0;
-141 digidx = X->used - 1;
-142 bitcpy = 0;
-143 bitbuf = 0;
-144
-145 for (;;) \{
-146 /* grab next digit as required */
-147 if (--bitcnt == 0) \{
-148 /* if digidx == -1 we are out of digits */
-149 if (digidx == -1) \{
-150 break;
-151 \}
-152 /* read next digit and reset the bitcnt */
-153 buf = X->dp[digidx--];
-154 bitcnt = (int) DIGIT_BIT;
-155 \}
-156
-157 /* grab the next msb from the exponent */
-158 y = (buf >> (mp_digit)(DIGIT_BIT - 1)) & 1;
-159 buf <<= (mp_digit)1;
-160
-161 /* if the bit is zero and mode == 0 then we ignore it
-162 * These represent the leading zero bits before the first 1 bit
-163 * in the exponent. Technically this opt is not required but it
-164 * does lower the # of trivial squaring/reductions used
-165 */
-166 if (mode == 0 && y == 0) \{
-167 continue;
-168 \}
-169
-170 /* if the bit is zero and mode == 1 then we square */
-171 if (mode == 1 && y == 0) \{
-172 if ((err = mp_sqr (&res, &res)) != MP_OKAY) \{
-173 goto LBL_RES;
-174 \}
-175 if ((err = redux (&res, P, &mu)) != MP_OKAY) \{
-176 goto LBL_RES;
-177 \}
-178 continue;
-179 \}
-180
-181 /* else we add it to the window */
-182 bitbuf |= (y << (winsize - ++bitcpy));
-183 mode = 2;
-184
-185 if (bitcpy == winsize) \{
-186 /* ok window is filled so square as required and multiply */
-187 /* square first */
-188 for (x = 0; x < winsize; x++) \{
-189 if ((err = mp_sqr (&res, &res)) != MP_OKAY) \{
-190 goto LBL_RES;
-191 \}
-192 if ((err = redux (&res, P, &mu)) != MP_OKAY) \{
-193 goto LBL_RES;
-194 \}
-195 \}
-196
-197 /* then multiply */
-198 if ((err = mp_mul (&res, &M[bitbuf], &res)) != MP_OKAY) \{
-199 goto LBL_RES;
-200 \}
-201 if ((err = redux (&res, P, &mu)) != MP_OKAY) \{
-202 goto LBL_RES;
-203 \}
-204
-205 /* empty window and reset */
-206 bitcpy = 0;
-207 bitbuf = 0;
-208 mode = 1;
-209 \}
-210 \}
-211
-212 /* if bits remain then square/multiply */
-213 if (mode == 2 && bitcpy > 0) \{
-214 /* square then multiply if the bit is set */
-215 for (x = 0; x < bitcpy; x++) \{
-216 if ((err = mp_sqr (&res, &res)) != MP_OKAY) \{
-217 goto LBL_RES;
-218 \}
-219 if ((err = redux (&res, P, &mu)) != MP_OKAY) \{
-220 goto LBL_RES;
-221 \}
-222
-223 bitbuf <<= 1;
-224 if ((bitbuf & (1 << winsize)) != 0) \{
-225 /* then multiply */
-226 if ((err = mp_mul (&res, &M[1], &res)) != MP_OKAY) \{
-227 goto LBL_RES;
-228 \}
-229 if ((err = redux (&res, P, &mu)) != MP_OKAY) \{
-230 goto LBL_RES;
-231 \}
-232 \}
-233 \}
-234 \}
-235
-236 mp_exch (&res, Y);
-237 err = MP_OKAY;
-238 LBL_RES:mp_clear (&res);
-239 LBL_MU:mp_clear (&mu);
-240 LBL_M:
-241 mp_clear(&M[1]);
-242 for (x = 1<<(winsize-1); x < (1 << winsize); x++) \{
-243 mp_clear (&M[x]);
-244 \}
-245 return err;
-246 \}
-247 #endif
-248
\end{alltt}
\end{small}
-Lines 31 through 41 determine the optimal window size based on the length of the exponent in bits. The window divisions are sorted
+Lines 32 through 46 determine the optimal window size based on the length of the exponent in bits. The window divisions are sorted
from smallest to greatest so that in each \textbf{if} statement only one condition must be tested. For example, by the \textbf{if} statement
-on line 33 the value of $x$ is already known to be greater than $140$.
+on line 38 the value of $x$ is already known to be greater than $140$.
-The conditional piece of code beginning on line 47 allows the window size to be restricted to five bits. This logic is used to ensure
+The conditional piece of code beginning on line 48 allows the window size to be restricted to five bits. This logic is used to ensure
the table of precomputed powers of $G$ remains relatively small.
-The for loop on line 60 initializes the $M$ array while lines 61 and 76 compute the value of $\mu$ required for
-Barrett reduction.
+The for loop on line 61 initializes the $M$ array while lines 72 and 77 through 86 initialize the reduction
+function that will be used for this modulus.
-- More later.
@@ -8167,35 +5237,6 @@ equivalent to $m \cdot 2^k$. By this logic when $m = 1$ a quick power of two ca
\hspace{-5.1mm}{\bf File}: bn\_mp\_2expt.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes a = 2**b
-018 *
-019 * Simple algorithm which zeroes the int, grows it then just sets one bit
-020 * as required.
-021 */
-022 int
-023 mp_2expt (mp_int * a, int b)
-024 \{
-025 int res;
-026
-027 /* zero a as per default */
-028 mp_zero (a);
-029
-030 /* grow a to accomodate the single bit */
-031 if ((res = mp_grow (a, b / DIGIT_BIT + 1)) != MP_OKAY) \{
-032 return res;
-033 \}
-034
-035 /* set the used count of where the bit will go */
-036 a->used = b / DIGIT_BIT + 1;
-037
-038 /* put the single bit in its place */
-039 a->dp[b / DIGIT_BIT] = ((mp_digit)1) << (b % DIGIT_BIT);
-040
-041 return MP_OKAY;
-042 \}
-043 #endif
-044
\end{alltt}
\end{small}
@@ -8444,279 +5485,6 @@ respectively be replaced with a zero.
\hspace{-5.1mm}{\bf File}: bn\_mp\_div.c
\vspace{-3mm}
\begin{alltt}
-016
-017 #ifdef BN_MP_DIV_SMALL
-018
-019 /* slower bit-bang division... also smaller */
-020 int mp_div(mp_int * a, mp_int * b, mp_int * c, mp_int * d)
-021 \{
-022 mp_int ta, tb, tq, q;
-023 int res, n, n2;
-024
-025 /* is divisor zero ? */
-026 if (mp_iszero (b) == 1) \{
-027 return MP_VAL;
-028 \}
-029
-030 /* if a < b then q=0, r = a */
-031 if (mp_cmp_mag (a, b) == MP_LT) \{
-032 if (d != NULL) \{
-033 res = mp_copy (a, d);
-034 \} else \{
-035 res = MP_OKAY;
-036 \}
-037 if (c != NULL) \{
-038 mp_zero (c);
-039 \}
-040 return res;
-041 \}
-042
-043 /* init our temps */
-044 if ((res = mp_init_multi(&ta, &tb, &tq, &q, NULL) != MP_OKAY)) \{
-045 return res;
-046 \}
-047
-048
-049 mp_set(&tq, 1);
-050 n = mp_count_bits(a) - mp_count_bits(b);
-051 if (((res = mp_abs(a, &ta)) != MP_OKAY) ||
-052 ((res = mp_abs(b, &tb)) != MP_OKAY) ||
-053 ((res = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) ||
-054 ((res = mp_mul_2d(&tq, n, &tq)) != MP_OKAY)) \{
-055 goto LBL_ERR;
-056 \}
-057
-058 while (n-- >= 0) \{
-059 if (mp_cmp(&tb, &ta) != MP_GT) \{
-060 if (((res = mp_sub(&ta, &tb, &ta)) != MP_OKAY) ||
-061 ((res = mp_add(&q, &tq, &q)) != MP_OKAY)) \{
-062 goto LBL_ERR;
-063 \}
-064 \}
-065 if (((res = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY) ||
-066 ((res = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY)) \{
-067 goto LBL_ERR;
-068 \}
-069 \}
-070
-071 /* now q == quotient and ta == remainder */
-072 n = a->sign;
-073 n2 = (a->sign == b->sign ? MP_ZPOS : MP_NEG);
-074 if (c != NULL) \{
-075 mp_exch(c, &q);
-076 c->sign = (mp_iszero(c) == MP_YES) ? MP_ZPOS : n2;
-077 \}
-078 if (d != NULL) \{
-079 mp_exch(d, &ta);
-080 d->sign = (mp_iszero(d) == MP_YES) ? MP_ZPOS : n;
-081 \}
-082 LBL_ERR:
-083 mp_clear_multi(&ta, &tb, &tq, &q, NULL);
-084 return res;
-085 \}
-086
-087 #else
-088
-089 /* integer signed division.
-090 * c*b + d == a [e.g. a/b, c=quotient, d=remainder]
-091 * HAC pp.598 Algorithm 14.20
-092 *
-093 * Note that the description in HAC is horribly
-094 * incomplete. For example, it doesn't consider
-095 * the case where digits are removed from 'x' in
-096 * the inner loop. It also doesn't consider the
-097 * case that y has fewer than three digits, etc..
-098 *
-099 * The overall algorithm is as described as
-100 * 14.20 from HAC but fixed to treat these cases.
-101 */
-102 int mp_div (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
-103 \{
-104 mp_int q, x, y, t1, t2;
-105 int res, n, t, i, norm, neg;
-106
-107 /* is divisor zero ? */
-108 if (mp_iszero (b) == 1) \{
-109 return MP_VAL;
-110 \}
-111
-112 /* if a < b then q=0, r = a */
-113 if (mp_cmp_mag (a, b) == MP_LT) \{
-114 if (d != NULL) \{
-115 res = mp_copy (a, d);
-116 \} else \{
-117 res = MP_OKAY;
-118 \}
-119 if (c != NULL) \{
-120 mp_zero (c);
-121 \}
-122 return res;
-123 \}
-124
-125 if ((res = mp_init_size (&q, a->used + 2)) != MP_OKAY) \{
-126 return res;
-127 \}
-128 q.used = a->used + 2;
-129
-130 if ((res = mp_init (&t1)) != MP_OKAY) \{
-131 goto LBL_Q;
-132 \}
-133
-134 if ((res = mp_init (&t2)) != MP_OKAY) \{
-135 goto LBL_T1;
-136 \}
-137
-138 if ((res = mp_init_copy (&x, a)) != MP_OKAY) \{
-139 goto LBL_T2;
-140 \}
-141
-142 if ((res = mp_init_copy (&y, b)) != MP_OKAY) \{
-143 goto LBL_X;
-144 \}
-145
-146 /* fix the sign */
-147 neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
-148 x.sign = y.sign = MP_ZPOS;
-149
-150 /* normalize both x and y, ensure that y >= b/2, [b == 2**DIGIT_BIT] */
-151 norm = mp_count_bits(&y) % DIGIT_BIT;
-152 if (norm < (int)(DIGIT_BIT-1)) \{
-153 norm = (DIGIT_BIT-1) - norm;
-154 if ((res = mp_mul_2d (&x, norm, &x)) != MP_OKAY) \{
-155 goto LBL_Y;
-156 \}
-157 if ((res = mp_mul_2d (&y, norm, &y)) != MP_OKAY) \{
-158 goto LBL_Y;
-159 \}
-160 \} else \{
-161 norm = 0;
-162 \}
-163
-164 /* note hac does 0 based, so if used==5 then its 0,1,2,3,4, e.g. use 4 */
-165 n = x.used - 1;
-166 t = y.used - 1;
-167
-168 /* while (x >= y*b**n-t) do \{ q[n-t] += 1; x -= y*b**\{n-t\} \} */
-169 if ((res = mp_lshd (&y, n - t)) != MP_OKAY) \{ /* y = y*b**\{n-t\} */
-170 goto LBL_Y;
-171 \}
-172
-173 while (mp_cmp (&x, &y) != MP_LT) \{
-174 ++(q.dp[n - t]);
-175 if ((res = mp_sub (&x, &y, &x)) != MP_OKAY) \{
-176 goto LBL_Y;
-177 \}
-178 \}
-179
-180 /* reset y by shifting it back down */
-181 mp_rshd (&y, n - t);
-182
-183 /* step 3. for i from n down to (t + 1) */
-184 for (i = n; i >= (t + 1); i--) \{
-185 if (i > x.used) \{
-186 continue;
-187 \}
-188
-189 /* step 3.1 if xi == yt then set q\{i-t-1\} to b-1,
-190 * otherwise set q\{i-t-1\} to (xi*b + x\{i-1\})/yt */
-191 if (x.dp[i] == y.dp[t]) \{
-192 q.dp[i - t - 1] = ((((mp_digit)1) << DIGIT_BIT) - 1);
-193 \} else \{
-194 mp_word tmp;
-195 tmp = ((mp_word) x.dp[i]) << ((mp_word) DIGIT_BIT);
-196 tmp |= ((mp_word) x.dp[i - 1]);
-197 tmp /= ((mp_word) y.dp[t]);
-198 if (tmp > (mp_word) MP_MASK)
-199 tmp = MP_MASK;
-200 q.dp[i - t - 1] = (mp_digit) (tmp & (mp_word) (MP_MASK));
-201 \}
-202
-203 /* while (q\{i-t-1\} * (yt * b + y\{t-1\})) >
-204 xi * b**2 + xi-1 * b + xi-2
-205
-206 do q\{i-t-1\} -= 1;
-207 */
-208 q.dp[i - t - 1] = (q.dp[i - t - 1] + 1) & MP_MASK;
-209 do \{
-210 q.dp[i - t - 1] = (q.dp[i - t - 1] - 1) & MP_MASK;
-211
-212 /* find left hand */
-213 mp_zero (&t1);
-214 t1.dp[0] = (t - 1 < 0) ? 0 : y.dp[t - 1];
-215 t1.dp[1] = y.dp[t];
-216 t1.used = 2;
-217 if ((res = mp_mul_d (&t1, q.dp[i - t - 1], &t1)) != MP_OKAY) \{
-218 goto LBL_Y;
-219 \}
-220
-221 /* find right hand */
-222 t2.dp[0] = (i - 2 < 0) ? 0 : x.dp[i - 2];
-223 t2.dp[1] = (i - 1 < 0) ? 0 : x.dp[i - 1];
-224 t2.dp[2] = x.dp[i];
-225 t2.used = 3;
-226 \} while (mp_cmp_mag(&t1, &t2) == MP_GT);
-227
-228 /* step 3.3 x = x - q\{i-t-1\} * y * b**\{i-t-1\} */
-229 if ((res = mp_mul_d (&y, q.dp[i - t - 1], &t1)) != MP_OKAY) \{
-230 goto LBL_Y;
-231 \}
-232
-233 if ((res = mp_lshd (&t1, i - t - 1)) != MP_OKAY) \{
-234 goto LBL_Y;
-235 \}
-236
-237 if ((res = mp_sub (&x, &t1, &x)) != MP_OKAY) \{
-238 goto LBL_Y;
-239 \}
-240
-241 /* if x < 0 then \{ x = x + y*b**\{i-t-1\}; q\{i-t-1\} -= 1; \} */
-242 if (x.sign == MP_NEG) \{
-243 if ((res = mp_copy (&y, &t1)) != MP_OKAY) \{
-244 goto LBL_Y;
-245 \}
-246 if ((res = mp_lshd (&t1, i - t - 1)) != MP_OKAY) \{
-247 goto LBL_Y;
-248 \}
-249 if ((res = mp_add (&x, &t1, &x)) != MP_OKAY) \{
-250 goto LBL_Y;
-251 \}
-252
-253 q.dp[i - t - 1] = (q.dp[i - t - 1] - 1UL) & MP_MASK;
-254 \}
-255 \}
-256
-257 /* now q is the quotient and x is the remainder
-258 * [which we have to normalize]
-259 */
-260
-261 /* get sign before writing to c */
-262 x.sign = x.used == 0 ? MP_ZPOS : a->sign;
-263
-264 if (c != NULL) \{
-265 mp_clamp (&q);
-266 mp_exch (&q, c);
-267 c->sign = neg;
-268 \}
-269
-270 if (d != NULL) \{
-271 mp_div_2d (&x, norm, &x, NULL);
-272 mp_exch (&x, d);
-273 \}
-274
-275 res = MP_OKAY;
-276
-277 LBL_Y:mp_clear (&y);
-278 LBL_X:mp_clear (&x);
-279 LBL_T2:mp_clear (&t2);
-280 LBL_T1:mp_clear (&t1);
-281 LBL_Q:mp_clear (&q);
-282 return res;
-283 \}
-284
-285 #endif
-286
-287 #endif
-288
\end{alltt}
\end{small}
@@ -8728,23 +5496,23 @@ algorithm with only the quotient is
mp_div(&a, &b, &c, NULL); /* c = [a/b] */
\end{verbatim}
-Lines 37 and 44 handle the two trivial cases of inputs which are division by zero and dividend smaller than the divisor
-respectively. After the two trivial cases all of the temporary variables are initialized. Line 105 determines the sign of
-the quotient and line 76 ensures that both $x$ and $y$ are positive.
+Lines 109 and 113 handle the two trivial cases of inputs which are division by zero and dividend smaller than the divisor
+respectively. After the two trivial cases all of the temporary variables are initialized. Line 148 determines the sign of
+the quotient and line 148 ensures that both $x$ and $y$ are positive.
-The number of bits in the leading digit is calculated on line 105. Implictly an mp\_int with $r$ digits will require $lg(\beta)(r-1) + k$ bits
+The number of bits in the leading digit is calculated on line 151. Implictly an mp\_int with $r$ digits will require $lg(\beta)(r-1) + k$ bits
of precision which when reduced modulo $lg(\beta)$ produces the value of $k$. In this case $k$ is the number of bits in the leading digit which is
exactly what is required. For the algorithm to operate $k$ must equal $lg(\beta) - 1$ and when it does not the inputs must be normalized by shifting
them to the left by $lg(\beta) - 1 - k$ bits.
Throughout the variables $n$ and $t$ will represent the highest digit of $x$ and $y$ respectively. These are first used to produce the
-leading digit of the quotient. The loop beginning on line 183 will produce the remainder of the quotient digits.
+leading digit of the quotient. The loop beginning on line 184 will produce the remainder of the quotient digits.
-The conditional ``continue'' on line 114 is used to prevent the algorithm from reading past the leading edge of $x$ which can occur when the
+The conditional ``continue'' on line 187 is used to prevent the algorithm from reading past the leading edge of $x$ which can occur when the
algorithm eliminates multiple non-zero digits in a single iteration. This ensures that $x_i$ is always non-zero since by definition the digits
above the $i$'th position $x$ must be zero in order for the quotient to be precise\footnote{Precise as far as integer division is concerned.}.
-Lines 130, 130 and 134 through 134 manually construct the high accuracy estimations by setting the digits of the two mp\_int
+Lines 214, 216 and 223 through 225 manually construct the high accuracy estimations by setting the digits of the two mp\_int
variables directly.
\section{Single Digit Helpers}
@@ -8782,96 +5550,6 @@ This algorithm initiates a temporary mp\_int with the value of the single digit
\hspace{-5.1mm}{\bf File}: bn\_mp\_add\_d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* single digit addition */
-018 int
-019 mp_add_d (mp_int * a, mp_digit b, mp_int * c)
-020 \{
-021 int res, ix, oldused;
-022 mp_digit *tmpa, *tmpc, mu;
-023
-024 /* grow c as required */
-025 if (c->alloc < a->used + 1) \{
-026 if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) \{
-027 return res;
-028 \}
-029 \}
-030
-031 /* if a is negative and |a| >= b, call c = |a| - b */
-032 if (a->sign == MP_NEG && (a->used > 1 || a->dp[0] >= b)) \{
-033 /* temporarily fix sign of a */
-034 a->sign = MP_ZPOS;
-035
-036 /* c = |a| - b */
-037 res = mp_sub_d(a, b, c);
-038
-039 /* fix sign */
-040 a->sign = c->sign = MP_NEG;
-041
-042 return res;
-043 \}
-044
-045 /* old number of used digits in c */
-046 oldused = c->used;
-047
-048 /* sign always positive */
-049 c->sign = MP_ZPOS;
-050
-051 /* source alias */
-052 tmpa = a->dp;
-053
-054 /* destination alias */
-055 tmpc = c->dp;
-056
-057 /* if a is positive */
-058 if (a->sign == MP_ZPOS) \{
-059 /* add digit, after this we're propagating
-060 * the carry.
-061 */
-062 *tmpc = *tmpa++ + b;
-063 mu = *tmpc >> DIGIT_BIT;
-064 *tmpc++ &= MP_MASK;
-065
-066 /* now handle rest of the digits */
-067 for (ix = 1; ix < a->used; ix++) \{
-068 *tmpc = *tmpa++ + mu;
-069 mu = *tmpc >> DIGIT_BIT;
-070 *tmpc++ &= MP_MASK;
-071 \}
-072 /* set final carry */
-073 ix++;
-074 *tmpc++ = mu;
-075
-076 /* setup size */
-077 c->used = a->used + 1;
-078 \} else \{
-079 /* a was negative and |a| < b */
-080 c->used = 1;
-081
-082 /* the result is a single digit */
-083 if (a->used == 1) \{
-084 *tmpc++ = b - a->dp[0];
-085 \} else \{
-086 *tmpc++ = b;
-087 \}
-088
-089 /* setup count so the clearing of oldused
-090 * can fall through correctly
-091 */
-092 ix = 1;
-093 \}
-094
-095 /* now zero to oldused */
-096 while (ix++ < oldused) \{
-097 *tmpc++ = 0;
-098 \}
-099 mp_clamp(c);
-100
-101 return MP_OKAY;
-102 \}
-103
-104 #endif
-105
\end{alltt}
\end{small}
@@ -8922,66 +5600,6 @@ Unlike the full multiplication algorithms this algorithm does not require any si
\hspace{-5.1mm}{\bf File}: bn\_mp\_mul\_d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* multiply by a digit */
-018 int
-019 mp_mul_d (mp_int * a, mp_digit b, mp_int * c)
-020 \{
-021 mp_digit u, *tmpa, *tmpc;
-022 mp_word r;
-023 int ix, res, olduse;
-024
-025 /* make sure c is big enough to hold a*b */
-026 if (c->alloc < a->used + 1) \{
-027 if ((res = mp_grow (c, a->used + 1)) != MP_OKAY) \{
-028 return res;
-029 \}
-030 \}
-031
-032 /* get the original destinations used count */
-033 olduse = c->used;
-034
-035 /* set the sign */
-036 c->sign = a->sign;
-037
-038 /* alias for a->dp [source] */
-039 tmpa = a->dp;
-040
-041 /* alias for c->dp [dest] */
-042 tmpc = c->dp;
-043
-044 /* zero carry */
-045 u = 0;
-046
-047 /* compute columns */
-048 for (ix = 0; ix < a->used; ix++) \{
-049 /* compute product and carry sum for this term */
-050 r = ((mp_word) u) + ((mp_word)*tmpa++) * ((mp_word)b);
-051
-052 /* mask off higher bits to get a single digit */
-053 *tmpc++ = (mp_digit) (r & ((mp_word) MP_MASK));
-054
-055 /* send carry into next iteration */
-056 u = (mp_digit) (r >> ((mp_word) DIGIT_BIT));
-057 \}
-058
-059 /* store final carry [if any] and increment ix offset */
-060 *tmpc++ = u;
-061 ++ix;
-062
-063 /* now zero digits above the top */
-064 while (ix++ < olduse) \{
-065 *tmpc++ = 0;
-066 \}
-067
-068 /* set used count */
-069 c->used = a->used + 1;
-070 mp_clamp(c);
-071
-072 return MP_OKAY;
-073 \}
-074 #endif
-075
\end{alltt}
\end{small}
@@ -9037,104 +5655,13 @@ from chapter seven.
\hspace{-5.1mm}{\bf File}: bn\_mp\_div\_d.c
\vspace{-3mm}
\begin{alltt}
-016
-017 static int s_is_power_of_two(mp_digit b, int *p)
-018 \{
-019 int x;
-020
-021 for (x = 1; x < DIGIT_BIT; x++) \{
-022 if (b == (((mp_digit)1)<<x)) \{
-023 *p = x;
-024 return 1;
-025 \}
-026 \}
-027 return 0;
-028 \}
-029
-030 /* single digit division (based on routine from MPI) */
-031 int mp_div_d (mp_int * a, mp_digit b, mp_int * c, mp_digit * d)
-032 \{
-033 mp_int q;
-034 mp_word w;
-035 mp_digit t;
-036 int res, ix;
-037
-038 /* cannot divide by zero */
-039 if (b == 0) \{
-040 return MP_VAL;
-041 \}
-042
-043 /* quick outs */
-044 if (b == 1 || mp_iszero(a) == 1) \{
-045 if (d != NULL) \{
-046 *d = 0;
-047 \}
-048 if (c != NULL) \{
-049 return mp_copy(a, c);
-050 \}
-051 return MP_OKAY;
-052 \}
-053
-054 /* power of two ? */
-055 if (s_is_power_of_two(b, &ix) == 1) \{
-056 if (d != NULL) \{
-057 *d = a->dp[0] & ((((mp_digit)1)<<ix) - 1);
-058 \}
-059 if (c != NULL) \{
-060 return mp_div_2d(a, ix, c, NULL);
-061 \}
-062 return MP_OKAY;
-063 \}
-064
-065 #ifdef BN_MP_DIV_3_C
-066 /* three? */
-067 if (b == 3) \{
-068 return mp_div_3(a, c, d);
-069 \}
-070 #endif
-071
-072 /* no easy answer [c'est la vie]. Just division */
-073 if ((res = mp_init_size(&q, a->used)) != MP_OKAY) \{
-074 return res;
-075 \}
-076
-077 q.used = a->used;
-078 q.sign = a->sign;
-079 w = 0;
-080 for (ix = a->used - 1; ix >= 0; ix--) \{
-081 w = (w << ((mp_word)DIGIT_BIT)) | ((mp_word)a->dp[ix]);
-082
-083 if (w >= b) \{
-084 t = (mp_digit)(w / b);
-085 w -= ((mp_word)t) * ((mp_word)b);
-086 \} else \{
-087 t = 0;
-088 \}
-089 q.dp[ix] = (mp_digit)t;
-090 \}
-091
-092 if (d != NULL) \{
-093 *d = (mp_digit)w;
-094 \}
-095
-096 if (c != NULL) \{
-097 mp_clamp(&q);
-098 mp_exch(&q, c);
-099 \}
-100 mp_clear(&q);
-101
-102 return res;
-103 \}
-104
-105 #endif
-106
\end{alltt}
\end{small}
Like the implementation of algorithm mp\_div this algorithm allows either of the quotient or remainder to be passed as a \textbf{NULL} pointer to
indicate the respective value is not required. This allows a trivial single digit modular reduction algorithm, mp\_mod\_d to be created.
-The division and remainder on lines 43 and @45,%@ can be replaced often by a single division on most processors. For example, the 32-bit x86 based
+The division and remainder on lines 44 and @45,%@ can be replaced often by a single division on most processors. For example, the 32-bit x86 based
processors can divide a 64-bit quantity by a 32-bit quantity and produce the quotient and remainder simultaneously. Unfortunately the GCC
compiler does not recognize that optimization and will actually produce two function calls to find the quotient and remainder respectively.
@@ -9202,119 +5729,6 @@ root. Ideally this algorithm is meant to find the $n$'th root of an input where
\hspace{-5.1mm}{\bf File}: bn\_mp\_n\_root.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* find the n'th root of an integer
-018 *
-019 * Result found such that (c)**b <= a and (c+1)**b > a
-020 *
-021 * This algorithm uses Newton's approximation
-022 * x[i+1] = x[i] - f(x[i])/f'(x[i])
-023 * which will find the root in log(N) time where
-024 * each step involves a fair bit. This is not meant to
-025 * find huge roots [square and cube, etc].
-026 */
-027 int mp_n_root (mp_int * a, mp_digit b, mp_int * c)
-028 \{
-029 mp_int t1, t2, t3;
-030 int res, neg;
-031
-032 /* input must be positive if b is even */
-033 if ((b & 1) == 0 && a->sign == MP_NEG) \{
-034 return MP_VAL;
-035 \}
-036
-037 if ((res = mp_init (&t1)) != MP_OKAY) \{
-038 return res;
-039 \}
-040
-041 if ((res = mp_init (&t2)) != MP_OKAY) \{
-042 goto LBL_T1;
-043 \}
-044
-045 if ((res = mp_init (&t3)) != MP_OKAY) \{
-046 goto LBL_T2;
-047 \}
-048
-049 /* if a is negative fudge the sign but keep track */
-050 neg = a->sign;
-051 a->sign = MP_ZPOS;
-052
-053 /* t2 = 2 */
-054 mp_set (&t2, 2);
-055
-056 do \{
-057 /* t1 = t2 */
-058 if ((res = mp_copy (&t2, &t1)) != MP_OKAY) \{
-059 goto LBL_T3;
-060 \}
-061
-062 /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */
-063
-064 /* t3 = t1**(b-1) */
-065 if ((res = mp_expt_d (&t1, b - 1, &t3)) != MP_OKAY) \{
-066 goto LBL_T3;
-067 \}
-068
-069 /* numerator */
-070 /* t2 = t1**b */
-071 if ((res = mp_mul (&t3, &t1, &t2)) != MP_OKAY) \{
-072 goto LBL_T3;
-073 \}
-074
-075 /* t2 = t1**b - a */
-076 if ((res = mp_sub (&t2, a, &t2)) != MP_OKAY) \{
-077 goto LBL_T3;
-078 \}
-079
-080 /* denominator */
-081 /* t3 = t1**(b-1) * b */
-082 if ((res = mp_mul_d (&t3, b, &t3)) != MP_OKAY) \{
-083 goto LBL_T3;
-084 \}
-085
-086 /* t3 = (t1**b - a)/(b * t1**(b-1)) */
-087 if ((res = mp_div (&t2, &t3, &t3, NULL)) != MP_OKAY) \{
-088 goto LBL_T3;
-089 \}
-090
-091 if ((res = mp_sub (&t1, &t3, &t2)) != MP_OKAY) \{
-092 goto LBL_T3;
-093 \}
-094 \} while (mp_cmp (&t1, &t2) != MP_EQ);
-095
-096 /* result can be off by a few so check */
-097 for (;;) \{
-098 if ((res = mp_expt_d (&t1, b, &t2)) != MP_OKAY) \{
-099 goto LBL_T3;
-100 \}
-101
-102 if (mp_cmp (&t2, a) == MP_GT) \{
-103 if ((res = mp_sub_d (&t1, 1, &t1)) != MP_OKAY) \{
-104 goto LBL_T3;
-105 \}
-106 \} else \{
-107 break;
-108 \}
-109 \}
-110
-111 /* reset the sign of a first */
-112 a->sign = neg;
-113
-114 /* set the result */
-115 mp_exch (&t1, c);
-116
-117 /* set the sign of the result */
-118 c->sign = neg;
-119
-120 res = MP_OKAY;
-121
-122 LBL_T3:mp_clear (&t3);
-123 LBL_T2:mp_clear (&t2);
-124 LBL_T1:mp_clear (&t1);
-125 return res;
-126 \}
-127 #endif
-128
\end{alltt}
\end{small}
@@ -9356,42 +5770,6 @@ the integers from $0$ to $\beta - 1$.
\hspace{-5.1mm}{\bf File}: bn\_mp\_rand.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* makes a pseudo-random int of a given size */
-018 int
-019 mp_rand (mp_int * a, int digits)
-020 \{
-021 int res;
-022 mp_digit d;
-023
-024 mp_zero (a);
-025 if (digits <= 0) \{
-026 return MP_OKAY;
-027 \}
-028
-029 /* first place a random non-zero digit */
-030 do \{
-031 d = ((mp_digit) abs (rand ())) & MP_MASK;
-032 \} while (d == 0);
-033
-034 if ((res = mp_add_d (a, d, a)) != MP_OKAY) \{
-035 return res;
-036 \}
-037
-038 while (--digits > 0) \{
-039 if ((res = mp_lshd (a, 1)) != MP_OKAY) \{
-040 return res;
-041 \}
-042
-043 if ((res = mp_add_d (a, ((mp_digit) abs (rand ())), a)) != MP_OKAY) \{
-044 return res;
-045 \}
-046 \}
-047
-048 return MP_OKAY;
-049 \}
-050 #endif
-051
\end{alltt}
\end{small}
@@ -9474,69 +5852,6 @@ as part of larger input without any significant problem.
\hspace{-5.1mm}{\bf File}: bn\_mp\_read\_radix.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* read a string [ASCII] in a given radix */
-018 int mp_read_radix (mp_int * a, const char *str, int radix)
-019 \{
-020 int y, res, neg;
-021 char ch;
-022
-023 /* make sure the radix is ok */
-024 if (radix < 2 || radix > 64) \{
-025 return MP_VAL;
-026 \}
-027
-028 /* if the leading digit is a
-029 * minus set the sign to negative.
-030 */
-031 if (*str == '-') \{
-032 ++str;
-033 neg = MP_NEG;
-034 \} else \{
-035 neg = MP_ZPOS;
-036 \}
-037
-038 /* set the integer to the default of zero */
-039 mp_zero (a);
-040
-041 /* process each digit of the string */
-042 while (*str) \{
-043 /* if the radix < 36 the conversion is case insensitive
-044 * this allows numbers like 1AB and 1ab to represent the same value
-045 * [e.g. in hex]
-046 */
-047 ch = (char) ((radix < 36) ? toupper (*str) : *str);
-048 for (y = 0; y < 64; y++) \{
-049 if (ch == mp_s_rmap[y]) \{
-050 break;
-051 \}
-052 \}
-053
-054 /* if the char was found in the map
-055 * and is less than the given radix add it
-056 * to the number, otherwise exit the loop.
-057 */
-058 if (y < radix) \{
-059 if ((res = mp_mul_d (a, (mp_digit) radix, a)) != MP_OKAY) \{
-060 return res;
-061 \}
-062 if ((res = mp_add_d (a, (mp_digit) y, a)) != MP_OKAY) \{
-063 return res;
-064 \}
-065 \} else \{
-066 break;
-067 \}
-068 ++str;
-069 \}
-070
-071 /* set the sign only if a != 0 */
-072 if (mp_iszero(a) != 1) \{
-073 a->sign = neg;
-074 \}
-075 return MP_OKAY;
-076 \}
-077 #endif
-078
\end{alltt}
\end{small}
@@ -9601,62 +5916,6 @@ are required instead of a series of $n \times k$ divisions. One design flaw of
\hspace{-5.1mm}{\bf File}: bn\_mp\_toradix.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* stores a bignum as a ASCII string in a given radix (2..64) */
-018 int mp_toradix (mp_int * a, char *str, int radix)
-019 \{
-020 int res, digs;
-021 mp_int t;
-022 mp_digit d;
-023 char *_s = str;
-024
-025 /* check range of the radix */
-026 if (radix < 2 || radix > 64) \{
-027 return MP_VAL;
-028 \}
-029
-030 /* quick out if its zero */
-031 if (mp_iszero(a) == 1) \{
-032 *str++ = '0';
-033 *str = '\symbol{92}0';
-034 return MP_OKAY;
-035 \}
-036
-037 if ((res = mp_init_copy (&t, a)) != MP_OKAY) \{
-038 return res;
-039 \}
-040
-041 /* if it is negative output a - */
-042 if (t.sign == MP_NEG) \{
-043 ++_s;
-044 *str++ = '-';
-045 t.sign = MP_ZPOS;
-046 \}
-047
-048 digs = 0;
-049 while (mp_iszero (&t) == 0) \{
-050 if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) \{
-051 mp_clear (&t);
-052 return res;
-053 \}
-054 *str++ = mp_s_rmap[d];
-055 ++digs;
-056 \}
-057
-058 /* reverse the digits of the string. In this case _s points
-059 * to the first digit [exluding the sign] of the number]
-060 */
-061 bn_reverse ((unsigned char *)_s, digs);
-062
-063 /* append a NULL so the string is properly terminated */
-064 *str = '\symbol{92}0';
-065
-066 mp_clear (&t);
-067 return MP_OKAY;
-068 \}
-069
-070 #endif
-071
\end{alltt}
\end{small}
@@ -9786,33 +6045,30 @@ and will produce the greatest common divisor.
\textbf{Input}. mp\_int $a$ and $b$ \\
\textbf{Output}. The greatest common divisor $c = (a, b)$. \\
\hline \\
-1. If $a = 0$ and $b \ne 0$ then \\
-\hspace{3mm}1.1 $c \leftarrow b$ \\
+1. If $a = 0$ then \\
+\hspace{3mm}1.1 $c \leftarrow \vert b \vert $ \\
\hspace{3mm}1.2 Return(\textit{MP\_OKAY}). \\
-2. If $a \ne 0$ and $b = 0$ then \\
-\hspace{3mm}2.1 $c \leftarrow a$ \\
+2. If $b = 0$ then \\
+\hspace{3mm}2.1 $c \leftarrow \vert a \vert $ \\
\hspace{3mm}2.2 Return(\textit{MP\_OKAY}). \\
-3. If $a = b = 0$ then \\
-\hspace{3mm}3.1 $c \leftarrow 1$ \\
-\hspace{3mm}3.2 Return(\textit{MP\_OKAY}). \\
-4. $u \leftarrow \vert a \vert, v \leftarrow \vert b \vert$ \\
-5. $k \leftarrow 0$ \\
-6. While $u.used > 0$ and $v.used > 0$ and $u_0 \equiv v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}6.1 $k \leftarrow k + 1$ \\
-\hspace{3mm}6.2 $u \leftarrow \lfloor u / 2 \rfloor$ \\
-\hspace{3mm}6.3 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-7. While $u.used > 0$ and $u_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}7.1 $u \leftarrow \lfloor u / 2 \rfloor$ \\
-8. While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{3mm}8.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-9. While $v.used > 0$ \\
-\hspace{3mm}9.1 If $\vert u \vert > \vert v \vert$ then \\
-\hspace{6mm}9.1.1 Swap $u$ and $v$. \\
-\hspace{3mm}9.2 $v \leftarrow \vert v \vert - \vert u \vert$ \\
-\hspace{3mm}9.3 While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
-\hspace{6mm}9.3.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
-10. $c \leftarrow u \cdot 2^k$ \\
-11. Return(\textit{MP\_OKAY}). \\
+3. $u \leftarrow \vert a \vert, v \leftarrow \vert b \vert$ \\
+4. $k \leftarrow 0$ \\
+5. While $u.used > 0$ and $v.used > 0$ and $u_0 \equiv v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}5.1 $k \leftarrow k + 1$ \\
+\hspace{3mm}5.2 $u \leftarrow \lfloor u / 2 \rfloor$ \\
+\hspace{3mm}5.3 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+6. While $u.used > 0$ and $u_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}6.1 $u \leftarrow \lfloor u / 2 \rfloor$ \\
+7. While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{3mm}7.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+8. While $v.used > 0$ \\
+\hspace{3mm}8.1 If $\vert u \vert > \vert v \vert$ then \\
+\hspace{6mm}8.1.1 Swap $u$ and $v$. \\
+\hspace{3mm}8.2 $v \leftarrow \vert v \vert - \vert u \vert$ \\
+\hspace{3mm}8.3 While $v.used > 0$ and $v_0 \equiv 0 \mbox{ (mod }2\mbox{)}$ \\
+\hspace{6mm}8.3.1 $v \leftarrow \lfloor v / 2 \rfloor$ \\
+9. $c \leftarrow u \cdot 2^k$ \\
+10. Return(\textit{MP\_OKAY}). \\
\hline
\end{tabular}
\end{center}
@@ -9824,17 +6080,17 @@ This algorithm will produce the greatest common divisor of two mp\_ints $a$ and
Knuth \cite[pp. 338]{TAOCPV2} but has been modified to be simpler to explain. In theory it achieves the same asymptotic working time as
Algorithm B and in practice this appears to be true.
-The first three steps handle the cases where either one of or both inputs are zero. If either input is zero the greatest common divisor is the
+The first two steps handle the cases where either one of or both inputs are zero. If either input is zero the greatest common divisor is the
largest input or zero if they are both zero. If the inputs are not trivial than $u$ and $v$ are assigned the absolute values of
$a$ and $b$ respectively and the algorithm will proceed to reduce the pair.
-Step six will divide out any common factors of two and keep track of the count in the variable $k$. After this step two is no longer a
+Step five will divide out any common factors of two and keep track of the count in the variable $k$. After this step, two is no longer a
factor of the remaining greatest common divisor between $u$ and $v$ and can be safely evenly divided out of either whenever they are even. Step
-seven and eight ensure that the $u$ and $v$ respectively have no more factors of two. At most only one of the while loops will iterate since
+six and seven ensure that the $u$ and $v$ respectively have no more factors of two. At most only one of the while--loops will iterate since
they cannot both be even.
-By step nine both of $u$ and $v$ are odd which is required for the inner logic. First the pair are swapped such that $v$ is equal to
-or greater than $u$. This ensures that the subtraction on step 9.2 will always produce a positive and even result. Step 9.3 removes any
+By step eight both of $u$ and $v$ are odd which is required for the inner logic. First the pair are swapped such that $v$ is equal to
+or greater than $u$. This ensures that the subtraction on step 8.2 will always produce a positive and even result. Step 8.3 removes any
factors of two from the difference $u$ to ensure that in the next iteration of the loop both are once again odd.
After $v = 0$ occurs the variable $u$ has the greatest common divisor of the pair $\left < u, v \right >$ just after step six. The result
@@ -9844,117 +6100,23 @@ must be adjusted by multiplying by the common factors of two ($2^k$) removed ear
\hspace{-5.1mm}{\bf File}: bn\_mp\_gcd.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* Greatest Common Divisor using the binary method */
-018 int mp_gcd (mp_int * a, mp_int * b, mp_int * c)
-019 \{
-020 mp_int u, v;
-021 int k, u_lsb, v_lsb, res;
-022
-023 /* either zero than gcd is the largest */
-024 if (mp_iszero (a) == 1 && mp_iszero (b) == 0) \{
-025 return mp_abs (b, c);
-026 \}
-027 if (mp_iszero (a) == 0 && mp_iszero (b) == 1) \{
-028 return mp_abs (a, c);
-029 \}
-030
-031 /* optimized. At this point if a == 0 then
-032 * b must equal zero too
-033 */
-034 if (mp_iszero (a) == 1) \{
-035 mp_zero(c);
-036 return MP_OKAY;
-037 \}
-038
-039 /* get copies of a and b we can modify */
-040 if ((res = mp_init_copy (&u, a)) != MP_OKAY) \{
-041 return res;
-042 \}
-043
-044 if ((res = mp_init_copy (&v, b)) != MP_OKAY) \{
-045 goto LBL_U;
-046 \}
-047
-048 /* must be positive for the remainder of the algorithm */
-049 u.sign = v.sign = MP_ZPOS;
-050
-051 /* B1. Find the common power of two for u and v */
-052 u_lsb = mp_cnt_lsb(&u);
-053 v_lsb = mp_cnt_lsb(&v);
-054 k = MIN(u_lsb, v_lsb);
-055
-056 if (k > 0) \{
-057 /* divide the power of two out */
-058 if ((res = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) \{
-059 goto LBL_V;
-060 \}
-061
-062 if ((res = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) \{
-063 goto LBL_V;
-064 \}
-065 \}
-066
-067 /* divide any remaining factors of two out */
-068 if (u_lsb != k) \{
-069 if ((res = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) \{
-070 goto LBL_V;
-071 \}
-072 \}
-073
-074 if (v_lsb != k) \{
-075 if ((res = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) \{
-076 goto LBL_V;
-077 \}
-078 \}
-079
-080 while (mp_iszero(&v) == 0) \{
-081 /* make sure v is the largest */
-082 if (mp_cmp_mag(&u, &v) == MP_GT) \{
-083 /* swap u and v to make sure v is >= u */
-084 mp_exch(&u, &v);
-085 \}
-086
-087 /* subtract smallest from largest */
-088 if ((res = s_mp_sub(&v, &u, &v)) != MP_OKAY) \{
-089 goto LBL_V;
-090 \}
-091
-092 /* Divide out all factors of two */
-093 if ((res = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) \{
-094 goto LBL_V;
-095 \}
-096 \}
-097
-098 /* multiply by 2**k which we divided out at the beginning */
-099 if ((res = mp_mul_2d (&u, k, c)) != MP_OKAY) \{
-100 goto LBL_V;
-101 \}
-102 c->sign = MP_ZPOS;
-103 res = MP_OKAY;
-104 LBL_V:mp_clear (&u);
-105 LBL_U:mp_clear (&v);
-106 return res;
-107 \}
-108 #endif
-109
\end{alltt}
\end{small}
This function makes use of the macros mp\_iszero and mp\_iseven. The former evaluates to $1$ if the input mp\_int is equivalent to the
integer zero otherwise it evaluates to $0$. The latter evaluates to $1$ if the input mp\_int represents a non-zero even integer otherwise
it evaluates to $0$. Note that just because mp\_iseven may evaluate to $0$ does not mean the input is odd, it could also be zero. The three
-trivial cases of inputs are handled on lines 24 through 37. After those lines the inputs are assumed to be non-zero.
+trivial cases of inputs are handled on lines 24 through 30. After those lines the inputs are assumed to be non-zero.
-Lines 34 and 40 make local copies $u$ and $v$ of the inputs $a$ and $b$ respectively. At this point the common factors of two
-must be divided out of the two inputs. The while loop on line 80 iterates so long as both are even. The local integer $k$ is used to
-keep track of how many factors of $2$ are pulled out of both values. It is assumed that the number of factors will not exceed the maximum
-value of a C ``int'' data type\footnote{Strictly speaking no array in C may have more than entries than are accessible by an ``int'' so this is not
-a limitation.}.
+Lines 32 and 37 make local copies $u$ and $v$ of the inputs $a$ and $b$ respectively. At this point the common factors of two
+must be divided out of the two inputs. The block starting at line 44 removes common factors of two by first counting the number of trailing
+zero bits in both. The local integer $k$ is used to keep track of how many factors of $2$ are pulled out of both values. It is assumed that
+the number of factors will not exceed the maximum value of a C ``int'' data type\footnote{Strictly speaking no array in C may have more than
+entries than are accessible by an ``int'' so this is not a limitation.}.
-At this point there are no more common factors of two in the two values. The while loops on lines 80 and 80 remove any independent
-factors of two such that both $u$ and $v$ are guaranteed to be an odd integer before hitting the main body of the algorithm. The while loop
-on line 80 performs the reduction of the pair until $v$ is equal to zero. The unsigned comparison and subtraction algorithms are used in
+At this point there are no more common factors of two in the two values. The divisions by a power of two on lines 62 and 68 remove
+any independent factors of two such that both $u$ and $v$ are guaranteed to be an odd integer before hitting the main body of the algorithm. The while loop
+on line 73 performs the reduction of the pair until $v$ is equal to zero. The unsigned comparison and subtraction algorithms are used in
place of the full signed routines since both values are guaranteed to be positive and the result of the subtraction is guaranteed to be non-negative.
\section{Least Common Multiple}
@@ -9993,47 +6155,6 @@ dividing the product of the two inputs by their greatest common divisor.
\hspace{-5.1mm}{\bf File}: bn\_mp\_lcm.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes least common multiple as |a*b|/(a, b) */
-018 int mp_lcm (mp_int * a, mp_int * b, mp_int * c)
-019 \{
-020 int res;
-021 mp_int t1, t2;
-022
-023
-024 if ((res = mp_init_multi (&t1, &t2, NULL)) != MP_OKAY) \{
-025 return res;
-026 \}
-027
-028 /* t1 = get the GCD of the two inputs */
-029 if ((res = mp_gcd (a, b, &t1)) != MP_OKAY) \{
-030 goto LBL_T;
-031 \}
-032
-033 /* divide the smallest by the GCD */
-034 if (mp_cmp_mag(a, b) == MP_LT) \{
-035 /* store quotient in t2 such that t2 * b is the LCM */
-036 if ((res = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) \{
-037 goto LBL_T;
-038 \}
-039 res = mp_mul(b, &t2, c);
-040 \} else \{
-041 /* store quotient in t2 such that t2 * a is the LCM */
-042 if ((res = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) \{
-043 goto LBL_T;
-044 \}
-045 res = mp_mul(a, &t2, c);
-046 \}
-047
-048 /* fix the sign to positive */
-049 c->sign = MP_ZPOS;
-050
-051 LBL_T:
-052 mp_clear_multi (&t1, &t2, NULL);
-053 return res;
-054 \}
-055 #endif
-056
\end{alltt}
\end{small}
@@ -10193,92 +6314,6 @@ $\left ( {p' \over a'} \right )$ which is multiplied against the current Jacobi
\hspace{-5.1mm}{\bf File}: bn\_mp\_jacobi.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* computes the jacobi c = (a | n) (or Legendre if n is prime)
-018 * HAC pp. 73 Algorithm 2.149
-019 */
-020 int mp_jacobi (mp_int * a, mp_int * p, int *c)
-021 \{
-022 mp_int a1, p1;
-023 int k, s, r, res;
-024 mp_digit residue;
-025
-026 /* if p <= 0 return MP_VAL */
-027 if (mp_cmp_d(p, 0) != MP_GT) \{
-028 return MP_VAL;
-029 \}
-030
-031 /* step 1. if a == 0, return 0 */
-032 if (mp_iszero (a) == 1) \{
-033 *c = 0;
-034 return MP_OKAY;
-035 \}
-036
-037 /* step 2. if a == 1, return 1 */
-038 if (mp_cmp_d (a, 1) == MP_EQ) \{
-039 *c = 1;
-040 return MP_OKAY;
-041 \}
-042
-043 /* default */
-044 s = 0;
-045
-046 /* step 3. write a = a1 * 2**k */
-047 if ((res = mp_init_copy (&a1, a)) != MP_OKAY) \{
-048 return res;
-049 \}
-050
-051 if ((res = mp_init (&p1)) != MP_OKAY) \{
-052 goto LBL_A1;
-053 \}
-054
-055 /* divide out larger power of two */
-056 k = mp_cnt_lsb(&a1);
-057 if ((res = mp_div_2d(&a1, k, &a1, NULL)) != MP_OKAY) \{
-058 goto LBL_P1;
-059 \}
-060
-061 /* step 4. if e is even set s=1 */
-062 if ((k & 1) == 0) \{
-063 s = 1;
-064 \} else \{
-065 /* else set s=1 if p = 1/7 (mod 8) or s=-1 if p = 3/5 (mod 8) */
-066 residue = p->dp[0] & 7;
-067
-068 if (residue == 1 || residue == 7) \{
-069 s = 1;
-070 \} else if (residue == 3 || residue == 5) \{
-071 s = -1;
-072 \}
-073 \}
-074
-075 /* step 5. if p == 3 (mod 4) *and* a1 == 3 (mod 4) then s = -s */
-076 if ( ((p->dp[0] & 3) == 3) && ((a1.dp[0] & 3) == 3)) \{
-077 s = -s;
-078 \}
-079
-080 /* if a1 == 1 we're done */
-081 if (mp_cmp_d (&a1, 1) == MP_EQ) \{
-082 *c = s;
-083 \} else \{
-084 /* n1 = n mod a1 */
-085 if ((res = mp_mod (p, &a1, &p1)) != MP_OKAY) \{
-086 goto LBL_P1;
-087 \}
-088 if ((res = mp_jacobi (&p1, &a1, &r)) != MP_OKAY) \{
-089 goto LBL_P1;
-090 \}
-091 *c = s * r;
-092 \}
-093
-094 /* done */
-095 res = MP_OKAY;
-096 LBL_P1:mp_clear (&p1);
-097 LBL_A1:mp_clear (&a1);
-098 return res;
-099 \}
-100 #endif
-101
\end{alltt}
\end{small}
@@ -10293,9 +6328,9 @@ After a local copy of $a$ is made all of the factors of two are divided out and
bit of $k$ is required, however, it makes the algorithm simpler to follow to perform an addition. In practice an exclusive-or and addition have the same
processor requirements and neither is faster than the other.
-Line 61 through 70 determines the value of $\left ( { 2 \over p } \right )^k$. If the least significant bit of $k$ is zero than
+Line 58 through 71 determines the value of $\left ( { 2 \over p } \right )^k$. If the least significant bit of $k$ is zero than
$k$ is even and the value is one. Otherwise, the value of $s$ depends on which residue class $p$ belongs to modulo eight. The value of
-$(-1)^{(p-1)(a'-1)/4}$ is compute and multiplied against $s$ on lines 75 through 73.
+$(-1)^{(p-1)(a'-1)/4}$ is compute and multiplied against $s$ on lines 71 through 74.
Finally, if $a1$ does not equal one the algorithm must recurse and compute $\left ( {p' \over a'} \right )$.
@@ -10404,30 +6439,6 @@ then only a couple of additions or subtractions will be required to adjust the i
\hspace{-5.1mm}{\bf File}: bn\_mp\_invmod.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* hac 14.61, pp608 */
-018 int mp_invmod (mp_int * a, mp_int * b, mp_int * c)
-019 \{
-020 /* b cannot be negative */
-021 if (b->sign == MP_NEG || mp_iszero(b) == 1) \{
-022 return MP_VAL;
-023 \}
-024
-025 #ifdef BN_FAST_MP_INVMOD_C
-026 /* if the modulus is odd we can use a faster routine instead */
-027 if (mp_isodd (b) == 1) \{
-028 return fast_mp_invmod (a, b, c);
-029 \}
-030 #endif
-031
-032 #ifdef BN_MP_INVMOD_SLOW_C
-033 return mp_invmod_slow(a, b, c);
-034 #endif
-035
-036 return MP_VAL;
-037 \}
-038 #endif
-039
\end{alltt}
\end{small}
@@ -10499,37 +6510,6 @@ This algorithm attempts to determine if a candidate integer $n$ is composite by
\hspace{-5.1mm}{\bf File}: bn\_mp\_prime\_is\_divisible.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* determines if an integers is divisible by one
-018 * of the first PRIME_SIZE primes or not
-019 *
-020 * sets result to 0 if not, 1 if yes
-021 */
-022 int mp_prime_is_divisible (mp_int * a, int *result)
-023 \{
-024 int err, ix;
-025 mp_digit res;
-026
-027 /* default to not */
-028 *result = MP_NO;
-029
-030 for (ix = 0; ix < PRIME_SIZE; ix++) \{
-031 /* what is a mod LBL_prime_tab[ix] */
-032 if ((err = mp_mod_d (a, ltm_prime_tab[ix], &res)) != MP_OKAY) \{
-033 return err;
-034 \}
-035
-036 /* is the residue zero? */
-037 if (res == 0) \{
-038 *result = MP_YES;
-039 return MP_OKAY;
-040 \}
-041 \}
-042
-043 return MP_OKAY;
-044 \}
-045 #endif
-046
\end{alltt}
\end{small}
@@ -10540,48 +6520,6 @@ mp\_digit. The table \_\_prime\_tab is defined in the following file.
\hspace{-5.1mm}{\bf File}: bn\_prime\_tab.c
\vspace{-3mm}
\begin{alltt}
-016 const mp_digit ltm_prime_tab[] = \{
-017 0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
-018 0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035,
-019 0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059,
-020 0x0061, 0x0065, 0x0067, 0x006B, 0x006D, 0x0071, 0x007F,
-021 #ifndef MP_8BIT
-022 0x0083,
-023 0x0089, 0x008B, 0x0095, 0x0097, 0x009D, 0x00A3, 0x00A7, 0x00AD,
-024 0x00B3, 0x00B5, 0x00BF, 0x00C1, 0x00C5, 0x00C7, 0x00D3, 0x00DF,
-025 0x00E3, 0x00E5, 0x00E9, 0x00EF, 0x00F1, 0x00FB, 0x0101, 0x0107,
-026 0x010D, 0x010F, 0x0115, 0x0119, 0x011B, 0x0125, 0x0133, 0x0137,
-027
-028 0x0139, 0x013D, 0x014B, 0x0151, 0x015B, 0x015D, 0x0161, 0x0167,
-029 0x016F, 0x0175, 0x017B, 0x017F, 0x0185, 0x018D, 0x0191, 0x0199,
-030 0x01A3, 0x01A5, 0x01AF, 0x01B1, 0x01B7, 0x01BB, 0x01C1, 0x01C9,
-031 0x01CD, 0x01CF, 0x01D3, 0x01DF, 0x01E7, 0x01EB, 0x01F3, 0x01F7,
-032 0x01FD, 0x0209, 0x020B, 0x021D, 0x0223, 0x022D, 0x0233, 0x0239,
-033 0x023B, 0x0241, 0x024B, 0x0251, 0x0257, 0x0259, 0x025F, 0x0265,
-034 0x0269, 0x026B, 0x0277, 0x0281, 0x0283, 0x0287, 0x028D, 0x0293,
-035 0x0295, 0x02A1, 0x02A5, 0x02AB, 0x02B3, 0x02BD, 0x02C5, 0x02CF,
-036
-037 0x02D7, 0x02DD, 0x02E3, 0x02E7, 0x02EF, 0x02F5, 0x02F9, 0x0301,
-038 0x0305, 0x0313, 0x031D, 0x0329, 0x032B, 0x0335, 0x0337, 0x033B,
-039 0x033D, 0x0347, 0x0355, 0x0359, 0x035B, 0x035F, 0x036D, 0x0371,
-040 0x0373, 0x0377, 0x038B, 0x038F, 0x0397, 0x03A1, 0x03A9, 0x03AD,
-041 0x03B3, 0x03B9, 0x03C7, 0x03CB, 0x03D1, 0x03D7, 0x03DF, 0x03E5,
-042 0x03F1, 0x03F5, 0x03FB, 0x03FD, 0x0407, 0x0409, 0x040F, 0x0419,
-043 0x041B, 0x0425, 0x0427, 0x042D, 0x043F, 0x0443, 0x0445, 0x0449,
-044 0x044F, 0x0455, 0x045D, 0x0463, 0x0469, 0x047F, 0x0481, 0x048B,
-045
-046 0x0493, 0x049D, 0x04A3, 0x04A9, 0x04B1, 0x04BD, 0x04C1, 0x04C7,
-047 0x04CD, 0x04CF, 0x04D5, 0x04E1, 0x04EB, 0x04FD, 0x04FF, 0x0503,
-048 0x0509, 0x050B, 0x0511, 0x0515, 0x0517, 0x051B, 0x0527, 0x0529,
-049 0x052F, 0x0551, 0x0557, 0x055D, 0x0565, 0x0577, 0x0581, 0x058F,
-050 0x0593, 0x0595, 0x0599, 0x059F, 0x05A7, 0x05AB, 0x05AD, 0x05B3,
-051 0x05BF, 0x05C9, 0x05CB, 0x05CF, 0x05D1, 0x05D5, 0x05DB, 0x05E7,
-052 0x05F3, 0x05FB, 0x0607, 0x060D, 0x0611, 0x0617, 0x061F, 0x0623,
-053 0x062B, 0x062F, 0x063D, 0x0641, 0x0647, 0x0649, 0x064D, 0x0653
-054 #endif
-055 \};
-056 #endif
-057
\end{alltt}
\end{small}
@@ -10628,49 +6566,6 @@ determine the result.
\hspace{-5.1mm}{\bf File}: bn\_mp\_prime\_fermat.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* performs one Fermat test.
-018 *
-019 * If "a" were prime then b**a == b (mod a) since the order of
-020 * the multiplicative sub-group would be phi(a) = a-1. That means
-021 * it would be the same as b**(a mod (a-1)) == b**1 == b (mod a).
-022 *
-023 * Sets result to 1 if the congruence holds, or zero otherwise.
-024 */
-025 int mp_prime_fermat (mp_int * a, mp_int * b, int *result)
-026 \{
-027 mp_int t;
-028 int err;
-029
-030 /* default to composite */
-031 *result = MP_NO;
-032
-033 /* ensure b > 1 */
-034 if (mp_cmp_d(b, 1) != MP_GT) \{
-035 return MP_VAL;
-036 \}
-037
-038 /* init t */
-039 if ((err = mp_init (&t)) != MP_OKAY) \{
-040 return err;
-041 \}
-042
-043 /* compute t = b**a mod a */
-044 if ((err = mp_exptmod (b, a, a, &t)) != MP_OKAY) \{
-045 goto LBL_T;
-046 \}
-047
-048 /* is it equal to b? */
-049 if (mp_cmp (&t, b) == MP_EQ) \{
-050 *result = MP_YES;
-051 \}
-052
-053 err = MP_OKAY;
-054 LBL_T:mp_clear (&t);
-055 return err;
-056 \}
-057 #endif
-058
\end{alltt}
\end{small}
@@ -10723,90 +6618,6 @@ composite then it is \textit{probably} prime.
\hspace{-5.1mm}{\bf File}: bn\_mp\_prime\_miller\_rabin.c
\vspace{-3mm}
\begin{alltt}
-016
-017 /* Miller-Rabin test of "a" to the base of "b" as described in
-018 * HAC pp. 139 Algorithm 4.24
-019 *
-020 * Sets result to 0 if definitely composite or 1 if probably prime.
-021 * Randomly the chance of error is no more than 1/4 and often
-022 * very much lower.
-023 */
-024 int mp_prime_miller_rabin (mp_int * a, mp_int * b, int *result)
-025 \{
-026 mp_int n1, y, r;
-027 int s, j, err;
-028
-029 /* default */
-030 *result = MP_NO;
-031
-032 /* ensure b > 1 */
-033 if (mp_cmp_d(b, 1) != MP_GT) \{
-034 return MP_VAL;
-035 \}
-036
-037 /* get n1 = a - 1 */
-038 if ((err = mp_init_copy (&n1, a)) != MP_OKAY) \{
-039 return err;
-040 \}
-041 if ((err = mp_sub_d (&n1, 1, &n1)) != MP_OKAY) \{
-042 goto LBL_N1;
-043 \}
-044
-045 /* set 2**s * r = n1 */
-046 if ((err = mp_init_copy (&r, &n1)) != MP_OKAY) \{
-047 goto LBL_N1;
-048 \}
-049
-050 /* count the number of least significant bits
-051 * which are zero
-052 */
-053 s = mp_cnt_lsb(&r);
-054
-055 /* now divide n - 1 by 2**s */
-056 if ((err = mp_div_2d (&r, s, &r, NULL)) != MP_OKAY) \{
-057 goto LBL_R;
-058 \}
-059
-060 /* compute y = b**r mod a */
-061 if ((err = mp_init (&y)) != MP_OKAY) \{
-062 goto LBL_R;
-063 \}
-064 if ((err = mp_exptmod (b, &r, a, &y)) != MP_OKAY) \{
-065 goto LBL_Y;
-066 \}
-067
-068 /* if y != 1 and y != n1 do */
-069 if (mp_cmp_d (&y, 1) != MP_EQ && mp_cmp (&y, &n1) != MP_EQ) \{
-070 j = 1;
-071 /* while j <= s-1 and y != n1 */
-072 while ((j <= (s - 1)) && mp_cmp (&y, &n1) != MP_EQ) \{
-073 if ((err = mp_sqrmod (&y, a, &y)) != MP_OKAY) \{
-074 goto LBL_Y;
-075 \}
-076
-077 /* if y == 1 then composite */
-078 if (mp_cmp_d (&y, 1) == MP_EQ) \{
-079 goto LBL_Y;
-080 \}
-081
-082 ++j;
-083 \}
-084
-085 /* if y != n1 then composite */
-086 if (mp_cmp (&y, &n1) != MP_EQ) \{
-087 goto LBL_Y;
-088 \}
-089 \}
-090
-091 /* probably prime now */
-092 *result = MP_YES;
-093 LBL_Y:mp_clear (&y);
-094 LBL_R:mp_clear (&r);
-095 LBL_N1:mp_clear (&n1);
-096 return err;
-097 \}
-098 #endif
-099
\end{alltt}
\end{small}
diff --git a/libtommath/tommath_class.h b/libtommath/tommath_class.h
index 29e36fc..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.1.1.3 $ */
-/* $Date: 2005/09/26 16:32:16 $ */
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/license.terms b/license.terms
index f1dcaa5..164d65e 100644
--- a/license.terms
+++ b/license.terms
@@ -34,7 +34,7 @@ Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
-252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.
diff --git a/macosx/Makefile b/macosx/GNUmakefile
index 7195e77..d7b0d1d 100644
--- a/macosx/Makefile
+++ b/macosx/GNUmakefile
@@ -4,8 +4,10 @@
# uses the standard unix build system in tcl/unix (which can be used directly instead of this
# if you are not using the tk/macosx projects).
#
-# RCS: @(#) $Id: Makefile,v 1.22 2005/06/03 08:52:16 das Exp $
+# Copyright (c) 2002-2008 Daniel A. Steffen <das@users.sourceforge.net>
#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
########################################################################################################
#-------------------------------------------------------------------------------------------------------
@@ -18,8 +20,8 @@ BUILD_DIR ?= ${CURDIR}/../../build
SYMROOT ?= ${BUILD_DIR}/${PROJECT}
OBJROOT ?= ${SYMROOT}
-EXTRA_CONFIGURE_ARGS ?=
-EXTRA_MAKE_ARGS ?=
+EXTRA_CONFIGURE_ARGS ?=
+EXTRA_MAKE_ARGS ?=
INSTALL_PATH ?= /Library/Frameworks
PREFIX ?= /usr/local
@@ -28,12 +30,12 @@ LIBDIR ?= ${INSTALL_PATH}
MANDIR ?= ${PREFIX}/man
# set to non-empty value to install manpages in addition to html help:
-INSTALL_MANPAGES ?=
+INSTALL_MANPAGES ?=
#-------------------------------------------------------------------------------------------------------
# meta targets
-meta := all install embedded install-embedded clean distclean test
+meta := all install embedded install-embedded clean distclean test
styles := develop deploy
@@ -69,13 +71,17 @@ BUILD_STYLE =
CONFIGURE_ARGS =
OBJ_DIR = ${OBJROOT}/${BUILD_STYLE}
+empty :=
+space := ${empty} ${empty}
+objdir = $(subst ${space},\ ,${OBJ_DIR})
+
develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols
deploy_make_args := BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \
- GENERIC_FLAGS=-DNDEBUG
+ EXTRA_CFLAGS=-DNDEBUG
embedded_make_args := EMBEDDED_BUILD=1
install_make_args := INSTALL_BUILD=1
-${targets}:
+${targets}:
${MAKE} ${action}${PROJECT} \
$(foreach s,${styles} embedded install,$(if $(findstring $s,$@),${${s}_make_args}))
@@ -89,10 +95,9 @@ UNIX_DIR := ${CURDIR}/../unix
VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in)
TCLSH := tclsh${VERSION}
-BUILD_TARGET := tclsh tcltest
+BUILD_TARGET := all tcltest
INSTALL_TARGET := install
-override GENERIC_FLAGS := ${GENERIC_FLAGS} -DTCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
export CPPROG := cp -p
INSTALL_TARGETS = install-binaries install-libraries
@@ -100,7 +105,7 @@ ifeq (${EMBEDDED_BUILD},)
INSTALL_TARGETS += install-private-headers
endif
ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment)
-INSTALL_TARGETS += html-tcl
+INSTALL_TARGETS += install-packages html-tcl
ifneq (${INSTALL_MANPAGES},)
INSTALL_TARGETS += install-doc
endif
@@ -109,33 +114,37 @@ endif
MAKE_VARS := INSTALL_ROOT INSTALL_TARGETS VERSION GENERIC_FLAGS
MAKE_ARGS_V = $(foreach v,${MAKE_VARS},$v='${$v}')
-build-${PROJECT}: target = ${TARGET}
+build-${PROJECT}: target = ${BUILD_TARGET}
install-${PROJECT}: target = ${INSTALL_TARGET}
clean-${PROJECT} distclean-${PROJECT} test-${PROJECT}: \
target = $*
-DO_MAKE = +${MAKE} -C ${OBJ_DIR} ${target} ${MAKE_ARGS_V} ${MAKE_ARGS} ${EXTRA_MAKE_ARGS}
+DO_MAKE = +${MAKE} -C "${OBJ_DIR}" ${target} ${MAKE_ARGS_V} ${MAKE_ARGS} ${EXTRA_MAKE_ARGS}
#-------------------------------------------------------------------------------------------------------
# build rules
${PROJECT}:
- ${MAKE} install-${PROJECT} INSTALL_ROOT=${OBJ_DIR}/
+ ${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/"
-${OBJ_DIR}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure
- mkdir -p ${OBJ_DIR} && cd ${OBJ_DIR} && ${UNIX_DIR}/configure -C \
- --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} \
- --mandir=${MANDIR} --enable-threads --enable-framework \
- ${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}
+${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
+ ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in
+ mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
+ if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
+ --prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
+ --mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \
+ ${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi
-build-${PROJECT}: ${OBJ_DIR}/Makefile
+build-${PROJECT}: ${objdir}/Makefile
${DO_MAKE}
+ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'
# into building Tcl.framework and tclsh in ${SYMROOT}
- @cd ${OBJ_DIR} && mkdir -p $(dir ./${LIBDIR}) $(dir ./${BINDIR}) ${SYMROOT} && \
- rm -f ./${LIBDIR} ./${BINDIR} && ln -fs ${SYMROOT} ./${LIBDIR} && \
- ln -fs ${SYMROOT} ./${BINDIR} && ln -fs ${OBJ_DIR}/tcltest ${SYMROOT}
+ @cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,./${LIBDIR})) $(dir $(subst ${space},\ ,./${BINDIR})) "${SYMROOT}" && \
+ rm -f "./${LIBDIR}" "./${BINDIR}" && ln -fs "${SYMROOT}" "./${LIBDIR}" && \
+ ln -fs "${SYMROOT}" "./${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}"
+endif
install-${PROJECT}: build-${PROJECT}
ifeq (${EMBEDDED_BUILD}_${INSTALL_ROOT},1_)
@@ -151,16 +160,19 @@ ifeq (${EMBEDDED_BUILD},1)
@rm -f "${INSTALL_ROOT}${BINDIR}/${TCLSH}" && \
rmdir -p "${INSTALL_ROOT}${BINDIR}" 2>&- || true
else
-# redo prebinding
- @cd ${INSTALL_ROOT}/ && \
+# redo prebinding (when not building for Mac OS X 10.4 or later only)
+ @if [ "`echo "$${MACOSX_DEPLOYMENT_TARGET}" | \
+ awk -F '10\\.' '{print int($$2)}'`" -lt 4 -a "`echo "$${CFLAGS}" | \
+ awk -F '-mmacosx-version-min=10\\.' '{print int($$2)}'`" -lt 4 ]; \
+ then cd ${INSTALL_ROOT}/; \
if [ ! -d usr/lib ]; then mkdir -p usr && ln -fs /usr/lib usr/ && RM_USRLIB=1; fi; \
if [ ! -d System ]; then ln -fs /System . && RM_SYSTEM=1; fi; \
redo_prebinding -r . "./${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}/${PRODUCT_NAME}"; \
redo_prebinding -r . "./${BINDIR}/${TCLSH}"; \
if [ -n "$${RM_USRLIB:-}" ]; then rm -f usr/lib; rmdir -p usr 2>&-; fi; \
- if [ -n "$${RM_SYSTEM:-}" ]; then rm -f System; fi
+ if [ -n "$${RM_SYSTEM:-}" ]; then rm -f System; fi; fi
# install tclsh symbolic link
- @ln -fs ${TCLSH} ${INSTALL_ROOT}${BINDIR}/tclsh
+ @ln -fs ${TCLSH} "${INSTALL_ROOT}${BINDIR}/tclsh"
endif
endif
ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_)
@@ -168,21 +180,21 @@ ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_)
# Deployment build can be installed on top
# of Development build without overwriting
# the debug library
- @cd ${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION} && \
+ @cd "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}" && \
ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug"
endif
clean-${PROJECT}: %-${PROJECT}:
${DO_MAKE}
- rm -rf ${SYMROOT}/{${PRODUCT_NAME}.framework,${TCLSH},tcltest}
- rm -f ${OBJ_DIR}{${LIBDIR},${BINDIR}} && \
- rmdir -p ${OBJ_DIR}$(dir ${LIBDIR}) 2>&- || true && \
- rmdir -p ${OBJ_DIR}$(dir ${BINDIR}) 2>&- || true
+ rm -rf "${SYMROOT}"/{${PRODUCT_NAME}.framework,${TCLSH},tcltest}
+ rm -f "${OBJ_DIR}"{"${LIBDIR}","${BINDIR}"} && \
+ rmdir -p "${OBJ_DIR}"$(dir $(subst ${space},\ ,${LIBDIR})) 2>&- || true && \
+ rmdir -p "${OBJ_DIR}"$(dir $(subst ${space},\ ,${BINDIR})) 2>&- || true
distclean-${PROJECT}: %-${PROJECT}: clean-${PROJECT}
${DO_MAKE}
- rm -rf ${OBJ_DIR}
-
+ rm -rf "${OBJ_DIR}"
+
test-${PROJECT}: %-${PROJECT}: build-${PROJECT}
${DO_MAKE}
diff --git a/macosx/README b/macosx/README
index 17554ac..bcffde3 100644
--- a/macosx/README
+++ b/macosx/README
@@ -1,122 +1,174 @@
-Tcl MacOSX README
------------------
+Tcl Mac OS X README
+-------------------
-RCS: @(#) $Id: README,v 1.5 2005/05/23 20:21:02 das Exp $
+This is the README file for the Mac OS X/Darwin version of Tcl.
-This is the README file for the Mac OS X native version of Tcl (framework build).
+1. Where to go for support
+--------------------------
-1. General
-----------
-
-- The tcl-mac mailing list on sourceforge is the canonical place for questions
+- The tcl-mac mailing list on sourceforge is the best place to ask questions
specific to Tcl & Tk on Mac OS X:
http://lists.sourceforge.net/lists/listinfo/tcl-mac
(this page also has a link to searchable archives of the list, please check them
before asking on the list, many questions have already been answered).
-- For general tcl/tk questions, the newsgroup comp.lang.tcl is your best bet,
-but also check the Tcl'ers Wiki for a wealth of information:
- http://wiki.tcl.tk/
-
-- The wiki has a page listing known bugs in Mac OS X Tcl/Tk (and other tips)
- http://wiki.tcl.tk/MacOS%20X
-as well as a page with info on building Tcl/Tk on Mac OS X
- http://wiki.tcl.tk/Steps%20to%20build%20Tcl/Tk%208.4.0%20on%20MacOS%20X
+- For general Tcl/Tk questions, the newsgroup comp.lang.tcl is your best bet:
+ http://groups.google.com/group/comp.lang.tcl/
-- You should report bugs to the sourceforge bug trackers as usual:
- Tcl: https://sourceforge.net/tracker/?func=add&group_id=10894&atid=110894
- Tk: https://sourceforge.net/tracker/?func=add&group_id=12997&atid=112997
-please make sure that your report Tk specific bugs to the tktoolkit bug
-tracker and not the tcl one.
+- The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see
+ http://wiki.tcl.tk/_/ref?N=3753
+ http://wiki.tcl.tk/_/ref?N=8361
+- Please report bugs with Tcl on Mac OS X to the tracker:
+ http://core.tcl.tk/tcl/reportlist
-2. Using Tcl on MacOSX
-----------------------
+2. Using Tcl on Mac OS X
+------------------------
-- Mac OS X 10.2 (or higher) is required to run Tcl on MacOSX.
+- At a minimum, Mac OS X 10.3 is required to run Tcl.
-- Tcl built on Mac OS X 10.3 or higher will not run on 10.2 due to missing
-symbols in libSystem, however Tcl built on 10.2 will run on 10.3 (but without
-prebinding and other optimizations).
+- Unless weak-linking is used, Tcl built on Mac OS X 10.x will not run on 10.y
+with y < x; on the other hand Tcl built on 10.y will always run on 10.x with
+y <= x (but without any of the fixes and optimizations that would be available
+in a binary built on 10.x).
+Weak-linking is available on OS X 10.2 or later, it additionally allows Tcl
+built on 10.x to run on any 10.y with x > y >= z (for a chosen z >= 2).
-- Tcl extensions will be found in any of:
- $HOME/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl
- $HOME/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks
- /System/Library/Frameworks (searched in that order).
+- Tcl extensions can be installed in any of:
+ $HOME/Library/Tcl /Library/Tcl /System/Library/Tcl
+ $HOME/Library/Frameworks /Library/Frameworks /System/Library/Frameworks
+ (searched in that order).
Given a potential package directory $pkg, Tcl on OSX checks for the file
$pkg/Resources/Scripts/pkgIndex.tcl as well as the usual $pkg/pkgIndex.tcl.
-This allows building extensions as frameworks with all script files contained
-in the Resources/Scripts directory of the framework.
+This allows building extensions as frameworks with all script files contained in
+the Resources/Scripts directory of the framework.
-- The Tcl framework contains documentation in html format in the
-standard location for frameworks:
+- [load]able binary extensions can linked as either ordinary shared libraries
+(.dylib) or as MachO bundles (since 8.4.10/8.5a3); bundles have the advantage
+that they are [load]ed more efficiently from a tcl VFS (no temporary copy to the
+native filesystem required), and prior to Mac OS X 10.5, only bundles can be
+[unload]ed.
+
+- The 'deploy' target of macosx/GNUmakefile installs the html manpages into the
+standard documentation location in the Tcl framework:
Tcl.framework/Resources/Documentation/Reference/Tcl
-No manpages are installed by default.
+No nroff manpages are installed by default by the GNUmakefile.
-- the framework Tcl.framework can be placed in any of the system's standard
+- The Tcl framework can be installed in any of the system's standard
framework directories:
- $HOME/Library/Frameworks /Library/Frameworks
- /Network/Library/Frameworks /System/Library/Frameworks
-and /usr/bin/tclsh will work.
-
-- the format of binary extensions expected by [load] is that of ordinary shared
-libraries (.dylib) and not MachO bundles, at present loading of MachO bundles is
-not supported.
-
-
-3. Building Tcl.framework
--------------------------
-
-- Mac OS X 10.2 (or higher) is required to build Tcl on MacOSX.
-
-- Apple's Developer Tools CD needs to be installed (the most recent version
-matching your OS release, but no earlier than December 2002). This CD should
-have come with Mac OS X retail or should be present as a disk image on new macs
-that came with OSX preinstalled. It can also be downloaded from
-http://connect.apple.com (after you register for free ADC membership).
-
-- Tcl is built as a Mac OS X framework via the Makefile in tcl/macosx, but can
-but can also be built directly with the standard unix configure and make
-buildsystem in tcl/unix.
-
-- It is still possible to build with Apple's Xcode IDE using the Tcl.pbproj
-project but this is not recommended anymore (currently Tcl.pbproj calls through
-to the tcl/macosx/Makefile so there should be no build differences).
-
-- Unpack the tcl source release archive.
-
-- The following instructions assume the tcl source tree is named "tcl${ver}",
-where ${ver} is a shell variable containing the tcl version number (for
-example '8.4.2').
-Setup the shell variable as follows:
- set ver="8.4.2" ;: if your shell is csh
- ver="8.4.2" ;: if your shell is sh
-The source tree will be named this way only if you are building from a release
-archive, if you are building from CVS, the version numbers will be missing; so
-set ${ver} to the empty string instead:
- set ver="" ;: if your shell is csh
- ver="" ;: if your shell is sh
-
-- The following steps will build Tcl from the Terminal, assuming you are
-located in the directory containing the tcl source tree:
+ $HOME/Library/Frameworks /Library/Frameworks /System/Library/Frameworks
+
+
+3. Building Tcl on Mac OS X
+---------------------------
+
+- At least Mac OS X 10.3 is required to build Tcl.
+Apple's Xcode Developer Tools need to be installed (only the most recent version
+matching your OS release is supported), the Xcode installer is available on Mac
+OS X install media or may be present in /Applications/Installers on Macs that
+came with OS X preinstalled. The most recent version can always be downloaded
+from the ADC website http://connect.apple.com (free ADC membership required).
+
+- Tcl is most easily built as a Mac OS X framework via GNUmakefile in tcl/macosx
+(see below for details), but can also be built with the standard unix configure
+and make buildsystem in tcl/unix as on any other unix platform (indeed, the
+GNUmakefile is just a wrapper around the unix buildsystem).
+The Mac OS X specific configure flags are --enable-framework and
+--disable-corefoundation (which disables CF and notably reverts to the standard
+select based notifier).
+
+- It is also possible to build with the Xcode IDE via the projects in
+tcl/macosx, take care to use the project matching your DevTools and OS version:
+ Tcl.xcode: for Xcode 3.1 on 10.5
+ Tcl.xcodeproj: for Xcode 3.2 on 10.6
+These have the following targets:
+ Tcl: calls through to tcl/macosx/GNUMakefile.
+ tcltest: static build of tcltest for debugging.
+ tests: build tcltest target and run tcl testsuite.
+The following build configurations are available:
+ Debug: debug build for the active architecture,
+ with Fix & Continue enabled.
+ Debug clang: use clang compiler.
+ Debug llvm-gcc: use llvm-gcc compiler.
+ Debug gcc40: use gcc 4.0 compiler.
+ DebugNoFixAndContinue: disable Fix & Continue.
+ DebugUnthreaded: disable threading.
+ DebugNoCF: disable corefoundation.
+ DebugNoCFUnthreaded: disable corefoundation an threading.
+ DebugMemCompile: enable memory and bytecode debugging.
+ DebugLeaks: define PURIFY.
+ DebugGCov: enable generation of gcov data files.
+ Debug64bit: configure with --enable-64bit (requires
+ building on a 64bit capable processor).
+ Release: release build for the active architecture.
+ ReleaseUniversal: 32/64-bit universal build.
+ ReleaseUniversal clang: use clang compiler.
+ ReleaseUniversal llvm-gcc: use llvm-gcc compiler.
+ ReleaseUniversal gcc40: use gcc 4.0 compiler.
+ ReleaseUniversal10.5SDK: build against the 10.5 SDK (with 10.5
+ deployment target).
+ Note that the non-SDK configurations have their deployment target set to
+ 10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj).
+The Xcode projects refer to the toplevel tcl source directory via the
+TCL_SRCROOT user build setting, by default this is set to the project-relative
+path '../../tcl', if your tcl source directory is named differently, e.g.
+'../../tcl8.6', you need to manually change the TCL_SRCROOT setting by editing
+your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
+with a text editor.
+
+- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
+ export CFLAGS="-arch i386 -arch x86_64 -arch ppc"
+This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is
+omitted, but _not_ Xcode 2.1) and will work on any architecture (on PowerPC
+Tiger you need to add "-isysroot /Developer/SDKs/MacOSX10.4u.sdk").
+Note that configure requires CFLAGS to contain a least one architecture that can
+be run on the build machine (i.e. ppc on G3/G4, ppc or ppc64 on G5, ppc or i386
+on Core and ppc, i386 or x86_64 on Core2/Xeon).
+Universal builds of Tcl TEA extensions are also possible with CFLAGS set as
+above, they will be [load]able by universal as well as thin binaries of Tcl.
+
+- To enable weak-linking, set the MACOSX_DEPLOYMENT_TARGET environment variable
+to the minimal OS version the binaries should be able to run on, e.g:
+ export MACOSX_DEPLOYMENT_TARGET=10.4
+This requires at least gcc 3.1; with gcc 4 or later, set/add to CFLAGS instead:
+ export CFLAGS="-mmacosx-version-min=10.4"
+Support for weak-linking was added with 8.4.14/8.5a5.
+
+Detailed Instructions for building with macosx/GNUmakefile
+----------------------------------------------------------
+
+- Unpack the Tcl source release archive.
+
+- The following instructions assume the Tcl source tree is named "tcl${ver}",
+(where ${ver} is a shell variable containing the Tcl version number e.g. '8.6').
+Setup this shell variable as follows:
+ ver="8.6"
+If you are building from CVS, omit this step (CVS source tree names usually do
+not contain a version number).
+
+- Setup environment variables as desired, e.g. for a universal build on 10.5:
+ CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5"
+ export CFLAGS
+
+- Change to the directory containing the Tcl source tree and build:
make -C tcl${ver}/macosx
-and the following will then install Tcl onto the root volume (admin password
-required):
+
+- Install Tcl onto the root volume (admin password required):
sudo make -C tcl${ver}/macosx install
-if you don't have the admin password, you can install into your home directory,
+if you don't have an admin password, you can install into your home directory
instead by passing an INSTALL_ROOT argument to make:
make -C tcl${ver}/macosx install INSTALL_ROOT="${HOME}/"
-- The default Makefile targets will build _both_ debug and optimized versions of
-the Tcl framework with the standard convention of naming the debug
-library Tcl.framework/Tcl_debug.
-This allows you to dynamically link to the debug libraries at runtime by setting
- setenv DYLD_IMAGE_SUFFIX _debug
+- The default GNUmakefile targets will build _both_ debug and optimized versions
+of the Tcl framework with the standard convention of naming the debug library
+Tcl.framework/Tcl_debug.
+This allows switching to the debug libraries at runtime by setting
+ export DYLD_IMAGE_SUFFIX=_debug
(c.f. man dyld for more details)
If you only want to build and install the debug or optimized build, use the
-'develop' or 'deploy' target variants of the Makefiles, respectively.
+'develop' or 'deploy' target variants of the GNUmakefile, respectively.
For example, to build and install only the optimized versions:
make -C tcl${ver}/macosx deploy
sudo make -C tcl${ver}/macosx install-deploy
diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig
new file mode 100644
index 0000000..9c47547
--- /dev/null
+++ b/macosx/Tcl-Common.xcconfig
@@ -0,0 +1,37 @@
+//
+// Tcl-Common.xcconfig --
+//
+// This file contains the Xcode build settings comon to all
+// project configurations in Tcl.xcodeproj.
+//
+// Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
+//
+// See the file "license.terms" for information on usage and redistribution
+// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+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)
+INSTALL_PATH = $(BINDIR)
+INSTALL_MODE_FLAG = go-w,a+rX
+GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h
+GCC_GENERATE_DEBUGGING_SYMBOLS = YES
+GCC_NO_COMMON_BLOCKS = YES
+GCC_DYNAMIC_NO_PIC = YES
+GCC_VERSION = 4.2
+GCC = gcc-$(GCC_VERSION)
+WARNING_CFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS)
+BINDIR = $(PREFIX)/bin
+CFLAGS = $(CFLAGS)
+CPPFLAGS = -mmacosx-version-min=$(MACOSX_DEPLOYMENT_TARGET) $(CPPFLAGS)
+FRAMEWORK_INSTALL_PATH = /Library/Frameworks
+INCLUDEDIR = $(PREFIX)/include
+LIBDIR = $(PREFIX)/lib
+MANDIR = $(PREFIX)/man
+PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
+PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
+PREFIX = /usr/local
+TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
+TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
+TCL_PACKAGE_PATH = "$(LIBDIR)"
+TCL_DEFS = HAVE_TCL_CONFIG_H
+VERSION = 8.6
diff --git a/macosx/Tcl-Debug.xcconfig b/macosx/Tcl-Debug.xcconfig
new file mode 100644
index 0000000..03d2b2d
--- /dev/null
+++ b/macosx/Tcl-Debug.xcconfig
@@ -0,0 +1,20 @@
+//
+// Tcl-Debug.xcconfig --
+//
+// This file contains the Xcode build settings for all Debug
+// project configurations in Tcl.xcodeproj.
+//
+// Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+//
+// See the file "license.terms" for information on usage and redistribution
+// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+#include "Tcl-Common.xcconfig"
+
+DEBUG_INFORMATION_FORMAT = dwarf
+DEAD_CODE_STRIPPING = NO
+DEPLOYMENT_POSTPROCESSING = NO
+GCC_OPTIMIZATION_LEVEL = 0
+GCC_PREPROCESSOR_DEFINITIONS = $(TCL_DEFS) $(GCC_PREPROCESSOR_DEFINITIONS)
+CONFIGURE_ARGS = --enable-symbols $(TCL_CONFIGURE_ARGS) $(CONFIGURE_ARGS)
+MAKE_TARGET = develop
diff --git a/macosx/Tcl-Info.plist.in b/macosx/Tcl-Info.plist.in
index b942956..f5c6b15 100644
--- a/macosx/Tcl-Info.plist.in
+++ b/macosx/Tcl-Info.plist.in
@@ -1,5 +1,11 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<!--
+ Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net>
+
+ See the file "license.terms" for information on usage and redistribution of
+ this file, and for a DISCLAIMER OF ALL WARRANTIES.
+-->
<plist version="1.0">
<dict>
<key>CFBundleDevelopmentRegion</key>
@@ -7,14 +13,17 @@
<key>CFBundleExecutable</key>
<string>@TCL_LIB_FILE@</string>
<key>CFBundleGetInfoString</key>
- <string>Tcl Library @TCL_VERSION@, Copyright © @TCL_YEAR@ Tcl Core Team.
-Initial MacOS X Port by Jim Ingham &lt;jingham@apple.com&gt; &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string>
+ <string>Tcl @TCL_VERSION@@TCL_PATCH_LEVEL@,
+Copyright © 1987-@TCL_YEAR@ Tcl Core Team,
+Copyright © 2001-@TCL_YEAR@ Daniel A. Steffen,
+Copyright © 2001-2009 Apple Inc.,
+Copyright © 2001-2002 Jim Ingham &amp; Ian Reid</string>
<key>CFBundleIdentifier</key>
<string>com.tcltk.tcllibrary</string>
<key>CFBundleInfoDictionaryVersion</key>
<string>6.0</string>
<key>CFBundleName</key>
- <string>Tcl Library @TCL_VERSION@</string>
+ <string>Tcl @TCL_VERSION@</string>
<key>CFBundlePackageType</key>
<string>FMWK</string>
<key>CFBundleShortVersionString</key>
diff --git a/macosx/Tcl-Release.xcconfig b/macosx/Tcl-Release.xcconfig
new file mode 100644
index 0000000..d960a52
--- /dev/null
+++ b/macosx/Tcl-Release.xcconfig
@@ -0,0 +1,20 @@
+//
+// Tcl-Release.xcconfig --
+//
+// This file contains the Xcode build settings for all Release
+// project configurations in Tcl.xcodeproj.
+//
+// Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+//
+// See the file "license.terms" for information on usage and redistribution
+// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+#include "Tcl-Common.xcconfig"
+
+DEBUG_INFORMATION_FORMAT = dwarf-with-dsym
+DEAD_CODE_STRIPPING = YES
+DEPLOYMENT_POSTPROCESSING = YES
+GCC_OPTIMIZATION_LEVEL = s
+GCC_PREPROCESSOR_DEFINITIONS = NDEBUG $(TCL_DEFS) $(GCC_PREPROCESSOR_DEFINITIONS)
+CONFIGURE_ARGS = --disable-symbols $(TCL_CONFIGURE_ARGS) $(CONFIGURE_ARGS)
+MAKE_TARGET = deploy
diff --git a/macosx/Tcl.pbproj/jingham.pbxuser b/macosx/Tcl.pbproj/jingham.pbxuser
deleted file mode 100644
index 10f0b57..0000000
--- a/macosx/Tcl.pbproj/jingham.pbxuser
+++ /dev/null
@@ -1,79 +0,0 @@
-// !$*UTF8*$!
-{
- 00E2F845016E82EB0ACA28DC = {
- activeBuildStyle = 00E2F847016E82EB0ACA28DC;
- activeExecutable = F9A61CCE04C2B5A8006F5A0B;
- activeTarget = 00E2F84C016E8B780ACA28DC;
- breakpoints = (
- );
- executables = (
- F9A61CCE04C2B5A8006F5A0B,
- F973FC3204852E75006F146B,
- );
- perUserDictionary = {
- PBXPerProjectTemplateStateSaveDate = 79872121;
- };
- projectwideBuildSettings = {
- SYMROOT = "${SRCROOT}/../../build/tcl";
- };
- wantsIndex = 1;
- wantsSCM = -1;
- };
- 00E2F84C016E8B780ACA28DC = {
- activeExec = 0;
- };
- F973FC3204852E75006F146B = {
- activeArgIndex = 2147483647;
- activeArgIndices = (
- );
- argumentStrings = (
- );
- configStateDict = {
- };
- debuggerPlugin = GDBDebugging;
- dylibVariantSuffix = "";
- enableDebugStr = 1;
- environmentEntries = (
- );
- isa = PBXExecutable;
- launchableReference = F9A61CCD04C2B5A5006F5A0B;
- name = tclsh8.4;
- shlibInfoDictList = (
- );
- sourceDirectories = (
- );
- };
- F9A61CCD04C2B5A5006F5A0B = {
- isa = PBXFileReference;
- name = tclsh8.4;
- path = ../../build/tcl/tclsh8.4;
- refType = 4;
- };
- F9A61CCE04C2B5A8006F5A0B = {
- activeArgIndex = 2147483647;
- activeArgIndices = (
- );
- argumentStrings = (
- );
- configStateDict = {
- };
- debuggerPlugin = GDBDebugging;
- dylibVariantSuffix = "";
- enableDebugStr = 1;
- environmentEntries = (
- );
- isa = PBXExecutable;
- launchableReference = F9A61CD104C2B5B4006F5A0B;
- name = tcltest;
- shlibInfoDictList = (
- );
- sourceDirectories = (
- );
- };
- F9A61CD104C2B5B4006F5A0B = {
- isa = PBXFileReference;
- name = tcltest;
- path = ../../build/tcl/tcltest;
- refType = 4;
- };
-}
diff --git a/macosx/Tcl.pbproj/project.pbxproj b/macosx/Tcl.pbproj/project.pbxproj
deleted file mode 100644
index 3635cbb..0000000
--- a/macosx/Tcl.pbproj/project.pbxproj
+++ /dev/null
@@ -1,1285 +0,0 @@
-// !$*UTF8*$!
-{
- archiveVersion = 1;
- classes = {
- };
- objectVersion = 38;
- objects = {
- 00E2F845016E82EB0ACA28DC = {
- buildStyles = (
- 00E2F847016E82EB0ACA28DC,
- 00E2F848016E82EB0ACA28DC,
- );
- hasScannedForEncodings = 1;
- isa = PBXProject;
- mainGroup = 00E2F846016E82EB0ACA28DC;
- productRefGroup = 00E2F84A016E8A830ACA28DC;
- projectDirPath = "";
- targets = (
- 00E2F84C016E8B780ACA28DC,
- );
- };
- 00E2F846016E82EB0ACA28DC = {
- children = (
- F5306CA003CAC9AE016F146B,
- F5306C9F03CAC979016F146B,
- F5C88655017D604601DC9062,
- F5F24FEE016ED0DF01DC9062,
- 00E2F855016E922C0ACA28DC,
- 00E2F857016E92B00ACA28DC,
- 00E2F85A016E92B00ACA28DC,
- 00E2F84A016E8A830ACA28DC,
- );
- isa = PBXGroup;
- refType = 4;
- };
- 00E2F847016E82EB0ACA28DC = {
- buildRules = (
- );
- buildSettings = {
- MAKE_TARGET = develop;
- };
- isa = PBXBuildStyle;
- name = Development;
- };
- 00E2F848016E82EB0ACA28DC = {
- buildRules = (
- );
- buildSettings = {
- MAKE_TARGET = deploy;
- };
- isa = PBXBuildStyle;
- name = Deployment;
- };
- 00E2F84A016E8A830ACA28DC = {
- children = (
- F9A61C9D04C2B4E3006F5A0B,
- F53ACC5C031D9D11016F146B,
- F53ACC73031DA405016F146B,
- );
- isa = PBXGroup;
- name = Products;
- refType = 4;
- };
- 00E2F84C016E8B780ACA28DC = {
- buildArgumentsString = "-c \"if [ \\\"${ACTION}\\\" != \\\"clean\\\" ]; then if [ \\\"${ACTION}\\\" = \\\"install\\\" ]; then MAKE_ACTION=\"install-\"; fi; else MAKE_ACTION=\"distclean-\"; fi; gnumake \\${MAKE_ACTION:-}${MAKE_TARGET}";
- buildPhases = (
- );
- buildSettings = {
- EXTRA_CONFIGURE_ARGS = "";
- EXTRA_MAKE_ARGS = "";
- INSTALL_PATH = /Library/Frameworks;
- INSTALL_ROOT = "${DSTROOT}";
- PREFIX = /usr;
- PRODUCT_NAME = Tcl;
- SYMROOT = "${SRCROOT}/../../build/tcl";
- };
- buildToolPath = /bin/sh;
- buildWorkingDirectory = "${SRCROOT}";
- dependencies = (
- );
- isa = PBXLegacyTarget;
- name = Tcl;
- passBuildSettingsInEnvironment = 1;
- productName = Tcl;
- settingsToExpand = 6;
- settingsToPassInEnvironment = 287;
- settingsToPassOnCommandLine = 280;
- };
- 00E2F854016E922C0ACA28DC = {
- children = (
- F5F24F87016ECAFC01DC9062,
- F5F24F88016ECAFC01DC9062,
- F5F24F89016ECAFC01DC9062,
- F5F24F8A016ECAFC01DC9062,
- F5F24F8B016ECAFC01DC9062,
- F5F24F8C016ECAFC01DC9062,
- F5F24F8D016ECAFC01DC9062,
- F5F24F8E016ECAFC01DC9062,
- F5F24F8F016ECAFC01DC9062,
- F5F24F90016ECAFC01DC9062,
- F5F24F91016ECAFC01DC9062,
- F5F24F92016ECAFC01DC9062,
- F5F24F93016ECAFC01DC9062,
- F5F24F94016ECAFC01DC9062,
- F5F24F95016ECAFC01DC9062,
- F5F24F96016ECAFC01DC9062,
- F5F24F97016ECAFC01DC9062,
- F5F24F98016ECAFC01DC9062,
- F5F24F99016ECAFC01DC9062,
- F5F24F9A016ECAFC01DC9062,
- F5F24F9B016ECAFC01DC9062,
- F5F24F9C016ECAFC01DC9062,
- F5F24F9D016ECAFC01DC9062,
- F5F24F9E016ECAFC01DC9062,
- F5F24F9F016ECAFC01DC9062,
- F5F24FA0016ECAFC01DC9062,
- F5F24FA1016ECAFC01DC9062,
- F5F24FA2016ECAFC01DC9062,
- F5F24FA3016ECAFC01DC9062,
- F5F24FA4016ECAFC01DC9062,
- F5F24FA5016ECAFC01DC9062,
- F5F24FA6016ECAFC01DC9062,
- F5F24FA7016ECAFC01DC9062,
- F5F24FA8016ECAFC01DC9062,
- F5F24FA9016ECAFC01DC9062,
- F5F24FAA016ECAFC01DC9062,
- F5F24FAB016ECAFC01DC9062,
- F5F24FAC016ECAFC01DC9062,
- F5F24FAD016ECAFC01DC9062,
- F5F24FAE016ECAFC01DC9062,
- F5F24FAF016ECAFC01DC9062,
- F5F24FB0016ECAFC01DC9062,
- F5F24FB1016ECAFC01DC9062,
- F5F24FB2016ECAFC01DC9062,
- F5F24FB3016ECAFC01DC9062,
- F5F24FB4016ECAFC01DC9062,
- F5F24FB5016ECAFC01DC9062,
- F5F24FB6016ECAFC01DC9062,
- F5F24FB7016ECAFC01DC9062,
- F5F24FB8016ECAFC01DC9062,
- F5F24FB9016ECAFC01DC9062,
- F5F24FBA016ECAFC01DC9062,
- F9FED5C7047C7D1B006F146B,
- F5F24FBB016ECAFC01DC9062,
- F5F24FD3016ECB4901DC9062,
- F5F24FBC016ECAFC01DC9062,
- F5F24FBD016ECAFC01DC9062,
- F5F24FBE016ECAFC01DC9062,
- F5F24FBF016ECAFC01DC9062,
- F5F24FC0016ECAFC01DC9062,
- F5F24FC1016ECAFC01DC9062,
- F5F24FC2016ECAFC01DC9062,
- F5F24FC3016ECAFC01DC9062,
- F5F24FC4016ECAFC01DC9062,
- F5F24FC5016ECAFC01DC9062,
- F5F24FC6016ECAFC01DC9062,
- F5F24FC7016ECAFC01DC9062,
- F5F24FC8016ECAFC01DC9062,
- F5F24FC9016ECAFC01DC9062,
- F5F24FCA016ECAFC01DC9062,
- F5F24FCB016ECAFC01DC9062,
- F5F24FCC016ECAFC01DC9062,
- F5F24FCD016ECAFC01DC9062,
- F5F24FCE016ECAFC01DC9062,
- F5F24FCF016ECAFC01DC9062,
- F5F24FD0016ECAFC01DC9062,
- );
- isa = PBXGroup;
- name = Sources;
- path = "";
- refType = 4;
- };
- 00E2F855016E922C0ACA28DC = {
- children = (
- 00E2F856016E92B00ACA28DC,
- 00E2F854016E922C0ACA28DC,
- );
- isa = PBXGroup;
- name = generic;
- refType = 4;
- };
- 00E2F856016E92B00ACA28DC = {
- children = (
- F5F24F6B016ECAA401DC9062,
- F5F24F6C016ECAA401DC9062,
- F5F24F6D016ECAA401DC9062,
- F5F24F6E016ECAA401DC9062,
- F5F24F6F016ECAA401DC9062,
- F5F24F70016ECAA401DC9062,
- F5F24F71016ECAA401DC9062,
- F5F24F72016ECAA401DC9062,
- F5F24F73016ECAA401DC9062,
- F5F24F74016ECAA401DC9062,
- F5F24F75016ECAA401DC9062,
- F5F24F76016ECAA401DC9062,
- F5F24F77016ECAA401DC9062,
- F5F24F78016ECAA401DC9062,
- F5F24FD1016ECB1E01DC9062,
- F5F24FD2016ECB1E01DC9062,
- );
- isa = PBXGroup;
- name = Headers;
- refType = 4;
- };
- 00E2F857016E92B00ACA28DC = {
- children = (
- 00E2F858016E92B00ACA28DC,
- 00E2F859016E92B00ACA28DC,
- );
- isa = PBXGroup;
- name = macosx;
- refType = 4;
- };
- 00E2F858016E92B00ACA28DC = {
- children = (
- );
- isa = PBXGroup;
- name = Headers;
- refType = 4;
- };
- 00E2F859016E92B00ACA28DC = {
- children = (
- F5A1836F018242A501DC9062,
- F9FED5C6047C7CEC006F146B,
- );
- isa = PBXGroup;
- name = Sources;
- refType = 4;
- };
- 00E2F85A016E92B00ACA28DC = {
- children = (
- 00E2F85B016E92B00ACA28DC,
- 00E2F85C016E92B00ACA28DC,
- );
- isa = PBXGroup;
- name = unix;
- refType = 4;
- };
- 00E2F85B016E92B00ACA28DC = {
- children = (
- F5F24FD6016ECC0F01DC9062,
- F5F24FD7016ECC0F01DC9062,
- );
- isa = PBXGroup;
- name = Headers;
- refType = 4;
- };
- 00E2F85C016E92B00ACA28DC = {
- children = (
- F5F24FD8016ECC0F01DC9062,
- F5F24FD9016ECC0F01DC9062,
- F5F24FDB016ECC0F01DC9062,
- F5F24FDC016ECC0F01DC9062,
- F5F24FDD016ECC0F01DC9062,
- F5F24FDE016ECC0F01DC9062,
- F5F24FDF016ECC0F01DC9062,
- F5F24FE0016ECC0F01DC9062,
- F5F24FE1016ECC0F01DC9062,
- F5F24FE2016ECC0F01DC9062,
- F5F24FE3016ECC0F01DC9062,
- F5F24FE4016ECC0F01DC9062,
- F5F24FE5016ECC0F01DC9062,
- F5F24FE6016ECC0F01DC9062,
- F5F24FE7016ECC0F01DC9062,
- );
- isa = PBXGroup;
- name = Sources;
- refType = 4;
- };
-//000
-//001
-//002
-//003
-//004
-//F50
-//F51
-//F52
-//F53
-//F54
- F5306C9F03CAC979016F146B = {
- children = (
- F5306CA303CAC9DE016F146B,
- F5306CA103CAC9DE016F146B,
- F5306CA203CAC9DE016F146B,
- );
- isa = PBXGroup;
- name = "Build System";
- refType = 4;
- };
- F5306CA003CAC9AE016F146B = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = ChangeLog;
- path = ../ChangeLog;
- refType = 2;
- };
- F5306CA103CAC9DE016F146B = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = configure.in;
- path = ../unix/configure.in;
- refType = 2;
- };
- F5306CA203CAC9DE016F146B = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = Makefile.in;
- path = ../unix/Makefile.in;
- refType = 2;
- };
- F5306CA303CAC9DE016F146B = {
- isa = PBXFileReference;
- name = tcl.m4;
- path = ../unix/tcl.m4;
- refType = 2;
- };
- F53ACC5C031D9D11016F146B = {
- isa = PBXExecutableFileReference;
- name = tclsh8.5;
- path = ../../build/tcl/tclsh8.5;
- refType = 2;
- };
- F53ACC73031DA405016F146B = {
- isa = PBXExecutableFileReference;
- name = tcltest;
- path = ../../build/tcl/tcltest;
- refType = 2;
- };
- F5A1836F018242A501DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- path = tclMacOSXBundle.c;
- refType = 2;
- };
- F5C88655017D604601DC9062 = {
- children = (
- F5C88656017D604601DC9062,
- F5C88657017D60C901DC9062,
- F5C88658017D60C901DC9062,
- );
- isa = PBXGroup;
- name = "Header Tools";
- refType = 4;
- };
- F5C88656017D604601DC9062 = {
- isa = PBXFileReference;
- name = genStubs.tcl;
- path = ../tools/genStubs.tcl;
- refType = 2;
- };
- F5C88657017D60C901DC9062 = {
- isa = PBXFileReference;
- name = tcl.decls;
- path = ../generic/tcl.decls;
- refType = 2;
- };
- F5C88658017D60C901DC9062 = {
- isa = PBXFileReference;
- name = tclInt.decls;
- path = ../generic/tclInt.decls;
- refType = 2;
- };
- F5F24F6B016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regcustom.h;
- path = ../generic/regcustom.h;
- refType = 2;
- };
- F5F24F6C016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regerrs.h;
- path = ../generic/regerrs.h;
- refType = 2;
- };
- F5F24F6D016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regguts.h;
- path = ../generic/regguts.h;
- refType = 2;
- };
- F5F24F6E016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tcl.h;
- path = ../generic/tcl.h;
- refType = 2;
- };
- F5F24F6F016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCompile.h;
- path = ../generic/tclCompile.h;
- refType = 2;
- };
- F5F24F70016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclDecls.h;
- path = ../generic/tclDecls.h;
- refType = 2;
- };
- F5F24F71016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclInitScript.h;
- path = ../generic/tclInitScript.h;
- refType = 2;
- };
- F5F24F72016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclInt.h;
- path = ../generic/tclInt.h;
- refType = 2;
- };
- F5F24F73016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIntDecls.h;
- path = ../generic/tclIntDecls.h;
- refType = 2;
- };
- F5F24F74016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIntPlatDecls.h;
- path = ../generic/tclIntPlatDecls.h;
- refType = 2;
- };
- F5F24F75016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIO.h;
- path = ../generic/tclIO.h;
- refType = 2;
- };
- F5F24F76016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclMath.h;
- path = ../generic/tclMath.h;
- refType = 2;
- };
- F5F24F77016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPlatDecls.h;
- path = ../generic/tclPlatDecls.h;
- refType = 2;
- };
- F5F24F78016ECAA401DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclRegexp.h;
- path = ../generic/tclRegexp.h;
- refType = 2;
- };
- F5F24F87016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regc_color.c;
- path = ../generic/regc_color.c;
- refType = 2;
- };
- F5F24F88016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regc_cvec.c;
- path = ../generic/regc_cvec.c;
- refType = 2;
- };
- F5F24F89016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regc_lex.c;
- path = ../generic/regc_lex.c;
- refType = 2;
- };
- F5F24F8A016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regc_locale.c;
- path = ../generic/regc_locale.c;
- refType = 2;
- };
- F5F24F8B016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regc_nfa.c;
- path = ../generic/regc_nfa.c;
- refType = 2;
- };
- F5F24F8C016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regcomp.c;
- path = ../generic/regcomp.c;
- refType = 2;
- };
- F5F24F8D016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = rege_dfa.c;
- path = ../generic/rege_dfa.c;
- refType = 2;
- };
- F5F24F8E016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regerror.c;
- path = ../generic/regerror.c;
- refType = 2;
- };
- F5F24F8F016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regexec.c;
- path = ../generic/regexec.c;
- refType = 2;
- };
- F5F24F90016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regfree.c;
- path = ../generic/regfree.c;
- refType = 2;
- };
- F5F24F91016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regfronts.c;
- path = ../generic/regfronts.c;
- refType = 2;
- };
- F5F24F92016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclAlloc.c;
- path = ../generic/tclAlloc.c;
- refType = 2;
- };
- F5F24F93016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclAsync.c;
- path = ../generic/tclAsync.c;
- refType = 2;
- };
- F5F24F94016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclBasic.c;
- path = ../generic/tclBasic.c;
- refType = 2;
- };
- F5F24F95016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclBinary.c;
- path = ../generic/tclBinary.c;
- refType = 2;
- };
- F5F24F96016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCkalloc.c;
- path = ../generic/tclCkalloc.c;
- refType = 2;
- };
- F5F24F97016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclClock.c;
- path = ../generic/tclClock.c;
- refType = 2;
- };
- F5F24F98016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCmdAH.c;
- path = ../generic/tclCmdAH.c;
- refType = 2;
- };
- F5F24F99016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCmdIL.c;
- path = ../generic/tclCmdIL.c;
- refType = 2;
- };
- F5F24F9A016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCmdMZ.c;
- path = ../generic/tclCmdMZ.c;
- refType = 2;
- };
- F5F24F9B016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCompCmds.c;
- path = ../generic/tclCompCmds.c;
- refType = 2;
- };
- F5F24F9C016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCompExpr.c;
- path = ../generic/tclCompExpr.c;
- refType = 2;
- };
- F5F24F9D016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclCompile.c;
- path = ../generic/tclCompile.c;
- refType = 2;
- };
- F5F24F9E016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclDate.c;
- path = ../generic/tclDate.c;
- refType = 2;
- };
- F5F24F9F016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclEncoding.c;
- path = ../generic/tclEncoding.c;
- refType = 2;
- };
- F5F24FA0016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclEnv.c;
- path = ../generic/tclEnv.c;
- refType = 2;
- };
- F5F24FA1016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclEvent.c;
- path = ../generic/tclEvent.c;
- refType = 2;
- };
- F5F24FA2016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclExecute.c;
- path = ../generic/tclExecute.c;
- refType = 2;
- };
- F5F24FA3016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclFCmd.c;
- path = ../generic/tclFCmd.c;
- refType = 2;
- };
- F5F24FA4016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclFileName.c;
- path = ../generic/tclFileName.c;
- refType = 2;
- };
- F5F24FA5016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclGet.c;
- path = ../generic/tclGet.c;
- refType = 2;
- };
- F5F24FA6016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclHash.c;
- path = ../generic/tclHash.c;
- refType = 2;
- };
- F5F24FA7016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclHistory.c;
- path = ../generic/tclHistory.c;
- refType = 2;
- };
- F5F24FA8016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIndexObj.c;
- path = ../generic/tclIndexObj.c;
- refType = 2;
- };
- F5F24FA9016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclInterp.c;
- path = ../generic/tclInterp.c;
- refType = 2;
- };
- F5F24FAA016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIO.c;
- path = ../generic/tclIO.c;
- refType = 2;
- };
- F5F24FAB016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIOCmd.c;
- path = ../generic/tclIOCmd.c;
- refType = 2;
- };
- F5F24FAC016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIOGT.c;
- path = ../generic/tclIOGT.c;
- refType = 2;
- };
- F5F24FAD016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIOSock.c;
- path = ../generic/tclIOSock.c;
- refType = 2;
- };
- F5F24FAE016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIOUtil.c;
- path = ../generic/tclIOUtil.c;
- refType = 2;
- };
- F5F24FAF016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclLink.c;
- path = ../generic/tclLink.c;
- refType = 2;
- };
- F5F24FB0016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclListObj.c;
- path = ../generic/tclListObj.c;
- refType = 2;
- };
- F5F24FB1016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclLiteral.c;
- path = ../generic/tclLiteral.c;
- refType = 2;
- };
- F5F24FB2016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclLoad.c;
- path = ../generic/tclLoad.c;
- refType = 2;
- };
- F5F24FB3016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclLoadNone.c;
- path = ../generic/tclLoadNone.c;
- refType = 2;
- };
- F5F24FB4016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclMain.c;
- path = ../generic/tclMain.c;
- refType = 2;
- };
- F5F24FB5016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclNamesp.c;
- path = ../generic/tclNamesp.c;
- refType = 2;
- };
- F5F24FB6016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclNotify.c;
- path = ../generic/tclNotify.c;
- refType = 2;
- };
- F5F24FB7016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclObj.c;
- path = ../generic/tclObj.c;
- refType = 2;
- };
- F5F24FB8016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPanic.c;
- path = ../generic/tclPanic.c;
- refType = 2;
- };
- F5F24FB9016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclParse.c;
- path = ../generic/tclParse.c;
- refType = 2;
- };
- F5F24FBA016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclParseExpr.c;
- path = ../generic/tclParseExpr.c;
- refType = 2;
- };
- F5F24FBB016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPipe.c;
- path = ../generic/tclPipe.c;
- refType = 2;
- };
- F5F24FBC016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPosixStr.c;
- path = ../generic/tclPosixStr.c;
- refType = 2;
- };
- F5F24FBD016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPreserve.c;
- path = ../generic/tclPreserve.c;
- refType = 2;
- };
- F5F24FBE016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclProc.c;
- path = ../generic/tclProc.c;
- refType = 2;
- };
- F5F24FBF016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclRegexp.c;
- path = ../generic/tclRegexp.c;
- refType = 2;
- };
- F5F24FC0016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclResolve.c;
- path = ../generic/tclResolve.c;
- refType = 2;
- };
- F5F24FC1016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclResult.c;
- path = ../generic/tclResult.c;
- refType = 2;
- };
- F5F24FC2016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclScan.c;
- path = ../generic/tclScan.c;
- refType = 2;
- };
- F5F24FC3016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclStringObj.c;
- path = ../generic/tclStringObj.c;
- refType = 2;
- };
- F5F24FC4016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclStubInit.c;
- path = ../generic/tclStubInit.c;
- refType = 2;
- };
- F5F24FC5016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclStubLib.c;
- path = ../generic/tclStubLib.c;
- refType = 2;
- };
- F5F24FC6016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclTest.c;
- path = ../generic/tclTest.c;
- refType = 2;
- };
- F5F24FC7016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclTestObj.c;
- path = ../generic/tclTestObj.c;
- refType = 2;
- };
- F5F24FC8016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclTestProcBodyObj.c;
- path = ../generic/tclTestProcBodyObj.c;
- refType = 2;
- };
- F5F24FC9016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclThread.c;
- path = ../generic/tclThread.c;
- refType = 2;
- };
- F5F24FCA016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclThreadJoin.c;
- path = ../generic/tclThreadJoin.c;
- refType = 2;
- };
- F5F24FCB016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclThreadTest.c;
- path = ../generic/tclThreadTest.c;
- refType = 2;
- };
- F5F24FCC016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclTimer.c;
- path = ../generic/tclTimer.c;
- refType = 2;
- };
- F5F24FCD016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUniData.c;
- path = ../generic/tclUniData.c;
- refType = 2;
- };
- F5F24FCE016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUtf.c;
- path = ../generic/tclUtf.c;
- refType = 2;
- };
- F5F24FCF016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUtil.c;
- path = ../generic/tclUtil.c;
- refType = 2;
- };
- F5F24FD0016ECAFC01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclVar.c;
- path = ../generic/tclVar.c;
- refType = 2;
- };
- F5F24FD1016ECB1E01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = regex.h;
- path = ../generic/regex.h;
- refType = 2;
- };
- F5F24FD2016ECB1E01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPort.h;
- path = ../generic/tclPort.h;
- refType = 2;
- };
- F5F24FD3016ECB4901DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclPkg.c;
- path = ../generic/tclPkg.c;
- refType = 2;
- };
- F5F24FD6016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixPort.h;
- path = ../unix/tclUnixPort.h;
- refType = 2;
- };
- F5F24FD7016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixThrd.h;
- path = ../unix/tclUnixThrd.h;
- refType = 2;
- };
- F5F24FD8016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclAppInit.c;
- path = ../unix/tclAppInit.c;
- refType = 2;
- };
- F5F24FD9016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclLoadDyld.c;
- path = ../unix/tclLoadDyld.c;
- refType = 2;
- };
- F5F24FDB016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixChan.c;
- path = ../unix/tclUnixChan.c;
- refType = 2;
- };
- F5F24FDC016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixEvent.c;
- path = ../unix/tclUnixEvent.c;
- refType = 2;
- };
- F5F24FDD016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixFCmd.c;
- path = ../unix/tclUnixFCmd.c;
- refType = 2;
- };
- F5F24FDE016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixFile.c;
- path = ../unix/tclUnixFile.c;
- refType = 2;
- };
- F5F24FDF016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixInit.c;
- path = ../unix/tclUnixInit.c;
- refType = 2;
- };
- F5F24FE0016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixNotfy.c;
- path = ../unix/tclUnixNotfy.c;
- refType = 2;
- };
- F5F24FE1016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixPipe.c;
- path = ../unix/tclUnixPipe.c;
- refType = 2;
- };
- F5F24FE2016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixSock.c;
- path = ../unix/tclUnixSock.c;
- refType = 2;
- };
- F5F24FE3016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixTest.c;
- path = ../unix/tclUnixTest.c;
- refType = 2;
- };
- F5F24FE4016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixThrd.c;
- path = ../unix/tclUnixThrd.c;
- refType = 2;
- };
- F5F24FE5016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclUnixTime.c;
- path = ../unix/tclUnixTime.c;
- refType = 2;
- };
- F5F24FE6016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclXtNotify.c;
- path = ../unix/tclXtNotify.c;
- refType = 2;
- };
- F5F24FE7016ECC0F01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclXtTest.c;
- path = ../unix/tclXtTest.c;
- refType = 2;
- };
- F5F24FEE016ED0DF01DC9062 = {
- children = (
- F5F24FEF016ED0DF01DC9062,
- F5F24FF0016ED0DF01DC9062,
- F5F24FF3016ED0DF01DC9062,
- F5F24FF4016ED0DF01DC9062,
- F5F24FF5016ED0DF01DC9062,
- F5F24FF6016ED0DF01DC9062,
- F5F24FFA016ED0DF01DC9062,
- F5F24FFB016ED0DF01DC9062,
- F5F24FFC016ED0DF01DC9062,
- F5F24FFE016ED0DF01DC9062,
- F5F25001016ED0DF01DC9062,
- F5F25002016ED0DF01DC9062,
- F5F25003016ED0DF01DC9062,
- F5F25005016ED0DF01DC9062,
- F5F25007016ED0DF01DC9062,
- F5F25008016ED0DF01DC9062,
- F5F2500A016ED0DF01DC9062,
- );
- isa = PBXGroup;
- name = Scripts;
- refType = 4;
- };
- F5F24FEF016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = auto.tcl;
- path = ../library/auto.tcl;
- refType = 2;
- };
- F5F24FF0016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = dde;
- path = ../library/dde;
- refType = 2;
- };
- F5F24FF3016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = encoding;
- path = ../library/encoding;
- refType = 2;
- };
- F5F24FF4016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = history.tcl;
- path = ../library/history.tcl;
- refType = 2;
- };
- F5F24FF5016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = http;
- path = ../library/http;
- refType = 2;
- };
- F5F24FF6016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = http1.0;
- path = ../library/http1.0;
- refType = 2;
- };
- F5F24FFA016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = init.tcl;
- path = ../library/init.tcl;
- refType = 2;
- };
- F5F24FFB016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = ldAout.tcl;
- path = ../library/ldAout.tcl;
- refType = 2;
- };
- F5F24FFC016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = msgcat;
- path = ../library/msgcat;
- refType = 2;
- };
- F5F24FFE016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = opt;
- path = ../library/opt;
- refType = 2;
- };
- F5F25001016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = package.tcl;
- path = ../library/package.tcl;
- refType = 2;
- };
- F5F25002016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = parray.tcl;
- path = ../library/parray.tcl;
- refType = 2;
- };
- F5F25003016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = reg;
- path = ../library/reg;
- refType = 2;
- };
- F5F25005016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = safe.tcl;
- path = ../library/safe.tcl;
- refType = 2;
- };
- F5F25007016ED0DF01DC9062 = {
- fileEncoding = 5;
- isa = PBXFileReference;
- name = tclIndex;
- path = ../library/tclIndex;
- refType = 2;
- };
- F5F25008016ED0DF01DC9062 = {
- includeInIndex = 0;
- isa = PBXFolderReference;
- name = tcltest;
- path = ../library/tcltest;
- refType = 2;
- };
- F5F2500A016ED0DF01DC9062 = {
- isa = PBXFileReference;
- name = word.tcl;
- path = ../library/word.tcl;
- refType = 2;
- };
-//F50
-//F51
-//F52
-//F53
-//F54
-//F90
-//F91
-//F92
-//F93
-//F94
- F9A61C9D04C2B4E3006F5A0B = {
- isa = PBXFrameworkReference;
- name = Tcl.framework;
- path = ../../build/tcl/Tcl.framework;
- refType = 2;
- };
- F9FED5C6047C7CEC006F146B = {
- fileEncoding = 30;
- isa = PBXFileReference;
- path = tclMacOSXFCmd.c;
- refType = 4;
- };
- F9FED5C7047C7D1B006F146B = {
- fileEncoding = 30;
- isa = PBXFileReference;
- name = tclPathObj.c;
- path = /Users/steffen/Documents/Development/TclTk/HEAD/tcl/generic/tclPathObj.c;
- refType = 0;
- };
- };
- rootObject = 00E2F845016E82EB0ACA28DC;
-}
diff --git a/macosx/Tcl.xcode/default.pbxuser b/macosx/Tcl.xcode/default.pbxuser
new file mode 100644
index 0000000..22ffa9e
--- /dev/null
+++ b/macosx/Tcl.xcode/default.pbxuser
@@ -0,0 +1,200 @@
+// !$*UTF8*$!
+{
+ 08FB7793FE84155DC02AAC07 /* Project object */ = {
+ activeBuildConfigurationName = Debug;
+ activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */;
+ activeTarget = F9E61D16090A3E94002B3151 /* Tcl */;
+ codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */;
+ executables = (
+ F9E61D1C090A4282002B3151 /* tclsh */,
+ F944EB8F08F798100049FDD4 /* tcltest */,
+ );
+ perUserDictionary = {
+ com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a0b707265666572656e63657386928497960892849a9a07666e6d617463688692849a9a008692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a0572656765788692849a9a065c2e286329248692849a9a097265637572736976658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0669734c656166869284b09db296008692849a9a0763616e536176658692af92849a9a1250425850726f6a65637453636f70654b65798692849a9a03594553868692849a9a08676c6f62616c49448692849a9a18314343304541343030343335304546393030343434313042868686>;
+ };
+ sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */;
+ userBuildSettings = {
+ SYMROOT = "${SRCROOT}/../../build/tcl";
+ TCL_SRCROOT = "${SRCROOT}/../../tcl";
+ };
+ };
+ 8DD76FA90486AB0100D96B5E /* tcltest */ = {
+ activeExec = 0;
+ executables = (
+ F944EB8F08F798100049FDD4 /* tcltest */,
+ );
+ };
+ F944EB8F08F798100049FDD4 /* tcltest */ = {
+ isa = PBXExecutable;
+ activeArgIndices = (
+ NO,
+ NO,
+ NO,
+ );
+ argumentStrings = (
+ "${TCL_SRCROOT}/tests/all.tcl",
+ "-singleproc 1",
+ "-verbose \"bet\"",
+ );
+ autoAttachOnCrash = 1;
+ breakpointsEnabled = 1;
+ configStateDict = {
+ "PBXLSLaunchAction-0" = {
+ PBXLSLaunchAction = 0;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXLSRunLaunchConfig;
+ displayName = "Executable Runner";
+ identifier = com.apple.Xcode.launch.runConfig;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ "PBXLSLaunchAction-1" = {
+ PBXLSLaunchAction = 1;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXGDB_LaunchConfig;
+ displayName = GDB;
+ identifier = com.apple.Xcode.launch.GDBMI_Config;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ };
+ customDataFormattersEnabled = 1;
+ debuggerPlugin = GDBDebugging;
+ disassemblyDisplayState = 0;
+ dylibVariantSuffix = "";
+ enableDebugStr = 0;
+ environmentEntries = (
+ {
+ active = YES;
+ name = TCL_LIBRARY;
+ value = "${TCL_SRCROOT}/library";
+ },
+ {
+ active = YES;
+ name = TCLLIBPATH;
+ value = /Library/Tcl;
+ },
+ {
+ active = NO;
+ name = DYLD_PRINT_LIBRARIES;
+ },
+ {
+ active = NO;
+ name = MallocBadFreeAbort;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocLogFile;
+ value = /tmp/malloc.log;
+ },
+ {
+ active = NO;
+ name = MallocStackLogging;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocStackLoggingNoCompact;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocPreScribble;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocScribble;
+ value = 1;
+ },
+ );
+ executableSystemSymbolLevel = 0;
+ executableUserSymbolLevel = 0;
+ libgmallocEnabled = 0;
+ name = tcltest;
+ sourceDirectories = (
+ );
+ };
+ F944EB9C08F798180049FDD4 /* Source Control */ = {
+ isa = PBXSourceControlManager;
+ fallbackIsa = XCSourceControlManager;
+ isSCMEnabled = 0;
+ scmConfiguration = {
+ CVSToolPath = /usr/bin/cvs;
+ CVSUseSSH = NO;
+ SubversionToolPath = /usr/bin/svn;
+ repositoryNamesForRoots = {
+ .. = "";
+ };
+ };
+ scmType = scm.cvs;
+ };
+ F944EB9D08F798180049FDD4 /* Code sense */ = {
+ isa = PBXCodeSenseManager;
+ indexTemplatePath = "";
+ };
+ F97258A50A86873C00096C78 /* tests */ = {
+ activeExec = 0;
+ };
+ F9E61D16090A3E94002B3151 /* Tcl */ = {
+ activeExec = 0;
+ executables = (
+ F9E61D1C090A4282002B3151 /* tclsh */,
+ );
+ };
+ F9E61D1C090A4282002B3151 /* tclsh */ = {
+ isa = PBXExecutable;
+ activeArgIndices = (
+ );
+ argumentStrings = (
+ );
+ autoAttachOnCrash = 1;
+ breakpointsEnabled = 1;
+ configStateDict = {
+ "PBXLSLaunchAction-0" = {
+ PBXLSLaunchAction = 0;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXLSRunLaunchConfig;
+ displayName = "Executable Runner";
+ identifier = com.apple.Xcode.launch.runConfig;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ "PBXLSLaunchAction-1" = {
+ PBXLSLaunchAction = 1;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXGDB_LaunchConfig;
+ displayName = GDB;
+ identifier = com.apple.Xcode.launch.GDBMI_Config;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ };
+ customDataFormattersEnabled = 1;
+ debuggerPlugin = GDBDebugging;
+ disassemblyDisplayState = 0;
+ dylibVariantSuffix = _debug;
+ enableDebugStr = 0;
+ environmentEntries = (
+ {
+ active = NO;
+ name = DYLD_PRINT_LIBRARIES;
+ },
+ );
+ executableSystemSymbolLevel = 0;
+ executableUserSymbolLevel = 0;
+ libgmallocEnabled = 0;
+ name = tclsh;
+ sourceDirectories = (
+ );
+ };
+}
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
new file mode 100644
index 0000000..a2a703b
--- /dev/null
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -0,0 +1,2936 @@
+// !$*UTF8*$!
+{
+ archiveVersion = 1;
+ classes = {
+ };
+ objectVersion = 45;
+ objects = {
+
+/* Begin PBXBuildFile section */
+ F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; };
+ F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
+ F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
+ F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
+ F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
+ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
+ F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
+ F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
+ F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; };
+ F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
+ F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
+ F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
+ F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
+ F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
+ F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
+ F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
+ F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; };
+ F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; };
+ F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; };
+ F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDE08F272A7004A47F5 /* tclBasic.c */; };
+ F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDF08F272A7004A47F5 /* tclBinary.c */; };
+ F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE008F272A7004A47F5 /* tclCkalloc.c */; };
+ F96D458008F272BC004A47F5 /* tclClock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE108F272A7004A47F5 /* tclClock.c */; };
+ F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE208F272A7004A47F5 /* tclCmdAH.c */; };
+ F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE308F272A7004A47F5 /* tclCmdIL.c */; };
+ F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */; };
+ F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE508F272A7004A47F5 /* tclCompCmds.c */; };
+ F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE608F272A7004A47F5 /* tclCompExpr.c */; };
+ F96D458608F272BC004A47F5 /* tclCompile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE708F272A7004A47F5 /* tclCompile.c */; };
+ F96D458808F272BC004A47F5 /* tclConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE908F272A7004A47F5 /* tclConfig.c */; };
+ F96D458908F272BC004A47F5 /* tclDate.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEA08F272A7004A47F5 /* tclDate.c */; };
+ F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEC08F272A7004A47F5 /* tclDictObj.c */; };
+ F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EED08F272A7004A47F5 /* tclEncoding.c */; };
+ F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEE08F272A7004A47F5 /* tclEnv.c */; };
+ F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEF08F272A7004A47F5 /* tclEvent.c */; };
+ F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF008F272A7004A47F5 /* tclExecute.c */; };
+ F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF108F272A7004A47F5 /* tclFCmd.c */; };
+ F96D459108F272BC004A47F5 /* tclFileName.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF208F272A7004A47F5 /* tclFileName.c */; };
+ F96D459308F272BC004A47F5 /* tclGet.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF408F272A7004A47F5 /* tclGet.c */; };
+ F96D459508F272BC004A47F5 /* tclHash.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF608F272A7004A47F5 /* tclHash.c */; };
+ F96D459608F272BC004A47F5 /* tclHistory.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF708F272A7004A47F5 /* tclHistory.c */; };
+ F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF808F272A7004A47F5 /* tclIndexObj.c */; };
+ F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFC08F272A7004A47F5 /* tclInterp.c */; };
+ F96D459D08F272BC004A47F5 /* tclIO.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFE08F272A7004A47F5 /* tclIO.c */; };
+ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0008F272A7004A47F5 /* tclIOCmd.c */; };
+ F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0108F272A7004A47F5 /* tclIOGT.c */; };
+ F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0208F272A7004A47F5 /* tclIORChan.c */; };
+ F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0308F272A7004A47F5 /* tclIOSock.c */; };
+ F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0408F272A7004A47F5 /* tclIOUtil.c */; };
+ F96D45A408F272BC004A47F5 /* tclLink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0508F272A7004A47F5 /* tclLink.c */; };
+ F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0608F272A7004A47F5 /* tclListObj.c */; };
+ F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0708F272A7004A47F5 /* tclLiteral.c */; };
+ F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0808F272A7004A47F5 /* tclLoad.c */; };
+ F96D45A908F272BC004A47F5 /* tclMain.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0A08F272A7004A47F5 /* tclMain.c */; };
+ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0B08F272A7004A47F5 /* tclNamesp.c */; };
+ F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0C08F272A7004A47F5 /* tclNotify.c */; };
+ F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0D08F272A7004A47F5 /* tclObj.c */; };
+ F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0E08F272A7004A47F5 /* tclPanic.c */; };
+ F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0F08F272A7004A47F5 /* tclParse.c */; };
+ F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1108F272A7004A47F5 /* tclPathObj.c */; };
+ F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1208F272A7004A47F5 /* tclPipe.c */; };
+ F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1308F272A7004A47F5 /* tclPkg.c */; };
+ F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */; settings = {COMPILER_FLAGS = "-DCFG_INSTALL_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_INSTALL_BINDIR=\\\"$(BINDIR)\\\" -DCFG_INSTALL_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_INSTALL_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_INSTALL_DOCDIR=\\\"$(MANDIR)\\\" -DCFG_RUNTIME_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_RUNTIME_BINDIR=\\\"$(BINDIR)\\\" -DCFG_RUNTIME_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_RUNTIME_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_RUNTIME_DOCDIR=\\\"$(MANDIR)\\\""; }; };
+ F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1708F272A7004A47F5 /* tclPosixStr.c */; };
+ F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1808F272A7004A47F5 /* tclPreserve.c */; };
+ F96D45B808F272BC004A47F5 /* tclProc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1908F272A7004A47F5 /* tclProc.c */; };
+ F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1A08F272A7004A47F5 /* tclRegexp.c */; };
+ F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1C08F272A7004A47F5 /* tclResolve.c */; };
+ F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1D08F272A7004A47F5 /* tclResult.c */; };
+ F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1E08F272A7004A47F5 /* tclScan.c */; };
+ F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1F08F272A7004A47F5 /* tclStringObj.c */; };
+ F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2408F272A7004A47F5 /* tclStrToD.c */; };
+ F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2508F272A7004A47F5 /* tclStubInit.c */; };
+ F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2608F272A7004A47F5 /* tclStubLib.c */; };
+ F96D45C608F272BC004A47F5 /* tclTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2708F272A7004A47F5 /* tclTest.c */; };
+ F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2808F272A7004A47F5 /* tclTestObj.c */; };
+ F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; };
+ F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; };
+ F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; };
+ F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; };
+ F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; };
+ F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; };
+ F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; };
+ F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */; };
+ F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3208F272A7004A47F5 /* tclTrace.c */; };
+ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3408F272A7004A47F5 /* tclUtf.c */; };
+ F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3508F272A7004A47F5 /* tclUtil.c */; };
+ F96D45D508F272BC004A47F5 /* tclVar.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3608F272A7004A47F5 /* tclVar.c */; };
+ F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */; };
+ F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */; };
+ F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426908F272B3004A47F5 /* bn_mp_add.c */; };
+ F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */; };
+ F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */; };
+ F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426E08F272B3004A47F5 /* bn_mp_clear.c */; };
+ 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 */; };
+ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427708F272B3004A47F5 /* bn_mp_div_2.c */; };
+ F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */; };
+ F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_mp_div_3.c */; };
+ F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */; };
+ F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427E08F272B3004A47F5 /* bn_mp_exch.c */; };
+ F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428708F272B3004A47F5 /* bn_mp_grow.c */; };
+ F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428808F272B3004A47F5 /* bn_mp_init.c */; };
+ F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */; };
+ F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */; };
+ F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */; };
+ F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */; };
+ F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */; };
+ F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */; };
+ F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429508F272B3004A47F5 /* bn_mp_lshd.c */; };
+ F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429608F272B3004A47F5 /* bn_mp_mod.c */; };
+ F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */; };
+ F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429C08F272B3004A47F5 /* bn_mp_mul.c */; };
+ F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */; };
+ F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */; };
+ F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */; };
+ F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */; };
+ F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */; };
+ F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */; };
+ F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; };
+ F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; };
+ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; };
+ F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; };
+ F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; };
+ F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; };
+ F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; };
+ F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; };
+ F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; };
+ F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; };
+ F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; };
+ F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; };
+ F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; };
+ F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; };
+ F96D495508F272C3004A47F5 /* bncore.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D708F272B3004A47F5 /* bncore.c */; };
+ F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; };
+ F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; };
+ F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; };
+ F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; };
+ F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; };
+ F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; };
+ F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; };
+ F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; };
+ F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; };
+ F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; };
+ F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; };
+ F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; };
+ F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; };
+ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; };
+ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; };
+ F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; };
+ F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; };
+ F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
+ F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
+ F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
+ F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
+ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
+ F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
+ F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
+ F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
+ F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
+/* End PBXBuildFile section */
+
+/* Begin PBXContainerItemProxy section */
+ F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 8DD76FA90486AB0100D96B5E;
+ remoteInfo = tcltest;
+ };
+/* End PBXContainerItemProxy section */
+
+/* Begin PBXFileReference section */
+ 8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; };
+ F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; };
+ F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; };
+ F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; };
+ F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; };
+ F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; };
+ F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; };
+ F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; };
+ F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; };
+ F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; };
+ F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; };
+ F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; };
+ F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; };
+ F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; };
+ F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
+ F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
+ F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
+ F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
+ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
+ F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
+ F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
+ F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; };
+ F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
+ F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
+ F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
+ F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
+ F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
+ F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
+ F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
+ F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; };
+ F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; };
+ F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
+ F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
+ F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
+ F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
+ F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
+ F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
+ F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };
+ F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = "<group>"; };
+ F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
+ F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
+ F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
+ F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
+ F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
+ F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = "<group>"; };
+ F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = "<group>"; };
+ F96D3E0308F272A4004A47F5 /* AppInit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AppInit.3; sourceTree = "<group>"; };
+ F96D3E0408F272A5004A47F5 /* array.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = array.n; sourceTree = "<group>"; };
+ F96D3E0508F272A5004A47F5 /* AssocData.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AssocData.3; sourceTree = "<group>"; };
+ F96D3E0608F272A5004A47F5 /* Async.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Async.3; sourceTree = "<group>"; };
+ F96D3E0708F272A5004A47F5 /* BackgdErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BackgdErr.3; sourceTree = "<group>"; };
+ F96D3E0808F272A5004A47F5 /* Backslash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Backslash.3; sourceTree = "<group>"; };
+ F96D3E0908F272A5004A47F5 /* bgerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = bgerror.n; sourceTree = "<group>"; };
+ F96D3E0A08F272A5004A47F5 /* binary.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = binary.n; sourceTree = "<group>"; };
+ F96D3E0B08F272A5004A47F5 /* BoolObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BoolObj.3; sourceTree = "<group>"; };
+ F96D3E0C08F272A5004A47F5 /* break.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = break.n; sourceTree = "<group>"; };
+ F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ByteArrObj.3; sourceTree = "<group>"; };
+ F96D3E0E08F272A5004A47F5 /* CallDel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CallDel.3; sourceTree = "<group>"; };
+ F96D3E0F08F272A5004A47F5 /* case.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = case.n; sourceTree = "<group>"; };
+ F96D3E1008F272A5004A47F5 /* catch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = catch.n; sourceTree = "<group>"; };
+ F96D3E1108F272A5004A47F5 /* cd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = cd.n; sourceTree = "<group>"; };
+ F96D3E1208F272A5004A47F5 /* chan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = chan.n; sourceTree = "<group>"; };
+ F96D3E1308F272A5004A47F5 /* ChnlStack.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ChnlStack.3; sourceTree = "<group>"; };
+ F96D3E1408F272A5004A47F5 /* clock.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = clock.n; sourceTree = "<group>"; };
+ F96D3E1508F272A5004A47F5 /* close.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = close.n; sourceTree = "<group>"; };
+ F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CmdCmplt.3; sourceTree = "<group>"; };
+ F96D3E1708F272A5004A47F5 /* Concat.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Concat.3; sourceTree = "<group>"; };
+ F96D3E1808F272A5004A47F5 /* concat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = concat.n; sourceTree = "<group>"; };
+ F96D3E1908F272A5004A47F5 /* continue.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = continue.n; sourceTree = "<group>"; };
+ F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChannel.3; sourceTree = "<group>"; };
+ F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = "<group>"; };
+ F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = "<group>"; };
+ F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = "<group>"; };
+ F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = "<group>"; };
+ F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
+ F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
+ F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
+ F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
+ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
+ F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
+ F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
+ F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = "<group>"; };
+ F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = "<group>"; };
+ F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = "<group>"; };
+ F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = "<group>"; };
+ F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoubleObj.3; sourceTree = "<group>"; };
+ F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoWhenIdle.3; sourceTree = "<group>"; };
+ F96D3E2C08F272A5004A47F5 /* DString.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DString.3; sourceTree = "<group>"; };
+ F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DumpActiveMemory.3; sourceTree = "<group>"; };
+ F96D3E2E08F272A5004A47F5 /* Encoding.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Encoding.3; sourceTree = "<group>"; };
+ F96D3E2F08F272A5004A47F5 /* encoding.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = encoding.n; sourceTree = "<group>"; };
+ F96D3E3008F272A5004A47F5 /* Ensemble.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Ensemble.3; sourceTree = "<group>"; };
+ F96D3E3108F272A5004A47F5 /* Environment.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Environment.3; sourceTree = "<group>"; };
+ F96D3E3208F272A5004A47F5 /* eof.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eof.n; sourceTree = "<group>"; };
+ F96D3E3308F272A5004A47F5 /* error.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = error.n; sourceTree = "<group>"; };
+ F96D3E3408F272A5004A47F5 /* Eval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Eval.3; sourceTree = "<group>"; };
+ F96D3E3508F272A5004A47F5 /* eval.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eval.n; sourceTree = "<group>"; };
+ F96D3E3608F272A5004A47F5 /* exec.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exec.n; sourceTree = "<group>"; };
+ F96D3E3708F272A5004A47F5 /* Exit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Exit.3; sourceTree = "<group>"; };
+ F96D3E3808F272A5004A47F5 /* exit.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exit.n; sourceTree = "<group>"; };
+ F96D3E3908F272A5004A47F5 /* expr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = expr.n; sourceTree = "<group>"; };
+ F96D3E3A08F272A5004A47F5 /* ExprLong.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLong.3; sourceTree = "<group>"; };
+ F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLongObj.3; sourceTree = "<group>"; };
+ F96D3E3C08F272A5004A47F5 /* fblocked.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fblocked.n; sourceTree = "<group>"; };
+ F96D3E3D08F272A5004A47F5 /* fconfigure.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fconfigure.n; sourceTree = "<group>"; };
+ F96D3E3E08F272A5004A47F5 /* fcopy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fcopy.n; sourceTree = "<group>"; };
+ F96D3E3F08F272A5004A47F5 /* file.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = file.n; sourceTree = "<group>"; };
+ F96D3E4008F272A5004A47F5 /* fileevent.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fileevent.n; sourceTree = "<group>"; };
+ F96D3E4108F272A5004A47F5 /* filename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = filename.n; sourceTree = "<group>"; };
+ F96D3E4208F272A5004A47F5 /* FileSystem.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FileSystem.3; sourceTree = "<group>"; };
+ F96D3E4308F272A5004A47F5 /* FindExec.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FindExec.3; sourceTree = "<group>"; };
+ F96D3E4408F272A5004A47F5 /* flush.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = flush.n; sourceTree = "<group>"; };
+ F96D3E4508F272A5004A47F5 /* for.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = for.n; sourceTree = "<group>"; };
+ F96D3E4608F272A5004A47F5 /* foreach.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = foreach.n; sourceTree = "<group>"; };
+ F96D3E4708F272A5004A47F5 /* format.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = format.n; sourceTree = "<group>"; };
+ F96D3E4808F272A5004A47F5 /* GetCwd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetCwd.3; sourceTree = "<group>"; };
+ F96D3E4908F272A5004A47F5 /* GetHostName.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetHostName.3; sourceTree = "<group>"; };
+ F96D3E4A08F272A5004A47F5 /* GetIndex.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetIndex.3; sourceTree = "<group>"; };
+ F96D3E4B08F272A5004A47F5 /* GetInt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetInt.3; sourceTree = "<group>"; };
+ F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetOpnFl.3; sourceTree = "<group>"; };
+ F96D3E4D08F272A5004A47F5 /* gets.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = gets.n; sourceTree = "<group>"; };
+ F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetStdChan.3; sourceTree = "<group>"; };
+ F96D3E4F08F272A5004A47F5 /* GetTime.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetTime.3; sourceTree = "<group>"; };
+ F96D3E5008F272A5004A47F5 /* GetVersion.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetVersion.3; sourceTree = "<group>"; };
+ F96D3E5108F272A5004A47F5 /* glob.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = glob.n; sourceTree = "<group>"; };
+ F96D3E5208F272A6004A47F5 /* global.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = global.n; sourceTree = "<group>"; };
+ F96D3E5308F272A6004A47F5 /* Hash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Hash.3; sourceTree = "<group>"; };
+ F96D3E5408F272A6004A47F5 /* history.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = history.n; sourceTree = "<group>"; };
+ F96D3E5508F272A6004A47F5 /* http.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = http.n; sourceTree = "<group>"; };
+ F96D3E5608F272A6004A47F5 /* if.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = if.n; sourceTree = "<group>"; };
+ F96D3E5708F272A6004A47F5 /* incr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = incr.n; sourceTree = "<group>"; };
+ F96D3E5808F272A6004A47F5 /* info.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = info.n; sourceTree = "<group>"; };
+ F96D3E5908F272A6004A47F5 /* Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Init.3; sourceTree = "<group>"; };
+ F96D3E5A08F272A6004A47F5 /* InitStubs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = InitStubs.3; sourceTree = "<group>"; };
+ F96D3E5B08F272A6004A47F5 /* Interp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Interp.3; sourceTree = "<group>"; };
+ F96D3E5C08F272A6004A47F5 /* interp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = interp.n; sourceTree = "<group>"; };
+ F96D3E5D08F272A6004A47F5 /* IntObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = IntObj.3; sourceTree = "<group>"; };
+ F96D3E5E08F272A6004A47F5 /* join.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = join.n; sourceTree = "<group>"; };
+ F96D3E5F08F272A6004A47F5 /* lappend.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lappend.n; sourceTree = "<group>"; };
+ F96D3E6008F272A6004A47F5 /* lassign.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lassign.n; sourceTree = "<group>"; };
+ F96D3E6108F272A6004A47F5 /* library.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = library.n; sourceTree = "<group>"; };
+ F96D3E6208F272A6004A47F5 /* Limit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Limit.3; sourceTree = "<group>"; };
+ F96D3E6308F272A6004A47F5 /* lindex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lindex.n; sourceTree = "<group>"; };
+ F96D3E6408F272A6004A47F5 /* LinkVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = LinkVar.3; sourceTree = "<group>"; };
+ F96D3E6508F272A6004A47F5 /* linsert.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = linsert.n; sourceTree = "<group>"; };
+ F96D3E6608F272A6004A47F5 /* list.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = list.n; sourceTree = "<group>"; };
+ F96D3E6708F272A6004A47F5 /* ListObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ListObj.3; sourceTree = "<group>"; };
+ F96D3E6808F272A6004A47F5 /* llength.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = llength.n; sourceTree = "<group>"; };
+ F96D3E6908F272A6004A47F5 /* load.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = load.n; sourceTree = "<group>"; };
+ F96D3E6A08F272A6004A47F5 /* lrange.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrange.n; sourceTree = "<group>"; };
+ F96D3E6B08F272A6004A47F5 /* lrepeat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrepeat.n; sourceTree = "<group>"; };
+ F96D3E6C08F272A6004A47F5 /* lreplace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lreplace.n; sourceTree = "<group>"; };
+ F96D3E6D08F272A6004A47F5 /* lsearch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsearch.n; sourceTree = "<group>"; };
+ F96D3E6E08F272A6004A47F5 /* lset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lset.n; sourceTree = "<group>"; };
+ F96D3E6F08F272A6004A47F5 /* lsort.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsort.n; sourceTree = "<group>"; };
+ F96D3E7008F272A6004A47F5 /* man.macros */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = man.macros; sourceTree = "<group>"; };
+ F96D3E7108F272A6004A47F5 /* mathfunc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = mathfunc.n; sourceTree = "<group>"; };
+ F96D3E7208F272A6004A47F5 /* memory.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = memory.n; sourceTree = "<group>"; };
+ F96D3E7308F272A6004A47F5 /* msgcat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = msgcat.n; sourceTree = "<group>"; };
+ F96D3E7408F272A6004A47F5 /* Namespace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Namespace.3; sourceTree = "<group>"; };
+ F96D3E7508F272A6004A47F5 /* namespace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = namespace.n; sourceTree = "<group>"; };
+ F96D3E7608F272A6004A47F5 /* Notifier.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Notifier.3; sourceTree = "<group>"; };
+ F96D3E7708F272A6004A47F5 /* Object.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Object.3; sourceTree = "<group>"; };
+ F96D3E7808F272A6004A47F5 /* ObjectType.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ObjectType.3; sourceTree = "<group>"; };
+ F96D3E7908F272A6004A47F5 /* open.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = open.n; sourceTree = "<group>"; };
+ F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenFileChnl.3; sourceTree = "<group>"; };
+ F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenTcp.3; sourceTree = "<group>"; };
+ F96D3E7C08F272A6004A47F5 /* package.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = package.n; sourceTree = "<group>"; };
+ F96D3E7D08F272A6004A47F5 /* packagens.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = packagens.n; sourceTree = "<group>"; };
+ F96D3E7E08F272A6004A47F5 /* Panic.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Panic.3; sourceTree = "<group>"; };
+ F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ParseCmd.3; sourceTree = "<group>"; };
+ F96D3E8008F272A6004A47F5 /* pid.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pid.n; sourceTree = "<group>"; };
+ F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pkgMkIndex.n; sourceTree = "<group>"; };
+ F96D3E8208F272A6004A47F5 /* PkgRequire.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PkgRequire.3; sourceTree = "<group>"; };
+ F96D3E8308F272A6004A47F5 /* Preserve.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Preserve.3; sourceTree = "<group>"; };
+ F96D3E8408F272A6004A47F5 /* PrintDbl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PrintDbl.3; sourceTree = "<group>"; };
+ F96D3E8508F272A6004A47F5 /* proc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = proc.n; sourceTree = "<group>"; };
+ F96D3E8608F272A6004A47F5 /* puts.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = puts.n; sourceTree = "<group>"; };
+ F96D3E8708F272A6004A47F5 /* pwd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pwd.n; sourceTree = "<group>"; };
+ F96D3E8808F272A6004A47F5 /* re_syntax.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = re_syntax.n; sourceTree = "<group>"; };
+ F96D3E8908F272A6004A47F5 /* read.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = read.n; sourceTree = "<group>"; };
+ F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecEvalObj.3; sourceTree = "<group>"; };
+ F96D3E8B08F272A6004A47F5 /* RecordEval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecordEval.3; sourceTree = "<group>"; };
+ F96D3E8C08F272A6004A47F5 /* RegConfig.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegConfig.3; sourceTree = "<group>"; };
+ F96D3E8D08F272A6004A47F5 /* RegExp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegExp.3; sourceTree = "<group>"; };
+ F96D3E8E08F272A6004A47F5 /* regexp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regexp.n; sourceTree = "<group>"; };
+ F96D3E8F08F272A6004A47F5 /* registry.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = registry.n; sourceTree = "<group>"; };
+ F96D3E9008F272A6004A47F5 /* regsub.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regsub.n; sourceTree = "<group>"; };
+ F96D3E9108F272A6004A47F5 /* rename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = rename.n; sourceTree = "<group>"; };
+ F96D3E9208F272A6004A47F5 /* return.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = return.n; sourceTree = "<group>"; };
+ F96D3E9308F272A6004A47F5 /* safe.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = safe.n; sourceTree = "<group>"; };
+ F96D3E9408F272A6004A47F5 /* SaveResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveResult.3; sourceTree = "<group>"; };
+ F96D3E9508F272A6004A47F5 /* scan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = scan.n; sourceTree = "<group>"; };
+ F96D3E9608F272A6004A47F5 /* seek.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = seek.n; sourceTree = "<group>"; };
+ F96D3E9708F272A6004A47F5 /* set.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = set.n; sourceTree = "<group>"; };
+ F96D3E9808F272A6004A47F5 /* SetChanErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetChanErr.3; sourceTree = "<group>"; };
+ F96D3E9908F272A6004A47F5 /* SetErrno.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetErrno.3; sourceTree = "<group>"; };
+ F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetRecLmt.3; sourceTree = "<group>"; };
+ F96D3E9B08F272A7004A47F5 /* SetResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetResult.3; sourceTree = "<group>"; };
+ F96D3E9C08F272A7004A47F5 /* SetVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetVar.3; sourceTree = "<group>"; };
+ F96D3E9D08F272A7004A47F5 /* Signal.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Signal.3; sourceTree = "<group>"; };
+ F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
+ F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
+ F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
+ F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
+ F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
+ F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
+ F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
+ F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; };
+ F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
+ F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
+ F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
+ F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = "<group>"; };
+ F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = "<group>"; };
+ F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = "<group>"; };
+ F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = "<group>"; };
+ F96D3EAD08F272A7004A47F5 /* Tcl.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl.n; sourceTree = "<group>"; };
+ F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl_Main.3; sourceTree = "<group>"; };
+ F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TCL_MEM_DEBUG.3; sourceTree = "<group>"; };
+ F96D3EB008F272A7004A47F5 /* tclsh.1 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclsh.1; sourceTree = "<group>"; };
+ F96D3EB108F272A7004A47F5 /* tcltest.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tcltest.n; sourceTree = "<group>"; };
+ F96D3EB208F272A7004A47F5 /* tclvars.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclvars.n; sourceTree = "<group>"; };
+ F96D3EB308F272A7004A47F5 /* tell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tell.n; sourceTree = "<group>"; };
+ F96D3EB408F272A7004A47F5 /* Thread.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Thread.3; sourceTree = "<group>"; };
+ F96D3EB508F272A7004A47F5 /* time.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = time.n; sourceTree = "<group>"; };
+ F96D3EB608F272A7004A47F5 /* tm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tm.n; sourceTree = "<group>"; };
+ F96D3EB708F272A7004A47F5 /* ToUpper.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ToUpper.3; sourceTree = "<group>"; };
+ F96D3EB808F272A7004A47F5 /* trace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = trace.n; sourceTree = "<group>"; };
+ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceCmd.3; sourceTree = "<group>"; };
+ F96D3EBA08F272A7004A47F5 /* TraceVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceVar.3; sourceTree = "<group>"; };
+ F96D3EBB08F272A7004A47F5 /* Translate.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Translate.3; sourceTree = "<group>"; };
+ F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UniCharIsAlpha.3; sourceTree = "<group>"; };
+ F96D3EBD08F272A7004A47F5 /* unknown.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unknown.n; sourceTree = "<group>"; };
+ F96D3EBE08F272A7004A47F5 /* unload.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unload.n; sourceTree = "<group>"; };
+ F96D3EBF08F272A7004A47F5 /* unset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unset.n; sourceTree = "<group>"; };
+ F96D3EC008F272A7004A47F5 /* update.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = update.n; sourceTree = "<group>"; };
+ F96D3EC108F272A7004A47F5 /* uplevel.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = uplevel.n; sourceTree = "<group>"; };
+ F96D3EC208F272A7004A47F5 /* UpVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UpVar.3; sourceTree = "<group>"; };
+ F96D3EC308F272A7004A47F5 /* upvar.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = upvar.n; sourceTree = "<group>"; };
+ F96D3EC408F272A7004A47F5 /* Utf.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Utf.3; sourceTree = "<group>"; };
+ F96D3EC508F272A7004A47F5 /* variable.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = variable.n; sourceTree = "<group>"; };
+ F96D3EC608F272A7004A47F5 /* vwait.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = vwait.n; sourceTree = "<group>"; };
+ F96D3EC708F272A7004A47F5 /* while.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = while.n; sourceTree = "<group>"; };
+ F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = WrongNumArgs.3; sourceTree = "<group>"; };
+ F96D3ECA08F272A7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D3ECB08F272A7004A47F5 /* regc_color.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_color.c; sourceTree = "<group>"; };
+ F96D3ECC08F272A7004A47F5 /* regc_cvec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_cvec.c; sourceTree = "<group>"; };
+ F96D3ECD08F272A7004A47F5 /* regc_lex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_lex.c; sourceTree = "<group>"; };
+ F96D3ECE08F272A7004A47F5 /* regc_locale.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_locale.c; sourceTree = "<group>"; };
+ F96D3ECF08F272A7004A47F5 /* regc_nfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_nfa.c; sourceTree = "<group>"; };
+ F96D3ED008F272A7004A47F5 /* regcomp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regcomp.c; sourceTree = "<group>"; };
+ F96D3ED108F272A7004A47F5 /* regcustom.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regcustom.h; sourceTree = "<group>"; };
+ F96D3ED208F272A7004A47F5 /* rege_dfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = rege_dfa.c; sourceTree = "<group>"; };
+ F96D3ED308F272A7004A47F5 /* regerror.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regerror.c; sourceTree = "<group>"; };
+ F96D3ED408F272A7004A47F5 /* regerrs.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regerrs.h; sourceTree = "<group>"; };
+ F96D3ED508F272A7004A47F5 /* regex.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regex.h; sourceTree = "<group>"; };
+ F96D3ED608F272A7004A47F5 /* regexec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regexec.c; sourceTree = "<group>"; };
+ F96D3ED708F272A7004A47F5 /* regfree.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfree.c; sourceTree = "<group>"; };
+ F96D3ED808F272A7004A47F5 /* regfronts.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfronts.c; sourceTree = "<group>"; };
+ F96D3ED908F272A7004A47F5 /* regguts.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regguts.h; sourceTree = "<group>"; };
+ F96D3EDA08F272A7004A47F5 /* tcl.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcl.decls; sourceTree = "<group>"; };
+ F96D3EDB08F272A7004A47F5 /* tcl.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tcl.h; sourceTree = "<group>"; };
+ F96D3EDC08F272A7004A47F5 /* tclAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAlloc.c; sourceTree = "<group>"; };
+ F96D3EDD08F272A7004A47F5 /* tclAsync.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAsync.c; sourceTree = "<group>"; };
+ F96D3EDE08F272A7004A47F5 /* tclBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBasic.c; sourceTree = "<group>"; };
+ F96D3EDF08F272A7004A47F5 /* tclBinary.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBinary.c; sourceTree = "<group>"; };
+ F96D3EE008F272A7004A47F5 /* tclCkalloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCkalloc.c; sourceTree = "<group>"; };
+ F96D3EE108F272A7004A47F5 /* tclClock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclClock.c; sourceTree = "<group>"; };
+ F96D3EE208F272A7004A47F5 /* tclCmdAH.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdAH.c; sourceTree = "<group>"; };
+ F96D3EE308F272A7004A47F5 /* tclCmdIL.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdIL.c; sourceTree = "<group>"; };
+ F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdMZ.c; sourceTree = "<group>"; };
+ F96D3EE508F272A7004A47F5 /* tclCompCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompCmds.c; sourceTree = "<group>"; };
+ F96D3EE608F272A7004A47F5 /* tclCompExpr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompExpr.c; sourceTree = "<group>"; };
+ F96D3EE708F272A7004A47F5 /* tclCompile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompile.c; sourceTree = "<group>"; };
+ F96D3EE808F272A7004A47F5 /* tclCompile.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclCompile.h; sourceTree = "<group>"; };
+ F96D3EE908F272A7004A47F5 /* tclConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclConfig.c; sourceTree = "<group>"; };
+ F96D3EEA08F272A7004A47F5 /* tclDate.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDate.c; sourceTree = "<group>"; };
+ F96D3EEB08F272A7004A47F5 /* tclDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclDecls.h; sourceTree = "<group>"; };
+ F96D3EEC08F272A7004A47F5 /* tclDictObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDictObj.c; sourceTree = "<group>"; };
+ F96D3EED08F272A7004A47F5 /* tclEncoding.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEncoding.c; sourceTree = "<group>"; };
+ F96D3EEE08F272A7004A47F5 /* tclEnv.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEnv.c; sourceTree = "<group>"; };
+ F96D3EEF08F272A7004A47F5 /* tclEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEvent.c; sourceTree = "<group>"; };
+ F96D3EF008F272A7004A47F5 /* tclExecute.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclExecute.c; sourceTree = "<group>"; };
+ F96D3EF108F272A7004A47F5 /* tclFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFCmd.c; sourceTree = "<group>"; };
+ F96D3EF208F272A7004A47F5 /* tclFileName.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFileName.c; sourceTree = "<group>"; };
+ F96D3EF308F272A7004A47F5 /* tclFileSystem.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclFileSystem.h; sourceTree = "<group>"; };
+ F96D3EF408F272A7004A47F5 /* tclGet.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclGet.c; sourceTree = "<group>"; };
+ F96D3EF508F272A7004A47F5 /* tclGetDate.y */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.yacc; path = tclGetDate.y; sourceTree = "<group>"; };
+ F96D3EF608F272A7004A47F5 /* tclHash.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHash.c; sourceTree = "<group>"; };
+ F96D3EF708F272A7004A47F5 /* tclHistory.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHistory.c; sourceTree = "<group>"; };
+ F96D3EF808F272A7004A47F5 /* tclIndexObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIndexObj.c; sourceTree = "<group>"; };
+ F96D3EF908F272A7004A47F5 /* tclInt.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclInt.decls; sourceTree = "<group>"; };
+ F96D3EFA08F272A7004A47F5 /* tclInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclInt.h; sourceTree = "<group>"; };
+ F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntDecls.h; sourceTree = "<group>"; };
+ F96D3EFC08F272A7004A47F5 /* tclInterp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclInterp.c; sourceTree = "<group>"; };
+ F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntPlatDecls.h; sourceTree = "<group>"; };
+ F96D3EFE08F272A7004A47F5 /* tclIO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIO.c; sourceTree = "<group>"; };
+ F96D3EFF08F272A7004A47F5 /* tclIO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIO.h; sourceTree = "<group>"; };
+ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOCmd.c; sourceTree = "<group>"; };
+ F96D3F0108F272A7004A47F5 /* tclIOGT.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOGT.c; sourceTree = "<group>"; };
+ F96D3F0208F272A7004A47F5 /* tclIORChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORChan.c; sourceTree = "<group>"; };
+ F96D3F0308F272A7004A47F5 /* tclIOSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOSock.c; sourceTree = "<group>"; };
+ F96D3F0408F272A7004A47F5 /* tclIOUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOUtil.c; sourceTree = "<group>"; };
+ F96D3F0508F272A7004A47F5 /* tclLink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLink.c; sourceTree = "<group>"; };
+ F96D3F0608F272A7004A47F5 /* tclListObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclListObj.c; sourceTree = "<group>"; };
+ F96D3F0708F272A7004A47F5 /* tclLiteral.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLiteral.c; sourceTree = "<group>"; };
+ F96D3F0808F272A7004A47F5 /* tclLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoad.c; sourceTree = "<group>"; };
+ F96D3F0908F272A7004A47F5 /* tclLoadNone.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNone.c; sourceTree = "<group>"; };
+ F96D3F0A08F272A7004A47F5 /* tclMain.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMain.c; sourceTree = "<group>"; };
+ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNamesp.c; sourceTree = "<group>"; };
+ F96D3F0C08F272A7004A47F5 /* tclNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNotify.c; sourceTree = "<group>"; };
+ F96D3F0D08F272A7004A47F5 /* tclObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclObj.c; sourceTree = "<group>"; };
+ F96D3F0E08F272A7004A47F5 /* tclPanic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPanic.c; sourceTree = "<group>"; };
+ F96D3F0F08F272A7004A47F5 /* tclParse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclParse.c; sourceTree = "<group>"; };
+ F96D3F1108F272A7004A47F5 /* tclPathObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPathObj.c; sourceTree = "<group>"; };
+ F96D3F1208F272A7004A47F5 /* tclPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPipe.c; sourceTree = "<group>"; };
+ F96D3F1308F272A7004A47F5 /* tclPkg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkg.c; sourceTree = "<group>"; };
+ F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkgConfig.c; sourceTree = "<group>"; };
+ F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPlatDecls.h; sourceTree = "<group>"; };
+ F96D3F1608F272A7004A47F5 /* tclPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPort.h; sourceTree = "<group>"; };
+ F96D3F1708F272A7004A47F5 /* tclPosixStr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPosixStr.c; sourceTree = "<group>"; };
+ F96D3F1808F272A7004A47F5 /* tclPreserve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPreserve.c; sourceTree = "<group>"; };
+ F96D3F1908F272A7004A47F5 /* tclProc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclProc.c; sourceTree = "<group>"; };
+ F96D3F1A08F272A7004A47F5 /* tclRegexp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclRegexp.c; sourceTree = "<group>"; };
+ F96D3F1B08F272A7004A47F5 /* tclRegexp.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclRegexp.h; sourceTree = "<group>"; };
+ F96D3F1C08F272A7004A47F5 /* tclResolve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResolve.c; sourceTree = "<group>"; };
+ F96D3F1D08F272A7004A47F5 /* tclResult.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResult.c; sourceTree = "<group>"; };
+ F96D3F1E08F272A7004A47F5 /* tclScan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclScan.c; sourceTree = "<group>"; };
+ F96D3F1F08F272A7004A47F5 /* tclStringObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStringObj.c; sourceTree = "<group>"; };
+ F96D3F2408F272A7004A47F5 /* tclStrToD.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStrToD.c; sourceTree = "<group>"; };
+ F96D3F2508F272A7004A47F5 /* tclStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubInit.c; sourceTree = "<group>"; };
+ F96D3F2608F272A7004A47F5 /* tclStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubLib.c; sourceTree = "<group>"; };
+ F96D3F2708F272A7004A47F5 /* tclTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTest.c; sourceTree = "<group>"; };
+ F96D3F2808F272A7004A47F5 /* tclTestObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestObj.c; sourceTree = "<group>"; };
+ F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = "<group>"; };
+ F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = "<group>"; };
+ F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = "<group>"; };
+ F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = "<group>"; };
+ F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = "<group>"; };
+ F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = "<group>"; };
+ F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = "<group>"; };
+ F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = "<group>"; };
+ F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = "<group>"; };
+ F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = "<group>"; };
+ F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = "<group>"; };
+ F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = "<group>"; };
+ F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = "<group>"; };
+ F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = "<group>"; };
+ F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = "<group>"; };
+ F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = "<group>"; };
+ F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = "<group>"; };
+ F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = "<group>"; };
+ F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
+ F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
+ F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F9308F272A8004A47F5 /* init.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.tcl; sourceTree = "<group>"; };
+ F96D3F9508F272A8004A47F5 /* msgcat.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.tcl; sourceTree = "<group>"; };
+ F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401808F272AA004A47F5 /* optparse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optparse.tcl; sourceTree = "<group>"; };
+ F96D401908F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401A08F272AA004A47F5 /* package.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.tcl; sourceTree = "<group>"; };
+ F96D401B08F272AA004A47F5 /* parray.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parray.tcl; sourceTree = "<group>"; };
+ F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = "<group>"; };
+ F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = "<group>"; };
+ F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; };
+ F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; };
+ F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; };
+ F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; };
+ F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; };
+ F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; };
+ F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; };
+ F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; };
+ F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; };
+ F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; };
+ F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = "<group>"; };
+ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; };
+ F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; };
+ F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; };
+ F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; };
+ F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; };
+ F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; };
+ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = "<group>"; };
+ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; };
+ F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; };
+ F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; };
+ F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; };
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; };
+ F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; };
+ F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; };
+ F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; };
+ F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; };
+ F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; };
+ F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; };
+ F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; };
+ F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; };
+ F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; };
+ F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; };
+ F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; };
+ F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; };
+ F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; };
+ F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; };
+ F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; };
+ F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; };
+ F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; };
+ F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; };
+ F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; };
+ F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; };
+ F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; };
+ F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; };
+ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; };
+ F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; };
+ F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; };
+ F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; };
+ F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; };
+ F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; };
+ F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; };
+ F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; };
+ F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; };
+ F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; };
+ F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; };
+ F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; };
+ F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; };
+ F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; };
+ F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; };
+ F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; };
+ F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; };
+ F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; };
+ F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; };
+ F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; };
+ F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; };
+ F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; };
+ F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = "<group>"; };
+ F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = "<group>"; };
+ F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = "<group>"; };
+ F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXBundle.c; sourceTree = "<group>"; };
+ F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXFCmd.c; sourceTree = "<group>"; };
+ F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXNotify.c; sourceTree = "<group>"; };
+ F96D434308F272B5004A47F5 /* README */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = README; sourceTree = "<group>"; };
+ F96D434508F272B5004A47F5 /* all.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = all.tcl; sourceTree = "<group>"; };
+ F96D434608F272B5004A47F5 /* append.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = append.test; sourceTree = "<group>"; };
+ F96D434708F272B5004A47F5 /* appendComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = appendComp.test; sourceTree = "<group>"; };
+ F96D434808F272B5004A47F5 /* assocd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = assocd.test; sourceTree = "<group>"; };
+ F96D434908F272B5004A47F5 /* async.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = async.test; sourceTree = "<group>"; };
+ F96D434A08F272B5004A47F5 /* autoMkindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = autoMkindex.test; sourceTree = "<group>"; };
+ F96D434B08F272B5004A47F5 /* basic.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = basic.test; sourceTree = "<group>"; };
+ F96D434C08F272B5004A47F5 /* binary.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = binary.test; sourceTree = "<group>"; };
+ F96D434D08F272B5004A47F5 /* case.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = case.test; sourceTree = "<group>"; };
+ F96D434E08F272B5004A47F5 /* chan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chan.test; sourceTree = "<group>"; };
+ F96D434F08F272B5004A47F5 /* clock.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.test; sourceTree = "<group>"; };
+ F96D435008F272B5004A47F5 /* cmdAH.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdAH.test; sourceTree = "<group>"; };
+ F96D435108F272B5004A47F5 /* cmdIL.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdIL.test; sourceTree = "<group>"; };
+ F96D435208F272B5004A47F5 /* cmdInfo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdInfo.test; sourceTree = "<group>"; };
+ F96D435308F272B5004A47F5 /* cmdMZ.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdMZ.test; sourceTree = "<group>"; };
+ F96D435408F272B5004A47F5 /* compExpr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "compExpr-old.test"; sourceTree = "<group>"; };
+ F96D435508F272B5004A47F5 /* compExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compExpr.test; sourceTree = "<group>"; };
+ F96D435608F272B5004A47F5 /* compile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compile.test; sourceTree = "<group>"; };
+ F96D435708F272B5004A47F5 /* concat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = concat.test; sourceTree = "<group>"; };
+ F96D435808F272B5004A47F5 /* config.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = config.test; sourceTree = "<group>"; };
+ F96D435908F272B5004A47F5 /* dcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dcall.test; sourceTree = "<group>"; };
+ F96D435A08F272B5004A47F5 /* dict.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dict.test; sourceTree = "<group>"; };
+ F96D435C08F272B5004A47F5 /* dstring.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dstring.test; sourceTree = "<group>"; };
+ F96D435E08F272B5004A47F5 /* encoding.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = encoding.test; sourceTree = "<group>"; };
+ F96D435F08F272B5004A47F5 /* env.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = env.test; sourceTree = "<group>"; };
+ F96D436008F272B5004A47F5 /* error.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = error.test; sourceTree = "<group>"; };
+ F96D436108F272B5004A47F5 /* eval.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eval.test; sourceTree = "<group>"; };
+ F96D436208F272B5004A47F5 /* event.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = event.test; sourceTree = "<group>"; };
+ F96D436308F272B5004A47F5 /* exec.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = exec.test; sourceTree = "<group>"; };
+ F96D436408F272B5004A47F5 /* execute.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = execute.test; sourceTree = "<group>"; };
+ F96D436508F272B5004A47F5 /* expr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "expr-old.test"; sourceTree = "<group>"; };
+ F96D436608F272B5004A47F5 /* expr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = expr.test; sourceTree = "<group>"; };
+ F96D436708F272B6004A47F5 /* fCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fCmd.test; sourceTree = "<group>"; };
+ F96D436808F272B6004A47F5 /* fileName.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileName.test; sourceTree = "<group>"; };
+ F96D436908F272B6004A47F5 /* fileSystem.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileSystem.test; sourceTree = "<group>"; };
+ F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = "<group>"; };
+ F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = "<group>"; };
+ F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = "<group>"; };
+ F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = "<group>"; };
+ F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; };
+ F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; };
+ F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; };
+ F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; };
+ F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; };
+ F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; };
+ F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; };
+ F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = "<group>"; };
+ F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = "<group>"; };
+ F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = "<group>"; };
+ F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = "<group>"; };
+ F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = "<group>"; };
+ F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = "<group>"; };
+ F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; };
+ F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; };
+ F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; };
+ F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; };
+ F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; };
+ F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; };
+ F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = "<group>"; };
+ F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = "<group>"; };
+ F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = "<group>"; };
+ F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = "<group>"; };
+ F96D438608F272B6004A47F5 /* load.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = load.test; sourceTree = "<group>"; };
+ F96D438708F272B6004A47F5 /* lrange.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrange.test; sourceTree = "<group>"; };
+ F96D438808F272B6004A47F5 /* lrepeat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrepeat.test; sourceTree = "<group>"; };
+ F96D438908F272B6004A47F5 /* lreplace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lreplace.test; sourceTree = "<group>"; };
+ F96D438A08F272B6004A47F5 /* lsearch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsearch.test; sourceTree = "<group>"; };
+ F96D438B08F272B6004A47F5 /* lset.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lset.test; sourceTree = "<group>"; };
+ F96D438C08F272B6004A47F5 /* lsetComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsetComp.test; sourceTree = "<group>"; };
+ F96D438D08F272B6004A47F5 /* macOSXFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXFCmd.test; sourceTree = "<group>"; };
+ F96D438E08F272B6004A47F5 /* main.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = main.test; sourceTree = "<group>"; };
+ F96D438F08F272B6004A47F5 /* misc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = misc.test; sourceTree = "<group>"; };
+ F96D439008F272B6004A47F5 /* msgcat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.test; sourceTree = "<group>"; };
+ F96D439108F272B6004A47F5 /* namespace-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "namespace-old.test"; sourceTree = "<group>"; };
+ F96D439208F272B7004A47F5 /* namespace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = namespace.test; sourceTree = "<group>"; };
+ F96D439308F272B7004A47F5 /* notify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = notify.test; sourceTree = "<group>"; };
+ F96D439408F272B7004A47F5 /* obj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = obj.test; sourceTree = "<group>"; };
+ F96D439508F272B7004A47F5 /* opt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = opt.test; sourceTree = "<group>"; };
+ F96D439608F272B7004A47F5 /* package.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.test; sourceTree = "<group>"; };
+ F96D439708F272B7004A47F5 /* parse.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parse.test; sourceTree = "<group>"; };
+ F96D439808F272B7004A47F5 /* parseExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseExpr.test; sourceTree = "<group>"; };
+ F96D439908F272B7004A47F5 /* parseOld.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseOld.test; sourceTree = "<group>"; };
+ F96D439A08F272B7004A47F5 /* pid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pid.test; sourceTree = "<group>"; };
+ F96D439B08F272B7004A47F5 /* pkg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkg.test; sourceTree = "<group>"; };
+ F96D439C08F272B7004A47F5 /* pkgMkIndex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgMkIndex.test; sourceTree = "<group>"; };
+ F96D439D08F272B7004A47F5 /* platform.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.test; sourceTree = "<group>"; };
+ F96D439E08F272B7004A47F5 /* proc-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "proc-old.test"; sourceTree = "<group>"; };
+ F96D439F08F272B7004A47F5 /* proc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = proc.test; sourceTree = "<group>"; };
+ F96D43A008F272B7004A47F5 /* pwd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pwd.test; sourceTree = "<group>"; };
+ F96D43A108F272B7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D43A208F272B7004A47F5 /* reg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = reg.test; sourceTree = "<group>"; };
+ F96D43A308F272B7004A47F5 /* regexp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexp.test; sourceTree = "<group>"; };
+ F96D43A408F272B7004A47F5 /* regexpComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpComp.test; sourceTree = "<group>"; };
+ F96D43A508F272B7004A47F5 /* registry.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = registry.test; sourceTree = "<group>"; };
+ F96D43A608F272B7004A47F5 /* remote.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = remote.tcl; sourceTree = "<group>"; };
+ F96D43A708F272B7004A47F5 /* rename.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = rename.test; sourceTree = "<group>"; };
+ F96D43A808F272B7004A47F5 /* result.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = result.test; sourceTree = "<group>"; };
+ F96D43A908F272B7004A47F5 /* safe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.test; sourceTree = "<group>"; };
+ F96D43AA08F272B7004A47F5 /* scan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scan.test; sourceTree = "<group>"; };
+ F96D43AB08F272B7004A47F5 /* security.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = security.test; sourceTree = "<group>"; };
+ F96D43AC08F272B7004A47F5 /* set-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "set-old.test"; sourceTree = "<group>"; };
+ F96D43AD08F272B7004A47F5 /* set.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = set.test; sourceTree = "<group>"; };
+ F96D43AE08F272B7004A47F5 /* socket.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = socket.test; sourceTree = "<group>"; };
+ F96D43AF08F272B7004A47F5 /* source.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = source.test; sourceTree = "<group>"; };
+ F96D43B008F272B7004A47F5 /* split.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = split.test; sourceTree = "<group>"; };
+ F96D43B108F272B7004A47F5 /* stack.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stack.test; sourceTree = "<group>"; };
+ F96D43B208F272B7004A47F5 /* string.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = string.test; sourceTree = "<group>"; };
+ F96D43B308F272B7004A47F5 /* stringComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringComp.test; sourceTree = "<group>"; };
+ F96D43B408F272B7004A47F5 /* stringObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringObj.test; sourceTree = "<group>"; };
+ F96D43B508F272B7004A47F5 /* subst.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = subst.test; sourceTree = "<group>"; };
+ F96D43B608F272B7004A47F5 /* switch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = switch.test; sourceTree = "<group>"; };
+ F96D43B708F272B7004A47F5 /* tcltest.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.test; sourceTree = "<group>"; };
+ F96D43B808F272B7004A47F5 /* thread.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = thread.test; sourceTree = "<group>"; };
+ F96D43B908F272B7004A47F5 /* timer.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = timer.test; sourceTree = "<group>"; };
+ F96D43BA08F272B7004A47F5 /* tm.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.test; sourceTree = "<group>"; };
+ F96D43BB08F272B7004A47F5 /* trace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = trace.test; sourceTree = "<group>"; };
+ F96D43BC08F272B7004A47F5 /* unixFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFCmd.test; sourceTree = "<group>"; };
+ F96D43BD08F272B7004A47F5 /* unixFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFile.test; sourceTree = "<group>"; };
+ F96D43BE08F272B7004A47F5 /* unixInit.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixInit.test; sourceTree = "<group>"; };
+ F96D43BF08F272B7004A47F5 /* unixNotfy.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixNotfy.test; sourceTree = "<group>"; };
+ F96D43C008F272B7004A47F5 /* unknown.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unknown.test; sourceTree = "<group>"; };
+ F96D43C108F272B7004A47F5 /* unload.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unload.test; sourceTree = "<group>"; };
+ F96D43C208F272B7004A47F5 /* uplevel.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uplevel.test; sourceTree = "<group>"; };
+ F96D43C308F272B7004A47F5 /* upvar.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = upvar.test; sourceTree = "<group>"; };
+ F96D43C408F272B7004A47F5 /* utf.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = utf.test; sourceTree = "<group>"; };
+ F96D43C508F272B7004A47F5 /* util.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = util.test; sourceTree = "<group>"; };
+ F96D43C608F272B7004A47F5 /* var.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = var.test; sourceTree = "<group>"; };
+ F96D43C708F272B7004A47F5 /* while-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "while-old.test"; sourceTree = "<group>"; };
+ F96D43C808F272B7004A47F5 /* while.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = while.test; sourceTree = "<group>"; };
+ F96D43C908F272B7004A47F5 /* winConsole.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winConsole.test; sourceTree = "<group>"; };
+ F96D43CA08F272B7004A47F5 /* winDde.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winDde.test; sourceTree = "<group>"; };
+ F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = "<group>"; };
+ F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = "<group>"; };
+ F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = "<group>"; };
+ F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = "<group>"; };
+ F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
+ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
+ F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D442208F272B8004A47F5 /* eolFix.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eolFix.tcl; sourceTree = "<group>"; };
+ F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
+ F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
+ F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
+ F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
+ F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
+ F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
+ F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
+ F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
+ F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
+ F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
+ F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
+ F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
+ 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>"; };
+ 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>"; };
+ F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
+ F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
+ F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
+ F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
+ F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = "<group>"; };
+ F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = "<group>"; };
+ F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = "<group>"; };
+ F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = "<group>"; };
+ F96D444C08F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D444D08F272B9004A47F5 /* install-sh */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = "install-sh"; sourceTree = "<group>"; };
+ F96D444E08F272B9004A47F5 /* installManPage */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = installManPage; sourceTree = "<group>"; };
+ F96D444F08F272B9004A47F5 /* ldAix */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = ldAix; sourceTree = "<group>"; };
+ F96D445008F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D445208F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D445308F272B9004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
+ F96D445408F272B9004A47F5 /* tcl.spec */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.spec; sourceTree = "<group>"; };
+ F96D445508F272B9004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
+ F96D445608F272B9004A47F5 /* tclConfig.h.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = tclConfig.h.in; sourceTree = "<group>"; };
+ F96D445708F272B9004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
+ F96D445808F272B9004A47F5 /* tclLoadAix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadAix.c; sourceTree = "<group>"; };
+ F96D445908F272B9004A47F5 /* tclLoadDl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDl.c; sourceTree = "<group>"; };
+ F96D445B08F272B9004A47F5 /* tclLoadDyld.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDyld.c; sourceTree = "<group>"; };
+ F96D445C08F272B9004A47F5 /* tclLoadNext.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNext.c; sourceTree = "<group>"; };
+ F96D445D08F272B9004A47F5 /* tclLoadOSF.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadOSF.c; sourceTree = "<group>"; };
+ F96D445E08F272B9004A47F5 /* tclLoadShl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadShl.c; sourceTree = "<group>"; };
+ F96D445F08F272B9004A47F5 /* tclUnixChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixChan.c; sourceTree = "<group>"; };
+ F96D446008F272B9004A47F5 /* tclUnixEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixEvent.c; sourceTree = "<group>"; };
+ F96D446108F272B9004A47F5 /* tclUnixFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFCmd.c; sourceTree = "<group>"; };
+ F96D446208F272B9004A47F5 /* tclUnixFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFile.c; sourceTree = "<group>"; };
+ F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
+ F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
+ F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
+ F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
+ 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>"; };
+ 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>"; };
+ F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
+ F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
+ F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
+ F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
+ F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
+ F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
+ F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
+ F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
+ F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
+ F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
+ F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; };
+ F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
+ F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
+ F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; };
+ F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
+ F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
+ F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; };
+ F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; };
+ F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; };
+ F96D448908F272BA004A47F5 /* tclWinConsole.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinConsole.c; sourceTree = "<group>"; };
+ F96D448A08F272BA004A47F5 /* tclWinDde.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinDde.c; sourceTree = "<group>"; };
+ F96D448B08F272BA004A47F5 /* tclWinError.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinError.c; sourceTree = "<group>"; };
+ F96D448C08F272BA004A47F5 /* tclWinFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFCmd.c; sourceTree = "<group>"; };
+ F96D448D08F272BA004A47F5 /* tclWinFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFile.c; sourceTree = "<group>"; };
+ F96D448E08F272BA004A47F5 /* tclWinInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinInit.c; sourceTree = "<group>"; };
+ F96D448F08F272BA004A47F5 /* tclWinInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinInt.h; sourceTree = "<group>"; };
+ F96D449008F272BA004A47F5 /* tclWinLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinLoad.c; sourceTree = "<group>"; };
+ F96D449108F272BA004A47F5 /* tclWinNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinNotify.c; sourceTree = "<group>"; };
+ F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = "<group>"; };
+ F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = "<group>"; };
+ F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = "<group>"; };
+ F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = "<group>"; };
+ F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = "<group>"; };
+ F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = "<group>"; };
+ F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; };
+ F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = "<group>"; };
+ F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; };
+ F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; };
+ F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; };
+ F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; };
+ F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; };
+ F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; };
+ F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; };
+ F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; };
+ F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = "<group>"; };
+ F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = "<group>"; };
+ F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = "<group>"; };
+ F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; };
+ F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; };
+ F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; };
+ F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; };
+ F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
+ F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
+ F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = "<group>"; };
+ F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
+ F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
+ F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
+ F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
+/* End PBXFileReference section */
+
+/* Begin PBXFrameworksBuildPhase section */
+ 8DD76FAD0486AB0100D96B5E /* Frameworks */ = {
+ isa = PBXFrameworksBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */,
+ F96437E70EF0D652003F468E /* libz.dylib in Frameworks */,
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+/* End PBXFrameworksBuildPhase section */
+
+/* Begin PBXGroup section */
+ 08FB7794FE84155DC02AAC07 /* Tcl */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3DF608F27169004A47F5 /* Tcl Sources */,
+ 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\n";
+ name = Tcl;
+ path = .;
+ sourceTree = SOURCE_ROOT;
+ };
+ 1AB674ADFE9D54B511CA2CBB /* Products */ = {
+ isa = PBXGroup;
+ children = (
+ F9A3084B08F2D4CE00BAE1AB /* tclsh */,
+ 8DD76FB20486AB0100D96B5E /* tcltest */,
+ F9A3084E08F2D4F400BAE1AB /* Tcl.framework */,
+ );
+ includeInIndex = 0;
+ name = Products;
+ sourceTree = "<group>";
+ };
+ F9183E690EFC81560030B814 /* pkgs */ = {
+ isa = PBXGroup;
+ children = (
+ F9183E6A0EFC81560030B814 /* README */,
+ F946FB8B0FBE3AED00CD6495 /* itcl */,
+ F9183E8F0EFC817B0030B814 /* tdbc */,
+ );
+ path = pkgs;
+ sourceTree = "<group>";
+ };
+ F966C06F08F281DC005CB29B /* Frameworks */ = {
+ isa = PBXGroup;
+ children = (
+ F966C07408F2820D005CB29B /* CoreFoundation.framework */,
+ F96437E60EF0D652003F468E /* libz.dylib */,
+ );
+ name = Frameworks;
+ sourceTree = "<group>";
+ };
+ F96D3DF608F27169004A47F5 /* Tcl Sources */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3EC908F272A7004A47F5 /* generic */,
+ F96D432C08F272B4004A47F5 /* macosx */,
+ F96D443E08F272B9004A47F5 /* unix */,
+ F96D425C08F272B2004A47F5 /* libtommath */,
+ F96D446E08F272B9004A47F5 /* win */,
+ F96D3F3808F272A7004A47F5 /* library */,
+ F96D434408F272B5004A47F5 /* tests */,
+ F96D3DFC08F272A4004A47F5 /* doc */,
+ F96D43D008F272B8004A47F5 /* tools */,
+ F9183E690EFC81560030B814 /* pkgs */,
+ F96D3DFA08F272A4004A47F5 /* ChangeLog */,
+ F96D3DFB08F272A4004A47F5 /* changes */,
+ F96D434308F272B5004A47F5 /* README */,
+ F96D432B08F272B4004A47F5 /* license.terms */,
+ );
+ name = "Tcl Sources";
+ sourceTree = TCL_SRCROOT;
+ };
+ F96D3DFC08F272A4004A47F5 /* doc */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3DFD08F272A4004A47F5 /* Access.3 */,
+ F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */,
+ F96D3DFF08F272A4004A47F5 /* after.n */,
+ F96D3E0008F272A4004A47F5 /* Alloc.3 */,
+ F96D3E0108F272A4004A47F5 /* AllowExc.3 */,
+ F96D3E0208F272A4004A47F5 /* append.n */,
+ F96D3E0308F272A4004A47F5 /* AppInit.3 */,
+ F96D3E0408F272A5004A47F5 /* array.n */,
+ F96D3E0508F272A5004A47F5 /* AssocData.3 */,
+ F96D3E0608F272A5004A47F5 /* Async.3 */,
+ F96D3E0708F272A5004A47F5 /* BackgdErr.3 */,
+ F96D3E0808F272A5004A47F5 /* Backslash.3 */,
+ F96D3E0908F272A5004A47F5 /* bgerror.n */,
+ F96D3E0A08F272A5004A47F5 /* binary.n */,
+ F96D3E0B08F272A5004A47F5 /* BoolObj.3 */,
+ F96D3E0C08F272A5004A47F5 /* break.n */,
+ F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */,
+ F96D3E0E08F272A5004A47F5 /* CallDel.3 */,
+ F96D3E0F08F272A5004A47F5 /* case.n */,
+ F96D3E1008F272A5004A47F5 /* catch.n */,
+ F96D3E1108F272A5004A47F5 /* cd.n */,
+ F96D3E1208F272A5004A47F5 /* chan.n */,
+ F96D3E1308F272A5004A47F5 /* ChnlStack.3 */,
+ F93599CF0DF1F87F00E04F67 /* Class.3 */,
+ F93599D00DF1F89E00E04F67 /* class.n */,
+ F96D3E1408F272A5004A47F5 /* clock.n */,
+ F96D3E1508F272A5004A47F5 /* close.n */,
+ F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */,
+ F96D3E1708F272A5004A47F5 /* Concat.3 */,
+ F96D3E1808F272A5004A47F5 /* concat.n */,
+ F96D3E1908F272A5004A47F5 /* continue.n */,
+ F93599D20DF1F8DF00E04F67 /* copy.n */,
+ F974D5720FBE7DC600BF728B /* coroutine.n */,
+ F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */,
+ F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */,
+ F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */,
+ F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */,
+ F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */,
+ F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
+ F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
+ F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
+ F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
+ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
+ F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
+ F96D3E2508F272A5004A47F5 /* dde.n */,
+ F93599D30DF1F8F500E04F67 /* define.n */,
+ F96D3E2608F272A5004A47F5 /* DetachPids.3 */,
+ F96D3E2708F272A5004A47F5 /* dict.n */,
+ F96D3E2808F272A5004A47F5 /* DictObj.3 */,
+ F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */,
+ F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */,
+ F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */,
+ F96D3E2C08F272A5004A47F5 /* DString.3 */,
+ F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */,
+ F96D3E2E08F272A5004A47F5 /* Encoding.3 */,
+ F96D3E2F08F272A5004A47F5 /* encoding.n */,
+ F96D3E3008F272A5004A47F5 /* Ensemble.3 */,
+ F96D3E3108F272A5004A47F5 /* Environment.3 */,
+ F96D3E3208F272A5004A47F5 /* eof.n */,
+ F96D3E3308F272A5004A47F5 /* error.n */,
+ F96D3E3408F272A5004A47F5 /* Eval.3 */,
+ F96D3E3508F272A5004A47F5 /* eval.n */,
+ F96D3E3608F272A5004A47F5 /* exec.n */,
+ F96D3E3708F272A5004A47F5 /* Exit.3 */,
+ F96D3E3808F272A5004A47F5 /* exit.n */,
+ F96D3E3908F272A5004A47F5 /* expr.n */,
+ F96D3E3A08F272A5004A47F5 /* ExprLong.3 */,
+ F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */,
+ F96D3E3C08F272A5004A47F5 /* fblocked.n */,
+ F96D3E3D08F272A5004A47F5 /* fconfigure.n */,
+ F96D3E3E08F272A5004A47F5 /* fcopy.n */,
+ F96D3E3F08F272A5004A47F5 /* file.n */,
+ F96D3E4008F272A5004A47F5 /* fileevent.n */,
+ F96D3E4108F272A5004A47F5 /* filename.n */,
+ F96D3E4208F272A5004A47F5 /* FileSystem.3 */,
+ F96D3E4308F272A5004A47F5 /* FindExec.3 */,
+ F96D3E4408F272A5004A47F5 /* flush.n */,
+ F96D3E4508F272A5004A47F5 /* for.n */,
+ F96D3E4608F272A5004A47F5 /* foreach.n */,
+ F96D3E4708F272A5004A47F5 /* format.n */,
+ F96D3E4808F272A5004A47F5 /* GetCwd.3 */,
+ F96D3E4908F272A5004A47F5 /* GetHostName.3 */,
+ F96D3E4A08F272A5004A47F5 /* GetIndex.3 */,
+ F96D3E4B08F272A5004A47F5 /* GetInt.3 */,
+ F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */,
+ F96D3E4D08F272A5004A47F5 /* gets.n */,
+ F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */,
+ F96D3E4F08F272A5004A47F5 /* GetTime.3 */,
+ F96D3E5008F272A5004A47F5 /* GetVersion.3 */,
+ F96D3E5108F272A5004A47F5 /* glob.n */,
+ F96D3E5208F272A6004A47F5 /* global.n */,
+ F96D3E5308F272A6004A47F5 /* Hash.3 */,
+ F96D3E5408F272A6004A47F5 /* history.n */,
+ F96D3E5508F272A6004A47F5 /* http.n */,
+ F96D3E5608F272A6004A47F5 /* if.n */,
+ F96D3E5708F272A6004A47F5 /* incr.n */,
+ F96D3E5808F272A6004A47F5 /* info.n */,
+ F96D3E5908F272A6004A47F5 /* Init.3 */,
+ F96D3E5A08F272A6004A47F5 /* InitStubs.3 */,
+ F96D3E5B08F272A6004A47F5 /* Interp.3 */,
+ F96D3E5C08F272A6004A47F5 /* interp.n */,
+ F96D3E5D08F272A6004A47F5 /* IntObj.3 */,
+ F96D3E5E08F272A6004A47F5 /* join.n */,
+ F96D3E5F08F272A6004A47F5 /* lappend.n */,
+ F96D3E6008F272A6004A47F5 /* lassign.n */,
+ F96D3E6108F272A6004A47F5 /* library.n */,
+ F96D3E6208F272A6004A47F5 /* Limit.3 */,
+ F96D3E6308F272A6004A47F5 /* lindex.n */,
+ F96D3E6408F272A6004A47F5 /* LinkVar.3 */,
+ F96D3E6508F272A6004A47F5 /* linsert.n */,
+ F96D3E6608F272A6004A47F5 /* list.n */,
+ F96D3E6708F272A6004A47F5 /* ListObj.3 */,
+ F96D3E6808F272A6004A47F5 /* llength.n */,
+ F96D3E6908F272A6004A47F5 /* load.n */,
+ F96D3E6A08F272A6004A47F5 /* lrange.n */,
+ F96D3E6B08F272A6004A47F5 /* lrepeat.n */,
+ F96D3E6C08F272A6004A47F5 /* lreplace.n */,
+ F96D3E6D08F272A6004A47F5 /* lsearch.n */,
+ F96D3E6E08F272A6004A47F5 /* lset.n */,
+ F96D3E6F08F272A6004A47F5 /* lsort.n */,
+ F96D3E7008F272A6004A47F5 /* man.macros */,
+ F96D3E7108F272A6004A47F5 /* mathfunc.n */,
+ F96D3E7208F272A6004A47F5 /* memory.n */,
+ F93599D40DF1F91900E04F67 /* Method.3 */,
+ F96D3E7308F272A6004A47F5 /* msgcat.n */,
+ F93599D50DF1F93700E04F67 /* my.n */,
+ F96D3E7408F272A6004A47F5 /* Namespace.3 */,
+ F96D3E7508F272A6004A47F5 /* namespace.n */,
+ F93599D60DF1F95000E04F67 /* next.n */,
+ F96D3E7608F272A6004A47F5 /* Notifier.3 */,
+ F96D3E7708F272A6004A47F5 /* Object.3 */,
+ F93599D70DF1F96800E04F67 /* object.n */,
+ F96D3E7808F272A6004A47F5 /* ObjectType.3 */,
+ F96D3E7908F272A6004A47F5 /* open.n */,
+ F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */,
+ F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */,
+ F96D3E7C08F272A6004A47F5 /* package.n */,
+ F96D3E7D08F272A6004A47F5 /* packagens.n */,
+ F96D3E7E08F272A6004A47F5 /* Panic.3 */,
+ F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */,
+ F96D3E8008F272A6004A47F5 /* pid.n */,
+ F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */,
+ F96D3E8208F272A6004A47F5 /* PkgRequire.3 */,
+ F9ECB1E10B26543C00A28025 /* platform_shell.n */,
+ F9ECB1E20B26543C00A28025 /* platform.n */,
+ F96D3E8308F272A6004A47F5 /* Preserve.3 */,
+ F96D3E8408F272A6004A47F5 /* PrintDbl.3 */,
+ F96D3E8508F272A6004A47F5 /* proc.n */,
+ F96D3E8608F272A6004A47F5 /* puts.n */,
+ F96D3E8708F272A6004A47F5 /* pwd.n */,
+ F96D3E8808F272A6004A47F5 /* re_syntax.n */,
+ F96D3E8908F272A6004A47F5 /* read.n */,
+ F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */,
+ F96D3E8B08F272A6004A47F5 /* RecordEval.3 */,
+ F96D3E8C08F272A6004A47F5 /* RegConfig.3 */,
+ F96D3E8D08F272A6004A47F5 /* RegExp.3 */,
+ F96D3E8E08F272A6004A47F5 /* regexp.n */,
+ F96D3E8F08F272A6004A47F5 /* registry.n */,
+ F96D3E9008F272A6004A47F5 /* regsub.n */,
+ F96D3E9108F272A6004A47F5 /* rename.n */,
+ F96D3E9208F272A6004A47F5 /* return.n */,
+ F96D3E9308F272A6004A47F5 /* safe.n */,
+ F96D3E9408F272A6004A47F5 /* SaveResult.3 */,
+ F96D3E9508F272A6004A47F5 /* scan.n */,
+ F96D3E9608F272A6004A47F5 /* seek.n */,
+ F93599D80DF1F98300E04F67 /* self.n */,
+ F96D3E9708F272A6004A47F5 /* set.n */,
+ F96D3E9808F272A6004A47F5 /* SetChanErr.3 */,
+ F96D3E9908F272A6004A47F5 /* SetErrno.3 */,
+ F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */,
+ F96D3E9B08F272A7004A47F5 /* SetResult.3 */,
+ F96D3E9C08F272A7004A47F5 /* SetVar.3 */,
+ F96D3E9D08F272A7004A47F5 /* Signal.3 */,
+ F96D3E9E08F272A7004A47F5 /* Sleep.3 */,
+ F96D3E9F08F272A7004A47F5 /* socket.n */,
+ F96D3EA008F272A7004A47F5 /* source.n */,
+ F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */,
+ F96D3EA208F272A7004A47F5 /* split.n */,
+ F96D3EA308F272A7004A47F5 /* SplitList.3 */,
+ F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
+ F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
+ F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
+ F96D3EA708F272A7004A47F5 /* string.n */,
+ F96D3EA808F272A7004A47F5 /* StringObj.3 */,
+ F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
+ F96D3EAA08F272A7004A47F5 /* subst.n */,
+ F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
+ F96D3EAC08F272A7004A47F5 /* switch.n */,
+ F974D5760FBE7E1900BF728B /* tailcall.n */,
+ F96D3EAD08F272A7004A47F5 /* Tcl.n */,
+ F99D61180EF5573A00BBFE01 /* TclZlib.3 */,
+ F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */,
+ F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */,
+ F96D3EB008F272A7004A47F5 /* tclsh.1 */,
+ F96D3EB108F272A7004A47F5 /* tcltest.n */,
+ F96D3EB208F272A7004A47F5 /* tclvars.n */,
+ F96D3EB308F272A7004A47F5 /* tell.n */,
+ F96D3EB408F272A7004A47F5 /* Thread.3 */,
+ F9183E640EFC80CD0030B814 /* throw.n */,
+ F96D3EB508F272A7004A47F5 /* time.n */,
+ F96D3EB608F272A7004A47F5 /* tm.n */,
+ F96D3EB708F272A7004A47F5 /* ToUpper.3 */,
+ F96D3EB808F272A7004A47F5 /* trace.n */,
+ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */,
+ F96D3EBA08F272A7004A47F5 /* TraceVar.3 */,
+ F96D3EBB08F272A7004A47F5 /* Translate.3 */,
+ F9183E650EFC80D70030B814 /* try.n */,
+ F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */,
+ F96D3EBD08F272A7004A47F5 /* unknown.n */,
+ F96D3EBE08F272A7004A47F5 /* unload.n */,
+ F96D3EBF08F272A7004A47F5 /* unset.n */,
+ F96D3EC008F272A7004A47F5 /* update.n */,
+ F96D3EC108F272A7004A47F5 /* uplevel.n */,
+ F96D3EC208F272A7004A47F5 /* UpVar.3 */,
+ F96D3EC308F272A7004A47F5 /* upvar.n */,
+ F96D3EC408F272A7004A47F5 /* Utf.3 */,
+ F96D3EC508F272A7004A47F5 /* variable.n */,
+ F96D3EC608F272A7004A47F5 /* vwait.n */,
+ F96D3EC708F272A7004A47F5 /* while.n */,
+ F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */,
+ F915432D0EF201EE0032D1E8 /* zlib.n */,
+ );
+ path = doc;
+ sourceTree = "<group>";
+ };
+ F96D3EC908F272A7004A47F5 /* generic */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3ECA08F272A7004A47F5 /* README */,
+ F96D3ECB08F272A7004A47F5 /* regc_color.c */,
+ F96D3ECC08F272A7004A47F5 /* regc_cvec.c */,
+ F96D3ECD08F272A7004A47F5 /* regc_lex.c */,
+ F96D3ECE08F272A7004A47F5 /* regc_locale.c */,
+ F96D3ECF08F272A7004A47F5 /* regc_nfa.c */,
+ F96D3ED008F272A7004A47F5 /* regcomp.c */,
+ F96D3ED108F272A7004A47F5 /* regcustom.h */,
+ F96D3ED208F272A7004A47F5 /* rege_dfa.c */,
+ F96D3ED308F272A7004A47F5 /* regerror.c */,
+ F96D3ED408F272A7004A47F5 /* regerrs.h */,
+ F96D3ED508F272A7004A47F5 /* regex.h */,
+ F96D3ED608F272A7004A47F5 /* regexec.c */,
+ F96D3ED708F272A7004A47F5 /* regfree.c */,
+ F96D3ED808F272A7004A47F5 /* regfronts.c */,
+ F96D3ED908F272A7004A47F5 /* regguts.h */,
+ F96D3EDA08F272A7004A47F5 /* tcl.decls */,
+ F96D3EDB08F272A7004A47F5 /* tcl.h */,
+ F96D3EDC08F272A7004A47F5 /* tclAlloc.c */,
+ F96D3EDD08F272A7004A47F5 /* tclAsync.c */,
+ F96D3EDE08F272A7004A47F5 /* tclBasic.c */,
+ F96D3EDF08F272A7004A47F5 /* tclBinary.c */,
+ F96D3EE008F272A7004A47F5 /* tclCkalloc.c */,
+ F96D3EE108F272A7004A47F5 /* tclClock.c */,
+ F96D3EE208F272A7004A47F5 /* tclCmdAH.c */,
+ F96D3EE308F272A7004A47F5 /* tclCmdIL.c */,
+ F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */,
+ F96D3EE508F272A7004A47F5 /* tclCompCmds.c */,
+ F96D3EE608F272A7004A47F5 /* tclCompExpr.c */,
+ F96D3EE708F272A7004A47F5 /* tclCompile.c */,
+ F96D3EE808F272A7004A47F5 /* tclCompile.h */,
+ F96D3EE908F272A7004A47F5 /* tclConfig.c */,
+ F96D3EEA08F272A7004A47F5 /* tclDate.c */,
+ F96D3EEB08F272A7004A47F5 /* tclDecls.h */,
+ F96D3EEC08F272A7004A47F5 /* tclDictObj.c */,
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */,
+ F96D3EED08F272A7004A47F5 /* tclEncoding.c */,
+ F96D3EEE08F272A7004A47F5 /* tclEnv.c */,
+ F96D3EEF08F272A7004A47F5 /* tclEvent.c */,
+ F96D3EF008F272A7004A47F5 /* tclExecute.c */,
+ F96D3EF108F272A7004A47F5 /* tclFCmd.c */,
+ F96D3EF208F272A7004A47F5 /* tclFileName.c */,
+ F96D3EF308F272A7004A47F5 /* tclFileSystem.h */,
+ F96D3EF408F272A7004A47F5 /* tclGet.c */,
+ F96D3EF508F272A7004A47F5 /* tclGetDate.y */,
+ F96D3EF608F272A7004A47F5 /* tclHash.c */,
+ F96D3EF708F272A7004A47F5 /* tclHistory.c */,
+ F96D3EF808F272A7004A47F5 /* tclIndexObj.c */,
+ F96D3EF908F272A7004A47F5 /* tclInt.decls */,
+ F96D3EFA08F272A7004A47F5 /* tclInt.h */,
+ F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */,
+ F96D3EFC08F272A7004A47F5 /* tclInterp.c */,
+ F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */,
+ F96D3EFE08F272A7004A47F5 /* tclIO.c */,
+ F96D3EFF08F272A7004A47F5 /* tclIO.h */,
+ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */,
+ F96D3F0108F272A7004A47F5 /* tclIOGT.c */,
+ F96D3F0208F272A7004A47F5 /* tclIORChan.c */,
+ F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */,
+ F96D3F0308F272A7004A47F5 /* tclIOSock.c */,
+ F96D3F0408F272A7004A47F5 /* tclIOUtil.c */,
+ F96D3F0508F272A7004A47F5 /* tclLink.c */,
+ F96D3F0608F272A7004A47F5 /* tclListObj.c */,
+ F96D3F0708F272A7004A47F5 /* tclLiteral.c */,
+ F96D3F0808F272A7004A47F5 /* tclLoad.c */,
+ F96D3F0908F272A7004A47F5 /* tclLoadNone.c */,
+ F96D3F0A08F272A7004A47F5 /* tclMain.c */,
+ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */,
+ F96D3F0C08F272A7004A47F5 /* tclNotify.c */,
+ F96D3F0D08F272A7004A47F5 /* tclObj.c */,
+ F93599B20DF1F75400E04F67 /* tclOO.c */,
+ F93599B40DF1F75900E04F67 /* tclOO.decls */,
+ F93599B50DF1F75D00E04F67 /* tclOO.h */,
+ F93599B60DF1F76100E04F67 /* tclOOBasic.c */,
+ F93599B80DF1F76600E04F67 /* tclOOCall.c */,
+ F93599BA0DF1F76A00E04F67 /* tclOODecls.h */,
+ F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */,
+ F93599BD0DF1F77400E04F67 /* tclOOInfo.c */,
+ F93599BF0DF1F77900E04F67 /* tclOOInt.h */,
+ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */,
+ F93599C10DF1F78300E04F67 /* tclOOMethod.c */,
+ F93599C30DF1F78800E04F67 /* tclOOStubInit.c */,
+ F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */,
+ F96D3F0E08F272A7004A47F5 /* tclPanic.c */,
+ F96D3F0F08F272A7004A47F5 /* tclParse.c */,
+ F96D3F1108F272A7004A47F5 /* tclPathObj.c */,
+ F96D3F1208F272A7004A47F5 /* tclPipe.c */,
+ F96D3F1308F272A7004A47F5 /* tclPkg.c */,
+ F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */,
+ F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */,
+ F96D3F1608F272A7004A47F5 /* tclPort.h */,
+ F96D3F1708F272A7004A47F5 /* tclPosixStr.c */,
+ F96D3F1808F272A7004A47F5 /* tclPreserve.c */,
+ F96D3F1908F272A7004A47F5 /* tclProc.c */,
+ F96D3F1A08F272A7004A47F5 /* tclRegexp.c */,
+ F96D3F1B08F272A7004A47F5 /* tclRegexp.h */,
+ F96D3F1C08F272A7004A47F5 /* tclResolve.c */,
+ F96D3F1D08F272A7004A47F5 /* tclResult.c */,
+ F96D3F1E08F272A7004A47F5 /* tclScan.c */,
+ F96D3F1F08F272A7004A47F5 /* tclStringObj.c */,
+ F96D3F2408F272A7004A47F5 /* tclStrToD.c */,
+ F96D3F2508F272A7004A47F5 /* tclStubInit.c */,
+ F96D3F2608F272A7004A47F5 /* tclStubLib.c */,
+ F96D3F2708F272A7004A47F5 /* tclTest.c */,
+ F96D3F2808F272A7004A47F5 /* tclTestObj.c */,
+ F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */,
+ F96D3F2A08F272A7004A47F5 /* tclThread.c */,
+ F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */,
+ F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */,
+ F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */,
+ F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */,
+ F96D3F2F08F272A7004A47F5 /* tclTimer.c */,
+ F9903CAF094FAADA004613E9 /* tclTomMath.decls */,
+ F96D3F3008F272A7004A47F5 /* tclTomMath.h */,
+ F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */,
+ F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */,
+ F96D3F3208F272A7004A47F5 /* tclTrace.c */,
+ F96D3F3308F272A7004A47F5 /* tclUniData.c */,
+ F96D3F3408F272A7004A47F5 /* tclUtf.c */,
+ F96D3F3508F272A7004A47F5 /* tclUtil.c */,
+ F96D3F3608F272A7004A47F5 /* tclVar.c */,
+ F96437C90EF0D4B2003F468E /* tclZlib.c */,
+ F96D3F3708F272A7004A47F5 /* tommath.h */,
+ );
+ path = generic;
+ sourceTree = "<group>";
+ };
+ F96D3F3808F272A7004A47F5 /* library */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F3908F272A8004A47F5 /* auto.tcl */,
+ F96D3F3A08F272A8004A47F5 /* clock.tcl */,
+ F96D3F3B08F272A8004A47F5 /* dde */,
+ F96D3F8C08F272A8004A47F5 /* history.tcl */,
+ F96D3F8D08F272A8004A47F5 /* http */,
+ F96D3F9008F272A8004A47F5 /* http1.0 */,
+ F96D3F9308F272A8004A47F5 /* init.tcl */,
+ F96D3F9408F272A8004A47F5 /* msgcat */,
+ F96D401708F272AA004A47F5 /* opt */,
+ F96D401A08F272AA004A47F5 /* package.tcl */,
+ F96D401B08F272AA004A47F5 /* parray.tcl */,
+ F9ECB1110B26521500A28025 /* platform */,
+ F96D401C08F272AA004A47F5 /* reg */,
+ F96D401E08F272AA004A47F5 /* safe.tcl */,
+ F96D401F08F272AA004A47F5 /* tclIndex */,
+ F96D402008F272AA004A47F5 /* tcltest */,
+ F96D402308F272AA004A47F5 /* tm.tcl */,
+ F96D425B08F272B2004A47F5 /* word.tcl */,
+ );
+ path = library;
+ sourceTree = "<group>";
+ };
+ F96D3F3B08F272A8004A47F5 /* dde */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = dde;
+ sourceTree = "<group>";
+ };
+ F96D3F8D08F272A8004A47F5 /* http */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F8E08F272A8004A47F5 /* http.tcl */,
+ F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = http;
+ sourceTree = "<group>";
+ };
+ F96D3F9008F272A8004A47F5 /* http1.0 */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F9108F272A8004A47F5 /* http.tcl */,
+ F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = http1.0;
+ sourceTree = "<group>";
+ };
+ F96D3F9408F272A8004A47F5 /* msgcat */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
+ F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = msgcat;
+ sourceTree = "<group>";
+ };
+ F96D401708F272AA004A47F5 /* opt */ = {
+ isa = PBXGroup;
+ children = (
+ F96D401808F272AA004A47F5 /* optparse.tcl */,
+ F96D401908F272AA004A47F5 /* pkgIndex.tcl */,
+ );
+ path = opt;
+ sourceTree = "<group>";
+ };
+ F96D401C08F272AA004A47F5 /* reg */ = {
+ isa = PBXGroup;
+ children = (
+ F96D401D08F272AA004A47F5 /* pkgIndex.tcl */,
+ );
+ path = reg;
+ sourceTree = "<group>";
+ };
+ F96D402008F272AA004A47F5 /* tcltest */ = {
+ isa = PBXGroup;
+ children = (
+ F96D402108F272AA004A47F5 /* pkgIndex.tcl */,
+ F96D402208F272AA004A47F5 /* tcltest.tcl */,
+ );
+ path = tcltest;
+ sourceTree = "<group>";
+ };
+ F96D425C08F272B2004A47F5 /* libtommath */ = {
+ isa = PBXGroup;
+ children = (
+ F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */,
+ F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */,
+ F96D426908F272B3004A47F5 /* bn_mp_add.c */,
+ F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */,
+ F96D426C08F272B3004A47F5 /* bn_mp_and.c */,
+ F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */,
+ F96D426E08F272B3004A47F5 /* bn_mp_clear.c */,
+ F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */,
+ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */,
+ F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */,
+ F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */,
+ F96D427408F272B3004A47F5 /* bn_mp_copy.c */,
+ F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */,
+ F96D427608F272B3004A47F5 /* bn_mp_div.c */,
+ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */,
+ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */,
+ F96D427908F272B3004A47F5 /* bn_mp_div_3.c */,
+ F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
+ F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
+ F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
+ F96D428808F272B3004A47F5 /* bn_mp_init.c */,
+ F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
+ F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */,
+ F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */,
+ F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */,
+ F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */,
+ F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */,
+ F96D429508F272B3004A47F5 /* bn_mp_lshd.c */,
+ F96D429608F272B3004A47F5 /* bn_mp_mod.c */,
+ F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */,
+ F96D429C08F272B3004A47F5 /* bn_mp_mul.c */,
+ F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */,
+ F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */,
+ F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */,
+ F96D42A208F272B3004A47F5 /* bn_mp_neg.c */,
+ F96D42A308F272B3004A47F5 /* bn_mp_or.c */,
+ F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */,
+ F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */,
+ F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */,
+ F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */,
+ F96D42BA08F272B3004A47F5 /* bn_mp_set.c */,
+ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */,
+ F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */,
+ F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */,
+ F96D42C108F272B3004A47F5 /* bn_mp_sub.c */,
+ F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */,
+ F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */,
+ F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */,
+ F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */,
+ F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */,
+ F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */,
+ F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */,
+ F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */,
+ F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */,
+ F96D42D008F272B3004A47F5 /* bn_reverse.c */,
+ F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */,
+ F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */,
+ F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */,
+ F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */,
+ F96D42D708F272B3004A47F5 /* bncore.c */,
+ F96D432908F272B4004A47F5 /* tommath_class.h */,
+ F96D432A08F272B4004A47F5 /* tommath_superclass.h */,
+ );
+ path = libtommath;
+ sourceTree = "<group>";
+ };
+ F96D432C08F272B4004A47F5 /* macosx */ = {
+ isa = PBXGroup;
+ children = (
+ F96D432E08F272B5004A47F5 /* configure.ac */,
+ F96D432F08F272B5004A47F5 /* GNUmakefile */,
+ F96D433108F272B5004A47F5 /* README */,
+ F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */,
+ F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */,
+ F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */,
+ F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */,
+ F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */,
+ F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */,
+ F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */,
+ F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */,
+ );
+ path = macosx;
+ sourceTree = "<group>";
+ };
+ F96D434408F272B5004A47F5 /* tests */ = {
+ isa = PBXGroup;
+ children = (
+ F96D434508F272B5004A47F5 /* all.tcl */,
+ F96D434608F272B5004A47F5 /* append.test */,
+ F96D434708F272B5004A47F5 /* appendComp.test */,
+ F9ECB1CA0B2652D300A28025 /* apply.test */,
+ F96D434808F272B5004A47F5 /* assocd.test */,
+ F96D434908F272B5004A47F5 /* async.test */,
+ F96D434A08F272B5004A47F5 /* autoMkindex.test */,
+ F96D434B08F272B5004A47F5 /* basic.test */,
+ F96D434C08F272B5004A47F5 /* binary.test */,
+ F96D434D08F272B5004A47F5 /* case.test */,
+ F96D434E08F272B5004A47F5 /* chan.test */,
+ F9A493240CEBF38300B78AE2 /* chanio.test */,
+ F96D434F08F272B5004A47F5 /* clock.test */,
+ F96D435008F272B5004A47F5 /* cmdAH.test */,
+ F96D435108F272B5004A47F5 /* cmdIL.test */,
+ F96D435208F272B5004A47F5 /* cmdInfo.test */,
+ F96D435308F272B5004A47F5 /* cmdMZ.test */,
+ F96D435408F272B5004A47F5 /* compExpr-old.test */,
+ F96D435508F272B5004A47F5 /* compExpr.test */,
+ F96D435608F272B5004A47F5 /* compile.test */,
+ F96D435708F272B5004A47F5 /* concat.test */,
+ F96D435808F272B5004A47F5 /* config.test */,
+ F974D5770FBE7E6100BF728B /* coroutine.test */,
+ F96D435908F272B5004A47F5 /* dcall.test */,
+ F96D435A08F272B5004A47F5 /* dict.test */,
+ F96D435C08F272B5004A47F5 /* dstring.test */,
+ F96D435E08F272B5004A47F5 /* encoding.test */,
+ F96D435F08F272B5004A47F5 /* env.test */,
+ F96D436008F272B5004A47F5 /* error.test */,
+ F96D436108F272B5004A47F5 /* eval.test */,
+ F96D436208F272B5004A47F5 /* event.test */,
+ F96D436308F272B5004A47F5 /* exec.test */,
+ F96D436408F272B5004A47F5 /* execute.test */,
+ F96D436508F272B5004A47F5 /* expr-old.test */,
+ F96D436608F272B5004A47F5 /* expr.test */,
+ F96D436708F272B6004A47F5 /* fCmd.test */,
+ F96D436808F272B6004A47F5 /* fileName.test */,
+ F96D436908F272B6004A47F5 /* fileSystem.test */,
+ F96D436A08F272B6004A47F5 /* for-old.test */,
+ F96D436B08F272B6004A47F5 /* for.test */,
+ F96D436C08F272B6004A47F5 /* foreach.test */,
+ F96D436D08F272B6004A47F5 /* format.test */,
+ F96D436E08F272B6004A47F5 /* get.test */,
+ F96D436F08F272B6004A47F5 /* history.test */,
+ F96D437008F272B6004A47F5 /* http.test */,
+ F974D56C0FBE7D6300BF728B /* http11.test */,
+ F96D437108F272B6004A47F5 /* httpd */,
+ F974D56D0FBE7D6300BF728B /* httpd11.tcl */,
+ F96D437208F272B6004A47F5 /* httpold.test */,
+ F96D437308F272B6004A47F5 /* if-old.test */,
+ F96D437408F272B6004A47F5 /* if.test */,
+ F96D437508F272B6004A47F5 /* incr-old.test */,
+ F96D437608F272B6004A47F5 /* incr.test */,
+ F96D437708F272B6004A47F5 /* indexObj.test */,
+ F96D437808F272B6004A47F5 /* info.test */,
+ F96D437908F272B6004A47F5 /* init.test */,
+ F96D437A08F272B6004A47F5 /* interp.test */,
+ F96D437B08F272B6004A47F5 /* io.test */,
+ F96D437C08F272B6004A47F5 /* ioCmd.test */,
+ F96D437D08F272B6004A47F5 /* iogt.test */,
+ F96D437F08F272B6004A47F5 /* join.test */,
+ F96D438008F272B6004A47F5 /* lindex.test */,
+ F96D438108F272B6004A47F5 /* link.test */,
+ F96D438208F272B6004A47F5 /* linsert.test */,
+ F96D438308F272B6004A47F5 /* list.test */,
+ F96D438408F272B6004A47F5 /* listObj.test */,
+ F96D438508F272B6004A47F5 /* llength.test */,
+ F96D438608F272B6004A47F5 /* load.test */,
+ F96D438708F272B6004A47F5 /* lrange.test */,
+ F96D438808F272B6004A47F5 /* lrepeat.test */,
+ F96D438908F272B6004A47F5 /* lreplace.test */,
+ F96D438A08F272B6004A47F5 /* lsearch.test */,
+ F96D438B08F272B6004A47F5 /* lset.test */,
+ F96D438C08F272B6004A47F5 /* lsetComp.test */,
+ F96D438D08F272B6004A47F5 /* macOSXFCmd.test */,
+ F95FAFF90B34F1130072E431 /* macOSXLoad.test */,
+ F96D438E08F272B6004A47F5 /* main.test */,
+ F9ECB1CB0B26534C00A28025 /* mathop.test */,
+ F96D438F08F272B6004A47F5 /* misc.test */,
+ F96D439008F272B6004A47F5 /* msgcat.test */,
+ F96D439108F272B6004A47F5 /* namespace-old.test */,
+ F96D439208F272B7004A47F5 /* namespace.test */,
+ F96D439308F272B7004A47F5 /* notify.test */,
+ F91DC23C0E44C51B002CB8D1 /* nre.test */,
+ F96D439408F272B7004A47F5 /* obj.test */,
+ F93599C80DF1F81900E04F67 /* oo.test */,
+ F96D439508F272B7004A47F5 /* opt.test */,
+ F96D439608F272B7004A47F5 /* package.test */,
+ F96D439708F272B7004A47F5 /* parse.test */,
+ F96D439808F272B7004A47F5 /* parseExpr.test */,
+ F96D439908F272B7004A47F5 /* parseOld.test */,
+ F96D439A08F272B7004A47F5 /* pid.test */,
+ F96D439B08F272B7004A47F5 /* pkg.test */,
+ F96D439C08F272B7004A47F5 /* pkgMkIndex.test */,
+ F96D439D08F272B7004A47F5 /* platform.test */,
+ F96D439E08F272B7004A47F5 /* proc-old.test */,
+ F96D439F08F272B7004A47F5 /* proc.test */,
+ F96D43A008F272B7004A47F5 /* pwd.test */,
+ F96D43A108F272B7004A47F5 /* README */,
+ F96D43A208F272B7004A47F5 /* reg.test */,
+ F96D43A308F272B7004A47F5 /* regexp.test */,
+ F96D43A408F272B7004A47F5 /* regexpComp.test */,
+ F96D43A508F272B7004A47F5 /* registry.test */,
+ F96D43A608F272B7004A47F5 /* remote.tcl */,
+ F96D43A708F272B7004A47F5 /* rename.test */,
+ F96D43A808F272B7004A47F5 /* result.test */,
+ F96D43A908F272B7004A47F5 /* safe.test */,
+ F96D43AA08F272B7004A47F5 /* scan.test */,
+ F96D43AB08F272B7004A47F5 /* security.test */,
+ F96D43AC08F272B7004A47F5 /* set-old.test */,
+ F96D43AD08F272B7004A47F5 /* set.test */,
+ F96D43AE08F272B7004A47F5 /* socket.test */,
+ F96D43AF08F272B7004A47F5 /* source.test */,
+ F96D43B008F272B7004A47F5 /* split.test */,
+ F96D43B108F272B7004A47F5 /* stack.test */,
+ F96D43B208F272B7004A47F5 /* string.test */,
+ F96D43B308F272B7004A47F5 /* stringComp.test */,
+ F96D43B408F272B7004A47F5 /* stringObj.test */,
+ F96D43B508F272B7004A47F5 /* subst.test */,
+ F96D43B608F272B7004A47F5 /* switch.test */,
+ F974D5780FBE7E6100BF728B /* tailcall.test */,
+ F96D43B708F272B7004A47F5 /* tcltest.test */,
+ F96D43B808F272B7004A47F5 /* thread.test */,
+ F96D43B908F272B7004A47F5 /* timer.test */,
+ F96D43BA08F272B7004A47F5 /* tm.test */,
+ F96D43BB08F272B7004A47F5 /* trace.test */,
+ F96D43BC08F272B7004A47F5 /* unixFCmd.test */,
+ F96D43BD08F272B7004A47F5 /* unixFile.test */,
+ F96D43BE08F272B7004A47F5 /* unixInit.test */,
+ F96D43BF08F272B7004A47F5 /* unixNotfy.test */,
+ F96D43C008F272B7004A47F5 /* unknown.test */,
+ F96D43C108F272B7004A47F5 /* unload.test */,
+ F96D43C208F272B7004A47F5 /* uplevel.test */,
+ F96D43C308F272B7004A47F5 /* upvar.test */,
+ F96D43C408F272B7004A47F5 /* utf.test */,
+ F96D43C508F272B7004A47F5 /* util.test */,
+ F96D43C608F272B7004A47F5 /* var.test */,
+ F96D43C708F272B7004A47F5 /* while-old.test */,
+ F96D43C808F272B7004A47F5 /* while.test */,
+ F96D43C908F272B7004A47F5 /* winConsole.test */,
+ F96D43CA08F272B7004A47F5 /* winDde.test */,
+ F96D43CB08F272B7004A47F5 /* winFCmd.test */,
+ F96D43CC08F272B7004A47F5 /* winFile.test */,
+ F96D43CD08F272B7004A47F5 /* winNotify.test */,
+ F96D43CE08F272B7004A47F5 /* winPipe.test */,
+ F96D43CF08F272B7004A47F5 /* winTime.test */,
+ F915432A0EF201CF0032D1E8 /* zlib.test */,
+ );
+ path = tests;
+ sourceTree = "<group>";
+ };
+ F96D43D008F272B8004A47F5 /* tools */ = {
+ isa = PBXGroup;
+ children = (
+ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
+ F96D43D208F272B8004A47F5 /* configure */,
+ F96D43D308F272B8004A47F5 /* configure.in */,
+ F96D442208F272B8004A47F5 /* eolFix.tcl */,
+ F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
+ F96D442508F272B8004A47F5 /* genStubs.tcl */,
+ F96D442708F272B8004A47F5 /* index.tcl */,
+ F96D442808F272B8004A47F5 /* installData.tcl */,
+ F96D442908F272B8004A47F5 /* loadICU.tcl */,
+ F96D442A08F272B8004A47F5 /* Makefile.in */,
+ F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
+ F96D442C08F272B8004A47F5 /* man2help.tcl */,
+ F96D442D08F272B8004A47F5 /* man2help2.tcl */,
+ F96D442E08F272B8004A47F5 /* man2html.tcl */,
+ F96D442F08F272B8004A47F5 /* man2html1.tcl */,
+ F96D443008F272B8004A47F5 /* man2html2.tcl */,
+ F96D443108F272B8004A47F5 /* man2tcl.c */,
+ F96D443208F272B8004A47F5 /* README */,
+ F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
+ F96D443508F272B8004A47F5 /* tcl.hpj.in */,
+ F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
+ F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
+ F92D7F100DE777240033A13A /* tsdPerf.tcl */,
+ F96D443B08F272B9004A47F5 /* uniClass.tcl */,
+ F96D443C08F272B9004A47F5 /* uniParse.tcl */,
+ );
+ path = tools;
+ sourceTree = "<group>";
+ };
+ F96D443E08F272B9004A47F5 /* unix */ = {
+ isa = PBXGroup;
+ children = (
+ F96D444008F272B9004A47F5 /* aclocal.m4 */,
+ F96D444108F272B9004A47F5 /* configure */,
+ F96D444208F272B9004A47F5 /* configure.in */,
+ F96D444308F272B9004A47F5 /* dltest */,
+ F96D444D08F272B9004A47F5 /* install-sh */,
+ F96D444E08F272B9004A47F5 /* installManPage */,
+ F96D444F08F272B9004A47F5 /* ldAix */,
+ F96D445008F272B9004A47F5 /* Makefile.in */,
+ F96D445208F272B9004A47F5 /* README */,
+ F96D445308F272B9004A47F5 /* tcl.m4 */,
+ F974D5790FBE7E9C00BF728B /* tcl.pc.in */,
+ F96D445408F272B9004A47F5 /* tcl.spec */,
+ F96D445508F272B9004A47F5 /* tclAppInit.c */,
+ F96D445608F272B9004A47F5 /* tclConfig.h.in */,
+ F96D445708F272B9004A47F5 /* tclConfig.sh.in */,
+ F96D445808F272B9004A47F5 /* tclLoadAix.c */,
+ F96D445908F272B9004A47F5 /* tclLoadDl.c */,
+ F96D445B08F272B9004A47F5 /* tclLoadDyld.c */,
+ F96D445C08F272B9004A47F5 /* tclLoadNext.c */,
+ F96D445D08F272B9004A47F5 /* tclLoadOSF.c */,
+ F96D445E08F272B9004A47F5 /* tclLoadShl.c */,
+ F96D445F08F272B9004A47F5 /* tclUnixChan.c */,
+ F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */,
+ F96D446008F272B9004A47F5 /* tclUnixEvent.c */,
+ F96D446108F272B9004A47F5 /* tclUnixFCmd.c */,
+ F96D446208F272B9004A47F5 /* tclUnixFile.c */,
+ F96D446308F272B9004A47F5 /* tclUnixInit.c */,
+ F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
+ F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
+ F96D446608F272B9004A47F5 /* tclUnixPort.h */,
+ F96D446708F272B9004A47F5 /* tclUnixSock.c */,
+ F96D446808F272B9004A47F5 /* tclUnixTest.c */,
+ F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
+ F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
+ F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
+ F96D446D08F272B9004A47F5 /* tclXtTest.c */,
+ );
+ path = unix;
+ sourceTree = "<group>";
+ };
+ F96D444308F272B9004A47F5 /* dltest */ = {
+ isa = PBXGroup;
+ children = (
+ F96D444408F272B9004A47F5 /* Makefile.in */,
+ F96D444508F272B9004A47F5 /* pkga.c */,
+ F96D444608F272B9004A47F5 /* pkgb.c */,
+ F96D444708F272B9004A47F5 /* pkgc.c */,
+ F96D444808F272B9004A47F5 /* pkgd.c */,
+ F96D444908F272B9004A47F5 /* pkge.c */,
+ F96D444B08F272B9004A47F5 /* pkgua.c */,
+ F96D444C08F272B9004A47F5 /* README */,
+ );
+ path = dltest;
+ sourceTree = "<group>";
+ };
+ F96D446E08F272B9004A47F5 /* win */ = {
+ isa = PBXGroup;
+ children = (
+ F96D447008F272BA004A47F5 /* aclocal.m4 */,
+ F96D447108F272BA004A47F5 /* buildall.vc.bat */,
+ F96D447208F272BA004A47F5 /* cat.c */,
+ F96D447308F272BA004A47F5 /* coffbase.txt */,
+ F96D447408F272BA004A47F5 /* configure */,
+ F96D447508F272BA004A47F5 /* configure.in */,
+ F96D447608F272BA004A47F5 /* makefile.bc */,
+ F96D447708F272BA004A47F5 /* Makefile.in */,
+ F96D447808F272BA004A47F5 /* makefile.vc */,
+ F96D447908F272BA004A47F5 /* nmakehlp.c */,
+ F96D447A08F272BA004A47F5 /* README */,
+ F96D447C08F272BA004A47F5 /* rules.vc */,
+ F96D447D08F272BA004A47F5 /* stub16.c */,
+ F96D447E08F272BA004A47F5 /* tcl.dsp */,
+ F96D447F08F272BA004A47F5 /* tcl.dsw */,
+ F96D448008F272BA004A47F5 /* tcl.hpj.in */,
+ F96D448108F272BA004A47F5 /* tcl.m4 */,
+ F96D448208F272BA004A47F5 /* tcl.rc */,
+ F96D448308F272BA004A47F5 /* tclAppInit.c */,
+ F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
+ F96D448608F272BA004A47F5 /* tclsh.rc */,
+ F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
+ F96D448808F272BA004A47F5 /* tclWinChan.c */,
+ F96D448908F272BA004A47F5 /* tclWinConsole.c */,
+ F96D448A08F272BA004A47F5 /* tclWinDde.c */,
+ F96D448B08F272BA004A47F5 /* tclWinError.c */,
+ F96D448C08F272BA004A47F5 /* tclWinFCmd.c */,
+ F96D448D08F272BA004A47F5 /* tclWinFile.c */,
+ F96D448E08F272BA004A47F5 /* tclWinInit.c */,
+ F96D448F08F272BA004A47F5 /* tclWinInt.h */,
+ F96D449008F272BA004A47F5 /* tclWinLoad.c */,
+ F96D449108F272BA004A47F5 /* tclWinNotify.c */,
+ F96D449208F272BA004A47F5 /* tclWinPipe.c */,
+ F96D449308F272BA004A47F5 /* tclWinPort.h */,
+ F96D449408F272BA004A47F5 /* tclWinReg.c */,
+ F96D449508F272BA004A47F5 /* tclWinSerial.c */,
+ F96D449608F272BA004A47F5 /* tclWinSock.c */,
+ F96D449708F272BA004A47F5 /* tclWinTest.c */,
+ F96D449808F272BA004A47F5 /* tclWinThrd.c */,
+ F96D449908F272BA004A47F5 /* tclWinThrd.h */,
+ F96D449A08F272BA004A47F5 /* tclWinTime.c */,
+ );
+ path = win;
+ sourceTree = "<group>";
+ };
+ F9ECB1110B26521500A28025 /* platform */ = {
+ isa = PBXGroup;
+ children = (
+ F9ECB1120B26521500A28025 /* pkgIndex.tcl */,
+ F9ECB1130B26521500A28025 /* platform.tcl */,
+ F9ECB1140B26521500A28025 /* shell.tcl */,
+ );
+ path = platform;
+ sourceTree = "<group>";
+ };
+/* End PBXGroup section */
+
+/* Begin PBXNativeTarget section */
+ 8DD76FA90486AB0100D96B5E /* tcltest */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */;
+ buildPhases = (
+ F9A5C5F508F651A2008AE941 /* Configure Tcl */,
+ 8DD76FAB0486AB0100D96B5E /* Sources */,
+ 8DD76FAD0486AB0100D96B5E /* Frameworks */,
+ F95FA74C0B32CE190072E431 /* Build dltest */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ );
+ name = tcltest;
+ productInstallPath = "$(BINDIR)";
+ productName = tcltest;
+ productReference = 8DD76FB20486AB0100D96B5E /* tcltest */;
+ productType = "com.apple.product-type.tool";
+ };
+ F97258A50A86873C00096C78 /* tests */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */;
+ buildPhases = (
+ F97258A40A86873C00096C78 /* Run Testsuite */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ F97258D30A868C6F00096C78 /* PBXTargetDependency */,
+ );
+ name = tests;
+ productName = tests;
+ productType = "com.apple.product-type.bundle";
+ };
+ F9E61D16090A3E94002B3151 /* Tcl */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */;
+ buildPhases = (
+ F97AF02F0B665DA900310EA2 /* Build Tcl */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ );
+ name = Tcl;
+ productName = tclsh;
+ productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */;
+ productType = "com.apple.product-type.tool";
+ };
+/* End PBXNativeTarget section */
+
+/* Begin PBXProject section */
+ 08FB7793FE84155DC02AAC07 /* Project object */ = {
+ isa = PBXProject;
+ attributes = {
+ BuildIndependentTargetsInParallel = YES;
+ };
+ buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */;
+ compatibilityVersion = "Xcode 3.1";
+ hasScannedForEncodings = 1;
+ mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */;
+ projectDirPath = "";
+ projectRoot = ..;
+ targets = (
+ F9E61D16090A3E94002B3151 /* Tcl */,
+ 8DD76FA90486AB0100D96B5E /* tcltest */,
+ F97258A50A86873C00096C78 /* tests */,
+ );
+ };
+/* End PBXProject section */
+
+/* Begin PBXShellScriptBuildPhase section */
+ F95FA74C0B32CE190072E431 /* Build dltest */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
+ "$(TCL_SRCROOT)/generic/tclStubLib.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkga.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgb.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgc.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgd.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkge.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgua.c",
+ );
+ name = "Build dltest";
+ outputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/dltest.marker",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n";
+ showEnvVarsInLog = 0;
+ };
+ F97258A40A86873C00096C78 /* Run Testsuite */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ name = "Run Testsuite";
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
+ showEnvVarsInLog = 0;
+ };
+ F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "${TARGET_TEMP_DIR}/.none",
+ );
+ name = "Build Tcl";
+ outputPaths = (
+ "${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
+ showEnvVarsInLog = 0;
+ };
+ F9A5C5F508F651A2008AE941 /* Configure Tcl */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "$(TCL_SRCROOT)/macosx/configure.ac",
+ "$(TCL_SRCROOT)/unix/configure.in",
+ "$(TCL_SRCROOT)/unix/tcl.m4",
+ "$(TCL_SRCROOT)/unix/aclocal.m4",
+ "$(TCL_SRCROOT)/unix/tclConfig.sh.in",
+ "$(TCL_SRCROOT)/unix/Makefile.in",
+ "$(TCL_SRCROOT)/unix/dltest/Makefile.in",
+ );
+ name = "Configure Tcl";
+ outputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
+ showEnvVarsInLog = 0;
+ };
+/* End PBXShellScriptBuildPhase section */
+
+/* Begin PBXSourcesBuildPhase section */
+ 8DD76FAB0486AB0100D96B5E /* Sources */ = {
+ isa = PBXSourcesBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ F96D456F08F272BB004A47F5 /* regcomp.c in Sources */,
+ F96D457208F272BB004A47F5 /* regerror.c in Sources */,
+ F96D457508F272BB004A47F5 /* regexec.c in Sources */,
+ F96D457608F272BB004A47F5 /* regfree.c in Sources */,
+ F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */,
+ F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */,
+ F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */,
+ F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */,
+ F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */,
+ F96D458008F272BC004A47F5 /* tclClock.c in Sources */,
+ F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */,
+ F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */,
+ F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */,
+ F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */,
+ F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */,
+ F96D458608F272BC004A47F5 /* tclCompile.c in Sources */,
+ F96D458808F272BC004A47F5 /* tclConfig.c in Sources */,
+ F96D458908F272BC004A47F5 /* tclDate.c in Sources */,
+ F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */,
+ F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */,
+ F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */,
+ F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */,
+ F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */,
+ F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */,
+ F96D459108F272BC004A47F5 /* tclFileName.c in Sources */,
+ F96D459308F272BC004A47F5 /* tclGet.c in Sources */,
+ F96D459508F272BC004A47F5 /* tclHash.c in Sources */,
+ F96D459608F272BC004A47F5 /* tclHistory.c in Sources */,
+ F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */,
+ F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */,
+ F96D459D08F272BC004A47F5 /* tclIO.c in Sources */,
+ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */,
+ F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */,
+ F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */,
+ F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */,
+ F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */,
+ F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */,
+ F96D45A408F272BC004A47F5 /* tclLink.c in Sources */,
+ F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */,
+ F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */,
+ F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */,
+ F96D45A908F272BC004A47F5 /* tclMain.c in Sources */,
+ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */,
+ F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */,
+ F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */,
+ F93599B30DF1F75400E04F67 /* tclOO.c in Sources */,
+ F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */,
+ F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */,
+ F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */,
+ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */,
+ F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */,
+ F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */,
+ F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */,
+ F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */,
+ F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */,
+ F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */,
+ F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */,
+ F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */,
+ F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */,
+ F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */,
+ F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */,
+ F96D45B808F272BC004A47F5 /* tclProc.c in Sources */,
+ F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */,
+ F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */,
+ F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */,
+ F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */,
+ F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */,
+ F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */,
+ F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */,
+ F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */,
+ F96D45C608F272BC004A47F5 /* tclTest.c in Sources */,
+ F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */,
+ F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */,
+ F96D45C908F272BC004A47F5 /* tclThread.c in Sources */,
+ F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */,
+ F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */,
+ F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */,
+ F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
+ F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,
+ F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */,
+ F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */,
+ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */,
+ F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */,
+ F96D45D508F272BC004A47F5 /* tclVar.c in Sources */,
+ F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */,
+ F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */,
+ F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */,
+ F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */,
+ F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */,
+ F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */,
+ F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */,
+ F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */,
+ F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */,
+ 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 */,
+ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */,
+ F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */,
+ F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */,
+ F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
+ F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
+ F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
+ F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
+ F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
+ F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */,
+ F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */,
+ F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */,
+ F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */,
+ F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */,
+ F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */,
+ F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */,
+ F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */,
+ F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */,
+ F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */,
+ F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */,
+ F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */,
+ F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */,
+ F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */,
+ F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */,
+ F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */,
+ F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */,
+ F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */,
+ F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */,
+ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */,
+ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */,
+ F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */,
+ F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */,
+ F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */,
+ F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */,
+ F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */,
+ F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */,
+ F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */,
+ F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */,
+ F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */,
+ F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */,
+ F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */,
+ F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */,
+ F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */,
+ F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */,
+ F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */,
+ F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */,
+ F96D495508F272C3004A47F5 /* bncore.c in Sources */,
+ F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */,
+ F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */,
+ F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */,
+ F90509300913A72400327603 /* tclAppInit.c in Sources */,
+ F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */,
+ F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */,
+ F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */,
+ F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */,
+ F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */,
+ F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */,
+ F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */,
+ F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */,
+ F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */,
+ F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */,
+ F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */,
+ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */,
+ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */,
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */,
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+/* End PBXSourcesBuildPhase section */
+
+/* Begin PBXTargetDependency section */
+ F97258D30A868C6F00096C78 /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 8DD76FA90486AB0100D96B5E /* tcltest */;
+ targetProxy = F97258D20A868C6F00096C78 /* PBXContainerItemProxy */;
+ };
+/* End PBXTargetDependency section */
+
+/* Begin XCBuildConfiguration section */
+ F91BCC4F093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = ReleaseUniversal;
+ };
+ F91BCC50093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = ReleaseUniversal;
+ };
+ F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ };
+ name = ReleaseUniversal;
+ };
+ F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugMemCompile;
+ };
+ F93084380BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugMemCompile;
+ };
+ F93084390BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugMemCompile;
+ };
+ F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugMemCompile;
+ };
+ F9359B250DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_GENERATE_TEST_COVERAGE_FILES = YES;
+ GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ OTHER_LDFLAGS = (
+ "$(OTHER_LDFLAGS)",
+ "-lgcov",
+ );
+ PREBINDING = NO;
+ };
+ name = DebugGCov;
+ };
+ F9359B260DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugGCov;
+ };
+ F9359B270DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugGCov;
+ };
+ F9359B280DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugGCov;
+ };
+ F95CC8AC09158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Debug;
+ };
+ F95CC8AD09158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Release;
+ };
+ F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F95CC8B109158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = Debug;
+ };
+ F95CC8B209158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = Release;
+ };
+ F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F95CC8B609158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = Debug;
+ };
+ F95CC8B709158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = Release;
+ };
+ F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F97258A90A86873D00096C78 /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Debug;
+ };
+ F97258AA0A86873D00096C78 /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Release;
+ };
+ F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F97258AC0A86873D00096C78 /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = ReleaseUniversal;
+ };
+ F97AED1B0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Debug64bit;
+ };
+ F97AED1C0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = Debug64bit;
+ };
+ F97AED1D0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Debug64bit;
+ };
+ F97AED1E0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(NATIVE_ARCH_64_BIT)";
+ CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)";
+ CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ };
+ name = Debug64bit;
+ };
+ F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoCF;
+ };
+ F98751300DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoCF;
+ };
+ F98751310DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoCF;
+ };
+ F98751320DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoCF;
+ };
+ F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F9988AB10D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_VERSION = 4.0;
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB20D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB30D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB40D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC = "llvm-gcc";
+ GCC_VERSION = com.apple.compilers.llvmgcc42;
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ GCC_VERSION = 4.0;
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ DEBUG_INFORMATION_FORMAT = dwarf;
+ GCC = "llvm-gcc";
+ GCC_OPTIMIZATION_LEVEL = 4;
+ GCC_VERSION = com.apple.compilers.llvmgcc42;
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE73C0BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugLeaks;
+ };
+ F99EE73D0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE73E0BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugLeaks;
+ };
+ F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE7400BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugLeaks;
+ };
+ F99EE7410BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE7420BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ PURIFY,
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugLeaks;
+ };
+ F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ SDKROOT = macosx10.5;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+/* End XCBuildConfiguration section */
+
+/* Begin XCConfigurationList section */
+ F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8AC09158F3100EA5ACE /* Debug */,
+ F9988AB60D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB20D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE73B0BE835310060D4AF /* DebugUnthreaded */,
+ F98751300DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084370BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE73C0BE835310060D4AF /* DebugLeaks */,
+ F9359B260DF212DA00E04F67 /* DebugGCov */,
+ F97AED1B0B660B2100310EA2 /* Debug64bit */,
+ F95CC8AD09158F3100EA5ACE /* Release */,
+ F91BCC4F093152310042A6BF /* ReleaseUniversal */,
+ F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8B109158F3100EA5ACE /* Debug */,
+ F9988AB70D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB30D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE73D0BE835310060D4AF /* DebugUnthreaded */,
+ F98751310DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084380BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE73E0BE835310060D4AF /* DebugLeaks */,
+ F9359B270DF212DA00E04F67 /* DebugGCov */,
+ F97AED1C0B660B2100310EA2 /* Debug64bit */,
+ F95CC8B209158F3100EA5ACE /* Release */,
+ F91BCC50093152310042A6BF /* ReleaseUniversal */,
+ F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8B609158F3100EA5ACE /* Debug */,
+ F9988AB50D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB10D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE7410BE835310060D4AF /* DebugUnthreaded */,
+ F987512F0DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F930843A0BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE7420BE835310060D4AF /* DebugLeaks */,
+ F9359B250DF212DA00E04F67 /* DebugGCov */,
+ F97AED1E0B660B2100310EA2 /* Debug64bit */,
+ F95CC8B709158F3100EA5ACE /* Release */,
+ F91BCC51093152310042A6BF /* ReleaseUniversal */,
+ F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F97258A90A86873D00096C78 /* Debug */,
+ F9988AB80D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB40D814C6500B6B03B /* Debug gcc40 */,
+ F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */,
+ F99EE73F0BE835310060D4AF /* DebugUnthreaded */,
+ F98751320DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084390BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE7400BE835310060D4AF /* DebugLeaks */,
+ F9359B280DF212DA00E04F67 /* DebugGCov */,
+ F97AED1D0B660B2100310EA2 /* Debug64bit */,
+ F97258AA0A86873D00096C78 /* Release */,
+ F97258AC0A86873D00096C78 /* ReleaseUniversal */,
+ F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+/* End XCConfigurationList section */
+ };
+ rootObject = 08FB7793FE84155DC02AAC07 /* Project object */;
+}
diff --git a/macosx/Tcl.xcodeproj/default.pbxuser b/macosx/Tcl.xcodeproj/default.pbxuser
new file mode 100644
index 0000000..0399c7b
--- /dev/null
+++ b/macosx/Tcl.xcodeproj/default.pbxuser
@@ -0,0 +1,211 @@
+// !$*UTF8*$!
+{
+ 08FB7793FE84155DC02AAC07 /* Project object */ = {
+ activeBuildConfigurationName = Debug;
+ activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */;
+ activeTarget = F9E61D16090A3E94002B3151 /* Tcl */;
+ codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */;
+ executables = (
+ F9E61D1C090A4282002B3151 /* tclsh */,
+ F944EB8F08F798100049FDD4 /* tcltest */,
+ );
+ perUserDictionary = {
+ com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a0b707265666572656e63657386928497960892849a9a0669734c6561668692848484084e534e756d626572008484074e5356616c7565009584012a849696008692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a09726563757273697665869284a29da496018692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a0763616e536176658692a892849a9a1250425850726f6a65637453636f70654b65798692849a9a035945538692849a9a0572656765788692849a9a065c2e286329248692849a9a07666e6d617463688692849a9a00868692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a08676c6f62616c49448692849a9a183143433045413430303433353045463930303434343130428692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f7570868686>;
+ };
+ sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */;
+ userBuildSettings = {
+ SYMROOT = "${SRCROOT}/../../build/tcl";
+ TCL_SRCROOT = "${SRCROOT}/../../tcl";
+ };
+ };
+ 8DD76FA90486AB0100D96B5E /* tcltest */ = {
+ activeExec = 0;
+ executables = (
+ F944EB8F08F798100049FDD4 /* tcltest */,
+ );
+ };
+ F944EB8F08F798100049FDD4 /* tcltest */ = {
+ isa = PBXExecutable;
+ activeArgIndices = (
+ NO,
+ NO,
+ NO,
+ );
+ argumentStrings = (
+ "${TCL_SRCROOT}/tests/all.tcl",
+ "-singleproc 1",
+ "-verbose \"bet\"",
+ );
+ autoAttachOnCrash = 1;
+ breakpointsEnabled = 1;
+ configStateDict = {
+ "PBXLSLaunchAction-0" = {
+ PBXLSLaunchAction = 0;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXLSRunLaunchConfig;
+ displayName = "Executable Runner";
+ identifier = com.apple.Xcode.launch.runConfig;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ "PBXLSLaunchAction-1" = {
+ PBXLSLaunchAction = 1;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXGDB_LaunchConfig;
+ displayName = GDB;
+ identifier = com.apple.Xcode.launch.GDBMI_Config;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ };
+ customDataFormattersEnabled = 1;
+ dataTipCustomDataFormattersEnabled = 1;
+ dataTipShowTypeColumn = 1;
+ dataTipSortType = 0;
+ debuggerPlugin = GDBDebugging;
+ disassemblyDisplayState = 0;
+ dylibVariantSuffix = "";
+ enableDebugStr = 0;
+ environmentEntries = (
+ {
+ active = YES;
+ name = TCL_LIBRARY;
+ value = "${TCL_SRCROOT}/library";
+ },
+ {
+ active = YES;
+ name = TCLLIBPATH;
+ value = /Library/Tcl;
+ },
+ {
+ active = NO;
+ name = DYLD_PRINT_LIBRARIES;
+ },
+ {
+ active = NO;
+ name = MallocBadFreeAbort;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocLogFile;
+ value = /tmp/malloc.log;
+ },
+ {
+ active = NO;
+ name = MallocStackLogging;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocStackLoggingNoCompact;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocPreScribble;
+ value = 1;
+ },
+ {
+ active = NO;
+ name = MallocScribble;
+ value = 1;
+ },
+ );
+ executableSystemSymbolLevel = 0;
+ executableUserSymbolLevel = 0;
+ libgmallocEnabled = 0;
+ name = tcltest;
+ showTypeColumn = 0;
+ sourceDirectories = (
+ );
+ };
+ F944EB9C08F798180049FDD4 /* Source Control */ = {
+ isa = PBXSourceControlManager;
+ fallbackIsa = XCSourceControlManager;
+ isSCMEnabled = 0;
+ repositoryNamesForRoots = {
+ .. = "";
+ };
+ scmConfiguration = {
+ CVSToolPath = /usr/bin/cvs;
+ CVSUseSSH = NO;
+ SubversionToolPath = /usr/bin/svn;
+ repositoryNamesForRoots = {
+ .. = "";
+ };
+ };
+ scmType = scm.cvs;
+ };
+ F944EB9D08F798180049FDD4 /* Code sense */ = {
+ isa = PBXCodeSenseManager;
+ indexTemplatePath = "";
+ };
+ F97258A50A86873C00096C78 /* tests */ = {
+ activeExec = 0;
+ };
+ F9E61D16090A3E94002B3151 /* Tcl */ = {
+ activeExec = 0;
+ executables = (
+ F9E61D1C090A4282002B3151 /* tclsh */,
+ );
+ };
+ F9E61D1C090A4282002B3151 /* tclsh */ = {
+ isa = PBXExecutable;
+ activeArgIndices = (
+ );
+ argumentStrings = (
+ );
+ autoAttachOnCrash = 1;
+ breakpointsEnabled = 1;
+ configStateDict = {
+ "PBXLSLaunchAction-0" = {
+ PBXLSLaunchAction = 0;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXLSRunLaunchConfig;
+ displayName = "Executable Runner";
+ identifier = com.apple.Xcode.launch.runConfig;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ "PBXLSLaunchAction-1" = {
+ PBXLSLaunchAction = 1;
+ PBXLSLaunchStartAction = 1;
+ PBXLSLaunchStdioStyle = 2;
+ PBXLSLaunchStyle = 0;
+ class = PBXGDB_LaunchConfig;
+ displayName = GDB;
+ identifier = com.apple.Xcode.launch.GDBMI_Config;
+ remoteHostInfo = "";
+ startActionInfo = "";
+ };
+ };
+ customDataFormattersEnabled = 1;
+ dataTipCustomDataFormattersEnabled = 1;
+ dataTipShowTypeColumn = 1;
+ dataTipSortType = 0;
+ debuggerPlugin = GDBDebugging;
+ disassemblyDisplayState = 0;
+ dylibVariantSuffix = _debug;
+ enableDebugStr = 0;
+ environmentEntries = (
+ {
+ active = NO;
+ name = DYLD_PRINT_LIBRARIES;
+ },
+ );
+ executableSystemSymbolLevel = 0;
+ executableUserSymbolLevel = 0;
+ libgmallocEnabled = 0;
+ name = tclsh;
+ showTypeColumn = 0;
+ sourceDirectories = (
+ );
+ };
+}
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
new file mode 100644
index 0000000..9c18ac0
--- /dev/null
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -0,0 +1,3041 @@
+// !$*UTF8*$!
+{
+ archiveVersion = 1;
+ classes = {
+ };
+ objectVersion = 46;
+ objects = {
+
+/* Begin PBXBuildFile section */
+ F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; };
+ F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
+ F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
+ F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
+ F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
+ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
+ F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
+ F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
+ F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; };
+ F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
+ F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
+ F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
+ F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
+ F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
+ F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
+ F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
+ F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; };
+ F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; };
+ F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; };
+ F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDE08F272A7004A47F5 /* tclBasic.c */; };
+ F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDF08F272A7004A47F5 /* tclBinary.c */; };
+ F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE008F272A7004A47F5 /* tclCkalloc.c */; };
+ F96D458008F272BC004A47F5 /* tclClock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE108F272A7004A47F5 /* tclClock.c */; };
+ F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE208F272A7004A47F5 /* tclCmdAH.c */; };
+ F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE308F272A7004A47F5 /* tclCmdIL.c */; };
+ F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */; };
+ F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE508F272A7004A47F5 /* tclCompCmds.c */; };
+ F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE608F272A7004A47F5 /* tclCompExpr.c */; };
+ F96D458608F272BC004A47F5 /* tclCompile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE708F272A7004A47F5 /* tclCompile.c */; };
+ F96D458808F272BC004A47F5 /* tclConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EE908F272A7004A47F5 /* tclConfig.c */; };
+ F96D458908F272BC004A47F5 /* tclDate.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEA08F272A7004A47F5 /* tclDate.c */; };
+ F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEC08F272A7004A47F5 /* tclDictObj.c */; };
+ F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EED08F272A7004A47F5 /* tclEncoding.c */; };
+ F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEE08F272A7004A47F5 /* tclEnv.c */; };
+ F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EEF08F272A7004A47F5 /* tclEvent.c */; };
+ F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF008F272A7004A47F5 /* tclExecute.c */; };
+ F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF108F272A7004A47F5 /* tclFCmd.c */; };
+ F96D459108F272BC004A47F5 /* tclFileName.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF208F272A7004A47F5 /* tclFileName.c */; };
+ F96D459308F272BC004A47F5 /* tclGet.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF408F272A7004A47F5 /* tclGet.c */; };
+ F96D459508F272BC004A47F5 /* tclHash.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF608F272A7004A47F5 /* tclHash.c */; };
+ F96D459608F272BC004A47F5 /* tclHistory.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF708F272A7004A47F5 /* tclHistory.c */; };
+ F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EF808F272A7004A47F5 /* tclIndexObj.c */; };
+ F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFC08F272A7004A47F5 /* tclInterp.c */; };
+ F96D459D08F272BC004A47F5 /* tclIO.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EFE08F272A7004A47F5 /* tclIO.c */; };
+ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0008F272A7004A47F5 /* tclIOCmd.c */; };
+ F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0108F272A7004A47F5 /* tclIOGT.c */; };
+ F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0208F272A7004A47F5 /* tclIORChan.c */; };
+ F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0308F272A7004A47F5 /* tclIOSock.c */; };
+ F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0408F272A7004A47F5 /* tclIOUtil.c */; };
+ F96D45A408F272BC004A47F5 /* tclLink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0508F272A7004A47F5 /* tclLink.c */; };
+ F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0608F272A7004A47F5 /* tclListObj.c */; };
+ F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0708F272A7004A47F5 /* tclLiteral.c */; };
+ F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0808F272A7004A47F5 /* tclLoad.c */; };
+ F96D45A908F272BC004A47F5 /* tclMain.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0A08F272A7004A47F5 /* tclMain.c */; };
+ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0B08F272A7004A47F5 /* tclNamesp.c */; };
+ F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0C08F272A7004A47F5 /* tclNotify.c */; };
+ F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0D08F272A7004A47F5 /* tclObj.c */; };
+ F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0E08F272A7004A47F5 /* tclPanic.c */; };
+ F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F0F08F272A7004A47F5 /* tclParse.c */; };
+ F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1108F272A7004A47F5 /* tclPathObj.c */; };
+ F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1208F272A7004A47F5 /* tclPipe.c */; };
+ F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1308F272A7004A47F5 /* tclPkg.c */; };
+ F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */; settings = {COMPILER_FLAGS = "-DCFG_INSTALL_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_INSTALL_BINDIR=\\\"$(BINDIR)\\\" -DCFG_INSTALL_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_INSTALL_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_INSTALL_DOCDIR=\\\"$(MANDIR)\\\" -DCFG_RUNTIME_LIBDIR=\\\"$(LIBDIR)\\\" -DCFG_RUNTIME_BINDIR=\\\"$(BINDIR)\\\" -DCFG_RUNTIME_SCRDIR=\\\"$(TCL_LIBRARY)\\\" -DCFG_RUNTIME_INCDIR=\\\"$(INCLUDEDIR)\\\" -DCFG_RUNTIME_DOCDIR=\\\"$(MANDIR)\\\""; }; };
+ F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1708F272A7004A47F5 /* tclPosixStr.c */; };
+ F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1808F272A7004A47F5 /* tclPreserve.c */; };
+ F96D45B808F272BC004A47F5 /* tclProc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1908F272A7004A47F5 /* tclProc.c */; };
+ F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1A08F272A7004A47F5 /* tclRegexp.c */; };
+ F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1C08F272A7004A47F5 /* tclResolve.c */; };
+ F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1D08F272A7004A47F5 /* tclResult.c */; };
+ F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1E08F272A7004A47F5 /* tclScan.c */; };
+ F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F1F08F272A7004A47F5 /* tclStringObj.c */; };
+ F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2408F272A7004A47F5 /* tclStrToD.c */; };
+ F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2508F272A7004A47F5 /* tclStubInit.c */; };
+ F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2608F272A7004A47F5 /* tclStubLib.c */; };
+ F96D45C608F272BC004A47F5 /* tclTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2708F272A7004A47F5 /* tclTest.c */; };
+ F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2808F272A7004A47F5 /* tclTestObj.c */; };
+ F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; };
+ F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; };
+ F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; };
+ F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; };
+ F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; };
+ F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; };
+ F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; };
+ F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */; };
+ F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3208F272A7004A47F5 /* tclTrace.c */; };
+ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3408F272A7004A47F5 /* tclUtf.c */; };
+ F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3508F272A7004A47F5 /* tclUtil.c */; };
+ F96D45D508F272BC004A47F5 /* tclVar.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3608F272A7004A47F5 /* tclVar.c */; };
+ F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */; };
+ F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */; };
+ F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426908F272B3004A47F5 /* bn_mp_add.c */; };
+ F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */; };
+ F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */; };
+ F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426E08F272B3004A47F5 /* bn_mp_clear.c */; };
+ 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 */; };
+ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427708F272B3004A47F5 /* bn_mp_div_2.c */; };
+ F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */; };
+ F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_mp_div_3.c */; };
+ F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */; };
+ F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427E08F272B3004A47F5 /* bn_mp_exch.c */; };
+ F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428708F272B3004A47F5 /* bn_mp_grow.c */; };
+ F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428808F272B3004A47F5 /* bn_mp_init.c */; };
+ F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */; };
+ F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */; };
+ F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */; };
+ F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */; };
+ F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */; };
+ F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */; };
+ F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429508F272B3004A47F5 /* bn_mp_lshd.c */; };
+ F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429608F272B3004A47F5 /* bn_mp_mod.c */; };
+ F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */; };
+ F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429C08F272B3004A47F5 /* bn_mp_mul.c */; };
+ F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */; };
+ F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */; };
+ F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */; };
+ F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */; };
+ F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */; };
+ F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */; };
+ F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; };
+ F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; };
+ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; };
+ F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; };
+ F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; };
+ F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; };
+ F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; };
+ F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; };
+ F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; };
+ F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; };
+ F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; };
+ F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; };
+ F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; };
+ F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; };
+ F96D495508F272C3004A47F5 /* bncore.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D708F272B3004A47F5 /* bncore.c */; };
+ F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; };
+ F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; };
+ F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; };
+ F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; };
+ F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; };
+ F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; };
+ F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; };
+ F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; };
+ F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; };
+ F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; };
+ F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; };
+ F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; };
+ F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; };
+ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; };
+ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; };
+ F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; };
+ F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; };
+ F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
+ F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
+ F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
+ F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
+ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
+ F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
+ F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
+ F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
+ F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
+/* End PBXBuildFile section */
+
+/* Begin PBXContainerItemProxy section */
+ F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 8DD76FA90486AB0100D96B5E;
+ remoteInfo = tcltest;
+ };
+/* End PBXContainerItemProxy section */
+
+/* Begin PBXFileReference section */
+ 8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; };
+ F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; };
+ F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; };
+ F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; };
+ F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; };
+ F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; };
+ F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; };
+ F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; };
+ F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; };
+ F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; };
+ F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; };
+ F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; };
+ F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; };
+ F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; };
+ F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
+ F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
+ F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
+ F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
+ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
+ F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
+ F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
+ F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; };
+ F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
+ F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
+ F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
+ F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
+ F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
+ F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
+ F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
+ F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; };
+ F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; };
+ F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
+ F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
+ F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
+ F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
+ F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
+ F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
+ F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };
+ F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = "<group>"; };
+ F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
+ F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
+ F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
+ F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
+ F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
+ F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = "<group>"; };
+ F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = "<group>"; };
+ F96D3E0308F272A4004A47F5 /* AppInit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AppInit.3; sourceTree = "<group>"; };
+ F96D3E0408F272A5004A47F5 /* array.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = array.n; sourceTree = "<group>"; };
+ F96D3E0508F272A5004A47F5 /* AssocData.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AssocData.3; sourceTree = "<group>"; };
+ F96D3E0608F272A5004A47F5 /* Async.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Async.3; sourceTree = "<group>"; };
+ F96D3E0708F272A5004A47F5 /* BackgdErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BackgdErr.3; sourceTree = "<group>"; };
+ F96D3E0808F272A5004A47F5 /* Backslash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Backslash.3; sourceTree = "<group>"; };
+ F96D3E0908F272A5004A47F5 /* bgerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = bgerror.n; sourceTree = "<group>"; };
+ F96D3E0A08F272A5004A47F5 /* binary.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = binary.n; sourceTree = "<group>"; };
+ F96D3E0B08F272A5004A47F5 /* BoolObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = BoolObj.3; sourceTree = "<group>"; };
+ F96D3E0C08F272A5004A47F5 /* break.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = break.n; sourceTree = "<group>"; };
+ F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ByteArrObj.3; sourceTree = "<group>"; };
+ F96D3E0E08F272A5004A47F5 /* CallDel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CallDel.3; sourceTree = "<group>"; };
+ F96D3E0F08F272A5004A47F5 /* case.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = case.n; sourceTree = "<group>"; };
+ F96D3E1008F272A5004A47F5 /* catch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = catch.n; sourceTree = "<group>"; };
+ F96D3E1108F272A5004A47F5 /* cd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = cd.n; sourceTree = "<group>"; };
+ F96D3E1208F272A5004A47F5 /* chan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = chan.n; sourceTree = "<group>"; };
+ F96D3E1308F272A5004A47F5 /* ChnlStack.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ChnlStack.3; sourceTree = "<group>"; };
+ F96D3E1408F272A5004A47F5 /* clock.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = clock.n; sourceTree = "<group>"; };
+ F96D3E1508F272A5004A47F5 /* close.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = close.n; sourceTree = "<group>"; };
+ F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CmdCmplt.3; sourceTree = "<group>"; };
+ F96D3E1708F272A5004A47F5 /* Concat.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Concat.3; sourceTree = "<group>"; };
+ F96D3E1808F272A5004A47F5 /* concat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = concat.n; sourceTree = "<group>"; };
+ F96D3E1908F272A5004A47F5 /* continue.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = continue.n; sourceTree = "<group>"; };
+ F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChannel.3; sourceTree = "<group>"; };
+ F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = "<group>"; };
+ F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = "<group>"; };
+ F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = "<group>"; };
+ F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = "<group>"; };
+ F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
+ F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
+ F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
+ F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
+ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
+ F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
+ F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
+ F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = "<group>"; };
+ F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = "<group>"; };
+ F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = "<group>"; };
+ F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = "<group>"; };
+ F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoubleObj.3; sourceTree = "<group>"; };
+ F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoWhenIdle.3; sourceTree = "<group>"; };
+ F96D3E2C08F272A5004A47F5 /* DString.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DString.3; sourceTree = "<group>"; };
+ F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DumpActiveMemory.3; sourceTree = "<group>"; };
+ F96D3E2E08F272A5004A47F5 /* Encoding.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Encoding.3; sourceTree = "<group>"; };
+ F96D3E2F08F272A5004A47F5 /* encoding.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = encoding.n; sourceTree = "<group>"; };
+ F96D3E3008F272A5004A47F5 /* Ensemble.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Ensemble.3; sourceTree = "<group>"; };
+ F96D3E3108F272A5004A47F5 /* Environment.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Environment.3; sourceTree = "<group>"; };
+ F96D3E3208F272A5004A47F5 /* eof.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eof.n; sourceTree = "<group>"; };
+ F96D3E3308F272A5004A47F5 /* error.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = error.n; sourceTree = "<group>"; };
+ F96D3E3408F272A5004A47F5 /* Eval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Eval.3; sourceTree = "<group>"; };
+ F96D3E3508F272A5004A47F5 /* eval.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = eval.n; sourceTree = "<group>"; };
+ F96D3E3608F272A5004A47F5 /* exec.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exec.n; sourceTree = "<group>"; };
+ F96D3E3708F272A5004A47F5 /* Exit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Exit.3; sourceTree = "<group>"; };
+ F96D3E3808F272A5004A47F5 /* exit.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = exit.n; sourceTree = "<group>"; };
+ F96D3E3908F272A5004A47F5 /* expr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = expr.n; sourceTree = "<group>"; };
+ F96D3E3A08F272A5004A47F5 /* ExprLong.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLong.3; sourceTree = "<group>"; };
+ F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ExprLongObj.3; sourceTree = "<group>"; };
+ F96D3E3C08F272A5004A47F5 /* fblocked.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fblocked.n; sourceTree = "<group>"; };
+ F96D3E3D08F272A5004A47F5 /* fconfigure.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fconfigure.n; sourceTree = "<group>"; };
+ F96D3E3E08F272A5004A47F5 /* fcopy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fcopy.n; sourceTree = "<group>"; };
+ F96D3E3F08F272A5004A47F5 /* file.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = file.n; sourceTree = "<group>"; };
+ F96D3E4008F272A5004A47F5 /* fileevent.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fileevent.n; sourceTree = "<group>"; };
+ F96D3E4108F272A5004A47F5 /* filename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = filename.n; sourceTree = "<group>"; };
+ F96D3E4208F272A5004A47F5 /* FileSystem.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FileSystem.3; sourceTree = "<group>"; };
+ F96D3E4308F272A5004A47F5 /* FindExec.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = FindExec.3; sourceTree = "<group>"; };
+ F96D3E4408F272A5004A47F5 /* flush.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = flush.n; sourceTree = "<group>"; };
+ F96D3E4508F272A5004A47F5 /* for.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = for.n; sourceTree = "<group>"; };
+ F96D3E4608F272A5004A47F5 /* foreach.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = foreach.n; sourceTree = "<group>"; };
+ F96D3E4708F272A5004A47F5 /* format.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = format.n; sourceTree = "<group>"; };
+ F96D3E4808F272A5004A47F5 /* GetCwd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetCwd.3; sourceTree = "<group>"; };
+ F96D3E4908F272A5004A47F5 /* GetHostName.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetHostName.3; sourceTree = "<group>"; };
+ F96D3E4A08F272A5004A47F5 /* GetIndex.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetIndex.3; sourceTree = "<group>"; };
+ F96D3E4B08F272A5004A47F5 /* GetInt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetInt.3; sourceTree = "<group>"; };
+ F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetOpnFl.3; sourceTree = "<group>"; };
+ F96D3E4D08F272A5004A47F5 /* gets.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = gets.n; sourceTree = "<group>"; };
+ F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetStdChan.3; sourceTree = "<group>"; };
+ F96D3E4F08F272A5004A47F5 /* GetTime.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetTime.3; sourceTree = "<group>"; };
+ F96D3E5008F272A5004A47F5 /* GetVersion.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = GetVersion.3; sourceTree = "<group>"; };
+ F96D3E5108F272A5004A47F5 /* glob.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = glob.n; sourceTree = "<group>"; };
+ F96D3E5208F272A6004A47F5 /* global.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = global.n; sourceTree = "<group>"; };
+ F96D3E5308F272A6004A47F5 /* Hash.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Hash.3; sourceTree = "<group>"; };
+ F96D3E5408F272A6004A47F5 /* history.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = history.n; sourceTree = "<group>"; };
+ F96D3E5508F272A6004A47F5 /* http.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = http.n; sourceTree = "<group>"; };
+ F96D3E5608F272A6004A47F5 /* if.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = if.n; sourceTree = "<group>"; };
+ F96D3E5708F272A6004A47F5 /* incr.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = incr.n; sourceTree = "<group>"; };
+ F96D3E5808F272A6004A47F5 /* info.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = info.n; sourceTree = "<group>"; };
+ F96D3E5908F272A6004A47F5 /* Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Init.3; sourceTree = "<group>"; };
+ F96D3E5A08F272A6004A47F5 /* InitStubs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = InitStubs.3; sourceTree = "<group>"; };
+ F96D3E5B08F272A6004A47F5 /* Interp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Interp.3; sourceTree = "<group>"; };
+ F96D3E5C08F272A6004A47F5 /* interp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = interp.n; sourceTree = "<group>"; };
+ F96D3E5D08F272A6004A47F5 /* IntObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = IntObj.3; sourceTree = "<group>"; };
+ F96D3E5E08F272A6004A47F5 /* join.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = join.n; sourceTree = "<group>"; };
+ F96D3E5F08F272A6004A47F5 /* lappend.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lappend.n; sourceTree = "<group>"; };
+ F96D3E6008F272A6004A47F5 /* lassign.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lassign.n; sourceTree = "<group>"; };
+ F96D3E6108F272A6004A47F5 /* library.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = library.n; sourceTree = "<group>"; };
+ F96D3E6208F272A6004A47F5 /* Limit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Limit.3; sourceTree = "<group>"; };
+ F96D3E6308F272A6004A47F5 /* lindex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lindex.n; sourceTree = "<group>"; };
+ F96D3E6408F272A6004A47F5 /* LinkVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = LinkVar.3; sourceTree = "<group>"; };
+ F96D3E6508F272A6004A47F5 /* linsert.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = linsert.n; sourceTree = "<group>"; };
+ F96D3E6608F272A6004A47F5 /* list.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = list.n; sourceTree = "<group>"; };
+ F96D3E6708F272A6004A47F5 /* ListObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ListObj.3; sourceTree = "<group>"; };
+ F96D3E6808F272A6004A47F5 /* llength.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = llength.n; sourceTree = "<group>"; };
+ F96D3E6908F272A6004A47F5 /* load.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = load.n; sourceTree = "<group>"; };
+ F96D3E6A08F272A6004A47F5 /* lrange.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrange.n; sourceTree = "<group>"; };
+ F96D3E6B08F272A6004A47F5 /* lrepeat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lrepeat.n; sourceTree = "<group>"; };
+ F96D3E6C08F272A6004A47F5 /* lreplace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lreplace.n; sourceTree = "<group>"; };
+ F96D3E6D08F272A6004A47F5 /* lsearch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsearch.n; sourceTree = "<group>"; };
+ F96D3E6E08F272A6004A47F5 /* lset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lset.n; sourceTree = "<group>"; };
+ F96D3E6F08F272A6004A47F5 /* lsort.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = lsort.n; sourceTree = "<group>"; };
+ F96D3E7008F272A6004A47F5 /* man.macros */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = man.macros; sourceTree = "<group>"; };
+ F96D3E7108F272A6004A47F5 /* mathfunc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = mathfunc.n; sourceTree = "<group>"; };
+ F96D3E7208F272A6004A47F5 /* memory.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = memory.n; sourceTree = "<group>"; };
+ F96D3E7308F272A6004A47F5 /* msgcat.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = msgcat.n; sourceTree = "<group>"; };
+ F96D3E7408F272A6004A47F5 /* Namespace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Namespace.3; sourceTree = "<group>"; };
+ F96D3E7508F272A6004A47F5 /* namespace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = namespace.n; sourceTree = "<group>"; };
+ F96D3E7608F272A6004A47F5 /* Notifier.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Notifier.3; sourceTree = "<group>"; };
+ F96D3E7708F272A6004A47F5 /* Object.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Object.3; sourceTree = "<group>"; };
+ F96D3E7808F272A6004A47F5 /* ObjectType.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ObjectType.3; sourceTree = "<group>"; };
+ F96D3E7908F272A6004A47F5 /* open.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = open.n; sourceTree = "<group>"; };
+ F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenFileChnl.3; sourceTree = "<group>"; };
+ F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = OpenTcp.3; sourceTree = "<group>"; };
+ F96D3E7C08F272A6004A47F5 /* package.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = package.n; sourceTree = "<group>"; };
+ F96D3E7D08F272A6004A47F5 /* packagens.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = packagens.n; sourceTree = "<group>"; };
+ F96D3E7E08F272A6004A47F5 /* Panic.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Panic.3; sourceTree = "<group>"; };
+ F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ParseCmd.3; sourceTree = "<group>"; };
+ F96D3E8008F272A6004A47F5 /* pid.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pid.n; sourceTree = "<group>"; };
+ F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pkgMkIndex.n; sourceTree = "<group>"; };
+ F96D3E8208F272A6004A47F5 /* PkgRequire.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PkgRequire.3; sourceTree = "<group>"; };
+ F96D3E8308F272A6004A47F5 /* Preserve.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Preserve.3; sourceTree = "<group>"; };
+ F96D3E8408F272A6004A47F5 /* PrintDbl.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = PrintDbl.3; sourceTree = "<group>"; };
+ F96D3E8508F272A6004A47F5 /* proc.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = proc.n; sourceTree = "<group>"; };
+ F96D3E8608F272A6004A47F5 /* puts.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = puts.n; sourceTree = "<group>"; };
+ F96D3E8708F272A6004A47F5 /* pwd.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = pwd.n; sourceTree = "<group>"; };
+ F96D3E8808F272A6004A47F5 /* re_syntax.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = re_syntax.n; sourceTree = "<group>"; };
+ F96D3E8908F272A6004A47F5 /* read.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = read.n; sourceTree = "<group>"; };
+ F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecEvalObj.3; sourceTree = "<group>"; };
+ F96D3E8B08F272A6004A47F5 /* RecordEval.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RecordEval.3; sourceTree = "<group>"; };
+ F96D3E8C08F272A6004A47F5 /* RegConfig.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegConfig.3; sourceTree = "<group>"; };
+ F96D3E8D08F272A6004A47F5 /* RegExp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = RegExp.3; sourceTree = "<group>"; };
+ F96D3E8E08F272A6004A47F5 /* regexp.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regexp.n; sourceTree = "<group>"; };
+ F96D3E8F08F272A6004A47F5 /* registry.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = registry.n; sourceTree = "<group>"; };
+ F96D3E9008F272A6004A47F5 /* regsub.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = regsub.n; sourceTree = "<group>"; };
+ F96D3E9108F272A6004A47F5 /* rename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = rename.n; sourceTree = "<group>"; };
+ F96D3E9208F272A6004A47F5 /* return.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = return.n; sourceTree = "<group>"; };
+ F96D3E9308F272A6004A47F5 /* safe.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = safe.n; sourceTree = "<group>"; };
+ F96D3E9408F272A6004A47F5 /* SaveResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveResult.3; sourceTree = "<group>"; };
+ F96D3E9508F272A6004A47F5 /* scan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = scan.n; sourceTree = "<group>"; };
+ F96D3E9608F272A6004A47F5 /* seek.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = seek.n; sourceTree = "<group>"; };
+ F96D3E9708F272A6004A47F5 /* set.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = set.n; sourceTree = "<group>"; };
+ F96D3E9808F272A6004A47F5 /* SetChanErr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetChanErr.3; sourceTree = "<group>"; };
+ F96D3E9908F272A6004A47F5 /* SetErrno.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetErrno.3; sourceTree = "<group>"; };
+ F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetRecLmt.3; sourceTree = "<group>"; };
+ F96D3E9B08F272A7004A47F5 /* SetResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetResult.3; sourceTree = "<group>"; };
+ F96D3E9C08F272A7004A47F5 /* SetVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SetVar.3; sourceTree = "<group>"; };
+ F96D3E9D08F272A7004A47F5 /* Signal.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Signal.3; sourceTree = "<group>"; };
+ F96D3E9E08F272A7004A47F5 /* Sleep.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Sleep.3; sourceTree = "<group>"; };
+ F96D3E9F08F272A7004A47F5 /* socket.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = socket.n; sourceTree = "<group>"; };
+ F96D3EA008F272A7004A47F5 /* source.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = source.n; sourceTree = "<group>"; };
+ F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SourceRCFile.3; sourceTree = "<group>"; };
+ F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
+ F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
+ F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
+ F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; };
+ F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
+ F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
+ F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
+ F96D3EA908F272A7004A47F5 /* StrMatch.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StrMatch.3; sourceTree = "<group>"; };
+ F96D3EAA08F272A7004A47F5 /* subst.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = subst.n; sourceTree = "<group>"; };
+ F96D3EAB08F272A7004A47F5 /* SubstObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SubstObj.3; sourceTree = "<group>"; };
+ F96D3EAC08F272A7004A47F5 /* switch.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = switch.n; sourceTree = "<group>"; };
+ F96D3EAD08F272A7004A47F5 /* Tcl.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl.n; sourceTree = "<group>"; };
+ F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tcl_Main.3; sourceTree = "<group>"; };
+ F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TCL_MEM_DEBUG.3; sourceTree = "<group>"; };
+ F96D3EB008F272A7004A47F5 /* tclsh.1 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclsh.1; sourceTree = "<group>"; };
+ F96D3EB108F272A7004A47F5 /* tcltest.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tcltest.n; sourceTree = "<group>"; };
+ F96D3EB208F272A7004A47F5 /* tclvars.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tclvars.n; sourceTree = "<group>"; };
+ F96D3EB308F272A7004A47F5 /* tell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tell.n; sourceTree = "<group>"; };
+ F96D3EB408F272A7004A47F5 /* Thread.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Thread.3; sourceTree = "<group>"; };
+ F96D3EB508F272A7004A47F5 /* time.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = time.n; sourceTree = "<group>"; };
+ F96D3EB608F272A7004A47F5 /* tm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tm.n; sourceTree = "<group>"; };
+ F96D3EB708F272A7004A47F5 /* ToUpper.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = ToUpper.3; sourceTree = "<group>"; };
+ F96D3EB808F272A7004A47F5 /* trace.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = trace.n; sourceTree = "<group>"; };
+ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceCmd.3; sourceTree = "<group>"; };
+ F96D3EBA08F272A7004A47F5 /* TraceVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TraceVar.3; sourceTree = "<group>"; };
+ F96D3EBB08F272A7004A47F5 /* Translate.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Translate.3; sourceTree = "<group>"; };
+ F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UniCharIsAlpha.3; sourceTree = "<group>"; };
+ F96D3EBD08F272A7004A47F5 /* unknown.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unknown.n; sourceTree = "<group>"; };
+ F96D3EBE08F272A7004A47F5 /* unload.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unload.n; sourceTree = "<group>"; };
+ F96D3EBF08F272A7004A47F5 /* unset.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = unset.n; sourceTree = "<group>"; };
+ F96D3EC008F272A7004A47F5 /* update.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = update.n; sourceTree = "<group>"; };
+ F96D3EC108F272A7004A47F5 /* uplevel.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = uplevel.n; sourceTree = "<group>"; };
+ F96D3EC208F272A7004A47F5 /* UpVar.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = UpVar.3; sourceTree = "<group>"; };
+ F96D3EC308F272A7004A47F5 /* upvar.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = upvar.n; sourceTree = "<group>"; };
+ F96D3EC408F272A7004A47F5 /* Utf.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Utf.3; sourceTree = "<group>"; };
+ F96D3EC508F272A7004A47F5 /* variable.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = variable.n; sourceTree = "<group>"; };
+ F96D3EC608F272A7004A47F5 /* vwait.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = vwait.n; sourceTree = "<group>"; };
+ F96D3EC708F272A7004A47F5 /* while.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = while.n; sourceTree = "<group>"; };
+ F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = WrongNumArgs.3; sourceTree = "<group>"; };
+ F96D3ECA08F272A7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D3ECB08F272A7004A47F5 /* regc_color.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_color.c; sourceTree = "<group>"; };
+ F96D3ECC08F272A7004A47F5 /* regc_cvec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_cvec.c; sourceTree = "<group>"; };
+ F96D3ECD08F272A7004A47F5 /* regc_lex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_lex.c; sourceTree = "<group>"; };
+ F96D3ECE08F272A7004A47F5 /* regc_locale.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_locale.c; sourceTree = "<group>"; };
+ F96D3ECF08F272A7004A47F5 /* regc_nfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regc_nfa.c; sourceTree = "<group>"; };
+ F96D3ED008F272A7004A47F5 /* regcomp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regcomp.c; sourceTree = "<group>"; };
+ F96D3ED108F272A7004A47F5 /* regcustom.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regcustom.h; sourceTree = "<group>"; };
+ F96D3ED208F272A7004A47F5 /* rege_dfa.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = rege_dfa.c; sourceTree = "<group>"; };
+ F96D3ED308F272A7004A47F5 /* regerror.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regerror.c; sourceTree = "<group>"; };
+ F96D3ED408F272A7004A47F5 /* regerrs.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regerrs.h; sourceTree = "<group>"; };
+ F96D3ED508F272A7004A47F5 /* regex.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regex.h; sourceTree = "<group>"; };
+ F96D3ED608F272A7004A47F5 /* regexec.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regexec.c; sourceTree = "<group>"; };
+ F96D3ED708F272A7004A47F5 /* regfree.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfree.c; sourceTree = "<group>"; };
+ F96D3ED808F272A7004A47F5 /* regfronts.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = regfronts.c; sourceTree = "<group>"; };
+ F96D3ED908F272A7004A47F5 /* regguts.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = regguts.h; sourceTree = "<group>"; };
+ F96D3EDA08F272A7004A47F5 /* tcl.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcl.decls; sourceTree = "<group>"; };
+ F96D3EDB08F272A7004A47F5 /* tcl.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tcl.h; sourceTree = "<group>"; };
+ F96D3EDC08F272A7004A47F5 /* tclAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAlloc.c; sourceTree = "<group>"; };
+ F96D3EDD08F272A7004A47F5 /* tclAsync.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAsync.c; sourceTree = "<group>"; };
+ F96D3EDE08F272A7004A47F5 /* tclBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBasic.c; sourceTree = "<group>"; };
+ F96D3EDF08F272A7004A47F5 /* tclBinary.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclBinary.c; sourceTree = "<group>"; };
+ F96D3EE008F272A7004A47F5 /* tclCkalloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCkalloc.c; sourceTree = "<group>"; };
+ F96D3EE108F272A7004A47F5 /* tclClock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclClock.c; sourceTree = "<group>"; };
+ F96D3EE208F272A7004A47F5 /* tclCmdAH.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdAH.c; sourceTree = "<group>"; };
+ F96D3EE308F272A7004A47F5 /* tclCmdIL.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdIL.c; sourceTree = "<group>"; };
+ F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCmdMZ.c; sourceTree = "<group>"; };
+ F96D3EE508F272A7004A47F5 /* tclCompCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompCmds.c; sourceTree = "<group>"; };
+ F96D3EE608F272A7004A47F5 /* tclCompExpr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompExpr.c; sourceTree = "<group>"; };
+ F96D3EE708F272A7004A47F5 /* tclCompile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclCompile.c; sourceTree = "<group>"; };
+ F96D3EE808F272A7004A47F5 /* tclCompile.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclCompile.h; sourceTree = "<group>"; };
+ F96D3EE908F272A7004A47F5 /* tclConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclConfig.c; sourceTree = "<group>"; };
+ F96D3EEA08F272A7004A47F5 /* tclDate.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDate.c; sourceTree = "<group>"; };
+ F96D3EEB08F272A7004A47F5 /* tclDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclDecls.h; sourceTree = "<group>"; };
+ F96D3EEC08F272A7004A47F5 /* tclDictObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclDictObj.c; sourceTree = "<group>"; };
+ F96D3EED08F272A7004A47F5 /* tclEncoding.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEncoding.c; sourceTree = "<group>"; };
+ F96D3EEE08F272A7004A47F5 /* tclEnv.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEnv.c; sourceTree = "<group>"; };
+ F96D3EEF08F272A7004A47F5 /* tclEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclEvent.c; sourceTree = "<group>"; };
+ F96D3EF008F272A7004A47F5 /* tclExecute.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclExecute.c; sourceTree = "<group>"; };
+ F96D3EF108F272A7004A47F5 /* tclFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFCmd.c; sourceTree = "<group>"; };
+ F96D3EF208F272A7004A47F5 /* tclFileName.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclFileName.c; sourceTree = "<group>"; };
+ F96D3EF308F272A7004A47F5 /* tclFileSystem.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclFileSystem.h; sourceTree = "<group>"; };
+ F96D3EF408F272A7004A47F5 /* tclGet.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclGet.c; sourceTree = "<group>"; };
+ F96D3EF508F272A7004A47F5 /* tclGetDate.y */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.yacc; path = tclGetDate.y; sourceTree = "<group>"; };
+ F96D3EF608F272A7004A47F5 /* tclHash.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHash.c; sourceTree = "<group>"; };
+ F96D3EF708F272A7004A47F5 /* tclHistory.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclHistory.c; sourceTree = "<group>"; };
+ F96D3EF808F272A7004A47F5 /* tclIndexObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIndexObj.c; sourceTree = "<group>"; };
+ F96D3EF908F272A7004A47F5 /* tclInt.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclInt.decls; sourceTree = "<group>"; };
+ F96D3EFA08F272A7004A47F5 /* tclInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclInt.h; sourceTree = "<group>"; };
+ F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntDecls.h; sourceTree = "<group>"; };
+ F96D3EFC08F272A7004A47F5 /* tclInterp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclInterp.c; sourceTree = "<group>"; };
+ F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIntPlatDecls.h; sourceTree = "<group>"; };
+ F96D3EFE08F272A7004A47F5 /* tclIO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIO.c; sourceTree = "<group>"; };
+ F96D3EFF08F272A7004A47F5 /* tclIO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclIO.h; sourceTree = "<group>"; };
+ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOCmd.c; sourceTree = "<group>"; };
+ F96D3F0108F272A7004A47F5 /* tclIOGT.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOGT.c; sourceTree = "<group>"; };
+ F96D3F0208F272A7004A47F5 /* tclIORChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORChan.c; sourceTree = "<group>"; };
+ F96D3F0308F272A7004A47F5 /* tclIOSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOSock.c; sourceTree = "<group>"; };
+ F96D3F0408F272A7004A47F5 /* tclIOUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIOUtil.c; sourceTree = "<group>"; };
+ F96D3F0508F272A7004A47F5 /* tclLink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLink.c; sourceTree = "<group>"; };
+ F96D3F0608F272A7004A47F5 /* tclListObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclListObj.c; sourceTree = "<group>"; };
+ F96D3F0708F272A7004A47F5 /* tclLiteral.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLiteral.c; sourceTree = "<group>"; };
+ F96D3F0808F272A7004A47F5 /* tclLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoad.c; sourceTree = "<group>"; };
+ F96D3F0908F272A7004A47F5 /* tclLoadNone.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNone.c; sourceTree = "<group>"; };
+ F96D3F0A08F272A7004A47F5 /* tclMain.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMain.c; sourceTree = "<group>"; };
+ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNamesp.c; sourceTree = "<group>"; };
+ F96D3F0C08F272A7004A47F5 /* tclNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclNotify.c; sourceTree = "<group>"; };
+ F96D3F0D08F272A7004A47F5 /* tclObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclObj.c; sourceTree = "<group>"; };
+ F96D3F0E08F272A7004A47F5 /* tclPanic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPanic.c; sourceTree = "<group>"; };
+ F96D3F0F08F272A7004A47F5 /* tclParse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclParse.c; sourceTree = "<group>"; };
+ F96D3F1108F272A7004A47F5 /* tclPathObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPathObj.c; sourceTree = "<group>"; };
+ F96D3F1208F272A7004A47F5 /* tclPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPipe.c; sourceTree = "<group>"; };
+ F96D3F1308F272A7004A47F5 /* tclPkg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkg.c; sourceTree = "<group>"; };
+ F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPkgConfig.c; sourceTree = "<group>"; };
+ F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPlatDecls.h; sourceTree = "<group>"; };
+ F96D3F1608F272A7004A47F5 /* tclPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclPort.h; sourceTree = "<group>"; };
+ F96D3F1708F272A7004A47F5 /* tclPosixStr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPosixStr.c; sourceTree = "<group>"; };
+ F96D3F1808F272A7004A47F5 /* tclPreserve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclPreserve.c; sourceTree = "<group>"; };
+ F96D3F1908F272A7004A47F5 /* tclProc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclProc.c; sourceTree = "<group>"; };
+ F96D3F1A08F272A7004A47F5 /* tclRegexp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclRegexp.c; sourceTree = "<group>"; };
+ F96D3F1B08F272A7004A47F5 /* tclRegexp.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclRegexp.h; sourceTree = "<group>"; };
+ F96D3F1C08F272A7004A47F5 /* tclResolve.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResolve.c; sourceTree = "<group>"; };
+ F96D3F1D08F272A7004A47F5 /* tclResult.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclResult.c; sourceTree = "<group>"; };
+ F96D3F1E08F272A7004A47F5 /* tclScan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclScan.c; sourceTree = "<group>"; };
+ F96D3F1F08F272A7004A47F5 /* tclStringObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStringObj.c; sourceTree = "<group>"; };
+ F96D3F2408F272A7004A47F5 /* tclStrToD.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStrToD.c; sourceTree = "<group>"; };
+ F96D3F2508F272A7004A47F5 /* tclStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubInit.c; sourceTree = "<group>"; };
+ F96D3F2608F272A7004A47F5 /* tclStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubLib.c; sourceTree = "<group>"; };
+ F96D3F2708F272A7004A47F5 /* tclTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTest.c; sourceTree = "<group>"; };
+ F96D3F2808F272A7004A47F5 /* tclTestObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestObj.c; sourceTree = "<group>"; };
+ F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = "<group>"; };
+ F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = "<group>"; };
+ F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = "<group>"; };
+ F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = "<group>"; };
+ F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = "<group>"; };
+ F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = "<group>"; };
+ F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = "<group>"; };
+ F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = "<group>"; };
+ F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = "<group>"; };
+ F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = "<group>"; };
+ F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = "<group>"; };
+ F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = "<group>"; };
+ F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = "<group>"; };
+ F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = "<group>"; };
+ F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = "<group>"; };
+ F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = "<group>"; };
+ F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = "<group>"; };
+ F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = "<group>"; };
+ F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
+ F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
+ F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D3F9308F272A8004A47F5 /* init.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.tcl; sourceTree = "<group>"; };
+ F96D3F9508F272A8004A47F5 /* msgcat.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.tcl; sourceTree = "<group>"; };
+ F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401808F272AA004A47F5 /* optparse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optparse.tcl; sourceTree = "<group>"; };
+ F96D401908F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401A08F272AA004A47F5 /* package.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.tcl; sourceTree = "<group>"; };
+ F96D401B08F272AA004A47F5 /* parray.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parray.tcl; sourceTree = "<group>"; };
+ F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = "<group>"; };
+ F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = "<group>"; };
+ F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; };
+ F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; };
+ F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; };
+ F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; };
+ F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; };
+ F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; };
+ F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; };
+ F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; };
+ F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; };
+ F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; };
+ F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = "<group>"; };
+ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; };
+ F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; };
+ F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; };
+ F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; };
+ F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; };
+ F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; };
+ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = "<group>"; };
+ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; };
+ F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; };
+ F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; };
+ F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; };
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; };
+ F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; };
+ F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; };
+ F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; };
+ F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; };
+ F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; };
+ F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; };
+ F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; };
+ F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; };
+ F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; };
+ F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; };
+ F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; };
+ F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; };
+ F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; };
+ F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; };
+ F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; };
+ F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; };
+ F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; };
+ F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; };
+ F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; };
+ F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; };
+ F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; };
+ F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; };
+ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; };
+ F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; };
+ F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; };
+ F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; };
+ F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; };
+ F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; };
+ F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; };
+ F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; };
+ F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; };
+ F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; };
+ F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; };
+ F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; };
+ F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; };
+ F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; };
+ F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; };
+ F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; };
+ F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; };
+ F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; };
+ F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; };
+ F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; };
+ F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; };
+ F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; };
+ F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = "<group>"; };
+ F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = "<group>"; };
+ F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = "<group>"; };
+ F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXBundle.c; sourceTree = "<group>"; };
+ F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXFCmd.c; sourceTree = "<group>"; };
+ F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclMacOSXNotify.c; sourceTree = "<group>"; };
+ F96D434308F272B5004A47F5 /* README */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = README; sourceTree = "<group>"; };
+ F96D434508F272B5004A47F5 /* all.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = all.tcl; sourceTree = "<group>"; };
+ F96D434608F272B5004A47F5 /* append.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = append.test; sourceTree = "<group>"; };
+ F96D434708F272B5004A47F5 /* appendComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = appendComp.test; sourceTree = "<group>"; };
+ F96D434808F272B5004A47F5 /* assocd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = assocd.test; sourceTree = "<group>"; };
+ F96D434908F272B5004A47F5 /* async.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = async.test; sourceTree = "<group>"; };
+ F96D434A08F272B5004A47F5 /* autoMkindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = autoMkindex.test; sourceTree = "<group>"; };
+ F96D434B08F272B5004A47F5 /* basic.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = basic.test; sourceTree = "<group>"; };
+ F96D434C08F272B5004A47F5 /* binary.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = binary.test; sourceTree = "<group>"; };
+ F96D434D08F272B5004A47F5 /* case.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = case.test; sourceTree = "<group>"; };
+ F96D434E08F272B5004A47F5 /* chan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chan.test; sourceTree = "<group>"; };
+ F96D434F08F272B5004A47F5 /* clock.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.test; sourceTree = "<group>"; };
+ F96D435008F272B5004A47F5 /* cmdAH.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdAH.test; sourceTree = "<group>"; };
+ F96D435108F272B5004A47F5 /* cmdIL.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdIL.test; sourceTree = "<group>"; };
+ F96D435208F272B5004A47F5 /* cmdInfo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdInfo.test; sourceTree = "<group>"; };
+ F96D435308F272B5004A47F5 /* cmdMZ.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = cmdMZ.test; sourceTree = "<group>"; };
+ F96D435408F272B5004A47F5 /* compExpr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "compExpr-old.test"; sourceTree = "<group>"; };
+ F96D435508F272B5004A47F5 /* compExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compExpr.test; sourceTree = "<group>"; };
+ F96D435608F272B5004A47F5 /* compile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = compile.test; sourceTree = "<group>"; };
+ F96D435708F272B5004A47F5 /* concat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = concat.test; sourceTree = "<group>"; };
+ F96D435808F272B5004A47F5 /* config.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = config.test; sourceTree = "<group>"; };
+ F96D435908F272B5004A47F5 /* dcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dcall.test; sourceTree = "<group>"; };
+ F96D435A08F272B5004A47F5 /* dict.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dict.test; sourceTree = "<group>"; };
+ F96D435C08F272B5004A47F5 /* dstring.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = dstring.test; sourceTree = "<group>"; };
+ F96D435E08F272B5004A47F5 /* encoding.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = encoding.test; sourceTree = "<group>"; };
+ F96D435F08F272B5004A47F5 /* env.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = env.test; sourceTree = "<group>"; };
+ F96D436008F272B5004A47F5 /* error.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = error.test; sourceTree = "<group>"; };
+ F96D436108F272B5004A47F5 /* eval.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eval.test; sourceTree = "<group>"; };
+ F96D436208F272B5004A47F5 /* event.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = event.test; sourceTree = "<group>"; };
+ F96D436308F272B5004A47F5 /* exec.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = exec.test; sourceTree = "<group>"; };
+ F96D436408F272B5004A47F5 /* execute.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = execute.test; sourceTree = "<group>"; };
+ F96D436508F272B5004A47F5 /* expr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "expr-old.test"; sourceTree = "<group>"; };
+ F96D436608F272B5004A47F5 /* expr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = expr.test; sourceTree = "<group>"; };
+ F96D436708F272B6004A47F5 /* fCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fCmd.test; sourceTree = "<group>"; };
+ F96D436808F272B6004A47F5 /* fileName.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileName.test; sourceTree = "<group>"; };
+ F96D436908F272B6004A47F5 /* fileSystem.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fileSystem.test; sourceTree = "<group>"; };
+ F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = "<group>"; };
+ F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = "<group>"; };
+ F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = "<group>"; };
+ F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = "<group>"; };
+ F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; };
+ F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; };
+ F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; };
+ F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; };
+ F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; };
+ F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; };
+ F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; };
+ F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = "<group>"; };
+ F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = "<group>"; };
+ F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = "<group>"; };
+ F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = "<group>"; };
+ F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = "<group>"; };
+ F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = "<group>"; };
+ F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; };
+ F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; };
+ F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; };
+ F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; };
+ F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; };
+ F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; };
+ F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = "<group>"; };
+ F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = "<group>"; };
+ F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = "<group>"; };
+ F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = "<group>"; };
+ F96D438608F272B6004A47F5 /* load.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = load.test; sourceTree = "<group>"; };
+ F96D438708F272B6004A47F5 /* lrange.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrange.test; sourceTree = "<group>"; };
+ F96D438808F272B6004A47F5 /* lrepeat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lrepeat.test; sourceTree = "<group>"; };
+ F96D438908F272B6004A47F5 /* lreplace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lreplace.test; sourceTree = "<group>"; };
+ F96D438A08F272B6004A47F5 /* lsearch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsearch.test; sourceTree = "<group>"; };
+ F96D438B08F272B6004A47F5 /* lset.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lset.test; sourceTree = "<group>"; };
+ F96D438C08F272B6004A47F5 /* lsetComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lsetComp.test; sourceTree = "<group>"; };
+ F96D438D08F272B6004A47F5 /* macOSXFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXFCmd.test; sourceTree = "<group>"; };
+ F96D438E08F272B6004A47F5 /* main.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = main.test; sourceTree = "<group>"; };
+ F96D438F08F272B6004A47F5 /* misc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = misc.test; sourceTree = "<group>"; };
+ F96D439008F272B6004A47F5 /* msgcat.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = msgcat.test; sourceTree = "<group>"; };
+ F96D439108F272B6004A47F5 /* namespace-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "namespace-old.test"; sourceTree = "<group>"; };
+ F96D439208F272B7004A47F5 /* namespace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = namespace.test; sourceTree = "<group>"; };
+ F96D439308F272B7004A47F5 /* notify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = notify.test; sourceTree = "<group>"; };
+ F96D439408F272B7004A47F5 /* obj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = obj.test; sourceTree = "<group>"; };
+ F96D439508F272B7004A47F5 /* opt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = opt.test; sourceTree = "<group>"; };
+ F96D439608F272B7004A47F5 /* package.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = package.test; sourceTree = "<group>"; };
+ F96D439708F272B7004A47F5 /* parse.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parse.test; sourceTree = "<group>"; };
+ F96D439808F272B7004A47F5 /* parseExpr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseExpr.test; sourceTree = "<group>"; };
+ F96D439908F272B7004A47F5 /* parseOld.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = parseOld.test; sourceTree = "<group>"; };
+ F96D439A08F272B7004A47F5 /* pid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pid.test; sourceTree = "<group>"; };
+ F96D439B08F272B7004A47F5 /* pkg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkg.test; sourceTree = "<group>"; };
+ F96D439C08F272B7004A47F5 /* pkgMkIndex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgMkIndex.test; sourceTree = "<group>"; };
+ F96D439D08F272B7004A47F5 /* platform.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.test; sourceTree = "<group>"; };
+ F96D439E08F272B7004A47F5 /* proc-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "proc-old.test"; sourceTree = "<group>"; };
+ F96D439F08F272B7004A47F5 /* proc.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = proc.test; sourceTree = "<group>"; };
+ F96D43A008F272B7004A47F5 /* pwd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pwd.test; sourceTree = "<group>"; };
+ F96D43A108F272B7004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D43A208F272B7004A47F5 /* reg.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = reg.test; sourceTree = "<group>"; };
+ F96D43A308F272B7004A47F5 /* regexp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexp.test; sourceTree = "<group>"; };
+ F96D43A408F272B7004A47F5 /* regexpComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpComp.test; sourceTree = "<group>"; };
+ F96D43A508F272B7004A47F5 /* registry.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = registry.test; sourceTree = "<group>"; };
+ F96D43A608F272B7004A47F5 /* remote.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = remote.tcl; sourceTree = "<group>"; };
+ F96D43A708F272B7004A47F5 /* rename.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = rename.test; sourceTree = "<group>"; };
+ F96D43A808F272B7004A47F5 /* result.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = result.test; sourceTree = "<group>"; };
+ F96D43A908F272B7004A47F5 /* safe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.test; sourceTree = "<group>"; };
+ F96D43AA08F272B7004A47F5 /* scan.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scan.test; sourceTree = "<group>"; };
+ F96D43AB08F272B7004A47F5 /* security.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = security.test; sourceTree = "<group>"; };
+ F96D43AC08F272B7004A47F5 /* set-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "set-old.test"; sourceTree = "<group>"; };
+ F96D43AD08F272B7004A47F5 /* set.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = set.test; sourceTree = "<group>"; };
+ F96D43AE08F272B7004A47F5 /* socket.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = socket.test; sourceTree = "<group>"; };
+ F96D43AF08F272B7004A47F5 /* source.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = source.test; sourceTree = "<group>"; };
+ F96D43B008F272B7004A47F5 /* split.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = split.test; sourceTree = "<group>"; };
+ F96D43B108F272B7004A47F5 /* stack.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stack.test; sourceTree = "<group>"; };
+ F96D43B208F272B7004A47F5 /* string.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = string.test; sourceTree = "<group>"; };
+ F96D43B308F272B7004A47F5 /* stringComp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringComp.test; sourceTree = "<group>"; };
+ F96D43B408F272B7004A47F5 /* stringObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = stringObj.test; sourceTree = "<group>"; };
+ F96D43B508F272B7004A47F5 /* subst.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = subst.test; sourceTree = "<group>"; };
+ F96D43B608F272B7004A47F5 /* switch.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = switch.test; sourceTree = "<group>"; };
+ F96D43B708F272B7004A47F5 /* tcltest.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.test; sourceTree = "<group>"; };
+ F96D43B808F272B7004A47F5 /* thread.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = thread.test; sourceTree = "<group>"; };
+ F96D43B908F272B7004A47F5 /* timer.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = timer.test; sourceTree = "<group>"; };
+ F96D43BA08F272B7004A47F5 /* tm.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.test; sourceTree = "<group>"; };
+ F96D43BB08F272B7004A47F5 /* trace.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = trace.test; sourceTree = "<group>"; };
+ F96D43BC08F272B7004A47F5 /* unixFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFCmd.test; sourceTree = "<group>"; };
+ F96D43BD08F272B7004A47F5 /* unixFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixFile.test; sourceTree = "<group>"; };
+ F96D43BE08F272B7004A47F5 /* unixInit.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixInit.test; sourceTree = "<group>"; };
+ F96D43BF08F272B7004A47F5 /* unixNotfy.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unixNotfy.test; sourceTree = "<group>"; };
+ F96D43C008F272B7004A47F5 /* unknown.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unknown.test; sourceTree = "<group>"; };
+ F96D43C108F272B7004A47F5 /* unload.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = unload.test; sourceTree = "<group>"; };
+ F96D43C208F272B7004A47F5 /* uplevel.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uplevel.test; sourceTree = "<group>"; };
+ F96D43C308F272B7004A47F5 /* upvar.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = upvar.test; sourceTree = "<group>"; };
+ F96D43C408F272B7004A47F5 /* utf.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = utf.test; sourceTree = "<group>"; };
+ F96D43C508F272B7004A47F5 /* util.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = util.test; sourceTree = "<group>"; };
+ F96D43C608F272B7004A47F5 /* var.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = var.test; sourceTree = "<group>"; };
+ F96D43C708F272B7004A47F5 /* while-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "while-old.test"; sourceTree = "<group>"; };
+ F96D43C808F272B7004A47F5 /* while.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = while.test; sourceTree = "<group>"; };
+ F96D43C908F272B7004A47F5 /* winConsole.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winConsole.test; sourceTree = "<group>"; };
+ F96D43CA08F272B7004A47F5 /* winDde.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winDde.test; sourceTree = "<group>"; };
+ F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = "<group>"; };
+ F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = "<group>"; };
+ F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = "<group>"; };
+ F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = "<group>"; };
+ F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
+ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
+ F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D442208F272B8004A47F5 /* eolFix.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eolFix.tcl; sourceTree = "<group>"; };
+ F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
+ F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
+ F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
+ F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
+ F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
+ F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
+ F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
+ F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
+ F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
+ F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
+ F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
+ F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
+ 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>"; };
+ 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>"; };
+ F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
+ F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
+ F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
+ F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
+ F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = "<group>"; };
+ F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = "<group>"; };
+ F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = "<group>"; };
+ F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = "<group>"; };
+ F96D444C08F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D444D08F272B9004A47F5 /* install-sh */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = "install-sh"; sourceTree = "<group>"; };
+ F96D444E08F272B9004A47F5 /* installManPage */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = installManPage; sourceTree = "<group>"; };
+ F96D444F08F272B9004A47F5 /* ldAix */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = ldAix; sourceTree = "<group>"; };
+ F96D445008F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D445208F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D445308F272B9004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
+ F96D445408F272B9004A47F5 /* tcl.spec */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.spec; sourceTree = "<group>"; };
+ F96D445508F272B9004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
+ F96D445608F272B9004A47F5 /* tclConfig.h.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = tclConfig.h.in; sourceTree = "<group>"; };
+ F96D445708F272B9004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
+ F96D445808F272B9004A47F5 /* tclLoadAix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadAix.c; sourceTree = "<group>"; };
+ F96D445908F272B9004A47F5 /* tclLoadDl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDl.c; sourceTree = "<group>"; };
+ F96D445B08F272B9004A47F5 /* tclLoadDyld.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadDyld.c; sourceTree = "<group>"; };
+ F96D445C08F272B9004A47F5 /* tclLoadNext.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadNext.c; sourceTree = "<group>"; };
+ F96D445D08F272B9004A47F5 /* tclLoadOSF.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadOSF.c; sourceTree = "<group>"; };
+ F96D445E08F272B9004A47F5 /* tclLoadShl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclLoadShl.c; sourceTree = "<group>"; };
+ F96D445F08F272B9004A47F5 /* tclUnixChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixChan.c; sourceTree = "<group>"; };
+ F96D446008F272B9004A47F5 /* tclUnixEvent.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixEvent.c; sourceTree = "<group>"; };
+ F96D446108F272B9004A47F5 /* tclUnixFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFCmd.c; sourceTree = "<group>"; };
+ F96D446208F272B9004A47F5 /* tclUnixFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixFile.c; sourceTree = "<group>"; };
+ F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
+ F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
+ F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
+ F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
+ 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>"; };
+ 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>"; };
+ F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
+ F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
+ F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
+ F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
+ F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
+ F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
+ F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
+ F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
+ F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
+ F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
+ F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
+ F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
+ F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; };
+ F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
+ F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
+ F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; };
+ F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
+ F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
+ F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; };
+ F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; };
+ F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; };
+ F96D448908F272BA004A47F5 /* tclWinConsole.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinConsole.c; sourceTree = "<group>"; };
+ F96D448A08F272BA004A47F5 /* tclWinDde.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinDde.c; sourceTree = "<group>"; };
+ F96D448B08F272BA004A47F5 /* tclWinError.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinError.c; sourceTree = "<group>"; };
+ F96D448C08F272BA004A47F5 /* tclWinFCmd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFCmd.c; sourceTree = "<group>"; };
+ F96D448D08F272BA004A47F5 /* tclWinFile.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinFile.c; sourceTree = "<group>"; };
+ F96D448E08F272BA004A47F5 /* tclWinInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinInit.c; sourceTree = "<group>"; };
+ F96D448F08F272BA004A47F5 /* tclWinInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinInt.h; sourceTree = "<group>"; };
+ F96D449008F272BA004A47F5 /* tclWinLoad.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinLoad.c; sourceTree = "<group>"; };
+ F96D449108F272BA004A47F5 /* tclWinNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinNotify.c; sourceTree = "<group>"; };
+ F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = "<group>"; };
+ F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = "<group>"; };
+ F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = "<group>"; };
+ F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = "<group>"; };
+ F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = "<group>"; };
+ F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = "<group>"; };
+ F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; };
+ F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = "<group>"; };
+ F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; };
+ F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; };
+ F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; };
+ F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; };
+ F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; };
+ F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; };
+ F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; };
+ F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; };
+ F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = "<group>"; };
+ F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = "<group>"; };
+ F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = "<group>"; };
+ F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; };
+ F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; };
+ F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; };
+ F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; };
+ F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
+ F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
+ F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
+ F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = "<group>"; };
+ F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
+ F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
+ F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
+ F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
+/* End PBXFileReference section */
+
+/* Begin PBXFrameworksBuildPhase section */
+ 8DD76FAD0486AB0100D96B5E /* Frameworks */ = {
+ isa = PBXFrameworksBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */,
+ F96437E70EF0D652003F468E /* libz.dylib in Frameworks */,
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+/* End PBXFrameworksBuildPhase section */
+
+/* Begin PBXGroup section */
+ 08FB7794FE84155DC02AAC07 /* Tcl */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3DF608F27169004A47F5 /* Tcl Sources */,
+ 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\n";
+ name = Tcl;
+ path = .;
+ sourceTree = SOURCE_ROOT;
+ };
+ 1AB674ADFE9D54B511CA2CBB /* Products */ = {
+ isa = PBXGroup;
+ children = (
+ F9A3084B08F2D4CE00BAE1AB /* tclsh */,
+ 8DD76FB20486AB0100D96B5E /* tcltest */,
+ F9A3084E08F2D4F400BAE1AB /* Tcl.framework */,
+ );
+ includeInIndex = 0;
+ name = Products;
+ sourceTree = "<group>";
+ };
+ F9183E690EFC81560030B814 /* pkgs */ = {
+ isa = PBXGroup;
+ children = (
+ F9183E6A0EFC81560030B814 /* README */,
+ F946FB8B0FBE3AED00CD6495 /* itcl */,
+ F9183E8F0EFC817B0030B814 /* tdbc */,
+ );
+ path = pkgs;
+ sourceTree = "<group>";
+ };
+ F966C06F08F281DC005CB29B /* Frameworks */ = {
+ isa = PBXGroup;
+ children = (
+ F966C07408F2820D005CB29B /* CoreFoundation.framework */,
+ F96437E60EF0D652003F468E /* libz.dylib */,
+ );
+ name = Frameworks;
+ sourceTree = "<group>";
+ };
+ F96D3DF608F27169004A47F5 /* Tcl Sources */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3EC908F272A7004A47F5 /* generic */,
+ F96D432C08F272B4004A47F5 /* macosx */,
+ F96D443E08F272B9004A47F5 /* unix */,
+ F96D425C08F272B2004A47F5 /* libtommath */,
+ F96D446E08F272B9004A47F5 /* win */,
+ F96D3F3808F272A7004A47F5 /* library */,
+ F96D434408F272B5004A47F5 /* tests */,
+ F96D3DFC08F272A4004A47F5 /* doc */,
+ F96D43D008F272B8004A47F5 /* tools */,
+ F9183E690EFC81560030B814 /* pkgs */,
+ F96D3DFA08F272A4004A47F5 /* ChangeLog */,
+ F96D3DFB08F272A4004A47F5 /* changes */,
+ F96D434308F272B5004A47F5 /* README */,
+ F96D432B08F272B4004A47F5 /* license.terms */,
+ );
+ name = "Tcl Sources";
+ sourceTree = TCL_SRCROOT;
+ };
+ F96D3DFC08F272A4004A47F5 /* doc */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3DFD08F272A4004A47F5 /* Access.3 */,
+ F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */,
+ F96D3DFF08F272A4004A47F5 /* after.n */,
+ F96D3E0008F272A4004A47F5 /* Alloc.3 */,
+ F96D3E0108F272A4004A47F5 /* AllowExc.3 */,
+ F96D3E0208F272A4004A47F5 /* append.n */,
+ F96D3E0308F272A4004A47F5 /* AppInit.3 */,
+ F96D3E0408F272A5004A47F5 /* array.n */,
+ F96D3E0508F272A5004A47F5 /* AssocData.3 */,
+ F96D3E0608F272A5004A47F5 /* Async.3 */,
+ F96D3E0708F272A5004A47F5 /* BackgdErr.3 */,
+ F96D3E0808F272A5004A47F5 /* Backslash.3 */,
+ F96D3E0908F272A5004A47F5 /* bgerror.n */,
+ F96D3E0A08F272A5004A47F5 /* binary.n */,
+ F96D3E0B08F272A5004A47F5 /* BoolObj.3 */,
+ F96D3E0C08F272A5004A47F5 /* break.n */,
+ F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */,
+ F96D3E0E08F272A5004A47F5 /* CallDel.3 */,
+ F96D3E0F08F272A5004A47F5 /* case.n */,
+ F96D3E1008F272A5004A47F5 /* catch.n */,
+ F96D3E1108F272A5004A47F5 /* cd.n */,
+ F96D3E1208F272A5004A47F5 /* chan.n */,
+ F96D3E1308F272A5004A47F5 /* ChnlStack.3 */,
+ F93599CF0DF1F87F00E04F67 /* Class.3 */,
+ F93599D00DF1F89E00E04F67 /* class.n */,
+ F96D3E1408F272A5004A47F5 /* clock.n */,
+ F96D3E1508F272A5004A47F5 /* close.n */,
+ F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */,
+ F96D3E1708F272A5004A47F5 /* Concat.3 */,
+ F96D3E1808F272A5004A47F5 /* concat.n */,
+ F96D3E1908F272A5004A47F5 /* continue.n */,
+ F93599D20DF1F8DF00E04F67 /* copy.n */,
+ F974D5720FBE7DC600BF728B /* coroutine.n */,
+ F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */,
+ F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */,
+ F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */,
+ F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */,
+ F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */,
+ F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
+ F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
+ F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
+ F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
+ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
+ F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
+ F96D3E2508F272A5004A47F5 /* dde.n */,
+ F93599D30DF1F8F500E04F67 /* define.n */,
+ F96D3E2608F272A5004A47F5 /* DetachPids.3 */,
+ F96D3E2708F272A5004A47F5 /* dict.n */,
+ F96D3E2808F272A5004A47F5 /* DictObj.3 */,
+ F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */,
+ F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */,
+ F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */,
+ F96D3E2C08F272A5004A47F5 /* DString.3 */,
+ F96D3E2D08F272A5004A47F5 /* DumpActiveMemory.3 */,
+ F96D3E2E08F272A5004A47F5 /* Encoding.3 */,
+ F96D3E2F08F272A5004A47F5 /* encoding.n */,
+ F96D3E3008F272A5004A47F5 /* Ensemble.3 */,
+ F96D3E3108F272A5004A47F5 /* Environment.3 */,
+ F96D3E3208F272A5004A47F5 /* eof.n */,
+ F96D3E3308F272A5004A47F5 /* error.n */,
+ F96D3E3408F272A5004A47F5 /* Eval.3 */,
+ F96D3E3508F272A5004A47F5 /* eval.n */,
+ F96D3E3608F272A5004A47F5 /* exec.n */,
+ F96D3E3708F272A5004A47F5 /* Exit.3 */,
+ F96D3E3808F272A5004A47F5 /* exit.n */,
+ F96D3E3908F272A5004A47F5 /* expr.n */,
+ F96D3E3A08F272A5004A47F5 /* ExprLong.3 */,
+ F96D3E3B08F272A5004A47F5 /* ExprLongObj.3 */,
+ F96D3E3C08F272A5004A47F5 /* fblocked.n */,
+ F96D3E3D08F272A5004A47F5 /* fconfigure.n */,
+ F96D3E3E08F272A5004A47F5 /* fcopy.n */,
+ F96D3E3F08F272A5004A47F5 /* file.n */,
+ F96D3E4008F272A5004A47F5 /* fileevent.n */,
+ F96D3E4108F272A5004A47F5 /* filename.n */,
+ F96D3E4208F272A5004A47F5 /* FileSystem.3 */,
+ F96D3E4308F272A5004A47F5 /* FindExec.3 */,
+ F96D3E4408F272A5004A47F5 /* flush.n */,
+ F96D3E4508F272A5004A47F5 /* for.n */,
+ F96D3E4608F272A5004A47F5 /* foreach.n */,
+ F96D3E4708F272A5004A47F5 /* format.n */,
+ F96D3E4808F272A5004A47F5 /* GetCwd.3 */,
+ F96D3E4908F272A5004A47F5 /* GetHostName.3 */,
+ F96D3E4A08F272A5004A47F5 /* GetIndex.3 */,
+ F96D3E4B08F272A5004A47F5 /* GetInt.3 */,
+ F96D3E4C08F272A5004A47F5 /* GetOpnFl.3 */,
+ F96D3E4D08F272A5004A47F5 /* gets.n */,
+ F96D3E4E08F272A5004A47F5 /* GetStdChan.3 */,
+ F96D3E4F08F272A5004A47F5 /* GetTime.3 */,
+ F96D3E5008F272A5004A47F5 /* GetVersion.3 */,
+ F96D3E5108F272A5004A47F5 /* glob.n */,
+ F96D3E5208F272A6004A47F5 /* global.n */,
+ F96D3E5308F272A6004A47F5 /* Hash.3 */,
+ F96D3E5408F272A6004A47F5 /* history.n */,
+ F96D3E5508F272A6004A47F5 /* http.n */,
+ F96D3E5608F272A6004A47F5 /* if.n */,
+ F96D3E5708F272A6004A47F5 /* incr.n */,
+ F96D3E5808F272A6004A47F5 /* info.n */,
+ F96D3E5908F272A6004A47F5 /* Init.3 */,
+ F96D3E5A08F272A6004A47F5 /* InitStubs.3 */,
+ F96D3E5B08F272A6004A47F5 /* Interp.3 */,
+ F96D3E5C08F272A6004A47F5 /* interp.n */,
+ F96D3E5D08F272A6004A47F5 /* IntObj.3 */,
+ F96D3E5E08F272A6004A47F5 /* join.n */,
+ F96D3E5F08F272A6004A47F5 /* lappend.n */,
+ F96D3E6008F272A6004A47F5 /* lassign.n */,
+ F96D3E6108F272A6004A47F5 /* library.n */,
+ F96D3E6208F272A6004A47F5 /* Limit.3 */,
+ F96D3E6308F272A6004A47F5 /* lindex.n */,
+ F96D3E6408F272A6004A47F5 /* LinkVar.3 */,
+ F96D3E6508F272A6004A47F5 /* linsert.n */,
+ F96D3E6608F272A6004A47F5 /* list.n */,
+ F96D3E6708F272A6004A47F5 /* ListObj.3 */,
+ F96D3E6808F272A6004A47F5 /* llength.n */,
+ F96D3E6908F272A6004A47F5 /* load.n */,
+ F96D3E6A08F272A6004A47F5 /* lrange.n */,
+ F96D3E6B08F272A6004A47F5 /* lrepeat.n */,
+ F96D3E6C08F272A6004A47F5 /* lreplace.n */,
+ F96D3E6D08F272A6004A47F5 /* lsearch.n */,
+ F96D3E6E08F272A6004A47F5 /* lset.n */,
+ F96D3E6F08F272A6004A47F5 /* lsort.n */,
+ F96D3E7008F272A6004A47F5 /* man.macros */,
+ F96D3E7108F272A6004A47F5 /* mathfunc.n */,
+ F96D3E7208F272A6004A47F5 /* memory.n */,
+ F93599D40DF1F91900E04F67 /* Method.3 */,
+ F96D3E7308F272A6004A47F5 /* msgcat.n */,
+ F93599D50DF1F93700E04F67 /* my.n */,
+ F96D3E7408F272A6004A47F5 /* Namespace.3 */,
+ F96D3E7508F272A6004A47F5 /* namespace.n */,
+ F93599D60DF1F95000E04F67 /* next.n */,
+ F96D3E7608F272A6004A47F5 /* Notifier.3 */,
+ F96D3E7708F272A6004A47F5 /* Object.3 */,
+ F93599D70DF1F96800E04F67 /* object.n */,
+ F96D3E7808F272A6004A47F5 /* ObjectType.3 */,
+ F96D3E7908F272A6004A47F5 /* open.n */,
+ F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */,
+ F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */,
+ F96D3E7C08F272A6004A47F5 /* package.n */,
+ F96D3E7D08F272A6004A47F5 /* packagens.n */,
+ F96D3E7E08F272A6004A47F5 /* Panic.3 */,
+ F96D3E7F08F272A6004A47F5 /* ParseCmd.3 */,
+ F96D3E8008F272A6004A47F5 /* pid.n */,
+ F96D3E8108F272A6004A47F5 /* pkgMkIndex.n */,
+ F96D3E8208F272A6004A47F5 /* PkgRequire.3 */,
+ F9ECB1E10B26543C00A28025 /* platform_shell.n */,
+ F9ECB1E20B26543C00A28025 /* platform.n */,
+ F96D3E8308F272A6004A47F5 /* Preserve.3 */,
+ F96D3E8408F272A6004A47F5 /* PrintDbl.3 */,
+ F96D3E8508F272A6004A47F5 /* proc.n */,
+ F96D3E8608F272A6004A47F5 /* puts.n */,
+ F96D3E8708F272A6004A47F5 /* pwd.n */,
+ F96D3E8808F272A6004A47F5 /* re_syntax.n */,
+ F96D3E8908F272A6004A47F5 /* read.n */,
+ F96D3E8A08F272A6004A47F5 /* RecEvalObj.3 */,
+ F96D3E8B08F272A6004A47F5 /* RecordEval.3 */,
+ F96D3E8C08F272A6004A47F5 /* RegConfig.3 */,
+ F96D3E8D08F272A6004A47F5 /* RegExp.3 */,
+ F96D3E8E08F272A6004A47F5 /* regexp.n */,
+ F96D3E8F08F272A6004A47F5 /* registry.n */,
+ F96D3E9008F272A6004A47F5 /* regsub.n */,
+ F96D3E9108F272A6004A47F5 /* rename.n */,
+ F96D3E9208F272A6004A47F5 /* return.n */,
+ F96D3E9308F272A6004A47F5 /* safe.n */,
+ F96D3E9408F272A6004A47F5 /* SaveResult.3 */,
+ F96D3E9508F272A6004A47F5 /* scan.n */,
+ F96D3E9608F272A6004A47F5 /* seek.n */,
+ F93599D80DF1F98300E04F67 /* self.n */,
+ F96D3E9708F272A6004A47F5 /* set.n */,
+ F96D3E9808F272A6004A47F5 /* SetChanErr.3 */,
+ F96D3E9908F272A6004A47F5 /* SetErrno.3 */,
+ F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */,
+ F96D3E9B08F272A7004A47F5 /* SetResult.3 */,
+ F96D3E9C08F272A7004A47F5 /* SetVar.3 */,
+ F96D3E9D08F272A7004A47F5 /* Signal.3 */,
+ F96D3E9E08F272A7004A47F5 /* Sleep.3 */,
+ F96D3E9F08F272A7004A47F5 /* socket.n */,
+ F96D3EA008F272A7004A47F5 /* source.n */,
+ F96D3EA108F272A7004A47F5 /* SourceRCFile.3 */,
+ F96D3EA208F272A7004A47F5 /* split.n */,
+ F96D3EA308F272A7004A47F5 /* SplitList.3 */,
+ F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
+ F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
+ F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
+ F96D3EA708F272A7004A47F5 /* string.n */,
+ F96D3EA808F272A7004A47F5 /* StringObj.3 */,
+ F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
+ F96D3EAA08F272A7004A47F5 /* subst.n */,
+ F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
+ F96D3EAC08F272A7004A47F5 /* switch.n */,
+ F974D5760FBE7E1900BF728B /* tailcall.n */,
+ F96D3EAD08F272A7004A47F5 /* Tcl.n */,
+ F99D61180EF5573A00BBFE01 /* TclZlib.3 */,
+ F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */,
+ F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */,
+ F96D3EB008F272A7004A47F5 /* tclsh.1 */,
+ F96D3EB108F272A7004A47F5 /* tcltest.n */,
+ F96D3EB208F272A7004A47F5 /* tclvars.n */,
+ F96D3EB308F272A7004A47F5 /* tell.n */,
+ F96D3EB408F272A7004A47F5 /* Thread.3 */,
+ F9183E640EFC80CD0030B814 /* throw.n */,
+ F96D3EB508F272A7004A47F5 /* time.n */,
+ F96D3EB608F272A7004A47F5 /* tm.n */,
+ F96D3EB708F272A7004A47F5 /* ToUpper.3 */,
+ F96D3EB808F272A7004A47F5 /* trace.n */,
+ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */,
+ F96D3EBA08F272A7004A47F5 /* TraceVar.3 */,
+ F96D3EBB08F272A7004A47F5 /* Translate.3 */,
+ F9183E650EFC80D70030B814 /* try.n */,
+ F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */,
+ F96D3EBD08F272A7004A47F5 /* unknown.n */,
+ F96D3EBE08F272A7004A47F5 /* unload.n */,
+ F96D3EBF08F272A7004A47F5 /* unset.n */,
+ F96D3EC008F272A7004A47F5 /* update.n */,
+ F96D3EC108F272A7004A47F5 /* uplevel.n */,
+ F96D3EC208F272A7004A47F5 /* UpVar.3 */,
+ F96D3EC308F272A7004A47F5 /* upvar.n */,
+ F96D3EC408F272A7004A47F5 /* Utf.3 */,
+ F96D3EC508F272A7004A47F5 /* variable.n */,
+ F96D3EC608F272A7004A47F5 /* vwait.n */,
+ F96D3EC708F272A7004A47F5 /* while.n */,
+ F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */,
+ F915432D0EF201EE0032D1E8 /* zlib.n */,
+ );
+ path = doc;
+ sourceTree = "<group>";
+ };
+ F96D3EC908F272A7004A47F5 /* generic */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3ECA08F272A7004A47F5 /* README */,
+ F96D3ECB08F272A7004A47F5 /* regc_color.c */,
+ F96D3ECC08F272A7004A47F5 /* regc_cvec.c */,
+ F96D3ECD08F272A7004A47F5 /* regc_lex.c */,
+ F96D3ECE08F272A7004A47F5 /* regc_locale.c */,
+ F96D3ECF08F272A7004A47F5 /* regc_nfa.c */,
+ F96D3ED008F272A7004A47F5 /* regcomp.c */,
+ F96D3ED108F272A7004A47F5 /* regcustom.h */,
+ F96D3ED208F272A7004A47F5 /* rege_dfa.c */,
+ F96D3ED308F272A7004A47F5 /* regerror.c */,
+ F96D3ED408F272A7004A47F5 /* regerrs.h */,
+ F96D3ED508F272A7004A47F5 /* regex.h */,
+ F96D3ED608F272A7004A47F5 /* regexec.c */,
+ F96D3ED708F272A7004A47F5 /* regfree.c */,
+ F96D3ED808F272A7004A47F5 /* regfronts.c */,
+ F96D3ED908F272A7004A47F5 /* regguts.h */,
+ F96D3EDA08F272A7004A47F5 /* tcl.decls */,
+ F96D3EDB08F272A7004A47F5 /* tcl.h */,
+ F96D3EDC08F272A7004A47F5 /* tclAlloc.c */,
+ F96D3EDD08F272A7004A47F5 /* tclAsync.c */,
+ F96D3EDE08F272A7004A47F5 /* tclBasic.c */,
+ F96D3EDF08F272A7004A47F5 /* tclBinary.c */,
+ F96D3EE008F272A7004A47F5 /* tclCkalloc.c */,
+ F96D3EE108F272A7004A47F5 /* tclClock.c */,
+ F96D3EE208F272A7004A47F5 /* tclCmdAH.c */,
+ F96D3EE308F272A7004A47F5 /* tclCmdIL.c */,
+ F96D3EE408F272A7004A47F5 /* tclCmdMZ.c */,
+ F96D3EE508F272A7004A47F5 /* tclCompCmds.c */,
+ F96D3EE608F272A7004A47F5 /* tclCompExpr.c */,
+ F96D3EE708F272A7004A47F5 /* tclCompile.c */,
+ F96D3EE808F272A7004A47F5 /* tclCompile.h */,
+ F96D3EE908F272A7004A47F5 /* tclConfig.c */,
+ F96D3EEA08F272A7004A47F5 /* tclDate.c */,
+ F96D3EEB08F272A7004A47F5 /* tclDecls.h */,
+ F96D3EEC08F272A7004A47F5 /* tclDictObj.c */,
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */,
+ F96D3EED08F272A7004A47F5 /* tclEncoding.c */,
+ F96D3EEE08F272A7004A47F5 /* tclEnv.c */,
+ F96D3EEF08F272A7004A47F5 /* tclEvent.c */,
+ F96D3EF008F272A7004A47F5 /* tclExecute.c */,
+ F96D3EF108F272A7004A47F5 /* tclFCmd.c */,
+ F96D3EF208F272A7004A47F5 /* tclFileName.c */,
+ F96D3EF308F272A7004A47F5 /* tclFileSystem.h */,
+ F96D3EF408F272A7004A47F5 /* tclGet.c */,
+ F96D3EF508F272A7004A47F5 /* tclGetDate.y */,
+ F96D3EF608F272A7004A47F5 /* tclHash.c */,
+ F96D3EF708F272A7004A47F5 /* tclHistory.c */,
+ F96D3EF808F272A7004A47F5 /* tclIndexObj.c */,
+ F96D3EF908F272A7004A47F5 /* tclInt.decls */,
+ F96D3EFA08F272A7004A47F5 /* tclInt.h */,
+ F96D3EFB08F272A7004A47F5 /* tclIntDecls.h */,
+ F96D3EFC08F272A7004A47F5 /* tclInterp.c */,
+ F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */,
+ F96D3EFE08F272A7004A47F5 /* tclIO.c */,
+ F96D3EFF08F272A7004A47F5 /* tclIO.h */,
+ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */,
+ F96D3F0108F272A7004A47F5 /* tclIOGT.c */,
+ F96D3F0208F272A7004A47F5 /* tclIORChan.c */,
+ F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */,
+ F96D3F0308F272A7004A47F5 /* tclIOSock.c */,
+ F96D3F0408F272A7004A47F5 /* tclIOUtil.c */,
+ F96D3F0508F272A7004A47F5 /* tclLink.c */,
+ F96D3F0608F272A7004A47F5 /* tclListObj.c */,
+ F96D3F0708F272A7004A47F5 /* tclLiteral.c */,
+ F96D3F0808F272A7004A47F5 /* tclLoad.c */,
+ F96D3F0908F272A7004A47F5 /* tclLoadNone.c */,
+ F96D3F0A08F272A7004A47F5 /* tclMain.c */,
+ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */,
+ F96D3F0C08F272A7004A47F5 /* tclNotify.c */,
+ F96D3F0D08F272A7004A47F5 /* tclObj.c */,
+ F93599B20DF1F75400E04F67 /* tclOO.c */,
+ F93599B40DF1F75900E04F67 /* tclOO.decls */,
+ F93599B50DF1F75D00E04F67 /* tclOO.h */,
+ F93599B60DF1F76100E04F67 /* tclOOBasic.c */,
+ F93599B80DF1F76600E04F67 /* tclOOCall.c */,
+ F93599BA0DF1F76A00E04F67 /* tclOODecls.h */,
+ F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */,
+ F93599BD0DF1F77400E04F67 /* tclOOInfo.c */,
+ F93599BF0DF1F77900E04F67 /* tclOOInt.h */,
+ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */,
+ F93599C10DF1F78300E04F67 /* tclOOMethod.c */,
+ F93599C30DF1F78800E04F67 /* tclOOStubInit.c */,
+ F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */,
+ F96D3F0E08F272A7004A47F5 /* tclPanic.c */,
+ F96D3F0F08F272A7004A47F5 /* tclParse.c */,
+ F96D3F1108F272A7004A47F5 /* tclPathObj.c */,
+ F96D3F1208F272A7004A47F5 /* tclPipe.c */,
+ F96D3F1308F272A7004A47F5 /* tclPkg.c */,
+ F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */,
+ F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */,
+ F96D3F1608F272A7004A47F5 /* tclPort.h */,
+ F96D3F1708F272A7004A47F5 /* tclPosixStr.c */,
+ F96D3F1808F272A7004A47F5 /* tclPreserve.c */,
+ F96D3F1908F272A7004A47F5 /* tclProc.c */,
+ F96D3F1A08F272A7004A47F5 /* tclRegexp.c */,
+ F96D3F1B08F272A7004A47F5 /* tclRegexp.h */,
+ F96D3F1C08F272A7004A47F5 /* tclResolve.c */,
+ F96D3F1D08F272A7004A47F5 /* tclResult.c */,
+ F96D3F1E08F272A7004A47F5 /* tclScan.c */,
+ F96D3F1F08F272A7004A47F5 /* tclStringObj.c */,
+ F96D3F2408F272A7004A47F5 /* tclStrToD.c */,
+ F96D3F2508F272A7004A47F5 /* tclStubInit.c */,
+ F96D3F2608F272A7004A47F5 /* tclStubLib.c */,
+ F96D3F2708F272A7004A47F5 /* tclTest.c */,
+ F96D3F2808F272A7004A47F5 /* tclTestObj.c */,
+ F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */,
+ F96D3F2A08F272A7004A47F5 /* tclThread.c */,
+ F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */,
+ F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */,
+ F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */,
+ F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */,
+ F96D3F2F08F272A7004A47F5 /* tclTimer.c */,
+ F9903CAF094FAADA004613E9 /* tclTomMath.decls */,
+ F96D3F3008F272A7004A47F5 /* tclTomMath.h */,
+ F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */,
+ F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */,
+ F96D3F3208F272A7004A47F5 /* tclTrace.c */,
+ F96D3F3308F272A7004A47F5 /* tclUniData.c */,
+ F96D3F3408F272A7004A47F5 /* tclUtf.c */,
+ F96D3F3508F272A7004A47F5 /* tclUtil.c */,
+ F96D3F3608F272A7004A47F5 /* tclVar.c */,
+ F96437C90EF0D4B2003F468E /* tclZlib.c */,
+ F96D3F3708F272A7004A47F5 /* tommath.h */,
+ );
+ path = generic;
+ sourceTree = "<group>";
+ };
+ F96D3F3808F272A7004A47F5 /* library */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F3908F272A8004A47F5 /* auto.tcl */,
+ F96D3F3A08F272A8004A47F5 /* clock.tcl */,
+ F96D3F3B08F272A8004A47F5 /* dde */,
+ F96D3F8C08F272A8004A47F5 /* history.tcl */,
+ F96D3F8D08F272A8004A47F5 /* http */,
+ F96D3F9008F272A8004A47F5 /* http1.0 */,
+ F96D3F9308F272A8004A47F5 /* init.tcl */,
+ F96D3F9408F272A8004A47F5 /* msgcat */,
+ F96D401708F272AA004A47F5 /* opt */,
+ F96D401A08F272AA004A47F5 /* package.tcl */,
+ F96D401B08F272AA004A47F5 /* parray.tcl */,
+ F9ECB1110B26521500A28025 /* platform */,
+ F96D401C08F272AA004A47F5 /* reg */,
+ F96D401E08F272AA004A47F5 /* safe.tcl */,
+ F96D401F08F272AA004A47F5 /* tclIndex */,
+ F96D402008F272AA004A47F5 /* tcltest */,
+ F96D402308F272AA004A47F5 /* tm.tcl */,
+ F96D425B08F272B2004A47F5 /* word.tcl */,
+ );
+ path = library;
+ sourceTree = "<group>";
+ };
+ F96D3F3B08F272A8004A47F5 /* dde */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = dde;
+ sourceTree = "<group>";
+ };
+ F96D3F8D08F272A8004A47F5 /* http */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F8E08F272A8004A47F5 /* http.tcl */,
+ F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = http;
+ sourceTree = "<group>";
+ };
+ F96D3F9008F272A8004A47F5 /* http1.0 */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F9108F272A8004A47F5 /* http.tcl */,
+ F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = http1.0;
+ sourceTree = "<group>";
+ };
+ F96D3F9408F272A8004A47F5 /* msgcat */ = {
+ isa = PBXGroup;
+ children = (
+ F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
+ F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
+ );
+ path = msgcat;
+ sourceTree = "<group>";
+ };
+ F96D401708F272AA004A47F5 /* opt */ = {
+ isa = PBXGroup;
+ children = (
+ F96D401808F272AA004A47F5 /* optparse.tcl */,
+ F96D401908F272AA004A47F5 /* pkgIndex.tcl */,
+ );
+ path = opt;
+ sourceTree = "<group>";
+ };
+ F96D401C08F272AA004A47F5 /* reg */ = {
+ isa = PBXGroup;
+ children = (
+ F96D401D08F272AA004A47F5 /* pkgIndex.tcl */,
+ );
+ path = reg;
+ sourceTree = "<group>";
+ };
+ F96D402008F272AA004A47F5 /* tcltest */ = {
+ isa = PBXGroup;
+ children = (
+ F96D402108F272AA004A47F5 /* pkgIndex.tcl */,
+ F96D402208F272AA004A47F5 /* tcltest.tcl */,
+ );
+ path = tcltest;
+ sourceTree = "<group>";
+ };
+ F96D425C08F272B2004A47F5 /* libtommath */ = {
+ isa = PBXGroup;
+ children = (
+ F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */,
+ F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */,
+ F96D426908F272B3004A47F5 /* bn_mp_add.c */,
+ F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */,
+ F96D426C08F272B3004A47F5 /* bn_mp_and.c */,
+ F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */,
+ F96D426E08F272B3004A47F5 /* bn_mp_clear.c */,
+ F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */,
+ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */,
+ F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */,
+ F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */,
+ F96D427408F272B3004A47F5 /* bn_mp_copy.c */,
+ F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */,
+ F96D427608F272B3004A47F5 /* bn_mp_div.c */,
+ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */,
+ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */,
+ F96D427908F272B3004A47F5 /* bn_mp_div_3.c */,
+ F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
+ F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
+ F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
+ F96D428808F272B3004A47F5 /* bn_mp_init.c */,
+ F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
+ F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */,
+ F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */,
+ F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */,
+ F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */,
+ F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */,
+ F96D429508F272B3004A47F5 /* bn_mp_lshd.c */,
+ F96D429608F272B3004A47F5 /* bn_mp_mod.c */,
+ F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */,
+ F96D429C08F272B3004A47F5 /* bn_mp_mul.c */,
+ F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */,
+ F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */,
+ F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */,
+ F96D42A208F272B3004A47F5 /* bn_mp_neg.c */,
+ F96D42A308F272B3004A47F5 /* bn_mp_or.c */,
+ F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */,
+ F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */,
+ F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */,
+ F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */,
+ F96D42BA08F272B3004A47F5 /* bn_mp_set.c */,
+ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */,
+ F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */,
+ F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */,
+ F96D42C108F272B3004A47F5 /* bn_mp_sub.c */,
+ F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */,
+ F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */,
+ F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */,
+ F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */,
+ F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */,
+ F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */,
+ F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */,
+ F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */,
+ F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */,
+ F96D42D008F272B3004A47F5 /* bn_reverse.c */,
+ F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */,
+ F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */,
+ F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */,
+ F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */,
+ F96D42D708F272B3004A47F5 /* bncore.c */,
+ F96D432908F272B4004A47F5 /* tommath_class.h */,
+ F96D432A08F272B4004A47F5 /* tommath_superclass.h */,
+ );
+ path = libtommath;
+ sourceTree = "<group>";
+ };
+ F96D432C08F272B4004A47F5 /* macosx */ = {
+ isa = PBXGroup;
+ children = (
+ F96D432E08F272B5004A47F5 /* configure.ac */,
+ F96D432F08F272B5004A47F5 /* GNUmakefile */,
+ F96D433108F272B5004A47F5 /* README */,
+ F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */,
+ F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */,
+ F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */,
+ F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */,
+ F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */,
+ F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */,
+ F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */,
+ F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */,
+ );
+ path = macosx;
+ sourceTree = "<group>";
+ };
+ F96D434408F272B5004A47F5 /* tests */ = {
+ isa = PBXGroup;
+ children = (
+ F96D434508F272B5004A47F5 /* all.tcl */,
+ F96D434608F272B5004A47F5 /* append.test */,
+ F96D434708F272B5004A47F5 /* appendComp.test */,
+ F9ECB1CA0B2652D300A28025 /* apply.test */,
+ F96D434808F272B5004A47F5 /* assocd.test */,
+ F96D434908F272B5004A47F5 /* async.test */,
+ F96D434A08F272B5004A47F5 /* autoMkindex.test */,
+ F96D434B08F272B5004A47F5 /* basic.test */,
+ F96D434C08F272B5004A47F5 /* binary.test */,
+ F96D434D08F272B5004A47F5 /* case.test */,
+ F96D434E08F272B5004A47F5 /* chan.test */,
+ F9A493240CEBF38300B78AE2 /* chanio.test */,
+ F96D434F08F272B5004A47F5 /* clock.test */,
+ F96D435008F272B5004A47F5 /* cmdAH.test */,
+ F96D435108F272B5004A47F5 /* cmdIL.test */,
+ F96D435208F272B5004A47F5 /* cmdInfo.test */,
+ F96D435308F272B5004A47F5 /* cmdMZ.test */,
+ F96D435408F272B5004A47F5 /* compExpr-old.test */,
+ F96D435508F272B5004A47F5 /* compExpr.test */,
+ F96D435608F272B5004A47F5 /* compile.test */,
+ F96D435708F272B5004A47F5 /* concat.test */,
+ F96D435808F272B5004A47F5 /* config.test */,
+ F974D5770FBE7E6100BF728B /* coroutine.test */,
+ F96D435908F272B5004A47F5 /* dcall.test */,
+ F96D435A08F272B5004A47F5 /* dict.test */,
+ F96D435C08F272B5004A47F5 /* dstring.test */,
+ F96D435E08F272B5004A47F5 /* encoding.test */,
+ F96D435F08F272B5004A47F5 /* env.test */,
+ F96D436008F272B5004A47F5 /* error.test */,
+ F96D436108F272B5004A47F5 /* eval.test */,
+ F96D436208F272B5004A47F5 /* event.test */,
+ F96D436308F272B5004A47F5 /* exec.test */,
+ F96D436408F272B5004A47F5 /* execute.test */,
+ F96D436508F272B5004A47F5 /* expr-old.test */,
+ F96D436608F272B5004A47F5 /* expr.test */,
+ F96D436708F272B6004A47F5 /* fCmd.test */,
+ F96D436808F272B6004A47F5 /* fileName.test */,
+ F96D436908F272B6004A47F5 /* fileSystem.test */,
+ F96D436A08F272B6004A47F5 /* for-old.test */,
+ F96D436B08F272B6004A47F5 /* for.test */,
+ F96D436C08F272B6004A47F5 /* foreach.test */,
+ F96D436D08F272B6004A47F5 /* format.test */,
+ F96D436E08F272B6004A47F5 /* get.test */,
+ F96D436F08F272B6004A47F5 /* history.test */,
+ F96D437008F272B6004A47F5 /* http.test */,
+ F974D56C0FBE7D6300BF728B /* http11.test */,
+ F96D437108F272B6004A47F5 /* httpd */,
+ F974D56D0FBE7D6300BF728B /* httpd11.tcl */,
+ F96D437208F272B6004A47F5 /* httpold.test */,
+ F96D437308F272B6004A47F5 /* if-old.test */,
+ F96D437408F272B6004A47F5 /* if.test */,
+ F96D437508F272B6004A47F5 /* incr-old.test */,
+ F96D437608F272B6004A47F5 /* incr.test */,
+ F96D437708F272B6004A47F5 /* indexObj.test */,
+ F96D437808F272B6004A47F5 /* info.test */,
+ F96D437908F272B6004A47F5 /* init.test */,
+ F96D437A08F272B6004A47F5 /* interp.test */,
+ F96D437B08F272B6004A47F5 /* io.test */,
+ F96D437C08F272B6004A47F5 /* ioCmd.test */,
+ F96D437D08F272B6004A47F5 /* iogt.test */,
+ F96D437F08F272B6004A47F5 /* join.test */,
+ F96D438008F272B6004A47F5 /* lindex.test */,
+ F96D438108F272B6004A47F5 /* link.test */,
+ F96D438208F272B6004A47F5 /* linsert.test */,
+ F96D438308F272B6004A47F5 /* list.test */,
+ F96D438408F272B6004A47F5 /* listObj.test */,
+ F96D438508F272B6004A47F5 /* llength.test */,
+ F96D438608F272B6004A47F5 /* load.test */,
+ F96D438708F272B6004A47F5 /* lrange.test */,
+ F96D438808F272B6004A47F5 /* lrepeat.test */,
+ F96D438908F272B6004A47F5 /* lreplace.test */,
+ F96D438A08F272B6004A47F5 /* lsearch.test */,
+ F96D438B08F272B6004A47F5 /* lset.test */,
+ F96D438C08F272B6004A47F5 /* lsetComp.test */,
+ F96D438D08F272B6004A47F5 /* macOSXFCmd.test */,
+ F95FAFF90B34F1130072E431 /* macOSXLoad.test */,
+ F96D438E08F272B6004A47F5 /* main.test */,
+ F9ECB1CB0B26534C00A28025 /* mathop.test */,
+ F96D438F08F272B6004A47F5 /* misc.test */,
+ F96D439008F272B6004A47F5 /* msgcat.test */,
+ F96D439108F272B6004A47F5 /* namespace-old.test */,
+ F96D439208F272B7004A47F5 /* namespace.test */,
+ F96D439308F272B7004A47F5 /* notify.test */,
+ F91DC23C0E44C51B002CB8D1 /* nre.test */,
+ F96D439408F272B7004A47F5 /* obj.test */,
+ F93599C80DF1F81900E04F67 /* oo.test */,
+ F96D439508F272B7004A47F5 /* opt.test */,
+ F96D439608F272B7004A47F5 /* package.test */,
+ F96D439708F272B7004A47F5 /* parse.test */,
+ F96D439808F272B7004A47F5 /* parseExpr.test */,
+ F96D439908F272B7004A47F5 /* parseOld.test */,
+ F96D439A08F272B7004A47F5 /* pid.test */,
+ F96D439B08F272B7004A47F5 /* pkg.test */,
+ F96D439C08F272B7004A47F5 /* pkgMkIndex.test */,
+ F96D439D08F272B7004A47F5 /* platform.test */,
+ F96D439E08F272B7004A47F5 /* proc-old.test */,
+ F96D439F08F272B7004A47F5 /* proc.test */,
+ F96D43A008F272B7004A47F5 /* pwd.test */,
+ F96D43A108F272B7004A47F5 /* README */,
+ F96D43A208F272B7004A47F5 /* reg.test */,
+ F96D43A308F272B7004A47F5 /* regexp.test */,
+ F96D43A408F272B7004A47F5 /* regexpComp.test */,
+ F96D43A508F272B7004A47F5 /* registry.test */,
+ F96D43A608F272B7004A47F5 /* remote.tcl */,
+ F96D43A708F272B7004A47F5 /* rename.test */,
+ F96D43A808F272B7004A47F5 /* result.test */,
+ F96D43A908F272B7004A47F5 /* safe.test */,
+ F96D43AA08F272B7004A47F5 /* scan.test */,
+ F96D43AB08F272B7004A47F5 /* security.test */,
+ F96D43AC08F272B7004A47F5 /* set-old.test */,
+ F96D43AD08F272B7004A47F5 /* set.test */,
+ F96D43AE08F272B7004A47F5 /* socket.test */,
+ F96D43AF08F272B7004A47F5 /* source.test */,
+ F96D43B008F272B7004A47F5 /* split.test */,
+ F96D43B108F272B7004A47F5 /* stack.test */,
+ F96D43B208F272B7004A47F5 /* string.test */,
+ F96D43B308F272B7004A47F5 /* stringComp.test */,
+ F96D43B408F272B7004A47F5 /* stringObj.test */,
+ F96D43B508F272B7004A47F5 /* subst.test */,
+ F96D43B608F272B7004A47F5 /* switch.test */,
+ F974D5780FBE7E6100BF728B /* tailcall.test */,
+ F96D43B708F272B7004A47F5 /* tcltest.test */,
+ F96D43B808F272B7004A47F5 /* thread.test */,
+ F96D43B908F272B7004A47F5 /* timer.test */,
+ F96D43BA08F272B7004A47F5 /* tm.test */,
+ F96D43BB08F272B7004A47F5 /* trace.test */,
+ F96D43BC08F272B7004A47F5 /* unixFCmd.test */,
+ F96D43BD08F272B7004A47F5 /* unixFile.test */,
+ F96D43BE08F272B7004A47F5 /* unixInit.test */,
+ F96D43BF08F272B7004A47F5 /* unixNotfy.test */,
+ F96D43C008F272B7004A47F5 /* unknown.test */,
+ F96D43C108F272B7004A47F5 /* unload.test */,
+ F96D43C208F272B7004A47F5 /* uplevel.test */,
+ F96D43C308F272B7004A47F5 /* upvar.test */,
+ F96D43C408F272B7004A47F5 /* utf.test */,
+ F96D43C508F272B7004A47F5 /* util.test */,
+ F96D43C608F272B7004A47F5 /* var.test */,
+ F96D43C708F272B7004A47F5 /* while-old.test */,
+ F96D43C808F272B7004A47F5 /* while.test */,
+ F96D43C908F272B7004A47F5 /* winConsole.test */,
+ F96D43CA08F272B7004A47F5 /* winDde.test */,
+ F96D43CB08F272B7004A47F5 /* winFCmd.test */,
+ F96D43CC08F272B7004A47F5 /* winFile.test */,
+ F96D43CD08F272B7004A47F5 /* winNotify.test */,
+ F96D43CE08F272B7004A47F5 /* winPipe.test */,
+ F96D43CF08F272B7004A47F5 /* winTime.test */,
+ F915432A0EF201CF0032D1E8 /* zlib.test */,
+ );
+ path = tests;
+ sourceTree = "<group>";
+ };
+ F96D43D008F272B8004A47F5 /* tools */ = {
+ isa = PBXGroup;
+ children = (
+ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
+ F96D43D208F272B8004A47F5 /* configure */,
+ F96D43D308F272B8004A47F5 /* configure.in */,
+ F96D442208F272B8004A47F5 /* eolFix.tcl */,
+ F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
+ F96D442508F272B8004A47F5 /* genStubs.tcl */,
+ F96D442708F272B8004A47F5 /* index.tcl */,
+ F96D442808F272B8004A47F5 /* installData.tcl */,
+ F96D442908F272B8004A47F5 /* loadICU.tcl */,
+ F96D442A08F272B8004A47F5 /* Makefile.in */,
+ F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
+ F96D442C08F272B8004A47F5 /* man2help.tcl */,
+ F96D442D08F272B8004A47F5 /* man2help2.tcl */,
+ F96D442E08F272B8004A47F5 /* man2html.tcl */,
+ F96D442F08F272B8004A47F5 /* man2html1.tcl */,
+ F96D443008F272B8004A47F5 /* man2html2.tcl */,
+ F96D443108F272B8004A47F5 /* man2tcl.c */,
+ F96D443208F272B8004A47F5 /* README */,
+ F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
+ F96D443508F272B8004A47F5 /* tcl.hpj.in */,
+ F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
+ F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
+ F92D7F100DE777240033A13A /* tsdPerf.tcl */,
+ F96D443B08F272B9004A47F5 /* uniClass.tcl */,
+ F96D443C08F272B9004A47F5 /* uniParse.tcl */,
+ );
+ path = tools;
+ sourceTree = "<group>";
+ };
+ F96D443E08F272B9004A47F5 /* unix */ = {
+ isa = PBXGroup;
+ children = (
+ F96D444008F272B9004A47F5 /* aclocal.m4 */,
+ F96D444108F272B9004A47F5 /* configure */,
+ F96D444208F272B9004A47F5 /* configure.in */,
+ F96D444308F272B9004A47F5 /* dltest */,
+ F96D444D08F272B9004A47F5 /* install-sh */,
+ F96D444E08F272B9004A47F5 /* installManPage */,
+ F96D444F08F272B9004A47F5 /* ldAix */,
+ F96D445008F272B9004A47F5 /* Makefile.in */,
+ F96D445208F272B9004A47F5 /* README */,
+ F96D445308F272B9004A47F5 /* tcl.m4 */,
+ F974D5790FBE7E9C00BF728B /* tcl.pc.in */,
+ F96D445408F272B9004A47F5 /* tcl.spec */,
+ F96D445508F272B9004A47F5 /* tclAppInit.c */,
+ F96D445608F272B9004A47F5 /* tclConfig.h.in */,
+ F96D445708F272B9004A47F5 /* tclConfig.sh.in */,
+ F96D445808F272B9004A47F5 /* tclLoadAix.c */,
+ F96D445908F272B9004A47F5 /* tclLoadDl.c */,
+ F96D445B08F272B9004A47F5 /* tclLoadDyld.c */,
+ F96D445C08F272B9004A47F5 /* tclLoadNext.c */,
+ F96D445D08F272B9004A47F5 /* tclLoadOSF.c */,
+ F96D445E08F272B9004A47F5 /* tclLoadShl.c */,
+ F96D445F08F272B9004A47F5 /* tclUnixChan.c */,
+ F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */,
+ F96D446008F272B9004A47F5 /* tclUnixEvent.c */,
+ F96D446108F272B9004A47F5 /* tclUnixFCmd.c */,
+ F96D446208F272B9004A47F5 /* tclUnixFile.c */,
+ F96D446308F272B9004A47F5 /* tclUnixInit.c */,
+ F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
+ F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
+ F96D446608F272B9004A47F5 /* tclUnixPort.h */,
+ F96D446708F272B9004A47F5 /* tclUnixSock.c */,
+ F96D446808F272B9004A47F5 /* tclUnixTest.c */,
+ F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
+ F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
+ F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
+ F96D446D08F272B9004A47F5 /* tclXtTest.c */,
+ );
+ path = unix;
+ sourceTree = "<group>";
+ };
+ F96D444308F272B9004A47F5 /* dltest */ = {
+ isa = PBXGroup;
+ children = (
+ F96D444408F272B9004A47F5 /* Makefile.in */,
+ F96D444508F272B9004A47F5 /* pkga.c */,
+ F96D444608F272B9004A47F5 /* pkgb.c */,
+ F96D444708F272B9004A47F5 /* pkgc.c */,
+ F96D444808F272B9004A47F5 /* pkgd.c */,
+ F96D444908F272B9004A47F5 /* pkge.c */,
+ F96D444B08F272B9004A47F5 /* pkgua.c */,
+ F96D444C08F272B9004A47F5 /* README */,
+ );
+ path = dltest;
+ sourceTree = "<group>";
+ };
+ F96D446E08F272B9004A47F5 /* win */ = {
+ isa = PBXGroup;
+ children = (
+ F96D447008F272BA004A47F5 /* aclocal.m4 */,
+ F96D447108F272BA004A47F5 /* buildall.vc.bat */,
+ F96D447208F272BA004A47F5 /* cat.c */,
+ F96D447308F272BA004A47F5 /* coffbase.txt */,
+ F96D447408F272BA004A47F5 /* configure */,
+ F96D447508F272BA004A47F5 /* configure.in */,
+ F96D447608F272BA004A47F5 /* makefile.bc */,
+ F96D447708F272BA004A47F5 /* Makefile.in */,
+ F96D447808F272BA004A47F5 /* makefile.vc */,
+ F96D447908F272BA004A47F5 /* nmakehlp.c */,
+ F96D447A08F272BA004A47F5 /* README */,
+ F96D447C08F272BA004A47F5 /* rules.vc */,
+ F96D447D08F272BA004A47F5 /* stub16.c */,
+ F96D447E08F272BA004A47F5 /* tcl.dsp */,
+ F96D447F08F272BA004A47F5 /* tcl.dsw */,
+ F96D448008F272BA004A47F5 /* tcl.hpj.in */,
+ F96D448108F272BA004A47F5 /* tcl.m4 */,
+ F96D448208F272BA004A47F5 /* tcl.rc */,
+ F96D448308F272BA004A47F5 /* tclAppInit.c */,
+ F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
+ F96D448608F272BA004A47F5 /* tclsh.rc */,
+ F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
+ F96D448808F272BA004A47F5 /* tclWinChan.c */,
+ F96D448908F272BA004A47F5 /* tclWinConsole.c */,
+ F96D448A08F272BA004A47F5 /* tclWinDde.c */,
+ F96D448B08F272BA004A47F5 /* tclWinError.c */,
+ F96D448C08F272BA004A47F5 /* tclWinFCmd.c */,
+ F96D448D08F272BA004A47F5 /* tclWinFile.c */,
+ F96D448E08F272BA004A47F5 /* tclWinInit.c */,
+ F96D448F08F272BA004A47F5 /* tclWinInt.h */,
+ F96D449008F272BA004A47F5 /* tclWinLoad.c */,
+ F96D449108F272BA004A47F5 /* tclWinNotify.c */,
+ F96D449208F272BA004A47F5 /* tclWinPipe.c */,
+ F96D449308F272BA004A47F5 /* tclWinPort.h */,
+ F96D449408F272BA004A47F5 /* tclWinReg.c */,
+ F96D449508F272BA004A47F5 /* tclWinSerial.c */,
+ F96D449608F272BA004A47F5 /* tclWinSock.c */,
+ F96D449708F272BA004A47F5 /* tclWinTest.c */,
+ F96D449808F272BA004A47F5 /* tclWinThrd.c */,
+ F96D449908F272BA004A47F5 /* tclWinThrd.h */,
+ F96D449A08F272BA004A47F5 /* tclWinTime.c */,
+ );
+ path = win;
+ sourceTree = "<group>";
+ };
+ F9ECB1110B26521500A28025 /* platform */ = {
+ isa = PBXGroup;
+ children = (
+ F9ECB1120B26521500A28025 /* pkgIndex.tcl */,
+ F9ECB1130B26521500A28025 /* platform.tcl */,
+ F9ECB1140B26521500A28025 /* shell.tcl */,
+ );
+ path = platform;
+ sourceTree = "<group>";
+ };
+/* End PBXGroup section */
+
+/* Begin PBXNativeTarget section */
+ 8DD76FA90486AB0100D96B5E /* tcltest */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */;
+ buildPhases = (
+ F9A5C5F508F651A2008AE941 /* Configure Tcl */,
+ 8DD76FAB0486AB0100D96B5E /* Sources */,
+ 8DD76FAD0486AB0100D96B5E /* Frameworks */,
+ F95FA74C0B32CE190072E431 /* Build dltest */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ );
+ name = tcltest;
+ productInstallPath = "$(BINDIR)";
+ productName = tcltest;
+ productReference = 8DD76FB20486AB0100D96B5E /* tcltest */;
+ productType = "com.apple.product-type.tool";
+ };
+ F97258A50A86873C00096C78 /* tests */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */;
+ buildPhases = (
+ F97258A40A86873C00096C78 /* Run Testsuite */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ F97258D30A868C6F00096C78 /* PBXTargetDependency */,
+ );
+ name = tests;
+ productName = tests;
+ productType = "com.apple.product-type.bundle";
+ };
+ F9E61D16090A3E94002B3151 /* Tcl */ = {
+ isa = PBXNativeTarget;
+ buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */;
+ buildPhases = (
+ F97AF02F0B665DA900310EA2 /* Build Tcl */,
+ );
+ buildRules = (
+ );
+ dependencies = (
+ );
+ name = Tcl;
+ productName = tclsh;
+ productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */;
+ productType = "com.apple.product-type.tool";
+ };
+/* End PBXNativeTarget section */
+
+/* Begin PBXProject section */
+ 08FB7793FE84155DC02AAC07 /* Project object */ = {
+ isa = PBXProject;
+ attributes = {
+ BuildIndependentTargetsInParallel = YES;
+ };
+ buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */;
+ compatibilityVersion = "Xcode 3.2";
+ hasScannedForEncodings = 1;
+ mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */;
+ projectDirPath = "";
+ projectRoot = ..;
+ targets = (
+ F9E61D16090A3E94002B3151 /* Tcl */,
+ 8DD76FA90486AB0100D96B5E /* tcltest */,
+ F97258A50A86873C00096C78 /* tests */,
+ );
+ };
+/* End PBXProject section */
+
+/* Begin PBXShellScriptBuildPhase section */
+ F95FA74C0B32CE190072E431 /* Build dltest */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
+ "$(TCL_SRCROOT)/generic/tclStubLib.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkga.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgb.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgc.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgd.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkge.c",
+ "$(TCL_SRCROOT)/unix/dltest/pkgua.c",
+ );
+ name = "Build dltest";
+ outputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/dltest.marker",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n";
+ showEnvVarsInLog = 0;
+ };
+ F97258A40A86873C00096C78 /* Run Testsuite */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ name = "Run Testsuite";
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
+ showEnvVarsInLog = 0;
+ };
+ F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "${TARGET_TEMP_DIR}/.none",
+ );
+ name = "Build Tcl";
+ outputPaths = (
+ "${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
+ showEnvVarsInLog = 0;
+ };
+ F9A5C5F508F651A2008AE941 /* Configure Tcl */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ "$(TCL_SRCROOT)/macosx/configure.ac",
+ "$(TCL_SRCROOT)/unix/configure.in",
+ "$(TCL_SRCROOT)/unix/tcl.m4",
+ "$(TCL_SRCROOT)/unix/aclocal.m4",
+ "$(TCL_SRCROOT)/unix/tclConfig.sh.in",
+ "$(TCL_SRCROOT)/unix/Makefile.in",
+ "$(TCL_SRCROOT)/unix/dltest/Makefile.in",
+ );
+ name = "Configure Tcl";
+ outputPaths = (
+ "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/bash;
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
+ showEnvVarsInLog = 0;
+ };
+/* End PBXShellScriptBuildPhase section */
+
+/* Begin PBXSourcesBuildPhase section */
+ 8DD76FAB0486AB0100D96B5E /* Sources */ = {
+ isa = PBXSourcesBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ F96D456F08F272BB004A47F5 /* regcomp.c in Sources */,
+ F96D457208F272BB004A47F5 /* regerror.c in Sources */,
+ F96D457508F272BB004A47F5 /* regexec.c in Sources */,
+ F96D457608F272BB004A47F5 /* regfree.c in Sources */,
+ F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */,
+ F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */,
+ F96D457D08F272BB004A47F5 /* tclBasic.c in Sources */,
+ F96D457E08F272BC004A47F5 /* tclBinary.c in Sources */,
+ F96D457F08F272BC004A47F5 /* tclCkalloc.c in Sources */,
+ F96D458008F272BC004A47F5 /* tclClock.c in Sources */,
+ F96D458108F272BC004A47F5 /* tclCmdAH.c in Sources */,
+ F96D458208F272BC004A47F5 /* tclCmdIL.c in Sources */,
+ F96D458308F272BC004A47F5 /* tclCmdMZ.c in Sources */,
+ F96D458408F272BC004A47F5 /* tclCompCmds.c in Sources */,
+ F96D458508F272BC004A47F5 /* tclCompExpr.c in Sources */,
+ F96D458608F272BC004A47F5 /* tclCompile.c in Sources */,
+ F96D458808F272BC004A47F5 /* tclConfig.c in Sources */,
+ F96D458908F272BC004A47F5 /* tclDate.c in Sources */,
+ F96D458B08F272BC004A47F5 /* tclDictObj.c in Sources */,
+ F96D458C08F272BC004A47F5 /* tclEncoding.c in Sources */,
+ F96D458D08F272BC004A47F5 /* tclEnv.c in Sources */,
+ F96D458E08F272BC004A47F5 /* tclEvent.c in Sources */,
+ F96D458F08F272BC004A47F5 /* tclExecute.c in Sources */,
+ F96D459008F272BC004A47F5 /* tclFCmd.c in Sources */,
+ F96D459108F272BC004A47F5 /* tclFileName.c in Sources */,
+ F96D459308F272BC004A47F5 /* tclGet.c in Sources */,
+ F96D459508F272BC004A47F5 /* tclHash.c in Sources */,
+ F96D459608F272BC004A47F5 /* tclHistory.c in Sources */,
+ F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */,
+ F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */,
+ F96D459D08F272BC004A47F5 /* tclIO.c in Sources */,
+ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */,
+ F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */,
+ F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */,
+ F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */,
+ F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */,
+ F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */,
+ F96D45A408F272BC004A47F5 /* tclLink.c in Sources */,
+ F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */,
+ F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */,
+ F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */,
+ F96D45A908F272BC004A47F5 /* tclMain.c in Sources */,
+ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */,
+ F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */,
+ F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */,
+ F93599B30DF1F75400E04F67 /* tclOO.c in Sources */,
+ F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */,
+ F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */,
+ F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */,
+ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */,
+ F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */,
+ F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */,
+ F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */,
+ F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */,
+ F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */,
+ F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */,
+ F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */,
+ F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */,
+ F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */,
+ F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */,
+ F96D45B708F272BC004A47F5 /* tclPreserve.c in Sources */,
+ F96D45B808F272BC004A47F5 /* tclProc.c in Sources */,
+ F96D45B908F272BC004A47F5 /* tclRegexp.c in Sources */,
+ F96D45BB08F272BC004A47F5 /* tclResolve.c in Sources */,
+ F96D45BC08F272BC004A47F5 /* tclResult.c in Sources */,
+ F96D45BD08F272BC004A47F5 /* tclScan.c in Sources */,
+ F96D45BE08F272BC004A47F5 /* tclStringObj.c in Sources */,
+ F96D45C308F272BC004A47F5 /* tclStrToD.c in Sources */,
+ F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */,
+ F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */,
+ F96D45C608F272BC004A47F5 /* tclTest.c in Sources */,
+ F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */,
+ F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */,
+ F96D45C908F272BC004A47F5 /* tclThread.c in Sources */,
+ F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */,
+ F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */,
+ F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */,
+ F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
+ F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,
+ F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */,
+ F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */,
+ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */,
+ F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */,
+ F96D45D508F272BC004A47F5 /* tclVar.c in Sources */,
+ F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */,
+ F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */,
+ F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */,
+ F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */,
+ F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */,
+ F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */,
+ F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */,
+ F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */,
+ F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */,
+ 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 */,
+ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */,
+ F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */,
+ F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */,
+ F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
+ F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
+ F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
+ F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
+ F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
+ F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */,
+ F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */,
+ F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */,
+ F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */,
+ F96D491108F272C3004A47F5 /* bn_mp_karatsuba_sqr.c in Sources */,
+ F96D491308F272C3004A47F5 /* bn_mp_lshd.c in Sources */,
+ F96D491408F272C3004A47F5 /* bn_mp_mod.c in Sources */,
+ F96D491508F272C3004A47F5 /* bn_mp_mod_2d.c in Sources */,
+ F96D491A08F272C3004A47F5 /* bn_mp_mul.c in Sources */,
+ F96D491B08F272C3004A47F5 /* bn_mp_mul_2.c in Sources */,
+ F96D491C08F272C3004A47F5 /* bn_mp_mul_2d.c in Sources */,
+ F96D491D08F272C3004A47F5 /* bn_mp_mul_d.c in Sources */,
+ F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */,
+ F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */,
+ F96D492908F272C3004A47F5 /* bn_mp_radix_size.c in Sources */,
+ F96D492A08F272C3004A47F5 /* bn_mp_radix_smap.c in Sources */,
+ F96D492C08F272C3004A47F5 /* bn_mp_read_radix.c in Sources */,
+ F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */,
+ F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */,
+ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */,
+ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */,
+ F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */,
+ F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */,
+ F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */,
+ F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */,
+ F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */,
+ F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */,
+ F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */,
+ F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */,
+ F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */,
+ F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */,
+ F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */,
+ F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */,
+ F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */,
+ F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */,
+ F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */,
+ F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */,
+ F96D495508F272C3004A47F5 /* bncore.c in Sources */,
+ F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */,
+ F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */,
+ F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */,
+ F90509300913A72400327603 /* tclAppInit.c in Sources */,
+ F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */,
+ F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */,
+ F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */,
+ F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */,
+ F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */,
+ F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */,
+ F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */,
+ F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */,
+ F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */,
+ F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */,
+ F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */,
+ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */,
+ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */,
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */,
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+/* End PBXSourcesBuildPhase section */
+
+/* Begin PBXTargetDependency section */
+ F97258D30A868C6F00096C78 /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 8DD76FA90486AB0100D96B5E /* tcltest */;
+ targetProxy = F97258D20A868C6F00096C78 /* PBXContainerItemProxy */;
+ };
+/* End PBXTargetDependency section */
+
+/* Begin XCBuildConfiguration section */
+ F91BCC4F093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = ReleaseUniversal;
+ };
+ F91BCC50093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = ReleaseUniversal;
+ };
+ F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ PREBINDING = NO;
+ };
+ name = ReleaseUniversal;
+ };
+ F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugMemCompile;
+ };
+ F93084380BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugMemCompile;
+ };
+ F93084390BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugMemCompile;
+ };
+ F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugMemCompile;
+ };
+ F9359B250DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_GENERATE_TEST_COVERAGE_FILES = YES;
+ GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ OTHER_LDFLAGS = (
+ "$(OTHER_LDFLAGS)",
+ "-lgcov",
+ );
+ PREBINDING = NO;
+ };
+ name = DebugGCov;
+ };
+ F9359B260DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugGCov;
+ };
+ F9359B270DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugGCov;
+ };
+ F9359B280DF212DA00E04F67 /* DebugGCov */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugGCov;
+ };
+ F95CC8AC09158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Debug;
+ };
+ F95CC8AD09158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Release;
+ };
+ F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F95CC8B109158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = Debug;
+ };
+ F95CC8B209158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = Release;
+ };
+ F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F95CC8B609158F3100EA5ACE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = Debug;
+ };
+ F95CC8B709158F3100EA5ACE /* Release */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = Release;
+ };
+ F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F97258A90A86873D00096C78 /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Debug;
+ };
+ F97258AA0A86873D00096C78 /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Release;
+ };
+ F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoFixAndContinue;
+ };
+ F97258AC0A86873D00096C78 /* ReleaseUniversal */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = ReleaseUniversal;
+ };
+ F97AED1B0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = Debug64bit;
+ };
+ F97AED1C0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = Debug64bit;
+ };
+ F97AED1D0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = Debug64bit;
+ };
+ F97AED1E0B660B2100310EA2 /* Debug64bit */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(NATIVE_ARCH_64_BIT)";
+ CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)";
+ CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ PREBINDING = NO;
+ };
+ name = Debug64bit;
+ };
+ F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoCF;
+ };
+ F98751300DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoCF;
+ };
+ F98751310DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoCF;
+ };
+ F98751320DE7B57E00B1C9EC /* DebugNoCF */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoCF;
+ };
+ F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugNoCFUnthreaded;
+ };
+ F9988AB10D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_VERSION = 4.0;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB20D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB30D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB40D814C6500B6B03B /* Debug gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "Debug gcc40";
+ };
+ F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC = "llvm-gcc";
+ GCC_VERSION = com.apple.compilers.llvmgcc42;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "Debug llvm-gcc";
+ };
+ F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ GCC_VERSION = 4.0;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ PREBINDING = NO;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "ReleaseUniversal gcc40";
+ };
+ F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ DEBUG_INFORMATION_FORMAT = dwarf;
+ GCC = "llvm-gcc";
+ GCC_OPTIMIZATION_LEVEL = 4;
+ "GCC_OPTIMIZATION_LEVEL[arch=ppc]" = s;
+ GCC_VERSION = com.apple.compilers.llvmgcc42;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ PREBINDING = NO;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "ReleaseUniversal llvm-gcc";
+ };
+ F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE73C0BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = DebugLeaks;
+ };
+ F99EE73D0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE73E0BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = DebugLeaks;
+ };
+ F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE7400BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = DebugLeaks;
+ };
+ F99EE7410BE835310060D4AF /* DebugUnthreaded */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads";
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = DebugUnthreaded;
+ };
+ F99EE7420BE835310060D4AF /* DebugLeaks */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ PURIFY,
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ RUN_CLANG_STATIC_ANALYZER = YES;
+ };
+ name = DebugLeaks;
+ };
+ F9A9D1EF0FC77787002A2BE3 /* Debug clang */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
+ GCC = clang;
+ GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ ONLY_ACTIVE_ARCH = YES;
+ PREBINDING = NO;
+ };
+ name = "Debug clang";
+ };
+ F9A9D1F00FC77787002A2BE3 /* Debug clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "Debug clang";
+ };
+ F9A9D1F10FC77787002A2BE3 /* Debug clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
+ GCC_DYNAMIC_NO_PIC = NO;
+ GCC_ENABLE_FIX_AND_CONTINUE = YES;
+ GCC_PREPROCESSOR_DEFINITIONS = (
+ "__private_extern__=extern",
+ "$(GCC_PREPROCESSOR_DEFINITIONS)",
+ );
+ GCC_SYMBOLS_PRIVATE_EXTERN = NO;
+ PRODUCT_NAME = tcltest;
+ };
+ name = "Debug clang";
+ };
+ F9A9D1F20FC77787002A2BE3 /* Debug clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "Debug clang";
+ };
+ F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = (
+ "$(NATIVE_ARCH_64_BIT)",
+ "$(NATIVE_ARCH_32_BIT)",
+ );
+ CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)";
+ DEBUG_INFORMATION_FORMAT = dwarf;
+ GCC = clang;
+ GCC_OPTIMIZATION_LEVEL = 4;
+ GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
+ MACOSX_DEPLOYMENT_TARGET = 10.6;
+ PREBINDING = NO;
+ };
+ name = "ReleaseUniversal clang";
+ };
+ F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = "ReleaseUniversal clang";
+ };
+ F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = "ReleaseUniversal clang";
+ };
+ F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = "ReleaseUniversal clang";
+ };
+ F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tclsh;
+ SKIP_INSTALL = NO;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = tcltest;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ CODE_SIGN_IDENTITY = "";
+ PRODUCT_NAME = tests;
+ TCLTEST_OPTIONS = "";
+ TCL_LIBRARY = "$(TCL_SRCROOT)/library";
+ TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+ F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
+ isa = XCBuildConfiguration;
+ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
+ buildSettings = {
+ ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
+ CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
+ CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
+ MACOSX_DEPLOYMENT_TARGET = 10.5;
+ PREBINDING = NO;
+ SDKROOT = macosx10.5;
+ };
+ name = ReleaseUniversal10.5SDK;
+ };
+/* End XCBuildConfiguration section */
+
+/* Begin XCConfigurationList section */
+ F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8AC09158F3100EA5ACE /* Debug */,
+ F9A9D1F00FC77787002A2BE3 /* Debug clang */,
+ F9988AB60D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB20D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE73B0BE835310060D4AF /* DebugUnthreaded */,
+ F98751300DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084370BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE73C0BE835310060D4AF /* DebugLeaks */,
+ F9359B260DF212DA00E04F67 /* DebugGCov */,
+ F97AED1B0B660B2100310EA2 /* Debug64bit */,
+ F95CC8AD09158F3100EA5ACE /* Release */,
+ F91BCC4F093152310042A6BF /* ReleaseUniversal */,
+ F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */,
+ F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8B109158F3100EA5ACE /* Debug */,
+ F9A9D1F10FC77787002A2BE3 /* Debug clang */,
+ F9988AB70D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB30D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE73D0BE835310060D4AF /* DebugUnthreaded */,
+ F98751310DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084380BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE73E0BE835310060D4AF /* DebugLeaks */,
+ F9359B270DF212DA00E04F67 /* DebugGCov */,
+ F97AED1C0B660B2100310EA2 /* Debug64bit */,
+ F95CC8B209158F3100EA5ACE /* Release */,
+ F91BCC50093152310042A6BF /* ReleaseUniversal */,
+ F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */,
+ F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F95CC8B609158F3100EA5ACE /* Debug */,
+ F9A9D1EF0FC77787002A2BE3 /* Debug clang */,
+ F9988AB50D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB10D814C6500B6B03B /* Debug gcc40 */,
+ F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */,
+ F99EE7410BE835310060D4AF /* DebugUnthreaded */,
+ F987512F0DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F930843A0BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE7420BE835310060D4AF /* DebugLeaks */,
+ F9359B250DF212DA00E04F67 /* DebugGCov */,
+ F97AED1E0B660B2100310EA2 /* Debug64bit */,
+ F95CC8B709158F3100EA5ACE /* Release */,
+ F91BCC51093152310042A6BF /* ReleaseUniversal */,
+ F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */,
+ F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+ F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ F97258A90A86873D00096C78 /* Debug */,
+ F9A9D1F20FC77787002A2BE3 /* Debug clang */,
+ F9988AB80D814C7500B6B03B /* Debug llvm-gcc */,
+ F9988AB40D814C6500B6B03B /* Debug gcc40 */,
+ F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */,
+ F99EE73F0BE835310060D4AF /* DebugUnthreaded */,
+ F98751320DE7B57E00B1C9EC /* DebugNoCF */,
+ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
+ F93084390BB93D2800CD0B9E /* DebugMemCompile */,
+ F99EE7400BE835310060D4AF /* DebugLeaks */,
+ F9359B280DF212DA00E04F67 /* DebugGCov */,
+ F97AED1D0B660B2100310EA2 /* Debug64bit */,
+ F97258AA0A86873D00096C78 /* Release */,
+ F97258AC0A86873D00096C78 /* ReleaseUniversal */,
+ F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */,
+ F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
+ F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */,
+ F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Debug;
+ };
+/* End XCConfigurationList section */
+ };
+ rootObject = 08FB7793FE84155DC02AAC07 /* Project object */;
+}
diff --git a/macosx/Tclsh-Info.plist.in b/macosx/Tclsh-Info.plist.in
new file mode 100644
index 0000000..ecc7f21
--- /dev/null
+++ b/macosx/Tclsh-Info.plist.in
@@ -0,0 +1,36 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<!--
+ Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net>
+
+ See the file "license.terms" for information on usage and redistribution of
+ this file, and for a DISCLAIMER OF ALL WARRANTIES.
+-->
+<plist version="1.0">
+<dict>
+ <key>CFBundleDevelopmentRegion</key>
+ <string>English</string>
+ <key>CFBundleExecutable</key>
+ <string>tclsh@TCL_VERSION@</string>
+ <key>CFBundleGetInfoString</key>
+ <string>Tcl Shell @TCL_VERSION@@TCL_PATCH_LEVEL@,
+Copyright © 1987-@TCL_YEAR@ Tcl Core Team,
+Copyright © 2001-@TCL_YEAR@ Daniel A. Steffen,
+Copyright © 2001-2009 Apple Inc.,
+Copyright © 2001-2002 Jim Ingham &amp; Ian Reid</string>
+ <key>CFBundleIdentifier</key>
+ <string>com.tcltk.tclsh</string>
+ <key>CFBundleInfoDictionaryVersion</key>
+ <string>6.0</string>
+ <key>CFBundleName</key>
+ <string>tclsh</string>
+ <key>CFBundlePackageType</key>
+ <string>APPL</string>
+ <key>CFBundleShortVersionString</key>
+ <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string>
+ <key>CFBundleSignature</key>
+ <string>TclS</string>
+ <key>CFBundleVersion</key>
+ <string>@TCL_VERSION@@TCL_PATCH_LEVEL@</string>
+</dict>
+</plist>
diff --git a/macosx/configure.ac b/macosx/configure.ac
new file mode 100644
index 0000000..01c3697
--- /dev/null
+++ b/macosx/configure.ac
@@ -0,0 +1,11 @@
+#! /bin/bash -norc
+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.
+
+dnl Ensure that the config (auto)headers support is used, then just
+dnl include the configure sources from ../unix:
+
+m4_include(../unix/aclocal.m4)
+m4_define(SC_USE_CONFIG_HEADERS)
+m4_include(../unix/configure.in)
diff --git a/macosx/tclMacOSXBundle.c b/macosx/tclMacOSXBundle.c
index 4b735b7..dad3733 100644
--- a/macosx/tclMacOSXBundle.c
+++ b/macosx/tclMacOSXBundle.c
@@ -4,54 +4,144 @@
* This file implements functions that inspect CFBundle structures on
* MacOS X.
*
- * Copyright 2001, Apple Computer, Inc.
- *
- * The following terms apply to all files originating from Apple
- * Computer, Inc. ("Apple") and associated with the software unless
- * explicitly disclaimed in individual files.
- *
- * Apple hereby grants permission to use, copy, modify, distribute, and
- * license this software and its documentation for any purpose, provided
- * that existing copyright notices are retained in all copies and that
- * this notice is included verbatim in any distributions. No written
- * agreement, license, or royalty fee is required for any of the
- * authorized uses. Modifications to this software may be copyrighted by
- * their authors and need not follow the licensing terms described here,
- * provided that the new terms are clearly indicated on the first page of
- * each file where they apply.
- *
- * IN NO EVENT SHALL APPLE, THE AUTHORS OR DISTRIBUTORS OF THE SOFTWARE
- * BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR
- * CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS
- * DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF APPLE OR THE
- * AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. APPLE,
- * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
- * NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND
- * APPLE,THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
- * MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
- *
- * GOVERNMENT USE: If you are acquiring this software on behalf of the
- * U.S. government, the Government shall have only "Restricted Rights" in
- * the software and related documentation as defined in the Federal
- * Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are
- * acquiring the software on behalf of the Department of Defense, the
- * software shall be classified as "Commercial Computer Software" and the
- * Government shall have only "Restricted Rights" as defined in Clause
- * 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
- * authors grant the U.S. Government and others acting in its behalf
- * permission to use and distribute the software in accordance with the
- * terms specified in this license.
+ * Copyright 2001-2009, Apple Inc.
+ * Copyright (c) 2003-2009 Daniel A. Steffen <das@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#include "tclPort.h"
+
#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>
+
+#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
+# define TCL_DYLD_USE_DLFCN 0
+# endif
+#endif /* TCL_DYLD_USE_DLFCN */
+
+#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
+#endif /* TCL_DYLD_USE_NSMODULE */
+
+#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.
+ */
+extern void * dlsym(void *handle, const char *symbol)
+ WEAK_IMPORT_ATTRIBUTE;
+extern char * dlerror(void) WEAK_IMPORT_ATTRIBUTE;
+#endif
+#endif /* TCL_DYLD_USE_DLFCN */
+
+#if TCL_DYLD_USE_NSMODULE
#include <mach-o/dyld.h>
+#endif
+
+#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \
+ (MAC_OS_X_VERSION_MIN_REQUIRED < 1050)
+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, ...)
+#endif /* TCL_DEBUG_LOAD */
+
+/*
+ * Forward declaration of functions defined in this file:
+ */
+
+static short OpenResourceMap(CFBundleRef bundleRef);
+
#endif /* HAVE_COREFOUNDATION */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenResourceMap --
+ *
+ * Wrapper that dynamically acquires the address for the function
+ * CFBundleOpenBundleResourceMap before calling it, since it is only
+ * present in full CoreFoundation on Mac OS X and not in CFLite on pure
+ * Darwin. Factored out because it is moderately ugly code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef HAVE_COREFOUNDATION
+
+static short
+OpenResourceMap(
+ CFBundleRef bundleRef)
+{
+ static int initialized = FALSE;
+ static short (*openresourcemap)(CFBundleRef) = NULL;
+
+ if (!initialized) {
+#if TCL_DYLD_USE_DLFCN
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
+ if (tclMacOSXDarwinRelease >= 8)
+#endif
+ {
+ openresourcemap = dlsym(RTLD_NEXT,
+ "CFBundleOpenBundleResourceMap");
+#ifdef TCL_DEBUG_LOAD
+ if (!openresourcemap) {
+ const char *errMsg = dlerror();
-#include "tcl.h"
+ TclLoadDbgMsg("dlsym() failed: %s", errMsg);
+ }
+#endif /* TCL_DEBUG_LOAD */
+ }
+ if (!openresourcemap)
+#endif /* TCL_DYLD_USE_DLFCN */
+ {
+#if TCL_DYLD_USE_NSMODULE
+ if (NSIsSymbolNameDefinedWithHint(
+ "_CFBundleOpenBundleResourceMap", "CoreFoundation")) {
+ NSSymbol nsSymbol = NSLookupAndBindSymbolWithHint(
+ "_CFBundleOpenBundleResourceMap", "CoreFoundation");
+ if (nsSymbol) {
+ openresourcemap = NSAddressOfSymbol(nsSymbol);
+ }
+ }
+#endif /* TCL_DYLD_USE_NSMODULE */
+ }
+ initialized = TRUE;
+ }
+
+ if (openresourcemap) {
+ return openresourcemap(bundleRef);
+ }
+ return -1;
+}
+
+#endif /* HAVE_COREFOUNDATION */
+
/*
*----------------------------------------------------------------------
*
@@ -75,13 +165,13 @@
int
Tcl_MacOSXOpenBundleResources(
Tcl_Interp *interp,
- CONST char *bundleName,
+ const char *bundleName,
int hasResourceFile,
int maxPathLen,
char *libraryPath)
{
- return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName,
- NULL, hasResourceFile, maxPathLen, libraryPath);
+ return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL,
+ hasResourceFile, maxPathLen, libraryPath);
}
/*
@@ -108,14 +198,14 @@ Tcl_MacOSXOpenBundleResources(
int
Tcl_MacOSXOpenVersionedBundleResources(
Tcl_Interp *interp,
- CONST char *bundleName,
- CONST char *bundleVersion,
+ const char *bundleName,
+ const char *bundleVersion,
int hasResourceFile,
int maxPathLen,
char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
- CFBundleRef bundleRef;
+ CFBundleRef bundleRef, versionedBundleRef = NULL;
CFStringRef bundleNameRef;
CFURLRef libURL;
@@ -132,72 +222,51 @@ Tcl_MacOSXOpenVersionedBundleResources(
* Create bundle from bundleVersion subdirectory of 'Versions'.
*/
- CFBundleRef versionedBundleRef = NULL;
- CFURLRef versionedBundleURL = NULL;
- CFStringRef bundleVersionRef = CFStringCreateWithCString(NULL,
- bundleVersion, kCFStringEncodingUTF8);
CFURLRef bundleURL = CFBundleCopyBundleURL(bundleRef);
if (bundleURL) {
- CFStringRef bundleTailRef = CFURLCopyLastPathComponent(bundleURL);
+ CFStringRef bundleVersionRef = CFStringCreateWithCString(NULL,
+ bundleVersion, kCFStringEncodingUTF8);
+
+ if (bundleVersionRef) {
+ CFComparisonResult versionComparison = kCFCompareLessThan;
+ CFStringRef bundleTailRef = CFURLCopyLastPathComponent(
+ bundleURL);
- if (bundleTailRef) {
- if (CFStringCompare(bundleTailRef, bundleVersionRef,
- 0) == kCFCompareEqualTo) {
- versionedBundleRef = bundleRef;
+ if (bundleTailRef) {
+ versionComparison = CFStringCompare(bundleTailRef,
+ bundleVersionRef, 0);
+ CFRelease(bundleTailRef);
}
- CFRelease(bundleTailRef);
- }
- }
+ if (versionComparison != kCFCompareEqualTo) {
+ CFURLRef versURL = CFURLCreateCopyAppendingPathComponent(
+ NULL, bundleURL, CFSTR("Versions"), TRUE);
- if (bundleURL && !versionedBundleRef) {
- CFURLRef versURL = CFURLCreateCopyAppendingPathComponent(NULL,
- bundleURL, CFSTR("Versions"), TRUE);
+ if (versURL) {
+ CFURLRef versionedBundleURL =
+ CFURLCreateCopyAppendingPathComponent(
+ NULL, versURL, bundleVersionRef, TRUE);
- if (versURL) {
- versionedBundleURL = CFURLCreateCopyAppendingPathComponent(
- NULL, versURL, bundleVersionRef, TRUE);
- CFRelease(versURL);
+ if (versionedBundleURL) {
+ versionedBundleRef = CFBundleCreate(NULL,
+ versionedBundleURL);
+ if (versionedBundleRef) {
+ bundleRef = versionedBundleRef;
+ }
+ CFRelease(versionedBundleURL);
+ }
+ CFRelease(versURL);
+ }
+ }
+ CFRelease(bundleVersionRef);
}
CFRelease(bundleURL);
}
- CFRelease(bundleVersionRef);
- if (versionedBundleURL) {
- versionedBundleRef = CFBundleCreate(NULL, versionedBundleURL);
- CFRelease(versionedBundleURL);
- }
- bundleRef = versionedBundleRef;
}
- if (bundleRef) {
+ if (bundleRef) {
if (hasResourceFile) {
- /*
- * Dynamically acquire address for CFBundleOpenBundleResourceMap
- * symbol, since it is only present in full CoreFoundation on Mac
- * OS X and not in CFLite on pure Darwin.
- */
-
- static int initialized = FALSE;
- static short (*openresourcemap)(CFBundleRef) = NULL;
-
- if (!initialized) {
- NSSymbol nsSymbol = NULL;
- if (NSIsSymbolNameDefinedWithHint(
- "_CFBundleOpenBundleResourceMap", "CoreFoundation")) {
- nsSymbol = NSLookupAndBindSymbolWithHint(
- "_CFBundleOpenBundleResourceMap","CoreFoundation");
- if (nsSymbol) {
- openresourcemap = NSAddressOfSymbol(nsSymbol);
- }
- }
- initialized = TRUE;
- }
-
- if (openresourcemap) {
- short refNum;
-
- refNum = openresourcemap(bundleRef);
- }
+ (void) OpenResourceMap(bundleRef);
}
libURL = CFBundleCopyResourceURL(bundleRef, CFSTR("Scripts"),
@@ -210,19 +279,28 @@ Tcl_MacOSXOpenVersionedBundleResources(
*/
CFURLGetFileSystemRepresentation(libURL, TRUE,
- (unsigned char*) libraryPath, maxPathLen);
+ (unsigned char *) libraryPath, maxPathLen);
CFRelease(libURL);
}
+ if (versionedBundleRef) {
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1050
+ /*
+ * Workaround CFBundle bug in Tiger and earlier. [Bug 2569449]
+ */
+
+ if (tclMacOSXDarwinRelease >= 9)
+#endif
+ {
+ CFRelease(versionedBundleRef);
+ }
+ }
}
-
+
if (libraryPath[0]) {
return TCL_OK;
- } else {
- return TCL_ERROR;
}
-#else /* HAVE_COREFOUNDATION */
- return TCL_ERROR;
#endif /* HAVE_COREFOUNDATION */
+ return TCL_ERROR;
}
/*
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 738839d..8ecfd0b 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -4,12 +4,10 @@
* This file implements the MacOSX specific portion of file manipulation
* subcommands of the "file" command.
*
- * Copyright (c) 2003 Tcl Core Team.
+ * Copyright (c) 2003-2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* 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.4 2005/07/25 20:48:34 dkf Exp $
*/
#include "tclInt.h"
@@ -17,8 +15,46 @@
#ifdef HAVE_GETATTRLIST
#include <sys/attr.h>
#include <sys/paths.h>
+#include <libkern/OSByteOrder.h>
+#endif
+
+/* Darwin 8 copyfile API. */
+#ifdef HAVE_COPYFILE
+#ifdef HAVE_COPYFILE_H
+#include <copyfile.h>
+#if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040)
+/* Support for weakly importing copyfile. */
+#define WEAK_IMPORT_COPYFILE
+extern int copyfile(const char *from, const char *to,
+ copyfile_state_t state, copyfile_flags_t flags)
+ WEAK_IMPORT_ATTRIBUTE;
+#endif /* HAVE_WEAK_IMPORT */
+#else /* HAVE_COPYFILE_H */
+int copyfile(const char *from, const char *to,
+ void *state, uint32_t flags);
+#define COPYFILE_ACL (1<<0)
+#define COPYFILE_XATTR (1<<2)
+#define COPYFILE_NOFOLLOW_SRC (1<<18)
+#if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040)
+/* Support for weakly importing copyfile. */
+#define WEAK_IMPORT_COPYFILE
+extern int copyfile(const char *from, const char *to,
+ void *state, uint32_t flags)
+ WEAK_IMPORT_ATTRIBUTE;
+#endif /* HAVE_WEAK_IMPORT */
+#endif /* HAVE_COPYFILE_H */
+#endif /* HAVE_COPYFILE */
+
+#ifdef WEAK_IMPORT_COPYFILE
+#define MayUseCopyFile() (copyfile != NULL)
+#elif defined(HAVE_COPYFILE)
+#define MayUseCopyFile() (1)
+#else
+#define MayUseCopyFile() (0)
#endif
+#include <libkern/OSByteOrder.h>
+
/*
* Constants for file attributes subcommand. Need to be kept in sync with
* tclUnixFCmd.c !
@@ -41,26 +77,38 @@ enum {
typedef u_int32_t OSType;
-static int Tcl_GetOSTypeFromObj(Tcl_Interp *interp,
+static int GetOSTypeFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, OSType *osTypePtr);
-static Tcl_Obj * Tcl_NewOSTypeStringObj(CONST OSType newOSType);
+static Tcl_Obj * NewOSTypeObj(const OSType newOSType);
+static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfOSType(Tcl_Obj *objPtr);
+
+static const Tcl_ObjType tclOSTypeType = {
+ "osType", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfOSType, /* updateStringProc */
+ SetOSTypeFromAny /* setFromAnyProc */
+};
enum {
- kFinfoIsInvisible = 0x4000,
+ kIsInvisible = 0x4000,
};
+#define kFinfoIsInvisible (OSSwapHostToBigConstInt16(kIsInvisible))
+
+typedef struct finderinfo {
+ u_int32_t type;
+ u_int32_t creator;
+ u_int16_t fdFlags;
+ u_int32_t location;
+ u_int16_t reserved;
+ u_int32_t extendedFileInfo[4];
+} __attribute__ ((__packed__)) finderinfo;
+
typedef struct fileinfobuf {
u_int32_t info_length;
- union {
- struct {
- u_int32_t type;
- u_int32_t creator;
- u_int16_t fdFlags;
- u_int16_t location;
- u_int32_t padding[4];
- } finder;
- off_t rsrcForkSize;
- } data __attribute__ ((packed));
+ u_int32_t data[8];
} fileinfobuf;
/*
@@ -82,25 +130,27 @@ typedef struct fileinfobuf {
*/
int
-TclMacOSXGetFileAttribute(interp, objIndex, fileName, attributePtrPtr)
- Tcl_Interp *interp; /* The interp we are using for errors. */
- int objIndex; /* The index of the attribute. */
- Tcl_Obj *fileName; /* The name of the file (UTF-8). */
- Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
+TclMacOSXGetFileAttribute(
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
#ifdef HAVE_GETATTRLIST
int result;
Tcl_StatBuf statBuf;
struct attrlist alist;
fileinfobuf finfo;
- CONST char *native;
+ finderinfo *finder = (finderinfo *) &finfo.data;
+ off_t *rsrcForkSize = (off_t *) &finfo.data;
+ const char *native;
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -110,12 +160,12 @@ TclMacOSXGetFileAttribute(interp, objIndex, fileName, attributePtrPtr)
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
- memset(&alist, 0, sizeof(struct attrlist));
+ bzero(&alist, sizeof(struct attrlist));
alist.bitmapcount = ATTR_BIT_MAP_COUNT;
if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
alist.fileattr = ATTR_FILE_RSRCLENGTH;
@@ -126,33 +176,36 @@ TclMacOSXGetFileAttribute(interp, objIndex, fileName, attributePtrPtr)
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
switch (objIndex) {
case MACOSX_CREATOR_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.creator);
+ *attributePtrPtr = NewOSTypeObj(
+ OSSwapBigToHostInt32(finder->creator));
break;
case MACOSX_TYPE_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.type);
+ *attributePtrPtr = NewOSTypeObj(
+ OSSwapBigToHostInt32(finder->type));
break;
case MACOSX_HIDDEN_ATTRIBUTE:
*attributePtrPtr = Tcl_NewBooleanObj(
- (finfo.data.finder.fdFlags & kFinfoIsInvisible) != 0);
+ (finder->fdFlags & kFinfoIsInvisible) != 0);
break;
case MACOSX_RSRCLENGTH_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewWideIntObj(finfo.data.rsrcForkSize);
+ *attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
break;
}
return TCL_OK;
#else
- Tcl_AppendResult(interp, "Mac OS X file attributes not supported",
- (char *) 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 */
}
/*
@@ -173,25 +226,27 @@ TclMacOSXGetFileAttribute(interp, objIndex, fileName, attributePtrPtr)
*/
int
-TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
- Tcl_Interp *interp; /* The interp for error reporting. */
- int objIndex; /* The index of the attribute. */
- Tcl_Obj *fileName; /* The name of the file (UTF-8). */
- Tcl_Obj *attributePtr; /* New owner for file. */
+TclMacOSXSetFileAttribute(
+ Tcl_Interp *interp, /* The interp for error reporting. */
+ int objIndex, /* The index of the attribute. */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *attributePtr) /* New owner for file. */
{
#ifdef HAVE_GETATTRLIST
int result;
Tcl_StatBuf statBuf;
struct attrlist alist;
fileinfobuf finfo;
- CONST char *native;
+ finderinfo *finder = (finderinfo *) &finfo.data;
+ off_t *rsrcForkSize = (off_t *) &finfo.data;
+ const char *native;
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -201,12 +256,12 @@ TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
- memset(&alist, 0, sizeof(struct attrlist));
+ bzero(&alist, sizeof(struct attrlist));
alist.bitmapcount = ATTR_BIT_MAP_COUNT;
if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
alist.fileattr = ATTR_FILE_RSRCLENGTH;
@@ -217,59 +272,59 @@ TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) {
+ OSType t;
+ int h;
+
switch (objIndex) {
case MACOSX_CREATOR_ATTRIBUTE:
- if (Tcl_GetOSTypeFromObj(interp, attributePtr,
- &finfo.data.finder.creator) != TCL_OK) {
+ if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
return TCL_ERROR;
}
+ finder->creator = OSSwapHostToBigInt32(t);
break;
case MACOSX_TYPE_ATTRIBUTE:
- if (Tcl_GetOSTypeFromObj(interp, attributePtr,
- &finfo.data.finder.type) != TCL_OK) {
+ if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
return TCL_ERROR;
}
+ finder->type = OSSwapHostToBigInt32(t);
break;
- case MACOSX_HIDDEN_ATTRIBUTE: {
- int hidden;
-
- if (Tcl_GetBooleanFromObj(interp,attributePtr,&hidden) != TCL_OK) {
+ case MACOSX_HIDDEN_ATTRIBUTE:
+ if (Tcl_GetBooleanFromObj(interp, attributePtr, &h) != TCL_OK) {
return TCL_ERROR;
}
- if (hidden) {
- finfo.data.finder.fdFlags |= kFinfoIsInvisible;
+ if (h) {
+ finder->fdFlags |= kFinfoIsInvisible;
} else {
- finfo.data.finder.fdFlags &= ~kFinfoIsInvisible;
+ finder->fdFlags &= ~kFinfoIsInvisible;
}
break;
}
- }
result = setattrlist(native, &alist,
&finfo.data, sizeof(finfo.data), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not set attributes of \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
} else {
- off_t newRsrcForkSize;
+ Tcl_WideInt newRsrcForkSize;
if (Tcl_GetWideIntFromObj(interp, attributePtr,
&newRsrcForkSize) != TCL_OK) {
return TCL_ERROR;
}
- if (newRsrcForkSize != finfo.data.rsrcForkSize) {
+ if (newRsrcForkSize != *rsrcForkSize) {
Tcl_DString ds;
/*
@@ -277,10 +332,10 @@ TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
* supported.
*/
- if(newRsrcForkSize != 0) {
- Tcl_AppendResult(interp,
- "setting nonzero rsrclength not supported",
- (char *) NULL);
+ if (newRsrcForkSize != 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "setting nonzero rsrclength not supported", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
}
@@ -293,22 +348,35 @@ TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1);
result = truncate(Tcl_DStringValue(&ds), (off_t)0);
+ if (result != 0) {
+ /*
+ * truncate() on a valid resource fork path may fail with a
+ * permission error in some OS releases, try truncating with
+ * open() instead:
+ */
+
+ int fd = open(Tcl_DStringValue(&ds), O_WRONLY | O_TRUNC);
+
+ if (fd > 0) {
+ result = close(fd);
+ }
+ }
Tcl_DStringFree(&ds);
if (result != 0) {
- Tcl_AppendResult(interp,
- "could not truncate resource fork of \"",
- Tcl_GetString(fileName), "\": ",
- Tcl_PosixError(interp), (char *) 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",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Mac OS X file attributes not supported", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
#endif
}
@@ -332,76 +400,162 @@ TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
*/
int
-TclMacOSXCopyFileAttributes(src, dst, statBufPtr)
- CONST char *src; /* Path name of source file (native). */
- CONST char *dst; /* Path name of target file (native). */
- CONST Tcl_StatBuf *statBufPtr;
+TclMacOSXCopyFileAttributes(
+ const char *src, /* Path name of source file (native). */
+ const char *dst, /* Path name of target file (native). */
+ const Tcl_StatBuf *statBufPtr)
/* Stat info for source file */
{
-#ifdef HAVE_GETATTRLIST
- struct attrlist alist;
- fileinfobuf finfo;
+ if (MayUseCopyFile()) {
+#ifdef HAVE_COPYFILE
+ if (0 == copyfile(src, dst, NULL, (S_ISLNK(statBufPtr->st_mode)
+ ? COPYFILE_XATTR | COPYFILE_NOFOLLOW_SRC
+ : COPYFILE_XATTR | COPYFILE_ACL))) {
+ return TCL_OK;
+ }
+#endif /* HAVE_COPYFILE */
+ } else {
+#if (!defined(HAVE_COPYFILE) || defined(WEAK_IMPORT_COPYFILE)) && defined(HAVE_GETATTRLIST)
+ struct attrlist alist;
+ fileinfobuf finfo;
+ off_t *rsrcForkSize = (off_t *) &finfo.data;
+ Tcl_DString srcBuf, dstBuf;
+ int result;
+
+ bzero(&alist, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ alist.commonattr = ATTR_CMN_FNDRINFO;
- memset(&alist, 0, sizeof(struct attrlist));
- alist.bitmapcount = ATTR_BIT_MAP_COUNT;
- alist.commonattr = ATTR_CMN_FNDRINFO;
+ if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
+ return TCL_ERROR;
+ }
+ if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
+ return TCL_ERROR;
+ }
- if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
- return TCL_ERROR;
- }
+ /*
+ * If we're a directory, we're done as they never have resource forks.
+ */
- if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
- return TCL_ERROR;
- }
+ if (S_ISDIR(statBufPtr->st_mode)) {
+ return TCL_OK;
+ }
- if (!S_ISDIR(statBufPtr->st_mode)) {
/*
- * Only copy non-empty resource fork.
+ * We only copy a non-empty resource fork, so determine if that's the
+ * case first.
*/
alist.commonattr = 0;
alist.fileattr = ATTR_FILE_RSRCLENGTH;
-
if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
return TCL_ERROR;
+ } else if (*rsrcForkSize == 0) {
+ return TCL_OK;
}
- if(finfo.data.rsrcForkSize > 0) {
- int result;
- Tcl_DString ds_src, ds_dst;
+ /*
+ * Construct paths to resource forks.
+ */
- /*
- * Construct paths to resource forks.
- */
+ Tcl_DStringInit(&srcBuf);
+ Tcl_DStringAppend(&srcBuf, src, -1);
+ Tcl_DStringAppend(&srcBuf, _PATH_RSRCFORKSPEC, -1);
+ Tcl_DStringInit(&dstBuf);
+ Tcl_DStringAppend(&dstBuf, dst, -1);
+ Tcl_DStringAppend(&dstBuf, _PATH_RSRCFORKSPEC, -1);
- Tcl_DStringInit(&ds_src);
- Tcl_DStringAppend(&ds_src, src, -1);
- Tcl_DStringAppend(&ds_src, _PATH_RSRCFORKSPEC, -1);
- Tcl_DStringInit(&ds_dst);
- Tcl_DStringAppend(&ds_dst, dst, -1);
- Tcl_DStringAppend(&ds_dst, _PATH_RSRCFORKSPEC, -1);
+ /*
+ * Do the copy.
+ */
+
+ result = TclUnixCopyFile(Tcl_DStringValue(&srcBuf),
+ Tcl_DStringValue(&dstBuf), statBufPtr, 1);
+ Tcl_DStringFree(&srcBuf);
+ Tcl_DStringFree(&dstBuf);
+ if (result == 0) {
+ return TCL_OK;
+ }
+#endif /* (!HAVE_COPYFILE || WEAK_IMPORT_COPYFILE) && HAVE_GETATTRLIST */
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacOSXMatchType --
+ *
+ * This routine is used by the globbing code to check if a file matches a
+ * given mac type and/or creator code.
+ *
+ * Results:
+ * The return value is 1, 0 or -1 indicating whether the file matches the
+ * given criteria, does not match them, or an error occurred (in wich
+ * case an error is left in interp).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- result = TclUnixCopyFile(Tcl_DStringValue(&ds_src),
- Tcl_DStringValue(&ds_dst), statBufPtr, 1);
+int
+TclMacOSXMatchType(
+ Tcl_Interp *interp, /* Interpreter to receive errors. */
+ const char *pathName, /* Native path to check. */
+ const char *fileName, /* Native filename to check. */
+ Tcl_StatBuf *statBufPtr, /* Stat info for file to check */
+ Tcl_GlobTypeData *types) /* Type description to match against. */
+{
+#ifdef HAVE_GETATTRLIST
+ struct attrlist alist;
+ fileinfobuf finfo;
+ finderinfo *finder = (finderinfo *) &finfo.data;
+ OSType osType;
- Tcl_DStringFree(&ds_src);
- Tcl_DStringFree(&ds_dst);
+ bzero(&alist, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ alist.commonattr = ATTR_CMN_FNDRINFO;
+ if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0) != 0) {
+ return 0;
+ }
+ if ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ !((finder->fdFlags & kFinfoIsInvisible) || (*fileName == '.'))) {
+ return 0;
+ }
+ if (S_ISDIR(statBufPtr->st_mode)
+ && (types->macType || types->macCreator)) {
+ /*
+ * Directories don't support types or creators.
+ */
- if (result != 0) {
- return TCL_ERROR;
- }
+ return 0;
+ }
+ if (types->macType) {
+ if (GetOSTypeFromObj(interp, types->macType, &osType) != TCL_OK) {
+ return -1;
+ }
+ if (osType != OSSwapBigToHostInt32(finder->type)) {
+ return 0;
+ }
+ }
+ if (types->macCreator) {
+ if (GetOSTypeFromObj(interp, types->macCreator, &osType) != TCL_OK) {
+ return -1;
+ }
+ if (osType != OSSwapBigToHostInt32(finder->creator)) {
+ return 0;
}
}
- return TCL_OK;
-#else
- return TCL_ERROR;
#endif
+ return 1;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetOSTypeFromObj --
+ * GetOSTypeFromObj --
*
* Attempt to return an OSType from the Tcl object "objPtr".
*
@@ -416,12 +570,72 @@ TclMacOSXCopyFileAttributes(src, dst, statBufPtr)
*/
static int
-Tcl_GetOSTypeFromObj(
+GetOSTypeFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* The object from which to get an OSType. */
OSType *osTypePtr) /* Place to store resulting OSType. */
{
- char *string;
+ int result = TCL_OK;
+
+ if (objPtr->typePtr != &tclOSTypeType) {
+ result = SetOSTypeFromAny(interp, objPtr);
+ }
+ *osTypePtr = (OSType) objPtr->internalRep.longValue;
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewOSTypeObj --
+ *
+ * Create a new OSType object.
+ *
+ * Results:
+ * The newly created OSType object is returned, it has ref count 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewOSTypeObj(
+ const OSType osType) /* OSType used to initialize the new
+ * object. */
+{
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ TclInvalidateStringRep(objPtr);
+ objPtr->internalRep.longValue = (long) osType;
+ objPtr->typePtr = &tclOSTypeType;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOSTypeFromAny --
+ *
+ * Attempts to force the internal representation for a Tcl object to
+ * tclOSTypeType, specifically.
+ *
+ * Results:
+ * The return value is a standard object Tcl result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOSTypeFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Pointer to the object to convert */
+{
+ const char *string;
int length, result = TCL_OK;
Tcl_DString ds;
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
@@ -429,15 +643,25 @@ Tcl_GetOSTypeFromObj(
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_UtfToExternalDString(encoding, string, length, &ds);
- if (Tcl_DStringLength(&ds) > sizeof(OSType)) {
- Tcl_AppendResult(interp,
- "expected Macintosh OS type but got \"",
- string, "\": ", (char *) NULL);
+ if (Tcl_DStringLength(&ds) > 4) {
+ 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 {
- memset(osTypePtr, 0, sizeof(OSType));
- memcpy(osTypePtr, Tcl_DStringValue(&ds),
- (size_t) Tcl_DStringLength(&ds));
+ OSType osType;
+ char bytes[4] = {'\0','\0','\0','\0'};
+
+ memcpy(bytes, Tcl_DStringValue(&ds), (size_t)Tcl_DStringLength(&ds));
+ osType = (OSType) bytes[0] << 24 |
+ (OSType) bytes[1] << 16 |
+ (OSType) bytes[2] << 8 |
+ (OSType) bytes[3];
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.longValue = (long) osType;
+ objPtr->typePtr = &tclOSTypeType;
}
Tcl_DStringFree(&ds);
Tcl_FreeEncoding(encoding);
@@ -447,36 +671,45 @@ Tcl_GetOSTypeFromObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewOSTypeStringObj --
+ * UpdateStringOfOSType --
*
- * Create a new OSType string object.
+ * Update the string representation for an OSType object. Note: This
+ * function does not free an existing old string rep so storage will be
+ * lost if this has not already been done.
*
* Results:
- * The newly created string object is returned, it has ref count 0.
+ * None.
*
* Side effects:
- * None.
+ * The object's string is set to a valid string that results from the
+ * OSType-to-string conversion.
*
*----------------------------------------------------------------------
*/
-static Tcl_Obj *
-Tcl_NewOSTypeStringObj(
- CONST OSType newOSType) /* OSType used to initialize the new object. */
+static void
+UpdateStringOfOSType(
+ register Tcl_Obj *objPtr) /* OSType object whose string rep to
+ * update. */
{
- char string[sizeof(OSType)+1];
- Tcl_Obj *resultPtr;
+ char string[5];
+ OSType osType = (OSType) objPtr->internalRep.longValue;
Tcl_DString ds;
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+ unsigned len;
- memcpy(string, &newOSType, sizeof(OSType));
- string[sizeof(OSType)] = '\0';
+ string[0] = (char) (osType >> 24);
+ string[1] = (char) (osType >> 16);
+ string[2] = (char) (osType >> 8);
+ string[3] = (char) (osType);
+ string[4] = '\0';
Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
- resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&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);
- return resultPtr;
}
/*
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index 6c46562..ef80192 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -6,23 +6,193 @@
* This file works together with generic/tclNotify.c.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright 2001, Apple Computer, Inc.
- * Copyright 2005, Tcl Core Team.
+ * Copyright 2001-2009, Apple Inc.
+ * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net>
*
* 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.4 2005/07/25 20:48:34 dkf Exp $
*/
+#include "tclInt.h"
#ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is
* in tclUnixNotfy.c */
-#include "tclInt.h"
#include <CoreFoundation/CoreFoundation.h>
#include <pthread.h>
-extern TclStubs tclStubs;
-extern Tcl_NotifierProcs tclOriginalNotifier;
+/* #define TCL_MAC_DEBUG_NOTIFIER 1 */
+
+/*
+ * We use the Darwin-native spinlock API rather than pthread mutexes for
+ * notifier locking: this radically simplifies the implementation and lowers
+ * overhead. Note that these are not pure spinlocks, they employ various
+ * strategies to back off and relinquish the processor, making them immune to
+ * most priority-inversion livelocks (c.f. 'man 3 OSSpinLockLock' and Darwin
+ * sources: xnu/osfmk/{ppc,i386}/commpage/spinlocks.s).
+ */
+
+#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
+/*
+ * Use OSSpinLock API where available (Tiger or later).
+ */
+
+#include <libkern/OSAtomic.h>
+
+#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
+/*
+ * Support for weakly importing spinlock API.
+ */
+#define WEAK_IMPORT_SPINLOCKLOCK
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050
+#define VOLATILE volatile
+#else
+#define VOLATILE
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */
+#ifndef bool
+#define bool int
+#endif
+extern void OSSpinLockLock(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+extern bool OSSpinLockTry(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+extern void _spin_lock(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+extern void _spin_unlock(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+extern bool _spin_lock_try(VOLATILE OSSpinLock *lock)
+ WEAK_IMPORT_ATTRIBUTE;
+static void (* lockLock)(VOLATILE OSSpinLock *lock) = NULL;
+static void (* lockUnlock)(VOLATILE OSSpinLock *lock) = NULL;
+static bool (* lockTry)(VOLATILE OSSpinLock *lock) = NULL;
+#undef VOLATILE
+static pthread_once_t spinLockLockInitControl = PTHREAD_ONCE_INIT;
+static void
+SpinLockLockInit(void)
+{
+ lockLock = OSSpinLockLock != NULL ? OSSpinLockLock : _spin_lock;
+ lockUnlock = OSSpinLockUnlock != NULL ? OSSpinLockUnlock : _spin_unlock;
+ lockTry = OSSpinLockTry != NULL ? OSSpinLockTry : _spin_lock_try;
+ if (lockLock == NULL || lockUnlock == NULL) {
+ Tcl_Panic("SpinLockLockInit: no spinlock API available");
+ }
+}
+#define SpinLockLock(p) lockLock(p)
+#define SpinLockUnlock(p) lockUnlock(p)
+#define SpinLockTry(p) lockTry(p)
+#else
+#define SpinLockLock(p) OSSpinLockLock(p)
+#define SpinLockUnlock(p) OSSpinLockUnlock(p)
+#define SpinLockTry(p) OSSpinLockTry(p)
+#endif /* HAVE_WEAK_IMPORT */
+#define SPINLOCK_INIT OS_SPINLOCK_INIT
+
+#else
+/*
+ * Otherwise, use commpage spinlock SPI directly.
+ */
+
+typedef uint32_t OSSpinLock;
+extern void _spin_lock(OSSpinLock *lock);
+extern void _spin_unlock(OSSpinLock *lock);
+extern int _spin_lock_try(OSSpinLock *lock);
+#define SpinLockLock(p) _spin_lock(p)
+#define SpinLockUnlock(p) _spin_unlock(p)
+#define SpinLockTry(p) _spin_lock_try(p)
+#define SPINLOCK_INIT 0
+
+#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
+
+/*
+ * These spinlocks lock access to the global notifier state.
+ */
+
+static OSSpinLock notifierInitLock = SPINLOCK_INIT;
+static OSSpinLock notifierLock = SPINLOCK_INIT;
+
+/*
+ * Macros abstracting notifier locking/unlocking
+ */
+
+#define LOCK_NOTIFIER_INIT SpinLockLock(&notifierInitLock)
+#define UNLOCK_NOTIFIER_INIT SpinLockUnlock(&notifierInitLock)
+#define LOCK_NOTIFIER SpinLockLock(&notifierLock)
+#define UNLOCK_NOTIFIER SpinLockUnlock(&notifierLock)
+#define LOCK_NOTIFIER_TSD SpinLockLock(&tsdPtr->tsdLock)
+#define UNLOCK_NOTIFIER_TSD SpinLockUnlock(&tsdPtr->tsdLock)
+
+#ifdef TCL_MAC_DEBUG_NOTIFIER
+#define TclMacOSXNotifierDbgMsg(m, ...) \
+ do { \
+ fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
+ "%s() pid %5d thread %10p: " m "\n", __LINE__, __func__, \
+ getpid(), pthread_self(), ##__VA_ARGS__); \
+ fflush(notifierLog?notifierLog:stderr); \
+ } while (0)
+
+/*
+ * Debug version of SpinLockLock that logs the time spent waiting for the lock
+ */
+
+#define SpinLockLockDbg(p) \
+ if (!SpinLockTry(p)) { \
+ Tcl_WideInt s = TclpGetWideClicks(), e; \
+ \
+ SpinLockLock(p); \
+ e = TclpGetWideClicks(); \
+ TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns", \
+ #p, TclpWideClicksToNanoseconds(e-s)); \
+ }
+#undef LOCK_NOTIFIER_INIT
+#define LOCK_NOTIFIER_INIT SpinLockLockDbg(&notifierInitLock)
+#undef LOCK_NOTIFIER
+#define LOCK_NOTIFIER SpinLockLockDbg(&notifierLock)
+#undef LOCK_NOTIFIER_TSD
+#define LOCK_NOTIFIER_TSD SpinLockLockDbg(&tsdPtr->tsdLock)
+#include <asl.h>
+static FILE *notifierLog = NULL;
+#ifndef NOTIFIER_LOG
+#define NOTIFIER_LOG "/tmp/tclMacOSXNotify.log"
+#endif
+#define OPEN_NOTIFIER_LOG \
+ if (!notifierLog) { \
+ notifierLog = fopen(NOTIFIER_LOG, "a"); \
+ /*TclMacOSXNotifierDbgMsg("open log"); \
+ *asl_set_filter(NULL, \
+ * ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \
+ *asl_add_log_file(NULL, fileno(notifierLog));*/ \
+ }
+#define CLOSE_NOTIFIER_LOG \
+ if (notifierLog) { \
+ /*asl_remove_log_file(NULL, fileno(notifierLog)); \
+ *TclMacOSXNotifierDbgMsg("close log");*/ \
+ fclose(notifierLog); \
+ notifierLog = NULL; \
+ }
+#define ENABLE_ASL \
+ if (notifierLog) { \
+ /*tsdPtr->asl = asl_open(NULL, "com.apple.console", \
+ * ASL_OPT_NO_REMOTE); \
+ *asl_set_filter(tsdPtr->asl, \
+ * ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \
+ *asl_add_log_file(tsdPtr->asl, fileno(notifierLog));*/ \
+ }
+#define DISABLE_ASL \
+ /*if (tsdPtr->asl) { \
+ * if (notifierLog) { \
+ * asl_remove_log_file(tsdPtr->asl, fileno(notifierLog)); \
+ * } \
+ * asl_close(tsdPtr->asl); \
+ *}*/
+#define ASLCLIENT_DECL /*aslclient asl*/
+#else
+#define TclMacOSXNotifierDbgMsg(m, ...)
+#define OPEN_NOTIFIER_LOG
+#define CLOSE_NOTIFIER_LOG
+#define ENABLE_ASL
+#define DISABLE_ASL
+#define ASLCLIENT_DECL
+#endif /* TCL_MAC_DEBUG_NOTIFIER */
/*
* This structure is used to keep track of the notifier info for a registered
@@ -77,6 +247,32 @@ typedef struct SelectMasks {
typedef struct ThreadSpecificData {
FileHandler *firstFileHandlerPtr;
/* Pointer to head of file handler list. */
+ int polled; /* True if the notifier thread has polled for
+ * this thread. */
+ int sleeping; /* True if runloop is inside Tcl_Sleep. */
+ int runLoopSourcePerformed; /* True after the runLoopSource callack was
+ * performed. */
+ int runLoopRunning; /* True if this thread's Tcl runLoop is
+ * running. */
+ int runLoopNestingLevel; /* Level of nested runLoop invocations. */
+ int runLoopServicingEvents; /* True if this thread's runLoop is servicing
+ * Tcl events. */
+
+ /* Must hold the notifierLock before accessing the following fields: */
+ /* Start notifierLock section */
+ int onList; /* True if this thread is on the
+ * waitingList */
+ struct ThreadSpecificData *nextPtr, *prevPtr;
+ /* All threads that are currently waiting on
+ * an event have their ThreadSpecificData
+ * structure on a doubly-linked listed formed
+ * from these pointers. */
+ /* End notifierLock section */
+
+ OSSpinLock tsdLock; /* Must hold this lock before acessing the
+ * following fields from more than one
+ * thread. */
+ /* Start tsdLock section */
SelectMasks checkMasks; /* This structure is used to build up the
* masks to be used in the next call to
* select. Bits are set in response to calls
@@ -87,26 +283,26 @@ typedef struct ThreadSpecificData {
int numFdBits; /* Number of valid bits in checkMasks (one
* more than highest fd for which
* Tcl_WatchFile has been called). */
- int onList; /* True if it is in this list */
- unsigned int pollState; /* pollState is used to implement a polling
- * handshake between each thread and the
- * notifier thread. Bits defined below. */
- struct ThreadSpecificData *nextPtr, *prevPtr;
- /* All threads that are currently waiting on
- * an event have their ThreadSpecificData
- * structure on a doubly-linked listed formed
- * from these pointers. You must hold the
- * notifierLock before accessing these
- * fields. */
+ int polling; /* True if this thread is polling for
+ * events. */
+ CFRunLoopRef runLoop; /* This thread's CFRunLoop, needs to be woken
+ * up whenever the runLoopSource is
+ * signaled. */
CFRunLoopSourceRef runLoopSource;
/* Any other thread alerts a notifier that an
* event is ready to be processed by signaling
* this CFRunLoopSource. */
- CFRunLoopRef runLoop; /* This thread's CFRunLoop, needs to be woken
- * up whenever the runLoopSource is
- * signaled. */
- int eventReady; /* True if an event is ready to be
- * processed. */
+ CFRunLoopObserverRef runLoopObserver, runLoopObserverTcl;
+ /* Adds/removes this thread from waitingList
+ * when the CFRunLoop starts/stops. */
+ CFRunLoopTimerRef runLoopTimer;
+ /* Wakes up CFRunLoop after given timeout when
+ * running embedded. */
+ /* End tsdLock section */
+
+ CFTimeInterval waitTime; /* runLoopTimer wait time when running
+ * embedded. */
+ ASLCLIENT_DECL;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
@@ -148,73 +344,87 @@ static int triggerPipe = -1;
static int receivePipe = -1; /* Output end of triggerPipe */
/*
- * We use Darwin-native spinlocks instead of pthread mutexes for notifier
- * locking: this radically simplifies the implementation and lowers overhead.
- * Note that these are not pure spinlocks, they employ various strategies to
- * back off, making them immune to most priority-inversion livelocks (c.f. man
- * 3 OSSpinLockLock).
- */
-
-#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
-/*
- * Use OSSpinLock API where available (Tiger or later).
- */
-
-#include <libkern/OSAtomic.h>
-
-#else
-/*
- * Otherwise, use commpage spinlock SPI directly.
+ * The following static indicates if the notifier thread is running.
+ *
+ * You must hold the notifierInitLock before accessing this variable.
*/
-typedef uint32_t OSSpinLock;
-extern void _spin_lock(OSSpinLock *lock);
-extern void _spin_unlock(OSSpinLock *lock);
-#define OSSpinLockLock(p) _spin_lock(p)
-#define OSSpinLockUnlock(p) _spin_unlock(p)
-
-#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
+static int notifierThreadRunning;
/*
- * These spinlocks lock access to the global notifier state.
+ * This is the thread ID of the notifier thread that does select. Only valid
+ * when notifierThreadRunning is non-zero.
+ *
+ * You must hold the notifierInitLock before accessing this variable.
*/
-static OSSpinLock notifierInitLock = 0;
-static OSSpinLock notifierLock = 0;
+static pthread_t notifierThread;
/*
- * Macros abstracting notifier locking/unlocking
+ * Custom runloop mode for running with only the runloop source for the
+ * notifier thread.
*/
-#define LOCK_NOTIFIER_INIT OSSpinLockLock(&notifierInitLock)
-#define UNLOCK_NOTIFIER_INIT OSSpinLockUnlock(&notifierInitLock)
-#define LOCK_NOTIFIER OSSpinLockLock(&notifierLock)
-#define UNLOCK_NOTIFIER OSSpinLockUnlock(&notifierLock)
+#ifndef TCL_EVENTS_ONLY_RUN_LOOP_MODE
+#define TCL_EVENTS_ONLY_RUN_LOOP_MODE "com.tcltk.tclEventsOnlyRunLoopMode"
+#endif
+#ifdef __CONSTANT_CFSTRINGS__
+#define tclEventsOnlyRunLoopMode CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE)
+#else
+static CFStringRef tclEventsOnlyRunLoopMode = NULL;
+#endif
/*
- * The pollState bits
- * POLL_WANT is set by each thread before it waits on its condition
- * variable. It is checked by the notifier before it does select.
- * POLL_DONE is set by the notifier if it goes into select after seeing
- * POLL_WANT. The idea is to ensure it tries a select with the
- * same bits the initial thread had set.
+ * CFTimeInterval to wait forever.
*/
-#define POLL_WANT 0x1
-#define POLL_DONE 0x2
+#define CF_TIMEINTERVAL_FOREVER 5.05e8
/*
- * This is the thread ID of the notifier thread that does select.
+ * Static routines defined in this file.
*/
-static pthread_t notifierThread;
+static void StartNotifierThread(void);
+static void NotifierThreadProc(ClientData clientData)
+ __attribute__ ((__noreturn__));
+static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+static void TimerWakeUp(CFRunLoopTimerRef timer, void *info);
+static void QueueFileEvents(void *info);
+static void UpdateWaitingListAndServiceEvents(
+ CFRunLoopObserverRef observer,
+ CFRunLoopActivity activity, void *info);
+static int OnOffWaitingList(ThreadSpecificData *tsdPtr,
+ int onList, int signalNotifier);
+
+#ifdef HAVE_PTHREAD_ATFORK
+static int atForkInit = 0;
+static void AtForkPrepare(void);
+static void AtForkParent(void);
+static void AtForkChild(void);
+#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
+/* Support for weakly importing pthread_atfork. */
+#define WEAK_IMPORT_PTHREAD_ATFORK
+extern int pthread_atfork(void (*prepare)(void),
+ void (*parent)(void), void (*child)(void))
+ WEAK_IMPORT_ATTRIBUTE;
+#define MayUsePthreadAtfork() (pthread_atfork != NULL)
+#else
+#define MayUsePthreadAtfork() (1)
+#endif /* HAVE_WEAK_IMPORT */
/*
- * Static routines defined in this file.
+ * On Darwin 9 and later, it is not possible to call CoreFoundation after
+ * a fork.
*/
-static void NotifierThreadProc(ClientData clientData);
-static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+#if !defined(MAC_OS_X_VERSION_MIN_REQUIRED) || \
+ MAC_OS_X_VERSION_MIN_REQUIRED < 1050
+MODULE_SCOPE long tclMacOSXDarwinRelease;
+#define noCFafterFork (tclMacOSXDarwinRelease >= 9)
+#else /* MAC_OS_X_VERSION_MIN_REQUIRED */
+#define noCFafterFork 1
+#endif /* MAC_OS_X_VERSION_MIN_REQUIRED */
+#endif /* HAVE_PTHREAD_ATFORK */
/*
*----------------------------------------------------------------------
@@ -224,7 +434,7 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
* Initializes the platform specific notifier state.
*
* Results:
- * Returns a handle to the notifier state for this thread..
+ * Returns a handle to the notifier state for this thread.
*
* Side effects:
* None.
@@ -233,59 +443,213 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
*/
ClientData
-Tcl_InitNotifier()
+Tcl_InitNotifier(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr;
- tsdPtr->eventReady = 0;
+ if (tclNotifierHooks.initNotifierProc) {
+ return tclNotifierHooks.initNotifierProc();
+ }
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#ifdef WEAK_IMPORT_SPINLOCKLOCK
+ /*
+ * Initialize support for weakly imported spinlock API.
+ */
+
+ if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
+ Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
+ }
+#endif
+
+#ifndef __CONSTANT_CFSTRINGS__
+ if (!tclEventsOnlyRunLoopMode) {
+ tclEventsOnlyRunLoopMode = CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE);
+ }
+#endif
/*
- * Initialize CFRunLoopSource and add it to CFRunLoop of this thread
+ * Initialize CFRunLoopSource and add it to CFRunLoop of this thread.
*/
if (!tsdPtr->runLoop) {
CFRunLoopRef runLoop = CFRunLoopGetCurrent();
CFRunLoopSourceRef runLoopSource;
CFRunLoopSourceContext runLoopSourceContext;
+ CFRunLoopObserverContext runLoopObserverContext;
+ CFRunLoopObserverRef runLoopObserver, runLoopObserverTcl;
bzero(&runLoopSourceContext, sizeof(CFRunLoopSourceContext));
runLoopSourceContext.info = tsdPtr;
- runLoopSource = CFRunLoopSourceCreate(NULL, 0, &runLoopSourceContext);
+ runLoopSourceContext.perform = QueueFileEvents;
+ runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN,
+ &runLoopSourceContext);
if (!runLoopSource) {
- Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource.");
+ Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource");
}
CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
- tsdPtr->runLoopSource = runLoopSource;
+ CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode);
+
+ bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
+ runLoopObserverContext.info = tsdPtr;
+ runLoopObserver = CFRunLoopObserverCreate(NULL,
+ kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ LONG_MIN, UpdateWaitingListAndServiceEvents,
+ &runLoopObserverContext);
+ if (!runLoopObserver) {
+ Tcl_Panic("Tcl_InitNotifier: could not create "
+ "CFRunLoopObserver");
+ }
+ CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes);
+
+ /*
+ * Create a second CFRunLoopObserver with the same callback as above
+ * for the tclEventsOnlyRunLoopMode to ensure that the callback can be
+ * re-entered via Tcl_ServiceAll() in the kCFRunLoopBeforeWaiting case
+ * (CFRunLoop prevents observer callback re-entry of a given observer
+ * instance).
+ */
+
+ runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
+ kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
+ LONG_MIN, UpdateWaitingListAndServiceEvents,
+ &runLoopObserverContext);
+ if (!runLoopObserverTcl) {
+ Tcl_Panic("Tcl_InitNotifier: could not create "
+ "CFRunLoopObserver");
+ }
+ CFRunLoopAddObserver(runLoop, runLoopObserverTcl,
+ tclEventsOnlyRunLoopMode);
+
tsdPtr->runLoop = runLoop;
+ tsdPtr->runLoopSource = runLoopSource;
+ tsdPtr->runLoopObserver = runLoopObserver;
+ tsdPtr->runLoopObserverTcl = runLoopObserverTcl;
+ tsdPtr->runLoopTimer = NULL;
+ tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER;
+ tsdPtr->tsdLock = SPINLOCK_INIT;
}
+ LOCK_NOTIFIER_INIT;
+#ifdef HAVE_PTHREAD_ATFORK
/*
- * Initialize trigger pipe and start the Notifier thread if necessary.
+ * Install pthread_atfork handlers to reinitialize the notifier in the
+ * child of a fork.
*/
- LOCK_NOTIFIER_INIT;
+ if (MayUsePthreadAtfork() && !atForkInit) {
+ int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
+
+ if (result) {
+ Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
+ }
+ atForkInit = 1;
+ }
+#endif /* HAVE_PTHREAD_ATFORK */
if (notifierCount == 0) {
- int fds[2], status, result;
- pthread_attr_t attr;
+ int fds[2], status;
+
+ /*
+ * Initialize trigger pipe.
+ */
if (pipe(fds) != 0) {
- Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe.");
+ Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe");
}
status = fcntl(fds[0], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[0], F_SETFL, status) < 0) {
- Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non blocking.");
+ Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non "
+ "blocking");
}
status = fcntl(fds[1], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[1], F_SETFL, status) < 0) {
- Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non blocking.");
+ Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non "
+ "blocking");
}
receivePipe = fds[0];
triggerPipe = fds[1];
+ /*
+ * Create notifier thread lazily in Tcl_WaitForEvent() to avoid
+ * interfering with fork() followed immediately by execve() (we cannot
+ * execve() when more than one thread is present).
+ */
+
+ notifierThreadRunning = 0;
+ OPEN_NOTIFIER_LOG;
+ }
+ ENABLE_ASL;
+ notifierCount++;
+ UNLOCK_NOTIFIER_INIT;
+
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacOSXNotifierAddRunLoopMode --
+ *
+ * Add the tcl notifier RunLoop source, observer and timer (if any)
+ * to the given RunLoop mode.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclMacOSXNotifierAddRunLoopMode(
+ const void *runLoopMode)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ CFStringRef mode = (CFStringRef) runLoopMode;
+
+ if (tsdPtr->runLoop) {
+ CFRunLoopAddSource(tsdPtr->runLoop, tsdPtr->runLoopSource, mode);
+ CFRunLoopAddObserver(tsdPtr->runLoop, tsdPtr->runLoopObserver, mode);
+ if (tsdPtr->runLoopTimer) {
+ CFRunLoopAddTimer(tsdPtr->runLoop, tsdPtr->runLoopTimer, mode);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StartNotifierThread --
+ *
+ * Start notifier thread if necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StartNotifierThread(void)
+{
+ LOCK_NOTIFIER_INIT;
+ if (!notifierCount) {
+ Tcl_Panic("StartNotifierThread: notifier not initialized");
+ }
+ if (!notifierThreadRunning) {
+ int result;
+ pthread_attr_t attr;
+
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
@@ -294,14 +658,13 @@ Tcl_InitNotifier()
(void * (*)(void *))NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result) {
- Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread.");
+ Tcl_Panic("StartNotifierThread: unable to start notifier thread");
}
+ notifierThreadRunning = 1;
}
- notifierCount++;
UNLOCK_NOTIFIER_INIT;
-
- return (ClientData) tsdPtr;
}
+
/*
*----------------------------------------------------------------------
@@ -322,13 +685,21 @@ Tcl_InitNotifier()
*/
void
-Tcl_FinalizeNotifier(clientData)
- ClientData clientData; /* Not used. */
+Tcl_FinalizeNotifier(
+ ClientData clientData) /* Not used. */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr;
+
+ if (tclNotifierHooks.finalizeNotifierProc) {
+ tclNotifierHooks.finalizeNotifierProc(clientData);
+ return;
+ }
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
LOCK_NOTIFIER_INIT;
notifierCount--;
+ DISABLE_ASL;
/*
* If this is the last thread to use the notifier, close the notifier pipe
@@ -336,49 +707,63 @@ Tcl_FinalizeNotifier(clientData)
*/
if (notifierCount == 0) {
- int result;
+ if (triggerPipe != -1) {
+ /*
+ * Send "q" message to the notifier thread so that it will
+ * terminate. The notifier will return from its call to select()
+ * and notice that a "q" message has arrived, it will then close
+ * its side of the pipe and terminate its thread. Note the we can
+ * not just close the pipe and check for EOF in the notifier
+ * thread because if a background child process was created with
+ * exec, select() would not register the EOF on the pipe until the
+ * child processes had terminated. [Bug: 4139] [Bug 1222872]
+ */
- if (triggerPipe < 0) {
- Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized.");
- }
+ write(triggerPipe, "q", 1);
+ close(triggerPipe);
- /*
- * Send "q" message to the notifier thread so that it will terminate.
- * The notifier will return from its call to select() and notice that
- * a "q" message has arrived, it will then close its side of the pipe
- * and terminate its thread. Note the we can not just close the pipe
- * and check for EOF in the notifier thread because if a background
- * child process was created with exec, select() would not register
- * the EOF on the pipe until the child processes had terminated. [Bug:
- * 4139]
- */
+ if (notifierThreadRunning) {
+ int result = pthread_join(notifierThread, NULL);
- write(triggerPipe, "q", 1);
- close(triggerPipe);
+ if (result) {
+ Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
+ "thread");
+ }
+ notifierThreadRunning = 0;
+ }
- result = pthread_join(notifierThread, NULL);
- if (result) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread.");
+ close(receivePipe);
+ triggerPipe = -1;
}
-
- close(receivePipe);
- triggerPipe = -1;
+ CLOSE_NOTIFIER_LOG;
}
UNLOCK_NOTIFIER_INIT;
- LOCK_NOTIFIER; /* for concurrency with Tcl_AlertNotifier */
+ LOCK_NOTIFIER_TSD; /* For concurrency with Tcl_AlertNotifier */
if (tsdPtr->runLoop) {
tsdPtr->runLoop = NULL;
/*
- * Remove runLoopSource from all CFRunLoops and release it.
+ * Remove runLoopSource, runLoopObserver and runLoopTimer from all
+ * CFRunLoops.
*/
CFRunLoopSourceInvalidate(tsdPtr->runLoopSource);
CFRelease(tsdPtr->runLoopSource);
tsdPtr->runLoopSource = NULL;
+ CFRunLoopObserverInvalidate(tsdPtr->runLoopObserver);
+ CFRelease(tsdPtr->runLoopObserver);
+ tsdPtr->runLoopObserver = NULL;
+ CFRunLoopObserverInvalidate(tsdPtr->runLoopObserverTcl);
+ CFRelease(tsdPtr->runLoopObserverTcl);
+ tsdPtr->runLoopObserverTcl = NULL;
+ if (tsdPtr->runLoopTimer) {
+ CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer);
+ CFRelease(tsdPtr->runLoopTimer);
+ tsdPtr->runLoopTimer = NULL;
+ }
}
- UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_TSD;
}
/*
@@ -401,18 +786,22 @@ Tcl_FinalizeNotifier(clientData)
*/
void
-Tcl_AlertNotifier(clientData)
- ClientData clientData;
+Tcl_AlertNotifier(
+ ClientData clientData)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ ThreadSpecificData *tsdPtr = clientData;
- LOCK_NOTIFIER;
+ if (tclNotifierHooks.alertNotifierProc) {
+ tclNotifierHooks.alertNotifierProc(clientData);
+ return;
+ }
+
+ LOCK_NOTIFIER_TSD;
if (tsdPtr->runLoop) {
- tsdPtr->eventReady = 1;
CFRunLoopSourceSignal(tsdPtr->runLoopSource);
CFRunLoopWakeUp(tsdPtr->runLoop);
}
- UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_TSD;
}
/*
@@ -420,32 +809,73 @@ Tcl_AlertNotifier(clientData)
*
* Tcl_SetTimer --
*
- * This function sets the current notifier timer value. This interface is
- * not implemented in this notifier because we are always running inside
- * of Tcl_DoOneEvent.
+ * This function sets the current notifier timer value.
*
* Results:
* None.
*
* Side effects:
- * None.
+ * Replaces any previous timer.
*
*----------------------------------------------------------------------
*/
void
-Tcl_SetTimer(timePtr)
- Tcl_Time *timePtr; /* Timeout value, may be NULL. */
+Tcl_SetTimer(
+ const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
- /*
- * The interval timer doesn't do anything in this implementation, because
- * the only event loop is via Tcl_DoOneEvent, which passes timeout values
- * to Tcl_WaitForEvent.
- */
+ ThreadSpecificData *tsdPtr;
+ CFRunLoopTimerRef runLoopTimer;
+ CFTimeInterval waitTime;
+
+ if (tclNotifierHooks.setTimerProc) {
+ tclNotifierHooks.setTimerProc(timePtr);
+ return;
+ }
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ runLoopTimer = tsdPtr->runLoopTimer;
+ if (!runLoopTimer) {
+ return;
+ }
+ if (timePtr) {
+ Tcl_Time vTime = *timePtr;
- if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
- tclStubs.tcl_SetTimer(timePtr);
+ if (vTime.sec != 0 || vTime.usec != 0) {
+ tclScaleTimeProcPtr(&vTime, tclTimeClientData);
+ waitTime = vTime.sec + 1.0e-6 * vTime.usec;
+ } else {
+ waitTime = 0;
+ }
+ } else {
+ waitTime = CF_TIMEINTERVAL_FOREVER;
}
+ tsdPtr->waitTime = waitTime;
+ CFRunLoopTimerSetNextFireDate(runLoopTimer,
+ CFAbsoluteTimeGetCurrent() + waitTime);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerWakeUp --
+ *
+ * CFRunLoopTimer callback.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerWakeUp(
+ CFRunLoopTimerRef timer,
+ void *info)
+{
}
/*
@@ -465,10 +895,32 @@ Tcl_SetTimer(timePtr)
*/
void
-Tcl_ServiceModeHook(mode)
- int mode; /* Either TCL_SERVICE_ALL, or
+Tcl_ServiceModeHook(
+ int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
+ ThreadSpecificData *tsdPtr;
+
+ if (tclNotifierHooks.serviceModeHookProc) {
+ tclNotifierHooks.serviceModeHookProc(mode);
+ return;
+ }
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) {
+ if (!tsdPtr->runLoop) {
+ Tcl_Panic("Tcl_ServiceModeHook: Notifier not initialized");
+ }
+ tsdPtr->runLoopTimer = CFRunLoopTimerCreate(NULL,
+ CFAbsoluteTimeGetCurrent() + CF_TIMEINTERVAL_FOREVER,
+ CF_TIMEINTERVAL_FOREVER, 0, 0, TimerWakeUp, NULL);
+ if (tsdPtr->runLoopTimer) {
+ CFRunLoopAddTimer(tsdPtr->runLoop, tsdPtr->runLoopTimer,
+ kCFRunLoopCommonModes);
+ StartNotifierThread();
+ }
+ }
}
/*
@@ -488,25 +940,26 @@ Tcl_ServiceModeHook(mode)
*/
void
-Tcl_CreateFileHandler(fd, mask, proc, clientData)
- int fd; /* Handle of stream to watch. */
- int mask; /* OR'ed combination of TCL_READABLE,
+Tcl_CreateFileHandler(
+ int fd, /* Handle of stream to watch. */
+ int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
- Tcl_FileProc *proc; /* Function to call for each
- * selected event. */
- ClientData clientData; /* Arbitrary data to pass to proc. */
+ Tcl_FileProc *proc, /* Function to call for each selected
+ * event. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr;
FileHandler *filePtr;
- if (tclStubs.tcl_CreateFileHandler !=
- tclOriginalNotifier.createFileHandlerProc) {
- tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);
+ if (tclNotifierHooks.createFileHandlerProc) {
+ tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
return;
}
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
filePtr = filePtr->nextPtr) {
if (filePtr->fd == fd) {
@@ -514,7 +967,7 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData)
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr = ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
@@ -528,24 +981,26 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData)
* Update the check masks for this file.
*/
+ LOCK_NOTIFIER_TSD;
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.exceptional);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_CLR(fd, &tsdPtr->checkMasks.exceptional);
}
if (tsdPtr->numFdBits <= fd) {
tsdPtr->numFdBits = fd+1;
}
+ UNLOCK_NOTIFIER_TSD;
}
/*
@@ -565,26 +1020,28 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData)
*/
void
-Tcl_DeleteFileHandler(fd)
- int fd; /* Stream id for which to remove callback
+Tcl_DeleteFileHandler(
+ int fd) /* Stream id for which to remove callback
* function. */
{
FileHandler *filePtr, *prevPtr;
- int i;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int i, numFdBits;
+ ThreadSpecificData *tsdPtr;
- if (tclStubs.tcl_DeleteFileHandler !=
- tclOriginalNotifier.deleteFileHandlerProc) {
- tclStubs.tcl_DeleteFileHandler(fd);
+ if (tclNotifierHooks.deleteFileHandlerProc) {
+ tclNotifierHooks.deleteFileHandlerProc(fd);
return;
}
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ numFdBits = -1;
+
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
@@ -594,35 +1051,41 @@ Tcl_DeleteFileHandler(fd)
}
/*
- * Update the check masks for this file.
- */
-
- if (filePtr->mask & TCL_READABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.readable));
- }
- if (filePtr->mask & TCL_WRITABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.writable));
- }
- if (filePtr->mask & TCL_EXCEPTION) {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
- }
-
- /*
* Find current max fd.
*/
if (fd+1 == tsdPtr->numFdBits) {
- tsdPtr->numFdBits = 0;
+ 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))) {
- tsdPtr->numFdBits = i+1;
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.writable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
+ numFdBits = i+1;
break;
}
}
}
+ LOCK_NOTIFIER_TSD;
+ if (numFdBits != -1) {
+ tsdPtr->numFdBits = numFdBits;
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ if (filePtr->mask & TCL_READABLE) {
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ FD_CLR(fd, &tsdPtr->checkMasks.exceptional);
+ }
+ UNLOCK_NOTIFIER_TSD;
+
/*
* Clean up information in the callback record.
*/
@@ -632,7 +1095,7 @@ Tcl_DeleteFileHandler(fd)
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
- ckfree((char *) filePtr);
+ ckfree(filePtr);
}
/*
@@ -658,9 +1121,9 @@ Tcl_DeleteFileHandler(fd)
*/
static int
-FileHandlerEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to handle,
+FileHandlerEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to handle,
* such as TCL_FILE_EVENTS. */
{
int mask;
@@ -701,7 +1164,18 @@ FileHandlerEventProc(evPtr, flags)
mask = filePtr->readyMask & filePtr->mask;
filePtr->readyMask = 0;
if (mask != 0) {
- (*filePtr->proc)(filePtr->clientData, mask);
+ LOCK_NOTIFIER_TSD;
+ if (mask & TCL_READABLE) {
+ FD_CLR(filePtr->fd, &tsdPtr->readyMasks.readable);
+ }
+ if (mask & TCL_WRITABLE) {
+ FD_CLR(filePtr->fd, &tsdPtr->readyMasks.writable);
+ }
+ if (mask & TCL_EXCEPTION) {
+ FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional);
+ }
+ UNLOCK_NOTIFIER_TSD;
+ filePtr->proc(filePtr->clientData, mask);
}
break;
}
@@ -718,167 +1192,540 @@ FileHandlerEventProc(evPtr, flags)
* polls without blocking.
*
* Results:
- * Returns -1 if the select would block forever, otherwise returns 0.
+ * Returns 0 if a tcl event or timeout ocurred and 1 if a non-tcl
+ * CFRunLoop source was processed.
*
* Side effects:
- * Queues file events that are detected by the select.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-Tcl_WaitForEvent(timePtr)
- Tcl_Time *timePtr; /* Maximum block time, or NULL. */
+Tcl_WaitForEvent(
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
- FileHandler *filePtr;
- FileHandlerEvent *fileEvPtr;
- int mask;
- Tcl_Time myTime;
- int waitForFiles;
- Tcl_Time *myTimePtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int result, polling, runLoopRunning;
+ CFTimeInterval waitTime;
+ SInt32 runLoopStatus;
+ ThreadSpecificData *tsdPtr;
+
+ if (tclNotifierHooks.waitForEventProc) {
+ return tclNotifierHooks.waitForEventProc(timePtr);
+ }
+ result = -1;
+ polling = 0;
+ waitTime = CF_TIMEINTERVAL_FOREVER;
+ tsdPtr = TCL_TSD_INIT(&dataKey);
- if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
- return tclStubs.tcl_WaitForEvent(timePtr);
+ if (!tsdPtr->runLoop) {
+ Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
}
- if (timePtr != NULL) {
+ if (timePtr) {
+ Tcl_Time vTime = *timePtr;
+
/*
* 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.
*/
- myTime.sec = timePtr->sec;
- myTime.usec = timePtr->usec;
+ if (vTime.sec != 0 || vTime.usec != 0) {
+ tclScaleTimeProcPtr(&vTime, tclTimeClientData);
+ waitTime = vTime.sec + 1.0e-6 * vTime.usec;
+ } else {
+ /*
+ * Polling: pretend to wait for files and tell the notifier thread
+ * what we are doing. The notifier thread makes sure it goes
+ * through select with its select mask in the same state as ours
+ * currently is. We block until that happens.
+ */
- if (myTime.sec != 0 || myTime.usec != 0) {
- (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
+ polling = 1;
}
+ }
- myTimePtr = &myTime;
- } else {
- myTimePtr = NULL;
+ StartNotifierThread();
+
+ LOCK_NOTIFIER_TSD;
+ tsdPtr->polling = polling;
+ UNLOCK_NOTIFIER_TSD;
+ tsdPtr->runLoopSourcePerformed = 0;
+
+ /*
+ * If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was
+ * called recursively) or is servicing events via the runloop observer,
+ * re-run it in a custom runloop mode containing only the source for the
+ * notifier thread, otherwise wakeups from other sources added to the
+ * common runloop modes might get lost or 3rd party event handlers might
+ * get called when they do not expect to be.
+ */
+
+ runLoopRunning = tsdPtr->runLoopRunning;
+ tsdPtr->runLoopRunning = 1;
+ runLoopStatus = CFRunLoopRunInMode(tsdPtr->runLoopServicingEvents ||
+ runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
+ waitTime, TRUE);
+ tsdPtr->runLoopRunning = runLoopRunning;
+
+ LOCK_NOTIFIER_TSD;
+ tsdPtr->polling = 0;
+ UNLOCK_NOTIFIER_TSD;
+ switch (runLoopStatus) {
+ case kCFRunLoopRunFinished:
+ Tcl_Panic("Tcl_WaitForEvent: CFRunLoop finished");
+ break;
+ case kCFRunLoopRunTimedOut:
+ QueueFileEvents(tsdPtr);
+ result = 0;
+ break;
+ case kCFRunLoopRunStopped:
+ case kCFRunLoopRunHandledSource:
+ result = tsdPtr->runLoopSourcePerformed ? 0 : 1;
+ break;
}
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueFileEvents --
+ *
+ * CFRunLoopSource callback for queueing file events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueFileEvents(
+ void *info)
+{
+ SelectMasks readyMasks;
+ FileHandler *filePtr;
+ ThreadSpecificData *tsdPtr = info;
+
/*
- * Place this thread on the list of interested threads, signal the
- * notifier thread, and wait for a response or a timeout.
+ * Queue all detected file events.
*/
- LOCK_NOTIFIER;
+ LOCK_NOTIFIER_TSD;
+ FD_COPY(&tsdPtr->readyMasks.readable, &readyMasks.readable);
+ FD_COPY(&tsdPtr->readyMasks.writable, &readyMasks.writable);
+ FD_COPY(&tsdPtr->readyMasks.exceptional, &readyMasks.exceptional);
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exceptional);
+ UNLOCK_NOTIFIER_TSD;
+ tsdPtr->runLoopSourcePerformed = 1;
- waitForFiles = (tsdPtr->numFdBits > 0);
- if (myTimePtr != NULL && myTimePtr->sec == 0 && myTimePtr->usec == 0) {
- /*
- * Cannot emulate a polling select with a polling condition variable.
- * Instead, pretend to wait for files and tell the notifier thread
- * what we are doing. The notifier thread makes sure it goes through
- * select with its select mask in the same state as ours currently is.
- * We block until that happens.
- */
+ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
+ filePtr = filePtr->nextPtr) {
+ int mask = 0;
- waitForFiles = 1;
- tsdPtr->pollState = POLL_WANT;
- myTimePtr = NULL;
- } else {
- tsdPtr->pollState = 0;
- }
+ if (FD_ISSET(filePtr->fd, &readyMasks.readable)) {
+ mask |= TCL_READABLE;
+ }
+ if (FD_ISSET(filePtr->fd, &readyMasks.writable)) {
+ mask |= TCL_WRITABLE;
+ }
+ if (FD_ISSET(filePtr->fd, &readyMasks.exceptional)) {
+ mask |= TCL_EXCEPTION;
+ }
+ if (!mask) {
+ continue;
+ }
- if (waitForFiles) {
/*
- * Add the ThreadSpecificData structure of this thread to the list of
- * ThreadSpecificData structures of all threads that are waiting on
- * file events.
+ * Don't bother to queue an event if the mask was previously non-zero
+ * since an event must still be on the queue.
*/
- tsdPtr->nextPtr = waitingListPtr;
- if (waitingListPtr) {
- waitingListPtr->prevPtr = tsdPtr;
- }
- tsdPtr->prevPtr = 0;
- waitingListPtr = tsdPtr;
- tsdPtr->onList = 1;
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
- write(triggerPipe, "", 1);
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask = mask;
}
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateWaitingListAndServiceEvents --
+ *
+ * CFRunLoopObserver callback for updating waitingList and
+ * servicing Tcl events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- FD_ZERO(&(tsdPtr->readyMasks.readable));
- FD_ZERO(&(tsdPtr->readyMasks.writable));
- FD_ZERO(&(tsdPtr->readyMasks.exceptional));
+static void
+UpdateWaitingListAndServiceEvents(
+ CFRunLoopObserverRef observer,
+ CFRunLoopActivity activity,
+ void *info)
+{
+ ThreadSpecificData *tsdPtr = info;
- if (!tsdPtr->eventReady) {
- CFTimeInterval waitTime;
+ if (tsdPtr->sleeping) {
+ return;
+ }
+ switch (activity) {
+ case kCFRunLoopEntry:
+ tsdPtr->runLoopNestingLevel++;
+ if (tsdPtr->numFdBits > 0 || tsdPtr->polling) {
+ LOCK_NOTIFIER;
+ if (!OnOffWaitingList(tsdPtr, 1, 1) && tsdPtr->polling) {
+ write(triggerPipe, "", 1);
+ }
+ UNLOCK_NOTIFIER;
+ }
+ break;
+ case kCFRunLoopExit:
+ if (tsdPtr->runLoopNestingLevel == 1) {
+ LOCK_NOTIFIER;
+ OnOffWaitingList(tsdPtr, 0, 1);
+ UNLOCK_NOTIFIER;
+ }
+ tsdPtr->runLoopNestingLevel--;
+ break;
+ case kCFRunLoopBeforeWaiting:
+ if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
+ (tsdPtr->runLoopNestingLevel > 1
+ || !tsdPtr->runLoopRunning)) {
+ tsdPtr->runLoopServicingEvents = 1;
+ while (Tcl_ServiceAll() && tsdPtr->waitTime == 0) {}
+ tsdPtr->runLoopServicingEvents = 0;
+ }
+ break;
+ default:
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OnOffWaitingList --
+ *
+ * Add/remove the specified thread to/from the global waitingList and
+ * optionally signal the notifier.
+ *
+ * !!! Requires notifierLock to be held !!!
+ *
+ * Results:
+ * Boolean indicating whether the waitingList was changed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if (myTimePtr == NULL) {
- waitTime = 1.0e10; /* Wait forever, as per CFRunLoop.c */
+static int
+OnOffWaitingList(
+ ThreadSpecificData *tsdPtr,
+ int onList,
+ int signalNotifier)
+{
+ int changeWaitingList;
+
+#ifdef TCL_MAC_DEBUG_NOTIFIER
+ if (SpinLockTry(&notifierLock)) {
+ Tcl_Panic("OnOffWaitingList: notifierLock unlocked");
+ }
+#endif
+ changeWaitingList = (!onList ^ !tsdPtr->onList);
+ if (changeWaitingList) {
+ if (onList) {
+ tsdPtr->nextPtr = waitingListPtr;
+ if (waitingListPtr) {
+ waitingListPtr->prevPtr = tsdPtr;
+ }
+ tsdPtr->prevPtr = NULL;
+ waitingListPtr = tsdPtr;
+ tsdPtr->onList = 1;
} else {
- waitTime = myTimePtr->sec + 1.0e-6 * myTimePtr->usec;
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ }
+ if (signalNotifier) {
+ write(triggerPipe, "", 1);
}
- UNLOCK_NOTIFIER;
- CFRunLoopRunInMode(kCFRunLoopDefaultMode, waitTime, TRUE);
- LOCK_NOTIFIER;
}
- tsdPtr->eventReady = 0;
- if (waitForFiles && tsdPtr->onList) {
- /*
- * Remove the ThreadSpecificData structure of this thread from the
- * waiting list. Alert the notifier thread to recompute its select
- * masks - skipping this caused a hang when trying to close a pipe
- * which the notifier thread was still doing a select on.
- */
+ return changeWaitingList;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Sleep --
+ *
+ * Delay execution for the specified number of milliseconds.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
- if (tsdPtr->prevPtr) {
- tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
- } else {
- waitingListPtr = tsdPtr->nextPtr;
+void
+Tcl_Sleep(
+ int ms) /* Number of milliseconds to sleep. */
+{
+ Tcl_Time vdelay;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (ms <= 0) {
+ return;
+ }
+
+ /*
+ * TIP #233: Scale from virtual time to real-time.
+ */
+
+ vdelay.sec = ms / 1000;
+ vdelay.usec = (ms % 1000) * 1000;
+ tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
+
+
+ if (tsdPtr->runLoop) {
+ CFTimeInterval waitTime;
+ CFRunLoopTimerRef runLoopTimer = tsdPtr->runLoopTimer;
+ CFAbsoluteTime nextTimerFire = 0, waitEnd, now;
+ SInt32 runLoopStatus;
+
+ waitTime = vdelay.sec + 1.0e-6 * vdelay.usec;
+ now = CFAbsoluteTimeGetCurrent();
+ waitEnd = now + waitTime;
+
+ if (runLoopTimer) {
+ nextTimerFire = CFRunLoopTimerGetNextFireDate(runLoopTimer);
+ if (nextTimerFire < waitEnd) {
+ CFRunLoopTimerSetNextFireDate(runLoopTimer, now +
+ CF_TIMEINTERVAL_FOREVER);
+ } else {
+ runLoopTimer = NULL;
+ }
+ }
+ tsdPtr->sleeping = 1;
+ do {
+ runLoopStatus = CFRunLoopRunInMode(kCFRunLoopDefaultMode,
+ waitTime, FALSE);
+ switch (runLoopStatus) {
+ case kCFRunLoopRunFinished:
+ Tcl_Panic("Tcl_Sleep: CFRunLoop finished");
+ break;
+ case kCFRunLoopRunStopped:
+ TclMacOSXNotifierDbgMsg("CFRunLoop stopped");
+ waitTime = waitEnd - CFAbsoluteTimeGetCurrent();
+ break;
+ case kCFRunLoopRunTimedOut:
+ waitTime = 0;
+ break;
+ }
+ } while (waitTime > 0);
+ tsdPtr->sleeping = 0;
+ if (runLoopTimer) {
+ CFRunLoopTimerSetNextFireDate(runLoopTimer, nextTimerFire);
}
- if (tsdPtr->nextPtr) {
- tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ } else {
+ struct timespec waitTime;
+
+ waitTime.tv_sec = vdelay.sec;
+ waitTime.tv_nsec = vdelay.usec * 1000;
+ while (nanosleep(&waitTime, &waitTime));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnixWaitForFile --
+ *
+ * This function waits synchronously for a file to become readable or
+ * writable, with an optional timeout.
+ *
+ * Results:
+ * The return value is an OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
+ * present on file at the time of the return. This function will not
+ * return until either "timeout" milliseconds have elapsed or at least
+ * one of the conditions given by mask has occurred for file (a return
+ * value of 0 means that a timeout occurred). No normal events will be
+ * serviced during the execution of this function.
+ *
+ * Side effects:
+ * Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUnixWaitForFile(
+ int fd, /* Handle for file on which to wait. */
+ int mask, /* What to wait for: OR'ed combination of
+ * TCL_READABLE, TCL_WRITABLE, and
+ * TCL_EXCEPTION. */
+ int timeout) /* Maximum amount of time to wait for one of
+ * the conditions in mask to occur, in
+ * milliseconds. A value of 0 means don't wait
+ * at all, and a value of -1 means wait
+ * forever. */
+{
+ Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
+ struct timeval blockTime, *timeoutPtr;
+ int numFound, result = 0;
+ fd_set readableMask;
+ fd_set writableMask;
+ fd_set exceptionalMask;
+
+#define SET_BITS(var, bits) ((var) |= (bits))
+#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
+
+#ifndef _DARWIN_C_SOURCE
+ /*
+ * Sanity check fd.
+ */
+
+ if (fd >= FD_SETSIZE) {
+ Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
+ /* must never get here, or select masks overrun will occur below */
+ }
+#endif
+
+ /*
+ * If there is a non-zero finite timeout, compute the time when we give
+ * up.
+ */
+
+ if (timeout > 0) {
+ Tcl_GetTime(&now);
+ abortTime.sec = now.sec + timeout/1000;
+ abortTime.usec = now.usec + (timeout%1000)*1000;
+ if (abortTime.usec >= 1000000) {
+ abortTime.usec -= 1000000;
+ abortTime.sec += 1;
}
- tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
- tsdPtr->onList = 0;
- write(triggerPipe, "", 1);
+ timeoutPtr = &blockTime;
+ } else if (timeout == 0) {
+ timeoutPtr = &blockTime;
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ } else {
+ timeoutPtr = NULL;
}
/*
- * Queue all detected file events before returning.
+ * Initialize the select masks.
*/
- for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
- filePtr = filePtr->nextPtr) {
+ FD_ZERO(&readableMask);
+ FD_ZERO(&writableMask);
+ FD_ZERO(&exceptionalMask);
- mask = 0;
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) {
- mask |= TCL_READABLE;
+ /*
+ * Loop in a mini-event loop of our own, waiting for either the file to
+ * become ready or a timeout to occur.
+ */
+
+ while (1) {
+ if (timeout > 0) {
+ blockTime.tv_sec = abortTime.sec - now.sec;
+ blockTime.tv_usec = abortTime.usec - now.usec;
+ if (blockTime.tv_usec < 0) {
+ blockTime.tv_sec -= 1;
+ blockTime.tv_usec += 1000000;
+ }
+ if (blockTime.tv_sec < 0) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ }
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) {
- mask |= TCL_WRITABLE;
+
+ /*
+ * Setup the select masks for the fd.
+ */
+
+ if (mask & TCL_READABLE) {
+ FD_SET(fd, &readableMask);
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) {
- mask |= TCL_EXCEPTION;
+ if (mask & TCL_WRITABLE) {
+ FD_SET(fd, &writableMask);
+ }
+ if (mask & TCL_EXCEPTION) {
+ FD_SET(fd, &exceptionalMask);
}
- if (!mask) {
+ /*
+ * Wait for the event or a timeout.
+ */
+
+ numFound = select(fd + 1, &readableMask, &writableMask,
+ &exceptionalMask, timeoutPtr);
+ if (numFound == 1) {
+ if (FD_ISSET(fd, &readableMask)) {
+ SET_BITS(result, TCL_READABLE);
+ }
+ if (FD_ISSET(fd, &writableMask)) {
+ SET_BITS(result, TCL_WRITABLE);
+ }
+ if (FD_ISSET(fd, &exceptionalMask)) {
+ SET_BITS(result, TCL_EXCEPTION);
+ }
+ result &= mask;
+ if (result) {
+ break;
+ }
+ }
+ if (timeout == 0) {
+ break;
+ }
+ if (timeout < 0) {
continue;
}
/*
- * Don't bother to queue an event if the mask was previously non-zero
- * since an event must still be on the queue.
+ * The select returned early, so we need to recompute the timeout.
*/
- if (filePtr->readyMask == 0) {
- fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
- fileEvPtr->header.proc = FileHandlerEventProc;
- fileEvPtr->fd = filePtr->fd;
- Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ Tcl_GetTime(&now);
+ if ((abortTime.sec < now.sec)
+ || (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
+ break;
}
- filePtr->readyMask = mask;
}
- UNLOCK_NOTIFIER;
- return 0;
+ return result;
}
/*
@@ -906,15 +1753,12 @@ Tcl_WaitForEvent(timePtr)
*/
static void
-NotifierThreadProc(clientData)
- ClientData clientData; /* Not used. */
+NotifierThreadProc(
+ ClientData clientData) /* Not used. */
{
ThreadSpecificData *tsdPtr;
- fd_set readableMask;
- fd_set writableMask;
- fd_set exceptionalMask;
- int i, numFdBits = 0;
- long found;
+ fd_set readableMask, writableMask, exceptionalMask;
+ int i, numFdBits = 0, polling;
struct timeval poll = {0., 0.}, *timePtr;
char buf[2];
@@ -932,30 +1776,27 @@ NotifierThreadProc(clientData)
* notifiers.
*/
- LOCK_NOTIFIER;
timePtr = NULL;
+ LOCK_NOTIFIER;
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ LOCK_NOTIFIER_TSD;
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))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
FD_SET(i, &exceptionalMask);
}
}
if (tsdPtr->numFdBits > numFdBits) {
numFdBits = tsdPtr->numFdBits;
}
- if (tsdPtr->pollState & POLL_WANT) {
- /*
- * Here we make sure we go through select() with the same mask
- * bits that were present when the thread tried to poll.
- */
-
- tsdPtr->pollState |= POLL_DONE;
+ polling = tsdPtr->polling;
+ UNLOCK_NOTIFIER_TSD;
+ if ((tsdPtr->polled = polling)) {
timePtr = &poll;
}
}
@@ -985,48 +1826,54 @@ NotifierThreadProc(clientData)
LOCK_NOTIFIER;
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
- found = 0;
+ int found = 0;
+ SelectMasks readyMasks, checkMasks;
+
+ LOCK_NOTIFIER_TSD;
+ FD_COPY(&tsdPtr->checkMasks.readable, &checkMasks.readable);
+ FD_COPY(&tsdPtr->checkMasks.writable, &checkMasks.writable);
+ FD_COPY(&tsdPtr->checkMasks.exceptional, &checkMasks.exceptional);
+ UNLOCK_NOTIFIER_TSD;
+ found = tsdPtr->polled;
+ FD_ZERO(&readyMasks.readable);
+ FD_ZERO(&readyMasks.writable);
+ FD_ZERO(&readyMasks.exceptional);
for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
+ if (FD_ISSET(i, &checkMasks.readable)
&& FD_ISSET(i, &readableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.readable));
+ FD_SET(i, &readyMasks.readable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))
+ if (FD_ISSET(i, &checkMasks.writable)
&& FD_ISSET(i, &writableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.writable));
+ FD_SET(i, &readyMasks.writable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))
+ if (FD_ISSET(i, &checkMasks.exceptional)
&& FD_ISSET(i, &exceptionalMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.exceptional));
+ FD_SET(i, &readyMasks.exceptional);
found = 1;
}
}
- if (found || (tsdPtr->pollState & POLL_DONE)) {
- tsdPtr->eventReady = 1;
- if (tsdPtr->onList) {
- /*
- * Remove the ThreadSpecificData structure of this thread
- * from the waiting list. This prevents us from
- * continuously spining on select until the other threads
- * runs and services the file event.
- */
-
- if (tsdPtr->prevPtr) {
- tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
- } else {
- waitingListPtr = tsdPtr->nextPtr;
- }
- if (tsdPtr->nextPtr) {
- tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
- }
- tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
- tsdPtr->onList = 0;
- tsdPtr->pollState = 0;
- }
+ if (found) {
+ /*
+ * Remove the ThreadSpecificData structure of this thread from
+ * the waiting list. This prevents us from spinning
+ * continuously on select until the other threads runs and
+ * services the file event.
+ */
+
+ OnOffWaitingList(tsdPtr, 0, 0);
+
+ LOCK_NOTIFIER_TSD;
+ FD_COPY(&readyMasks.readable, &tsdPtr->readyMasks.readable);
+ FD_COPY(&readyMasks.writable, &tsdPtr->readyMasks.writable);
+ FD_COPY(&readyMasks.exceptional,
+ &tsdPtr->readyMasks.exceptional);
+ UNLOCK_NOTIFIER_TSD;
+ tsdPtr->polled = 0;
if (tsdPtr->runLoop) {
CFRunLoopSourceSignal(tsdPtr->runLoopSource);
CFRunLoopWakeUp(tsdPtr->runLoop);
@@ -1055,8 +1902,129 @@ NotifierThreadProc(clientData)
}
}
}
- pthread_exit (0);
+ pthread_exit(0);
+}
+
+#ifdef HAVE_PTHREAD_ATFORK
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkPrepare --
+ *
+ * Lock the notifier in preparation for a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkPrepare(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ LOCK_NOTIFIER_INIT;
+ LOCK_NOTIFIER;
+ LOCK_NOTIFIER_TSD;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkParent --
+ *
+ * Unlock the notifier in the parent after a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkParent(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ UNLOCK_NOTIFIER_TSD;
+ UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_INIT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AtForkChild --
+ *
+ * Unlock and reinstall the notifier in the child after a fork.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AtForkChild(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ UNLOCK_NOTIFIER_TSD;
+ UNLOCK_NOTIFIER;
+ UNLOCK_NOTIFIER_INIT;
+ if (tsdPtr->runLoop) {
+ tsdPtr->runLoop = NULL;
+ if (!noCFafterFork) {
+ CFRunLoopSourceInvalidate(tsdPtr->runLoopSource);
+ CFRelease(tsdPtr->runLoopSource);
+ if (tsdPtr->runLoopTimer) {
+ CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer);
+ CFRelease(tsdPtr->runLoopTimer);
+ }
+ }
+ tsdPtr->runLoopSource = NULL;
+ tsdPtr->runLoopTimer = NULL;
+ }
+ if (notifierCount > 0) {
+ notifierCount = 1;
+ notifierThreadRunning = 0;
+
+ /*
+ * Assume that the return value of Tcl_InitNotifier in the child will
+ * be identical to the one stored as clientData in tclNotify.c's
+ * ThreadSpecificData by the parent's TclInitNotifier, so discard the
+ * return value here. This assumption may require the fork() to be
+ * executed in the main thread of the parent, otherwise
+ * Tcl_AlertNotifier may break in the child.
+ */
+
+ if (!noCFafterFork) {
+ Tcl_InitNotifier();
+ }
+ }
}
+#endif /* HAVE_PTHREAD_ATFORK */
+
+#else /* HAVE_COREFOUNDATION */
+
+void
+TclMacOSXNotifierAddRunLoopMode(
+ const void *runLoopMode)
+{
+ Tcl_Panic("TclMacOSXNotifierAddRunLoopMode: "
+ "Tcl not built with CoreFoundation support");
+}
+
#endif /* HAVE_COREFOUNDATION */
/*
diff --git a/pkgs/README b/pkgs/README
new file mode 100644
index 0000000..868bd4f
--- /dev/null
+++ b/pkgs/README
@@ -0,0 +1,57 @@
+
+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 determining 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..0d5dcf8
--- /dev/null
+++ b/pkgs/package.list.txt
@@ -0,0 +1,35 @@
+# 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 SQLite3
+sqlite SQLite3
+Sqlite3 SQLite3
+sqlite3 SQLite3
+
+# Thread
+Thread Thread
+thread Thread
+
+# Tcl Database Connectivity
+tdbc TDBC
+Tdbc TDBC
+TDBC TDBC
+# Drivers for TDBC
+Tdbcmysql tdbc::mysql
+tdbcmysql tdbc::mysql
+Tdbcodbc tdbc::odbc
+tdbcodbc tdbc::odbc
+Tdbcpostgres tdbc::postgres
+tdbcpostgres tdbc::postgres
+Tdbcsqlite3 tdbc::sqlite3
+tdbcsqlite3 tdbc::sqlite3
+Tdbcsqlite tdbc::sqlite3
+tdbcsqlite 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 f83536d..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.18 2004/10/30 02:16:52 dgp Exp $
+package prefer latest
package require Tcl 8.5
package require tcltest 2.2
namespace import tcltest::*
-configure {expand}$argv -testdir [file dir [info script]]
+configure {*}$argv -testdir [file dir [info script]]
runAllTests
+proc exit args {}
diff --git a/tests/append.test b/tests/append.test
index 58c0de7..69c6381 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -1,26 +1,24 @@
# Commands covered: append lappend
#
-# 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: append.test,v 1.7 2001/07/03 23:39:24 hobbs 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::*
}
-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} {
@@ -44,37 +42,37 @@ test append-2.1 {long appends} {
expr {$x == $y}
} 1
-test append-3.1 {append errors} {
- list [catch {append} msg] $msg
-} {1 {wrong # args: should be "append varName ?value value ...?"}}
-test append-3.2 {append errors} {
+test append-3.1 {append errors} -returnCodes error -body {
+ append
+} -result {wrong # args: should be "append varName ?value ...?"}
+test append-3.2 {append errors} -returnCodes error -body {
set x ""
- list [catch {append x(0) 44} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
-test append-3.3 {append errors} {
- catch {unset x}
- list [catch {append x} msg] $msg
-} {1 {can't read "x": no such variable}}
+ append x(0) 44
+} -result {can't set "x(0)": variable isn't array}
+test append-3.3 {append errors} -returnCodes error -body {
+ 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} {
set x ""
list [lappend x first] [lappend x second] [lappend x third] $x
} {first {first second} {first second third} {first second third}}
-test append-4.3 {lappend command} {
+test append-4.3 {lappend command} -body {
proc foo {} {
global x
set x old
unset x
lappend x new
}
- set result [foo]
+ foo
+} -cleanup {
rename foo {}
- set result
-} {new}
+} -result {new}
test append-4.4 {lappend command} {
set x {}
lappend x \{\ abc
@@ -95,22 +93,22 @@ test append-4.8 {lappend command} {
set x "\\\{"
lappend x abc
} "\\{ abc"
-test append-4.9 {lappend command} {
+test append-4.9 {lappend command} -returnCodes error -body {
set x " \{"
- list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.10 {lappend command} {
+ lappend x abc
+} -result {unmatched open brace in list}
+test append-4.10 {lappend command} -returnCodes error -body {
set x " \{"
- list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.11 {lappend command} {
+ lappend x abc
+} -result {unmatched open brace in list}
+test append-4.11 {lappend command} -returnCodes error -body {
set x "\{\{\{"
- list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.12 {lappend command} {
+ lappend x abc
+} -result {unmatched open brace in list}
+test append-4.12 {lappend command} -returnCodes error -body {
set x "x \{\{\{"
- list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
+ lappend x abc
+} -result {unmatched open brace in list}
test append-4.13 {lappend command} {
set x "x\{\{\{"
lappend x abc
@@ -128,55 +126,68 @@ 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
+test append-4.21 {lappend command} -returnCodes error -body {
+ set x \"
+ lappend x
+} -result {unmatched open quote in list}
+test append-4.22 {lappend command} -returnCodes error -body {
+ set x \"
+ lappend x abc
+} -result {unmatched open quote in list}
-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 append-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} {set i [expr $i+1]} {
+ 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 append-5.1 {long lappends} {
- catch {unset x}
+} -body {
set x ""
- for {set i 0} {$i < 300} {set i [expr $i+1]} {
+ for {set i 0} {$i < 300} {incr i} {
lappend x "item $i"
}
check $x 300
-} ok
+} -cleanup {
+ rename check {}
+} -result ok
-test append-6.1 {lappend errors} {
- list [catch {lappend} msg] $msg
-} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
-test append-6.2 {lappend errors} {
+test append-6.1 {lappend errors} -returnCodes error -body {
+ lappend
+} -result {wrong # args: should be "lappend varName ?value ...?"}
+test append-6.2 {lappend errors} -returnCodes error -body {
set x ""
- list [catch {lappend x(0) 44} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
+ lappend x(0) 44
+} -result {can't set "x(0)": variable isn't array}
-test append-7.1 {lappend-created var and error in trace on that var} {
+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}
catch {lappend x 1}
@@ -185,48 +196,111 @@ test append-7.1 {lappend-created var and error in trace on that var} {
set x
lappend x 1
list [info exists x] [catch {set x} msg] $msg
-} {0 1 {can't read "x": no such variable}}
-test append-7.2 {lappend var triggers read trace} {
- catch {unset myvar}
- catch {unset ::result}
+} -result {0 1 {can't read "x": no such variable}}
+test append-7.2 {lappend var triggers read trace} -setup {
+ unset -nocomplain myvar
+ unset -nocomplain ::result
+} -body {
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar a
- list [catch {set ::result} msg] $msg
-} {0 {myvar {} r}}
-test append-7.3 {lappend var triggers read trace, array var} {
- # The behavior of read triggers on lappend changed in 8.0 to
- # not trigger them, and was changed back in 8.4.
- catch {unset myvar}
- catch {unset ::result}
+ return $::result
+} -result {myvar {} r}
+test append-7.3 {lappend var triggers read trace, array var} -setup {
+ 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.
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
- list [catch {set ::result} msg] $msg
-} {0 {myvar b r}}
-test append-7.4 {lappend var triggers read trace, array var exists} {
- catch {unset myvar}
- catch {unset ::result}
+ return $::result
+} -result {myvar b r}
+test append-7.4 {lappend var triggers read trace, array var exists} -setup {
+ unset -nocomplain myvar
+ unset -nocomplain ::result
+} -body {
set myvar(0) 1
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
- list [catch {set ::result} msg] $msg
-} {0 {myvar b r}}
-test append-7.5 {append var does not trigger read trace} {
- catch {unset myvar}
- catch {unset ::result}
+ return $::result
+} -result {myvar b r}
+test append-7.5 {append var does not trigger read trace} -setup {
+ unset -nocomplain myvar
+ unset -nocomplain ::result
+} -body {
trace variable myvar r foo
proc foo {args} {append ::result $args}
append myvar a
info exists ::result
-} {0}
+} -result {0}
+# THERE ARE NO append-8.* TESTS
-catch {unset i x result y}
+# 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} -setup {
+ unset -nocomplain myvar
+} -body {
+ array set myvar {}
+ proc nonull {var key val} {
+ upvar 1 $var lvar
+ if {![info exists lvar($key)]} {
+ return -code error "no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ list [catch {
+ lappend myvar(key) "new value"
+ } msg] $msg
+} -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
+} -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
+ if {![info exists lvar($key)]} {
+ return -code error "no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ list [catch {
+ append myvar(key) "new value"
+ } msg] $msg
+} -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
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
+unset -nocomplain i x result y
catch {rename foo ""}
-catch {rename check ""}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/appendComp.test b/tests/appendComp.test
index c946d35..f85c3ba 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -1,29 +1,28 @@
# Commands covered: append lappend
#
-# 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: appendComp.test,v 1.9 2005/05/10 18:34:56 kennykb 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 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 ""
@@ -54,29 +53,29 @@ test appendComp-2.1 {long appends} {
foo
} 1
-test appendComp-3.1 {append errors} {
+test appendComp-3.1 {append errors} -returnCodes error -body {
proc foo {} {append}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "append varName ?value value ...?"}}
-test appendComp-3.2 {append errors} {
+ foo
+} -result {wrong # args: should be "append varName ?value ...?"}
+test appendComp-3.2 {append errors} -returnCodes error -body {
proc foo {} {
set x ""
append x(0) 44
}
- list [catch {foo} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
-test appendComp-3.3 {append errors} {
+ foo
+} -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
}
- list [catch {foo} msg] $msg
-} {1 {can't read "x": no such variable}}
+ foo
+} -result {can't read "x": no such variable}
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
@@ -134,34 +133,34 @@ test appendComp-4.8 {lappend command} {
}
foo
} "\\{ abc"
-test appendComp-4.9 {lappend command} {
+test appendComp-4.9 {lappend command} -returnCodes error -body {
proc foo {} {
set x " \{"
- list [catch {lappend x abc} msg] $msg
+ lappend x abc
}
foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.10 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.10 {lappend command} -returnCodes error -body {
proc foo {} {
set x " \{"
- list [catch {lappend x abc} msg] $msg
+ lappend x abc
}
foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.11 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.11 {lappend command} -returnCodes error -body {
proc foo {} {
set x "\{\{\{"
- list [catch {lappend x abc} msg] $msg
+ lappend x abc
}
foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.12 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.12 {lappend command} -returnCodes error -body {
proc foo {} {
set x "x \{\{\{"
- list [catch {lappend x abc} msg] $msg
+ lappend x abc
}
foo
-} {1 {unmatched open brace in list}}
+} -result {unmatched open brace in list}
test appendComp-4.13 {lappend command} {
proc foo {} {
set x "x\{\{\{"
@@ -207,45 +206,50 @@ 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} {
+test appendComp-6.1 {lappend errors} -returnCodes error -body {
proc foo {} {lappend}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
-test appendComp-6.2 {lappend errors} {
+ foo
+} -result {wrong # args: should be "lappend varName ?value ...?"}
+test appendComp-6.2 {lappend errors} -returnCodes error -body {
proc foo {} {
set x ""
lappend x(0) 44
}
- list [catch {foo} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
+ foo
+} -result {can't set "x(0)": variable isn't array}
-test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
+test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
+ catch {rename foo ""}
+ unset -nocomplain x
+} -body {
proc bar {} {
global x
- catch {rename foo ""}
- catch {unset x}
trace variable x w foo
proc foo {} {global x; unset x}
catch {lappend x 1}
@@ -256,100 +260,103 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
list [info exists x] [catch {set x} msg] $msg
}
bar
-} {0 1 {can't read "x": no such variable}}
-test appendComp-7.2 {lappend var triggers read trace, index var} {
+} -result {0 1 {can't read "x": no such variable}}
+test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
+ unset -nocomplain ::result
+} -body {
proc bar {} {
- catch {unset myvar}
- catch {unset ::result}
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar a
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {myvar {} r}}
-test appendComp-7.3 {lappend var triggers read trace, stack var} {
+} -result {myvar {} r} -constraints {bug-3057639}
+test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
+ unset -nocomplain ::result
+ unset -nocomplain ::myvar
+} -body {
proc bar {} {
- catch {unset ::myvar}
- catch {unset ::result}
trace variable ::myvar r foo
proc foo {args} {append ::result $args}
lappend ::myvar a
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {::myvar {} r}}
-test appendComp-7.4 {lappend var triggers read trace, array var} {
- # The behavior of read triggers on lappend changed in 8.0 to
- # not trigger them. Maybe not correct, but been there a while.
+} -result {::myvar {} r} -constraints {bug-3057639}
+test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
+ 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.
proc bar {} {
- catch {unset myvar}
- catch {unset ::result}
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {myvar b r}}
-test appendComp-7.5 {lappend var triggers read trace, array var} {
- # The behavior of read triggers on lappend changed in 8.0 to
- # not trigger them. Maybe not correct, but been there a while.
+} -result {myvar b r} -constraints {bug-3057639}
+test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
+ 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.
proc bar {} {
- catch {unset myvar}
- catch {unset ::result}
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar(b) a b
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {myvar b r}}
-test appendComp-7.6 {lappend var triggers read trace, array var exists} {
+} -result {myvar b r}
+test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
+ unset -nocomplain ::result
+} -body {
proc bar {} {
- catch {unset myvar}
- catch {unset ::result}
set myvar(0) 1
trace variable myvar r foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {myvar b r}}
-test appendComp-7.7 {lappend var triggers read trace, array stack var} {
+} -result {myvar b r} -constraints {bug-3057639}
+test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
+ unset -nocomplain ::myvar
+ unset -nocomplain ::result
+} -body {
proc bar {} {
- catch {unset ::myvar}
- catch {unset ::result}
trace variable ::myvar r foo
proc foo {args} {append ::result $args}
lappend ::myvar(b) a
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {::myvar b r}}
-test appendComp-7.8 {lappend var triggers read trace, array stack var} {
+} -result {::myvar b r} -constraints {bug-3057639}
+test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
+ unset -nocomplain ::myvar
+ unset -nocomplain ::result
+} -body {
proc bar {} {
- catch {unset ::myvar}
- catch {unset ::result}
trace variable ::myvar r foo
proc foo {args} {append ::result $args}
lappend ::myvar(b) a b
- list [catch {set ::result} msg] $msg
+ return $::result
}
bar
-} {0 {::myvar b r}}
-test appendComp-7.9 {append var does not trigger read trace} {
+} -result {::myvar b r}
+test appendComp-7.9 {append var does not trigger read trace} -setup {
+ unset -nocomplain ::result
+} -body {
proc bar {} {
- catch {unset myvar}
- catch {unset ::result}
trace variable myvar r foo
proc foo {args} {append ::result $args}
append myvar a
info exists ::result
}
bar
-} {0}
+} -result {0}
test appendComp-8.1 {defer error to runtime} -setup {
interp create slave
@@ -365,6 +372,73 @@ 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.
+
+# 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.
+
+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)]} {
+ return -code error "BOOM. no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ proc foo {} {
+ lappend ::myvar(key) "new value"
+ }
+ list [catch { foo } msg] $msg
+} -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
+} -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)]} {
+ return -code error "BOOM. no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ proc foo {} {
+ append ::myvar(key) "new value"
+ }
+ list [catch { foo } msg] $msg
+} -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
+} -cleanup {
+ unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
catch {unset i x result y}
catch {rename foo ""}
catch {rename bar ""}
@@ -374,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
new file mode 100644
index 0000000..ba19b81
--- /dev/null
+++ b/tests/apply.test
@@ -0,0 +1,321 @@
+# Commands covered: apply
+#
+# 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.
+# Copyright (c) 2005-2006 Miguel Sofer
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2.2
+ namespace import -force ::tcltest::*
+}
+
+if {[info commands ::apply] eq {}} {
+ return
+}
+
+testConstraint memory [llength [info commands memory]]
+
+# Tests for wrong number of arguments
+
+test apply-1.1 {too few arguments} -returnCodes error -body {
+ apply
+} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}
+
+# Tests for malformed lambda
+
+test apply-2.0 {malformed lambda} -returnCodes error -body {
+ set lambda a
+ apply $lambda
+} -result {can't interpret "a" as a lambda expression}
+test apply-2.1 {malformed lambda} -returnCodes error -body {
+ set lambda [list a b c d]
+ apply $lambda
+} -result {can't interpret "a b c d" as a lambda expression}
+test apply-2.2 {malformed lambda} {
+ set lambda [list {{}} boo]
+ list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {argument with no name} {argument with no name
+ (parsing lambda expression "{{}} boo")
+ invoked from within
+"apply $lambda"}}
+test apply-2.3 {malformed lambda} {
+ set lambda [list {{a b c}} boo]
+ list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c"
+ (parsing lambda expression "{{a b c}} boo")
+ invoked from within
+"apply $lambda"}}
+test apply-2.4 {malformed lambda} {
+ set lambda [list a(1) boo]
+ list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element
+ (parsing lambda expression "a(1) boo")
+ invoked from within
+"apply $lambda"}}
+test apply-2.5 {malformed lambda} {
+ set lambda [list a::b boo]
+ list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name
+ (parsing lambda expression "a::b boo")
+ invoked from within
+"apply $lambda"}}
+
+# Tests for runtime errors in the lambda expression
+
+test apply-3.1 {non-existing namespace} -body {
+ apply [list x {set x 1} ::NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.2 {non-existing namespace} -body {
+ namespace eval ::NONEXIST::FOR::SURE {}
+ set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
+ apply $lambda x
+ namespace delete ::NONEXIST
+ apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.3 {non-existing namespace} -body {
+ apply [list x {set x 1} NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.4 {non-existing namespace} -body {
+ namespace eval ::NONEXIST::FOR::SURE {}
+ set lambda [list x {set x 1} NONEXIST::FOR::SURE]
+ apply $lambda x
+ namespace delete ::NONEXIST
+ apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+
+test apply-4.1 {error in arguments to lambda expression} -body {
+ set lambda [list x {set x 1}]
+ apply $lambda
+} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
+test apply-4.2 {error in arguments to lambda expression} -body {
+ set lambda [list x {set x 1}]
+ apply $lambda a b
+} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
+test apply-4.3 {error in arguments to lambda expression} -body {
+ interp alias {} foo {} ::apply [list x {set x 1}]
+ foo a b
+} -cleanup {
+ rename foo {}
+} -returnCodes error -result {wrong # args: should be "foo x"}
+test apply-4.4 {error in arguments to lambda expression} -body {
+ interp alias {} foo {} ::apply [list x {set x 1}] a
+ foo b
+} -cleanup {
+ rename foo {}
+} -returnCodes error -result {wrong # args: should be "foo"}
+test apply-4.5 {error in arguments to lambda expression} -body {
+ set lambda [list x {set x 1}]
+ namespace eval a {
+ namespace ensemble create -command ::bar -map {id {::a::const foo}}
+ proc const val { return $val }
+ proc alias {object slot = command args} {
+ set map [namespace ensemble configure $object -map]
+ dict set map $slot [linsert $args 0 $command]
+ namespace ensemble configure $object -map $map
+ }
+ proc method {object name params body} {
+ set params [linsert $params 0 self]
+ alias $object $name = ::apply [list $params $body] $object
+ }
+ method ::bar boo x {return "[expr {$x*$x}] - $self"}
+ }
+ bar boo
+} -cleanup {
+ namespace delete ::a
+} -returnCodes error -result {wrong # args: should be "bar boo x"}
+
+test apply-5.1 {runtime error in lambda expression} {
+ set lambda [list {} {error foo}]
+ set res [catch {apply $lambda}]
+ list $res $::errorInfo
+} {1 {foo
+ while executing
+"error foo"
+ (lambda term "{} {error foo}" line 1)
+ invoked from within
+"apply $lambda"}}
+
+# Tests for correct execution; as the implementation is the same as that for
+# procs, the general functionality is mostly tested elsewhere
+
+test apply-6.1 {info level} {
+ set lev [info level]
+ set lambda [list {} {info level}]
+ expr {[apply $lambda] - $lev}
+} 1
+test apply-6.2 {info level} {
+ set lambda [list {} {info level 0}]
+ apply $lambda
+} {apply {{} {info level 0}}}
+test apply-6.3 {info level} {
+ set lambda [list args {info level 0}]
+ apply $lambda x y
+} {apply {args {info level 0}} x y}
+
+# Tests for correct namespace scope
+
+namespace eval ::testApply {
+ proc testApply args {return testApply}
+}
+
+test apply-7.1 {namespace access} {
+ set ::testApply::x 0
+ set body {set x 1; set x}
+ list [apply [list args $body ::testApply]] $::testApply::x
+} {1 0}
+test apply-7.2 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x}
+ list [apply [list args $body ::testApply]] $::testApply::x
+} {0 0}
+test apply-7.3 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x 1}
+ list [apply [list args $body ::testApply]] $::testApply::x
+} {1 1}
+test apply-7.4 {namespace access} {
+ set ::testApply::x 0
+ set body {testApply}
+ apply [list args $body ::testApply]
+} testApply
+test apply-7.5 {namespace access} {
+ set ::testApply::x 0
+ set body {set x 1; set x}
+ list [apply [list args $body testApply]] $::testApply::x
+} {1 0}
+test apply-7.6 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x}
+ list [apply [list args $body testApply]] $::testApply::x
+} {0 0}
+test apply-7.7 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x 1}
+ list [apply [list args $body testApply]] $::testApply::x
+} {1 1}
+test apply-7.8 {namespace access} {
+ set ::testApply::x 0
+ set body {testApply}
+ apply [list args $body testApply]
+} testApply
+
+# Tests for correct argument treatment
+
+set applyBody {
+ set res {}
+ foreach v [info locals] {
+ if {$v eq "res"} continue
+ lappend res [list $v [set $v]]
+ }
+ set res
+}
+
+test apply-8.1 {args treatment} {
+ apply [list args $applyBody] 1 2 3
+} {{args {1 2 3}}}
+test apply-8.2 {args treatment} {
+ apply [list {x args} $applyBody] 1 2
+} {{x 1} {args 2}}
+test apply-8.3 {args treatment} {
+ apply [list {x args} $applyBody] 1 2 3
+} {{x 1} {args {2 3}}}
+test apply-8.4 {default values} {
+ apply [list {{x 1} {y 2}} $applyBody]
+} {{x 1} {y 2}}
+test apply-8.5 {default values} {
+ apply [list {{x 1} {y 2}} $applyBody] 3 4
+} {{x 3} {y 4}}
+test apply-8.6 {default values} {
+ apply [list {{x 1} {y 2}} $applyBody] 3
+} {{x 3} {y 2}}
+test apply-8.7 {default values} {
+ apply [list {x {y 2}} $applyBody] 1
+} {{x 1} {y 2}}
+test apply-8.8 {default values} {
+ apply [list {x {y 2}} $applyBody] 1 3
+} {{x 1} {y 3}}
+test apply-8.9 {default values} {
+ apply [list {x {y 2} args} $applyBody] 1
+} {{x 1} {y 2} {args {}}}
+test apply-8.10 {default values} {
+ apply [list {x {y 2} args} $applyBody] 1 3
+} {{x 1} {y 3} {args {}}}
+
+# Tests for leaks
+
+test apply-9.1 {leaking internal rep} -setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+ set lam [list {} {set a 1}]
+} -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ ::apply [lrange $lam 0 end]
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ rename getbytes {}
+ unset -nocomplain lam end i tmp leakedBytes
+} -result 0
+test apply-9.2 {leaking internal rep} -setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ ::apply [list {} {set a 1}]
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ rename getbytes {}
+ unset -nocomplain end i tmp leakedBytes
+} -result 0
+test apply-9.3 {leaking internal rep} -setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set x [list {} {set a 1} ::NS::THAT::DOES::NOT::EXIST]
+ catch {::apply $x}
+ set x {}
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ rename getbytes {}
+ unset -nocomplain end i x tmp leakedBytes
+} -result 0
+
+# Tests for the avoidance of recompilation
+
+# cleanup
+
+namespace delete testApply
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/assemble.test b/tests/assemble.test
new file mode 100644
index 0000000..b0487e6
--- /dev/null
+++ b/tests/assemble.test
@@ -0,0 +1,3292 @@
+# 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
+"{}e"
+ ("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..edf55c4 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -10,13 +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: 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::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testgetassocdata [llength [info commands testgetassocdata]]
testConstraint testsetassocdata [llength [info commands testsetassocdata]]
@@ -35,15 +34,21 @@ test assocd-1.4 {testing setting assoc data} testsetassocdata {
testsetassocdata abc "abc d e f"
} ""
-test assocd-2.1 {testing getting assoc data} testgetassocdata {
- testgetassocdata a
-} 2
-test assocd-2.2 {testing getting assoc data} testgetassocdata {
- testgetassocdata 123
-} 456
-test assocd-2.3 {testing getting assoc data} testgetassocdata {
+test assocd-2.1 {testing getting assoc data} -setup {
+ testsetassocdata a 2
+} -constraints {testgetassocdata} -body {
+ testgetassocdata a
+} -result 2
+test assocd-2.2 {testing getting assoc data} -setup {
+ testsetassocdata 123 456
+} -constraints {testgetassocdata} -body {
+ testgetassocdata 123
+} -result 456
+test assocd-2.3 {testing getting assoc data} -setup {
+ testsetassocdata abc "abc d e f"
+} -constraints {testgetassocdata} -body {
testgetassocdata abc
-} {abc d e f}
+} -result "abc d e f"
test assocd-2.4 {testing getting assoc data} testgetassocdata {
testgetassocdata xxx
} ""
@@ -59,5 +64,5 @@ test assocd-3.3 {testing deleting assoc data} testdelassocdata {
} {0 {}}
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/async.test b/tests/async.test
index 969208c..cb67cc2 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -10,19 +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.8 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-testConstraint testasync [llength [info commands testasync]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
-tcltest::testConstraint threaded [expr {
- [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
-}]
+testConstraint testasync [llength [info commands testasync]]
+testConstraint threaded [::tcl::pkgconfig get threaded]
proc async1 {result code} {
global aresult acode
@@ -150,44 +148,25 @@ test async-3.1 {deleting handlers} testasync {
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
-proc nothing {} {
- # empty proc
-}
-proc hang1 {handle} {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- for {set i 0} {
- $i < 2500000 && $aresult eq "Async event not delivered"
- } {incr i} {
- nothing
- }
- return $aresult
-}
-proc hang2 {handle} {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- for {set i 0} {
- $i < 2500000 && $aresult eq "Async event not delivered"
- } {incr i} {}
- return $aresult
-}
-proc hang3 {handle} [concat {
- global aresult
- set aresult {Async event not delivered}
- testasync marklater $handle
- set i 0
-} [string repeat {;incr i;} 1500000] {
- return $aresult
-}]
-
test async-4.1 {async interrupting bytecode sequence} -constraints {
testasync threaded
} -setup {
set hm [testasync create async3]
+ proc nothing {} {
+ # empty proc
+ }
} -body {
- hang1 $hm
+ apply {{handle} {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ for {set i 0} {
+ $i < 2500000 && $aresult eq "Async event not delivered"
+ } {incr i} {
+ nothing
+ }
+ return $aresult
+ }} $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}
@@ -196,7 +175,15 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
} -setup {
set hm [testasync create async3]
} -body {
- hang2 $hm
+ apply {{handle} {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ for {set i 0} {
+ $i < 2500000 && $aresult eq "Async event not delivered"
+ } {incr i} {}
+ return $aresult
+ }} $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}
@@ -205,7 +192,14 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
} -setup {
set hm [testasync create async3]
} -body {
- hang3 $hm
+ apply [list {handle} [concat {
+ global aresult
+ set aresult {Async event not delivered}
+ testasync marklater $handle
+ set i 0
+ } "[string repeat {;incr i;} 1500000]after 10;" {
+ return $aresult
+ }]] $hm
} -result {test pattern} -cleanup {
testasync delete $hm
}
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 56e1ffb..4721553 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,125 @@ 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}"
+} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
+makeFile {
+namespace eval wok {
+ namespace ensemble create -subcommands {commands vars}
-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 commands {{pattern *}} {
+ puts [join [lsort -dictionary [info commands $pattern]] \n]
+ }
-proc ::pro::team {} {
- puts "go packers!"
- return true
-}
+ proc vars {{pattern *}} {
+ puts [join [lsort -dictionary [info vars $pattern]] \n]
+ }
-proc ::college::team {} {
- puts "go badgers!"
- return true
}
-} [file join pkg samename.tcl]
-
+} ensemblecommands.tcl
-test autoMkindex-4.1 {platform indenpendant source commands} {
+test autoMkindex-3.4 {ensemble commands in tclIndex} {
file delete tclIndex
- auto_mkindex . pkg/samename.tcl
+ auto_mkindex . ensemblecommands.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}]]]
+ set dat [list]
+ foreach r [split [string trim [read $f]] "\n"] {
+ if {[string match {set auto_index*} $r]} {
+ lappend dat $r
+ }
+ }
+ set result [lsort $dat]
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]
+} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}}
+removeFile ensemblecommands.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} {
+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]
+ 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 +364,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 2dc628d..1a0037c 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -14,12 +14,12 @@
#
# 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.40 2005/05/10 18:34:56 kennykb Exp $
-#
package require tcltest 2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
@@ -31,7 +31,7 @@ catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
-catch {unset x}
+unset -nocomplain x
test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
catch {interp delete test_interp}
@@ -155,7 +155,7 @@ test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespac
[namespace delete test_ns_basic]
} {:: {} 1 {invalid command name "cmd"} {} :: {}}
-test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and can not go to another namespace} {
+test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and cannot go to another namespace} {
catch {namespace delete test_ns_basic}
catch {rename cmd ""}
proc cmd {} { ;# note that this is global
@@ -182,7 +182,7 @@ test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and
[test_ns_basic::exposeCmdWorkAround] \
[test_ns_basic::newCmd] \
[namespace delete test_ns_basic]
-} {:: {} 1 {can not expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
+} {:: {} 1 {cannot expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
catch {rename p ""}
catch {rename cmd ""}
@@ -202,13 +202,13 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo
} {42 {} {} Hello {} {} 42}
test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [testcreatecommand create] \
[test_ns_basic::createdcommand] \
[testcreatecommand delete]
} {{} {CreatedCommandProc in ::test_ns_basic} {}}
test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename value:at: ""}
list [testcreatecommand create2] \
[value:at:] \
@@ -216,7 +216,7 @@ test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle
} {{} {CreatedCommandProc2 in ::} {}}
test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_basic {}
proc test_ns_basic::cmd {} { ;# proc requires that ns already exist
return [namespace current]
@@ -232,7 +232,7 @@ test basic-17.1 {TclInvokeObjCommand} {emptyTest} {
} {}
test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename cmd ""}
namespace eval test_ns_basic {
proc p {} {
@@ -244,11 +244,11 @@ test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace quali
[test_ns_basic::q]
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_basic {
proc p {} {
return "p in [namespace current]"
@@ -259,7 +259,7 @@ test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
[info commands test_ns_basic::*]
} {::test_ns_basic::p {} {}}
test basic-18.4 {TclRenameCommand, bad new name} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_basic {
proc p {} {
return "p in [namespace current]"
@@ -267,16 +267,26 @@ test basic-18.4 {TclRenameCommand, bad new name} {
}
rename test_ns_basic::p :::george::martha
} {}
-test basic-18.5 {TclRenameCommand, new name must not already exist} {
+test basic-18.5 {TclRenameCommand, new name must not already exist} -setup {
+ if {![llength [info commands :::george::martha]]} {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_basic {
+ proc p {} {
+ return "p in [namespace current]"
+ }
+ }
+ rename test_ns_basic::p :::george::martha
+ }
+} -body {
namespace eval test_ns_basic {
proc q {} {
return 42
}
}
list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
-} {1 {can't rename to ":::george::martha": command already exists}}
+} -result {1 {can't rename to ":::george::martha": command already exists}}
test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
proc p {} {
@@ -299,10 +309,10 @@ test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} {
} {}
test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
- catch {unset x}
+ unset -nocomplain x
set x [namespace eval test_ns_basic::test_ns_basic2 {
# the following creates a cmd in the global namespace
testcmdtoken create p
@@ -328,7 +338,7 @@ test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
} {}
test basic-22.1 {Tcl_GetCommandFullName} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_basic1 {
namespace export cmd*
proc cmd1 {} {}
@@ -355,7 +365,7 @@ test basic-23.1 {Tcl_DeleteCommand} {emptyTest} {
test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
catch {interp delete test_interp}
- catch {unset x}
+ unset -nocomplain x
interp create test_interp
interp eval test_interp {
proc useSet {} {
@@ -374,7 +384,7 @@ test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd
[interp delete test_interp]
} {123 {set called with a 123} {}}
test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
proc p {} {
return "global p"
@@ -392,7 +402,7 @@ test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command e
[test_ns_basic::callP]
} {{namespace p} {} {global p}}
test basic-24.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
namespace eval test_ns_basic {
namespace export p
@@ -427,7 +437,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
# string would have been freed, leaving garbage bytes for the error
# message.
set f [open $fName w]
- fileevent $f writable "fileevent $f writable {}; error foo"
+ chan event $f writable "chan event $f writable {}; error foo"
set x {}
vwait x
close $f
@@ -438,7 +448,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
rename myHandler {}
} -result "foo\n while executing\n\"error foo\""
-test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
+test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
#
# Follow the pure-list branch in a manner that
# a - the pure-list internal rep is destroyed by shimmering
@@ -455,9 +465,13 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
error "BAD CALL"
}
catch {eval $SRC}
-} 1
+} -result 1 -cleanup {
+ rename foo {}
+ rename $::SRC {}
+ unset ::SRC
+}
-test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
+test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
#
# Follow the pure-list branch in a manner that
# a - the pure-list internal rep is destroyed by shimmering
@@ -473,7 +487,11 @@ test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
info level 0
}
catch {eval $SRC}
-} 0
+} -result 0 -cleanup {
+ rename foo {}
+ rename $::SRC {}
+ unset ::SRC
+}
test basic-27.1 {Tcl_ExprLong} {emptyTest} {
} {}
@@ -494,7 +512,7 @@ test basic-32.1 {Tcl_ExprBooleanObj} {emptyTest} {
} {}
test basic-36.1 {Tcl_EvalObjv, lookup of "unknown" command} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {interp delete test_interp}
interp create test_interp
interp eval test_interp {
@@ -539,10 +557,10 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
catch {close $f}
set res [catch {
set f [open |[list [interpreter]] w+]
- fconfigure $f -buffering line
- puts $f {fconfigure stdout -buffering line}
+ chan configure $f -buffering line
+ puts $f {chan configure stdout -buffering line}
puts $f continue
- puts $f {puts $errorInfo}
+ puts $f {puts $::errorInfo}
puts $f {puts DONE}
set newMsg {}
set msg {}
@@ -623,8 +641,10 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup {
"return -code return"
(file "*BREAKtest" line 2)}
-test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body {
- subst {a[set b [format cd]}
+test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -constraints {
+ testevalex
+} -body {
+ testevalex {a[set b [format cd]}
} -returnCodes error -result {missing close-bracket}
# Some lists for expansion tests to work with
@@ -646,69 +666,69 @@ if $noComp {
}
test basic-47.2.$noComp {Tcl_EvalEx: error during word expansion} -body {
- run {{expand}\{}
+ run {{*}\{}
} -constraints $constraints -returnCodes error -result {unmatched open brace in list}
test basic-47.3.$noComp {Tcl_EvalEx, error during substitution} -body {
- run {{expand}[error foo]}
+ run {{*}[error foo]}
} -constraints $constraints -returnCodes error -result foo
test basic-47.4.$noComp {Tcl_EvalEx: no expansion} $constraints {
- run {list {expand} {expand} {expand}}
-} {expand expand expand}
+ run {list {*} {*} {*}}
+} {* * *}
test basic-47.5.$noComp {Tcl_EvalEx: expansion} $constraints {
- run {list {expand}{} {expand} {expand}x {expand}"y z"}
-} {expand x y z}
+ run {list {*}{} {*} {*}x {*}"y z"}
+} {* x y z}
test basic-47.6.$noComp {Tcl_EvalEx: expansion to zero args} $constraints {
- run {list {expand}{}}
+ run {list {*}{}}
} {}
test basic-47.7.$noComp {Tcl_EvalEx: expansion to one arg} $constraints {
- run {list {expand}x}
+ run {list {*}x}
} x
test basic-47.8.$noComp {Tcl_EvalEx: expansion to many args} $constraints {
- run {list {expand}"y z"}
+ run {list {*}"y z"}
} {y z}
test basic-47.9.$noComp {Tcl_EvalEx: expansion and subst order} $constraints {
set x 0
- run {list [incr x] {expand}[incr x] [incr x] \
- {expand}[list [incr x] [incr x]] [incr x]}
+ run {list [incr x] {*}[incr x] [incr x] \
+ {*}[list [incr x] [incr x]] [incr x]}
} {1 2 3 4 5 6}
test basic-47.10.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{} a b c d e f g h i j k l m n o p q r}
+ run {concat {*}{} a b c d e f g h i j k l m n o p q r}
} {a b c d e f g h i j k l m n o p q r}
test basic-47.11.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}1 a b c d e f g h i j k l m n o p q r}
+ run {concat {*}1 a b c d e f g h i j k l m n o p q r}
} {1 a b c d e f g h i j k l m n o p q r}
test basic-47.12.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r}
+ run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r}
} {1 2 a b c d e f g h i j k l m n o p q r}
test basic-47.13.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q}
+ run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q}
} {1 2 a b c d e f g h i j k l m n o p q}
test basic-47.14.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{} a b c d e f g h i j k l m n o p q r s}
+ run {concat {*}{} a b c d e f g h i j k l m n o p q r s}
} {a b c d e f g h i j k l m n o p q r s}
test basic-47.15.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}1 a b c d e f g h i j k l m n o p q r s}
+ run {concat {*}1 a b c d e f g h i j k l m n o p q r s}
} {1 a b c d e f g h i j k l m n o p q r s}
test basic-47.16.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r s}
+ run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r s}
} {1 2 a b c d e f g h i j k l m n o p q r s}
test basic-47.17.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
- run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q r}
+ run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q r}
} {1 2 a b c d e f g h i j k l m n o p q r}
test basic-48.1.$noComp {expansion: parsing} $constraints {
@@ -716,7 +736,7 @@ test basic-48.1.$noComp {expansion: parsing} $constraints {
# Another comment
list 1 2\
- 3 {expand}$::l1
+ 3 {*}$::l1
# Comment again
}
@@ -727,13 +747,13 @@ test basic-48.2.$noComp {no expansion} $constraints {
} {{a {b b} c d} {e f {g g} h} {i j k {l l}}}
test basic-48.3.$noComp {expansion} $constraints {
- run {list {expand}$::l1 $::l2 {expand}[l3]}
+ run {list {*}$::l1 $::l2 {*}[l3]}
} {a {b b} c d {e f {g g} h} i j k {l l}}
test basic-48.4.$noComp {expansion: really long cmd} $constraints {
set cmd [list list]
for {set t 0} {$t < 500} {incr t} {
- lappend cmd {{expand}$::l1}
+ lappend cmd {{*}$::l1}
}
llength [run [join $cmd]]
} 2000
@@ -741,31 +761,31 @@ test basic-48.4.$noComp {expansion: really long cmd} $constraints {
test basic-48.5.$noComp {expansion: error detection} -setup {
set l "a {a b}x y"
} -constraints $constraints -body {
- run {list $::l1 {expand}$l}
+ run {list $::l1 {*}$l}
} -cleanup {
unset l
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test basic-48.6.$noComp {expansion: odd usage} $constraints {
- run {list {expand}$::l1$::l2}
+ run {list {*}$::l1$::l2}
} {a {b b} c de f {g g} h}
test basic-48.7.$noComp {expansion: odd usage} -constraints $constraints -body {
- run {list {expand}[l3]$::l1}
+ run {list {*}[l3]$::l1}
} -returnCodes 1 -result {list element in braces followed by "a" instead of space}
test basic-48.8.$noComp {expansion: odd usage} $constraints {
- run {list {expand}hej$::l1}
+ run {list {*}hej$::l1}
} {heja {b b} c d}
-test basic-48.9.$noComp {expansion: Not all {expand} should trigger} $constraints {
- run {list {expand}$::l1 \{expand\}$::l2 "{expand}$::l1" {{expand} i j k}}
-} {a {b b} c d {{expand}e f {g g} h} {{expand}a {b b} c d} {{expand} i j k}}
+test basic-48.9.$noComp {expansion: Not all {*} should trigger} $constraints {
+ run {list {*}$::l1 \{*\}$::l2 "{*}$::l1" {{*} i j k}}
+} {a {b b} c d {{*}e f {g g} h} {{*}a {b b} c d} {{*} i j k}}
test basic-48.10.$noComp {expansion: expansion of command word} -setup {
set cmd [list string range jultomte]
} -constraints $constraints -body {
- run {{expand}$cmd 2 6}
+ run {{*}$cmd 2 6}
} -cleanup {
unset cmd
} -result ltomt
@@ -774,24 +794,24 @@ test basic-48.11.$noComp {expansion: expansion into nothing} -setup {
set cmd {}
set bar {}
} -constraints $constraints -body {
- run {{expand}$cmd {expand}$bar}
+ run {{*}$cmd {*}$bar}
} -cleanup {
unset cmd bar
} -result {}
test basic-48.12.$noComp {expansion: odd usage} $constraints {
- run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2}
+ run {list {*}$::l1 {*}"hej hopp" {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}
test basic-48.13.$noComp {expansion: odd usage} $constraints {
- run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2}
+ run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}
test basic-48.14.$noComp {expansion: hash command} -setup {
catch {rename \# ""}
set cmd "#"
} -constraints $constraints -body {
- run { {expand}$cmd apa bepa }
+ run { {*}$cmd apa bepa }
} -cleanup {
unset cmd
} -returnCodes 1 -result {invalid command name "#"}
@@ -802,7 +822,7 @@ test basic-48.15.$noComp {expansion: complex words} -setup {
set c [list {f\ g h\ i j k} x y]
set d {0\ 1 2 3}
} -constraints $constraints -body {
- run { lappend d {expand}$a($b) {expand}[lindex $c 0] }
+ run { lappend d {*}$a($b) {*}[lindex $c 0] }
} -cleanup {
unset a b c d
} -result {{0 1} 2 3 a {b c} d e {f g} {h i} j k}
@@ -820,25 +840,25 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
# Create free objects that should disappear
set l [list 1$a 2$a 3$a 4$a 5$a 6$a 7$a]
# A short number of words and a short result (8)
- set l [run {list {expand}$l $a$a}]
+ set l [run {list {*}$l $a$a}]
# A short number of words and a longer result (27)
- set l [run {list {expand}$l $a$a {expand}$l $a$a {expand}$l $a$a}]
+ set l [run {list {*}$l $a$a {*}$l $a$a {*}$l $a$a}]
# A short number of words and a longer result, with an error
# This is to stress the cleanup in the error case
- if {![catch {run {_moo_ {expand}$l $a$a {expand}$l $a$a {expand}$l}}]} {
+ if {![catch {run {_moo_ {*}$l $a$a {*}$l $a$a {*}$l}}]} {
error "An error was expected in the previous statement"
}
# Many words
- set l [run {list {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a {expand}$l $a$a \
- {expand}$l $a$a}]
+ set l [run {list {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a {*}$l $a$a \
+ {*}$l $a$a}]
if {[llength $l] != 19*28} {
error "Bad Length: [llength $l] should be [expr {19*28}]"
@@ -864,7 +884,7 @@ test basic-48.17.$noComp {expansion: object safety} -setup {
} -constraints $constraints -body {
set third [expr {1.0/3.0}]
set l [list $third $third]
- set x [run {list $third {expand}$l $third}]
+ set x [run {list $third {*}$l $third}]
set res [list]
foreach t $x {
lappend res [expr {$t * 3.0}]
@@ -881,7 +901,7 @@ test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -
set apa 10
}
set apa 0
- list [llength [run { {expand}$badcmd }]] $apa
+ list [llength [run { {*}$badcmd }]] $apa
} -cleanup {
unset apa badcmd
} -result {5 0}
@@ -890,38 +910,38 @@ test basic-48.19.$noComp {expansion: error checking order} -body {
set badlist "a {}x y"
set a 0
set b 0
- catch {run {list [incr a] {expand}$badlist [incr b]}}
+ catch {run {list [incr a] {*}$badlist [incr b]}}
list $a $b
} -constraints $constraints -cleanup {
unset badlist a b
} -result {1 0}
test basic-48.20.$noComp {expansion: odd case with word boundaries} $constraints {
- run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2}
+ run {list {*}$::l1 {*}"hej hopp" {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}
test basic-48.21.$noComp {expansion: odd case with word boundaries} $constraints {
- run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2}
+ run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}
test basic-48.22.$noComp {expansion: odd case with word boundaries} -body {
- run {list {expand}$::l1 {expand}"hej hopp {expand}$::l2}
+ run {list {*}$::l1 {*}"hej hopp {*}$::l2}
} -constraints $constraints -returnCodes error -result {missing "}
test basic-48.23.$noComp {expansion: handle return codes} -constraints $constraints -body {
set res {}
for {set t 0} {$t < 10} {incr t} {
- run { {expand}break }
+ run { {*}break }
}
lappend res $t
for {set t 0} {$t < 10} {incr t} {
- run { {expand}continue }
+ run { {*}continue }
set t 20
}
lappend res $t
- lappend res [catch { run { {expand}{error Hejsan} } } err]
+ lappend res [catch { run { {*}{error Hejsan} } } err]
lappend res $err
} -cleanup {
unset res t
@@ -955,13 +975,13 @@ rename l3 {}
rename run {}
#cleanup
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {namespace delete george}
catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
-catch {unset x}
-::tcltest::cleanupTests
+unset -nocomplain x
+cleanupTests
return
diff --git a/tests/binary.test b/tests/binary.test
index 26444f7..40b1315 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -1,52 +1,106 @@
-# This file tests the tclBinary.c file and the "binary" Tcl command.
+# This file tests the tclBinary.c file and the "binary" Tcl command.
#
-# 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: binary.test,v 1.23 2005/08/24 15:15:46 kennykb 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
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
-::tcltest::testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+
+# Big test for correct ordering of data in [expr]
+proc testIEEE {} {
+ variable ieeeValues
+ binary scan [binary format dd -1.0 1.0] c* c
+ switch -exact -- $c {
+ {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+ # little endian
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+ ieeeValues(-Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+ ieeeValues(-Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+ ieeeValues(-Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+ ieeeValues(+Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+ ieeeValues(+Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 1
+ return 1
+ }
+ {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+ binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Infinity)
+ binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Normal)
+ binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Subnormal)
+ binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Normal)
+ binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Infinity)
+ binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 0
+ return 1
+ }
+ default {
+ return 0
+ }
+ }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+
+# ----------------------------------------------------------------------
test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
set buf hellomatt
-
set data $hdr
append data $buf
-
string length $data
} 11
-test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
- list [catch {binary} msg] $msg
-} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
-test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
- list [catch {binary foo} msg] $msg
-} {1 {bad option "foo": must be format or scan}}
-
-test binary-1.3 {Tcl_BinaryObjCmd: format error} {
- list [catch {binary f} msg] $msg
-} {1 {wrong # args: should be "binary format formatString ?arg arg ...?"}}
-test binary-1.4 {Tcl_BinaryObjCmd: format} {
+test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body {
+ binary
+} -returnCodes error -match glob -result {wrong # args: *}
+test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body {
+ binary foo
+} -match glob -result {unknown or ambiguous subcommand "foo": *}
+test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body {
+ binary f
+} -result {wrong # args: should be "binary format formatString ?arg ...?"}
+test binary-1.4 {Tcl_BinaryObjCmd: format} -body {
binary format ""
-} {}
-
+} -result {}
-test binary-2.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format a } msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format a
+} -result {not enough arguments for all format specifiers}
test binary-2.2 {Tcl_BinaryObjCmd: format} {
binary format a0 foo
} {}
@@ -69,9 +123,9 @@ test binary-2.8 {Tcl_BinaryObjCmd: format} {
binary format a*X3a2 foobar x
} foox\x00r
-test binary-3.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format A
+} -result {not enough arguments for all format specifiers}
test binary-3.2 {Tcl_BinaryObjCmd: format} {
binary format A0 f
} {}
@@ -94,9 +148,9 @@ test binary-3.8 {Tcl_BinaryObjCmd: format} {
binary format A*X3A2 foobar x
} {foox r}
-test binary-4.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format B
+} -result {not enough arguments for all format specifiers}
test binary-4.2 {Tcl_BinaryObjCmd: format} {
binary format B0 1
} {}
@@ -118,13 +172,13 @@ test binary-4.7 {Tcl_BinaryObjCmd: format} {
test binary-4.8 {Tcl_BinaryObjCmd: format} {
binary format B2B3 10 010
} \x80\x40
-test binary-4.9 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format B1B5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format B1B5 1 foo
+} -result {expected binary string but got "foo" instead}
-test binary-5.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format b
+} -result {not enough arguments for all format specifiers}
test binary-5.2 {Tcl_BinaryObjCmd: format} {
binary format b0 1
} {}
@@ -149,13 +203,13 @@ test binary-5.8 {Tcl_BinaryObjCmd: format} {
test binary-5.9 {Tcl_BinaryObjCmd: format} {
binary format b2b3 10 010
} \x01\x02
-test binary-5.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format b1b5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format b1b5 1 foo
+} -result {expected binary string but got "foo" instead}
-test binary-6.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format h
+} -result {not enough arguments for all format specifiers}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
binary format h0 1
} {}
@@ -183,13 +237,13 @@ test binary-6.9 {Tcl_BinaryObjCmd: format} {
test binary-6.10 {Tcl_BinaryObjCmd: format} {
binary format h2h3 23 456
} \x32\x54\x06
-test binary-6.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format h2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
+test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format h2 foo
+} -result {expected hexadecimal string but got "foo" instead}
-test binary-7.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format H
+} -result {not enough arguments for all format specifiers}
test binary-7.2 {Tcl_BinaryObjCmd: format} {
binary format H0 1
} {}
@@ -217,16 +271,16 @@ test binary-7.9 {Tcl_BinaryObjCmd: format} {
test binary-7.10 {Tcl_BinaryObjCmd: format} {
binary format H2H3 23 456
} \x23\x45\x60
-test binary-7.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format H2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
-
-test binary-8.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-8.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format H2 foo
+} -result {expected hexadecimal string but got "foo" instead}
+
+test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c
+} -result {not enough arguments for all format specifiers}
+test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c blat
+} -result {expected integer but got "blat"}
test binary-8.3 {Tcl_BinaryObjCmd: format} {
binary format c0 0x50
} {}
@@ -245,24 +299,24 @@ test binary-8.7 {Tcl_BinaryObjCmd: format} {
test binary-8.8 {Tcl_BinaryObjCmd: format} {
binary format c* {0x50 0x52}
} PR
-test binary-8.9 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-8.10 {Tcl_BinaryObjCmd: format} {
+test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format c $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format c $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-8.11 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format c1 $a
} P
-test binary-9.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-9.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s
+} -result {not enough arguments for all format specifiers}
+test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s blat
+} -result {expected integer but got "blat"}
test binary-9.3 {Tcl_BinaryObjCmd: format} {
binary format s0 0x50
} {}
@@ -284,24 +338,24 @@ test binary-9.8 {Tcl_BinaryObjCmd: format} {
test binary-9.9 {Tcl_BinaryObjCmd: format} {
binary format s2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
-test binary-9.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-9.11 {Tcl_BinaryObjCmd: format} {
+test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format s $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format s $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-9.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format s1 $a
} P\x00
-test binary-10.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-10.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S
+} -result {not enough arguments for all format specifiers}
+test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S blat
+} -result {expected integer but got "blat"}
test binary-10.3 {Tcl_BinaryObjCmd: format} {
binary format S0 0x50
} {}
@@ -323,24 +377,24 @@ test binary-10.8 {Tcl_BinaryObjCmd: format} {
test binary-10.9 {Tcl_BinaryObjCmd: format} {
binary format S2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
-test binary-10.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-10.11 {Tcl_BinaryObjCmd: format} {
+test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format S $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format S $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-10.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format S1 $a
} \x00P
-test binary-11.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-11.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i
+} -result {not enough arguments for all format specifiers}
+test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i blat
+} -result {expected integer but got "blat"}
test binary-11.3 {Tcl_BinaryObjCmd: format} {
binary format i0 0x50
} {}
@@ -365,24 +419,24 @@ test binary-11.9 {Tcl_BinaryObjCmd: format} {
test binary-11.10 {Tcl_BinaryObjCmd: format} {
binary format i* {0x50515253 0x52}
} SRQPR\x00\x00\x00
-test binary-11.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-11.12 {Tcl_BinaryObjCmd: format} {
+test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format i $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format i $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-11.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format i1 $a
} P\x00\x00\x00
-test binary-12.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-12.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format I blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format I
+} -result {not enough arguments for all format specifiers}
+test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format I blat
+} -result {expected integer but got "blat"}
test binary-12.3 {Tcl_BinaryObjCmd: format} {
binary format I0 0x50
} {}
@@ -407,24 +461,24 @@ test binary-12.9 {Tcl_BinaryObjCmd: format} {
test binary-12.10 {Tcl_BinaryObjCmd: format} {
binary format I* {0x50515253 0x52}
} PQRS\x00\x00\x00R
-test binary-12.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-12.12 {Tcl_BinaryObjCmd: format} {
+test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format I $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format I $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-12.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format I1 $a
} \x00\x00\x00P
-test binary-13.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-13.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-13.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f
+} -result {not enough arguments for all format specifiers}
+test binary-13.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f blat
+} -result {expected floating-point number but got "blat"}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
@@ -464,13 +518,13 @@ test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
binary format f -3.402825e-100
} \x00\x00\x00\x80
-test binary-13.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-13.17 {Tcl_BinaryObjCmd: format} {
+test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format f $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format f $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format f1 $a
@@ -480,12 +534,12 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f1 $a
} \xcd\xcc\xcc\x3f
-test binary-14.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-14.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d
+} -result {not enough arguments for all format specifiers}
+test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d blat
+} -result {expected floating-point number but got "blat"}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
binary format d0 1.6
} {}
@@ -513,13 +567,13 @@ test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.14 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-14.15 {Tcl_BinaryObjCmd: format} {
+test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format d $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format d $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format d1 $a
@@ -528,10 +582,14 @@ test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
set a {1.6 3.4}
binary format d1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
-
-test binary-15.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format ax*a "y" "z"} msg] $msg
-} {1 {cannot use "*" in format string with "x"}}
+test binary-14.18 {FormatNumber: Bug 1116542} {
+ binary scan [binary format d 1.25] d w
+ set w
+} 1.25
+
+test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format ax*a "y" "z"
+} -result {cannot use "*" in format string with "x"}
test binary-15.2 {Tcl_BinaryObjCmd: format} {
binary format axa "y" "z"
} y\x00z
@@ -541,6 +599,18 @@ test binary-15.3 {Tcl_BinaryObjCmd: format} {
test binary-15.4 {Tcl_BinaryObjCmd: format} {
binary format a*X3x3a* "foo" "z"
} \x00\x00\x00z
+test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x0s 1
+} \x01\x00
+test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x0ss 1 1
+} \x01\x00\x01\x00
+test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x1s 1
+} \x00\x01\x00
+test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x1ss 1 1
+} \x00\x01\x00\x01\x00
test binary-16.1 {Tcl_BinaryObjCmd: format} {
binary format a*X*a "foo" "z"
@@ -568,738 +638,840 @@ test binary-17.3 {Tcl_BinaryObjCmd: format} {
binary format {a* @0 a2 @* a*} "foobar" "ab" "blat"
} abobarblat
-test binary-18.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format u0a3 abc abd} msg] $msg
-} {1 {bad field specifier "u"}}
-
+test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format u0a3 abc abd
+} -result {bad field specifier "u"}
-test binary-19.1 {Tcl_BinaryObjCmd: errors} {
- list [catch {binary s} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
-test binary-19.2 {Tcl_BinaryObjCmd: errors} {
- list [catch {binary scan foo} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
+test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary s
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
+test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary scan foo
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
binary scan {} {}
} 0
-test binary-20.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc a} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-20.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc a
+} -result {not enough arguments for all format specifiers}
+test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan abc a arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-20.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ binary scan abc a arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
set arg1 abc
list [binary scan abc a0 arg1] $arg1
-} {1 {}}
-test binary-20.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {}}
+test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a* arg1] $arg1
-} {1 abc}
-test binary-20.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 abc}
+test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
test binary-20.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc a2 arg1] $arg1
} {1 ab}
-test binary-20.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-20.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {2 ab cd}
+test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-20.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a arg1(a)] $arg1(a)
-} {1 a}
-
-test binary-21.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-21.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 a}
+
+test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc A
+} -result {not enough arguments for all format specifiers}
+test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan abc A arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-21.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ binary scan abc A arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
set arg1 abc
list [binary scan abc A0 arg1] $arg1
-} {1 {}}
-test binary-21.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {}}
+test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A* arg1] $arg1
-} {1 abc}
-test binary-21.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 abc}
+test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
test binary-21.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc A2 arg1] $arg1
} {1 ab}
-test binary-21.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-21.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {2 ab cd}
+test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A arg1(a)] $arg1(a)
-} {1 a}
-test binary-21.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 a}
+test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan "abc def \x00 " A* arg1] $arg1
-} {1 {abc def}}
-test binary-21.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {abc def}}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan "abc def \x00ghi " A* arg1] $arg1
-} [list 1 "abc def \x00ghi"]
+} -result [list 1 "abc def \x00ghi"]
-test binary-22.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc b
+} -result {not enough arguments for all format specifiers}
test binary-22.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b* arg1] $arg1
} {1 0100101011001010}
test binary-22.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b arg1] $arg1
} {1 0}
test binary-22.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b1 arg1] $arg1
} {1 0}
test binary-22.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b0 arg1] $arg1
} {1 {}}
test binary-22.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b5 arg1] $arg1
} {1 01001}
test binary-22.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b8 arg1] $arg1
} {1 01001010}
test binary-22.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b14 arg1] $arg1
} {1 01001010110010}
test binary-22.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
-test binary-22.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-22.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 b1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
-} {2 11100 1110000110100000}
-
+} -result {2 11100 1110000110100000}
-test binary-23.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc B
+} -result {not enough arguments for all format specifiers}
test binary-23.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B* arg1] $arg1
} {1 0101001001010011}
test binary-23.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 B arg1] $arg1
} {1 1}
test binary-23.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 B1 arg1] $arg1
} {1 1}
test binary-23.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B0 arg1] $arg1
} {1 {}}
test binary-23.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B5 arg1] $arg1
} {1 01010}
test binary-23.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B8 arg1] $arg1
} {1 01010010}
test binary-23.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B14 arg1] $arg1
} {1 01010010010100}
test binary-23.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
-test binary-23.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-23.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 B1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
-} {2 01110 1000011100000101}
+} -result {2 01110 1000011100000101}
-test binary-24.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc h
+} -result {not enough arguments for all format specifiers}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xc2\xa3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xf2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
-test binary-24.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-24.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 h1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
-} {2 07 7850}
+} -result {2 07 7850}
-test binary-25.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc H
+} -result {not enough arguments for all format specifiers}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xc2\xa3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xf2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
-test binary-25.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 H1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}
-test binary-26.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc c
+} -result {not enough arguments for all format specifiers}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xff c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
-test binary-26.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 c1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
+test binary-26.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu* arg1] $arg1
+} {1 {82 163}}
+test binary-26.12 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu arg1] $arg1
+} {1 82}
+test binary-26.13 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xff cu arg1] $arg1
+} {1 255}
+test binary-26.14 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
+} {2 128 -128}
+test binary-26.15 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
+} {2 -128 128}
-test binary-27.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc s
+} -result {not enough arguments for all format specifiers}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
} {1 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
-test binary-27.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 s1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
+test binary-27.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
+} {1 {41810 21587}}
+test binary-27.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
+} {2 65535 -1}
+test binary-27.12 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
+} {2 -1 65535}
-test binary-28.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc S
+} -result {not enough arguments for all format specifiers}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
} {1 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
-test binary-28.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 S1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
-
-test binary-29.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-28.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
+} {1 {41810 21587}}
+
+test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc i
+} -result {not enough arguments for all format specifiers}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
-test binary-29.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53\x53\x54 i1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
-
-test binary-30.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-29.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-29.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-29.12 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
+} {2 128 2147483648}
+
+test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc I
+} -result {not enough arguments for all format specifiers}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
-test binary-30.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53\x53\x54 I1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
-
-test binary-31.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-30.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-30.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-30.12 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
+} {2 2147483648 128}
+
+test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc f
+} -result {not enough arguments for all format specifiers}
test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
} {1 1.600000023841858}
test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
} {1 1.600000023841858}
test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
-test binary-31.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xcc\xcc\xcd f1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
-test binary-32.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc d
+} -result {not enough arguments for all format specifiers}
test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
} {1 1.6}
test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
} {1 1.6}
test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
} {1 1.6}
test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
} {1 1.6}
test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
} {1 {}}
test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
} {1 {}}
test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
-test binary-32.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-33.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
test binary-33.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x1a1 arg1] $arg1
} {1 b}
test binary-33.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x5a1 arg1] $arg1
} {1 f}
test binary-33.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x0a1 arg1] $arg1
} {1 a}
test binary-34.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
} {2 ab bcd}
test binary-34.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abc X20a3 arg1] $arg1
} {1 abc}
test binary-34.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*X1a1 arg1] $arg1
} {1 f}
test binary-34.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*X5a1 arg1] $arg1
} {1 b}
test binary-34.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x3X0a1 arg1] $arg1
} {1 d}
-test binary-35.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
- list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
-} {1 {missing count for "@" field specifier}}
+test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -returnCodes error -body {
+ binary scan abcdefg a2@a3 arg1 arg2
+} -result {missing count for "@" field specifier}
test binary-35.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef @2a3 arg1] $arg1
} {1 cde}
test binary-35.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*@1a1 arg1] $arg1
} {1 b}
test binary-35.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*@0a1 arg1] $arg1
} {1 a}
-test binary-36.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abcdef u0a3} msg] $msg
-} {1 {bad field specifier "u"}}
+test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abcdef u0a3
+} -result {bad field specifier "u"}
-# GetFormatSpec is pretty thoroughly tested above, but there are a few
-# cases we should text explicitly
+# GetFormatSpec is pretty thoroughly tested above, but there are a few cases
+# we should text explicitly
test binary-37.1 {GetFormatSpec: whitespace} {
binary format "a3 a5 a3" foo barblat baz
@@ -1319,11 +1491,11 @@ test binary-37.5 {GetFormatSpec: whitespace} {
test binary-37.6 {GetFormatSpec: whitespace} {
binary format " a3 " foo
} foo
-test binary-37.7 {GetFormatSpec: numbers} {
- list [catch {binary scan abcdef "x-1" foo} msg] $msg
-} {1 {bad field specifier "-"}}
+test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -body {
+ binary scan abcdef "x-1" foo
+} -result {bad field specifier "-"}
test binary-37.8 {GetFormatSpec: numbers} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan abcdef "a0x3" arg1] $arg1
} {1 {}}
@@ -1361,79 +1533,99 @@ test binary-38.8 {FormatNumber: word alignment} littleEndian {
} \x01\xcd\xcc\xcc\x3f
test binary-39.1 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
-
-test binary-40.3 {ScanNumber: NaN} \
- -body {
- catch {unset arg1}
- list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
- } \
- -match glob \
- -result {1 -NaN*}
-
-test binary-40.4 {ScanNumber: NaN} \
- -body {
- catch {unset arg1}
- list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
- } \
- -match glob \
- -result {1 -NaN*}
-
-test binary-41.1 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+test binary-39.6 {ScanNumber: no sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu2 arg1] $arg1
+} {1 {82 163}}
+test binary-39.7 {ScanNumber: no sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
+} {1 {513 33025 386 33409}}
+test binary-39.8 {ScanNumber: no sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
+} {1 {258 385 33281 33154}}
+test binary-39.9 {ScanNumber: no sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
+} {1 {33620225 16843137 16876033 25297153 2164326657}}
+test binary-39.10 {ScanNumber: no sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
+} {1 {16843010 2164326657 25297153 16876033 16843137}}
+
+test binary-40.3 {ScanNumber: NaN} -body {
+ unset -nocomplain arg1
+ list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
+} -match glob -result {1 -NaN*}
+test binary-40.4 {ScanNumber: NaN} -body {
+ unset -nocomplain arg1
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
+} -match glob -result {1 -NaN*}
+
+test binary-41.1 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.2 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.2 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.3 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.3 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.4 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.4 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.5 {ScanNumber: word alignment} bigEndian {
- catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.5 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -constraints bigEndian -body {
list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
-} {2 1 1.600000023841858}
-test binary-41.6 {ScanNumber: word alignment} littleEndian {
- catch {unset arg1; unset arg2}
+} -result {2 1 1.600000023841858}
+test binary-41.6 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -constraints littleEndian -body {
list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
-} {2 1 1.600000023841858}
-test binary-41.7 {ScanNumber: word alignment} bigEndian {
- catch {unset arg1; unset arg2}
+} -result {2 1 1.600000023841858}
+test binary-41.7 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -constraints bigEndian -body {
list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
-} {2 1 1.6}
-test binary-41.8 {ScanNumber: word alignment} littleEndian {
- catch {unset arg1; unset arg2}
+} -result {2 1 1.6}
+test binary-41.8 {ScanNumber: word alignment} -setup {
+ unset -nocomplain arg1 arg2
+} -constraints littleEndian -body {
list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
-} {2 1 1.6}
+} -result {2 1 1.6}
-test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
- catch {binary ""} result
- set result
-} {bad option "": must be format or scan}
+test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
+ binary ?
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *}
# Wide int (guaranteed at least 64-bit) handling
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
@@ -1459,6 +1651,26 @@ test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
binary scan [binary format W [expr {wide(3) << 31}]] W x
set x
} 6442450944
+test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
+ unset -nocomplain arg1
+ list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
+} {1 -9223372036854775808}
+test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+ unset -nocomplain arg1
+ list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+ unset -nocomplain arg1
+ list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
+test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+ unset -nocomplain arg1 arg2
+ list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
binary scan [binary format sws 16450 -1 19521] c* x
@@ -1492,22 +1704,22 @@ test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
} "1 \u00a4 \u20ac"
test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
- # This test is only reliable when memory debugging is turned on,
- # but without even memory debugging it should still generate the
- # expected answers and might therefore still pick up memory corruption
- # caused by [Bug 851747].
+ # This test is only reliable when memory debugging is turned on, but
+ # without even memory debugging it should still generate the expected
+ # answers and might therefore still pick up memory corruption caused by
+ # [Bug 851747].
list [binary scan aba ccc x x x] $x
} {3 97}
### TIP#129: endian specifiers ----
# format t
-test binary-48.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-48.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t
+} -result {not enough arguments for all format specifiers}
+test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t blat
+} -result {expected integer but got "blat"}
test binary-48.3 {Tcl_BinaryObjCmd: format} {
binary format S0 0x50
} {}
@@ -1535,10 +1747,10 @@ test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t2 {0x50 0x52}
} P\x00R\x00
-test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
+test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
binary format t* {0x5051 0x52}
} PQ\x00R
-test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
+test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t* {0x5051 0x52}
} QPR\x00
test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
@@ -1547,13 +1759,13 @@ test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
-test binary-48.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-48.17 {Tcl_BinaryObjCmd: format} {
+test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format t $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format t $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {0x50 0x51}
binary format t1 $a
@@ -1564,12 +1776,12 @@ test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
} P\x00
# format n
-test binary-49.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-49.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n
+} -result {not enough arguments for all format specifiers}
+test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n blat
+} -result {expected integer but got "blat"}
test binary-49.3 {Tcl_BinaryObjCmd: format} {
binary format n0 0x50
} {}
@@ -1594,13 +1806,13 @@ test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
binary format n* {0x50515253 0x52}
} SRQPR\x00\x00\x00
-test binary-49.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-49.12 {Tcl_BinaryObjCmd: format} {
+test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format n $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format n $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
set a {0x50 0x51}
binary format n1 $a
@@ -1643,14 +1855,13 @@ test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
set x
} 6442450944
-
# format Q/q
-test binary-51.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format Q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-51.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format q blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-51.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format Q
+} -result {not enough arguments for all format specifiers}
+test binary-51.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format q blat
+} -result {expected floating-point number but got "blat"}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
binary format q0 1.6
} {}
@@ -1678,13 +1889,13 @@ test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
binary format q2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-51.14 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format q2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-51.15 {Tcl_BinaryObjCmd: format} {
+test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format q2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format q $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format q $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format Q1 $a
@@ -1695,12 +1906,12 @@ test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
# format R/r
-test binary-53.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-53.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r
+} -result {not enough arguments for all format specifiers}
+test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r blat
+} -result {expected floating-point number but got "blat"}
test binary-53.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
@@ -1740,13 +1951,13 @@ test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
binary format r -3.402825e-100
} \x00\x00\x00\x80
-test binary-53.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-53.17 {Tcl_BinaryObjCmd: format} {
+test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format r $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format r $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format R1 $a
@@ -1757,298 +1968,352 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
} \xcd\xcc\xcc\x3f
# scan t (s)
-test binary-54.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {-23726 21587}}
test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 -23726}
test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 -23726}
test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {-23726 21587}}
test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
-test binary-54.8 {Tcl_BinaryObjCmd: scan} {} {
- catch {unset arg1}
+test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
+test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
# scan t (b)
-test binary-55.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
+test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {21155 21332}}
-test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 21155}
-test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 21155}
-test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
-test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {21155 21332}}
-test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
-test binary-55.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
+test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
# scan n (s)
-test binary-56.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1414767442 67305985}}
-test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1414767442}
-test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1414767442}
-test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
-test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1414767442 67305985}}
-test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
-test binary-56.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
+test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
+test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
# scan n (b)
-test binary-57.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
+test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1386435412 16909060}}
-test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1386435412}
-test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1386435412}
-test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
-test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1386435412 16909060}}
-test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
-test binary-57.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
+test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
+test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
# scan Q/q
-test binary-58.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc q
+} -result {not enough arguments for all format specifiers}
test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
} {1 1.6}
test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
} {1 1.6}
test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
} {1 1.6}
test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
} {1 1.6}
test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
} {1 {}}
test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
} {1 {}}
test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
-test binary-58.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
# scan R/r
-test binary-59.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc r
+} -result {not enough arguments for all format specifiers}
test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
} {1 1.600000023841858}
test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
} {1 1.600000023841858}
test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
} {1 {}}
test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
} {1 {}}
test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
-test binary-59.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xcc\xcc\xcd r1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
@@ -2069,7 +2334,7 @@ test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
binary scan lcTolleH m x
set x
} 5216694956358656876
-test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
+test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
binary scan [binary format w [expr {wide(3) << 31}]] m x
set x
} 6442450944
@@ -2078,64 +2343,77 @@ test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
set x
} 6442450944
-# Big test for correct ordering of data in [expr]
-
-proc testIEEE {} {
- variable ieeeValues
- binary scan [binary format dd -1.0 1.0] c* c
- switch -exact -- $c {
- {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
- # little endian
- binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
- ieeeValues(-Infinity)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
- ieeeValues(-Normal)
- binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
- ieeeValues(-Subnormal)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
- ieeeValues(-0)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+0)
- binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
- ieeeValues(+Subnormal)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
- ieeeValues(+Normal)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
- ieeeValues(+Infinity)
- binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
- ieeeValues(NaN)
- set ieeeValues(littleEndian) 1
- return 1
- }
- {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
- binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Infinity)
- binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Normal)
- binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Subnormal)
- binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-0)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+0)
- binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Subnormal)
- binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Normal)
- binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Infinity)
- binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(NaN)
- set ieeeValues(littleEndian) 0
- return 1
- }
- default {
- return 0
- }
- }
-}
-
-testConstraint ieeeFloatingPoint [testIEEE]
+# scan/format infinities
+
+test binary-62.1 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q Infinity] w w
+ format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.2 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q -Infinity] w w
+ format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.3 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q Inf] w w
+ format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.4 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q -Infinity] w w
+ format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.5 {infinity} ieeeFloatingPoint {
+ binary scan [binary format w 0x7ff0000000000000] q d
+ set d
+} Inf
+test binary-62.6 {infinity} ieeeFloatingPoint {
+ binary scan [binary format w 0xfff0000000000000] q d
+ set d
+} -Inf
+
+# scan/format Not-a-Number
+
+test binary-63.1 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q NaN] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff0000000000000
+test binary-63.2 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q -NaN] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0xfff0000000000000
+test binary-63.3 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q NaN(3123456789aBc)] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff3123456789abc
+test binary-63.4 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q {NaN( 3123456789aBc)}] w w
+ 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
+} -match glob -result NaN*
+test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
+ binary scan [binary format w 0x7ff0123456789aBc] q d
+ set d
+} -match glob -result NaN(*123456789abc)
test binary-65.1 {largest significand} ieeeFloatingPoint {
binary scan [binary format w 0x3fcfffffffffffff] q d
@@ -2169,12 +2447,403 @@ test binary-65.8 {largest significand} ieeeFloatingPoint {
binary scan [binary format w 0x4350000000000000] q d
set d
} 18014398509481984.0
-test binary-65.8 {largest significand} ieeeFloatingPoint {
+test binary-65.9 {largest significand} ieeeFloatingPoint {
binary scan [binary format w 0x4350000000000001] q d
set d
} 18014398509481988.0
-
+test binary-70.1 {binary encode hex} -body {
+ binary encode hex
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-70.2 {binary encode hex} -body {
+ binary encode hex a
+} -result {61}
+test binary-70.3 {binary encode hex} -body {
+ binary encode hex {}
+} -result {}
+test binary-70.4 {binary encode hex} -body {
+ binary encode hex [string repeat a 20]
+} -result [string repeat 61 20]
+test binary-70.5 {binary encode hex} -body {
+ binary encode hex \0\1\2\3\4\0\1\2\3\4
+} -result {00010203040001020304}
+
+test binary-71.1 {binary decode hex} -body {
+ binary decode hex
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-71.2 {binary decode hex} -body {
+ binary decode hex 61
+} -result {a}
+test binary-71.3 {binary decode hex} -body {
+ binary decode hex {}
+} -result {}
+test binary-71.4 {binary decode hex} -body {
+ binary decode hex [string repeat 61 20]
+} -result [string repeat a 20]
+test binary-71.5 {binary decode hex} -body {
+ binary decode hex 00010203040001020304
+} -result "\0\1\2\3\4\0\1\2\3\4"
+test binary-71.6 {binary decode hex} -body {
+ binary decode hex "61 61"
+} -result {aa}
+test binary-71.7 {binary decode hex} -body {
+ binary decode hex "61\n\n\n61"
+} -result {aa}
+test binary-71.8 {binary decode hex} -body {
+ binary decode hex -strict "61 61"
+} -returnCodes error -result {invalid hexadecimal digit " " at position 2}
+test binary-71.9 {binary decode hex} -body {
+ set r [binary decode hex "6"]
+ list [string length $r] $r
+} -result {0 {}}
+test binary-71.10 {binary decode hex} -body {
+ string length [binary decode hex " "]
+} -result 0
+test binary-71.11 {binary decode hex: Bug b98fa55285} -body {
+ apply {{} {
+ set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n"
+ set decoded [binary decode hex $str]
+ list [string length $decoded] [scan [string index $decoded end] %c]
+ }}
+} -result {29 38}
+test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body {
+ apply {{} {
+ set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n"
+ set decoded [binary decode hex $str]
+ list [string length $decoded] [scan [string index $decoded end] %c]
+ }}
+} -result {28 140}
+test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body {
+ apply {{} {
+ set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n"
+ set decoded [binary decode hex $str]
+ list [string length $decoded] [scan [string index $decoded end] %c]
+ }}
+} -result {28 140}
+test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body {
+ apply {{} {
+ set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n"
+ set decoded [binary decode hex $str]
+ list [string length $decoded] [scan [string index $decoded end] %c]
+ }}
+} -result {28 140}
+
+test binary-72.1 {binary encode base64} -body {
+ binary encode base64
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-72.2 {binary encode base64} -body {
+ binary encode base64 abc
+} -result {YWJj}
+test binary-72.3 {binary encode base64} -body {
+ binary encode base64 {}
+} -result {}
+test binary-72.4 {binary encode base64} -body {
+ binary encode base64 [string repeat abc 20]
+} -result [string repeat YWJj 20]
+test binary-72.5 {binary encode base64} -body {
+ binary encode base64 \0\1\2\3\4\0\1\2\3
+} -result {AAECAwQAAQID}
+test binary-72.6 {binary encode base64} -body {
+ binary encode base64 \0
+} -result {AA==}
+test binary-72.7 {binary encode base64} -body {
+ binary encode base64 \0\0
+} -result {AAA=}
+test binary-72.8 {binary encode base64} -body {
+ binary encode base64 \0\0\0
+} -result {AAAA}
+test binary-72.9 {binary encode base64} -body {
+ binary encode base64 \0\0\0\0
+} -result {AAAAAA==}
+test binary-72.10 {binary encode base64} -body {
+ binary encode base64 -maxlen 0 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.11 {binary encode base64} -body {
+ binary encode base64 -maxlen 1 -wrapchar : abcabcabc
+} -result {Y:W:J:j:Y:W:J:j:Y:W:J:j}
+test binary-72.12 {binary encode base64} -body {
+ binary encode base64 -maxlen 2 -wrapchar : abcabcabc
+} -result {YW:Jj:YW:Jj:YW:Jj}
+test binary-72.13 {binary encode base64} -body {
+ binary encode base64 -maxlen 3 -wrapchar : abcabcabc
+} -result {YWJ:jYW:JjY:WJj}
+test binary-72.14 {binary encode base64} -body {
+ binary encode base64 -maxlen 4 -wrapchar : abcabcabc
+} -result {YWJj:YWJj:YWJj}
+test binary-72.15 {binary encode base64} -body {
+ binary encode base64 -maxlen 5 -wrapchar : abcabcabc
+} -result {YWJjY:WJjYW:Jj}
+test binary-72.16 {binary encode base64} -body {
+ binary encode base64 -maxlen 6 -wrapchar : abcabcabc
+} -result {YWJjYW:JjYWJj}
+test binary-72.17 {binary encode base64} -body {
+ binary encode base64 -maxlen 7 -wrapchar : abcabcabc
+} -result {YWJjYWJ:jYWJj}
+test binary-72.18 {binary encode base64} -body {
+ binary encode base64 -maxlen 8 -wrapchar : abcabcabc
+} -result {YWJjYWJj:YWJj}
+test binary-72.19 {binary encode base64} -body {
+ binary encode base64 -maxlen 9 -wrapchar : abcabcabc
+} -result {YWJjYWJjY:WJj}
+test binary-72.20 {binary encode base64} -body {
+ binary encode base64 -maxlen 10 -wrapchar : abcabcabc
+} -result {YWJjYWJjYW:Jj}
+test binary-72.21 {binary encode base64} -body {
+ binary encode base64 -maxlen 11 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJ:j}
+test binary-72.22 {binary encode base64} -body {
+ binary encode base64 -maxlen 12 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.23 {binary encode base64} -body {
+ binary encode base64 -maxlen 13 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.24 {binary encode base64} -body {
+ binary encode base64 -maxlen 60 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.25 {binary encode base64} -body {
+ binary encode base64 -maxlen 2 -wrapchar * abcabcabc
+} -result {YW*Jj*YW*Jj*YW*Jj}
+test binary-72.26 {binary encode base64} -body {
+ binary encode base64 -maxlen 6 -wrapchar -*- abcabcabc
+} -result {YWJjYW-*-JjYWJj}
+test binary-72.27 {binary encode base64} -body {
+ binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc
+} -result {YWJj-*-YWJj-*-YWJj}
+test binary-72.28 {binary encode base64} -body {
+ binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc
+} -result {YWJjYW0123456789JjYWJj}
+
+test binary-73.1 {binary decode base64} -body {
+ binary decode base64
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-73.2 {binary decode base64} -body {
+ binary decode base64 YWJj
+} -result {abc}
+test binary-73.3 {binary decode base64} -body {
+ binary decode base64 {}
+} -result {}
+test binary-73.4 {binary decode base64} -body {
+ binary decode base64 [string repeat YWJj 20]
+} -result [string repeat abc 20]
+test binary-73.5 {binary encode base64} -body {
+ binary decode base64 AAECAwQAAQID
+} -result "\0\1\2\3\4\0\1\2\3"
+test binary-73.6 {binary encode base64} -body {
+ binary decode base64 AA==
+} -result "\0"
+test binary-73.7 {binary encode base64} -body {
+ binary decode base64 AAA=
+} -result "\0\0"
+test binary-73.8 {binary encode base64} -body {
+ binary decode base64 AAAA
+} -result "\0\0\0"
+test binary-73.9 {binary encode base64} -body {
+ binary decode base64 AAAAAA==
+} -result "\0\0\0\0"
+test binary-73.10 {binary decode base64} -body {
+ set s "[string repeat YWJj 10]\n[string repeat YWJj 10]"
+ binary decode base64 $s
+} -result [string repeat abc 20]
+test binary-73.11 {binary decode base64} -body {
+ set s "[string repeat YWJj 10]\n [string repeat YWJj 10]"
+ binary decode base64 $s
+} -result [string repeat abc 20]
+test binary-73.12 {binary decode base64} -body {
+ binary decode base64 -strict ":YWJj"
+} -returnCodes error -match glob -result {invalid base64 character ":" at position 0}
+test binary-73.13 {binary decode base64} -body {
+ set s "[string repeat YWJj 10]:[string repeat YWJj 10]"
+ binary decode base64 -strict $s
+} -returnCodes error -match glob -result {invalid base64 character ":" at position 40}
+test binary-73.14 {binary decode base64} -body {
+ set s "[string repeat YWJj 10]\n [string repeat YWJj 10]"
+ binary decode base64 -strict $s
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.20 {binary decode base64} -body {
+ set r [binary decode base64 Y]
+ list [string length $r] $r
+} -result {0 {}}
+test binary-73.21 {binary decode base64} -body {
+ set r [binary decode base64 YW]
+ list [string length $r] $r
+} -result {1 a}
+test binary-73.22 {binary decode base64} -body {
+ set r [binary decode base64 YWJ]
+ list [string length $r] $r
+} -result {2 ab}
+test binary-73.23 {binary decode base64} -body {
+ set r [binary decode base64 YWJj]
+ list [string length $r] $r
+} -result {3 abc}
+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
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-74.2 {binary encode uuencode} -body {
+ binary encode uuencode abc
+} -result {#86)C
+}
+test binary-74.3 {binary encode uuencode} -body {
+ binary encode uuencode {}
+} -result {}
+test binary-74.4 {binary encode uuencode} -body {
+ binary encode uuencode [string repeat abc 20]
+} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
+test binary-74.5 {binary encode uuencode} -body {
+ binary encode uuencode \0\1\2\3\4\0\1\2\3
+} -result ")``\$\"`P0``0(#\n"
+test binary-74.6 {binary encode uuencode} -body {
+ binary encode uuencode \0
+} -result {!``
+}
+test binary-74.7 {binary encode uuencode} -body {
+ binary encode uuencode \0\0
+} -result "\"```
+"
+test binary-74.8 {binary encode uuencode} -body {
+ binary encode uuencode \0\0\0
+} -result {#````
+}
+test binary-74.9 {binary encode uuencode} -body {
+ binary encode uuencode \0\0\0\0
+} -result {$``````
+}
+test binary-74.10 {binary encode uuencode} -returnCodes error -body {
+ binary encode uuencode -foo 30 abcabcabc
+} -result {bad option "-foo": must be -maxlen or -wrapchar}
+test binary-74.11 {binary encode uuencode} -returnCodes error -body {
+ binary encode uuencode -maxlen 1 abcabcabc
+} -result {line length out of range}
+test binary-74.12 {binary encode uuencode} -body {
+ binary encode uuencode -maxlen 3 -wrapchar | abcabcabc
+} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|}
+
+test binary-75.1 {binary decode uuencode} -body {
+ binary decode uuencode
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-75.2 {binary decode uuencode} -body {
+ binary decode uuencode "#86)C\n"
+} -result {abc}
+test binary-75.3 {binary decode uuencode} -body {
+ binary decode uuencode {}
+} -result {}
+test binary-75.3.1 {binary decode uuencode} -body {
+ binary decode uuencode `\n
+} -result {}
+test binary-75.4 {binary decode uuencode} -body {
+ binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
+} -result [string repeat abc 20]
+test binary-75.5 {binary decode uuencode} -body {
+ binary decode uuencode ")``\$\"`P0``0(#"
+} -result "\0\1\2\3\4\0\1\2\3"
+test binary-75.6 {binary decode uuencode} -body {
+ string length [binary decode uuencode "`\n"]
+} -result 0
+test binary-75.7 {binary decode uuencode} -body {
+ string length [binary decode uuencode "!`\n"]
+} -result 1
+test binary-75.8 {binary decode uuencode} -body {
+ string length [binary decode uuencode "\"``\n"]
+} -result 2
+test binary-75.9 {binary decode uuencode} -body {
+ string length [binary decode uuencode "#```\n"]
+} -result 3
+test binary-75.10 {binary decode uuencode} -body {
+ set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]"
+ binary decode uuencode $s
+} -result [string repeat abc 20]
+test binary-75.11 {binary decode uuencode} -body {
+ set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r"
+ binary decode uuencode $s
+} -result [string repeat abc 20]
+test binary-75.12 {binary decode uuencode} -body {
+ binary decode uuencode -strict "|86)C"
+} -returnCodes error -match glob -result {invalid uuencode character "|" at position 0}
+test binary-75.13 {binary decode uuencode} -body {
+ set s ">[string repeat 86)C 10]|[string repeat 86)C 10]"
+ binary decode uuencode -strict $s
+} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41}
+test binary-75.14 {binary decode uuencode} -body {
+ set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]"
+ binary decode uuencode -strict $s
+} -returnCodes error -match glob -result {invalid uuencode character *}
+test binary-75.20 {binary decode uuencode} -body {
+ set r [binary decode uuencode " 8"]
+ list [string length $r] $r
+} -result {0 {}}
+test binary-75.21 {binary decode uuencode} -body {
+ set r [binary decode uuencode "!86"]
+ list [string length $r] $r
+} -result {1 a}
+test binary-75.22 {binary decode uuencode} -body {
+ set r [binary decode uuencode "\"86)"]
+ list [string length $r] $r
+} -result {2 ab}
+test binary-75.23 {binary decode uuencode} -body {
+ set r [binary decode uuencode "#86)C"]
+ list [string length $r] $r
+} -result {3 abc}
+test binary-75.24 {binary decode uuencode} -body {
+ set s "#04)\# "
+ binary decode uuencode $s
+} -result ABC
+test binary-75.25 {binary decode uuencode} -body {
+ set s "#04)\#z"
+ binary decode uuencode $s
+} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5}
+test binary-75.26 {binary decode uuencode} -body {
+ string length [binary decode uuencode " "]
+} -result 0
+
+test binary-76.1 {binary string appending growth algorithm} unix {
+ # Create zero-length byte array first
+ set f [open /dev/null rb]
+ chan configure $f -blocking 0
+ set str [read $f 2]
+ close $f
+ # Append to it
+ string length [append str [binary format a* foo]]
+} 3
+test binary-76.2 {binary string appending growth algorithm} win {
+ # Create zero-length byte array first
+ set f [open NUL rb]
+ chan configure $f -blocking 0
+ set str [read $f 2]
+ close $f
+ # Append to it
+ string length [append str [binary format a* foo]]
+} 3
+
+# ----------------------------------------------------------------------
# cleanup
+
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/case.test b/tests/case.test
index 477538c..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.6 2004/05/19 10:52:35 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -42,7 +40,7 @@ test case-1.7 {list of patterns} {
test case-2.1 {error in executed command} {
list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
- $msg $errorInfo
+ $msg $::errorInfo
} {1 {Just a test} {Just a test
while executing
"error "Just a test""
@@ -51,7 +49,7 @@ test case-2.1 {error in executed command} {
"case a in a {error "Just a test"} default {format 1}"}}
test case-2.2 {error: not enough args} {
list [catch {case} msg] $msg
-} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
+} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
test case-2.3 {error: pattern with no body} {
list [catch {case a b} msg] $msg
} {1 {extra case pattern with no body}}
@@ -60,7 +58,7 @@ test case-2.4 {error: pattern with no body} {
} {1 {extra case pattern with no body}}
test case-2.5 {error in default command} {
list [catch {case foo in a {error case1} default {error case2} \
- b {error case 3}} msg] $msg $errorInfo
+ b {error case 3}} msg] $msg $::errorInfo
} {1 case2 {case2
while executing
"error case2"
diff --git a/tests/chan.test b/tests/chan.test
index f2376a3..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.5 2005/08/24 17:56:24 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -21,22 +19,49 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
test chan-1.1 {chan command general syntax} -body {
chan
-} -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\""
+} -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\""
test chan-1.2 {chan command general syntax} -body {
chan FOOBAR
-} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate"
+} -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *"
test chan-2.1 {chan command: blocked subcommand} -body {
chan blocked foo bar
} -returnCodes error -result "wrong # args: should be \"chan blocked channelId\""
-
test chan-3.1 {chan command: close subcommand} -body {
- chan close foo bar
-} -returnCodes error -result "wrong # args: should be \"chan close channelId\""
-
+ chan close foo bar zet
+} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\""
+test chan-3.2 {chan command: close subcommand} -setup {
+ set chan [open [info script] r]
+} -body {
+ chan close $chan bar
+} -cleanup {
+ close $chan
+} -returnCodes error -result "bad direction \"bar\": must be read or write"
+test chan-3.3 {chan command: close subcommand} -setup {
+ set chan [open [info script] r]
+} -body {
+ chan close $chan write
+} -cleanup {
+ close $chan
+} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
test chan-4.1 {chan command: configure subcommand} -body {
chan configure
-} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?optionName? ?value? ?optionName value?...\""
+} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
+test chan-4.2 {chan command: [Bug 800753]} -body {
+ chan configure stdout -eofchar \u0100
+} -returnCodes error -match glob -result {bad value*}
+test chan-4.3 {chan command: [Bug 800753]} -body {
+ chan configure stdout -eofchar \u0000
+} -returnCodes error -match glob -result {bad value*}
+test chan-4.4 {chan command: check valid inValue, no outValue} -body {
+ chan configure stdout -eofchar [list \x27 {}]
+} -returnCodes ok -result {}
+test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
+ chan configure stdout -eofchar [list \x27 \x80]
+} -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 {} -cleanup {chan configure stdout -eofchar [list {} {}]}
test chan-5.1 {chan command: copy subcommand} -body {
chan copy foo
@@ -96,6 +121,152 @@ test chan-15.2 {chan command: truncate subcommand} -setup {
catch {removeFile $file}
}
+# TIP 287: chan pending
+test chan-16.1 {chan command: pending subcommand} -body {
+ chan pending
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.2 {chan command: pending subcommand} -body {
+ chan pending stdin
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.3 {chan command: pending subcommand} -body {
+ chan pending stdin stdout stderr
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.4 {chan command: pending subcommand} -body {
+ chan pending {input output} stdout
+} -returnCodes error -result "bad mode \"input output\": must be input or output"
+test chan-16.5 {chan command: pending input subcommand} -body {
+ chan pending input stdout
+} -result -1
+test chan-16.6 {chan command: pending input subcommand} -body {
+ chan pending input stdin
+} -result 0
+test chan-16.7 {chan command: pending input subcommand} -body {
+ chan pending input FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.8 {chan command: pending input subcommand} -setup {
+ set file [makeFile {} testAvailable]
+ set f [open $file w+]
+ chan configure $f -translation lf -buffering line
+} -body {
+ chan puts $f foo
+ chan puts $f bar
+ chan puts $f baz
+ chan seek $f 0
+ chan gets $f
+ chan pending input $f
+} -result 8 -cleanup {
+ catch {chan close $f}
+ catch {removeFile $file}
+}
+test chan-16.9 {chan command: pending input subcommand} -setup {
+ proc chan-16.9-accept {sock addr port} {
+ chan configure $sock -blocking 0 -buffering line -buffersize 32
+ chan event $sock readable [list chan-16.9-readable $sock]
+ }
+
+ proc chan-16.9-readable {sock} {
+ set r [chan gets $sock line]
+ set l [string length $line]
+ set e [chan eof $sock]
+ set b [chan blocked $sock]
+ set i [chan pending input $sock]
+
+ lappend ::chan-16.9-data $r $l $e $b $i
+
+ if {$r != -1 || $e || $l || !$b || $i > 128} {
+ set data [read $sock $i]
+ lappend ::chan-16.9-data [string range $data 0 2]
+ lappend ::chan-16.9-data [string range $data end-2 end]
+ set ::chan-16.9-done 1
+ chan event $sock readable {}
+ } else {
+ after idle chan-16.9-client
+ }
+ }
+
+ proc chan-16.9-client {} {
+ chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
+ chan flush $::client
+ }
+
+ set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
+ set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
+ set ::chan-16.9-data [list]
+ set ::chan-16.9-done 0
+} -body {
+ after idle chan-16.9-client
+ vwait ::chan-16.9-done
+ set ::chan-16.9-data
+} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
+ catch {chan close $client}
+ catch {chan close $server}
+ rename chan-16.9-accept {}
+ rename chan-16.9-readable {}
+ rename chan-16.9-client {}
+ unset -nocomplain ::chan-16.9-data
+ unset -nocomplain ::chan-16.9-done
+ unset -nocomplain ::server
+ unset -nocomplain ::client
+}
+test chan-16.10 {chan command: pending output subcommand} -body {
+ chan pending output stdin
+} -result -1
+test chan-16.11 {chan command: pending output subcommand} -body {
+ chan pending output stdout
+} -result 0
+test chan-16.12 {chan command: pending output subcommand} -body {
+ chan pending output FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.13 {chan command: pending output subcommand} -setup {
+ set file [makeFile {} testPendingOutput]
+ set f [open $file w+]
+ chan configure $f -translation lf -buffering full -buffersize 1024
+} -body {
+ set result [list]
+ chan puts $f [string repeat x 512]
+ lappend result [chan pending output $f]
+ chan flush $f
+ lappend result [chan pending output $f]
+} -result [list 513 0] -cleanup {
+ unset -nocomplain result
+ catch {chan close $f}
+ catch {removeFile $file}
+}
+
+# TIP 304: chan pipe
+
+test chan-17.1 {chan command: pipe subcommand} -body {
+ chan pipe foo
+} -returnCodes error -result "wrong # args: should be \"chan pipe \""
+
+test chan-17.2 {chan command: pipe subcommand} -body {
+ chan pipe foo bar
+} -returnCodes error -result "wrong # args: should be \"chan pipe \""
+
+test chan-17.3 {chan command: pipe subcommand} -body {
+ set l [chan pipe]
+ foreach {pr pw} $l break
+ list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking]
+} -result [list 2 1 1] -cleanup {
+ close $pw
+ close $pr
+}
+
+test chan-17.4 {chan command: pipe subcommand} -body {
+ set ::done 0
+ foreach {::pr ::pw} [chan pipe] break
+ after 100 {puts $::pw foo;flush $::pw}
+ fileevent $::pr readable {set ::done 1}
+ after 500 {set ::done -1}
+ vwait ::done
+ set out nope
+ if {$::done==1} {gets $::pr out}
+ list $::done $out
+} -result [list 1 foo] -cleanup {
+ close $::pw
+ close $::pr
+}
+
cleanupTests
return
diff --git a/tests/chanio.test b/tests/chanio.test
new file mode 100644
index 0000000..999d0bb
--- /dev/null
+++ b/tests/chanio.test
@@ -0,0 +1,7723 @@
+# -*- tcl -*-
+# Functionality covered: operation of all IO commands, and all procedures
+# defined in generic/tclIO.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.
+#
+# Copyright (c) 1991-1994 The Regents of the University of California.
+# Copyright (c) 1994-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.
+
+if {[catch {package require tcltest 2}]} {
+ chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
+ return
+}
+namespace eval ::tcl::test::io {
+ namespace import ::tcltest::*
+
+ variable umaskValue
+ variable path
+ variable f
+ variable i
+ variable n
+ variable v
+ 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
+ testConstraint fileevent [llength [info commands fileevent]]
+ 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 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...
+ testConstraint largefileSupport 0
+
+ # 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]}]}]
+
+ testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
+
+ # set up a long data file for some of the following tests
+
+ set path(longfile) [makeFile {} longfile]
+ set f [open $path(longfile) w]
+ chan configure $f -eofchar {} -translation lf
+ for { set i 0 } { $i < 100 } { incr i} {
+ chan puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
+\#123456789abcdef01
+\#"
+ }
+ chan close $f
+
+ set path(cat) [makeFile {
+ set f stdin
+ if {$argv != ""} {
+ set f [open [lindex $argv 0]]
+ }
+ chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
+ chan configure stdout -encoding binary -translation lf -buffering none
+ chan event $f readable "foo $f"
+ proc foo {f} {
+ set x [chan read $f]
+ catch {chan puts -nonewline $x}
+ if {[chan eof $f]} {
+ chan close $f
+ exit 0
+ }
+ }
+ vwait forever
+ } cat]
+
+ set thisScript [file join [pwd] [info script]]
+
+ proc contents {file} {
+ set f [open $file]
+ chan configure $f -translation binary
+ set a [chan read $f]
+ 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.
+} {}
+set path(test1) [makeFile {} test1]
+test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
+ set f [open $path(test1) w]
+ chan configure $f -encoding binary
+ chan puts -nonewline $f "a\u4e4d\0"
+ chan close $f
+ contents $path(test1)
+} "a\x4d\x00"
+test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
+ set f [open $path(test1) w]
+ chan configure $f -encoding shiftjis
+ chan puts -nonewline $f "a\u4e4d\0"
+ chan close $f
+ contents $path(test1)
+} "a\x93\xe1\x00"
+set path(test2) [makeFile {} test2]
+test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
+ # This test written for SF bug #506297.
+ #
+ # Executing this test without the fix for the referenced bug applied to
+ # tcl will cause tcl, more specifically WriteChars, to go into an infinite
+ # loop.
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp
+ chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ chan close $f
+ contents $path(test2)
+} " \x1b\$B\$O\x1b(B"
+test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
+ # When closing a channel with an encoding that appends escape bytes, check
+ # for the case where the escape bytes overflow the current IO buffer. The
+ # bytes should be moved into a new buffer.
+ set data "1234567890 [format %c 12399]"
+ set sizes [list]
+ # With default buffer size
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp
+ chan puts -nonewline $f $data
+ chan close $f
+ lappend sizes [file size $path(test2)]
+ # With buffer size equal to the length of the data, the escape bytes would
+ # go into the next buffer.
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp -buffersize 16
+ chan puts -nonewline $f $data
+ chan close $f
+ lappend sizes [file size $path(test2)]
+ # With buffer size that is large enough to hold 1 byte of escaped data,
+ # but not all 3. This should not write the escape bytes to the first
+ # buffer and then again to the second buffer.
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp -buffersize 17
+ chan puts -nonewline $f $data
+ chan close $f
+ lappend sizes [file size $path(test2)]
+ # With buffer size that can hold 2 out of 3 bytes of escaped data.
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp -buffersize 18
+ chan puts -nonewline $f $data
+ chan close $f
+ lappend sizes [file size $path(test2)]
+ # With buffer size that can hold all the data and escape bytes.
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp -buffersize 19
+ chan puts -nonewline $f $data
+ chan close $f
+ lappend sizes [file size $path(test2)]
+} {19 19 19 19 19}
+
+test chan-io-2.1 {WriteBytes} {
+ # loop until all bytes are written
+ set f [open $path(test1) w]
+ chan configure $f -encoding binary -buffersize 16 -translation crlf
+ chan puts $f "abcdefghijklmnopqrstuvwxyz"
+ chan close $f
+ contents $path(test1)
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test chan-io-2.2 {WriteBytes: savedLF > 0} {
+ # After flushing buffer, there was a \n left over from the last
+ # \n -> \r\n expansion. It gets stuck at beginning of this buffer.
+ set f [open $path(test1) w]
+ chan configure $f -encoding binary -buffersize 16 -translation crlf
+ chan puts -nonewline $f "123456789012345\n12"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "123456789012345\r" "123456789012345\r\n12"]
+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"
+ contents $path(test1)
+} -cleanup {
+ chan close $f
+} -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 \
+ -buffersize 16
+ chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test chan-io-3.1 {WriteChars: compatibility with WriteBytes} {
+ # loop until all bytes are written
+ set f [open $path(test1) w]
+ chan configure $f -encoding ascii -buffersize 16 -translation crlf
+ chan puts $f "abcdefghijklmnopqrstuvwxyz"
+ chan close $f
+ contents $path(test1)
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
+ # After flushing buffer, there was a \n left over from the last
+ # \n -> \r\n expansion. It gets stuck at beginning of this buffer.
+ set f [open $path(test1) w]
+ chan configure $f -encoding ascii -buffersize 16 -translation crlf
+ chan puts -nonewline $f "123456789012345\n12"
+ set x [list [contents $path(test1)]]
+ 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} -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"
+ contents $path(test1)
+} -cleanup {
+ chan close $f
+} -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]
+ chan configure $f -encoding jis0208 -buffersize 16
+ chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.5 {WriteChars: saved != 0} {
+ # Bytes produced by UtfToExternal from end of last channel buffer had to
+ # be moved to beginning of next channel buffer to preserve requested
+ # buffersize.
+ set f [open $path(test1) w]
+ chan configure $f -encoding jis0208 -buffersize 17
+ chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
+ # One incomplete UTF-8 character at end of staging buffer. Backup in src
+ # to the beginning of that UTF-8 character and try again.
+ #
+ # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
+ # (first two bytes of \uff21 in UTF-8). Given those two bytes try
+ # translating them again, find that no bytes are read produced, and break
+ # to outer loop where those two bytes will have the remaining 4 bytes (the
+ # last byte of \uff21 plus the all of \uff22) appended.
+ set f [open $path(test1) w]
+ chan configure $f -encoding shiftjis -buffersize 16
+ chan puts -nonewline $f "12345678901234\uff21\uff22"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
+test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
+ # When translating UTF-8 to external, the produced bytes went past end of
+ # the channel buffer. This is done on purpose - we then truncate the bytes
+ # at the end of the partial character to preserve the requested blocksize
+ # on flush. The truncated bytes are moved to the beginning of the next
+ # channel buffer.
+ set f [open $path(test1) w]
+ chan configure $f -encoding jis0208 -buffersize 17
+ chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
+ set f [open $path(test1) w]
+ chan configure $f -encoding ascii -buffering line -translation lf \
+ -buffersize 16
+ chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test chan-io-4.1 {TranslateOutputEOL: lf} {
+ # search for \n
+ set f [open $path(test1) w]
+ chan configure $f -buffering line -translation lf
+ chan puts $f "abcde"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "abcde\n" "abcde\n"]
+test chan-io-4.2 {TranslateOutputEOL: cr} {
+ # search for \n, replace with \r
+ set f [open $path(test1) w]
+ chan configure $f -buffering line -translation cr
+ chan puts $f "abcde"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "abcde\r" "abcde\r"]
+test chan-io-4.3 {TranslateOutputEOL: crlf} {
+ # simple case: search for \n, replace with \r
+ set f [open $path(test1) w]
+ chan configure $f -buffering line -translation crlf
+ chan puts $f "abcde"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "abcde\r\n" "abcde\r\n"]
+test chan-io-4.4 {TranslateOutputEOL: crlf} {
+ # Keep storing more bytes in output buffer until output buffer is full. We
+ # have 13 bytes initially that would turn into 18 bytes. Fill dest buffer
+ # while (dstEnd < dstMax).
+ set f [open $path(test1) w]
+ chan configure $f -translation crlf -buffersize 16
+ chan puts -nonewline $f "1234567\n\n\n\n\nA"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
+test chan-io-4.5 {TranslateOutputEOL: crlf} {
+ # Check for overflow of the destination buffer
+ set f [open $path(test1) w]
+ chan configure $f -translation crlf -buffersize 12
+ chan puts -nonewline $f "12345678901\n456789012345678901234"
+ chan close $f
+ set x [contents $path(test1)]
+} "12345678901\r\n456789012345678901234"
+
+test chan-io-5.1 {CheckFlush: not full} {
+ set f [open $path(test1) w]
+ chan configure $f
+ chan puts -nonewline $f "12345678901234567890"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "" "12345678901234567890"]
+test chan-io-5.2 {CheckFlush: full} {
+ set f [open $path(test1) w]
+ chan configure $f -buffersize 16
+ chan puts -nonewline $f "12345678901234567890"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "1234567890123456" "12345678901234567890"]
+test chan-io-5.3 {CheckFlush: not line} {
+ set f [open $path(test1) w]
+ chan configure $f -buffering line
+ chan puts -nonewline $f "12345678901234567890"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "" "12345678901234567890"]
+test chan-io-5.4 {CheckFlush: line} {
+ set f [open $path(test1) w]
+ chan configure $f -buffering line -translation lf -encoding ascii
+ chan puts -nonewline $f "1234567890\n1234567890"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "1234567890\n1234567890" "1234567890\n1234567890"]
+test chan-io-5.5 {CheckFlush: none} {
+ set f [open $path(test1) w]
+ chan configure $f -buffering none
+ chan puts -nonewline $f "1234567890"
+ set x [list [contents $path(test1)]]
+ chan close $f
+ lappend x [contents $path(test1)]
+} [list "1234567890" "1234567890"]
+
+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)]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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?} -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)]
+ list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -result [list 2 "\u4e00\u4e01"]
+set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+append a $a
+append a $a
+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)]
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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 [openpipe w+ $path(cat)]
+ chan puts -nonewline $f "hi\nwould"
+ chan flush $f
+ chan gets $f
+ chan configure $f -blocking 0
+ chan gets $f line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -result {11 abcdefghijk 3 wom}
+# Comprehensive tests
+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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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"
+ 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]
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ 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
+} -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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ 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
+} -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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf -buffersize 16
+ list [chan gets $f line] $line [testchannel inputbuffered $f]
+} -cleanup {
+ chan close $f
+} -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 [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
+ lappend x [chan gets $f]
+ chan configure $f -blocking 0
+ lappend x [chan gets $f line] $line [chan blocked $f] \
+ [testchannel inputbuffered $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456789012345\r\n123"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf -buffersize 16
+ list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456789012345\r"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf -buffersize 16
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf -buffersize 16
+ list [chan gets $f line] $line [chan tell $f]
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ 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
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto lf} -buffering none
+ chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ chan configure $f -buffersize 16
+ 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
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto lf} -buffering none
+ chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ chan configure $f -buffersize 16
+ 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
+} -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 [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
+ 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
+} -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 [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
+ 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
+} -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
+ chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto -buffersize 16
+ list [chan gets $f] [testchannel inputbuffered $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456789012345\r"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto -buffersize 16
+ list [chan gets $f] [testchannel queuedcr $f]
+} -cleanup {
+ chan close $f
+} -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)]
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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)]
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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)]
+ list [chan gets $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "123456\x1ak9012345\r"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -eofchar \x1a
+ list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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)]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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)]
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding iso2022-jp
+ list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+ chan close $f
+} -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
+ 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
+ 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
+ }]
+ chan configure $f -blocking 0
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ return $x
+} -cleanup {
+ chan close $f
+} -result {{} timeout foobarbaz timeout}
+
+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
+ chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding shiftjis -buffersize 16
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding shiftjis
+ list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ 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
+} -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 {
+ 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
+} -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} -constraints {testchannel} -body {
+ # (bufPtr->nextPtr == NULL)
+ set f [open $path(test1) w]
+ chan configure $f -encoding ascii -translation lf
+ chan puts -nonewline $f "123456789012345\r\n2345678"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding ascii -translation auto -buffersize 16
+ # here
+ chan gets $f
+ testchannel inputbuffered $f
+} -cleanup {
+ chan close $f
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -translation lf -encoding ascii -buffering none
+ chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
+ 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
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto binary}
+ chan puts -nonewline $f "abcdefghijklmno\r"
+ chan flush $f
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+ chan close $f
+} -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} -body {
+ # not (bytesLeft == 0)
+ set f [open $path(test1) w+]
+ chan configure $f -translation binary
+ chan puts $f "${a}\r\nabcdef"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding binary -translation auto
+ # "${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.
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -result $a
+unset a
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
+ # (bufPtr->nextAdded < bufPtr->length)
+ set f [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto binary}
+ chan puts -nonewline $f "abcdefghijklmno\r"
+ chan flush $f
+ # here
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+ chan close $f
+} -result {15 abcdefghijklmno 1}
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ set f [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto binary} -buffersize 16
+ chan puts -nonewline $f "abcdefghijklmno\r"
+ chan flush $f
+ # here
+ list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+ chan close $f
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -translation {auto binary} -buffering none
+ chan puts -nonewline $f "abcdefghijklmno\r"
+ # here
+ 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
+} -result {15 abcdefghijklmno 1 -1 {}}
+
+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} -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)]
+ chan read $f 5
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f abcdefghijklmnopqrstuvwxyz
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -buffersize 16
+ # here
+ chan read $f 19
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f 1000
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f 1000
+} -cleanup {
+ chan close $f
+} -result {abcdefghijkl}
+
+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
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding binary
+ # here
+ chan read $f 1000
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -encoding binary
+ # here
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -buffersize 16 -encoding binary
+ # here
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-11.4 {ReadBytes: EOF char found} -body {
+ # (TranslateInputEOL() != 0)
+ set f [open $path(test1) w]
+ chan puts $f abcdefghijklmnopqrstuvwxyz
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -eofchar m -encoding binary
+ # here
+ list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -result {abcdefghijkl 1 {} 1}
+
+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
+ chan read $f 1000
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -buffersize 16
+ # here
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-12.4 {ReadChars: split-up char} -setup {
+ variable x {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
+ # (srcRead == 0)
+ 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 {
+ lappend x [chan read $f] [testchannel inputbuffered $f]
+ }]
+ chan configure $f -encoding shiftjis
+ vwait [namespace which -variable x]
+ chan configure $f -encoding binary -blocking 1
+ chan puts -nonewline $f "\x7b"
+ 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
+} -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 [openpipe r+ $path(test1)]
+ chan event $f readable [namespace code {
+ lappend x [chan read $f]
+ if {[chan eof $f]} {
+ lappend x eof
+ }
+ }]
+ chan puts $f "go1"
+ chan flush $f
+ chan configure $f -blocking 0 -encoding utf-8
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
+ chan puts $f "go2"
+ chan flush $f
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
+ chan puts $f "go3"
+ chan flush $f
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ lappend x [catch {chan close $f} msg] $msg
+} -result "{} timeout {} timeout \u7266 {} eof 0 {}"
+
+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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\r\ndef\r"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\r\ndef\rfgh"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\r\ndef\nfgh"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation crlf
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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 [openpipe w+ $path(cat)]
+ chan configure $f -blocking 0 -buffering none -translation {auto lf}
+ chan event $f read [namespace code {
+ lappend x [chan read $f] [testchannel queuedcr $f]
+ }]
+ 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
+} -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
+ chan puts -nonewline $f "abcd\r"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto
+ list [chan read $f] [testchannel queuedcr $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\r\ndef"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\ndef"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "abcd\ndefgh"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto -eofchar e
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
+ chan close $f
+ set f [open $path(test1)]
+ chan configure $f -translation auto -eofchar e
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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 {[testConstraint testchannel]} {
+ set consoleFileNames [lsort [testchannel open]]
+} else {
+ # just to avoid an error
+ set consoleFileNames [list]
+}
+
+test chan-io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
+ 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} -setup {
+ interp create x
+ 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
+} -result {line line none}
+set path(test3) [makeFile {} test3]
+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
+ chan close stdout
+ chan close stderr
+ set f [}
+ 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 stdout out
+ chan puts stderr err
+ chan close $f
+ chan close $f2
+ chan close $f3
+ }
+ chan close $f
+ set result [exec [interpreter] $path(test1)]
+ 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
+} -result {{
+out
+} {err
+}}
+# This test relies on the fact that stdout is used before stderr.
+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
+ chan close stderr
+ set f [}
+ 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 stdout $f2
+ chan puts stderr $f3
+ chan close $f
+ chan close $f2
+ chan close $f3
+ }
+ chan close $f
+ set result [exec [interpreter] $path(test1)]
+ 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
+} -result {{ chan close stdin
+stdout
+} {stderr
+}}
+catch {interp delete z}
+test chan-io-14.5 {Tcl_GetChannel: stdio name translation} -setup {
+ interp create z
+} -body {
+ chan eof stdin
+ catch {z eval chan flush stdin} msg1
+ catch {z eval chan close stdin} msg2
+ catch {z eval chan flush stdin} msg3
+ list $msg1 $msg2 $msg3
+} -cleanup {
+ interp delete z
+} -result {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
+test chan-io-14.6 {Tcl_GetChannel: stdio name translation} -setup {
+ interp create z
+} -body {
+ chan eof stdout
+ catch {z eval chan flush stdout} msg1
+ catch {z eval chan close stdout} msg2
+ catch {z eval chan flush stdout} msg3
+ list $msg1 $msg2 $msg3
+} -cleanup {
+ interp delete z
+} -result {{} {} {can not find channel named "stdout"}}
+test chan-io-14.7 {Tcl_GetChannel: stdio name translation} -setup {
+ interp create z
+} -body {
+ chan eof stderr
+ catch {z eval chan flush stderr} msg1
+ catch {z eval chan close stderr} msg2
+ catch {z eval chan flush stderr} msg3
+ list $msg1 $msg2 $msg3
+} -cleanup {
+ interp delete z
+} -result {{} {} {can not find channel named "stderr"}}
+set path(script) [makeFile {} script]
+test chan-io-14.8 {reuse of stdio special channels} -setup {
+ file delete $path(script)
+ file delete $path(test1)
+} -constraints {stdio openpipe} -body {
+ set f [open $path(script) w]
+ chan puts -nonewline $f {
+ chan close stderr
+ set f [}
+ chan puts $f [list open $path(test1) w]]
+ chan puts -nonewline $f {
+ chan puts stderr hello
+ chan close $f
+ set f [}
+ chan puts $f [list open $path(test1) r]]
+ chan puts $f {
+ chan puts [chan gets $f]
+ }
+ chan close $f
+ set f [openpipe r $path(script)]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -result hello
+test chan-io-14.9 {reuse of stdio special channels} -setup {
+ file delete $path(script)
+ file delete $path(test1)
+} -constraints {stdio openpipe fileevent} -body {
+ set f [open $path(script) w]
+ chan puts $f {
+ array set path [lindex $argv 0]
+ set f [open $path(test1) w]
+ chan puts $f hello
+ chan close $f
+ chan close stderr
+ set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
+ chan puts [chan gets $f]
+ }
+ chan close $f
+ 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 [expr {[testConstraint win] ? 10000 : 500}]
+ file delete $path(script)
+ file delete $path(test1)
+} -result hello
+
+test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest {
+} {}
+
+test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest {
+} {}
+
+# Test channel table management. The functions tested are GetChannelTable,
+# DeleteChannelTable, Tcl_RegisterChannel, Tcl_UnregisterChannel,
+# Tcl_GetChannel and Tcl_CreateChannel.
+#
+# 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} -setup {
+ set l ""
+} -constraints {testchannel} -body {
+ set l1 [testchannel refcount stdin]
+ chan eof stdin
+ interp create x
+ lappend l [expr {[testchannel refcount stdin] - $l1}]
+ x eval {chan eof stdin}
+ lappend l [expr {[testchannel refcount stdin] - $l1}]
+ interp delete x
+ 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
+ lappend l [expr {[testchannel refcount stdout] - $l1}]
+ x eval {chan eof stdout}
+ lappend l [expr {[testchannel refcount stdout] - $l1}]
+ interp delete x
+ 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
+ lappend l [expr {[testchannel refcount stderr] - $l1}]
+ x eval {chan eof stderr}
+ lappend l [expr {[testchannel refcount stderr] - $l1}]
+ interp delete x
+ 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)
+ set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
+ lappend l [lindex [testchannel info $f] 15]
+ chan close $f
+ if {[catch {lindex [testchannel info $f] 15} msg]} {
+ lappend l $msg
+ } else {
+ lappend l "very broken: $f found after being chan closed"
+ }
+ 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)
+ set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
+ lappend l [lindex [testchannel info $f] 15]
+ interp create x
+ interp share "" $f x
+ lappend l [lindex [testchannel info $f] 15]
+ x eval chan close $f
+ lappend l [lindex [testchannel info $f] 15]
+ interp delete x
+ lappend l [lindex [testchannel info $f] 15]
+ chan close $f
+ if {[catch {lindex [testchannel info $f] 15} msg]} {
+ lappend l $msg
+ } else {
+ lappend l "very broken: $f found after being chan closed"
+ }
+ 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)
+ set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
+ lappend l [lindex [testchannel info $f] 15]
+ interp create x
+ interp share "" $f x
+ lappend l [lindex [testchannel info $f] 15]
+ interp delete x
+ lappend l [lindex [testchannel info $f] 15]
+ chan close $f
+ if {[catch {lindex [testchannel info $f] 15} msg]} {
+ lappend l $msg
+ } else {
+ lappend l "very broken: $f found after being chan closed"
+ }
+ 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} -setup {
+ file delete $path(test1)
+} -body {
+ set f [open $path(test1) w]
+ chan eof $f
+} -cleanup {
+ chan close $f
+} -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"}
+test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup {
+ file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
+ lappend l [chan eof $f]
+ chan close $f
+ if {[catch {lindex [testchannel info $f] 15} msg]} {
+ lappend l $msg
+ } else {
+ lappend l "very broken: $f found after being chan closed"
+ }
+ string equal $l [list 0 "can not find channel named \"$f\""]
+} -result 1
+
+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]
+ chan configure $f -encoding
+} -cleanup {
+ encoding system $old
+ chan close $f
+ chan close $a
+} -result {ascii}
+test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
+ set f [open $path(test1) w+]
+ list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
+ chan close $f
+} -result [list [list \x1a ""] {auto crlf}]
+test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
+ set f [open $path(test1) w+]
+ list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
+ chan close $f
+} -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
+ set f1 [}
+ chan puts $f [list open $path(stdout) w]]
+ chan puts $f {
+ chan configure $f1 -buffersize 777
+ chan puts stderr [chan configure stdout -buffersize]
+ }
+ chan close $f
+ 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 {
+} {}
+
+# Test management of attributes associated with a channel, such as its default
+# translation, its name and type, etc. The functions tested in this group are
+# Tcl_GetChannelName, Tcl_GetChannelType and Tcl_GetChannelFile.
+# Tcl_GetChannelInstanceData not tested because files do not use the instance
+# data.
+
+test chan-io-22.1 {Tcl_GetChannelMode} emptyTest {
+ # Not used anywhere in Tcl.
+} {}
+
+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
+} -result ok
+
+test chan-io-24.1 {Tcl_GetChannelType} -constraints {testchannel} -setup {
+ file delete $path(test1)
+} -body {
+ set f [open $path(test1) w]
+ testchannel type $f
+} -cleanup {
+ chan close $f
+} -result "file"
+
+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
+ lappend l [testchannel inputbuffered $f]
+ lappend l [chan tell $f]
+} -cleanup {
+ chan close $f
+} -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
+ 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)
+} -result {6 6 0 6}
+
+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 [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} -setup {
+ file delete $path(test1)
+} -body {
+ set f [open $path(test1) w]
+ chan flush $f
+ file size $path(test1)
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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)]
+} -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 {}
+ chan puts $f hello
+ lappend l [file size $path(test1)]
+ chan close $f
+ lappend l [file size $path(test1)]
+} -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
+ lappend l [file size $path(test1)]
+ for {set i 0} {$i < 12} {incr i} {
+ chan puts $f hello
+ }
+ lappend l [file size $path(test1)]
+ chan flush $f
+ lappend l [file size $path(test1)]
+} -cleanup {
+ chan close $f
+} -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 {}
+ lappend l [file size $path(test1)]
+ for {set i 0} {$i < 12} {incr i} {
+ chan puts $f hello
+ }
+ lappend l [file size $path(test1)]
+ chan close $f
+ lappend l [file size $path(test1)]
+} -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} -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 -buffering none -eofchar {}
+ while {![chan eof stdin]} {
+ after 20
+ chan puts -nonewline $f [chan read stdin 1024]
+ }
+ chan close $f
+ }
+ chan close $f
+ set x 01234567890123456789012345678901
+ for {set i 0} {$i < 11} {incr i} {
+ set x "$x$x"
+ }
+ set f [open $path(output) w]
+ chan close $f
+ set f [openpipe w $path(pipe)]
+ chan configure $f -blocking off
+ chan puts -nonewline $f $x
+ chan close $f
+ set counter 0
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+ after 20 [list incr [namespace which -variable counter]]
+ vwait [namespace which -variable counter]
+ }
+ if {$counter == 1000} {
+ set result "file size only [file size $path(output)]"
+ } else {
+ set result 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} -setup {
+ file delete $path(test1)
+ set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
+ interp create x
+ interp share "" $f x
+ lappend l [testchannel refcount $f]
+ x eval chan close $f
+ interp delete x
+ lappend l [testchannel refcount $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f abc
+ chan close $f
+ x eval chan puts $f def
+ x eval chan close $f
+ interp delete x
+ set f [open $path(test1) r]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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
+ # side of the pipe already chan closed, so that writing would cause an
+ # error "invalid file".
+ chan configure stdout -eofchar {}
+ chan configure stderr -eofchar {}
+ set f [open $path(output) w]
+ chan configure $f -translation lf -buffering none
+ for {set x 0} {$x < 20} {incr x} {
+ after 20
+ chan puts -nonewline $f [chan read stdin 1024]
+ }
+ chan close $f
+ }
+ chan close $f
+ set x 01234567890123456789012345678901
+ for {set i 0} {$i < 11} {incr i} {
+ set x "$x$x"
+ }
+ set f [open $path(output) w]
+ chan close $f
+ set f [openpipe r+ $path(pipe)]
+ chan configure $f -blocking off -eofchar {}
+ chan puts -nonewline $f $x
+ chan close $f
+ set counter 0
+ while {([file size $path(output)] < 20480) && ($counter < 1000)} {
+ after 20 [list incr [namespace which -variable counter]]
+ vwait [namespace which -variable counter]
+ }
+ if {$counter == 1000} {
+ set result probably_broken
+ } else {
+ set result ok
+ }
+} -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]]
+ chan close $f
+ lappend l [lsort [testchannel open]]
+ set x [list $consoleFileNames \
+ [lsort [list {*}$consoleFileNames $f]] \
+ $consoleFileNames]
+ 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 {
+ set f [open $path(script) w]
+ chan puts $f {
+ chan close stdin
+ chan puts [testchannel open]
+ }
+ chan close $f
+ set f [openpipe r $path(script)]
+ set l [chan gets $f]
+ chan close $f
+ lsort $l
+} -result {file1 file2}
+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}
+ puts DONE
+ exit 0
+ } cat.tcl]
+ variable done
+} -body {
+ 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
+ }
+ }]
+ vwait [namespace which -variable done]
+ after cancel $timer
+ close $ff r
+ list $done $acc
+} -cleanup {
+ removeFile cat.tcl
+} -result {Succeeded {Hey DONE}}
+test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup {
+ set echo [makeFile {
+ proc accept {s args} {set ::sok $s}
+ set s [socket -server accept 0]
+ 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
+ exit 0
+ } echo.tcl]
+ variable done
+ unset -nocomplain done
+ set done ""
+ set timer ""
+ set ff [openpipe r $echo]
+ gets $ff port
+} -body {
+ 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
+ }
+ }]
+ vwait [namespace which -variable done]
+ list $done $acc
+} -cleanup {
+ catch {close $s}
+ close $ff
+ after cancel $timer
+ removeFile echo.tcl
+} -result {Succeeded {Hey DONE}}
+
+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)
+} -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)
+} -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
+ 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
+} -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
+ 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
+} -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
+ 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
+} -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
+ 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)]
+ chan flush $f
+ lappend l [testchannel outputbuffered $f]
+ lappend l [file size $path(test1)]
+} -cleanup {
+ chan close $f
+} -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
+ 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)]
+ chan puts $f hello
+ 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
+} -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]
+ for {set x 0} {$x < 10} {incr x} {
+ chan puts $f1 [chan gets $f2]
+ }
+ chan close $f2
+ chan close $f1
+ file size $path(test1)
+} -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]
+ for {set x 0} {$x < 10} {incr x} {
+ chan puts -nonewline $f1 [chan gets $f2]
+ }
+ chan close $f1
+ chan close $f2
+ file size $path(test1)
+} -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 {
+ for {set x 0} {$x < 10} {incr x} {
+ chan puts [chan gets $f1]
+ }
+ }
+ chan close $f1
+ 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 ne $l2} {
+ set y broken:$x
+ }
+ }
+ return $y
+} -cleanup {
+ chan close $f1
+ chan close $f2
+} -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]
+ chan puts [chan gets stdin]
+ }
+ chan close $f1
+ set y ok
+ 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 ne $backline} {
+ set y broken1
+ }
+ set line [chan gets $f2]
+ chan puts $f1 $line
+ set backline [chan gets $f1]
+ if {$line ne $backline} {
+ set y broken2
+ }
+ return $y
+} -cleanup {
+ chan close $f1
+ chan close $f2
+} -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]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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]
+ chan flush $fd
+} -returnCodes error -cleanup {
+ catch {chan close $fd}
+} -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
+ file size $path(test1)
+} -cleanup {
+ chan close $f1
+} -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
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [file size $path(test1)]
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [file size $path(test1)]
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [file size $path(test1)]
+} -cleanup {
+ chan close $f1
+} -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 ""
+ chan puts $f1 hello
+ chan puts $f1 hello
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [file size $path(test1)]
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [file size $path(test1)]
+ chan puts $f1 hello
+ chan close $f1
+ lappend x [file size $path(test1)]
+} -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"
+ for {set x 0} {$x < 100} {incr x} {
+ chan puts $f1 $line
+ }
+ set z ""
+ lappend z [file size $path(test1)]
+ for {set x 0} {$x < 100} {incr x} {
+ chan puts $f1 $line
+ }
+ lappend z [file size $path(test1)]
+ chan close $f1
+ lappend z [file size $path(test1)]
+} -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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ chan flush $f1
+ chan gets $f1
+} -cleanup {
+ catch {chan close $f1}
+} -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
+ chan puts hello
+ chan puts hello
+ chan flush stdout
+ chan gets stdin
+ chan puts bye
+ chan flush stdout
+ }
+ chan close $f1
+ 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
+} -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
+ chan puts hello
+ chan gets stdin
+ chan puts bye
+ }
+ chan close $f1
+ 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
+} -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)]
+ 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
+} -result "{} {Line 1\nLine 2}"
+test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
+ file delete $path(test3)
+} -constraints {stdio openpipe fileevent} -body {
+ 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]
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result "Line 1\nLine 2\n"
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
+ set f [open "|[list cat -u]" r+]
+ chan puts $f "Line1"
+ chan flush $f
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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
+} -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 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 {
+ set x {this was supposed to fail and did not}
+ }
+ string tolower $x
+} -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
+ file size $path(test1)
+} -cleanup {
+ chan close $f
+} -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)
+} -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)
+} -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}
+ set x [list while {![chan eof stdin]}]
+ set x "$x {"
+ chan puts $f $x
+ chan puts $f { chan puts -nonewline $f [chan read stdin 4096]}
+ chan puts $f { chan flush $f}
+ chan puts $f "}"
+ chan puts $f {chan close $f}
+ chan close $f
+ set x 01234567890123456789012345678901
+ for {set i 0} {$i < 11} {incr i} {
+ set x "$x$x"
+ }
+ set f [open $path(output) w]
+ chan close $f
+ set f [openpipe r+ $path(pipe)]
+ chan configure $f -blocking off
+ chan puts -nonewline $f $x
+ chan close $f
+ set counter 0
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+ after 10 [list incr [namespace which -variable counter]]
+ vwait [namespace which -variable counter]
+ }
+ if {$counter == 1000} {
+ set result "file size only [file size $path(output)]"
+ } else {
+ set result ok
+ }
+ # allow a little time for the background process to chan close.
+ # otherwise, the following test fails on the [file delete $path(output)
+ # on Windows because a process still has the file open.
+ after 100 set v 1; vwait v
+ 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}
+ set x [list while {![chan eof stdin]}]
+ set x "$x \{"
+ chan puts $f $x
+ chan puts $f { after 20}
+ chan puts $f { chan puts -nonewline $f [chan read stdin 1024]}
+ chan puts $f { chan flush $f}
+ chan puts $f "\}"
+ chan puts $f {chan close $f}
+ chan close $f
+ set x 01234567890123456789012345678901
+ for {set i 0} {$i < 11} {incr i} {
+ set x "$x$x"
+ }
+ set f [open $path(output) w]
+ chan close $f
+ set f [openpipe r+ $path(pipe)]
+ chan configure $f -blocking off
+ chan puts -nonewline $f $x
+ chan close $f
+ set counter 0
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+ after 20 [list incr [namespace which -variable counter]]
+ vwait [namespace which -variable counter]
+ }
+ if {$counter == 1000} {
+ set result "file size only [file size $path(output)]"
+ } else {
+ set result ok
+ }
+} -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
+ chan puts $f hello
+ chan puts $f bye
+ chan puts $f strange
+ }
+ chan close $f
+} -constraints exec -body {
+ exec [interpreter] $path(script)
+ set f [open $path(test1) r]
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ proc writelots {s l} {
+ for {set i 0} {$i < 2000} {incr i} {
+ 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]]
+ chan configure $s -blocking off
+ set x accepted
+ }
+ proc readit {s} {
+ variable c
+ variable x
+ set l [chan gets $s]
+ if {[chan eof $s]} {
+ chan close $s
+ set x done
+ } elseif {([string length $l] > 0) || ![chan blocked $s]} {
+ incr c
+ }
+ }
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+ set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
+ vwait [namespace which -variable x]
+ chan configure $cs -blocking off
+ writelots $cs $l
+ chan close $cs
+ chan close $ss
+ vwait [namespace which -variable x]
+ 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]
+ proc accept {s a p} {
+ chan puts $s hello
+ chan close $s
+ }
+ set c [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]]
+ interp share {} $c x
+ interp share {} $c y
+ chan close $c
+ x eval {
+ proc readit {s} {
+ chan gets $s
+ if {[chan eof $s]} {
+ chan close $s
+ }
+ }
+ }
+ y eval {
+ proc readit {s} {
+ chan gets $s
+ if {[chan eof $s]} {
+ chan close $s
+ }
+ }
+ }
+ x eval "chan event $c readable \{readit $c\}"
+ 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} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+ chan close $f
+} -result {{hello
+there
+and
+here
+} 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]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+ chan close $f
+} -result {{hello
+there
+and
+here
+} 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]
+ list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+ chan close $f
+} -result {{hello
+there
+and
+here
+} 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
+ chan puts -nonewline $f x ;# shift crlf across block boundary
+ for {set i 0} {$i < 700} {incr i} {
+ chan puts $f $line
+ }
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation auto
+ string length [chan read $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan puts -nonewline $f x ;# shift crlf across block boundary
+ for {set i 0} {$i < 700} {incr i} {
+ chan puts $f $line
+ }
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation crlf
+ string length [chan read $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result {hello
+there
+and
+here
+}
+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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result {hello
+there
+and
+here
+}
+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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result {hello
+there
+and
+here
+}
+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]
+ chan puts $f $s
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $s
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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 {}
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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 x [chan gets $f]
+ 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
+} -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 {}
+ 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 x [chan gets $f]
+ 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
+} -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
+ 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
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $c
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation lf -eofchar \x1a
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $c
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $c
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation cr -eofchar \x1a
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $c
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan puts $f $c
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation crlf -eofchar \x1a
+ list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -result {8 1}
+
+# Test end of line translations. Functions tested are Tcl_Write and
+# Tcl_Gets.
+
+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]
+ 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
+} -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]
+ 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
+} -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]
+ 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
+} -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
+ 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
+} -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
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+ lappend l [string length [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan configure $f -translation]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan configure $f -translation
+} -cleanup {
+ chan close $f
+} -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} -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
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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]
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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
+ 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
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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
+ lappend l [chan gets $f]
+ lappend l [chan gets $f]
+ 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
+} -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
+ 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
+ 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
+} -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
+ 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
+ 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
+} -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 {}
+ 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 {}
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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 {}
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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 {}
+ 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]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ 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
+ 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
+} -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
+ 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
+ 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
+} -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 {}
+ 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
+ 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
+} -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 {}
+ 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
+ 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
+} -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 {}
+ 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
+ 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
+} -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 {}
+ 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
+ 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
+} -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
+ chan puts -nonewline $f x ;# shift crlf across block boundary
+ for {set i 0} {$i < 700} {incr i} {
+ chan puts $f $line
+ }
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation crlf
+ while {[chan gets $f line] >= 0} {
+ append c $line\n
+ }
+ chan close $f
+ string length $c
+} -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
+ chan puts -nonewline $f x ;# shift crlf across block boundary
+ for {set i 0} {$i < 700} {incr i} {
+ chan puts $f $line
+ }
+ chan close $f
+ set f [open $path(test1) r]
+ chan configure $f -translation auto
+ while {[chan gets $f line] >= 0} {
+ append c $line\n
+ }
+ chan close $f
+ string length $c
+} -result [expr 700*15+1]
+
+# Test Tcl_Read and buffering.
+
+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} -setup {
+ set f [open $path(longfile) r]
+} -body {
+ chan read $f -1
+} -returnCodes error -cleanup {
+ chan close $f
+} -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]
+ string length [chan read $f 1024]
+} -cleanup {
+ chan close $f
+} -result 1024
+test chan-io-32.5 {Tcl_Read, multiple buffers} -body {
+ set f [open $path(longfile) r]
+ chan configure $f -buffersize 100
+ string length [chan read $f 1024]
+} -cleanup {
+ chan close $f
+} -result 1024
+test chan-io-32.6 {Tcl_Read, very large read} {
+ set f1 [open $path(longfile) r]
+ set z [chan read $f1 1000000]
+ chan close $f1
+ set l [string length $z]
+ set x ok
+ set z [file size $path(longfile)]
+ if {$z != $l} {
+ set x "$z != $l"
+ }
+ set x
+} ok
+test chan-io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+ set f1 [open $path(longfile) r]
+ chan configure $f1 -blocking off
+ set z [chan read $f1 20]
+ chan close $f1
+ set l [string length $z]
+ set x ok
+ if {$l != 20} {
+ set x "$l != 20"
+ }
+ set x
+} ok
+test chan-io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+ set f1 [open $path(longfile) r]
+ chan configure $f1 -blocking off
+ set z [chan read $f1 1000000]
+ chan close $f1
+ set x ok
+ set l [string length $z]
+ set z [file size $path(longfile)]
+ if {$z != $l} {
+ set x "$z != $l"
+ }
+ set x
+} ok
+test chan-io-32.9 {Tcl_Read, read to end of file} {
+ set f1 [open $path(longfile) r]
+ set z [chan read $f1]
+ chan close $f1
+ set l [string length $z]
+ set x ok
+ set z [file size $path(longfile)]
+ if {$z != $l} {
+ set x "$z != $l"
+ }
+ set x
+} ok
+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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ chan flush $f1
+ chan read $f1
+} -cleanup {
+ chan close $f1
+} -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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [chan read $f1 6]
+ chan puts $f1 hello
+ chan flush $f1
+ lappend x [chan read $f1]
+} -cleanup {
+ chan close $f1
+} -result {{hello
+} {hello
+}}
+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]
+ chan read -nonewline $f1
+} -cleanup {
+ chan close $f1
+} -result {hello
+bye}
+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]
+ list [string length $c] $c
+} -cleanup {
+ chan close $f1
+} -result {9 {hello
+bye}}
+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)]
+ list [chan read $f 1] [chan read $f 2] [chan read $f]
+} -cleanup {
+ chan close $f
+} -result {T wo { lines: this one
+and this one
+}}
+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)]
+ chan read $f 100
+} -cleanup {
+ chan close $f
+} -result {Two lines: this one
+and this one
+}
+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)]
+ chan read -nonewline $f
+} -cleanup {
+ chan close $f
+} -result {Two lines: this one
+and this one}
+
+# Test Tcl_Gets.
+
+test chan-io-33.1 {Tcl_Gets, reading what was written} -setup {
+ file delete $path(test1)
+} -body {
+ set f1 [open $path(test1) w]
+ chan puts $f1 "first line"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan gets $f1
+} -cleanup {
+ chan close $f1
+} -result {first line}
+test chan-io-33.2 {Tcl_Gets into variable} {
+ set f1 [open $path(longfile) r]
+ set c [chan gets $f1 x]
+ set l [string length x]
+ set z ok
+ if {$l != $l} {
+ set z broken
+ }
+ chan close $f1
+ set z
+} ok
+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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ chan flush $f1
+ chan gets $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ chan puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ chan close $f
+ set f [open $path(test3)]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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} -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 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
+} -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 f [open $path(test3) r]
+} -body {
+ set x 24
+ chan gets $f x(0)
+} -returnCodes error -cleanup {
+ chan close $f
+} -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 {}
+ set x ""
+ for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+ for {set y 0} {$y < 100} {incr y} {chan puts $f $x}
+ chan close $f
+ set f [open $path(test3) r]
+ chan configure $f -translation lf
+ for {set y 0} {$y < 100} {incr y} {chan gets $f}
+ chan close $f
+ set y
+} 100
+test chan-io-33.9 {Tcl_Gets, exercising double buffering} {
+ set f [open $path(test3) w]
+ chan configure $f -translation lf -eofchar {}
+ set x ""
+ for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+ for {set y 0} {$y < 200} {incr y} {chan puts $f $x}
+ chan close $f
+ set f [open $path(test3) r]
+ chan configure $f -translation lf
+ for {set y 0} {$y < 200} {incr y} {chan gets $f}
+ chan close $f
+ set y
+} 200
+test chan-io-33.10 {Tcl_Gets, exercising double buffering} {
+ set f [open $path(test3) w]
+ chan configure $f -translation lf -eofchar {}
+ set x ""
+ for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+ for {set y 0} {$y < 300} {incr y} {chan puts $f $x}
+ chan close $f
+ set f [open $path(test3) r]
+ chan configure $f -translation lf
+ for {set y 0} {$y < 300} {incr y} {chan gets $f}
+ chan close $f
+ set y
+} 300
+
+# Test Tcl_Seek and Tcl_Tell.
+
+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
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 10 start
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 0 end
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 -10 end
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 10 current
+ chan seek $f1 10 current
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 -10 end
+ list [chan tell $f1] [chan read $f1]
+} -cleanup {
+ chan close $f1
+} -result {44 {rstuvwxyz
+}}
+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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 -10 end
+ set c1 [chan tell $f1]
+ set r1 [chan read $f1 5]
+ chan seek $f1 0 current
+ list $c1 $r1 [chan tell $f1]
+} -cleanup {
+ chan close $f1
+} -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"
+ chan close $f
+ set f [open $path(test3) RDWR]
+ set x [chan read $f 1]
+ chan seek $f 3
+ lappend x [chan read $f 1]
+ chan seek $f 0 start
+ lappend x [chan read $f 1]
+ chan seek $f 10 current
+ lappend x [chan read $f 1]
+ chan seek $f -2 end
+ lappend x [chan read $f 1]
+ chan seek $f 50 end
+ lappend x [chan read $f 1]
+ chan seek $f 1
+ lappend x [chan read $f 1]
+} -cleanup {
+ chan close $f
+} -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]
+ chan configure $f -translation lf
+ chan puts $f xyz\n123
+ chan close $f
+ set f [open $path(test3) r+]
+ chan configure $f -translation lf
+ set x [chan gets $f]
+ chan seek $f 0 current
+ chan puts $f 456
+ chan close $f
+ list $x [viewFile test3]
+} "xyz {xyz
+456}"
+test chan-io-34.11 {Tcl_Seek testing flushing of buffered output} {
+ set f [open $path(test3) w]
+ chan puts $f xyz\n123
+ chan close $f
+ set f [open $path(test3) w+]
+ chan puts $f xyzzy
+ chan seek $f 2
+ set x [chan gets $f]
+ chan close $f
+ list $x [viewFile test3]
+} "zzy xyzzy"
+test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
+ set f [open $path(test3) w]
+ chan configure $f -translation lf -eofchar {}
+ chan puts $f xyz\n123
+ chan close $f
+ set f [open $path(test3) a+]
+ chan configure $f -translation lf -eofchar {}
+ chan puts $f xyzzy
+ chan flush $f
+ set x [chan tell $f]
+ chan seek $f -4 cur
+ set y [chan gets $f]
+ chan close $f
+ list $x [viewFile test3] $y
+} {14 {xyz
+123
+xyzzy} zzy}
+test chan-io-34.13 {Tcl_Tell at start of file} -setup {
+ file delete $path(test1)
+} -body {
+ set f1 [open $path(test1) w]
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 0 end
+ chan tell $f1
+} -cleanup {
+ chan close $f1
+} -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"
+ chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+ chan close $f1
+ set f1 [open $path(test1) r]
+ chan seek $f1 10 start
+ set c1 [chan tell $f1]
+ chan seek $f1 10 current
+ list $c1 [chan tell $f1]
+} -cleanup {
+ chan close $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
+} -result -1
+test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+ set f1 [openpipe]
+ chan puts $f1 {chan puts hello}
+ chan flush $f1
+ set c [chan tell $f1]
+ chan gets $f1
+ chan close $f1
+ set c
+} -1
+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"
+ chan close $f
+ set f [open $path(test2)]
+ chan configure $f -translation lf
+ set x [chan tell $f]
+ chan read $f 3
+ lappend x [chan tell $f]
+ chan seek $f 2
+ lappend x [chan tell $f]
+ chan seek $f 10 current
+ lappend x [chan tell $f]
+ chan seek $f 0 end
+ lappend x [chan tell $f]
+} -cleanup {
+ chan close $f
+} -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]
+ chan tell $f
+} -cleanup {
+ chan close $f
+} -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
+ chan seek $f 39 start
+ lappend l [chan tell $f]
+ chan puts -nonewline $f a
+ lappend l [chan tell $f]
+ chan seek $f 407 end
+ lappend l [chan tell $f]
+} -cleanup {
+ chan close $f
+} -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
+ lappend l [chan tell $f]
+ chan puts -nonewline $f abcdef
+ lappend l [chan tell $f]
+ chan flush $f
+ lappend l [chan tell $f]
+ # 4GB offset!
+ chan seek $f 0x100000000
+ lappend l [chan tell $f]
+ chan puts -nonewline $f abcdef
+ lappend l [chan tell $f]
+ chan close $f
+ lappend l [file size $f]
+ # truncate...
+ chan close [open $path(test3) w]
+ lappend l [file size $f]
+} -result {0 6 6 4294967296 4294967302 4294967302 0}
+
+# Test 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
+ chan close $f
+ set f [open $path(test1)]
+ set x [chan eof $f]
+ lappend x [chan eof $f]
+ chan gets $f
+ lappend x [chan eof $f]
+ chan gets $f
+ lappend x [chan eof $f]
+ chan gets $f
+ lappend x [chan eof $f]
+ lappend x [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ set x [chan eof $f1]
+ chan flush $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+} -cleanup {
+ chan close $f1
+} -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 [openpipe r+ $path(pipe)]
+ chan puts $f1 hello
+ set x [chan eof $f1]
+ chan flush $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+ chan gets $f1
+ lappend x [chan eof $f1]
+} -cleanup {
+ chan close $f1
+} -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 l ""
+} -constraints {nonBlockFiles} -body {
+ chan close [open $path(test1) w]
+ set f [open $path(test1) r]
+ chan configure $f -blocking off
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 [openpipe r $path(pipe)]
+ lappend l [chan gets $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation lf -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation cr -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation auto -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ chan configure $f -translation crlf -eofchar \x1a
+ list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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 {}
+ 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
+ list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+ chan close $f
+} -result {21 8 1}
+
+# Test Tcl_InputBlocked
+
+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}
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ chan flush $f1
+ after 200
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+} -cleanup {
+ chan close $f1
+} -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}
+ 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
+} -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]
+ 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
+} -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]
+ 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]
+ return $l
+} -result {abc def ghi jkl mno {p
+} eof}
+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
+ 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
+} -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
+ 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]
+ return $l
+} -result {abc def ghi jkl mno {p
+} eof}
+
+# Test Tcl_InputBuffered
+
+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
+ lappend l [testchannel inputbuffered $f]
+ lappend l [chan tell $f]
+} -cleanup {
+ chan close $f
+} -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
+ 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
+} -result {4093 3 0 3}
+
+# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
+
+test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} -body {
+ set f [open $path(longfile) r]
+ chan configure $f -buffersize
+} -cleanup {
+ chan close $f
+} -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]
+ chan configure $f -buffersize 1
+ lappend l [chan configure $f -buffersize]
+ chan configure $f -buffersize -1
+ lappend l [chan configure $f -buffersize]
+ chan configure $f -buffersize 0
+ lappend l [chan configure $f -buffersize]
+ chan configure $f -buffersize 100000
+ lappend l [chan configure $f -buffersize]
+ chan configure $f -buffersize 10000000
+ lappend l [chan configure $f -buffersize]
+} -cleanup {
+ chan close $f
+} -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]
+ chan configure $chan -buffersize 10
+ set var [chan read $chan 2]
+ chan configure $chan -buffersize 32
+ append var [chan read $chan]
+ chan close $chan
+} {}
+
+# Test Tcl_SetChannelOption, Tcl_GetChannelOption
+
+test chan-io-39.1 {Tcl_GetChannelOption} -setup {
+ file delete $path(test1)
+} -body {
+ set f1 [open $path(test1) w]
+ chan configure $f1 -blocking
+} -cleanup {
+ chan close $f1
+} -result 1
+#
+# Test 17.2 was removed.
+#
+test chan-io-39.2 {Tcl_GetChannelOption} -setup {
+ file delete $path(test1)
+} -body {
+ set f1 [open $path(test1) w]
+ chan configure $f1 -buffering
+} -cleanup {
+ chan close $f1
+} -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
+ chan configure $f1 -buffering
+} -cleanup {
+ chan close $f1
+} -result line
+test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} -setup {
+ file delete $path(test1)
+ 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]
+ chan configure $f1 -buffering none
+ lappend l [chan configure $f1 -buffering]
+ chan configure $f1 -buffering line
+ lappend l [chan configure $f1 -buffering]
+ chan configure $f1 -buffering full
+ lappend l [chan configure $f1 -buffering]
+} -cleanup {
+ chan close $f1
+} -result {full line none line full}
+test chan-io-39.5 {Tcl_GetChannelOption, invariance} -setup {
+ file delete $path(test1)
+ 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
+} -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
+ file size $path(test1)
+} -cleanup {
+ chan close $f1
+} -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
+ 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
+} -result {0 21}
+test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup {
+ file delete $path(test1)
+ 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)]
+ chan puts -nonewline $f1 hello
+ lappend l [file size $path(test1)]
+ chan configure $f1 -buffering full
+ chan puts -nonewline $f1 hello
+ lappend l [file size $path(test1)]
+ chan configure $f1 -buffering none
+ lappend l [file size $path(test1)]
+ chan puts -nonewline $f1 hello
+ lappend l [file size $path(test1)]
+ chan close $f1
+ lappend l [file size $path(test1)]
+} -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]
+ lappend x [chan configure $f1 -blocking]
+ chan configure $f1 -blocking off
+ lappend x [chan configure $f1 -blocking]
+ lappend x [chan gets $f1]
+ lappend x [chan read $f1 1000]
+ lappend x [chan blocked $f1]
+ lappend x [chan eof $f1]
+} -cleanup {
+ chan close $f1
+} -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
+ after 100
+ chan puts hi
+ chan gets stdin
+ }
+ chan close $f1
+ set f1 [openpipe r+ $path(pipe)]
+ chan configure $f1 -blocking off -buffering line
+ lappend x [chan configure $f1 -blocking]
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ chan configure $f1 -blocking on
+ chan puts $f1 hello
+ chan configure $f1 -blocking off
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ chan configure $f1 -blocking on
+ chan puts $f1 bye
+ chan configure $f1 -blocking off
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ chan configure $f1 -blocking on
+ lappend x [chan configure $f1 -blocking]
+ lappend x [chan gets $f1]
+ lappend x [chan blocked $f1]
+ lappend x [chan eof $f1]
+ lappend x [chan gets $f1]
+ lappend x [chan eof $f1]
+} -cleanup {
+ chan close $f1
+} -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
+ chan configure $f -buffersize
+} -cleanup {
+ chan close $f
+} -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
+ chan configure $f -buffersize
+} -cleanup {
+ chan close $f
+} -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
+ chan configure $f -buffersize
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -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
+ chan read $f
+} -cleanup {
+ chan close $f
+} -result \u7266
+test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+} -body {
+ chan configure $f -encoding foobar
+} -returnCodes error -cleanup {
+ chan close $f
+} -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
+ chan event $f readable [namespace code { lappend x [chan read $f] }]
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
+ chan configure $f -encoding utf-8
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
+ chan configure $f -encoding binary
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
+ return $x
+} -cleanup {
+ chan close $f
+} -result "{} timeout {} timeout \xe7 timeout"
+test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
+ -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}
+ chan configure $s2 -translation
+} -cleanup {
+ chan close $s1
+ chan close $s2
+} -result {auto lf}
+test chan-io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
+ -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}
+ chan configure $s2 -translation
+} -cleanup {
+ chan close $s1
+ chan close $s2
+} -result {auto crlf}
+test chan-io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
+ -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}
+ chan configure $s2 -translation
+} -cleanup {
+ chan close $s1
+ chan close $s2
+} -result {auto cr}
+test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
+ -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}
+ chan configure $s2 -translation
+} -cleanup {
+ chan close $s1
+ chan close $s2
+} -result {auto crlf}
+test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
+ file delete $path(test1)
+ 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
+} -result {{{} {}} {O G} {D D}}
+test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
+ file delete $path(test1)
+ 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
+} -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]
+} -cleanup {
+ chan close $sock
+} -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]
+} -cleanup {
+ chan close $sock
+} -result {{{}} auto}
+
+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
+ set f [open $path(test3) RDWR]
+ chan puts -nonewline $f "ab"
+ chan seek $f 0 current
+ set x [chan gets $f]
+ chan close $f
+ set f [open $path(test3) r]
+ lappend x [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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]]
+ chan puts $f "line 1"
+ chan close $f
+ set f [open $path(test3) r]
+ lappend x [chan gets $f]
+} -cleanup {
+ chan close $f
+} -result {0600 {line 1}}
+test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
+ file delete $path(test3)
+} -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]
+} -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
+ chan close $f
+ set f [open $path(test3) {WRONLY CREAT}]
+ chan configure $f -eofchar {}
+ chan puts -nonewline $f "ab"
+ chan close $f
+ set f [open $path(test3) r]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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
+ chan close $f
+ set f [open $path(test3) {WRONLY APPEND}]
+ chan configure $f -translation lf
+ chan puts $f "new line"
+ chan seek $f 0
+ chan puts $f "abc"
+ chan close $f
+ set f [open $path(test3) r]
+ chan configure $f -translation lf
+ chan seek $f 6 current
+ lappend x [chan gets $f]
+ lappend x [chan gets $f]
+} -cleanup {
+ chan close $f
+} -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} -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
+} -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
+ set f [open $path(test3) {WRONLY TRUNC}]
+ chan puts $f abc
+ chan close $f
+ set f [open $path(test3) r]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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]
+ chan gets $f
+} -cleanup {
+ chan close $f
+} -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]
+ list [chan gets $f] [catch {chan puts $f Test} msg] $msg
+} -cleanup {
+ chan close $f
+} -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
+} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
+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} -body {
+ makeFile xyzzy test3
+ set f [open $path(test3) WRONLY]
+ chan configure $f -eofchar {}
+ chan puts -nonewline $f "ab"
+ chan seek $f 0 current
+ set x [list [catch {chan gets $f} msg] $msg]
+ chan close $f
+ lappend x [viewFile test3]
+} -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
+} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
+test chan-io-40.15 {POSIX open access modes: RDWR} {
+ makeFile xyzzy test3
+ set f [open $path(test3) RDWR]
+ chan puts -nonewline $f "ab"
+ chan seek $f 0 current
+ set x [chan gets $f]
+ chan close $f
+ lappend x [viewFile test3]
+} {zzy abzzy}
+test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
+ makeFile {Some text} _test_ ~
+} -body {
+ file exists [file join $::env(HOME) _test_]
+} -cleanup {
+ removeFile _test_ ~
+} -result 1
+test chan-io-40.17 {tilde substitution in open} -setup {
+ set home $::env(HOME)
+} -body {
+ unset ::env(HOME)
+ open ~/foo
+} -returnCodes error -cleanup {
+ set ::env(HOME) $home
+} -result {couldn't find HOME environment variable to expand path}
+
+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
+#
+
+set path(foo) [makeFile {} foo]
+set f [open $path(foo) w+]
+
+test chan-io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} {
+ list [chan event $f readable] [chan event $f writable]
+} {{} {}}
+test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
+ set result {}
+ chan event $f r "first script"
+ lappend result [chan event $f readable]
+ chan event $f r "new script"
+ lappend result [chan event $f readable]
+ chan event $f r "yet another"
+ lappend result [chan event $f readable]
+ chan event $f r ""
+ lappend result [chan event $f readable]
+} {{first script} {new script} {yet another} {}}
+test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
+ set result {}
+ chan event $f r "first scr\0ipt"
+ lappend result [string length [chan event $f readable]]
+ chan event $f r "new scr\0ipt"
+ lappend result [string length [chan event $f readable]]
+ chan event $f r "yet ano\0ther"
+ lappend result [string length [chan event $f readable]]
+ chan event $f r ""
+ 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"
+ lappend result [chan event $f readable] [chan event $f writable]
+ chan event $f writable "write script"
+ lappend result [chan event $f readable] [chan event $f writable]
+ chan event $f readable {}
+ lappend result [chan event $f readable] [chan event $f writable]
+ chan event $f writable {}
+ lappend result [chan event $f readable] [chan event $f writable]
+} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
+test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+ set result {}
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+ 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"
+ chan event $f3 r "chan read f3"
+ lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+ chan event $f2 r {}
+ lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+ chan event $f3 r {}
+ lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+ chan event $f r {}
+ lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+} -cleanup {
+ catch {chan close $f2}
+ catch {chan close $f3}
+} -result {{} {} {} {chan read f} {chan read f2} {chan read f3} {chan read f} {} {chan read f3} {chan read f} {} {} {} {} {}}
+
+test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+ chan event $f2 readable [namespace code {
+ set x [chan gets $f2]; chan event $f2 readable {}
+ }]
+ chan puts $f2 text; chan flush $f2
+ variable x initial
+ vwait [namespace which -variable 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} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+ proc myHandler {msg options} {
+ variable x $msg
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+ chan event $f2 readable {error bogus}
+ chan puts $f2 text; chan flush $f2
+ variable x initial
+ vwait [namespace which -variable x]
+ list $x [chan event $f2 readable]
+} -cleanup {
+ interp bgerror {} $handler
+ catch {chan close $f2}
+ catch {chan close $f3}
+} -result {bogus {}}
+test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+ chan event $f2 writable [namespace code {
+ lappend x "triggered"
+ incr count -1
+ if {$count <= 0} {
+ chan event $f2 writable {}
+ }
+ }]
+ variable x initial
+ set count 3
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable 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} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+ proc myHandler {msg options} {
+ variable x $msg
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+ chan event $f2 writable {error bad-write}
+ variable x initial
+ vwait [namespace which -variable x]
+ list $x [chan event $f2 writable]
+} -cleanup {
+ interp bgerror {} $handler
+ catch {chan close $f2}
+ catch {chan close $f3}
+} -result {bad-write {}}
+test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+ set f4 [openpipe r $path(cat) << foo]
+ chan event $f4 readable [namespace code {
+ if {[chan gets $f4 line] < 0} {
+ lappend x eof
+ chan event $f4 readable {}
+ } else {
+ lappend x $line
+ }
+ }]
+ variable x initial
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ chan close $f4
+ set x
+} {initial foo eof}
+
+chan close $f
+makeFile "foo bar" foo
+
+test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} {
+ set f [open $path(foo) r]
+ chan event $f readable [namespace code {
+ lappend x "binding triggered: \"[chan gets $f]\""
+ chan event $f readable {}
+ }]
+ chan close $f
+ set x initial
+ after 100 [namespace code {
+ set y done
+ }]
+ variable y
+ vwait [namespace which -variable y]
+ set x
+} {initial}
+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 {}
+ }]
+ chan event $f2 readable [namespace code {
+ lappend x "f2 triggered: \"[chan gets $f2]\""
+ chan event $f2 readable {}
+ }]
+ chan close $f
+ variable x initial
+ vwait [namespace which -variable x]
+ chan close $f2
+ set x
+} {initial {f2 triggered: "foo bar"}}
+test chan-io-45.3 {DeleteFileEvent, cleanup on chan close} {fileevent} {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ set f3 [open $path(foo) r]
+ chan event $f readable {f script}
+ chan event $f2 readable {f2 script}
+ chan event $f3 readable {f3 script}
+ set x {}
+ chan close $f2
+ lappend x [catch {chan event $f readable} msg] $msg \
+ [catch {chan event $f2 readable}] \
+ [catch {chan event $f3 readable} msg] $msg
+ chan close $f3
+ lappend x [catch {chan event $f readable} msg] $msg \
+ [catch {chan event $f2 readable}] \
+ [catch {chan event $f3 readable}]
+ chan close $f
+ lappend x [catch {chan event $f readable}] \
+ [catch {chan event $f2 readable}] \
+ [catch {chan event $f3 readable}]
+} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
+
+# Execute these tests only if the "testfevent" command is present.
+
+test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+ testfevent create
+ set script "set f \[[list open $path(foo) r]]\n"
+ append script {
+ set x "no event"
+ chan event $f readable [namespace code {
+ set x "f triggered: [chan gets $f]"
+ chan event $f readable {}
+ }]
+ }
+ testfevent cmd $script
+ after 1 ;# We must delay because Windows takes a little time to notice
+ update
+ testfevent cmd {chan close $f}
+ list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
+} {{f triggered: foo bar} after}
+test chan-io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
+ testfevent create
+ testfevent cmd {
+ variable x 0
+ after 100 {set x triggered}
+ vwait [namespace which -variable x]
+ set x
+ }
+} {triggered}
+test chan-io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
+ testfevent create
+ testfevent cmd {
+ set x 0
+ after 10 {lappend x timer}
+ after 30
+ set result $x
+ update idletasks
+ lappend result $x
+ update
+ lappend result $x
+ }
+} {0 0 {0 timer}}
+
+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}
+ 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
+} -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
+ testfevent share $f3
+ testfevent cmd "chan event $f2 readable {script 2}
+ chan event $f3 readable {script 3}"
+ chan event $f4 readable {script 4}
+ testfevent delete
+ 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
+} -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
+ chan event $f readable {script 1}
+ chan event $f2 readable {script 2}
+ testfevent cmd "chan event $f3 readable {script 3}
+ chan event $f4 readable {script 4}"
+ testfevent delete
+ 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
+} -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}
+ list [chan event $f2 readable] [testfevent cmd "chan event $f readable"] \
+ [chan event $f readable]
+} -cleanup {
+ testfevent delete
+ chan close $f
+ chan close $f2
+} -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 {}"
+ list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
+ testfevent delete
+ chan close $f
+} -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 {}
+ list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
+ testfevent delete
+ chan close $f
+} -result {{script 1} {}}
+
+set path(bar) [makeFile {} bar]
+
+test chan-io-48.1 {testing readability conditions} {fileevent} {
+ set f [open $path(bar) w]
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan close $f
+ set f [open $path(bar) r]
+ chan event $f readable [namespace code {
+ lappend l called
+ if {[chan eof $f]} {
+ chan close $f
+ set x done
+ } else {
+ chan gets $f
+ }
+ }]
+ set l ""
+ variable x not_done
+ vwait [namespace which -variable x]
+ list $x $l
+} {done {called called called called called called called}}
+test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
+ set f [open $path(bar) w]
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan close $f
+ set f [open $path(bar) r]
+ chan event $f readable [namespace code {
+ lappend l called
+ if {[chan eof $f]} {
+ chan close $f
+ set x done
+ } 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} -setup {
+ set l ""
+} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
+ set f [open $path(bar) w]
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan puts $f abcdefg
+ chan close $f
+ set f [open $path(my_script) w]
+ chan puts $f {
+ proc copy_slowly {f} {
+ while {![chan eof $f]} {
+ chan puts [chan gets $f]
+ after 200
+ }
+ chan close $f
+ }
+ }
+ chan close $f
+ set f [openpipe]
+ chan event $f readable [namespace code {
+ if {[chan eof $f]} {
+ set x done
+ } else {
+ chan gets $f
+ lappend l [chan blocked $f]
+ chan gets $f
+ lappend l [chan blocked $f]
+ }
+ }]
+ 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]
+ list $x $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -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
+ chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+ chan close $f
+ 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
+ } else {
+ lappend l [chan gets $f]
+ incr c
+ }
+ }]
+ variable x
+ vwait [namespace which -variable x]
+ list $c $l
+} -result {3 {abc def {}}}
+
+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]
+ lappend l [file size $path(test1)]
+ chan configure $f -translation crlf
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 1]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+ lappend l [chan read $f 1]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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} -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]
+ lappend l [file size $path(test1)]
+ chan configure $f -translation crlf
+ lappend l [chan read $f 2]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 2]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 2]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+ lappend l [chan read $f 2]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ lappend l [file size $path(test1)]
+ chan configure $f -translation crlf
+ lappend l [chan read $f 3]
+ lappend l [chan tell $f]
+ lappend l [chan read $f 3]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+ lappend l [chan read $f 3]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ lappend l [file size $path(test1)]
+ chan configure $f -translation crlf
+ lappend l [chan read $f 3]
+ lappend l [chan tell $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -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]
+ lappend l [file size $path(test1)]
+ chan configure $f -translation crlf
+ lappend l [set x [chan gets $f]]
+ lappend l [chan tell $f]
+ lappend l [chan gets $f]
+ lappend l [chan tell $f]
+ lappend l [chan eof $f]
+} -cleanup {
+ chan close $f
+} -result [list 7 a\rb\rc 7 {} 7 1]
+
+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 {
+ variable z called
+ testchannelevent $f delete 0
+ }]
+ variable z not_called
+ update
+ return $z
+} -cleanup {
+ chan close $f
+} -result called
+test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
+ file delete $path(test1)
+ chan close [open $path(test1) w]
+ set z ""
+} -constraints {testchannelevent} -body {
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ proc delhandler {f i} {
+ variable z
+ lappend z "called delhandler $f $i"
+ testchannelevent $f delete 0
+ }
+ update
+ string equal $z \
+ [list [list called delhandler $f 0] [list called delhandler $f 1]]
+} -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]]
+ proc notcalled {f i} {
+ variable z
+ lappend z "notcalled was called!! $f $i"
+ }
+ proc delhandler {f i} {
+ variable z
+ testchannelevent $f delete 1
+ lappend z "delhandler $f $i called"
+ testchannelevent $f delete 0
+ lappend z "delhandler $f $i deleted myself"
+ }
+ update
+ string equal $z \
+ [list [list delhandler $f 0 called] \
+ [list delhandler $f 0 deleted myself]]
+} -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 {
+ if {$u eq "recursive"} {
+ testchannelevent $f delete 0
+ lappend z "delrecursive deleting recursive"
+ } else {
+ lappend z "delrecursive calling recursive"
+ set u recursive
+ update
+ }
+ }]
+ variable u toplevel
+ variable z ""
+ update
+ return $z
+} -cleanup {
+ chan close $f
+} -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]]
+ proc notcalled {f} {
+ variable z
+ lappend z "notcalled was called!! $f"
+ }
+ proc del {f} {
+ variable u
+ variable z
+ if {$u eq "recursive"} {
+ testchannelevent $f delete 1
+ testchannelevent $f delete 0
+ lappend z "del deleted notcalled"
+ lappend z "del deleted myself"
+ } else {
+ set u recursive
+ lappend z "del calling recursive"
+ update
+ lappend z "del after update"
+ }
+ }
+ set z ""
+ set u toplevel
+ update
+ return $z
+} -cleanup {
+ chan close $f
+} -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 eq "toplevel"} {
+ lappend z "first called"
+ set u first
+ update
+ lappend z "first after update"
+ } else {
+ lappend z "first called not toplevel"
+ }
+ }
+ proc second {f} {
+ variable u
+ variable z
+ if {$u eq "first"} {
+ lappend z "second called, first time"
+ set u second
+ testchannelevent $f delete 0
+ } elseif {$u eq "second"} {
+ lappend z "second called, second time"
+ testchannelevent $f delete 0
+ } else {
+ lappend z "second called, cannot happen!"
+ testchannelevent $f removeall
+ }
+ }
+ set z ""
+ set u toplevel
+ update
+ return $z
+} -cleanup {
+ chan close $f
+} -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} -setup {
+ set x 0
+ set result ""
+ variable wait ""
+} -constraints {socket} -body {
+ proc accept {s a p} {
+ variable x
+ chan configure $s -blocking off
+ chan puts $s "sock[incr x]"
+ chan close $s
+ variable wait done
+ }
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+ set port [lindex [chan configure $ss -sockname] 2]
+ set cs [socket 127.0.0.1 $port]
+ vwait [namespace which -variable wait]
+ lappend result [chan gets $cs]
+ chan close $cs
+ set cs [socket 127.0.0.1 $port]
+ vwait [namespace which -variable wait]
+ lappend result [chan gets $cs]
+ chan close $cs
+ set cs [socket 127.0.0.1 $port]
+ vwait [namespace which -variable wait]
+ lappend result [chan gets $cs]
+ chan close $cs
+ 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
+} -result {sock1 sock2 sock3 sock4}
+
+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 " # "
+ chan copy $f1 $f2
+} -returnCodes error -cleanup {
+ chan close $f1
+ chan close $f2
+} -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 " # "
+ chan copy $f3 $f2
+} -returnCodes error -cleanup {
+ chan close $f1
+ chan close $f2
+ chan close $f3
+} -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
+ chan configure $f2 -translation cr -blocking 0
+ set s0 [chan copy $f1 $f2]
+ 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) && ($s0 == $s1)} {
+ lappend result ok
+ }
+ 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
+ chan configure $f2 -translation cr -blocking 0
+ chan copy $f1 $f2 -size 40
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ chan close $f1
+ chan close $f2
+ lappend result [file size $path(test1)]
+} -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
+ chan configure $f2 -translation lf -blocking 0
+ chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ chan close $f1
+ chan close $f2
+ if {[file size $thisScript] == [file size $path(test1)]} {
+ lappend result ok
+ }
+ 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
+ chan configure $f2 -translation lf -blocking 0
+ chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ chan close $f1
+ chan close $f2
+ if {[file size $thisScript] == [file size $path(test1)]} {
+ lappend result ok
+ }
+ 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
+ chan configure $f2 -translation lf -blocking 0
+ chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ chan close $f1
+ chan close $f2
+ if {[file size $thisScript] == [file size $path(test1)]} {
+ lappend result ok
+ }
+ 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
+ chan configure $f2 -translation lf -blocking 0
+ set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
+ 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) && ($s0 == $s1)} {
+ lappend result ok
+ }
+ 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]]
+ if {[file size $thisScript] == [file size $path(test1)]} {
+ lappend result ok
+ }
+ 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 "
+ chan puts ready
+ chan gets stdin
+ set f1 \[open [list $thisScript] r\]
+ chan configure \$f1 -translation lf
+ chan puts \[chan read \$f1 100\]
+ chan close \$f1
+ "
+ chan close $f1
+ set f1 [openpipe r+ $path(pipe)]
+ chan configure $f1 -translation lf
+ chan gets $f1
+ chan puts $f1 ready
+ chan flush $f1
+ set f2 [open $path(test1) w]
+ chan configure $f2 -translation lf
+ set s0 [chan copy $f1 $f2 -size 40]
+ catch {chan close $f1}
+ chan close $f2
+ list $s0 [file size $path(test1)]
+} -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]
+set path(utf8-rp.txt) [makeFile {} utf8-rp.txt]
+# Create kyrillic file, use lf translation to avoid os eol issues
+set out [open $path(kyrillic.txt) w]
+chan configure $out -encoding koi8-r -translation lf
+chan puts $out "\u0410\u0410"
+chan close $out
+test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
+ # Copy kyrillic to UTF-8, using chan copy.
+ set in [open $path(kyrillic.txt) r]
+ set out [open $path(utf8-fcopy.txt) w]
+ chan configure $in -encoding koi8-r -translation lf
+ chan configure $out -encoding utf-8 -translation lf
+ chan copy $in $out
+ chan close $in
+ chan close $out
+ # Do the same again, but differently (read/chan puts).
+ set in [open $path(kyrillic.txt) r]
+ set out [open $path(utf8-rp.txt) w]
+ chan configure $in -encoding koi8-r -translation lf
+ chan configure $out -encoding utf-8 -translation lf
+ chan puts -nonewline $out [chan read $in]
+ chan close $in
+ chan close $out
+ list [file size $path(kyrillic.txt)] \
+ [file size $path(utf8-fcopy.txt)] \
+ [file size $path(utf8-rp.txt)]
+} {3 5 5}
+test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
+ # encoding to binary (=> implies that the internal utf-8 is written)
+ set in [open $path(kyrillic.txt) r]
+ set out [open $path(utf8-fcopy.txt) w]
+ chan configure $in -encoding koi8-r -translation lf
+ # -translation binary is also -encoding binary
+ chan configure $out -translation binary
+ chan copy $in $out
+ chan close $in
+ chan close $out
+ file size $path(utf8-fcopy.txt)
+} 5
+test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
+ # binary to encoding => the input has to be in utf-8 to make sense to the
+ # encoder
+ set in [open $path(utf8-fcopy.txt) r]
+ set out [open $path(kyrillic.txt) w]
+ # -translation binary is also -encoding binary
+ chan configure $in -translation binary
+ chan configure $out -encoding koi8-r -translation lf
+ chan copy $in $out
+ chan close $in
+ chan close $out
+ file size $path(kyrillic.txt)
+} 3
+
+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
+ chan configure $f2 -translation cr -blocking 0
+ chan copy $f1 $f2 -size 0
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ chan close $f1
+ chan close $f2
+ lappend result [file size $path(test1)]
+} -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
+ chan configure $f2 -translation cr -blocking 0
+ chan copy $f1 $f2 -command [namespace code {set s0}]
+ set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+ variable s0
+ vwait [namespace which -variable s0]
+ chan close $f1
+ chan close $f2
+ set s1 [file size $thisScript]
+ set s2 [file size $path(test1)]
+ if {($s1 == $s2) && ($s0 == $s1)} {
+ lappend result ok
+ }
+ 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 copy stdin stdout -command { set x }
+ vwait x
+ set f [}
+ chan puts $f1 [list open $path(test1) w]]
+ chan puts $f1 {
+ chan configure $f -translation lf
+ chan puts $f "done"
+ chan close $f
+ }
+ chan close $f1
+ set f1 [openpipe r+ $path(pipe)]
+ set result [chan gets $f1]
+ chan puts $f1 line1
+ chan flush $f1
+ lappend result [chan gets $f1]
+ chan puts $f1 line2
+ chan flush $f1
+ lappend result [chan gets $f1]
+ chan close $f1
+ after 500
+ set f [open $path(test1)]
+ lappend result [chan read $f]
+} -cleanup {
+ chan close $f
+} -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} {
+ append big $big
+ }
+ 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
+ chan copy stdin stdout -command { set x }
+ vwait x
+ set f [open $path(test1) w]
+ chan configure $f -translation lf
+ chan puts $f "done"
+ chan close $f
+ }
+ chan close $f1
+ set f1 [openpipe r+ $path(pipe)]
+ set result [chan gets $f1]
+ chan configure $f1 -blocking 0
+ chan puts $f1 $big
+ chan flush $f1
+ after 500
+ set result ""
+ chan event $f1 read [namespace code {
+ append result [chan read $f1 1024]
+ if {[string length $result] >= [string length $big]} {
+ set x done
+ }
+ }]
+ vwait [namespace which -variable x]
+ return $x
+} -cleanup {
+ set big {}
+ chan close $f1
+} -result done
+set result {}
+proc FcopyTestAccept {sock args} {
+ after 1000 "chan close $sock"
+}
+proc FcopyTestDone {bytes {error {}}} {
+ variable fcopyTestDone
+ if {[string length $error]} {
+ set fcopyTestDone 1
+ } else {
+ set fcopyTestDone 0
+ }
+}
+test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
+ variable fcopyTestDone
+ set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
+ set in [open $thisScript] ;# 126 K
+ set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
+ catch {unset fcopyTestDone}
+ chan close $listen ;# This means the socket open never really succeeds
+ chan copy $in $out -command [namespace code FcopyTestDone]
+ variable fcopyTestDone
+ if ![info exists fcopyTestDone] {
+ vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
+ }
+ chan close $in
+ chan close $out
+ set fcopyTestDone ;# 1 for error condition
+} 1
+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 [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
+} -result 0
+proc doFcopy {in out {bytes 0} {error {}}} {
+ variable fcopyTestDone
+ variable fcopyTestCount
+ incr fcopyTestCount $bytes
+ if {[string length $error]} {
+ set fcopyTestDone 1
+ } elseif {[chan eof $in]} {
+ set fcopyTestDone 0
+ } else {
+ # Delay next chan copy to wait for size>0 input bytes
+ after 100 [list chan copy $in $out -size 1000 \
+ -command [namespace code [list doFcopy $in $out]]]
+ }
+}
+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 {
+ # Write 10 bytes / 10 msec
+ proc Write {count} {
+ chan puts -nonewline "1234567890"
+ if {[incr count -1]} {
+ after 10 [list Write $count]
+ } else {
+ set ::ready 1
+ }
+ }
+ chan configure stdout -buffering none
+ Write 345 ;# 3450 bytes ~3.45 sec
+ vwait ready
+ exit 0
+ }
+ chan close $f1
+ set in [openpipe r+ $path(pipe) &]
+ set out [open $path(test1) w]
+ doFcopy $in $out
+ variable fcopyTestDone
+ if {![info exists fcopyTestDone]} {
+ vwait [namespace which -variable fcopyTestDone]
+ }
+ # -1=error 0=script error N=number of bytes
+ expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
+} -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 {
+ lappend ::RES "CMD $args"
+ error !STOP
+ }
+ # capture callback error here
+ proc ::bgerror args {
+ lappend ::RES "bgerror/OK $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 {
+ # 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 [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.
+ set token [after 1000 {
+ lappend ::RES {bgerror/FAIL timeout}
+ set ::forever has-been-reached
+ }]
+ vwait ::forever
+ catch {after cancel $token}
+ # Report
+ return $::RES
+} -cleanup {
+ chan close $f
+ chan close $g
+ catch {unset ::RES}
+ catch {unset ::forever}
+ 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.
+ 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] ; chan configure $f -translation binary
+ set g [open $bar w] ; chan configure $g -translation binary -buffering none
+} -constraints {stdio openpipe fcopy} -body {
+ # Initialize and force eof on the input.
+ 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 [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
+ # 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
+ return $::RES
+} -cleanup {
+ chan close $f
+ chan close $g
+ catch {unset ::RES}
+ catch {unset ::forever}
+ removeFile foo
+ removeFile bar
+} -result {1 sync/OK {CMD 0}}
+test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
+ set out [makeFile {} out]
+ set err [makeFile {} err]
+ set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+ chan configure $pipe -translation binary -buffering line
+ chan puts $pipe {
+ chan configure stdout -translation binary -buffering line
+ chan puts stderr Waiting...
+ after 1000
+ foreach x {a b c} {
+ chan puts stderr Looping...
+ chan puts $x
+ after 500
+ }
+ proc bye args {
+ if {[chan gets stdin line]<0} {
+ chan puts stderr "CHILD: EOF detected, exiting"
+ exit
+ } else {
+ chan puts stderr "CHILD: ignoring line: $line"
+ }
+ }
+ chan puts stderr Now-sleeping-forever
+ chan event stdin readable bye
+ vwait forever
+ }
+ proc ::done args {
+ set ::forever OK
+ return
+ }
+ set ::forever {}
+ set out [open $out w]
+} -constraints {stdio openpipe fcopy} -body {
+ chan copy $pipe $out -size 6 -command ::done
+ set token [after 5000 {
+ set ::forever {fcopy hangs}
+ }]
+ vwait ::forever
+ catch {after cancel $token}
+ set ::forever
+} -cleanup {
+ chan close $pipe
+ rename ::done {}
+ 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}
+ catch {unset ::forever}
+} -result OK
+test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+ set err [makeFile {} err]
+ set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+ chan configure $pipe -translation binary -buffering line
+ chan puts $pipe {
+ chan configure stderr -buffering line
+ # Kill server when pipe closed by invoker.
+ proc bye args {
+ if {![chan eof stdin]} { chan gets stdin ; return }
+ chan puts stderr BYE
+ exit
+ }
+ # Server code. Bi-directional copy between 2 sockets.
+ proc geof {sok} {
+ chan puts stderr DONE/$sok
+ chan close $sok
+ }
+ proc new {sok args} {
+ chan puts stderr NEW/$sok
+ global l srv
+ chan configure $sok -translation binary -buffering none
+ lappend l $sok
+ if {[llength $l] == 2} {
+ chan close $srv
+ foreach {a b} $l break
+ chan copy $a $b -command [list geof $a]
+ chan copy $b $a -command [list geof $b]
+ chan puts stderr 2COPY
+ }
+ chan puts stderr ...
+ }
+ chan puts stderr SRV
+ set l {}
+ set srv [socket -server new 9999]
+ chan puts stderr WAITING
+ chan event stdin readable bye
+ chan puts OK
+ vwait forever
+ }
+ # wait for OK from server.
+ chan gets $pipe
+ # Now the two clients.
+ proc done {sock} {
+ if {[chan eof $sock]} { chan close $sock ; return }
+ lappend ::forever [chan gets $sock]
+ return
+ }
+ set a [socket 127.0.0.1 9999]
+ 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 [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 {}
+ chan puts $a AB
+ vwait ::forever
+ chan puts $b BA
+ vwait ::forever
+ set ::forever
+} -cleanup {
+ catch {chan close $a}
+ catch {chan close $b}
+ chan close $pipe
+ if {[testConstraint win]} {
+ after 1000 ;# Give Windows time to kill the process
+ }
+ removeFile err
+ catch {unset ::forever}
+} -result {AB BA}
+
+test chan-io-54.1 {Recursive channel events} {socket fileevent} {
+ # This test checks to see if file events are delivered during recursive
+ # event loops when there is buffered data on the channel.
+ proc accept {s a p} {
+ variable as
+ chan configure $s -translation lf
+ chan puts $s "line 1\nline2\nline3"
+ chan flush $s
+ set as $s
+ }
+ proc readit {s next} {
+ variable x
+ variable result
+ lappend result $next
+ if {$next == 1} {
+ chan event $s readable [namespace code [list readit $s 2]]
+ vwait [namespace which -variable x]
+ }
+ incr x
+ }
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+ # We need to delay on some systems until the creation of the server socket
+ # 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]]
+ }]} then {
+ set done 1
+ break
+ }
+ after 100
+ }
+ if {$done == 0} {
+ chan close $ss
+ error "failed to connect to server"
+ }
+ variable result {}
+ variable x 0
+ variable as
+ vwait [namespace which -variable as]
+ chan configure $cs -translation lf
+ lappend result [chan gets $cs]
+ chan configure $cs -blocking off
+ chan event $cs readable [namespace code [list readit $cs 1]]
+ set a [after 2000 [namespace code { set x failure }]]
+ vwait [namespace which -variable x]
+ after cancel $a
+ chan close $as
+ chan close $ss
+ chan close $cs
+ list $result $x
+} {{{line 1} 1 2} 2}
+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
+ variable accept $s
+ chan configure $s -blocking off -buffering line -translation lf
+ chan event $s readable [namespace code "doit $s"]
+ }
+ proc doit {s} {
+ variable counter
+ variable after
+ incr counter
+ if {[chan gets $s] eq ""} {
+ chan event $s readable [namespace code "doit1 $s"]
+ 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
+ chan gets $s
+ chan close $s
+ set accept {}
+ }
+ proc producer {} {
+ variable s
+ variable writer
+ set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]]
+ chan configure $writer -buffering line
+ chan puts -nonewline $writer hello
+ chan flush $writer
+ }
+ producer
+ vwait [namespace which -variable done]
+ chan close $writer
+ chan close $s
+ after cancel $after
+ return $counter
+} -cleanup {
+ if {$accept ne {}} {chan close $accept}
+} -result 1
+
+set path(fooBar) [makeFile {} fooBar]
+
+test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
+ fileevent
+} -setup {
+ variable x
+ proc eventScript {fd} {
+ variable x
+ chan close $fd
+ error "planned error"
+ set x whoops
+ }
+ proc myHandler args {
+ variable x got_error
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -body {
+ set f [open $path(fooBar) w]
+ chan event $f writable [namespace code [list eventScript $f]]
+ variable x not_done
+ vwait [namespace which -variable x]
+ return $x
+} -cleanup {
+ interp bgerror {} $handler
+} -result {got_error}
+
+test chan-io-56.1 {ChannelTimerProc} {testchannelevent} {
+ set f [open $path(fooBar) w]
+ chan puts $f "this is a test"
+ chan close $f
+ set f [open $path(fooBar) r]
+ testchannelevent $f add readable [namespace code {
+ chan read $f 1
+ incr x
+ }]
+ variable x 0
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ set result $x
+ testchannelevent $f set 0 none
+ after idle [namespace code {set y done}]
+ variable y
+ vwait [namespace which -variable y]
+ chan close $f
+ lappend result $y
+} {2 done}
+
+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]]
+ vwait [namespace which -variable s2]
+ update
+ chan event $s2 readable [namespace code {lappend result readable}]
+ chan puts $s "12\n34567890"
+ chan flush $s
+ variable result [chan gets $s2]
+ after 1000 [namespace code {lappend result timer}]
+ 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
+} -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]]
+ vwait [namespace which -variable s2]
+ update
+ chan event $s2 readable [namespace code {lappend result readable}]
+ chan puts -nonewline $s "1234567890"
+ chan flush $s
+ variable result [chan read $s2 1]
+ after 1000 [namespace code {lappend result timer}]
+ 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
+} -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]
+ chan puts $out {
+ chan puts "normal message from pipe"
+ chan puts stderr "error message from pipe"
+ exit 1
+ }
+ proc readit {pipe} {
+ variable x
+ variable result
+ if {[chan eof $pipe]} {
+ set x [catch {chan close $pipe} line]
+ lappend result catch $line
+ } else {
+ chan gets $pipe line
+ lappend result chan gets $line
+ }
+ }
+ chan close $out
+ set pipe [openpipe r $path(script)]
+ chan event $pipe readable [namespace code [list readit $pipe]]
+ variable x ""
+ set result ""
+ vwait [namespace which -variable x]
+ list $x $result
+} {1 {chan gets {normal message from pipe} chan gets {} catch {error message from pipe}}}
+
+test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
+ # TIP #10
+ # 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'.
+ set f [open $path(longfile) r]
+ set result [testchannel mthread $f]
+ chan close $f
+ string equal $result [testmainthread]
+} {1}
+
+test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
+ # This test will hang in older revisions of the core.
+ set out [open $path(script) w]
+ chan puts $out {
+ chan puts [encoding convertfrom identity \xe2]
+ exit 1
+ }
+ proc readit {pipe} {
+ variable x
+ variable result
+ if {[chan eof $pipe]} {
+ set x [catch {chan close $pipe} line]
+ lappend result catch $line
+ } else {
+ chan gets $pipe line
+ lappend result gets $line
+ }
+ }
+ chan close $out
+ set pipe [openpipe r $path(script)]
+ chan event $pipe readable [namespace code [list readit $pipe]]
+ variable x ""
+ set result ""
+ vwait [namespace which -variable x]
+ # cut of the remainder of the error stack, especially the filename
+ set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
+ list $x $result
+} {1 {gets {} catch {error writing "stdout": invalid argument}}}
+
+test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
+ set datafile [makeFile {} eofchar]
+ set f [open $datafile w]
+ chan configure $f -translation binary
+ chan puts -nonewline $f [string repeat "Ho hum\n" 11]
+ chan puts $f =
+ set line [string repeat "Ge gla " 4]
+ chan puts -nonewline $f [string repeat [string trimright $line]\n 834]
+ chan close $f
+} -body {
+ set f [open $datafile r]
+ chan configure $f -eofchar =
+ set res {}
+ lappend res [chan read $f; chan tell $f]
+ chan configure $f -eofchar {}
+ lappend res [chan read $f 1]
+ lappend res [chan read $f; chan tell $f]
+ # Any seek zaps the internals into a good state.
+ #chan seek $f 0 start
+ #chan seek $f 0 current
+ #lappend res [chan read $f; chan tell $f]
+} -cleanup {
+ chan close $f
+ removeFile eofchar
+} -result {77 = 23431}
+
+# Test the cutting and splicing of channels, this is incidentially the
+# attach/detach facility of package Thread, but __without any safeguards__. It
+# 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} -setup {
+ set f [makeFile {... dummy ...} cutsplice]
+ set res {}
+} -constraints {testchannel} -body {
+ set c [open $f r]
+ 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
+} -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]
+ lappend res [catch {chan seek $c 0 start}]
+ testchannel cut $c
+ lappend res [catch {chan seek $c 0 start}]
+ 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
+ }]
+} -cleanup {
+ thread::release $tid
+ removeFile cutsplice
+} -result {0 1 0}
+
+# ### ### ### ######### ######### #########
+
+foreach {n msg expected} {
+ 0 {} {}
+ 1 {{message only}} {{message only}}
+ 2 {-options x} {-options x}
+ 3 {-options {x y} {the message}} {-options {x y} {the message}}
+
+ 4 {-code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 5 {-code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 6 {-code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 7 {-code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf}
+ 9 {-code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf}
+ 11 {-code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 12 {-code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 13 {-code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 14 {-code 1 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 15 {-code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 16 {-code 1 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 17 {-code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 18 {-code error -level 0 -f ba} {-code error -level 0 -f ba}
+ 19 {-code ok -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 20 {-code error -level 5 -f ba} {-code error -level 0 -f ba}
+ 21 {-code ok -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 22 {-code boss -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 23 {-code boss -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 24 {-code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 25 {-code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf}
+ 27 {-code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 28 {-code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 29 {-code 1 -level X -f ba} {-code 1 -level 0 -f ba}
+ 30 {-code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ 31 {-code error -level X -f ba} {-code error -level 0 -f ba}
+ 32 {-code ok -level X -f ba} {-code 1 -level 0 -f ba}
+ 33 {-code boss -level X -f ba} {-code 1 -level 0 -f ba}
+
+ 34 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ 35 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 36 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ 37 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+ 39 {-code 1 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+ 41 {-code 1 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 42 {-code 1 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 43 {-code 1 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 44 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba}
+ 45 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 46 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba}
+ 47 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 48 {-code 1 -code error -level 0 -f ba} {-code 1 -code error -level 0 -f ba}
+ 49 {-code 1 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 50 {-code 1 -code error -level 5 -f ba} {-code 1 -code error -level 0 -f ba}
+ 51 {-code 1 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 52 {-code 1 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 53 {-code 1 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 54 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ 55 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+ 57 {-code 1 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 58 {-code 1 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 59 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba}
+ 60 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ 61 {-code 1 -code error -level X -f ba} {-code 1 -code error -level 0 -f ba}
+ 62 {-code 1 -code ok -level X -f ba} {-code 1 -level 0 -f ba}
+ 63 {-code 1 -code boss -level X -f ba} {-code 1 -level 0 -f ba}
+
+ 64 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 65 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 66 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 67 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 69 {-code 0 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 71 {-code 0 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 72 {-code 0 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 73 {-code 0 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 74 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 75 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 76 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 77 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 78 {-code 0 -code error -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 79 {-code 0 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 80 {-code 0 -code error -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 81 {-code 0 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 82 {-code 0 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba}
+ 83 {-code 0 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba}
+ 84 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 85 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 87 {-code 0 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 88 {-code 0 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 89 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba}
+ 90 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ 91 {-code 0 -code error -level X -f ba} {-code 1 -level 0 -f ba}
+ 92 {-code 0 -code ok -level X -f ba} {-code 1 -level 0 -f ba}
+ 93 {-code 0 -code boss -level X -f ba} {-code 1 -level 0 -f ba}
+
+ 94 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ 95 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 96 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ 97 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ 98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+ 99 {-code ok -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+ a1 {-code ok -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ a2 {-code boss -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ a3 {-code boss -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ a4 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba}
+ a5 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ a6 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba}
+ a7 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ a8 {-code error -code 1 -level 0 -f ba} {-code error -code 1 -level 0 -f ba}
+ a9 {-code ok -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ b0 {-code error -code 1 -level 5 -f ba} {-code error -code 1 -level 0 -f ba}
+ b1 {-code ok -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ b2 {-code boss -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ b3 {-code boss -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ b4 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf}
+ b5 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+ b7 {-code ok -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ b8 {-code boss -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ b9 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba}
+ c0 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba}
+ c1 {-code error -code 1 -level X -f ba} {-code error -code 1 -level 0 -f ba}
+ c2 {-code ok -code 1 -level X -f ba} {-code 1 -level 0 -f ba}
+ c3 {-code boss -code 1 -level X -f ba} {-code 1 -level 0 -f ba}
+
+ c4 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ c5 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ c6 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ c7 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ c9 {-code ok -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ d1 {-code ok -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ d2 {-code boss -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ d3 {-code boss -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ d4 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ d5 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ d6 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ d7 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ d8 {-code error -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ d9 {-code ok -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ e0 {-code error -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ e1 {-code ok -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ e2 {-code boss -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba}
+ e3 {-code boss -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba}
+ e4 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ e5 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ e7 {-code ok -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ e8 {-code boss -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+ e9 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ f0 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ f1 {-code error -code 0 -level X -f ba} {-code 1 -level 0 -f ba}
+ 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} -setup {
+ set f [makeFile {... dummy ...} cutsplice]
+ } -constraints {testchannel} -body {
+ set c [open $f r]
+ testchannel setchannelerror $c [lrange $msg 0 end]
+ } -cleanup {
+ chan close $c
+ removeFile cutsplice
+ } -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]
+ testchannel setchannelerrorinterp $c [lrange $msg 0 end]
+ } -cleanup {
+ chan close $c
+ removeFile cutsplice
+ } -result [lrange $expected 0 end]
+}
+
+test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} -body {
+ # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+ 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 kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+ removeFile $file
+}
+cleanupTests
+}
+namespace delete ::tcl::test::io
diff --git a/tests/clock.test b/tests/clock.test
index 4911726..8debba1 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -10,38 +10,28 @@
#
# 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.58 2005/08/17 21:27:41 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-if { $::tcl_platform(platform) eq {windows} } {
- if { [catch { package require registry 1.1 }] } {
-
- # HIDEOUS KLUDGE: [package require registry 1.1] has failed.
- # This failure likely means that we're running in Tcl's build
- # directory instead of the install directory. We recover by
- # trying to load tclreg*.dll directly.
-
- if { [catch {
- load [lindex \
- [glob -directory \
- [file join \
- [pwd] \
- [file dirname [info nameofexecutable]]] \
- tclReg*.dll] \
- 0] registry
- }] } {
- # Still no registry!
- namespace eval ::tcl::clock [set NoRegistry {}]
- }
+if {[testConstraint win]} {
+ if {[catch {
+ ::tcltest::loadTestedCommands
+ package require registry
+ }]} {
+ namespace eval ::tcl::clock {variable NoRegistry {}}
}
}
+
package require msgcat 1.4
+testConstraint detroit \
+ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
+testConstraint y2038 \
+ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
+
# TEST PLAN
# clock-1:
@@ -216,6 +206,8 @@ namespace eval ::tcl::clock {
LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY}
LOCALE_TIME_FORMAT {%OH h %OM m %OS s}
LOCALE_DATE_TIME_FORMAT {%Ex %EX}
+ BCE {Before Christ}
+ CE {Anno Domini}
}
}
@@ -233,6 +225,7 @@ namespace eval ::testClock {
[dict create \
HKEY_CURRENT_USER\\Control\ Panel\\International \
[dict create \
+ locale 0409 \
sShortDate dd-MMM-yyyy \
sLongDate "'the' dd''' day of' MMMM yyyy" \
sTimeFormat "h:mm:ss tt"] \
@@ -241,8 +234,8 @@ namespace eval ::testClock {
Bias 300 \
StandardBias 0 \
DaylightBias -60 \
- StandardStart \x00\x00\x0a\x00\x05\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
- DaylightStart \x00\x00\x04\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
+ StandardStart \x00\x00\x0b\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
+ DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
}
@@ -261,7 +254,7 @@ proc ::testClock::registry { cmd path key } {
test clock-1.0 "clock format - wrong # args" {
list [catch {clock format} msg] $msg $::errorCode
-} {1 {wrong # args: should be "::tcl::clock::format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
+} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
test clock-1.1 "clock format - bad time" {
list [catch {clock format foo} msg] $msg
@@ -275,9 +268,13 @@ test clock-1.3 "clock format - empty val" {
clock format 0 -gmt 1 -format ""
} {}
-test clock-1.4 "clock format - bad flag" {
+test clock-1.4 "clock format - bad flag" {*}{
+ -body {
list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
-} {1 {bad switch "-oops", must be -format, -gmt, -locale or -timezone} {CLOCK badSwitch -oops}}
+ }
+ -match glob
+ -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}}
+}
test clock-1.5 "clock format - bad timezone" {
list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
@@ -287,6 +284,10 @@ test clock-1.6 "clock format - gmt + timezone" {
list [catch {clock format 0 -timezone :GMT -gmt true} msg] $msg $::errorCode
} {1 {cannot use -gmt and -timezone in same call} {CLOCK gmtWithTimezone}}
+test clock-1.7 "clock format - option abbreviations" {
+ clock format 0 -g true -f "%Y-%m-%d"
+} 1970-01-01
+
# BEGIN testcases2
# Test formatting of Gregorian year, month, day, all formats
@@ -12416,1775 +12417,2297 @@ test clock-2.2424 {conversion of 2065-12-31} {
# BEGIN testcases3
test clock-3.1 {ISO week-based calendar 1871-W52-1} {
- clock format -3093206400 -format {%a %A %g %G %u %V %w} -gmt true; # 1871-W52-1
-} {Mon Monday 71 1871 1 52 1}
-test clock-3.2 {ISO week-based calendar 1871-W52-7} {
- clock format -3092688000 -format {%a %A %g %G %u %V %w} -gmt true; # 1871-W52-7
-} {Sun Sunday 71 1871 7 52 0}
-test clock-3.3 {ISO week-based calendar 1872-W01-1} {
- clock format -3092601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W01-1
-} {Mon Monday 72 1872 1 01 1}
-test clock-3.4 {ISO week-based calendar 1872-W01-7} {
- clock format -3092083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W01-7
-} {Sun Sunday 72 1872 7 01 0}
-test clock-3.5 {ISO week-based calendar 1872-W02-1} {
- clock format -3091996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W02-1
-} {Mon Monday 72 1872 1 02 1}
-test clock-3.6 {ISO week-based calendar 1872-W52-1} {
- clock format -3061756800 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W52-1
-} {Mon Monday 72 1872 1 52 1}
-test clock-3.7 {ISO week-based calendar 1872-W52-7} {
- clock format -3061238400 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W52-7
-} {Sun Sunday 72 1872 7 52 0}
-test clock-3.8 {ISO week-based calendar 1873-W01-1} {
- clock format -3061152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-1
-} {Mon Monday 73 1873 1 01 1}
-test clock-3.9 {ISO week-based calendar 1873-W01-3} {
- clock format -3060979200 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-3
-} {Wed Wednesday 73 1873 3 01 3}
-test clock-3.10 {ISO week-based calendar 1873-W01-7} {
- clock format -3060633600 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-7
-} {Sun Sunday 73 1873 7 01 0}
-test clock-3.11 {ISO week-based calendar 1873-W02-1} {
- clock format -3060547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W02-1
-} {Mon Monday 73 1873 1 02 1}
-test clock-3.12 {ISO week-based calendar 1875-W52-1} {
- clock format -2966803200 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-1
-} {Mon Monday 75 1875 1 52 1}
-test clock-3.13 {ISO week-based calendar 1875-W52-6} {
- clock format -2966371200 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-6
-} {Sat Saturday 75 1875 6 52 6}
-test clock-3.14 {ISO week-based calendar 1875-W52-7} {
- clock format -2966284800 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-7
-} {Sun Sunday 75 1875 7 52 0}
-test clock-3.15 {ISO week-based calendar 1876-W01-1} {
- clock format -2966198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W01-1
-} {Mon Monday 76 1876 1 01 1}
-test clock-3.16 {ISO week-based calendar 1876-W01-7} {
- clock format -2965680000 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W01-7
-} {Sun Sunday 76 1876 7 01 0}
-test clock-3.17 {ISO week-based calendar 1876-W02-1} {
- clock format -2965593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W02-1
-} {Mon Monday 76 1876 1 02 1}
-test clock-3.18 {ISO week-based calendar 1876-W52-1} {
- clock format -2935353600 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W52-1
-} {Mon Monday 76 1876 1 52 1}
-test clock-3.19 {ISO week-based calendar 1876-W52-7} {
- clock format -2934835200 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W52-7
-} {Sun Sunday 76 1876 7 52 0}
-test clock-3.20 {ISO week-based calendar 1877-W01-1} {
- clock format -2934748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W01-1
-} {Mon Monday 77 1877 1 01 1}
-test clock-3.21 {ISO week-based calendar 1877-W01-7} {
- clock format -2934230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W01-7
-} {Sun Sunday 77 1877 7 01 0}
-test clock-3.22 {ISO week-based calendar 1877-W02-1} {
- clock format -2934144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W02-1
-} {Mon Monday 77 1877 1 02 1}
-test clock-3.23 {ISO week-based calendar 1879-W52-1} {
- clock format -2841004800 -format {%a %A %g %G %u %V %w} -gmt true; # 1879-W52-1
-} {Mon Monday 79 1879 1 52 1}
-test clock-3.24 {ISO week-based calendar 1879-W52-7} {
- clock format -2840486400 -format {%a %A %g %G %u %V %w} -gmt true; # 1879-W52-7
-} {Sun Sunday 79 1879 7 52 0}
-test clock-3.25 {ISO week-based calendar 1880-W01-1} {
- clock format -2840400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-1
-} {Mon Monday 80 1880 1 01 1}
-test clock-3.26 {ISO week-based calendar 1880-W01-4} {
- clock format -2840140800 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-4
-} {Thu Thursday 80 1880 4 01 4}
-test clock-3.27 {ISO week-based calendar 1880-W01-7} {
- clock format -2839881600 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-7
-} {Sun Sunday 80 1880 7 01 0}
-test clock-3.28 {ISO week-based calendar 1880-W02-1} {
- clock format -2839795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W02-1
-} {Mon Monday 80 1880 1 02 1}
-test clock-3.29 {ISO week-based calendar 1880-W53-1} {
- clock format -2808950400 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-1
-} {Mon Monday 80 1880 1 53 1}
-test clock-3.30 {ISO week-based calendar 1880-W53-6} {
- clock format -2808518400 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-6
-} {Sat Saturday 80 1880 6 53 6}
-test clock-3.31 {ISO week-based calendar 1880-W53-7} {
- clock format -2808432000 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-7
-} {Sun Sunday 80 1880 7 53 0}
-test clock-3.32 {ISO week-based calendar 1881-W01-1} {
- clock format -2808345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W01-1
-} {Mon Monday 81 1881 1 01 1}
-test clock-3.33 {ISO week-based calendar 1881-W01-7} {
- clock format -2807827200 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W01-7
-} {Sun Sunday 81 1881 7 01 0}
-test clock-3.34 {ISO week-based calendar 1881-W02-1} {
- clock format -2807740800 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W02-1
-} {Mon Monday 81 1881 1 02 1}
-test clock-3.35 {ISO week-based calendar 1883-W52-1} {
- clock format -2714601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1883-W52-1
-} {Mon Monday 83 1883 1 52 1}
-test clock-3.36 {ISO week-based calendar 1883-W52-7} {
- clock format -2714083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1883-W52-7
-} {Sun Sunday 83 1883 7 52 0}
-test clock-3.37 {ISO week-based calendar 1884-W01-1} {
- clock format -2713996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-1
-} {Mon Monday 84 1884 1 01 1}
-test clock-3.38 {ISO week-based calendar 1884-W01-2} {
- clock format -2713910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-2
-} {Tue Tuesday 84 1884 2 01 2}
-test clock-3.39 {ISO week-based calendar 1884-W01-7} {
- clock format -2713478400 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-7
-} {Sun Sunday 84 1884 7 01 0}
-test clock-3.40 {ISO week-based calendar 1884-W02-1} {
- clock format -2713392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W02-1
-} {Mon Monday 84 1884 1 02 1}
-test clock-3.41 {ISO week-based calendar 1884-W52-1} {
- clock format -2683152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W52-1
-} {Mon Monday 84 1884 1 52 1}
-test clock-3.42 {ISO week-based calendar 1884-W52-7} {
- clock format -2682633600 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W52-7
-} {Sun Sunday 84 1884 7 52 0}
-test clock-3.43 {ISO week-based calendar 1885-W01-1} {
- clock format -2682547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-1
-} {Mon Monday 85 1885 1 01 1}
-test clock-3.44 {ISO week-based calendar 1885-W01-4} {
- clock format -2682288000 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-4
-} {Thu Thursday 85 1885 4 01 4}
-test clock-3.45 {ISO week-based calendar 1885-W01-7} {
- clock format -2682028800 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-7
-} {Sun Sunday 85 1885 7 01 0}
-test clock-3.46 {ISO week-based calendar 1885-W02-1} {
- clock format -2681942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W02-1
-} {Mon Monday 85 1885 1 02 1}
-test clock-3.47 {ISO week-based calendar 1887-W52-1} {
- clock format -2588198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-1
-} {Mon Monday 87 1887 1 52 1}
-test clock-3.48 {ISO week-based calendar 1887-W52-6} {
- clock format -2587766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-6
-} {Sat Saturday 87 1887 6 52 6}
-test clock-3.49 {ISO week-based calendar 1887-W52-7} {
- clock format -2587680000 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-7
-} {Sun Sunday 87 1887 7 52 0}
-test clock-3.50 {ISO week-based calendar 1888-W01-1} {
- clock format -2587593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W01-1
-} {Mon Monday 88 1888 1 01 1}
-test clock-3.51 {ISO week-based calendar 1888-W01-7} {
- clock format -2587075200 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W01-7
-} {Sun Sunday 88 1888 7 01 0}
-test clock-3.52 {ISO week-based calendar 1888-W02-1} {
- clock format -2586988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W02-1
-} {Mon Monday 88 1888 1 02 1}
-test clock-3.53 {ISO week-based calendar 1888-W52-1} {
- clock format -2556748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W52-1
-} {Mon Monday 88 1888 1 52 1}
-test clock-3.54 {ISO week-based calendar 1888-W52-7} {
- clock format -2556230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W52-7
-} {Sun Sunday 88 1888 7 52 0}
-test clock-3.55 {ISO week-based calendar 1889-W01-1} {
- clock format -2556144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-1
-} {Mon Monday 89 1889 1 01 1}
-test clock-3.56 {ISO week-based calendar 1889-W01-2} {
- clock format -2556057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-2
-} {Tue Tuesday 89 1889 2 01 2}
-test clock-3.57 {ISO week-based calendar 1889-W01-7} {
- clock format -2555625600 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-7
-} {Sun Sunday 89 1889 7 01 0}
-test clock-3.58 {ISO week-based calendar 1889-W02-1} {
- clock format -2555539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W02-1
-} {Mon Monday 89 1889 1 02 1}
-test clock-3.59 {ISO week-based calendar 1889-W52-1} {
- clock format -2525299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W52-1
-} {Mon Monday 89 1889 1 52 1}
-test clock-3.60 {ISO week-based calendar 1889-W52-7} {
- clock format -2524780800 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W52-7
-} {Sun Sunday 89 1889 7 52 0}
-test clock-3.61 {ISO week-based calendar 1890-W01-1} {
- clock format -2524694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-1
-} {Mon Monday 90 1890 1 01 1}
-test clock-3.62 {ISO week-based calendar 1890-W01-3} {
- clock format -2524521600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-3
-} {Wed Wednesday 90 1890 3 01 3}
-test clock-3.63 {ISO week-based calendar 1890-W01-7} {
- clock format -2524176000 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-7
-} {Sun Sunday 90 1890 7 01 0}
-test clock-3.64 {ISO week-based calendar 1890-W02-1} {
- clock format -2524089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W02-1
-} {Mon Monday 90 1890 1 02 1}
-test clock-3.65 {ISO week-based calendar 1890-W52-1} {
- clock format -2493849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W52-1
-} {Mon Monday 90 1890 1 52 1}
-test clock-3.66 {ISO week-based calendar 1890-W52-7} {
- clock format -2493331200 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W52-7
-} {Sun Sunday 90 1890 7 52 0}
-test clock-3.67 {ISO week-based calendar 1891-W01-1} {
- clock format -2493244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-1
-} {Mon Monday 91 1891 1 01 1}
-test clock-3.68 {ISO week-based calendar 1891-W01-4} {
- clock format -2492985600 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-4
-} {Thu Thursday 91 1891 4 01 4}
-test clock-3.69 {ISO week-based calendar 1891-W01-7} {
- clock format -2492726400 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-7
-} {Sun Sunday 91 1891 7 01 0}
-test clock-3.70 {ISO week-based calendar 1891-W02-1} {
- clock format -2492640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W02-1
-} {Mon Monday 91 1891 1 02 1}
-test clock-3.71 {ISO week-based calendar 1891-W53-1} {
- clock format -2461795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-1
-} {Mon Monday 91 1891 1 53 1}
-test clock-3.72 {ISO week-based calendar 1891-W53-5} {
- clock format -2461449600 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-5
-} {Fri Friday 91 1891 5 53 5}
-test clock-3.73 {ISO week-based calendar 1891-W53-7} {
- clock format -2461276800 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-7
-} {Sun Sunday 91 1891 7 53 0}
-test clock-3.74 {ISO week-based calendar 1892-W01-1} {
- clock format -2461190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W01-1
-} {Mon Monday 92 1892 1 01 1}
-test clock-3.75 {ISO week-based calendar 1892-W01-7} {
- clock format -2460672000 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W01-7
-} {Sun Sunday 92 1892 7 01 0}
-test clock-3.76 {ISO week-based calendar 1892-W02-1} {
- clock format -2460585600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W02-1
-} {Mon Monday 92 1892 1 02 1}
-test clock-3.77 {ISO week-based calendar 1892-W52-1} {
- clock format -2430345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-1
-} {Mon Monday 92 1892 1 52 1}
-test clock-3.78 {ISO week-based calendar 1892-W52-6} {
- clock format -2429913600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-6
-} {Sat Saturday 92 1892 6 52 6}
-test clock-3.79 {ISO week-based calendar 1892-W52-7} {
- clock format -2429827200 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-7
-} {Sun Sunday 92 1892 7 52 0}
-test clock-3.80 {ISO week-based calendar 1893-W01-1} {
- clock format -2429740800 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W01-1
-} {Mon Monday 93 1893 1 01 1}
-test clock-3.81 {ISO week-based calendar 1893-W01-7} {
- clock format -2429222400 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W01-7
-} {Sun Sunday 93 1893 7 01 0}
-test clock-3.82 {ISO week-based calendar 1893-W02-1} {
- clock format -2429136000 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W02-1
-} {Mon Monday 93 1893 1 02 1}
-test clock-3.83 {ISO week-based calendar 1893-W52-1} {
- clock format -2398896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W52-1
-} {Mon Monday 93 1893 1 52 1}
-test clock-3.84 {ISO week-based calendar 1893-W52-7} {
- clock format -2398377600 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W52-7
-} {Sun Sunday 93 1893 7 52 0}
-test clock-3.85 {ISO week-based calendar 1894-W01-1} {
- clock format -2398291200 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W01-1
-} {Mon Monday 94 1894 1 01 1}
-test clock-3.86 {ISO week-based calendar 1894-W01-7} {
- clock format -2397772800 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W01-7
-} {Sun Sunday 94 1894 7 01 0}
-test clock-3.87 {ISO week-based calendar 1894-W02-1} {
- clock format -2397686400 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W02-1
-} {Mon Monday 94 1894 1 02 1}
-test clock-3.88 {ISO week-based calendar 1894-W52-1} {
- clock format -2367446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W52-1
-} {Mon Monday 94 1894 1 52 1}
-test clock-3.89 {ISO week-based calendar 1894-W52-7} {
- clock format -2366928000 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W52-7
-} {Sun Sunday 94 1894 7 52 0}
-test clock-3.90 {ISO week-based calendar 1895-W01-1} {
- clock format -2366841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-1
-} {Mon Monday 95 1895 1 01 1}
-test clock-3.91 {ISO week-based calendar 1895-W01-2} {
- clock format -2366755200 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-2
-} {Tue Tuesday 95 1895 2 01 2}
-test clock-3.92 {ISO week-based calendar 1895-W01-7} {
- clock format -2366323200 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-7
-} {Sun Sunday 95 1895 7 01 0}
-test clock-3.93 {ISO week-based calendar 1895-W02-1} {
- clock format -2366236800 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W02-1
-} {Mon Monday 95 1895 1 02 1}
-test clock-3.94 {ISO week-based calendar 1895-W52-1} {
- clock format -2335996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W52-1
-} {Mon Monday 95 1895 1 52 1}
-test clock-3.95 {ISO week-based calendar 1895-W52-7} {
- clock format -2335478400 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W52-7
-} {Sun Sunday 95 1895 7 52 0}
-test clock-3.96 {ISO week-based calendar 1896-W01-1} {
- clock format -2335392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-1
-} {Mon Monday 96 1896 1 01 1}
-test clock-3.97 {ISO week-based calendar 1896-W01-3} {
- clock format -2335219200 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-3
-} {Wed Wednesday 96 1896 3 01 3}
-test clock-3.98 {ISO week-based calendar 1896-W01-7} {
- clock format -2334873600 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-7
-} {Sun Sunday 96 1896 7 01 0}
-test clock-3.99 {ISO week-based calendar 1896-W02-1} {
- clock format -2334787200 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W02-1
-} {Mon Monday 96 1896 1 02 1}
-test clock-3.100 {ISO week-based calendar 1896-W53-1} {
- clock format -2303942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-1
-} {Mon Monday 96 1896 1 53 1}
-test clock-3.101 {ISO week-based calendar 1896-W53-5} {
- clock format -2303596800 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-5
-} {Fri Friday 96 1896 5 53 5}
-test clock-3.102 {ISO week-based calendar 1896-W53-7} {
- clock format -2303424000 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-7
-} {Sun Sunday 96 1896 7 53 0}
-test clock-3.103 {ISO week-based calendar 1897-W01-1} {
- clock format -2303337600 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W01-1
-} {Mon Monday 97 1897 1 01 1}
-test clock-3.104 {ISO week-based calendar 1897-W01-7} {
- clock format -2302819200 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W01-7
-} {Sun Sunday 97 1897 7 01 0}
-test clock-3.105 {ISO week-based calendar 1897-W02-1} {
- clock format -2302732800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W02-1
-} {Mon Monday 97 1897 1 02 1}
-test clock-3.106 {ISO week-based calendar 1897-W52-1} {
- clock format -2272492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-1
-} {Mon Monday 97 1897 1 52 1}
-test clock-3.107 {ISO week-based calendar 1897-W52-6} {
- clock format -2272060800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-6
-} {Sat Saturday 97 1897 6 52 6}
-test clock-3.108 {ISO week-based calendar 1897-W52-7} {
- clock format -2271974400 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-7
-} {Sun Sunday 97 1897 7 52 0}
-test clock-3.109 {ISO week-based calendar 1898-W01-1} {
- clock format -2271888000 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W01-1
-} {Mon Monday 98 1898 1 01 1}
-test clock-3.110 {ISO week-based calendar 1898-W01-7} {
- clock format -2271369600 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W01-7
-} {Sun Sunday 98 1898 7 01 0}
-test clock-3.111 {ISO week-based calendar 1898-W02-1} {
- clock format -2271283200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W02-1
-} {Mon Monday 98 1898 1 02 1}
-test clock-3.112 {ISO week-based calendar 1898-W52-1} {
- clock format -2241043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-1
-} {Mon Monday 98 1898 1 52 1}
-test clock-3.113 {ISO week-based calendar 1898-W52-6} {
- clock format -2240611200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-6
-} {Sat Saturday 98 1898 6 52 6}
-test clock-3.114 {ISO week-based calendar 1898-W52-7} {
- clock format -2240524800 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-7
-} {Sun Sunday 98 1898 7 52 0}
-test clock-3.115 {ISO week-based calendar 1899-W01-1} {
- clock format -2240438400 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W01-1
-} {Mon Monday 99 1899 1 01 1}
-test clock-3.116 {ISO week-based calendar 1899-W01-7} {
- clock format -2239920000 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W01-7
-} {Sun Sunday 99 1899 7 01 0}
-test clock-3.117 {ISO week-based calendar 1899-W02-1} {
- clock format -2239833600 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W02-1
-} {Mon Monday 99 1899 1 02 1}
-test clock-3.118 {ISO week-based calendar 1899-W52-1} {
- clock format -2209593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W52-1
-} {Mon Monday 99 1899 1 52 1}
-test clock-3.119 {ISO week-based calendar 1899-W52-7} {
- clock format -2209075200 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W52-7
-} {Sun Sunday 99 1899 7 52 0}
-test clock-3.120 {ISO week-based calendar 1900-W01-1} {
- clock format -2208988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W01-1
-} {Mon Monday 00 1900 1 01 1}
-test clock-3.121 {ISO week-based calendar 1900-W01-7} {
- clock format -2208470400 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W01-7
-} {Sun Sunday 00 1900 7 01 0}
-test clock-3.122 {ISO week-based calendar 1900-W02-1} {
- clock format -2208384000 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W02-1
-} {Mon Monday 00 1900 1 02 1}
-test clock-3.123 {ISO week-based calendar 1943-W52-1} {
- clock format -820972800 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-1
-} {Mon Monday 43 1943 1 52 1}
-test clock-3.124 {ISO week-based calendar 1943-W52-6} {
- clock format -820540800 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-6
-} {Sat Saturday 43 1943 6 52 6}
-test clock-3.125 {ISO week-based calendar 1943-W52-7} {
- clock format -820454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-7
-} {Sun Sunday 43 1943 7 52 0}
-test clock-3.126 {ISO week-based calendar 1944-W01-1} {
- clock format -820368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W01-1
-} {Mon Monday 44 1944 1 01 1}
-test clock-3.127 {ISO week-based calendar 1944-W01-7} {
- clock format -819849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W01-7
-} {Sun Sunday 44 1944 7 01 0}
-test clock-3.128 {ISO week-based calendar 1944-W02-1} {
- clock format -819763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W02-1
-} {Mon Monday 44 1944 1 02 1}
-test clock-3.129 {ISO week-based calendar 1944-W52-1} {
- clock format -789523200 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W52-1
-} {Mon Monday 44 1944 1 52 1}
-test clock-3.130 {ISO week-based calendar 1944-W52-7} {
- clock format -789004800 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W52-7
-} {Sun Sunday 44 1944 7 52 0}
-test clock-3.131 {ISO week-based calendar 1945-W01-1} {
- clock format -788918400 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W01-1
-} {Mon Monday 45 1945 1 01 1}
-test clock-3.132 {ISO week-based calendar 1945-W01-7} {
- clock format -788400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W01-7
-} {Sun Sunday 45 1945 7 01 0}
-test clock-3.133 {ISO week-based calendar 1945-W02-1} {
- clock format -788313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W02-1
-} {Mon Monday 45 1945 1 02 1}
-test clock-3.134 {ISO week-based calendar 1947-W52-1} {
- clock format -695174400 -format {%a %A %g %G %u %V %w} -gmt true; # 1947-W52-1
-} {Mon Monday 47 1947 1 52 1}
-test clock-3.135 {ISO week-based calendar 1947-W52-7} {
- clock format -694656000 -format {%a %A %g %G %u %V %w} -gmt true; # 1947-W52-7
-} {Sun Sunday 47 1947 7 52 0}
-test clock-3.136 {ISO week-based calendar 1948-W01-1} {
- clock format -694569600 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-1
-} {Mon Monday 48 1948 1 01 1}
-test clock-3.137 {ISO week-based calendar 1948-W01-4} {
- clock format -694310400 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-4
-} {Thu Thursday 48 1948 4 01 4}
-test clock-3.138 {ISO week-based calendar 1948-W01-7} {
- clock format -694051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-7
-} {Sun Sunday 48 1948 7 01 0}
-test clock-3.139 {ISO week-based calendar 1948-W02-1} {
- clock format -693964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W02-1
-} {Mon Monday 48 1948 1 02 1}
-test clock-3.140 {ISO week-based calendar 1948-W53-1} {
- clock format -663120000 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-1
-} {Mon Monday 48 1948 1 53 1}
-test clock-3.141 {ISO week-based calendar 1948-W53-6} {
- clock format -662688000 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-6
-} {Sat Saturday 48 1948 6 53 6}
-test clock-3.142 {ISO week-based calendar 1948-W53-7} {
- clock format -662601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-7
-} {Sun Sunday 48 1948 7 53 0}
-test clock-3.143 {ISO week-based calendar 1949-W01-1} {
- clock format -662515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W01-1
-} {Mon Monday 49 1949 1 01 1}
-test clock-3.144 {ISO week-based calendar 1949-W01-7} {
- clock format -661996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W01-7
-} {Sun Sunday 49 1949 7 01 0}
-test clock-3.145 {ISO week-based calendar 1949-W02-1} {
- clock format -661910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W02-1
-} {Mon Monday 49 1949 1 02 1}
-test clock-3.146 {ISO week-based calendar 1951-W52-1} {
- clock format -568771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1951-W52-1
-} {Mon Monday 51 1951 1 52 1}
-test clock-3.147 {ISO week-based calendar 1951-W52-7} {
- clock format -568252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1951-W52-7
-} {Sun Sunday 51 1951 7 52 0}
-test clock-3.148 {ISO week-based calendar 1952-W01-1} {
- clock format -568166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-1
-} {Mon Monday 52 1952 1 01 1}
-test clock-3.149 {ISO week-based calendar 1952-W01-2} {
- clock format -568080000 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-2
-} {Tue Tuesday 52 1952 2 01 2}
-test clock-3.150 {ISO week-based calendar 1952-W01-7} {
- clock format -567648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-7
-} {Sun Sunday 52 1952 7 01 0}
-test clock-3.151 {ISO week-based calendar 1952-W02-1} {
- clock format -567561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W02-1
-} {Mon Monday 52 1952 1 02 1}
-test clock-3.152 {ISO week-based calendar 1952-W52-1} {
- clock format -537321600 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W52-1
-} {Mon Monday 52 1952 1 52 1}
-test clock-3.153 {ISO week-based calendar 1952-W52-7} {
- clock format -536803200 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W52-7
-} {Sun Sunday 52 1952 7 52 0}
-test clock-3.154 {ISO week-based calendar 1953-W01-1} {
- clock format -536716800 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-1
-} {Mon Monday 53 1953 1 01 1}
-test clock-3.155 {ISO week-based calendar 1953-W01-4} {
- clock format -536457600 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-4
-} {Thu Thursday 53 1953 4 01 4}
-test clock-3.156 {ISO week-based calendar 1953-W01-7} {
- clock format -536198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-7
-} {Sun Sunday 53 1953 7 01 0}
-test clock-3.157 {ISO week-based calendar 1953-W02-1} {
- clock format -536112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W02-1
-} {Mon Monday 53 1953 1 02 1}
-test clock-3.158 {ISO week-based calendar 1955-W52-1} {
- clock format -442368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-1
-} {Mon Monday 55 1955 1 52 1}
-test clock-3.159 {ISO week-based calendar 1955-W52-6} {
- clock format -441936000 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-6
-} {Sat Saturday 55 1955 6 52 6}
-test clock-3.160 {ISO week-based calendar 1955-W52-7} {
- clock format -441849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-7
-} {Sun Sunday 55 1955 7 52 0}
-test clock-3.161 {ISO week-based calendar 1956-W01-1} {
- clock format -441763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W01-1
-} {Mon Monday 56 1956 1 01 1}
-test clock-3.162 {ISO week-based calendar 1956-W01-7} {
- clock format -441244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W01-7
-} {Sun Sunday 56 1956 7 01 0}
-test clock-3.163 {ISO week-based calendar 1956-W02-1} {
- clock format -441158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W02-1
-} {Mon Monday 56 1956 1 02 1}
-test clock-3.164 {ISO week-based calendar 1956-W52-1} {
- clock format -410918400 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W52-1
-} {Mon Monday 56 1956 1 52 1}
-test clock-3.165 {ISO week-based calendar 1956-W52-7} {
- clock format -410400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W52-7
-} {Sun Sunday 56 1956 7 52 0}
-test clock-3.166 {ISO week-based calendar 1957-W01-1} {
- clock format -410313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-1
-} {Mon Monday 57 1957 1 01 1}
-test clock-3.167 {ISO week-based calendar 1957-W01-2} {
- clock format -410227200 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-2
-} {Tue Tuesday 57 1957 2 01 2}
-test clock-3.168 {ISO week-based calendar 1957-W01-7} {
- clock format -409795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-7
-} {Sun Sunday 57 1957 7 01 0}
-test clock-3.169 {ISO week-based calendar 1957-W02-1} {
- clock format -409708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W02-1
-} {Mon Monday 57 1957 1 02 1}
-test clock-3.170 {ISO week-based calendar 1958-W52-1} {
- clock format -348019200 -format {%a %A %g %G %u %V %w} -gmt true; # 1958-W52-1
-} {Mon Monday 58 1958 1 52 1}
-test clock-3.171 {ISO week-based calendar 1958-W52-7} {
- clock format -347500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1958-W52-7
-} {Sun Sunday 58 1958 7 52 0}
-test clock-3.172 {ISO week-based calendar 1959-W01-1} {
- clock format -347414400 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-1
-} {Mon Monday 59 1959 1 01 1}
-test clock-3.173 {ISO week-based calendar 1959-W01-4} {
- clock format -347155200 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-4
-} {Thu Thursday 59 1959 4 01 4}
-test clock-3.174 {ISO week-based calendar 1959-W01-7} {
- clock format -346896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-7
-} {Sun Sunday 59 1959 7 01 0}
-test clock-3.175 {ISO week-based calendar 1959-W02-1} {
- clock format -346809600 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W02-1
-} {Mon Monday 59 1959 1 02 1}
-test clock-3.176 {ISO week-based calendar 1959-W53-1} {
- clock format -315964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-1
-} {Mon Monday 59 1959 1 53 1}
-test clock-3.177 {ISO week-based calendar 1959-W53-5} {
- clock format -315619200 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-5
-} {Fri Friday 59 1959 5 53 5}
-test clock-3.178 {ISO week-based calendar 1959-W53-7} {
- clock format -315446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-7
-} {Sun Sunday 59 1959 7 53 0}
-test clock-3.179 {ISO week-based calendar 1960-W01-1} {
- clock format -315360000 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W01-1
-} {Mon Monday 60 1960 1 01 1}
-test clock-3.180 {ISO week-based calendar 1960-W01-7} {
- clock format -314841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W01-7
-} {Sun Sunday 60 1960 7 01 0}
-test clock-3.181 {ISO week-based calendar 1960-W02-1} {
- clock format -314755200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W02-1
-} {Mon Monday 60 1960 1 02 1}
-test clock-3.182 {ISO week-based calendar 1960-W52-1} {
- clock format -284515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-1
-} {Mon Monday 60 1960 1 52 1}
-test clock-3.183 {ISO week-based calendar 1960-W52-6} {
- clock format -284083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-6
-} {Sat Saturday 60 1960 6 52 6}
-test clock-3.184 {ISO week-based calendar 1960-W52-7} {
- clock format -283996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-7
-} {Sun Sunday 60 1960 7 52 0}
-test clock-3.185 {ISO week-based calendar 1961-W01-1} {
- clock format -283910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W01-1
-} {Mon Monday 61 1961 1 01 1}
-test clock-3.186 {ISO week-based calendar 1961-W01-7} {
- clock format -283392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W01-7
-} {Sun Sunday 61 1961 7 01 0}
-test clock-3.187 {ISO week-based calendar 1961-W02-1} {
- clock format -283305600 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W02-1
-} {Mon Monday 61 1961 1 02 1}
-test clock-3.188 {ISO week-based calendar 1961-W52-1} {
- clock format -253065600 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W52-1
-} {Mon Monday 61 1961 1 52 1}
-test clock-3.189 {ISO week-based calendar 1961-W52-7} {
- clock format -252547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W52-7
-} {Sun Sunday 61 1961 7 52 0}
-test clock-3.190 {ISO week-based calendar 1962-W01-1} {
- clock format -252460800 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W01-1
-} {Mon Monday 62 1962 1 01 1}
-test clock-3.191 {ISO week-based calendar 1962-W01-7} {
- clock format -251942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W01-7
-} {Sun Sunday 62 1962 7 01 0}
-test clock-3.192 {ISO week-based calendar 1962-W02-1} {
- clock format -251856000 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W02-1
-} {Mon Monday 62 1962 1 02 1}
-test clock-3.193 {ISO week-based calendar 1962-W52-1} {
- clock format -221616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W52-1
-} {Mon Monday 62 1962 1 52 1}
-test clock-3.194 {ISO week-based calendar 1962-W52-7} {
- clock format -221097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W52-7
-} {Sun Sunday 62 1962 7 52 0}
-test clock-3.195 {ISO week-based calendar 1963-W01-1} {
- clock format -221011200 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-1
-} {Mon Monday 63 1963 1 01 1}
-test clock-3.196 {ISO week-based calendar 1963-W01-2} {
- clock format -220924800 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-2
-} {Tue Tuesday 63 1963 2 01 2}
-test clock-3.197 {ISO week-based calendar 1963-W01-7} {
- clock format -220492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-7
-} {Sun Sunday 63 1963 7 01 0}
-test clock-3.198 {ISO week-based calendar 1963-W02-1} {
- clock format -220406400 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W02-1
-} {Mon Monday 63 1963 1 02 1}
-test clock-3.199 {ISO week-based calendar 1963-W52-1} {
- clock format -190166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W52-1
-} {Mon Monday 63 1963 1 52 1}
-test clock-3.200 {ISO week-based calendar 1963-W52-7} {
- clock format -189648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W52-7
-} {Sun Sunday 63 1963 7 52 0}
-test clock-3.201 {ISO week-based calendar 1964-W01-1} {
- clock format -189561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-1
-} {Mon Monday 64 1964 1 01 1}
-test clock-3.202 {ISO week-based calendar 1964-W01-3} {
- clock format -189388800 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-3
-} {Wed Wednesday 64 1964 3 01 3}
-test clock-3.203 {ISO week-based calendar 1964-W01-7} {
- clock format -189043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-7
-} {Sun Sunday 64 1964 7 01 0}
-test clock-3.204 {ISO week-based calendar 1964-W02-1} {
- clock format -188956800 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W02-1
-} {Mon Monday 64 1964 1 02 1}
-test clock-3.205 {ISO week-based calendar 1964-W53-1} {
- clock format -158112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-1
-} {Mon Monday 64 1964 1 53 1}
-test clock-3.206 {ISO week-based calendar 1964-W53-5} {
- clock format -157766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-5
-} {Fri Friday 64 1964 5 53 5}
-test clock-3.207 {ISO week-based calendar 1964-W53-7} {
- clock format -157593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-7
-} {Sun Sunday 64 1964 7 53 0}
-test clock-3.208 {ISO week-based calendar 1965-W01-1} {
- clock format -157507200 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W01-1
-} {Mon Monday 65 1965 1 01 1}
-test clock-3.209 {ISO week-based calendar 1965-W01-7} {
- clock format -156988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W01-7
-} {Sun Sunday 65 1965 7 01 0}
-test clock-3.210 {ISO week-based calendar 1965-W02-1} {
- clock format -156902400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W02-1
-} {Mon Monday 65 1965 1 02 1}
-test clock-3.211 {ISO week-based calendar 1965-W52-1} {
- clock format -126662400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-1
-} {Mon Monday 65 1965 1 52 1}
-test clock-3.212 {ISO week-based calendar 1965-W52-6} {
- clock format -126230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-6
-} {Sat Saturday 65 1965 6 52 6}
-test clock-3.213 {ISO week-based calendar 1965-W52-7} {
- clock format -126144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-7
-} {Sun Sunday 65 1965 7 52 0}
-test clock-3.214 {ISO week-based calendar 1966-W01-1} {
- clock format -126057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W01-1
-} {Mon Monday 66 1966 1 01 1}
-test clock-3.215 {ISO week-based calendar 1966-W01-7} {
- clock format -125539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W01-7
-} {Sun Sunday 66 1966 7 01 0}
-test clock-3.216 {ISO week-based calendar 1966-W02-1} {
- clock format -125452800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W02-1
-} {Mon Monday 66 1966 1 02 1}
-test clock-3.217 {ISO week-based calendar 1966-W52-1} {
- clock format -95212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-1
-} {Mon Monday 66 1966 1 52 1}
-test clock-3.218 {ISO week-based calendar 1966-W52-6} {
- clock format -94780800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-6
-} {Sat Saturday 66 1966 6 52 6}
-test clock-3.219 {ISO week-based calendar 1966-W52-7} {
- clock format -94694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-7
-} {Sun Sunday 66 1966 7 52 0}
-test clock-3.220 {ISO week-based calendar 1967-W01-1} {
- clock format -94608000 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W01-1
-} {Mon Monday 67 1967 1 01 1}
-test clock-3.221 {ISO week-based calendar 1967-W01-7} {
- clock format -94089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W01-7
-} {Sun Sunday 67 1967 7 01 0}
-test clock-3.222 {ISO week-based calendar 1967-W02-1} {
- clock format -94003200 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W02-1
-} {Mon Monday 67 1967 1 02 1}
-test clock-3.223 {ISO week-based calendar 1967-W52-1} {
- clock format -63763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W52-1
-} {Mon Monday 67 1967 1 52 1}
-test clock-3.224 {ISO week-based calendar 1967-W52-7} {
- clock format -63244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W52-7
-} {Sun Sunday 67 1967 7 52 0}
-test clock-3.225 {ISO week-based calendar 1968-W01-1} {
- clock format -63158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W01-1
-} {Mon Monday 68 1968 1 01 1}
-test clock-3.226 {ISO week-based calendar 1968-W01-7} {
- clock format -62640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W01-7
-} {Sun Sunday 68 1968 7 01 0}
-test clock-3.227 {ISO week-based calendar 1968-W02-1} {
- clock format -62553600 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W02-1
-} {Mon Monday 68 1968 1 02 1}
-test clock-3.228 {ISO week-based calendar 1968-W52-1} {
- clock format -32313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W52-1
-} {Mon Monday 68 1968 1 52 1}
-test clock-3.229 {ISO week-based calendar 1968-W52-7} {
- clock format -31795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W52-7
-} {Sun Sunday 68 1968 7 52 0}
-test clock-3.230 {ISO week-based calendar 1969-W01-1} {
- clock format -31708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-1
-} {Mon Monday 69 1969 1 01 1}
-test clock-3.231 {ISO week-based calendar 1969-W01-3} {
- clock format -31536000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-3
-} {Wed Wednesday 69 1969 3 01 3}
-test clock-3.232 {ISO week-based calendar 1969-W01-7} {
- clock format -31190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-7
-} {Sun Sunday 69 1969 7 01 0}
-test clock-3.233 {ISO week-based calendar 1969-W02-1} {
- clock format -31104000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W02-1
-} {Mon Monday 69 1969 1 02 1}
-test clock-3.234 {ISO week-based calendar 1969-W52-1} {
- clock format -864000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W52-1
-} {Mon Monday 69 1969 1 52 1}
-test clock-3.235 {ISO week-based calendar 1969-W52-7} {
- clock format -345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W52-7
-} {Sun Sunday 69 1969 7 52 0}
-test clock-3.236 {ISO week-based calendar 1970-W01-1} {
- clock format -259200 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-1
-} {Mon Monday 70 1970 1 01 1}
-test clock-3.237 {ISO week-based calendar 1970-W01-4} {
- clock format 0 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-4
-} {Thu Thursday 70 1970 4 01 4}
-test clock-3.238 {ISO week-based calendar 1970-W01-7} {
- clock format 259200 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-7
-} {Sun Sunday 70 1970 7 01 0}
-test clock-3.239 {ISO week-based calendar 1970-W02-1} {
- clock format 345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W02-1
-} {Mon Monday 70 1970 1 02 1}
-test clock-3.240 {ISO week-based calendar 1970-W53-1} {
- clock format 31190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-1
-} {Mon Monday 70 1970 1 53 1}
-test clock-3.241 {ISO week-based calendar 1970-W53-5} {
- clock format 31536000 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-5
-} {Fri Friday 70 1970 5 53 5}
-test clock-3.242 {ISO week-based calendar 1970-W53-7} {
- clock format 31708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-7
-} {Sun Sunday 70 1970 7 53 0}
-test clock-3.243 {ISO week-based calendar 1971-W01-1} {
- clock format 31795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W01-1
-} {Mon Monday 71 1971 1 01 1}
-test clock-3.244 {ISO week-based calendar 1971-W01-7} {
- clock format 32313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W01-7
-} {Sun Sunday 71 1971 7 01 0}
-test clock-3.245 {ISO week-based calendar 1971-W02-1} {
- clock format 32400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W02-1
-} {Mon Monday 71 1971 1 02 1}
-test clock-3.246 {ISO week-based calendar 1971-W52-1} {
- clock format 62640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-1
-} {Mon Monday 71 1971 1 52 1}
-test clock-3.247 {ISO week-based calendar 1971-W52-6} {
- clock format 63072000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-6
-} {Sat Saturday 71 1971 6 52 6}
-test clock-3.248 {ISO week-based calendar 1971-W52-7} {
- clock format 63158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-7
-} {Sun Sunday 71 1971 7 52 0}
-test clock-3.249 {ISO week-based calendar 1972-W01-1} {
- clock format 63244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W01-1
-} {Mon Monday 72 1972 1 01 1}
-test clock-3.250 {ISO week-based calendar 1972-W01-7} {
- clock format 63763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W01-7
-} {Sun Sunday 72 1972 7 01 0}
-test clock-3.251 {ISO week-based calendar 1972-W02-1} {
- clock format 63849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W02-1
-} {Mon Monday 72 1972 1 02 1}
-test clock-3.252 {ISO week-based calendar 1972-W52-1} {
- clock format 94089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W52-1
-} {Mon Monday 72 1972 1 52 1}
-test clock-3.253 {ISO week-based calendar 1972-W52-7} {
- clock format 94608000 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W52-7
-} {Sun Sunday 72 1972 7 52 0}
-test clock-3.254 {ISO week-based calendar 1973-W01-1} {
- clock format 94694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W01-1
-} {Mon Monday 73 1973 1 01 1}
-test clock-3.255 {ISO week-based calendar 1973-W01-7} {
- clock format 95212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W01-7
-} {Sun Sunday 73 1973 7 01 0}
-test clock-3.256 {ISO week-based calendar 1973-W02-1} {
- clock format 95299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W02-1
-} {Mon Monday 73 1973 1 02 1}
-test clock-3.257 {ISO week-based calendar 1973-W52-1} {
- clock format 125539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W52-1
-} {Mon Monday 73 1973 1 52 1}
-test clock-3.258 {ISO week-based calendar 1973-W52-7} {
- clock format 126057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W52-7
-} {Sun Sunday 73 1973 7 52 0}
-test clock-3.259 {ISO week-based calendar 1974-W01-1} {
- clock format 126144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-1
-} {Mon Monday 74 1974 1 01 1}
-test clock-3.260 {ISO week-based calendar 1974-W01-2} {
- clock format 126230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-2
-} {Tue Tuesday 74 1974 2 01 2}
-test clock-3.261 {ISO week-based calendar 1974-W01-7} {
- clock format 126662400 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-7
-} {Sun Sunday 74 1974 7 01 0}
-test clock-3.262 {ISO week-based calendar 1974-W02-1} {
- clock format 126748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W02-1
-} {Mon Monday 74 1974 1 02 1}
-test clock-3.263 {ISO week-based calendar 1974-W52-1} {
- clock format 156988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W52-1
-} {Mon Monday 74 1974 1 52 1}
-test clock-3.264 {ISO week-based calendar 1974-W52-7} {
- clock format 157507200 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W52-7
-} {Sun Sunday 74 1974 7 52 0}
-test clock-3.265 {ISO week-based calendar 1975-W01-1} {
- clock format 157593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-1
-} {Mon Monday 75 1975 1 01 1}
-test clock-3.266 {ISO week-based calendar 1975-W01-3} {
- clock format 157766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-3
-} {Wed Wednesday 75 1975 3 01 3}
-test clock-3.267 {ISO week-based calendar 1975-W01-7} {
- clock format 158112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-7
-} {Sun Sunday 75 1975 7 01 0}
-test clock-3.268 {ISO week-based calendar 1975-W02-1} {
- clock format 158198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W02-1
-} {Mon Monday 75 1975 1 02 1}
-test clock-3.269 {ISO week-based calendar 1975-W52-1} {
- clock format 188438400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W52-1
-} {Mon Monday 75 1975 1 52 1}
-test clock-3.270 {ISO week-based calendar 1975-W52-7} {
- clock format 188956800 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W52-7
-} {Sun Sunday 75 1975 7 52 0}
-test clock-3.271 {ISO week-based calendar 1976-W01-1} {
- clock format 189043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-1
-} {Mon Monday 76 1976 1 01 1}
-test clock-3.272 {ISO week-based calendar 1976-W01-4} {
- clock format 189302400 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-4
-} {Thu Thursday 76 1976 4 01 4}
-test clock-3.273 {ISO week-based calendar 1976-W01-7} {
- clock format 189561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-7
-} {Sun Sunday 76 1976 7 01 0}
-test clock-3.274 {ISO week-based calendar 1976-W02-1} {
- clock format 189648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W02-1
-} {Mon Monday 76 1976 1 02 1}
-test clock-3.275 {ISO week-based calendar 1976-W53-1} {
- clock format 220492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-1
-} {Mon Monday 76 1976 1 53 1}
-test clock-3.276 {ISO week-based calendar 1976-W53-6} {
- clock format 220924800 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-6
-} {Sat Saturday 76 1976 6 53 6}
-test clock-3.277 {ISO week-based calendar 1976-W53-7} {
- clock format 221011200 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-7
-} {Sun Sunday 76 1976 7 53 0}
-test clock-3.278 {ISO week-based calendar 1977-W01-1} {
- clock format 221097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W01-1
-} {Mon Monday 77 1977 1 01 1}
-test clock-3.279 {ISO week-based calendar 1977-W01-7} {
- clock format 221616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W01-7
-} {Sun Sunday 77 1977 7 01 0}
-test clock-3.280 {ISO week-based calendar 1977-W02-1} {
- clock format 221702400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W02-1
-} {Mon Monday 77 1977 1 02 1}
-test clock-3.281 {ISO week-based calendar 1977-W52-1} {
- clock format 251942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-1
-} {Mon Monday 77 1977 1 52 1}
-test clock-3.282 {ISO week-based calendar 1977-W52-6} {
- clock format 252374400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-6
-} {Sat Saturday 77 1977 6 52 6}
-test clock-3.283 {ISO week-based calendar 1977-W52-7} {
- clock format 252460800 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-7
-} {Sun Sunday 77 1977 7 52 0}
-test clock-3.284 {ISO week-based calendar 1978-W01-1} {
- clock format 252547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W01-1
-} {Mon Monday 78 1978 1 01 1}
-test clock-3.285 {ISO week-based calendar 1978-W01-7} {
- clock format 253065600 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W01-7
-} {Sun Sunday 78 1978 7 01 0}
-test clock-3.286 {ISO week-based calendar 1978-W02-1} {
- clock format 253152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W02-1
-} {Mon Monday 78 1978 1 02 1}
-test clock-3.287 {ISO week-based calendar 1978-W52-1} {
- clock format 283392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W52-1
-} {Mon Monday 78 1978 1 52 1}
-test clock-3.288 {ISO week-based calendar 1978-W52-7} {
- clock format 283910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W52-7
-} {Sun Sunday 78 1978 7 52 0}
-test clock-3.289 {ISO week-based calendar 1979-W01-1} {
- clock format 283996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W01-1
-} {Mon Monday 79 1979 1 01 1}
-test clock-3.290 {ISO week-based calendar 1979-W01-7} {
- clock format 284515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W01-7
-} {Sun Sunday 79 1979 7 01 0}
-test clock-3.291 {ISO week-based calendar 1979-W02-1} {
- clock format 284601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W02-1
-} {Mon Monday 79 1979 1 02 1}
-test clock-3.292 {ISO week-based calendar 1979-W52-1} {
- clock format 314841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W52-1
-} {Mon Monday 79 1979 1 52 1}
-test clock-3.293 {ISO week-based calendar 1979-W52-7} {
- clock format 315360000 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W52-7
-} {Sun Sunday 79 1979 7 52 0}
-test clock-3.294 {ISO week-based calendar 1980-W01-1} {
- clock format 315446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-1
-} {Mon Monday 80 1980 1 01 1}
-test clock-3.295 {ISO week-based calendar 1980-W01-2} {
- clock format 315532800 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-2
-} {Tue Tuesday 80 1980 2 01 2}
-test clock-3.296 {ISO week-based calendar 1980-W01-7} {
- clock format 315964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-7
-} {Sun Sunday 80 1980 7 01 0}
-test clock-3.297 {ISO week-based calendar 1980-W02-1} {
- clock format 316051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W02-1
-} {Mon Monday 80 1980 1 02 1}
-test clock-3.298 {ISO week-based calendar 1980-W52-1} {
- clock format 346291200 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W52-1
-} {Mon Monday 80 1980 1 52 1}
-test clock-3.299 {ISO week-based calendar 1980-W52-7} {
- clock format 346809600 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W52-7
-} {Sun Sunday 80 1980 7 52 0}
-test clock-3.300 {ISO week-based calendar 1981-W01-1} {
- clock format 346896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-1
-} {Mon Monday 81 1981 1 01 1}
-test clock-3.301 {ISO week-based calendar 1981-W01-4} {
- clock format 347155200 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-4
-} {Thu Thursday 81 1981 4 01 4}
-test clock-3.302 {ISO week-based calendar 1981-W01-7} {
- clock format 347414400 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-7
-} {Sun Sunday 81 1981 7 01 0}
-test clock-3.303 {ISO week-based calendar 1981-W02-1} {
- clock format 347500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W02-1
-} {Mon Monday 81 1981 1 02 1}
-test clock-3.304 {ISO week-based calendar 1983-W52-1} {
- clock format 441244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-1
-} {Mon Monday 83 1983 1 52 1}
-test clock-3.305 {ISO week-based calendar 1983-W52-6} {
- clock format 441676800 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-6
-} {Sat Saturday 83 1983 6 52 6}
-test clock-3.306 {ISO week-based calendar 1983-W52-7} {
- clock format 441763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-7
-} {Sun Sunday 83 1983 7 52 0}
-test clock-3.307 {ISO week-based calendar 1984-W01-1} {
- clock format 441849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W01-1
-} {Mon Monday 84 1984 1 01 1}
-test clock-3.308 {ISO week-based calendar 1984-W01-7} {
- clock format 442368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W01-7
-} {Sun Sunday 84 1984 7 01 0}
-test clock-3.309 {ISO week-based calendar 1984-W02-1} {
- clock format 442454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W02-1
-} {Mon Monday 84 1984 1 02 1}
-test clock-3.310 {ISO week-based calendar 1984-W52-1} {
- clock format 472694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W52-1
-} {Mon Monday 84 1984 1 52 1}
-test clock-3.311 {ISO week-based calendar 1984-W52-7} {
- clock format 473212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W52-7
-} {Sun Sunday 84 1984 7 52 0}
-test clock-3.312 {ISO week-based calendar 1985-W01-1} {
- clock format 473299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-1
-} {Mon Monday 85 1985 1 01 1}
-test clock-3.313 {ISO week-based calendar 1985-W01-2} {
- clock format 473385600 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-2
-} {Tue Tuesday 85 1985 2 01 2}
-test clock-3.314 {ISO week-based calendar 1985-W01-7} {
- clock format 473817600 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-7
-} {Sun Sunday 85 1985 7 01 0}
-test clock-3.315 {ISO week-based calendar 1985-W02-1} {
- clock format 473904000 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W02-1
-} {Mon Monday 85 1985 1 02 1}
-test clock-3.316 {ISO week-based calendar 1987-W53-1} {
- clock format 567648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-1
-} {Mon Monday 87 1987 1 53 1}
-test clock-3.317 {ISO week-based calendar 1987-W53-5} {
- clock format 567993600 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-5
-} {Fri Friday 87 1987 5 53 5}
-test clock-3.318 {ISO week-based calendar 1987-W53-7} {
- clock format 568166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-7
-} {Sun Sunday 87 1987 7 53 0}
-test clock-3.319 {ISO week-based calendar 1988-W01-1} {
- clock format 568252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W01-1
-} {Mon Monday 88 1988 1 01 1}
-test clock-3.320 {ISO week-based calendar 1988-W01-7} {
- clock format 568771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W01-7
-} {Sun Sunday 88 1988 7 01 0}
-test clock-3.321 {ISO week-based calendar 1988-W02-1} {
- clock format 568857600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W02-1
-} {Mon Monday 88 1988 1 02 1}
-test clock-3.322 {ISO week-based calendar 1988-W52-1} {
- clock format 599097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-1
-} {Mon Monday 88 1988 1 52 1}
-test clock-3.323 {ISO week-based calendar 1988-W52-6} {
- clock format 599529600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-6
-} {Sat Saturday 88 1988 6 52 6}
-test clock-3.324 {ISO week-based calendar 1988-W52-7} {
- clock format 599616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-7
-} {Sun Sunday 88 1988 7 52 0}
-test clock-3.325 {ISO week-based calendar 1989-W01-1} {
- clock format 599702400 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W01-1
-} {Mon Monday 89 1989 1 01 1}
-test clock-3.326 {ISO week-based calendar 1989-W01-7} {
- clock format 600220800 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W01-7
-} {Sun Sunday 89 1989 7 01 0}
-test clock-3.327 {ISO week-based calendar 1989-W02-1} {
- clock format 600307200 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W02-1
-} {Mon Monday 89 1989 1 02 1}
-test clock-3.328 {ISO week-based calendar 1991-W52-1} {
- clock format 693446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1991-W52-1
-} {Mon Monday 91 1991 1 52 1}
-test clock-3.329 {ISO week-based calendar 1991-W52-7} {
- clock format 693964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1991-W52-7
-} {Sun Sunday 91 1991 7 52 0}
-test clock-3.330 {ISO week-based calendar 1992-W01-1} {
- clock format 694051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-1
-} {Mon Monday 92 1992 1 01 1}
-test clock-3.331 {ISO week-based calendar 1992-W01-3} {
- clock format 694224000 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-3
-} {Wed Wednesday 92 1992 3 01 3}
-test clock-3.332 {ISO week-based calendar 1992-W01-7} {
- clock format 694569600 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-7
-} {Sun Sunday 92 1992 7 01 0}
-test clock-3.333 {ISO week-based calendar 1992-W02-1} {
- clock format 694656000 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W02-1
-} {Mon Monday 92 1992 1 02 1}
-test clock-3.334 {ISO week-based calendar 1992-W53-1} {
- clock format 725500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-1
-} {Mon Monday 92 1992 1 53 1}
-test clock-3.335 {ISO week-based calendar 1992-W53-5} {
- clock format 725846400 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-5
-} {Fri Friday 92 1992 5 53 5}
-test clock-3.336 {ISO week-based calendar 1992-W53-7} {
- clock format 726019200 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-7
-} {Sun Sunday 92 1992 7 53 0}
-test clock-3.337 {ISO week-based calendar 1993-W01-1} {
- clock format 726105600 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W01-1
-} {Mon Monday 93 1993 1 01 1}
-test clock-3.338 {ISO week-based calendar 1993-W01-7} {
- clock format 726624000 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W01-7
-} {Sun Sunday 93 1993 7 01 0}
-test clock-3.339 {ISO week-based calendar 1993-W02-1} {
- clock format 726710400 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W02-1
-} {Mon Monday 93 1993 1 02 1}
-test clock-3.340 {ISO week-based calendar 1995-W52-1} {
- clock format 819849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1995-W52-1
-} {Mon Monday 95 1995 1 52 1}
-test clock-3.341 {ISO week-based calendar 1995-W52-7} {
- clock format 820368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1995-W52-7
-} {Sun Sunday 95 1995 7 52 0}
-test clock-3.342 {ISO week-based calendar 1996-W01-1} {
- clock format 820454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W01-1
-} {Mon Monday 96 1996 1 01 1}
-test clock-3.343 {ISO week-based calendar 1996-W01-7} {
- clock format 820972800 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W01-7
-} {Sun Sunday 96 1996 7 01 0}
-test clock-3.344 {ISO week-based calendar 1996-W02-1} {
- clock format 821059200 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W02-1
-} {Mon Monday 96 1996 1 02 1}
-test clock-3.345 {ISO week-based calendar 1996-W52-1} {
- clock format 851299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W52-1
-} {Mon Monday 96 1996 1 52 1}
-test clock-3.346 {ISO week-based calendar 1996-W52-7} {
- clock format 851817600 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W52-7
-} {Sun Sunday 96 1996 7 52 0}
-test clock-3.347 {ISO week-based calendar 1997-W01-1} {
- clock format 851904000 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-1
-} {Mon Monday 97 1997 1 01 1}
-test clock-3.348 {ISO week-based calendar 1997-W01-3} {
- clock format 852076800 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-3
-} {Wed Wednesday 97 1997 3 01 3}
-test clock-3.349 {ISO week-based calendar 1997-W01-7} {
- clock format 852422400 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-7
-} {Sun Sunday 97 1997 7 01 0}
-test clock-3.350 {ISO week-based calendar 1997-W02-1} {
- clock format 852508800 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W02-1
-} {Mon Monday 97 1997 1 02 1}
-test clock-3.351 {ISO week-based calendar 1999-W52-1} {
- clock format 946252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-1
-} {Mon Monday 99 1999 1 52 1}
-test clock-3.352 {ISO week-based calendar 1999-W52-6} {
- clock format 946684800 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-6
-} {Sat Saturday 99 1999 6 52 6}
-test clock-3.353 {ISO week-based calendar 1999-W52-7} {
- clock format 946771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-7
-} {Sun Sunday 99 1999 7 52 0}
-test clock-3.354 {ISO week-based calendar 2000-W01-1} {
- clock format 946857600 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W01-1
-} {Mon Monday 00 2000 1 01 1}
-test clock-3.355 {ISO week-based calendar 2000-W01-7} {
- clock format 947376000 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W01-7
-} {Sun Sunday 00 2000 7 01 0}
-test clock-3.356 {ISO week-based calendar 2000-W02-1} {
- clock format 947462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W02-1
-} {Mon Monday 00 2000 1 02 1}
-test clock-3.357 {ISO week-based calendar 2000-W52-1} {
- clock format 977702400 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W52-1
-} {Mon Monday 00 2000 1 52 1}
-test clock-3.358 {ISO week-based calendar 2000-W52-7} {
- clock format 978220800 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W52-7
-} {Sun Sunday 00 2000 7 52 0}
-test clock-3.359 {ISO week-based calendar 2001-W01-1} {
- clock format 978307200 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W01-1
-} {Mon Monday 01 2001 1 01 1}
-test clock-3.360 {ISO week-based calendar 2001-W01-7} {
- clock format 978825600 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W01-7
-} {Sun Sunday 01 2001 7 01 0}
-test clock-3.361 {ISO week-based calendar 2001-W02-1} {
- clock format 978912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W02-1
-} {Mon Monday 01 2001 1 02 1}
-test clock-3.362 {ISO week-based calendar 2001-W52-1} {
- clock format 1009152000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W52-1
-} {Mon Monday 01 2001 1 52 1}
-test clock-3.363 {ISO week-based calendar 2001-W52-7} {
- clock format 1009670400 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W52-7
-} {Sun Sunday 01 2001 7 52 0}
-test clock-3.364 {ISO week-based calendar 2002-W01-1} {
- clock format 1009756800 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-1
-} {Mon Monday 02 2002 1 01 1}
-test clock-3.365 {ISO week-based calendar 2002-W01-2} {
- clock format 1009843200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-2
-} {Tue Tuesday 02 2002 2 01 2}
-test clock-3.366 {ISO week-based calendar 2002-W01-7} {
- clock format 1010275200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-7
-} {Sun Sunday 02 2002 7 01 0}
-test clock-3.367 {ISO week-based calendar 2002-W02-1} {
- clock format 1010361600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W02-1
-} {Mon Monday 02 2002 1 02 1}
-test clock-3.368 {ISO week-based calendar 2002-W52-1} {
- clock format 1040601600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W52-1
-} {Mon Monday 02 2002 1 52 1}
-test clock-3.369 {ISO week-based calendar 2002-W52-7} {
- clock format 1041120000 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W52-7
-} {Sun Sunday 02 2002 7 52 0}
-test clock-3.370 {ISO week-based calendar 2003-W01-1} {
- clock format 1041206400 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-1
-} {Mon Monday 03 2003 1 01 1}
-test clock-3.371 {ISO week-based calendar 2003-W01-3} {
- clock format 1041379200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-3
-} {Wed Wednesday 03 2003 3 01 3}
-test clock-3.372 {ISO week-based calendar 2003-W01-7} {
- clock format 1041724800 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-7
-} {Sun Sunday 03 2003 7 01 0}
-test clock-3.373 {ISO week-based calendar 2003-W02-1} {
- clock format 1041811200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W02-1
-} {Mon Monday 03 2003 1 02 1}
-test clock-3.374 {ISO week-based calendar 2003-W52-1} {
- clock format 1072051200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W52-1
-} {Mon Monday 03 2003 1 52 1}
-test clock-3.375 {ISO week-based calendar 2003-W52-7} {
- clock format 1072569600 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W52-7
-} {Sun Sunday 03 2003 7 52 0}
-test clock-3.376 {ISO week-based calendar 2004-W01-1} {
- clock format 1072656000 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-1
-} {Mon Monday 04 2004 1 01 1}
-test clock-3.377 {ISO week-based calendar 2004-W01-4} {
- clock format 1072915200 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-4
-} {Thu Thursday 04 2004 4 01 4}
-test clock-3.378 {ISO week-based calendar 2004-W01-7} {
- clock format 1073174400 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-7
-} {Sun Sunday 04 2004 7 01 0}
-test clock-3.379 {ISO week-based calendar 2004-W02-1} {
- clock format 1073260800 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W02-1
-} {Mon Monday 04 2004 1 02 1}
-test clock-3.380 {ISO week-based calendar 2004-W53-1} {
- clock format 1104105600 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-1
-} {Mon Monday 04 2004 1 53 1}
-test clock-3.381 {ISO week-based calendar 2004-W53-6} {
- clock format 1104537600 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-6
-} {Sat Saturday 04 2004 6 53 6}
-test clock-3.382 {ISO week-based calendar 2004-W53-7} {
- clock format 1104624000 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-7
-} {Sun Sunday 04 2004 7 53 0}
-test clock-3.383 {ISO week-based calendar 2005-W01-1} {
- clock format 1104710400 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W01-1
-} {Mon Monday 05 2005 1 01 1}
-test clock-3.384 {ISO week-based calendar 2005-W01-7} {
- clock format 1105228800 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W01-7
-} {Sun Sunday 05 2005 7 01 0}
-test clock-3.385 {ISO week-based calendar 2005-W02-1} {
- clock format 1105315200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W02-1
-} {Mon Monday 05 2005 1 02 1}
-test clock-3.386 {ISO week-based calendar 2005-W52-1} {
- clock format 1135555200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-1
-} {Mon Monday 05 2005 1 52 1}
-test clock-3.387 {ISO week-based calendar 2005-W52-6} {
- clock format 1135987200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-6
-} {Sat Saturday 05 2005 6 52 6}
-test clock-3.388 {ISO week-based calendar 2005-W52-7} {
- clock format 1136073600 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-7
-} {Sun Sunday 05 2005 7 52 0}
-test clock-3.389 {ISO week-based calendar 2006-W01-1} {
- clock format 1136160000 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W01-1
-} {Mon Monday 06 2006 1 01 1}
-test clock-3.390 {ISO week-based calendar 2006-W01-7} {
- clock format 1136678400 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W01-7
-} {Sun Sunday 06 2006 7 01 0}
-test clock-3.391 {ISO week-based calendar 2006-W02-1} {
- clock format 1136764800 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W02-1
-} {Mon Monday 06 2006 1 02 1}
-test clock-3.392 {ISO week-based calendar 2006-W52-1} {
- clock format 1167004800 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W52-1
-} {Mon Monday 06 2006 1 52 1}
-test clock-3.393 {ISO week-based calendar 2006-W52-7} {
- clock format 1167523200 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W52-7
-} {Sun Sunday 06 2006 7 52 0}
-test clock-3.394 {ISO week-based calendar 2007-W01-1} {
- clock format 1167609600 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W01-1
-} {Mon Monday 07 2007 1 01 1}
-test clock-3.395 {ISO week-based calendar 2007-W01-7} {
- clock format 1168128000 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W01-7
-} {Sun Sunday 07 2007 7 01 0}
-test clock-3.396 {ISO week-based calendar 2007-W02-1} {
- clock format 1168214400 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W02-1
-} {Mon Monday 07 2007 1 02 1}
-test clock-3.397 {ISO week-based calendar 2007-W52-1} {
- clock format 1198454400 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W52-1
-} {Mon Monday 07 2007 1 52 1}
-test clock-3.398 {ISO week-based calendar 2007-W52-7} {
- clock format 1198972800 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W52-7
-} {Sun Sunday 07 2007 7 52 0}
-test clock-3.399 {ISO week-based calendar 2008-W01-1} {
- clock format 1199059200 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-1
-} {Mon Monday 08 2008 1 01 1}
-test clock-3.400 {ISO week-based calendar 2008-W01-2} {
- clock format 1199145600 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-2
-} {Tue Tuesday 08 2008 2 01 2}
-test clock-3.401 {ISO week-based calendar 2008-W01-7} {
- clock format 1199577600 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-7
-} {Sun Sunday 08 2008 7 01 0}
-test clock-3.402 {ISO week-based calendar 2008-W02-1} {
- clock format 1199664000 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W02-1
-} {Mon Monday 08 2008 1 02 1}
-test clock-3.403 {ISO week-based calendar 2008-W52-1} {
- clock format 1229904000 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W52-1
-} {Mon Monday 08 2008 1 52 1}
-test clock-3.404 {ISO week-based calendar 2008-W52-7} {
- clock format 1230422400 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W52-7
-} {Sun Sunday 08 2008 7 52 0}
-test clock-3.405 {ISO week-based calendar 2009-W01-1} {
- clock format 1230508800 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-1
-} {Mon Monday 09 2009 1 01 1}
-test clock-3.406 {ISO week-based calendar 2009-W01-4} {
- clock format 1230768000 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-4
-} {Thu Thursday 09 2009 4 01 4}
-test clock-3.407 {ISO week-based calendar 2009-W01-7} {
- clock format 1231027200 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-7
-} {Sun Sunday 09 2009 7 01 0}
-test clock-3.408 {ISO week-based calendar 2009-W02-1} {
- clock format 1231113600 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W02-1
-} {Mon Monday 09 2009 1 02 1}
-test clock-3.409 {ISO week-based calendar 2009-W53-1} {
- clock format 1261958400 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-1
-} {Mon Monday 09 2009 1 53 1}
-test clock-3.410 {ISO week-based calendar 2009-W53-5} {
- clock format 1262304000 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-5
-} {Fri Friday 09 2009 5 53 5}
-test clock-3.411 {ISO week-based calendar 2009-W53-7} {
- clock format 1262476800 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-7
-} {Sun Sunday 09 2009 7 53 0}
-test clock-3.412 {ISO week-based calendar 2010-W01-1} {
- clock format 1262563200 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W01-1
-} {Mon Monday 10 2010 1 01 1}
-test clock-3.413 {ISO week-based calendar 2010-W01-7} {
- clock format 1263081600 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W01-7
-} {Sun Sunday 10 2010 7 01 0}
-test clock-3.414 {ISO week-based calendar 2010-W02-1} {
- clock format 1263168000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W02-1
-} {Mon Monday 10 2010 1 02 1}
-test clock-3.415 {ISO week-based calendar 2010-W52-1} {
- clock format 1293408000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-1
-} {Mon Monday 10 2010 1 52 1}
-test clock-3.416 {ISO week-based calendar 2010-W52-6} {
- clock format 1293840000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-6
-} {Sat Saturday 10 2010 6 52 6}
-test clock-3.417 {ISO week-based calendar 2010-W52-7} {
- clock format 1293926400 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-7
-} {Sun Sunday 10 2010 7 52 0}
-test clock-3.418 {ISO week-based calendar 2011-W01-1} {
- clock format 1294012800 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W01-1
-} {Mon Monday 11 2011 1 01 1}
-test clock-3.419 {ISO week-based calendar 2011-W01-7} {
- clock format 1294531200 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W01-7
-} {Sun Sunday 11 2011 7 01 0}
-test clock-3.420 {ISO week-based calendar 2011-W02-1} {
- clock format 1294617600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W02-1
-} {Mon Monday 11 2011 1 02 1}
-test clock-3.421 {ISO week-based calendar 2011-W52-1} {
- clock format 1324857600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-1
-} {Mon Monday 11 2011 1 52 1}
-test clock-3.422 {ISO week-based calendar 2011-W52-6} {
- clock format 1325289600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-6
-} {Sat Saturday 11 2011 6 52 6}
-test clock-3.423 {ISO week-based calendar 2011-W52-7} {
- clock format 1325376000 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-7
-} {Sun Sunday 11 2011 7 52 0}
-test clock-3.424 {ISO week-based calendar 2012-W01-1} {
- clock format 1325462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W01-1
-} {Mon Monday 12 2012 1 01 1}
-test clock-3.425 {ISO week-based calendar 2012-W01-7} {
- clock format 1325980800 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W01-7
-} {Sun Sunday 12 2012 7 01 0}
-test clock-3.426 {ISO week-based calendar 2012-W02-1} {
- clock format 1326067200 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W02-1
-} {Mon Monday 12 2012 1 02 1}
-test clock-3.427 {ISO week-based calendar 2012-W52-1} {
- clock format 1356307200 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W52-1
-} {Mon Monday 12 2012 1 52 1}
-test clock-3.428 {ISO week-based calendar 2012-W52-7} {
- clock format 1356825600 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W52-7
-} {Sun Sunday 12 2012 7 52 0}
-test clock-3.429 {ISO week-based calendar 2013-W01-1} {
- clock format 1356912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-1
-} {Mon Monday 13 2013 1 01 1}
-test clock-3.430 {ISO week-based calendar 2013-W01-2} {
- clock format 1356998400 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-2
-} {Tue Tuesday 13 2013 2 01 2}
-test clock-3.431 {ISO week-based calendar 2013-W01-7} {
- clock format 1357430400 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-7
-} {Sun Sunday 13 2013 7 01 0}
-test clock-3.432 {ISO week-based calendar 2013-W02-1} {
- clock format 1357516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W02-1
-} {Mon Monday 13 2013 1 02 1}
-test clock-3.433 {ISO week-based calendar 2015-W53-1} {
- clock format 1451260800 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-1
-} {Mon Monday 15 2015 1 53 1}
-test clock-3.434 {ISO week-based calendar 2015-W53-5} {
- clock format 1451606400 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-5
-} {Fri Friday 15 2015 5 53 5}
-test clock-3.435 {ISO week-based calendar 2015-W53-7} {
- clock format 1451779200 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-7
-} {Sun Sunday 15 2015 7 53 0}
-test clock-3.436 {ISO week-based calendar 2016-W01-1} {
- clock format 1451865600 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W01-1
-} {Mon Monday 16 2016 1 01 1}
-test clock-3.437 {ISO week-based calendar 2016-W01-7} {
- clock format 1452384000 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W01-7
-} {Sun Sunday 16 2016 7 01 0}
-test clock-3.438 {ISO week-based calendar 2016-W02-1} {
- clock format 1452470400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W02-1
-} {Mon Monday 16 2016 1 02 1}
-test clock-3.439 {ISO week-based calendar 2016-W52-1} {
- clock format 1482710400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-1
-} {Mon Monday 16 2016 1 52 1}
-test clock-3.440 {ISO week-based calendar 2016-W52-6} {
- clock format 1483142400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-6
-} {Sat Saturday 16 2016 6 52 6}
-test clock-3.441 {ISO week-based calendar 2016-W52-7} {
- clock format 1483228800 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-7
-} {Sun Sunday 16 2016 7 52 0}
-test clock-3.442 {ISO week-based calendar 2017-W01-1} {
- clock format 1483315200 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W01-1
-} {Mon Monday 17 2017 1 01 1}
-test clock-3.443 {ISO week-based calendar 2017-W01-7} {
- clock format 1483833600 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W01-7
-} {Sun Sunday 17 2017 7 01 0}
-test clock-3.444 {ISO week-based calendar 2017-W02-1} {
- clock format 1483920000 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W02-1
-} {Mon Monday 17 2017 1 02 1}
-test clock-3.445 {ISO week-based calendar 2019-W52-1} {
- clock format 1577059200 -format {%a %A %g %G %u %V %w} -gmt true; # 2019-W52-1
-} {Mon Monday 19 2019 1 52 1}
-test clock-3.446 {ISO week-based calendar 2019-W52-7} {
- clock format 1577577600 -format {%a %A %g %G %u %V %w} -gmt true; # 2019-W52-7
-} {Sun Sunday 19 2019 7 52 0}
-test clock-3.447 {ISO week-based calendar 2020-W01-1} {
- clock format 1577664000 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-1
-} {Mon Monday 20 2020 1 01 1}
-test clock-3.448 {ISO week-based calendar 2020-W01-3} {
- clock format 1577836800 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-3
-} {Wed Wednesday 20 2020 3 01 3}
-test clock-3.449 {ISO week-based calendar 2020-W01-7} {
- clock format 1578182400 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-7
-} {Sun Sunday 20 2020 7 01 0}
-test clock-3.450 {ISO week-based calendar 2020-W02-1} {
- clock format 1578268800 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W02-1
-} {Mon Monday 20 2020 1 02 1}
-test clock-3.451 {ISO week-based calendar 2020-W53-1} {
- clock format 1609113600 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-1
-} {Mon Monday 20 2020 1 53 1}
-test clock-3.452 {ISO week-based calendar 2020-W53-5} {
- clock format 1609459200 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-5
-} {Fri Friday 20 2020 5 53 5}
-test clock-3.453 {ISO week-based calendar 2020-W53-7} {
- clock format 1609632000 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-7
-} {Sun Sunday 20 2020 7 53 0}
-test clock-3.454 {ISO week-based calendar 2021-W01-1} {
- clock format 1609718400 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W01-1
-} {Mon Monday 21 2021 1 01 1}
-test clock-3.455 {ISO week-based calendar 2021-W01-7} {
- clock format 1610236800 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W01-7
-} {Sun Sunday 21 2021 7 01 0}
-test clock-3.456 {ISO week-based calendar 2021-W02-1} {
- clock format 1610323200 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W02-1
-} {Mon Monday 21 2021 1 02 1}
-test clock-3.457 {ISO week-based calendar 2023-W52-1} {
- clock format 1703462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2023-W52-1
-} {Mon Monday 23 2023 1 52 1}
-test clock-3.458 {ISO week-based calendar 2023-W52-7} {
- clock format 1703980800 -format {%a %A %g %G %u %V %w} -gmt true; # 2023-W52-7
-} {Sun Sunday 23 2023 7 52 0}
-test clock-3.459 {ISO week-based calendar 2024-W01-1} {
- clock format 1704067200 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W01-1
-} {Mon Monday 24 2024 1 01 1}
-test clock-3.460 {ISO week-based calendar 2024-W01-7} {
- clock format 1704585600 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W01-7
-} {Sun Sunday 24 2024 7 01 0}
-test clock-3.461 {ISO week-based calendar 2024-W02-1} {
- clock format 1704672000 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W02-1
-} {Mon Monday 24 2024 1 02 1}
-test clock-3.462 {ISO week-based calendar 2024-W52-1} {
- clock format 1734912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W52-1
-} {Mon Monday 24 2024 1 52 1}
-test clock-3.463 {ISO week-based calendar 2024-W52-7} {
- clock format 1735430400 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W52-7
-} {Sun Sunday 24 2024 7 52 0}
-test clock-3.464 {ISO week-based calendar 2025-W01-1} {
- clock format 1735516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-1
-} {Mon Monday 25 2025 1 01 1}
-test clock-3.465 {ISO week-based calendar 2025-W01-3} {
- clock format 1735689600 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-3
-} {Wed Wednesday 25 2025 3 01 3}
-test clock-3.466 {ISO week-based calendar 2025-W01-7} {
- clock format 1736035200 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-7
-} {Sun Sunday 25 2025 7 01 0}
-test clock-3.467 {ISO week-based calendar 2025-W02-1} {
- clock format 1736121600 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W02-1
-} {Mon Monday 25 2025 1 02 1}
-test clock-3.468 {ISO week-based calendar 2036-W52-1} {
- clock format 2113516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2036-W52-1
-} {Mon Monday 36 2036 1 52 1}
-test clock-3.469 {ISO week-based calendar 2036-W52-7} {
- clock format 2114035200 -format {%a %A %g %G %u %V %w} -gmt true; # 2036-W52-7
-} {Sun Sunday 36 2036 7 52 0}
-test clock-3.470 {ISO week-based calendar 2037-W01-1} {
- clock format 2114121600 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-1
-} {Mon Monday 37 2037 1 01 1}
-test clock-3.471 {ISO week-based calendar 2037-W01-4} {
- clock format 2114380800 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-4
-} {Thu Thursday 37 2037 4 01 4}
-test clock-3.472 {ISO week-based calendar 2037-W01-7} {
- clock format 2114640000 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-7
-} {Sun Sunday 37 2037 7 01 0}
-test clock-3.473 {ISO week-based calendar 2037-W02-1} {
- clock format 2114726400 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W02-1
-} {Mon Monday 37 2037 1 02 1}
-test clock-3.474 {ISO week-based calendar 2037-W53-1} {
- clock format 2145571200 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-1
-} {Mon Monday 37 2037 1 53 1}
-test clock-3.475 {ISO week-based calendar 2037-W53-5} {
- clock format 2145916800 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-5
-} {Fri Friday 37 2037 5 53 5}
-test clock-3.476 {ISO week-based calendar 2037-W53-7} {
- clock format 2146089600 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-7
-} {Sun Sunday 37 2037 7 53 0}
-test clock-3.477 {ISO week-based calendar 2038-W01-1} {
- clock format 2146176000 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W01-1
-} {Mon Monday 38 2038 1 01 1}
-test clock-3.478 {ISO week-based calendar 2038-W01-7} {
- clock format 2146694400 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W01-7
-} {Sun Sunday 38 2038 7 01 0}
-test clock-3.479 {ISO week-based calendar 2038-W02-1} {
- clock format 2146780800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W02-1
-} {Mon Monday 38 2038 1 02 1}
-test clock-3.480 {ISO week-based calendar 2038-W52-1} {
- clock format 2177020800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-1
-} {Mon Monday 38 2038 1 52 1}
-test clock-3.481 {ISO week-based calendar 2038-W52-6} {
- clock format 2177452800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-6
-} {Sat Saturday 38 2038 6 52 6}
-test clock-3.482 {ISO week-based calendar 2038-W52-7} {
- clock format 2177539200 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-7
-} {Sun Sunday 38 2038 7 52 0}
-test clock-3.483 {ISO week-based calendar 2039-W01-1} {
- clock format 2177625600 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W01-1
-} {Mon Monday 39 2039 1 01 1}
-test clock-3.484 {ISO week-based calendar 2039-W01-7} {
- clock format 2178144000 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W01-7
-} {Sun Sunday 39 2039 7 01 0}
-test clock-3.485 {ISO week-based calendar 2039-W02-1} {
- clock format 2178230400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W02-1
-} {Mon Monday 39 2039 1 02 1}
-test clock-3.486 {ISO week-based calendar 2039-W52-1} {
- clock format 2208470400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-1
-} {Mon Monday 39 2039 1 52 1}
-test clock-3.487 {ISO week-based calendar 2039-W52-6} {
- clock format 2208902400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-6
-} {Sat Saturday 39 2039 6 52 6}
-test clock-3.488 {ISO week-based calendar 2039-W52-7} {
- clock format 2208988800 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-7
-} {Sun Sunday 39 2039 7 52 0}
-test clock-3.489 {ISO week-based calendar 2040-W01-1} {
- clock format 2209075200 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W01-1
-} {Mon Monday 40 2040 1 01 1}
-test clock-3.490 {ISO week-based calendar 2040-W01-7} {
- clock format 2209593600 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W01-7
-} {Sun Sunday 40 2040 7 01 0}
-test clock-3.491 {ISO week-based calendar 2040-W02-1} {
- clock format 2209680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W02-1
-} {Mon Monday 40 2040 1 02 1}
-test clock-3.492 {ISO week-based calendar 2040-W52-1} {
- clock format 2239920000 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W52-1
-} {Mon Monday 40 2040 1 52 1}
-test clock-3.493 {ISO week-based calendar 2040-W52-7} {
- clock format 2240438400 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W52-7
-} {Sun Sunday 40 2040 7 52 0}
-test clock-3.494 {ISO week-based calendar 2041-W01-1} {
- clock format 2240524800 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-1
-} {Mon Monday 41 2041 1 01 1}
-test clock-3.495 {ISO week-based calendar 2041-W01-2} {
- clock format 2240611200 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-2
-} {Tue Tuesday 41 2041 2 01 2}
-test clock-3.496 {ISO week-based calendar 2041-W01-7} {
- clock format 2241043200 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-7
-} {Sun Sunday 41 2041 7 01 0}
-test clock-3.497 {ISO week-based calendar 2041-W02-1} {
- clock format 2241129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W02-1
-} {Mon Monday 41 2041 1 02 1}
-test clock-3.498 {ISO week-based calendar 2041-W52-1} {
- clock format 2271369600 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W52-1
-} {Mon Monday 41 2041 1 52 1}
-test clock-3.499 {ISO week-based calendar 2041-W52-7} {
- clock format 2271888000 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W52-7
-} {Sun Sunday 41 2041 7 52 0}
-test clock-3.500 {ISO week-based calendar 2042-W01-1} {
- clock format 2271974400 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-1
-} {Mon Monday 42 2042 1 01 1}
-test clock-3.501 {ISO week-based calendar 2042-W01-3} {
- clock format 2272147200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-3
-} {Wed Wednesday 42 2042 3 01 3}
-test clock-3.502 {ISO week-based calendar 2042-W01-7} {
- clock format 2272492800 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-7
-} {Sun Sunday 42 2042 7 01 0}
-test clock-3.503 {ISO week-based calendar 2042-W02-1} {
- clock format 2272579200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W02-1
-} {Mon Monday 42 2042 1 02 1}
-test clock-3.504 {ISO week-based calendar 2042-W52-1} {
- clock format 2302819200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W52-1
-} {Mon Monday 42 2042 1 52 1}
-test clock-3.505 {ISO week-based calendar 2042-W52-7} {
- clock format 2303337600 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W52-7
-} {Sun Sunday 42 2042 7 52 0}
-test clock-3.506 {ISO week-based calendar 2043-W01-1} {
- clock format 2303424000 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-1
-} {Mon Monday 43 2043 1 01 1}
-test clock-3.507 {ISO week-based calendar 2043-W01-4} {
- clock format 2303683200 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-4
-} {Thu Thursday 43 2043 4 01 4}
-test clock-3.508 {ISO week-based calendar 2043-W01-7} {
- clock format 2303942400 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-7
-} {Sun Sunday 43 2043 7 01 0}
-test clock-3.509 {ISO week-based calendar 2043-W02-1} {
- clock format 2304028800 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W02-1
-} {Mon Monday 43 2043 1 02 1}
-test clock-3.510 {ISO week-based calendar 2043-W53-1} {
- clock format 2334873600 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-1
-} {Mon Monday 43 2043 1 53 1}
-test clock-3.511 {ISO week-based calendar 2043-W53-5} {
- clock format 2335219200 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-5
-} {Fri Friday 43 2043 5 53 5}
-test clock-3.512 {ISO week-based calendar 2043-W53-7} {
- clock format 2335392000 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-7
-} {Sun Sunday 43 2043 7 53 0}
-test clock-3.513 {ISO week-based calendar 2044-W01-1} {
- clock format 2335478400 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W01-1
-} {Mon Monday 44 2044 1 01 1}
-test clock-3.514 {ISO week-based calendar 2044-W01-7} {
- clock format 2335996800 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W01-7
-} {Sun Sunday 44 2044 7 01 0}
-test clock-3.515 {ISO week-based calendar 2044-W02-1} {
- clock format 2336083200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W02-1
-} {Mon Monday 44 2044 1 02 1}
-test clock-3.516 {ISO week-based calendar 2044-W52-1} {
- clock format 2366323200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-1
-} {Mon Monday 44 2044 1 52 1}
-test clock-3.517 {ISO week-based calendar 2044-W52-6} {
- clock format 2366755200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-6
-} {Sat Saturday 44 2044 6 52 6}
-test clock-3.518 {ISO week-based calendar 2044-W52-7} {
- clock format 2366841600 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-7
-} {Sun Sunday 44 2044 7 52 0}
-test clock-3.519 {ISO week-based calendar 2045-W01-1} {
- clock format 2366928000 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W01-1
-} {Mon Monday 45 2045 1 01 1}
-test clock-3.520 {ISO week-based calendar 2045-W01-7} {
- clock format 2367446400 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W01-7
-} {Sun Sunday 45 2045 7 01 0}
-test clock-3.521 {ISO week-based calendar 2045-W02-1} {
- clock format 2367532800 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W02-1
-} {Mon Monday 45 2045 1 02 1}
-test clock-3.522 {ISO week-based calendar 2045-W52-1} {
- clock format 2397772800 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W52-1
-} {Mon Monday 45 2045 1 52 1}
-test clock-3.523 {ISO week-based calendar 2045-W52-7} {
- clock format 2398291200 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W52-7
-} {Sun Sunday 45 2045 7 52 0}
-test clock-3.524 {ISO week-based calendar 2046-W01-1} {
- clock format 2398377600 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W01-1
-} {Mon Monday 46 2046 1 01 1}
-test clock-3.525 {ISO week-based calendar 2046-W01-7} {
- clock format 2398896000 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W01-7
-} {Sun Sunday 46 2046 7 01 0}
-test clock-3.526 {ISO week-based calendar 2046-W02-1} {
- clock format 2398982400 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W02-1
-} {Mon Monday 46 2046 1 02 1}
-test clock-3.527 {ISO week-based calendar 2046-W52-1} {
- clock format 2429222400 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W52-1
-} {Mon Monday 46 2046 1 52 1}
-test clock-3.528 {ISO week-based calendar 2046-W52-7} {
- clock format 2429740800 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W52-7
-} {Sun Sunday 46 2046 7 52 0}
-test clock-3.529 {ISO week-based calendar 2047-W01-1} {
- clock format 2429827200 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-1
-} {Mon Monday 47 2047 1 01 1}
-test clock-3.530 {ISO week-based calendar 2047-W01-2} {
- clock format 2429913600 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-2
-} {Tue Tuesday 47 2047 2 01 2}
-test clock-3.531 {ISO week-based calendar 2047-W01-7} {
- clock format 2430345600 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-7
-} {Sun Sunday 47 2047 7 01 0}
-test clock-3.532 {ISO week-based calendar 2047-W02-1} {
- clock format 2430432000 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W02-1
-} {Mon Monday 47 2047 1 02 1}
-test clock-3.533 {ISO week-based calendar 2047-W52-1} {
- clock format 2460672000 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W52-1
-} {Mon Monday 47 2047 1 52 1}
-test clock-3.534 {ISO week-based calendar 2047-W52-7} {
- clock format 2461190400 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W52-7
-} {Sun Sunday 47 2047 7 52 0}
-test clock-3.535 {ISO week-based calendar 2048-W01-1} {
- clock format 2461276800 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-1
-} {Mon Monday 48 2048 1 01 1}
-test clock-3.536 {ISO week-based calendar 2048-W01-3} {
- clock format 2461449600 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-3
-} {Wed Wednesday 48 2048 3 01 3}
-test clock-3.537 {ISO week-based calendar 2048-W01-7} {
- clock format 2461795200 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-7
-} {Sun Sunday 48 2048 7 01 0}
-test clock-3.538 {ISO week-based calendar 2048-W02-1} {
- clock format 2461881600 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W02-1
-} {Mon Monday 48 2048 1 02 1}
-test clock-3.539 {ISO week-based calendar 2048-W53-1} {
- clock format 2492726400 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-1
-} {Mon Monday 48 2048 1 53 1}
-test clock-3.540 {ISO week-based calendar 2048-W53-5} {
- clock format 2493072000 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-5
-} {Fri Friday 48 2048 5 53 5}
-test clock-3.541 {ISO week-based calendar 2048-W53-7} {
- clock format 2493244800 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-7
-} {Sun Sunday 48 2048 7 53 0}
-test clock-3.542 {ISO week-based calendar 2049-W01-1} {
- clock format 2493331200 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W01-1
-} {Mon Monday 49 2049 1 01 1}
-test clock-3.543 {ISO week-based calendar 2049-W01-7} {
- clock format 2493849600 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W01-7
-} {Sun Sunday 49 2049 7 01 0}
-test clock-3.544 {ISO week-based calendar 2049-W02-1} {
- clock format 2493936000 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W02-1
-} {Mon Monday 49 2049 1 02 1}
-test clock-3.545 {ISO week-based calendar 2051-W52-1} {
- clock format 2587075200 -format {%a %A %g %G %u %V %w} -gmt true; # 2051-W52-1
-} {Mon Monday 51 2051 1 52 1}
-test clock-3.546 {ISO week-based calendar 2051-W52-7} {
- clock format 2587593600 -format {%a %A %g %G %u %V %w} -gmt true; # 2051-W52-7
-} {Sun Sunday 51 2051 7 52 0}
-test clock-3.547 {ISO week-based calendar 2052-W01-1} {
- clock format 2587680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W01-1
-} {Mon Monday 52 2052 1 01 1}
-test clock-3.548 {ISO week-based calendar 2052-W01-7} {
- clock format 2588198400 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W01-7
-} {Sun Sunday 52 2052 7 01 0}
-test clock-3.549 {ISO week-based calendar 2052-W02-1} {
- clock format 2588284800 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W02-1
-} {Mon Monday 52 2052 1 02 1}
-test clock-3.550 {ISO week-based calendar 2052-W52-1} {
- clock format 2618524800 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W52-1
-} {Mon Monday 52 2052 1 52 1}
-test clock-3.551 {ISO week-based calendar 2052-W52-7} {
- clock format 2619043200 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W52-7
-} {Sun Sunday 52 2052 7 52 0}
-test clock-3.552 {ISO week-based calendar 2053-W01-1} {
- clock format 2619129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-1
-} {Mon Monday 53 2053 1 01 1}
-test clock-3.553 {ISO week-based calendar 2053-W01-3} {
- clock format 2619302400 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-3
-} {Wed Wednesday 53 2053 3 01 3}
-test clock-3.554 {ISO week-based calendar 2053-W01-7} {
- clock format 2619648000 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-7
-} {Sun Sunday 53 2053 7 01 0}
-test clock-3.555 {ISO week-based calendar 2053-W02-1} {
- clock format 2619734400 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W02-1
-} {Mon Monday 53 2053 1 02 1}
-test clock-3.556 {ISO week-based calendar 2055-W52-1} {
- clock format 2713478400 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-1
-} {Mon Monday 55 2055 1 52 1}
-test clock-3.557 {ISO week-based calendar 2055-W52-6} {
- clock format 2713910400 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-6
-} {Sat Saturday 55 2055 6 52 6}
-test clock-3.558 {ISO week-based calendar 2055-W52-7} {
- clock format 2713996800 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-7
-} {Sun Sunday 55 2055 7 52 0}
-test clock-3.559 {ISO week-based calendar 2056-W01-1} {
- clock format 2714083200 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W01-1
-} {Mon Monday 56 2056 1 01 1}
-test clock-3.560 {ISO week-based calendar 2056-W01-7} {
- clock format 2714601600 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W01-7
-} {Sun Sunday 56 2056 7 01 0}
-test clock-3.561 {ISO week-based calendar 2056-W02-1} {
- clock format 2714688000 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W02-1
-} {Mon Monday 56 2056 1 02 1}
-test clock-3.562 {ISO week-based calendar 2056-W52-1} {
- clock format 2744928000 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W52-1
-} {Mon Monday 56 2056 1 52 1}
-test clock-3.563 {ISO week-based calendar 2056-W52-7} {
- clock format 2745446400 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W52-7
-} {Sun Sunday 56 2056 7 52 0}
-test clock-3.564 {ISO week-based calendar 2057-W01-1} {
- clock format 2745532800 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W01-1
-} {Mon Monday 57 2057 1 01 1}
-test clock-3.565 {ISO week-based calendar 2057-W01-7} {
- clock format 2746051200 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W01-7
-} {Sun Sunday 57 2057 7 01 0}
-test clock-3.566 {ISO week-based calendar 2057-W02-1} {
- clock format 2746137600 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W02-1
-} {Mon Monday 57 2057 1 02 1}
-test clock-3.567 {ISO week-based calendar 2059-W52-1} {
- clock format 2839276800 -format {%a %A %g %G %u %V %w} -gmt true; # 2059-W52-1
-} {Mon Monday 59 2059 1 52 1}
-test clock-3.568 {ISO week-based calendar 2059-W52-7} {
- clock format 2839795200 -format {%a %A %g %G %u %V %w} -gmt true; # 2059-W52-7
-} {Sun Sunday 59 2059 7 52 0}
-test clock-3.569 {ISO week-based calendar 2060-W01-1} {
- clock format 2839881600 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-1
-} {Mon Monday 60 2060 1 01 1}
-test clock-3.570 {ISO week-based calendar 2060-W01-4} {
- clock format 2840140800 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-4
-} {Thu Thursday 60 2060 4 01 4}
-test clock-3.571 {ISO week-based calendar 2060-W01-7} {
- clock format 2840400000 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-7
-} {Sun Sunday 60 2060 7 01 0}
-test clock-3.572 {ISO week-based calendar 2060-W02-1} {
- clock format 2840486400 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W02-1
-} {Mon Monday 60 2060 1 02 1}
-test clock-3.573 {ISO week-based calendar 2060-W53-1} {
- clock format 2871331200 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-1
-} {Mon Monday 60 2060 1 53 1}
-test clock-3.574 {ISO week-based calendar 2060-W53-6} {
- clock format 2871763200 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-6
-} {Sat Saturday 60 2060 6 53 6}
-test clock-3.575 {ISO week-based calendar 2060-W53-7} {
- clock format 2871849600 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-7
-} {Sun Sunday 60 2060 7 53 0}
-test clock-3.576 {ISO week-based calendar 2061-W01-1} {
- clock format 2871936000 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W01-1
-} {Mon Monday 61 2061 1 01 1}
-test clock-3.577 {ISO week-based calendar 2061-W01-7} {
- clock format 2872454400 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W01-7
-} {Sun Sunday 61 2061 7 01 0}
-test clock-3.578 {ISO week-based calendar 2061-W02-1} {
- clock format 2872540800 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W02-1
-} {Mon Monday 61 2061 1 02 1}
-test clock-3.579 {ISO week-based calendar 2063-W52-1} {
- clock format 2965680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2063-W52-1
-} {Mon Monday 63 2063 1 52 1}
-test clock-3.580 {ISO week-based calendar 2063-W52-7} {
- clock format 2966198400 -format {%a %A %g %G %u %V %w} -gmt true; # 2063-W52-7
-} {Sun Sunday 63 2063 7 52 0}
-test clock-3.581 {ISO week-based calendar 2064-W01-1} {
- clock format 2966284800 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-1
-} {Mon Monday 64 2064 1 01 1}
-test clock-3.582 {ISO week-based calendar 2064-W01-2} {
- clock format 2966371200 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-2
-} {Tue Tuesday 64 2064 2 01 2}
-test clock-3.583 {ISO week-based calendar 2064-W01-7} {
- clock format 2966803200 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-7
-} {Sun Sunday 64 2064 7 01 0}
-test clock-3.584 {ISO week-based calendar 2064-W02-1} {
- clock format 2966889600 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W02-1
-} {Mon Monday 64 2064 1 02 1}
-test clock-3.585 {ISO week-based calendar 2064-W52-1} {
- clock format 2997129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W52-1
-} {Mon Monday 64 2064 1 52 1}
-test clock-3.586 {ISO week-based calendar 2064-W52-7} {
- clock format 2997648000 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W52-7
-} {Sun Sunday 64 2064 7 52 0}
-test clock-3.587 {ISO week-based calendar 2065-W01-1} {
- clock format 2997734400 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-1
-} {Mon Monday 65 2065 1 01 1}
-test clock-3.588 {ISO week-based calendar 2065-W01-4} {
- clock format 2997993600 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-4
-} {Thu Thursday 65 2065 4 01 4}
-test clock-3.589 {ISO week-based calendar 2065-W01-7} {
- clock format 2998252800 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-7
-} {Sun Sunday 65 2065 7 01 0}
-test clock-3.590 {ISO week-based calendar 2065-W02-1} {
- clock format 2998339200 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W02-1
-} {Mon Monday 65 2065 1 02 1}
+ clock format -3093206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-1
+} {Mon Monday 71 1871 1 52 52 1 52}
+test clock-3.2 {ISO week-based calendar 1871-W52-6} {
+ clock format -3092774400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-6
+} {Sat Saturday 71 1871 6 52 52 6 52}
+test clock-3.3 {ISO week-based calendar 1871-W52-7} {
+ clock format -3092688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-7
+} {Sun Sunday 71 1871 7 53 52 0 52}
+test clock-3.4 {ISO week-based calendar 1872-W01-1} {
+ clock format -3092601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-1
+} {Mon Monday 72 1872 1 00 01 1 01}
+test clock-3.5 {ISO week-based calendar 1872-W01-6} {
+ clock format -3092169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-6
+} {Sat Saturday 72 1872 6 00 01 6 01}
+test clock-3.6 {ISO week-based calendar 1872-W01-7} {
+ clock format -3092083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-7
+} {Sun Sunday 72 1872 7 01 01 0 01}
+test clock-3.7 {ISO week-based calendar 1872-W02-1} {
+ clock format -3091996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W02-1
+} {Mon Monday 72 1872 1 01 02 1 02}
+test clock-3.8 {ISO week-based calendar 1872-W52-1} {
+ clock format -3061756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-1
+} {Mon Monday 72 1872 1 51 52 1 52}
+test clock-3.9 {ISO week-based calendar 1872-W52-6} {
+ clock format -3061324800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-6
+} {Sat Saturday 72 1872 6 51 52 6 52}
+test clock-3.10 {ISO week-based calendar 1872-W52-7} {
+ clock format -3061238400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-7
+} {Sun Sunday 72 1872 7 52 52 0 52}
+test clock-3.11 {ISO week-based calendar 1873-W01-1} {
+ clock format -3061152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-1
+} {Mon Monday 73 1873 1 52 01 1 53}
+test clock-3.12 {ISO week-based calendar 1873-W01-3} {
+ clock format -3060979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-3
+} {Wed Wednesday 73 1873 3 00 01 3 00}
+test clock-3.13 {ISO week-based calendar 1873-W01-6} {
+ clock format -3060720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-6
+} {Sat Saturday 73 1873 6 00 01 6 00}
+test clock-3.14 {ISO week-based calendar 1873-W01-7} {
+ clock format -3060633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-7
+} {Sun Sunday 73 1873 7 01 01 0 00}
+test clock-3.15 {ISO week-based calendar 1873-W02-1} {
+ clock format -3060547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W02-1
+} {Mon Monday 73 1873 1 01 02 1 01}
+test clock-3.16 {ISO week-based calendar 1875-W52-1} {
+ clock format -2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-1
+} {Mon Monday 75 1875 1 52 52 1 52}
+test clock-3.17 {ISO week-based calendar 1875-W52-6} {
+ clock format -2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-6
+} {Sat Saturday 75 1875 6 00 52 6 00}
+test clock-3.18 {ISO week-based calendar 1875-W52-7} {
+ clock format -2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-7
+} {Sun Sunday 75 1875 7 01 52 0 00}
+test clock-3.19 {ISO week-based calendar 1876-W01-1} {
+ clock format -2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-1
+} {Mon Monday 76 1876 1 01 01 1 01}
+test clock-3.20 {ISO week-based calendar 1876-W01-6} {
+ clock format -2965766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-6
+} {Sat Saturday 76 1876 6 01 01 6 01}
+test clock-3.21 {ISO week-based calendar 1876-W01-7} {
+ clock format -2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-7
+} {Sun Sunday 76 1876 7 02 01 0 01}
+test clock-3.22 {ISO week-based calendar 1876-W02-1} {
+ clock format -2965593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W02-1
+} {Mon Monday 76 1876 1 02 02 1 02}
+test clock-3.23 {ISO week-based calendar 1876-W52-1} {
+ clock format -2935353600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-1
+} {Mon Monday 76 1876 1 52 52 1 52}
+test clock-3.24 {ISO week-based calendar 1876-W52-6} {
+ clock format -2934921600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-6
+} {Sat Saturday 76 1876 6 52 52 6 52}
+test clock-3.25 {ISO week-based calendar 1876-W52-7} {
+ clock format -2934835200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-7
+} {Sun Sunday 76 1876 7 53 52 0 52}
+test clock-3.26 {ISO week-based calendar 1877-W01-1} {
+ clock format -2934748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-1
+} {Mon Monday 77 1877 1 00 01 1 01}
+test clock-3.27 {ISO week-based calendar 1877-W01-6} {
+ clock format -2934316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-6
+} {Sat Saturday 77 1877 6 00 01 6 01}
+test clock-3.28 {ISO week-based calendar 1877-W01-7} {
+ clock format -2934230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-7
+} {Sun Sunday 77 1877 7 01 01 0 01}
+test clock-3.29 {ISO week-based calendar 1877-W02-1} {
+ clock format -2934144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W02-1
+} {Mon Monday 77 1877 1 01 02 1 02}
+test clock-3.30 {ISO week-based calendar 1879-W52-1} {
+ clock format -2841004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-1
+} {Mon Monday 79 1879 1 51 52 1 51}
+test clock-3.31 {ISO week-based calendar 1879-W52-6} {
+ clock format -2840572800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-6
+} {Sat Saturday 79 1879 6 51 52 6 51}
+test clock-3.32 {ISO week-based calendar 1879-W52-7} {
+ clock format -2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-7
+} {Sun Sunday 79 1879 7 52 52 0 51}
+test clock-3.33 {ISO week-based calendar 1880-W01-1} {
+ clock format -2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-1
+} {Mon Monday 80 1880 1 52 01 1 52}
+test clock-3.34 {ISO week-based calendar 1880-W01-4} {
+ clock format -2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-4
+} {Thu Thursday 80 1880 4 00 01 4 00}
+test clock-3.35 {ISO week-based calendar 1880-W01-6} {
+ clock format -2839968000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-6
+} {Sat Saturday 80 1880 6 00 01 6 00}
+test clock-3.36 {ISO week-based calendar 1880-W01-7} {
+ clock format -2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-7
+} {Sun Sunday 80 1880 7 01 01 0 00}
+test clock-3.37 {ISO week-based calendar 1880-W02-1} {
+ clock format -2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W02-1
+} {Mon Monday 80 1880 1 01 02 1 01}
+test clock-3.38 {ISO week-based calendar 1880-W53-1} {
+ clock format -2808950400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-1
+} {Mon Monday 80 1880 1 52 53 1 52}
+test clock-3.39 {ISO week-based calendar 1880-W53-6} {
+ clock format -2808518400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-6
+} {Sat Saturday 80 1880 6 00 53 6 00}
+test clock-3.40 {ISO week-based calendar 1880-W53-7} {
+ clock format -2808432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-7
+} {Sun Sunday 80 1880 7 01 53 0 00}
+test clock-3.41 {ISO week-based calendar 1881-W01-1} {
+ clock format -2808345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-1
+} {Mon Monday 81 1881 1 01 01 1 01}
+test clock-3.42 {ISO week-based calendar 1881-W01-6} {
+ clock format -2807913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-6
+} {Sat Saturday 81 1881 6 01 01 6 01}
+test clock-3.43 {ISO week-based calendar 1881-W01-7} {
+ clock format -2807827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-7
+} {Sun Sunday 81 1881 7 02 01 0 01}
+test clock-3.44 {ISO week-based calendar 1881-W02-1} {
+ clock format -2807740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W02-1
+} {Mon Monday 81 1881 1 02 02 1 02}
+test clock-3.45 {ISO week-based calendar 1883-W52-1} {
+ clock format -2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-1
+} {Mon Monday 83 1883 1 51 52 1 52}
+test clock-3.46 {ISO week-based calendar 1883-W52-6} {
+ clock format -2714169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-6
+} {Sat Saturday 83 1883 6 51 52 6 52}
+test clock-3.47 {ISO week-based calendar 1883-W52-7} {
+ clock format -2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-7
+} {Sun Sunday 83 1883 7 52 52 0 52}
+test clock-3.48 {ISO week-based calendar 1884-W01-1} {
+ clock format -2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-1
+} {Mon Monday 84 1884 1 52 01 1 53}
+test clock-3.49 {ISO week-based calendar 1884-W01-2} {
+ clock format -2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-2
+} {Tue Tuesday 84 1884 2 00 01 2 00}
+test clock-3.50 {ISO week-based calendar 1884-W01-6} {
+ clock format -2713564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-6
+} {Sat Saturday 84 1884 6 00 01 6 00}
+test clock-3.51 {ISO week-based calendar 1884-W01-7} {
+ clock format -2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-7
+} {Sun Sunday 84 1884 7 01 01 0 00}
+test clock-3.52 {ISO week-based calendar 1884-W02-1} {
+ clock format -2713392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W02-1
+} {Mon Monday 84 1884 1 01 02 1 01}
+test clock-3.53 {ISO week-based calendar 1884-W52-1} {
+ clock format -2683152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-1
+} {Mon Monday 84 1884 1 51 52 1 51}
+test clock-3.54 {ISO week-based calendar 1884-W52-6} {
+ clock format -2682720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-6
+} {Sat Saturday 84 1884 6 51 52 6 51}
+test clock-3.55 {ISO week-based calendar 1884-W52-7} {
+ clock format -2682633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-7
+} {Sun Sunday 84 1884 7 52 52 0 51}
+test clock-3.56 {ISO week-based calendar 1885-W01-1} {
+ clock format -2682547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-1
+} {Mon Monday 85 1885 1 52 01 1 52}
+test clock-3.57 {ISO week-based calendar 1885-W01-4} {
+ clock format -2682288000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-4
+} {Thu Thursday 85 1885 4 00 01 4 00}
+test clock-3.58 {ISO week-based calendar 1885-W01-6} {
+ clock format -2682115200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-6
+} {Sat Saturday 85 1885 6 00 01 6 00}
+test clock-3.59 {ISO week-based calendar 1885-W01-7} {
+ clock format -2682028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-7
+} {Sun Sunday 85 1885 7 01 01 0 00}
+test clock-3.60 {ISO week-based calendar 1885-W02-1} {
+ clock format -2681942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W02-1
+} {Mon Monday 85 1885 1 01 02 1 01}
+test clock-3.61 {ISO week-based calendar 1887-W52-1} {
+ clock format -2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-1
+} {Mon Monday 87 1887 1 52 52 1 52}
+test clock-3.62 {ISO week-based calendar 1887-W52-6} {
+ clock format -2587766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-6
+} {Sat Saturday 87 1887 6 52 52 6 52}
+test clock-3.63 {ISO week-based calendar 1887-W52-7} {
+ clock format -2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-7
+} {Sun Sunday 87 1887 7 01 52 0 00}
+test clock-3.64 {ISO week-based calendar 1888-W01-1} {
+ clock format -2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-1
+} {Mon Monday 88 1888 1 01 01 1 01}
+test clock-3.65 {ISO week-based calendar 1888-W01-6} {
+ clock format -2587161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-6
+} {Sat Saturday 88 1888 6 01 01 6 01}
+test clock-3.66 {ISO week-based calendar 1888-W01-7} {
+ clock format -2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-7
+} {Sun Sunday 88 1888 7 02 01 0 01}
+test clock-3.67 {ISO week-based calendar 1888-W02-1} {
+ clock format -2586988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W02-1
+} {Mon Monday 88 1888 1 02 02 1 02}
+test clock-3.68 {ISO week-based calendar 1888-W52-1} {
+ clock format -2556748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-1
+} {Mon Monday 88 1888 1 52 52 1 52}
+test clock-3.69 {ISO week-based calendar 1888-W52-6} {
+ clock format -2556316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-6
+} {Sat Saturday 88 1888 6 52 52 6 52}
+test clock-3.70 {ISO week-based calendar 1888-W52-7} {
+ clock format -2556230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-7
+} {Sun Sunday 88 1888 7 53 52 0 52}
+test clock-3.71 {ISO week-based calendar 1889-W01-1} {
+ clock format -2556144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-1
+} {Mon Monday 89 1889 1 53 01 1 53}
+test clock-3.72 {ISO week-based calendar 1889-W01-2} {
+ clock format -2556057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-2
+} {Tue Tuesday 89 1889 2 00 01 2 00}
+test clock-3.73 {ISO week-based calendar 1889-W01-6} {
+ clock format -2555712000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-6
+} {Sat Saturday 89 1889 6 00 01 6 00}
+test clock-3.74 {ISO week-based calendar 1889-W01-7} {
+ clock format -2555625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-7
+} {Sun Sunday 89 1889 7 01 01 0 00}
+test clock-3.75 {ISO week-based calendar 1889-W02-1} {
+ clock format -2555539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W02-1
+} {Mon Monday 89 1889 1 01 02 1 01}
+test clock-3.76 {ISO week-based calendar 1889-W52-1} {
+ clock format -2525299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-1
+} {Mon Monday 89 1889 1 51 52 1 51}
+test clock-3.77 {ISO week-based calendar 1889-W52-6} {
+ clock format -2524867200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-6
+} {Sat Saturday 89 1889 6 51 52 6 51}
+test clock-3.78 {ISO week-based calendar 1889-W52-7} {
+ clock format -2524780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-7
+} {Sun Sunday 89 1889 7 52 52 0 51}
+test clock-3.79 {ISO week-based calendar 1890-W01-1} {
+ clock format -2524694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-1
+} {Mon Monday 90 1890 1 52 01 1 52}
+test clock-3.80 {ISO week-based calendar 1890-W01-3} {
+ clock format -2524521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-3
+} {Wed Wednesday 90 1890 3 00 01 3 00}
+test clock-3.81 {ISO week-based calendar 1890-W01-6} {
+ clock format -2524262400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-6
+} {Sat Saturday 90 1890 6 00 01 6 00}
+test clock-3.82 {ISO week-based calendar 1890-W01-7} {
+ clock format -2524176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-7
+} {Sun Sunday 90 1890 7 01 01 0 00}
+test clock-3.83 {ISO week-based calendar 1890-W02-1} {
+ clock format -2524089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W02-1
+} {Mon Monday 90 1890 1 01 02 1 01}
+test clock-3.84 {ISO week-based calendar 1890-W52-1} {
+ clock format -2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-1
+} {Mon Monday 90 1890 1 51 52 1 51}
+test clock-3.85 {ISO week-based calendar 1890-W52-6} {
+ clock format -2493417600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-6
+} {Sat Saturday 90 1890 6 51 52 6 51}
+test clock-3.86 {ISO week-based calendar 1890-W52-7} {
+ clock format -2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-7
+} {Sun Sunday 90 1890 7 52 52 0 51}
+test clock-3.87 {ISO week-based calendar 1891-W01-1} {
+ clock format -2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-1
+} {Mon Monday 91 1891 1 52 01 1 52}
+test clock-3.88 {ISO week-based calendar 1891-W01-4} {
+ clock format -2492985600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-4
+} {Thu Thursday 91 1891 4 00 01 4 00}
+test clock-3.89 {ISO week-based calendar 1891-W01-6} {
+ clock format -2492812800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-6
+} {Sat Saturday 91 1891 6 00 01 6 00}
+test clock-3.90 {ISO week-based calendar 1891-W01-7} {
+ clock format -2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-7
+} {Sun Sunday 91 1891 7 01 01 0 00}
+test clock-3.91 {ISO week-based calendar 1891-W02-1} {
+ clock format -2492640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W02-1
+} {Mon Monday 91 1891 1 01 02 1 01}
+test clock-3.92 {ISO week-based calendar 1891-W53-1} {
+ clock format -2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-1
+} {Mon Monday 91 1891 1 52 53 1 52}
+test clock-3.93 {ISO week-based calendar 1891-W53-5} {
+ clock format -2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-5
+} {Fri Friday 91 1891 5 00 53 5 00}
+test clock-3.94 {ISO week-based calendar 1891-W53-6} {
+ clock format -2461363200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-6
+} {Sat Saturday 91 1891 6 00 53 6 00}
+test clock-3.95 {ISO week-based calendar 1891-W53-7} {
+ clock format -2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-7
+} {Sun Sunday 91 1891 7 01 53 0 00}
+test clock-3.96 {ISO week-based calendar 1892-W01-1} {
+ clock format -2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-1
+} {Mon Monday 92 1892 1 01 01 1 01}
+test clock-3.97 {ISO week-based calendar 1892-W01-6} {
+ clock format -2460758400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-6
+} {Sat Saturday 92 1892 6 01 01 6 01}
+test clock-3.98 {ISO week-based calendar 1892-W01-7} {
+ clock format -2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-7
+} {Sun Sunday 92 1892 7 02 01 0 01}
+test clock-3.99 {ISO week-based calendar 1892-W02-1} {
+ clock format -2460585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W02-1
+} {Mon Monday 92 1892 1 02 02 1 02}
+test clock-3.100 {ISO week-based calendar 1892-W52-1} {
+ clock format -2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-1
+} {Mon Monday 92 1892 1 52 52 1 52}
+test clock-3.101 {ISO week-based calendar 1892-W52-6} {
+ clock format -2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-6
+} {Sat Saturday 92 1892 6 52 52 6 52}
+test clock-3.102 {ISO week-based calendar 1892-W52-7} {
+ clock format -2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-7
+} {Sun Sunday 92 1892 7 01 52 0 00}
+test clock-3.103 {ISO week-based calendar 1893-W01-1} {
+ clock format -2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-1
+} {Mon Monday 93 1893 1 01 01 1 01}
+test clock-3.104 {ISO week-based calendar 1893-W01-6} {
+ clock format -2429308800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-6
+} {Sat Saturday 93 1893 6 01 01 6 01}
+test clock-3.105 {ISO week-based calendar 1893-W01-7} {
+ clock format -2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-7
+} {Sun Sunday 93 1893 7 02 01 0 01}
+test clock-3.106 {ISO week-based calendar 1893-W02-1} {
+ clock format -2429136000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W02-1
+} {Mon Monday 93 1893 1 02 02 1 02}
+test clock-3.107 {ISO week-based calendar 1893-W52-1} {
+ clock format -2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-1
+} {Mon Monday 93 1893 1 52 52 1 52}
+test clock-3.108 {ISO week-based calendar 1893-W52-6} {
+ clock format -2398464000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-6
+} {Sat Saturday 93 1893 6 52 52 6 52}
+test clock-3.109 {ISO week-based calendar 1893-W52-7} {
+ clock format -2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-7
+} {Sun Sunday 93 1893 7 53 52 0 52}
+test clock-3.110 {ISO week-based calendar 1894-W01-1} {
+ clock format -2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-1
+} {Mon Monday 94 1894 1 00 01 1 01}
+test clock-3.111 {ISO week-based calendar 1894-W01-6} {
+ clock format -2397859200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-6
+} {Sat Saturday 94 1894 6 00 01 6 01}
+test clock-3.112 {ISO week-based calendar 1894-W01-7} {
+ clock format -2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-7
+} {Sun Sunday 94 1894 7 01 01 0 01}
+test clock-3.113 {ISO week-based calendar 1894-W02-1} {
+ clock format -2397686400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W02-1
+} {Mon Monday 94 1894 1 01 02 1 02}
+test clock-3.114 {ISO week-based calendar 1894-W52-1} {
+ clock format -2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-1
+} {Mon Monday 94 1894 1 51 52 1 52}
+test clock-3.115 {ISO week-based calendar 1894-W52-6} {
+ clock format -2367014400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-6
+} {Sat Saturday 94 1894 6 51 52 6 52}
+test clock-3.116 {ISO week-based calendar 1894-W52-7} {
+ clock format -2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-7
+} {Sun Sunday 94 1894 7 52 52 0 52}
+test clock-3.117 {ISO week-based calendar 1895-W01-1} {
+ clock format -2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-1
+} {Mon Monday 95 1895 1 52 01 1 53}
+test clock-3.118 {ISO week-based calendar 1895-W01-2} {
+ clock format -2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-2
+} {Tue Tuesday 95 1895 2 00 01 2 00}
+test clock-3.119 {ISO week-based calendar 1895-W01-6} {
+ clock format -2366409600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-6
+} {Sat Saturday 95 1895 6 00 01 6 00}
+test clock-3.120 {ISO week-based calendar 1895-W01-7} {
+ clock format -2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-7
+} {Sun Sunday 95 1895 7 01 01 0 00}
+test clock-3.121 {ISO week-based calendar 1895-W02-1} {
+ clock format -2366236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W02-1
+} {Mon Monday 95 1895 1 01 02 1 01}
+test clock-3.122 {ISO week-based calendar 1895-W52-1} {
+ clock format -2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-1
+} {Mon Monday 95 1895 1 51 52 1 51}
+test clock-3.123 {ISO week-based calendar 1895-W52-6} {
+ clock format -2335564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-6
+} {Sat Saturday 95 1895 6 51 52 6 51}
+test clock-3.124 {ISO week-based calendar 1895-W52-7} {
+ clock format -2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-7
+} {Sun Sunday 95 1895 7 52 52 0 51}
+test clock-3.125 {ISO week-based calendar 1896-W01-1} {
+ clock format -2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-1
+} {Mon Monday 96 1896 1 52 01 1 52}
+test clock-3.126 {ISO week-based calendar 1896-W01-3} {
+ clock format -2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-3
+} {Wed Wednesday 96 1896 3 00 01 3 00}
+test clock-3.127 {ISO week-based calendar 1896-W01-6} {
+ clock format -2334960000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-6
+} {Sat Saturday 96 1896 6 00 01 6 00}
+test clock-3.128 {ISO week-based calendar 1896-W01-7} {
+ clock format -2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-7
+} {Sun Sunday 96 1896 7 01 01 0 00}
+test clock-3.129 {ISO week-based calendar 1896-W02-1} {
+ clock format -2334787200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W02-1
+} {Mon Monday 96 1896 1 01 02 1 01}
+test clock-3.130 {ISO week-based calendar 1896-W53-1} {
+ clock format -2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-1
+} {Mon Monday 96 1896 1 52 53 1 52}
+test clock-3.131 {ISO week-based calendar 1896-W53-5} {
+ clock format -2303596800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-5
+} {Fri Friday 96 1896 5 00 53 5 00}
+test clock-3.132 {ISO week-based calendar 1896-W53-6} {
+ clock format -2303510400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-6
+} {Sat Saturday 96 1896 6 00 53 6 00}
+test clock-3.133 {ISO week-based calendar 1896-W53-7} {
+ clock format -2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-7
+} {Sun Sunday 96 1896 7 01 53 0 00}
+test clock-3.134 {ISO week-based calendar 1897-W01-1} {
+ clock format -2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-1
+} {Mon Monday 97 1897 1 01 01 1 01}
+test clock-3.135 {ISO week-based calendar 1897-W01-6} {
+ clock format -2302905600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-6
+} {Sat Saturday 97 1897 6 01 01 6 01}
+test clock-3.136 {ISO week-based calendar 1897-W01-7} {
+ clock format -2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-7
+} {Sun Sunday 97 1897 7 02 01 0 01}
+test clock-3.137 {ISO week-based calendar 1897-W02-1} {
+ clock format -2302732800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W02-1
+} {Mon Monday 97 1897 1 02 02 1 02}
+test clock-3.138 {ISO week-based calendar 1897-W52-1} {
+ clock format -2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-1
+} {Mon Monday 97 1897 1 52 52 1 52}
+test clock-3.139 {ISO week-based calendar 1897-W52-6} {
+ clock format -2272060800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-6
+} {Sat Saturday 97 1897 6 00 52 6 00}
+test clock-3.140 {ISO week-based calendar 1897-W52-7} {
+ clock format -2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-7
+} {Sun Sunday 97 1897 7 01 52 0 00}
+test clock-3.141 {ISO week-based calendar 1898-W01-1} {
+ clock format -2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-1
+} {Mon Monday 98 1898 1 01 01 1 01}
+test clock-3.142 {ISO week-based calendar 1898-W01-6} {
+ clock format -2271456000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-6
+} {Sat Saturday 98 1898 6 01 01 6 01}
+test clock-3.143 {ISO week-based calendar 1898-W01-7} {
+ clock format -2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-7
+} {Sun Sunday 98 1898 7 02 01 0 01}
+test clock-3.144 {ISO week-based calendar 1898-W02-1} {
+ clock format -2271283200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W02-1
+} {Mon Monday 98 1898 1 02 02 1 02}
+test clock-3.145 {ISO week-based calendar 1898-W52-1} {
+ clock format -2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-1
+} {Mon Monday 98 1898 1 52 52 1 52}
+test clock-3.146 {ISO week-based calendar 1898-W52-6} {
+ clock format -2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-6
+} {Sat Saturday 98 1898 6 52 52 6 52}
+test clock-3.147 {ISO week-based calendar 1898-W52-7} {
+ clock format -2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-7
+} {Sun Sunday 98 1898 7 01 52 0 00}
+test clock-3.148 {ISO week-based calendar 1899-W01-1} {
+ clock format -2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-1
+} {Mon Monday 99 1899 1 01 01 1 01}
+test clock-3.149 {ISO week-based calendar 1899-W01-6} {
+ clock format -2240006400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-6
+} {Sat Saturday 99 1899 6 01 01 6 01}
+test clock-3.150 {ISO week-based calendar 1899-W01-7} {
+ clock format -2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-7
+} {Sun Sunday 99 1899 7 02 01 0 01}
+test clock-3.151 {ISO week-based calendar 1899-W02-1} {
+ clock format -2239833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W02-1
+} {Mon Monday 99 1899 1 02 02 1 02}
+test clock-3.152 {ISO week-based calendar 1899-W52-1} {
+ clock format -2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-1
+} {Mon Monday 99 1899 1 52 52 1 52}
+test clock-3.153 {ISO week-based calendar 1899-W52-6} {
+ clock format -2209161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-6
+} {Sat Saturday 99 1899 6 52 52 6 52}
+test clock-3.154 {ISO week-based calendar 1899-W52-7} {
+ clock format -2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-7
+} {Sun Sunday 99 1899 7 53 52 0 52}
+test clock-3.155 {ISO week-based calendar 1900-W01-1} {
+ clock format -2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-1
+} {Mon Monday 00 1900 1 00 01 1 01}
+test clock-3.156 {ISO week-based calendar 1900-W01-6} {
+ clock format -2208556800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-6
+} {Sat Saturday 00 1900 6 00 01 6 01}
+test clock-3.157 {ISO week-based calendar 1900-W01-7} {
+ clock format -2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-7
+} {Sun Sunday 00 1900 7 01 01 0 01}
+test clock-3.158 {ISO week-based calendar 1900-W02-1} {
+ clock format -2208384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W02-1
+} {Mon Monday 00 1900 1 01 02 1 02}
+test clock-3.159 {ISO week-based calendar 1943-W52-1} {
+ clock format -820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-1
+} {Mon Monday 43 1943 1 52 52 1 52}
+test clock-3.160 {ISO week-based calendar 1943-W52-6} {
+ clock format -820540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-6
+} {Sat Saturday 43 1943 6 00 52 6 00}
+test clock-3.161 {ISO week-based calendar 1943-W52-7} {
+ clock format -820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-7
+} {Sun Sunday 43 1943 7 01 52 0 00}
+test clock-3.162 {ISO week-based calendar 1944-W01-1} {
+ clock format -820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-1
+} {Mon Monday 44 1944 1 01 01 1 01}
+test clock-3.163 {ISO week-based calendar 1944-W01-6} {
+ clock format -819936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-6
+} {Sat Saturday 44 1944 6 01 01 6 01}
+test clock-3.164 {ISO week-based calendar 1944-W01-7} {
+ clock format -819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-7
+} {Sun Sunday 44 1944 7 02 01 0 01}
+test clock-3.165 {ISO week-based calendar 1944-W02-1} {
+ clock format -819763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W02-1
+} {Mon Monday 44 1944 1 02 02 1 02}
+test clock-3.166 {ISO week-based calendar 1944-W52-1} {
+ clock format -789523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-1
+} {Mon Monday 44 1944 1 52 52 1 52}
+test clock-3.167 {ISO week-based calendar 1944-W52-6} {
+ clock format -789091200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-6
+} {Sat Saturday 44 1944 6 52 52 6 52}
+test clock-3.168 {ISO week-based calendar 1944-W52-7} {
+ clock format -789004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-7
+} {Sun Sunday 44 1944 7 53 52 0 52}
+test clock-3.169 {ISO week-based calendar 1945-W01-1} {
+ clock format -788918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-1
+} {Mon Monday 45 1945 1 00 01 1 01}
+test clock-3.170 {ISO week-based calendar 1945-W01-6} {
+ clock format -788486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-6
+} {Sat Saturday 45 1945 6 00 01 6 01}
+test clock-3.171 {ISO week-based calendar 1945-W01-7} {
+ clock format -788400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-7
+} {Sun Sunday 45 1945 7 01 01 0 01}
+test clock-3.172 {ISO week-based calendar 1945-W02-1} {
+ clock format -788313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W02-1
+} {Mon Monday 45 1945 1 01 02 1 02}
+test clock-3.173 {ISO week-based calendar 1947-W52-1} {
+ clock format -695174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-1
+} {Mon Monday 47 1947 1 51 52 1 51}
+test clock-3.174 {ISO week-based calendar 1947-W52-6} {
+ clock format -694742400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-6
+} {Sat Saturday 47 1947 6 51 52 6 51}
+test clock-3.175 {ISO week-based calendar 1947-W52-7} {
+ clock format -694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-7
+} {Sun Sunday 47 1947 7 52 52 0 51}
+test clock-3.176 {ISO week-based calendar 1948-W01-1} {
+ clock format -694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-1
+} {Mon Monday 48 1948 1 52 01 1 52}
+test clock-3.177 {ISO week-based calendar 1948-W01-4} {
+ clock format -694310400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-4
+} {Thu Thursday 48 1948 4 00 01 4 00}
+test clock-3.178 {ISO week-based calendar 1948-W01-6} {
+ clock format -694137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-6
+} {Sat Saturday 48 1948 6 00 01 6 00}
+test clock-3.179 {ISO week-based calendar 1948-W01-7} {
+ clock format -694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-7
+} {Sun Sunday 48 1948 7 01 01 0 00}
+test clock-3.180 {ISO week-based calendar 1948-W02-1} {
+ clock format -693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W02-1
+} {Mon Monday 48 1948 1 01 02 1 01}
+test clock-3.181 {ISO week-based calendar 1948-W53-1} {
+ clock format -663120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-1
+} {Mon Monday 48 1948 1 52 53 1 52}
+test clock-3.182 {ISO week-based calendar 1948-W53-6} {
+ clock format -662688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-6
+} {Sat Saturday 48 1948 6 00 53 6 00}
+test clock-3.183 {ISO week-based calendar 1948-W53-7} {
+ clock format -662601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-7
+} {Sun Sunday 48 1948 7 01 53 0 00}
+test clock-3.184 {ISO week-based calendar 1949-W01-1} {
+ clock format -662515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-1
+} {Mon Monday 49 1949 1 01 01 1 01}
+test clock-3.185 {ISO week-based calendar 1949-W01-6} {
+ clock format -662083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-6
+} {Sat Saturday 49 1949 6 01 01 6 01}
+test clock-3.186 {ISO week-based calendar 1949-W01-7} {
+ clock format -661996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-7
+} {Sun Sunday 49 1949 7 02 01 0 01}
+test clock-3.187 {ISO week-based calendar 1949-W02-1} {
+ clock format -661910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W02-1
+} {Mon Monday 49 1949 1 02 02 1 02}
+test clock-3.188 {ISO week-based calendar 1951-W52-1} {
+ clock format -568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-1
+} {Mon Monday 51 1951 1 51 52 1 52}
+test clock-3.189 {ISO week-based calendar 1951-W52-6} {
+ clock format -568339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-6
+} {Sat Saturday 51 1951 6 51 52 6 52}
+test clock-3.190 {ISO week-based calendar 1951-W52-7} {
+ clock format -568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-7
+} {Sun Sunday 51 1951 7 52 52 0 52}
+test clock-3.191 {ISO week-based calendar 1952-W01-1} {
+ clock format -568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-1
+} {Mon Monday 52 1952 1 52 01 1 53}
+test clock-3.192 {ISO week-based calendar 1952-W01-2} {
+ clock format -568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-2
+} {Tue Tuesday 52 1952 2 00 01 2 00}
+test clock-3.193 {ISO week-based calendar 1952-W01-6} {
+ clock format -567734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-6
+} {Sat Saturday 52 1952 6 00 01 6 00}
+test clock-3.194 {ISO week-based calendar 1952-W01-7} {
+ clock format -567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-7
+} {Sun Sunday 52 1952 7 01 01 0 00}
+test clock-3.195 {ISO week-based calendar 1952-W02-1} {
+ clock format -567561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W02-1
+} {Mon Monday 52 1952 1 01 02 1 01}
+test clock-3.196 {ISO week-based calendar 1952-W52-1} {
+ clock format -537321600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-1
+} {Mon Monday 52 1952 1 51 52 1 51}
+test clock-3.197 {ISO week-based calendar 1952-W52-6} {
+ clock format -536889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-6
+} {Sat Saturday 52 1952 6 51 52 6 51}
+test clock-3.198 {ISO week-based calendar 1952-W52-7} {
+ clock format -536803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-7
+} {Sun Sunday 52 1952 7 52 52 0 51}
+test clock-3.199 {ISO week-based calendar 1953-W01-1} {
+ clock format -536716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-1
+} {Mon Monday 53 1953 1 52 01 1 52}
+test clock-3.200 {ISO week-based calendar 1953-W01-4} {
+ clock format -536457600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-4
+} {Thu Thursday 53 1953 4 00 01 4 00}
+test clock-3.201 {ISO week-based calendar 1953-W01-6} {
+ clock format -536284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-6
+} {Sat Saturday 53 1953 6 00 01 6 00}
+test clock-3.202 {ISO week-based calendar 1953-W01-7} {
+ clock format -536198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-7
+} {Sun Sunday 53 1953 7 01 01 0 00}
+test clock-3.203 {ISO week-based calendar 1953-W02-1} {
+ clock format -536112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W02-1
+} {Mon Monday 53 1953 1 01 02 1 01}
+test clock-3.204 {ISO week-based calendar 1955-W52-1} {
+ clock format -442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-1
+} {Mon Monday 55 1955 1 52 52 1 52}
+test clock-3.205 {ISO week-based calendar 1955-W52-6} {
+ clock format -441936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-6
+} {Sat Saturday 55 1955 6 52 52 6 52}
+test clock-3.206 {ISO week-based calendar 1955-W52-7} {
+ clock format -441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-7
+} {Sun Sunday 55 1955 7 01 52 0 00}
+test clock-3.207 {ISO week-based calendar 1956-W01-1} {
+ clock format -441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-1
+} {Mon Monday 56 1956 1 01 01 1 01}
+test clock-3.208 {ISO week-based calendar 1956-W01-6} {
+ clock format -441331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-6
+} {Sat Saturday 56 1956 6 01 01 6 01}
+test clock-3.209 {ISO week-based calendar 1956-W01-7} {
+ clock format -441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-7
+} {Sun Sunday 56 1956 7 02 01 0 01}
+test clock-3.210 {ISO week-based calendar 1956-W02-1} {
+ clock format -441158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W02-1
+} {Mon Monday 56 1956 1 02 02 1 02}
+test clock-3.211 {ISO week-based calendar 1956-W52-1} {
+ clock format -410918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-1
+} {Mon Monday 56 1956 1 52 52 1 52}
+test clock-3.212 {ISO week-based calendar 1956-W52-6} {
+ clock format -410486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-6
+} {Sat Saturday 56 1956 6 52 52 6 52}
+test clock-3.213 {ISO week-based calendar 1956-W52-7} {
+ clock format -410400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-7
+} {Sun Sunday 56 1956 7 53 52 0 52}
+test clock-3.214 {ISO week-based calendar 1957-W01-1} {
+ clock format -410313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-1
+} {Mon Monday 57 1957 1 53 01 1 53}
+test clock-3.215 {ISO week-based calendar 1957-W01-2} {
+ clock format -410227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-2
+} {Tue Tuesday 57 1957 2 00 01 2 00}
+test clock-3.216 {ISO week-based calendar 1957-W01-6} {
+ clock format -409881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-6
+} {Sat Saturday 57 1957 6 00 01 6 00}
+test clock-3.217 {ISO week-based calendar 1957-W01-7} {
+ clock format -409795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-7
+} {Sun Sunday 57 1957 7 01 01 0 00}
+test clock-3.218 {ISO week-based calendar 1957-W02-1} {
+ clock format -409708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W02-1
+} {Mon Monday 57 1957 1 01 02 1 01}
+test clock-3.219 {ISO week-based calendar 1958-W52-1} {
+ clock format -348019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-1
+} {Mon Monday 58 1958 1 51 52 1 51}
+test clock-3.220 {ISO week-based calendar 1958-W52-6} {
+ clock format -347587200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-6
+} {Sat Saturday 58 1958 6 51 52 6 51}
+test clock-3.221 {ISO week-based calendar 1958-W52-7} {
+ clock format -347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-7
+} {Sun Sunday 58 1958 7 52 52 0 51}
+test clock-3.222 {ISO week-based calendar 1959-W01-1} {
+ clock format -347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-1
+} {Mon Monday 59 1959 1 52 01 1 52}
+test clock-3.223 {ISO week-based calendar 1959-W01-4} {
+ clock format -347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-4
+} {Thu Thursday 59 1959 4 00 01 4 00}
+test clock-3.224 {ISO week-based calendar 1959-W01-6} {
+ clock format -346982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-6
+} {Sat Saturday 59 1959 6 00 01 6 00}
+test clock-3.225 {ISO week-based calendar 1959-W01-7} {
+ clock format -346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-7
+} {Sun Sunday 59 1959 7 01 01 0 00}
+test clock-3.226 {ISO week-based calendar 1959-W02-1} {
+ clock format -346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W02-1
+} {Mon Monday 59 1959 1 01 02 1 01}
+test clock-3.227 {ISO week-based calendar 1959-W53-1} {
+ clock format -315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-1
+} {Mon Monday 59 1959 1 52 53 1 52}
+test clock-3.228 {ISO week-based calendar 1959-W53-5} {
+ clock format -315619200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-5
+} {Fri Friday 59 1959 5 00 53 5 00}
+test clock-3.229 {ISO week-based calendar 1959-W53-6} {
+ clock format -315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-6
+} {Sat Saturday 59 1959 6 00 53 6 00}
+test clock-3.230 {ISO week-based calendar 1959-W53-7} {
+ clock format -315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-7
+} {Sun Sunday 59 1959 7 01 53 0 00}
+test clock-3.231 {ISO week-based calendar 1960-W01-1} {
+ clock format -315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-1
+} {Mon Monday 60 1960 1 01 01 1 01}
+test clock-3.232 {ISO week-based calendar 1960-W01-6} {
+ clock format -314928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-6
+} {Sat Saturday 60 1960 6 01 01 6 01}
+test clock-3.233 {ISO week-based calendar 1960-W01-7} {
+ clock format -314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-7
+} {Sun Sunday 60 1960 7 02 01 0 01}
+test clock-3.234 {ISO week-based calendar 1960-W02-1} {
+ clock format -314755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W02-1
+} {Mon Monday 60 1960 1 02 02 1 02}
+test clock-3.235 {ISO week-based calendar 1960-W52-1} {
+ clock format -284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-1
+} {Mon Monday 60 1960 1 52 52 1 52}
+test clock-3.236 {ISO week-based calendar 1960-W52-6} {
+ clock format -284083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-6
+} {Sat Saturday 60 1960 6 52 52 6 52}
+test clock-3.237 {ISO week-based calendar 1960-W52-7} {
+ clock format -283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-7
+} {Sun Sunday 60 1960 7 01 52 0 00}
+test clock-3.238 {ISO week-based calendar 1961-W01-1} {
+ clock format -283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-1
+} {Mon Monday 61 1961 1 01 01 1 01}
+test clock-3.239 {ISO week-based calendar 1961-W01-6} {
+ clock format -283478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-6
+} {Sat Saturday 61 1961 6 01 01 6 01}
+test clock-3.240 {ISO week-based calendar 1961-W01-7} {
+ clock format -283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-7
+} {Sun Sunday 61 1961 7 02 01 0 01}
+test clock-3.241 {ISO week-based calendar 1961-W02-1} {
+ clock format -283305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W02-1
+} {Mon Monday 61 1961 1 02 02 1 02}
+test clock-3.242 {ISO week-based calendar 1961-W52-1} {
+ clock format -253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-1
+} {Mon Monday 61 1961 1 52 52 1 52}
+test clock-3.243 {ISO week-based calendar 1961-W52-6} {
+ clock format -252633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-6
+} {Sat Saturday 61 1961 6 52 52 6 52}
+test clock-3.244 {ISO week-based calendar 1961-W52-7} {
+ clock format -252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-7
+} {Sun Sunday 61 1961 7 53 52 0 52}
+test clock-3.245 {ISO week-based calendar 1962-W01-1} {
+ clock format -252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-1
+} {Mon Monday 62 1962 1 00 01 1 01}
+test clock-3.246 {ISO week-based calendar 1962-W01-6} {
+ clock format -252028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-6
+} {Sat Saturday 62 1962 6 00 01 6 01}
+test clock-3.247 {ISO week-based calendar 1962-W01-7} {
+ clock format -251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-7
+} {Sun Sunday 62 1962 7 01 01 0 01}
+test clock-3.248 {ISO week-based calendar 1962-W02-1} {
+ clock format -251856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W02-1
+} {Mon Monday 62 1962 1 01 02 1 02}
+test clock-3.249 {ISO week-based calendar 1962-W52-1} {
+ clock format -221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-1
+} {Mon Monday 62 1962 1 51 52 1 52}
+test clock-3.250 {ISO week-based calendar 1962-W52-6} {
+ clock format -221184000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-6
+} {Sat Saturday 62 1962 6 51 52 6 52}
+test clock-3.251 {ISO week-based calendar 1962-W52-7} {
+ clock format -221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-7
+} {Sun Sunday 62 1962 7 52 52 0 52}
+test clock-3.252 {ISO week-based calendar 1963-W01-1} {
+ clock format -221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-1
+} {Mon Monday 63 1963 1 52 01 1 53}
+test clock-3.253 {ISO week-based calendar 1963-W01-2} {
+ clock format -220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-2
+} {Tue Tuesday 63 1963 2 00 01 2 00}
+test clock-3.254 {ISO week-based calendar 1963-W01-6} {
+ clock format -220579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-6
+} {Sat Saturday 63 1963 6 00 01 6 00}
+test clock-3.255 {ISO week-based calendar 1963-W01-7} {
+ clock format -220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-7
+} {Sun Sunday 63 1963 7 01 01 0 00}
+test clock-3.256 {ISO week-based calendar 1963-W02-1} {
+ clock format -220406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W02-1
+} {Mon Monday 63 1963 1 01 02 1 01}
+test clock-3.257 {ISO week-based calendar 1963-W52-1} {
+ clock format -190166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-1
+} {Mon Monday 63 1963 1 51 52 1 51}
+test clock-3.258 {ISO week-based calendar 1963-W52-6} {
+ clock format -189734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-6
+} {Sat Saturday 63 1963 6 51 52 6 51}
+test clock-3.259 {ISO week-based calendar 1963-W52-7} {
+ clock format -189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-7
+} {Sun Sunday 63 1963 7 52 52 0 51}
+test clock-3.260 {ISO week-based calendar 1964-W01-1} {
+ clock format -189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-1
+} {Mon Monday 64 1964 1 52 01 1 52}
+test clock-3.261 {ISO week-based calendar 1964-W01-3} {
+ clock format -189388800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-3
+} {Wed Wednesday 64 1964 3 00 01 3 00}
+test clock-3.262 {ISO week-based calendar 1964-W01-6} {
+ clock format -189129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-6
+} {Sat Saturday 64 1964 6 00 01 6 00}
+test clock-3.263 {ISO week-based calendar 1964-W01-7} {
+ clock format -189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-7
+} {Sun Sunday 64 1964 7 01 01 0 00}
+test clock-3.264 {ISO week-based calendar 1964-W02-1} {
+ clock format -188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W02-1
+} {Mon Monday 64 1964 1 01 02 1 01}
+test clock-3.265 {ISO week-based calendar 1964-W53-1} {
+ clock format -158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-1
+} {Mon Monday 64 1964 1 52 53 1 52}
+test clock-3.266 {ISO week-based calendar 1964-W53-5} {
+ clock format -157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-5
+} {Fri Friday 64 1964 5 00 53 5 00}
+test clock-3.267 {ISO week-based calendar 1964-W53-6} {
+ clock format -157680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-6
+} {Sat Saturday 64 1964 6 00 53 6 00}
+test clock-3.268 {ISO week-based calendar 1964-W53-7} {
+ clock format -157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-7
+} {Sun Sunday 64 1964 7 01 53 0 00}
+test clock-3.269 {ISO week-based calendar 1965-W01-1} {
+ clock format -157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-1
+} {Mon Monday 65 1965 1 01 01 1 01}
+test clock-3.270 {ISO week-based calendar 1965-W01-6} {
+ clock format -157075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-6
+} {Sat Saturday 65 1965 6 01 01 6 01}
+test clock-3.271 {ISO week-based calendar 1965-W01-7} {
+ clock format -156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-7
+} {Sun Sunday 65 1965 7 02 01 0 01}
+test clock-3.272 {ISO week-based calendar 1965-W02-1} {
+ clock format -156902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W02-1
+} {Mon Monday 65 1965 1 02 02 1 02}
+test clock-3.273 {ISO week-based calendar 1965-W52-1} {
+ clock format -126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-1
+} {Mon Monday 65 1965 1 52 52 1 52}
+test clock-3.274 {ISO week-based calendar 1965-W52-6} {
+ clock format -126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-6
+} {Sat Saturday 65 1965 6 00 52 6 00}
+test clock-3.275 {ISO week-based calendar 1965-W52-7} {
+ clock format -126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-7
+} {Sun Sunday 65 1965 7 01 52 0 00}
+test clock-3.276 {ISO week-based calendar 1966-W01-1} {
+ clock format -126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-1
+} {Mon Monday 66 1966 1 01 01 1 01}
+test clock-3.277 {ISO week-based calendar 1966-W01-6} {
+ clock format -125625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-6
+} {Sat Saturday 66 1966 6 01 01 6 01}
+test clock-3.278 {ISO week-based calendar 1966-W01-7} {
+ clock format -125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-7
+} {Sun Sunday 66 1966 7 02 01 0 01}
+test clock-3.279 {ISO week-based calendar 1966-W02-1} {
+ clock format -125452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W02-1
+} {Mon Monday 66 1966 1 02 02 1 02}
+test clock-3.280 {ISO week-based calendar 1966-W52-1} {
+ clock format -95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-1
+} {Mon Monday 66 1966 1 52 52 1 52}
+test clock-3.281 {ISO week-based calendar 1966-W52-6} {
+ clock format -94780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-6
+} {Sat Saturday 66 1966 6 52 52 6 52}
+test clock-3.282 {ISO week-based calendar 1966-W52-7} {
+ clock format -94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-7
+} {Sun Sunday 66 1966 7 01 52 0 00}
+test clock-3.283 {ISO week-based calendar 1967-W01-1} {
+ clock format -94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-1
+} {Mon Monday 67 1967 1 01 01 1 01}
+test clock-3.284 {ISO week-based calendar 1967-W01-6} {
+ clock format -94176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-6
+} {Sat Saturday 67 1967 6 01 01 6 01}
+test clock-3.285 {ISO week-based calendar 1967-W01-7} {
+ clock format -94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-7
+} {Sun Sunday 67 1967 7 02 01 0 01}
+test clock-3.286 {ISO week-based calendar 1967-W02-1} {
+ clock format -94003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W02-1
+} {Mon Monday 67 1967 1 02 02 1 02}
+test clock-3.287 {ISO week-based calendar 1967-W52-1} {
+ clock format -63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-1
+} {Mon Monday 67 1967 1 52 52 1 52}
+test clock-3.288 {ISO week-based calendar 1967-W52-6} {
+ clock format -63331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-6
+} {Sat Saturday 67 1967 6 52 52 6 52}
+test clock-3.289 {ISO week-based calendar 1967-W52-7} {
+ clock format -63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-7
+} {Sun Sunday 67 1967 7 53 52 0 52}
+test clock-3.290 {ISO week-based calendar 1968-W01-1} {
+ clock format -63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-1
+} {Mon Monday 68 1968 1 00 01 1 01}
+test clock-3.291 {ISO week-based calendar 1968-W01-6} {
+ clock format -62726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-6
+} {Sat Saturday 68 1968 6 00 01 6 01}
+test clock-3.292 {ISO week-based calendar 1968-W01-7} {
+ clock format -62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-7
+} {Sun Sunday 68 1968 7 01 01 0 01}
+test clock-3.293 {ISO week-based calendar 1968-W02-1} {
+ clock format -62553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W02-1
+} {Mon Monday 68 1968 1 01 02 1 02}
+test clock-3.294 {ISO week-based calendar 1968-W52-1} {
+ clock format -32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-1
+} {Mon Monday 68 1968 1 51 52 1 52}
+test clock-3.295 {ISO week-based calendar 1968-W52-6} {
+ clock format -31881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-6
+} {Sat Saturday 68 1968 6 51 52 6 52}
+test clock-3.296 {ISO week-based calendar 1968-W52-7} {
+ clock format -31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-7
+} {Sun Sunday 68 1968 7 52 52 0 52}
+test clock-3.297 {ISO week-based calendar 1969-W01-1} {
+ clock format -31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-1
+} {Mon Monday 69 1969 1 52 01 1 53}
+test clock-3.298 {ISO week-based calendar 1969-W01-3} {
+ clock format -31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-3
+} {Wed Wednesday 69 1969 3 00 01 3 00}
+test clock-3.299 {ISO week-based calendar 1969-W01-6} {
+ clock format -31276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-6
+} {Sat Saturday 69 1969 6 00 01 6 00}
+test clock-3.300 {ISO week-based calendar 1969-W01-7} {
+ clock format -31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-7
+} {Sun Sunday 69 1969 7 01 01 0 00}
+test clock-3.301 {ISO week-based calendar 1969-W02-1} {
+ clock format -31104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W02-1
+} {Mon Monday 69 1969 1 01 02 1 01}
+test clock-3.302 {ISO week-based calendar 1969-W52-1} {
+ clock format -864000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-1
+} {Mon Monday 69 1969 1 51 52 1 51}
+test clock-3.303 {ISO week-based calendar 1969-W52-6} {
+ clock format -432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-6
+} {Sat Saturday 69 1969 6 51 52 6 51}
+test clock-3.304 {ISO week-based calendar 1969-W52-7} {
+ clock format -345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-7
+} {Sun Sunday 69 1969 7 52 52 0 51}
+test clock-3.305 {ISO week-based calendar 1970-W01-1} {
+ clock format -259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-1
+} {Mon Monday 70 1970 1 52 01 1 52}
+test clock-3.306 {ISO week-based calendar 1970-W01-4} {
+ clock format 0 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-4
+} {Thu Thursday 70 1970 4 00 01 4 00}
+test clock-3.307 {ISO week-based calendar 1970-W01-6} {
+ clock format 172800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-6
+} {Sat Saturday 70 1970 6 00 01 6 00}
+test clock-3.308 {ISO week-based calendar 1970-W01-7} {
+ clock format 259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-7
+} {Sun Sunday 70 1970 7 01 01 0 00}
+test clock-3.309 {ISO week-based calendar 1970-W02-1} {
+ clock format 345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W02-1
+} {Mon Monday 70 1970 1 01 02 1 01}
+test clock-3.310 {ISO week-based calendar 1970-W53-1} {
+ clock format 31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-1
+} {Mon Monday 70 1970 1 52 53 1 52}
+test clock-3.311 {ISO week-based calendar 1970-W53-5} {
+ clock format 31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-5
+} {Fri Friday 70 1970 5 00 53 5 00}
+test clock-3.312 {ISO week-based calendar 1970-W53-6} {
+ clock format 31622400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-6
+} {Sat Saturday 70 1970 6 00 53 6 00}
+test clock-3.313 {ISO week-based calendar 1970-W53-7} {
+ clock format 31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-7
+} {Sun Sunday 70 1970 7 01 53 0 00}
+test clock-3.314 {ISO week-based calendar 1971-W01-1} {
+ clock format 31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-1
+} {Mon Monday 71 1971 1 01 01 1 01}
+test clock-3.315 {ISO week-based calendar 1971-W01-6} {
+ clock format 32227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-6
+} {Sat Saturday 71 1971 6 01 01 6 01}
+test clock-3.316 {ISO week-based calendar 1971-W01-7} {
+ clock format 32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-7
+} {Sun Sunday 71 1971 7 02 01 0 01}
+test clock-3.317 {ISO week-based calendar 1971-W02-1} {
+ clock format 32400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W02-1
+} {Mon Monday 71 1971 1 02 02 1 02}
+test clock-3.318 {ISO week-based calendar 1971-W52-1} {
+ clock format 62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-1
+} {Mon Monday 71 1971 1 52 52 1 52}
+test clock-3.319 {ISO week-based calendar 1971-W52-6} {
+ clock format 63072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-6
+} {Sat Saturday 71 1971 6 00 52 6 00}
+test clock-3.320 {ISO week-based calendar 1971-W52-7} {
+ clock format 63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-7
+} {Sun Sunday 71 1971 7 01 52 0 00}
+test clock-3.321 {ISO week-based calendar 1972-W01-1} {
+ clock format 63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-1
+} {Mon Monday 72 1972 1 01 01 1 01}
+test clock-3.322 {ISO week-based calendar 1972-W01-6} {
+ clock format 63676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-6
+} {Sat Saturday 72 1972 6 01 01 6 01}
+test clock-3.323 {ISO week-based calendar 1972-W01-7} {
+ clock format 63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-7
+} {Sun Sunday 72 1972 7 02 01 0 01}
+test clock-3.324 {ISO week-based calendar 1972-W02-1} {
+ clock format 63849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W02-1
+} {Mon Monday 72 1972 1 02 02 1 02}
+test clock-3.325 {ISO week-based calendar 1972-W52-1} {
+ clock format 94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-1
+} {Mon Monday 72 1972 1 52 52 1 52}
+test clock-3.326 {ISO week-based calendar 1972-W52-6} {
+ clock format 94521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-6
+} {Sat Saturday 72 1972 6 52 52 6 52}
+test clock-3.327 {ISO week-based calendar 1972-W52-7} {
+ clock format 94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-7
+} {Sun Sunday 72 1972 7 53 52 0 52}
+test clock-3.328 {ISO week-based calendar 1973-W01-1} {
+ clock format 94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-1
+} {Mon Monday 73 1973 1 00 01 1 01}
+test clock-3.329 {ISO week-based calendar 1973-W01-6} {
+ clock format 95126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-6
+} {Sat Saturday 73 1973 6 00 01 6 01}
+test clock-3.330 {ISO week-based calendar 1973-W01-7} {
+ clock format 95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-7
+} {Sun Sunday 73 1973 7 01 01 0 01}
+test clock-3.331 {ISO week-based calendar 1973-W02-1} {
+ clock format 95299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W02-1
+} {Mon Monday 73 1973 1 01 02 1 02}
+test clock-3.332 {ISO week-based calendar 1973-W52-1} {
+ clock format 125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-1
+} {Mon Monday 73 1973 1 51 52 1 52}
+test clock-3.333 {ISO week-based calendar 1973-W52-6} {
+ clock format 125971200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-6
+} {Sat Saturday 73 1973 6 51 52 6 52}
+test clock-3.334 {ISO week-based calendar 1973-W52-7} {
+ clock format 126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-7
+} {Sun Sunday 73 1973 7 52 52 0 52}
+test clock-3.335 {ISO week-based calendar 1974-W01-1} {
+ clock format 126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-1
+} {Mon Monday 74 1974 1 52 01 1 53}
+test clock-3.336 {ISO week-based calendar 1974-W01-2} {
+ clock format 126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-2
+} {Tue Tuesday 74 1974 2 00 01 2 00}
+test clock-3.337 {ISO week-based calendar 1974-W01-6} {
+ clock format 126576000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-6
+} {Sat Saturday 74 1974 6 00 01 6 00}
+test clock-3.338 {ISO week-based calendar 1974-W01-7} {
+ clock format 126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-7
+} {Sun Sunday 74 1974 7 01 01 0 00}
+test clock-3.339 {ISO week-based calendar 1974-W02-1} {
+ clock format 126748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W02-1
+} {Mon Monday 74 1974 1 01 02 1 01}
+test clock-3.340 {ISO week-based calendar 1974-W52-1} {
+ clock format 156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-1
+} {Mon Monday 74 1974 1 51 52 1 51}
+test clock-3.341 {ISO week-based calendar 1974-W52-6} {
+ clock format 157420800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-6
+} {Sat Saturday 74 1974 6 51 52 6 51}
+test clock-3.342 {ISO week-based calendar 1974-W52-7} {
+ clock format 157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-7
+} {Sun Sunday 74 1974 7 52 52 0 51}
+test clock-3.343 {ISO week-based calendar 1975-W01-1} {
+ clock format 157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-1
+} {Mon Monday 75 1975 1 52 01 1 52}
+test clock-3.344 {ISO week-based calendar 1975-W01-3} {
+ clock format 157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-3
+} {Wed Wednesday 75 1975 3 00 01 3 00}
+test clock-3.345 {ISO week-based calendar 1975-W01-6} {
+ clock format 158025600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-6
+} {Sat Saturday 75 1975 6 00 01 6 00}
+test clock-3.346 {ISO week-based calendar 1975-W01-7} {
+ clock format 158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-7
+} {Sun Sunday 75 1975 7 01 01 0 00}
+test clock-3.347 {ISO week-based calendar 1975-W02-1} {
+ clock format 158198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W02-1
+} {Mon Monday 75 1975 1 01 02 1 01}
+test clock-3.348 {ISO week-based calendar 1975-W52-1} {
+ clock format 188438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-1
+} {Mon Monday 75 1975 1 51 52 1 51}
+test clock-3.349 {ISO week-based calendar 1975-W52-6} {
+ clock format 188870400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-6
+} {Sat Saturday 75 1975 6 51 52 6 51}
+test clock-3.350 {ISO week-based calendar 1975-W52-7} {
+ clock format 188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-7
+} {Sun Sunday 75 1975 7 52 52 0 51}
+test clock-3.351 {ISO week-based calendar 1976-W01-1} {
+ clock format 189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-1
+} {Mon Monday 76 1976 1 52 01 1 52}
+test clock-3.352 {ISO week-based calendar 1976-W01-4} {
+ clock format 189302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-4
+} {Thu Thursday 76 1976 4 00 01 4 00}
+test clock-3.353 {ISO week-based calendar 1976-W01-6} {
+ clock format 189475200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-6
+} {Sat Saturday 76 1976 6 00 01 6 00}
+test clock-3.354 {ISO week-based calendar 1976-W01-7} {
+ clock format 189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-7
+} {Sun Sunday 76 1976 7 01 01 0 00}
+test clock-3.355 {ISO week-based calendar 1976-W02-1} {
+ clock format 189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W02-1
+} {Mon Monday 76 1976 1 01 02 1 01}
+test clock-3.356 {ISO week-based calendar 1976-W53-1} {
+ clock format 220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-1
+} {Mon Monday 76 1976 1 52 53 1 52}
+test clock-3.357 {ISO week-based calendar 1976-W53-6} {
+ clock format 220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-6
+} {Sat Saturday 76 1976 6 00 53 6 00}
+test clock-3.358 {ISO week-based calendar 1976-W53-7} {
+ clock format 221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-7
+} {Sun Sunday 76 1976 7 01 53 0 00}
+test clock-3.359 {ISO week-based calendar 1977-W01-1} {
+ clock format 221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-1
+} {Mon Monday 77 1977 1 01 01 1 01}
+test clock-3.360 {ISO week-based calendar 1977-W01-6} {
+ clock format 221529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-6
+} {Sat Saturday 77 1977 6 01 01 6 01}
+test clock-3.361 {ISO week-based calendar 1977-W01-7} {
+ clock format 221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-7
+} {Sun Sunday 77 1977 7 02 01 0 01}
+test clock-3.362 {ISO week-based calendar 1977-W02-1} {
+ clock format 221702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W02-1
+} {Mon Monday 77 1977 1 02 02 1 02}
+test clock-3.363 {ISO week-based calendar 1977-W52-1} {
+ clock format 251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-1
+} {Mon Monday 77 1977 1 52 52 1 52}
+test clock-3.364 {ISO week-based calendar 1977-W52-6} {
+ clock format 252374400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-6
+} {Sat Saturday 77 1977 6 52 52 6 52}
+test clock-3.365 {ISO week-based calendar 1977-W52-7} {
+ clock format 252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-7
+} {Sun Sunday 77 1977 7 01 52 0 00}
+test clock-3.366 {ISO week-based calendar 1978-W01-1} {
+ clock format 252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-1
+} {Mon Monday 78 1978 1 01 01 1 01}
+test clock-3.367 {ISO week-based calendar 1978-W01-6} {
+ clock format 252979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-6
+} {Sat Saturday 78 1978 6 01 01 6 01}
+test clock-3.368 {ISO week-based calendar 1978-W01-7} {
+ clock format 253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-7
+} {Sun Sunday 78 1978 7 02 01 0 01}
+test clock-3.369 {ISO week-based calendar 1978-W02-1} {
+ clock format 253152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W02-1
+} {Mon Monday 78 1978 1 02 02 1 02}
+test clock-3.370 {ISO week-based calendar 1978-W52-1} {
+ clock format 283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-1
+} {Mon Monday 78 1978 1 52 52 1 52}
+test clock-3.371 {ISO week-based calendar 1978-W52-6} {
+ clock format 283824000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-6
+} {Sat Saturday 78 1978 6 52 52 6 52}
+test clock-3.372 {ISO week-based calendar 1978-W52-7} {
+ clock format 283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-7
+} {Sun Sunday 78 1978 7 53 52 0 52}
+test clock-3.373 {ISO week-based calendar 1979-W01-1} {
+ clock format 283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-1
+} {Mon Monday 79 1979 1 00 01 1 01}
+test clock-3.374 {ISO week-based calendar 1979-W01-6} {
+ clock format 284428800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-6
+} {Sat Saturday 79 1979 6 00 01 6 01}
+test clock-3.375 {ISO week-based calendar 1979-W01-7} {
+ clock format 284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-7
+} {Sun Sunday 79 1979 7 01 01 0 01}
+test clock-3.376 {ISO week-based calendar 1979-W02-1} {
+ clock format 284601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W02-1
+} {Mon Monday 79 1979 1 01 02 1 02}
+test clock-3.377 {ISO week-based calendar 1979-W52-1} {
+ clock format 314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-1
+} {Mon Monday 79 1979 1 51 52 1 52}
+test clock-3.378 {ISO week-based calendar 1979-W52-6} {
+ clock format 315273600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-6
+} {Sat Saturday 79 1979 6 51 52 6 52}
+test clock-3.379 {ISO week-based calendar 1979-W52-7} {
+ clock format 315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-7
+} {Sun Sunday 79 1979 7 52 52 0 52}
+test clock-3.380 {ISO week-based calendar 1980-W01-1} {
+ clock format 315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-1
+} {Mon Monday 80 1980 1 52 01 1 53}
+test clock-3.381 {ISO week-based calendar 1980-W01-2} {
+ clock format 315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-2
+} {Tue Tuesday 80 1980 2 00 01 2 00}
+test clock-3.382 {ISO week-based calendar 1980-W01-6} {
+ clock format 315878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-6
+} {Sat Saturday 80 1980 6 00 01 6 00}
+test clock-3.383 {ISO week-based calendar 1980-W01-7} {
+ clock format 315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-7
+} {Sun Sunday 80 1980 7 01 01 0 00}
+test clock-3.384 {ISO week-based calendar 1980-W02-1} {
+ clock format 316051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W02-1
+} {Mon Monday 80 1980 1 01 02 1 01}
+test clock-3.385 {ISO week-based calendar 1980-W52-1} {
+ clock format 346291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-1
+} {Mon Monday 80 1980 1 51 52 1 51}
+test clock-3.386 {ISO week-based calendar 1980-W52-6} {
+ clock format 346723200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-6
+} {Sat Saturday 80 1980 6 51 52 6 51}
+test clock-3.387 {ISO week-based calendar 1980-W52-7} {
+ clock format 346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-7
+} {Sun Sunday 80 1980 7 52 52 0 51}
+test clock-3.388 {ISO week-based calendar 1981-W01-1} {
+ clock format 346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-1
+} {Mon Monday 81 1981 1 52 01 1 52}
+test clock-3.389 {ISO week-based calendar 1981-W01-4} {
+ clock format 347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-4
+} {Thu Thursday 81 1981 4 00 01 4 00}
+test clock-3.390 {ISO week-based calendar 1981-W01-6} {
+ clock format 347328000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-6
+} {Sat Saturday 81 1981 6 00 01 6 00}
+test clock-3.391 {ISO week-based calendar 1981-W01-7} {
+ clock format 347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-7
+} {Sun Sunday 81 1981 7 01 01 0 00}
+test clock-3.392 {ISO week-based calendar 1981-W02-1} {
+ clock format 347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W02-1
+} {Mon Monday 81 1981 1 01 02 1 01}
+test clock-3.393 {ISO week-based calendar 1983-W52-1} {
+ clock format 441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-1
+} {Mon Monday 83 1983 1 52 52 1 52}
+test clock-3.394 {ISO week-based calendar 1983-W52-6} {
+ clock format 441676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-6
+} {Sat Saturday 83 1983 6 52 52 6 52}
+test clock-3.395 {ISO week-based calendar 1983-W52-7} {
+ clock format 441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-7
+} {Sun Sunday 83 1983 7 01 52 0 00}
+test clock-3.396 {ISO week-based calendar 1984-W01-1} {
+ clock format 441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-1
+} {Mon Monday 84 1984 1 01 01 1 01}
+test clock-3.397 {ISO week-based calendar 1984-W01-6} {
+ clock format 442281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-6
+} {Sat Saturday 84 1984 6 01 01 6 01}
+test clock-3.398 {ISO week-based calendar 1984-W01-7} {
+ clock format 442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-7
+} {Sun Sunday 84 1984 7 02 01 0 01}
+test clock-3.399 {ISO week-based calendar 1984-W02-1} {
+ clock format 442454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W02-1
+} {Mon Monday 84 1984 1 02 02 1 02}
+test clock-3.400 {ISO week-based calendar 1984-W52-1} {
+ clock format 472694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-1
+} {Mon Monday 84 1984 1 52 52 1 52}
+test clock-3.401 {ISO week-based calendar 1984-W52-6} {
+ clock format 473126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-6
+} {Sat Saturday 84 1984 6 52 52 6 52}
+test clock-3.402 {ISO week-based calendar 1984-W52-7} {
+ clock format 473212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-7
+} {Sun Sunday 84 1984 7 53 52 0 52}
+test clock-3.403 {ISO week-based calendar 1985-W01-1} {
+ clock format 473299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-1
+} {Mon Monday 85 1985 1 53 01 1 53}
+test clock-3.404 {ISO week-based calendar 1985-W01-2} {
+ clock format 473385600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-2
+} {Tue Tuesday 85 1985 2 00 01 2 00}
+test clock-3.405 {ISO week-based calendar 1985-W01-6} {
+ clock format 473731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-6
+} {Sat Saturday 85 1985 6 00 01 6 00}
+test clock-3.406 {ISO week-based calendar 1985-W01-7} {
+ clock format 473817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-7
+} {Sun Sunday 85 1985 7 01 01 0 00}
+test clock-3.407 {ISO week-based calendar 1985-W02-1} {
+ clock format 473904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W02-1
+} {Mon Monday 85 1985 1 01 02 1 01}
+test clock-3.408 {ISO week-based calendar 1987-W53-1} {
+ clock format 567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-1
+} {Mon Monday 87 1987 1 52 53 1 52}
+test clock-3.409 {ISO week-based calendar 1987-W53-5} {
+ clock format 567993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-5
+} {Fri Friday 87 1987 5 00 53 5 00}
+test clock-3.410 {ISO week-based calendar 1987-W53-6} {
+ clock format 568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-6
+} {Sat Saturday 87 1987 6 00 53 6 00}
+test clock-3.411 {ISO week-based calendar 1987-W53-7} {
+ clock format 568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-7
+} {Sun Sunday 87 1987 7 01 53 0 00}
+test clock-3.412 {ISO week-based calendar 1988-W01-1} {
+ clock format 568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-1
+} {Mon Monday 88 1988 1 01 01 1 01}
+test clock-3.413 {ISO week-based calendar 1988-W01-6} {
+ clock format 568684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-6
+} {Sat Saturday 88 1988 6 01 01 6 01}
+test clock-3.414 {ISO week-based calendar 1988-W01-7} {
+ clock format 568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-7
+} {Sun Sunday 88 1988 7 02 01 0 01}
+test clock-3.415 {ISO week-based calendar 1988-W02-1} {
+ clock format 568857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W02-1
+} {Mon Monday 88 1988 1 02 02 1 02}
+test clock-3.416 {ISO week-based calendar 1988-W52-1} {
+ clock format 599097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-1
+} {Mon Monday 88 1988 1 52 52 1 52}
+test clock-3.417 {ISO week-based calendar 1988-W52-6} {
+ clock format 599529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-6
+} {Sat Saturday 88 1988 6 52 52 6 52}
+test clock-3.418 {ISO week-based calendar 1988-W52-7} {
+ clock format 599616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-7
+} {Sun Sunday 88 1988 7 01 52 0 00}
+test clock-3.419 {ISO week-based calendar 1989-W01-1} {
+ clock format 599702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-1
+} {Mon Monday 89 1989 1 01 01 1 01}
+test clock-3.420 {ISO week-based calendar 1989-W01-6} {
+ clock format 600134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-6
+} {Sat Saturday 89 1989 6 01 01 6 01}
+test clock-3.421 {ISO week-based calendar 1989-W01-7} {
+ clock format 600220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-7
+} {Sun Sunday 89 1989 7 02 01 0 01}
+test clock-3.422 {ISO week-based calendar 1989-W02-1} {
+ clock format 600307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W02-1
+} {Mon Monday 89 1989 1 02 02 1 02}
+test clock-3.423 {ISO week-based calendar 1991-W52-1} {
+ clock format 693446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-1
+} {Mon Monday 91 1991 1 51 52 1 51}
+test clock-3.424 {ISO week-based calendar 1991-W52-6} {
+ clock format 693878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-6
+} {Sat Saturday 91 1991 6 51 52 6 51}
+test clock-3.425 {ISO week-based calendar 1991-W52-7} {
+ clock format 693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-7
+} {Sun Sunday 91 1991 7 52 52 0 51}
+test clock-3.426 {ISO week-based calendar 1992-W01-1} {
+ clock format 694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-1
+} {Mon Monday 92 1992 1 52 01 1 52}
+test clock-3.427 {ISO week-based calendar 1992-W01-3} {
+ clock format 694224000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-3
+} {Wed Wednesday 92 1992 3 00 01 3 00}
+test clock-3.428 {ISO week-based calendar 1992-W01-6} {
+ clock format 694483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-6
+} {Sat Saturday 92 1992 6 00 01 6 00}
+test clock-3.429 {ISO week-based calendar 1992-W01-7} {
+ clock format 694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-7
+} {Sun Sunday 92 1992 7 01 01 0 00}
+test clock-3.430 {ISO week-based calendar 1992-W02-1} {
+ clock format 694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W02-1
+} {Mon Monday 92 1992 1 01 02 1 01}
+test clock-3.431 {ISO week-based calendar 1992-W53-1} {
+ clock format 725500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-1
+} {Mon Monday 92 1992 1 52 53 1 52}
+test clock-3.432 {ISO week-based calendar 1992-W53-5} {
+ clock format 725846400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-5
+} {Fri Friday 92 1992 5 00 53 5 00}
+test clock-3.433 {ISO week-based calendar 1992-W53-6} {
+ clock format 725932800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-6
+} {Sat Saturday 92 1992 6 00 53 6 00}
+test clock-3.434 {ISO week-based calendar 1992-W53-7} {
+ clock format 726019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-7
+} {Sun Sunday 92 1992 7 01 53 0 00}
+test clock-3.435 {ISO week-based calendar 1993-W01-1} {
+ clock format 726105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-1
+} {Mon Monday 93 1993 1 01 01 1 01}
+test clock-3.436 {ISO week-based calendar 1993-W01-6} {
+ clock format 726537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-6
+} {Sat Saturday 93 1993 6 01 01 6 01}
+test clock-3.437 {ISO week-based calendar 1993-W01-7} {
+ clock format 726624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-7
+} {Sun Sunday 93 1993 7 02 01 0 01}
+test clock-3.438 {ISO week-based calendar 1993-W02-1} {
+ clock format 726710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W02-1
+} {Mon Monday 93 1993 1 02 02 1 02}
+test clock-3.439 {ISO week-based calendar 1995-W52-1} {
+ clock format 819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-1
+} {Mon Monday 95 1995 1 52 52 1 52}
+test clock-3.440 {ISO week-based calendar 1995-W52-6} {
+ clock format 820281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-6
+} {Sat Saturday 95 1995 6 52 52 6 52}
+test clock-3.441 {ISO week-based calendar 1995-W52-7} {
+ clock format 820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-7
+} {Sun Sunday 95 1995 7 53 52 0 52}
+test clock-3.442 {ISO week-based calendar 1996-W01-1} {
+ clock format 820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-1
+} {Mon Monday 96 1996 1 00 01 1 01}
+test clock-3.443 {ISO week-based calendar 1996-W01-6} {
+ clock format 820886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-6
+} {Sat Saturday 96 1996 6 00 01 6 01}
+test clock-3.444 {ISO week-based calendar 1996-W01-7} {
+ clock format 820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-7
+} {Sun Sunday 96 1996 7 01 01 0 01}
+test clock-3.445 {ISO week-based calendar 1996-W02-1} {
+ clock format 821059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W02-1
+} {Mon Monday 96 1996 1 01 02 1 02}
+test clock-3.446 {ISO week-based calendar 1996-W52-1} {
+ clock format 851299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-1
+} {Mon Monday 96 1996 1 51 52 1 52}
+test clock-3.447 {ISO week-based calendar 1996-W52-6} {
+ clock format 851731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-6
+} {Sat Saturday 96 1996 6 51 52 6 52}
+test clock-3.448 {ISO week-based calendar 1996-W52-7} {
+ clock format 851817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-7
+} {Sun Sunday 96 1996 7 52 52 0 52}
+test clock-3.449 {ISO week-based calendar 1997-W01-1} {
+ clock format 851904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-1
+} {Mon Monday 97 1997 1 52 01 1 53}
+test clock-3.450 {ISO week-based calendar 1997-W01-3} {
+ clock format 852076800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-3
+} {Wed Wednesday 97 1997 3 00 01 3 00}
+test clock-3.451 {ISO week-based calendar 1997-W01-6} {
+ clock format 852336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-6
+} {Sat Saturday 97 1997 6 00 01 6 00}
+test clock-3.452 {ISO week-based calendar 1997-W01-7} {
+ clock format 852422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-7
+} {Sun Sunday 97 1997 7 01 01 0 00}
+test clock-3.453 {ISO week-based calendar 1997-W02-1} {
+ clock format 852508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W02-1
+} {Mon Monday 97 1997 1 01 02 1 01}
+test clock-3.454 {ISO week-based calendar 1999-W52-1} {
+ clock format 946252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-1
+} {Mon Monday 99 1999 1 52 52 1 52}
+test clock-3.455 {ISO week-based calendar 1999-W52-6} {
+ clock format 946684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-6
+} {Sat Saturday 99 1999 6 00 52 6 00}
+test clock-3.456 {ISO week-based calendar 1999-W52-7} {
+ clock format 946771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-7
+} {Sun Sunday 99 1999 7 01 52 0 00}
+test clock-3.457 {ISO week-based calendar 2000-W01-1} {
+ clock format 946857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-1
+} {Mon Monday 00 2000 1 01 01 1 01}
+test clock-3.458 {ISO week-based calendar 2000-W01-6} {
+ clock format 947289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-6
+} {Sat Saturday 00 2000 6 01 01 6 01}
+test clock-3.459 {ISO week-based calendar 2000-W01-7} {
+ clock format 947376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-7
+} {Sun Sunday 00 2000 7 02 01 0 01}
+test clock-3.460 {ISO week-based calendar 2000-W02-1} {
+ clock format 947462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W02-1
+} {Mon Monday 00 2000 1 02 02 1 02}
+test clock-3.461 {ISO week-based calendar 2000-W52-1} {
+ clock format 977702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-1
+} {Mon Monday 00 2000 1 52 52 1 52}
+test clock-3.462 {ISO week-based calendar 2000-W52-6} {
+ clock format 978134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-6
+} {Sat Saturday 00 2000 6 52 52 6 52}
+test clock-3.463 {ISO week-based calendar 2000-W52-7} {
+ clock format 978220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-7
+} {Sun Sunday 00 2000 7 53 52 0 52}
+test clock-3.464 {ISO week-based calendar 2001-W01-1} {
+ clock format 978307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-1
+} {Mon Monday 01 2001 1 00 01 1 01}
+test clock-3.465 {ISO week-based calendar 2001-W01-6} {
+ clock format 978739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-6
+} {Sat Saturday 01 2001 6 00 01 6 01}
+test clock-3.466 {ISO week-based calendar 2001-W01-7} {
+ clock format 978825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-7
+} {Sun Sunday 01 2001 7 01 01 0 01}
+test clock-3.467 {ISO week-based calendar 2001-W02-1} {
+ clock format 978912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W02-1
+} {Mon Monday 01 2001 1 01 02 1 02}
+test clock-3.468 {ISO week-based calendar 2001-W52-1} {
+ clock format 1009152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-1
+} {Mon Monday 01 2001 1 51 52 1 52}
+test clock-3.469 {ISO week-based calendar 2001-W52-6} {
+ clock format 1009584000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-6
+} {Sat Saturday 01 2001 6 51 52 6 52}
+test clock-3.470 {ISO week-based calendar 2001-W52-7} {
+ clock format 1009670400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-7
+} {Sun Sunday 01 2001 7 52 52 0 52}
+test clock-3.471 {ISO week-based calendar 2002-W01-1} {
+ clock format 1009756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-1
+} {Mon Monday 02 2002 1 52 01 1 53}
+test clock-3.472 {ISO week-based calendar 2002-W01-2} {
+ clock format 1009843200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-2
+} {Tue Tuesday 02 2002 2 00 01 2 00}
+test clock-3.473 {ISO week-based calendar 2002-W01-6} {
+ clock format 1010188800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-6
+} {Sat Saturday 02 2002 6 00 01 6 00}
+test clock-3.474 {ISO week-based calendar 2002-W01-7} {
+ clock format 1010275200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-7
+} {Sun Sunday 02 2002 7 01 01 0 00}
+test clock-3.475 {ISO week-based calendar 2002-W02-1} {
+ clock format 1010361600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W02-1
+} {Mon Monday 02 2002 1 01 02 1 01}
+test clock-3.476 {ISO week-based calendar 2002-W52-1} {
+ clock format 1040601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-1
+} {Mon Monday 02 2002 1 51 52 1 51}
+test clock-3.477 {ISO week-based calendar 2002-W52-6} {
+ clock format 1041033600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-6
+} {Sat Saturday 02 2002 6 51 52 6 51}
+test clock-3.478 {ISO week-based calendar 2002-W52-7} {
+ clock format 1041120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-7
+} {Sun Sunday 02 2002 7 52 52 0 51}
+test clock-3.479 {ISO week-based calendar 2003-W01-1} {
+ clock format 1041206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-1
+} {Mon Monday 03 2003 1 52 01 1 52}
+test clock-3.480 {ISO week-based calendar 2003-W01-3} {
+ clock format 1041379200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-3
+} {Wed Wednesday 03 2003 3 00 01 3 00}
+test clock-3.481 {ISO week-based calendar 2003-W01-6} {
+ clock format 1041638400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-6
+} {Sat Saturday 03 2003 6 00 01 6 00}
+test clock-3.482 {ISO week-based calendar 2003-W01-7} {
+ clock format 1041724800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-7
+} {Sun Sunday 03 2003 7 01 01 0 00}
+test clock-3.483 {ISO week-based calendar 2003-W02-1} {
+ clock format 1041811200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W02-1
+} {Mon Monday 03 2003 1 01 02 1 01}
+test clock-3.484 {ISO week-based calendar 2003-W52-1} {
+ clock format 1072051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-1
+} {Mon Monday 03 2003 1 51 52 1 51}
+test clock-3.485 {ISO week-based calendar 2003-W52-6} {
+ clock format 1072483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-6
+} {Sat Saturday 03 2003 6 51 52 6 51}
+test clock-3.486 {ISO week-based calendar 2003-W52-7} {
+ clock format 1072569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-7
+} {Sun Sunday 03 2003 7 52 52 0 51}
+test clock-3.487 {ISO week-based calendar 2004-W01-1} {
+ clock format 1072656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-1
+} {Mon Monday 04 2004 1 52 01 1 52}
+test clock-3.488 {ISO week-based calendar 2004-W01-4} {
+ clock format 1072915200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-4
+} {Thu Thursday 04 2004 4 00 01 4 00}
+test clock-3.489 {ISO week-based calendar 2004-W01-6} {
+ clock format 1073088000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-6
+} {Sat Saturday 04 2004 6 00 01 6 00}
+test clock-3.490 {ISO week-based calendar 2004-W01-7} {
+ clock format 1073174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-7
+} {Sun Sunday 04 2004 7 01 01 0 00}
+test clock-3.491 {ISO week-based calendar 2004-W02-1} {
+ clock format 1073260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W02-1
+} {Mon Monday 04 2004 1 01 02 1 01}
+test clock-3.492 {ISO week-based calendar 2004-W53-1} {
+ clock format 1104105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-1
+} {Mon Monday 04 2004 1 52 53 1 52}
+test clock-3.493 {ISO week-based calendar 2004-W53-6} {
+ clock format 1104537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-6
+} {Sat Saturday 04 2004 6 00 53 6 00}
+test clock-3.494 {ISO week-based calendar 2004-W53-7} {
+ clock format 1104624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-7
+} {Sun Sunday 04 2004 7 01 53 0 00}
+test clock-3.495 {ISO week-based calendar 2005-W01-1} {
+ clock format 1104710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-1
+} {Mon Monday 05 2005 1 01 01 1 01}
+test clock-3.496 {ISO week-based calendar 2005-W01-6} {
+ clock format 1105142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-6
+} {Sat Saturday 05 2005 6 01 01 6 01}
+test clock-3.497 {ISO week-based calendar 2005-W01-7} {
+ clock format 1105228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-7
+} {Sun Sunday 05 2005 7 02 01 0 01}
+test clock-3.498 {ISO week-based calendar 2005-W02-1} {
+ clock format 1105315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W02-1
+} {Mon Monday 05 2005 1 02 02 1 02}
+test clock-3.499 {ISO week-based calendar 2005-W52-1} {
+ clock format 1135555200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-1
+} {Mon Monday 05 2005 1 52 52 1 52}
+test clock-3.500 {ISO week-based calendar 2005-W52-6} {
+ clock format 1135987200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-6
+} {Sat Saturday 05 2005 6 52 52 6 52}
+test clock-3.501 {ISO week-based calendar 2005-W52-7} {
+ clock format 1136073600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-7
+} {Sun Sunday 05 2005 7 01 52 0 00}
+test clock-3.502 {ISO week-based calendar 2006-W01-1} {
+ clock format 1136160000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-1
+} {Mon Monday 06 2006 1 01 01 1 01}
+test clock-3.503 {ISO week-based calendar 2006-W01-6} {
+ clock format 1136592000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-6
+} {Sat Saturday 06 2006 6 01 01 6 01}
+test clock-3.504 {ISO week-based calendar 2006-W01-7} {
+ clock format 1136678400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-7
+} {Sun Sunday 06 2006 7 02 01 0 01}
+test clock-3.505 {ISO week-based calendar 2006-W02-1} {
+ clock format 1136764800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W02-1
+} {Mon Monday 06 2006 1 02 02 1 02}
+test clock-3.506 {ISO week-based calendar 2006-W52-1} {
+ clock format 1167004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-1
+} {Mon Monday 06 2006 1 52 52 1 52}
+test clock-3.507 {ISO week-based calendar 2006-W52-6} {
+ clock format 1167436800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-6
+} {Sat Saturday 06 2006 6 52 52 6 52}
+test clock-3.508 {ISO week-based calendar 2006-W52-7} {
+ clock format 1167523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-7
+} {Sun Sunday 06 2006 7 53 52 0 52}
+test clock-3.509 {ISO week-based calendar 2007-W01-1} {
+ clock format 1167609600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-1
+} {Mon Monday 07 2007 1 00 01 1 01}
+test clock-3.510 {ISO week-based calendar 2007-W01-6} {
+ clock format 1168041600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-6
+} {Sat Saturday 07 2007 6 00 01 6 01}
+test clock-3.511 {ISO week-based calendar 2007-W01-7} {
+ clock format 1168128000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-7
+} {Sun Sunday 07 2007 7 01 01 0 01}
+test clock-3.512 {ISO week-based calendar 2007-W02-1} {
+ clock format 1168214400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W02-1
+} {Mon Monday 07 2007 1 01 02 1 02}
+test clock-3.513 {ISO week-based calendar 2007-W52-1} {
+ clock format 1198454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-1
+} {Mon Monday 07 2007 1 51 52 1 52}
+test clock-3.514 {ISO week-based calendar 2007-W52-6} {
+ clock format 1198886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-6
+} {Sat Saturday 07 2007 6 51 52 6 52}
+test clock-3.515 {ISO week-based calendar 2007-W52-7} {
+ clock format 1198972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-7
+} {Sun Sunday 07 2007 7 52 52 0 52}
+test clock-3.516 {ISO week-based calendar 2008-W01-1} {
+ clock format 1199059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-1
+} {Mon Monday 08 2008 1 52 01 1 53}
+test clock-3.517 {ISO week-based calendar 2008-W01-2} {
+ clock format 1199145600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-2
+} {Tue Tuesday 08 2008 2 00 01 2 00}
+test clock-3.518 {ISO week-based calendar 2008-W01-6} {
+ clock format 1199491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-6
+} {Sat Saturday 08 2008 6 00 01 6 00}
+test clock-3.519 {ISO week-based calendar 2008-W01-7} {
+ clock format 1199577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-7
+} {Sun Sunday 08 2008 7 01 01 0 00}
+test clock-3.520 {ISO week-based calendar 2008-W02-1} {
+ clock format 1199664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W02-1
+} {Mon Monday 08 2008 1 01 02 1 01}
+test clock-3.521 {ISO week-based calendar 2008-W52-1} {
+ clock format 1229904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-1
+} {Mon Monday 08 2008 1 51 52 1 51}
+test clock-3.522 {ISO week-based calendar 2008-W52-6} {
+ clock format 1230336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-6
+} {Sat Saturday 08 2008 6 51 52 6 51}
+test clock-3.523 {ISO week-based calendar 2008-W52-7} {
+ clock format 1230422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-7
+} {Sun Sunday 08 2008 7 52 52 0 51}
+test clock-3.524 {ISO week-based calendar 2009-W01-1} {
+ clock format 1230508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-1
+} {Mon Monday 09 2009 1 52 01 1 52}
+test clock-3.525 {ISO week-based calendar 2009-W01-4} {
+ clock format 1230768000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-4
+} {Thu Thursday 09 2009 4 00 01 4 00}
+test clock-3.526 {ISO week-based calendar 2009-W01-6} {
+ clock format 1230940800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-6
+} {Sat Saturday 09 2009 6 00 01 6 00}
+test clock-3.527 {ISO week-based calendar 2009-W01-7} {
+ clock format 1231027200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-7
+} {Sun Sunday 09 2009 7 01 01 0 00}
+test clock-3.528 {ISO week-based calendar 2009-W02-1} {
+ clock format 1231113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W02-1
+} {Mon Monday 09 2009 1 01 02 1 01}
+test clock-3.529 {ISO week-based calendar 2009-W53-1} {
+ clock format 1261958400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-1
+} {Mon Monday 09 2009 1 52 53 1 52}
+test clock-3.530 {ISO week-based calendar 2009-W53-5} {
+ clock format 1262304000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-5
+} {Fri Friday 09 2009 5 00 53 5 00}
+test clock-3.531 {ISO week-based calendar 2009-W53-6} {
+ clock format 1262390400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-6
+} {Sat Saturday 09 2009 6 00 53 6 00}
+test clock-3.532 {ISO week-based calendar 2009-W53-7} {
+ clock format 1262476800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-7
+} {Sun Sunday 09 2009 7 01 53 0 00}
+test clock-3.533 {ISO week-based calendar 2010-W01-1} {
+ clock format 1262563200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-1
+} {Mon Monday 10 2010 1 01 01 1 01}
+test clock-3.534 {ISO week-based calendar 2010-W01-6} {
+ clock format 1262995200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-6
+} {Sat Saturday 10 2010 6 01 01 6 01}
+test clock-3.535 {ISO week-based calendar 2010-W01-7} {
+ clock format 1263081600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-7
+} {Sun Sunday 10 2010 7 02 01 0 01}
+test clock-3.536 {ISO week-based calendar 2010-W02-1} {
+ clock format 1263168000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W02-1
+} {Mon Monday 10 2010 1 02 02 1 02}
+test clock-3.537 {ISO week-based calendar 2010-W52-1} {
+ clock format 1293408000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-1
+} {Mon Monday 10 2010 1 52 52 1 52}
+test clock-3.538 {ISO week-based calendar 2010-W52-6} {
+ clock format 1293840000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-6
+} {Sat Saturday 10 2010 6 00 52 6 00}
+test clock-3.539 {ISO week-based calendar 2010-W52-7} {
+ clock format 1293926400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-7
+} {Sun Sunday 10 2010 7 01 52 0 00}
+test clock-3.540 {ISO week-based calendar 2011-W01-1} {
+ clock format 1294012800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-1
+} {Mon Monday 11 2011 1 01 01 1 01}
+test clock-3.541 {ISO week-based calendar 2011-W01-6} {
+ clock format 1294444800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-6
+} {Sat Saturday 11 2011 6 01 01 6 01}
+test clock-3.542 {ISO week-based calendar 2011-W01-7} {
+ clock format 1294531200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-7
+} {Sun Sunday 11 2011 7 02 01 0 01}
+test clock-3.543 {ISO week-based calendar 2011-W02-1} {
+ clock format 1294617600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W02-1
+} {Mon Monday 11 2011 1 02 02 1 02}
+test clock-3.544 {ISO week-based calendar 2011-W52-1} {
+ clock format 1324857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-1
+} {Mon Monday 11 2011 1 52 52 1 52}
+test clock-3.545 {ISO week-based calendar 2011-W52-6} {
+ clock format 1325289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-6
+} {Sat Saturday 11 2011 6 52 52 6 52}
+test clock-3.546 {ISO week-based calendar 2011-W52-7} {
+ clock format 1325376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-7
+} {Sun Sunday 11 2011 7 01 52 0 00}
+test clock-3.547 {ISO week-based calendar 2012-W01-1} {
+ clock format 1325462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-1
+} {Mon Monday 12 2012 1 01 01 1 01}
+test clock-3.548 {ISO week-based calendar 2012-W01-6} {
+ clock format 1325894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-6
+} {Sat Saturday 12 2012 6 01 01 6 01}
+test clock-3.549 {ISO week-based calendar 2012-W01-7} {
+ clock format 1325980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-7
+} {Sun Sunday 12 2012 7 02 01 0 01}
+test clock-3.550 {ISO week-based calendar 2012-W02-1} {
+ clock format 1326067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W02-1
+} {Mon Monday 12 2012 1 02 02 1 02}
+test clock-3.551 {ISO week-based calendar 2012-W52-1} {
+ clock format 1356307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-1
+} {Mon Monday 12 2012 1 52 52 1 52}
+test clock-3.552 {ISO week-based calendar 2012-W52-6} {
+ clock format 1356739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-6
+} {Sat Saturday 12 2012 6 52 52 6 52}
+test clock-3.553 {ISO week-based calendar 2012-W52-7} {
+ clock format 1356825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-7
+} {Sun Sunday 12 2012 7 53 52 0 52}
+test clock-3.554 {ISO week-based calendar 2013-W01-1} {
+ clock format 1356912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-1
+} {Mon Monday 13 2013 1 53 01 1 53}
+test clock-3.555 {ISO week-based calendar 2013-W01-2} {
+ clock format 1356998400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-2
+} {Tue Tuesday 13 2013 2 00 01 2 00}
+test clock-3.556 {ISO week-based calendar 2013-W01-6} {
+ clock format 1357344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-6
+} {Sat Saturday 13 2013 6 00 01 6 00}
+test clock-3.557 {ISO week-based calendar 2013-W01-7} {
+ clock format 1357430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-7
+} {Sun Sunday 13 2013 7 01 01 0 00}
+test clock-3.558 {ISO week-based calendar 2013-W02-1} {
+ clock format 1357516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W02-1
+} {Mon Monday 13 2013 1 01 02 1 01}
+test clock-3.559 {ISO week-based calendar 2015-W53-1} {
+ clock format 1451260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-1
+} {Mon Monday 15 2015 1 52 53 1 52}
+test clock-3.560 {ISO week-based calendar 2015-W53-5} {
+ clock format 1451606400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-5
+} {Fri Friday 15 2015 5 00 53 5 00}
+test clock-3.561 {ISO week-based calendar 2015-W53-6} {
+ clock format 1451692800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-6
+} {Sat Saturday 15 2015 6 00 53 6 00}
+test clock-3.562 {ISO week-based calendar 2015-W53-7} {
+ clock format 1451779200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-7
+} {Sun Sunday 15 2015 7 01 53 0 00}
+test clock-3.563 {ISO week-based calendar 2016-W01-1} {
+ clock format 1451865600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-1
+} {Mon Monday 16 2016 1 01 01 1 01}
+test clock-3.564 {ISO week-based calendar 2016-W01-6} {
+ clock format 1452297600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-6
+} {Sat Saturday 16 2016 6 01 01 6 01}
+test clock-3.565 {ISO week-based calendar 2016-W01-7} {
+ clock format 1452384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-7
+} {Sun Sunday 16 2016 7 02 01 0 01}
+test clock-3.566 {ISO week-based calendar 2016-W02-1} {
+ clock format 1452470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W02-1
+} {Mon Monday 16 2016 1 02 02 1 02}
+test clock-3.567 {ISO week-based calendar 2016-W52-1} {
+ clock format 1482710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-1
+} {Mon Monday 16 2016 1 52 52 1 52}
+test clock-3.568 {ISO week-based calendar 2016-W52-6} {
+ clock format 1483142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-6
+} {Sat Saturday 16 2016 6 52 52 6 52}
+test clock-3.569 {ISO week-based calendar 2016-W52-7} {
+ clock format 1483228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-7
+} {Sun Sunday 16 2016 7 01 52 0 00}
+test clock-3.570 {ISO week-based calendar 2017-W01-1} {
+ clock format 1483315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-1
+} {Mon Monday 17 2017 1 01 01 1 01}
+test clock-3.571 {ISO week-based calendar 2017-W01-6} {
+ clock format 1483747200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-6
+} {Sat Saturday 17 2017 6 01 01 6 01}
+test clock-3.572 {ISO week-based calendar 2017-W01-7} {
+ clock format 1483833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-7
+} {Sun Sunday 17 2017 7 02 01 0 01}
+test clock-3.573 {ISO week-based calendar 2017-W02-1} {
+ clock format 1483920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W02-1
+} {Mon Monday 17 2017 1 02 02 1 02}
+test clock-3.574 {ISO week-based calendar 2019-W52-1} {
+ clock format 1577059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-1
+} {Mon Monday 19 2019 1 51 52 1 51}
+test clock-3.575 {ISO week-based calendar 2019-W52-6} {
+ clock format 1577491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-6
+} {Sat Saturday 19 2019 6 51 52 6 51}
+test clock-3.576 {ISO week-based calendar 2019-W52-7} {
+ clock format 1577577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-7
+} {Sun Sunday 19 2019 7 52 52 0 51}
+test clock-3.577 {ISO week-based calendar 2020-W01-1} {
+ clock format 1577664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-1
+} {Mon Monday 20 2020 1 52 01 1 52}
+test clock-3.578 {ISO week-based calendar 2020-W01-3} {
+ clock format 1577836800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-3
+} {Wed Wednesday 20 2020 3 00 01 3 00}
+test clock-3.579 {ISO week-based calendar 2020-W01-6} {
+ clock format 1578096000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-6
+} {Sat Saturday 20 2020 6 00 01 6 00}
+test clock-3.580 {ISO week-based calendar 2020-W01-7} {
+ clock format 1578182400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-7
+} {Sun Sunday 20 2020 7 01 01 0 00}
+test clock-3.581 {ISO week-based calendar 2020-W02-1} {
+ clock format 1578268800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W02-1
+} {Mon Monday 20 2020 1 01 02 1 01}
+test clock-3.582 {ISO week-based calendar 2020-W53-1} {
+ clock format 1609113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-1
+} {Mon Monday 20 2020 1 52 53 1 52}
+test clock-3.583 {ISO week-based calendar 2020-W53-5} {
+ clock format 1609459200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-5
+} {Fri Friday 20 2020 5 00 53 5 00}
+test clock-3.584 {ISO week-based calendar 2020-W53-6} {
+ clock format 1609545600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-6
+} {Sat Saturday 20 2020 6 00 53 6 00}
+test clock-3.585 {ISO week-based calendar 2020-W53-7} {
+ clock format 1609632000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-7
+} {Sun Sunday 20 2020 7 01 53 0 00}
+test clock-3.586 {ISO week-based calendar 2021-W01-1} {
+ clock format 1609718400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-1
+} {Mon Monday 21 2021 1 01 01 1 01}
+test clock-3.587 {ISO week-based calendar 2021-W01-6} {
+ clock format 1610150400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-6
+} {Sat Saturday 21 2021 6 01 01 6 01}
+test clock-3.588 {ISO week-based calendar 2021-W01-7} {
+ clock format 1610236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-7
+} {Sun Sunday 21 2021 7 02 01 0 01}
+test clock-3.589 {ISO week-based calendar 2021-W02-1} {
+ clock format 1610323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W02-1
+} {Mon Monday 21 2021 1 02 02 1 02}
+test clock-3.590 {ISO week-based calendar 2023-W52-1} {
+ clock format 1703462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-1
+} {Mon Monday 23 2023 1 52 52 1 52}
+test clock-3.591 {ISO week-based calendar 2023-W52-6} {
+ clock format 1703894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-6
+} {Sat Saturday 23 2023 6 52 52 6 52}
+test clock-3.592 {ISO week-based calendar 2023-W52-7} {
+ clock format 1703980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-7
+} {Sun Sunday 23 2023 7 53 52 0 52}
+test clock-3.593 {ISO week-based calendar 2024-W01-1} {
+ clock format 1704067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-1
+} {Mon Monday 24 2024 1 00 01 1 01}
+test clock-3.594 {ISO week-based calendar 2024-W01-6} {
+ clock format 1704499200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-6
+} {Sat Saturday 24 2024 6 00 01 6 01}
+test clock-3.595 {ISO week-based calendar 2024-W01-7} {
+ clock format 1704585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-7
+} {Sun Sunday 24 2024 7 01 01 0 01}
+test clock-3.596 {ISO week-based calendar 2024-W02-1} {
+ clock format 1704672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W02-1
+} {Mon Monday 24 2024 1 01 02 1 02}
+test clock-3.597 {ISO week-based calendar 2024-W52-1} {
+ clock format 1734912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-1
+} {Mon Monday 24 2024 1 51 52 1 52}
+test clock-3.598 {ISO week-based calendar 2024-W52-6} {
+ clock format 1735344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-6
+} {Sat Saturday 24 2024 6 51 52 6 52}
+test clock-3.599 {ISO week-based calendar 2024-W52-7} {
+ clock format 1735430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-7
+} {Sun Sunday 24 2024 7 52 52 0 52}
+test clock-3.600 {ISO week-based calendar 2025-W01-1} {
+ clock format 1735516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-1
+} {Mon Monday 25 2025 1 52 01 1 53}
+test clock-3.601 {ISO week-based calendar 2025-W01-3} {
+ clock format 1735689600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-3
+} {Wed Wednesday 25 2025 3 00 01 3 00}
+test clock-3.602 {ISO week-based calendar 2025-W01-6} {
+ clock format 1735948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-6
+} {Sat Saturday 25 2025 6 00 01 6 00}
+test clock-3.603 {ISO week-based calendar 2025-W01-7} {
+ clock format 1736035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-7
+} {Sun Sunday 25 2025 7 01 01 0 00}
+test clock-3.604 {ISO week-based calendar 2025-W02-1} {
+ clock format 1736121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W02-1
+} {Mon Monday 25 2025 1 01 02 1 01}
+test clock-3.605 {ISO week-based calendar 2036-W52-1} {
+ clock format 2113516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-1
+} {Mon Monday 36 2036 1 51 52 1 51}
+test clock-3.606 {ISO week-based calendar 2036-W52-6} {
+ clock format 2113948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-6
+} {Sat Saturday 36 2036 6 51 52 6 51}
+test clock-3.607 {ISO week-based calendar 2036-W52-7} {
+ clock format 2114035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-7
+} {Sun Sunday 36 2036 7 52 52 0 51}
+test clock-3.608 {ISO week-based calendar 2037-W01-1} {
+ clock format 2114121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-1
+} {Mon Monday 37 2037 1 52 01 1 52}
+test clock-3.609 {ISO week-based calendar 2037-W01-4} {
+ clock format 2114380800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-4
+} {Thu Thursday 37 2037 4 00 01 4 00}
+test clock-3.610 {ISO week-based calendar 2037-W01-6} {
+ clock format 2114553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-6
+} {Sat Saturday 37 2037 6 00 01 6 00}
+test clock-3.611 {ISO week-based calendar 2037-W01-7} {
+ clock format 2114640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-7
+} {Sun Sunday 37 2037 7 01 01 0 00}
+test clock-3.612 {ISO week-based calendar 2037-W02-1} {
+ clock format 2114726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W02-1
+} {Mon Monday 37 2037 1 01 02 1 01}
+test clock-3.613 {ISO week-based calendar 2037-W53-1} {
+ clock format 2145571200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-1
+} {Mon Monday 37 2037 1 52 53 1 52}
+test clock-3.614 {ISO week-based calendar 2037-W53-5} {
+ clock format 2145916800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-5
+} {Fri Friday 37 2037 5 00 53 5 00}
+test clock-3.615 {ISO week-based calendar 2037-W53-6} {
+ clock format 2146003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-6
+} {Sat Saturday 37 2037 6 00 53 6 00}
+test clock-3.616 {ISO week-based calendar 2037-W53-7} {
+ clock format 2146089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-7
+} {Sun Sunday 37 2037 7 01 53 0 00}
+test clock-3.617 {ISO week-based calendar 2038-W01-1} {
+ clock format 2146176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-1
+} {Mon Monday 38 2038 1 01 01 1 01}
+test clock-3.618 {ISO week-based calendar 2038-W01-6} {
+ clock format 2146608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-6
+} {Sat Saturday 38 2038 6 01 01 6 01}
+test clock-3.619 {ISO week-based calendar 2038-W01-7} {
+ clock format 2146694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-7
+} {Sun Sunday 38 2038 7 02 01 0 01}
+test clock-3.620 {ISO week-based calendar 2038-W02-1} {
+ clock format 2146780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W02-1
+} {Mon Monday 38 2038 1 02 02 1 02}
+test clock-3.621 {ISO week-based calendar 2038-W52-1} {
+ clock format 2177020800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-1
+} {Mon Monday 38 2038 1 52 52 1 52}
+test clock-3.622 {ISO week-based calendar 2038-W52-6} {
+ clock format 2177452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-6
+} {Sat Saturday 38 2038 6 00 52 6 00}
+test clock-3.623 {ISO week-based calendar 2038-W52-7} {
+ clock format 2177539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-7
+} {Sun Sunday 38 2038 7 01 52 0 00}
+test clock-3.624 {ISO week-based calendar 2039-W01-1} {
+ clock format 2177625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-1
+} {Mon Monday 39 2039 1 01 01 1 01}
+test clock-3.625 {ISO week-based calendar 2039-W01-6} {
+ clock format 2178057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-6
+} {Sat Saturday 39 2039 6 01 01 6 01}
+test clock-3.626 {ISO week-based calendar 2039-W01-7} {
+ clock format 2178144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-7
+} {Sun Sunday 39 2039 7 02 01 0 01}
+test clock-3.627 {ISO week-based calendar 2039-W02-1} {
+ clock format 2178230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W02-1
+} {Mon Monday 39 2039 1 02 02 1 02}
+test clock-3.628 {ISO week-based calendar 2039-W52-1} {
+ clock format 2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-1
+} {Mon Monday 39 2039 1 52 52 1 52}
+test clock-3.629 {ISO week-based calendar 2039-W52-6} {
+ clock format 2208902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-6
+} {Sat Saturday 39 2039 6 52 52 6 52}
+test clock-3.630 {ISO week-based calendar 2039-W52-7} {
+ clock format 2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-7
+} {Sun Sunday 39 2039 7 01 52 0 00}
+test clock-3.631 {ISO week-based calendar 2040-W01-1} {
+ clock format 2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-1
+} {Mon Monday 40 2040 1 01 01 1 01}
+test clock-3.632 {ISO week-based calendar 2040-W01-6} {
+ clock format 2209507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-6
+} {Sat Saturday 40 2040 6 01 01 6 01}
+test clock-3.633 {ISO week-based calendar 2040-W01-7} {
+ clock format 2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-7
+} {Sun Sunday 40 2040 7 02 01 0 01}
+test clock-3.634 {ISO week-based calendar 2040-W02-1} {
+ clock format 2209680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W02-1
+} {Mon Monday 40 2040 1 02 02 1 02}
+test clock-3.635 {ISO week-based calendar 2040-W52-1} {
+ clock format 2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-1
+} {Mon Monday 40 2040 1 52 52 1 52}
+test clock-3.636 {ISO week-based calendar 2040-W52-6} {
+ clock format 2240352000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-6
+} {Sat Saturday 40 2040 6 52 52 6 52}
+test clock-3.637 {ISO week-based calendar 2040-W52-7} {
+ clock format 2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-7
+} {Sun Sunday 40 2040 7 53 52 0 52}
+test clock-3.638 {ISO week-based calendar 2041-W01-1} {
+ clock format 2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-1
+} {Mon Monday 41 2041 1 53 01 1 53}
+test clock-3.639 {ISO week-based calendar 2041-W01-2} {
+ clock format 2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-2
+} {Tue Tuesday 41 2041 2 00 01 2 00}
+test clock-3.640 {ISO week-based calendar 2041-W01-6} {
+ clock format 2240956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-6
+} {Sat Saturday 41 2041 6 00 01 6 00}
+test clock-3.641 {ISO week-based calendar 2041-W01-7} {
+ clock format 2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-7
+} {Sun Sunday 41 2041 7 01 01 0 00}
+test clock-3.642 {ISO week-based calendar 2041-W02-1} {
+ clock format 2241129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W02-1
+} {Mon Monday 41 2041 1 01 02 1 01}
+test clock-3.643 {ISO week-based calendar 2041-W52-1} {
+ clock format 2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-1
+} {Mon Monday 41 2041 1 51 52 1 51}
+test clock-3.644 {ISO week-based calendar 2041-W52-6} {
+ clock format 2271801600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-6
+} {Sat Saturday 41 2041 6 51 52 6 51}
+test clock-3.645 {ISO week-based calendar 2041-W52-7} {
+ clock format 2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-7
+} {Sun Sunday 41 2041 7 52 52 0 51}
+test clock-3.646 {ISO week-based calendar 2042-W01-1} {
+ clock format 2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-1
+} {Mon Monday 42 2042 1 52 01 1 52}
+test clock-3.647 {ISO week-based calendar 2042-W01-3} {
+ clock format 2272147200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-3
+} {Wed Wednesday 42 2042 3 00 01 3 00}
+test clock-3.648 {ISO week-based calendar 2042-W01-6} {
+ clock format 2272406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-6
+} {Sat Saturday 42 2042 6 00 01 6 00}
+test clock-3.649 {ISO week-based calendar 2042-W01-7} {
+ clock format 2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-7
+} {Sun Sunday 42 2042 7 01 01 0 00}
+test clock-3.650 {ISO week-based calendar 2042-W02-1} {
+ clock format 2272579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W02-1
+} {Mon Monday 42 2042 1 01 02 1 01}
+test clock-3.651 {ISO week-based calendar 2042-W52-1} {
+ clock format 2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-1
+} {Mon Monday 42 2042 1 51 52 1 51}
+test clock-3.652 {ISO week-based calendar 2042-W52-6} {
+ clock format 2303251200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-6
+} {Sat Saturday 42 2042 6 51 52 6 51}
+test clock-3.653 {ISO week-based calendar 2042-W52-7} {
+ clock format 2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-7
+} {Sun Sunday 42 2042 7 52 52 0 51}
+test clock-3.654 {ISO week-based calendar 2043-W01-1} {
+ clock format 2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-1
+} {Mon Monday 43 2043 1 52 01 1 52}
+test clock-3.655 {ISO week-based calendar 2043-W01-4} {
+ clock format 2303683200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-4
+} {Thu Thursday 43 2043 4 00 01 4 00}
+test clock-3.656 {ISO week-based calendar 2043-W01-6} {
+ clock format 2303856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-6
+} {Sat Saturday 43 2043 6 00 01 6 00}
+test clock-3.657 {ISO week-based calendar 2043-W01-7} {
+ clock format 2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-7
+} {Sun Sunday 43 2043 7 01 01 0 00}
+test clock-3.658 {ISO week-based calendar 2043-W02-1} {
+ clock format 2304028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W02-1
+} {Mon Monday 43 2043 1 01 02 1 01}
+test clock-3.659 {ISO week-based calendar 2043-W53-1} {
+ clock format 2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-1
+} {Mon Monday 43 2043 1 52 53 1 52}
+test clock-3.660 {ISO week-based calendar 2043-W53-5} {
+ clock format 2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-5
+} {Fri Friday 43 2043 5 00 53 5 00}
+test clock-3.661 {ISO week-based calendar 2043-W53-6} {
+ clock format 2335305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-6
+} {Sat Saturday 43 2043 6 00 53 6 00}
+test clock-3.662 {ISO week-based calendar 2043-W53-7} {
+ clock format 2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-7
+} {Sun Sunday 43 2043 7 01 53 0 00}
+test clock-3.663 {ISO week-based calendar 2044-W01-1} {
+ clock format 2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-1
+} {Mon Monday 44 2044 1 01 01 1 01}
+test clock-3.664 {ISO week-based calendar 2044-W01-6} {
+ clock format 2335910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-6
+} {Sat Saturday 44 2044 6 01 01 6 01}
+test clock-3.665 {ISO week-based calendar 2044-W01-7} {
+ clock format 2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-7
+} {Sun Sunday 44 2044 7 02 01 0 01}
+test clock-3.666 {ISO week-based calendar 2044-W02-1} {
+ clock format 2336083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W02-1
+} {Mon Monday 44 2044 1 02 02 1 02}
+test clock-3.667 {ISO week-based calendar 2044-W52-1} {
+ clock format 2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-1
+} {Mon Monday 44 2044 1 52 52 1 52}
+test clock-3.668 {ISO week-based calendar 2044-W52-6} {
+ clock format 2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-6
+} {Sat Saturday 44 2044 6 52 52 6 52}
+test clock-3.669 {ISO week-based calendar 2044-W52-7} {
+ clock format 2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-7
+} {Sun Sunday 44 2044 7 01 52 0 00}
+test clock-3.670 {ISO week-based calendar 2045-W01-1} {
+ clock format 2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-1
+} {Mon Monday 45 2045 1 01 01 1 01}
+test clock-3.671 {ISO week-based calendar 2045-W01-6} {
+ clock format 2367360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-6
+} {Sat Saturday 45 2045 6 01 01 6 01}
+test clock-3.672 {ISO week-based calendar 2045-W01-7} {
+ clock format 2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-7
+} {Sun Sunday 45 2045 7 02 01 0 01}
+test clock-3.673 {ISO week-based calendar 2045-W02-1} {
+ clock format 2367532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W02-1
+} {Mon Monday 45 2045 1 02 02 1 02}
+test clock-3.674 {ISO week-based calendar 2045-W52-1} {
+ clock format 2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-1
+} {Mon Monday 45 2045 1 52 52 1 52}
+test clock-3.675 {ISO week-based calendar 2045-W52-6} {
+ clock format 2398204800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-6
+} {Sat Saturday 45 2045 6 52 52 6 52}
+test clock-3.676 {ISO week-based calendar 2045-W52-7} {
+ clock format 2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-7
+} {Sun Sunday 45 2045 7 53 52 0 52}
+test clock-3.677 {ISO week-based calendar 2046-W01-1} {
+ clock format 2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-1
+} {Mon Monday 46 2046 1 00 01 1 01}
+test clock-3.678 {ISO week-based calendar 2046-W01-6} {
+ clock format 2398809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-6
+} {Sat Saturday 46 2046 6 00 01 6 01}
+test clock-3.679 {ISO week-based calendar 2046-W01-7} {
+ clock format 2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-7
+} {Sun Sunday 46 2046 7 01 01 0 01}
+test clock-3.680 {ISO week-based calendar 2046-W02-1} {
+ clock format 2398982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W02-1
+} {Mon Monday 46 2046 1 01 02 1 02}
+test clock-3.681 {ISO week-based calendar 2046-W52-1} {
+ clock format 2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-1
+} {Mon Monday 46 2046 1 51 52 1 52}
+test clock-3.682 {ISO week-based calendar 2046-W52-6} {
+ clock format 2429654400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-6
+} {Sat Saturday 46 2046 6 51 52 6 52}
+test clock-3.683 {ISO week-based calendar 2046-W52-7} {
+ clock format 2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-7
+} {Sun Sunday 46 2046 7 52 52 0 52}
+test clock-3.684 {ISO week-based calendar 2047-W01-1} {
+ clock format 2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-1
+} {Mon Monday 47 2047 1 52 01 1 53}
+test clock-3.685 {ISO week-based calendar 2047-W01-2} {
+ clock format 2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-2
+} {Tue Tuesday 47 2047 2 00 01 2 00}
+test clock-3.686 {ISO week-based calendar 2047-W01-6} {
+ clock format 2430259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-6
+} {Sat Saturday 47 2047 6 00 01 6 00}
+test clock-3.687 {ISO week-based calendar 2047-W01-7} {
+ clock format 2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-7
+} {Sun Sunday 47 2047 7 01 01 0 00}
+test clock-3.688 {ISO week-based calendar 2047-W02-1} {
+ clock format 2430432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W02-1
+} {Mon Monday 47 2047 1 01 02 1 01}
+test clock-3.689 {ISO week-based calendar 2047-W52-1} {
+ clock format 2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-1
+} {Mon Monday 47 2047 1 51 52 1 51}
+test clock-3.690 {ISO week-based calendar 2047-W52-6} {
+ clock format 2461104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-6
+} {Sat Saturday 47 2047 6 51 52 6 51}
+test clock-3.691 {ISO week-based calendar 2047-W52-7} {
+ clock format 2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-7
+} {Sun Sunday 47 2047 7 52 52 0 51}
+test clock-3.692 {ISO week-based calendar 2048-W01-1} {
+ clock format 2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-1
+} {Mon Monday 48 2048 1 52 01 1 52}
+test clock-3.693 {ISO week-based calendar 2048-W01-3} {
+ clock format 2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-3
+} {Wed Wednesday 48 2048 3 00 01 3 00}
+test clock-3.694 {ISO week-based calendar 2048-W01-6} {
+ clock format 2461708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-6
+} {Sat Saturday 48 2048 6 00 01 6 00}
+test clock-3.695 {ISO week-based calendar 2048-W01-7} {
+ clock format 2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-7
+} {Sun Sunday 48 2048 7 01 01 0 00}
+test clock-3.696 {ISO week-based calendar 2048-W02-1} {
+ clock format 2461881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W02-1
+} {Mon Monday 48 2048 1 01 02 1 01}
+test clock-3.697 {ISO week-based calendar 2048-W53-1} {
+ clock format 2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-1
+} {Mon Monday 48 2048 1 52 53 1 52}
+test clock-3.698 {ISO week-based calendar 2048-W53-5} {
+ clock format 2493072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-5
+} {Fri Friday 48 2048 5 00 53 5 00}
+test clock-3.699 {ISO week-based calendar 2048-W53-6} {
+ clock format 2493158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-6
+} {Sat Saturday 48 2048 6 00 53 6 00}
+test clock-3.700 {ISO week-based calendar 2048-W53-7} {
+ clock format 2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-7
+} {Sun Sunday 48 2048 7 01 53 0 00}
+test clock-3.701 {ISO week-based calendar 2049-W01-1} {
+ clock format 2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-1
+} {Mon Monday 49 2049 1 01 01 1 01}
+test clock-3.702 {ISO week-based calendar 2049-W01-6} {
+ clock format 2493763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-6
+} {Sat Saturday 49 2049 6 01 01 6 01}
+test clock-3.703 {ISO week-based calendar 2049-W01-7} {
+ clock format 2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-7
+} {Sun Sunday 49 2049 7 02 01 0 01}
+test clock-3.704 {ISO week-based calendar 2049-W02-1} {
+ clock format 2493936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W02-1
+} {Mon Monday 49 2049 1 02 02 1 02}
+test clock-3.705 {ISO week-based calendar 2051-W52-1} {
+ clock format 2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-1
+} {Mon Monday 51 2051 1 52 52 1 52}
+test clock-3.706 {ISO week-based calendar 2051-W52-6} {
+ clock format 2587507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-6
+} {Sat Saturday 51 2051 6 52 52 6 52}
+test clock-3.707 {ISO week-based calendar 2051-W52-7} {
+ clock format 2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-7
+} {Sun Sunday 51 2051 7 53 52 0 52}
+test clock-3.708 {ISO week-based calendar 2052-W01-1} {
+ clock format 2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-1
+} {Mon Monday 52 2052 1 00 01 1 01}
+test clock-3.709 {ISO week-based calendar 2052-W01-6} {
+ clock format 2588112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-6
+} {Sat Saturday 52 2052 6 00 01 6 01}
+test clock-3.710 {ISO week-based calendar 2052-W01-7} {
+ clock format 2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-7
+} {Sun Sunday 52 2052 7 01 01 0 01}
+test clock-3.711 {ISO week-based calendar 2052-W02-1} {
+ clock format 2588284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W02-1
+} {Mon Monday 52 2052 1 01 02 1 02}
+test clock-3.712 {ISO week-based calendar 2052-W52-1} {
+ clock format 2618524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-1
+} {Mon Monday 52 2052 1 51 52 1 52}
+test clock-3.713 {ISO week-based calendar 2052-W52-6} {
+ clock format 2618956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-6
+} {Sat Saturday 52 2052 6 51 52 6 52}
+test clock-3.714 {ISO week-based calendar 2052-W52-7} {
+ clock format 2619043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-7
+} {Sun Sunday 52 2052 7 52 52 0 52}
+test clock-3.715 {ISO week-based calendar 2053-W01-1} {
+ clock format 2619129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-1
+} {Mon Monday 53 2053 1 52 01 1 53}
+test clock-3.716 {ISO week-based calendar 2053-W01-3} {
+ clock format 2619302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-3
+} {Wed Wednesday 53 2053 3 00 01 3 00}
+test clock-3.717 {ISO week-based calendar 2053-W01-6} {
+ clock format 2619561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-6
+} {Sat Saturday 53 2053 6 00 01 6 00}
+test clock-3.718 {ISO week-based calendar 2053-W01-7} {
+ clock format 2619648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-7
+} {Sun Sunday 53 2053 7 01 01 0 00}
+test clock-3.719 {ISO week-based calendar 2053-W02-1} {
+ clock format 2619734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W02-1
+} {Mon Monday 53 2053 1 01 02 1 01}
+test clock-3.720 {ISO week-based calendar 2055-W52-1} {
+ clock format 2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-1
+} {Mon Monday 55 2055 1 52 52 1 52}
+test clock-3.721 {ISO week-based calendar 2055-W52-6} {
+ clock format 2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-6
+} {Sat Saturday 55 2055 6 00 52 6 00}
+test clock-3.722 {ISO week-based calendar 2055-W52-7} {
+ clock format 2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-7
+} {Sun Sunday 55 2055 7 01 52 0 00}
+test clock-3.723 {ISO week-based calendar 2056-W01-1} {
+ clock format 2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-1
+} {Mon Monday 56 2056 1 01 01 1 01}
+test clock-3.724 {ISO week-based calendar 2056-W01-6} {
+ clock format 2714515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-6
+} {Sat Saturday 56 2056 6 01 01 6 01}
+test clock-3.725 {ISO week-based calendar 2056-W01-7} {
+ clock format 2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-7
+} {Sun Sunday 56 2056 7 02 01 0 01}
+test clock-3.726 {ISO week-based calendar 2056-W02-1} {
+ clock format 2714688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W02-1
+} {Mon Monday 56 2056 1 02 02 1 02}
+test clock-3.727 {ISO week-based calendar 2056-W52-1} {
+ clock format 2744928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-1
+} {Mon Monday 56 2056 1 52 52 1 52}
+test clock-3.728 {ISO week-based calendar 2056-W52-6} {
+ clock format 2745360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-6
+} {Sat Saturday 56 2056 6 52 52 6 52}
+test clock-3.729 {ISO week-based calendar 2056-W52-7} {
+ clock format 2745446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-7
+} {Sun Sunday 56 2056 7 53 52 0 52}
+test clock-3.730 {ISO week-based calendar 2057-W01-1} {
+ clock format 2745532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-1
+} {Mon Monday 57 2057 1 00 01 1 01}
+test clock-3.731 {ISO week-based calendar 2057-W01-6} {
+ clock format 2745964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-6
+} {Sat Saturday 57 2057 6 00 01 6 01}
+test clock-3.732 {ISO week-based calendar 2057-W01-7} {
+ clock format 2746051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-7
+} {Sun Sunday 57 2057 7 01 01 0 01}
+test clock-3.733 {ISO week-based calendar 2057-W02-1} {
+ clock format 2746137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W02-1
+} {Mon Monday 57 2057 1 01 02 1 02}
+test clock-3.734 {ISO week-based calendar 2059-W52-1} {
+ clock format 2839276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-1
+} {Mon Monday 59 2059 1 51 52 1 51}
+test clock-3.735 {ISO week-based calendar 2059-W52-6} {
+ clock format 2839708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-6
+} {Sat Saturday 59 2059 6 51 52 6 51}
+test clock-3.736 {ISO week-based calendar 2059-W52-7} {
+ clock format 2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-7
+} {Sun Sunday 59 2059 7 52 52 0 51}
+test clock-3.737 {ISO week-based calendar 2060-W01-1} {
+ clock format 2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-1
+} {Mon Monday 60 2060 1 52 01 1 52}
+test clock-3.738 {ISO week-based calendar 2060-W01-4} {
+ clock format 2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-4
+} {Thu Thursday 60 2060 4 00 01 4 00}
+test clock-3.739 {ISO week-based calendar 2060-W01-6} {
+ clock format 2840313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-6
+} {Sat Saturday 60 2060 6 00 01 6 00}
+test clock-3.740 {ISO week-based calendar 2060-W01-7} {
+ clock format 2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-7
+} {Sun Sunday 60 2060 7 01 01 0 00}
+test clock-3.741 {ISO week-based calendar 2060-W02-1} {
+ clock format 2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W02-1
+} {Mon Monday 60 2060 1 01 02 1 01}
+test clock-3.742 {ISO week-based calendar 2060-W53-1} {
+ clock format 2871331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-1
+} {Mon Monday 60 2060 1 52 53 1 52}
+test clock-3.743 {ISO week-based calendar 2060-W53-6} {
+ clock format 2871763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-6
+} {Sat Saturday 60 2060 6 00 53 6 00}
+test clock-3.744 {ISO week-based calendar 2060-W53-7} {
+ clock format 2871849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-7
+} {Sun Sunday 60 2060 7 01 53 0 00}
+test clock-3.745 {ISO week-based calendar 2061-W01-1} {
+ clock format 2871936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-1
+} {Mon Monday 61 2061 1 01 01 1 01}
+test clock-3.746 {ISO week-based calendar 2061-W01-6} {
+ clock format 2872368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-6
+} {Sat Saturday 61 2061 6 01 01 6 01}
+test clock-3.747 {ISO week-based calendar 2061-W01-7} {
+ clock format 2872454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-7
+} {Sun Sunday 61 2061 7 02 01 0 01}
+test clock-3.748 {ISO week-based calendar 2061-W02-1} {
+ clock format 2872540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W02-1
+} {Mon Monday 61 2061 1 02 02 1 02}
+test clock-3.749 {ISO week-based calendar 2063-W52-1} {
+ clock format 2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-1
+} {Mon Monday 63 2063 1 51 52 1 52}
+test clock-3.750 {ISO week-based calendar 2063-W52-6} {
+ clock format 2966112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-6
+} {Sat Saturday 63 2063 6 51 52 6 52}
+test clock-3.751 {ISO week-based calendar 2063-W52-7} {
+ clock format 2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-7
+} {Sun Sunday 63 2063 7 52 52 0 52}
+test clock-3.752 {ISO week-based calendar 2064-W01-1} {
+ clock format 2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-1
+} {Mon Monday 64 2064 1 52 01 1 53}
+test clock-3.753 {ISO week-based calendar 2064-W01-2} {
+ clock format 2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-2
+} {Tue Tuesday 64 2064 2 00 01 2 00}
+test clock-3.754 {ISO week-based calendar 2064-W01-6} {
+ clock format 2966716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-6
+} {Sat Saturday 64 2064 6 00 01 6 00}
+test clock-3.755 {ISO week-based calendar 2064-W01-7} {
+ clock format 2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-7
+} {Sun Sunday 64 2064 7 01 01 0 00}
+test clock-3.756 {ISO week-based calendar 2064-W02-1} {
+ clock format 2966889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W02-1
+} {Mon Monday 64 2064 1 01 02 1 01}
+test clock-3.757 {ISO week-based calendar 2064-W52-1} {
+ clock format 2997129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-1
+} {Mon Monday 64 2064 1 51 52 1 51}
+test clock-3.758 {ISO week-based calendar 2064-W52-6} {
+ clock format 2997561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-6
+} {Sat Saturday 64 2064 6 51 52 6 51}
+test clock-3.759 {ISO week-based calendar 2064-W52-7} {
+ clock format 2997648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-7
+} {Sun Sunday 64 2064 7 52 52 0 51}
+test clock-3.760 {ISO week-based calendar 2065-W01-1} {
+ clock format 2997734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-1
+} {Mon Monday 65 2065 1 52 01 1 52}
+test clock-3.761 {ISO week-based calendar 2065-W01-4} {
+ clock format 2997993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-4
+} {Thu Thursday 65 2065 4 00 01 4 00}
+test clock-3.762 {ISO week-based calendar 2065-W01-6} {
+ clock format 2998166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-6
+} {Sat Saturday 65 2065 6 00 01 6 00}
+test clock-3.763 {ISO week-based calendar 2065-W01-7} {
+ clock format 2998252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-7
+} {Sun Sunday 65 2065 7 01 01 0 00}
+test clock-3.764 {ISO week-based calendar 2065-W02-1} {
+ clock format 2998339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W02-1
+} {Mon Monday 65 2065 1 01 02 1 01}
# END testcases3
# BEGIN testcases4
@@ -14774,17 +15297,14 @@ test clock-4.96 { format time of day 23:59:59 } {
# Test formatting of Daylight Saving Time
-::tcltest::testConstraint detroit 0
test clock-5.1 {does Detroit exist} {
clock format 0 -format {} -timezone :America/Detroit
- ::tcltest::testConstraint detroit 1
concat
} {}
test clock-5.2 {does Detroit have a Y2038 problem} detroit {
if { [clock format 2158894800 -format %z -timezone :America/Detroit] ne {-0400} } {
concat {y2038 problem}
} else {
- ::tcltest::testConstraint y2038 1
concat {ok}
}
} ok
@@ -15760,2236 +16280,2236 @@ test clock-5.245 {time zone boundary case 2006-10-29 01:00:01} detroit {
clock format 1162101601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.246 {time zone boundary case 2007-04-01 01:59:59} detroit {
- clock format 1175410799 -format {%H:%M:%S %z %Z} \
+test clock-5.246 {time zone boundary case 2007-03-11 01:59:59} detroit {
+ clock format 1173596399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.247 {time zone boundary case 2007-04-01 03:00:00} detroit {
- clock format 1175410800 -format {%H:%M:%S %z %Z} \
+test clock-5.247 {time zone boundary case 2007-03-11 03:00:00} detroit {
+ clock format 1173596400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.248 {time zone boundary case 2007-04-01 03:00:01} detroit {
- clock format 1175410801 -format {%H:%M:%S %z %Z} \
+test clock-5.248 {time zone boundary case 2007-03-11 03:00:01} detroit {
+ clock format 1173596401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.249 {time zone boundary case 2007-10-28 01:59:59} detroit {
- clock format 1193551199 -format {%H:%M:%S %z %Z} \
+test clock-5.249 {time zone boundary case 2007-11-04 01:59:59} detroit {
+ clock format 1194155999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.250 {time zone boundary case 2007-10-28 01:00:00} detroit {
- clock format 1193551200 -format {%H:%M:%S %z %Z} \
+test clock-5.250 {time zone boundary case 2007-11-04 01:00:00} detroit {
+ clock format 1194156000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.251 {time zone boundary case 2007-10-28 01:00:01} detroit {
- clock format 1193551201 -format {%H:%M:%S %z %Z} \
+test clock-5.251 {time zone boundary case 2007-11-04 01:00:01} detroit {
+ clock format 1194156001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.252 {time zone boundary case 2008-04-06 01:59:59} detroit {
- clock format 1207465199 -format {%H:%M:%S %z %Z} \
+test clock-5.252 {time zone boundary case 2008-03-09 01:59:59} detroit {
+ clock format 1205045999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.253 {time zone boundary case 2008-04-06 03:00:00} detroit {
- clock format 1207465200 -format {%H:%M:%S %z %Z} \
+test clock-5.253 {time zone boundary case 2008-03-09 03:00:00} detroit {
+ clock format 1205046000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.254 {time zone boundary case 2008-04-06 03:00:01} detroit {
- clock format 1207465201 -format {%H:%M:%S %z %Z} \
+test clock-5.254 {time zone boundary case 2008-03-09 03:00:01} detroit {
+ clock format 1205046001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.255 {time zone boundary case 2008-10-26 01:59:59} detroit {
- clock format 1225000799 -format {%H:%M:%S %z %Z} \
+test clock-5.255 {time zone boundary case 2008-11-02 01:59:59} detroit {
+ clock format 1225605599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.256 {time zone boundary case 2008-10-26 01:00:00} detroit {
- clock format 1225000800 -format {%H:%M:%S %z %Z} \
+test clock-5.256 {time zone boundary case 2008-11-02 01:00:00} detroit {
+ clock format 1225605600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.257 {time zone boundary case 2008-10-26 01:00:01} detroit {
- clock format 1225000801 -format {%H:%M:%S %z %Z} \
+test clock-5.257 {time zone boundary case 2008-11-02 01:00:01} detroit {
+ clock format 1225605601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.258 {time zone boundary case 2009-04-05 01:59:59} detroit {
- clock format 1238914799 -format {%H:%M:%S %z %Z} \
+test clock-5.258 {time zone boundary case 2009-03-08 01:59:59} detroit {
+ clock format 1236495599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.259 {time zone boundary case 2009-04-05 03:00:00} detroit {
- clock format 1238914800 -format {%H:%M:%S %z %Z} \
+test clock-5.259 {time zone boundary case 2009-03-08 03:00:00} detroit {
+ clock format 1236495600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.260 {time zone boundary case 2009-04-05 03:00:01} detroit {
- clock format 1238914801 -format {%H:%M:%S %z %Z} \
+test clock-5.260 {time zone boundary case 2009-03-08 03:00:01} detroit {
+ clock format 1236495601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.261 {time zone boundary case 2009-10-25 01:59:59} detroit {
- clock format 1256450399 -format {%H:%M:%S %z %Z} \
+test clock-5.261 {time zone boundary case 2009-11-01 01:59:59} detroit {
+ clock format 1257055199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.262 {time zone boundary case 2009-10-25 01:00:00} detroit {
- clock format 1256450400 -format {%H:%M:%S %z %Z} \
+test clock-5.262 {time zone boundary case 2009-11-01 01:00:00} detroit {
+ clock format 1257055200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.263 {time zone boundary case 2009-10-25 01:00:01} detroit {
- clock format 1256450401 -format {%H:%M:%S %z %Z} \
+test clock-5.263 {time zone boundary case 2009-11-01 01:00:01} detroit {
+ clock format 1257055201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.264 {time zone boundary case 2010-04-04 01:59:59} detroit {
- clock format 1270364399 -format {%H:%M:%S %z %Z} \
+test clock-5.264 {time zone boundary case 2010-03-14 01:59:59} detroit {
+ clock format 1268549999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.265 {time zone boundary case 2010-04-04 03:00:00} detroit {
- clock format 1270364400 -format {%H:%M:%S %z %Z} \
+test clock-5.265 {time zone boundary case 2010-03-14 03:00:00} detroit {
+ clock format 1268550000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.266 {time zone boundary case 2010-04-04 03:00:01} detroit {
- clock format 1270364401 -format {%H:%M:%S %z %Z} \
+test clock-5.266 {time zone boundary case 2010-03-14 03:00:01} detroit {
+ clock format 1268550001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.267 {time zone boundary case 2010-10-31 01:59:59} detroit {
- clock format 1288504799 -format {%H:%M:%S %z %Z} \
+test clock-5.267 {time zone boundary case 2010-11-07 01:59:59} detroit {
+ clock format 1289109599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.268 {time zone boundary case 2010-10-31 01:00:00} detroit {
- clock format 1288504800 -format {%H:%M:%S %z %Z} \
+test clock-5.268 {time zone boundary case 2010-11-07 01:00:00} detroit {
+ clock format 1289109600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.269 {time zone boundary case 2010-10-31 01:00:01} detroit {
- clock format 1288504801 -format {%H:%M:%S %z %Z} \
+test clock-5.269 {time zone boundary case 2010-11-07 01:00:01} detroit {
+ clock format 1289109601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.270 {time zone boundary case 2011-04-03 01:59:59} detroit {
- clock format 1301813999 -format {%H:%M:%S %z %Z} \
+test clock-5.270 {time zone boundary case 2011-03-13 01:59:59} detroit {
+ clock format 1299999599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.271 {time zone boundary case 2011-04-03 03:00:00} detroit {
- clock format 1301814000 -format {%H:%M:%S %z %Z} \
+test clock-5.271 {time zone boundary case 2011-03-13 03:00:00} detroit {
+ clock format 1299999600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.272 {time zone boundary case 2011-04-03 03:00:01} detroit {
- clock format 1301814001 -format {%H:%M:%S %z %Z} \
+test clock-5.272 {time zone boundary case 2011-03-13 03:00:01} detroit {
+ clock format 1299999601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.273 {time zone boundary case 2011-10-30 01:59:59} detroit {
- clock format 1319954399 -format {%H:%M:%S %z %Z} \
+test clock-5.273 {time zone boundary case 2011-11-06 01:59:59} detroit {
+ clock format 1320559199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.274 {time zone boundary case 2011-10-30 01:00:00} detroit {
- clock format 1319954400 -format {%H:%M:%S %z %Z} \
+test clock-5.274 {time zone boundary case 2011-11-06 01:00:00} detroit {
+ clock format 1320559200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.275 {time zone boundary case 2011-10-30 01:00:01} detroit {
- clock format 1319954401 -format {%H:%M:%S %z %Z} \
+test clock-5.275 {time zone boundary case 2011-11-06 01:00:01} detroit {
+ clock format 1320559201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.276 {time zone boundary case 2012-04-01 01:59:59} detroit {
- clock format 1333263599 -format {%H:%M:%S %z %Z} \
+test clock-5.276 {time zone boundary case 2012-03-11 01:59:59} detroit {
+ clock format 1331449199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.277 {time zone boundary case 2012-04-01 03:00:00} detroit {
- clock format 1333263600 -format {%H:%M:%S %z %Z} \
+test clock-5.277 {time zone boundary case 2012-03-11 03:00:00} detroit {
+ clock format 1331449200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.278 {time zone boundary case 2012-04-01 03:00:01} detroit {
- clock format 1333263601 -format {%H:%M:%S %z %Z} \
+test clock-5.278 {time zone boundary case 2012-03-11 03:00:01} detroit {
+ clock format 1331449201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.279 {time zone boundary case 2012-10-28 01:59:59} detroit {
- clock format 1351403999 -format {%H:%M:%S %z %Z} \
+test clock-5.279 {time zone boundary case 2012-11-04 01:59:59} detroit {
+ clock format 1352008799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.280 {time zone boundary case 2012-10-28 01:00:00} detroit {
- clock format 1351404000 -format {%H:%M:%S %z %Z} \
+test clock-5.280 {time zone boundary case 2012-11-04 01:00:00} detroit {
+ clock format 1352008800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.281 {time zone boundary case 2012-10-28 01:00:01} detroit {
- clock format 1351404001 -format {%H:%M:%S %z %Z} \
+test clock-5.281 {time zone boundary case 2012-11-04 01:00:01} detroit {
+ clock format 1352008801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.282 {time zone boundary case 2013-04-07 01:59:59} detroit {
- clock format 1365317999 -format {%H:%M:%S %z %Z} \
+test clock-5.282 {time zone boundary case 2013-03-10 01:59:59} detroit {
+ clock format 1362898799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.283 {time zone boundary case 2013-04-07 03:00:00} detroit {
- clock format 1365318000 -format {%H:%M:%S %z %Z} \
+test clock-5.283 {time zone boundary case 2013-03-10 03:00:00} detroit {
+ clock format 1362898800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.284 {time zone boundary case 2013-04-07 03:00:01} detroit {
- clock format 1365318001 -format {%H:%M:%S %z %Z} \
+test clock-5.284 {time zone boundary case 2013-03-10 03:00:01} detroit {
+ clock format 1362898801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.285 {time zone boundary case 2013-10-27 01:59:59} detroit {
- clock format 1382853599 -format {%H:%M:%S %z %Z} \
+test clock-5.285 {time zone boundary case 2013-11-03 01:59:59} detroit {
+ clock format 1383458399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.286 {time zone boundary case 2013-10-27 01:00:00} detroit {
- clock format 1382853600 -format {%H:%M:%S %z %Z} \
+test clock-5.286 {time zone boundary case 2013-11-03 01:00:00} detroit {
+ clock format 1383458400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.287 {time zone boundary case 2013-10-27 01:00:01} detroit {
- clock format 1382853601 -format {%H:%M:%S %z %Z} \
+test clock-5.287 {time zone boundary case 2013-11-03 01:00:01} detroit {
+ clock format 1383458401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.288 {time zone boundary case 2014-04-06 01:59:59} detroit {
- clock format 1396767599 -format {%H:%M:%S %z %Z} \
+test clock-5.288 {time zone boundary case 2014-03-09 01:59:59} detroit {
+ clock format 1394348399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.289 {time zone boundary case 2014-04-06 03:00:00} detroit {
- clock format 1396767600 -format {%H:%M:%S %z %Z} \
+test clock-5.289 {time zone boundary case 2014-03-09 03:00:00} detroit {
+ clock format 1394348400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.290 {time zone boundary case 2014-04-06 03:00:01} detroit {
- clock format 1396767601 -format {%H:%M:%S %z %Z} \
+test clock-5.290 {time zone boundary case 2014-03-09 03:00:01} detroit {
+ clock format 1394348401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.291 {time zone boundary case 2014-10-26 01:59:59} detroit {
- clock format 1414303199 -format {%H:%M:%S %z %Z} \
+test clock-5.291 {time zone boundary case 2014-11-02 01:59:59} detroit {
+ clock format 1414907999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.292 {time zone boundary case 2014-10-26 01:00:00} detroit {
- clock format 1414303200 -format {%H:%M:%S %z %Z} \
+test clock-5.292 {time zone boundary case 2014-11-02 01:00:00} detroit {
+ clock format 1414908000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.293 {time zone boundary case 2014-10-26 01:00:01} detroit {
- clock format 1414303201 -format {%H:%M:%S %z %Z} \
+test clock-5.293 {time zone boundary case 2014-11-02 01:00:01} detroit {
+ clock format 1414908001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.294 {time zone boundary case 2015-04-05 01:59:59} detroit {
- clock format 1428217199 -format {%H:%M:%S %z %Z} \
+test clock-5.294 {time zone boundary case 2015-03-08 01:59:59} detroit {
+ clock format 1425797999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.295 {time zone boundary case 2015-04-05 03:00:00} detroit {
- clock format 1428217200 -format {%H:%M:%S %z %Z} \
+test clock-5.295 {time zone boundary case 2015-03-08 03:00:00} detroit {
+ clock format 1425798000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.296 {time zone boundary case 2015-04-05 03:00:01} detroit {
- clock format 1428217201 -format {%H:%M:%S %z %Z} \
+test clock-5.296 {time zone boundary case 2015-03-08 03:00:01} detroit {
+ clock format 1425798001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.297 {time zone boundary case 2015-10-25 01:59:59} detroit {
- clock format 1445752799 -format {%H:%M:%S %z %Z} \
+test clock-5.297 {time zone boundary case 2015-11-01 01:59:59} detroit {
+ clock format 1446357599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.298 {time zone boundary case 2015-10-25 01:00:00} detroit {
- clock format 1445752800 -format {%H:%M:%S %z %Z} \
+test clock-5.298 {time zone boundary case 2015-11-01 01:00:00} detroit {
+ clock format 1446357600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.299 {time zone boundary case 2015-10-25 01:00:01} detroit {
- clock format 1445752801 -format {%H:%M:%S %z %Z} \
+test clock-5.299 {time zone boundary case 2015-11-01 01:00:01} detroit {
+ clock format 1446357601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.300 {time zone boundary case 2016-04-03 01:59:59} detroit {
- clock format 1459666799 -format {%H:%M:%S %z %Z} \
+test clock-5.300 {time zone boundary case 2016-03-13 01:59:59} detroit {
+ clock format 1457852399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.301 {time zone boundary case 2016-04-03 03:00:00} detroit {
- clock format 1459666800 -format {%H:%M:%S %z %Z} \
+test clock-5.301 {time zone boundary case 2016-03-13 03:00:00} detroit {
+ clock format 1457852400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.302 {time zone boundary case 2016-04-03 03:00:01} detroit {
- clock format 1459666801 -format {%H:%M:%S %z %Z} \
+test clock-5.302 {time zone boundary case 2016-03-13 03:00:01} detroit {
+ clock format 1457852401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.303 {time zone boundary case 2016-10-30 01:59:59} detroit {
- clock format 1477807199 -format {%H:%M:%S %z %Z} \
+test clock-5.303 {time zone boundary case 2016-11-06 01:59:59} detroit {
+ clock format 1478411999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.304 {time zone boundary case 2016-10-30 01:00:00} detroit {
- clock format 1477807200 -format {%H:%M:%S %z %Z} \
+test clock-5.304 {time zone boundary case 2016-11-06 01:00:00} detroit {
+ clock format 1478412000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.305 {time zone boundary case 2016-10-30 01:00:01} detroit {
- clock format 1477807201 -format {%H:%M:%S %z %Z} \
+test clock-5.305 {time zone boundary case 2016-11-06 01:00:01} detroit {
+ clock format 1478412001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.306 {time zone boundary case 2017-04-02 01:59:59} detroit {
- clock format 1491116399 -format {%H:%M:%S %z %Z} \
+test clock-5.306 {time zone boundary case 2017-03-12 01:59:59} detroit {
+ clock format 1489301999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.307 {time zone boundary case 2017-04-02 03:00:00} detroit {
- clock format 1491116400 -format {%H:%M:%S %z %Z} \
+test clock-5.307 {time zone boundary case 2017-03-12 03:00:00} detroit {
+ clock format 1489302000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.308 {time zone boundary case 2017-04-02 03:00:01} detroit {
- clock format 1491116401 -format {%H:%M:%S %z %Z} \
+test clock-5.308 {time zone boundary case 2017-03-12 03:00:01} detroit {
+ clock format 1489302001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.309 {time zone boundary case 2017-10-29 01:59:59} detroit {
- clock format 1509256799 -format {%H:%M:%S %z %Z} \
+test clock-5.309 {time zone boundary case 2017-11-05 01:59:59} detroit {
+ clock format 1509861599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.310 {time zone boundary case 2017-10-29 01:00:00} detroit {
- clock format 1509256800 -format {%H:%M:%S %z %Z} \
+test clock-5.310 {time zone boundary case 2017-11-05 01:00:00} detroit {
+ clock format 1509861600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.311 {time zone boundary case 2017-10-29 01:00:01} detroit {
- clock format 1509256801 -format {%H:%M:%S %z %Z} \
+test clock-5.311 {time zone boundary case 2017-11-05 01:00:01} detroit {
+ clock format 1509861601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.312 {time zone boundary case 2018-04-01 01:59:59} detroit {
- clock format 1522565999 -format {%H:%M:%S %z %Z} \
+test clock-5.312 {time zone boundary case 2018-03-11 01:59:59} detroit {
+ clock format 1520751599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.313 {time zone boundary case 2018-04-01 03:00:00} detroit {
- clock format 1522566000 -format {%H:%M:%S %z %Z} \
+test clock-5.313 {time zone boundary case 2018-03-11 03:00:00} detroit {
+ clock format 1520751600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.314 {time zone boundary case 2018-04-01 03:00:01} detroit {
- clock format 1522566001 -format {%H:%M:%S %z %Z} \
+test clock-5.314 {time zone boundary case 2018-03-11 03:00:01} detroit {
+ clock format 1520751601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.315 {time zone boundary case 2018-10-28 01:59:59} detroit {
- clock format 1540706399 -format {%H:%M:%S %z %Z} \
+test clock-5.315 {time zone boundary case 2018-11-04 01:59:59} detroit {
+ clock format 1541311199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.316 {time zone boundary case 2018-10-28 01:00:00} detroit {
- clock format 1540706400 -format {%H:%M:%S %z %Z} \
+test clock-5.316 {time zone boundary case 2018-11-04 01:00:00} detroit {
+ clock format 1541311200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.317 {time zone boundary case 2018-10-28 01:00:01} detroit {
- clock format 1540706401 -format {%H:%M:%S %z %Z} \
+test clock-5.317 {time zone boundary case 2018-11-04 01:00:01} detroit {
+ clock format 1541311201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.318 {time zone boundary case 2019-04-07 01:59:59} detroit {
- clock format 1554620399 -format {%H:%M:%S %z %Z} \
+test clock-5.318 {time zone boundary case 2019-03-10 01:59:59} detroit {
+ clock format 1552201199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.319 {time zone boundary case 2019-04-07 03:00:00} detroit {
- clock format 1554620400 -format {%H:%M:%S %z %Z} \
+test clock-5.319 {time zone boundary case 2019-03-10 03:00:00} detroit {
+ clock format 1552201200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.320 {time zone boundary case 2019-04-07 03:00:01} detroit {
- clock format 1554620401 -format {%H:%M:%S %z %Z} \
+test clock-5.320 {time zone boundary case 2019-03-10 03:00:01} detroit {
+ clock format 1552201201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.321 {time zone boundary case 2019-10-27 01:59:59} detroit {
- clock format 1572155999 -format {%H:%M:%S %z %Z} \
+test clock-5.321 {time zone boundary case 2019-11-03 01:59:59} detroit {
+ clock format 1572760799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.322 {time zone boundary case 2019-10-27 01:00:00} detroit {
- clock format 1572156000 -format {%H:%M:%S %z %Z} \
+test clock-5.322 {time zone boundary case 2019-11-03 01:00:00} detroit {
+ clock format 1572760800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.323 {time zone boundary case 2019-10-27 01:00:01} detroit {
- clock format 1572156001 -format {%H:%M:%S %z %Z} \
+test clock-5.323 {time zone boundary case 2019-11-03 01:00:01} detroit {
+ clock format 1572760801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.324 {time zone boundary case 2020-04-05 01:59:59} detroit {
- clock format 1586069999 -format {%H:%M:%S %z %Z} \
+test clock-5.324 {time zone boundary case 2020-03-08 01:59:59} detroit {
+ clock format 1583650799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.325 {time zone boundary case 2020-04-05 03:00:00} detroit {
- clock format 1586070000 -format {%H:%M:%S %z %Z} \
+test clock-5.325 {time zone boundary case 2020-03-08 03:00:00} detroit {
+ clock format 1583650800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.326 {time zone boundary case 2020-04-05 03:00:01} detroit {
- clock format 1586070001 -format {%H:%M:%S %z %Z} \
+test clock-5.326 {time zone boundary case 2020-03-08 03:00:01} detroit {
+ clock format 1583650801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.327 {time zone boundary case 2020-10-25 01:59:59} detroit {
- clock format 1603605599 -format {%H:%M:%S %z %Z} \
+test clock-5.327 {time zone boundary case 2020-11-01 01:59:59} detroit {
+ clock format 1604210399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.328 {time zone boundary case 2020-10-25 01:00:00} detroit {
- clock format 1603605600 -format {%H:%M:%S %z %Z} \
+test clock-5.328 {time zone boundary case 2020-11-01 01:00:00} detroit {
+ clock format 1604210400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.329 {time zone boundary case 2020-10-25 01:00:01} detroit {
- clock format 1603605601 -format {%H:%M:%S %z %Z} \
+test clock-5.329 {time zone boundary case 2020-11-01 01:00:01} detroit {
+ clock format 1604210401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.330 {time zone boundary case 2021-04-04 01:59:59} detroit {
- clock format 1617519599 -format {%H:%M:%S %z %Z} \
+test clock-5.330 {time zone boundary case 2021-03-14 01:59:59} detroit {
+ clock format 1615705199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.331 {time zone boundary case 2021-04-04 03:00:00} detroit {
- clock format 1617519600 -format {%H:%M:%S %z %Z} \
+test clock-5.331 {time zone boundary case 2021-03-14 03:00:00} detroit {
+ clock format 1615705200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.332 {time zone boundary case 2021-04-04 03:00:01} detroit {
- clock format 1617519601 -format {%H:%M:%S %z %Z} \
+test clock-5.332 {time zone boundary case 2021-03-14 03:00:01} detroit {
+ clock format 1615705201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.333 {time zone boundary case 2021-10-31 01:59:59} detroit {
- clock format 1635659999 -format {%H:%M:%S %z %Z} \
+test clock-5.333 {time zone boundary case 2021-11-07 01:59:59} detroit {
+ clock format 1636264799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.334 {time zone boundary case 2021-10-31 01:00:00} detroit {
- clock format 1635660000 -format {%H:%M:%S %z %Z} \
+test clock-5.334 {time zone boundary case 2021-11-07 01:00:00} detroit {
+ clock format 1636264800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.335 {time zone boundary case 2021-10-31 01:00:01} detroit {
- clock format 1635660001 -format {%H:%M:%S %z %Z} \
+test clock-5.335 {time zone boundary case 2021-11-07 01:00:01} detroit {
+ clock format 1636264801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.336 {time zone boundary case 2022-04-03 01:59:59} detroit {
- clock format 1648969199 -format {%H:%M:%S %z %Z} \
+test clock-5.336 {time zone boundary case 2022-03-13 01:59:59} detroit {
+ clock format 1647154799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.337 {time zone boundary case 2022-04-03 03:00:00} detroit {
- clock format 1648969200 -format {%H:%M:%S %z %Z} \
+test clock-5.337 {time zone boundary case 2022-03-13 03:00:00} detroit {
+ clock format 1647154800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.338 {time zone boundary case 2022-04-03 03:00:01} detroit {
- clock format 1648969201 -format {%H:%M:%S %z %Z} \
+test clock-5.338 {time zone boundary case 2022-03-13 03:00:01} detroit {
+ clock format 1647154801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.339 {time zone boundary case 2022-10-30 01:59:59} detroit {
- clock format 1667109599 -format {%H:%M:%S %z %Z} \
+test clock-5.339 {time zone boundary case 2022-11-06 01:59:59} detroit {
+ clock format 1667714399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.340 {time zone boundary case 2022-10-30 01:00:00} detroit {
- clock format 1667109600 -format {%H:%M:%S %z %Z} \
+test clock-5.340 {time zone boundary case 2022-11-06 01:00:00} detroit {
+ clock format 1667714400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.341 {time zone boundary case 2022-10-30 01:00:01} detroit {
- clock format 1667109601 -format {%H:%M:%S %z %Z} \
+test clock-5.341 {time zone boundary case 2022-11-06 01:00:01} detroit {
+ clock format 1667714401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.342 {time zone boundary case 2023-04-02 01:59:59} detroit {
- clock format 1680418799 -format {%H:%M:%S %z %Z} \
+test clock-5.342 {time zone boundary case 2023-03-12 01:59:59} detroit {
+ clock format 1678604399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.343 {time zone boundary case 2023-04-02 03:00:00} detroit {
- clock format 1680418800 -format {%H:%M:%S %z %Z} \
+test clock-5.343 {time zone boundary case 2023-03-12 03:00:00} detroit {
+ clock format 1678604400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.344 {time zone boundary case 2023-04-02 03:00:01} detroit {
- clock format 1680418801 -format {%H:%M:%S %z %Z} \
+test clock-5.344 {time zone boundary case 2023-03-12 03:00:01} detroit {
+ clock format 1678604401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.345 {time zone boundary case 2023-10-29 01:59:59} detroit {
- clock format 1698559199 -format {%H:%M:%S %z %Z} \
+test clock-5.345 {time zone boundary case 2023-11-05 01:59:59} detroit {
+ clock format 1699163999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.346 {time zone boundary case 2023-10-29 01:00:00} detroit {
- clock format 1698559200 -format {%H:%M:%S %z %Z} \
+test clock-5.346 {time zone boundary case 2023-11-05 01:00:00} detroit {
+ clock format 1699164000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.347 {time zone boundary case 2023-10-29 01:00:01} detroit {
- clock format 1698559201 -format {%H:%M:%S %z %Z} \
+test clock-5.347 {time zone boundary case 2023-11-05 01:00:01} detroit {
+ clock format 1699164001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.348 {time zone boundary case 2024-04-07 01:59:59} detroit {
- clock format 1712473199 -format {%H:%M:%S %z %Z} \
+test clock-5.348 {time zone boundary case 2024-03-10 01:59:59} detroit {
+ clock format 1710053999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.349 {time zone boundary case 2024-04-07 03:00:00} detroit {
- clock format 1712473200 -format {%H:%M:%S %z %Z} \
+test clock-5.349 {time zone boundary case 2024-03-10 03:00:00} detroit {
+ clock format 1710054000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.350 {time zone boundary case 2024-04-07 03:00:01} detroit {
- clock format 1712473201 -format {%H:%M:%S %z %Z} \
+test clock-5.350 {time zone boundary case 2024-03-10 03:00:01} detroit {
+ clock format 1710054001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.351 {time zone boundary case 2024-10-27 01:59:59} detroit {
- clock format 1730008799 -format {%H:%M:%S %z %Z} \
+test clock-5.351 {time zone boundary case 2024-11-03 01:59:59} detroit {
+ clock format 1730613599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.352 {time zone boundary case 2024-10-27 01:00:00} detroit {
- clock format 1730008800 -format {%H:%M:%S %z %Z} \
+test clock-5.352 {time zone boundary case 2024-11-03 01:00:00} detroit {
+ clock format 1730613600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.353 {time zone boundary case 2024-10-27 01:00:01} detroit {
- clock format 1730008801 -format {%H:%M:%S %z %Z} \
+test clock-5.353 {time zone boundary case 2024-11-03 01:00:01} detroit {
+ clock format 1730613601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.354 {time zone boundary case 2025-04-06 01:59:59} detroit {
- clock format 1743922799 -format {%H:%M:%S %z %Z} \
+test clock-5.354 {time zone boundary case 2025-03-09 01:59:59} detroit {
+ clock format 1741503599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.355 {time zone boundary case 2025-04-06 03:00:00} detroit {
- clock format 1743922800 -format {%H:%M:%S %z %Z} \
+test clock-5.355 {time zone boundary case 2025-03-09 03:00:00} detroit {
+ clock format 1741503600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.356 {time zone boundary case 2025-04-06 03:00:01} detroit {
- clock format 1743922801 -format {%H:%M:%S %z %Z} \
+test clock-5.356 {time zone boundary case 2025-03-09 03:00:01} detroit {
+ clock format 1741503601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.357 {time zone boundary case 2025-10-26 01:59:59} detroit {
- clock format 1761458399 -format {%H:%M:%S %z %Z} \
+test clock-5.357 {time zone boundary case 2025-11-02 01:59:59} detroit {
+ clock format 1762063199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.358 {time zone boundary case 2025-10-26 01:00:00} detroit {
- clock format 1761458400 -format {%H:%M:%S %z %Z} \
+test clock-5.358 {time zone boundary case 2025-11-02 01:00:00} detroit {
+ clock format 1762063200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.359 {time zone boundary case 2025-10-26 01:00:01} detroit {
- clock format 1761458401 -format {%H:%M:%S %z %Z} \
+test clock-5.359 {time zone boundary case 2025-11-02 01:00:01} detroit {
+ clock format 1762063201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.360 {time zone boundary case 2026-04-05 01:59:59} detroit {
- clock format 1775372399 -format {%H:%M:%S %z %Z} \
+test clock-5.360 {time zone boundary case 2026-03-08 01:59:59} detroit {
+ clock format 1772953199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.361 {time zone boundary case 2026-04-05 03:00:00} detroit {
- clock format 1775372400 -format {%H:%M:%S %z %Z} \
+test clock-5.361 {time zone boundary case 2026-03-08 03:00:00} detroit {
+ clock format 1772953200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.362 {time zone boundary case 2026-04-05 03:00:01} detroit {
- clock format 1775372401 -format {%H:%M:%S %z %Z} \
+test clock-5.362 {time zone boundary case 2026-03-08 03:00:01} detroit {
+ clock format 1772953201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.363 {time zone boundary case 2026-10-25 01:59:59} detroit {
- clock format 1792907999 -format {%H:%M:%S %z %Z} \
+test clock-5.363 {time zone boundary case 2026-11-01 01:59:59} detroit {
+ clock format 1793512799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.364 {time zone boundary case 2026-10-25 01:00:00} detroit {
- clock format 1792908000 -format {%H:%M:%S %z %Z} \
+test clock-5.364 {time zone boundary case 2026-11-01 01:00:00} detroit {
+ clock format 1793512800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.365 {time zone boundary case 2026-10-25 01:00:01} detroit {
- clock format 1792908001 -format {%H:%M:%S %z %Z} \
+test clock-5.365 {time zone boundary case 2026-11-01 01:00:01} detroit {
+ clock format 1793512801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.366 {time zone boundary case 2027-04-04 01:59:59} detroit {
- clock format 1806821999 -format {%H:%M:%S %z %Z} \
+test clock-5.366 {time zone boundary case 2027-03-14 01:59:59} detroit {
+ clock format 1805007599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.367 {time zone boundary case 2027-04-04 03:00:00} detroit {
- clock format 1806822000 -format {%H:%M:%S %z %Z} \
+test clock-5.367 {time zone boundary case 2027-03-14 03:00:00} detroit {
+ clock format 1805007600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.368 {time zone boundary case 2027-04-04 03:00:01} detroit {
- clock format 1806822001 -format {%H:%M:%S %z %Z} \
+test clock-5.368 {time zone boundary case 2027-03-14 03:00:01} detroit {
+ clock format 1805007601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.369 {time zone boundary case 2027-10-31 01:59:59} detroit {
- clock format 1824962399 -format {%H:%M:%S %z %Z} \
+test clock-5.369 {time zone boundary case 2027-11-07 01:59:59} detroit {
+ clock format 1825567199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.370 {time zone boundary case 2027-10-31 01:00:00} detroit {
- clock format 1824962400 -format {%H:%M:%S %z %Z} \
+test clock-5.370 {time zone boundary case 2027-11-07 01:00:00} detroit {
+ clock format 1825567200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.371 {time zone boundary case 2027-10-31 01:00:01} detroit {
- clock format 1824962401 -format {%H:%M:%S %z %Z} \
+test clock-5.371 {time zone boundary case 2027-11-07 01:00:01} detroit {
+ clock format 1825567201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.372 {time zone boundary case 2028-04-02 01:59:59} detroit {
- clock format 1838271599 -format {%H:%M:%S %z %Z} \
+test clock-5.372 {time zone boundary case 2028-03-12 01:59:59} detroit {
+ clock format 1836457199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.373 {time zone boundary case 2028-04-02 03:00:00} detroit {
- clock format 1838271600 -format {%H:%M:%S %z %Z} \
+test clock-5.373 {time zone boundary case 2028-03-12 03:00:00} detroit {
+ clock format 1836457200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.374 {time zone boundary case 2028-04-02 03:00:01} detroit {
- clock format 1838271601 -format {%H:%M:%S %z %Z} \
+test clock-5.374 {time zone boundary case 2028-03-12 03:00:01} detroit {
+ clock format 1836457201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.375 {time zone boundary case 2028-10-29 01:59:59} detroit {
- clock format 1856411999 -format {%H:%M:%S %z %Z} \
+test clock-5.375 {time zone boundary case 2028-11-05 01:59:59} detroit {
+ clock format 1857016799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.376 {time zone boundary case 2028-10-29 01:00:00} detroit {
- clock format 1856412000 -format {%H:%M:%S %z %Z} \
+test clock-5.376 {time zone boundary case 2028-11-05 01:00:00} detroit {
+ clock format 1857016800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.377 {time zone boundary case 2028-10-29 01:00:01} detroit {
- clock format 1856412001 -format {%H:%M:%S %z %Z} \
+test clock-5.377 {time zone boundary case 2028-11-05 01:00:01} detroit {
+ clock format 1857016801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.378 {time zone boundary case 2029-04-01 01:59:59} detroit {
- clock format 1869721199 -format {%H:%M:%S %z %Z} \
+test clock-5.378 {time zone boundary case 2029-03-11 01:59:59} detroit {
+ clock format 1867906799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.379 {time zone boundary case 2029-04-01 03:00:00} detroit {
- clock format 1869721200 -format {%H:%M:%S %z %Z} \
+test clock-5.379 {time zone boundary case 2029-03-11 03:00:00} detroit {
+ clock format 1867906800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.380 {time zone boundary case 2029-04-01 03:00:01} detroit {
- clock format 1869721201 -format {%H:%M:%S %z %Z} \
+test clock-5.380 {time zone boundary case 2029-03-11 03:00:01} detroit {
+ clock format 1867906801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.381 {time zone boundary case 2029-10-28 01:59:59} detroit {
- clock format 1887861599 -format {%H:%M:%S %z %Z} \
+test clock-5.381 {time zone boundary case 2029-11-04 01:59:59} detroit {
+ clock format 1888466399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.382 {time zone boundary case 2029-10-28 01:00:00} detroit {
- clock format 1887861600 -format {%H:%M:%S %z %Z} \
+test clock-5.382 {time zone boundary case 2029-11-04 01:00:00} detroit {
+ clock format 1888466400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.383 {time zone boundary case 2029-10-28 01:00:01} detroit {
- clock format 1887861601 -format {%H:%M:%S %z %Z} \
+test clock-5.383 {time zone boundary case 2029-11-04 01:00:01} detroit {
+ clock format 1888466401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.384 {time zone boundary case 2030-04-07 01:59:59} detroit {
- clock format 1901775599 -format {%H:%M:%S %z %Z} \
+test clock-5.384 {time zone boundary case 2030-03-10 01:59:59} detroit {
+ clock format 1899356399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.385 {time zone boundary case 2030-04-07 03:00:00} detroit {
- clock format 1901775600 -format {%H:%M:%S %z %Z} \
+test clock-5.385 {time zone boundary case 2030-03-10 03:00:00} detroit {
+ clock format 1899356400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.386 {time zone boundary case 2030-04-07 03:00:01} detroit {
- clock format 1901775601 -format {%H:%M:%S %z %Z} \
+test clock-5.386 {time zone boundary case 2030-03-10 03:00:01} detroit {
+ clock format 1899356401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.387 {time zone boundary case 2030-10-27 01:59:59} detroit {
- clock format 1919311199 -format {%H:%M:%S %z %Z} \
+test clock-5.387 {time zone boundary case 2030-11-03 01:59:59} detroit {
+ clock format 1919915999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.388 {time zone boundary case 2030-10-27 01:00:00} detroit {
- clock format 1919311200 -format {%H:%M:%S %z %Z} \
+test clock-5.388 {time zone boundary case 2030-11-03 01:00:00} detroit {
+ clock format 1919916000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.389 {time zone boundary case 2030-10-27 01:00:01} detroit {
- clock format 1919311201 -format {%H:%M:%S %z %Z} \
+test clock-5.389 {time zone boundary case 2030-11-03 01:00:01} detroit {
+ clock format 1919916001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.390 {time zone boundary case 2031-04-06 01:59:59} detroit {
- clock format 1933225199 -format {%H:%M:%S %z %Z} \
+test clock-5.390 {time zone boundary case 2031-03-09 01:59:59} detroit {
+ clock format 1930805999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.391 {time zone boundary case 2031-04-06 03:00:00} detroit {
- clock format 1933225200 -format {%H:%M:%S %z %Z} \
+test clock-5.391 {time zone boundary case 2031-03-09 03:00:00} detroit {
+ clock format 1930806000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.392 {time zone boundary case 2031-04-06 03:00:01} detroit {
- clock format 1933225201 -format {%H:%M:%S %z %Z} \
+test clock-5.392 {time zone boundary case 2031-03-09 03:00:01} detroit {
+ clock format 1930806001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.393 {time zone boundary case 2031-10-26 01:59:59} detroit {
- clock format 1950760799 -format {%H:%M:%S %z %Z} \
+test clock-5.393 {time zone boundary case 2031-11-02 01:59:59} detroit {
+ clock format 1951365599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.394 {time zone boundary case 2031-10-26 01:00:00} detroit {
- clock format 1950760800 -format {%H:%M:%S %z %Z} \
+test clock-5.394 {time zone boundary case 2031-11-02 01:00:00} detroit {
+ clock format 1951365600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.395 {time zone boundary case 2031-10-26 01:00:01} detroit {
- clock format 1950760801 -format {%H:%M:%S %z %Z} \
+test clock-5.395 {time zone boundary case 2031-11-02 01:00:01} detroit {
+ clock format 1951365601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.396 {time zone boundary case 2032-04-04 01:59:59} detroit {
- clock format 1964674799 -format {%H:%M:%S %z %Z} \
+test clock-5.396 {time zone boundary case 2032-03-14 01:59:59} detroit {
+ clock format 1962860399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.397 {time zone boundary case 2032-04-04 03:00:00} detroit {
- clock format 1964674800 -format {%H:%M:%S %z %Z} \
+test clock-5.397 {time zone boundary case 2032-03-14 03:00:00} detroit {
+ clock format 1962860400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.398 {time zone boundary case 2032-04-04 03:00:01} detroit {
- clock format 1964674801 -format {%H:%M:%S %z %Z} \
+test clock-5.398 {time zone boundary case 2032-03-14 03:00:01} detroit {
+ clock format 1962860401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.399 {time zone boundary case 2032-10-31 01:59:59} detroit {
- clock format 1982815199 -format {%H:%M:%S %z %Z} \
+test clock-5.399 {time zone boundary case 2032-11-07 01:59:59} detroit {
+ clock format 1983419999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.400 {time zone boundary case 2032-10-31 01:00:00} detroit {
- clock format 1982815200 -format {%H:%M:%S %z %Z} \
+test clock-5.400 {time zone boundary case 2032-11-07 01:00:00} detroit {
+ clock format 1983420000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.401 {time zone boundary case 2032-10-31 01:00:01} detroit {
- clock format 1982815201 -format {%H:%M:%S %z %Z} \
+test clock-5.401 {time zone boundary case 2032-11-07 01:00:01} detroit {
+ clock format 1983420001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.402 {time zone boundary case 2033-04-03 01:59:59} detroit {
- clock format 1996124399 -format {%H:%M:%S %z %Z} \
+test clock-5.402 {time zone boundary case 2033-03-13 01:59:59} detroit {
+ clock format 1994309999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.403 {time zone boundary case 2033-04-03 03:00:00} detroit {
- clock format 1996124400 -format {%H:%M:%S %z %Z} \
+test clock-5.403 {time zone boundary case 2033-03-13 03:00:00} detroit {
+ clock format 1994310000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.404 {time zone boundary case 2033-04-03 03:00:01} detroit {
- clock format 1996124401 -format {%H:%M:%S %z %Z} \
+test clock-5.404 {time zone boundary case 2033-03-13 03:00:01} detroit {
+ clock format 1994310001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.405 {time zone boundary case 2033-10-30 01:59:59} detroit {
- clock format 2014264799 -format {%H:%M:%S %z %Z} \
+test clock-5.405 {time zone boundary case 2033-11-06 01:59:59} detroit {
+ clock format 2014869599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.406 {time zone boundary case 2033-10-30 01:00:00} detroit {
- clock format 2014264800 -format {%H:%M:%S %z %Z} \
+test clock-5.406 {time zone boundary case 2033-11-06 01:00:00} detroit {
+ clock format 2014869600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.407 {time zone boundary case 2033-10-30 01:00:01} detroit {
- clock format 2014264801 -format {%H:%M:%S %z %Z} \
+test clock-5.407 {time zone boundary case 2033-11-06 01:00:01} detroit {
+ clock format 2014869601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.408 {time zone boundary case 2034-04-02 01:59:59} detroit {
- clock format 2027573999 -format {%H:%M:%S %z %Z} \
+test clock-5.408 {time zone boundary case 2034-03-12 01:59:59} detroit {
+ clock format 2025759599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.409 {time zone boundary case 2034-04-02 03:00:00} detroit {
- clock format 2027574000 -format {%H:%M:%S %z %Z} \
+test clock-5.409 {time zone boundary case 2034-03-12 03:00:00} detroit {
+ clock format 2025759600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.410 {time zone boundary case 2034-04-02 03:00:01} detroit {
- clock format 2027574001 -format {%H:%M:%S %z %Z} \
+test clock-5.410 {time zone boundary case 2034-03-12 03:00:01} detroit {
+ clock format 2025759601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.411 {time zone boundary case 2034-10-29 01:59:59} detroit {
- clock format 2045714399 -format {%H:%M:%S %z %Z} \
+test clock-5.411 {time zone boundary case 2034-11-05 01:59:59} detroit {
+ clock format 2046319199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.412 {time zone boundary case 2034-10-29 01:00:00} detroit {
- clock format 2045714400 -format {%H:%M:%S %z %Z} \
+test clock-5.412 {time zone boundary case 2034-11-05 01:00:00} detroit {
+ clock format 2046319200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.413 {time zone boundary case 2034-10-29 01:00:01} detroit {
- clock format 2045714401 -format {%H:%M:%S %z %Z} \
+test clock-5.413 {time zone boundary case 2034-11-05 01:00:01} detroit {
+ clock format 2046319201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.414 {time zone boundary case 2035-04-01 01:59:59} detroit {
- clock format 2059023599 -format {%H:%M:%S %z %Z} \
+test clock-5.414 {time zone boundary case 2035-03-11 01:59:59} detroit {
+ clock format 2057209199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.415 {time zone boundary case 2035-04-01 03:00:00} detroit {
- clock format 2059023600 -format {%H:%M:%S %z %Z} \
+test clock-5.415 {time zone boundary case 2035-03-11 03:00:00} detroit {
+ clock format 2057209200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.416 {time zone boundary case 2035-04-01 03:00:01} detroit {
- clock format 2059023601 -format {%H:%M:%S %z %Z} \
+test clock-5.416 {time zone boundary case 2035-03-11 03:00:01} detroit {
+ clock format 2057209201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.417 {time zone boundary case 2035-10-28 01:59:59} detroit {
- clock format 2077163999 -format {%H:%M:%S %z %Z} \
+test clock-5.417 {time zone boundary case 2035-11-04 01:59:59} detroit {
+ clock format 2077768799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.418 {time zone boundary case 2035-10-28 01:00:00} detroit {
- clock format 2077164000 -format {%H:%M:%S %z %Z} \
+test clock-5.418 {time zone boundary case 2035-11-04 01:00:00} detroit {
+ clock format 2077768800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.419 {time zone boundary case 2035-10-28 01:00:01} detroit {
- clock format 2077164001 -format {%H:%M:%S %z %Z} \
+test clock-5.419 {time zone boundary case 2035-11-04 01:00:01} detroit {
+ clock format 2077768801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.420 {time zone boundary case 2036-04-06 01:59:59} detroit {
- clock format 2091077999 -format {%H:%M:%S %z %Z} \
+test clock-5.420 {time zone boundary case 2036-03-09 01:59:59} detroit {
+ clock format 2088658799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.421 {time zone boundary case 2036-04-06 03:00:00} detroit {
- clock format 2091078000 -format {%H:%M:%S %z %Z} \
+test clock-5.421 {time zone boundary case 2036-03-09 03:00:00} detroit {
+ clock format 2088658800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.422 {time zone boundary case 2036-04-06 03:00:01} detroit {
- clock format 2091078001 -format {%H:%M:%S %z %Z} \
+test clock-5.422 {time zone boundary case 2036-03-09 03:00:01} detroit {
+ clock format 2088658801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.423 {time zone boundary case 2036-10-26 01:59:59} detroit {
- clock format 2108613599 -format {%H:%M:%S %z %Z} \
+test clock-5.423 {time zone boundary case 2036-11-02 01:59:59} detroit {
+ clock format 2109218399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.424 {time zone boundary case 2036-10-26 01:00:00} detroit {
- clock format 2108613600 -format {%H:%M:%S %z %Z} \
+test clock-5.424 {time zone boundary case 2036-11-02 01:00:00} detroit {
+ clock format 2109218400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.425 {time zone boundary case 2036-10-26 01:00:01} detroit {
- clock format 2108613601 -format {%H:%M:%S %z %Z} \
+test clock-5.425 {time zone boundary case 2036-11-02 01:00:01} detroit {
+ clock format 2109218401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.426 {time zone boundary case 2037-04-05 01:59:59} detroit {
- clock format 2122527599 -format {%H:%M:%S %z %Z} \
+test clock-5.426 {time zone boundary case 2037-03-08 01:59:59} detroit {
+ clock format 2120108399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.427 {time zone boundary case 2037-04-05 03:00:00} detroit {
- clock format 2122527600 -format {%H:%M:%S %z %Z} \
+test clock-5.427 {time zone boundary case 2037-03-08 03:00:00} detroit {
+ clock format 2120108400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.428 {time zone boundary case 2037-04-05 03:00:01} detroit {
- clock format 2122527601 -format {%H:%M:%S %z %Z} \
+test clock-5.428 {time zone boundary case 2037-03-08 03:00:01} detroit {
+ clock format 2120108401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.429 {time zone boundary case 2037-10-25 01:59:59} detroit {
- clock format 2140063199 -format {%H:%M:%S %z %Z} \
+test clock-5.429 {time zone boundary case 2037-11-01 01:59:59} detroit {
+ clock format 2140667999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.430 {time zone boundary case 2037-10-25 01:00:00} detroit {
- clock format 2140063200 -format {%H:%M:%S %z %Z} \
+test clock-5.430 {time zone boundary case 2037-11-01 01:00:00} detroit {
+ clock format 2140668000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.431 {time zone boundary case 2037-10-25 01:00:01} detroit {
- clock format 2140063201 -format {%H:%M:%S %z %Z} \
+test clock-5.431 {time zone boundary case 2037-11-01 01:00:01} detroit {
+ clock format 2140668001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.432 {time zone boundary case 2038-04-04 01:59:59} {detroit y2038} {
- clock format 2153977199 -format {%H:%M:%S %z %Z} \
+test clock-5.432 {time zone boundary case 2038-03-14 01:59:59} {detroit y2038} {
+ clock format 2152162799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.433 {time zone boundary case 2038-04-04 03:00:00} {detroit y2038} {
- clock format 2153977200 -format {%H:%M:%S %z %Z} \
+test clock-5.433 {time zone boundary case 2038-03-14 03:00:00} {detroit y2038} {
+ clock format 2152162800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.434 {time zone boundary case 2038-04-04 03:00:01} {detroit y2038} {
- clock format 2153977201 -format {%H:%M:%S %z %Z} \
+test clock-5.434 {time zone boundary case 2038-03-14 03:00:01} {detroit y2038} {
+ clock format 2152162801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.435 {time zone boundary case 2038-10-31 01:59:59} {detroit y2038} {
- clock format 2172117599 -format {%H:%M:%S %z %Z} \
+test clock-5.435 {time zone boundary case 2038-11-07 01:59:59} {detroit y2038} {
+ clock format 2172722399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.436 {time zone boundary case 2038-10-31 01:00:00} {detroit y2038} {
- clock format 2172117600 -format {%H:%M:%S %z %Z} \
+test clock-5.436 {time zone boundary case 2038-11-07 01:00:00} {detroit y2038} {
+ clock format 2172722400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.437 {time zone boundary case 2038-10-31 01:00:01} {detroit y2038} {
- clock format 2172117601 -format {%H:%M:%S %z %Z} \
+test clock-5.437 {time zone boundary case 2038-11-07 01:00:01} {detroit y2038} {
+ clock format 2172722401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.438 {time zone boundary case 2039-04-03 01:59:59} {detroit y2038} {
- clock format 2185426799 -format {%H:%M:%S %z %Z} \
+test clock-5.438 {time zone boundary case 2039-03-13 01:59:59} {detroit y2038} {
+ clock format 2183612399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.439 {time zone boundary case 2039-04-03 03:00:00} {detroit y2038} {
- clock format 2185426800 -format {%H:%M:%S %z %Z} \
+test clock-5.439 {time zone boundary case 2039-03-13 03:00:00} {detroit y2038} {
+ clock format 2183612400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.440 {time zone boundary case 2039-04-03 03:00:01} {detroit y2038} {
- clock format 2185426801 -format {%H:%M:%S %z %Z} \
+test clock-5.440 {time zone boundary case 2039-03-13 03:00:01} {detroit y2038} {
+ clock format 2183612401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.441 {time zone boundary case 2039-10-30 01:59:59} {detroit y2038} {
- clock format 2203567199 -format {%H:%M:%S %z %Z} \
+test clock-5.441 {time zone boundary case 2039-11-06 01:59:59} {detroit y2038} {
+ clock format 2204171999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.442 {time zone boundary case 2039-10-30 01:00:00} {detroit y2038} {
- clock format 2203567200 -format {%H:%M:%S %z %Z} \
+test clock-5.442 {time zone boundary case 2039-11-06 01:00:00} {detroit y2038} {
+ clock format 2204172000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.443 {time zone boundary case 2039-10-30 01:00:01} {detroit y2038} {
- clock format 2203567201 -format {%H:%M:%S %z %Z} \
+test clock-5.443 {time zone boundary case 2039-11-06 01:00:01} {detroit y2038} {
+ clock format 2204172001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.444 {time zone boundary case 2040-04-01 01:59:59} {detroit y2038} {
- clock format 2216876399 -format {%H:%M:%S %z %Z} \
+test clock-5.444 {time zone boundary case 2040-03-11 01:59:59} {detroit y2038} {
+ clock format 2215061999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.445 {time zone boundary case 2040-04-01 03:00:00} {detroit y2038} {
- clock format 2216876400 -format {%H:%M:%S %z %Z} \
+test clock-5.445 {time zone boundary case 2040-03-11 03:00:00} {detroit y2038} {
+ clock format 2215062000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.446 {time zone boundary case 2040-04-01 03:00:01} {detroit y2038} {
- clock format 2216876401 -format {%H:%M:%S %z %Z} \
+test clock-5.446 {time zone boundary case 2040-03-11 03:00:01} {detroit y2038} {
+ clock format 2215062001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.447 {time zone boundary case 2040-10-28 01:59:59} {detroit y2038} {
- clock format 2235016799 -format {%H:%M:%S %z %Z} \
+test clock-5.447 {time zone boundary case 2040-11-04 01:59:59} {detroit y2038} {
+ clock format 2235621599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.448 {time zone boundary case 2040-10-28 01:00:00} {detroit y2038} {
- clock format 2235016800 -format {%H:%M:%S %z %Z} \
+test clock-5.448 {time zone boundary case 2040-11-04 01:00:00} {detroit y2038} {
+ clock format 2235621600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.449 {time zone boundary case 2040-10-28 01:00:01} {detroit y2038} {
- clock format 2235016801 -format {%H:%M:%S %z %Z} \
+test clock-5.449 {time zone boundary case 2040-11-04 01:00:01} {detroit y2038} {
+ clock format 2235621601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.450 {time zone boundary case 2041-04-07 01:59:59} {detroit y2038} {
- clock format 2248930799 -format {%H:%M:%S %z %Z} \
+test clock-5.450 {time zone boundary case 2041-03-10 01:59:59} {detroit y2038} {
+ clock format 2246511599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.451 {time zone boundary case 2041-04-07 03:00:00} {detroit y2038} {
- clock format 2248930800 -format {%H:%M:%S %z %Z} \
+test clock-5.451 {time zone boundary case 2041-03-10 03:00:00} {detroit y2038} {
+ clock format 2246511600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.452 {time zone boundary case 2041-04-07 03:00:01} {detroit y2038} {
- clock format 2248930801 -format {%H:%M:%S %z %Z} \
+test clock-5.452 {time zone boundary case 2041-03-10 03:00:01} {detroit y2038} {
+ clock format 2246511601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.453 {time zone boundary case 2041-10-27 01:59:59} {detroit y2038} {
- clock format 2266466399 -format {%H:%M:%S %z %Z} \
+test clock-5.453 {time zone boundary case 2041-11-03 01:59:59} {detroit y2038} {
+ clock format 2267071199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.454 {time zone boundary case 2041-10-27 01:00:00} {detroit y2038} {
- clock format 2266466400 -format {%H:%M:%S %z %Z} \
+test clock-5.454 {time zone boundary case 2041-11-03 01:00:00} {detroit y2038} {
+ clock format 2267071200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.455 {time zone boundary case 2041-10-27 01:00:01} {detroit y2038} {
- clock format 2266466401 -format {%H:%M:%S %z %Z} \
+test clock-5.455 {time zone boundary case 2041-11-03 01:00:01} {detroit y2038} {
+ clock format 2267071201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.456 {time zone boundary case 2042-04-06 01:59:59} {detroit y2038} {
- clock format 2280380399 -format {%H:%M:%S %z %Z} \
+test clock-5.456 {time zone boundary case 2042-03-09 01:59:59} {detroit y2038} {
+ clock format 2277961199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.457 {time zone boundary case 2042-04-06 03:00:00} {detroit y2038} {
- clock format 2280380400 -format {%H:%M:%S %z %Z} \
+test clock-5.457 {time zone boundary case 2042-03-09 03:00:00} {detroit y2038} {
+ clock format 2277961200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.458 {time zone boundary case 2042-04-06 03:00:01} {detroit y2038} {
- clock format 2280380401 -format {%H:%M:%S %z %Z} \
+test clock-5.458 {time zone boundary case 2042-03-09 03:00:01} {detroit y2038} {
+ clock format 2277961201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.459 {time zone boundary case 2042-10-26 01:59:59} {detroit y2038} {
- clock format 2297915999 -format {%H:%M:%S %z %Z} \
+test clock-5.459 {time zone boundary case 2042-11-02 01:59:59} {detroit y2038} {
+ clock format 2298520799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.460 {time zone boundary case 2042-10-26 01:00:00} {detroit y2038} {
- clock format 2297916000 -format {%H:%M:%S %z %Z} \
+test clock-5.460 {time zone boundary case 2042-11-02 01:00:00} {detroit y2038} {
+ clock format 2298520800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.461 {time zone boundary case 2042-10-26 01:00:01} {detroit y2038} {
- clock format 2297916001 -format {%H:%M:%S %z %Z} \
+test clock-5.461 {time zone boundary case 2042-11-02 01:00:01} {detroit y2038} {
+ clock format 2298520801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.462 {time zone boundary case 2043-04-05 01:59:59} {detroit y2038} {
- clock format 2311829999 -format {%H:%M:%S %z %Z} \
+test clock-5.462 {time zone boundary case 2043-03-08 01:59:59} {detroit y2038} {
+ clock format 2309410799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.463 {time zone boundary case 2043-04-05 03:00:00} {detroit y2038} {
- clock format 2311830000 -format {%H:%M:%S %z %Z} \
+test clock-5.463 {time zone boundary case 2043-03-08 03:00:00} {detroit y2038} {
+ clock format 2309410800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.464 {time zone boundary case 2043-04-05 03:00:01} {detroit y2038} {
- clock format 2311830001 -format {%H:%M:%S %z %Z} \
+test clock-5.464 {time zone boundary case 2043-03-08 03:00:01} {detroit y2038} {
+ clock format 2309410801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.465 {time zone boundary case 2043-10-25 01:59:59} {detroit y2038} {
- clock format 2329365599 -format {%H:%M:%S %z %Z} \
+test clock-5.465 {time zone boundary case 2043-11-01 01:59:59} {detroit y2038} {
+ clock format 2329970399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.466 {time zone boundary case 2043-10-25 01:00:00} {detroit y2038} {
- clock format 2329365600 -format {%H:%M:%S %z %Z} \
+test clock-5.466 {time zone boundary case 2043-11-01 01:00:00} {detroit y2038} {
+ clock format 2329970400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.467 {time zone boundary case 2043-10-25 01:00:01} {detroit y2038} {
- clock format 2329365601 -format {%H:%M:%S %z %Z} \
+test clock-5.467 {time zone boundary case 2043-11-01 01:00:01} {detroit y2038} {
+ clock format 2329970401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.468 {time zone boundary case 2044-04-03 01:59:59} {detroit y2038} {
- clock format 2343279599 -format {%H:%M:%S %z %Z} \
+test clock-5.468 {time zone boundary case 2044-03-13 01:59:59} {detroit y2038} {
+ clock format 2341465199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.469 {time zone boundary case 2044-04-03 03:00:00} {detroit y2038} {
- clock format 2343279600 -format {%H:%M:%S %z %Z} \
+test clock-5.469 {time zone boundary case 2044-03-13 03:00:00} {detroit y2038} {
+ clock format 2341465200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.470 {time zone boundary case 2044-04-03 03:00:01} {detroit y2038} {
- clock format 2343279601 -format {%H:%M:%S %z %Z} \
+test clock-5.470 {time zone boundary case 2044-03-13 03:00:01} {detroit y2038} {
+ clock format 2341465201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.471 {time zone boundary case 2044-10-30 01:59:59} {detroit y2038} {
- clock format 2361419999 -format {%H:%M:%S %z %Z} \
+test clock-5.471 {time zone boundary case 2044-11-06 01:59:59} {detroit y2038} {
+ clock format 2362024799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.472 {time zone boundary case 2044-10-30 01:00:00} {detroit y2038} {
- clock format 2361420000 -format {%H:%M:%S %z %Z} \
+test clock-5.472 {time zone boundary case 2044-11-06 01:00:00} {detroit y2038} {
+ clock format 2362024800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.473 {time zone boundary case 2044-10-30 01:00:01} {detroit y2038} {
- clock format 2361420001 -format {%H:%M:%S %z %Z} \
+test clock-5.473 {time zone boundary case 2044-11-06 01:00:01} {detroit y2038} {
+ clock format 2362024801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.474 {time zone boundary case 2045-04-02 01:59:59} {detroit y2038} {
- clock format 2374729199 -format {%H:%M:%S %z %Z} \
+test clock-5.474 {time zone boundary case 2045-03-12 01:59:59} {detroit y2038} {
+ clock format 2372914799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.475 {time zone boundary case 2045-04-02 03:00:00} {detroit y2038} {
- clock format 2374729200 -format {%H:%M:%S %z %Z} \
+test clock-5.475 {time zone boundary case 2045-03-12 03:00:00} {detroit y2038} {
+ clock format 2372914800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.476 {time zone boundary case 2045-04-02 03:00:01} {detroit y2038} {
- clock format 2374729201 -format {%H:%M:%S %z %Z} \
+test clock-5.476 {time zone boundary case 2045-03-12 03:00:01} {detroit y2038} {
+ clock format 2372914801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.477 {time zone boundary case 2045-10-29 01:59:59} {detroit y2038} {
- clock format 2392869599 -format {%H:%M:%S %z %Z} \
+test clock-5.477 {time zone boundary case 2045-11-05 01:59:59} {detroit y2038} {
+ clock format 2393474399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.478 {time zone boundary case 2045-10-29 01:00:00} {detroit y2038} {
- clock format 2392869600 -format {%H:%M:%S %z %Z} \
+test clock-5.478 {time zone boundary case 2045-11-05 01:00:00} {detroit y2038} {
+ clock format 2393474400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.479 {time zone boundary case 2045-10-29 01:00:01} {detroit y2038} {
- clock format 2392869601 -format {%H:%M:%S %z %Z} \
+test clock-5.479 {time zone boundary case 2045-11-05 01:00:01} {detroit y2038} {
+ clock format 2393474401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.480 {time zone boundary case 2046-04-01 01:59:59} {detroit y2038} {
- clock format 2406178799 -format {%H:%M:%S %z %Z} \
+test clock-5.480 {time zone boundary case 2046-03-11 01:59:59} {detroit y2038} {
+ clock format 2404364399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.481 {time zone boundary case 2046-04-01 03:00:00} {detroit y2038} {
- clock format 2406178800 -format {%H:%M:%S %z %Z} \
+test clock-5.481 {time zone boundary case 2046-03-11 03:00:00} {detroit y2038} {
+ clock format 2404364400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.482 {time zone boundary case 2046-04-01 03:00:01} {detroit y2038} {
- clock format 2406178801 -format {%H:%M:%S %z %Z} \
+test clock-5.482 {time zone boundary case 2046-03-11 03:00:01} {detroit y2038} {
+ clock format 2404364401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.483 {time zone boundary case 2046-10-28 01:59:59} {detroit y2038} {
- clock format 2424319199 -format {%H:%M:%S %z %Z} \
+test clock-5.483 {time zone boundary case 2046-11-04 01:59:59} {detroit y2038} {
+ clock format 2424923999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.484 {time zone boundary case 2046-10-28 01:00:00} {detroit y2038} {
- clock format 2424319200 -format {%H:%M:%S %z %Z} \
+test clock-5.484 {time zone boundary case 2046-11-04 01:00:00} {detroit y2038} {
+ clock format 2424924000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.485 {time zone boundary case 2046-10-28 01:00:01} {detroit y2038} {
- clock format 2424319201 -format {%H:%M:%S %z %Z} \
+test clock-5.485 {time zone boundary case 2046-11-04 01:00:01} {detroit y2038} {
+ clock format 2424924001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.486 {time zone boundary case 2047-04-07 01:59:59} {detroit y2038} {
- clock format 2438233199 -format {%H:%M:%S %z %Z} \
+test clock-5.486 {time zone boundary case 2047-03-10 01:59:59} {detroit y2038} {
+ clock format 2435813999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.487 {time zone boundary case 2047-04-07 03:00:00} {detroit y2038} {
- clock format 2438233200 -format {%H:%M:%S %z %Z} \
+test clock-5.487 {time zone boundary case 2047-03-10 03:00:00} {detroit y2038} {
+ clock format 2435814000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.488 {time zone boundary case 2047-04-07 03:00:01} {detroit y2038} {
- clock format 2438233201 -format {%H:%M:%S %z %Z} \
+test clock-5.488 {time zone boundary case 2047-03-10 03:00:01} {detroit y2038} {
+ clock format 2435814001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.489 {time zone boundary case 2047-10-27 01:59:59} {detroit y2038} {
- clock format 2455768799 -format {%H:%M:%S %z %Z} \
+test clock-5.489 {time zone boundary case 2047-11-03 01:59:59} {detroit y2038} {
+ clock format 2456373599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.490 {time zone boundary case 2047-10-27 01:00:00} {detroit y2038} {
- clock format 2455768800 -format {%H:%M:%S %z %Z} \
+test clock-5.490 {time zone boundary case 2047-11-03 01:00:00} {detroit y2038} {
+ clock format 2456373600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.491 {time zone boundary case 2047-10-27 01:00:01} {detroit y2038} {
- clock format 2455768801 -format {%H:%M:%S %z %Z} \
+test clock-5.491 {time zone boundary case 2047-11-03 01:00:01} {detroit y2038} {
+ clock format 2456373601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.492 {time zone boundary case 2048-04-05 01:59:59} {detroit y2038} {
- clock format 2469682799 -format {%H:%M:%S %z %Z} \
+test clock-5.492 {time zone boundary case 2048-03-08 01:59:59} {detroit y2038} {
+ clock format 2467263599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.493 {time zone boundary case 2048-04-05 03:00:00} {detroit y2038} {
- clock format 2469682800 -format {%H:%M:%S %z %Z} \
+test clock-5.493 {time zone boundary case 2048-03-08 03:00:00} {detroit y2038} {
+ clock format 2467263600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.494 {time zone boundary case 2048-04-05 03:00:01} {detroit y2038} {
- clock format 2469682801 -format {%H:%M:%S %z %Z} \
+test clock-5.494 {time zone boundary case 2048-03-08 03:00:01} {detroit y2038} {
+ clock format 2467263601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.495 {time zone boundary case 2048-10-25 01:59:59} {detroit y2038} {
- clock format 2487218399 -format {%H:%M:%S %z %Z} \
+test clock-5.495 {time zone boundary case 2048-11-01 01:59:59} {detroit y2038} {
+ clock format 2487823199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.496 {time zone boundary case 2048-10-25 01:00:00} {detroit y2038} {
- clock format 2487218400 -format {%H:%M:%S %z %Z} \
+test clock-5.496 {time zone boundary case 2048-11-01 01:00:00} {detroit y2038} {
+ clock format 2487823200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.497 {time zone boundary case 2048-10-25 01:00:01} {detroit y2038} {
- clock format 2487218401 -format {%H:%M:%S %z %Z} \
+test clock-5.497 {time zone boundary case 2048-11-01 01:00:01} {detroit y2038} {
+ clock format 2487823201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.498 {time zone boundary case 2049-04-04 01:59:59} {detroit y2038} {
- clock format 2501132399 -format {%H:%M:%S %z %Z} \
+test clock-5.498 {time zone boundary case 2049-03-14 01:59:59} {detroit y2038} {
+ clock format 2499317999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.499 {time zone boundary case 2049-04-04 03:00:00} {detroit y2038} {
- clock format 2501132400 -format {%H:%M:%S %z %Z} \
+test clock-5.499 {time zone boundary case 2049-03-14 03:00:00} {detroit y2038} {
+ clock format 2499318000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.500 {time zone boundary case 2049-04-04 03:00:01} {detroit y2038} {
- clock format 2501132401 -format {%H:%M:%S %z %Z} \
+test clock-5.500 {time zone boundary case 2049-03-14 03:00:01} {detroit y2038} {
+ clock format 2499318001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.501 {time zone boundary case 2049-10-31 01:59:59} {detroit y2038} {
- clock format 2519272799 -format {%H:%M:%S %z %Z} \
+test clock-5.501 {time zone boundary case 2049-11-07 01:59:59} {detroit y2038} {
+ clock format 2519877599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.502 {time zone boundary case 2049-10-31 01:00:00} {detroit y2038} {
- clock format 2519272800 -format {%H:%M:%S %z %Z} \
+test clock-5.502 {time zone boundary case 2049-11-07 01:00:00} {detroit y2038} {
+ clock format 2519877600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.503 {time zone boundary case 2049-10-31 01:00:01} {detroit y2038} {
- clock format 2519272801 -format {%H:%M:%S %z %Z} \
+test clock-5.503 {time zone boundary case 2049-11-07 01:00:01} {detroit y2038} {
+ clock format 2519877601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.504 {time zone boundary case 2050-04-03 01:59:59} {detroit y2038} {
- clock format 2532581999 -format {%H:%M:%S %z %Z} \
+test clock-5.504 {time zone boundary case 2050-03-13 01:59:59} {detroit y2038} {
+ clock format 2530767599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.505 {time zone boundary case 2050-04-03 03:00:00} {detroit y2038} {
- clock format 2532582000 -format {%H:%M:%S %z %Z} \
+test clock-5.505 {time zone boundary case 2050-03-13 03:00:00} {detroit y2038} {
+ clock format 2530767600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.506 {time zone boundary case 2050-04-03 03:00:01} {detroit y2038} {
- clock format 2532582001 -format {%H:%M:%S %z %Z} \
+test clock-5.506 {time zone boundary case 2050-03-13 03:00:01} {detroit y2038} {
+ clock format 2530767601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.507 {time zone boundary case 2050-10-30 01:59:59} {detroit y2038} {
- clock format 2550722399 -format {%H:%M:%S %z %Z} \
+test clock-5.507 {time zone boundary case 2050-11-06 01:59:59} {detroit y2038} {
+ clock format 2551327199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.508 {time zone boundary case 2050-10-30 01:00:00} {detroit y2038} {
- clock format 2550722400 -format {%H:%M:%S %z %Z} \
+test clock-5.508 {time zone boundary case 2050-11-06 01:00:00} {detroit y2038} {
+ clock format 2551327200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.509 {time zone boundary case 2050-10-30 01:00:01} {detroit y2038} {
- clock format 2550722401 -format {%H:%M:%S %z %Z} \
+test clock-5.509 {time zone boundary case 2050-11-06 01:00:01} {detroit y2038} {
+ clock format 2551327201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.510 {time zone boundary case 2051-04-02 01:59:59} {detroit y2038} {
- clock format 2564031599 -format {%H:%M:%S %z %Z} \
+test clock-5.510 {time zone boundary case 2051-03-12 01:59:59} {detroit y2038} {
+ clock format 2562217199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.511 {time zone boundary case 2051-04-02 03:00:00} {detroit y2038} {
- clock format 2564031600 -format {%H:%M:%S %z %Z} \
+test clock-5.511 {time zone boundary case 2051-03-12 03:00:00} {detroit y2038} {
+ clock format 2562217200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.512 {time zone boundary case 2051-04-02 03:00:01} {detroit y2038} {
- clock format 2564031601 -format {%H:%M:%S %z %Z} \
+test clock-5.512 {time zone boundary case 2051-03-12 03:00:01} {detroit y2038} {
+ clock format 2562217201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.513 {time zone boundary case 2051-10-29 01:59:59} {detroit y2038} {
- clock format 2582171999 -format {%H:%M:%S %z %Z} \
+test clock-5.513 {time zone boundary case 2051-11-05 01:59:59} {detroit y2038} {
+ clock format 2582776799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.514 {time zone boundary case 2051-10-29 01:00:00} {detroit y2038} {
- clock format 2582172000 -format {%H:%M:%S %z %Z} \
+test clock-5.514 {time zone boundary case 2051-11-05 01:00:00} {detroit y2038} {
+ clock format 2582776800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.515 {time zone boundary case 2051-10-29 01:00:01} {detroit y2038} {
- clock format 2582172001 -format {%H:%M:%S %z %Z} \
+test clock-5.515 {time zone boundary case 2051-11-05 01:00:01} {detroit y2038} {
+ clock format 2582776801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.516 {time zone boundary case 2052-04-07 01:59:59} {detroit y2038} {
- clock format 2596085999 -format {%H:%M:%S %z %Z} \
+test clock-5.516 {time zone boundary case 2052-03-10 01:59:59} {detroit y2038} {
+ clock format 2593666799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.517 {time zone boundary case 2052-04-07 03:00:00} {detroit y2038} {
- clock format 2596086000 -format {%H:%M:%S %z %Z} \
+test clock-5.517 {time zone boundary case 2052-03-10 03:00:00} {detroit y2038} {
+ clock format 2593666800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.518 {time zone boundary case 2052-04-07 03:00:01} {detroit y2038} {
- clock format 2596086001 -format {%H:%M:%S %z %Z} \
+test clock-5.518 {time zone boundary case 2052-03-10 03:00:01} {detroit y2038} {
+ clock format 2593666801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.519 {time zone boundary case 2052-10-27 01:59:59} {detroit y2038} {
- clock format 2613621599 -format {%H:%M:%S %z %Z} \
+test clock-5.519 {time zone boundary case 2052-11-03 01:59:59} {detroit y2038} {
+ clock format 2614226399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.520 {time zone boundary case 2052-10-27 01:00:00} {detroit y2038} {
- clock format 2613621600 -format {%H:%M:%S %z %Z} \
+test clock-5.520 {time zone boundary case 2052-11-03 01:00:00} {detroit y2038} {
+ clock format 2614226400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.521 {time zone boundary case 2052-10-27 01:00:01} {detroit y2038} {
- clock format 2613621601 -format {%H:%M:%S %z %Z} \
+test clock-5.521 {time zone boundary case 2052-11-03 01:00:01} {detroit y2038} {
+ clock format 2614226401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.522 {time zone boundary case 2053-04-06 01:59:59} {detroit y2038} {
- clock format 2627535599 -format {%H:%M:%S %z %Z} \
+test clock-5.522 {time zone boundary case 2053-03-09 01:59:59} {detroit y2038} {
+ clock format 2625116399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.523 {time zone boundary case 2053-04-06 03:00:00} {detroit y2038} {
- clock format 2627535600 -format {%H:%M:%S %z %Z} \
+test clock-5.523 {time zone boundary case 2053-03-09 03:00:00} {detroit y2038} {
+ clock format 2625116400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.524 {time zone boundary case 2053-04-06 03:00:01} {detroit y2038} {
- clock format 2627535601 -format {%H:%M:%S %z %Z} \
+test clock-5.524 {time zone boundary case 2053-03-09 03:00:01} {detroit y2038} {
+ clock format 2625116401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.525 {time zone boundary case 2053-10-26 01:59:59} {detroit y2038} {
- clock format 2645071199 -format {%H:%M:%S %z %Z} \
+test clock-5.525 {time zone boundary case 2053-11-02 01:59:59} {detroit y2038} {
+ clock format 2645675999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.526 {time zone boundary case 2053-10-26 01:00:00} {detroit y2038} {
- clock format 2645071200 -format {%H:%M:%S %z %Z} \
+test clock-5.526 {time zone boundary case 2053-11-02 01:00:00} {detroit y2038} {
+ clock format 2645676000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.527 {time zone boundary case 2053-10-26 01:00:01} {detroit y2038} {
- clock format 2645071201 -format {%H:%M:%S %z %Z} \
+test clock-5.527 {time zone boundary case 2053-11-02 01:00:01} {detroit y2038} {
+ clock format 2645676001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.528 {time zone boundary case 2054-04-05 01:59:59} {detroit y2038} {
- clock format 2658985199 -format {%H:%M:%S %z %Z} \
+test clock-5.528 {time zone boundary case 2054-03-08 01:59:59} {detroit y2038} {
+ clock format 2656565999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.529 {time zone boundary case 2054-04-05 03:00:00} {detroit y2038} {
- clock format 2658985200 -format {%H:%M:%S %z %Z} \
+test clock-5.529 {time zone boundary case 2054-03-08 03:00:00} {detroit y2038} {
+ clock format 2656566000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.530 {time zone boundary case 2054-04-05 03:00:01} {detroit y2038} {
- clock format 2658985201 -format {%H:%M:%S %z %Z} \
+test clock-5.530 {time zone boundary case 2054-03-08 03:00:01} {detroit y2038} {
+ clock format 2656566001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.531 {time zone boundary case 2054-10-25 01:59:59} {detroit y2038} {
- clock format 2676520799 -format {%H:%M:%S %z %Z} \
+test clock-5.531 {time zone boundary case 2054-11-01 01:59:59} {detroit y2038} {
+ clock format 2677125599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.532 {time zone boundary case 2054-10-25 01:00:00} {detroit y2038} {
- clock format 2676520800 -format {%H:%M:%S %z %Z} \
+test clock-5.532 {time zone boundary case 2054-11-01 01:00:00} {detroit y2038} {
+ clock format 2677125600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.533 {time zone boundary case 2054-10-25 01:00:01} {detroit y2038} {
- clock format 2676520801 -format {%H:%M:%S %z %Z} \
+test clock-5.533 {time zone boundary case 2054-11-01 01:00:01} {detroit y2038} {
+ clock format 2677125601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.534 {time zone boundary case 2055-04-04 01:59:59} {detroit y2038} {
- clock format 2690434799 -format {%H:%M:%S %z %Z} \
+test clock-5.534 {time zone boundary case 2055-03-14 01:59:59} {detroit y2038} {
+ clock format 2688620399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.535 {time zone boundary case 2055-04-04 03:00:00} {detroit y2038} {
- clock format 2690434800 -format {%H:%M:%S %z %Z} \
+test clock-5.535 {time zone boundary case 2055-03-14 03:00:00} {detroit y2038} {
+ clock format 2688620400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.536 {time zone boundary case 2055-04-04 03:00:01} {detroit y2038} {
- clock format 2690434801 -format {%H:%M:%S %z %Z} \
+test clock-5.536 {time zone boundary case 2055-03-14 03:00:01} {detroit y2038} {
+ clock format 2688620401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.537 {time zone boundary case 2055-10-31 01:59:59} {detroit y2038} {
- clock format 2708575199 -format {%H:%M:%S %z %Z} \
+test clock-5.537 {time zone boundary case 2055-11-07 01:59:59} {detroit y2038} {
+ clock format 2709179999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.538 {time zone boundary case 2055-10-31 01:00:00} {detroit y2038} {
- clock format 2708575200 -format {%H:%M:%S %z %Z} \
+test clock-5.538 {time zone boundary case 2055-11-07 01:00:00} {detroit y2038} {
+ clock format 2709180000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.539 {time zone boundary case 2055-10-31 01:00:01} {detroit y2038} {
- clock format 2708575201 -format {%H:%M:%S %z %Z} \
+test clock-5.539 {time zone boundary case 2055-11-07 01:00:01} {detroit y2038} {
+ clock format 2709180001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.540 {time zone boundary case 2056-04-02 01:59:59} {detroit y2038} {
- clock format 2721884399 -format {%H:%M:%S %z %Z} \
+test clock-5.540 {time zone boundary case 2056-03-12 01:59:59} {detroit y2038} {
+ clock format 2720069999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.541 {time zone boundary case 2056-04-02 03:00:00} {detroit y2038} {
- clock format 2721884400 -format {%H:%M:%S %z %Z} \
+test clock-5.541 {time zone boundary case 2056-03-12 03:00:00} {detroit y2038} {
+ clock format 2720070000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.542 {time zone boundary case 2056-04-02 03:00:01} {detroit y2038} {
- clock format 2721884401 -format {%H:%M:%S %z %Z} \
+test clock-5.542 {time zone boundary case 2056-03-12 03:00:01} {detroit y2038} {
+ clock format 2720070001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.543 {time zone boundary case 2056-10-29 01:59:59} {detroit y2038} {
- clock format 2740024799 -format {%H:%M:%S %z %Z} \
+test clock-5.543 {time zone boundary case 2056-11-05 01:59:59} {detroit y2038} {
+ clock format 2740629599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.544 {time zone boundary case 2056-10-29 01:00:00} {detroit y2038} {
- clock format 2740024800 -format {%H:%M:%S %z %Z} \
+test clock-5.544 {time zone boundary case 2056-11-05 01:00:00} {detroit y2038} {
+ clock format 2740629600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.545 {time zone boundary case 2056-10-29 01:00:01} {detroit y2038} {
- clock format 2740024801 -format {%H:%M:%S %z %Z} \
+test clock-5.545 {time zone boundary case 2056-11-05 01:00:01} {detroit y2038} {
+ clock format 2740629601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.546 {time zone boundary case 2057-04-01 01:59:59} {detroit y2038} {
- clock format 2753333999 -format {%H:%M:%S %z %Z} \
+test clock-5.546 {time zone boundary case 2057-03-11 01:59:59} {detroit y2038} {
+ clock format 2751519599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.547 {time zone boundary case 2057-04-01 03:00:00} {detroit y2038} {
- clock format 2753334000 -format {%H:%M:%S %z %Z} \
+test clock-5.547 {time zone boundary case 2057-03-11 03:00:00} {detroit y2038} {
+ clock format 2751519600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.548 {time zone boundary case 2057-04-01 03:00:01} {detroit y2038} {
- clock format 2753334001 -format {%H:%M:%S %z %Z} \
+test clock-5.548 {time zone boundary case 2057-03-11 03:00:01} {detroit y2038} {
+ clock format 2751519601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.549 {time zone boundary case 2057-10-28 01:59:59} {detroit y2038} {
- clock format 2771474399 -format {%H:%M:%S %z %Z} \
+test clock-5.549 {time zone boundary case 2057-11-04 01:59:59} {detroit y2038} {
+ clock format 2772079199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.550 {time zone boundary case 2057-10-28 01:00:00} {detroit y2038} {
- clock format 2771474400 -format {%H:%M:%S %z %Z} \
+test clock-5.550 {time zone boundary case 2057-11-04 01:00:00} {detroit y2038} {
+ clock format 2772079200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.551 {time zone boundary case 2057-10-28 01:00:01} {detroit y2038} {
- clock format 2771474401 -format {%H:%M:%S %z %Z} \
+test clock-5.551 {time zone boundary case 2057-11-04 01:00:01} {detroit y2038} {
+ clock format 2772079201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.552 {time zone boundary case 2058-04-07 01:59:59} {detroit y2038} {
- clock format 2785388399 -format {%H:%M:%S %z %Z} \
+test clock-5.552 {time zone boundary case 2058-03-10 01:59:59} {detroit y2038} {
+ clock format 2782969199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.553 {time zone boundary case 2058-04-07 03:00:00} {detroit y2038} {
- clock format 2785388400 -format {%H:%M:%S %z %Z} \
+test clock-5.553 {time zone boundary case 2058-03-10 03:00:00} {detroit y2038} {
+ clock format 2782969200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.554 {time zone boundary case 2058-04-07 03:00:01} {detroit y2038} {
- clock format 2785388401 -format {%H:%M:%S %z %Z} \
+test clock-5.554 {time zone boundary case 2058-03-10 03:00:01} {detroit y2038} {
+ clock format 2782969201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.555 {time zone boundary case 2058-10-27 01:59:59} {detroit y2038} {
- clock format 2802923999 -format {%H:%M:%S %z %Z} \
+test clock-5.555 {time zone boundary case 2058-11-03 01:59:59} {detroit y2038} {
+ clock format 2803528799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.556 {time zone boundary case 2058-10-27 01:00:00} {detroit y2038} {
- clock format 2802924000 -format {%H:%M:%S %z %Z} \
+test clock-5.556 {time zone boundary case 2058-11-03 01:00:00} {detroit y2038} {
+ clock format 2803528800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.557 {time zone boundary case 2058-10-27 01:00:01} {detroit y2038} {
- clock format 2802924001 -format {%H:%M:%S %z %Z} \
+test clock-5.557 {time zone boundary case 2058-11-03 01:00:01} {detroit y2038} {
+ clock format 2803528801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.558 {time zone boundary case 2059-04-06 01:59:59} {detroit y2038} {
- clock format 2816837999 -format {%H:%M:%S %z %Z} \
+test clock-5.558 {time zone boundary case 2059-03-09 01:59:59} {detroit y2038} {
+ clock format 2814418799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.559 {time zone boundary case 2059-04-06 03:00:00} {detroit y2038} {
- clock format 2816838000 -format {%H:%M:%S %z %Z} \
+test clock-5.559 {time zone boundary case 2059-03-09 03:00:00} {detroit y2038} {
+ clock format 2814418800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.560 {time zone boundary case 2059-04-06 03:00:01} {detroit y2038} {
- clock format 2816838001 -format {%H:%M:%S %z %Z} \
+test clock-5.560 {time zone boundary case 2059-03-09 03:00:01} {detroit y2038} {
+ clock format 2814418801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.561 {time zone boundary case 2059-10-26 01:59:59} {detroit y2038} {
- clock format 2834373599 -format {%H:%M:%S %z %Z} \
+test clock-5.561 {time zone boundary case 2059-11-02 01:59:59} {detroit y2038} {
+ clock format 2834978399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.562 {time zone boundary case 2059-10-26 01:00:00} {detroit y2038} {
- clock format 2834373600 -format {%H:%M:%S %z %Z} \
+test clock-5.562 {time zone boundary case 2059-11-02 01:00:00} {detroit y2038} {
+ clock format 2834978400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.563 {time zone boundary case 2059-10-26 01:00:01} {detroit y2038} {
- clock format 2834373601 -format {%H:%M:%S %z %Z} \
+test clock-5.563 {time zone boundary case 2059-11-02 01:00:01} {detroit y2038} {
+ clock format 2834978401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.564 {time zone boundary case 2060-04-04 01:59:59} {detroit y2038} {
- clock format 2848287599 -format {%H:%M:%S %z %Z} \
+test clock-5.564 {time zone boundary case 2060-03-14 01:59:59} {detroit y2038} {
+ clock format 2846473199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.565 {time zone boundary case 2060-04-04 03:00:00} {detroit y2038} {
- clock format 2848287600 -format {%H:%M:%S %z %Z} \
+test clock-5.565 {time zone boundary case 2060-03-14 03:00:00} {detroit y2038} {
+ clock format 2846473200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.566 {time zone boundary case 2060-04-04 03:00:01} {detroit y2038} {
- clock format 2848287601 -format {%H:%M:%S %z %Z} \
+test clock-5.566 {time zone boundary case 2060-03-14 03:00:01} {detroit y2038} {
+ clock format 2846473201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.567 {time zone boundary case 2060-10-31 01:59:59} {detroit y2038} {
- clock format 2866427999 -format {%H:%M:%S %z %Z} \
+test clock-5.567 {time zone boundary case 2060-11-07 01:59:59} {detroit y2038} {
+ clock format 2867032799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.568 {time zone boundary case 2060-10-31 01:00:00} {detroit y2038} {
- clock format 2866428000 -format {%H:%M:%S %z %Z} \
+test clock-5.568 {time zone boundary case 2060-11-07 01:00:00} {detroit y2038} {
+ clock format 2867032800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.569 {time zone boundary case 2060-10-31 01:00:01} {detroit y2038} {
- clock format 2866428001 -format {%H:%M:%S %z %Z} \
+test clock-5.569 {time zone boundary case 2060-11-07 01:00:01} {detroit y2038} {
+ clock format 2867032801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.570 {time zone boundary case 2061-04-03 01:59:59} {detroit y2038} {
- clock format 2879737199 -format {%H:%M:%S %z %Z} \
+test clock-5.570 {time zone boundary case 2061-03-13 01:59:59} {detroit y2038} {
+ clock format 2877922799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.571 {time zone boundary case 2061-04-03 03:00:00} {detroit y2038} {
- clock format 2879737200 -format {%H:%M:%S %z %Z} \
+test clock-5.571 {time zone boundary case 2061-03-13 03:00:00} {detroit y2038} {
+ clock format 2877922800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.572 {time zone boundary case 2061-04-03 03:00:01} {detroit y2038} {
- clock format 2879737201 -format {%H:%M:%S %z %Z} \
+test clock-5.572 {time zone boundary case 2061-03-13 03:00:01} {detroit y2038} {
+ clock format 2877922801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.573 {time zone boundary case 2061-10-30 01:59:59} {detroit y2038} {
- clock format 2897877599 -format {%H:%M:%S %z %Z} \
+test clock-5.573 {time zone boundary case 2061-11-06 01:59:59} {detroit y2038} {
+ clock format 2898482399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.574 {time zone boundary case 2061-10-30 01:00:00} {detroit y2038} {
- clock format 2897877600 -format {%H:%M:%S %z %Z} \
+test clock-5.574 {time zone boundary case 2061-11-06 01:00:00} {detroit y2038} {
+ clock format 2898482400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.575 {time zone boundary case 2061-10-30 01:00:01} {detroit y2038} {
- clock format 2897877601 -format {%H:%M:%S %z %Z} \
+test clock-5.575 {time zone boundary case 2061-11-06 01:00:01} {detroit y2038} {
+ clock format 2898482401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.576 {time zone boundary case 2062-04-02 01:59:59} {detroit y2038} {
- clock format 2911186799 -format {%H:%M:%S %z %Z} \
+test clock-5.576 {time zone boundary case 2062-03-12 01:59:59} {detroit y2038} {
+ clock format 2909372399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.577 {time zone boundary case 2062-04-02 03:00:00} {detroit y2038} {
- clock format 2911186800 -format {%H:%M:%S %z %Z} \
+test clock-5.577 {time zone boundary case 2062-03-12 03:00:00} {detroit y2038} {
+ clock format 2909372400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.578 {time zone boundary case 2062-04-02 03:00:01} {detroit y2038} {
- clock format 2911186801 -format {%H:%M:%S %z %Z} \
+test clock-5.578 {time zone boundary case 2062-03-12 03:00:01} {detroit y2038} {
+ clock format 2909372401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.579 {time zone boundary case 2062-10-29 01:59:59} {detroit y2038} {
- clock format 2929327199 -format {%H:%M:%S %z %Z} \
+test clock-5.579 {time zone boundary case 2062-11-05 01:59:59} {detroit y2038} {
+ clock format 2929931999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.580 {time zone boundary case 2062-10-29 01:00:00} {detroit y2038} {
- clock format 2929327200 -format {%H:%M:%S %z %Z} \
+test clock-5.580 {time zone boundary case 2062-11-05 01:00:00} {detroit y2038} {
+ clock format 2929932000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.581 {time zone boundary case 2062-10-29 01:00:01} {detroit y2038} {
- clock format 2929327201 -format {%H:%M:%S %z %Z} \
+test clock-5.581 {time zone boundary case 2062-11-05 01:00:01} {detroit y2038} {
+ clock format 2929932001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.582 {time zone boundary case 2063-04-01 01:59:59} {detroit y2038} {
- clock format 2942636399 -format {%H:%M:%S %z %Z} \
+test clock-5.582 {time zone boundary case 2063-03-11 01:59:59} {detroit y2038} {
+ clock format 2940821999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.583 {time zone boundary case 2063-04-01 03:00:00} {detroit y2038} {
- clock format 2942636400 -format {%H:%M:%S %z %Z} \
+test clock-5.583 {time zone boundary case 2063-03-11 03:00:00} {detroit y2038} {
+ clock format 2940822000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.584 {time zone boundary case 2063-04-01 03:00:01} {detroit y2038} {
- clock format 2942636401 -format {%H:%M:%S %z %Z} \
+test clock-5.584 {time zone boundary case 2063-03-11 03:00:01} {detroit y2038} {
+ clock format 2940822001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.585 {time zone boundary case 2063-10-28 01:59:59} {detroit y2038} {
- clock format 2960776799 -format {%H:%M:%S %z %Z} \
+test clock-5.585 {time zone boundary case 2063-11-04 01:59:59} {detroit y2038} {
+ clock format 2961381599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.586 {time zone boundary case 2063-10-28 01:00:00} {detroit y2038} {
- clock format 2960776800 -format {%H:%M:%S %z %Z} \
+test clock-5.586 {time zone boundary case 2063-11-04 01:00:00} {detroit y2038} {
+ clock format 2961381600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.587 {time zone boundary case 2063-10-28 01:00:01} {detroit y2038} {
- clock format 2960776801 -format {%H:%M:%S %z %Z} \
+test clock-5.587 {time zone boundary case 2063-11-04 01:00:01} {detroit y2038} {
+ clock format 2961381601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.588 {time zone boundary case 2064-04-06 01:59:59} {detroit y2038} {
- clock format 2974690799 -format {%H:%M:%S %z %Z} \
+test clock-5.588 {time zone boundary case 2064-03-09 01:59:59} {detroit y2038} {
+ clock format 2972271599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.589 {time zone boundary case 2064-04-06 03:00:00} {detroit y2038} {
- clock format 2974690800 -format {%H:%M:%S %z %Z} \
+test clock-5.589 {time zone boundary case 2064-03-09 03:00:00} {detroit y2038} {
+ clock format 2972271600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.590 {time zone boundary case 2064-04-06 03:00:01} {detroit y2038} {
- clock format 2974690801 -format {%H:%M:%S %z %Z} \
+test clock-5.590 {time zone boundary case 2064-03-09 03:00:01} {detroit y2038} {
+ clock format 2972271601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.591 {time zone boundary case 2064-10-26 01:59:59} {detroit y2038} {
- clock format 2992226399 -format {%H:%M:%S %z %Z} \
+test clock-5.591 {time zone boundary case 2064-11-02 01:59:59} {detroit y2038} {
+ clock format 2992831199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.592 {time zone boundary case 2064-10-26 01:00:00} {detroit y2038} {
- clock format 2992226400 -format {%H:%M:%S %z %Z} \
+test clock-5.592 {time zone boundary case 2064-11-02 01:00:00} {detroit y2038} {
+ clock format 2992831200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.593 {time zone boundary case 2064-10-26 01:00:01} {detroit y2038} {
- clock format 2992226401 -format {%H:%M:%S %z %Z} \
+test clock-5.593 {time zone boundary case 2064-11-02 01:00:01} {detroit y2038} {
+ clock format 2992831201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.594 {time zone boundary case 2065-04-05 01:59:59} {detroit y2038} {
- clock format 3006140399 -format {%H:%M:%S %z %Z} \
+test clock-5.594 {time zone boundary case 2065-03-08 01:59:59} {detroit y2038} {
+ clock format 3003721199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.595 {time zone boundary case 2065-04-05 03:00:00} {detroit y2038} {
- clock format 3006140400 -format {%H:%M:%S %z %Z} \
+test clock-5.595 {time zone boundary case 2065-03-08 03:00:00} {detroit y2038} {
+ clock format 3003721200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.596 {time zone boundary case 2065-04-05 03:00:01} {detroit y2038} {
- clock format 3006140401 -format {%H:%M:%S %z %Z} \
+test clock-5.596 {time zone boundary case 2065-03-08 03:00:01} {detroit y2038} {
+ clock format 3003721201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.597 {time zone boundary case 2065-10-25 01:59:59} {detroit y2038} {
- clock format 3023675999 -format {%H:%M:%S %z %Z} \
+test clock-5.597 {time zone boundary case 2065-11-01 01:59:59} {detroit y2038} {
+ clock format 3024280799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.598 {time zone boundary case 2065-10-25 01:00:00} {detroit y2038} {
- clock format 3023676000 -format {%H:%M:%S %z %Z} \
+test clock-5.598 {time zone boundary case 2065-11-01 01:00:00} {detroit y2038} {
+ clock format 3024280800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.599 {time zone boundary case 2065-10-25 01:00:01} {detroit y2038} {
- clock format 3023676001 -format {%H:%M:%S %z %Z} \
+test clock-5.599 {time zone boundary case 2065-11-01 01:00:01} {detroit y2038} {
+ clock format 3024280801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.600 {time zone boundary case 2066-04-04 01:59:59} {detroit y2038} {
- clock format 3037589999 -format {%H:%M:%S %z %Z} \
+test clock-5.600 {time zone boundary case 2066-03-14 01:59:59} {detroit y2038} {
+ clock format 3035775599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.601 {time zone boundary case 2066-04-04 03:00:00} {detroit y2038} {
- clock format 3037590000 -format {%H:%M:%S %z %Z} \
+test clock-5.601 {time zone boundary case 2066-03-14 03:00:00} {detroit y2038} {
+ clock format 3035775600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.602 {time zone boundary case 2066-04-04 03:00:01} {detroit y2038} {
- clock format 3037590001 -format {%H:%M:%S %z %Z} \
+test clock-5.602 {time zone boundary case 2066-03-14 03:00:01} {detroit y2038} {
+ clock format 3035775601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.603 {time zone boundary case 2066-10-31 01:59:59} {detroit y2038} {
- clock format 3055730399 -format {%H:%M:%S %z %Z} \
+test clock-5.603 {time zone boundary case 2066-11-07 01:59:59} {detroit y2038} {
+ clock format 3056335199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.604 {time zone boundary case 2066-10-31 01:00:00} {detroit y2038} {
- clock format 3055730400 -format {%H:%M:%S %z %Z} \
+test clock-5.604 {time zone boundary case 2066-11-07 01:00:00} {detroit y2038} {
+ clock format 3056335200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.605 {time zone boundary case 2066-10-31 01:00:01} {detroit y2038} {
- clock format 3055730401 -format {%H:%M:%S %z %Z} \
+test clock-5.605 {time zone boundary case 2066-11-07 01:00:01} {detroit y2038} {
+ clock format 3056335201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.606 {time zone boundary case 2067-04-03 01:59:59} {detroit y2038} {
- clock format 3069039599 -format {%H:%M:%S %z %Z} \
+test clock-5.606 {time zone boundary case 2067-03-13 01:59:59} {detroit y2038} {
+ clock format 3067225199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.607 {time zone boundary case 2067-04-03 03:00:00} {detroit y2038} {
- clock format 3069039600 -format {%H:%M:%S %z %Z} \
+test clock-5.607 {time zone boundary case 2067-03-13 03:00:00} {detroit y2038} {
+ clock format 3067225200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.608 {time zone boundary case 2067-04-03 03:00:01} {detroit y2038} {
- clock format 3069039601 -format {%H:%M:%S %z %Z} \
+test clock-5.608 {time zone boundary case 2067-03-13 03:00:01} {detroit y2038} {
+ clock format 3067225201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.609 {time zone boundary case 2067-10-30 01:59:59} {detroit y2038} {
- clock format 3087179999 -format {%H:%M:%S %z %Z} \
+test clock-5.609 {time zone boundary case 2067-11-06 01:59:59} {detroit y2038} {
+ clock format 3087784799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.610 {time zone boundary case 2067-10-30 01:00:00} {detroit y2038} {
- clock format 3087180000 -format {%H:%M:%S %z %Z} \
+test clock-5.610 {time zone boundary case 2067-11-06 01:00:00} {detroit y2038} {
+ clock format 3087784800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.611 {time zone boundary case 2067-10-30 01:00:01} {detroit y2038} {
- clock format 3087180001 -format {%H:%M:%S %z %Z} \
+test clock-5.611 {time zone boundary case 2067-11-06 01:00:01} {detroit y2038} {
+ clock format 3087784801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.612 {time zone boundary case 2068-04-01 01:59:59} {detroit y2038} {
- clock format 3100489199 -format {%H:%M:%S %z %Z} \
+test clock-5.612 {time zone boundary case 2068-03-11 01:59:59} {detroit y2038} {
+ clock format 3098674799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.613 {time zone boundary case 2068-04-01 03:00:00} {detroit y2038} {
- clock format 3100489200 -format {%H:%M:%S %z %Z} \
+test clock-5.613 {time zone boundary case 2068-03-11 03:00:00} {detroit y2038} {
+ clock format 3098674800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.614 {time zone boundary case 2068-04-01 03:00:01} {detroit y2038} {
- clock format 3100489201 -format {%H:%M:%S %z %Z} \
+test clock-5.614 {time zone boundary case 2068-03-11 03:00:01} {detroit y2038} {
+ clock format 3098674801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.615 {time zone boundary case 2068-10-28 01:59:59} {detroit y2038} {
- clock format 3118629599 -format {%H:%M:%S %z %Z} \
+test clock-5.615 {time zone boundary case 2068-11-04 01:59:59} {detroit y2038} {
+ clock format 3119234399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.616 {time zone boundary case 2068-10-28 01:00:00} {detroit y2038} {
- clock format 3118629600 -format {%H:%M:%S %z %Z} \
+test clock-5.616 {time zone boundary case 2068-11-04 01:00:00} {detroit y2038} {
+ clock format 3119234400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.617 {time zone boundary case 2068-10-28 01:00:01} {detroit y2038} {
- clock format 3118629601 -format {%H:%M:%S %z %Z} \
+test clock-5.617 {time zone boundary case 2068-11-04 01:00:01} {detroit y2038} {
+ clock format 3119234401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.618 {time zone boundary case 2069-04-07 01:59:59} {detroit y2038} {
- clock format 3132543599 -format {%H:%M:%S %z %Z} \
+test clock-5.618 {time zone boundary case 2069-03-10 01:59:59} {detroit y2038} {
+ clock format 3130124399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.619 {time zone boundary case 2069-04-07 03:00:00} {detroit y2038} {
- clock format 3132543600 -format {%H:%M:%S %z %Z} \
+test clock-5.619 {time zone boundary case 2069-03-10 03:00:00} {detroit y2038} {
+ clock format 3130124400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.620 {time zone boundary case 2069-04-07 03:00:01} {detroit y2038} {
- clock format 3132543601 -format {%H:%M:%S %z %Z} \
+test clock-5.620 {time zone boundary case 2069-03-10 03:00:01} {detroit y2038} {
+ clock format 3130124401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.621 {time zone boundary case 2069-10-27 01:59:59} {detroit y2038} {
- clock format 3150079199 -format {%H:%M:%S %z %Z} \
+test clock-5.621 {time zone boundary case 2069-11-03 01:59:59} {detroit y2038} {
+ clock format 3150683999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.622 {time zone boundary case 2069-10-27 01:00:00} {detroit y2038} {
- clock format 3150079200 -format {%H:%M:%S %z %Z} \
+test clock-5.622 {time zone boundary case 2069-11-03 01:00:00} {detroit y2038} {
+ clock format 3150684000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.623 {time zone boundary case 2069-10-27 01:00:01} {detroit y2038} {
- clock format 3150079201 -format {%H:%M:%S %z %Z} \
+test clock-5.623 {time zone boundary case 2069-11-03 01:00:01} {detroit y2038} {
+ clock format 3150684001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.624 {time zone boundary case 2070-04-06 01:59:59} {detroit y2038} {
- clock format 3163993199 -format {%H:%M:%S %z %Z} \
+test clock-5.624 {time zone boundary case 2070-03-09 01:59:59} {detroit y2038} {
+ clock format 3161573999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.625 {time zone boundary case 2070-04-06 03:00:00} {detroit y2038} {
- clock format 3163993200 -format {%H:%M:%S %z %Z} \
+test clock-5.625 {time zone boundary case 2070-03-09 03:00:00} {detroit y2038} {
+ clock format 3161574000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.626 {time zone boundary case 2070-04-06 03:00:01} {detroit y2038} {
- clock format 3163993201 -format {%H:%M:%S %z %Z} \
+test clock-5.626 {time zone boundary case 2070-03-09 03:00:01} {detroit y2038} {
+ clock format 3161574001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.627 {time zone boundary case 2070-10-26 01:59:59} {detroit y2038} {
- clock format 3181528799 -format {%H:%M:%S %z %Z} \
+test clock-5.627 {time zone boundary case 2070-11-02 01:59:59} {detroit y2038} {
+ clock format 3182133599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.628 {time zone boundary case 2070-10-26 01:00:00} {detroit y2038} {
- clock format 3181528800 -format {%H:%M:%S %z %Z} \
+test clock-5.628 {time zone boundary case 2070-11-02 01:00:00} {detroit y2038} {
+ clock format 3182133600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.629 {time zone boundary case 2070-10-26 01:00:01} {detroit y2038} {
- clock format 3181528801 -format {%H:%M:%S %z %Z} \
+test clock-5.629 {time zone boundary case 2070-11-02 01:00:01} {detroit y2038} {
+ clock format 3182133601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.630 {time zone boundary case 2071-04-05 01:59:59} {detroit y2038} {
- clock format 3195442799 -format {%H:%M:%S %z %Z} \
+test clock-5.630 {time zone boundary case 2071-03-08 01:59:59} {detroit y2038} {
+ clock format 3193023599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.631 {time zone boundary case 2071-04-05 03:00:00} {detroit y2038} {
- clock format 3195442800 -format {%H:%M:%S %z %Z} \
+test clock-5.631 {time zone boundary case 2071-03-08 03:00:00} {detroit y2038} {
+ clock format 3193023600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.632 {time zone boundary case 2071-04-05 03:00:01} {detroit y2038} {
- clock format 3195442801 -format {%H:%M:%S %z %Z} \
+test clock-5.632 {time zone boundary case 2071-03-08 03:00:01} {detroit y2038} {
+ clock format 3193023601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.633 {time zone boundary case 2071-10-25 01:59:59} {detroit y2038} {
- clock format 3212978399 -format {%H:%M:%S %z %Z} \
+test clock-5.633 {time zone boundary case 2071-11-01 01:59:59} {detroit y2038} {
+ clock format 3213583199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.634 {time zone boundary case 2071-10-25 01:00:00} {detroit y2038} {
- clock format 3212978400 -format {%H:%M:%S %z %Z} \
+test clock-5.634 {time zone boundary case 2071-11-01 01:00:00} {detroit y2038} {
+ clock format 3213583200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.635 {time zone boundary case 2071-10-25 01:00:01} {detroit y2038} {
- clock format 3212978401 -format {%H:%M:%S %z %Z} \
+test clock-5.635 {time zone boundary case 2071-11-01 01:00:01} {detroit y2038} {
+ clock format 3213583201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.636 {time zone boundary case 2072-04-03 01:59:59} {detroit y2038} {
- clock format 3226892399 -format {%H:%M:%S %z %Z} \
+test clock-5.636 {time zone boundary case 2072-03-13 01:59:59} {detroit y2038} {
+ clock format 3225077999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.637 {time zone boundary case 2072-04-03 03:00:00} {detroit y2038} {
- clock format 3226892400 -format {%H:%M:%S %z %Z} \
+test clock-5.637 {time zone boundary case 2072-03-13 03:00:00} {detroit y2038} {
+ clock format 3225078000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.638 {time zone boundary case 2072-04-03 03:00:01} {detroit y2038} {
- clock format 3226892401 -format {%H:%M:%S %z %Z} \
+test clock-5.638 {time zone boundary case 2072-03-13 03:00:01} {detroit y2038} {
+ clock format 3225078001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.639 {time zone boundary case 2072-10-30 01:59:59} {detroit y2038} {
- clock format 3245032799 -format {%H:%M:%S %z %Z} \
+test clock-5.639 {time zone boundary case 2072-11-06 01:59:59} {detroit y2038} {
+ clock format 3245637599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.640 {time zone boundary case 2072-10-30 01:00:00} {detroit y2038} {
- clock format 3245032800 -format {%H:%M:%S %z %Z} \
+test clock-5.640 {time zone boundary case 2072-11-06 01:00:00} {detroit y2038} {
+ clock format 3245637600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.641 {time zone boundary case 2072-10-30 01:00:01} {detroit y2038} {
- clock format 3245032801 -format {%H:%M:%S %z %Z} \
+test clock-5.641 {time zone boundary case 2072-11-06 01:00:01} {detroit y2038} {
+ clock format 3245637601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.642 {time zone boundary case 2073-04-02 01:59:59} {detroit y2038} {
- clock format 3258341999 -format {%H:%M:%S %z %Z} \
+test clock-5.642 {time zone boundary case 2073-03-12 01:59:59} {detroit y2038} {
+ clock format 3256527599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.643 {time zone boundary case 2073-04-02 03:00:00} {detroit y2038} {
- clock format 3258342000 -format {%H:%M:%S %z %Z} \
+test clock-5.643 {time zone boundary case 2073-03-12 03:00:00} {detroit y2038} {
+ clock format 3256527600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.644 {time zone boundary case 2073-04-02 03:00:01} {detroit y2038} {
- clock format 3258342001 -format {%H:%M:%S %z %Z} \
+test clock-5.644 {time zone boundary case 2073-03-12 03:00:01} {detroit y2038} {
+ clock format 3256527601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.645 {time zone boundary case 2073-10-29 01:59:59} {detroit y2038} {
- clock format 3276482399 -format {%H:%M:%S %z %Z} \
+test clock-5.645 {time zone boundary case 2073-11-05 01:59:59} {detroit y2038} {
+ clock format 3277087199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.646 {time zone boundary case 2073-10-29 01:00:00} {detroit y2038} {
- clock format 3276482400 -format {%H:%M:%S %z %Z} \
+test clock-5.646 {time zone boundary case 2073-11-05 01:00:00} {detroit y2038} {
+ clock format 3277087200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.647 {time zone boundary case 2073-10-29 01:00:01} {detroit y2038} {
- clock format 3276482401 -format {%H:%M:%S %z %Z} \
+test clock-5.647 {time zone boundary case 2073-11-05 01:00:01} {detroit y2038} {
+ clock format 3277087201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.648 {time zone boundary case 2074-04-01 01:59:59} {detroit y2038} {
- clock format 3289791599 -format {%H:%M:%S %z %Z} \
+test clock-5.648 {time zone boundary case 2074-03-11 01:59:59} {detroit y2038} {
+ clock format 3287977199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.649 {time zone boundary case 2074-04-01 03:00:00} {detroit y2038} {
- clock format 3289791600 -format {%H:%M:%S %z %Z} \
+test clock-5.649 {time zone boundary case 2074-03-11 03:00:00} {detroit y2038} {
+ clock format 3287977200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.650 {time zone boundary case 2074-04-01 03:00:01} {detroit y2038} {
- clock format 3289791601 -format {%H:%M:%S %z %Z} \
+test clock-5.650 {time zone boundary case 2074-03-11 03:00:01} {detroit y2038} {
+ clock format 3287977201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.651 {time zone boundary case 2074-10-28 01:59:59} {detroit y2038} {
- clock format 3307931999 -format {%H:%M:%S %z %Z} \
+test clock-5.651 {time zone boundary case 2074-11-04 01:59:59} {detroit y2038} {
+ clock format 3308536799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.652 {time zone boundary case 2074-10-28 01:00:00} {detroit y2038} {
- clock format 3307932000 -format {%H:%M:%S %z %Z} \
+test clock-5.652 {time zone boundary case 2074-11-04 01:00:00} {detroit y2038} {
+ clock format 3308536800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.653 {time zone boundary case 2074-10-28 01:00:01} {detroit y2038} {
- clock format 3307932001 -format {%H:%M:%S %z %Z} \
+test clock-5.653 {time zone boundary case 2074-11-04 01:00:01} {detroit y2038} {
+ clock format 3308536801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.654 {time zone boundary case 2075-04-07 01:59:59} {detroit y2038} {
- clock format 3321845999 -format {%H:%M:%S %z %Z} \
+test clock-5.654 {time zone boundary case 2075-03-10 01:59:59} {detroit y2038} {
+ clock format 3319426799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.655 {time zone boundary case 2075-04-07 03:00:00} {detroit y2038} {
- clock format 3321846000 -format {%H:%M:%S %z %Z} \
+test clock-5.655 {time zone boundary case 2075-03-10 03:00:00} {detroit y2038} {
+ clock format 3319426800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.656 {time zone boundary case 2075-04-07 03:00:01} {detroit y2038} {
- clock format 3321846001 -format {%H:%M:%S %z %Z} \
+test clock-5.656 {time zone boundary case 2075-03-10 03:00:01} {detroit y2038} {
+ clock format 3319426801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.657 {time zone boundary case 2075-10-27 01:59:59} {detroit y2038} {
- clock format 3339381599 -format {%H:%M:%S %z %Z} \
+test clock-5.657 {time zone boundary case 2075-11-03 01:59:59} {detroit y2038} {
+ clock format 3339986399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.658 {time zone boundary case 2075-10-27 01:00:00} {detroit y2038} {
- clock format 3339381600 -format {%H:%M:%S %z %Z} \
+test clock-5.658 {time zone boundary case 2075-11-03 01:00:00} {detroit y2038} {
+ clock format 3339986400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.659 {time zone boundary case 2075-10-27 01:00:01} {detroit y2038} {
- clock format 3339381601 -format {%H:%M:%S %z %Z} \
+test clock-5.659 {time zone boundary case 2075-11-03 01:00:01} {detroit y2038} {
+ clock format 3339986401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.660 {time zone boundary case 2076-04-05 01:59:59} {detroit y2038} {
- clock format 3353295599 -format {%H:%M:%S %z %Z} \
+test clock-5.660 {time zone boundary case 2076-03-08 01:59:59} {detroit y2038} {
+ clock format 3350876399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.661 {time zone boundary case 2076-04-05 03:00:00} {detroit y2038} {
- clock format 3353295600 -format {%H:%M:%S %z %Z} \
+test clock-5.661 {time zone boundary case 2076-03-08 03:00:00} {detroit y2038} {
+ clock format 3350876400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.662 {time zone boundary case 2076-04-05 03:00:01} {detroit y2038} {
- clock format 3353295601 -format {%H:%M:%S %z %Z} \
+test clock-5.662 {time zone boundary case 2076-03-08 03:00:01} {detroit y2038} {
+ clock format 3350876401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.663 {time zone boundary case 2076-10-25 01:59:59} {detroit y2038} {
- clock format 3370831199 -format {%H:%M:%S %z %Z} \
+test clock-5.663 {time zone boundary case 2076-11-01 01:59:59} {detroit y2038} {
+ clock format 3371435999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.664 {time zone boundary case 2076-10-25 01:00:00} {detroit y2038} {
- clock format 3370831200 -format {%H:%M:%S %z %Z} \
+test clock-5.664 {time zone boundary case 2076-11-01 01:00:00} {detroit y2038} {
+ clock format 3371436000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.665 {time zone boundary case 2076-10-25 01:00:01} {detroit y2038} {
- clock format 3370831201 -format {%H:%M:%S %z %Z} \
+test clock-5.665 {time zone boundary case 2076-11-01 01:00:01} {detroit y2038} {
+ clock format 3371436001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.666 {time zone boundary case 2077-04-04 01:59:59} {detroit y2038} {
- clock format 3384745199 -format {%H:%M:%S %z %Z} \
+test clock-5.666 {time zone boundary case 2077-03-14 01:59:59} {detroit y2038} {
+ clock format 3382930799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.667 {time zone boundary case 2077-04-04 03:00:00} {detroit y2038} {
- clock format 3384745200 -format {%H:%M:%S %z %Z} \
+test clock-5.667 {time zone boundary case 2077-03-14 03:00:00} {detroit y2038} {
+ clock format 3382930800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.668 {time zone boundary case 2077-04-04 03:00:01} {detroit y2038} {
- clock format 3384745201 -format {%H:%M:%S %z %Z} \
+test clock-5.668 {time zone boundary case 2077-03-14 03:00:01} {detroit y2038} {
+ clock format 3382930801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.669 {time zone boundary case 2077-10-31 01:59:59} {detroit y2038} {
- clock format 3402885599 -format {%H:%M:%S %z %Z} \
+test clock-5.669 {time zone boundary case 2077-11-07 01:59:59} {detroit y2038} {
+ clock format 3403490399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.670 {time zone boundary case 2077-10-31 01:00:00} {detroit y2038} {
- clock format 3402885600 -format {%H:%M:%S %z %Z} \
+test clock-5.670 {time zone boundary case 2077-11-07 01:00:00} {detroit y2038} {
+ clock format 3403490400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.671 {time zone boundary case 2077-10-31 01:00:01} {detroit y2038} {
- clock format 3402885601 -format {%H:%M:%S %z %Z} \
+test clock-5.671 {time zone boundary case 2077-11-07 01:00:01} {detroit y2038} {
+ clock format 3403490401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.672 {time zone boundary case 2078-04-03 01:59:59} {detroit y2038} {
- clock format 3416194799 -format {%H:%M:%S %z %Z} \
+test clock-5.672 {time zone boundary case 2078-03-13 01:59:59} {detroit y2038} {
+ clock format 3414380399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.673 {time zone boundary case 2078-04-03 03:00:00} {detroit y2038} {
- clock format 3416194800 -format {%H:%M:%S %z %Z} \
+test clock-5.673 {time zone boundary case 2078-03-13 03:00:00} {detroit y2038} {
+ clock format 3414380400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.674 {time zone boundary case 2078-04-03 03:00:01} {detroit y2038} {
- clock format 3416194801 -format {%H:%M:%S %z %Z} \
+test clock-5.674 {time zone boundary case 2078-03-13 03:00:01} {detroit y2038} {
+ clock format 3414380401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.675 {time zone boundary case 2078-10-30 01:59:59} {detroit y2038} {
- clock format 3434335199 -format {%H:%M:%S %z %Z} \
+test clock-5.675 {time zone boundary case 2078-11-06 01:59:59} {detroit y2038} {
+ clock format 3434939999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.676 {time zone boundary case 2078-10-30 01:00:00} {detroit y2038} {
- clock format 3434335200 -format {%H:%M:%S %z %Z} \
+test clock-5.676 {time zone boundary case 2078-11-06 01:00:00} {detroit y2038} {
+ clock format 3434940000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.677 {time zone boundary case 2078-10-30 01:00:01} {detroit y2038} {
- clock format 3434335201 -format {%H:%M:%S %z %Z} \
+test clock-5.677 {time zone boundary case 2078-11-06 01:00:01} {detroit y2038} {
+ clock format 3434940001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.678 {time zone boundary case 2079-04-02 01:59:59} {detroit y2038} {
- clock format 3447644399 -format {%H:%M:%S %z %Z} \
+test clock-5.678 {time zone boundary case 2079-03-12 01:59:59} {detroit y2038} {
+ clock format 3445829999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.679 {time zone boundary case 2079-04-02 03:00:00} {detroit y2038} {
- clock format 3447644400 -format {%H:%M:%S %z %Z} \
+test clock-5.679 {time zone boundary case 2079-03-12 03:00:00} {detroit y2038} {
+ clock format 3445830000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.680 {time zone boundary case 2079-04-02 03:00:01} {detroit y2038} {
- clock format 3447644401 -format {%H:%M:%S %z %Z} \
+test clock-5.680 {time zone boundary case 2079-03-12 03:00:01} {detroit y2038} {
+ clock format 3445830001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.681 {time zone boundary case 2079-10-29 01:59:59} {detroit y2038} {
- clock format 3465784799 -format {%H:%M:%S %z %Z} \
+test clock-5.681 {time zone boundary case 2079-11-05 01:59:59} {detroit y2038} {
+ clock format 3466389599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.682 {time zone boundary case 2079-10-29 01:00:00} {detroit y2038} {
- clock format 3465784800 -format {%H:%M:%S %z %Z} \
+test clock-5.682 {time zone boundary case 2079-11-05 01:00:00} {detroit y2038} {
+ clock format 3466389600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.683 {time zone boundary case 2079-10-29 01:00:01} {detroit y2038} {
- clock format 3465784801 -format {%H:%M:%S %z %Z} \
+test clock-5.683 {time zone boundary case 2079-11-05 01:00:01} {detroit y2038} {
+ clock format 3466389601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.684 {time zone boundary case 2080-04-07 01:59:59} {detroit y2038} {
- clock format 3479698799 -format {%H:%M:%S %z %Z} \
+test clock-5.684 {time zone boundary case 2080-03-10 01:59:59} {detroit y2038} {
+ clock format 3477279599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.685 {time zone boundary case 2080-04-07 03:00:00} {detroit y2038} {
- clock format 3479698800 -format {%H:%M:%S %z %Z} \
+test clock-5.685 {time zone boundary case 2080-03-10 03:00:00} {detroit y2038} {
+ clock format 3477279600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.686 {time zone boundary case 2080-04-07 03:00:01} {detroit y2038} {
- clock format 3479698801 -format {%H:%M:%S %z %Z} \
+test clock-5.686 {time zone boundary case 2080-03-10 03:00:01} {detroit y2038} {
+ clock format 3477279601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.687 {time zone boundary case 2080-10-27 01:59:59} {detroit y2038} {
- clock format 3497234399 -format {%H:%M:%S %z %Z} \
+test clock-5.687 {time zone boundary case 2080-11-03 01:59:59} {detroit y2038} {
+ clock format 3497839199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.688 {time zone boundary case 2080-10-27 01:00:00} {detroit y2038} {
- clock format 3497234400 -format {%H:%M:%S %z %Z} \
+test clock-5.688 {time zone boundary case 2080-11-03 01:00:00} {detroit y2038} {
+ clock format 3497839200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.689 {time zone boundary case 2080-10-27 01:00:01} {detroit y2038} {
- clock format 3497234401 -format {%H:%M:%S %z %Z} \
+test clock-5.689 {time zone boundary case 2080-11-03 01:00:01} {detroit y2038} {
+ clock format 3497839201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.690 {time zone boundary case 2081-04-06 01:59:59} {detroit y2038} {
- clock format 3511148399 -format {%H:%M:%S %z %Z} \
+test clock-5.690 {time zone boundary case 2081-03-09 01:59:59} {detroit y2038} {
+ clock format 3508729199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.691 {time zone boundary case 2081-04-06 03:00:00} {detroit y2038} {
- clock format 3511148400 -format {%H:%M:%S %z %Z} \
+test clock-5.691 {time zone boundary case 2081-03-09 03:00:00} {detroit y2038} {
+ clock format 3508729200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.692 {time zone boundary case 2081-04-06 03:00:01} {detroit y2038} {
- clock format 3511148401 -format {%H:%M:%S %z %Z} \
+test clock-5.692 {time zone boundary case 2081-03-09 03:00:01} {detroit y2038} {
+ clock format 3508729201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.693 {time zone boundary case 2081-10-26 01:59:59} {detroit y2038} {
- clock format 3528683999 -format {%H:%M:%S %z %Z} \
+test clock-5.693 {time zone boundary case 2081-11-02 01:59:59} {detroit y2038} {
+ clock format 3529288799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.694 {time zone boundary case 2081-10-26 01:00:00} {detroit y2038} {
- clock format 3528684000 -format {%H:%M:%S %z %Z} \
+test clock-5.694 {time zone boundary case 2081-11-02 01:00:00} {detroit y2038} {
+ clock format 3529288800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.695 {time zone boundary case 2081-10-26 01:00:01} {detroit y2038} {
- clock format 3528684001 -format {%H:%M:%S %z %Z} \
+test clock-5.695 {time zone boundary case 2081-11-02 01:00:01} {detroit y2038} {
+ clock format 3529288801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.696 {time zone boundary case 2082-04-05 01:59:59} {detroit y2038} {
- clock format 3542597999 -format {%H:%M:%S %z %Z} \
+test clock-5.696 {time zone boundary case 2082-03-08 01:59:59} {detroit y2038} {
+ clock format 3540178799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.697 {time zone boundary case 2082-04-05 03:00:00} {detroit y2038} {
- clock format 3542598000 -format {%H:%M:%S %z %Z} \
+test clock-5.697 {time zone boundary case 2082-03-08 03:00:00} {detroit y2038} {
+ clock format 3540178800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.698 {time zone boundary case 2082-04-05 03:00:01} {detroit y2038} {
- clock format 3542598001 -format {%H:%M:%S %z %Z} \
+test clock-5.698 {time zone boundary case 2082-03-08 03:00:01} {detroit y2038} {
+ clock format 3540178801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.699 {time zone boundary case 2082-10-25 01:59:59} {detroit y2038} {
- clock format 3560133599 -format {%H:%M:%S %z %Z} \
+test clock-5.699 {time zone boundary case 2082-11-01 01:59:59} {detroit y2038} {
+ clock format 3560738399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.700 {time zone boundary case 2082-10-25 01:00:00} {detroit y2038} {
- clock format 3560133600 -format {%H:%M:%S %z %Z} \
+test clock-5.700 {time zone boundary case 2082-11-01 01:00:00} {detroit y2038} {
+ clock format 3560738400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.701 {time zone boundary case 2082-10-25 01:00:01} {detroit y2038} {
- clock format 3560133601 -format {%H:%M:%S %z %Z} \
+test clock-5.701 {time zone boundary case 2082-11-01 01:00:01} {detroit y2038} {
+ clock format 3560738401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.702 {time zone boundary case 2083-04-04 01:59:59} {detroit y2038} {
- clock format 3574047599 -format {%H:%M:%S %z %Z} \
+test clock-5.702 {time zone boundary case 2083-03-14 01:59:59} {detroit y2038} {
+ clock format 3572233199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.703 {time zone boundary case 2083-04-04 03:00:00} {detroit y2038} {
- clock format 3574047600 -format {%H:%M:%S %z %Z} \
+test clock-5.703 {time zone boundary case 2083-03-14 03:00:00} {detroit y2038} {
+ clock format 3572233200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.704 {time zone boundary case 2083-04-04 03:00:01} {detroit y2038} {
- clock format 3574047601 -format {%H:%M:%S %z %Z} \
+test clock-5.704 {time zone boundary case 2083-03-14 03:00:01} {detroit y2038} {
+ clock format 3572233201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.705 {time zone boundary case 2083-10-31 01:59:59} {detroit y2038} {
- clock format 3592187999 -format {%H:%M:%S %z %Z} \
+test clock-5.705 {time zone boundary case 2083-11-07 01:59:59} {detroit y2038} {
+ clock format 3592792799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.706 {time zone boundary case 2083-10-31 01:00:00} {detroit y2038} {
- clock format 3592188000 -format {%H:%M:%S %z %Z} \
+test clock-5.706 {time zone boundary case 2083-11-07 01:00:00} {detroit y2038} {
+ clock format 3592792800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.707 {time zone boundary case 2083-10-31 01:00:01} {detroit y2038} {
- clock format 3592188001 -format {%H:%M:%S %z %Z} \
+test clock-5.707 {time zone boundary case 2083-11-07 01:00:01} {detroit y2038} {
+ clock format 3592792801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.708 {time zone boundary case 2084-04-02 01:59:59} {detroit y2038} {
- clock format 3605497199 -format {%H:%M:%S %z %Z} \
+test clock-5.708 {time zone boundary case 2084-03-12 01:59:59} {detroit y2038} {
+ clock format 3603682799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.709 {time zone boundary case 2084-04-02 03:00:00} {detroit y2038} {
- clock format 3605497200 -format {%H:%M:%S %z %Z} \
+test clock-5.709 {time zone boundary case 2084-03-12 03:00:00} {detroit y2038} {
+ clock format 3603682800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.710 {time zone boundary case 2084-04-02 03:00:01} {detroit y2038} {
- clock format 3605497201 -format {%H:%M:%S %z %Z} \
+test clock-5.710 {time zone boundary case 2084-03-12 03:00:01} {detroit y2038} {
+ clock format 3603682801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.711 {time zone boundary case 2084-10-29 01:59:59} {detroit y2038} {
- clock format 3623637599 -format {%H:%M:%S %z %Z} \
+test clock-5.711 {time zone boundary case 2084-11-05 01:59:59} {detroit y2038} {
+ clock format 3624242399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.712 {time zone boundary case 2084-10-29 01:00:00} {detroit y2038} {
- clock format 3623637600 -format {%H:%M:%S %z %Z} \
+test clock-5.712 {time zone boundary case 2084-11-05 01:00:00} {detroit y2038} {
+ clock format 3624242400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.713 {time zone boundary case 2084-10-29 01:00:01} {detroit y2038} {
- clock format 3623637601 -format {%H:%M:%S %z %Z} \
+test clock-5.713 {time zone boundary case 2084-11-05 01:00:01} {detroit y2038} {
+ clock format 3624242401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.714 {time zone boundary case 2085-04-01 01:59:59} {detroit y2038} {
- clock format 3636946799 -format {%H:%M:%S %z %Z} \
+test clock-5.714 {time zone boundary case 2085-03-11 01:59:59} {detroit y2038} {
+ clock format 3635132399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.715 {time zone boundary case 2085-04-01 03:00:00} {detroit y2038} {
- clock format 3636946800 -format {%H:%M:%S %z %Z} \
+test clock-5.715 {time zone boundary case 2085-03-11 03:00:00} {detroit y2038} {
+ clock format 3635132400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.716 {time zone boundary case 2085-04-01 03:00:01} {detroit y2038} {
- clock format 3636946801 -format {%H:%M:%S %z %Z} \
+test clock-5.716 {time zone boundary case 2085-03-11 03:00:01} {detroit y2038} {
+ clock format 3635132401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.717 {time zone boundary case 2085-10-28 01:59:59} {detroit y2038} {
- clock format 3655087199 -format {%H:%M:%S %z %Z} \
+test clock-5.717 {time zone boundary case 2085-11-04 01:59:59} {detroit y2038} {
+ clock format 3655691999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.718 {time zone boundary case 2085-10-28 01:00:00} {detroit y2038} {
- clock format 3655087200 -format {%H:%M:%S %z %Z} \
+test clock-5.718 {time zone boundary case 2085-11-04 01:00:00} {detroit y2038} {
+ clock format 3655692000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.719 {time zone boundary case 2085-10-28 01:00:01} {detroit y2038} {
- clock format 3655087201 -format {%H:%M:%S %z %Z} \
+test clock-5.719 {time zone boundary case 2085-11-04 01:00:01} {detroit y2038} {
+ clock format 3655692001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.720 {time zone boundary case 2086-04-07 01:59:59} {detroit y2038} {
- clock format 3669001199 -format {%H:%M:%S %z %Z} \
+test clock-5.720 {time zone boundary case 2086-03-10 01:59:59} {detroit y2038} {
+ clock format 3666581999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.721 {time zone boundary case 2086-04-07 03:00:00} {detroit y2038} {
- clock format 3669001200 -format {%H:%M:%S %z %Z} \
+test clock-5.721 {time zone boundary case 2086-03-10 03:00:00} {detroit y2038} {
+ clock format 3666582000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.722 {time zone boundary case 2086-04-07 03:00:01} {detroit y2038} {
- clock format 3669001201 -format {%H:%M:%S %z %Z} \
+test clock-5.722 {time zone boundary case 2086-03-10 03:00:01} {detroit y2038} {
+ clock format 3666582001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.723 {time zone boundary case 2086-10-27 01:59:59} {detroit y2038} {
- clock format 3686536799 -format {%H:%M:%S %z %Z} \
+test clock-5.723 {time zone boundary case 2086-11-03 01:59:59} {detroit y2038} {
+ clock format 3687141599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.724 {time zone boundary case 2086-10-27 01:00:00} {detroit y2038} {
- clock format 3686536800 -format {%H:%M:%S %z %Z} \
+test clock-5.724 {time zone boundary case 2086-11-03 01:00:00} {detroit y2038} {
+ clock format 3687141600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.725 {time zone boundary case 2086-10-27 01:00:01} {detroit y2038} {
- clock format 3686536801 -format {%H:%M:%S %z %Z} \
+test clock-5.725 {time zone boundary case 2086-11-03 01:00:01} {detroit y2038} {
+ clock format 3687141601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.726 {time zone boundary case 2087-04-06 01:59:59} {detroit y2038} {
- clock format 3700450799 -format {%H:%M:%S %z %Z} \
+test clock-5.726 {time zone boundary case 2087-03-09 01:59:59} {detroit y2038} {
+ clock format 3698031599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.727 {time zone boundary case 2087-04-06 03:00:00} {detroit y2038} {
- clock format 3700450800 -format {%H:%M:%S %z %Z} \
+test clock-5.727 {time zone boundary case 2087-03-09 03:00:00} {detroit y2038} {
+ clock format 3698031600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.728 {time zone boundary case 2087-04-06 03:00:01} {detroit y2038} {
- clock format 3700450801 -format {%H:%M:%S %z %Z} \
+test clock-5.728 {time zone boundary case 2087-03-09 03:00:01} {detroit y2038} {
+ clock format 3698031601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.729 {time zone boundary case 2087-10-26 01:59:59} {detroit y2038} {
- clock format 3717986399 -format {%H:%M:%S %z %Z} \
+test clock-5.729 {time zone boundary case 2087-11-02 01:59:59} {detroit y2038} {
+ clock format 3718591199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.730 {time zone boundary case 2087-10-26 01:00:00} {detroit y2038} {
- clock format 3717986400 -format {%H:%M:%S %z %Z} \
+test clock-5.730 {time zone boundary case 2087-11-02 01:00:00} {detroit y2038} {
+ clock format 3718591200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.731 {time zone boundary case 2087-10-26 01:00:01} {detroit y2038} {
- clock format 3717986401 -format {%H:%M:%S %z %Z} \
+test clock-5.731 {time zone boundary case 2087-11-02 01:00:01} {detroit y2038} {
+ clock format 3718591201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.732 {time zone boundary case 2088-04-04 01:59:59} {detroit y2038} {
- clock format 3731900399 -format {%H:%M:%S %z %Z} \
+test clock-5.732 {time zone boundary case 2088-03-14 01:59:59} {detroit y2038} {
+ clock format 3730085999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.733 {time zone boundary case 2088-04-04 03:00:00} {detroit y2038} {
- clock format 3731900400 -format {%H:%M:%S %z %Z} \
+test clock-5.733 {time zone boundary case 2088-03-14 03:00:00} {detroit y2038} {
+ clock format 3730086000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.734 {time zone boundary case 2088-04-04 03:00:01} {detroit y2038} {
- clock format 3731900401 -format {%H:%M:%S %z %Z} \
+test clock-5.734 {time zone boundary case 2088-03-14 03:00:01} {detroit y2038} {
+ clock format 3730086001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.735 {time zone boundary case 2088-10-31 01:59:59} {detroit y2038} {
- clock format 3750040799 -format {%H:%M:%S %z %Z} \
+test clock-5.735 {time zone boundary case 2088-11-07 01:59:59} {detroit y2038} {
+ clock format 3750645599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.736 {time zone boundary case 2088-10-31 01:00:00} {detroit y2038} {
- clock format 3750040800 -format {%H:%M:%S %z %Z} \
+test clock-5.736 {time zone boundary case 2088-11-07 01:00:00} {detroit y2038} {
+ clock format 3750645600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.737 {time zone boundary case 2088-10-31 01:00:01} {detroit y2038} {
- clock format 3750040801 -format {%H:%M:%S %z %Z} \
+test clock-5.737 {time zone boundary case 2088-11-07 01:00:01} {detroit y2038} {
+ clock format 3750645601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.738 {time zone boundary case 2089-04-03 01:59:59} {detroit y2038} {
- clock format 3763349999 -format {%H:%M:%S %z %Z} \
+test clock-5.738 {time zone boundary case 2089-03-13 01:59:59} {detroit y2038} {
+ clock format 3761535599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.739 {time zone boundary case 2089-04-03 03:00:00} {detroit y2038} {
- clock format 3763350000 -format {%H:%M:%S %z %Z} \
+test clock-5.739 {time zone boundary case 2089-03-13 03:00:00} {detroit y2038} {
+ clock format 3761535600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.740 {time zone boundary case 2089-04-03 03:00:01} {detroit y2038} {
- clock format 3763350001 -format {%H:%M:%S %z %Z} \
+test clock-5.740 {time zone boundary case 2089-03-13 03:00:01} {detroit y2038} {
+ clock format 3761535601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.741 {time zone boundary case 2089-10-30 01:59:59} {detroit y2038} {
- clock format 3781490399 -format {%H:%M:%S %z %Z} \
+test clock-5.741 {time zone boundary case 2089-11-06 01:59:59} {detroit y2038} {
+ clock format 3782095199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.742 {time zone boundary case 2089-10-30 01:00:00} {detroit y2038} {
- clock format 3781490400 -format {%H:%M:%S %z %Z} \
+test clock-5.742 {time zone boundary case 2089-11-06 01:00:00} {detroit y2038} {
+ clock format 3782095200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.743 {time zone boundary case 2089-10-30 01:00:01} {detroit y2038} {
- clock format 3781490401 -format {%H:%M:%S %z %Z} \
+test clock-5.743 {time zone boundary case 2089-11-06 01:00:01} {detroit y2038} {
+ clock format 3782095201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.744 {time zone boundary case 2090-04-02 01:59:59} {detroit y2038} {
- clock format 3794799599 -format {%H:%M:%S %z %Z} \
+test clock-5.744 {time zone boundary case 2090-03-12 01:59:59} {detroit y2038} {
+ clock format 3792985199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.745 {time zone boundary case 2090-04-02 03:00:00} {detroit y2038} {
- clock format 3794799600 -format {%H:%M:%S %z %Z} \
+test clock-5.745 {time zone boundary case 2090-03-12 03:00:00} {detroit y2038} {
+ clock format 3792985200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.746 {time zone boundary case 2090-04-02 03:00:01} {detroit y2038} {
- clock format 3794799601 -format {%H:%M:%S %z %Z} \
+test clock-5.746 {time zone boundary case 2090-03-12 03:00:01} {detroit y2038} {
+ clock format 3792985201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.747 {time zone boundary case 2090-10-29 01:59:59} {detroit y2038} {
- clock format 3812939999 -format {%H:%M:%S %z %Z} \
+test clock-5.747 {time zone boundary case 2090-11-05 01:59:59} {detroit y2038} {
+ clock format 3813544799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.748 {time zone boundary case 2090-10-29 01:00:00} {detroit y2038} {
- clock format 3812940000 -format {%H:%M:%S %z %Z} \
+test clock-5.748 {time zone boundary case 2090-11-05 01:00:00} {detroit y2038} {
+ clock format 3813544800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.749 {time zone boundary case 2090-10-29 01:00:01} {detroit y2038} {
- clock format 3812940001 -format {%H:%M:%S %z %Z} \
+test clock-5.749 {time zone boundary case 2090-11-05 01:00:01} {detroit y2038} {
+ clock format 3813544801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.750 {time zone boundary case 2091-04-01 01:59:59} {detroit y2038} {
- clock format 3826249199 -format {%H:%M:%S %z %Z} \
+test clock-5.750 {time zone boundary case 2091-03-11 01:59:59} {detroit y2038} {
+ clock format 3824434799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.751 {time zone boundary case 2091-04-01 03:00:00} {detroit y2038} {
- clock format 3826249200 -format {%H:%M:%S %z %Z} \
+test clock-5.751 {time zone boundary case 2091-03-11 03:00:00} {detroit y2038} {
+ clock format 3824434800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.752 {time zone boundary case 2091-04-01 03:00:01} {detroit y2038} {
- clock format 3826249201 -format {%H:%M:%S %z %Z} \
+test clock-5.752 {time zone boundary case 2091-03-11 03:00:01} {detroit y2038} {
+ clock format 3824434801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.753 {time zone boundary case 2091-10-28 01:59:59} {detroit y2038} {
- clock format 3844389599 -format {%H:%M:%S %z %Z} \
+test clock-5.753 {time zone boundary case 2091-11-04 01:59:59} {detroit y2038} {
+ clock format 3844994399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.754 {time zone boundary case 2091-10-28 01:00:00} {detroit y2038} {
- clock format 3844389600 -format {%H:%M:%S %z %Z} \
+test clock-5.754 {time zone boundary case 2091-11-04 01:00:00} {detroit y2038} {
+ clock format 3844994400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.755 {time zone boundary case 2091-10-28 01:00:01} {detroit y2038} {
- clock format 3844389601 -format {%H:%M:%S %z %Z} \
+test clock-5.755 {time zone boundary case 2091-11-04 01:00:01} {detroit y2038} {
+ clock format 3844994401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.756 {time zone boundary case 2092-04-06 01:59:59} {detroit y2038} {
- clock format 3858303599 -format {%H:%M:%S %z %Z} \
+test clock-5.756 {time zone boundary case 2092-03-09 01:59:59} {detroit y2038} {
+ clock format 3855884399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.757 {time zone boundary case 2092-04-06 03:00:00} {detroit y2038} {
- clock format 3858303600 -format {%H:%M:%S %z %Z} \
+test clock-5.757 {time zone boundary case 2092-03-09 03:00:00} {detroit y2038} {
+ clock format 3855884400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.758 {time zone boundary case 2092-04-06 03:00:01} {detroit y2038} {
- clock format 3858303601 -format {%H:%M:%S %z %Z} \
+test clock-5.758 {time zone boundary case 2092-03-09 03:00:01} {detroit y2038} {
+ clock format 3855884401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.759 {time zone boundary case 2092-10-26 01:59:59} {detroit y2038} {
- clock format 3875839199 -format {%H:%M:%S %z %Z} \
+test clock-5.759 {time zone boundary case 2092-11-02 01:59:59} {detroit y2038} {
+ clock format 3876443999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.760 {time zone boundary case 2092-10-26 01:00:00} {detroit y2038} {
- clock format 3875839200 -format {%H:%M:%S %z %Z} \
+test clock-5.760 {time zone boundary case 2092-11-02 01:00:00} {detroit y2038} {
+ clock format 3876444000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.761 {time zone boundary case 2092-10-26 01:00:01} {detroit y2038} {
- clock format 3875839201 -format {%H:%M:%S %z %Z} \
+test clock-5.761 {time zone boundary case 2092-11-02 01:00:01} {detroit y2038} {
+ clock format 3876444001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.762 {time zone boundary case 2093-04-05 01:59:59} {detroit y2038} {
- clock format 3889753199 -format {%H:%M:%S %z %Z} \
+test clock-5.762 {time zone boundary case 2093-03-08 01:59:59} {detroit y2038} {
+ clock format 3887333999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.763 {time zone boundary case 2093-04-05 03:00:00} {detroit y2038} {
- clock format 3889753200 -format {%H:%M:%S %z %Z} \
+test clock-5.763 {time zone boundary case 2093-03-08 03:00:00} {detroit y2038} {
+ clock format 3887334000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.764 {time zone boundary case 2093-04-05 03:00:01} {detroit y2038} {
- clock format 3889753201 -format {%H:%M:%S %z %Z} \
+test clock-5.764 {time zone boundary case 2093-03-08 03:00:01} {detroit y2038} {
+ clock format 3887334001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.765 {time zone boundary case 2093-10-25 01:59:59} {detroit y2038} {
- clock format 3907288799 -format {%H:%M:%S %z %Z} \
+test clock-5.765 {time zone boundary case 2093-11-01 01:59:59} {detroit y2038} {
+ clock format 3907893599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.766 {time zone boundary case 2093-10-25 01:00:00} {detroit y2038} {
- clock format 3907288800 -format {%H:%M:%S %z %Z} \
+test clock-5.766 {time zone boundary case 2093-11-01 01:00:00} {detroit y2038} {
+ clock format 3907893600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.767 {time zone boundary case 2093-10-25 01:00:01} {detroit y2038} {
- clock format 3907288801 -format {%H:%M:%S %z %Z} \
+test clock-5.767 {time zone boundary case 2093-11-01 01:00:01} {detroit y2038} {
+ clock format 3907893601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.768 {time zone boundary case 2094-04-04 01:59:59} {detroit y2038} {
- clock format 3921202799 -format {%H:%M:%S %z %Z} \
+test clock-5.768 {time zone boundary case 2094-03-14 01:59:59} {detroit y2038} {
+ clock format 3919388399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.769 {time zone boundary case 2094-04-04 03:00:00} {detroit y2038} {
- clock format 3921202800 -format {%H:%M:%S %z %Z} \
+test clock-5.769 {time zone boundary case 2094-03-14 03:00:00} {detroit y2038} {
+ clock format 3919388400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.770 {time zone boundary case 2094-04-04 03:00:01} {detroit y2038} {
- clock format 3921202801 -format {%H:%M:%S %z %Z} \
+test clock-5.770 {time zone boundary case 2094-03-14 03:00:01} {detroit y2038} {
+ clock format 3919388401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.771 {time zone boundary case 2094-10-31 01:59:59} {detroit y2038} {
- clock format 3939343199 -format {%H:%M:%S %z %Z} \
+test clock-5.771 {time zone boundary case 2094-11-07 01:59:59} {detroit y2038} {
+ clock format 3939947999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.772 {time zone boundary case 2094-10-31 01:00:00} {detroit y2038} {
- clock format 3939343200 -format {%H:%M:%S %z %Z} \
+test clock-5.772 {time zone boundary case 2094-11-07 01:00:00} {detroit y2038} {
+ clock format 3939948000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.773 {time zone boundary case 2094-10-31 01:00:01} {detroit y2038} {
- clock format 3939343201 -format {%H:%M:%S %z %Z} \
+test clock-5.773 {time zone boundary case 2094-11-07 01:00:01} {detroit y2038} {
+ clock format 3939948001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.774 {time zone boundary case 2095-04-03 01:59:59} {detroit y2038} {
- clock format 3952652399 -format {%H:%M:%S %z %Z} \
+test clock-5.774 {time zone boundary case 2095-03-13 01:59:59} {detroit y2038} {
+ clock format 3950837999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.775 {time zone boundary case 2095-04-03 03:00:00} {detroit y2038} {
- clock format 3952652400 -format {%H:%M:%S %z %Z} \
+test clock-5.775 {time zone boundary case 2095-03-13 03:00:00} {detroit y2038} {
+ clock format 3950838000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.776 {time zone boundary case 2095-04-03 03:00:01} {detroit y2038} {
- clock format 3952652401 -format {%H:%M:%S %z %Z} \
+test clock-5.776 {time zone boundary case 2095-03-13 03:00:01} {detroit y2038} {
+ clock format 3950838001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.777 {time zone boundary case 2095-10-30 01:59:59} {detroit y2038} {
- clock format 3970792799 -format {%H:%M:%S %z %Z} \
+test clock-5.777 {time zone boundary case 2095-11-06 01:59:59} {detroit y2038} {
+ clock format 3971397599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.778 {time zone boundary case 2095-10-30 01:00:00} {detroit y2038} {
- clock format 3970792800 -format {%H:%M:%S %z %Z} \
+test clock-5.778 {time zone boundary case 2095-11-06 01:00:00} {detroit y2038} {
+ clock format 3971397600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.779 {time zone boundary case 2095-10-30 01:00:01} {detroit y2038} {
- clock format 3970792801 -format {%H:%M:%S %z %Z} \
+test clock-5.779 {time zone boundary case 2095-11-06 01:00:01} {detroit y2038} {
+ clock format 3971397601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.780 {time zone boundary case 2096-04-01 01:59:59} {detroit y2038} {
- clock format 3984101999 -format {%H:%M:%S %z %Z} \
+test clock-5.780 {time zone boundary case 2096-03-11 01:59:59} {detroit y2038} {
+ clock format 3982287599 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.781 {time zone boundary case 2096-04-01 03:00:00} {detroit y2038} {
- clock format 3984102000 -format {%H:%M:%S %z %Z} \
+test clock-5.781 {time zone boundary case 2096-03-11 03:00:00} {detroit y2038} {
+ clock format 3982287600 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.782 {time zone boundary case 2096-04-01 03:00:01} {detroit y2038} {
- clock format 3984102001 -format {%H:%M:%S %z %Z} \
+test clock-5.782 {time zone boundary case 2096-03-11 03:00:01} {detroit y2038} {
+ clock format 3982287601 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.783 {time zone boundary case 2096-10-28 01:59:59} {detroit y2038} {
- clock format 4002242399 -format {%H:%M:%S %z %Z} \
+test clock-5.783 {time zone boundary case 2096-11-04 01:59:59} {detroit y2038} {
+ clock format 4002847199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.784 {time zone boundary case 2096-10-28 01:00:00} {detroit y2038} {
- clock format 4002242400 -format {%H:%M:%S %z %Z} \
+test clock-5.784 {time zone boundary case 2096-11-04 01:00:00} {detroit y2038} {
+ clock format 4002847200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.785 {time zone boundary case 2096-10-28 01:00:01} {detroit y2038} {
- clock format 4002242401 -format {%H:%M:%S %z %Z} \
+test clock-5.785 {time zone boundary case 2096-11-04 01:00:01} {detroit y2038} {
+ clock format 4002847201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.786 {time zone boundary case 2097-04-07 01:59:59} {detroit y2038} {
- clock format 4016156399 -format {%H:%M:%S %z %Z} \
+test clock-5.786 {time zone boundary case 2097-03-10 01:59:59} {detroit y2038} {
+ clock format 4013737199 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.787 {time zone boundary case 2097-04-07 03:00:00} {detroit y2038} {
- clock format 4016156400 -format {%H:%M:%S %z %Z} \
+test clock-5.787 {time zone boundary case 2097-03-10 03:00:00} {detroit y2038} {
+ clock format 4013737200 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.788 {time zone boundary case 2097-04-07 03:00:01} {detroit y2038} {
- clock format 4016156401 -format {%H:%M:%S %z %Z} \
+test clock-5.788 {time zone boundary case 2097-03-10 03:00:01} {detroit y2038} {
+ clock format 4013737201 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.789 {time zone boundary case 2097-10-27 01:59:59} {detroit y2038} {
- clock format 4033691999 -format {%H:%M:%S %z %Z} \
+test clock-5.789 {time zone boundary case 2097-11-03 01:59:59} {detroit y2038} {
+ clock format 4034296799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.790 {time zone boundary case 2097-10-27 01:00:00} {detroit y2038} {
- clock format 4033692000 -format {%H:%M:%S %z %Z} \
+test clock-5.790 {time zone boundary case 2097-11-03 01:00:00} {detroit y2038} {
+ clock format 4034296800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.791 {time zone boundary case 2097-10-27 01:00:01} {detroit y2038} {
- clock format 4033692001 -format {%H:%M:%S %z %Z} \
+test clock-5.791 {time zone boundary case 2097-11-03 01:00:01} {detroit y2038} {
+ clock format 4034296801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.792 {time zone boundary case 2098-04-06 01:59:59} {detroit y2038} {
- clock format 4047605999 -format {%H:%M:%S %z %Z} \
+test clock-5.792 {time zone boundary case 2098-03-09 01:59:59} {detroit y2038} {
+ clock format 4045186799 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.793 {time zone boundary case 2098-04-06 03:00:00} {detroit y2038} {
- clock format 4047606000 -format {%H:%M:%S %z %Z} \
+test clock-5.793 {time zone boundary case 2098-03-09 03:00:00} {detroit y2038} {
+ clock format 4045186800 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.794 {time zone boundary case 2098-04-06 03:00:01} {detroit y2038} {
- clock format 4047606001 -format {%H:%M:%S %z %Z} \
+test clock-5.794 {time zone boundary case 2098-03-09 03:00:01} {detroit y2038} {
+ clock format 4045186801 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.795 {time zone boundary case 2098-10-26 01:59:59} {detroit y2038} {
- clock format 4065141599 -format {%H:%M:%S %z %Z} \
+test clock-5.795 {time zone boundary case 2098-11-02 01:59:59} {detroit y2038} {
+ clock format 4065746399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.796 {time zone boundary case 2098-10-26 01:00:00} {detroit y2038} {
- clock format 4065141600 -format {%H:%M:%S %z %Z} \
+test clock-5.796 {time zone boundary case 2098-11-02 01:00:00} {detroit y2038} {
+ clock format 4065746400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.797 {time zone boundary case 2098-10-26 01:00:01} {detroit y2038} {
- clock format 4065141601 -format {%H:%M:%S %z %Z} \
+test clock-5.797 {time zone boundary case 2098-11-02 01:00:01} {detroit y2038} {
+ clock format 4065746401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
-test clock-5.798 {time zone boundary case 2099-04-05 01:59:59} {detroit y2038} {
- clock format 4079055599 -format {%H:%M:%S %z %Z} \
+test clock-5.798 {time zone boundary case 2099-03-08 01:59:59} {detroit y2038} {
+ clock format 4076636399 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0500 EST}
-test clock-5.799 {time zone boundary case 2099-04-05 03:00:00} {detroit y2038} {
- clock format 4079055600 -format {%H:%M:%S %z %Z} \
+test clock-5.799 {time zone boundary case 2099-03-08 03:00:00} {detroit y2038} {
+ clock format 4076636400 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:00 -0400 EDT}
-test clock-5.800 {time zone boundary case 2099-04-05 03:00:01} {detroit y2038} {
- clock format 4079055601 -format {%H:%M:%S %z %Z} \
+test clock-5.800 {time zone boundary case 2099-03-08 03:00:01} {detroit y2038} {
+ clock format 4076636401 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {03:00:01 -0400 EDT}
-test clock-5.801 {time zone boundary case 2099-10-25 01:59:59} {detroit y2038} {
- clock format 4096591199 -format {%H:%M:%S %z %Z} \
+test clock-5.801 {time zone boundary case 2099-11-01 01:59:59} {detroit y2038} {
+ clock format 4097195999 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:59:59 -0400 EDT}
-test clock-5.802 {time zone boundary case 2099-10-25 01:00:00} {detroit y2038} {
- clock format 4096591200 -format {%H:%M:%S %z %Z} \
+test clock-5.802 {time zone boundary case 2099-11-01 01:00:00} {detroit y2038} {
+ clock format 4097196000 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:00 -0500 EST}
-test clock-5.803 {time zone boundary case 2099-10-25 01:00:01} {detroit y2038} {
- clock format 4096591201 -format {%H:%M:%S %z %Z} \
+test clock-5.803 {time zone boundary case 2099-11-01 01:00:01} {detroit y2038} {
+ clock format 4097196001 -format {%H:%M:%S %z %Z} \
-timezone :America/Detroit
} {01:00:01 -0500 EST}
# END testcases5
@@ -34536,56 +35056,78 @@ test clock-30.9 {clock add days} {
} {{2000-01-02 12:34:56} {1999-12-31 12:34:56}}
test clock-30.10 {clock add days, spring DST conversion, before} {
set t [clock scan {2004-04-03 01:59:59} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 days -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 days \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-04-04 01:59:59 -0500} {2004-04-05 01:59:59 -0400}}
test clock-30.11 {clock add days, spring DST conversion, bad case} {
set t [clock scan {2004-04-03 02:30:00} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 day -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-04-04 03:30:00 -0400} {2004-04-05 02:30:00 -0400}}
test clock-30.12 {clock add days, spring DST conversion, after} {
set t [clock scan {2004-04-03 03:00:00} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 day -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-04-04 03:00:00 -0400} {2004-04-05 03:00:00 -0400}}
test clock-30.13 {clock add days, fall DST conversion, before} {
set t [clock scan {2004-10-30 00:59:59} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 day -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-10-31 00:59:59 -0400} {2004-11-01 00:59:59 -0500}}
test clock-30.14 {clock add days, fall DST conversion, bad case} {
set t [clock scan {2004-10-30 01:30:00} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 day -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-10-31 01:30:00 -0400} {2004-11-01 01:30:00 -0500}}
test clock-30.15 {clock add days, fall DST conversion, after} {
set t [clock scan {2004-10-30 02:30:00} -format {%Y-%m-%d %H:%M:%S} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 day -timezone EST5EDT]
- set f2 [clock add $t 2 day -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
- set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f2 [clock add $t 2 day \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
list $x1 $x2
} {{2004-10-31 02:30:00 -0500} {2004-11-01 02:30:00 -0500}}
test clock-30.16 {clock add weeks} {
@@ -34609,16 +35151,19 @@ test clock-30.17 {clock add hours} {
test clock-30.18 {clock add hours at DST conversion} {
set t [clock scan {2004-04-04 01:00:00 -0500} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 hour -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 hour -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-04-04 03:00:00 -0400}
test clock-30.19 {clock add hours at DST conversion} {
set t [clock scan {2004-10-31 01:00:00 -0400} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 1 hour -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 1 hour \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
test clock-30.20 {clock add minutes} {
set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \
@@ -34632,16 +35177,20 @@ test clock-30.20 {clock add minutes} {
test clock-30.21 {clock add minutes at DST conversion} {
set t [clock scan {2004-04-04 01:00:00 -0500} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 60 minutes -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 60 minutes \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-04-04 03:00:00 -0400}
test clock-30.22 {clock add minutes at DST conversion} {
set t [clock scan {2004-10-31 01:00:00 -0400} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 60 minutes -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 60 minutes \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
test clock-30.23 {clock add seconds} {
set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \
@@ -34655,16 +35204,19 @@ test clock-30.23 {clock add seconds} {
test clock-30.24 {clock add seconds at DST conversion} {
set t [clock scan {2004-04-04 01:00:00 -0500} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 3600 seconds -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 3600 seconds \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-04-04 03:00:00 -0400}
test clock-30.25 {clock add seconds at DST conversion} {
set t [clock scan {2004-10-31 01:00:00 -0400} \
-format {%Y-%m-%d %H:%M:%S %z} \
- -timezone EST5EDT]
- set f1 [clock add $t 3600 seconds -timezone EST5EDT]
- set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+ set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
test clock-31.1 {system locale} \
@@ -34673,6 +35225,8 @@ test clock-31.1 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
::tcl::clock::ClearCaches
} \
-body {
@@ -34682,6 +35236,7 @@ test clock-31.1 {system locale} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
::tcl::clock::ClearCaches
} \
-result [clock format 0 -timezone :UTC -locale current \
@@ -34693,6 +35248,8 @@ test clock-31.2 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
::tcl::clock::ClearCaches
} \
-body {
@@ -34702,6 +35259,7 @@ test clock-31.2 {system locale} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
::tcl::clock::ClearCaches
} \
-result [clock format 0 -timezone :UTC -locale current \
@@ -34713,6 +35271,8 @@ test clock-31.3 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
::tcl::clock::ClearCaches
} \
-body {
@@ -34722,6 +35282,7 @@ test clock-31.3 {system locale} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
::tcl::clock::ClearCaches
} \
-result [clock format 0 -timezone :UTC -locale current \
@@ -34733,6 +35294,8 @@ test clock-31.4 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
if { [info exists env(TZ)] } {
set oldTZ $env(TZ)
unset env(TZ)
@@ -34756,6 +35319,7 @@ test clock-31.4 {system locale} \
if { [info exists oldTZ] } {
set env(TZ) $oldTZ
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
::tcl::clock::ClearCaches
} \
-result [clock format 0 -locale current -timezone EST5 \
@@ -34767,6 +35331,8 @@ test clock-31.5 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
if { [info exists env(TZ)] } {
set oldTZ $env(TZ)
unset env(TZ)
@@ -34784,6 +35350,7 @@ test clock-31.5 {system locale} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
if { [info exists oldTclTZ] } {
set env(TCL_TZ) $oldTclTZ
}
@@ -34801,6 +35368,8 @@ test clock-31.6 {system locale} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
if { [info exists env(TZ)] } {
set oldTZ $env(TZ)
unset env(TZ)
@@ -34818,6 +35387,7 @@ test clock-31.6 {system locale} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
if { [info exists oldTclTZ] } {
set env(TCL_TZ) $oldTclTZ
}
@@ -34880,7 +35450,7 @@ test clock-33.2 {clock clicks tests} {
} {1}
test clock-33.3 {clock clicks tests} {
list [catch {clock clicks foo} msg] $msg
-} {1 {bad option "foo": must be -milliseconds or -microseconds}}
+} {1 {bad switch "foo": must be -milliseconds or -microseconds}}
test clock-33.4 {clock clicks tests} {
expr [clock clicks -milliseconds]+1
concat {}
@@ -34890,6 +35460,8 @@ test clock-33.4a {clock milliseconds} {
concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
set start [clock clicks -milli]
after 10
set end [clock clicks -milli]
@@ -34900,6 +35472,8 @@ test clock-33.5 {clock clicks tests, millisecond timing test} {
"test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.5a {clock tests, millisecond timing test} {
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
set start [clock milliseconds]
after 10
set end [clock milliseconds]
@@ -34910,19 +35484,23 @@ test clock-33.5a {clock tests, millisecond timing test} {
"test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
- list [catch { clock clicks {} } msg] $msg
-} {1 {bad option "": must be -milliseconds or -microseconds}}
+ list [catch { clock clicks ? } msg] $msg
+} {1 {bad switch "?": must be -milliseconds or -microseconds}}
test clock-33.7 {clock clicks, milli with too much abbreviation} {
list [catch { clock clicks - } msg] $msg
-} {1 {ambiguous option "-": must be -milliseconds or -microseconds}}
+} {1 {ambiguous switch "-": must be -milliseconds or -microseconds}}
test clock-33.8 {clock clicks test, microsecond timing test} {
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
set start [clock clicks -micro]
after 10
set end [clock clicks -micro]
expr {($end > $start) && (($end - $start) <= 60000)}
} {1}
test clock-33.8a {clock test, microsecond timing test} {
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
set start [clock microseconds]
after 10
set end [clock microseconds]
@@ -34995,10 +35573,13 @@ test clock-33.11a {clock test, millis align with micros} {
# clock scan
test clock-34.1 {clock scan tests} {
list [catch {clock scan} msg] $msg
-} {1 {wrong # args: should be "::tcl::clock::scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
-test clock-34.2 {clock scan tests} {
- list [catch {clock scan "bad-string"} msg] $msg
-} {1 {unable to convert date-time string "bad-string"}}
+} {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
+test clock-34.2 {clock scan tests} {*}{
+ -body {clock scan "bad-string"}
+ -returnCodes error
+ -match glob
+ -result {unable to convert date-time string "bad-string"*}
+}
test clock-34.3 {clock scan tests} {
clock format [clock scan "14 Feb 92" -gmt true] \
-format {%m/%d/%y %I:%M:%S %p} -gmt true
@@ -35222,6 +35803,38 @@ test clock-34.47 {ago with multiple relative units} {
expr {$base - $res}
} 180000
+test clock-34.48 {more than one ToD} {*}{
+ -body {clock scan {10:00 11:00}}
+ -returnCodes error
+ -result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
+}
+
+test clock-34.49 {more than one date} {*}{
+ -body {clock scan {1/1/2001 2/2/2002}}
+ -returnCodes error
+ -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
+}
+
+test clock-34.50 {more than one time zone} {*}{
+ -body {clock scan {10:00 EST CST}}
+ -returnCodes error
+ -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
+}
+
+test clock-34.51 {more than one weekday} {*}{
+ -body {clock scan {Monday Tuesday}}
+ -returnCodes error
+ -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
+}
+
+test clock-34.52 {more than one ordinal month} {*}{
+ -body {clock scan {next January next March}}
+ -returnCodes error
+ -result {unable to convert date-time string "next January next March": more than one ordinal month in string}
+}
+
+
+
# clock seconds
test clock-35.1 {clock seconds tests} {
expr [clock seconds]+1
@@ -35280,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}
@@ -35292,7 +35938,7 @@ test clock-40.1 {regression - bad month with -timezone :localtime} \
set env(TZ) UTC0
} \
-body {
- clock scan 1970-01-01T00:00:00 -timezone :localtime \
+ clock scan 2000-01-01T00:00:00 -timezone :localtime \
-format %Y-%m-%dT%H:%M:%S
} \
-cleanup {
@@ -35303,7 +35949,7 @@ test clock-40.1 {regression - bad month with -timezone :localtime} \
unset env(TZ)
}
} \
- -result {0}
+ -result 946684800
test clock-41.1 {regression test - format group %k when hour is 0 } {
clock format 0 -format %k -gmt true
@@ -35409,6 +36055,8 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
+ set noreg [info exists ::tcl::clock::NoRegistry]
+ if {$noreg} {unset ::tcl::clock::NoRegistry}
if { [info exists env(TZ)] } {
set oldTZ $env(TZ)
unset env(TZ)
@@ -35419,13 +36067,13 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
}
# make it so New York time is a missing file
dict set ::tcl::clock::WinZoneInfo \
- {-18000 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} \
+ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
:No/Such/File
::tcl::clock::ClearCaches
} \
-body {
list [::tcl::clock::GuessWindowsTimeZone] \
- [clock format 0 -locale system -format "%X %Z"] \
+ [clock format 0 -locale system -format "%H:%M:%S %Z"] \
[clock format -86400 -format "%Y"]
} \
-cleanup {
@@ -35433,6 +36081,7 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
namespace eval ::tcl::clock {
rename registry {}
}
+ if {$noreg} {set ::tcl::clock::NoRegistry {}}
if { [info exists oldTclTZ] } {
set env(TCL_TZ) $oldTclTZ
}
@@ -35441,11 +36090,11 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
}
# put New York back on the map
dict set ::tcl::clock::WinZoneInfo \
- {-18000 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} \
+ {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
:America/New_York
::tcl::clock::ClearCaches
} \
- -result {<-0500>+05:00:00<-0400>+04:00:00,M4.1.0/02:00:00,M10.5.0/02:00:00 { 7:00:00 PM -0500} 1969}
+ -result {<-0500>+05:00:00<-0400>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00 {19:00:00 -0500} 1969}
test clock-50.1 {format / scan -1 as a local time} {
if {[catch {
@@ -35472,6 +36121,821 @@ test clock-50.2 {format / scan -2 as a local time} {
set result
} -2
+test clock-51.1 {correct conversion of times in Sydney} {
+ # Paul Mackerras reported a bug where DST rollover in New South Wales
+ # was miscalculated. The problem was that tclZIC.tcl had a
+ # typo in the switch case where DST begins/ends at a given time
+ # Standard Time (that is, winter time).
+ set result {}
+ foreach t {1130601599 1130601600 1130637599 1130637600} {
+ lappend result [clock format $t -format %H:%M:%S \
+ -timezone :Australia/Sydney]
+ }
+ set result
+} {01:59:59 03:00:00 12:59:59 13:00:00}
+
+test clock-52.1 {Posix timezone and conversion on last Sunday} {
+ # Martin Lemburg reported a bug where if tzdata is missing, then
+ # times are converted incorrectly in locales where DST conversion
+ # happens in the last (nominal 5th) week of a month.
+ set result {}
+ set timezone <MEZ>-01:00:00<MESZ>-02:00:00,M3.5.0/02:00:00,M10.5.0/01:00:00
+ foreach t {1143334799 1143334800} {
+ lappend result [clock format $t -format %H:%M:%S -timezone $timezone] \
+ [clock format $t -format %H:%M:%S -timezone :Europe/Berlin]
+ }
+ set result
+} {01:59:59 01:59:59 03:00:00 03:00:00}
+
+test clock-52.2 {correct conversion of times in Europe} {
+ # [Bug 2207436]
+ set result {}
+ foreach t [list 1206838799 1206838800 1224982799 1224982800] {
+ lappend result [clock format $t -format %H:%M:%S \
+ -timezone MET-1METDST]
+ lappend result [clock format $t -format %H:%M:%S \
+ -timezone MET0METDST]
+ }
+ set result
+} {01:59:59 00:59:59 03:00:00 02:00:00 02:59:59 01:59:59 02:00:00 01:00:00}
+
+test clock-52.3 {correct conversion of times in Russia} {
+ # [Bug 2207436]
+ set result {}
+ foreach t [list 1206799199 1206799200 1224943199 1224943200] {
+ lappend result [clock format $t -format %H:%M:%S \
+ -timezone WST-12WSTDST]
+ }
+ set result
+} {01:59:59 03:00:00 02:59:59 02:00:00}
+
+test clock-52.4 {correct conversion of times in USA} {
+ # [Bug 2207436]
+ set result {}
+ foreach t [list 1268549999 1268550000 1257055199 1257055200] {
+ lappend result [clock format $t -format %H:%M:%S \
+ -timezone EST5EDT]
+ }
+ set result
+} {01:59:59 03:00:00 01:59:59 01:00:00}
+
+# Regression test for Bug # 1505383
+
+test clock-53.1 {%EC %Ey} {
+ clock format 0 -gmt true -locale en_US_roman -format %EC%Ey
+} mcmlxx
+
+# Test that glob-special characters can be handled in [clock]
+
+test clock-54.1 {glob specials in [clock format]} \
+ -setup {
+ clock format 0 -gmt 1 -format %Y
+ } \
+ -body {
+ clock format 0 -gmt 1 -format {*[%Y%m%d]*}
+ } \
+ -result {*[19700101]*}
+test clock-54.2 {glob specials in [clock scan]} \
+ -setup {
+ clock scan 1970 -gmt 1 -format %Y
+ } \
+ -body {
+ clock scan {*[19700101]*} -format {*[%Y%m%d]*} -gmt 1
+ } \
+ -result 0
+
+test clock-55.1 {Common Era} {
+ clock format -62135769600 -gmt 1 -format {%d %m %Y %EE}
+} {01 01 0001 C.E.}
+test clock-55.2 {Common Era} {
+ clock format -62135769600 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} {01 01 0001 Anno Domini}
+test clock-55.3 {Before the Common Era} {
+ clock format -62135769601 -gmt 1 -format {%d %m %Y %EE}
+} {31 12 0001 B.C.E.}
+test clock-55.4 {Before the Common Era} {
+ clock format -62135769601 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} {31 12 0001 Before Christ}
+test clock-55.5 {Common Era} {
+ clock scan {01 01 0001 C.E.} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.6 {Common Era} {
+ clock scan {01 01 0001 A.D.} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.7 {Common Era} {
+ clock scan {01 01 0001 Anno Domini} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.8 {Before the Common Era} {
+ clock scan {31 12 0001 B.C.E.} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+test clock-55.9 {Common Era} {
+ clock scan {31 12 0001 B.C.} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+test clock-55.10 {Common Era} {
+ clock scan {31 12 0001 Before Christ} \
+ -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+
+test clock-56.1 {use of zoneinfo, version 1} {*}{
+ -setup {
+ clock format [clock seconds]
+ set tzdir [makeDirectory zoneinfo]
+ set tzdir2 [makeDirectory Test $tzdir]
+ set tzfile [makeFile {} PhoenixOne $tzdir2]
+ set f [open $tzfile wb]
+ puts -nonewline $f [binary format c* {
+ 0x54 0x5a 0x69 0x66 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x03
+ 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a
+ 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90
+ 0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80
+ 0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac
+ 0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00
+ 0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff
+ 0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff
+ 0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00
+ 0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+ }]
+ close $f
+ set ::tcl::clock::ZoneinfoPaths \
+ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+ ::tcl::clock::ClearCaches
+ }
+ -cleanup {
+ set ::tcl::clock::ZoneinfoPaths \
+ [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+ ::tcl::clock::ClearCaches
+ removeFile PhoenixOne $tzdir2
+ removeDirectory Test $tzdir
+ removeDirectory zoneinfo
+ }
+ -body {
+ clock format 1072940400 -timezone :Test/PhoenixOne \
+ -format {%Y-%m-%d %H:%M:%S %Z}
+ }
+ -result {2004-01-01 00:00:00 MST}
+}
+
+test clock-56.2 {use of zoneinfo, version 2} {*}{
+ -setup {
+ clock format [clock seconds]
+ set tzdir [makeDirectory zoneinfo]
+ set tzdir2 [makeDirectory Test $tzdir]
+ set tzfile [makeFile {} PhoenixTwo $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 0x03
+ 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a
+ 0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90
+ 0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80
+ 0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac
+ 0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00
+ 0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff
+ 0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff
+ 0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00
+ 0x4d 0x57 0x54 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 0x04 0x00 0x00
+ 0x00 0x04 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0b 0x00 0x00
+ 0x00 0x04 0x00 0x00 0x00 0x10 0xff 0xff 0xff 0xff 0x5e 0x04
+ 0x0c 0xb0 0xff 0xff 0xff 0xff 0x9e 0xa6 0x3a 0x90 0xff 0xff
+ 0xff 0xff 0x9f 0xbb 0x07 0x80 0xff 0xff 0xff 0xff 0xa0 0x86
+ 0x1c 0x90 0xff 0xff 0xff 0xff 0xa1 0x9a 0xe9 0x80 0xff 0xff
+ 0xff 0xff 0xcb 0x89 0x0c 0x90 0xff 0xff 0xff 0xff 0xcf 0x17
+ 0xdf 0x1c 0xff 0xff 0xff 0xff 0xcf 0x8f 0xe5 0xac 0xff 0xff
+ 0xff 0xff 0xd0 0x81 0x1a 0x1c 0xff 0xff 0xff 0xff 0xfa 0xf8
+ 0x75 0x10 0xff 0xff 0xff 0xff 0xfb 0xe8 0x58 0x00 0x02 0x01
+ 0x02 0x01 0x02 0x03 0x02 0x03 0x02 0x01 0x02 0xff 0xff 0x96
+ 0xee 0x00 0x00 0xff 0xff 0xab 0xa0 0x01 0x04 0xff 0xff 0x9d
+ 0x90 0x00 0x08 0xff 0xff 0xab 0xa0 0x01 0x0c 0x4c 0x4d 0x54
+ 0x00 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54
+ 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x4d 0x53
+ 0x54 0x37 0x0a
+ }]
+ close $f
+ set ::tcl::clock::ZoneinfoPaths \
+ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+ ::tcl::clock::ClearCaches
+ }
+ -cleanup {
+ set ::tcl::clock::ZoneinfoPaths \
+ [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+ ::tcl::clock::ClearCaches
+ removeFile PhoenixTwo $tzdir2
+ removeDirectory Test $tzdir
+ removeDirectory zoneinfo
+ }
+ -body {
+ clock format 1072940400 -timezone :Test/PhoenixTwo \
+ -format {%Y-%m-%d %H:%M:%S %Z}
+ }
+ -result {2004-01-01 00:00:00 MST}
+}
+
+test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{
+ -setup {
+ clock format [clock seconds]
+ set tzdir [makeDirectory zoneinfo]
+ set tzdir2 [makeDirectory Test $tzdir]
+ set tzfile [makeFile {} TijuanaTwo $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 0x95 0x00 0x00 0x00
+ 0x06 0x00 0x00 0x00 0x18 0xa5 0xb6 0xf6 0x80 0xa9 0x79 0x4f 0x70
+ 0xaf 0xf2 0x7c 0xf0 0xb6 0x66 0x64 0x70 0xb7 0x1b 0x10 0x00 0xb8
+ 0x0a 0xf2 0xf0 0xcb 0xea 0x8d 0x80 0xd2 0x23 0xf4 0x70 0xd2 0x99
+ 0xba 0x70 0xd7 0x1b 0x59 0x00 0xd8 0x91 0xb4 0xf0 0xe2 0x7e 0x59
+ 0xa0 0xe3 0x49 0x52 0x90 0xe4 0x5e 0x3b 0xa0 0xe5 0x29 0x34 0x90
+ 0xe6 0x47 0x58 0x20 0xe7 0x12 0x51 0x10 0xe8 0x27 0x3a 0x20 0xe8
+ 0xf2 0x33 0x10 0xea 0x07 0x1c 0x20 0xea 0xd2 0x15 0x10 0xeb 0xe6
+ 0xfe 0x20 0xec 0xb1 0xf7 0x10 0xed 0xc6 0xe0 0x20 0xee 0x91 0xd9
+ 0x10 0x0b 0xe0 0xaf 0xa0 0x0c 0xd9 0xcd 0x10 0x0d 0xc0 0x91 0xa0
+ 0x0e 0xb9 0xaf 0x10 0x0f 0xa9 0xae 0x20 0x10 0x99 0x91 0x10 0x11
+ 0x89 0x90 0x20 0x12 0x79 0x73 0x10 0x13 0x69 0x72 0x20 0x14 0x59
+ 0x55 0x10 0x15 0x49 0x54 0x20 0x16 0x39 0x37 0x10 0x17 0x29 0x36
+ 0x20 0x18 0x22 0x53 0x90 0x19 0x09 0x18 0x20 0x1a 0x02 0x35 0x90
+ 0x1a 0xf2 0x34 0xa0 0x1b 0xe2 0x17 0x90 0x1c 0xd2 0x16 0xa0 0x1d
+ 0xc1 0xf9 0x90 0x1e 0xb1 0xf8 0xa0 0x1f 0xa1 0xdb 0x90 0x20 0x76
+ 0x2b 0x20 0x21 0x81 0xbd 0x90 0x22 0x56 0x0d 0x20 0x23 0x6a 0xda
+ 0x10 0x24 0x35 0xef 0x20 0x25 0x4a 0xbc 0x10 0x26 0x15 0xd1 0x20
+ 0x27 0x2a 0x9e 0x10 0x27 0xfe 0xed 0xa0 0x29 0x0a 0x80 0x10 0x29
+ 0xde 0xcf 0xa0 0x2a 0xea 0x62 0x10 0x2b 0xbe 0xb1 0xa0 0x2c 0xd3
+ 0x7e 0x90 0x2d 0x9e 0x93 0xa0 0x2e 0xb3 0x60 0x90 0x2f 0x7e 0x75
+ 0xa0 0x30 0x93 0x42 0x90 0x31 0x67 0x92 0x20 0x32 0x73 0x24 0x90
+ 0x33 0x47 0x74 0x20 0x34 0x53 0x06 0x90 0x35 0x27 0x56 0x20 0x36
+ 0x32 0xe8 0x90 0x37 0x07 0x38 0x20 0x38 0x1c 0x05 0x10 0x38 0xe7
+ 0x1a 0x20 0x39 0xfb 0xe7 0x10 0x3a 0xc6 0xfc 0x20 0x3b 0xdb 0xc9
+ 0x10 0x3c 0xb0 0x18 0xa0 0x3d 0xbb 0xab 0x10 0x3e 0x8f 0xfa 0xa0
+ 0x3f 0x9b 0x8d 0x10 0x40 0x6f 0xdc 0xa0 0x41 0x84 0xa9 0x90 0x42
+ 0x4f 0xbe 0xa0 0x43 0x64 0x8b 0x90 0x44 0x2f 0xa0 0xa0 0x45 0x44
+ 0x6d 0x90 0x46 0x0f 0x82 0xa0 0x47 0x24 0x4f 0x90 0x47 0xf8 0x9f
+ 0x20 0x49 0x04 0x31 0x90 0x49 0xd8 0x81 0x20 0x4a 0xe4 0x13 0x90
+ 0x4b 0xb8 0x63 0x20 0x4c 0xcd 0x30 0x10 0x4d 0x98 0x45 0x20 0x4e
+ 0xad 0x12 0x10 0x4f 0x78 0x27 0x20 0x50 0x8c 0xf4 0x10 0x51 0x61
+ 0x43 0xa0 0x52 0x6c 0xd6 0x10 0x53 0x41 0x25 0xa0 0x54 0x4c 0xb8
+ 0x10 0x55 0x21 0x07 0xa0 0x56 0x2c 0x9a 0x10 0x57 0x00 0xe9 0xa0
+ 0x58 0x15 0xb6 0x90 0x58 0xe0 0xcb 0xa0 0x59 0xf5 0x98 0x90 0x5a
+ 0xc0 0xad 0xa0 0x5b 0xd5 0x7a 0x90 0x5c 0xa9 0xca 0x20 0x5d 0xb5
+ 0x5c 0x90 0x5e 0x89 0xac 0x20 0x5f 0x95 0x3e 0x90 0x60 0x69 0x8e
+ 0x20 0x61 0x7e 0x5b 0x10 0x62 0x49 0x70 0x20 0x63 0x5e 0x3d 0x10
+ 0x64 0x29 0x52 0x20 0x65 0x3e 0x1f 0x10 0x66 0x12 0x6e 0xa0 0x67
+ 0x1e 0x01 0x10 0x67 0xf2 0x50 0xa0 0x68 0xfd 0xe3 0x10 0x69 0xd2
+ 0x32 0xa0 0x6a 0xdd 0xc5 0x10 0x6b 0xb2 0x14 0xa0 0x6c 0xc6 0xe1
+ 0x90 0x6d 0x91 0xf6 0xa0 0x6e 0xa6 0xc3 0x90 0x6f 0x71 0xd8 0xa0
+ 0x70 0x86 0xa5 0x90 0x71 0x5a 0xf5 0x20 0x72 0x66 0x87 0x90 0x73
+ 0x3a 0xd7 0x20 0x74 0x46 0x69 0x90 0x75 0x1a 0xb9 0x20 0x76 0x2f
+ 0x86 0x10 0x76 0xfa 0x9b 0x20 0x78 0x0f 0x68 0x10 0x78 0xda 0x7d
+ 0x20 0x79 0xef 0x4a 0x10 0x7a 0xba 0x5f 0x20 0x7b 0xcf 0x2c 0x10
+ 0x7c 0xa3 0x7b 0xa0 0x7d 0xaf 0x0e 0x10 0x7e 0x83 0x5d 0xa0 0x7f
+ 0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92 0x4c
+ 0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80 0x00
+ 0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01 0x10
+ 0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53 0x54
+ 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54 0x00
+ 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00 0x00
+ 0x00 0x00 0x01 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 0x95
+ 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x18 0xff 0xff 0xff 0xff 0xa5
+ 0xb6 0xf6 0x80 0xff 0xff 0xff 0xff 0xa9 0x79 0x4f 0x70 0xff 0xff
+ 0xff 0xff 0xaf 0xf2 0x7c 0xf0 0xff 0xff 0xff 0xff 0xb6 0x66 0x64
+ 0x70 0xff 0xff 0xff 0xff 0xb7 0x1b 0x10 0x00 0xff 0xff 0xff 0xff
+ 0xb8 0x0a 0xf2 0xf0 0xff 0xff 0xff 0xff 0xcb 0xea 0x8d 0x80 0xff
+ 0xff 0xff 0xff 0xd2 0x23 0xf4 0x70 0xff 0xff 0xff 0xff 0xd2 0x99
+ 0xba 0x70 0xff 0xff 0xff 0xff 0xd7 0x1b 0x59 0x00 0xff 0xff 0xff
+ 0xff 0xd8 0x91 0xb4 0xf0 0xff 0xff 0xff 0xff 0xe2 0x7e 0x59 0xa0
+ 0xff 0xff 0xff 0xff 0xe3 0x49 0x52 0x90 0xff 0xff 0xff 0xff 0xe4
+ 0x5e 0x3b 0xa0 0xff 0xff 0xff 0xff 0xe5 0x29 0x34 0x90 0xff 0xff
+ 0xff 0xff 0xe6 0x47 0x58 0x20 0xff 0xff 0xff 0xff 0xe7 0x12 0x51
+ 0x10 0xff 0xff 0xff 0xff 0xe8 0x27 0x3a 0x20 0xff 0xff 0xff 0xff
+ 0xe8 0xf2 0x33 0x10 0xff 0xff 0xff 0xff 0xea 0x07 0x1c 0x20 0xff
+ 0xff 0xff 0xff 0xea 0xd2 0x15 0x10 0xff 0xff 0xff 0xff 0xeb 0xe6
+ 0xfe 0x20 0xff 0xff 0xff 0xff 0xec 0xb1 0xf7 0x10 0xff 0xff 0xff
+ 0xff 0xed 0xc6 0xe0 0x20 0xff 0xff 0xff 0xff 0xee 0x91 0xd9 0x10
+ 0x00 0x00 0x00 0x00 0x0b 0xe0 0xaf 0xa0 0x00 0x00 0x00 0x00 0x0c
+ 0xd9 0xcd 0x10 0x00 0x00 0x00 0x00 0x0d 0xc0 0x91 0xa0 0x00 0x00
+ 0x00 0x00 0x0e 0xb9 0xaf 0x10 0x00 0x00 0x00 0x00 0x0f 0xa9 0xae
+ 0x20 0x00 0x00 0x00 0x00 0x10 0x99 0x91 0x10 0x00 0x00 0x00 0x00
+ 0x11 0x89 0x90 0x20 0x00 0x00 0x00 0x00 0x12 0x79 0x73 0x10 0x00
+ 0x00 0x00 0x00 0x13 0x69 0x72 0x20 0x00 0x00 0x00 0x00 0x14 0x59
+ 0x55 0x10 0x00 0x00 0x00 0x00 0x15 0x49 0x54 0x20 0x00 0x00 0x00
+ 0x00 0x16 0x39 0x37 0x10 0x00 0x00 0x00 0x00 0x17 0x29 0x36 0x20
+ 0x00 0x00 0x00 0x00 0x18 0x22 0x53 0x90 0x00 0x00 0x00 0x00 0x19
+ 0x09 0x18 0x20 0x00 0x00 0x00 0x00 0x1a 0x02 0x35 0x90 0x00 0x00
+ 0x00 0x00 0x1a 0xf2 0x34 0xa0 0x00 0x00 0x00 0x00 0x1b 0xe2 0x17
+ 0x90 0x00 0x00 0x00 0x00 0x1c 0xd2 0x16 0xa0 0x00 0x00 0x00 0x00
+ 0x1d 0xc1 0xf9 0x90 0x00 0x00 0x00 0x00 0x1e 0xb1 0xf8 0xa0 0x00
+ 0x00 0x00 0x00 0x1f 0xa1 0xdb 0x90 0x00 0x00 0x00 0x00 0x20 0x76
+ 0x2b 0x20 0x00 0x00 0x00 0x00 0x21 0x81 0xbd 0x90 0x00 0x00 0x00
+ 0x00 0x22 0x56 0x0d 0x20 0x00 0x00 0x00 0x00 0x23 0x6a 0xda 0x10
+ 0x00 0x00 0x00 0x00 0x24 0x35 0xef 0x20 0x00 0x00 0x00 0x00 0x25
+ 0x4a 0xbc 0x10 0x00 0x00 0x00 0x00 0x26 0x15 0xd1 0x20 0x00 0x00
+ 0x00 0x00 0x27 0x2a 0x9e 0x10 0x00 0x00 0x00 0x00 0x27 0xfe 0xed
+ 0xa0 0x00 0x00 0x00 0x00 0x29 0x0a 0x80 0x10 0x00 0x00 0x00 0x00
+ 0x29 0xde 0xcf 0xa0 0x00 0x00 0x00 0x00 0x2a 0xea 0x62 0x10 0x00
+ 0x00 0x00 0x00 0x2b 0xbe 0xb1 0xa0 0x00 0x00 0x00 0x00 0x2c 0xd3
+ 0x7e 0x90 0x00 0x00 0x00 0x00 0x2d 0x9e 0x93 0xa0 0x00 0x00 0x00
+ 0x00 0x2e 0xb3 0x60 0x90 0x00 0x00 0x00 0x00 0x2f 0x7e 0x75 0xa0
+ 0x00 0x00 0x00 0x00 0x30 0x93 0x42 0x90 0x00 0x00 0x00 0x00 0x31
+ 0x67 0x92 0x20 0x00 0x00 0x00 0x00 0x32 0x73 0x24 0x90 0x00 0x00
+ 0x00 0x00 0x33 0x47 0x74 0x20 0x00 0x00 0x00 0x00 0x34 0x53 0x06
+ 0x90 0x00 0x00 0x00 0x00 0x35 0x27 0x56 0x20 0x00 0x00 0x00 0x00
+ 0x36 0x32 0xe8 0x90 0x00 0x00 0x00 0x00 0x37 0x07 0x38 0x20 0x00
+ 0x00 0x00 0x00 0x38 0x1c 0x05 0x10 0x00 0x00 0x00 0x00 0x38 0xe7
+ 0x1a 0x20 0x00 0x00 0x00 0x00 0x39 0xfb 0xe7 0x10 0x00 0x00 0x00
+ 0x00 0x3a 0xc6 0xfc 0x20 0x00 0x00 0x00 0x00 0x3b 0xdb 0xc9 0x10
+ 0x00 0x00 0x00 0x00 0x3c 0xb0 0x18 0xa0 0x00 0x00 0x00 0x00 0x3d
+ 0xbb 0xab 0x10 0x00 0x00 0x00 0x00 0x3e 0x8f 0xfa 0xa0 0x00 0x00
+ 0x00 0x00 0x3f 0x9b 0x8d 0x10 0x00 0x00 0x00 0x00 0x40 0x6f 0xdc
+ 0xa0 0x00 0x00 0x00 0x00 0x41 0x84 0xa9 0x90 0x00 0x00 0x00 0x00
+ 0x42 0x4f 0xbe 0xa0 0x00 0x00 0x00 0x00 0x43 0x64 0x8b 0x90 0x00
+ 0x00 0x00 0x00 0x44 0x2f 0xa0 0xa0 0x00 0x00 0x00 0x00 0x45 0x44
+ 0x6d 0x90 0x00 0x00 0x00 0x00 0x46 0x0f 0x82 0xa0 0x00 0x00 0x00
+ 0x00 0x47 0x24 0x4f 0x90 0x00 0x00 0x00 0x00 0x47 0xf8 0x9f 0x20
+ 0x00 0x00 0x00 0x00 0x49 0x04 0x31 0x90 0x00 0x00 0x00 0x00 0x49
+ 0xd8 0x81 0x20 0x00 0x00 0x00 0x00 0x4a 0xe4 0x13 0x90 0x00 0x00
+ 0x00 0x00 0x4b 0xb8 0x63 0x20 0x00 0x00 0x00 0x00 0x4c 0xcd 0x30
+ 0x10 0x00 0x00 0x00 0x00 0x4d 0x98 0x45 0x20 0x00 0x00 0x00 0x00
+ 0x4e 0xad 0x12 0x10 0x00 0x00 0x00 0x00 0x4f 0x78 0x27 0x20 0x00
+ 0x00 0x00 0x00 0x50 0x8c 0xf4 0x10 0x00 0x00 0x00 0x00 0x51 0x61
+ 0x43 0xa0 0x00 0x00 0x00 0x00 0x52 0x6c 0xd6 0x10 0x00 0x00 0x00
+ 0x00 0x53 0x41 0x25 0xa0 0x00 0x00 0x00 0x00 0x54 0x4c 0xb8 0x10
+ 0x00 0x00 0x00 0x00 0x55 0x21 0x07 0xa0 0x00 0x00 0x00 0x00 0x56
+ 0x2c 0x9a 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0xe9 0xa0 0x00 0x00
+ 0x00 0x00 0x58 0x15 0xb6 0x90 0x00 0x00 0x00 0x00 0x58 0xe0 0xcb
+ 0xa0 0x00 0x00 0x00 0x00 0x59 0xf5 0x98 0x90 0x00 0x00 0x00 0x00
+ 0x5a 0xc0 0xad 0xa0 0x00 0x00 0x00 0x00 0x5b 0xd5 0x7a 0x90 0x00
+ 0x00 0x00 0x00 0x5c 0xa9 0xca 0x20 0x00 0x00 0x00 0x00 0x5d 0xb5
+ 0x5c 0x90 0x00 0x00 0x00 0x00 0x5e 0x89 0xac 0x20 0x00 0x00 0x00
+ 0x00 0x5f 0x95 0x3e 0x90 0x00 0x00 0x00 0x00 0x60 0x69 0x8e 0x20
+ 0x00 0x00 0x00 0x00 0x61 0x7e 0x5b 0x10 0x00 0x00 0x00 0x00 0x62
+ 0x49 0x70 0x20 0x00 0x00 0x00 0x00 0x63 0x5e 0x3d 0x10 0x00 0x00
+ 0x00 0x00 0x64 0x29 0x52 0x20 0x00 0x00 0x00 0x00 0x65 0x3e 0x1f
+ 0x10 0x00 0x00 0x00 0x00 0x66 0x12 0x6e 0xa0 0x00 0x00 0x00 0x00
+ 0x67 0x1e 0x01 0x10 0x00 0x00 0x00 0x00 0x67 0xf2 0x50 0xa0 0x00
+ 0x00 0x00 0x00 0x68 0xfd 0xe3 0x10 0x00 0x00 0x00 0x00 0x69 0xd2
+ 0x32 0xa0 0x00 0x00 0x00 0x00 0x6a 0xdd 0xc5 0x10 0x00 0x00 0x00
+ 0x00 0x6b 0xb2 0x14 0xa0 0x00 0x00 0x00 0x00 0x6c 0xc6 0xe1 0x90
+ 0x00 0x00 0x00 0x00 0x6d 0x91 0xf6 0xa0 0x00 0x00 0x00 0x00 0x6e
+ 0xa6 0xc3 0x90 0x00 0x00 0x00 0x00 0x6f 0x71 0xd8 0xa0 0x00 0x00
+ 0x00 0x00 0x70 0x86 0xa5 0x90 0x00 0x00 0x00 0x00 0x71 0x5a 0xf5
+ 0x20 0x00 0x00 0x00 0x00 0x72 0x66 0x87 0x90 0x00 0x00 0x00 0x00
+ 0x73 0x3a 0xd7 0x20 0x00 0x00 0x00 0x00 0x74 0x46 0x69 0x90 0x00
+ 0x00 0x00 0x00 0x75 0x1a 0xb9 0x20 0x00 0x00 0x00 0x00 0x76 0x2f
+ 0x86 0x10 0x00 0x00 0x00 0x00 0x76 0xfa 0x9b 0x20 0x00 0x00 0x00
+ 0x00 0x78 0x0f 0x68 0x10 0x00 0x00 0x00 0x00 0x78 0xda 0x7d 0x20
+ 0x00 0x00 0x00 0x00 0x79 0xef 0x4a 0x10 0x00 0x00 0x00 0x00 0x7a
+ 0xba 0x5f 0x20 0x00 0x00 0x00 0x00 0x7b 0xcf 0x2c 0x10 0x00 0x00
+ 0x00 0x00 0x7c 0xa3 0x7b 0xa0 0x00 0x00 0x00 0x00 0x7d 0xaf 0x0e
+ 0x10 0x00 0x00 0x00 0x00 0x7e 0x83 0x5d 0xa0 0x00 0x00 0x00 0x00
+ 0x7f 0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+ 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+ 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92
+ 0x4c 0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80
+ 0x00 0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01
+ 0x10 0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53
+ 0x54 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54
+ 0x00 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00
+ 0x00 0x00 0x00 0x01 0x0a 0x50 0x53 0x54 0x38 0x50 0x44 0x54 0x2c
+ 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x2c 0x4d 0x31 0x30 0x2e 0x35 0x2e
+ 0x30 0x0a
+ }]
+ close $f
+ set ::tcl::clock::ZoneinfoPaths \
+ [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+ ::tcl::clock::ClearCaches
+ }
+ -cleanup {
+ set ::tcl::clock::ZoneinfoPaths \
+ [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+ ::tcl::clock::ClearCaches
+ removeFile TijuanaTwo $tzdir2
+ removeDirectory Test $tzdir
+ removeDirectory zoneinfo
+ }
+ -body {
+ clock format 2224738800 -timezone :Test/TijuanaTwo \
+ -format {%Y-%m-%d %H:%M:%S %Z}
+ }
+ -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
+
+test clock-58.1 {clock l10n - Japanese localisation} {*}{
+ -setup {
+ proc backslashify { string } {
+
+ set retval {}
+ foreach char [split $string {}] {
+ scan $char %c ccode
+ if { $ccode >= 0x0020 && $ccode < 0x007f
+ && $char ne "\{" && $char ne "\}" && $char ne "\["
+ && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
+ append retval $char
+ } else {
+ append retval \\u [format %04x $ccode]
+ }
+ }
+ return $retval
+ }
+ }
+ -body {
+ set trouble {}
+ foreach {date jdate} [list \
+ 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 \
+ 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 \
+ 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 \
+ 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 \
+ 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 \
+ 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 \
+ 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 \
+ 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 \
+ ] {
+ set status [catch {
+ set secs [clock scan $date \
+ -timezone +0900 \
+ -locale ja_JP \
+ -format %Y-%m-%d]
+ set jda [clock format $secs \
+ -timezone +0900 \
+ -locale ja_JP \
+ -format %Ex]
+ } result]
+ if {$status != 0} {
+ append trouble \n $date " gives error " $result
+ } elseif {$jda ne $jdate} {
+ append trouble \n $date " converts to " \
+ [backslashify $jda] " and should be " \
+ [backslashify $jdate]
+ }
+ # There is no code for scanning dates on the locale's
+ # alternative calendar.
+ continue
+ set status [catch {
+ set secs [clock scan $jdate \
+ -timezone +0900 \
+ -locale ja_JP \
+ -format %Ex]
+ set da [clock format $secs \
+ -timezone +0900 \
+ -locale ja_JP \
+ -format %Y-%m-%d]
+ } result]
+ if {$status != 0} {
+ append trouble \n [backslashify $jdate] " gives error " $result
+ } elseif {$da ne $date} {
+ append trouble \n [backslashify $jdate] " converts to " \
+ $da " and should be " $date
+ }
+ }
+ set trouble
+ }
+ -cleanup {
+ rename backslashify {}
+ }
+ -result {}
+}
+
+test clock-59.1 {military time zones} {
+ set hour 0
+ set base [clock scan "20000101 000000" -format "%Y%m%d %H%M%S" -gmt 1]
+ set trouble {}
+ foreach {pzone mzone} {
+ Z Z A N B O C P D Q E R F S G T H U I V K W L X M Y
+ } {
+ catch {clock scan "20000101 000000 $pzone" \
+ -format "%Y%m%d %H%M%S %Z"} ps1
+ catch {clock scan "20000101 000000 $pzone"} ps2
+ catch {clock scan "20000101 000000 $mzone" \
+ -format "%Y%m%d %H%M%S %Z"} ms1
+ catch {clock scan "20000101 000000 $mzone"} ms2
+ if {$ps1 != $base - 3600 * $hour} {
+ lappend trouble [list pzone $pzone hour $hour ps1 is $ps1]
+ }
+ if {$ps2 != $base - 3600 * $hour} {
+ lappend trouble [list pzone $pzone ps2 is $ps2]
+ }
+ if {$ms1 != $base + 3600 * $hour} {
+ lappend trouble [list mzone $mzone ms1 is $ms1]
+ }
+ if {$ms2 != $base + 3600 * $hour} {
+ lappend trouble [list mzone $mzone ms2 is $ms2]
+ }
+ incr hour
+ }
+ join $trouble \n
+} {}
+
+# case-insensitive matching of weekday and month names [Bug 1781282]
+
+test clock-60.1 {case insensitive weekday names} {
+ clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+test clock-60.2 {case insensitive weekday names} {
+ clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+test clock-60.3 {case insensitive weekday names} {
+ clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+test clock-60.4 {case insensitive weekday names} {
+ clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+test clock-60.5 {case insensitive weekday names} {
+ clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+test clock-60.6 {case insensitive weekday names} {
+ clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+test clock-60.7 {case insensitive month names} {
+ clock scan "1 january 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+test clock-60.8 {case insensitive month names} {
+ clock scan "1 January 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+test clock-60.9 {case insensitive month names} {
+ clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+test clock-60.10 {case insensitive month names} {
+ clock scan "1 december 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+test clock-60.11 {case insensitive month names} {
+ clock scan "1 December 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+test clock-60.12 {case insensitive month names} {
+ clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+
+test clock-61.1 {overflow of a wide integer on output} {*}{
+ -body {
+ clock format 0x8000000000000000 -format %s -gmt true
+ }
+ -result {integer value too large to represent}
+ -returnCodes error
+}
+test clock-61.2 {overflow of a wide integer on output} {*}{
+ -body {
+ clock format -0x8000000000000001 -format %s -gmt true
+ }
+ -result {integer value too large to represent}
+ -returnCodes error
+}
+test clock-61.3 {near-miss overflow of a wide integer on output} {
+ clock format 0x7fffffffffffffff -format %s -gmt true
+} [expr 0x7fffffffffffffff]
+test clock-61.4 {near-miss overflow of a wide integer on output} {
+ clock format -0x8000000000000000 -format %s -gmt true
+} [expr -0x8000000000000000]
+
+test clock-62.1 {Bug 1902423} {*}{
+ -setup {::tcl::clock::ClearCaches}
+ -body {
+ set s 1204049747
+ set f1 [clock format $s -format {%Y-%m-%d %T} -locale C]
+ set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C]
+ if {$f1 ne $f2} {
+ subst "$f2 is not $f1"
+ } else {
+ subst "ok"
+ }
+ }
+ -result ok
+}
+
+test clock-63.1 {Incorrect use of internal ConvertLocalToUTC command} {*}{
+ -body {
+ ::tcl::clock::ConvertLocalToUTC {immaterial stuff} {} 12345
+ }
+ -returnCodes error
+ -result {key "localseconds" not found in dictionary}
+}
+
+test clock-64.1 {:: in format string [Bug 2362156]} {*}{
+ -body {
+ clock scan 2001-02-03::04:05:06 -gmt 1 -format %Y-%m-%d::%H:%M:%S
+ }
+ -result 981173106
+}
+test clock-64.2 {:: in format string [Bug 2362156]} {*}{
+ -body {
+ clock format 981173106 -gmt 1 -format %Y-%m-%d::%H:%M:%S
+ }
+ -result 2001-02-03::04:05:06
+}
+
+test clock-65.1 {clock add, bad option [Bug 2481670]} {*}{
+ -body {
+ clock add 0 1 year -foo bar
+ }
+ -match glob
+ -returnCodes error
+ -result {bad switch "-foo"*}
+}
+
+test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
+ -setup {
+ ::tcl::clock::ClearCaches
+ }
+ -body {
+ clock scan 1200 \
+ -timezone {<EST>+05:00:00<EDT>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00} \
+ -base 1256529600 \
+ -format %H%M
+ }
+ -result 1256572800
+}
+
+test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
+ clock format [clock seconds] -format %%r
+} %r
+
+test clock-67.2 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
+
# cleanup
namespace delete ::testClock
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 25db252..04a86fa 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1,107 +1,149 @@
# The file tests the tclCmdAH.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) 1996-1998 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: cmdAH.test,v 1.50 2004/11/01 16:58:37 kennykb 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.1
namespace import -force ::tcltest::*
}
-tcltest::testConstraint testchmod \
- [string equal testchmod [info commands testchmod]]
-tcltest::testConstraint testsetplatform \
- [string equal testsetplatform [info commands testsetplatform]]
-tcltest::testConstraint testvolumetype \
- [string equal testvolumetype [info commands testvolumetype]]
-tcltest::testConstraint linkDirectory [expr \
- {$tcl_platform(platform) ne "windows" || \
- ([string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS"))}]
+::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]]
+testConstraint linkDirectory [expr {
+ ![testConstraint win] ||
+ ([string index $tcl_platform(osVersion) 0] >= 5
+ && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
+}]
global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}
-test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
- list [catch {break foo} msg] $msg
-} {1 {wrong # args: should be "break"}}
+proc waitForEvenSecondForFAT {} {
+ # Windows 9x uses filesystems (the FAT* family of FSes) without enough
+ # data in its timestamps for even per-second-accurate timings. :^(
+ # This procedure based on work by Helmut Giese
+ if {
+ [testConstraint win] &&
+ [lindex [file system [temporaryDirectory]] 1] ne "NTFS"
+ } then {
+ # Assume non-NTFS means FAT{12,16,32} and hence in need of special
+ # help...
+ set start [clock seconds]
+ while {1} {
+ set now [clock seconds]
+ if {$now!=$start && !($now & 1)} {
+ break
+ }
+ after 50
+ }
+ }
+}
+
+test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
+ break foo
+} -returnCodes error -result {wrong # args: should be "break"}
test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
list [catch {break} msg] $msg
} {3 {}}
# Tcl_CaseObjCmd is tested in case.test
-test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
- list [catch {catch} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
+ catch
+} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
list [catch {catch foo bar baz} msg] $msg
} {0 1}
-test cmdAH-1.3 {Tcl_CatchObjCmd, errors} {
- list [catch {catch foo bar baz spaz} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+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} {
- list [catch {cd foo bar} msg] $msg
-} {1 {wrong # args: should be "cd ?dirName?"}}
+test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
+ cd foo bar
+} -result {wrong # args: should be "cd ?dirName?"}
set foodir [file join [temporaryDirectory] foo]
-test cmdAH-2.2 {Tcl_CdObjCmd} {
+test cmdAH-2.2 {Tcl_CdObjCmd} -setup {
file delete -force $foodir
+ set oldpwd [pwd]
+} -body {
file mkdir $foodir
cd $foodir
- set result [file tail [pwd]]
- cd ..
+ file tail [pwd]
+} -cleanup {
+ cd $oldpwd
file delete $foodir
- set result
-} foo
-test cmdAH-2.3 {Tcl_CdObjCmd} {
+} -result foo
+test cmdAH-2.3 {Tcl_CdObjCmd} -setup {
global env
set oldpwd [pwd]
set temp $env(HOME)
- set env(HOME) $oldpwd
file delete -force $foodir
+} -body {
+ set env(HOME) $oldpwd
file mkdir $foodir
cd $foodir
cd ~
- set result [string equal [pwd] $oldpwd]
+ string equal [pwd] $oldpwd
+} -cleanup {
+ cd $oldpwd
file delete $foodir
set env(HOME) $temp
- set result
-} 1
-test cmdAH-2.4 {Tcl_CdObjCmd} {
+} -result 1
+test cmdAH-2.4 {Tcl_CdObjCmd} -setup {
global env
set oldpwd [pwd]
set temp $env(HOME)
- set env(HOME) $oldpwd
file delete -force $foodir
+} -body {
+ set env(HOME) $oldpwd
file mkdir $foodir
cd $foodir
cd
- set result [string equal [pwd] $oldpwd]
+ string equal [pwd] $oldpwd
+} -cleanup {
+ cd $oldpwd
file delete $foodir
set env(HOME) $temp
- set result
-} 1
-test cmdAH-2.5 {Tcl_CdObjCmd} {
- list [catch {cd ~~} msg] $msg
-} {1 {user "~" doesn't exist}}
-test cmdAH-2.6 {Tcl_CdObjCmd} {
- list [catch {cd _foobar} msg] $msg
-} {1 {couldn't change working directory to "_foobar": no such file or directory}}
-test cmdAH-2.6.1 {Tcl_CdObjCmd} {
- list [catch {cd ""} msg] $msg
-} {1 {couldn't change working directory to "": no such file or directory}}
-
+} -result 1
+test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body {
+ cd ~~
+} -result {user "~" doesn't exist}
+test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body {
+ cd _foobar
+} -result {couldn't change working directory to "_foobar": no such file or directory}
+test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body {
+ cd ""
+} -result {couldn't change working directory to "": no such file or directory}
+test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
+ set dir [pwd]
+} -body {
+ cd /
+ pwd
+} -cleanup {
+ cd $dir
+} -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+ cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -112,134 +154,124 @@ test cmdAH-2.9 {Tcl_ConcatObjCmd} {
concat a {b c}
} {a b c}
-test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
- list [catch {continue foo} msg] $msg
-} {1 {wrong # args: should be "continue"}}
+test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
+ continue foo
+} -result {wrong # args: should be "continue"}
test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
list [catch {continue} msg] $msg
} {4 {}}
-test cmdAH-4.1 {Tcl_EncodingObjCmd} {
- list [catch {encoding} msg] $msg
-} {1 {wrong # args: should be "encoding option ?arg ...?"}}
-test cmdAH-4.2 {Tcl_EncodingObjCmd} {
- list [catch {encoding foo} msg] $msg
-} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}
-test cmdAH-4.3 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertto} msg] $msg
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
-test cmdAH-4.4 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertto foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.5 {Tcl_EncodingObjCmd} {
+test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding
+} -result {wrong # args: should be "encoding option ?arg ...?"}
+test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding foo
+} -result {bad option "foo": must be convertfrom, convertto, dirs, names, or system}
+test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding convertto
+} -result {wrong # args: should be "encoding convertto ?encoding? data"}
+test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding convertto foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
+} -body {
encoding system jis0208
- set x [encoding convertto \u4e4e]
+ encoding convertto \u4e4e
+} -cleanup {
encoding system $system
- set x
-} 8C
-test cmdAH-4.6 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
+} -body {
encoding system identity
- set x [encoding convertto jis0208 \u4e4e]
+ encoding convertto jis0208 \u4e4e
+} -cleanup {
encoding system $system
- set x
-} 8C
-test cmdAH-4.7 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertfrom} msg] $msg
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
-test cmdAH-4.8 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertfrom foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.9 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding convertfrom
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
+test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding convertfrom foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
+} -body {
encoding system jis0208
- set x [encoding convertfrom 8C]
+ encoding convertfrom 8C
+} -cleanup {
encoding system $system
- set x
-} \u4e4e
-test cmdAH-4.10 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
+} -body {
encoding system identity
- set x [encoding convertfrom jis0208 8C]
+ encoding convertfrom jis0208 8C
+} -cleanup {
encoding system $system
- set x
-} \u4e4e
-test cmdAH-4.11 {Tcl_EncodingObjCmd} {
- list [catch {encoding names foo} msg] $msg
-} {1 {wrong # args: should be "encoding names"}}
-test cmdAH-4.12 {Tcl_EncodingObjCmd} {
- list [catch {encoding system foo bar} msg] $msg
-} {1 {wrong # args: should be "encoding system ?encoding?"}}
-test cmdAH-4.13 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding names foo
+} -result {wrong # args: should be "encoding names"}
+test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
+ encoding system foo bar
+} -result {wrong # args: should be "encoding system ?encoding?"}
+test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
+} -body {
encoding system identity
- set x [encoding system]
+ encoding system
+} -cleanup {
encoding system $system
- set x
-} identity
-
-test cmdAH-5.1 {Tcl_FileObjCmd} {
- list [catch file msg] $msg
-} {1 {wrong # args: should be "file option ?arg ...?"}}
-test cmdAH-5.2 {Tcl_FileObjCmd} {
- list [catch {file x} msg] $msg
-} {1 {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, type, volumes, or writable}}
-test cmdAH-5.3 {Tcl_FileObjCmd} {
- list [catch {file exists} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
+} -result identity
+
+test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
+ file
+} -result {wrong # args: should be "file subcommand ?arg ...?"}
+test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
+ file x
+} -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"}
test cmdAH-5.4 {Tcl_FileObjCmd} {
- list [catch {file exists ""} msg] $msg
-} {0 0}
-
-#volume
+ file exists ""
+} 0
-test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
- list [catch {file volumes x} msg] $msg
-} {1 {wrong # args: should be "file volumes"}}
-test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
- set volumeList [file volumes]
- if { [llength $volumeList] == 0 } {
- set result 0
- } else {
- set result 1
- }
-} {1}
-test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
+# volume
+test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body {
+ file volumes x
+} -result {wrong # args: should be "file volumes"}
+test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body {
+ lindex [file volumes] 0
+} -match glob -result ?*
+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}
-
-test cmdAH-6.5 {cd} {unix nonPortable} {
- set dir [pwd]
- cd /
- set res [pwd]
- cd $dir
- set res
-} {/}
+ 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} {
+test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
set foofile [makeFile abcde foo.file]
catch {file delete -force $foofile}
+} -body {
close [open $foofile w]
- set res [catch {file attributes $foofile}]
+ file attributes $foofile
+} -cleanup {
# We used [makeFile] so we undo with [removeFile]
removeFile $foofile
- set res
-} {0}
+} -match glob -result *
# dirname
-
-test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform {
- testsetplatform unix
- list [catch {file dirname a b} msg] $msg
-} {1 {wrong # args: should be "file dirname name"}}
+test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body {
+ file dirname a b
+} -result {wrong # args: should be "file dirname name"}
test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
file dirname /a/b
@@ -274,125 +306,116 @@ test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform {
} /
test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname /} msg] $msg
-} {0 /}
+ file dirname /
+} /
test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname /foo} msg] $msg
-} {0 /}
+ file dirname /foo
+} /
test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname //foo} msg] $msg
-} {0 /}
+ file dirname //foo
+} /
test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname //foo/bar} msg] $msg
-} {0 /foo}
+ file dirname //foo/bar
+} /foo
test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname {//foo\/bar/baz}} msg] $msg
-} {0 {/foo\/bar}}
+ file dirname {//foo\/bar/baz}
+} {/foo\/bar}
test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
-} {0 {/foo\/bar/baz}}
+ file dirname {//foo\/bar/baz/blat}
+} {/foo\/bar/baz}
test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname /foo//} msg] $msg
-} {0 /}
+ file dirname /foo//
+} /
test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname ./a} msg] $msg
-} {0 .}
+ file dirname ./a
+} .
test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname a/.a} msg] $msg
-} {0 a}
+ file dirname a/.a
+} a
test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname c:foo} msg] $msg
-} {0 c:}
+ file dirname c:foo
+} c:
test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname c:} msg] $msg
-} {0 c:}
+ file dirname c:
+} c:
test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname c:/} msg] $msg
-} {0 c:/}
+ file dirname c:/
+} c:/
test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname {c:\foo}} msg] $msg
-} {0 c:/}
+ file dirname {c:\foo}
+} c:/
test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname {//foo/bar/baz}} msg] $msg
-} {0 //foo/bar}
+ file dirname {//foo/bar/baz}
+} //foo/bar
test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform windows
- list [catch {file dirname {//foo/bar}} msg] $msg
-} {0 //foo/bar}
+ file dirname {//foo/bar}
+} //foo/bar
test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname ~/foo} msg] $msg
-} {0 ~}
+ file dirname ~/foo
+} ~
test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
- list [catch {file dirname ~bar/foo} msg] $msg
-} {0 ~bar}
-test cmdAH-8.43 {Tcl_FileObjCmd: dirname} testsetplatform {
+ file dirname ~bar/foo
+} ~bar
+test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup {
global env
set temp $env(HOME)
+} -constraints testsetplatform -body {
set env(HOME) "/homewontexist/test"
testsetplatform unix
- set result [list [catch {file dirname ~} msg] $msg]
+ file dirname ~
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 /homewontexist}
-test cmdAH-8.44 {Tcl_FileObjCmd: dirname} testsetplatform {
+} -result /homewontexist
+test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup {
global env
set temp $env(HOME)
+} -constraints testsetplatform -body {
set env(HOME) "~"
testsetplatform unix
- set result [list [catch {file dirname ~} msg] $msg]
+ file dirname ~
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 ~}
-test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
- -constraints {win testsetplatform}
- -match regexp
- -setup {
- set temp $::env(HOME)
- }
- -body {
- set ::env(HOME) "/homewontexist/test"
- testsetplatform windows
- file dirname ~
- }
- -cleanup {
- set ::env(HOME) $temp
- }
- -result {([a-zA-Z]:?)/homewontexist}
-}
+} -result ~
+test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup {
+ set temp $::env(HOME)
+} -constraints {win testsetplatform} -match regexp -body {
+ set ::env(HOME) "/homewontexist/test"
+ testsetplatform windows
+ file dirname ~
+} -cleanup {
+ set ::env(HOME) $temp
+} -result {([a-zA-Z]:?)/homewontexist}
test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
set f [file normalize [info nameof]]
file exists $f
set res1 [file dirname [file join $f foo/bar]]
set res2 [file dirname "${f}/foo/bar"]
if {$res1 eq $res2} {
- set res "ok"
- } else {
- set res "file dirname problem, $res1, $res2 not equal"
+ return "ok"
}
- set res
+ return "file dirname problem, $res1, $res2 not equal"
} {ok}
# tail
-
-test cmdAH-9.1 {Tcl_FileObjCmd: tail} testsetplatform {
- testsetplatform unix
- list [catch {file tail a b} msg] $msg
-} {1 {wrong # args: should be "file tail name"}}
+test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body {
+ file tail a b
+} -result {wrong # args: should be "file tail name"}
test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform unix
file tail /a/b
@@ -485,33 +508,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}
@@ -538,11 +564,9 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
} bar
# rootname
-
-test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform {
- testsetplatform unix
- list [catch {file rootname a b} msg] $msg
-} {1 {wrong # args: should be "file rootname name"}}
+test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
+ file rootname a b
+} -result {wrong # args: should be "file rootname name"}
test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform {
testsetplatform unix
file rootname {}
@@ -640,11 +664,9 @@ foreach outer { {} a .a a. a.a } {
}
# extension
-
-test cmdAH-11.1 {Tcl_FileObjCmd: extension} testsetplatform {
- testsetplatform unix
- list [catch {file extension a b} msg] $msg
-} {1 {wrong # args: should be "file extension name"}}
+test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body {
+ file extension a b
+} -result {wrong # args: should be "file extension name"}
test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform {
testsetplatform unix
file extension {}
@@ -729,23 +751,26 @@ test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform {
testsetplatform windows
file extension a\\b.c\\
} {}
-set num 35
-foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
- foreach p {unix windows} {
- ;test cmdAH-11.$num {Tcl_FileObjCmd: extension} testsetplatform "
- testsetplatform $p
- file extension $value
- " $result
- incr num
- }
+foreach {test onPlatform value result} {
+ cmdAH-11.35 unix a..b .b
+ cmdAH-11.36 windows a..b .b
+ cmdAH-11.37 unix a...b .b
+ cmdAH-11.38 windows a...b .b
+ cmdAH-11.39 unix a.c..b .b
+ cmdAH-11.40 windows a.c..b .b
+ cmdAH-11.41 unix ..b .b
+ cmdAH-11.42 windows ..b .b
+} {
+ test $test {Tcl_FileObjCmd: extension} testsetplatform "
+ testsetplatform $onPlatform
+ file extension $value
+ " $result
}
# pathtype
-
-test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} testsetplatform {
- testsetplatform unix
- list [catch {file pathtype a b} msg] $msg
-} {1 {wrong # args: should be "file pathtype name"}}
+test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body {
+ file pathtype a b
+} -result {wrong # args: should be "file pathtype name"}
test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform {
testsetplatform unix
file pathtype /a
@@ -760,11 +785,9 @@ test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform {
} volumerelative
# split
-
-test cmdAH-13.1 {Tcl_FileObjCmd: split} testsetplatform {
- testsetplatform unix
- list [catch {file split a b} msg] $msg
-} {1 {wrong # args: should be "file split name"}}
+test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body {
+ file split a b
+} -result {wrong # args: should be "file split name"}
test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform {
testsetplatform unix
file split a
@@ -775,7 +798,6 @@ test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform {
} {a b}
# join
-
test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform {
testsetplatform unix
file join a
@@ -790,22 +812,20 @@ test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform {
} a/b/c/d
# error handling of Tcl_TranslateFileName
-
-test cmdAH-15.1 {Tcl_FileObjCmd} testsetplatform {
+test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body {
testsetplatform unix
- list [catch {file atime ~_bad_user} msg] $msg
-} {1 {user "_bad_user" doesn't exist}}
+ file atime ~_bad_user
+} -returnCodes error -result {user "_bad_user" doesn't exist}
catch {testsetplatform $platform}
# readable
-
set gorpfile [makeFile abcde gorp.file]
set dirfile [makeDirectory dir.file]
-
test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
- -body {list [catch {file readable a b} msg] $msg}
- -result {1 {wrong # args: should be "file readable name"}}
+ -returnCodes error
+ -body {file readable a b}
+ -result {wrong # args: should be "file readable name"}
}
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
-constraints testchmod
@@ -816,15 +836,15 @@ test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
-constraints {unix notRoot testchmod}
-setup {testchmod 0333 $gorpfile}
- -body {file reada $gorpfile}
+ -body {file readable $gorpfile}
-result 0
}
# writable
-
test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
- -body {list [catch {file writable a b} msg] $msg}
- -result {1 {wrong # args: should be "file writable name"}}
+ -returnCodes error
+ -body {file writable a b}
+ -result {wrong # args: should be "file writable name"}
}
test cmdAH-17.2 {Tcl_FileObjCmd: writable} {
-constraints {notRoot testchmod}
@@ -839,49 +859,41 @@ test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
-result 1
}
-
# executable
-
removeFile $gorpfile
removeDirectory $dirfile
set dirfile [makeDirectory dir.file]
set gorpfile [makeFile abcde gorp.file]
-
-test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {
- list [catch {file executable a b} msg] $msg
-} {1 {wrong # args: should be "file executable name"}}
-test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod notRoot} {
+test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
+ file executable a b
+} -result {wrong # args: should be "file executable name"}
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
- # Only on unix will setting the execute bit on a regular file
- # cause that file to be executable.
-
+ # Only on unix will setting the execute bit on a regular file cause that
+ # file to be executable.
testchmod 0775 $gorpfile
file exe $gorpfile
} 1
-
-test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win testchmod} {
+test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
# On pc, must be a .exe, .com, etc.
-
set x [file exe $gorpfile]
set gorpexe [makeFile foo gorp.exe]
lappend x [file exe $gorpexe]
+} -cleanup {
removeFile $gorpexe
- set x
-} {0 1}
-test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win testchmod} {
+} -result {0 1}
+test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
# On pc, must be a .exe, .com, etc.
-
set x [file exe $gorpfile]
set gorpexe [makeFile foo gorp.exe]
lappend x [file exe [string toupper $gorpexe]]
+} -cleanup {
removeFile $gorpexe
- set x
-} {0 1}
-test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
+} -result {0 1}
+test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
# Directories are always executable.
-
file exe $dirfile
} 1
@@ -891,10 +903,9 @@ set linkfile [file join [temporaryDirectory] link.file]
file delete $linkfile
# exists
-
-test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
- list [catch {file exists a b} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
+test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body {
+ file exists a b
+} -result {wrong # args: should be "file exists name"}
test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0
test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
file exists [file join [temporaryDirectory] dir.file gorp.file]
@@ -910,43 +921,55 @@ test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
file exists $subgorp
} 1
-
# nativename
-test cmdAH-19.6 {Tcl_FileObjCmd: nativename} testsetplatform {
+test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body {
testsetplatform unix
- list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 a/b {}}
-test cmdAH-19.7 {Tcl_FileObjCmd: nativename} testsetplatform {
+ file nativename a/b
+} -constraints testsetplatform -cleanup {
+ testsetplatform $platform
+} -result a/b
+test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body {
testsetplatform windows
- list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 {a\b} {}}
-
+ file nativename a/b
+} -constraints testsetplatform -cleanup {
+ testsetplatform $platform
+} -result {a\b}
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
-
-# 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.
-
-test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unix notRoot} {
+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.
+test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
file delete -force /tmp/tcl.foo.dir/file
file delete -force /tmp/tcl.foo.dir
+} -body {
makeDirectory /tmp/tcl.foo.dir
makeFile 12345 /tmp/tcl.foo.dir/file
file attributes /tmp/tcl.foo.dir -permissions 0000
-
- set result [file exists /tmp/tcl.foo.dir/file]
-
+ file exists /tmp/tcl.foo.dir/file
+} -cleanup {
file attributes /tmp/tcl.foo.dir -permissions 0775
removeFile /tmp/tcl.foo.dir/file
removeDirectory /tmp/tcl.foo.dir
- set result
-} 0
+} -result 0
+test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup {
+ set newdirfile [makeDirectory newdir.file]
+ set cwd [pwd]
+ cd $newdirfile
+ # Content of file is totally unimportant; name is *not*
+ set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]]
+} -body {
+ list [file exists foo.bar] [file exists *.bar]
+} -cleanup {
+ cd $cwd
+ removeFile $innocentBystander
+ removeDirectory $newdirfile
+} -result {1 0}
# Stat related commands
@@ -955,31 +978,30 @@ removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}
-# atime
-
# avoid problems with non-local filesystems
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
set file [makeFile "data" touch.me /tmp]
} else {
set file [makeFile "data" touch.me]
}
-test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
- list [catch {file atime a b c} msg] $msg
-} {1 {wrong # args: should be "file atime name ?time?"}}
-test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
- catch {unset stat}
+# atime
+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 {
+ unset -nocomplain stat
+} -body {
file stat $gorpfile stat
list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
[expr {[file atime $gorpfile] == $stat(atime)}]
-} {1 1}
+} -result {1 1}
test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
- string tolower [list [catch {file atime _bogus_} msg] \
- $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
- list [catch {file atime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
+ list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body {
+ file atime $file notint
+} -result {expected integer but got "notint"}
test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
set atime [file atime $file]
after 1100; # pause a sec to notice change in atime
@@ -987,13 +1009,15 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
set modatime [file atime $file $newatime]
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} 1
-test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
+test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
set old [pwd]
cd $::tcltest::temporaryDirectory
- if {![string equal "NTFS" [testvolumetype]]} {
- # Windows FAT doesn't understand atime, but NTFS does
- # May also fail for Windows on NFS mounted disks
- cd $old
+ set volumetype [testvolumetype]
+ cd $old
+} -constraints {win testvolumetype} -body {
+ if {"NTFS" ne $volumetype} {
+ # Windows FAT doesn't understand atime, but NTFS does. May also fail
+ # for Windows on NFS mounted disks.
return 1
}
cd $old
@@ -1002,135 +1026,117 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
set newatime [clock seconds]
set modatime [file atime $file $newatime]
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
-} 1
+} -result 1
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
removeFile touch.me /tmp
} else {
removeFile touch.me
}
# isdirectory
-
-test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
- list [catch {file isdirectory a b} msg] $msg
-} {1 {wrong # args: should be "file isdirectory name"}}
-test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
- file isdirectory $gorpfile
-} 0
-test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
- file isd $dirfile
-} 1
+test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body {
+ file isdirectory a b
+} -result {wrong # args: should be "file isdirectory name"}
+test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0
+test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1
# isfile
-
-test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
- list [catch {file isfile a b} msg] $msg
-} {1 {wrong # args: should be "file isfile name"}}
+test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body {
+ file isfile a b
+} -result {wrong # args: should be "file isfile name"}
test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1
test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0
-# lstat and readlink: don't run these tests everywhere, since not all
-# sites will have symbolic links
-
+# lstat and readlink: don't run these tests everywhere, since not all sites
+# will have symbolic links
catch {file link -symbolic $linkfile $gorpfile}
-test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
- list [catch {file lstat a} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
- list [catch {file lstat a b c} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
- catch {unset stat}
+test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
+ file lstat a
+} -result {wrong # args: should be "file lstat name varName"}
+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 {
+ unset -nocomplain stat
+} -constraints {unix nonPortable} -body {
file lstat $linkfile stat
lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
- catch {unset stat}
+} -result {atime ctime dev gid ino mode mtime nlink size type uid}
+test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
+ unset -nocomplain stat
+} -constraints {unix nonPortable} -body {
file lstat $linkfile stat
list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
-} {1 511 link}
+} -result {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
- string tolower [list [catch {file lstat _bogus_ stat} msg] \
- $msg $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} {
- catch {unset x}
+ list [catch {file lstat _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-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
+ unset -nocomplain x
+} -body {
set x 44
list [catch {file lstat $gorpfile x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-catch {unset stat}
-
+} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
+unset -nocomplain stat
# mkdir
-
set dirA [file join [temporaryDirectory] a]
set dirB [file join [temporaryDirectory] a]
-test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
+test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup {
catch {file delete -force $dirA}
+} -body {
file mkdir $dirA
- set res [file isdirectory $dirA]
+ file isdirectory $dirA
+} -cleanup {
file delete $dirA
- set res
-} {1}
-test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} -setup {
catch {file delete -force $dirA}
+} -body {
file mkdir $dirA/b
- set res [file isdirectory $dirA/b]
+ file isdirectory $dirA/b
+} -cleanup {
file delete -force $dirA
- set res
-} {1}
-test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} -setup {
catch {file delete -force $dirA}
+} -body {
file mkdir $dirA/b/c
- set res [file isdirectory $dirA/b/c]
+ file isdirectory $dirA/b/c
+} -cleanup {
file delete -force $dirA
- set res
-} {1}
-test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} -setup {
catch {file delete -force $dirA}
catch {file delete -force $dirB}
+} -body {
file mkdir $dirA/b $dirB/a/c
- set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]]
+ list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]
+} -cleanup {
file delete -force $dirA
file delete -force $dirB
- set res
-} {1 1}
-
-# mtime
-
-proc waitForEvenSecondForFAT {} {
- # Windows 9x uses filesystems (the FAT* family of FSes) without
- # enough data in its timestamps for even per-second-accurate
- # timings. :^(
- # This procedure based on work by Helmut Giese
+} -result {1 1}
+test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} {
+ # Allow zero arguments (TIP 323)
+ file mkdir
+} {}
- global tcl_platform
- if {$tcl_platform(platform) ne "windows"} {return}
- if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return}
- # Assume non-NTFS means FAT{12,16,32} and hence in need of special help
- set start [clock seconds]
- while {1} {
- set now [clock seconds]
- if {$now!=$start && !($now & 1)} {
- return
- }
- after 50
- }
-}
set file [makeFile "data" touch.me]
-
-test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
- list [catch {file mtime a b c} msg] $msg
-} {1 {wrong # args: should be "file mtime name ?time?"}}
-# Check (allowing for clock-skew and OS interrupts as best we can)
-# that the change in mtime on a file being written is the time elapsed
-# between writes. Note that this can still fail on very busy systems
-# if there are long preemptions between the writes and the reading of
-# the clock, but there's not much you can do about that other than the
-# completely horrible "keep on trying to write until you managed to do
-# it all in less than a second." - DKF
-test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
+# mtime
+test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
+ file mtime a b c
+} -result {wrong # args: should be "file mtime name ?time?"}
+test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup {
+ # Check (allowing for clock-skew and OS interrupts as best we can) that
+ # the change in mtime on a file being written is the time elapsed between
+ # writes. Note that this can still fail on very busy systems if there are
+ # long preemptions between the writes and the reading of the clock, but
+ # there's not much you can do about that other than the completely
+ # horrible "keep on trying to write until you managed to do it all in less
+ # than a second." - DKF
waitForEvenSecondForFAT
+} -body {
set f [open $gorpfile w]
puts $f "More text"
close $f
@@ -1147,39 +1153,37 @@ test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
(abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" :
"file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)"
}
-} {1}
-test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
- catch {unset stat}
+} -result {1}
+test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup {
+ unset -nocomplain stat
+} -body {
file stat $gorpfile stat
list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
[expr {[file atime $gorpfile] == $stat(atime)}]
-} {1 1}
+} -result {1 1}
test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
- string tolower [list [catch {file mtime _bogus_} msg] $msg \
- $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
- # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
- # On other platforms, just use a file in the local directory.
-
- if {[string equal $tcl_platform(platform) "unix"]} {
+ list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup {
+ # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other
+ # platforms, just use a file in the local directory.
+ if {[testConstraint unix]} {
set name /tmp/tcl.test.[pid]
} else {
set name [file join [temporaryDirectory] tf]
}
-
- # Make sure that a new file's time is correct. 10 seconds variance
- # is allowed used due to slow networks or clock skew on a network drive.
-
+} -body {
+ # Make sure that a new file's time is correct. 10 seconds variance is
+ # allowed used due to slow networks or clock skew on a network drive.
file delete -force $name
close [open $name w]
- set a [expr abs([clock seconds]-[file mtime $name])<10]
+ expr {abs([clock seconds]-[file mtime $name])<10}
+} -cleanup {
file delete $name
- set a
-} {1}
-test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
- list [catch {file mtime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
+} -result {1}
+test cmdAH-24.7 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
+ file mtime $file notint
+} -result {expected integer but got "notint"}
test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix {
set mtime [file mtime $file]
after 1100; # pause a sec to notice change in mtime
@@ -1187,8 +1191,9 @@ test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix {
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} 1
-test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix {
+test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
set oldfile $file
+} -constraints unix -body {
# introduce some non-ascii characters.
append file \u2022
file delete -force $file
@@ -1196,24 +1201,24 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix {
set mtime [file mtime $file]
after 1100; # pause a sec to notice change in mtime
set newmtime [clock seconds]
- set err [catch {file mtime $file $newmtime} modmtime]
- file rename $file $oldfile
- if {$err} {
- error $modmtime
- }
+ set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
-test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} win {
+} -cleanup {
+ file rename $file $oldfile
+} -result 1
+test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} -constraints win -setup {
waitForEvenSecondForFAT
+} -body {
set mtime [file mtime $file]
after 2100; # pause two secs to notice change in mtime on FAT fs'es
set newmtime [clock seconds]
set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
-test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
+} -result 1
+test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
waitForEvenSecondForFAT
set oldfile $file
+} -constraints win -body {
# introduce some non-ascii characters.
append file \u2022
file delete -force $file
@@ -1221,33 +1226,43 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
set mtime [file mtime $file]
after 2100; # pause two secs to notice change in mtime on FAT fs'es
set newmtime [clock seconds]
- set err [catch {file mtime $file $newmtime} modmtime]
- file rename $file $oldfile
- if {$err} {
- error $modmtime
- }
+ set modmtime [file mtime $file $newmtime]
expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
+} -cleanup {
+ file rename $file $oldfile
+} -result 1
removeFile touch.me
rename waitForEvenSecondForFAT {}
-
-test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
+test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} -setup {
set name [file join [temporaryDirectory] clockchange]
-
file delete -force $name
close [open $name w]
+} -body {
set time [clock scan "21:00:00 October 30 2004 GMT"]
file mtime $name $time
set newmtime [file mtime $name]
- file delete $name
expr {$newmtime == $time ? 1 : "$newmtime != $time"}
-} {1}
+} -cleanup {
+ file delete $name
+} -result {1}
+# bug 1420432: setting mtime fails for directories on windows.
+test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
+ set dirname [file join [temporaryDirectory] tmp[pid]]
+ file delete -force $dirname
+} -constraints tempNotWin -body {
+ file mkdir $dirname
+ set old [file mtime $dirname]
+ file mtime $dirname 0
+ set new [file mtime $dirname]
+ list $new [expr {$old != $new}]
+} -cleanup {
+ file delete -force $dirname
+} -result {0 1}
# owned
-
-test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
- list [catch {file owned a b} msg] $msg
-} {1 {wrong # args: should be "file owned name"}}
+test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
+ file owned a b
+} -result {wrong # args: should be "file owned name"}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
file owned $gorpfile
} -result 1
@@ -1264,27 +1279,23 @@ test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
} 0
# readlink
-
-test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
- list [catch {file readlink a b} msg] $msg
-} {1 {wrong # args: should be "file readlink name"}}
+test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
+ file readlink a b
+} -result {wrong # args: should be "file readlink name"}
test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} {
file readlink $linkfile
} $gorpfile
test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} {
- list [catch {file readlink _bogus_} msg] [string tolower $msg] \
- [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+ list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} {
- list [catch {file readlink _bogus_} msg] [string tolower $msg] \
- [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
+ list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}}
# size
-
-test cmdAH-27.1 {Tcl_FileObjCmd: size} {
- list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
+test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body {
+ file size a b
+} -result {wrong # args: should be "file size name"}
test cmdAH-27.2 {Tcl_FileObjCmd: size} {
set oldsize [file size $gorpfile]
set f [open $gorpfile a]
@@ -1294,106 +1305,105 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
expr {[file size $gorpfile] - $oldsize}
} {10}
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
- string tolower [list [catch {file size _bogus_} msg] $msg \
- $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-
-# stat
+ list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}
-test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
- list [catch {file stat _bogus_} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
- list [catch {file stat _bogus_ a b} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
- catch {unset stat}
+# stat
+test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
+ file stat _bogus_
+} -result {wrong # args: should be "file stat name varName"}
+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 {
+ unset -nocomplain stat
+ set stat(blocks) [set stat(blksize) {}]
+} -body {
file stat $gorpfile stat
+ unset stat(blocks) stat(blksize); # Ignore these fields; not always set
lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
- catch {unset stat}
+} -result {atime ctime dev gid ino mode mtime nlink size type uid}
+test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
+ unset -nocomplain stat
+} -body {
file stat $gorpfile stat
list $stat(nlink) $stat(size) $stat(type)
-} {1 12 file}
-test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unix} {
- catch {unset stat}
+} -result {1 12 file}
+test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
+ unset -nocomplain stat
+} -body {
file stat $gorpfile stat
- expr $stat(mode)&0777
-} {501}
+ expr {$stat(mode) & 0o777}
+} -result {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
- string tolower [list [catch {file stat _bogus_ stat} msg] \
- $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} {
- catch {unset x}
+ 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 {
+ unset -nocomplain x
+} -returnCodes error -body {
set x 44
- list [catch {file stat $gorpfile x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
- # Sign extension of purported unsigned short to int.
-
+ file stat $gorpfile x
+} -result {can't set "x(dev)": variable isn't array}
+test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup {
set filename [makeFile "" foo.text]
+} -body {
+ # Sign extension of purported unsigned short to int.
file stat $filename stat
- set x [expr {$stat(mode) > 0}]
+ expr {$stat(mode) > 0}
+} -cleanup {
removeFile $filename
- set x
-} 1
+} -result 1
test cmdAH-28.9 {Tcl_FileObjCmd: stat} win {
- # stat of root directory was failing.
- # don't care about answer, just that test runs.
-
- # relative paths that resolve to root
+ # stat of root directory was failing. Don't care about answer, just that
+ # test runs. Relative paths that resolve to root
set old [pwd]
cd c:/
file stat c: stat
file stat c:. stat
file stat . stat
cd $old
-
file stat / stat
file stat c:/ stat
file stat c:/. stat
} {}
test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} {
- # stat of root directory was failing.
- # don't care about answer, just that test runs.
-
+ # stat of root directory was failing. Don't care about answer, just that
+ # test runs.
file stat //pop/$env(USERNAME) stat
file stat //pop/$env(USERNAME)/ stat
file stat //pop/$env(USERNAME)/. stat
} {}
-test cmdAH-28.11 {Tcl_FileObjCmd: stat} {win nonPortable} {
- # stat of network directory was returning id of current local drive.
-
+test cmdAH-28.11 {Tcl_FileObjCmd: stat} -setup {
set old [pwd]
+} -constraints {win nonPortable} -body {
+ # stat of network directory was returning id of current local drive.
cd c:/
-
file stat //pop/$env(USERNAME) stat
- cd $old
expr {$stat(dev) == 2}
-} 0
-test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
- # stat(mode) with S_IFREG flag was returned as a negative number
- # if mode_t was a short instead of an unsigned short.
-
+} -cleanup {
+ cd $old
+} -result 0
+test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
set filename [makeFile "" foo.test]
+} -body {
+ # stat(mode) with S_IFREG flag was returned as a negative number if mode_t
+ # was a short instead of an unsigned short.
file stat $filename stat
- removeFile $filename
expr {$stat(mode) > 0}
-} 1
-catch {unset stat}
+} -cleanup {
+ removeFile $filename
+} -result 1
+unset -nocomplain stat
# type
-
-test cmdAH-29.1 {Tcl_FileObjCmd: type} {
- list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
+test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
+ file size a b
+} -result {wrong # args: should be "file size name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
file type $dirfile
} directory
@@ -1406,79 +1416,78 @@ test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortab
test cmdAH-29.3 {Tcl_FileObjCmd: type} {
file type $gorpfile
} file
-test cmdAH-29.4 {Tcl_FileObjCmd: type} {unix} {
+test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup {
catch {file delete $linkfile}
+} -body {
# Unlike [exec ln -s], [file link] requires an existing target
file link -symbolic $linkfile $gorpfile
- set result [file type $linkfile]
+ file type $linkfile
+} -cleanup {
file delete $linkfile
- set result
-} link
-test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {
+} -result link
+test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
set tempdir [makeDirectory temp]
+} -body {
set linkdir [file join [temporaryDirectory] link.dir]
file link -symbolic $linkdir $tempdir
- set result [file type $linkdir]
+ file type $linkdir
+} -cleanup {
file delete $linkdir
removeDirectory $tempdir
- set result
-} link
+} -result link
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
- string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+ list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
# Error conditions
-
-test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
- list [catch {file gorp x} msg] $msg
-} {1 {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, type, volumes, or writable}}
-test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
- list [catch {file ex x} msg] $msg
-} {1 {ambiguous option "ex": 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, type, volumes, or writable}}
-test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
- list [catch {file is x} msg] $msg
-} {1 {ambiguous option "is": 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, type, volumes, or writable}}
-test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
- list [catch {file z x} msg] $msg
-} {1 {bad option "z": 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, type, volumes, or writable}}
-test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
- list [catch {file read x} msg] $msg
-} {1 {ambiguous option "read": 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, type, volumes, or writable}}
-test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
- list [catch {file s x} msg] $msg
-} {1 {ambiguous option "s": 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, type, volumes, or writable}}
-test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
- list [catch {file t x} msg] $msg
-} {1 {ambiguous option "t": 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, type, volumes, or writable}}
-test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
- list [catch {file dirname ~woohgy} msg] $msg
-} {1 {user "woohgy" doesn't exist}}
+test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+ file gorp x
+} -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 {unknown or ambiguous subcommand "ex": must be *}
+test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+ file is x
+} -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 {unknown or ambiguous subcommand "z": must be *}
+test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+ file read x
+} -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 {unknown or ambiguous subcommand "s": must be *}
+test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+ file t x
+} -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}
# channels
-# In testing 'file channels', we need to make sure that a channel
-# created in one interp isn't visible in another.
+# In testing 'file channels', we need to make sure that a channel created in
+# one interp isn't visible in another.
interp create simpleInterp
interp create -safe safeInterp
-interp c
-safeInterp expose file file
+interp create
+catch {safeInterp expose file file}
-test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
- list [catch {file channels a b} msg] $msg
-} {1 {wrong # args: should be "file channels ?pattern?"}}
+test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
+ file channels a b
+} -returnCodes error -result {wrong # args: should be "file channels ?pattern?"}
test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
# Normal interps start out with only the standard channels
lsort [simpleInterp eval [list file chan]]
-} [lsort {stderr stdout stdin}]
+} {stderr stdin stdout}
test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
string equal [file channels] [file channels *]
} {1}
test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
lsort [file channels std*]
-} [lsort {stdout stderr stdin}]
-
+} {stderr stdin stdout}
set newFileId [open $gorpfile w]
-
test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
set res [file channels $newFileId]
string equal $newFileId $res
@@ -1487,13 +1496,11 @@ test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
# Safe interps start out with no channels
safeInterp eval [list file channels]
} {}
-test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {
- list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
-} [list 1 "can not find channel named \"$newFileId\""]
-
+test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} -body {
+ safeInterp eval [list puts $newFileId "hello"]
+} -returnCodes error -result "can not find channel named \"$newFileId\""
interp share {} $newFileId safeInterp
interp share {} stdout safeInterp
-
test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {
# $newFileId should now be visible in both interps
list [file channels $newFileId] \
@@ -1506,9 +1513,7 @@ test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
# we can now write to $newFileId from slave
safeInterp eval [list puts $newFileId "hello"]
} {}
-
interp transfer {} $newFileId safeInterp
-
test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {
# $newFileId should now be visible only in safeInterp
list [file channels $newFileId] \
@@ -1522,6 +1527,54 @@ test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
safeInterp eval [list file channels]
} {stdout}
+# Temp files (TIP#210)
+test cmdAH-32.1 {file tempfile - usage} -returnCodes error -body {
+ file tempfile a b c
+} -result {wrong # args: should be "file tempfile ?nameVar? ?template?"}
+test cmdAH-32.2 {file tempfile - returns a read/write channel} -body {
+ set f [file tempfile]
+ puts $f ok
+ seek $f 0
+ gets $f
+} -cleanup {
+ catch {close $f}
+} -result ok
+test cmdAH-32.3 {file tempfile - makes filenames} -setup {
+ unset -nocomplain name
+} -body {
+ set result [info exists name]
+ set f [file tempfile name]
+ lappend result [info exists name] [file exists $name]
+ close $f
+ lappend result [file exists $name]
+} -cleanup {
+ catch {close $f}
+ catch {file delete $name}
+} -result {0 1 1 1}
+# We try to obey the template on Unix, but don't (currently) bother on Win
+test cmdAH-32.4 {file tempfile - templates} -constraints unix -body {
+ close [file tempfile name foo]
+ expr {[string match foo* [file tail $name]] ? "ok" : "foo produced $name"}
+} -cleanup {
+ catch {file delete $name}
+} -result ok
+test cmdAH-32.5 {file tempfile - templates} -constraints unix -body {
+ set template [file join $dirfile foo]
+ close [file tempfile name $template]
+ expr {[string match $template* $name] ? "ok" : "$template produced $name"}
+} -cleanup {
+ catch {file delete $name}
+} -result ok
+# Not portable; not all unix systems have mkstemps()
+test cmdAH-32.6 {file tempfile - templates} -body {
+ set template [file join $dirfile foo]
+ close [file tempfile name $template.bar]
+ expr {[string match $template*.bar $name] ? "ok" :
+ "$template.bar produced $name"}
+} -constraints {unix nonPortable} -cleanup {
+ catch {file delete $name}
+} -result ok
+
# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}
@@ -1530,7 +1583,7 @@ interp delete simpleInterp
# cleanup
catch {testsetplatform $platform}
-catch {unset platform}
+unset -nocomplain platform
# Tcl_ForObjCmd is tested in for.test
@@ -1544,3 +1597,7 @@ cd $cmdAHwd
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index f1653b4..23a5f96 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -1,38 +1,40 @@
-# This file contains a collection of tests for the procedures in the
-# file tclCmdIL.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
+# tclCmdIL.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: cmdIL.test,v 1.26 2005/06/01 11:00:35 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 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]]
-test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
- list [catch {lsort} msg] $msg
-} {1 {wrong # args: should be "lsort ?options? list"}}
-test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
- list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
+test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+ lsort
+} -result {wrong # args: should be "lsort ?-option value ...? list"}
+test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+ lsort -foo {1 3 2 5}
+} -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
lsort -integer -ascii {d e c b a d35 d300}
} {a b c d d300 d35 e}
-test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} {
- list [catch {lsort -command {1 3 2 5}} msg] $msg
-} {1 {"-command" option must be followed by comparison command}}
+test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body {
+ lsort -command {1 3 2 5}
+} -returnCodes error -result {"-command" option must be followed by comparison command}
test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup {
proc cmp {a b} {
expr {[string match x* $b] - [string match x* $a]}
@@ -54,12 +56,12 @@ test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} {
test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
-test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
- list [catch {lsort -index {1 3 2 5}} msg] $msg
-} {1 {"-index" option must be followed by list index}}
-test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
- list [catch {lsort -index foo {1 3 2 5}} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
+test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
+ lsort -index {1 3 2 5}
+} -returnCodes error -result {"-index" option must be followed by list index}
+test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
+ lsort -index foo {1 3 2 5}
+} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
@@ -69,15 +71,15 @@ test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
lsort -integer {24 6 300 18}
} {6 18 24 300}
-test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} {
- list [catch {lsort -integer {1 3 2.4}} msg] $msg
-} {1 {expected integer but got "2.4"}}
+test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} -body {
+ lsort -integer {1 3 2.4}
+} -returnCodes error -result {expected integer but got "2.4"}
test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} {
lsort -real {24.2 6e3 150e-1}
} {150e-1 24.2 6e3}
-test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
- list [catch {lsort "1 2 3 \{ 4"} msg] $msg
-} {1 {unmatched open brace in list}}
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} -body {
+ lsort "1 2 3 \{ 4"
+} -returnCodes error -result {unmatched open brace in list}
test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
lsort {}
} {}
@@ -93,22 +95,21 @@ test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup
proc testcmp {a b} {return [string compare $a $b]}
} -body {
set l [list [list a b] [list c d]]
- list [catch {lsort -command testcmp -index 1 $l} msg] $msg
+ lsort -command testcmp -index 1 $l
} -cleanup {
rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
+} -result [list [list a b] [list c d]]
test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup {
catch {rename 1 ""}
proc testcmp {a b} {return [string compare $a $b]}
} -body {
set l [list [list a b] [list c d]]
- list [catch {lsort -index 1 -command testcmp $l} msg] $msg
+ lsort -index 1 -command testcmp $l
} -cleanup {
rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
-# Note that the required order only exists in the end-1'th element;
-# indexing using the end element or any fixed offset from the start
-# will not work...
+} -result [list [list a b] [list c d]]
+# Note that the required order only exists in the end-1'th element; indexing
+# using the end element or any fixed offset from the start will not work...
test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
} {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
@@ -118,9 +119,37 @@ test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} {
test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} {
lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6}
} {2 3 0}
+test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} {
+ set l {1 2 3}
+ string length [lsort -command {apply {args {string length $::l}}} $l]
+} 5
+test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} {
+ lsort -stride 2 {f e d c b a}
+} {b a d c f e}
+test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} {
+ lsort -stride 3 {f e d c b a}
+} {c b a f e d}
+test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body {
+ lsort -stride foo bar
+} -result {expected integer but got "foo"}
+test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body {
+ lsort -stride 1 bar
+} -result {stride length must be at least 2}
+test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
+ lsort -stride 2 {a b c}
+} -result {list size must be a multiple of the stride length}
+test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
+ lsort -stride 2 -index 3 {a b c d}
+} -result {when used with "-stride", the leading "-index" value must be within the group}
+test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
+ lsort -stride 2 -index {0 1} {
+ {{c o d e} 54321} {{b l a h} 94729}
+ {{b i g} 12345} {{d e m o} 34512}
+ }
+} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
-# Can't think of any good tests for the MergeSort and MergeLists
-# procedures, except a bunch of random lists to sort.
+# Can't think of any good tests for the MergeSort and MergeLists procedures,
+# except a bunch of random lists to sort.
test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
set result {}
@@ -145,36 +174,35 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
set old $el
}
}
- set result
+ string trim $result
} -cleanup {
rename rand ""
} -result {}
-test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -setup {
- proc cmp {a b} {
- global x
- incr x
- error "error #$x"
- }
-} -body {
- set x 0
- list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
- $msg $x
-} -cleanup {
- rename cmp ""
+test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -body {
+ set ::x 0
+ list [catch {
+ lsort -integer -command {apply {{a b} {
+ incr ::x
+ error "error #$::x"
+ }}} {48 6 28 190 16 2 3 6 1}
+ } msg] $msg $::x
} -result {1 {error #1} 1}
-test cmdIL-3.2 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 "\\\{ {30 40 50}"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.3 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
-} {1 {element 2 missing from sublist "20 10"}}
-test cmdIL-3.4 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 "{a b c} \\\{"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.5 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
-} {1 {element 2 missing from sublist "15"}}
+test cmdIL-3.2 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "\\\{ {30 40 50}"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.3 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 {{20 10} {15 30 40}}
+} -returnCodes error -result {element 2 missing from sublist "20 10"}
+test cmdIL-3.4 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "{a b c} \\\{"
+} -returnCodes error -result {expected integer but got "c"}
+test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "{1 2 3} \\\{"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.5 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 {{20 10 13} {15}}
+} -returnCodes error -result {element 2 missing from sublist "15"}
test cmdIL-3.6 {SortCompare procedure, -index option} {
lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
@@ -184,21 +212,21 @@ test cmdIL-3.7 {SortCompare procedure, -ascii option} {
test cmdIL-3.8 {SortCompare procedure, -dictionary option} {
lsort -dictionary {d e c b a d35 d300 100 20}
} {20 100 a b c d d35 d300 e}
-test cmdIL-3.9 {SortCompare procedure, -integer option} {
- list [catch {lsort -integer {x 3}} msg] $msg
-} {1 {expected integer but got "x"}}
-test cmdIL-3.10 {SortCompare procedure, -integer option} {
- list [catch {lsort -integer {3 q}} msg] $msg
-} {1 {expected integer but got "q"}}
+test cmdIL-3.9 {SortCompare procedure, -integer option} -body {
+ lsort -integer {x 3}
+} -returnCodes error -result {expected integer but got "x"}
+test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
+ lsort -integer {3 q}
+} -returnCodes error -result {expected integer but got "q"}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
- lsort -integer {35 21 0x20 30 023 100 8}
-} {8 023 21 30 0x20 35 100}
-test cmdIL-3.12 {SortCompare procedure, -real option} {
- list [catch {lsort -real {6...4 3}} msg] $msg
-} {1 {expected floating-point number but got "6...4"}}
-test cmdIL-3.13 {SortCompare procedure, -real option} {
- list [catch {lsort -real {3 1x7}} msg] $msg
-} {1 {expected floating-point number but got "1x7"}}
+ lsort -integer {35 21 0x20 30 0o23 100 8}
+} {8 0o23 21 30 0x20 35 100}
+test cmdIL-3.12 {SortCompare procedure, -real option} -body {
+ lsort -real {6...4 3}
+} -returnCodes error -result {expected floating-point number but got "6...4"}
+test cmdIL-3.13 {SortCompare procedure, -real option} -body {
+ lsort -real {3 1x7}
+} -returnCodes error -result {expected floating-point number but got "1x7"}
test cmdIL-3.14 {SortCompare procedure, -real option} {
lsort -real {24 2.5e01 16.7 85e-1 10.004}
} {85e-1 10.004 16.7 24 2.5e01}
@@ -206,7 +234,7 @@ test cmdIL-3.15 {SortCompare procedure, -command option} -body {
proc cmp {a b} {
error "comparison error"
}
- list [catch {lsort -command cmp {48 6}} msg] $msg $errorInfo
+ list [catch {lsort -command cmp {48 6}} msg] $msg $::errorInfo
} -cleanup {
rename cmp ""
} -result {1 {comparison error} {comparison error
@@ -230,10 +258,10 @@ test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} -bo
proc cmp {a b} {
return foow
}
- list [catch {lsort -command cmp {48 6}} msg] $msg
-} -cleanup {
+ lsort -command cmp {48 6}
+} -returnCodes error -cleanup {
rename cmp ""
-} -result {1 {-compare command returned non-integer result}}
+} -result {-compare command returned non-integer result}
test cmdIL-3.18 {SortCompare procedure, -command option} -body {
proc cmp {a b} {
expr {$b - $a}
@@ -243,8 +271,8 @@ test cmdIL-3.18 {SortCompare procedure, -command option} -body {
rename cmp ""
} -result {48 36 35 22 21 18 6}
test cmdIL-3.19 {SortCompare procedure, -decreasing option} {
- lsort -decreasing -integer {35 21 0x20 30 023 100 8}
-} {100 35 0x20 30 21 023 8}
+ lsort -decreasing -integer {35 21 0x20 30 0o23 100 8}
+} {100 35 0x20 30 21 0o23 8}
test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} {
lsort -dictionary {a003b a03b}
@@ -389,6 +417,15 @@ test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}
+test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
+} {257 32 256}
+test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c
+} {97 32 97 0 97}
+test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
+ scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c
+} {97 32 97 0 97}
test cmdIL-5.1 {lsort with list style index} {
lsort -ascii -decreasing -index {0 1} {
@@ -431,110 +468,76 @@ 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} -body {
- proc testLassign {} {
- lassign
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
-test cmdIL-6.2 {lassign command syntax} -body {
- proc testLassign {} {
- lassign x
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
+ apply {{} { lassign }}
+} -result {wrong # args: should be "lassign list ?varName ...?"}
+test cmdIL-6.2 {lassign command syntax} {
+ apply {{} { lassign x }}
+} x
test cmdIL-6.3 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
list [lassign a x] $x
- }
- testLassign
-} -result {{} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a}
test cmdIL-6.4 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign a x y] $x $y
- }
- testLassign
-} -result {{} a {}} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a {}}
test cmdIL-6.5 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b} x y] $x $y
- }
- testLassign
-} -result {{} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a b}
test cmdIL-6.6 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b c} x y] $x $y
- }
- testLassign
-} -result {c a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c a b}
test cmdIL-6.7 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b c d} x y] $x $y
- }
- testLassign
-} -result {{c d} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{c d} a b}
test cmdIL-6.8 {lassign command - list format error} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
- }
- testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
test cmdIL-6.9 {lassign command - assignment to arrays} -body {
- proc testLassign {} {
+ apply {{} {
list [lassign {a b} x(x)] $x(x)
- }
- testLassign
-} -result {b a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {b a}
test cmdIL-6.10 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set x(x) {}
lassign a x
- }
- testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
- rename testLassign {}
-}
+ }}
+} -returnCodes error -result {can't set "x": variable is array}
test cmdIL-6.11 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set x(x) {}
set y FAIL
list [catch {lassign a y x} msg] $msg $y
- }
- testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {can't set "x": variable is array} a}
test cmdIL-6.12 {lassign command - memory leak testing} -setup {
unset -nocomplain x y
set x(x) {}
@@ -563,119 +566,86 @@ test cmdIL-6.12 {lassign command - memory leak testing} -setup {
rename stress {}
}
# Force non-compiled version
-test cmdIL-6.13 {lassign command syntax} -body {
- proc testLassign {} {
+test cmdIL-6.13 {lassign command syntax} -returnCodes error -body {
+ apply {{} {
set lassign lassign
$lassign
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
-test cmdIL-6.14 {lassign command syntax} -body {
- proc testLassign {} {
+ }}
+} -result {wrong # args: should be "lassign list ?varName ...?"}
+test cmdIL-6.14 {lassign command syntax} {
+ apply {{} {
set lassign lassign
$lassign x
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+ }}
+} x
test cmdIL-6.15 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
list [$lassign a x] $x
- }
- testLassign
-} -result {{} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a}
test cmdIL-6.16 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign a x y] $x $y
- }
- testLassign
-} -result {{} a {}} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a {}}
test cmdIL-6.17 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b} x y] $x $y
- }
- testLassign
-} -result {{} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a b}
test cmdIL-6.18 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b c} x y] $x $y
- }
- testLassign
-} -result {c a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c a b}
test cmdIL-6.19 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b c d} x y] $x $y
- }
- testLassign
-} -result {{c d} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{c d} a b}
test cmdIL-6.20 {lassign command - list format error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y
- }
- testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
test cmdIL-6.21 {lassign command - assignment to arrays} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
list [$lassign {a b} x(x)] $x(x)
- }
- testLassign
-} -result {b a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {b a}
test cmdIL-6.22 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x(x) {}
$lassign a x
- }
- testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
- rename testLassign {}
-}
+ }}
+} -returnCodes 1 -result {can't set "x": variable is array}
test cmdIL-6.23 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x(x) {}
set y FAIL
list [catch {$lassign a y x} msg] $msg $y
- }
- testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {can't set "x": variable is array} a}
test cmdIL-6.24 {lassign command - memory leak testing} -setup {
set x(x) {}
set y FAIL
@@ -705,24 +675,66 @@ test cmdIL-6.24 {lassign command - memory leak testing} -setup {
}
# Assorted shimmering problems
test cmdIL-6.25 {lassign command - shimmering protection} -body {
- proc testLassign {} {
+ apply {{} {
set x {a b c}
list [lassign $x $x y] $x [set $x] $y
- }
- testLassign
-} -result {c {a b c} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c {a b c} a b}
test cmdIL-6.26 {lassign command - shimmering protection} -body {
- proc testLassign {} {
+ apply {{} {
set x {a b c}
set lassign lassign
list [$lassign $x $x y] $x [set $x] $y
- }
- testLassign
-} -result {c {a b c} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c {a b c} a b}
+
+test cmdIL-7.1 {lreverse command} -body {
+ lreverse
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.2 {lreverse command} -body {
+ lreverse a b
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.3 {lreverse command} -body {
+ lreverse "not \{a list"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-7.4 {lreverse command - shared object} {
+ set x {a b {c d} e f}
+ lreverse $x
+} {f e {c d} b a}
+test cmdIL-7.5 {lreverse command - unshared object} {
+ lreverse [list a b {c d} e f]
+} {f e {c d} b a}
+test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
+ lreverse [set x {1 2 3}][unset x]
+} {3 2 1}
+test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
+ lreverse [list]
+} {}
+test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
+ teststringobj set 1 {1 2 3}
+ testobj convert 1 list
+ testobj duplicate 1 2
+ variable x [teststringobj get 1]
+ variable y [teststringobj get 2]
+ testobj freeallvars
+ proc K {a b} {return $a}
+} -constraints testobj -body {
+ lreverse [K $y [unset y]]
+ lindex $x 0
+} -cleanup {
+ unset -nocomplain x y
+ 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
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index b4022af..0a587e8 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -12,18 +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.8 2003/11/14 20:44:46 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
-::tcltest::testConstraint testcmdinfo \
- [llength [info commands testcmdinfo]]
-::tcltest::testConstraint testcmdtoken \
- [llength [info commands testcmdtoken]]
+testConstraint testcmdinfo [llength [info commands testcmdinfo]]
+testConstraint testcmdtoken [llength [info commands testcmdtoken]]
test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
@@ -71,7 +68,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
rename x1 newName
set y [testcmdtoken name $x]
rename newName x1
- lappend y {expand}[testcmdtoken name $x]
+ lappend y {*}[testcmdtoken name $x]
} {newName ::newName x1 ::x1}
catch {rename newTestCmd {}}
@@ -88,7 +85,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \
}]
set y [testcmdtoken name $x]
rename ::testCmd newTestCmd
- lappend y {expand}[testcmdtoken name $x]
+ lappend y {*}[testcmdtoken name $x]
} {testCmd ::testCmd newTestCmd ::newTestCmd}
test cmdinfo-6.1 {Names for commands created when outside namespaces} \
@@ -96,11 +93,15 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \
set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
set y [testcmdtoken name $x]
rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
- lappend y {expand}[testcmdtoken name $x]
+ lappend y {*}[testcmdtoken name $x]
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
# cleanup
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
-::tcltest::cleanupTests
+cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 2eff71f..2d68138 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -1,17 +1,15 @@
# The tests in this file cover the procedures in tclCmdMZ.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) 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: cmdMZ.test,v 1.24 2004/07/06 21:08:37 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -26,49 +24,64 @@ namespace eval ::tcl::test::cmdMZ {
namespace import ::tcltest::temporaryDirectory
namespace import ::tcltest::test
+ proc ListGlobMatch {expected actual} {
+ if {[llength $expected] != [llength $actual]} {
+ return 0
+ }
+ foreach e $expected a $actual {
+ if {![string match $e $a]} {
+ return 0
+ }
+ }
+ return 1
+ }
+ customMatch listGlob [namespace which ListGlobMatch]
+
# Tcl_PwdObjCmd
-test cmdMZ-1.1 {Tcl_PwdObjCmd} {
- list [catch {pwd a} msg] $msg
-} {1 {wrong # args: should be "pwd"}}
+test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body {
+ pwd a
+} -result {wrong # args: should be "pwd"}
test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
catch pwd
} 0
-test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
- expr [string length pwd]>0
-} 1
-test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unix nonPortable} {
- # This test fails on various unix platforms (eg Linux) where
- # permissions caching causes this to fail. The caching is strictly
- # incorrect, but we have no control over that.
+test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} -body {
+ pwd
+} -match glob -result {?*}
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
+ set cwd [pwd]
set foodir [file join [temporaryDirectory] foo]
file delete -force $foodir
file mkdir $foodir
- set cwd [pwd]
cd $foodir
+} -constraints {unix nonPortable} -body {
+ # This test fails on various unix platforms (eg Linux) where permissions
+ # caching causes this to fail. The caching is strictly incorrect, but we
+ # have no control over that.
file attr . -permissions 000
- set result [list [catch {pwd} msg] $msg]
+ pwd
+} -returnCodes error -cleanup {
cd $cwd
file delete -force $foodir
- set result
-} {1 {error getting working directory name: permission denied}}
+} -result {error getting working directory name: permission denied}
# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
# Tcl_RenameObjCmd
-test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1 r2 r3} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
+test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+ rename r1
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+ rename r1 r2 r3
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.3 {Tcl_RenameObjCmd: success} -setup {
catch {rename r2 {}}
+} -body {
proc r1 {} {return "r1"}
rename r1 r2
r2
-} {r1}
+} -result {r1}
test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
proc r1 {} {return "r1"}
rename r1 {}
@@ -81,24 +94,25 @@ test cmdMZ-return-1.0 {return checks for bad option values} -body {
return -options foo
} -returnCodes error -match glob -result {bad -options value:*}
test cmdMZ-return-1.1 {return checks for bad option values} -body {
- return -code foo
-} -returnCodes error -match glob -result {bad completion code*}
+ return -code err
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
test cmdMZ-return-1.2 {return checks for bad option values} -body {
return -code 0x100000000
-} -returnCodes error -match glob -result {bad completion code*}
+} -returnCodes error -match glob -result {bad completion code "0x100000000": must be ok, error, return, break, continue*, or an integer}
test cmdMZ-return-1.3 {return checks for bad option values} -body {
return -level foo
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.4 {return checks for bad option values} -body {
return -level -1
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.5 {return checks for bad option values} -body {
return -level 3.1415926
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
proc dictSort {d} {
+ set result {}
foreach k [lsort [dict keys $d]] {
- lappend result $k [dict get $d $k]
+ dict set result $k [dict get $d $k]
}
return $result
}
@@ -133,11 +147,11 @@ test cmdMZ-return-2.8 {return option handling} -body {
test cmdMZ-return-2.9 {return option handling} -body {
return -level 0 -code 10
} -returnCodes 10 -result {}
-test cmdMZ-return-2.10 {return option handling} {
+test cmdMZ-return-2.10 {return option handling} -body {
list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
-} {1 {-code 1 -errorcode NONE -errorinfo {
+} -match glob -result {1 {-code 1 -errorcode NONE -errorinfo {
while executing
-"return -level 0 -code error"} -errorline 1 -level 0}}
+"return -level 0 -code error"} -errorline 1 -errorstack * -level 0}}
test cmdMZ-return-2.11 {return option handling} {
list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
} {3 {-code 3 -level 0}}
@@ -145,72 +159,66 @@ test cmdMZ-return-2.12 {return option handling} -body {
return -level 0 -code error -options {-code ok}
} -returnCodes ok -result {}
test cmdMZ-return-2.13 {return option handling} -body {
- return -level 0 -code error -options {-code foo}
-} -returnCodes error -match glob -result {bad completion code*}
+ return -level 0 -code error -options {-code err}
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
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]
+} {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
-# indistinguishable from that of the originally caught script, no
-# matter what the script is/does. (TIP 90)
-set i 0
-foreach script {
- {}
- {format x}
- {set}
- {set a 1}
- {error}
- {error foo}
- {error foo bar}
- {error foo bar baz}
- {return -level 0}
- {return -code error}
- {return -code error -errorinfo foo}
- {return -code error -errorinfo foo -errorcode bar}
- {return -code error -errorinfo foo -errorcode bar -errorline 10}
- {return -options {x y z 2}}
- {return -level 3 -code break sdf}
+# indistinguishable from that of the originally caught script, no matter what
+# the script is/does. (TIP 90)
+foreach {testid script} {
+ cmdMZ-return-3.0 {}
+ cmdMZ-return-3.1 {format x}
+ cmdMZ-return-3.2 {set}
+ cmdMZ-return-3.3 {set a 1}
+ cmdMZ-return-3.4 {error}
+ cmdMZ-return-3.5 {error foo}
+ cmdMZ-return-3.6 {error foo bar}
+ cmdMZ-return-3.7 {error foo bar baz}
+ cmdMZ-return-3.8 {return -level 0}
+ cmdMZ-return-3.9 {return -code error}
+ cmdMZ-return-3.10 {return -code error -errorinfo foo}
+ cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
+ cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
+ cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz}
+ cmdMZ-return-3.13 {return -options {x y z 2}}
+ cmdMZ-return-3.14 {return -level 3 -code break sdf}
} {
- test cmdMZ-return-3.$i "check that return after a catch is same:\n$script" {
+ test $testid "check that return after a catch is same:\n$script" {
set one [list [catch $script foo bar] $foo [dictSort $bar] \
$::errorCode $::errorInfo]
set two [list [catch {return -options $bar $foo} foo2 bar2] \
$foo2 [dictSort $bar2] $::errorCode $::errorInfo]
string equal $one $two
} 1
- incr i
}
# The tests for Tcl_ScanObjCmd are in scan.test
@@ -220,58 +228,44 @@ foreach script {
test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
unixOrPc
-} -body {
- list [catch {source} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
+} -returnCodes error -body {
+ source
+} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
unixOrPc
-} -body {
- list [catch {source a b} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
-
-proc ListGlobMatch {expected actual} {
- if {[llength $expected] != [llength $actual]} {
- return 0
- }
- foreach e $expected a $actual {
- if {![string match $e $a]} {
- return 0
- }
- }
- return 1
-}
-customMatch listGlob [namespace which ListGlobMatch]
-
+} -returnCodes error -body {
+ source a b
+} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
set file [makeFile {
set x 146
error "error in sourced file"
set y $x
} source.file]
- set result [list [catch {source $file} msg] $msg $errorInfo]
+ list [catch {source $file} msg] $msg $::errorInfo
+} -cleanup {
removeFile source.file
- set result
} -match listGlob -result {1 {error in sourced file} {error in sourced file
while executing
"error "error in sourced file""
(file "*" line 3)
invoked from within
"source $file"}}
-test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
- set file [makeFile {list result} source.file]
- set result [source $file]
+test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} -body {
+ set file [makeFile {list ok} source.file]
+ source $file
+} -cleanup {
removeFile source.file
- set result
-} result
+} -result ok
# Tcl_SplitObjCmd
-test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
- list [catch split msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
-test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
- list [catch {split a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+ split
+} -result {wrong # args: should be "split string ?splitChars?"}
+test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+ split a b c
+} -result {wrong # args: should be "split string ?splitChars?"}
test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}
@@ -294,23 +288,22 @@ test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
split { }
} {{} {} {} {}}
test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
- proc foo {} {
+ apply {{} {
set x {}
foreach f [split {]\n} {}] {
append x $f
}
- return $x
- }
- foo
+ return $x
+ }}
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
- proc foo {} {
+ apply {{} {
set x ab\000c
set y [split $x {}]
- return $y
- }
- foo
-} "a b \000 c"
+ binary scan $y c* z
+ return $z
+ }}
+} {97 32 98 32 0 32 99}
test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
split "a0ab1b2bbb3\000c4" ab\000c
} {{} 0 {} 1 2 {} {} 3 {} 4}
@@ -323,21 +316,21 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
-test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time a b c} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time a b} msg] $msg
-} {1 {expected integer but got "b"}}
+test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
+ time
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
+ time a b c
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body {
+ time a b
+} -returnCodes error -result {expected integer but got "b"}
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
time bogusCmd -12456
} {0 microseconds per iteration}
-test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
- regexp {^\d+ microseconds per iteration} [time {format 1}]
-} 1
+test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
+ time {format 1}
+} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
} 1
@@ -350,9 +343,13 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
"time {error foo}"}}
# The tests for Tcl_WhileObjCmd are in while.test
-
+
# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index db8601d..bae26a0 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -11,15 +11,16 @@
#
# 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.14 2005/08/10 16:28:02 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::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 {
testConstraint testmathfunctions 1
@@ -81,7 +82,10 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
+
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
# procedures used below
@@ -190,34 +194,28 @@ test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr
test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} {
expr double(5*[llength "6 2"])
} 10.0
-test compExpr-old-2.2 {TclCompileExpr: error in expr} {
- catch {expr 2***3} msg
- set msg
-} {syntax error in expression "2***3": unexpected operator *}
-test compExpr-old-2.3 {TclCompileExpr: junk after legal expr} {
- catch {expr 7*[llength "a b"]foo} msg
- set msg
-} {syntax error in expression "7*2foo": extra tokens at end of expression}
+test compExpr-old-2.2 {TclCompileExpr: error in expr} -body {
+ expr 2***3
+} -returnCodes error -match glob -result *
+test compExpr-old-2.3 {TclCompileExpr: junk after legal expr} -body {
+ expr 7*[llength "a b"]foo
+} -returnCodes error -match glob -result *
test compExpr-old-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
expr {0001}
} 1
test compExpr-old-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
test compExpr-old-3.2 {CompileCondExpr: error in lor expr} -body {
- catch {expr x||3} msg
- set msg
-} -match glob \
- -result {syntax error in expression "x||3": * preceding $*}
+ expr x||3
+} -returnCodes error -match glob -result *
test compExpr-old-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
-test compExpr-old-3.4 {CompileCondExpr: error compiling true arm} {
- catch {expr 3>2?2***3:66} msg
- set msg
-} {syntax error in expression "3>2?2***3:66": unexpected operator *}
+test compExpr-old-3.4 {CompileCondExpr: error compiling true arm} -body {
+ expr 3>2?2***3:66
+} -returnCodes error -match glob -result *
test compExpr-old-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
-test compExpr-old-3.6 {CompileCondExpr: error compiling false arm} {
- catch {expr 2>3?44:2***3} msg
- set msg
-} {syntax error in expression "2>3?44:2***3": unexpected operator *}
+test compExpr-old-3.6 {CompileCondExpr: error compiling false arm} -body {
+ expr 2>3?44:2***3
+} -returnCodes error -match glob -result *
test compExpr-old-3.7 {CompileCondExpr: long arms & nested cond exprs} {
hello_world
} {Hello world}
@@ -228,20 +226,17 @@ test compExpr-old-3.8 {CompileCondExpr: long arms & nested cond exprs} unix {
test compExpr-old-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
test compExpr-old-4.2 {CompileLorExpr: error in land expr} -body {
- catch {expr x&&3} msg
- set msg
-} -match glob -result {syntax error in expression "x&&3": * preceding $*}
+ expr x&&3
+} -returnCodes error -match glob -result *
test compExpr-old-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
test compExpr-old-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
test compExpr-old-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
-test compExpr-old-4.6 {CompileLorExpr: error compiling lor arm} {
- catch {expr 2***3||4.0} msg
- set msg
-} {syntax error in expression "2***3||4.0": unexpected operator *}
-test compExpr-old-4.7 {CompileLorExpr: error compiling lor arm} {
- catch {expr 1.3||2***3} msg
- set msg
-} {syntax error in expression "1.3||2***3": unexpected operator *}
+test compExpr-old-4.6 {CompileLorExpr: error compiling lor arm} -body {
+ expr 2***3||4.0
+} -returnCodes error -match glob -result *
+test compExpr-old-4.7 {CompileLorExpr: error compiling lor arm} -body {
+ expr 1.3||2***3
+} -returnCodes error -match glob -result *
test compExpr-old-4.8 {CompileLorExpr: error compiling lor arms} {
list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -253,21 +248,18 @@ test compExpr-old-4.9 {CompileLorExpr: long lor arm} {
test compExpr-old-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
test compExpr-old-5.2 {CompileLandExpr: error in bitor expr} -body {
- catch {expr x|3} msg
- set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*}
+ expr x|3
+} -returnCodes error -match glob -result *
test compExpr-old-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
test compExpr-old-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
test compExpr-old-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
test compExpr-old-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
-test compExpr-old-5.7 {CompileLandExpr: error compiling land arm} {
- catch {expr 2***3&&4.0} msg
- set msg
-} {syntax error in expression "2***3&&4.0": unexpected operator *}
-test compExpr-old-5.8 {CompileLandExpr: error compiling land arm} {
- catch {expr 1.3&&2***3} msg
- set msg
-} {syntax error in expression "1.3&&2***3": unexpected operator *}
+test compExpr-old-5.7 {CompileLandExpr: error compiling land arm} -body {
+ expr 2***3&&4.0
+} -returnCodes error -match glob -result *
+test compExpr-old-5.8 {CompileLandExpr: error compiling land arm} -body {
+ expr 1.3&&2***3
+} -returnCodes error -match glob -result *
test compExpr-old-5.9 {CompileLandExpr: error compiling land arm} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -279,21 +271,18 @@ test compExpr-old-5.10 {CompileLandExpr: long land arms} {
test compExpr-old-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
test compExpr-old-6.2 {CompileBitXorExpr: error in bitand expr} -body {
- catch {expr x|3} msg
- set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*}
+ expr x|3
+} -returnCodes error -match glob -result *
test compExpr-old-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
test compExpr-old-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
test compExpr-old-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
test compExpr-old-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
-test compExpr-old-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
- catch {expr 2***3|6} msg
- set msg
-} {syntax error in expression "2***3|6": unexpected operator *}
+test compExpr-old-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body {
+ expr 2***3|6
+} -returnCodes error -match glob -result *
test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
- catch {expr 2^x} msg
- set msg
-} -match glob -result {syntax error in expression "2^x": * preceding $*}
+ expr 2^x
+} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value as operand of "^"}}
@@ -306,21 +295,18 @@ test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body {
- catch {expr x==3} msg
- set msg
-} -match glob -result {syntax error in expression "x==3": * preceding $*}
+ expr x==3
+} -returnCodes error -match glob -result *
test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
-test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} {
- catch {expr 2***3&6} msg
- set msg
-} {syntax error in expression "2***3&6": unexpected operator *}
+test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
+ expr 2***3&6
+} -returnCodes error -match glob -result *
test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
- catch {expr 2&x} msg
- set msg
-} -match glob -result {syntax error in expression "2&x": * preceding $*}
+ expr 2&x
+} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value as operand of "&"}}
@@ -333,21 +319,18 @@ test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1}
test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body {
- catch {expr x>3} msg
- set msg
-} -match glob -result {syntax error in expression "x>3": * preceding $*}
+ expr x>3
+} -returnCodes error -match glob -result *
test compExpr-old-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
test compExpr-old-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
test compExpr-old-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
test compExpr-old-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
-test compExpr-old-8.10 {CompileEqualityExpr: error compiling equality arm} {
- catch {expr 2***3==6} msg
- set msg
-} {syntax error in expression "2***3==6": unexpected operator *}
+test compExpr-old-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
+ expr 2***3==6
+} -returnCodes error -match glob -result *
test compExpr-old-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
- catch {expr 2!=x} msg
- set msg
-} -match glob -result {syntax error in expression "2!=x": * preceding $*}
+ expr 2!=x
+} -returnCodes error -match glob -result *
test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
@@ -358,50 +341,40 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
- expr {1<<63}
+ expr {int(1<<63)}
} -9223372036854775808
-
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
- expr {1<<31}
+ expr {int(1<<31)}
} -2147483648
test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
- catch {expr x>>3} msg
- set msg
-} -match glob -result {syntax error in expression "x>>3": * preceding $*}
+ expr x>>3
+} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
-test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} {
- catch {expr 2***3>6} msg
- set msg
-} {syntax error in expression "2***3>6": unexpected operator *}
+test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
+ expr 2***3>6
+} -returnCodes error -match glob -result *
test compExpr-old-9.10 {CompileRelationalExpr: error compiling relational arm} -body {
- catch {expr 2<x} msg
- set msg
-} -match glob -result {syntax error in expression "2<x": * preceding $*}
+ expr 2<x
+} -returnCodes error -match glob -result *
test compExpr-old-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
test compExpr-old-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
test compExpr-old-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0o123} -82
test compExpr-old-10.5 {CompileShiftExpr: error in add expr} -body {
- catch {expr x+3} msg
- set msg
-} -match glob -result {syntax error in expression "x+3": * preceding $*}
+ expr x+3
+} -returnCodes error -match glob -result *
test compExpr-old-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
test compExpr-old-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
-test compExpr-old-10.8 {CompileShiftExpr: error compiling shift arm} {
- catch {expr 2***3>>6} msg
- set msg
-} {syntax error in expression "2***3>>6": unexpected operator *}
+test compExpr-old-10.8 {CompileShiftExpr: error compiling shift arm} -body {
+ expr 2***3>>6
+} -returnCodes error -match glob -result *
test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
- catch {expr 2<<x} msg
- set msg
-} -match glob -result {syntax error in expression "2<<x": * preceding $*}
+ expr 2<<x
+} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value as operand of ">>"}}
@@ -412,21 +385,18 @@ test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
- catch {expr x*3} msg
- set msg
-} -match glob -result {syntax error in expression "x*3": * preceding $*}
+ expr x*3
+} -returnCodes error -match glob -result *
test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
-test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} {
- catch {expr 2***3+6} msg
- set msg
-} {syntax error in expression "2***3+6": unexpected operator *}
+test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body {
+ expr 2***3+6
+} -returnCodes error -match glob -result *
test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
- catch {expr 2-x} msg
- set msg
-} -match glob -result {syntax error in expression "2-x": * preceding $*}
+ expr 2-x
+} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}
@@ -448,19 +418,16 @@ test compExpr-old-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
test compExpr-old-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
test compExpr-old-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
test compExpr-old-12.5 {CompileMultiplyExpr: error in unary expr} -body {
- catch {expr ~x} msg
- set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
+ expr ~x
+} -returnCodes error -match glob -result *
test compExpr-old-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
test compExpr-old-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
-test compExpr-old-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
- catch {expr 2*3%%6} msg
- set msg
-} {syntax error in expression "2*3%%6": unexpected operator %}
+test compExpr-old-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body {
+ expr 2*3%%6
+} -returnCodes error -match glob -result *
test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
- catch {expr 2*x} msg
- set msg
-} -match glob -result {syntax error in expression "2*x": * preceding $*}
+ expr 2*x
+} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "*"}}
@@ -469,20 +436,19 @@ test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
} {1 {can't use non-numeric string as operand of "/"}}
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
- catch {expr ~x} msg
- set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
-test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} {
- catch {expr !1.x} msg
+ expr ~x
+} -returnCodes error -match glob -result *
+test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
+ expr !1.x
set msg
-} {syntax error in expression "!1.x": extra tokens at end of expression}
+} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "~"}}
@@ -505,7 +471,7 @@ test compExpr-old-13.16 {CompileUnaryExpr: error in primary expr} {
test compExpr-old-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
test compExpr-old-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
test compExpr-old-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8
test compExpr-old-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
test compExpr-old-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
@@ -543,14 +509,11 @@ test compExpr-old-14.15 {CompilePrimaryExpr: var reference primary} {
set msg
} 123.2
test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
- catch {expr {$a(foo}} msg
- set errorInfo
-} -match glob -result {missing )
- while *ing
-"expr {$a(foo}"}
-test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+ expr {$a(foo}
+} -returnCodes error -match glob -result *
+test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body {
expr $
-} $
+} -returnCodes error -match glob -result *
test compExpr-old-14.18 {CompilePrimaryExpr: quoted string primary} {
expr "21"
} 21
@@ -573,16 +536,13 @@ test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} {
} 123
test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
- catch {expr {[set i}} msg
- set errorInfo
-} -match glob -result {missing close-bracket
- while *ing
-"expr {\[set i}"}
+ expr {[set i}
+} -returnCodes error -match glob -result *
test compExpr-old-14.25 {CompilePrimaryExpr: math function primary} {
format %.6g [expr exp(1.0)]
} 2.71828
@@ -590,73 +550,58 @@ test compExpr-old-14.26 {CompilePrimaryExpr: math function primary} {
format %.6g [expr pow(2.0+0.1,3.0+0.1)]
} 9.97424
test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} -body {
- catch {expr sinh::(2.0)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sinh::(2.0)": * function arguments*
- while *ing
-"expr sinh::(2.0)"}
+ expr sinh::(2.0)
+} -returnCodes error -match glob -result *
test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
} 14
test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
- catch {expr 2+(3*(4+5)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
- while *ing
-"expr 2+(3*(4+5)"}
+ expr 2+(3*(4+5)
+} -returnCodes error -match glob -result *
test compExpr-old-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
} {{15 == 15} {15 == 15} {15 == 15}}
test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} -body {
- catch {expr @} msg
- set errorInfo
-} -match glob -result {syntax error in expression "@": character not legal in expressions
- while *ing
-"expr @"}
+ expr @
+} -returnCodes error -match glob -result *
test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} -body {
- catch {expr sinh2.0)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sinh2.0)": * preceding $*
- while *ing
-"expr sinh2.0)"}
+ expr sinh2.0)
+} -returnCodes error -match glob -result *
test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {* "*whazzathuh"
while *ing
"expr whazzathuh(1)"}
test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too many arguments for math function*
while *ing
"expr sin(1,2,3)"}
test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr sin()"}
test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
- catch {expr sin(1} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
- while *ing
-"expr sin(1"}
+ expr sin(1
+} -returnCodes error -match glob -result *
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
expr 2*T1()
} 246
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 42e5cd5..14c875d 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -1,51 +1,55 @@
-# 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.9 2005/05/10 18:35:17 kennykb 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 {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::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 {
testConstraint testmathfunctions 1
}
-catch {unset a}
+# Constrain memory leak tests
+testConstraint memory [llength [info commands memory]]
+catch {unset a}
+
test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
expr 1+2
} 3
-test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} {
- list [catch {expr 1+2+} msg] $msg
-} {1 {syntax error in expression "1+2+": premature end of expression}}
+test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body {
+ expr 1+2+
+} -returnCodes error -match glob -result *
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 {000123}
+ 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
-test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} {
- list [catch {expr {"00[expr 1+]" + 17}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+} -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 *
test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} {
expr {{12345}}
} 12345
@@ -62,33 +66,36 @@ test compExpr-2.6 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
expr {[]}
} {}
-test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} {
- list [catch {expr {[foo "bar"xxx] + 17}} msg] $msg
-} {1 {extra characters after close-quote}}
-test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
- catch {unset a}
+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} -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
@@ -146,143 +153,162 @@ 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
-test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
- list [catch {expr {+[expr 1+]}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+ expr {+[expr 1+]}
+} -returnCodes error -match glob -result *
test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
expr {4+2}
} 6
-test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
- list [catch {expr {[expr 1+]+5}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
-test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
- list [catch {expr {5+[expr 1+]}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+ expr {[expr 1+]+5}
+} -returnCodes error -match glob -result *
+test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+ expr {5+[expr 1+]}
+} -returnCodes error -match glob -result *
test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
expr {-2}
} -2
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
-test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} {
- list [catch {expr {[expr *2]||0}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} {
- catch {unset a}
- catch {unset b}
+} -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} -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
-test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} {
- list [catch {expr {0||[expr %2]}} msg] $msg
-} {1 {syntax error in expression "%2": unexpected operator %}}
+} -result 0
+test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body {
+ expr {0||[expr %2]}
+} -returnCodes error -match glob -result *
test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
set a "abcdefghijkl"
set i 7
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
-test compExpr-4.3 {CompileCondExpr procedure, error in test} {
- list [catch {expr {[expr *2]? +1 : -1}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
- catch {unset a}
+} -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} -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
-test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} {
- list [catch {expr {1? [expr *2] : -127}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
- catch {unset a}
+} -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} -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}
- set a 00123
+} -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}
@@ -291,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
@@ -300,27 +326,71 @@ 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
-test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} {
- list [catch {expr {sinh(2.*)}} msg] $msg
-} {1 {syntax error in expression "sinh(2.*)": unexpected close parenthesis}}
+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} {
- list [catch {expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3} msg] $msg
-} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": extra tokens at end of expression}}
+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
+} -returnCodes error -match glob -result *
+test compExpr-7.1 {Memory Leak} -constraints memory -setup {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ lindex $lines 3 3
+ }
+} -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ interp create slave
+ slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
+ interp delete slave
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ unset end i tmp
+ rename getbytes {}
+} -result 0
+
+test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setup {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ lindex $lines 3 3
+ }
+} -body {
+ set i 5
+ set end [getbytes]
+ while {[incr i -1]} {
+ expr ${i}000
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ 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 1c774c4..2852bf2 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.38 2005/05/10 18:35:18 kennykb 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,65 @@ 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-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
+ -setup {
+ namespace eval catchtest {
+ variable options1 {}
+ }
+ trace add variable catchtest::options1 write catchtest::failtrace
+ proc catchtest::failtrace {n1 n2 op} {
+ return -code error "trace on $n1 fails by request"
+ }
+ }
+ -body {
+ proc catchtest::x {} {
+ variable options1
+ 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 "options1": trace on options1 fails by request}}
+ -cleanup {namespace delete catchtest}
+}
test compile-4.1 {TclCompileForCmd: command substituted test expression} {
set i 0
@@ -157,29 +225,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 +258,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 +299,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?}}
-test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; string index a 09 }
- list [catch {p} msg] $msg
-} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like 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 }
- list [catch {p} msg] $msg
-} {1 {can't read "foo": no such variable}}
-test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; incr foo bogus }
- list [catch {p} msg] $msg
-} {1 {expected integer but got "bogus"}}
+ }}
+} -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 {
+ 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 }
- list [catch {p} msg] $msg
-} -match glob -result {1 {syntax error in expression "!a": * preceding $*}}
+ 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} }
- list [catch {p} msg] $msg
-} -match glob -result {1 {syntax error in expression "!a": * preceding $*}}
-test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
- proc p {} { set r [list foobar] ; llength "\{" }
+ apply {{} { set r [list foobar] ; expr {!a} }}
+} -returnCodes error -match glob -result *
+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 {
@@ -296,10 +359,11 @@ test compile-12.1 {testing literal leak on interp delete} -setup {
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
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} {
@@ -320,33 +384,32 @@ test compile-12.3 {check for a buffer overrun} -body {
crash
} -returnCodes error -cleanup {
rename crash {}
-} -match glob -result {syntax error in expression "a+2": * preceding $*}
+} -match glob -result *
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 {
@@ -380,9 +443,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} {
@@ -393,8 +455,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
@@ -403,34 +465,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} {
@@ -444,124 +491,103 @@ if $noComp {
}
test compile-16.1.$noComp {TclCompileScript: word expansion} $constraints {
- run "list [string repeat {{expand}a } 255]"
+ run "list [string repeat {{*}a } 255]"
} [lrepeat 255 a]
-
test compile-16.2.$noComp {TclCompileScript: word expansion} $constraints {
- run "list [string repeat {{expand}a } 256]"
+ run "list [string repeat {{*}a } 256]"
} [lrepeat 256 a]
-
test compile-16.3.$noComp {TclCompileScript: word expansion} $constraints {
- run "list [string repeat {{expand}a } 257]"
+ run "list [string repeat {{*}a } 257]"
} [lrepeat 257 a]
-
test compile-16.4.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list}
+ run {{*}list}
} {}
-
test compile-16.5.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list {expand}{x y z}}
+ run {{*}list {*}{x y z}}
} {x y z}
-
test compile-16.6.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list {expand}[list x y z]}
+ run {{*}list {*}[list x y z]}
} {x y z}
-
test compile-16.7.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list {expand}[list x y z][list x y z]}
+ run {{*}list {*}[list x y z][list x y z]}
} {x y zx y z}
-
test compile-16.8.$noComp {TclCompileScript: word expansion} -body {
set l {x y z}
- run {{expand}list {expand}$l}
+ run {{*}list {*}$l}
} -constraints $constraints -cleanup {
unset l
} -result {x y z}
-
test compile-16.9.$noComp {TclCompileScript: word expansion} -body {
set l {x y z}
- run {{expand}list {expand}$l$l}
+ run {{*}list {*}$l$l}
} -constraints $constraints -cleanup {
unset l
} -result {x y zx y z}
-
test compile-16.10.$noComp {TclCompileScript: word expansion} -body {
- run {{expand}\{}
+ run {{*}\{}
} -constraints $constraints -returnCodes error \
-result {unmatched open brace in list}
-
test compile-16.11.$noComp {TclCompileScript: word expansion} -body {
proc badList {} {return \{}
- run {{expand}[badList]}
+ run {{*}[badList]}
} -constraints $constraints -cleanup {
rename badList {}
} -returnCodes error -result {unmatched open brace in list}
-
test compile-16.12.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list x y z}
+ run {{*}list x y z}
} {x y z}
-
test compile-16.13.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list x y {expand}z}
+ run {{*}list x y {*}z}
} {x y z}
-
test compile-16.14.$noComp {TclCompileScript: word expansion} $constraints {
- run {{expand}list x {expand}y z}
+ run {{*}list x {*}y z}
} {x y z}
-
test compile-16.15.$noComp {TclCompileScript: word expansion} $constraints {
- run {list x y {expand}z}
+ run {list x y {*}z}
} {x y z}
-
test compile-16.16.$noComp {TclCompileScript: word expansion} $constraints {
- run {list x {expand}y z}
+ run {list x {*}y z}
} {x y z}
-
test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints {
- run {list {expand}x y z}
+ 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]}
- llength [run "list [string repeat {{expand}[LongList] } [expr {1<<10}]]"]
+ llength [run "list [string repeat {{*}[LongList] } [expr {1<<10}]]"]
} -constraints [linsert $constraints 0 knownBug] -cleanup {
rename LongList {}
} -returnCodes ok -result [expr {1<<20}]
-
test compile-16.19.$noComp {TclCompileScript: word expansion} -body {
proc LongList {} {return [lrepeat [expr {1<<11}] x]}
- llength [run "list [string repeat {{expand}[LongList] } [expr {1<<11}]]"]
+ llength [run "list [string repeat {{*}[LongList] } [expr {1<<11}]]"]
} -constraints [linsert $constraints 0 knownBug] -cleanup {
rename LongList {}
} -returnCodes ok -result [expr {1<<22}]
-
test compile-16.20.$noComp {TclCompileScript: word expansion} -body {
proc LongList {} {return [lrepeat [expr {1<<12}] x]}
- llength [run "list [string repeat {{expand}[LongList] } [expr {1<<12}]]"]
+ llength [run "list [string repeat {{*}[LongList] } [expr {1<<12}]]"]
} -constraints [linsert $constraints 0 knownBug] -cleanup {
rename LongList {}
} -returnCodes ok -result [expr {1<<24}]
-
# This is the one that should cause overflow
test compile-16.21.$noComp {TclCompileScript: word expansion} -body {
proc LongList {} {return [lrepeat [expr {1<<16}] x]}
- llength [run "list [string repeat {{expand}[LongList] } [expr {1<<16}]]"]
+ llength [run "list [string repeat {{*}[LongList] } [expr {1<<16}]]"]
} -constraints [linsert $constraints 0 knownBug] -cleanup {
rename LongList {}
} -returnCodes ok -result [expr {wide(1)<<32}]
-
test compile-16.22.$noComp {
Bug 845412: TclCompileScript: word expansion not mandatory
} -body {
@@ -571,7 +597,6 @@ test compile-16.22.$noComp {
} -constraints $constraints -cleanup {
rename ReturnResults {}
} -returnCodes ok -result [string trim [string repeat {x } 260]]
-
test compile-16.23.$noComp {
Bug 1032805: defer parse error until run time
} -constraints $constraints -body {
@@ -584,11 +609,22 @@ test compile-16.23.$noComp {
} -cleanup {
namespace delete x
} -returnCodes ok -result {syntax {}{}}
-
+test compile-16.24.$noComp {
+ Bug 1638414: bad list constant as first expanded term
+} -constraints $constraints -body {
+ run "{*}\"\{foo bar\""
+} -returnCodes error -result {unmatched open brace in list}
+test compile-16.25.$noComp {TclCompileScript: word expansion, naked backslashes} $constraints {
+ run {list {*}{a \n b}}
+} {a {
+} b}
+test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslashes} $constraints {
+ run {list {*}{a {\n} b}}
+} {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 {
@@ -618,6 +654,161 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
interp delete $i
} -result substituted
+# This tests the supported parts of the unsupported [disassemble] command. It
+# does not check the format of disassembled bytecode though; that's liable to
+# change without warning.
+
+test compile-18.1 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble
+} -match glob -result {wrong # args: should be "*"}
+test compile-18.2 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble ?
+} -match glob -result {bad type "?": must be *}
+test compile-18.3 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble lambda
+} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
+test compile-18.4 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble lambda \{
+} -result "can't interpret \"\{\" as a lambda expression"
+test compile-18.5 {disassembler - basics} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble lambda {{} {}}
+} -match glob -result *
+test compile-18.6 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble proc
+} -match glob -result {wrong # args: should be "* proc procName"}
+test compile-18.7 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble proc nosuchproc
+} -result {"nosuchproc" isn't a procedure}
+test compile-18.8 {disassembler - basics} -setup {
+ proc chewonthis {} {}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble proc chewonthis
+} -cleanup {
+ rename chewonthis {}
+} -match glob -result *
+test compile-18.9 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble script
+} -match glob -result {wrong # args: should be "* script script"}
+test compile-18.10 {disassembler - basics} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble script {}
+} -match glob -result *
+test compile-18.11 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method
+} -match glob -result {wrong # args: should be "* method className methodName"}
+test compile-18.12 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method nosuchclass foo
+} -result {nosuchclass does not refer to an object}
+test compile-18.13 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble method justanobject foo
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.14 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.15 {disassembler - basics} -setup {
+ oo::class create foo {method bar {} {}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble method foo bar
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.16 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod
+} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
+test compile-18.17 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod nosuchobject foo
+} -result {nosuchobject does not refer to an object}
+test compile-18.18 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.19 {disassembler - basics} -setup {
+ oo::object create foo
+ oo::objdefine foo {method bar {} {}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble objmethod foo bar
+} -cleanup {
+ foo destroy
+} -match glob -result *
+
+test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
+ # This will panic in a --enable-symbols=compile build, unless bug is fixed.
+ apply {{} {list [if 1]}}
+} -returnCodes error -match glob -result *
+
+test compile-20.1 {ensure there are no infinite loops in optimizing} {
+ tcl::unsupported::disassemble script {
+ while 1 {
+ return -code continue -level 0
+ }
+ }
+ return
+} {}
+test compile-20.2 {ensure there are no infinite loops in optimizing} {
+ tcl::unsupported::disassemble script {
+ while 1 {
+ while 1 {
+ return -code break -level 0
+ }
+ }
+ }
+ return
+} {}
+
+test compile-21.1 {stack balance management} {
+ apply {{} {
+ set result {}
+ while 1 {
+ lappend result a
+ lappend result [list b [break]]
+ lappend result c
+ }
+ return $result
+ }}
+} a
+test compile-21.2 {stack balance management} {
+ apply {{} {
+ set result {}
+ while {[incr i] <= 10} {
+ lappend result $i
+ lappend result [list b [continue] c]
+ lappend result c
+ }
+ return $result
+ }}
+} {1 2 3 4 5 6 7 8 9 10}
+test compile-21.3 {stack balance management} {
+ apply {args {
+ set result {}
+ while 1 {
+ lappend result a
+ lappend result [concat {*}$args [break]]
+ lappend result c
+ }
+ return $result
+ }} P Q R S T
+} a
+test compile-21.4 {stack balance management} {
+ apply {args {
+ set result {}
+ while {[incr i] <= 10} {
+ lappend result $i
+ lappend result [concat {*}$args [continue] c]
+ lappend result c
+ }
+ return $result
+ }} P Q R S T
+} {1 2 3 4 5 6 7 8 9 10}
+
+# TODO sometime - check that bytecode from tbcload is *not* disassembled.
+
# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
@@ -626,3 +817,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 2023d9c..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.4 2004/10/29 15:39:10 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -35,7 +33,7 @@ test pkgconfig-1.3 {query value multiple times} {
test pkgconfig-2.0 {error: missing subcommand} {
catch {::tcl::pkgconfig} msg
set msg
-} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
test pkgconfig-2.1 {error: illegal subcommand} {
catch {::tcl::pkgconfig foo} msg
set msg
@@ -55,7 +53,7 @@ test pkgconfig-2.4 {error: query unknown key} {
test pkgconfig-2.5 {error: query with to many arguments} {
catch {::tcl::pkgconfig get foo bar} msg
set msg
-} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/coroutine.test b/tests/coroutine.test
new file mode 100644
index 0000000..05b58c9
--- /dev/null
+++ b/tests/coroutine.test
@@ -0,0 +1,739 @@
+# Commands covered: coroutine, yield, yieldto, [info coroutine]
+#
+# This file contains a collection of tests for experimental commands that are
+# found in ::tcl::unsupported. The tests will migrate to normal test files
+# if/when the commands find their way into the core.
+#
+# Copyright (c) 2008 by Miguel Sofer.
+#
+# 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
+ 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]]
+
+set lambda [list {{start 0} {stop 10}} {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ yield [expr {$i*$stop}]
+ incr i
+ }
+}]
+
+test coroutine-1.1 {coroutine basic} -setup {
+ coroutine foo ::apply $lambda
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [foo]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {0 10 20}
+test coroutine-1.2 {coroutine basic} -setup {
+ coroutine foo ::apply $lambda 2 8
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [foo]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {16 24 32}
+test coroutine-1.3 {yield returns new arg} -setup {
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ set stop [yield [expr {$i*$stop}]]
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 2} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [foo $k]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {20 6 12}
+test coroutine-1.4 {yield in nested proc} -setup {
+ proc moo {} {
+ upvar 1 i i stop stop
+ yield [expr {$i*$stop}]
+ }
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ moo
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [foo $k]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ rename moo {}
+ unset body res
+} -result {0 10 20}
+test coroutine-1.5 {just yield} -body {
+ coroutine foo yield
+ list [foo] [catch foo msg] $msg
+} -cleanup {
+ unset msg
+} -result {{} 1 {invalid command name "foo"}}
+test coroutine-1.6 {just yield} -body {
+ coroutine foo [list yield]
+ list [foo] [catch foo msg] $msg
+} -cleanup {
+ unset msg
+} -result {{} 1 {invalid command name "foo"}}
+test coroutine-1.7 {yield in nested uplevel} -setup {
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ uplevel 0 [list yield [expr {$i*$stop}]]
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [eval foo $k]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ unset body res
+} -result {0 10 20}
+test coroutine-1.8 {yield in nested uplevel} -setup {
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ uplevel 0 yield [expr {$i*$stop}]
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [eval foo $k]
+ }
+ set res
+} -cleanup {
+ rename foo {}
+ unset body res
+} -result {0 10 20}
+test coroutine-1.9 {yield in nested eval} -setup {
+ proc moo {} {
+ upvar 1 i i stop stop
+ yield [expr {$i*$stop}]
+ }
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ eval moo
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [foo $k]
+ }
+ set res
+} -cleanup {
+ rename moo {}
+ unset body res
+} -result {0 10 20}
+test coroutine-1.10 {yield in nested eval} -setup {
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ eval yield [expr {$i*$stop}]
+ incr i
+ }
+ }
+ coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+ set res {}
+} -body {
+ for {set k 1} {$k < 4} {incr k} {
+ lappend res [eval foo $k]
+ }
+ set res
+} -cleanup {
+ unset body res
+} -result {0 10 20}
+test coroutine-1.11 {yield outside coroutine} -setup {
+ proc moo {} {
+ upvar 1 i i stop stop
+ yield [expr {$i*$stop}]
+ }
+} -body {
+ variable i 5 stop 6
+ moo
+} -cleanup {
+ rename moo {}
+ unset i stop
+} -returnCodes error -result {yield can only be called in a coroutine}
+test coroutine-1.12 {proc as coroutine} -setup {
+ set body {
+ # init
+ set i $start
+ set imax $stop
+ yield
+ while {$i < $imax} {
+ uplevel 0 [list yield [expr {$i*$stop}]]
+ incr i
+ }
+ }
+ proc moo {{start 0} {stop 10}} $body
+ coroutine foo moo 2 8
+} -body {
+ list [foo] [foo]
+} -cleanup {
+ unset body
+ rename moo {}
+ rename foo {}
+} -result {16 24}
+test coroutine-1.13 {subst as coroutine: literal} {
+ list [coroutine foo eval {subst {>>[yield a],[yield b]<<}}] [foo x] [foo y]
+} {a b >>x,y<<}
+test coroutine-1.14 {subst as coroutine: in variable} {
+ set pattern {>>[yield c],[yield d]<<}
+ list [coroutine foo eval {subst $pattern}] [foo p] [foo q]
+} {c d >>p,q<<}
+
+test coroutine-2.1 {self deletion on return} -body {
+ coroutine foo set x 3
+ foo
+} -returnCodes error -result {invalid command name "foo"}
+test coroutine-2.2 {self deletion on return} -body {
+ coroutine foo ::apply [list {} {yield; yield 1; return 2}]
+ list [foo] [foo] [catch foo msg] $msg
+} -result {1 2 1 {invalid command name "foo"}}
+test coroutine-2.3 {self deletion on error return} -body {
+ coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
+ list [foo] [catch foo msg] $msg [catch foo msg] $msg
+} -result {1 1 ouch! 1 {invalid command name "foo"}}
+test coroutine-2.4 {self deletion on other return} -body {
+ coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
+ list [foo] [catch foo msg] $msg [catch foo msg] $msg
+} -result {1 100 ouch! 1 {invalid command name "foo"}}
+test coroutine-2.5 {deletion of suspended coroutine} -body {
+ coroutine foo ::apply [list {} {yield; yield 1; return 2}]
+ list [foo] [rename foo {}] [catch foo msg] $msg
+} -result {1 {} 1 {invalid command name "foo"}}
+test coroutine-2.6 {deletion of running coroutine} -body {
+ coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
+ list [foo] [catch foo msg] $msg
+} -result {1 1 {invalid command name "foo"}}
+
+test coroutine-3.1 {info level computation} -setup {
+ proc a {} {while 1 {yield [info level]}}
+ proc b {} foo
+} -body {
+ # note that coroutines execute in uplevel #0
+ set l0 [coroutine foo a]
+ set l1 [foo]
+ set l2 [b]
+ list $l0 $l1 $l2
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result {1 1 1}
+test coroutine-3.2 {info frame computation} -setup {
+ proc a {} {while 1 {yield [info frame]}}
+ proc b {} foo
+} -body {
+ set l0 [coroutine foo a]
+ set l1 [foo]
+ set l2 [b]
+ expr {$l2 - $l1}
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result 1
+test coroutine-3.3 {info coroutine} -setup {
+ proc a {} {info coroutine}
+ proc b {} a
+} -body {
+ b
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result {}
+test coroutine-3.4 {info coroutine} -setup {
+ proc a {} {info coroutine}
+ proc b {} a
+} -body {
+ coroutine foo b
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result ::foo
+test coroutine-3.5 {info coroutine} -setup {
+ proc a {} {info coroutine}
+ proc b {} {rename [info coroutine] {}; a}
+} -body {
+ coroutine foo b
+} -cleanup {
+ rename a {}
+ rename b {}
+} -result {}
+test coroutine-3.6 {info frame, bug #2910094} -setup {
+ proc stack {} {
+ set res [list "LEVEL:[set lev [info frame]]"]
+ for {set i 1} {$i < $lev} {incr i} {
+ lappend res [info frame $i]
+ }
+ set res
+ # the precise command depends on line numbers and such, is likely not
+ # to be stable: just check that the test completes!
+ return
+ }
+ proc a {} stack
+} -body {
+ coroutine aa a
+} -cleanup {
+ rename stack {}
+ rename a {}
+} -result {}
+test coroutine-3.7 {bug 0b874c344d} {
+ dict get [coroutine X coroutine Y info frame 0] cmd
+} {coroutine X coroutine Y info frame 0}
+
+test coroutine-4.1 {bug #2093188} -setup {
+ proc foo {} {
+ set v 1
+ trace add variable v {write unset} bar
+ yield
+ set v 2
+ yield
+ set v 3
+ }
+ proc bar args {lappend ::res $args}
+ coroutine a foo
+} -body {
+ list [a] [a] $::res
+} -cleanup {
+ rename foo {}
+ rename bar {}
+ unset ::res
+} -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
+test coroutine-4.2 {bug #2093188} -setup {
+ proc foo {} {
+ set v 1
+ trace add variable v {read unset} bar
+ yield
+ set v 2
+ set v
+ yield
+ set v 3
+ }
+ proc bar args {lappend ::res $args}
+ coroutine a foo
+} -body {
+ list [a] [a] $::res
+} -cleanup {
+ rename foo {}
+ rename bar {}
+ unset ::res
+} -result {{} 3 {{v {} read} {v {} unset}}}
+
+test coroutine-4.3 {bug #2093947} -setup {
+ proc foo {} {
+ set v 1
+ trace add variable v {write unset} bar
+ yield
+ set v 2
+ yield
+ set v 3
+ }
+ proc bar args {lappend ::res $args}
+} -body {
+ coroutine a foo
+ a
+ a
+ coroutine a foo
+ a
+ rename a {}
+ set ::res
+} -cleanup {
+ rename foo {}
+ rename bar {}
+ unset ::res
+} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}
+
+test coroutine-4.4 {bug #2917627: cmd resolution} -setup {
+ proc a {} {return global}
+ namespace eval b {proc a {} {return local}}
+} -body {
+ namespace eval b {coroutine foo a}
+} -cleanup {
+ rename a {}
+ namespace delete b
+} -result local
+
+test coroutine-4.5 {bug #2724403} -constraints {memory} \
+-setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set ns ::y$i
+ namespace eval $ns {}
+ proc ${ns}::start {} {yield; puts hello}
+ coroutine ${ns}::run ${ns}::start
+ namespace delete $ns
+ set start $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $start}]
+} -cleanup {
+ rename getbytes {}
+ unset i ns start end
+} -result 0
+
+test coroutine-4.6 {compile context, bug #3282869} -setup {
+ unset -nocomplain ::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 {}}} {
+ yield $val
+ }
+ proc getNumLevel {} {
+ # remove the level for this proc's call
+ expr {[lindex [testnrelevels] 1] - 1}
+ }
+ proc relativeLevel base {
+ # remove the level for this proc's call
+ expr {[getNumLevel] - $base - 1}
+ }
+ proc foo {} {
+ while 1 {
+ nestedYield
+ }
+ }
+ set res {}
+} -body {
+ set base [getNumLevel]
+ lappend res [relativeLevel $base]
+ eval {coroutine a foo}
+ # back to base level
+ lappend res [relativeLevel $base]
+ a
+ lappend res [relativeLevel $base]
+ eval a
+ lappend res [relativeLevel $base]
+ eval {eval a}
+ lappend res [relativeLevel $base]
+ rename a {}
+ lappend res [relativeLevel $base]
+ set res
+} -cleanup {
+ rename foo {}
+ rename nestedYield {}
+ rename getNumLevel {}
+ rename relativeLevel {}
+ unset res
+} -result {0 0 0 0 0 0}
+test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
+-setup {
+ proc nestedYield {{val {}}} {
+ yield $val
+ }
+ proc getNumLevel {} {
+ # remove the level for this proc's call
+ expr {[lindex [testnrelevels] 1] - 1}
+ }
+ proc relativeLevel base {
+ # remove the level for this proc's call
+ expr {[getNumLevel] - $base - 1}
+ }
+ proc foo base {
+ while 1 {
+ set base [nestedYield [relativeLevel $base]]
+ }
+ }
+ set res {}
+} -body {
+ lappend res [eval {coroutine a foo [getNumLevel]}]
+ lappend res [a [getNumLevel]]
+ lappend res [eval {a [getNumLevel]}]
+ lappend res [eval {eval {a [getNumLevel]}}]
+ set base [lindex $res 0]
+ foreach x $res[set res {}] {
+ lappend res [expr {$x-$base}]
+ }
+ set res
+} -cleanup {
+ rename a {}
+ rename foo {}
+ rename nestedYield {}
+ rename getNumLevel {}
+ rename relativeLevel {}
+ unset res
+} -result {0 0 0 0}
+
+test coroutine-6.1 {coroutine nargs} -body {
+ coroutine a ::apply $lambda
+ a
+} -cleanup {
+ rename a {}
+} -result 0
+test coroutine-6.2 {coroutine nargs} -body {
+ coroutine a ::apply $lambda
+ a a
+} -cleanup {
+ rename a {}
+} -result 0
+test coroutine-6.3 {coroutine nargs} -body {
+ coroutine a ::apply $lambda
+ a a a
+} -cleanup {
+ rename a {}
+} -returnCodes error -result {wrong # args: should be "a ?arg?"}
+
+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 [yieldto return -level 0 $a]
+ lappend a [llength $a]
+ }
+ }
+ coroutine a corobody
+ coroutine b corobody
+ list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
+ [b ok] [rename b {}]
+} -cleanup {
+ rename corobody {}
+} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
+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 {
+ catch {rename juggler ""}
+} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
+test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
+ proc foo {a b} {catch yield; return 1}
+} -cleanup {
+ rename foo {}
+} -body {
+ coroutine demo lsort -command foo {a b}
+} -result {b a}
+test coroutine-7.5 {return codes} {
+ set result {}
+ foreach code {0 1 2 3 4 5} {
+ lappend result [catch {coroutine demo return -level 0 -code $code}]
+ }
+ set result
+} {0 1 2 3 4 5}
+test coroutine-7.6 {Early yield crashes} {
+ proc foo args {}
+ trace add execution foo enter {catch yield}
+ coroutine demo foo
+ rename foo {}
+} {}
+test coroutine-7.7 {Bug 2486550} -setup {
+ interp hide {} yield
+} -body {
+ coroutine demo interp invokehidden {} yield ok
+} -cleanup {
+ demo
+ interp expose {} yield
+} -result ok
+test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
+ namespace eval cotest {}
+ set ::result ""
+} -body {
+ proc cotest::body {} {
+ lappend ::result a
+ yield OUT
+ lappend ::result b
+ yieldto ::return -level 0 123
+ lappend ::result c
+ return
+ }
+ lappend ::result [coroutine cotest cotest::body]
+ namespace delete cotest
+ namespace eval cotest {}
+ lappend ::result [cotest]
+ cotest
+ return $result
+} -returnCodes error -cleanup {
+ catch {namespace delete ::cotest}
+ catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
+ namespace eval cotest {}
+ set ::result ""
+} -body {
+ proc cotest::body {} {
+ set y ::yieldto
+ lappend ::result a
+ yield OUT
+ lappend ::result b
+ $y ::return -level 0 123
+ lappend ::result c
+ return
+ }
+ lappend ::result [coroutine cotest cotest::body]
+ namespace delete cotest
+ namespace eval cotest {}
+ lappend ::result [cotest]
+ cotest
+ return $result
+} -returnCodes error -cleanup {
+ catch {namespace delete ::cotest}
+ catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
+ namespace eval cotest {}
+ set ::result ""
+} -body {
+ proc cotest::body {} {
+ lappend ::result a
+ yield OUT
+ lappend ::result b
+ yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
+ lappend ::result c
+ return
+ }
+ lappend ::result [coroutine cotest cotest::body]
+ lappend ::result [cotest]
+ cotest
+ return $result
+} -returnCodes error -cleanup {
+ catch {namespace delete ::cotest}
+ catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
+ namespace eval cotest {}
+ set ::result ""
+} -body {
+ proc cotest::body {} {
+ set y ::yieldto
+ lappend ::result a
+ yield OUT
+ lappend ::result b
+ $y ::return -level 0 -cotest [namespace delete ::cotest] 123
+ lappend ::result c
+ return
+ }
+ lappend ::result [coroutine cotest cotest::body]
+ lappend ::result [cotest]
+ cotest
+ return $result
+} -returnCodes error -cleanup {
+ catch {namespace delete ::cotest}
+ catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+
+
+# cleanup
+unset lambda
+::tcltest::cleanupTests
+
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/dcall.test b/tests/dcall.test
index 55f6731..41dd777 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -10,13 +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: 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::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testdcall [llength [info commands testdcall]]
@@ -40,5 +39,5 @@ test dcall-1.6 {deletion callbacks} testdcall {
} {}
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/dict.test b/tests/dict.test
index 090142e..a583de8 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1,15 +1,13 @@
-# This test file covers the dictionary object type and the dict
-# command used to work with values of that type.
+# This test file covers the dictionary object type and the dict command used
+# to work with values of that type.
#
-# 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) 2003 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.13 2005/07/21 21:49:08 dkf Exp $
+# 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.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -18,27 +16,24 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
-
-# Procedure to help check the contents of a dictionary. Note that we
-# can't just compare the string version because the order of the
-# elements is (deliberately) not defined. This is because it is
-# dependent on the underlying hash table implementation and also
-# potentially on the history of the value itself. Net result: you
-# cannot safely assume anything about the ordering of values.
-proc getOrder {dictVal args} {
- foreach key $args {
- lappend result $key [dict get $dictVal $key]
+if {[testConstraint memory]} {
+ proc memtest script {
+ set end [lindex [split [memory info] \n] 3 3]
+ for {set i 0} {$i < 5} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [lindex [split [memory info] \n] 3 3]
+ }
+ expr {$end - $tmp}
}
- lappend result [dict size $dictVal]
- return $result
}
-
-test dict-1.1 {dict command basic syntax} {
- list [catch {dict} msg] $msg
-} {1 {wrong # args: should be "dict subcommand ?arg ...?"}}
-test dict-1.2 {dict command basic syntax} {
- list [catch {dict ?} msg] $msg
-} {1 {bad subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}}
+
+test dict-1.1 {dict command basic syntax} -returnCodes error -body {
+ dict
+} -result {wrong # args: should be "dict subcommand ?arg ...?"}
+test dict-1.2 {dict command basic syntax} -returnCodes error -body {
+ dict ?
+} -match glob -result {unknown or ambiguous subcommand "?": must be *}
test dict-2.1 {dict create command} {
dict create
@@ -46,7 +41,7 @@ test dict-2.1 {dict create command} {
test dict-2.2 {dict create command} {
dict create a b
} {a b}
-test dict-2.3 {dict create command} {
+test dict-2.3 {dict create command} -body {
set result {}
set dict [dict create a b c d]
# Can't compare directly as ordering of values is undefined
@@ -57,87 +52,119 @@ test dict-2.3 {dict create command} {
}
lappend result [lindex $dict [expr {$idx+1}]]
}
- set result
-} {b d}
-test dict-2.4 {dict create command} {
- list [catch {dict create a} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.5 {dict create command} {
- list [catch {dict create a b c} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.6 {dict create command - initialse refcount field!} {
+ return $result
+} -cleanup {
+ unset result dict key idx
+} -result {b d}
+test dict-2.4 {dict create command} -returnCodes error -body {
+ dict create a
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.5 {dict create command} -returnCodes error -body {
+ dict create a b c
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.6 {dict create command - initialse refcount field!} -body {
# Bug 715751 will show up in memory debuggers like purify
for {set i 0} {$i<10} {incr i} {
set dictv [dict create a 0]
set share [dict values $dictv]
list [dict incr dictv a]
}
-} {}
+} -cleanup {
+ unset i dictv share
+} -result {}
test dict-2.7 {dict create command - #-quoting in string rep} {
dict create # #comment
} {{#} #comment}
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
test dict-3.3 {dict get command} {dict get {a b c d} c} d
-test dict-3.4 {dict get command} {
- list [catch {dict get {a b c d} b} msg] $msg
-} {1 {key "b" not known in dictionary}}
+test dict-3.4 {dict get command} -returnCodes error -body {
+ dict get {a b c d} b
+} -result {key "b" not known in dictionary}
test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q
test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s
test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v
test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y
-test dict-3.9 {dict get command} {
- list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg
-} {1 {key "z" not known in dictionary}}
-test dict-3.10 {dict get command} {
- list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg
-} {1 {key "c" not known in dictionary}}
+test dict-3.9 {dict get command} -returnCodes error -body {
+ dict get {a {p q r s} b {u v x y}} a z
+} -result {key "z" not known in dictionary}
+test dict-3.10 {dict get command} -returnCodes error -body {
+ dict get {a {p q r s} b {u v x y}} c z
+} -result {key "c" not known in dictionary}
test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
-test dict-3.12 {dict get command} {
- list [catch {dict get} msg] $msg
-} {1 {wrong # args: should be "dict get dictionary ?key key ...?"}}
-test dict-3.13 {dict get command} {
+test dict-3.12 {dict get command} -returnCodes error -body {
+ dict get
+} -result {wrong # args: should be "dict get dictionary ?key ...?"}
+test dict-3.13 {dict get command} -body {
set dict [dict get {a b c d}]
if {$dict eq "a b c d"} {
- subst OK
+ return OK
} elseif {$dict eq "c d a b"} {
- subst OK
+ return reordered
} else {
- set dict
+ return $dict
}
-} OK
-test dict-3.14 {dict get command} {
- list [catch {dict get {a b c d} a c} msg] $msg
-} {1 {missing value to go with key}}
+} -cleanup {
+ unset dict
+} -result OK
+test dict-3.14 {dict get command} -returnCodes error -body {
+ dict get {a b c d} a c
+} -result {missing value to go with key}
+test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
+ apply {{} {
+ dict set a(z) b c
+ dict get $a(z) d
+ }}
+} -returnCodes error -result {key "d" not known in dictionary}
+test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}
+test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6
test dict-4.1 {dict replace command} {
- getOrder [dict replace {a b c d}] a c
-} {a b c d 2}
+ dict replace {a b c d}
+} {a b c d}
test dict-4.2 {dict replace command} {
- getOrder [dict replace {a b c d} e f] a c e
-} {a b c d e f 3}
+ dict replace {a b c d} e f
+} {a b c d e f}
test dict-4.3 {dict replace command} {
- getOrder [dict replace {a b c d} c f] a c
-} {a b c f 2}
+ dict replace {a b c d} c f
+} {a b c f}
test dict-4.4 {dict replace command} {
- getOrder [dict replace {a b c d} c x a y] a c
-} {a y c x 2}
-test dict-4.5 {dict replace command} {
- list [catch {dict replace} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.6 {dict replace command} {
- list [catch {dict replace {a a} a} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.7 {dict replace command} {
- list [catch {dict replace {a a a} a b} msg] $msg
-} {1 {missing value to go with key}}
-test dict-4.8 {dict replace command} {
- list [catch {dict replace [list a a a] a b} msg] $msg
-} {1 {missing value to go with key}}
+ dict replace {a b c d} c x a y
+} {a y c x}
+test dict-4.5 {dict replace command} -returnCodes error -body {
+ dict replace
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.6 {dict replace command} -returnCodes error -body {
+ dict replace {a a} a
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.7 {dict replace command} -returnCodes error -body {
+ dict replace {a a a} a b
+} -result {missing value to go with key}
+test dict-4.8 {dict replace command} -returnCodes error -body {
+ dict replace [list a a a] a b
+} -result {missing value to go with key}
test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
@@ -146,12 +173,12 @@ test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
test dict-5.5 {dict remove command} {
- getOrder [dict remove {a b c d}] a c
-} {a b c d 2}
+ dict remove {a b c d}
+} {a b c d}
test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
-test dict-5.7 {dict remove command} {
- list [catch {dict remove} msg] $msg
-} {1 {wrong # args: should be "dict remove dictionary ?key ...?"}}
+test dict-5.7 {dict remove command} -returnCodes error -body {
+ dict remove
+} -result {wrong # args: should be "dict remove dictionary ?key ...?"}
test dict-6.1 {dict keys command} {dict keys {a b}} a
test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -160,15 +187,15 @@ test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca}
-test dict-6.8 {dict keys command} {
- list [catch {dict keys} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.9 {dict keys command} {
- list [catch {dict keys {} a b} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.10 {dict keys command} {
- list [catch {dict keys a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-6.8 {dict keys command} -returnCodes error -body {
+ dict keys
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.9 {dict keys command} -returnCodes error -body {
+ dict keys {} a b
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.10 {dict keys command} -returnCodes error -body {
+ dict keys a
+} -result {missing value to go with key}
test dict-7.1 {dict values command} {dict values {a b}} b
test dict-7.2 {dict values command} {dict values {c d}} d
@@ -177,259 +204,332 @@ test dict-7.4 {dict values command} {dict values {a b c d} b} b
test dict-7.5 {dict values command} {dict values {a b c d} d} d
test dict-7.6 {dict values command} {dict values {a b c d} e} {}
test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da}
-test dict-7.8 {dict values command} {
- list [catch {dict values} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.9 {dict values command} {
- list [catch {dict values {} a b} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.10 {dict values command} {
- list [catch {dict values a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-7.8 {dict values command} -returnCodes error -body {
+ dict values
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.9 {dict values command} -returnCodes error -body {
+ dict values {} a b
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.10 {dict values command} -returnCodes error -body {
+ dict values a
+} -result {missing value to go with key}
test dict-8.1 {dict size command} {dict size {}} 0
test dict-8.2 {dict size command} {dict size {a b}} 1
test dict-8.3 {dict size command} {dict size {a b c d}} 2
-test dict-8.4 {dict size command} {
- list [catch {dict size} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.5 {dict size command} {
- list [catch {dict size a b} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.6 {dict size command} {
- list [catch {dict size a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-8.4 {dict size command} -returnCodes error -body {
+ dict size
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.5 {dict size command} -returnCodes error -body {
+ dict size a b
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.6 {dict size command} -returnCodes error -body {
+ dict size a
+} -result {missing value to go with key}
test dict-9.1 {dict exists command} {dict exists {a b} a} 1
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} {
- list [catch {dict exists {a {b c d}} a c} msg] $msg
-} {1 {missing value to go with key}}
-test dict-9.7 {dict exists command} {
- list [catch {dict exists} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
-test dict-9.8 {dict exists command} {
- list [catch {dict exists {}} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?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 ...?"}
+test dict-9.8 {dict exists command} -returnCodes error -body {
+ dict exists {}
+} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
-test dict-10.1 {dict info command} {
+test dict-10.1 {dict info command} -body {
# Actual string returned by this command is undefined; it is
# intended for human consumption and not for use by scripts.
dict info {}
- subst {}
-} {}
-test dict-10.2 {dict info command} {
- list [catch {dict info} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.3 {dict info command} {
- list [catch {dict info {} x} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.4 {dict info command} {
- list [catch {dict info x} msg] $msg
-} {1 {missing value to go with key}}
+} -match glob -result *
+test dict-10.2 {dict info command} -returnCodes error -body {
+ dict info
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.3 {dict info command} -returnCodes error -body {
+ dict info {} x
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.4 {dict info command} -returnCodes error -body {
+ dict info x
+} -result {missing value to go with key}
-test dict-11.1 {dict incr command: unshared value} {
+test dict-11.1 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.2 {dict incr command: unshared value} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {a 1 b 3 c 2147483649}
+test dict-11.2 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.3 {dict incr command: unshared value} {
+ dict incr dictv b
+} -cleanup {
+ unset dictv
+} -result {a 0 b 4 c 2147483649}
+test dict-11.3 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.4 {dict incr command: shared value} {
+ dict incr dictv c
+} -cleanup {
+ unset dictv
+} -result {a 0 b 3 c 2147483650}
+test dict-11.4 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.5 {dict incr command: shared value} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv sharing
+} -result {a 1 b 3 c 2147483649}
+test dict-11.5 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.6 {dict incr command: shared value} {
+ dict incr dictv b
+} -cleanup {
+ unset dictv sharing
+} -result {a 0 b 4 c 2147483649}
+test dict-11.6 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.7 {dict incr command: unknown values} {
+ dict incr dictv c
+} -cleanup {
+ unset dictv sharing
+} -result {a 0 b 3 c 2147483650}
+test dict-11.7 {dict incr command: unknown values} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv d] a b c d
-} {a 0 b 3 c 2147483649 d 1 4}
-test dict-11.8 {dict incr command} {
+ dict incr dictv d
+} -cleanup {
+ unset dictv
+} -result {a 0 b 3 c 2147483649 d 1}
+test dict-11.8 {dict incr command} -body {
set dictv {a 1}
dict incr dictv a 2
-} {a 3}
-test dict-11.9 {dict incr command} {
+} -cleanup {
+ unset dictv
+} -result {a 3}
+test dict-11.9 {dict incr command} -returnCodes error -body {
set dictv {a dummy}
- list [catch {dict incr dictv a} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.10 {dict incr command} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.10 {dict incr command} -returnCodes error -body {
set dictv {a 1}
- list [catch {dict incr dictv a dummy} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.11 {dict incr command} {
- catch {unset dictv}
+ dict incr dictv a dummy
+} -cleanup {
+ unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.11 {dict incr command} -setup {
+ unset -nocomplain dictv
+} -body {
dict incr dictv a
-} {a 1}
-test dict-11.12 {dict incr command} {
+} -cleanup {
+ unset dictv
+} -result {a 1}
+test dict-11.12 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-11.13 {dict incr command} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-11.13 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv a a a} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.14 {dict incr command} {
+ dict incr dictv a a a
+} -cleanup {
+ unset dictv
+} -result {wrong # args: should be "dict incr varName key ?increment?"}
+test dict-11.14 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.15 {dict incr command: write failure} {
- catch {unset dictVar}
+ dict incr dictv
+} -cleanup {
+ unset dictv
+} -result {wrong # args: should be "dict incr varName key ?increment?"}
+test dict-11.15 {dict incr command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict incr dictVar a} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict incr dictVar a
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
test dict-11.16 {dict incr command: compilation} {
- proc dicttest {} {
+ apply {{} {
set v {a 0 b 0 c 0}
dict incr v a
dict incr v b 1
dict incr v c 2
dict incr v d 3
list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d]
- }
- dicttest
+ }}
} {1 1 2 3}
+test dict-11.17 {dict incr command: compilation} {
+ apply {{} {
+ set dictv {a 1}
+ dict incr dictv a 2
+ }}
+} {a 3}
-test dict-12.1 {dict lappend command} {
+test dict-12.1 {dict lappend command} -body {
set dictv {a a}
dict lappend dictv a
-} {a a}
-test dict-12.2 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a a}
+test dict-12.2 {dict lappend command} -body {
set dictv {a a}
set sharing [dict values $dictv]
dict lappend dictv a b
-} {a {a b}}
-test dict-12.3 {dict lappend command} {
+} -cleanup {
+ unset dictv sharing
+} -result {a {a b}}
+test dict-12.3 {dict lappend command} -body {
set dictv {a a}
dict lappend dictv a b c
-} {a {a b c}}
-test dict-12.2.1 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a {a b c}}
+test dict-12.2.1 {dict lappend command} -body {
set dictv [dict create a [string index =a= 1]]
dict lappend dictv a b
-} {a {a b}}
-test dict-12.4 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a {a b}}
+test dict-12.4 {dict lappend command} -body {
set dictv {}
dict lappend dictv a x y z
-} {a {x y z}}
-test dict-12.5 {dict lappend command} {
- catch {unset dictv}
+} -cleanup {
+ unset dictv
+} -result {a {x y z}}
+test dict-12.5 {dict lappend command} -body {
+ unset -nocomplain dictv
dict lappend dictv a b
-} {a b}
-test dict-12.6 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a b}
+test dict-12.6 {dict lappend command} -returnCodes error -body {
set dictv a
- list [catch {dict lappend dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-12.7 {dict lappend command} {
- list [catch {dict lappend} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.8 {dict lappend command} {
- list [catch {dict lappend dictv} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.9 {dict lappend command} {
+ dict lappend dictv a a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-12.7 {dict lappend command} -returnCodes error -body {
+ dict lappend
+} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+test dict-12.8 {dict lappend command} -returnCodes error -body {
+ dict lappend dictv
+} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+test dict-12.9 {dict lappend command} -returnCodes error -body {
set dictv [dict create a "\{"]
- list [catch {dict lappend dictv a a} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-12.10 {dict lappend command: write failure} {
- catch {unset dictVar}
+ dict lappend dictv a a
+} -cleanup {
+ unset dictv
+} -result {unmatched open brace in list}
+test dict-12.10 {dict lappend command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict lappend dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict lappend dictVar a x
+} -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} {
+test dict-13.1 {dict append command} -body {
set dictv {a a}
dict append dictv a
-} {a a}
-test dict-13.2 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a a}
+test dict-13.2 {dict append command} -body {
set dictv {a a}
set sharing [dict values $dictv]
dict append dictv a b
-} {a ab}
-test dict-13.3 {dict append command} {
+} -cleanup {
+ unset dictv sharing
+} -result {a ab}
+test dict-13.3 {dict append command} -body {
set dictv {a a}
dict append dictv a b c
-} {a abc}
-test dict-13.2.1 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a abc}
+test dict-13.2.1 {dict append command} -body {
set dictv [dict create a [string index =a= 1]]
dict append dictv a b
-} {a ab}
-test dict-13.4 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a ab}
+test dict-13.4 {dict append command} -body {
set dictv {}
dict append dictv a x y z
-} {a xyz}
-test dict-13.5 {dict append command} {
- catch {unset dictv}
+} -cleanup {
+ unset dictv
+} -result {a xyz}
+test dict-13.5 {dict append command} -body {
+ unset -nocomplain dictv
dict append dictv a b
-} {a b}
-test dict-13.6 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a b}
+test dict-13.6 {dict append command} -returnCodes error -body {
set dictv a
- list [catch {dict append dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-13.7 {dict append command} {
- list [catch {dict append} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.8 {dict append command} {
- list [catch {dict append dictv} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.9 {dict append command: write failure} {
- catch {unset dictVar}
+ dict append dictv a a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-13.7 {dict append command} -returnCodes error -body {
+ dict append
+} -result {wrong # args: should be "dict append varName key ?value ...?"}
+test dict-13.8 {dict append command} -returnCodes error -body {
+ dict append dictv
+} -result {wrong # args: should be "dict append varName key ?value ...?"}
+test dict-13.9 {dict append command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict append dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict append dictVar a x
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+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} {
- list [catch {dict for} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.2 {dict for command: syntax} {
- list [catch {dict for x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.3 {dict for command: syntax} {
- list [catch {dict for x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.4 {dict for command: syntax} {
- list [catch {dict for x x x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.5 {dict for command: syntax} {
- list [catch {dict for x x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.6 {dict for command: syntax} {
- list [catch {dict for {x x x} x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.7 {dict for command: syntax} {
- list [catch {dict for "\{x" x x} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-14.8 {dict for command} {
+test dict-14.1 {dict for command: syntax} -returnCodes error -body {
+ dict for
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.2 {dict for command: syntax} -returnCodes error -body {
+ dict for x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.3 {dict for command: syntax} -returnCodes error -body {
+ dict for x x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.4 {dict for command: syntax} -returnCodes error -body {
+ dict for x x x x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.5 {dict for command: syntax} -returnCodes error -body {
+ dict for x x x
+} -result {must have exactly two variable names}
+test dict-14.6 {dict for command: syntax} -returnCodes error -body {
+ dict for {x x x} x x
+} -result {must have exactly two variable names}
+test dict-14.7 {dict for command: syntax} -returnCodes error -body {
+ dict for "\{x" x x
+} -result {unmatched open brace in list}
+test dict-14.8 {dict for command} -body {
# This test confirms that [dict keys], [dict values] and [dict for]
# all traverse a dictionary in the same order.
set dictv {a A b B c C}
@@ -443,31 +543,37 @@ test dict-14.8 {dict for command} {
$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
}]
expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
-} YES
+} -cleanup {
+ unset result keys values k v dictv
+} -result YES
test dict-14.9 {dict for command} {
dict for {k v} {} {
error "unexpected execution of 'dict for' body"
}
} {}
-test dict-14.10 {dict for command: script results} {
+test dict-14.10 {dict for command: script results} -body {
set times 0
dict for {k v} {a a b b} {
incr times
continue
error "shouldn't get here"
}
- set times
-} 2
-test dict-14.11 {dict for command: script results} {
+ return $times
+} -cleanup {
+ unset times k v
+} -result 2
+test dict-14.11 {dict for command: script results} -body {
set times 0
dict for {k v} {a a b b} {
incr times
break
error "shouldn't get here"
}
- set times
-} 1
-test dict-14.12 {dict for command: script results} {
+ return $times
+} -cleanup {
+ unset times k v
+} -result 1
+test dict-14.12 {dict for command: script results} -body {
set times 0
list [catch {
dict for {k v} {a a b b} {
@@ -475,7 +581,9 @@ test dict-14.12 {dict for command: script results} {
error test
}
} msg] $msg $times $::errorInfo
-} {1 test 1 {test
+} -cleanup {
+ unset times k v msg
+} -result {1 test 1 {test
while executing
"error test"
("dict for" body line 3)
@@ -485,17 +593,15 @@ test dict-14.12 {dict for command: script results} {
error test
}"}}
test dict-14.13 {dict for command: script results} {
- proc dicttest {} {
- rename dicttest {}
+ apply {{} {
dict for {k v} {a b} {
return ok,$k,$v
error "skipped return completely"
}
error "return didn't go far enough"
- }
- dicttest
+ }}
} ok,a,b
-test dict-14.14 {dict for command: handle representation loss} {
+test dict-14.14 {dict for command: handle representation loss} -body {
set dictVar {a b c d e f g h}
set keys {}
set values {}
@@ -506,11 +612,14 @@ test dict-14.14 {dict for command: handle representation loss} {
}
}
list [lsort $keys] [lsort $values]
-} {{a c e g} {b d f h}}
-test dict-14.15 {dict for command: keys are unique and iterated over once only} {
- set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- catch {unset accum}
+} -cleanup {
+ unset dictVar keys values k v
+} -result {{a c e g} {b d f h}}
+test dict-14.15 {dict for 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 for {k v} $dictVar {
append accum($k) $v,
}
@@ -519,416 +628,618 @@ test dict-14.15 {dict for command: keys are unique and iterated over once only}
foreach k $result {
catch {lappend result $accum($k)}
}
- catch {unset accum}
- set result
-} {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+ return $result
+} -cleanup {
+ unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
test dict-14.16 {dict for command in compilation context} {
- proc dicttest {} {
+ apply {{} {
set res {x x x x x x}
dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
lset res $v $k
continue
}
return $res
- }
- dicttest
+ }}
} {a b c d e f}
-# There's probably a lot more tests to add here. Really ought to use
-# a coverage tool for this job...
+test dict-14.17 {dict for command in compilation context} {
+ # Bug 1379349
+ apply {{} {
+ set d [dict create a 1] ;# Dict must be unshared!
+ dict for {k v} $d {
+ dict set d $k 0 ;# Any modification will do
+ }
+ return $d
+ }}
+} {a 0}
+test dict-14.18 {dict for command in compilation context} {
+ # Bug 1382528
+ apply {{} {
+ dict for {k v} {} {} ;# Note empty dict
+ catch { error foo } ;# Note compiled [catch]
+ }}
+} 1
+test dict-14.19 {dict for and invalid dicts: bug 1531184} -body {
+ di[list]ct for {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-14.20 {dict for stack space compilation: bug 1903325} {
+ apply {{x y args} {
+ dict for {a b} $x {}
+ concat "c=$y,$args"
+ }} {} 1 2 3
+} {c=1,2 3}
+test dict-14.21 {compiled dict for and break} {
+ apply {{} {
+ dict for {a b} {c d e f} {
+ lappend result $a,$b
+ break
+ }
+ return $result
+ }}
+} c,d
+test dict-14.22 {dict for and exception range depths: Bug 3614382} {
+ apply {{} {
+ dict for {a b} {c d} {
+ dict for {e f} {g h} {
+ return 5
+ }
+ }
+ }}
+} 5
+# There's probably a lot more tests to add here. Really ought to use a
+# coverage tool for this job...
-test dict-15.1 {dict set command} {
+test dict-15.1 {dict set command} -body {
set dictVar {}
dict set dictVar a x
-} {a x}
-test dict-15.2 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.2 {dict set command} -body {
set dictvar {a {}}
dict set dictvar a b x
-} {a {b x}}
-test dict-15.3 {dict set command} {
+} -cleanup {
+ unset dictvar
+} -result {a {b x}}
+test dict-15.3 {dict set command} -body {
set dictvar {a {b {}}}
dict set dictvar a b c x
-} {a {b {c x}}}
-test dict-15.4 {dict set command} {
+} -cleanup {
+ unset dictvar
+} -result {a {b {c x}}}
+test dict-15.4 {dict set command} -body {
set dictVar {a y}
dict set dictVar a x
-} {a x}
-test dict-15.5 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.5 {dict set command} -body {
set dictVar {a {b y}}
dict set dictVar a b x
-} {a {b x}}
-test dict-15.6 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a {b x}}
+test dict-15.6 {dict set command} -body {
set dictVar {a {b {c y}}}
dict set dictVar a b c x
-} {a {b {c x}}}
-test dict-15.7 {dict set command: path creation} {
+} -cleanup {
+ unset dictVar
+} -result {a {b {c x}}}
+test dict-15.7 {dict set command: path creation} -body {
set dictVar {}
dict set dictVar a b x
-} {a {b x}}
-test dict-15.8 {dict set command: creates variables} {
- catch {unset dictVar}
+} -cleanup {
+ unset dictVar
+} -result {a {b x}}
+test dict-15.8 {dict set command: creates variables} -setup {
+ unset -nocomplain dictVar
+} -body {
dict set dictVar a x
- set dictVar
-} {a x}
-test dict-15.9 {dict set command: write failure} {
- catch {unset dictVar}
+ return $dictVar
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.9 {dict set command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict set dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
-test dict-15.10 {dict set command: syntax} {
- list [catch {dict set} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.11 {dict set command: syntax} {
- list [catch {dict set a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.12 {dict set command: syntax} {
- list [catch {dict set a a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.13 {dict set command} {
+ dict set dictVar a x
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-15.10 {dict set command: syntax} -returnCodes error -body {
+ dict set
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.11 {dict set command: syntax} -returnCodes error -body {
+ dict set a
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.12 {dict set command: syntax} -returnCodes error -body {
+ dict set a a
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.13 {dict set command} -returnCodes error -body {
set dictVar a
- list [catch {dict set dictVar b c} msg] $msg
-} {1 {missing value to go with key}}
+ dict set dictVar b c
+} -cleanup {
+ unset dictVar
+} -result {missing value to go with key}
-test dict-16.1 {dict unset command} {
+test dict-16.1 {dict unset command} -body {
set dictVar {a b c d}
dict unset dictVar a
-} {c d}
-test dict-16.2 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {c d}
+test dict-16.2 {dict unset command} -body {
set dictVar {a b c d}
dict unset dictVar c
-} {a b}
-test dict-16.3 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a b}
+test dict-16.3 {dict unset command} -body {
set dictVar {a b}
dict unset dictVar c
-} {a b}
-test dict-16.4 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a b}
+test dict-16.4 {dict unset command} -body {
set dictVar {a {b c d e}}
dict unset dictVar a b
-} {a {d e}}
-test dict-16.5 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a {d e}}
+test dict-16.5 {dict unset command} -returnCodes error -body {
set dictVar a
- list [catch {dict unset dictVar a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-16.6 {dict unset command} {
+ dict unset dictVar a
+} -cleanup {
+ unset dictVar
+} -result {missing value to go with key}
+test dict-16.6 {dict unset command} -returnCodes error -body {
set dictVar {a b}
- list [catch {dict unset dictVar c d} msg] $msg
-} {1 {key "c" not known in dictionary}}
-test dict-16.7 {dict unset command} {
- catch {unset dictVar}
+ dict unset dictVar c d
+} -cleanup {
+ unset dictVar
+} -result {key "c" not known in dictionary}
+test dict-16.7 {dict unset command} -setup {
+ unset -nocomplain dictVar
+} -body {
list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
-} {0 {} 1}
-test dict-16.8 {dict unset command} {
- list [catch {dict unset dictVar} msg] $msg
-} {1 {wrong # args: should be "dict unset varName key ?key ...?"}}
-test dict-16.9 {dict unset command: write failure} {
- catch {unset dictVar}
+} -cleanup {
+ unset dictVar
+} -result {0 {} 1}
+test dict-16.8 {dict unset command} -returnCodes error -body {
+ dict unset dictVar
+} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+test dict-16.9 {dict unset command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict unset dictVar a} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict unset dictVar a
+} -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} {
+test dict-17.1 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict filter $dictVar key a2
-} {a2 b}
-test dict-17.2 {dict filter command: key} {
+} -cleanup {
+ unset dictVar
+} -result {a2 b}
+test dict-17.2 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict size [dict filter $dictVar key *]
-} 6
-test dict-17.3 {dict filter command: key} {
+} -cleanup {
+ unset dictVar
+} -result 6
+test dict-17.3 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- getOrder [dict filter $dictVar key ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.4 {dict filter command: key} {
- list [catch {dict filter {} key} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.5 {dict filter command: key} {
- list [catch {dict filter {} key a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.6 {dict filter command: value} {
+ dict filter $dictVar key ???
+} -cleanup {
+ unset dictVar
+} -result {foo bar bar foo}
+test dict-17.4 {dict filter command: key - no patterns} {
+ dict filter {a b c d} key
+} {}
+test dict-17.4.1 {dict filter command: key - many patterns} {
+ dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b?
+} {a1 a a2 b b1 c b2 d}
+test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body {
+ dict filter {a b c} key
+} -result {missing value to go with key}
+test dict-17.6 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict filter $dictVar value c
-} {b1 c}
-test dict-17.7 {dict filter command: value} {
+} -cleanup {
+ unset dictVar
+} -result {b1 c}
+test dict-17.7 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict size [dict filter $dictVar value *]
-} 6
-test dict-17.8 {dict filter command: value} {
+} -cleanup {
+ unset dictVar
+} -result 6
+test dict-17.8 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- getOrder [dict filter $dictVar value ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.9 {dict filter command: value} {
- list [catch {dict filter {} value} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.10 {dict filter command: value} {
- list [catch {dict filter {} value a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.11 {dict filter command: script} {
+ dict filter $dictVar value ???
+} -cleanup {
+ unset dictVar
+} -result {foo bar bar foo}
+test dict-17.9 {dict filter command: value - no patterns} {
+ dict filter {a b c d} value
+} {}
+test dict-17.9.1 {dict filter command: value - many patterns} {
+ dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b?
+} {a a1 b a2 c b1 d b2}
+test dict-17.10 {dict filter command: value - bad dict} -body {
+ dict filter {a b c} value a
+} -returnCodes error -result {missing value to go with key}
+test dict-17.11 {dict filter command: script} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
set n 0
- list [getOrder [dict filter $dictVar script {k v} {
+ list [dict filter $dictVar script {k v} {
incr n
expr {[string length $k] == [string length $v]}
- }] bar foo] $n
-} {{bar foo foo bar 2} 6}
-test dict-17.12 {dict filter command: script} {
- list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg
-} {1 {expected boolean value but got "a b"}}
-test dict-17.13 {dict filter command: script} {
+ }] $n
+} -cleanup {
+ unset dictVar n k v
+} -result {{foo bar bar foo} 6}
+test dict-17.12 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script {k v} {
+ concat $k $v
+ }
+} -cleanup {
+ unset k v
+} -result {expected boolean value but got "a b"}
+test dict-17.13 {dict filter command: script} -body {
list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \
$::errorInfo
-} {1 x {x
+} -cleanup {
+ unset k v msg
+} -result {1 x {x
while executing
"error x"
("dict filter" script line 1)
invoked from within
"dict filter {a b} script {k v} {error x}"}}
-test dict-17.14 {dict filter command: script} {
+test dict-17.14 {dict filter command: script} -setup {
set n 0
+} -body {
list [dict filter {a b c d} script {k v} {
incr n
break
error boom!
}] $n
-} {{} 1}
-test dict-17.15 {dict filter command: script} {
+} -cleanup {
+ unset n k v
+} -result {{} 1}
+test dict-17.15 {dict filter command: script} -setup {
set n 0
+} -body {
list [dict filter {a b c d} script {k v} {
incr n
continue
error boom!
}] $n
-} {{} 2}
+} -cleanup {
+ unset n k v
+} -result {{} 2}
test dict-17.16 {dict filter command: script} {
- proc dicttest {} {
- rename dicttest {}
+ apply {{} {
dict filter {a b} script {k v} {
return ok,$k,$v
error "skipped return completely"
}
error "return didn't go far enough"
- }
- dicttest
+ }}
} ok,a,b
-test dict-17.17 {dict filter command: script} {
+test dict-17.17 {dict filter command: script} -body {
dict filter {a b} script {k k} {continue}
- set k
-} b
-test dict-17.18 {dict filter command: script} {
- list [catch {dict filter {a b} script {k k}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}}
-test dict-17.19 {dict filter command: script} {
- list [catch {dict filter {a b} script k {continue}} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-17.20 {dict filter command: script} {
- list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-17.21 {dict filter command} {
- list [catch {dict filter {a b}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary filterType ..."}}
-test dict-17.22 {dict filter command} {
- list [catch {dict filter {a b} JUNK} msg] $msg
-} {1 {bad filterType "JUNK": must be key, script, or value}}
-test dict-17.23 {dict filter command} {
- list [catch {dict filter a key *} msg] $msg
-} {1 {missing value to go with key}}
+ return $k
+} -cleanup {
+ unset k
+} -result b
+test dict-17.18 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script {k k}
+} -result {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}
+test dict-17.19 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script k {continue}
+} -result {must have exactly two variable names}
+test dict-17.20 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script "\{k v" {continue}
+} -result {unmatched open brace in list}
+test dict-17.21 {dict filter command} -returnCodes error -body {
+ dict filter {a b}
+} -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"}
+test dict-17.22 {dict filter command} -returnCodes error -body {
+ dict filter {a b} JUNK
+} -result {bad filterType "JUNK": must be key, script, or value}
+test dict-17.23 {dict filter command} -returnCodes error -body {
+ dict filter a key *
+} -result {missing value to go with key}
-test dict-18.1 {dict-list relationship} {
- -body {
- # Test that any internal conversion between list and dict
- # does not change the object
- set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
- dict values $l
- set l
- }
- -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
-}
-test dict-18.2 {dict-list relationship} {
- -body {
- # Test that the dictionary is a valid list
- set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
- for {set t 0} {$t < 5} {incr t} {
- llength $d
- dict lappend d "abc def" "\}\{"
- dict append d "a\{b" "\}"
- dict incr d "c\}d" 1
- }
- llength $d
+test dict-18.1 {dict-list relationship} -body {
+ # Test that any internal conversion between list and dict does not change
+ # the object
+ set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
+ dict values $l
+ return $l
+} -cleanup {
+ unset l
+} -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
+test dict-18.2 {dict-list relationship} -body {
+ # Test that the dictionary is a valid list
+ set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
+ for {set t 0} {$t < 5} {incr t} {
+ llength $d
+ dict lappend d "abc def" "\}\{"
+ dict append d "a\{b" "\}"
+ dict incr d "c\}d" 1
}
- -result 6
-}
+ llength $d
+} -cleanup {
+ unset d t
+} -result 6
+test dict-18.3 {dict-list relationship} -body {
+ set ld [list a b c d c e f g]
+ list [string length $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+ unset ld
+} -result {15 3 8}
+test dict-18.4 {dict-list relationship} -body {
+ set ld [list a b c d c e f g]
+ list [llength $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+ unset ld
+} -result {8 3 8}
# This is a test for a specific bug.
# It shows a bad ref counter when running with memdebug on.
-test dict-19.1 {memory bug} -setup {
- proc xxx {} {
+test dict-19.1 {memory bug} {
+ apply {{} {
set successors [dict create x {c d}]
dict set successors x a b
dict get $successors x
- }
-} -body {
- xxx
-} -cleanup {
- rename xxx {}
-} -result [dict create c d a b]
-test dict-19.2 {dict: testing for leaks} -setup {
- proc getbytes {} {
- set lines [split [memory info] "\n"]
- lindex [lindex $lines 3] 3
- }
+ }}
+} [dict create c d a b]
+test dict-19.2 {dict: testing for leaks} -constraints memory -body {
# This test is made to stress object reference management
- proc stress {} {
- # A shared invalid dictinary
- set apa {a {}b c d}
- set bepa $apa
- catch {dict replace $apa e f}
- catch {dict remove $apa c d}
- catch {dict incr apa a 5}
- catch {dict lappend apa a 5}
- catch {dict append apa a 5}
- catch {dict set apa a 5}
- catch {dict unset apa a}
+ memtest {
+ apply {{} {
+ # A shared invalid dictinary
+ set apa {a {}b c d}
+ set bepa $apa
+ catch {dict replace $apa e f}
+ catch {dict remove $apa c d}
+ catch {dict incr apa a 5}
+ catch {dict lappend apa a 5}
+ catch {dict append apa a 5}
+ catch {dict set apa a 5}
+ catch {dict unset apa a}
- # A shared valid dictionary, invalid incr
- set apa {a b c d}
- set bepa $apa
- catch {dict incr bepa a 5}
+ # A shared valid dictionary, invalid incr
+ set apa {a b c d}
+ set bepa $apa
+ catch {dict incr bepa a 5}
- # An error during write to an unshared object, incr
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict incr bepa a 5}
- unset bepa
+ # An error during write to an unshared object, incr
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict incr bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, incr
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict incr bepa a 5}
- unset bepa
+ # An error during write to a shared object, incr
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict incr bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # A shared valid dictionary, invalid lappend
- set apa [list a {{}b} c d]
- set bepa $apa
- catch {dict lappend bepa a 5}
+ # A shared valid dictionary, invalid lappend
+ set apa [list a {{}b} c d]
+ set bepa $apa
+ catch {dict lappend bepa a 5}
- # An error during write to an unshared object, lappend
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict lappend bepa a 5}
- unset bepa
+ # An error during write to an unshared object, lappend
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict lappend bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, lappend
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict lappend bepa a 5}
- unset bepa
+ # An error during write to a shared object, lappend
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict lappend bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, append
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict append bepa a 5}
- unset bepa
+ # An error during write to an unshared object, append
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict append bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, append
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict append bepa a 5}
- unset bepa
+ # An error during write to a shared object, append
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict append bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, set
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict set bepa a 5}
- unset bepa
+ # An error during write to an unshared object, set
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict set bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, set
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict set bepa a 5}
- unset bepa
+ # An error during write to a shared object, set
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict set bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, unset
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict unset bepa a}
- unset bepa
+ # An error during write to an unshared object, unset
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict unset bepa a}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, unset
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict unset bepa a}
- unset bepa
+ # An error during write to a shared object, unset
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict unset bepa a}
+ trace remove variable bepa write {error hej}
+ unset bepa
+ }}
}
-} -constraints memory -body {
- set end [getbytes]
- for {set i 0} {$i < 5} {incr i} {
- stress
- set tmp $end
- set end [getbytes]
+} -result 0
+test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body {
+ set d aDictVar; # Force interpreted [dict incr]
+ memtest {
+ dict incr $d aKey 0
+ unset $d
}
- expr {$end - $tmp}
} -cleanup {
- unset -nocomplain end i tmp
- rename getbytes {}
- rename stress {}
+ unset d
} -result 0
test dict-20.1 {dict merge command} {
dict merge
} {}
test dict-20.2 {dict merge command} {
- getOrder [dict merge {a b c d e f}] a c e
-} {a b c d e f 3}
+ dict merge {a b c d e f}
+} {a b c d e f}
test dict-20.3 {dict merge command} -body {
dict merge {a b c d e}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.4 {dict merge command} {
- getOrder [dict merge {a b c d} {e f g h}] a c e g
-} {a b c d e f g h 4}
+ dict merge {a b c d} {e f g h}
+} {a b c d e f g h}
test dict-20.5 {dict merge command} -body {
dict merge {a b c d e} {e f g h}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.6 {dict merge command} -body {
dict merge {a b c d} {e f g h i}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.7 {dict merge command} {
- getOrder [dict merge {a b c d e f} {e x g h}] a c e g
-} {a b c d e x g h 4}
+ dict merge {a b c d e f} {e x g h}
+} {a b c d e x g h}
test dict-20.8 {dict merge command} {
- getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+ dict merge {a b c d} {a x c y}
+} {a x c y}
test dict-20.9 {dict merge command} {
- getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+ dict merge {a b c d} {c y a x}
+} {a x c y}
test dict-20.10 {dict merge command} {
- getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3
-} {a - c d e f 1 - 3 4 5}
+ 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} -body {
+test dict-21.1 {dict update command} -returnCodes 1 -body {
dict update
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.2 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.2 {dict update command} -returnCodes 1 -body {
dict update v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.3 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.3 {dict update command} -returnCodes 1 -body {
dict update v k
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.4 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.4 {dict update command} -returnCodes 1 -body {
dict update v k v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.5 {dict update command} {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.5 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -936,8 +1247,10 @@ test dict-21.5 {dict update command} {
lappend result $a $bb
}
lappend result $a
-} {{b c} c {b c}}
-test dict-21.6 {dict update command} {
+} -cleanup {
+ unset a result bb
+} -result {{b c} c {b c}}
+test dict-21.6 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -945,8 +1258,10 @@ test dict-21.6 {dict update command} {
lappend result $a $bb [set bb d]
}
lappend result $a
-} {{b c} c d {b d}}
-test dict-21.7 {dict update command} {
+} -cleanup {
+ unset a result bb
+} -result {{b c} c d {b d}}
+test dict-21.7 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -954,44 +1269,56 @@ test dict-21.7 {dict update command} {
lappend result $a $bb [unset bb]
}
lappend result $a
-} {{b c} c {} {}}
-test dict-21.8 {dict update command} {
+} -cleanup {
+ unset a result
+} -result {{b c} c {} {}}
+test dict-21.8 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {
lassign "$v1 $v2" v2 v1
}
- getOrder $a b d
-} {b e d c 2}
-test dict-21.9 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b e d c}
+test dict-21.9 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {unset a}
info exist a
-} 0
-test dict-21.10 {dict update command} {
+} -cleanup {
+ unset v1 v2
+} -result 0
+test dict-21.10 {dict update command} -body {
set a {b {c d}}
dict update a b v1 {
dict update v1 c v2 {
set v2 foo
}
}
- set a
-} {b {c foo}}
-test dict-21.11 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b {c foo}}
+test dict-21.11 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {
dict set a f g
}
- getOrder $a b d f
-} {b c d e f g 3}
-test dict-21.12 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b c d e f g}
+test dict-21.12 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 f v3 {
set v3 g
}
- getOrder $a b d f
-} {b c d e f g 3}
+ return $a
+} -cleanup {
+ unset a v1 v2 v3
+} -result {b c d e f g}
test dict-21.13 {dict update command: compilation} {
- proc dicttest {d} {
+ apply {d {
while 1 {
dict update d a alpha b beta {
set beta $alpha
@@ -1000,9 +1327,52 @@ test dict-21.13 {dict update command: compilation} {
}
}
return $d
+ }} {a 1 c 2}
+} {c 2 b 1}
+test dict-21.14 {dict update command: compilation} {
+ apply {x {
+ set indices {2 3}
+ trace add variable aa write "string length \$indices ;#"
+ dict update x k aa l bb {}
+ }} {k 1 l 2}
+} {}
+test dict-21.15 {dict update command: compilation} {
+ apply {x {
+ set indices {2 3}
+ trace add variable aa read "string length \$indices ;#"
+ dict update x k aa l bb {}
+ }} {k 1 l 2}
+} {}
+test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body {
+ set foo {a {b {c {d {e 1}}}}}
+ dict update foo a t {
+ dict update t b t {
+ dict update t c t {
+ dict update t d t {
+ dict incr t e
+ }
+ }
+ }
}
- getOrder [dicttest {a 1 c 2}] b c
-} {b 1 c 2 2}
+ string range [append foo OK] end-1 end
+} -cleanup {
+ unset foo t
+} -result OK
+test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
+ apply {{} {
+ set foo {a {b {c {d {e 1}}}}}
+ dict update foo a t {
+ dict update t b t {
+ dict update t c t {
+ dict update t d t {
+ dict incr t e
+ }
+ }
+ }
+ }
+ string range [append foo OK] end-1 end
+ }}
+} OK
test dict-22.1 {dict with command} -body {
dict with
@@ -1014,53 +1384,65 @@ test dict-22.3 {dict with command} -body {
unset -nocomplain v
dict with v {error "in body"}
} -returnCodes 1 -result {can't read "v": no such variable}
-test dict-22.4 {dict with command} {
+test dict-22.4 {dict with command} -body {
set a {b c d e}
unset -nocomplain b d
set result [list [info exist b] [info exist d]]
dict with a {
lappend result [info exist b] [info exist d] $b $d
}
- set result
-} {0 0 1 1 c e}
-test dict-22.5 {dict with command} {
+ return $result
+} -cleanup {
+ unset a b d result
+} -result {0 0 1 1 c e}
+test dict-22.5 {dict with command} -body {
set a {b c d e}
dict with a {
lassign "$b $d" d b
}
- getOrder $a b d
-} {b e d c 2}
-test dict-22.6 {dict with command} {
+ return $a
+} -cleanup {
+ unset a b d
+} -result {b e d c}
+test dict-22.6 {dict with command} -body {
set a {b c d e}
dict with a {
unset b
# This *won't* go into the dict...
set f g
}
- set a
-} {d e}
-test dict-22.7 {dict with command} {
+ return $a
+} -cleanup {
+ unset a d f
+} -result {d e}
+test dict-22.7 {dict with command} -body {
set a {b c d e}
dict with a {
dict unset a b
}
- getOrder $a b d
-} {b c d e 2}
-test dict-22.8 {dict with command} {
+ return $a
+} -cleanup {
+ unset a
+} -result {d e b c}
+test dict-22.8 {dict with command} -body {
set a [dict create b c]
dict with a {
set b $a
}
- set a
-} {b {b c}}
-test dict-22.9 {dict with command} {
+ return $a
+} -cleanup {
+ unset a b
+} -result {b {b c}}
+test dict-22.9 {dict with command} -body {
set a {b {c d}}
dict with a b {
set c $c$c
}
- set a
-} {b {c dd}}
-test dict-22.10 {dict with command: result handling tricky case} {
+ return $a
+} -cleanup {
+ unset a c
+} -result {b {c dd}}
+test dict-22.10 {dict with command: result handling tricky case} -body {
set a {b {c d}}
foreach i {0 1} {
if {$i} break
@@ -1071,8 +1453,523 @@ test dict-22.10 {dict with command: result handling tricky case} {
}
}
list $i $a
-} {0 {}}
+} -cleanup {
+ unset a i c
+} -result {0 {}}
+test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body {
+ set foo {t {t {t {inner 1}}}}
+ dict with foo {
+ dict with t {
+ dict with t {
+ dict with t {
+ incr inner
+ }
+ }
+ }
+ }
+ string range [append foo OK] end-1 end
+} -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} {
+ # 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} {
+ 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-23.3 {CompileWord OBOE} {
+ # segfault when buggy
+ apply {{} {tcl::dict::lappend foo bar \
+ [format baz]}}
+} {bar baz}
+test dict-23.4 {CompileWord OBOE} {
+ apply {n {
+ dict set foo {*}{
+ } [return [incr n -[linenumber]]] val
+ }} [linenumber]
+} 1
+test dict-23.5 {CompileWord OBOE} {
+ # segfault when buggy
+ apply {{} {tcl::dict::incr foo \
+ [format bar]}}
+} {bar 1}
+test dict-23.6 {CompileWord OBOE} {
+ apply {n {
+ dict get {a b} {*}{
+ } [return [incr n -[linenumber]]]
+ }} [linenumber]
+} 1
+test dict-23.7 {CompileWord OBOE} {
+ apply {n {
+ dict for {a b} [return [incr n -[linenumber]]] {*}{
+ } {}
+ }} [linenumber]
+} 2
+test dict-23.8 {CompileWord OBOE} {
+ apply {n {
+ dict update foo {*}{
+ } [return [incr n -[linenumber]]] x {}
+ }} [linenumber]
+} 1
+test dict-23.9 {CompileWord OBOE} {
+ apply {n {
+ dict exists {} {*}{
+ } [return [incr n -[linenumber]]]
+ }} [linenumber]
+} 1
+test dict-23.10 {CompileWord OBOE} {
+ apply {n {
+ dict with foo {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.11 {CompileWord OBOE} {
+ apply {n {
+ dict with ::foo {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.12 {CompileWord OBOE} {
+ apply {n {
+ dict with {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.13 {CompileWord OBOE} {
+ apply {n {
+ dict with {*}{
+ } [return [incr n -[linenumber]]] {bar}
+ }} [linenumber]
+} 1
+test dict-23.14 {CompileWord OBOE} {
+ apply {n {
+ dict with foo {*}{
+ } [return [incr n -[linenumber]]] {bar}
+ }} [linenumber]
+} 1
+
+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
return
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 dc4fd8c..0374e2d 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -1,50 +1,63 @@
# 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.23 2005/05/10 18:35:18 kennykb 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 eval ::tcl::test::encoding {
+ variable x
+
namespace import -force ::tcltest::*
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+}
+
proc toutf {args} {
- global x
+ variable x
lappend x "toutf $args"
}
proc fromutf {args} {
- global x
+ variable x
lappend x "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 toutf 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 toutf fromutf
+ 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] \
@@ -54,70 +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 [testencoding path]
+ set path [encoding dirs]
+} -constraints {testencoding} -body {
encoding system shiftjis ;# incr ref count
- testencoding path [list [pwd]]
+ 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
- testencoding path $path
+ 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 [testencoding path]
- testencoding path {}
+ set path [encoding dirs]
+ encoding dirs {}
catch {unset encodings}
catch {unset x}
+} -body {
foreach encoding [encoding names] {
set encodings($encoding) 1
}
- testencoding path [list [file join [pwd] encoding]]
+ 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
}
}
- testencoding path $path
+ 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
@@ -125,20 +145,22 @@ test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
} {0}
test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
- testencoding create foo {toutf 1} {fromutf 2}
+ testencoding create foo [namespace code {toutf 1}] \
+ [namespace code {fromutf 2}]
set x {}
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 {toutf a} {fromutf b}
+ testencoding create foo [namespace code {toutf a}] \
+ [namespace code {fromutf b}]
set x {}
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} {
@@ -164,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} {
@@ -192,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} {
@@ -209,11 +231,12 @@ proc viewable {str} {
test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
set system [encoding system]
- set path [testencoding path]
+ set path [encoding dirs]
encoding system iso8859-1
- testencoding path {}
+ encoding dirs {}
+ llength jis0208 ;# Shimmer any cached Tcl_Encoding in shared literal
set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
- testencoding path $path
+ encoding dirs $path
encoding system $system
lappend x [encoding convertto jis0208 \u4e4e]
} {1 {unknown encoding "jis0208"} 8C}
@@ -232,27 +255,28 @@ 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 [testencoding path]
+ set path [encoding dirs]
encoding system identity
+} -body {
cd [temporaryDirectory]
- testencoding path [file join tmp encoding]
+ encoding dirs [file join tmp encoding]
makeDirectory tmp
makeDirectory [file join tmp encoding]
set f [open [file join tmp encoding splat.enc] w]
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]
- testencoding path $path
+ 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.
@@ -290,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]
@@ -298,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]
@@ -307,8 +329,9 @@ test encoding-15.3 {UtfToUtfProc null character input} {
} {1 2 c080}
test encoding-16.1 {UnicodeToUtfProc} {
- encoding convertfrom unicode NN
-} "\u4e4e"
+ set val [encoding convertfrom unicode NN]
+ list $val [format %x [scan $val %c]]
+} "\u4e4e 4e4e"
test encoding-17.1 {UtfToUnicodeProc} {
} {}
@@ -328,14 +351,14 @@ test encoding-21.1 {EscapeToUtfProc} {
test encoding-22.1 {EscapeFromUtfProc} {
} {}
-set ::iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
+set iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
\u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B
\u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
\u001b\$B\$7\$g\$&\$+!)\u001b(B"
-set ::iso2022uniData [encoding convertfrom iso2022-jp $::iso2022encData]
-set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
+set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
+set iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
\u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a
\u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08
\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
@@ -344,11 +367,11 @@ set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3
cd [temporaryDirectory]
set fid [open iso2022.txt w]
fconfigure $fid -encoding binary
-puts -nonewline $fid $::iso2022encData
+puts -nonewline $fid $iso2022encData
close $fid
test encoding-23.1 {iso2022-jp escape encoding test} {
- string equal $::iso2022uniData $::iso2022uniData2
+ string equal $iso2022uniData $iso2022uniData2
} 1
test encoding-23.2 {iso2022-jp escape encoding test} {
# This checks that 'gets' isn't resetting the encoding inappropriately.
@@ -366,54 +389,52 @@ test encoding-23.2 {iso2022-jp escape encoding test} {
incr count $num
}
close $fid
- if {[string compare $::iso2022uniData $out]} {
+ if {[string compare $iso2022uniData $out]} {
return -code error "iso2022-jp read in doesn't match original"
}
list $count $out
-} [list [string length $::iso2022uniData] $::iso2022uniData]
+} [list [string length $iso2022uniData] $iso2022uniData]
test encoding-23.3 {iso2022-jp escape encoding test} {
# read $fis <size> reads size in chars, not raw bytes.
set fid [open iso2022.txt r]
fconfigure $fid -encoding iso2022-jp
set data [read $fid 50]
close $fid
- set data
-} [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
+ 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
+ set env(TCL_FINALIZE_ON_EXIT) 1
exit
- } 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)"
-
+ }]
+} "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
@@ -457,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)}]
@@ -512,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.
@@ -531,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]
@@ -540,41 +558,53 @@ 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 {expand}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
+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
+
+}
# cleanup
+namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/env.test b/tests/env.test
index 24dc2e3..83d99e0 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -1,17 +1,15 @@
# Commands covered: none (tests environment variable implementation)
#
-# 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: env.test,v 1.21 2005/05/24 04:44:08 das 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 2
@@ -23,74 +21,90 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint exec [llength [info commands exec]]
#
-# These tests will run on any platform (and indeed crashed
-# on the Mac). So put them before you test for the existance
-# of exec.
+# These tests will run on any platform (and indeed crashed on the Mac). So put
+# them before you test for the existance of exec.
#
-test env-1.1 {propagation of env values to child interpreters} {
+test env-1.1 {propagation of env values to child interpreters} -setup {
catch {interp delete child}
catch {unset env(test)}
+} -body {
interp create child
set env(test) garbage
- set return [child eval {set env(test)}]
+ child eval {set env(test)}
+} -cleanup {
interp delete child
unset env(test)
- set return
-} {garbage}
+} -result {garbage}
#
-# This one crashed on Solaris under Tcl8.0, so we only
-# want to make sure it runs.
+# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
+# runs.
#
-test env-1.2 {lappend to env value} {
+test env-1.2 {lappend to env value} -setup {
catch {unset env(test)}
+} -body {
set env(test) aaaaaaaaaaaaaaaa
append env(test) bbbbbbbbbbbbbb
unset env(test)
-} {}
-test env-1.3 {reflection of env by "array names"} {
+}
+test env-1.3 {reflection of env by "array names"} -setup {
catch {interp delete child}
catch {unset env(test)}
+} -body {
interp create child
child eval {set env(test) garbage}
- set names [array names env]
+ expr {"test" in [array names env]}
+} -cleanup {
interp delete child
- set ix [lsearch $names test]
catch {unset env(test)}
- expr {$ix >= 0}
-} {1}
+} -result {1}
set printenvScript [makeFile {
+ encoding system iso8859-1
proc lrem {listname name} {
upvar $listname list
- set i [lsearch $list $name]
+ set i [lsearch -nocase $list $name]
if {$i >= 0} {
set list [lreplace $list $i $i]
}
return $list
}
-
+ proc mangle s {
+ regsub -all {\[|\\|\]} $s {\\&} s
+ regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
+ return [subst -novariables $s]
+ }
+ proc manglechar c {
+ return [format {\u%04x} [scan $c %c]]
+ }
+
set names [lsort [array names env]]
- if {$tcl_platform(platform) == "windows"} {
+ if {$tcl_platform(platform) eq "windows"} {
lrem names HOME
lrem names COMSPEC
lrem names ComSpec
lrem names ""
- }
- foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH __CF_USER_TEXT_ENCODING } {
+ }
+ foreach name {
+ TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
+ 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 CommonProgramW6432 ProgramW6432
+ } {
lrem names $name
}
foreach p $names {
- puts "$p=$env($p)"
+ puts "[mangle $p]=[mangle $env($p)]"
}
exit
} printenv]
-
-# [exec] is required here to see the actual environment received
-# by child processes.
+
+# [exec] is required here to see the actual environment received by child
+# processes.
proc getenv {} {
global printenvScript tcltest
catch {exec [interpreter] $printenvScript} out
- if {$out == "child process exited abnormally"} {
+ if {$out eq "child process exited abnormally"} {
set out {}
}
return $out
@@ -98,151 +112,220 @@ proc getenv {} {
# Save the current environment variables at the start of the test.
+set env2 [array get env]
foreach name [array names env] {
- set env2($name) $env($name)
- unset env($name)
-}
-
-# Added the following lines so that child tcltest can actually find its
-# library if the initial tcltest is run from a non-standard place.
-# ('saved' env vars)
-foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH} {
- if {[info exists env2($name)]} {
- set env($name) $env2($name);
+ # Keep some environment variables that support operation of the tcltest
+ # package.
+ if {[string toupper $name] ni {
+ TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
+ SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
+ DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
+ SECURITYSESSIONID LANG WINDIR TERM
+ CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
+ }} {
+ unset env($name)
}
}
-test env-2.1 {adding environment variables} {exec} {
- getenv
-} {}
+# Need to run 'getenv' in known encoding, so save the current one here...
+set sysenc [encoding system]
-set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {exec} {
+test env-2.1 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
getenv
-} {NAME1=test string}
-
-set env(NAME2) "more"
-test env-2.3 {adding environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {}
+test env-2.2 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(NAME1) "test string"
+ getenv
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string}
+test env-2.3 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(NAME2) "more"
getenv
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=more}
-
-set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {exec} {
+test env-2.4 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(XYZZY) "garbage"
getenv
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {exec} {
+test env-3.1 {changing environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set result [getenv]
unset env(NAME2)
set result
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
-test env-4.1 {unsetting environment variables} {exec} {
- set result [getenv]
- unset env(NAME1)
- set result
-} {NAME1=test string
+test env-4.1 {unsetting environment variables: default} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ getenv
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
XYZZY=garbage}
-
-test env-4.2 {unsetting environment variables} {exec} {
- set result [getenv]
+test env-4.2 {unsetting environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ unset env(NAME1)
+ getenv
+} -cleanup {
unset env(XYZZY)
- set result
-} {XYZZY=garbage}
-
-test env-4.3 {setting international environment variables} {exec} {
+ encoding system $sysenc
+} -result {XYZZY=garbage}
+test env-4.3 {setting international environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set env(\ua7) \ub6
getenv
-} "\ua7=\ub6"
-test env-4.4 {changing international environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {\u00a7=\u00b6}
+test env-4.4 {changing international environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set env(\ua7) \ua7
getenv
-} "\ua7=\ua7"
-test env-4.5 {unsetting international environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {\u00a7=\u00a7}
+test env-4.5 {unsetting international environment variables} -setup {
+ encoding system iso8859-1
+} -body {
set env(\ub6) \ua7
unset env(\ua7)
- set result [getenv]
+ getenv
+} -constraints {exec} -cleanup {
unset env(\ub6)
- set result
-} "\ub6=\ua7"
+ encoding system $sysenc
+} -result {\u00b6=\u00a7}
-test env-5.0 {corner cases - set a value, it should exist} {} {
+test env-5.0 {corner cases - set a value, it should exist} -body {
set env(temp) a
- set result [set env(temp)]
+ set env(temp)
+} -cleanup {
unset env(temp)
- set result
-} {a}
-test env-5.1 {corner cases - remove one elem at a time} {} {
- # When no environment variables exist, the env var will
- # contain no entries. The "array names" call synchs up
- # the C-level environ array with the Tcl level env array.
- # Make sure an empty Tcl array is created.
-
+} -result {a}
+test env-5.1 {corner cases - remove one elem at a time} -setup {
set x [array get env]
+} -body {
+ # When no environment variables exist, the env var will contain no
+ # entries. The "array names" call synchs up the C-level environ array with
+ # the Tcl level env array. Make sure an empty Tcl array is created.
foreach e [array names env] {
unset env($e)
}
- set result [catch {array names env}]
+ array size env
+} -cleanup {
array set env $x
- set result
-} {0}
-test env-5.2 {corner cases - unset the env array} {} {
- # Unsetting a variable in an interp detaches the C-level
- # traces from the Tcl "env" variable.
-
- interp create i
- i eval { unset env }
- i eval { set env(THIS_SHOULDNT_EXIST) a}
- set result [info exists env(THIS_SHOULDNT_EXIST)]
+} -result {0}
+test env-5.2 {corner cases - unset the env array} -setup {
+ interp create i
+} -body {
+ # Unsetting a variable in an interp detaches the C-level traces from the
+ # Tcl "env" variable.
+ i eval {
+ unset env
+ set env(THIS_SHOULDNT_EXIST) a
+ }
+ info exists env(THIS_SHOULDNT_EXIST)
+} -cleanup {
interp delete i
- set result
-} {0}
-test env-5.3 {corner cases - unset the env in master should unset child} {} {
- # Variables deleted in a master interp should be deleted in
- # child interp too.
-
- interp create i
+} -result {0}
+test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+ interp create i
+} -body {
+ # Variables deleted in a master interp should be deleted in child interp
+ # too.
i eval { set env(THIS_SHOULD_EXIST) a}
set result [set env(THIS_SHOULD_EXIST)]
unset env(THIS_SHOULD_EXIST)
lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
+} -cleanup {
interp delete i
- set result
-} {a 1}
-test env-5.4 {corner cases - unset the env array} {} {
+} -result {a 1}
+test env-5.4 {corner cases - unset the env array} -setup {
+ interp create i
+} -body {
# The info exists command should be in synch with the env array.
# Know Bug: 1737
-
- interp create i
i eval { set env(THIS_SHOULD_EXIST) a}
set result [info exists env(THIS_SHOULD_EXIST)]
lappend result [set env(THIS_SHOULD_EXIST)]
lappend result [info exists env(THIS_SHOULD_EXIST)]
+} -cleanup {
interp delete i
- set result
-} {1 a 1}
+} -result {1 a 1}
test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
set env() a
catch {set env()}
} {1}
+test env-6.1 {corner cases - add lots of env variables} {} {
+ set size [array size env]
+ for {set i 0} {$i < 100} {incr i} {
+ set env(BOGUS$i) $i
+ }
+ expr {[array size env] - $size}
+} 100
+
+test env-7.1 {[219226]: whole env array should not be unset by read} {
+ set n [array size env]
+ set s [array startsearch env]
+ while {[array anymore env $s]} {
+ array nextelement env $s
+ incr n -1
+ }
+ array donesearch env $s
+ return $n
+} 0
+test env-7.2 {[219226]: links to env elements should not be removed by read} {
+ apply {{} {
+ set ::env(test7_2) ok
+ upvar env(test7_2) elem
+ set ::env(PATH)
+ try {
+ return $elem
+ } finally {
+ unset ::env(test7_2)
+ }
+ }}
+} ok
# Restore the environment variables at the end of the test.
foreach name [array names env] {
unset env($name)
}
-foreach name [array names env2] {
- set env($name) $env2($name)
-}
+array set env $env2
# cleanup
removeFile $printenvScript
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/error.test b/tests/error.test
index ab35c5d..0de644c 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -1,23 +1,42 @@
-# Commands covered: error, catch
+# Commands covered: error, catch, throw, try
#
-# 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: error.test,v 1.13 2005/07/28 18:42:28 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
+ package require tcltest 2
namespace import -force ::tcltest::*
}
+testConstraint memory [llength [info commands memory]]
+customMatch pairwise {apply {{a b} {
+ string equal [lindex $b 0] [lindex $b 1]
+}}}
+namespace eval ::tcl::test::error {
+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}]
+ }
+}
+
proc foo {} {
global errorInfo
set a [catch {format [error glorp2]} b]
@@ -35,88 +54,74 @@ proc foo2 {} {
test error-1.1 {simple errors from commands} {
catch {format [string index]} b
} 1
-
test error-1.2 {simple errors from commands} {
catch {format [string index]} b
set b
} {wrong # args: should be "string index string charIndex"}
-
test error-1.3 {simple errors from commands} {
catch {format [string index]} b
- set errorInfo
- # this used to return '... while executing ...', but
- # string index is fully compiled as of 8.4a3
+ set ::errorInfo
+ # This used to return '... while executing ...', but string index is fully
+ # compiled as of 8.4a3
} {wrong # args: should be "string index string charIndex"
while executing
"string index"}
-
test error-1.4 {simple errors from commands} {
catch {error glorp} b
} 1
-
test error-1.5 {simple errors from commands} {
catch {error glorp} b
set b
} glorp
-
test error-1.6 {simple errors from commands} {
catch {catch a b c d} b
} 1
-
test error-1.7 {simple errors from commands} {
catch {catch a b c d} b
set b
} {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
-
test error-1.8 {simple errors from commands} {
- # This test is non-portable: it generates a memory fault on
- # machines like DEC Alphas (infinite recursion overflows
- # stack?)
+ # This test is non-portable: it generates a memory fault on machines like
+ # DEC Alphas (infinite recursion overflows stack?)
#
# That claims sounds like a bug to be fixed rather than a portability
- # problem. Anyhow, I believe it's out of date (bug's been fixed) so
- # this test is re-enabled.
-
+ # problem. Anyhow, I believe it's out of date (bug's been fixed) so this
+ # test is re-enabled.
proc p {} {
uplevel 1 catch p error
}
p
} 0
-# Check errors nested in procedures. Also check the optional argument
-# to "error" to generate a new error trace.
+# Check errors nested in procedures. Also check the optional argument to
+# "error" to generate a new error trace.
test error-2.1 {errors in nested procedures} {
catch foo b
} 1
-
test error-2.2 {errors in nested procedures} {
catch foo b
set b
} {Human-generated}
-
test error-2.3 {errors in nested procedures} {
catch foo b
- set errorInfo
+ set ::errorInfo
} {Human-generated
while executing
"error {Human-generated}"
(procedure "foo" line 4)
invoked from within
"foo"}
-
test error-2.4 {errors in nested procedures} {
catch foo2 b
} 1
-
test error-2.5 {errors in nested procedures} {
catch foo2 b
set b
} {Human-generated}
-
test error-2.6 {errors in nested procedures} {
catch foo2 b
- set errorInfo
+ set ::errorInfo
} {glorp2
while executing
"error glorp2"
@@ -136,35 +141,58 @@ 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
test error-4.1 {errorInfo and errorCode variables} {
- list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 msg3}
test error-4.2 {errorInfo and errorCode variables} {
- list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 {} msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1 {} msg3"} msg3}
test error-4.3 {errorInfo and errorCode variables} {
- list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode
+ list [catch {error msg1 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1 {}"} NONE}
test error-4.4 {errorInfo and errorCode variables} {
- set errorCode bogus
- list [catch {error msg1} msg] $msg $errorInfo $errorCode
+ set ::errorCode bogus
+ list [catch {error msg1} msg] $msg $::errorInfo $::errorCode
} {1 msg1 {msg1
while executing
"error msg1"} NONE}
test error-4.5 {errorInfo and errorCode variables} {
- set errorCode bogus
- list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode
+ set ::errorCode bogus
+ list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 {}}
+test error-4.6 {errorstack via info } -body {
+ proc f x {g $x$x}
+ proc g x {error G:$x}
+ catch {f 12}
+ info errorstack
+} -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 {INNER * CALL {g 1212} CALL {f 12} UP 1}
+test error-4.8 {errorstack from exec traces} -body {
+ proc foo args {}
+ proc goo {} foo
+ trace add execution foo enter {error bar;#}
+ catch goo m d
+ dict get $d -errorstack
+} -cleanup {
+ rename goo {}; rename foo {}
+ unset -nocomplain m d
+} -result {INNER {error bar} CALL goo UP 1}
+
# Errors in error command itself
test error-5.1 {errors in error command} {
@@ -178,49 +206,1000 @@ test error-5.2 {errors in error command} {
test error-6.1 {catch must reset error state} {
catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.2 {catch must reset error state} {
catch {error outer [catch {return -level 0 -code error -errorcode BUG}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.3 {catch must reset error state} {
- set errorCode BUG
+ set ::errorCode BUG
catch {error outer [catch set]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.4 {catch must reset error state} {
catch {error [catch {error foo bar baz}] 1}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.5 {catch must reset error state} {
catch {error [catch {return -level 0 -code error -errorcode BUG}] 1}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.6 {catch must reset error state} {
catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]}
- list $errorCode $errorInfo
+ list $::errorCode $::errorInfo
} {NONE 1}
test error-6.7 {catch must reset error state} {
proc foo {} {
return -code error -errorinfo [catch {error foo bar baz}]
}
catch foo
- list $errorCode
+ list $::errorCode
} {NONE}
test error-6.8 {catch must reset error state} {
catch {return -level 0 -code error [catch {error foo bar baz}]}
- list $errorCode
+ list $::errorCode
} {NONE}
test error-6.9 {catch must reset error state} {
proc foo {} {
return -code error [catch {error foo bar baz}]
}
catch foo
- list $errorCode
+ list $::errorCode
} {NONE}
+test error-6.10 {catch must reset errorstack} -body {
+ proc f x {g $x$x}
+ proc g x {error G:$x}
+ catch {f 12}
+ set e1 [info errorstack]
+ catch {f 13}
+ set e2 [info errorstack]
+ list $e1 $e2
+} -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
+ proc EIWrite args {
+ variable cmds
+ lappend cmds [lindex [info level -2] 0]
+ }
+ proc BadProc {} {
+ set i a
+ incr i
+ }
+ trace add variable ::errorInfo write [namespace code EIWrite]
+ catch BadProc
+ trace remove variable ::errorInfo write [namespace code EIWrite]
+ set cmds
+} -match glob -result {*BadProc*}
+
+# throw tests
+
+test error-8.1 {throw produces error 1 at level 0} {
+ catch { throw FOO bar }
+} {1}
+test error-8.2 {throw behaves as error does at level 0} {
+ catch { throw FOO bar } em1 opts1
+ catch { error bar {} FOO } em2 opts2
+ dict set opts1 -result $em1
+ dict set opts2 -result $em2
+ foreach key {-code -level -result -errorcode} {
+ if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+ error "error/throw outcome differs on '$key'"
+ }
+ }
+} {}
+test error-8.3 {throw produces error 1 at level > 0} {
+ proc throw_foo {} {
+ throw FOO bar
+ }
+ catch { throw_foo }
+} {1}
+test error-8.4 {throw behaves as error does at level > 0} {
+ proc throw_foo {} {
+ throw FOO bar
+ }
+ proc error_foo {} {
+ error bar {} FOO
+ }
+ catch { throw_foo } em1 opts1
+ catch { error_foo } em2 opts2
+ dict set opts1 -result $em1
+ dict set opts2 -result $em2
+ foreach key {-code -level -result -errorcode} {
+ if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+ error "error/throw outcome differs on '$key'"
+ }
+ }
+} {}
+test error-8.5 {throw syntax checks} -returnCodes error -body {
+ throw
+} -result {wrong # args: should be "throw type message"}
+test error-8.6 {throw syntax checks} -returnCodes error -body {
+ throw a
+} -result {wrong # args: should be "throw type message"}
+test error-8.7 {throw syntax checks} -returnCodes error -body {
+ throw a b c
+} -result {wrong # args: should be "throw type message"}
+test error-8.8 {throw syntax checks} -returnCodes error -body {
+ throw "not a \{ list" foo
+} -result {unmatched open brace in list}
+test error-8.9 {throw syntax checks} -returnCodes error -body {
+ throw {} foo
+} -result {type must be non-empty list}
+test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body {
+ apply {code {throw $code foo}} {}
+} -result {type must be non-empty list}
+test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error -body {
+ throw {not {}a list} x[]y
+} -result {list element in braces followed by "a" instead of space}
+
+# simple try tests: body completes with code ok
+
+test error-9.1 {try (ok, empty result) with no handlers} {
+ try list
+} {}
+test error-9.2 {try (ok, non-empty result) with no handlers} {
+ try { list a b c }
+} {a b c}
+test error-9.3 {try (ok, non-empty result) with trap handler} {
+ try { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-9.4 {try (ok, non-empty result) with on handler} {
+ try { list a b c } on break {} { list d e f }
+} {a b c}
+test error-9.5 {try (ok, non-empty result) with on ok handler} {
+ try { list a b c } on ok {} { list d e f }
+} {d e f}
+
+# simple try tests - "on" handler matching
+
+test error-10.1 {try with on ok} {
+ try { list a b c } on ok {} { list d e f }
+} {d e f}
+test error-10.2 {try with on 0} {
+ try { list a b c } on 0 {} { list d e f }
+} {d e f}
+test error-10.3 {try with on error (using error)} {
+ try { error a b c } on error {} { list d e f }
+} {d e f}
+test error-10.4 {try with on error (using return -code)} {
+ try { return -level 0 -code 1 a } on error {} { list d e f }
+} {d e f}
+test error-10.5 {try with on error (using throw)} {
+ try { throw c a } on error {} { list d e f }
+} {d e f}
+test error-10.6 {try with on 1 (using error)} {
+ try { error a b c } on 1 {} { list d e f }
+} {d e f}
+test error-10.7 {try with on return} {
+ try { return [list a b c] } on return {} { list d e f }
+} {d e f}
+test error-10.8 {try with on break} {
+ try { break } on break {} { list d e f }
+} {d e f}
+test error-10.9 {try with on continue} {
+ try { continue } on continue {} { list d e f }
+} {d e f}
+test error-10.10 {try with on for arbitrary (decimal) return code} {
+ try { return -level 0 -code 123456 } on 123456 {} { list d e f }
+} {d e f}
+test error-10.11 {try with on for arbitrary (hex) return code} {
+ try { return -level 0 -code 0x123456 } on 0x123456 {} { list d e f }
+} {d e f}
+test error-10.12 {try with on for arbitrary return code (mixed number representations)} {
+ try { return -level 0 -code 0x10 } on 16 {} { list d e f }
+} {d e f}
+
+# simple try tests - "trap" handler matching
+
+test error-11.1 {try with trap all} {
+ try { throw FOO bar } trap {} {} { list d e f }
+} {d e f}
+test error-11.2 {try with trap (exact)} {
+ try { throw FOO bar } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.3 {try with trap (prefix 1)} {
+ try { throw [list FOO A B C D] bar } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.4 {try with trap (prefix 2)} {
+ try { throw [list FOO A B C D] bar } trap {FOO A} {} { list d e f }
+} {d e f}
+test error-11.5 {try with trap (prefix 3)} {
+ try { throw [list FOO A B C D] bar } trap {FOO A B} {} { list d e f }
+} {d e f}
+test error-11.6 {try with trap (prefix 4)} {
+ try { throw [list FOO A B C D] bar } trap {FOO A B C} {} { list d e f }
+} {d e f}
+test error-11.7 {try with trap (exact, 5 elements)} {
+ try { throw [list FOO A B C D] bar } trap {FOO A B C D} {} { list d e f }
+} {d e f}
+
+# simple try tests - variable assignment and result handling
+
+test error-12.1 {try with no variable assignment in on handler} {
+ try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+test error-12.2 {try with result variable assignment in on handler} {
+ try { throw FOO bar } on error {res} { set res }
+} {bar}
+test error-12.3 {try with result variable assignment in on handler, var remains in scope} {
+ try { throw FOO bar } on error {res} { list d e f }
+ set res
+} {bar}
+test error-12.4 {try with result/opts variable assignment in on handler} {
+ try {
+ throw FOO bar
+ } on error {res opts} {
+ set r "$res,[dict get $opts -errorcode]"
+ }
+} {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]"
+} {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 }
+} {a b c}
+test error-12.7 {handler result is propagated if handler executes} {
+ try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+
+# negative case try tests - bad args to try
+
+test error-13.1 {try with no arguments} -body {
+ # warning: error message may change
+ try
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.2 {try with body only (ok)} {
+ try list
+} {}
+test error-13.3 {try with missing finally body} -body {
+ # warning: error message may change
+ try list finally
+} -returnCodes error -match glob -result {wrong # args to finally clause: *}
+test error-13.4 {try with bad handler keyword} -body {
+ # warning: error message may change
+ try list then a b c
+} -returnCodes error -match glob -result {bad handler *}
+test error-13.5 {try with partial handler #1} -body {
+ # warning: error message may change
+ try list on
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+test error-13.6 {try with partial handler #2} -body {
+ # warning: error message may change
+ try list on error
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+test error-13.7 {try with partial handler #3} -body {
+ # warning: error message may change
+ try list on error {em opts}
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+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 {} -
+} -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 }
+} -returnCodes error -result {last non-finally clause must not have a body of "-"}
+
+# try tests - multiple handlers (left-to-right matching, only one runs)
+
+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 }
+} {d e f}
+test error-14.3 {try with multiple handlers (only one matches) #3} {
+ try {
+ throw FOO bar
+ } on break {} {
+ list x y z
+ } trap FOO {} {
+ 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 }
+} {a b c}
+test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} {
+ try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c }
+} {d e f}
+test error-14.6 {try with multiple matching handlers (only the first in left-to-right order runs) #3} {
+ try { throw FOO bar } trap {} {} { list d e f } on 1 {} { list a b c }
+} {d e f}
+test error-14.7 {try with multiple matching handlers (only the first in left-to-right order runs) #4} {
+ try { throw FOO bar } on 1 {} { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-14.8 {try with handler-of-last-resort "trap {}"} {
+ try { throw FOO bar } trap FOX {} { list a b c } trap {} {} { list d e f }
+} {d e f}
+test error-14.9 {try with handler-of-last-resort "on error"} {
+ try { foo } trap FOX {} { list a b c } on error {} { list d e f }
+} {d e f}
+
+# try tests - propagation (no matching handlers)
+
+test error-15.1 {try with no handler (ok result propagates)} {
+ try { list a b c }
+} {a b c}
+test error-15.2 {try with no matching handler (ok result propagates)} {
+ try { list a b c } on error {} { list d e f }
+} {a b c}
+test error-15.3 {try with no handler (error result propagates)} -body {
+ try { throw FOO bar }
+} -returnCodes error -result {bar}
+test error-15.4 {try with no matching handler (error result propagates)} -body {
+ try { throw FOO bar } trap FOX {} { list a b c }
+} -returnCodes error -result {bar}
+test error-15.5 {try with no handler (return result propagates)} -body {
+ try { return bar }
+} -returnCodes 2 -result {bar}
+test error-15.6 {try with no matching handler (break result propagates)} -body {
+ try { if {1} break } on error {} { list a b c }
+} -returnCodes 3 -result {}
+test error-15.7 {try with no matching handler (unknown integer result propagates)} -body {
+ try { return -level 0 -code 123456 } trap {} {} { list a b c }
+} -returnCodes 123456 -result {}
+
+foreach level {0 1 2 3} {
+ foreach code {0 1 2 3 4 5} {
+
+ # Following cases have different -errorinfo; avoid false alarms
+ # TODO: examine whether these difference are as they ought to be.
+ if {$level == 0 && $code == 1} continue
+
+ foreach extras {{} {-bar soom}} {
+
+test error-15.8.$level.$code.[llength $extras] {[try] coverage} {
+ set script {return -level $level -code $code {*}$extras foo}
+ catch $script m1 o1
+ catch {try $script} m2 o2
+ set o1 [lsort -stride 2 $o1]
+ set o2 [lsort -stride 2 $o2]
+ expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+test error-15.9.$level.$code.[llength $extras] {[try] coverage} {
+ set script {return -level $level -code $code {*}$extras foo}
+ catch $script m1 o1
+ catch {try $script finally {}} m2 o2
+ set o1 [lsort -stride 2 $o1]
+ set o2 [lsort -stride 2 $o2]
+ expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+test error-15.10.$level.$code.[llength $extras] {[try] coverage} {
+ set script {return -level $level -code $code {*}$extras foo}
+ catch $script m1 o1
+ catch {try $script on $code {x y} {return -options $y $x}} m2 o2
+ set o1 [lsort -stride 2 $o1]
+ set o2 [lsort -stride 2 $o2]
+ expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+ }
+ }
+}
+
+# try tests - propagation (exceptions in handlers, exception chaining)
+
+test error-16.1 {try with successfully executed handler} {
+ try { throw FOO bar } trap FOO {} { list a b c }
+} {a b c}
+test error-16.2 {try with exception (error) in handler} -body {
+ try { throw FOO bar } trap FOO {} { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-16.3 {try with exception (return) in handler} -body {
+ try { throw FOO bar } trap FOO {} { return BAR }
+} -returnCodes 2 -result {BAR}
+test error-16.4 {try with exception (break) in handler #1} -body {
+ try { throw FOO bar } trap FOO {} { break }
+} -returnCodes 3 -result {}
+test error-16.5 {try with exception (break) in handler #2} {
+ for { set i 5 } { $i < 10 } { incr i } {
+ try { throw FOO bar } trap FOO {} { break }
+ }
+ set i
+} {5}
+test error-16.6 {try with variable assignment and propagation #1} {
+ # Ensure that the handler variables preserve the exception off the
+ # try-body, and are not modified by the exception off the handler
+ catch {
+ try { throw FOO bar } trap FOO {em} { throw BAR baz }
+ }
+ 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]
+} {bar FOO}
+test error-16.8 {exception chaining (try=ok, handler=error)} -body {
+ #FIXME is the intent of this test correct?
+ catch {
+ try { list a b c } on ok {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.9 {exception chaining (try=error, handler=error)} -body {
+ # The exception off the handler should chain to the exception off the
+ # try-body (using the -during option)
+ catch {
+ try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.10 {no exception chaining when handler is successful} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { list d e f }
+ } tryem tryopts
+ dict exists $tryopts -during
+} {0}
+test error-16.11 {no exception chaining when handler is a non-error exception} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { break }
+ } tryem tryopts
+ dict exists $tryopts -during
+} {0}
+test error-16.12 {compiled try with successfully executed handler} {
+ apply {{} {
+ try { throw FOO bar } trap FOO {} { list a b c }
+ }}
+} {a b c}
+test error-16.13 {compiled try with exception (error) in handler} -body {
+ apply {{} {
+ try { throw FOO bar } trap FOO {} { throw BAR foo }
+ }}
+} -returnCodes error -result {foo}
+test error-16.14 {compiled try with exception (return) in handler} -body {
+ apply {{} {
+ list [catch {
+ try { throw FOO bar } trap FOO {} { return BAR }
+ } msg] $msg
+ }}
+} -result {2 BAR}
+test error-16.15 {compiled try with exception (break) in handler} {
+ apply {{} {
+ for { set i 5 } { $i < 10 } { incr i } {
+ try { throw FOO bar } trap FOO {} { break }
+ }
+ return $i
+ }}
+} {5}
+test error-16.16 {compiled try with exception (continue) in handler} {
+ apply {{} {
+ for { set i 5 } { $i < 10 } { incr i } {
+ try { throw FOO bar } trap FOO {} { continue }
+ incr i 20
+ }
+ return $i
+ }}
+} {10}
+test error-16.17 {compiled try with variable assignment and propagation #1} {
+ # Ensure that the handler variables preserve the exception off the
+ # try-body, and are not modified by the exception off the handler
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap FOO {em} { throw BAR baz }
+ }
+ return $em
+ }}
+} {bar}
+test error-16.18 {compiled try with variable assignment and propagation #2} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+ }
+ list $em [dict get $opts -errorcode]
+ }}
+} {bar FOO}
+test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body {
+ #FIXME is the intent of this test correct?
+ apply {{} {
+ catch {
+ try { list a b c } on ok {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+ }}
+} -match pairwise -result equal
+test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body {
+ # The exception off the handler should chain to the exception off the
+ # try-body (using the -during option)
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during]
+ }}
+} -match pairwise -result equal
+test error-16.21 {compiled try exception chaining (try=error, finally=error)} {
+ # The exception off the handler should chain to the exception off the
+ # try-body (using the -during option)
+ apply {{} {
+ catch {
+ try { throw FOO bar } finally { throw BAR baz }
+ } tryem tryopts
+ dict get $tryopts -during -errorcode
+ }}
+} FOO
+test error-16.22 {compiled try: no exception chaining when handler is successful} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { list d e f }
+ } tryem tryopts
+ dict exists $tryopts -during
+ }}
+} {0}
+test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} {
+ apply {{} {
+ catch {
+ try { throw FOO bar } trap {} {em opts} { break }
+ } tryem tryopts
+ dict exists $tryopts -during
+ }}
+} {0}
+test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body {
+ apply {{} {
+ catch {
+ try {
+ list a b c
+ } on ok {em opts} {
+ throw BAR baz
+ } finally {
+ throw DING dong
+ }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during -during]
+ }}
+} -match pairwise -result equal
+test error-16.25 {compiled try exception chaining (all errors)} -body {
+ apply {{} {
+ catch {
+ try {
+ throw FOO bar
+ } on error {em opts} {
+ throw BAR baz
+ } finally {
+ throw DING dong
+ }
+ } tryem tryopts
+ list $opts [dict get $tryopts -during -during]
+ }}
+} -match pairwise -result equal
+
+# try tests - finally
+
+test error-17.1 {finally always runs (try with ok result)} {
+ set RES {}
+ try { list a b c } finally { set RES done }
+ set RES
+} {done}
+test error-17.2 {finally always runs (try with error result)} {
+ set RES {}
+ catch {
+ try { throw FOO bar } finally { set RES done }
+ }
+ set RES
+} {done}
+test error-17.3 {finally always runs (try with matching handler)} {
+ set RES {}
+ try { throw FOO bar } trap FOO {} { list a b c } finally { set RES done }
+ set RES
+} {done}
+test error-17.4 {finally always runs (try with exception in handler)} {
+ set RES {}
+ catch {
+ try {
+ throw FOO bar
+ } trap FOO {} {
+ throw BAR baz
+ } finally {
+ set RES done
+ }
+ }
+ set RES
+} {done}
+test error-17.5 {successful finally doesn't modify try outcome (try=ok)} {
+ try { list a b c } finally { list d e f }
+} {a b c}
+test error-17.6 {successful finally doesn't modify try outcome (try=return)} -body {
+ try { return c } finally { list d e f }
+} -returnCodes 2 -result {c}
+test error-17.7 {successful finally doesn't modify try outcome (try=error)} -body {
+ try { error bar } finally { list d e f }
+} -returnCodes 1 -result {bar}
+test error-17.8 {successful finally doesn't modify handler outcome (handler=ok)} {
+ try { throw FOO bar } trap FOO {} { list a b c } finally { list d e f }
+} {a b c}
+test error-17.9 {successful finally doesn't modify handler outcome (handler=error)} -body {
+ try { throw FOO bar } trap FOO {} { throw BAR baz } finally { list d e f }
+} -returnCodes error -result {baz}
+test error-17.10 {successful finally doesn't affect variable assignment} {
+ catch {
+ try { throw FOO bar } trap FOO {em opts} { list d e f } finally { list d e f }
+ } result
+ list $em $result
+} {bar {d e f}}
+test error-17.11 {successful finally doesn't affect variable assignment or propagation} {
+ catch {
+ try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
+ }
+ list $em [dict get $opts -errorcode]
+} {bar FOO}
+
+# try tests - propagation (exceptions in finally, exception chaining)
+
+test error-18.1 {try (ok) with exception in finally (error)} -body {
+ try { list a b c } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.2 {try (error) with exception in finally (break)} -body {
+ try { throw FOO bar } finally { break }
+} -returnCodes 3 -result {}
+test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body {
+ try { list a b c } on ok {} { list d e f } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body {
+ try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing }
+} -returnCodes 99 -result {zing}
+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]
+} {bar FOO}
+test error-18.6 {exception chaining in finally (try=ok)} -body {
+ catch {
+ list a b c
+ } em expopts
+ catch {
+ try { list a b c } finally { throw BAR foo }
+ } em opts
+ list $expopts [dict get $opts -during]
+} -match pairwise -result equal
+test error-18.7 {exception chaining in finally (try=error)} {
+ catch {
+ try { throw FOO bar } finally { throw BAR baz }
+ } em opts
+ dict get $opts -during -errorcode
+} {FOO}
+test error-18.8 {exception chaining in finally (try=ok, handler=ok)} {
+ catch {
+ try { list a b c } on ok {} { list d e f } finally { throw BAR baz }
+ } em opts
+ list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.9 {exception chaining in finally (try=error, handler=ok)} {
+ catch {
+ try {
+ throw FOO bar
+ } on error {} {
+ list d e f
+ } finally {
+ throw BAR baz
+ }
+ } em opts
+ list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.10 {exception chaining in finally (try=error, handler=error)} {
+ catch {
+ try {
+ throw FOO bar
+ } on error {} {
+ throw BAR baz
+ } finally {
+ throw BAR baz
+ }
+ } em opts
+ list [dict get $opts -during -errorcode] [dict get $opts -during -during -errorcode]
+} {BAR FOO}
+test error-18.11 {no exception chaining if finally produces a non-error exception} {
+ catch {
+ try { throw FOO bar } on error {} { throw BAR baz } finally { break }
+ } em opts
+ dict exists $opts -during
+} {0}
+test error-18.12 {variable assignment unaffected by exception in finally} {
+ catch {
+ try {
+ throw FOO bar
+ } on error {em opts} {
+ list a b c
+ } finally {
+ throw BAR baz
+ }
+ }
+ list $em [dict get $opts -errorcode]
+} {bar FOO}
+
+# try tests - fallthough body cases
+
+test error-19.1 {try with fallthrough body #1} {
+ set RES {}
+ try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
+ set RES
+} {1}
+test error-19.2 {try with fallthrough body #2} {
+ set RES {}
+ 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} {
+ set RES {}
+ try {
+ throw FOO bar
+ } trap FOO {} - trap BAR {} - trap {} {} {
+ set RES trap
+ } on error {} { set RES err }
+ set RES
+} {trap}
+test error-19.4 {multiple unrelated fallthroughs #1} {
+ set RES {}
+ try {
+ throw FOO 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 {} {
+ set RES foo
+ } trap {} {} - on error {} {
+ set RES err
+ }
+ set RES
+} {err}
+proc addmsg msg {
+ variable RES
+ lappend RES $msg
+}
+test error-19.6 {compiled try executes all clauses} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ try {
+ addmsg a
+ throw bar hello
+ } trap bar {res opt} {
+ addmsg b
+ } finally {
+ addmsg c
+ }
+ addmsg d
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {a b c d}
+test error-19.7 {compiled try executes all clauses} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ try {
+ addmsg a
+ } on error {res opt} {
+ addmsg b
+ } on ok {} {
+ addmsg c
+ } finally {
+ addmsg d
+ }
+ addmsg e
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {a c d e}
+test error-19.8 {compiled try executes all clauses} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ try {
+ addmsg a
+ throw bar hello
+ } trap bar {res opt} {
+ addmsg b
+ }
+ addmsg c
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {a b c}
+test error-19.9 {compiled try executes all clauses} -setup {
+ set RES {}
+} -body {
+ apply {{} {
+ try {
+ addmsg a
+ } on error {res opt} {
+ addmsg b
+ } on ok {} {
+ addmsg c
+ }
+ addmsg d
+ } ::tcl::test::error}
+} -cleanup {
+ unset RES
+} -result {a c d}
+test error-19.10 {compiled try with chained clauses} -setup {
+ set RES {}
+} -body {
+ list [apply {{} {
+ try {
+ return good
+ } on return {res} - on ok {res} {
+ addmsg ok
+ addmsg $res
+ return handler
+ } finally {
+ addmsg finally
+ }
+ } ::tcl::test::error}] $RES
+} -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?
+# It would seem appropriate to set at least those for the matching handler and
+# the executed body; possibly for each handler we fall through as well?
+
+# negative case try tests - bad "on" handler
+
+test error-20.1 {bad code name in on handler} -body {
+ try { list a b c } on err {} {}
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
+test error-20.2 {bad code value in on handler} -body {
+ try { list a b c } on 34985723094872345 {} {}
+} -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer}
+
+test error-21.1 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {string repeat x 10} on ok {} {}
+ }
+} 0
+test error-21.2 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {error [string repeat x 10]} on error {} {}
+ }
+} 0
+test error-21.3 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {throw FOO [string repeat x 10]} trap FOO {} {}
+ }
+} 0
+test error-21.4 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {string repeat x 10}
+ }
+} 0
+test error-21.5 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {string repeat x 10} on ok {} {} finally {string repeat y 10}
+ }
+} 0
+test error-21.6 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {
+ error [string repeat x 10]
+ } on error {} {} finally {
+ string repeat y 10
+ }
+ }
+} 0
+test error-21.7 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {
+ throw FOO [string repeat x 10]
+ } trap FOO {} {} finally {
+ string repeat y 10
+ }
+ }
+} 0
+test error-21.8 {memory leaks in try: Bug 2910044} memory {
+ leaktest {
+ try {string repeat x 10} finally {string repeat y 10}
+ }
+} 0
+
+# negative case try tests - bad "trap" handler
+# what is the effect if we attempt to trap an errorcode that is not a list?
+# nested try
+# catch inside try
+# no tests for bad varslist?
+# -errorcode but code!=1 doesn't trap
+# throw negative case tests (no args, too many args, etc)
+
+}
+namespace delete ::tcl::test::error
# cleanup
catch {rename p ""}
::tcltest::cleanupTests
-return
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/eval.test b/tests/eval.test
index eefa96f..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.7 2005/09/06 14:40:11 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 eval-1.1 {single argument} {
eval {format 22}
} 22
@@ -47,7 +45,7 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
set a 1
error "test error"
}} msg
- set errorInfo
+ set ::errorInfo
} "test error
while executing
\"error \"test error\"\"
@@ -68,7 +66,7 @@ test eval-3.3 {eval and canonical lists} {
set cmd [list list 1 2 3 4 5]
# Force existance of utf-8 rep
set dummy($cmd) $cmd
- unset dummy($cmd)
+ unset dummy
eval $cmd
} {1 2 3 4 5}
test eval-3.4 {concatenating eval and canonical lists} {
@@ -77,10 +75,15 @@ test eval-3.4 {concatenating eval and canonical lists} {
# Force existance of utf-8 rep
set dummy($cmd) $cmd
set dummy($cmd2) $cmd2
- unset dummy($cmd) dummy($cmd2)
+ 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 0cf627b..0d1b06c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,46 +1,54 @@
# This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "update", and "vwait" Tcl
-# commands. Sourcing this file into Tcl runs the tests and generates
-# output for errors. No output means no errors were found.
+# tclEvent.c, which includes the "update", and "vwait" Tcl commands. Sourcing
+# this file into Tcl runs the tests and generates output for errors. No
+# output means no errors were found.
#
# Copyright (c) 1995-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: event.test,v 1.20 2002/07/10 11:56:44 dgp 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]]
-
-test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
+testConstraint exec [llength [info commands exec]]
+
+test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler} -body {
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
- set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 0} {1 0} {2 0}}
-test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
- # This test is non-portable because on some systems (e.g.
- # SunOS 4.1.3) pipes seem to be writable always.
+} -result {{0 0} {1 0} {2 0}}
+test event-1.2 {Tcl_CreateFileHandler, writing} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
+ # This test is non-portable because on some systems (e.g., SunOS 4.1.3)
+ # pipes seem to be writable always.
testfilehandler create 0 off writable
testfilehandler clear 0
testfilehandler oneevent
- set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
@@ -48,16 +56,17 @@ test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
testfilehandler fill 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {0 2} {0 2}}
-test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+} -result {{0 1} {0 2} {0 2}}
+test event-1.3 {Tcl_DeleteFileHandler} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler create 0 disabled disabled
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -67,16 +76,17 @@ test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
+} -result {{0 1} {1 1} {1 2} {0 0}}
-test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+test event-2.1 {Tcl_DeleteFileHandler} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -86,43 +96,44 @@ test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
- {testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup {
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 0 readable writable
testfilehandler fillpartial 0
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler oneevent
lappend result [testfilehandler counts 0]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {0 0}}
+} -result {{0 1} {0 0}}
-test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
+test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup {
testfilehandler close
+} -constraints {testfilehandler} -body {
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
testfilehandler windowevent
- set result [testfilehandler counts 1]
+ testfilehandler counts 1
+} -cleanup {
testfilehandler close
- set result
-} {0 0}
+} -result {0 0}
-test event-4.1 {FileHandlerEventProc, race between event and disabling} \
- {testfilehandler nonPortable} {
+test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup {
update
testfilehandler close
+ set result ""
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
- set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
@@ -132,13 +143,13 @@ test event-4.1 {FileHandlerEventProc, race between event and disabling} \
testfilehandler create 1 disabled disabled
testfilehandler oneevent
lappend result [testfilehandler counts 1]
+} -cleanup {
testfilehandler close
- set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
- {testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup {
update
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 1 readable writable
testfilehandler create 2 readable writable
testfilehandler fillpartial 1
@@ -148,13 +159,14 @@ test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler windowevent
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+} -cleanup {
testfilehandler close
- set result
-} {{0 0} {0 1} {0 0} {0 1}}
+} -result {{0 0} {0 1} {0 0} {0 1}}
update
-test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
catch {rename bgerror {}}
+} -body {
proc bgerror msg {
global errorInfo errorCode x
lappend x [list $msg $errorInfo $errorCode]
@@ -164,18 +176,19 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
after idle {set errorInfo foobar; set errorCode xyzzy}
set x {}
update idletasks
+ regsub -all [file join {} non_existent] $x "non_existent"
+} -cleanup {
rename bgerror {}
- regsub -all [file join {} non_existent] $x "non_existent" x
- set x
-} {{{a simple error} {a simple error
+} -result {{{a simple error} {a simple error
while executing
"error "a simple error""
("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
"open non_existent"
("after" script)} {POSIX ENOENT {no such file or directory}}}}
-test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
catch {rename bgerror {}}
+} -body {
proc bgerror msg {
global x
lappend x $msg
@@ -185,14 +198,102 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
after idle {open non_existent}
set x {}
update idletasks
+ return $x
+} -cleanup {
+ rename bgerror {}
+} -result {{a simple error}}
+test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
+ variable x
+ proc demo args {variable x done}
+ variable target [list [namespace which demo] x]
+ proc trial args {variable target; string length $target}
+ trace add execution demo enter [namespace code trial]
+ variable save [interp bgerror {}]
+ interp bgerror {} $target
+} -body {
+ after 0 {error bar}
+ vwait [namespace which -variable x]
+} -cleanup {
+ interp bgerror {} $save
+ unset x target save
+ rename demo {}
+ rename trial {}
+} -result {}
+test event-5.3.1 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.4 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {}
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.5 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {} {} {}
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.6 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {} {}
+} -returnCodes error -match glob -result {*-level*}
+test event-5.7 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {} {-level foo}
+} -returnCodes error -match glob -result {*expected integer*}
+test event-5.8 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {} {-level 0}
+} -returnCodes error -match glob -result {*-code*}
+test event-5.9 {Default [interp bgerror] handler} -body {
+ ::tcl::Bgerror {} {-level 0 -code ok}
+} -returnCodes error -match glob -result {*expected integer*}
+test event-5.10 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror {} {-level 0 -code 0}
+ return $::res
+} -cleanup {
+ rename bgerror {}
+} -result {}
+test event-5.11 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror msg {-level 0 -code 1}
+ return $::res
+} -cleanup {
+ rename bgerror {}
+} -result {msg}
+test event-5.12 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror msg {-level 0 -code 2}
+ return $::res
+} -cleanup {
+ rename bgerror {}
+} -result {command returned bad code: 2}
+test event-5.13 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror msg {-level 0 -code 3}
+ return $::res
+} -cleanup {
+ rename bgerror {}
+} -result {invoked "break" outside of a loop}
+test event-5.14 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror msg {-level 0 -code 4}
+ return $::res
+} -cleanup {
rename bgerror {}
- set x
-} {{a simple error}}
+} -result {invoked "continue" outside of a loop}
+test event-5.15 {Default [interp bgerror] handler} -body {
+ proc bgerror {m} {append ::res $m}
+ set ::res {}
+ ::tcl::Bgerror msg {-level 0 -code 5}
+ return $::res
+} -cleanup {
+ rename bgerror {}
+} -result {command returned bad code: 5}
-test event-6.1 {BgErrorDeleteProc procedure} {
+test event-6.1 {BgErrorDeleteProc procedure} -setup {
catch {interp delete foo}
interp create foo
set erroutfile [makeFile Unmodified err.out]
+} -body {
foo eval [list set erroutfile $erroutfile]
foo eval {
proc bgerror args {
@@ -211,102 +312,135 @@ test event-6.1 {BgErrorDeleteProc procedure} {
set f [open $erroutfile r]
set result [read $f]
close $f
+ return $result
+} -cleanup {
removeFile $erroutfile
- set result
-} {Unmodified
+} -result {Unmodified
}
test event-7.1 {bgerror / regular} {
set errRes {}
proc bgerror {err} {
- global errRes;
- set errRes $err;
+ global errRes
+ set errRes $err
}
after 0 {error err1}
- vwait errRes;
- set errRes;
+ vwait errRes
+ return $errRes
} err1
-
test event-7.2 {bgerror / accumulation} {
set errRes {}
proc bgerror {err} {
- global errRes;
- lappend errRes $err;
+ global errRes
+ lappend errRes $err
}
after 0 {error err1}
after 0 {error err2}
after 0 {error err3}
update
- set errRes;
+ return $errRes
} {err1 err2 err3}
-
test event-7.3 {bgerror / accumulation / break} {
set errRes {}
proc bgerror {err} {
- global errRes;
- lappend errRes $err;
- return -code break "skip!";
+ global errRes
+ lappend errRes $err
+ return -code break "skip!"
}
after 0 {error err1}
after 0 {error err2}
after 0 {error err3}
update
- set errRes;
+ return $errRes
} err1
-
-test event-7.4 {tkerror is nothing special anymore to tcl} {
+test event-7.4 {tkerror is nothing special anymore to tcl} -body {
set errRes {}
# we don't just rename bgerror to empty because it could then
# be autoloaded...
proc bgerror {err} {
- global errRes;
- lappend errRes "bg:$err";
+ global errRes
+ lappend errRes "bg:$err"
}
proc tkerror {err} {
- global errRes;
- lappend errRes "tk:$err";
+ global errRes
+ lappend errRes "tk:$err"
}
after 0 {error err1}
update
+ return $errRes
+} -cleanup {
rename tkerror {}
- set errRes
-} bg:err1
-
-testConstraint exec [llength [info commands exec]]
-
-test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
- set script {
+} -result bg:err1
+test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body {
+ exec [interpreter] << {
after 1000 error hello
after 2000 set a 0
vwait a
}
-
- list [catch {exec [interpreter] << $script} errMsg] $errMsg
-} {1 {hello
+} -constraints {exec} -returnCodes error -result {hello
while executing
"error hello"
- ("after" script)}}
-
+ ("after" script)}
+test event-7.6 {safe hidden bgerror fallback} -setup {
+ variable result {}
+ interp create -safe safe
+} -body {
+ safe alias puts puts
+ safe alias result ::append [namespace which -variable result]
+ safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
+ safe hide bgerror
+ safe eval after 0 error foo
+ update
+ return $result
+} -cleanup {
+ interp delete safe
+} -result {foo
+NONE
+foo
+ while executing
+"error foo"
+ ("after" script)
+}
+test event-7.7 {safe hidden bgerror fallback} -setup {
+ variable result {}
+ interp create -safe safe
+} -body {
+ safe alias puts puts
+ safe alias result ::append [namespace which -variable result]
+ safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
+ safe hide bgerror
+ safe eval {proc bgerror m {error bar soom baz}}
+ safe eval after 0 error foo
+ update
+ return $result
+} -cleanup {
+ interp delete safe
+} -result {foo
+NONE
+foo
+ while executing
+"error foo"
+ ("after" script)
+}
-# someday : add a test checking that
-# when there is no bgerror, an error msg goes to stderr
-# ideally one would use sub interp and transfer a fake stderr
-# to it, unfortunatly the current interp tcl API does not allow
-# that. the other option would be to use fork a test but it
-# then becomes more a file/exec test than a bgerror test.
+# someday : add a test checking that when there is no bgerror, an error msg
+# goes to stderr ideally one would use sub interp and transfer a fake stderr
+# to it, unfortunatly the current interp tcl API does not allow that. The
+# other option would be to use fork a test but it then becomes more a
+# file/exec test than a bgerror test.
# end of bgerror tests
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
set result [read $child]
close $child
- set result
+ return $result
} {even 6
even 4
odd 41
@@ -314,77 +448,83 @@ 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"
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 16
even 6
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"
flush $child
set result [read $child]
close $child
- set result
- } {even 16
+ return $result
+} {even 16
even 6
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"
flush $child
set result [read $child]
close $child
- set result
+ return $result
} {even 16
even 4
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
set result [read $child]
close $child
- set result
+ return $result
} {even 16
}
test event-10.1 {Tcl_Exit procedure} {stdio} {
set child [open |[list [interpreter]] r+]
puts $child "exit 3"
- list [catch {close $child} msg] $msg [lindex $errorCode 0] \
- [lindex $errorCode 2]
+ list [catch {close $child} msg] $msg [lindex $::errorCode 0] \
+ [lindex $::errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}
-test event-11.1 {Tcl_VwaitCmd procedure} {
- list [catch {vwait} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.2 {Tcl_VwaitCmd procedure} {
- list [catch {vwait a b} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.3 {Tcl_VwaitCmd procedure} {
+test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+ vwait
+} -result {wrong # args: should be "vwait name"}
+test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+ vwait a b
+} -result {wrong # args: should be "vwait name"}
+test event-11.3 {Tcl_VwaitCmd procedure} -setup {
catch {unset x}
+} -body {
set x 1
- list [catch {vwait x(1)} msg] $msg
-} {1 {can't trace "x(1)": variable isn't array}}
-test event-11.4 {Tcl_VwaitCmd procedure} {} {
+ vwait x(1)
+} -returnCodes error -result {can't trace "x(1)": variable isn't array}
+test event-11.4 {Tcl_VwaitCmd procedure} -setup {
foreach i [after info] {
after cancel $i
}
after 10; update; # On Mac make sure update won't take long
+} -body {
after 100 {set x x-done}
after 200 {set y y-done}
after 300 {set z z-done}
@@ -394,22 +534,22 @@ test event-11.4 {Tcl_VwaitCmd procedure} {} {
set z before
set q before
list [vwait y] $x $y $z $q
-} {{} x-done y-done before q-done}
-
-foreach i [after info] {
- after cancel $i
-}
-
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} x-done y-done before q-done}
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {
set test1file [makeFile "" test1]
+} -constraints {socket} -body {
set f1 [open $test1file w]
proc accept {s args} {
puts $s foobar
close $s
}
- catch {set s1 [socket -server accept 0]}
+ set s1 [socket -server accept -myaddr 127.0.0.1 0]
after 1000
- catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
+ set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]
close $s1
set x 0
set y 0
@@ -421,9 +561,10 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
vwait z
close $f1
close $s2
- removeFile $test1file
list $x $y $z
-} {3 3 done}
+} -cleanup {
+ removeFile $test1file
+} -result {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
set test1file [makeFile "" test1]
set test2file [makeFile "" test2]
@@ -443,17 +584,17 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
list $x $y $z
} {3 3 done}
-
-test event-12.1 {Tcl_UpdateCmd procedure} {
- list [catch {update a b} msg] $msg
-} {1 {wrong # args: should be "update ?idletasks?"}}
-test event-12.2 {Tcl_UpdateCmd procedure} {
- list [catch {update bogus} msg] $msg
-} {1 {bad option "bogus": must be idletasks}}
-test event-12.3 {Tcl_UpdateCmd procedure} {
+test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+ update a b
+} -result {wrong # args: should be "update ?idletasks?"}
+test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+ update bogus
+} -result {bad option "bogus": must be idletasks}
+test event-12.3 {Tcl_UpdateCmd procedure} -setup {
foreach i [after info] {
after cancel $i
}
+} -body {
after 500 {set x after}
after idle {set y after}
after idle {set z "after, y = $y"}
@@ -462,11 +603,16 @@ test event-12.3 {Tcl_UpdateCmd procedure} {
set z before
update idletasks
list $x $y $z
-} {before after {after, y = after}}
-test event-12.4 {Tcl_UpdateCmd procedure} {
+} -cleanup {
foreach i [after info] {
after cancel $i
}
+} -result {before after {after, y = after}}
+test event-12.4 {Tcl_UpdateCmd procedure} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -body {
after 10; update; # On Mac make sure update won't take long
after 200 {set x x-done}
after 600 {set y y-done}
@@ -477,118 +623,311 @@ test event-12.4 {Tcl_UpdateCmd procedure} {
after 300
update
list $x $y $z
-} {x-done before z-done}
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {x-done before z-done}
-test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
+test event-13.1 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 0]
update
- testfilehandler close
list $result $x
-} {{} {no timeout}}
-test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {no timeout}}
+test event-13.2 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
- testfilehandler close
list $result $x
-} {{} timeout}
-test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} timeout}
+test event-13.3 {Tcl_WaitForFile procedure, readable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fillpartial 1
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
- testfilehandler close
list $result $x
-} {readable {no timeout}}
-test event-13.4 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {readable {no timeout}}
+test event-13.4 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 0]
update
- testfilehandler close
list $result $x
-} {{} {no timeout}}
-test event-13.5 {Tcl_WaitForFile procedure, writable} \
- {testfilehandler nonPortable} {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {no timeout}}
+test event-13.5 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+ after 100 set x timeout
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
- testfilehandler close
list $result $x
-} {{} timeout}
-test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} timeout}
+test event-13.6 {Tcl_WaitForFile procedure, writable} -setup {
foreach i [after info] {
after cancel $i
}
- after 100 set x timeout
testfilehandler close
+} -constraints testfilehandler -body {
+ after 100 set x timeout
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
- testfilehandler close
list $result $x
-} {writable {no timeout}}
-test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
+} -cleanup {
+ testfilehandler close
foreach i [after info] {
after cancel $i
}
+} -result {writable {no timeout}}
+test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+ testfilehandler close
+} -constraints testfilehandler -body {
after 100 lappend x timeout
after idle lappend x idle
- testfilehandler close
testfilehandler create 1 off off
set x ""
set result [list [testfilehandler wait 1 readable 200] $x]
update
- testfilehandler close
lappend result $x
-} {{} {} {timeout idle}}
-
+} -cleanup {
+ testfilehandler close
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} {} {timeout idle}}
test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
set f [open "|sleep 2" r]
set result ""
lappend result [testfilewait $f readable 100]
lappend result [testfilewait $f readable -1]
close $f
- set result
+ return $result
} {{} readable}
+test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 0]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fillpartial 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {readable {no timeout}}
+test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 0]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 set x timeout
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ list $result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {writable {no timeout}}
+test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+ foreach i [after info] {after cancel $i}
+ testfilehandler close
+} -constraints {testfilehandler unix} -body {
+ after 100 lappend x timeout
+ after idle lappend x idle
+ testfilehandler create 1 off off
+ set x ""
+ set result [list [testfilehandler wait 1 readable 200] $x]
+ update
+ lappend result $x
+} -cleanup {
+ testfilehandler close
+ foreach chan $chanList {close $chan}
+ foreach i [after info] {after cancel $i}
+} -result {{} {} {timeout idle}}
+test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup {
+ set chanList {}
+ for {set i 0} {$i < 32} {incr i} {
+ lappend chanList [open /dev/null r]
+ }
+} -constraints {testfilewait unix} -body {
+ set f [open "|sleep 2" r]
+ set result ""
+ lappend result [testfilewait $f readable 100]
+ lappend result [testfilewait $f readable -1]
+ close $f
+ return $result
+} -cleanup {
+ foreach chan $chanList {close $chan}
+} -result {{} readable}
+
# cleanup
foreach i [after info] {
after cancel $i
}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/exec.test b/tests/exec.test
index a80aaeb..871c0c5 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -1,17 +1,15 @@
# Commands covered: exec
#
-# 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-1994 The Regents of the University of California.
# Copyright (c) 1994-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: exec.test,v 1.23 2005/07/28 10:55:37 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
namespace import -force ::tcltest::*
@@ -20,6 +18,8 @@ namespace import -force ::tcltest::*
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
unset -nocomplain path
+
+# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
puts -nonewline [lindex $argv 0]
foreach str [lrange $argv 1 end] {
@@ -28,28 +28,33 @@ set path(echo) [makeFile {
puts {}
exit
} echo]
-
+set path(echo2) [makeFile {
+ puts stdout [join $argv]
+ puts stderr [lindex $argv 1]
+ exit
+} echo2]
set path(cat) [makeFile {
- if {$argv == {}} {
+ if {$argv eq ""} {
set argv -
}
+ fconfigure stdout -translation binary
foreach name $argv {
- if {$name == "-"} {
+ if {$name eq "-"} {
set f stdin
} elseif {[catch {open $name r} f] != 0} {
puts stderr $f
continue
}
+ fconfigure $f -translation binary
while {[eof $f] == 0} {
puts -nonewline [read $f]
}
- if {$f != "stdin"} {
+ if {$f ne "stdin"} {
close $f
}
}
exit
} cat]
-
set path(wc) [makeFile {
set data [read stdin]
set lines [regsub -all "\n" $data {} dummy]
@@ -58,39 +63,59 @@ set path(wc) [makeFile {
puts [format "%8.d%8.d%8.d" $lines $words $chars]
exit
} wc]
-
set path(sh) [makeFile {
- if {[lindex $argv 0] != "-c"} {
+ if {[lindex $argv 0] ne "-c"} {
error "sh: unexpected arguments $argv"
}
set cmd [lindex $argv 1]
lappend cmd ";"
-
set newcmd {}
-
foreach arg $cmd {
- if {$arg == ";"} {
- eval exec >@stdout 2>@stderr [list [info nameofexecutable]] $newcmd
+ if {$arg eq ";"} {
+ exec >@stdout 2>@stderr [info nameofexecutable] {*}$newcmd
set newcmd {}
continue
}
- if {$arg == "1>&2"} {
+ if {$arg eq "1>&2"} {
set arg >@stderr
}
lappend newcmd $arg
}
exit
} sh]
-
+set path(sh2) [makeFile {
+ if {[lindex $argv 0] ne "-c"} {
+ error "sh: unexpected arguments $argv"
+ }
+ set cmd [lindex $argv 1]
+ lappend cmd ";"
+ set newcmd {}
+ foreach arg $cmd {
+ if {$arg eq ";"} {
+ exec -ignorestderr >@stdout [info nameofexecutable] {*}$newcmd
+ set newcmd {}
+ continue
+ }
+ lappend newcmd $arg
+ }
+ exit
+} sh2]
set path(sleep) [makeFile {
after [expr $argv*1000]
exit
} sleep]
-
set path(exit) [makeFile {
exit $argv
} exit]
+proc readfile filename {
+ set f [open $filename]
+ set d [read $f]
+ close $f
+ return [string trimright $d \n]
+}
+
+# ----------------------------------------------------------------------
# Basic operations.
test exec-1.1 {basic exec operation} {exec} {
@@ -127,13 +152,24 @@ test exec-2.4 {redirecting input from immediate source} {exec stdio} {
test exec-2.5 {redirecting input from immediate source} {exec} {
exec [interpreter] $path(cat) "<<Joined to arrows"
} {Joined to arrows}
-test exec-2.6 {redirecting input from immediate source, with UTF} {exec} {
- # If this fails, it may give back:
- # "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
- # If it does, this means that the UTF -> external conversion did not
- # occur before writing out the temp file.
- exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"
-} "\uE9\uE0\uFC\uF1"
+test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
+ set sysenc [encoding system]
+ encoding system iso8859-1
+ proc quotenonascii s {
+ regsub -all {\[|\\|\]} $s {\\&} s
+ regsub -all "\[\u007f-\uffff\]" $s \
+ {[apply {c {format {\u%04x} [scan $c %c]}} &]} s
+ return [subst -novariables $s]
+ }
+} -constraints {exec} -body {
+ # If this fails, it may give back: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
+ # If it does, this means that the UTF -> external conversion did not occur
+ # before writing out the temp file.
+ quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"]
+} -cleanup {
+ encoding system $sysenc
+ rename quotenonascii {}
+} -result {\u00e9\u00e0\u00fc\u00f1}
# I/O redirection: output to file.
@@ -182,37 +218,37 @@ test exec-3.7 {redirecting output to file} {exec} {
file delete $path(gorp.file)
test exec-4.1 {redirecting output and stderr to file} {exec} {
- exec [interpreter] "$path(echo)" "test output" >& $path(gorp.file)
- exec [interpreter] "$path(cat)" "$path(gorp.file)"
+ exec [interpreter] $path(echo) "test output" >& $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "test output"
test exec-4.2 {redirecting output and stderr to file} {exec} {
- list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+ list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} {{} {foo bar}}
test exec-4.3 {redirecting output and stderr to file} {exec} {
exec [interpreter] $path(echo) "first line" > $path(gorp.file)
- list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" >>&$path(gorp.file)] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+ list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >>&$path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} "{} {first line\nfoo bar}"
test exec-4.4 {redirecting output and stderr to file} {exec} {
- set f [open "$path(gorp.file)" w]
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec [interpreter] "$path(echo)" "More text" >&@ $f
- exec [interpreter] "$path(echo)" >&@$f "Even more"
+ exec [interpreter] $path(echo) "More text" >&@ $f
+ exec [interpreter] $path(echo) >&@$f "Even more"
puts $f "Line 3"
close $f
- exec [interpreter] "$path(cat)" "$path(gorp.file)"
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nMore text\nEven more\nLine 3"
test exec-4.5 {redirecting output and stderr to file} {exec} {
- set f [open "$path(gorp.file)" w]
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec >&@ $f [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2"
- exec >&@$f [interpreter] "$path(sh)" -c "\"$path(echo)\" xyzzy 1>&2"
+ exec >&@ $f [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2"
+ exec >&@$f [interpreter] $path(sh) -c "\"$path(echo)\" xyzzy 1>&2"
puts $f "Line 3"
close $f
- exec [interpreter] "$path(cat)" "$path(gorp.file)"
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nfoo bar\nxyzzy\nLine 3"
# I/O redirection: input from file.
@@ -235,30 +271,30 @@ test exec-5.4 {redirecting input from file} {exec stdio} {
test exec-5.5 {redirecting input from file} {exec} {
exec [interpreter] $path(cat) <$path(gorp.file)
} {Just a few thoughts}
-test exec-5.6 {redirecting input from file} {exec} {
+test exec-5.6 {redirecting input from file} -constraints {exec} -body {
set f [open $path(gorp.file) r]
- set result [exec [interpreter] $path(cat) <@ $f]
+ exec [interpreter] $path(cat) <@ $f
+} -cleanup {
close $f
- set result
-} {Just a few thoughts}
-test exec-5.7 {redirecting input from file} {exec} {
+} -result {Just a few thoughts}
+test exec-5.7 {redirecting input from file} -constraints {exec} -body {
set f [open $path(gorp.file) r]
- set result [exec <@$f [interpreter] $path(cat)]
+ exec <@$f [interpreter] $path(cat)
+} -cleanup {
close $f
- set result
-} {Just a few thoughts}
+} -result {Just a few thoughts}
# I/O redirection: standard error through a pipeline.
test exec-6.1 {redirecting stderr through a pipeline} {exec stdio} {
- exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar" |& [interpreter] "$path(cat)"
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar" |& [interpreter] $path(cat)
} "foo bar"
test exec-6.2 {redirecting stderr through a pipeline} {exec stdio} {
- exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" |& [interpreter] "$path(cat)"
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" |& [interpreter] $path(cat)
} "foo bar"
test exec-6.3 {redirecting stderr through a pipeline} {exec stdio} {
- exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
- |& [interpreter] "$path(sh)" -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] "$path(cat)"
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+ |& [interpreter] $path(sh) -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] $path(cat)
} "second msg\nfoo bar"
# I/O redirection: combinations.
@@ -275,7 +311,6 @@ test exec-7.2 {multiple I/O redirections} {exec} {
} {command input}
# Long input to command and output from command.
-
set a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n"
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
@@ -284,9 +319,7 @@ set a [concat $a $a $a $a]
test exec-8.1 {long input and output} {exec} {
exec [interpreter] $path(cat) << $a
} $a
-
# More than 20 arguments to exec.
-
test exec-8.2 {long input and output} {exec} {
exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}
@@ -300,118 +333,120 @@ test exec-9.1 {commands returning errors} {exec} {
test exec-9.2 {commands returning errors} {exec} {
string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.3 {commands returning errors} {exec stdio} {
- list [catch {exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1} msg] $msg
-} {1 {child process exited abnormally}}
-test exec-9.4 {commands returning errors} {exec stdio} {
- list [catch {exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"} msg] $msg
-} {1 {foo bar
-child process exited abnormally}}
-test exec-9.5 {commands returning errors} {exec stdio} {
- list [catch {exec gorp456 | [interpreter] echo a b c} msg] [string tolower $msg]
-} {1 {couldn't execute "gorp456": no such file or directory}}
-test exec-9.6 {commands returning errors} {exec} {
- list [catch {exec [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2"} msg] $msg
-} {1 {error msg}}
-test exec-9.7 {commands returning errors} {exec stdio} {
- list [catch {exec [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2" \
- | [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2"} msg] $msg
-} {1 {error msg
-error msg}}
-
+test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
+ exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1
+} -returnCodes error -result {child process exited abnormally}
+test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
+ exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
+} -returnCodes error -result {foo bar
+child process exited abnormally}
+test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
+ exec gorp456 | [interpreter] echo a b c
+} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
+test exec-9.6 {commands returning errors} -constraints {exec} -body {
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2"
+} -returnCodes error -result {error msg}
+test exec-9.7 {commands returning errors} -constraints {exec stdio nonPortable} -body {
+ # This test can fail easily on multiprocessor machines
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1" \
+ | [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1"
+} -returnCodes error -result {error msg
+error msg}
set path(err) [makeFile {} err]
-
-test exec-9.8 {commands returning errors} {exec} {
+test exec-9.8 {commands returning errors} -constraints {exec} -setup {
set f [open $path(err) w]
puts $f {
puts stdout out
puts stderr err
}
close $f
- list [catch {exec [interpreter] $path(err)} msg] $msg
-} {1 {out
-err}}
-
-# Errors in executing the Tcl command, as opposed to errors in the
-# processes that are invoked.
-
-test exec-10.1 {errors in exec invocation} {exec} {
- list [catch {exec} msg] $msg
-} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-10.2 {errors in exec invocation} {exec} {
- list [catch {exec | cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.3 {errors in exec invocation} {exec} {
- list [catch {exec cat |} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.4 {errors in exec invocation} {exec} {
- list [catch {exec cat | | cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.5 {errors in exec invocation} {exec} {
- list [catch {exec cat | |& cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.6 {errors in exec invocation} {exec} {
- list [catch {exec cat |&} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.7 {errors in exec invocation} {exec} {
- list [catch {exec cat <} msg] $msg
-} {1 {can't specify "<" as last word in command}}
-test exec-10.8 {errors in exec invocation} {exec} {
- list [catch {exec cat >} msg] $msg
-} {1 {can't specify ">" as last word in command}}
-test exec-10.9 {errors in exec invocation} {exec} {
- list [catch {exec cat <<} msg] $msg
-} {1 {can't specify "<<" as last word in command}}
-test exec-10.10 {errors in exec invocation} {exec} {
- list [catch {exec cat >>} msg] $msg
-} {1 {can't specify ">>" as last word in command}}
-test exec-10.11 {errors in exec invocation} {exec} {
- list [catch {exec cat >&} msg] $msg
-} {1 {can't specify ">&" as last word in command}}
-test exec-10.12 {errors in exec invocation} {exec} {
- list [catch {exec cat >>&} msg] $msg
-} {1 {can't specify ">>&" as last word in command}}
-test exec-10.13 {errors in exec invocation} {exec} {
- list [catch {exec cat >@} msg] $msg
-} {1 {can't specify ">@" as last word in command}}
-test exec-10.14 {errors in exec invocation} {exec} {
- list [catch {exec cat <@} msg] $msg
-} {1 {can't specify "<@" as last word in command}}
-test exec-10.15 {errors in exec invocation} {exec} {
- list [catch {exec cat < a/b/c} msg] [string tolower $msg]
-} {1 {couldn't read file "a/b/c": no such file or directory}}
-test exec-10.16 {errors in exec invocation} {exec} {
- list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
-} {1 {couldn't write file "a/b/c": no such file or directory}}
-test exec-10.17 {errors in exec invocation} {exec} {
- list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
-} {1 {couldn't write file "a/b/c": no such file or directory}}
+} -body {
+ exec [interpreter] $path(err)
+} -returnCodes error -result {out
+err}
+
+# Errors in executing the Tcl command, as opposed to errors in the processes
+# that are invoked.
+
+test exec-10.1 {errors in exec invocation} -constraints {exec} -body {
+ exec
+} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+test exec-10.2 {errors in exec invocation} -constraints {exec} -body {
+ exec | cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.3 {errors in exec invocation} -constraints {exec} -body {
+ exec cat |
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.4 {errors in exec invocation} -constraints {exec} -body {
+ exec cat | | cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.5 {errors in exec invocation} -constraints {exec} -body {
+ exec cat | |& cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.6 {errors in exec invocation} -constraints {exec} -body {
+ exec cat |&
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.7 {errors in exec invocation} -constraints {exec} -body {
+ exec cat <
+} -returnCodes error -result {can't specify "<" as last word in command}
+test exec-10.8 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >
+} -returnCodes error -result {can't specify ">" as last word in command}
+test exec-10.9 {errors in exec invocation} -constraints {exec} -body {
+ exec cat <<
+} -returnCodes error -result {can't specify "<<" as last word in command}
+test exec-10.10 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >>
+} -returnCodes error -result {can't specify ">>" as last word in command}
+test exec-10.11 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >&
+} -returnCodes error -result {can't specify ">&" as last word in command}
+test exec-10.12 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >>&
+} -returnCodes error -result {can't specify ">>&" as last word in command}
+test exec-10.13 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >@
+} -returnCodes error -result {can't specify ">@" as last word in command}
+test exec-10.14 {errors in exec invocation} -constraints {exec} -body {
+ exec cat <@
+} -returnCodes error -result {can't specify "<@" as last word in command}
+test exec-10.15 {errors in exec invocation} -constraints {exec} -body {
+ exec cat < a/b/c
+} -returnCodes error -result {couldn't read file "a/b/c": no such file or directory}
+test exec-10.16 {errors in exec invocation} -constraints {exec} -body {
+ exec cat << foo > a/b/c
+} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
+test exec-10.17 {errors in exec invocation} -constraints {exec} -body {
+ exec cat << foo > a/b/c
+} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
set f [open $path(gorp.file) w]
-test exec-10.18 {errors in exec invocation} {exec} {
- list [catch {exec cat <@ $f} msg] $msg
-} "1 {channel \"$f\" wasn't opened for reading}"
+test exec-10.18 {errors in exec invocation} -constraints {exec} -body {
+ exec cat <@ $f
+} -returnCodes error -result "channel \"$f\" wasn't opened for reading"
close $f
set f [open $path(gorp.file) r]
-test exec-10.19 {errors in exec invocation} {exec} {
- list [catch {exec cat >@ $f} msg] $msg
-} "1 {channel \"$f\" wasn't opened for writing}"
+test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
+ exec cat >@ $f
+} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
-test exec-10.20 {errors in exec invocation} {exec} {
- list [catch {exec ~non_existent_user/foo/bar} msg] $msg
-} {1 {user "non_existent_user" doesn't exist}}
-test exec-10.21 {errors in exec invocation} {exec} {
- list [catch {exec [interpreter] true | ~xyzzy_bad_user/x | false} msg] $msg
-} {1 {user "xyzzy_bad_user" doesn't exist}}
-
+test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
+ exec ~non_existent_user/foo/bar
+} -returnCodes error -result {user "non_existent_user" doesn't exist}
+test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
+ exec [interpreter] true | ~xyzzy_bad_user/x | false
+} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
+test exec-10.22 {errors in exec invocation} -constraints exec -body {
+ exec echo test > ~non_existent_user/foo/bar
+} -returnCodes error -result {user "non_existent_user" doesn't exist}
# Commands in background.
test exec-11.1 {commands in background} {exec} {
- set x [lindex [time {exec [interpreter] $path(sleep) 2 &}] 0]
- expr $x<1000000
+ set time [time {exec [interpreter] $path(sleep) 2 &}]
+ expr {[lindex $time 0] < 1000000}
} 1
-test exec-11.2 {commands in background} {exec} {
- list [catch {exec [interpreter] $path(echo) a &b} msg] $msg
-} {0 {a &b}}
+test exec-11.2 {commands in background} -constraints {exec} -body {
+ exec [interpreter] $path(echo) a &b
+} -result {a &b}
test exec-11.3 {commands in background} {exec} {
llength [exec [interpreter] $path(sleep) 1 &]
} 1
@@ -422,35 +457,33 @@ test exec-11.5 {commands in background} {exec} {
set f [open $path(gorp.file) w]
puts $f [list catch [list exec [info nameofexecutable] $path(echo) foo &]]
close $f
- string compare "foo" [exec [interpreter] $path(gorp.file)]
-} 0
+ exec [interpreter] $path(gorp.file)
+} foo
-# Make sure that background commands are properly reaped when
-# they eventually die.
+# Make sure that background commands are properly reaped when they
+# eventually die.
-if {[testConstraint exec]} {
- exec [interpreter] $path(sleep) 3
+if {[testConstraint exec] && [testConstraint nonPortable]} {
+ after 1300
+ exec [interpreter] $path(sleep) 1
}
-test exec-12.1 {reaping background processes} \
- {exec unix nonPortable} {
+test exec-12.1 {reaping background processes} {exec unix nonPortable} {
for {set i 0} {$i < 20} {incr i} {
exec echo foo > /dev/null &
}
- exec sleep 1
+ after 1000
catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
lindex $msg 0
} 0
-test exec-12.2 {reaping background processes} \
- {exec unix nonPortable} {
+test exec-12.2 {reaping background processes} {exec unix nonPortable} {
exec sleep 2 | sleep 2 | sleep 2 &
catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
set x [lindex $msg 0]
- exec sleep 3
+ after 3000
catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
list $x [lindex $msg 0]
} {3 0}
-test exec-12.3 {reaping background processes} \
- {exec unix nonPortable} {
+test exec-12.3 {reaping background processes} {exec unix nonPortable} {
exec sleep 1000 &
exec sleep 1000 &
set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
@@ -463,7 +496,6 @@ test exec-12.3 {reaping background processes} \
}
catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg
set x [lindex $msg 0]
-
foreach i $pids {
catch {exec kill -KILL $i}
}
@@ -484,62 +516,87 @@ test exec-13.3 {setting errorCode variable} {exec} {
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}
+test exec-13.4 {extended exit result codes} -setup {
+ set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
+} -constraints {win} -body {
+ list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+ removeFile $tmp
+} -result {1 {CHILDSTATUS {} 257}}
+test exec-13.5 {extended exit result codes: max value} -setup {
+ set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5]
+} -constraints {win} -body {
+ list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+ removeFile $tmp
+} -result {1 {CHILDSTATUS {} 1073741823}}
+test exec-13.6 {extended exit result codes: signalled} -setup {
+ set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6]
+} -constraints {win} -body {
+ list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+ removeFile $tmp
+} -result {1 {CHILDKILLED {} SIGABRT SIGABRT}}
# Switches before the first argument
test exec-14.1 {-keepnewline switch} {exec} {
exec -keepnewline [interpreter] $path(echo) foo
} "foo\n"
-test exec-14.2 {-keepnewline switch} {exec} {
- list [catch {exec -keepnewline} msg] $msg
-} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-14.3 {unknown switch} {exec} {
- list [catch {exec -gorp} msg] $msg
-} {1 {bad switch "-gorp": must be -keepnewline or --}}
-test exec-14.4 {-- switch} {exec} {
- list [catch {exec -- -gorp} msg] [string tolower $msg]
-} {1 {couldn't execute "-gorp": no such file or directory}}
+test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
+ exec -keepnewline
+} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+test exec-14.3 {unknown switch} -constraints {exec} -body {
+ exec -gorp
+} -returnCodes error -result {bad switch "-gorp": must be -ignorestderr, -keepnewline, or --}
+test exec-14.4 {-- switch} -constraints {exec} -body {
+ exec -- -gorp
+} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
+test exec-14.5 {-ignorestderr switch} {exec} {
+ # Alas, the use of -ignorestderr is buried here :-(
+ exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1
+} "foo bar\nbar"
# Redirecting standard error separately from standard output
test exec-15.1 {standard error redirection} {exec} {
- exec [interpreter] "$path(echo)" "First line" > "$path(gorp.file)"
- list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2> "$path(gorp.file)"] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+ exec [interpreter] $path(echo) "First line" > $path(gorp.file)
+ list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2> $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)]
} {{} {foo bar}}
test exec-15.2 {standard error redirection} {exec stdio} {
- list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
- | [interpreter] "$path(echo)" biz baz >$path(gorp.file) 2> "$path(gorp.file2)"] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file)"] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+ list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+ | [interpreter] $path(echo) biz baz >$path(gorp.file) 2> $path(gorp.file2)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file2)]
} {{} {biz baz} {foo bar}}
test exec-15.3 {standard error redirection} {exec stdio} {
- list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
- | [interpreter] "$path(echo)" biz baz 2>$path(gorp.file) > "$path(gorp.file2)"] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file)"] \
- [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+ list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+ | [interpreter] $path(echo) biz baz 2>$path(gorp.file) > $path(gorp.file2)] \
+ [exec [interpreter] $path(cat) $path(gorp.file)] \
+ [exec [interpreter] $path(cat) $path(gorp.file2)]
} {{} {foo bar} {biz baz}}
test exec-15.4 {standard error redirection} {exec} {
- set f [open "$path(gorp.file)" w]
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@ $f
+ exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2>@ $f
puts $f "Line 3"
close $f
- exec [interpreter] "$path(cat)" "$path(gorp.file)"
+ readfile $path(gorp.file)
} {Line 1
foo bar
Line 3}
test exec-15.5 {standard error redirection} {exec} {
- exec [interpreter] "$path(echo)" "First line" > "$path(gorp.file)"
+ exec [interpreter] $path(echo) "First line" > "$path(gorp.file)"
exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>> "$path(gorp.file)"
- exec [interpreter] "$path(cat)" "$path(gorp.file)"
+ readfile $path(gorp.file)
} {First line
foo bar}
test exec-15.6 {standard error redirection} {exec stdio} {
exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" > "$path(gorp.file2)" 2> "$path(gorp.file)" \
- >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] "$path(echo)" biz baz
- list [exec [interpreter] "$path(cat)" "$path(gorp.file)"] [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+ >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] $path(echo) biz baz
+ list [readfile $path(gorp.file)] [readfile $path(gorp.file2)]
} {{biz baz} {foo bar}}
test exec-15.7 {standard error redirection 2>@1} {exec stdio} {
# This redirects stderr output into normal result output from exec
@@ -552,7 +609,7 @@ test exec-16.1 {flush output before exec} {exec} {
exec [interpreter] $path(echo) "Second line" >@ $f
puts $f "Third line"
close $f
- exec [interpreter] $path(cat) $path(gorp.file)
+ readfile $path(gorp.file)
} {First line
Second line
Third line}
@@ -562,78 +619,81 @@ test exec-16.2 {flush output before exec} {exec} {
exec [interpreter] << {puts stderr {Second line}} >&@ $f > $path(gorp.file2)
puts $f "Third line"
close $f
- exec [interpreter] $path(cat) $path(gorp.file)
+ readfile $path(gorp.file)
} {First line
Second line
Third line}
-set path(script) [makeFile {} script]
-
-test exec-17.1 { inheriting standard I/O } {exec} {
+test exec-17.1 {inheriting standard I/O} -constraints {exec} -setup {
+ set path(script) [makeFile {} script]
set f [open $path(script) w]
- puts -nonewline $f {close stdout
- set f [}
- puts $f [list open $path(gorp.file) w]]
- puts $f [list catch \
- [list exec [info nameofexecutable] $path(echo) foobar &]]
- puts $f [list exec [info nameofexecutable] $path(sleep) 2]
- puts $f {close $f}
+ puts $f [list lassign [list \
+ [info nameofexecutable] $path(gorp.file) $path(echo) $path(sleep) \
+ ] exe file echo sleep]
+ puts $f {
+ close stdout
+ set f [open $file w]
+ catch {exec $exe $echo foobar &}
+ exec $exe $sleep 2
+ close $f
+ }
close $f
+} -body {
catch {exec [interpreter] $path(script)} result
- set f [open $path(gorp.file) r]
- lappend result [read $f]
- close $f
- set result
-} {{foobar
-}}
-
-test exec-18.1 { exec cat deals with weird file names} {exec tempNotWin} {
+ list $result [readfile $path(gorp.file)]
+} -cleanup {
+ removeFile $path(script)
+} -result {{} foobar}
+
+test exec-18.1 {exec deals with weird file names} -body {
+ set path(fooblah) [makeFile {contents} "foo\[\{blah"]
+ exec [interpreter] $path(cat) $path(fooblah)
+} -constraints {exec} -cleanup {
+ removeFile $path(fooblah)
+} -result contents
+test exec-18.2 {exec cat deals with weird file names} -body {
# This is cross-platform, but the cat isn't predictably correct on
# Windows.
- set f "foo\[\{blah"
- set path(fooblah) [makeFile {} $f]
- set fout [open $path(fooblah) w]
- puts $fout "contents"
- close $fout
- set res [list [catch {exec cat $path(fooblah)} msg] $msg]
- removeFile $f
- set res
-} {0 contents}
+ set path(fooblah) [makeFile {contents} "foo\[\{blah"]
+ exec cat $path(fooblah)
+} -constraints {exec tempNotWin} -cleanup {
+ removeFile $path(fooblah)
+} -result contents
# Note that this test cannot be adapted to work on Windows; that platform has
-# no kernel support for an analog of O_APPEND.
-test exec-19.1 {exec >> uses O_APPEND} {
- -constraints {exec unix}
- -setup {
- set tmpfile [makeFile {0} tmpfile.exec-19.1]
- }
- -body {
- # Note that we have to allow for the current contents of the
- # temporary file, which is why the result is 14 and not 12
- exec /bin/sh -c \
+# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
+# that there is a POSIX shell...
+test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
+ set tmpfile [makeFile {0} tmpfile.exec-19.1]
+} -body {
+ # Note that we have to allow for the current contents of the temporary
+ # file, which is why the result is 14 and not 12
+ exec /bin/sh -c \
{for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile &
- exec /bin/sh -c \
+ exec /bin/sh -c \
{for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
- # The above two shell invokations take about 3 seconds to
- # finish, so allow 5s (in case the machine is busy)
- after 5000
- # Check that no bytes have got lost through mixups with
- # overlapping appends, which is only guaranteed to work when
- # we set O_APPEND on the file descriptor in the [exec >>...]
- file size $tmpfile
- }
- -cleanup {
- removeFile $tmpfile
- }
- -result 14
-}
-
+ # The above two shell invokations take about 3 seconds to finish, so allow
+ # 5s (in case the machine is busy)
+ after 5000
+ # Check that no bytes have got lost through mixups with overlapping
+ # appends, which is only guaranteed to work when we set O_APPEND on the
+ # file descriptor in the [exec >>...]
+ file size $tmpfile
+} -cleanup {
+ removeFile $tmpfile
+} -result 14
+
+# ----------------------------------------------------------------------
# cleanup
-foreach file {script gorp.file gorp.file2 echo cat wc sh sleep exit err} {
+foreach file {gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} {
removeFile $file
}
unset -nocomplain path
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/execute.test b/tests/execute.test
index 0f02e01..94af158 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -1,41 +1,42 @@
-# 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.19 2004/10/28 17:21:25 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::*
}
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}
-::tcltest::testConstraint testobj \
- [expr {[info commands testobj] != {} \
- && [info commands testdoubleobj] != {} \
- && [info commands teststringobj] != {} \
- && [info commands testobj] != {}}]
-
-::tcltest::testConstraint longIs32bit \
- [expr {int(0x80000000) < 0}]
+testConstraint testobj [expr {
+ [llength [info commands testobj]]
+ && [llength [info commands testdoubleobj]]
+ && [llength [info commands teststringobj]]
+}]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint testexprlongobj [llength [info commands testexprlongobj]]
+
# Tests for the omnibus TclExecuteByteCode function:
# INST_DONE not tested
@@ -43,14 +44,12 @@ catch {unset msg}
# INST_PUSH4 not tested
# INST_POP not tested
# INST_DUP not tested
-# INST_CONCAT1 not tested
# INST_INVOKE_STK4 not tested
# INST_INVOKE_STK1 not tested
# INST_EVAL_STK not tested
# INST_EXPR_STK not tested
# INST_LOAD_SCALAR1
-
test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
proc foo {} {
set x 1
@@ -68,7 +67,6 @@ test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
set y 1
return $y
}
-
proc foo {} $body
foo
} 1
@@ -81,9 +79,7 @@ test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
list [catch {foo} msg] $msg
} {1 {can't read "x": no such variable}}
-
# INST_LOAD_SCALAR4
-
test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
set body {}
for {set i 0} {$i < 256} {incr i} {
@@ -93,7 +89,6 @@ test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
set y 1
return $y
}
-
proc foo {} $body
foo
} 1
@@ -107,12 +102,10 @@ test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
unset y
return $y
}
-
proc foo {} $body
list [catch {foo} msg] $msg
} {1 {can't read "y": no such variable}}
-
# INST_LOAD_SCALAR_STK not tested
# INST_LOAD_ARRAY4 not tested
# INST_LOAD_ARRAY1 not tested
@@ -506,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} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
- catch {unset x}
- catch {unset y}
+test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ unset -nocomplain x
+ unset -nocomplain y
+} -body {
namespace eval test_ns_1 {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
@@ -523,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} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -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"
}
@@ -544,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} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -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"
@@ -562,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} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
- catch {unset l}
+test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ unset -nocomplain l
+} -body {
proc {} {} {return {}}
{}
set l {}
lindex {} 0
{}
-} {}
+} -result {}
test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
proc {} {} {}
@@ -585,137 +581,325 @@ test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName o
}
p
} {}
-
test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
set w {3*5}
proc a {obj} {expr $obj}
set res "[a $w]:[a $w]"
} {15:15}
+test execute-6.3 {Tcl_ExprObj: don't use cached script bytecode [Bug 1899164]} -setup {
+ proc 0+0 {} {return SCRIPT}
+} -body {
+ set e { 0+0 }
+ if 1 $e
+ if 1 {expr $e}
+} -cleanup {
+ rename 0+0 {}
+} -result 0
+test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]} -setup {
+ proc 0+0 {} {return SCRIPT}
+} -body {
+ set e { 0+0 }
+ if 1 {expr $e}
+ if 1 $e
+} -cleanup {
+ rename 0+0 {}
+} -result SCRIPT
+test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body {
+ set script { llength {} }
+ set result {}
+ lappend result [if 1 $script]
+ set origName [namespace which llength]
+ rename $origName llength.orig
+ proc $origName {args} {return AHA!}
+ lappend result [if 1 $script]
+} -cleanup {
+ rename $origName {}
+ rename llength.orig $origName
+} -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 {}
+} -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!}
+ }
+ set result {}
+ lappend result [if 1 $script]
+ lappend result [namespace eval foo $script]
+} -cleanup {
+ namespace delete foo
+} -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]
+ namespace eval foo {
+ proc llength {args} {return AHA!}
+ }
+ lappend result [namespace eval foo $script]
+} -cleanup {
+ namespace delete foo
+} -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
+} -result {0 AHA!}
+test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
+ set script { llength {} }
+ interp create slave
+ set result {}
+ lappend result [slave eval $script]
+ interp delete slave
+ interp create slave
+ lappend result [slave eval $script]
+} -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 {}
+ load {} Tcltest slave
+ interp alias {} e slave testexprlongobj
+ lappend result [e $e]
+ interp delete slave
+ interp create slave
+ load {} Tcltest slave
+ interp alias {} e slave testexprlongobj
+ lappend result [e $e]
+} -cleanup {
+ interp delete slave
+} -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 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
+} -result {1 1}
+test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
+ set e { [llength {}]+1 }
+ set result {}
+ lappend result [expr $e]
+ set origName [namespace which llength]
+ rename $origName llength.orig
+ proc $origName {args} {return 1}
+ lappend result [expr $e]
+} -cleanup {
+ rename $origName {}
+ rename llength.orig $origName
+} -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}
+ }
+ set result {}
+ lappend result [expr $e]
+ lappend result [namespace eval foo {expr $e}]
+} -cleanup {
+ namespace delete foo
+} -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}]
+ namespace eval foo {
+ proc llength {args} {return 1}
+ }
+ lappend result [namespace eval foo {expr $e}]
+} -cleanup {
+ namespace delete foo
+} -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
+} -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 {}
+} -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 {}
+} -result {0 1}
-test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {
set x 0x100000000
expr {$x && 1}
} 1
-test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {
expr {0x100000000 && 1}
} 1
-test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {
expr {1 && 0x100000000}
} 1
-test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {
expr {wide(0x100000000) && 1}
} 1
-test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {
expr {1 && wide(0x100000000)}
} 1
-test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
+test execute-7.5 {Wide int handling in INST_EQ} {
expr {4 == (wide(1)+wide(3))}
} 1
-test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
+test execute-7.6 {Wide int handling in INST_EQ and [incr]} {
set x 399999999999
expr {400000000000 == [incr x]}
} 1
# wide ints have more bits of precision than doubles, but we convert anyway
-test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
+test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
set x [expr {wide(1)<<62}]
set y [expr {$x+1}]
expr {double($x) == double($y)}
} 1
-test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {
+test execute-7.8 {Wide int conversions can change sign} longIs32bit {
set x 0x80000000
expr {int($x) < wide($x)}
} 1
-test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
+test execute-7.9 {Wide int handling in INST_MOD} {
expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
-test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
+test execute-7.10 {Wide int handling in INST_MOD} {
expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
-test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+test execute-7.11 {Wide int handling in INST_LSHIFT} {
expr wide(42)<<30
} 45097156608
-test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+test execute-7.12 {Wide int handling in INST_LSHIFT} {
expr 12345678901<<3
} 98765431208
-test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
+test execute-7.13 {Wide int handling in INST_RSHIFT} {
expr 0x543210febcda9876>>7
} 47397893236700464
-test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
- expr 0x9876543210febcda>>7
+test execute-7.14 {Wide int handling in INST_RSHIFT} {
+ expr wide(0x9876543210febcda)>>7
} -58286587177206407
-test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
- expr 0x9876543210febcda | 0x543210febcda9876
+test execute-7.15 {Wide int handling in INST_BITOR} {
+ expr wide(0x9876543210febcda) | 0x543210febcda9876
} -2560765885044310786
-test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
- expr 0x9876543210febcda ^ 0x543210febcda9876
+test execute-7.16 {Wide int handling in INST_BITXOR} {
+ expr wide(0x9876543210febcda) ^ 0x543210febcda9876
} -3727778945703861076
-test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
- expr 0x9876543210febcda & 0x543210febcda9876
+test execute-7.17 {Wide int handling in INST_BITAND} {
+ expr wide(0x9876543210febcda) & 0x543210febcda9876
} 1167013060659550290
-test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.18 {Wide int handling in INST_ADD} {
expr wide(0x7fffffff)+wide(0x7fffffff)
} 4294967294
-test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.19 {Wide int handling in INST_ADD} {
expr 0x7fffffff+wide(0x7fffffff)
} 4294967294
-test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.20 {Wide int handling in INST_ADD} {
expr wide(0x7fffffff)+0x7fffffff
} 4294967294
-test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.21 {Wide int handling in INST_ADD} {
expr double(0x7fffffff)+wide(0x7fffffff)
} 4294967294.0
-test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.22 {Wide int handling in INST_ADD} {
expr wide(0x7fffffff)+double(0x7fffffff)
} 4294967294.0
-test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
+test execute-7.23 {Wide int handling in INST_SUB} {
expr 0x123456789a-0x20406080a
} 69530054800
-test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
+test execute-7.24 {Wide int handling in INST_MULT} {
expr 0x123456789a*193
} 15090186251290
-test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
+test execute-7.25 {Wide int handling in INST_DIV} {
expr 0x123456789a/193
} 405116546
-test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
+test execute-7.26 {Wide int handling in INST_UPLUS} {
set x 0x123456871234568
expr {+ $x}
} 81985533099853160
-test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
+test execute-7.27 {Wide int handling in INST_UMINUS} {
set x 0x123456871234568
expr {- $x}
} -81985533099853160
-test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
+test execute-7.28 {Wide int handling in INST_LNOT} {
set x 0x123456871234568
expr {! $x}
} 0
-test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
+test execute-7.29 {Wide int handling in INST_BITNOT} {
set x 0x123456871234568
expr {~ $x}
} -81985533099853161
-test execute-7.30 {Wide int handling in function call} {longIs32bit} {
+test execute-7.30 {Wide int handling in function call} {
set x 0x12345687123456
incr x
expr {log($x) == log(double($x))}
} 1
-test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
+test execute-7.31 {Wide int handling in abs()} {
set x 0xa23456871234568
incr x
set y 0x123456871234568
concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
-test execute-7.32 {Wide int handling} {longIs32bit} {
- expr {1024 * 1024 * 1024 * 1024}
+test execute-7.32 {Wide int handling} longIs32bit {
+ expr {int(1024 * 1024 * 1024 * 1024)}
} 0
-test execute-7.33 {Wide int handling} {longIs32bit} {
- expr {0x1 * 1024 * 1024 * 1024 * 1024}
+test execute-7.33 {Wide int handling} longIs32bit {
+ expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 0
-test execute-7.34 {Wide int handling} {longIs32bit} {
+test execute-7.34 {Wide int handling} {
expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 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 {
@@ -724,48 +908,147 @@ 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
- } -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
- set arglst [string repeat "a " 1000]
- proc f {args} "f $arglst"
- proc run {} {
- # bump the interp's epoch
- rename ::set ::dummy
- rename ::dummy ::set
- catch f msg
- set msg
- }
- run
- } -setup {
+ 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} -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?)}
+ 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 {} {
+ # bump the interp's epoch
+ rename ::set ::dummy
+ rename ::dummy ::set
+ catch f msg
+ set msg
+ }
+ run
+} -cleanup {
+ interp recursionlimit {} $limit
+} -result {too many nested evaluations (infinite loop?)}
+test execute-8.4 {Compile epoch bump effect on stack trace} -setup {
+ proc foo {} {
+ error bar
+ }
+ proc FOO {} {
+ catch {error bar} m o
+ rename ::set ::dummy
+ rename ::dummy ::set
+ return -options $o $m
+ }
+} -body {
+ catch foo m o
+ set stack1 [dict get $o -errorinfo]
+ catch FOO m o
+ set stack2 [string map {FOO foo} [dict get $o -errorinfo]]
+ expr {$stack1 eq $stack2 ? {} : "These differ:\n$stack1\n$stack2"}
+} -cleanup {
+ rename foo {}
+ rename FOO {}
+ unset -nocomplain m o stack1 stack2
+} -result {}
+test execute-8.5 {Bug 2038069} -setup {
+ proc demo {} {
+ catch [list error FOO] m o
+ return $o
+ }
+} -body {
+ demo
+} -cleanup {
+ rename demo {}
+} -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO
+ while executing
+"error FOO"
+ invoked from within
+"catch \[list error FOO\] m o"} -errorline 2}
+
+test execute-9.1 {Interp result resetting [Bug 1522803]} {
+ set c 0
+ catch {
+ catch {set foo}
+ expr {1/$c}
+ }
+ if {[string match *foo* $::errorInfo]} {
+ set result "Bad errorInfo: $::errorInfo"
+ } else {
+ set result SUCCESS
+ }
+ set result
+} SUCCESS
+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 {
+ # If [Bug 2802881] is not fixed, this will segfault
+ slave eval {
+ trace add variable ::errorInfo write {expr {$foo} ;#}
+ proc demo {} {a {}{}}
+ demo
+ }
+} -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} {
+ yield $i
+ }
+ }
+ proc t {args} {
+ incr ::foo
+ }
+ trace add execution ::generate enterstep ::t
+} -body {
+ coroutine coro generate 5
+ trace remove execution ::generate enterstep ::t
+ set ::foo
+} -cleanup {
+ unset ::foo
+ rename generate {}
+ rename t {}
+ 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
}
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {rename p ""}
catch {rename {} ""}
@@ -775,3 +1058,8 @@ catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 1817e9a..06a00ba 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -12,15 +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: expr-old.test,v 1.26 2005/07/28 18:42:28 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2.1
- namespace import -force ::tcltest::*
-}
+package require tcltest 2.1
+namespace import ::tcltest::*
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::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]]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+
+if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
testConstraint testmathfunctions 0
} else {
testConstraint testmathfunctions 1
@@ -82,7 +86,7 @@ proc testIEEE {} {
}
}
}
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
# First, test all of the integer operators individually.
@@ -139,7 +143,7 @@ test expr-old-1.50 {integer operators} {expr +36} 36
test expr-old-1.51 {integer operators} {expr +--++36} 36
test expr-old-1.52 {integer operators} {expr +36%+5} 1
test expr-old-1.53 {integer operators} {
- catch {unset x}
+ unset -nocomplain x
set x yes
list [expr {1 && $x}] [expr {$x && 1}] \
[expr {0 || $x}] [expr {$x || 0}]
@@ -447,7 +451,7 @@ test expr-old-23.3 {double quotes} {
test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc}
test expr-old-23.6 {double quotes} {
- catch {unset bogus__}
+ unset -nocomplain bogus__
list [catch {expr {"$bogus__"}} msg] $msg
} {1 {can't read "bogus__": no such variable}}
test expr-old-23.7 {double quotes} {
@@ -460,7 +464,7 @@ test expr-old-23.8 {double quotes} {
# Numbers in various bases.
test expr-old-24.1 {numbers in different bases} {expr 0x20} 32
-test expr-old-24.2 {numbers in different bases} {expr 015} 13
+test expr-old-24.2 {numbers in different bases} {expr 0o15} 13
# Conversions between various data types.
@@ -490,13 +494,13 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0
test expr-old-26.1 {error conditions} {
list [catch {expr 2+"a"} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}
-test expr-old-26.2 {error conditions} {
- list [catch {expr 2+4*} msg] $msg
-} {1 {syntax error in expression "2+4*": premature end of expression}}
-test expr-old-26.3 {error conditions} {
- list [catch {expr 2+4*(} msg] $msg
-} {1 {syntax error in expression "2+4*(": premature end of expression}}
-catch {unset _non_existent_}
+test expr-old-26.2 {error conditions} -body {
+ expr 2+4*
+} -returnCodes error -match glob -result *
+test expr-old-26.3 {error conditions} -body {
+ expr 2+4*(
+} -returnCodes error -match glob -result *
+unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
@@ -507,9 +511,9 @@ test expr-old-26.5 {error conditions} {
test expr-old-26.6 {error conditions} {
list [catch {expr {2+[set a]}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}
-test expr-old-26.7 {error conditions} {
- list [catch {expr {2+(4}} msg] $msg
-} {1 {syntax error in expression "2+(4": looking for close parenthesis}}
+test expr-old-26.7 {error conditions} -body {
+ expr {2+(4}
+} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
@@ -522,33 +526,33 @@ test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
test expr-old-26.10b {error conditions} ieeeFloatingPoint {
list [catch {expr 2.0/0.0} msg] $msg
} {0 Inf}
-test expr-old-26.11 {error conditions} {
- list [catch {expr 2#} msg] $msg
-} {1 {syntax error in expression "2#": extra tokens at end of expression}}
+test expr-old-26.11 {error conditions} -body {
+ expr 2#
+} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
- list [catch {expr a.b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a.b": * preceding $*}}
+ expr a.b
+} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "/"}}
-test expr-old-26.14 {error conditions} {
- list [catch {expr 2:3} msg] $msg
-} {1 {syntax error in expression "2:3": extra tokens at end of expression}}
+test expr-old-26.14 {error conditions} -body {
+ expr 2:3
+} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
- list [catch {expr a@b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a@b": * preceding $*}}
+ expr a@b
+} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} {
list [catch {expr a[b} msg] $msg
} {1 {missing close-bracket}}
test expr-old-26.17 {error conditions} -body {
- list [catch {expr a`b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a`b": * preceding $*}}
-test expr-old-26.18 {error conditions} {
- list [catch {expr \"a\"\{b} msg] $msg
-} {1 syntax\ error\ in\ expression\ \"\"a\"\{b\":\ extra\ tokens\ at\ end\ of\ expression}
+ expr a`b
+} -returnCodes error -match glob -result *
+test expr-old-26.18 {error conditions} -body {
+ expr \"a\"\{b
+} -returnCodes error -match glob -result *
test expr-old-26.19 {error conditions} -body {
- list [catch {expr a} msg] $msg
-} -match glob -result {1 {syntax error in expression "a": * preceding $*}}
+ expr a
+} -returnCodes error -match glob -result *
test expr-old-26.20 {error conditions} {
list [catch expr msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
@@ -575,7 +579,7 @@ test expr-old-27.4 {cancelled evaluation} {
expr {1?2:[set a 2]}
set a
} 1
-catch {unset x}
+unset -nocomplain x
test expr-old-27.5 {cancelled evaluation} {
list [catch {expr {[info exists x] && $x}} msg] $msg
} {0 0}
@@ -597,11 +601,11 @@ test expr-old-27.10 {cancelled evaluation} {
list [catch {expr {($x > 0) ? round(log($x)) : 0}} msg] $msg
} {0 0}
test expr-old-27.11 {cancelled evaluation} -body {
- list [catch {expr {0 && foo}} msg] $msg
-} -match glob -result {1 {syntax error in expression "0 && foo": * preceding $*}}
+ expr {0 && foo}
+} -returnCodes error -match glob -result *
test expr-old-27.12 {cancelled evaluation} -body {
- list [catch {expr {0 ? 1 : foo}} msg] $msg
-} -match glob -result {1 {syntax error in expression "0 ? 1 : foo": * preceding $*}}
+ expr {0 ? 1 : foo}
+} -returnCodes error -match glob -result *
# Tcl_ExprBool as used in "if" statements
@@ -673,12 +677,12 @@ test expr-old-28.14 {Tcl_ExprBool usage} {
# Operands enclosed in braces
test expr-old-29.1 {braces} {expr {{abc}}} abc
-test expr-old-29.2 {braces} {expr {{00010}}} 8
+test expr-old-29.2 {braces} {expr {{0o0010}}} 8
test expr-old-29.3 {braces} {expr {{3.1200000}}} 3.12
test expr-old-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c"
-test expr-old-29.5 {braces} {
- list [catch {expr "\{abc"} msg] $msg
-} {1 {missing close-brace}}
+test expr-old-29.5 {braces} -body {
+ expr "\{abc"
+} -returnCodes error -match glob -result *
# Very long values
@@ -699,15 +703,15 @@ test expr-old-30.2 {long values} {
test expr-old-31.1 {multiple arguments to expr command} {
expr 4 + ( 6 *12) -3
} 73
-test expr-old-31.2 {multiple arguments to expr command} {
- list [catch {expr 2 + (3 + 4} msg] $msg
-} {1 {syntax error in expression "2 + (3 + 4": looking for close parenthesis}}
-test expr-old-31.3 {multiple arguments to expr command} {
- list [catch {expr 2 + 3 +} msg] $msg
-} {1 {syntax error in expression "2 + 3 +": premature end of expression}}
-test expr-old-31.4 {multiple arguments to expr command} {
- list [catch {expr 2 + 3 )} msg] $msg
-} {1 {syntax error in expression "2 + 3 )": extra tokens at end of expression}}
+test expr-old-31.2 {multiple arguments to expr command} -body {
+ expr 2 + (3 + 4
+} -returnCodes error -match glob -result *
+test expr-old-31.3 {multiple arguments to expr command} -body {
+ expr 2 + 3 +
+} -returnCodes error -match glob -result *
+test expr-old-31.4 {multiple arguments to expr command} -body {
+ expr 2 + 3 )
+} -returnCodes error -match glob -result *
# Math functions
@@ -785,8 +789,8 @@ test expr-old-32.24 {math functions in expressions} {
} {66}
test expr-old-32.25a {math functions in expressions} {
- list [catch {expr abs(0x8000000000000000)} msg] $msg
-} {1 {integer value too large to represent}}
+ expr abs(0x8000000000000000)
+} [expr 1<<63]
test expr-old-32.25b {math functions in expressions} {
expr abs(0x80000000)
@@ -814,11 +818,11 @@ test expr-old-32.32 {math functions in expressions} {
expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
- list [catch {expr int(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+ expr int(1e60)
+} 0
test expr-old-32.34 {math functions in expressions} {
- list [catch {expr int(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+ expr int(-1e60)
+} 0
test expr-old-32.35 {math functions in expressions} {
expr round(1.49)
} {1}
@@ -832,11 +836,11 @@ test expr-old-32.38 {math functions in expressions} {
expr round(-1.51)
} {-2}
test expr-old-32.39 {math functions in expressions} {
- list [catch {expr round(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+ expr round(1e60)
+} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.40 {math functions in expressions} {
- list [catch {expr round(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+ expr round(-1e60)
+} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
@@ -858,12 +862,12 @@ test expr-old-32.46 {math functions in expressions} -body {
test expr-old-32.47 {math functions in expressions} -body {
list [catch {expr srand()} msg] $msg
} -match glob -result {1 {too few arguments for math function*}}
-test expr-old-32.48 {math functions in expressions} {
- list [catch {expr srand(3.79)} msg] $msg
-} {1 {can't use floating-point value as argument to srand}}
-test expr-old-32.49 {math functions in expressions} {
- list [catch {expr srand("")} msg] $msg
-} {1 {argument to math function didn't have numeric value}}
+test expr-old-32.48 {math functions in expressions} -body {
+ expr srand(3.79)
+} -returnCodes error -match glob -result *
+test expr-old-32.49 {math functions in expressions} -body {
+ expr srand("")
+} -returnCodes error -match glob -result *
test expr-old-32.50 {math functions in expressions} {
set result [expr round(srand(12345) * 1000)]
for {set i 0} {$i < 10} {incr i} {
@@ -871,11 +875,11 @@ test expr-old-32.50 {math functions in expressions} {
}
set result
} {97 834 948 36 12 51 766 585 914 784 333}
-test expr-old-32.51 {math functions in expressions} {
- list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
-} {1 {argument to math function didn't have numeric value}}
+test expr-old-32.51 {math functions in expressions} -body {
+ expr {srand([lindex "6ty" 0])}
+} -returnCodes error -match glob -result *
test expr-old-32.52 {math functions in expressions} {
- expr {srand(1<<37) < 1}
+ expr {srand(int(1<<37)) < 1}
} {1}
test expr-old-32.53 {math functions in expressions} {
expr {srand((1<<31) - 1) > 0}
@@ -898,20 +902,20 @@ test expr-old-34.1 {errors in math functions} -body {
list [catch {expr func_2(1.0)} msg] $msg
} -match glob -result {1 {* "*func_2"}}
test expr-old-34.2 {errors in math functions} -body {
- list [catch {expr func|(1.0)} msg] $msg
-} -match glob -result {1 {syntax error in expression "func|(1.0)": * preceding $*}}
+ expr func|(1.0)
+} -returnCodes error -match glob -result *
test expr-old-34.3 {errors in math functions} {
list [catch {expr {hypot("a b", 2.0)}} msg] $msg
} {1 {expected floating-point number but got "a b"}}
-test expr-old-34.4 {errors in math functions} {
- list [catch {expr hypot(1.0 2.0)} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 2.0)": missing close parenthesis at end of function call}}
-test expr-old-34.5 {errors in math functions} {
- list [catch {expr hypot(1.0, 2.0} msg] $msg
-} {1 {syntax error in expression "hypot(1.0, 2.0": missing close parenthesis at end of function call}}
-test expr-old-34.6 {errors in math functions} {
- list [catch {expr hypot(1.0 ,} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 ,": premature end of expression}}
+test expr-old-34.4 {errors in math functions} -body {
+ expr hypot(1.0 2.0)
+} -returnCodes error -match glob -result *
+test expr-old-34.5 {errors in math functions} -body {
+ expr hypot(1.0, 2.0
+} -returnCodes error -match glob -result *
+test expr-old-34.6 {errors in math functions} -body {
+ expr hypot(1.0 ,
+} -returnCodes error -match glob -result *
test expr-old-34.7 {errors in math functions} -body {
list [catch {expr hypot(1.0)} msg] $msg
} -match glob -result {1 {too few arguments for math function*}}
@@ -937,27 +941,27 @@ test expr-old-34.12b {errors in math functions} ieeeFloatingPoint {
list [catch {expr -14.0*exp(100000)} msg] $msg
} {0 -Inf}
test expr-old-34.13 {errors in math functions} {
- list [catch {expr int(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+ expr wide(1.0e30)
+} 5076964154930102272
test expr-old-34.14 {errors in math functions} {
- list [catch {expr int(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+ expr wide(-1.0e30)
+} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
- list [catch {expr round(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+ expr round(1.0e30)
+} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
- list [catch {expr round(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+ expr round(-1.0e30)
+} -1000000000000000019884624838656
test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
-body {
list [catch {expr T1(4)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
- expr 0289
+ expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
- set x 0289
+ set x 0o289
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
@@ -986,14 +990,14 @@ test expr-old-36.9 {ExprLooksLikeInt procedure} {
} {0 240.0}
test expr-old-36.10 {ExprLooksLikeInt procedure} -body {
expr 78e
-} -returnCodes error -match glob -result {syntax error in expression "78e"*}
+} -returnCodes error -match glob -result *
# test for [Bug #542588]
test expr-old-36.11 {ExprLooksLikeInt procedure} {
# define a "too large integer"; this one works also for 64bit arith
set x 665802003400000000000000
- list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
+ expr {$x+1}
+} 665802003400000000000001
# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
@@ -1006,19 +1010,16 @@ test expr-old-36.13 {ExprLooksLikeInt procedure} {
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
set x "123456789012345678901234567890 "
- list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
+ expr {$x+1}
+} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
- set x "099 "
+ set x "0o99 "
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
set x " 0xffffffffffffffffffffffffffffffffffffff "
- list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
-
-testConstraint testexprlong [llength [info commands testexprlong]]
-testConstraint testexprstring [llength [info commands testexprstring]]
+ expr {$x+1}
+} [expr 0x100000000000000000000000000000000000000]
test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
testexprlong 4+1
@@ -1028,10 +1029,102 @@ test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
testexprlong wide(1)+2
} {This is a result: 3}
-test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
+test expr-old-37.3 {Tcl_ExprLong on the empty string} testexprlong {
+ testexprlong ""
+} {This is a result: 0}
+test expr-old-37.4 {Tcl_ExprLong coerces doubles} testexprlong {
+ testexprlong 3+.14159
+} {This is a result: 3}
+test expr-old-37.5 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.6 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 0xffffffff
+} {This is a result: -1}
+test expr-old-37.7 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
+ testexprlong -0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong -0xffffffff
+} {This is a result: 1}
+test expr-old-37.10 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong -0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.11 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.12 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 4294967295.
+} {This is a result: -1}
+test expr-old-37.13 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
+ testexprlong -2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong -4294967295.
+} {This is a result: 1}
+test expr-old-37.16 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+
+test expr-old-37.17 {Check that Tcl_ExprDouble doesn't modify interpreter result if no error} testexprdouble {
+ testexprdouble 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-old-37.18 {Tcl_ExprDouble on the empty string} testexprdouble {
+ testexprdouble ""
+} {This is a result: 0.0}
+test expr-old-37.19 {Tcl_ExprDouble coerces wides} testexprdouble {
+ testexprdouble 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-old-37.20 {Tcl_ExprDouble coerces bignums} testexprdouble {
+ testexprdouble 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-old-37.21 {Tcl_ExprDouble handles overflows} testexprdouble {
+ testexprdouble 17976931348623157[string repeat 0 292].
+} {This is a result: 1.7976931348623157e+308}
+test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} \
+ testexprdouble {
+ testexprdouble 17976931348623157[string repeat 0 292]
+ } {This is a result: 1.7976931348623157e+308}
+test expr-old-37.23 {Tcl_ExprDouble handles overflows} \
+ ieeeFloatingPoint&&testexprdouble {
+ testexprdouble 17976931348623165[string repeat 0 292].
+ } {This is a result: Inf}
+test expr-old-37.24 {Tcl_ExprDouble handles overflows that look like int} \
+ ieeeFloatingPoint&&testexprdouble {
+ testexprdouble 17976931348623165[string repeat 0 292]
+ } {This is a result: Inf}
+test expr-old-37.25 {Tcl_ExprDouble and NaN} \
+ {ieeeFloatingPoint testexprdouble} {
+ list [catch {testexprdouble 0.0/0.0} result] $result
+ } {1 {domain error: argument not in valid range}}
+
+test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
[catch {testexprstring "1+"} msg] $msg
-} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}
+} -match glob -result {5 10.2 1 *}
test expr-old-38.2 {Tcl_ExprString} testexprstring {
# This one is "magical"
testexprstring {}
@@ -1055,6 +1148,48 @@ test expr-old-39.1 {Rounding with wide result} {
} {1 1}
unset -nocomplain x y
+#
+# TIP #255 min and max math functions
+#
+
+test expr-old-40.1 {min math function} -body {
+ expr {min(0)}
+} -result 0
+test expr-old-40.2 {min math function} -body {
+ expr {min(0.0)}
+} -result 0.0
+test expr-old-40.3 {min math function} -body {
+ list [catch {expr {min()}} msg] $msg
+} -result {1 {too few arguments to math function "min"}}
+test expr-old-40.4 {min math function} -body {
+ expr {min(wide(-1) << 30, 4.5, -10)}
+} -result [expr {wide(-1) << 30}]
+test expr-old-40.5 {min math function} -body {
+ expr {min("a", 0)}
+} -returnCodes error -match glob -result *
+test expr-old-40.6 {min math function} -body {
+ expr {min(300, "0xFF")}
+} -result 255
+
+test expr-old-41.1 {max math function} -body {
+ expr {max(0)}
+} -result 0
+test expr-old-41.2 {max math function} -body {
+ expr {max(0.0)}
+} -result 0.0
+test expr-old-41.3 {max math function} -body {
+ list [catch {expr {max()}} msg] $msg
+} -result {1 {too few arguments to math function "max"}}
+test expr-old-41.4 {max math function} -body {
+ expr {max(wide(1) << 30, 4.5, -10)}
+} -result [expr {wide(1) << 30}]
+test expr-old-41.5 {max math function} -body {
+ expr {max("a", 0)}
+} -returnCodes error -match glob -result *
+test expr-old-41.6 {max math function} -body {
+ expr {max(200, "0xFF")}
+} -result 255
+
# Special test for Pentium arithmetic bug of 1994:
if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
@@ -1067,3 +1202,7 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/expr.test b/tests/expr.test
index 50159c0..6ad7208 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -9,16 +9,17 @@
#
# 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.44 2005/08/29 17:54:22 kennykb 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 {unknown math function "T1"})
+ ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]
# Determine if "long int" type is a 32 bit number and if the wide
@@ -26,7 +27,8 @@ testConstraint testmathfunctions [expr {
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+testConstraint wideIs64bit \
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
# Big test for correct ordering of data in [expr]
@@ -54,6 +56,8 @@ 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)
set ieeeValues(littleEndian) 1
return 1
}
@@ -76,6 +80,8 @@ 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)
set ieeeValues(littleEndian) 0
return 1
}
@@ -198,33 +204,28 @@ test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with co
test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
expr double(5*[llength "6 2"])
} 10.0
-test expr-2.2 {TclCompileExpr: error in expr} {
- catch {expr 2***3} msg
- set msg
-} {syntax error in expression "2***3": unexpected operator *}
-test expr-2.3 {TclCompileExpr: junk after legal expr} {
- catch {expr 7*[llength "a b"]foo} msg
- set msg
-} {syntax error in expression "7*2foo": extra tokens at end of expression}
+test expr-2.2 {TclCompileExpr: error in expr} -body {
+ expr 2***3
+} -returnCodes error -match glob -result *
+test expr-2.3 {TclCompileExpr: junk after legal expr} -body {
+ expr 7*[llength "a b"]foo
+} -returnCodes error -match glob -result *
test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
expr {0001}
} 1
test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
test expr-3.2 {CompileCondExpr: error in lor expr} -body {
- catch {expr x||3} msg
- set msg
-} -match glob -result {syntax error in expression "x||3": * preceding $*}
+ expr x||3
+} -returnCodes error -match glob -result *
test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
-test expr-3.4 {CompileCondExpr: error compiling true arm} {
- catch {expr 3>2?2***3:66} msg
- set msg
-} {syntax error in expression "3>2?2***3:66": unexpected operator *}
+test expr-3.4 {CompileCondExpr: error compiling true arm} -body {
+ expr 3>2?2***3:66
+} -returnCodes error -match glob -result *
test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
-test expr-3.6 {CompileCondExpr: error compiling false arm} {
- catch {expr 2>3?44:2***3} msg
- set msg
-} {syntax error in expression "2>3?44:2***3": unexpected operator *}
+test expr-3.6 {CompileCondExpr: error compiling false arm} -body {
+ expr 2>3?44:2***3
+} -returnCodes error -match glob -result *
test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {
hello_world
} {Hello world}
@@ -235,20 +236,17 @@ test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} unix {
test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
test expr-4.2 {CompileLorExpr: error in land expr} -body {
- catch {expr x&&3} msg
- set msg
-} -match glob -result {syntax error in expression "x&&3": *preceding $*}
+ expr x&&3
+} -returnCodes error -match glob -result *
test expr-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
test expr-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
test expr-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
-test expr-4.6 {CompileLorExpr: error compiling lor arm} {
- catch {expr 2***3||4.0} msg
- set msg
-} {syntax error in expression "2***3||4.0": unexpected operator *}
-test expr-4.7 {CompileLorExpr: error compiling lor arm} {
- catch {expr 1.3||2***3} msg
- set msg
-} {syntax error in expression "1.3||2***3": unexpected operator *}
+test expr-4.6 {CompileLorExpr: error compiling lor arm} -body {
+ expr 2***3||4.0
+} -returnCodes error -match glob -result *
+test expr-4.7 {CompileLorExpr: error compiling lor arm} -body {
+ expr 1.3||2***3
+} -returnCodes error -match glob -result *
test expr-4.8 {CompileLorExpr: error compiling lor arms} {
list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -269,21 +267,18 @@ test expr-4.12 {CompileLorExpr: error compiling land arms} {
test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
test expr-5.2 {CompileLandExpr: error in bitor expr} -body {
- catch {expr x|3} msg
- set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*}
+ expr x|3
+} -returnCodes error -match glob -result *
test expr-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
test expr-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
test expr-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
test expr-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
-test expr-5.7 {CompileLandExpr: error compiling land arm} {
- catch {expr 2***3&&4.0} msg
- set msg
-} {syntax error in expression "2***3&&4.0": unexpected operator *}
-test expr-5.8 {CompileLandExpr: error compiling land arm} {
- catch {expr 1.3&&2***3} msg
- set msg
-} {syntax error in expression "1.3&&2***3": unexpected operator *}
+test expr-5.7 {CompileLandExpr: error compiling land arm} -body {
+ expr 2***3&&4.0
+} -returnCodes error -match glob -result *
+test expr-5.8 {CompileLandExpr: error compiling land arm} -body {
+ expr 1.3&&2***3
+} -returnCodes error -match glob -result *
test expr-5.9 {CompileLandExpr: error compiling land arm} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -295,21 +290,18 @@ test expr-5.10 {CompileLandExpr: long land arms} {
test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
test expr-6.2 {CompileBitXorExpr: error in bitand expr} -body {
- catch {expr x|3} msg
- set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*}
+ expr x|3
+} -returnCodes error -match glob -result *
test expr-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
test expr-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
test expr-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
test expr-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
-test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
- catch {expr 2***3|6} msg
- set msg
-} {syntax error in expression "2***3|6": unexpected operator *}
+test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body {
+ expr 2***3|6
+} -returnCodes error -match glob -result *
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
- catch {expr 2^x} msg
- set msg
-} -match glob -result {syntax error in expression "2^x": * preceding $**}
+ expr 2^x
+} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value as operand of "^"}}
@@ -322,21 +314,18 @@ test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test expr-7.5 {CompileBitAndExpr: error in equality expr} -body {
- catch {expr x==3} msg
- set msg
-} -match glob -result {syntax error in expression "x==3": * preceding $*}
+ expr x==3
+} -returnCodes error -match glob -result *
test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
-test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} {
- catch {expr 2***3&6} msg
- set msg
-} {syntax error in expression "2***3&6": unexpected operator *}
+test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
+ expr 2***3&6
+} -returnCodes error -match glob -result *
test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
- catch {expr 2&x} msg
- set msg
-} -match glob -result {syntax error in expression "2&x": * preceding $*}
+ expr 2&x
+} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value as operand of "&"}}
@@ -346,32 +335,28 @@ test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
- catch {expr xne3} msg
- set msg
-} -match glob -result {syntax error in expression "xne3": * preceding $*}
+ expr xne3
+} -returnCodes error -match glob -result *
test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test expr-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
test expr-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test expr-8.5 {CompileEqualityExpr: error in relational expr} -body {
- catch {expr x>3} msg
- set msg
-} -match glob -result {syntax error in expression "x>3": * preceding $*}
+ expr x>3
+} -returnCodes error -match glob -result *
test expr-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
test expr-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
test expr-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
test expr-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
-test expr-8.10 {CompileEqualityExpr: error compiling equality arm} {
- catch {expr 2***3==6} msg
- set msg
-} {syntax error in expression "2***3==6": unexpected operator *}
+test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
+ expr 2***3==6
+} -returnCodes error -match glob -result *
test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
- catch {expr 2!=x} msg
- set msg
-} -match glob -result {syntax error in expression "2!=x": * preceding $*}
+ expr 2!=x
+} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
-test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1
+test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1
test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
@@ -379,22 +364,18 @@ test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0
test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1
test expr-8.20 {CompileBitAndExpr: error in equality expr} -body {
- catch {expr x ne3} msg
- set msg
-} -match glob -result {syntax error in expression "x ne3": * preceding $*}
+ expr x ne3
+} -returnCodes error -match glob -result *
test expr-8.21 {CompileBitAndExpr: error in equality expr} -body {
# These should be ""ed to avoid the error
- catch {expr a eq b} msg
- set msg
-} -match glob -result {syntax error in expression "a eq b": * preceding $*}
-test expr-8.22 {CompileBitAndExpr: error in equality expr} {
- catch {expr {false eqfalse}} msg
- set msg
-} {syntax error in expression "false eqfalse": extra tokens at end of expression}
-test expr-8.23 {CompileBitAndExpr: error in equality expr} {
- catch {expr {false nefalse}} msg
- set msg
-} {syntax error in expression "false nefalse": extra tokens at end of expression}
+ expr a eq b
+} -returnCodes error -match glob -result *
+test expr-8.22 {CompileBitAndExpr: error in equality expr} -body {
+ expr {false eqfalse}
+} -returnCodes error -match glob -result *
+test expr-8.23 {CompileBitAndExpr: error in equality expr} -body {
+ expr {false nefalse}
+} -returnCodes error -match glob -result *
test expr-8.24 {CompileEqualityExpr: simple equality exprs} {
set x 12398712938788234
expr {$x == 100}
@@ -420,65 +401,59 @@ test expr-8.29 {CompileEqualityExpr: just relational expr} {
test expr-8.30 {CompileEqualityExpr: simple equality exprs} {
expr {"fake" != "bob"}
} 1
-test expr-8.31 {expr edge cases} {
- list [catch {expr {1e}} err] $err
-} {1 {syntax error in expression "1e": extra tokens at end of expression}}
-test expr-8.32 {expr edge cases} {
- list [catch {expr {1E}} err] $err
-} {1 {syntax error in expression "1E": extra tokens at end of expression}}
-test expr-8.33 {expr edge cases} {
- list [catch {expr {1e+}} err] $err
-} {1 {syntax error in expression "1e+": extra tokens at end of expression}}
-test expr-8.34 {expr edge cases} {
- list [catch {expr {1E+}} err] $err
-} {1 {syntax error in expression "1E+": extra tokens at end of expression}}
-test expr-8.35 {expr edge cases} {
- list [catch {expr {1ea}} err] $err
-} {1 {syntax error in expression "1ea": extra tokens at end of expression}}
+test expr-8.31 {expr edge cases} -body {
+ expr {1e}
+} -returnCodes error -match glob -result *
+test expr-8.32 {expr edge cases} -body {
+ expr {1E}
+} -returnCodes error -match glob -result *
+test expr-8.33 {expr edge cases} -body {
+ expr {1e+}
+} -returnCodes error -match glob -result *
+test expr-8.34 {expr edge cases} -body {
+ expr {1E+}
+} -returnCodes error -match glob -result *
+test expr-8.35 {expr edge cases} -body {
+ expr {1ea}
+} -returnCodes error -match glob -result *
test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
- expr {1<<63}
+ expr {int(1<<63)}
} -9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
- expr {1<<31}
+ expr {int(1<<31)}
} -2147483648
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
- catch {expr x>>3} msg
- set msg
-} -match glob -result {syntax error in expression "x>>3": * preceding $*}
+ expr x>>3
+} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
-test expr-9.9 {CompileRelationalExpr: error compiling relational arm} {
- catch {expr 2***3>6} msg
- set msg
-} {syntax error in expression "2***3>6": unexpected operator *}
+test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
+ expr 2***3>6
+} -returnCodes error -match glob -result *
test expr-9.10 {CompileRelationalExpr: error compiling relational arm} -body {
- catch {expr 2<x} msg
- set msg
-} -match glob -result {syntax error in expression "2<x": * preceding $*}
+ expr 2<x
+} -returnCodes error -match glob -result *
test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
test expr-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0o123} -82
test expr-10.5 {CompileShiftExpr: error in add expr} -body {
- catch {expr x+3} msg
- set msg
-} -match glob -result {syntax error in expression "x+3": * preceding $*}
+ expr x+3
+} -returnCodes error -match glob -result *
test expr-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
test expr-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
-test expr-10.8 {CompileShiftExpr: error compiling shift arm} {
- catch {expr 2***3>>6} msg
- set msg
-} {syntax error in expression "2***3>>6": unexpected operator *}
+test expr-10.8 {CompileShiftExpr: error compiling shift arm} -body {
+ expr 2***3>>6
+} -returnCodes error -match glob -result *
test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
- catch {expr 2<<x} msg
- set msg
-} -match glob -result {syntax error in expression "2<<x": * preceding $*}
+ expr 2<<x
+} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value as operand of ">>"}}
@@ -489,21 +464,18 @@ test expr-10.11 {CompileShiftExpr: runtime error} {
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
- catch {expr x*3} msg
- set msg
-} -match glob -result {syntax error in expression "x*3": * preceding $*}
+ expr x*3
+} -returnCodes error -match glob -result *
test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
-test expr-11.8 {CompileAddExpr: error compiling add arm} {
- catch {expr 2***3+6} msg
- set msg
-} {syntax error in expression "2***3+6": unexpected operator *}
+test expr-11.8 {CompileAddExpr: error compiling add arm} -body {
+ expr 2***3+6
+} -returnCodes error -match glob -result *
test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
- catch {expr 2-x} msg
- set msg
-} -match glob -result {syntax error in expression "2-x": * preceding $*}
+ expr 2-x
+} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "+"}}
@@ -525,19 +497,16 @@ test expr-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
test expr-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
test expr-12.5 {CompileMultiplyExpr: error in unary expr} -body {
- catch {expr ~x} msg
- set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
+ expr ~x
+} -returnCodes error -match glob -result *
test expr-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
test expr-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
-test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
- catch {expr 2*3%%6} msg
- set msg
-} {syntax error in expression "2*3%%6": unexpected operator %}
+test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body {
+ expr 2*3%%6
+} -returnCodes error -match glob -result *
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
- catch {expr 2*x} msg
- set msg
-} -match glob -result {syntax error in expression "2*x": * preceding $*}
+ expr 2*x
+} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "*"}}
@@ -546,20 +515,18 @@ test expr-12.11 {CompileMultiplyExpr: runtime error} {
} {1 {can't use non-numeric string as operand of "/"}}
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
- catch {expr ~x} msg
- set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
-test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
- catch {expr !1.x} msg
- set msg
-} {syntax error in expression "!1.x": extra tokens at end of expression}
+ expr ~x
+} -returnCodes error -match glob -result *
+test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
+ expr !1.x
+} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "~"}}
@@ -587,7 +554,7 @@ test expr-13.17 {CompileUnaryExpr: negating non-numeric boolean literals} {
test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8
test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
test expr-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
@@ -625,14 +592,11 @@ test expr-14.15 {CompilePrimaryExpr: var reference primary} {
set msg
} 123.2
test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
- catch {expr {$a(foo}} msg
- set errorInfo
-} -match glob -result {missing )
- while *ing
-"expr {$a(foo}"}
-test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+ expr {$a(foo}
+} -returnCodes error -match glob -result *
+test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body {
expr $
-} $
+} -returnCodes error -match glob -result *
test expr-14.18 {CompilePrimaryExpr: quoted string primary} {
expr "21"
} 21
@@ -655,16 +619,13 @@ test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
} 123
test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
- catch {expr {[set i}} msg
- set errorInfo
-} -match glob -result {missing close-bracket
- while *ing
-"expr {\[set i}"}
+ expr {[set i}
+} -returnCodes error -match glob -result *
test expr-14.25 {CompilePrimaryExpr: math function primary} {
format %.6g [expr exp(1.0)]
} 2.71828
@@ -672,73 +633,58 @@ test expr-14.26 {CompilePrimaryExpr: math function primary} {
format %.6g [expr pow(2.0+0.1,3.0+0.1)]
} 9.97424
test expr-14.27 {CompilePrimaryExpr: error in math function primary} -body {
- catch {expr sinh::(2.0)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sinh::(2.0)": * function arguments*
- while *ing
-"expr sinh::(2.0)"}
+ expr sinh::(2.0)
+} -returnCodes error -match glob -result *
test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
} 14
test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
- catch {expr 2+(3*(4+5)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
- while *ing
-"expr 2+(3*(4+5)"}
+ expr 2+(3*(4+5)
+} -returnCodes error -match glob -result *
test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
} {{15 == 15} {15 == 15} {15 == 15}}
test expr-14.32 {CompilePrimaryExpr: unexpected token} -body {
- catch {expr @} msg
- set errorInfo
-} -match glob -result {syntax error in expression "@": character not legal in expressions
- while *ing
-"expr @"}
+ expr @
+} -returnCodes error -match glob -result *
test expr-15.1 {CompileMathFuncCall: missing parenthesis} -body {
- catch {expr sinh2.0)} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sinh2.0)": * preceding $*
- while *ing
-"expr sinh2.0)"}
+ expr sinh2.0)
+} -returnCodes error -match glob -result *
test expr-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {* "*whazzathuh"
while *ing
"expr whazzathuh(1)"}
test expr-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too many arguments for math function*
while *ing
"expr sin(1,2,3)"}
test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
- catch {expr sin(1} msg
- set errorInfo
-} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
- while *ing
-"expr sin(1"}
+ expr sin(1
+} -returnCodes error -match glob -result *
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr 2*T1()
} 246
@@ -766,9 +712,15 @@ test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunct
test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(21.0, wide(37))
} 37.0
-test expr=15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
+test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
expr T3(wide(21), 37.0)
} 37.0
+test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
+ testmathfunctions
+} -body {
+ expr T3(0,"a")
+} -returnCodes error -result {argument to math function didn't have numeric value}
+
test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
@@ -836,7 +788,7 @@ test expr-20.1 {wrong brace matching} {
set cmd "expr $l$q|$q == $q$r$q$r"
list [catch $cmd a] $a
} {1 {extra characters after close-brace}}
-test expr-20.2 {double invocation of variable traces} {
+test expr-20.2 {double invocation of variable traces} -body {
set exprtracecounter 0
proc exprtraceproc {args} {
upvar #0 exprtracecounter counter
@@ -854,7 +806,7 @@ test expr-20.2 {double invocation of variable traces} {
list [catch {expr "$exprtracevar + 20"} a] $a \
[catch {expr "$exprtracevar + 20"} b] $b \
[unset exprtracevar exprtracecounter]
-} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 32 {}}
+} -match glob -result {1 * 0 32 {}}
test expr-20.3 {broken substitution of integer digits} {
# fails with 8.0.x, but not 8.1b2
list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
@@ -887,9 +839,9 @@ test expr-21.9 {non-numeric boolean literals} {expr !off } 1
test expr-21.10 {non-numeric boolean literals} {expr !on } 0
test expr-21.11 {non-numeric boolean literals} {expr !no } 1
test expr-21.12 {non-numeric boolean literals} {expr !yes } 0
-test expr-21.13 {non-numeric boolean literals} {
- list [catch {expr !truef} err] $err
-} {1 {syntax error in expression "!truef": the word "truef" requires a preceding $ if it's a variable or function arguments if it's a function}}
+test expr-21.13 {non-numeric boolean literals} -body {
+ expr !truef
+} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
list [catch {expr !"truef"} err] $err
} {1 {can't use non-numeric string as operand of "!"}}
@@ -965,18 +917,15 @@ test expr-23.2 {CompileExponentialExpr: just exponential expr} {expr 0xff**2} 65
test expr-23.3 {CompileExponentialExpr: just exponential expr} {expr -1**2} 1
test expr-23.4 {CompileExponentialExpr: just exponential expr} {expr 18**07} 612220032
test expr-23.5 {CompileExponentialExpr: error in exponential expr} -body {
- catch {expr x**3} msg
- set msg
-} -match glob -result {syntax error in expression "x**3": * preceding $*}
+ expr x**3
+} -returnCodes error -match glob -result *
test expr-23.6 {CompileExponentialExpr: simple expo exprs} {expr 0xff**0x3} 16581375
-test expr-23.7 {CompileExponentialExpr: error compiling expo arm} {
- catch {expr (-3-)**6} msg
- set msg
-} {syntax error in expression "(-3-)**6": unexpected close parenthesis}
+test expr-23.7 {CompileExponentialExpr: error compiling expo arm} -body {
+ expr (-3-)**6
+} -returnCodes error -match glob -result *
test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
- catch {expr 2**x} msg
- set msg
-} -match glob -result {syntax error in expression "2**x": * preceding $*}
+ expr 2**x
+} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
list [catch {expr {24.0**"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "**"}}
@@ -1014,18 +963,486 @@ test expr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1
test expr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0
test expr-23.34 {INST_EXPON: special cases} {expr {2**0}} 1
test expr-23.35 {INST_EXPON: special cases} {expr {wide(2)**0}} 1
+test expr-23.36 {INST_EXPON: big integer} {expr {10**17}} 1[string repeat 0 17]
+test expr-23.37 {INST_EXPON: big integer} {expr {10**18}} 1[string repeat 0 18]
+test expr-23.38 {INST_EXPON: big integer} {expr {10**19}} 1[string repeat 0 19]
+test expr-23.39 {INST_EXPON: big integer} {
+ expr 1[string repeat 0 30]**2
+} 1[string repeat 0 60]
+test expr-23.40 {INST_EXPON: overflow to big integer} {expr {(-10)**3}} -1000
+test expr-23.41 {INST_EXPON: overflow to big integer} {expr 2**64} [expr 1<<64]
+test expr-23.42 {INST_EXPON: overflow to big integer} {expr 4**32} [expr 1<<64]
+test expr-23.43 {INST_EXPON: overflow to big integer} {expr 16**16} [expr 1<<64]
+test expr-23.44 {INST_EXPON: overflow to big integer} {expr 256**8} [expr 1<<64]
+test expr-23.45 {INST_EXPON: Bug 1555371} {expr 2**1} 2
+test expr-23.46 {INST_EXPON: Bug 1561260} -body {
+ expr 5**28
+} -match glob -result *5
+test expr-23.47 {INST_EXPON: Bug 1561260} {
+ expr 2**32*5**32
+} 1[string repeat 0 32]
+test expr-23.48 {INST_EXPON: TIP 274: right assoc} {
+expr 2**3**4
+} 2417851639229258349412352
+test expr-23.49 {INST_EXPON: optimize powers of 2} {
+ set trouble {test powers of 2}
+ for {set tval 0} {$tval <= 66} {incr tval} {
+ set is [expr {2 ** $tval}]
+ set sb [expr {1 << $tval}]
+ if {$is != $sb} {
+ append trouble \n "2**" $tval " is " $is " should be " $sb
+ }
+ if {$tval >= 1} {
+ set is [expr {-2 ** $tval}]
+ set sb [expr {1 << $tval}]
+ if {$tval & 1} {
+ set sb [expr {-$sb}]
+ }
+ if {$is != $sb} {
+ append trouble \n "-2**" $tval " is " $is " should be " $sb
+ }
+ }
+ }
+ set trouble
+} {test powers of 2}
+test expr-23.50 {INST_EXPON: small powers of 32-bit integers} {
+ set trouble {test small powers of 32-bit ints}
+ for {set base 3} {$base <= 45} {incr base} {
+ set sb $base
+ set sbm [expr {-$base}]
+ for {set expt 2} {$expt <= 8} {incr expt} {
+ set sb [expr {$sb * $base}]
+ set is [expr {$base ** $expt}]
+ if {$sb != $is} {
+ append trouble \n $base ** $expt " is " $is " should be " $sb
+ }
+ set sbm [expr {-$sbm * $base}]
+ set ism [expr {(-$base) ** $expt}]
+ if {$sbm != $ism} {
+ append trouble \n - $base ** $expt " is " $ism \
+ " should be " $sbm
+ }
+ }
+ }
+ set trouble
+} {test small powers of 32-bit ints}
+test expr-23.51 {INST_EXPON: intermediate powers of 32-bit integers} {
+ set trouble {test intermediate powers of 32-bit ints}
+ for {set base 3} {$base <= 11} {incr base} {
+ set sb [expr {$base ** 8}]
+ set sbm $sb
+ for {set expt 9} {$expt <= 21} {incr expt} {
+ set sb [expr {$sb * $base}]
+ set sbm [expr {$sbm * -$base}]
+ set is [expr {$base ** $expt}]
+ set ism [expr {-$base ** $expt}]
+ if {$sb != $is} {
+ append trouble \n $base ** $expt " is " $is " should be " $sb
+ }
+ if {$sbm != $ism} {
+ append trouble \n - $base ** $expt " is " $ism \
+ " should be " $sbm
+ }
+ }
+ }
+ set trouble
+} {test intermediate powers of 32-bit ints}
+test expr-23.52 {INST_EXPON: small integer powers with 64-bit results} {
+ set trouble {test small int powers with 64-bit results}
+ for {set exp 2} {$exp <= 16} {incr exp} {
+ set base [expr {entier(pow(double(0x7fffffffffffffff),(1.0/$exp)))}]
+ set sb 1
+ set sbm 1
+ for {set i 0} {$i < $exp} {incr i} {
+ set sb [expr {$sb * $base}]
+ set sbm [expr {$sbm * -$base}]
+ }
+ set is [expr {$base ** $exp}]
+ set ism [expr {-$base ** $exp}]
+ if {$sb != $is} {
+ append trouble \n $base ** $exp " is " $is " should be " $sb
+ }
+ if {$sbm != $ism} {
+ append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+ }
+ incr base
+ set sb 1
+ set sbm 1
+ for {set i 0} {$i < $exp} {incr i} {
+ set sb [expr {$sb * $base}]
+ set sbm [expr {$sbm * -$base}]
+ }
+ set is [expr {$base ** $exp}]
+ set ism [expr {-$base ** $exp}]
+ if {$sb != $is} {
+ append trouble \n $base ** $exp " is " $is " should be " $sb
+ }
+ if {$sbm != $ism} {
+ append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+ }
+ }
+ set trouble
+} {test small int powers with 64-bit results}
+test expr-23.53 {INST_EXPON: intermediate powers of 64-bit integers} {
+ set trouble {test intermediate powers of 64-bit ints}
+ for {set base 3} {$base <= 13} {incr base} {
+ set sb [expr {$base ** 15}]
+ set sbm [expr {-$sb}]
+ for {set expt 16} {$expt <= 39} {incr expt} {
+ set sb [expr {$sb * $base}]
+ set sbm [expr {$sbm * -$base}]
+ set is [expr {$base ** $expt}]
+ set ism [expr {-$base ** $expt}]
+ if {$sb != $is} {
+ append trouble \n $base ** $expt " is " $is " should be " $sb
+ }
+ if {$sbm != $ism} {
+ append trouble \n - $base ** $expt " is " $ism \
+ " should be " $sbm
+ }
+ }
+ }
+ set trouble
+} {test intermediate powers of 64-bit ints}
+test expr-23.54.0 {INST_EXPON: Bug 2798543} {
+ expr {3**9 == 3**65545}
+} 0
+test expr-23.54.1 {INST_EXPON: Bug 2798543} {
+ expr {3**10 == 3**65546}
+} 0
+test expr-23.54.2 {INST_EXPON: Bug 2798543} {
+ expr {3**11 == 3**65547}
+} 0
+test expr-23.54.3 {INST_EXPON: Bug 2798543} {
+ expr {3**12 == 3**65548}
+} 0
+test expr-23.54.4 {INST_EXPON: Bug 2798543} {
+ expr {3**13 == 3**65549}
+} 0
+test expr-23.54.5 {INST_EXPON: Bug 2798543} {
+ expr {3**14 == 3**65550}
+} 0
+test expr-23.54.6 {INST_EXPON: Bug 2798543} {
+ expr {3**15 == 3**65551}
+} 0
+test expr-23.54.7 {INST_EXPON: Bug 2798543} {
+ expr {3**16 == 3**65552}
+} 0
+test expr-23.54.8 {INST_EXPON: Bug 2798543} {
+ expr {3**17 == 3**65553}
+} 0
+test expr-23.54.9 {INST_EXPON: Bug 2798543} {
+ expr {3**18 == 3**65554}
+} 0
+test expr-23.54.10 {INST_EXPON: Bug 2798543} {
+ expr {3**19 == 3**65555}
+} 0
+test expr-23.54.11 {INST_EXPON: Bug 2798543} {
+ expr {3**9 == 3**131081}
+} 0
+test expr-23.54.12 {INST_EXPON: Bug 2798543} -body {
+ expr {3**9 == 3**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.54.13 {INST_EXPON: Bug 2798543} {
+ expr {(-3)**9 == (-3)**65545}
+} 0
+test expr-23.55.0 {INST_EXPON: Bug 2798543} {
+ expr {4**9 == 4**65545}
+} 0
+test expr-23.55.1 {INST_EXPON: Bug 2798543} {
+ expr {4**15 == 4**65551}
+} 0
+test expr-23.55.2 {INST_EXPON: Bug 2798543} {
+ expr {4**9 == 4**131081}
+} 0
+test expr-23.55.3 {INST_EXPON: Bug 2798543} -body {
+ expr {4**9 == 4**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.55.4 {INST_EXPON: Bug 2798543} {
+ expr {(-4)**9 == (-4)**65545}
+} 0
+test expr-23.56.0 {INST_EXPON: Bug 2798543} {
+ expr {5**9 == 5**65545}
+} 0
+test expr-23.56.1 {INST_EXPON: Bug 2798543} {
+ expr {5**13 == 5**65549}
+} 0
+test expr-23.56.2 {INST_EXPON: Bug 2798543} {
+ expr {5**9 == 5**131081}
+} 0
+test expr-23.56.3 {INST_EXPON: Bug 2798543} -body {
+ expr {5**9 == 5**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.56.4 {INST_EXPON: Bug 2798543} {
+ expr {(-5)**9 == (-5)**65545}
+} 0
+test expr-23.57.0 {INST_EXPON: Bug 2798543} {
+ expr {6**9 == 6**65545}
+} 0
+test expr-23.57.1 {INST_EXPON: Bug 2798543} {
+ expr {6**11 == 6**65547}
+} 0
+test expr-23.57.2 {INST_EXPON: Bug 2798543} {
+ expr {6**9 == 6**131081}
+} 0
+test expr-23.57.3 {INST_EXPON: Bug 2798543} -body {
+ expr {6**9 == 6**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.57.4 {INST_EXPON: Bug 2798543} {
+ expr {(-6)**9 == (-6)**65545}
+} 0
+test expr-23.58.0 {INST_EXPON: Bug 2798543} {
+ expr {7**9 == 7**65545}
+} 0
+test expr-23.58.1 {INST_EXPON: Bug 2798543} {
+ expr {7**11 == 7**65547}
+} 0
+test expr-23.58.2 {INST_EXPON: Bug 2798543} {
+ expr {7**9 == 7**131081}
+} 0
+test expr-23.58.3 {INST_EXPON: Bug 2798543} -body {
+ expr {7**9 == 7**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.58.4 {INST_EXPON: Bug 2798543} {
+ expr {(-7)**9 == (-7)**65545}
+} 0
+test expr-23.59.0 {INST_EXPON: Bug 2798543} {
+ expr {8**9 == 8**65545}
+} 0
+test expr-23.59.1 {INST_EXPON: Bug 2798543} {
+ expr {8**10 == 8**65546}
+} 0
+test expr-23.59.2 {INST_EXPON: Bug 2798543} {
+ expr {8**9 == 8**131081}
+} 0
+test expr-23.59.3 {INST_EXPON: Bug 2798543} -body {
+ expr {8**9 == 8**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.59.4 {INST_EXPON: Bug 2798543} {
+ expr {(-8)**9 == (-8)**65545}
+} 0
+test expr-23.60.0 {INST_EXPON: Bug 2798543} {
+ expr {9**9 == 9**65545}
+} 0
+test expr-23.60.1 {INST_EXPON: Bug 2798543} {
+ expr {9**9 == 9**131081}
+} 0
+test expr-23.60.2 {INST_EXPON: Bug 2798543} -body {
+ expr {9**9 == 9**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.60.3 {INST_EXPON: Bug 2798543} {
+ expr {(-9)**9 == (-9)**65545}
+} 0
+test expr-23.61.0 {INST_EXPON: Bug 2798543} {
+ expr {10**9 == 10**65545}
+} 0
+test expr-23.61.1 {INST_EXPON: Bug 2798543} {
+ expr {10**9 == 10**131081}
+} 0
+test expr-23.61.2 {INST_EXPON: Bug 2798543} -body {
+ expr {10**9 == 10**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.61.3 {INST_EXPON: Bug 2798543} {
+ expr {(-10)**9 == (-10)**65545}
+} 0
+test expr-23.62.0 {INST_EXPON: Bug 2798543} {
+ expr {11**9 == 11**65545}
+} 0
+test expr-23.62.1 {INST_EXPON: Bug 2798543} {
+ expr {11**9 == 11**131081}
+} 0
+test expr-23.62.2 {INST_EXPON: Bug 2798543} -body {
+ expr {11**9 == 11**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.62.3 {INST_EXPON: Bug 2798543} {
+ expr {(-11)**9 == (-11)**65545}
+} 0
+test expr-23.63.0 {INST_EXPON: Bug 2798543} {
+ expr {3**20 == 3**65556}
+} 0
+test expr-23.63.1 {INST_EXPON: Bug 2798543} {
+ expr {3**39 == 3**65575}
+} 0
+test expr-23.63.2 {INST_EXPON: Bug 2798543} {
+ expr {3**20 == 3**131092}
+} 0
+test expr-23.63.3 {INST_EXPON: Bug 2798543} -body {
+ expr {3**20 == 3**268435476}
+} -returnCodes error -result {exponent too large}
+test expr-23.63.4 {INST_EXPON: Bug 2798543} {
+ expr {(-3)**20 == (-3)**65556}
+} 0
+test expr-23.64.0 {INST_EXPON: Bug 2798543} {
+ expr {4**17 == 4**65553}
+} 0
+test expr-23.64.1 {INST_EXPON: Bug 2798543} {
+ expr {4**31 == 4**65567}
+} 0
+test expr-23.64.2 {INST_EXPON: Bug 2798543} {
+ expr {4**17 == 4**131089}
+} 0
+test expr-23.64.3 {INST_EXPON: Bug 2798543} -body {
+ expr {4**17 == 4**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.64.4 {INST_EXPON: Bug 2798543} {
+ expr {(-4)**17 == (-4)**65553}
+} 0
+test expr-23.65.0 {INST_EXPON: Bug 2798543} {
+ expr {5**17 == 5**65553}
+} 0
+test expr-23.65.1 {INST_EXPON: Bug 2798543} {
+ expr {5**27 == 5**65563}
+} 0
+test expr-23.65.2 {INST_EXPON: Bug 2798543} {
+ expr {5**17 == 5**131089}
+} 0
+test expr-23.65.3 {INST_EXPON: Bug 2798543} -body {
+ expr {5**17 == 5**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.65.4 {INST_EXPON: Bug 2798543} {
+ expr {(-5)**17 == (-5)**65553}
+} 0
+test expr-23.66.0 {INST_EXPON: Bug 2798543} {
+ expr {6**17 == 6**65553}
+} 0
+test expr-23.66.1 {INST_EXPON: Bug 2798543} {
+ expr {6**24 == 6**65560}
+} 0
+test expr-23.66.2 {INST_EXPON: Bug 2798543} {
+ expr {6**17 == 6**131089}
+} 0
+test expr-23.66.3 {INST_EXPON: Bug 2798543} -body {
+ expr {6**17 == 6**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.66.4 {INST_EXPON: Bug 2798543} {
+ expr {(-6)**17 == (-6)**65553}
+} 0
+test expr-23.67.0 {INST_EXPON: Bug 2798543} {
+ expr {7**17 == 7**65553}
+} 0
+test expr-23.67.1 {INST_EXPON: Bug 2798543} {
+ expr {7**22 == 7**65558}
+} 0
+test expr-23.67.2 {INST_EXPON: Bug 2798543} {
+ expr {7**17 == 7**131089}
+} 0
+test expr-23.67.3 {INST_EXPON: Bug 2798543} -body {
+ expr {7**17 == 7**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.67.4 {INST_EXPON: Bug 2798543} {
+ expr {(-7)**17 == (-7)**65553}
+} 0
+test expr-23.68.0 {INST_EXPON: Bug 2798543} {
+ expr {8**17 == 8**65553}
+} 0
+test expr-23.68.1 {INST_EXPON: Bug 2798543} {
+ expr {8**20 == 8**65556}
+} 0
+test expr-23.68.2 {INST_EXPON: Bug 2798543} {
+ expr {8**17 == 8**131089}
+} 0
+test expr-23.68.3 {INST_EXPON: Bug 2798543} -body {
+ expr {8**17 == 8**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.68.4 {INST_EXPON: Bug 2798543} {
+ expr {(-8)**17 == (-8)**65553}
+} 0
+test expr-23.69.0 {INST_EXPON: Bug 2798543} {
+ expr {9**17 == 9**65553}
+} 0
+test expr-23.69.1 {INST_EXPON: Bug 2798543} {
+ expr {9**19 == 9**65555}
+} 0
+test expr-23.69.2 {INST_EXPON: Bug 2798543} {
+ expr {9**17 == 9**131089}
+} 0
+test expr-23.69.3 {INST_EXPON: Bug 2798543} -body {
+ expr {9**17 == 9**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.69.4 {INST_EXPON: Bug 2798543} {
+ expr {(-9)**17 == (-9)**65553}
+} 0
+test expr-23.70.0 {INST_EXPON: Bug 2798543} {
+ expr {10**17 == 10**65553}
+} 0
+test expr-23.70.1 {INST_EXPON: Bug 2798543} {
+ expr {10**18 == 10**65554}
+} 0
+test expr-23.70.2 {INST_EXPON: Bug 2798543} {
+ expr {10**17 == 10**131089}
+} 0
+test expr-23.70.3 {INST_EXPON: Bug 2798543} -body {
+ expr {10**17 == 10**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.70.4 {INST_EXPON: Bug 2798543} {
+ expr {(-10)**17 == (-10)**65553}
+} 0
+test expr-23.71.0 {INST_EXPON: Bug 2798543} {
+ expr {11**17 == 11**65553}
+} 0
+test expr-23.71.1 {INST_EXPON: Bug 2798543} {
+ expr {11**18 == 11**65554}
+} 0
+test expr-23.71.2 {INST_EXPON: Bug 2798543} {
+ expr {11**17 == 11**131089}
+} 0
+test expr-23.71.3 {INST_EXPON: Bug 2798543} -body {
+ expr {11**17 == 11**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.71.4 {INST_EXPON: Bug 2798543} {
+ expr {(-11)**17 == (-11)**65553}
+} 0
+test expr-23.72.0 {INST_EXPON: Bug 2798543} {
+ expr {12**17 == 12**65553}
+} 0
+test expr-23.72.1 {INST_EXPON: Bug 2798543} {
+ expr {12**17 == 12**131089}
+} 0
+test expr-23.72.2 {INST_EXPON: Bug 2798543} -body {
+ expr {12**17 == 12**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.72.3 {INST_EXPON: Bug 2798543} {
+ expr {(-12)**17 == (-12)**65553}
+} 0
+test expr-23.73.0 {INST_EXPON: Bug 2798543} {
+ expr {13**17 == 13**65553}
+} 0
+test expr-23.73.1 {INST_EXPON: Bug 2798543} {
+ expr {13**17 == 13**131089}
+} 0
+test expr-23.73.2 {INST_EXPON: Bug 2798543} -body {
+ expr {13**17 == 13**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.73.3 {INST_EXPON: Bug 2798543} {
+ expr {(-13)**17 == (-13)**65553}
+} 0
+test expr-23.74.0 {INST_EXPON: Bug 2798543} {
+ expr {14**17 == 14**65553}
+} 0
+test expr-23.74.1 {INST_EXPON: Bug 2798543} {
+ expr {14**17 == 14**131089}
+} 0
+test expr-23.74.2 {INST_EXPON: Bug 2798543} -body {
+ expr {14**17 == 14**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.74.3 {INST_EXPON: Bug 2798543} {
+ expr {(-14)**17 == (-14)**65553}
+} 0
+
# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
-test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5)<<32} 0
-test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5)<<63} 0
+test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
+test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
-test expr-24.8 {expr edge cases; shifting} {expr wide(10)<<63} 0
+test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
+test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000
+
# List membership tests
test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1
test expr-25.2 {'in' operator} {expr {"a" in "b a c"}} 1
@@ -5400,7 +5817,20 @@ test expr-32.2 {expr div basics} {
-3 -2 -1 -1 -1 \
]
-test expr-33.1 {parse largest long value} {longIs32bit} {
+test expr-32.3 {Bug 1585704} {
+ expr 1%(1<<63)
+} 1
+test expr-32.4 {Bug 1585704} {
+ expr -1%(1<<63)
+} [expr (1<<63)-1]
+test expr-32.5 {Bug 1585704} {
+ expr (1<<32)%(1<<63)
+} [expr 1<<32]
+test expr-32.6 {Bug 1585704} {
+ expr -(1<<32)%(1<<63)
+} [expr (1<<63)-(1<<32)]
+
+test expr-33.1 {parse largest long value} longIs32bit {
set max_long_str 2147483647
set max_long_hex "0x7FFFFFFF "
@@ -5414,10 +5844,10 @@ test expr-33.1 {parse largest long value} {longIs32bit} {
[expr {$max_long + 0}] \
[expr {2147483647 + 0}] \
[expr {$max_long == $max_long_hex}] \
- [expr {(2147483647 + 1) < 0}] \
+ [expr {int(2147483647 + 1) < 0}] \
} {2147483647 2147483647 2147483647 2147483647 1 1}
-test expr-33.2 {parse smallest long value} {longIs32bit} {
+test expr-33.2 {parse smallest long value} longIs32bit {
set min_long_str -2147483648
set min_long_hex "-0x80000000 "
@@ -5434,10 +5864,10 @@ test expr-33.2 {parse smallest long value} {longIs32bit} {
[expr {$min_long + 0}] \
[expr {-2147483648 + 0}] \
[expr {$min_long == $min_long_hex}] \
- [expr {(-2147483648 - 1) == 0x7FFFFFFF}] \
+ [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \
} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
-test expr-33.3 {parse largest wide value} {wideIs64bit} {
+test expr-33.3 {parse largest wide value} wideIs64bit {
set max_wide_str 9223372036854775807
set max_wide_hex "0x7FFFFFFFFFFFFFFF "
@@ -5451,10 +5881,10 @@ test expr-33.3 {parse largest wide value} {wideIs64bit} {
[expr {$max_wide + 0}] \
[expr {9223372036854775807 + 0}] \
[expr {$max_wide == $max_wide_hex}] \
- [expr {(9223372036854775807 + 1) < 0}] \
+ [expr {wide(9223372036854775807 + 1) < 0}] \
} {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1}
-test expr-33.4 {parse smallest wide value} {wideIs64bit} {
+test expr-33.4 {parse smallest wide value} wideIs64bit {
set min_wide_str -9223372036854775808
set min_wide_hex "-0x8000000000000000 "
@@ -5471,351 +5901,351 @@ test expr-33.4 {parse smallest wide value} {wideIs64bit} {
[expr {$min_wide + 0}] \
[expr {-9223372036854775808 + 0}] \
[expr {$min_wide == $min_wide_hex}] \
- [expr {(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \
+ [expr {wide(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \
} {-9223372036854775808 -9223372036854775808 -9223372036854775808 -9223372036854775808 1 1}
set min -2147483648
set max 2147483647
-test expr-34.1 {expr edge cases} {longIs32bit} {
+test expr-34.1 {expr edge cases} {
expr {$min / $min}
} {1}
-test expr-34.2 {expr edge cases} {longIs32bit} {
+test expr-34.2 {expr edge cases} {
expr {$min % $min}
} {0}
-test expr-34.3 {expr edge cases} {longIs32bit} {
+test expr-34.3 {expr edge cases} {
expr {$min / ($min + 1)}
} {1}
-test expr-34.4 {expr edge cases} {longIs32bit} {
+test expr-34.4 {expr edge cases} {
expr {$min % ($min + 1)}
} {-1}
-test expr-34.5 {expr edge cases} {longIs32bit} {
+test expr-34.5 {expr edge cases} {
expr {$min / ($min + 2)}
} {1}
-test expr-34.6 {expr edge cases} {longIs32bit} {
+test expr-34.6 {expr edge cases} {
expr {$min % ($min + 2)}
} {-2}
-test expr-34.7 {expr edge cases} {longIs32bit} {
+test expr-34.7 {expr edge cases} {
expr {$min / ($min + 3)}
} {1}
-test expr-34.8 {expr edge cases} {longIs32bit} {
+test expr-34.8 {expr edge cases} {
expr {$min % ($min + 3)}
} {-3}
-test expr-34.9 {expr edge cases} {longIs32bit} {
+test expr-34.9 {expr edge cases} {
expr {$min / -3}
} {715827882}
-test expr-34.10 {expr edge cases} {longIs32bit} {
+test expr-34.10 {expr edge cases} {
expr {$min % -3}
} {-2}
-test expr-34.11 {expr edge cases} {longIs32bit} {
+test expr-34.11 {expr edge cases} {
expr {$min / -2}
} {1073741824}
-test expr-34.12 {expr edge cases} {longIs32bit} {
+test expr-34.12 {expr edge cases} {
expr {$min % -2}
} {0}
-test expr-34.13 {expr edge cases} {longIs32bit} {
- expr {$min / -1}
+test expr-34.13 {expr edge cases} longIs32bit {
+ expr {int($min / -1)}
} {-2147483648}
-test expr-34.14 {expr edge cases} {longIs32bit} {
+test expr-34.14 {expr edge cases} {
expr {$min % -1}
} {0}
-test expr-34.15 {expr edge cases} {longIs32bit} {
- expr {$min * -1}
+test expr-34.15 {expr edge cases} longIs32bit {
+ expr {int($min * -1)}
} $min
-test expr-34.16 {expr edge cases} {longIs32bit} {
- expr {-$min}
+test expr-34.16 {expr edge cases} longIs32bit {
+ expr {int(-$min)}
} $min
-test expr-34.17 {expr edge cases} {longIs32bit} {
+test expr-34.17 {expr edge cases} {
expr {$min / 1}
} $min
-test expr-34.18 {expr edge cases} {longIs32bit} {
+test expr-34.18 {expr edge cases} {
expr {$min % 1}
} {0}
-test expr-34.19 {expr edge cases} {longIs32bit} {
+test expr-34.19 {expr edge cases} {
expr {$min / 2}
} {-1073741824}
-test expr-34.20 {expr edge cases} {longIs32bit} {
+test expr-34.20 {expr edge cases} {
expr {$min % 2}
} {0}
-test expr-34.21 {expr edge cases} {longIs32bit} {
+test expr-34.21 {expr edge cases} {
expr {$min / 3}
} {-715827883}
-test expr-34.22 {expr edge cases} {longIs32bit} {
+test expr-34.22 {expr edge cases} {
expr {$min % 3}
} {1}
-test expr-34.23 {expr edge cases} {longIs32bit} {
+test expr-34.23 {expr edge cases} {
expr {$min / ($max - 3)}
} {-2}
-test expr-34.24 {expr edge cases} {longIs32bit} {
+test expr-34.24 {expr edge cases} {
expr {$min % ($max - 3)}
} {2147483640}
-test expr-34.25 {expr edge cases} {longIs32bit} {
+test expr-34.25 {expr edge cases} {
expr {$min / ($max - 2)}
} {-2}
-test expr-34.26 {expr edge cases} {longIs32bit} {
+test expr-34.26 {expr edge cases} {
expr {$min % ($max - 2)}
} {2147483642}
-test expr-34.27 {expr edge cases} {longIs32bit} {
+test expr-34.27 {expr edge cases} {
expr {$min / ($max - 1)}
} {-2}
-test expr-34.28 {expr edge cases} {longIs32bit} {
+test expr-34.28 {expr edge cases} {
expr {$min % ($max - 1)}
} {2147483644}
-test expr-34.29 {expr edge cases} {longIs32bit} {
+test expr-34.29 {expr edge cases} {
expr {$min / $max}
} {-2}
-test expr-34.30 {expr edge cases} {longIs32bit} {
+test expr-34.30 {expr edge cases} {
expr {$min % $max}
} {2147483646}
-test expr-34.31 {expr edge cases} {longIs32bit} {
+test expr-34.31 {expr edge cases} {
expr {$max / $max}
} {1}
-test expr-34.32 {expr edge cases} {longIs32bit} {
+test expr-34.32 {expr edge cases} {
expr {$max % $max}
} {0}
-test expr-34.33 {expr edge cases} {longIs32bit} {
+test expr-34.33 {expr edge cases} {
expr {$max / ($max - 1)}
} {1}
-test expr-34.34 {expr edge cases} {longIs32bit} {
+test expr-34.34 {expr edge cases} {
expr {$max % ($max - 1)}
} {1}
-test expr-34.35 {expr edge cases} {longIs32bit} {
+test expr-34.35 {expr edge cases} {
expr {$max / ($max - 2)}
} {1}
-test expr-34.36 {expr edge cases} {longIs32bit} {
+test expr-34.36 {expr edge cases} {
expr {$max % ($max - 2)}
} {2}
-test expr-34.37 {expr edge cases} {longIs32bit} {
+test expr-34.37 {expr edge cases} {
expr {$max / ($max - 3)}
} {1}
-test expr-34.38 {expr edge cases} {longIs32bit} {
+test expr-34.38 {expr edge cases} {
expr {$max % ($max - 3)}
} {3}
-test expr-34.39 {expr edge cases} {longIs32bit} {
+test expr-34.39 {expr edge cases} {
expr {$max / 3}
} {715827882}
-test expr-34.40 {expr edge cases} {longIs32bit} {
+test expr-34.40 {expr edge cases} {
expr {$max % 3}
} {1}
-test expr-34.41 {expr edge cases} {longIs32bit} {
+test expr-34.41 {expr edge cases} {
expr {$max / 2}
} {1073741823}
-test expr-34.42 {expr edge cases} {longIs32bit} {
+test expr-34.42 {expr edge cases} {
expr {$max % 2}
} {1}
-test expr-34.43 {expr edge cases} {longIs32bit} {
+test expr-34.43 {expr edge cases} {
expr {$max / 1}
} $max
-test expr-34.44 {expr edge cases} {longIs32bit} {
+test expr-34.44 {expr edge cases} {
expr {$max % 1}
} {0}
-test expr-34.45 {expr edge cases} {longIs32bit} {
+test expr-34.45 {expr edge cases} {
expr {$max / -1}
} "-$max"
-test expr-34.46 {expr edge cases} {longIs32bit} {
+test expr-34.46 {expr edge cases} {
expr {$max % -1}
} {0}
-test expr-34.47 {expr edge cases} {longIs32bit} {
+test expr-34.47 {expr edge cases} {
expr {$max / -2}
} {-1073741824}
-test expr-34.48 {expr edge cases} {longIs32bit} {
+test expr-34.48 {expr edge cases} {
expr {$max % -2}
} {-1}
-test expr-34.49 {expr edge cases} {longIs32bit} {
+test expr-34.49 {expr edge cases} {
expr {$max / -3}
} {-715827883}
-test expr-34.50 {expr edge cases} {longIs32bit} {
+test expr-34.50 {expr edge cases} {
expr {$max % -3}
} {-2}
-test expr-34.51 {expr edge cases} {longIs32bit} {
+test expr-34.51 {expr edge cases} {
expr {$max / ($min + 3)}
} {-2}
-test expr-34.52 {expr edge cases} {longIs32bit} {
+test expr-34.52 {expr edge cases} {
expr {$max % ($min + 3)}
} {-2147483643}
-test expr-34.53 {expr edge cases} {longIs32bit} {
+test expr-34.53 {expr edge cases} {
expr {$max / ($min + 2)}
} {-2}
-test expr-34.54 {expr edge cases} {longIs32bit} {
+test expr-34.54 {expr edge cases} {
expr {$max % ($min + 2)}
} {-2147483645}
-test expr-34.55 {expr edge cases} {longIs32bit} {
+test expr-34.55 {expr edge cases} {
expr {$max / ($min + 1)}
} {-1}
-test expr-34.56 {expr edge cases} {longIs32bit} {
+test expr-34.56 {expr edge cases} {
expr {$max % ($min + 1)}
} {0}
-test expr-34.57 {expr edge cases} {longIs32bit} {
+test expr-34.57 {expr edge cases} {
expr {$max / $min}
} {-1}
-test expr-34.58 {expr edge cases} {longIs32bit} {
+test expr-34.58 {expr edge cases} {
expr {$max % $min}
} {-1}
-test expr-34.59 {expr edge cases} {longIs32bit} {
+test expr-34.59 {expr edge cases} {
expr {($min + 1) / ($max - 1)}
} {-2}
-test expr-34.60 {expr edge cases} {longIs32bit} {
+test expr-34.60 {expr edge cases} {
expr {($min + 1) % ($max - 1)}
} {2147483645}
-test expr-34.61 {expr edge cases} {longIs32bit} {
+test expr-34.61 {expr edge cases} {
expr {($max - 1) / ($min + 1)}
} {-1}
-test expr-34.62 {expr edge cases} {longIs32bit} {
+test expr-34.62 {expr edge cases} {
expr {($max - 1) % ($min + 1)}
} {-1}
-test expr-34.63 {expr edge cases} {longIs32bit} {
+test expr-34.63 {expr edge cases} {
expr {($max - 1) / $min}
} {-1}
-test expr-34.64 {expr edge cases} {longIs32bit} {
+test expr-34.64 {expr edge cases} {
expr {($max - 1) % $min}
} {-2}
-test expr-34.65 {expr edge cases} {longIs32bit} {
+test expr-34.65 {expr edge cases} {
expr {($max - 2) / $min}
} {-1}
-test expr-34.66 {expr edge cases} {longIs32bit} {
+test expr-34.66 {expr edge cases} {
expr {($max - 2) % $min}
} {-3}
-test expr-34.67 {expr edge cases} {longIs32bit} {
+test expr-34.67 {expr edge cases} {
expr {($max - 3) / $min}
} {-1}
-test expr-34.68 {expr edge cases} {longIs32bit} {
+test expr-34.68 {expr edge cases} {
expr {($max - 3) % $min}
} {-4}
-test expr-34.69 {expr edge cases} {longIs32bit} {
+test expr-34.69 {expr edge cases} {
expr {-3 / $min}
} {0}
-test expr-34.70 {expr edge cases} {longIs32bit} {
+test expr-34.70 {expr edge cases} {
expr {-3 % $min}
} {-3}
-test expr-34.71 {expr edge cases} {longIs32bit} {
+test expr-34.71 {expr edge cases} {
expr {-2 / $min}
} {0}
-test expr-34.72 {expr edge cases} {longIs32bit} {
+test expr-34.72 {expr edge cases} {
expr {-2 % $min}
} {-2}
-test expr-34.73 {expr edge cases} {longIs32bit} {
+test expr-34.73 {expr edge cases} {
expr {-1 / $min}
} {0}
-test expr-34.74 {expr edge cases} {longIs32bit} {
+test expr-34.74 {expr edge cases} {
expr {-1 % $min}
} {-1}
-test expr-34.75 {expr edge cases} {longIs32bit} {
+test expr-34.75 {expr edge cases} {
expr {0 / $min}
} {0}
-test expr-34.76 {expr edge cases} {longIs32bit} {
+test expr-34.76 {expr edge cases} {
expr {0 % $min}
} {0}
-test expr-34.77 {expr edge cases} {longIs32bit} {
+test expr-34.77 {expr edge cases} {
expr {0 / ($min + 1)}
} {0}
-test expr-34.78 {expr edge cases} {longIs32bit} {
+test expr-34.78 {expr edge cases} {
expr {0 % ($min + 1)}
} {0}
-test expr-34.79 {expr edge cases} {longIs32bit} {
+test expr-34.79 {expr edge cases} {
expr {1 / $min}
} {-1}
-test expr-34.80 {expr edge cases} {longIs32bit} {
+test expr-34.80 {expr edge cases} {
expr {1 % $min}
} {-2147483647}
-test expr-34.81 {expr edge cases} {longIs32bit} {
+test expr-34.81 {expr edge cases} {
expr {1 / ($min + 1)}
} {-1}
-test expr-34.82 {expr edge cases} {longIs32bit} {
+test expr-34.82 {expr edge cases} {
expr {1 % ($min + 1)}
} {-2147483646}
-test expr-34.83 {expr edge cases} {longIs32bit} {
+test expr-34.83 {expr edge cases} {
expr {2 / $min}
} {-1}
-test expr-34.84 {expr edge cases} {longIs32bit} {
+test expr-34.84 {expr edge cases} {
expr {2 % $min}
} {-2147483646}
-test expr-34.85 {expr edge cases} {longIs32bit} {
+test expr-34.85 {expr edge cases} {
expr {2 / ($min + 1)}
} {-1}
-test expr-34.86 {expr edge cases} {longIs32bit} {
+test expr-34.86 {expr edge cases} {
expr {2 % ($min + 1)}
} {-2147483645}
-test expr-34.87 {expr edge cases} {longIs32bit} {
+test expr-34.87 {expr edge cases} {
expr {3 / $min}
} {-1}
-test expr-34.88 {expr edge cases} {longIs32bit} {
+test expr-34.88 {expr edge cases} {
expr {3 % $min}
} {-2147483645}
-test expr-34.89 {expr edge cases} {longIs32bit} {
+test expr-34.89 {expr edge cases} {
expr {3 / ($min + 1)}
} {-1}
-test expr-34.90 {expr edge cases} {longIs32bit} {
+test expr-34.90 {expr edge cases} {
expr {3 % ($min + 1)}
} {-2147483644}
# Euclidean property:
# quotient * divisor + remainder = dividend
-test expr-35.1 {expr edge cases} {longIs32bit} {
+test expr-35.1 {expr edge cases} {
set dividend $max
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($divisor * $q) + $r}]
} {1073741823 * 2 + 1 = 2147483647}
-test expr-35.2 {expr edge cases} {longIs32bit} {
+test expr-35.2 {expr edge cases} {
set dividend [expr {$max - 1}]
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {1073741823 * 2 + 0 = 2147483646}
-test expr-35.3 {expr edge cases} {longIs32bit} {
+test expr-35.3 {expr edge cases} {
set dividend [expr {$max - 2}]
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {1073741822 * 2 + 1 = 2147483645}
-test expr-35.4 {expr edge cases} {longIs32bit} {
+test expr-35.4 {expr edge cases} {
set dividend $max
set divisor 3
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {715827882 * 3 + 1 = 2147483647}
-test expr-35.5 {expr edge cases} {longIs32bit} {
+test expr-35.5 {expr edge cases} {
set dividend [expr {$max - 1}]
set divisor 3
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {715827882 * 3 + 0 = 2147483646}
-test expr-35.6 {expr edge cases} {longIs32bit} {
+test expr-35.6 {expr edge cases} {
set dividend [expr {$max - 2}]
set divisor 3
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {715827881 * 3 + 2 = 2147483645}
-test expr-35.7 {expr edge cases} {longIs32bit} {
+test expr-35.7 {expr edge cases} {
set dividend $min
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {-1073741824 * 2 + 0 = -2147483648}
-test expr-35.8 {expr edge cases} {longIs32bit} {
+test expr-35.8 {expr edge cases} {
set dividend [expr {$min + 1}]
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {-1073741824 * 2 + 1 = -2147483647}
-test expr-35.9 {expr edge cases} {longIs32bit} {
+test expr-35.9 {expr edge cases} {
set dividend [expr {$min + 2}]
set divisor 2
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {-1073741823 * 2 + 0 = -2147483646}
-test expr-35.10 {expr edge cases} {longIs32bit} {
+test expr-35.10 {expr edge cases} {
# Two things could happen here. The multiplication
# could overflow a 32 bit type, so that when
# 1 is added it overflows again back to min.
@@ -5828,28 +6258,28 @@ test expr-35.10 {expr edge cases} {longIs32bit} {
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {-715827883 * 3 + 1 = -2147483648}
-test expr-35.11 {expr edge cases} {longIs32bit} {
+test expr-35.11 {expr edge cases} {
set dividend $min
set divisor -3
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {715827882 * -3 + -2 = -2147483648}
-test expr-35.12 {expr edge cases} {longIs32bit} {
+test expr-35.12 {expr edge cases} {
set dividend $min
set divisor $min
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {1 * -2147483648 + 0 = -2147483648}
-test expr-35.13 {expr edge cases} {longIs32bit} {
+test expr-35.13 {expr edge cases} {
set dividend $min
set divisor [expr {$min + 1}]
set q [expr {$dividend / $divisor}]
set r [expr {$dividend % $divisor}]
list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
} {1 * -2147483647 + -1 = -2147483648}
-test expr-35.14 {expr edge cases} {longIs32bit} {
+test expr-35.14 {expr edge cases} {
set dividend $min
set divisor [expr {$min + 2}]
set q [expr {$dividend / $divisor}]
@@ -5898,17 +6328,17 @@ test expr-36.11 {expr edge cases} {wideIs64bit} {
test expr-36.12 {expr edge cases} {wideIs64bit} {
expr {$min % -2}
} {0}
-test expr-36.13 {expr edge cases} {wideIs64bit} {
- expr {$min / -1}
+test expr-36.13 {expr edge cases} wideIs64bit {
+ expr {wide($min / -1)}
} $min
test expr-36.14 {expr edge cases} {wideIs64bit} {
expr {$min % -1}
} {0}
-test expr-36.15 {expr edge cases} {wideIs64bit} {
- expr {$min * -1}
+test expr-36.15 {expr edge cases} wideIs64bit {
+ expr {wide($min * -1)}
} $min
-test expr-36.16 {expr edge cases} {wideIs64bit} {
- expr {-$min}
+test expr-36.16 {expr edge cases} wideIs64bit {
+ expr {wide(-$min)}
} $min
test expr-36.17 {expr edge cases} {wideIs64bit} {
expr {$min / 1}
@@ -6238,6 +6668,277 @@ test expr-37.14 {expr edge cases} {wideIs64bit} {
test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} {
expr {abs(-2147483648)}
} 2147483648
+test expr-38.2 {abs and -0 [Bug 1893815]} {
+ expr {abs(-0)}
+} 0
+test expr-38.3 {abs and -0 [Bug 1893815]} {
+ expr {abs(-0.0)}
+} 0.0
+test expr-38.4 {abs and -0 [Bug 1893815]} {
+ expr {abs(-1e-324)}
+} 0.0
+test expr-38.5 {abs and -0 [Bug 1893815]} {
+ ::tcl::mathfunc::abs -0
+} 0
+test expr-38.6 {abs and -0 [Bug 1893815]} {
+ ::tcl::mathfunc::abs -0.0
+} 0.0
+test expr-38.7 {abs and -0 [Bug 1893815]} {
+ ::tcl::mathfunc::abs -1e-324
+} 0.0
+test expr-38.8 {abs and 0.0 [Bug 2954959]} {
+ ::tcl::mathfunc::abs 0.0
+} 0.0
+test expr-38.9 {abs and 0.0 [Bug 2954959]} {
+ expr {abs(0.0)}
+} 0.0
+test expr-38.10 {abs and -0x0 [Bug 2954959]} {
+ expr {abs(-0x0)}
+} 0
+test expr-38.11 {abs and 0x0 [Bug 2954959]} {
+ ::tcl::mathfunc::abs { 0x0}
+} { 0x0}
+test expr-38.12 {abs and -0x0 [Bug 2954959]} {
+ ::tcl::mathfunc::abs { -0x0}
+} 0
+test expr-38.13 {abs and 0.0 [Bug 2954959]} {
+ ::tcl::mathfunc::abs 1e-324
+} 1e-324
+
+testConstraint testexprlongobj [llength [info commands testexprlongobj]]
+testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]]
+
+test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj {
+ testexprlongobj 4+1
+} {This is a result: 5}
+#Check for [Bug 1109484]
+test expr-39.2 {Tcl_ExprLongObj handles wide ints gracefully} testexprlongobj {
+ testexprlongobj wide(1)+2
+} {This is a result: 3}
+
+test expr-39.3 {Tcl_ExprLongObj on the empty string} \
+ -constraints {testexprlongobj}\
+ -body {testexprlongobj ""} \
+ -match glob \
+ -returnCodes error -result *
+test expr-39.4 {Tcl_ExprLongObj coerces doubles} testexprlongobj {
+ testexprlongobj 3+.14159
+} {This is a result: 3}
+test expr-39.5 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 0x80000000
+} {This is a result: -2147483648}
+test expr-39.6 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 0xffffffff
+} {This is a result: -1}
+test expr-39.7 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlongobj 0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
+ testexprlongobj -0x80000000
+} {This is a result: -2147483648}
+test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj -0xffffffff
+} {This is a result: 1}
+test expr-39.10 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlongobj -0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-39.11 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 2147483648.
+} {This is a result: -2147483648}
+test expr-39.12 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 4294967295.
+} {This is a result: -1}
+test expr-39.13 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlongobj 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
+ testexprlongobj -2147483648.
+} {This is a result: -2147483648}
+test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj -4294967295.
+} {This is a result: 1}
+test expr-39.16 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlongobj 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+
+test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
+ testexprdoubleobj 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
+ -constraints {testexprdoubleobj} \
+ -match glob \
+ -body {testexprdoubleobj ""} \
+ -returnCodes error -result *
+test expr-39.19 {Tcl_ExprDoubleObj coerces wides} testexprdoubleobj {
+ testexprdoubleobj 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-39.20 {Tcl_ExprDoubleObj coerces bignums} testexprdoubleobj {
+ testexprdoubleobj 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-39.21 {Tcl_ExprDoubleObj handles overflows} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623157[string repeat 0 292].
+ } {This is a result: 1.7976931348623157e+308}
+test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623157[string repeat 0 292]
+ } {This is a result: 1.7976931348623157e+308}
+test expr-39.23 {Tcl_ExprDoubleObj handles overflows} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623165[string repeat 0 292].
+ } {This is a result: Inf}
+test expr-39.24 {Tcl_ExprDoubleObj handles overflows that look like int} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623165[string repeat 0 292]
+ } {This is a result: Inf}
+test expr-39.25 {Tcl_ExprDoubleObj and NaN} \
+ {testexprdoubleobj ieeeFloatingPoint} {
+ list [catch {testexprdoubleobj 0.0/0.0} result] $result
+ } {1 {domain error: argument not in valid range}}
+
+test expr-40.1 {large octal shift} {
+ expr 0o100000000000000000000000000000000
+} [expr 0x1000000000000000000000000]
+test expr-40.2 {large octal shift} {
+ expr 0o100000000000000000000000000000001
+} [expr 0x1000000000000000000000001]
+
+test expr-41.1 {exponent overflow} {
+ expr 1.0e2147483630
+} Inf
+test expr-41.2 {exponent underflow} {
+ expr 1.0e-2147483630
+} 0.0
+
+test expr-42.1 {denormals} ieeeFloatingPoint {
+ expr 7e-324
+} 5e-324
+
+# TIP 114
+
+test expr-43.1 {0b notation} {
+ expr 0b0
+} 0
+test expr-43.2 {0b notation} {
+ expr 0b1
+} 1
+test expr-43.3 {0b notation} {
+ expr 0b10
+} 2
+test expr-43.4 {0b notation} {
+ expr 0b11
+} 3
+test expr-43.5 {0b notation} {
+ expr 0b100
+} 4
+test expr-43.6 {0b notation} {
+ expr 0b101
+} 5
+test expr-43.7 {0b notation} {
+ expr 0b1000
+} 8
+test expr-43.8 {0b notation} {
+ expr 0b1001
+} 9
+test expr-43.9 {0b notation} {
+ expr 0b1[string repeat 0 31]
+} 2147483648
+test expr-43.10 {0b notation} {
+ expr 0b1[string repeat 0 30]1
+} 2147483649
+test expr-43.11 {0b notation} {
+ expr 0b[string repeat 1 64]
+} 18446744073709551615
+test expr-43.12 {0b notation} {
+ expr 0b1[string repeat 0 64]
+} 18446744073709551616
+test expr-43.13 {0b notation} {
+ expr 0b1[string repeat 0 63]1
+} 18446744073709551617
+
+test expr-44.1 {0o notation} {
+ expr 0o0
+} 0
+test expr-44.2 {0o notation} {
+ expr 0o1
+} 1
+test expr-44.3 {0o notation} {
+ expr 0o7
+} 7
+test expr-44.4 {0o notation} {
+ expr 0o10
+} 8
+test expr-44.5 {0o notation} {
+ expr 0o11
+} 9
+test expr-44.6 {0o notation} {
+ expr 0o100
+} 64
+test expr-44.7 {0o notation} {
+ expr 0o101
+} 65
+test expr-44.8 {0o notation} {
+ expr 0o1000
+} 512
+test expr-44.9 {0o notation} {
+ expr 0o1001
+} 513
+test expr-44.10 {0o notation} {
+ expr 0o1[string repeat 7 21]
+} 18446744073709551615
+test expr-44.11 {0o notation} {
+ expr 0o2[string repeat 0 21]
+} 18446744073709551616
+test expr-44.12 {0o notation} {
+ expr 0o2[string repeat 0 20]1
+} 18446744073709551617
+
+# TIP 237 again
+
+test expr-45.1 {entier} {
+ expr entier(0)
+} 0
+test expr-45.2 {entier} {
+ expr entier(0.5)
+} 0
+test expr-45.3 {entier} {
+ expr entier(1.0)
+} 1
+test expr-45.4 {entier} {
+ expr entier(1.5)
+} 1
+test expr-45.5 {entier} {
+ expr entier(2.0)
+} 2
+test expr-45.6 {entier} {
+ expr entier(1e+22)
+} 10000000000000000000000
+test expr-45.7 {entier} {
+ list [catch {expr entier(Inf)} result] $result
+} {1 {integer value too large to represent}}
+test expr-45.8 {entier} ieeeFloatingPoint {
+ list [catch {expr {entier($ieeeValues(NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
+test expr-45.9 {entier} ieeeFloatingPoint {
+ list [catch {expr {entier($ieeeValues(-NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
test expr-46.1 {round() rounds to +-infinity} {
expr round(0.5)
@@ -6252,15 +6953,15 @@ test expr-46.4 {round() rounds to +-infinity} {
expr round(-1.5)
} -2
test expr-46.5 {round() overflow} {
- list [catch {expr round(9.2233720368547758e+018)} result] $result
-} {1 {integer value too large to represent}}
+ expr round(9.2233720368547758e+018)
+} 9223372036854775808
test expr-46.6 {round() overflow} {
- list [catch {expr round(-9.2233720368547758e+018)} result] $result
-} {1 {integer value too large to represent}}
-test expr-46.7 {round() bad value} {
+ expr round(-9.2233720368547758e+018)
+} -9223372036854775808
+test expr-46.7 {round() bad value} -body {
set x trash
- list [catch {expr {round($x)}} result] $result
-} {1 {argument to math function didn't have numeric value}}
+ expr {round($x)}
+} -returnCodes error -match glob -result *
test expr-46.8 {round() already an integer} {
set x 123456789012
incr x
@@ -6310,6 +7011,170 @@ test expr-46.12 {round() boundary case - -1/2 + 1 ulp} {
}
expr {round($x)}
} 0
+test expr-46.13 {round() boundary case - round down} {
+ expr {round(2147483647 - 0.51)}
+} 2147483646
+
+test expr-46.14 {round() boundary case - round up} {
+ expr {round(2147483647 - 0.50)}
+} 2147483647
+
+test expr-46.15 {round() boundary case - round up to wide} {
+ expr {round(2147483647 + 0.50)}
+} [expr {wide(2147483647) + 1}]
+
+test expr-46.16 {round() boundary case - round up} {
+ expr {round(-2147483648 + 0.51)}
+} -2147483647
+
+test expr-46.17 {round() boundary case - round down} {
+ expr {round(-2147483648 + 0.50)}
+} -2147483648
+test expr-46.18 {round() boundary case - round down to wide} {
+ expr {round(-2147483648 - 0.50)}
+} [expr {wide(-2147483648) - 1}]
+
+test expr-46.19 {round() handling of long/bignum boundary} {
+ expr {round(double(0x7fffffffffffffff))}
+} 9223372036854775808
+
+test expr-47.1 {isqrt() - arg count} {
+ list [catch {expr {isqrt(1,2)}} result] $result
+} {1 {too many arguments for math function "isqrt"}}
+
+test expr-47.2 {isqrt() - non-number} {
+ list [catch {expr {isqrt({rubbish})}} result] $result
+} {1 {expected number but got "rubbish"}}
+
+test expr-47.3 {isqrt() - NaN} ieeeFloatingPoint {
+ list [catch {expr {isqrt(NaN)}} result] $result
+} {1 {floating point value is Not a Number}}
+
+test expr-47.4 {isqrt() of negative floating point number} {
+ list [catch {expr {isqrt(-1.0)}} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.5 {isqrt() of floating point zero} {
+ expr isqrt(0.0)
+} 0
+
+test expr-47.6 {isqrt() of exact floating point numbers} {
+ set trouble {}
+ for {set i 0} {$i < 16} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {pow(2., (2 * $i))}]
+ if {isqrt($arg-1) != $rm1} {
+ append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+ }
+ if {isqrt($arg) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+ }
+ if {isqrt($arg+1) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+ }
+ }
+ set trouble
+} {}
+
+test expr-47.7 {isqrt() of exact floating point numbers} ieeeFloatingPoint {
+ set trouble {}
+ for {set i 17} {$i < 27} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {pow(2., (2 * $i))}]
+ if {isqrt($arg-1.0) != $rm1} {
+ append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+ }
+ if {isqrt($arg) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+ }
+ if {isqrt($arg+1.0) != $root} {
+ append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+ }
+ }
+ set trouble
+} {}
+
+test expr-47.8 {isqrt of inexact floating point number} ieeeFloatingPoint {
+ expr isqrt(2[string repeat 0 34])
+} 141421356237309504
+
+test expr-47.9 {isqrt of negative int} {
+ list [catch {expr isqrt(-1)} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.10 {isqrt of negative bignum} {
+ list [catch {expr isqrt(-1[string repeat 0 1000])} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.11 {isqrt of zero} {
+ expr {isqrt(0)}
+} 0
+
+test expr-47.12 {isqrt of various sizes of integer} {
+ set faults 0
+ set trouble {}
+ for {set i 0} {$faults < 10 && $i <= 1024} {incr i} {
+ set root [expr {1 << $i}]
+ set rm1 [expr {$root - 1}]
+ set arg [expr {1 << (2 * $i)}]
+ set tval [expr {isqrt($arg-1)}]
+ if {$tval != $rm1} {
+ append trouble "i = " $i ": isqrt(" $arg "-1) == " $tval \
+ " != " $rm1 "\n"
+ incr faults
+ }
+ set tval [expr {isqrt($arg)}]
+ if {$tval != $root} {
+ append trouble "i = " $i ": isqrt(" $arg ") == " $tval \
+ " != " $root "\n"
+ incr faults
+ }
+ set tval [expr {isqrt($arg+1)}]
+ if {$tval != $root} {
+ append trouble "i = " $i ": isqrt(" $arg "+1) == " $tval \
+ " != " $root "\n"
+ incr faults
+ }
+ }
+ set trouble
+} {}
+
+test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} {
+ set trouble {}
+ set faults 0
+ for {set i 0} {$i < 29 && $faults < 10} {incr i} {
+ for {set j 0} {$j <= $i} {incr j} {
+ set k [expr {isqrt((1<<56)+(1<<$i)+(1<<$j))}]
+ if {$k != (1<<28)} {
+ append trouble "i = $i, j = $j, k = $k\n"
+ incr faults
+ }
+ }
+ set k [expr {isqrt((1<<56)+(1<<29)+(1<<$i))}]
+ if {$k != (1<<28)+1} {
+ append trouble "i = $i, k = $k\n"
+ incr faults
+ }
+ }
+ set trouble
+} {}
+
+test expr-48.1 {Bug 1770224} {
+ expr {-0x8000000000000001 >> 0x8000000000000000}
+} -1
+
+test expr-49.1 {Bug 2823282} {
+ coroutine foo apply {{} {set expr expr; $expr {[yield]}}}
+ 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
if {[info exists a]} {
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 4ba7034..3d22b09 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -1,36 +1,104 @@
# This file tests the tclFCmd.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) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 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: fCmd.test,v 1.46 2005/05/10 18:35:19 kennykb 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]]
+
+cd [temporaryDirectory]
+
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
+testConstraint winVista 0
+testConstraint win2000orXP 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
+testConstraint reg 0
+if {[testConstraint win]} {
+ catch {
+ # Is the registry extension already static to this shell?
+ try {
+ load {} Registry
+ set ::reglib {}
+ } on error {} {
+ # try the location given to use on the commandline to tcltest
+ ::tcltest::loadTestedCommands
+ load $::reglib Registry
+ }
+ testConstraint reg 1
+ }
+}
+
+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]}]
+if {[testConstraint unix]} {
+ catch {
+ set groupList [exec groups]
+ 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 win]} {
+ set major [string index $tcl_platform(osVersion) 0]
+ if {[testConstraint nt] && $major > 4} {
+ if {$major > 5} {
+ testConstraint winVista 1
+ } elseif {$major == 5} {
+ testConstraint win2000orXP 1
+ }
+ }
+}
+
+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
+testConstraint notFileSharing 1
+testConstraint linkFile 1
+testConstraint linkDirectory 1
# Several tests require need to match results against the unix username
set user {}
-if {$tcl_platform(platform) == "unix"} {
- catch {set user [exec whoami]}
- if {$user == ""} {
- catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+if {[testConstraint unix]} {
+ catch {
+ set user [exec whoami]
+ }
+ if {$user eq ""} {
+ catch {
+ regexp {^[^(]*\(([^)]*)\)} [exec id] -> user
+ }
}
- if {$user == ""} {
+ if {$user eq ""} {
set user "root"
}
}
@@ -42,18 +110,18 @@ proc createfile {file {string a}} {
return $string
}
-#
+#
# checkcontent --
#
-# Ensures that file "file" contains only the string "matchString"
-# returns 0 if the file does not exist, or has a different content
+# Ensures that file "file" contains only the string "matchString" returns 0
+# 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
- }]} {
+ close $f
+ } on error {} {
return 0
}
return [string match $matchString $fileString]
@@ -78,7 +146,10 @@ proc cleanup {args} {
set x [glob -directory $p tf* td*]
}
foreach file $x {
- if {[catch {file delete -force -- $file}]} {
+ if {
+ [catch {file delete -force -- $file}]
+ && [testConstraint testchmod]
+ } then {
catch {openup $file}
catch {file delete -force -- $file}
}
@@ -87,33 +158,18 @@ proc cleanup {args} {
}
proc contents {file} {
- set f [open $file r]
+ set f [open $file]
set r [read $f]
close $f
- set r
+ return $r
}
-cd [temporaryDirectory]
-testConstraint fileSharing 0
-testConstraint notFileSharing 1
-
-testConstraint xdev 0
-
-if {$tcl_platform(platform) == "unix"} {
- if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
- set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
- set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
- if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
- testConstraint xdev 1
- }
- }
-}
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 or allowable filename.
+# 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"
append long $long
@@ -121,80 +177,91 @@ append long $long
append long $long
append long $long
append long $long
-
-test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
+
+test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
+} -result {tf2}
-test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
+test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
file copy tf1 tf2
lsort [glob tf*]
-} {tf1 tf2}
-
-test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
- list [catch {file rename -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
- list [catch {file rename xyz} msg] $msg
-} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
-test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
- list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
- cleanup
- list [catch {file copy tf1 ~} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
- cleanup
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
- {notRoot} {
- cleanup
+} -result {tf1 tf2}
+
+test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
+ file rename -xyz
+} -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"}
+test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
+ file rename xyz ~_totally_bogus_user
+} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
+ file copy tf1 ~
+} -result {error copying "tf1": no such file or directory}
+test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
+ file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile tf3
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
+ file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
createfile tf1 tf1
file rename tf1 td1
contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
+} -result {tf1}
+test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup {
cleanup
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+ file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup {
cleanup
- list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
-} {1 {error copying: target "tf3" is not a directory}}
-test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+ file copy -force -- tf1 tf2 tf3
+} -result {error copying: target "tf3" is not a directory}
+test fCmd-3.10 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1 tf1
file rename tf1 tf2
contents tf2
-} {tf1}
-test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
+} -result {tf1}
+test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1 tf1
file rename -force -force -- tf1 tf2
contents tf2
-} {tf1}
-test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
+} -result {tf1}
+test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1 tf1
file mkdir td1
file rename tf1 td1
contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
+} -result {tf1}
+test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1 tf1
createfile tf2 tf2
createfile tf3 tf3
@@ -203,261 +270,291 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
file rename tf1 tf2 tf3 tf4 td1
list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
[contents [file join td1 tf3]] [contents [file join td1 tf4]]
-} {tf1 tf2 tf3 tf4}
-test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
+} -result {tf1 tf2 tf3 tf4}
+test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
- list [catch {file rename ~_totally_bogus_user td1} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
+ file rename ~_totally_bogus_user td1
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
cleanup
+} -constraints {notRoot unixOrPc} -returnCodes error -body {
file mkdir td1
- list [catch {file rename / td1} msg] $msg
-} {1 {error renaming "/" to "td1": file already exists}}
-test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- createfile tf3
- createfile tf4
+ file rename / td1
+} -result {error renaming "/" to "td1": file already exists}
+test fCmd-3.16 {FileCopyRename: break on first error} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
+ createfile tf1
+ createfile tf2
+ createfile tf3
+ createfile tf4
file mkdir td1
createfile [file join td1 tf3]
- list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
-} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
+ file rename tf1 tf2 tf3 tf4 td1
+} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]
-test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
+test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
glob td*
-} {td1}
-test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
+} -result {td1}
+test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1 td2 td3
lsort [glob td*]
-} {td1 td2 td3}
-test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
+} -result {td1 td2 td3}
+test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
catch {file mkdir td1 td2 tf1 td3 td4}
glob td1 td2 tf1 td3 td4
-} {td1 td2 tf1}
-test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
+} -result {td1 td2 tf1}
+test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
cleanup
- list [catch {file mkdir ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
- {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+ file mkdir ~_totally_bogus_user
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup {
cleanup
- list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+ file mkdir ""
+} -result {can't create directory "": no such file or directory}
+test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
glob td1
-} {td1}
-test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
+} -result {td1}
+test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir [file join td1 td2 td3 td4]
glob td1 [file join td1 td2]
-} "td1 [file join td1 td2]"
-test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
+} -result "td1 [file join td1 td2]"
+test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
set x [file exists td1]
file mkdir td1
list $x [file exists td1]
-} {1 1}
-test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
+} -result {1 1}
+test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile tf1
- list [catch {file mkdir tf1} msg] $msg
-} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
-test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
+ file mkdir tf1
+} -result [subst {can't create directory "[file join tf1]": file already exists}]
+test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
set x [file exists td1]
file mkdir td1
list $x [file exists td1]
-} {1 1}
-test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
- {unix notRoot testchmod} {
+} -result {1 1}
+test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
cleanup
+} -constraints {unix notRoot testchmod} -returnCodes error -body {
file mkdir td1/td2/td3
testchmod 000 td1/td2
- set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
+ file mkdir td1/td2/td3/td4
+} -cleanup {
testchmod 755 td1/td2
- set msg
-} {1 {can't create directory "td1/td2/td3": permission denied}}
-test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
cleanup
+} -result {can't create directory "td1/td2/td3": permission denied}
+test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
+ cleanup
+} -constraints {notRoot} -body {
set x [file exists td1]
file mkdir td1
list $x [file exists td1]
-} {0 1}
-test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
- {unix notRoot} {
+} -result {0 1}
+test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
cleanup
file delete -force foo
+} -constraints {unix notRoot} -body {
file mkdir foo
file attr foo -perm 040000
- set result [list [catch {file mkdir foo/tf1} msg] $msg]
+ file mkdir foo/tf1
+} -returnCodes error -cleanup {
file delete -force foo
- set result
-} {1 {can't create directory "foo/tf1": permission denied}}
-test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
+} -result {can't create directory "foo/tf1": permission denied}
+test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir tf1
file exists tf1
-} {1}
+} -result {1}
-test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
- list [catch {file delete -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
- list [catch {file delete -force -force} msg] $msg
-} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
-test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
+test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
+ file delete -xyz
+} -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 {}
+test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup {
cleanup
+} -body {
createfile tf1
createfile tf2
file mkdir td1
file delete tf2
glob tf* td*
-} {tf1 td1}
-test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
+} -result {tf1 td1}
+test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup {
cleanup
+} -body {
createfile tf1
createfile tf2
file mkdir td1
set x [list [file exists tf1] [file exists tf2] [file exists td1]]
file delete tf1 td1 tf2
lappend x [file exists tf1] [file exists tf2] [file exists tf3]
-} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
+} -cleanup {cleanup} -result {1 1 1 0 0 0}
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
cleanup
+} -constraints {notRoot unixOrPc} -body {
createfile tf1
createfile tf2
file mkdir td1
catch {file delete tf1 td1 $root tf2}
list [file exists tf1] [file exists tf2] [file exists td1]
-} {0 1 0}
-test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
- list [catch {file delete ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
+} -cleanup {cleanup} -result {0 1 0}
+test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
+ file delete ~_totally_bogus_user
+} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup {
catch {file delete ~/tf1}
+} -constraints {notRoot} -body {
createfile ~/tf1
file delete ~/tf1
-} {}
-test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
+} -result {}
+test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
set x [file exists tf1]
file delete tf1
list $x [file exists tf1]
-} {0 0}
-test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
+} -result {0 0}
+test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup {
cleanup
+} -body {
file mkdir td1
file delete td1
file exists td1
-} {0}
-test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
+} -result {0}
+test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir [file join td1 td2]
- list [catch {file delete td1} msg] $msg
-} {1 {error deleting "td1": directory not empty}}
-test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} {
+ file delete td1
+} -result {error deleting "td1": directory not empty}
+test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup {
cleanup
set dir [pwd]
+} -constraints {notRoot} -body {
file mkdir [file join td1 td2]
cd [file join td1 td2]
set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
cd $dir
lappend res [file exists td1] $msg
-} {0 0 {}}
-test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} {
+} -cleanup {
+ cd $dir
+} -result {0 0 {}}
+test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup {
cleanup
+} -constraints {unix} -body {
file mkdir [file join td1 td2]
- #exec chmod u-rwx [file join td1 td2]
file attributes [file join td1 td2] -permissions u+rwx
set res [list [catch {file delete -force td1} msg]]
lappend res [file exists td1] $msg
-} {0 0 {}}
+} -result {0 0 {}}
-test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
+test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} {
# can't test this, because it's caught by FileCopyRename
} {}
-test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
+test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} {
# can't test this, because it's caught by FileCopyRename
} {}
-test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
+test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup {
cleanup
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+ file rename tf1 tf2
+} -result {error renaming "tf1": no such file or directory}
+test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
-test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
+} -result {tf2}
+test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
-test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unix notRoot testchmod} {
+} -result {tf2}
+test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
cleanup
+} -constraints {unix notRoot testchmod} -body {
file mkdir td1
testchmod 000 td1
createfile tf1
- set msg [list [catch {file rename tf1 td1} msg] $msg]
+ file rename tf1 td1
+} -returnCodes error -cleanup {
testchmod 755 td1
- set msg
-} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {win 95} {
- cleanup
- createfile tf1
- list [catch {file rename tf1 $long} msg] $msg
-} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
-test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} {
+} -result {error renaming "tf1" to "td1/tf1": permission denied}
+test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
cleanup
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 tf2
glob tf*
-} {tf2}
-test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
+} -result {tf2}
+test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile tf1
createfile tf2
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
+ file rename tf1 tf2
+} -result {error renaming "tf1" to "tf2": file already exists}
+test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile tf1
createfile tf2
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
+ file rename tf1 tf2
+} -result {error renaming "tf1" to "tf2": file already exists}
+test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup {
cleanup
+} -constraints {notRoot} -body {
createfile tf1
createfile tf2
file rename -force tf1 tf2
glob tf*
-} {tf2}
-test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
+} -result {tf2}
+test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
file mkdir td2
createfile [file join td2 td1]
- list [catch {file rename -force td1 td2} msg] $msg
-} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
-test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
+ file rename -force td1 td2
+} -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}]
+test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile tf1
file mkdir [file join td1 tf1]
- list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+ file rename -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup {
cleanup
} -constraints {notRoot notNetworkFilesystem} -body {
@@ -476,10 +573,11 @@ test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
file rename -force td2 td1
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
+test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
cleanup
- list [catch {file rename -force $root tf1} msg] $msg
-} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
+} -constraints {notRoot} -returnCodes error -body {
+ file rename -force $root tf1
+} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
cleanup
} -constraints {notRoot} -body {
@@ -489,228 +587,264 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
file rename -force td2 td1
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} {
- cleanup /tmp
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
+ cleanup $tmpspace
+} -constraints {unix notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf1
-} {/tmp/tf1}
-test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {win} {
+ 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 {
file mkdir c:/tcl8975@
- if [catch {file rename c:/tcl8975@ d:/}] {
- set msg d:/tcl8975@
- } else {
- set msg [glob c:/tcl8975@ d:/tcl8975@]
- file delete -force d:/tcl8975@
+ if {[catch {file rename c:/tcl8975@ d:/}]} {
+ return d:/tcl8975@
}
+ glob c:/tcl8975@ d:/tcl8975@
+} -cleanup {
file delete -force c:/tcl8975@
- set msg
-} {d:/tcl8975@}
-test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
- {unix notRoot} {
- cleanup /tmp
+ catch {file delete -force d:/tcl8975@}
+} -result {d:/tcl8975@}
+test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
+ cleanup $tmpspace
+} -constraints {unix notRoot} -body {
file mkdir td1
- file rename td1 /tmp
- glob -nocomplain td* /tmp/td*
-} {/tmp/td1}
-test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
- {unix notRoot} {
- cleanup /tmp
+ 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 $tmpspace
+} -constraints {unix notRoot} -body {
createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf*
-} {/tmp/tf1}
-test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unix notRoot xdev} {
- cleanup /tmp
+ 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 $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
- set msg [list [catch {file rename td1 /tmp} msg] $msg]
+ file rename td1 $tmpspace
+} -returnCodes error -cleanup {
file attributes td1 -permissions 0755
- set msg
-} {1 {error renaming "td1": permission denied}}
-test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
- {unix notRoot} {
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 {
file mkdir ~/td1/td2
set td1name [file join [file dirname ~] [file tail ~] td1]
file attributes $td1name -permissions 0000
- set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+ file copy ~/td1 td1
+} -returnCodes error -cleanup {
file attributes $td1name -permissions 0755
file delete -force ~/td1
- set msg
-} {1 {error copying "~/td1": permission denied}}
-test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
- {unix notRoot} {
+} -result {error copying "~/td1": permission denied}
+test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
cleanup
+} -constraints {unix notRoot} -body {
file mkdir td2
file mkdir ~/td1
set td1name [file join [file dirname ~] [file tail ~] td1]
file attributes $td1name -permissions 0000
- set msg [list [catch {file copy td2 ~/td1} msg] $msg]
+ file copy td2 ~/td1
+} -returnCodes error -cleanup {
file attributes $td1name -permissions 0755
file delete -force ~/td1
- set msg
-} {1 {error copying "td2" to "~/td1/td2": permission denied}}
-test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
- {unix notRoot} {
+} -result {error copying "td2" to "~/td1/td2": permission denied}
+test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
cleanup
+} -constraints {unix notRoot} -body {
file mkdir ~/td1/td2
set td2name [file join [file dirname ~] [file tail ~] td1 td2]
file attributes $td2name -permissions 0000
- set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+ file copy ~/td1 td1
+} -returnCodes error -cleanup {
file attributes $td2name -permissions 0755
file delete -force ~/td1
- set msg
-} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
-test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unix notRoot xdev} {
- cleanup /tmp
+} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
+test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -returnCodes error -body {
file mkdir td1/td2/td3
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- list [catch {file rename -force td1 /tmp} msg] $msg
-} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
-test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unix notRoot xdev} {
- cleanup /tmp
+ 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 $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0000
- set msg [list [catch {file rename td1 /tmp} msg] $msg]
+ file rename td1 $tmpspace
+} -returnCodes error -cleanup {
file attributes td1/td2/td3 -permissions 0755
- set msg
-} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
-test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
- {unix notRoot xdev} {
- cleanup /tmp
+ 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 $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
- file rename td1 /tmp
- glob td* /tmp/td1/t*
-} {/tmp/td1/td2}
-test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
- {unix notRoot} {
- cleanup
+ 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 $tmpspace
+} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
- set catchResult [catch {file rename foo/bar /tmp} msg]
- set msg [lindex [split $msg :] end]
- catch {file delete /tmp/bar}
+ file rename foo/bar $tmpspace
+} -returnCodes error -cleanup {
+ catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
- list $catchResult $msg
-} {1 { permission denied}}
-test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
- {unix notRoot xdev} {
- catch {cleanup /tmp}
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename /tmp/td1/tf1 tf1
- list [file exists /tmp/td1/tf1] [file exists tf1]
-} {0 1}
-test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
- cleanup
- list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-catch {cleanup /tmp}
+} -match glob -result {*: permission denied}
+test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
+ 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}
-test fCmd-7.1 {FileForceOption: none} {notRoot} {
+test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
cleanup
+} -returnCodes error -body {
file mkdir [file join tf1 tf2]
- list [catch {file delete tf1} msg] $msg
-} {1 {error deleting "tf1": directory not empty}}
-test fCmd-7.2 {FileForceOption: -force} {notRoot} {
+ file delete tf1
+} -result {error deleting "tf1": directory not empty}
+test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup {
cleanup
+} -body {
file mkdir [file join tf1 tf2]
file delete -force tf1
-} {}
-test fCmd-7.3 {FileForceOption: --} {notRoot} {
+} -result {}
+test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body {
createfile -tf1
file delete -- -tf1
-} {}
-test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
+} -result {}
+test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
createfile -tf1
- set msg [list [catch {file delete -tf1} msg] $msg]
+} -body {
+ file delete -tf1
+} -returnCodes error -cleanup {
file delete -- -tf1
- set msg
-} {1 {bad option "-tf1": should be -force or --}}
-test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
+} -result {bad option "-tf1": must be -force or --}
+test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
createfile --
createfile -force
file delete -force -force -- -- -force
- list [catch {glob -- -- -force} msg] $msg
-} {1 {no files matched glob patterns "-- -force"}}
+ glob -- -- -force
+} -result {no files matched glob patterns "-- -force"}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- {unix notRoot knownBug} {
+ -constraints {unix notRoot knownBug} -body {
# Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
file attr td1 -perm 040000
- set result [list [catch {file rename ~$user td1} msg] $msg]
+ file rename ~$user td1
+} -returnCodes error -cleanup {
file delete -force td1
- set result
-} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
+} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- {unix notRoot} {
+ -constraints {unix notRoot} -body {
string equal [file tail ~$user] ~$user
-} 0
-test fCmd-8.3 {file copy and path translation: ensure correct error} {
- list [catch {file copy ~ [file join this file doesnt exist]} res] $res
-} [list 1 \
- "error copying \"~\" to \"[file join this file doesnt exist]\":\
- no such file or directory"]
+} -result 0
+test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
+ file copy ~ [file join this file doesnt exist]
+} -returnCodes error -result [subst \
+ {error copying "~" to "[file join this file doesnt exist]": no such file or directory}]
-test fCmd-9.1 {file rename: comprehensive: EACCES} {unix notRoot} {
+test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
cleanup
+} -constraints {unix notRoot} -body {
file mkdir td1
file mkdir td2
file attr td2 -perm 040000
- set result [list [catch {file rename td1 td2/} msg] $msg]
+ file rename td1 td2/
+} -returnCodes error -cleanup {
file delete -force td2
file delete -force td1
- set result
-} {1 {error renaming "td1" to "td2/td1": permission denied}}
-test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
+} -result {error renaming "td1" to "td2/td1": permission denied}
+test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup {
cleanup
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
+} -constraints {notRoot} -returnCodes error -body {
+ file rename tf1 tf2
+} -result {error renaming "tf1": no such file or directory}
+test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
testchmod 444 tf2
file rename tf1 tf3
file rename tf2 tf4
list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
-} {{tf3 tf4} 1 0}
-test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
+} -result {{tf3 tf4} 1 0}
+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]
-} {{td3 td4} 1 0}
-test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
+} -cleanup {
+ cleanup
+} -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
+ file rename td2 td4
+ list [lsort [glob td*]] [file writable td3] [file writable td4]
+} -cleanup {
+ cleanup
+} -result {{td3 td4} 1 0}
+test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
+ cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1 tf1
createfile tf2 tf2
testchmod 444 tf2
file rename -force tf1 tf1
file rename -force tf2 tf2
list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}
-test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
+} -result {tf1 tf2 1 0}
+test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
cleanup
+} -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]
-} {{td1 td2} 1 0}
-test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
+} -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
+ 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.7 {file rename: comprehensive: file to existing file} -setup {
+ cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
createfile tfs1
@@ -730,14 +864,13 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testc
file rename -force tfs2 tfd2
file rename -force tfs3 tfd3
file rename -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
+ list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
- # Under unix, you can rename a read-only directory, but you can't
- # move it into another directory.
-
+ # Under unix, you can rename a read-only directory, but you can't move it
+ # into another directory.
file mkdir td1
file mkdir [file join td2 td1]
file mkdir tds1
@@ -748,7 +881,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
file mkdir [file join tdd2 tds2]
file mkdir [file join tdd3 tds3]
file mkdir [file join tdd4 tds4]
- if {$tcl_platform(platform) != "unix"} {
+ if {![testConstraint unix]} {
testchmod 555 tds3
testchmod 555 tds4
}
@@ -759,12 +892,12 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
file rename -force tds2 tdd2
file rename -force tds3 tdd3
file rename -force tds4 tdd4
- if {$tcl_platform(platform) != "unix"} {
- set w3 [file writable [file join tdd3 tds3]]
- set w4 [file writable [file join tdd4 tds4]]
- } else {
+ if {[testConstraint unix]} {
set w3 0
set w4 0
+ } else {
+ set w3 [file writable [file join tdd3 tds3]]
+ set w4 [file writable [file join tdd4 tds4]]
}
list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
[file writable [file join tdd2 tds2]] $w3 $w4
@@ -777,21 +910,22 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
file mkdir tds2
file mkdir [file join tdd1 tds1 xxx]
file mkdir [file join tdd2 tds2 xxx]
- if {$tcl_platform(platform) != "unix"} {
+ if {!([testConstraint unix] || [testConstraint winVista])} {
testchmod 555 tds2
}
set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
- if {$tcl_platform(platform) != "unix"} {
- set w2 [file writable tds2]
- } else {
+ if {[testConstraint unix] || [testConstraint winVista]} {
set w2 0
+ } else {
+ set w2 [file writable tds2]
}
list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} -match glob -result \
[subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
file mkdir td1
@@ -800,25 +934,26 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot t
file rename tf2 [file join td1 tf4]
list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
+} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
- if {$tcl_platform(platform) != "unix"} {
+ if {!([testConstraint unix] || [testConstraint winVista])} {
testchmod 555 td2
}
file rename td1 [file join td3 td3]
file rename td2 [file join td3 td4]
- if {$tcl_platform(platform) != "unix"} {
- set w4 [file writable [file join td3 td4]]
- } else {
+ if {[testConstraint unix] || [testConstraint winVista]} {
set w4 0
+ } else {
+ set w4 [file writable [file join td3 td4]]
}
list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
[file writable [file join td3 td3]] $w4
-} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
+} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
@@ -839,79 +974,104 @@ test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
file rename -force td1 td2
} -returnCodes error -match glob -result \
[subst {error renaming "td1" to "[file join td2 td1]": file *}]
-test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
+test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
-} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
-test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} {
+} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
+test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
cleanup
+} -constraints {notRoot} -body {
file mkdir td1
file rename td1 td1x
file rename td1x td1
set msg "ok"
-} {ok}
-test fCmd-9.14.2 {file rename: comprehensive: dir into self} {nonPortable notRoot} {
+} -result {ok}
+test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup {
cleanup
- file mkdir td1
set dir [pwd]
+} -constraints {nonPortable notRoot} -body {
+ file mkdir td1
cd td1
- set res [list [catch {file rename [file join .. td1] [file join .. td1x]} msg] $msg]
+ file rename [file join .. td1] [file join .. td1x]
+} -returnCodes error -cleanup {
cd $dir
- set res
-} [subst {1 {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}}]
-test fCmd-9.14.3 {file rename: comprehensive: dir into self} {notRoot} {
+} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}]
+test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup {
cleanup
- file mkdir td1
set dir [pwd]
+} -constraints {notRoot} -body {
+ file mkdir td1
cd td1
- set res [list [catch {file rename [file join .. td1] [file join .. td1 foo]} msg] $msg]
+ file rename [file join .. td1] [file join .. td1 foo]
+} -returnCodes error -cleanup {
cd $dir
- set res
-} [subst {1 {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}}]
-test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
- {notRoot} {
+} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}]
+test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
createfile tf1
- list [catch {file rename -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
- {notRoot} {
+ file rename -force td1 tf1
+} -cleanup {
+ cleanup
+} -result {can't overwrite file "tf1" with directory "td1"}
+test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir td1/tf1
createfile tf1
- list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+ file rename -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
-test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
+test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
cleanup
- list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
+} -constraints {notRoot} -returnCodes error -body {
+ file copy tf1 tf2
+} -result {error copying "tf1": no such file or directory}
+test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1 tf1
createfile tf2 tf2
testchmod 444 tf2
file copy tf1 tf3
file copy tf2 tf4
list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
-} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
-test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} {
+} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
+test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
+ cleanup
+} -constraints {unix notRoot testchmod} -body {
+ file mkdir [file join td1 tdx]
+ file mkdir [file join td2 tdy]
+ testchmod 555 td2
+ file copy td1 td3
+ file copy td2 td4
+ list [lsort [glob td*]] [glob -directory td3 t*] \
+ [glob -directory td4 t*] [file writable td3] [file writable td4]
+} -cleanup {
+ testchmod 755 td2
+ testchmod 755 td4
+} -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 {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]
testchmod 555 td2
file copy td1 td3
file copy td2 td4
- set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
- [glob -directory td4 t*] [file writable td3] [file writable td4]]
+ list [lsort [glob td*]] [glob -directory td3 t*] \
+ [glob -directory td4 t*] [file writable td3] [file writable td4]
+} -cleanup {
testchmod 755 td2
testchmod 755 td4
- set msg
-} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
-test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
+} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
+test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
createfile tfs1
@@ -931,10 +1091,11 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testch
file copy -force tfs2 tfd2
file copy -force tfs3 tfd3
file copy -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
+ list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
+test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
file mkdir td1
file mkdir [file join td2 td1]
file mkdir tds1
@@ -954,11 +1115,11 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod}
set a3 [catch {file copy -force tds2 tdd2}]
set a4 [catch {file copy -force tds3 tdd3}]
set a5 [catch {file copy -force tds4 tdd4}]
- list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
-} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
-test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
- {notRoot unixOrPc testchmod} {
+ list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
+} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
+test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
cleanup
+} -constraints {notRoot unixOrPc testchmod} -body {
file mkdir tds1
file mkdir tds2
file mkdir [file join tdd1 tds1 xxx]
@@ -967,9 +1128,10 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
-} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
+} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
+test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
cleanup
+} -constraints {notRoot testchmod} -body {
createfile tf1
createfile tf2
file mkdir td1
@@ -978,10 +1140,10 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot t
file copy tf2 [file join td1 tf4]
list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [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} \
- {notRoot unixOrPc testchmod} {
+} -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 {unix notRoot testchmod} -body {
file mkdir td1
file mkdir td2
file mkdir td3
@@ -990,556 +1152,591 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
file copy td2 [file join td3 td4]
list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
[file writable [file join td3 td3]] [file writable [file join td3 td4]]
-} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
- {notRoot} {
+} -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 {win notRoot testchmod} -body {
+ # On Windows with ACLs, copying a directory is defined like this
+ file mkdir td1
+ file mkdir td2
+ file mkdir td3
+ testchmod 555 td2
+ file copy td1 [file join td3 td3]
+ file copy td2 [file join td3 td4]
+ list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
+ [file writable [file join td3 td3]] [file writable [file join td3 td4]]
+} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
+test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
+ cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir td1
createfile tf1
- list [catch {file copy -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
- {notRoot} {
+ file copy -force td1 tf1
+} -result {can't overwrite file "tf1" with directory "td1"}
+test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup {
cleanup
+} -constraints {notRoot} -returnCodes error -body {
file mkdir [file join td1 tf1]
createfile tf1
- list [catch {file copy -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-test fCmd-10.11 {file copy: copy to empty file name} {
+ file copy -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
+test fCmd-10.11 {file copy: copy to empty file name} -setup {
cleanup
+} -returnCodes error -body {
createfile tf1
- list [catch {file copy tf1 ""} msg] $msg
-} {1 {error copying "tf1" to "": no such file or directory}}
-test fCmd-10.12 {file rename: rename to empty file name} {
+ file copy tf1 ""
+} -result {error copying "tf1" to "": no such file or directory}
+test fCmd-10.12 {file rename: rename to empty file name} -setup {
cleanup
+} -returnCodes error -body {
createfile tf1
- list [catch {file rename tf1 ""} msg] $msg
-} {1 {error renaming "tf1" to "": no such file or directory}}
-cleanup
+ file rename tf1 ""
+} -result {error renaming "tf1" to "": no such file or directory}
+cleanup
-# old tests
+# old tests
-test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
+test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup {
catch {file delete -force -- -tfa1}
+} -body {
set s [createfile -tfa1]
file rename -- -tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
+ list [checkcontent tfa2 $s] [file exists -tfa1]
+} -cleanup {
file delete tfa2
- set result
-} {1}
-test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
+} -result {1 0}
+test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup {
catch {file delete -force -- tfa1}
+} -body {
set s [createfile tfa1]
- set r1 [catch {file rename -x tfa1 tfa2}]
- set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+ list [catch {file rename -x tfa1 tfa2}] \
+ [checkcontent tfa1 $s] [file exists tfa2]
+} -cleanup {
file delete tfa1
- set result
-} {1}
-test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
- catch {file rename -- }
-} {1}
-test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file rename tfa ~/foobar }]
- set env(HOME) $temp
- set result
- } {1}
-test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
+} -result {1 1 0}
+test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body {
+ file rename --
+} -match glob -result *
+test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints notRoot -body {
+ global env
+ unset env(HOME)
+ catch { file rename tfa ~/foobar }
+} -cleanup {
+ set ::env(HOME) $temp
+} -result 1
+test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file rename tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
+ catch {file rename tfa1 tfa2 tfa3}
+} -cleanup {
file delete tfa1 tfa2 tfa3
- set result
-} {1}
-test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
+} -result {1}
+test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
file mkdir tfad
file rename tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
+ list [checkcontent tfad/tfa1 $s] [file exists tfa1]
+} -cleanup {
file delete -force tfad
- set result
-} {1}
-test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
+} -result {1 0}
+test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup {
catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
+} -constraints {notRoot} -body {
+ set s1 [createfile tfa1]
+ set s2 [createfile tfa2]
file mkdir tfad
file rename tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
-
- set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
-
+ list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+ [file exists tfa1] [file exists tfa2]
+} -cleanup {
file delete -force tfad
- set result
-} {1}
-test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
+} -result {1 1 0 0}
+test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup {
catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s [createfile tfa]
file mkdir tfad
file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
+ list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
+} -result {1 1 1}
#
# Coverage tests for renamefile() ;
#
-test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
+test fCmd-12.1 {renamefile: source filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
unset env(HOME)
- set result [catch {file rename ~/tfa1 tfa2}]
- set env(HOME) $temp
- set result
-} {1}
-test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
+ catch {file rename ~/tfa1 tfa2}
+} -cleanup {
+ set ::env(HOME) $temp
+} -result {1}
+test fCmd-12.2 {renamefile: src filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
unset env(HOME)
set s [createfile tfa1]
file mkdir tfad
- set result [catch {file rename tfa1 ~/tfa2 tfad}]
- set env(HOME) $temp
+ catch {file rename tfa1 ~/tfa2 tfad}
+} -cleanup {
+ set ::env(HOME) $temp
file delete -force tfad
- set result
-} {1}
-test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
+} -result {1}
+test fCmd-12.3 {renamefile: stat failing on source} -setup {
catch {file delete -force -- tfa1 tfa2}
- set r1 [catch {file rename tfa1 tfa2}]
- expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
-} {1}
-test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
+} -constraints {notRoot} -body {
+ list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
catch {file delete -force -- tfa tfad}
- set s1 [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s1 [createfile tfa]
file mkdir tfad
file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s1]
- set r3 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3]
+ list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \
+ [file isdir tfad/tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
+} -result {1 1 1}
+test fCmd-12.5 {renamefile: error renaming directory to file} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa
file mkdir tfad
set s [createfile tfad/tfa]
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfad/tfa $s]
- set r3 [file isdir tfad]
- set r4 [file isdir tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
+ list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \
+ [file isdir tfad] [file isdir tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
file rename tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
+ list [checkcontent tfa2 $s] [file exists tfa1]
+} -cleanup {
file delete tfa2
- set result
-} {1}
-test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
+} -result {1 0}
+test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
catch {file delete -force -- tfad}
+} -constraints {notRoot} -body {
file mkdir tfad
file mkdir tfad/dir
- set result [catch {file rename tfad tfad/dir}]
- file delete -force tfad
- set result
-} {1}
-test fCmd-12.8 {renamefile: generic error} {unix notRoot} {
+ catch {file rename tfad tfad/dir}
+} -cleanup {
+ file delete -force tfad
+} -result {1}
+test fCmd-12.8 {renamefile: generic error} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/dir
file attributes tfa -permissions 0555
- set result [catch {file rename tfa/dir tfa2}]
- file attributes tfa -permissions 0777
+ catch {file rename tfa/dir tfa2}
+} -cleanup {
+ catch {file attributes tfa -permissions 0777}
file delete -force tfa
- set result
-} {1}
-test fCmd-12.9 {renamefile: moving a file across volumes} {unix notRoot} {
- catch {file delete -force -- tfa /tmp/tfa}
- set s [createfile tfa ]
- file rename tfa /tmp
- set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
- file delete /tmp/tfa
- set result
-} {1}
-test fCmd-12.10 {renamefile: moving a directory across volumes } \
- {unix notRoot} {
- catch {file delete -force -- tfad /tmp/tfad}
+} -result {1}
+test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
+ cleanup $tmpspace
+} -constraints {unix notRoot} -body {
+ set s [createfile tfa]
+ file rename tfa $tmpspace
+ list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
+} -cleanup {
+ cleanup $tmpspace
+} -result {1 0}
+test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir tfad
- set s [createfile tfad/a ]
- file rename tfad /tmp
- set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
- file delete -force /tmp/tfad
- set result
-} {1}
+ set s [createfile tfad/a]
+ file rename tfad $tmpspace
+ list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad]
+} -cleanup {
+ cleanup $tmpspace
+} -result {1 0}
#
# Coverage tests for TclCopyFilesCmd()
#
-test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
+test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup {
catch {file delete -force -- tfa1}
+} -body {
set s [createfile tfa1]
file copy -force tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+ list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
file delete tfa1 tfa2
- set result
-} {1}
-test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
+} -result {1 1}
+test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1}
+} -body {
set s [createfile -tfa1]
file copy -- -tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]]
+ list [checkcontent tfa2 $s] [checkcontent -tfa1 $s]
+} -cleanup {
file delete -- -tfa1 tfa2
- set result
-} {1}
-test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
+} -result {1 1}
+test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1}
+} -body {
set s [createfile tfa1]
- set r1 [catch {file copy -x tfa1 tfa2}]
- set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+ list [catch {file copy -x tfa1 tfa2}] \
+ [checkcontent tfa1 $s] [file exists tfa2]
+} -cleanup {
file delete tfa1
- set result
-} {1}
-test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
- catch {file copy -- }
-} {1}
-test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
- global env
- set temp $env(HOME)
+} -result {1 1 0}
+test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body {
+ file copy --
+} -returnCodes error -match glob -result *
+test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
+ set temp $::env(HOME)
+} -body {
+ global env
unset env(HOME)
- set result [catch {file copy tfa ~/foobar }]
- set env(HOME) $temp
- set result
- } {1}
-test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
+ catch { file copy tfa ~/foobar }
+} -cleanup {
+ set ::env(HOME) $temp
+} -result {1}
+test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file copy tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
+ catch {file copy tfa1 tfa2 tfa3}
+} -cleanup {
file delete tfa1 tfa2 tfa3
- set result
-} {1}
-test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
+} -result {1}
+test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
file mkdir tfad
file copy tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
+ list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
+} -cleanup {
file delete -force tfad tfa1
- set result
-} {1}
-test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
+} -result {1 1}
+test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup {
catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
+} -constraints {notRoot} -body {
+ set s1 [createfile tfa1]
+ set s2 [createfile tfa2]
file mkdir tfad
file copy tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
- set r3 [checkcontent tfa1 $s1]
- set r4 [checkcontent tfa2 $s2]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
-
+ list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+ [checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
+} -cleanup {
file delete -force tfad tfa1 tfa2
- set result
-} {1}
-test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup {
catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s [createfile tfa]
file mkdir tfad
file mkdir tfad/tfa
- set r1 [catch {file copy tfa tfad}]
- set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
+ list [catch {file copy tfa tfad}] [checkcontent tfa $s] \
+ [file isdir tfad/tfa] [file isdir tfad]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
+} -result {1 1 1 1}
#
# Coverage tests for copyfile()
-#
-test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
+#
+test fCmd-14.1 {copyfile: source filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
unset env(HOME)
- set result [catch {file copy ~/tfa1 tfa2}]
- set env(HOME) $temp
- set result
-} {1}
-test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
+ catch {file copy ~/tfa1 tfa2}
+} -cleanup {
+ set ::env(HOME) $temp
+} -result {1}
+test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
unset env(HOME)
set s [createfile tfa1]
file mkdir tfad
- set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
- set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
- set env(HOME) $temp
+ list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s]
+} -cleanup {
+ set ::env(HOME) $temp
file delete -force tfa1 tfad
- set result
-} {1}
-test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
+} -result {1 1}
+test fCmd-14.3 {copyfile: stat failing on source} -setup {
catch {file delete -force -- tfa1 tfa2}
- set r1 [catch {file copy tfa1 tfa2}]
- expr $r1 && ![file exists tfa1] && ![file exists tfa2]
-} {1}
-test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
+} -constraints notRoot -body {
+ list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-14.4 {copyfile: error copying file to directory} -setup {
catch {file delete -force -- tfa tfad}
- set s1 [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s1 [createfile tfa]
file mkdir tfad
file mkdir tfad/tfa
- set r1 [catch {file copy tfa tfad}]
- set r2 [checkcontent tfa $s1]
- set r3 [file isdir tfad]
- set r4 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
+ list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \
+ [file isdir tfad] [file isdir tfad/tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa
- file mkdir tfad
- set s [createfile tfad/tfa]
- set r1 [catch {file copy tfa tfad}]
- set r2 [checkcontent tfad/tfa $s]
- set r3 [file isdir tfad]
- set r4 [file isdir tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
+} -result {1 1 1 1}
+test fCmd-14.5 {copyfile: error copying directory to file} -setup {
+ catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
+ file mkdir tfa
+ file mkdir tfad
+ set s [createfile tfad/tfa]
+ list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \
+ [file isdir tfad] [file isdir tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup {
catch {file delete -force -- tfa tfa2}
+} -body {
set s [createfile tfa]
file copy tfa tfa2
- set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]]
+ list [checkcontent tfa $s] [checkcontent tfa2 $s]
+} -cleanup {
file delete tfa tfa2
- set result
-} {1}
-test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
+} -result {1 1}
+test fCmd-14.7 {copyfile: copy directory succeeding} -setup {
catch {file delete -force -- tfa tfa2}
+} -constraints {notRoot} -body {
file mkdir tfa
set s [createfile tfa/file]
file copy tfa tfa2
- set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
+ list [checkcontent tfa/file $s] [checkcontent tfa2/file $s]
+} -cleanup {
file delete -force tfa tfa2
- set result
-} {1}
-test fCmd-14.8 {copyfile: copy directory failing} {unix notRoot} {
+} -result {1 1}
+test fCmd-14.8 {copyfile: copy directory failing} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa/dir/a/b/c
file attributes tfa/dir -permissions 0000
- set r1 [catch {file copy tfa tfa2}]
+ catch {file copy tfa tfa2}
+} -cleanup {
file attributes tfa/dir -permissions 0777
- set result $r1
file delete -force tfa tfa2
- set result
-} {1}
+} -result {1}
#
# Coverage tests for TclMkdirCmd()
#
-test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
+test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file mkdir ~/tfa}]
- set env(HOME) $temp
- set result
-} {1}
+ unset env(HOME)
+ catch {file mkdir ~/tfa}
+} -cleanup {
+ 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 } {notRoot} {
+test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
file mkdir tfa
- set result [file isdirectory tfa]
+ file isdirectory tfa
+} -cleanup {
file delete tfa
- set result
-} {1}
-test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
+} -result {1}
+test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
file mkdir tfa1 tfa2
- set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
+ list [file isdirectory tfa1] [file isdirectory tfa2]
+} -cleanup {
file delete tfa1 tfa2
- set result
-} {1}
-test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unix notRoot} {
+} -result {1 1}
+test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
createfile tfa/file
file attributes tfa -permissions 0000
- set result [catch {file mkdir tfa/file}]
+ catch {file mkdir tfa/file}
+} -cleanup {
file attributes tfa -permissions 0777
file delete -force tfa
- set result
-} {1}
-test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
- {notRoot} {
+} -result {1}
+test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
file mkdir tfa/a/b/c
- set result [file isdir tfa/a/b/c]
+ file isdir tfa/a/b/c
+} -cleanup {
file delete -force tfa
- set result
-} {1}
-test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
+} -result {1}
+test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
set s [createfile tfa]
- set r1 [catch {file mkdir tfa}]
- set r2 [file isdir tfa]
- set r3 [file exists tfa]
- set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
+ list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \
+ [checkcontent tfa $s]
+} -cleanup {
file delete tfa
- set result
-} {1}
-test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
+} -result {1 0 1 1}
+test fCmd-15.7 {TclMakeDirsCmd - making several directories} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
file mkdir tfa1 tfa2/a/b/c
- set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
+ list [file isdir tfa1] [file isdir tfa2/a/b/c]
+} -cleanup {
file delete -force tfa1 tfa2
- set result
-} {1}
-test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
+} -result {1 1}
+test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
file mkdir tfa
file mkdir tfa
- set result [file isdir tfa]
+ file isdir tfa
+} -constraints {notRoot} -cleanup {
file delete tfa
- set result
-} {1}
+} -result {1}
# Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 {test the -- argument} {notRoot} {
+test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
+} -body {
createfile tfa
file delete -- tfa
file exists tfa
-} {0}
-test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
+} -result 0
+test fCmd-16.2 {test the -force and -- arguments} -constraints notRoot -setup {
catch {file delete -force -- tfa}
+} -body {
createfile tfa
file delete -force -- tfa
file exists tfa
-} {0}
-test fCmd-16.3 {test bad option} {notRoot} {
+} -result 0
+test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
+} -body {
createfile tfa
- set result [catch {file delete -dog tfa}]
+ catch {file delete -dog tfa}
+} -cleanup {
file delete tfa
- set result
-} {1}
-test fCmd-16.4 {test not enough args} {notRoot} {
- catch {file delete}
-} {1}
-test fCmd-16.5 {test not enough args with options} {notRoot} {
- catch {file delete --}
-} {1}
-test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
+} -result {1}
+test fCmd-16.4 {accept zero files (TIP 323)} -body {
+ file delete
+} -result {}
+test fCmd-16.5 {accept zero files (TIP 323)} -body {
+ file delete --
+} -result {}
+test fCmd-16.6 {delete: source filename translation failing} -setup {
+ set temp $::env(HOME)
+} -constraints {notRoot} -body {
global env
- set temp $env(HOME)
unset env(HOME)
- set result [catch {file delete ~/tfa}]
- set env(HOME) $temp
- set result
-} {1}
-test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
+ catch {file delete ~/tfa}
+} -cleanup {
+ set ::env(HOME) $temp
+} -result {1}
+test fCmd-16.7 {remove a non-empty directory without -force} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
file mkdir tfa
createfile tfa/a
- set result [catch {file delete tfa }]
+ catch {file delete tfa}
+} -cleanup {
file delete -force tfa
- set result
-} {1}
-test fCmd-16.8 {remove a normal file } {notRoot} {
+} -result {1}
+test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
+} -body {
file mkdir tfa
createfile tfa/a
- set result [catch {file delete tfa }]
+ catch {file delete tfa}
+} -cleanup {
file delete -force tfa
- set result
-} {1}
-test fCmd-16.9 {error while deleting file } {unix notRoot} {
+} -result {1}
+test fCmd-16.9 {error while deleting file} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
createfile tfa/a
file attributes tfa -permissions 0555
- set result [catch {file delete tfa/a }]
+ catch {file delete tfa/a}
#######
- ####### If any directory in a tree that is being removed does not
- ####### have write permission, the process will fail!
- ####### This is also the case with "rm -rf"
+ ####### If any directory in a tree that is being removed does not have
+ ####### write permission, the process will fail! This is also the case
+ ####### with "rm -rf"
#######
+} -cleanup {
file attributes tfa -permissions 0777
file delete -force tfa
- set result
-} {1}
-test fCmd-16.10 {deleting multiple files} {notRoot} {
+} -result {1}
+test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -body {
createfile tfa1
createfile tfa2
file delete tfa1 tfa2
- expr ![file exists tfa1] && ![file exists tfa2]
-} {1}
-test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
+ list [file exists tfa1] [file exists tfa2]
+} -result {0 0}
+test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
file delete tfa
- set result 1
-} {1}
+} -result {}
# More coverage tests for mkpath()
-test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unix notRoot} {
+test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
catch {file delete -force -- tfa1}
+} -constraints {unix notRoot} -body {
file mkdir tfa1
file attributes tfa1 -permissions 0555
- set result [catch {file mkdir tfa1/tfa2}]
+ catch {file mkdir tfa1/tfa2}
+} -cleanup {
file attributes tfa1 -permissions 0777
file delete -force tfa1
- set result
-} {1}
-test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
+} -result {1}
+test fCmd-17.2 {mkdir several levels deep - relative} -setup {
catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
file mkdir tfa/a/b
- set result [file isdir tfa/a/b ]
+ file isdir tfa/a/b
+} -cleanup {
file delete tfa/a/b tfa/a tfa
- set result
-} {1}
-test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
+} -result 1
+test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
catch {file delete -force -- tfa}
- set f [file join [pwd] tfa a ]
+} -constraints {notRoot} -body {
+ set f [file join [pwd] tfa a]
file mkdir $f
- set result [file isdir $f ]
+ file isdir $f
+} -cleanup {
file delete $f [file join [pwd] tfa]
- set result
-} {1}
+} -result {1}
#
# Functionality tests for TclFileRenameCmd()
#
-
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
- {notRoot} {
+ -setup {
catch {file delete -force -- tfad}
+ set savedDir [pwd]
+} -constraints {notRoot} -body {
file mkdir tfad/dir
cd tfad/dir
- set s [createfile foo ]
+ set s [createfile foo]
file rename foo bar
file rename bar ./foo
file rename ./foo bar
@@ -1549,73 +1746,70 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
file rename ../../tfad/dir/foo ../../tfad/dir/bar
file rename [file join [pwd] bar] foo
file rename foo [file join [pwd] bar]
- set result [expr [checkcontent bar $s] && ![file exists foo]]
- cd ../..
+ list [checkcontent bar $s] [file exists foo]
+} -cleanup {
+ cd $savedDir
file delete -force tfad
- set result
-} {1}
-test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
+} -result {1 0}
+test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
file mkdir tfa1
file rename tfa1 tfa2
- set result [expr [file exists tfa2] && ![file exists tfa1]]
+ list [file exists tfa2] [file exists tfa1]
+} -cleanup {
file delete tfa2
- set result
-} {1}
-test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
+} -result {1 0}
+test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} -setup {
catch {file delete -force -- tfa1 tfad1 tfad2}
- set s [createfile tfa1 ]
+} -constraints {notRoot} -body {
+ set s [createfile tfa1]
file mkdir tfad1 tfad2
file rename tfa1 tfad1 tfad2
- set r1 [checkcontent tfad2/tfa1 $s]
- set r2 [file isdir tfad2/tfad1]
- set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
+ list [checkcontent tfad2/tfa1 $s] [file isdir tfad2/tfad1] \
+ [file exists tfa1] [file exists tfad1]
+} -cleanup {
file delete tfad2/tfa1
file delete -force tfad2
- set result
-} {1}
-test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
+} -result {1 1 0 0}
+test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} -setup {
catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s [createfile tfa]
file mkdir tfad
- set r1 [catch {file rename tfad tfa}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
+ list [catch {file rename tfad tfa}] [checkcontent tfa $s] [file isdir tfad]
+} -cleanup {
file delete tfa tfad
- set result
-} {1}
-test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
+} -result {1 1 1}
+test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} -setup {
catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
+} -constraints {notRoot} -body {
+ set s [createfile tfa]
file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3 ]
- file delete -force tfa tfad
- set result
-} {1}
+ list [catch {file rename tfa tfad}] [checkcontent tfa $s] \
+ [file isdir tfad/tfa]
+} -cleanup {
+ file delete -force tfa tfad
+} -result {1 1 1}
#
# On Windows there is no easy way to determine if two files are the same
#
-test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {unix notRoot} {
+test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
set s [createfile tfa]
- set r1 [catch {file rename tfa tfa}]
- set result [expr $r1 && [checkcontent tfa $s]]
+ list [catch {file rename tfa tfa}] [checkcontent tfa $s]
+} -cleanup {
file delete tfa
- set result
-} {1}
-test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
- {notRoot} {
+} -result {1 1}
+test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set result [expr $r1 && [file isdir tfa]]
+ list [catch {file rename tfa tfad}] [file isdir tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
+} -result {1 1}
test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} -setup {
catch {file delete -force -- tfa tfad}
} -constraints {notRoot notNetworkFilesystem} -body {
@@ -1625,344 +1819,344 @@ test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -for
} -cleanup {
file delete -force tfad
} -result 0
-test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
- {notRoot} {
+test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa tfad/tfa/file
- set r1 [catch {file rename tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+ list [catch {file rename tfa tfad}] [file isdir tfa] \
+ [file isdir tfad/tfa/file]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
- {notRoot notNetworkFilesystem} {
+} -result {1 1 1}
+test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot notNetworkFilesystem} -body {
file mkdir tfa tfad/tfa/file
- set r1 [catch {file rename -force tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+ list [catch {file rename -force tfa tfad}] [file isdir tfa] \
+ [file isdir tfad/tfa/file]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
+} -result {1 1 1}
+test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} -setup {
catch {file delete -force -- tfa1}
- set r1 [catch {file rename tfa1 tfa2}]
- set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
-} {1}
-test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
- {unix notRoot} {
+} -constraints {notRoot} -body {
+ list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
set s [createfile tfa1]
file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
- set t [file type tfa3]
- set result [expr {$t eq "link"}]
+ file type tfa3
+} -cleanup {
file delete tfa1 tfa3
- set result
-} {1}
-test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
- {unix notRoot} {
+} -result link
+test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
file mkdir tfa1
file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
- set t [file type tfa3]
- set result [expr {$t eq "link"}]
+ file type tfa3
+} -cleanup {
file delete tfa1 tfa3
- set result
-} {1}
-test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
- {unix notRoot} {
+} -result link
+test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
file mkdir tfa1/a/b/c/d
file mkdir tfa2
- set f [file join [pwd] tfa1/a/b]
+ set f [file join [pwd] tfa1/a/b]
set f2 [file join [pwd] {tfa2/b alias}]
file link -symbolic $f2 $f
file rename {tfa2/b alias/c} tfa3
- set r1 [file isdir tfa3]
- set r2 [file exists tfa1/a/b/c]
- set result [expr $r1 && !$r2]
+ list [file isdir tfa3] [file exists tfa1/a/b/c]
+} -cleanup {
file delete -force tfa1 tfa2 tfa3
- set result
-} {1}
-test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
- {unix notRoot} {
+} -result {1 0}
+test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
catch {file delete -force -- tfa1 tfa2 tfalink}
-
+} -constraints {unix notRoot} -body {
file mkdir tfa1
set s [createfile tfa2]
file link -symbolic tfalink tfa1
-
file rename tfa2 tfalink
- set result [checkcontent tfa1/tfa2 $s ]
+ checkcontent tfa1/tfa2 $s
+} -cleanup {
file delete -force tfa1 tfalink
- set result
-} {1}
-test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unix notRoot} {
+} -result {1}
+test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
catch {file delete -force -- tfa1 tfalink}
-
+} -constraints {unix notRoot} -body {
file mkdir tfa1
file link -symbolic tfalink tfa1
- file delete tfa1
+ file delete tfa1
file rename tfalink tfa2
- set result [expr [string compare [file type tfa2] "link"] == 0]
+ file type tfa2
+} -cleanup {
file delete tfa2
- set result
-} {1}
+} -result link
#
# Coverage tests for TclUnixRmdir
#
-test fCmd-19.1 {remove empty directory} {notRoot} {
+test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
+} -body {
file mkdir tfa
file delete tfa
file exists tfa
-} {0}
-test fCmd-19.2 {rmdir error besides EEXIST} {unix notRoot} {
+} -result {0}
+test fCmd-19.2 {rmdir error besides EEXIST} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa -permissions 0555
- set result [catch {file delete tfa/a}]
+ catch {file delete tfa/a}
+} -cleanup {
file attributes tfa -permissions 0777
file delete -force tfa
- set result
-} {1}
-test fCmd-19.3 {recursive remove} {notRoot} {
+} -result {1}
+test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
+} -body {
file mkdir tfa
file mkdir tfa/a
file delete -force tfa
file exists tfa
-} {0}
+} -result {0}
#
-# TclUnixDeleteFile and TraversalDelete are covered by tests from the
+# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#
-#
#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
-
-test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
- {unix notRoot} {
+test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa/a -permissions 0000
- set result [catch {file delete -force tfa}]
+ catch {file delete -force tfa}
+} -cleanup {
file attributes tfa/a -permissions 0777
file delete -force tfa
- set result
-} {1}
-
-test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \
- {unix notRoot} {
+} -result {1}
+test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
file mkdir tfa
- for {set i 1} {$i <= 200} {incr i} {createfile tfa/testfile_$i}
- set result [catch {file delete -force tfa} msg]
+ for {set i 1} {$i <= 300} {incr i} {
+ createfile tfa/testfile_$i
+ }
+ file delete -force tfa
+} -cleanup {
while {[catch {file delete -force tfa}]} {}
- list $result $msg
-} {0 {}}
+} -result {}
#
# Feature testing for TclCopyFilesCmd
-#
-test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
+#
+test fCmd-21.1 {copy : single file to nonexistant} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
file copy tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+ list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
file delete tfa1 tfa2
- set result
-} {1}
-test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
+} -result {1 1}
+test fCmd-21.2 {copy : single dir to nonexistant} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
file mkdir tfa1
file copy tfa1 tfa2
- set result [expr [file isdir tfa2] && [file isdir tfa1]]
+ list [file isdir tfa2] [file isdir tfa1]
+} -cleanup {
file delete tfa1 tfa2
- set result
-} {1}
-test fCmd-21.3 {copy : single file into directory } {notRoot} {
+} -result {1 1}
+test fCmd-21.3 {copy : single file into directory} -setup {
catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
file mkdir tfad
file copy tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
+ list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
+} -cleanup {
file delete -force tfa1 tfad
- set result
-} {1}
-test fCmd-21.4 {copy : more than one source and target is not a directory} \
- {notRoot} {
+} -result {1 1}
+test fCmd-21.4 {copy : more than one source and target is not a directory} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file copy tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+ createfile tfa1
+ createfile tfa2
+ createfile tfa3
+ catch {file copy tfa1 tfa2 tfa3}
+} -cleanup {
file delete tfa1 tfa2 tfa3
- set result
-} {1}
-test fCmd-21.5 {copy : multiple files into directory } {notRoot} {
+} -result {1}
+test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
+} -body {
+ set s1 [createfile tfa1]
+ set s2 [createfile tfa2]
file mkdir tfad
file copy tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
- set r3 [checkcontent tfa1 $s1]
- set r4 [checkcontent tfa2 $s2]
- set result [expr $r1 && $r2 && $r3 && $r4]
+ list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+ [checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
+} -cleanup {
file delete -force tfa1 tfa2 tfad
- set result
-} {1}
-test fCmd-21.6 {copy: mixed dirs and files into directory} \
- {notRoot notFileSharing} {
+} -result {1 1 1 1}
+test fCmd-21.6 {copy: mixed dirs and files into directory} -setup {
catch {file delete -force -- tfa1 tfad1 tfad2}
- set s [createfile tfa1 ]
+} -constraints {notRoot notFileSharing} -body {
+ set s [createfile tfa1]
file mkdir tfad1 tfad2
file copy tfa1 tfad1 tfad2
- set r1 [checkcontent [file join tfad2 tfa1] $s]
- set r2 [file isdir [file join tfad2 tfad1]]
- set r3 [checkcontent tfa1 $s]
- set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
+ list [checkcontent [file join tfad2 tfa1] $s] \
+ [file isdir [file join tfad2 tfad1]] \
+ [checkcontent tfa1 $s] [file isdir tfad1]
+} -cleanup {
file delete -force tfa1 tfad1 tfad2
- set result
-} {1}
-test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unix notRoot dontCopyLinks} {
+} -result {1 1 1 1}
+test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} -setup {
+ catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot dontCopyLinks} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file delete tfad1
- set result [list [catch {file copy tfalink tfalink2} msg] $msg]
- file delete -force tfalink tfalink2
- set result
-} {1 {error copying "tfalink": the target of this link doesn't exist}}
-test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
+ file copy tfalink tfalink2
+} -returnCodes error -cleanup {
+ file delete -force tfalink tfalink2
+} -result {error copying "tfalink": the target of this link doesn't exist}
+test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} -setup {
+ catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file delete tfad1
file copy tfalink tfalink2
- set result [string match [file type tfalink2] link]
- file delete tfalink tfalink2
- set result
-} {1}
-test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unix notRoot dontCopyLinks} {
+ file type tfalink2
+} -cleanup {
+ file delete tfalink tfalink2
+} -result link
+test fCmd-21.8.1 {TclCopyFilesCmd: copy a link} -setup {
+ catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot dontCopyLinks} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file copy tfalink tfalink2
- set r1 [file type tfalink]; # link
- set r2 [file type tfalink2]; # directory
- set r3 [file isdir tfad1]; # 1
- set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]
+ list [file type tfalink] [file type tfalink2] [file isdir tfad1]
+} -cleanup {
file delete -force tfad1 tfalink tfalink2
- set result
-} {1}
-test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unix notRoot} {
+} -result {link directory 1}
+test fCmd-21.8.2 {TclCopyFilesCmd: copy a link} -setup {
+ catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file copy tfalink tfalink2
- set r1 [file type tfalink]; # link
- set r2 [file type tfalink2]; # link
- set r3 [file isdir tfad1]; # 1
- set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]
+ list [file type tfalink] [file type tfalink2] [file isdir tfad1]
+} -cleanup {
file delete -force tfad1 tfalink tfalink2
- set result
-} {1}
-test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unix notRoot} {
+} -result {link link 1}
+test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} -setup {
+ catch {file delete -force tfad1 tfad2}
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfad1/tfalink "[pwd]/tfad1"
file copy tfad1 tfad2
- set result [string match [file type tfad2/tfalink] link]
+ file type tfad2/tfalink
+} -cleanup {
file delete -force tfad1 tfad2
- set result
-} {1}
-test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
- {notRoot} {
+} -result link
+test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa [file join tfad tfa]
- set r1 [catch {file copy tfa tfad}]
- set result [expr $r1 && [file isdir tfa]]
+ list [catch {file copy tfa tfad}] [file isdir tfa]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
+} -result {1 1}
+test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa [file join tfad tfa file]
- set r1 [catch {file copy tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+ list [catch {file copy tfa tfad}] [file isdir tfa] \
+ [file isdir [file join tfad tfa file]]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
-test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
- {notRoot} {
+} -result {1 1 1}
+test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} -setup {
catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
file mkdir tfa [file join tfad tfa file]
- set r1 [catch {file copy -force tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+ list [catch {file copy -force tfa tfad}] [file isdir tfa] \
+ [file isdir [file join tfad tfa file]]
+} -cleanup {
file delete -force tfa tfad
- set result
-} {1}
+} -result {1 1 1}
#
# Coverage testing for TclpRenameFile
#
-test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
+test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
set s2 [createfile tfa2 q]
-
- set r1 [catch {rename tfa1 tfa2}]
+ set result [catch {file rename tfa1 tfa2}]
file rename -force tfa1 tfa2
- set result [expr $r1 && [checkcontent tfa2 $s]]
+ lappend result [checkcontent tfa2 $s]
+} -cleanup {
file delete [glob tfa1 tfa2]
- set result
-} {1}
-test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {unix notRoot} {
+} -result {1 1}
+test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup {
catch {file delete -force -- tfa1}
- set s [createfile tfa1]
+} -constraints {unix notRoot} -body {
+ set s [createfile tfa1]
file rename -force tfa1 tfa1
- set result [checkcontent tfa1 $s]
- file delete tfa1
- set result
-} {1}
-test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
+ checkcontent tfa1 $s
+} -cleanup {
+ file delete tfa1
+} -result {1}
+test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
catch {file delete -force -- d1 tfad}
+} -constraints {notRoot} -body {
file mkdir d1 [file join tfad d1]
- set r1 [catch {file rename d1 tfad}]
- set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
+ list [catch {file rename d1 tfad}] [file isdir d1] \
+ [file isdir [file join tfad d1]]
+} -cleanup {
file delete -force d1 tfad
- set result
-} {1}
-test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
+} -result {1 1 1}
+test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} -setup {
catch {file delete -force -- d1 tfad}
+} -constraints {notRoot} -body {
file mkdir d1 [file join tfad a b c]
file rename d1 [file join tfad a b c d1]
- set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
+ list [file isdir d1] [file isdir [file join tfad a b c d1]]
+} -cleanup {
file delete -force [glob d1 tfad]
- set result
-} {1}
+} -result {0 1}
#
# TclMacCopyFile needs to be redone.
#
-test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
+test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
set s [createfile tfa1]
set s2 [createfile tfa2 q]
-
- set r1 [catch {file copy tfa1 tfa2}]
+ set result [catch {file copy tfa1 tfa2}]
file copy -force tfa1 tfa2
- set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+ lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
file delete tfa1 tfa2
- set result
-} {1}
+} -result {1 1 1}
#
# TclMacMkdir - basic cases are covered elsewhere.
@@ -1973,241 +2167,252 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
# TclMacRmdir
# Error cases are not covered.
#
-
-test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
+test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
catch {file delete -force -- tfad}
-
+} -constraints {notRoot} -body {
file mkdir [file join tfad dir]
-
- set result [catch {file delete tfad}]
- file delete -force tfad
- set result
-} {1}
+ list [catch {file delete tfad}] [file delete -force tfad]
+} -cleanup {
+ catch {file delete -force tfad}
+} -result {1 {}}
#
-# TclMacDeleteFile
+# TclMacDeleteFile
# Error cases are not covered.
#
-test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
+test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} -setup {
catch {file delete -force -- tfa1}
-
+} -constraints {notRoot} -body {
createfile tfa1
file delete tfa1
file exists tfa1
-} {0}
+} -cleanup {
+ catch {file delete -force tfa1}
+} -result {0}
#
# TclMacCopyDirectory
# Error cases are not covered.
#
-test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {
+test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
file mkdir [file join tfad1 a b c]
file copy tfad1 tfad2
- set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
+ list [file isdir [file join tfad1 a b c]] \
+ [file isdir [file join tfad2 a b c]]
+} -cleanup {
file delete -force tfad1 tfad2
- set result
-} {1}
-test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
+} -result {1 1}
+test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
file mkdir tfad1
file copy tfad1 tfad2
- set result [expr [file isdir tfad1] && [file isdir tfad2]]
+ list [file isdir tfad1] [file isdir tfad2]
+} -cleanup {
file delete tfad1 tfad2
- set result
-} {1}
-test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
+} -result {1 1}
+test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
file mkdir [file join tfad1 x y z]
file mkdir [file join tfad2 dir]
file copy tfad1 [file join tfad2 dir]
- set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
+ list [file isdir [file join tfad1 x y z]] \
+ [file isdir [file join tfad2 dir tfad1 x y z]]
+} -cleanup {
file delete -force tfad1 tfad2
- set result
-} {1}
+} -result {1 1}
#
# Functionality tests for TclDeleteFilesCmd
#
-
-test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unix notRoot} {
+test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfalink tfad1
file delete tfalink
-
- set r1 [file isdir tfad1]
- set r2 [file exists tfalink]
-
- set result [expr $r1 && !$r2]
+ list [file isdir tfad1] [file exists tfalink]
+} -cleanup {
file delete tfad1
- set result
-} {1}
-test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unix notRoot} {
+ catch {file delete tfalink}
+} -result {1 0}
+test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file mkdir tfad2
file link -symbolic [file join tfad2 link] [file join .. tfad1]
file delete -force tfad2
-
- set r1 [file isdir tfad1]
- set r2 [file exists tfad2]
-
- set result [expr $r1 && !$r2]
+ list [file isdir tfad1] [file exists tfad2]
+} -cleanup {
file delete tfad1
- set result
-} {1}
-test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unix notRoot} {
+} -result {1 0}
+test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup {
catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
file mkdir tfad1
file link -symbolic tfad2 tfad1
file delete tfad1
file delete tfad2
+ list [file exists tfad1] [file exists tfad2]
+} -result {0 0}
- set r1 [file exists tfad1]
- set r2 [file exists tfad2]
-
- set result [expr !$r1 && !$r2]
- set result
-} {1}
-
-test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
+# There is no fCmd-27.1
+test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup {
set platform [testgetplatform]
+} -constraints {testsetplatform} -body {
testsetplatform unix
- list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
-} {1 {user "_totally_bogus_user" doesn't exist} {}}
-test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
+ file attributes ~_totally_bogus_user
+} -returnCodes error -cleanup {
+ testsetplatform $platform
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup {
catch {file delete -force -- foo.tmp}
+} -body {
createfile foo.tmp
- list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
-} {0 1 {}}
-test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
+ file attributes foo.tmp
+ # Must be non-empty result
+} -cleanup {
+ file delete -force -- foo.tmp
+} -match glob -result {?*}
+test fCmd-27.4 {TclFileAttrsCmd - getting one option} -setup {
catch {file delete -force -- foo.tmp}
+} -body {
createfile foo.tmp
set attrs [file attributes foo.tmp]
- list [catch {file attributes foo.tmp {expand}[lindex $attrs 0]}] [file delete -force -- foo.tmp]
-} {0 {}}
-# Find a group that exists on this Unix system, or else skip tests that
-# require Unix groups.
-if {$tcl_platform(platform) == "unix"} {
- ::tcltest::testConstraint foundGroup 0
- catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- ::tcltest::testConstraint foundGroup 1
- }
-} else {
- ::tcltest::testConstraint foundGroup 1
-}
-test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
+ file attributes foo.tmp {*}[lindex $attrs 0]
+ # Any successful result will do
+} -cleanup {
+ file delete -force -- foo.tmp
+} -match glob -result *
+test fCmd-27.5 {TclFileAttrsCmd - setting one option} -setup {
catch {file delete -force -- foo.tmp}
+} -constraints {foundGroup} -body {
createfile foo.tmp
set attrs [file attributes foo.tmp]
- list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
+ file attributes foo.tmp {*}[lrange $attrs 0 1]
+} -cleanup {
+ file delete -force -- foo.tmp
+} -result {}
+test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
catch {file delete -force -- foo.tmp}
+} -constraints {foundGroup} -body {
createfile foo.tmp
set attrs [file attributes foo.tmp]
- list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-
-if {[string equal $tcl_platform(platform) "windows"]} {
- if {[string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
- tcltest::testConstraint linkDirectory 1
- tcltest::testConstraint linkFile 1
- } else {
- tcltest::testConstraint linkDirectory 0
- tcltest::testConstraint linkFile 0
- }
-} else {
- tcltest::testConstraint linkFile 1
- tcltest::testConstraint linkDirectory 1
+ file attributes foo.tmp {*}[lrange $attrs 0 3]
+} -cleanup {
+ file delete -force -- foo.tmp
+} -result {}
+
+if {
+ [testConstraint win] &&
+ ([string index $tcl_platform(osVersion) 0] < 5
+ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
+} then {
+ testConstraint linkDirectory 0
+ testConstraint linkFile 0
}
-test fCmd-28.1 {file link} {
- list [catch {file link} msg] $msg
-} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
-test fCmd-28.2 {file link} {
- list [catch {file link a b c d} msg] $msg
-} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
-test fCmd-28.3 {file link} {
- list [catch {file link abc b c} msg] $msg
-} {1 {bad switch "abc": must be -symbolic or -hard}}
-test fCmd-28.4 {file link} {
- list [catch {file link -abc b c} msg] $msg
-} {1 {bad switch "-abc": must be -symbolic or -hard}}
+test fCmd-28.1 {file link} -returnCodes error -body {
+ file link
+} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
+test fCmd-28.2 {file link} -returnCodes error -body {
+ file link a b c d
+} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
+test fCmd-28.3 {file link} -returnCodes error -body {
+ file link abc b c
+} -result {bad switch "abc": must be -symbolic or -hard}
+test fCmd-28.4 {file link} -returnCodes error -body {
+ file link -abc b c
+} -result {bad switch "-abc": must be -symbolic or -hard}
cd [workingDirectory]
makeDirectory abc.dir
makeDirectory abc2.dir
makeFile contents abc.file
makeFile contents abc2.file
cd [temporaryDirectory]
-test fCmd-28.5 {file link: source already exists} {linkDirectory} {
+test fCmd-28.5 {file link: source already exists} -setup {
+ cd [temporaryDirectory]
+} -constraints {linkDirectory} -body {
+ file link abc.dir abc2.dir
+} -returnCodes error -cleanup {
+ cd [workingDirectory]
+} -result {could not create new link "abc.dir": that path already exists}
+test fCmd-28.6 {file link: unsupported operation} -setup {
cd [temporaryDirectory]
- set res [list [catch {file link abc.dir abc2.dir} msg] $msg]
+} -constraints {linkDirectory win} -body {
+ file link -hard abc.link abc.dir
+} -returnCodes error -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.dir": that path already exists}}
-test fCmd-28.6 {file link: unsupported operation} {linkDirectory win} {
+} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}
+test fCmd-28.7 {file link: source already exists} -setup {
cd [temporaryDirectory]
- set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]
+} -constraints {linkFile} -body {
+ file link abc.file abc2.file
+} -returnCodes error -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}}
-test fCmd-28.7 {file link: source already exists} {linkFile} {
+} -result {could not create new link "abc.file": that path already exists}
+test fCmd-28.8 {file link} -constraints {linkFile win} -setup {
cd [temporaryDirectory]
- set res [list [catch {file link abc.file abc2.file} msg] $msg]
+} -body {
+ file link -symbolic abc.link abc.file
+} -returnCodes error -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.file": that path already exists}}
-test fCmd-28.8 {file link} {linkFile win} {
+} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
+test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup {
cd [temporaryDirectory]
- set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]
+ file delete -force abc.link
+} -body {
+ file link abc.link abc.file
+} -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}}
-test fCmd-28.9 {file link: success with file} {linkFile} {
+} -result abc.file
+test fCmd-28.9.1 {file link: success with file} -setup {
cd [temporaryDirectory]
file delete -force abc.link
- set res [list [catch {file link abc.link abc.file} msg] $msg]
+} -constraints {linkFile win} -body {
+ file stat abc.file arr
+ set res $arr(nlink)
+ lappend res [catch {file link abc.link abc.file} msg] $msg
+ file stat abc.file arr
+ lappend res $arr(nlink)
+} -cleanup {
cd [workingDirectory]
- set res
-} {0 abc.file}
+} -result {1 0 abc.file 2}
cd [temporaryDirectory]
catch {file delete -force abc.link}
cd [workingDirectory]
-test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
+test fCmd-28.10 {file link: linking to nonexistent path} -setup {
cd [temporaryDirectory]
file delete -force abc.link
- set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
+} -constraints {linkDirectory} -body {
+ file link abc.link abc2.doesnt
+} -returnCodes error -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}}
-test fCmd-28.10.1 {file link: linking to nonexistent path} {linkDirectory} {
+} -result {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}
+test fCmd-28.10.1 {file link: linking to nonexistent path} -setup {
cd [temporaryDirectory]
file delete -force abc.link
- set res [list [catch {file link doesnt/abc.link abc.dir} msg] $msg]
+} -constraints {linkDirectory} -body {
+ file link doesnt/abc.link abc.dir
+} -returnCodes error -cleanup {
cd [workingDirectory]
- set res
-} {1 {could not create new link "doesnt/abc.link": no such file or directory}}
-test fCmd-28.11 {file link: success with directory} {linkDirectory} {
+} -result {could not create new link "doesnt/abc.link": no such file or directory}
+test fCmd-28.11 {file link: success with directory} -setup {
cd [temporaryDirectory]
file delete -force abc.link
- set res [list [catch {file link abc.link abc.dir} msg] $msg]
+} -constraints {linkDirectory} -body {
+ file link abc.link abc.dir
+} -cleanup {
cd [workingDirectory]
- set res
-} {0 abc.dir}
-test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
+} -result abc.dir
+test fCmd-28.12 {file link: cd into a link} -setup {
cd [temporaryDirectory]
file delete -force abc.link
+} -constraints {linkDirectory} -body {
file link abc.link abc.dir
set orig [pwd]
cd abc.link
@@ -2215,55 +2420,66 @@ test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
cd ..
set up [pwd]
cd $orig
- # 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)
- if {([file normalize $up] != [file normalize $orig]) \
- && ([file normalize $up] != [file normalize [file dirname abc.dir]])} {
- set res "wrong directory with 'cd abc.link ; cd ..': \
- \"[file normalize $up]\" should be \"[file normalize $orig]\" or\
- \"[file normalize [file dirname abc.dir]]\""
+ # 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)
+ if {
+ ([file normalize $up] ne [file normalize $orig]) &&
+ ([file normalize $up] ne [file normalize [file dirname abc.dir]])
+ } then {
+ return "wrong directory with 'cd abc.link ; cd ..': \
+ \"[file normalize $up]\" should be \"[file normalize $orig]\"\
+ or \"[file normalize [file dirname abc.dir]]\""
} else {
- set res "ok"
+ return "ok"
}
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} {ok}
-test fCmd-28.13 {file link} {linkDirectory} {
- # duplicate link throws error
+} -result ok
+test fCmd-28.13 {file link} -constraints {linkDirectory} -setup {
cd [temporaryDirectory]
- set res [list [catch {file link abc.link abc.dir} msg] $msg]
+ file link abc.link abc.dir
+} -body {
+ # duplicate link throws error
+ file link abc.link abc.dir
+} -returnCodes error -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} {1 {could not create new link "abc.link": that path already exists}}
-test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} {
+} -result {could not create new link "abc.link": that path already exists}
+test fCmd-28.14 {file link: deletes link not dir} -setup {
cd [temporaryDirectory]
+} -constraints {linkDirectory} -body {
file delete -force abc.link
- set res [list [file exists abc.link] [file exists abc.dir]]
+ list [file exists abc.link] [file exists abc.dir]
+} -cleanup {
cd [workingDirectory]
- set res
-} {0 1}
-test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {
+} -result {0 1}
+test fCmd-28.15.1 {file link: copies link not dir} -setup {
cd [temporaryDirectory]
file delete -force abc.link
+} -constraints {linkDirectory dontCopyLinks} -body {
file link abc.link abc.dir
file copy abc.link abc2.link
- # abc2.linkdir was a copy of a link to a dir, so it should end up as
- # a directory, not a link (links trace to endpoint).
- set res [list [file type abc2.link] [file tail [file link abc.link]]]
+ # abc2.linkdir was a copy of a link to a dir, so it should end up as a
+ # directory, not a link (links trace to endpoint).
+ list [file type abc2.link] [file tail [file link abc.link]]
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} {directory abc.dir}
-test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
+} -result {directory abc.dir}
+test fCmd-28.15.2 {file link: copies link not dir} -setup {
cd [temporaryDirectory]
file delete -force abc.link
+} -constraints {linkDirectory} -body {
file link abc.link abc.dir
file copy abc.link abc2.link
- set res [list [file type abc2.link] [file tail [file link abc2.link]]]
+ list [file type abc2.link] [file tail [file link abc2.link]]
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} {link abc.dir}
+} -result {link abc.dir}
cd [temporaryDirectory]
file delete -force abc.link
file delete -force abc2.link
@@ -2274,65 +2490,119 @@ cd ..
file copy abc.file abc.dir
file copy abc2.file abc.dir
cd [workingDirectory]
-test fCmd-28.16 {file link: glob inside link} {linkDirectory} {
+test fCmd-28.16 {file link: glob inside link} -setup {
cd [temporaryDirectory]
file delete -force abc.link
+} -constraints {linkDirectory} -body {
file link abc.link abc.dir
- set res [glob -dir abc.link -tails *]
+ lsort [glob -dir abc.link -tails *]
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- lsort $res
-} {abc.file abc2.file}
-test fCmd-28.17 {file link: glob -type l} {linkDirectory} {
+} -result {abc.file abc2.file}
+test fCmd-28.17 {file link: glob -type l} -setup {
cd [temporaryDirectory]
- set res [glob -dir [pwd] -type l -tails abc*]
+ file link abc.link abc.dir
+} -constraints {linkDirectory} -body {
+ glob -dir [pwd] -type l -tails abc*
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} {abc.link}
-test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
+} -result {abc.link}
+test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup {
cd [temporaryDirectory]
- set res [lsort [glob -dir [pwd] -type d -tails abc*]]
+ file link abc.link abc.dir
+} -body {
+ lsort [glob -dir [pwd] -type d -tails abc*]
+} -cleanup {
+ file delete -force abc.link
cd [workingDirectory]
- set res
-} [lsort [list abc.link abc.dir abc2.dir]]
-test fCmd-28.19 {file link: relative paths} {win linkDirectory} {
+} -result [lsort [list abc.link abc.dir abc2.dir]]
+test fCmd-28.19 {file link: relative paths} -setup {
cd [temporaryDirectory]
+} -constraints {win linkDirectory} -body {
file mkdir d1/d2/d3
- set res [list [catch {file link d1/l2 d1/d2} err] $err]
- lappend res [catch {file delete -force d1} err] $err
-} {0 d1/d2 0 {}}
-test fCmd-28.20 {file link: relative paths} {unix linkDirectory} {
+ file link d1/l2 d1/d2
+} -cleanup {
+ catch {file delete -force d1}
+ cd [workingDirectory]
+} -result d1/d2
+test fCmd-28.20 {file link: relative paths} -setup {
cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
file mkdir d1/d2/d3
- list [catch {file link d1/l2 d1/d2} res] $res
-} {1 {could not create new link "d1/l2": target "d1/d2" doesn't exist}}
-test fCmd-28.21 {file link: relative paths} {unix linkDirectory} {
+ file link d1/l2 d1/d2
+} -returnCodes error -cleanup {
+ catch {file delete -force d1}
+ cd [workingDirectory]
+} -result {could not create new link "d1/l2": target "d1/d2" doesn't exist}
+test fCmd-28.21 {file link: relative paths} -setup {
cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
file mkdir d1/d2/d3
- list [catch {file link d1/l2 d2} res] $res
-} {0 d2}
-test fCmd-28.22 {file link: relative paths} {unix linkDirectory} {
+ file link d1/l2 d2
+} -cleanup {
+ catch {file delete -force d1}
+ cd [workingDirectory]
+} -result d2
+test fCmd-28.22 {file link: relative paths} -setup {
cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
file mkdir d1/d2/d3
catch {file delete -force d1/l2}
- list [catch {file link d1/l2 d2/d3} res] $res
-} {0 d2/d3}
-
-test fCmd-29.1 {weird memory corruption fault} {
- catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
-} 1
-
-cd [temporaryDirectory]
-file delete -force abc.link
-file delete -force d1/d2
-file delete -force d1
-cd [workingDirectory]
-
+ file link d1/l2 d2/d3
+} -cleanup {
+ catch {file delete -force d1}
+ cd [workingDirectory]
+} -result d2/d3
+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 {win reg} -body {
+ file writable $mydocsname
+} -result 1
+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 {win} -body {
+ set r {}
+ if {[info exists env(SystemDrive)]} {
+ set path $env(SystemDrive)/pagefile.sys
+ lappend r exists [file exists $path]
+ lappend r readable [file readable $path]
+ lappend r stat [catch {file stat $path a} e] $e
+ }
+ 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 979dd63..51f00d1 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1,38 +1,55 @@
# This file tests the filename manipulation routines.
#
-# 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) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 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: fileName.test,v 1.48 2005/07/28 18:42:32 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::*
}
-testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
+::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
+testConstraint symbolicLinkFile 1
+if {[testConstraint win]} {
+ if {[string index $tcl_platform(osVersion) 0] < 5 \
+ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
+ testConstraint linkDirectory 0
+ }
+ testConstraint symbolicLinkFile 0
+ testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
+}
+# This match compares the first two words of the result. If the wanted result
+# is "equal", then this is successful if the words are equal. If the wanted
+# result is "not equal", then this is successful if the words are different.
+customMatch compareWords {apply {{a b} {
+ lassign $b w1 w2
+ expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2}
+}}}
+proc touch filename {catch {close [open $filename w]}}
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 latter commands
-# operate on the real filesystem but will potentially have their
-# logic routed through the wrong generic code paths if we've
-# used 'testsetplatform'. This can lead to serious problems,
-# even crashes.
+
+# 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
+# latter commands operate on the real filesystem but will potentially have
+# their logic routed through the wrong generic code paths if we've used
+# 'testsetplatform'. This can lead to serious problems, even crashes.
test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype /
@@ -182,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
@@ -203,36 +220,33 @@ test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo/bar~/baz
} {foo bar~ baz}
-
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-
-test filename-4.19 {Tcl_SplitPath} {
+test filename-4.19 {Tcl_SplitPath} -setup {
set oldDir [pwd]
- set res [catch {
- cd [temporaryDirectory]
- file mkdir tildetmp
- set nastydir [file join tildetmp ./~tilde]
- file mkdir $nastydir
- set norm [file normalize $nastydir]
- cd tildetmp
- cd ./~tilde
- glob -nocomplain *
- set idx [string first tildetmp $norm]
- set norm [string range $norm $idx end]
- # fix path away so all platforms are the same
- regsub {(.*):$} $norm {\1} norm
- regsub -all ":" $norm "/" norm
- # make sure we can delete the directory we created
- cd $oldDir
- file delete -force $nastydir
- set norm
- } err]
+ cd [temporaryDirectory]
+} -body {
+ file mkdir tildetmp
+ set nastydir [file join tildetmp ./~tilde]
+ file mkdir $nastydir
+ set norm [file normalize $nastydir]
+ cd tildetmp
+ cd ./~tilde
+ glob -nocomplain *
+ set idx [string first tildetmp $norm]
+ set norm [string range $norm $idx end]
+ # fix path away so all platforms are the same
+ regsub {(.*):$} $norm {\1} norm
+ regsub -all ":" $norm "/" norm
+ # make sure we can delete the directory we created
+ cd $oldDir
+ file delete -force $nastydir
+ return $norm
+} -cleanup {
cd $oldDir
catch {file delete -force [file join [temporaryDirectory] tildetmp]}
- list $res $err
-} {0 tildetmp/~tilde}
+} -result {tildetmp/~tilde}
test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
@@ -422,12 +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
@@ -505,25 +518,25 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {C:\foo\bar}] \
- [file join C:/blah {C:\foo\bar}] \
- [file join C:/blah C:/blah {C:\foo\bar}]
+ [file join {C:\foo\bar}] \
+ [file join C:/blah {C:\foo\bar}] \
+ [file join C:/blah C:/blah {C:\foo\bar}]
} {C:/foo/bar C:/foo/bar C:/foo/bar}
test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join C:/blah {foo\bar}] \
- [file join C:/blah C:/blah {foo\bar}]
+ [file join {foo\bar}] \
+ [file join C:/blah {foo\bar}] \
+ [file join C:/blah C:/blah {foo\bar}]
} {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join [pwd] {foo\bar}] \
- [file join [pwd] [pwd] {foo\bar}]
+ [file join {foo\bar}] \
+ [file join [pwd] {foo\bar}] \
+ [file join [pwd] [pwd] {foo\bar}]
set nres {}
foreach elt $res {
lappend nres [string map [list [pwd] pwd] $elt]
@@ -534,614 +547,563 @@ test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
set res {}
lappend res \
- [file join {/foo/bar}] \
- [file join /x {/foo/bar}] \
- [file join /x /x {/foo/bar}]
+ [file join {/foo/bar}] \
+ [file join /x {/foo/bar}] \
+ [file join /x /x {/foo/bar}]
} {/foo/bar /foo/bar /foo/bar}
test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join C:/blah {foo\bar}] \
- [file join C:/blah C:/blah {foo\bar}]
+ [file join {foo\bar}] \
+ [file join C:/blah {foo\bar}] \
+ [file join C:/blah C:/blah {foo\bar}]
string map [list C:/blah ""] $res
} {foo/bar /foo/bar /foo/bar}
test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
set res {}
lappend res \
- [file join {foo/bar}] \
- [file join /x {foo/bar}] \
- [file join /x /x {foo/bar}]
+ [file join {foo/bar}] \
+ [file join /x {foo/bar}] \
+ [file join /x /x {foo/bar}]
string map [list /x ""] $res
} {foo/bar /foo/bar /foo/bar}
-test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
+test filename-10.1 {Tcl_TranslateFileName} -body {
testsetplatform unix
- list [catch {testtranslatefilename foo} msg] $msg
-} {0 foo}
-test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
+ testtranslatefilename foo
+} -result {foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.2 {Tcl_TranslateFileName} -body {
testsetplatform windows
- list [catch {testtranslatefilename {c:/foo}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
+ testtranslatefilename {c:/foo}
+} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.3 {Tcl_TranslateFileName} -body {
testsetplatform windows
- list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} {
+ testtranslatefilename {c:/\\foo/}
+} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.3.1 {Tcl_TranslateFileName} -body {
testsetplatform windows
- list [catch {testtranslatefilename {c://///}} msg] $msg
-} {0 c:\\}
-test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
+ testtranslatefilename {c://///}
+} -result c:\\ -constraints {testsetplatform testtranslatefilename}
+test filename-10.6 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "/home/test"
testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 /home/test/foo}
-test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test/foo}
+test filename-10.7 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
unset env(HOME)
testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -returnCodes error -cleanup {
set env(HOME) $temp
- set result
-} {1 {couldn't find HOME environment variable to expand path}}
-test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {couldn't find HOME environment variable to expand path}
+test filename-10.8 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "/home/test"
testsetplatform unix
- set result [list [catch {testtranslatefilename ~} msg] $msg]
+ testtranslatefilename ~
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 /home/test}
-test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test}
+test filename-10.9 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "/home/test/"
testsetplatform unix
- set result [list [catch {testtranslatefilename ~} msg] $msg]
+ testtranslatefilename ~
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 /home/test}
-test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test}
+test filename-10.10 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "/home/test/"
testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 /home/test/foo}
-test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test/foo}
+test filename-10.17 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "\\home\\"
testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 {\home\foo}}
-test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {\home\foo}
+test filename-10.18 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "\\home\\"
testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
+ testtranslatefilename ~/foo\\bar
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 {\home\foo\bar}}
-test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {\home\foo\bar}
+test filename-10.19 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "c:"
testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 c:foo}
-test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} {
- list [catch {testtranslatefilename ~blorp/foo} msg] $msg
-} {1 {user "blorp" doesn't exist}}
-test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {c:foo}
+test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body {
+ testtranslatefilename ~blorp/foo
+} -constraints {testtranslatefilename testtranslatefilename} \
+ -result {user "blorp" doesn't exist}
+test filename-10.21 {Tcl_TranslateFileName} -setup {
global env
set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
set env(HOME) "c:\\"
testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+ testtranslatefilename ~/foo
+} -cleanup {
set env(HOME) $temp
- set result
-} {0 {c:\foo}}
-test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {c:\foo}
+test filename-10.22 {Tcl_TranslateFileName} -body {
testsetplatform windows
- list [catch {testtranslatefilename foo//bar} msg] $msg
-} {0 {foo\bar}}
-
+ testtranslatefilename foo//bar
+} -constraints {testsetplatform testtranslatefilename} -result {foo\bar}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-
-test filename-10.23 {Tcl_TranslateFileName} {nonPortable} {
+test filename-10.23 {Tcl_TranslateFileName} -body {
# this test fails if ~ouster is not /home/ouster
- list [catch {testtranslatefilename ~ouster} msg] $msg
-} {0 /home/ouster}
-test filename-10.24 {Tcl_TranslateFileName} {nonPortable} {
+ testtranslatefilename ~ouster
+} -constraints {nonPortable testtranslatefilename} -result {/home/ouster}
+test filename-10.24 {Tcl_TranslateFileName} -body {
# this test fails if ~ouster is not /home/ouster
- list [catch {testtranslatefilename ~ouster/foo} msg] $msg
-} {0 /home/ouster/foo}
+ testtranslatefilename ~ouster/foo
+} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
-
-test filename-11.1 {Tcl_GlobCmd} {
- list [catch {glob} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.2 {Tcl_GlobCmd} {
- list [catch {glob -gorp} msg] $msg
-} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-test filename-11.3 {Tcl_GlobCmd} {
- list [catch {glob -nocomplai} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.4 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.5 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain ~xyqrszzz} msg] $msg
-} {0 {}}
-test filename-11.6 {Tcl_GlobCmd} {
- list [catch {glob ~xyqrszzz} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.7 {Tcl_GlobCmd} {
- list [catch {glob -- -nocomplain} msg] $msg
-} {1 {no files matched glob pattern "-nocomplain"}}
-test filename-11.8 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain -- -nocomplain} msg] $msg
-} {0 {}}
-test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
+test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
+ glob
+} -result {no files matched glob patterns ""}
+test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -gorp
+} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
+test filename-11.3 {Tcl_GlobCmd} -body {
+ glob -nocomplai
+} -result {}
+test filename-11.4 {Tcl_GlobCmd} -body {
+ glob -nocomplain
+} -result {}
+test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -nocomplain * ~xyqrszzz
+} -result {user "xyqrszzz" doesn't exist}
+test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
+ glob ~xyqrszzz
+} -result {user "xyqrszzz" doesn't exist}
+test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -- -nocomplain
+} -result {no files matched glob pattern "-nocomplain"}
+test filename-11.8 {Tcl_GlobCmd} -body {
+ glob -nocomplain -- -nocomplain
+} -result {}
+test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
- list [catch {glob ~\\xyqrszzz/bar} msg] $msg
-} {1 {user "\xyqrszzz" doesn't exist}}
-test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
+ glob ~\\xyqrszzz/bar
+} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
+test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
- list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
-} {0 {}}
-test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
+ glob -nocomplain ~\\xyqrszzz/bar
+} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
+test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
- list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
+ glob ~xyqrszzz\\/\\bar
+} -returnCodes error -result {user "xyqrszzz" doesn't exist}
+test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup {
testsetplatform unix
set home $env(HOME)
+} -body {
unset env(HOME)
- set x [list [catch {glob ~/*} msg] $msg]
+ glob ~/*
+} -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}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-
test filename-11.13 {Tcl_GlobCmd} {
- list [catch {file join [lindex [glob ~] 0]} msg] $msg
-} [list 0 [file join $env(HOME)]]
-
+ file join [lindex [glob ~] 0]
+} [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
file mkdir globTest/a1/b2
file mkdir globTest/a2/b3
file mkdir globTest/a3
-close [open globTest/x1.c w]
-close [open globTest/y1.c w]
-close [open globTest/z1.c w]
-close [open "globTest/weird name.c" w]
-close [open globTest/a1/b1/x2.c w]
-close [open globTest/a1/b2/y2.c w]
-
-catch {close [open globTest/.1 w]}
-catch {close [open globTest/x,z1.c w]}
-
+touch globTest/x1.c
+touch globTest/y1.c
+touch globTest/z1.c
+touch "globTest/weird name.c"
+touch globTest/a1/b1/x2.c
+touch globTest/a1/b2/y2.c
+touch globTest/.1
+touch globTest/x,z1.c
test filename-11.14 {Tcl_GlobCmd} {
- list [catch {glob ~/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
+ glob ~/globTest
+} [list [file join $env(HOME) globTest]]
test filename-11.15 {Tcl_GlobCmd} {
- list [catch {glob ~\\/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
+ glob ~\\/globTest
+} [list [file join $env(HOME) globTest]]
test filename-11.16 {Tcl_GlobCmd} {
- list [catch {glob globTest} msg] $msg
-} {0 globTest}
-
+ glob globTest
+} {globTest}
set globname "globTest"
set horribleglobname "glob\[\{Test"
-
test filename-11.17 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -directory $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -directory $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-if {[string equal $tcl_platform(platform) "windows"]} {
- if {[string index $tcl_platform(osVersion) 0] >= 5 \
- && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
- testConstraint linkDirectory 1
- } else {
- testConstraint linkDirectory 0
- }
-} else {
- testConstraint linkDirectory 1
-}
-if {[string equal $tcl_platform(platform) "windows"]} {
- testConstraint symbolicLinkFile 0
-} else {
- testConstraint symbolicLinkFile 1
-}
-test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
+ [file join $globname y1.c] [file join $globname z1.c]]]
+test filename-11.17.2 {Tcl_GlobCmd} -setup {
set dir [pwd]
- set ret "error in test"
- if {[catch {
- cd $globname
- file link -symbolic link a1
- cd $dir
- set ret [list [catch {
- lsort [glob -directory $globname -join * b1]
- } msg] $msg]
- }]} {
- cd $dir
- }
+} -constraints {notRoot linkDirectory} -body {
+ cd $globname
+ file link -symbolic link a1
+ cd $dir
+ lsort [glob -directory $globname -join * b1]
+} -cleanup {
+ cd $dir
file delete [file join $globname link]
- set ret
-} [list 0 [lsort [list [file join $globname a1 b1] \
- [file join $globname link b1]]]]
+} -result [list [file join $globname a1 b1] \
+ [file join $globname link b1]]
# Simpler version of the above test to illustrate a given bug.
-test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} {
+test filename-11.17.3 {Tcl_GlobCmd} -setup {
set dir [pwd]
- set ret "error in test"
- if {[catch {
- cd $globname
- file link -symbolic link a1
- cd $dir
- set ret [list [catch {
- lsort [glob -directory $globname -type d *]
- } msg] $msg]
- }]} {
- cd $dir
- }
+} -constraints {notRoot linkDirectory} -body {
+ cd $globname
+ file link -symbolic link a1
+ cd $dir
+ lsort [glob -directory $globname -type d *]
+} -cleanup {
+ cd $dir
file delete [file join $globname link]
- set ret
-} [list 0 [lsort [list [file join $globname a1] \
- [file join $globname a2] \
- [file join $globname a3] \
- [file join $globname link]]]]
-# Make sure the bugfix isn't too simple. We don't want
-# to break 'glob -type l'.
-test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} {
+} -result [list [file join $globname a1] \
+ [file join $globname a2] \
+ [file join $globname a3] \
+ [file join $globname link]]
+# Make sure the bugfix isn't too simple. We don't want to break 'glob -type l'
+test filename-11.17.4 {Tcl_GlobCmd} -setup {
set dir [pwd]
- set ret "error in test"
- if {[catch {
- cd $globname
- file link -symbolic link a1
- cd $dir
- set ret [list [catch {
- lsort [glob -directory $globname -type l *]
- } msg] $msg]
- }]} {
- cd $dir
- }
+} -constraints {notRoot linkDirectory} -body {
+ cd $globname
+ file link -symbolic link a1
+ cd $dir
+ lsort [glob -directory $globname -type l *]
+} -cleanup {
+ cd $dir
file delete [file join $globname link]
- set ret
-} [list 0 [list [file join $globname link]]]
+} -result [list [file join $globname link]]
test filename-11.17.5 {Tcl_GlobCmd} {
- list [catch {lsort [glob -directory $globname -tails *.c]} msg] $msg
-} [list 0 [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
+ lsort [glob -directory $globname -tails *.c]
+} [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]
test filename-11.17.6 {Tcl_GlobCmd} {
- list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg
-} [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
- [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]]
-test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} {
+ lsort [glob -directory $globname -tails *.c *.c]
+} [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
+ [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
+test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup {
set dir [pwd]
- set ret "error in test"
- if {[catch {
- cd $globname
- file mkdir nonexistent
- file link -symbolic link nonexistent
- file delete nonexistent
- cd $dir
- set ret [list [catch {
- lsort [glob -nocomplain -directory $globname -type l *]
- } msg] $msg]
- }]} {
- cd $dir
- }
+} -constraints {linkDirectory} -body {
+ cd $globname
+ file mkdir nonexistent
+ file link -symbolic link nonexistent
+ file delete nonexistent
+ cd $dir
+ lsort [glob -nocomplain -directory $globname -type l *]
+} -cleanup {
+ cd $dir
file delete [file join $globname link]
- set ret
-} [list 0 [list [file join $globname link]]]
-test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} {
+} -result [list [file join $globname link]]
+test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} -setup {
set dir [pwd]
- set ret "error in test"
- if {[catch {
- cd $globname
- close [open "nonexistent" w]
- file link -symbolic link nonexistent
- file delete nonexistent
- cd $dir
- set ret [list [catch {
- lsort [glob -nocomplain -directory $globname -type l *]
- } msg] $msg]
- }]} {
- cd $dir
- }
+} -constraints {symbolicLinkFile} -body {
+ cd $globname
+ touch "nonexistent"
+ file link -symbolic link nonexistent
+ file delete nonexistent
+ cd $dir
+ lsort [glob -nocomplain -directory $globname -type l *]
+} -cleanup {
+ cd $dir
file delete [file join $globname link]
- set ret
-} [list 0 [list [file join $globname link]]]
+} -result [list [file join $globname link]]
test filename-11.18 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.18.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.20 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
+ lsort [glob -type d -dir $globname *]
+} [lsort [list [file join $globname a1]\
[file join $globname a2]\
- [file join $globname a3]]]]
+ [file join $globname a3]]]
test filename-11.21 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -path $globname *]} msg] $msg
-} [list 0 [lsort [list $globname]]]
-
-test filename-11.21.1 {Tcl_GlobCmd} {
- close [open {[tcl].testremains} w]
- set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg]
+ lsort [glob -type d -path $globname *]
+} [list $globname]
+test filename-11.21.1 {Tcl_GlobCmd} -body {
+ touch {[tcl].testremains}
+ lsort [glob -path {[tcl]} *]
+} -cleanup {
file delete -force {[tcl].testremains}
- set res
-} [list 0 {{[tcl].testremains}}]
-
-# Get rid of file/dir if it exists, since it will have
-# been left behind by a previous failed run.
+} -result {{[tcl].testremains}}
+# Get rid of file/dir if it exists, since it will have been left behind by a
+# previous failed run.
if {[file exists $horribleglobname]} {
file delete -force $horribleglobname
}
file rename globTest $horribleglobname
set globname $horribleglobname
-
test filename-11.22 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -dir $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.22.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -dir $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24 {Tcl_GlobCmd} {unix} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24.1 {Tcl_GlobCmd} {win} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
+ lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname .1]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.25 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
+ lsort [glob -type d -dir $globname *]
+} [lsort [list [file join $globname a1]\
[file join $globname a2]\
- [file join $globname a3]]]]
+ [file join $globname a3]]]
test filename-11.25.1 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type {d r} -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
- [file join $globname a2]\
- [file join $globname a3]]]]
+ lsort [glob -type {d r} -dir $globname *]
+} [lsort [list [file join $globname a1]\
+ [file join $globname a2]\
+ [file join $globname a3]]]
test filename-11.25.2 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type {d r w} -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
- [file join $globname a2]\
- [file join $globname a3]]]]
+ lsort [glob -type {d r w} -dir $globname *]
+} [lsort [list [file join $globname a1]\
+ [file join $globname a2]\
+ [file join $globname a3]]]
test filename-11.26 {Tcl_GlobCmd} {
- list [catch {glob -type d -path $globname *} msg] $msg
-} [list 0 [list $globname]]
-test filename-11.27 {Tcl_GlobCmd} {
- list [catch {glob -types abcde *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.28 {Tcl_GlobCmd} {
- list [catch {glob -types z *} msg] $msg
-} {1 {bad argument to "-types": z}}
-test filename-11.29 {Tcl_GlobCmd} {
- list [catch {glob -types {abcd efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.30 {Tcl_GlobCmd} {
- list [catch {glob -types {{macintosh type TEXT} \
- {macintosh creator ALFA} efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.31 {Tcl_GlobCmd} {
- list [catch {glob -types} msg] $msg
-} {1 {missing argument to "-types"}}
-test filename-11.32 {Tcl_GlobCmd} {
- list [catch {glob -path hello -dir hello *} msg] $msg
-} {1 {"-directory" cannot be used with "-path"}}
-test filename-11.33 {Tcl_GlobCmd} {
- list [catch {glob -path} msg] $msg
-} {1 {missing argument to "-path"}}
-test filename-11.34 {Tcl_GlobCmd} {
- list [catch {glob -direct} msg] $msg
-} {1 {missing argument to "-directory"}}
-test filename-11.35 {Tcl_GlobCmd} {
- list [catch {glob -paths *} msg] $msg
-} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
+ glob -type d -path $globname *
+} [list $globname]
+test filename-11.27 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types abcde *
+} -result {bad argument to "-types": abcde}
+test filename-11.28 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types z *
+} -result {bad argument to "-types": z}
+test filename-11.29 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types {abcd efgh} *
+} -result {only one MacOS type or creator argument to "-types" allowed}
+test filename-11.30 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types {{macintosh type TEXT} {macintosh creator ALFA} efgh} *
+} -result {only one MacOS type or creator argument to "-types" allowed}
+test filename-11.31 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types
+} -result {missing argument to "-types"}
+test filename-11.32 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -path hello -dir hello *
+} -result {"-directory" cannot be used with "-path"}
+test filename-11.33 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -path
+} -result {missing argument to "-path"}
+test filename-11.34 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -direct
+} -result {missing argument to "-directory"}
+test filename-11.35 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -paths *
+} -result {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
# Test '-tails' flag to glob.
-test filename-11.36 {Tcl_GlobCmd} {
- list [catch {glob -tails *} msg] $msg
-} {1 {"-tails" must be used with either "-directory" or "-path"}}
+test filename-11.36 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -tails *
+} -result {"-tails" must be used with either "-directory" or "-path"}
test filename-11.37 {Tcl_GlobCmd} {
- list [catch {glob -type d -tails -path $globname *} msg] $msg
-} [list 0 [list $globname]]
+ glob -type d -tails -path $globname *
+} [list $globname]
test filename-11.38 {Tcl_GlobCmd} {
- list [catch {glob -tails -path $globname *} msg] $msg
-} [list 0 [list $globname]]
+ glob -tails -path $globname *
+} [list $globname]
test filename-11.39 {Tcl_GlobCmd} {
- list [catch {glob -tails -join -path $globname *} msg] $msg
-} [list 0 [list $globname]]
-test filename-11.40 {Tcl_GlobCmd} {
- expr {[glob -dir [pwd] -tails *] == [glob *]}
-} {1}
-test filename-11.41 {Tcl_GlobCmd} {
- expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]}
-} {1}
-test filename-11.42 {Tcl_GlobCmd} {
+ glob -tails -join -path $globname *
+} [list $globname]
+test filename-11.40 {Tcl_GlobCmd} -body {
+ list [glob -dir [pwd] -tails *] [glob *]
+} -match compareWords -result equal
+test filename-11.41 {Tcl_GlobCmd} -body {
+ list [glob -dir [pwd] -tails *] [glob -dir [pwd] *]
+} -match compareWords -result "not equal"
+test filename-11.42 {Tcl_GlobCmd} -body {
set res [list]
foreach f [glob -dir [pwd] *] {
lappend res [file tail $f]
}
- expr {$res == [glob *]}
-} {1}
-test filename-11.43 {Tcl_GlobCmd} {
- list [catch {glob -t *} msg] $msg
-} {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-test filename-11.44 {Tcl_GlobCmd} {
- list [catch {glob -tails -path hello -directory hello *} msg] $msg
-} {1 {"-directory" cannot be used with "-path"}}
-test filename-11.45 {Tcl_GlobCmd on root volume} {
+ list $res [glob *]
+} -match compareWords -result equal
+test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -t *
+} -result {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
+test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -tails -path hello -directory hello *
+} -result {"-directory" cannot be used with "-path"}
+test filename-11.45 {Tcl_GlobCmd on root volume} -setup {
set res1 ""
set res2 ""
+ set tmpd [pwd]
+} -body {
catch {
set res1 [glob -dir [lindex [file volumes] 0] -tails *]
}
catch {
- set tmpd [pwd]
cd [lindex [file volumes] 0]
set res2 [glob *]
- cd $tmpd
}
- set res [expr {$res1 == $res2}]
- if {!$res} {
- lappend res $res1 $res2
- }
- set res
-} {1}
-test filename-11.46 {Tcl_GlobCmd} {
- list [catch {glob -types abcde -dir foo *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.47 {Tcl_GlobCmd} {
- list [catch {glob -types abcde -path foo *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.48 {Tcl_GlobCmd} {
- list [catch {glob -types abcde -dir foo -join * *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.49 {Tcl_GlobCmd} {
- list [catch {glob -types abcde -path foo -join * *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
+ list $res1 $res2
+} -cleanup {
+ cd $tmpd
+} -match compareWords -result equal
+test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types abcde -dir foo *
+} -result {bad argument to "-types": abcde}
+test filename-11.47 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types abcde -path foo *
+} -result {bad argument to "-types": abcde}
+test filename-11.48 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types abcde -dir foo -join * *
+} -result {bad argument to "-types": abcde}
+test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -types abcde -path foo -join * *
+} -result {bad argument to "-types": abcde}
file rename $horribleglobname globTest
set globname globTest
unset horribleglobname
test filename-12.1 {simple globbing} {unixOrPc} {
- list [catch {glob {}} msg] $msg
-} {0 .}
-test filename-12.1.1 {simple globbing} {unixOrPc} {
- list [catch {glob -types f {}} msg] $msg
-} {1 {no files matched glob pattern ""}}
+ glob {}
+} {.}
+test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
+ glob -types f {}
+} -returnCodes error -result {no files matched glob pattern ""}
test filename-12.1.2 {simple globbing} {unixOrPc} {
- list [catch {glob -types d {}} msg] $msg
-} {0 .}
+ glob -types d {}
+} {.}
test filename-12.1.3 {simple globbing} {unix} {
- list [catch {glob -types hidden {}} msg] $msg
-} {0 .}
-test filename-12.1.4 {simple globbing} {win} {
- list [catch {glob -types hidden {}} msg] $msg
-} {1 {no files matched glob pattern ""}}
-test filename-12.1.5 {simple globbing} {win} {
- list [catch {glob -types hidden c:/} msg] $msg
-} {1 {no files matched glob pattern "c:/"}}
+ glob -types hidden {}
+} {.}
+test filename-12.1.4 {simple globbing} -constraints {win} -body {
+ glob -types hidden {}
+} -returnCodes error -result {no files matched glob pattern ""}
+test filename-12.1.5 {simple globbing} -constraints {win} -body {
+ glob -types hidden c:/
+} -returnCodes error -result {no files matched glob pattern "c:/"}
test filename-12.1.6 {simple globbing} {win} {
- list [catch {glob c:/} msg] $msg
-} {0 c:/}
+ glob c:/
+} {c:/}
test filename-12.3 {simple globbing} {
- list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
-} {0 {}}
-
+ glob -nocomplain \{a1,a2\}
+} {}
set globPreResult globTest/
set x1 x1.c
set y1 y1.c
@@ -1149,92 +1111,67 @@ test filename-12.4 {simple globbing} {unixOrPc} {
lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
} "$globPreResult$x1 $globPreResult$y1"
test filename-12.5 {simple globbing} {
- list [catch {glob globTest\\/x1.c} msg] $msg
-} "0 $globPreResult$x1"
+ glob globTest\\/x1.c
+} "$globPreResult$x1"
test filename-12.6 {simple globbing} {
- list [catch {glob globTest\\/\\x1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-12.7 {globbing at filesystem root} {unix} {
- set res1 [glob -nocomplain /*]
- set res2 [glob -path / *]
- set equal [string equal $res1 $res2]
- if {!$equal} {
- lappend equal "not equal" $res1 $res2
- }
- set equal
-} {1}
-test filename-12.8 {globbing at filesystem root} {unix} {
- set dir [lindex [glob -type d /*] 0]
- set first [string range $dir 0 1]
- set res1 [glob -nocomplain ${first}*]
- set res2 [glob -path $first *]
- set equal [string equal $res1 $res2]
- if {!$equal} {
- lappend equal "not equal" $res1 $res2
- }
- set equal
-} {1}
-test filename-12.9 {globbing at filesystem root} {win} {
- # Can't grab just anything from 'file volumes' because we need a dir
- # that has subdirs - assume that C:/ exists across Windows machines.
- set dir [lindex [glob -type d C:/*] 0]
- set first [string range $dir 0 3]
- set res1 [glob -nocomplain ${first}*]
- set res2 [glob -path $first *]
- set equal [string equal $res1 $res2]
- if {!$equal} {
- lappend equal "not equal" $res1 $res2
- }
- set equal
-} {1}
-
-test filename-12.10 {globbing with volume relative paths} {win} {
- set dir [lindex [glob -type d C:/*] 0]
+ glob globTest\\/\\x1.c
+} "$globPreResult$x1"
+test filename-12.7 {globbing at filesystem root} -constraints {unix} -body {
+ list [glob -nocomplain /*] [glob -path / *]
+} -match compareWords -result equal
+test filename-12.8 {globbing at filesystem root} -constraints {unix} -body {
+ set first [string range [lindex [glob -type d /*] 0] 0 1]
+ list [glob -nocomplain ${first}*] [glob -path $first *]
+} -match compareWords -result equal
+test filename-12.9 {globbing at filesystem root} -constraints {win} -body {
+ # Can't grab just anything from 'file volumes' because we need a dir that
+ # has subdirs - assume that C:/ exists across Windows machines.
+ set first [string range [lindex [glob -type d C:/*] 0] 0 3]
+ list [glob -nocomplain ${first}*] [glob -path $first *]
+} -match compareWords -result equal
+test filename-12.10 {globbing with volume relative paths} -setup {
set pwd [pwd]
+} -body {
+ set dir [lindex [glob -type d C:/*] 0]
cd C:/
- set res1 [glob -nocomplain [string range $dir 2 end]]
+ list [glob -nocomplain [string range $dir 2 end]] [list $dir]
+} -cleanup {
cd $pwd
- set res2 [list $dir]
- set equal [string equal $res1 $res2]
- if {!$equal} {
- lappend equal "not equal" $res1 $res2
- }
- set equal
-} {1}
+} -constraints {win} -match compareWords -result equal
test filename-13.1 {globbing with brace substitution} {
- list [catch {glob globTest/\{\}} msg] $msg
-} "0 $globPreResult"
-test filename-13.2 {globbing with brace substitution} {
- list [catch {glob globTest/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.3 {globbing with brace substitution} {
- list [catch {glob globTest/\{\\\}} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.4 {globbing with brace substitution} {
- list [catch {glob globTest/\{\\} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.5 {globbing with brace substitution} {
- list [catch {glob globTest/\}} msg] $msg
-} {1 {unmatched close-brace in file name}}
+ glob globTest/\{\}
+} "$globPreResult"
+test filename-13.2 {globbing with brace substitution} -body {
+ glob globTest/\{
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.3 {globbing with brace substitution} -body {
+ glob globTest/\{\\\}
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.4 {globbing with brace substitution} -body {
+ glob globTest/\{\\
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.5 {globbing with brace substitution} -body {
+ glob globTest/\}
+} -returnCodes error -result {unmatched close-brace in file name}
test filename-13.6 {globbing with brace substitution} {
- list [catch {glob globTest/\{\}x1.c} msg] $msg
-} "0 $globPreResult$x1"
+ glob globTest/\{\}x1.c
+} "$globPreResult$x1"
test filename-13.7 {globbing with brace substitution} {
- list [catch {glob globTest/\{x\}1.c} msg] $msg
-} "0 $globPreResult$x1"
+ glob globTest/\{x\}1.c
+} "$globPreResult$x1"
test filename-13.8 {globbing with brace substitution} {
- list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
-} "0 $globPreResult$x1"
+ glob globTest/\{x\{\}\}1.c
+} "$globPreResult$x1"
test filename-13.9 {globbing with brace substitution} {
- list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+ lsort [glob globTest/\{x,y\}1.c]
+} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.10 {globbing with brace substitution} {
- list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+ lsort [glob globTest/\{x,,y\}1.c]
+} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.11 {globbing with brace substitution} {unixOrPc} {
- list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
-} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
+ lsort [glob globTest/\{x,x\\,z,z\}1.c]
+} [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}]
test filename-13.13 {globbing with brace substitution} {
lsort [glob globTest/{a,b,x,y}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
@@ -1250,9 +1187,9 @@ test filename-13.18 {globbing with brace substitution} {unixOrPc} {
test filename-13.20 {globbing with brace substitution} {unixOrPc} {
lsort [glob globTest/{a,x}1/*/{x,y}*]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-13.22 {globbing with brace substitution} {
- list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
+test filename-13.22 {globbing with brace substitution} -body {
+ glob globTest/\{a,x\}1/*/\{
+} -returnCodes error -result {unmatched open-brace in file name}
test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob glo*/*.c]
@@ -1260,22 +1197,21 @@ test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob globTest/?1.c]
} {globTest/x1.c globTest/y1.c globTest/z1.c}
-
-# The current directory could be anywhere; do this to stop spurious matches
-file mkdir globTestContext
-file rename globTest [file join globTestContext globTest]
-set savepwd [pwd]
-cd globTestContext
-
-test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.5 {asterisks, question marks, and brackets} -setup {
+ # The current directory could be anywhere; do this to stop spurious
+ # matches
+ file mkdir globTestContext
+ file rename globTest [file join globTestContext globTest]
+ set savepwd [pwd]
+ cd globTestContext
+} -constraints {unixOrPc} -body {
lsort [glob */*/*/*.c]
-} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-
-# Reset to where we were
-cd $savepwd
-file rename [file join globTestContext globTest] globTest
-file delete globTestContext
-
+} -cleanup {
+ # Reset to where we were
+ cd $savepwd
+ file rename [file join globTestContext globTest] globTest
+ file delete globTestContext
+} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-14.7 {asterisks, question marks, and brackets} {unix} {
lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
@@ -1294,26 +1230,27 @@ test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
-test filename-14.17 {asterisks, question marks, and brackets} {
+test filename-14.17 {asterisks, question marks, and brackets} -setup {
global env
set temp $env(HOME)
+} -body {
set env(HOME) [file join $env(HOME) globTest]
- set result [list [catch {glob ~/z*} msg] $msg]
+ glob ~/z*
+} -cleanup {
set env(HOME) $temp
- set result
-} [list 0 [list [file join $env(HOME) globTest z1.c]]]
+} -result [list [file join $env(HOME) globTest z1.c]]
test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
- list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
-} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
+ lsort [glob globTest/*.c goo/*]
+} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.20 {asterisks, question marks, and brackets} {
- list [catch {glob -nocomplain goo/*} msg] $msg
-} {0 {}}
-test filename-14.21 {asterisks, question marks, and brackets} {
- list [catch {glob globTest/*/gorp} msg] $msg
-} {1 {no files matched glob pattern "globTest/*/gorp"}}
-test filename-14.22 {asterisks, question marks, and brackets} {
- list [catch {glob goo/* x*z foo?q} msg] $msg
-} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
+ glob -nocomplain goo/*
+} {}
+test filename-14.21 {asterisks, question marks, and brackets} -body {
+ glob globTest/*/gorp
+} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
+test filename-14.22 {asterisks, question marks, and brackets} -body {
+ glob goo/* x*z foo?q
+} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
test filename-14.23 {slash globbing} {unix} {
glob /
} /
@@ -1324,88 +1261,116 @@ test filename-14.24 {slash globbing} {win} {
glob {\\}
} [file norm /]
test filename-14.25 {type specific globbing} {unix} {
- list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
+ lsort [glob -dir globTest -types f *]
+} [lsort [list \
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.25.1 {type specific globbing} {win} {
- list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
- [file join $globname .1]\
+ lsort [glob -dir globTest -types f *]
+} [lsort [list \
+ [file join $globname .1]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
+ [file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.26 {type specific globbing} {
- list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
-} [list 0 {}]
+ glob -nocomplain -dir globTest -types {readonly} *
+} {}
+test filename-14.27 {Bug 2710920} {unixOrPc} {
+ file tail [lindex [lsort [glob globTest/*/]] 0]
+} a1
+test filename-14.28 {Bug 2710920} {unixOrPc} {
+ file dirname [lindex [lsort [glob globTest/*/]] 0]
+} globTest
+test filename-14.29 {Bug 2710920} {unixOrPc} {
+ file extension [lindex [lsort [glob globTest/*/]] 0]
+} {}
+test filename-14.30 {Bug 2710920} {unixOrPc} {
+ file rootname [lindex [lsort [glob globTest/*/]] 0]
+} globTest/a1/
+
+test filename-14.31 {Bug 2918610} -setup {
+ set d [makeDirectory foo]
+ makeFile {} bar.soom $d
+} -body {
+ foreach fn [glob $d/bar.soom] {
+ set root [file rootname $fn]
+ close [open $root {WRONLY CREAT}]
+ }
+ llength [glob -directory $d *]
+} -cleanup {
+ file delete -force $d/bar
+ removeFile bar.soom $d
+ removeDirectory foo
+} -result 2
unset globname
-# The following tests are only valid for Unix systems.
-# On some systems, like AFS, "000" protection doesn't prevent
-# access by owner, so the following test is not portable.
+# The following tests are only valid for Unix systems. On some systems, like
+# AFS, "000" protection doesn't prevent access by owner, so the following test
+# is not portable.
catch {file attributes globTest/a1 -permissions 0000}
test filename-15.1 {unix specific globbing} {unix nonPortable} {
- string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
+ string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} {
glob -nocomplain globTest/a1/*
} {}
test filename-15.3 {unix specific no complain: no errors, good result} \
{unix nonPortable} {
- # test fails because if an error occur , the interp's result
- # is reset...
+ # test fails because if an error occurs, the interp's result is reset...
glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
-
catch {file attributes globTest/a1 -permissions 0755}
test filename-15.4 {unix specific no complain: no errors, good result} \
{unix nonPortable} {
- # test fails because if an error occurs, the interp's result
- # is reset... or you don't run at scriptics where the
- # outser and welch users exists
+ # test fails because if an error occurs, the interp's result is reset...
+ # or you don't run at scriptics where the outser and welch users exists
glob -nocomplain ~ouster ~foo ~welch
} {/home/ouster /home/welch}
-test filename-15.4.1 {no complain: no errors, good result} {
- # test used to fail because if an error occurs, the interp's result
- # is reset...
- string equal [glob -nocomplain ~wontexist ~blah ~] \
- [glob -nocomplain ~ ~blah ~wontexist]
-} {1}
+test filename-15.4.1 {no complain: errors, sequencing} {
+ # test used to fail because if an error occurs, the interp's result is
+ # reset... But, the sequence means we throw a different error first.
+ list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \
+ [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2
+} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}}
+test filename-15.4.2 {no complain: errors, sequencing} -body {
+ # test used to fail because if an error occurs, the interp's result is
+ # reset...
+ list [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
+ [list [catch {glob -nocomplain * ~wontexist} res2] $res2]
+} -match compareWords -result equal
test filename-15.5 {unix specific globbing} {unix nonPortable} {
glob ~ouster/.csh*
} "/home/ouster/.cshrc"
-catch {close [open globTest/odd\\\[\]*?\{\}name w]}
-test filename-15.6 {unix specific globbing} {unix} {
+touch globTest/odd\\\[\]*?\{\}name
+test filename-15.6 {unix specific globbing} -constraints {unix} -setup {
global env
set temp $env(HOME)
+} -body {
set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
- set result [list [catch {glob ~} msg] $msg]
+ glob ~
+} -cleanup {
set env(HOME) $temp
- set result
-} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
+} -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]
catch {file delete -force globTest/odd\\\[\]*?\{\}name}
-test filename-15.7 {win specific globbing} {win} {
- if {[string index [glob ~] end] == "/"} {
- set res "glob ~ is [glob ~] but shouldn't end in a separator"
- } else {
- set res "ok"
- }
-} {ok}
-test filename-15.8 {win and unix specific globbing} {unixOrWin} {
+test filename-15.7 {win specific globbing} -constraints {win} -body {
+ glob ~
+} -match regexp -result {[^/]$}
+test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup {
global env
set temp $env(HOME)
- catch {close [open $env(HOME)/globTest/anyname w]} err
+} -body {
+ touch $env(HOME)/globTest/anyname
set env(HOME) $env(HOME)/globTest/anyname
- set result [list [catch {glob ~} msg] $msg]
+ glob ~
+} -cleanup {
set env(HOME) $temp
catch {file delete -force $env(HOME)/globTest/anyname}
- set result
-} [list 0 [list [lindex [glob ~] 0]/globTest/anyname]]
+} -result [list [lindex [glob ~] 0]/globTest/anyname]
# The following tests are only valid for Windows systems.
set oldDir [pwd]
@@ -1413,24 +1378,25 @@ if {[testConstraint win]} {
cd c:/
file delete -force globTest
file mkdir globTest
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
+ touch globTest/x1.BAT
+ touch globTest/y1.Bat
+ touch globTest/z1.bat
}
test filename-16.1 {windows specific globbing} {win} {
lsort [glob globTest/*.bat]
} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
test filename-16.2 {windows specific globbing} {win} {
- list [catch {glob c:} res] $res
-} {0 c:}
-test filename-16.2.1 {windows specific globbing} {win} {
+ glob c:
+} c:
+test filename-16.2.1 {windows specific globbing} -constraints {win} -setup {
set dir [pwd]
+} -body {
cd C:/
- set res [list [catch {glob c:} err] $err]
+ glob c:
+} -cleanup {
cd $dir
- set res
-} {0 c:}
+} -result c:
test filename-16.3 {windows specific globbing} {win} {
glob -nocomplain c:\\\\
} c:/
@@ -1458,13 +1424,7 @@ test filename-16.10 {windows specific globbing} {win} {
test filename-16.11 {windows specific globbing} {win} {
lsort [glob -nocomplain c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
-
# some tests require a shared C drive
-
-if {[testConstraint win]} {
- testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
-}
-
test filename-16.12 {windows specific globbing} {win sharedCdrive} {
cd //[info hostname]/c
glob //[info hostname]/c/*Test
@@ -1475,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]
@@ -1484,53 +1444,179 @@ test filename-16.15 {windows specific globbing} {win} {
test filename-16.16 {windows specific globbing} {win} {
file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
} {..}
-test filename-16.17 {windows specific globbing} {win} {
+test filename-16.17 {windows specific globbing} -constraints {win} -body {
cd C:/
- # Ensure correct trimming of tails with absolute and
- # volume relative globbing.
- set res1 [glob -nocomplain -tails -dir C:/ *]
- set res2 [glob -nocomplain -tails -dir C: *]
- if {$res1 eq $res2} {
- concat ok
- } else {
- concat $res1 ne $res2
- }
-} {ok}
+ # Ensure correct trimming of tails with absolute and volume relative
+ # globbing.
+ list [glob -nocomplain -tails -dir C:/ *] \
+ [glob -nocomplain -tails -dir C: *]
+} -match compareWords -result equal
+
+# Put the working directory back now that we're done with globbing in C:/
+if {[testConstraint win]} {
+ cd $oldDir
+}
test filename-17.1 {windows specific special files} {testsetplatform} {
testsetplatform win
list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
- [file pathtype prn] [file pathtype nul] [file pathtype aux] \
- [file pathtype foo]
+ [file pathtype prn] [file pathtype nul] [file pathtype aux] \
+ [file pathtype foo]
} {absolute absolute absolute absolute absolute absolute relative}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-
-test filename-17.2 {windows specific glob with executable} {win} {
+test filename-17.2 {windows specific glob with executable} -body {
makeDirectory execglob
makeFile contents execglob/abc.exe
makeFile contents execglob/abc.notexecutable
- set res [glob -nocomplain -dir [temporaryDirectory]/execglob \
- -tails -types x *]
+ glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *
+} -constraints {win} -cleanup {
removeFile execglob/abc.exe
removeFile execglob/abc.notexecutable
removeDirectory execglob
- set res
-} {abc.exe}
+} -result {abc.exe}
+test filename-17.3 {Bug 2571597} win {
+ set p /a
+ file pathtype $p
+ file normalize $p
+ file pathtype $p
+} volumerelative
test fileName-18.1 {windows - split ADS name correctly} {win} {
# bug 1194458
set x [file split c:/c:d]
- set y [eval [linsert $x 0 file join]]
- list $x $y
+ list $x [file join {*}$x]
} {{c:/ ./c:d} c:/c:d}
+test fileName-19.1 {ensure that [Bug 1325099] stays fixed} {
+ # Any non-crashing result is OK
+ list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file]
+} {0 0}
+
+test fileName-20.1 {Bug 1750300} -setup {
+ set d [makeDirectory foo]
+ makeFile {} TAGS $d
+} -body {
+ llength [glob -nocomplain -directory $d -- TAGS one two]
+} -cleanup {
+ removeFile TAGS $d
+ removeDirectory foo
+} -result 1
+test fileName-20.2 {Bug 1750300} -setup {
+ set d [makeDirectory foo]
+ makeFile {} TAGS $d
+} -body {
+ llength [glob -nocomplain -directory $d -types {} -- TAGS one two]
+} -cleanup {
+ removeFile TAGS $d
+ removeDirectory foo
+} -result 1
+test fileName-20.3 {Bug 1750300} -setup {
+ set d [makeDirectory foo]
+ makeFile {} TAGS $d
+} -body {
+ llength [glob -nocomplain -directory $d -types {} -- *U*]
+} -cleanup {
+ removeFile TAGS $d
+ removeDirectory foo
+} -result 0
+test fileName-20.4 {Bug 1750300} -setup {
+ set d [makeDirectory foo]
+ makeFile {} TAGS $d
+} -body {
+ llength [glob -nocomplain -directory $d -types {} -- URGENT Urkle]
+} -cleanup {
+ removeFile TAGS $d
+ removeDirectory foo
+} -result 0
+test fileName-20.5 {Bug 2837800} -setup {
+ set dd [makeDirectory isolate]
+ set d [makeDirectory ./~foo $dd]
+ makeFile {} test $d
+ set savewd [pwd]
+ cd $dd
+} -body {
+ glob -nocomplain */test
+} -cleanup {
+ cd $savewd
+ removeFile test $d
+ 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]
+ makeFile {} test ~
+ set dd [makeDirectory isolate]
+ set d [makeDirectory ./~ $dd]
+ set savewd [pwd]
+ cd $dd
+} -body {
+ glob -nocomplain */test
+} -cleanup {
+ cd $savewd
+ removeDirectory ./~ $dd
+ removeDirectory isolate
+ removeFile test ~
+} -result {}
+test fileName-20.7 {Bug 2806250} -setup {
+ set savewd [pwd]
+ cd [temporaryDirectory]
+ set d [makeDirectory isolate]
+ makeFile {} ./~test $d
+} -body {
+ file exists [lindex [glob -nocomplain isolate/*] 0]
+} -cleanup {
+ removeFile ./~test $d
+ removeDirectory isolate
+ cd $savewd
+} -result 1
+test fileName-20.8 {Bug 2806250} -setup {
+ set savewd [pwd]
+ cd [temporaryDirectory]
+ set d [makeDirectory isolate]
+ makeFile {} ./~test $d
+} -body {
+ file tail [lindex [glob -nocomplain isolate/*] 0]
+} -cleanup {
+ removeFile ./~test $d
+ removeDirectory isolate
+ cd $savewd
+} -result ./~test
+test fileName-20.9 {globbing for special chars} -setup {
+ makeFile {} test ~
+ set d [makeDirectory isolate]
+ set savewd [pwd]
+ cd $d
+} -body {
+ glob -nocomplain -directory ~ test
+} -cleanup {
+ cd $savewd
+ removeDirectory isolate
+ removeFile test ~
+} -result ~/test
+test fileName-20.10 {globbing for special chars} -setup {
+ set s [makeDirectory sub ~]
+ makeFile {} fileName-20.10 $s
+ set d [makeDirectory isolate]
+ set savewd [pwd]
+ cd $d
+} -body {
+ glob -nocomplain -directory ~ -join * fileName-20.10
+} -cleanup {
+ cd $savewd
+ removeDirectory isolate
+ 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
@@ -1539,3 +1625,7 @@ if {[testConstraint testsetplatform]} {
catch {unset oldhome temp result globPreResult}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 3c0bac2..942a86c 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -1,31 +1,35 @@
# This file tests the filesystem and vfs internals.
#
-# 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) 2002 Vincent Darley.
#
-# 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.
package require tcltest 2
namespace eval ::tcl::test::fileSystem {
+ namespace import ::tcltest::*
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeDirectory
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeDirectory
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
-
catch {
file delete -force link.file
file delete -force dir.link
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]]
@@ -38,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 {$::tcl_platform(platform) eq "windows"} {
- 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 {$::tcl_platform(platform) eq "windows"} {
- 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 {
@@ -95,6 +94,8 @@ testConstraint hasLinks [expr {![catch {
if {[testConstraint testsetplatform]} {
set platform [testgetplatform]
}
+
+# ----------------------------------------------------------------------
test filesystem-1.0 {link normalisation} {hasLinks} {
string equal [file normalize gorp.file] [file normalize link.file]
@@ -105,48 +106,54 @@ 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]]
+ string equal [file normalize [file join dir.dir linkinside.file]] \
+ [file normalize [file join dir.link inside.file]]
} {0}
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]]
+ 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}
-test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
+} -result ok
+test filesystem-1.10 {link normalisation: double link} -constraints {
+ unix hasLinks
+} -body {
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}
+} -cleanup {
+ file delete dir2.link
+} -result ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
+ file link dir2.link dir.link
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 *]] {
@@ -203,62 +210,49 @@ 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]]]
- if {![string equal [lindex $res 0] [lindex $res 1]]} {
- set res "$res not equal"
- } else {
- set res "ok"
- }
-} {ok}
+ 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]]]
- if {![string equal [lindex $res 0] [lindex $res 1]]} {
- set res "$res not equal"
- } else {
- set res "ok"
- }
-} {ok}
-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]
file link dir2.link $to
set res [file normalize [file join dir2.link x yyy z]]
- if {[string first ".." $res] != -1} {
- set res "$res must not contain '..'"
- } else {
- set res "ok"
+ if {[string match *..* $res]} {
+ return "$res must not contain '..'"
}
-} {ok}
+ return "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
@@ -267,9 +261,9 @@ file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
-test filesystem-1.30 {normalisation of nonexistent user} {
- list [catch {file normalize ~noonewiththisname} err] $err
-} {1 {user "noonewiththisname" doesn't exist}}
+test filesystem-1.30 {normalisation of nonexistent user} -body {
+ file normalize ~noonewiththisname
+} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform unix
file normalize /foo/../bar
@@ -281,9 +275,9 @@ test filesystem-1.32 {link normalisation: link near filesystem root} {testsetpla
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform windows
set res [file normalize C:/../bar]
- if {$::tcl_platform(platform) == "unix"} {
- # Some unices go further in normalizing this -- not really
- # a problem since this is a Windows test
+ if {[testConstraint unix]} {
+ # Some unices go further in normalizing this -- not really a problem
+ # since this is a Windows test.
regexp {C:/bar$} $res res
}
set res
@@ -291,391 +285,347 @@ 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)} {
+ testPathEqual [file norm /xxx/..] [file norm /]
+} ok
+test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/../] [file norm /]
+} ok
+test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/foo/../..] [file norm /]
+} ok
+test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/foo/../../] [file norm /]
+} ok
+test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]
+} ok
+test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/../../bar] [file norm /bar]
+} ok
+test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /xxx/../bar] [file norm /bar]
+} ok
+test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /..] [file norm /]
+} ok
+test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /../] [file norm /]
+} ok
+test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /.] [file norm /]
+} ok
+test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /./] [file norm /]
+} ok
+test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
+ testPathEqual [file norm /../..] [file norm /]
+} ok
+test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
+ 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]} {
+ proc resetfs {} {
while {![catch {testfilesystem 0}]} {}
+ }
}
-test filesystem-3.0 {Tcl_FSRegister} testfilesystem {
- testfilesystem 1
-} {registered}
-test filesystem-3.1 {Tcl_FSUnregister} testfilesystem {
- testfilesystem 0
-} {unregistered}
-test filesystem-3.2 {Tcl_FSUnregister} testfilesystem {
- list [catch {testfilesystem 0} err] $err
-} {1 failed}
+test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
+ set result {}
+ lappend result [testfilesystem 1]
+ lappend result [testfilesystem 0]
+ lappend result [catch {testfilesystem 0} msg] $msg
+} {registered unregistered 1 failed}
test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
testfilesystem 1
testfilesystem 1
testfilesystem 0
testfilesystem 0
} {unregistered}
-test filesystem-3.4 {Tcl_FSRegister} testfilesystem {
+test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body {
testfilesystem 1
file system bar
-} {reporting}
-test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
+} -cleanup {
testfilesystem 0
+} -result {reporting}
+test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
+ resetfs
lindex [file system bar] 0
} {native}
-test filesystem-4.0 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- file exists foo
- testfilesystem 0
- set filesystemReport
- }
- -result {*{access foo}}
-}
-test filesystem-4.1 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {file stat foo bar}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{stat foo}}
-}
-test filesystem-4.2 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {file lstat foo bar}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{lstat foo}}
-}
-test filesystem-4.3 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {glob *}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{matchindirectory *}*}
-}
+test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ file exists foo
+ testfilesystem 0
+ 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
+ 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
+ return $filesystemReport
+} -match glob -result {*{lstat foo}}
+test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ catch {glob *}
+ testfilesystem 0
+ return $filesystemReport
+} -match glob -result {*{matchindirectory *}*}
-test filesystem-5.1 {cache and ~} {
- -constraints testfilesystem
- -match regexp
- -body {
- set orig $env(HOME)
- set ::env(HOME) /foo/bar/blah
- set testdir ~
- set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
- set ::env(HOME) /a/b/c
- set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
- set ::env(HOME) $orig
- list $res1 $res2
- }
- -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
-}
+test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
+ set orig $::env(HOME)
+} -body {
+ set ::env(HOME) /foo/bar/blah
+ set testdir ~
+ set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
+ set ::env(HOME) /a/b/c
+ set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
+ list $res1 $res2
+} -cleanup {
+ set ::env(HOME) $orig
+} -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/cygwin)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/cygwin)?(/a/b|a:b)}}
-test filesystem-6.1 {empty file name} {
- list [catch {open ""} msg] $msg
-} {1 {couldn't open "": no such file or directory}}
-test filesystem-6.2 {empty file name} {
- list [catch {file stat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.3 {empty file name} {
- list [catch {file atime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.4 {empty file name} {
- list [catch {file attributes ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.5 {empty file name} {
- list [catch {file copy "" ""} msg] $msg
-} {1 {error copying "": no such file or directory}}
-test filesystem-6.6 {empty file name} {
- list [catch {file delete ""} msg] $msg
-} {0 {}}
-test filesystem-6.7 {empty file name} {
- list [catch {file dirname ""} msg] $msg
-} {0 .}
-test filesystem-6.8 {empty file name} {
- list [catch {file executable ""} msg] $msg
-} {0 0}
-test filesystem-6.9 {empty file name} {
- list [catch {file exists ""} msg] $msg
-} {0 0}
-test filesystem-6.10 {empty file name} {
- list [catch {file extension ""} msg] $msg
-} {0 {}}
-test filesystem-6.11 {empty file name} {
- list [catch {file isdirectory ""} msg] $msg
-} {0 0}
-test filesystem-6.12 {empty file name} {
- list [catch {file isfile ""} msg] $msg
-} {0 0}
-test filesystem-6.13 {empty file name} {
- list [catch {file join ""} msg] $msg
-} {0 {}}
-test filesystem-6.14 {empty file name} {
- list [catch {file link ""} msg] $msg
-} {1 {could not read link "": no such file or directory}}
-test filesystem-6.15 {empty file name} {
- list [catch {file lstat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.16 {empty file name} {
- list [catch {file mtime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.17 {empty file name} {
- list [catch {file mtime "" 0} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.18 {empty file name} {
- list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test filesystem-6.19 {empty file name} {
- list [catch {file nativename ""} msg] $msg
-} {0 {}}
-test filesystem-6.20 {empty file name} {
- list [catch {file normalize ""} msg] $msg
-} {0 {}}
-test filesystem-6.21 {empty file name} {
- list [catch {file owned ""} msg] $msg
-} {0 0}
-test filesystem-6.22 {empty file name} {
- list [catch {file pathtype ""} msg] $msg
-} {0 relative}
-test filesystem-6.23 {empty file name} {
- list [catch {file readable ""} msg] $msg
-} {0 0}
-test filesystem-6.24 {empty file name} {
- list [catch {file readlink ""} msg] $msg
-} {1 {could not readlink "": no such file or directory}}
-test filesystem-6.25 {empty file name} {
- list [catch {file rename "" ""} msg] $msg
-} {1 {error renaming "": no such file or directory}}
-test filesystem-6.26 {empty file name} {
- list [catch {file rootname ""} msg] $msg
-} {0 {}}
-test filesystem-6.27 {empty file name} {
- list [catch {file separator ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.28 {empty file name} {
- list [catch {file size ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.29 {empty file name} {
- list [catch {file split ""} msg] $msg
-} {0 {}}
-test filesystem-6.30 {empty file name} {
- list [catch {file system ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.31 {empty file name} {
- list [catch {file tail ""} msg] $msg
-} {0 {}}
-test filesystem-6.32 {empty file name} {
- list [catch {file type ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.33 {empty file name} {
- list [catch {file writable ""} msg] $msg
-} {0 0}
+test filesystem-6.1 {empty file name} -returnCodes error -body {
+ open ""
+} -result {couldn't open "": no such file or directory}
+test filesystem-6.2 {empty file name} -returnCodes error -body {
+ file stat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.3 {empty file name} -returnCodes error -body {
+ file atime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.4 {empty file name} -returnCodes error -body {
+ file attributes ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.5 {empty file name} -returnCodes error -body {
+ file copy "" ""
+} -result {error copying "": no such file or directory}
+test filesystem-6.6 {empty file name} {file delete ""} {}
+test filesystem-6.7 {empty file name} {file dirname ""} .
+test filesystem-6.8 {empty file name} {file executable ""} 0
+test filesystem-6.9 {empty file name} {file exists ""} 0
+test filesystem-6.10 {empty file name} {file extension ""} {}
+test filesystem-6.11 {empty file name} {file isdirectory ""} 0
+test filesystem-6.12 {empty file name} {file isfile ""} 0
+test filesystem-6.13 {empty file name} {file join ""} {}
+test filesystem-6.14 {empty file name} -returnCodes error -body {
+ file link ""
+} -result {could not read link "": no such file or directory}
+test filesystem-6.15 {empty file name} -returnCodes error -body {
+ file lstat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.16 {empty file name} -returnCodes error -body {
+ file mtime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.17 {empty file name} -returnCodes error -body {
+ file mtime "" 0
+} -result {could not read "": no such file or directory}
+test filesystem-6.18 {empty file name} -returnCodes error -body {
+ file mkdir ""
+} -result {can't create directory "": no such file or directory}
+test filesystem-6.19 {empty file name} {file nativename ""} {}
+test filesystem-6.20 {empty file name} {file normalize ""} {}
+test filesystem-6.21 {empty file name} {file owned ""} 0
+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 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}
+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}
+test filesystem-6.31 {empty file name} {file tail ""} {}
+test filesystem-6.32 {empty file name} -returnCodes error -body {
+ file type ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.33 {empty file name} {file writable ""} 0
# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
while {![catch {testfilesystem 0}]} {}
}
-test filesystem-7.1 {load from vfs} {win testsimplefilesystem} {
- # This may cause a crash on exit
+test filesystem-7.1.1 {load from vfs} -setup {
set dir [pwd]
- cd [file dirname [info nameof]]
- set dde [lindex [glob *dde*[info sharedlib]] 0]
+} -constraints {win testsimplefilesystem loaddll} -body {
+ # This may cause a crash on exit
+ 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.
+} -cleanup {
cd $dir
- set res "ok"
+} -result ok
+test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
+ set dir [pwd]
+} -constraints {win testsimplefilesystem loaddll} -body {
+ # This may cause a crash on exit
+ cd [file dirname $::reglib]
+ testsimplefilesystem 1
+ # This loads reg via a complex copy-to-temp operation
+ 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.
-} {ok}
-test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \
- {testsimplefilesystem} {
+} -cleanup {
+ cd $dir
+} -result ok
+test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
# We created this file several tests ago.
set origtime [file mtime gorp.file]
set res [file exists gorp.file]
- if {[catch {
- testsimplefilesystem 1
- file delete -force theCopy
- file copy simplefs:/gorp.file theCopy
- testsimplefilesystem 0
- set newtime [file mtime theCopy]
- file delete theCopy
- } err]} {
- lappend res $err
- set newtime ""
- }
+ testsimplefilesystem 1
+ file delete -force theCopy
+ file copy simplefs:/gorp.file theCopy
+ testsimplefilesystem 0
+ set newtime [file mtime theCopy]
+ lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}]
+} -cleanup {
+ catch {file delete theCopy}
cd $dir
- lappend res [expr {$origtime == $newtime}]
-} {1 1}
-test filesystem-7.3 {glob in simplefs} testsimplefilesystem {
+} -result {1 1}
+test filesystem-7.3 {glob in simplefs} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain -dir simplefs:/simpledir *]
- testsimplefilesystem 0
+ glob -nocomplain -dir simplefs:/simpledir *
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir/simplefile}
-test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile}
+test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
set res [glob -nocomplain simplefs:/simpledir/*]
- eval lappend res [glob -nocomplain simplefs:/simpledir]
- testsimplefilesystem 0
+ lappend res {*}[glob -nocomplain simplefs:/simpledir]
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir/simplefile simplefs:/simpledir}
-test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile simplefs:/simpledir}
+test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain simplefs:/s*]
- testsimplefilesystem 0
+ glob -nocomplain simplefs:/s*
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- if {[llength $res] > 0} {
- set res "ok"
- } else {
- set res "no files found with 'glob -nocomplain simplefs:/s*'"
- }
-} {ok}
-test filesystem-7.3.3 {glob in simplefs: pattern is a volume} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain simplefs:/*]
+ glob -nocomplain simplefs:/*
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
cd $dir
- if {[llength $res] > 0} {
- set res "ok"
- } else {
- set res "no files found with 'glob -nocomplain simplefs:/*'"
- }
-} {ok}
-test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.4 {cross-filesystem file copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
set fout [open [file join simplefile] w]
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
# First copy should succeed
set res [catch {file copy simplefs:/simplefile file2} err]
lappend res $err
@@ -686,19 +636,20 @@ test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesyste
lappend res [catch {file copy -force simplefs:/simplefile file2} err]
lappend res $err
lappend res [file exists file2]
- testsimplefilesystem 0
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simplefile
file delete -force file2
cd $dir
- set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesystem unix} {
+} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
+test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
set fout [open [file join simplefile] w]
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
# First copy should succeed
set res [catch {file copy simplefs:/simplefile file2} err]
lappend res $err
@@ -710,13 +661,13 @@ test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesyst
lappend res [catch {file copy -force simplefs:/simplefile file2} err]
lappend res $err
lappend res [file exists file2]
+} -cleanup {
testsimplefilesystem 0
file delete -force simplefile
file delete -force file2
cd $dir
- set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem {
+} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
+test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
@@ -726,6 +677,7 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
# First copy should succeed
set res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
@@ -737,13 +689,13 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
lappend res $err
lappend res [file exists [file join dir2 simpledir]] \
[file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
file delete -force dir2
cd $dir
- set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
-test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesystem unix} {
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
@@ -753,6 +705,7 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
# First copy should succeed
set res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
@@ -760,40 +713,41 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
lappend res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
# Third copy should succeed (-force)
- # I've noticed on some Unices that this only succeeds
- # intermittently (some runs work, some fail). This needs
- # examining further.
+ # I've noticed on some Unices that this only succeeds intermittently (some
+ # runs work, some fail). This needs examining further.
lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
lappend res $err
lappend res [file exists [file join dir2 simpledir]] \
[file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
file delete -force dir2
cd $dir
- set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
removeFile gorp.file
-test filesystem-7.8 {vfs cd} testsimplefilesystem {
+test filesystem-7.8 {vfs cd} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
file mkdir simpledir
testsimplefilesystem 1
- # This can variously cause an infinite loop or simply have
- # no effect at all (before certain bugs were fixed, of course).
+} -constraints testsimplefilesystem -body {
+ # This can variously cause an infinite loop or simply have no effect at
+ # all (before certain bugs were fixed, of course).
cd simplefs:/simpledir
- set res [pwd]
+ pwd
+} -cleanup {
cd [tcltest::temporaryDirectory]
testsimplefilesystem 0
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir}
+} -result {simplefs:/simpledir}
-test filesystem-8.1 {relative path objects and caching of pwd} {
+test filesystem-8.1 {relative path objects and caching of pwd} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
makeDirectory abc
makeDirectory def
makeFile "contents" [file join abc foo]
@@ -804,35 +758,35 @@ test filesystem-8.1 {relative path objects and caching of pwd} {
lappend res [file exists $f]
cd ..
cd def
- # If we haven't cleared the object's cwd cache, Tcl
- # will think it still exists.
+ # If we haven't cleared the object's cwd cache, Tcl will think it still
+ # exists.
lappend res [file exists $f]
lappend res [file exists $f]
+} -cleanup {
removeFile [file join abc foo]
removeDirectory abc
removeDirectory def
cd $dir
- set res
-} {1 1 0 0}
-test filesystem-8.2 {relative path objects and use of pwd} {
+} -result {1 1 0 0}
+test filesystem-8.2 {relative path objects and use of pwd} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
set dir "abc"
makeDirectory $dir
makeFile "contents" [file join abc foo]
cd $dir
- set res [file exists [lindex [glob *] 0]]
- cd ..
+ file exists [lindex [glob *] 0]
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
removeFile [file join abc foo]
removeDirectory abc
cd $origdir
- set res
-} {1}
+} -result 1
test filesystem-8.3 {path objects and empty string} {
set anchor ""
set dst foo
set res $dst
-
set yyy [file split $anchor]
set dst [file join $anchor $dst]
lappend res $dst $yyy
@@ -844,7 +798,7 @@ proc TestFind1 {d f} {
lappend res "is dir a dir? [file isdirectory $d]"
set r2 [file exists [file join $d $f]]
lappend res "[file join $d $f] found: $r2"
- set res
+ return $res
}
proc TestFind2 {d f} {
set r1 [file exists [file join $d $f]]
@@ -852,67 +806,74 @@ proc TestFind2 {d f} {
lappend res "is dir a dir? [file isdirectory [file join $d]]"
set r2 [file exists [file join $d $f]]
lappend res "[file join $d $f] found: $r2"
- set res
+ return $res
}
-test filesystem-9.1 {path objects and join and object rep} {
+test filesystem-9.1 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind1 a [file join b . c]]
+ TestFind1 a [file join b . c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b . c]]
+ TestFind2 a [file join b . c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2.1 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2.1 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b .]]
+ TestFind2 a [file join b .]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
-test filesystem-9.3 {path objects and join and object rep} {
+} -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
+test filesystem-9.3 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind1 a [file join b .. b c]]
+ TestFind1 a [file join b .. b c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.4 {path objects and join and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.4 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b .. b c]]
+ TestFind2 a [file join b .. b c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.5 {path objects and file tail and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.5 {path objects and file tail and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir dgp
close [open dgp/test w]
foreach relative [glob -nocomplain [file join * test]] {
set absolute [file join [pwd] $relative]
set res [list [file tail $absolute] "test"]
}
+ return $res
+} -cleanup {
file delete -force dgp
cd $origdir
- set res
-} {test test}
+} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
set res {}
set p "C:\\toto"
@@ -920,10 +881,11 @@ test filesystem-9.6 {path objects and file tail and object rep} win {
file isdirectory $p
lappend res [file join $p toto]
} {C:/toto/toto C:/toto/toto}
-test filesystem-9.7 {path objects and glob and file tail and tilde} {
+test filesystem-9.7 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -932,15 +894,16 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} {
lappend res $file
lappend res [file exists $file] [catch {file tail $file} r] $r
lappend res [catch {file tail $file} r] $r
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.8 {path objects and glob and file tail and tilde} {
+} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.8 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -949,15 +912,16 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} {
lappend res $file1 $file2
lappend res [catch {file tail $file1} r] $r
lappend res [catch {file tail $file2} r] $r
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.9 {path objects and glob and file tail and tilde} {
+} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -966,14 +930,24 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} {
lappend res [catch {file exists $file1} r] $r
lappend res [catch {file exists $file2} r] $r
lappend res [string equal $file1 $file2]
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {0 0 0 0 1}
+} -result {0 0 0 0 1}
+
+# ----------------------------------------------------------------------
+
+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
+
+# Local Variables:
+# mode: tcl
+# End:
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 7c968f6..8abd270 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -8,21 +8,25 @@
#
# 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.12 2005/06/20 07:49:11 mdejong Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
+}
+
# Basic "for" operation.
test for-1.1 {TclCompileForCmd: missing initial command} {
list [catch {for} msg] $msg
} {1 {wrong # args: should be "for start test next command"}}
test for-1.2 {TclCompileForCmd: error in initial command} -body {
- list [catch {for {set}} msg] $msg $errorInfo
+ list [catch {for {set}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
while *ing
"for {set}"}}
@@ -33,7 +37,7 @@ test for-1.3 {TclCompileForCmd: missing test expression} {
} {wrong # args: should be "for start test next command"}
test for-1.4 {TclCompileForCmd: error in test expression} -body {
catch {for {set i 0} {$i<}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "for start test next command"
while *ing
"for {set i 0} {$i<}"}
@@ -51,7 +55,7 @@ test for-1.7 {TclCompileForCmd: missing command body} {
} {wrong # args: should be "for start test next command"}
test for-1.8 {TclCompileForCmd: error compiling command body} -body {
catch {for {set i 0} {$i < 5} {incr i} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -82,7 +86,7 @@ test for-1.11 {TclCompileForCmd: computed command body} {
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
catch {for {set i 0} {$i < 5} {set} {format $i}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -199,6 +203,19 @@ test for-2.6 {continue tests, long command body} {
}
set a
} {1 3}
+test for-2.7 {continue tests, uncompiled [for]} -body {
+ set file [makeFile {
+ set guard 0
+ for {set i 20} {$i > 0} {incr i -1} {
+ if {[incr guard]>30} {return BAD}
+ continue
+ }
+ return GOOD
+ } source.file]
+ source $file
+} -cleanup {
+ removeFile source.file
+} -result GOOD
# Check "for" and "break".
@@ -334,7 +351,6 @@ proc formatMail {} {
64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
}
-
set result ""
set NL "
"
@@ -354,7 +370,6 @@ proc formatMail {} {
} else {
set break 1
}
-
set xmailer 0
set inheaders 1
set last [array size lines]
@@ -375,9 +390,7 @@ proc formatMail {} {
set limit 55
} else {
set limit 55
-
# Decide whether or not to break the body line
-
if {$plen > 0} {
if {[string first {> } $line] == 0} {
# This is quoted text from previous message, don't reformat
@@ -420,7 +433,7 @@ proc formatMail {} {
set climit [expr $limit-1]
set cutoff 50
set continuation 0
-
+
while {[string length $line] > $limit} {
for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
set char [string index $line $c]
@@ -652,19 +665,18 @@ test for-6.5 {Tcl_ForObjCmd: number of args} {
} {wrong # args: should be "for start test next command"}
test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
set z for
- list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
+ list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
("for" initial command)
invoked from within
"$z {set} {$i < 5} {incr i} {body}"}}
-test for-6.7 {Tcl_ForObjCmd: error in test expression} -match glob -body {
+test for-6.7 {Tcl_ForObjCmd: error in test expression} -body {
set z for
- list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
-} -result {1 {syntax error in expression "i < 5": * preceding $*} {syntax error in expression "i < 5": * preceding $*
- while executing
-"$z {set i 0} {i < 5} {incr i} {body}"}}
+ catch {$z {set i 0} {i < 5} {incr i} {body}}
+ set ::errorInfo
+} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"}
test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
set z for
set i 0
@@ -674,7 +686,7 @@ test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
set z for
catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
@@ -711,7 +723,7 @@ test for-6.12 {Tcl_ForObjCmd: computed command body} {
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
set z for
catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
- set errorInfo
+ set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
@@ -814,7 +826,369 @@ test for-6.18 {Tcl_ForObjCmd: for command result} {
1 {invoked "continue" outside of a loop} \
]
-
+test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [break] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [continue] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[break] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[continue] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [apply {{} {return -code break}}] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [apply {{} {return -code continue}}] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[apply {{} {
+ return -code continue
+ }}] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+ return -code break
+ }}] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+ return -code continue
+ }}] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+ return -code break
+ }}] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory {
+ apply {{} {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+ return -code continue
+ }}] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
+ apply {op {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [{*}$op] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code break}
+} 0
+test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
+ apply {op {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [{*}$op] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code continue}
+} 0
+test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
+ apply {op {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[{*}$op] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code break}
+} 0
+test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
+ apply {op {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[{*}$op] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code continue}
+} 0
+test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
+ apply {op {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code break}
+} 0
+test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
+ apply {op {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code continue}
+} 0
+test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
+ apply {op {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code break}
+} 0
+test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
+ apply {op {
+ set l [lrepeat 50 p q r]
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+ puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+ }]
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }} {return -level 0 -code continue}
+} 0
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/foreach.test b/tests/foreach.test
index 9f4b5b0..6fd5476 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.9 2003/03/27 13:19:15 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -73,8 +71,11 @@ catch {unset a}
test foreach-1.14 {foreach errors} {
catch {unset a}
set a(0) 44
- list [catch {foreach a {1 2 3} {}} msg] $msg
-} {1 {couldn't set loop variable: "a"}}
+ list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+ (setting foreach loop variable "a")
+ invoked from within
+"foreach a {1 2 3} {}"}}
test foreach-1.15 {foreach errors} {
list [catch {foreach {} {} {}} msg] $msg
} {1 {foreach varlist is empty}}
@@ -163,7 +164,7 @@ test foreach-3.1 {compiled foreach backward jump works correctly} {
test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
catch {unset x}
foreach {12.0} {a b c} {
- set x 12.0
+ set x 12.0
set x [expr $x + 1]
}
set x
@@ -210,7 +211,7 @@ test foreach-6.4 {break tests} {
catch {break foo} msg
set msg
} {wrong # args: should be "break"}
-# Check for bug #406709
+# Check for bug #406709
test foreach-6.5 {break tests} {
proc a {} {
set a 1
@@ -221,7 +222,6 @@ test foreach-6.5 {break tests} {
} {2}
# Test for incorrect "double evaluation" semantics
-
test foreach-7.1 {delayed substitution of body} {
proc foo {} {
set a 0
@@ -233,8 +233,62 @@ test foreach-7.1 {delayed substitution of body} {
foo
} {0}
+# Test for [Bug 1189274]; crash on failure
+test foreach-8.1 {empty list handling} {
+ proc crash {} {
+ rename crash {}
+ set a "x y z"
+ set b ""
+ foreach aa $a bb $b { set x "aa = $aa bb = $bb" }
+ }
+ crash
+} {}
+
+# [Bug 1671138]; infinite loop with empty var list in bytecompiled version
+test foreach-9.1 {compiled empty var list} {
+ proc foo {} {
+ foreach {} x {
+ error "reached body"
+ }
+ }
+ list [catch { foo } msg] $msg
+} {1 {foreach varlist is empty}}
+
+test foreach-9.2 {line numbers} -setup {
+ proc linenumber {} {dict get [info frame -1] line}
+} -body {
+ apply {n {
+ foreach x y {*}{
+ } {return [incr n -[linenumber]]}
+ }} [linenumber]
+} -cleanup {
+ rename linenumber {}
+} -result 1
+
+test foreach-10.1 {foreach: [Bug 1671087]} -setup {
+ proc demo {} {
+ set vals {1 2 3 4}
+ trace add variable x write {string length $vals ;# }
+ foreach {x y} $vals {format $y}
+ }
+} -body {
+ demo
+} -cleanup {
+ 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}
+catch {rename foo {}}
::tcltest::cleanupTests
return
diff --git a/tests/format.test b/tests/format.test
index a6e2242..27eac31 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -9,25 +9,25 @@
#
# 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.21 2005/07/28 18:42:32 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+# %u output depends on word length, so this test is not portable.
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint wideIs64bit \
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
test format-1.2 {integer formatting} {
format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} { 6 34 16923 -12 -1 0xe 0XC}
-
-# %u output depends on word length, so this test is not portable.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
test format-1.3 {integer formatting} longIs32bit {
format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} { 6 34 16923 4294967284 -1 0}
@@ -43,10 +43,8 @@ test format-1.5 {integer formatting} {
test format-1.6 {integer formatting} {
format "%00*d" 6 34
} {000034}
-
# Printing negative numbers in hex or octal format depends on word
# length, so these tests are not portable.
-
test format-1.7 {integer formatting} longIs32bit {
format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} { 6 22 421b fffffff4}
@@ -77,6 +75,9 @@ test format-1.11 {integer formatting} longIs32bit {
test format-1.11.1 {integer formatting} longIs64bit {
format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
} {06 042 041033 01777777777777777777764}
+test format-1.12 {integer formatting} {
+ format "%b %#b %llb" 5 5 [expr {2**100}]
+} {101 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-2.1 {string formatting} {
format "%s %s %c %s" abcd {This is a very long test string.} 120 x
@@ -288,7 +289,7 @@ test format-8.1 {error conditions} {
test format-8.2 {error conditions} {
catch format msg
set msg
-} {wrong # args: should be "format formatString ?arg arg ...?"}
+} {wrong # args: should be "format formatString ?arg ...?"}
test format-8.3 {error conditions} {
catch {format %*d}
} 1
@@ -381,6 +382,10 @@ test format-10.4 {"h" format specifier} {
# Bug 1154163: This is minimal behaviour for %hx specifier!
format %hx 1
} 1
+test format-10.5 {"h" format specifier} {
+ # Bug 1284178: Highly out-of-range values shouldn't cause errors
+ format %hu 0x100000000
+} 0
test format-11.1 {XPG3 %$n specifiers} {
format {%2$d %1$d} 4 5
@@ -422,6 +427,7 @@ test format-11.12 {XPG3 %$n specifiers} {
test format-12.1 {negative width specifiers} {
format "%*d" -47 25
} {25 }
+
test format-13.1 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
@@ -471,6 +477,7 @@ test format-13.5 {tcl_precision fuzzy comparison} {
set c [expr $a + $b]
format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}
+
test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
format {%s} ""
} {}
@@ -490,6 +497,12 @@ test format-15.3 {testing %0..s 0 padding for chars/strings} {
test format-15.4 {testing %0..s 0 padding for chars/strings} {
format %05c 61
} {0000=}
+test format-15.5 {testing %d space padding for integers} {
+ format "(% 1d) (% 1d)" 10 -10
+} {( 10) (-10)}
+test format-15.6 {testing %d plus padding for integers} {
+ format "(%+1d) (%+1d)" 10 -10
+} {(+10) (-10)}
set a "0123456789"
set b ""
@@ -498,19 +511,14 @@ for {set i 0} {$i < 290} {incr i} {
}
for {set i 290} {$i < 400} {incr i} {
test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
- format {%s} $b
+ format {%s} $b
} $b
append b "x"
}
-::tcltest::testConstraint wideIs64bit \
- [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
-::tcltest::testConstraint wideBiggerThanInt \
- [expr {wide(0x80000000) != int(0x80000000)}]
-
test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
- list [catch {format %d 7810179016327718216} msg] $msg
-} {1 {integer value too large to represent}}
+ format %d 7810179016327718216
+} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
format %ld 7810179016327718216
} 7810179016327718216
@@ -526,14 +534,11 @@ test format-18.1 {do not demote existing numeric values} {
# Ensure $a and $b are separate objects
set b 0xaaaa
append b aaaa
-
set result [expr {$a == $b}]
format %08lx $b
lappend result [expr {$a == $b}]
-
set b 0xaaaa
append b aaaa
-
lappend result [expr {$a == $b}]
format %08x $b
lappend result [expr {$a == $b}]
@@ -541,17 +546,28 @@ test format-18.1 {do not demote existing numeric values} {
test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
set a [expr {0xaaaaaaaaaa + 1}]
set b 0xaaaaaaaaab
- list [catch {format %08x $a} msg] $msg [expr {$a == $b}]
-} {1 {integer value too large to represent} 1}
+ 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}
+test format-19.2 {Bug 1867855} {
+ format %llx 0
+} 0
+test format-19.3 {Bug 2830354} {
+ string length [format %340f 0]
+} 340
+# Note that this test may fail in future versions
+test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
+ set x [dict create a b c d]
+ 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 "*"}
+
# cleanup
catch {unset a}
catch {unset b}
@@ -559,3 +575,7 @@ catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
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 b283b1a..c562796 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -1,17 +1,15 @@
# Commands covered: history
#
-# 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: history.test,v 1.6 2004/05/19 12:43:03 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
@@ -35,7 +33,7 @@ if {[testConstraint history]} {
# Dummy value, must be numeric
set num 0
}
-
+
# "history event"
test history-1.1 {event option} history {history event -1} \
@@ -245,8 +243,8 @@ test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
catch {history gorp} msg
set msg
-} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
-
+} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/http.test b/tests/http.test
index 86811f4..a0a26de 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -1,23 +1,18 @@
# Commands covered: http::config, http::geturl, http::wait, http::reset
#
# This file contains a collection of tests for the http script library.
-# 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) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
-# 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.38 2004/05/25 22:56:33 hobbs 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 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
if {[catch {package require http 2} version]} {
if {[info exists http2]} {
@@ -56,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]} {
@@ -81,117 +75,118 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
set port [lindex [fconfigure $listen -sockname] 2]
}
}
-
-
+
test http-1.1 {http::config} {
+ http::config -useragent UserAgent
http::config
-} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"]
-
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
test http-1.2 {http::config} {
http::config -proxyfilter
} http::ProxyRequired
-
test http-1.3 {http::config} {
catch {http::config -junk}
} 1
-
test http-1.4 {http::config} {
set savedconf [http::config]
http::config -proxyhost nowhere.come -proxyport 8080 \
-proxyfilter myFilter -useragent "Tcl Test Suite" \
-urlencoding iso8859-1
set x [http::config]
- http::config {expand}$savedconf
+ http::config {*}$savedconf
set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
-
-test http-1.5 {http::config} {
- list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
-} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}}
-
-test http-1.6 {http::config} {
+test http-1.5 {http::config} -returnCodes error -body {
+ http::config -proxyhost {} -junk 8080
+} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
+test http-1.6 {http::config} -setup {
+ set oldenc [http::config -urlencoding]
+} -body {
set enc [list [http::config -urlencoding]]
http::config -urlencoding iso8859-1
lappend enc [http::config -urlencoding]
- http::config -urlencoding [lindex $enc 0]
- set enc
-} {utf-8 iso8859-1}
-
+} -cleanup {
+ http::config -urlencoding $oldenc
+} -result {utf-8 iso8859-1}
test http-2.1 {http::reset} {
catch {http::reset http#1}
} 0
-test http-3.1 {http::geturl} {
- list [catch {http::geturl -bogus flag} msg] $msg
-} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}}
-
-test http-3.2 {http::geturl} {
- catch {http::geturl http:junk} err
- set err
-} {Unsupported URL: http:junk}
-
-set url [info hostname]:$port
-set badurl [info hostname]:6666
-test http-3.3 {http::geturl} {
+test http-3.1 {http::geturl} -returnCodes error -body {
+ http::geturl -bogus flag
+} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
+test http-3.2 {http::geturl} -returnCodes error -body {
+ http::geturl http:junk
+} -result {Unsupported URL: http:junk}
+set url //[info hostname]:$port
+set badurl //[info hostname]:[expr $port+1]
+test http-3.3 {http::geturl} -body {
set token [http::geturl $url]
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"
-
set tail /a/b/c
-set url [info hostname]:$port/a/b/c
-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
-
-test http-3.4 {http::geturl} {
+set url //[info hostname]:$port/a/b/c
+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 authorityurl //[info hostname]:$port
+set ipv6url http://\[::1\]:$port/
+test http-3.4 {http::geturl} -body {
set token [http::geturl $url]
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
-
proc selfproxy {host} {
global port
return [list [info hostname] $port]
}
-test http-3.5 {http::geturl} {
+test http-3.5 {http::geturl} -body {
http::config -proxyfilter selfproxy
set token [http::geturl $url]
- http::config -proxyfilter http::ProxyRequired
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::config -proxyfilter http::ProxyRequired
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
+<h2>GET http:$url</h2>
</body></html>"
-
-test http-3.6 {http::geturl} {
+test http-3.6 {http::geturl} -body {
http::config -proxyfilter bogus
set token [http::geturl $url]
- http::config -proxyfilter http::ProxyRequired
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::config -proxyfilter http::ProxyRequired
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
-
-test http-3.7 {http::geturl} {
+test http-3.7 {http::geturl} -body {
set token [http::geturl $url -headers {Pragma no-cache}]
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
-
-test http-3.8 {http::geturl} {
+test http-3.8 {http::geturl} -body {
set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>POST $tail</h2>
<h2>Query</h2>
@@ -200,13 +195,13 @@ test http-3.8 {http::geturl} {
<dt>Foo<dd>Bar
</dl>
</body></html>"
-
-test http-3.9 {http::geturl} {
+test http-3.9 {http::geturl} -body {
set token [http::geturl $url -validate 1]
http::code $token
-} "HTTP/1.0 200 OK"
-
-test http-3.10 {http::geturl queryprogress} {
+} -cleanup {
+ http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.10 {http::geturl queryprogress} -setup {
set query foo=bar
set sep ""
set i 0
@@ -216,19 +211,20 @@ test http-3.10 {http::geturl queryprogress} {
append query $sep$query
set sep &
}
-
+} -body {
proc postProgress {token x y} {
global postProgress
lappend postProgress $y
}
set postProgress {}
- set t [http::geturl $posturl -query $query \
+ set t [http::geturl $posturl -keepalive 0 -query $query \
-queryprogress postProgress -queryblocksize 16384]
http::wait $t
list [http::status $t] [string length $query] $postProgress [http::data $t]
-} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
-
-test http-3.11 {http::geturl querychannel with -command} {
+} -cleanup {
+ http::cleanup $t
+} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
+test http-3.11 {http::geturl querychannel with -command} -setup {
set query foo=bar
set sep ""
set i 0
@@ -239,8 +235,8 @@ test http-3.11 {http::geturl querychannel with -command} {
set sep &
}
set file [makeFile $query outdata]
+} -body {
set fp [open $file]
-
proc asyncCB {token} {
global postResult
lappend postResult [http::data $token]
@@ -249,7 +245,6 @@ test http-3.11 {http::geturl querychannel with -command} {
set t [http::geturl $posturl -querychannel $fp]
http::wait $t
set testRes [list [http::status $t] [string length $query] [http::data $t]]
-
# Now do async
http::cleanup $t
close $fp
@@ -258,20 +253,17 @@ test http-3.11 {http::geturl querychannel with -command} {
set postResult [list PostStart]
http::wait $t
close $fp
-
lappend testRes [http::status $t] $postResult
+} -cleanup {
removeFile outdata
- set testRes
-} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
-
-# On Linux platforms when the client and server are on the same
-# host, the client is unable to read the server's response one
-# it hits the write error. The status is "eof"
-
-# On Windows, the http::wait procedure gets a
-# "connection reset by peer" error while reading the reply
-
-test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
+ http::cleanup $t
+} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
+# On Linux platforms when the client and server are on the same host, the
+# client is unable to read the server's response one it hits the write error.
+# The status is "eof".
+# On Windows, the http::wait procedure gets a "connection reset by peer" error
+# while reading the reply.
+test http-3.12 {http::geturl querychannel with aborted request} -setup {
set query foo=bar
set sep ""
set i 0
@@ -282,8 +274,8 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
set sep &
}
set file [makeFile $query outdata]
+} -constraints {nonPortable} -body {
set fp [open $file]
-
proc asyncCB {token} {
global postResult
lappend postResult [http::data $token]
@@ -301,86 +293,198 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
http::wait $t
upvar #0 $t state
} err]} {
- puts $errorInfo
+ puts $::errorInfo
error $err
}
-
- removeFile outdata
list [http::status $t] [http::code $t]
-} {ok {HTTP/1.0 200 Data follows}}
-
+} -cleanup {
+ removeFile outdata
+ http::cleanup $t
+} -result {ok {HTTP/1.0 200 Data follows}}
test http-3.13 {http::geturl socket leak test} {
set chanCount [llength [file channels]]
for {set i 0} {$i < 3} {incr i} {
- catch {http::geturl $badurl -timeout 5000}
+ catch {http::geturl $badurl -timeout 5000}
}
# No extra channels should be taken
expr {[llength [file channels]] == $chanCount}
} 1
-
-test http-3.14 "http::geturl $fullurl" {
+test http-3.14 "http::geturl $fullurl" -body {
set token [http::geturl $fullurl -validate 1]
http::code $token
-} "HTTP/1.0 200 OK"
-
-test http-4.1 {http::Event} {
- set token [http::geturl $url]
+} -cleanup {
+ http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.15 {http::geturl parse failures} -body {
+ http::geturl "{invalid}:url"
+} -returnCodes error -result {Unsupported URL: {invalid}:url}
+test http-3.16 {http::geturl parse failures} -body {
+ http::geturl http:relative/url
+} -returnCodes error -result {Unsupported URL: http:relative/url}
+test http-3.17 {http::geturl parse failures} -body {
+ http::geturl /absolute/url
+} -returnCodes error -result {Missing host part: /absolute/url}
+test http-3.18 {http::geturl parse failures} -body {
+ http::geturl http://somewhere:123456789/
+} -returnCodes error -result {Invalid port number: 123456789}
+test http-3.19 {http::geturl parse failures} -body {
+ http::geturl http://{user}@somewhere
+} -returnCodes error -result {Illegal characters in URL user}
+test http-3.20 {http::geturl parse failures} -body {
+ http::geturl http://%user@somewhere
+} -returnCodes error -result {Illegal encoding character usage "%us" in URL user}
+test http-3.21 {http::geturl parse failures} -body {
+ http::geturl http://somewhere/{path}
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.22 {http::geturl parse failures} -body {
+ http::geturl http://somewhere/%path
+} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path}
+test http-3.23 {http::geturl parse failures} -body {
+ http::geturl http://somewhere/path?{query}?
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.24 {http::geturl parse failures} -body {
+ http::geturl http://somewhere/path?%query
+} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
+test http-3.25 {http::meta} -setup {
+ unset -nocomplain m token
+} -body {
+ set token [http::geturl $url -timeout 2000]
+ array set m [http::meta $token]
+ lsort [array names m]
+} -cleanup {
+ http::cleanup $token
+ unset -nocomplain m token
+} -result {Content-Length Content-Type Date}
+test http-3.26 {http::meta} -setup {
+ unset -nocomplain m token
+} -body {
+ set token [http::geturl $url -headers {X-Check 1} -timeout 2000]
+ array set m [http::meta $token]
+ lsort [array names m]
+} -cleanup {
+ 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 IPv6 address} -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-3.30 {http::geturl query without path} -body {
+ set token [http::geturl $authorityurl?var=val]
+ http::ncode $token
+} -cleanup {
+ catch { http::cleanup $token }
+} -result 200
+test http-3.31 {http::geturl fragment without path} -body {
+ set token [http::geturl "$authorityurl#fragment42"]
+ http::ncode $token
+} -cleanup {
+ catch { http::cleanup $token }
+} -result 200
+test http-4.1 {http::Event} -body {
+ set token [http::geturl $url -keepalive 0]
upvar #0 $token data
array set meta $data(meta)
- expr ($data(totalsize) == $meta(Content-Length))
-} 1
-
-test http-4.2 {http::Event} {
+ expr {($data(totalsize) == $meta(Content-Length))}
+} -cleanup {
+ http::cleanup $token
+} -result 1
+test http-4.2 {http::Event} -body {
set token [http::geturl $url]
upvar #0 $token data
array set meta $data(meta)
string compare $data(type) [string trim $meta(Content-Type)]
-} 0
-
-test http-4.3 {http::Event} {
+} -cleanup {
+ http::cleanup $token
+} -result 0
+test http-4.3 {http::Event} -body {
set token [http::geturl $url]
http::code $token
-} {HTTP/1.0 200 Data follows}
-
-test http-4.4 {http::Event} {
+} -cleanup {
+ http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.4 {http::Event} -setup {
set testfile [makeFile "" testfile]
+} -body {
set out [open $testfile w]
set token [http::geturl $url -channel $out]
close $out
set in [open $testfile]
set x [read $in]
- close $in
+} -cleanup {
+ catch {close $in}
+ catch {close $out}
removeFile $testfile
- set x
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
-
-test http-4.5 {http::Event} {
+test http-4.5 {http::Event} -setup {
set testfile [makeFile "" testfile]
+} -body {
set out [open $testfile w]
+ fconfigure $out -translation lf
set token [http::geturl $url -channel $out]
close $out
upvar #0 $token data
+ expr {$data(currentsize) == $data(totalsize)}
+} -cleanup {
removeFile $testfile
- expr $data(currentsize) == $data(totalsize)
-} 1
-
-test http-4.6 {http::Event} {
+ http::cleanup $token
+} -result 1
+test http-4.6 {http::Event} -setup {
set testfile [makeFile "" testfile]
+} -body {
set out [open $testfile w]
set token [http::geturl $binurl -channel $out]
close $out
set in [open $testfile]
fconfigure $in -translation binary
- set x [read $in]
- close $in
+ read $in
+} -cleanup {
+ catch {close $in}
+ catch {close $out}
removeFile $testfile
- set x
-} "$bindata$binurl"
-
+ http::cleanup $token
+} -result "$bindata[string trimleft $binurl /]"
proc myProgress {token total current} {
global progress httpLog
if {[info exists httpLog] && $httpLog} {
@@ -388,161 +492,152 @@ proc myProgress {token total current} {
}
set progress [list $total $current]
}
-if 0 {
- # This test hangs on Windows95 because the client never gets EOF
- set httpLog 1
- test http-4.6 {http::Event} {
- set token [http::geturl $url -blocksize 50 -progress myProgress]
- set progress
- } {111 111}
-}
-test http-4.7 {http::Event} {
- set token [http::geturl $url -progress myProgress]
- set progress
+test http-4.6.1 {http::Event} knownBug {
+ set token [http::geturl $url -blocksize 50 -progress myProgress]
+ return $progress
} {111 111}
-test http-4.8 {http::Event} {
+test http-4.7 {http::Event} -body {
+ set token [http::geturl $url -keepalive 0 -progress myProgress]
+ return $progress
+} -cleanup {
+ http::cleanup $token
+} -result {111 111}
+test http-4.8 {http::Event} -body {
set token [http::geturl $url]
http::status $token
-} {ok}
-test http-4.9 {http::Event} {
+} -cleanup {
+ http::cleanup $token
+} -result {ok}
+test http-4.9 {http::Event} -body {
set token [http::geturl $url -progress myProgress]
http::code $token
-} {HTTP/1.0 200 Data follows}
-test http-4.10 {http::Event} {
+} -cleanup {
+ http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.10 {http::Event} -body {
set token [http::geturl $url -progress myProgress]
http::size $token
-} {111}
-
+} -cleanup {
+ http::cleanup $token
+} -result {111}
# Timeout cases
-
-# Short timeout to working server (the test server)
-# This lets us try a reset during the connection
-
-test http-4.11 {http::Event} {
- set token [http::geturl $url -timeout 1 -command {#}]
+# Short timeout to working server (the test server). This lets us try a
+# reset during the connection.
+test http-4.11 {http::Event} -body {
+ set token [http::geturl $url -timeout 1 -keepalive 0 -command \#]
http::reset $token
http::status $token
-} {reset}
-
-# Longer timeout with reset
-
-test http-4.12 {http::Event} {
- set token [http::geturl $url/?timeout=10 -command {#}]
+} -cleanup {
+ http::cleanup $token
+} -result {reset}
+# Longer timeout with reset.
+test http-4.12 {http::Event} -body {
+ set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
http::reset $token
http::status $token
-} {reset}
-
-# Medium timeout to working server that waits even longer
-# The timeout hits while waiting for a reply
-
-test http-4.13 {http::Event} {
- set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]
+} -cleanup {
+ http::cleanup $token
+} -result {reset}
+# Medium timeout to working server that waits even longer. The timeout
+# hits while waiting for a reply.
+test http-4.13 {http::Event} -body {
+ set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#]
http::wait $token
http::status $token
-} {timeout}
-
-# Longer timeout to good host, bad port, gets an error
-# after the connection "completes" but the socket is bad
-
-test http-4.14 {http::Event} {
- set code [catch {
- set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]
- if {[string length $token] == 0} {
- error "bogus return from http::geturl"
- }
- http::wait $token
- http::status $token
- } err]
- # error code varies among platforms.
- list $code [regexp {(connect failed|couldn't open socket)} $err]
-} {1 1}
-
+} -cleanup {
+ http::cleanup $token
+} -result {timeout}
+# Longer timeout to good host, bad port, gets an error after the
+# connection "completes" but the socket is bad.
+test http-4.14 {http::Event} -body {
+ set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#]
+ if {$token eq ""} {
+ error "bogus return from http::geturl"
+ }
+ http::wait $token
+ lindex [http::error $token] 0
+} -cleanup {
+ catch {http::cleanup $token}
+} -result {connect failed connection refused}
# Bogus host
-
-test http-4.15 {http::Event} {
- # This test may fail if you use a proxy server. That is to be
+test http-4.15 {http::Event} -body {
+ # This test may fail if you use a proxy server. That is to be
# expected and is not a problem with Tcl.
- set code [catch {
- set token [http::geturl not_a_host.tcl.tk -timeout 1000 -command {#}]
- http::wait $token
- http::status $token
- } err]
- # error code varies among platforms.
- list $code [string match "couldn't open socket*" $err]
-} {1 1}
+ set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#]
+ http::wait $token
+ http::status $token
+ # error codes vary among platforms.
+} -cleanup {
+ catch {http::cleanup $token}
+} -returnCodes 1 -match glob -result "couldn't open socket*"
test http-5.1 {http::formatQuery} {
http::formatQuery name1 value1 name2 "value two"
-} {name1=value1&name2=value+two}
-
+} {name1=value1&name2=value%20two}
# 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=%7ebwelch&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=%7ebwelch&name2=%a1%a2%a2}
+} {name1=~bwelch&name2=%A1%A2%A2}
-test http-6.1 {http::ProxyRequired} {
+test http-6.1 {http::ProxyRequired} -body {
http::config -proxyhost [info hostname] -proxyport $port
set token [http::geturl $url]
http::wait $token
- http::config -proxyhost {} -proxyport {}
upvar #0 $token data
set data(body)
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+ http::config -proxyhost {} -proxyport {}
+ http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
+<h2>GET http:$url</h2>
</body></html>"
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}
-
-test http-7.3 {http::formatQuery} {
+} {%E2%88%88}
+test http-7.3 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
+} -returnCodes error -body {
# this would be reverting to http <=2.4 behavior
http::config -urlencoding ""
- set res [list [catch {http::mapReply "\u2208"} msg] $msg]
+ http::mapReply "\u2208"
+} -cleanup {
http::config -urlencoding $enc
- set res
-} [list 1 "can't read \"formMap(\u2208)\": no such element in array"]
-
-test http-7.4 {http::formatQuery} {
+} -result "can't read \"formMap(\u2208)\": no such element in array"
+test http-7.4 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
+} -body {
# this would be reverting to http <=2.4 behavior w/o errors
# (unknown chars become '?')
http::config -urlencoding "iso8859-1"
- set res [http::mapReply "\u2208"]
+ http::mapReply "\u2208"
+} -cleanup {
http::config -urlencoding $enc
- set res
-} {%3f}
-
+} -result {%3F}
+
# cleanup
catch {unset url}
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
}
@@ -553,3 +648,7 @@ if {[info exists removeHttpd]} {
rename bgerror {}
::tcltest::cleanupTests
+
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/http11.test b/tests/http11.test
new file mode 100644
index 0000000..230ce5a
--- /dev/null
+++ b/tests/http11.test
@@ -0,0 +1,656 @@
+# http11.test -- -*- tcl-*-
+#
+# Test HTTP/1.1 features.
+#
+# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# 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::*
+
+package require http 2.8
+
+# start the server
+variable httpd_output
+proc create_httpd {} {
+ proc httpd_read {chan} {
+ variable httpd_output
+ if {[gets $chan line] != -1} {
+ #puts stderr "read '$line'"
+ set httpd_output $line
+ }
+ if {[eof $chan]} {
+ puts stderr "eof from httpd"
+ fileevent $chan readable {}
+ close $chan
+ }
+ }
+ variable httpd_output
+ set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl]
+ set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+]
+ fconfigure $httpd -buffering line -blocking 0
+ fileevent $httpd readable [list httpd_read $httpd]
+ vwait httpd_output
+ variable httpd_port [lindex $httpd_output 2]
+ return $httpd
+}
+
+proc halt_httpd {} {
+ variable httpd_output
+ variable httpd
+ if {[info exists httpd]} {
+ puts $httpd "quit"
+ vwait httpd_output
+ close $httpd
+ }
+ unset -nocomplain httpd_output httpd
+}
+
+proc meta {tok {key ""}} {
+ set meta [http::meta $tok]
+ if {$key ne ""} {
+ if {[dict exists $meta $key]} {
+ return [dict get $meta $key]
+ } else {
+ return ""
+ }
+ }
+ return $meta
+}
+
+proc check_crc {tok args} {
+ set crc [meta $tok x-crc32]
+ 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"
+ }
+ return "ok"
+}
+
+makeFile "<html><head><title>test</title></head>\
+<body><p>this is a test</p>\n\
+[string repeat {<p>This is a tcl test file.</p>} 4192]\n\
+</body></html>" testdoc.html
+
+# -------------------------------------------------------------------------
+
+test http11-1.0 "normal request for document " -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close}
+
+test http11-1.1 "normal,gzip,non-chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -headers {accept-encoding gzip}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok gzip {}}
+
+test http11-1.2 "normal,deflated,non-chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -headers {accept-encoding deflate}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok deflate {}}
+
+test http11-1.3 "normal,compressed,non-chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -headers {accept-encoding compress}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok compress {}}
+
+test http11-1.4 "normal,identity,non-chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -headers {accept-encoding identity}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} {}}
+
+test http11-1.5 "normal request for document, unsupported coding" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -headers {accept-encoding unsupported}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {}}
+
+test http11-1.6 "normal, specify 1.1 " -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -protocol 1.1 -timeout 10000]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close chunked}
+
+test http11-1.7 "normal, 1.1 and keepalive " -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+
+test http11-1.8 "normal, 1.1 and keepalive, server close" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {}}
+
+test http11-1.9 "normal,gzip,chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -headers {accept-encoding gzip}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok gzip chunked}
+
+test http11-1.10 "normal,deflate,chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -headers {accept-encoding deflate}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok deflate chunked}
+
+test http11-1.11 "normal,compress,chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -headers {accept-encoding compress}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok compress chunked}
+
+test http11-1.12 "normal,identity,chunked" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -headers {accept-encoding identity}]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+
+# -------------------------------------------------------------------------
+
+test http11-2.0 "-channel" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close chunked}
+
+test http11-2.1 "-channel, encoding gzip" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close gzip chunked}
+
+test http11-2.2 "-channel, encoding deflate" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close deflate chunked}
+
+test http11-2.3 "-channel,encoding compress" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan \
+ -headers {accept-encoding compress}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close compress chunked}
+
+test http11-2.4 "-channel,encoding identity" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan \
+ -headers {accept-encoding identity}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
+
+test http11-2.5 "-channel,encoding unsupported" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan \
+ -headers {accept-encoding unsupported}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
+
+test http11-2.6 "-channel,encoding gzip,non-chunked" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]\
+ [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0}
+
+test http11-2.7 "-channel,encoding deflate,non-chunked" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]\
+ [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0}
+
+test http11-2.8 "-channel,encoding compress,non-chunked" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 5000 -channel $chan -headers {accept-encoding compress}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]\
+ [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close compress {} 0}
+
+test http11-2.9 "-channel,encoding identity,non-chunked" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 5000 -channel $chan -headers {accept-encoding identity}]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]\
+ [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0}
+
+test http11-2.10 "-channel,deflate,keepalive" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 5000 -channel $chan -keepalive 1]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]\
+ [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0}
+
+test http11-2.11 "-channel,identity,keepalive" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -headers {accept-encoding identity} \
+ -timeout 5000 -channel $chan -keepalive 1]
+ http::wait $tok
+ seek $chan 0
+ set data [read $chan]
+ list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+ [meta $tok connection] [meta $tok content-encoding]\
+ [meta $tok transfer-encoding]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}
+
+# -------------------------------------------------------------------------
+#
+# The following tests for the -handler option will require changes in
+# the future. At the moment we cannot handler chunked data with this
+# option. Therefore we currently force HTTP/1.0 protocol version.
+#
+# Once this is solved, these tests should be fixed to assume chunked
+# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1
+
+proc handler {var sock token} {
+ upvar #0 $var data
+ set chunk [read $sock]
+ append data $chunk
+ #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
+ if {[eof $sock]} {
+ #::http::Log "handler eof $sock"
+ chan event $sock readable {}
+ }
+}
+
+test http11-3.0 "-handler,close,identity" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -handler [namespace code [list handler testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.1 "-handler,protocol1.0" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+ -timeout 10000 -protocol 1.0 \
+ -handler [namespace code [list handler testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.2 "-handler,close,chunked" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -keepalive 0 -binary 1\
+ -handler [namespace code [list handler testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.3 "-handler,keepalive,chunked" -setup {
+ variable httpd [create_httpd]
+ set testdata ""
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -timeout 10000 -keepalive 1 -binary 1\
+ -handler [namespace code [list handler testdata]]]
+ http::wait $tok
+ list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+ [meta $tok connection] [meta $tok content-encoding] \
+ [meta $tok transfer-encoding] \
+ [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+ http::cleanup $tok
+ unset -nocomplain testdata
+ halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-4.0 "normal post request" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set query [http::formatQuery q 1 z 2]
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -query $query -timeout 10000]
+ http::wait $tok
+ list status [http::status $tok] code [http::code $tok]\
+ crc [check_crc $tok]\
+ connection [meta $tok connection]\
+ query-length [meta $tok x-query-length]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http11-4.1 "normal post request, check query length" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set query [http::formatQuery q 1 z 2]
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+ -headers [list x-check-query yes] \
+ -query $query -timeout 10000]
+ http::wait $tok
+ list status [http::status $tok] code [http::code $tok]\
+ crc [check_crc $tok]\
+ connection [meta $tok connection]\
+ query-length [meta $tok x-query-length]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http11-4.2 "normal post request, check long query length" -setup {
+ variable httpd [create_httpd]
+} -body {
+ set query [string repeat a 24576]
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+ -headers [list x-check-query yes]\
+ -query $query -timeout 10000]
+ http::wait $tok
+ list status [http::status $tok] code [http::code $tok]\
+ crc [check_crc $tok]\
+ connection [meta $tok connection]\
+ query-length [meta $tok x-query-length]
+} -cleanup {
+ http::cleanup $tok
+ halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576}
+
+test http11-4.3 "normal post request, check channel query length" -setup {
+ variable httpd [create_httpd]
+ set chan [open [makeFile {} testfile.tmp] wb+]
+ puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192]
+ flush $chan
+ seek $chan 0
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+ -headers [list x-check-query yes]\
+ -querychannel $chan -timeout 10000]
+ http::wait $tok
+ list status [http::status $tok] code [http::code $tok]\
+ crc [check_crc $tok]\
+ connection [meta $tok connection]\
+ query-length [meta $tok x-query-length]
+} -cleanup {
+ http::cleanup $tok
+ close $chan
+ removeFile testfile.tmp
+ halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}
+
+# -------------------------------------------------------------------------
+
+foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
+ if {[llength [info proc $p]]} {rename $p {}}
+}
+removeFile testdoc.html
+unset -nocomplain httpd_port httpd p
+
+::tcltest::cleanupTests
diff --git a/tests/httpd b/tests/httpd
index f41c3c1..232e80a 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -1,3 +1,4 @@
+# -*- tcl -*-
#
# The httpd_ procedures implement a stub http server.
#
@@ -6,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
@@ -27,7 +26,7 @@ array set httpdErrors {
404 {Not Found}
503 {Service Unavailable}
504 {Service Temporarily Unavailable}
- }
+}
proc httpdError {sock code args} {
global httpdErrors
@@ -41,7 +40,7 @@ proc httpdAccept {newsock ipaddr port} {
fconfigure $newsock -blocking 0 -translation {auto crlf}
httpd_log $newsock Connect $ipaddr $port
set data(ipaddr) $ipaddr
- fileevent $newsock readable [list httpdRead $newsock]
+ after 50 [list fileevent $newsock readable [list httpdRead $newsock]]
}
# read data from a client request
@@ -56,8 +55,8 @@ proc httpdRead { sock } {
# Read the protocol line and parse out the URL and query
set readCount [gets $sock line]
- if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} \
- $line x data(proto) data(url) data(query) data(httpversion)] {
+ if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \
+ -> data(proto) data(url) data(query) data(httpversion)]} {
set data(state) mime
httpd_log $sock Query $line
} else {
@@ -71,6 +70,10 @@ proc httpdRead { sock } {
# Read the HTTP headers
set readCount [gets $sock line]
+ if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
+ lappend data(meta) $key [string trim $val]
+ }
+
} elseif {$data(state) == "query"} {
# Read the query data
@@ -96,7 +99,7 @@ proc httpdRead { sock } {
}
0,mime,HEAD -
0,mime,GET -
- 0,query,POST {
+ 0,query,POST {
# Empty line at end of headers,
# or eof after query data
httpdRespond $sock
@@ -172,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
@@ -192,19 +203,27 @@ proc httpdRespond { sock } {
append html </body></html>
}
}
-
- # Catch errors from premature client closes
+ # Catch errors from premature client closes
+
catch {
if {$data(proto) == "HEAD"} {
puts $sock "HTTP/1.0 200 OK"
} else {
- puts $sock "HTTP/1.0 200 Data follows"
+ # Split the response to test for [Bug 26245326]
+ puts -nonewline $sock "HT"
+ flush $sock
+ puts $sock "TP/1.0 200 Data follows"
}
puts $sock "Date: [clock format [clock seconds] \
-format {%a, %d %b %Y %H:%M:%S %Z}]"
puts $sock "Content-Type: $type"
puts $sock "Content-Length: [string length $html]"
+ foreach {key val} $data(meta) {
+ if {[string match "X-*" $key]} {
+ puts $sock "$key: $val"
+ }
+ }
puts $sock ""
flush $sock
if {$data(proto) != "HEAD"} {
@@ -215,5 +234,3 @@ proc httpdRespond { sock } {
httpd_log $sock Done ""
httpdSockDone $sock
}
-
-
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
new file mode 100644
index 0000000..9c543dc
--- /dev/null
+++ b/tests/httpd11.tcl
@@ -0,0 +1,254 @@
+# httpd11.tcl -- -*- tcl -*-
+#
+# A simple httpd for testing HTTP/1.1 client features.
+# Not suitable for use on a internet connected port.
+#
+# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.6
+
+proc ::tcl::dict::get? {dict key} {
+ if {[dict exists $dict $key]} {
+ return [dict get $dict $key]
+ }
+ return
+}
+namespace ensemble configure dict \
+ -map [linsert [namespace ensemble configure dict -map] end get? ::tcl::dict::get?]
+
+proc make-chunk-generator {data {size 4096}} {
+ variable _chunk_gen_uid
+ if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0}
+ set lambda {{data size} {
+ set pos 0
+ yield
+ while {1} {
+ set payload [string range $data $pos [expr {$pos + $size - 1}]]
+ incr pos $size
+ set chunk [format %x [string length $payload]]\r\n$payload\r\n
+ yield $chunk
+ if {![string length $payload]} {return}
+ }
+ }}
+ set name chunker[incr _chunk_gen_uid]
+ coroutine $name ::apply $lambda $data $size
+ return $name
+}
+
+proc get-chunks {data {compression gzip}} {
+ switch -exact -- $compression {
+ gzip { set data [zlib gzip $data] }
+ deflate { set data [zlib deflate $data] }
+ compress { set data [zlib compress $data] }
+ }
+
+ set data ""
+ set chunker [make-chunk-generator $data 512]
+ while {[string length [set chunk [$chunker]]]} {
+ append data $chunk
+ }
+ return $data
+}
+
+proc blow-chunks {data {ochan stdout} {compression gzip}} {
+ switch -exact -- $compression {
+ gzip { set data [zlib gzip $data] }
+ deflate { set data [zlib deflate $data] }
+ compress { set data [zlib compress $data] }
+ }
+
+ set chunker [make-chunk-generator $data 512]
+ while {[string length [set chunk [$chunker]]]} {
+ puts -nonewline $ochan $chunk
+ }
+ return
+}
+
+proc mime-type {filename} {
+ switch -exact -- [file extension $filename] {
+ .htm - .html { return {text text/html}}
+ .png { return {binary image/png} }
+ .jpg { return {binary image/jpeg} }
+ .gif { return {binary image/gif} }
+ .css { return {text text/css} }
+ .xml { return {text text/xml} }
+ .xhtml {return {text application/xml+html} }
+ .svg { return {text image/svg+xml} }
+ .txt - .tcl - .c - .h { return {text text/plain}}
+ }
+ return {binary text/plain}
+}
+
+proc Puts {chan s} {puts $chan $s; puts $s}
+
+proc Service {chan addr port} {
+ chan event $chan readable [info coroutine]
+ while {1} {
+ set meta {}
+ chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
+ chan configure $chan -blocking 0
+ yield
+ while {[gets $chan line] < 0} {
+ if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
+ yield
+ }
+ if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
+ foreach {req url protocol} {GET {} HTTP/1.1} break
+ regexp {^(\S+)\s+(.*)\s(\S+)?$} $line -> req url protocol
+
+ puts $line
+ while {[gets $chan line] > 0} {
+ if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
+ puts [list $key [string trim $val]]
+ lappend meta [string tolower $key] [string trim $val]
+ }
+ yield
+ }
+
+ set encoding identity
+ set transfer ""
+ set close 1
+ set type text/html
+ set code "404 Not Found"
+ set data "<html><head><title>Error 404</title></head>"
+ append data "<body><h1>Not Found</h1><p>Try again.</p></body></html>"
+
+ if {[scan $url {%[^?]?%s} path query] < 2} {
+ set query ""
+ }
+
+ switch -exact -- $req {
+ GET - HEAD {
+ }
+ POST {
+ # Read the query.
+ set qlen [dict get? $meta content-length]
+ if {[string is integer -strict $qlen]} {
+ chan configure $chan -buffering none -translation binary
+ while {[string length $query] < $qlen} {
+ append query [read $chan $qlen]
+ if {[string length $query] < $qlen} {yield}
+ }
+ # Check for excess query bytes [Bug 2715421]
+ if {[dict get? $meta x-check-query] eq "yes"} {
+ chan configure $chan -blocking 0
+ append query [read $chan]
+ }
+ }
+ }
+ default {
+ # invalid request error 5??
+ }
+ }
+ if {$query ne ""} {puts $query}
+
+ set path [string trimleft $path /]
+ set path [file join [pwd] $path]
+ if {[file exists $path] && [file isfile $path]} {
+ foreach {what type} [mime-type $path] break
+ set f [open $path r]
+ if {$what eq "binary"} {chan configure $f -translation binary}
+ set data [read $f]
+ close $f
+ set code "200 OK"
+ set close [expr {[dict get? $meta connection] eq "close"}]
+ }
+
+ if {$protocol eq "HTTP/1.1"} {
+ if {[string match "*deflate*" [dict get? $meta accept-encoding]]} {
+ set encoding deflate
+ } elseif {[string match "*gzip*" [dict get? $meta accept-encoding]]} {
+ set encoding gzip
+ } elseif {[string match "*compress*" [dict get? $meta accept-encoding]]} {
+ set encoding compress
+ }
+ set transfer chunked
+ } else {
+ set close 1
+ }
+
+ foreach pair [split $query &] {
+ if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
+ switch -exact -- $key {
+ close {set close 1 ; set transfer 0}
+ transfer {set transfer $val}
+ content-type {set type $val}
+ }
+ }
+
+ chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
+ Puts $chan "$protocol $code"
+ Puts $chan "content-type: $type"
+ Puts $chan [format "x-crc32: %08x" [zlib crc32 $data]]
+ if {$req eq "POST"} {
+ Puts $chan [format "x-query-length: %d" [string length $query]]
+ }
+ if {$close} {
+ Puts $chan "connection: close"
+ }
+ if {$encoding eq "identity"} {
+ Puts $chan "content-length: [string length $data]"
+ } else {
+ Puts $chan "content-encoding: $encoding"
+ }
+ if {$transfer eq "chunked"} {
+ Puts $chan "transfer-encoding: chunked"
+ }
+ puts $chan ""
+ flush $chan
+
+ chan configure $chan -buffering full -translation binary
+ if {$transfer eq "chunked"} {
+ blow-chunks $data $chan $encoding
+ } elseif {$encoding ne "identity"} {
+ puts -nonewline $chan [zlib $encoding $data]
+ } else {
+ puts -nonewline $chan $data
+ }
+
+ if {$close} {
+ chan event $chan readable {}
+ close $chan
+ puts "close $chan"
+ return
+ } else {
+ flush $chan
+ }
+ puts "pipeline $chan"
+ }
+}
+
+proc Accept {chan addr port} {
+ coroutine client$chan Service $chan $addr $port
+ return
+}
+
+proc Control {chan} {
+ if {[gets $chan line] != -1} {
+ if {[string trim $line] eq "quit"} {
+ set ::forever 1
+ }
+ }
+ if {[eof $chan]} {
+ chan event $chan readable {}
+ }
+}
+
+proc Main {{port 0}} {
+ set server [socket -server Accept -myaddr localhost $port]
+ puts [chan configure $server -sockname]
+ flush stdout
+ chan event stdin readable [list Control stdin]
+ vwait ::forever
+ close $server
+ return "done"
+}
+
+if {!$tcl_interactive} {
+ set r [catch [linsert $argv 0 Main] err]
+ if {$r} {puts stderr $errorInfo} elseif {[string length $err]} {puts $err}
+ exit $r
+}
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 aec98f4..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.8 2004/09/26 16:36:06 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -20,85 +18,109 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Basic "if" operation.
catch {unset a}
-test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
- list [catch {if} msg] $msg
-} {1 {wrong # args: no expression after "if" argument}}
-test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
- list [catch {if {[error "error in condition"]} foo} msg] $msg
-} {1 {error in condition}}
+test if-1.1 {TclCompileIfCmd: missing if/elseif test} -body {
+ if
+} -returnCodes error -result {wrong # args: no expression after "if" argument}
+test if-1.2 {TclCompileIfCmd: error in if/elseif test} -body {
+ if {[error "error in condition"]} foo
+} -returnCodes error -result {error in condition}
test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body {
- list [catch {if {1+}} msg] $msg $errorInfo
-} -match glob -result {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression*
- while *ing
-"if {1+}"}}
-test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
+ list [catch {if {1+}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+ unset msg
+} -result {1 * {*"if {1+}"}}
+test if-1.4 {TclCompileIfCmd: if/elseif test in braces} -body {
set a {}
if {1<2} {set a 1}
- set a
-} {1}
-test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
+ return $a
+} -cleanup {
+ unset a
+} -result {1}
+test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} -body {
set a {}
if 1<2 {set a 1}
- set a
-} {1}
-test if-1.6 {TclCompileIfCmd: multiline test expr} {
+ return $a
+} -cleanup {
+ unset a
+} -result {1}
+test if-1.6 {TclCompileIfCmd: multiline test expr} -setup {
set a {}
+} -body {
if {($tcl_platform(platform) != "foobar1") && \
($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
- set a
-} 3
-test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
+ return $a
+} -cleanup {
+ unset a
+} -result 3
+test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} -body {
set a {}
if 4>3 then {set a 1}
- set a
-} {1}
-test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
+ return $a
+} -cleanup {
+ unset a
+} -result {1}
+test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} -setup {
set a {}
- catch {if 1<2 therefore {set a 1}} msg
- set msg
-} {invalid command name "therefore"}
-test if-1.9 {TclCompileIfCmd: missing "then" body} {
+} -body {
+ if 1<2 therefore {set a 1}
+} -cleanup {
+ unset a
+} -returnCodes error -result {invalid command name "therefore"}
+test if-1.9 {TclCompileIfCmd: missing "then" body} -setup {
set a {}
- catch {if 1<2 then} msg
- set msg
-} {wrong # args: no script following "then" argument}
+} -body {
+ if 1<2 then
+} -cleanup {
+ unset a
+} -returnCodes error -result {wrong # args: no script following "then" argument}
test if-1.10 {TclCompileIfCmd: error in "then" body} -body {
set a {}
- list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+ unset a msg
+} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}}
-test if-1.11 {TclCompileIfCmd: error in "then" body} {
- list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
-} {1 {error in then clause}}
-test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
+test if-1.11 {TclCompileIfCmd: error in "then" body} -body {
+ if 2 then {[error "error in then clause"]}
+} -returnCodes error -result {error in then clause}
+test if-1.12 {TclCompileIfCmd: "then" body in quotes} -body {
set a {}
if 27>17 "append a x"
- set a
-} {x}
-test if-1.13 {TclCompileIfCmd: computed "then" body} {
+ return $a
+} -cleanup {
+ unset a
+} -result {x}
+test if-1.13 {TclCompileIfCmd: computed "then" body} -setup {
catch {unset x1}
catch {unset x2}
- set a {}
+} -body {
set x1 {append a x1}
set x2 {; append a x2}
set a {}
if 1 $x1$x2
- set a
-} {x1x2}
-test if-1.14 {TclCompileIfCmd: taking proper branch} {
+ return $a
+} -cleanup {
+ unset a x1 x2
+} -result {x1x2}
+test if-1.14 {TclCompileIfCmd: taking proper branch} -body {
set a {}
if 1<2 {set a 1}
- set a
-} 1
-test if-1.15 {TclCompileIfCmd: taking proper branch} {
+ return $a
+} -cleanup {
+ unset a
+} -result 1
+test if-1.15 {TclCompileIfCmd: taking proper branch} -body {
set a {}
if 1>2 {set a 1}
- set a
-} {}
-test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
+ return $a
+} -cleanup {
+ unset a
+} -result {}
+test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} -setup {
catch {unset i}
set a {}
+} -body {
if 1<2 {
set a 1
while {$a != "xxx"} {
@@ -148,40 +170,54 @@ test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long
}
set a 3
}
- set a
-} 3
-test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result 3
+test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} -setup {
set a {}
- list [catch {if {"0 < 3"} {set a 1}} msg] $msg
-} {1 {expected boolean value but got "0 < 3"}}
-
+} -body {
+ if {"0 < 3"} {set a 1}
+} -returnCodes error -cleanup {
+ unset a
+} -result {expected boolean value but got "0 < 3"}
-test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
+test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} -setup {
set a {}
+} -body {
if 3>4 {set a 1} elseif 1 {set a 2}
- set a
-} {2}
+ return $a
+} -cleanup {
+ unset a
+} -result {2}
# Since "else" is optional, the "elwood" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
-test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
+test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} -setup {
set a {}
- catch {if 1<2 {set a 1} elwood {set a 2}} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
+} -body {
+ if 1<2 {set a 1} elwood {set a 2}
+} -returnCodes error -cleanup {
+ unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} -setup {
set a {}
- catch {if 1<2 {set a 1} elseif} msg
- set msg
-} {wrong # args: no expression after "elseif" argument}
-test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body {
+} -body {
+ if 1<2 {set a 1} elseif
+} -returnCodes error -cleanup {
+ unset a
+} -result {wrong # args: no expression after "elseif" argument}
+test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -setup {
set a {}
- list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} -match glob -result {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression*
- while *ing
-"if 3>4 {set a 1} elseif {1>}"}}
-test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
+} -body {
+ list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+ unset a msg
+} -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}}
+test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} -setup {
catch {unset i}
set a {}
+} -body {
if 1>2 {
set a 1
while {$a != "xxx"} {
@@ -279,44 +315,59 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
}
set a 6
}
- set a
-} 6
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result 6
-test if-3.1 {TclCompileIfCmd: "else" clause} {
+test if-3.1 {TclCompileIfCmd: "else" clause} -body {
set a {}
if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
- set a
-} 3
+ return $a
+} -cleanup {
+ unset a
+} -result 3
# Since "else" is optional, the "elsex" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
-test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
+test if-3.2 {TclCompileIfCmd: keyword other than "else"} -setup {
set a {}
- catch {if 1<2 then {set a 1} elsex {set a 2}} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-3.3 {TclCompileIfCmd: missing body after "else"} {
+} -body {
+ if 1<2 then {set a 1} elsex {set a 2}
+} -returnCodes error -cleanup {
+ unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-3.3 {TclCompileIfCmd: missing body after "else"} -setup {
set a {}
- catch {if 2<1 {set a 1} else} msg
- set msg
-} {wrong # args: no script following "else" argument}
-test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body {
+} -body {
+ if 2<1 {set a 1} else
+} -returnCodes error -cleanup {
+ unset a
+} -result {wrong # args: no script following "else" argument}
+test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -setup {
set a {}
- catch {if 2<1 {set a 1} else {set}} msg
- set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+} -body {
+ catch {if 2<1 {set a 1} else {set}}
+ set ::errorInfo
+} -match glob -cleanup {
+ unset a
+} -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
-test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
+test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} -setup {
set a {}
- catch {if 2<1 {set a 1} else {set a 2} or something} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
+} -body {
+ if 2<1 {set a 1} else {set a 2} or something
+} -returnCodes error -cleanup {
+ unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
# The following test also checks whether contained loops and other
# commands are properly relocated because a short jump must be replaced
# by a "long distance" one.
-test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
+test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} -setup {
catch {unset i}
set a {}
+} -body {
if 1>2 {
set a 1
while {$a != "xxx"} {
@@ -462,134 +513,185 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
}
set a 9
}
- set a
-} 9
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result 9
-test if-4.1 {TclCompileIfCmd: "if" command result} {
+test if-4.1 {TclCompileIfCmd: "if" command result} -setup {
set a {}
+} -body {
set a [if 3<4 {set i 27}]
- set a
-} 27
-test if-4.2 {TclCompileIfCmd: "if" command result} {
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result 27
+test if-4.2 {TclCompileIfCmd: "if" command result} -setup {
set a {}
+} -body {
set a [if 3>4 {set i 27}]
- set a
-} {}
-test if-4.3 {TclCompileIfCmd: "if" command result} {
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result {}
+test if-4.3 {TclCompileIfCmd: "if" command result} -setup {
set a {}
+} -body {
set a [if 0 {set i 1} elseif 1 {set i 2}]
- set a
-} 2
-test if-4.4 {TclCompileIfCmd: "if" command result} {
+ return $a
+} -cleanup {
+ unset a
+ unset -nocomplain i
+} -result 2
+test if-4.4 {TclCompileIfCmd: "if" command result} -setup {
set a {}
+} -body {
set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
- set a
-} 4
-test if-4.5 {TclCompileIfCmd: return value} {
+ return $a
+} -cleanup {
+ unset a i
+} -result 4
+test if-4.5 {TclCompileIfCmd: return value} -body {
if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
-} def
+} -cleanup {
+ unset -nocomplain a
+} -result def
# Check "if" and computed command names.
-catch {unset a}
-test if-5.1 {if cmd with computed command names: missing if/elseif test} {
+test if-5.1 {if cmd with computed command names: missing if/elseif test} -body {
set z if
- list [catch {$z} msg] $msg
-} {1 {wrong # args: no expression after "if" argument}}
-
-test if-5.2 {if cmd with computed command names: error in if/elseif test} {
+ $z
+} -returnCodes error -cleanup {
+ unset z
+} -result {wrong # args: no expression after "if" argument}
+test if-5.2 {if cmd with computed command names: error in if/elseif test} -body {
set z if
- list [catch {$z {[error "error in condition"]} foo} msg] $msg
-} {1 {error in condition}}
-test if-5.3 {if cmd with computed command names: error in if/elseif test} {
- set z if
- list [catch {$z {1+}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
- while executing
-"$z {1+}"}}
-test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
+ $z {[error "error in condition"]} foo
+} -returnCodes error -cleanup {
+ unset z
+} -result {error in condition}
+test if-5.3 {if cmd with computed command names: error in if/elseif test} -body {
set z if
+ list [catch {$z {1+}}] $::errorInfo
+} -match glob -cleanup {
+ unset z
+} -result {1 {*"$z {1+}"}}
+test if-5.4 {if cmd with computed command names: if/elseif test in braces} -setup {
set a {}
- $z {1<2} {set a 1}
- set a
-} {1}
-test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
+} -body {
set z if
+ $z {1<2} {set a 1}
+ return $a
+} -cleanup {
+ unset a z
+} -result {1}
+test if-5.5 {if cmd with computed command names: if/elseif test not in braces} -setup {
set a {}
+} -body {
+ set z if
$z 1<2 {set a 1}
- set a
-} {1}
-test if-5.6 {if cmd with computed command names: multiline test expr} {
+ return $a
+} -cleanup {
+ unset a z
+} -result {1}
+test if-5.6 {if cmd with computed command names: multiline test expr} -body {
set z if
- set a {}
$z {($tcl_platform(platform) != "foobar1") && \
($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
- set a
-} 3
-test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
- set z if
+ return $a
+} -cleanup {
+ unset a z
+} -result 3
+test if-5.7 {if cmd with computed command names: "then" after if/elseif test} -setup {
set a {}
- $z 4>3 then {set a 1}
- set a
-} {1}
-test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
+} -body {
set z if
+ $z 4>3 then {set a 1}
+ return $a
+} -cleanup {
+ unset a z
+} -result {1}
+test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} -setup {
set a {}
- catch {$z 1<2 therefore {set a 1}} msg
- set msg
-} {invalid command name "therefore"}
-test if-5.9 {if cmd with computed command names: missing "then" body} {
+} -body {
set z if
+ $z 1<2 therefore {set a 1}
+} -returnCodes error -cleanup {
+ unset a z
+} -result {invalid command name "therefore"}
+test if-5.9 {if cmd with computed command names: missing "then" body} -setup {
set a {}
- catch {$z 1<2 then} msg
- set msg
-} {wrong # args: no script following "then" argument}
+} -body {
+ set z if
+ $z 1<2 then
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: no script following "then" argument}
test if-5.10 {if cmd with computed command names: error in "then" body} -body {
set z if
set a {}
- list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+ unset a z msg
+} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
invoked from within
"$z {$a!="xxx"} then {set}"}}
-test if-5.11 {if cmd with computed command names: error in "then" body} {
- set z if
- list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
-} {1 {error in then clause}}
-test if-5.12 {if cmd with computed command names: "then" body in quotes} {
+test if-5.11 {if cmd with computed command names: error in "then" body} -body {
set z if
+ $z 2 then {[error "error in then clause"]}
+} -returnCodes error -cleanup {
+ unset z
+} -result {error in then clause}
+test if-5.12 {if cmd with computed command names: "then" body in quotes} -setup {
set a {}
- $z 27>17 "append a x"
- set a
-} {x}
-test if-5.13 {if cmd with computed command names: computed "then" body} {
+} -body {
set z if
+ $z 27>17 "append a x"
+ return $a
+} -cleanup {
+ unset a z
+} -result {x}
+test if-5.13 {if cmd with computed command names: computed "then" body} -setup {
catch {unset x1}
catch {unset x2}
- set a {}
+} -body {
+ set z if
set x1 {append a x1}
set x2 {; append a x2}
set a {}
$z 1 $x1$x2
- set a
-} {x1x2}
-test if-5.14 {if cmd with computed command names: taking proper branch} {
- set z if
+ return $a
+} -cleanup {
+ unset a z x1 x2
+} -result {x1x2}
+test if-5.14 {if cmd with computed command names: taking proper branch} -setup {
set a {}
- $z 1<2 {set a 1}
- set a
-} 1
-test if-5.15 {if cmd with computed command names: taking proper branch} {
+} -body {
set z if
+ $z 1<2 {set a 1}
+ return $a
+} -cleanup {
+ unset a z
+} -result 1
+test if-5.15 {if cmd with computed command names: taking proper branch} -body {
set a {}
- $z 1>2 {set a 1}
- set a
-} {}
-test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
set z if
+ $z 1>2 {set a 1}
+ return $a
+} -cleanup {
+ unset a z
+} -result {}
+test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} -setup {
catch {unset i}
set a {}
+} -body {
+ set z if
$z 1<2 {
set a 1
while {$a != "xxx"} {
@@ -639,46 +741,60 @@ test if-5.16 {if cmd with computed command names: test jumpFalse instruction rep
}
set a 3
}
- set a
-} 3
-test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
- set z if
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 3
+test if-5.17 {if cmd with computed command names: if/elseif test in quotes} -setup {
set a {}
- list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
-} {1 {expected boolean value but got "0 < 3"}}
-
-
-test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
+} -body {
set z if
+ $z {"0 < 3"} {set a 1}
+} -returnCodes error -cleanup {
+ unset a z
+} -result {expected boolean value but got "0 < 3"}
+
+test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} -setup {
set a {}
+} -body {
+ set z if
$z 3>4 {set a 1} elseif 1 {set a 2}
- set a
-} {2}
+ return $a
+} -cleanup {
+ unset a z
+} -result {2}
# Since "else" is optional, the "elwood" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
-test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
- set z if
+test if-6.2 {if cmd with computed command names: keyword other than "elseif"} -setup {
set a {}
- catch {$z 1<2 {set a 1} elwood {set a 2}} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
+} -body {
set z if
+ $z 1<2 {set a 1} elwood {set a 2}
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-6.3 {if cmd with computed command names: missing expression after "elseif"} -setup {
set a {}
- catch {$z 1<2 {set a 1} elseif} msg
- set msg
-} {wrong # args: no expression after "elseif" argument}
-test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
+} -body {
set z if
+ $z 1<2 {set a 1} elseif
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: no expression after "elseif" argument}
+test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -setup {
set a {}
- list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
- while executing
-"$z 3>4 {set a 1} elseif {1>}"}}
-test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
+} -body {
set z if
+ list [catch {$z 3>4 {set a 1} elseif {1>}}] $::errorInfo
+} -match glob -cleanup {
+ unset a z
+} -result {1 {*"$z 3>4 {set a 1} elseif {1>}"}}
+test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} -setup {
catch {unset i}
set a {}
+} -body {
+ set z if
$z 1>2 {
set a 1
while {$a != "xxx"} {
@@ -776,52 +892,68 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
}
set a 6
}
- set a
-} 6
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 6
-test if-7.1 {if cmd with computed command names: "else" clause} {
- set z if
+test if-7.1 {if cmd with computed command names: "else" clause} -setup {
set a {}
+} -body {
+ set z if
$z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
- set a
-} 3
+ return $a
+} -cleanup {
+ unset a z
+} -result 3
# Since "else" is optional, the "elsex" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
-test if-7.2 {if cmd with computed command names: keyword other than "else"} {
- set z if
+test if-7.2 {if cmd with computed command names: keyword other than "else"} -setup {
set a {}
- catch {$z 1<2 then {set a 1} elsex {set a 2}} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-7.3 {if cmd with computed command names: missing body after "else"} {
+} -body {
set z if
+ $z 1<2 then {set a 1} elsex {set a 2}
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-7.3 {if cmd with computed command names: missing body after "else"} -setup {
set a {}
- catch {$z 2<1 {set a 1} else} msg
- set msg
-} {wrong # args: no script following "else" argument}
-test if-7.4 {if cmd with computed command names: error compiling body after "else"} -body {
+} -body {
set z if
+ $z 2<1 {set a 1} else
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: no script following "else" argument}
+test if-7.4 {if cmd with computed command names: error compiling body after "else"} -setup {
set a {}
- catch {$z 2<1 {set a 1} else {set}} msg
- set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+} -body {
+ set z if
+ catch {$z 2<1 {set a 1} else {set}}
+ return $::errorInfo
+} -match glob -cleanup {
+ unset a z
+} -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"
invoked from within
"$z 2<1 {set a 1} else {set}"}
-test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
- set z if
+test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} -setup {
set a {}
- catch {$z 2<1 {set a 1} else {set a 2} or something} msg
- set msg
-} {wrong # args: extra words after "else" clause in "if" command}
+} -body {
+ set z if
+ $z 2<1 {set a 1} else {set a 2} or something
+} -returnCodes error -cleanup {
+ unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
# The following test also checks whether contained loops and other
# commands are properly relocated because a short jump must be replaced
# by a "long distance" one.
-test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
- set z if
+test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} -setup {
catch {unset i}
set a {}
+} -body {
+ set z if
$z 1>2 {
set a 1
while {$a != "xxx"} {
@@ -967,45 +1099,69 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
}
set a 9
}
- set a
-} 9
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 9
-test if-8.1 {if cmd with computed command names: "if" command result} {
- set z if
+test if-8.1 {if cmd with computed command names: "if" command result} -setup {
set a {}
- set a [$z 3<4 {set i 27}]
- set a
-} 27
-test if-8.2 {if cmd with computed command names: "if" command result} {
+} -body {
set z if
+ set a [$z 3<4 {set i 27}]
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 27
+test if-8.2 {if cmd with computed command names: "if" command result} -setup {
set a {}
- set a [$z 3>4 {set i 27}]
- set a
-} {}
-test if-8.3 {if cmd with computed command names: "if" command result} {
+} -body {
set z if
+ set a [$z 3>4 {set i 27}]
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result {}
+test if-8.3 {if cmd with computed command names: "if" command result} -setup {
set a {}
- set a [$z 0 {set i 1} elseif 1 {set i 2}]
- set a
-} 2
-test if-8.4 {if cmd with computed command names: "if" command result} {
+} -body {
set z if
+ set a [$z 0 {set i 1} elseif 1 {set i 2}]
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 2
+test if-8.4 {if cmd with computed command names: "if" command result} -setup {
set a {}
+} -body {
+ set z if
set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
- set a
-} 4
-test if-8.5 {if cmd with computed command names: return value} {
+ return $a
+} -cleanup {
+ unset a z
+ unset -nocomplain i
+} -result 4
+test if-8.5 {if cmd with computed command names: return value} -body {
set z if
$z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
-} def
+} -cleanup {
+ unset z
+ unset -nocomplain a
+} -result def
-test if-9.1 {if cmd with namespace qualifiers} {
+test if-9.1 {if cmd with namespace qualifiers} -body {
::if {1} {set x 4}
-} 4
+} -cleanup {
+ unset x
+} -result 4
# Test for incorrect "double evaluation semantics"
-test if-10.1 {delayed substitution of then body} {
+test if-10.1 {delayed substitution of then body} -body {
set j 0
set if if
# this is not compiled
@@ -1021,8 +1177,11 @@ test if-10.1 {delayed substitution of then body} {
set result
}
append result [p]
-} {00}
-test if-10.2 {delayed substitution of elseif expression} {
+} -cleanup {
+ unset j if result
+ rename p {}
+} -result {00}
+test if-10.2 {delayed substitution of elseif expression} -body {
set j 0
set if if
# this is not compiled
@@ -1046,8 +1205,11 @@ test if-10.2 {delayed substitution of elseif expression} {
set result
}
append result [p]
-} {00}
-test if-10.3 {delayed substitution of elseif body} {
+} -cleanup {
+ unset j if result
+ rename p {}
+} -result {00}
+test if-10.3 {delayed substitution of elseif body} -body {
set j 0
set if if
# this is not compiled
@@ -1066,23 +1228,30 @@ test if-10.3 {delayed substitution of elseif body} {
"
}
append result [p]
-} {00}
-test if-10.4 {delayed substitution of else body} {
+} -cleanup {
+ unset j if result
+ rename p {}
+} -result {00}
+test if-10.4 {delayed substitution of else body} -body {
set j 0
if {[incr j] == 0} {
set result badthen
} else "
set result $j
"
- set result
-} {0}
-test if-10.5 {substituted control words} {
+ return $result
+} -cleanup {
+ unset j result
+} -result {0}
+test if-10.5 {substituted control words} -body {
set then then; proc then {} {return badthen}
set else else; proc else {} {return badelse}
set elseif elseif; proc elseif {} {return badelseif}
list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
-} {0 ok}
-test if-10.6 {double invocation of variable traces} {
+} -cleanup {
+ unset then else elseif a
+} -result {0 ok}
+test if-10.6 {double invocation of variable traces} -body {
set iftracecounter 0
proc iftraceproc {args} {
upvar #0 iftracecounter counter
@@ -1098,10 +1267,16 @@ test if-10.6 {double invocation of variable traces} {
}
trace variable iftracevar r [list iftraceproc 10]
list [catch {if "$iftracevar + 20" {}} a] $a \
- [catch {if "$iftracevar + 20" {}} b] $b \
- [unset iftracevar iftracecounter]
-} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 {} {}}
+ [catch {if "$iftracevar + 20" {}} b] $b
+} -cleanup {
+ unset iftracevar iftracecounter a b
+} -match glob -result {1 {*} 0 {}}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 95250f8..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.8 2004/11/03 17:16:05 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -47,20 +45,17 @@ test incr-old-2.2 {incr errors} {
} {1 {wrong # args: should be "incr varName ?increment?"}}
test incr-old-2.3 {incr errors} {
catch {unset x}
- list [catch {incr x} msg] $msg $errorInfo
-} {1 {can't read "x": no such variable} {can't read "x": no such variable
- (reading value of variable to increment)
- invoked from within
-"incr x"}}
+ incr x
+} 1
test incr-old-2.4 {incr errors} {
set x abc
- list [catch {incr x} msg] $msg $errorInfo
+ list [catch {incr x} msg] $msg $::errorInfo
} {1 {expected integer but got "abc"} {expected integer but got "abc"
while executing
"incr x"}}
test incr-old-2.5 {incr errors} {
set x 123
- list [catch {incr x 1a} msg] $msg $errorInfo
+ list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
@@ -69,7 +64,7 @@ test incr-old-2.6 {incr errors} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
- list [catch {incr x 1} msg] $msg $errorInfo
+ list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
diff --git a/tests/incr.test b/tests/incr.test
index 07526c4..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.11 2004/11/03 17:16:05 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
@@ -87,9 +88,8 @@ test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
proc p {} {
incr bar
}
- catch {p} msg
- set msg
-} {can't read "bar": no such variable}
+ p
+} 1
test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
proc 260locals {} {
# create 260 locals
@@ -150,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
@@ -176,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"*}
@@ -195,96 +196,88 @@ test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
} 200005
test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
- incr i 000012345 ;# an octal literal
+ 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} {
- list [catch {incr {"foo}} msg] $msg $errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
- (reading value of variable to increment)
- invoked from within
-"incr {"foo}"}}
+ unset -nocomplain {"foo}
+ incr {"foo}
+} 1
test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
- list [catch {incr [set]} msg] $msg $errorInfo
+ list [catch {incr [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
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
- list [catch {incr x 1} msg] $msg $errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+ readonly x
+ list [catch {incr x 1} msg] $msg $::errorInfo
+} -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"
@@ -297,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
@@ -308,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
@@ -331,9 +322,8 @@ test incr-2.13 {incr command (not compiled): simple but new (unknown) local name
set z incr
$z bar
}
- catch {p} msg
- set msg
-} {can't read "bar": no such variable}
+ p
+} 1
test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
proc 260locals {} {
set z incr
@@ -395,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
@@ -426,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"*}
@@ -449,62 +440,56 @@ test incr-2.22 {incr command (not compiled): increment given, large int} {
test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
set z incr
set i 25
- $z i 000012345 ;# an octal literal
+ $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
- list [catch {$z {"foo}} msg] $msg $errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
- (reading value of variable to increment)
- invoked from within
-"$z {"foo}"}}
+ $z {"foo}
+} -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
+ list [catch {$z [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
while *ing
"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
- list [catch {$z x 1} msg] $msg $errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+ readonly x
+ list [catch {$z x 1} msg] $msg $::errorInfo
+} -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
- list [catch {$z x 1a} msg] $msg $errorInfo
+ list [catch {$z x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
"$z x 1a"}}
test incr-2.31 {incr command (compiled): bad increment} {
- list [catch {incr x 1a} msg] $msg $errorInfo
+ list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
(reading increment)
invoked from within
@@ -520,6 +505,18 @@ test incr-3.2 {increment by wide amount: command route} {
$z x 123123123123
} 123123123123
+test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
+ proc x {} {incr a(1)}
+ x
+} -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 7fea854..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.9 2004/11/25 16:37:15 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
+ 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}
@@ -38,6 +40,12 @@ test indexObj-1.6 {forced exact match} testindexobj {
test indexObj-1.7 {forced exact match} testindexobj {
testindexobj 1 0 x abc def xalb xyz alm x
} {5}
+test indexObj-1.8 {exact match of empty values} testindexobj {
+ testindexobj 1 1 {} a aa aaa {} b bb bbb
+} 3
+test indexObj-1.9 {exact match of empty values} testindexobj {
+ testindexobj 1 0 {} a aa aaa {} b bb bbb
+} 3
test indexObj-2.1 {no match} testindexobj {
list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg
@@ -54,6 +62,22 @@ test indexObj-2.4 {ambiguous value} testindexobj {
test indexObj-2.5 {omit error message} testindexobj {
list [catch {testindexobj 0 1 d x} msg] $msg
} {1 {}}
+test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} testindexobj {
+ list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg
+} {1 {bad token "d": must be dumb, daughter, a, or c}}
+test indexObj-2.7 {exact match of empty values} testindexobj {
+ list [catch {testindexobj 1 1 {} a b c} msg] $msg
+} {1 {ambiguous token "": must be a, b, or c}}
+test indexObj-2.8 {exact match of empty values: singleton case} testindexobj {
+ list [catch {testindexobj 1 0 {} a} msg] $msg
+} {1 {bad token "": must be a}}
+test indexObj-2.9 {non-exact match of empty values: singleton case} testindexobj {
+ # NOTE this is a special case. Although the empty string is a
+ # unique prefix, we have an established history of rejecting
+ # empty lookup keys, requiring any unique prefix match to have
+ # at least one character.
+ list [catch {testindexobj 1 1 {} a} msg] $msg
+} {1 {bad token "": must be a}}
test indexObj-3.1 {cache result to skip next lookup} testindexobj {
testindexobj check 42
@@ -66,8 +90,8 @@ test indexObj-4.1 {free old internal representation} testindexobj {
} {2}
test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
- testwrongnumargs 1 "?option?" mycmd
-} "wrong # args: should be \"mycmd ?option?\""
+ testwrongnumargs 1 "?-switch?" mycmd
+} "wrong # args: should be \"mycmd ?-switch?\""
test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "bar" mycmd foo
} "wrong # args: should be \"mycmd foo bar\""
@@ -108,6 +132,35 @@ 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
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/info.test b/tests/info.test
index 9014eee..3057dd2 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
# Commands covered: info
#
# This file contains a collection of tests for one or more of the Tcl
@@ -7,17 +8,21 @@
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006 ActiveState
#
# 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.32 2005/07/29 14:47:47 dkf Exp $
+# DO NOT DELETE THIS LINE
-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]]
+
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
@@ -29,7 +34,6 @@ namespace eval test_ns_info1 {
proc q {{y 27} {z {}}} {return "y=$y"}
}
-
test info-1.1 {info args option} {
proc t1 {a bbb c} {return foo}
info args t1
@@ -42,13 +46,13 @@ test info-1.3 {info args option} {
proc t1 "" {return foo}
info args t1
} {}
-test info-1.4 {info args option} {
+test info-1.4 {info args option} -body {
catch {rename t1 {}}
- list [catch {info args t1} msg] $msg
-} {1 {"t1" isn't a procedure}}
-test info-1.5 {info args option} {
- list [catch {info args set} msg] $msg
-} {1 {"set" isn't a procedure}}
+ info args t1
+} -returnCodes error -result {"t1" isn't a procedure}
+test info-1.5 {info args option} -body {
+ info args set
+} -returnCodes error -result {"set" isn't a procedure}
test info-1.6 {info args option} {
proc t1 {a b} {set c 123; set d $c}
t1 1 2
@@ -66,12 +70,12 @@ test info-2.1 {info body option} {
proc t1 {} {body of t1}
info body t1
} {body of t1}
-test info-2.2 {info body option} {
- list [catch {info body set} msg] $msg
-} {1 {"set" isn't a procedure}}
-test info-2.3 {info body option} {
- list [catch {info args set 1} msg] $msg
-} {1 {wrong # args: should be "info args procname"}}
+test info-2.2 {info body option} -body {
+ info body set
+} -returnCodes error -result {"set" isn't a procedure}
+test info-2.3 {info body option} -body {
+ info args set 1
+} -returnCodes error -result {wrong # args: should be "info args procname"}
test info-2.4 {info body option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
@@ -83,7 +87,7 @@ test info-2.4 {info body option} {
# would return the bytecompiled version of foo, which the catch
# would then try and eval out of the foo context, accessing
# compiled local indices
-test info-2.5 {info body option, returning bytecompiled bodies} {
+test info-2.5 {info body option, returning bytecompiled bodies} -body {
catch {unset args}
proc foo {args} {
foreach v $args {
@@ -92,8 +96,8 @@ test info-2.5 {info body option, returning bytecompiled bodies} {
}
}
foo a
- list [catch [info body foo] msg] $msg
-} {1 {can't read "args": no such variable}}
+ eval [info body foo]
+} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
@@ -107,35 +111,35 @@ proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
set z [info cm]
- expr $z-$x
+ expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
testinfocmdcount
-} 3
-test info-3.2 {info cmdcount evaled} {
+} 4
+test info-3.2 {info cmdcount evaled} -body {
set x [info cmdcount]
set y 12345
set z [info cm]
- expr $z-$x
-} 3
-test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
-test info-3.4 {info cmdcount option} {
- list [catch {info cmdcount 1} msg] $msg
-} {1 {wrong # args: should be "info cmdcount"}}
-
-test info-4.1 {info commands option} {
+ expr {$z-$x}
+} -cleanup {unset x y z} -result 4
+test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
+test info-3.4 {info cmdcount option} -body {
+ info cmdcount 1
+} -returnCodes error -result {wrong # args: should be "info cmdcount"}
+
+test info-4.1 {info commands option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info commands] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* set *} $x] [string match {* list *} $x]
-} {1 1 1 1}
-test info-4.2 {info commands option} {
+} -cleanup {unset x} -result {1 1 1 1}
+test info-4.2 {info commands option} -body {
proc t1 {} {}
rename t1 {}
- set x [info comm]
- string match {* t1 *} $x
-} 0
+ string match {* t1 *} \
+ [info comm]
+} -result 0
test info-4.3 {info commands option} {
proc _t1_ {} {}
proc _t2_ {} {}
@@ -148,14 +152,14 @@ test info-4.4 {info commands option} {
} {_t1_ _t2_}
catch {rename _t1_ {}}
catch {rename _t2_ {}}
-test info-4.5 {info commands option} {
- list [catch {info commands a b} msg] $msg
-} {1 {wrong # args: should be "info commands ?pattern?"}}
+test info-4.5 {info commands option} -returnCodes error -body {
+ info commands a b
+} -result {wrong # args: should be "info commands ?pattern?"}
# Also some tests in namespace.test
-test info-5.1 {info complete option} {
- list [catch {info complete} msg] $msg
-} {1 {wrong # args: should be "info complete command"}}
+test info-5.1 {info complete option} -body {
+ info complete
+} -returnCodes error -result {wrong # args: should be "info complete command"}
test info-5.2 {info complete option} {
info complete abc
} 1
@@ -176,50 +180,52 @@ test info-6.1 {info default option} {
proc t1 {a b {c d} {e "long default value"}} {}
info default t1 a value
} 0
-test info-6.2 {info default option} {
+test info-6.2 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
info d t1 a value
- set value
-} {}
-test info-6.3 {info default option} {
+ return $value
+} -cleanup {unset value} -result {}
+test info-6.3 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
info default t1 c value
-} 1
-test info-6.4 {info default option} {
+} -cleanup {unset value} -result 1
+test info-6.4 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
info default t1 c value
- set value
-} d
-test info-6.5 {info default option} {
+ return $value
+} -cleanup {unset value} -result d
+test info-6.5 {info default option} -body {
proc t1 {a b {c d} {e "long default value"}} {}
set value 12345
set x [info default t1 e value]
list $x $value
-} {1 {long default value}}
-test info-6.6 {info default option} {
- list [catch {info default a b} msg] $msg
-} {1 {wrong # args: should be "info default procname arg varname"}}
-test info-6.7 {info default option} {
- list [catch {info default _nonexistent_ a b} msg] $msg
-} {1 {"_nonexistent_" isn't a procedure}}
-test info-6.8 {info default option} {
+} -cleanup {unset x value} -result {1 {long default value}}
+test info-6.6 {info default option} -returnCodes error -body {
+ info default a b
+} -result {wrong # args: should be "info default procname arg varname"}
+test info-6.7 {info default option} -returnCodes error -body {
+ info default _nonexistent_ a b
+} -result {"_nonexistent_" isn't a procedure}
+test info-6.8 {info default option} -returnCodes error -body {
proc t1 {a b} {}
- list [catch {info default t1 x value} msg] $msg
-} {1 {procedure "t1" doesn't have an argument "x"}}
-test info-6.9 {info default option} {
+ info default t1 x value
+} -result {procedure "t1" doesn't have an argument "x"}
+test info-6.9 {info default option} -returnCodes error -setup {
catch {unset a}
+} -cleanup {unset a} -body {
set a(0) 88
proc t1 {a b} {}
- list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
-test info-6.10 {info default option} {
+ info default t1 a 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} {}
- list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
+ info default t1 a 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 {
@@ -227,27 +233,26 @@ test info-6.11 {info default option} {
list [info default p x foo] $foo [info default q y bar] $bar
}
} {0 {} 1 27}
-catch {unset a}
-test info-7.1 {info exists option} {
+test info-7.1 {info exists option} -body {
set value foo
info exists value
-} 1
-catch {unset _nonexistent_}
-test info-7.2 {info exists option} {
+} -cleanup {unset value} -result 1
+
+test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
info exists _nonexistent_
-} 0
+} -result 0
test info-7.3 {info exists option} {
proc t1 {x} {return [info exists x]}
t1 2
} 1
-test info-7.4 {info exists option} {
+test info-7.4 {info exists option} -body {
proc t1 {x} {
global _nonexistent_
return [info exists _nonexistent_]
}
t1 2
-} 0
+} -setup {unset -nocomplain _nonexistent_} -result 0
test info-7.5 {info exists option} {
proc t1 {x} {
set y 47
@@ -259,42 +264,43 @@ test info-7.6 {info exists option} {
proc t1 {x} {return [info exists value]}
t1 2
} 0
-test info-7.7 {info exists option} {
+test info-7.7 {info exists option} -setup {
catch {unset x}
+} -body {
set x(2) 44
list [info exists x] [info exists x(1)] [info exists x(2)]
-} {1 0 1}
+} -result {1 0 1}
catch {unset x}
-test info-7.8 {info exists option} {
- list [catch {info exists} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-test info-7.9 {info exists option} {
- list [catch {info exists 1 2} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-
-test info-8.1 {info globals option} {
+test info-7.8 {info exists option} -body {
+ info exists
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+test info-7.9 {info exists option} -body {
+ info exists 1 2
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+
+test info-8.1 {info globals option} -body {
set x 1
set y 2
set value 23
set a " [info globals] "
list [string match {* x *} $a] [string match {* y *} $a] \
[string match {* value *} $a] [string match {* _foobar_ *} $a]
-} {1 1 1 0}
-test info-8.2 {info globals option} {
+} -cleanup {unset x y value a} -result {1 1 1 0}
+test info-8.2 {info globals option} -body {
set _xxx1 1
set _xxx2 2
lsort [info g _xxx*]
-} {_xxx1 _xxx2}
-test info-8.3 {info globals option} {
- list [catch {info globals 1 2} msg] $msg
-} {1 {wrong # args: should be "info globals ?pattern?"}}
-test info-8.4 {info globals option: may have leading namespace qualifiers} {
+} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
+test info-8.3 {info globals option} -returnCodes error -body {
+ info globals 1 2
+} -result {wrong # args: should be "info globals ?pattern?"}
+test info-8.4 {info globals option: may have leading namespace qualifiers} -body {
set x 0
list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
-} {x {} x x x}
+} -cleanup {unset x} -result {x {} x x x}
test info-8.5 {info globals option: only return existing global variables} {
-setup {
- catch {unset ::NO_SUCH_VAR}
+ unset -nocomplain ::NO_SUCH_VAR
proc evalInProc script {eval $script}
}
-body {
@@ -335,51 +341,69 @@ test info-9.4 {info level option} {
}
t1
} {1 t1}
-test info-9.5 {info level option} {
- list [catch {info level 1 2} msg] $msg
-} {1 {wrong # args: should be "info level ?number?"}}
-test info-9.6 {info level option} {
- list [catch {info level 123a} msg] $msg
-} {1 {expected integer but got "123a"}}
-test info-9.7 {info level option} {
- list [catch {info level 0} msg] $msg
-} {1 {bad level "0"}}
-test info-9.8 {info level option} {
+test info-9.5 {info level option} -body {
+ info level 1 2
+} -returnCodes error -result {wrong # args: should be "info level ?number?"}
+test info-9.6 {info level option} -body {
+ info level 123a
+} -returnCodes error -result {expected integer but got "123a"}
+test info-9.7 {info level option} -body {
+ info level 0
+} -returnCodes error -result {bad level "0"}
+test info-9.8 {info level option} -body {
proc t1 {} {info level -1}
- list [catch {t1} msg] $msg
-} {1 {bad level "-1"}}
-test info-9.9 {info level option} {
+ t1
+} -returnCodes error -result {bad level "-1"}
+test info-9.9 {info level option} -body {
proc t1 {x} {info level $x}
- list [catch {t1 -3} msg] $msg
-} {1 {bad level "-3"}}
-test info-9.10 {info level option, namespaces} {
- set msg [namespace eval t {info level 0}]
+ t1 -3
+} -returnCodes error -result {bad level "-3"}
+test info-9.10 {info level option, namespaces} -body {
+ namespace eval t {info level 0}
+} -cleanup {
namespace delete t
- set msg
-} {namespace eval t {info level 0}}
+} -result {namespace eval t {info level 0}}
+test info-9.11 {info level option, aliases} -constraints knownBug -setup {
+ proc w {x y z} {info level 0}
+ interp alias {} a {} w a b
+} -body {
+ a c
+} -cleanup {
+ rename a {}
+ rename w {}
+} -result {a c}
+test info-9.12 {info level option, ensembles} -constraints knownBug -setup {
+ proc w {x y z} {info level 0}
+ namespace ensemble create -command a -map {foo ::w}
+} -body {
+ a foo 1 2 3
+} -cleanup {
+ rename a {}
+ rename w {}
+} -result {a foo 1 2 3}
set savedLibrary $tcl_library
-test info-10.1 {info library option} {
- list [catch {info library x} msg] $msg
-} {1 {wrong # args: should be "info library"}}
+test info-10.1 {info library option} -body {
+ info library x
+} -returnCodes error -result {wrong # args: should be "info library"}
test info-10.2 {info library option} {
set tcl_library 12345
info library
} {12345}
-test info-10.3 {info library option} {
+test info-10.3 {info library option} -body {
unset tcl_library
- list [catch {info library} msg] $msg
-} {1 {no library has been specified for Tcl}}
-set tcl_library $savedLibrary
-
-test info-11.1 {info loaded option} {
- list [catch {info loaded a b} msg] $msg
-} {1 {wrong # args: should be "info loaded ?interp?"}}
-test info-11.2 {info loaded option} {
- list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
-} {0 1 {could not find interpreter "gorp"}}
-
-test info-12.1 {info locals option} {
+ info library
+} -returnCodes error -result {no library has been specified for Tcl}
+set tcl_library $savedLibrary; unset savedLibrary
+
+test info-11.1 {info loaded option} -body {
+ info loaded a b
+} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
+test info-11.2 {info loaded option} -body {
+ info loaded {}; info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
+
+test info-12.1 {info locals option} -body {
set a 22
proc t1 {x y} {
set b 13
@@ -390,7 +414,7 @@ test info-12.1 {info locals option} {
return [info locals]
}
lsort [t1 23 24]
-} {b c x y}
+} -cleanup {unset a aa} -result {b c x y}
test info-12.2 {info locals option} {
proc t1 {x y} {
set xx1 2
@@ -400,9 +424,9 @@ test info-12.2 {info locals option} {
}
lsort [t1 2 3]
} {x xx1 xx2}
-test info-12.3 {info locals option} {
- list [catch {info locals 1 2} msg] $msg
-} {1 {wrong # args: should be "info locals ?pattern?"}}
+test info-12.3 {info locals option} -body {
+ info locals 1 2
+} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
test info-12.4 {info locals option} {
info locals
} {}
@@ -426,32 +450,33 @@ test info-12.7 {info locals with temporary variables} {
t1
} {a}
-test info-13.1 {info nameofexecutable option} {
- list [catch {info nameofexecutable foo} msg] $msg
-} {1 {wrong # args: should be "info nameofexecutable"}}
+test info-13.1 {info nameofexecutable option} -returnCodes error -body {
+ info nameofexecutable foo
+} -result {wrong # args: should be "info nameofexecutable"}
-test info-14.1 {info patchlevel option} {
+test info-14.1 {info patchlevel option} -body {
set a [info patchlevel]
regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
-} 1
-test info-14.2 {info patchlevel option} {
- list [catch {info patchlevel a} msg] $msg
-} {1 {wrong # args: should be "info patchlevel"}}
-test info-14.3 {info patchlevel option} {
+} -cleanup {unset a} -result 1
+test info-14.2 {info patchlevel option} -returnCodes error -body {
+ info patchlevel a
+} -result {wrong # args: should be "info patchlevel"}
+test info-14.3 {info patchlevel option} -setup {
set t $tcl_patchLevel
+} -body {
unset tcl_patchLevel
- set result [list [catch {info patchlevel} msg] $msg]
- set tcl_patchLevel $t
- set result
-} {1 {can't read "tcl_patchLevel": no such variable}}
+ info patchlevel
+} -cleanup {
+ set tcl_patchLevel $t; unset t
+} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
-test info-15.1 {info procs option} {
+test info-15.1 {info procs option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info procs] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* _undefined_ *} $x]
-} {1 1 0}
+} -cleanup {unset x} -result {1 1 0}
test info-15.2 {info procs option} {
proc _tt1 {} {}
proc _tt2 {} {}
@@ -459,19 +484,21 @@ test info-15.2 {info procs option} {
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
-test info-15.3 {info procs option} {
- list [catch {info procs 2 3} msg] $msg
-} {1 {wrong # args: should be "info procs ?pattern?"}}
-test info-15.4 {info procs option} {
+test info-15.3 {info procs option} -body {
+ info procs 2 3
+} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
+test info-15.4 {info procs option} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
proc r {} {}
- list [info procs] [info procs p*]
+ list [lsort [info procs]] [info procs p*]
}
-} {{p q r} p}
-test info-15.5 {info procs option with a proc in a namespace} {
+} -result {{p q r} p}
+test info-15.5 {info procs option with a proc in a namespace} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
proc p1 { arg } {
puts cmd
@@ -481,9 +508,10 @@ test info-15.5 {info procs option with a proc in a namespace} {
}
}
info procs ::test_ns_info2::p1
-} {::test_ns_info2::p1}
-test info-15.6 {info procs option with a pattern in a namespace} {
+} -result {::test_ns_info2::p1}
+test info-15.6 {info procs option with a pattern in a namespace} -setup {
catch {namespace delete test_ns_info2}
+} -body {
namespace eval test_ns_info2 {
proc p1 { arg } {
puts cmd
@@ -493,9 +521,10 @@ test info-15.6 {info procs option with a pattern in a namespace} {
}
}
lsort [info procs ::test_ns_info2::p*]
-} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
-test info-15.7 {info procs option with a global shadowing proc} {
+} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
+test info-15.7 {info procs option with a global shadowing proc} -setup {
catch {namespace delete test_ns_info2}
+} -body {
proc string_cmd { arg } {
puts cmd
}
@@ -505,12 +534,13 @@ test info-15.7 {info procs option with a global shadowing proc} {
}
}
info procs test_ns_info2::string*
-} {::test_ns_info2::string_cmd}
+} -result {::test_ns_info2::string_cmd}
# This regression test is currently commented out because it requires
# that the implementation of "info procs" looks into the global namespace,
# which it does not (in contrast to "info commands")
-test info-15.8 {info procs option with a global shadowing proc} knownBug {
+test info-15.8 {info procs option with a global shadowing proc} -setup {
catch {namespace delete test_ns_info2}
+} -constraints knownBug -body {
proc string_cmd { arg } {
puts cmd
}
@@ -525,11 +555,11 @@ test info-15.8 {info procs option with a global shadowing proc} knownBug {
namespace eval test_ns_info2 {
lsort [info procs string*]
}
-} [lsort [list string_cmd string_cmd2]]
+} -result [lsort [list string_cmd string_cmd2]]
-test info-16.1 {info script option} {
- list [catch {info script x x} msg] $msg
-} {1 {wrong # args: should be "info script ?filename?"}}
+test info-16.1 {info script option} -returnCodes error -body {
+ info script x x
+} -result {wrong # args: should be "info script ?filename?"}
test info-16.2 {info script option} {
file tail [info sc]
} "info.test"
@@ -545,45 +575,45 @@ test info-16.5 {resetting "info script" after errors} {
catch {source _nonexistent_}
file tail [info script]
} "info.test"
-test info-16.6 {info script option} {
+test info-16.6 {info script option} -body {
set script [info script]
list [file tail [info script]] \
[info script newname.txt] \
[file tail [info script $script]]
-} [list info.test newname.txt info.test]
-test info-16.7 {info script option} {
+} -result [list info.test newname.txt info.test] -cleanup {unset script}
+test info-16.7 {info script option} -body {
set script [info script]
info script newname.txt
list [source $gorpfile] [file tail [info script]] \
[file tail [info script $script]]
-} [list $gorpfile newname.txt info.test]
+} -result [list $gorpfile newname.txt info.test] -cleanup {unset script}
removeFile gorp.info
set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
test info-16.8 {info script option} {
list [source $gorpfile] [file tail [info script]]
} [list [list $gorpfile foo.bar] info.test]
-removeFile gorp.info
+removeFile gorp.info; unset gorpfile
-test info-17.1 {info sharedlibextension option} {
- list [catch {info sharedlibextension foo} msg] $msg
-} {1 {wrong # args: should be "info sharedlibextension"}}
-
-test info-18.1 {info tclversion option} {
- set x [info tclversion]
- scan $x "%d.%d%c" a b c
-} 2
-test info-18.2 {info tclversion option} {
- list [catch {info t 2} msg] $msg
-} {1 {wrong # args: should be "info tclversion"}}
-test info-18.3 {info tclversion option} {
- set t $tcl_version
+test info-17.1 {info sharedlibextension option} -returnCodes error -body {
+ info sharedlibextension foo
+} -result {wrong # args: should be "info sharedlibextension"}
+
+test info-18.1 {info tclversion option} -body {
+ scan [info tclversion] "%d.%d%c" a b c
+} -cleanup {unset -nocomplain a b c} -result 2
+test info-18.2 {info tclversion option} -body {
+ info t 2
+} -returnCodes error -result {wrong # args: should be "info tclversion"}
+test info-18.3 {info tclversion option} -body {
unset tcl_version
- set result [list [catch {info tclversion} msg] $msg]
- set tcl_version $t
- set result
-} {1 {can't read "tcl_version": no such variable}}
+ info tclversion
+} -returnCodes error -setup {
+ set t $tcl_version
+} -cleanup {
+ set tcl_version $t; unset t
+} -result {can't read "tcl_version": no such variable}
-test info-19.1 {info vars option} {
+test info-19.1 {info vars option} -body {
set a 1
set b 2
proc t1 {x y} {
@@ -592,8 +622,8 @@ test info-19.1 {info vars option} {
return [info vars]
}
lsort [t1 18 19]
-} {a b c x y}
-test info-19.2 {info vars option} {
+} -cleanup {unset a b} -result {a b c x y}
+test info-19.2 {info vars option} -body {
set xxx1 1
set xxx2 2
proc t1 {xxa y} {
@@ -602,13 +632,13 @@ test info-19.2 {info vars option} {
return [info vars x*]
}
lsort [t1 18 19]
-} {xxa xxx1 xxx2}
+} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
lsort [info vars]
} [lsort [info globals]]
-test info-19.4 {info vars option} {
- list [catch {info vars a b} msg] $msg
-} {1 {wrong # args: should be "info vars ?pattern?"}}
+test info-19.4 {info vars option} -returnCodes error -body {
+ info vars a b
+} -result {wrong # args: should be "info vars ?pattern?"}
test info-19.5 {info vars with temporary variables} {
proc t1 {} {
foreach a {b c} {}
@@ -625,11 +655,10 @@ test info-19.6 {info vars: Bug 1072654} -setup {
namespace delete x
} -result {}
+set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide}
# Check whether the extra testing functions are defined...
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
- set functions {abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
-} else {
- set functions {T1 T2 T3 abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
+if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} {
+ set functions "T1 T2 T3 $functions" ;# A lazy way of prepending!
}
test info-20.1 {info functions option} {info functions sin} sin
test info-20.2 {info functions option} {lsort [info functions]} $functions
@@ -639,25 +668,1735 @@ test info-20.3 {info functions option} {
test info-20.4 {info functions option} {
lsort [info functions *tan*]
} {atan atan2 tan tanh}
-test info-20.5 {info functions option} {
- list [catch {info functions raise an error} msg] $msg
-} {1 {wrong # args: should be "info functions ?pattern?"}}
-
-test info-21.1 {miscellaneous error conditions} {
- list [catch {info} msg] $msg
-} {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-21.2 {miscellaneous error conditions} {
- list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.3 {miscellaneous error conditions} {
- list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.4 {miscellaneous error conditions} {
- list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.5 {miscellaneous error conditions} {
- list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-20.5 {info functions option} -returnCodes error -body {
+ info functions raise an error
+} -result {wrong # args: should be "info functions ?pattern?"}
+unset functions msg
+
+test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
+ info
+} -result {wrong # args: should be "info subcommand ?arg ...?"}
+test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
+ info gorp
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
+ info c
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
+ info l
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
+ info s
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+
+##
+# ### ### ### ######### ######### #########
+## 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 cmd [dict get $frame cmd]
+ if {[regexp \n $cmd]} {
+ dict set frame cmd \
+ [string range [lindex [split $cmd \n] 0] 0 end-4]
+ }
+ if {[dict exists $frame file]} {
+ dict set frame file \
+ [file tail [dict get $frame file]]
+ }
+ return $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
+# implementation of tcltest. Any changes and these tests will have to
+# be updated.
+
+proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+}
+
+test info-22.0 {info frame, levels} {!singleTestInterp} {
+ info frame
+} 7
+test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
+ # catch is another level!, i.e. we have 8, not 7
+ catch {info frame -8} msg
+ set msg
+} {bad level "-8"}
+test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
+ # catch is another level!, i.e. we have 8, not 7
+ catch {info frame 9} msg
+ set msg
+} {bad level "9"}
+test info-22.3 {info frame, current, relative} -match glob -body {
+ info frame 0
+} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-22.4 {info frame, current, relative, nested} -match glob -body {
+ set res [info frame 0]
+} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
+test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
+ reduce [info frame 7]
+} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
+test info-22.6 {info frame, global, relative} {!singleTestInterp} {
+ reduce [info frame -6]
+} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
+test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
+ reduce [info frame 1]
+} {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 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
+
+test info-23.0.0 {eval'd info frame} {!singleTestInterp} {
+ eval {info frame}
+} 8
+test info-23.0.1 {eval'd info frame} -constraints {singleTestInterp} -match glob -body {
+ eval {info frame}
+} -result {1[12]} ;# SingleTestInterp results changes depending on running the whole suite, or info.test alone.
+test info-23.1.0 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
+ eval info frame
+} 8
+test info-23.1.1 {eval'd info frame, semi-dynamic} -constraints {singleTestInterp} -match glob -body {
+ eval info frame
+} -result {1[12]}
+test info-23.2.0 {eval'd info frame, dynamic} -constraints {!singleTestInterp} -body {
+ set script {info frame}
+ eval $script
+} -cleanup {unset script} -result 8
+test info-23.2.1 {eval'd info frame, dynamic} -constraints {singleTestInterp} -match glob -body {
+ set script {info frame}
+ eval $script
+} -cleanup {unset script} -result {1[12]}
+test info-23.3 {eval'd info frame, literal} -match glob -body {
+ eval {
+ info frame 0
+ }
+} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.4 {eval'd info frame, semi-dynamic} {
+ eval info frame 0
+} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
+ set script {info frame 0}
+ eval $script
+} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+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 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}}
+
+# -------------------------------------------------------------------------
+
+# Procedures defined in scripts which are arguments to control
+# structures (like 'namespace eval', 'interp eval', 'if', 'while',
+# 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
+# location. The command implementations execute such scripts through
+# Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This
+# causes the connection to the context to be lost. Currently only
+# procedure bodies are able to remember their context.
+
+# NOTE THAT THESE DO NOT USE THE -setup OPTION TO [test]
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {
+ proc bar {} {info frame 0}
+}
+
+test info-24.0 {info frame, interaction, namespace eval} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set flag 1
+if {$flag} {
+ namespace eval foo {}
+ proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.1 {info frame, interaction, if} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set flag 1
+while {$flag} {
+ namespace eval foo {}
+ proc ::foo::bar {} {info frame 0}
+ set flag 0
+};unset flag
+
+test info-24.2 {info frame, interaction, while} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+catch {
+ namespace eval foo {}
+ proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.3 {info frame, interaction, catch} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+foreach var val {
+ namespace eval foo {}
+ proc ::foo::bar {} {info frame 0}
+ break
+}; unset var
+
+test info-24.4 {info frame, interaction, foreach} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+for {} {1} {} {
+ namespace eval foo {}
+ proc ::foo::bar {} {info frame 0}
+ break
+}
+
+test info-24.5 {info frame, interaction, for} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x {
+ foo {
+ proc ::foo::bar {} {info frame 0}
+ }
+}
+
+test info-24.6.0 {info frame, interaction, switch, list body} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x foo {
+ proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x [list foo {
+ proc ::foo::bar {} {info frame 0}
+}]
+
+test info-24.6.2 {info frame, interaction, switch, list body, dynamic} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+dict for {k v} {foo bar} {
+ proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.7 {info frame, interaction, dict for} {
+ reduce [foo::bar]
+} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo; unset k v
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set thedict {foo bar}
+dict with thedict {
+ proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.8 {info frame, interaction, dict with} {
+ reduce [foo::bar]
+} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset thedict foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+dict filter {foo bar} script {k v} {
+ proc ::foo::bar {} {info frame 0}
+ set x 1
+}; unset k v x
+
+test info-24.9 {info frame, interaction, dict filter} {
+ reduce [foo::bar]
+} {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+#unset x
+
+# -------------------------------------------------------------------------
+
+eval {
+ proc bar {} {info frame 0}
+}
+
+test info-25.0 {info frame, proc in eval} {
+ reduce [bar]
+} {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0}
+# Don't need to clean up yet...
+
+proc bar {} {info frame 0}
+
+test info-25.1 {info frame, regular proc} {
+ reduce [bar]
+} {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0}
+
+rename bar {}
+
+# -------------------------------------------------------------------------
+# More info-30.x test cases at the end of the file.
+test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
+ if {1} {
+ set res \
+ [reduce [info frame 0]];#1018
+ }
+ return $res
+ # This was reporting line 3 instead of the correct 4 because the
+ # bs+nl combination is subst by the parser before the 'if'
+ # command, and the bcc, see the word. Fixed by recording the
+ # offsets of all bs+nl sequences in literal words, then using the
+ # information in the bcc and other places to bump line numbers when
+ # parsing over the location. Also affected: testcases 22.8 and 23.6.
+} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+# -------------------------------------------------------------------------
+# See 24.0 - 24.5 for similar situations, using literal scripts.
+
+set body {set flag 0
+ set a c
+ set res [info frame 0]} ;# line 3!
+
+test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}}
+ namespace eval foo $body
+ return $foo::res
+} -result {type eval line 3 cmd {info frame 0} level 0} -cleanup {
+ catch {namespace delete foo}
+}
+test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body {
+ if 1 $body
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body {
+ if 1 then $body
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body {
+ set flag 1
+ while {$flag} $body
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+# .3 - proc - scoping prevent return of result ...
+
+test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body {
+ foreach var val $body
+ set res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body {
+ set flag 1
+ for {} {$flag} {} $body
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body {
+ eval $body
+ return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+# -------------------------------------------------------------------------
+
+set body {
+ foo {
+ proc ::foo::bar {} {info frame 0}
+ }
+}
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x $body; unset body
+
+test info-31.7 {info frame, interaction, switch, dynamic} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+ unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set body {
+ proc ::foo::bar {} {info frame 0}
+}
+
+namespace eval foo {}
+eval $body
+
+test info-32.0 {info frame, dynamic procedure} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace {*}{
+ eval
+ foo
+ {proc bar {} {info frame 0}}
+}
+test info-33.0 {{*}, literal, direct} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ set flag 1
+ if {*}{
+ {$flag}
+ {info frame 0}
+ }
+}
+test info-33.1 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace {*}"
+ eval
+ foo
+ {proc bar {} {info frame 0}}
+"
+test info-33.2 {{*}, literal, direct} {
+ reduce [foo::bar]
+} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace {*}"eval\nfoo\n{proc bar {} {info frame 0}}\n"
+
+test info-33.2a {{*}, literal, not simple, direct} {
+ reduce [foo::bar]
+} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ set flag 1
+ if {*}"
+ {1}
+ {info frame 0}
+ "
+}
+test info-33.3 {{*}, literal, simple, bytecompiled} {
+ reduce [foo::bar]
+} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ set flag 1
+ if {*}"\n{1}\n{info frame 0}"
+}
+test info-33.3a {{*}, literal, not simple, bytecompiled} {
+ reduce [foo::bar]
+} {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+set body {
+ eval
+ foo
+ {proc bar {} {
+ info frame 0
+ }}
+}
+namespace {*}$body
+test info-34.0 {{*}, dynamic, direct} {
+ reduce [foo::bar]
+} {type proc line 2 cmd {info frame 0} proc ::foo::bar level 0}
+
+unset body
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set body {
+ {$flag}
+ {info frame 0}
+}
+proc foo::bar {} {
+ global body ; set flag 1
+ if {*}$body
+}
+test info-34.1 {{*}, literal, bytecompiled} {
+ reduce [foo::bar]
+} {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+unset body
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+proc foo {} {
+ apply {
+ {x y}
+ {info frame 0}
+ } 0 0
+}
+test info-35.0 {apply, literal} {
+ reduce [foo]
+} {type source line 1231 file info.test cmd {info frame 0} lambda {
+ {x y}
+ {info frame 0}
+ } level 0}
+rename foo {}
+
+set lambda {
+ {x y}
+ {info frame 0}
+}
+test info-35.1 {apply, dynamic} {
+ reduce [apply $lambda 0 0]
+} {type proc line 1 cmd {info frame 0} lambda {
+ {x y}
+ {info frame 0}
+} level 0}
+unset lambda
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ dict for {k v} {foo bar} {
+ set x [info frame 0]
+ }
+ set x
+}
+test info-36.0 {info frame, dict for, bcc} -body {
+ reduce [foo::bar]
+} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ set x foo
+ switch -exact -- $x {
+ foo {set y [info frame 0]}
+ }
+ set y
+}
+
+test info-36.1.0 {switch, list literal, bcc} -body {
+ reduce [foo::bar]
+} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+ set x foo
+ switch -exact -- $x foo {set y [info frame 0]}
+ set y
+}
+
+test info-36.1.1 {switch, multi-body literals, bcc} -body {
+ reduce [foo::bar]
+} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+test info-37.0 {eval pure list, single line} -match glob -body {
+ # Basically, counting the newline in the word seen through $foo
+ # doesn't really make sense. It makes a bit of sense if the word
+ # would have been a string literal in the command list.
+ #
+ # Problem: At the point where we see the list elements we cannot
+ # distinguish the two cases, thus we cannot switch between
+ # count/not-count, it is has to be one or the other for all
+ # cases. Of the two possibilities miguel convinced me that 'not
+ # counting' is the more proper.
+ set foo {b
+ c}
+ set cmd [list foreach $foo {x y} {
+ set res [join [lrange [etrace] 0 2] \n]
+ break
+ }]
+ eval $cmd
+ return $res
+} -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}
+
+# -------------------------------------------------------------------------
+
+# 6 cases.
+## DV. direct-var - unchanged
+## DPV direct-proc-var - ditto
+## PPV proc-proc-var - ditto
+## DL. direct-literal - now tracking absolute location
+## DPL direct-proc-literal - ditto
+## PPL proc-proc-literal - ditto
+## ### ### ### ######### ######### #########"
+
+proc control {vv script} {
+ upvar 1 $vv var
+ return [uplevel 1 $script]
+}
+
+proc datal {} {
+ control y {
+ set y PPL
+ etrace
+ }
+}
+
+proc datav {} {
+ set script {
+ set y PPV
+ etrace
+ }
+ control y $script
+}
+
+test info-38.1 {location information for uplevel, dv, direct-var} -match glob -body {
+ set script {
+ set y DV.
+ etrace
+ }
+ join [lrange [uplevel \#0 $script] 0 2] \n
+} -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}
+
+# 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 {
+ set y DPV
+ etrace
+ }
+ join [lrange [control y $script] 0 3] \n
+} -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}
+
+# 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 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}}
+
+# 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 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}}
+
+# -------------------------------------------------------------------------
+# literal sharing
+
+test info-39.0 {location information not confused by literal sharing} -body {
+ namespace eval ::foo {}
+ proc ::foo::bar {} {
+ lappend res {}
+ lappend res [reduce [eval {info frame 0}]]
+ lappend res [reduce [eval {info frame 0}]]
+ return $res
+ }
+ set res [::foo::bar]
+ namespace delete ::foo
+ join $res \n
+} -cleanup {unset res} -result {
+type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
+type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).
+
+test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
+ proc abra {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1446
+ }
+ }
+ abra
+} -cleanup {
+ rename abra {}
+} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.2 {bs+nl in literal words, namespace script} {
+ namespace eval xxx {
+ variable res \
+ [info frame 0];# line 1457
+ }
+ return [reduce $xxx::res]
+} {type source line 1457 file info.test cmd {info frame 0} level 0}
+
+test info-30.3 {bs+nl in literal words, namespace multi-word script} {
+ namespace eval xxx variable res \
+ [list [reduce [info frame 0]]];# line 1464
+ return $xxx::res
+} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
+ eval {
+ set ::res \
+ [reduce [info frame 0]];# line 1471
+ }
+ return $res
+} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
+ eval {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1481
+ }
+ }
+ return $res
+} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
+ set res "\
+[reduce [info frame 0]]";# line 1489
+} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.7 {bs+nl in computed word, in proc} -body {
+ proc abra {} {
+ return "\
+[reduce [info frame 0]]";# line 1495
+ }
+ abra
+} -cleanup {
+ rename abra {}
+} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.8 {bs+nl in computed word, nested eval} -body {
+ eval {
+ set \
+ res "\
+[reduce [info frame 0]]";# line 1506
+}
+} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.9 {bs+nl in computed word, nested eval} -body {
+ eval {
+ set \
+ res "\
+[reduce \
+ [info frame 0]]";# line 1515
+}
+} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.10 {bs+nl in computed word, key to array} -body {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1523
+ unset tmp
+ set res
+} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.11 {bs+nl in subst arguments} -body {
+ subst {[set \
+ res "\
+[reduce \
+ [info frame 0]]"]} ; #1532
+} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.12 {bs+nl in computed word, nested eval} -body {
+ eval {
+ set \
+ res "\
+[set x {}] \
+[reduce \
+ [info frame 0]]";# line 1541
+}
+} -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 {
+ subinterp ; set res [interp eval sub { uplevel #0 {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1550
+ }
+ }
+ 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} {
+ subinterp ; set res [interp eval sub { proc abra {script} {
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1562
+ }]
+ rename abra {}
+ 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} {
+ proc a {} {
+ proc b {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1574
+ }
+ }
+ }
+ a ; set res [b]
+ rename a {}
+ rename b {}
+ set res
+} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
+
+test info-30.16 {bs+nl in multi-body switch, compiled} {
+ proc a {value} {
+ switch -regexp -- $value \
+ ^key { info frame 0; # 1587 } \
+ \t### { info frame 0; # 1588 } \
+ {[0-9]*} { info frame 0; # 1589 }
+ }
+ set res {}
+ lappend res [reduce [a {key }]]
+ lappend res [reduce [a {1alpha}]]
+ set res "\n[join $res \n]"
+} {
+type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.17 {bs+nl in multi-body switch, direct} {
+ switch -regexp -- {key } \
+ ^key { reduce [info frame 0] ;# 1601 } \
+ \t### { } \
+ {[0-9]*} { }
+} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
+ proc abra {script} {
+ append script "\n# end of script"
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1613, still line of 3 appended script
+ }]
+ rename abra {}
+ set res
+} { type eval line 3 cmd {info frame 0} proc ::abra}
+# { type source line 1606 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.19 {bs+nl in single-body switch, compiled} {
+ proc a {value} {
+ switch -regexp -- $value {
+ ^key { reduce \
+ [info frame 0] }
+ \t { reduce \
+ [info frame 0] }
+ {[0-9]*} { reduce \
+ [info frame 0] }
+ }
+ }
+ set res {}
+ lappend res [a {key }]
+ lappend res [a {1alpha}]
+ set res "\n[join $res \n]"
+} {
+type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.20 {bs+nl in single-body switch, direct} {
+ switch -regexp -- {key } { \
+
+ ^key { reduce \
+ [info frame 0] }
+ \t### { }
+ {[0-9]*} { }
+ }
+} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.21 {bs+nl in if, full compiled} {
+ proc a {value} {
+ if {$value} \
+ {info frame 0} \
+ {info frame 0} ; # 1653
+ }
+ set res {}
+ lappend res [reduce [a 1]]
+ lappend res [reduce [a 0]]
+ set res "\n[join $res \n]"
+} {
+type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.22 {bs+nl in computed word, key to array, compiled} {
+ proc a {} {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1668
+ unset tmp
+ set res
+ }
+ set res [a]
+ rename a {}
+ set res
+} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.23 {bs+nl in multi-body switch, full compiled} {
+ proc a {value} {
+ switch -exact -- $value \
+ key { info frame 0; # 1680 } \
+ xxx { info frame 0; # 1681 } \
+ 000 { info frame 0; # 1682 }
+ }
+ set res {}
+ lappend res [reduce [a key]]
+ lappend res [reduce [a 000]]
+ set res "\n[join $res \n]"
+} {
+type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.24 {bs+nl in single-body switch, full compiled} {
+ proc a {value} {
+ switch -exact -- $value {
+ key { reduce \
+ [info frame 0] }
+ xxx { reduce \
+ [info frame 0] }
+ 000 { reduce \
+ [info frame 0] }
+ }
+ }
+ set res {}
+ lappend res [a key]
+ lappend res [a 000]
+ set res "\n[join $res \n]"
+} {
+type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.25 {TIP 280 for compiled [subst]} {
+ subst {[reduce [info frame 0]]} ; # 1712
+} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.26 {TIP 280 for compiled [subst]} {
+ subst \
+ {[reduce [info frame 0]]} ; # 1716
+} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.27 {TIP 280 for compiled [subst]} {
+ subst {
+[reduce [info frame 0]]} ; # 1720
+} {
+type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.28 {TIP 280 for compiled [subst]} {
+ subst {\
+[reduce [info frame 0]]} ; # 1725
+} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.29 {TIP 280 for compiled [subst]} {
+ subst {foo\
+[reduce [info frame 0]]} ; # 1729
+} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.30 {TIP 280 for compiled [subst]} {
+ subst {foo
+[reduce [info frame 0]]} ; # 1733
+} {foo
+type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.31 {TIP 280 for compiled [subst]} {
+ subst {[][reduce [info frame 0]]} ; # 1737
+} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.32 {TIP 280 for compiled [subst]} {
+ subst {[\
+][reduce [info frame 0]]} ; # 1741
+} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.33 {TIP 280 for compiled [subst]} {
+ subst {[
+][reduce [info frame 0]]} ; # 1745
+} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.34 {TIP 280 for compiled [subst]} {
+ subst {[format %s {}
+][reduce [info frame 0]]} ; # 1749
+} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.35 {TIP 280 for compiled [subst]} {
+ subst {[format %s {}
+]
+[reduce [info frame 0]]} ; # 1754
+} {
+type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.36 {TIP 280 for compiled [subst]} {
+ subst {
+[format %s {}][reduce [info frame 0]]} ; # 1759
+} {
+type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.37 {TIP 280 for compiled [subst]} {
+ subst {
+[format %s {}]
+[reduce [info frame 0]]} ; # 1765
+} {
+
+type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.38 {TIP 280 for compiled [subst]} {
+ subst {\
+[format %s {}][reduce [info frame 0]]} ; # 1771
+} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.39 {TIP 280 for compiled [subst]} {
+ subst {\
+[format %s {}]\
+[reduce [info frame 0]]} ; # 1776
+} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.40 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}
+ subst {$empty[reduce [info frame 0]]} ; # 1782
+} -cleanup {
+ unset empty
+} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.41 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}
+ subst {$empty
+[reduce [info frame 0]]} ; # 1791
+} -cleanup {
+ unset empty
+} -result {
+type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.42 {TIP 280 for compiled [subst]} -setup {
+ unset -nocomplain empty
+} -body {
+ set empty {}; subst {$empty\
+[reduce [info frame 0]]} ; # 1800
+} -cleanup {
+ unset empty
+} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.43 {TIP 280 for compiled [subst]} -body {
+ unset -nocomplain a\nb
+ set a\nb {}
+ subst {${a
+b}[reduce [info frame 0]]} ; # 1808
+} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.44 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a(\n) {}
+ subst {$a(
+)[reduce [info frame 0]]} ; # 1814
+} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.45 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a() {}
+ subst {$a([
+return -level 0])[reduce [info frame 0]]} ; # 1820
+} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.46 {TIP 280 for compiled [subst]} {
+ unset -nocomplain a
+ set a(1825) YES; set a(1824) 1824; set a(1826) 1826
+ subst {$a([dict get [info frame 0] line])} ; # 1825
+} 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
+ subst {$a(
+[dict get [info frame 0] line])} ; # 1831
+} YES
+unset -nocomplain a
+
+test info-30.48 {Bug 2850901} testevalex {
+ testevalex {return -level 0 [format %s {}
+][reduce [info frame 0]]} ; # line 2 of the eval
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
+
+
+# -------------------------------------------------------------------------
+# literal sharing 2, bug 2933089
+
+test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
+ set result {}
+
+ proc print_one {} {}
+ proc test_info_frame {} {
+ set x 1
+ set y x
+
+ if "$x != 1" {
+ } else {
+ print_one
+ } ;#line 1854^
+
+ if "$$y != 1" {
+ } else {
+ print_one
+ } ;#line 1859^
+ # Do not put the comments listing the line numbers into the
+ # branches. We need shared literals, and the comments would
+ # make them different, thus unshared.
+ }
+
+ proc get_frame_info { cmd_str op } {
+ lappend ::result [reduce [eval {info frame -3}]]
+ }
+ trace add execution print_one enter get_frame_info
+} -body {
+ test_info_frame;
+ join $result \n
+} -cleanup {
+ trace remove execution print_one enter get_frame_info
+ rename get_frame_info {}
+ rename test_info_frame {}
+ rename print_one {}
+} -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1
+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"}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ catch {*}{
+ {info frame 0}
+ res
+ }
+ return $res
+}
+test info-33.4 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ dict for {a b} {c d} {*}{
+ {set res [info frame 0]}
+ }
+ return $res
+}
+test info-33.5 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ set d {a b}
+ dict update d x y {*}{
+ {set res [info frame 0]}
+ }
+ return $res
+}
+test info-33.6 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ set d {}
+ dict with d {*}{
+ {set res [info frame 0]}
+ }
+ return $res
+}
+test info-33.7 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ for {*}{
+ {set res [info frame 0]}
+ {1} {} {break}
+ }
+ return $res
+}
+test info-33.8 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ for {*}{
+ {} {1} {}
+ {set res [info frame 0]; break}
+ }
+ return $res
+}
+test info-33.9 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ for {*}{
+ {} {1}
+ {return [info frame 0]}
+ {}
+ }
+}
+test info-33.10 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ for {*}{
+ {}
+ {[return [info frame 0]]}
+ {} {}
+ }
+}
+test info-33.11 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ foreach {*}{
+ x
+ } [return [info frame 0]] {}
+}
+test info-33.12 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ foreach {*}{
+ x y
+ {set res [info frame 0]}
+ }
+ return $res
+}
+test info-33.13 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ if {*}{
+ {[return [info frame 0]]}
+ {}
+ }
+}
+test info-33.14 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ if 0 {*}{
+ {} else
+ {return [info frame 0]}
+ }
+}
+test info-33.15 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ incr {*}{
+ x
+ } [return [info frame 0]]
+}
+test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ info level {*}{
+ } [return [info frame 0]]
+}
+test info-33.17 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ string match {*}{
+ } [return [info frame 0]] {}
+}
+test info-33.18 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ string match {*}{
+ {}
+ } [return [info frame 0]]
+}
+test info-33.19 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ string length {*}{
+ } [return [info frame 0]]
+}
+test info-33.20 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ while {*}{
+ {[return [info frame 0]]}
+ } {}
+}
+test info-33.21 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ switch -- {*}{
+ } [return [info frame 0]] {*}{
+ } x y
+}
+test info-33.22 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {*}{
+ {set res [info frame 0]}
+ }
+ return $res
+}
+test info-33.23 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {*}{
+ {set res [info frame 0]}
+ } finally {}
+ return $res
+}
+test info-33.24 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {*}{
+ {set res [info frame 0]}
+ } on ok {} {}
+ return $res
+}
+test info-33.25 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {*}{
+ {set res [info frame 0]}
+ } on ok {} {} finally {}
+ return $res
+}
+test info-33.26 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ while 1 {*}{
+ {return [info frame 0]}
+ }
+}
+test info-33.27 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {} finally {*}{
+ {return [info frame 0]}
+ }
+}
+test info-33.28 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {} on ok {} {} finally {*}{
+ {return [info frame 0]}
+ }
+}
+test info-33.29 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {} on ok {} {*}{
+ {return [info frame 0]}
+ }
+}
+test info-33.30 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ try {} on ok {} {*}{
+ {return [info frame 0]}
+ } finally {}
+}
+test info-33.31 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ binary format {*}{
+ } [return [info frame 0]]
+}
+test info-33.32 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ set format format
+ binary $format {*}{
+ } [return [info frame 0]]
+}
+test info-33.33 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ append x {*}{
+ } [return [info frame 0]]
+}
+test info-33.34 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ append {*}{
+ } x([return [info frame 0]]) {*}{
+ } a
+}
+test info-33.35 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+unset -nocomplain res
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
diff --git a/tests/init.test b/tests/init.test
index 694ce74..41b8624 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -1,141 +1,114 @@
-# 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.
#
-# 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.14 2005/05/24 19:13:46 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 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.3.4
namespace import -force ::tcltest::*
}
# Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
-
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+
# Six cases - white box testing
test init-1.1 {auto_qualify - absolute cmd - namespace} {
auto_qualify ::foo::bar ::blue
} ::foo::bar
-
test init-1.2 {auto_qualify - absolute cmd - global} {
auto_qualify ::global ::sub
} global
-
test init-1.3 {auto_qualify - no colons cmd - global} {
auto_qualify nocolons ::
} nocolons
-
test init-1.4 {auto_qualify - no colons cmd - namespace} {
auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}
-
test init-1.5 {auto_qualify - colons in cmd - global} {
auto_qualify foo::bar ::
} ::foo::bar
-
test init-1.6 {auto_qualify - colons in cmd - namespace} {
auto_qualify foo::bar ::sub
} {::sub::foo::bar ::foo::bar}
-
# Some additional tests
-
test init-1.7 {auto_qualify - multiples colons 1} {
auto_qualify :::foo::::bar ::blue
} ::foo::bar
-
test init-1.8 {auto_qualify - multiple colons 2} {
auto_qualify :::foo ::bar
} foo
-
-
-# we use a sub interp and auto_reset and double the tests because there is 2
+
+# We use a sub-interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-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 {}}
-
-test init-2.0 {load parray - stage 1} {
- set ret [catch {parray} error]
- 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?"}}
-
-
+ auto_reset
+ catch {rename parray {}}
+
+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.
+} -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
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
test init-2.3 {load ::safe::setLogCmd - stage 2} {
::safe::setLogCmd
- rename ::safe::setLogCmd {} ; # should not fail
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
auto_reset
catch {rename ::safe::setLogCmd {}}
-
test init-2.4 {load safe:::setLogCmd - stage 1} {
- safe:::setLogCmd ; # intentionally 3 :
- rename ::safe::setLogCmd {} ; # should not fail
+ safe:::setLogCmd ;# intentionally 3 :
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
test init-2.5 {load safe:::setLogCmd - stage 2} {
- safe:::setLogCmd ; # intentionally 3 :
- rename ::safe::setLogCmd {} ; # should not fail
+ safe:::setLogCmd ;# intentionally 3 :
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
auto_reset
catch {rename ::safe::setLogCmd {}}
-
test init-2.6 {load setLogCmd from safe:: - stage 1} {
namespace eval safe setLogCmd
- rename ::safe::setLogCmd {} ; # should not fail
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
test init-2.7 {oad setLogCmd from safe:: - stage 2} {
namespace eval safe setLogCmd
- rename ::safe::setLogCmd {} ; # should not fail
+ rename ::safe::setLogCmd {} ;# should not fail
} {}
-
-
-
test init-2.8 {load tcl::HistAdd} -setup {
auto_reset
catch {rename ::tcl::HistAdd {}}
} -body {
# 3 ':' on purpose
- list [catch {tcl:::HistAdd} error] $error
-} -cleanup {
- rename ::tcl::HistAdd {} ;
-} -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}}
-
+ tcl:::HistAdd
+} -returnCodes error -cleanup {
+ rename ::tcl::HistAdd {}
+} -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) {
@@ -144,18 +117,18 @@ test init-3.0 {random stuff in the auto_index, should still work} {
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.
+# 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}
@@ -164,34 +137,33 @@ 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
}
@@ -207,8 +179,8 @@ test init-5.0 {return options passed through ::unknown} -setup {
list $code $foo $bar $code2 $foo2 $bar2
} -cleanup {
unset ::auto_index(::xxx)
-} -result {2 xxx {-code 1 -level 1} 2 xxx {-code 1 -level 1}}
-
+} -match glob -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}}
+
cleanupTests
} ;# End of [interp eval $testInterp]
@@ -217,3 +189,7 @@ interp delete $testInterp
::tcltest::cleanupTests
return
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/interp.test b/tests/interp.test
index f801247..ad99fac 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -9,59 +9,57 @@
#
# 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.46 2005/06/17 14:26:15 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}
+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
}
-
-proc equiv {x} {return $x}
-
+
# Part 0: Check out options for interp command
-test interp-1.1 {options for interp command} {
- list [catch {interp} msg] $msg
-} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
-test interp-1.2 {options for interp command} {
- list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+test interp-1.1 {options for interp command} -returnCodes error -body {
+ interp
+} -result {wrong # args: should be "interp cmd ?arg ...?"}
+test interp-1.2 {options for interp command} -returnCodes error -body {
+ interp frobox
+} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.3 {options for interp command} {
interp delete
} ""
-test interp-1.4 {options for interp command} {
- list [catch {interp delete foo bar} msg] $msg
-} {1 {could not find interpreter "foo"}}
-test interp-1.5 {options for interp command} {
- list [catch {interp exists foo bar} msg] $msg
-} {1 {wrong # args: should be "interp exists ?path?"}}
+test interp-1.4 {options for interp command} -returnCodes error -body {
+ interp delete foo bar
+} -result {could not find interpreter "foo"}
+test interp-1.5 {options for interp command} -returnCodes error -body {
+ interp exists foo bar
+} -result {wrong # args: should be "interp exists ?path?"}
#
# test interp-0.6 was removed
#
-test interp-1.6 {options for interp command} {
- list [catch {interp slaves foo bar zop} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
-test interp-1.7 {options for interp command} {
- list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
-test interp-1.8 {options for interp command} {
- list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
-test interp-1.9 {options for interp command} {
- list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
-test interp-1.10 {options for interp command} {
- list [catch {interp target} msg] $msg
-} {1 {wrong # args: should be "interp target path alias"}}
-
+test interp-1.6 {options for interp command} -returnCodes error -body {
+ interp slaves foo bar zop
+} -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, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+test interp-1.8 {options for interp command} -returnCodes error -body {
+ interp -froboz
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+test interp-1.9 {options for interp command} -returnCodes error -body {
+ interp -froboz -safe
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+test interp-1.10 {options for interp command} -returnCodes error -body {
+ interp target
+} -result {wrong # args: should be "interp target path alias"}
# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
@@ -113,11 +111,11 @@ test interp-2.12 {anonymous interps vs existing procs} {
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy anothernum
expr $anothernum - $thenum
-} 1
+} 1
test interp-2.13 {correct default when no $path arg is given} -body {
interp create --
} -match regexp -result {interp[0-9]+}
-
+
foreach i [interp slaves] {
interp delete $i
}
@@ -133,24 +131,24 @@ test interp-3.2 {testing interp exists and interp slaves} {
test interp-3.3 {testing interp exists and interp slaves} {
interp exists nonexistent
} 0
-test interp-3.4 {testing interp exists and interp slaves} {
- list [catch {interp slaves a b c} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
-test interp-3.5 {testing interp exists and interp slaves} {
- list [catch {interp exists a b c} msg] $msg
-} {1 {wrong # args: should be "interp exists ?path?"}}
+test interp-3.4 {testing interp exists and interp slaves} -body {
+ interp slaves a b c
+} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
+test interp-3.5 {testing interp exists and interp slaves} -body {
+ interp exists a b c
+} -returnCodes error -result {wrong # args: should be "interp exists ?path?"}
test interp-3.6 {testing interp exists and interp slaves} {
interp exists
} 1
test interp-3.7 {testing interp exists and interp slaves} {
interp slaves
} a
-test interp-3.8 {testing interp exists and interp slaves} {
- list [catch {interp slaves a b c} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
+test interp-3.8 {testing interp exists and interp slaves} -body {
+ interp slaves a b c
+} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
test interp-3.9 {testing interp exists and interp slaves} {
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}
@@ -164,12 +162,12 @@ test interp-4.1 {testing interp delete} {
catch {interp create a}
interp delete a
} ""
-test interp-4.2 {testing interp delete} {
- list [catch {interp delete nonexistent} msg] $msg
-} {1 {could not find interpreter "nonexistent"}}
-test interp-4.3 {testing interp delete} {
- list [catch {interp delete x y z} msg] $msg
-} {1 {could not find interpreter "x"}}
+test interp-4.2 {testing interp delete} -returnCodes error -body {
+ interp delete nonexistent
+} -result {could not find interpreter "nonexistent"}
+test interp-4.3 {testing interp delete} -returnCodes error -body {
+ interp delete x y z
+} -result {could not find interpreter "x"}
test interp-4.4 {testing interp delete} {
interp delete
} ""
@@ -177,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
@@ -185,14 +183,14 @@ test interp-4.6 {testing interp delete} {
interp create c3
interp delete c1 c2 c3
} ""
-test interp-4.7 {testing interp delete} {
+test interp-4.7 {testing interp delete} -returnCodes error -body {
interp create c1
interp create c2
- list [catch {interp delete c1 c2 c3} msg] $msg
-} {1 {could not find interpreter "c3"}}
-test interp-4.8 {testing interp delete} {
- list [catch {interp delete {}} msg] $msg
-} {1 {cannot delete the current interpreter}}
+ interp delete c1 c2 c3
+} -result {could not find interpreter "c3"}
+test interp-4.8 {testing interp delete} -returnCodes error -body {
+ interp delete {}
+} -result {cannot delete the current interpreter}
foreach i [interp slaves] {
interp delete $i
@@ -217,9 +215,9 @@ interp create a
test interp-6.1 {testing eval} {
a eval expr 3 + 5
} 8
-test interp-6.2 {testing eval} {
- list [catch {a eval foo} msg] $msg
-} {1 {invalid command name "foo"}}
+test interp-6.2 {testing eval} -returnCodes error -body {
+ a eval foo
+} -result {invalid command name "foo"}
test interp-6.3 {testing eval} {
a eval {proc foo {} {expr 3 + 5}}
a eval foo
@@ -227,15 +225,14 @@ test interp-6.3 {testing eval} {
test interp-6.4 {testing eval} {
interp eval a foo
} 8
-
test interp-6.5 {testing eval} {
interp create {a x2}
interp eval {a x2} {proc frob {} {expr 4 * 9}}
interp eval {a x2} frob
} 36
-test interp-6.6 {testing eval} {
- list [catch {interp eval {a x2} foo} msg] $msg
-} {1 {invalid command name "foo"}}
+test interp-6.6 {testing eval} -returnCodes error -body {
+ interp eval {a x2} foo
+} -result {invalid command name "foo"}
# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
proc in_master {args} {
@@ -259,9 +256,9 @@ test interp-7.4 {testing basic alias creation} {
test interp-7.5 {testing basic alias creation} {
lsort [a aliases]
} {bar foo}
-test interp-7.6 {testing basic aliases arg checking} {
- list [catch {a aliases too many args} msg] $msg
-} {1 {wrong # args: should be "a aliases"}}
+test interp-7.6 {testing basic aliases arg checking} -returnCodes error -body {
+ a aliases too many args
+} -result {wrong # args: should be "a aliases"}
# Part 7: testing basic alias invocation
test interp-8.1 {testing basic alias invocation} {
@@ -274,10 +271,10 @@ test interp-8.2 {testing basic alias invocation} {
a alias bar in_master a1 a2 a3
a eval bar s1 s2 s3
} {seen in master: {a1 a2 a3 s1 s2 s3}}
-test interp-8.3 {testing basic alias invocation} {
+test interp-8.3 {testing basic alias invocation} -returnCodes error -body {
catch {interp create a}
- list [catch {a alias} msg] $msg
-} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}
+ a alias
+} -result {wrong # args: should be "a alias aliasName ?targetName? ?arg ...?"}
# Part 8: Testing aliases for non-existent or hidden targets
test interp-9.1 {testing aliases for non-existent targets} {
@@ -379,7 +376,7 @@ test interp-10.7 {testing aliases between interpreters} {
set x [foo 33]
a eval {rename zoppo {}}
interp alias "" foo a {}
- equiv $x
+ return $x
} {33 33 33}
# Part 10: Testing "interp target"
@@ -503,6 +500,92 @@ test interp-14.4 {testing interp alias - alias over master} {
interp create a
list [catch {interp alias "" a a eval} msg] $msg [info commands a]
} {1 {cannot define or rename alias "a": interpreter deleted} {}}
+test interp-14.5 {testing interp-alias: wrong # args} -body {
+ proc setx x {set x}
+ interp alias {} a {} setx
+ catch {a 1 2}
+ set ::errorInfo
+} -cleanup {
+ rename setx {}
+ rename a {}
+} -result {wrong # args: should be "a x"
+ while executing
+"a 1 2"}
+test interp-14.6 {testing interp-alias: wrong # args} -setup {
+ proc setx x {set x}
+ catch {interp delete a}
+ interp create a
+} -body {
+ interp alias a a {} setx
+ catch {a eval a 1 2}
+ set ::errorInfo
+} -cleanup {
+ rename setx {}
+ interp delete a
+} -result {wrong # args: should be "a x"
+ invoked from within
+"a 1 2"
+ invoked from within
+"a eval a 1 2"}
+test interp-14.7 {testing interp-alias: wrong # args} -setup {
+ proc setx x {set x}
+ catch {interp delete a}
+ interp create a
+} -body {
+ interp alias a a {} setx
+ a eval {
+ catch {a 1 2}
+ set ::errorInfo
+ }
+} -cleanup {
+ rename setx {}
+ interp delete a
+} -result {wrong # args: should be "a x"
+ invoked from within
+"a 1 2"}
+test interp-14.8 {testing interp-alias: error messages} -body {
+ proc setx x {return -code error x}
+ interp alias {} a {} setx
+ catch {a 1}
+ set ::errorInfo
+} -cleanup {
+ rename setx {}
+ rename a {}
+} -result {x
+ while executing
+"a 1"}
+test interp-14.9 {testing interp-alias: error messages} -setup {
+ proc setx x {return -code error x}
+ catch {interp delete a}
+ interp create a
+} -body {
+ interp alias a a {} setx
+ catch {a eval a 1}
+ set ::errorInfo
+} -cleanup {
+ rename setx {}
+ interp delete a
+} -result {x
+ invoked from within
+"a 1"
+ invoked from within
+"a eval a 1"}
+test interp-14.10 {testing interp-alias: error messages} -setup {
+ proc setx x {return -code error x}
+ catch {interp delete a}
+ interp create a
+} -body {
+ interp alias a a {} setx
+ a eval {
+ catch {a 1}
+ set ::errorInfo
+ }
+} -cleanup {
+ rename setx {}
+ interp delete a
+} -result {x
+ invoked from within
+"a 1"}
# part 15: testing file sharing
test interp-15.1 {testing file sharing} {
@@ -584,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
@@ -1509,7 +1591,28 @@ test interp-20.49 {interp invokehidden -namespace} -setup {
interp delete slave
removeFile script
} -result ::foo
-
+test interp-20.50 {Bug 2486550} -setup {
+ interp create slave
+} -body {
+ slave hide coroutine
+ slave invokehidden coroutine
+} -cleanup {
+ interp delete slave
+} -returnCodes error -match glob -result *
+test interp-20.50.1 {Bug 2486550} -setup {
+ interp create slave
+} -body {
+ slave hide coroutine
+ catch {slave invokehidden coroutine} m o
+ dict get $o -errorinfo
+} -cleanup {
+ unset -nocomplain m 0
+ interp delete slave
+} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
+ while executing
+"coroutine"
+ invoked from within
+"slave invokehidden coroutine"}
test interp-21.1 {interp hidden} {
interp hidden {}
@@ -1517,67 +1620,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}
@@ -1677,181 +1786,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 [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} {bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source} {bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source} clock {cd encoding exec exit fconfigure file glob load open pwd socket source}}
+} -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
- 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
- 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} {
@@ -1862,16 +1951,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} {
@@ -1882,16 +1970,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} {
@@ -1899,20 +1985,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} {
@@ -1920,28 +2003,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}}
-
-unset hidden_cmds
+} -result {1 {1 2 3} 1 {1 2 3}}
-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
@@ -1951,7 +2028,6 @@ test interp-26.1 {result code transmission : interp eval direct} {
# Test that all the possibles error codes from Tcl get passed up
# from the slave interp's context to the master, even though the
# slave nominally thinks the command is running at the root level.
-
catch {interp delete a}
interp create a
set res {}
@@ -1962,8 +2038,6 @@ test interp-26.1 {result code transmission : interp eval direct} {
interp delete a
set res
} {-1 0 1 2 3 4 5}
-
-
test interp-26.2 {result code transmission : interp eval indirect} {
# retcode == 2 == return is special
catch {interp delete a}
@@ -1977,12 +2051,10 @@ test interp-26.2 {result code transmission : interp eval indirect} {
interp delete a
set res
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
test interp-26.3 {result code transmission : aliases} {
- # Test that all the possibles error codes from Tcl get passed up
- # from the slave interp's context to the master, even though the
- # slave nominally thinks the command is running at the root level.
-
+ # Test that all the possibles error codes from Tcl get passed up from the
+ # slave interp's context to the master, even though the slave nominally
+ # thinks the command is running at the root level.
catch {interp delete a}
interp create a
set res {}
@@ -1996,7 +2068,6 @@ test interp-26.3 {result code transmission : aliases} {
interp delete a
set res
} {-1 0 1 2 3 4 5}
-
test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
{knownBug} {
# The known bug is that code 2 is returned, not the -code argument
@@ -2010,36 +2081,35 @@ test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
interp delete a
set res
} {-1 0 1 2 3 4 5}
-
-test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
- {knownBug} {
- # The known bug is that the break and continue should raise errors
- # that they are used outside a loop.
+test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} -setup {
catch {interp delete a}
interp create a
+} -body {
+ # The known bug is that the break and continue should raise errors that
+ # they are used outside a loop.
set res {}
interp eval a {proc retcode {code} {return -code $code ret$code}}
interp hide a retcode
for {set code -1} {$code<=5} {incr code} {
lappend res [catch {interp invokehidden a retcode $code} msg] $msg
}
+ return $res
+} -cleanup {
interp delete a
- set res
-} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
-test interp-26.6 {result code transmission: all combined--bug 1637} \
- {knownBug} {
- # Test that all the possibles error codes from Tcl get passed
- # In both directions. This doesn't work.
- set interp [interp create];
+} -result {-1 ret-1 0 ret0 1 ret1 2 ret2 3 ret3 4 ret4 5 ret5}
+test interp-26.6 {result code transmission: all combined--bug 1637} -setup {
+ set interp [interp create]
+} -constraints knownBug -body {
+ # Test that all the possibles error codes from Tcl get passed in both
+ # directions. This doesn't work.
proc MyTestAlias {interp args} {
- global aliasTrace;
- lappend aliasTrace $args;
- interp invokehidden $interp {expand}$args
+ global aliasTrace
+ lappend aliasTrace $args
+ interp invokehidden $interp {*}$args
}
foreach c {return} {
- interp hide $interp $c;
- interp alias $interp $c {} MyTestAlias $interp $c;
+ interp hide $interp $c
+ interp alias $interp $c {} MyTestAlias $interp $c
}
interp eval $interp {proc ret {code} {return -code $code ret$code}}
set res {}
@@ -2047,231 +2117,247 @@ test interp-26.6 {result code transmission: all combined--bug 1637} \
for {set code -1} {$code<=5} {incr code} {
lappend res [catch {interp eval $interp ret $code} msg] $msg
}
- interp delete $interp;
- set res
-} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
-# Some tests might need to be added to check for difference between
-# toplevel and non toplevel evals.
-
+ return $res
+} -cleanup {
+ interp delete $interp
+} -result {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
+# Some tests might need to be added to check for difference between toplevel
+# and non-toplevel evals.
# End of return code transmission section
-
-test interp-26.7 {errorInfo transmission: regular interps} {
- set interp [interp create];
+test interp-26.7 {errorInfo transmission: regular interps} -setup {
+ set interp [interp create]
+} -body {
proc MyError {secret} {
return -code error "msg"
}
proc MyTestAlias {interp args} {
MyError "some secret"
}
- interp alias $interp test {} MyTestAlias $interp;
- set res [interp eval $interp {catch test;set errorInfo}]
- interp delete $interp;
- set res
-} {msg
+ interp alias $interp test {} MyTestAlias $interp
+ interp eval $interp {catch test;set ::errorInfo}
+} -cleanup {
+ interp delete $interp
+} -result {msg
while executing
"MyError "some secret""
(procedure "MyTestAlias" line 2)
invoked from within
"test"}
-
-test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
- # this test fails because the errorInfo is fully transmitted
- # whether the interp is safe or not. The errorInfo should never
- # report data from the master interpreter because it could
- # contain sensitive information.
- set interp [interp create -safe];
+test interp-26.8 {errorInfo transmission: safe interps--bug 1637} -setup {
+ set interp [interp create -safe]
+} -constraints knownBug -body {
+ # this test fails because the errorInfo is fully transmitted whether the
+ # interp is safe or not. The errorInfo should never report data from the
+ # master interpreter because it could contain sensitive information.
proc MyError {secret} {
return -code error "msg"
}
proc MyTestAlias {interp args} {
MyError "some secret"
}
- interp alias $interp test {} MyTestAlias $interp;
- set res [interp eval $interp {catch test;set errorInfo}]
- interp delete $interp;
- set res
-} {msg
+ interp alias $interp test {} MyTestAlias $interp
+ interp eval $interp {catch test;set ::errorInfo}
+} -cleanup {
+ interp delete $interp
+} -result {msg
while executing
"test"}
# Interps & Namespaces
-test interp-27.1 {interp aliases & namespaces} {
- set i [interp create];
- set aliasTrace {};
+test interp-27.1 {interp aliases & namespaces} -setup {
+ set i [interp create]
+} -body {
+ set aliasTrace {}
proc tstAlias {args} {
- global aliasTrace;
- lappend aliasTrace [list [namespace current] $args];
+ global aliasTrace
+ lappend aliasTrace [list [namespace current] $args]
}
- $i alias foo::bar tstAlias foo::bar;
+ $i alias foo::bar tstAlias foo::bar
$i eval foo::bar test
+ return $aliasTrace
+} -cleanup {
interp delete $i
- set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.2 {interp aliases & namespaces} {
- set i [interp create];
- set aliasTrace {};
+} -result {{:: {foo::bar test}}}
+test interp-27.2 {interp aliases & namespaces} -setup {
+ set i [interp create]
+} -body {
+ set aliasTrace {}
proc tstAlias {args} {
- global aliasTrace;
- lappend aliasTrace [list [namespace current] $args];
+ global aliasTrace
+ lappend aliasTrace [list [namespace current] $args]
}
- $i alias foo::bar tstAlias foo::bar;
+ $i alias foo::bar tstAlias foo::bar
$i eval namespace eval foo {bar test}
+ return $aliasTrace
+} -cleanup {
interp delete $i
- set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.3 {interp aliases & namespaces} {
- set i [interp create];
- set aliasTrace {};
+} -result {{:: {foo::bar test}}}
+test interp-27.3 {interp aliases & namespaces} -setup {
+ set i [interp create]
+} -body {
+ set aliasTrace {}
proc tstAlias {args} {
- global aliasTrace;
- lappend aliasTrace [list [namespace current] $args];
+ global aliasTrace
+ lappend aliasTrace [list [namespace current] $args]
}
interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
- interp alias $i foo::bar {} tstAlias foo::bar;
+ interp alias $i foo::bar {} tstAlias foo::bar
interp eval $i {namespace eval foo {bar test}}
+ return $aliasTrace
+} -cleanup {
interp delete $i
- set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.4 {interp aliases & namespaces} {
- set i [interp create];
+} -result {{:: {foo::bar test}}}
+test interp-27.4 {interp aliases & namespaces} -setup {
+ set i [interp create]
+} -body {
namespace eval foo2 {
- variable aliasTrace {};
+ variable aliasTrace {}
proc bar {args} {
- variable aliasTrace;
- lappend aliasTrace [list [namespace current] $args];
+ variable aliasTrace
+ lappend aliasTrace [list [namespace current] $args]
}
}
- $i alias foo::bar foo2::bar foo::bar;
+ $i alias foo::bar foo2::bar foo::bar
$i eval namespace eval foo {bar test}
- set r $foo2::aliasTrace;
- namespace delete foo2;
- set r
-} {{::foo2 {foo::bar test}}}
-
-# the following tests are commented out while we don't support
-# hiding in namespaces
-
-# test interp-27.5 {interp hidden & namespaces} {
-# set i [interp create];
-# interp eval $i {
-# namespace eval foo {
-# proc bar {args} {
-# return "bar called ([namespace current]) ($args)"
-# }
-# }
-# }
-# set res [list [interp eval $i {namespace eval foo {bar test1}}]]
-# interp hide $i foo::bar;
-# lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
-# interp delete $i;
-# set res;
-#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
-
-# test interp-27.6 {interp hidden & aliases & namespaces} {
-# set i [interp create];
-# set v root-master;
-# namespace eval foo {
-# variable v foo-master;
-# proc bar {interp args} {
-# variable v;
-# list "master bar called ($v) ([namespace current]) ($args)"\
-# [interp invokehidden $interp foo::bar $args];
-# }
-# }
-# interp eval $i {
-# namespace eval foo {
-# namespace export *
-# variable v foo-slave;
-# proc bar {args} {
-# variable v;
-# return "slave bar called ($v) ([namespace current]) ($args)"
-# }
-# }
-# }
-# set res [list [interp eval $i {namespace eval foo {bar test1}}]]
-# $i hide foo::bar;
-# $i alias foo::bar foo::bar $i;
-# set res [concat $res [interp eval $i {
-# set v root-slave;
-# namespace eval test {
-# variable v foo-test;
-# namespace import ::foo::*;
-# bar test2
-# }
-# }]]
-# namespace delete foo;
-# interp delete $i;
-# set res
-# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
-
-
-# test interp-27.7 {interp hidden & aliases & imports & namespaces} {
-# set i [interp create];
-# set v root-master;
-# namespace eval mfoo {
-# variable v foo-master;
-# proc bar {interp args} {
-# variable v;
-# list "master bar called ($v) ([namespace current]) ($args)"\
-# [interp invokehidden $interp test::bar $args];
-# }
-# }
-# interp eval $i {
-# namespace eval foo {
-# namespace export *
-# variable v foo-slave;
-# proc bar {args} {
-# variable v;
-# return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
-# }
-# }
-# set v root-slave;
-# namespace eval test {
-# variable v foo-test;
-# namespace import ::foo::*;
-# }
-# }
-# set res [list [interp eval $i {namespace eval test {bar test1}}]]
-# $i hide test::bar;
-# $i alias test::bar mfoo::bar $i;
-# set res [concat $res [interp eval $i {test::bar test2}]];
-# namespace delete mfoo;
-# interp delete $i;
-# set res
-# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
-
-#test interp-27.8 {hiding, namespaces and integrity} {
-# namespace eval foo {
-# variable v 3;
-# proc bar {} {variable v; set v}
-# # next command would currently generate an unknown command "bar" error.
-# interp hide {} bar;
-# }
-# namespace delete foo;
-# list [catch {interp invokehidden {} foo} msg] $msg;
-#} {1 {invalid hidden command name "foo"}}
-
-
-test interp-28.1 {getting fooled by slave's namespace ?} {
- set i [interp create -safe];
+ return $foo2::aliasTrace
+} -cleanup {
+ namespace delete foo2
+ interp delete $i
+} -result {{::foo2 {foo::bar test}}}
+test interp-27.5 {interp hidden & namespaces} -setup {
+ set i [interp create]
+} -constraints knownBug -body {
+ interp eval $i {
+ namespace eval foo {
+ proc bar {args} {
+ return "bar called ([namespace current]) ($args)"
+ }
+ }
+ }
+ set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+ interp hide $i foo::bar
+ lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
+} -cleanup {
+ interp delete $i
+} -result {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
+test interp-27.6 {interp hidden & aliases & namespaces} -setup {
+ set i [interp create]
+} -constraints knownBug -body {
+ set v root-master
+ namespace eval foo {
+ variable v foo-master
+ proc bar {interp args} {
+ variable v
+ list "master bar called ($v) ([namespace current]) ($args)"\
+ [interp invokehidden $interp foo::bar $args]
+ }
+ }
+ interp eval $i {
+ namespace eval foo {
+ namespace export *
+ variable v foo-slave
+ proc bar {args} {
+ variable v
+ return "slave bar called ($v) ([namespace current]) ($args)"
+ }
+ }
+ }
+ set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+ $i hide foo::bar
+ $i alias foo::bar foo::bar $i
+ set res [concat $res [interp eval $i {
+ set v root-slave
+ namespace eval test {
+ variable v foo-test
+ namespace import ::foo::*
+ bar test2
+ }
+ }]]
+} -cleanup {
+ namespace delete foo
+ interp delete $i
+} -result {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
+test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup {
+ set i [interp create]
+} -constraints knownBug -body {
+ set v root-master
+ namespace eval mfoo {
+ variable v foo-master
+ proc bar {interp args} {
+ variable v
+ list "master bar called ($v) ([namespace current]) ($args)"\
+ [interp invokehidden $interp test::bar $args]
+ }
+ }
+ interp eval $i {
+ namespace eval foo {
+ namespace export *
+ variable v foo-slave
+ proc bar {args} {
+ variable v
+ return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
+ }
+ }
+ set v root-slave
+ namespace eval test {
+ variable v foo-test
+ namespace import ::foo::*
+ }
+ }
+ set res [list [interp eval $i {namespace eval test {bar test1}}]]
+ $i hide test::bar
+ $i alias test::bar mfoo::bar $i
+ set res [concat $res [interp eval $i {test::bar test2}]]
+} -cleanup {
+ namespace delete mfoo
+ interp delete $i
+} -result {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
+test interp-27.8 {hiding, namespaces and integrity} knownBug {
+ namespace eval foo {
+ variable v 3
+ proc bar {} {variable v; set v}
+ # next command would currently generate an unknown command "bar" error.
+ interp hide {} bar
+ }
+ namespace delete foo
+ list [catch {interp invokehidden {} foo::bar} msg] $msg
+} {1 {invalid hidden command name "foo"}}
+
+test interp-28.1 {getting fooled by slave's namespace ?} -setup {
+ set i [interp create -safe]
proc master {interp args} {interp hide $interp list}
- $i alias master master $i;
+} -body {
+ $i alias master master $i
set r [interp eval $i {
namespace eval foo {
proc list {args} {
- return "dummy foo::list";
+ return "dummy foo::list"
}
- master;
+ master
}
info commands list
}]
- interp delete $i;
- set r
-} {}
+} -cleanup {
+ rename master {}
+ interp delete $i
+} -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 {*}[filter [{*}$y]]
+ set j [interp create]
+ $j alias filter filter
+ $j eval {namespace delete {*}[filter [namespace children ::]]}
+ namespace eval foo {}
+ list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
+ }
+} -cleanup {
+ interp delete $i
+} -result {::foo ::foo {} {}}
# Part 29: recursion limit
# 29.1.* Argument checking
@@ -2284,96 +2370,81 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
test interp-29.1.1 {interp recursionlimit argument checking} {
list [catch {interp recursionlimit} msg] $msg
} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
-
test interp-29.1.2 {interp recursionlimit argument checking} {
list [catch {interp recursionlimit foo bar} msg] $msg
} {1 {could not find interpreter "foo"}}
-
test interp-29.1.3 {interp recursionlimit argument checking} {
list [catch {interp recursionlimit foo bar baz} msg] $msg
} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
-
test interp-29.1.4 {interp recursionlimit argument checking} {
interp create moo
set result [catch {interp recursionlimit moo bar} msg]
interp delete moo
list $result $msg
} {1 {expected integer but got "bar"}}
-
test interp-29.1.5 {interp recursionlimit argument checking} {
interp create moo
set result [catch {interp recursionlimit moo 0} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-
test interp-29.1.6 {interp recursionlimit argument checking} {
interp create moo
set result [catch {interp recursionlimit moo -1} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-
test interp-29.1.7 {interp recursionlimit argument checking} {
interp create moo
set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
interp delete moo
list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
-
test interp-29.1.8 {slave recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit foo bar} msg]
interp delete moo
list $result $msg
} {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
-
test interp-29.1.9 {slave recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit foo} msg]
interp delete moo
list $result $msg
} {1 {expected integer but got "foo"}}
-
test interp-29.1.10 {slave recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit 0} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-
test interp-29.1.11 {slave recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit -1} msg]
interp delete moo
list $result $msg
} {1 {recursion limit must be > 0}}
-
test interp-29.1.12 {slave recursionlimit argument checking} {
interp create moo
set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
interp delete moo
list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
-
test interp-29.2.1 {query recursion limit} {
interp recursionlimit {}
} 1000
-
test interp-29.2.2 {query recursion limit} {
set i [interp create]
set n [interp recursionlimit $i]
interp delete $i
set n
} 1000
-
test interp-29.2.3 {query recursion limit} {
set i [interp create]
set n [$i recursionlimit]
interp delete $i
set n
} 1000
-
test interp-29.2.4 {query recursion limit} {
set i [interp create]
set r [$i eval {
@@ -2384,7 +2455,6 @@ test interp-29.2.4 {query recursion limit} {
interp delete $i
set r
} {42 42}
-
test interp-29.2.5 {query recursion limit} {
set i [interp create]
set n1 [interp recursionlimit $i 42]
@@ -2392,7 +2462,6 @@ test interp-29.2.5 {query recursion limit} {
interp delete $i
list $n1 $n2
} {42 42}
-
test interp-29.2.6 {query recursion limit} {
set i [interp create]
set n1 [interp recursionlimit $i 42]
@@ -2400,7 +2469,6 @@ test interp-29.2.6 {query recursion limit} {
interp delete $i
list $n1 $n2
} {42 42}
-
test interp-29.2.7 {query recursion limit} {
set i [interp create]
set n1 [$i recursionlimit 42]
@@ -2408,7 +2476,6 @@ test interp-29.2.7 {query recursion limit} {
interp delete $i
list $n1 $n2
} {42 42}
-
test interp-29.2.8 {query recursion limit} {
set i [interp create]
set n1 [$i recursionlimit 42]
@@ -2416,7 +2483,6 @@ test interp-29.2.8 {query recursion limit} {
interp delete $i
list $n1 $n2
} {42 42}
-
test interp-29.3.1 {recursion limit} {
set i [interp create]
set r [interp eval $i {
@@ -2427,8 +2493,7 @@ test interp-29.3.1 {recursion limit} {
}]
interp delete $i
set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
test interp-29.3.2 {recursion limit} {
set i [interp create]
interp recursionlimit $i 50
@@ -2439,8 +2504,7 @@ test interp-29.3.2 {recursion limit} {
}]
interp delete $i
set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
test interp-29.3.3 {recursion limit} {
set i [interp create]
$i recursionlimit 50
@@ -2451,8 +2515,7 @@ test interp-29.3.3 {recursion limit} {
}]
interp delete $i
set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
test interp-29.3.4 {recursion limit error reporting} {
interp create slave
set r1 [slave eval {
@@ -2473,7 +2536,6 @@ test interp-29.3.4 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {1 {falling back due to new recursion limit}}
-
test interp-29.3.5 {recursion limit error reporting} {
interp create slave
set r1 [slave eval {
@@ -2494,7 +2556,6 @@ test interp-29.3.5 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {1 {falling back due to new recursion limit}}
-
test interp-29.3.6 {recursion limit error reporting} {
interp create slave
set r1 [slave eval {
@@ -2515,8 +2576,11 @@ test interp-29.3.6 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {0 ok}
-
-test interp-29.3.7 {recursion limit error reporting} {
+#
+# Note that TEBC does not verify the interp's nesting level itself; the nesting
+# level will only be verified when it invokes a non-bcc'd command.
+#
+test interp-29.3.7a {recursion limit error reporting} {
interp create slave
after 0 {interp recursionlimit slave 5}
set r1 [slave eval {
@@ -2525,8 +2589,51 @@ test interp-29.3.7 {recursion limit error reporting} {
eval { # 3
eval { # 4
eval { # 5
- update
- set x ok
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.7b {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 5}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ update
+ eval { # 5
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.7c {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 5}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set set set
+ $set x ok
}
}
}
@@ -2537,8 +2644,7 @@ test interp-29.3.7 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.8 {recursion limit error reporting} {
+test interp-29.3.8a {recursion limit error reporting} {
interp create slave
after 0 {interp recursionlimit slave 4}
set r1 [slave eval {
@@ -2547,8 +2653,29 @@ test interp-29.3.8 {recursion limit error reporting} {
eval { # 3
eval { # 4
eval { # 5
- update
- set x ok
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.8b {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 4}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ update
+ eval { # 5
+ set x ok
}
}
}
@@ -2559,8 +2686,7 @@ test interp-29.3.8 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.9 {recursion limit error reporting} {
+test interp-29.3.9a {recursion limit error reporting} {
interp create slave
after 0 {interp recursionlimit slave 6}
set r1 [slave eval {
@@ -2569,8 +2695,8 @@ test interp-29.3.9 {recursion limit error reporting} {
eval { # 3
eval { # 4
eval { # 5
- update
- set x ok
+ update
+ set x ok
}
}
}
@@ -2581,8 +2707,28 @@ test interp-29.3.9 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {0 ok}
-
-test interp-29.3.10 {recursion limit error reporting} {
+test interp-29.3.9b {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 6}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ set set set
+ $set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.10a {recursion limit error reporting} {
interp create slave
after 0 {slave recursionlimit 4}
set r1 [slave eval {
@@ -2602,9 +2748,29 @@ test interp-29.3.10 {recursion limit error reporting} {
set r2 [slave eval { set msg }]
interp delete slave
list $r1 $r2
+} {0 ok}
+test interp-29.3.10b {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 4}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ update
+ eval { # 5
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.11 {recursion limit error reporting} {
+test interp-29.3.11a {recursion limit error reporting} {
interp create slave
after 0 {slave recursionlimit 5}
set r1 [slave eval {
@@ -2613,8 +2779,30 @@ test interp-29.3.11 {recursion limit error reporting} {
eval { # 3
eval { # 4
eval { # 5
- update
- set x ok
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.11b {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 5}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set set set
+ $set x ok
}
}
}
@@ -2625,8 +2813,7 @@ test interp-29.3.11 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.12 {recursion limit error reporting} {
+test interp-29.3.12a {recursion limit error reporting} {
interp create slave
after 0 {slave recursionlimit 6}
set r1 [slave eval {
@@ -2635,8 +2822,30 @@ test interp-29.3.12 {recursion limit error reporting} {
eval { # 3
eval { # 4
eval { # 5
- update
- set x ok
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+test interp-29.3.12b {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 6}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set set set
+ $set x ok
}
}
}
@@ -2647,7 +2856,6 @@ test interp-29.3.12 {recursion limit error reporting} {
interp delete slave
list $r1 $r2
} {0 ok}
-
test interp-29.4.1 {recursion limit inheritance} {
set i [interp create]
set ii [interp eval $i {
@@ -2662,8 +2870,7 @@ test interp-29.4.1 {recursion limit inheritance} {
}]
interp delete $i
set r
-} 49
-
+} 50
test interp-29.4.2 {recursion limit inheritance} {
set i [interp create]
$i recursionlimit 50
@@ -2676,8 +2883,7 @@ test interp-29.4.2 {recursion limit inheritance} {
}]
interp delete $i
set r
-} 49
-
+} 50
test interp-29.5.1 {does slave recursion limit affect master?} {
set before [interp recursionlimit {}]
set i [interp create]
@@ -2687,7 +2893,6 @@ test interp-29.5.1 {does slave recursion limit affect master?} {
interp delete $i
list [expr {$before == $after}] $slavelimit
} {1 20000}
-
test interp-29.5.2 {does slave recursion limit affect master?} {
set before [interp recursionlimit {}]
set i [interp create]
@@ -2697,7 +2902,6 @@ test interp-29.5.2 {does slave recursion limit affect master?} {
interp delete $i
list [expr {$before == $after}] $slavelimit
} {1 20000}
-
test interp-29.5.3 {does slave recursion limit affect master?} {
set before [interp recursionlimit {}]
set i [interp create]
@@ -2707,7 +2911,6 @@ test interp-29.5.3 {does slave recursion limit affect master?} {
interp delete $i
list [expr {$before == $after}] $slavelimit
} {1 20000}
-
test interp-29.5.4 {does slave recursion limit affect master?} {
set before [interp recursionlimit {}]
set i [interp create]
@@ -2717,21 +2920,18 @@ test interp-29.5.4 {does slave recursion limit affect master?} {
interp delete $i
list [expr {$before == $after}] $slavelimit
} {1 20000}
-
test interp-29.6.1 {safe interpreter recursion limit} {
interp create slave -safe
set n [interp recursionlimit slave]
interp delete slave
set n
} 1000
-
test interp-29.6.2 {safe interpreter recursion limit} {
interp create slave -safe
set n [slave recursionlimit]
interp delete slave
set n
} 1000
-
test interp-29.6.3 {safe interpreter recursion limit} {
interp create slave -safe
set n1 [interp recursionlimit slave 42]
@@ -2739,7 +2939,6 @@ test interp-29.6.3 {safe interpreter recursion limit} {
interp delete slave
list $n1 $n2
} {42 42}
-
test interp-29.6.4 {safe interpreter recursion limit} {
interp create slave -safe
set n1 [slave recursionlimit 42]
@@ -2747,7 +2946,6 @@ test interp-29.6.4 {safe interpreter recursion limit} {
interp delete slave
list $n1 $n2
} {42 42}
-
test interp-29.6.5 {safe interpreter recursion limit} {
interp create slave -safe
set n1 [interp recursionlimit slave 42]
@@ -2755,7 +2953,6 @@ test interp-29.6.5 {safe interpreter recursion limit} {
interp delete slave
list $n1 $n2
} {42 42}
-
test interp-29.6.6 {safe interpreter recursion limit} {
interp create slave -safe
set n1 [slave recursionlimit 42]
@@ -2763,7 +2960,6 @@ test interp-29.6.6 {safe interpreter recursion limit} {
interp delete slave
list $n1 $n2
} {42 42}
-
test interp-29.6.7 {safe interpreter recursion limit} {
interp create slave -safe
set n1 [slave recursionlimit 42]
@@ -2771,14 +2967,12 @@ test interp-29.6.7 {safe interpreter recursion limit} {
interp delete slave
list $n1 $n2
} {42 42}
-
test interp-29.6.8 {safe interpreter recursion limit} {
interp create slave -safe
set n [catch {slave eval {interp recursionlimit {} 42}} msg]
interp delete slave
list $n $msg
} {1 {permission denied: safe interpreters cannot change recursion limit}}
-
test interp-29.6.9 {safe interpreter recursion limit} {
interp create slave -safe
set result [
@@ -2793,7 +2987,6 @@ test interp-29.6.9 {safe interpreter recursion limit} {
interp delete slave
set result
} {1 {permission denied: safe interpreters cannot change recursion limit}}
-
test interp-29.6.10 {safe interpreter recursion limit} {
interp create slave -safe
set result [
@@ -2846,13 +3039,12 @@ test interp-31.1 {alias invocation scope} {
upvar 1 $varName localVar
set localVar $value
}
-
interp alias {} myNewSet {} mySet
proc testMyNewSet {value} {
myNewSet a $value
return $a
}
- catch {unset a}
+ unset -nocomplain a
set result [testMyNewSet "ok"]
rename testMyNewSet {}
rename mySet {}
@@ -2860,8 +3052,9 @@ test interp-31.1 {alias invocation scope} {
set result
} ok
-test interp-32.1 {parent's working directory should be inherited by a child interp} {
+test interp-32.1 {parent's working directory should be inherited by a child interp} -setup {
cd [temporaryDirectory]
+} -body {
set parent [pwd]
set i [interp create]
set child [$i eval pwd]
@@ -2874,10 +3067,11 @@ test interp-32.1 {parent's working directory should be inherited by a child inte
cd ..
file delete cwd_test
interp delete $i
- cd [workingDirectory]
expr {[string equal $parent $child] ? 1 :
"\{$parent\} != \{$child\}"}
-} 1
+} -cleanup {
+ cd [workingDirectory]
+} -result 1
test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
# This test will panic if Bug 730244 is not fixed.
@@ -3113,13 +3307,83 @@ test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
interp delete $i
lappend result $msg
} -result {1 {time limit exceeded}}
+test interp-34.11 {time limit extension in callbacks} -setup {
+ proc cb1 {i t} {
+ global result
+ lappend result cb1
+ $i limit time -seconds $t -command cb2
+ }
+ proc cb2 {} {
+ global result
+ lappend result cb2
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 \
+ -command "cb1 $i [expr {$t0+2}]"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup {
+ rename cb1 {}
+ rename cb2 {}
+}
+test interp-34.12 {time limit extension in callbacks} -setup {
+ proc cb1 {i} {
+ global result times
+ lappend result cb1
+ set times [lassign $times t]
+ $i limit time -seconds $t
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ set ::times "[expr {$t0+2}] [expr {$t0+100}]"
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb1 0 {} ok} -cleanup {
+ rename cb1 {}
+}
+test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup {
+ set i [interp create -safe]
+} -body {
+ $i limit time -seconds [clock add [clock seconds] 1 second]
+ $i eval {
+ after 2000 set x timeout
+ vwait x
+ return $x
+ }
+} -cleanup {
+ interp delete $i
+} -returnCodes error -result {limit exceeded}
test interp-35.1 {interp limit syntax} -body {
interp limit
-} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
+} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
test interp-35.2 {interp limit syntax} -body {
interp limit {}
-} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
+} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
test interp-35.3 {interp limit syntax} -body {
interp limit {} foo
} -returnCodes error -result {bad limit type "foo": must be commands or time}
@@ -3248,6 +3512,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
@@ -3283,10 +3554,94 @@ test interp-36.6 {SlaveBgerror returns handler} -setup {
} -cleanup {
interp delete slave
} -result {foo bar soom}
+test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
+ interp create slave
+ slave alias handler handler
+ slave bgerror handler
+ variable result {untouched}
+ proc handler {args} {
+ variable result
+ set result [lindex $args 0]
+ }
+} -body {
+ slave eval {
+ variable done {}
+ after 0 error foo
+ after 10 [list ::set [namespace which -variable done] {}]
+ vwait [namespace which -variable done]
+ }
+ set result
+} -cleanup {
+ variable result {}
+ unset -nocomplain result
+ interp delete slave
+} -result foo
+test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
+ catch {interp delete a}
+ interp create a
+ set result {}
+} -body {
+ interp create {a b} -safe
+ 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 -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
}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/io.test b/tests/io.test
index 4edb308..edc0b11 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -12,22 +12,26 @@
#
# 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.69 2005/08/24 17:56:24 andreas_kupries 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::*
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::viewFile
+ variable umaskValue
+ variable path
+ variable f
+ variable i
+ variable n
+ variable v
+ variable msg
+ variable expected
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
@@ -37,6 +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 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...
@@ -45,7 +50,9 @@ testConstraint largefileSupport 0
# 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 [exec /bin/sh -c umask]}]}]
+testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}]
+
+testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
# set up a long data file for some of the following tests
@@ -121,6 +128,66 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
+test io-1.9 {Tcl_WriteChars: WriteChars} {
+ # When closing a channel with an encoding that appends
+ # escape bytes, check for the case where the escape
+ # bytes overflow the current IO buffer. The bytes
+ # should be moved into a new buffer.
+
+ set data "1234567890 [format %c 12399]"
+
+ set sizes [list]
+
+ # With default buffer size
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp
+ puts -nonewline $f $data
+ close $f
+ lappend sizes [file size $path(test2)]
+
+ # With buffer size equal to the length
+ # of the data, the escape bytes would
+ # go into the next buffer.
+
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp -buffersize 16
+ puts -nonewline $f $data
+ close $f
+ lappend sizes [file size $path(test2)]
+
+ # With buffer size that is large enough
+ # to hold 1 byte of escaped data, but
+ # not all 3. This should not write
+ # the escape bytes to the first buffer
+ # and then again to the second buffer.
+
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp -buffersize 17
+ puts -nonewline $f $data
+ close $f
+ lappend sizes [file size $path(test2)]
+
+ # With buffer size that can hold 2 out of
+ # 3 bytes of escaped data.
+
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp -buffersize 18
+ puts -nonewline $f $data
+ close $f
+ lappend sizes [file size $path(test2)]
+
+ # With buffer size that can hold all the
+ # data and escape bytes.
+
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp -buffersize 19
+ puts -nonewline $f $data
+ close $f
+ lappend sizes [file size $path(test2)]
+
+ set sizes
+} {19 19 19 19 19}
+
test io-2.1 {WriteBytes} {
# loop until all bytes are written
@@ -1605,8 +1672,8 @@ test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
out
} {err
}}
-# This test relies on the fact that the smallest available fd is used first.
-test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
+# This test relies on the fact that stdout is used before stderr
+test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
set f [open $path(test1) w]
puts -nonewline $f { close stdin
close stdout
@@ -1631,8 +1698,8 @@ test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
close $f2
set result
} {{ close stdin
-file1
-} {file2
+stdout
+} {stderr
}}
catch {interp delete z}
test io-14.5 {Tcl_GetChannel: stdio name translation} {
@@ -2023,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]
@@ -2142,7 +2211,7 @@ test io-28.4 {Tcl_Close} {testchannel} {
close $f
lappend l [lsort [testchannel open]]
set x [list $consoleFileNames \
- [lsort [list {expand}$consoleFileNames $f]] \
+ [lsort [list {*}$consoleFileNames $f]] \
$consoleFileNames]
string compare $l $x
} 0
@@ -2157,7 +2226,7 @@ test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
- set l
+ lsort $l
} {file1 file2}
test io-29.1 {Tcl_WriteChars, channel not writable} {
@@ -2543,11 +2612,11 @@ test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
# you disable the debugger's signal interception.
#
if {[catch {flush $f} msg]} {
- set x [list 1 $msg $errorCode]
+ set x [list 1 $msg $::errorCode]
catch {close $f}
} else {
if {[catch {close $f} msg]} {
- set x [list 1 $msg $errorCode]
+ set x [list 1 $msg $::errorCode]
} else {
set x {this was supposed to fail and did not}
}
@@ -2582,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]
@@ -2623,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]
@@ -2673,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
@@ -2692,7 +2785,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
variable c
variable x
set l [gets $s]
-
+
if {[eof $s]} {
close $s
set x done
@@ -2700,8 +2793,8 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
incr c
}
}
- set ss [socket -server [namespace code accept] 0]
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+ set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable x]
fconfigure $cs -blocking off
writelots $cs $l
@@ -2711,19 +2804,19 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
set c
} 2000
test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
- # On Mac, this test screws up sockets such that subsequent tests using port 2828
+ # On Mac, this test screws up sockets such that subsequent tests using port 2828
# either cause errors or panic().
-
+
catch {interp delete x}
catch {interp delete y}
interp create x
interp create y
- set s [socket -server [namespace code accept] 0]
+ set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
proc accept {s a p} {
puts $s hello
close $s
}
- set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+ set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
interp share {} $c x
interp share {} $c y
close $c
@@ -3793,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]
@@ -4287,7 +4380,7 @@ test io-34.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-34.16 {Tcl_tell on pipe: always -1} {stdio openpipe} {
+test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
@@ -4632,6 +4725,77 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
close $f
list $c $l $e
} {21 8 1}
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr
+ puts $f abc\ndef
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar \x1a
+ puts $f abc\ndef
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar \x1a
+ puts $f {}
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr
+ puts $f {}
+ close $f
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $s $l $e [scan [string index $in end] %c]
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar {}
+ set i [format abc\ndef\n%cqrs\nuvw 26]
+ puts $f $i
+ close $f
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $c $l $e [scan [string index $in end] %c]
+} -result {17 8 1 13}
# Test Tcl_InputBlocked
@@ -4793,7 +4957,7 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
lappend l [fconfigure $f -buffersize]
close $f
set l
-} {4096 10000 1 1 1 100000 100000}
+} {4096 10000 1 1 1 100000 1048576}
test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
# This test crashes the interp if Bug #427196 is not fixed
@@ -4954,22 +5118,22 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
close $f1
set x
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
-test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -buffersize -10
set x [fconfigure $f -buffersize]
close $f
set x
-} 4096
-test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
+} 1
+test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -buffersize 10000000
set x [fconfigure $f -buffersize]
close $f
set x
-} 4096
+} 1048576
test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -5034,7 +5198,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA}
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server [namespace code accept] 0]
+ set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5047,7 +5211,7 @@ test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server [namespace code accept] 0]
+ set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5060,7 +5224,7 @@ test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server [namespace code accept] 0]
+ set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5073,7 +5237,7 @@ test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server [namespace code accept] 0]
+ set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5110,7 +5274,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} {
test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
writeable, it should still have valid -eofchar and -translation options } {
set l [list]
- set sock [socket -server [namespace code accept] 0]
+ set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
set l
@@ -5118,7 +5282,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
writable so we can't change -eofchar or -translation } {
set l [list]
- set sock [socket -server [namespace code accept] 0]
+ set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
fconfigure $sock -eofchar D -translation lf
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
@@ -5142,24 +5306,24 @@ 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)&0777]]
+ 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)
set f [open $path(test3) {WRONLY CREAT}]
close $f
file stat $path(test3) stats
- format "0%o" [expr $stats(mode)&0777]
-} [format %04o [expr {0666 & ~ $umaskValue}]]
+ format "0%o" [expr $stats(mode)&0o777]
+} [format %04o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
file delete $path(test3)
set f [open $path(test3) w]
@@ -5279,19 +5443,18 @@ test io-40.15 {POSIX open access modes: RDWR} {
close $f
lappend x [viewFile test3]
} {zzy abzzy}
-testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
test io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
makeFile {Some text} _test_ ~
} -body {
- file exists [file join $env(HOME) _test_]
+ file exists [file join $::env(HOME) _test_]
} -cleanup {
removeFile _test_ ~
} -result 1
test io-40.17 {tilde substitution in open} {
- set home $env(HOME)
- unset env(HOME)
+ set home $::env(HOME)
+ unset ::env(HOME)
set x [list [catch {open ~/foo} msg] $msg]
- set env(HOME) $home
+ set ::env(HOME) $home
set x
} {1 {couldn't find HOME environment variable to expand path}}
@@ -5344,13 +5507,6 @@ test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent
lappend result [fileevent $f readable]
} {13 11 12 {}}
-#
-# Test fileevent on a pipe
-#
-if {[testConstraint openpipe]} {
- catch {set f2 [open "|[list cat -u]" r+]}
- catch {set f3 [open "|[list cat -u]" r+]}
-}
test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
set result {}
@@ -5363,7 +5519,10 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f
fileevent $f writable {}
lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
-test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs fileevent} {
+test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
set result {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r "read f"
@@ -5376,9 +5535,15 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs fil
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
-} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
-
-test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs fileevent} {
+} -cleanup {
+ catch {close $f2}
+ catch {close $f3}
+} -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
+
+test io-44.1 {FileEventProc procedure: normal read event} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
}]
@@ -5386,10 +5551,15 @@ test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs filee
variable x initial
vwait [namespace which -variable x]
set x
-} {text}
+} -cleanup {
+ catch {close $f2}
+ catch {close $f3}
+} -result {text}
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
- stdio unixExecs fileevent
+ stdio unixExecs fileevent openpipe
} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
proc myHandler {msg options} {
variable x $msg
}
@@ -5403,8 +5573,13 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints {
list $x [fileevent $f2 readable]
} -cleanup {
interp bgerror {} $handler
+ catch {close $f2}
+ catch {close $f3}
} -result {bogus {}}
-test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs fileevent} {
+test io-44.3 {FileEventProc procedure: normal write event} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5418,10 +5593,15 @@ test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs file
vwait [namespace which -variable x]
vwait [namespace which -variable x]
set x
-} {initial triggered triggered triggered}
+} -cleanup {
+ catch {close $f2}
+ catch {close $f3}
+} -result {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
- stdio unixExecs fileevent
+ stdio unixExecs fileevent openpipe
} -setup {
+ set f2 [open "|[list cat -u]" r+]
+ set f3 [open "|[list cat -u]" r+]
proc myHandler {msg options} {
variable x $msg
}
@@ -5434,6 +5614,8 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
list $x [fileevent $f2 writable]
} -cleanup {
interp bgerror {} $handler
+ catch {close $f2}
+ catch {close $f3}
} -result {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
@@ -5452,8 +5634,6 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
set x
} {initial foo eof}
-catch {close $f2}
-catch {close $f3}
close $f
makeFile "foo bar" foo
@@ -6379,27 +6559,29 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
close $s
set wait done
}
- set ss [socket -server [namespace code accept] 0]
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $ss -sockname] 2]
+
variable wait ""
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket 127.0.0.1 $port]
vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
@@ -6458,13 +6640,47 @@ test io-52.4 {TclCopyChannel} {fcopy} {
close $f2
lappend result [file size $path(test1)]
} {0 0 40}
-test io-52.5 {TclCopyChannel} {fcopy} {
+test io-52.5 {TclCopyChannel, all} {fcopy} {
+ file delete $path(test1)
+ set f1 [open $thisScript]
+ set f2 [open $path(test1) w]
+ fconfigure $f1 -translation lf -blocking 0
+ fconfigure $f2 -translation lf -blocking 0
+ fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
+ set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+ close $f1
+ close $f2
+ set s1 [file size $thisScript]
+ set s2 [file size $path(test1)]
+ if {"$s1" == "$s2"} {
+ lappend result ok
+ }
+ set result
+} {0 0 ok}
+test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
- fcopy $f1 $f2 -size -1
+ fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
+ set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+ close $f1
+ close $f2
+ set s1 [file size $thisScript]
+ set s2 [file size $path(test1)]
+ if {"$s1" == "$s2"} {
+ lappend result ok
+ }
+ set result
+} {0 0 ok}
+test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
+ file delete $path(test1)
+ set f1 [open $thisScript]
+ set f2 [open $path(test1) w]
+ fconfigure $f1 -translation lf -blocking 0
+ fconfigure $f2 -translation lf -blocking 0
+ fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
@@ -6723,7 +6939,7 @@ proc FcopyTestDone {bytes {error {}}} {
}
test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
variable fcopyTestDone
- set listen [socket -server [namespace code FcopyTestAccept] 0]
+ set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
set in [open $thisScript] ;# 126 K
set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
@@ -6804,6 +7020,280 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
# -1=error 0=script error N=number of bytes
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}
+test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
+ # copy progress callback. errors out intentionally
+ proc ::cmd args {
+ lappend ::RES "CMD $args"
+ error !STOP
+ }
+ # capture callback error here
+ proc ::bgerror args {
+ lappend ::RES "bgerror/OK $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 {
+ # Record input size, so that result is always defined
+ lappend ::RES [file size $bar]
+ # Run the copy. Should not invoke -command now.
+ fcopy $f $g -size 2 -command ::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.
+ set token [after 1000 {
+ lappend ::RES {bgerror/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 {}
+ rename ::bgerror {}
+ removeFile foo
+ removeFile bar
+} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
+test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -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 {
+ # Initialize and force eof on the input.
+ seek $f 0 end ; read $f 1
+ set ::RES [eof $f]
+ # Run the copy. Should not invoke -command now.
+ fcopy $f $g -size 2 -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 {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]
+ set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+ fconfigure $pipe -translation binary -buffering line
+ puts $pipe {
+ fconfigure stdout -translation binary -buffering line
+ puts stderr Waiting...
+ after 1000
+ foreach x {a b c} {
+ puts stderr Looping...
+ puts $x
+ after 500
+ }
+ proc bye args {
+ if {[gets stdin line]<0} {
+ puts stderr "CHILD: EOF detected, exiting"
+ exit
+ } else {
+ puts stderr "CHILD: ignoring line: $line"
+ }
+ }
+ puts stderr Now-sleeping-forever
+ fileevent stdin readable bye
+ vwait forever
+ }
+ proc ::done args {
+ set ::forever OK
+ return
+ }
+ set ::forever {}
+ set out [open $out w]
+} -constraints {stdio openpipe fcopy} -body {
+ fcopy $pipe $out -size 6 -command ::done
+ set token [after 5000 {
+ set ::forever {fcopy hangs}
+ }]
+ vwait ::forever
+ catch {after cancel $token}
+ set ::forever
+} -cleanup {
+ close $pipe
+ rename ::done {}
+ after 1000; # Give Windows time to kill the process
+ catch {close $out}
+ catch {removeFile out}
+ catch {removeFile err}
+ catch {unset ::forever}
+} -result OK
+test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+ set err [makeFile {} err]
+ set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+ fconfigure $pipe -translation binary -buffering line
+ puts $pipe {
+ fconfigure stderr -buffering line
+ # Kill server when pipe closed by invoker.
+ proc bye args {
+ if {![eof stdin]} { gets stdin ; return }
+ puts stderr BYE
+ exit
+ }
+ # Server code. Bi-directional copy between 2 sockets.
+ proc geof {sok} {
+ puts stderr DONE/$sok
+ close $sok
+ }
+ proc new {sok args} {
+ puts stderr NEW/$sok
+ global l srv
+ fconfigure $sok -translation binary -buffering none
+ lappend l $sok
+ if {[llength $l]==2} {
+ close $srv
+ foreach {a b} $l break
+ fcopy $a $b -command [list geof $a]
+ fcopy $b $a -command [list geof $b]
+ puts stderr 2COPY
+ }
+ puts stderr ...
+ }
+ puts stderr SRV
+ set l {}
+ set srv [socket -server new 9999]
+ puts stderr WAITING
+ fileevent stdin readable bye
+ puts OK
+ vwait forever
+ }
+ # wait for OK from server.
+ gets $pipe
+ # Now the two clients.
+ proc ::done {sock} {
+ if {[eof $sock]} { close $sock ; return }
+ lappend ::forever [gets $sock]
+ return
+ }
+ set a [socket 127.0.0.1 9999]
+ set b [socket 127.0.0.1 9999]
+ fconfigure $a -translation binary -buffering none
+ fconfigure $b -translation binary -buffering none
+ fileevent $a readable [list ::done $a]
+ fileevent $b readable [list ::done $b]
+} -constraints {stdio openpipe fcopy} -body {
+ # Now pass data through the server in both directions.
+ set ::forever {}
+ puts $a AB
+ vwait ::forever
+ puts $b BA
+ vwait ::forever
+ set ::forever
+} -cleanup {
+ catch {close $a}
+ catch {close $b}
+ close $pipe
+ rename ::done {}
+ after 1000 ;# Give Windows time to kill the process
+ removeFile err
+ catch {unset ::forever}
+} -result {AB BA}
+test io-53.11 {Bug 2895565} -setup {
+ set in [makeFile {} in]
+ set f [open $in w]
+ fconfigure $f -encoding utf-8 -translation binary
+ puts -nonewline $f [string repeat "Ho hum\n" 11]
+ close $f
+ set inChan [open $in r]
+ fconfigure $inChan -translation binary
+ set out [makeFile {} out]
+ set outChan [open $out w]
+ fconfigure $outChan -encoding cp1252 -translation crlf
+ proc CopyDone {bytes args} {
+ variable done
+ if {[llength $args]} {
+ set done "Error: '[lindex $args 0]' after $bytes bytes copied"
+ } else {
+ set done "$bytes bytes copied"
+ }
+ }
+} -body {
+ variable done
+ after 2000 [list set [namespace which -variable done] timeout]
+ fcopy $inChan $outChan -size 40 -command [namespace which CopyDone]
+ vwait [namespace which -variable done]
+ set done
+} -cleanup {
+ close $outChan
+ close $inChan
+ removeFile out
+ removeFile in
+} -result {40 bytes copied}
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive
@@ -6826,14 +7316,14 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
}
incr x
}
- set ss [socket -server [namespace code accept] 0]
+ set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
# We need to delay on some systems until the creation of the
# server socket completes.
set done 0
for {set i 0} {$i < 10} {incr i} {
- if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
+ if {![catch {set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]}]} {
set done 1
break
}
@@ -6862,7 +7352,7 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
set accept {}
set after {}
- variable s [socket -server [namespace code accept] 0]
+ variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
proc accept {s a p} {
variable counter
variable accept
@@ -6972,7 +7462,7 @@ test io-57.1 {buffered data and file events, gets} {fileevent} {
variable s2
set s2 $sock
}
- set server [socket -server [namespace code accept] 0]
+ set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
variable s2
vwait [namespace which -variable s2]
@@ -6995,7 +7485,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
variable s2
set s2 $sock
}
- set server [socket -server [namespace code accept] 0]
+ set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
variable s2
vwait [namespace which -variable s2]
@@ -7046,7 +7536,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]
@@ -7138,27 +7628,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.
-
-testConstraint testthread [expr {[info commands testthread] != {}}]
-
-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]
@@ -7167,16 +7637,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
@@ -7370,11 +7841,29 @@ foreach {n msg expected} {
} [lrange $expected 0 end]
}
+test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
+ # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+ catch {close [lreplace [list a] 0 end]}
+} {1}
+
+test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
+ # Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters.
+ set f [open [info script] r]
+} -body {
+ interp create foo
+ seek $f 0
+ set code [catch {interp eval foo [list seek $f 0]} msg]
+ # The string map converts the changing channel handle to a fixed string
+ list $code [string map [list $f @@] $msg]
+} -cleanup {
+ close $f
+} -result {1 {can not find channel named "@@"}}
+
# ### ### ### ######### ######### #########
# cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script foo \
- bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+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
}
cleanupTests
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 2c95b13..3976d25 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -12,15 +12,21 @@
#
# 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.24 2005/08/24 17:56:24 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-testConstraint fcopy [llength [info commands fcopy]]
+::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 thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+#----------------------------------------------------------------------
test iocmd-1.1 {puts command} {
list [catch {puts} msg] $msg
@@ -30,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"}}
@@ -62,7 +68,6 @@ test iocmd-1.8 {puts command} {
file size $path(test1)
} 9
-
test iocmd-2.1 {flush command} {
list [catch {flush} msg] $msg
} {1 {wrong # args: should be "flush channelId"}}
@@ -113,8 +118,8 @@ test iocmd-4.4 {read command} {
list [catch {read -nonewline} msg] $msg
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
test iocmd-4.5 {read command} {
- list [catch {read -nonew file4} msg] $msg $errorCode
-} {1 {can not find channel named "-nonew"} NONE}
+ list [catch {read -nonew file4} msg] $msg $::errorCode
+} {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}}
test iocmd-4.6 {read command} {
list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
@@ -128,45 +133,44 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
puts $f "and this one"
close $f
set f [open $path(test1)]
- set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
+ set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
close $f
set x
-} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
+} {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}
+ list [catch {read stdin foo} msg] $msg $::errorCode
+} {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"} NONE}
-
+ list [catch {read file107} msg] $msg $::errorCode
+} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}}
set path(test3) [makeFile {} test3]
-
test iocmd-4.11 {read command} {
set f [open $path(test3) w]
- set x [list [catch {read $f} msg] $msg $errorCode]
+ set x [list [catch {read $f} msg] $msg $::errorCode]
close $f
string compare [string tolower $x] \
[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
} 0
-test iocmd-4.12 {read command} {
+test iocmd-4.12 {read command} -setup {
set f [open $path(test1)]
- set x [list [catch {read $f 12z} msg] $msg $errorCode]
+} -body {
+ list [catch {read $f 12z} msg] $msg $::errorCode
+} -cleanup {
close $f
- set x
-} {1 {expected integer but got "12z"} NONE}
-
-test iocmd-5.1 {seek command} {
- list [catch {seek} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.2 {seek command} {
- list [catch {seek a b c d e f g} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.3 {seek command} {
- list [catch {seek stdin gugu} msg] $msg
-} {1 {expected integer but got "gugu"}}
-test iocmd-5.4 {seek command} {
- list [catch {seek stdin 100 gugu} msg] $msg
-} {1 {bad origin "gugu": must be start, current, or end}}
+} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}}
+
+test iocmd-5.1 {seek command} -returnCodes error -body {
+ seek
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.2 {seek command} -returnCodes error -body {
+ seek a b c d e f g
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.3 {seek command} -returnCodes error -body {
+ seek stdin gugu
+} -result {expected integer but got "gugu"}
+test iocmd-5.4 {seek command} -returnCodes error -body {
+ seek stdin 100 gugu
+} -result {bad origin "gugu": must be start, current, or end}
test iocmd-6.1 {tell command} {
list [catch {tell} msg] $msg
@@ -180,20 +184,34 @@ test iocmd-6.3 {tell command} {
test iocmd-7.1 {close command} {
list [catch {close} msg] $msg
-} {1 {wrong # args: should be "close channelId"}}
+} {1 {wrong # args: should be "close channelId ?direction?"}}
test iocmd-7.2 {close command} {
list [catch {close a b c d e} msg] $msg
-} {1 {wrong # args: should be "close channelId"}}
+} {1 {wrong # args: should be "close channelId ?direction?"}}
test iocmd-7.3 {close command} {
list [catch {close aaa} msg] $msg
} {1 {can not find channel named "aaa"}}
+test iocmd-7.4 {close command} -setup {
+ set chan [open [info script] r]
+} -body {
+ chan close $chan bar
+} -cleanup {
+ close $chan
+} -returnCodes error -result "bad direction \"bar\": must be read or write"
+test iocmd-7.5 {close command} -setup {
+ set chan [open [info script] r]
+} -body {
+ chan close $chan write
+} -cleanup {
+ close $chan
+} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
test iocmd-8.1 {fconfigure command} {
list [catch {fconfigure} msg] $msg
-} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
+} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
test iocmd-8.2 {fconfigure command} {
list [catch {fconfigure a b c d e f} msg] $msg
-} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
+} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
test iocmd-8.3 {fconfigure command} {
list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
@@ -241,102 +259,109 @@ test iocmd-8.9 {fconfigure command} {
test iocmd-8.10 {fconfigure command} {
list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
-
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
-
test iocmd-8.11 {fconfigure command} {
set chan [open $path(fconfigure.dummy) r]
set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg]
close $chan
set res
} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
test iocmd-8.12 {fconfigure command} {
set chan [open $path(fconfigure.dummy) r]
set res [list [catch {fconfigure $chan -b blarfo} msg] $msg]
close $chan
set res
} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
test iocmd-8.13 {fconfigure command} {
set chan [open $path(fconfigure.dummy) r]
set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg]
close $chan
set res
} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
removeFile fconfigure.dummy
-
test iocmd-8.14 {fconfigure command} {
fconfigure stdin -buffers
} 4096
-
-proc iocmdSSETUP {} {
- uplevel {
- set srv [socket -server iocmdSRV 0]
- set port [lindex [fconfigure $srv -sockname] 2]
- proc iocmdSRV {sock ip port} {close $sock}
- set cli [socket 127.0.0.1 $port]
- }
-}
-proc iocmdSSHTDWN {} {
- uplevel {
- close $cli
- close $srv
- unset cli srv port
- rename iocmdSRV {}
- }
-}
-
-test iocmd-8.15.1 {fconfigure command / tcp channel} {socket unixOrPc} {
- iocmdSSETUP
- set r [list [catch {fconfigure $cli -blah} msg] $msg]
- iocmdSSHTDWN
- set r
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}}
-test iocmd-8.16 {fconfigure command / tcp channel} {socket} {
- iocmdSSETUP
- set r [expr [lindex [fconfigure $cli -peername] 2]==$port]
- iocmdSSHTDWN
- set r
-} 1
-test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} {
- # It is possible that you don't get the connection reset by peer
- # error but rather a valid answer. depends of the tcp implementation
- iocmdSSETUP
- update;
- puts $cli "blah"; flush $cli; # that flush could/should fail too
- update;
- set r [catch {fconfigure $cli -peername} msg]
- iocmdSSHTDWN
- regsub -all {can([^:])+: } $r {} r;
- set r
-} 1
-test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unix} {
- # might fail if /dev/ttya is unavailable
- set tty [open /dev/ttya]
- set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
- close $tty;
- set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}}
-test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable win} {
- # might fail if com1 is unavailable
- set tty [open com1]
- set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
- close $tty;
- set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, or -pollinterval}}
+test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup {
+ set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $srv -sockname] 2]
+ proc iocmdSRV {sock ip port} {close $sock}
+ set cli [socket 127.0.0.1 $port]
+} -body {
+ fconfigure $cli -blah
+} -cleanup {
+ close $cli
+ close $srv
+ unset cli srv port
+ rename iocmdSRV {}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
+test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
+ set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $srv -sockname] 2]
+ proc iocmdSRV {sock ip port} {close $sock}
+ set cli [socket 127.0.0.1 $port]
+} -body {
+ expr {[lindex [fconfigure $cli -peername] 2] == $port}
+} -cleanup {
+ close $cli
+ close $srv
+ unset cli srv port
+ rename iocmdSRV {}
+} -result 1
+test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup {
+ set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $srv -sockname] 2]
+ proc iocmdSRV {sock ip port} {close $sock}
+ set cli [socket 127.0.0.1 $port]
+} -body {
+ # It is possible that you don't get the connection reset by peer
+ # error but rather a valid answer. Depends on the tcp implementation
+ update
+ puts $cli "blah"
+ flush $cli; # that flush could/should fail too
+ update
+ regsub -all {can([^:])+: } [catch {fconfigure $cli -peername} msg] {}
+} -cleanup {
+ close $cli
+ close $srv
+ unset cli srv port
+ rename iocmdSRV {}
+} -result 1
+test iocmd-8.18 {fconfigure command / unix tty channel} -constraints {nonPortable unix} -setup {
+ set tty ""
+} -body {
+ # might fail if /dev/ttya is unavailable
+ set tty [open /dev/ttya]
+ fconfigure $tty -blah blih
+} -cleanup {
+ if {$tty ne ""} {
+ close $tty
+ }
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}
+test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup {
+ set tty ""
+} -body {
+ # might fail early if com1 is unavailable
+ set tty [open com1]
+ fconfigure $tty -blah blih
+} -cleanup {
+ if {$tty ne ""} {
+ close $tty
+ }
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
+# TODO: Test parsing of serial channel options (nonportable, since requires an
+# open channel to work with).
test iocmd-9.1 {eof command} {
- list [catch {eof} msg] $msg $errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+ list [catch {eof} msg] $msg $::errorCode
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.2 {eof command} {
- list [catch {eof a b} msg] $msg $errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+ list [catch {eof a b} msg] $msg $::errorCode
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.3 {eof command} {
catch {close file100}
- list [catch {eof file100} msg] $msg $errorCode
-} {1 {can not find channel named "file100"} NONE}
+ list [catch {eof file100} msg] $msg $::errorCode
+} {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}}
# The tests for Tcl_ExecObjCmd are in exec.test
@@ -363,14 +388,17 @@ file delete $path(test5)
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}
+ list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
+} {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}
+ list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
+} {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}
+ list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
+} {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}}}
test iocmd-12.1 {POSIX open access modes: RDONLY} {
file delete $path(test1)
@@ -419,7 +447,7 @@ test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
open $path(test3) RDWR
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test iocmd-12.6 {POSIX open access modes: errors} {
- concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
+ concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$::errorInfo
} "1 unmatched open brace in list
unmatched open brace in list
while processing open access modes \"FOO {BAR BAZ\"
@@ -449,7 +477,7 @@ test iocmd-12.10 {POSIX open access modes: BINARY} {
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} {
set f [open $path(test1) {WRONLY BINARY TRUNC}]
- puts $f \u0248 ;# gets truncated to \u0048
+ puts $f \u0248 ;# gets truncated to \u0048
close $f
set f [open $path(test1) r]
fconfigure $f -translation binary
@@ -474,9 +502,9 @@ test iocmd-13.5 {errors in open command} {
list [catch {open $path(test1) r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test iocmd-13.6 {errors in open command} {
- set msg [list [catch {open _non_existent_} msg] $msg $errorCode]
+ set msg [list [catch {open _non_existent_} msg] $msg $::errorCode]
regsub [file join {} _non_existent_] $msg "_non_existent_" msg
- string tolower $msg
+ string tolower $msg
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
test iocmd-13.7 {errors in open command} {
list [catch {open $path(test1) b} msg] $msg
@@ -487,10 +515,61 @@ test iocmd-13.8 {errors in open command} {
test iocmd-13.9 {errors in open command} {
list [catch {open $path(test1) r++} msg] $msg
} {1 {illegal access mode "r++"}}
+test iocmd-13.10.1 {open for append, a mode} -setup {
+ set log [makeFile {} out]
+ set chans {}
+} -body {
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } {
+ puts [set ch [open $log a]] $i
+ lappend chans $ch
+ }
+ foreach ch $chans {catch {close $ch}}
+ lsort [split [string trim [viewFile out]] \n]
+} -cleanup {
+ removeFile out
+ # Ensure that channels are gone, even if body failed to do so
+ foreach ch $chans {catch {close $ch}}
+} -result {0 1 2 3 4 5 6 7 8 9}
+test iocmd-13.10.2 {open for append, O_APPEND} -setup {
+ set log [makeFile {} out]
+ set chans {}
+} -body {
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } {
+ puts [set ch [open $log {WRONLY CREAT APPEND}]] $i
+ lappend chans $ch
+ }
+ foreach ch $chans {catch {close $ch}}
+ lsort [split [string trim [viewFile out]] \n]
+} -cleanup {
+ removeFile out
+ # Ensure that channels are gone, even if body failed to do so
+ foreach ch $chans {catch {close $ch}}
+} -result {0 1 2 3 4 5 6 7 8 9}
+test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup {
+ set f [makeFile {} ioutil41.tmp]
+ set fid [open $f wb]
+ puts -nonewline $fid 123
+ close $fid
+} -body {
+ set fid [open $f ab+]
+ puts -nonewline $fid 456
+ seek $fid 2
+ set d [read $fid 2]
+ seek $fid 4
+ puts -nonewline $fid x
+ close $fid
+ set fid [open $f rb]
+ append d [read $fid]
+ close $fid
+ return $d
+} -cleanup {
+ removeFile $f
+} -result 341234x6
+
test iocmd-14.1 {file id parsing errors} {
- list [catch {eof gorp} msg] $msg $errorCode
-} {1 {can not find channel named "gorp"} NONE}
+ list [catch {eof gorp} msg] $msg $::errorCode
+} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}
@@ -541,10 +620,8 @@ test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} {
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
set path(test2) [makeFile {} test2]
-
set f [open $path(test1) w]
close $f
-
set rfile [open $path(test1) r]
set wfile [open $path(test2) w]
@@ -579,12 +656,10 @@ close $wfile
test iocmd-20.0 {chan, wrong#args} {
catch {chan} msg
set msg
-} {wrong # args: should be "chan subcommand ?argument ...?"}
-
-test iocmd-20.1 {chan, unknown method} {
- catch {chan foo} msg
- set msg
-} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate}
+} {wrong # args: should be "chan subcommand ?arg ...?"}
+test iocmd-20.1 {chan, unknown method} -body {
+ chan foo
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *}
# --- --- --- --------- --------- ---------
# chan create, and method "initalize"
@@ -593,120 +668,102 @@ test iocmd-21.0 {chan create, wrong#args, not enough} {
catch {chan create} msg
set msg
} {wrong # args: should be "chan create mode cmdprefix"}
-
test iocmd-21.1 {chan create, wrong#args, too many} {
catch {chan create a b c} msg
set msg
} {wrong # args: should be "chan create mode cmdprefix"}
-
test iocmd-21.2 {chan create, invalid r/w mode, empty} {
proc foo {} {}
catch {chan create {} foo} msg
rename foo {}
set msg
} {bad mode list: is empty}
-
test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
proc foo {} {}
catch {chan create {c} foo} msg
rename foo {}
set msg
} {bad mode "c": must be read or write}
-
test iocmd-21.4 {chan create, bad handler, not a list} {
catch {chan create {r w} "foo \{"} msg
set msg
} {unmatched open brace in list}
-
test iocmd-21.5 {chan create, bad handler, not a command} {
catch {chan create {r w} foo} msg
set msg
-} {Initialize failure: invalid command name "foo"}
-
+} {invalid command name "foo"}
test iocmd-21.6 {chan create, initialize failed, bad signature} {
proc foo {} {}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: wrong # args: should be "foo"}
-
+} {wrong # args: should be "foo"}
test iocmd-21.7 {chan create, initialize failed, bad signature} {
proc foo {} {}
catch {chan create {r w} ::foo} msg
rename foo {}
set msg
-} {Initialize failure: wrong # args: should be "::foo"}
-
-test iocmd-21.8 {chan create, initialize failed, bad result, not a list} {
+} {wrong # args: should be "::foo"}
+test iocmd-21.8 {chan create, initialize failed, bad result, not a list} -body {
proc foo {args} {return "\{"}
catch {chan create {r w} foo} msg
rename foo {}
- set msg
-} {Initialize failure: unmatched open brace in list}
-
-test iocmd-21.9 {chan create, initialize failed, bad result, not a list} {
+ set ::errorInfo
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iocmd-21.9 {chan create, initialize failed, bad result, not a list} -body {
proc foo {args} {return \{\{\}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: unmatched open brace in list}
-
-test iocmd-21.10 {chan create, initialize failed, bad result, empty list} {
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iocmd-21.10 {chan create, initialize failed, bad result, empty list} -body {
proc foo {args} {}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: Not all required methods supported}
-
-test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} {
+} -match glob -result {*all required methods*}
+test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} -body {
proc foo {args} {return 1}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: bad method "1": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write}
-
-test iocmd-21.12 {chan create, initialize failed, bad result, ambiguous method name} {
+} -match glob -result {*bad method "1": must be *}
+test iocmd-21.12 {chan create, initialize failed, bad result, bogus method name} -body {
proc foo {args} {return {a b c}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: ambiguous method "c": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write}
-
-test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} {
+} -match glob -result {*bad method "c": must be *}
+test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} -body {
proc foo {args} {return {initialize finalize}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: Not all required methods supported}
-
-test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} {
+} -match glob -result {*all required methods*}
+test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
proc foo {args} {return {initialize finalize watch read}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: Writing not supported, but requested}
-
-test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} {
+} -match glob -result {*lacks a "write" method}
+test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
proc foo {args} {return {initialize finalize watch write}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: Reading not supported, but requested}
-
-test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} {
+} -match glob -result {*lacks a "read" method}
+test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
proc foo {args} {return {initialize finalize watch cget write read}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: 'cgetall' not supported, but should be, as 'cget' is}
-
-test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} {
+} -match glob -result {*supports "cget" but not "cgetall"}
+test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
proc foo {args} {return {initialize finalize watch cgetall read write}}
catch {chan create {r w} foo} msg
rename foo {}
set msg
-} {Initialize failure: 'cget' not supported, but should be, as 'cgetall' is}
-
+} -match glob -result {*supports "cgetall" but not "cget"}
test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body {
proc foo {args} {
global res
@@ -722,7 +779,6 @@ test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body
rename foo {}
set res
} -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}}
-
test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body {
proc foo {args} {
global res
@@ -736,14 +792,107 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
lappend res [file channel rc*]
rename foo {}
set res
-} -result {{} {initialize rc* {read write}} 1 {Initialize failure: Not all required methods supported} {}}
+} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ close $chan
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 0
+} -cleanup {
+ close $ch
+ rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 1
+} -returnCodes error -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ chan configure $ch -translation binary
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
-proc note {item} {global res ; lappend res $item ; return}
-proc track {} {upvar args item ; note $item; return}
+# Stored in a script so that the threads and interpreters needing this
+# code do not need their own copy but can access this variable.
+
+set helperscript {
+
+proc note {item} {global res; lappend res $item; return}
+proc track {} {upvar args item; note $item; return}
proc notes {items} {foreach i $items {note $i}}
+# This forces the return options to be in the order that the test expects!
+proc noteOpts opts {global res; lappend res [dict merge {
+ -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+} $opts]; return}
# Helper command, canned result for 'initialize' method.
# Gets the optional methods as arguments. Use return features
@@ -753,132 +902,108 @@ proc init {args} {
lappend args initialize finalize watch read write
return -code return $args
}
-
proc oninit {args} {
upvar args hargs
if {[lindex $hargs 0] ne "initialize"} {return}
lappend args initialize finalize watch read write
return -code return $args
}
-
proc onfinal {} {
upvar args hargs
if {[lindex $hargs 0] ne "finalize"} {return}
return -code return ""
}
+}
+
+# Set everything up in the main thread.
+eval $helperscript
# --- --- --- --------- --------- ---------
# method finalize
test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
set res {}
- proc foo {args} {track ; oninit; return}
+ proc foo {args} {track; oninit; return}
note [set c [chan create {r w} foo]]
-
rename foo {}
-
note [file channels rc*]
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
note [file channels rc*]
-
set res
} -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}}
-
test iocmd-22.2 {chan finalize, for close} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return {}}
+ proc foo {args} {track; oninit; return {}}
note [set c [chan create {r w} foo]]
-
close $c
-
# Close deleted the channel.
note [file channels rc*]
-
# Channel destruction does not kill handler command!
note [info command foo]
-
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
-
test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return -code error 5}
+ proc foo {args} {track; oninit; return -code error 5}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
# Channel is gone despite error.
note [file channels rc*]
-
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
-
test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; error FOO}
+ proc foo {args} {track; oninit; error FOO}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg] ; note $msg
-
+ note [catch {close $c} msg]; note $msg; note $::errorInfo
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO {FOO
+*"close $c"}}
test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return SOMETHING}
+ proc foo {args} {track; oninit; return SOMETHING}
note [set c [chan create {r w} foo]]
-
note [catch {close $c} msg]; note $msg
-
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
-
test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return -code 3}
+ proc foo {args} {track; oninit; return -code 3}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg] ; note $msg
-
+ note [catch {close $c} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return -code 4}
+ proc foo {args} {track; oninit; return -code 4}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg] ; note $msg
-
+ note [catch {close $c} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return -code 777 BANG}
+ proc foo {args} {track; oninit; return -code 777 BANG}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg] ; note $msg
-
+ note [catch {close $c} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG}
-
-test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
+test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
set res {}
- proc foo {args} {track ; oninit ; return -level 5 -code 777 BANG}
+} -body {
+ proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
note [set c [chan create {r w} foo]]
-
- note [catch {close $c} msg opt] ; note $msg ; note $opt
-
+ note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+ return $res
+} -cleanup {
rename foo {}
- set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
# --- === *** ###########################
# method read
@@ -886,117 +1011,144 @@ test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glo
test iocmd-23.1 {chan read, regular data return} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return snarf
}
set c [chan create {r w} foo]
-
note [read $c 10]
close $c
-
rename foo {}
set res
} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
-
test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return [string repeat snarf 1000]
}
set c [chan create {r w} foo]
-
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{read rc* 4096} 1 {read delivered more than requested}}
-
test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
- note MUST_NOT_HAPPEN
+ oninit; onfinal; track; note MUST_NOT_HAPPEN
}
set c [chan create {w} foo]
-
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {1 {channel "rc*" wasn't opened for reading}}
-
test iocmd-23.4 {chan read, error return} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{read rc* 4096} 1 BOOM!}
-
test iocmd-23.5 {chan read, break return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!}
-
+} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.6 {chan read, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!}
-
+} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.7 {chan read, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code 777 BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!}
-
+} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.8 {chan read, level is squashed} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -level 55 -code 777 BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg opt] ; note $msg ; note $opt
+ note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+ close $c
+ rename foo {}
+ set res
+} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ return ""
+ }
+ set c [chan create {r w} foo]
+} -body {
+ note [read $c 2]
+ note [eof $c]
+ set res
+} -cleanup {
close $c
-
rename foo {}
+ unset res
+} -result {{read rc* 4096} {} 1}
+test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ error EAGAIN
+ }
+ set c [chan create {r w} foo]
+} -body {
+ note [read $c 2]
+ note [eof $c]
set res
-} -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}}
+} -cleanup {
+ close $c
+ rename foo {}
+ unset res
+} -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ set args [lassign $args sub id]
+ if {$sub ne "read"} {return}
+ close $id
+ return {}
+ }
+ set c [chan create {r} foo]
+ note [read $c]
+ rename foo {}
+ set res
+} -result {{read rc* 4096} {}}
# --- === *** ###########################
# method write
@@ -1004,324 +1156,291 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body {
test iocmd-24.1 {chan write, regular write} -match glob -body {
set res {}
proc foo {args} {
- oninit; onfinal ; track
+ oninit; onfinal; track
set written [string length [lindex $args 2]]
note $written
return $written
}
set c [chan create {r w} foo]
-
- puts -nonewline $c snarf ; flush $c
+ puts -nonewline $c snarf; flush $c
close $c
-
rename foo {}
set res
} -result {{write rc* snarf} 5}
-
test iocmd-24.2 {chan write, partial write is ok} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
set written [string length [lindex $args 2]]
if {$written > 10} {set written [expr {$written / 2}]}
note $written
return $written
}
set c [chan create {r w} foo]
-
- puts -nonewline $c snarfsnarfsnarf ; flush $c
+ puts -nonewline $c snarfsnarfsnarf; flush $c
close $c
-
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
-
test iocmd-24.3 {chan write, failed write} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note -1 ; return -1}
-
+ proc foo {args} {oninit; onfinal; track; note -1; return -1}
set c [chan create {r w} foo]
- puts -nonewline $c snarfsnarfsnarf ; flush $c
+ puts -nonewline $c snarfsnarfsnarf; flush $c
close $c
-
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} -1}
-
test iocmd-24.4 {chan write, non-writable channel} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {1 {channel "rc*" wasn't opened for writing}}
-
test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return 10000}
+ proc foo {args} {oninit; onfinal; track; return 10000}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{write rc* snarf} 1 {write wrote more than requested}}
-
test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return 0}
+ proc foo {args} {oninit; onfinal; track; return 0}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{write rc* snarf} 1 {write wrote more than requested}}
-
+} -result {{write rc* snarf} 1 {write wrote nothing}}
test iocmd-24.7 {chan write, failed write, error return} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!}
+ proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
-
test iocmd-24.8 {chan write, failed write, error return} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; error BOOM!}
+ proc foo {args} {oninit; onfinal; track; error BOOM!}
set c [chan create {r w} foo]
-
- notes [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
-
test iocmd-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!}
+ proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
test iocmd-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!}
+ proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
test iocmd-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!}
+ proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return BANG}
+ proc foo {args} {oninit; onfinal; track; return BANG}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
-
rename foo {}
set res
} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}}
-
test iocmd-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!}
+ proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
set c [chan create {r w} foo]
-
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
+ close $c
+ rename foo {}
+ set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
+test iocmd-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ return 3
+ }
+ set c [chan create {r w} foo]
+} -body {
+ note [puts -nonewline $c ABC ; flush $c]
+ set res
+} -cleanup {
close $c
-
rename foo {}
+ unset res
+} -result {{write rc* ABC} {}}
+test iocmd-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -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 {
+ note [puts -nonewline $c ABC ; flush $c]
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}}
+} -cleanup {
+ close $c
+ rename foo {}
+ unset res
+} -result {{write rc* ABC} {watch rc* write} {}}
# --- === *** ###########################
# method cgetall
test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
note [fconfigure $c]
close $c
-
rename foo {}
set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
-
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
- proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""}
+ proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
set c [chan create {r w} foo]
-
note [fconfigure $c]
close $c
-
rename foo {}
set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
-
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "-bar foo -snarf x"
}
set c [chan create {r w} foo]
-
note [fconfigure $c]
close $c
-
rename foo {}
set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
-
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "-bar"
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
-
test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "\{"
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{cgetall rc*} 1 {unmatched open brace in list}}
-
test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{cgetall rc*} 1 BOOM!}
-
test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!}
-
+} -result {{cgetall rc*} 1 *bad code*}
test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!}
-
+} -result {{cgetall rc*} 1 *bad code*}
test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code 777 BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!}
-
+} -result {{cgetall rc*} 1 *bad code*}
test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -level 55 -code 777 BANG
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt
close $c
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}}
# --- === *** ###########################
# method configure
@@ -1329,427 +1448,333 @@ test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
test iocmd-26.1 {chan configure, set standard option} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN
- return
+ oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
}
set c [chan create {r w} foo]
-
note [fconfigure $c -translation lf]
close $c
-
rename foo {}
set res
} -result {{}}
-
test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} 1 BOOM!}
-
test iocmd-26.3 {chan configure, set option, ok return} -match glob -body {
set res {}
- proc foo {args} {oninit configure ; onfinal ; track ; return}
+ proc foo {args} {oninit configure; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -rc-foo bar]
close $c
-
rename foo {}
set res
} -result {{configure rc* -rc-foo bar} {}}
-
test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code 444 BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -level 55 -code 444 BANG
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt
close $c
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}}
# --- === *** ###########################
# method cget
test iocmd-27.1 {chan configure, get option, ok return} -match glob -body {
set res {}
- proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo}
+ proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
set c [chan create {r w} foo]
-
note [fconfigure $c -rc-foo]
close $c
-
rename foo {}
set res
} -result {{cget rc* -rc-foo} foo}
-
test iocmd-27.2 {chan configure, get option, error return} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 BOOM!}
-
test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{cget rc* -rc-foo} 1 BOOM!}
-
test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BOOM!}
-
+} -result {{cget rc* -rc-foo} 1 *bad code*}
test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code 333 BOOM!
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BOOM!}
-
+} -result {{cget rc* -rc-foo} 1 *bad code*}
test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -level 77 -code 333 BANG
}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt
close $c
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}}
# --- === *** ###########################
# method seek
test iocmd-28.1 {chan tell, not supported by handler} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
note [tell $c]
close $c
-
rename foo {}
set res
} -result {-1}
-
test iocmd-28.2 {chan tell, error return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 current} 1 BOOM!}
-
test iocmd-28.3 {chan tell, break return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!}
-
+} -result {{seek rc* 0 current} 1 *bad code*}
test iocmd-28.4 {chan tell, continue return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!}
-
+} -result {{seek rc* 0 current} 1 *bad code*}
test iocmd-28.5 {chan tell, custom return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code 222 BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!}
-
+} -result {{seek rc* 0 current} 1 *bad code*}
test iocmd-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}
+ proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg opt] ; note $msg ; note $opt
+ note [catch {tell $c} msg opt]; note $msg; noteOpts $opt
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
-
+} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
test iocmd-28.7 {chan tell, regular return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return 88}
+ proc foo {args} {oninit seek; onfinal; track; return 88}
set c [chan create {r w} foo]
-
note [tell $c]
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 current} 88}
-
test iocmd-28.8 {chan tell, negative return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -1}
+ proc foo {args} {oninit seek; onfinal; track; return -1}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 current} 1 {Tried to seek before origin}}
-
test iocmd-28.9 {chan tell, string return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+ proc foo {args} {oninit seek; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}}
-
test iocmd-28.10 {chan seek, not supported by handler} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {1 {error during seek on "rc*": invalid argument}}
-
test iocmd-28.11 {chan seek, error return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 start} 1 BOOM!}
-
test iocmd-28.12 {chan seek, break return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!}
-
+} -result {{seek rc* 0 start} 1 *bad code*}
test iocmd-28.13 {chan seek, continue return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!}
-
+} -result {{seek rc* 0 start} 1 *bad code*}
test iocmd-28.14 {chan seek, custom return is error} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -code 99 BOOM!}
+ proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!}
-
+} -result {{seek rc* 0 start} 1 *bad code*}
test iocmd-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}
+ proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt
+ note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt
close $c
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
-
+} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return -45}
+ proc foo {args} {oninit seek; onfinal; track; return -45}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 start} 1 {Tried to seek before origin}}
-
test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+ proc foo {args} {oninit seek; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]; note $msg
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}}
-
test iocmd-28.18 {chan seek, ok result} -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return 23}
+ proc foo {args} {oninit seek; onfinal; track; return 23}
set c [chan create {r w} foo]
-
note [seek $c 0 current]
close $c
-
rename foo {}
set res
} -result {{seek rc* 0 current} {}}
-
-foreach {n code} {
- 0 start
- 1 current
- 2 end
+foreach {testname code} {
+ iocmd-28.19.0 start
+ iocmd-28.19.1 current
+ iocmd-28.19.2 end
} {
- test iocmd-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+ test $testname "chan seek, base conversion, $code" -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return 0}
-
+ proc foo {args} {oninit seek; onfinal; track; return 0}
set c [chan create {r w} foo]
note [seek $c 0 $code]
close $c
-
rename foo {}
set res
} -result [list [list seek rc* 0 $code] {}]
@@ -1760,136 +1785,105 @@ foreach {n code} {
test iocmd-29.1 {chan blocking, no handler support} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -blocking]
close $c
-
rename foo {}
set res
} -result {1}
-
test iocmd-29.2 {chan blocking, no handler support} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -blocking 0]
note [fconfigure $c -blocking]
close $c
-
rename foo {}
set res
} -result {{} 0}
-
test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -blocking]
close $c
-
rename foo {}
set res
} -result {1}
-
test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return}
+ proc foo {args} {oninit blocking; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -blocking 0]
note [fconfigure $c -blocking]
close $c
-
rename foo {}
set res
} -result {{blocking rc* 0} {} 0}
-
test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return}
+ proc foo {args} {oninit blocking; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fconfigure $c -blocking 1]
note [fconfigure $c -blocking]
close $c
-
rename foo {}
set res
} -result {{blocking rc* 1} {} 1}
-
test iocmd-29.6 {chan blocking, error return} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; error BOOM!}
-
+ proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
-
+ note [catch {fconfigure $c -blocking 0} msg]; note $msg
# Catch the close. It changes blocking mode internally, and runs into the error result.
catch {close $c}
rename foo {}
set res
} -result {{blocking rc* 0} 1 BOOM!}
-
test iocmd-29.7 {chan blocking, break return is error} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return -code break BOOM!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
-
+ note [catch {fconfigure $c -blocking 0} msg]; note $msg
catch {close $c}
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!}
-
+} -result {{blocking rc* 0} 1 *bad code*}
test iocmd-29.8 {chan blocking, continue return is error} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return -code continue BOOM!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
-
+ note [catch {fconfigure $c -blocking 0} msg]; note $msg
catch {close $c}
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!}
-
+} -result {{blocking rc* 0} 1 *bad code*}
test iocmd-29.9 {chan blocking, custom return is error} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return -code 44 BOOM!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
-
+ note [catch {fconfigure $c -blocking 0} msg]; note $msg
catch {close $c}
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!}
-
-test iocmd-29.10 {chan blocking, level is ignored} -match glob -body {
+} -result {{blocking rc* 0} 1 *bad code*}
+test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return -level 99 -code 44 BANG}
+} -body {
+ proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt
-
+ note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt
catch {close $c}
+ return $res
+} -cleanup {
rename foo {}
- set res
-} -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
-
+} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}}
test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
set res {}
- proc foo {args} {oninit blocking ; onfinal ; track ; return BOGUS}
+ proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
-
+ note [catch {fconfigure $c -blocking 0} msg]; note $msg
catch {close $c}
rename foo {}
set res
@@ -1900,54 +1894,43 @@ test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -
test iocmd-30.1 {chan watch, read interest, some return} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return IGNORED}
+ proc foo {args} {oninit; onfinal; track; return IGNORED}
set c [chan create {r w} foo]
-
note [fileevent $c readable {set tick $tick}]
- close $c ;# 2nd watch, interest zero.
-
+ close $c ;# 2nd watch, interest zero.
rename foo {}
set res
} -result {{watch rc* read} {} {watch rc* {}}}
-
test iocmd-30.2 {chan watch, write interest, error return} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!_IGNORED}
+ proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
set c [chan create {r w} foo]
-
note [fileevent $c writable {set tick $tick}]
note [fileevent $c writable {}]
close $c
-
rename foo {}
set res
} -result {{watch rc* write} {} {watch rc* {}} {}}
-
test iocmd-30.3 {chan watch, accumulated interests} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fileevent $c writable {set tick $tick}]
note [fileevent $c readable {set tick $tick}]
note [fileevent $c writable {}]
note [fileevent $c readable {}]
close $c
-
rename foo {}
set res
} -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}}
-
test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fileevent $c writable {set tick $tick}]
note [fileevent $c readable {set tick $tick}] ;# Script is changing,
note [fileevent $c readable {set tock $tock}] ;# interest does not.
-
- close $c ;# 3rd and 4th watch, removing the event handlers.
+ close $c ;# 3rd and 4th watch, removing the event handlers.
rename foo {}
set res
} -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}}
@@ -1957,95 +1940,181 @@ test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body
test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body {
set c [open [makeFile {} goo] r]
-
catch {chan postevent $c {r w}} msg
-
close $c
removeFile goo
set msg
-} -result {channel "file*" is not a reflected channel}
-
+} -result {can not find reflected channel named "file*"}
test iocmd-31.2 {chan postevent, unwanted events} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
- catch {chan postevent $c {r w}} msg ; note $msg
+ catch {chan postevent $c {r w}} msg; note $msg
close $c
-
rename foo {}
set res
} -result {{tried to post events channel "rc*" is not interested in}}
-
test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
- catch {chan postevent $c {}} msg ; note $msg
+ catch {chan postevent $c {}} msg; note $msg
close $c
-
rename foo {}
set res
} -result {{bad event list: is empty}}
-
test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
- catch {chan postevent $c goo} msg ; note $msg
+ catch {chan postevent $c goo} msg; note $msg
close $c
-
rename foo {}
set res
} -result {{bad event "goo": must be read or write}}
-
test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
- catch {chan postevent $c "\{"} msg ; note $msg
+ catch {chan postevent $c "\{"} msg; note $msg
close $c
-
rename foo {}
set res
} -result {{unmatched open brace in list}}
-
test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fileevent $c readable {note TOCK}]
-
set stop [after 10000 {note TIMEOUT}]
after 1000 {note [chan postevent $c r]}
vwait ::res
catch {after cancel $stop}
close $c
-
rename foo {}
set res
} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
-
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
note [fileevent $c writable {note TOCK}]
-
set stop [after 10000 {note TIMEOUT}]
after 1000 {note [chan postevent $c w]}
vwait ::res
catch {after cancel $stop}
close $c
-
rename foo {}
set res
} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
+test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
+ proc foo {args} {oninit; onfinal; track; return}
+ proc dummy args { return }
+ set c [chan create {r w} foo]
+ fileevent $c readable dummy
+} -body {
+ close $c
+ chan postevent $c read
+} -cleanup {
+ rename foo {}
+ rename dummy {}
+} -returnCodes error -result {can not find reflected channel named "rc*"}
+
+# --- === *** ###########################
+# '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 iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
+
+ set ida [interp create];#puts <<$ida>>
+ set idb [interp create];#puts <<$idb>>
+
+ # Magic to get the test* commands in the slaves
+ load {} Tcltest $ida
+ load {} Tcltest $idb
+
+ # Set up channel in interpreter
+ interp eval $ida $helperscript
+ set chan [interp eval $ida {
+ proc foo {args} {oninit seek; onfinal; track; return}
+ set chan [chan create {r w} foo]
+ fconfigure $chan -buffering none
+ set chan
+ }]
+
+ # Move channel to 2nd interpreter.
+ 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
+
+} -constraints {testchannel} \
+ -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {
+
+ 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
+
+ # Set up channel in thread
+ set chan [interp eval $ida $helperscript]
+ set chan [interp eval $ida {
+ proc foo {args} {
+ oninit; onfinal; track;
+ # destroy interpreter during channel access
+ # Actually not possible for an interp to destroy itself.
+ interp delete {}
+ return}
+ set chan [chan create {r w} foo]
+ fconfigure $chan -buffering none
+ set chan
+ }]
+
+ # Move channel to 2nd thread.
+ 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.
+
+ interp eval $idb [list set chan $chan]
+ 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
+ catch { puts $chan shoo } res
+ set res
+ }]
+ set res
+} -constraints {testchannel impossible} \
+ -result {Owner lost}
+
+test iocmd-32.2 {delete interp of reflected chan} {
+ # Bug 3034840
+ # Run this test in an interp with memory debugging to panic
+ # on the double free
+ interp create slave
+ slave eval {
+ proc no-op args {}
+ proc driver {sub args} {return {initialize finalize watch read}}
+ chan event [chan create read driver] readable no-op
+ }
+ interp delete slave
+} {}
# ### ### ### ######### ######### #########
## Same tests as above, but exercising the code forwarding and
@@ -2059,38 +2128,16 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
## forwarding, and gaps due to tests not applicable to forwarding are
## left to keep this asociation.
-testConstraint testchannel [llength [info commands testchannel]]
-
-# 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.
-
-testConstraint testthread [expr {[info commands testthread] != {}}]
-
-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
## 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
@@ -2099,19 +2146,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 {
- proc note {item} {global notes ; lappend notes $item}
- proc notes {} {global notes ; return $notes}
+ 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.
@@ -2119,15 +2170,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]
+ 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
}
@@ -2137,125 +2188,101 @@ proc inthread {chan script args} {
test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
set res {}
- proc foo {args} {track ; oninit ; return {}}
+ proc foo {args} {track; oninit; return {}}
note [set c [chan create {r w} foo]]
-
note [inthread $c {
close $c
# Close the deleted the channel.
file channels rc*
} c]
-
# Channel destruction does not kill handler command!
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}
+ proc foo {args} {track; oninit; return -code error 5}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
# Channel is gone despite error.
note [file channels rc*]
notes
} 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}
+ proc foo {args} {track; oninit; error FOO}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
notes
} 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}
+ proc foo {args} {track; oninit; return SOMETHING}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
note [catch {close $c} msg]; note $msg
notes
} 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}
+ proc foo {args} {track; oninit; return -code 3}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
notes
} c]
-
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \
- -constraints {testchannel testthread}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+ -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}
+ proc foo {args} {track; oninit; return -code 4}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
notes
} c]
-
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \
- -constraints {testchannel testthread}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+ -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}
+ proc foo {args} {track; oninit; return -code 777 BANG}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg] ; note $msg
+ note [catch {close $c} msg]; note $msg
notes
} c]
-
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG} \
- -constraints {testchannel testthread}
-
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+ -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}
+ proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
note [set c [chan create {r w} foo]]
-
notes [inthread $c {
- note [catch {close $c} msg opt] ; note $msg ; note $opt
+ note [catch {close $c} msg opt]; note $msg; noteOpts $opt
notes
} c]
-
rename foo {}
set res
-} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
+} -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 thread}
# --- === *** ###########################
# method read
@@ -2263,7 +2290,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match
test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return snarf
}
set c [chan create {r w} foo]
@@ -2272,139 +2299,158 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
close $c
notes
} 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} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return [string repeat snarf 1000]
}
set c [chan create {r w} foo]
notes [inthread $c {
- note [catch {[read $c 2]} msg] ; note $msg
+ note [catch {[read $c 2]} msg]; note $msg
close $c
notes
} 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} {
- oninit ; onfinal ; track
- note MUST_NOT_HAPPEN
+ oninit; onfinal; track; note MUST_NOT_HAPPEN
}
set c [chan create {w} foo]
notes [inthread $c {
- note [catch {[read $c 2]} msg] ; note $msg
+ note [catch {[read $c 2]} msg]; note $msg
close $c
notes
} 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} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
notes
} c]
-
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} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{read rc* 4096} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{read rc* 4096} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -code 777 BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {read $c 2} msg] ; note $msg
+ note [catch {read $c 2} msg]; note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{read rc* 4096} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
set res {}
proc foo {args} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
return -level 55 -code 777 BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {read $c 2} msg opt] ; note $msg ; note $opt
+ note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \
- -constraints {testchannel testthread}
+} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
+ -constraints {testchannel thread}
+test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ return ""
+ }
+ set c [chan create {r w} foo]
+} -body {
+ notes [inthread $c {
+ note [read $c 2]
+ note [eof $c]
+ close $c
+ notes
+ } c]
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {{read rc* 4096} {} 1} \
+ -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} {
+ oninit; onfinal; track
+ error EAGAIN
+ }
+ set c [chan create {r w} foo]
+} -body {
+ notes [inthread $c {
+ note [read $c 2]
+ note [eof $c]
+ close $c
+ notes
+ } c]
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {{read rc* 4096} {} 0} \
+ -constraints {testchannel thread}
# --- === *** ###########################
# method write
@@ -2412,404 +2458,541 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
set res {}
proc foo {args} {
- oninit; onfinal ; track
+ oninit; onfinal; track
set written [string length [lindex $args 2]]
note $written
return $written
}
set c [chan create {r w} foo]
-
inthread $c {
- puts -nonewline $c snarf ; flush $c
+ puts -nonewline $c snarf; flush $c
close $c
} 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} {
- oninit ; onfinal ; track
+ oninit; onfinal; track
set written [string length [lindex $args 2]]
if {$written > 10} {set written [expr {$written / 2}]}
note $written
return $written
}
set c [chan create {r w} foo]
-
inthread $c {
- puts -nonewline $c snarfsnarfsnarf ; flush $c
+ puts -nonewline $c snarfsnarfsnarf; flush $c
close $c
} 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}
+ proc foo {args} {oninit; onfinal; track; note -1; return -1}
set c [chan create {r w} foo]
-
inthread $c {
- puts -nonewline $c snarfsnarfsnarf ; flush $c
+ puts -nonewline $c snarfsnarfsnarf; flush $c
close $c
} 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}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ note $msg
close $c
notes
} 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}
+ proc foo {args} {oninit; onfinal; track; return 10000}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarf; flush $c} msg]
+ note $msg
close $c
notes
} 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}
+ proc foo {args} {oninit; onfinal; track; return 0}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+ note [catch {puts -nonewline $c snarf; flush $c} msg]
+ note $msg
close $c
notes
} 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!}
+ proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit; onfinal; track; error BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+ -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}
+ proc foo {args} {oninit; onfinal; track; return BANG}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt]
+ note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \
- -constraints {testchannel testthread}
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
+ -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} {
+ oninit; onfinal; track
+ return 3
+ }
+ set c [chan create {r w} foo]
+} -body {
+ notes [inthread $c {
+ note [puts -nonewline $c ABC ; flush $c]
+ close $c
+ notes
+ } c]
+ set res
+} -cleanup {
+ rename foo {}
+ unset res
+} -result {{write rc* ABC} {}} \
+ -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} {
+ 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]
+ 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 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
test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c]
close $c
notes
} 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 {}
- proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""}
+ proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c]
close $c
notes
} 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 {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "-bar foo -snarf x"
}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c]
close $c
notes
} 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 {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "-bar"
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} 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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return "\{"
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} 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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} 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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{cgetall rc*} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{cgetall rc*} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code 777 BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg] ; note $msg
+ note [catch {fconfigure $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{cgetall rc*} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -level 55 -code 777 BANG
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c} msg opt]
+ note $msg
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
+} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \
+ -constraints {testchannel thread}
# --- === *** ###########################
# method configure
@@ -2817,553 +3000,488 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod
test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN
- return
+ oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
}
-
set c [chan create {r w} foo]
notes [inthread $c {
note [fconfigure $c -translation lf]
close $c
notes
} 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} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]
+ note $msg
close $c
notes
} 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}
+ proc foo {args} {oninit configure; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -rc-foo bar]
close $c
notes
} 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} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code break BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -code 444 BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo bar} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit configure ; onfinal ; track
+ oninit configure; onfinal; track
return -level 55 -code 444 BANG
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c -rc-foo bar} msg opt]
+ note $msg
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
+} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \
+ -constraints {testchannel thread}
# --- === *** ###########################
# method cget
test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
set res {}
- proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo}
+ proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -rc-foo]
close $c
notes
} 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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]
+ note $msg
close $c
notes
} 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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code error BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]
+ note $msg
close $c
notes
} c]
-
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} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code continue BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{cget rc* -rc-foo} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -code 333 BOOM!
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+ note [catch {fconfigure $c -rc-foo} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{cget rc* -rc-foo} 1 *bad code*} \
+ -constraints {testchannel thread}
test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
set res {}
proc foo {args} {
- oninit cget cgetall ; onfinal ; track
+ oninit cget cgetall; onfinal; track
return -level 77 -code 333 BANG
}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c -rc-foo} msg opt]
+ note $msg
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
+} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \
+ -constraints {testchannel thread}
# --- === *** ###########################
# method seek
test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [tell $c]
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 current} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 current} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 current} 1 *bad code*} \
+ -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}
+ proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg opt] ; note $msg ; note $opt
+ note [catch {tell $c} msg opt]
+ note $msg
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
+ -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}
+ proc foo {args} {oninit seek; onfinal; track; return 88}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [tell $c]
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit seek; onfinal; track; return -1}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit seek; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {tell $c} msg] ; note $msg
+ note [catch {tell $c} msg]
+ note $msg
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 start} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 start} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 start} 1 *bad code*} \
+ -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}
+ proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt
+ note [catch {seek $c 0 start} msg opt]
+ note $msg
+ noteOpts $opt
close $c
notes
} c]
-
rename foo {}
set res
-} -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
-
+} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
+ -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}
+ proc foo {args} {oninit seek; onfinal; track; return -45}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit seek; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {seek $c 0 start} msg] ; note $msg
+ note [catch {seek $c 0 start} msg]
+ note $msg
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit seek; onfinal; track; return 23}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [seek $c 0 current]
close $c
notes
} c]
-
rename foo {}
set res
} -result {{seek rc* 0 current} {}} \
- -constraints {testchannel testthread}
-
-foreach {n code} {
- 0 start
- 1 current
- 2 end
+ -constraints {testchannel thread}
+foreach {testname code} {
+ iocmd.tf-28.19.0 start
+ iocmd.tf-28.19.1 current
+ iocmd.tf-28.19.2 end
} {
- test iocmd.tf-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+ test $testname "chan seek, base conversion, $code" -match glob -body {
set res {}
- proc foo {args} {oninit seek ; onfinal ; track ; return 0}
+ proc foo {args} {oninit seek; onfinal; track; return 0}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [seek $c 0 $code]
close $c
notes
} c code]
-
rename foo {}
set res
} -result [list [list seek rc* 0 $code] {}] \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
}
# --- === *** ###########################
@@ -3371,224 +3489,191 @@ foreach {n code} {
test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -blocking]
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -blocking 0]
note [fconfigure $c -blocking]
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -blocking]
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit blocking; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -blocking 0]
note [fconfigure $c -blocking]
close $c
notes
} c]
-
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}
+ proc foo {args} {oninit blocking; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fconfigure $c -blocking 1]
note [fconfigure $c -blocking]
close $c
notes
} c]
-
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!}
-
+ proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ note [catch {fconfigure $c -blocking 0} msg]
+ note $msg
# Catch the close. It changes blocking mode internally, and runs into the error result.
catch {close $c}
notes
} c]
-
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!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ note [catch {fconfigure $c -blocking 0} msg]
+ note $msg
catch {close $c}
notes
} c]
-
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{blocking rc* 0} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ note [catch {fconfigure $c -blocking 0} msg]
+ note $msg
catch {close $c}
notes
} c]
-
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{blocking rc* 0} 1 *bad code*} \
+ -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!}
+ proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ note [catch {fconfigure $c -blocking 0} msg]
+ note $msg
catch {close $c}
notes
} c]
-
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BOOM!} \
- -constraints {testchannel testthread}
-
+} -result {{blocking rc* 0} 1 *bad code*} \
+ -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}
+ proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt
+ note [catch {fconfigure $c -blocking 0} msg opt]
+ note $msg
+ noteOpts $opt
catch {close $c}
notes
} c]
-
rename foo {}
set res
-} -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
- -constraints {testchannel testthread}
-
+} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \
+ -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}
+ proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
set c [chan create {r w} foo]
-
notes [inthread $c {
- note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ note [catch {fconfigure $c -blocking 0} msg]
+ note $msg
catch {close $c}
notes
} c]
-
rename foo {}
set res
} -result {{blocking rc* 0} 0 {}} \
- -constraints {testchannel testthread}
+ -constraints {testchannel thread}
# --- === *** ###########################
# method watch
test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return IGNORED}
+ proc foo {args} {oninit; onfinal; track; return IGNORED}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fileevent $c readable {set tick $tick}]
- close $c ;# 2nd watch, interest zero.
+ close $c ;# 2nd watch, interest zero.
notes
} 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}
+ proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fileevent $c writable {set tick $tick}]
note [fileevent $c writable {}]
close $c
notes
} 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}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fileevent $c writable {set tick $tick}]
note [fileevent $c readable {set tick $tick}]
@@ -3597,28 +3682,24 @@ test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
close $c
notes
} 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 {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
note [fileevent $c writable {set tick $tick}]
note [fileevent $c readable {set tick $tick}] ;# Script is changing,
note [fileevent $c readable {set tock $tock}] ;# interest does not.
- close $c ;# 3rd and 4th watch, removing the event handlers.
+ close $c ;# 3rd and 4th watch, removing the event handlers.
notes
} c]
-
rename foo {}
set res
-} -constraints {testchannel testthread} \
+} -constraints {testchannel thread} \
-result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
# --- === *** ###########################
@@ -3628,20 +3709,120 @@ test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -b
test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
set res {}
- proc foo {args} {oninit ; onfinal ; track ; return}
+ proc foo {args} {oninit; onfinal; track; return}
set c [chan create {r w} foo]
-
notes [inthread $c {
- catch {chan postevent $c r} msg ; note $msg
+ catch {chan postevent $c r} msg
+ note $msg
close $c
notes
} c]
-
rename foo {}
set res
-} -constraints {testchannel testthread} \
- -result {{postevent for channel "rc*" called from outside interpreter}}
+} -constraints {testchannel thread} \
+ -result {{can not find reflected channel named "rc*"}}
+
+# --- === *** ###########################
+# '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 iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
+
+ #puts <<$tcltest::mainThread>>main
+ 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
+ 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
+ set chan
+ }]
+
+ # Move channel to 2nd thread.
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
+ # Kill origin thread, then access channel from 2nd thread.
+ thread::release $tida
+
+ 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
+ thread::release $tidb
+ set res
+
+} -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 [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
+ thread::send $tida $helperscript
+ set chan [thread::send $tida {
+ proc foo {args} {
+ oninit; onfinal; track;
+ # destroy thread during channel access
+ thread::exit
+ }
+ set chan [chan create {r w} foo]
+ fconfigure $chan -buffering none
+ set chan
+ }]
+
+ # Move channel to 2nd thread.
+ 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 2000
+ catch { puts $chan shoo } res
+ thread::send -async $mid [list set ::res $res]
+ }
+ vwait ::res
+
+ catch {thread::release $tida}
+ thread::release $tidb
+ set res
+} -constraints {testchannel thread notValgrind} \
+ -result {Owner lost}
# ### ### ### ######### ######### #########
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
new file mode 100644
index 0000000..7f4f7f0
--- /dev/null
+++ b/tests/ioTrans.test
@@ -0,0 +1,1918 @@
+# -*- tcl -*-
+# Functionality covered: operation of the reflected transformation
+#
+# 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) 2007 Andreas Kupries <andreask@activestate.com>
+# <akupries@shaw.ca>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
+ 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 thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+# testchannel cut|splice Both needed to test the reflection in threads.
+# 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.
+
+set helperscript {
+ if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+ }
+
+ # This forces the return options to be in the order that the test expects!
+ variable optorder {
+ -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+ -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.
+
+ proc handle.initialize {args} {
+ upvar args hargs
+ if {[lindex $hargs 0] eq "initialize"} {
+ return -code return [list {*}$args initialize finalize read write]
+ }
+ }
+ proc handle.finalize {} {
+ upvar args hargs
+ if {[lindex $hargs 0] eq "finalize"} {
+ return -code return ""
+ }
+ }
+ proc handle.read {} {
+ upvar args hargs
+ if {[lindex $hargs 0] eq "read"} {
+ return -code return "@"
+ }
+ }
+ proc handle.drain {} {
+ upvar args hargs
+ if {[lindex $hargs 0] eq "drain"} {
+ return -code return "<>"
+ }
+ }
+ proc handle.clear {} {
+ upvar args hargs
+ if {[lindex $hargs 0] eq "clear"} {
+ return -code return ""
+ }
+ }
+
+ proc tempchan {{mode r+}} {
+ 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 }
+}
+
+# Set everything up in the main thread.
+eval $helperscript
+
+#puts <<[file channels]>>
+
+# ### ### ### ######### ######### #########
+
+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
+} -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} -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 {} {}
+} -returnCodes error -body {
+ chan push {} foo
+} -cleanup {
+ rename foo {}
+} -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
+} -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
+} -result {invalid command name "foo"}
+test iortrans-2.5 {chan push, initialize failed, bad signature} -body {
+ proc foo {} {}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -result {wrong # args: should be "foo"}
+test iortrans-2.6 {chan push, initialize failed, bad signature} -body {
+ proc foo {} {}
+ chan push [tempchan] ::foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename 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}
+ return $::errorInfo
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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 \{\{\}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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} {}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -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}}
+ chan push [tempchan] foo
+} -returnCodes error -cleanup {
+ tempdone
+ rename foo {}
+} -match glob -result {*supports "flush" but not "write"}
+test iortrans-2.19 {chan push, initialize ok, creates channel} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ global res
+ lappend res $args
+ if {[lindex $args 0] ne "initialize"} {return}
+ return {initialize finalize drain flush read write}
+ }
+ 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 {}
+} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
+test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ global res
+ lappend res $args
+ return
+ }
+ lappend res [file channel rt*]
+ lappend res [catch {chan push [tempchan] foo} msg] $msg
+ lappend res [file channel rt*]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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.
+
+test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ lappend ::res $args
+ handle.initialize
+ return
+ }
+ lappend res [set c [chan push [tempchan] foo]]
+ rename foo {}
+ 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} -setup {
+ set res {}
+} -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.
+ lappend res [file channels rt*]
+ # Channel destruction does not kill handler command!
+ lappend res [info command foo]
+} -cleanup {
+ rename foo {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
+ set res {}
+} -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.
+ lappend res [file channels rt*]
+} -cleanup {
+ rename foo {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
+ set res {}
+} -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 {}
+ 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} -setup {
+ set res {}
+} -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 {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
+ set res {}
+} -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 {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
+ set res {}
+} -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 {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
+ set res {}
+} -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 {}
+ tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
+ set res {}
+} -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 [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} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return snarf
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [read $c 10]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} snarf}
+test iortrans-4.2 {chan read, for non-readable channel} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
+ }
+ set c [chan push [tempchan w] foo]
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {1 {channel "file*" wasn't opened for reading}}
+test iortrans-4.3 {chan read, error return} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} 1 BOOM!}
+test iortrans-4.4 {chan read, break return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code break BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.5 {chan read, continue return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code continue BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.6 {chan read, custom return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.7 {chan read, level is squashed} -setup {
+ set res {}
+} -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]
+ lappend res [catch {read $c 2} msg opt] $msg
+ noteOpts $opt
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ lappend res [read $c]
+ #lappend res [gets $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} {}}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ chan configure $c -buffersize 2
+ lappend res [read $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a
+}} {}}
+test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ return x
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ chan configure $c -buffersize 1
+ lappend res [read $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* {
+}} {}}
+test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ lappend res [gets $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} {}}
+
+# --- === *** ###########################
+# method write (via puts)
+
+test iortrans-5.1 {chan write, regular write} -setup {
+ set res {}
+} -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
+ close $c
+ lappend res [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarf} transformresult}
+test iortrans-5.2 {chan write, no write is ok, no change to file} -setup {
+ set res {}
+} -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
+ close $c
+ lappend res [tempview]; # This has to show the original data, as nothing was written
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} {test data}}
+test iortrans-5.3 {chan write, failed write} -setup {
+ set res {}
+} -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
+ lappend res [catch {flush $c} msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
+test iortrans-5.4 {chan write, non-writable channel} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
+ return
+ }
+ set c [chan push [tempchan r] foo]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ close $c
+ tempdone
+ rename foo {}
+} -result {1 {channel "file*" wasn't opened for writing}}
+test iortrans-5.5 {chan write, failed write, error return} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans-5.6 {chan write, failed write, error return} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ error BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans-5.7 {chan write, failed write, break return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code break BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.8 {chan write, failed write, continue return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code continue BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.9 {chan write, failed write, custom return is error} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.10 {chan write, failed write, level is ignored} -setup {
+ set res {}
+} -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]
+ lappend res [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg opt] $msg
+ noteOpts $opt
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
+ global level
+ if {$level} {
+ return
+ }
+ incr level
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ lappend res [puts -nonewline $c abcdef]
+ lappend res [flush $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{} {write rt* abcdef} {write rt* abcdef} {}}
+
+# --- === *** ###########################
+# method limit?, drain (via read)
+
+test iortrans-6.1 {chan read, read limits} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize limit?
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ return 6
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [read $c 10]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize drain
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ handle.drain
+ return
+ }
+ set c [chan push [tempchan] foo]
+ lappend res [read $c]
+ lappend res [close $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} {drain rt*} @<> {}}
+
+# --- === *** ###########################
+# method clear (via puts, seek)
+
+test iortrans-7.1 {chan write, write clears read buffers} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ handle.clear
+ return transformresult
+ }
+ set c [chan push [tempchan] foo]
+ puts -nonewline $c snarf
+ flush $c
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{clear rt*} {write rt* snarf}}
+test iortrans-7.2 {seek clears read buffers} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ return
+ }
+ set c [chan push [tempchan] foo]
+ seek $c 2
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{clear rt*}}
+test iortrans-7.3 {clear, any result is ignored} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ 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 {}
+} -result {{clear rt*}}
+test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
+ set res {}
+} -body {
+ proc foo {fd args} {
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ seek $c 2
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{clear rt*}}
+
+# --- === *** ###########################
+# method flush (via seek, close)
+
+test iortrans-8.1 {seek flushes write buffers, ignores data} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ 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!
+ lappend res |
+ lappend res [close $c] | [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{flush rt*} | {flush rt*} {} | {teXt data}}
+test iortrans-8.2 {close flushes write buffers, writes data} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {args} {
+ handle.initialize flush
+ lappend ::res $args
+ handle.finalize
+ return .flushed.
+ }
+ set c [chan push [tempchan] foo]
+ close $c
+ lappend res [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{flush rt*} {finalize rt*} .flushed.}
+test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
+ set res {}
+} -body {
+ proc foo {fd args} {
+ handle.initialize flush
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ seek $c 2
+ set res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{flush rt*}}
+
+# --- === *** ###########################
+# method watch - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# 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} -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} {
+ 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 $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 \
+ [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
+} -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} {
+ 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 $idb [list testchannel splice $chan]
+ # 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 50
+ catch { puts $chan shoo } res
+ set res
+ }]
+} -cleanup {
+ tempdone
+} -result {Owner lost}
+test iortrans-11.2 {delete interp of reflected transform} -setup {
+ interp create slave
+ # Magic to get the test* commands into the slave
+ load {} Tcltest slave
+} -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}
+ }
+ set t [chan push $c [list driver $c]]
+ chan event $c readable no-op
+ }
+ interp delete slave
+} -cleanup {
+ tempdone
+} -result {}
+
+# ### ### ### ######### ######### #########
+## Same tests as above, but exercising the code forwarding and receiving
+## driver operations to the originator thread.
+
+# ### ### ### ######### ######### #########
+## 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.
+
+# ### ### ### ######### ######### #########
+## 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 [thread::create -preserved]
+ thread::send $tid {load {} Tcltest}
+
+ # Init thread configuration.
+ # - Listed variables
+ # - Id of main thread
+ # - A number of helper commands
+
+ foreach v $args {
+ upvar 1 $v x
+ thread::send $tid [list set $v $x]
+ }
+ 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]
+ }
+ }
+ thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+
+ # Transfer channel (cut/splice aka detach/attach)
+
+ testchannel cut $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.
+
+ set ::tres ""
+ 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.
+
+ thread::release $tid
+ return $::tres
+}
+
+# ### ### ### ######### ######### #########
+
+test iortrans.tf-3.2 {chan finalize, for close} -setup {
+ set res {}
+} -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!
+ lappend res [info command foo]
+} -cleanup {
+ rename foo {}
+} -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.
+ lappend notes [file channels rt*]
+ notes
+ } c]
+} -cleanup {
+ rename foo {}
+} -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 {}
+} -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 {}
+} -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 {}
+} -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 {}
+} -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 {}
+} -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 {}
+} -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 {}
+} -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} -setup {
+ set res {}
+} -constraints {testchannel thread} -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return snarf
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c 10]
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -match glob -result {{read rt* {test data
+}} snarf}
+test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
+ set res {}
+} -constraints {testchannel thread} -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args MUST_NOT_HAPPEN
+ }
+ set c [chan push [tempchan w] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {[read $c 2]} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code error BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code break BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code continue BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -level 55 -code 777 BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {read $c 2} msg opt] $msg
+ noteOpts $opt
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} -setup {
+ set res {}
+} -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
+ close $c
+ } c
+ lappend res [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarf} transformresult}
+test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
+ set res {}
+} -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
+ close $c
+ } c
+ lappend res [tempview]; # This has to show the original data, as nothing was written
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} {test data}}
+test iortrans.tf-5.3 {chan write, failed write} -setup {
+ set res {}
+} -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]
+ lappend res {*}[inthread $c {
+ puts -nonewline $c snarfsnarfsnarf
+ lappend notes [catch {flush $c} msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
+test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
+ set res {}
+} -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]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {1 {channel "file*" wasn't opened for writing}}
+test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
+ set res {}
+} -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]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ error BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
+ set res {}
+} -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]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup {
+ set res {}
+} -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]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
+ set res {}
+} -constraints {testchannel thread} -body {
+ proc foo {args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ return -code 777 BOOM!
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [catch {
+ puts -nonewline $c snarfsnarfsnarf
+ flush $c
+ } msg] $msg
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
+ set res {}
+} -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]
+ 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 {}
+} -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} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize limit?
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ return 6
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c 10]
+ close $c
+ notes
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
+}} {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} {
+ handle.initialize drain
+ handle.finalize
+ lappend ::res $args
+ handle.read
+ handle.drain
+ return
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ lappend notes [read $c]
+ lappend notes [close $c]
+ } c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} {drain rt*} @<> {}}
+
+# --- === *** ###########################
+# method clear (via puts, seek)
+
+test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ 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
+ close $c
+ } c
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ return
+ }
+ set c [chan push [tempchan] foo]
+ inthread $c {
+ seek $c 2
+ close $c
+ } c
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize clear
+ handle.finalize
+ lappend ::res $args
+ return -code error "X"
+ }
+ set c [chan push [tempchan] foo]
+ inthread $c {
+ seek $c 2
+ close $c
+ } c
+ return $res
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{clear rt*}}
+
+# --- === *** ###########################
+# method flush (via seek, close)
+
+test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
+ set res {}
+} -constraints {testchannel thread} -match glob -body {
+ proc foo {args} {
+ handle.initialize flush
+ handle.finalize
+ lappend ::res $args
+ return X
+ }
+ set c [chan push [tempchan] foo]
+ lappend res {*}[inthread $c {
+ # Flush, no writing
+ seek $c 2
+ # The close flushes again, this modifies the file!
+ 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]
+ lappend res [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -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} {
+ handle.initialize flush
+ lappend ::res $args
+ handle.finalize
+ return .flushed.
+ }
+ set c [chan push [tempchan] foo]
+ inthread $c {
+ close $c
+ } c
+ lappend res [tempview]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{flush rt*} {finalize rt*} .flushed.}
+
+# --- === *** ###########################
+# method watch - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# 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} -setup {
+ #puts <<$tcltest::mainThread>>main
+ 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
+ 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.
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
+
+ # Kill origin thread, then access channel from 2nd thread.
+ thread::release -wait $tida
+
+ 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}}
+
+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 [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
+ 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
+ # destroy thread during channel access
+ thread::exit
+ }
+ set chan [chan push [tempchan] foo]
+ fconfigure $chan -buffering none
+ set chan
+ }]
+
+ # Move channel to 2nd thread, transform goes with it.
+ 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 }
+ thread::send -async $mid [list set ::res $res]
+ }
+ vwait ::res
+ set res
+} -cleanup {
+ thread::send $tidb tempdone
+ thread::release $tidb
+} -result {Owner lost}
+
+# ### ### ### ######### ######### #########
+
+cleanupTests
+return
diff --git a/tests/ioUtil.test b/tests/ioUtil.test
deleted file mode 100644
index 1671572..0000000
--- a/tests/ioUtil.test
+++ /dev/null
@@ -1,310 +0,0 @@
-# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
-# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
-# 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.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: ioUtil.test,v 1.15 2003/11/14 20:44:46 dgp Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
-
-::tcltest::testConstraint testopenfilechannelproc \
- [llength [info commands testopenfilechannelproc]]
-::tcltest::testConstraint testaccessproc \
- [llength [info commands testaccessproc]]
-::tcltest::testConstraint teststatproc \
- [llength [info commands teststatproc]]
-
-set unsetScript {
- catch {unset testStat1(size)}
- catch {unset testStat2(size)}
- catch {unset testStat3(size)}
-}
-
-test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} {
- catch {file stat testStat1%.fil testStat1} err1
- catch {file stat testStat2%.fil testStat2} err2
- catch {file stat testStat3%.fil testStat3} err3
- list $err1 $err2 $err3
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}
-
-test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
- catch {teststatproc insert TclpStat} err1
- teststatproc insert TestStatProc1
- teststatproc insert TestStatProc2
- teststatproc insert TestStatProc3
- set err1
-} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
-
-test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} {
- file stat testStat2%.fil testStat2
- file stat testStat1%.fil testStat1
- file stat testStat3%.fil testStat3
-
- list $testStat2(size) $testStat1(size) $testStat3(size)
-} {2345 1234 3456}
-
-eval $unsetScript
-
-test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} {
- catch {teststatproc delete TclpStat} err2
- set err2
-} {"TclpStat": could not be deleteed}
-
-test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} {
- # Delete the 2nd procedure and test that it longer exists but that
- # the others do actually return a result.
-
- teststatproc delete TestStatProc2
- file stat testStat1%.fil testStat1
- catch {file stat testStat2%.fil testStat2} err3
- file stat testStat3%.fil testStat3
-
- list $testStat1(size) $err3 $testStat3(size)
-} {1234 {could not read "testStat2%.fil": no such file or directory} 3456}
-
-eval $unsetScript
-
-test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} {
- # Next delete the 1st procedure and test that only the 3rd procedure
- # is the only one that exists.
-
- teststatproc delete TestStatProc1
- catch {file stat testStat1%.fil testStat1} err4
- catch {file stat testStat2%.fil testStat2} err5
- file stat testStat3%.fil testStat3
-
- list $err4 $err5 $testStat3(size)
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456}
-
-eval $unsetScript
-
-test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} {
- # Finally delete the 3rd procedure and check that none of the
- # procedures exist.
-
- teststatproc delete TestStatProc3
- catch {file stat testStat1%.fil testStat1} err6
- catch {file stat testStat2%.fil testStat2} err7
- catch {file stat testStat3%.fil testStat3} err8
-
- list $err6 $err7 $err8
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}
-
-eval $unsetScript
-
-test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} {
- # Attempt to delete all the Stat procs. again to ensure they no longer
- # exist and an error is returned.
-
- catch {teststatproc delete TestStatProc1} err9
- catch {teststatproc delete TestStatProc2} err10
- catch {teststatproc delete TestStatProc3} err11
-
- list $err9 $err10 $err11
-} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
-
-eval $unsetScript
-
-test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} {
- catch {file exists testAccess1%.fil} err1
- catch {file exists testAccess2%.fil} err2
- catch {file exists testAccess3%.fil} err3
- list $err1 $err2 $err3
-} {0 0 0}
-
-test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
- catch {testaccessproc insert TclpAccess} err1
- testaccessproc insert TestAccessProc1
- testaccessproc insert TestAccessProc2
- testaccessproc insert TestAccessProc3
- set err1
-} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
-
-test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} {
- list [file exists testAccess2%.fil] \
- [file exists testAccess1%.fil] \
- [file exists testAccess3%.fil]
-} {1 1 1}
-
-test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} {
- catch {testaccessproc delete TclpAccess} err2
- set err2
-} {"TclpAccess": could not be deleteed}
-
-test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} {
- # Delete the 2nd procedure and test that it longer exists but that
- # the others do actually return a result.
-
- testaccessproc delete TestAccessProc2
- set res1 [file exists testAccess1%.fil]
- catch {file exists testAccess2%.fil} err3
- set res2 [file exists testAccess3%.fil]
-
- list $res1 $err3 $res2
-} {1 0 1}
-
-test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} {
- # Next delete the 1st procedure and test that only the 3rd procedure
- # is the only one that exists.
-
- testaccessproc delete TestAccessProc1
- catch {file exists testAccess1%.fil} err4
- catch {file exists testAccess2%.fil} err5
- set res3 [file exists testAccess3%.fil]
-
- list $err4 $err5 $res3
-} {0 0 1}
-
-test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} {
- # Finally delete the 3rd procedure and check that none of the
- # procedures exist.
-
- testaccessproc delete TestAccessProc3
- catch {file exists testAccess1%.fil} err6
- catch {file exists testAccess2%.fil} err7
- catch {file exists testAccess3%.fil} err8
-
- list $err6 $err7 $err8
-} {0 0 0}
-
-test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} {
- # Attempt to delete all the Access procs. again to ensure they no longer
- # exist and an error is returned.
-
- catch {testaccessproc delete TestAccessProc1} err9
- catch {testaccessproc delete TestAccessProc2} err10
- catch {testaccessproc delete TestAccessProc3} err11
-
- list $err9 $err10 $err11
-} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
-
-# Some of the following tests require a writable current directory
-set oldpwd [pwd]
-cd [temporaryDirectory]
-
-test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
- catch {file delete -force {expand}[glob *testOpenFileChannel*]}
- catch {file exists testOpenFileChannel1%.fil} err1
- catch {file exists testOpenFileChannel2%.fil} err2
- catch {file exists testOpenFileChannel3%.fil} err3
- catch {file exists __testOpenFileChannel1%__.fil} err4
- catch {file exists __testOpenFileChannel2%__.fil} err5
- catch {file exists __testOpenFileChannel3%__.fil} err6
- list $err1 $err2 $err3 $err4 $err5 $err6
-} {0 0 0 0 0 0}
-
-test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
- catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
- testopenfilechannelproc insert TestOpenFileChannelProc1
- testopenfilechannelproc insert TestOpenFileChannelProc2
- testopenfilechannelproc insert TestOpenFileChannelProc3
- set err1
-} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
-
-test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} {
- close [open __testOpenFileChannel1%__.fil w]
- close [open __testOpenFileChannel2%__.fil w]
- close [open __testOpenFileChannel3%__.fil w]
-
- catch {
- close [open testOpenFileChannel1%.fil r]
- close [open testOpenFileChannel2%.fil r]
- close [open testOpenFileChannel3%.fil r]
- } err
-
- file delete __testOpenFileChannel1%__.fil
- file delete __testOpenFileChannel2%__.fil
- file delete __testOpenFileChannel3%__.fil
-
- set err
-} {}
-
-test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
- catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
- set err2
-} {"TclpOpenFileChannel": could not be deleteed}
-
-test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
- # Delete the 2nd procedure and test that it longer exists but that
- # the others do actually return a result.
-
- testopenfilechannelproc delete TestOpenFileChannelProc2
-
- close [open __testOpenFileChannel1%__.fil w]
- close [open __testOpenFileChannel3%__.fil w]
-
- catch {
- close [open testOpenFileChannel1%.fil r]
- catch {close [open testOpenFileChannel2%.fil r]} msg1
- close [open testOpenFileChannel3%.fil r]
- } err3
-
- file delete __testOpenFileChannel1%__.fil
- file delete __testOpenFileChannel3%__.fil
-
- list $err3 $msg1
-} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}
-
-test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} {
- # Next delete the 1st procedure and test that only the 3rd procedure
- # is the only one that exists.
-
- testopenfilechannelproc delete TestOpenFileChannelProc1
-
- close [open __testOpenFileChannel3%__.fil w]
-
- catch {
- catch {close [open testOpenFileChannel1%.fil r]} msg2
- catch {close [open testOpenFileChannel2%.fil r]} msg3
- close [open testOpenFileChannel3%.fil r]
- } err4
-
- file delete __testOpenFileChannel3%__.fil
-
- list $err4 $msg2 $msg3
-} [list {} \
- {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
- {couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
-
-test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} {
- # Finally delete the 3rd procedure and check that none of the
- # procedures exist.
-
- testopenfilechannelproc delete TestOpenFileChannelProc3
- catch {
- catch {close [open testOpenFileChannel1%.fil r]} msg4
- catch {close [open testOpenFileChannel2%.fil r]} msg5
- catch {close [open testOpenFileChannel3%.fil r]} msg6
- } err5
-
- list $err5 $msg4 $msg5 $msg6
-} [list 1 \
- {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
- {couldn't open "testOpenFileChannel2%.fil": no such file or directory}\
- {couldn't open "testOpenFileChannel3%.fil": no such file or directory}]
-
-test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} {
-
- # Attempt to delete all the OpenFileChannel procs. again to ensure they no
- # longer exist and an error is returned.
-
- catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
- catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
- catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
-
- list $err9 $err10 $err11
-} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
-
-cd $oldpwd
-
-# cleanup
-::tcltest::cleanupTests
-return
diff --git a/tests/iogt.test b/tests/iogt.test
index 9e09270..ded8bb9 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -3,28 +3,25 @@
#
# 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.13 2005/05/10 18:35:22 kennykb Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
return
}
-namespace eval ::tcl::test::iogt {
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+namespace eval ::tcl::test::iogt {
+ namespace import ::tcltest::*
- testConstraint testchannel [llength [info commands testchannel]]
+testConstraint testchannel [llength [info commands testchannel]]
set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
} dummy]
@@ -43,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
@@ -91,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
@@ -103,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
@@ -114,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]
@@ -131,44 +121,37 @@ proc echoPut {c sock} {
#fileevent stdin readable {exit ;#cut}
# main
-socket -server newconn $port
+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 {expand}$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
}
@@ -178,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
+ }
}
}
@@ -198,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 {
@@ -249,19 +220,40 @@ proc id_fulltrail {var op data} {
return $res
}
+proc id_torture {chan op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read {}
+ write -
+ read {
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
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} {
@@ -276,25 +268,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} {
@@ -312,36 +299,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
@@ -355,36 +334,33 @@ 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 torture {-attach channel} {
+ testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
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]]
}
@@ -394,36 +370,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]]
@@ -432,79 +403,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
@@ -538,23 +483,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
@@ -592,24 +531,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*
@@ -639,110 +571,90 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+ set fh [open $path(dummy) r]
+ torture -attach $fh
+ chan configure $fh -buffersize 2
+ set x [read $fh]
+ testchannel unstack $fh
+ close $fh
+ set x
+} {}
-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,./?><;'\|]]
[[]]
@@ -823,35 +735,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
@@ -882,66 +786,51 @@ delete/read {} *ignored*
flush/write {} {}
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 562c3e0..4abe233 100644
--- a/tests/join.test
+++ b/tests/join.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: join.test,v 1.6 2004/05/19 10:51:06 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-
+
test join-1.1 {basic join commands} {
join {a b c} xyz
} axyzbxyzc
@@ -33,22 +31,25 @@ test join-1.4 {basic join commands} {
test join-2.1 {join errors} {
list [catch join msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
test join-2.2 {join errors} {
list [catch {join a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {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} NONE}
+} {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]
} 9
-
test join-3.2 {join is binary ok} {
string length [join "a\0b a\0b a\0b"]
} 11
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lindex.test b/tests/lindex.test
index 7fcc24a..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.13 2005/05/10 18:35:22 kennykb 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]]
+
set minus -
testConstraint testevalex [llength [info commands testevalex]]
@@ -26,7 +27,7 @@ testConstraint testevalex [llength [info commands testevalex]]
test lindex-1.1 {wrong # args} testevalex {
list [catch {testevalex lindex} result] $result
-} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
# Indices that are lists or convertible to lists
@@ -34,18 +35,15 @@ test lindex-2.1 {empty index list} testevalex {
set x {}
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{a b c} {a b c}}
-
test lindex-2.2 {singleton index list} testevalex {
set x { 1 }
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {b b}
-
test lindex-2.3 {multiple indices in list} testevalex {
set x {1 2}
list [testevalex {lindex {{a b c} {d e f}} $x}] \
[testevalex {lindex {{a b c} {d e f}} $x}]
} {f f}
-
test lindex-2.4 {malformed index list} testevalex {
set x \{
list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -57,32 +55,26 @@ test lindex-3.1 {integer -1} testevalex {
set x ${minus}1
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-
test lindex-3.2 {integer 0} testevalex {
set x [string range 00 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {a a}
-
test lindex-3.3 {integer 2} testevalex {
set x [string range 22 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
-
test lindex-3.4 {integer 3} testevalex {
set x [string range 33 0 0]
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-
-test lindex-3.5 {bad octal} testevalex {
- set x 08
+test lindex-3.5 {bad octal} -constraints testevalex -body {
+ set x 0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-3.6 {bad octal} testevalex {
- set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-3.6 {bad octal} -constraints testevalex -body {
+ set x -0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
+} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
set x [expr {(wide(1)<<31) - 2}]
list $x [lindex {1 2 3} $x] [incr x] [incr x]
@@ -94,47 +86,38 @@ test lindex-4.1 {index = end} testevalex {
set x end
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
-
test lindex-4.2 {index = end--1} testevalex {
set x end--1
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-
test lindex-4.3 {index = end-0} testevalex {
set x end-0
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
-
test lindex-4.4 {index = end-2} testevalex {
set x end-2
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {a a}
-
test lindex-4.5 {index = end-3} testevalex {
set x end-3
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
-
-test lindex-4.6 {bad octal} testevalex {
- set x end-08
+test lindex-4.6 {bad octal} -constraints testevalex -body {
+ set x end-0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-4.7 {bad octal} testevalex {
- set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-4.7 {bad octal} -constraints testevalex -body {
+ set x end--0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
-
+} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
set x end-0a2
list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lindex-4.9 {obsolete test} testevalex {
set x end
list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
-
test lindex-4.10 {incomplete end-} testevalex {
set x end-
list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -143,14 +126,13 @@ test lindex-4.10 {incomplete end-} testevalex {
test lindex-5.1 {bad second index} testevalex {
list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result
} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lindex-5.2 {good second index} testevalex {
testevalex {lindex {{a b c} {d e f} {g h i}} 1 2}
} f
-
test lindex-5.3 {three indices} testevalex {
testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1}
} f
+
test lindex-6.1 {error conditions in parsing list} testevalex {
list [catch {testevalex {lindex "a \{" 2}} msg] $msg
} {1 {unmatched open brace in list}}
@@ -178,7 +160,6 @@ test lindex-8.1 {data reuse} testevalex {
set x 0
testevalex {lindex $x $x}
} {0}
-
test lindex-8.2 {data reuse} testevalex {
set a 0
testevalex {lindex $a $a $a}
@@ -187,22 +168,18 @@ test lindex-8.3 {data reuse} testevalex {
set a 1
testevalex {lindex $a $a $a}
} {}
-
test lindex-8.4 {data reuse} testevalex {
set x [list 0 0]
testevalex {lindex $x $x}
} {0}
-
test lindex-8.5 {data reuse} testevalex {
set x 0
testevalex {lindex $x [list $x $x]}
} {0}
-
test lindex-8.6 {data reuse} testevalex {
set x [list 1 1]
testevalex {lindex $x $x}
} {}
-
test lindex-8.7 {data reuse} testevalex {
set x 1
testevalex {lindex $x [list $x $x]}
@@ -214,7 +191,14 @@ test lindex-8.7 {data reuse} testevalex {
test lindex-9.1 {wrong # args} {
list [catch {lindex} result] $result
-} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
+test lindex-9.2 {ensure that compilation works in the right order} {
+ proc foo {} {
+ rename foo {}
+ lindex 1 0
+ }
+ foo
+} 1
# Indices that are lists or convertible to lists
@@ -225,7 +209,6 @@ test lindex-10.1 {empty index list} {
} result
set result
} {{a b c} {a b c}}
-
test lindex-10.2 {singleton index list} {
set x { 1 }
catch {
@@ -233,7 +216,6 @@ test lindex-10.2 {singleton index list} {
} result
set result
} {b b}
-
test lindex-10.3 {multiple indices in list} {
set x {1 2}
catch {
@@ -241,7 +223,6 @@ test lindex-10.3 {multiple indices in list} {
} result
set result
} {f f}
-
test lindex-10.4 {malformed index list} {
set x \{
list [catch { lindex {a b c} $x } result] $result
@@ -256,7 +237,6 @@ test lindex-11.1 {integer -1} {
} result
set result
} {{} {}}
-
test lindex-11.2 {integer 0} {
set x [string range 00 0 0]
catch {
@@ -264,7 +244,6 @@ test lindex-11.2 {integer 0} {
} result
set result
} {a a}
-
test lindex-11.3 {integer 2} {
set x [string range 22 0 0]
catch {
@@ -272,7 +251,6 @@ test lindex-11.3 {integer 2} {
} result
set result
} {c c}
-
test lindex-11.4 {integer 3} {
set x [string range 33 0 0]
catch {
@@ -280,16 +258,14 @@ test lindex-11.4 {integer 3} {
} result
set result
} {{} {}}
-
-test lindex-11.5 {bad octal} {
- set x 08
+test lindex-11.5 {bad octal} -body {
+ set x 0o8
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-11.6 {bad octal} {
- set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-11.6 {bad octal} -body {
+ set x -0o9
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
# Indices relative to end
@@ -300,7 +276,6 @@ test lindex-12.1 {index = end} {
} result
set result
} {c c}
-
test lindex-12.2 {index = end--1} {
set x end--1
catch {
@@ -308,7 +283,6 @@ test lindex-12.2 {index = end--1} {
} result
set result
} {{} {}}
-
test lindex-12.3 {index = end-0} {
set x end-0
catch {
@@ -316,7 +290,6 @@ test lindex-12.3 {index = end-0} {
} result
set result
} {c c}
-
test lindex-12.4 {index = end-2} {
set x end-2
catch {
@@ -324,7 +297,6 @@ test lindex-12.4 {index = end-2} {
} result
set result
} {a a}
-
test lindex-12.5 {index = end-3} {
set x end-3
catch {
@@ -332,22 +304,18 @@ test lindex-12.5 {index = end-3} {
} result
set result
} {{} {}}
-
-test lindex-12.6 {bad octal} {
- set x end-08
+test lindex-12.6 {bad octal} -body {
+ set x end-0o8
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-12.7 {bad octal} {
- set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-12.7 {bad octal} -body {
+ set x end--0o9
list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
-
+} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lindex-12.9 {obsolete test} {
set x end
catch {
@@ -355,7 +323,6 @@ test lindex-12.9 {obsolete test} {
} result
set result
} {c c}
-
test lindex-12.10 {incomplete end-} {
set x end-
list [catch { lindex {a b c} $x } result] $result
@@ -364,14 +331,12 @@ test lindex-12.10 {incomplete end-} {
test lindex-13.1 {bad second index} {
list [catch { lindex {a b c} 0 0a2 } result] $result
} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lindex-13.2 {good second index} {
catch {
lindex {{a b c} {d e f} {g h i}} 1 2
} result
set result
} f
-
test lindex-13.3 {three indices} {
catch {
lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
@@ -421,7 +386,6 @@ test lindex-16.1 {data reuse} {
} result
set result
} {0}
-
test lindex-16.2 {data reuse} {
set a 0
catch {
@@ -436,7 +400,6 @@ test lindex-16.3 {data reuse} {
} result
set result
} {}
-
test lindex-16.4 {data reuse} {
set x [list 0 0]
catch {
@@ -444,7 +407,6 @@ test lindex-16.4 {data reuse} {
} result
set result
} {0}
-
test lindex-16.5 {data reuse} {
set x 0
catch {
@@ -452,7 +414,6 @@ test lindex-16.5 {data reuse} {
} result
set result
} {0}
-
test lindex-16.6 {data reuse} {
set x [list 1 1]
catch {
@@ -460,7 +421,6 @@ test lindex-16.6 {data reuse} {
} result
set result
} {}
-
test lindex-16.7 {data reuse} {
set x 1
catch {
@@ -469,8 +429,30 @@ test lindex-16.7 {data reuse} {
set result
} {}
+test lindex-17.0 {Bug 1718580} {*}{
+ -body {
+ lindex {} end foo
+ }
+ -match glob
+ -result {bad index "foo"*}
+ -returnCodes 1
+}
+
+test lindex-17.1 {Bug 1718580} {*}{
+ -body {
+ lindex a end foo
+ }
+ -match glob
+ -result {bad index "foo"*}
+ -returnCodes 1
+}
+
catch { unset minus }
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/link.test b/tests/link.test
index 84fa154..00e490c 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -1,47 +1,51 @@
# 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.14 2005/09/08 14:14: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} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::testConstraint testlink \
- [expr {[info commands testlink] != {}}]
+::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 "00721"
+ set int "0o0721"
set real -10.5
set bool true
set string abcdef
@@ -56,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 | 00721 -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 \
@@ -91,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 \
@@ -101,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
@@ -123,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
@@ -144,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 {
@@ -248,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 {
@@ -262,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
@@ -270,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 3419c74..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.10 2005/05/10 18:35:22 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -84,16 +82,22 @@ test linsert-1.20 {linsert command, use of end-int index} {
test linsert-2.1 {linsert errors} {
list [catch linsert msg] $msg
-} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
+} {1 {wrong # args: should be "linsert list index ?element ...?"}}
test linsert-2.2 {linsert errors} {
list [catch {linsert a b} msg] $msg
-} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
+} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.3 {linsert errors} {
list [catch {linsert a 12x 2} msg] $msg
} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.4 {linsert errors} {
list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
+test linsert-2.5 {syntax (TIP 323)} {
+ linsert {a b c} 0
+} [list a b c]
+test linsert-2.6 {syntax (TIP 323)} {
+ linsert "a\nb\nc" 0
+} [list a b c]
test linsert-3.1 {linsert won't modify shared argument objects} {
proc p {} {
diff --git a/tests/list.test b/tests/list.test
index 01dc060..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.7 2003/07/24 16:05:24 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -46,6 +44,26 @@ test list-1.23 {basic tests} {list \{} "\\{"
test list-1.24 {basic tests} {list} {}
test list-1.25 {basic tests} {list # #} {{#} #}
test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
+test list-1.27 {basic null treatment} {
+ set l [list "" "\0" "\0\0"]
+ set e "{} \0 \0\0"
+ string equal $l $e
+} 1
+test list-1.28 {basic null treatment} {
+ set result "\0a\0b"
+ list $result [string length $result]
+} "\0a\0b 4"
+test list-1.29 {basic null treatment} {
+ set result "\0a\0b"
+ set srep "$result 4"
+ set lrep [list $result [string length $result]]
+ string equal $srep $lrep
+} 1
+test list-1.30 {basic null treatment} {
+ set l [list "\0abc" "xyz"]
+ set e "\0abc xyz"
+ string equal $l $e
+} 1
# For the next round of tests create a list and then pick it apart
# with "index" to make sure that we get back exactly what went in.
@@ -107,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 a3c9f20..d7fb46c 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -10,14 +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: listObj.test,v 1.8 2005/07/27 18:12:43 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}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
# Test removed; tested an internal detail
@@ -175,6 +178,32 @@ test listobj-9.1 {UpdateStringOfList} {
string length [list foo\x00help]
} 8
+test listobj-10.1 {Bug [2971669]} {*}{
+ -constraints testobj
+ -setup {
+ testobj freeallvars
+ }
+ -body {
+ set result {}
+ lappend result \
+ [testlistobj set 1 a b c d e] \
+ [testlistobj replace 1 0x7fffffff 0x7fffffff f] \
+ [testlistobj get 1]
+ }
+ -cleanup {
+ testobj freeallvars
+ }
+ -result {{a b c d e} {} {a b c d e f}}
+}
+
+test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
+ testobj bug3598580
+} 123
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# 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..08035d9
--- /dev/null
+++ b/tests/lmap.test
@@ -0,0 +1,471 @@
+# 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 b 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} -setup {
+ unset -nocomplain a b x
+} -body {
+ set x [lmap a [lrepeat 1000000 x] { set b y$a }]
+ list $b [llength $x] [string length $x]
+} -result {yx 1000000 2999999}
+test lmap-7.8 {huge list compiled} -setup {
+ unset -nocomplain a b x
+} -body {
+ set x [apply {{times} {
+ global b
+ lmap a [lrepeat $times x] { set b Y$a }
+ }} 1000000]
+ list $b [llength $x] [string length $x]
+} -result {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 d1bdc04..9536271 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -9,73 +9,85 @@
#
# 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.14 2005/07/28 18:42:32 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]]
+
# Figure out what extension is used for shared libraries on this
# platform.
-
+if {![info exists ext]} {
+ set ext [info sharedlibextension]
+}
# Tests require the existence of one of the DLLs in the dltest directory.
-set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir pkga$ext]
set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file readable $x]
+testConstraint $dll [file readable $x]
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
-::tcltest::testConstraint $loaded \
- [expr {![string match *pkga* $alreadyLoaded]}]
+testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticpkg' command from tcltest
-::tcltest::testConstraint teststaticpkg \
- [string compare {} [info commands teststaticpkg]]
+testConstraint teststaticpkg [llength [info commands teststaticpkg]]
+# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest
+testConstraint testsimplefilesystem \
+ [llength [info commands 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]
- list [pkga_eq abc def] [info commands pkga_*]
+ 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"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
- list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
-} -match glob -result {1 {*couldn't find procedure Foo_Init}}
+ list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
+} -match glob \
+ -result [list 1 {cannot find symbol "Foo_Init"*} \
+ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
@@ -83,7 +95,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
test load-3.1 {error in _Init procedure, same interpreter} \
[list $dll $loaded] {
list [catch {load [file join $testDir pkge$ext] pkge} msg] \
- $msg $errorInfo $errorCode
+ $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
"open non_existent"
@@ -95,10 +107,10 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
- set errorCode foo
- set errorInfo bar
+ set ::errorCode foo
+ set ::errorInfo bar
set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
- $msg $errorInfo $errorCode]
+ $msg $::errorInfo $::errorCode]
interp delete x
set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
@@ -120,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
@@ -176,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} \
@@ -194,10 +206,27 @@ 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} \
+ -constraints [list $dll $loaded testsimplefilesystem] \
+ -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
+ -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
+ -result {0 {}} \
+ -cleanup {testsimplefilesystem 0; cd $dir; unset dir}
+
+test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
+ [list $dll $loaded] {
+ load [file join $testDir pkgooa$ext]
+ list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
+} {1 pkgooa_stubsok}
+
# cleanup
+unset ext
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lrange.test b/tests/lrange.test
index 29eafb9..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.9 2005/05/10 18:35:22 kennykb 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,6 +61,7 @@ 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\]}
@@ -86,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 f6888b1..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.2 2003/10/06 14:32:22 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -22,14 +20,13 @@ test lrepeat-1.1 {error cases} {
lrepeat
}
-returnCodes 1
- -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+ -result {wrong # args: should be "lrepeat count ?value ...?"}
}
-test lrepeat-1.2 {error cases} {
+test lrepeat-1.2 {Accept zero elements(TIP 323)} {
-body {
lrepeat 1
}
- -returnCodes 1
- -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+ -result {}
}
test lrepeat-1.3 {error cases} {
-body {
@@ -43,14 +40,13 @@ test lrepeat-1.4 {error cases} {
lrepeat -3 1
}
-returnCodes 1
- -result {must have a count of at least 1}
+ -result {bad count "-3": must be integer >= 0}
}
-test lrepeat-1.5 {error cases} {
+test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
-body {
lrepeat 0
}
- -returnCodes 1
- -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+ -result {}
}
test lrepeat-1.6 {error cases} {
-body {
@@ -59,6 +55,15 @@ test lrepeat-1.6 {error cases} {
-returnCodes 1
-result {expected integer but got "3.5"}
}
+test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
+ -body {
+ lrepeat 0 a b c
+ }
+ -result {}
+}
+test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
+ lrepeat 0x10000000 a b c d e f g h
+} -returnCodes error -match glob -result *
## Okay
test lrepeat-2.1 {normal cases} {
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 6ea1f75..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.9 2005/05/10 18:35:22 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -104,10 +102,10 @@ test lreplace-1.26 {lreplace command} {
test lreplace-2.1 {lreplace errors} {
list [catch lreplace msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} {
list [catch {lreplace a b} msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} {
list [catch {lreplace x a 10} msg] $msg
} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 0155bdd..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.16 2005/06/01 11:00:35 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, -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 ?options? list pattern"}}
-test lsearch-3.2 {lsearch errors} {
- list [catch {lsearch a} msg] $msg
-} {1 {wrong # args: should be "lsearch ?options? list pattern"}}
-test lsearch-3.3 {lsearch errors} {
- list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -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, -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} {
@@ -317,6 +315,18 @@ test lsearch-10.7 {offset searching with an empty list} {
# Stop bug #694232 from reocurring
lsearch -start 0 {} x
} -1
+test lsearch-10.8 {offset searching past the end of the list} {
+ # Stop [Bug 1374778] from reoccurring
+ lsearch -start 10 {a b c} c
+} -1
+test lsearch-10.9 {offset searching past the end of the list} {
+ # Stop [Bug 1374778] from reoccurring
+ lsearch -start 10 -all {a b c} c
+} {}
+test lsearch-10.10 {offset searching past the end of the list} {
+ # Stop [Bug 1374778] from reoccurring
+ lsearch -start 10 -inline {a b c} c
+} {}
test lsearch-11.1 {negated searches} {
lsearch -not {a a a b a a a} a
@@ -382,6 +392,10 @@ test lsearch-16.1 {lsearch -regexp shared object} {
set str a
lsearch -regexp $str $str
} 0
+# Bug 1366683
+test lsearch-16.2 {lsearch -regexp allows internal backrefs} {
+ lsearch -regexp {a aa b} {(.)\1}
+} 1
test lsearch-17.1 {lsearch -index option, basic functionality} {
lsearch -index 1 {{a c} {a b} {a a}} a
@@ -437,16 +451,65 @@ 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
+ lsearch -exact -integer $x $x
+} 0
+test lsearch-21.2 {lsearch shimmering crash} {
+ set x 0.5
+ lsearch -exact -real $x $x
+} 0
+test lsearch-22.1 {lsearch -bisect} -setup {
+ set res {}
+} -body {
+ foreach i {0 1 5 6 7 8 15 16} {
+ lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i]
+ }
+ return $res
+} -result {-1 0 2 2 3 3 5 5}
+test lsearch-22.2 {lsearch -bisect, last of equals} -setup {
+ set res {}
+} -body {
+ foreach i {0 1 2 3} {
+ lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i]
+ }
+ return $res
+} -result {1 4 7 10}
+test lsearch-22.3 {lsearch -bisect decreasing order} -setup {
+ set res {}
+} -body {
+ foreach i {0 1 5 6 7 8 15 16} {
+ lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i]
+ }
+ return $res
+} -result {5 5 3 2 2 1 0 -1}
+test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -setup {
+ set res {}
+} -body {
+ foreach i {0 1 2 3} {
+ lappend res [lsearch -bisect -integer -decreasing \
+ {3 3 3 2 2 2 1 1 1 0 0} $i]
+ }
+ return $res
+} -result {10 8 5 2}
+test lsearch-22.5 {lsearch -bisect, all equal} {
+ lsearch -bisect -integer {5 5 5 5} 5
+} {3}
+test lsearch-22.6 {lsearch -sorted, all equal} {
+ lsearch -sorted -integer {5 5 5 5} 5
+} {0}
+
# cleanup
catch {unset res}
catch {unset increasingIntegers}
@@ -459,3 +522,7 @@ catch {unset increasingDictionary}
catch {unset decreasingDictionary}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lset.test b/tests/lset.test
index 00facb2..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"
}
@@ -31,12 +32,10 @@ trace add variable noWrite write failTrace
test lset-1.1 {lset, not compiled, arg count} testevalex {
list [catch {testevalex lset} msg] $msg
-} "1 {wrong \# args: should be \"lset listVar index ?index...? value\"}"
-
+} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
test lset-1.2 {lset, not compiled, no such var} testevalex {
list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
} "1 {can't read \"noSuchVar\": no such variable}"
-
test lset-1.3 {lset, not compiled, var not readable} testevalex {
list [catch {testevalex {lset noRead 0 {}}} msg] $msg
} "1 {can't read \"noRead\": trace failed}"
@@ -45,7 +44,6 @@ test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex
set x {0 1 2}
list [testevalex {lset x 0 3}] $x
} {{3 1 2} {3 1 2}}
-
test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
set x {0 1 2}
list [catch {
@@ -57,30 +55,25 @@ test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1 2}
list [testevalex {lset x 0 $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-
test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1}
set y $x
list [testevalex {lset x 0 2}] $x $y
} {{2 1} {2 1} {0 1}}
-
test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1}
set y $x
list [testevalex {lset x 0 $x}] $x $y
} {{{0 1} 1} {{0 1} 1} {0 1}}
-
test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1 2}
list [testevalex {lset x [list 0] $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-
test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1}
set y $x
list [testevalex {lset x [list 0] 2}] $x $y
} {{2 1} {2 1} {0 1}}
-
test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex {
set x {0 1}
set y $x
@@ -93,77 +86,78 @@ test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex {
testevalex {lset a [list 0] y}
} msg] $msg
} {1 {unmatched open brace in list}}
-
test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
set a {x y z}
list [catch {
testevalex {lset a [list 2a2] w}
} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
testevalex {lset a [list -1] w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a [list 3] w}
+ testevalex {lset a [list 4] w}
} msg] $msg
} {1 {list index out of range}}
-
-test lset-4.5 {lset, not compiled, 3 args, index out of range} testevalex {
+test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a [list end--1] w}
+ testevalex {lset a [list end--2] w}
+ } msg] $msg
+} {1 {list index out of range}}
+test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
+ set a {x y z}
+ list [catch {
+ testevalex {lset a [list end+2] w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
testevalex {lset a [list end-3] w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
set a "x \{"
list [catch {
testevalex {lset a 0 y}
} msg] $msg
} {1 {unmatched open brace in list}}
-
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
set a {x y z}
list [catch {
testevalex {lset a 2a2 w}
} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
testevalex {lset a -1 w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a 3 w}
+ testevalex {lset a 4 w}
+ } msg] $msg
+} {1 {list index out of range}}
+test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
+ set a {x y z}
+ list [catch {
+ testevalex {lset a end--2 w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
- testevalex {lset a end--1 w}
+ testevalex {lset a end+2 w}
} msg] $msg
} {1 {list index out of range}}
-
test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
set a {x y z}
list [catch {
@@ -176,7 +170,6 @@ test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
testevalex {lset noWrite 0 d}
} msg] $msg $noWrite
} {1 {can't set "noWrite": trace failed} {d b c}}
-
test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {
list [catch {
testevalex {lset noWrite [list 0] d}
@@ -187,47 +180,38 @@ test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a 0 a}] $a
} {{a y z} {a y z}}
-
test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a [list 0] a}] $a
} {{a y z} {a y z}}
-
test lset-6.3 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a 2 a}] $a
} {{x y a} {x y a}}
-
test lset-6.4 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a [list 2] a}] $a
} {{x y a} {x y a}}
-
test lset-6.5 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a end a}] $a
} {{x y a} {x y a}}
-
test lset-6.6 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a [list end] a}] $a
} {{x y a} {x y a}}
-
test lset-6.7 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a end-0 a}] $a
} {{x y a} {x y a}}
-
test lset-6.8 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a [list end-0] a}] $a
} {{x y a} {x y a}}
-
test lset-6.9 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a end-2 a}] $a
} {{a y z} {a y z}}
-
test lset-6.10 {lset, not compiled, 1-d list basics} testevalex {
set a {x y z}
list [testevalex {lset a [list end-2] a}] $a
@@ -237,51 +221,42 @@ test lset-7.1 {lset, not compiled, data sharing} testevalex {
set a 0
list [testevalex {lset a $a {gag me}}] $a
} {{{gag me}} {{gag me}}}
-
test lset-7.2 {lset, not compiled, data sharing} testevalex {
set a [list 0]
list [testevalex {lset a $a {gag me}}] $a
} {{{gag me}} {{gag me}}}
-
test lset-7.3 {lset, not compiled, data sharing} testevalex {
set a {x y}
list [testevalex {lset a 0 $a}] $a
} {{{x y} y} {{x y} y}}
-
test lset-7.4 {lset, not compiled, data sharing} testevalex {
set a {x y}
list [testevalex {lset a [list 0] $a}] $a
} {{{x y} y} {{x y} y}}
-
test lset-7.5 {lset, not compiled, data sharing} testevalex {
set n 0
set a {x y}
list [testevalex {lset a $n $n}] $a $n
} {{0 y} {0 y} 0}
-
test lset-7.6 {lset, not compiled, data sharing} testevalex {
set n [list 0]
set a {x y}
list [testevalex {lset a $n $n}] $a $n
} {{0 y} {0 y} 0}
-
test lset-7.7 {lset, not compiled, data sharing} testevalex {
set n 0
set a [list $n $n]
list [testevalex {lset a $n 1}] $a $n
} {{1 0} {1 0} 0}
-
test lset-7.8 {lset, not compiled, data sharing} testevalex {
set n [list 0]
set a [list $n $n]
list [testevalex {lset a $n 1}] $a $n
} {{1 0} {1 0} 0}
-
test lset-7.9 {lset, not compiled, data sharing} testevalex {
set a 0
list [testevalex {lset a $a $a}] $a
} {0 0}
-
test lset-7.10 {lset, not compiled, data sharing} testevalex {
set a [list 0]
list [testevalex {lset a $a $a}] $a
@@ -291,57 +266,54 @@ test lset-8.1 {lset, not compiled, malformed sublist} testevalex {
set a [list "a \{" b]
list [catch {testevalex {lset a 0 1 c}} msg] $msg
} {1 {unmatched open brace in list}}
-
test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
set a [list "a \{" b]
list [catch {testevalex {lset a {0 1} c}} msg] $msg
} {1 {unmatched open brace in list}}
-
test lset-8.3 {lset, not compiled, bad second index} testevalex {
set a {{b c} {d e}}
list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lset-8.4 {lset, not compiled, bad second index} testevalex {
set a {{b c} {d e}}
list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
test lset-8.5 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
list [catch {testevalex {lset a 2 -1 h}} msg] $msg
} {1 {list index out of range}}
-
test lset-8.6 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
list [catch {testevalex {lset a {2 -1} h}} msg] $msg
} {1 {list index out of range}}
-
test lset-8.7 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a 2 2 h}} msg] $msg
+ list [catch {testevalex {lset a 2 3 h}} msg] $msg
} {1 {list index out of range}}
-
test lset-8.8 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a {2 2} h}} msg] $msg
+ list [catch {testevalex {lset a {2 3} h}} msg] $msg
} {1 {list index out of range}}
-
-test lset-8.9 {lset, not compiled, second index out of range} testevalex {
+test lset-8.9a {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a 2 end--1 h}} msg] $msg
+ list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
} {1 {list index out of range}}
-
-test lset-8.10 {lset, not compiled, second index out of range} testevalex {
+test lset-8.9b {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
- list [catch {testevalex {lset a {2 end--1} h}} msg] $msg
+ list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.10a {lset, not compiled, second index out of range} testevalex {
+ set a {{b c} {d e} {f g}}
+ list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.10b {lset, not compiled, second index out of range} testevalex {
+ set a {{b c} {d e} {f g}}
+ list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
} {1 {list index out of range}}
-
test lset-8.11 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
} {1 {list index out of range}}
-
test lset-8.12 {lset, not compiled, second index out of range} testevalex {
set a {{b c} {d e} {f g}}
list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
@@ -351,7 +323,6 @@ test lset-9.1 {lset, not compiled, entire variable} testevalex {
set a x
list [testevalex {lset a y}] $a
} {y y}
-
test lset-9.2 {lset, not compiled, entire variable} testevalex {
set a x
list [testevalex {lset a {} y}] $a
@@ -362,48 +333,45 @@ test lset-10.1 {lset, not compiled, shared data} testevalex {
set a [list $row $row]
list [testevalex {lset a 0 0 x}] $a
} {{{x q} {p q}} {{x q} {p q}}}
-
test lset-10.2 {lset, not compiled, shared data} testevalex {
set row {p q}
set a [list $row $row]
list [testevalex {lset a {0 0} x}] $a
} {{{x q} {p q}} {{x q} {p q}}}
+test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex {
+ set a [list [list p q] [list r s]]
+ set b $a
+ list [testevalex {lset b {0 0} x}] $a
+} {{{x q} {r s}} {{p q} {r s}}}
test lset-11.1 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a 0 0 f}] $a
} {{{f c} {d e}} {{f c} {d e}}}
-
test lset-11.2 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a {0 0} f}] $a
} {{{f c} {d e}} {{f c} {d e}}}
-
test lset-11.3 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a 0 1 f}] $a
} {{{b f} {d e}} {{b f} {d e}}}
-
test lset-11.4 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a {0 1} f}] $a
} {{{b f} {d e}} {{b f} {d e}}}
-
test lset-11.5 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a 1 0 f}] $a
} {{{b c} {f e}} {{b c} {f e}}}
-
test lset-11.6 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a {1 0} f}] $a
} {{{b c} {f e}} {{b c} {f e}}}
-
test lset-11.7 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a 1 1 f}] $a
} {{{b c} {d f}} {{b c} {d f}}}
-
test lset-11.8 {lset, not compiled, 2-d basics} testevalex {
set a {{b c} {d e}}
list [testevalex {lset a {1 1} f}] $a
@@ -423,12 +391,10 @@ test lset-13.0 {lset, not compiled, shimmering hell} testevalex {
set a 0
list [testevalex {lset a $a $a $a $a {gag me}}] $a
} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-
test lset-13.1 {lset, not compiled, shimmering hell} testevalex {
set a [list 0]
list [testevalex {lset a $a $a $a $a {gag me}}] $a
} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-
test lset-13.2 {lset, not compiled, shimmering hell} testevalex {
set a [list 0 0 0 0]
list [testevalex {lset a $a {gag me}}] $a
@@ -439,13 +405,71 @@ test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testeva
catch { testevalex {lset a {1 5} 5} }
list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
-
test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
set a { { 1 2 } { 3 4 } }
catch { testevalex {lset a 1 5 5} }
list $a [lindex $a 1]
} "{ { 1 2 } { 3 4 } } { 3 4 }"
+testConstraint testobj [llength [info commands testobj]]
+test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {
+ teststringobj set 1 {{1 2} 3}
+ testobj convert 1 list
+ testobj duplicate 1 2
+ variable x [teststringobj get 1]
+ variable y [teststringobj get 2]
+ testobj freeallvars
+ set l [list $y z]
+ unset y
+} -constraints testobj -body {
+ lset l 0 0 0 5
+ lindex $x 0 0
+} -cleanup {
+ unset -nocomplain x l
+} -result 1
+
+test lset-16.1 {lset - grow a variable} testevalex {
+ set x {}
+ testevalex {lset x 0 {test 1}}
+ testevalex {lset x 1 {test 2}}
+ set x
+} {{test 1} {test 2}}
+test lset-16.2 {lset - multiple created sublists} testevalex {
+ set x {}
+ testevalex {lset x 0 0 {test 1}}
+} {{{test 1}}}
+test lset-16.3 {lset - sublists 3 deep} testevalex {
+ set x {}
+ testevalex {lset x 0 0 0 {test 1}}
+} {{{{test 1}}}}
+test lset-16.4 {lset - append to inner list} testevalex {
+ set x {test 1}
+ testevalex {lset x 1 1 2}
+ testevalex {lset x 1 2 3}
+ testevalex {lset x 1 2 1 4}
+} {test {1 2 {3 4}}}
+
+test lset-16.5 {lset - grow a variable} testevalex {
+ set x {}
+ testevalex {lset x end+1 {test 1}}
+ testevalex {lset x end+1 {test 2}}
+ set x
+} {{test 1} {test 2}}
+test lset-16.6 {lset - multiple created sublists} testevalex {
+ set x {}
+ testevalex {lset x end+1 end+1 {test 1}}
+} {{{test 1}}}
+test lset-16.7 {lset - sublists 3 deep} testevalex {
+ set x {}
+ testevalex {lset x end+1 end+1 end+1 {test 1}}
+} {{{{test 1}}}}
+test lset-16.8 {lset - append to inner list} testevalex {
+ set x {test 1}
+ testevalex {lset x end end+1 2}
+ testevalex {lset x end end+1 3}
+ testevalex {lset x end end end+1 4}
+} {test {1 2 {3 4}}}
+
catch {unset noRead}
catch {unset noWrite}
catch {rename failTrace {}}
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index 6b9264c..6846cbf 100755..100644
--- 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
@@ -36,7 +34,7 @@ test lsetComp-1.1 {lset, compiled, wrong \# args} {
evalInProc {
lset
}
-} "1 {wrong \# args: should be \"lset listVar index ?index...? value\"}"
+} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
test lsetComp-2.1 {lset, compiled, list of args, not a simple var name} {
evalInProc {
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index 2250435..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.2 2004/05/19 20:15:32 dkf Exp $
-#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -24,8 +21,7 @@ cd [temporaryDirectory]
# check whether macosx file attributes are supported
testConstraint macosxFileAttr 0
-if {$tcl_platform(platform) eq "unix" && \
- $tcl_platform(os) eq "Darwin"} {
+if {[testConstraint unix] && $tcl_platform(os) eq "Darwin"} {
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
@@ -66,15 +62,15 @@ test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoo
test macOSXFCmd-2.1 {MacOSXSetFileAttribute - file not found} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -creator FOOO} msg] $msg
+ list [catch {file attributes foo.test -creator FOOC} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test macOSXFCmd-2.2 {MacOSXSetFileAttribute - creator} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -creator FOOO} msg] $msg \
+ list [catch {file attributes foo.test -creator FOOC} msg] $msg \
[catch {file attributes foo.test -creator} msg] $msg \
[file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOC {}}
test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
@@ -85,10 +81,10 @@ test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr not
test macOSXFCmd-2.4 {MacOSXSetFileAttribute - type} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -type FOOO} msg] $msg \
+ list [catch {file attributes foo.test -type FOOT} msg] $msg \
[catch {file attributes foo.test -type} msg] $msg \
[file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOT {}}
test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
@@ -107,7 +103,7 @@ test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoo
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
- set f [open foo.test/rsrc w]
+ set f [open foo.test/..namedfork/rsrc w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f "foo"
close $f
@@ -123,8 +119,8 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
catch {file delete -force -- bar.test}
close [open foo.test w]
catch {
- file attributes foo.test -creator FOOO -type FOOO -hidden 1
- set f [open foo.test/rsrc w]
+ file attributes foo.test -creator FOOC -type FOOT -hidden 1
+ set f [open foo.test/..namedfork/rsrc w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f "foo"
close $f
@@ -135,7 +131,49 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
[catch {file attributes bar.test -hidden} msg] $msg \
[catch {file attributes bar.test -rsrclength} msg] $msg \
[file delete -force -- foo.test bar.test]
-} {0 FOOO 0 FOOO 0 1 0 3 {}}
+} {0 FOOC 0 FOOT 0 1 0 3 {}}
+
+test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} {
+ file mkdir globtest
+ cd globtest
+ foreach f {bar baz foo inv inw .nv reg} {
+ catch {file delete -force -- $f.test}
+ close [open $f.test w]
+ }
+ catch {file delete -force -- dir.test}
+ file mkdir dir.test
+ catch {
+ file attributes bar.test -type FOOT
+ file attributes baz.test -creator FOOC -type FOOT
+ file attributes foo.test -creator FOOC
+ file attributes inv.test -hidden 1
+ file attributes inw.test -hidden 1 -type FOOT
+ file attributes dir.test -hidden 1
+ }
+ set res [list \
+ [catch {glob *.test} msg] $msg \
+ [catch {glob -types FOOT *.test} msg] $msg \
+ [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
+ [catch {glob -types FOOTT *.test} msg] $msg \
+ [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
+ [catch {glob -types hidden *.test} msg] $msg \
+ [catch {glob -types {hidden FOOT} *.test} msg] $msg \
+ ]
+ cd ..
+ file delete -force globtest
+ set res
+} [list \
+ 0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
+ 0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \
+ 1 {bad argument to "-types": FOOTT} \
+ 1 {expected Macintosh OS type but got "FOOTT": } \
+ 0 {foo.test inv.test reg.test} 0 {baz.test foo.test} \
+ 0 baz.test 0 {.nv.test dir.test inv.test inw.test} \
+ 0 inw.test
+]
# cleanup
cd $oldcwd
diff --git a/tests/macOSXLoad.test b/tests/macOSXLoad.test
new file mode 100644
index 0000000..12c77e0
--- /dev/null
+++ b/tests/macOSXLoad.test
@@ -0,0 +1,33 @@
+# Commands covered: load unload
+#
+# 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 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+set oldTSF $::tcltest::testSingleFile
+set ::tcltest::testSingleFile false
+
+if {[testConstraint unix] && $tcl_platform(os) eq "Darwin" &&
+ ![string match *pkga* [info loaded]]} {
+ # On Darwin, test .bundle (un)loading in addition to .dylib
+ set ext .bundle
+ source [file join [file dirname [info script]] load.test]
+ set ext .bundle
+ source [file join [file dirname [info script]] unload.test]
+ unset -nocomplain ext
+}
+
+set ::tcltest::testSingleFile $oldTSF
+unset oldTSF
+::tcltest::cleanupTests
+return
diff --git a/tests/main.test b/tests/main.test
index 0500377..351fd4f 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.16 2005/04/28 05:32:02 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -8,15 +6,7 @@ if {[catch {package require tcltest 2.0.2}]} {
}
namespace eval ::tcl::test::main {
-
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::temporaryDirectory
- namespace import ::tcltest::workingDirectory
+ namespace import ::tcltest::*
# Is [exec] defined?
testConstraint exec [llength [info commands exec]]
@@ -76,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 {
@@ -92,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]}
@@ -108,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 {
@@ -124,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]}
@@ -147,7 +129,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -168,7 +150,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -189,7 +171,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -554,7 +536,7 @@ namespace eval ::tcl::test::main {
}
} rc]
} -body {
- exec [interpreter] << {puts "In script"} \
+ exec [interpreter] << {} \
-appinitprocsetrcfile $rc >& result
set f [open result]
read $f
@@ -563,7 +545,28 @@ namespace eval ::tcl::test::main {
file delete result
removeFile rc
} -result "application-specific initialization failed:\
- \nIn script\nExit MainLoop\nIn exit\neven 0\n"
+ \nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-4.5 {
+ Tcl_Main: Bug 1481986
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {
+ testsetmainloop
+ after 0 {puts "Event callback"}
+ } rc]
+ } -body {
+ set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
+ after 1000
+ type $f {puts {Interactive output}
+ exit
+ }
+ read $f
+ } -cleanup {
+ catch {close $f}
+ removeFile rc
+ } -result "Event callback\nInteractive output\n"
# Tests Tcl_Main-5.*: interactive operations
@@ -589,7 +592,7 @@ namespace eval ::tcl::test::main {
catch {set f [open "|[list [interpreter]]" w+]}
} -body {
type $f {
- fconfigure stdin -blocking 0
+ chan configure stdin -blocking 0
puts SUCCESS
}
list [catch {gets $f} line] $line
@@ -603,20 +606,19 @@ namespace eval ::tcl::test::main {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
- type $f "fconfigure stdin -eofchar \\032
+ type $f "chan configure stdin -eofchar \\032
if 1 \{\n\032"
variable wait
- fileevent $f readable \
+ chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 2000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -629,18 +631,17 @@ namespace eval ::tcl::test::main {
} -setup {
set cmd {makeFile "if 1 \{" script}
catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
variable wait
- fileevent $f readable \
+ chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 2000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -747,7 +748,7 @@ namespace eval ::tcl::test::main {
exec Tcltest
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
type $f "testsetmainloop
after 2000 testexitmainloop
@@ -808,6 +809,20 @@ namespace eval ::tcl::test::main {
file delete result
} -result "Exit MainLoop\nIn exit\neven 0\n"
+ test Tcl_Main-5.13 {
+ Bug 1775878
+ } -constraints {
+ exec
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ type $f "puts \\"
+ type $f return
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ } -result [list 0 return]
+
# Tests Tcl_Main-6.*: interactive operations with prompts
test Tcl_Main-6.1 {
@@ -913,6 +928,7 @@ namespace eval ::tcl::test::main {
} -body {
exec [interpreter] << {
proc foo\{ x {}
+ set ::auto_noexec xxx
set tcl_interactive 1
foo y} >& result
set f [open result]
@@ -967,7 +983,7 @@ namespace eval ::tcl::test::main {
} -body {
exec [interpreter] << {
testsetmainloop
- fconfigure stdin -blocking 0
+ chan configure stdin -blocking 0
testexitmainloop
} >& result
set f [open result]
@@ -1190,6 +1206,21 @@ namespace eval ::tcl::test::main {
file delete result
} -result "1\nExit MainLoop\n"
+ test Tcl_Main-8.13 {
+ Bug 1775878
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "pwd\nExit MainLoop\n"
+
# Tests Tcl_Main-9.*: Prompt operations
test Tcl_Main-9.1 {
diff --git a/tests/mathop.test b/tests/mathop.test
new file mode 100644
index 0000000..f122b7b
--- /dev/null
+++ b/tests/mathop.test
@@ -0,0 +1,1340 @@
+# Commands covered: ::tcl::mathop::...
+#
+# 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) 2006 Donal K. Fellows
+# Copyright (c) 2006 Peter Spjuth
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2.1
+ namespace import -force ::tcltest::*
+}
+
+# A namespace to test that operators are exported and that they
+# work when imported
+namespace eval ::testmathop2 {
+ namespace import ::tcl::mathop::*
+}
+
+# Helper to test math ops.
+# Test different invokation variants and see that they do the same thing.
+# Byte compiled / non byte compiled version
+# Shared / unshared arguments
+# Original / imported
+proc TestOp {op args} {
+ set results {}
+
+ # Non byte compiled version, shared args
+ if {[catch {::tcl::mathop::$op {*}$args} res]} {
+ append res " $::errorCode"
+ }
+ lappend results $res
+
+ # Non byte compiled version, unshared args
+ set cmd ::tcl::mathop::\$op
+ foreach arg $args {
+ append cmd " \[format %s [list $arg]\]"
+ }
+ if {[catch $cmd res]} {
+ append res " $::errorCode"
+ }
+ lappend results $res
+
+ # Non byte compiled imported
+ if {[catch {::testmathop2::$op {*}$args} res]} {
+ append res " $::errorCode"
+ }
+ lappend results [string map {testmathop2 tcl::mathop} $res]
+
+ # BC version
+ set argList1 {}
+ set argList2 {}
+ set argList3 {}
+ for {set t 0} {$t < [llength $args]} {incr t} {
+ lappend argList1 a$t
+ lappend argList2 \$a$t
+ lappend argList3 "\[format %s \$a$t\]"
+ }
+ # Shared args
+ proc _TestOp $argList1 "::tcl::mathop::$op [join $argList2]"
+ # Unshared args
+ proc _TestOp2 $argList1 "::tcl::mathop::$op [join $argList3]"
+ # Imported
+ proc _TestOp3 $argList1 "::testmathop2::$op [join $argList2]"
+
+ set ::tcl_traceCompile 0 ;# Set to 2 to help with debug
+ if {[catch {_TestOp {*}$args} res]} {
+ append res " $::errorCode"
+ }
+ set ::tcl_traceCompile 0
+ lappend results $res
+
+ if {[catch {_TestOp2 {*}$args} res]} {
+ append res " $::errorCode"
+ }
+ lappend results $res
+
+ if {[catch {_TestOp3 {*}$args} res]} {
+ append res " $::errorCode"
+ }
+ lappend results [string map {testmathop2 tcl::mathop} $res]
+
+ # Check that they do the same
+ set len [llength $results]
+ for {set i 0} {$i < ($len - 1)} {incr i} {
+ set res1 [lindex $results $i]
+ set res2 [lindex $results $i+1]
+ if {$res1 ne $res2} {
+ return "$i:($res1 != $res2)"
+ }
+ }
+ return [lindex $results 0]
+}
+
+# start of tests
+
+namespace eval ::testmathop {
+ namespace path ::tcl::mathop
+ variable op ;# stop surprises!
+
+ test mathop-1.1 {compiled +} { + } 0
+ test mathop-1.2 {compiled +} { + 1 } 1
+ test mathop-1.3 {compiled +} { + 1 2 } 3
+ test mathop-1.4 {compiled +} { + 1 2 3 } 6
+ test mathop-1.5 {compiled +} { + 1.0 2 3 } 6.0
+ test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
+ test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
+ test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
+ test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
+ test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
+ test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+ + x 0
+ } -result {can't use non-numeric string as operand of "+"}
+ test mathop-1.12 {compiled +: errors} -returnCodes error -body {
+ + nan 0
+ } -result {can't use non-numeric floating-point value as operand of "+"}
+ test mathop-1.13 {compiled +: errors} -returnCodes error -body {
+ + 0 x
+ } -result {can't use non-numeric string as operand of "+"}
+ test mathop-1.14 {compiled +: errors} -returnCodes error -body {
+ + 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "+"}
+ test mathop-1.15 {compiled +: errors} -returnCodes error -body {
+ + 0o8 0
+ } -result {can't use invalid octal number as operand of "+"}
+ test mathop-1.16 {compiled +: errors} -returnCodes error -body {
+ + 0 0o8
+ } -result {can't use invalid octal number as operand of "+"}
+ test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+ + 0 [error expectedError]
+ } -result expectedError
+ test mathop-1.18 {compiled +: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ + [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ set op +
+ test mathop-1.19 {interpreted +} { $op } 0
+ test mathop-1.20 {interpreted +} { $op 1 } 1
+ test mathop-1.21 {interpreted +} { $op 1 2 } 3
+ test mathop-1.22 {interpreted +} { $op 1 2 3 } 6
+ test mathop-1.23 {interpreted +} { $op 1.0 2 3 } 6.0
+ test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
+ test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
+ test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
+ test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
+ test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
+ test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
+ $op x 0
+ } -result {can't use non-numeric string as operand of "+"}
+ test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
+ $op nan 0
+ } -result {can't use non-numeric floating-point value as operand of "+"}
+ test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
+ $op 0 x
+ } -result {can't use non-numeric string as operand of "+"}
+ test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
+ $op 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "+"}
+ test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
+ $op 0o8 0
+ } -result {can't use invalid octal number as operand of "+"}
+ test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
+ $op 0 0o8
+ } -result {can't use invalid octal number as operand of "+"}
+ test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
+ $op 0 [error expectedError]
+ } -result expectedError
+ test mathop-1.36 {interpreted +: argument processing order} -body {
+ list [catch {
+ $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+
+ test mathop-2.1 {compiled *} { * } 1
+ test mathop-2.2 {compiled *} { * 2 } 2
+ test mathop-2.3 {compiled *} { * 2 3 } 6
+ test mathop-2.4 {compiled *} { * 2 3 4 } 24
+ test mathop-2.5 {compiled *} { * 1.0 2 3 } 6.0
+ test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
+ test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
+ test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
+ test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
+ test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
+ test mathop-2.11 {compiled *: errors} -returnCodes error -body {
+ * x 0
+ } -result {can't use non-numeric string as operand of "*"}
+ test mathop-2.12 {compiled *: errors} -returnCodes error -body {
+ * nan 0
+ } -result {can't use non-numeric floating-point value as operand of "*"}
+ test mathop-2.13 {compiled *: errors} -returnCodes error -body {
+ * 0 x
+ } -result {can't use non-numeric string as operand of "*"}
+ test mathop-2.14 {compiled *: errors} -returnCodes error -body {
+ * 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "*"}
+ test mathop-2.15 {compiled *: errors} -returnCodes error -body {
+ * 0o8 0
+ } -result {can't use invalid octal number as operand of "*"}
+ test mathop-2.16 {compiled *: errors} -returnCodes error -body {
+ * 0 0o8
+ } -result {can't use invalid octal number as operand of "*"}
+ test mathop-2.17 {compiled *: errors} -returnCodes error -body {
+ * 0 [error expectedError]
+ } -result expectedError
+ test mathop-2.18 {compiled *: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ * [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ set op *
+ test mathop-2.19 {interpreted *} { $op } 1
+ test mathop-2.20 {interpreted *} { $op 2 } 2
+ test mathop-2.21 {interpreted *} { $op 2 3 } 6
+ test mathop-2.22 {interpreted *} { $op 2 3 4 } 24
+ test mathop-2.23 {interpreted *} { $op 1.0 2 3 } 6.0
+ test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
+ test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
+ test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
+ test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
+ test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
+ test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
+ $op x 0
+ } -result {can't use non-numeric string as operand of "*"}
+ test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
+ $op nan 0
+ } -result {can't use non-numeric floating-point value as operand of "*"}
+ test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
+ $op 0 x
+ } -result {can't use non-numeric string as operand of "*"}
+ test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
+ $op 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "*"}
+ test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
+ $op 0o8 0
+ } -result {can't use invalid octal number as operand of "*"}
+ test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
+ $op 0 0o8
+ } -result {can't use invalid octal number as operand of "*"}
+ test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
+ $op 0 [error expectedError]
+ } -result expectedError
+ test mathop-2.36 {interpreted *: argument processing order} -body {
+ list [catch {
+ $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+
+ test mathop-3.1 {compiled !} {! 0} 1
+ test mathop-3.2 {compiled !} {! 1} 0
+ test mathop-3.3 {compiled !} {! false} 1
+ test mathop-3.4 {compiled !} {! true} 0
+ test mathop-3.5 {compiled !} {! 0.0} 1
+ test mathop-3.6 {compiled !} {! 10000000000} 0
+ test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
+ test mathop-3.8 {compiled !: errors} -body {
+ ! foobar
+ } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+ test mathop-3.9 {compiled !: errors} -body {
+ ! 0 0
+ } -returnCodes error -result "wrong # args: should be \"! boolean\""
+ test mathop-3.10 {compiled !: errors} -body {
+ !
+ } -returnCodes error -result "wrong # args: should be \"! boolean\""
+ set op !
+ test mathop-3.11 {interpreted !} {$op 0} 1
+ test mathop-3.12 {interpreted !} {$op 1} 0
+ test mathop-3.13 {interpreted !} {$op false} 1
+ test mathop-3.14 {interpreted !} {$op true} 0
+ test mathop-3.15 {interpreted !} {$op 0.0} 1
+ test mathop-3.16 {interpreted !} {$op 10000000000} 0
+ test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
+ test mathop-3.18 {interpreted !: errors} -body {
+ $op foobar
+ } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+ test mathop-3.19 {interpreted !: errors} -body {
+ $op 0 0
+ } -returnCodes error -result "wrong # args: should be \"! boolean\""
+ test mathop-3.20 {interpreted !: errors} -body {
+ $op
+ } -returnCodes error -result "wrong # args: should be \"! boolean\""
+ test mathop-3.21 {compiled !: error} -returnCodes error -body {
+ ! NaN
+ } -result {can't use non-numeric floating-point value as operand of "!"}
+ test mathop-3.22 {interpreted !: error} -returnCodes error -body {
+ $op NaN
+ } -result {can't use non-numeric floating-point value as operand of "!"}
+
+ test mathop-4.1 {compiled ~} {~ 0} -1
+ test mathop-4.2 {compiled ~} {~ 1} -2
+ test mathop-4.3 {compiled ~} {~ 31} -32
+ test mathop-4.4 {compiled ~} {~ -127} 126
+ test mathop-4.5 {compiled ~} {~ -0} -1
+ test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001
+ test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
+ test mathop-4.8 {compiled ~: errors} -body {
+ ~ foobar
+ } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+ test mathop-4.9 {compiled ~: errors} -body {
+ ~ 0 0
+ } -returnCodes error -result "wrong # args: should be \"~ integer\""
+ test mathop-4.10 {compiled ~: errors} -body {
+ ~
+ } -returnCodes error -result "wrong # args: should be \"~ integer\""
+ test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
+ ~ 0.0
+ } -result {can't use floating-point value as operand of "~"}
+ test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
+ ~ NaN
+ } -result {can't use non-numeric floating-point value as operand of "~"}
+ set op ~
+ test mathop-4.13 {interpreted ~} {$op 0} -1
+ test mathop-4.14 {interpreted ~} {$op 1} -2
+ test mathop-4.15 {interpreted ~} {$op 31} -32
+ test mathop-4.16 {interpreted ~} {$op -127} 126
+ test mathop-4.17 {interpreted ~} {$op -0} -1
+ test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001
+ test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
+ test mathop-4.20 {interpreted ~: errors} -body {
+ $op foobar
+ } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+ test mathop-4.21 {interpreted ~: errors} -body {
+ $op 0 0
+ } -returnCodes error -result "wrong # args: should be \"~ integer\""
+ test mathop-4.22 {interpreted ~: errors} -body {
+ $op
+ } -returnCodes error -result "wrong # args: should be \"~ integer\""
+ test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
+ $op 0.0
+ } -result {can't use floating-point value as operand of "~"}
+ test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
+ $op NaN
+ } -result {can't use non-numeric floating-point value as operand of "~"}
+
+ test mathop-5.1 {compiled eq} {eq {} a} 0
+ test mathop-5.2 {compiled eq} {eq a a} 1
+ test mathop-5.3 {compiled eq} {eq a {}} 0
+ test mathop-5.4 {compiled eq} {eq a b} 0
+ test mathop-5.5 {compiled eq} { eq } 1
+ test mathop-5.6 {compiled eq} {eq a} 1
+ test mathop-5.7 {compiled eq} {eq a a a} 1
+ test mathop-5.8 {compiled eq} {eq a a b} 0
+ test mathop-5.9 {compiled eq} -body {
+ eq a b [error foobar]
+ } -returnCodes error -result foobar
+ test mathop-5.10 {compiled eq} {eq NaN Na NaN} 0
+ set op eq
+ test mathop-5.11 {interpreted eq} {$op {} a} 0
+ test mathop-5.12 {interpreted eq} {$op a a} 1
+ test mathop-5.13 {interpreted eq} {$op a {}} 0
+ test mathop-5.14 {interpreted eq} {$op a b} 0
+ test mathop-5.15 {interpreted eq} { $op } 1
+ test mathop-5.16 {interpreted eq} {$op a} 1
+ test mathop-5.17 {interpreted eq} {$op a a a} 1
+ test mathop-5.18 {interpreted eq} {$op a a b} 0
+ test mathop-5.19 {interpreted eq} -body {
+ $op a b [error foobar]
+ } -returnCodes error -result foobar
+ test mathop-5.20 {interpreted eq} {$op NaN Na NaN} 0
+
+ variable big1 12135435435354435435342423948763867876
+ variable big2 2746237174783836746262564892918327847
+ variable wide1 12345678912345
+ variable wide2 87321847232215
+ variable small1 87345
+ variable small2 16753
+
+ test mathop-6.1 {compiled &} { & } -1
+ test mathop-6.2 {compiled &} { & 1 } 1
+ test mathop-6.3 {compiled &} { & 1 2 } 0
+ test mathop-6.4 {compiled &} { & 3 7 6 } 2
+ test mathop-6.5 {compiled &} -returnCodes error -body {
+ & 1.0 2 3
+ } -result {can't use floating-point value as operand of "&"}
+ test mathop-6.6 {compiled &} -returnCodes error -body {
+ & 1 2 3.0
+ } -result {can't use floating-point value as operand of "&"}
+ test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
+ test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
+ test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
+ test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
+ test mathop-6.11 {compiled &: errors} -returnCodes error -body {
+ & x 0
+ } -result {can't use non-numeric string as operand of "&"}
+ test mathop-6.12 {compiled &: errors} -returnCodes error -body {
+ & nan 0
+ } -result {can't use non-numeric floating-point value as operand of "&"}
+ test mathop-6.13 {compiled &: errors} -returnCodes error -body {
+ & 0 x
+ } -result {can't use non-numeric string as operand of "&"}
+ test mathop-6.14 {compiled &: errors} -returnCodes error -body {
+ & 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "&"}
+ test mathop-6.15 {compiled &: errors} -returnCodes error -body {
+ & 0o8 0
+ } -result {can't use invalid octal number as operand of "&"}
+ test mathop-6.16 {compiled &: errors} -returnCodes error -body {
+ & 0 0o8
+ } -result {can't use invalid octal number as operand of "&"}
+ test mathop-6.17 {compiled &: errors} -returnCodes error -body {
+ & 0 [error expectedError]
+ } -result expectedError
+ test mathop-6.18 {compiled &: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ & [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ set op &
+ test mathop-6.19 {interpreted &} { $op } -1
+ test mathop-6.20 {interpreted &} { $op 1 } 1
+ test mathop-6.21 {interpreted &} { $op 1 2 } 0
+ test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
+ test mathop-6.23 {interpreted &} -returnCodes error -body {
+ $op 1.0 2 3
+ } -result {can't use floating-point value as operand of "&"}
+ test mathop-6.24 {interpreted &} -returnCodes error -body {
+ $op 1 2 3.0
+ } -result {can't use floating-point value as operand of "&"}
+ test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
+ test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
+ test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
+ test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
+ test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
+ $op x 0
+ } -result {can't use non-numeric string as operand of "&"}
+ test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
+ $op nan 0
+ } -result {can't use non-numeric floating-point value as operand of "&"}
+ test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
+ $op 0 x
+ } -result {can't use non-numeric string as operand of "&"}
+ test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
+ $op 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "&"}
+ test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
+ $op 0o8 0
+ } -result {can't use invalid octal number as operand of "&"}
+ test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
+ $op 0 0o8
+ } -result {can't use invalid octal number as operand of "&"}
+ test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
+ $op 0 [error expectedError]
+ } -result expectedError
+ test mathop-6.36 {interpreted &: argument processing order} -body {
+ list [catch {
+ $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ test mathop-6.37 {& and bignums} {
+ list [& $big1 $big2] [$op $big1 $big2]
+ } {712439449294653815890598856501796 712439449294653815890598856501796}
+ test mathop-6.38 {& and bignums} {
+ list [& $big1 $wide2] [$op $big1 $wide2]
+ } {78521450111684 78521450111684}
+ test mathop-6.39 {& and bignums} {
+ list [& $big1 $small2] [$op $big1 $small2]
+ } {96 96}
+ test mathop-6.40 {& and bignums} {
+ list [& $wide1 $big2] [$op $wide1 $big2]
+ } {2371422390785 2371422390785}
+ test mathop-6.41 {& and bignums} {
+ list [& $wide1 $wide2] [$op $wide1 $wide2]
+ } {12275881497169 12275881497169}
+ test mathop-6.42 {& and bignums} {
+ list [& $wide1 $small2] [$op $wide1 $small2]
+ } {16721 16721}
+ test mathop-6.43 {& and bignums} {
+ list [& $small1 $big2] [$op $small1 $big2]
+ } {33 33}
+ test mathop-6.44 {& and bignums} {
+ list [& $small1 $wide2] [$op $small1 $wide2]
+ } {87057 87057}
+ test mathop-6.45 {& and bignums} {
+ list [& $small1 $small2] [$op $small1 $small2]
+ } {16689 16689}
+
+ test mathop-7.1 {compiled |} { | } 0
+ test mathop-7.2 {compiled |} { | 1 } 1
+ test mathop-7.3 {compiled |} { | 1 2 } 3
+ test mathop-7.4 {compiled |} { | 3 7 6 } 7
+ test mathop-7.5 {compiled |} -returnCodes error -body {
+ | 1.0 2 3
+ } -result {can't use floating-point value as operand of "|"}
+ test mathop-7.6 {compiled |} -returnCodes error -body {
+ | 1 2 3.0
+ } -result {can't use floating-point value as operand of "|"}
+ test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
+ test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
+ test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
+ test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
+ test mathop-7.11 {compiled |: errors} -returnCodes error -body {
+ | x 0
+ } -result {can't use non-numeric string as operand of "|"}
+ test mathop-7.12 {compiled |: errors} -returnCodes error -body {
+ | nan 0
+ } -result {can't use non-numeric floating-point value as operand of "|"}
+ test mathop-7.13 {compiled |: errors} -returnCodes error -body {
+ | 0 x
+ } -result {can't use non-numeric string as operand of "|"}
+ test mathop-7.14 {compiled |: errors} -returnCodes error -body {
+ | 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "|"}
+ test mathop-7.15 {compiled |: errors} -returnCodes error -body {
+ | 0o8 0
+ } -result {can't use invalid octal number as operand of "|"}
+ test mathop-7.16 {compiled |: errors} -returnCodes error -body {
+ | 0 0o8
+ } -result {can't use invalid octal number as operand of "|"}
+ test mathop-7.17 {compiled |: errors} -returnCodes error -body {
+ | 0 [error expectedError]
+ } -result expectedError
+ test mathop-7.18 {compiled |: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ | [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ set op |
+ test mathop-7.19 {interpreted |} { $op } 0
+ test mathop-7.20 {interpreted |} { $op 1 } 1
+ test mathop-7.21 {interpreted |} { $op 1 2 } 3
+ test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
+ test mathop-7.23 {interpreted |} -returnCodes error -body {
+ $op 1.0 2 3
+ } -result {can't use floating-point value as operand of "|"}
+ test mathop-7.24 {interpreted |} -returnCodes error -body {
+ $op 1 2 3.0
+ } -result {can't use floating-point value as operand of "|"}
+ test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
+ test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
+ test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
+ test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
+ test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
+ $op x 0
+ } -result {can't use non-numeric string as operand of "|"}
+ test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
+ $op nan 0
+ } -result {can't use non-numeric floating-point value as operand of "|"}
+ test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
+ $op 0 x
+ } -result {can't use non-numeric string as operand of "|"}
+ test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
+ $op 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "|"}
+ test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
+ $op 0o8 0
+ } -result {can't use invalid octal number as operand of "|"}
+ test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
+ $op 0 0o8
+ } -result {can't use invalid octal number as operand of "|"}
+ test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
+ $op 0 [error expectedError]
+ } -result expectedError
+ test mathop-7.36 {interpreted |: argument processing order} -body {
+ list [catch {
+ $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ test mathop-7.37 {| and bignums} {
+ list [| $big1 $big2] [$op $big1 $big2]
+ } {14880960170688977527789098242825693927 14880960170688977527789098242825693927}
+ test mathop-7.38 {| and bignums} {
+ list [| $big1 $wide2] [$op $big1 $wide2]
+ } {12135435435354435435342432749160988407 12135435435354435435342432749160988407}
+ test mathop-7.39 {| and bignums} {
+ list [| $big1 $small2] [$op $big1 $small2]
+ } {12135435435354435435342423948763884533 12135435435354435435342423948763884533}
+ test mathop-7.40 {| and bignums} {
+ list [| $wide1 $big2] [$op $wide1 $big2]
+ } {2746237174783836746262574867174849407 2746237174783836746262574867174849407}
+ test mathop-7.41 {| and bignums} {
+ list [| $wide1 $wide2] [$op $wide1 $wide2]
+ } {87391644647391 87391644647391}
+ test mathop-7.42 {| and bignums} {
+ list [| $wide1 $small2] [$op $wide1 $small2]
+ } {12345678912377 12345678912377}
+ test mathop-7.43 {| and bignums} {
+ list [| $small1 $big2] [$op $small1 $big2]
+ } {2746237174783836746262564892918415159 2746237174783836746262564892918415159}
+ test mathop-7.44 {| and bignums} {
+ list [| $small1 $wide2] [$op $small1 $wide2]
+ } {87321847232503 87321847232503}
+ test mathop-7.45 {| and bignums} {
+ list [| $small1 $small2] [$op $small1 $small2]
+ } {87409 87409}
+
+ test mathop-8.1 {compiled ^} { ^ } 0
+ test mathop-8.2 {compiled ^} { ^ 1 } 1
+ test mathop-8.3 {compiled ^} { ^ 1 2 } 3
+ test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
+ test mathop-8.5 {compiled ^} -returnCodes error -body {
+ ^ 1.0 2 3
+ } -result {can't use floating-point value as operand of "^"}
+ test mathop-8.6 {compiled ^} -returnCodes error -body {
+ ^ 1 2 3.0
+ } -result {can't use floating-point value as operand of "^"}
+ test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
+ test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
+ test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
+ test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
+ test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
+ ^ x 0
+ } -result {can't use non-numeric string as operand of "^"}
+ test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
+ ^ nan 0
+ } -result {can't use non-numeric floating-point value as operand of "^"}
+ test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
+ ^ 0 x
+ } -result {can't use non-numeric string as operand of "^"}
+ test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
+ ^ 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "^"}
+ test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
+ ^ 0o8 0
+ } -result {can't use invalid octal number as operand of "^"}
+ test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
+ ^ 0 0o8
+ } -result {can't use invalid octal number as operand of "^"}
+ test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
+ ^ 0 [error expectedError]
+ } -result expectedError
+ test mathop-8.18 {compiled ^: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ ^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ set op ^
+ test mathop-8.19 {interpreted ^} { $op } 0
+ test mathop-8.20 {interpreted ^} { $op 1 } 1
+ test mathop-8.21 {interpreted ^} { $op 1 2 } 3
+ test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
+ test mathop-8.23 {interpreted ^} -returnCodes error -body {
+ $op 1.0 2 3
+ } -result {can't use floating-point value as operand of "^"}
+ test mathop-8.24 {interpreted ^} -returnCodes error -body {
+ $op 1 2 3.0
+ } -result {can't use floating-point value as operand of "^"}
+ test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
+ test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
+ test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
+ test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
+ test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
+ $op x 0
+ } -result {can't use non-numeric string as operand of "^"}
+ test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
+ $op nan 0
+ } -result {can't use non-numeric floating-point value as operand of "^"}
+ test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
+ $op 0 x
+ } -result {can't use non-numeric string as operand of "^"}
+ test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
+ $op 0 nan
+ } -result {can't use non-numeric floating-point value as operand of "^"}
+ test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
+ $op 0o8 0
+ } -result {can't use invalid octal number as operand of "^"}
+ test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
+ $op 0 0o8
+ } -result {can't use invalid octal number as operand of "^"}
+ test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
+ $op 0 [error expectedError]
+ } -result expectedError
+ test mathop-8.36 {interpreted ^: argument processing order} -body {
+ list [catch {
+ $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+ test mathop-8.37 {^ and bignums} {
+ list [^ $big1 $big2] [$op $big1 $big2]
+ } {14880247731239682873973207643969192131 14880247731239682873973207643969192131}
+ test mathop-8.38 {^ and bignums} {
+ list [^ $big1 $wide2] [$op $big1 $wide2]
+ } {12135435435354435435342354227710876723 12135435435354435435342354227710876723}
+ test mathop-8.39 {^ and bignums} {
+ list [^ $big1 $small2] [$op $big1 $small2]
+ } {12135435435354435435342423948763884437 12135435435354435435342423948763884437}
+ test mathop-8.40 {^ and bignums} {
+ list [^ $wide1 $big2] [$op $wide1 $big2]
+ } {2746237174783836746262572495752458622 2746237174783836746262572495752458622}
+ test mathop-8.41 {^ and bignums} {
+ list [^ $wide1 $wide2] [$op $wide1 $wide2]
+ } {75115763150222 75115763150222}
+ test mathop-8.42 {^ and bignums} {
+ list [^ $wide1 $small2] [$op $wide1 $small2]
+ } {12345678895656 12345678895656}
+ test mathop-8.43 {^ and bignums} {
+ list [^ $small1 $big2] [$op $small1 $big2]
+ } {2746237174783836746262564892918415126 2746237174783836746262564892918415126}
+ test mathop-8.44 {^ and bignums} {
+ list [^ $small1 $wide2] [$op $small1 $wide2]
+ } {87321847145446 87321847145446}
+ test mathop-8.45 {^ and bignums} {
+ list [^ $small1 $small2] [$op $small1 $small2]
+ } {70720 70720}
+
+ # TODO: % ** << >> - / == != < <= > >= ne in ni
+
+ test mathop-13.100 {compiled -: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ - [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+
+ test mathop-14.100 {compiled /: argument processing order} -body {
+ # Bytecode compilation known hard for 3+ arguments
+ list [catch {
+ / [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+ } msg] $msg $x
+ } -result {1 expected 2}
+}
+
+test mathop-20.1 { zero args, return unit } {
+ set res {}
+ foreach op {+ * & ^ | ** < <= > >= == eq} {
+ lappend res [TestOp $op]
+ }
+ set res
+} {0 1 -1 0 0 1 1 1 1 1 1 1}
+test mathop-20.2 { zero args, not allowed } {
+ set exp {}
+ foreach op {~ ! << >> % != ne in ni - /} {
+ set res [TestOp $op]
+ if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+ lappend exp 0
+ } else {
+ lappend exp $res
+ }
+ }
+ set exp
+} {0 0 0 0 0 0 0 0 0 0 0}
+test mathop-20.3 { one arg } {
+ set res {}
+ foreach val {7 8.3} {
+ foreach op {+ ** - * / < <= > >= == eq !} {
+ lappend res [TestOp $op $val]
+ }
+ }
+ set res
+} [list 7 7 -7 7 [expr {1.0/7.0}] 1 1 1 1 1 1 0 \
+ 8.3 8.3 -8.3 8.3 [expr {1.0/8.3}] 1 1 1 1 1 1 0]
+test mathop-20.4 { one arg, integer only ops } {
+ set res {}
+ foreach val {23} {
+ foreach op {& | ^ ~} {
+ lappend res [TestOp $op $val]
+ }
+ }
+ set res
+} [list 23 23 23 -24]
+test mathop-20.5 { one arg, not allowed } {
+ set exp {}
+ foreach op {% != ne in ni << >>} {
+ set res [TestOp $op 1]
+ if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+ lappend exp 0
+ } else {
+ lappend exp $res
+ }
+ }
+ set exp
+} {0 0 0 0 0 0 0}
+test mathop-20.6 { one arg, error } {
+ set res {}
+ set exp {}
+ foreach vals {x {1 x} {1 1 x} {1 x 1}} {
+ # skipping - for now, knownbug...
+ foreach op {+ * / & | ^ **} {
+ lappend res [TestOp $op {*}$vals]
+ lappend exp "can't use non-numeric string as operand of \"$op\"\
+ ARITH DOMAIN {non-numeric string}"
+ }
+ }
+ foreach op {+ * / & | ^ **} {
+ lappend res [TestOp $op NaN 1]
+ lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
+ ARITH DOMAIN {non-numeric floating-point value}"
+ }
+ expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-20.7 { multi arg } {
+ set res {}
+ foreach vals {{1 2} {3 4 5} {4 3 2 1}} {
+ foreach op {+ - * /} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 3 -1 2 0 12 -6 60 0 10 -2 24 0]
+test mathop-20.8 { multi arg, double } {
+ set res {}
+ foreach vals {{1.0 2} {3.0 4 5} {4 3.0 2 1}
+ {1.0 -1.0 1e-18} {1.0 1.0 1e-18}} {
+ foreach op {+ - * /} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 3.0 -1.0 2.0 0.5 12.0 -6.0 60.0 0.15 10.0 -2.0 24.0 [expr {2.0/3}] 1e-18 2.0 -1e-18 [expr {-1.0/1e-18}] 2.0 -1e-18 1e-18 [expr {1.0/1e-18}]]
+
+test mathop-21.1 { unary ops, bitnot } {
+ set res {}
+ lappend res [TestOp ~ 7]
+ lappend res [TestOp ~ -5]
+ lappend res [TestOp ~ 354657483923456]
+ lappend res [TestOp ~ 123456789123456789123456789]
+ set res
+} [list -8 4 -354657483923457 -123456789123456789123456790]
+test mathop-21.2 { unary ops, logical not } {
+ set res {}
+ lappend res [TestOp ! 0]
+ lappend res [TestOp ! 1]
+ lappend res [TestOp ! true]
+ lappend res [TestOp ! false]
+ lappend res [TestOp ! 37]
+ lappend res [TestOp ! 8.5]
+ set res
+} [list 1 0 0 1 0 0]
+test mathop-21.3 { unary ops, negation } {
+ set res {}
+ lappend res [TestOp - 7.2]
+ lappend res [TestOp - -5]
+ lappend res [TestOp - -2147483648] ;# -2**31
+ lappend res [TestOp - -9223372036854775808] ;# -2**63
+ lappend res [TestOp - 354657483923456] ;# wide
+ lappend res [TestOp - 123456789123456789123456789] ;# big
+ set res
+} [list -7.2 5 2147483648 9223372036854775808 -354657483923456 \
+ -123456789123456789123456789]
+test mathop-21.4 { unary ops, inversion } {
+ set res {}
+ lappend res [TestOp / 1]
+ lappend res [TestOp / 5]
+ lappend res [TestOp / 5.6]
+ lappend res [TestOp / -8]
+ lappend res [TestOp / 354657483923456] ;# wide
+ lappend res [TestOp / 123456789123456789123456789] ;# big
+ set res
+} [list 1.0 0.2 0.17857142857142858 -0.125 \
+ 2.8196218755553604e-15 8.10000006561e-27]
+test mathop-21.5 { unary ops, bad values } {
+ set res {}
+ set exp {}
+ lappend res [TestOp / x]
+ lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp - x]
+ lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp ~ x]
+ lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp ! x]
+ lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp ~ 5.0]
+ lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
+ expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-21.6 { unary ops, too many } {
+ set exp {}
+ foreach op {~ !} {
+ set res [TestOp $op 7 8]
+ if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+ lappend exp 0
+ } else {
+ lappend exp $res
+ }
+ }
+ set exp
+} {0 0}
+
+test mathop-22.1 { bitwise ops } {
+ set res {}
+ foreach vals {5 {1 6} {1 2 3} {1 2 3 4}} {
+ foreach op {& | ^} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 5 5 5 0 7 7 0 3 0 0 7 4]
+test mathop-22.2 { bitwise ops on bignums } {
+ set dig 50
+ set a 0x[string repeat 5 $dig]
+ set b 0x[string repeat 7 $dig]
+ set c 0x[string repeat 9 $dig]
+ set bn [expr {~$b}]
+ set cn [expr {~$c}]
+
+ set res {}
+ foreach vals [list [list $a $b] [list $a $c] [list $b $c] \
+ [list $a $bn] [list $bn $c] [list $bn $cn]] {
+ foreach op {& | ^} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set exp {}
+ foreach d {5 7 2 1 D C 1 F E 0 -D -D 8 -9 -1 -0 -E E} {
+ if {[string match "-*" $d]} {
+ set d [format %X [expr 15-0x[string range $d 1 end]]]
+ set val [expr -0x[string repeat $d $dig]-1]
+ } else {
+ set val [expr 0x[string repeat $d $dig]]
+ }
+ lappend exp $val
+ }
+ expr {$exp eq $res ? 1 : "($res != $exp"}
+} 1
+test mathop-22.3 { bitwise ops } {
+ set big1 12135435435354435435342423948763867876
+ set big2 2746237174783836746262564892918327847
+ set wide1 12345678912345
+ set wide2 87321847232215
+ set small1 87345
+ set small2 16753
+
+ set res {}
+ foreach op {& | ^} {
+ lappend res [TestOp $op $big1 $big2]
+ lappend res [TestOp $op $big1 $wide2]
+ lappend res [TestOp $op $big1 $small2]
+ lappend res [TestOp $op $wide1 $big2]
+ lappend res [TestOp $op $wide1 $wide2]
+ lappend res [TestOp $op $wide1 $small2]
+ lappend res [TestOp $op $small1 $big2]
+ lappend res [TestOp $op $small1 $wide2]
+ lappend res [TestOp $op $small1 $small2]
+ }
+ set res
+} [list \
+ 712439449294653815890598856501796 \
+ 78521450111684 \
+ 96 \
+ 2371422390785 \
+ 12275881497169 \
+ 16721 \
+ 33 \
+ 87057 \
+ 16689 \
+ 14880960170688977527789098242825693927 \
+ 12135435435354435435342432749160988407 \
+ 12135435435354435435342423948763884533 \
+ 2746237174783836746262574867174849407 \
+ 87391644647391 \
+ 12345678912377 \
+ 2746237174783836746262564892918415159 \
+ 87321847232503 \
+ 87409 \
+ 14880247731239682873973207643969192131 \
+ 12135435435354435435342354227710876723 \
+ 12135435435354435435342423948763884437 \
+ 2746237174783836746262572495752458622 \
+ 75115763150222 \
+ 12345678895656 \
+ 2746237174783836746262564892918415126 \
+ 87321847145446 \
+ 70720 \
+ ]
+test mathop-22.4 { unary ops, bad values } {
+ set res {}
+ set exp {}
+ foreach op {& | ^} {
+ lappend res [TestOp $op x 5]
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp $op 5 x]
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ }
+ expr {$res eq $exp ? 0 : $res}
+} 0
+
+test mathop-23.1 { comparison ops, numerical } {
+ set res {}
+ set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}}
+ lappend todo [list 2342476234762482734623842342 234827463876473 3434]
+ lappend todo [list 2653 453735910264536 453735910264537 2384762472634982746239847637]
+ lappend todo [list 2653 2384762472634982746239847637]
+ lappend todo [list 2653 -2384762472634982746239847637]
+ lappend todo [list 3789253678212653 -2384762472634982746239847637]
+ lappend todo [list 5.0 6 7.0 8 1e13 1945628567352654 1.1e20 \
+ 6734253647589123456784564378 2.3e50]
+ set a 7
+ lappend todo [list $a $a] ;# Same object
+ foreach vals $todo {
+ foreach op {< <= > >= == eq} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 1 1 1 1 1 1 \
+ 1 1 0 0 0 0 \
+ 0 1 0 0 0 0 \
+ 0 0 1 1 0 0 \
+ 0 1 0 1 1 1 \
+ 0 0 0 1 0 0 \
+ 0 1 0 1 1 0 \
+ 0 0 1 1 0 0 \
+ 1 1 0 0 0 0 \
+ 1 1 0 0 0 0 \
+ 0 0 1 1 0 0 \
+ 0 0 1 1 0 0 \
+ 1 1 0 0 0 0 \
+ 0 1 0 1 1 1 \
+ ]
+test mathop-23.2 { comparison ops, string } {
+ set res {}
+ set todo {a {a b} {5 b b c} {d c b a} {xy xy} {gy ef ef ab}}
+ set a x
+ lappend todo [list $a $a]
+ foreach vals $todo {
+ foreach op {< <= > >= == eq} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 1 1 1 1 1 1 \
+ 1 1 0 0 0 0 \
+ 0 1 0 0 0 0 \
+ 0 0 1 1 0 0 \
+ 0 1 0 1 1 1 \
+ 0 0 0 1 0 0 \
+ 0 1 0 1 1 1 \
+ ]
+test mathop-23.3 { comparison ops, nonequal} {
+ set res {}
+ foreach vals {{a b} {17.0 0x11} {foo foo} {10 10}} {
+ foreach op {!= ne} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 1 1 0 1 0 0 0 0 ]
+
+test mathop-24.1 { binary ops } {
+ set res {}
+ foreach vals {{3 5} {17 7} {199 5} {293234675763434238476239486 17} \
+ {5 1} {0 7}} {
+ foreach op {% << >> in ni} {
+ lappend res [TestOp $op {*}$vals]
+ }
+ }
+ set res
+} [list 3 96 0 0 1 3 2176 0 0 1 4 6368 6 0 1 \
+ 14 38434855421664852505557661908992 2237203031642412097749 0 1 \
+ 0 10 2 0 1 0 0 0 0 1]
+test mathop-24.2 { binary ops, modulo } {
+ # Test different combinations to get all code paths
+ set res {}
+
+ set bigbig 14372423674564535234543545248972634923869
+ set big 12135435435354435435342423948763867876
+ set wide 12345678912345
+ set negwide -12345678912345
+ set small 5
+ set neg -5
+
+ lappend res [TestOp % $bigbig $big]
+ lappend res [TestOp % $wide $big]
+ lappend res [TestOp % $negwide $big]
+ lappend res [TestOp % $small $big]
+ lappend res [TestOp % $neg $big]
+ lappend res [TestOp % $small $wide]
+ lappend res [TestOp % $neg $wide]
+ lappend res [TestOp % $wide $small]
+ set res
+} [list 4068119104883679098115293636215358685 \
+ 12345678912345 \
+ 12135435435354435435342411603084955531 \
+ 5 \
+ 12135435435354435435342423948763867871 \
+ 5 \
+ 12345678912340 \
+ 0 \
+ ]
+test mathop-24.3 { binary ops, bad values } {
+ set res {}
+ set exp {}
+ foreach op {% << >>} {
+ lappend res [TestOp $op x 1]
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp $op 1 x]
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ }
+ foreach op {% << >>} {
+ lappend res [TestOp $op 5.0 1]
+ lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ lappend res [TestOp $op 1 5.0]
+ lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ }
+ foreach op {in ni} {
+ lappend res [TestOp $op 5 "a b \{ c"]
+ 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}"
+ lappend res [TestOp % 9838923468297346238478737647637375 0]
+ lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+ lappend res [TestOp / 5 0]
+ lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+ lappend res [TestOp / 9838923468297346238478737647637375 0]
+ lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+ expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.4 { binary ops, negative shift } {
+ set res {}
+
+ set big -12135435435354435435342423948763867876
+ set wide -12345678912345
+ set small -1
+
+ lappend res [TestOp << 10 $big]
+ lappend res [TestOp << 10 $wide]
+ lappend res [TestOp << 10 $small]
+ lappend res [TestOp >> 10 $big]
+ lappend res [TestOp >> 10 $wide]
+ lappend res [TestOp >> 10 $small]
+
+ set exp [lrepeat 6 "negative shift argument NONE"]
+ expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.5 { binary ops, large shift } {
+ set res {}
+ set exp {}
+
+ set big 12135435435354435435342423948763867876
+ set wide 12345678912345
+ set small 1
+
+ lappend res [TestOp << 1 2147483648]
+ lappend exp "integer value too large to represent NONE"
+ lappend res [TestOp << 1 4294967296]
+ lappend exp "integer value too large to represent NONE"
+ lappend res [TestOp << $small $wide]
+ lappend exp "integer value too large to represent NONE"
+ lappend res [TestOp << $small $big]
+ lappend exp "integer value too large to represent NONE"
+ lappend res [TestOp >> $big $wide]
+ lappend exp 0
+ lappend res [TestOp >> $big $big]
+ lappend exp 0
+ lappend res [TestOp >> $small 70]
+ lappend exp 0
+ lappend res [TestOp >> $wide 70]
+ lappend exp 0
+ lappend res [TestOp >> -$big $wide]
+ lappend exp -1
+ lappend res [TestOp >> -$wide $wide]
+ lappend exp -1
+ lappend res [TestOp >> -$small $wide]
+ lappend exp -1
+ lappend res [TestOp >> -$small 70]
+ lappend exp -1
+ lappend res [TestOp >> -$wide 70]
+ lappend exp -1
+
+ expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.6 { binary ops, shift } {
+ # Test different combinations to get all code paths
+ set res {}
+
+ set bigbig 14372423674564535234543545248972634923869
+ set big 12135435435354435435342423948763867876
+ set wide 12345678912345
+ set negwide -12345678912345
+ set small 5
+ set neg -5
+
+ lappend res [TestOp << $wide $small]
+ lappend res [TestOp >> $wide $small]
+ set res
+} [list 395061725195040 \
+ 385802466010 \
+ ]
+test mathop-24.7 { binary ops, list search } {
+ set res {}
+
+ foreach op {in ni} {
+ lappend res [TestOp $op 5 {7 5 8}]
+ lappend res [TestOp $op hej {foo bar hej}]
+ lappend res [TestOp $op 5 {7 0x5 8}]
+ }
+ set res
+} [list 1 1 0 0 0 1]
+test mathop-24.8 { binary ops, too many } {
+ set exp {}
+ foreach op {<< >> % != ne in ni ~ !} {
+ set res [TestOp $op 7 8 9]
+ if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+ lappend exp 0
+ } else {
+ lappend exp $res
+ }
+ }
+ set exp
+} {0 0 0 0 0 0 0 0 0}
+
+test mathop-25.1 { exp operator } {TestOp ** } 1
+test mathop-25.2 { exp operator } {TestOp ** 0 } 0
+test mathop-25.3 { exp operator } {TestOp ** 0 5} 0
+test mathop-25.4 { exp operator } {TestOp ** 7.5 } 7.5
+test mathop-25.5 { exp operator } {TestOp ** 1 5} 1
+test mathop-25.6 { exp operator } {TestOp ** 5 1} 5
+test mathop-25.7 { exp operator } {TestOp ** 4 3 2 1} 262144
+test mathop-25.8 { exp operator } {TestOp ** 5.5 4} 915.0625
+test mathop-25.9 { exp operator } {TestOp ** 16 3.5} 16384.0
+test mathop-25.10 { exp operator } {TestOp ** 3.5 0} 1.0
+test mathop-25.11 { exp operator } {TestOp ** 378 0} 1
+test mathop-25.12 { exp operator } {TestOp ** 7.8 1} 7.8
+test mathop-25.13 { exp operator } {TestOp ** 748 1} 748
+test mathop-25.14 { exp operator } {TestOp ** 1.6 -1} 0.625
+test mathop-25.15 { exp operator } {TestOp ** 683 -1} 0
+test mathop-25.16 { exp operator } {TestOp ** 1 -1} 1
+test mathop-25.17 { exp operator } {TestOp ** -1 -1} -1
+test mathop-25.18 { exp operator } {TestOp ** -1 -2} 1
+test mathop-25.19 { exp operator } {TestOp ** -1 3} -1
+test mathop-25.20 { exp operator } {TestOp ** -1 4} 1
+test mathop-25.21 { exp operator } {TestOp ** 2 63} 9223372036854775808
+test mathop-25.22 { exp operator } {TestOp ** 83756485763458746358734658473567847567473 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
+test mathop-25.23 { exp operator errors } {
+ set res {}
+ set exp {}
+
+ set huge [string repeat 145782 1000]
+ set big 12135435435354435435342423948763867876
+ set wide 12345678912345
+ set small 2
+
+ lappend res [TestOp ** 0 -5]
+ lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
+ lappend res [TestOp ** 0.0 -5.0]
+ lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
+ lappend res [TestOp ** $small $wide]
+ lappend exp "exponent too large NONE"
+ lappend res [TestOp ** 2 $big]
+ lappend exp "exponent too large NONE"
+ lappend res [TestOp ** $huge 2.1]
+ lappend exp "Inf"
+ lappend res [TestOp ** 2 foo]
+ lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+ lappend res [TestOp ** foo 2]
+ lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+
+ expr {$res eq $exp ? 0 : $res}
+} 0
+
+test mathop-26.1 { misc ops, size combinations } {
+ set big1 12135435435354435435342423948763867876
+ set big2 2746237174783836746262564892918327847
+ set wide1 87321847232215
+ set wide2 12345678912345
+ set small1 87345
+ set small2 16753
+
+ set res {}
+ foreach op {+ * - /} {
+ lappend res [TestOp $op $big1 $big2]
+ lappend res [TestOp $op $big1 $wide2]
+ lappend res [TestOp $op $big1 $small2]
+ lappend res [TestOp $op $wide1 $big2]
+ lappend res [TestOp $op $wide1 $wide2]
+ lappend res [TestOp $op $wide1 $small2]
+ lappend res [TestOp $op $small1 $big2]
+ lappend res [TestOp $op $small1 $wide2]
+ lappend res [TestOp $op $small1 $small2]
+ }
+ set res
+} [list \
+ 14881672610138272181604988841682195723 \
+ 12135435435354435435342436294442780221 \
+ 12135435435354435435342423948763884629 \
+ 2746237174783836746262652214765560062 \
+ 99667526144560 \
+ 87321847248968 \
+ 2746237174783836746262564892918415192 \
+ 12345678999690 \
+ 104098 \
+ 33326783924759424684447891401270222910405366244661685890993770489959542972 \
+ 149820189346379518024969783068410988366610965329220 \
+ 203304949848492856848291628413641078526628 \
+ 239806503039903915972546163440347114360602909991105 \
+ 1078047487961768329845194175 \
+ 1462902906681297895 \
+ 239870086031494220602303730571951345796215 \
+ 1078333324598774025 \
+ 1463290785 \
+ 9389198260570598689079859055845540029 \
+ 12135435435354435435342411603084955531 \
+ 12135435435354435435342423948763851123 \
+ -2746237174783836746262477571071095632 \
+ 74976168319870 \
+ 87321847215462 \
+ -2746237174783836746262564892918240502 \
+ -12345678825000 \
+ 70592 \
+ 4 \
+ 982970278225822587257201 \
+ 724373869477373332259441529801460 \
+ 0 \
+ 7 \
+ 5212311062 \
+ 0 \
+ 0 \
+ 5 \
+ ]
+test mathop-26.2 { misc ops, corner cases } {
+ set res {}
+ lappend res [TestOp - 0 -2147483648] ;# -2**31
+ lappend res [TestOp - 0 -9223372036854775808] ;# -2**63
+ lappend res [TestOp / -9223372036854775808 -1]
+ lappend res [TestOp * 2147483648 2]
+ lappend res [TestOp * 9223372036854775808 2]
+ set res
+} [list 2147483648 9223372036854775808 9223372036854775808 4294967296 18446744073709551616]
+
+if 0 {
+ # Compare ops to expr bytecodes
+ namespace import ::tcl::mathop::*
+ proc _X {a b c} {
+ set x [+ $a [- $b $c]]
+ set y [expr {$a + ($b - $c)}]
+ set z [< $a $b $c]
+ }
+ set ::tcl_traceCompile 2
+ _X 3 4 5
+ set ::tcl_traceCompile 0
+}
+
+# cleanup
+namespace delete ::testmathop
+namespace delete ::testmathop2
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/misc.test b/tests/misc.test
index c82944b..d4ece74 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.10 2004/09/22 22:23:40 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 testhashsystemhash [llength [info commands testhashsystemhash]]
test misc-1.1 {error in variable ref. in command in array reference} {
@@ -53,17 +54,12 @@ test misc-1.2 {error in variable ref. in command in array reference} {
# this is a bogus comment
"
set msg {}
- join [list [catch tstProc msg] $msg $errorInfo] \n
+ join [list [catch tstProc msg] $msg $::errorInfo] \n
} [subst -novariables -nocommands {1
missing close-brace for variable name
missing close-brace for variable name
while executing
-"set tst $a([winfo name $\{zz)
- # this is a bogus comment
- # this is a bogus comment
- # this is a bogus comment
- # this is a bogus comment
- # this is a ..."
+"set tst $a([winfo name $\{"
(procedure "tstProc" line 4)
invoked from within
"tstProc"}]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 06fccf6..050b592 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.18 2005/05/10 18:35:22 kennykb Exp $
-package require Tcl 8.2
+package require Tcl 8.5
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
-if {[catch {package require msgcat 1.4.1}]} {
- puts stderr "Skipping tests in [info script]. No msgcat 1.4.1 found to test."
+if {[catch {package require msgcat 1.5}]} {
+ puts stderr "Skipping tests in [info script]. No msgcat 1.5 found to test."
return
}
@@ -54,15 +52,27 @@ namespace eval ::msgcat::test {
foreach setVars [PowerSet $envVars] {
set result [string tolower [lindex $setVars 0]]
if {[string length $result] == 0} {
- set result c
+ if {[info exists ::tcl::mac::locale]} {
+ set result [string tolower \
+ [msgcat::ConvertLocale $::tcl::mac::locale]]
+ } else {
+ if {([info sharedlibextension] eq ".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
+ }
}
- test msgcat-0.$count {
- locale initialization from environment variables
- } -setup {
+ test msgcat-0.$count [list \
+ locale initialization from environment variables $setVars \
+ ] -setup {
variable var
foreach var $envVars {
catch {variable $var $::env($var)}
- catch {unset ::env($var)}
+ unset -nocomplain ::env($var)
}
foreach var $setVars {
set ::env($var) $var
@@ -74,13 +84,13 @@ namespace eval ::msgcat::test {
} -cleanup {
interp delete [namespace current]::i
foreach var $envVars {
- catch {unset ::env($var)}
+ unset -nocomplain ::env($var)
catch {set ::env($var) [set [namespace current]::$var]}
}
} -body {i eval msgcat::mclocale} -result $result
incr count
}
- catch {unset result}
+ unset -nocomplain result
# Could add tests of initialization from Windows registry here.
# Use a fake registry package.
@@ -314,7 +324,7 @@ namespace eval ::msgcat::test {
incr count
}
}
- catch {unset result}
+ unset -nocomplain result
# Tests msgcat-4.*: [mcunknown]
@@ -608,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 0fadd1f..1d8ba31 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -13,52 +13,42 @@
#
# 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.9 2004/08/27 14:39:14 dkf Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.2
namespace import -force ::tcltest::*
}
# Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
-
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+
test namespace-old-1.1 {usage for "namespace" command} {
list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
-
test namespace-old-1.2 {global namespace's name is "::" or {}} {
list [namespace current] [namespace eval {} {namespace current}]
} {:: ::}
-
test namespace-old-1.3 {usage for "namespace eval"} {
list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
test namespace-old-1.4 {create new namespaces} {
list [lsort [namespace children :: test_ns_simple*]] \
[namespace eval test_ns_simple {}] \
[namespace eval test_ns_simple2 {}] \
[lsort [namespace children :: test_ns_simple*]]
} {{} {} {} {::test_ns_simple ::test_ns_simple2}}
-
test namespace-old-1.5 {access a new namespace} {
namespace eval test_ns_simple { namespace current }
} {::test_ns_simple}
-
test namespace-old-1.6 {usage for "namespace eval"} {
list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
test namespace-old-1.7 {usage for "namespace eval"} {
list [catch {namespace eval test_ns_xyzzy} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
test namespace-old-1.8 {command "namespace eval" concatenates args} {
namespace eval test_ns_simple namespace current
} {::test_ns_simple}
-
test namespace-old-1.9 {add elements to a namespace} {
namespace eval test_ns_simple {
variable test_ns_x 0
@@ -67,19 +57,15 @@ test namespace-old-1.9 {add elements to a namespace} {
}
}
} {}
-
test namespace-old-1.10 {commands in a namespace} {
namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}
-
test namespace-old-1.11 {variables in a namespace} {
namespace eval test_ns_simple { info vars [namespace current]::* }
} {::test_ns_simple::test_ns_x}
-
test namespace-old-1.12 {global vars are separate from locals vars} {
list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
} {{test: 123} 0}
-
test namespace-old-1.13 {add to an existing namespace} {
namespace eval test_ns_simple {
variable test_ns_y 123
@@ -88,18 +74,15 @@ test namespace-old-1.13 {add to an existing namespace} {
}
}
} ""
-
test namespace-old-1.14 {commands in a namespace} {
lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
-
test namespace-old-1.15 {variables in a namespace} {
lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
test namespace-old-1.16 {variables in a namespace} {
lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
test namespace-old-1.17 {commands in a namespace are hidden} {
list [catch "_backdoor {return yes!}" msg] $msg
} {1 {invalid command name "_backdoor"}}
@@ -109,7 +92,6 @@ test namespace-old-1.18 {using namespace qualifiers} {
test namespace-old-1.19 {using absolute namespace qualifiers} {
list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}
-
test namespace-old-1.20 {variables in a namespace are hidden} {
list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
@@ -128,25 +110,21 @@ test namespace-old-1.23 {variables can be accessed within a namespace} {
return "$test_ns_x $test_ns_y"
}
} {0 123}
-
test namespace-old-1.24 {setting global variables} {
test_ns_simple::_backdoor {variable test_ns_x; set test_ns_x "new val"}
namespace eval test_ns_simple {set test_ns_x}
} {new val}
-
test namespace-old-1.25 {qualified variables don't need a global declaration} {
namespace eval test_ns_another { variable test_ns_x 456 }
set cmd {set ::test_ns_another::test_ns_x}
list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
[eval $cmd]
} {0 some-value some-value}
-
test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
list [test_ns_simple::_backdoor $cmd] [eval $cmd]
} {{12 34} {12 34}}
-
test namespace-old-1.27 {can create commands with null names} {
proc test_ns_simple:: {args} {return $args}
} {}
@@ -157,35 +135,27 @@ test namespace-old-1.27 {can create commands with null names} {
test namespace-old-2.1 {querying: info commands} {
lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
-
test namespace-old-2.2 {querying: info procs} {
lsort [test_ns_simple::_backdoor {info procs}]
} {{} _backdoor test}
-
test namespace-old-2.3 {querying: info vars} {
lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
test namespace-old-2.4 {querying: info vars} {
lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
test namespace-old-2.5 {querying: info locals} {
lsort [test_ns_simple::_backdoor {info locals}]
} {cmd}
-
test namespace-old-2.6 {querying: info exists} {
test_ns_simple::_backdoor {info exists test_ns_x}
} {0}
-
test namespace-old-2.7 {querying: info exists} {
test_ns_simple::_backdoor {info exists cmd}
} {1}
-
test namespace-old-2.8 {querying: info args} {
info args test_ns_simple::_backdoor
} {cmd}
-
test namespace-old-2.9 {querying: info body} {
string trim [info body test_ns_simple::test]
} {return "test: $test_ns_x"}
@@ -196,7 +166,6 @@ test namespace-old-2.9 {querying: info body} {
test namespace-old-3.1 {usage for "namespace qualifiers"} {
list [catch "namespace qualifiers" msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}
-
test namespace-old-3.2 {querying: namespace qualifiers} {
list [namespace qualifiers ""] \
[namespace qualifiers ::] \
@@ -205,11 +174,9 @@ test namespace-old-3.2 {querying: namespace qualifiers} {
[namespace qualifiers foo::x] \
[namespace qualifiers ::foo::bar::xyz]
} {{} {} {} {} foo ::foo::bar}
-
test namespace-old-3.3 {usage for "namespace tail"} {
list [catch "namespace tail" msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}
-
test namespace-old-3.4 {querying: namespace tail} {
list [namespace tail ""] \
[namespace tail ::] \
@@ -236,23 +203,20 @@ test namespace-old-4.1 {define test namespaces} {
lsort [namespace children]
}
} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
-
test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
list [catch {namespace delete} msg] $msg
} {0 {}}
-
test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
set cmd {
namespace eval test_ns_delete {namespace delete ns*}
}
list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}
-
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
set cmd {
namespace eval test_ns_delete {
namespace delete \
- {expand}[namespace children [namespace current] ns?]
+ {*}[namespace children [namespace current] ns?]
}
}
list [catch $cmd msg] $msg [namespace children test_ns_delete]
@@ -264,125 +228,99 @@ test namespace-old-4.4 {command "namespace delete" handles multiple args} {
test namespace-old-5.1 {define nested namespaces} {
set test_ns_var_global "var in ::"
proc test_ns_cmd_global {} {return "cmd in ::"}
-
namespace eval test_ns_hier1 {
set test_ns_var_hier1 "particular to hier1"
proc test_ns_cmd_hier1 {} {return "particular to hier1"}
-
set test_ns_level 1
proc test_ns_show {} {return "[namespace current]: 1"}
-
namespace eval test_ns_hier2 {
set test_ns_var_hier2 "particular to hier2"
proc test_ns_cmd_hier2 {} {return "particular to hier2"}
-
set test_ns_level 2
proc test_ns_show {} {return "[namespace current]: 2"}
-
namespace eval test_ns_hier3a {}
namespace eval test_ns_hier3b {}
}
-
namespace eval test_ns_hier2a {}
namespace eval test_ns_hier2b {}
}
} {}
-
test namespace-old-5.2 {namespaces can be nested} {
list [namespace eval test_ns_hier1 {namespace current}] \
[namespace eval test_ns_hier1 {
namespace eval test_ns_hier2 {namespace current}
}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
-
test namespace-old-5.3 {namespace qualifiers work in namespace command} {
list [namespace eval ::test_ns_hier1 {namespace current}] \
[namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
[namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
-
test namespace-old-5.4 {nested namespaces can access global namespace} {
list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
[namespace eval test_ns_hier1 {test_ns_cmd_global}] \
[namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
[namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
-
test namespace-old-5.5 {variables in different namespaces don't conflict} {
list [set test_ns_hier1::test_ns_level] \
[set test_ns_hier1::test_ns_hier2::test_ns_level]
} {1 2}
-
test namespace-old-5.6 {commands in different namespaces don't conflict} {
list [test_ns_hier1::test_ns_show] \
[test_ns_hier1::test_ns_hier2::test_ns_show]
} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
-
test namespace-old-5.7 {nested namespaces don't see variables in parent} {
set cmd {
namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
}
list [catch $cmd msg] $msg
} {1 {can't read "test_ns_var_hier1": no such variable}}
-
test namespace-old-5.8 {nested namespaces don't see commands in parent} {
set cmd {
namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
}
list [catch $cmd msg] $msg
} {1 {invalid command name "test_ns_cmd_hier1"}}
-
test namespace-old-5.9 {usage for "namespace children"} {
list [catch {namespace children test_ns_hier1 y z} msg] $msg
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
-
-test namespace-old-5.10 {command "namespace children" must get valid namespace} {
- list [catch {namespace children xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace children command}}
-
+test namespace-old-5.10 {command "namespace children" must get valid namespace} -body {
+ namespace children xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
test namespace-old-5.11 {querying namespace children} {
lsort [namespace children :: test_ns_hier*]
} {::test_ns_hier1}
-
test namespace-old-5.12 {querying namespace children} {
lsort [namespace children test_ns_hier1]
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
-
test namespace-old-5.13 {querying namespace children} {
lsort [namespace eval test_ns_hier1 {namespace children}]
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
-
test namespace-old-5.14 {querying namespace children} {
lsort [namespace children test_ns_hier1::test_ns_hier2]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
test namespace-old-5.15 {querying namespace children} {
lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
test namespace-old-5.16 {querying namespace children with patterns} {
lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
test namespace-old-5.17 {querying namespace children with patterns} {
lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
test namespace-old-5.18 {usage for "namespace parent"} {
list [catch {namespace parent x y} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}
-
-test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
- list [catch {namespace parent xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace parent command}}
-
+test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body {
+ namespace parent xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
test namespace-old-5.20 {querying namespace parent} {
list [namespace eval :: {namespace parent}] \
[namespace eval test_ns_hier1 {namespace parent}] \
[namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
[namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
-
test namespace-old-5.21 {querying namespace parent for explicit namespace} {
list [namespace parent ::] \
[namespace parent test_ns_hier1] \
@@ -406,25 +344,21 @@ test namespace-old-6.1 {relative ns names only looked up in current ns} {
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
test namespace-old-6.2 {relative ns names only looked up in current ns} {
namespace eval test_ns_cache1::test_ns_cache2 {}
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
test namespace-old-6.3 {relative ns names only looked up in current ns} {
namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
test namespace-old-6.4 {relative ns names only looked up in current ns} {
namespace delete test_ns_cache1::test_ns_cache2
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
test namespace-old-6.5 {define test commands} {
proc test_ns_cache_cmd {} {
return "global version"
@@ -436,35 +370,30 @@ test namespace-old-6.5 {define test commands} {
}
test_ns_cache1::trigger
} {global version}
-
test namespace-old-6.6 {one-level check for command shadowing} {
proc test_ns_cache1::test_ns_cache_cmd {} {
return "cache1 version"
}
test_ns_cache1::trigger
} {cache1 version}
-
test namespace-old-6.7 {renaming commands changes command epoch} {
namespace eval test_ns_cache1 {
rename test_ns_cache_cmd test_ns_new
}
test_ns_cache1::trigger
} {global version}
-
test namespace-old-6.8 {renaming back handles shadowing} {
namespace eval test_ns_cache1 {
rename test_ns_new test_ns_cache_cmd
}
test_ns_cache1::trigger
} {cache1 version}
-
test namespace-old-6.9 {deleting commands changes command epoch} {
namespace eval test_ns_cache1 {
rename test_ns_cache_cmd ""
}
test_ns_cache1::trigger
} {global version}
-
test namespace-old-6.10 {define test namespaces} {
namespace eval test_ns_cache2 {
proc test_ns_cache_cmd {} {
@@ -483,34 +412,29 @@ test namespace-old-6.10 {define test namespaces} {
}
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{global cache2 version} {global version}}
-
test namespace-old-6.11 {commands affect all parent namespaces} {
proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
return "cache2 version"
}
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
-
test namespace-old-6.12 {define test variables} {
variable test_ns_cache_var "global version"
set trigger {set test_ns_cache_var}
namespace eval test_ns_cache1 $trigger
} {global version}
-
test namespace-old-6.13 {one-level check for variable shadowing} {
namespace eval test_ns_cache1 {
variable test_ns_cache_var "cache1 version"
}
namespace eval test_ns_cache1 $trigger
} {cache1 version}
-
test namespace-old-6.14 {deleting variables changes variable epoch} {
namespace eval test_ns_cache1 {
unset test_ns_cache_var
}
namespace eval test_ns_cache1 $trigger
} {global version}
-
test namespace-old-6.15 {define test namespaces} {
namespace eval test_ns_cache2 {
variable test_ns_cache_var "global cache2 version"
@@ -519,13 +443,11 @@ test namespace-old-6.15 {define test namespaces} {
list [namespace eval test_ns_cache1 $trigger2] \
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}
-
test namespace-old-6.16 {public variables affect all parent namespaces} {
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
list [namespace eval test_ns_cache1 $trigger2] \
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{cache2 version} {cache2 version}}
-
test namespace-old-6.17 {usage for "namespace which"} {
list [catch "namespace which -baz x" msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
@@ -533,7 +455,6 @@ test namespace-old-6.18 {usage for "namespace which"} {
# Presume no imported command called -command ;^)
namespace which -command
} {}
-
test namespace-old-6.19 {querying: namespace which -command} {
proc test_ns_cache1::test_ns_cache_cmd {} {
return "cache1 version"
@@ -543,17 +464,14 @@ test namespace-old-6.19 {querying: namespace which -command} {
[namespace eval :: {namespace which -command test_ns_cache_cmd}] \
[namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
-
test namespace-old-6.20 {command "namespace which" may not find commands} {
namespace eval test_ns_cache1 {namespace which -command xyzzy}
} {}
-
test namespace-old-6.21 {querying: namespace which -variable} {
namespace eval test_ns_cache1::test_ns_cache2 {
namespace which -variable test_ns_cache_var
}
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
-
test namespace-old-6.22 {command "namespace which" may not find variables} {
namespace eval test_ns_cache1 {namespace which -variable xyzzy}
} {}
@@ -565,7 +483,6 @@ test namespace-old-7.1 {define test namespace} {
namespace eval test_ns_uplevel {
variable x 0
variable y 1
-
proc show_vars {num} {
return [uplevel $num {info vars}]
}
@@ -577,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]
@@ -586,10 +503,9 @@ test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
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]
@@ -597,11 +513,9 @@ test namespace-old-7.6 {absolute call frame references work too} {
test namespace-old-7.7 {absolute call frame references work too} {
expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
} {1}
-
test namespace-old-7.8 {namespaces are included in the call stack} {
namespace eval test_ns_upvar {
variable scope "test_ns_upvar"
-
proc show_val {var num} {
upvar $num $var x
return $x
@@ -633,7 +547,6 @@ test namespace-old-8.1 {traces work across namespace boundaries} {
namespace eval foo {
variable x ""
}
-
variable status ""
proc monitor {name1 name2 op} {
variable status
@@ -644,7 +557,6 @@ test namespace-old-8.1 {traces work across namespace boundaries} {
set test_ns_trace::foo::x "yes!"
set test_ns_trace::foo::x
unset test_ns_trace::foo::x
-
namespace eval test_ns_trace { set status }
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
@@ -657,7 +569,6 @@ test namespace-old-9.1 {empty "namespace export" list} {
test namespace-old-9.2 {usage for "namespace export" command} {
list [catch "namespace export test_ns_trace::zzz" msg] $msg
} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
-
test namespace-old-9.3 {define test namespaces for import} {
namespace eval test_ns_export {
namespace export cmd1 cmd2 cmd3
@@ -670,7 +581,6 @@ test namespace-old-9.3 {define test namespaces for import} {
}
lsort [info commands test_ns_export::*]
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
-
test namespace-old-9.4 {check export status} {
set x ""
namespace eval test_ns_import {
@@ -682,19 +592,20 @@ test namespace-old-9.4 {check export status} {
}
set x
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
-
test namespace-old-9.5 {empty import list in "namespace import" command} {
- namespace import
-} {}
-
-test namespace-old-9.6 {empty import list for "namespace import" command} {
- namespace import
-} {}
-
+ namespace eval test_ns_import_empty {
+ namespace import ::test_ns_export::*
+ try {
+ lsort [namespace import]
+ } finally {
+ namespace delete [namespace current]
+ }
+ }
+} {cmd1 cmd2 cmd3}
+# there is no namespace-old-9.6
test namespace-old-9.7 {empty forget list for "namespace forget" command} {
namespace forget
} {}
-
catch {rename cmd1 {}}
catch {rename cmd2 {}}
catch {rename ncmd {}}
@@ -704,11 +615,9 @@ test namespace-old-9.8 {only exported commands are imported} {
namespace import test_ns_import::cmd*
set x [lsort [info commands cmd*]]
} {cmd1 cmd2}
-
test namespace-old-9.9 {imported commands work just the same as original} {
list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
-
test namespace-old-9.10 {commands can be imported from many namespaces} {
namespace eval test_ns_import2 {
namespace export ncmd ncmd1 ncmd2
@@ -720,27 +629,22 @@ test namespace-old-9.10 {commands can be imported from many namespaces} {
namespace import test_ns_import2::*
lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
-
test namespace-old-9.11 {imported commands can be removed by deleting them} {
rename cmd1 ""
lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd2 ncmd ncmd1 ncmd2}
-
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
-
test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
[lsort [info commands cmd?]]
} {0 {} cmd2}
-
test namespace-old-9.14 {imported commands can be removed} {
namespace forget test_ns_import::cmd?
list [lsort [info commands cmd?]] \
[catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
-
test namespace-old-9.15 {existing commands can't be overwritten} {
proc cmd1 {x y} {
return [expr $x+$y]
@@ -748,13 +652,11 @@ test namespace-old-9.15 {existing commands can't be overwritten} {
list [catch {namespace import test_ns_import::cmd?} msg] $msg \
[cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
-
test namespace-old-9.16 {use "-force" option to override existing commands} {
list [cmd1 3 5] \
[namespace import -force test_ns_import::cmd?] \
[cmd1 3 5]
} {8 {} {cmd1: 3 5}}
-
test namespace-old-9.17 {commands can be imported into many namespaces} {
namespace eval test_ns_import_use {
namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
@@ -762,13 +664,11 @@ test namespace-old-9.17 {commands can be imported into many namespaces} {
[info commands ::test_ns_import_use::ncmd*]]
}
} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
-
test namespace-old-9.18 {when command is deleted, imported commands go away} {
namespace eval test_ns_import { rename cmd1 "" }
list [info commands cmd1] \
[namespace eval test_ns_import_use {info commands cmd1}]
} {{} {}}
-
test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
namespace delete test_ns_import test_ns_import2
list [info commands cmd*] \
@@ -792,43 +692,36 @@ test namespace-old-10.1 {define namespace for scope test} {
list [set x] [show test]
}
} {x-value {show: test}}
-
test namespace-old-10.2 {command "namespace code" requires one argument} {
list [catch {namespace code} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}
-
test namespace-old-10.3 {command "namespace code" requires one argument} {
list [catch {namespace code first "second arg" third} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}
-
test namespace-old-10.4 {command "namespace code" gets current namesp context} {
namespace eval test_ns_inscope {
namespace code {"1 2 3" "4 5" 6}
}
} {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
-
test namespace-old-10.5 {with one arg, first "scope" sticks} {
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
namespace code $sval
} {::namespace inscope ::test_ns_inscope {one two}}
-
test namespace-old-10.6 {with many args, each "scope" adds new args} {
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
namespace code "$sval three"
} {::namespace inscope ::test_ns_inscope {one two} three}
-
test namespace-old-10.7 {scoped commands work with eval} {
set cref [namespace eval test_ns_inscope {namespace code show}]
list [eval $cref "a" "b c" "d e f"]
} {{show: a b c d e f}}
-
test namespace-old-10.8 {scoped commands execute in namespace context} {
set cref [namespace eval test_ns_inscope {
namespace code {set x "some new value"}
}]
list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
} {x-value {some new value} {some new value}}
-
+
foreach cmd [info commands test_ns_*] {
rename $cmd ""
}
@@ -851,3 +744,7 @@ eval namespace delete [namespace children :: test_ns_*]
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/namespace.test b/tests/namespace.test
index 947beb6..fab0040 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1,25 +1,37 @@
# 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.46 2005/07/05 17:33:07 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 2
- namespace import -force ::tcltest::*
-}
+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'.
+#
# Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: 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_*
@@ -40,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} {
@@ -79,7 +90,7 @@ test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
} {123}
test namespace-6.1 {Tcl_CreateNamespace} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [lsort [namespace children :: test_ns_*]] \
[namespace eval test_ns_1 {namespace current}] \
[namespace eval test_ns_2 {namespace current}] \
@@ -98,7 +109,7 @@ test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1:: {
namespace eval test_ns_2:: {}
namespace eval test_ns_3:: {}
@@ -116,7 +127,7 @@ test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1 {
proc p {} {
namespace delete [namespace current]
@@ -133,6 +144,56 @@ test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
}
list [test_ns_2::p] [namespace delete test_ns_2]
} {::test_ns_2 {}}
+test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
+ # [Bug 1355942]
+ namespace eval test_ns_2 {
+ set x 1
+ trace add variable x unset "namespace delete [namespace current];#"
+ namespace delete [namespace current]
+ }
+} {}
+test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
+ # [Bug 1355942]
+ namespace eval test_ns_2 {
+ proc x {} {}
+ trace add command x delete "namespace delete [namespace current];#"
+ namespace delete [namespace current]
+ }
+} {}
+test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
+ # [Bug 1355942]
+ namespace eval test_ns_2 {
+ set x 1
+ trace add variable x unset "namespace delete [namespace current];#"
+ }
+ namespace delete test_ns_2
+} {}
+test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
+ # [Bug 1355942]
+ namespace eval test_ns_2 {
+ proc x {} {}
+ trace add command x delete "namespace delete [namespace current];#"
+ }
+ namespace delete test_ns_2
+} {}
+test namespace-7.7 {Bug 1655305} -setup {
+ interp create slave
+ # Can't invoke through the ensemble, since deleting the global namespace
+ # (indirectly, via deleting ::tcl) deletes the ensemble.
+ slave eval {rename ::tcl::info::commands ::infocommands}
+ slave hide infocommands
+ slave eval {
+ proc foo {} {
+ namespace delete ::
+ }
+ }
+} -body {
+ slave eval foo
+ slave invokehidden infocommands
+} -cleanup {
+ interp delete slave
+} -result {}
+
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
catch {interp delete test_interp}
@@ -161,7 +222,7 @@ test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
[interp delete test_interp]
} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
list [namespace children test_ns_1] \
@@ -169,7 +230,7 @@ test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
[namespace children test_ns_1]
} {::test_ns_1::test_ns_2 {} {}}
test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
list [namespace children test_ns_1] \
@@ -177,9 +238,9 @@ test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
[namespace children test_ns_1] \
[catch {namespace children test_ns_1::test_ns_2} msg] $msg \
[info commands test_ns_1::test_ns_2::test_ns_3a::*]
-} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
+} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}}
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
namespace export cmd1 cmd2
proc cmd1 {args} {return "cmd1: $args"}
@@ -220,7 +281,7 @@ test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values}
} baz
test namespace-9.1 {Tcl_Import, empty import pattern} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
} {1 {empty import pattern}}
test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
@@ -230,7 +291,7 @@ test namespace-9.3 {Tcl_Import, import ns == export ns} {
list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
test namespace-9.4 {Tcl_Import, simple import} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
@@ -242,7 +303,7 @@ test namespace-9.4 {Tcl_Import, simple import} {
}
test_ns_import::p
} {cmd1: 123}
-test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} {
list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
@@ -252,7 +313,7 @@ test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
}
} {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
@@ -314,7 +375,7 @@ test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
} -returnCodes error -match glob -result {import pattern * would create a loop*}
test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
@@ -454,7 +515,7 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
} -returnCodes error -match glob -result *
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
@@ -478,7 +539,7 @@ test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
} {{cmd1: 123} ::test_ns_export::cmd1}
test namespace-12.1 {InvokeImportedCmd} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
namespace export cmd1
proc cmd1 {args} {namespace current}
@@ -497,9 +558,18 @@ test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
lappend l [info commands ::test_ns_import::*]
}
} {::test_ns_import::cmd1 {}}
+test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
+ # Will panic if still buggy
+ namespace eval src {namespace export foo; proc foo {} {}}
+ namespace eval dst {namespace import [namespace parent]::src::foo}
+ trace add command src::foo delete \
+ "[list namespace delete [namespace current]::dst] ;#"
+ proc src::foo {} {}
+ namespace delete src
+} {}
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
variable v 10
namespace eval test_ns_1::test_ns_2 {
variable v 20
@@ -517,7 +587,7 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
list [catch {set ::test_ns_777::v} msg] $msg \
[catch {namespace children test_ns_777} msg] $msg
}
-} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
+} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
namespace eval test_ns_1 {
list $v $test_ns_2::v
@@ -531,15 +601,14 @@ test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up onl
list [namespace children test_ns_2] \
[catch {namespace children test_ns_1} msg] $msg
}
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
namespace eval ::test_ns_2 {
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 {
@@ -549,7 +618,7 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl
list [namespace children test_ns_2] \
[catch {namespace children test_ns_1} msg] $msg
}
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
namespace children test_ns_1:::
} {::test_ns_1::test_ns_2}
@@ -577,7 +646,7 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for
lappend l [test_ns_1::test_ns_2:: hello]
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1 {
variable {}
set test_ns_1::(x) y
@@ -585,12 +654,12 @@ test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for
set test_ns_1::(x)
} y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
} {1 {can't create namespace "": only global namespace can have empty name}}
test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_delete {
namespace eval test_ns_delete2 {}
proc cmd {args} {namespace current}
@@ -617,7 +686,7 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
test namespace-16.1 {Tcl_FindCommand, absolute name found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1 {
proc cmd {args} {return "[namespace current]::cmd: $args"}
variable v "::test_ns_1::cmd"
@@ -660,14 +729,16 @@ test namespace-16.8 {Tcl_FindCommand, relative name found} {
cmd a b c
}
} {::test_ns_1::cmd: a b c}
-test namespace-16.9 {Tcl_FindCommand, relative name found} {
- catch {rename cmd2 {}}
+test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
namespace eval test_ns_1 {
cmd2 a b c
}
-} {::::cmd2: a b c}
-test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
+} -cleanup {
+ catch {rename cmd2 {}}
+} -result {::::cmd2: a b c}
+test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body {
+ proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
namespace eval test_ns_1 {
proc cmd2 {args} {
return "[namespace current]::cmd2 in test_ns_1: $args"
@@ -676,7 +747,9 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current
cmd2 a b c
}
}
-} {::::cmd2: a b c}
+} -cleanup {
+ catch {rename cmd2 {}}
+} -result {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
namespace eval test_ns_1 {
list [catch {cmd3 a b c} msg] $msg
@@ -685,7 +758,7 @@ test namespace-16.11 {Tcl_FindCommand, relative name not found} {
catch {unset x}
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
set x 314159
namespace eval test_ns_1 {
set ::x
@@ -754,7 +827,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}
@@ -762,7 +835,7 @@ catch {unset x}
catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
proc foo {} {return "global foo"}
namespace eval test_ns_1 {
proc trigger {} {
@@ -776,7 +849,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 {
@@ -797,13 +869,12 @@ 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 {}}
test namespace-19.1 {GetNamespaceFromObj, global name found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1::test_ns_2 {}
namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
@@ -812,11 +883,11 @@ test namespace-19.2 {GetNamespaceFromObj, relative name found} {
namespace children test_ns_2
}
} {}
-test namespace-19.3 {GetNamespaceFromObj, name not found} {
+test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
namespace eval test_ns_1 {
- list [catch {namespace children test_ns_99} msg] $msg
+ namespace children test_ns_99
}
-} {1 {unknown namespace "test_ns_99" in namespace children command}}
+} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
namespace eval test_ns_1 {
proc foo {} {
@@ -829,22 +900,21 @@ 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} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
-test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
- list [catch {namespace wombat {}} msg] $msg
-} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
+test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
+ namespace wombat {}
+} -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_*
} {}
test namespace-21.1 {NamespaceChildrenCmd, no args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1::test_ns_2 {}
expr {[string first ::test_ns_1 [namespace children]] != -1}
} {1}
@@ -874,9 +944,13 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
namespace eval test_ns_1::test_ns_foo {}
lsort [namespace children test_ns_1 test*]
} [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] [fq test_ns_1]
+} [fq test_ns_1]
test namespace-22.1 {NamespaceCodeCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace code} msg] $msg \
[catch {namespace code xxx yyy} msg] $msg
} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
@@ -884,11 +958,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}
@@ -908,9 +982,15 @@ 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 {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace current xxx} msg] $msg \
[catch {namespace current xxx yyy} msg] $msg
} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
@@ -924,7 +1004,7 @@ test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
} {::test_ns_1::test_ns_2}
test namespace-24.1 {NamespaceDeleteCmd, no args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace delete
} {}
test namespace-24.2 {NamespaceDeleteCmd, one arg} {
@@ -940,12 +1020,12 @@ test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
test namespace-25.1 {NamespaceEvalCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-test namespace-25.2 {NamespaceEvalCmd, bad args} {
- list [catch {namespace test_ns_1} msg] $msg
-} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
+test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
+ namespace test_ns_1
+} -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
@@ -968,7 +1048,7 @@ test namespace-25.5 {NamespaceEvalCmd, multiple args} {
namespace eval test_ns_1 "set" "v"
} {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
while executing
"xxxx"
@@ -976,21 +1056,24 @@ test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
invoked from within
"namespace eval test_ns_1 {xxxx}"}}
test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo
} {1 foo {bar
(in namespace eval "::test_ns_1" script line 1)
invoked from within
"namespace eval test_ns_1 {error foo bar baz}"}}
test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} {
- list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
+ list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo
} {1 foo {bar
(in namespace eval "::test_ns_1" script line 1)
invoked from within
"namespace eval test_ns_1 error foo bar baz"}}
catch {unset v}
+test namespace-25.9 {NamespaceEvalCmd, 545325} {
+ namespace eval test_ns_1 info level 0
+} {namespace eval test_ns_1 info level 0}
test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace export
} {}
test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
@@ -1037,9 +1120,17 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
}
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
+test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
+ catch {namespace delete foo}
+ namespace eval foo {
+ namespace export x
+ namespace export -clear
+ }
+ list [namespace eval foo namespace export] [namespace delete foo]
+} {{} {}}
test namespace-27.1 {NamespaceForgetCmd, no args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace forget
} {}
test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
@@ -1058,10 +1149,23 @@ test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
info commands ::test_ns_2::*
} {::test_ns_2::cmd2}
-test namespace-28.1 {NamespaceImportCmd, no args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
- namespace import
-} {}
+test namespace-28.1 {NamespaceImportCmd, no args} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
+ namespace eval ::test_ns_1 {
+ proc foo {} {}
+ proc bar {} {}
+ proc boo {} {}
+ proc glorp {} {}
+ namespace export foo b*
+ }
+ namespace eval ::test_ns_2 {
+ namespace import ::test_ns_1::*
+ lsort [namespace import]
+ }
+} -cleanup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -result {bar boo foo}
test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
namespace import -force
} {}
@@ -1079,15 +1183,15 @@ test namespace-28.3 {NamespaceImportCmd, arg is imported} {
} {::test_ns_2::cmd2}
test namespace-29.1 {NamespaceInscopeCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace inscope} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
list [catch {namespace inscope ::} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
-test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
- list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
-} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
+test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body {
+ namespace inscope test_ns_1 {set v}
+} -returnCodes error -result {namespace "test_ns_1" not found in "::"}
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
namespace eval test_ns_1 {
variable v 747
@@ -1102,9 +1206,13 @@ test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
list [namespace inscope test_ns_1 cmd x y z] \
[namespace eval test_ns_1 [concat cmd [list x y z]]]
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
+test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
+ namespace inscope test_ns_1 {info level 0}
+} {namespace inscope test_ns_1 {info level 0}}
+
test namespace-30.1 {NamespaceOriginCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace origin} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.2 {NamespaceOriginCmd, bad args} {
@@ -1137,7 +1245,7 @@ test namespace-30.5 {NamespaceOriginCmd, imported command} {
} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
test namespace-31.1 {NamespaceParentCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace parent a b} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}
test namespace-31.2 {NamespaceParentCmd, no args} {
@@ -1153,12 +1261,12 @@ test namespace-31.3 {NamespaceParentCmd, namespace specified} {
[namespace parent test_ns_1::test_ns_2] \
[namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
} {{} ::test_ns_1 ::test_ns_1}
-test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
- list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
-} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
+test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body {
+ namespace parent test_ns_1::test_ns_foo
+} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"}
test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace qualifiers} msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}
test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
@@ -1184,7 +1292,7 @@ test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
} {foo}
test namespace-33.1 {NamespaceTailCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace tail} msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}
test namespace-33.2 {NamespaceTailCmd, bad args} {
@@ -1210,7 +1318,7 @@ test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
} {}
test namespace-34.1 {NamespaceWhichCmd, bad args} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
list [catch {namespace which} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.2 {NamespaceWhichCmd, bad args} {
@@ -1263,7 +1371,7 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1 {
proc p {} {
namespace delete [namespace current]
@@ -1286,7 +1394,7 @@ test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
catch {unset x}
catch {unset y}
test namespace-36.1 {DupNsNameInternalRep} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1 {}
set x "::test_ns_1"
list [namespace parent $x] [set y $x] [namespace parent $y]
@@ -1295,27 +1403,27 @@ catch {unset x}
catch {unset y}
test namespace-37.1 {SetNsNameFromAny, ns name found} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_1::test_ns_2 {}
namespace eval test_ns_1 {
namespace children ::test_ns_1
}
} {::test_ns_1::test_ns_2}
-test namespace-37.2 {SetNsNameFromAny, ns name not found} {
+test namespace-37.2 {SetNsNameFromAny, ns name not found} -body {
namespace eval test_ns_1 {
- list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
+ namespace children ::test_ns_1::test_ns_foo
}
-} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
+} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found}
test namespace-38.1 {UpdateStringOfNsName} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
list [namespace eval {} {namespace current}] \
[namespace eval {} {namespace current}]
} {:: ::}
test namespace-39.1 {NamespaceExistsCmd} {
- catch {namespace delete {expand}[namespace children :: test_ns_*]}
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval ::test_ns_z::test_me { variable foo }
list [namespace exists ::] \
[namespace exists ::bogus_namespace] \
@@ -1334,16 +1442,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 {}
@@ -1361,7 +1470,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 {}
@@ -1375,19 +1483,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
@@ -1426,18 +1531,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}
@@ -1445,11 +1550,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 {
@@ -1462,11 +1567,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 {
@@ -1479,10 +1584,24 @@ 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]
+ proc trial args {variable target; string length $target}
+ trace add execution demo enter [namespace code trial]
+ namespace ensemble create -command foo -map [list bar $target]
+} -body {
+ foo bar
+} -cleanup {
+ unset target
+ rename demo {}
+ rename trial {}
+ rename foo {}
+} -result {}
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
@@ -1495,7 +1614,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}
@@ -1504,10 +1623,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
@@ -1605,6 +1724,9 @@ test namespace-44.5 {ensemble: errors} -setup {
} -cleanup {
rename foobar {}
} -returnCodes error -result {invalid command name "::foobarconfigure"}
+test namespace-44.6 {ensemble: errors} -returnCodes error -body {
+ namespace ensemble create gorp
+} -result {wrong # args: should be "namespace ensemble create ?option value ...?"}
test namespace-45.1 {ensemble: introspection} {
namespace eval ns {
@@ -1615,7 +1737,7 @@ test namespace-45.1 {ensemble: introspection} {
}
namespace delete ns
set result
-} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
+} {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
namespace eval ns {
namespace export x
@@ -1631,15 +1753,12 @@ test namespace-46.1 {ensemble: modification} {
namespace eval ns {
namespace export x
proc x {} {format 123}
-
# Ensemble maps A->x
namespace ensemble create -command ns -map {A ::ns::x}
set ::result [list [namespace ensemble configure ns -map] [ns A]]
-
# Ensemble maps B->x
namespace ensemble configure ns -map {B ::ns::x}
lappend ::result [namespace ensemble configure ns -map] [ns B]
-
# Ensemble maps x->x
namespace ensemble configure ns -map {}
lappend ::result [namespace ensemble configure ns -map] [ns x]
@@ -1679,7 +1798,7 @@ test namespace-46.3 {ensemble: implementation errors} {
lappend result $ns::count
namespace delete ns
lappend result [info command p]
-} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}}
+} {1 {wrong # args: should be "ns subcommand ?arg ...?"} 10 3010 3010 {}}
test namespace-46.4 {ensemble: implementation errors} {
namespace eval ns {
namespace ensemble create
@@ -1777,7 +1896,7 @@ test namespace-47.2 {ensemble: unknown handler} {
}
namespace ensemble create -unknown ::ns::Magic
}
- list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+ list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
} {1 foobar {foobar
while executing
"error foobar"
@@ -1810,7 +1929,7 @@ test namespace-47.4 {ensemble: unknown handler} {
}
namespace ensemble create -unknown ::ns::Magic
}
- list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+ list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break
result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong
invoked from within
@@ -1829,19 +1948,37 @@ test namespace-47.5 {ensemble: unknown handler} {
lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
rename foo {}
set result
-} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}}
+} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}}
test namespace-47.6 {ensemble: unknown handler} {
namespace ensemble create -command foo -unknown bar
proc bar {args} {
return "\{"
}
- set result [list [catch {foo bar} msg] $msg $errorInfo]
+ set result [list [catch {foo bar} msg] $msg $::errorInfo]
rename foo {}
set result
} {1 {unmatched open brace in list} {unmatched open brace in list
while parsing result of ensemble unknown subcommand handler
invoked from within
"foo bar"}}
+test namespace-47.7 {ensemble: unknown handler, commands with spaces} {
+ namespace ensemble create -command foo -unknown bar
+ proc bar {args} {
+ list ::set ::x [join $args |]
+ }
+ set result [foo {one two three}]
+ rename foo {}
+ set result
+} {::foo|one two three}
+test namespace-47.8 {ensemble: unknown handler, commands with spaces} {
+ namespace ensemble create -command foo -unknown {bar boo}
+ proc bar {args} {
+ list ::set ::x [join $args |]
+ }
+ set result [foo {one two three}]
+ rename foo {}
+ set result
+} {boo|::foo|one two three}
test namespace-48.1 {ensembles and namespace import: unknown handler} {
namespace eval foo {
@@ -1878,7 +2015,7 @@ test namespace-48.1 {ensembles and namespace import: unknown handler} {
bar z 789
namespace delete foo
set result
-} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
+} {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
test namespace-48.2 {ensembles and namespace import: exists} {
namespace eval foo {
namespace ensemble create -command ::foo::bar
@@ -1942,7 +2079,7 @@ test namespace-50.1 {ensembles affect proc arguments error messages} -body {
namespace ens cre -command a -map {b {bb foo}}
proc bb {c d {e f} args} {list $c $args}
a b
-} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup {
+} -returnCodes error -result "wrong # args: should be \"a b d ?e? ?arg ...?\"" -cleanup {
rename a {}
rename bb {}
}
@@ -1959,6 +2096,7 @@ test namespace-50.3 {chained ensembles affect error messages} -body {
a b d
} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup {
rename a {}
+ rename c {}
}
test namespace-50.4 {chained ensembles affect error messages} -body {
namespace ens cre -command a -map {b {c d}}
@@ -1967,6 +2105,7 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
a b d
} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup {
rename a {}
+ rename c {}
}
test namespace-51.1 {name resolution path control} -body {
@@ -2235,7 +2374,7 @@ test namespace-51.10 {name resolution path control} -body {
namespace eval ::test_ns_1 {
namespace path does::not::exist
}
-} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup {
+} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup {
catch {namespace delete ::test_ns_1}
}
test namespace-51.11 {name resolution path control} -body {
@@ -2278,15 +2417,14 @@ test namespace-51.12 {name resolution path control} -body {
catch {namespace delete ::test_ns_3}
catch {namespace delete ::test_ns_4}
}
-# Fails right now due to unrelated bug...
-test namespace-51.13 {name resolution path control} -constraints knownBug -body {
+test namespace-51.13 {name resolution path control} -body {
set ::result {}
namespace eval ::test_ns_1 {
proc foo {} {lappend ::result 1}
}
namespace eval ::test_ns_2 {
proc foo {} {lappend ::result 2}
- trace add command foo delete {namespace eval ::test_ns_3 foo;#}
+ trace add command foo delete "namespace eval ::test_ns_3 foo;#"
}
namespace eval ::test_ns_3 {
proc foo {} {
@@ -2302,21 +2440,24 @@ test namespace-51.13 {name resolution path control} -constraints knownBug -body
}
bar
}
- # Should the result be "2 {} {2 3 1 1}" instead?
-} -result {2 {} {2 3 2 1}} -cleanup {
+ # Should the result be "2 {} {2 3 2 1}" instead?
+} -result {2 {} {2 3 1 1}} -cleanup {
catch {namespace delete ::test_ns_1}
catch {namespace delete ::test_ns_2}
catch {namespace delete ::test_ns_3}
catch {namespace delete ::test_ns_4}
}
-test namespace-51.14 {name resolution path control} -body {
- proc foo0 {} {}
- namespace eval ::test_ns_1 {
- proc foo1 {} {}
- }
- namespace eval ::test_ns_2 {
- proc foo2 {} {}
+test namespace-51.14 {name resolution path control} -setup {
+ foreach cmd [info commands foo*] {
+ rename $cmd {}
}
+ namespace eval ::test_ns_1 {}
+ namespace eval ::test_ns_2 {}
+ namespace eval ::test_ns_3 {}
+} -body {
+ proc foo0 {} {}
+ proc ::test_ns_1::foo1 {} {}
+ proc ::test_ns_2::foo2 {} {}
namespace eval ::test_ns_3 {
variable result {}
lappend result [info commands foo*]
@@ -2329,11 +2470,11 @@ test namespace-51.14 {name resolution path control} -body {
namespace delete ::test_ns_1
lappend result [info commands foo*]
}
-} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup {
+} -cleanup {
catch {namespace delete ::test_ns_1}
catch {namespace delete ::test_ns_2}
catch {namespace delete ::test_ns_3}
-}
+} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}}
test namespace-51.15 {namespace resolution path control} -body {
namespace eval ::test_ns_2 {
proc foo {} {return 2}
@@ -2351,13 +2492,470 @@ test namespace-51.15 {namespace resolution path control} -body {
namespace delete ::test_ns_1
namespace delete ::test_ns_2
}
+test namespace-51.16 {Bug 1566526} {
+ interp create slave
+ slave eval namespace eval demo namespace path ::
+ interp delete slave
+} {}
+test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
+ set result {}
+ catch {namespace delete ::a}
+} -body {
+ namespace eval ::a {
+ proc c {} {lappend ::result A}
+ c
+ namespace eval b {
+ variable d c
+ lappend ::result [catch { $d }]
+ }
+ lappend ::result .
+ namespace eval b {
+ namespace path [namespace parent]
+ $d;[format %c 99]
+ }
+ lappend ::result .
+ namespace eval b {
+ proc c {} {lappend ::result B}
+ $d;[format %c 99]
+ }
+ lappend ::result .
+ }
+ namespace eval ::a::b {
+ $d;[format %c 99]
+ lappend ::result .
+ proc ::c {} {lappend ::result G}
+ $d;[format %c 99]
+ lappend ::result .
+ rename ::a::c {}
+ $d;[format %c 99]
+ lappend ::result .
+ rename ::a::b::c {}
+ $d;[format %c 99]
+ }
+} -cleanup {
+ namespace delete ::a
+ 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} {
+ set result [list [namespace eval foobar { namespace unknown }]]
+ lappend result [namespace eval :: { namespace unknown }]
+ namespace delete foobar
+ set result
+} {{} ::unknown}
+test namespace-52.2 {unknown: default resolution global} {
+ proc ::foo {} { return "GLOBAL" }
+ namespace eval ::bar { proc foo {} { return "NAMESPACE" } }
+ namespace eval ::bar::jim { proc test {} { foo } }
+ set result [::bar::jim::test]
+ namespace delete ::bar
+ rename ::foo {}
+ set result
+} {GLOBAL}
+test namespace-52.3 {unknown: default resolution local} {
+ proc ::foo {} { return "GLOBAL" }
+ namespace eval ::bar {
+ proc foo {} { return "NAMESPACE" }
+ proc test {} { foo }
+ }
+ set result [::bar::test]
+ namespace delete ::bar
+ rename ::foo {}
+ set result
+} {NAMESPACE}
+test namespace-52.4 {unknown: set handler} {
+ namespace eval foo {
+ namespace unknown [list dispatch]
+ proc dispatch {args} { return $args }
+ proc test {} {
+ UnknownCmd a b c
+ }
+ }
+ set result [foo::test]
+ namespace delete foo
+ set result
+} {UnknownCmd a b c}
+test namespace-52.5 {unknown: search path before unknown is unaltered} {
+ proc ::test2 {args} { return "TEST2: $args" }
+ namespace eval foo {
+ namespace unknown [list dispatch]
+ proc dispatch {args} { return "UNKNOWN: $args" }
+ proc test1 {args} { return "TEST1: $args" }
+ proc test {} {
+ set result [list [test1 a b c]]
+ lappend result [test2 a b c]
+ lappend result [test3 a b c]
+ return $result
+ }
+ }
+ set result [foo::test]
+ namespace delete foo
+ rename ::test2 {}
+ set result
+} {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}}
+test namespace-52.6 {unknown: deleting handler restores default} {
+ rename ::unknown ::_unknown_orig
+ proc ::unknown {args} { return "DEFAULT: $args" }
+ namespace eval foo {
+ namespace unknown dummy
+ namespace unknown {}
+ }
+ set result [namespace eval foo { dummy a b c }]
+ rename ::unknown {}
+ rename ::_unknown_orig ::unknown
+ namespace delete foo
+ set result
+} {DEFAULT: dummy a b c}
+test namespace-52.7 {unknown: setting global unknown handler} {
+ proc ::myunknown {args} { return "MYUNKNOWN: $args" }
+ namespace eval :: { namespace unknown ::myunknown }
+ set result [namespace eval foo { dummy a b c }]
+ namespace eval :: { namespace unknown {} }
+ rename ::myunknown {}
+ namespace delete foo
+ set result
+} {MYUNKNOWN: dummy a b c}
+test namespace-52.8 {unknown: destroying and redefining global namespace} {
+ set i [interp create]
+ $i hide proc
+ $i hide namespace
+ $i hide return
+ $i invokehidden namespace delete ::
+ $i expose return
+ $i invokehidden proc unknown args { return "FINE" }
+ $i eval { foo bar bob }
+} {FINE}
+test namespace-52.9 {unknown: refcounting} -setup {
+ proc this args {
+ unset args ;# stop sharing
+ set copy [namespace unknown]
+ string length $copy ;# shimmer away list rep
+ info level 0
+ }
+ set handler [namespace unknown]
+ namespace unknown {this is a test}
+ catch {rename noSuchCommand {}}
+} -body {
+ noSuchCommand
+} -cleanup {
+ namespace unknown $handler
+ rename this {}
+} -result {this is a test noSuchCommand}
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints {
+ testevalobjv
+} -setup {
+ rename ::unknown unknown.save
+ proc ::unknown args {
+ set caller [uplevel 1 {namespace current}]
+ namespace eval $caller {
+ variable foo
+ return $foo
+ }
+ }
+ catch {rename ::noSuchCommand {}}
+} -body {
+ namespace eval :: {
+ variable foo SUCCESS
+ }
+ namespace eval test_ns_1 {
+ variable foo FAIL
+ testevalobjv 1 noSuchCommand
+ }
+} -cleanup {
+ unset -nocomplain ::foo
+ namespace delete test_ns_1
+ rename ::unknown {}
+ rename unknown.save ::unknown
+} -result SUCCESS
+test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
+ set handler [namespace eval :: {namespace unknown}]
+ namespace eval :: {namespace unknown unknown}
+ rename ::unknown unknown.save
+ namespace eval :: {
+ proc unknown args {
+ return SUCCESS
+ }
+ }
+ catch {rename ::noSuchCommand {}}
+ set ::slave [interp create]
+} -body {
+ $::slave alias bar noSuchCommand
+ namespace eval test_ns_1 {
+ namespace unknown unknown
+ proc unknown args {
+ return FAIL
+ }
+ $::slave eval bar
+ }
+} -cleanup {
+ interp delete $::slave
+ unset ::slave
+ namespace delete test_ns_1
+ rename ::unknown {}
+ rename unknown.save ::unknown
+ namespace eval :: [list namespace unknown $handler]
+} -result SUCCESS
+test namespace-52.12 {unknown: error case must not reset handler} -body {
+ namespace eval foo {
+ namespace unknown ok
+ catch {namespace unknown {{}{}{}}}
+ namespace unknown
+ }
+} -cleanup {
+ namespace delete foo
+} -result ok
+# TIP 314 - ensembles with parameters
+test namespace-53.1 {ensembles: parameters} {
+ namespace eval ns {
+ namespace export x
+ proc x {para} {list 1 $para}
+ namespace ensemble create -parameters {para1}
+ }
+ list [info command ns] [ns bar x] [namespace delete ns] [info command ns]
+} {ns {1 bar} {} {}}
+test namespace-53.2 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x
+ proc x {para} {list 1 $para}
+ namespace ensemble create
+ }
+} -body {
+ namespace ensemble configure ns -parameters {para1}
+ rename ns foo
+ list [info command foo] [foo bar x] [namespace delete ns] [info command foo]
+} -result {foo {1 bar} {} {}}
+test namespace-53.3 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {para} {list 1 $para}
+ proc x2 {para} {list 2 $para}
+ namespace ensemble create -parameters param1
+ }
+} -body {
+ set result [list [ns x2 x1] [ns x1 x2]]
+ lappend result [catch {ns x} msg] $msg
+ lappend result [catch {ns x x} msg] $msg
+ rename ns {}
+ lappend result [info command ns::x1]
+ namespace delete ns
+ lappend result [info command ns::x1]
+} -result\
+ {{1 x2} {2 x1}\
+ 1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\
+ 1 {unknown or ambiguous subcommand "x": must be x1, or x2}\
+ ::ns::x1 {}}
+test namespace-53.4 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1 a2} {list 1 $a1 $a2}
+ proc x2 {a1 a2} {list 2 $a1 $a2}
+ proc x3 {a1 a2} {list 3 $a1 $a2}
+ namespace ensemble create
+ }
+} -body {
+ set result {}
+ lappend result [ns x1 x2 x3]
+ namespace ensemble configure ns -parameters p1
+ lappend result [ns x1 x2 x3]
+ namespace ensemble configure ns -parameters {p1 p2}
+ lappend result [ns x1 x2 x3]
+} -cleanup {
+ namespace delete ns
+} -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}}
+test namespace-53.5 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {para} {list 1 $para}
+ proc x2 {para} {list 2 $para}
+ proc x3 {para} {list 3 $para}
+ namespace ensemble create
+ }
+} -body {
+ set result [list [catch {ns x x1} msg] $msg]
+ lappend result [catch {ns x1 x} msg] $msg
+ namespace ensemble configure ns -parameters p1
+ lappend result [catch {ns x1 x} msg] $msg
+ lappend result [catch {ns x x1} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+ 0 {1 x}\
+ 1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+ 0 {1 x}}
+test namespace-53.6 {ensembles: nested} -setup {
+ namespace eval ns {
+ namespace export x*
+ namespace eval x0 {
+ proc z {args} {list 0 $args}
+ namespace export z
+ namespace ensemble create
+ }
+ proc x1 {args} {list 1 $args}
+ proc x2 {args} {list 2 $args}
+ proc x3 {args} {list 3 $args}
+ namespace ensemble create -parameters p
+ }
+} -body {
+ list [ns z x0] [ns z x1] [ns z x2] [ns z x3]
+} -cleanup {
+ namespace delete ns
+} -result {{0 {}} {1 z} {2 z} {3 z}}
+test namespace-53.7 {ensembles: parameters & wrong # args} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4}
+ namespace ensemble create -parameters p1
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns} msg] $msg
+ lappend result [catch {ns x1} msg] $msg
+ lappend result [catch {ns x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+ 1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 0 {x1 x1 x1 x1 x1}}
+test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1} {list 1 $a1}
+ proc Magic {ensemble subcmd args} {
+ namespace ensemble configure $ensemble\
+ -parameters [lrange p1 [llength [
+ namespace ensemble configure $ensemble -parameters
+ ]] 0]
+ list
+ }
+ namespace ensemble create -unknown ::ns::Magic
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 {1 x2} {}\
+ 0 {1 x2} p1\
+ 1 {unknown or ambiguous subcommand "x2": must be x1} {}}
+test namespace-53.9 {ensemble: unknown handler changing -parameters,\
+ thereby eating all args} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {args} {list 1 $args}
+ proc Magic {ensemble subcmd args} {
+ namespace ensemble configure $ensemble\
+ -parameters {p1 p2 p3 p4 p5}
+ list
+ }
+ namespace ensemble create -unknown ::ns::Magic
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 {1 x2} {}\
+ 1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\
+ 0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}}
+test namespace-53.10 {ensembles: nested rewrite} -setup {
+ namespace eval ns {
+ namespace export x
+ namespace eval x {
+ proc z0 {} {list 0}
+ proc z1 {a1} {list 1 $a1}
+ proc z2 {a1 a2} {list 2 $a1 $a2}
+ proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3}
+ namespace export z*
+ namespace ensemble create
+ }
+ namespace ensemble create -parameters p
+ }
+} -body {
+ set result {}
+ # In these cases, parsing the subensemble does not grab a new word.
+ lappend result [catch {ns z0 x} msg] $msg
+ lappend result [catch {ns z1 x} msg] $msg
+ lappend result [catch {ns z2 x} msg] $msg
+ lappend result [catch {ns z2 x v} msg] $msg
+ namespace ensemble configure ns::x -parameters q1
+ # In these cases, parsing the subensemble grabs a new word.
+ lappend result [catch {ns v x z0} msg] $msg
+ lappend result [catch {ns v x z1} msg] $msg
+ lappend result [catch {ns v x z2} msg] $msg
+ lappend result [catch {ns v x z2 v2} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 0\
+ 1 {wrong # args: should be "ns z1 x a1"}\
+ 1 {wrong # args: should be "ns z2 x a1 a2"}\
+ 1 {wrong # args: should be "ns z2 x a1 a2"}\
+ 1 {wrong # args: should be "::ns::x::z0"}\
+ 0 {1 v}\
+ 1 {wrong # args: should be "ns v x z2 a2"}\
+ 0 {2 v v2}}
+
+test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
+-setup {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex $lines 3 3
+ }
+} -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ set ns ::y$i
+ namespace eval $ns {}
+ namespace delete $ns
+ set start $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $start}]
+} -cleanup {
+ rename getbytes {}
+ unset i ns start end
+} -result 0
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
-namespace delete {expand}[namespace children :: test_ns_*]
+namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return
diff --git a/tests/notify.test b/tests/notify.test
index 0d80132..d2b9123 100755..100644
--- 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
new file mode 100644
index 0000000..b5eb032
--- /dev/null
+++ b/tests/nre.test
@@ -0,0 +1,426 @@
+# Commands covered: proc, apply, [interp alias], [namespce import]
+#
+# This file contains a collection of tests for the non-recursive executor that
+# avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the
+# actual command functionality is tested in the specific test file.
+#
+# Copyright (c) 2008 by Miguel Sofer.
+#
+# 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
+ namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testnrelevels [llength [info commands testnrelevels]]
+
+#
+# The tests that risked blowing the C stack on failure have been removed: we
+# can now actually measure using testnrelevels.
+#
+
+if {[testConstraint testnrelevels]} {
+ namespace eval testnre {
+ namespace path ::tcl::mathop
+ #
+ # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
+ # cmdFrame level, callFrame level, tosPtr and callback depth
+ #
+ variable last [testnrelevels]
+ proc depthDiff {} {
+ variable last
+ set depth [testnrelevels]
+ set res {}
+ foreach t $depth l $last {
+ lappend res [expr {$t-$l}]
+ }
+ set last $depth
+ return $res
+ }
+ proc setabs {} {
+ variable abs [- [lindex [testnrelevels] 0]]
+ }
+
+ variable body0 {
+ set x [depthDiff]
+ if {[incr i] > 10} {
+ namespace upvar [namespace qualifiers \
+ [namespace origin depthDiff]] abs abs
+ incr abs [lindex [testnrelevels] 0]
+ return [list [lrange $x 0 3] $abs]
+ }
+ }
+ proc makebody txt {
+ variable body0
+ return "$body0; $txt"
+ }
+ namespace export *
+ }
+ namespace import testnre::*
+}
+
+test nre-1.1 {self-recursive procs} -setup {
+ proc a i [makebody {a $i}]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-1.2 {self-recursive lambdas} -setup {
+ set a [list i [makebody {apply $::a $i}]]
+} -body {
+ setabs
+ apply $a 0
+} -cleanup {
+ unset a
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-1.3 {mutually recursive procs and lambdas} -setup {
+ proc a i {
+ apply $::b [incr i]
+ }
+ set b [list i [makebody {a $i}]]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+ unset b
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 2} 0}
+
+#
+# Test that aliases are non-recursive
+#
+
+test nre-2.1 {alias is not recursive} -setup {
+ proc a i [makebody {b $i}]
+ interp alias {} b {} a
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+ rename b {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 1 1} 0}
+
+#
+# Test that imports are non-recursive
+#
+
+test nre-3.1 {imports are not recursive} -setup {
+ namespace eval foo {
+ setabs
+ namespace export a
+ }
+ proc foo::a i [makebody {::a $i}]
+ namespace import foo::a
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+ namespace delete ::foo
+} -constraints {
+ testnrelevels
+} -result {{0 2 1 1} 0}
+
+test nre-4.1 {ensembles are not recursive} -setup {
+ proc a i [makebody {b foo $i}]
+ namespace ensemble create \
+ -command b \
+ -map [list foo a]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+ rename b {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 1 1} 0}
+
+test nre-5.1 {[namespace eval] is not recursive} -setup {
+ namespace eval ::foo {
+ setabs
+ }
+ proc foo::a i [makebody {namespace eval ::foo [list a $i]}]
+} -body {
+ ::foo::a 0
+} -cleanup {
+ namespace delete ::foo
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 2} 0}
+test nre-5.2 {[namespace eval] is not recursive} -setup {
+ namespace eval ::foo {
+ setabs
+ }
+ proc foo::a i [makebody {namespace eval ::foo "set x $i; a $i"}]
+} -body {
+ foo::a 0
+} -cleanup {
+ namespace delete ::foo
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 2} 0}
+
+test nre-6.1 {[uplevel] is not recursive} -setup {
+ proc a i [makebody {uplevel 1 [list a $i]}]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-6.2 {[uplevel] is not recursive} -setup {
+ setabs
+ proc a i [makebody {uplevel 1 "set x $i; a $i"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 0} 0}
+
+test nre-7.1 {[catch] is not recursive} -setup {
+ setabs
+ proc a i [makebody {uplevel 1 "catch {a $i} msg; set msg"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 3 3 0} 0}
+test nre-7.2 {[if] is not recursive} -setup {
+ setabs
+ proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.3 {[while] is not recursive} -setup {
+ setabs
+ proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.4 {[for] is not recursive} -setup {
+ setabs
+ proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.5 {[foreach] is not recursive} -setup {
+ #
+ # Enable once [foreach] is NR-enabled
+ #
+ setabs
+ proc a i [makebody {uplevel 1 "foreach j {1 2 3 4 5 6} {set res \[a $i\]; break}; set res"}]
+} -body {
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 3 3 0} 0}
+test nre-7.6 {[eval] is not recursive} -setup {
+ proc a i [makebody {eval [list a $i]}]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 1} 0}
+test nre-7.7 {[eval] is not recursive} -setup {
+ proc a i [makebody {eval "a $i"}]
+} -body {
+ setabs
+ a 0
+} -cleanup {
+ rename a {}
+} -constraints {
+ testnrelevels
+} -result {{0 2 2 1} 0}
+test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
+ proc foo args {}
+ foo
+ coroutine bar apply {{} {
+ yield
+ proc foo args {return ok}
+ while 1 {
+ yield [incr i]
+ foo
+ }
+ }}
+} -body {
+ # if switching to plain eval is not nre aware, this will cause a "cannot
+ # yield" error
+ list [bar] [bar] [bar]
+} -cleanup {
+ rename bar {}
+ rename foo {}
+} -result {1 2 3}
+
+test nre-8.1 {nre and {*}} -body {
+ # force an expansion that grows the evaluation stack, check that nre
+ # adapts the TEBCdataPtr. This crashes on failure.
+ proc inner {} {
+ set long [lrepeat 1000000 1]
+ list {*}$long
+ }
+ proc outer {} inner
+ lrange [outer] 0 2
+} -cleanup {
+ rename inner {}
+ rename outer {}
+} -result {1 1 1}
+test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
+ # force an expansion that grows the evaluation stack, check that nre
+ # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
+ # done properly.
+ proc nop {} {}
+ proc crash {} {
+ foreach val [list {*}[lrepeat 100000 x]] {
+ nop
+ }
+ }
+ crash
+} -cleanup {
+ rename nop {}
+ rename crash {}
+}
+
+#
+# Basic TclOO tests
+#
+
+test nre-oo.1 {really deep calls in oo - direct} -setup {
+ oo::object create foo
+ oo::objdefine foo method bar i [makebody {foo bar $i}]
+} -body {
+ setabs
+ foo bar 0
+} -cleanup {
+ foo destroy
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
+ oo::object create foo
+ oo::objdefine foo method bar i [makebody {[self] bar $i}]
+} -body {
+ setabs
+ foo bar 0
+} -cleanup {
+ foo destroy
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.3 {really deep calls in oo - private calls} -setup {
+ oo::object create foo
+ oo::objdefine foo method bar i [makebody {my bar $i}]
+} -body {
+ setabs
+ foo bar 0
+} -cleanup {
+ foo destroy
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.4 {really deep calls in oo - overriding} -setup {
+ oo::class create foo {
+ method bar i [makebody {my bar $i}]
+ }
+ oo::class create boo {
+ superclass foo
+ method bar i [makebody {next $i}]
+ }
+} -body {
+ setabs
+ [boo new] bar 0
+} -cleanup {
+ foo destroy
+} -constraints {
+ testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.5 {really deep calls in oo - forwards} -setup {
+ oo::object create foo
+ set body [makebody {my boo $i}]
+ oo::objdefine foo "
+ method bar i {$body}
+ forward boo ::foo bar
+ "
+} -body {
+ setabs
+ foo bar 0
+} -cleanup {
+ foo destroy
+} -constraints {
+ testnrelevels
+} -result {{0 2 1 1} 0}
+
+#
+# NASTY BUG found by tcllib's interp package
+#
+
+test nre-X.1 {eval in wrong interp} -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 {*}[filter [{*}$y]]
+ set j [interp create]
+ $j alias filter filter
+ $j eval {namespace delete {*}[filter [namespace children ::]]}
+ namespace eval foo {}
+ list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
+ }
+} -cleanup {
+ interp delete $i
+} -result {::foo ::foo {} {}}
+
+# cleanup
+::tcltest::cleanupTests
+
+if {[testConstraint testnrelevels]} {
+ namespace forget testnre::*
+ namespace delete testnre
+}
+
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/obj.test b/tests/obj.test
index e905698..151abfb 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.18 2005/07/28 18:42:32 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)}]
@@ -26,18 +27,13 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes
set r 1
foreach {t} {
{array search}
- bignum
bytearray
bytecode
cmdName
dict
- double
end-offset
- int
- nsName
regexp
string
- wideInt
} {
set first [string first $t [testobj types]]
set r [expr {$r && ($first != -1)}]
@@ -52,17 +48,19 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 12]
- lappend result [testobj convert 1 double]
+ lappend result [testobj convert 1 bytearray]
lappend result [testobj type 1]
lappend result [testobj refcount 1]
-} {{} 12 12 double 3}
+} {{} 12 12 bytearray 3}
test obj-3.1 {Tcl_ConvertToType error} testobj {
- list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
-} {12.34 1 {expected integer but got "12.34"}}
+ list [testdoubleobj set 1 12.34] \
+ [catch {testobj convert 1 end-offset} msg] \
+ $msg
+} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
- list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
-} {{} 1 {expected integer but got ""}}
+ list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
+} {{} 1 {bad index "": must be end?[+-]integer?}}
test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
set result ""
@@ -607,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x 0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
set x 0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 4294967296}
@@ -623,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x -0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
set x -0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 -4294967296}
diff --git a/tests/oo.test b/tests/oo.test
new file mode 100644
index 0000000..d63e931
--- /dev/null
+++ b/tests/oo.test
@@ -0,0 +1,3512 @@
+# 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-2013 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.1
+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-0.1 {basic test of OO's ability to clean up its initial state} {
+ interp create t
+ t eval {
+ package require TclOO
+ }
+ interp delete t
+} {}
+test oo-0.2 {basic test of OO's ability to clean up its initial state} {
+ set i [interp create]
+ 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 {
+ [oo::object new] destroy
+ }
+} -constraints memory -result 0
+test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
+ leaktest {
+ oo::class create foo
+ foo new
+ foo destroy
+ }
+} -constraints memory -result 0
+test oo-0.5 {testing literal leak on interp delete} memory {
+ leaktest {
+ interp create foo
+ foo eval {oo::object new}
+ interp delete foo
+ }
+} 0
+test oo-0.6 {cleaning the core class pair; way #1} -setup {
+ interp create t
+} -body {
+ t eval {
+ package require TclOO
+ namespace path oo
+ list [catch {class destroy} m] $m [catch {object destroy} m] $m
+ }
+} -cleanup {
+ interp delete t
+} -result {0 {} 1 {invalid command name "object"}}
+test oo-0.7 {cleaning the core class pair; way #2} -setup {
+ interp create t
+} -body {
+ t eval {
+ package require TclOO
+ namespace path oo
+ list [catch {object destroy} m] $m [catch {class destroy} m] $m
+ }
+} -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::patchlevel $::oo::patchlevel]
+
+test oo-1.1 {basic test of OO functionality: no classes} {
+ set result {}
+ lappend result [oo::object create foo]
+ lappend result [oo::objdefine foo {
+ method bar args {
+ global result
+ lappend result {*}$args
+ return [llength $args]
+ }
+ }]
+ lappend result [foo bar a b c]
+ lappend result [foo destroy] [info commands foo]
+} {::foo {} a b c 3 {} {}}
+test oo-1.2 {basic test of OO functionality: no classes} -body {
+ oo::define oo::object method missingArgs
+} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\""
+test oo-1.3 {basic test of OO functionality: no classes} {
+ catch {oo::define oo::object method missingArgs}
+ set errorInfo
+} "wrong # args: should be \"oo::define oo::object method name args body\"
+ while executing
+\"oo::define oo::object method missingArgs\""
+test oo-1.4 {basic test of OO functionality} -body {
+ oo::object create {}
+} -returnCodes 1 -result {object name must not be empty}
+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 {
+ oo::objdefine aninstance unexport destroy
+ aninstance doesnotexist
+} -cleanup {
+ rename aninstance {}
+} -returnCodes 1 -result {object "::aninstance" has no visible methods}
+test oo-1.7 {basic test of OO functionality} -setup {
+ oo::object create aninstance
+} -body {
+ oo::objdefine aninstance {
+ # Do not do this in real code! Ever! This is *not* supported!
+ ::oo::define::method ha ha ha
+ }
+} -returnCodes error -cleanup {
+ aninstance destroy
+} -result {attempt to misuse API}
+test oo-1.8 {basic test of OO functionality} -setup {
+ oo::object create obj
+ set result {}
+} -cleanup {
+ obj destroy
+} -body {
+ oo::objdefine obj method foo {} {return bar}
+ lappend result [obj foo]
+ oo::objdefine obj method foo {} {}
+ lappend result [obj foo]
+} -result {bar {}}
+test oo-1.9 {basic test of OO functionality} -setup {
+ oo::object create a
+ oo::object create b
+} -cleanup {
+ catch {a destroy}
+ b destroy
+} -body {
+ oo::objdefine a method foo {} { return A }
+ oo::objdefine b method foo {} { return B }
+ apply {{} {
+ set m foo
+ return [a $m],[a destroy],[b $m]
+ }}
+} -result A,,B
+test oo-1.10 {basic test of OO functionality} -body {
+ namespace eval foo {
+ namespace eval bar {
+ oo::object create o
+ namespace export o
+ }
+ namespace import bar::o
+ }
+ list [info object isa object foo::bar::o] [info object isa object foo::o]
+} -cleanup {
+ namespace delete foo
+} -result {1 1}
+test oo-1.11 {basic test of OO functionality: abbreviating} -setup {
+ oo::class create c
+} -cleanup {
+ c destroy
+} -body {
+ oo::define c super oo::class
+ info class super c
+} -result ::oo::class
+test oo-1.12 {basic test of OO functionality: abbreviating} -setup {
+ oo::class create c
+} -cleanup {
+ c destroy
+} -body {
+ oo::define c {super oo::class}
+ info class super c
+} -result ::oo::class
+test oo-1.13 {basic test of OO functionality: abbreviating} -setup {
+ oo::class create c
+} -cleanup {
+ c destroy
+} -body {
+ oo::define c self {forw a b}
+ info object forw c a
+} -result b
+test oo-1.14 {basic test of OO functionality: abbreviating} -setup {
+ oo::class create c
+} -cleanup {
+ c destroy
+} -body {
+ oo::define c self forw a b
+ info object forw c a
+} -result b
+test oo-1.15 {basic test of OO functionality: abbreviating} -setup {
+ oo::object create o
+} -cleanup {
+ o destroy
+} -body {
+ oo::objdefine o {forw a b}
+ info object forw o a
+} -result b
+test oo-1.16 {basic test of OO functionality: abbreviating} -setup {
+ oo::object create o
+} -cleanup {
+ o destroy
+} -body {
+ oo::objdefine o forw a b
+ info object forw o a
+} -result b
+test oo-1.17 {basic test of OO functionality: Bug 2481109} -body {
+ namespace eval ::foo {oo::object create lreplace}
+} -cleanup {
+ namespace delete ::foo
+} -result ::foo::lreplace
+# Check for Bug 2519474; problem in tclNamesp.c, but tested here...
+test oo-1.18 {OO: create object in NS with same name as global cmd} -setup {
+ proc test-oo-1.18 {} return
+ oo::class create A
+ oo::class create B {superclass A}
+} -body {
+ oo::define B constructor {} {A create test-oo-1.18}
+ B create C
+} -cleanup {
+ rename test-oo-1.18 {}
+ A destroy
+} -result ::C
+test oo-1.19 {basic test of OO functionality: teardown order} -body {
+ oo::object create o
+ namespace delete [info object namespace o]
+ o destroy
+ # Crashes on error
+} -returnCodes error -result {invalid command name "o"}
+test oo-1.20 {basic test of OO functionality: my teardown post rename} -body {
+ oo::object create obj
+ rename [info object namespace obj]::my ::AGlobalName
+ obj destroy
+ info commands ::AGlobalName
+} -result {}
+
+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
+ subinterp eval {
+ package require TclOO
+ }
+} -body {
+ subinterp eval {
+ oo::define oo::object constructor {} {
+ lappend ::result [info level 0]
+ }
+ lappend result 1
+ lappend result 2 [oo::object create foo]
+ }
+} -cleanup {
+ interp delete subinterp
+} -result {1 {oo::object create foo} 2 ::foo}
+test oo-2.2 {basic test of OO functionality: constructor} {
+ oo::class create testClass {
+ constructor {} {
+ global result
+ lappend result "[self]->construct"
+ }
+ method bar {} {
+ global result
+ lappend result "[self]->bar"
+ }
+ }
+ set result {}
+ [testClass create foo] bar
+ testClass destroy
+ return $result
+} {::foo->construct ::foo->bar}
+test oo-2.4 {OO constructor - Bug 2531577} -setup {
+ oo::class create foo
+} -body {
+ oo::define foo constructor {} return
+ [foo new] destroy
+ oo::define foo constructor {} {}
+ llength [info command [foo new]]
+} -cleanup {
+ foo destroy
+} -result 1
+test oo-2.5 {OO constructor - Bug 2531577} -setup {
+ oo::class create foo
+ set result {}
+} -body {
+ oo::define foo constructor {} {error x}
+ lappend result [catch {foo new}]
+ oo::define foo constructor {} {}
+ lappend result [llength [info command [foo new]]]
+} -cleanup {
+ foo destroy
+} -result {1 1}
+test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup {
+ oo::class create foo
+} -body {
+ oo::define foo {
+ constructor {} { tailcall my bar }
+ method bar {} { return bad }
+ }
+ namespace tail [foo create good]
+} -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
+ subinterp eval {
+ package require TclOO
+ }
+} -body {
+ subinterp eval {
+ oo::define oo::object destructor {
+ lappend ::result died
+ }
+ lappend result 1 [oo::object create foo]
+ lappend result 2 [rename foo {}]
+ oo::define oo::object destructor {}
+ return $result
+ }
+} -cleanup {
+ interp delete subinterp
+} -result {1 ::foo died 2 {}}
+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
+ subinterp eval {
+ package require TclOO
+ }
+} -body {
+ subinterp eval {
+ oo::define oo::object destructor {
+ lappend ::result died
+ }
+ lappend result 1 [oo::object create foo]
+ lappend result 2 [rename foo {}]
+ }
+} -cleanup {
+ interp delete subinterp
+} -result {1 ::foo died 2 {}}
+test oo-3.3 {basic test of OO functionality: destructor} -setup {
+ oo::class create foo
+ set result {}
+} -cleanup {
+ foo destroy
+} -body {
+ oo::define foo {
+ constructor {} {lappend ::result made}
+ destructor {lappend ::result died}
+ }
+ namespace delete [info object namespace [foo new]]
+ return $result
+} -result {made died}
+test oo-3.4 {basic test of OO functionality: my exists in destructor} -setup {
+ oo::class create cls
+ set result {}
+} -cleanup {
+ cls destroy
+} -body {
+ oo::define cls {
+ variable state
+ constructor {} {
+ proc localcmdexists {} {}
+ set state ok
+ }
+ forward Report lappend ::result
+ destructor {
+ objmy Report [catch {set state} msg] $msg
+ objmy Report [namespace which -var state]
+ objmy Report [info commands localcmdexists]
+ }
+ }
+ cls create obj
+ rename [info object namespace obj]::my ::objmy
+ obj destroy
+ lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.4a {basic test of OO functionality: my exists in destructor} -setup {
+ oo::class create cls
+ set result {}
+} -cleanup {
+ cls destroy
+} -body {
+ oo::define cls {
+ variable state
+ constructor {} {
+ proc localcmdexists {} {}
+ set state ok
+ }
+ forward Report lappend ::result
+ destructor {
+ objmy Report [catch {set state} msg] $msg
+ objmy Report [namespace which -var state]
+ objmy Report [info commands localcmdexists]
+ }
+ }
+ cls create obj
+ rename [info object namespace obj]::my ::objmy
+ rename obj {}
+ lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.5 {basic test of OO functionality: destructor: evil case for Itcl} -setup {
+ oo::class create cls
+ set result {}
+} -cleanup {
+ cls destroy
+} -body {
+ oo::define cls {
+ variable state
+ constructor {} {
+ proc localcmdexists {} {}
+ set state ok
+ }
+ forward Report lappend ::result
+ destructor {
+ objmy Report [catch {set state} msg] $msg
+ objmy Report [namespace which -var state]
+ objmy Report [info commands localcmdexists]
+ }
+ }
+ cls create obj
+ rename [info object namespace obj]::my ::objmy
+ namespace delete [info object namespace obj]
+ lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -setup {
+ oo::class create cls
+ set result {}
+} -cleanup {
+ cls destroy
+} -body {
+ oo::define cls {
+ variable state result
+ constructor {} {
+ proc localcmdexists {} {}
+ set state ok
+ my eval {upvar 0 ::result result}
+ }
+ method nuke {} {
+ namespace delete [namespace current]
+ return $result
+ }
+ destructor {
+ lappend result [self] $state [info commands localcmdexists]
+ }
+ }
+ cls create obj
+ namespace delete [info object namespace obj]
+ [cls create obj2] nuke
+} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists}
+test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {
+ oo::class create cls
+} -cleanup {
+ cls destroy
+} -body {
+ oo::define cls destructor {error foo}
+ list [catch {[cls create obj] destroy} msg] $msg [info commands obj]
+} -result {1 foo {}}
+test oo-3.7 {basic test of OO functionality: errors in destructor} -setup {
+ oo::class create cls
+ set result {}
+ proc bgerror msg {lappend ::result $msg}
+} -cleanup {
+ cls destroy
+ rename bgerror {}
+} -body {
+ oo::define cls destructor {error foo}
+ list [rename [cls create obj] {}] \
+ [update idletasks] $result [info commands obj]
+} -result {{} {} foo {}}
+test oo-3.8 {basic test of OO functionality: errors in destructor} -setup {
+ oo::class create cls
+ set result {}
+ proc bgerror msg {lappend ::result $msg}
+} -cleanup {
+ cls destroy
+ rename bgerror {}
+} -body {
+ oo::define cls destructor {error foo}
+ list [namespace delete [info object namespace [cls create obj]]] \
+ [update idletasks] $result [info commands obj]
+} -result {{} {} foo {}}
+test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup {
+ oo::class create cls
+ set result {}
+} -body {
+ oo::define cls {
+ destructor {
+ lappend ::result in destructor
+ [self] destroy
+ }
+ }
+ # This used to crash
+ [cls new] destroy
+ return $result
+} -cleanup {
+ cls destroy
+} -result {in destructor}
+
+test oo-4.1 {basic test of OO functionality: export} {
+ set o [oo::object new]
+ set result {}
+ oo::objdefine $o method Foo {} {lappend ::result Foo; return}
+ lappend result [catch {$o Foo} msg] $msg
+ oo::objdefine $o export Foo
+ lappend result [$o Foo] [$o destroy]
+} {1 {unknown method "Foo": must be destroy} Foo {} {}}
+test oo-4.2 {basic test of OO functionality: unexport} {
+ set o [oo::object new]
+ set result {}
+ oo::objdefine $o method foo {} {lappend ::result foo; return}
+ lappend result [$o foo]
+ oo::objdefine $o unexport foo
+ lappend result [catch {$o foo} msg] $msg [$o destroy]
+} {foo {} 1 {unknown method "foo": must be destroy} {}}
+test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
+ oo::class create testClass
+} -cleanup {
+ testClass destroy
+} -body {
+ oo::define testClass self export Bad
+ testClass Bad
+} -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new}
+test oo-4.4 {exporting a class method from an object} -setup {
+ oo::class create testClass
+ testClass create testObject
+} -cleanup {
+ testClass destroy
+} -body {
+ oo::define testClass method Good {} { return ok }
+ oo::objdefine testObject export Good
+ testObject Good
+} -result ok
+test oo-4.5 {export creates proper method entries} -setup {
+ oo::class create testClass
+} -body {
+ oo::define testClass {
+ export foo
+ method foo {} {return ok}
+ }
+ [testClass new] foo
+} -cleanup {
+ testClass destroy
+} -result ok
+test oo-4.6 {export creates proper method entries} -setup {
+ oo::class create testClass
+} -body {
+ oo::define testClass {
+ unexport foo
+ method foo {} {return ok}
+ }
+ [testClass new] foo
+} -cleanup {
+ testClass destroy
+} -result ok
+
+test oo-5.1 {OO: manipulation of classes as objects} -setup {
+ set obj [oo::object new]
+} -body {
+ oo::objdefine oo::object method foo {} { return "in object" }
+ catch {$obj foo} result
+ list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+ oo::objdefine oo::object deletemethod foo
+ $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.2 {OO: manipulation of classes as objects} -setup {
+ set obj [oo::object new]
+} -body {
+ oo::define oo::object self method foo {} { return "in object" }
+ catch {$obj foo} result
+ list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+ oo::objdefine oo::object deletemethod foo
+ $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.3 {OO: manipulation of classes as objects} -setup {
+ set obj [oo::object new]
+} -body {
+ oo::objdefine oo::object {
+ method foo {} { return "in object" }
+ }
+ catch {$obj foo} result
+ list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+ oo::objdefine oo::object deletemethod foo
+ $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.4 {OO: manipulation of classes as objects} -setup {
+ set obj [oo::object new]
+} -body {
+ oo::define oo::object {
+ self method foo {} { return "in object" }
+ }
+ catch {$obj foo} result
+ list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+ oo::objdefine oo::object deletemethod foo
+ $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.5 {OO: manipulation of classes as objects} -setup {
+ set obj [oo::object new]
+} -body {
+ oo::define oo::object {
+ self {
+ method foo {} { return "in object" }
+ }
+ }
+ catch {$obj foo} result
+ list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+ oo::objdefine oo::object deletemethod foo
+ $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+
+test oo-6.1 {OO: forward} {
+ oo::object create foo
+ oo::objdefine foo {
+ forward a lappend
+ forward b lappend result
+ }
+ set result {}
+ foo a result 1
+ foo b 2
+ foo destroy
+ return $result
+} {1 2}
+test oo-6.2 {OO: forward resolution scope} -setup {
+ oo::class create fooClass
+} -body {
+ proc foo {} {return bad}
+ oo::define fooClass {
+ constructor {} {
+ proc foo {} {return good}
+ }
+ forward bar foo
+ }
+ [fooClass new] bar
+} -cleanup {
+ fooClass destroy
+ rename foo {}
+} -result good
+test oo-6.3 {OO: forward resolution scope} -setup {
+ oo::class create fooClass
+} -body {
+ proc foo {} {return bad}
+ oo::define fooClass {
+ constructor {} {
+ proc foo {} {return good}
+ }
+ }
+ oo::define fooClass forward bar foo
+ [fooClass new] bar
+} -cleanup {
+ fooClass destroy
+ rename foo {}
+} -result good
+test oo-6.4 {OO: forward resolution scope} -setup {
+ oo::class create fooClass
+} -body {
+ proc foo {} {return good}
+ oo::define fooClass {
+ constructor {} {
+ proc foo {} {return bad}
+ }
+ forward bar ::foo
+ }
+ [fooClass new] bar
+} -cleanup {
+ fooClass destroy
+ rename foo {}
+} -result good
+test oo-6.5 {OO: forward resolution scope} -setup {
+ oo::class create fooClass
+ namespace eval foo {}
+} -body {
+ proc foo::foo {} {return good}
+ oo::define fooClass {
+ constructor {} {
+ proc foo {} {return bad}
+ }
+ forward bar foo::foo
+ }
+ [fooClass new] bar
+} -cleanup {
+ fooClass destroy
+ namespace delete foo
+} -result good
+test oo-6.6 {OO: forward resolution scope} -setup {
+ oo::class create fooClass
+ namespace eval foo {}
+} -body {
+ proc foo::foo {} {return bad}
+ oo::define fooClass {
+ constructor {} {
+ namespace eval foo {
+ proc foo {} {return good}
+ }
+ }
+ forward bar foo::foo
+ }
+ [fooClass new] bar
+} -cleanup {
+ fooClass destroy
+ namespace delete foo
+} -result good
+test oo-6.7 {OO: forward resolution scope is per-object} -setup {
+ oo::class create fooClass
+} -body {
+ oo::define fooClass {
+ constructor {} {
+ proc curns {} {namespace current}
+ }
+ forward ns curns
+ }
+ expr {[[fooClass new] ns] ne [[fooClass new] ns]}
+} -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-6.19 {Bug 3610404: forwarding resolution + traces} -setup {
+ oo::object create foo
+ unset -nocomplain ::result
+ set ::result {}
+} -body {
+ proc ::my {method} {lappend ::result global}
+ oo::objdefine foo {
+ method target {} {lappend ::result instance}
+ forward bar my target
+ method bump {} {
+ set ns [info object namespace ::foo]
+ rename ${ns}::my ${ns}::
+ rename ${ns}:: ${ns}::my
+ }
+ }
+ proc harness {} {
+ foo target
+ foo bar
+ foo target
+ }
+ trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+ foo target
+ foo bar
+ foo bump
+ foo bar
+ harness
+} -cleanup {
+ catch {rename harness {}}
+ catch {rename ::my {}}
+ foo destroy
+} -result {instance instance instance instance instance instance}
+test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup {
+ oo::class create fooClass
+ fooClass create foo
+ unset -nocomplain ::result
+ set ::result {}
+} -body {
+ proc ::my {method} {lappend ::result global}
+ oo::define fooClass {
+ method target {} {lappend ::result class}
+ forward bar my target
+ method bump {} {
+ set ns [info object namespace [self]]
+ rename ${ns}::my ${ns}::
+ rename ${ns}:: ${ns}::my
+ }
+ }
+ proc harness {} {
+ foo target
+ foo bar
+ foo target
+ }
+ trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+ foo target
+ foo bar
+ foo bump
+ foo bar
+ harness
+} -cleanup {
+ catch {rename harness {}}
+ catch {rename ::my {}}
+ fooClass destroy
+} -result {class class class class class class}
+
+test oo-7.1 {OO: inheritance 101} -setup {
+ oo::class create superClass
+ oo::class create subClass
+ subClass create instance
+} -body {
+ oo::define superClass method doit x {lappend ::result $x}
+ oo::define subClass superclass superClass
+ set result [list [catch {subClass doit bad} msg] $msg]
+ instance doit ok
+ return $result
+} -cleanup {
+ subClass destroy
+ superClass destroy
+} -result {1 {unknown method "doit": must be create, destroy or new} ok}
+test oo-7.2 {OO: inheritance 101} -setup {
+ oo::class create superClass
+ oo::class create subClass
+ subClass create instance
+} -body {
+ oo::define superClass method doit x {
+ lappend ::result |$x|
+ }
+ oo::define subClass superclass superClass
+ oo::objdefine instance method doit x {
+ lappend ::result =$x=
+ next [incr x]
+ }
+ set result {}
+ instance doit 1
+ return $result
+} -cleanup {
+ subClass destroy
+ superClass destroy
+} -result {=1= |2|}
+test oo-7.3 {OO: inheritance 101} -setup {
+ oo::class create superClass
+ oo::class create subClass
+ subClass create instance
+} -body {
+ oo::define superClass method doit x {
+ lappend ::result |$x|
+ }
+ oo::define subClass {
+ superclass superClass
+ method doit x {lappend ::result -$x-; next [incr x]}
+ }
+ oo::objdefine instance method doit x {
+ lappend ::result =$x=;
+ next [incr x]
+ }
+ set result {}
+ instance doit 1
+ return $result
+} -cleanup {
+ subClass destroy
+ superClass destroy
+} -result {=1= -2- |3|}
+test oo-7.4 {OO: inheritance from oo::class} -body {
+ oo::class create meta {
+ superclass oo::class
+ self {
+ unexport create new
+ method make {x {definitions {}}} {
+ if {![string match ::* $x]} {
+ set ns [uplevel 1 {::namespace current}]
+ set x ${ns}::$x
+ }
+ set o [my create $x]
+ lappend ::result "made $o"
+ oo::define $o $definitions
+ return $o
+ }
+ }
+ }
+ set result [list [catch {meta create foo} msg] $msg]
+ lappend result [meta make classinstance {
+ lappend ::result "in definition script in [namespace current]"
+ }]
+ lappend result [classinstance create instance]
+} -cleanup {
+ catch {classinstance destroy}
+ catch {meta destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
+ oo::class create other
+ oo::class create meta {
+ superclass other oo::class
+ self {
+ unexport create new
+ method make {x {definitions {}}} {
+ if {![string match ::* $x]} {
+ set ns [uplevel 1 {::namespace current}]
+ set x ${ns}::$x
+ }
+ set o [my create $x]
+ lappend ::result "made $o"
+ oo::define $o $definitions
+ return $o
+ }
+ }
+ }
+ set result [list [catch {meta create foo} msg] $msg]
+ lappend result [meta make classinstance {
+ lappend ::result "in definition script in [namespace current]"
+ }]
+ lappend result [classinstance create instance]
+} -cleanup {
+ catch {classinstance destroy}
+ catch {meta destroy}
+ catch {other destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
+ oo::class create Aclass
+ oo::class create Bclass
+ Bclass create Binstance
+} -body {
+ oo::define Aclass {
+ method incr {var step} {
+ upvar 1 $var v
+ ::incr v $step
+ }
+ }
+ oo::define Bclass {
+ superclass Aclass
+ method incr {var {step 1}} {
+ global result
+ lappend result $var $step
+ set r [next $var $step]
+ lappend result returning:$r
+ return $r
+ }
+ }
+ set result {}
+ set x 10
+ lappend result x=$x
+ lappend result [Binstance incr x]
+ lappend result x=$x
+} -result {x=10 x 1 returning:11 11 x=11} -cleanup {
+ unset -nocomplain x
+ Aclass destroy
+}
+test oo-7.7 {OO: inheritance and errorInfo} -setup {
+ oo::class create A
+ oo::class create B
+ B create c
+} -body {
+ oo::define A method foo {} {error foo!}
+ oo::define B {
+ superclass A
+ method foo {} { next }
+ }
+ oo::objdefine c method foo {} { next }
+ catch {c ?} msg
+ set result [list $msg]
+ catch {c foo} msg
+ lappend result $msg $errorInfo
+} -cleanup {
+ A destroy
+} -result {{unknown method "?": must be destroy or foo} foo! {foo!
+ while executing
+"error foo!"
+ (class "::A" method "foo" line 1)
+ invoked from within
+"next "
+ (class "::B" method "foo" line 1)
+ invoked from within
+"next "
+ (object "::c" method "foo" line 1)
+ invoked from within
+"c foo"}}
+test oo-7.8 {OO: next at the end of the method chain} -setup {
+ set ::result ""
+} -cleanup {
+ foo destroy
+} -body {
+ oo::class create foo {
+ method bar {} {lappend ::result foo; lappend ::result [next] foo}
+ }
+ oo::class create foo2 {
+ superclass foo
+ method bar {} {lappend ::result foo2; lappend ::result [next] foo2}
+ }
+ lappend result [catch {[foo2 new] bar} msg] $msg
+} -result {foo2 foo 1 {no next method implementation}}
+test oo-7.9 {OO: defining inheritance in namespaces} -setup {
+ set ::result {}
+ oo::class create ::master
+ namespace eval ::foo {
+ oo::class create mixin {superclass ::master}
+ }
+} -cleanup {
+ ::master destroy
+ namespace delete ::foo
+} -body {
+ namespace eval ::foo {
+ oo::class create bar {superclass master}
+ oo::class create boo
+ oo::define boo {superclass bar}
+ oo::define boo {mixin mixin}
+ oo::class create spong {superclass boo}
+ return
+ }
+} -result {}
+
+test oo-8.1 {OO: global must work in methods} {
+ oo::object create foo
+ oo::objdefine foo method bar x {global result; lappend result $x}
+ set result {}
+ foo bar this
+ foo bar is
+ lappend result a
+ foo bar test
+ foo destroy
+ return $result
+} {this is a test}
+
+test oo-9.1 {OO: multiple inheritance} -setup {
+ oo::class create A
+ oo::class create B
+ oo::class create C
+ oo::class create D
+ D create foo
+} -body {
+ oo::define A method test {} {lappend ::result A; return ok}
+ oo::define B {
+ superclass A
+ method test {} {lappend ::result B; next}
+ }
+ oo::define C {
+ superclass A
+ method test {} {lappend ::result C; next}
+ }
+ oo::define D {
+ superclass B C
+ method test {} {lappend ::result D; next}
+ }
+ set result {}
+ lappend result [foo test]
+} -cleanup {
+ D destroy
+ C destroy
+ B destroy
+ A destroy
+} -result {D B C A ok}
+test oo-9.2 {OO: multiple inheritance} -setup {
+ oo::class create A
+ oo::class create B
+ oo::class create C
+ oo::class create D
+ D create foo
+} -body {
+ oo::define A method test {} {lappend ::result A; return ok}
+ oo::define B {
+ superclass A
+ method test {} {lappend ::result B; next}
+ }
+ oo::define C {
+ superclass A
+ method test {} {lappend ::result C; next}
+ }
+ oo::define D {
+ superclass B C
+ method test {} {lappend ::result D; next}
+ }
+ set result {}
+ lappend result [foo test]
+} -cleanup {
+ A destroy
+} -result {D B C A ok}
+
+test oo-10.1 {OO: recursive invoke and modify} -setup {
+ [oo::class create C] create O
+} -cleanup {
+ C destroy
+} -body {
+ oo::define C method foo x {
+ lappend ::result $x
+ if {$x} {
+ [self object] foo [incr x -1]
+ }
+ }
+ oo::objdefine O method foo x {
+ lappend ::result -$x-
+ if {$x == 1} {
+ oo::objdefine O deletemethod foo
+ }
+ next $x
+ }
+ set result {}
+ O foo 2
+ return $result
+} -result {-2- 2 -1- 1 0}
+test oo-10.2 {OO: recursive invoke and modify} -setup {
+ oo::object create O
+} -cleanup {
+ O destroy
+} -body {
+ oo::objdefine O method foo {} {
+ oo::objdefine [self] method foo {} {
+ error "not called"
+ }
+ return [format %s%s call ed]
+ }
+ O foo
+} -result called
+test oo-10.3 {OO: invoke and modify} -setup {
+ oo::class create A {
+ method a {} {return A.a}
+ method b {} {return A.b}
+ method c {} {return A.c}
+ }
+ oo::class create B {
+ superclass A
+ method a {} {return [next],B.a}
+ method b {} {return [next],B.b}
+ method c {} {return [next],B.c}
+ }
+ B create C
+ set result {}
+} -cleanup {
+ A destroy
+} -body {
+ lappend result [C a] [C b] [C c] -
+ oo::define B deletemethod b
+ lappend result [C a] [C b] [C c] -
+ oo::define B renamemethod a b
+ lappend result [C a] [C b] [C c] -
+ oo::define B deletemethod b c
+ lappend result [C a] [C b] [C c]
+} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
+
+test oo-11.1 {OO: cleanup} {
+ oo::object create foo
+ set result [list [catch {oo::object create foo} msg] $msg]
+ lappend result [foo destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.2 {OO: cleanup} {
+ oo::class create bar
+ bar create foo
+ set result [list [catch {bar create foo} msg] $msg]
+ lappend result [bar destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.3 {OO: cleanup} {
+ oo::class create bar0
+ oo::class create bar
+ oo::define bar superclass bar0
+ bar create foo
+ set result [list [catch {bar create foo} msg] $msg]
+ lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.4 {OO: cleanup} {
+ oo::class create bar0
+ oo::class create bar1
+ oo::define bar1 superclass bar0
+ oo::class create bar2
+ oo::define bar2 {
+ superclass bar0
+ destructor {lappend ::result destroyed}
+ }
+ oo::class create bar
+ oo::define bar superclass bar1 bar2
+ bar create foo
+ set result [list [catch {bar create foo} msg] $msg]
+ lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
+ [oo::object create bar2] [bar2 destroy]
+} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+
+test oo-12.1 {OO: filters} {
+ oo::class create Aclass
+ Aclass create Aobject
+ oo::define Aclass {
+ method concatenate args {
+ global result
+ lappend result {*}$args
+ join $args {}
+ }
+ method logFilter args {
+ global result
+ lappend result "calling [self object]->[self method] $args"
+ set r [next {*}$args]
+ lappend result "result=$r"
+ return $r
+ }
+ }
+ oo::objdefine Aobject filter logFilter
+ set result {}
+ lappend result [Aobject concatenate 1 2 3 4 5]
+ Aclass destroy
+ return $result
+} {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
+test oo-12.2 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method concatenate args {
+ global result
+ lappend result {*}$args
+ join $args {}
+ }
+ method logFilter args {
+ global result
+ lappend result "calling [self object]->[self method] $args"
+ set r [next {*}$args]
+ lappend result "result=$r"
+ return $r
+ }
+ }
+ oo::objdefine Aobject filter logFilter
+ set result {}
+ lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+ Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.3 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method concatenate args {
+ global result
+ lappend result {*}$args
+ join $args {}
+ }
+ method logFilter args {
+ global result
+ lappend result "calling [self object]->[self method] $args"
+ set r [next {*}$args]
+ lappend result "result=$r"
+ return $r
+ }
+ filter logFilter
+ }
+ set result {}
+ lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+ Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.4 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method foo {} { return foo }
+ method Bar {} { return 1 }
+ method boo {} { if {[my Bar]} { next } { error forbidden } }
+ filter boo
+ }
+ Aobject foo
+} -cleanup {
+ Aclass destroy
+} -result foo
+test oo-12.5 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method foo {} { return foo }
+ method Bar {} { return [my Bar2] }
+ method Bar2 {} { return 1 }
+ method boo {} { if {[my Bar]} { next } { error forbidden } }
+ filter boo
+ }
+ Aobject foo
+} -cleanup {
+ Aclass destroy
+} -result foo
+test oo-12.6 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method foo {} { return foo }
+ method Bar {} { return [my Bar2] }
+ method Bar2 {} { return [my Bar3] }
+ method Bar3 {} { return 1 }
+ method boo {} { if {[my Bar]} { next } { error forbidden } }
+ filter boo
+ }
+ Aobject foo
+} -cleanup {
+ Aclass destroy
+} -result foo
+test oo-12.7 {OO: filters} -setup {
+ oo::class create Aclass
+ Aclass create Aobject
+} -body {
+ oo::define Aclass {
+ method outerfoo {} { return [my InnerFoo] }
+ method InnerFoo {} { return foo }
+ method Bar {} { return [my Bar2] }
+ method Bar2 {} { return [my Bar3] }
+ method Bar3 {} { return 1 }
+ method boo {} {
+ lappend ::log [self target]
+ if {[my Bar]} { next } else { error forbidden }
+ }
+ filter boo
+ }
+ set log {}
+ list [Aobject outerfoo] $log
+} -cleanup {
+ Aclass destroy
+} -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
+
+test oo-13.1 {OO: changing an object's class} {
+ oo::class create Aclass
+ oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}}
+ oo::class create Bclass
+ oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}}
+ set result [Aclass create foo]
+ foo bar
+ oo::objdefine foo class Bclass
+ foo bar
+ Aclass destroy
+ lappend result [info command foo]
+ Bclass destroy
+ return $result
+} {::foo {in A ::foo} {in B ::foo} foo}
+test oo-13.2 {OO: changing an object's class} -body {
+ oo::object create foo
+ oo::objdefine foo class oo::class
+} -cleanup {
+ foo destroy
+} -returnCodes 1 -result {may not change a non-class object into a class object}
+test oo-13.3 {OO: changing an object's class} -body {
+ oo::class create foo
+ oo::objdefine foo class oo::object
+} -cleanup {
+ foo destroy
+} -returnCodes 1 -result {may not change a class object into a non-class object}
+test oo-13.4 {OO: changing an object's class} -body {
+ oo::class create foo {
+ method m {} {
+ set result [list [self class] [info object class [self]]]
+ oo::objdefine [self] class ::bar
+ lappend result [self class] [info object class [self]]
+ }
+ }
+ oo::class create bar
+ [foo new] m
+} -cleanup {
+ foo destroy
+ bar destroy
+} -result {::foo ::foo ::foo ::bar}
+# todo: changing a class subtype (metaclass) to another class subtype
+
+test oo-14.1 {OO: mixins} {
+ oo::class create Aclass
+ oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
+ oo::class create Bclass
+ oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
+ oo::objdefine [Aclass create fooTest] mixin Bclass
+ oo::objdefine [Aclass create fooTest2] mixin Bclass
+ set result [list [catch {fooTest ?} msg] $msg]
+ fooTest bar
+ fooTest boo
+ fooTest2 bar
+ fooTest2 boo
+ oo::objdefine fooTest2 mixin
+ lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
+} {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
+test oo-14.2 {OO: mixins} {
+ oo::class create Aclass {
+ method bar {} {return "[self object] in bar"}
+ }
+ oo::class create Bclass {
+ method boo {} {return "[self object] in boo"}
+ }
+ oo::define Aclass mixin Bclass
+ Aclass create fooTest
+ set result [list [catch {fooTest ?} msg] $msg]
+ lappend result [catch {fooTest bar} msg] $msg
+ lappend result [catch {fooTest boo} msg] $msg
+ lappend result [Bclass destroy] [info commands Aclass]
+} {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
+test oo-14.3 {OO and mixins and filters - advanced case} -setup {
+ oo::class create mix
+ oo::class create c {
+ mixin mix
+ }
+ c create i
+} -body {
+ oo::define mix {
+ method foo {} {return >>[next]<<}
+ filter foo
+ }
+ oo::objdefine i method bar {} {return foobar}
+ i bar
+} -cleanup {
+ mix destroy
+ if {[info object isa object i]} {
+ error "mixin deletion failed to destroy dependent instance"
+ }
+} -result >>foobar<<
+test oo-14.4 {OO: mixin error case} -setup {
+ oo::class create c
+} -body {
+ oo::define c mixin c
+} -returnCodes error -cleanup {
+ c destroy
+} -result {may not mix a class into itself}
+test oo-14.5 {OO and mixins and filters - advanced case} -setup {
+ oo::class create mix
+ oo::class create c {
+ mixin mix
+ }
+ c create i
+} -body {
+ oo::define mix {
+ method foo {} {return >>[next]<<}
+ filter foo
+ }
+ oo::objdefine i method bar {} {return foobar}
+ i bar
+} -cleanup {
+ c destroy
+ mix destroy
+} -result >>foobar<<
+test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create A {
+ superclass master
+ method egg {} {
+ return chicken
+ }
+ }
+ oo::class create B {
+ superclass master
+ mixin A
+ method bar {} {
+ # mixin from A
+ my egg
+ }
+ }
+ oo::class create C {
+ superclass master
+ mixin B
+ method foo {} {
+ # mixin from B
+ my bar
+ }
+ }
+ [C new] foo
+} -result chicken
+test oo-14.7 {OO and filters from mixins of mixins} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create A {
+ superclass master
+ method egg {} {
+ return chicken
+ }
+ filter f
+ method f args {
+ set m [lindex [self target] 1]
+ return "($m) [next {*}$args] ($m)"
+ }
+ }
+ oo::class create B {
+ superclass master
+ mixin A
+ filter f
+ method bar {} {
+ # mixin from A
+ my egg
+ }
+ }
+ oo::class create C {
+ superclass master
+ mixin B
+ filter f
+ method foo {} {
+ # mixin from B
+ my bar
+ }
+ }
+ [C new] foo
+} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
+test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
+ set ::result {}
+ oo::class create master {
+ method test {} {}
+ }
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create mix {
+ superclass master
+ method test {} {lappend ::result mix; next; return $::result}
+ }
+ oo::class create cls {
+ superclass master
+ mixin mix
+ method test {} {lappend ::result cls; next; return $::result}
+ }
+ [cls new] test
+} -result {mix cls}
+
+test oo-15.1 {OO: object cloning} {
+ oo::class create Aclass
+ oo::define Aclass method test {} {lappend ::result [self object]->test}
+ Aclass create Ainstance
+ set result {}
+ Ainstance test
+ oo::copy Ainstance Binstance
+ Binstance test
+ Ainstance test
+ Ainstance destroy
+ namespace eval foo {
+ oo::copy Binstance Cinstance
+ Cinstance test
+ }
+ Aclass destroy
+ namespace delete foo
+ lappend result [info commands Binstance]
+} {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}}
+test oo-15.2 {OO: object cloning} {
+ oo::object create foo
+ oo::objdefine foo {
+ method m x {lappend ::result [self object] >$x<}
+ forward f ::lappend ::result fwd
+ }
+ set result {}
+ foo m 1
+ foo f 2
+ lappend result [oo::copy foo bar]
+ foo m 3
+ foo f 4
+ bar m 5
+ bar f 6
+ lappend result [foo destroy]
+ bar m 7
+ bar f 8
+ lappend result [bar destroy]
+} {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}}
+catch {foo destroy}
+catch {bar destroy}
+test oo-15.3 {OO: class cloning} {
+ oo::class create foo {
+ method testme {} {lappend ::result [self class]->[self object]}
+ }
+ set result {}
+ foo create baseline
+ baseline testme
+ oo::copy foo bar
+ baseline testme
+ bar create tester
+ tester testme
+ foo destroy
+ tester testme
+ 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-15.10 {variable binding must not bleed through oo::copy} -setup {
+ oo::class create FooClass
+ set result {}
+} -body {
+ set obj1 [FooClass new]
+ oo::objdefine $obj1 {
+ variable var
+ method m {} {
+ set var foo
+ }
+ method get {} {
+ return $var
+ }
+ export eval
+ }
+
+ $obj1 m
+ lappend result [$obj1 get]
+ set obj2 [oo::copy $obj1]
+ $obj2 eval {
+ set var bar
+ }
+ lappend result [$obj2 get]
+ $obj1 eval {
+ set var grill
+ }
+ lappend result [$obj1 get] [$obj2 get]
+} -cleanup {
+ FooClass destroy
+} -result {foo bar grill bar}
+
+test oo-16.1 {OO: object introspection} -body {
+ info object
+} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
+test oo-16.2 {OO: object introspection} -body {
+ info object class NOTANOBJECT
+} -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 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
+} -body {
+ list [list [info object class oo::object] \
+ [info object class oo::class] \
+ [info object class meta] \
+ [info object class instance1] \
+ [info object class instance2]] \
+ [list [info object isa class oo::object] \
+ [info object isa class meta] \
+ [info object isa class instance1] \
+ [info object isa class instance2]] \
+ [list [info object isa metaclass oo::object] \
+ [info object isa metaclass oo::class] \
+ [info object isa metaclass meta] \
+ [info object isa metaclass instance1] \
+ [info object isa metaclass instance2]] \
+ [list [info object isa object oo::object] \
+ [info object isa object oo::class] \
+ [info object isa object meta] \
+ [info object isa object instance1] \
+ [info object isa object instance2] \
+ [info object isa object oo::define] \
+ [info object isa object NOTANOBJECT]]
+} -cleanup {
+ meta destroy
+} -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}}
+test oo-16.5 {OO: object introspection} {info object methods oo::object} {}
+test oo-16.6 {OO: object introspection} {
+ oo::object create foo
+ set result [list [info object methods foo]]
+ oo::objdefine foo method bar {} {...}
+ lappend result [info object methods foo] [foo destroy]
+} {{} bar {}}
+test oo-16.7 {OO: object introspection} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo method bar {a {b c} args} {the body}
+ set result [info object methods foo]
+ lappend result [info object methodtype foo bar] \
+ [info object definition foo bar]
+} -cleanup {
+ foo destroy
+} -result {bar method {{a {b c} args} {the body}}}
+test oo-16.8 {OO: object introspection} {
+ oo::object create foo
+ oo::class create bar
+ oo::objdefine foo mixin bar
+ set result [list [info object mixins foo] \
+ [info object isa mixin foo bar] \
+ [info object isa mixin foo oo::class]]
+ foo destroy
+ bar destroy
+ return $result
+} {::bar 1 0}
+test oo-16.9 {OO: object introspection} -body {
+ oo::class create Ac
+ oo::class create Bc; oo::define Bc superclass Ac
+ oo::class create Cc; oo::define Cc superclass Bc
+ oo::class create Dc; oo::define Dc mixin Cc
+ Cc create E
+ Dc create F
+ list [info object isa typeof E oo::class] \
+ [info object isa typeof E Ac] \
+ [info object isa typeof F Bc] \
+ [info object isa typeof F Cc]
+} -cleanup {
+ catch {Ac destroy}
+} -result {0 1 1 1}
+test oo-16.10 {OO: object introspection} -setup {
+ oo::object create foo
+} -body {
+ oo::objdefine foo export eval
+ foo eval {variable c 3 a 1 b 2 ddd 4 e}
+ lsort [info object vars foo ?]
+} -cleanup {
+ foo destroy
+} -result {a b c}
+test oo-16.11 {OO: object introspection} -setup {
+ oo::class create foo
+ foo create bar
+} -body {
+ oo::define foo method spong {} {...}
+ oo::objdefine bar method boo {a {b c} args} {the body}
+ list [lsort [info object methods bar -all]] [lsort [info object methods bar -all -private]]
+} -cleanup {
+ foo destroy
+} -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 {
+ rename foo {}
+} -body {
+ oo::objdefine foo unexport {*}[info object methods foo -all]
+ info object methods foo -all
+} -result {}
+test oo-16.13 {OO: object introspection} -setup {
+ oo::object create foo
+} -cleanup {
+ rename foo {}
+} -body {
+ oo::objdefine foo method Bar {} {return "ok in foo"}
+ [info object namespace foo]::my Bar
+} -result "ok in foo"
+
+test oo-17.1 {OO: class introspection} -body {
+ info class
+} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
+test oo-17.2 {OO: class introspection} -body {
+ info class superclass NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-17.3 {OO: class introspection} -setup {
+ oo::object create foo
+} -body {
+ info class superclass foo
+} -returnCodes 1 -cleanup {
+ foo destroy
+} -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 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 {
+ testClass create foo
+ testClass create bar
+ testClass create spong
+ lsort [info class instances testClass]
+} -cleanup {
+ testClass destroy
+} -result {::bar ::foo ::spong}
+test oo-17.6 {OO: class introspection} -setup {
+ oo::class create foo
+} -body {
+ oo::define foo method bar {a {b c} args} {the body}
+ set result [info class methods foo]
+ lappend result [info class methodtype foo bar] \
+ [info class definition foo bar]
+} -cleanup {
+ foo destroy
+} -result {bar method {{a {b c} args} {the body}}}
+test oo-17.7 {OO: class introspection} {
+ info class superclasses oo::class
+} ::oo::object
+test oo-17.8 {OO: class introspection} -setup {
+ oo::class create testClass
+ oo::class create superClass1
+ oo::class create superClass2
+} -body {
+ oo::define testClass superclass superClass1 superClass2
+ list [info class superclasses testClass] \
+ [lsort [info class subclass oo::object ::superClass?]]
+} -cleanup {
+ testClass destroy
+ superClass1 destroy
+ superClass2 destroy
+} -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}}
+test oo-17.9 {OO: class introspection} -setup {
+ oo::class create foo
+ oo::class create subfoo {superclass foo}
+} -body {
+ oo::define foo {
+ method bar {a {b c} args} {the body}
+ self {
+ method bad {} {...}
+ }
+ }
+ oo::define subfoo method boo {a {b c} args} {the body}
+ list [lsort [info class methods subfoo -all]] \
+ [lsort [info class methods subfoo -all -private]]
+} -cleanup {
+ foo destroy
+} -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 {
+ rename foo {}
+} -body {
+ oo::define foo unexport {*}[info class methods foo -all]
+ info class methods foo -all
+} -result {}
+
+test oo-18.1 {OO: define command support} {
+ list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
+} {1 foo {foo
+ while executing
+"error foo"
+ (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} {
+ list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
+} {1 foo {foo
+ while executing
+"oo::define oo::object error foo"}}
+test oo-18.3 {OO: define command support} {
+ list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
+} {1 bar {bar
+ while executing
+"error bar"
+ (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} {
+ list [catch {oo::class create foo {
+ error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+ while executing
+"error bar"
+ (in definition script for class "::foo" line 2)
+ invoked from within
+"oo::class create foo {
+ error bar
+}"}}
+test oo-18.3b {OO: define command support} {
+ list [catch {oo::class create foo {
+ eval eval error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+ while executing
+"error bar"
+ ("eval" body line 1)
+ invoked from within
+"eval error bar"
+ ("eval" body line 1)
+ invoked from within
+"eval eval error bar"
+ (in definition script for class "::foo" line 2)
+ invoked from within
+"oo::class create foo {
+ eval eval error bar
+}"}}
+test oo-18.4 {OO: more error traces from the guts} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj method bar {} {my eval {error foo}}
+ list [catch {obj bar} msg] $msg $errorInfo
+} -cleanup {
+ obj destroy
+} -result {1 foo {foo
+ while executing
+"error foo"
+ (in "my eval" script line 1)
+ invoked from within
+"my eval {error foo}"
+ (object "::obj" method "bar" line 1)
+ invoked from within
+"obj bar"}}
+test oo-18.5 {OO: more error traces from the guts} -setup {
+ [oo::class create cls] create obj
+ set errorInfo {}
+} -body {
+ oo::define cls {
+ method eval script {next $script}
+ export eval
+ }
+ oo::objdefine obj method bar {} {my eval {error foo}}
+ set result {}
+ lappend result [catch {obj bar} msg] $msg $errorInfo
+ lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo
+} -cleanup {
+ cls destroy
+} -result {1 foo {foo
+ while executing
+"error foo"
+ (in "my eval" script line 1)
+ invoked from within
+"next $script"
+ (class "::cls" method "eval" line 1)
+ invoked from within
+"my eval {error foo}"
+ (object "::obj" method "bar" line 1)
+ invoked from within
+"obj bar"} 1 bar {bar
+ while executing
+"error bar"
+ (in "::obj eval" script line 1)
+ invoked from within
+"next $script"
+ (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
+ oo::objdefine inst export eval
+ set result {}
+ inst eval { variable x }
+} -body {
+ inst eval {trace add variable x write foo}
+ set ns [inst eval namespace current]
+ proc foo args {
+ global ns result
+ set context [uplevel 1 namespace current]
+ lappend result $args [expr {
+ $ns eq $context ? "ok" : [list $ns ne $context]
+ }] [expr {
+ "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]]
+ }]
+ }
+ lappend result [inst eval set x 0]
+} -cleanup {
+ inst destroy
+ rename foo {}
+} -result {{x {} write} ok ok 0}
+test oo-19.2 {OO: varname method: Bug 2883857} -setup {
+ oo::class create SpecialClass
+ oo::objdefine SpecialClass export createWithNamespace
+ SpecialClass createWithNamespace inst ::oo_test
+ oo::objdefine inst export varname eval
+} -body {
+ inst eval { variable x; array set x {y z} }
+ inst varname x(y)
+} -cleanup {
+ SpecialClass destroy
+} -result ::oo_test::x(y)
+test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup {
+ oo::class create testClass {
+ variable foo
+ export varname
+ constructor {} {
+ variable foo x
+ }
+ method bar {obj} {
+ my varname foo
+ $obj varname foo
+ }
+ }
+} -body {
+ testClass create A
+ testClass create B
+ lsearch [list [A varname foo] [B varname foo]] [B bar A]
+} -cleanup {
+ testClass destroy
+} -result 0
+
+test oo-20.1 {OO: variable method} -body {
+ oo::class create testClass {
+ constructor {} {
+ my variable ok
+ set ok {}
+ }
+ }
+ lsort [info object vars [testClass new]]
+} -cleanup {
+ catch {testClass destroy}
+} -result ok
+test oo-20.2 {OO: variable method} -body {
+ oo::class create testClass {
+ constructor {} {
+ my variable a b c
+ set a [set b [set c {}]]
+ }
+ }
+ lsort [info object vars [testClass new]]
+} -cleanup {
+ catch {testClass destroy}
+} -result {a b c}
+test oo-20.3 {OO: variable method} -body {
+ oo::class create testClass {
+ export varname
+ method bar {} {
+ my variable a(b)
+ }
+ }
+ testClass create foo
+ array set [foo varname a] {b c}
+ foo bar
+} -returnCodes 1 -cleanup {
+ catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.4 {OO: variable method} -body {
+ oo::class create testClass {
+ export varname
+ method bar {} {
+ my variable a(b)
+ }
+ }
+ testClass create foo
+ set [foo varname a] b
+ foo bar
+} -returnCodes 1 -cleanup {
+ catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.5 {OO: variable method} -body {
+ oo::class create testClass {
+ method bar {} {
+ my variable a::b
+ }
+ }
+ testClass create foo
+ foo bar
+} -returnCodes 1 -cleanup {
+ catch {testClass destroy}
+} -result {variable name "a::b" illegal: must not contain namespace separator}
+test oo-20.6 {OO: variable method} -setup {
+ oo::class create testClass {
+ export varname
+ self export eval
+ }
+} -body {
+ testClass eval variable a 0
+ oo::objdefine [testClass create foo] method bar {other} {
+ $other variable a
+ set a 3
+ }
+ oo::objdefine [testClass create boo] export variable
+ set [foo varname a] 1
+ set [boo varname a] 2
+ foo bar boo
+ list [testClass eval set a] [set [foo varname a]] [set [boo varname a]]
+} -cleanup {
+ testClass destroy
+} -result {0 1 3}
+test oo-20.7 {OO: variable method} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ method a {} {
+ my variable d b
+ lappend b $d
+ }
+ method e {} {
+ my variable b d
+ return [list $b $d]
+ }
+ method f {x y} {
+ my variable b d
+ set b $x
+ set d $y
+ }
+ }
+ cls create obj
+ obj f p q
+ obj a
+ obj a
+ obj e
+} -cleanup {
+ cls destroy
+} -result {{p q q} q}
+# oo-20.8 tested explicitly for functionality removed due to [Bug 1959457]
+test oo-20.9 {OO: variable method} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj {
+ method a {} {
+ my variable ::b
+ }
+ }
+ obj a
+} -returnCodes 1 -cleanup {
+ obj destroy
+} -result {variable name "::b" illegal: must not contain namespace separator}
+test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj {
+ method a {} {
+ my variable b
+ set b [self]
+ return [my varname b]
+ }
+ }
+ list [set [obj a]] [namespace tail [obj a]]
+} -cleanup {
+ obj destroy
+} -result {::obj b}
+test oo-20.11 {OO: variable mustn't crash when recursing} -body {
+ oo::class create A {
+ constructor {name} {
+ my variable np_name
+ set np_name $name
+ }
+ method copy {nm} {
+ set cpy [[info object class [self]] new $nm]
+ foreach var [info object vars [self]] {
+ my variable $var
+ set val [set $var]
+ if {[string match o_* $var]} {
+ set objs {}
+ foreach ref $val {
+ # call to "copy" crashes
+ lappend objs [$ref copy {}]
+ }
+ $cpy prop $var $objs
+ } else {
+ $cpy prop $var $val
+ }
+ }
+ return $cpy
+ }
+ method prop {name val} {
+ my variable $name
+ set $name $val
+ }
+ }
+ set o1 [A new {}]
+ set o2 [A new {}]
+ $o1 prop o_object $o2
+ $o1 copy aa
+} -cleanup {
+ catch {A destroy}
+} -match glob -result *
+test oo-20.12 {OO: variable method accept zero args (TIP 323)} -setup {
+ oo::object create foo
+} -cleanup {
+ foo destroy
+} -body {
+ oo::objdefine foo method demo {} {
+ my variable
+ }
+ foo demo
+} -result {}
+test oo-20.13 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+ oo::object create fooObj
+ oo::objdefine fooObj export variable
+} -cleanup {
+ fooObj destroy
+} -body {
+ apply {{} {fooObj variable x; set x ok; return}}
+ apply {{} {fooObj variable x; return $x}}
+} -result ok
+test oo-20.14 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+ oo::object create fooObj
+ oo::objdefine fooObj export variable
+ namespace eval ns1 {}
+ namespace eval ns2 {}
+ set x bad
+} -cleanup {
+ fooObj destroy
+ namespace delete ns1 ns2
+ unset x
+} -body {
+ namespace eval ns1 {fooObj variable x; set x ok; subst ""}
+ set x bad
+ namespace eval ns2 {fooObj variable x; return $x}
+} -result ok
+test oo-20.15 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+ oo::object create fooObj
+ oo::objdefine fooObj export variable varname
+} -cleanup {
+ fooObj destroy
+} -body {
+ 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
+} -body {
+ oo::define A method m {} {lappend ::result A}
+ oo::class create B {
+ superclass A
+ method m {} {lappend ::result B;next}
+ }
+ oo::class create C {
+ superclass A
+ method m {} {lappend ::result C;next}
+ }
+ oo::class create D {
+ superclass B C
+ method m {} {lappend ::result D;next}
+ }
+ D create o
+ oo::objdefine o method m {} {lappend ::result o;next}
+ set result {}
+ o m
+ return $result
+} -cleanup {
+ A destroy
+} -result {o D B C A}
+test oo-21.2 {OO: inheritance ordering} -setup {
+ oo::class create A
+} -body {
+ oo::define A method m {} {lappend ::result A}
+ oo::class create B {
+ superclass A
+ method m {} {lappend ::result B;next}
+ }
+ oo::class create C {
+ superclass A
+ method m {} {lappend ::result C;next}
+ }
+ oo::class create D {
+ superclass B C
+ method m {} {lappend ::result D;next}
+ }
+ oo::class create Emix {
+ superclass C
+ method m {} {lappend ::result Emix;next}
+ }
+ oo::class create Fmix {
+ superclass Emix
+ method m {} {lappend ::result Fmix;next}
+ }
+ D create o
+ oo::objdefine o {
+ method m {} {lappend ::result o;next}
+ mixin Fmix
+ }
+ set result {}
+ o m
+ return $result
+} -cleanup {
+ A destroy
+} -result {Fmix Emix o D B C A}
+test oo-21.3 {OO: inheritance ordering} -setup {
+ oo::class create A
+} -body {
+ oo::define A method m {} {lappend ::result A}
+ oo::class create B {
+ superclass A
+ method m {} {lappend ::result B;next}
+ method f {} {lappend ::result B-filt;next}
+ }
+ oo::class create C {
+ superclass A
+ method m {} {lappend ::result C;next}
+ }
+ oo::class create D {
+ superclass B C
+ method m {} {lappend ::result D;next}
+ }
+ oo::class create Emix {
+ superclass C
+ method m {} {lappend ::result Emix;next}
+ method f {} {lappend ::result Emix-filt;next}
+ }
+ oo::class create Fmix {
+ superclass Emix
+ method m {} {lappend ::result Fmix;next}
+ }
+ D create o
+ oo::objdefine o {
+ method m {} {lappend ::result o;next}
+ mixin Fmix
+ filter f
+ }
+ set result {}
+ o m
+ return $result
+} -cleanup {
+ A destroy
+} -result {Emix-filt B-filt Fmix Emix o D B C A}
+test oo-21.4 {OO: inheritance ordering} -setup {
+ oo::class create A
+} -body {
+ oo::define A method m {} {lappend ::result A}
+ oo::class create B {
+ superclass A
+ method m {} {lappend ::result B;next}
+ method f {} {lappend ::result B-filt;next}
+ method g {} {lappend ::result B-cfilt;next}
+ }
+ oo::class create C {
+ superclass A
+ method m {} {lappend ::result C;next}
+ }
+ oo::class create D {
+ superclass B C
+ method m {} {lappend ::result D;next}
+ method g {} {lappend ::result D-cfilt;next}
+ filter g
+ }
+ oo::class create Emix {
+ superclass C
+ method m {} {lappend ::result Emix;next}
+ method f {} {lappend ::result Emix-filt;next}
+ }
+ oo::class create Fmix {
+ superclass Emix
+ method m {} {lappend ::result Fmix;next}
+ }
+ D create o
+ oo::objdefine o {
+ method m {} {lappend ::result o;next}
+ mixin Fmix
+ filter f
+ }
+ set result {}
+ o m
+ return $result
+} -cleanup {
+ A destroy
+} -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}
+
+test oo-22.1 {OO and info frame} -setup {
+ oo::class create c
+ c create i
+} -match glob -body {
+ oo::define c self method frame {} {
+ info frame 0
+ }
+ oo::define c {
+ method frames {} {
+ info frame 0
+ }
+ method level {} {
+ info frame
+ }
+ }
+ oo::objdefine i {
+ method frames {} {
+ list [next] [info frame 0]
+ }
+ method level {} {
+ expr {[next] - [info frame]}
+ }
+ }
+ list [i level] [i frames] [dict get [c frame] object]
+} -cleanup {
+ c destroy
+} -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 {
+ oo::class create SELF {
+ superclass oo::class
+ unexport create new
+ # Next is just a convenience
+ method method args {oo::define [self] method {*}$args}
+ method derive {name} {
+ set o [my new [list superclass [self]]]
+ oo::objdefine $o mixin $o
+ uplevel 1 [list rename $o $name]\;[list namespace which $name]
+ }
+ self mixin SELF
+ }
+ set result {}
+} -body {
+ [SELF derive foo1] method bar1 {} {return 1}
+ lappend result [foo1 bar1]
+ [foo1 derive foo2] method bar2 {} {return [my bar1],2}
+ lappend result [foo2 bar2]
+ [foo2 derive foo3] method bar3 {} {return [my bar2],3}
+ lappend result [foo3 bar3]
+ [foo3 derive foo4] method bar4 {} {return [my bar3],4}
+ lappend result [foo4 bar4]
+ foo2 method bar2 {} {return [my bar1],x}
+ lappend result [foo4 bar4]
+} -cleanup {
+ SELF destroy
+} -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4}
+
+test oo-24.1 {unknown method method - Bug 1965063} -setup {
+ oo::class create cls
+} -cleanup {
+ cls destroy
+} -returnCodes error -body {
+ oo::define cls {
+ method dummy {} {}
+ method unknown args {next {*}$args}
+ }
+ [cls new] foo bar
+} -result {unknown method "foo": must be destroy, dummy or unknown}
+test oo-24.2 {unknown method method - Bug 1965063} -setup {
+ oo::class create cls
+} -cleanup {
+ cls destroy
+} -returnCodes error -body {
+ oo::define cls {
+ method dummy {} {}
+ method unknown args {next {*}$args}
+ }
+ cls create obj
+ oo::objdefine obj {
+ method dummy2 {} {}
+ method unknown args {next {*}$args}
+ }
+ 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 {
+ oo::class create cls {
+ method ab {} {return ok}
+ }
+ set result {}
+} -cleanup {
+ cls destroy
+} -body {
+ cls create foo
+ cls create bar
+ set m1 ab
+ set m2 a; append m2 b ;# different object!
+ lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1]
+ lappend result [foo $m2] [bar $m2]
+ oo::objdefine foo method ab {} {return good}
+ lappend result [foo $m1] [bar $m2]
+} -result {ok ok ok ok ok ok good ok}
+test oo-25.2 {call chain caching - Bug #2120903} -setup {
+ set c [oo::class create MyClass]
+ set o [$c new]
+} -body {
+ oo::define MyClass {
+ method name {} {return ok}
+ method isa o {MyClass name $o}
+ self method name o {$o name}
+ }
+ list [$o name] [$c name $o] [$o isa $o]
+} -cleanup {
+ $c destroy
+} -result {ok ok ok}
+
+test oo-26.1 {Bug 2037727} -setup {
+ proc succeed args {}
+ oo::object create example
+} -body {
+ oo::objdefine example method foo {} {succeed}
+ example foo
+ proc succeed {} {return succeed}
+ example foo
+} -cleanup {
+ example destroy
+ rename succeed {}
+} -result succeed
+test oo-26.2 {Bug 2037727} -setup {
+ oo::class create example {
+ method localProc {args body} {proc called $args $body}
+ method run {} { called }
+ }
+ example create i1
+ example create i2
+} -body {
+ i1 localProc args {}
+ i2 localProc args {return nonempty}
+ list [i1 run] [i2 run]
+} -cleanup {
+ example destroy
+} -result {{} nonempty}
+test oo-26.3 {Bug 2037727} -setup {
+ oo::class create example {
+ method subProc {args body} {
+ namespace eval subns [list proc called $args $body]
+ }
+ method run {} { subns::called }
+ }
+ example create i1
+ example create i2
+} -body {
+ i1 subProc args {}
+ i2 subProc args {return nonempty}
+ list [i1 run] [i2 run]
+} -cleanup {
+ example destroy
+} -result {{} nonempty}
+
+test oo-27.1 {variables declaration - class introspection} -setup {
+ oo::class create foo
+} -cleanup {
+ foo destroy
+} -body {
+ oo::define foo variable a b c
+ info class variables foo
+} -result {a b c}
+test oo-27.2 {variables declaration - object introspection} -setup {
+ oo::object create foo
+} -cleanup {
+ foo destroy
+} -body {
+ oo::objdefine foo variable a b c
+ info object variables foo
+} -result {a b c}
+test oo-27.3 {variables declaration - basic behaviour} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x!
+ constructor {} {set x! 1}
+ method y {} {incr x!}
+ }
+ foo create bar
+ bar y
+ bar y
+} -result 3
+test oo-27.4 {variables declaration - destructors too} -setup {
+ oo::class create master
+ set result bad!
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x!
+ constructor {} {set x! 1}
+ method y {} {incr x!}
+ destructor {set ::result ${x!}}
+ }
+ foo create bar
+ bar y
+ bar y
+ bar destroy
+ return $result
+} -result 3
+test oo-27.5 {variables declaration - object-bound variables} -setup {
+ oo::object create foo
+} -cleanup {
+ foo destroy
+} -body {
+ oo::objdefine foo {
+ variable x!
+ method y {} {incr x!}
+ }
+ foo y
+ foo y
+} -result 2
+test oo-27.6 {variables declaration - non-interference of levels} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x!
+ constructor {} {set x! 1}
+ method y {} {incr x!}
+ }
+ foo create bar
+ oo::objdefine bar {
+ variable y!
+ method y {} {list [next] [incr y!] [info var] [info local]}
+ export eval
+ }
+ bar y
+ list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
+} -result {{3 2 y! {}} {x! y!} {x! y!}}
+test oo-27.7 {variables declaration - one underlying variable space} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable x!
+ constructor {} {set x! 1}
+ method y {} {incr x!}
+ }
+ oo::class create foo2 {
+ superclass foo
+ variable y!
+ constructor {} {set y! 42; next}
+ method x {} {incr y! -1}
+ }
+ foo2 create bar
+ oo::objdefine bar {
+ variable x! y!
+ method z {} {list ${x!} ${y!}}
+ }
+ bar y
+ bar x
+ list [bar y] [bar x] [bar z]
+} -result {3 40 {3 40}}
+test oo-27.8 {variables declaration - error cases - ns separators} -body {
+ oo::define oo::object variable bad::var
+} -returnCodes error -result {invalid declared variable name "bad::var": must not contain namespace separators}
+test oo-27.9 {variables declaration - error cases - arrays} -body {
+ oo::define oo::object variable bad(var)
+} -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
+test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable clsvar
+ constructor {} {
+ set clsvar 0
+ }
+ method step {} {
+ incr clsvar
+ return
+ }
+ method value {} {
+ return $clsvar
+ }
+ }
+ foo create inst1
+ inst1 step
+ foo create inst2
+ inst2 step
+ inst1 step
+ inst2 step
+ inst1 step
+ list [inst1 value] [inst2 value]
+} -result {3 2}
+test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
+ oo::class create master
+} -cleanup {
+ master destroy
+} -body {
+ oo::class create foo {
+ superclass master
+ variable clsvar
+ constructor {} {
+ set clsvar 0
+ }
+ method step {} {
+ incr clsvar
+ return
+ }
+ method value {} {
+ return $clsvar
+ }
+ }
+ foo create inst1
+ oo::objdefine inst1 {
+ variable clsvar
+ method reinit {} {
+ set clsvar 0
+ }
+ }
+ foo create inst2
+ oo::objdefine inst2 {
+ variable clsvar
+ method reinit {} {
+ set clsvar 0
+ }
+ }
+ inst1 step
+ inst2 step
+ inst1 reinit
+ inst2 reinit
+ inst1 step
+ inst2 step
+ inst1 step
+ inst2 step
+ 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...
+test oo-28.1 {scripted extensions to oo::define} -setup {
+ interp create foo
+ foo eval {oo::class create cls {export eval}}
+} -cleanup {
+ interp delete foo
+} -body {
+ foo eval {
+ proc oo::define::privateMethod {name arguments body} {
+ uplevel 1 [list method $name $arguments $body]
+ uplevel 1 [list unexport $name]
+ }
+ oo::define cls privateMethod m {x y} {return $x,$y}
+ cls create obj
+ list [catch {obj m 1 2}] [obj eval my m 3 4]
+ }
+} -result {1 3,4}
+
+test oo-29.1 {self class with object-defined methods} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj method demo {} {
+ self class
+ }
+ obj demo
+} -returnCodes error -cleanup {
+ obj destroy
+} -result {method not defined by a class}
+
+test oo-30.1 {Bug 2903011: deleting an object in a constructor} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {constructor {} {[self] destroy}}
+ cls new
+} -returnCodes error -cleanup {
+ cls destroy
+} -result {object deleted in constructor}
+test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {constructor {} {my destroy}}
+ cls new
+} -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}}
+
+test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+ oo::class create fruit {
+ method eat {} {}
+ }
+ set result {}
+} -body {
+ lappend result [fruit create ::apple] [info class superclasses fruit]
+ oo::define fruit superclass
+ lappend result [info class superclasses fruit] \
+ [info object class apple oo::object] \
+ [info class call fruit destroy] \
+ [catch { apple }]
+} -cleanup {
+ unset -nocomplain result
+ fruit destroy
+} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
+test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+ oo::class create fruitMetaclass {
+ superclass oo::class
+ method eat {} {}
+ }
+ set result {}
+} -body {
+ lappend result [fruitMetaclass create ::appleClass] \
+ [appleClass create orange] \
+ [info class superclasses fruitMetaclass]
+ oo::define fruitMetaclass superclass
+ lappend result [info class superclasses fruitMetaclass] \
+ [info object class appleClass oo::class] \
+ [catch { orange }] [info object class orange] \
+ [appleClass create pear]
+} -cleanup {
+ unset -nocomplain result
+ fruitMetaclass destroy
+} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
new file mode 100644
index 0000000..a47aa91
--- /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.1
+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 b7e3a55..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.9 2004/05/19 12:48:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -19,7 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
# the package we are going to test
-package require opt 0.4.1
+package require opt 0.4.6
# we are using implementation specifics to test the package
@@ -58,7 +56,7 @@ test opt-3.2 {OptParse / temp key is removed even on errors} {
test opt-4.1 {OptProc} {
::tcl::OptProc optTest {} {}
- optTest ;
+ optTest
::tcl::OptKeyDelete optTest
} {}
@@ -74,12 +72,12 @@ test opt-5.1 {OptProcArgGiven} {
} {0 1 1 1}
test opt-6.1 {OptKeyParse} {
- ::tcl::OptKeyRegister {} test;
+ ::tcl::OptKeyRegister {} test
list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
} {1 {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )}}
+ (-help gives this help)}}
test opt-7.1 {OptCheckType} {
list \
@@ -161,9 +159,9 @@ test opt-10.1 {ambigous flags} {
catch {optTest -fL} msg
set msg
} {ambigous option "-fL", choose from:
- -fla boolflag (false)
- -flag2xyz boolflag (false)
- -flag3xyz boolflag (false) }
+ -fla boolflag (false)
+ -flag2xyz boolflag (false)
+ -flag3xyz boolflag (false)}
test opt-10.2 {non ambigous flags} {
::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
return $flag2xyz
@@ -183,8 +181,8 @@ test opt-10.4 {ambigous flags, not exact match} {
catch {optTest -fLag1X} msg
set msg
} {ambigous option "-fLag1X", choose from:
- -flag1xy boolflag (false)
- -flag1xyz boolflag (false) }
+ -flag1xy boolflag (false)
+ -flag1xyz boolflag (false)}
# medium size overall test example: (defined once)
::tcl::OptProc optTest {
@@ -206,12 +204,12 @@ test opt-10.6 {medium size overall test} {
} {1 {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
+ (-help gives this help)
cmd choice (print save delete) sub command to choose
- -allowBoing boolean (true)
+ -allowBoing boolean (true)
arg2 string () this is help
?arg3? int (7) optional number
- -moreflags boolflag (false) }}
+ -moreflags boolflag (false)}}
test opt-10.7 {medium size overall test} {
optTest save tst
} {save 1 tst 7 0}
@@ -232,8 +230,8 @@ test opt-11.1 {too many args test 2} {
} {1 {too many arguments (unexpected argument(s): blah), usage:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
- -foo boolflag (false) } {}}
+ (-help gives this help)
+ -foo boolflag (false)} {}}
test opt-11.2 {default value for args} {
set args {}
set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
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 8481a6f..01443c9 100644
--- a/tests/parse.test
+++ b/tests/parse.test